From 4440ed628aa55ad71a745fc61e1b12a2acc240d5 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 14 Jun 2023 16:36:21 +0000 Subject: [PATCH 01/15] Add ability to test OpenFAST restart in reg_tests --- reg_tests/CTestList.cmake | 1 + reg_tests/executeOpenfastRegressionCase.py | 12 +++++++++++- reg_tests/lib/openfastDrivers.py | 21 +++++++++++++-------- reg_tests/r-test | 2 +- 4 files changed, 26 insertions(+), 10 deletions(-) diff --git a/reg_tests/CTestList.cmake b/reg_tests/CTestList.cmake index 428b149b41..142e57339c 100644 --- a/reg_tests/CTestList.cmake +++ b/reg_tests/CTestList.cmake @@ -277,6 +277,7 @@ of_regression("SWRT_YFree_VS_EDC01" "openfast;elastodyn;aerodyn14;se # of_regression("SWRT_YFree_VS_WTurb" "openfast;elastodyn;aerodyn14;servodyn") of_regression("5MW_Land_DLL_WTurb" "openfast;elastodyn;aerodyn15;servodyn") of_regression("5MW_OC3Mnpl_DLL_WTurb_WavesIrr" "openfast;elastodyn;aerodyn15;servodyn;hydrodyn;subdyn;offshore") +of_regression("5MW_OC3Mnpl_DLL_WTurb_WavesIrr_Restart" "openfast;elastodyn;aerodyn15;servodyn;hydrodyn;subdyn;offshore;restart") of_regression("5MW_OC3Trpd_DLL_WSt_WavesReg" "openfast;elastodyn;aerodyn15;servodyn;hydrodyn;subdyn;offshore") # of_regression("5MW_OC4Jckt_DLL_WTurb_WavesIrr_MGrowth" "openfast;elastodyn;aerodyn15;servodyn;hydrodyn;subdyn;offshore") # of_regression("5MW_ITIBarge_DLL_WTurb_WavesIrr" "openfast;elastodyn;aerodyn14;servodyn;hydrodyn;map;offshore") diff --git a/reg_tests/executeOpenfastRegressionCase.py b/reg_tests/executeOpenfastRegressionCase.py index a0cae63e6b..a9a0d20ad5 100644 --- a/reg_tests/executeOpenfastRegressionCase.py +++ b/reg_tests/executeOpenfastRegressionCase.py @@ -29,6 +29,7 @@ import argparse import numpy as np import shutil +import glob import subprocess import rtestlib as rtl import openfastDrivers @@ -125,7 +126,16 @@ returnCode = openfastDrivers.runOpenfastCase(caseInputFile, executable) if returnCode != 0: sys.exit(returnCode*10) - + +### If this is a restart test case +if caseName.endswith('_Restart'): + for caseInputFile in reversed(glob.glob(os.path.join(testBuildDirectory, '*chkp'))): + if not caseInputFile.endswith('dll.chkp'): + break + returnCode = openfastDrivers.runOpenfastCase(caseInputFile, executable, restart=True) + if returnCode != 0: + sys.exit(returnCode*10) + ### Build the filesystem navigation variables for running the regression test localOutFile = os.path.join(testBuildDirectory, caseName + ".outb") baselineOutFile = os.path.join(targetOutputDirectory, caseName + ".outb") diff --git a/reg_tests/lib/openfastDrivers.py b/reg_tests/lib/openfastDrivers.py index c7d1659e0b..ceeb5a5634 100644 --- a/reg_tests/lib/openfastDrivers.py +++ b/reg_tests/lib/openfastDrivers.py @@ -27,15 +27,17 @@ import subprocess import rtestlib as rtl -def _runCase(executable, inputFile, logFile, stdout): +def _runCase(executable, inputFile, logFile, stdout, restart=False): if logFile is None: - command = "{} {}".format(executable, inputFile, logFile) + command = f"{executable} {inputFile}" + elif restart: + command = f"{executable} -restart {os.path.splitext(inputFile)[0]} > {logFile}" else: - command = "{} {} > {}".format(executable, inputFile, logFile) + command = f"{executable} {inputFile} > {logFile}" print(command) return subprocess.call(command, stdout=stdout, shell=True) -def _runGenericCase(inputFile, executable, verbose=False, log=True): +def _runGenericCase(inputFile, executable, verbose=False, restart=False, log=True): stdout = sys.stdout if verbose else open(os.devnull, 'w') rtl.validateFileOrExit(inputFile) @@ -47,9 +49,12 @@ def _runGenericCase(inputFile, executable, verbose=False, log=True): else: caseparent = os.path.sep.join(inputFile.split(os.path.sep)[:-1]) casebase = caseparent.split(os.path.sep)[-1] # assumes that the directory structure name is the name of the .log file. (for consistent driver + glue-code names) - logFile = caseparent + os.path.sep + casebase + '.log' + if restart: + logFile = caseparent + os.path.sep + casebase + '_2.log' + else: + logFile = caseparent + os.path.sep + casebase + '.log' - returnCode = _runCase(executable, inputFile, logFile, stdout) + returnCode = _runCase(executable, inputFile, logFile, stdout, restart) print("COMPLETE with code {}".format(returnCode), flush=True) return returnCode @@ -71,8 +76,8 @@ def _runUACase(inputFile, executable, verbose=False, log=True): return returnCode -def runOpenfastCase(inputFile, executable, verbose=False): - return _runGenericCase(inputFile, executable, verbose) +def runOpenfastCase(inputFile, executable, verbose=False, restart=False): + return _runGenericCase(inputFile, executable, verbose, restart) def runAerodynDriverCase(inputFile, executable, verbose=False): caseDirectory = os.path.sep.join(inputFile.split(os.path.sep)[:-1]) diff --git a/reg_tests/r-test b/reg_tests/r-test index 77b73ebca9..3e92b0bdc7 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 77b73ebca9c8923d9e3cc532e1eb0bfb32a1c37d +Subproject commit 3e92b0bdc7b1a641649d94b92f99397c5669b9b3 From ec245193eb02e0db04791caf85e63ff3c0852e5a Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Wed, 14 Jun 2023 16:44:13 +0000 Subject: [PATCH 02/15] Update Registry Pack/Unpack to support Pointers This commit significantly modifies the OpenFAST Registry code which generated the Pack and Unpack routines so that it can support packing and unpacking pointers without loosing their associations. This was accomplished by creating a PackBuffer derived type which stores a buffer of bytes and a pointer index. The byte buffer replaces the DbKiBuf, IntKiBuf, and ReKiBuf and packs all data as bytes (int8) using the `transfer` intrinsic. As each pointer is encountered in any structure, `c_loc` is used to get the address and the pointer index in PackBuffer is searched. If the pointer is found (already encountered in another field), then the exisitng index is saved into the buffer; otherwise, the pointer is added to the index and the new index is saved into the buffer. If the pointer wasn't in the index, then the associated data is saved to the buffer. Unpacking is the reverse of this process. --- .../fast-farm/src/FASTWrapper_Types.f90 | 2797 +- glue-codes/fast-farm/src/FAST_Farm_Types.f90 | 7191 +- modules/aerodyn/src/AeroAcoustics_Types.f90 | 11298 +-- modules/aerodyn/src/AeroDyn_Driver_Types.f90 | 4871 +- modules/aerodyn/src/AeroDyn_IO.f90 | 2 +- modules/aerodyn/src/AeroDyn_Inflow_Types.f90 | 6983 +- modules/aerodyn/src/AeroDyn_Types.f90 | 19311 ++--- modules/aerodyn/src/AirfoilInfo_Types.f90 | 2908 +- modules/aerodyn/src/BEMT_Types.f90 | 7270 +- modules/aerodyn/src/DBEMT_Types.f90 | 2447 +- modules/aerodyn/src/FVW_Types.f90 | 11711 +-- modules/aerodyn/src/UnsteadyAero_Types.f90 | 7060 +- modules/aerodyn14/src/AeroDyn14_Types.f90 | 16840 ++--- modules/aerodyn14/src/DWM_Types.f90 | 9448 +-- modules/awae/src/AWAE_Types.f90 | 8172 +-- modules/beamdyn/src/BeamDyn_Types.f90 | 13119 +--- modules/elastodyn/src/ElastoDyn_Types.f90 | 27951 +++----- modules/extptfm/src/ExtPtfm_MCKF_Types.f90 | 4887 +- modules/feamooring/src/FEAMooring_Types.f90 | 7471 +- modules/hydrodyn/src/Conv_Radiation_Types.f90 | 1761 +- modules/hydrodyn/src/HydroDyn_Types.f90 | 8238 +-- modules/hydrodyn/src/Morison_Types.f90 | 13164 ++-- modules/hydrodyn/src/SS_Excitation_Types.f90 | 2543 +- modules/hydrodyn/src/SS_Radiation_Types.f90 | 2038 +- modules/hydrodyn/src/WAMIT2_Types.f90 | 1508 +- modules/hydrodyn/src/WAMIT_Types.f90 | 5342 +- modules/icedyn/src/IceDyn_Types.f90 | 4120 +- modules/icefloe/src/icefloe/IceFloe_Types.f90 | 2047 +- .../inflowwind/src/IfW_FlowField_Types.f90 | 3630 +- modules/inflowwind/src/InflowWind_Driver.f90 | 23 +- .../inflowwind/src/InflowWind_IO_Types.f90 | 2105 +- modules/inflowwind/src/InflowWind_Types.f90 | 5191 +- modules/inflowwind/src/Lidar_Types.f90 | 2031 +- modules/map/src/MAP_Fortran_Types.f90 | 606 +- modules/map/src/MAP_Types.f90 | 4265 +- modules/moordyn/src/MoorDyn_Types.f90 | 14265 ++-- modules/nwtc-library/CMakeLists.txt | 5 + modules/nwtc-library/ModRegGen.py | 603 + modules/nwtc-library/src/ModMesh.f90 | 592 +- modules/nwtc-library/src/ModMesh_Mapping.f90 | 2259 +- modules/nwtc-library/src/ModReg.f90 | 1679 + modules/nwtc-library/src/NWTC_Base.f90 | 25 + modules/nwtc-library/src/NWTC_IO.f90 | 120 +- modules/nwtc-library/src/NWTC_Library.f90 | 1 + .../nwtc-library/src/NWTC_Library_Types.f90 | 1497 +- modules/nwtc-library/src/SingPrec.f90 | 21 +- modules/openfast-library/src/FAST_Subs.f90 | 148 +- modules/openfast-library/src/FAST_Types.f90 | 58983 ++++------------ .../src/registry_gen_fortran.cpp | 714 +- modules/openfoam/src/OpenFOAM_Types.f90 | 3660 +- .../src/OrcaFlexInterface_Types.f90 | 2199 +- modules/seastate/src/Current_Types.f90 | 554 +- .../seastate/src/SeaSt_WaveField_Types.f90 | 1464 +- modules/seastate/src/SeaState.f90 | 2 +- .../seastate/src/SeaState_Interp_Types.f90 | 713 +- modules/seastate/src/SeaState_Types.f90 | 5244 +- modules/seastate/src/Waves2_Types.f90 | 1450 +- modules/seastate/src/Waves_Types.f90 | 1742 +- modules/servodyn/src/ServoDyn_Types.f90 | 19961 ++---- modules/servodyn/src/StrucCtrl_Types.f90 | 6106 +- modules/subdyn/src/SubDyn_Types.f90 | 13332 ++-- .../supercontroller/src/SCDataEx_Types.f90 | 941 +- .../src/SuperController_Types.f90 | 2198 +- .../wakedynamics/src/WakeDynamics_Types.f90 | 6007 +- 64 files changed, 103358 insertions(+), 273476 deletions(-) create mode 100644 modules/nwtc-library/ModRegGen.py create mode 100644 modules/nwtc-library/src/ModReg.f90 diff --git a/glue-codes/fast-farm/src/FASTWrapper_Types.f90 b/glue-codes/fast-farm/src/FASTWrapper_Types.f90 index 837c4048f9..198dd81f82 100644 --- a/glue-codes/fast-farm/src/FASTWrapper_Types.f90 +++ b/glue-codes/fast-farm/src/FASTWrapper_Types.f90 @@ -215,305 +215,231 @@ SUBROUTINE FWrap_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) NULLIFY(InitInputData%Vdist_High) END SUBROUTINE FWrap_DestroyInitInput - SUBROUTINE FWrap_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FWrap_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! nr - Int_BufSz = Int_BufSz + 1*LEN(InData%FASTInFile) ! FASTInFile - Re_BufSz = Re_BufSz + 1 ! dr - Db_BufSz = Db_BufSz + 1 ! tmax - Re_BufSz = Re_BufSz + SIZE(InData%p_ref_Turbine) ! p_ref_Turbine - Int_BufSz = Int_BufSz + 1 ! WaveFieldMod - Int_BufSz = Int_BufSz + 1 ! n_high_low - Db_BufSz = Db_BufSz + 1 ! dt_high - Re_BufSz = Re_BufSz + SIZE(InData%p_ref_high) ! p_ref_high - Int_BufSz = Int_BufSz + 1 ! nX_high - Int_BufSz = Int_BufSz + 1 ! nY_high - Int_BufSz = Int_BufSz + 1 ! nZ_high - Re_BufSz = Re_BufSz + 1 ! dX_high - Re_BufSz = Re_BufSz + 1 ! dY_high - Re_BufSz = Re_BufSz + 1 ! dZ_high - Int_BufSz = Int_BufSz + 1 ! TurbNum - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1 ! NumSC2Ctrl - Int_BufSz = Int_BufSz + 1 ! NumSC2CtrlGlob - Int_BufSz = Int_BufSz + 1 ! NumCtrl2SC - Int_BufSz = Int_BufSz + 1 ! UseSC - Int_BufSz = Int_BufSz + 1 ! fromSCGlob allocated yes/no - IF ( ALLOCATED(InData%fromSCGlob) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! fromSCGlob upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fromSCGlob) ! fromSCGlob - END IF - Int_BufSz = Int_BufSz + 1 ! fromSC allocated yes/no - IF ( ALLOCATED(InData%fromSC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! fromSC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fromSC) ! fromSC - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%nr - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%FASTInFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%FASTInFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf(Re_Xferred) = InData%dr - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%tmax - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%p_ref_Turbine,1), UBOUND(InData%p_ref_Turbine,1) - ReKiBuf(Re_Xferred) = InData%p_ref_Turbine(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%WaveFieldMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%n_high_low - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%dt_high - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%p_ref_high,1), UBOUND(InData%p_ref_high,1) - ReKiBuf(Re_Xferred) = InData%p_ref_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%nX_high - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nY_high - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nZ_high - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dX_high - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dY_high - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dZ_high - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TurbNum - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%NumSC2Ctrl - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumSC2CtrlGlob - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumCtrl2SC - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseSC, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%fromSCGlob) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fromSCGlob,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fromSCGlob,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%fromSCGlob,1), UBOUND(InData%fromSCGlob,1) - ReKiBuf(Re_Xferred) = InData%fromSCGlob(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%fromSC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fromSC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fromSC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%fromSC,1), UBOUND(InData%fromSC,1) - ReKiBuf(Re_Xferred) = InData%fromSC(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FWrap_PackInitInput - - SUBROUTINE FWrap_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FWrap_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%nr = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%FASTInFile) - OutData%FASTInFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%dr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%tmax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%p_ref_Turbine,1) - i1_u = UBOUND(OutData%p_ref_Turbine,1) - DO i1 = LBOUND(OutData%p_ref_Turbine,1), UBOUND(OutData%p_ref_Turbine,1) - OutData%p_ref_Turbine(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%WaveFieldMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%n_high_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%dt_high = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%p_ref_high,1) - i1_u = UBOUND(OutData%p_ref_high,1) - DO i1 = LBOUND(OutData%p_ref_high,1), UBOUND(OutData%p_ref_high,1) - OutData%p_ref_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%nX_high = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nY_high = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nZ_high = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%dX_high = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dY_high = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dZ_high = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TurbNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%NumSC2Ctrl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumSC2CtrlGlob = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumCtrl2SC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UseSC = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseSC) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fromSCGlob not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%fromSCGlob)) DEALLOCATE(OutData%fromSCGlob) - ALLOCATE(OutData%fromSCGlob(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSCGlob.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%fromSCGlob,1), UBOUND(OutData%fromSCGlob,1) - OutData%fromSCGlob(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fromSC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%fromSC)) DEALLOCATE(OutData%fromSC) - ALLOCATE(OutData%fromSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%fromSC,1), UBOUND(OutData%fromSC,1) - OutData%fromSC(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - NULLIFY(OutData%Vdist_High) - END SUBROUTINE FWrap_UnPackInitInput +subroutine FWrap_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FWrap_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FWrap_PackInitInput' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + ! nr + call RegPack(Buf, InData%nr) + if (RegCheckErr(Buf, RoutineName)) return + ! FASTInFile + call RegPack(Buf, InData%FASTInFile) + if (RegCheckErr(Buf, RoutineName)) return + ! dr + call RegPack(Buf, InData%dr) + if (RegCheckErr(Buf, RoutineName)) return + ! tmax + call RegPack(Buf, InData%tmax) + if (RegCheckErr(Buf, RoutineName)) return + ! p_ref_Turbine + call RegPack(Buf, InData%p_ref_Turbine) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveFieldMod + call RegPack(Buf, InData%WaveFieldMod) + if (RegCheckErr(Buf, RoutineName)) return + ! n_high_low + call RegPack(Buf, InData%n_high_low) + if (RegCheckErr(Buf, RoutineName)) return + ! dt_high + call RegPack(Buf, InData%dt_high) + if (RegCheckErr(Buf, RoutineName)) return + ! p_ref_high + call RegPack(Buf, InData%p_ref_high) + if (RegCheckErr(Buf, RoutineName)) return + ! nX_high + call RegPack(Buf, InData%nX_high) + if (RegCheckErr(Buf, RoutineName)) return + ! nY_high + call RegPack(Buf, InData%nY_high) + if (RegCheckErr(Buf, RoutineName)) return + ! nZ_high + call RegPack(Buf, InData%nZ_high) + if (RegCheckErr(Buf, RoutineName)) return + ! dX_high + call RegPack(Buf, InData%dX_high) + if (RegCheckErr(Buf, RoutineName)) return + ! dY_high + call RegPack(Buf, InData%dY_high) + if (RegCheckErr(Buf, RoutineName)) return + ! dZ_high + call RegPack(Buf, InData%dZ_high) + if (RegCheckErr(Buf, RoutineName)) return + ! TurbNum + call RegPack(Buf, InData%TurbNum) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegPack(Buf, InData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! NumSC2Ctrl + call RegPack(Buf, InData%NumSC2Ctrl) + if (RegCheckErr(Buf, RoutineName)) return + ! NumSC2CtrlGlob + call RegPack(Buf, InData%NumSC2CtrlGlob) + if (RegCheckErr(Buf, RoutineName)) return + ! NumCtrl2SC + call RegPack(Buf, InData%NumCtrl2SC) + if (RegCheckErr(Buf, RoutineName)) return + ! UseSC + call RegPack(Buf, InData%UseSC) + if (RegCheckErr(Buf, RoutineName)) return + ! fromSCGlob + call RegPack(Buf, allocated(InData%fromSCGlob)) + if (allocated(InData%fromSCGlob)) then + call RegPackBounds(Buf, 1, lbound(InData%fromSCGlob), ubound(InData%fromSCGlob)) + call RegPack(Buf, InData%fromSCGlob) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! fromSC + call RegPack(Buf, allocated(InData%fromSC)) + if (allocated(InData%fromSC)) then + call RegPackBounds(Buf, 1, lbound(InData%fromSC), ubound(InData%fromSC)) + call RegPack(Buf, InData%fromSC) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Vdist_High + call RegPack(Buf, associated(InData%Vdist_High)) + if (associated(InData%Vdist_High)) then + call RegPackBounds(Buf, 5, lbound(InData%Vdist_High), ubound(InData%Vdist_High)) + call RegPackPointer(Buf, c_loc(InData%Vdist_High), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%Vdist_High) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FWrap_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FWrap_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FWrap_UnPackInitInput' + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + ! nr + call RegUnpack(Buf, OutData%nr) + if (RegCheckErr(Buf, RoutineName)) return + ! FASTInFile + call RegUnpack(Buf, OutData%FASTInFile) + if (RegCheckErr(Buf, RoutineName)) return + ! dr + call RegUnpack(Buf, OutData%dr) + if (RegCheckErr(Buf, RoutineName)) return + ! tmax + call RegUnpack(Buf, OutData%tmax) + if (RegCheckErr(Buf, RoutineName)) return + ! p_ref_Turbine + call RegUnpack(Buf, OutData%p_ref_Turbine) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveFieldMod + call RegUnpack(Buf, OutData%WaveFieldMod) + if (RegCheckErr(Buf, RoutineName)) return + ! n_high_low + call RegUnpack(Buf, OutData%n_high_low) + if (RegCheckErr(Buf, RoutineName)) return + ! dt_high + call RegUnpack(Buf, OutData%dt_high) + if (RegCheckErr(Buf, RoutineName)) return + ! p_ref_high + call RegUnpack(Buf, OutData%p_ref_high) + if (RegCheckErr(Buf, RoutineName)) return + ! nX_high + call RegUnpack(Buf, OutData%nX_high) + if (RegCheckErr(Buf, RoutineName)) return + ! nY_high + call RegUnpack(Buf, OutData%nY_high) + if (RegCheckErr(Buf, RoutineName)) return + ! nZ_high + call RegUnpack(Buf, OutData%nZ_high) + if (RegCheckErr(Buf, RoutineName)) return + ! dX_high + call RegUnpack(Buf, OutData%dX_high) + if (RegCheckErr(Buf, RoutineName)) return + ! dY_high + call RegUnpack(Buf, OutData%dY_high) + if (RegCheckErr(Buf, RoutineName)) return + ! dZ_high + call RegUnpack(Buf, OutData%dZ_high) + if (RegCheckErr(Buf, RoutineName)) return + ! TurbNum + call RegUnpack(Buf, OutData%TurbNum) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! NumSC2Ctrl + call RegUnpack(Buf, OutData%NumSC2Ctrl) + if (RegCheckErr(Buf, RoutineName)) return + ! NumSC2CtrlGlob + call RegUnpack(Buf, OutData%NumSC2CtrlGlob) + if (RegCheckErr(Buf, RoutineName)) return + ! NumCtrl2SC + call RegUnpack(Buf, OutData%NumCtrl2SC) + if (RegCheckErr(Buf, RoutineName)) return + ! UseSC + call RegUnpack(Buf, OutData%UseSC) + if (RegCheckErr(Buf, RoutineName)) return + ! fromSCGlob + if (allocated(OutData%fromSCGlob)) deallocate(OutData%fromSCGlob) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%fromSCGlob(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSCGlob.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%fromSCGlob) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! fromSC + if (allocated(OutData%fromSC)) deallocate(OutData%fromSC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%fromSC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%fromSC) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Vdist_High + if (associated(OutData%Vdist_High)) deallocate(OutData%Vdist_High) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vdist_High, UB(1:5)-LB(1:5)) + OutData%Vdist_High(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => OutData%Vdist_High + else + allocate(OutData%Vdist_High(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vdist_High.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Vdist_High) + call RegUnpack(Buf, OutData%Vdist_High) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%Vdist_High => null() + end if +end subroutine SUBROUTINE FWrap_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(FWrap_InitOutputType), INTENT(IN) :: SrcInitOutputData TYPE(FWrap_InitOutputType), INTENT(INOUT) :: DstInitOutputData @@ -552,196 +478,31 @@ SUBROUTINE FWrap_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE FWrap_DestroyInitOutput - SUBROUTINE FWrap_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FWrap_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + SIZE(InData%PtfmInit) ! PtfmInit - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i1 = LBOUND(InData%PtfmInit,1), UBOUND(InData%PtfmInit,1) - DbKiBuf(Db_Xferred) = InData%PtfmInit(i1) - Db_Xferred = Db_Xferred + 1 - END DO - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE FWrap_PackInitOutput - - SUBROUTINE FWrap_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FWrap_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%PtfmInit,1) - i1_u = UBOUND(OutData%PtfmInit,1) - DO i1 = LBOUND(OutData%PtfmInit,1), UBOUND(OutData%PtfmInit,1) - OutData%PtfmInit(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE FWrap_UnPackInitOutput +subroutine FWrap_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FWrap_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FWrap_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! PtfmInit + call RegPack(Buf, InData%PtfmInit) + if (RegCheckErr(Buf, RoutineName)) return + ! Ver + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FWrap_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FWrap_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FWrap_UnPackInitOutput' + if (Buf%ErrStat /= ErrID_None) return + ! PtfmInit + call RegUnpack(Buf, OutData%PtfmInit) + if (RegCheckErr(Buf, RoutineName)) return + ! Ver + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver +end subroutine SUBROUTINE FWrap_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(FWrap_ContinuousStateType), INTENT(IN) :: SrcContStateData TYPE(FWrap_ContinuousStateType), INTENT(INOUT) :: DstContStateData @@ -774,103 +535,26 @@ SUBROUTINE FWrap_DestroyContState( ContStateData, ErrStat, ErrMsg ) END SUBROUTINE FWrap_DestroyContState - SUBROUTINE FWrap_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FWrap_ContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_PackContState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! dummy - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%dummy - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE FWrap_PackContState - - SUBROUTINE FWrap_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FWrap_ContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_UnPackContState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%dummy = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE FWrap_UnPackContState +subroutine FWrap_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FWrap_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FWrap_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + ! dummy + call RegPack(Buf, InData%dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FWrap_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FWrap_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FWrap_UnPackContState' + if (Buf%ErrStat /= ErrID_None) return + ! dummy + call RegUnpack(Buf, OutData%dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE FWrap_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(FWrap_DiscreteStateType), INTENT(IN) :: SrcDiscStateData TYPE(FWrap_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData @@ -903,103 +587,26 @@ SUBROUTINE FWrap_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) END SUBROUTINE FWrap_DestroyDiscState - SUBROUTINE FWrap_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FWrap_DiscreteStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_PackDiscState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! dummy - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%dummy - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE FWrap_PackDiscState - - SUBROUTINE FWrap_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FWrap_DiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_UnPackDiscState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%dummy = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE FWrap_UnPackDiscState +subroutine FWrap_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FWrap_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FWrap_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + ! dummy + call RegPack(Buf, InData%dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FWrap_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FWrap_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FWrap_UnPackDiscState' + if (Buf%ErrStat /= ErrID_None) return + ! dummy + call RegUnpack(Buf, OutData%dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE FWrap_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(FWrap_ConstraintStateType), INTENT(IN) :: SrcConstrStateData TYPE(FWrap_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData @@ -1032,103 +639,26 @@ SUBROUTINE FWrap_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) END SUBROUTINE FWrap_DestroyConstrState - SUBROUTINE FWrap_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FWrap_ConstraintStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_PackConstrState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! dummy - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%dummy - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE FWrap_PackConstrState - - SUBROUTINE FWrap_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FWrap_ConstraintStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_UnPackConstrState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%dummy = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE FWrap_UnPackConstrState +subroutine FWrap_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FWrap_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FWrap_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + ! dummy + call RegPack(Buf, InData%dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FWrap_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FWrap_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FWrap_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + ! dummy + call RegUnpack(Buf, OutData%dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE FWrap_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(FWrap_OtherStateType), INTENT(IN) :: SrcOtherStateData TYPE(FWrap_OtherStateType), INTENT(INOUT) :: DstOtherStateData @@ -1161,103 +691,26 @@ SUBROUTINE FWrap_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) END SUBROUTINE FWrap_DestroyOtherState - SUBROUTINE FWrap_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FWrap_OtherStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_PackOtherState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! dummy - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%dummy - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FWrap_PackOtherState - - SUBROUTINE FWrap_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FWrap_OtherStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_UnPackOtherState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%dummy = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FWrap_UnPackOtherState +subroutine FWrap_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FWrap_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FWrap_PackOtherState' + if (Buf%ErrStat >= AbortErrLev) return + ! dummy + call RegPack(Buf, InData%dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FWrap_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FWrap_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FWrap_UnPackOtherState' + if (Buf%ErrStat /= ErrID_None) return + ! dummy + call RegUnpack(Buf, OutData%dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE FWrap_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) TYPE(FWrap_MiscVarType), INTENT(INOUT) :: SrcMiscData TYPE(FWrap_MiscVarType), INTENT(INOUT) :: DstMiscData @@ -1387,665 +840,139 @@ SUBROUTINE FWrap_DestroyMisc( MiscData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE FWrap_DestroyMisc - SUBROUTINE FWrap_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FWrap_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Turbine: size of buffers for each call to pack subtype - CALL FAST_PackTurbineType( Re_Buf, Db_Buf, Int_Buf, InData%Turbine, ErrStat2, ErrMsg2, .TRUE. ) ! Turbine - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Turbine - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Turbine - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Turbine - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! TempDisp allocated yes/no - IF ( ALLOCATED(InData%TempDisp) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TempDisp upper/lower bounds for each dimension - DO i1 = LBOUND(InData%TempDisp,1), UBOUND(InData%TempDisp,1) - Int_BufSz = Int_BufSz + 3 ! TempDisp: size of buffers for each call to pack subtype - CALL MeshPack( InData%TempDisp(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TempDisp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TempDisp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TempDisp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TempDisp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! TempLoads allocated yes/no - IF ( ALLOCATED(InData%TempLoads) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TempLoads upper/lower bounds for each dimension - DO i1 = LBOUND(InData%TempLoads,1), UBOUND(InData%TempLoads,1) - Int_BufSz = Int_BufSz + 3 ! TempLoads: size of buffers for each call to pack subtype - CALL MeshPack( InData%TempLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TempLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TempLoads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TempLoads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TempLoads - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! ADRotorDisk allocated yes/no - IF ( ALLOCATED(InData%ADRotorDisk) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ADRotorDisk upper/lower bounds for each dimension - DO i1 = LBOUND(InData%ADRotorDisk,1), UBOUND(InData%ADRotorDisk,1) - Int_BufSz = Int_BufSz + 3 ! ADRotorDisk: size of buffers for each call to pack subtype - CALL MeshPack( InData%ADRotorDisk(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! ADRotorDisk - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ADRotorDisk - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ADRotorDisk - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ADRotorDisk - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! AD_L2L allocated yes/no - IF ( ALLOCATED(InData%AD_L2L) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AD_L2L upper/lower bounds for each dimension - DO i1 = LBOUND(InData%AD_L2L,1), UBOUND(InData%AD_L2L,1) - Int_BufSz = Int_BufSz + 3 ! AD_L2L: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%AD_L2L(i1), ErrStat2, ErrMsg2, .TRUE. ) ! AD_L2L - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD_L2L - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD_L2L - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD_L2L - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL FAST_PackTurbineType( Re_Buf, Db_Buf, Int_Buf, InData%Turbine, ErrStat2, ErrMsg2, OnlySize ) ! Turbine - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%TempDisp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TempDisp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TempDisp,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TempDisp,1), UBOUND(InData%TempDisp,1) - CALL MeshPack( InData%TempDisp(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TempDisp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TempLoads) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TempLoads,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TempLoads,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TempLoads,1), UBOUND(InData%TempLoads,1) - CALL MeshPack( InData%TempLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TempLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ADRotorDisk) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ADRotorDisk,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ADRotorDisk,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ADRotorDisk,1), UBOUND(InData%ADRotorDisk,1) - CALL MeshPack( InData%ADRotorDisk(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! ADRotorDisk - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AD_L2L) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AD_L2L,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AD_L2L,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AD_L2L,1), UBOUND(InData%AD_L2L,1) - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%AD_L2L(i1), ErrStat2, ErrMsg2, OnlySize ) ! AD_L2L - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - END SUBROUTINE FWrap_PackMisc - - SUBROUTINE FWrap_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FWrap_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FAST_UnpackTurbineType( Re_Buf, Db_Buf, Int_Buf, OutData%Turbine, ErrStat2, ErrMsg2 ) ! Turbine - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TempDisp not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TempDisp)) DEALLOCATE(OutData%TempDisp) - ALLOCATE(OutData%TempDisp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TempDisp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TempDisp,1), UBOUND(OutData%TempDisp,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%TempDisp(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TempDisp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TempLoads not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TempLoads)) DEALLOCATE(OutData%TempLoads) - ALLOCATE(OutData%TempLoads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TempLoads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TempLoads,1), UBOUND(OutData%TempLoads,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%TempLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TempLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ADRotorDisk not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ADRotorDisk)) DEALLOCATE(OutData%ADRotorDisk) - ALLOCATE(OutData%ADRotorDisk(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ADRotorDisk.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ADRotorDisk,1), UBOUND(OutData%ADRotorDisk,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%ADRotorDisk(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! ADRotorDisk - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AD_L2L not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AD_L2L)) DEALLOCATE(OutData%AD_L2L) - ALLOCATE(OutData%AD_L2L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AD_L2L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AD_L2L,1), UBOUND(OutData%AD_L2L,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%AD_L2L(i1), ErrStat2, ErrMsg2 ) ! AD_L2L - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - END SUBROUTINE FWrap_UnPackMisc +subroutine FWrap_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FWrap_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FWrap_PackMisc' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! Turbine + call FAST_PackTurbineType(Buf, InData%Turbine) + if (RegCheckErr(Buf, RoutineName)) return + ! TempDisp + call RegPack(Buf, allocated(InData%TempDisp)) + if (allocated(InData%TempDisp)) then + call RegPackBounds(Buf, 1, lbound(InData%TempDisp), ubound(InData%TempDisp)) + LB(1:1) = lbound(InData%TempDisp) + UB(1:1) = ubound(InData%TempDisp) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%TempDisp(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TempLoads + call RegPack(Buf, allocated(InData%TempLoads)) + if (allocated(InData%TempLoads)) then + call RegPackBounds(Buf, 1, lbound(InData%TempLoads), ubound(InData%TempLoads)) + LB(1:1) = lbound(InData%TempLoads) + UB(1:1) = ubound(InData%TempLoads) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%TempLoads(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ADRotorDisk + call RegPack(Buf, allocated(InData%ADRotorDisk)) + if (allocated(InData%ADRotorDisk)) then + call RegPackBounds(Buf, 1, lbound(InData%ADRotorDisk), ubound(InData%ADRotorDisk)) + LB(1:1) = lbound(InData%ADRotorDisk) + UB(1:1) = ubound(InData%ADRotorDisk) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%ADRotorDisk(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AD_L2L + call RegPack(Buf, allocated(InData%AD_L2L)) + if (allocated(InData%AD_L2L)) then + call RegPackBounds(Buf, 1, lbound(InData%AD_L2L), ubound(InData%AD_L2L)) + LB(1:1) = lbound(InData%AD_L2L) + UB(1:1) = ubound(InData%AD_L2L) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%AD_L2L(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FWrap_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FWrap_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FWrap_UnPackMisc' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! Turbine + call FAST_UnpackTurbineType(Buf, OutData%Turbine) ! Turbine + ! TempDisp + if (allocated(OutData%TempDisp)) deallocate(OutData%TempDisp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TempDisp(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TempDisp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%TempDisp(i1)) ! TempDisp + end do + end if + ! TempLoads + if (allocated(OutData%TempLoads)) deallocate(OutData%TempLoads) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TempLoads(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TempLoads.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%TempLoads(i1)) ! TempLoads + end do + end if + ! ADRotorDisk + if (allocated(OutData%ADRotorDisk)) deallocate(OutData%ADRotorDisk) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ADRotorDisk(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ADRotorDisk.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%ADRotorDisk(i1)) ! ADRotorDisk + end do + end if + ! AD_L2L + if (allocated(OutData%AD_L2L)) deallocate(OutData%AD_L2L) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AD_L2L(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AD_L2L.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%AD_L2L(i1)) ! AD_L2L + end do + end if +end subroutine SUBROUTINE FWrap_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(FWrap_ParameterType), INTENT(IN) :: SrcParamData TYPE(FWrap_ParameterType), INTENT(INOUT) :: DstParamData @@ -2096,158 +1023,63 @@ SUBROUTINE FWrap_DestroyParam( ParamData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE FWrap_DestroyParam - SUBROUTINE FWrap_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FWrap_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! nr - Int_BufSz = Int_BufSz + 1 ! r allocated yes/no - IF ( ALLOCATED(InData%r) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! r upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%r) ! r - END IF - Int_BufSz = Int_BufSz + 1 ! n_FAST_low - Re_BufSz = Re_BufSz + SIZE(InData%p_ref_Turbine) ! p_ref_Turbine - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%nr - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%r) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%r,1), UBOUND(InData%r,1) - ReKiBuf(Re_Xferred) = InData%r(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%n_FAST_low - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%p_ref_Turbine,1), UBOUND(InData%p_ref_Turbine,1) - ReKiBuf(Re_Xferred) = InData%p_ref_Turbine(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE FWrap_PackParam - - SUBROUTINE FWrap_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FWrap_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%nr = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%r)) DEALLOCATE(OutData%r) - ALLOCATE(OutData%r(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%r.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%r,1), UBOUND(OutData%r,1) - OutData%r(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%n_FAST_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%p_ref_Turbine,1) - i1_u = UBOUND(OutData%p_ref_Turbine,1) - DO i1 = LBOUND(OutData%p_ref_Turbine,1), UBOUND(OutData%p_ref_Turbine,1) - OutData%p_ref_Turbine(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE FWrap_UnPackParam +subroutine FWrap_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FWrap_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FWrap_PackParam' + if (Buf%ErrStat >= AbortErrLev) return + ! nr + call RegPack(Buf, InData%nr) + if (RegCheckErr(Buf, RoutineName)) return + ! r + call RegPack(Buf, allocated(InData%r)) + if (allocated(InData%r)) then + call RegPackBounds(Buf, 1, lbound(InData%r), ubound(InData%r)) + call RegPack(Buf, InData%r) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! n_FAST_low + call RegPack(Buf, InData%n_FAST_low) + if (RegCheckErr(Buf, RoutineName)) return + ! p_ref_Turbine + call RegPack(Buf, InData%p_ref_Turbine) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FWrap_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FWrap_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FWrap_UnPackParam' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! nr + call RegUnpack(Buf, OutData%nr) + if (RegCheckErr(Buf, RoutineName)) return + ! r + if (allocated(OutData%r)) deallocate(OutData%r) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%r(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%r.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%r) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! n_FAST_low + call RegUnpack(Buf, OutData%n_FAST_low) + if (RegCheckErr(Buf, RoutineName)) return + ! p_ref_Turbine + call RegUnpack(Buf, OutData%p_ref_Turbine) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE FWrap_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(FWrap_InputType), INTENT(IN) :: SrcInputData TYPE(FWrap_InputType), INTENT(INOUT) :: DstInputData @@ -2310,175 +1142,67 @@ SUBROUTINE FWrap_DestroyInput( InputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE FWrap_DestroyInput - SUBROUTINE FWrap_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FWrap_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! fromSCglob allocated yes/no - IF ( ALLOCATED(InData%fromSCglob) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! fromSCglob upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fromSCglob) ! fromSCglob - END IF - Int_BufSz = Int_BufSz + 1 ! fromSC allocated yes/no - IF ( ALLOCATED(InData%fromSC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! fromSC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fromSC) ! fromSC - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%fromSCglob) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fromSCglob,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fromSCglob,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%fromSCglob,1), UBOUND(InData%fromSCglob,1) - ReKiBuf(Re_Xferred) = InData%fromSCglob(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%fromSC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fromSC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fromSC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%fromSC,1), UBOUND(InData%fromSC,1) - ReKiBuf(Re_Xferred) = InData%fromSC(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FWrap_PackInput - - SUBROUTINE FWrap_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FWrap_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fromSCglob not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%fromSCglob)) DEALLOCATE(OutData%fromSCglob) - ALLOCATE(OutData%fromSCglob(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSCglob.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%fromSCglob,1), UBOUND(OutData%fromSCglob,1) - OutData%fromSCglob(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fromSC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%fromSC)) DEALLOCATE(OutData%fromSC) - ALLOCATE(OutData%fromSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%fromSC,1), UBOUND(OutData%fromSC,1) - OutData%fromSC(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FWrap_UnPackInput +subroutine FWrap_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FWrap_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FWrap_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + ! fromSCglob + call RegPack(Buf, allocated(InData%fromSCglob)) + if (allocated(InData%fromSCglob)) then + call RegPackBounds(Buf, 1, lbound(InData%fromSCglob), ubound(InData%fromSCglob)) + call RegPack(Buf, InData%fromSCglob) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! fromSC + call RegPack(Buf, allocated(InData%fromSC)) + if (allocated(InData%fromSC)) then + call RegPackBounds(Buf, 1, lbound(InData%fromSC), ubound(InData%fromSC)) + call RegPack(Buf, InData%fromSC) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FWrap_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FWrap_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FWrap_UnPackInput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! fromSCglob + if (allocated(OutData%fromSCglob)) deallocate(OutData%fromSCglob) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%fromSCglob(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSCglob.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%fromSCglob) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! fromSC + if (allocated(OutData%fromSC)) deallocate(OutData%fromSC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%fromSC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%fromSC) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE FWrap_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(FWrap_OutputType), INTENT(IN) :: SrcOutputData TYPE(FWrap_OutputType), INTENT(INOUT) :: DstOutputData @@ -2563,259 +1287,130 @@ SUBROUTINE FWrap_DestroyOutput( OutputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE FWrap_DestroyOutput - SUBROUTINE FWrap_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FWrap_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! toSC allocated yes/no - IF ( ALLOCATED(InData%toSC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! toSC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%toSC) ! toSC - END IF - Re_BufSz = Re_BufSz + SIZE(InData%xHat_Disk) ! xHat_Disk - Re_BufSz = Re_BufSz + 1 ! YawErr - Re_BufSz = Re_BufSz + 1 ! psi_skew - Re_BufSz = Re_BufSz + 1 ! chi_skew - Re_BufSz = Re_BufSz + SIZE(InData%p_hub) ! p_hub - Re_BufSz = Re_BufSz + 1 ! D_rotor - Re_BufSz = Re_BufSz + 1 ! DiskAvg_Vx_Rel - Int_BufSz = Int_BufSz + 1 ! AzimAvg_Ct allocated yes/no - IF ( ALLOCATED(InData%AzimAvg_Ct) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AzimAvg_Ct upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AzimAvg_Ct) ! AzimAvg_Ct - END IF - Int_BufSz = Int_BufSz + 1 ! AzimAvg_Cq allocated yes/no - IF ( ALLOCATED(InData%AzimAvg_Cq) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AzimAvg_Cq upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AzimAvg_Cq) ! AzimAvg_Cq - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%toSC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%toSC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%toSC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%toSC,1), UBOUND(InData%toSC,1) - ReKiBuf(Re_Xferred) = InData%toSC(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DO i1 = LBOUND(InData%xHat_Disk,1), UBOUND(InData%xHat_Disk,1) - ReKiBuf(Re_Xferred) = InData%xHat_Disk(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%YawErr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%psi_skew - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%chi_skew - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%p_hub,1), UBOUND(InData%p_hub,1) - ReKiBuf(Re_Xferred) = InData%p_hub(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%D_rotor - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DiskAvg_Vx_Rel - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%AzimAvg_Ct) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AzimAvg_Ct,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AzimAvg_Ct,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AzimAvg_Ct,1), UBOUND(InData%AzimAvg_Ct,1) - ReKiBuf(Re_Xferred) = InData%AzimAvg_Ct(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AzimAvg_Cq) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AzimAvg_Cq,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AzimAvg_Cq,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AzimAvg_Cq,1), UBOUND(InData%AzimAvg_Cq,1) - ReKiBuf(Re_Xferred) = InData%AzimAvg_Cq(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FWrap_PackOutput - - SUBROUTINE FWrap_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FWrap_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! toSC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%toSC)) DEALLOCATE(OutData%toSC) - ALLOCATE(OutData%toSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%toSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%toSC,1), UBOUND(OutData%toSC,1) - OutData%toSC(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - i1_l = LBOUND(OutData%xHat_Disk,1) - i1_u = UBOUND(OutData%xHat_Disk,1) - DO i1 = LBOUND(OutData%xHat_Disk,1), UBOUND(OutData%xHat_Disk,1) - OutData%xHat_Disk(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%YawErr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%psi_skew = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%chi_skew = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%p_hub,1) - i1_u = UBOUND(OutData%p_hub,1) - DO i1 = LBOUND(OutData%p_hub,1), UBOUND(OutData%p_hub,1) - OutData%p_hub(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%D_rotor = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DiskAvg_Vx_Rel = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AzimAvg_Ct not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AzimAvg_Ct)) DEALLOCATE(OutData%AzimAvg_Ct) - ALLOCATE(OutData%AzimAvg_Ct(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AzimAvg_Ct.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AzimAvg_Ct,1), UBOUND(OutData%AzimAvg_Ct,1) - OutData%AzimAvg_Ct(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AzimAvg_Cq not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AzimAvg_Cq)) DEALLOCATE(OutData%AzimAvg_Cq) - ALLOCATE(OutData%AzimAvg_Cq(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AzimAvg_Cq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AzimAvg_Cq,1), UBOUND(OutData%AzimAvg_Cq,1) - OutData%AzimAvg_Cq(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FWrap_UnPackOutput +subroutine FWrap_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FWrap_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FWrap_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! toSC + call RegPack(Buf, allocated(InData%toSC)) + if (allocated(InData%toSC)) then + call RegPackBounds(Buf, 1, lbound(InData%toSC), ubound(InData%toSC)) + call RegPack(Buf, InData%toSC) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! xHat_Disk + call RegPack(Buf, InData%xHat_Disk) + if (RegCheckErr(Buf, RoutineName)) return + ! YawErr + call RegPack(Buf, InData%YawErr) + if (RegCheckErr(Buf, RoutineName)) return + ! psi_skew + call RegPack(Buf, InData%psi_skew) + if (RegCheckErr(Buf, RoutineName)) return + ! chi_skew + call RegPack(Buf, InData%chi_skew) + if (RegCheckErr(Buf, RoutineName)) return + ! p_hub + call RegPack(Buf, InData%p_hub) + if (RegCheckErr(Buf, RoutineName)) return + ! D_rotor + call RegPack(Buf, InData%D_rotor) + if (RegCheckErr(Buf, RoutineName)) return + ! DiskAvg_Vx_Rel + call RegPack(Buf, InData%DiskAvg_Vx_Rel) + if (RegCheckErr(Buf, RoutineName)) return + ! AzimAvg_Ct + call RegPack(Buf, allocated(InData%AzimAvg_Ct)) + if (allocated(InData%AzimAvg_Ct)) then + call RegPackBounds(Buf, 1, lbound(InData%AzimAvg_Ct), ubound(InData%AzimAvg_Ct)) + call RegPack(Buf, InData%AzimAvg_Ct) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AzimAvg_Cq + call RegPack(Buf, allocated(InData%AzimAvg_Cq)) + if (allocated(InData%AzimAvg_Cq)) then + call RegPackBounds(Buf, 1, lbound(InData%AzimAvg_Cq), ubound(InData%AzimAvg_Cq)) + call RegPack(Buf, InData%AzimAvg_Cq) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FWrap_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FWrap_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FWrap_UnPackOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! toSC + if (allocated(OutData%toSC)) deallocate(OutData%toSC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%toSC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%toSC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%toSC) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! xHat_Disk + call RegUnpack(Buf, OutData%xHat_Disk) + if (RegCheckErr(Buf, RoutineName)) return + ! YawErr + call RegUnpack(Buf, OutData%YawErr) + if (RegCheckErr(Buf, RoutineName)) return + ! psi_skew + call RegUnpack(Buf, OutData%psi_skew) + if (RegCheckErr(Buf, RoutineName)) return + ! chi_skew + call RegUnpack(Buf, OutData%chi_skew) + if (RegCheckErr(Buf, RoutineName)) return + ! p_hub + call RegUnpack(Buf, OutData%p_hub) + if (RegCheckErr(Buf, RoutineName)) return + ! D_rotor + call RegUnpack(Buf, OutData%D_rotor) + if (RegCheckErr(Buf, RoutineName)) return + ! DiskAvg_Vx_Rel + call RegUnpack(Buf, OutData%DiskAvg_Vx_Rel) + if (RegCheckErr(Buf, RoutineName)) return + ! AzimAvg_Ct + if (allocated(OutData%AzimAvg_Ct)) deallocate(OutData%AzimAvg_Ct) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AzimAvg_Ct(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AzimAvg_Ct.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AzimAvg_Ct) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AzimAvg_Cq + if (allocated(OutData%AzimAvg_Cq)) deallocate(OutData%AzimAvg_Cq) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AzimAvg_Cq(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AzimAvg_Cq.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AzimAvg_Cq) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine END MODULE FASTWrapper_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/glue-codes/fast-farm/src/FAST_Farm_Types.f90 b/glue-codes/fast-farm/src/FAST_Farm_Types.f90 index 51203da76d..4bbe757f1e 100644 --- a/glue-codes/fast-farm/src/FAST_Farm_Types.f90 +++ b/glue-codes/fast-farm/src/FAST_Farm_Types.f90 @@ -405,851 +405,478 @@ SUBROUTINE Farm_DestroyParam( ParamData, ErrStat, ErrMsg ) ENDDO END SUBROUTINE Farm_DestroyParam - SUBROUTINE Farm_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Farm_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Farm_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! DT_low - Db_BufSz = Db_BufSz + 1 ! DT_high - Db_BufSz = Db_BufSz + 1 ! TMax - Int_BufSz = Int_BufSz + 1 ! n_high_low - Int_BufSz = Int_BufSz + 1 ! NumTurbines - Int_BufSz = Int_BufSz + 1*LEN(InData%WindFilePath) ! WindFilePath - Int_BufSz = Int_BufSz + 1*LEN(InData%SC_FileName) ! SC_FileName - Int_BufSz = Int_BufSz + 1 ! UseSC - Int_BufSz = Int_BufSz + 1 ! WT_Position allocated yes/no - IF ( ALLOCATED(InData%WT_Position) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WT_Position upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WT_Position) ! WT_Position - END IF - Int_BufSz = Int_BufSz + 1 ! WaveFieldMod - Int_BufSz = Int_BufSz + 1 ! MooringMod - Int_BufSz = Int_BufSz + 1*LEN(InData%MD_FileName) ! MD_FileName - Db_BufSz = Db_BufSz + 1 ! DT_mooring - Int_BufSz = Int_BufSz + 1 ! n_mooring - Int_BufSz = Int_BufSz + 1 ! WT_FASTInFile allocated yes/no - IF ( ALLOCATED(InData%WT_FASTInFile) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WT_FASTInFile upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WT_FASTInFile)*LEN(InData%WT_FASTInFile) ! WT_FASTInFile - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%FTitle) ! FTitle - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFileRoot) ! OutFileRoot - Int_BufSz = Int_BufSz + 1 ! n_ChkptTime - Db_BufSz = Db_BufSz + 1 ! TStart - Int_BufSz = Int_BufSz + 1 ! n_TMax - Int_BufSz = Int_BufSz + 1 ! SumPrint - Int_BufSz = Int_BufSz + 1 ! WrBinOutFile - Int_BufSz = Int_BufSz + 1 ! WrTxtOutFile - Int_BufSz = Int_BufSz + 1*LEN(InData%Delim) ! Delim - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt_t) ! OutFmt_t - Int_BufSz = Int_BufSz + 1 ! FmtWidth - Int_BufSz = Int_BufSz + 1 ! TChanLen - Int_BufSz = Int_BufSz + 1 ! NOutTurb - Int_BufSz = Int_BufSz + 1 ! NOutRadii - Int_BufSz = Int_BufSz + 1 ! OutRadii allocated yes/no - IF ( ALLOCATED(InData%OutRadii) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutRadii upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%OutRadii) ! OutRadii - END IF - Int_BufSz = Int_BufSz + 1 ! NOutDist - Int_BufSz = Int_BufSz + 1 ! OutDist allocated yes/no - IF ( ALLOCATED(InData%OutDist) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutDist upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OutDist) ! OutDist - END IF - Int_BufSz = Int_BufSz + 1 ! NWindVel - Int_BufSz = Int_BufSz + 1 ! WindVelX allocated yes/no - IF ( ALLOCATED(InData%WindVelX) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WindVelX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WindVelX) ! WindVelX - END IF - Int_BufSz = Int_BufSz + 1 ! WindVelY allocated yes/no - IF ( ALLOCATED(InData%WindVelY) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WindVelY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WindVelY) ! WindVelY - END IF - Int_BufSz = Int_BufSz + 1 ! WindVelZ allocated yes/no - IF ( ALLOCATED(InData%WindVelZ) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WindVelZ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WindVelZ) ! WindVelZ - END IF - Int_BufSz = Int_BufSz + 1 ! OutParam allocated yes/no - IF ( ALLOCATED(InData%OutParam) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutParam upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - Int_BufSz = Int_BufSz + 3 ! OutParam: size of buffers for each call to pack subtype - CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutParam - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutParam - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutParam - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! NOutSteps - Int_BufSz = Int_BufSz + SIZE(InData%FileDescLines)*LEN(InData%FileDescLines) ! FileDescLines - DO i1 = LBOUND(InData%Module_Ver,1), UBOUND(InData%Module_Ver,1) - Int_BufSz = Int_BufSz + 3 ! Module_Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Module_Ver(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Module_Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Module_Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Module_Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Module_Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 1 ! UnOu - Re_BufSz = Re_BufSz + 1 ! dX_low - Re_BufSz = Re_BufSz + 1 ! dY_low - Re_BufSz = Re_BufSz + 1 ! dZ_low - Int_BufSz = Int_BufSz + 1 ! nX_low - Int_BufSz = Int_BufSz + 1 ! nY_low - Int_BufSz = Int_BufSz + 1 ! nZ_low - Re_BufSz = Re_BufSz + 1 ! X0_low - Re_BufSz = Re_BufSz + 1 ! Y0_low - Re_BufSz = Re_BufSz + 1 ! Z0_low - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%DT_low - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%DT_high - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TMax - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%n_high_low - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumTurbines - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%WindFilePath) - IntKiBuf(Int_Xferred) = ICHAR(InData%WindFilePath(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%SC_FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%SC_FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseSC, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WT_Position) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WT_Position,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WT_Position,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WT_Position,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WT_Position,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WT_Position,2), UBOUND(InData%WT_Position,2) - DO i1 = LBOUND(InData%WT_Position,1), UBOUND(InData%WT_Position,1) - ReKiBuf(Re_Xferred) = InData%WT_Position(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%WaveFieldMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MooringMod - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%MD_FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%MD_FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf(Db_Xferred) = InData%DT_mooring - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%n_mooring - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WT_FASTInFile) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WT_FASTInFile,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WT_FASTInFile,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WT_FASTInFile,1), UBOUND(InData%WT_FASTInFile,1) - DO I = 1, LEN(InData%WT_FASTInFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%WT_FASTInFile(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - DO I = 1, LEN(InData%FTitle) - IntKiBuf(Int_Xferred) = ICHAR(InData%FTitle(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutFileRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFileRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%n_ChkptTime - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TStart - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%n_TMax - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WrBinOutFile, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WrTxtOutFile, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutFmt_t) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt_t(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%FmtWidth - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TChanLen - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NOutTurb - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NOutRadii - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutRadii) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutRadii,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutRadii,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutRadii,1), UBOUND(InData%OutRadii,1) - IntKiBuf(Int_Xferred) = InData%OutRadii(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NOutDist - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutDist) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutDist,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutDist,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutDist,1), UBOUND(InData%OutDist,1) - ReKiBuf(Re_Xferred) = InData%OutDist(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NWindVel - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WindVelX) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WindVelX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindVelX,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WindVelX,1), UBOUND(InData%WindVelX,1) - ReKiBuf(Re_Xferred) = InData%WindVelX(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WindVelY) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WindVelY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindVelY,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WindVelY,1), UBOUND(InData%WindVelY,1) - ReKiBuf(Re_Xferred) = InData%WindVelY(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WindVelZ) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WindVelZ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindVelZ,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WindVelZ,1), UBOUND(InData%WindVelZ,1) - ReKiBuf(Re_Xferred) = InData%WindVelZ(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutParam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParam,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NOutSteps - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%FileDescLines,1), UBOUND(InData%FileDescLines,1) - DO I = 1, LEN(InData%FileDescLines) - IntKiBuf(Int_Xferred) = ICHAR(InData%FileDescLines(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - DO i1 = LBOUND(InData%Module_Ver,1), UBOUND(InData%Module_Ver,1) - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Module_Ver(i1), ErrStat2, ErrMsg2, OnlySize ) ! Module_Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - IntKiBuf(Int_Xferred) = InData%UnOu - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dX_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dY_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dZ_low - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nX_low - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nY_low - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nZ_low - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%X0_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Y0_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Z0_low - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Farm_PackParam - - SUBROUTINE Farm_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Farm_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Farm_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DT_low = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%DT_high = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%TMax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%n_high_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumTurbines = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%WindFilePath) - OutData%WindFilePath(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%SC_FileName) - OutData%SC_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UseSC = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseSC) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WT_Position not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WT_Position)) DEALLOCATE(OutData%WT_Position) - ALLOCATE(OutData%WT_Position(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WT_Position.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WT_Position,2), UBOUND(OutData%WT_Position,2) - DO i1 = LBOUND(OutData%WT_Position,1), UBOUND(OutData%WT_Position,1) - OutData%WT_Position(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%WaveFieldMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MooringMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%MD_FileName) - OutData%MD_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%DT_mooring = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%n_mooring = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WT_FASTInFile not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WT_FASTInFile)) DEALLOCATE(OutData%WT_FASTInFile) - ALLOCATE(OutData%WT_FASTInFile(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WT_FASTInFile.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WT_FASTInFile,1), UBOUND(OutData%WT_FASTInFile,1) - DO I = 1, LEN(OutData%WT_FASTInFile) - OutData%WT_FASTInFile(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - DO I = 1, LEN(OutData%FTitle) - OutData%FTitle(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutFileRoot) - OutData%OutFileRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%n_ChkptTime = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TStart = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%n_TMax = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) - Int_Xferred = Int_Xferred + 1 - OutData%WrBinOutFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%WrBinOutFile) - Int_Xferred = Int_Xferred + 1 - OutData%WrTxtOutFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%WrTxtOutFile) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutFmt_t) - OutData%OutFmt_t(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%FmtWidth = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TChanLen = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NOutTurb = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NOutRadii = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutRadii not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutRadii)) DEALLOCATE(OutData%OutRadii) - ALLOCATE(OutData%OutRadii(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutRadii.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutRadii,1), UBOUND(OutData%OutRadii,1) - OutData%OutRadii(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%NOutDist = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutDist not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutDist)) DEALLOCATE(OutData%OutDist) - ALLOCATE(OutData%OutDist(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutDist.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutDist,1), UBOUND(OutData%OutDist,1) - OutData%OutDist(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%NWindVel = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindVelX not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WindVelX)) DEALLOCATE(OutData%WindVelX) - ALLOCATE(OutData%WindVelX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindVelX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WindVelX,1), UBOUND(OutData%WindVelX,1) - OutData%WindVelX(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindVelY not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WindVelY)) DEALLOCATE(OutData%WindVelY) - ALLOCATE(OutData%WindVelY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindVelY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WindVelY,1), UBOUND(OutData%WindVelY,1) - OutData%WindVelY(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindVelZ not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WindVelZ)) DEALLOCATE(OutData%WindVelZ) - ALLOCATE(OutData%WindVelZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindVelZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WindVelZ,1), UBOUND(OutData%WindVelZ,1) - OutData%WindVelZ(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutParam)) DEALLOCATE(OutData%OutParam) - ALLOCATE(OutData%OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutParam,1), UBOUND(OutData%OutParam,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackOutParmType( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NOutSteps = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%FileDescLines,1) - i1_u = UBOUND(OutData%FileDescLines,1) - DO i1 = LBOUND(OutData%FileDescLines,1), UBOUND(OutData%FileDescLines,1) - DO I = 1, LEN(OutData%FileDescLines) - OutData%FileDescLines(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - i1_l = LBOUND(OutData%Module_Ver,1) - i1_u = UBOUND(OutData%Module_Ver,1) - DO i1 = LBOUND(OutData%Module_Ver,1), UBOUND(OutData%Module_Ver,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Module_Ver(i1), ErrStat2, ErrMsg2 ) ! Module_Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - OutData%UnOu = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%dX_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dY_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dZ_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%nX_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nY_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nZ_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%X0_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Y0_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Z0_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Farm_UnPackParam +subroutine Farm_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Farm_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Farm_PackParam' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + ! DT_low + call RegPack(Buf, InData%DT_low) + if (RegCheckErr(Buf, RoutineName)) return + ! DT_high + call RegPack(Buf, InData%DT_high) + if (RegCheckErr(Buf, RoutineName)) return + ! TMax + call RegPack(Buf, InData%TMax) + if (RegCheckErr(Buf, RoutineName)) return + ! n_high_low + call RegPack(Buf, InData%n_high_low) + if (RegCheckErr(Buf, RoutineName)) return + ! NumTurbines + call RegPack(Buf, InData%NumTurbines) + if (RegCheckErr(Buf, RoutineName)) return + ! WindFilePath + call RegPack(Buf, InData%WindFilePath) + if (RegCheckErr(Buf, RoutineName)) return + ! SC_FileName + call RegPack(Buf, InData%SC_FileName) + if (RegCheckErr(Buf, RoutineName)) return + ! UseSC + call RegPack(Buf, InData%UseSC) + if (RegCheckErr(Buf, RoutineName)) return + ! WT_Position + call RegPack(Buf, allocated(InData%WT_Position)) + if (allocated(InData%WT_Position)) then + call RegPackBounds(Buf, 2, lbound(InData%WT_Position), ubound(InData%WT_Position)) + call RegPack(Buf, InData%WT_Position) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveFieldMod + call RegPack(Buf, InData%WaveFieldMod) + if (RegCheckErr(Buf, RoutineName)) return + ! MooringMod + call RegPack(Buf, InData%MooringMod) + if (RegCheckErr(Buf, RoutineName)) return + ! MD_FileName + call RegPack(Buf, InData%MD_FileName) + if (RegCheckErr(Buf, RoutineName)) return + ! DT_mooring + call RegPack(Buf, InData%DT_mooring) + if (RegCheckErr(Buf, RoutineName)) return + ! n_mooring + call RegPack(Buf, InData%n_mooring) + if (RegCheckErr(Buf, RoutineName)) return + ! WT_FASTInFile + call RegPack(Buf, allocated(InData%WT_FASTInFile)) + if (allocated(InData%WT_FASTInFile)) then + call RegPackBounds(Buf, 1, lbound(InData%WT_FASTInFile), ubound(InData%WT_FASTInFile)) + call RegPack(Buf, InData%WT_FASTInFile) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FTitle + call RegPack(Buf, InData%FTitle) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFileRoot + call RegPack(Buf, InData%OutFileRoot) + if (RegCheckErr(Buf, RoutineName)) return + ! n_ChkptTime + call RegPack(Buf, InData%n_ChkptTime) + if (RegCheckErr(Buf, RoutineName)) return + ! TStart + call RegPack(Buf, InData%TStart) + if (RegCheckErr(Buf, RoutineName)) return + ! n_TMax + call RegPack(Buf, InData%n_TMax) + if (RegCheckErr(Buf, RoutineName)) return + ! SumPrint + call RegPack(Buf, InData%SumPrint) + if (RegCheckErr(Buf, RoutineName)) return + ! WrBinOutFile + call RegPack(Buf, InData%WrBinOutFile) + if (RegCheckErr(Buf, RoutineName)) return + ! WrTxtOutFile + call RegPack(Buf, InData%WrTxtOutFile) + if (RegCheckErr(Buf, RoutineName)) return + ! Delim + call RegPack(Buf, InData%Delim) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFmt + call RegPack(Buf, InData%OutFmt) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFmt_t + call RegPack(Buf, InData%OutFmt_t) + if (RegCheckErr(Buf, RoutineName)) return + ! FmtWidth + call RegPack(Buf, InData%FmtWidth) + if (RegCheckErr(Buf, RoutineName)) return + ! TChanLen + call RegPack(Buf, InData%TChanLen) + if (RegCheckErr(Buf, RoutineName)) return + ! NOutTurb + call RegPack(Buf, InData%NOutTurb) + if (RegCheckErr(Buf, RoutineName)) return + ! NOutRadii + call RegPack(Buf, InData%NOutRadii) + if (RegCheckErr(Buf, RoutineName)) return + ! OutRadii + call RegPack(Buf, allocated(InData%OutRadii)) + if (allocated(InData%OutRadii)) then + call RegPackBounds(Buf, 1, lbound(InData%OutRadii), ubound(InData%OutRadii)) + call RegPack(Buf, InData%OutRadii) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NOutDist + call RegPack(Buf, InData%NOutDist) + if (RegCheckErr(Buf, RoutineName)) return + ! OutDist + call RegPack(Buf, allocated(InData%OutDist)) + if (allocated(InData%OutDist)) then + call RegPackBounds(Buf, 1, lbound(InData%OutDist), ubound(InData%OutDist)) + call RegPack(Buf, InData%OutDist) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NWindVel + call RegPack(Buf, InData%NWindVel) + if (RegCheckErr(Buf, RoutineName)) return + ! WindVelX + call RegPack(Buf, allocated(InData%WindVelX)) + if (allocated(InData%WindVelX)) then + call RegPackBounds(Buf, 1, lbound(InData%WindVelX), ubound(InData%WindVelX)) + call RegPack(Buf, InData%WindVelX) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WindVelY + call RegPack(Buf, allocated(InData%WindVelY)) + if (allocated(InData%WindVelY)) then + call RegPackBounds(Buf, 1, lbound(InData%WindVelY), ubound(InData%WindVelY)) + call RegPack(Buf, InData%WindVelY) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WindVelZ + call RegPack(Buf, allocated(InData%WindVelZ)) + if (allocated(InData%WindVelZ)) then + call RegPackBounds(Buf, 1, lbound(InData%WindVelZ), ubound(InData%WindVelZ)) + call RegPack(Buf, InData%WindVelZ) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OutParam + call RegPack(Buf, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegPack(Buf, InData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! NOutSteps + call RegPack(Buf, InData%NOutSteps) + if (RegCheckErr(Buf, RoutineName)) return + ! FileDescLines + call RegPack(Buf, InData%FileDescLines) + if (RegCheckErr(Buf, RoutineName)) return + ! Module_Ver + LB(1:1) = lbound(InData%Module_Ver) + UB(1:1) = ubound(InData%Module_Ver) + do i1 = LB(1), UB(1) + call NWTC_Library_PackProgDesc(Buf, InData%Module_Ver(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! UnOu + call RegPack(Buf, InData%UnOu) + if (RegCheckErr(Buf, RoutineName)) return + ! dX_low + call RegPack(Buf, InData%dX_low) + if (RegCheckErr(Buf, RoutineName)) return + ! dY_low + call RegPack(Buf, InData%dY_low) + if (RegCheckErr(Buf, RoutineName)) return + ! dZ_low + call RegPack(Buf, InData%dZ_low) + if (RegCheckErr(Buf, RoutineName)) return + ! nX_low + call RegPack(Buf, InData%nX_low) + if (RegCheckErr(Buf, RoutineName)) return + ! nY_low + call RegPack(Buf, InData%nY_low) + if (RegCheckErr(Buf, RoutineName)) return + ! nZ_low + call RegPack(Buf, InData%nZ_low) + if (RegCheckErr(Buf, RoutineName)) return + ! X0_low + call RegPack(Buf, InData%X0_low) + if (RegCheckErr(Buf, RoutineName)) return + ! Y0_low + call RegPack(Buf, InData%Y0_low) + if (RegCheckErr(Buf, RoutineName)) return + ! Z0_low + call RegPack(Buf, InData%Z0_low) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Farm_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Farm_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Farm_UnPackParam' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! DT_low + call RegUnpack(Buf, OutData%DT_low) + if (RegCheckErr(Buf, RoutineName)) return + ! DT_high + call RegUnpack(Buf, OutData%DT_high) + if (RegCheckErr(Buf, RoutineName)) return + ! TMax + call RegUnpack(Buf, OutData%TMax) + if (RegCheckErr(Buf, RoutineName)) return + ! n_high_low + call RegUnpack(Buf, OutData%n_high_low) + if (RegCheckErr(Buf, RoutineName)) return + ! NumTurbines + call RegUnpack(Buf, OutData%NumTurbines) + if (RegCheckErr(Buf, RoutineName)) return + ! WindFilePath + call RegUnpack(Buf, OutData%WindFilePath) + if (RegCheckErr(Buf, RoutineName)) return + ! SC_FileName + call RegUnpack(Buf, OutData%SC_FileName) + if (RegCheckErr(Buf, RoutineName)) return + ! UseSC + call RegUnpack(Buf, OutData%UseSC) + if (RegCheckErr(Buf, RoutineName)) return + ! WT_Position + if (allocated(OutData%WT_Position)) deallocate(OutData%WT_Position) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WT_Position(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WT_Position.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WT_Position) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WaveFieldMod + call RegUnpack(Buf, OutData%WaveFieldMod) + if (RegCheckErr(Buf, RoutineName)) return + ! MooringMod + call RegUnpack(Buf, OutData%MooringMod) + if (RegCheckErr(Buf, RoutineName)) return + ! MD_FileName + call RegUnpack(Buf, OutData%MD_FileName) + if (RegCheckErr(Buf, RoutineName)) return + ! DT_mooring + call RegUnpack(Buf, OutData%DT_mooring) + if (RegCheckErr(Buf, RoutineName)) return + ! n_mooring + call RegUnpack(Buf, OutData%n_mooring) + if (RegCheckErr(Buf, RoutineName)) return + ! WT_FASTInFile + if (allocated(OutData%WT_FASTInFile)) deallocate(OutData%WT_FASTInFile) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WT_FASTInFile(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WT_FASTInFile.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WT_FASTInFile) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! FTitle + call RegUnpack(Buf, OutData%FTitle) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFileRoot + call RegUnpack(Buf, OutData%OutFileRoot) + if (RegCheckErr(Buf, RoutineName)) return + ! n_ChkptTime + call RegUnpack(Buf, OutData%n_ChkptTime) + if (RegCheckErr(Buf, RoutineName)) return + ! TStart + call RegUnpack(Buf, OutData%TStart) + if (RegCheckErr(Buf, RoutineName)) return + ! n_TMax + call RegUnpack(Buf, OutData%n_TMax) + if (RegCheckErr(Buf, RoutineName)) return + ! SumPrint + call RegUnpack(Buf, OutData%SumPrint) + if (RegCheckErr(Buf, RoutineName)) return + ! WrBinOutFile + call RegUnpack(Buf, OutData%WrBinOutFile) + if (RegCheckErr(Buf, RoutineName)) return + ! WrTxtOutFile + call RegUnpack(Buf, OutData%WrTxtOutFile) + if (RegCheckErr(Buf, RoutineName)) return + ! Delim + call RegUnpack(Buf, OutData%Delim) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFmt + call RegUnpack(Buf, OutData%OutFmt) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFmt_t + call RegUnpack(Buf, OutData%OutFmt_t) + if (RegCheckErr(Buf, RoutineName)) return + ! FmtWidth + call RegUnpack(Buf, OutData%FmtWidth) + if (RegCheckErr(Buf, RoutineName)) return + ! TChanLen + call RegUnpack(Buf, OutData%TChanLen) + if (RegCheckErr(Buf, RoutineName)) return + ! NOutTurb + call RegUnpack(Buf, OutData%NOutTurb) + if (RegCheckErr(Buf, RoutineName)) return + ! NOutRadii + call RegUnpack(Buf, OutData%NOutRadii) + if (RegCheckErr(Buf, RoutineName)) return + ! OutRadii + if (allocated(OutData%OutRadii)) deallocate(OutData%OutRadii) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutRadii(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutRadii.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutRadii) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NOutDist + call RegUnpack(Buf, OutData%NOutDist) + if (RegCheckErr(Buf, RoutineName)) return + ! OutDist + if (allocated(OutData%OutDist)) deallocate(OutData%OutDist) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutDist(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutDist.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutDist) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NWindVel + call RegUnpack(Buf, OutData%NWindVel) + if (RegCheckErr(Buf, RoutineName)) return + ! WindVelX + if (allocated(OutData%WindVelX)) deallocate(OutData%WindVelX) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WindVelX(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindVelX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WindVelX) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WindVelY + if (allocated(OutData%WindVelY)) deallocate(OutData%WindVelY) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WindVelY(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindVelY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WindVelY) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WindVelZ + if (allocated(OutData%WindVelZ)) deallocate(OutData%WindVelZ) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WindVelZ(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindVelZ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WindVelZ) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! OutParam + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam + end do + end if + ! NumOuts + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! NOutSteps + call RegUnpack(Buf, OutData%NOutSteps) + if (RegCheckErr(Buf, RoutineName)) return + ! FileDescLines + call RegUnpack(Buf, OutData%FileDescLines) + if (RegCheckErr(Buf, RoutineName)) return + ! Module_Ver + LB(1:1) = lbound(OutData%Module_Ver) + UB(1:1) = ubound(OutData%Module_Ver) + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackProgDesc(Buf, OutData%Module_Ver(i1)) ! Module_Ver + end do + ! UnOu + call RegUnpack(Buf, OutData%UnOu) + if (RegCheckErr(Buf, RoutineName)) return + ! dX_low + call RegUnpack(Buf, OutData%dX_low) + if (RegCheckErr(Buf, RoutineName)) return + ! dY_low + call RegUnpack(Buf, OutData%dY_low) + if (RegCheckErr(Buf, RoutineName)) return + ! dZ_low + call RegUnpack(Buf, OutData%dZ_low) + if (RegCheckErr(Buf, RoutineName)) return + ! nX_low + call RegUnpack(Buf, OutData%nX_low) + if (RegCheckErr(Buf, RoutineName)) return + ! nY_low + call RegUnpack(Buf, OutData%nY_low) + if (RegCheckErr(Buf, RoutineName)) return + ! nZ_low + call RegUnpack(Buf, OutData%nZ_low) + if (RegCheckErr(Buf, RoutineName)) return + ! X0_low + call RegUnpack(Buf, OutData%X0_low) + if (RegCheckErr(Buf, RoutineName)) return + ! Y0_low + call RegUnpack(Buf, OutData%Y0_low) + if (RegCheckErr(Buf, RoutineName)) return + ! Z0_low + call RegUnpack(Buf, OutData%Z0_low) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE Farm_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) TYPE(Farm_MiscVarType), INTENT(INOUT) :: SrcMiscData TYPE(Farm_MiscVarType), INTENT(INOUT) :: DstMiscData @@ -1377,470 +1004,152 @@ SUBROUTINE Farm_DestroyMisc( MiscData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE Farm_DestroyMisc - SUBROUTINE Farm_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Farm_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Farm_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! AllOuts allocated yes/no - IF ( ALLOCATED(InData%AllOuts) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AllOuts upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AllOuts) ! AllOuts - END IF - Int_BufSz = Int_BufSz + 1 ! TimeData allocated yes/no - IF ( ALLOCATED(InData%TimeData) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TimeData upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%TimeData) ! TimeData - END IF - Int_BufSz = Int_BufSz + 1 ! AllOutData allocated yes/no - IF ( ALLOCATED(InData%AllOutData) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AllOutData upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AllOutData) ! AllOutData - END IF - Int_BufSz = Int_BufSz + 1 ! n_Out - Int_BufSz = Int_BufSz + 1 ! FWrap_2_MD allocated yes/no - IF ( ALLOCATED(InData%FWrap_2_MD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FWrap_2_MD upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%FWrap_2_MD,1), UBOUND(InData%FWrap_2_MD,1) - Int_BufSz = Int_BufSz + 3 ! FWrap_2_MD: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%FWrap_2_MD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! FWrap_2_MD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FWrap_2_MD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FWrap_2_MD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FWrap_2_MD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! MD_2_FWrap allocated yes/no - IF ( ALLOCATED(InData%MD_2_FWrap) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MD_2_FWrap upper/lower bounds for each dimension - DO i1 = LBOUND(InData%MD_2_FWrap,1), UBOUND(InData%MD_2_FWrap,1) - Int_BufSz = Int_BufSz + 3 ! MD_2_FWrap: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%MD_2_FWrap(i1), ErrStat2, ErrMsg2, .TRUE. ) ! MD_2_FWrap - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! MD_2_FWrap - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! MD_2_FWrap - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! MD_2_FWrap - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%AllOuts) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AllOuts,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOuts,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AllOuts,1), UBOUND(InData%AllOuts,1) - ReKiBuf(Re_Xferred) = InData%AllOuts(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TimeData) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TimeData,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TimeData,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TimeData,1), UBOUND(InData%TimeData,1) - DbKiBuf(Db_Xferred) = InData%TimeData(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AllOutData) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AllOutData,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOutData,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AllOutData,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOutData,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AllOutData,2), UBOUND(InData%AllOutData,2) - DO i1 = LBOUND(InData%AllOutData,1), UBOUND(InData%AllOutData,1) - ReKiBuf(Re_Xferred) = InData%AllOutData(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%n_Out - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%FWrap_2_MD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FWrap_2_MD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FWrap_2_MD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FWrap_2_MD,1), UBOUND(InData%FWrap_2_MD,1) - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%FWrap_2_MD(i1), ErrStat2, ErrMsg2, OnlySize ) ! FWrap_2_MD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MD_2_FWrap) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MD_2_FWrap,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MD_2_FWrap,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MD_2_FWrap,1), UBOUND(InData%MD_2_FWrap,1) - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%MD_2_FWrap(i1), ErrStat2, ErrMsg2, OnlySize ) ! MD_2_FWrap - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - END SUBROUTINE Farm_PackMisc - - SUBROUTINE Farm_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Farm_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Farm_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AllOuts not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AllOuts)) DEALLOCATE(OutData%AllOuts) - ALLOCATE(OutData%AllOuts(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AllOuts,1), UBOUND(OutData%AllOuts,1) - OutData%AllOuts(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TimeData not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TimeData)) DEALLOCATE(OutData%TimeData) - ALLOCATE(OutData%TimeData(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TimeData.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TimeData,1), UBOUND(OutData%TimeData,1) - OutData%TimeData(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AllOutData not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AllOutData)) DEALLOCATE(OutData%AllOutData) - ALLOCATE(OutData%AllOutData(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOutData.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AllOutData,2), UBOUND(OutData%AllOutData,2) - DO i1 = LBOUND(OutData%AllOutData,1), UBOUND(OutData%AllOutData,1) - OutData%AllOutData(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%n_Out = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FWrap_2_MD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FWrap_2_MD)) DEALLOCATE(OutData%FWrap_2_MD) - ALLOCATE(OutData%FWrap_2_MD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FWrap_2_MD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FWrap_2_MD,1), UBOUND(OutData%FWrap_2_MD,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%FWrap_2_MD(i1), ErrStat2, ErrMsg2 ) ! FWrap_2_MD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MD_2_FWrap not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MD_2_FWrap)) DEALLOCATE(OutData%MD_2_FWrap) - ALLOCATE(OutData%MD_2_FWrap(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MD_2_FWrap.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MD_2_FWrap,1), UBOUND(OutData%MD_2_FWrap,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%MD_2_FWrap(i1), ErrStat2, ErrMsg2 ) ! MD_2_FWrap - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - END SUBROUTINE Farm_UnPackMisc +subroutine Farm_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Farm_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Farm_PackMisc' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + ! AllOuts + call RegPack(Buf, allocated(InData%AllOuts)) + if (allocated(InData%AllOuts)) then + call RegPackBounds(Buf, 1, lbound(InData%AllOuts), ubound(InData%AllOuts)) + call RegPack(Buf, InData%AllOuts) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TimeData + call RegPack(Buf, allocated(InData%TimeData)) + if (allocated(InData%TimeData)) then + call RegPackBounds(Buf, 1, lbound(InData%TimeData), ubound(InData%TimeData)) + call RegPack(Buf, InData%TimeData) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AllOutData + call RegPack(Buf, allocated(InData%AllOutData)) + if (allocated(InData%AllOutData)) then + call RegPackBounds(Buf, 2, lbound(InData%AllOutData), ubound(InData%AllOutData)) + call RegPack(Buf, InData%AllOutData) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! n_Out + call RegPack(Buf, InData%n_Out) + if (RegCheckErr(Buf, RoutineName)) return + ! FWrap_2_MD + call RegPack(Buf, allocated(InData%FWrap_2_MD)) + if (allocated(InData%FWrap_2_MD)) then + call RegPackBounds(Buf, 1, lbound(InData%FWrap_2_MD), ubound(InData%FWrap_2_MD)) + LB(1:1) = lbound(InData%FWrap_2_MD) + UB(1:1) = ubound(InData%FWrap_2_MD) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%FWrap_2_MD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MD_2_FWrap + call RegPack(Buf, allocated(InData%MD_2_FWrap)) + if (allocated(InData%MD_2_FWrap)) then + call RegPackBounds(Buf, 1, lbound(InData%MD_2_FWrap), ubound(InData%MD_2_FWrap)) + LB(1:1) = lbound(InData%MD_2_FWrap) + UB(1:1) = ubound(InData%MD_2_FWrap) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%MD_2_FWrap(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Farm_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Farm_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Farm_UnPackMisc' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! AllOuts + if (allocated(OutData%AllOuts)) deallocate(OutData%AllOuts) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AllOuts(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AllOuts) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TimeData + if (allocated(OutData%TimeData)) deallocate(OutData%TimeData) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TimeData(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TimeData.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TimeData) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AllOutData + if (allocated(OutData%AllOutData)) deallocate(OutData%AllOutData) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AllOutData(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOutData.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AllOutData) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! n_Out + call RegUnpack(Buf, OutData%n_Out) + if (RegCheckErr(Buf, RoutineName)) return + ! FWrap_2_MD + if (allocated(OutData%FWrap_2_MD)) deallocate(OutData%FWrap_2_MD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FWrap_2_MD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FWrap_2_MD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%FWrap_2_MD(i1)) ! FWrap_2_MD + end do + end if + ! MD_2_FWrap + if (allocated(OutData%MD_2_FWrap)) deallocate(OutData%MD_2_FWrap) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MD_2_FWrap(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MD_2_FWrap.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%MD_2_FWrap(i1)) ! MD_2_FWrap + end do + end if +end subroutine SUBROUTINE Farm_CopyFASTWrapper_Data( SrcFASTWrapper_DataData, DstFASTWrapper_DataData, CtrlCode, ErrStat, ErrMsg ) TYPE(FASTWrapper_Data), INTENT(INOUT) :: SrcFASTWrapper_DataData TYPE(FASTWrapper_Data), INTENT(INOUT) :: DstFASTWrapper_DataData @@ -1913,784 +1222,66 @@ SUBROUTINE Farm_DestroyFASTWrapper_Data( FASTWrapper_DataData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE Farm_DestroyFASTWrapper_Data - SUBROUTINE Farm_PackFASTWrapper_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FASTWrapper_Data), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Farm_PackFASTWrapper_Data' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL FWrap_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x, ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL FWrap_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd, ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL FWrap_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z, ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL FWrap_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL FWrap_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL FWrap_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL FWrap_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL FWrap_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! IsInitialized - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL FWrap_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x, ErrStat2, ErrMsg2, OnlySize ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL FWrap_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd, ErrStat2, ErrMsg2, OnlySize ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL FWrap_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z, ErrStat2, ErrMsg2, OnlySize ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL FWrap_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL FWrap_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL FWrap_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL FWrap_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL FWrap_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = TRANSFER(InData%IsInitialized, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Farm_PackFASTWrapper_Data - - SUBROUTINE Farm_UnPackFASTWrapper_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FASTWrapper_Data), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Farm_UnPackFASTWrapper_Data' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FWrap_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x, ErrStat2, ErrMsg2 ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FWrap_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd, ErrStat2, ErrMsg2 ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FWrap_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z, ErrStat2, ErrMsg2 ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FWrap_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt, ErrStat2, ErrMsg2 ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FWrap_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FWrap_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FWrap_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FWrap_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%IsInitialized = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsInitialized) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Farm_UnPackFASTWrapper_Data +subroutine Farm_PackFASTWrapper_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FASTWrapper_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'Farm_PackFASTWrapper_Data' + if (Buf%ErrStat >= AbortErrLev) return + ! x + call FWrap_PackContState(Buf, InData%x) + if (RegCheckErr(Buf, RoutineName)) return + ! xd + call FWrap_PackDiscState(Buf, InData%xd) + if (RegCheckErr(Buf, RoutineName)) return + ! z + call FWrap_PackConstrState(Buf, InData%z) + if (RegCheckErr(Buf, RoutineName)) return + ! OtherSt + call FWrap_PackOtherState(Buf, InData%OtherSt) + if (RegCheckErr(Buf, RoutineName)) return + ! p + call FWrap_PackParam(Buf, InData%p) + if (RegCheckErr(Buf, RoutineName)) return + ! u + call FWrap_PackInput(Buf, InData%u) + if (RegCheckErr(Buf, RoutineName)) return + ! y + call FWrap_PackOutput(Buf, InData%y) + if (RegCheckErr(Buf, RoutineName)) return + ! m + call FWrap_PackMisc(Buf, InData%m) + if (RegCheckErr(Buf, RoutineName)) return + ! IsInitialized + call RegPack(Buf, InData%IsInitialized) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Farm_UnPackFASTWrapper_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FASTWrapper_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Farm_UnPackFASTWrapper_Data' + if (Buf%ErrStat /= ErrID_None) return + ! x + call FWrap_UnpackContState(Buf, OutData%x) ! x + ! xd + call FWrap_UnpackDiscState(Buf, OutData%xd) ! xd + ! z + call FWrap_UnpackConstrState(Buf, OutData%z) ! z + ! OtherSt + call FWrap_UnpackOtherState(Buf, OutData%OtherSt) ! OtherSt + ! p + call FWrap_UnpackParam(Buf, OutData%p) ! p + ! u + call FWrap_UnpackInput(Buf, OutData%u) ! u + ! y + call FWrap_UnpackOutput(Buf, OutData%y) ! y + ! m + call FWrap_UnpackMisc(Buf, OutData%m) ! m + ! IsInitialized + call RegUnpack(Buf, OutData%IsInitialized) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE Farm_CopyWakeDynamics_Data( SrcWakeDynamics_DataData, DstWakeDynamics_DataData, CtrlCode, ErrStat, ErrMsg ) TYPE(WakeDynamics_Data), INTENT(IN) :: SrcWakeDynamics_DataData TYPE(WakeDynamics_Data), INTENT(INOUT) :: DstWakeDynamics_DataData @@ -2763,784 +1354,66 @@ SUBROUTINE Farm_DestroyWakeDynamics_Data( WakeDynamics_DataData, ErrStat, ErrMsg CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE Farm_DestroyWakeDynamics_Data - SUBROUTINE Farm_PackWakeDynamics_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(WakeDynamics_Data), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Farm_PackWakeDynamics_Data' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL WD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x, ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL WD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd, ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL WD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z, ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL WD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL WD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL WD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL WD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL WD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! IsInitialized - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL WD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x, ErrStat2, ErrMsg2, OnlySize ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL WD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd, ErrStat2, ErrMsg2, OnlySize ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL WD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z, ErrStat2, ErrMsg2, OnlySize ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL WD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL WD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL WD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL WD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL WD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = TRANSFER(InData%IsInitialized, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Farm_PackWakeDynamics_Data - - SUBROUTINE Farm_UnPackWakeDynamics_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(WakeDynamics_Data), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Farm_UnPackWakeDynamics_Data' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL WD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x, ErrStat2, ErrMsg2 ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL WD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd, ErrStat2, ErrMsg2 ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL WD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z, ErrStat2, ErrMsg2 ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL WD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt, ErrStat2, ErrMsg2 ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL WD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL WD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL WD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL WD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%IsInitialized = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsInitialized) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Farm_UnPackWakeDynamics_Data +subroutine Farm_PackWakeDynamics_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WakeDynamics_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'Farm_PackWakeDynamics_Data' + if (Buf%ErrStat >= AbortErrLev) return + ! x + call WD_PackContState(Buf, InData%x) + if (RegCheckErr(Buf, RoutineName)) return + ! xd + call WD_PackDiscState(Buf, InData%xd) + if (RegCheckErr(Buf, RoutineName)) return + ! z + call WD_PackConstrState(Buf, InData%z) + if (RegCheckErr(Buf, RoutineName)) return + ! OtherSt + call WD_PackOtherState(Buf, InData%OtherSt) + if (RegCheckErr(Buf, RoutineName)) return + ! p + call WD_PackParam(Buf, InData%p) + if (RegCheckErr(Buf, RoutineName)) return + ! u + call WD_PackInput(Buf, InData%u) + if (RegCheckErr(Buf, RoutineName)) return + ! y + call WD_PackOutput(Buf, InData%y) + if (RegCheckErr(Buf, RoutineName)) return + ! m + call WD_PackMisc(Buf, InData%m) + if (RegCheckErr(Buf, RoutineName)) return + ! IsInitialized + call RegPack(Buf, InData%IsInitialized) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Farm_UnPackWakeDynamics_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WakeDynamics_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Farm_UnPackWakeDynamics_Data' + if (Buf%ErrStat /= ErrID_None) return + ! x + call WD_UnpackContState(Buf, OutData%x) ! x + ! xd + call WD_UnpackDiscState(Buf, OutData%xd) ! xd + ! z + call WD_UnpackConstrState(Buf, OutData%z) ! z + ! OtherSt + call WD_UnpackOtherState(Buf, OutData%OtherSt) ! OtherSt + ! p + call WD_UnpackParam(Buf, OutData%p) ! p + ! u + call WD_UnpackInput(Buf, OutData%u) ! u + ! y + call WD_UnpackOutput(Buf, OutData%y) ! y + ! m + call WD_UnpackMisc(Buf, OutData%m) ! m + ! IsInitialized + call RegUnpack(Buf, OutData%IsInitialized) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE Farm_CopyAWAE_Data( SrcAWAE_DataData, DstAWAE_DataData, CtrlCode, ErrStat, ErrMsg ) TYPE(AWAE_Data), INTENT(IN) :: SrcAWAE_DataData TYPE(AWAE_Data), INTENT(INOUT) :: DstAWAE_DataData @@ -3613,784 +1486,66 @@ SUBROUTINE Farm_DestroyAWAE_Data( AWAE_DataData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE Farm_DestroyAWAE_Data - SUBROUTINE Farm_PackAWAE_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AWAE_Data), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Farm_PackAWAE_Data' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL AWAE_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x, ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL AWAE_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd, ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL AWAE_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z, ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL AWAE_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL AWAE_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL AWAE_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL AWAE_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL AWAE_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! IsInitialized - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL AWAE_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x, ErrStat2, ErrMsg2, OnlySize ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AWAE_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd, ErrStat2, ErrMsg2, OnlySize ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AWAE_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z, ErrStat2, ErrMsg2, OnlySize ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AWAE_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AWAE_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AWAE_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AWAE_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AWAE_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = TRANSFER(InData%IsInitialized, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Farm_PackAWAE_Data - - SUBROUTINE Farm_UnPackAWAE_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AWAE_Data), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Farm_UnPackAWAE_Data' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AWAE_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x, ErrStat2, ErrMsg2 ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AWAE_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd, ErrStat2, ErrMsg2 ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AWAE_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z, ErrStat2, ErrMsg2 ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AWAE_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt, ErrStat2, ErrMsg2 ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AWAE_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AWAE_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AWAE_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AWAE_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%IsInitialized = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsInitialized) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Farm_UnPackAWAE_Data +subroutine Farm_PackAWAE_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'Farm_PackAWAE_Data' + if (Buf%ErrStat >= AbortErrLev) return + ! x + call AWAE_PackContState(Buf, InData%x) + if (RegCheckErr(Buf, RoutineName)) return + ! xd + call AWAE_PackDiscState(Buf, InData%xd) + if (RegCheckErr(Buf, RoutineName)) return + ! z + call AWAE_PackConstrState(Buf, InData%z) + if (RegCheckErr(Buf, RoutineName)) return + ! OtherSt + call AWAE_PackOtherState(Buf, InData%OtherSt) + if (RegCheckErr(Buf, RoutineName)) return + ! p + call AWAE_PackParam(Buf, InData%p) + if (RegCheckErr(Buf, RoutineName)) return + ! u + call AWAE_PackInput(Buf, InData%u) + if (RegCheckErr(Buf, RoutineName)) return + ! y + call AWAE_PackOutput(Buf, InData%y) + if (RegCheckErr(Buf, RoutineName)) return + ! m + call AWAE_PackMisc(Buf, InData%m) + if (RegCheckErr(Buf, RoutineName)) return + ! IsInitialized + call RegPack(Buf, InData%IsInitialized) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Farm_UnPackAWAE_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Farm_UnPackAWAE_Data' + if (Buf%ErrStat /= ErrID_None) return + ! x + call AWAE_UnpackContState(Buf, OutData%x) ! x + ! xd + call AWAE_UnpackDiscState(Buf, OutData%xd) ! xd + ! z + call AWAE_UnpackConstrState(Buf, OutData%z) ! z + ! OtherSt + call AWAE_UnpackOtherState(Buf, OutData%OtherSt) ! OtherSt + ! p + call AWAE_UnpackParam(Buf, OutData%p) ! p + ! u + call AWAE_UnpackInput(Buf, OutData%u) ! u + ! y + call AWAE_UnpackOutput(Buf, OutData%y) ! y + ! m + call AWAE_UnpackMisc(Buf, OutData%m) ! m + ! IsInitialized + call RegUnpack(Buf, OutData%IsInitialized) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE Farm_CopySC_Data( SrcSC_DataData, DstSC_DataData, CtrlCode, ErrStat, ErrMsg ) TYPE(SC_Data), INTENT(IN) :: SrcSC_DataData TYPE(SC_Data), INTENT(INOUT) :: DstSC_DataData @@ -4465,796 +1620,72 @@ SUBROUTINE Farm_DestroySC_Data( SC_DataData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE Farm_DestroySC_Data - SUBROUTINE Farm_PackSC_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SC_Data), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Farm_PackSC_Data' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL SC_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x, ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL SC_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd, ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL SC_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z, ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OtherState: size of buffers for each call to pack subtype - CALL SC_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherState, ErrStat2, ErrMsg2, .TRUE. ) ! OtherState - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherState - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherState - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherState - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL SC_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! uInputs: size of buffers for each call to pack subtype - CALL SC_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%uInputs, ErrStat2, ErrMsg2, .TRUE. ) ! uInputs - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! uInputs - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! uInputs - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! uInputs - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Db_BufSz = Db_BufSz + SIZE(InData%utimes) ! utimes - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL SC_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL SC_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! IsInitialized - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL SC_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x, ErrStat2, ErrMsg2, OnlySize ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SC_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd, ErrStat2, ErrMsg2, OnlySize ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SC_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z, ErrStat2, ErrMsg2, OnlySize ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SC_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherState, ErrStat2, ErrMsg2, OnlySize ) ! OtherState - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SC_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SC_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%uInputs, ErrStat2, ErrMsg2, OnlySize ) ! uInputs - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - DO i1 = LBOUND(InData%utimes,1), UBOUND(InData%utimes,1) - DbKiBuf(Db_Xferred) = InData%utimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - CALL SC_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SC_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = TRANSFER(InData%IsInitialized, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Farm_PackSC_Data - - SUBROUTINE Farm_UnPackSC_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SC_Data), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Farm_UnPackSC_Data' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SC_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x, ErrStat2, ErrMsg2 ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SC_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd, ErrStat2, ErrMsg2 ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SC_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z, ErrStat2, ErrMsg2 ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SC_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherState, ErrStat2, ErrMsg2 ) ! OtherState - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SC_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SC_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%uInputs, ErrStat2, ErrMsg2 ) ! uInputs - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - i1_l = LBOUND(OutData%utimes,1) - i1_u = UBOUND(OutData%utimes,1) - DO i1 = LBOUND(OutData%utimes,1), UBOUND(OutData%utimes,1) - OutData%utimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SC_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SC_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%IsInitialized = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsInitialized) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Farm_UnPackSC_Data +subroutine Farm_PackSC_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SC_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'Farm_PackSC_Data' + if (Buf%ErrStat >= AbortErrLev) return + ! x + call SC_PackContState(Buf, InData%x) + if (RegCheckErr(Buf, RoutineName)) return + ! xd + call SC_PackDiscState(Buf, InData%xd) + if (RegCheckErr(Buf, RoutineName)) return + ! z + call SC_PackConstrState(Buf, InData%z) + if (RegCheckErr(Buf, RoutineName)) return + ! OtherState + call SC_PackOtherState(Buf, InData%OtherState) + if (RegCheckErr(Buf, RoutineName)) return + ! p + call SC_PackParam(Buf, InData%p) + if (RegCheckErr(Buf, RoutineName)) return + ! uInputs + call SC_PackInput(Buf, InData%uInputs) + if (RegCheckErr(Buf, RoutineName)) return + ! utimes + call RegPack(Buf, InData%utimes) + if (RegCheckErr(Buf, RoutineName)) return + ! y + call SC_PackOutput(Buf, InData%y) + if (RegCheckErr(Buf, RoutineName)) return + ! m + call SC_PackMisc(Buf, InData%m) + if (RegCheckErr(Buf, RoutineName)) return + ! IsInitialized + call RegPack(Buf, InData%IsInitialized) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Farm_UnPackSC_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SC_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Farm_UnPackSC_Data' + if (Buf%ErrStat /= ErrID_None) return + ! x + call SC_UnpackContState(Buf, OutData%x) ! x + ! xd + call SC_UnpackDiscState(Buf, OutData%xd) ! xd + ! z + call SC_UnpackConstrState(Buf, OutData%z) ! z + ! OtherState + call SC_UnpackOtherState(Buf, OutData%OtherState) ! OtherState + ! p + call SC_UnpackParam(Buf, OutData%p) ! p + ! uInputs + call SC_UnpackInput(Buf, OutData%uInputs) ! uInputs + ! utimes + call RegUnpack(Buf, OutData%utimes) + if (RegCheckErr(Buf, RoutineName)) return + ! y + call SC_UnpackOutput(Buf, OutData%y) ! y + ! m + call SC_UnpackMisc(Buf, OutData%m) ! m + ! IsInitialized + call RegUnpack(Buf, OutData%IsInitialized) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE Farm_CopyMD_Data( SrcMD_DataData, DstMD_DataData, CtrlCode, ErrStat, ErrMsg ) TYPE(MD_Data), INTENT(INOUT) :: SrcMD_DataData TYPE(MD_Data), INTENT(INOUT) :: DstMD_DataData @@ -5366,943 +1797,121 @@ SUBROUTINE Farm_DestroyMD_Data( MD_DataData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE Farm_DestroyMD_Data - SUBROUTINE Farm_PackMD_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MD_Data), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Farm_PackMD_Data' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x, ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL MD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd, ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL MD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z, ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL MD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL MD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL MD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL MD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! IsInitialized - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x, ErrStat2, ErrMsg2, OnlySize ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd, ErrStat2, ErrMsg2, OnlySize ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z, ErrStat2, ErrMsg2, OnlySize ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%Input) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - CALL MD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = TRANSFER(InData%IsInitialized, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Farm_PackMD_Data - - SUBROUTINE Farm_UnPackMD_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MD_Data), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Farm_UnPackMD_Data' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x, ErrStat2, ErrMsg2 ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd, ErrStat2, ErrMsg2 ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z, ErrStat2, ErrMsg2 ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt, ErrStat2, ErrMsg2 ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%IsInitialized = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsInitialized) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Farm_UnPackMD_Data +subroutine Farm_PackMD_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MD_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'Farm_PackMD_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! x + call MD_PackContState(Buf, InData%x) + if (RegCheckErr(Buf, RoutineName)) return + ! xd + call MD_PackDiscState(Buf, InData%xd) + if (RegCheckErr(Buf, RoutineName)) return + ! z + call MD_PackConstrState(Buf, InData%z) + if (RegCheckErr(Buf, RoutineName)) return + ! OtherSt + call MD_PackOtherState(Buf, InData%OtherSt) + if (RegCheckErr(Buf, RoutineName)) return + ! p + call MD_PackParam(Buf, InData%p) + if (RegCheckErr(Buf, RoutineName)) return + ! u + call MD_PackInput(Buf, InData%u) + if (RegCheckErr(Buf, RoutineName)) return + ! Input + call RegPack(Buf, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call MD_PackInput(Buf, InData%Input(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! InputTimes + call RegPack(Buf, allocated(InData%InputTimes)) + if (allocated(InData%InputTimes)) then + call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPack(Buf, InData%InputTimes) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! y + call MD_PackOutput(Buf, InData%y) + if (RegCheckErr(Buf, RoutineName)) return + ! m + call MD_PackMisc(Buf, InData%m) + if (RegCheckErr(Buf, RoutineName)) return + ! IsInitialized + call RegPack(Buf, InData%IsInitialized) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Farm_UnPackMD_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MD_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Farm_UnPackMD_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! x + call MD_UnpackContState(Buf, OutData%x) ! x + ! xd + call MD_UnpackDiscState(Buf, OutData%xd) ! xd + ! z + call MD_UnpackConstrState(Buf, OutData%z) ! z + ! OtherSt + call MD_UnpackOtherState(Buf, OutData%OtherSt) ! OtherSt + ! p + call MD_UnpackParam(Buf, OutData%p) ! p + ! u + call MD_UnpackInput(Buf, OutData%u) ! u + ! Input + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackInput(Buf, OutData%Input(i1)) ! Input + end do + end if + ! InputTimes + if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InputTimes) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! y + call MD_UnpackOutput(Buf, OutData%y) ! y + ! m + call MD_UnpackMisc(Buf, OutData%m) ! m + ! IsInitialized + call RegUnpack(Buf, OutData%IsInitialized) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE Farm_CopyAll_FastFarm_Data( SrcAll_FastFarm_DataData, DstAll_FastFarm_DataData, CtrlCode, ErrStat, ErrMsg ) TYPE(All_FastFarm_Data), INTENT(INOUT) :: SrcAll_FastFarm_DataData TYPE(All_FastFarm_Data), INTENT(INOUT) :: DstAll_FastFarm_DataData @@ -6406,764 +2015,104 @@ SUBROUTINE Farm_DestroyAll_FastFarm_Data( All_FastFarm_DataData, ErrStat, ErrMsg CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE Farm_DestroyAll_FastFarm_Data - SUBROUTINE Farm_PackAll_FastFarm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(All_FastFarm_Data), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Farm_PackAll_FastFarm_Data' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL Farm_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL Farm_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! FWrap allocated yes/no - IF ( ALLOCATED(InData%FWrap) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FWrap upper/lower bounds for each dimension - DO i1 = LBOUND(InData%FWrap,1), UBOUND(InData%FWrap,1) - Int_BufSz = Int_BufSz + 3 ! FWrap: size of buffers for each call to pack subtype - CALL Farm_PackFASTWrapper_Data( Re_Buf, Db_Buf, Int_Buf, InData%FWrap(i1), ErrStat2, ErrMsg2, .TRUE. ) ! FWrap - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FWrap - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FWrap - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FWrap - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! WD allocated yes/no - IF ( ALLOCATED(InData%WD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%WD,1), UBOUND(InData%WD,1) - Int_BufSz = Int_BufSz + 3 ! WD: size of buffers for each call to pack subtype - CALL Farm_PackWakeDynamics_Data( Re_Buf, Db_Buf, Int_Buf, InData%WD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! WD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! AWAE: size of buffers for each call to pack subtype - CALL Farm_PackAWAE_Data( Re_Buf, Db_Buf, Int_Buf, InData%AWAE, ErrStat2, ErrMsg2, .TRUE. ) ! AWAE - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AWAE - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AWAE - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AWAE - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SC: size of buffers for each call to pack subtype - CALL Farm_PackSC_Data( Re_Buf, Db_Buf, Int_Buf, InData%SC, ErrStat2, ErrMsg2, .TRUE. ) ! SC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! MD: size of buffers for each call to pack subtype - CALL Farm_PackMD_Data( Re_Buf, Db_Buf, Int_Buf, InData%MD, ErrStat2, ErrMsg2, .TRUE. ) ! MD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! MD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! MD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! MD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL Farm_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL Farm_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%FWrap) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FWrap,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FWrap,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FWrap,1), UBOUND(InData%FWrap,1) - CALL Farm_PackFASTWrapper_Data( Re_Buf, Db_Buf, Int_Buf, InData%FWrap(i1), ErrStat2, ErrMsg2, OnlySize ) ! FWrap - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WD,1), UBOUND(InData%WD,1) - CALL Farm_PackWakeDynamics_Data( Re_Buf, Db_Buf, Int_Buf, InData%WD(i1), ErrStat2, ErrMsg2, OnlySize ) ! WD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL Farm_PackAWAE_Data( Re_Buf, Db_Buf, Int_Buf, InData%AWAE, ErrStat2, ErrMsg2, OnlySize ) ! AWAE - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL Farm_PackSC_Data( Re_Buf, Db_Buf, Int_Buf, InData%SC, ErrStat2, ErrMsg2, OnlySize ) ! SC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL Farm_PackMD_Data( Re_Buf, Db_Buf, Int_Buf, InData%MD, ErrStat2, ErrMsg2, OnlySize ) ! MD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE Farm_PackAll_FastFarm_Data - - SUBROUTINE Farm_UnPackAll_FastFarm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(All_FastFarm_Data), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Farm_UnPackAll_FastFarm_Data' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Farm_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Farm_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FWrap not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FWrap)) DEALLOCATE(OutData%FWrap) - ALLOCATE(OutData%FWrap(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FWrap.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FWrap,1), UBOUND(OutData%FWrap,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Farm_UnpackFASTWrapper_Data( Re_Buf, Db_Buf, Int_Buf, OutData%FWrap(i1), ErrStat2, ErrMsg2 ) ! FWrap - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WD)) DEALLOCATE(OutData%WD) - ALLOCATE(OutData%WD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WD,1), UBOUND(OutData%WD,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Farm_UnpackWakeDynamics_Data( Re_Buf, Db_Buf, Int_Buf, OutData%WD(i1), ErrStat2, ErrMsg2 ) ! WD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Farm_UnpackAWAE_Data( Re_Buf, Db_Buf, Int_Buf, OutData%AWAE, ErrStat2, ErrMsg2 ) ! AWAE - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Farm_UnpackSC_Data( Re_Buf, Db_Buf, Int_Buf, OutData%SC, ErrStat2, ErrMsg2 ) ! SC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Farm_UnpackMD_Data( Re_Buf, Db_Buf, Int_Buf, OutData%MD, ErrStat2, ErrMsg2 ) ! MD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE Farm_UnPackAll_FastFarm_Data +subroutine Farm_PackAll_FastFarm_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(All_FastFarm_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'Farm_PackAll_FastFarm_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! p + call Farm_PackParam(Buf, InData%p) + if (RegCheckErr(Buf, RoutineName)) return + ! m + call Farm_PackMisc(Buf, InData%m) + if (RegCheckErr(Buf, RoutineName)) return + ! FWrap + call RegPack(Buf, allocated(InData%FWrap)) + if (allocated(InData%FWrap)) then + call RegPackBounds(Buf, 1, lbound(InData%FWrap), ubound(InData%FWrap)) + LB(1:1) = lbound(InData%FWrap) + UB(1:1) = ubound(InData%FWrap) + do i1 = LB(1), UB(1) + call Farm_PackFASTWrapper_Data(Buf, InData%FWrap(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WD + call RegPack(Buf, allocated(InData%WD)) + if (allocated(InData%WD)) then + call RegPackBounds(Buf, 1, lbound(InData%WD), ubound(InData%WD)) + LB(1:1) = lbound(InData%WD) + UB(1:1) = ubound(InData%WD) + do i1 = LB(1), UB(1) + call Farm_PackWakeDynamics_Data(Buf, InData%WD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AWAE + call Farm_PackAWAE_Data(Buf, InData%AWAE) + if (RegCheckErr(Buf, RoutineName)) return + ! SC + call Farm_PackSC_Data(Buf, InData%SC) + if (RegCheckErr(Buf, RoutineName)) return + ! MD + call Farm_PackMD_Data(Buf, InData%MD) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Farm_UnPackAll_FastFarm_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(All_FastFarm_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Farm_UnPackAll_FastFarm_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! p + call Farm_UnpackParam(Buf, OutData%p) ! p + ! m + call Farm_UnpackMisc(Buf, OutData%m) ! m + ! FWrap + if (allocated(OutData%FWrap)) deallocate(OutData%FWrap) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FWrap(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FWrap.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Farm_UnpackFASTWrapper_Data(Buf, OutData%FWrap(i1)) ! FWrap + end do + end if + ! WD + if (allocated(OutData%WD)) deallocate(OutData%WD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Farm_UnpackWakeDynamics_Data(Buf, OutData%WD(i1)) ! WD + end do + end if + ! AWAE + call Farm_UnpackAWAE_Data(Buf, OutData%AWAE) ! AWAE + ! SC + call Farm_UnpackSC_Data(Buf, OutData%SC) ! SC + ! MD + call Farm_UnpackMD_Data(Buf, OutData%MD) ! MD +end subroutine END MODULE FAST_Farm_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/AeroAcoustics_Types.f90 b/modules/aerodyn/src/AeroAcoustics_Types.f90 index 88494c69b5..2e09eca4ea 100644 --- a/modules/aerodyn/src/AeroAcoustics_Types.f90 +++ b/modules/aerodyn/src/AeroAcoustics_Types.f90 @@ -311,108 +311,32 @@ SUBROUTINE AA_DestroyBladePropsType( BladePropsTypeData, ErrStat, ErrMsg ) END SUBROUTINE AA_DestroyBladePropsType - SUBROUTINE AA_PackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AA_BladePropsType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_PackBladePropsType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! TEThick - Re_BufSz = Re_BufSz + 1 ! TEAngle - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%TEThick - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEAngle - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AA_PackBladePropsType - - SUBROUTINE AA_UnPackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AA_BladePropsType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_UnPackBladePropsType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%TEThick = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEAngle = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AA_UnPackBladePropsType +subroutine AA_PackBladePropsType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AA_BladePropsType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AA_PackBladePropsType' + if (Buf%ErrStat >= AbortErrLev) return + ! TEThick + call RegPack(Buf, InData%TEThick) + if (RegCheckErr(Buf, RoutineName)) return + ! TEAngle + call RegPack(Buf, InData%TEAngle) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AA_UnPackBladePropsType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AA_BladePropsType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AA_UnPackBladePropsType' + if (Buf%ErrStat /= ErrID_None) return + ! TEThick + call RegUnpack(Buf, OutData%TEThick) + if (RegCheckErr(Buf, RoutineName)) return + ! TEAngle + call RegUnpack(Buf, OutData%TEAngle) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE AA_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(AA_InitInputType), INTENT(IN) :: SrcInitInputData TYPE(AA_InitInputType), INTENT(INOUT) :: DstInitInputData @@ -528,413 +452,167 @@ SUBROUTINE AA_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE AA_DestroyInitInput - SUBROUTINE AA_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AA_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%InputFile) ! InputFile - Int_BufSz = Int_BufSz + 1 ! NumBlades - Int_BufSz = Int_BufSz + 1 ! NumBlNds - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1 ! BlSpn allocated yes/no - IF ( ALLOCATED(InData%BlSpn) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BlSpn upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlSpn) ! BlSpn - END IF - Int_BufSz = Int_BufSz + 1 ! BlChord allocated yes/no - IF ( ALLOCATED(InData%BlChord) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BlChord upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlChord) ! BlChord - END IF - Re_BufSz = Re_BufSz + 1 ! AirDens - Re_BufSz = Re_BufSz + 1 ! KinVisc - Re_BufSz = Re_BufSz + 1 ! SpdSound - Re_BufSz = Re_BufSz + 1 ! HubHeight - Int_BufSz = Int_BufSz + 1 ! BlAFID allocated yes/no - IF ( ALLOCATED(InData%BlAFID) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BlAFID upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BlAFID) ! BlAFID - END IF - Int_BufSz = Int_BufSz + 1 ! AFInfo allocated yes/no - IF ( ALLOCATED(InData%AFInfo) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AFInfo upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%AFInfo,1), UBOUND(InData%AFInfo,1) - Int_BufSz = Int_BufSz + 3 ! AFInfo: size of buffers for each call to pack subtype - CALL AFI_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%AFInfo(i1), ErrStat2, ErrMsg2, .TRUE. ) ! AFInfo - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AFInfo - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AFInfo - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AFInfo - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%NumBlades - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBlNds - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%BlSpn) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlSpn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlSpn,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlSpn,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlSpn,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BlSpn,2), UBOUND(InData%BlSpn,2) - DO i1 = LBOUND(InData%BlSpn,1), UBOUND(InData%BlSpn,1) - ReKiBuf(Re_Xferred) = InData%BlSpn(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlChord) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlChord,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlChord,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlChord,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlChord,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BlChord,2), UBOUND(InData%BlChord,2) - DO i1 = LBOUND(InData%BlChord,1), UBOUND(InData%BlChord,1) - ReKiBuf(Re_Xferred) = InData%BlChord(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%AirDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%KinVisc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SpdSound - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubHeight - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BlAFID) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlAFID,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlAFID,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlAFID,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlAFID,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BlAFID,2), UBOUND(InData%BlAFID,2) - DO i1 = LBOUND(InData%BlAFID,1), UBOUND(InData%BlAFID,1) - IntKiBuf(Int_Xferred) = InData%BlAFID(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AFInfo) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFInfo,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFInfo,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AFInfo,1), UBOUND(InData%AFInfo,1) - CALL AFI_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%AFInfo(i1), ErrStat2, ErrMsg2, OnlySize ) ! AFInfo - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - END SUBROUTINE AA_PackInitInput - - SUBROUTINE AA_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AA_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%NumBlades = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumBlNds = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlSpn not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlSpn)) DEALLOCATE(OutData%BlSpn) - ALLOCATE(OutData%BlSpn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlSpn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BlSpn,2), UBOUND(OutData%BlSpn,2) - DO i1 = LBOUND(OutData%BlSpn,1), UBOUND(OutData%BlSpn,1) - OutData%BlSpn(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlChord not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlChord)) DEALLOCATE(OutData%BlChord) - ALLOCATE(OutData%BlChord(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlChord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BlChord,2), UBOUND(OutData%BlChord,2) - DO i1 = LBOUND(OutData%BlChord,1), UBOUND(OutData%BlChord,1) - OutData%BlChord(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%AirDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%KinVisc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SpdSound = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HubHeight = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlAFID not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlAFID)) DEALLOCATE(OutData%BlAFID) - ALLOCATE(OutData%BlAFID(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlAFID.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BlAFID,2), UBOUND(OutData%BlAFID,2) - DO i1 = LBOUND(OutData%BlAFID,1), UBOUND(OutData%BlAFID,1) - OutData%BlAFID(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFInfo not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AFInfo)) DEALLOCATE(OutData%AFInfo) - ALLOCATE(OutData%AFInfo(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFInfo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AFInfo,1), UBOUND(OutData%AFInfo,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AFI_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%AFInfo(i1), ErrStat2, ErrMsg2 ) ! AFInfo - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - END SUBROUTINE AA_UnPackInitInput +subroutine AA_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AA_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AA_PackInitInput' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + ! InputFile + call RegPack(Buf, InData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! NumBlades + call RegPack(Buf, InData%NumBlades) + if (RegCheckErr(Buf, RoutineName)) return + ! NumBlNds + call RegPack(Buf, InData%NumBlNds) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegPack(Buf, InData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! BlSpn + call RegPack(Buf, allocated(InData%BlSpn)) + if (allocated(InData%BlSpn)) then + call RegPackBounds(Buf, 2, lbound(InData%BlSpn), ubound(InData%BlSpn)) + call RegPack(Buf, InData%BlSpn) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BlChord + call RegPack(Buf, allocated(InData%BlChord)) + if (allocated(InData%BlChord)) then + call RegPackBounds(Buf, 2, lbound(InData%BlChord), ubound(InData%BlChord)) + call RegPack(Buf, InData%BlChord) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AirDens + call RegPack(Buf, InData%AirDens) + if (RegCheckErr(Buf, RoutineName)) return + ! KinVisc + call RegPack(Buf, InData%KinVisc) + if (RegCheckErr(Buf, RoutineName)) return + ! SpdSound + call RegPack(Buf, InData%SpdSound) + if (RegCheckErr(Buf, RoutineName)) return + ! HubHeight + call RegPack(Buf, InData%HubHeight) + if (RegCheckErr(Buf, RoutineName)) return + ! BlAFID + call RegPack(Buf, allocated(InData%BlAFID)) + if (allocated(InData%BlAFID)) then + call RegPackBounds(Buf, 2, lbound(InData%BlAFID), ubound(InData%BlAFID)) + call RegPack(Buf, InData%BlAFID) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AFInfo + call RegPack(Buf, allocated(InData%AFInfo)) + if (allocated(InData%AFInfo)) then + call RegPackBounds(Buf, 1, lbound(InData%AFInfo), ubound(InData%AFInfo)) + LB(1:1) = lbound(InData%AFInfo) + UB(1:1) = ubound(InData%AFInfo) + do i1 = LB(1), UB(1) + call AFI_PackParam(Buf, InData%AFInfo(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AA_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AA_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AA_UnPackInitInput' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! InputFile + call RegUnpack(Buf, OutData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! NumBlades + call RegUnpack(Buf, OutData%NumBlades) + if (RegCheckErr(Buf, RoutineName)) return + ! NumBlNds + call RegUnpack(Buf, OutData%NumBlNds) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! BlSpn + if (allocated(OutData%BlSpn)) deallocate(OutData%BlSpn) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlSpn(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlSpn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlSpn) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BlChord + if (allocated(OutData%BlChord)) deallocate(OutData%BlChord) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlChord(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlChord.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlChord) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AirDens + call RegUnpack(Buf, OutData%AirDens) + if (RegCheckErr(Buf, RoutineName)) return + ! KinVisc + call RegUnpack(Buf, OutData%KinVisc) + if (RegCheckErr(Buf, RoutineName)) return + ! SpdSound + call RegUnpack(Buf, OutData%SpdSound) + if (RegCheckErr(Buf, RoutineName)) return + ! HubHeight + call RegUnpack(Buf, OutData%HubHeight) + if (RegCheckErr(Buf, RoutineName)) return + ! BlAFID + if (allocated(OutData%BlAFID)) deallocate(OutData%BlAFID) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlAFID(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlAFID.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlAFID) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AFInfo + if (allocated(OutData%AFInfo)) deallocate(OutData%AFInfo) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AFInfo(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFInfo.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AFI_UnpackParam(Buf, OutData%AFInfo(i1)) ! AFInfo + end do + end if +end subroutine SUBROUTINE AA_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(AA_InitOutputType), INTENT(IN) :: SrcInitOutputData TYPE(AA_InitOutputType), INTENT(INOUT) :: DstInitOutputData @@ -1094,535 +772,216 @@ SUBROUTINE AA_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AA_DestroyInitOutput - SUBROUTINE AA_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AA_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! WriteOutputHdr allocated yes/no - IF ( ALLOCATED(InData%WriteOutputHdr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdr upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdr)*LEN(InData%WriteOutputHdr) ! WriteOutputHdr - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputUnt allocated yes/no - IF ( ALLOCATED(InData%WriteOutputUnt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUnt upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUnt)*LEN(InData%WriteOutputUnt) ! WriteOutputUnt - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputHdrforPE allocated yes/no - IF ( ALLOCATED(InData%WriteOutputHdrforPE) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdrforPE upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdrforPE)*LEN(InData%WriteOutputHdrforPE) ! WriteOutputHdrforPE - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputUntforPE allocated yes/no - IF ( ALLOCATED(InData%WriteOutputUntforPE) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUntforPE upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUntforPE)*LEN(InData%WriteOutputUntforPE) ! WriteOutputUntforPE - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputHdrSep allocated yes/no - IF ( ALLOCATED(InData%WriteOutputHdrSep) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdrSep upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdrSep)*LEN(InData%WriteOutputHdrSep) ! WriteOutputHdrSep - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputUntSep allocated yes/no - IF ( ALLOCATED(InData%WriteOutputUntSep) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUntSep upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUntSep)*LEN(InData%WriteOutputUntSep) ! WriteOutputUntSep - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputHdrNodes allocated yes/no - IF ( ALLOCATED(InData%WriteOutputHdrNodes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdrNodes upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdrNodes)*LEN(InData%WriteOutputHdrNodes) ! WriteOutputHdrNodes - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputUntNodes allocated yes/no - IF ( ALLOCATED(InData%WriteOutputUntNodes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUntNodes upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUntNodes)*LEN(InData%WriteOutputUntNodes) ! WriteOutputUntNodes - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%delim) ! delim - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Re_BufSz = Re_BufSz + 1 ! AirDens - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%WriteOutputHdr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) - DO I = 1, LEN(InData%WriteOutputHdr) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputUnt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) - DO I = 1, LEN(InData%WriteOutputUnt) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputHdrforPE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdrforPE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdrforPE,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputHdrforPE,1), UBOUND(InData%WriteOutputHdrforPE,1) - DO I = 1, LEN(InData%WriteOutputHdrforPE) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdrforPE(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputUntforPE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputUntforPE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUntforPE,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputUntforPE,1), UBOUND(InData%WriteOutputUntforPE,1) - DO I = 1, LEN(InData%WriteOutputUntforPE) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUntforPE(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputHdrSep) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdrSep,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdrSep,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputHdrSep,1), UBOUND(InData%WriteOutputHdrSep,1) - DO I = 1, LEN(InData%WriteOutputHdrSep) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdrSep(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputUntSep) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputUntSep,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUntSep,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputUntSep,1), UBOUND(InData%WriteOutputUntSep,1) - DO I = 1, LEN(InData%WriteOutputUntSep) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUntSep(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputHdrNodes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdrNodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdrNodes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputHdrNodes,1), UBOUND(InData%WriteOutputHdrNodes,1) - DO I = 1, LEN(InData%WriteOutputHdrNodes) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdrNodes(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputUntNodes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputUntNodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUntNodes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputUntNodes,1), UBOUND(InData%WriteOutputUntNodes,1) - DO I = 1, LEN(InData%WriteOutputUntNodes) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUntNodes(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - DO I = 1, LEN(InData%delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - ReKiBuf(Re_Xferred) = InData%AirDens - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AA_PackInitOutput - - SUBROUTINE AA_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AA_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputHdr)) DEALLOCATE(OutData%WriteOutputHdr) - ALLOCATE(OutData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) - DO I = 1, LEN(OutData%WriteOutputHdr) - OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputUnt)) DEALLOCATE(OutData%WriteOutputUnt) - ALLOCATE(OutData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) - DO I = 1, LEN(OutData%WriteOutputUnt) - OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdrforPE not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputHdrforPE)) DEALLOCATE(OutData%WriteOutputHdrforPE) - ALLOCATE(OutData%WriteOutputHdrforPE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdrforPE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputHdrforPE,1), UBOUND(OutData%WriteOutputHdrforPE,1) - DO I = 1, LEN(OutData%WriteOutputHdrforPE) - OutData%WriteOutputHdrforPE(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUntforPE not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputUntforPE)) DEALLOCATE(OutData%WriteOutputUntforPE) - ALLOCATE(OutData%WriteOutputUntforPE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUntforPE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputUntforPE,1), UBOUND(OutData%WriteOutputUntforPE,1) - DO I = 1, LEN(OutData%WriteOutputUntforPE) - OutData%WriteOutputUntforPE(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdrSep not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputHdrSep)) DEALLOCATE(OutData%WriteOutputHdrSep) - ALLOCATE(OutData%WriteOutputHdrSep(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdrSep.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputHdrSep,1), UBOUND(OutData%WriteOutputHdrSep,1) - DO I = 1, LEN(OutData%WriteOutputHdrSep) - OutData%WriteOutputHdrSep(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUntSep not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputUntSep)) DEALLOCATE(OutData%WriteOutputUntSep) - ALLOCATE(OutData%WriteOutputUntSep(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUntSep.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputUntSep,1), UBOUND(OutData%WriteOutputUntSep,1) - DO I = 1, LEN(OutData%WriteOutputUntSep) - OutData%WriteOutputUntSep(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdrNodes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputHdrNodes)) DEALLOCATE(OutData%WriteOutputHdrNodes) - ALLOCATE(OutData%WriteOutputHdrNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdrNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputHdrNodes,1), UBOUND(OutData%WriteOutputHdrNodes,1) - DO I = 1, LEN(OutData%WriteOutputHdrNodes) - OutData%WriteOutputHdrNodes(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUntNodes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputUntNodes)) DEALLOCATE(OutData%WriteOutputUntNodes) - ALLOCATE(OutData%WriteOutputUntNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUntNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputUntNodes,1), UBOUND(OutData%WriteOutputUntNodes,1) - DO I = 1, LEN(OutData%WriteOutputUntNodes) - OutData%WriteOutputUntNodes(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - DO I = 1, LEN(OutData%delim) - OutData%delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%AirDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AA_UnPackInitOutput +subroutine AA_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AA_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AA_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! WriteOutputHdr + call RegPack(Buf, allocated(InData%WriteOutputHdr)) + if (allocated(InData%WriteOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPack(Buf, InData%WriteOutputHdr) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutputUnt + call RegPack(Buf, allocated(InData%WriteOutputUnt)) + if (allocated(InData%WriteOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPack(Buf, InData%WriteOutputUnt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutputHdrforPE + call RegPack(Buf, allocated(InData%WriteOutputHdrforPE)) + if (allocated(InData%WriteOutputHdrforPE)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdrforPE), ubound(InData%WriteOutputHdrforPE)) + call RegPack(Buf, InData%WriteOutputHdrforPE) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutputUntforPE + call RegPack(Buf, allocated(InData%WriteOutputUntforPE)) + if (allocated(InData%WriteOutputUntforPE)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUntforPE), ubound(InData%WriteOutputUntforPE)) + call RegPack(Buf, InData%WriteOutputUntforPE) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutputHdrSep + call RegPack(Buf, allocated(InData%WriteOutputHdrSep)) + if (allocated(InData%WriteOutputHdrSep)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdrSep), ubound(InData%WriteOutputHdrSep)) + call RegPack(Buf, InData%WriteOutputHdrSep) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutputUntSep + call RegPack(Buf, allocated(InData%WriteOutputUntSep)) + if (allocated(InData%WriteOutputUntSep)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUntSep), ubound(InData%WriteOutputUntSep)) + call RegPack(Buf, InData%WriteOutputUntSep) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutputHdrNodes + call RegPack(Buf, allocated(InData%WriteOutputHdrNodes)) + if (allocated(InData%WriteOutputHdrNodes)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdrNodes), ubound(InData%WriteOutputHdrNodes)) + call RegPack(Buf, InData%WriteOutputHdrNodes) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutputUntNodes + call RegPack(Buf, allocated(InData%WriteOutputUntNodes)) + if (allocated(InData%WriteOutputUntNodes)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUntNodes), ubound(InData%WriteOutputUntNodes)) + call RegPack(Buf, InData%WriteOutputUntNodes) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! delim + call RegPack(Buf, InData%delim) + if (RegCheckErr(Buf, RoutineName)) return + ! Ver + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + if (RegCheckErr(Buf, RoutineName)) return + ! AirDens + call RegPack(Buf, InData%AirDens) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AA_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AA_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AA_UnPackInitOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! WriteOutputHdr + if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WriteOutputUnt + if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WriteOutputHdrforPE + if (allocated(OutData%WriteOutputHdrforPE)) deallocate(OutData%WriteOutputHdrforPE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdrforPE(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdrforPE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdrforPE) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WriteOutputUntforPE + if (allocated(OutData%WriteOutputUntforPE)) deallocate(OutData%WriteOutputUntforPE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUntforPE(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUntforPE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUntforPE) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WriteOutputHdrSep + if (allocated(OutData%WriteOutputHdrSep)) deallocate(OutData%WriteOutputHdrSep) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdrSep(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdrSep.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdrSep) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WriteOutputUntSep + if (allocated(OutData%WriteOutputUntSep)) deallocate(OutData%WriteOutputUntSep) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUntSep(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUntSep.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUntSep) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WriteOutputHdrNodes + if (allocated(OutData%WriteOutputHdrNodes)) deallocate(OutData%WriteOutputHdrNodes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdrNodes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdrNodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdrNodes) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WriteOutputUntNodes + if (allocated(OutData%WriteOutputUntNodes)) deallocate(OutData%WriteOutputUntNodes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUntNodes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUntNodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUntNodes) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! delim + call RegUnpack(Buf, OutData%delim) + if (RegCheckErr(Buf, RoutineName)) return + ! Ver + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + ! AirDens + call RegUnpack(Buf, OutData%AirDens) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE AA_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) TYPE(AA_InputFile), INTENT(IN) :: SrcInputFileData TYPE(AA_InputFile), INTENT(INOUT) :: DstInputFileData @@ -1962,1089 +1321,521 @@ SUBROUTINE AA_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE AA_DestroyInputFile - SUBROUTINE AA_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AA_InputFile), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_PackInputFile' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! DT_AA - Int_BufSz = Int_BufSz + 1 ! IBLUNT - Int_BufSz = Int_BufSz + 1 ! ILAM - Int_BufSz = Int_BufSz + 1 ! ITIP - Int_BufSz = Int_BufSz + 1 ! ITRIP - Int_BufSz = Int_BufSz + 1 ! ITURB - Int_BufSz = Int_BufSz + 1 ! IInflow - Int_BufSz = Int_BufSz + 1 ! X_BLMethod - Int_BufSz = Int_BufSz + 1 ! TICalcMeth - Int_BufSz = Int_BufSz + 1 ! NReListBL - Int_BufSz = Int_BufSz + 1 ! aweightflag - Int_BufSz = Int_BufSz + 1 ! ROUND - Re_BufSz = Re_BufSz + 1 ! ALPRAT - Int_BufSz = Int_BufSz + 1 ! AA_Bl_Prcntge - Int_BufSz = Int_BufSz + 1 ! NrObsLoc - Int_BufSz = Int_BufSz + 1 ! ObsX allocated yes/no - IF ( ALLOCATED(InData%ObsX) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ObsX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ObsX) ! ObsX - END IF - Int_BufSz = Int_BufSz + 1 ! ObsY allocated yes/no - IF ( ALLOCATED(InData%ObsY) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ObsY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ObsY) ! ObsY - END IF - Int_BufSz = Int_BufSz + 1 ! ObsZ allocated yes/no - IF ( ALLOCATED(InData%ObsZ) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ObsZ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ObsZ) ! ObsZ - END IF - Int_BufSz = Int_BufSz + 1 ! BladeProps allocated yes/no - IF ( ALLOCATED(InData%BladeProps) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladeProps upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%BladeProps,1), UBOUND(InData%BladeProps,1) - Int_BufSz = Int_BufSz + 3 ! BladeProps: size of buffers for each call to pack subtype - CALL AA_PackBladePropsType( Re_Buf, Db_Buf, Int_Buf, InData%BladeProps(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BladeProps - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeProps - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeProps - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeProps - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NrOutFile - Int_BufSz = Int_BufSz + 1 ! AAoutfile allocated yes/no - IF ( ALLOCATED(InData%AAoutfile) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AAoutfile upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%AAoutfile)*LEN(InData%AAoutfile) ! AAoutfile - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%TICalcTabFile) ! TICalcTabFile - Int_BufSz = Int_BufSz + 1*LEN(InData%FTitle) ! FTitle - Db_BufSz = Db_BufSz + 1 ! AAStart - Re_BufSz = Re_BufSz + 1 ! Lturb - Re_BufSz = Re_BufSz + 1 ! AvgV - Int_BufSz = Int_BufSz + 1 ! ReListBL allocated yes/no - IF ( ALLOCATED(InData%ReListBL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ReListBL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ReListBL) ! ReListBL - END IF - Int_BufSz = Int_BufSz + 1 ! AoAListBL allocated yes/no - IF ( ALLOCATED(InData%AoAListBL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AoAListBL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AoAListBL) ! AoAListBL - END IF - Int_BufSz = Int_BufSz + 1 ! Pres_DispThick allocated yes/no - IF ( ALLOCATED(InData%Pres_DispThick) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Pres_DispThick upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Pres_DispThick) ! Pres_DispThick - END IF - Int_BufSz = Int_BufSz + 1 ! Suct_DispThick allocated yes/no - IF ( ALLOCATED(InData%Suct_DispThick) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Suct_DispThick upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Suct_DispThick) ! Suct_DispThick - END IF - Int_BufSz = Int_BufSz + 1 ! Pres_BLThick allocated yes/no - IF ( ALLOCATED(InData%Pres_BLThick) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Pres_BLThick upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Pres_BLThick) ! Pres_BLThick - END IF - Int_BufSz = Int_BufSz + 1 ! Suct_BLThick allocated yes/no - IF ( ALLOCATED(InData%Suct_BLThick) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Suct_BLThick upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Suct_BLThick) ! Suct_BLThick - END IF - Int_BufSz = Int_BufSz + 1 ! Pres_Cf allocated yes/no - IF ( ALLOCATED(InData%Pres_Cf) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Pres_Cf upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Pres_Cf) ! Pres_Cf - END IF - Int_BufSz = Int_BufSz + 1 ! Suct_Cf allocated yes/no - IF ( ALLOCATED(InData%Suct_Cf) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Suct_Cf upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Suct_Cf) ! Suct_Cf - END IF - Int_BufSz = Int_BufSz + 1 ! Pres_EdgeVelRat allocated yes/no - IF ( ALLOCATED(InData%Pres_EdgeVelRat) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Pres_EdgeVelRat upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Pres_EdgeVelRat) ! Pres_EdgeVelRat - END IF - Int_BufSz = Int_BufSz + 1 ! Suct_EdgeVelRat allocated yes/no - IF ( ALLOCATED(InData%Suct_EdgeVelRat) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Suct_EdgeVelRat upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Suct_EdgeVelRat) ! Suct_EdgeVelRat - END IF - Int_BufSz = Int_BufSz + 1 ! TI_Grid_In allocated yes/no - IF ( ALLOCATED(InData%TI_Grid_In) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TI_Grid_In upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TI_Grid_In) ! TI_Grid_In - END IF - Re_BufSz = Re_BufSz + 1 ! dz_turb_in - Re_BufSz = Re_BufSz + 1 ! dy_turb_in - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%DT_AA - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%IBLUNT - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ILAM - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ITIP - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ITRIP - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ITURB - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%IInflow - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%X_BLMethod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TICalcMeth - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NReListBL - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%aweightflag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%ROUND, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ALPRAT - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%AA_Bl_Prcntge - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NrObsLoc - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%ObsX) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ObsX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ObsX,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ObsX,1), UBOUND(InData%ObsX,1) - ReKiBuf(Re_Xferred) = InData%ObsX(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ObsY) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ObsY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ObsY,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ObsY,1), UBOUND(InData%ObsY,1) - ReKiBuf(Re_Xferred) = InData%ObsY(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ObsZ) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ObsZ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ObsZ,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ObsZ,1), UBOUND(InData%ObsZ,1) - ReKiBuf(Re_Xferred) = InData%ObsZ(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BladeProps) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeProps,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeProps,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BladeProps,1), UBOUND(InData%BladeProps,1) - CALL AA_PackBladePropsType( Re_Buf, Db_Buf, Int_Buf, InData%BladeProps(i1), ErrStat2, ErrMsg2, OnlySize ) ! BladeProps - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NrOutFile - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%AAoutfile) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AAoutfile,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AAoutfile,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AAoutfile,1), UBOUND(InData%AAoutfile,1) - DO I = 1, LEN(InData%AAoutfile) - IntKiBuf(Int_Xferred) = ICHAR(InData%AAoutfile(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - DO I = 1, LEN(InData%TICalcTabFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%TICalcTabFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%FTitle) - IntKiBuf(Int_Xferred) = ICHAR(InData%FTitle(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf(Db_Xferred) = InData%AAStart - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Lturb - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AvgV - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%ReListBL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ReListBL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ReListBL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ReListBL,1), UBOUND(InData%ReListBL,1) - ReKiBuf(Re_Xferred) = InData%ReListBL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AoAListBL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AoAListBL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AoAListBL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AoAListBL,1), UBOUND(InData%AoAListBL,1) - ReKiBuf(Re_Xferred) = InData%AoAListBL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Pres_DispThick) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pres_DispThick,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_DispThick,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pres_DispThick,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_DispThick,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pres_DispThick,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_DispThick,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Pres_DispThick,3), UBOUND(InData%Pres_DispThick,3) - DO i2 = LBOUND(InData%Pres_DispThick,2), UBOUND(InData%Pres_DispThick,2) - DO i1 = LBOUND(InData%Pres_DispThick,1), UBOUND(InData%Pres_DispThick,1) - ReKiBuf(Re_Xferred) = InData%Pres_DispThick(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Suct_DispThick) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Suct_DispThick,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_DispThick,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Suct_DispThick,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_DispThick,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Suct_DispThick,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_DispThick,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Suct_DispThick,3), UBOUND(InData%Suct_DispThick,3) - DO i2 = LBOUND(InData%Suct_DispThick,2), UBOUND(InData%Suct_DispThick,2) - DO i1 = LBOUND(InData%Suct_DispThick,1), UBOUND(InData%Suct_DispThick,1) - ReKiBuf(Re_Xferred) = InData%Suct_DispThick(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Pres_BLThick) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pres_BLThick,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_BLThick,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pres_BLThick,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_BLThick,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pres_BLThick,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_BLThick,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Pres_BLThick,3), UBOUND(InData%Pres_BLThick,3) - DO i2 = LBOUND(InData%Pres_BLThick,2), UBOUND(InData%Pres_BLThick,2) - DO i1 = LBOUND(InData%Pres_BLThick,1), UBOUND(InData%Pres_BLThick,1) - ReKiBuf(Re_Xferred) = InData%Pres_BLThick(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Suct_BLThick) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Suct_BLThick,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_BLThick,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Suct_BLThick,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_BLThick,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Suct_BLThick,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_BLThick,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Suct_BLThick,3), UBOUND(InData%Suct_BLThick,3) - DO i2 = LBOUND(InData%Suct_BLThick,2), UBOUND(InData%Suct_BLThick,2) - DO i1 = LBOUND(InData%Suct_BLThick,1), UBOUND(InData%Suct_BLThick,1) - ReKiBuf(Re_Xferred) = InData%Suct_BLThick(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Pres_Cf) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pres_Cf,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_Cf,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pres_Cf,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_Cf,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pres_Cf,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_Cf,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Pres_Cf,3), UBOUND(InData%Pres_Cf,3) - DO i2 = LBOUND(InData%Pres_Cf,2), UBOUND(InData%Pres_Cf,2) - DO i1 = LBOUND(InData%Pres_Cf,1), UBOUND(InData%Pres_Cf,1) - ReKiBuf(Re_Xferred) = InData%Pres_Cf(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Suct_Cf) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Suct_Cf,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_Cf,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Suct_Cf,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_Cf,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Suct_Cf,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_Cf,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Suct_Cf,3), UBOUND(InData%Suct_Cf,3) - DO i2 = LBOUND(InData%Suct_Cf,2), UBOUND(InData%Suct_Cf,2) - DO i1 = LBOUND(InData%Suct_Cf,1), UBOUND(InData%Suct_Cf,1) - ReKiBuf(Re_Xferred) = InData%Suct_Cf(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Pres_EdgeVelRat) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pres_EdgeVelRat,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_EdgeVelRat,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pres_EdgeVelRat,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_EdgeVelRat,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pres_EdgeVelRat,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pres_EdgeVelRat,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Pres_EdgeVelRat,3), UBOUND(InData%Pres_EdgeVelRat,3) - DO i2 = LBOUND(InData%Pres_EdgeVelRat,2), UBOUND(InData%Pres_EdgeVelRat,2) - DO i1 = LBOUND(InData%Pres_EdgeVelRat,1), UBOUND(InData%Pres_EdgeVelRat,1) - ReKiBuf(Re_Xferred) = InData%Pres_EdgeVelRat(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Suct_EdgeVelRat) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Suct_EdgeVelRat,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_EdgeVelRat,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Suct_EdgeVelRat,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_EdgeVelRat,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Suct_EdgeVelRat,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Suct_EdgeVelRat,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Suct_EdgeVelRat,3), UBOUND(InData%Suct_EdgeVelRat,3) - DO i2 = LBOUND(InData%Suct_EdgeVelRat,2), UBOUND(InData%Suct_EdgeVelRat,2) - DO i1 = LBOUND(InData%Suct_EdgeVelRat,1), UBOUND(InData%Suct_EdgeVelRat,1) - ReKiBuf(Re_Xferred) = InData%Suct_EdgeVelRat(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TI_Grid_In) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TI_Grid_In,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI_Grid_In,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TI_Grid_In,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI_Grid_In,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TI_Grid_In,2), UBOUND(InData%TI_Grid_In,2) - DO i1 = LBOUND(InData%TI_Grid_In,1), UBOUND(InData%TI_Grid_In,1) - ReKiBuf(Re_Xferred) = InData%TI_Grid_In(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%dz_turb_in - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dy_turb_in - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AA_PackInputFile - - SUBROUTINE AA_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AA_InputFile), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_UnPackInputFile' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DT_AA = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%IBLUNT = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ILAM = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ITIP = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ITRIP = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ITURB = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%IInflow = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%X_BLMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TICalcMeth = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NReListBL = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%aweightflag = TRANSFER(IntKiBuf(Int_Xferred), OutData%aweightflag) - Int_Xferred = Int_Xferred + 1 - OutData%ROUND = TRANSFER(IntKiBuf(Int_Xferred), OutData%ROUND) - Int_Xferred = Int_Xferred + 1 - OutData%ALPRAT = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AA_Bl_Prcntge = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NrObsLoc = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ObsX not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ObsX)) DEALLOCATE(OutData%ObsX) - ALLOCATE(OutData%ObsX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ObsX,1), UBOUND(OutData%ObsX,1) - OutData%ObsX(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ObsY not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ObsY)) DEALLOCATE(OutData%ObsY) - ALLOCATE(OutData%ObsY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ObsY,1), UBOUND(OutData%ObsY,1) - OutData%ObsY(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ObsZ not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ObsZ)) DEALLOCATE(OutData%ObsZ) - ALLOCATE(OutData%ObsZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ObsZ,1), UBOUND(OutData%ObsZ,1) - OutData%ObsZ(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeProps not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BladeProps)) DEALLOCATE(OutData%BladeProps) - ALLOCATE(OutData%BladeProps(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeProps.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladeProps,1), UBOUND(OutData%BladeProps,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AA_UnpackBladePropsType( Re_Buf, Db_Buf, Int_Buf, OutData%BladeProps(i1), ErrStat2, ErrMsg2 ) ! BladeProps - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - OutData%NrOutFile = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AAoutfile not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AAoutfile)) DEALLOCATE(OutData%AAoutfile) - ALLOCATE(OutData%AAoutfile(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AAoutfile.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AAoutfile,1), UBOUND(OutData%AAoutfile,1) - DO I = 1, LEN(OutData%AAoutfile) - OutData%AAoutfile(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - DO I = 1, LEN(OutData%TICalcTabFile) - OutData%TICalcTabFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%FTitle) - OutData%FTitle(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%AAStart = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Lturb = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AvgV = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ReListBL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ReListBL)) DEALLOCATE(OutData%ReListBL) - ALLOCATE(OutData%ReListBL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ReListBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ReListBL,1), UBOUND(OutData%ReListBL,1) - OutData%ReListBL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AoAListBL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AoAListBL)) DEALLOCATE(OutData%AoAListBL) - ALLOCATE(OutData%AoAListBL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AoAListBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AoAListBL,1), UBOUND(OutData%AoAListBL,1) - OutData%AoAListBL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Pres_DispThick not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Pres_DispThick)) DEALLOCATE(OutData%Pres_DispThick) - ALLOCATE(OutData%Pres_DispThick(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Pres_DispThick.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Pres_DispThick,3), UBOUND(OutData%Pres_DispThick,3) - DO i2 = LBOUND(OutData%Pres_DispThick,2), UBOUND(OutData%Pres_DispThick,2) - DO i1 = LBOUND(OutData%Pres_DispThick,1), UBOUND(OutData%Pres_DispThick,1) - OutData%Pres_DispThick(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Suct_DispThick not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Suct_DispThick)) DEALLOCATE(OutData%Suct_DispThick) - ALLOCATE(OutData%Suct_DispThick(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Suct_DispThick.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Suct_DispThick,3), UBOUND(OutData%Suct_DispThick,3) - DO i2 = LBOUND(OutData%Suct_DispThick,2), UBOUND(OutData%Suct_DispThick,2) - DO i1 = LBOUND(OutData%Suct_DispThick,1), UBOUND(OutData%Suct_DispThick,1) - OutData%Suct_DispThick(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Pres_BLThick not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Pres_BLThick)) DEALLOCATE(OutData%Pres_BLThick) - ALLOCATE(OutData%Pres_BLThick(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Pres_BLThick.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Pres_BLThick,3), UBOUND(OutData%Pres_BLThick,3) - DO i2 = LBOUND(OutData%Pres_BLThick,2), UBOUND(OutData%Pres_BLThick,2) - DO i1 = LBOUND(OutData%Pres_BLThick,1), UBOUND(OutData%Pres_BLThick,1) - OutData%Pres_BLThick(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Suct_BLThick not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Suct_BLThick)) DEALLOCATE(OutData%Suct_BLThick) - ALLOCATE(OutData%Suct_BLThick(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Suct_BLThick.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Suct_BLThick,3), UBOUND(OutData%Suct_BLThick,3) - DO i2 = LBOUND(OutData%Suct_BLThick,2), UBOUND(OutData%Suct_BLThick,2) - DO i1 = LBOUND(OutData%Suct_BLThick,1), UBOUND(OutData%Suct_BLThick,1) - OutData%Suct_BLThick(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Pres_Cf not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Pres_Cf)) DEALLOCATE(OutData%Pres_Cf) - ALLOCATE(OutData%Pres_Cf(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Pres_Cf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Pres_Cf,3), UBOUND(OutData%Pres_Cf,3) - DO i2 = LBOUND(OutData%Pres_Cf,2), UBOUND(OutData%Pres_Cf,2) - DO i1 = LBOUND(OutData%Pres_Cf,1), UBOUND(OutData%Pres_Cf,1) - OutData%Pres_Cf(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Suct_Cf not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Suct_Cf)) DEALLOCATE(OutData%Suct_Cf) - ALLOCATE(OutData%Suct_Cf(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Suct_Cf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Suct_Cf,3), UBOUND(OutData%Suct_Cf,3) - DO i2 = LBOUND(OutData%Suct_Cf,2), UBOUND(OutData%Suct_Cf,2) - DO i1 = LBOUND(OutData%Suct_Cf,1), UBOUND(OutData%Suct_Cf,1) - OutData%Suct_Cf(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Pres_EdgeVelRat not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Pres_EdgeVelRat)) DEALLOCATE(OutData%Pres_EdgeVelRat) - ALLOCATE(OutData%Pres_EdgeVelRat(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Pres_EdgeVelRat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Pres_EdgeVelRat,3), UBOUND(OutData%Pres_EdgeVelRat,3) - DO i2 = LBOUND(OutData%Pres_EdgeVelRat,2), UBOUND(OutData%Pres_EdgeVelRat,2) - DO i1 = LBOUND(OutData%Pres_EdgeVelRat,1), UBOUND(OutData%Pres_EdgeVelRat,1) - OutData%Pres_EdgeVelRat(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Suct_EdgeVelRat not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Suct_EdgeVelRat)) DEALLOCATE(OutData%Suct_EdgeVelRat) - ALLOCATE(OutData%Suct_EdgeVelRat(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Suct_EdgeVelRat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Suct_EdgeVelRat,3), UBOUND(OutData%Suct_EdgeVelRat,3) - DO i2 = LBOUND(OutData%Suct_EdgeVelRat,2), UBOUND(OutData%Suct_EdgeVelRat,2) - DO i1 = LBOUND(OutData%Suct_EdgeVelRat,1), UBOUND(OutData%Suct_EdgeVelRat,1) - OutData%Suct_EdgeVelRat(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TI_Grid_In not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TI_Grid_In)) DEALLOCATE(OutData%TI_Grid_In) - ALLOCATE(OutData%TI_Grid_In(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI_Grid_In.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TI_Grid_In,2), UBOUND(OutData%TI_Grid_In,2) - DO i1 = LBOUND(OutData%TI_Grid_In,1), UBOUND(OutData%TI_Grid_In,1) - OutData%TI_Grid_In(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%dz_turb_in = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dy_turb_in = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AA_UnPackInputFile +subroutine AA_PackInputFile(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AA_InputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'AA_PackInputFile' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + if (Buf%ErrStat >= AbortErrLev) return + ! DT_AA + call RegPack(Buf, InData%DT_AA) + if (RegCheckErr(Buf, RoutineName)) return + ! IBLUNT + call RegPack(Buf, InData%IBLUNT) + if (RegCheckErr(Buf, RoutineName)) return + ! ILAM + call RegPack(Buf, InData%ILAM) + if (RegCheckErr(Buf, RoutineName)) return + ! ITIP + call RegPack(Buf, InData%ITIP) + if (RegCheckErr(Buf, RoutineName)) return + ! ITRIP + call RegPack(Buf, InData%ITRIP) + if (RegCheckErr(Buf, RoutineName)) return + ! ITURB + call RegPack(Buf, InData%ITURB) + if (RegCheckErr(Buf, RoutineName)) return + ! IInflow + call RegPack(Buf, InData%IInflow) + if (RegCheckErr(Buf, RoutineName)) return + ! X_BLMethod + call RegPack(Buf, InData%X_BLMethod) + if (RegCheckErr(Buf, RoutineName)) return + ! TICalcMeth + call RegPack(Buf, InData%TICalcMeth) + if (RegCheckErr(Buf, RoutineName)) return + ! NReListBL + call RegPack(Buf, InData%NReListBL) + if (RegCheckErr(Buf, RoutineName)) return + ! aweightflag + call RegPack(Buf, InData%aweightflag) + if (RegCheckErr(Buf, RoutineName)) return + ! ROUND + call RegPack(Buf, InData%ROUND) + if (RegCheckErr(Buf, RoutineName)) return + ! ALPRAT + call RegPack(Buf, InData%ALPRAT) + if (RegCheckErr(Buf, RoutineName)) return + ! AA_Bl_Prcntge + call RegPack(Buf, InData%AA_Bl_Prcntge) + if (RegCheckErr(Buf, RoutineName)) return + ! NrObsLoc + call RegPack(Buf, InData%NrObsLoc) + if (RegCheckErr(Buf, RoutineName)) return + ! ObsX + call RegPack(Buf, allocated(InData%ObsX)) + if (allocated(InData%ObsX)) then + call RegPackBounds(Buf, 1, lbound(InData%ObsX), ubound(InData%ObsX)) + call RegPack(Buf, InData%ObsX) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ObsY + call RegPack(Buf, allocated(InData%ObsY)) + if (allocated(InData%ObsY)) then + call RegPackBounds(Buf, 1, lbound(InData%ObsY), ubound(InData%ObsY)) + call RegPack(Buf, InData%ObsY) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ObsZ + call RegPack(Buf, allocated(InData%ObsZ)) + if (allocated(InData%ObsZ)) then + call RegPackBounds(Buf, 1, lbound(InData%ObsZ), ubound(InData%ObsZ)) + call RegPack(Buf, InData%ObsZ) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BladeProps + call RegPack(Buf, allocated(InData%BladeProps)) + if (allocated(InData%BladeProps)) then + call RegPackBounds(Buf, 1, lbound(InData%BladeProps), ubound(InData%BladeProps)) + LB(1:1) = lbound(InData%BladeProps) + UB(1:1) = ubound(InData%BladeProps) + do i1 = LB(1), UB(1) + call AA_PackBladePropsType(Buf, InData%BladeProps(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NrOutFile + call RegPack(Buf, InData%NrOutFile) + if (RegCheckErr(Buf, RoutineName)) return + ! AAoutfile + call RegPack(Buf, allocated(InData%AAoutfile)) + if (allocated(InData%AAoutfile)) then + call RegPackBounds(Buf, 1, lbound(InData%AAoutfile), ubound(InData%AAoutfile)) + call RegPack(Buf, InData%AAoutfile) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TICalcTabFile + call RegPack(Buf, InData%TICalcTabFile) + if (RegCheckErr(Buf, RoutineName)) return + ! FTitle + call RegPack(Buf, InData%FTitle) + if (RegCheckErr(Buf, RoutineName)) return + ! AAStart + call RegPack(Buf, InData%AAStart) + if (RegCheckErr(Buf, RoutineName)) return + ! Lturb + call RegPack(Buf, InData%Lturb) + if (RegCheckErr(Buf, RoutineName)) return + ! AvgV + call RegPack(Buf, InData%AvgV) + if (RegCheckErr(Buf, RoutineName)) return + ! ReListBL + call RegPack(Buf, allocated(InData%ReListBL)) + if (allocated(InData%ReListBL)) then + call RegPackBounds(Buf, 1, lbound(InData%ReListBL), ubound(InData%ReListBL)) + call RegPack(Buf, InData%ReListBL) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AoAListBL + call RegPack(Buf, allocated(InData%AoAListBL)) + if (allocated(InData%AoAListBL)) then + call RegPackBounds(Buf, 1, lbound(InData%AoAListBL), ubound(InData%AoAListBL)) + call RegPack(Buf, InData%AoAListBL) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Pres_DispThick + call RegPack(Buf, allocated(InData%Pres_DispThick)) + if (allocated(InData%Pres_DispThick)) then + call RegPackBounds(Buf, 3, lbound(InData%Pres_DispThick), ubound(InData%Pres_DispThick)) + call RegPack(Buf, InData%Pres_DispThick) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Suct_DispThick + call RegPack(Buf, allocated(InData%Suct_DispThick)) + if (allocated(InData%Suct_DispThick)) then + call RegPackBounds(Buf, 3, lbound(InData%Suct_DispThick), ubound(InData%Suct_DispThick)) + call RegPack(Buf, InData%Suct_DispThick) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Pres_BLThick + call RegPack(Buf, allocated(InData%Pres_BLThick)) + if (allocated(InData%Pres_BLThick)) then + call RegPackBounds(Buf, 3, lbound(InData%Pres_BLThick), ubound(InData%Pres_BLThick)) + call RegPack(Buf, InData%Pres_BLThick) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Suct_BLThick + call RegPack(Buf, allocated(InData%Suct_BLThick)) + if (allocated(InData%Suct_BLThick)) then + call RegPackBounds(Buf, 3, lbound(InData%Suct_BLThick), ubound(InData%Suct_BLThick)) + call RegPack(Buf, InData%Suct_BLThick) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Pres_Cf + call RegPack(Buf, allocated(InData%Pres_Cf)) + if (allocated(InData%Pres_Cf)) then + call RegPackBounds(Buf, 3, lbound(InData%Pres_Cf), ubound(InData%Pres_Cf)) + call RegPack(Buf, InData%Pres_Cf) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Suct_Cf + call RegPack(Buf, allocated(InData%Suct_Cf)) + if (allocated(InData%Suct_Cf)) then + call RegPackBounds(Buf, 3, lbound(InData%Suct_Cf), ubound(InData%Suct_Cf)) + call RegPack(Buf, InData%Suct_Cf) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Pres_EdgeVelRat + call RegPack(Buf, allocated(InData%Pres_EdgeVelRat)) + if (allocated(InData%Pres_EdgeVelRat)) then + call RegPackBounds(Buf, 3, lbound(InData%Pres_EdgeVelRat), ubound(InData%Pres_EdgeVelRat)) + call RegPack(Buf, InData%Pres_EdgeVelRat) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Suct_EdgeVelRat + call RegPack(Buf, allocated(InData%Suct_EdgeVelRat)) + if (allocated(InData%Suct_EdgeVelRat)) then + call RegPackBounds(Buf, 3, lbound(InData%Suct_EdgeVelRat), ubound(InData%Suct_EdgeVelRat)) + call RegPack(Buf, InData%Suct_EdgeVelRat) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TI_Grid_In + call RegPack(Buf, allocated(InData%TI_Grid_In)) + if (allocated(InData%TI_Grid_In)) then + call RegPackBounds(Buf, 2, lbound(InData%TI_Grid_In), ubound(InData%TI_Grid_In)) + call RegPack(Buf, InData%TI_Grid_In) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! dz_turb_in + call RegPack(Buf, InData%dz_turb_in) + if (RegCheckErr(Buf, RoutineName)) return + ! dy_turb_in + call RegPack(Buf, InData%dy_turb_in) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AA_UnPackInputFile(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AA_InputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AA_UnPackInputFile' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! DT_AA + call RegUnpack(Buf, OutData%DT_AA) + if (RegCheckErr(Buf, RoutineName)) return + ! IBLUNT + call RegUnpack(Buf, OutData%IBLUNT) + if (RegCheckErr(Buf, RoutineName)) return + ! ILAM + call RegUnpack(Buf, OutData%ILAM) + if (RegCheckErr(Buf, RoutineName)) return + ! ITIP + call RegUnpack(Buf, OutData%ITIP) + if (RegCheckErr(Buf, RoutineName)) return + ! ITRIP + call RegUnpack(Buf, OutData%ITRIP) + if (RegCheckErr(Buf, RoutineName)) return + ! ITURB + call RegUnpack(Buf, OutData%ITURB) + if (RegCheckErr(Buf, RoutineName)) return + ! IInflow + call RegUnpack(Buf, OutData%IInflow) + if (RegCheckErr(Buf, RoutineName)) return + ! X_BLMethod + call RegUnpack(Buf, OutData%X_BLMethod) + if (RegCheckErr(Buf, RoutineName)) return + ! TICalcMeth + call RegUnpack(Buf, OutData%TICalcMeth) + if (RegCheckErr(Buf, RoutineName)) return + ! NReListBL + call RegUnpack(Buf, OutData%NReListBL) + if (RegCheckErr(Buf, RoutineName)) return + ! aweightflag + call RegUnpack(Buf, OutData%aweightflag) + if (RegCheckErr(Buf, RoutineName)) return + ! ROUND + call RegUnpack(Buf, OutData%ROUND) + if (RegCheckErr(Buf, RoutineName)) return + ! ALPRAT + call RegUnpack(Buf, OutData%ALPRAT) + if (RegCheckErr(Buf, RoutineName)) return + ! AA_Bl_Prcntge + call RegUnpack(Buf, OutData%AA_Bl_Prcntge) + if (RegCheckErr(Buf, RoutineName)) return + ! NrObsLoc + call RegUnpack(Buf, OutData%NrObsLoc) + if (RegCheckErr(Buf, RoutineName)) return + ! ObsX + if (allocated(OutData%ObsX)) deallocate(OutData%ObsX) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ObsX(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ObsX) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ObsY + if (allocated(OutData%ObsY)) deallocate(OutData%ObsY) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ObsY(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ObsY) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ObsZ + if (allocated(OutData%ObsZ)) deallocate(OutData%ObsZ) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ObsZ(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsZ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ObsZ) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BladeProps + if (allocated(OutData%BladeProps)) deallocate(OutData%BladeProps) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BladeProps(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeProps.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AA_UnpackBladePropsType(Buf, OutData%BladeProps(i1)) ! BladeProps + end do + end if + ! NrOutFile + call RegUnpack(Buf, OutData%NrOutFile) + if (RegCheckErr(Buf, RoutineName)) return + ! AAoutfile + if (allocated(OutData%AAoutfile)) deallocate(OutData%AAoutfile) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AAoutfile(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AAoutfile.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AAoutfile) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TICalcTabFile + call RegUnpack(Buf, OutData%TICalcTabFile) + if (RegCheckErr(Buf, RoutineName)) return + ! FTitle + call RegUnpack(Buf, OutData%FTitle) + if (RegCheckErr(Buf, RoutineName)) return + ! AAStart + call RegUnpack(Buf, OutData%AAStart) + if (RegCheckErr(Buf, RoutineName)) return + ! Lturb + call RegUnpack(Buf, OutData%Lturb) + if (RegCheckErr(Buf, RoutineName)) return + ! AvgV + call RegUnpack(Buf, OutData%AvgV) + if (RegCheckErr(Buf, RoutineName)) return + ! ReListBL + if (allocated(OutData%ReListBL)) deallocate(OutData%ReListBL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ReListBL(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ReListBL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ReListBL) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AoAListBL + if (allocated(OutData%AoAListBL)) deallocate(OutData%AoAListBL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AoAListBL(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AoAListBL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AoAListBL) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Pres_DispThick + if (allocated(OutData%Pres_DispThick)) deallocate(OutData%Pres_DispThick) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Pres_DispThick(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Pres_DispThick.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Pres_DispThick) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Suct_DispThick + if (allocated(OutData%Suct_DispThick)) deallocate(OutData%Suct_DispThick) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Suct_DispThick(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Suct_DispThick.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Suct_DispThick) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Pres_BLThick + if (allocated(OutData%Pres_BLThick)) deallocate(OutData%Pres_BLThick) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Pres_BLThick(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Pres_BLThick.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Pres_BLThick) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Suct_BLThick + if (allocated(OutData%Suct_BLThick)) deallocate(OutData%Suct_BLThick) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Suct_BLThick(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Suct_BLThick.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Suct_BLThick) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Pres_Cf + if (allocated(OutData%Pres_Cf)) deallocate(OutData%Pres_Cf) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Pres_Cf(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Pres_Cf.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Pres_Cf) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Suct_Cf + if (allocated(OutData%Suct_Cf)) deallocate(OutData%Suct_Cf) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Suct_Cf(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Suct_Cf.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Suct_Cf) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Pres_EdgeVelRat + if (allocated(OutData%Pres_EdgeVelRat)) deallocate(OutData%Pres_EdgeVelRat) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Pres_EdgeVelRat(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Pres_EdgeVelRat.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Pres_EdgeVelRat) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Suct_EdgeVelRat + if (allocated(OutData%Suct_EdgeVelRat)) deallocate(OutData%Suct_EdgeVelRat) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Suct_EdgeVelRat(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Suct_EdgeVelRat.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Suct_EdgeVelRat) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TI_Grid_In + if (allocated(OutData%TI_Grid_In)) deallocate(OutData%TI_Grid_In) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TI_Grid_In(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI_Grid_In.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TI_Grid_In) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! dz_turb_in + call RegUnpack(Buf, OutData%dz_turb_in) + if (RegCheckErr(Buf, RoutineName)) return + ! dy_turb_in + call RegUnpack(Buf, OutData%dy_turb_in) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE AA_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(AA_ContinuousStateType), INTENT(IN) :: SrcContStateData TYPE(AA_ContinuousStateType), INTENT(INOUT) :: DstContStateData @@ -3077,103 +1868,26 @@ SUBROUTINE AA_DestroyContState( ContStateData, ErrStat, ErrMsg ) END SUBROUTINE AA_DestroyContState - SUBROUTINE AA_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AA_ContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_PackContState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyContState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AA_PackContState - - SUBROUTINE AA_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AA_ContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_UnPackContState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyContState = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AA_UnPackContState +subroutine AA_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AA_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AA_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyContState + call RegPack(Buf, InData%DummyContState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AA_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AA_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AA_UnPackContState' + if (Buf%ErrStat /= ErrID_None) return + ! DummyContState + call RegUnpack(Buf, OutData%DummyContState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE AA_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(AA_DiscreteStateType), INTENT(IN) :: SrcDiscStateData TYPE(AA_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData @@ -3399,649 +2113,265 @@ SUBROUTINE AA_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE AA_DestroyDiscState - SUBROUTINE AA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AA_DiscreteStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_PackDiscState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! MeanVrel allocated yes/no - IF ( ALLOCATED(InData%MeanVrel) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MeanVrel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MeanVrel) ! MeanVrel - END IF - Int_BufSz = Int_BufSz + 1 ! VrelSq allocated yes/no - IF ( ALLOCATED(InData%VrelSq) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! VrelSq upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%VrelSq) ! VrelSq - END IF - Int_BufSz = Int_BufSz + 1 ! TIVrel allocated yes/no - IF ( ALLOCATED(InData%TIVrel) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TIVrel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TIVrel) ! TIVrel - END IF - Int_BufSz = Int_BufSz + 1 ! VrelStore allocated yes/no - IF ( ALLOCATED(InData%VrelStore) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! VrelStore upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%VrelStore) ! VrelStore - END IF - Int_BufSz = Int_BufSz + 1 ! TIVx allocated yes/no - IF ( ALLOCATED(InData%TIVx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TIVx upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TIVx) ! TIVx - END IF - Int_BufSz = Int_BufSz + 1 ! MeanVxVyVz allocated yes/no - IF ( ALLOCATED(InData%MeanVxVyVz) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MeanVxVyVz upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MeanVxVyVz) ! MeanVxVyVz - END IF - Int_BufSz = Int_BufSz + 1 ! VxSq allocated yes/no - IF ( ALLOCATED(InData%VxSq) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! VxSq upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%VxSq) ! VxSq - END IF - Int_BufSz = Int_BufSz + 1 ! allregcounter allocated yes/no - IF ( ALLOCATED(InData%allregcounter) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! allregcounter upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%allregcounter) ! allregcounter - END IF - Int_BufSz = Int_BufSz + 1 ! VxSqRegion allocated yes/no - IF ( ALLOCATED(InData%VxSqRegion) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! VxSqRegion upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%VxSqRegion) ! VxSqRegion - END IF - Int_BufSz = Int_BufSz + 1 ! RegVxStor allocated yes/no - IF ( ALLOCATED(InData%RegVxStor) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! RegVxStor upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%RegVxStor) ! RegVxStor - END IF - Int_BufSz = Int_BufSz + 1 ! RegionTIDelete allocated yes/no - IF ( ALLOCATED(InData%RegionTIDelete) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! RegionTIDelete upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%RegionTIDelete) ! RegionTIDelete - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%MeanVrel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MeanVrel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MeanVrel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MeanVrel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MeanVrel,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MeanVrel,2), UBOUND(InData%MeanVrel,2) - DO i1 = LBOUND(InData%MeanVrel,1), UBOUND(InData%MeanVrel,1) - ReKiBuf(Re_Xferred) = InData%MeanVrel(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%VrelSq) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VrelSq,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VrelSq,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VrelSq,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VrelSq,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%VrelSq,2), UBOUND(InData%VrelSq,2) - DO i1 = LBOUND(InData%VrelSq,1), UBOUND(InData%VrelSq,1) - ReKiBuf(Re_Xferred) = InData%VrelSq(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TIVrel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TIVrel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TIVrel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TIVrel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TIVrel,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TIVrel,2), UBOUND(InData%TIVrel,2) - DO i1 = LBOUND(InData%TIVrel,1), UBOUND(InData%TIVrel,1) - ReKiBuf(Re_Xferred) = InData%TIVrel(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%VrelStore) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VrelStore,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VrelStore,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VrelStore,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VrelStore,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VrelStore,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VrelStore,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%VrelStore,3), UBOUND(InData%VrelStore,3) - DO i2 = LBOUND(InData%VrelStore,2), UBOUND(InData%VrelStore,2) - DO i1 = LBOUND(InData%VrelStore,1), UBOUND(InData%VrelStore,1) - ReKiBuf(Re_Xferred) = InData%VrelStore(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TIVx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TIVx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TIVx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TIVx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TIVx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TIVx,2), UBOUND(InData%TIVx,2) - DO i1 = LBOUND(InData%TIVx,1), UBOUND(InData%TIVx,1) - ReKiBuf(Re_Xferred) = InData%TIVx(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MeanVxVyVz) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MeanVxVyVz,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MeanVxVyVz,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MeanVxVyVz,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MeanVxVyVz,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MeanVxVyVz,2), UBOUND(InData%MeanVxVyVz,2) - DO i1 = LBOUND(InData%MeanVxVyVz,1), UBOUND(InData%MeanVxVyVz,1) - ReKiBuf(Re_Xferred) = InData%MeanVxVyVz(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%VxSq) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VxSq,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VxSq,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VxSq,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VxSq,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%VxSq,2), UBOUND(InData%VxSq,2) - DO i1 = LBOUND(InData%VxSq,1), UBOUND(InData%VxSq,1) - ReKiBuf(Re_Xferred) = InData%VxSq(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%allregcounter) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%allregcounter,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%allregcounter,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%allregcounter,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%allregcounter,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%allregcounter,2), UBOUND(InData%allregcounter,2) - DO i1 = LBOUND(InData%allregcounter,1), UBOUND(InData%allregcounter,1) - ReKiBuf(Re_Xferred) = InData%allregcounter(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%VxSqRegion) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VxSqRegion,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VxSqRegion,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VxSqRegion,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VxSqRegion,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%VxSqRegion,2), UBOUND(InData%VxSqRegion,2) - DO i1 = LBOUND(InData%VxSqRegion,1), UBOUND(InData%VxSqRegion,1) - ReKiBuf(Re_Xferred) = InData%VxSqRegion(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RegVxStor) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RegVxStor,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RegVxStor,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RegVxStor,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RegVxStor,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RegVxStor,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RegVxStor,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%RegVxStor,3), UBOUND(InData%RegVxStor,3) - DO i2 = LBOUND(InData%RegVxStor,2), UBOUND(InData%RegVxStor,2) - DO i1 = LBOUND(InData%RegVxStor,1), UBOUND(InData%RegVxStor,1) - ReKiBuf(Re_Xferred) = InData%RegVxStor(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RegionTIDelete) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RegionTIDelete,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RegionTIDelete,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RegionTIDelete,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RegionTIDelete,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%RegionTIDelete,2), UBOUND(InData%RegionTIDelete,2) - DO i1 = LBOUND(InData%RegionTIDelete,1), UBOUND(InData%RegionTIDelete,1) - ReKiBuf(Re_Xferred) = InData%RegionTIDelete(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE AA_PackDiscState - - SUBROUTINE AA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AA_DiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_UnPackDiscState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MeanVrel not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MeanVrel)) DEALLOCATE(OutData%MeanVrel) - ALLOCATE(OutData%MeanVrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MeanVrel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MeanVrel,2), UBOUND(OutData%MeanVrel,2) - DO i1 = LBOUND(OutData%MeanVrel,1), UBOUND(OutData%MeanVrel,1) - OutData%MeanVrel(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VrelSq not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%VrelSq)) DEALLOCATE(OutData%VrelSq) - ALLOCATE(OutData%VrelSq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VrelSq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%VrelSq,2), UBOUND(OutData%VrelSq,2) - DO i1 = LBOUND(OutData%VrelSq,1), UBOUND(OutData%VrelSq,1) - OutData%VrelSq(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TIVrel not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TIVrel)) DEALLOCATE(OutData%TIVrel) - ALLOCATE(OutData%TIVrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TIVrel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TIVrel,2), UBOUND(OutData%TIVrel,2) - DO i1 = LBOUND(OutData%TIVrel,1), UBOUND(OutData%TIVrel,1) - OutData%TIVrel(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VrelStore not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%VrelStore)) DEALLOCATE(OutData%VrelStore) - ALLOCATE(OutData%VrelStore(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VrelStore.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%VrelStore,3), UBOUND(OutData%VrelStore,3) - DO i2 = LBOUND(OutData%VrelStore,2), UBOUND(OutData%VrelStore,2) - DO i1 = LBOUND(OutData%VrelStore,1), UBOUND(OutData%VrelStore,1) - OutData%VrelStore(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TIVx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TIVx)) DEALLOCATE(OutData%TIVx) - ALLOCATE(OutData%TIVx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TIVx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TIVx,2), UBOUND(OutData%TIVx,2) - DO i1 = LBOUND(OutData%TIVx,1), UBOUND(OutData%TIVx,1) - OutData%TIVx(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MeanVxVyVz not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MeanVxVyVz)) DEALLOCATE(OutData%MeanVxVyVz) - ALLOCATE(OutData%MeanVxVyVz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MeanVxVyVz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MeanVxVyVz,2), UBOUND(OutData%MeanVxVyVz,2) - DO i1 = LBOUND(OutData%MeanVxVyVz,1), UBOUND(OutData%MeanVxVyVz,1) - OutData%MeanVxVyVz(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VxSq not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%VxSq)) DEALLOCATE(OutData%VxSq) - ALLOCATE(OutData%VxSq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VxSq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%VxSq,2), UBOUND(OutData%VxSq,2) - DO i1 = LBOUND(OutData%VxSq,1), UBOUND(OutData%VxSq,1) - OutData%VxSq(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! allregcounter not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%allregcounter)) DEALLOCATE(OutData%allregcounter) - ALLOCATE(OutData%allregcounter(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%allregcounter.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%allregcounter,2), UBOUND(OutData%allregcounter,2) - DO i1 = LBOUND(OutData%allregcounter,1), UBOUND(OutData%allregcounter,1) - OutData%allregcounter(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VxSqRegion not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%VxSqRegion)) DEALLOCATE(OutData%VxSqRegion) - ALLOCATE(OutData%VxSqRegion(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VxSqRegion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%VxSqRegion,2), UBOUND(OutData%VxSqRegion,2) - DO i1 = LBOUND(OutData%VxSqRegion,1), UBOUND(OutData%VxSqRegion,1) - OutData%VxSqRegion(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RegVxStor not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RegVxStor)) DEALLOCATE(OutData%RegVxStor) - ALLOCATE(OutData%RegVxStor(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RegVxStor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%RegVxStor,3), UBOUND(OutData%RegVxStor,3) - DO i2 = LBOUND(OutData%RegVxStor,2), UBOUND(OutData%RegVxStor,2) - DO i1 = LBOUND(OutData%RegVxStor,1), UBOUND(OutData%RegVxStor,1) - OutData%RegVxStor(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RegionTIDelete not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RegionTIDelete)) DEALLOCATE(OutData%RegionTIDelete) - ALLOCATE(OutData%RegionTIDelete(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RegionTIDelete.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%RegionTIDelete,2), UBOUND(OutData%RegionTIDelete,2) - DO i1 = LBOUND(OutData%RegionTIDelete,1), UBOUND(OutData%RegionTIDelete,1) - OutData%RegionTIDelete(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE AA_UnPackDiscState +subroutine AA_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AA_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AA_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + ! MeanVrel + call RegPack(Buf, allocated(InData%MeanVrel)) + if (allocated(InData%MeanVrel)) then + call RegPackBounds(Buf, 2, lbound(InData%MeanVrel), ubound(InData%MeanVrel)) + call RegPack(Buf, InData%MeanVrel) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! VrelSq + call RegPack(Buf, allocated(InData%VrelSq)) + if (allocated(InData%VrelSq)) then + call RegPackBounds(Buf, 2, lbound(InData%VrelSq), ubound(InData%VrelSq)) + call RegPack(Buf, InData%VrelSq) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TIVrel + call RegPack(Buf, allocated(InData%TIVrel)) + if (allocated(InData%TIVrel)) then + call RegPackBounds(Buf, 2, lbound(InData%TIVrel), ubound(InData%TIVrel)) + call RegPack(Buf, InData%TIVrel) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! VrelStore + call RegPack(Buf, allocated(InData%VrelStore)) + if (allocated(InData%VrelStore)) then + call RegPackBounds(Buf, 3, lbound(InData%VrelStore), ubound(InData%VrelStore)) + call RegPack(Buf, InData%VrelStore) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TIVx + call RegPack(Buf, allocated(InData%TIVx)) + if (allocated(InData%TIVx)) then + call RegPackBounds(Buf, 2, lbound(InData%TIVx), ubound(InData%TIVx)) + call RegPack(Buf, InData%TIVx) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MeanVxVyVz + call RegPack(Buf, allocated(InData%MeanVxVyVz)) + if (allocated(InData%MeanVxVyVz)) then + call RegPackBounds(Buf, 2, lbound(InData%MeanVxVyVz), ubound(InData%MeanVxVyVz)) + call RegPack(Buf, InData%MeanVxVyVz) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! VxSq + call RegPack(Buf, allocated(InData%VxSq)) + if (allocated(InData%VxSq)) then + call RegPackBounds(Buf, 2, lbound(InData%VxSq), ubound(InData%VxSq)) + call RegPack(Buf, InData%VxSq) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! allregcounter + call RegPack(Buf, allocated(InData%allregcounter)) + if (allocated(InData%allregcounter)) then + call RegPackBounds(Buf, 2, lbound(InData%allregcounter), ubound(InData%allregcounter)) + call RegPack(Buf, InData%allregcounter) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! VxSqRegion + call RegPack(Buf, allocated(InData%VxSqRegion)) + if (allocated(InData%VxSqRegion)) then + call RegPackBounds(Buf, 2, lbound(InData%VxSqRegion), ubound(InData%VxSqRegion)) + call RegPack(Buf, InData%VxSqRegion) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RegVxStor + call RegPack(Buf, allocated(InData%RegVxStor)) + if (allocated(InData%RegVxStor)) then + call RegPackBounds(Buf, 3, lbound(InData%RegVxStor), ubound(InData%RegVxStor)) + call RegPack(Buf, InData%RegVxStor) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RegionTIDelete + call RegPack(Buf, allocated(InData%RegionTIDelete)) + if (allocated(InData%RegionTIDelete)) then + call RegPackBounds(Buf, 2, lbound(InData%RegionTIDelete), ubound(InData%RegionTIDelete)) + call RegPack(Buf, InData%RegionTIDelete) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AA_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AA_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AA_UnPackDiscState' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! MeanVrel + if (allocated(OutData%MeanVrel)) deallocate(OutData%MeanVrel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MeanVrel(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MeanVrel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MeanVrel) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! VrelSq + if (allocated(OutData%VrelSq)) deallocate(OutData%VrelSq) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%VrelSq(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VrelSq.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%VrelSq) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TIVrel + if (allocated(OutData%TIVrel)) deallocate(OutData%TIVrel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TIVrel(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TIVrel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TIVrel) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! VrelStore + if (allocated(OutData%VrelStore)) deallocate(OutData%VrelStore) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%VrelStore(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VrelStore.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%VrelStore) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TIVx + if (allocated(OutData%TIVx)) deallocate(OutData%TIVx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TIVx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TIVx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TIVx) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! MeanVxVyVz + if (allocated(OutData%MeanVxVyVz)) deallocate(OutData%MeanVxVyVz) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MeanVxVyVz(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MeanVxVyVz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MeanVxVyVz) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! VxSq + if (allocated(OutData%VxSq)) deallocate(OutData%VxSq) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%VxSq(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VxSq.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%VxSq) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! allregcounter + if (allocated(OutData%allregcounter)) deallocate(OutData%allregcounter) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%allregcounter(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%allregcounter.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%allregcounter) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! VxSqRegion + if (allocated(OutData%VxSqRegion)) deallocate(OutData%VxSqRegion) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%VxSqRegion(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VxSqRegion.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%VxSqRegion) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RegVxStor + if (allocated(OutData%RegVxStor)) deallocate(OutData%RegVxStor) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RegVxStor(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RegVxStor.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RegVxStor) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RegionTIDelete + if (allocated(OutData%RegionTIDelete)) deallocate(OutData%RegionTIDelete) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RegionTIDelete(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RegionTIDelete.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RegionTIDelete) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE AA_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(AA_ConstraintStateType), INTENT(IN) :: SrcConstrStateData TYPE(AA_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData @@ -4074,103 +2404,26 @@ SUBROUTINE AA_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) END SUBROUTINE AA_DestroyConstrState - SUBROUTINE AA_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AA_ConstraintStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_PackConstrState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyConstrState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AA_PackConstrState - - SUBROUTINE AA_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AA_ConstraintStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_UnPackConstrState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyConstrState = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AA_UnPackConstrState +subroutine AA_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AA_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AA_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyConstrState + call RegPack(Buf, InData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AA_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AA_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AA_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + ! DummyConstrState + call RegUnpack(Buf, OutData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE AA_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(AA_OtherStateType), INTENT(IN) :: SrcOtherStateData TYPE(AA_OtherStateType), INTENT(INOUT) :: DstOtherStateData @@ -4203,103 +2456,26 @@ SUBROUTINE AA_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) END SUBROUTINE AA_DestroyOtherState - SUBROUTINE AA_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AA_OtherStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_PackOtherState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyOtherState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyOtherState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AA_PackOtherState - - SUBROUTINE AA_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AA_OtherStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_UnPackOtherState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyOtherState = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AA_UnPackOtherState +subroutine AA_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AA_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AA_PackOtherState' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyOtherState + call RegPack(Buf, InData%DummyOtherState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AA_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AA_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AA_UnPackOtherState' + if (Buf%ErrStat /= ErrID_None) return + ! DummyOtherState + call RegUnpack(Buf, OutData%DummyOtherState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE AA_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) TYPE(AA_MiscVarType), INTENT(IN) :: SrcMiscData TYPE(AA_MiscVarType), INTENT(INOUT) :: DstMiscData @@ -4680,1224 +2856,673 @@ SUBROUTINE AA_DestroyMisc( MiscData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE AA_DestroyMisc - SUBROUTINE AA_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AA_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! AllOuts allocated yes/no - IF ( ALLOCATED(InData%AllOuts) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AllOuts upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AllOuts) ! AllOuts - END IF - Int_BufSz = Int_BufSz + 1 ! ChordAngleTE allocated yes/no - IF ( ALLOCATED(InData%ChordAngleTE) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! ChordAngleTE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ChordAngleTE) ! ChordAngleTE - END IF - Int_BufSz = Int_BufSz + 1 ! SpanAngleTE allocated yes/no - IF ( ALLOCATED(InData%SpanAngleTE) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! SpanAngleTE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SpanAngleTE) ! SpanAngleTE - END IF - Int_BufSz = Int_BufSz + 1 ! ChordAngleLE allocated yes/no - IF ( ALLOCATED(InData%ChordAngleLE) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! ChordAngleLE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ChordAngleLE) ! ChordAngleLE +subroutine AA_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AA_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AA_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + ! AllOuts + call RegPack(Buf, allocated(InData%AllOuts)) + if (allocated(InData%AllOuts)) then + call RegPackBounds(Buf, 1, lbound(InData%AllOuts), ubound(InData%AllOuts)) + call RegPack(Buf, InData%AllOuts) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ChordAngleTE + call RegPack(Buf, allocated(InData%ChordAngleTE)) + if (allocated(InData%ChordAngleTE)) then + call RegPackBounds(Buf, 3, lbound(InData%ChordAngleTE), ubound(InData%ChordAngleTE)) + call RegPack(Buf, InData%ChordAngleTE) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SpanAngleTE + call RegPack(Buf, allocated(InData%SpanAngleTE)) + if (allocated(InData%SpanAngleTE)) then + call RegPackBounds(Buf, 3, lbound(InData%SpanAngleTE), ubound(InData%SpanAngleTE)) + call RegPack(Buf, InData%SpanAngleTE) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ChordAngleLE + call RegPack(Buf, allocated(InData%ChordAngleLE)) + if (allocated(InData%ChordAngleLE)) then + call RegPackBounds(Buf, 3, lbound(InData%ChordAngleLE), ubound(InData%ChordAngleLE)) + call RegPack(Buf, InData%ChordAngleLE) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SpanAngleLE + call RegPack(Buf, allocated(InData%SpanAngleLE)) + if (allocated(InData%SpanAngleLE)) then + call RegPackBounds(Buf, 3, lbound(InData%SpanAngleLE), ubound(InData%SpanAngleLE)) + call RegPack(Buf, InData%SpanAngleLE) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! rTEtoObserve + call RegPack(Buf, allocated(InData%rTEtoObserve)) + if (allocated(InData%rTEtoObserve)) then + call RegPackBounds(Buf, 3, lbound(InData%rTEtoObserve), ubound(InData%rTEtoObserve)) + call RegPack(Buf, InData%rTEtoObserve) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! rLEtoObserve + call RegPack(Buf, allocated(InData%rLEtoObserve)) + if (allocated(InData%rLEtoObserve)) then + call RegPackBounds(Buf, 3, lbound(InData%rLEtoObserve), ubound(InData%rLEtoObserve)) + call RegPack(Buf, InData%rLEtoObserve) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LE_Location + call RegPack(Buf, allocated(InData%LE_Location)) + if (allocated(InData%LE_Location)) then + call RegPackBounds(Buf, 3, lbound(InData%LE_Location), ubound(InData%LE_Location)) + call RegPack(Buf, InData%LE_Location) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RotSpeedAoA + call RegPack(Buf, InData%RotSpeedAoA) + if (RegCheckErr(Buf, RoutineName)) return + ! SPLLBL + call RegPack(Buf, allocated(InData%SPLLBL)) + if (allocated(InData%SPLLBL)) then + call RegPackBounds(Buf, 1, lbound(InData%SPLLBL), ubound(InData%SPLLBL)) + call RegPack(Buf, InData%SPLLBL) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SPLP + call RegPack(Buf, allocated(InData%SPLP)) + if (allocated(InData%SPLP)) then + call RegPackBounds(Buf, 1, lbound(InData%SPLP), ubound(InData%SPLP)) + call RegPack(Buf, InData%SPLP) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SPLS + call RegPack(Buf, allocated(InData%SPLS)) + if (allocated(InData%SPLS)) then + call RegPackBounds(Buf, 1, lbound(InData%SPLS), ubound(InData%SPLS)) + call RegPack(Buf, InData%SPLS) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SPLALPH + call RegPack(Buf, allocated(InData%SPLALPH)) + if (allocated(InData%SPLALPH)) then + call RegPackBounds(Buf, 1, lbound(InData%SPLALPH), ubound(InData%SPLALPH)) + call RegPack(Buf, InData%SPLALPH) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SPLTBL + call RegPack(Buf, allocated(InData%SPLTBL)) + if (allocated(InData%SPLTBL)) then + call RegPackBounds(Buf, 1, lbound(InData%SPLTBL), ubound(InData%SPLTBL)) + call RegPack(Buf, InData%SPLTBL) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SPLTIP + call RegPack(Buf, allocated(InData%SPLTIP)) + if (allocated(InData%SPLTIP)) then + call RegPackBounds(Buf, 1, lbound(InData%SPLTIP), ubound(InData%SPLTIP)) + call RegPack(Buf, InData%SPLTIP) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SPLTI + call RegPack(Buf, allocated(InData%SPLTI)) + if (allocated(InData%SPLTI)) then + call RegPackBounds(Buf, 1, lbound(InData%SPLTI), ubound(InData%SPLTI)) + call RegPack(Buf, InData%SPLTI) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SPLTIGui + call RegPack(Buf, allocated(InData%SPLTIGui)) + if (allocated(InData%SPLTIGui)) then + call RegPackBounds(Buf, 1, lbound(InData%SPLTIGui), ubound(InData%SPLTIGui)) + call RegPack(Buf, InData%SPLTIGui) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SPLBLUNT + call RegPack(Buf, allocated(InData%SPLBLUNT)) + if (allocated(InData%SPLBLUNT)) then + call RegPackBounds(Buf, 1, lbound(InData%SPLBLUNT), ubound(InData%SPLBLUNT)) + call RegPack(Buf, InData%SPLBLUNT) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CfVar + call RegPack(Buf, allocated(InData%CfVar)) + if (allocated(InData%CfVar)) then + call RegPackBounds(Buf, 1, lbound(InData%CfVar), ubound(InData%CfVar)) + call RegPack(Buf, InData%CfVar) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! d99Var + call RegPack(Buf, allocated(InData%d99Var)) + if (allocated(InData%d99Var)) then + call RegPackBounds(Buf, 1, lbound(InData%d99Var), ubound(InData%d99Var)) + call RegPack(Buf, InData%d99Var) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! dStarVar + call RegPack(Buf, allocated(InData%dStarVar)) + if (allocated(InData%dStarVar)) then + call RegPackBounds(Buf, 1, lbound(InData%dStarVar), ubound(InData%dStarVar)) + call RegPack(Buf, InData%dStarVar) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! EdgeVelVar + call RegPack(Buf, allocated(InData%EdgeVelVar)) + if (allocated(InData%EdgeVelVar)) then + call RegPackBounds(Buf, 1, lbound(InData%EdgeVelVar), ubound(InData%EdgeVelVar)) + call RegPack(Buf, InData%EdgeVelVar) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! speccou + call RegPack(Buf, InData%speccou) + if (RegCheckErr(Buf, RoutineName)) return + ! filesopen + call RegPack(Buf, InData%filesopen) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AA_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AA_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AA_UnPackMisc' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! AllOuts + if (allocated(OutData%AllOuts)) deallocate(OutData%AllOuts) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AllOuts(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AllOuts) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ChordAngleTE + if (allocated(OutData%ChordAngleTE)) deallocate(OutData%ChordAngleTE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ChordAngleTE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChordAngleTE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ChordAngleTE) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! SpanAngleTE + if (allocated(OutData%SpanAngleTE)) deallocate(OutData%SpanAngleTE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SpanAngleTE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SpanAngleTE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SpanAngleTE) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ChordAngleLE + if (allocated(OutData%ChordAngleLE)) deallocate(OutData%ChordAngleLE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ChordAngleLE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChordAngleLE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ChordAngleLE) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! SpanAngleLE + if (allocated(OutData%SpanAngleLE)) deallocate(OutData%SpanAngleLE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SpanAngleLE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SpanAngleLE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SpanAngleLE) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! rTEtoObserve + if (allocated(OutData%rTEtoObserve)) deallocate(OutData%rTEtoObserve) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rTEtoObserve(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rTEtoObserve.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rTEtoObserve) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! rLEtoObserve + if (allocated(OutData%rLEtoObserve)) deallocate(OutData%rLEtoObserve) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rLEtoObserve(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rLEtoObserve.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rLEtoObserve) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LE_Location + if (allocated(OutData%LE_Location)) deallocate(OutData%LE_Location) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LE_Location(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LE_Location.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LE_Location) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RotSpeedAoA + call RegUnpack(Buf, OutData%RotSpeedAoA) + if (RegCheckErr(Buf, RoutineName)) return + ! SPLLBL + if (allocated(OutData%SPLLBL)) deallocate(OutData%SPLLBL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SPLLBL(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLLBL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SPLLBL) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! SPLP + if (allocated(OutData%SPLP)) deallocate(OutData%SPLP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SPLP(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SPLP) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! SPLS + if (allocated(OutData%SPLS)) deallocate(OutData%SPLS) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SPLS(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SPLS) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! SPLALPH + if (allocated(OutData%SPLALPH)) deallocate(OutData%SPLALPH) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SPLALPH(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLALPH.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SPLALPH) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! SPLTBL + if (allocated(OutData%SPLTBL)) deallocate(OutData%SPLTBL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SPLTBL(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLTBL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SPLTBL) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! SPLTIP + if (allocated(OutData%SPLTIP)) deallocate(OutData%SPLTIP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SPLTIP(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLTIP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SPLTIP) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! SPLTI + if (allocated(OutData%SPLTI)) deallocate(OutData%SPLTI) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SPLTI(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLTI.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SPLTI) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! SPLTIGui + if (allocated(OutData%SPLTIGui)) deallocate(OutData%SPLTIGui) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SPLTIGui(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLTIGui.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SPLTIGui) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! SPLBLUNT + if (allocated(OutData%SPLBLUNT)) deallocate(OutData%SPLBLUNT) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SPLBLUNT(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLBLUNT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SPLBLUNT) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CfVar + if (allocated(OutData%CfVar)) deallocate(OutData%CfVar) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CfVar(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CfVar.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CfVar) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! d99Var + if (allocated(OutData%d99Var)) deallocate(OutData%d99Var) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%d99Var(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%d99Var.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%d99Var) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! dStarVar + if (allocated(OutData%dStarVar)) deallocate(OutData%dStarVar) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dStarVar(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dStarVar.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dStarVar) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! EdgeVelVar + if (allocated(OutData%EdgeVelVar)) deallocate(OutData%EdgeVelVar) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%EdgeVelVar(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%EdgeVelVar.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%EdgeVelVar) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! speccou + call RegUnpack(Buf, OutData%speccou) + if (RegCheckErr(Buf, RoutineName)) return + ! filesopen + call RegUnpack(Buf, OutData%filesopen) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + SUBROUTINE AA_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) + TYPE(AA_ParameterType), INTENT(IN) :: SrcParamData + TYPE(AA_ParameterType), INTENT(INOUT) :: DstParamData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AA_CopyParam' +! + ErrStat = ErrID_None + ErrMsg = "" + DstParamData%DT = SrcParamData%DT + DstParamData%IBLUNT = SrcParamData%IBLUNT + DstParamData%ILAM = SrcParamData%ILAM + DstParamData%ITIP = SrcParamData%ITIP + DstParamData%ITRIP = SrcParamData%ITRIP + DstParamData%ITURB = SrcParamData%ITURB + DstParamData%IInflow = SrcParamData%IInflow + DstParamData%X_BLMethod = SrcParamData%X_BLMethod + DstParamData%TICalcMeth = SrcParamData%TICalcMeth + DstParamData%ROUND = SrcParamData%ROUND + DstParamData%ALPRAT = SrcParamData%ALPRAT + DstParamData%NumBlades = SrcParamData%NumBlades + DstParamData%NumBlNds = SrcParamData%NumBlNds + DstParamData%AirDens = SrcParamData%AirDens + DstParamData%KinVisc = SrcParamData%KinVisc + DstParamData%SpdSound = SrcParamData%SpdSound + DstParamData%HubHeight = SrcParamData%HubHeight + DstParamData%toptip = SrcParamData%toptip + DstParamData%bottip = SrcParamData%bottip +IF (ALLOCATED(SrcParamData%rotorregionlimitsVert)) THEN + i1_l = LBOUND(SrcParamData%rotorregionlimitsVert,1) + i1_u = UBOUND(SrcParamData%rotorregionlimitsVert,1) + IF (.NOT. ALLOCATED(DstParamData%rotorregionlimitsVert)) THEN + ALLOCATE(DstParamData%rotorregionlimitsVert(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsVert.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! SpanAngleLE allocated yes/no - IF ( ALLOCATED(InData%SpanAngleLE) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! SpanAngleLE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SpanAngleLE) ! SpanAngleLE + DstParamData%rotorregionlimitsVert = SrcParamData%rotorregionlimitsVert +ENDIF +IF (ALLOCATED(SrcParamData%rotorregionlimitsHorz)) THEN + i1_l = LBOUND(SrcParamData%rotorregionlimitsHorz,1) + i1_u = UBOUND(SrcParamData%rotorregionlimitsHorz,1) + IF (.NOT. ALLOCATED(DstParamData%rotorregionlimitsHorz)) THEN + ALLOCATE(DstParamData%rotorregionlimitsHorz(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsHorz.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! rTEtoObserve allocated yes/no - IF ( ALLOCATED(InData%rTEtoObserve) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! rTEtoObserve upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rTEtoObserve) ! rTEtoObserve + DstParamData%rotorregionlimitsHorz = SrcParamData%rotorregionlimitsHorz +ENDIF +IF (ALLOCATED(SrcParamData%rotorregionlimitsalph)) THEN + i1_l = LBOUND(SrcParamData%rotorregionlimitsalph,1) + i1_u = UBOUND(SrcParamData%rotorregionlimitsalph,1) + IF (.NOT. ALLOCATED(DstParamData%rotorregionlimitsalph)) THEN + ALLOCATE(DstParamData%rotorregionlimitsalph(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsalph.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! rLEtoObserve allocated yes/no - IF ( ALLOCATED(InData%rLEtoObserve) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! rLEtoObserve upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rLEtoObserve) ! rLEtoObserve + DstParamData%rotorregionlimitsalph = SrcParamData%rotorregionlimitsalph +ENDIF +IF (ALLOCATED(SrcParamData%rotorregionlimitsrad)) THEN + i1_l = LBOUND(SrcParamData%rotorregionlimitsrad,1) + i1_u = UBOUND(SrcParamData%rotorregionlimitsrad,1) + IF (.NOT. ALLOCATED(DstParamData%rotorregionlimitsrad)) THEN + ALLOCATE(DstParamData%rotorregionlimitsrad(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsrad.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! LE_Location allocated yes/no - IF ( ALLOCATED(InData%LE_Location) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! LE_Location upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LE_Location) ! LE_Location + DstParamData%rotorregionlimitsrad = SrcParamData%rotorregionlimitsrad +ENDIF + DstParamData%NrObsLoc = SrcParamData%NrObsLoc + DstParamData%aweightflag = SrcParamData%aweightflag + DstParamData%TxtFileOutput = SrcParamData%TxtFileOutput + DstParamData%AAStart = SrcParamData%AAStart +IF (ALLOCATED(SrcParamData%ObsX)) THEN + i1_l = LBOUND(SrcParamData%ObsX,1) + i1_u = UBOUND(SrcParamData%ObsX,1) + IF (.NOT. ALLOCATED(DstParamData%ObsX)) THEN + ALLOCATE(DstParamData%ObsX(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ObsX.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Re_BufSz = Re_BufSz + 1 ! RotSpeedAoA - Int_BufSz = Int_BufSz + 1 ! SPLLBL allocated yes/no - IF ( ALLOCATED(InData%SPLLBL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SPLLBL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SPLLBL) ! SPLLBL + DstParamData%ObsX = SrcParamData%ObsX +ENDIF +IF (ALLOCATED(SrcParamData%ObsY)) THEN + i1_l = LBOUND(SrcParamData%ObsY,1) + i1_u = UBOUND(SrcParamData%ObsY,1) + IF (.NOT. ALLOCATED(DstParamData%ObsY)) THEN + ALLOCATE(DstParamData%ObsY(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ObsY.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! SPLP allocated yes/no - IF ( ALLOCATED(InData%SPLP) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SPLP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SPLP) ! SPLP + DstParamData%ObsY = SrcParamData%ObsY +ENDIF +IF (ALLOCATED(SrcParamData%ObsZ)) THEN + i1_l = LBOUND(SrcParamData%ObsZ,1) + i1_u = UBOUND(SrcParamData%ObsZ,1) + IF (.NOT. ALLOCATED(DstParamData%ObsZ)) THEN + ALLOCATE(DstParamData%ObsZ(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ObsZ.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! SPLS allocated yes/no - IF ( ALLOCATED(InData%SPLS) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SPLS upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SPLS) ! SPLS + DstParamData%ObsZ = SrcParamData%ObsZ +ENDIF +IF (ALLOCATED(SrcParamData%FreqList)) THEN + i1_l = LBOUND(SrcParamData%FreqList,1) + i1_u = UBOUND(SrcParamData%FreqList,1) + IF (.NOT. ALLOCATED(DstParamData%FreqList)) THEN + ALLOCATE(DstParamData%FreqList(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FreqList.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! SPLALPH allocated yes/no - IF ( ALLOCATED(InData%SPLALPH) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SPLALPH upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SPLALPH) ! SPLALPH - END IF - Int_BufSz = Int_BufSz + 1 ! SPLTBL allocated yes/no - IF ( ALLOCATED(InData%SPLTBL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SPLTBL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SPLTBL) ! SPLTBL - END IF - Int_BufSz = Int_BufSz + 1 ! SPLTIP allocated yes/no - IF ( ALLOCATED(InData%SPLTIP) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SPLTIP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SPLTIP) ! SPLTIP - END IF - Int_BufSz = Int_BufSz + 1 ! SPLTI allocated yes/no - IF ( ALLOCATED(InData%SPLTI) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SPLTI upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SPLTI) ! SPLTI - END IF - Int_BufSz = Int_BufSz + 1 ! SPLTIGui allocated yes/no - IF ( ALLOCATED(InData%SPLTIGui) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SPLTIGui upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SPLTIGui) ! SPLTIGui - END IF - Int_BufSz = Int_BufSz + 1 ! SPLBLUNT allocated yes/no - IF ( ALLOCATED(InData%SPLBLUNT) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SPLBLUNT upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SPLBLUNT) ! SPLBLUNT - END IF - Int_BufSz = Int_BufSz + 1 ! CfVar allocated yes/no - IF ( ALLOCATED(InData%CfVar) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CfVar upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CfVar) ! CfVar - END IF - Int_BufSz = Int_BufSz + 1 ! d99Var allocated yes/no - IF ( ALLOCATED(InData%d99Var) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! d99Var upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%d99Var) ! d99Var - END IF - Int_BufSz = Int_BufSz + 1 ! dStarVar allocated yes/no - IF ( ALLOCATED(InData%dStarVar) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dStarVar upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dStarVar) ! dStarVar - END IF - Int_BufSz = Int_BufSz + 1 ! EdgeVelVar allocated yes/no - IF ( ALLOCATED(InData%EdgeVelVar) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! EdgeVelVar upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%EdgeVelVar) ! EdgeVelVar - END IF - Int_BufSz = Int_BufSz + 1 ! speccou - Int_BufSz = Int_BufSz + 1 ! filesopen - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%AllOuts) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AllOuts,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOuts,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AllOuts,1), UBOUND(InData%AllOuts,1) - ReKiBuf(Re_Xferred) = InData%AllOuts(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ChordAngleTE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ChordAngleTE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChordAngleTE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ChordAngleTE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChordAngleTE,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ChordAngleTE,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChordAngleTE,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%ChordAngleTE,3), UBOUND(InData%ChordAngleTE,3) - DO i2 = LBOUND(InData%ChordAngleTE,2), UBOUND(InData%ChordAngleTE,2) - DO i1 = LBOUND(InData%ChordAngleTE,1), UBOUND(InData%ChordAngleTE,1) - ReKiBuf(Re_Xferred) = InData%ChordAngleTE(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SpanAngleTE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SpanAngleTE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SpanAngleTE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SpanAngleTE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SpanAngleTE,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SpanAngleTE,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SpanAngleTE,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%SpanAngleTE,3), UBOUND(InData%SpanAngleTE,3) - DO i2 = LBOUND(InData%SpanAngleTE,2), UBOUND(InData%SpanAngleTE,2) - DO i1 = LBOUND(InData%SpanAngleTE,1), UBOUND(InData%SpanAngleTE,1) - ReKiBuf(Re_Xferred) = InData%SpanAngleTE(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ChordAngleLE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ChordAngleLE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChordAngleLE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ChordAngleLE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChordAngleLE,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ChordAngleLE,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChordAngleLE,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%ChordAngleLE,3), UBOUND(InData%ChordAngleLE,3) - DO i2 = LBOUND(InData%ChordAngleLE,2), UBOUND(InData%ChordAngleLE,2) - DO i1 = LBOUND(InData%ChordAngleLE,1), UBOUND(InData%ChordAngleLE,1) - ReKiBuf(Re_Xferred) = InData%ChordAngleLE(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SpanAngleLE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SpanAngleLE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SpanAngleLE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SpanAngleLE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SpanAngleLE,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SpanAngleLE,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SpanAngleLE,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%SpanAngleLE,3), UBOUND(InData%SpanAngleLE,3) - DO i2 = LBOUND(InData%SpanAngleLE,2), UBOUND(InData%SpanAngleLE,2) - DO i1 = LBOUND(InData%SpanAngleLE,1), UBOUND(InData%SpanAngleLE,1) - ReKiBuf(Re_Xferred) = InData%SpanAngleLE(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rTEtoObserve) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rTEtoObserve,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rTEtoObserve,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rTEtoObserve,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rTEtoObserve,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rTEtoObserve,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rTEtoObserve,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%rTEtoObserve,3), UBOUND(InData%rTEtoObserve,3) - DO i2 = LBOUND(InData%rTEtoObserve,2), UBOUND(InData%rTEtoObserve,2) - DO i1 = LBOUND(InData%rTEtoObserve,1), UBOUND(InData%rTEtoObserve,1) - ReKiBuf(Re_Xferred) = InData%rTEtoObserve(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rLEtoObserve) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rLEtoObserve,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rLEtoObserve,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rLEtoObserve,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rLEtoObserve,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rLEtoObserve,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rLEtoObserve,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%rLEtoObserve,3), UBOUND(InData%rLEtoObserve,3) - DO i2 = LBOUND(InData%rLEtoObserve,2), UBOUND(InData%rLEtoObserve,2) - DO i1 = LBOUND(InData%rLEtoObserve,1), UBOUND(InData%rLEtoObserve,1) - ReKiBuf(Re_Xferred) = InData%rLEtoObserve(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LE_Location) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LE_Location,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LE_Location,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LE_Location,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LE_Location,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LE_Location,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LE_Location,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%LE_Location,3), UBOUND(InData%LE_Location,3) - DO i2 = LBOUND(InData%LE_Location,2), UBOUND(InData%LE_Location,2) - DO i1 = LBOUND(InData%LE_Location,1), UBOUND(InData%LE_Location,1) - ReKiBuf(Re_Xferred) = InData%LE_Location(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%RotSpeedAoA - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%SPLLBL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SPLLBL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SPLLBL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SPLLBL,1), UBOUND(InData%SPLLBL,1) - ReKiBuf(Re_Xferred) = InData%SPLLBL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SPLP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SPLP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SPLP,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SPLP,1), UBOUND(InData%SPLP,1) - ReKiBuf(Re_Xferred) = InData%SPLP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SPLS) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SPLS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SPLS,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SPLS,1), UBOUND(InData%SPLS,1) - ReKiBuf(Re_Xferred) = InData%SPLS(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SPLALPH) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SPLALPH,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SPLALPH,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SPLALPH,1), UBOUND(InData%SPLALPH,1) - ReKiBuf(Re_Xferred) = InData%SPLALPH(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SPLTBL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SPLTBL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SPLTBL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SPLTBL,1), UBOUND(InData%SPLTBL,1) - ReKiBuf(Re_Xferred) = InData%SPLTBL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SPLTIP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SPLTIP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SPLTIP,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SPLTIP,1), UBOUND(InData%SPLTIP,1) - ReKiBuf(Re_Xferred) = InData%SPLTIP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SPLTI) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SPLTI,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SPLTI,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SPLTI,1), UBOUND(InData%SPLTI,1) - ReKiBuf(Re_Xferred) = InData%SPLTI(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SPLTIGui) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SPLTIGui,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SPLTIGui,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SPLTIGui,1), UBOUND(InData%SPLTIGui,1) - ReKiBuf(Re_Xferred) = InData%SPLTIGui(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SPLBLUNT) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SPLBLUNT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SPLBLUNT,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SPLBLUNT,1), UBOUND(InData%SPLBLUNT,1) - ReKiBuf(Re_Xferred) = InData%SPLBLUNT(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CfVar) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CfVar,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CfVar,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CfVar,1), UBOUND(InData%CfVar,1) - ReKiBuf(Re_Xferred) = InData%CfVar(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%d99Var) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%d99Var,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%d99Var,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%d99Var,1), UBOUND(InData%d99Var,1) - ReKiBuf(Re_Xferred) = InData%d99Var(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dStarVar) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dStarVar,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dStarVar,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dStarVar,1), UBOUND(InData%dStarVar,1) - ReKiBuf(Re_Xferred) = InData%dStarVar(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%EdgeVelVar) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%EdgeVelVar,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EdgeVelVar,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%EdgeVelVar,1), UBOUND(InData%EdgeVelVar,1) - ReKiBuf(Re_Xferred) = InData%EdgeVelVar(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%speccou - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%filesopen - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AA_PackMisc - - SUBROUTINE AA_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AA_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AllOuts not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AllOuts)) DEALLOCATE(OutData%AllOuts) - ALLOCATE(OutData%AllOuts(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AllOuts,1), UBOUND(OutData%AllOuts,1) - OutData%AllOuts(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ChordAngleTE not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ChordAngleTE)) DEALLOCATE(OutData%ChordAngleTE) - ALLOCATE(OutData%ChordAngleTE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChordAngleTE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%ChordAngleTE,3), UBOUND(OutData%ChordAngleTE,3) - DO i2 = LBOUND(OutData%ChordAngleTE,2), UBOUND(OutData%ChordAngleTE,2) - DO i1 = LBOUND(OutData%ChordAngleTE,1), UBOUND(OutData%ChordAngleTE,1) - OutData%ChordAngleTE(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SpanAngleTE not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SpanAngleTE)) DEALLOCATE(OutData%SpanAngleTE) - ALLOCATE(OutData%SpanAngleTE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SpanAngleTE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%SpanAngleTE,3), UBOUND(OutData%SpanAngleTE,3) - DO i2 = LBOUND(OutData%SpanAngleTE,2), UBOUND(OutData%SpanAngleTE,2) - DO i1 = LBOUND(OutData%SpanAngleTE,1), UBOUND(OutData%SpanAngleTE,1) - OutData%SpanAngleTE(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ChordAngleLE not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ChordAngleLE)) DEALLOCATE(OutData%ChordAngleLE) - ALLOCATE(OutData%ChordAngleLE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChordAngleLE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%ChordAngleLE,3), UBOUND(OutData%ChordAngleLE,3) - DO i2 = LBOUND(OutData%ChordAngleLE,2), UBOUND(OutData%ChordAngleLE,2) - DO i1 = LBOUND(OutData%ChordAngleLE,1), UBOUND(OutData%ChordAngleLE,1) - OutData%ChordAngleLE(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SpanAngleLE not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SpanAngleLE)) DEALLOCATE(OutData%SpanAngleLE) - ALLOCATE(OutData%SpanAngleLE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SpanAngleLE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%SpanAngleLE,3), UBOUND(OutData%SpanAngleLE,3) - DO i2 = LBOUND(OutData%SpanAngleLE,2), UBOUND(OutData%SpanAngleLE,2) - DO i1 = LBOUND(OutData%SpanAngleLE,1), UBOUND(OutData%SpanAngleLE,1) - OutData%SpanAngleLE(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rTEtoObserve not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rTEtoObserve)) DEALLOCATE(OutData%rTEtoObserve) - ALLOCATE(OutData%rTEtoObserve(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rTEtoObserve.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%rTEtoObserve,3), UBOUND(OutData%rTEtoObserve,3) - DO i2 = LBOUND(OutData%rTEtoObserve,2), UBOUND(OutData%rTEtoObserve,2) - DO i1 = LBOUND(OutData%rTEtoObserve,1), UBOUND(OutData%rTEtoObserve,1) - OutData%rTEtoObserve(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rLEtoObserve not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rLEtoObserve)) DEALLOCATE(OutData%rLEtoObserve) - ALLOCATE(OutData%rLEtoObserve(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rLEtoObserve.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%rLEtoObserve,3), UBOUND(OutData%rLEtoObserve,3) - DO i2 = LBOUND(OutData%rLEtoObserve,2), UBOUND(OutData%rLEtoObserve,2) - DO i1 = LBOUND(OutData%rLEtoObserve,1), UBOUND(OutData%rLEtoObserve,1) - OutData%rLEtoObserve(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LE_Location not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LE_Location)) DEALLOCATE(OutData%LE_Location) - ALLOCATE(OutData%LE_Location(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LE_Location.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%LE_Location,3), UBOUND(OutData%LE_Location,3) - DO i2 = LBOUND(OutData%LE_Location,2), UBOUND(OutData%LE_Location,2) - DO i1 = LBOUND(OutData%LE_Location,1), UBOUND(OutData%LE_Location,1) - OutData%LE_Location(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%RotSpeedAoA = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SPLLBL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SPLLBL)) DEALLOCATE(OutData%SPLLBL) - ALLOCATE(OutData%SPLLBL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLLBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SPLLBL,1), UBOUND(OutData%SPLLBL,1) - OutData%SPLLBL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SPLP not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SPLP)) DEALLOCATE(OutData%SPLP) - ALLOCATE(OutData%SPLP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SPLP,1), UBOUND(OutData%SPLP,1) - OutData%SPLP(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SPLS not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SPLS)) DEALLOCATE(OutData%SPLS) - ALLOCATE(OutData%SPLS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SPLS,1), UBOUND(OutData%SPLS,1) - OutData%SPLS(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SPLALPH not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SPLALPH)) DEALLOCATE(OutData%SPLALPH) - ALLOCATE(OutData%SPLALPH(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLALPH.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SPLALPH,1), UBOUND(OutData%SPLALPH,1) - OutData%SPLALPH(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SPLTBL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SPLTBL)) DEALLOCATE(OutData%SPLTBL) - ALLOCATE(OutData%SPLTBL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLTBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SPLTBL,1), UBOUND(OutData%SPLTBL,1) - OutData%SPLTBL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SPLTIP not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SPLTIP)) DEALLOCATE(OutData%SPLTIP) - ALLOCATE(OutData%SPLTIP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLTIP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SPLTIP,1), UBOUND(OutData%SPLTIP,1) - OutData%SPLTIP(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SPLTI not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SPLTI)) DEALLOCATE(OutData%SPLTI) - ALLOCATE(OutData%SPLTI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLTI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SPLTI,1), UBOUND(OutData%SPLTI,1) - OutData%SPLTI(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SPLTIGui not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SPLTIGui)) DEALLOCATE(OutData%SPLTIGui) - ALLOCATE(OutData%SPLTIGui(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLTIGui.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SPLTIGui,1), UBOUND(OutData%SPLTIGui,1) - OutData%SPLTIGui(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SPLBLUNT not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SPLBLUNT)) DEALLOCATE(OutData%SPLBLUNT) - ALLOCATE(OutData%SPLBLUNT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLBLUNT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SPLBLUNT,1), UBOUND(OutData%SPLBLUNT,1) - OutData%SPLBLUNT(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CfVar not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CfVar)) DEALLOCATE(OutData%CfVar) - ALLOCATE(OutData%CfVar(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CfVar.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CfVar,1), UBOUND(OutData%CfVar,1) - OutData%CfVar(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! d99Var not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%d99Var)) DEALLOCATE(OutData%d99Var) - ALLOCATE(OutData%d99Var(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%d99Var.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%d99Var,1), UBOUND(OutData%d99Var,1) - OutData%d99Var(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dStarVar not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%dStarVar)) DEALLOCATE(OutData%dStarVar) - ALLOCATE(OutData%dStarVar(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dStarVar.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dStarVar,1), UBOUND(OutData%dStarVar,1) - OutData%dStarVar(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! EdgeVelVar not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%EdgeVelVar)) DEALLOCATE(OutData%EdgeVelVar) - ALLOCATE(OutData%EdgeVelVar(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%EdgeVelVar.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%EdgeVelVar,1), UBOUND(OutData%EdgeVelVar,1) - OutData%EdgeVelVar(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%speccou = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%filesopen = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AA_UnPackMisc - - SUBROUTINE AA_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_ParameterType), INTENT(IN) :: SrcParamData - TYPE(AA_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT - DstParamData%IBLUNT = SrcParamData%IBLUNT - DstParamData%ILAM = SrcParamData%ILAM - DstParamData%ITIP = SrcParamData%ITIP - DstParamData%ITRIP = SrcParamData%ITRIP - DstParamData%ITURB = SrcParamData%ITURB - DstParamData%IInflow = SrcParamData%IInflow - DstParamData%X_BLMethod = SrcParamData%X_BLMethod - DstParamData%TICalcMeth = SrcParamData%TICalcMeth - DstParamData%ROUND = SrcParamData%ROUND - DstParamData%ALPRAT = SrcParamData%ALPRAT - DstParamData%NumBlades = SrcParamData%NumBlades - DstParamData%NumBlNds = SrcParamData%NumBlNds - DstParamData%AirDens = SrcParamData%AirDens - DstParamData%KinVisc = SrcParamData%KinVisc - DstParamData%SpdSound = SrcParamData%SpdSound - DstParamData%HubHeight = SrcParamData%HubHeight - DstParamData%toptip = SrcParamData%toptip - DstParamData%bottip = SrcParamData%bottip -IF (ALLOCATED(SrcParamData%rotorregionlimitsVert)) THEN - i1_l = LBOUND(SrcParamData%rotorregionlimitsVert,1) - i1_u = UBOUND(SrcParamData%rotorregionlimitsVert,1) - IF (.NOT. ALLOCATED(DstParamData%rotorregionlimitsVert)) THEN - ALLOCATE(DstParamData%rotorregionlimitsVert(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsVert.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%rotorregionlimitsVert = SrcParamData%rotorregionlimitsVert -ENDIF -IF (ALLOCATED(SrcParamData%rotorregionlimitsHorz)) THEN - i1_l = LBOUND(SrcParamData%rotorregionlimitsHorz,1) - i1_u = UBOUND(SrcParamData%rotorregionlimitsHorz,1) - IF (.NOT. ALLOCATED(DstParamData%rotorregionlimitsHorz)) THEN - ALLOCATE(DstParamData%rotorregionlimitsHorz(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsHorz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%rotorregionlimitsHorz = SrcParamData%rotorregionlimitsHorz -ENDIF -IF (ALLOCATED(SrcParamData%rotorregionlimitsalph)) THEN - i1_l = LBOUND(SrcParamData%rotorregionlimitsalph,1) - i1_u = UBOUND(SrcParamData%rotorregionlimitsalph,1) - IF (.NOT. ALLOCATED(DstParamData%rotorregionlimitsalph)) THEN - ALLOCATE(DstParamData%rotorregionlimitsalph(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsalph.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%rotorregionlimitsalph = SrcParamData%rotorregionlimitsalph -ENDIF -IF (ALLOCATED(SrcParamData%rotorregionlimitsrad)) THEN - i1_l = LBOUND(SrcParamData%rotorregionlimitsrad,1) - i1_u = UBOUND(SrcParamData%rotorregionlimitsrad,1) - IF (.NOT. ALLOCATED(DstParamData%rotorregionlimitsrad)) THEN - ALLOCATE(DstParamData%rotorregionlimitsrad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsrad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%rotorregionlimitsrad = SrcParamData%rotorregionlimitsrad + DstParamData%FreqList = SrcParamData%FreqList ENDIF - DstParamData%NrObsLoc = SrcParamData%NrObsLoc - DstParamData%aweightflag = SrcParamData%aweightflag - DstParamData%TxtFileOutput = SrcParamData%TxtFileOutput - DstParamData%AAStart = SrcParamData%AAStart -IF (ALLOCATED(SrcParamData%ObsX)) THEN - i1_l = LBOUND(SrcParamData%ObsX,1) - i1_u = UBOUND(SrcParamData%ObsX,1) - IF (.NOT. ALLOCATED(DstParamData%ObsX)) THEN - ALLOCATE(DstParamData%ObsX(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcParamData%Aweight)) THEN + i1_l = LBOUND(SrcParamData%Aweight,1) + i1_u = UBOUND(SrcParamData%Aweight,1) + IF (.NOT. ALLOCATED(DstParamData%Aweight)) THEN + ALLOCATE(DstParamData%Aweight(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ObsX.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Aweight.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstParamData%ObsX = SrcParamData%ObsX + DstParamData%Aweight = SrcParamData%Aweight ENDIF -IF (ALLOCATED(SrcParamData%ObsY)) THEN - i1_l = LBOUND(SrcParamData%ObsY,1) - i1_u = UBOUND(SrcParamData%ObsY,1) - IF (.NOT. ALLOCATED(DstParamData%ObsY)) THEN - ALLOCATE(DstParamData%ObsY(i1_l:i1_u),STAT=ErrStat2) + DstParamData%Fsample = SrcParamData%Fsample + DstParamData%total_sample = SrcParamData%total_sample + DstParamData%total_sampleTI = SrcParamData%total_sampleTI + DstParamData%AA_Bl_Prcntge = SrcParamData%AA_Bl_Prcntge + DstParamData%startnode = SrcParamData%startnode + DstParamData%Lturb = SrcParamData%Lturb + DstParamData%AvgV = SrcParamData%AvgV + DstParamData%dz_turb_in = SrcParamData%dz_turb_in + DstParamData%dy_turb_in = SrcParamData%dy_turb_in +IF (ALLOCATED(SrcParamData%TI_Grid_In)) THEN + i1_l = LBOUND(SrcParamData%TI_Grid_In,1) + i1_u = UBOUND(SrcParamData%TI_Grid_In,1) + i2_l = LBOUND(SrcParamData%TI_Grid_In,2) + i2_u = UBOUND(SrcParamData%TI_Grid_In,2) + IF (.NOT. ALLOCATED(DstParamData%TI_Grid_In)) THEN + ALLOCATE(DstParamData%TI_Grid_In(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ObsY.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TI_Grid_In.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstParamData%ObsY = SrcParamData%ObsY -ENDIF -IF (ALLOCATED(SrcParamData%ObsZ)) THEN - i1_l = LBOUND(SrcParamData%ObsZ,1) - i1_u = UBOUND(SrcParamData%ObsZ,1) - IF (.NOT. ALLOCATED(DstParamData%ObsZ)) THEN - ALLOCATE(DstParamData%ObsZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ObsZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ObsZ = SrcParamData%ObsZ -ENDIF -IF (ALLOCATED(SrcParamData%FreqList)) THEN - i1_l = LBOUND(SrcParamData%FreqList,1) - i1_u = UBOUND(SrcParamData%FreqList,1) - IF (.NOT. ALLOCATED(DstParamData%FreqList)) THEN - ALLOCATE(DstParamData%FreqList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FreqList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FreqList = SrcParamData%FreqList -ENDIF -IF (ALLOCATED(SrcParamData%Aweight)) THEN - i1_l = LBOUND(SrcParamData%Aweight,1) - i1_u = UBOUND(SrcParamData%Aweight,1) - IF (.NOT. ALLOCATED(DstParamData%Aweight)) THEN - ALLOCATE(DstParamData%Aweight(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Aweight.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Aweight = SrcParamData%Aweight -ENDIF - DstParamData%Fsample = SrcParamData%Fsample - DstParamData%total_sample = SrcParamData%total_sample - DstParamData%total_sampleTI = SrcParamData%total_sampleTI - DstParamData%AA_Bl_Prcntge = SrcParamData%AA_Bl_Prcntge - DstParamData%startnode = SrcParamData%startnode - DstParamData%Lturb = SrcParamData%Lturb - DstParamData%AvgV = SrcParamData%AvgV - DstParamData%dz_turb_in = SrcParamData%dz_turb_in - DstParamData%dy_turb_in = SrcParamData%dy_turb_in -IF (ALLOCATED(SrcParamData%TI_Grid_In)) THEN - i1_l = LBOUND(SrcParamData%TI_Grid_In,1) - i1_u = UBOUND(SrcParamData%TI_Grid_In,1) - i2_l = LBOUND(SrcParamData%TI_Grid_In,2) - i2_u = UBOUND(SrcParamData%TI_Grid_In,2) - IF (.NOT. ALLOCATED(DstParamData%TI_Grid_In)) THEN - ALLOCATE(DstParamData%TI_Grid_In(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TI_Grid_In.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TI_Grid_In = SrcParamData%TI_Grid_In + DstParamData%TI_Grid_In = SrcParamData%TI_Grid_In ENDIF DstParamData%FTitle = SrcParamData%FTitle DstParamData%outFmt = SrcParamData%outFmt @@ -5918,2468 +3543,1455 @@ SUBROUTINE AA_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) IF (.NOT. ALLOCATED(DstParamData%OutParam)) THEN ALLOCATE(DstParamData%OutParam(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%OutParam,1), UBOUND(SrcParamData%OutParam,1) - CALL NWTC_Library_Copyoutparmtype( SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%StallStart)) THEN - i1_l = LBOUND(SrcParamData%StallStart,1) - i1_u = UBOUND(SrcParamData%StallStart,1) - i2_l = LBOUND(SrcParamData%StallStart,2) - i2_u = UBOUND(SrcParamData%StallStart,2) - IF (.NOT. ALLOCATED(DstParamData%StallStart)) THEN - ALLOCATE(DstParamData%StallStart(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StallStart.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%StallStart = SrcParamData%StallStart -ENDIF -IF (ALLOCATED(SrcParamData%TEThick)) THEN - i1_l = LBOUND(SrcParamData%TEThick,1) - i1_u = UBOUND(SrcParamData%TEThick,1) - i2_l = LBOUND(SrcParamData%TEThick,2) - i2_u = UBOUND(SrcParamData%TEThick,2) - IF (.NOT. ALLOCATED(DstParamData%TEThick)) THEN - ALLOCATE(DstParamData%TEThick(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TEThick.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TEThick = SrcParamData%TEThick -ENDIF -IF (ALLOCATED(SrcParamData%TEAngle)) THEN - i1_l = LBOUND(SrcParamData%TEAngle,1) - i1_u = UBOUND(SrcParamData%TEAngle,1) - i2_l = LBOUND(SrcParamData%TEAngle,2) - i2_u = UBOUND(SrcParamData%TEAngle,2) - IF (.NOT. ALLOCATED(DstParamData%TEAngle)) THEN - ALLOCATE(DstParamData%TEAngle(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TEAngle.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TEAngle = SrcParamData%TEAngle -ENDIF -IF (ALLOCATED(SrcParamData%AerCent)) THEN - i1_l = LBOUND(SrcParamData%AerCent,1) - i1_u = UBOUND(SrcParamData%AerCent,1) - i2_l = LBOUND(SrcParamData%AerCent,2) - i2_u = UBOUND(SrcParamData%AerCent,2) - i3_l = LBOUND(SrcParamData%AerCent,3) - i3_u = UBOUND(SrcParamData%AerCent,3) - IF (.NOT. ALLOCATED(DstParamData%AerCent)) THEN - ALLOCATE(DstParamData%AerCent(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AerCent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AerCent = SrcParamData%AerCent -ENDIF -IF (ALLOCATED(SrcParamData%BlAFID)) THEN - i1_l = LBOUND(SrcParamData%BlAFID,1) - i1_u = UBOUND(SrcParamData%BlAFID,1) - i2_l = LBOUND(SrcParamData%BlAFID,2) - i2_u = UBOUND(SrcParamData%BlAFID,2) - IF (.NOT. ALLOCATED(DstParamData%BlAFID)) THEN - ALLOCATE(DstParamData%BlAFID(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlAFID.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BlAFID = SrcParamData%BlAFID -ENDIF -IF (ALLOCATED(SrcParamData%AFInfo)) THEN - i1_l = LBOUND(SrcParamData%AFInfo,1) - i1_u = UBOUND(SrcParamData%AFInfo,1) - IF (.NOT. ALLOCATED(DstParamData%AFInfo)) THEN - ALLOCATE(DstParamData%AFInfo(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFInfo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%AFInfo,1), UBOUND(SrcParamData%AFInfo,1) - CALL AFI_CopyParam( SrcParamData%AFInfo(i1), DstParamData%AFInfo(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%AFLECo)) THEN - i1_l = LBOUND(SrcParamData%AFLECo,1) - i1_u = UBOUND(SrcParamData%AFLECo,1) - i2_l = LBOUND(SrcParamData%AFLECo,2) - i2_u = UBOUND(SrcParamData%AFLECo,2) - i3_l = LBOUND(SrcParamData%AFLECo,3) - i3_u = UBOUND(SrcParamData%AFLECo,3) - IF (.NOT. ALLOCATED(DstParamData%AFLECo)) THEN - ALLOCATE(DstParamData%AFLECo(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFLECo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AFLECo = SrcParamData%AFLECo -ENDIF -IF (ALLOCATED(SrcParamData%AFTECo)) THEN - i1_l = LBOUND(SrcParamData%AFTECo,1) - i1_u = UBOUND(SrcParamData%AFTECo,1) - i2_l = LBOUND(SrcParamData%AFTECo,2) - i2_u = UBOUND(SrcParamData%AFTECo,2) - i3_l = LBOUND(SrcParamData%AFTECo,3) - i3_u = UBOUND(SrcParamData%AFTECo,3) - IF (.NOT. ALLOCATED(DstParamData%AFTECo)) THEN - ALLOCATE(DstParamData%AFTECo(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFTECo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AFTECo = SrcParamData%AFTECo -ENDIF -IF (ALLOCATED(SrcParamData%BlSpn)) THEN - i1_l = LBOUND(SrcParamData%BlSpn,1) - i1_u = UBOUND(SrcParamData%BlSpn,1) - i2_l = LBOUND(SrcParamData%BlSpn,2) - i2_u = UBOUND(SrcParamData%BlSpn,2) - IF (.NOT. ALLOCATED(DstParamData%BlSpn)) THEN - ALLOCATE(DstParamData%BlSpn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlSpn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BlSpn = SrcParamData%BlSpn -ENDIF -IF (ALLOCATED(SrcParamData%BlChord)) THEN - i1_l = LBOUND(SrcParamData%BlChord,1) - i1_u = UBOUND(SrcParamData%BlChord,1) - i2_l = LBOUND(SrcParamData%BlChord,2) - i2_u = UBOUND(SrcParamData%BlChord,2) - IF (.NOT. ALLOCATED(DstParamData%BlChord)) THEN - ALLOCATE(DstParamData%BlChord(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlChord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BlChord = SrcParamData%BlChord -ENDIF -IF (ALLOCATED(SrcParamData%ReListBL)) THEN - i1_l = LBOUND(SrcParamData%ReListBL,1) - i1_u = UBOUND(SrcParamData%ReListBL,1) - IF (.NOT. ALLOCATED(DstParamData%ReListBL)) THEN - ALLOCATE(DstParamData%ReListBL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ReListBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ReListBL = SrcParamData%ReListBL -ENDIF -IF (ALLOCATED(SrcParamData%AOAListBL)) THEN - i1_l = LBOUND(SrcParamData%AOAListBL,1) - i1_u = UBOUND(SrcParamData%AOAListBL,1) - IF (.NOT. ALLOCATED(DstParamData%AOAListBL)) THEN - ALLOCATE(DstParamData%AOAListBL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AOAListBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AOAListBL = SrcParamData%AOAListBL -ENDIF -IF (ALLOCATED(SrcParamData%dStarAll1)) THEN - i1_l = LBOUND(SrcParamData%dStarAll1,1) - i1_u = UBOUND(SrcParamData%dStarAll1,1) - i2_l = LBOUND(SrcParamData%dStarAll1,2) - i2_u = UBOUND(SrcParamData%dStarAll1,2) - i3_l = LBOUND(SrcParamData%dStarAll1,3) - i3_u = UBOUND(SrcParamData%dStarAll1,3) - IF (.NOT. ALLOCATED(DstParamData%dStarAll1)) THEN - ALLOCATE(DstParamData%dStarAll1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dStarAll1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%dStarAll1 = SrcParamData%dStarAll1 -ENDIF -IF (ALLOCATED(SrcParamData%dStarAll2)) THEN - i1_l = LBOUND(SrcParamData%dStarAll2,1) - i1_u = UBOUND(SrcParamData%dStarAll2,1) - i2_l = LBOUND(SrcParamData%dStarAll2,2) - i2_u = UBOUND(SrcParamData%dStarAll2,2) - i3_l = LBOUND(SrcParamData%dStarAll2,3) - i3_u = UBOUND(SrcParamData%dStarAll2,3) - IF (.NOT. ALLOCATED(DstParamData%dStarAll2)) THEN - ALLOCATE(DstParamData%dStarAll2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dStarAll2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%dStarAll2 = SrcParamData%dStarAll2 -ENDIF -IF (ALLOCATED(SrcParamData%d99All1)) THEN - i1_l = LBOUND(SrcParamData%d99All1,1) - i1_u = UBOUND(SrcParamData%d99All1,1) - i2_l = LBOUND(SrcParamData%d99All1,2) - i2_u = UBOUND(SrcParamData%d99All1,2) - i3_l = LBOUND(SrcParamData%d99All1,3) - i3_u = UBOUND(SrcParamData%d99All1,3) - IF (.NOT. ALLOCATED(DstParamData%d99All1)) THEN - ALLOCATE(DstParamData%d99All1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%d99All1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%d99All1 = SrcParamData%d99All1 -ENDIF -IF (ALLOCATED(SrcParamData%d99All2)) THEN - i1_l = LBOUND(SrcParamData%d99All2,1) - i1_u = UBOUND(SrcParamData%d99All2,1) - i2_l = LBOUND(SrcParamData%d99All2,2) - i2_u = UBOUND(SrcParamData%d99All2,2) - i3_l = LBOUND(SrcParamData%d99All2,3) - i3_u = UBOUND(SrcParamData%d99All2,3) - IF (.NOT. ALLOCATED(DstParamData%d99All2)) THEN - ALLOCATE(DstParamData%d99All2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%d99All2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%d99All2 = SrcParamData%d99All2 -ENDIF -IF (ALLOCATED(SrcParamData%CfAll1)) THEN - i1_l = LBOUND(SrcParamData%CfAll1,1) - i1_u = UBOUND(SrcParamData%CfAll1,1) - i2_l = LBOUND(SrcParamData%CfAll1,2) - i2_u = UBOUND(SrcParamData%CfAll1,2) - i3_l = LBOUND(SrcParamData%CfAll1,3) - i3_u = UBOUND(SrcParamData%CfAll1,3) - IF (.NOT. ALLOCATED(DstParamData%CfAll1)) THEN - ALLOCATE(DstParamData%CfAll1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CfAll1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CfAll1 = SrcParamData%CfAll1 -ENDIF -IF (ALLOCATED(SrcParamData%CfAll2)) THEN - i1_l = LBOUND(SrcParamData%CfAll2,1) - i1_u = UBOUND(SrcParamData%CfAll2,1) - i2_l = LBOUND(SrcParamData%CfAll2,2) - i2_u = UBOUND(SrcParamData%CfAll2,2) - i3_l = LBOUND(SrcParamData%CfAll2,3) - i3_u = UBOUND(SrcParamData%CfAll2,3) - IF (.NOT. ALLOCATED(DstParamData%CfAll2)) THEN - ALLOCATE(DstParamData%CfAll2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CfAll2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CfAll2 = SrcParamData%CfAll2 -ENDIF -IF (ALLOCATED(SrcParamData%EdgeVelRat1)) THEN - i1_l = LBOUND(SrcParamData%EdgeVelRat1,1) - i1_u = UBOUND(SrcParamData%EdgeVelRat1,1) - i2_l = LBOUND(SrcParamData%EdgeVelRat1,2) - i2_u = UBOUND(SrcParamData%EdgeVelRat1,2) - i3_l = LBOUND(SrcParamData%EdgeVelRat1,3) - i3_u = UBOUND(SrcParamData%EdgeVelRat1,3) - IF (.NOT. ALLOCATED(DstParamData%EdgeVelRat1)) THEN - ALLOCATE(DstParamData%EdgeVelRat1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%EdgeVelRat1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%EdgeVelRat1 = SrcParamData%EdgeVelRat1 -ENDIF -IF (ALLOCATED(SrcParamData%EdgeVelRat2)) THEN - i1_l = LBOUND(SrcParamData%EdgeVelRat2,1) - i1_u = UBOUND(SrcParamData%EdgeVelRat2,1) - i2_l = LBOUND(SrcParamData%EdgeVelRat2,2) - i2_u = UBOUND(SrcParamData%EdgeVelRat2,2) - i3_l = LBOUND(SrcParamData%EdgeVelRat2,3) - i3_u = UBOUND(SrcParamData%EdgeVelRat2,3) - IF (.NOT. ALLOCATED(DstParamData%EdgeVelRat2)) THEN - ALLOCATE(DstParamData%EdgeVelRat2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%EdgeVelRat2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%EdgeVelRat2 = SrcParamData%EdgeVelRat2 -ENDIF -IF (ALLOCATED(SrcParamData%AFThickGuida)) THEN - i1_l = LBOUND(SrcParamData%AFThickGuida,1) - i1_u = UBOUND(SrcParamData%AFThickGuida,1) - i2_l = LBOUND(SrcParamData%AFThickGuida,2) - i2_u = UBOUND(SrcParamData%AFThickGuida,2) - IF (.NOT. ALLOCATED(DstParamData%AFThickGuida)) THEN - ALLOCATE(DstParamData%AFThickGuida(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFThickGuida.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AFThickGuida = SrcParamData%AFThickGuida -ENDIF - END SUBROUTINE AA_CopyParam - - SUBROUTINE AA_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(AA_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%rotorregionlimitsVert)) THEN - DEALLOCATE(ParamData%rotorregionlimitsVert) -ENDIF -IF (ALLOCATED(ParamData%rotorregionlimitsHorz)) THEN - DEALLOCATE(ParamData%rotorregionlimitsHorz) -ENDIF -IF (ALLOCATED(ParamData%rotorregionlimitsalph)) THEN - DEALLOCATE(ParamData%rotorregionlimitsalph) -ENDIF -IF (ALLOCATED(ParamData%rotorregionlimitsrad)) THEN - DEALLOCATE(ParamData%rotorregionlimitsrad) -ENDIF -IF (ALLOCATED(ParamData%ObsX)) THEN - DEALLOCATE(ParamData%ObsX) -ENDIF -IF (ALLOCATED(ParamData%ObsY)) THEN - DEALLOCATE(ParamData%ObsY) -ENDIF -IF (ALLOCATED(ParamData%ObsZ)) THEN - DEALLOCATE(ParamData%ObsZ) -ENDIF -IF (ALLOCATED(ParamData%FreqList)) THEN - DEALLOCATE(ParamData%FreqList) -ENDIF -IF (ALLOCATED(ParamData%Aweight)) THEN - DEALLOCATE(ParamData%Aweight) -ENDIF -IF (ALLOCATED(ParamData%TI_Grid_In)) THEN - DEALLOCATE(ParamData%TI_Grid_In) -ENDIF -IF (ALLOCATED(ParamData%OutParam)) THEN -DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_DestroyOutParmType( ParamData%OutParam(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%OutParam) -ENDIF -IF (ALLOCATED(ParamData%StallStart)) THEN - DEALLOCATE(ParamData%StallStart) -ENDIF -IF (ALLOCATED(ParamData%TEThick)) THEN - DEALLOCATE(ParamData%TEThick) -ENDIF -IF (ALLOCATED(ParamData%TEAngle)) THEN - DEALLOCATE(ParamData%TEAngle) -ENDIF -IF (ALLOCATED(ParamData%AerCent)) THEN - DEALLOCATE(ParamData%AerCent) -ENDIF -IF (ALLOCATED(ParamData%BlAFID)) THEN - DEALLOCATE(ParamData%BlAFID) -ENDIF -IF (ALLOCATED(ParamData%AFInfo)) THEN -DO i1 = LBOUND(ParamData%AFInfo,1), UBOUND(ParamData%AFInfo,1) - CALL AFI_DestroyParam( ParamData%AFInfo(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%AFInfo) -ENDIF -IF (ALLOCATED(ParamData%AFLECo)) THEN - DEALLOCATE(ParamData%AFLECo) -ENDIF -IF (ALLOCATED(ParamData%AFTECo)) THEN - DEALLOCATE(ParamData%AFTECo) -ENDIF -IF (ALLOCATED(ParamData%BlSpn)) THEN - DEALLOCATE(ParamData%BlSpn) -ENDIF -IF (ALLOCATED(ParamData%BlChord)) THEN - DEALLOCATE(ParamData%BlChord) -ENDIF -IF (ALLOCATED(ParamData%ReListBL)) THEN - DEALLOCATE(ParamData%ReListBL) -ENDIF -IF (ALLOCATED(ParamData%AOAListBL)) THEN - DEALLOCATE(ParamData%AOAListBL) -ENDIF -IF (ALLOCATED(ParamData%dStarAll1)) THEN - DEALLOCATE(ParamData%dStarAll1) -ENDIF -IF (ALLOCATED(ParamData%dStarAll2)) THEN - DEALLOCATE(ParamData%dStarAll2) -ENDIF -IF (ALLOCATED(ParamData%d99All1)) THEN - DEALLOCATE(ParamData%d99All1) -ENDIF -IF (ALLOCATED(ParamData%d99All2)) THEN - DEALLOCATE(ParamData%d99All2) -ENDIF -IF (ALLOCATED(ParamData%CfAll1)) THEN - DEALLOCATE(ParamData%CfAll1) -ENDIF -IF (ALLOCATED(ParamData%CfAll2)) THEN - DEALLOCATE(ParamData%CfAll2) -ENDIF -IF (ALLOCATED(ParamData%EdgeVelRat1)) THEN - DEALLOCATE(ParamData%EdgeVelRat1) -ENDIF -IF (ALLOCATED(ParamData%EdgeVelRat2)) THEN - DEALLOCATE(ParamData%EdgeVelRat2) -ENDIF -IF (ALLOCATED(ParamData%AFThickGuida)) THEN - DEALLOCATE(ParamData%AFThickGuida) -ENDIF - END SUBROUTINE AA_DestroyParam - - SUBROUTINE AA_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AA_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! DT - Int_BufSz = Int_BufSz + 1 ! IBLUNT - Int_BufSz = Int_BufSz + 1 ! ILAM - Int_BufSz = Int_BufSz + 1 ! ITIP - Int_BufSz = Int_BufSz + 1 ! ITRIP - Int_BufSz = Int_BufSz + 1 ! ITURB - Int_BufSz = Int_BufSz + 1 ! IInflow - Int_BufSz = Int_BufSz + 1 ! X_BLMethod - Int_BufSz = Int_BufSz + 1 ! TICalcMeth - Int_BufSz = Int_BufSz + 1 ! ROUND - Re_BufSz = Re_BufSz + 1 ! ALPRAT - Int_BufSz = Int_BufSz + 1 ! NumBlades - Int_BufSz = Int_BufSz + 1 ! NumBlNds - Re_BufSz = Re_BufSz + 1 ! AirDens - Re_BufSz = Re_BufSz + 1 ! KinVisc - Re_BufSz = Re_BufSz + 1 ! SpdSound - Re_BufSz = Re_BufSz + 1 ! HubHeight - Re_BufSz = Re_BufSz + 1 ! toptip - Re_BufSz = Re_BufSz + 1 ! bottip - Int_BufSz = Int_BufSz + 1 ! rotorregionlimitsVert allocated yes/no - IF ( ALLOCATED(InData%rotorregionlimitsVert) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotorregionlimitsVert upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rotorregionlimitsVert) ! rotorregionlimitsVert - END IF - Int_BufSz = Int_BufSz + 1 ! rotorregionlimitsHorz allocated yes/no - IF ( ALLOCATED(InData%rotorregionlimitsHorz) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotorregionlimitsHorz upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rotorregionlimitsHorz) ! rotorregionlimitsHorz - END IF - Int_BufSz = Int_BufSz + 1 ! rotorregionlimitsalph allocated yes/no - IF ( ALLOCATED(InData%rotorregionlimitsalph) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotorregionlimitsalph upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rotorregionlimitsalph) ! rotorregionlimitsalph - END IF - Int_BufSz = Int_BufSz + 1 ! rotorregionlimitsrad allocated yes/no - IF ( ALLOCATED(InData%rotorregionlimitsrad) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotorregionlimitsrad upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rotorregionlimitsrad) ! rotorregionlimitsrad - END IF - Int_BufSz = Int_BufSz + 1 ! NrObsLoc - Int_BufSz = Int_BufSz + 1 ! aweightflag - Int_BufSz = Int_BufSz + 1 ! TxtFileOutput - Db_BufSz = Db_BufSz + 1 ! AAStart - Int_BufSz = Int_BufSz + 1 ! ObsX allocated yes/no - IF ( ALLOCATED(InData%ObsX) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ObsX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ObsX) ! ObsX - END IF - Int_BufSz = Int_BufSz + 1 ! ObsY allocated yes/no - IF ( ALLOCATED(InData%ObsY) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ObsY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ObsY) ! ObsY - END IF - Int_BufSz = Int_BufSz + 1 ! ObsZ allocated yes/no - IF ( ALLOCATED(InData%ObsZ) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ObsZ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ObsZ) ! ObsZ - END IF - Int_BufSz = Int_BufSz + 1 ! FreqList allocated yes/no - IF ( ALLOCATED(InData%FreqList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FreqList upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FreqList) ! FreqList - END IF - Int_BufSz = Int_BufSz + 1 ! Aweight allocated yes/no - IF ( ALLOCATED(InData%Aweight) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Aweight upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Aweight) ! Aweight - END IF - Re_BufSz = Re_BufSz + 1 ! Fsample - Int_BufSz = Int_BufSz + 1 ! total_sample - Int_BufSz = Int_BufSz + 1 ! total_sampleTI - Int_BufSz = Int_BufSz + 1 ! AA_Bl_Prcntge - Int_BufSz = Int_BufSz + 1 ! startnode - Re_BufSz = Re_BufSz + 1 ! Lturb - Re_BufSz = Re_BufSz + 1 ! AvgV - Re_BufSz = Re_BufSz + 1 ! dz_turb_in - Re_BufSz = Re_BufSz + 1 ! dy_turb_in - Int_BufSz = Int_BufSz + 1 ! TI_Grid_In allocated yes/no - IF ( ALLOCATED(InData%TI_Grid_In) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TI_Grid_In upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TI_Grid_In) ! TI_Grid_In - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%FTitle) ! FTitle - Int_BufSz = Int_BufSz + 1*LEN(InData%outFmt) ! outFmt - Int_BufSz = Int_BufSz + 1 ! NrOutFile - Int_BufSz = Int_BufSz + 1*LEN(InData%delim) ! delim - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! NumOutsForPE - Int_BufSz = Int_BufSz + 1 ! NumOutsForSep - Int_BufSz = Int_BufSz + 1 ! NumOutsForNodes - Int_BufSz = Int_BufSz + 1 ! unOutFile - Int_BufSz = Int_BufSz + 1 ! unOutFile2 - Int_BufSz = Int_BufSz + 1 ! unOutFile3 - Int_BufSz = Int_BufSz + 1 ! unOutFile4 - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1 ! OutParam allocated yes/no - IF ( ALLOCATED(InData%OutParam) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutParam upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - Int_BufSz = Int_BufSz + 3 ! OutParam: size of buffers for each call to pack subtype - CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutParam - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutParam - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutParam - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! StallStart allocated yes/no - IF ( ALLOCATED(InData%StallStart) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StallStart upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StallStart) ! StallStart - END IF - Int_BufSz = Int_BufSz + 1 ! TEThick allocated yes/no - IF ( ALLOCATED(InData%TEThick) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TEThick upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TEThick) ! TEThick - END IF - Int_BufSz = Int_BufSz + 1 ! TEAngle allocated yes/no - IF ( ALLOCATED(InData%TEAngle) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TEAngle upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TEAngle) ! TEAngle - END IF - Int_BufSz = Int_BufSz + 1 ! AerCent allocated yes/no - IF ( ALLOCATED(InData%AerCent) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AerCent upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AerCent) ! AerCent - END IF - Int_BufSz = Int_BufSz + 1 ! BlAFID allocated yes/no - IF ( ALLOCATED(InData%BlAFID) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BlAFID upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BlAFID) ! BlAFID - END IF - Int_BufSz = Int_BufSz + 1 ! AFInfo allocated yes/no - IF ( ALLOCATED(InData%AFInfo) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AFInfo upper/lower bounds for each dimension - DO i1 = LBOUND(InData%AFInfo,1), UBOUND(InData%AFInfo,1) - Int_BufSz = Int_BufSz + 3 ! AFInfo: size of buffers for each call to pack subtype - CALL AFI_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%AFInfo(i1), ErrStat2, ErrMsg2, .TRUE. ) ! AFInfo - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AFInfo - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AFInfo - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AFInfo - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! AFLECo allocated yes/no - IF ( ALLOCATED(InData%AFLECo) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AFLECo upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AFLECo) ! AFLECo - END IF - Int_BufSz = Int_BufSz + 1 ! AFTECo allocated yes/no - IF ( ALLOCATED(InData%AFTECo) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AFTECo upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AFTECo) ! AFTECo - END IF - Int_BufSz = Int_BufSz + 1 ! BlSpn allocated yes/no - IF ( ALLOCATED(InData%BlSpn) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BlSpn upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlSpn) ! BlSpn - END IF - Int_BufSz = Int_BufSz + 1 ! BlChord allocated yes/no - IF ( ALLOCATED(InData%BlChord) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BlChord upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlChord) ! BlChord - END IF - Int_BufSz = Int_BufSz + 1 ! ReListBL allocated yes/no - IF ( ALLOCATED(InData%ReListBL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ReListBL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ReListBL) ! ReListBL - END IF - Int_BufSz = Int_BufSz + 1 ! AOAListBL allocated yes/no - IF ( ALLOCATED(InData%AOAListBL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AOAListBL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AOAListBL) ! AOAListBL - END IF - Int_BufSz = Int_BufSz + 1 ! dStarAll1 allocated yes/no - IF ( ALLOCATED(InData%dStarAll1) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! dStarAll1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dStarAll1) ! dStarAll1 - END IF - Int_BufSz = Int_BufSz + 1 ! dStarAll2 allocated yes/no - IF ( ALLOCATED(InData%dStarAll2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! dStarAll2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dStarAll2) ! dStarAll2 - END IF - Int_BufSz = Int_BufSz + 1 ! d99All1 allocated yes/no - IF ( ALLOCATED(InData%d99All1) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! d99All1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%d99All1) ! d99All1 - END IF - Int_BufSz = Int_BufSz + 1 ! d99All2 allocated yes/no - IF ( ALLOCATED(InData%d99All2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! d99All2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%d99All2) ! d99All2 - END IF - Int_BufSz = Int_BufSz + 1 ! CfAll1 allocated yes/no - IF ( ALLOCATED(InData%CfAll1) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! CfAll1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CfAll1) ! CfAll1 - END IF - Int_BufSz = Int_BufSz + 1 ! CfAll2 allocated yes/no - IF ( ALLOCATED(InData%CfAll2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! CfAll2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CfAll2) ! CfAll2 - END IF - Int_BufSz = Int_BufSz + 1 ! EdgeVelRat1 allocated yes/no - IF ( ALLOCATED(InData%EdgeVelRat1) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! EdgeVelRat1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%EdgeVelRat1) ! EdgeVelRat1 - END IF - Int_BufSz = Int_BufSz + 1 ! EdgeVelRat2 allocated yes/no - IF ( ALLOCATED(InData%EdgeVelRat2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! EdgeVelRat2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%EdgeVelRat2) ! EdgeVelRat2 - END IF - Int_BufSz = Int_BufSz + 1 ! AFThickGuida allocated yes/no - IF ( ALLOCATED(InData%AFThickGuida) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AFThickGuida upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AFThickGuida) ! AFThickGuida - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%IBLUNT - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ILAM - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ITIP - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ITRIP - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ITURB - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%IInflow - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%X_BLMethod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TICalcMeth - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%ROUND, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ALPRAT - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBlades - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBlNds - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AirDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%KinVisc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SpdSound - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubHeight - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%toptip - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%bottip - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%rotorregionlimitsVert) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rotorregionlimitsVert,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotorregionlimitsVert,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rotorregionlimitsVert,1), UBOUND(InData%rotorregionlimitsVert,1) - ReKiBuf(Re_Xferred) = InData%rotorregionlimitsVert(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rotorregionlimitsHorz) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rotorregionlimitsHorz,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotorregionlimitsHorz,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rotorregionlimitsHorz,1), UBOUND(InData%rotorregionlimitsHorz,1) - ReKiBuf(Re_Xferred) = InData%rotorregionlimitsHorz(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rotorregionlimitsalph) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rotorregionlimitsalph,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotorregionlimitsalph,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rotorregionlimitsalph,1), UBOUND(InData%rotorregionlimitsalph,1) - ReKiBuf(Re_Xferred) = InData%rotorregionlimitsalph(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rotorregionlimitsrad) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rotorregionlimitsrad,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotorregionlimitsrad,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rotorregionlimitsrad,1), UBOUND(InData%rotorregionlimitsrad,1) - ReKiBuf(Re_Xferred) = InData%rotorregionlimitsrad(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NrObsLoc - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%aweightflag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TxtFileOutput, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%AAStart - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%ObsX) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ObsX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ObsX,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ObsX,1), UBOUND(InData%ObsX,1) - ReKiBuf(Re_Xferred) = InData%ObsX(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ObsY) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ObsY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ObsY,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ObsY,1), UBOUND(InData%ObsY,1) - ReKiBuf(Re_Xferred) = InData%ObsY(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ObsZ) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ObsZ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ObsZ,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ObsZ,1), UBOUND(InData%ObsZ,1) - ReKiBuf(Re_Xferred) = InData%ObsZ(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FreqList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FreqList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FreqList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FreqList,1), UBOUND(InData%FreqList,1) - ReKiBuf(Re_Xferred) = InData%FreqList(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Aweight) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Aweight,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Aweight,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Aweight,1), UBOUND(InData%Aweight,1) - ReKiBuf(Re_Xferred) = InData%Aweight(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%Fsample - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%total_sample - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%total_sampleTI - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%AA_Bl_Prcntge - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%startnode - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Lturb - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AvgV - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dz_turb_in - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dy_turb_in - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TI_Grid_In) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TI_Grid_In,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI_Grid_In,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TI_Grid_In,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI_Grid_In,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TI_Grid_In,2), UBOUND(InData%TI_Grid_In,2) - DO i1 = LBOUND(InData%TI_Grid_In,1), UBOUND(InData%TI_Grid_In,1) - ReKiBuf(Re_Xferred) = InData%TI_Grid_In(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DO I = 1, LEN(InData%FTitle) - IntKiBuf(Int_Xferred) = ICHAR(InData%FTitle(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%outFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%outFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%NrOutFile - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOutsForPE - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOutsForSep - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOutsForNodes - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%unOutFile - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%unOutFile2 - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%unOutFile3 - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%unOutFile4 - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutParam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParam,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StallStart) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StallStart,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StallStart,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StallStart,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StallStart,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%StallStart,2), UBOUND(InData%StallStart,2) - DO i1 = LBOUND(InData%StallStart,1), UBOUND(InData%StallStart,1) - ReKiBuf(Re_Xferred) = InData%StallStart(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TEThick) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TEThick,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TEThick,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TEThick,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TEThick,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TEThick,2), UBOUND(InData%TEThick,2) - DO i1 = LBOUND(InData%TEThick,1), UBOUND(InData%TEThick,1) - ReKiBuf(Re_Xferred) = InData%TEThick(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TEAngle) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TEAngle,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TEAngle,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TEAngle,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TEAngle,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TEAngle,2), UBOUND(InData%TEAngle,2) - DO i1 = LBOUND(InData%TEAngle,1), UBOUND(InData%TEAngle,1) - ReKiBuf(Re_Xferred) = InData%TEAngle(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AerCent) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AerCent,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AerCent,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AerCent,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AerCent,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AerCent,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AerCent,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AerCent,3), UBOUND(InData%AerCent,3) - DO i2 = LBOUND(InData%AerCent,2), UBOUND(InData%AerCent,2) - DO i1 = LBOUND(InData%AerCent,1), UBOUND(InData%AerCent,1) - ReKiBuf(Re_Xferred) = InData%AerCent(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlAFID) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlAFID,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlAFID,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlAFID,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlAFID,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BlAFID,2), UBOUND(InData%BlAFID,2) - DO i1 = LBOUND(InData%BlAFID,1), UBOUND(InData%BlAFID,1) - IntKiBuf(Int_Xferred) = InData%BlAFID(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AFInfo) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFInfo,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFInfo,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AFInfo,1), UBOUND(InData%AFInfo,1) - CALL AFI_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%AFInfo(i1), ErrStat2, ErrMsg2, OnlySize ) ! AFInfo - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AFLECo) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFLECo,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFLECo,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFLECo,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFLECo,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFLECo,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFLECo,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AFLECo,3), UBOUND(InData%AFLECo,3) - DO i2 = LBOUND(InData%AFLECo,2), UBOUND(InData%AFLECo,2) - DO i1 = LBOUND(InData%AFLECo,1), UBOUND(InData%AFLECo,1) - ReKiBuf(Re_Xferred) = InData%AFLECo(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AFTECo) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFTECo,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFTECo,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFTECo,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFTECo,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFTECo,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFTECo,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AFTECo,3), UBOUND(InData%AFTECo,3) - DO i2 = LBOUND(InData%AFTECo,2), UBOUND(InData%AFTECo,2) - DO i1 = LBOUND(InData%AFTECo,1), UBOUND(InData%AFTECo,1) - ReKiBuf(Re_Xferred) = InData%AFTECo(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlSpn) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlSpn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlSpn,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlSpn,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlSpn,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BlSpn,2), UBOUND(InData%BlSpn,2) - DO i1 = LBOUND(InData%BlSpn,1), UBOUND(InData%BlSpn,1) - ReKiBuf(Re_Xferred) = InData%BlSpn(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlChord) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlChord,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlChord,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlChord,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlChord,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BlChord,2), UBOUND(InData%BlChord,2) - DO i1 = LBOUND(InData%BlChord,1), UBOUND(InData%BlChord,1) - ReKiBuf(Re_Xferred) = InData%BlChord(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ReListBL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ReListBL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ReListBL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ReListBL,1), UBOUND(InData%ReListBL,1) - ReKiBuf(Re_Xferred) = InData%ReListBL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AOAListBL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AOAListBL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AOAListBL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AOAListBL,1), UBOUND(InData%AOAListBL,1) - ReKiBuf(Re_Xferred) = InData%AOAListBL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dStarAll1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dStarAll1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dStarAll1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dStarAll1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dStarAll1,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dStarAll1,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dStarAll1,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%dStarAll1,3), UBOUND(InData%dStarAll1,3) - DO i2 = LBOUND(InData%dStarAll1,2), UBOUND(InData%dStarAll1,2) - DO i1 = LBOUND(InData%dStarAll1,1), UBOUND(InData%dStarAll1,1) - ReKiBuf(Re_Xferred) = InData%dStarAll1(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dStarAll2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dStarAll2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dStarAll2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dStarAll2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dStarAll2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dStarAll2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dStarAll2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%dStarAll2,3), UBOUND(InData%dStarAll2,3) - DO i2 = LBOUND(InData%dStarAll2,2), UBOUND(InData%dStarAll2,2) - DO i1 = LBOUND(InData%dStarAll2,1), UBOUND(InData%dStarAll2,1) - ReKiBuf(Re_Xferred) = InData%dStarAll2(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%d99All1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%d99All1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%d99All1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%d99All1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%d99All1,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%d99All1,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%d99All1,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%d99All1,3), UBOUND(InData%d99All1,3) - DO i2 = LBOUND(InData%d99All1,2), UBOUND(InData%d99All1,2) - DO i1 = LBOUND(InData%d99All1,1), UBOUND(InData%d99All1,1) - ReKiBuf(Re_Xferred) = InData%d99All1(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%d99All2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%d99All2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%d99All2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%d99All2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%d99All2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%d99All2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%d99All2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%d99All2,3), UBOUND(InData%d99All2,3) - DO i2 = LBOUND(InData%d99All2,2), UBOUND(InData%d99All2,2) - DO i1 = LBOUND(InData%d99All2,1), UBOUND(InData%d99All2,1) - ReKiBuf(Re_Xferred) = InData%d99All2(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CfAll1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CfAll1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CfAll1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CfAll1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CfAll1,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CfAll1,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CfAll1,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%CfAll1,3), UBOUND(InData%CfAll1,3) - DO i2 = LBOUND(InData%CfAll1,2), UBOUND(InData%CfAll1,2) - DO i1 = LBOUND(InData%CfAll1,1), UBOUND(InData%CfAll1,1) - ReKiBuf(Re_Xferred) = InData%CfAll1(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CfAll2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CfAll2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CfAll2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CfAll2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CfAll2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CfAll2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CfAll2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%CfAll2,3), UBOUND(InData%CfAll2,3) - DO i2 = LBOUND(InData%CfAll2,2), UBOUND(InData%CfAll2,2) - DO i1 = LBOUND(InData%CfAll2,1), UBOUND(InData%CfAll2,1) - ReKiBuf(Re_Xferred) = InData%CfAll2(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%EdgeVelRat1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%EdgeVelRat1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EdgeVelRat1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%EdgeVelRat1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EdgeVelRat1,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%EdgeVelRat1,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EdgeVelRat1,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%EdgeVelRat1,3), UBOUND(InData%EdgeVelRat1,3) - DO i2 = LBOUND(InData%EdgeVelRat1,2), UBOUND(InData%EdgeVelRat1,2) - DO i1 = LBOUND(InData%EdgeVelRat1,1), UBOUND(InData%EdgeVelRat1,1) - ReKiBuf(Re_Xferred) = InData%EdgeVelRat1(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%EdgeVelRat2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%EdgeVelRat2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EdgeVelRat2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%EdgeVelRat2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EdgeVelRat2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%EdgeVelRat2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EdgeVelRat2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%EdgeVelRat2,3), UBOUND(InData%EdgeVelRat2,3) - DO i2 = LBOUND(InData%EdgeVelRat2,2), UBOUND(InData%EdgeVelRat2,2) - DO i1 = LBOUND(InData%EdgeVelRat2,1), UBOUND(InData%EdgeVelRat2,1) - ReKiBuf(Re_Xferred) = InData%EdgeVelRat2(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AFThickGuida) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFThickGuida,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFThickGuida,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFThickGuida,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFThickGuida,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AFThickGuida,2), UBOUND(InData%AFThickGuida,2) - DO i1 = LBOUND(InData%AFThickGuida,1), UBOUND(InData%AFThickGuida,1) - ReKiBuf(Re_Xferred) = InData%AFThickGuida(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE AA_PackParam - - SUBROUTINE AA_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AA_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%IBLUNT = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ILAM = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ITIP = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ITRIP = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ITURB = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%IInflow = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%X_BLMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TICalcMeth = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ROUND = TRANSFER(IntKiBuf(Int_Xferred), OutData%ROUND) - Int_Xferred = Int_Xferred + 1 - OutData%ALPRAT = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NumBlades = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumBlNds = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%AirDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%KinVisc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SpdSound = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HubHeight = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%toptip = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%bottip = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rotorregionlimitsVert not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rotorregionlimitsVert)) DEALLOCATE(OutData%rotorregionlimitsVert) - ALLOCATE(OutData%rotorregionlimitsVert(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotorregionlimitsVert.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotorregionlimitsVert,1), UBOUND(OutData%rotorregionlimitsVert,1) - OutData%rotorregionlimitsVert(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rotorregionlimitsHorz not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rotorregionlimitsHorz)) DEALLOCATE(OutData%rotorregionlimitsHorz) - ALLOCATE(OutData%rotorregionlimitsHorz(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotorregionlimitsHorz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotorregionlimitsHorz,1), UBOUND(OutData%rotorregionlimitsHorz,1) - OutData%rotorregionlimitsHorz(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rotorregionlimitsalph not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rotorregionlimitsalph)) DEALLOCATE(OutData%rotorregionlimitsalph) - ALLOCATE(OutData%rotorregionlimitsalph(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotorregionlimitsalph.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotorregionlimitsalph,1), UBOUND(OutData%rotorregionlimitsalph,1) - OutData%rotorregionlimitsalph(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rotorregionlimitsrad not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rotorregionlimitsrad)) DEALLOCATE(OutData%rotorregionlimitsrad) - ALLOCATE(OutData%rotorregionlimitsrad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotorregionlimitsrad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotorregionlimitsrad,1), UBOUND(OutData%rotorregionlimitsrad,1) - OutData%rotorregionlimitsrad(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%NrObsLoc = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%aweightflag = TRANSFER(IntKiBuf(Int_Xferred), OutData%aweightflag) - Int_Xferred = Int_Xferred + 1 - OutData%TxtFileOutput = TRANSFER(IntKiBuf(Int_Xferred), OutData%TxtFileOutput) - Int_Xferred = Int_Xferred + 1 - OutData%AAStart = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ObsX not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ObsX)) DEALLOCATE(OutData%ObsX) - ALLOCATE(OutData%ObsX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ObsX,1), UBOUND(OutData%ObsX,1) - OutData%ObsX(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ObsY not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ObsY)) DEALLOCATE(OutData%ObsY) - ALLOCATE(OutData%ObsY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ObsY,1), UBOUND(OutData%ObsY,1) - OutData%ObsY(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ObsZ not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ObsZ)) DEALLOCATE(OutData%ObsZ) - ALLOCATE(OutData%ObsZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ObsZ,1), UBOUND(OutData%ObsZ,1) - OutData%ObsZ(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FreqList not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FreqList)) DEALLOCATE(OutData%FreqList) - ALLOCATE(OutData%FreqList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FreqList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FreqList,1), UBOUND(OutData%FreqList,1) - OutData%FreqList(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Aweight not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Aweight)) DEALLOCATE(OutData%Aweight) - ALLOCATE(OutData%Aweight(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Aweight.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Aweight,1), UBOUND(OutData%Aweight,1) - OutData%Aweight(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Fsample = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%total_sample = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%total_sampleTI = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%AA_Bl_Prcntge = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%startnode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Lturb = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AvgV = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dz_turb_in = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dy_turb_in = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TI_Grid_In not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TI_Grid_In)) DEALLOCATE(OutData%TI_Grid_In) - ALLOCATE(OutData%TI_Grid_In(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI_Grid_In.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TI_Grid_In,2), UBOUND(OutData%TI_Grid_In,2) - DO i1 = LBOUND(OutData%TI_Grid_In,1), UBOUND(OutData%TI_Grid_In,1) - OutData%TI_Grid_In(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DO I = 1, LEN(OutData%FTitle) - OutData%FTitle(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%outFmt) - OutData%outFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%NrOutFile = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%delim) - OutData%delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumOutsForPE = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumOutsForSep = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumOutsForNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%unOutFile = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%unOutFile2 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%unOutFile3 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%unOutFile4 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutParam)) DEALLOCATE(OutData%OutParam) - ALLOCATE(OutData%OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%OutParam,1), UBOUND(OutData%OutParam,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackOutParmType( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StallStart not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%StallStart)) DEALLOCATE(OutData%StallStart) - ALLOCATE(OutData%StallStart(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DO i1 = LBOUND(SrcParamData%OutParam,1), UBOUND(SrcParamData%OutParam,1) + CALL NWTC_Library_Copyoutparmtype( SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcParamData%StallStart)) THEN + i1_l = LBOUND(SrcParamData%StallStart,1) + i1_u = UBOUND(SrcParamData%StallStart,1) + i2_l = LBOUND(SrcParamData%StallStart,2) + i2_u = UBOUND(SrcParamData%StallStart,2) + IF (.NOT. ALLOCATED(DstParamData%StallStart)) THEN + ALLOCATE(DstParamData%StallStart(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StallStart.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StallStart.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i2 = LBOUND(OutData%StallStart,2), UBOUND(OutData%StallStart,2) - DO i1 = LBOUND(OutData%StallStart,1), UBOUND(OutData%StallStart,1) - OutData%StallStart(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TEThick not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TEThick)) DEALLOCATE(OutData%TEThick) - ALLOCATE(OutData%TEThick(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DstParamData%StallStart = SrcParamData%StallStart +ENDIF +IF (ALLOCATED(SrcParamData%TEThick)) THEN + i1_l = LBOUND(SrcParamData%TEThick,1) + i1_u = UBOUND(SrcParamData%TEThick,1) + i2_l = LBOUND(SrcParamData%TEThick,2) + i2_u = UBOUND(SrcParamData%TEThick,2) + IF (.NOT. ALLOCATED(DstParamData%TEThick)) THEN + ALLOCATE(DstParamData%TEThick(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TEThick.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TEThick.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i2 = LBOUND(OutData%TEThick,2), UBOUND(OutData%TEThick,2) - DO i1 = LBOUND(OutData%TEThick,1), UBOUND(OutData%TEThick,1) - OutData%TEThick(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TEAngle not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TEAngle)) DEALLOCATE(OutData%TEAngle) - ALLOCATE(OutData%TEAngle(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DstParamData%TEThick = SrcParamData%TEThick +ENDIF +IF (ALLOCATED(SrcParamData%TEAngle)) THEN + i1_l = LBOUND(SrcParamData%TEAngle,1) + i1_u = UBOUND(SrcParamData%TEAngle,1) + i2_l = LBOUND(SrcParamData%TEAngle,2) + i2_u = UBOUND(SrcParamData%TEAngle,2) + IF (.NOT. ALLOCATED(DstParamData%TEAngle)) THEN + ALLOCATE(DstParamData%TEAngle(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TEAngle.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TEAngle.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i2 = LBOUND(OutData%TEAngle,2), UBOUND(OutData%TEAngle,2) - DO i1 = LBOUND(OutData%TEAngle,1), UBOUND(OutData%TEAngle,1) - OutData%TEAngle(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AerCent not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AerCent)) DEALLOCATE(OutData%AerCent) - ALLOCATE(OutData%AerCent(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + DstParamData%TEAngle = SrcParamData%TEAngle +ENDIF +IF (ALLOCATED(SrcParamData%AerCent)) THEN + i1_l = LBOUND(SrcParamData%AerCent,1) + i1_u = UBOUND(SrcParamData%AerCent,1) + i2_l = LBOUND(SrcParamData%AerCent,2) + i2_u = UBOUND(SrcParamData%AerCent,2) + i3_l = LBOUND(SrcParamData%AerCent,3) + i3_u = UBOUND(SrcParamData%AerCent,3) + IF (.NOT. ALLOCATED(DstParamData%AerCent)) THEN + ALLOCATE(DstParamData%AerCent(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AerCent.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AerCent.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i3 = LBOUND(OutData%AerCent,3), UBOUND(OutData%AerCent,3) - DO i2 = LBOUND(OutData%AerCent,2), UBOUND(OutData%AerCent,2) - DO i1 = LBOUND(OutData%AerCent,1), UBOUND(OutData%AerCent,1) - OutData%AerCent(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlAFID not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlAFID)) DEALLOCATE(OutData%BlAFID) - ALLOCATE(OutData%BlAFID(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DstParamData%AerCent = SrcParamData%AerCent +ENDIF +IF (ALLOCATED(SrcParamData%BlAFID)) THEN + i1_l = LBOUND(SrcParamData%BlAFID,1) + i1_u = UBOUND(SrcParamData%BlAFID,1) + i2_l = LBOUND(SrcParamData%BlAFID,2) + i2_u = UBOUND(SrcParamData%BlAFID,2) + IF (.NOT. ALLOCATED(DstParamData%BlAFID)) THEN + ALLOCATE(DstParamData%BlAFID(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlAFID.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlAFID.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i2 = LBOUND(OutData%BlAFID,2), UBOUND(OutData%BlAFID,2) - DO i1 = LBOUND(OutData%BlAFID,1), UBOUND(OutData%BlAFID,1) - OutData%BlAFID(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFInfo not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AFInfo)) DEALLOCATE(OutData%AFInfo) - ALLOCATE(OutData%AFInfo(i1_l:i1_u),STAT=ErrStat2) + DstParamData%BlAFID = SrcParamData%BlAFID +ENDIF +IF (ALLOCATED(SrcParamData%AFInfo)) THEN + i1_l = LBOUND(SrcParamData%AFInfo,1) + i1_u = UBOUND(SrcParamData%AFInfo,1) + IF (.NOT. ALLOCATED(DstParamData%AFInfo)) THEN + ALLOCATE(DstParamData%AFInfo(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFInfo.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFInfo.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%AFInfo,1), UBOUND(OutData%AFInfo,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AFI_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%AFInfo(i1), ErrStat2, ErrMsg2 ) ! AFInfo - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFLECo not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AFLECo)) DEALLOCATE(OutData%AFLECo) - ALLOCATE(OutData%AFLECo(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + DO i1 = LBOUND(SrcParamData%AFInfo,1), UBOUND(SrcParamData%AFInfo,1) + CALL AFI_CopyParam( SrcParamData%AFInfo(i1), DstParamData%AFInfo(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcParamData%AFLECo)) THEN + i1_l = LBOUND(SrcParamData%AFLECo,1) + i1_u = UBOUND(SrcParamData%AFLECo,1) + i2_l = LBOUND(SrcParamData%AFLECo,2) + i2_u = UBOUND(SrcParamData%AFLECo,2) + i3_l = LBOUND(SrcParamData%AFLECo,3) + i3_u = UBOUND(SrcParamData%AFLECo,3) + IF (.NOT. ALLOCATED(DstParamData%AFLECo)) THEN + ALLOCATE(DstParamData%AFLECo(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFLECo.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFLECo.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i3 = LBOUND(OutData%AFLECo,3), UBOUND(OutData%AFLECo,3) - DO i2 = LBOUND(OutData%AFLECo,2), UBOUND(OutData%AFLECo,2) - DO i1 = LBOUND(OutData%AFLECo,1), UBOUND(OutData%AFLECo,1) - OutData%AFLECo(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFTECo not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AFTECo)) DEALLOCATE(OutData%AFTECo) - ALLOCATE(OutData%AFTECo(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + DstParamData%AFLECo = SrcParamData%AFLECo +ENDIF +IF (ALLOCATED(SrcParamData%AFTECo)) THEN + i1_l = LBOUND(SrcParamData%AFTECo,1) + i1_u = UBOUND(SrcParamData%AFTECo,1) + i2_l = LBOUND(SrcParamData%AFTECo,2) + i2_u = UBOUND(SrcParamData%AFTECo,2) + i3_l = LBOUND(SrcParamData%AFTECo,3) + i3_u = UBOUND(SrcParamData%AFTECo,3) + IF (.NOT. ALLOCATED(DstParamData%AFTECo)) THEN + ALLOCATE(DstParamData%AFTECo(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFTECo.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFTECo.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i3 = LBOUND(OutData%AFTECo,3), UBOUND(OutData%AFTECo,3) - DO i2 = LBOUND(OutData%AFTECo,2), UBOUND(OutData%AFTECo,2) - DO i1 = LBOUND(OutData%AFTECo,1), UBOUND(OutData%AFTECo,1) - OutData%AFTECo(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlSpn not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlSpn)) DEALLOCATE(OutData%BlSpn) - ALLOCATE(OutData%BlSpn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DstParamData%AFTECo = SrcParamData%AFTECo +ENDIF +IF (ALLOCATED(SrcParamData%BlSpn)) THEN + i1_l = LBOUND(SrcParamData%BlSpn,1) + i1_u = UBOUND(SrcParamData%BlSpn,1) + i2_l = LBOUND(SrcParamData%BlSpn,2) + i2_u = UBOUND(SrcParamData%BlSpn,2) + IF (.NOT. ALLOCATED(DstParamData%BlSpn)) THEN + ALLOCATE(DstParamData%BlSpn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlSpn.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlSpn.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i2 = LBOUND(OutData%BlSpn,2), UBOUND(OutData%BlSpn,2) - DO i1 = LBOUND(OutData%BlSpn,1), UBOUND(OutData%BlSpn,1) - OutData%BlSpn(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlChord not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlChord)) DEALLOCATE(OutData%BlChord) - ALLOCATE(OutData%BlChord(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DstParamData%BlSpn = SrcParamData%BlSpn +ENDIF +IF (ALLOCATED(SrcParamData%BlChord)) THEN + i1_l = LBOUND(SrcParamData%BlChord,1) + i1_u = UBOUND(SrcParamData%BlChord,1) + i2_l = LBOUND(SrcParamData%BlChord,2) + i2_u = UBOUND(SrcParamData%BlChord,2) + IF (.NOT. ALLOCATED(DstParamData%BlChord)) THEN + ALLOCATE(DstParamData%BlChord(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlChord.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlChord.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i2 = LBOUND(OutData%BlChord,2), UBOUND(OutData%BlChord,2) - DO i1 = LBOUND(OutData%BlChord,1), UBOUND(OutData%BlChord,1) - OutData%BlChord(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ReListBL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ReListBL)) DEALLOCATE(OutData%ReListBL) - ALLOCATE(OutData%ReListBL(i1_l:i1_u),STAT=ErrStat2) + DstParamData%BlChord = SrcParamData%BlChord +ENDIF +IF (ALLOCATED(SrcParamData%ReListBL)) THEN + i1_l = LBOUND(SrcParamData%ReListBL,1) + i1_u = UBOUND(SrcParamData%ReListBL,1) + IF (.NOT. ALLOCATED(DstParamData%ReListBL)) THEN + ALLOCATE(DstParamData%ReListBL(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ReListBL.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ReListBL.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%ReListBL,1), UBOUND(OutData%ReListBL,1) - OutData%ReListBL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AOAListBL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AOAListBL)) DEALLOCATE(OutData%AOAListBL) - ALLOCATE(OutData%AOAListBL(i1_l:i1_u),STAT=ErrStat2) + DstParamData%ReListBL = SrcParamData%ReListBL +ENDIF +IF (ALLOCATED(SrcParamData%AOAListBL)) THEN + i1_l = LBOUND(SrcParamData%AOAListBL,1) + i1_u = UBOUND(SrcParamData%AOAListBL,1) + IF (.NOT. ALLOCATED(DstParamData%AOAListBL)) THEN + ALLOCATE(DstParamData%AOAListBL(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AOAListBL.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AOAListBL.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%AOAListBL,1), UBOUND(OutData%AOAListBL,1) - OutData%AOAListBL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dStarAll1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%dStarAll1)) DEALLOCATE(OutData%dStarAll1) - ALLOCATE(OutData%dStarAll1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + DstParamData%AOAListBL = SrcParamData%AOAListBL +ENDIF +IF (ALLOCATED(SrcParamData%dStarAll1)) THEN + i1_l = LBOUND(SrcParamData%dStarAll1,1) + i1_u = UBOUND(SrcParamData%dStarAll1,1) + i2_l = LBOUND(SrcParamData%dStarAll1,2) + i2_u = UBOUND(SrcParamData%dStarAll1,2) + i3_l = LBOUND(SrcParamData%dStarAll1,3) + i3_u = UBOUND(SrcParamData%dStarAll1,3) + IF (.NOT. ALLOCATED(DstParamData%dStarAll1)) THEN + ALLOCATE(DstParamData%dStarAll1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dStarAll1.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dStarAll1.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i3 = LBOUND(OutData%dStarAll1,3), UBOUND(OutData%dStarAll1,3) - DO i2 = LBOUND(OutData%dStarAll1,2), UBOUND(OutData%dStarAll1,2) - DO i1 = LBOUND(OutData%dStarAll1,1), UBOUND(OutData%dStarAll1,1) - OutData%dStarAll1(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dStarAll2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%dStarAll2)) DEALLOCATE(OutData%dStarAll2) - ALLOCATE(OutData%dStarAll2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + DstParamData%dStarAll1 = SrcParamData%dStarAll1 +ENDIF +IF (ALLOCATED(SrcParamData%dStarAll2)) THEN + i1_l = LBOUND(SrcParamData%dStarAll2,1) + i1_u = UBOUND(SrcParamData%dStarAll2,1) + i2_l = LBOUND(SrcParamData%dStarAll2,2) + i2_u = UBOUND(SrcParamData%dStarAll2,2) + i3_l = LBOUND(SrcParamData%dStarAll2,3) + i3_u = UBOUND(SrcParamData%dStarAll2,3) + IF (.NOT. ALLOCATED(DstParamData%dStarAll2)) THEN + ALLOCATE(DstParamData%dStarAll2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dStarAll2.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dStarAll2.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i3 = LBOUND(OutData%dStarAll2,3), UBOUND(OutData%dStarAll2,3) - DO i2 = LBOUND(OutData%dStarAll2,2), UBOUND(OutData%dStarAll2,2) - DO i1 = LBOUND(OutData%dStarAll2,1), UBOUND(OutData%dStarAll2,1) - OutData%dStarAll2(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! d99All1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%d99All1)) DEALLOCATE(OutData%d99All1) - ALLOCATE(OutData%d99All1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + DstParamData%dStarAll2 = SrcParamData%dStarAll2 +ENDIF +IF (ALLOCATED(SrcParamData%d99All1)) THEN + i1_l = LBOUND(SrcParamData%d99All1,1) + i1_u = UBOUND(SrcParamData%d99All1,1) + i2_l = LBOUND(SrcParamData%d99All1,2) + i2_u = UBOUND(SrcParamData%d99All1,2) + i3_l = LBOUND(SrcParamData%d99All1,3) + i3_u = UBOUND(SrcParamData%d99All1,3) + IF (.NOT. ALLOCATED(DstParamData%d99All1)) THEN + ALLOCATE(DstParamData%d99All1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%d99All1.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%d99All1.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i3 = LBOUND(OutData%d99All1,3), UBOUND(OutData%d99All1,3) - DO i2 = LBOUND(OutData%d99All1,2), UBOUND(OutData%d99All1,2) - DO i1 = LBOUND(OutData%d99All1,1), UBOUND(OutData%d99All1,1) - OutData%d99All1(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! d99All2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%d99All2)) DEALLOCATE(OutData%d99All2) - ALLOCATE(OutData%d99All2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + DstParamData%d99All1 = SrcParamData%d99All1 +ENDIF +IF (ALLOCATED(SrcParamData%d99All2)) THEN + i1_l = LBOUND(SrcParamData%d99All2,1) + i1_u = UBOUND(SrcParamData%d99All2,1) + i2_l = LBOUND(SrcParamData%d99All2,2) + i2_u = UBOUND(SrcParamData%d99All2,2) + i3_l = LBOUND(SrcParamData%d99All2,3) + i3_u = UBOUND(SrcParamData%d99All2,3) + IF (.NOT. ALLOCATED(DstParamData%d99All2)) THEN + ALLOCATE(DstParamData%d99All2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%d99All2.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%d99All2.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i3 = LBOUND(OutData%d99All2,3), UBOUND(OutData%d99All2,3) - DO i2 = LBOUND(OutData%d99All2,2), UBOUND(OutData%d99All2,2) - DO i1 = LBOUND(OutData%d99All2,1), UBOUND(OutData%d99All2,1) - OutData%d99All2(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CfAll1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CfAll1)) DEALLOCATE(OutData%CfAll1) - ALLOCATE(OutData%CfAll1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + DstParamData%d99All2 = SrcParamData%d99All2 +ENDIF +IF (ALLOCATED(SrcParamData%CfAll1)) THEN + i1_l = LBOUND(SrcParamData%CfAll1,1) + i1_u = UBOUND(SrcParamData%CfAll1,1) + i2_l = LBOUND(SrcParamData%CfAll1,2) + i2_u = UBOUND(SrcParamData%CfAll1,2) + i3_l = LBOUND(SrcParamData%CfAll1,3) + i3_u = UBOUND(SrcParamData%CfAll1,3) + IF (.NOT. ALLOCATED(DstParamData%CfAll1)) THEN + ALLOCATE(DstParamData%CfAll1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CfAll1.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CfAll1.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i3 = LBOUND(OutData%CfAll1,3), UBOUND(OutData%CfAll1,3) - DO i2 = LBOUND(OutData%CfAll1,2), UBOUND(OutData%CfAll1,2) - DO i1 = LBOUND(OutData%CfAll1,1), UBOUND(OutData%CfAll1,1) - OutData%CfAll1(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CfAll2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CfAll2)) DEALLOCATE(OutData%CfAll2) - ALLOCATE(OutData%CfAll2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + DstParamData%CfAll1 = SrcParamData%CfAll1 +ENDIF +IF (ALLOCATED(SrcParamData%CfAll2)) THEN + i1_l = LBOUND(SrcParamData%CfAll2,1) + i1_u = UBOUND(SrcParamData%CfAll2,1) + i2_l = LBOUND(SrcParamData%CfAll2,2) + i2_u = UBOUND(SrcParamData%CfAll2,2) + i3_l = LBOUND(SrcParamData%CfAll2,3) + i3_u = UBOUND(SrcParamData%CfAll2,3) + IF (.NOT. ALLOCATED(DstParamData%CfAll2)) THEN + ALLOCATE(DstParamData%CfAll2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CfAll2.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CfAll2.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i3 = LBOUND(OutData%CfAll2,3), UBOUND(OutData%CfAll2,3) - DO i2 = LBOUND(OutData%CfAll2,2), UBOUND(OutData%CfAll2,2) - DO i1 = LBOUND(OutData%CfAll2,1), UBOUND(OutData%CfAll2,1) - OutData%CfAll2(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! EdgeVelRat1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%EdgeVelRat1)) DEALLOCATE(OutData%EdgeVelRat1) - ALLOCATE(OutData%EdgeVelRat1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + DstParamData%CfAll2 = SrcParamData%CfAll2 +ENDIF +IF (ALLOCATED(SrcParamData%EdgeVelRat1)) THEN + i1_l = LBOUND(SrcParamData%EdgeVelRat1,1) + i1_u = UBOUND(SrcParamData%EdgeVelRat1,1) + i2_l = LBOUND(SrcParamData%EdgeVelRat1,2) + i2_u = UBOUND(SrcParamData%EdgeVelRat1,2) + i3_l = LBOUND(SrcParamData%EdgeVelRat1,3) + i3_u = UBOUND(SrcParamData%EdgeVelRat1,3) + IF (.NOT. ALLOCATED(DstParamData%EdgeVelRat1)) THEN + ALLOCATE(DstParamData%EdgeVelRat1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%EdgeVelRat1.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%EdgeVelRat1.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i3 = LBOUND(OutData%EdgeVelRat1,3), UBOUND(OutData%EdgeVelRat1,3) - DO i2 = LBOUND(OutData%EdgeVelRat1,2), UBOUND(OutData%EdgeVelRat1,2) - DO i1 = LBOUND(OutData%EdgeVelRat1,1), UBOUND(OutData%EdgeVelRat1,1) - OutData%EdgeVelRat1(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! EdgeVelRat2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%EdgeVelRat2)) DEALLOCATE(OutData%EdgeVelRat2) - ALLOCATE(OutData%EdgeVelRat2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + DstParamData%EdgeVelRat1 = SrcParamData%EdgeVelRat1 +ENDIF +IF (ALLOCATED(SrcParamData%EdgeVelRat2)) THEN + i1_l = LBOUND(SrcParamData%EdgeVelRat2,1) + i1_u = UBOUND(SrcParamData%EdgeVelRat2,1) + i2_l = LBOUND(SrcParamData%EdgeVelRat2,2) + i2_u = UBOUND(SrcParamData%EdgeVelRat2,2) + i3_l = LBOUND(SrcParamData%EdgeVelRat2,3) + i3_u = UBOUND(SrcParamData%EdgeVelRat2,3) + IF (.NOT. ALLOCATED(DstParamData%EdgeVelRat2)) THEN + ALLOCATE(DstParamData%EdgeVelRat2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%EdgeVelRat2.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%EdgeVelRat2.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i3 = LBOUND(OutData%EdgeVelRat2,3), UBOUND(OutData%EdgeVelRat2,3) - DO i2 = LBOUND(OutData%EdgeVelRat2,2), UBOUND(OutData%EdgeVelRat2,2) - DO i1 = LBOUND(OutData%EdgeVelRat2,1), UBOUND(OutData%EdgeVelRat2,1) - OutData%EdgeVelRat2(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFThickGuida not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AFThickGuida)) DEALLOCATE(OutData%AFThickGuida) - ALLOCATE(OutData%AFThickGuida(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DstParamData%EdgeVelRat2 = SrcParamData%EdgeVelRat2 +ENDIF +IF (ALLOCATED(SrcParamData%AFThickGuida)) THEN + i1_l = LBOUND(SrcParamData%AFThickGuida,1) + i1_u = UBOUND(SrcParamData%AFThickGuida,1) + i2_l = LBOUND(SrcParamData%AFThickGuida,2) + i2_u = UBOUND(SrcParamData%AFThickGuida,2) + IF (.NOT. ALLOCATED(DstParamData%AFThickGuida)) THEN + ALLOCATE(DstParamData%AFThickGuida(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFThickGuida.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFThickGuida.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i2 = LBOUND(OutData%AFThickGuida,2), UBOUND(OutData%AFThickGuida,2) - DO i1 = LBOUND(OutData%AFThickGuida,1), UBOUND(OutData%AFThickGuida,1) - OutData%AFThickGuida(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO END IF - END SUBROUTINE AA_UnPackParam + DstParamData%AFThickGuida = SrcParamData%AFThickGuida +ENDIF + END SUBROUTINE AA_CopyParam + + SUBROUTINE AA_DestroyParam( ParamData, ErrStat, ErrMsg ) + TYPE(AA_ParameterType), INTENT(INOUT) :: ParamData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyParam' + + ErrStat = ErrID_None + ErrMsg = "" + +IF (ALLOCATED(ParamData%rotorregionlimitsVert)) THEN + DEALLOCATE(ParamData%rotorregionlimitsVert) +ENDIF +IF (ALLOCATED(ParamData%rotorregionlimitsHorz)) THEN + DEALLOCATE(ParamData%rotorregionlimitsHorz) +ENDIF +IF (ALLOCATED(ParamData%rotorregionlimitsalph)) THEN + DEALLOCATE(ParamData%rotorregionlimitsalph) +ENDIF +IF (ALLOCATED(ParamData%rotorregionlimitsrad)) THEN + DEALLOCATE(ParamData%rotorregionlimitsrad) +ENDIF +IF (ALLOCATED(ParamData%ObsX)) THEN + DEALLOCATE(ParamData%ObsX) +ENDIF +IF (ALLOCATED(ParamData%ObsY)) THEN + DEALLOCATE(ParamData%ObsY) +ENDIF +IF (ALLOCATED(ParamData%ObsZ)) THEN + DEALLOCATE(ParamData%ObsZ) +ENDIF +IF (ALLOCATED(ParamData%FreqList)) THEN + DEALLOCATE(ParamData%FreqList) +ENDIF +IF (ALLOCATED(ParamData%Aweight)) THEN + DEALLOCATE(ParamData%Aweight) +ENDIF +IF (ALLOCATED(ParamData%TI_Grid_In)) THEN + DEALLOCATE(ParamData%TI_Grid_In) +ENDIF +IF (ALLOCATED(ParamData%OutParam)) THEN +DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) + CALL NWTC_Library_DestroyOutParmType( ParamData%OutParam(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(ParamData%OutParam) +ENDIF +IF (ALLOCATED(ParamData%StallStart)) THEN + DEALLOCATE(ParamData%StallStart) +ENDIF +IF (ALLOCATED(ParamData%TEThick)) THEN + DEALLOCATE(ParamData%TEThick) +ENDIF +IF (ALLOCATED(ParamData%TEAngle)) THEN + DEALLOCATE(ParamData%TEAngle) +ENDIF +IF (ALLOCATED(ParamData%AerCent)) THEN + DEALLOCATE(ParamData%AerCent) +ENDIF +IF (ALLOCATED(ParamData%BlAFID)) THEN + DEALLOCATE(ParamData%BlAFID) +ENDIF +IF (ALLOCATED(ParamData%AFInfo)) THEN +DO i1 = LBOUND(ParamData%AFInfo,1), UBOUND(ParamData%AFInfo,1) + CALL AFI_DestroyParam( ParamData%AFInfo(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(ParamData%AFInfo) +ENDIF +IF (ALLOCATED(ParamData%AFLECo)) THEN + DEALLOCATE(ParamData%AFLECo) +ENDIF +IF (ALLOCATED(ParamData%AFTECo)) THEN + DEALLOCATE(ParamData%AFTECo) +ENDIF +IF (ALLOCATED(ParamData%BlSpn)) THEN + DEALLOCATE(ParamData%BlSpn) +ENDIF +IF (ALLOCATED(ParamData%BlChord)) THEN + DEALLOCATE(ParamData%BlChord) +ENDIF +IF (ALLOCATED(ParamData%ReListBL)) THEN + DEALLOCATE(ParamData%ReListBL) +ENDIF +IF (ALLOCATED(ParamData%AOAListBL)) THEN + DEALLOCATE(ParamData%AOAListBL) +ENDIF +IF (ALLOCATED(ParamData%dStarAll1)) THEN + DEALLOCATE(ParamData%dStarAll1) +ENDIF +IF (ALLOCATED(ParamData%dStarAll2)) THEN + DEALLOCATE(ParamData%dStarAll2) +ENDIF +IF (ALLOCATED(ParamData%d99All1)) THEN + DEALLOCATE(ParamData%d99All1) +ENDIF +IF (ALLOCATED(ParamData%d99All2)) THEN + DEALLOCATE(ParamData%d99All2) +ENDIF +IF (ALLOCATED(ParamData%CfAll1)) THEN + DEALLOCATE(ParamData%CfAll1) +ENDIF +IF (ALLOCATED(ParamData%CfAll2)) THEN + DEALLOCATE(ParamData%CfAll2) +ENDIF +IF (ALLOCATED(ParamData%EdgeVelRat1)) THEN + DEALLOCATE(ParamData%EdgeVelRat1) +ENDIF +IF (ALLOCATED(ParamData%EdgeVelRat2)) THEN + DEALLOCATE(ParamData%EdgeVelRat2) +ENDIF +IF (ALLOCATED(ParamData%AFThickGuida)) THEN + DEALLOCATE(ParamData%AFThickGuida) +ENDIF + END SUBROUTINE AA_DestroyParam + +subroutine AA_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AA_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AA_PackParam' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + if (Buf%ErrStat >= AbortErrLev) return + ! DT + call RegPack(Buf, InData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! IBLUNT + call RegPack(Buf, InData%IBLUNT) + if (RegCheckErr(Buf, RoutineName)) return + ! ILAM + call RegPack(Buf, InData%ILAM) + if (RegCheckErr(Buf, RoutineName)) return + ! ITIP + call RegPack(Buf, InData%ITIP) + if (RegCheckErr(Buf, RoutineName)) return + ! ITRIP + call RegPack(Buf, InData%ITRIP) + if (RegCheckErr(Buf, RoutineName)) return + ! ITURB + call RegPack(Buf, InData%ITURB) + if (RegCheckErr(Buf, RoutineName)) return + ! IInflow + call RegPack(Buf, InData%IInflow) + if (RegCheckErr(Buf, RoutineName)) return + ! X_BLMethod + call RegPack(Buf, InData%X_BLMethod) + if (RegCheckErr(Buf, RoutineName)) return + ! TICalcMeth + call RegPack(Buf, InData%TICalcMeth) + if (RegCheckErr(Buf, RoutineName)) return + ! ROUND + call RegPack(Buf, InData%ROUND) + if (RegCheckErr(Buf, RoutineName)) return + ! ALPRAT + call RegPack(Buf, InData%ALPRAT) + if (RegCheckErr(Buf, RoutineName)) return + ! NumBlades + call RegPack(Buf, InData%NumBlades) + if (RegCheckErr(Buf, RoutineName)) return + ! NumBlNds + call RegPack(Buf, InData%NumBlNds) + if (RegCheckErr(Buf, RoutineName)) return + ! AirDens + call RegPack(Buf, InData%AirDens) + if (RegCheckErr(Buf, RoutineName)) return + ! KinVisc + call RegPack(Buf, InData%KinVisc) + if (RegCheckErr(Buf, RoutineName)) return + ! SpdSound + call RegPack(Buf, InData%SpdSound) + if (RegCheckErr(Buf, RoutineName)) return + ! HubHeight + call RegPack(Buf, InData%HubHeight) + if (RegCheckErr(Buf, RoutineName)) return + ! toptip + call RegPack(Buf, InData%toptip) + if (RegCheckErr(Buf, RoutineName)) return + ! bottip + call RegPack(Buf, InData%bottip) + if (RegCheckErr(Buf, RoutineName)) return + ! rotorregionlimitsVert + call RegPack(Buf, allocated(InData%rotorregionlimitsVert)) + if (allocated(InData%rotorregionlimitsVert)) then + call RegPackBounds(Buf, 1, lbound(InData%rotorregionlimitsVert), ubound(InData%rotorregionlimitsVert)) + call RegPack(Buf, InData%rotorregionlimitsVert) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! rotorregionlimitsHorz + call RegPack(Buf, allocated(InData%rotorregionlimitsHorz)) + if (allocated(InData%rotorregionlimitsHorz)) then + call RegPackBounds(Buf, 1, lbound(InData%rotorregionlimitsHorz), ubound(InData%rotorregionlimitsHorz)) + call RegPack(Buf, InData%rotorregionlimitsHorz) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! rotorregionlimitsalph + call RegPack(Buf, allocated(InData%rotorregionlimitsalph)) + if (allocated(InData%rotorregionlimitsalph)) then + call RegPackBounds(Buf, 1, lbound(InData%rotorregionlimitsalph), ubound(InData%rotorregionlimitsalph)) + call RegPack(Buf, InData%rotorregionlimitsalph) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! rotorregionlimitsrad + call RegPack(Buf, allocated(InData%rotorregionlimitsrad)) + if (allocated(InData%rotorregionlimitsrad)) then + call RegPackBounds(Buf, 1, lbound(InData%rotorregionlimitsrad), ubound(InData%rotorregionlimitsrad)) + call RegPack(Buf, InData%rotorregionlimitsrad) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NrObsLoc + call RegPack(Buf, InData%NrObsLoc) + if (RegCheckErr(Buf, RoutineName)) return + ! aweightflag + call RegPack(Buf, InData%aweightflag) + if (RegCheckErr(Buf, RoutineName)) return + ! TxtFileOutput + call RegPack(Buf, InData%TxtFileOutput) + if (RegCheckErr(Buf, RoutineName)) return + ! AAStart + call RegPack(Buf, InData%AAStart) + if (RegCheckErr(Buf, RoutineName)) return + ! ObsX + call RegPack(Buf, allocated(InData%ObsX)) + if (allocated(InData%ObsX)) then + call RegPackBounds(Buf, 1, lbound(InData%ObsX), ubound(InData%ObsX)) + call RegPack(Buf, InData%ObsX) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ObsY + call RegPack(Buf, allocated(InData%ObsY)) + if (allocated(InData%ObsY)) then + call RegPackBounds(Buf, 1, lbound(InData%ObsY), ubound(InData%ObsY)) + call RegPack(Buf, InData%ObsY) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ObsZ + call RegPack(Buf, allocated(InData%ObsZ)) + if (allocated(InData%ObsZ)) then + call RegPackBounds(Buf, 1, lbound(InData%ObsZ), ubound(InData%ObsZ)) + call RegPack(Buf, InData%ObsZ) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FreqList + call RegPack(Buf, allocated(InData%FreqList)) + if (allocated(InData%FreqList)) then + call RegPackBounds(Buf, 1, lbound(InData%FreqList), ubound(InData%FreqList)) + call RegPack(Buf, InData%FreqList) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Aweight + call RegPack(Buf, allocated(InData%Aweight)) + if (allocated(InData%Aweight)) then + call RegPackBounds(Buf, 1, lbound(InData%Aweight), ubound(InData%Aweight)) + call RegPack(Buf, InData%Aweight) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Fsample + call RegPack(Buf, InData%Fsample) + if (RegCheckErr(Buf, RoutineName)) return + ! total_sample + call RegPack(Buf, InData%total_sample) + if (RegCheckErr(Buf, RoutineName)) return + ! total_sampleTI + call RegPack(Buf, InData%total_sampleTI) + if (RegCheckErr(Buf, RoutineName)) return + ! AA_Bl_Prcntge + call RegPack(Buf, InData%AA_Bl_Prcntge) + if (RegCheckErr(Buf, RoutineName)) return + ! startnode + call RegPack(Buf, InData%startnode) + if (RegCheckErr(Buf, RoutineName)) return + ! Lturb + call RegPack(Buf, InData%Lturb) + if (RegCheckErr(Buf, RoutineName)) return + ! AvgV + call RegPack(Buf, InData%AvgV) + if (RegCheckErr(Buf, RoutineName)) return + ! dz_turb_in + call RegPack(Buf, InData%dz_turb_in) + if (RegCheckErr(Buf, RoutineName)) return + ! dy_turb_in + call RegPack(Buf, InData%dy_turb_in) + if (RegCheckErr(Buf, RoutineName)) return + ! TI_Grid_In + call RegPack(Buf, allocated(InData%TI_Grid_In)) + if (allocated(InData%TI_Grid_In)) then + call RegPackBounds(Buf, 2, lbound(InData%TI_Grid_In), ubound(InData%TI_Grid_In)) + call RegPack(Buf, InData%TI_Grid_In) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FTitle + call RegPack(Buf, InData%FTitle) + if (RegCheckErr(Buf, RoutineName)) return + ! outFmt + call RegPack(Buf, InData%outFmt) + if (RegCheckErr(Buf, RoutineName)) return + ! NrOutFile + call RegPack(Buf, InData%NrOutFile) + if (RegCheckErr(Buf, RoutineName)) return + ! delim + call RegPack(Buf, InData%delim) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegPack(Buf, InData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOutsForPE + call RegPack(Buf, InData%NumOutsForPE) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOutsForSep + call RegPack(Buf, InData%NumOutsForSep) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOutsForNodes + call RegPack(Buf, InData%NumOutsForNodes) + if (RegCheckErr(Buf, RoutineName)) return + ! unOutFile + call RegPack(Buf, InData%unOutFile) + if (RegCheckErr(Buf, RoutineName)) return + ! unOutFile2 + call RegPack(Buf, InData%unOutFile2) + if (RegCheckErr(Buf, RoutineName)) return + ! unOutFile3 + call RegPack(Buf, InData%unOutFile3) + if (RegCheckErr(Buf, RoutineName)) return + ! unOutFile4 + call RegPack(Buf, InData%unOutFile4) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegPack(Buf, InData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! OutParam + call RegPack(Buf, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! StallStart + call RegPack(Buf, allocated(InData%StallStart)) + if (allocated(InData%StallStart)) then + call RegPackBounds(Buf, 2, lbound(InData%StallStart), ubound(InData%StallStart)) + call RegPack(Buf, InData%StallStart) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TEThick + call RegPack(Buf, allocated(InData%TEThick)) + if (allocated(InData%TEThick)) then + call RegPackBounds(Buf, 2, lbound(InData%TEThick), ubound(InData%TEThick)) + call RegPack(Buf, InData%TEThick) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TEAngle + call RegPack(Buf, allocated(InData%TEAngle)) + if (allocated(InData%TEAngle)) then + call RegPackBounds(Buf, 2, lbound(InData%TEAngle), ubound(InData%TEAngle)) + call RegPack(Buf, InData%TEAngle) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AerCent + call RegPack(Buf, allocated(InData%AerCent)) + if (allocated(InData%AerCent)) then + call RegPackBounds(Buf, 3, lbound(InData%AerCent), ubound(InData%AerCent)) + call RegPack(Buf, InData%AerCent) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BlAFID + call RegPack(Buf, allocated(InData%BlAFID)) + if (allocated(InData%BlAFID)) then + call RegPackBounds(Buf, 2, lbound(InData%BlAFID), ubound(InData%BlAFID)) + call RegPack(Buf, InData%BlAFID) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AFInfo + call RegPack(Buf, allocated(InData%AFInfo)) + if (allocated(InData%AFInfo)) then + call RegPackBounds(Buf, 1, lbound(InData%AFInfo), ubound(InData%AFInfo)) + LB(1:1) = lbound(InData%AFInfo) + UB(1:1) = ubound(InData%AFInfo) + do i1 = LB(1), UB(1) + call AFI_PackParam(Buf, InData%AFInfo(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AFLECo + call RegPack(Buf, allocated(InData%AFLECo)) + if (allocated(InData%AFLECo)) then + call RegPackBounds(Buf, 3, lbound(InData%AFLECo), ubound(InData%AFLECo)) + call RegPack(Buf, InData%AFLECo) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AFTECo + call RegPack(Buf, allocated(InData%AFTECo)) + if (allocated(InData%AFTECo)) then + call RegPackBounds(Buf, 3, lbound(InData%AFTECo), ubound(InData%AFTECo)) + call RegPack(Buf, InData%AFTECo) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BlSpn + call RegPack(Buf, allocated(InData%BlSpn)) + if (allocated(InData%BlSpn)) then + call RegPackBounds(Buf, 2, lbound(InData%BlSpn), ubound(InData%BlSpn)) + call RegPack(Buf, InData%BlSpn) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BlChord + call RegPack(Buf, allocated(InData%BlChord)) + if (allocated(InData%BlChord)) then + call RegPackBounds(Buf, 2, lbound(InData%BlChord), ubound(InData%BlChord)) + call RegPack(Buf, InData%BlChord) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ReListBL + call RegPack(Buf, allocated(InData%ReListBL)) + if (allocated(InData%ReListBL)) then + call RegPackBounds(Buf, 1, lbound(InData%ReListBL), ubound(InData%ReListBL)) + call RegPack(Buf, InData%ReListBL) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AOAListBL + call RegPack(Buf, allocated(InData%AOAListBL)) + if (allocated(InData%AOAListBL)) then + call RegPackBounds(Buf, 1, lbound(InData%AOAListBL), ubound(InData%AOAListBL)) + call RegPack(Buf, InData%AOAListBL) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! dStarAll1 + call RegPack(Buf, allocated(InData%dStarAll1)) + if (allocated(InData%dStarAll1)) then + call RegPackBounds(Buf, 3, lbound(InData%dStarAll1), ubound(InData%dStarAll1)) + call RegPack(Buf, InData%dStarAll1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! dStarAll2 + call RegPack(Buf, allocated(InData%dStarAll2)) + if (allocated(InData%dStarAll2)) then + call RegPackBounds(Buf, 3, lbound(InData%dStarAll2), ubound(InData%dStarAll2)) + call RegPack(Buf, InData%dStarAll2) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! d99All1 + call RegPack(Buf, allocated(InData%d99All1)) + if (allocated(InData%d99All1)) then + call RegPackBounds(Buf, 3, lbound(InData%d99All1), ubound(InData%d99All1)) + call RegPack(Buf, InData%d99All1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! d99All2 + call RegPack(Buf, allocated(InData%d99All2)) + if (allocated(InData%d99All2)) then + call RegPackBounds(Buf, 3, lbound(InData%d99All2), ubound(InData%d99All2)) + call RegPack(Buf, InData%d99All2) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CfAll1 + call RegPack(Buf, allocated(InData%CfAll1)) + if (allocated(InData%CfAll1)) then + call RegPackBounds(Buf, 3, lbound(InData%CfAll1), ubound(InData%CfAll1)) + call RegPack(Buf, InData%CfAll1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CfAll2 + call RegPack(Buf, allocated(InData%CfAll2)) + if (allocated(InData%CfAll2)) then + call RegPackBounds(Buf, 3, lbound(InData%CfAll2), ubound(InData%CfAll2)) + call RegPack(Buf, InData%CfAll2) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! EdgeVelRat1 + call RegPack(Buf, allocated(InData%EdgeVelRat1)) + if (allocated(InData%EdgeVelRat1)) then + call RegPackBounds(Buf, 3, lbound(InData%EdgeVelRat1), ubound(InData%EdgeVelRat1)) + call RegPack(Buf, InData%EdgeVelRat1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! EdgeVelRat2 + call RegPack(Buf, allocated(InData%EdgeVelRat2)) + if (allocated(InData%EdgeVelRat2)) then + call RegPackBounds(Buf, 3, lbound(InData%EdgeVelRat2), ubound(InData%EdgeVelRat2)) + call RegPack(Buf, InData%EdgeVelRat2) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AFThickGuida + call RegPack(Buf, allocated(InData%AFThickGuida)) + if (allocated(InData%AFThickGuida)) then + call RegPackBounds(Buf, 2, lbound(InData%AFThickGuida), ubound(InData%AFThickGuida)) + call RegPack(Buf, InData%AFThickGuida) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AA_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AA_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AA_UnPackParam' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! DT + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! IBLUNT + call RegUnpack(Buf, OutData%IBLUNT) + if (RegCheckErr(Buf, RoutineName)) return + ! ILAM + call RegUnpack(Buf, OutData%ILAM) + if (RegCheckErr(Buf, RoutineName)) return + ! ITIP + call RegUnpack(Buf, OutData%ITIP) + if (RegCheckErr(Buf, RoutineName)) return + ! ITRIP + call RegUnpack(Buf, OutData%ITRIP) + if (RegCheckErr(Buf, RoutineName)) return + ! ITURB + call RegUnpack(Buf, OutData%ITURB) + if (RegCheckErr(Buf, RoutineName)) return + ! IInflow + call RegUnpack(Buf, OutData%IInflow) + if (RegCheckErr(Buf, RoutineName)) return + ! X_BLMethod + call RegUnpack(Buf, OutData%X_BLMethod) + if (RegCheckErr(Buf, RoutineName)) return + ! TICalcMeth + call RegUnpack(Buf, OutData%TICalcMeth) + if (RegCheckErr(Buf, RoutineName)) return + ! ROUND + call RegUnpack(Buf, OutData%ROUND) + if (RegCheckErr(Buf, RoutineName)) return + ! ALPRAT + call RegUnpack(Buf, OutData%ALPRAT) + if (RegCheckErr(Buf, RoutineName)) return + ! NumBlades + call RegUnpack(Buf, OutData%NumBlades) + if (RegCheckErr(Buf, RoutineName)) return + ! NumBlNds + call RegUnpack(Buf, OutData%NumBlNds) + if (RegCheckErr(Buf, RoutineName)) return + ! AirDens + call RegUnpack(Buf, OutData%AirDens) + if (RegCheckErr(Buf, RoutineName)) return + ! KinVisc + call RegUnpack(Buf, OutData%KinVisc) + if (RegCheckErr(Buf, RoutineName)) return + ! SpdSound + call RegUnpack(Buf, OutData%SpdSound) + if (RegCheckErr(Buf, RoutineName)) return + ! HubHeight + call RegUnpack(Buf, OutData%HubHeight) + if (RegCheckErr(Buf, RoutineName)) return + ! toptip + call RegUnpack(Buf, OutData%toptip) + if (RegCheckErr(Buf, RoutineName)) return + ! bottip + call RegUnpack(Buf, OutData%bottip) + if (RegCheckErr(Buf, RoutineName)) return + ! rotorregionlimitsVert + if (allocated(OutData%rotorregionlimitsVert)) deallocate(OutData%rotorregionlimitsVert) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rotorregionlimitsVert(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotorregionlimitsVert.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rotorregionlimitsVert) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! rotorregionlimitsHorz + if (allocated(OutData%rotorregionlimitsHorz)) deallocate(OutData%rotorregionlimitsHorz) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rotorregionlimitsHorz(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotorregionlimitsHorz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rotorregionlimitsHorz) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! rotorregionlimitsalph + if (allocated(OutData%rotorregionlimitsalph)) deallocate(OutData%rotorregionlimitsalph) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rotorregionlimitsalph(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotorregionlimitsalph.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rotorregionlimitsalph) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! rotorregionlimitsrad + if (allocated(OutData%rotorregionlimitsrad)) deallocate(OutData%rotorregionlimitsrad) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rotorregionlimitsrad(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotorregionlimitsrad.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rotorregionlimitsrad) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NrObsLoc + call RegUnpack(Buf, OutData%NrObsLoc) + if (RegCheckErr(Buf, RoutineName)) return + ! aweightflag + call RegUnpack(Buf, OutData%aweightflag) + if (RegCheckErr(Buf, RoutineName)) return + ! TxtFileOutput + call RegUnpack(Buf, OutData%TxtFileOutput) + if (RegCheckErr(Buf, RoutineName)) return + ! AAStart + call RegUnpack(Buf, OutData%AAStart) + if (RegCheckErr(Buf, RoutineName)) return + ! ObsX + if (allocated(OutData%ObsX)) deallocate(OutData%ObsX) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ObsX(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ObsX) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ObsY + if (allocated(OutData%ObsY)) deallocate(OutData%ObsY) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ObsY(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ObsY) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ObsZ + if (allocated(OutData%ObsZ)) deallocate(OutData%ObsZ) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ObsZ(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsZ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ObsZ) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! FreqList + if (allocated(OutData%FreqList)) deallocate(OutData%FreqList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FreqList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FreqList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FreqList) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Aweight + if (allocated(OutData%Aweight)) deallocate(OutData%Aweight) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Aweight(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Aweight.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Aweight) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Fsample + call RegUnpack(Buf, OutData%Fsample) + if (RegCheckErr(Buf, RoutineName)) return + ! total_sample + call RegUnpack(Buf, OutData%total_sample) + if (RegCheckErr(Buf, RoutineName)) return + ! total_sampleTI + call RegUnpack(Buf, OutData%total_sampleTI) + if (RegCheckErr(Buf, RoutineName)) return + ! AA_Bl_Prcntge + call RegUnpack(Buf, OutData%AA_Bl_Prcntge) + if (RegCheckErr(Buf, RoutineName)) return + ! startnode + call RegUnpack(Buf, OutData%startnode) + if (RegCheckErr(Buf, RoutineName)) return + ! Lturb + call RegUnpack(Buf, OutData%Lturb) + if (RegCheckErr(Buf, RoutineName)) return + ! AvgV + call RegUnpack(Buf, OutData%AvgV) + if (RegCheckErr(Buf, RoutineName)) return + ! dz_turb_in + call RegUnpack(Buf, OutData%dz_turb_in) + if (RegCheckErr(Buf, RoutineName)) return + ! dy_turb_in + call RegUnpack(Buf, OutData%dy_turb_in) + if (RegCheckErr(Buf, RoutineName)) return + ! TI_Grid_In + if (allocated(OutData%TI_Grid_In)) deallocate(OutData%TI_Grid_In) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TI_Grid_In(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI_Grid_In.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TI_Grid_In) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! FTitle + call RegUnpack(Buf, OutData%FTitle) + if (RegCheckErr(Buf, RoutineName)) return + ! outFmt + call RegUnpack(Buf, OutData%outFmt) + if (RegCheckErr(Buf, RoutineName)) return + ! NrOutFile + call RegUnpack(Buf, OutData%NrOutFile) + if (RegCheckErr(Buf, RoutineName)) return + ! delim + call RegUnpack(Buf, OutData%delim) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOutsForPE + call RegUnpack(Buf, OutData%NumOutsForPE) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOutsForSep + call RegUnpack(Buf, OutData%NumOutsForSep) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOutsForNodes + call RegUnpack(Buf, OutData%NumOutsForNodes) + if (RegCheckErr(Buf, RoutineName)) return + ! unOutFile + call RegUnpack(Buf, OutData%unOutFile) + if (RegCheckErr(Buf, RoutineName)) return + ! unOutFile2 + call RegUnpack(Buf, OutData%unOutFile2) + if (RegCheckErr(Buf, RoutineName)) return + ! unOutFile3 + call RegUnpack(Buf, OutData%unOutFile3) + if (RegCheckErr(Buf, RoutineName)) return + ! unOutFile4 + call RegUnpack(Buf, OutData%unOutFile4) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! OutParam + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam + end do + end if + ! StallStart + if (allocated(OutData%StallStart)) deallocate(OutData%StallStart) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StallStart(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StallStart.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StallStart) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TEThick + if (allocated(OutData%TEThick)) deallocate(OutData%TEThick) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TEThick(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TEThick.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TEThick) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TEAngle + if (allocated(OutData%TEAngle)) deallocate(OutData%TEAngle) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TEAngle(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TEAngle.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TEAngle) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AerCent + if (allocated(OutData%AerCent)) deallocate(OutData%AerCent) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AerCent(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AerCent.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AerCent) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BlAFID + if (allocated(OutData%BlAFID)) deallocate(OutData%BlAFID) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlAFID(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlAFID.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlAFID) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AFInfo + if (allocated(OutData%AFInfo)) deallocate(OutData%AFInfo) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AFInfo(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFInfo.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AFI_UnpackParam(Buf, OutData%AFInfo(i1)) ! AFInfo + end do + end if + ! AFLECo + if (allocated(OutData%AFLECo)) deallocate(OutData%AFLECo) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AFLECo(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFLECo.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AFLECo) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AFTECo + if (allocated(OutData%AFTECo)) deallocate(OutData%AFTECo) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AFTECo(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFTECo.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AFTECo) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BlSpn + if (allocated(OutData%BlSpn)) deallocate(OutData%BlSpn) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlSpn(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlSpn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlSpn) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BlChord + if (allocated(OutData%BlChord)) deallocate(OutData%BlChord) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlChord(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlChord.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlChord) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ReListBL + if (allocated(OutData%ReListBL)) deallocate(OutData%ReListBL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ReListBL(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ReListBL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ReListBL) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AOAListBL + if (allocated(OutData%AOAListBL)) deallocate(OutData%AOAListBL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AOAListBL(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AOAListBL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AOAListBL) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! dStarAll1 + if (allocated(OutData%dStarAll1)) deallocate(OutData%dStarAll1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dStarAll1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dStarAll1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dStarAll1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! dStarAll2 + if (allocated(OutData%dStarAll2)) deallocate(OutData%dStarAll2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dStarAll2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dStarAll2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dStarAll2) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! d99All1 + if (allocated(OutData%d99All1)) deallocate(OutData%d99All1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%d99All1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%d99All1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%d99All1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! d99All2 + if (allocated(OutData%d99All2)) deallocate(OutData%d99All2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%d99All2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%d99All2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%d99All2) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CfAll1 + if (allocated(OutData%CfAll1)) deallocate(OutData%CfAll1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CfAll1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CfAll1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CfAll1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CfAll2 + if (allocated(OutData%CfAll2)) deallocate(OutData%CfAll2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CfAll2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CfAll2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CfAll2) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! EdgeVelRat1 + if (allocated(OutData%EdgeVelRat1)) deallocate(OutData%EdgeVelRat1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%EdgeVelRat1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%EdgeVelRat1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%EdgeVelRat1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! EdgeVelRat2 + if (allocated(OutData%EdgeVelRat2)) deallocate(OutData%EdgeVelRat2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%EdgeVelRat2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%EdgeVelRat2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%EdgeVelRat2) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AFThickGuida + if (allocated(OutData%AFThickGuida)) deallocate(OutData%AFThickGuida) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AFThickGuida(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFThickGuida.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AFThickGuida) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE AA_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(AA_InputType), INTENT(IN) :: SrcInputData TYPE(AA_InputType), INTENT(INOUT) :: DstInputData @@ -8508,382 +5120,133 @@ SUBROUTINE AA_DestroyInput( InputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE AA_DestroyInput - SUBROUTINE AA_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AA_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! RotGtoL allocated yes/no - IF ( ALLOCATED(InData%RotGtoL) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! RotGtoL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%RotGtoL) ! RotGtoL - END IF - Int_BufSz = Int_BufSz + 1 ! AeroCent_G allocated yes/no - IF ( ALLOCATED(InData%AeroCent_G) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AeroCent_G upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AeroCent_G) ! AeroCent_G - END IF - Int_BufSz = Int_BufSz + 1 ! Vrel allocated yes/no - IF ( ALLOCATED(InData%Vrel) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vrel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vrel) ! Vrel - END IF - Int_BufSz = Int_BufSz + 1 ! AoANoise allocated yes/no - IF ( ALLOCATED(InData%AoANoise) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AoANoise upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AoANoise) ! AoANoise - END IF - Int_BufSz = Int_BufSz + 1 ! Inflow allocated yes/no - IF ( ALLOCATED(InData%Inflow) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Inflow upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Inflow) ! Inflow - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%RotGtoL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotGtoL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotGtoL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotGtoL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotGtoL,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotGtoL,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotGtoL,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotGtoL,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotGtoL,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%RotGtoL,4), UBOUND(InData%RotGtoL,4) - DO i3 = LBOUND(InData%RotGtoL,3), UBOUND(InData%RotGtoL,3) - DO i2 = LBOUND(InData%RotGtoL,2), UBOUND(InData%RotGtoL,2) - DO i1 = LBOUND(InData%RotGtoL,1), UBOUND(InData%RotGtoL,1) - ReKiBuf(Re_Xferred) = InData%RotGtoL(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AeroCent_G) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AeroCent_G,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AeroCent_G,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AeroCent_G,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AeroCent_G,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AeroCent_G,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AeroCent_G,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AeroCent_G,3), UBOUND(InData%AeroCent_G,3) - DO i2 = LBOUND(InData%AeroCent_G,2), UBOUND(InData%AeroCent_G,2) - DO i1 = LBOUND(InData%AeroCent_G,1), UBOUND(InData%AeroCent_G,1) - ReKiBuf(Re_Xferred) = InData%AeroCent_G(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vrel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vrel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vrel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vrel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vrel,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vrel,2), UBOUND(InData%Vrel,2) - DO i1 = LBOUND(InData%Vrel,1), UBOUND(InData%Vrel,1) - ReKiBuf(Re_Xferred) = InData%Vrel(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AoANoise) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AoANoise,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AoANoise,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AoANoise,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AoANoise,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AoANoise,2), UBOUND(InData%AoANoise,2) - DO i1 = LBOUND(InData%AoANoise,1), UBOUND(InData%AoANoise,1) - ReKiBuf(Re_Xferred) = InData%AoANoise(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Inflow) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Inflow,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Inflow,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Inflow,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Inflow,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Inflow,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Inflow,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Inflow,3), UBOUND(InData%Inflow,3) - DO i2 = LBOUND(InData%Inflow,2), UBOUND(InData%Inflow,2) - DO i1 = LBOUND(InData%Inflow,1), UBOUND(InData%Inflow,1) - ReKiBuf(Re_Xferred) = InData%Inflow(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE AA_PackInput - - SUBROUTINE AA_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AA_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotGtoL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RotGtoL)) DEALLOCATE(OutData%RotGtoL) - ALLOCATE(OutData%RotGtoL(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotGtoL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%RotGtoL,4), UBOUND(OutData%RotGtoL,4) - DO i3 = LBOUND(OutData%RotGtoL,3), UBOUND(OutData%RotGtoL,3) - DO i2 = LBOUND(OutData%RotGtoL,2), UBOUND(OutData%RotGtoL,2) - DO i1 = LBOUND(OutData%RotGtoL,1), UBOUND(OutData%RotGtoL,1) - OutData%RotGtoL(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AeroCent_G not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AeroCent_G)) DEALLOCATE(OutData%AeroCent_G) - ALLOCATE(OutData%AeroCent_G(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AeroCent_G.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AeroCent_G,3), UBOUND(OutData%AeroCent_G,3) - DO i2 = LBOUND(OutData%AeroCent_G,2), UBOUND(OutData%AeroCent_G,2) - DO i1 = LBOUND(OutData%AeroCent_G,1), UBOUND(OutData%AeroCent_G,1) - OutData%AeroCent_G(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vrel not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vrel)) DEALLOCATE(OutData%Vrel) - ALLOCATE(OutData%Vrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vrel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vrel,2), UBOUND(OutData%Vrel,2) - DO i1 = LBOUND(OutData%Vrel,1), UBOUND(OutData%Vrel,1) - OutData%Vrel(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AoANoise not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AoANoise)) DEALLOCATE(OutData%AoANoise) - ALLOCATE(OutData%AoANoise(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AoANoise.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AoANoise,2), UBOUND(OutData%AoANoise,2) - DO i1 = LBOUND(OutData%AoANoise,1), UBOUND(OutData%AoANoise,1) - OutData%AoANoise(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Inflow not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Inflow)) DEALLOCATE(OutData%Inflow) - ALLOCATE(OutData%Inflow(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Inflow.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Inflow,3), UBOUND(OutData%Inflow,3) - DO i2 = LBOUND(OutData%Inflow,2), UBOUND(OutData%Inflow,2) - DO i1 = LBOUND(OutData%Inflow,1), UBOUND(OutData%Inflow,1) - OutData%Inflow(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE AA_UnPackInput +subroutine AA_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AA_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AA_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + ! RotGtoL + call RegPack(Buf, allocated(InData%RotGtoL)) + if (allocated(InData%RotGtoL)) then + call RegPackBounds(Buf, 4, lbound(InData%RotGtoL), ubound(InData%RotGtoL)) + call RegPack(Buf, InData%RotGtoL) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AeroCent_G + call RegPack(Buf, allocated(InData%AeroCent_G)) + if (allocated(InData%AeroCent_G)) then + call RegPackBounds(Buf, 3, lbound(InData%AeroCent_G), ubound(InData%AeroCent_G)) + call RegPack(Buf, InData%AeroCent_G) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Vrel + call RegPack(Buf, allocated(InData%Vrel)) + if (allocated(InData%Vrel)) then + call RegPackBounds(Buf, 2, lbound(InData%Vrel), ubound(InData%Vrel)) + call RegPack(Buf, InData%Vrel) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AoANoise + call RegPack(Buf, allocated(InData%AoANoise)) + if (allocated(InData%AoANoise)) then + call RegPackBounds(Buf, 2, lbound(InData%AoANoise), ubound(InData%AoANoise)) + call RegPack(Buf, InData%AoANoise) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Inflow + call RegPack(Buf, allocated(InData%Inflow)) + if (allocated(InData%Inflow)) then + call RegPackBounds(Buf, 3, lbound(InData%Inflow), ubound(InData%Inflow)) + call RegPack(Buf, InData%Inflow) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AA_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AA_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AA_UnPackInput' + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! RotGtoL + if (allocated(OutData%RotGtoL)) deallocate(OutData%RotGtoL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotGtoL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotGtoL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotGtoL) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AeroCent_G + if (allocated(OutData%AeroCent_G)) deallocate(OutData%AeroCent_G) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AeroCent_G(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AeroCent_G.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AeroCent_G) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Vrel + if (allocated(OutData%Vrel)) deallocate(OutData%Vrel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vrel(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vrel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vrel) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AoANoise + if (allocated(OutData%AoANoise)) deallocate(OutData%AoANoise) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AoANoise(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AoANoise.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AoANoise) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Inflow + if (allocated(OutData%Inflow)) deallocate(OutData%Inflow) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Inflow(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Inflow.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Inflow) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE AA_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(AA_OutputType), INTENT(IN) :: SrcOutputData TYPE(AA_OutputType), INTENT(INOUT) :: DstOutputData @@ -9110,649 +5473,264 @@ SUBROUTINE AA_DestroyOutput( OutputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE AA_DestroyOutput - SUBROUTINE AA_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AA_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! SumSpecNoise allocated yes/no - IF ( ALLOCATED(InData%SumSpecNoise) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! SumSpecNoise upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SumSpecNoise) ! SumSpecNoise - END IF - Int_BufSz = Int_BufSz + 1 ! SumSpecNoiseSep allocated yes/no - IF ( ALLOCATED(InData%SumSpecNoiseSep) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! SumSpecNoiseSep upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SumSpecNoiseSep) ! SumSpecNoiseSep - END IF - Int_BufSz = Int_BufSz + 1 ! OASPL allocated yes/no - IF ( ALLOCATED(InData%OASPL) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! OASPL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OASPL) ! OASPL - END IF - Int_BufSz = Int_BufSz + 1 ! OASPL_Mech allocated yes/no - IF ( ALLOCATED(InData%OASPL_Mech) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! OASPL_Mech upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OASPL_Mech) ! OASPL_Mech - END IF - Int_BufSz = Int_BufSz + 1 ! DirectiviOutput allocated yes/no - IF ( ALLOCATED(InData%DirectiviOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DirectiviOutput upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DirectiviOutput) ! DirectiviOutput - END IF - Int_BufSz = Int_BufSz + 1 ! OutLECoords allocated yes/no - IF ( ALLOCATED(InData%OutLECoords) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! OutLECoords upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OutLECoords) ! OutLECoords - END IF - Int_BufSz = Int_BufSz + 1 ! PtotalFreq allocated yes/no - IF ( ALLOCATED(InData%PtotalFreq) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PtotalFreq upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtotalFreq) ! PtotalFreq - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputForPE allocated yes/no - IF ( ALLOCATED(InData%WriteOutputForPE) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputForPE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WriteOutputForPE) ! WriteOutputForPE - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutput allocated yes/no - IF ( ALLOCATED(InData%WriteOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutput upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WriteOutput) ! WriteOutput - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputSep allocated yes/no - IF ( ALLOCATED(InData%WriteOutputSep) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputSep upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WriteOutputSep) ! WriteOutputSep - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputNode allocated yes/no - IF ( ALLOCATED(InData%WriteOutputNode) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputNode upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WriteOutputNode) ! WriteOutputNode - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%SumSpecNoise) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SumSpecNoise,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SumSpecNoise,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SumSpecNoise,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SumSpecNoise,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SumSpecNoise,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SumSpecNoise,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%SumSpecNoise,3), UBOUND(InData%SumSpecNoise,3) - DO i2 = LBOUND(InData%SumSpecNoise,2), UBOUND(InData%SumSpecNoise,2) - DO i1 = LBOUND(InData%SumSpecNoise,1), UBOUND(InData%SumSpecNoise,1) - ReKiBuf(Re_Xferred) = InData%SumSpecNoise(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SumSpecNoiseSep) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SumSpecNoiseSep,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SumSpecNoiseSep,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SumSpecNoiseSep,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SumSpecNoiseSep,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SumSpecNoiseSep,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SumSpecNoiseSep,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%SumSpecNoiseSep,3), UBOUND(InData%SumSpecNoiseSep,3) - DO i2 = LBOUND(InData%SumSpecNoiseSep,2), UBOUND(InData%SumSpecNoiseSep,2) - DO i1 = LBOUND(InData%SumSpecNoiseSep,1), UBOUND(InData%SumSpecNoiseSep,1) - ReKiBuf(Re_Xferred) = InData%SumSpecNoiseSep(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OASPL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OASPL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OASPL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OASPL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OASPL,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OASPL,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OASPL,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%OASPL,3), UBOUND(InData%OASPL,3) - DO i2 = LBOUND(InData%OASPL,2), UBOUND(InData%OASPL,2) - DO i1 = LBOUND(InData%OASPL,1), UBOUND(InData%OASPL,1) - ReKiBuf(Re_Xferred) = InData%OASPL(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OASPL_Mech) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OASPL_Mech,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OASPL_Mech,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OASPL_Mech,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OASPL_Mech,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OASPL_Mech,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OASPL_Mech,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OASPL_Mech,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OASPL_Mech,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%OASPL_Mech,4), UBOUND(InData%OASPL_Mech,4) - DO i3 = LBOUND(InData%OASPL_Mech,3), UBOUND(InData%OASPL_Mech,3) - DO i2 = LBOUND(InData%OASPL_Mech,2), UBOUND(InData%OASPL_Mech,2) - DO i1 = LBOUND(InData%OASPL_Mech,1), UBOUND(InData%OASPL_Mech,1) - ReKiBuf(Re_Xferred) = InData%OASPL_Mech(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DirectiviOutput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DirectiviOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DirectiviOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DirectiviOutput,1), UBOUND(InData%DirectiviOutput,1) - ReKiBuf(Re_Xferred) = InData%DirectiviOutput(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OutLECoords) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutLECoords,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutLECoords,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutLECoords,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutLECoords,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutLECoords,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutLECoords,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutLECoords,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutLECoords,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%OutLECoords,4), UBOUND(InData%OutLECoords,4) - DO i3 = LBOUND(InData%OutLECoords,3), UBOUND(InData%OutLECoords,3) - DO i2 = LBOUND(InData%OutLECoords,2), UBOUND(InData%OutLECoords,2) - DO i1 = LBOUND(InData%OutLECoords,1), UBOUND(InData%OutLECoords,1) - ReKiBuf(Re_Xferred) = InData%OutLECoords(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PtotalFreq) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtotalFreq,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtotalFreq,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtotalFreq,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtotalFreq,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PtotalFreq,2), UBOUND(InData%PtotalFreq,2) - DO i1 = LBOUND(InData%PtotalFreq,1), UBOUND(InData%PtotalFreq,1) - ReKiBuf(Re_Xferred) = InData%PtotalFreq(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputForPE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputForPE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputForPE,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputForPE,1), UBOUND(InData%WriteOutputForPE,1) - ReKiBuf(Re_Xferred) = InData%WriteOutputForPE(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) - ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputSep) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputSep,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputSep,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputSep,1), UBOUND(InData%WriteOutputSep,1) - ReKiBuf(Re_Xferred) = InData%WriteOutputSep(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputNode) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputNode,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputNode,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputNode,1), UBOUND(InData%WriteOutputNode,1) - ReKiBuf(Re_Xferred) = InData%WriteOutputNode(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AA_PackOutput - - SUBROUTINE AA_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AA_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SumSpecNoise not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SumSpecNoise)) DEALLOCATE(OutData%SumSpecNoise) - ALLOCATE(OutData%SumSpecNoise(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SumSpecNoise.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%SumSpecNoise,3), UBOUND(OutData%SumSpecNoise,3) - DO i2 = LBOUND(OutData%SumSpecNoise,2), UBOUND(OutData%SumSpecNoise,2) - DO i1 = LBOUND(OutData%SumSpecNoise,1), UBOUND(OutData%SumSpecNoise,1) - OutData%SumSpecNoise(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SumSpecNoiseSep not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SumSpecNoiseSep)) DEALLOCATE(OutData%SumSpecNoiseSep) - ALLOCATE(OutData%SumSpecNoiseSep(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SumSpecNoiseSep.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%SumSpecNoiseSep,3), UBOUND(OutData%SumSpecNoiseSep,3) - DO i2 = LBOUND(OutData%SumSpecNoiseSep,2), UBOUND(OutData%SumSpecNoiseSep,2) - DO i1 = LBOUND(OutData%SumSpecNoiseSep,1), UBOUND(OutData%SumSpecNoiseSep,1) - OutData%SumSpecNoiseSep(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OASPL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OASPL)) DEALLOCATE(OutData%OASPL) - ALLOCATE(OutData%OASPL(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OASPL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%OASPL,3), UBOUND(OutData%OASPL,3) - DO i2 = LBOUND(OutData%OASPL,2), UBOUND(OutData%OASPL,2) - DO i1 = LBOUND(OutData%OASPL,1), UBOUND(OutData%OASPL,1) - OutData%OASPL(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OASPL_Mech not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OASPL_Mech)) DEALLOCATE(OutData%OASPL_Mech) - ALLOCATE(OutData%OASPL_Mech(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OASPL_Mech.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%OASPL_Mech,4), UBOUND(OutData%OASPL_Mech,4) - DO i3 = LBOUND(OutData%OASPL_Mech,3), UBOUND(OutData%OASPL_Mech,3) - DO i2 = LBOUND(OutData%OASPL_Mech,2), UBOUND(OutData%OASPL_Mech,2) - DO i1 = LBOUND(OutData%OASPL_Mech,1), UBOUND(OutData%OASPL_Mech,1) - OutData%OASPL_Mech(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DirectiviOutput not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DirectiviOutput)) DEALLOCATE(OutData%DirectiviOutput) - ALLOCATE(OutData%DirectiviOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DirectiviOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DirectiviOutput,1), UBOUND(OutData%DirectiviOutput,1) - OutData%DirectiviOutput(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutLECoords not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutLECoords)) DEALLOCATE(OutData%OutLECoords) - ALLOCATE(OutData%OutLECoords(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutLECoords.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%OutLECoords,4), UBOUND(OutData%OutLECoords,4) - DO i3 = LBOUND(OutData%OutLECoords,3), UBOUND(OutData%OutLECoords,3) - DO i2 = LBOUND(OutData%OutLECoords,2), UBOUND(OutData%OutLECoords,2) - DO i1 = LBOUND(OutData%OutLECoords,1), UBOUND(OutData%OutLECoords,1) - OutData%OutLECoords(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtotalFreq not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PtotalFreq)) DEALLOCATE(OutData%PtotalFreq) - ALLOCATE(OutData%PtotalFreq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtotalFreq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PtotalFreq,2), UBOUND(OutData%PtotalFreq,2) - DO i1 = LBOUND(OutData%PtotalFreq,1), UBOUND(OutData%PtotalFreq,1) - OutData%PtotalFreq(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputForPE not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputForPE)) DEALLOCATE(OutData%WriteOutputForPE) - ALLOCATE(OutData%WriteOutputForPE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputForPE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputForPE,1), UBOUND(OutData%WriteOutputForPE,1) - OutData%WriteOutputForPE(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutput)) DEALLOCATE(OutData%WriteOutput) - ALLOCATE(OutData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) - OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputSep not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputSep)) DEALLOCATE(OutData%WriteOutputSep) - ALLOCATE(OutData%WriteOutputSep(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputSep.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputSep,1), UBOUND(OutData%WriteOutputSep,1) - OutData%WriteOutputSep(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputNode not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputNode)) DEALLOCATE(OutData%WriteOutputNode) - ALLOCATE(OutData%WriteOutputNode(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputNode.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputNode,1), UBOUND(OutData%WriteOutputNode,1) - OutData%WriteOutputNode(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AA_UnPackOutput +subroutine AA_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AA_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AA_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! SumSpecNoise + call RegPack(Buf, allocated(InData%SumSpecNoise)) + if (allocated(InData%SumSpecNoise)) then + call RegPackBounds(Buf, 3, lbound(InData%SumSpecNoise), ubound(InData%SumSpecNoise)) + call RegPack(Buf, InData%SumSpecNoise) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SumSpecNoiseSep + call RegPack(Buf, allocated(InData%SumSpecNoiseSep)) + if (allocated(InData%SumSpecNoiseSep)) then + call RegPackBounds(Buf, 3, lbound(InData%SumSpecNoiseSep), ubound(InData%SumSpecNoiseSep)) + call RegPack(Buf, InData%SumSpecNoiseSep) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OASPL + call RegPack(Buf, allocated(InData%OASPL)) + if (allocated(InData%OASPL)) then + call RegPackBounds(Buf, 3, lbound(InData%OASPL), ubound(InData%OASPL)) + call RegPack(Buf, InData%OASPL) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OASPL_Mech + call RegPack(Buf, allocated(InData%OASPL_Mech)) + if (allocated(InData%OASPL_Mech)) then + call RegPackBounds(Buf, 4, lbound(InData%OASPL_Mech), ubound(InData%OASPL_Mech)) + call RegPack(Buf, InData%OASPL_Mech) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DirectiviOutput + call RegPack(Buf, allocated(InData%DirectiviOutput)) + if (allocated(InData%DirectiviOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%DirectiviOutput), ubound(InData%DirectiviOutput)) + call RegPack(Buf, InData%DirectiviOutput) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OutLECoords + call RegPack(Buf, allocated(InData%OutLECoords)) + if (allocated(InData%OutLECoords)) then + call RegPackBounds(Buf, 4, lbound(InData%OutLECoords), ubound(InData%OutLECoords)) + call RegPack(Buf, InData%OutLECoords) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PtotalFreq + call RegPack(Buf, allocated(InData%PtotalFreq)) + if (allocated(InData%PtotalFreq)) then + call RegPackBounds(Buf, 2, lbound(InData%PtotalFreq), ubound(InData%PtotalFreq)) + call RegPack(Buf, InData%PtotalFreq) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutputForPE + call RegPack(Buf, allocated(InData%WriteOutputForPE)) + if (allocated(InData%WriteOutputForPE)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputForPE), ubound(InData%WriteOutputForPE)) + call RegPack(Buf, InData%WriteOutputForPE) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutput + call RegPack(Buf, allocated(InData%WriteOutput)) + if (allocated(InData%WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPack(Buf, InData%WriteOutput) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutputSep + call RegPack(Buf, allocated(InData%WriteOutputSep)) + if (allocated(InData%WriteOutputSep)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputSep), ubound(InData%WriteOutputSep)) + call RegPack(Buf, InData%WriteOutputSep) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutputNode + call RegPack(Buf, allocated(InData%WriteOutputNode)) + if (allocated(InData%WriteOutputNode)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputNode), ubound(InData%WriteOutputNode)) + call RegPack(Buf, InData%WriteOutputNode) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AA_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AA_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AA_UnPackOutput' + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! SumSpecNoise + if (allocated(OutData%SumSpecNoise)) deallocate(OutData%SumSpecNoise) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SumSpecNoise(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SumSpecNoise.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SumSpecNoise) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! SumSpecNoiseSep + if (allocated(OutData%SumSpecNoiseSep)) deallocate(OutData%SumSpecNoiseSep) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SumSpecNoiseSep(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SumSpecNoiseSep.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SumSpecNoiseSep) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! OASPL + if (allocated(OutData%OASPL)) deallocate(OutData%OASPL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OASPL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OASPL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OASPL) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! OASPL_Mech + if (allocated(OutData%OASPL_Mech)) deallocate(OutData%OASPL_Mech) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OASPL_Mech(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OASPL_Mech.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OASPL_Mech) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! DirectiviOutput + if (allocated(OutData%DirectiviOutput)) deallocate(OutData%DirectiviOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DirectiviOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DirectiviOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DirectiviOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! OutLECoords + if (allocated(OutData%OutLECoords)) deallocate(OutData%OutLECoords) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutLECoords(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutLECoords.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutLECoords) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PtotalFreq + if (allocated(OutData%PtotalFreq)) deallocate(OutData%PtotalFreq) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PtotalFreq(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtotalFreq.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PtotalFreq) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WriteOutputForPE + if (allocated(OutData%WriteOutputForPE)) deallocate(OutData%WriteOutputForPE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputForPE(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputForPE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputForPE) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WriteOutput + if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WriteOutputSep + if (allocated(OutData%WriteOutputSep)) deallocate(OutData%WriteOutputSep) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputSep(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputSep.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputSep) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WriteOutputNode + if (allocated(OutData%WriteOutputNode)) deallocate(OutData%WriteOutputNode) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputNode(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputNode.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputNode) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine END MODULE AeroAcoustics_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 index 2982bfff30..22aa1a1a30 100644 --- a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 @@ -240,153 +240,86 @@ SUBROUTINE AD_Dvr_DestroyDvr_Case( Dvr_CaseData, ErrStat, ErrMsg ) 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) :: 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_PackDvr_Case(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Dvr_Case), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_Dvr_PackDvr_Case' + if (Buf%ErrStat >= AbortErrLev) return + ! HWindSpeed + call RegPack(Buf, InData%HWindSpeed) + if (RegCheckErr(Buf, RoutineName)) return + ! PLExp + call RegPack(Buf, InData%PLExp) + if (RegCheckErr(Buf, RoutineName)) return + ! rotSpeed + call RegPack(Buf, InData%rotSpeed) + if (RegCheckErr(Buf, RoutineName)) return + ! bldPitch + call RegPack(Buf, InData%bldPitch) + if (RegCheckErr(Buf, RoutineName)) return + ! nacYaw + call RegPack(Buf, InData%nacYaw) + if (RegCheckErr(Buf, RoutineName)) return + ! tMax + call RegPack(Buf, InData%tMax) + if (RegCheckErr(Buf, RoutineName)) return + ! dT + call RegPack(Buf, InData%dT) + if (RegCheckErr(Buf, RoutineName)) return + ! numSteps + call RegPack(Buf, InData%numSteps) + if (RegCheckErr(Buf, RoutineName)) return + ! DOF + call RegPack(Buf, InData%DOF) + if (RegCheckErr(Buf, RoutineName)) return + ! amplitude + call RegPack(Buf, InData%amplitude) + if (RegCheckErr(Buf, RoutineName)) return + ! frequency + call RegPack(Buf, InData%frequency) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_Dvr_UnPackDvr_Case(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Dvr_Case), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_Dvr_UnPackDvr_Case' + if (Buf%ErrStat /= ErrID_None) return + ! HWindSpeed + call RegUnpack(Buf, OutData%HWindSpeed) + if (RegCheckErr(Buf, RoutineName)) return + ! PLExp + call RegUnpack(Buf, OutData%PLExp) + if (RegCheckErr(Buf, RoutineName)) return + ! rotSpeed + call RegUnpack(Buf, OutData%rotSpeed) + if (RegCheckErr(Buf, RoutineName)) return + ! bldPitch + call RegUnpack(Buf, OutData%bldPitch) + if (RegCheckErr(Buf, RoutineName)) return + ! nacYaw + call RegUnpack(Buf, OutData%nacYaw) + if (RegCheckErr(Buf, RoutineName)) return + ! tMax + call RegUnpack(Buf, OutData%tMax) + if (RegCheckErr(Buf, RoutineName)) return + ! dT + call RegUnpack(Buf, OutData%dT) + if (RegCheckErr(Buf, RoutineName)) return + ! numSteps + call RegUnpack(Buf, OutData%numSteps) + if (RegCheckErr(Buf, RoutineName)) return + ! DOF + call RegUnpack(Buf, OutData%DOF) + if (RegCheckErr(Buf, RoutineName)) return + ! amplitude + call RegUnpack(Buf, OutData%amplitude) + if (RegCheckErr(Buf, RoutineName)) return + ! frequency + call RegUnpack(Buf, OutData%frequency) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE AD_Dvr_CopyDvrVTK_SurfaceType( SrcDvrVTK_SurfaceTypeData, DstDvrVTK_SurfaceTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(DvrVTK_SurfaceType), INTENT(IN) :: SrcDvrVTK_SurfaceTypeData TYPE(DvrVTK_SurfaceType), INTENT(INOUT) :: DstDvrVTK_SurfaceTypeData @@ -423,139 +356,38 @@ SUBROUTINE AD_Dvr_DestroyDvrVTK_SurfaceType( DvrVTK_SurfaceTypeData, ErrStat, Er 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_PackDvrVTK_SurfaceType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DvrVTK_SurfaceType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_Dvr_PackDvrVTK_SurfaceType' + if (Buf%ErrStat >= AbortErrLev) return + ! NumSectors + call RegPack(Buf, InData%NumSectors) + if (RegCheckErr(Buf, RoutineName)) return + ! NacelleBox + call RegPack(Buf, InData%NacelleBox) + if (RegCheckErr(Buf, RoutineName)) return + ! BaseBox + call RegPack(Buf, InData%BaseBox) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_Dvr_UnPackDvrVTK_SurfaceType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DvrVTK_SurfaceType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_Dvr_UnPackDvrVTK_SurfaceType' + if (Buf%ErrStat /= ErrID_None) return + ! NumSectors + call RegUnpack(Buf, OutData%NumSectors) + if (RegCheckErr(Buf, RoutineName)) return + ! NacelleBox + call RegUnpack(Buf, OutData%NacelleBox) + if (RegCheckErr(Buf, RoutineName)) return + ! BaseBox + call RegUnpack(Buf, OutData%BaseBox) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE AD_Dvr_CopyDvr_Outputs( SrcDvr_OutputsData, DstDvr_OutputsData, CtrlCode, ErrStat, ErrMsg ) TYPE(Dvr_Outputs), INTENT(IN) :: SrcDvr_OutputsData TYPE(Dvr_Outputs), INTENT(INOUT) :: DstDvr_OutputsData @@ -715,651 +547,276 @@ SUBROUTINE AD_Dvr_DestroyDvr_Outputs( Dvr_OutputsData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE AD_Dvr_DestroyDvr_Outputs - SUBROUTINE AD_Dvr_PackDvr_Outputs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Dvr_Outputs), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_PackDvr_Outputs' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! AD_ver: size of buffers for each call to pack subtype - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%AD_ver, ErrStat2, ErrMsg2, .TRUE. ) ! AD_ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD_ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD_ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD_ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! unOutFile allocated yes/no - IF ( ALLOCATED(InData%unOutFile) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! unOutFile upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%unOutFile) ! unOutFile - END IF - Int_BufSz = Int_BufSz + 1 ! ActualChanLen - Int_BufSz = Int_BufSz + 1 ! nDvrOutputs - Int_BufSz = Int_BufSz + 1*LEN(InData%Fmt_t) ! Fmt_t - Int_BufSz = Int_BufSz + 1*LEN(InData%Fmt_a) ! Fmt_a - Int_BufSz = Int_BufSz + 1*LEN(InData%delim) ! delim - Int_BufSz = Int_BufSz + 1*LEN(InData%outFmt) ! outFmt - Int_BufSz = Int_BufSz + 1 ! fileFmt - Int_BufSz = Int_BufSz + 1 ! wrVTK - Int_BufSz = Int_BufSz + 1 ! WrVTK_Type - Int_BufSz = Int_BufSz + 1*LEN(InData%Root) ! Root - Int_BufSz = Int_BufSz + 1*LEN(InData%VTK_OutFileRoot) ! VTK_OutFileRoot - Int_BufSz = Int_BufSz + 1 ! WriteOutputHdr allocated yes/no - IF ( ALLOCATED(InData%WriteOutputHdr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdr upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdr)*LEN(InData%WriteOutputHdr) ! WriteOutputHdr - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputUnt allocated yes/no - IF ( ALLOCATED(InData%WriteOutputUnt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUnt upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUnt)*LEN(InData%WriteOutputUnt) ! WriteOutputUnt - END IF - Int_BufSz = Int_BufSz + 1 ! storage allocated yes/no - IF ( ALLOCATED(InData%storage) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! storage upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%storage) ! storage - END IF - Int_BufSz = Int_BufSz + 1 ! outLine allocated yes/no - IF ( ALLOCATED(InData%outLine) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! outLine upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%outLine) ! outLine - END IF - Int_BufSz = Int_BufSz + 1 ! VTK_surface allocated yes/no - IF ( ALLOCATED(InData%VTK_surface) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! VTK_surface upper/lower bounds for each dimension - DO i1 = LBOUND(InData%VTK_surface,1), UBOUND(InData%VTK_surface,1) - Int_BufSz = Int_BufSz + 3 ! VTK_surface: size of buffers for each call to pack subtype - CALL AD_Dvr_PackDvrVTK_SurfaceType( Re_Buf, Db_Buf, Int_Buf, InData%VTK_surface(i1), ErrStat2, ErrMsg2, .TRUE. ) ! VTK_surface - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! VTK_surface - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! VTK_surface - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! VTK_surface - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! VTK_tWidth - Int_BufSz = Int_BufSz + 1 ! n_VTKTime - Re_BufSz = Re_BufSz + 1 ! VTKHubRad - Re_BufSz = Re_BufSz + SIZE(InData%VTKNacDim) ! VTKNacDim - Re_BufSz = Re_BufSz + SIZE(InData%VTKRefPoint) ! VTKRefPoint - Db_BufSz = Db_BufSz + 1 ! DT_Outs - Int_BufSz = Int_BufSz + 1 ! n_DT_Out - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%AD_ver, ErrStat2, ErrMsg2, OnlySize ) ! AD_ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%unOutFile) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%unOutFile,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%unOutFile,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%unOutFile,1), UBOUND(InData%unOutFile,1) - IntKiBuf(Int_Xferred) = InData%unOutFile(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%ActualChanLen - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDvrOutputs - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%Fmt_t) - IntKiBuf(Int_Xferred) = ICHAR(InData%Fmt_t(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Fmt_a) - IntKiBuf(Int_Xferred) = ICHAR(InData%Fmt_a(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%outFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%outFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%fileFmt - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%wrVTK - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WrVTK_Type - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%Root) - IntKiBuf(Int_Xferred) = ICHAR(InData%Root(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%VTK_OutFileRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%VTK_OutFileRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%WriteOutputHdr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) - DO I = 1, LEN(InData%WriteOutputHdr) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputUnt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) - DO I = 1, LEN(InData%WriteOutputUnt) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%storage) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%storage,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%storage,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%storage,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%storage,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%storage,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%storage,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%storage,3), UBOUND(InData%storage,3) - DO i2 = LBOUND(InData%storage,2), UBOUND(InData%storage,2) - DO i1 = LBOUND(InData%storage,1), UBOUND(InData%storage,1) - ReKiBuf(Re_Xferred) = InData%storage(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%outLine) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%outLine,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%outLine,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%outLine,1), UBOUND(InData%outLine,1) - ReKiBuf(Re_Xferred) = InData%outLine(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%VTK_surface) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VTK_surface,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VTK_surface,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%VTK_surface,1), UBOUND(InData%VTK_surface,1) - CALL AD_Dvr_PackDvrVTK_SurfaceType( Re_Buf, Db_Buf, Int_Buf, InData%VTK_surface(i1), ErrStat2, ErrMsg2, OnlySize ) ! VTK_surface - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IntKiBuf(Int_Xferred) = InData%VTK_tWidth - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%n_VTKTime - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VTKHubRad - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%VTKNacDim,1), UBOUND(InData%VTKNacDim,1) - ReKiBuf(Re_Xferred) = InData%VTKNacDim(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%VTKRefPoint,1), UBOUND(InData%VTKRefPoint,1) - ReKiBuf(Re_Xferred) = InData%VTKRefPoint(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DbKiBuf(Db_Xferred) = InData%DT_Outs - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%n_DT_Out - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD_Dvr_PackDvr_Outputs - - SUBROUTINE AD_Dvr_UnPackDvr_Outputs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Dvr_Outputs), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_UnPackDvr_Outputs' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%AD_ver, ErrStat2, ErrMsg2 ) ! AD_ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! unOutFile not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%unOutFile)) DEALLOCATE(OutData%unOutFile) - ALLOCATE(OutData%unOutFile(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%unOutFile.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%unOutFile,1), UBOUND(OutData%unOutFile,1) - OutData%unOutFile(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%ActualChanLen = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDvrOutputs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%Fmt_t) - OutData%Fmt_t(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Fmt_a) - OutData%Fmt_a(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%delim) - OutData%delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%outFmt) - OutData%outFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%fileFmt = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%wrVTK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WrVTK_Type = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%Root) - OutData%Root(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%VTK_OutFileRoot) - OutData%VTK_OutFileRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputHdr)) DEALLOCATE(OutData%WriteOutputHdr) - ALLOCATE(OutData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) - DO I = 1, LEN(OutData%WriteOutputHdr) - OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputUnt)) DEALLOCATE(OutData%WriteOutputUnt) - ALLOCATE(OutData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) - DO I = 1, LEN(OutData%WriteOutputUnt) - OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! storage not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%storage)) DEALLOCATE(OutData%storage) - ALLOCATE(OutData%storage(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%storage.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%storage,3), UBOUND(OutData%storage,3) - DO i2 = LBOUND(OutData%storage,2), UBOUND(OutData%storage,2) - DO i1 = LBOUND(OutData%storage,1), UBOUND(OutData%storage,1) - OutData%storage(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! outLine not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%outLine)) DEALLOCATE(OutData%outLine) - ALLOCATE(OutData%outLine(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%outLine.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%outLine,1), UBOUND(OutData%outLine,1) - OutData%outLine(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VTK_surface not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%VTK_surface)) DEALLOCATE(OutData%VTK_surface) - ALLOCATE(OutData%VTK_surface(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VTK_surface.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%VTK_surface,1), UBOUND(OutData%VTK_surface,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_Dvr_UnpackDvrVTK_SurfaceType( Re_Buf, Db_Buf, Int_Buf, OutData%VTK_surface(i1), ErrStat2, ErrMsg2 ) ! VTK_surface - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - OutData%VTK_tWidth = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%n_VTKTime = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%VTKHubRad = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%VTKNacDim,1) - i1_u = UBOUND(OutData%VTKNacDim,1) - DO i1 = LBOUND(OutData%VTKNacDim,1), UBOUND(OutData%VTKNacDim,1) - OutData%VTKNacDim(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%VTKRefPoint,1) - i1_u = UBOUND(OutData%VTKRefPoint,1) - DO i1 = LBOUND(OutData%VTKRefPoint,1), UBOUND(OutData%VTKRefPoint,1) - OutData%VTKRefPoint(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%DT_Outs = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%n_DT_Out = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD_Dvr_UnPackDvr_Outputs +subroutine AD_Dvr_PackDvr_Outputs(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Dvr_Outputs), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_Dvr_PackDvr_Outputs' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + if (Buf%ErrStat >= AbortErrLev) return + ! AD_ver + call NWTC_Library_PackProgDesc(Buf, InData%AD_ver) + if (RegCheckErr(Buf, RoutineName)) return + ! unOutFile + call RegPack(Buf, allocated(InData%unOutFile)) + if (allocated(InData%unOutFile)) then + call RegPackBounds(Buf, 1, lbound(InData%unOutFile), ubound(InData%unOutFile)) + call RegPack(Buf, InData%unOutFile) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ActualChanLen + call RegPack(Buf, InData%ActualChanLen) + if (RegCheckErr(Buf, RoutineName)) return + ! nDvrOutputs + call RegPack(Buf, InData%nDvrOutputs) + if (RegCheckErr(Buf, RoutineName)) return + ! Fmt_t + call RegPack(Buf, InData%Fmt_t) + if (RegCheckErr(Buf, RoutineName)) return + ! Fmt_a + call RegPack(Buf, InData%Fmt_a) + if (RegCheckErr(Buf, RoutineName)) return + ! delim + call RegPack(Buf, InData%delim) + if (RegCheckErr(Buf, RoutineName)) return + ! outFmt + call RegPack(Buf, InData%outFmt) + if (RegCheckErr(Buf, RoutineName)) return + ! fileFmt + call RegPack(Buf, InData%fileFmt) + if (RegCheckErr(Buf, RoutineName)) return + ! wrVTK + call RegPack(Buf, InData%wrVTK) + if (RegCheckErr(Buf, RoutineName)) return + ! WrVTK_Type + call RegPack(Buf, InData%WrVTK_Type) + if (RegCheckErr(Buf, RoutineName)) return + ! Root + call RegPack(Buf, InData%Root) + if (RegCheckErr(Buf, RoutineName)) return + ! VTK_OutFileRoot + call RegPack(Buf, InData%VTK_OutFileRoot) + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutputHdr + call RegPack(Buf, allocated(InData%WriteOutputHdr)) + if (allocated(InData%WriteOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPack(Buf, InData%WriteOutputHdr) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutputUnt + call RegPack(Buf, allocated(InData%WriteOutputUnt)) + if (allocated(InData%WriteOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPack(Buf, InData%WriteOutputUnt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! storage + call RegPack(Buf, allocated(InData%storage)) + if (allocated(InData%storage)) then + call RegPackBounds(Buf, 3, lbound(InData%storage), ubound(InData%storage)) + call RegPack(Buf, InData%storage) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! outLine + call RegPack(Buf, allocated(InData%outLine)) + if (allocated(InData%outLine)) then + call RegPackBounds(Buf, 1, lbound(InData%outLine), ubound(InData%outLine)) + call RegPack(Buf, InData%outLine) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! VTK_surface + call RegPack(Buf, allocated(InData%VTK_surface)) + if (allocated(InData%VTK_surface)) then + call RegPackBounds(Buf, 1, lbound(InData%VTK_surface), ubound(InData%VTK_surface)) + LB(1:1) = lbound(InData%VTK_surface) + UB(1:1) = ubound(InData%VTK_surface) + do i1 = LB(1), UB(1) + call AD_Dvr_PackDvrVTK_SurfaceType(Buf, InData%VTK_surface(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! VTK_tWidth + call RegPack(Buf, InData%VTK_tWidth) + if (RegCheckErr(Buf, RoutineName)) return + ! n_VTKTime + call RegPack(Buf, InData%n_VTKTime) + if (RegCheckErr(Buf, RoutineName)) return + ! VTKHubRad + call RegPack(Buf, InData%VTKHubRad) + if (RegCheckErr(Buf, RoutineName)) return + ! VTKNacDim + call RegPack(Buf, InData%VTKNacDim) + if (RegCheckErr(Buf, RoutineName)) return + ! VTKRefPoint + call RegPack(Buf, InData%VTKRefPoint) + if (RegCheckErr(Buf, RoutineName)) return + ! DT_Outs + call RegPack(Buf, InData%DT_Outs) + if (RegCheckErr(Buf, RoutineName)) return + ! n_DT_Out + call RegPack(Buf, InData%n_DT_Out) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_Dvr_UnPackDvr_Outputs(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Dvr_Outputs), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_Dvr_UnPackDvr_Outputs' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! AD_ver + call NWTC_Library_UnpackProgDesc(Buf, OutData%AD_ver) ! AD_ver + ! unOutFile + if (allocated(OutData%unOutFile)) deallocate(OutData%unOutFile) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%unOutFile(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%unOutFile.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%unOutFile) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ActualChanLen + call RegUnpack(Buf, OutData%ActualChanLen) + if (RegCheckErr(Buf, RoutineName)) return + ! nDvrOutputs + call RegUnpack(Buf, OutData%nDvrOutputs) + if (RegCheckErr(Buf, RoutineName)) return + ! Fmt_t + call RegUnpack(Buf, OutData%Fmt_t) + if (RegCheckErr(Buf, RoutineName)) return + ! Fmt_a + call RegUnpack(Buf, OutData%Fmt_a) + if (RegCheckErr(Buf, RoutineName)) return + ! delim + call RegUnpack(Buf, OutData%delim) + if (RegCheckErr(Buf, RoutineName)) return + ! outFmt + call RegUnpack(Buf, OutData%outFmt) + if (RegCheckErr(Buf, RoutineName)) return + ! fileFmt + call RegUnpack(Buf, OutData%fileFmt) + if (RegCheckErr(Buf, RoutineName)) return + ! wrVTK + call RegUnpack(Buf, OutData%wrVTK) + if (RegCheckErr(Buf, RoutineName)) return + ! WrVTK_Type + call RegUnpack(Buf, OutData%WrVTK_Type) + if (RegCheckErr(Buf, RoutineName)) return + ! Root + call RegUnpack(Buf, OutData%Root) + if (RegCheckErr(Buf, RoutineName)) return + ! VTK_OutFileRoot + call RegUnpack(Buf, OutData%VTK_OutFileRoot) + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutputHdr + if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WriteOutputUnt + if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! storage + if (allocated(OutData%storage)) deallocate(OutData%storage) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%storage(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%storage.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%storage) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! outLine + if (allocated(OutData%outLine)) deallocate(OutData%outLine) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%outLine(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%outLine.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%outLine) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! VTK_surface + if (allocated(OutData%VTK_surface)) deallocate(OutData%VTK_surface) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%VTK_surface(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VTK_surface.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_Dvr_UnpackDvrVTK_SurfaceType(Buf, OutData%VTK_surface(i1)) ! VTK_surface + end do + end if + ! VTK_tWidth + call RegUnpack(Buf, OutData%VTK_tWidth) + if (RegCheckErr(Buf, RoutineName)) return + ! n_VTKTime + call RegUnpack(Buf, OutData%n_VTKTime) + if (RegCheckErr(Buf, RoutineName)) return + ! VTKHubRad + call RegUnpack(Buf, OutData%VTKHubRad) + if (RegCheckErr(Buf, RoutineName)) return + ! VTKNacDim + call RegUnpack(Buf, OutData%VTKNacDim) + if (RegCheckErr(Buf, RoutineName)) return + ! VTKRefPoint + call RegUnpack(Buf, OutData%VTKRefPoint) + if (RegCheckErr(Buf, RoutineName)) return + ! DT_Outs + call RegUnpack(Buf, OutData%DT_Outs) + if (RegCheckErr(Buf, RoutineName)) return + ! n_DT_Out + call RegUnpack(Buf, OutData%n_DT_Out) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE AD_Dvr_CopyBladeData( SrcBladeDataData, DstBladeDataData, CtrlCode, ErrStat, ErrMsg ) TYPE(BladeData), INTENT(IN) :: SrcBladeDataData TYPE(BladeData), INTENT(INOUT) :: DstBladeDataData @@ -1420,226 +877,105 @@ SUBROUTINE AD_Dvr_DestroyBladeData( BladeDataData, ErrStat, ErrMsg ) 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_PackBladeData(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BladeData), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_Dvr_PackBladeData' + if (Buf%ErrStat >= AbortErrLev) return + ! pitch + call RegPack(Buf, InData%pitch) + if (RegCheckErr(Buf, RoutineName)) return + ! pitchSpeed + call RegPack(Buf, InData%pitchSpeed) + if (RegCheckErr(Buf, RoutineName)) return + ! pitchAcc + call RegPack(Buf, InData%pitchAcc) + if (RegCheckErr(Buf, RoutineName)) return + ! origin_h + call RegPack(Buf, InData%origin_h) + if (RegCheckErr(Buf, RoutineName)) return + ! orientation_h + call RegPack(Buf, InData%orientation_h) + if (RegCheckErr(Buf, RoutineName)) return + ! hubRad_bl + call RegPack(Buf, InData%hubRad_bl) + if (RegCheckErr(Buf, RoutineName)) return + ! Rh2bl0 + call RegPack(Buf, InData%Rh2bl0) + if (RegCheckErr(Buf, RoutineName)) return + ! motionType + call RegPack(Buf, InData%motionType) + if (RegCheckErr(Buf, RoutineName)) return + ! iMotion + call RegPack(Buf, InData%iMotion) + if (RegCheckErr(Buf, RoutineName)) return + ! motion + call RegPack(Buf, allocated(InData%motion)) + if (allocated(InData%motion)) then + call RegPackBounds(Buf, 2, lbound(InData%motion), ubound(InData%motion)) + call RegPack(Buf, InData%motion) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! motionFileName + call RegPack(Buf, InData%motionFileName) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_Dvr_UnPackBladeData(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BladeData), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_Dvr_UnPackBladeData' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! pitch + call RegUnpack(Buf, OutData%pitch) + if (RegCheckErr(Buf, RoutineName)) return + ! pitchSpeed + call RegUnpack(Buf, OutData%pitchSpeed) + if (RegCheckErr(Buf, RoutineName)) return + ! pitchAcc + call RegUnpack(Buf, OutData%pitchAcc) + if (RegCheckErr(Buf, RoutineName)) return + ! origin_h + call RegUnpack(Buf, OutData%origin_h) + if (RegCheckErr(Buf, RoutineName)) return + ! orientation_h + call RegUnpack(Buf, OutData%orientation_h) + if (RegCheckErr(Buf, RoutineName)) return + ! hubRad_bl + call RegUnpack(Buf, OutData%hubRad_bl) + if (RegCheckErr(Buf, RoutineName)) return + ! Rh2bl0 + call RegUnpack(Buf, OutData%Rh2bl0) + if (RegCheckErr(Buf, RoutineName)) return + ! motionType + call RegUnpack(Buf, OutData%motionType) + if (RegCheckErr(Buf, RoutineName)) return + ! iMotion + call RegUnpack(Buf, OutData%iMotion) + if (RegCheckErr(Buf, RoutineName)) return + ! motion + if (allocated(OutData%motion)) deallocate(OutData%motion) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%motion(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%motion.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%motion) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! motionFileName + call RegUnpack(Buf, OutData%motionFileName) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE AD_Dvr_CopyHubData( SrcHubDataData, DstHubDataData, CtrlCode, ErrStat, ErrMsg ) TYPE(HubData), INTENT(IN) :: SrcHubDataData TYPE(HubData), INTENT(INOUT) :: DstHubDataData @@ -1698,204 +1034,93 @@ SUBROUTINE AD_Dvr_DestroyHubData( HubDataData, ErrStat, ErrMsg ) 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_PackHubData(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(HubData), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_Dvr_PackHubData' + if (Buf%ErrStat >= AbortErrLev) return + ! origin_n + call RegPack(Buf, InData%origin_n) + if (RegCheckErr(Buf, RoutineName)) return + ! orientation_n + call RegPack(Buf, InData%orientation_n) + if (RegCheckErr(Buf, RoutineName)) return + ! motionType + call RegPack(Buf, InData%motionType) + if (RegCheckErr(Buf, RoutineName)) return + ! iMotion + call RegPack(Buf, InData%iMotion) + if (RegCheckErr(Buf, RoutineName)) return + ! azimuth + call RegPack(Buf, InData%azimuth) + if (RegCheckErr(Buf, RoutineName)) return + ! rotSpeed + call RegPack(Buf, InData%rotSpeed) + if (RegCheckErr(Buf, RoutineName)) return + ! rotAcc + call RegPack(Buf, InData%rotAcc) + if (RegCheckErr(Buf, RoutineName)) return + ! motionFileName + call RegPack(Buf, InData%motionFileName) + if (RegCheckErr(Buf, RoutineName)) return + ! motion + call RegPack(Buf, allocated(InData%motion)) + if (allocated(InData%motion)) then + call RegPackBounds(Buf, 2, lbound(InData%motion), ubound(InData%motion)) + call RegPack(Buf, InData%motion) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_Dvr_UnPackHubData(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(HubData), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_Dvr_UnPackHubData' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! origin_n + call RegUnpack(Buf, OutData%origin_n) + if (RegCheckErr(Buf, RoutineName)) return + ! orientation_n + call RegUnpack(Buf, OutData%orientation_n) + if (RegCheckErr(Buf, RoutineName)) return + ! motionType + call RegUnpack(Buf, OutData%motionType) + if (RegCheckErr(Buf, RoutineName)) return + ! iMotion + call RegUnpack(Buf, OutData%iMotion) + if (RegCheckErr(Buf, RoutineName)) return + ! azimuth + call RegUnpack(Buf, OutData%azimuth) + if (RegCheckErr(Buf, RoutineName)) return + ! rotSpeed + call RegUnpack(Buf, OutData%rotSpeed) + if (RegCheckErr(Buf, RoutineName)) return + ! rotAcc + call RegUnpack(Buf, OutData%rotAcc) + if (RegCheckErr(Buf, RoutineName)) return + ! motionFileName + call RegUnpack(Buf, OutData%motionFileName) + if (RegCheckErr(Buf, RoutineName)) return + ! motion + if (allocated(OutData%motion)) deallocate(OutData%motion) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%motion(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%motion.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%motion) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE AD_Dvr_CopyNacData( SrcNacDataData, DstNacDataData, CtrlCode, ErrStat, ErrMsg ) TYPE(NacData), INTENT(IN) :: SrcNacDataData TYPE(NacData), INTENT(INOUT) :: DstNacDataData @@ -1953,193 +1178,87 @@ SUBROUTINE AD_Dvr_DestroyNacData( NacDataData, ErrStat, ErrMsg ) 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_PackNacData(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(NacData), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_Dvr_PackNacData' + if (Buf%ErrStat >= AbortErrLev) return + ! origin_t + call RegPack(Buf, InData%origin_t) + if (RegCheckErr(Buf, RoutineName)) return + ! motionType + call RegPack(Buf, InData%motionType) + if (RegCheckErr(Buf, RoutineName)) return + ! iMotion + call RegPack(Buf, InData%iMotion) + if (RegCheckErr(Buf, RoutineName)) return + ! yaw + call RegPack(Buf, InData%yaw) + if (RegCheckErr(Buf, RoutineName)) return + ! yawSpeed + call RegPack(Buf, InData%yawSpeed) + if (RegCheckErr(Buf, RoutineName)) return + ! yawAcc + call RegPack(Buf, InData%yawAcc) + if (RegCheckErr(Buf, RoutineName)) return + ! motionFileName + call RegPack(Buf, InData%motionFileName) + if (RegCheckErr(Buf, RoutineName)) return + ! motion + call RegPack(Buf, allocated(InData%motion)) + if (allocated(InData%motion)) then + call RegPackBounds(Buf, 2, lbound(InData%motion), ubound(InData%motion)) + call RegPack(Buf, InData%motion) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_Dvr_UnPackNacData(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(NacData), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_Dvr_UnPackNacData' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! origin_t + call RegUnpack(Buf, OutData%origin_t) + if (RegCheckErr(Buf, RoutineName)) return + ! motionType + call RegUnpack(Buf, OutData%motionType) + if (RegCheckErr(Buf, RoutineName)) return + ! iMotion + call RegUnpack(Buf, OutData%iMotion) + if (RegCheckErr(Buf, RoutineName)) return + ! yaw + call RegUnpack(Buf, OutData%yaw) + if (RegCheckErr(Buf, RoutineName)) return + ! yawSpeed + call RegUnpack(Buf, OutData%yawSpeed) + if (RegCheckErr(Buf, RoutineName)) return + ! yawAcc + call RegUnpack(Buf, OutData%yawAcc) + if (RegCheckErr(Buf, RoutineName)) return + ! motionFileName + call RegUnpack(Buf, OutData%motionFileName) + if (RegCheckErr(Buf, RoutineName)) return + ! motion + if (allocated(OutData%motion)) deallocate(OutData%motion) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%motion(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%motion.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%motion) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE AD_Dvr_CopyTwrData( SrcTwrDataData, DstTwrDataData, CtrlCode, ErrStat, ErrMsg ) TYPE(TwrData), INTENT(IN) :: SrcTwrDataData TYPE(TwrData), INTENT(INOUT) :: DstTwrDataData @@ -2173,110 +1292,26 @@ SUBROUTINE AD_Dvr_DestroyTwrData( TwrDataData, ErrStat, ErrMsg ) 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_PackTwrData(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(TwrData), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_Dvr_PackTwrData' + if (Buf%ErrStat >= AbortErrLev) return + ! origin_t + call RegPack(Buf, InData%origin_t) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_Dvr_UnPackTwrData(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(TwrData), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_Dvr_UnPackTwrData' + if (Buf%ErrStat /= ErrID_None) return + ! origin_t + call RegUnpack(Buf, OutData%origin_t) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE AD_Dvr_CopyWTData( SrcWTDataData, DstWTDataData, CtrlCode, ErrStat, ErrMsg ) TYPE(WTData), INTENT(INOUT) :: SrcWTDataData TYPE(WTData), INTENT(INOUT) :: DstWTDataData @@ -2447,1061 +1482,260 @@ SUBROUTINE AD_Dvr_DestroyWTData( WTDataData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE AD_Dvr_DestroyWTData - SUBROUTINE AD_Dvr_PackWTData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(WTData), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_PackWTData' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + SIZE(InData%originInit) ! originInit - Re_BufSz = Re_BufSz + SIZE(InData%orientationInit) ! orientationInit - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! map2twrPt: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%map2twrPt, ErrStat2, ErrMsg2, .TRUE. ) ! map2twrPt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! map2twrPt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! map2twrPt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! map2twrPt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! map2nacPt: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%map2nacPt, ErrStat2, ErrMsg2, .TRUE. ) ! map2nacPt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! map2nacPt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! map2nacPt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! map2nacPt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! map2hubPt: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%map2hubPt, ErrStat2, ErrMsg2, .TRUE. ) ! map2hubPt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! map2hubPt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! map2hubPt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! map2hubPt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! map2BldPt allocated yes/no - IF ( ALLOCATED(InData%map2BldPt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! map2BldPt upper/lower bounds for each dimension - DO i1 = LBOUND(InData%map2BldPt,1), UBOUND(InData%map2BldPt,1) - Int_BufSz = Int_BufSz + 3 ! map2BldPt: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%map2BldPt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! map2BldPt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! map2BldPt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! map2BldPt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! map2BldPt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! bld allocated yes/no - IF ( ALLOCATED(InData%bld) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! bld upper/lower bounds for each dimension - DO i1 = LBOUND(InData%bld,1), UBOUND(InData%bld,1) - Int_BufSz = Int_BufSz + 3 ! bld: size of buffers for each call to pack subtype - CALL AD_Dvr_PackBladeData( Re_Buf, Db_Buf, Int_Buf, InData%bld(i1), ErrStat2, ErrMsg2, .TRUE. ) ! bld - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! bld - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! bld - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! bld - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! hub: size of buffers for each call to pack subtype - CALL AD_Dvr_PackHubData( Re_Buf, Db_Buf, Int_Buf, InData%hub, ErrStat2, ErrMsg2, .TRUE. ) ! hub - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! hub - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! hub - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! hub - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! nac: size of buffers for each call to pack subtype - CALL AD_Dvr_PackNacData( Re_Buf, Db_Buf, Int_Buf, InData%nac, ErrStat2, ErrMsg2, .TRUE. ) ! nac - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! nac - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! nac - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! nac - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! twr: size of buffers for each call to pack subtype - CALL AD_Dvr_PackTwrData( Re_Buf, Db_Buf, Int_Buf, InData%twr, ErrStat2, ErrMsg2, .TRUE. ) ! twr - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! twr - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! twr - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! twr - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! numBlades - Int_BufSz = Int_BufSz + 1 ! basicHAWTFormat - Int_BufSz = Int_BufSz + 1 ! hasTower - Int_BufSz = Int_BufSz + 1 ! projMod - Int_BufSz = Int_BufSz + 1 ! BEM_Mod - Int_BufSz = Int_BufSz + 1 ! HAWTprojection - Int_BufSz = Int_BufSz + 1 ! motionType - Int_BufSz = Int_BufSz + 1 ! motion allocated yes/no - IF ( ALLOCATED(InData%motion) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! motion upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%motion) ! motion - END IF - Int_BufSz = Int_BufSz + 1 ! iMotion - Int_BufSz = Int_BufSz + 1 ! degreeOfFreedom - Re_BufSz = Re_BufSz + 1 ! amplitude - Re_BufSz = Re_BufSz + 1 ! frequency - Int_BufSz = Int_BufSz + 1*LEN(InData%motionFileName) ! motionFileName - Int_BufSz = Int_BufSz + 1 ! WriteOutput allocated yes/no - IF ( ALLOCATED(InData%WriteOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutput upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WriteOutput) ! WriteOutput - END IF - Int_BufSz = Int_BufSz + 1 ! userSwapArray allocated yes/no - IF ( ALLOCATED(InData%userSwapArray) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! userSwapArray upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%userSwapArray) ! userSwapArray - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i1 = LBOUND(InData%originInit,1), UBOUND(InData%originInit,1) - ReKiBuf(Re_Xferred) = InData%originInit(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%orientationInit,1), UBOUND(InData%orientationInit,1) - ReKiBuf(Re_Xferred) = InData%orientationInit(i1) - Re_Xferred = Re_Xferred + 1 - END DO - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%map2twrPt, ErrStat2, ErrMsg2, OnlySize ) ! map2twrPt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%map2nacPt, ErrStat2, ErrMsg2, OnlySize ) ! map2nacPt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%map2hubPt, ErrStat2, ErrMsg2, OnlySize ) ! map2hubPt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%map2BldPt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%map2BldPt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%map2BldPt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%map2BldPt,1), UBOUND(InData%map2BldPt,1) - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%map2BldPt(i1), ErrStat2, ErrMsg2, OnlySize ) ! map2BldPt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%bld) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%bld,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%bld,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%bld,1), UBOUND(InData%bld,1) - CALL AD_Dvr_PackBladeData( Re_Buf, Db_Buf, Int_Buf, InData%bld(i1), ErrStat2, ErrMsg2, OnlySize ) ! bld - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL AD_Dvr_PackHubData( Re_Buf, Db_Buf, Int_Buf, InData%hub, ErrStat2, ErrMsg2, OnlySize ) ! hub - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD_Dvr_PackNacData( Re_Buf, Db_Buf, Int_Buf, InData%nac, ErrStat2, ErrMsg2, OnlySize ) ! nac - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD_Dvr_PackTwrData( Re_Buf, Db_Buf, Int_Buf, InData%twr, ErrStat2, ErrMsg2, OnlySize ) ! twr - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = InData%numBlades - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%basicHAWTFormat, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%hasTower, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%projMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%BEM_Mod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%HAWTprojection, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%motionType - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%motion) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%motion,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%motion,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%motion,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%motion,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%motion,2), UBOUND(InData%motion,2) - DO i1 = LBOUND(InData%motion,1), UBOUND(InData%motion,1) - ReKiBuf(Re_Xferred) = InData%motion(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%iMotion - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%degreeOfFreedom - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%amplitude - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%frequency - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%motionFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%motionFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) - ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%userSwapArray) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%userSwapArray,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%userSwapArray,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%userSwapArray,1), UBOUND(InData%userSwapArray,1) - ReKiBuf(Re_Xferred) = InData%userSwapArray(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AD_Dvr_PackWTData - - SUBROUTINE AD_Dvr_UnPackWTData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(WTData), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_UnPackWTData' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%originInit,1) - i1_u = UBOUND(OutData%originInit,1) - DO i1 = LBOUND(OutData%originInit,1), UBOUND(OutData%originInit,1) - OutData%originInit(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%orientationInit,1) - i1_u = UBOUND(OutData%orientationInit,1) - DO i1 = LBOUND(OutData%orientationInit,1), UBOUND(OutData%orientationInit,1) - OutData%orientationInit(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%map2twrPt, ErrStat2, ErrMsg2 ) ! map2twrPt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%map2nacPt, ErrStat2, ErrMsg2 ) ! map2nacPt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%map2hubPt, ErrStat2, ErrMsg2 ) ! map2hubPt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! map2BldPt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%map2BldPt)) DEALLOCATE(OutData%map2BldPt) - ALLOCATE(OutData%map2BldPt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%map2BldPt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%map2BldPt,1), UBOUND(OutData%map2BldPt,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%map2BldPt(i1), ErrStat2, ErrMsg2 ) ! map2BldPt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! bld not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%bld)) DEALLOCATE(OutData%bld) - ALLOCATE(OutData%bld(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%bld.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%bld,1), UBOUND(OutData%bld,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_Dvr_UnpackBladeData( Re_Buf, Db_Buf, Int_Buf, OutData%bld(i1), ErrStat2, ErrMsg2 ) ! bld - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_Dvr_UnpackHubData( Re_Buf, Db_Buf, Int_Buf, OutData%hub, ErrStat2, ErrMsg2 ) ! hub - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_Dvr_UnpackNacData( Re_Buf, Db_Buf, Int_Buf, OutData%nac, ErrStat2, ErrMsg2 ) ! nac - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_Dvr_UnpackTwrData( Re_Buf, Db_Buf, Int_Buf, OutData%twr, ErrStat2, ErrMsg2 ) ! twr - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%numBlades = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%basicHAWTFormat = TRANSFER(IntKiBuf(Int_Xferred), OutData%basicHAWTFormat) - Int_Xferred = Int_Xferred + 1 - OutData%hasTower = TRANSFER(IntKiBuf(Int_Xferred), OutData%hasTower) - Int_Xferred = Int_Xferred + 1 - OutData%projMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%BEM_Mod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%HAWTprojection = TRANSFER(IntKiBuf(Int_Xferred), OutData%HAWTprojection) - Int_Xferred = Int_Xferred + 1 - OutData%motionType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! motion not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%motion)) DEALLOCATE(OutData%motion) - ALLOCATE(OutData%motion(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%motion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%motion,2), UBOUND(OutData%motion,2) - DO i1 = LBOUND(OutData%motion,1), UBOUND(OutData%motion,1) - OutData%motion(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%iMotion = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%degreeOfFreedom = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%amplitude = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%frequency = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%motionFileName) - OutData%motionFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutput)) DEALLOCATE(OutData%WriteOutput) - ALLOCATE(OutData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) - OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! userSwapArray not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%userSwapArray)) DEALLOCATE(OutData%userSwapArray) - ALLOCATE(OutData%userSwapArray(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%userSwapArray.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%userSwapArray,1), UBOUND(OutData%userSwapArray,1) - OutData%userSwapArray(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AD_Dvr_UnPackWTData +subroutine AD_Dvr_PackWTData(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WTData), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_Dvr_PackWTData' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + ! originInit + call RegPack(Buf, InData%originInit) + if (RegCheckErr(Buf, RoutineName)) return + ! orientationInit + call RegPack(Buf, InData%orientationInit) + if (RegCheckErr(Buf, RoutineName)) return + ! map2twrPt + call NWTC_Library_PackMeshMapType(Buf, InData%map2twrPt) + if (RegCheckErr(Buf, RoutineName)) return + ! map2nacPt + call NWTC_Library_PackMeshMapType(Buf, InData%map2nacPt) + if (RegCheckErr(Buf, RoutineName)) return + ! map2hubPt + call NWTC_Library_PackMeshMapType(Buf, InData%map2hubPt) + if (RegCheckErr(Buf, RoutineName)) return + ! map2BldPt + call RegPack(Buf, allocated(InData%map2BldPt)) + if (allocated(InData%map2BldPt)) then + call RegPackBounds(Buf, 1, lbound(InData%map2BldPt), ubound(InData%map2BldPt)) + LB(1:1) = lbound(InData%map2BldPt) + UB(1:1) = ubound(InData%map2BldPt) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%map2BldPt(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! bld + call RegPack(Buf, allocated(InData%bld)) + if (allocated(InData%bld)) then + call RegPackBounds(Buf, 1, lbound(InData%bld), ubound(InData%bld)) + LB(1:1) = lbound(InData%bld) + UB(1:1) = ubound(InData%bld) + do i1 = LB(1), UB(1) + call AD_Dvr_PackBladeData(Buf, InData%bld(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! hub + call AD_Dvr_PackHubData(Buf, InData%hub) + if (RegCheckErr(Buf, RoutineName)) return + ! nac + call AD_Dvr_PackNacData(Buf, InData%nac) + if (RegCheckErr(Buf, RoutineName)) return + ! twr + call AD_Dvr_PackTwrData(Buf, InData%twr) + if (RegCheckErr(Buf, RoutineName)) return + ! numBlades + call RegPack(Buf, InData%numBlades) + if (RegCheckErr(Buf, RoutineName)) return + ! basicHAWTFormat + call RegPack(Buf, InData%basicHAWTFormat) + if (RegCheckErr(Buf, RoutineName)) return + ! hasTower + call RegPack(Buf, InData%hasTower) + if (RegCheckErr(Buf, RoutineName)) return + ! projMod + call RegPack(Buf, InData%projMod) + if (RegCheckErr(Buf, RoutineName)) return + ! BEM_Mod + call RegPack(Buf, InData%BEM_Mod) + if (RegCheckErr(Buf, RoutineName)) return + ! HAWTprojection + call RegPack(Buf, InData%HAWTprojection) + if (RegCheckErr(Buf, RoutineName)) return + ! motionType + call RegPack(Buf, InData%motionType) + if (RegCheckErr(Buf, RoutineName)) return + ! motion + call RegPack(Buf, allocated(InData%motion)) + if (allocated(InData%motion)) then + call RegPackBounds(Buf, 2, lbound(InData%motion), ubound(InData%motion)) + call RegPack(Buf, InData%motion) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! iMotion + call RegPack(Buf, InData%iMotion) + if (RegCheckErr(Buf, RoutineName)) return + ! degreeOfFreedom + call RegPack(Buf, InData%degreeOfFreedom) + if (RegCheckErr(Buf, RoutineName)) return + ! amplitude + call RegPack(Buf, InData%amplitude) + if (RegCheckErr(Buf, RoutineName)) return + ! frequency + call RegPack(Buf, InData%frequency) + if (RegCheckErr(Buf, RoutineName)) return + ! motionFileName + call RegPack(Buf, InData%motionFileName) + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutput + call RegPack(Buf, allocated(InData%WriteOutput)) + if (allocated(InData%WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPack(Buf, InData%WriteOutput) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! userSwapArray + call RegPack(Buf, allocated(InData%userSwapArray)) + if (allocated(InData%userSwapArray)) then + call RegPackBounds(Buf, 1, lbound(InData%userSwapArray), ubound(InData%userSwapArray)) + call RegPack(Buf, InData%userSwapArray) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_Dvr_UnPackWTData(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WTData), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_Dvr_UnPackWTData' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! originInit + call RegUnpack(Buf, OutData%originInit) + if (RegCheckErr(Buf, RoutineName)) return + ! orientationInit + call RegUnpack(Buf, OutData%orientationInit) + if (RegCheckErr(Buf, RoutineName)) return + ! map2twrPt + call NWTC_Library_UnpackMeshMapType(Buf, OutData%map2twrPt) ! map2twrPt + ! map2nacPt + call NWTC_Library_UnpackMeshMapType(Buf, OutData%map2nacPt) ! map2nacPt + ! map2hubPt + call NWTC_Library_UnpackMeshMapType(Buf, OutData%map2hubPt) ! map2hubPt + ! map2BldPt + if (allocated(OutData%map2BldPt)) deallocate(OutData%map2BldPt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%map2BldPt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%map2BldPt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%map2BldPt(i1)) ! map2BldPt + end do + end if + ! bld + if (allocated(OutData%bld)) deallocate(OutData%bld) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%bld(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%bld.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_Dvr_UnpackBladeData(Buf, OutData%bld(i1)) ! bld + end do + end if + ! hub + call AD_Dvr_UnpackHubData(Buf, OutData%hub) ! hub + ! nac + call AD_Dvr_UnpackNacData(Buf, OutData%nac) ! nac + ! twr + call AD_Dvr_UnpackTwrData(Buf, OutData%twr) ! twr + ! numBlades + call RegUnpack(Buf, OutData%numBlades) + if (RegCheckErr(Buf, RoutineName)) return + ! basicHAWTFormat + call RegUnpack(Buf, OutData%basicHAWTFormat) + if (RegCheckErr(Buf, RoutineName)) return + ! hasTower + call RegUnpack(Buf, OutData%hasTower) + if (RegCheckErr(Buf, RoutineName)) return + ! projMod + call RegUnpack(Buf, OutData%projMod) + if (RegCheckErr(Buf, RoutineName)) return + ! BEM_Mod + call RegUnpack(Buf, OutData%BEM_Mod) + if (RegCheckErr(Buf, RoutineName)) return + ! HAWTprojection + call RegUnpack(Buf, OutData%HAWTprojection) + if (RegCheckErr(Buf, RoutineName)) return + ! motionType + call RegUnpack(Buf, OutData%motionType) + if (RegCheckErr(Buf, RoutineName)) return + ! motion + if (allocated(OutData%motion)) deallocate(OutData%motion) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%motion(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%motion.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%motion) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! iMotion + call RegUnpack(Buf, OutData%iMotion) + if (RegCheckErr(Buf, RoutineName)) return + ! degreeOfFreedom + call RegUnpack(Buf, OutData%degreeOfFreedom) + if (RegCheckErr(Buf, RoutineName)) return + ! amplitude + call RegUnpack(Buf, OutData%amplitude) + if (RegCheckErr(Buf, RoutineName)) return + ! frequency + call RegUnpack(Buf, OutData%frequency) + if (RegCheckErr(Buf, RoutineName)) return + ! motionFileName + call RegUnpack(Buf, OutData%motionFileName) + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutput + if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! userSwapArray + if (allocated(OutData%userSwapArray)) deallocate(OutData%userSwapArray) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%userSwapArray(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%userSwapArray.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%userSwapArray) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE AD_Dvr_CopyDvr_SimData( SrcDvr_SimDataData, DstDvr_SimDataData, CtrlCode, ErrStat, ErrMsg ) TYPE(Dvr_SimData), INTENT(INOUT) :: SrcDvr_SimDataData TYPE(Dvr_SimData), INTENT(INOUT) :: DstDvr_SimDataData @@ -3626,657 +1860,220 @@ SUBROUTINE AD_Dvr_DestroyDvr_SimData( Dvr_SimDataData, ErrStat, ErrMsg ) 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_PackDvr_SimData(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Dvr_SimData), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_Dvr_PackDvr_SimData' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + ! AD_InputFile + call RegPack(Buf, InData%AD_InputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! MHK + call RegPack(Buf, InData%MHK) + if (RegCheckErr(Buf, RoutineName)) return + ! AnalysisType + call RegPack(Buf, InData%AnalysisType) + if (RegCheckErr(Buf, RoutineName)) return + ! FldDens + call RegPack(Buf, InData%FldDens) + if (RegCheckErr(Buf, RoutineName)) return + ! KinVisc + call RegPack(Buf, InData%KinVisc) + if (RegCheckErr(Buf, RoutineName)) return + ! SpdSound + call RegPack(Buf, InData%SpdSound) + if (RegCheckErr(Buf, RoutineName)) return + ! Patm + call RegPack(Buf, InData%Patm) + if (RegCheckErr(Buf, RoutineName)) return + ! Pvap + call RegPack(Buf, InData%Pvap) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDpth + call RegPack(Buf, InData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! MSL2SWL + call RegPack(Buf, InData%MSL2SWL) + if (RegCheckErr(Buf, RoutineName)) return + ! numTurbines + call RegPack(Buf, InData%numTurbines) + if (RegCheckErr(Buf, RoutineName)) return + ! WT + call RegPack(Buf, allocated(InData%WT)) + if (allocated(InData%WT)) then + call RegPackBounds(Buf, 1, lbound(InData%WT), ubound(InData%WT)) + LB(1:1) = lbound(InData%WT) + UB(1:1) = ubound(InData%WT) + do i1 = LB(1), UB(1) + call AD_Dvr_PackWTData(Buf, InData%WT(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! dT + call RegPack(Buf, InData%dT) + if (RegCheckErr(Buf, RoutineName)) return + ! tMax + call RegPack(Buf, InData%tMax) + if (RegCheckErr(Buf, RoutineName)) return + ! numSteps + call RegPack(Buf, InData%numSteps) + if (RegCheckErr(Buf, RoutineName)) return + ! numCases + call RegPack(Buf, InData%numCases) + if (RegCheckErr(Buf, RoutineName)) return + ! Cases + call RegPack(Buf, allocated(InData%Cases)) + if (allocated(InData%Cases)) then + call RegPackBounds(Buf, 1, lbound(InData%Cases), ubound(InData%Cases)) + LB(1:1) = lbound(InData%Cases) + UB(1:1) = ubound(InData%Cases) + do i1 = LB(1), UB(1) + call AD_Dvr_PackDvr_Case(Buf, InData%Cases(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! iCase + call RegPack(Buf, InData%iCase) + if (RegCheckErr(Buf, RoutineName)) return + ! timeSeries + call RegPack(Buf, allocated(InData%timeSeries)) + if (allocated(InData%timeSeries)) then + call RegPackBounds(Buf, 2, lbound(InData%timeSeries), ubound(InData%timeSeries)) + call RegPack(Buf, InData%timeSeries) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! iTimeSeries + call RegPack(Buf, InData%iTimeSeries) + if (RegCheckErr(Buf, RoutineName)) return + ! root + call RegPack(Buf, InData%root) + if (RegCheckErr(Buf, RoutineName)) return + ! out + call AD_Dvr_PackDvr_Outputs(Buf, InData%out) + if (RegCheckErr(Buf, RoutineName)) return + ! IW_InitInp + call ADI_PackIW_InputData(Buf, InData%IW_InitInp) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_Dvr_UnPackDvr_SimData(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Dvr_SimData), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_Dvr_UnPackDvr_SimData' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! AD_InputFile + call RegUnpack(Buf, OutData%AD_InputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! MHK + call RegUnpack(Buf, OutData%MHK) + if (RegCheckErr(Buf, RoutineName)) return + ! AnalysisType + call RegUnpack(Buf, OutData%AnalysisType) + if (RegCheckErr(Buf, RoutineName)) return + ! FldDens + call RegUnpack(Buf, OutData%FldDens) + if (RegCheckErr(Buf, RoutineName)) return + ! KinVisc + call RegUnpack(Buf, OutData%KinVisc) + if (RegCheckErr(Buf, RoutineName)) return + ! SpdSound + call RegUnpack(Buf, OutData%SpdSound) + if (RegCheckErr(Buf, RoutineName)) return + ! Patm + call RegUnpack(Buf, OutData%Patm) + if (RegCheckErr(Buf, RoutineName)) return + ! Pvap + call RegUnpack(Buf, OutData%Pvap) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDpth + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! MSL2SWL + call RegUnpack(Buf, OutData%MSL2SWL) + if (RegCheckErr(Buf, RoutineName)) return + ! numTurbines + call RegUnpack(Buf, OutData%numTurbines) + if (RegCheckErr(Buf, RoutineName)) return + ! WT + if (allocated(OutData%WT)) deallocate(OutData%WT) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WT(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_Dvr_UnpackWTData(Buf, OutData%WT(i1)) ! WT + end do + end if + ! dT + call RegUnpack(Buf, OutData%dT) + if (RegCheckErr(Buf, RoutineName)) return + ! tMax + call RegUnpack(Buf, OutData%tMax) + if (RegCheckErr(Buf, RoutineName)) return + ! numSteps + call RegUnpack(Buf, OutData%numSteps) + if (RegCheckErr(Buf, RoutineName)) return + ! numCases + call RegUnpack(Buf, OutData%numCases) + if (RegCheckErr(Buf, RoutineName)) return + ! Cases + if (allocated(OutData%Cases)) deallocate(OutData%Cases) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Cases(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cases.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_Dvr_UnpackDvr_Case(Buf, OutData%Cases(i1)) ! Cases + end do + end if + ! iCase + call RegUnpack(Buf, OutData%iCase) + if (RegCheckErr(Buf, RoutineName)) return + ! timeSeries + if (allocated(OutData%timeSeries)) deallocate(OutData%timeSeries) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%timeSeries(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%timeSeries.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%timeSeries) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! iTimeSeries + call RegUnpack(Buf, OutData%iTimeSeries) + if (RegCheckErr(Buf, RoutineName)) return + ! root + call RegUnpack(Buf, OutData%root) + if (RegCheckErr(Buf, RoutineName)) return + ! out + call AD_Dvr_UnpackDvr_Outputs(Buf, OutData%out) ! out + ! IW_InitInp + call ADI_UnpackIW_InputData(Buf, OutData%IW_InitInp) ! IW_InitInp +end subroutine SUBROUTINE AD_Dvr_CopyAllData( SrcAllDataData, DstAllDataData, CtrlCode, ErrStat, ErrMsg ) TYPE(AllData), INTENT(INOUT) :: SrcAllDataData TYPE(AllData), INTENT(INOUT) :: DstAllDataData @@ -4326,372 +2123,52 @@ SUBROUTINE AD_Dvr_DestroyAllData( AllDataData, ErrStat, ErrMsg ) 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 +subroutine AD_Dvr_PackAllData(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AllData), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_Dvr_PackAllData' + if (Buf%ErrStat >= AbortErrLev) return + ! dvr + call AD_Dvr_PackDvr_SimData(Buf, InData%dvr) + if (RegCheckErr(Buf, RoutineName)) return + ! ADI + call ADI_PackData(Buf, InData%ADI) + if (RegCheckErr(Buf, RoutineName)) return + ! FED + call ADI_PackFED_Data(Buf, InData%FED) + if (RegCheckErr(Buf, RoutineName)) return + ! errStat + call RegPack(Buf, InData%errStat) + if (RegCheckErr(Buf, RoutineName)) return + ! errMsg + call RegPack(Buf, InData%errMsg) + if (RegCheckErr(Buf, RoutineName)) return + ! initialized + call RegPack(Buf, InData%initialized) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_Dvr_UnPackAllData(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AllData), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_Dvr_UnPackAllData' + if (Buf%ErrStat /= ErrID_None) return + ! dvr + call AD_Dvr_UnpackDvr_SimData(Buf, OutData%dvr) ! dvr + ! ADI + call ADI_UnpackData(Buf, OutData%ADI) ! ADI + ! FED + call ADI_UnpackFED_Data(Buf, OutData%FED) ! FED + ! errStat + call RegUnpack(Buf, OutData%errStat) + if (RegCheckErr(Buf, RoutineName)) return + ! errMsg + call RegUnpack(Buf, OutData%errMsg) + if (RegCheckErr(Buf, RoutineName)) return + ! initialized + call RegUnpack(Buf, OutData%initialized) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine END MODULE AeroDyn_Driver_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/AeroDyn_IO.f90 b/modules/aerodyn/src/AeroDyn_IO.f90 index 6450bbc614..d8cf22afaa 100644 --- a/modules/aerodyn/src/AeroDyn_IO.f90 +++ b/modules/aerodyn/src/AeroDyn_IO.f90 @@ -2405,7 +2405,7 @@ subroutine hpsort_eps_epw (n, ra, ind, eps) implicit none !-input/output variables integer(IntKi), intent(in) :: n - real, intent(in) :: eps + real(ReKi), intent(in) :: eps integer(IntKi) :: ind (n) real(ReKi) :: ra (n) !-local variables diff --git a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 index bad6784950..fa424639b8 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 @@ -250,799 +250,84 @@ SUBROUTINE ADI_DestroyInflowWindData( InflowWindDataData, ErrStat, ErrMsg ) 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) :: 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_PackInflowWindData(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ADI_InflowWindData), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_PackInflowWindData' + if (Buf%ErrStat >= AbortErrLev) return + ! x + call InflowWind_PackContState(Buf, InData%x) + if (RegCheckErr(Buf, RoutineName)) return + ! xd + call InflowWind_PackDiscState(Buf, InData%xd) + if (RegCheckErr(Buf, RoutineName)) return + ! z + call InflowWind_PackConstrState(Buf, InData%z) + if (RegCheckErr(Buf, RoutineName)) return + ! OtherSt + call InflowWind_PackOtherState(Buf, InData%OtherSt) + if (RegCheckErr(Buf, RoutineName)) return + ! p + call InflowWind_PackParam(Buf, InData%p) + if (RegCheckErr(Buf, RoutineName)) return + ! m + call InflowWind_PackMisc(Buf, InData%m) + if (RegCheckErr(Buf, RoutineName)) return + ! u + call InflowWind_PackInput(Buf, InData%u) + if (RegCheckErr(Buf, RoutineName)) return + ! y + call InflowWind_PackOutput(Buf, InData%y) + if (RegCheckErr(Buf, RoutineName)) return + ! CompInflow + call RegPack(Buf, InData%CompInflow) + if (RegCheckErr(Buf, RoutineName)) return + ! HWindSpeed + call RegPack(Buf, InData%HWindSpeed) + if (RegCheckErr(Buf, RoutineName)) return + ! RefHt + call RegPack(Buf, InData%RefHt) + if (RegCheckErr(Buf, RoutineName)) return + ! PLExp + call RegPack(Buf, InData%PLExp) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ADI_UnPackInflowWindData(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ADI_InflowWindData), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_UnPackInflowWindData' + if (Buf%ErrStat /= ErrID_None) return + ! x + call InflowWind_UnpackContState(Buf, OutData%x) ! x + ! xd + call InflowWind_UnpackDiscState(Buf, OutData%xd) ! xd + ! z + call InflowWind_UnpackConstrState(Buf, OutData%z) ! z + ! OtherSt + call InflowWind_UnpackOtherState(Buf, OutData%OtherSt) ! OtherSt + ! p + call InflowWind_UnpackParam(Buf, OutData%p) ! p + ! m + call InflowWind_UnpackMisc(Buf, OutData%m) ! m + ! u + call InflowWind_UnpackInput(Buf, OutData%u) ! u + ! y + call InflowWind_UnpackOutput(Buf, OutData%y) ! y + ! CompInflow + call RegUnpack(Buf, OutData%CompInflow) + if (RegCheckErr(Buf, RoutineName)) return + ! HWindSpeed + call RegUnpack(Buf, OutData%HWindSpeed) + if (RegCheckErr(Buf, RoutineName)) return + ! RefHt + call RegUnpack(Buf, OutData%RefHt) + if (RegCheckErr(Buf, RoutineName)) return + ! PLExp + call RegUnpack(Buf, OutData%PLExp) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE ADI_CopyIW_InputData( SrcIW_InputDataData, DstIW_InputDataData, CtrlCode, ErrStat, ErrMsg ) TYPE(ADI_IW_InputData), INTENT(IN) :: SrcIW_InputDataData TYPE(ADI_IW_InputData), INTENT(INOUT) :: DstIW_InputDataData @@ -1087,228 +372,73 @@ SUBROUTINE ADI_DestroyIW_InputData( IW_InputDataData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE ADI_DestroyIW_InputData - SUBROUTINE ADI_PackIW_InputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ADI_IW_InputData), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ADI_PackIW_InputData' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%InputFile) ! InputFile - Int_BufSz = Int_BufSz + 1 ! CompInflow - Re_BufSz = Re_BufSz + 1 ! HWindSpeed - Re_BufSz = Re_BufSz + 1 ! RefHt - Re_BufSz = Re_BufSz + 1 ! PLExp - Int_BufSz = Int_BufSz + 1 ! MHK - Int_BufSz = Int_BufSz + 1 ! UseInputFile - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! PassedFileData: size of buffers for each call to pack subtype - CALL NWTC_Library_PackFileInfoType( Re_Buf, Db_Buf, Int_Buf, InData%PassedFileData, ErrStat2, ErrMsg2, .TRUE. ) ! PassedFileData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PassedFileData - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PassedFileData - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PassedFileData - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Linearize - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%CompInflow - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HWindSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RefHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PLExp - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MHK - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseInputFile, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - CALL NWTC_Library_PackFileInfoType( Re_Buf, Db_Buf, Int_Buf, InData%PassedFileData, ErrStat2, ErrMsg2, OnlySize ) ! PassedFileData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE ADI_PackIW_InputData - - SUBROUTINE ADI_UnPackIW_InputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ADI_IW_InputData), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ADI_UnPackIW_InputData' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%CompInflow = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%HWindSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RefHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PLExp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MHK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UseInputFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseInputFile) - Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackFileInfoType( Re_Buf, Db_Buf, Int_Buf, OutData%PassedFileData, ErrStat2, ErrMsg2 ) ! PassedFileData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE ADI_UnPackIW_InputData +subroutine ADI_PackIW_InputData(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ADI_IW_InputData), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_PackIW_InputData' + if (Buf%ErrStat >= AbortErrLev) return + ! InputFile + call RegPack(Buf, InData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! CompInflow + call RegPack(Buf, InData%CompInflow) + if (RegCheckErr(Buf, RoutineName)) return + ! HWindSpeed + call RegPack(Buf, InData%HWindSpeed) + if (RegCheckErr(Buf, RoutineName)) return + ! RefHt + call RegPack(Buf, InData%RefHt) + if (RegCheckErr(Buf, RoutineName)) return + ! PLExp + call RegPack(Buf, InData%PLExp) + if (RegCheckErr(Buf, RoutineName)) return + ! MHK + call RegPack(Buf, InData%MHK) + if (RegCheckErr(Buf, RoutineName)) return + ! UseInputFile + call RegPack(Buf, InData%UseInputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! PassedFileData + call NWTC_Library_PackFileInfoType(Buf, InData%PassedFileData) + if (RegCheckErr(Buf, RoutineName)) return + ! Linearize + call RegPack(Buf, InData%Linearize) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ADI_UnPackIW_InputData(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ADI_IW_InputData), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_UnPackIW_InputData' + if (Buf%ErrStat /= ErrID_None) return + ! InputFile + call RegUnpack(Buf, OutData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! CompInflow + call RegUnpack(Buf, OutData%CompInflow) + if (RegCheckErr(Buf, RoutineName)) return + ! HWindSpeed + call RegUnpack(Buf, OutData%HWindSpeed) + if (RegCheckErr(Buf, RoutineName)) return + ! RefHt + call RegUnpack(Buf, OutData%RefHt) + if (RegCheckErr(Buf, RoutineName)) return + ! PLExp + call RegUnpack(Buf, OutData%PLExp) + if (RegCheckErr(Buf, RoutineName)) return + ! MHK + call RegUnpack(Buf, OutData%MHK) + if (RegCheckErr(Buf, RoutineName)) return + ! UseInputFile + call RegUnpack(Buf, OutData%UseInputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! PassedFileData + call NWTC_Library_UnpackFileInfoType(Buf, OutData%PassedFileData) ! PassedFileData + ! Linearize + call RegUnpack(Buf, OutData%Linearize) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE ADI_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(ADI_InitInputType), INTENT(IN) :: SrcInitInputData TYPE(ADI_InitInputType), INTENT(INOUT) :: DstInitInputData @@ -1355,298 +485,60 @@ SUBROUTINE ADI_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE ADI_DestroyInitInput - SUBROUTINE ADI_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ADI_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ADI_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! AD: size of buffers for each call to pack subtype - CALL AD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, .TRUE. ) ! AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! IW_InitInp: size of buffers for each call to pack subtype - CALL ADI_PackIW_InputData( Re_Buf, Db_Buf, Int_Buf, InData%IW_InitInp, ErrStat2, ErrMsg2, .TRUE. ) ! IW_InitInp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IW_InitInp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IW_InitInp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IW_InitInp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1 ! storeHHVel - Int_BufSz = Int_BufSz + 1 ! WrVTK - Int_BufSz = Int_BufSz + 1 ! WrVTK_Type - Re_BufSz = Re_BufSz + 1 ! WtrDpth - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL AD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, OnlySize ) ! AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL ADI_PackIW_InputData( Re_Buf, Db_Buf, Int_Buf, InData%IW_InitInp, ErrStat2, ErrMsg2, OnlySize ) ! IW_InitInp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%storeHHVel, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WrVTK - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WrVTK_Type - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ADI_PackInitInput - - SUBROUTINE ADI_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ADI_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ADI_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%AD, ErrStat2, ErrMsg2 ) ! AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ADI_UnpackIW_InputData( Re_Buf, Db_Buf, Int_Buf, OutData%IW_InitInp, ErrStat2, ErrMsg2 ) ! IW_InitInp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%storeHHVel = TRANSFER(IntKiBuf(Int_Xferred), OutData%storeHHVel) - Int_Xferred = Int_Xferred + 1 - OutData%WrVTK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WrVTK_Type = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ADI_UnPackInitInput +subroutine ADI_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ADI_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + ! AD + call AD_PackInitInput(Buf, InData%AD) + if (RegCheckErr(Buf, RoutineName)) return + ! IW_InitInp + call ADI_PackIW_InputData(Buf, InData%IW_InitInp) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegPack(Buf, InData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! storeHHVel + call RegPack(Buf, InData%storeHHVel) + if (RegCheckErr(Buf, RoutineName)) return + ! WrVTK + call RegPack(Buf, InData%WrVTK) + if (RegCheckErr(Buf, RoutineName)) return + ! WrVTK_Type + call RegPack(Buf, InData%WrVTK_Type) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDpth + call RegPack(Buf, InData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ADI_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ADI_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_UnPackInitInput' + if (Buf%ErrStat /= ErrID_None) return + ! AD + call AD_UnpackInitInput(Buf, OutData%AD) ! AD + ! IW_InitInp + call ADI_UnpackIW_InputData(Buf, OutData%IW_InitInp) ! IW_InitInp + ! RootName + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! storeHHVel + call RegUnpack(Buf, OutData%storeHHVel) + if (RegCheckErr(Buf, RoutineName)) return + ! WrVTK + call RegUnpack(Buf, OutData%WrVTK) + if (RegCheckErr(Buf, RoutineName)) return + ! WrVTK_Type + call RegUnpack(Buf, OutData%WrVTK_Type) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDpth + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE ADI_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(ADI_InitOutputType), INTENT(IN) :: SrcInitOutputData TYPE(ADI_InitOutputType), INTENT(INOUT) :: DstInitOutputData @@ -1714,269 +606,72 @@ SUBROUTINE ADI_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) 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_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ADI_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! Ver + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutputHdr + call RegPack(Buf, allocated(InData%WriteOutputHdr)) + if (allocated(InData%WriteOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPack(Buf, InData%WriteOutputHdr) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutputUnt + call RegPack(Buf, allocated(InData%WriteOutputUnt)) + if (allocated(InData%WriteOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPack(Buf, InData%WriteOutputUnt) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ADI_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ADI_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_UnPackInitOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! Ver + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + ! WriteOutputHdr + if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WriteOutputUnt + if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE ADI_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(ADI_ContinuousStateType), INTENT(IN) :: SrcContStateData TYPE(ADI_ContinuousStateType), INTENT(INOUT) :: DstContStateData @@ -2013,184 +708,25 @@ SUBROUTINE ADI_DestroyContState( ContStateData, ErrStat, ErrMsg ) 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_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ADI_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + ! AD + call AD_PackContState(Buf, InData%AD) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ADI_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ADI_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_UnPackContState' + if (Buf%ErrStat /= ErrID_None) return + ! AD + call AD_UnpackContState(Buf, OutData%AD) ! AD +end subroutine SUBROUTINE ADI_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(ADI_DiscreteStateType), INTENT(IN) :: SrcDiscStateData TYPE(ADI_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData @@ -2227,184 +763,25 @@ SUBROUTINE ADI_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) 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_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ADI_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + ! AD + call AD_PackDiscState(Buf, InData%AD) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ADI_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ADI_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_UnPackDiscState' + if (Buf%ErrStat /= ErrID_None) return + ! AD + call AD_UnpackDiscState(Buf, OutData%AD) ! AD +end subroutine SUBROUTINE ADI_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(ADI_ConstraintStateType), INTENT(IN) :: SrcConstrStateData TYPE(ADI_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData @@ -2441,184 +818,25 @@ SUBROUTINE ADI_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) 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_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ADI_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + ! AD + call AD_PackConstrState(Buf, InData%AD) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ADI_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ADI_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + ! AD + call AD_UnpackConstrState(Buf, OutData%AD) ! AD +end subroutine SUBROUTINE ADI_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(ADI_OtherStateType), INTENT(IN) :: SrcOtherStateData TYPE(ADI_OtherStateType), INTENT(INOUT) :: DstOtherStateData @@ -2655,184 +873,25 @@ SUBROUTINE ADI_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) 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_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ADI_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_PackOtherState' + if (Buf%ErrStat >= AbortErrLev) return + ! AD + call AD_PackOtherState(Buf, InData%AD) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ADI_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ADI_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_UnPackOtherState' + if (Buf%ErrStat /= ErrID_None) return + ! AD + call AD_UnpackOtherState(Buf, OutData%AD) ! AD +end subroutine SUBROUTINE ADI_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) TYPE(ADI_MiscVarType), INTENT(INOUT) :: SrcMiscData TYPE(ADI_MiscVarType), INTENT(INOUT) :: DstMiscData @@ -2898,390 +957,63 @@ SUBROUTINE ADI_DestroyMisc( MiscData, ErrStat, ErrMsg ) 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_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ADI_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_PackMisc' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! AD + call AD_PackMisc(Buf, InData%AD) + if (RegCheckErr(Buf, RoutineName)) return + ! IW + call ADI_PackInflowWindData(Buf, InData%IW) + if (RegCheckErr(Buf, RoutineName)) return + ! VTK_surfaces + call RegPack(Buf, allocated(InData%VTK_surfaces)) + if (allocated(InData%VTK_surfaces)) then + call RegPackBounds(Buf, 1, lbound(InData%VTK_surfaces), ubound(InData%VTK_surfaces)) + LB(1:1) = lbound(InData%VTK_surfaces) + UB(1:1) = ubound(InData%VTK_surfaces) + do i1 = LB(1), UB(1) + call AD_PackVTK_RotSurfaceType(Buf, InData%VTK_surfaces(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ADI_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ADI_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_UnPackMisc' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! AD + call AD_UnpackMisc(Buf, OutData%AD) ! AD + ! IW + call ADI_UnpackInflowWindData(Buf, OutData%IW) ! IW + ! VTK_surfaces + if (allocated(OutData%VTK_surfaces)) deallocate(OutData%VTK_surfaces) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%VTK_surfaces(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VTK_surfaces.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackVTK_RotSurfaceType(Buf, OutData%VTK_surfaces(i1)) ! VTK_surfaces + end do + end if +end subroutine SUBROUTINE ADI_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(ADI_ParameterType), INTENT(IN) :: SrcParamData TYPE(ADI_ParameterType), INTENT(INOUT) :: DstParamData @@ -3325,219 +1057,67 @@ SUBROUTINE ADI_DestroyParam( ParamData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE ADI_DestroyParam - SUBROUTINE ADI_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ADI_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ADI_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! AD: size of buffers for each call to pack subtype - CALL AD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, .TRUE. ) ! AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Db_BufSz = Db_BufSz + 1 ! dt - Int_BufSz = Int_BufSz + 1 ! storeHHVel - Int_BufSz = Int_BufSz + 1 ! wrVTK - Int_BufSz = Int_BufSz + 1 ! WrVTK_Type - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! MHK - Re_BufSz = Re_BufSz + 1 ! WtrDpth - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL AD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, OnlySize ) ! AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - DbKiBuf(Db_Xferred) = InData%dt - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%storeHHVel, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%wrVTK - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WrVTK_Type - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MHK - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ADI_PackParam - - SUBROUTINE ADI_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ADI_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ADI_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%AD, ErrStat2, ErrMsg2 ) ! AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%dt = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%storeHHVel = TRANSFER(IntKiBuf(Int_Xferred), OutData%storeHHVel) - Int_Xferred = Int_Xferred + 1 - OutData%wrVTK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WrVTK_Type = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MHK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ADI_UnPackParam +subroutine ADI_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ADI_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_PackParam' + if (Buf%ErrStat >= AbortErrLev) return + ! AD + call AD_PackParam(Buf, InData%AD) + if (RegCheckErr(Buf, RoutineName)) return + ! dt + call RegPack(Buf, InData%dt) + if (RegCheckErr(Buf, RoutineName)) return + ! storeHHVel + call RegPack(Buf, InData%storeHHVel) + if (RegCheckErr(Buf, RoutineName)) return + ! wrVTK + call RegPack(Buf, InData%wrVTK) + if (RegCheckErr(Buf, RoutineName)) return + ! WrVTK_Type + call RegPack(Buf, InData%WrVTK_Type) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegPack(Buf, InData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! MHK + call RegPack(Buf, InData%MHK) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDpth + call RegPack(Buf, InData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ADI_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ADI_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_UnPackParam' + if (Buf%ErrStat /= ErrID_None) return + ! AD + call AD_UnpackParam(Buf, OutData%AD) ! AD + ! dt + call RegUnpack(Buf, OutData%dt) + if (RegCheckErr(Buf, RoutineName)) return + ! storeHHVel + call RegUnpack(Buf, OutData%storeHHVel) + if (RegCheckErr(Buf, RoutineName)) return + ! wrVTK + call RegUnpack(Buf, OutData%wrVTK) + if (RegCheckErr(Buf, RoutineName)) return + ! WrVTK_Type + call RegUnpack(Buf, OutData%WrVTK_Type) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! MHK + call RegUnpack(Buf, OutData%MHK) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDpth + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE ADI_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(ADI_InputType), INTENT(INOUT) :: SrcInputData TYPE(ADI_InputType), INTENT(INOUT) :: DstInputData @@ -3574,184 +1154,25 @@ SUBROUTINE ADI_DestroyInput( InputData, ErrStat, ErrMsg ) 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_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ADI_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + ! AD + call AD_PackInput(Buf, InData%AD) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ADI_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ADI_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_UnPackInput' + if (Buf%ErrStat /= ErrID_None) return + ! AD + call AD_UnpackInput(Buf, OutData%AD) ! AD +end subroutine SUBROUTINE ADI_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(ADI_OutputType), INTENT(INOUT) :: SrcOutputData TYPE(ADI_OutputType), INTENT(INOUT) :: DstOutputData @@ -3838,315 +1259,100 @@ SUBROUTINE ADI_DestroyOutput( OutputData, ErrStat, ErrMsg ) 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_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ADI_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! AD + call AD_PackOutput(Buf, InData%AD) + if (RegCheckErr(Buf, RoutineName)) return + ! HHVel + call RegPack(Buf, allocated(InData%HHVel)) + if (allocated(InData%HHVel)) then + call RegPackBounds(Buf, 2, lbound(InData%HHVel), ubound(InData%HHVel)) + call RegPack(Buf, InData%HHVel) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PLExp + call RegPack(Buf, InData%PLExp) + if (RegCheckErr(Buf, RoutineName)) return + ! IW_WriteOutput + call RegPack(Buf, allocated(InData%IW_WriteOutput)) + if (allocated(InData%IW_WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%IW_WriteOutput), ubound(InData%IW_WriteOutput)) + call RegPack(Buf, InData%IW_WriteOutput) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutput + call RegPack(Buf, allocated(InData%WriteOutput)) + if (allocated(InData%WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPack(Buf, InData%WriteOutput) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ADI_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ADI_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_UnPackOutput' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! AD + call AD_UnpackOutput(Buf, OutData%AD) ! AD + ! HHVel + if (allocated(OutData%HHVel)) deallocate(OutData%HHVel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%HHVel(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%HHVel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%HHVel) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PLExp + call RegUnpack(Buf, OutData%PLExp) + if (RegCheckErr(Buf, RoutineName)) return + ! IW_WriteOutput + if (allocated(OutData%IW_WriteOutput)) deallocate(OutData%IW_WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IW_WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IW_WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IW_WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WriteOutput + if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE ADI_CopyData( SrcDataData, DstDataData, CtrlCode, ErrStat, ErrMsg ) TYPE(ADI_Data), INTENT(INOUT) :: SrcDataData TYPE(ADI_Data), INTENT(INOUT) :: DstDataData @@ -4324,993 +1530,198 @@ SUBROUTINE ADI_DestroyData( DataData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE ADI_DestroyData - SUBROUTINE ADI_PackData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ADI_Data), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ADI_PackData' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! x allocated yes/no - IF ( ALLOCATED(InData%x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL ADI_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! xd allocated yes/no - IF ( ALLOCATED(InData%xd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xd upper/lower bounds for each dimension - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL ADI_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! z allocated yes/no - IF ( ALLOCATED(InData%z) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z upper/lower bounds for each dimension - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL ADI_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OtherState allocated yes/no - IF ( ALLOCATED(InData%OtherState) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OtherState upper/lower bounds for each dimension - DO i1 = LBOUND(InData%OtherState,1), UBOUND(InData%OtherState,1) - Int_BufSz = Int_BufSz + 3 ! OtherState: size of buffers for each call to pack subtype - CALL ADI_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherState(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherState - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherState - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherState - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherState - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL ADI_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL ADI_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! u allocated yes/no - IF ( ALLOCATED(InData%u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u,1), UBOUND(InData%u,1) - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL ADI_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL ADI_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! inputTimes allocated yes/no - IF ( ALLOCATED(InData%inputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! inputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%inputTimes) ! inputTimes - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL ADI_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%xd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL ADI_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%z) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL ADI_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OtherState) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherState,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherState,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OtherState,1), UBOUND(InData%OtherState,1) - CALL ADI_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherState(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherState - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL ADI_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL ADI_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u,1), UBOUND(InData%u,1) - CALL ADI_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u(i1), ErrStat2, ErrMsg2, OnlySize ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL ADI_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%inputTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%inputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%inputTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%inputTimes,1), UBOUND(InData%inputTimes,1) - DbKiBuf(Db_Xferred) = InData%inputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE ADI_PackData - - SUBROUTINE ADI_UnPackData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ADI_Data), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ADI_UnPackData' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%x)) DEALLOCATE(OutData%x) - ALLOCATE(OutData%x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ADI_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%xd)) DEALLOCATE(OutData%xd) - ALLOCATE(OutData%xd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ADI_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%z)) DEALLOCATE(OutData%z) - ALLOCATE(OutData%z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ADI_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherState not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OtherState)) DEALLOCATE(OutData%OtherState) - ALLOCATE(OutData%OtherState(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherState.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OtherState,1), UBOUND(OutData%OtherState,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ADI_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherState(i1), ErrStat2, ErrMsg2 ) ! OtherState - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ADI_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ADI_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%u)) DEALLOCATE(OutData%u) - ALLOCATE(OutData%u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u,1), UBOUND(OutData%u,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ADI_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u(i1), ErrStat2, ErrMsg2 ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ADI_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! inputTimes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%inputTimes)) DEALLOCATE(OutData%inputTimes) - ALLOCATE(OutData%inputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%inputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%inputTimes,1), UBOUND(OutData%inputTimes,1) - OutData%inputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE ADI_UnPackData +subroutine ADI_PackData(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ADI_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_PackData' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! x + call RegPack(Buf, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(Buf, 1, lbound(InData%x), ubound(InData%x)) + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call ADI_PackContState(Buf, InData%x(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! xd + call RegPack(Buf, allocated(InData%xd)) + if (allocated(InData%xd)) then + call RegPackBounds(Buf, 1, lbound(InData%xd), ubound(InData%xd)) + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call ADI_PackDiscState(Buf, InData%xd(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! z + call RegPack(Buf, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(Buf, 1, lbound(InData%z), ubound(InData%z)) + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call ADI_PackConstrState(Buf, InData%z(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OtherState + call RegPack(Buf, allocated(InData%OtherState)) + if (allocated(InData%OtherState)) then + call RegPackBounds(Buf, 1, lbound(InData%OtherState), ubound(InData%OtherState)) + LB(1:1) = lbound(InData%OtherState) + UB(1:1) = ubound(InData%OtherState) + do i1 = LB(1), UB(1) + call ADI_PackOtherState(Buf, InData%OtherState(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! p + call ADI_PackParam(Buf, InData%p) + if (RegCheckErr(Buf, RoutineName)) return + ! m + call ADI_PackMisc(Buf, InData%m) + if (RegCheckErr(Buf, RoutineName)) return + ! u + call RegPack(Buf, allocated(InData%u)) + if (allocated(InData%u)) then + call RegPackBounds(Buf, 1, lbound(InData%u), ubound(InData%u)) + LB(1:1) = lbound(InData%u) + UB(1:1) = ubound(InData%u) + do i1 = LB(1), UB(1) + call ADI_PackInput(Buf, InData%u(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! y + call ADI_PackOutput(Buf, InData%y) + if (RegCheckErr(Buf, RoutineName)) return + ! inputTimes + call RegPack(Buf, allocated(InData%inputTimes)) + if (allocated(InData%inputTimes)) then + call RegPackBounds(Buf, 1, lbound(InData%inputTimes), ubound(InData%inputTimes)) + call RegPack(Buf, InData%inputTimes) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ADI_UnPackData(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ADI_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_UnPackData' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! x + if (allocated(OutData%x)) deallocate(OutData%x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ADI_UnpackContState(Buf, OutData%x(i1)) ! x + end do + end if + ! xd + if (allocated(OutData%xd)) deallocate(OutData%xd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ADI_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + end do + end if + ! z + if (allocated(OutData%z)) deallocate(OutData%z) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ADI_UnpackConstrState(Buf, OutData%z(i1)) ! z + end do + end if + ! OtherState + if (allocated(OutData%OtherState)) deallocate(OutData%OtherState) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OtherState(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherState.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ADI_UnpackOtherState(Buf, OutData%OtherState(i1)) ! OtherState + end do + end if + ! p + call ADI_UnpackParam(Buf, OutData%p) ! p + ! m + call ADI_UnpackMisc(Buf, OutData%m) ! m + ! u + if (allocated(OutData%u)) deallocate(OutData%u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ADI_UnpackInput(Buf, OutData%u(i1)) ! u + end do + end if + ! y + call ADI_UnpackOutput(Buf, OutData%y) ! y + ! inputTimes + if (allocated(OutData%inputTimes)) deallocate(OutData%inputTimes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%inputTimes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%inputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%inputTimes) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE ADI_CopyRotFED( SrcRotFEDData, DstRotFEDData, CtrlCode, ErrStat, ErrMsg ) TYPE(RotFED), INTENT(INOUT) :: SrcRotFEDData TYPE(RotFED), INTENT(INOUT) :: DstRotFEDData @@ -5488,1445 +1899,202 @@ SUBROUTINE ADI_DestroyRotFED( RotFEDData, ErrStat, ErrMsg ) 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_PackRotFED(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(RotFED), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_PackRotFED' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! PlatformPtMesh + call MeshPack(Buf, InData%PlatformPtMesh) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrPtMesh + call MeshPack(Buf, InData%TwrPtMesh) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrPtMeshAD + call MeshPack(Buf, InData%TwrPtMeshAD) + if (RegCheckErr(Buf, RoutineName)) return + ! NacelleMotion + call MeshPack(Buf, InData%NacelleMotion) + if (RegCheckErr(Buf, RoutineName)) return + ! HubPtMotion + call MeshPack(Buf, InData%HubPtMotion) + if (RegCheckErr(Buf, RoutineName)) return + ! BladeRootMotion + call RegPack(Buf, allocated(InData%BladeRootMotion)) + if (allocated(InData%BladeRootMotion)) then + call RegPackBounds(Buf, 1, lbound(InData%BladeRootMotion), ubound(InData%BladeRootMotion)) + LB(1:1) = lbound(InData%BladeRootMotion) + UB(1:1) = ubound(InData%BladeRootMotion) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%BladeRootMotion(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BladeLn2Mesh + call RegPack(Buf, allocated(InData%BladeLn2Mesh)) + if (allocated(InData%BladeLn2Mesh)) then + call RegPackBounds(Buf, 1, lbound(InData%BladeLn2Mesh), ubound(InData%BladeLn2Mesh)) + LB(1:1) = lbound(InData%BladeLn2Mesh) + UB(1:1) = ubound(InData%BladeLn2Mesh) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%BladeLn2Mesh(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! hasTower + call RegPack(Buf, InData%hasTower) + if (RegCheckErr(Buf, RoutineName)) return + ! rigidBlades + call RegPack(Buf, InData%rigidBlades) + if (RegCheckErr(Buf, RoutineName)) return + ! numBlades + call RegPack(Buf, InData%numBlades) + if (RegCheckErr(Buf, RoutineName)) return + ! ED_P_2_AD_P_T + call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_AD_P_T) + if (RegCheckErr(Buf, RoutineName)) return + ! AD_P_2_AD_L_T + call NWTC_Library_PackMeshMapType(Buf, InData%AD_P_2_AD_L_T) + if (RegCheckErr(Buf, RoutineName)) return + ! AD_P_2_AD_L_B + call RegPack(Buf, allocated(InData%AD_P_2_AD_L_B)) + if (allocated(InData%AD_P_2_AD_L_B)) then + call RegPackBounds(Buf, 1, lbound(InData%AD_P_2_AD_L_B), ubound(InData%AD_P_2_AD_L_B)) + LB(1:1) = lbound(InData%AD_P_2_AD_L_B) + UB(1:1) = ubound(InData%AD_P_2_AD_L_B) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%AD_P_2_AD_L_B(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ED_P_2_AD_P_TF + call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_AD_P_TF) + if (RegCheckErr(Buf, RoutineName)) return + ! ED_P_2_AD_P_R + call RegPack(Buf, allocated(InData%ED_P_2_AD_P_R)) + if (allocated(InData%ED_P_2_AD_P_R)) then + call RegPackBounds(Buf, 1, lbound(InData%ED_P_2_AD_P_R), ubound(InData%ED_P_2_AD_P_R)) + LB(1:1) = lbound(InData%ED_P_2_AD_P_R) + UB(1:1) = ubound(InData%ED_P_2_AD_P_R) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_AD_P_R(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ED_P_2_AD_P_H + call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_AD_P_H) + if (RegCheckErr(Buf, RoutineName)) return + ! ED_P_2_AD_P_N + call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_AD_P_N) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ADI_UnPackRotFED(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(RotFED), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_UnPackRotFED' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! PlatformPtMesh + call MeshUnpack(Buf, OutData%PlatformPtMesh) ! PlatformPtMesh + ! TwrPtMesh + call MeshUnpack(Buf, OutData%TwrPtMesh) ! TwrPtMesh + ! TwrPtMeshAD + call MeshUnpack(Buf, OutData%TwrPtMeshAD) ! TwrPtMeshAD + ! NacelleMotion + call MeshUnpack(Buf, OutData%NacelleMotion) ! NacelleMotion + ! HubPtMotion + call MeshUnpack(Buf, OutData%HubPtMotion) ! HubPtMotion + ! BladeRootMotion + if (allocated(OutData%BladeRootMotion)) deallocate(OutData%BladeRootMotion) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BladeRootMotion(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootMotion.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%BladeRootMotion(i1)) ! BladeRootMotion + end do + end if + ! BladeLn2Mesh + if (allocated(OutData%BladeLn2Mesh)) deallocate(OutData%BladeLn2Mesh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BladeLn2Mesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeLn2Mesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%BladeLn2Mesh(i1)) ! BladeLn2Mesh + end do + end if + ! hasTower + call RegUnpack(Buf, OutData%hasTower) + if (RegCheckErr(Buf, RoutineName)) return + ! rigidBlades + call RegUnpack(Buf, OutData%rigidBlades) + if (RegCheckErr(Buf, RoutineName)) return + ! numBlades + call RegUnpack(Buf, OutData%numBlades) + if (RegCheckErr(Buf, RoutineName)) return + ! ED_P_2_AD_P_T + call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_AD_P_T) ! ED_P_2_AD_P_T + ! AD_P_2_AD_L_T + call NWTC_Library_UnpackMeshMapType(Buf, OutData%AD_P_2_AD_L_T) ! AD_P_2_AD_L_T + ! AD_P_2_AD_L_B + if (allocated(OutData%AD_P_2_AD_L_B)) deallocate(OutData%AD_P_2_AD_L_B) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AD_P_2_AD_L_B(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AD_P_2_AD_L_B.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%AD_P_2_AD_L_B(i1)) ! AD_P_2_AD_L_B + end do + end if + ! ED_P_2_AD_P_TF + call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_AD_P_TF) ! ED_P_2_AD_P_TF + ! ED_P_2_AD_P_R + if (allocated(OutData%ED_P_2_AD_P_R)) deallocate(OutData%ED_P_2_AD_P_R) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ED_P_2_AD_P_R(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_AD_P_R.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_AD_P_R(i1)) ! ED_P_2_AD_P_R + end do + end if + ! ED_P_2_AD_P_H + call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_AD_P_H) ! ED_P_2_AD_P_H + ! ED_P_2_AD_P_N + call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_AD_P_N) ! ED_P_2_AD_P_N +end subroutine SUBROUTINE ADI_CopyFED_Data( SrcFED_DataData, DstFED_DataData, CtrlCode, ErrStat, ErrMsg ) TYPE(FED_Data), INTENT(INOUT) :: SrcFED_DataData TYPE(FED_Data), INTENT(INOUT) :: DstFED_DataData @@ -6982,219 +2150,52 @@ SUBROUTINE ADI_DestroyFED_Data( FED_DataData, ErrStat, ErrMsg ) 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_PackFED_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FED_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'ADI_PackFED_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! WT + call RegPack(Buf, allocated(InData%WT)) + if (allocated(InData%WT)) then + call RegPackBounds(Buf, 1, lbound(InData%WT), ubound(InData%WT)) + LB(1:1) = lbound(InData%WT) + UB(1:1) = ubound(InData%WT) + do i1 = LB(1), UB(1) + call ADI_PackRotFED(Buf, InData%WT(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ADI_UnPackFED_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FED_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ADI_UnPackFED_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! WT + if (allocated(OutData%WT)) deallocate(OutData%WT) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WT(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ADI_UnpackRotFED(Buf, OutData%WT(i1)) ! WT + end do + end if +end subroutine END MODULE AeroDyn_Inflow_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index 230a66c3f4..e59b4a8e5f 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -523,123 +523,50 @@ SUBROUTINE AD_DestroyTFinParameterType( TFinParameterTypeData, ErrStat, ErrMsg ) END SUBROUTINE AD_DestroyTFinParameterType - SUBROUTINE AD_PackTFinParameterType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(TFinParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_PackTFinParameterType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! TFinMod - Re_BufSz = Re_BufSz + 1 ! TFinChord - Re_BufSz = Re_BufSz + 1 ! TFinArea - Int_BufSz = Int_BufSz + 1 ! TFinIndMod - Int_BufSz = Int_BufSz + 1 ! TFinAFID - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%TFinMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFinChord - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFinArea - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TFinIndMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TFinAFID - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD_PackTFinParameterType - - SUBROUTINE AD_UnPackTFinParameterType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(TFinParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackTFinParameterType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%TFinMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TFinChord = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFinArea = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFinIndMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TFinAFID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD_UnPackTFinParameterType +subroutine AD_PackTFinParameterType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(TFinParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackTFinParameterType' + if (Buf%ErrStat >= AbortErrLev) return + ! TFinMod + call RegPack(Buf, InData%TFinMod) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinChord + call RegPack(Buf, InData%TFinChord) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinArea + call RegPack(Buf, InData%TFinArea) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinIndMod + call RegPack(Buf, InData%TFinIndMod) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinAFID + call RegPack(Buf, InData%TFinAFID) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackTFinParameterType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(TFinParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackTFinParameterType' + if (Buf%ErrStat /= ErrID_None) return + ! TFinMod + call RegUnpack(Buf, OutData%TFinMod) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinChord + call RegUnpack(Buf, OutData%TFinChord) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinArea + call RegUnpack(Buf, OutData%TFinArea) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinIndMod + call RegUnpack(Buf, OutData%TFinIndMod) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinAFID + call RegUnpack(Buf, OutData%TFinAFID) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE AD_CopyTFinInputFileType( SrcTFinInputFileTypeData, DstTFinInputFileTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(TFinInputFileType), INTENT(IN) :: SrcTFinInputFileTypeData TYPE(TFinInputFileType), INTENT(INOUT) :: DstTFinInputFileTypeData @@ -679,146 +606,62 @@ SUBROUTINE AD_DestroyTFinInputFileType( TFinInputFileTypeData, ErrStat, ErrMsg ) END SUBROUTINE AD_DestroyTFinInputFileType - SUBROUTINE AD_PackTFinInputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(TFinInputFileType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_PackTFinInputFileType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! TFinMod - Re_BufSz = Re_BufSz + 1 ! TFinChord - Re_BufSz = Re_BufSz + 1 ! TFinArea - Re_BufSz = Re_BufSz + SIZE(InData%TFinRefP_n) ! TFinRefP_n - Re_BufSz = Re_BufSz + SIZE(InData%TFinAngles) ! TFinAngles - Int_BufSz = Int_BufSz + 1 ! TFinIndMod - Int_BufSz = Int_BufSz + 1 ! TFinAFID - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%TFinMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFinChord - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFinArea - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%TFinRefP_n,1), UBOUND(InData%TFinRefP_n,1) - ReKiBuf(Re_Xferred) = InData%TFinRefP_n(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TFinAngles,1), UBOUND(InData%TFinAngles,1) - ReKiBuf(Re_Xferred) = InData%TFinAngles(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%TFinIndMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TFinAFID - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD_PackTFinInputFileType - - SUBROUTINE AD_UnPackTFinInputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(TFinInputFileType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackTFinInputFileType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%TFinMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TFinChord = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFinArea = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%TFinRefP_n,1) - i1_u = UBOUND(OutData%TFinRefP_n,1) - DO i1 = LBOUND(OutData%TFinRefP_n,1), UBOUND(OutData%TFinRefP_n,1) - OutData%TFinRefP_n(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TFinAngles,1) - i1_u = UBOUND(OutData%TFinAngles,1) - DO i1 = LBOUND(OutData%TFinAngles,1), UBOUND(OutData%TFinAngles,1) - OutData%TFinAngles(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%TFinIndMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TFinAFID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD_UnPackTFinInputFileType +subroutine AD_PackTFinInputFileType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(TFinInputFileType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackTFinInputFileType' + if (Buf%ErrStat >= AbortErrLev) return + ! TFinMod + call RegPack(Buf, InData%TFinMod) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinChord + call RegPack(Buf, InData%TFinChord) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinArea + call RegPack(Buf, InData%TFinArea) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinRefP_n + call RegPack(Buf, InData%TFinRefP_n) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinAngles + call RegPack(Buf, InData%TFinAngles) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinIndMod + call RegPack(Buf, InData%TFinIndMod) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinAFID + call RegPack(Buf, InData%TFinAFID) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackTFinInputFileType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(TFinInputFileType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackTFinInputFileType' + if (Buf%ErrStat /= ErrID_None) return + ! TFinMod + call RegUnpack(Buf, OutData%TFinMod) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinChord + call RegUnpack(Buf, OutData%TFinChord) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinArea + call RegUnpack(Buf, OutData%TFinArea) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinRefP_n + call RegUnpack(Buf, OutData%TFinRefP_n) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinAngles + call RegUnpack(Buf, OutData%TFinAngles) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinIndMod + call RegUnpack(Buf, OutData%TFinIndMod) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinAFID + call RegUnpack(Buf, OutData%TFinAFID) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE AD_CopyVTK_BLSurfaceType( SrcVTK_BLSurfaceTypeData, DstVTK_BLSurfaceTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(AD_VTK_BLSurfaceType), INTENT(IN) :: SrcVTK_BLSurfaceTypeData TYPE(AD_VTK_BLSurfaceType), INTENT(INOUT) :: DstVTK_BLSurfaceTypeData @@ -872,159 +715,45 @@ SUBROUTINE AD_DestroyVTK_BLSurfaceType( VTK_BLSurfaceTypeData, ErrStat, ErrMsg ) 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_PackVTK_BLSurfaceType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD_VTK_BLSurfaceType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackVTK_BLSurfaceType' + if (Buf%ErrStat >= AbortErrLev) return + ! AirfoilCoords + call RegPack(Buf, allocated(InData%AirfoilCoords)) + if (allocated(InData%AirfoilCoords)) then + call RegPackBounds(Buf, 3, lbound(InData%AirfoilCoords), ubound(InData%AirfoilCoords)) + call RegPack(Buf, InData%AirfoilCoords) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackVTK_BLSurfaceType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD_VTK_BLSurfaceType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackVTK_BLSurfaceType' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! AirfoilCoords + if (allocated(OutData%AirfoilCoords)) deallocate(OutData%AirfoilCoords) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AirfoilCoords(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AirfoilCoords.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AirfoilCoords) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE AD_CopyVTK_RotSurfaceType( SrcVTK_RotSurfaceTypeData, DstVTK_RotSurfaceTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(AD_VTK_RotSurfaceType), INTENT(IN) :: SrcVTK_RotSurfaceTypeData TYPE(AD_VTK_RotSurfaceType), INTENT(INOUT) :: DstVTK_RotSurfaceTypeData @@ -1095,258 +824,75 @@ SUBROUTINE AD_DestroyVTK_RotSurfaceType( VTK_RotSurfaceTypeData, ErrStat, ErrMsg 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_PackVTK_RotSurfaceType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD_VTK_RotSurfaceType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackVTK_RotSurfaceType' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! BladeShape + call RegPack(Buf, allocated(InData%BladeShape)) + if (allocated(InData%BladeShape)) then + call RegPackBounds(Buf, 1, lbound(InData%BladeShape), ubound(InData%BladeShape)) + LB(1:1) = lbound(InData%BladeShape) + UB(1:1) = ubound(InData%BladeShape) + do i1 = LB(1), UB(1) + call AD_PackVTK_BLSurfaceType(Buf, InData%BladeShape(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TowerRad + call RegPack(Buf, allocated(InData%TowerRad)) + if (allocated(InData%TowerRad)) then + call RegPackBounds(Buf, 1, lbound(InData%TowerRad), ubound(InData%TowerRad)) + call RegPack(Buf, InData%TowerRad) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackVTK_RotSurfaceType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD_VTK_RotSurfaceType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackVTK_RotSurfaceType' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! BladeShape + if (allocated(OutData%BladeShape)) deallocate(OutData%BladeShape) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BladeShape(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeShape.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackVTK_BLSurfaceType(Buf, OutData%BladeShape(i1)) ! BladeShape + end do + end if + ! TowerRad + if (allocated(OutData%TowerRad)) deallocate(OutData%TowerRad) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TowerRad(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TowerRad.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TowerRad) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE AD_CopyRotInitInputType( SrcRotInitInputTypeData, DstRotInitInputTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(RotInitInputType), INTENT(IN) :: SrcRotInitInputTypeData TYPE(RotInitInputType), INTENT(INOUT) :: DstRotInitInputTypeData @@ -1424,278 +970,109 @@ SUBROUTINE AD_DestroyRotInitInputType( RotInitInputTypeData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE AD_DestroyRotInitInputType - SUBROUTINE AD_PackRotInitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(RotInitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_PackRotInitInputType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! NumBlades - Re_BufSz = Re_BufSz + SIZE(InData%HubPosition) ! HubPosition - Db_BufSz = Db_BufSz + SIZE(InData%HubOrientation) ! HubOrientation - Int_BufSz = Int_BufSz + 1 ! BladeRootPosition allocated yes/no - IF ( ALLOCATED(InData%BladeRootPosition) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BladeRootPosition upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BladeRootPosition) ! BladeRootPosition - END IF - Int_BufSz = Int_BufSz + 1 ! BladeRootOrientation allocated yes/no - IF ( ALLOCATED(InData%BladeRootOrientation) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! BladeRootOrientation upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%BladeRootOrientation) ! BladeRootOrientation - END IF - Db_BufSz = Db_BufSz + SIZE(InData%NacellePosition) ! NacellePosition - Db_BufSz = Db_BufSz + SIZE(InData%NacelleOrientation) ! NacelleOrientation - Int_BufSz = Int_BufSz + 1 ! AeroProjMod - Int_BufSz = Int_BufSz + 1 ! AeroBEM_Mod - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%NumBlades - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%HubPosition,1), UBOUND(InData%HubPosition,1) - ReKiBuf(Re_Xferred) = InData%HubPosition(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i2 = LBOUND(InData%HubOrientation,2), UBOUND(InData%HubOrientation,2) - DO i1 = LBOUND(InData%HubOrientation,1), UBOUND(InData%HubOrientation,1) - DbKiBuf(Db_Xferred) = InData%HubOrientation(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - IF ( .NOT. ALLOCATED(InData%BladeRootPosition) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootPosition,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootPosition,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootPosition,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootPosition,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BladeRootPosition,2), UBOUND(InData%BladeRootPosition,2) - DO i1 = LBOUND(InData%BladeRootPosition,1), UBOUND(InData%BladeRootPosition,1) - ReKiBuf(Re_Xferred) = InData%BladeRootPosition(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BladeRootOrientation) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootOrientation,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootOrientation,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootOrientation,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootOrientation,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootOrientation,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootOrientation,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%BladeRootOrientation,3), UBOUND(InData%BladeRootOrientation,3) - DO i2 = LBOUND(InData%BladeRootOrientation,2), UBOUND(InData%BladeRootOrientation,2) - DO i1 = LBOUND(InData%BladeRootOrientation,1), UBOUND(InData%BladeRootOrientation,1) - DbKiBuf(Db_Xferred) = InData%BladeRootOrientation(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%NacellePosition,1), UBOUND(InData%NacellePosition,1) - DbKiBuf(Db_Xferred) = InData%NacellePosition(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i2 = LBOUND(InData%NacelleOrientation,2), UBOUND(InData%NacelleOrientation,2) - DO i1 = LBOUND(InData%NacelleOrientation,1), UBOUND(InData%NacelleOrientation,1) - DbKiBuf(Db_Xferred) = InData%NacelleOrientation(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - IntKiBuf(Int_Xferred) = InData%AeroProjMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%AeroBEM_Mod - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD_PackRotInitInputType - - SUBROUTINE AD_UnPackRotInitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(RotInitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackRotInitInputType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%NumBlades = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%HubPosition,1) - i1_u = UBOUND(OutData%HubPosition,1) - DO i1 = LBOUND(OutData%HubPosition,1), UBOUND(OutData%HubPosition,1) - OutData%HubPosition(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%HubOrientation,1) - i1_u = UBOUND(OutData%HubOrientation,1) - i2_l = LBOUND(OutData%HubOrientation,2) - i2_u = UBOUND(OutData%HubOrientation,2) - DO i2 = LBOUND(OutData%HubOrientation,2), UBOUND(OutData%HubOrientation,2) - DO i1 = LBOUND(OutData%HubOrientation,1), UBOUND(OutData%HubOrientation,1) - OutData%HubOrientation(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeRootPosition not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BladeRootPosition)) DEALLOCATE(OutData%BladeRootPosition) - ALLOCATE(OutData%BladeRootPosition(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootPosition.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BladeRootPosition,2), UBOUND(OutData%BladeRootPosition,2) - DO i1 = LBOUND(OutData%BladeRootPosition,1), UBOUND(OutData%BladeRootPosition,1) - OutData%BladeRootPosition(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeRootOrientation not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BladeRootOrientation)) DEALLOCATE(OutData%BladeRootOrientation) - ALLOCATE(OutData%BladeRootOrientation(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootOrientation.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%BladeRootOrientation,3), UBOUND(OutData%BladeRootOrientation,3) - DO i2 = LBOUND(OutData%BladeRootOrientation,2), UBOUND(OutData%BladeRootOrientation,2) - DO i1 = LBOUND(OutData%BladeRootOrientation,1), UBOUND(OutData%BladeRootOrientation,1) - OutData%BladeRootOrientation(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%NacellePosition,1) - i1_u = UBOUND(OutData%NacellePosition,1) - DO i1 = LBOUND(OutData%NacellePosition,1), UBOUND(OutData%NacellePosition,1) - OutData%NacellePosition(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%NacelleOrientation,1) - i1_u = UBOUND(OutData%NacelleOrientation,1) - i2_l = LBOUND(OutData%NacelleOrientation,2) - i2_u = UBOUND(OutData%NacelleOrientation,2) - DO i2 = LBOUND(OutData%NacelleOrientation,2), UBOUND(OutData%NacelleOrientation,2) - DO i1 = LBOUND(OutData%NacelleOrientation,1), UBOUND(OutData%NacelleOrientation,1) - OutData%NacelleOrientation(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - OutData%AeroProjMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%AeroBEM_Mod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD_UnPackRotInitInputType +subroutine AD_PackRotInitInputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(RotInitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackRotInitInputType' + if (Buf%ErrStat >= AbortErrLev) return + ! NumBlades + call RegPack(Buf, InData%NumBlades) + if (RegCheckErr(Buf, RoutineName)) return + ! HubPosition + call RegPack(Buf, InData%HubPosition) + if (RegCheckErr(Buf, RoutineName)) return + ! HubOrientation + call RegPack(Buf, InData%HubOrientation) + if (RegCheckErr(Buf, RoutineName)) return + ! BladeRootPosition + call RegPack(Buf, allocated(InData%BladeRootPosition)) + if (allocated(InData%BladeRootPosition)) then + call RegPackBounds(Buf, 2, lbound(InData%BladeRootPosition), ubound(InData%BladeRootPosition)) + call RegPack(Buf, InData%BladeRootPosition) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BladeRootOrientation + call RegPack(Buf, allocated(InData%BladeRootOrientation)) + if (allocated(InData%BladeRootOrientation)) then + call RegPackBounds(Buf, 3, lbound(InData%BladeRootOrientation), ubound(InData%BladeRootOrientation)) + call RegPack(Buf, InData%BladeRootOrientation) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NacellePosition + call RegPack(Buf, InData%NacellePosition) + if (RegCheckErr(Buf, RoutineName)) return + ! NacelleOrientation + call RegPack(Buf, InData%NacelleOrientation) + if (RegCheckErr(Buf, RoutineName)) return + ! AeroProjMod + call RegPack(Buf, InData%AeroProjMod) + if (RegCheckErr(Buf, RoutineName)) return + ! AeroBEM_Mod + call RegPack(Buf, InData%AeroBEM_Mod) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackRotInitInputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(RotInitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackRotInitInputType' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! NumBlades + call RegUnpack(Buf, OutData%NumBlades) + if (RegCheckErr(Buf, RoutineName)) return + ! HubPosition + call RegUnpack(Buf, OutData%HubPosition) + if (RegCheckErr(Buf, RoutineName)) return + ! HubOrientation + call RegUnpack(Buf, OutData%HubOrientation) + if (RegCheckErr(Buf, RoutineName)) return + ! BladeRootPosition + if (allocated(OutData%BladeRootPosition)) deallocate(OutData%BladeRootPosition) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BladeRootPosition(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootPosition.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BladeRootPosition) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BladeRootOrientation + if (allocated(OutData%BladeRootOrientation)) deallocate(OutData%BladeRootOrientation) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BladeRootOrientation(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootOrientation.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BladeRootOrientation) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NacellePosition + call RegUnpack(Buf, OutData%NacellePosition) + if (RegCheckErr(Buf, RoutineName)) return + ! NacelleOrientation + call RegUnpack(Buf, OutData%NacelleOrientation) + if (RegCheckErr(Buf, RoutineName)) return + ! AeroProjMod + call RegUnpack(Buf, OutData%AeroProjMod) + if (RegCheckErr(Buf, RoutineName)) return + ! AeroBEM_Mod + call RegUnpack(Buf, OutData%AeroBEM_Mod) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE AD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(AD_InitInputType), INTENT(IN) :: SrcInitInputData TYPE(AD_InitInputType), INTENT(INOUT) :: DstInitInputData @@ -1769,378 +1146,136 @@ SUBROUTINE AD_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AD_DestroyInitInput - SUBROUTINE AD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AD_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! rotors allocated yes/no - IF ( ALLOCATED(InData%rotors) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotors upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - Int_BufSz = Int_BufSz + 3 ! rotors: size of buffers for each call to pack subtype - CALL AD_PackRotInitInputType( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! rotors - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! rotors - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! rotors - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%InputFile) ! InputFile - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1 ! UsePrimaryInputFile - Int_BufSz = Int_BufSz + 3 ! PassedPrimaryInputData: size of buffers for each call to pack subtype - CALL NWTC_Library_PackFileInfoType( Re_Buf, Db_Buf, Int_Buf, InData%PassedPrimaryInputData, ErrStat2, ErrMsg2, .TRUE. ) ! PassedPrimaryInputData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PassedPrimaryInputData - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PassedPrimaryInputData - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PassedPrimaryInputData - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Linearize - Re_BufSz = Re_BufSz + 1 ! Gravity - Int_BufSz = Int_BufSz + 1 ! MHK - Re_BufSz = Re_BufSz + 1 ! defFldDens - Re_BufSz = Re_BufSz + 1 ! defKinVisc - Re_BufSz = Re_BufSz + 1 ! defSpdSound - Re_BufSz = Re_BufSz + 1 ! defPatm - Re_BufSz = Re_BufSz + 1 ! defPvap - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Re_BufSz = Re_BufSz + 1 ! MSL2SWL - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%rotors) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rotors,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotors,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - CALL AD_PackRotInitInputType( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%UsePrimaryInputFile, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - CALL NWTC_Library_PackFileInfoType( Re_Buf, Db_Buf, Int_Buf, InData%PassedPrimaryInputData, ErrStat2, ErrMsg2, OnlySize ) ! PassedPrimaryInputData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MHK - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%defFldDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%defKinVisc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%defSpdSound - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%defPatm - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%defPvap - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD_PackInitInput - - SUBROUTINE AD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AD_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rotors not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rotors)) DEALLOCATE(OutData%rotors) - ALLOCATE(OutData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotors,1), UBOUND(OutData%rotors,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackRotInitInputType( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UsePrimaryInputFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%UsePrimaryInputFile) - Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackFileInfoType( Re_Buf, Db_Buf, Int_Buf, OutData%PassedPrimaryInputData, ErrStat2, ErrMsg2 ) ! PassedPrimaryInputData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) - Int_Xferred = Int_Xferred + 1 - OutData%Gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MHK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%defFldDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%defKinVisc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%defSpdSound = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%defPatm = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%defPvap = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MSL2SWL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD_UnPackInitInput +subroutine AD_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackInitInput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! rotors + call RegPack(Buf, allocated(InData%rotors)) + if (allocated(InData%rotors)) then + call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) + do i1 = LB(1), UB(1) + call AD_PackRotInitInputType(Buf, InData%rotors(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! InputFile + call RegPack(Buf, InData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegPack(Buf, InData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! UsePrimaryInputFile + call RegPack(Buf, InData%UsePrimaryInputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! PassedPrimaryInputData + call NWTC_Library_PackFileInfoType(Buf, InData%PassedPrimaryInputData) + if (RegCheckErr(Buf, RoutineName)) return + ! Linearize + call RegPack(Buf, InData%Linearize) + if (RegCheckErr(Buf, RoutineName)) return + ! Gravity + call RegPack(Buf, InData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + ! MHK + call RegPack(Buf, InData%MHK) + if (RegCheckErr(Buf, RoutineName)) return + ! defFldDens + call RegPack(Buf, InData%defFldDens) + if (RegCheckErr(Buf, RoutineName)) return + ! defKinVisc + call RegPack(Buf, InData%defKinVisc) + if (RegCheckErr(Buf, RoutineName)) return + ! defSpdSound + call RegPack(Buf, InData%defSpdSound) + if (RegCheckErr(Buf, RoutineName)) return + ! defPatm + call RegPack(Buf, InData%defPatm) + if (RegCheckErr(Buf, RoutineName)) return + ! defPvap + call RegPack(Buf, InData%defPvap) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDpth + call RegPack(Buf, InData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! MSL2SWL + call RegPack(Buf, InData%MSL2SWL) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackInitInput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! rotors + if (allocated(OutData%rotors)) deallocate(OutData%rotors) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rotors(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackRotInitInputType(Buf, OutData%rotors(i1)) ! rotors + end do + end if + ! InputFile + call RegUnpack(Buf, OutData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! UsePrimaryInputFile + call RegUnpack(Buf, OutData%UsePrimaryInputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! PassedPrimaryInputData + call NWTC_Library_UnpackFileInfoType(Buf, OutData%PassedPrimaryInputData) ! PassedPrimaryInputData + ! Linearize + call RegUnpack(Buf, OutData%Linearize) + if (RegCheckErr(Buf, RoutineName)) return + ! Gravity + call RegUnpack(Buf, OutData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + ! MHK + call RegUnpack(Buf, OutData%MHK) + if (RegCheckErr(Buf, RoutineName)) return + ! defFldDens + call RegUnpack(Buf, OutData%defFldDens) + if (RegCheckErr(Buf, RoutineName)) return + ! defKinVisc + call RegUnpack(Buf, OutData%defKinVisc) + if (RegCheckErr(Buf, RoutineName)) return + ! defSpdSound + call RegUnpack(Buf, OutData%defSpdSound) + if (RegCheckErr(Buf, RoutineName)) return + ! defPatm + call RegUnpack(Buf, OutData%defPatm) + if (RegCheckErr(Buf, RoutineName)) return + ! defPvap + call RegUnpack(Buf, OutData%defPvap) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDpth + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! MSL2SWL + call RegUnpack(Buf, OutData%MSL2SWL) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE AD_CopyBladePropsType( SrcBladePropsTypeData, DstBladePropsTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(AD_BladePropsType), INTENT(IN) :: SrcBladePropsTypeData TYPE(AD_BladePropsType), INTENT(INOUT) :: DstBladePropsTypeData @@ -2324,690 +1459,341 @@ SUBROUTINE AD_DestroyBladePropsType( BladePropsTypeData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE AD_DestroyBladePropsType - SUBROUTINE AD_PackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AD_BladePropsType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + +subroutine AD_PackBladePropsType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD_BladePropsType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackBladePropsType' + if (Buf%ErrStat >= AbortErrLev) return + ! NumBlNds + call RegPack(Buf, InData%NumBlNds) + if (RegCheckErr(Buf, RoutineName)) return + ! BlSpn + call RegPack(Buf, allocated(InData%BlSpn)) + if (allocated(InData%BlSpn)) then + call RegPackBounds(Buf, 1, lbound(InData%BlSpn), ubound(InData%BlSpn)) + call RegPack(Buf, InData%BlSpn) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BlCrvAC + call RegPack(Buf, allocated(InData%BlCrvAC)) + if (allocated(InData%BlCrvAC)) then + call RegPackBounds(Buf, 1, lbound(InData%BlCrvAC), ubound(InData%BlCrvAC)) + call RegPack(Buf, InData%BlCrvAC) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BlSwpAC + call RegPack(Buf, allocated(InData%BlSwpAC)) + if (allocated(InData%BlSwpAC)) then + call RegPackBounds(Buf, 1, lbound(InData%BlSwpAC), ubound(InData%BlSwpAC)) + call RegPack(Buf, InData%BlSwpAC) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BlCrvAng + call RegPack(Buf, allocated(InData%BlCrvAng)) + if (allocated(InData%BlCrvAng)) then + call RegPackBounds(Buf, 1, lbound(InData%BlCrvAng), ubound(InData%BlCrvAng)) + call RegPack(Buf, InData%BlCrvAng) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BlTwist + call RegPack(Buf, allocated(InData%BlTwist)) + if (allocated(InData%BlTwist)) then + call RegPackBounds(Buf, 1, lbound(InData%BlTwist), ubound(InData%BlTwist)) + call RegPack(Buf, InData%BlTwist) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BlChord + call RegPack(Buf, allocated(InData%BlChord)) + if (allocated(InData%BlChord)) then + call RegPackBounds(Buf, 1, lbound(InData%BlChord), ubound(InData%BlChord)) + call RegPack(Buf, InData%BlChord) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BlAFID + call RegPack(Buf, allocated(InData%BlAFID)) + if (allocated(InData%BlAFID)) then + call RegPackBounds(Buf, 1, lbound(InData%BlAFID), ubound(InData%BlAFID)) + call RegPack(Buf, InData%BlAFID) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BlCb + call RegPack(Buf, allocated(InData%BlCb)) + if (allocated(InData%BlCb)) then + call RegPackBounds(Buf, 1, lbound(InData%BlCb), ubound(InData%BlCb)) + call RegPack(Buf, InData%BlCb) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BlCenBn + call RegPack(Buf, allocated(InData%BlCenBn)) + if (allocated(InData%BlCenBn)) then + call RegPackBounds(Buf, 1, lbound(InData%BlCenBn), ubound(InData%BlCenBn)) + call RegPack(Buf, InData%BlCenBn) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BlCenBt + call RegPack(Buf, allocated(InData%BlCenBt)) + if (allocated(InData%BlCenBt)) then + call RegPackBounds(Buf, 1, lbound(InData%BlCenBt), ubound(InData%BlCenBt)) + call RegPack(Buf, InData%BlCenBt) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackBladePropsType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD_BladePropsType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackBladePropsType' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! NumBlNds + call RegUnpack(Buf, OutData%NumBlNds) + if (RegCheckErr(Buf, RoutineName)) return + ! BlSpn + if (allocated(OutData%BlSpn)) deallocate(OutData%BlSpn) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlSpn(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlSpn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlSpn) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BlCrvAC + if (allocated(OutData%BlCrvAC)) deallocate(OutData%BlCrvAC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlCrvAC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCrvAC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlCrvAC) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BlSwpAC + if (allocated(OutData%BlSwpAC)) deallocate(OutData%BlSwpAC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlSwpAC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlSwpAC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlSwpAC) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BlCrvAng + if (allocated(OutData%BlCrvAng)) deallocate(OutData%BlCrvAng) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlCrvAng(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCrvAng.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlCrvAng) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BlTwist + if (allocated(OutData%BlTwist)) deallocate(OutData%BlTwist) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlTwist(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlTwist.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlTwist) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BlChord + if (allocated(OutData%BlChord)) deallocate(OutData%BlChord) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlChord(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlChord.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlChord) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BlAFID + if (allocated(OutData%BlAFID)) deallocate(OutData%BlAFID) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlAFID(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlAFID.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlAFID) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BlCb + if (allocated(OutData%BlCb)) deallocate(OutData%BlCb) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlCb(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlCb) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BlCenBn + if (allocated(OutData%BlCenBn)) deallocate(OutData%BlCenBn) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlCenBn(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCenBn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlCenBn) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BlCenBt + if (allocated(OutData%BlCenBt)) deallocate(OutData%BlCenBt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlCenBt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCenBt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlCenBt) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + SUBROUTINE AD_CopyBladeShape( SrcBladeShapeData, DstBladeShapeData, CtrlCode, ErrStat, ErrMsg ) + TYPE(AD_BladeShape), INTENT(IN) :: SrcBladeShapeData + TYPE(AD_BladeShape), INTENT(INOUT) :: DstBladeShapeData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_CopyBladeShape' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcBladeShapeData%AirfoilCoords)) THEN + i1_l = LBOUND(SrcBladeShapeData%AirfoilCoords,1) + i1_u = UBOUND(SrcBladeShapeData%AirfoilCoords,1) + i2_l = LBOUND(SrcBladeShapeData%AirfoilCoords,2) + i2_u = UBOUND(SrcBladeShapeData%AirfoilCoords,2) + i3_l = LBOUND(SrcBladeShapeData%AirfoilCoords,3) + i3_u = UBOUND(SrcBladeShapeData%AirfoilCoords,3) + IF (.NOT. ALLOCATED(DstBladeShapeData%AirfoilCoords)) THEN + ALLOCATE(DstBladeShapeData%AirfoilCoords(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeShapeData%AirfoilCoords.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstBladeShapeData%AirfoilCoords = SrcBladeShapeData%AirfoilCoords +ENDIF + END SUBROUTINE AD_CopyBladeShape + + SUBROUTINE AD_DestroyBladeShape( BladeShapeData, ErrStat, ErrMsg ) + TYPE(AD_BladeShape), INTENT(INOUT) :: BladeShapeData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_PackBladePropsType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyBladeShape' - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! ErrStat = ErrID_None ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! NumBlNds - Int_BufSz = Int_BufSz + 1 ! BlSpn allocated yes/no - IF ( ALLOCATED(InData%BlSpn) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlSpn upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlSpn) ! BlSpn - END IF - Int_BufSz = Int_BufSz + 1 ! BlCrvAC allocated yes/no - IF ( ALLOCATED(InData%BlCrvAC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlCrvAC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlCrvAC) ! BlCrvAC - END IF - Int_BufSz = Int_BufSz + 1 ! BlSwpAC allocated yes/no - IF ( ALLOCATED(InData%BlSwpAC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlSwpAC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlSwpAC) ! BlSwpAC - END IF - Int_BufSz = Int_BufSz + 1 ! BlCrvAng allocated yes/no - IF ( ALLOCATED(InData%BlCrvAng) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlCrvAng upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlCrvAng) ! BlCrvAng - END IF - Int_BufSz = Int_BufSz + 1 ! BlTwist allocated yes/no - IF ( ALLOCATED(InData%BlTwist) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlTwist upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlTwist) ! BlTwist - END IF - Int_BufSz = Int_BufSz + 1 ! BlChord allocated yes/no - IF ( ALLOCATED(InData%BlChord) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlChord upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlChord) ! BlChord - END IF - Int_BufSz = Int_BufSz + 1 ! BlAFID allocated yes/no - IF ( ALLOCATED(InData%BlAFID) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlAFID upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BlAFID) ! BlAFID - END IF - Int_BufSz = Int_BufSz + 1 ! BlCb allocated yes/no - IF ( ALLOCATED(InData%BlCb) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlCb upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlCb) ! BlCb - END IF - Int_BufSz = Int_BufSz + 1 ! BlCenBn allocated yes/no - IF ( ALLOCATED(InData%BlCenBn) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlCenBn upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlCenBn) ! BlCenBn - END IF - Int_BufSz = Int_BufSz + 1 ! BlCenBt allocated yes/no - IF ( ALLOCATED(InData%BlCenBt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlCenBt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlCenBt) ! BlCenBt - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%NumBlNds - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BlSpn) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlSpn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlSpn,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlSpn,1), UBOUND(InData%BlSpn,1) - ReKiBuf(Re_Xferred) = InData%BlSpn(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlCrvAC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlCrvAC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCrvAC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlCrvAC,1), UBOUND(InData%BlCrvAC,1) - ReKiBuf(Re_Xferred) = InData%BlCrvAC(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlSwpAC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlSwpAC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlSwpAC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlSwpAC,1), UBOUND(InData%BlSwpAC,1) - ReKiBuf(Re_Xferred) = InData%BlSwpAC(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlCrvAng) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlCrvAng,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCrvAng,1) - Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%BlCrvAng,1), UBOUND(InData%BlCrvAng,1) - ReKiBuf(Re_Xferred) = InData%BlCrvAng(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlTwist) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlTwist,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlTwist,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlTwist,1), UBOUND(InData%BlTwist,1) - ReKiBuf(Re_Xferred) = InData%BlTwist(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlChord) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlChord,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlChord,1) - Int_Xferred = Int_Xferred + 2 +IF (ALLOCATED(BladeShapeData%AirfoilCoords)) THEN + DEALLOCATE(BladeShapeData%AirfoilCoords) +ENDIF + END SUBROUTINE AD_DestroyBladeShape - DO i1 = LBOUND(InData%BlChord,1), UBOUND(InData%BlChord,1) - ReKiBuf(Re_Xferred) = InData%BlChord(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlAFID) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlAFID,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlAFID,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlAFID,1), UBOUND(InData%BlAFID,1) - IntKiBuf(Int_Xferred) = InData%BlAFID(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlCb) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlCb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCb,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlCb,1), UBOUND(InData%BlCb,1) - ReKiBuf(Re_Xferred) = InData%BlCb(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlCenBn) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlCenBn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCenBn,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlCenBn,1), UBOUND(InData%BlCenBn,1) - ReKiBuf(Re_Xferred) = InData%BlCenBn(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlCenBt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlCenBt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCenBt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlCenBt,1), UBOUND(InData%BlCenBt,1) - ReKiBuf(Re_Xferred) = InData%BlCenBt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AD_PackBladePropsType - - SUBROUTINE AD_UnPackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AD_BladePropsType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackBladePropsType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%NumBlNds = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlSpn not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlSpn)) DEALLOCATE(OutData%BlSpn) - ALLOCATE(OutData%BlSpn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlSpn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlSpn,1), UBOUND(OutData%BlSpn,1) - OutData%BlSpn(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlCrvAC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlCrvAC)) DEALLOCATE(OutData%BlCrvAC) - ALLOCATE(OutData%BlCrvAC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCrvAC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlCrvAC,1), UBOUND(OutData%BlCrvAC,1) - OutData%BlCrvAC(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlSwpAC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlSwpAC)) DEALLOCATE(OutData%BlSwpAC) - ALLOCATE(OutData%BlSwpAC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlSwpAC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlSwpAC,1), UBOUND(OutData%BlSwpAC,1) - OutData%BlSwpAC(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlCrvAng not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlCrvAng)) DEALLOCATE(OutData%BlCrvAng) - ALLOCATE(OutData%BlCrvAng(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCrvAng.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlCrvAng,1), UBOUND(OutData%BlCrvAng,1) - OutData%BlCrvAng(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlTwist not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlTwist)) DEALLOCATE(OutData%BlTwist) - ALLOCATE(OutData%BlTwist(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlTwist.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlTwist,1), UBOUND(OutData%BlTwist,1) - OutData%BlTwist(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlChord not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlChord)) DEALLOCATE(OutData%BlChord) - ALLOCATE(OutData%BlChord(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlChord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlChord,1), UBOUND(OutData%BlChord,1) - OutData%BlChord(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlAFID not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlAFID)) DEALLOCATE(OutData%BlAFID) - ALLOCATE(OutData%BlAFID(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlAFID.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlAFID,1), UBOUND(OutData%BlAFID,1) - OutData%BlAFID(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlCb not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlCb)) DEALLOCATE(OutData%BlCb) - ALLOCATE(OutData%BlCb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlCb,1), UBOUND(OutData%BlCb,1) - OutData%BlCb(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlCenBn not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlCenBn)) DEALLOCATE(OutData%BlCenBn) - ALLOCATE(OutData%BlCenBn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCenBn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlCenBn,1), UBOUND(OutData%BlCenBn,1) - OutData%BlCenBn(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlCenBt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlCenBt)) DEALLOCATE(OutData%BlCenBt) - ALLOCATE(OutData%BlCenBt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCenBt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlCenBt,1), UBOUND(OutData%BlCenBt,1) - OutData%BlCenBt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AD_UnPackBladePropsType - - SUBROUTINE AD_CopyBladeShape( SrcBladeShapeData, DstBladeShapeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD_BladeShape), INTENT(IN) :: SrcBladeShapeData - TYPE(AD_BladeShape), INTENT(INOUT) :: DstBladeShapeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_CopyBladeShape' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcBladeShapeData%AirfoilCoords)) THEN - i1_l = LBOUND(SrcBladeShapeData%AirfoilCoords,1) - i1_u = UBOUND(SrcBladeShapeData%AirfoilCoords,1) - i2_l = LBOUND(SrcBladeShapeData%AirfoilCoords,2) - i2_u = UBOUND(SrcBladeShapeData%AirfoilCoords,2) - i3_l = LBOUND(SrcBladeShapeData%AirfoilCoords,3) - i3_u = UBOUND(SrcBladeShapeData%AirfoilCoords,3) - IF (.NOT. ALLOCATED(DstBladeShapeData%AirfoilCoords)) THEN - ALLOCATE(DstBladeShapeData%AirfoilCoords(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeShapeData%AirfoilCoords.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeShapeData%AirfoilCoords = SrcBladeShapeData%AirfoilCoords -ENDIF - END SUBROUTINE AD_CopyBladeShape - - SUBROUTINE AD_DestroyBladeShape( BladeShapeData, ErrStat, ErrMsg ) - TYPE(AD_BladeShape), INTENT(INOUT) :: BladeShapeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyBladeShape' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(BladeShapeData%AirfoilCoords)) THEN - DEALLOCATE(BladeShapeData%AirfoilCoords) -ENDIF - END SUBROUTINE AD_DestroyBladeShape - - SUBROUTINE AD_PackBladeShape( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AD_BladeShape), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_PackBladeShape' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! AirfoilCoords allocated yes/no - IF ( ALLOCATED(InData%AirfoilCoords) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AirfoilCoords upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AirfoilCoords) ! AirfoilCoords - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%AirfoilCoords) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AirfoilCoords,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AirfoilCoords,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AirfoilCoords,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AirfoilCoords,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AirfoilCoords,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AirfoilCoords,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AirfoilCoords,3), UBOUND(InData%AirfoilCoords,3) - DO i2 = LBOUND(InData%AirfoilCoords,2), UBOUND(InData%AirfoilCoords,2) - DO i1 = LBOUND(InData%AirfoilCoords,1), UBOUND(InData%AirfoilCoords,1) - ReKiBuf(Re_Xferred) = InData%AirfoilCoords(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE AD_PackBladeShape - - SUBROUTINE AD_UnPackBladeShape( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AD_BladeShape), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackBladeShape' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AirfoilCoords not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AirfoilCoords)) DEALLOCATE(OutData%AirfoilCoords) - ALLOCATE(OutData%AirfoilCoords(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AirfoilCoords.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AirfoilCoords,3), UBOUND(OutData%AirfoilCoords,3) - DO i2 = LBOUND(OutData%AirfoilCoords,2), UBOUND(OutData%AirfoilCoords,2) - DO i1 = LBOUND(OutData%AirfoilCoords,1), UBOUND(OutData%AirfoilCoords,1) - OutData%AirfoilCoords(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE AD_UnPackBladeShape +subroutine AD_PackBladeShape(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD_BladeShape), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackBladeShape' + if (Buf%ErrStat >= AbortErrLev) return + ! AirfoilCoords + call RegPack(Buf, allocated(InData%AirfoilCoords)) + if (allocated(InData%AirfoilCoords)) then + call RegPackBounds(Buf, 3, lbound(InData%AirfoilCoords), ubound(InData%AirfoilCoords)) + call RegPack(Buf, InData%AirfoilCoords) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackBladeShape(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD_BladeShape), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackBladeShape' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! AirfoilCoords + if (allocated(OutData%AirfoilCoords)) deallocate(OutData%AirfoilCoords) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AirfoilCoords(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AirfoilCoords.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AirfoilCoords) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE AD_CopyRotInitOutputType( SrcRotInitOutputTypeData, DstRotInitOutputTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(RotInitOutputType), INTENT(IN) :: SrcRotInitOutputTypeData TYPE(RotInitOutputType), INTENT(INOUT) :: DstRotInitOutputTypeData @@ -3267,1221 +2053,503 @@ SUBROUTINE AD_DestroyRotInitOutputType( RotInitOutputTypeData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE AD_DestroyRotInitOutputType - SUBROUTINE AD_PackRotInitOutputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(RotInitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + +subroutine AD_PackRotInitOutputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(RotInitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackRotInitOutputType' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! AirDens + call RegPack(Buf, InData%AirDens) + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutputHdr + call RegPack(Buf, allocated(InData%WriteOutputHdr)) + if (allocated(InData%WriteOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPack(Buf, InData%WriteOutputHdr) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutputUnt + call RegPack(Buf, allocated(InData%WriteOutputUnt)) + if (allocated(InData%WriteOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPack(Buf, InData%WriteOutputUnt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BladeShape + call RegPack(Buf, allocated(InData%BladeShape)) + if (allocated(InData%BladeShape)) then + call RegPackBounds(Buf, 1, lbound(InData%BladeShape), ubound(InData%BladeShape)) + LB(1:1) = lbound(InData%BladeShape) + UB(1:1) = ubound(InData%BladeShape) + do i1 = LB(1), UB(1) + call AD_PackBladeShape(Buf, InData%BladeShape(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LinNames_y + call RegPack(Buf, allocated(InData%LinNames_y)) + if (allocated(InData%LinNames_y)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) + call RegPack(Buf, InData%LinNames_y) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LinNames_x + call RegPack(Buf, allocated(InData%LinNames_x)) + if (allocated(InData%LinNames_x)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_x), ubound(InData%LinNames_x)) + call RegPack(Buf, InData%LinNames_x) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LinNames_u + call RegPack(Buf, allocated(InData%LinNames_u)) + if (allocated(InData%LinNames_u)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) + call RegPack(Buf, InData%LinNames_u) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RotFrame_y + call RegPack(Buf, allocated(InData%RotFrame_y)) + if (allocated(InData%RotFrame_y)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y), ubound(InData%RotFrame_y)) + call RegPack(Buf, InData%RotFrame_y) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RotFrame_x + call RegPack(Buf, allocated(InData%RotFrame_x)) + if (allocated(InData%RotFrame_x)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x), ubound(InData%RotFrame_x)) + call RegPack(Buf, InData%RotFrame_x) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RotFrame_u + call RegPack(Buf, allocated(InData%RotFrame_u)) + if (allocated(InData%RotFrame_u)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u), ubound(InData%RotFrame_u)) + call RegPack(Buf, InData%RotFrame_u) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! IsLoad_u + call RegPack(Buf, allocated(InData%IsLoad_u)) + if (allocated(InData%IsLoad_u)) then + call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) + call RegPack(Buf, InData%IsLoad_u) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BladeProps + call RegPack(Buf, allocated(InData%BladeProps)) + if (allocated(InData%BladeProps)) then + call RegPackBounds(Buf, 1, lbound(InData%BladeProps), ubound(InData%BladeProps)) + LB(1:1) = lbound(InData%BladeProps) + UB(1:1) = ubound(InData%BladeProps) + do i1 = LB(1), UB(1) + call AD_PackBladePropsType(Buf, InData%BladeProps(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DerivOrder_x + call RegPack(Buf, allocated(InData%DerivOrder_x)) + if (allocated(InData%DerivOrder_x)) then + call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x), ubound(InData%DerivOrder_x)) + call RegPack(Buf, InData%DerivOrder_x) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TwrElev + call RegPack(Buf, allocated(InData%TwrElev)) + if (allocated(InData%TwrElev)) then + call RegPackBounds(Buf, 1, lbound(InData%TwrElev), ubound(InData%TwrElev)) + call RegPack(Buf, InData%TwrElev) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TwrDiam + call RegPack(Buf, allocated(InData%TwrDiam)) + if (allocated(InData%TwrDiam)) then + call RegPackBounds(Buf, 1, lbound(InData%TwrDiam), ubound(InData%TwrDiam)) + call RegPack(Buf, InData%TwrDiam) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackRotInitOutputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(RotInitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackRotInitOutputType' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! AirDens + call RegUnpack(Buf, OutData%AirDens) + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutputHdr + if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WriteOutputUnt + if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BladeShape + if (allocated(OutData%BladeShape)) deallocate(OutData%BladeShape) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BladeShape(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeShape.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackBladeShape(Buf, OutData%BladeShape(i1)) ! BladeShape + end do + end if + ! LinNames_y + if (allocated(OutData%LinNames_y)) deallocate(OutData%LinNames_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LinNames_x + if (allocated(OutData%LinNames_x)) deallocate(OutData%LinNames_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LinNames_u + if (allocated(OutData%LinNames_u)) deallocate(OutData%LinNames_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RotFrame_y + if (allocated(OutData%RotFrame_y)) deallocate(OutData%RotFrame_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RotFrame_x + if (allocated(OutData%RotFrame_x)) deallocate(OutData%RotFrame_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RotFrame_u + if (allocated(OutData%RotFrame_u)) deallocate(OutData%RotFrame_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! IsLoad_u + if (allocated(OutData%IsLoad_u)) deallocate(OutData%IsLoad_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IsLoad_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IsLoad_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BladeProps + if (allocated(OutData%BladeProps)) deallocate(OutData%BladeProps) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BladeProps(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeProps.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackBladePropsType(Buf, OutData%BladeProps(i1)) ! BladeProps + end do + end if + ! DerivOrder_x + if (allocated(OutData%DerivOrder_x)) deallocate(OutData%DerivOrder_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DerivOrder_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DerivOrder_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TwrElev + if (allocated(OutData%TwrElev)) deallocate(OutData%TwrElev) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrElev(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrElev.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrElev) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TwrDiam + if (allocated(OutData%TwrDiam)) deallocate(OutData%TwrDiam) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrDiam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrDiam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrDiam) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + SUBROUTINE AD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(AD_InitOutputType), INTENT(IN) :: SrcInitOutputData + TYPE(AD_InitOutputType), INTENT(INOUT) :: DstInitOutputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_CopyInitOutput' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcInitOutputData%rotors)) THEN + i1_l = LBOUND(SrcInitOutputData%rotors,1) + i1_u = UBOUND(SrcInitOutputData%rotors,1) + IF (.NOT. ALLOCATED(DstInitOutputData%rotors)) THEN + ALLOCATE(DstInitOutputData%rotors(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%rotors.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcInitOutputData%rotors,1), UBOUND(SrcInitOutputData%rotors,1) + CALL AD_Copyrotinitoutputtype( SrcInitOutputData%rotors(i1), DstInitOutputData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + END SUBROUTINE AD_CopyInitOutput + + SUBROUTINE AD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + TYPE(AD_InitOutputType), INTENT(INOUT) :: InitOutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_PackRotInitOutputType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyInitOutput' - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! ErrStat = ErrID_None ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! AirDens - Int_BufSz = Int_BufSz + 1 ! WriteOutputHdr allocated yes/no - IF ( ALLOCATED(InData%WriteOutputHdr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdr upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdr)*LEN(InData%WriteOutputHdr) ! WriteOutputHdr - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputUnt allocated yes/no - IF ( ALLOCATED(InData%WriteOutputUnt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUnt upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUnt)*LEN(InData%WriteOutputUnt) ! WriteOutputUnt - END IF - Int_BufSz = Int_BufSz + 1 ! BladeShape allocated yes/no - IF ( ALLOCATED(InData%BladeShape) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladeShape upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%BladeShape,1), UBOUND(InData%BladeShape,1) - Int_BufSz = Int_BufSz + 3 ! BladeShape: size of buffers for each call to pack subtype - CALL AD_PackBladeShape( Re_Buf, Db_Buf, Int_Buf, InData%BladeShape(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BladeShape - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeShape - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeShape - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeShape - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_y allocated yes/no - IF ( ALLOCATED(InData%LinNames_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_y)*LEN(InData%LinNames_y) ! LinNames_y - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_x allocated yes/no - IF ( ALLOCATED(InData%LinNames_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_x)*LEN(InData%LinNames_x) ! LinNames_x - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_u allocated yes/no - IF ( ALLOCATED(InData%LinNames_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_u)*LEN(InData%LinNames_u) ! LinNames_u - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_y allocated yes/no - IF ( ALLOCATED(InData%RotFrame_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_y) ! RotFrame_y - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_x allocated yes/no - IF ( ALLOCATED(InData%RotFrame_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_x) ! RotFrame_x - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_u allocated yes/no - IF ( ALLOCATED(InData%RotFrame_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_u) ! RotFrame_u - END IF - Int_BufSz = Int_BufSz + 1 ! IsLoad_u allocated yes/no - IF ( ALLOCATED(InData%IsLoad_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IsLoad_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IsLoad_u) ! IsLoad_u - END IF - Int_BufSz = Int_BufSz + 1 ! BladeProps allocated yes/no - IF ( ALLOCATED(InData%BladeProps) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladeProps upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BladeProps,1), UBOUND(InData%BladeProps,1) - Int_BufSz = Int_BufSz + 3 ! BladeProps: size of buffers for each call to pack subtype - CALL AD_PackBladePropsType( Re_Buf, Db_Buf, Int_Buf, InData%BladeProps(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BladeProps - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeProps - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeProps - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeProps - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! DerivOrder_x allocated yes/no - IF ( ALLOCATED(InData%DerivOrder_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DerivOrder_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%DerivOrder_x) ! DerivOrder_x - END IF - Int_BufSz = Int_BufSz + 1 ! TwrElev allocated yes/no - IF ( ALLOCATED(InData%TwrElev) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrElev upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrElev) ! TwrElev - END IF - Int_BufSz = Int_BufSz + 1 ! TwrDiam allocated yes/no - IF ( ALLOCATED(InData%TwrDiam) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrDiam upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrDiam) ! TwrDiam - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 +IF (ALLOCATED(InitOutputData%rotors)) THEN +DO i1 = LBOUND(InitOutputData%rotors,1), UBOUND(InitOutputData%rotors,1) + CALL AD_DestroyRotInitOutputType( InitOutputData%rotors(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(InitOutputData%rotors) +ENDIF + CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END SUBROUTINE AD_DestroyInitOutput - ReKiBuf(Re_Xferred) = InData%AirDens - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WriteOutputHdr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) - Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) - DO I = 1, LEN(InData%WriteOutputHdr) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO +subroutine AD_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackInitOutput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! rotors + call RegPack(Buf, allocated(InData%rotors)) + if (allocated(InData%rotors)) then + call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) + do i1 = LB(1), UB(1) + call AD_PackRotInitOutputType(Buf, InData%rotors(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Ver + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackInitOutput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! rotors + if (allocated(OutData%rotors)) deallocate(OutData%rotors) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rotors(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackRotInitOutputType(Buf, OutData%rotors(i1)) ! rotors + end do + end if + ! Ver + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver +end subroutine + SUBROUTINE AD_CopyRotInputFile( SrcRotInputFileData, DstRotInputFileData, CtrlCode, ErrStat, ErrMsg ) + TYPE(RotInputFile), INTENT(IN) :: SrcRotInputFileData + TYPE(RotInputFile), INTENT(INOUT) :: DstRotInputFileData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_CopyRotInputFile' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcRotInputFileData%BladeProps)) THEN + i1_l = LBOUND(SrcRotInputFileData%BladeProps,1) + i1_u = UBOUND(SrcRotInputFileData%BladeProps,1) + IF (.NOT. ALLOCATED(DstRotInputFileData%BladeProps)) THEN + ALLOCATE(DstRotInputFileData%BladeProps(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%BladeProps.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputUnt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) - DO I = 1, LEN(InData%WriteOutputUnt) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BladeShape) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeShape,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeShape,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BladeShape,1), UBOUND(InData%BladeShape,1) - CALL AD_PackBladeShape( Re_Buf, Db_Buf, Int_Buf, InData%BladeShape(i1), ErrStat2, ErrMsg2, OnlySize ) ! BladeShape - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinNames_y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) - DO I = 1, LEN(InData%LinNames_y) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_y(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinNames_x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_x,1), UBOUND(InData%LinNames_x,1) - DO I = 1, LEN(InData%LinNames_x) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_x(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinNames_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) - DO I = 1, LEN(InData%LinNames_u) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_u(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_y,1), UBOUND(InData%RotFrame_y,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_y(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_x,1), UBOUND(InData%RotFrame_x,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_x(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_u,1), UBOUND(InData%RotFrame_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IsLoad_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IsLoad_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BladeProps) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeProps,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeProps,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BladeProps,1), UBOUND(InData%BladeProps,1) - CALL AD_PackBladePropsType( Re_Buf, Db_Buf, Int_Buf, InData%BladeProps(i1), ErrStat2, ErrMsg2, OnlySize ) ! BladeProps - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DerivOrder_x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DerivOrder_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DerivOrder_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DerivOrder_x,1), UBOUND(InData%DerivOrder_x,1) - IntKiBuf(Int_Xferred) = InData%DerivOrder_x(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrElev) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrElev,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrElev,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrElev,1), UBOUND(InData%TwrElev,1) - ReKiBuf(Re_Xferred) = InData%TwrElev(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrDiam) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrDiam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrDiam,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrDiam,1), UBOUND(InData%TwrDiam,1) - ReKiBuf(Re_Xferred) = InData%TwrDiam(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AD_PackRotInitOutputType - - SUBROUTINE AD_UnPackRotInitOutputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(RotInitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackRotInitOutputType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%AirDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputHdr)) DEALLOCATE(OutData%WriteOutputHdr) - ALLOCATE(OutData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) - DO I = 1, LEN(OutData%WriteOutputHdr) - OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputUnt)) DEALLOCATE(OutData%WriteOutputUnt) - ALLOCATE(OutData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) - DO I = 1, LEN(OutData%WriteOutputUnt) - OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeShape not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BladeShape)) DEALLOCATE(OutData%BladeShape) - ALLOCATE(OutData%BladeShape(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeShape.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladeShape,1), UBOUND(OutData%BladeShape,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackBladeShape( Re_Buf, Db_Buf, Int_Buf, OutData%BladeShape(i1), ErrStat2, ErrMsg2 ) ! BladeShape - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LinNames_y)) DEALLOCATE(OutData%LinNames_y) - ALLOCATE(OutData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) - DO I = 1, LEN(OutData%LinNames_y) - OutData%LinNames_y(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LinNames_x)) DEALLOCATE(OutData%LinNames_x) - ALLOCATE(OutData%LinNames_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_x,1), UBOUND(OutData%LinNames_x,1) - DO I = 1, LEN(OutData%LinNames_x) - OutData%LinNames_x(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LinNames_u)) DEALLOCATE(OutData%LinNames_u) - ALLOCATE(OutData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) - DO I = 1, LEN(OutData%LinNames_u) - OutData%LinNames_u(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RotFrame_y)) DEALLOCATE(OutData%RotFrame_y) - ALLOCATE(OutData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_y,1), UBOUND(OutData%RotFrame_y,1) - OutData%RotFrame_y(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_y(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RotFrame_x)) DEALLOCATE(OutData%RotFrame_x) - ALLOCATE(OutData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_x,1), UBOUND(OutData%RotFrame_x,1) - OutData%RotFrame_x(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_x(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RotFrame_u)) DEALLOCATE(OutData%RotFrame_u) - ALLOCATE(OutData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_u,1), UBOUND(OutData%RotFrame_u,1) - OutData%RotFrame_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IsLoad_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IsLoad_u)) DEALLOCATE(OutData%IsLoad_u) - ALLOCATE(OutData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) - OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeProps not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BladeProps)) DEALLOCATE(OutData%BladeProps) - ALLOCATE(OutData%BladeProps(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeProps.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladeProps,1), UBOUND(OutData%BladeProps,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackBladePropsType( Re_Buf, Db_Buf, Int_Buf, OutData%BladeProps(i1), ErrStat2, ErrMsg2 ) ! BladeProps - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DerivOrder_x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DerivOrder_x)) DEALLOCATE(OutData%DerivOrder_x) - ALLOCATE(OutData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DerivOrder_x,1), UBOUND(OutData%DerivOrder_x,1) - OutData%DerivOrder_x(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrElev not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TwrElev)) DEALLOCATE(OutData%TwrElev) - ALLOCATE(OutData%TwrElev(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrElev.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrElev,1), UBOUND(OutData%TwrElev,1) - OutData%TwrElev(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrDiam not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TwrDiam)) DEALLOCATE(OutData%TwrDiam) - ALLOCATE(OutData%TwrDiam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrDiam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrDiam,1), UBOUND(OutData%TwrDiam,1) - OutData%TwrDiam(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AD_UnPackRotInitOutputType - - SUBROUTINE AD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(AD_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_CopyInitOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInitOutputData%rotors)) THEN - i1_l = LBOUND(SrcInitOutputData%rotors,1) - i1_u = UBOUND(SrcInitOutputData%rotors,1) - IF (.NOT. ALLOCATED(DstInitOutputData%rotors)) THEN - ALLOCATE(DstInitOutputData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitOutputData%rotors,1), UBOUND(SrcInitOutputData%rotors,1) - CALL AD_Copyrotinitoutputtype( SrcInitOutputData%rotors(i1), DstInitOutputData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD_CopyInitOutput - - SUBROUTINE AD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(AD_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitOutputData%rotors)) THEN -DO i1 = LBOUND(InitOutputData%rotors,1), UBOUND(InitOutputData%rotors,1) - CALL AD_DestroyRotInitOutputType( InitOutputData%rotors(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InitOutputData%rotors) -ENDIF - CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_DestroyInitOutput - - SUBROUTINE AD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AD_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! rotors allocated yes/no - IF ( ALLOCATED(InData%rotors) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotors upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - Int_BufSz = Int_BufSz + 3 ! rotors: size of buffers for each call to pack subtype - CALL AD_PackRotInitOutputType( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! rotors - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! rotors - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! rotors - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%rotors) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rotors,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotors,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - CALL AD_PackRotInitOutputType( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE AD_PackInitOutput - - SUBROUTINE AD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AD_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rotors not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rotors)) DEALLOCATE(OutData%rotors) - ALLOCATE(OutData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotors,1), UBOUND(OutData%rotors,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackRotInitOutputType( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE AD_UnPackInitOutput - - SUBROUTINE AD_CopyRotInputFile( SrcRotInputFileData, DstRotInputFileData, CtrlCode, ErrStat, ErrMsg ) - TYPE(RotInputFile), INTENT(IN) :: SrcRotInputFileData - TYPE(RotInputFile), INTENT(INOUT) :: DstRotInputFileData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_CopyRotInputFile' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcRotInputFileData%BladeProps)) THEN - i1_l = LBOUND(SrcRotInputFileData%BladeProps,1) - i1_u = UBOUND(SrcRotInputFileData%BladeProps,1) - IF (.NOT. ALLOCATED(DstRotInputFileData%BladeProps)) THEN - ALLOCATE(DstRotInputFileData%BladeProps(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%BladeProps.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotInputFileData%BladeProps,1), UBOUND(SrcRotInputFileData%BladeProps,1) - CALL AD_Copybladepropstype( SrcRotInputFileData%BladeProps(i1), DstRotInputFileData%BladeProps(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstRotInputFileData%NumTwrNds = SrcRotInputFileData%NumTwrNds -IF (ALLOCATED(SrcRotInputFileData%TwrElev)) THEN - i1_l = LBOUND(SrcRotInputFileData%TwrElev,1) - i1_u = UBOUND(SrcRotInputFileData%TwrElev,1) - IF (.NOT. ALLOCATED(DstRotInputFileData%TwrElev)) THEN - ALLOCATE(DstRotInputFileData%TwrElev(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%TwrElev.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + DO i1 = LBOUND(SrcRotInputFileData%BladeProps,1), UBOUND(SrcRotInputFileData%BladeProps,1) + CALL AD_Copybladepropstype( SrcRotInputFileData%BladeProps(i1), DstRotInputFileData%BladeProps(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + DstRotInputFileData%NumTwrNds = SrcRotInputFileData%NumTwrNds +IF (ALLOCATED(SrcRotInputFileData%TwrElev)) THEN + i1_l = LBOUND(SrcRotInputFileData%TwrElev,1) + i1_u = UBOUND(SrcRotInputFileData%TwrElev,1) + IF (.NOT. ALLOCATED(DstRotInputFileData%TwrElev)) THEN + ALLOCATE(DstRotInputFileData%TwrElev(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%TwrElev.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF DstRotInputFileData%TwrElev = SrcRotInputFileData%TwrElev ENDIF @@ -4583,540 +2651,210 @@ SUBROUTINE AD_DestroyRotInputFile( RotInputFileData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AD_DestroyRotInputFile - SUBROUTINE AD_PackRotInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(RotInputFile), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_PackRotInputFile' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! BladeProps allocated yes/no - IF ( ALLOCATED(InData%BladeProps) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladeProps upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%BladeProps,1), UBOUND(InData%BladeProps,1) - Int_BufSz = Int_BufSz + 3 ! BladeProps: size of buffers for each call to pack subtype - CALL AD_PackBladePropsType( Re_Buf, Db_Buf, Int_Buf, InData%BladeProps(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BladeProps - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeProps - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeProps - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeProps - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NumTwrNds - Int_BufSz = Int_BufSz + 1 ! TwrElev allocated yes/no - IF ( ALLOCATED(InData%TwrElev) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrElev upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrElev) ! TwrElev - END IF - Int_BufSz = Int_BufSz + 1 ! TwrDiam allocated yes/no - IF ( ALLOCATED(InData%TwrDiam) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrDiam upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrDiam) ! TwrDiam - END IF - Int_BufSz = Int_BufSz + 1 ! TwrCd allocated yes/no - IF ( ALLOCATED(InData%TwrCd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrCd upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrCd) ! TwrCd - END IF - Int_BufSz = Int_BufSz + 1 ! TwrTI allocated yes/no - IF ( ALLOCATED(InData%TwrTI) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrTI upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrTI) ! TwrTI - END IF - Int_BufSz = Int_BufSz + 1 ! TwrCb allocated yes/no - IF ( ALLOCATED(InData%TwrCb) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrCb upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrCb) ! TwrCb - END IF - Re_BufSz = Re_BufSz + 1 ! VolHub - Re_BufSz = Re_BufSz + 1 ! HubCenBx - Re_BufSz = Re_BufSz + 1 ! VolNac - Re_BufSz = Re_BufSz + SIZE(InData%NacCenB) ! NacCenB - Int_BufSz = Int_BufSz + 1 ! TFinAero - Int_BufSz = Int_BufSz + 1*LEN(InData%TFinFile) ! TFinFile - Int_BufSz = Int_BufSz + 3 ! TFin: size of buffers for each call to pack subtype - CALL AD_PackTFinInputFileType( Re_Buf, Db_Buf, Int_Buf, InData%TFin, ErrStat2, ErrMsg2, .TRUE. ) ! TFin - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TFin - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TFin - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TFin - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%BladeProps) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeProps,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeProps,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BladeProps,1), UBOUND(InData%BladeProps,1) - CALL AD_PackBladePropsType( Re_Buf, Db_Buf, Int_Buf, InData%BladeProps(i1), ErrStat2, ErrMsg2, OnlySize ) ! BladeProps - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NumTwrNds - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TwrElev) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrElev,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrElev,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrElev,1), UBOUND(InData%TwrElev,1) - ReKiBuf(Re_Xferred) = InData%TwrElev(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrDiam) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrDiam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrDiam,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrDiam,1), UBOUND(InData%TwrDiam,1) - ReKiBuf(Re_Xferred) = InData%TwrDiam(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrCd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrCd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrCd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrCd,1), UBOUND(InData%TwrCd,1) - ReKiBuf(Re_Xferred) = InData%TwrCd(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrTI) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrTI,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrTI,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrTI,1), UBOUND(InData%TwrTI,1) - ReKiBuf(Re_Xferred) = InData%TwrTI(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrCb) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrCb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrCb,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrCb,1), UBOUND(InData%TwrCb,1) - ReKiBuf(Re_Xferred) = InData%TwrCb(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%VolHub - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubCenBx - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VolNac - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%NacCenB,1), UBOUND(InData%NacCenB,1) - ReKiBuf(Re_Xferred) = InData%NacCenB(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = TRANSFER(InData%TFinAero, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%TFinFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%TFinFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - CALL AD_PackTFinInputFileType( Re_Buf, Db_Buf, Int_Buf, InData%TFin, ErrStat2, ErrMsg2, OnlySize ) ! TFin - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE AD_PackRotInputFile - - SUBROUTINE AD_UnPackRotInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(RotInputFile), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackRotInputFile' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeProps not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BladeProps)) DEALLOCATE(OutData%BladeProps) - ALLOCATE(OutData%BladeProps(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeProps.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladeProps,1), UBOUND(OutData%BladeProps,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackBladePropsType( Re_Buf, Db_Buf, Int_Buf, OutData%BladeProps(i1), ErrStat2, ErrMsg2 ) ! BladeProps - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - OutData%NumTwrNds = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrElev not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TwrElev)) DEALLOCATE(OutData%TwrElev) - ALLOCATE(OutData%TwrElev(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrElev.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrElev,1), UBOUND(OutData%TwrElev,1) - OutData%TwrElev(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrDiam not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TwrDiam)) DEALLOCATE(OutData%TwrDiam) - ALLOCATE(OutData%TwrDiam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrDiam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrDiam,1), UBOUND(OutData%TwrDiam,1) - OutData%TwrDiam(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrCd not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TwrCd)) DEALLOCATE(OutData%TwrCd) - ALLOCATE(OutData%TwrCd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrCd,1), UBOUND(OutData%TwrCd,1) - OutData%TwrCd(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrTI not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TwrTI)) DEALLOCATE(OutData%TwrTI) - ALLOCATE(OutData%TwrTI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrTI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrTI,1), UBOUND(OutData%TwrTI,1) - OutData%TwrTI(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrCb not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TwrCb)) DEALLOCATE(OutData%TwrCb) - ALLOCATE(OutData%TwrCb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrCb,1), UBOUND(OutData%TwrCb,1) - OutData%TwrCb(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%VolHub = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HubCenBx = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VolNac = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%NacCenB,1) - i1_u = UBOUND(OutData%NacCenB,1) - DO i1 = LBOUND(OutData%NacCenB,1), UBOUND(OutData%NacCenB,1) - OutData%NacCenB(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%TFinAero = TRANSFER(IntKiBuf(Int_Xferred), OutData%TFinAero) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%TFinFile) - OutData%TFinFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackTFinInputFileType( Re_Buf, Db_Buf, Int_Buf, OutData%TFin, ErrStat2, ErrMsg2 ) ! TFin - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE AD_UnPackRotInputFile +subroutine AD_PackRotInputFile(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(RotInputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackRotInputFile' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! BladeProps + call RegPack(Buf, allocated(InData%BladeProps)) + if (allocated(InData%BladeProps)) then + call RegPackBounds(Buf, 1, lbound(InData%BladeProps), ubound(InData%BladeProps)) + LB(1:1) = lbound(InData%BladeProps) + UB(1:1) = ubound(InData%BladeProps) + do i1 = LB(1), UB(1) + call AD_PackBladePropsType(Buf, InData%BladeProps(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NumTwrNds + call RegPack(Buf, InData%NumTwrNds) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrElev + call RegPack(Buf, allocated(InData%TwrElev)) + if (allocated(InData%TwrElev)) then + call RegPackBounds(Buf, 1, lbound(InData%TwrElev), ubound(InData%TwrElev)) + call RegPack(Buf, InData%TwrElev) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TwrDiam + call RegPack(Buf, allocated(InData%TwrDiam)) + if (allocated(InData%TwrDiam)) then + call RegPackBounds(Buf, 1, lbound(InData%TwrDiam), ubound(InData%TwrDiam)) + call RegPack(Buf, InData%TwrDiam) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TwrCd + call RegPack(Buf, allocated(InData%TwrCd)) + if (allocated(InData%TwrCd)) then + call RegPackBounds(Buf, 1, lbound(InData%TwrCd), ubound(InData%TwrCd)) + call RegPack(Buf, InData%TwrCd) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TwrTI + call RegPack(Buf, allocated(InData%TwrTI)) + if (allocated(InData%TwrTI)) then + call RegPackBounds(Buf, 1, lbound(InData%TwrTI), ubound(InData%TwrTI)) + call RegPack(Buf, InData%TwrTI) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TwrCb + call RegPack(Buf, allocated(InData%TwrCb)) + if (allocated(InData%TwrCb)) then + call RegPackBounds(Buf, 1, lbound(InData%TwrCb), ubound(InData%TwrCb)) + call RegPack(Buf, InData%TwrCb) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! VolHub + call RegPack(Buf, InData%VolHub) + if (RegCheckErr(Buf, RoutineName)) return + ! HubCenBx + call RegPack(Buf, InData%HubCenBx) + if (RegCheckErr(Buf, RoutineName)) return + ! VolNac + call RegPack(Buf, InData%VolNac) + if (RegCheckErr(Buf, RoutineName)) return + ! NacCenB + call RegPack(Buf, InData%NacCenB) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinAero + call RegPack(Buf, InData%TFinAero) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinFile + call RegPack(Buf, InData%TFinFile) + if (RegCheckErr(Buf, RoutineName)) return + ! TFin + call AD_PackTFinInputFileType(Buf, InData%TFin) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackRotInputFile(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(RotInputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackRotInputFile' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! BladeProps + if (allocated(OutData%BladeProps)) deallocate(OutData%BladeProps) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BladeProps(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeProps.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackBladePropsType(Buf, OutData%BladeProps(i1)) ! BladeProps + end do + end if + ! NumTwrNds + call RegUnpack(Buf, OutData%NumTwrNds) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrElev + if (allocated(OutData%TwrElev)) deallocate(OutData%TwrElev) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrElev(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrElev.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrElev) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TwrDiam + if (allocated(OutData%TwrDiam)) deallocate(OutData%TwrDiam) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrDiam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrDiam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrDiam) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TwrCd + if (allocated(OutData%TwrCd)) deallocate(OutData%TwrCd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrCd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrCd) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TwrTI + if (allocated(OutData%TwrTI)) deallocate(OutData%TwrTI) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrTI(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrTI.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrTI) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TwrCb + if (allocated(OutData%TwrCb)) deallocate(OutData%TwrCb) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrCb(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrCb) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! VolHub + call RegUnpack(Buf, OutData%VolHub) + if (RegCheckErr(Buf, RoutineName)) return + ! HubCenBx + call RegUnpack(Buf, OutData%HubCenBx) + if (RegCheckErr(Buf, RoutineName)) return + ! VolNac + call RegUnpack(Buf, OutData%VolNac) + if (RegCheckErr(Buf, RoutineName)) return + ! NacCenB + call RegUnpack(Buf, OutData%NacCenB) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinAero + call RegUnpack(Buf, OutData%TFinAero) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinFile + call RegUnpack(Buf, OutData%TFinFile) + if (RegCheckErr(Buf, RoutineName)) return + ! TFin + call AD_UnpackTFinInputFileType(Buf, OutData%TFin) ! TFin +end subroutine SUBROUTINE AD_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) TYPE(AD_InputFile), INTENT(IN) :: SrcInputFileData TYPE(AD_InputFile), INTENT(INOUT) :: DstInputFileData @@ -5282,662 +3020,441 @@ SUBROUTINE AD_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE AD_DestroyInputFile - SUBROUTINE AD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AD_InputFile), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_PackInputFile' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! Echo - Db_BufSz = Db_BufSz + 1 ! DTAero - Int_BufSz = Int_BufSz + 1 ! WakeMod - Int_BufSz = Int_BufSz + 1 ! AFAeroMod - Int_BufSz = Int_BufSz + 1 ! TwrPotent - Int_BufSz = Int_BufSz + 1 ! TwrShadow - Int_BufSz = Int_BufSz + 1 ! TwrAero - Int_BufSz = Int_BufSz + 1 ! FrozenWake - Int_BufSz = Int_BufSz + 1 ! CavitCheck - Int_BufSz = Int_BufSz + 1 ! Buoyancy - Int_BufSz = Int_BufSz + 1 ! CompAA - Int_BufSz = Int_BufSz + 1*LEN(InData%AA_InputFile) ! AA_InputFile - Int_BufSz = Int_BufSz + 1 ! ADBlFile allocated yes/no - IF ( ALLOCATED(InData%ADBlFile) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ADBlFile upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ADBlFile)*LEN(InData%ADBlFile) ! ADBlFile - END IF - Re_BufSz = Re_BufSz + 1 ! AirDens - Re_BufSz = Re_BufSz + 1 ! KinVisc - Re_BufSz = Re_BufSz + 1 ! Patm - Re_BufSz = Re_BufSz + 1 ! Pvap - Re_BufSz = Re_BufSz + 1 ! SpdSound - Int_BufSz = Int_BufSz + 1 ! SkewMod - Re_BufSz = Re_BufSz + 1 ! SkewModFactor - Int_BufSz = Int_BufSz + 1 ! TipLoss - Int_BufSz = Int_BufSz + 1 ! HubLoss - Int_BufSz = Int_BufSz + 1 ! TanInd - Int_BufSz = Int_BufSz + 1 ! AIDrag - Int_BufSz = Int_BufSz + 1 ! TIDrag - Re_BufSz = Re_BufSz + 1 ! IndToler - Re_BufSz = Re_BufSz + 1 ! MaxIter - Int_BufSz = Int_BufSz + 1 ! UAMod - Int_BufSz = Int_BufSz + 1 ! FLookup - Re_BufSz = Re_BufSz + 1 ! InCol_Alfa - Re_BufSz = Re_BufSz + 1 ! InCol_Cl - Re_BufSz = Re_BufSz + 1 ! InCol_Cd - Re_BufSz = Re_BufSz + 1 ! InCol_Cm - Re_BufSz = Re_BufSz + 1 ! InCol_Cpmin - Int_BufSz = Int_BufSz + 1 ! AFTabMod - Int_BufSz = Int_BufSz + 1 ! NumAFfiles - Int_BufSz = Int_BufSz + 1*LEN(InData%FVWFileName) ! FVWFileName - Int_BufSz = Int_BufSz + 1 ! AFNames allocated yes/no - IF ( ALLOCATED(InData%AFNames) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AFNames upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%AFNames)*LEN(InData%AFNames) ! AFNames - END IF - Int_BufSz = Int_BufSz + 1 ! UseBlCm - Int_BufSz = Int_BufSz + 1 ! SumPrint - Int_BufSz = Int_BufSz + 1 ! NBlOuts - Int_BufSz = Int_BufSz + SIZE(InData%BlOutNd) ! BlOutNd - Int_BufSz = Int_BufSz + 1 ! NTwOuts - Int_BufSz = Int_BufSz + SIZE(InData%TwOutNd) ! TwOutNd - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! OutList allocated yes/no - IF ( ALLOCATED(InData%OutList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%OutList)*LEN(InData%OutList) ! OutList - END IF - Re_BufSz = Re_BufSz + 1 ! tau1_const - Int_BufSz = Int_BufSz + 1 ! DBEMT_Mod - Int_BufSz = Int_BufSz + 1 ! BldNd_NumOuts - Int_BufSz = Int_BufSz + 1 ! BldNd_OutList allocated yes/no - IF ( ALLOCATED(InData%BldNd_OutList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BldNd_OutList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BldNd_OutList)*LEN(InData%BldNd_OutList) ! BldNd_OutList - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%BldNd_BlOutNd_Str) ! BldNd_BlOutNd_Str - Int_BufSz = Int_BufSz + 1 ! BldNd_BladesOut - Re_BufSz = Re_BufSz + 1 ! UAStartRad - Re_BufSz = Re_BufSz + 1 ! UAEndRad - Int_BufSz = Int_BufSz + 1 ! rotors allocated yes/no - IF ( ALLOCATED(InData%rotors) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotors upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - Int_BufSz = Int_BufSz + 3 ! rotors: size of buffers for each call to pack subtype - CALL AD_PackRotInputFile( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! rotors - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! rotors - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! rotors - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = TRANSFER(InData%Echo, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%DTAero - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WakeMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%AFAeroMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TwrPotent - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TwrShadow - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TwrAero, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FrozenWake, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%CavitCheck, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Buoyancy, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%CompAA, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%AA_InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%AA_InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%ADBlFile) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ADBlFile,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ADBlFile,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ADBlFile,1), UBOUND(InData%ADBlFile,1) - DO I = 1, LEN(InData%ADBlFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%ADBlFile(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - ReKiBuf(Re_Xferred) = InData%AirDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%KinVisc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Patm - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Pvap - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SpdSound - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%SkewMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SkewModFactor - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TipLoss, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%HubLoss, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TanInd, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%AIDrag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TIDrag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%IndToler - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MaxIter - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UAMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FLookup, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%InCol_Alfa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%InCol_Cl - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%InCol_Cd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%InCol_Cm - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%InCol_Cpmin - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%AFTabMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumAFfiles - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%FVWFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%FVWFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%AFNames) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFNames,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFNames,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AFNames,1), UBOUND(InData%AFNames,1) - DO I = 1, LEN(InData%AFNames) - IntKiBuf(Int_Xferred) = ICHAR(InData%AFNames(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseBlCm, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NBlOuts - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%BlOutNd,1), UBOUND(InData%BlOutNd,1) - IntKiBuf(Int_Xferred) = InData%BlOutNd(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%NTwOuts - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%TwOutNd,1), UBOUND(InData%TwOutNd,1) - IntKiBuf(Int_Xferred) = InData%TwOutNd(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) - DO I = 1, LEN(InData%OutList) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - ReKiBuf(Re_Xferred) = InData%tau1_const - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%DBEMT_Mod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%BldNd_NumOuts - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BldNd_OutList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldNd_OutList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_OutList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BldNd_OutList,1), UBOUND(InData%BldNd_OutList,1) - DO I = 1, LEN(InData%BldNd_OutList) - IntKiBuf(Int_Xferred) = ICHAR(InData%BldNd_OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - DO I = 1, LEN(InData%BldNd_BlOutNd_Str) - IntKiBuf(Int_Xferred) = ICHAR(InData%BldNd_BlOutNd_Str(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%BldNd_BladesOut - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%UAStartRad - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%UAEndRad - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%rotors) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rotors,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotors,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - CALL AD_PackRotInputFile( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - END SUBROUTINE AD_PackInputFile - - SUBROUTINE AD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AD_InputFile), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackInputFile' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%Echo = TRANSFER(IntKiBuf(Int_Xferred), OutData%Echo) - Int_Xferred = Int_Xferred + 1 - OutData%DTAero = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%WakeMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%AFAeroMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TwrPotent = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TwrShadow = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TwrAero = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwrAero) - Int_Xferred = Int_Xferred + 1 - OutData%FrozenWake = TRANSFER(IntKiBuf(Int_Xferred), OutData%FrozenWake) - Int_Xferred = Int_Xferred + 1 - OutData%CavitCheck = TRANSFER(IntKiBuf(Int_Xferred), OutData%CavitCheck) - Int_Xferred = Int_Xferred + 1 - OutData%Buoyancy = TRANSFER(IntKiBuf(Int_Xferred), OutData%Buoyancy) - Int_Xferred = Int_Xferred + 1 - OutData%CompAA = TRANSFER(IntKiBuf(Int_Xferred), OutData%CompAA) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%AA_InputFile) - OutData%AA_InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ADBlFile not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ADBlFile)) DEALLOCATE(OutData%ADBlFile) - ALLOCATE(OutData%ADBlFile(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ADBlFile.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ADBlFile,1), UBOUND(OutData%ADBlFile,1) - DO I = 1, LEN(OutData%ADBlFile) - OutData%ADBlFile(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - OutData%AirDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%KinVisc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Patm = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Pvap = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SpdSound = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SkewMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%SkewModFactor = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TipLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%TipLoss) - Int_Xferred = Int_Xferred + 1 - OutData%HubLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%HubLoss) - Int_Xferred = Int_Xferred + 1 - OutData%TanInd = TRANSFER(IntKiBuf(Int_Xferred), OutData%TanInd) - Int_Xferred = Int_Xferred + 1 - OutData%AIDrag = TRANSFER(IntKiBuf(Int_Xferred), OutData%AIDrag) - Int_Xferred = Int_Xferred + 1 - OutData%TIDrag = TRANSFER(IntKiBuf(Int_Xferred), OutData%TIDrag) - Int_Xferred = Int_Xferred + 1 - OutData%IndToler = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MaxIter = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%UAMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FLookup = TRANSFER(IntKiBuf(Int_Xferred), OutData%FLookup) - Int_Xferred = Int_Xferred + 1 - OutData%InCol_Alfa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%InCol_Cl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%InCol_Cd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%InCol_Cm = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%InCol_Cpmin = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AFTabMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumAFfiles = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%FVWFileName) - OutData%FVWFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFNames not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AFNames)) DEALLOCATE(OutData%AFNames) - ALLOCATE(OutData%AFNames(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFNames.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AFNames,1), UBOUND(OutData%AFNames,1) - DO I = 1, LEN(OutData%AFNames) - OutData%AFNames(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - OutData%UseBlCm = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseBlCm) - Int_Xferred = Int_Xferred + 1 - OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) - Int_Xferred = Int_Xferred + 1 - OutData%NBlOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%BlOutNd,1) - i1_u = UBOUND(OutData%BlOutNd,1) - DO i1 = LBOUND(OutData%BlOutNd,1), UBOUND(OutData%BlOutNd,1) - OutData%BlOutNd(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%NTwOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%TwOutNd,1) - i1_u = UBOUND(OutData%TwOutNd,1) - DO i1 = LBOUND(OutData%TwOutNd,1), UBOUND(OutData%TwOutNd,1) - OutData%TwOutNd(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutList not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutList)) DEALLOCATE(OutData%OutList) - ALLOCATE(OutData%OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) - DO I = 1, LEN(OutData%OutList) - OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - OutData%tau1_const = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DBEMT_Mod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%BldNd_NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_OutList not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BldNd_OutList)) DEALLOCATE(OutData%BldNd_OutList) - ALLOCATE(OutData%BldNd_OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BldNd_OutList,1), UBOUND(OutData%BldNd_OutList,1) - DO I = 1, LEN(OutData%BldNd_OutList) - OutData%BldNd_OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - DO I = 1, LEN(OutData%BldNd_BlOutNd_Str) - OutData%BldNd_BlOutNd_Str(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%BldNd_BladesOut = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UAStartRad = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%UAEndRad = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rotors not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rotors)) DEALLOCATE(OutData%rotors) - ALLOCATE(OutData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotors,1), UBOUND(OutData%rotors,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackRotInputFile( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - END SUBROUTINE AD_UnPackInputFile +subroutine AD_PackInputFile(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD_InputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackInputFile' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! Echo + call RegPack(Buf, InData%Echo) + if (RegCheckErr(Buf, RoutineName)) return + ! DTAero + call RegPack(Buf, InData%DTAero) + if (RegCheckErr(Buf, RoutineName)) return + ! WakeMod + call RegPack(Buf, InData%WakeMod) + if (RegCheckErr(Buf, RoutineName)) return + ! AFAeroMod + call RegPack(Buf, InData%AFAeroMod) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrPotent + call RegPack(Buf, InData%TwrPotent) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrShadow + call RegPack(Buf, InData%TwrShadow) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrAero + call RegPack(Buf, InData%TwrAero) + if (RegCheckErr(Buf, RoutineName)) return + ! FrozenWake + call RegPack(Buf, InData%FrozenWake) + if (RegCheckErr(Buf, RoutineName)) return + ! CavitCheck + call RegPack(Buf, InData%CavitCheck) + if (RegCheckErr(Buf, RoutineName)) return + ! Buoyancy + call RegPack(Buf, InData%Buoyancy) + if (RegCheckErr(Buf, RoutineName)) return + ! CompAA + call RegPack(Buf, InData%CompAA) + if (RegCheckErr(Buf, RoutineName)) return + ! AA_InputFile + call RegPack(Buf, InData%AA_InputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! ADBlFile + call RegPack(Buf, allocated(InData%ADBlFile)) + if (allocated(InData%ADBlFile)) then + call RegPackBounds(Buf, 1, lbound(InData%ADBlFile), ubound(InData%ADBlFile)) + call RegPack(Buf, InData%ADBlFile) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AirDens + call RegPack(Buf, InData%AirDens) + if (RegCheckErr(Buf, RoutineName)) return + ! KinVisc + call RegPack(Buf, InData%KinVisc) + if (RegCheckErr(Buf, RoutineName)) return + ! Patm + call RegPack(Buf, InData%Patm) + if (RegCheckErr(Buf, RoutineName)) return + ! Pvap + call RegPack(Buf, InData%Pvap) + if (RegCheckErr(Buf, RoutineName)) return + ! SpdSound + call RegPack(Buf, InData%SpdSound) + if (RegCheckErr(Buf, RoutineName)) return + ! SkewMod + call RegPack(Buf, InData%SkewMod) + if (RegCheckErr(Buf, RoutineName)) return + ! SkewModFactor + call RegPack(Buf, InData%SkewModFactor) + if (RegCheckErr(Buf, RoutineName)) return + ! TipLoss + call RegPack(Buf, InData%TipLoss) + if (RegCheckErr(Buf, RoutineName)) return + ! HubLoss + call RegPack(Buf, InData%HubLoss) + if (RegCheckErr(Buf, RoutineName)) return + ! TanInd + call RegPack(Buf, InData%TanInd) + if (RegCheckErr(Buf, RoutineName)) return + ! AIDrag + call RegPack(Buf, InData%AIDrag) + if (RegCheckErr(Buf, RoutineName)) return + ! TIDrag + call RegPack(Buf, InData%TIDrag) + if (RegCheckErr(Buf, RoutineName)) return + ! IndToler + call RegPack(Buf, InData%IndToler) + if (RegCheckErr(Buf, RoutineName)) return + ! MaxIter + call RegPack(Buf, InData%MaxIter) + if (RegCheckErr(Buf, RoutineName)) return + ! UAMod + call RegPack(Buf, InData%UAMod) + if (RegCheckErr(Buf, RoutineName)) return + ! FLookup + call RegPack(Buf, InData%FLookup) + if (RegCheckErr(Buf, RoutineName)) return + ! InCol_Alfa + call RegPack(Buf, InData%InCol_Alfa) + if (RegCheckErr(Buf, RoutineName)) return + ! InCol_Cl + call RegPack(Buf, InData%InCol_Cl) + if (RegCheckErr(Buf, RoutineName)) return + ! InCol_Cd + call RegPack(Buf, InData%InCol_Cd) + if (RegCheckErr(Buf, RoutineName)) return + ! InCol_Cm + call RegPack(Buf, InData%InCol_Cm) + if (RegCheckErr(Buf, RoutineName)) return + ! InCol_Cpmin + call RegPack(Buf, InData%InCol_Cpmin) + if (RegCheckErr(Buf, RoutineName)) return + ! AFTabMod + call RegPack(Buf, InData%AFTabMod) + if (RegCheckErr(Buf, RoutineName)) return + ! NumAFfiles + call RegPack(Buf, InData%NumAFfiles) + if (RegCheckErr(Buf, RoutineName)) return + ! FVWFileName + call RegPack(Buf, InData%FVWFileName) + if (RegCheckErr(Buf, RoutineName)) return + ! AFNames + call RegPack(Buf, allocated(InData%AFNames)) + if (allocated(InData%AFNames)) then + call RegPackBounds(Buf, 1, lbound(InData%AFNames), ubound(InData%AFNames)) + call RegPack(Buf, InData%AFNames) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! UseBlCm + call RegPack(Buf, InData%UseBlCm) + if (RegCheckErr(Buf, RoutineName)) return + ! SumPrint + call RegPack(Buf, InData%SumPrint) + if (RegCheckErr(Buf, RoutineName)) return + ! NBlOuts + call RegPack(Buf, InData%NBlOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! BlOutNd + call RegPack(Buf, InData%BlOutNd) + if (RegCheckErr(Buf, RoutineName)) return + ! NTwOuts + call RegPack(Buf, InData%NTwOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! TwOutNd + call RegPack(Buf, InData%TwOutNd) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegPack(Buf, InData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! OutList + call RegPack(Buf, allocated(InData%OutList)) + if (allocated(InData%OutList)) then + call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) + call RegPack(Buf, InData%OutList) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! tau1_const + call RegPack(Buf, InData%tau1_const) + if (RegCheckErr(Buf, RoutineName)) return + ! DBEMT_Mod + call RegPack(Buf, InData%DBEMT_Mod) + if (RegCheckErr(Buf, RoutineName)) return + ! BldNd_NumOuts + call RegPack(Buf, InData%BldNd_NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! BldNd_OutList + call RegPack(Buf, allocated(InData%BldNd_OutList)) + if (allocated(InData%BldNd_OutList)) then + call RegPackBounds(Buf, 1, lbound(InData%BldNd_OutList), ubound(InData%BldNd_OutList)) + call RegPack(Buf, InData%BldNd_OutList) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BldNd_BlOutNd_Str + call RegPack(Buf, InData%BldNd_BlOutNd_Str) + if (RegCheckErr(Buf, RoutineName)) return + ! BldNd_BladesOut + call RegPack(Buf, InData%BldNd_BladesOut) + if (RegCheckErr(Buf, RoutineName)) return + ! UAStartRad + call RegPack(Buf, InData%UAStartRad) + if (RegCheckErr(Buf, RoutineName)) return + ! UAEndRad + call RegPack(Buf, InData%UAEndRad) + if (RegCheckErr(Buf, RoutineName)) return + ! rotors + call RegPack(Buf, allocated(InData%rotors)) + if (allocated(InData%rotors)) then + call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) + do i1 = LB(1), UB(1) + call AD_PackRotInputFile(Buf, InData%rotors(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackInputFile(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD_InputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackInputFile' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! Echo + call RegUnpack(Buf, OutData%Echo) + if (RegCheckErr(Buf, RoutineName)) return + ! DTAero + call RegUnpack(Buf, OutData%DTAero) + if (RegCheckErr(Buf, RoutineName)) return + ! WakeMod + call RegUnpack(Buf, OutData%WakeMod) + if (RegCheckErr(Buf, RoutineName)) return + ! AFAeroMod + call RegUnpack(Buf, OutData%AFAeroMod) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrPotent + call RegUnpack(Buf, OutData%TwrPotent) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrShadow + call RegUnpack(Buf, OutData%TwrShadow) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrAero + call RegUnpack(Buf, OutData%TwrAero) + if (RegCheckErr(Buf, RoutineName)) return + ! FrozenWake + call RegUnpack(Buf, OutData%FrozenWake) + if (RegCheckErr(Buf, RoutineName)) return + ! CavitCheck + call RegUnpack(Buf, OutData%CavitCheck) + if (RegCheckErr(Buf, RoutineName)) return + ! Buoyancy + call RegUnpack(Buf, OutData%Buoyancy) + if (RegCheckErr(Buf, RoutineName)) return + ! CompAA + call RegUnpack(Buf, OutData%CompAA) + if (RegCheckErr(Buf, RoutineName)) return + ! AA_InputFile + call RegUnpack(Buf, OutData%AA_InputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! ADBlFile + if (allocated(OutData%ADBlFile)) deallocate(OutData%ADBlFile) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ADBlFile(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ADBlFile.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ADBlFile) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AirDens + call RegUnpack(Buf, OutData%AirDens) + if (RegCheckErr(Buf, RoutineName)) return + ! KinVisc + call RegUnpack(Buf, OutData%KinVisc) + if (RegCheckErr(Buf, RoutineName)) return + ! Patm + call RegUnpack(Buf, OutData%Patm) + if (RegCheckErr(Buf, RoutineName)) return + ! Pvap + call RegUnpack(Buf, OutData%Pvap) + if (RegCheckErr(Buf, RoutineName)) return + ! SpdSound + call RegUnpack(Buf, OutData%SpdSound) + if (RegCheckErr(Buf, RoutineName)) return + ! SkewMod + call RegUnpack(Buf, OutData%SkewMod) + if (RegCheckErr(Buf, RoutineName)) return + ! SkewModFactor + call RegUnpack(Buf, OutData%SkewModFactor) + if (RegCheckErr(Buf, RoutineName)) return + ! TipLoss + call RegUnpack(Buf, OutData%TipLoss) + if (RegCheckErr(Buf, RoutineName)) return + ! HubLoss + call RegUnpack(Buf, OutData%HubLoss) + if (RegCheckErr(Buf, RoutineName)) return + ! TanInd + call RegUnpack(Buf, OutData%TanInd) + if (RegCheckErr(Buf, RoutineName)) return + ! AIDrag + call RegUnpack(Buf, OutData%AIDrag) + if (RegCheckErr(Buf, RoutineName)) return + ! TIDrag + call RegUnpack(Buf, OutData%TIDrag) + if (RegCheckErr(Buf, RoutineName)) return + ! IndToler + call RegUnpack(Buf, OutData%IndToler) + if (RegCheckErr(Buf, RoutineName)) return + ! MaxIter + call RegUnpack(Buf, OutData%MaxIter) + if (RegCheckErr(Buf, RoutineName)) return + ! UAMod + call RegUnpack(Buf, OutData%UAMod) + if (RegCheckErr(Buf, RoutineName)) return + ! FLookup + call RegUnpack(Buf, OutData%FLookup) + if (RegCheckErr(Buf, RoutineName)) return + ! InCol_Alfa + call RegUnpack(Buf, OutData%InCol_Alfa) + if (RegCheckErr(Buf, RoutineName)) return + ! InCol_Cl + call RegUnpack(Buf, OutData%InCol_Cl) + if (RegCheckErr(Buf, RoutineName)) return + ! InCol_Cd + call RegUnpack(Buf, OutData%InCol_Cd) + if (RegCheckErr(Buf, RoutineName)) return + ! InCol_Cm + call RegUnpack(Buf, OutData%InCol_Cm) + if (RegCheckErr(Buf, RoutineName)) return + ! InCol_Cpmin + call RegUnpack(Buf, OutData%InCol_Cpmin) + if (RegCheckErr(Buf, RoutineName)) return + ! AFTabMod + call RegUnpack(Buf, OutData%AFTabMod) + if (RegCheckErr(Buf, RoutineName)) return + ! NumAFfiles + call RegUnpack(Buf, OutData%NumAFfiles) + if (RegCheckErr(Buf, RoutineName)) return + ! FVWFileName + call RegUnpack(Buf, OutData%FVWFileName) + if (RegCheckErr(Buf, RoutineName)) return + ! AFNames + if (allocated(OutData%AFNames)) deallocate(OutData%AFNames) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AFNames(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFNames.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AFNames) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! UseBlCm + call RegUnpack(Buf, OutData%UseBlCm) + if (RegCheckErr(Buf, RoutineName)) return + ! SumPrint + call RegUnpack(Buf, OutData%SumPrint) + if (RegCheckErr(Buf, RoutineName)) return + ! NBlOuts + call RegUnpack(Buf, OutData%NBlOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! BlOutNd + call RegUnpack(Buf, OutData%BlOutNd) + if (RegCheckErr(Buf, RoutineName)) return + ! NTwOuts + call RegUnpack(Buf, OutData%NTwOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! TwOutNd + call RegUnpack(Buf, OutData%TwOutNd) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! OutList + if (allocated(OutData%OutList)) deallocate(OutData%OutList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutList) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! tau1_const + call RegUnpack(Buf, OutData%tau1_const) + if (RegCheckErr(Buf, RoutineName)) return + ! DBEMT_Mod + call RegUnpack(Buf, OutData%DBEMT_Mod) + if (RegCheckErr(Buf, RoutineName)) return + ! BldNd_NumOuts + call RegUnpack(Buf, OutData%BldNd_NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! BldNd_OutList + if (allocated(OutData%BldNd_OutList)) deallocate(OutData%BldNd_OutList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BldNd_OutList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BldNd_OutList) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BldNd_BlOutNd_Str + call RegUnpack(Buf, OutData%BldNd_BlOutNd_Str) + if (RegCheckErr(Buf, RoutineName)) return + ! BldNd_BladesOut + call RegUnpack(Buf, OutData%BldNd_BladesOut) + if (RegCheckErr(Buf, RoutineName)) return + ! UAStartRad + call RegUnpack(Buf, OutData%UAStartRad) + if (RegCheckErr(Buf, RoutineName)) return + ! UAEndRad + call RegUnpack(Buf, OutData%UAEndRad) + if (RegCheckErr(Buf, RoutineName)) return + ! rotors + if (allocated(OutData%rotors)) deallocate(OutData%rotors) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rotors(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackRotInputFile(Buf, OutData%rotors(i1)) ! rotors + end do + end if +end subroutine SUBROUTINE AD_CopyRotContinuousStateType( SrcRotContinuousStateTypeData, DstRotContinuousStateTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(RotContinuousStateType), INTENT(IN) :: SrcRotContinuousStateTypeData TYPE(RotContinuousStateType), INTENT(INOUT) :: DstRotContinuousStateTypeData @@ -5979,269 +3496,30 @@ SUBROUTINE AD_DestroyRotContinuousStateType( RotContinuousStateTypeData, ErrStat CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AD_DestroyRotContinuousStateType - SUBROUTINE AD_PackRotContinuousStateType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(RotContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_PackRotContinuousStateType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! BEMT: size of buffers for each call to pack subtype - CALL BEMT_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%BEMT, ErrStat2, ErrMsg2, .TRUE. ) ! BEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BEMT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BEMT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BEMT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! AA: size of buffers for each call to pack subtype - CALL AA_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, .TRUE. ) ! AA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL BEMT_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%BEMT, ErrStat2, ErrMsg2, OnlySize ) ! BEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AA_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, OnlySize ) ! AA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE AD_PackRotContinuousStateType - - SUBROUTINE AD_UnPackRotContinuousStateType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(RotContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackRotContinuousStateType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL BEMT_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%BEMT, ErrStat2, ErrMsg2 ) ! BEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AA_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%AA, ErrStat2, ErrMsg2 ) ! AA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE AD_UnPackRotContinuousStateType +subroutine AD_PackRotContinuousStateType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(RotContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackRotContinuousStateType' + if (Buf%ErrStat >= AbortErrLev) return + ! BEMT + call BEMT_PackContState(Buf, InData%BEMT) + if (RegCheckErr(Buf, RoutineName)) return + ! AA + call AA_PackContState(Buf, InData%AA) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackRotContinuousStateType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(RotContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackRotContinuousStateType' + if (Buf%ErrStat /= ErrID_None) return + ! BEMT + call BEMT_UnpackContState(Buf, OutData%BEMT) ! BEMT + ! AA + call AA_UnpackContState(Buf, OutData%AA) ! AA +end subroutine SUBROUTINE AD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(AD_ContinuousStateType), INTENT(IN) :: SrcContStateData TYPE(AD_ContinuousStateType), INTENT(INOUT) :: DstContStateData @@ -6302,305 +3580,58 @@ SUBROUTINE AD_DestroyContState( ContStateData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AD_DestroyContState - SUBROUTINE AD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AD_ContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_PackContState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! rotors allocated yes/no - IF ( ALLOCATED(InData%rotors) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotors upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - Int_BufSz = Int_BufSz + 3 ! rotors: size of buffers for each call to pack subtype - CALL AD_PackRotContinuousStateType( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! rotors - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! rotors - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! rotors - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! FVW: size of buffers for each call to pack subtype - CALL FVW_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, .TRUE. ) ! FVW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FVW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FVW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FVW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%rotors) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rotors,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotors,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - CALL AD_PackRotContinuousStateType( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL FVW_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, OnlySize ) ! FVW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE AD_PackContState - - SUBROUTINE AD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AD_ContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackContState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rotors not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rotors)) DEALLOCATE(OutData%rotors) - ALLOCATE(OutData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotors,1), UBOUND(OutData%rotors,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackRotContinuousStateType( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FVW_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%FVW, ErrStat2, ErrMsg2 ) ! FVW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE AD_UnPackContState +subroutine AD_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackContState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! rotors + call RegPack(Buf, allocated(InData%rotors)) + if (allocated(InData%rotors)) then + call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) + do i1 = LB(1), UB(1) + call AD_PackRotContinuousStateType(Buf, InData%rotors(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FVW + call FVW_PackContState(Buf, InData%FVW) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackContState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! rotors + if (allocated(OutData%rotors)) deallocate(OutData%rotors) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rotors(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackRotContinuousStateType(Buf, OutData%rotors(i1)) ! rotors + end do + end if + ! FVW + call FVW_UnpackContState(Buf, OutData%FVW) ! FVW +end subroutine SUBROUTINE AD_CopyRotDiscreteStateType( SrcRotDiscreteStateTypeData, DstRotDiscreteStateTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(RotDiscreteStateType), INTENT(IN) :: SrcRotDiscreteStateTypeData TYPE(RotDiscreteStateType), INTENT(INOUT) :: DstRotDiscreteStateTypeData @@ -6642,269 +3673,30 @@ SUBROUTINE AD_DestroyRotDiscreteStateType( RotDiscreteStateTypeData, ErrStat, Er CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AD_DestroyRotDiscreteStateType - SUBROUTINE AD_PackRotDiscreteStateType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(RotDiscreteStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_PackRotDiscreteStateType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! BEMT: size of buffers for each call to pack subtype - CALL BEMT_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%BEMT, ErrStat2, ErrMsg2, .TRUE. ) ! BEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BEMT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BEMT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BEMT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! AA: size of buffers for each call to pack subtype - CALL AA_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, .TRUE. ) ! AA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL BEMT_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%BEMT, ErrStat2, ErrMsg2, OnlySize ) ! BEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AA_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, OnlySize ) ! AA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE AD_PackRotDiscreteStateType - - SUBROUTINE AD_UnPackRotDiscreteStateType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(RotDiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackRotDiscreteStateType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL BEMT_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%BEMT, ErrStat2, ErrMsg2 ) ! BEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AA_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%AA, ErrStat2, ErrMsg2 ) ! AA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE AD_UnPackRotDiscreteStateType +subroutine AD_PackRotDiscreteStateType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(RotDiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackRotDiscreteStateType' + if (Buf%ErrStat >= AbortErrLev) return + ! BEMT + call BEMT_PackDiscState(Buf, InData%BEMT) + if (RegCheckErr(Buf, RoutineName)) return + ! AA + call AA_PackDiscState(Buf, InData%AA) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackRotDiscreteStateType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(RotDiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackRotDiscreteStateType' + if (Buf%ErrStat /= ErrID_None) return + ! BEMT + call BEMT_UnpackDiscState(Buf, OutData%BEMT) ! BEMT + ! AA + call AA_UnpackDiscState(Buf, OutData%AA) ! AA +end subroutine SUBROUTINE AD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(AD_DiscreteStateType), INTENT(IN) :: SrcDiscStateData TYPE(AD_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData @@ -6965,305 +3757,58 @@ SUBROUTINE AD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AD_DestroyDiscState - SUBROUTINE AD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AD_DiscreteStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_PackDiscState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! rotors allocated yes/no - IF ( ALLOCATED(InData%rotors) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotors upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - Int_BufSz = Int_BufSz + 3 ! rotors: size of buffers for each call to pack subtype - CALL AD_PackRotDiscreteStateType( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! rotors - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! rotors - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! rotors - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! FVW: size of buffers for each call to pack subtype - CALL FVW_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, .TRUE. ) ! FVW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FVW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FVW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FVW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%rotors) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rotors,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotors,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - CALL AD_PackRotDiscreteStateType( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL FVW_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, OnlySize ) ! FVW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE AD_PackDiscState - - SUBROUTINE AD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AD_DiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackDiscState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rotors not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rotors)) DEALLOCATE(OutData%rotors) - ALLOCATE(OutData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotors,1), UBOUND(OutData%rotors,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackRotDiscreteStateType( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FVW_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%FVW, ErrStat2, ErrMsg2 ) ! FVW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE AD_UnPackDiscState +subroutine AD_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackDiscState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! rotors + call RegPack(Buf, allocated(InData%rotors)) + if (allocated(InData%rotors)) then + call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) + do i1 = LB(1), UB(1) + call AD_PackRotDiscreteStateType(Buf, InData%rotors(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FVW + call FVW_PackDiscState(Buf, InData%FVW) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackDiscState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! rotors + if (allocated(OutData%rotors)) deallocate(OutData%rotors) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rotors(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackRotDiscreteStateType(Buf, OutData%rotors(i1)) ! rotors + end do + end if + ! FVW + call FVW_UnpackDiscState(Buf, OutData%FVW) ! FVW +end subroutine SUBROUTINE AD_CopyRotConstraintStateType( SrcRotConstraintStateTypeData, DstRotConstraintStateTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(RotConstraintStateType), INTENT(IN) :: SrcRotConstraintStateTypeData TYPE(RotConstraintStateType), INTENT(INOUT) :: DstRotConstraintStateTypeData @@ -7305,269 +3850,30 @@ SUBROUTINE AD_DestroyRotConstraintStateType( RotConstraintStateTypeData, ErrStat CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AD_DestroyRotConstraintStateType - SUBROUTINE AD_PackRotConstraintStateType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(RotConstraintStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_PackRotConstraintStateType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! BEMT: size of buffers for each call to pack subtype - CALL BEMT_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%BEMT, ErrStat2, ErrMsg2, .TRUE. ) ! BEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BEMT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BEMT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BEMT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! AA: size of buffers for each call to pack subtype - CALL AA_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, .TRUE. ) ! AA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL BEMT_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%BEMT, ErrStat2, ErrMsg2, OnlySize ) ! BEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AA_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, OnlySize ) ! AA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE AD_PackRotConstraintStateType - - SUBROUTINE AD_UnPackRotConstraintStateType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(RotConstraintStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackRotConstraintStateType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL BEMT_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%BEMT, ErrStat2, ErrMsg2 ) ! BEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AA_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%AA, ErrStat2, ErrMsg2 ) ! AA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE AD_UnPackRotConstraintStateType +subroutine AD_PackRotConstraintStateType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(RotConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackRotConstraintStateType' + if (Buf%ErrStat >= AbortErrLev) return + ! BEMT + call BEMT_PackConstrState(Buf, InData%BEMT) + if (RegCheckErr(Buf, RoutineName)) return + ! AA + call AA_PackConstrState(Buf, InData%AA) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackRotConstraintStateType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(RotConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackRotConstraintStateType' + if (Buf%ErrStat /= ErrID_None) return + ! BEMT + call BEMT_UnpackConstrState(Buf, OutData%BEMT) ! BEMT + ! AA + call AA_UnpackConstrState(Buf, OutData%AA) ! AA +end subroutine SUBROUTINE AD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(AD_ConstraintStateType), INTENT(IN) :: SrcConstrStateData TYPE(AD_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData @@ -7628,305 +3934,58 @@ SUBROUTINE AD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AD_DestroyConstrState - SUBROUTINE AD_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AD_ConstraintStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_PackConstrState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! rotors allocated yes/no - IF ( ALLOCATED(InData%rotors) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotors upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - Int_BufSz = Int_BufSz + 3 ! rotors: size of buffers for each call to pack subtype - CALL AD_PackRotConstraintStateType( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! rotors - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! rotors - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! rotors - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! FVW: size of buffers for each call to pack subtype - CALL FVW_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, .TRUE. ) ! FVW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FVW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FVW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FVW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%rotors) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rotors,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotors,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - CALL AD_PackRotConstraintStateType( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL FVW_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, OnlySize ) ! FVW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE AD_PackConstrState - - SUBROUTINE AD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AD_ConstraintStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackConstrState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rotors not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rotors)) DEALLOCATE(OutData%rotors) - ALLOCATE(OutData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotors,1), UBOUND(OutData%rotors,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackRotConstraintStateType( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FVW_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%FVW, ErrStat2, ErrMsg2 ) ! FVW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE AD_UnPackConstrState +subroutine AD_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackConstrState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! rotors + call RegPack(Buf, allocated(InData%rotors)) + if (allocated(InData%rotors)) then + call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) + do i1 = LB(1), UB(1) + call AD_PackRotConstraintStateType(Buf, InData%rotors(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FVW + call FVW_PackConstrState(Buf, InData%FVW) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackConstrState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! rotors + if (allocated(OutData%rotors)) deallocate(OutData%rotors) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rotors(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackRotConstraintStateType(Buf, OutData%rotors(i1)) ! rotors + end do + end if + ! FVW + call FVW_UnpackConstrState(Buf, OutData%FVW) ! FVW +end subroutine SUBROUTINE AD_CopyRotOtherStateType( SrcRotOtherStateTypeData, DstRotOtherStateTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(RotOtherStateType), INTENT(IN) :: SrcRotOtherStateTypeData TYPE(RotOtherStateType), INTENT(INOUT) :: DstRotOtherStateTypeData @@ -7968,269 +4027,30 @@ SUBROUTINE AD_DestroyRotOtherStateType( RotOtherStateTypeData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AD_DestroyRotOtherStateType - SUBROUTINE AD_PackRotOtherStateType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(RotOtherStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_PackRotOtherStateType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! BEMT: size of buffers for each call to pack subtype - CALL BEMT_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%BEMT, ErrStat2, ErrMsg2, .TRUE. ) ! BEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BEMT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BEMT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BEMT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! AA: size of buffers for each call to pack subtype - CALL AA_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, .TRUE. ) ! AA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL BEMT_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%BEMT, ErrStat2, ErrMsg2, OnlySize ) ! BEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AA_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, OnlySize ) ! AA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE AD_PackRotOtherStateType - - SUBROUTINE AD_UnPackRotOtherStateType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(RotOtherStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackRotOtherStateType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL BEMT_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%BEMT, ErrStat2, ErrMsg2 ) ! BEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AA_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%AA, ErrStat2, ErrMsg2 ) ! AA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE AD_UnPackRotOtherStateType +subroutine AD_PackRotOtherStateType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(RotOtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackRotOtherStateType' + if (Buf%ErrStat >= AbortErrLev) return + ! BEMT + call BEMT_PackOtherState(Buf, InData%BEMT) + if (RegCheckErr(Buf, RoutineName)) return + ! AA + call AA_PackOtherState(Buf, InData%AA) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackRotOtherStateType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(RotOtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackRotOtherStateType' + if (Buf%ErrStat /= ErrID_None) return + ! BEMT + call BEMT_UnpackOtherState(Buf, OutData%BEMT) ! BEMT + ! AA + call AA_UnpackOtherState(Buf, OutData%AA) ! AA +end subroutine SUBROUTINE AD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(AD_OtherStateType), INTENT(IN) :: SrcOtherStateData TYPE(AD_OtherStateType), INTENT(INOUT) :: DstOtherStateData @@ -8309,354 +4129,80 @@ SUBROUTINE AD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE AD_DestroyOtherState - SUBROUTINE AD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AD_OtherStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_PackOtherState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! rotors allocated yes/no - IF ( ALLOCATED(InData%rotors) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotors upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - Int_BufSz = Int_BufSz + 3 ! rotors: size of buffers for each call to pack subtype - CALL AD_PackRotOtherStateType( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! rotors - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! rotors - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! rotors - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! FVW: size of buffers for each call to pack subtype - CALL FVW_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, .TRUE. ) ! FVW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FVW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FVW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FVW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! WakeLocationPoints allocated yes/no - IF ( ALLOCATED(InData%WakeLocationPoints) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WakeLocationPoints upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WakeLocationPoints) ! WakeLocationPoints - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%rotors) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rotors,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotors,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - CALL AD_PackRotOtherStateType( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL FVW_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, OnlySize ) ! FVW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%WakeLocationPoints) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WakeLocationPoints,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WakeLocationPoints,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WakeLocationPoints,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WakeLocationPoints,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WakeLocationPoints,2), UBOUND(InData%WakeLocationPoints,2) - DO i1 = LBOUND(InData%WakeLocationPoints,1), UBOUND(InData%WakeLocationPoints,1) - ReKiBuf(Re_Xferred) = InData%WakeLocationPoints(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE AD_PackOtherState - - SUBROUTINE AD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AD_OtherStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackOtherState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rotors not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rotors)) DEALLOCATE(OutData%rotors) - ALLOCATE(OutData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotors,1), UBOUND(OutData%rotors,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackRotOtherStateType( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FVW_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%FVW, ErrStat2, ErrMsg2 ) ! FVW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WakeLocationPoints not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WakeLocationPoints)) DEALLOCATE(OutData%WakeLocationPoints) - ALLOCATE(OutData%WakeLocationPoints(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WakeLocationPoints.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WakeLocationPoints,2), UBOUND(OutData%WakeLocationPoints,2) - DO i1 = LBOUND(OutData%WakeLocationPoints,1), UBOUND(OutData%WakeLocationPoints,1) - OutData%WakeLocationPoints(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE AD_UnPackOtherState +subroutine AD_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackOtherState' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + ! rotors + call RegPack(Buf, allocated(InData%rotors)) + if (allocated(InData%rotors)) then + call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) + do i1 = LB(1), UB(1) + call AD_PackRotOtherStateType(Buf, InData%rotors(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FVW + call FVW_PackOtherState(Buf, InData%FVW) + if (RegCheckErr(Buf, RoutineName)) return + ! WakeLocationPoints + call RegPack(Buf, allocated(InData%WakeLocationPoints)) + if (allocated(InData%WakeLocationPoints)) then + call RegPackBounds(Buf, 2, lbound(InData%WakeLocationPoints), ubound(InData%WakeLocationPoints)) + call RegPack(Buf, InData%WakeLocationPoints) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackOtherState' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! rotors + if (allocated(OutData%rotors)) deallocate(OutData%rotors) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rotors(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackRotOtherStateType(Buf, OutData%rotors(i1)) ! rotors + end do + end if + ! FVW + call FVW_UnpackOtherState(Buf, OutData%FVW) ! FVW + ! WakeLocationPoints + if (allocated(OutData%WakeLocationPoints)) deallocate(OutData%WakeLocationPoints) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WakeLocationPoints(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WakeLocationPoints.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WakeLocationPoints) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE AD_CopyRotMiscVarType( SrcRotMiscVarTypeData, DstRotMiscVarTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(RotMiscVarType), INTENT(INOUT) :: SrcRotMiscVarTypeData TYPE(RotMiscVarType), INTENT(INOUT) :: DstRotMiscVarTypeData @@ -9182,3240 +4728,1105 @@ SUBROUTINE AD_CopyRotMiscVarType( SrcRotMiscVarTypeData, DstRotMiscVarTypeData, DstRotMiscVarTypeData%AvgDiskVelDist = SrcRotMiscVarTypeData%AvgDiskVelDist DstRotMiscVarTypeData%TFinAlpha = SrcRotMiscVarTypeData%TFinAlpha DstRotMiscVarTypeData%TFinRe = SrcRotMiscVarTypeData%TFinRe - DstRotMiscVarTypeData%TFinVrel = SrcRotMiscVarTypeData%TFinVrel - DstRotMiscVarTypeData%TFinVund_i = SrcRotMiscVarTypeData%TFinVund_i - DstRotMiscVarTypeData%TFinVind_i = SrcRotMiscVarTypeData%TFinVind_i - DstRotMiscVarTypeData%TFinVrel_i = SrcRotMiscVarTypeData%TFinVrel_i - DstRotMiscVarTypeData%TFinSTV_i = SrcRotMiscVarTypeData%TFinSTV_i - DstRotMiscVarTypeData%TFinF_i = SrcRotMiscVarTypeData%TFinF_i - DstRotMiscVarTypeData%TFinM_i = SrcRotMiscVarTypeData%TFinM_i - END SUBROUTINE AD_CopyRotMiscVarType - - SUBROUTINE AD_DestroyRotMiscVarType( RotMiscVarTypeData, ErrStat, ErrMsg ) - TYPE(RotMiscVarType), INTENT(INOUT) :: RotMiscVarTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyRotMiscVarType' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL BEMT_DestroyMisc( RotMiscVarTypeData%BEMT, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL BEMT_DestroyOutput( RotMiscVarTypeData%BEMT_y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -DO i1 = LBOUND(RotMiscVarTypeData%BEMT_u,1), UBOUND(RotMiscVarTypeData%BEMT_u,1) - CALL BEMT_DestroyInput( RotMiscVarTypeData%BEMT_u(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL AA_DestroyMisc( RotMiscVarTypeData%AA, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AA_DestroyOutput( RotMiscVarTypeData%AA_y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AA_DestroyInput( RotMiscVarTypeData%AA_u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(RotMiscVarTypeData%DisturbedInflow)) THEN - DEALLOCATE(RotMiscVarTypeData%DisturbedInflow) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%orientationAnnulus)) THEN - DEALLOCATE(RotMiscVarTypeData%orientationAnnulus) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%AllOuts)) THEN - DEALLOCATE(RotMiscVarTypeData%AllOuts) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%W_Twr)) THEN - DEALLOCATE(RotMiscVarTypeData%W_Twr) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%X_Twr)) THEN - DEALLOCATE(RotMiscVarTypeData%X_Twr) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%Y_Twr)) THEN - DEALLOCATE(RotMiscVarTypeData%Y_Twr) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%Curve)) THEN - DEALLOCATE(RotMiscVarTypeData%Curve) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%TwrClrnc)) THEN - DEALLOCATE(RotMiscVarTypeData%TwrClrnc) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%X)) THEN - DEALLOCATE(RotMiscVarTypeData%X) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%Y)) THEN - DEALLOCATE(RotMiscVarTypeData%Y) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%Z)) THEN - DEALLOCATE(RotMiscVarTypeData%Z) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%M)) THEN - DEALLOCATE(RotMiscVarTypeData%M) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%Mx)) THEN - DEALLOCATE(RotMiscVarTypeData%Mx) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%My)) THEN - DEALLOCATE(RotMiscVarTypeData%My) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%Mz)) THEN - DEALLOCATE(RotMiscVarTypeData%Mz) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%hub_theta_x_root)) THEN - DEALLOCATE(RotMiscVarTypeData%hub_theta_x_root) -ENDIF - CALL MeshDestroy( RotMiscVarTypeData%HubLoad, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(RotMiscVarTypeData%B_L_2_H_P)) THEN -DO i1 = LBOUND(RotMiscVarTypeData%B_L_2_H_P,1), UBOUND(RotMiscVarTypeData%B_L_2_H_P,1) - CALL NWTC_Library_DestroyMeshMapType( RotMiscVarTypeData%B_L_2_H_P(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotMiscVarTypeData%B_L_2_H_P) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%SigmaCavitCrit)) THEN - DEALLOCATE(RotMiscVarTypeData%SigmaCavitCrit) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%SigmaCavit)) THEN - DEALLOCATE(RotMiscVarTypeData%SigmaCavit) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%CavitWarnSet)) THEN - DEALLOCATE(RotMiscVarTypeData%CavitWarnSet) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%BlFB)) THEN - DEALLOCATE(RotMiscVarTypeData%BlFB) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%BlMB)) THEN - DEALLOCATE(RotMiscVarTypeData%BlMB) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%TwrFB)) THEN - DEALLOCATE(RotMiscVarTypeData%TwrFB) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%TwrMB)) THEN - DEALLOCATE(RotMiscVarTypeData%TwrMB) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%HubFB)) THEN - DEALLOCATE(RotMiscVarTypeData%HubFB) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%HubMB)) THEN - DEALLOCATE(RotMiscVarTypeData%HubMB) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%NacFB)) THEN - DEALLOCATE(RotMiscVarTypeData%NacFB) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%NacMB)) THEN - DEALLOCATE(RotMiscVarTypeData%NacMB) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%BladeRootLoad)) THEN -DO i1 = LBOUND(RotMiscVarTypeData%BladeRootLoad,1), UBOUND(RotMiscVarTypeData%BladeRootLoad,1) - CALL MeshDestroy( RotMiscVarTypeData%BladeRootLoad(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotMiscVarTypeData%BladeRootLoad) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%B_L_2_R_P)) THEN -DO i1 = LBOUND(RotMiscVarTypeData%B_L_2_R_P,1), UBOUND(RotMiscVarTypeData%B_L_2_R_P,1) - CALL NWTC_Library_DestroyMeshMapType( RotMiscVarTypeData%B_L_2_R_P(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotMiscVarTypeData%B_L_2_R_P) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%BladeBuoyLoadPoint)) THEN -DO i1 = LBOUND(RotMiscVarTypeData%BladeBuoyLoadPoint,1), UBOUND(RotMiscVarTypeData%BladeBuoyLoadPoint,1) - CALL MeshDestroy( RotMiscVarTypeData%BladeBuoyLoadPoint(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotMiscVarTypeData%BladeBuoyLoadPoint) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%BladeBuoyLoad)) THEN -DO i1 = LBOUND(RotMiscVarTypeData%BladeBuoyLoad,1), UBOUND(RotMiscVarTypeData%BladeBuoyLoad,1) - CALL MeshDestroy( RotMiscVarTypeData%BladeBuoyLoad(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotMiscVarTypeData%BladeBuoyLoad) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%B_P_2_B_L)) THEN -DO i1 = LBOUND(RotMiscVarTypeData%B_P_2_B_L,1), UBOUND(RotMiscVarTypeData%B_P_2_B_L,1) - CALL NWTC_Library_DestroyMeshMapType( RotMiscVarTypeData%B_P_2_B_L(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotMiscVarTypeData%B_P_2_B_L) -ENDIF - CALL MeshDestroy( RotMiscVarTypeData%TwrBuoyLoadPoint, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( RotMiscVarTypeData%TwrBuoyLoad, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyMeshMapType( RotMiscVarTypeData%T_P_2_T_L, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_DestroyRotMiscVarType - - SUBROUTINE AD_PackRotMiscVarType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(RotMiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_PackRotMiscVarType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! BEMT: size of buffers for each call to pack subtype - CALL BEMT_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%BEMT, ErrStat2, ErrMsg2, .TRUE. ) ! BEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BEMT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BEMT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BEMT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! BEMT_y: size of buffers for each call to pack subtype - CALL BEMT_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%BEMT_y, ErrStat2, ErrMsg2, .TRUE. ) ! BEMT_y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BEMT_y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BEMT_y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BEMT_y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - DO i1 = LBOUND(InData%BEMT_u,1), UBOUND(InData%BEMT_u,1) - Int_BufSz = Int_BufSz + 3 ! BEMT_u: size of buffers for each call to pack subtype - CALL BEMT_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%BEMT_u(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BEMT_u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BEMT_u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BEMT_u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BEMT_u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! AA: size of buffers for each call to pack subtype - CALL AA_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, .TRUE. ) ! AA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! AA_y: size of buffers for each call to pack subtype - CALL AA_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%AA_y, ErrStat2, ErrMsg2, .TRUE. ) ! AA_y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AA_y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AA_y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AA_y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! AA_u: size of buffers for each call to pack subtype - CALL AA_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%AA_u, ErrStat2, ErrMsg2, .TRUE. ) ! AA_u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AA_u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AA_u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AA_u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! DisturbedInflow allocated yes/no - IF ( ALLOCATED(InData%DisturbedInflow) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! DisturbedInflow upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DisturbedInflow) ! DisturbedInflow - END IF - Int_BufSz = Int_BufSz + 1 ! orientationAnnulus allocated yes/no - IF ( ALLOCATED(InData%orientationAnnulus) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! orientationAnnulus upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%orientationAnnulus) ! orientationAnnulus - END IF - Int_BufSz = Int_BufSz + 1 ! AllOuts allocated yes/no - IF ( ALLOCATED(InData%AllOuts) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AllOuts upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AllOuts) ! AllOuts - END IF - Int_BufSz = Int_BufSz + 1 ! W_Twr allocated yes/no - IF ( ALLOCATED(InData%W_Twr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! W_Twr upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%W_Twr) ! W_Twr - END IF - Int_BufSz = Int_BufSz + 1 ! X_Twr allocated yes/no - IF ( ALLOCATED(InData%X_Twr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! X_Twr upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%X_Twr) ! X_Twr - END IF - Int_BufSz = Int_BufSz + 1 ! Y_Twr allocated yes/no - IF ( ALLOCATED(InData%Y_Twr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Y_Twr upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Y_Twr) ! Y_Twr - END IF - Int_BufSz = Int_BufSz + 1 ! Curve allocated yes/no - IF ( ALLOCATED(InData%Curve) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Curve upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Curve) ! Curve - END IF - Int_BufSz = Int_BufSz + 1 ! TwrClrnc allocated yes/no - IF ( ALLOCATED(InData%TwrClrnc) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TwrClrnc upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrClrnc) ! TwrClrnc - END IF - Int_BufSz = Int_BufSz + 1 ! X allocated yes/no - IF ( ALLOCATED(InData%X) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! X upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%X) ! X - END IF - Int_BufSz = Int_BufSz + 1 ! Y allocated yes/no - IF ( ALLOCATED(InData%Y) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Y upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Y) ! Y - END IF - Int_BufSz = Int_BufSz + 1 ! Z allocated yes/no - IF ( ALLOCATED(InData%Z) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Z upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Z) ! Z - END IF - Int_BufSz = Int_BufSz + 1 ! M allocated yes/no - IF ( ALLOCATED(InData%M) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! M upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%M) ! M - END IF - Int_BufSz = Int_BufSz + 1 ! Mx allocated yes/no - IF ( ALLOCATED(InData%Mx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Mx upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Mx) ! Mx - END IF - Int_BufSz = Int_BufSz + 1 ! My allocated yes/no - IF ( ALLOCATED(InData%My) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! My upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%My) ! My - END IF - Int_BufSz = Int_BufSz + 1 ! Mz allocated yes/no - IF ( ALLOCATED(InData%Mz) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Mz upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Mz) ! Mz - END IF - Re_BufSz = Re_BufSz + SIZE(InData%V_DiskAvg) ! V_DiskAvg - Re_BufSz = Re_BufSz + 1 ! yaw - Re_BufSz = Re_BufSz + 1 ! tilt - Int_BufSz = Int_BufSz + 1 ! hub_theta_x_root allocated yes/no - IF ( ALLOCATED(InData%hub_theta_x_root) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! hub_theta_x_root upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%hub_theta_x_root) ! hub_theta_x_root - END IF - Re_BufSz = Re_BufSz + 1 ! V_dot_x - Int_BufSz = Int_BufSz + 3 ! HubLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%HubLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! HubLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! HubLoad - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! HubLoad - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! HubLoad - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! B_L_2_H_P allocated yes/no - IF ( ALLOCATED(InData%B_L_2_H_P) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! B_L_2_H_P upper/lower bounds for each dimension - DO i1 = LBOUND(InData%B_L_2_H_P,1), UBOUND(InData%B_L_2_H_P,1) - Int_BufSz = Int_BufSz + 3 ! B_L_2_H_P: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%B_L_2_H_P(i1), ErrStat2, ErrMsg2, .TRUE. ) ! B_L_2_H_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! B_L_2_H_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! B_L_2_H_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! B_L_2_H_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SigmaCavitCrit allocated yes/no - IF ( ALLOCATED(InData%SigmaCavitCrit) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! SigmaCavitCrit upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SigmaCavitCrit) ! SigmaCavitCrit - END IF - Int_BufSz = Int_BufSz + 1 ! SigmaCavit allocated yes/no - IF ( ALLOCATED(InData%SigmaCavit) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! SigmaCavit upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SigmaCavit) ! SigmaCavit - END IF - Int_BufSz = Int_BufSz + 1 ! CavitWarnSet allocated yes/no - IF ( ALLOCATED(InData%CavitWarnSet) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CavitWarnSet upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%CavitWarnSet) ! CavitWarnSet - END IF - Int_BufSz = Int_BufSz + 1 ! BlFB allocated yes/no - IF ( ALLOCATED(InData%BlFB) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! BlFB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlFB) ! BlFB - END IF - Int_BufSz = Int_BufSz + 1 ! BlMB allocated yes/no - IF ( ALLOCATED(InData%BlMB) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! BlMB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlMB) ! BlMB - END IF - Int_BufSz = Int_BufSz + 1 ! TwrFB allocated yes/no - IF ( ALLOCATED(InData%TwrFB) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TwrFB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrFB) ! TwrFB - END IF - Int_BufSz = Int_BufSz + 1 ! TwrMB allocated yes/no - IF ( ALLOCATED(InData%TwrMB) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TwrMB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrMB) ! TwrMB - END IF - Int_BufSz = Int_BufSz + 1 ! HubFB allocated yes/no - IF ( ALLOCATED(InData%HubFB) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! HubFB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%HubFB) ! HubFB - END IF - Int_BufSz = Int_BufSz + 1 ! HubMB allocated yes/no - IF ( ALLOCATED(InData%HubMB) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! HubMB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%HubMB) ! HubMB - END IF - Int_BufSz = Int_BufSz + 1 ! NacFB allocated yes/no - IF ( ALLOCATED(InData%NacFB) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NacFB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%NacFB) ! NacFB - END IF - Int_BufSz = Int_BufSz + 1 ! NacMB allocated yes/no - IF ( ALLOCATED(InData%NacMB) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NacMB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%NacMB) ! NacMB - END IF - Int_BufSz = Int_BufSz + 1 ! BladeRootLoad allocated yes/no - IF ( ALLOCATED(InData%BladeRootLoad) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladeRootLoad upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BladeRootLoad,1), UBOUND(InData%BladeRootLoad,1) - Int_BufSz = Int_BufSz + 3 ! BladeRootLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%BladeRootLoad(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BladeRootLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeRootLoad - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeRootLoad - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeRootLoad - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! B_L_2_R_P allocated yes/no - IF ( ALLOCATED(InData%B_L_2_R_P) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! B_L_2_R_P upper/lower bounds for each dimension - DO i1 = LBOUND(InData%B_L_2_R_P,1), UBOUND(InData%B_L_2_R_P,1) - Int_BufSz = Int_BufSz + 3 ! B_L_2_R_P: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%B_L_2_R_P(i1), ErrStat2, ErrMsg2, .TRUE. ) ! B_L_2_R_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! B_L_2_R_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! B_L_2_R_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! B_L_2_R_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! BladeBuoyLoadPoint allocated yes/no - IF ( ALLOCATED(InData%BladeBuoyLoadPoint) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladeBuoyLoadPoint upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BladeBuoyLoadPoint,1), UBOUND(InData%BladeBuoyLoadPoint,1) - Int_BufSz = Int_BufSz + 3 ! BladeBuoyLoadPoint: size of buffers for each call to pack subtype - CALL MeshPack( InData%BladeBuoyLoadPoint(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BladeBuoyLoadPoint - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeBuoyLoadPoint - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeBuoyLoadPoint - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeBuoyLoadPoint - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! BladeBuoyLoad allocated yes/no - IF ( ALLOCATED(InData%BladeBuoyLoad) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladeBuoyLoad upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BladeBuoyLoad,1), UBOUND(InData%BladeBuoyLoad,1) - Int_BufSz = Int_BufSz + 3 ! BladeBuoyLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%BladeBuoyLoad(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BladeBuoyLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeBuoyLoad - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeBuoyLoad - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeBuoyLoad - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! B_P_2_B_L allocated yes/no - IF ( ALLOCATED(InData%B_P_2_B_L) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! B_P_2_B_L upper/lower bounds for each dimension - DO i1 = LBOUND(InData%B_P_2_B_L,1), UBOUND(InData%B_P_2_B_L,1) - Int_BufSz = Int_BufSz + 3 ! B_P_2_B_L: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%B_P_2_B_L(i1), ErrStat2, ErrMsg2, .TRUE. ) ! B_P_2_B_L - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! B_P_2_B_L - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! B_P_2_B_L - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! B_P_2_B_L - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! TwrBuoyLoadPoint: size of buffers for each call to pack subtype - CALL MeshPack( InData%TwrBuoyLoadPoint, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TwrBuoyLoadPoint - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TwrBuoyLoadPoint - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TwrBuoyLoadPoint - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TwrBuoyLoadPoint - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! TwrBuoyLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%TwrBuoyLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TwrBuoyLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TwrBuoyLoad - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TwrBuoyLoad - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TwrBuoyLoad - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! T_P_2_T_L: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%T_P_2_T_L, ErrStat2, ErrMsg2, .TRUE. ) ! T_P_2_T_L - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! T_P_2_T_L - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! T_P_2_T_L - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! T_P_2_T_L - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! FirstWarn_TowerStrike - Re_BufSz = Re_BufSz + SIZE(InData%AvgDiskVel) ! AvgDiskVel - Re_BufSz = Re_BufSz + SIZE(InData%AvgDiskVelDist) ! AvgDiskVelDist - Re_BufSz = Re_BufSz + 1 ! TFinAlpha - Re_BufSz = Re_BufSz + 1 ! TFinRe - Re_BufSz = Re_BufSz + 1 ! TFinVrel - Re_BufSz = Re_BufSz + SIZE(InData%TFinVund_i) ! TFinVund_i - Re_BufSz = Re_BufSz + SIZE(InData%TFinVind_i) ! TFinVind_i - Re_BufSz = Re_BufSz + SIZE(InData%TFinVrel_i) ! TFinVrel_i - Re_BufSz = Re_BufSz + SIZE(InData%TFinSTV_i) ! TFinSTV_i - Re_BufSz = Re_BufSz + SIZE(InData%TFinF_i) ! TFinF_i - Re_BufSz = Re_BufSz + SIZE(InData%TFinM_i) ! TFinM_i - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL BEMT_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%BEMT, ErrStat2, ErrMsg2, OnlySize ) ! BEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL BEMT_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%BEMT_y, ErrStat2, ErrMsg2, OnlySize ) ! BEMT_y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - DO i1 = LBOUND(InData%BEMT_u,1), UBOUND(InData%BEMT_u,1) - CALL BEMT_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%BEMT_u(i1), ErrStat2, ErrMsg2, OnlySize ) ! BEMT_u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - CALL AA_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, OnlySize ) ! AA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AA_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%AA_y, ErrStat2, ErrMsg2, OnlySize ) ! AA_y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AA_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%AA_u, ErrStat2, ErrMsg2, OnlySize ) ! AA_u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%DisturbedInflow) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DisturbedInflow,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DisturbedInflow,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DisturbedInflow,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DisturbedInflow,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DisturbedInflow,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DisturbedInflow,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%DisturbedInflow,3), UBOUND(InData%DisturbedInflow,3) - DO i2 = LBOUND(InData%DisturbedInflow,2), UBOUND(InData%DisturbedInflow,2) - DO i1 = LBOUND(InData%DisturbedInflow,1), UBOUND(InData%DisturbedInflow,1) - ReKiBuf(Re_Xferred) = InData%DisturbedInflow(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%orientationAnnulus) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%orientationAnnulus,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%orientationAnnulus,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%orientationAnnulus,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%orientationAnnulus,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%orientationAnnulus,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%orientationAnnulus,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%orientationAnnulus,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%orientationAnnulus,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%orientationAnnulus,4), UBOUND(InData%orientationAnnulus,4) - DO i3 = LBOUND(InData%orientationAnnulus,3), UBOUND(InData%orientationAnnulus,3) - DO i2 = LBOUND(InData%orientationAnnulus,2), UBOUND(InData%orientationAnnulus,2) - DO i1 = LBOUND(InData%orientationAnnulus,1), UBOUND(InData%orientationAnnulus,1) - DbKiBuf(Db_Xferred) = InData%orientationAnnulus(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AllOuts) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AllOuts,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOuts,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AllOuts,1), UBOUND(InData%AllOuts,1) - ReKiBuf(Re_Xferred) = InData%AllOuts(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%W_Twr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%W_Twr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W_Twr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%W_Twr,1), UBOUND(InData%W_Twr,1) - ReKiBuf(Re_Xferred) = InData%W_Twr(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%X_Twr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%X_Twr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X_Twr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%X_Twr,1), UBOUND(InData%X_Twr,1) - ReKiBuf(Re_Xferred) = InData%X_Twr(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Y_Twr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Y_Twr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y_Twr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Y_Twr,1), UBOUND(InData%Y_Twr,1) - ReKiBuf(Re_Xferred) = InData%Y_Twr(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Curve) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Curve,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Curve,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Curve,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Curve,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Curve,2), UBOUND(InData%Curve,2) - DO i1 = LBOUND(InData%Curve,1), UBOUND(InData%Curve,1) - ReKiBuf(Re_Xferred) = InData%Curve(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrClrnc) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrClrnc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrClrnc,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrClrnc,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrClrnc,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TwrClrnc,2), UBOUND(InData%TwrClrnc,2) - DO i1 = LBOUND(InData%TwrClrnc,1), UBOUND(InData%TwrClrnc,1) - ReKiBuf(Re_Xferred) = InData%TwrClrnc(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%X) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%X,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%X,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%X,2), UBOUND(InData%X,2) - DO i1 = LBOUND(InData%X,1), UBOUND(InData%X,1) - ReKiBuf(Re_Xferred) = InData%X(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Y,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Y,2), UBOUND(InData%Y,2) - DO i1 = LBOUND(InData%Y,1), UBOUND(InData%Y,1) - ReKiBuf(Re_Xferred) = InData%Y(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Z) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Z,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Z,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Z,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Z,2), UBOUND(InData%Z,2) - DO i1 = LBOUND(InData%Z,1), UBOUND(InData%Z,1) - ReKiBuf(Re_Xferred) = InData%Z(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%M) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%M,2), UBOUND(InData%M,2) - DO i1 = LBOUND(InData%M,1), UBOUND(InData%M,1) - ReKiBuf(Re_Xferred) = InData%M(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Mx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Mx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Mx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Mx,2), UBOUND(InData%Mx,2) - DO i1 = LBOUND(InData%Mx,1), UBOUND(InData%Mx,1) - ReKiBuf(Re_Xferred) = InData%Mx(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%My) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%My,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%My,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%My,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%My,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%My,2), UBOUND(InData%My,2) - DO i1 = LBOUND(InData%My,1), UBOUND(InData%My,1) - ReKiBuf(Re_Xferred) = InData%My(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Mz) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Mz,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mz,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Mz,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mz,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Mz,2), UBOUND(InData%Mz,2) - DO i1 = LBOUND(InData%Mz,1), UBOUND(InData%Mz,1) - ReKiBuf(Re_Xferred) = InData%Mz(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%V_DiskAvg,1), UBOUND(InData%V_DiskAvg,1) - ReKiBuf(Re_Xferred) = InData%V_DiskAvg(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%yaw - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%tilt - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%hub_theta_x_root) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%hub_theta_x_root,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%hub_theta_x_root,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%hub_theta_x_root,1), UBOUND(InData%hub_theta_x_root,1) - ReKiBuf(Re_Xferred) = InData%hub_theta_x_root(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%V_dot_x - Re_Xferred = Re_Xferred + 1 - CALL MeshPack( InData%HubLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! HubLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%B_L_2_H_P) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%B_L_2_H_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B_L_2_H_P,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%B_L_2_H_P,1), UBOUND(InData%B_L_2_H_P,1) - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%B_L_2_H_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! B_L_2_H_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SigmaCavitCrit) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SigmaCavitCrit,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SigmaCavitCrit,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SigmaCavitCrit,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SigmaCavitCrit,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%SigmaCavitCrit,2), UBOUND(InData%SigmaCavitCrit,2) - DO i1 = LBOUND(InData%SigmaCavitCrit,1), UBOUND(InData%SigmaCavitCrit,1) - ReKiBuf(Re_Xferred) = InData%SigmaCavitCrit(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SigmaCavit) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SigmaCavit,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SigmaCavit,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SigmaCavit,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SigmaCavit,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%SigmaCavit,2), UBOUND(InData%SigmaCavit,2) - DO i1 = LBOUND(InData%SigmaCavit,1), UBOUND(InData%SigmaCavit,1) - ReKiBuf(Re_Xferred) = InData%SigmaCavit(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CavitWarnSet) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CavitWarnSet,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CavitWarnSet,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CavitWarnSet,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CavitWarnSet,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CavitWarnSet,2), UBOUND(InData%CavitWarnSet,2) - DO i1 = LBOUND(InData%CavitWarnSet,1), UBOUND(InData%CavitWarnSet,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%CavitWarnSet(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlFB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlFB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlFB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlFB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlFB,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlFB,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlFB,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%BlFB,3), UBOUND(InData%BlFB,3) - DO i2 = LBOUND(InData%BlFB,2), UBOUND(InData%BlFB,2) - DO i1 = LBOUND(InData%BlFB,1), UBOUND(InData%BlFB,1) - ReKiBuf(Re_Xferred) = InData%BlFB(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlMB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlMB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlMB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlMB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlMB,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlMB,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlMB,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%BlMB,3), UBOUND(InData%BlMB,3) - DO i2 = LBOUND(InData%BlMB,2), UBOUND(InData%BlMB,2) - DO i1 = LBOUND(InData%BlMB,1), UBOUND(InData%BlMB,1) - ReKiBuf(Re_Xferred) = InData%BlMB(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrFB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrFB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrFB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrFB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrFB,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TwrFB,2), UBOUND(InData%TwrFB,2) - DO i1 = LBOUND(InData%TwrFB,1), UBOUND(InData%TwrFB,1) - ReKiBuf(Re_Xferred) = InData%TwrFB(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrMB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrMB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrMB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrMB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrMB,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TwrMB,2), UBOUND(InData%TwrMB,2) - DO i1 = LBOUND(InData%TwrMB,1), UBOUND(InData%TwrMB,1) - ReKiBuf(Re_Xferred) = InData%TwrMB(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%HubFB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%HubFB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HubFB,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%HubFB,1), UBOUND(InData%HubFB,1) - ReKiBuf(Re_Xferred) = InData%HubFB(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%HubMB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%HubMB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HubMB,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%HubMB,1), UBOUND(InData%HubMB,1) - ReKiBuf(Re_Xferred) = InData%HubMB(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NacFB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NacFB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NacFB,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NacFB,1), UBOUND(InData%NacFB,1) - ReKiBuf(Re_Xferred) = InData%NacFB(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NacMB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NacMB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NacMB,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NacMB,1), UBOUND(InData%NacMB,1) - ReKiBuf(Re_Xferred) = InData%NacMB(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BladeRootLoad) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootLoad,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootLoad,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BladeRootLoad,1), UBOUND(InData%BladeRootLoad,1) - CALL MeshPack( InData%BladeRootLoad(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BladeRootLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%B_L_2_R_P) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%B_L_2_R_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B_L_2_R_P,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%B_L_2_R_P,1), UBOUND(InData%B_L_2_R_P,1) - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%B_L_2_R_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! B_L_2_R_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BladeBuoyLoadPoint) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeBuoyLoadPoint,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeBuoyLoadPoint,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BladeBuoyLoadPoint,1), UBOUND(InData%BladeBuoyLoadPoint,1) - CALL MeshPack( InData%BladeBuoyLoadPoint(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BladeBuoyLoadPoint - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BladeBuoyLoad) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeBuoyLoad,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeBuoyLoad,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BladeBuoyLoad,1), UBOUND(InData%BladeBuoyLoad,1) - CALL MeshPack( InData%BladeBuoyLoad(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BladeBuoyLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%B_P_2_B_L) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%B_P_2_B_L,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B_P_2_B_L,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%B_P_2_B_L,1), UBOUND(InData%B_P_2_B_L,1) - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%B_P_2_B_L(i1), ErrStat2, ErrMsg2, OnlySize ) ! B_P_2_B_L - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL MeshPack( InData%TwrBuoyLoadPoint, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TwrBuoyLoadPoint - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MeshPack( InData%TwrBuoyLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TwrBuoyLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%T_P_2_T_L, ErrStat2, ErrMsg2, OnlySize ) ! T_P_2_T_L - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstWarn_TowerStrike, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%AvgDiskVel,1), UBOUND(InData%AvgDiskVel,1) - ReKiBuf(Re_Xferred) = InData%AvgDiskVel(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%AvgDiskVelDist,1), UBOUND(InData%AvgDiskVelDist,1) - ReKiBuf(Re_Xferred) = InData%AvgDiskVelDist(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%TFinAlpha - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFinRe - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFinVrel - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%TFinVund_i,1), UBOUND(InData%TFinVund_i,1) - ReKiBuf(Re_Xferred) = InData%TFinVund_i(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TFinVind_i,1), UBOUND(InData%TFinVind_i,1) - ReKiBuf(Re_Xferred) = InData%TFinVind_i(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TFinVrel_i,1), UBOUND(InData%TFinVrel_i,1) - ReKiBuf(Re_Xferred) = InData%TFinVrel_i(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TFinSTV_i,1), UBOUND(InData%TFinSTV_i,1) - ReKiBuf(Re_Xferred) = InData%TFinSTV_i(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TFinF_i,1), UBOUND(InData%TFinF_i,1) - ReKiBuf(Re_Xferred) = InData%TFinF_i(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TFinM_i,1), UBOUND(InData%TFinM_i,1) - ReKiBuf(Re_Xferred) = InData%TFinM_i(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE AD_PackRotMiscVarType - - SUBROUTINE AD_UnPackRotMiscVarType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(RotMiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackRotMiscVarType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL BEMT_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%BEMT, ErrStat2, ErrMsg2 ) ! BEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL BEMT_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%BEMT_y, ErrStat2, ErrMsg2 ) ! BEMT_y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - i1_l = LBOUND(OutData%BEMT_u,1) - i1_u = UBOUND(OutData%BEMT_u,1) - DO i1 = LBOUND(OutData%BEMT_u,1), UBOUND(OutData%BEMT_u,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL BEMT_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%BEMT_u(i1), ErrStat2, ErrMsg2 ) ! BEMT_u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AA_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%AA, ErrStat2, ErrMsg2 ) ! AA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AA_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%AA_y, ErrStat2, ErrMsg2 ) ! AA_y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AA_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%AA_u, ErrStat2, ErrMsg2 ) ! AA_u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DisturbedInflow not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DisturbedInflow)) DEALLOCATE(OutData%DisturbedInflow) - ALLOCATE(OutData%DisturbedInflow(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DisturbedInflow.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%DisturbedInflow,3), UBOUND(OutData%DisturbedInflow,3) - DO i2 = LBOUND(OutData%DisturbedInflow,2), UBOUND(OutData%DisturbedInflow,2) - DO i1 = LBOUND(OutData%DisturbedInflow,1), UBOUND(OutData%DisturbedInflow,1) - OutData%DisturbedInflow(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! orientationAnnulus not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%orientationAnnulus)) DEALLOCATE(OutData%orientationAnnulus) - ALLOCATE(OutData%orientationAnnulus(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%orientationAnnulus.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%orientationAnnulus,4), UBOUND(OutData%orientationAnnulus,4) - DO i3 = LBOUND(OutData%orientationAnnulus,3), UBOUND(OutData%orientationAnnulus,3) - DO i2 = LBOUND(OutData%orientationAnnulus,2), UBOUND(OutData%orientationAnnulus,2) - DO i1 = LBOUND(OutData%orientationAnnulus,1), UBOUND(OutData%orientationAnnulus,1) - OutData%orientationAnnulus(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AllOuts not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AllOuts)) DEALLOCATE(OutData%AllOuts) - ALLOCATE(OutData%AllOuts(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AllOuts,1), UBOUND(OutData%AllOuts,1) - OutData%AllOuts(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! W_Twr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%W_Twr)) DEALLOCATE(OutData%W_Twr) - ALLOCATE(OutData%W_Twr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%W_Twr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%W_Twr,1), UBOUND(OutData%W_Twr,1) - OutData%W_Twr(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X_Twr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%X_Twr)) DEALLOCATE(OutData%X_Twr) - ALLOCATE(OutData%X_Twr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X_Twr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%X_Twr,1), UBOUND(OutData%X_Twr,1) - OutData%X_Twr(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Y_Twr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Y_Twr)) DEALLOCATE(OutData%Y_Twr) - ALLOCATE(OutData%Y_Twr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y_Twr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Y_Twr,1), UBOUND(OutData%Y_Twr,1) - OutData%Y_Twr(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Curve not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Curve)) DEALLOCATE(OutData%Curve) - ALLOCATE(OutData%Curve(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Curve.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Curve,2), UBOUND(OutData%Curve,2) - DO i1 = LBOUND(OutData%Curve,1), UBOUND(OutData%Curve,1) - OutData%Curve(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrClrnc not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TwrClrnc)) DEALLOCATE(OutData%TwrClrnc) - ALLOCATE(OutData%TwrClrnc(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrClrnc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TwrClrnc,2), UBOUND(OutData%TwrClrnc,2) - DO i1 = LBOUND(OutData%TwrClrnc,1), UBOUND(OutData%TwrClrnc,1) - OutData%TwrClrnc(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%X)) DEALLOCATE(OutData%X) - ALLOCATE(OutData%X(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%X,2), UBOUND(OutData%X,2) - DO i1 = LBOUND(OutData%X,1), UBOUND(OutData%X,1) - OutData%X(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Y)) DEALLOCATE(OutData%Y) - ALLOCATE(OutData%Y(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Y,2), UBOUND(OutData%Y,2) - DO i1 = LBOUND(OutData%Y,1), UBOUND(OutData%Y,1) - OutData%Y(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Z not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Z)) DEALLOCATE(OutData%Z) - ALLOCATE(OutData%Z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Z,2), UBOUND(OutData%Z,2) - DO i1 = LBOUND(OutData%Z,1), UBOUND(OutData%Z,1) - OutData%Z(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%M)) DEALLOCATE(OutData%M) - ALLOCATE(OutData%M(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%M,2), UBOUND(OutData%M,2) - DO i1 = LBOUND(OutData%M,1), UBOUND(OutData%M,1) - OutData%M(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Mx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Mx)) DEALLOCATE(OutData%Mx) - ALLOCATE(OutData%Mx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Mx,2), UBOUND(OutData%Mx,2) - DO i1 = LBOUND(OutData%Mx,1), UBOUND(OutData%Mx,1) - OutData%Mx(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! My not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%My)) DEALLOCATE(OutData%My) - ALLOCATE(OutData%My(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%My.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%My,2), UBOUND(OutData%My,2) - DO i1 = LBOUND(OutData%My,1), UBOUND(OutData%My,1) - OutData%My(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Mz not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Mz)) DEALLOCATE(OutData%Mz) - ALLOCATE(OutData%Mz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Mz,2), UBOUND(OutData%Mz,2) - DO i1 = LBOUND(OutData%Mz,1), UBOUND(OutData%Mz,1) - OutData%Mz(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%V_DiskAvg,1) - i1_u = UBOUND(OutData%V_DiskAvg,1) - DO i1 = LBOUND(OutData%V_DiskAvg,1), UBOUND(OutData%V_DiskAvg,1) - OutData%V_DiskAvg(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%yaw = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%tilt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! hub_theta_x_root not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%hub_theta_x_root)) DEALLOCATE(OutData%hub_theta_x_root) - ALLOCATE(OutData%hub_theta_x_root(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%hub_theta_x_root.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%hub_theta_x_root,1), UBOUND(OutData%hub_theta_x_root,1) - OutData%hub_theta_x_root(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%V_dot_x = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%HubLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! HubLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! B_L_2_H_P not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%B_L_2_H_P)) DEALLOCATE(OutData%B_L_2_H_P) - ALLOCATE(OutData%B_L_2_H_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%B_L_2_H_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%B_L_2_H_P,1), UBOUND(OutData%B_L_2_H_P,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%B_L_2_H_P(i1), ErrStat2, ErrMsg2 ) ! B_L_2_H_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SigmaCavitCrit not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SigmaCavitCrit)) DEALLOCATE(OutData%SigmaCavitCrit) - ALLOCATE(OutData%SigmaCavitCrit(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SigmaCavitCrit.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%SigmaCavitCrit,2), UBOUND(OutData%SigmaCavitCrit,2) - DO i1 = LBOUND(OutData%SigmaCavitCrit,1), UBOUND(OutData%SigmaCavitCrit,1) - OutData%SigmaCavitCrit(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SigmaCavit not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SigmaCavit)) DEALLOCATE(OutData%SigmaCavit) - ALLOCATE(OutData%SigmaCavit(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SigmaCavit.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%SigmaCavit,2), UBOUND(OutData%SigmaCavit,2) - DO i1 = LBOUND(OutData%SigmaCavit,1), UBOUND(OutData%SigmaCavit,1) - OutData%SigmaCavit(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CavitWarnSet not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CavitWarnSet)) DEALLOCATE(OutData%CavitWarnSet) - ALLOCATE(OutData%CavitWarnSet(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CavitWarnSet.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CavitWarnSet,2), UBOUND(OutData%CavitWarnSet,2) - DO i1 = LBOUND(OutData%CavitWarnSet,1), UBOUND(OutData%CavitWarnSet,1) - OutData%CavitWarnSet(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%CavitWarnSet(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlFB not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlFB)) DEALLOCATE(OutData%BlFB) - ALLOCATE(OutData%BlFB(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlFB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%BlFB,3), UBOUND(OutData%BlFB,3) - DO i2 = LBOUND(OutData%BlFB,2), UBOUND(OutData%BlFB,2) - DO i1 = LBOUND(OutData%BlFB,1), UBOUND(OutData%BlFB,1) - OutData%BlFB(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 ! BlMB not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlMB)) DEALLOCATE(OutData%BlMB) - ALLOCATE(OutData%BlMB(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlMB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%BlMB,3), UBOUND(OutData%BlMB,3) - DO i2 = LBOUND(OutData%BlMB,2), UBOUND(OutData%BlMB,2) - DO i1 = LBOUND(OutData%BlMB,1), UBOUND(OutData%BlMB,1) - OutData%BlMB(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 ! TwrFB not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TwrFB)) DEALLOCATE(OutData%TwrFB) - ALLOCATE(OutData%TwrFB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrFB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TwrFB,2), UBOUND(OutData%TwrFB,2) - DO i1 = LBOUND(OutData%TwrFB,1), UBOUND(OutData%TwrFB,1) - OutData%TwrFB(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrMB not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TwrMB)) DEALLOCATE(OutData%TwrMB) - ALLOCATE(OutData%TwrMB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrMB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TwrMB,2), UBOUND(OutData%TwrMB,2) - DO i1 = LBOUND(OutData%TwrMB,1), UBOUND(OutData%TwrMB,1) - OutData%TwrMB(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HubFB not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%HubFB)) DEALLOCATE(OutData%HubFB) - ALLOCATE(OutData%HubFB(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HubFB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%HubFB,1), UBOUND(OutData%HubFB,1) - OutData%HubFB(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HubMB not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%HubMB)) DEALLOCATE(OutData%HubMB) - ALLOCATE(OutData%HubMB(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HubMB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%HubMB,1), UBOUND(OutData%HubMB,1) - OutData%HubMB(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NacFB not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NacFB)) DEALLOCATE(OutData%NacFB) - ALLOCATE(OutData%NacFB(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NacFB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NacFB,1), UBOUND(OutData%NacFB,1) - OutData%NacFB(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NacMB not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NacMB)) DEALLOCATE(OutData%NacMB) - ALLOCATE(OutData%NacMB(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NacMB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NacMB,1), UBOUND(OutData%NacMB,1) - OutData%NacMB(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeRootLoad not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BladeRootLoad)) DEALLOCATE(OutData%BladeRootLoad) - ALLOCATE(OutData%BladeRootLoad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootLoad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladeRootLoad,1), UBOUND(OutData%BladeRootLoad,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%BladeRootLoad(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BladeRootLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! B_L_2_R_P not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%B_L_2_R_P)) DEALLOCATE(OutData%B_L_2_R_P) - ALLOCATE(OutData%B_L_2_R_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%B_L_2_R_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%B_L_2_R_P,1), UBOUND(OutData%B_L_2_R_P,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%B_L_2_R_P(i1), ErrStat2, ErrMsg2 ) ! B_L_2_R_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeBuoyLoadPoint not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BladeBuoyLoadPoint)) DEALLOCATE(OutData%BladeBuoyLoadPoint) - ALLOCATE(OutData%BladeBuoyLoadPoint(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeBuoyLoadPoint.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladeBuoyLoadPoint,1), UBOUND(OutData%BladeBuoyLoadPoint,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%BladeBuoyLoadPoint(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BladeBuoyLoadPoint - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeBuoyLoad not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BladeBuoyLoad)) DEALLOCATE(OutData%BladeBuoyLoad) - ALLOCATE(OutData%BladeBuoyLoad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeBuoyLoad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladeBuoyLoad,1), UBOUND(OutData%BladeBuoyLoad,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%BladeBuoyLoad(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BladeBuoyLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! B_P_2_B_L not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%B_P_2_B_L)) DEALLOCATE(OutData%B_P_2_B_L) - ALLOCATE(OutData%B_P_2_B_L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%B_P_2_B_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%B_P_2_B_L,1), UBOUND(OutData%B_P_2_B_L,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%B_P_2_B_L(i1), ErrStat2, ErrMsg2 ) ! B_P_2_B_L - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + DstRotMiscVarTypeData%TFinVrel = SrcRotMiscVarTypeData%TFinVrel + DstRotMiscVarTypeData%TFinVund_i = SrcRotMiscVarTypeData%TFinVund_i + DstRotMiscVarTypeData%TFinVind_i = SrcRotMiscVarTypeData%TFinVind_i + DstRotMiscVarTypeData%TFinVrel_i = SrcRotMiscVarTypeData%TFinVrel_i + DstRotMiscVarTypeData%TFinSTV_i = SrcRotMiscVarTypeData%TFinSTV_i + DstRotMiscVarTypeData%TFinF_i = SrcRotMiscVarTypeData%TFinF_i + DstRotMiscVarTypeData%TFinM_i = SrcRotMiscVarTypeData%TFinM_i + END SUBROUTINE AD_CopyRotMiscVarType - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%TwrBuoyLoadPoint, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TwrBuoyLoadPoint - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + SUBROUTINE AD_DestroyRotMiscVarType( RotMiscVarTypeData, ErrStat, ErrMsg ) + TYPE(RotMiscVarType), INTENT(INOUT) :: RotMiscVarTypeData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyRotMiscVarType' - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%TwrBuoyLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TwrBuoyLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + ErrStat = ErrID_None + ErrMsg = "" - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%T_P_2_T_L, ErrStat2, ErrMsg2 ) ! T_P_2_T_L - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + CALL BEMT_DestroyMisc( RotMiscVarTypeData%BEMT, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL BEMT_DestroyOutput( RotMiscVarTypeData%BEMT_y, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +DO i1 = LBOUND(RotMiscVarTypeData%BEMT_u,1), UBOUND(RotMiscVarTypeData%BEMT_u,1) + CALL BEMT_DestroyInput( RotMiscVarTypeData%BEMT_u(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + CALL AA_DestroyMisc( RotMiscVarTypeData%AA, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL AA_DestroyOutput( RotMiscVarTypeData%AA_y, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL AA_DestroyInput( RotMiscVarTypeData%AA_u, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(RotMiscVarTypeData%DisturbedInflow)) THEN + DEALLOCATE(RotMiscVarTypeData%DisturbedInflow) +ENDIF +IF (ALLOCATED(RotMiscVarTypeData%orientationAnnulus)) THEN + DEALLOCATE(RotMiscVarTypeData%orientationAnnulus) +ENDIF +IF (ALLOCATED(RotMiscVarTypeData%AllOuts)) THEN + DEALLOCATE(RotMiscVarTypeData%AllOuts) +ENDIF +IF (ALLOCATED(RotMiscVarTypeData%W_Twr)) THEN + DEALLOCATE(RotMiscVarTypeData%W_Twr) +ENDIF +IF (ALLOCATED(RotMiscVarTypeData%X_Twr)) THEN + DEALLOCATE(RotMiscVarTypeData%X_Twr) +ENDIF +IF (ALLOCATED(RotMiscVarTypeData%Y_Twr)) THEN + DEALLOCATE(RotMiscVarTypeData%Y_Twr) +ENDIF +IF (ALLOCATED(RotMiscVarTypeData%Curve)) THEN + DEALLOCATE(RotMiscVarTypeData%Curve) +ENDIF +IF (ALLOCATED(RotMiscVarTypeData%TwrClrnc)) THEN + DEALLOCATE(RotMiscVarTypeData%TwrClrnc) +ENDIF +IF (ALLOCATED(RotMiscVarTypeData%X)) THEN + DEALLOCATE(RotMiscVarTypeData%X) +ENDIF +IF (ALLOCATED(RotMiscVarTypeData%Y)) THEN + DEALLOCATE(RotMiscVarTypeData%Y) +ENDIF +IF (ALLOCATED(RotMiscVarTypeData%Z)) THEN + DEALLOCATE(RotMiscVarTypeData%Z) +ENDIF +IF (ALLOCATED(RotMiscVarTypeData%M)) THEN + DEALLOCATE(RotMiscVarTypeData%M) +ENDIF +IF (ALLOCATED(RotMiscVarTypeData%Mx)) THEN + DEALLOCATE(RotMiscVarTypeData%Mx) +ENDIF +IF (ALLOCATED(RotMiscVarTypeData%My)) THEN + DEALLOCATE(RotMiscVarTypeData%My) +ENDIF +IF (ALLOCATED(RotMiscVarTypeData%Mz)) THEN + DEALLOCATE(RotMiscVarTypeData%Mz) +ENDIF +IF (ALLOCATED(RotMiscVarTypeData%hub_theta_x_root)) THEN + DEALLOCATE(RotMiscVarTypeData%hub_theta_x_root) +ENDIF + CALL MeshDestroy( RotMiscVarTypeData%HubLoad, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(RotMiscVarTypeData%B_L_2_H_P)) THEN +DO i1 = LBOUND(RotMiscVarTypeData%B_L_2_H_P,1), UBOUND(RotMiscVarTypeData%B_L_2_H_P,1) + CALL NWTC_Library_DestroyMeshMapType( RotMiscVarTypeData%B_L_2_H_P(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(RotMiscVarTypeData%B_L_2_H_P) +ENDIF +IF (ALLOCATED(RotMiscVarTypeData%SigmaCavitCrit)) THEN + DEALLOCATE(RotMiscVarTypeData%SigmaCavitCrit) +ENDIF +IF (ALLOCATED(RotMiscVarTypeData%SigmaCavit)) THEN + DEALLOCATE(RotMiscVarTypeData%SigmaCavit) +ENDIF +IF (ALLOCATED(RotMiscVarTypeData%CavitWarnSet)) THEN + DEALLOCATE(RotMiscVarTypeData%CavitWarnSet) +ENDIF +IF (ALLOCATED(RotMiscVarTypeData%BlFB)) THEN + DEALLOCATE(RotMiscVarTypeData%BlFB) +ENDIF +IF (ALLOCATED(RotMiscVarTypeData%BlMB)) THEN + DEALLOCATE(RotMiscVarTypeData%BlMB) +ENDIF +IF (ALLOCATED(RotMiscVarTypeData%TwrFB)) THEN + DEALLOCATE(RotMiscVarTypeData%TwrFB) +ENDIF +IF (ALLOCATED(RotMiscVarTypeData%TwrMB)) THEN + DEALLOCATE(RotMiscVarTypeData%TwrMB) +ENDIF +IF (ALLOCATED(RotMiscVarTypeData%HubFB)) THEN + DEALLOCATE(RotMiscVarTypeData%HubFB) +ENDIF +IF (ALLOCATED(RotMiscVarTypeData%HubMB)) THEN + DEALLOCATE(RotMiscVarTypeData%HubMB) +ENDIF +IF (ALLOCATED(RotMiscVarTypeData%NacFB)) THEN + DEALLOCATE(RotMiscVarTypeData%NacFB) +ENDIF +IF (ALLOCATED(RotMiscVarTypeData%NacMB)) THEN + DEALLOCATE(RotMiscVarTypeData%NacMB) +ENDIF +IF (ALLOCATED(RotMiscVarTypeData%BladeRootLoad)) THEN +DO i1 = LBOUND(RotMiscVarTypeData%BladeRootLoad,1), UBOUND(RotMiscVarTypeData%BladeRootLoad,1) + CALL MeshDestroy( RotMiscVarTypeData%BladeRootLoad(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(RotMiscVarTypeData%BladeRootLoad) +ENDIF +IF (ALLOCATED(RotMiscVarTypeData%B_L_2_R_P)) THEN +DO i1 = LBOUND(RotMiscVarTypeData%B_L_2_R_P,1), UBOUND(RotMiscVarTypeData%B_L_2_R_P,1) + CALL NWTC_Library_DestroyMeshMapType( RotMiscVarTypeData%B_L_2_R_P(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(RotMiscVarTypeData%B_L_2_R_P) +ENDIF +IF (ALLOCATED(RotMiscVarTypeData%BladeBuoyLoadPoint)) THEN +DO i1 = LBOUND(RotMiscVarTypeData%BladeBuoyLoadPoint,1), UBOUND(RotMiscVarTypeData%BladeBuoyLoadPoint,1) + CALL MeshDestroy( RotMiscVarTypeData%BladeBuoyLoadPoint(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(RotMiscVarTypeData%BladeBuoyLoadPoint) +ENDIF +IF (ALLOCATED(RotMiscVarTypeData%BladeBuoyLoad)) THEN +DO i1 = LBOUND(RotMiscVarTypeData%BladeBuoyLoad,1), UBOUND(RotMiscVarTypeData%BladeBuoyLoad,1) + CALL MeshDestroy( RotMiscVarTypeData%BladeBuoyLoad(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(RotMiscVarTypeData%BladeBuoyLoad) +ENDIF +IF (ALLOCATED(RotMiscVarTypeData%B_P_2_B_L)) THEN +DO i1 = LBOUND(RotMiscVarTypeData%B_P_2_B_L,1), UBOUND(RotMiscVarTypeData%B_P_2_B_L,1) + CALL NWTC_Library_DestroyMeshMapType( RotMiscVarTypeData%B_P_2_B_L(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(RotMiscVarTypeData%B_P_2_B_L) +ENDIF + CALL MeshDestroy( RotMiscVarTypeData%TwrBuoyLoadPoint, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL MeshDestroy( RotMiscVarTypeData%TwrBuoyLoad, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL NWTC_Library_DestroyMeshMapType( RotMiscVarTypeData%T_P_2_T_L, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END SUBROUTINE AD_DestroyRotMiscVarType - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%FirstWarn_TowerStrike = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn_TowerStrike) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%AvgDiskVel,1) - i1_u = UBOUND(OutData%AvgDiskVel,1) - DO i1 = LBOUND(OutData%AvgDiskVel,1), UBOUND(OutData%AvgDiskVel,1) - OutData%AvgDiskVel(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%AvgDiskVelDist,1) - i1_u = UBOUND(OutData%AvgDiskVelDist,1) - DO i1 = LBOUND(OutData%AvgDiskVelDist,1), UBOUND(OutData%AvgDiskVelDist,1) - OutData%AvgDiskVelDist(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%TFinAlpha = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFinRe = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFinVrel = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%TFinVund_i,1) - i1_u = UBOUND(OutData%TFinVund_i,1) - DO i1 = LBOUND(OutData%TFinVund_i,1), UBOUND(OutData%TFinVund_i,1) - OutData%TFinVund_i(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TFinVind_i,1) - i1_u = UBOUND(OutData%TFinVind_i,1) - DO i1 = LBOUND(OutData%TFinVind_i,1), UBOUND(OutData%TFinVind_i,1) - OutData%TFinVind_i(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TFinVrel_i,1) - i1_u = UBOUND(OutData%TFinVrel_i,1) - DO i1 = LBOUND(OutData%TFinVrel_i,1), UBOUND(OutData%TFinVrel_i,1) - OutData%TFinVrel_i(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TFinSTV_i,1) - i1_u = UBOUND(OutData%TFinSTV_i,1) - DO i1 = LBOUND(OutData%TFinSTV_i,1), UBOUND(OutData%TFinSTV_i,1) - OutData%TFinSTV_i(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TFinF_i,1) - i1_u = UBOUND(OutData%TFinF_i,1) - DO i1 = LBOUND(OutData%TFinF_i,1), UBOUND(OutData%TFinF_i,1) - OutData%TFinF_i(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TFinM_i,1) - i1_u = UBOUND(OutData%TFinM_i,1) - DO i1 = LBOUND(OutData%TFinM_i,1), UBOUND(OutData%TFinM_i,1) - OutData%TFinM_i(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE AD_UnPackRotMiscVarType +subroutine AD_PackRotMiscVarType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(RotMiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackRotMiscVarType' + integer(IntKi) :: i1, i2, i3, i4 + integer(IntKi) :: LB(4), UB(4) + if (Buf%ErrStat >= AbortErrLev) return + ! BEMT + call BEMT_PackMisc(Buf, InData%BEMT) + if (RegCheckErr(Buf, RoutineName)) return + ! BEMT_y + call BEMT_PackOutput(Buf, InData%BEMT_y) + if (RegCheckErr(Buf, RoutineName)) return + ! BEMT_u + LB(1:1) = lbound(InData%BEMT_u) + UB(1:1) = ubound(InData%BEMT_u) + do i1 = LB(1), UB(1) + call BEMT_PackInput(Buf, InData%BEMT_u(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! AA + call AA_PackMisc(Buf, InData%AA) + if (RegCheckErr(Buf, RoutineName)) return + ! AA_y + call AA_PackOutput(Buf, InData%AA_y) + if (RegCheckErr(Buf, RoutineName)) return + ! AA_u + call AA_PackInput(Buf, InData%AA_u) + if (RegCheckErr(Buf, RoutineName)) return + ! DisturbedInflow + call RegPack(Buf, allocated(InData%DisturbedInflow)) + if (allocated(InData%DisturbedInflow)) then + call RegPackBounds(Buf, 3, lbound(InData%DisturbedInflow), ubound(InData%DisturbedInflow)) + call RegPack(Buf, InData%DisturbedInflow) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! orientationAnnulus + call RegPack(Buf, allocated(InData%orientationAnnulus)) + if (allocated(InData%orientationAnnulus)) then + call RegPackBounds(Buf, 4, lbound(InData%orientationAnnulus), ubound(InData%orientationAnnulus)) + call RegPack(Buf, InData%orientationAnnulus) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AllOuts + call RegPack(Buf, allocated(InData%AllOuts)) + if (allocated(InData%AllOuts)) then + call RegPackBounds(Buf, 1, lbound(InData%AllOuts), ubound(InData%AllOuts)) + call RegPack(Buf, InData%AllOuts) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! W_Twr + call RegPack(Buf, allocated(InData%W_Twr)) + if (allocated(InData%W_Twr)) then + call RegPackBounds(Buf, 1, lbound(InData%W_Twr), ubound(InData%W_Twr)) + call RegPack(Buf, InData%W_Twr) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! X_Twr + call RegPack(Buf, allocated(InData%X_Twr)) + if (allocated(InData%X_Twr)) then + call RegPackBounds(Buf, 1, lbound(InData%X_Twr), ubound(InData%X_Twr)) + call RegPack(Buf, InData%X_Twr) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Y_Twr + call RegPack(Buf, allocated(InData%Y_Twr)) + if (allocated(InData%Y_Twr)) then + call RegPackBounds(Buf, 1, lbound(InData%Y_Twr), ubound(InData%Y_Twr)) + call RegPack(Buf, InData%Y_Twr) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Curve + call RegPack(Buf, allocated(InData%Curve)) + if (allocated(InData%Curve)) then + call RegPackBounds(Buf, 2, lbound(InData%Curve), ubound(InData%Curve)) + call RegPack(Buf, InData%Curve) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TwrClrnc + call RegPack(Buf, allocated(InData%TwrClrnc)) + if (allocated(InData%TwrClrnc)) then + call RegPackBounds(Buf, 2, lbound(InData%TwrClrnc), ubound(InData%TwrClrnc)) + call RegPack(Buf, InData%TwrClrnc) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! X + call RegPack(Buf, allocated(InData%X)) + if (allocated(InData%X)) then + call RegPackBounds(Buf, 2, lbound(InData%X), ubound(InData%X)) + call RegPack(Buf, InData%X) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Y + call RegPack(Buf, allocated(InData%Y)) + if (allocated(InData%Y)) then + call RegPackBounds(Buf, 2, lbound(InData%Y), ubound(InData%Y)) + call RegPack(Buf, InData%Y) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Z + call RegPack(Buf, allocated(InData%Z)) + if (allocated(InData%Z)) then + call RegPackBounds(Buf, 2, lbound(InData%Z), ubound(InData%Z)) + call RegPack(Buf, InData%Z) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! M + call RegPack(Buf, allocated(InData%M)) + if (allocated(InData%M)) then + call RegPackBounds(Buf, 2, lbound(InData%M), ubound(InData%M)) + call RegPack(Buf, InData%M) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Mx + call RegPack(Buf, allocated(InData%Mx)) + if (allocated(InData%Mx)) then + call RegPackBounds(Buf, 2, lbound(InData%Mx), ubound(InData%Mx)) + call RegPack(Buf, InData%Mx) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! My + call RegPack(Buf, allocated(InData%My)) + if (allocated(InData%My)) then + call RegPackBounds(Buf, 2, lbound(InData%My), ubound(InData%My)) + call RegPack(Buf, InData%My) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Mz + call RegPack(Buf, allocated(InData%Mz)) + if (allocated(InData%Mz)) then + call RegPackBounds(Buf, 2, lbound(InData%Mz), ubound(InData%Mz)) + call RegPack(Buf, InData%Mz) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! V_DiskAvg + call RegPack(Buf, InData%V_DiskAvg) + if (RegCheckErr(Buf, RoutineName)) return + ! yaw + call RegPack(Buf, InData%yaw) + if (RegCheckErr(Buf, RoutineName)) return + ! tilt + call RegPack(Buf, InData%tilt) + if (RegCheckErr(Buf, RoutineName)) return + ! hub_theta_x_root + call RegPack(Buf, allocated(InData%hub_theta_x_root)) + if (allocated(InData%hub_theta_x_root)) then + call RegPackBounds(Buf, 1, lbound(InData%hub_theta_x_root), ubound(InData%hub_theta_x_root)) + call RegPack(Buf, InData%hub_theta_x_root) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! V_dot_x + call RegPack(Buf, InData%V_dot_x) + if (RegCheckErr(Buf, RoutineName)) return + ! HubLoad + call MeshPack(Buf, InData%HubLoad) + if (RegCheckErr(Buf, RoutineName)) return + ! B_L_2_H_P + call RegPack(Buf, allocated(InData%B_L_2_H_P)) + if (allocated(InData%B_L_2_H_P)) then + call RegPackBounds(Buf, 1, lbound(InData%B_L_2_H_P), ubound(InData%B_L_2_H_P)) + LB(1:1) = lbound(InData%B_L_2_H_P) + UB(1:1) = ubound(InData%B_L_2_H_P) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%B_L_2_H_P(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SigmaCavitCrit + call RegPack(Buf, allocated(InData%SigmaCavitCrit)) + if (allocated(InData%SigmaCavitCrit)) then + call RegPackBounds(Buf, 2, lbound(InData%SigmaCavitCrit), ubound(InData%SigmaCavitCrit)) + call RegPack(Buf, InData%SigmaCavitCrit) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SigmaCavit + call RegPack(Buf, allocated(InData%SigmaCavit)) + if (allocated(InData%SigmaCavit)) then + call RegPackBounds(Buf, 2, lbound(InData%SigmaCavit), ubound(InData%SigmaCavit)) + call RegPack(Buf, InData%SigmaCavit) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CavitWarnSet + call RegPack(Buf, allocated(InData%CavitWarnSet)) + if (allocated(InData%CavitWarnSet)) then + call RegPackBounds(Buf, 2, lbound(InData%CavitWarnSet), ubound(InData%CavitWarnSet)) + call RegPack(Buf, InData%CavitWarnSet) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BlFB + call RegPack(Buf, allocated(InData%BlFB)) + if (allocated(InData%BlFB)) then + call RegPackBounds(Buf, 3, lbound(InData%BlFB), ubound(InData%BlFB)) + call RegPack(Buf, InData%BlFB) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BlMB + call RegPack(Buf, allocated(InData%BlMB)) + if (allocated(InData%BlMB)) then + call RegPackBounds(Buf, 3, lbound(InData%BlMB), ubound(InData%BlMB)) + call RegPack(Buf, InData%BlMB) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TwrFB + call RegPack(Buf, allocated(InData%TwrFB)) + if (allocated(InData%TwrFB)) then + call RegPackBounds(Buf, 2, lbound(InData%TwrFB), ubound(InData%TwrFB)) + call RegPack(Buf, InData%TwrFB) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TwrMB + call RegPack(Buf, allocated(InData%TwrMB)) + if (allocated(InData%TwrMB)) then + call RegPackBounds(Buf, 2, lbound(InData%TwrMB), ubound(InData%TwrMB)) + call RegPack(Buf, InData%TwrMB) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! HubFB + call RegPack(Buf, allocated(InData%HubFB)) + if (allocated(InData%HubFB)) then + call RegPackBounds(Buf, 1, lbound(InData%HubFB), ubound(InData%HubFB)) + call RegPack(Buf, InData%HubFB) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! HubMB + call RegPack(Buf, allocated(InData%HubMB)) + if (allocated(InData%HubMB)) then + call RegPackBounds(Buf, 1, lbound(InData%HubMB), ubound(InData%HubMB)) + call RegPack(Buf, InData%HubMB) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NacFB + call RegPack(Buf, allocated(InData%NacFB)) + if (allocated(InData%NacFB)) then + call RegPackBounds(Buf, 1, lbound(InData%NacFB), ubound(InData%NacFB)) + call RegPack(Buf, InData%NacFB) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NacMB + call RegPack(Buf, allocated(InData%NacMB)) + if (allocated(InData%NacMB)) then + call RegPackBounds(Buf, 1, lbound(InData%NacMB), ubound(InData%NacMB)) + call RegPack(Buf, InData%NacMB) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BladeRootLoad + call RegPack(Buf, allocated(InData%BladeRootLoad)) + if (allocated(InData%BladeRootLoad)) then + call RegPackBounds(Buf, 1, lbound(InData%BladeRootLoad), ubound(InData%BladeRootLoad)) + LB(1:1) = lbound(InData%BladeRootLoad) + UB(1:1) = ubound(InData%BladeRootLoad) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%BladeRootLoad(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! B_L_2_R_P + call RegPack(Buf, allocated(InData%B_L_2_R_P)) + if (allocated(InData%B_L_2_R_P)) then + call RegPackBounds(Buf, 1, lbound(InData%B_L_2_R_P), ubound(InData%B_L_2_R_P)) + LB(1:1) = lbound(InData%B_L_2_R_P) + UB(1:1) = ubound(InData%B_L_2_R_P) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%B_L_2_R_P(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BladeBuoyLoadPoint + call RegPack(Buf, allocated(InData%BladeBuoyLoadPoint)) + if (allocated(InData%BladeBuoyLoadPoint)) then + call RegPackBounds(Buf, 1, lbound(InData%BladeBuoyLoadPoint), ubound(InData%BladeBuoyLoadPoint)) + LB(1:1) = lbound(InData%BladeBuoyLoadPoint) + UB(1:1) = ubound(InData%BladeBuoyLoadPoint) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%BladeBuoyLoadPoint(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BladeBuoyLoad + call RegPack(Buf, allocated(InData%BladeBuoyLoad)) + if (allocated(InData%BladeBuoyLoad)) then + call RegPackBounds(Buf, 1, lbound(InData%BladeBuoyLoad), ubound(InData%BladeBuoyLoad)) + LB(1:1) = lbound(InData%BladeBuoyLoad) + UB(1:1) = ubound(InData%BladeBuoyLoad) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%BladeBuoyLoad(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! B_P_2_B_L + call RegPack(Buf, allocated(InData%B_P_2_B_L)) + if (allocated(InData%B_P_2_B_L)) then + call RegPackBounds(Buf, 1, lbound(InData%B_P_2_B_L), ubound(InData%B_P_2_B_L)) + LB(1:1) = lbound(InData%B_P_2_B_L) + UB(1:1) = ubound(InData%B_P_2_B_L) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%B_P_2_B_L(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TwrBuoyLoadPoint + call MeshPack(Buf, InData%TwrBuoyLoadPoint) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrBuoyLoad + call MeshPack(Buf, InData%TwrBuoyLoad) + if (RegCheckErr(Buf, RoutineName)) return + ! T_P_2_T_L + call NWTC_Library_PackMeshMapType(Buf, InData%T_P_2_T_L) + if (RegCheckErr(Buf, RoutineName)) return + ! FirstWarn_TowerStrike + call RegPack(Buf, InData%FirstWarn_TowerStrike) + if (RegCheckErr(Buf, RoutineName)) return + ! AvgDiskVel + call RegPack(Buf, InData%AvgDiskVel) + if (RegCheckErr(Buf, RoutineName)) return + ! AvgDiskVelDist + call RegPack(Buf, InData%AvgDiskVelDist) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinAlpha + call RegPack(Buf, InData%TFinAlpha) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinRe + call RegPack(Buf, InData%TFinRe) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinVrel + call RegPack(Buf, InData%TFinVrel) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinVund_i + call RegPack(Buf, InData%TFinVund_i) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinVind_i + call RegPack(Buf, InData%TFinVind_i) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinVrel_i + call RegPack(Buf, InData%TFinVrel_i) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinSTV_i + call RegPack(Buf, InData%TFinSTV_i) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinF_i + call RegPack(Buf, InData%TFinF_i) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinM_i + call RegPack(Buf, InData%TFinM_i) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackRotMiscVarType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(RotMiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackRotMiscVarType' + integer(IntKi) :: i1, i2, i3, i4 + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! BEMT + call BEMT_UnpackMisc(Buf, OutData%BEMT) ! BEMT + ! BEMT_y + call BEMT_UnpackOutput(Buf, OutData%BEMT_y) ! BEMT_y + ! BEMT_u + LB(1:1) = lbound(OutData%BEMT_u) + UB(1:1) = ubound(OutData%BEMT_u) + do i1 = LB(1), UB(1) + call BEMT_UnpackInput(Buf, OutData%BEMT_u(i1)) ! BEMT_u + end do + ! AA + call AA_UnpackMisc(Buf, OutData%AA) ! AA + ! AA_y + call AA_UnpackOutput(Buf, OutData%AA_y) ! AA_y + ! AA_u + call AA_UnpackInput(Buf, OutData%AA_u) ! AA_u + ! DisturbedInflow + if (allocated(OutData%DisturbedInflow)) deallocate(OutData%DisturbedInflow) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DisturbedInflow(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DisturbedInflow.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DisturbedInflow) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! orientationAnnulus + if (allocated(OutData%orientationAnnulus)) deallocate(OutData%orientationAnnulus) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%orientationAnnulus(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%orientationAnnulus.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%orientationAnnulus) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AllOuts + if (allocated(OutData%AllOuts)) deallocate(OutData%AllOuts) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AllOuts(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AllOuts) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! W_Twr + if (allocated(OutData%W_Twr)) deallocate(OutData%W_Twr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%W_Twr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%W_Twr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%W_Twr) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! X_Twr + if (allocated(OutData%X_Twr)) deallocate(OutData%X_Twr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%X_Twr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%X_Twr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%X_Twr) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Y_Twr + if (allocated(OutData%Y_Twr)) deallocate(OutData%Y_Twr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Y_Twr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y_Twr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Y_Twr) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Curve + if (allocated(OutData%Curve)) deallocate(OutData%Curve) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Curve(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Curve.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Curve) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TwrClrnc + if (allocated(OutData%TwrClrnc)) deallocate(OutData%TwrClrnc) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrClrnc(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrClrnc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrClrnc) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! X + if (allocated(OutData%X)) deallocate(OutData%X) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%X(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%X.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%X) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Y + if (allocated(OutData%Y)) deallocate(OutData%Y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Y(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Y) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Z + if (allocated(OutData%Z)) deallocate(OutData%Z) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Z(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Z) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! M + if (allocated(OutData%M)) deallocate(OutData%M) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%M(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%M.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%M) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Mx + if (allocated(OutData%Mx)) deallocate(OutData%Mx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Mx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Mx) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! My + if (allocated(OutData%My)) deallocate(OutData%My) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%My(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%My.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%My) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Mz + if (allocated(OutData%Mz)) deallocate(OutData%Mz) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Mz(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Mz) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! V_DiskAvg + call RegUnpack(Buf, OutData%V_DiskAvg) + if (RegCheckErr(Buf, RoutineName)) return + ! yaw + call RegUnpack(Buf, OutData%yaw) + if (RegCheckErr(Buf, RoutineName)) return + ! tilt + call RegUnpack(Buf, OutData%tilt) + if (RegCheckErr(Buf, RoutineName)) return + ! hub_theta_x_root + if (allocated(OutData%hub_theta_x_root)) deallocate(OutData%hub_theta_x_root) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%hub_theta_x_root(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%hub_theta_x_root.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%hub_theta_x_root) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! V_dot_x + call RegUnpack(Buf, OutData%V_dot_x) + if (RegCheckErr(Buf, RoutineName)) return + ! HubLoad + call MeshUnpack(Buf, OutData%HubLoad) ! HubLoad + ! B_L_2_H_P + if (allocated(OutData%B_L_2_H_P)) deallocate(OutData%B_L_2_H_P) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%B_L_2_H_P(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B_L_2_H_P.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%B_L_2_H_P(i1)) ! B_L_2_H_P + end do + end if + ! SigmaCavitCrit + if (allocated(OutData%SigmaCavitCrit)) deallocate(OutData%SigmaCavitCrit) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SigmaCavitCrit(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SigmaCavitCrit.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SigmaCavitCrit) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! SigmaCavit + if (allocated(OutData%SigmaCavit)) deallocate(OutData%SigmaCavit) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SigmaCavit(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SigmaCavit.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SigmaCavit) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CavitWarnSet + if (allocated(OutData%CavitWarnSet)) deallocate(OutData%CavitWarnSet) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CavitWarnSet(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CavitWarnSet.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CavitWarnSet) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BlFB + if (allocated(OutData%BlFB)) deallocate(OutData%BlFB) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlFB(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlFB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlFB) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BlMB + if (allocated(OutData%BlMB)) deallocate(OutData%BlMB) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlMB(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlMB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlMB) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TwrFB + if (allocated(OutData%TwrFB)) deallocate(OutData%TwrFB) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrFB(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrFB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrFB) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TwrMB + if (allocated(OutData%TwrMB)) deallocate(OutData%TwrMB) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrMB(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrMB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrMB) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! HubFB + if (allocated(OutData%HubFB)) deallocate(OutData%HubFB) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%HubFB(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%HubFB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%HubFB) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! HubMB + if (allocated(OutData%HubMB)) deallocate(OutData%HubMB) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%HubMB(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%HubMB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%HubMB) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NacFB + if (allocated(OutData%NacFB)) deallocate(OutData%NacFB) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NacFB(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NacFB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%NacFB) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NacMB + if (allocated(OutData%NacMB)) deallocate(OutData%NacMB) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NacMB(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NacMB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%NacMB) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BladeRootLoad + if (allocated(OutData%BladeRootLoad)) deallocate(OutData%BladeRootLoad) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BladeRootLoad(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootLoad.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%BladeRootLoad(i1)) ! BladeRootLoad + end do + end if + ! B_L_2_R_P + if (allocated(OutData%B_L_2_R_P)) deallocate(OutData%B_L_2_R_P) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%B_L_2_R_P(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B_L_2_R_P.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%B_L_2_R_P(i1)) ! B_L_2_R_P + end do + end if + ! BladeBuoyLoadPoint + if (allocated(OutData%BladeBuoyLoadPoint)) deallocate(OutData%BladeBuoyLoadPoint) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BladeBuoyLoadPoint(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeBuoyLoadPoint.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%BladeBuoyLoadPoint(i1)) ! BladeBuoyLoadPoint + end do + end if + ! BladeBuoyLoad + if (allocated(OutData%BladeBuoyLoad)) deallocate(OutData%BladeBuoyLoad) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BladeBuoyLoad(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeBuoyLoad.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%BladeBuoyLoad(i1)) ! BladeBuoyLoad + end do + end if + ! B_P_2_B_L + if (allocated(OutData%B_P_2_B_L)) deallocate(OutData%B_P_2_B_L) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%B_P_2_B_L(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B_P_2_B_L.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%B_P_2_B_L(i1)) ! B_P_2_B_L + end do + end if + ! TwrBuoyLoadPoint + call MeshUnpack(Buf, OutData%TwrBuoyLoadPoint) ! TwrBuoyLoadPoint + ! TwrBuoyLoad + call MeshUnpack(Buf, OutData%TwrBuoyLoad) ! TwrBuoyLoad + ! T_P_2_T_L + call NWTC_Library_UnpackMeshMapType(Buf, OutData%T_P_2_T_L) ! T_P_2_T_L + ! FirstWarn_TowerStrike + call RegUnpack(Buf, OutData%FirstWarn_TowerStrike) + if (RegCheckErr(Buf, RoutineName)) return + ! AvgDiskVel + call RegUnpack(Buf, OutData%AvgDiskVel) + if (RegCheckErr(Buf, RoutineName)) return + ! AvgDiskVelDist + call RegUnpack(Buf, OutData%AvgDiskVelDist) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinAlpha + call RegUnpack(Buf, OutData%TFinAlpha) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinRe + call RegUnpack(Buf, OutData%TFinRe) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinVrel + call RegUnpack(Buf, OutData%TFinVrel) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinVund_i + call RegUnpack(Buf, OutData%TFinVund_i) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinVind_i + call RegUnpack(Buf, OutData%TFinVind_i) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinVrel_i + call RegUnpack(Buf, OutData%TFinVrel_i) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinSTV_i + call RegUnpack(Buf, OutData%TFinSTV_i) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinF_i + call RegUnpack(Buf, OutData%TFinF_i) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinM_i + call RegUnpack(Buf, OutData%TFinM_i) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE AD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) TYPE(AD_MiscVarType), INTENT(INOUT) :: SrcMiscData TYPE(AD_MiscVarType), INTENT(INOUT) :: DstMiscData @@ -12533,678 +5944,179 @@ SUBROUTINE AD_DestroyMisc( MiscData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MiscData%rotors) -ENDIF -IF (ALLOCATED(MiscData%FVW_u)) THEN -DO i1 = LBOUND(MiscData%FVW_u,1), UBOUND(MiscData%FVW_u,1) - CALL FVW_DestroyInput( MiscData%FVW_u(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%FVW_u) -ENDIF - CALL FVW_DestroyOutput( MiscData%FVW_y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FVW_DestroyMisc( MiscData%FVW, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MiscData%WindPos)) THEN - DEALLOCATE(MiscData%WindPos) -ENDIF -IF (ALLOCATED(MiscData%WindVel)) THEN - DEALLOCATE(MiscData%WindVel) -ENDIF -IF (ALLOCATED(MiscData%WindAcc)) THEN - DEALLOCATE(MiscData%WindAcc) -ENDIF - END SUBROUTINE AD_DestroyMisc - - SUBROUTINE AD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AD_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! rotors allocated yes/no - IF ( ALLOCATED(InData%rotors) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotors upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - Int_BufSz = Int_BufSz + 3 ! rotors: size of buffers for each call to pack subtype - CALL AD_PackRotMiscVarType( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! rotors - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! rotors - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! rotors - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! FVW_u allocated yes/no - IF ( ALLOCATED(InData%FVW_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FVW_u upper/lower bounds for each dimension - DO i1 = LBOUND(InData%FVW_u,1), UBOUND(InData%FVW_u,1) - Int_BufSz = Int_BufSz + 3 ! FVW_u: size of buffers for each call to pack subtype - CALL FVW_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%FVW_u(i1), ErrStat2, ErrMsg2, .TRUE. ) ! FVW_u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FVW_u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FVW_u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FVW_u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! FVW_y: size of buffers for each call to pack subtype - CALL FVW_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%FVW_y, ErrStat2, ErrMsg2, .TRUE. ) ! FVW_y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FVW_y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FVW_y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FVW_y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! FVW: size of buffers for each call to pack subtype - CALL FVW_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, .TRUE. ) ! FVW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FVW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FVW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FVW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! WindPos allocated yes/no - IF ( ALLOCATED(InData%WindPos) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WindPos upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WindPos) ! WindPos - END IF - Int_BufSz = Int_BufSz + 1 ! WindVel allocated yes/no - IF ( ALLOCATED(InData%WindVel) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WindVel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WindVel) ! WindVel - END IF - Int_BufSz = Int_BufSz + 1 ! WindAcc allocated yes/no - IF ( ALLOCATED(InData%WindAcc) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WindAcc upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WindAcc) ! WindAcc - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%rotors) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rotors,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotors,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - CALL AD_PackRotMiscVarType( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FVW_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FVW_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FVW_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FVW_u,1), UBOUND(InData%FVW_u,1) - CALL FVW_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%FVW_u(i1), ErrStat2, ErrMsg2, OnlySize ) ! FVW_u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL FVW_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%FVW_y, ErrStat2, ErrMsg2, OnlySize ) ! FVW_y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL FVW_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, OnlySize ) ! FVW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%WindPos) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WindPos,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindPos,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WindPos,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindPos,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WindPos,2), UBOUND(InData%WindPos,2) - DO i1 = LBOUND(InData%WindPos,1), UBOUND(InData%WindPos,1) - ReKiBuf(Re_Xferred) = InData%WindPos(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WindVel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WindVel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindVel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WindVel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindVel,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WindVel,2), UBOUND(InData%WindVel,2) - DO i1 = LBOUND(InData%WindVel,1), UBOUND(InData%WindVel,1) - ReKiBuf(Re_Xferred) = InData%WindVel(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WindAcc) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WindAcc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindAcc,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WindAcc,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindAcc,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WindAcc,2), UBOUND(InData%WindAcc,2) - DO i1 = LBOUND(InData%WindAcc,1), UBOUND(InData%WindAcc,1) - ReKiBuf(Re_Xferred) = InData%WindAcc(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE AD_PackMisc - - SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AD_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rotors not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rotors)) DEALLOCATE(OutData%rotors) - ALLOCATE(OutData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotors,1), UBOUND(OutData%rotors,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackRotMiscVarType( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FVW_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FVW_u)) DEALLOCATE(OutData%FVW_u) - ALLOCATE(OutData%FVW_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FVW_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FVW_u,1), UBOUND(OutData%FVW_u,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FVW_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%FVW_u(i1), ErrStat2, ErrMsg2 ) ! FVW_u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FVW_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%FVW_y, ErrStat2, ErrMsg2 ) ! FVW_y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FVW_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%FVW, ErrStat2, ErrMsg2 ) ! FVW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN +ENDIF +IF (ALLOCATED(MiscData%FVW_u)) THEN +DO i1 = LBOUND(MiscData%FVW_u,1), UBOUND(MiscData%FVW_u,1) + CALL FVW_DestroyInput( MiscData%FVW_u(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(MiscData%FVW_u) +ENDIF + CALL FVW_DestroyOutput( MiscData%FVW_y, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL FVW_DestroyMisc( MiscData%FVW, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(MiscData%WindPos)) THEN + DEALLOCATE(MiscData%WindPos) +ENDIF +IF (ALLOCATED(MiscData%WindVel)) THEN + DEALLOCATE(MiscData%WindVel) +ENDIF +IF (ALLOCATED(MiscData%WindAcc)) THEN + DEALLOCATE(MiscData%WindAcc) +ENDIF + END SUBROUTINE AD_DestroyMisc - 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 ! WindPos not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WindPos)) DEALLOCATE(OutData%WindPos) - ALLOCATE(OutData%WindPos(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindPos.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WindPos,2), UBOUND(OutData%WindPos,2) - DO i1 = LBOUND(OutData%WindPos,1), UBOUND(OutData%WindPos,1) - OutData%WindPos(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindVel not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WindVel)) DEALLOCATE(OutData%WindVel) - ALLOCATE(OutData%WindVel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WindVel,2), UBOUND(OutData%WindVel,2) - DO i1 = LBOUND(OutData%WindVel,1), UBOUND(OutData%WindVel,1) - OutData%WindVel(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindAcc not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WindAcc)) DEALLOCATE(OutData%WindAcc) - ALLOCATE(OutData%WindAcc(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindAcc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WindAcc,2), UBOUND(OutData%WindAcc,2) - DO i1 = LBOUND(OutData%WindAcc,1), UBOUND(OutData%WindAcc,1) - OutData%WindAcc(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE AD_UnPackMisc +subroutine AD_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackMisc' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + ! rotors + call RegPack(Buf, allocated(InData%rotors)) + if (allocated(InData%rotors)) then + call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) + do i1 = LB(1), UB(1) + call AD_PackRotMiscVarType(Buf, InData%rotors(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FVW_u + call RegPack(Buf, allocated(InData%FVW_u)) + if (allocated(InData%FVW_u)) then + call RegPackBounds(Buf, 1, lbound(InData%FVW_u), ubound(InData%FVW_u)) + LB(1:1) = lbound(InData%FVW_u) + UB(1:1) = ubound(InData%FVW_u) + do i1 = LB(1), UB(1) + call FVW_PackInput(Buf, InData%FVW_u(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FVW_y + call FVW_PackOutput(Buf, InData%FVW_y) + if (RegCheckErr(Buf, RoutineName)) return + ! FVW + call FVW_PackMisc(Buf, InData%FVW) + if (RegCheckErr(Buf, RoutineName)) return + ! WindPos + call RegPack(Buf, allocated(InData%WindPos)) + if (allocated(InData%WindPos)) then + call RegPackBounds(Buf, 2, lbound(InData%WindPos), ubound(InData%WindPos)) + call RegPack(Buf, InData%WindPos) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WindVel + call RegPack(Buf, allocated(InData%WindVel)) + if (allocated(InData%WindVel)) then + call RegPackBounds(Buf, 2, lbound(InData%WindVel), ubound(InData%WindVel)) + call RegPack(Buf, InData%WindVel) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WindAcc + call RegPack(Buf, allocated(InData%WindAcc)) + if (allocated(InData%WindAcc)) then + call RegPackBounds(Buf, 2, lbound(InData%WindAcc), ubound(InData%WindAcc)) + call RegPack(Buf, InData%WindAcc) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackMisc' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! rotors + if (allocated(OutData%rotors)) deallocate(OutData%rotors) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rotors(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackRotMiscVarType(Buf, OutData%rotors(i1)) ! rotors + end do + end if + ! FVW_u + if (allocated(OutData%FVW_u)) deallocate(OutData%FVW_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FVW_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FVW_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FVW_UnpackInput(Buf, OutData%FVW_u(i1)) ! FVW_u + end do + end if + ! FVW_y + call FVW_UnpackOutput(Buf, OutData%FVW_y) ! FVW_y + ! FVW + call FVW_UnpackMisc(Buf, OutData%FVW) ! FVW + ! WindPos + if (allocated(OutData%WindPos)) deallocate(OutData%WindPos) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WindPos(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindPos.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WindPos) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WindVel + if (allocated(OutData%WindVel)) deallocate(OutData%WindVel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WindVel(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindVel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WindVel) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WindAcc + if (allocated(OutData%WindAcc)) deallocate(OutData%WindAcc) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WindAcc(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindAcc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WindAcc) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE AD_CopyRotParameterType( SrcRotParameterTypeData, DstRotParameterTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(RotParameterType), INTENT(IN) :: SrcRotParameterTypeData TYPE(RotParameterType), INTENT(INOUT) :: DstRotParameterTypeData @@ -13624,1630 +6536,762 @@ SUBROUTINE AD_DestroyRotParameterType( RotParameterTypeData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(RotParameterTypeData%OutParam) -ENDIF -IF (ALLOCATED(RotParameterTypeData%BldNd_OutParam)) THEN -DO i1 = LBOUND(RotParameterTypeData%BldNd_OutParam,1), UBOUND(RotParameterTypeData%BldNd_OutParam,1) - CALL NWTC_Library_DestroyOutParmType( RotParameterTypeData%BldNd_OutParam(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotParameterTypeData%BldNd_OutParam) -ENDIF -IF (ALLOCATED(RotParameterTypeData%BldNd_BlOutNd)) THEN - DEALLOCATE(RotParameterTypeData%BldNd_BlOutNd) -ENDIF - CALL AD_DestroyTFinParameterType( RotParameterTypeData%TFin, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_DestroyRotParameterType - - SUBROUTINE AD_PackRotParameterType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(RotParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_PackRotParameterType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! NumBlades - Int_BufSz = Int_BufSz + 1 ! NumBlNds - Int_BufSz = Int_BufSz + 1 ! NumTwrNds - Int_BufSz = Int_BufSz + 1 ! TwrDiam allocated yes/no - IF ( ALLOCATED(InData%TwrDiam) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrDiam upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrDiam) ! TwrDiam - END IF - Int_BufSz = Int_BufSz + 1 ! TwrCd allocated yes/no - IF ( ALLOCATED(InData%TwrCd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrCd upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrCd) ! TwrCd - END IF - Int_BufSz = Int_BufSz + 1 ! TwrTI allocated yes/no - IF ( ALLOCATED(InData%TwrTI) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrTI upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrTI) ! TwrTI - END IF - Int_BufSz = Int_BufSz + 1 ! BlTwist allocated yes/no - IF ( ALLOCATED(InData%BlTwist) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BlTwist upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlTwist) ! BlTwist - END IF - Int_BufSz = Int_BufSz + 1 ! TwrCb allocated yes/no - IF ( ALLOCATED(InData%TwrCb) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrCb upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrCb) ! TwrCb - END IF - Int_BufSz = Int_BufSz + 1 ! BlCenBn allocated yes/no - IF ( ALLOCATED(InData%BlCenBn) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BlCenBn upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlCenBn) ! BlCenBn - END IF - Int_BufSz = Int_BufSz + 1 ! BlCenBt allocated yes/no - IF ( ALLOCATED(InData%BlCenBt) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BlCenBt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlCenBt) ! BlCenBt - END IF - Re_BufSz = Re_BufSz + 1 ! VolHub - Re_BufSz = Re_BufSz + 1 ! HubCenBx - Re_BufSz = Re_BufSz + 1 ! VolNac - Re_BufSz = Re_BufSz + SIZE(InData%NacCenB) ! NacCenB - Re_BufSz = Re_BufSz + 1 ! VolBl - Re_BufSz = Re_BufSz + 1 ! VolTwr - Int_BufSz = Int_BufSz + 1 ! BlRad allocated yes/no - IF ( ALLOCATED(InData%BlRad) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BlRad upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlRad) ! BlRad - END IF - Int_BufSz = Int_BufSz + 1 ! BlDL allocated yes/no - IF ( ALLOCATED(InData%BlDL) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BlDL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlDL) ! BlDL - END IF - Int_BufSz = Int_BufSz + 1 ! BlTaper allocated yes/no - IF ( ALLOCATED(InData%BlTaper) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BlTaper upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlTaper) ! BlTaper - END IF - Int_BufSz = Int_BufSz + 1 ! BlAxCent allocated yes/no - IF ( ALLOCATED(InData%BlAxCent) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BlAxCent upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlAxCent) ! BlAxCent - END IF - Int_BufSz = Int_BufSz + 1 ! TwrRad allocated yes/no - IF ( ALLOCATED(InData%TwrRad) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrRad upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrRad) ! TwrRad - END IF - Int_BufSz = Int_BufSz + 1 ! TwrDL allocated yes/no - IF ( ALLOCATED(InData%TwrDL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrDL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrDL) ! TwrDL - END IF - Int_BufSz = Int_BufSz + 1 ! TwrTaper allocated yes/no - IF ( ALLOCATED(InData%TwrTaper) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrTaper upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrTaper) ! TwrTaper - END IF - Int_BufSz = Int_BufSz + 1 ! TwrAxCent allocated yes/no - IF ( ALLOCATED(InData%TwrAxCent) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrAxCent upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrAxCent) ! TwrAxCent - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! BEMT: size of buffers for each call to pack subtype - CALL BEMT_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%BEMT, ErrStat2, ErrMsg2, .TRUE. ) ! BEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BEMT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BEMT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BEMT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! AA: size of buffers for each call to pack subtype - CALL AA_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, .TRUE. ) ! AA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_u_indx allocated yes/no - IF ( ALLOCATED(InData%Jac_u_indx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_u_indx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_u_indx) ! Jac_u_indx - END IF - Int_BufSz = Int_BufSz + 1 ! du allocated yes/no - IF ( ALLOCATED(InData%du) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! du upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%du) ! du - END IF - Int_BufSz = Int_BufSz + 1 ! dx allocated yes/no - IF ( ALLOCATED(InData%dx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dx upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dx) ! dx - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_ny - Int_BufSz = Int_BufSz + 1 ! NumBl_Lin - Int_BufSz = Int_BufSz + 1 ! TwrPotent - Int_BufSz = Int_BufSz + 1 ! TwrShadow - Int_BufSz = Int_BufSz + 1 ! TwrAero - Int_BufSz = Int_BufSz + 1 ! FrozenWake - Int_BufSz = Int_BufSz + 1 ! CavitCheck - Int_BufSz = Int_BufSz + 1 ! Buoyancy - Int_BufSz = Int_BufSz + 1 ! MHK - Int_BufSz = Int_BufSz + 1 ! CompAA - Re_BufSz = Re_BufSz + 1 ! AirDens - Re_BufSz = Re_BufSz + 1 ! KinVisc - Re_BufSz = Re_BufSz + 1 ! SpdSound - Re_BufSz = Re_BufSz + 1 ! Gravity - Re_BufSz = Re_BufSz + 1 ! Patm - Re_BufSz = Re_BufSz + 1 ! Pvap - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Re_BufSz = Re_BufSz + 1 ! MSL2SWL - Int_BufSz = Int_BufSz + 1 ! AeroProjMod - Int_BufSz = Int_BufSz + 1 ! AeroBEM_Mod - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1 ! OutParam allocated yes/no - IF ( ALLOCATED(InData%OutParam) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutParam upper/lower bounds for each dimension - DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - Int_BufSz = Int_BufSz + 3 ! OutParam: size of buffers for each call to pack subtype - CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutParam - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutParam - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutParam - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NBlOuts - Int_BufSz = Int_BufSz + SIZE(InData%BlOutNd) ! BlOutNd - Int_BufSz = Int_BufSz + 1 ! NTwOuts - Int_BufSz = Int_BufSz + SIZE(InData%TwOutNd) ! TwOutNd - Int_BufSz = Int_BufSz + 1 ! BldNd_NumOuts - Int_BufSz = Int_BufSz + 1 ! BldNd_TotNumOuts - Int_BufSz = Int_BufSz + 1 ! BldNd_OutParam allocated yes/no - IF ( ALLOCATED(InData%BldNd_OutParam) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BldNd_OutParam upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BldNd_OutParam,1), UBOUND(InData%BldNd_OutParam,1) - Int_BufSz = Int_BufSz + 3 ! BldNd_OutParam: size of buffers for each call to pack subtype - CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BldNd_OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BldNd_OutParam - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BldNd_OutParam - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BldNd_OutParam - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! BldNd_BlOutNd allocated yes/no - IF ( ALLOCATED(InData%BldNd_BlOutNd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BldNd_BlOutNd upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BldNd_BlOutNd) ! BldNd_BlOutNd - END IF - Int_BufSz = Int_BufSz + 1 ! BldNd_BladesOut - Int_BufSz = Int_BufSz + 1 ! TFinAero - Int_BufSz = Int_BufSz + 3 ! TFin: size of buffers for each call to pack subtype - CALL AD_PackTFinParameterType( Re_Buf, Db_Buf, Int_Buf, InData%TFin, ErrStat2, ErrMsg2, .TRUE. ) ! TFin - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TFin - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TFin - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TFin - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%NumBlades - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBlNds - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumTwrNds - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TwrDiam) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrDiam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrDiam,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrDiam,1), UBOUND(InData%TwrDiam,1) - ReKiBuf(Re_Xferred) = InData%TwrDiam(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrCd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrCd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrCd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrCd,1), UBOUND(InData%TwrCd,1) - ReKiBuf(Re_Xferred) = InData%TwrCd(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrTI) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrTI,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrTI,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrTI,1), UBOUND(InData%TwrTI,1) - ReKiBuf(Re_Xferred) = InData%TwrTI(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlTwist) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlTwist,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlTwist,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlTwist,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlTwist,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BlTwist,2), UBOUND(InData%BlTwist,2) - DO i1 = LBOUND(InData%BlTwist,1), UBOUND(InData%BlTwist,1) - ReKiBuf(Re_Xferred) = InData%BlTwist(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrCb) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrCb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrCb,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrCb,1), UBOUND(InData%TwrCb,1) - ReKiBuf(Re_Xferred) = InData%TwrCb(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlCenBn) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlCenBn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCenBn,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlCenBn,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCenBn,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BlCenBn,2), UBOUND(InData%BlCenBn,2) - DO i1 = LBOUND(InData%BlCenBn,1), UBOUND(InData%BlCenBn,1) - ReKiBuf(Re_Xferred) = InData%BlCenBn(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlCenBt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlCenBt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCenBt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlCenBt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCenBt,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BlCenBt,2), UBOUND(InData%BlCenBt,2) - DO i1 = LBOUND(InData%BlCenBt,1), UBOUND(InData%BlCenBt,1) - ReKiBuf(Re_Xferred) = InData%BlCenBt(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%VolHub - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubCenBx - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VolNac - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%NacCenB,1), UBOUND(InData%NacCenB,1) - ReKiBuf(Re_Xferred) = InData%NacCenB(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%VolBl - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VolTwr - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BlRad) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlRad,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlRad,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlRad,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlRad,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BlRad,2), UBOUND(InData%BlRad,2) - DO i1 = LBOUND(InData%BlRad,1), UBOUND(InData%BlRad,1) - ReKiBuf(Re_Xferred) = InData%BlRad(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlDL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlDL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlDL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlDL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlDL,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BlDL,2), UBOUND(InData%BlDL,2) - DO i1 = LBOUND(InData%BlDL,1), UBOUND(InData%BlDL,1) - ReKiBuf(Re_Xferred) = InData%BlDL(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlTaper) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlTaper,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlTaper,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlTaper,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlTaper,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BlTaper,2), UBOUND(InData%BlTaper,2) - DO i1 = LBOUND(InData%BlTaper,1), UBOUND(InData%BlTaper,1) - ReKiBuf(Re_Xferred) = InData%BlTaper(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlAxCent) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlAxCent,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlAxCent,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlAxCent,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlAxCent,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BlAxCent,2), UBOUND(InData%BlAxCent,2) - DO i1 = LBOUND(InData%BlAxCent,1), UBOUND(InData%BlAxCent,1) - ReKiBuf(Re_Xferred) = InData%BlAxCent(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrRad) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrRad,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrRad,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrRad,1), UBOUND(InData%TwrRad,1) - ReKiBuf(Re_Xferred) = InData%TwrRad(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrDL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrDL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrDL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrDL,1), UBOUND(InData%TwrDL,1) - ReKiBuf(Re_Xferred) = InData%TwrDL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrTaper) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrTaper,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrTaper,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrTaper,1), UBOUND(InData%TwrTaper,1) - ReKiBuf(Re_Xferred) = InData%TwrTaper(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrAxCent) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrAxCent,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrAxCent,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrAxCent,1), UBOUND(InData%TwrAxCent,1) - ReKiBuf(Re_Xferred) = InData%TwrAxCent(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - CALL BEMT_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%BEMT, ErrStat2, ErrMsg2, OnlySize ) ! BEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AA_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%AA, ErrStat2, ErrMsg2, OnlySize ) ! AA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%Jac_u_indx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_u_indx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_u_indx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jac_u_indx,2), UBOUND(InData%Jac_u_indx,2) - DO i1 = LBOUND(InData%Jac_u_indx,1), UBOUND(InData%Jac_u_indx,1) - IntKiBuf(Int_Xferred) = InData%Jac_u_indx(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%du) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%du,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%du,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%du,1), UBOUND(InData%du,1) - ReKiBuf(Re_Xferred) = InData%du(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dx,1), UBOUND(InData%dx,1) - ReKiBuf(Re_Xferred) = InData%dx(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%Jac_ny - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBl_Lin - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TwrPotent - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TwrShadow - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TwrAero, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FrozenWake, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%CavitCheck, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Buoyancy, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MHK - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%CompAA, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AirDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%KinVisc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SpdSound - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Patm - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Pvap - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%AeroProjMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%AeroBEM_Mod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutParam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParam,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NBlOuts - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%BlOutNd,1), UBOUND(InData%BlOutNd,1) - IntKiBuf(Int_Xferred) = InData%BlOutNd(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%NTwOuts - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%TwOutNd,1), UBOUND(InData%TwOutNd,1) - IntKiBuf(Int_Xferred) = InData%TwOutNd(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%BldNd_NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%BldNd_TotNumOuts - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BldNd_OutParam) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldNd_OutParam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_OutParam,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BldNd_OutParam,1), UBOUND(InData%BldNd_OutParam,1) - CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! BldNd_OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BldNd_BlOutNd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldNd_BlOutNd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_BlOutNd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BldNd_BlOutNd,1), UBOUND(InData%BldNd_BlOutNd,1) - IntKiBuf(Int_Xferred) = InData%BldNd_BlOutNd(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%BldNd_BladesOut - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TFinAero, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - CALL AD_PackTFinParameterType( Re_Buf, Db_Buf, Int_Buf, InData%TFin, ErrStat2, ErrMsg2, OnlySize ) ! TFin - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE AD_PackRotParameterType - - SUBROUTINE AD_UnPackRotParameterType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(RotParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackRotParameterType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%NumBlades = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumBlNds = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumTwrNds = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrDiam not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TwrDiam)) DEALLOCATE(OutData%TwrDiam) - ALLOCATE(OutData%TwrDiam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrDiam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrDiam,1), UBOUND(OutData%TwrDiam,1) - OutData%TwrDiam(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrCd not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TwrCd)) DEALLOCATE(OutData%TwrCd) - ALLOCATE(OutData%TwrCd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrCd,1), UBOUND(OutData%TwrCd,1) - OutData%TwrCd(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrTI not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TwrTI)) DEALLOCATE(OutData%TwrTI) - ALLOCATE(OutData%TwrTI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrTI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrTI,1), UBOUND(OutData%TwrTI,1) - OutData%TwrTI(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlTwist not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlTwist)) DEALLOCATE(OutData%BlTwist) - ALLOCATE(OutData%BlTwist(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlTwist.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BlTwist,2), UBOUND(OutData%BlTwist,2) - DO i1 = LBOUND(OutData%BlTwist,1), UBOUND(OutData%BlTwist,1) - OutData%BlTwist(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrCb not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TwrCb)) DEALLOCATE(OutData%TwrCb) - ALLOCATE(OutData%TwrCb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrCb,1), UBOUND(OutData%TwrCb,1) - OutData%TwrCb(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlCenBn not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlCenBn)) DEALLOCATE(OutData%BlCenBn) - ALLOCATE(OutData%BlCenBn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCenBn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BlCenBn,2), UBOUND(OutData%BlCenBn,2) - DO i1 = LBOUND(OutData%BlCenBn,1), UBOUND(OutData%BlCenBn,1) - OutData%BlCenBn(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlCenBt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlCenBt)) DEALLOCATE(OutData%BlCenBt) - ALLOCATE(OutData%BlCenBt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCenBt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BlCenBt,2), UBOUND(OutData%BlCenBt,2) - DO i1 = LBOUND(OutData%BlCenBt,1), UBOUND(OutData%BlCenBt,1) - OutData%BlCenBt(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%VolHub = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HubCenBx = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VolNac = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%NacCenB,1) - i1_u = UBOUND(OutData%NacCenB,1) - DO i1 = LBOUND(OutData%NacCenB,1), UBOUND(OutData%NacCenB,1) - OutData%NacCenB(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%VolBl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VolTwr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlRad not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlRad)) DEALLOCATE(OutData%BlRad) - ALLOCATE(OutData%BlRad(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlRad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BlRad,2), UBOUND(OutData%BlRad,2) - DO i1 = LBOUND(OutData%BlRad,1), UBOUND(OutData%BlRad,1) - OutData%BlRad(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlDL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlDL)) DEALLOCATE(OutData%BlDL) - ALLOCATE(OutData%BlDL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlDL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BlDL,2), UBOUND(OutData%BlDL,2) - DO i1 = LBOUND(OutData%BlDL,1), UBOUND(OutData%BlDL,1) - OutData%BlDL(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlTaper not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlTaper)) DEALLOCATE(OutData%BlTaper) - ALLOCATE(OutData%BlTaper(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlTaper.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BlTaper,2), UBOUND(OutData%BlTaper,2) - DO i1 = LBOUND(OutData%BlTaper,1), UBOUND(OutData%BlTaper,1) - OutData%BlTaper(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlAxCent not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlAxCent)) DEALLOCATE(OutData%BlAxCent) - ALLOCATE(OutData%BlAxCent(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlAxCent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BlAxCent,2), UBOUND(OutData%BlAxCent,2) - DO i1 = LBOUND(OutData%BlAxCent,1), UBOUND(OutData%BlAxCent,1) - OutData%BlAxCent(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrRad not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TwrRad)) DEALLOCATE(OutData%TwrRad) - ALLOCATE(OutData%TwrRad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrRad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrRad,1), UBOUND(OutData%TwrRad,1) - OutData%TwrRad(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrDL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TwrDL)) DEALLOCATE(OutData%TwrDL) - ALLOCATE(OutData%TwrDL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrDL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrDL,1), UBOUND(OutData%TwrDL,1) - OutData%TwrDL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrTaper not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TwrTaper)) DEALLOCATE(OutData%TwrTaper) - ALLOCATE(OutData%TwrTaper(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrTaper.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrTaper,1), UBOUND(OutData%TwrTaper,1) - OutData%TwrTaper(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrAxCent not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TwrAxCent)) DEALLOCATE(OutData%TwrAxCent) - ALLOCATE(OutData%TwrAxCent(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrAxCent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrAxCent,1), UBOUND(OutData%TwrAxCent,1) - OutData%TwrAxCent(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL BEMT_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%BEMT, ErrStat2, ErrMsg2 ) ! BEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AA_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%AA, ErrStat2, ErrMsg2 ) ! AA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_u_indx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Jac_u_indx)) DEALLOCATE(OutData%Jac_u_indx) - ALLOCATE(OutData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_u_indx,2), UBOUND(OutData%Jac_u_indx,2) - DO i1 = LBOUND(OutData%Jac_u_indx,1), UBOUND(OutData%Jac_u_indx,1) - OutData%Jac_u_indx(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! du not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%du)) DEALLOCATE(OutData%du) - ALLOCATE(OutData%du(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%du,1), UBOUND(OutData%du,1) - OutData%du(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%dx)) DEALLOCATE(OutData%dx) - ALLOCATE(OutData%dx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dx,1), UBOUND(OutData%dx,1) - OutData%dx(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Jac_ny = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumBl_Lin = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TwrPotent = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TwrShadow = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TwrAero = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwrAero) - Int_Xferred = Int_Xferred + 1 - OutData%FrozenWake = TRANSFER(IntKiBuf(Int_Xferred), OutData%FrozenWake) - Int_Xferred = Int_Xferred + 1 - OutData%CavitCheck = TRANSFER(IntKiBuf(Int_Xferred), OutData%CavitCheck) - Int_Xferred = Int_Xferred + 1 - OutData%Buoyancy = TRANSFER(IntKiBuf(Int_Xferred), OutData%Buoyancy) - Int_Xferred = Int_Xferred + 1 - OutData%MHK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CompAA = TRANSFER(IntKiBuf(Int_Xferred), OutData%CompAA) - Int_Xferred = Int_Xferred + 1 - OutData%AirDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%KinVisc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SpdSound = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Patm = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Pvap = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MSL2SWL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AeroProjMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%AeroBEM_Mod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutParam)) DEALLOCATE(OutData%OutParam) - ALLOCATE(OutData%OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutParam,1), UBOUND(OutData%OutParam,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackOutParmType( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - OutData%NBlOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%BlOutNd,1) - i1_u = UBOUND(OutData%BlOutNd,1) - DO i1 = LBOUND(OutData%BlOutNd,1), UBOUND(OutData%BlOutNd,1) - OutData%BlOutNd(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%NTwOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%TwOutNd,1) - i1_u = UBOUND(OutData%TwOutNd,1) - DO i1 = LBOUND(OutData%TwOutNd,1), UBOUND(OutData%TwOutNd,1) - OutData%TwOutNd(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%BldNd_NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%BldNd_TotNumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_OutParam not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BldNd_OutParam)) DEALLOCATE(OutData%BldNd_OutParam) - ALLOCATE(OutData%BldNd_OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BldNd_OutParam,1), UBOUND(OutData%BldNd_OutParam,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackOutParmType( Re_Buf, Db_Buf, Int_Buf, OutData%BldNd_OutParam(i1), ErrStat2, ErrMsg2 ) ! BldNd_OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_BlOutNd not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BldNd_BlOutNd)) DEALLOCATE(OutData%BldNd_BlOutNd) - ALLOCATE(OutData%BldNd_BlOutNd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_BlOutNd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BldNd_BlOutNd,1), UBOUND(OutData%BldNd_BlOutNd,1) - OutData%BldNd_BlOutNd(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%BldNd_BladesOut = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TFinAero = TRANSFER(IntKiBuf(Int_Xferred), OutData%TFinAero) - Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackTFinParameterType( Re_Buf, Db_Buf, Int_Buf, OutData%TFin, ErrStat2, ErrMsg2 ) ! TFin - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN +ENDIF +IF (ALLOCATED(RotParameterTypeData%BldNd_OutParam)) THEN +DO i1 = LBOUND(RotParameterTypeData%BldNd_OutParam,1), UBOUND(RotParameterTypeData%BldNd_OutParam,1) + CALL NWTC_Library_DestroyOutParmType( RotParameterTypeData%BldNd_OutParam(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(RotParameterTypeData%BldNd_OutParam) +ENDIF +IF (ALLOCATED(RotParameterTypeData%BldNd_BlOutNd)) THEN + DEALLOCATE(RotParameterTypeData%BldNd_BlOutNd) +ENDIF + CALL AD_DestroyTFinParameterType( RotParameterTypeData%TFin, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END SUBROUTINE AD_DestroyRotParameterType - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE AD_UnPackRotParameterType +subroutine AD_PackRotParameterType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(RotParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackRotParameterType' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + ! NumBlades + call RegPack(Buf, InData%NumBlades) + if (RegCheckErr(Buf, RoutineName)) return + ! NumBlNds + call RegPack(Buf, InData%NumBlNds) + if (RegCheckErr(Buf, RoutineName)) return + ! NumTwrNds + call RegPack(Buf, InData%NumTwrNds) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrDiam + call RegPack(Buf, allocated(InData%TwrDiam)) + if (allocated(InData%TwrDiam)) then + call RegPackBounds(Buf, 1, lbound(InData%TwrDiam), ubound(InData%TwrDiam)) + call RegPack(Buf, InData%TwrDiam) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TwrCd + call RegPack(Buf, allocated(InData%TwrCd)) + if (allocated(InData%TwrCd)) then + call RegPackBounds(Buf, 1, lbound(InData%TwrCd), ubound(InData%TwrCd)) + call RegPack(Buf, InData%TwrCd) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TwrTI + call RegPack(Buf, allocated(InData%TwrTI)) + if (allocated(InData%TwrTI)) then + call RegPackBounds(Buf, 1, lbound(InData%TwrTI), ubound(InData%TwrTI)) + call RegPack(Buf, InData%TwrTI) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BlTwist + call RegPack(Buf, allocated(InData%BlTwist)) + if (allocated(InData%BlTwist)) then + call RegPackBounds(Buf, 2, lbound(InData%BlTwist), ubound(InData%BlTwist)) + call RegPack(Buf, InData%BlTwist) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TwrCb + call RegPack(Buf, allocated(InData%TwrCb)) + if (allocated(InData%TwrCb)) then + call RegPackBounds(Buf, 1, lbound(InData%TwrCb), ubound(InData%TwrCb)) + call RegPack(Buf, InData%TwrCb) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BlCenBn + call RegPack(Buf, allocated(InData%BlCenBn)) + if (allocated(InData%BlCenBn)) then + call RegPackBounds(Buf, 2, lbound(InData%BlCenBn), ubound(InData%BlCenBn)) + call RegPack(Buf, InData%BlCenBn) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BlCenBt + call RegPack(Buf, allocated(InData%BlCenBt)) + if (allocated(InData%BlCenBt)) then + call RegPackBounds(Buf, 2, lbound(InData%BlCenBt), ubound(InData%BlCenBt)) + call RegPack(Buf, InData%BlCenBt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! VolHub + call RegPack(Buf, InData%VolHub) + if (RegCheckErr(Buf, RoutineName)) return + ! HubCenBx + call RegPack(Buf, InData%HubCenBx) + if (RegCheckErr(Buf, RoutineName)) return + ! VolNac + call RegPack(Buf, InData%VolNac) + if (RegCheckErr(Buf, RoutineName)) return + ! NacCenB + call RegPack(Buf, InData%NacCenB) + if (RegCheckErr(Buf, RoutineName)) return + ! VolBl + call RegPack(Buf, InData%VolBl) + if (RegCheckErr(Buf, RoutineName)) return + ! VolTwr + call RegPack(Buf, InData%VolTwr) + if (RegCheckErr(Buf, RoutineName)) return + ! BlRad + call RegPack(Buf, allocated(InData%BlRad)) + if (allocated(InData%BlRad)) then + call RegPackBounds(Buf, 2, lbound(InData%BlRad), ubound(InData%BlRad)) + call RegPack(Buf, InData%BlRad) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BlDL + call RegPack(Buf, allocated(InData%BlDL)) + if (allocated(InData%BlDL)) then + call RegPackBounds(Buf, 2, lbound(InData%BlDL), ubound(InData%BlDL)) + call RegPack(Buf, InData%BlDL) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BlTaper + call RegPack(Buf, allocated(InData%BlTaper)) + if (allocated(InData%BlTaper)) then + call RegPackBounds(Buf, 2, lbound(InData%BlTaper), ubound(InData%BlTaper)) + call RegPack(Buf, InData%BlTaper) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BlAxCent + call RegPack(Buf, allocated(InData%BlAxCent)) + if (allocated(InData%BlAxCent)) then + call RegPackBounds(Buf, 2, lbound(InData%BlAxCent), ubound(InData%BlAxCent)) + call RegPack(Buf, InData%BlAxCent) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TwrRad + call RegPack(Buf, allocated(InData%TwrRad)) + if (allocated(InData%TwrRad)) then + call RegPackBounds(Buf, 1, lbound(InData%TwrRad), ubound(InData%TwrRad)) + call RegPack(Buf, InData%TwrRad) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TwrDL + call RegPack(Buf, allocated(InData%TwrDL)) + if (allocated(InData%TwrDL)) then + call RegPackBounds(Buf, 1, lbound(InData%TwrDL), ubound(InData%TwrDL)) + call RegPack(Buf, InData%TwrDL) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TwrTaper + call RegPack(Buf, allocated(InData%TwrTaper)) + if (allocated(InData%TwrTaper)) then + call RegPackBounds(Buf, 1, lbound(InData%TwrTaper), ubound(InData%TwrTaper)) + call RegPack(Buf, InData%TwrTaper) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TwrAxCent + call RegPack(Buf, allocated(InData%TwrAxCent)) + if (allocated(InData%TwrAxCent)) then + call RegPackBounds(Buf, 1, lbound(InData%TwrAxCent), ubound(InData%TwrAxCent)) + call RegPack(Buf, InData%TwrAxCent) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BEMT + call BEMT_PackParam(Buf, InData%BEMT) + if (RegCheckErr(Buf, RoutineName)) return + ! AA + call AA_PackParam(Buf, InData%AA) + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_u_indx + call RegPack(Buf, allocated(InData%Jac_u_indx)) + if (allocated(InData%Jac_u_indx)) then + call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx), ubound(InData%Jac_u_indx)) + call RegPack(Buf, InData%Jac_u_indx) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! du + call RegPack(Buf, allocated(InData%du)) + if (allocated(InData%du)) then + call RegPackBounds(Buf, 1, lbound(InData%du), ubound(InData%du)) + call RegPack(Buf, InData%du) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! dx + call RegPack(Buf, allocated(InData%dx)) + if (allocated(InData%dx)) then + call RegPackBounds(Buf, 1, lbound(InData%dx), ubound(InData%dx)) + call RegPack(Buf, InData%dx) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_ny + call RegPack(Buf, InData%Jac_ny) + if (RegCheckErr(Buf, RoutineName)) return + ! NumBl_Lin + call RegPack(Buf, InData%NumBl_Lin) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrPotent + call RegPack(Buf, InData%TwrPotent) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrShadow + call RegPack(Buf, InData%TwrShadow) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrAero + call RegPack(Buf, InData%TwrAero) + if (RegCheckErr(Buf, RoutineName)) return + ! FrozenWake + call RegPack(Buf, InData%FrozenWake) + if (RegCheckErr(Buf, RoutineName)) return + ! CavitCheck + call RegPack(Buf, InData%CavitCheck) + if (RegCheckErr(Buf, RoutineName)) return + ! Buoyancy + call RegPack(Buf, InData%Buoyancy) + if (RegCheckErr(Buf, RoutineName)) return + ! MHK + call RegPack(Buf, InData%MHK) + if (RegCheckErr(Buf, RoutineName)) return + ! CompAA + call RegPack(Buf, InData%CompAA) + if (RegCheckErr(Buf, RoutineName)) return + ! AirDens + call RegPack(Buf, InData%AirDens) + if (RegCheckErr(Buf, RoutineName)) return + ! KinVisc + call RegPack(Buf, InData%KinVisc) + if (RegCheckErr(Buf, RoutineName)) return + ! SpdSound + call RegPack(Buf, InData%SpdSound) + if (RegCheckErr(Buf, RoutineName)) return + ! Gravity + call RegPack(Buf, InData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + ! Patm + call RegPack(Buf, InData%Patm) + if (RegCheckErr(Buf, RoutineName)) return + ! Pvap + call RegPack(Buf, InData%Pvap) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDpth + call RegPack(Buf, InData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! MSL2SWL + call RegPack(Buf, InData%MSL2SWL) + if (RegCheckErr(Buf, RoutineName)) return + ! AeroProjMod + call RegPack(Buf, InData%AeroProjMod) + if (RegCheckErr(Buf, RoutineName)) return + ! AeroBEM_Mod + call RegPack(Buf, InData%AeroBEM_Mod) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegPack(Buf, InData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegPack(Buf, InData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! OutParam + call RegPack(Buf, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NBlOuts + call RegPack(Buf, InData%NBlOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! BlOutNd + call RegPack(Buf, InData%BlOutNd) + if (RegCheckErr(Buf, RoutineName)) return + ! NTwOuts + call RegPack(Buf, InData%NTwOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! TwOutNd + call RegPack(Buf, InData%TwOutNd) + if (RegCheckErr(Buf, RoutineName)) return + ! BldNd_NumOuts + call RegPack(Buf, InData%BldNd_NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! BldNd_TotNumOuts + call RegPack(Buf, InData%BldNd_TotNumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! BldNd_OutParam + call RegPack(Buf, allocated(InData%BldNd_OutParam)) + if (allocated(InData%BldNd_OutParam)) then + call RegPackBounds(Buf, 1, lbound(InData%BldNd_OutParam), ubound(InData%BldNd_OutParam)) + LB(1:1) = lbound(InData%BldNd_OutParam) + UB(1:1) = ubound(InData%BldNd_OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(Buf, InData%BldNd_OutParam(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BldNd_BlOutNd + call RegPack(Buf, allocated(InData%BldNd_BlOutNd)) + if (allocated(InData%BldNd_BlOutNd)) then + call RegPackBounds(Buf, 1, lbound(InData%BldNd_BlOutNd), ubound(InData%BldNd_BlOutNd)) + call RegPack(Buf, InData%BldNd_BlOutNd) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BldNd_BladesOut + call RegPack(Buf, InData%BldNd_BladesOut) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinAero + call RegPack(Buf, InData%TFinAero) + if (RegCheckErr(Buf, RoutineName)) return + ! TFin + call AD_PackTFinParameterType(Buf, InData%TFin) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackRotParameterType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(RotParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackRotParameterType' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! NumBlades + call RegUnpack(Buf, OutData%NumBlades) + if (RegCheckErr(Buf, RoutineName)) return + ! NumBlNds + call RegUnpack(Buf, OutData%NumBlNds) + if (RegCheckErr(Buf, RoutineName)) return + ! NumTwrNds + call RegUnpack(Buf, OutData%NumTwrNds) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrDiam + if (allocated(OutData%TwrDiam)) deallocate(OutData%TwrDiam) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrDiam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrDiam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrDiam) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TwrCd + if (allocated(OutData%TwrCd)) deallocate(OutData%TwrCd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrCd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrCd) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TwrTI + if (allocated(OutData%TwrTI)) deallocate(OutData%TwrTI) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrTI(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrTI.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrTI) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BlTwist + if (allocated(OutData%BlTwist)) deallocate(OutData%BlTwist) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlTwist(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlTwist.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlTwist) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TwrCb + if (allocated(OutData%TwrCb)) deallocate(OutData%TwrCb) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrCb(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrCb) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BlCenBn + if (allocated(OutData%BlCenBn)) deallocate(OutData%BlCenBn) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlCenBn(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCenBn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlCenBn) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BlCenBt + if (allocated(OutData%BlCenBt)) deallocate(OutData%BlCenBt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlCenBt(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCenBt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlCenBt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! VolHub + call RegUnpack(Buf, OutData%VolHub) + if (RegCheckErr(Buf, RoutineName)) return + ! HubCenBx + call RegUnpack(Buf, OutData%HubCenBx) + if (RegCheckErr(Buf, RoutineName)) return + ! VolNac + call RegUnpack(Buf, OutData%VolNac) + if (RegCheckErr(Buf, RoutineName)) return + ! NacCenB + call RegUnpack(Buf, OutData%NacCenB) + if (RegCheckErr(Buf, RoutineName)) return + ! VolBl + call RegUnpack(Buf, OutData%VolBl) + if (RegCheckErr(Buf, RoutineName)) return + ! VolTwr + call RegUnpack(Buf, OutData%VolTwr) + if (RegCheckErr(Buf, RoutineName)) return + ! BlRad + if (allocated(OutData%BlRad)) deallocate(OutData%BlRad) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlRad(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlRad.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlRad) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BlDL + if (allocated(OutData%BlDL)) deallocate(OutData%BlDL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlDL(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlDL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlDL) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BlTaper + if (allocated(OutData%BlTaper)) deallocate(OutData%BlTaper) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlTaper(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlTaper.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlTaper) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BlAxCent + if (allocated(OutData%BlAxCent)) deallocate(OutData%BlAxCent) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlAxCent(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlAxCent.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlAxCent) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TwrRad + if (allocated(OutData%TwrRad)) deallocate(OutData%TwrRad) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrRad(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrRad.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrRad) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TwrDL + if (allocated(OutData%TwrDL)) deallocate(OutData%TwrDL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrDL(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrDL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrDL) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TwrTaper + if (allocated(OutData%TwrTaper)) deallocate(OutData%TwrTaper) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrTaper(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrTaper.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrTaper) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TwrAxCent + if (allocated(OutData%TwrAxCent)) deallocate(OutData%TwrAxCent) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrAxCent(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrAxCent.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrAxCent) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BEMT + call BEMT_UnpackParam(Buf, OutData%BEMT) ! BEMT + ! AA + call AA_UnpackParam(Buf, OutData%AA) ! AA + ! Jac_u_indx + if (allocated(OutData%Jac_u_indx)) deallocate(OutData%Jac_u_indx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jac_u_indx) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! du + if (allocated(OutData%du)) deallocate(OutData%du) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%du(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%du) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! dx + if (allocated(OutData%dx)) deallocate(OutData%dx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dx(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dx) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Jac_ny + call RegUnpack(Buf, OutData%Jac_ny) + if (RegCheckErr(Buf, RoutineName)) return + ! NumBl_Lin + call RegUnpack(Buf, OutData%NumBl_Lin) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrPotent + call RegUnpack(Buf, OutData%TwrPotent) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrShadow + call RegUnpack(Buf, OutData%TwrShadow) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrAero + call RegUnpack(Buf, OutData%TwrAero) + if (RegCheckErr(Buf, RoutineName)) return + ! FrozenWake + call RegUnpack(Buf, OutData%FrozenWake) + if (RegCheckErr(Buf, RoutineName)) return + ! CavitCheck + call RegUnpack(Buf, OutData%CavitCheck) + if (RegCheckErr(Buf, RoutineName)) return + ! Buoyancy + call RegUnpack(Buf, OutData%Buoyancy) + if (RegCheckErr(Buf, RoutineName)) return + ! MHK + call RegUnpack(Buf, OutData%MHK) + if (RegCheckErr(Buf, RoutineName)) return + ! CompAA + call RegUnpack(Buf, OutData%CompAA) + if (RegCheckErr(Buf, RoutineName)) return + ! AirDens + call RegUnpack(Buf, OutData%AirDens) + if (RegCheckErr(Buf, RoutineName)) return + ! KinVisc + call RegUnpack(Buf, OutData%KinVisc) + if (RegCheckErr(Buf, RoutineName)) return + ! SpdSound + call RegUnpack(Buf, OutData%SpdSound) + if (RegCheckErr(Buf, RoutineName)) return + ! Gravity + call RegUnpack(Buf, OutData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + ! Patm + call RegUnpack(Buf, OutData%Patm) + if (RegCheckErr(Buf, RoutineName)) return + ! Pvap + call RegUnpack(Buf, OutData%Pvap) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDpth + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! MSL2SWL + call RegUnpack(Buf, OutData%MSL2SWL) + if (RegCheckErr(Buf, RoutineName)) return + ! AeroProjMod + call RegUnpack(Buf, OutData%AeroProjMod) + if (RegCheckErr(Buf, RoutineName)) return + ! AeroBEM_Mod + call RegUnpack(Buf, OutData%AeroBEM_Mod) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! OutParam + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam + end do + end if + ! NBlOuts + call RegUnpack(Buf, OutData%NBlOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! BlOutNd + call RegUnpack(Buf, OutData%BlOutNd) + if (RegCheckErr(Buf, RoutineName)) return + ! NTwOuts + call RegUnpack(Buf, OutData%NTwOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! TwOutNd + call RegUnpack(Buf, OutData%TwOutNd) + if (RegCheckErr(Buf, RoutineName)) return + ! BldNd_NumOuts + call RegUnpack(Buf, OutData%BldNd_NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! BldNd_TotNumOuts + call RegUnpack(Buf, OutData%BldNd_TotNumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! BldNd_OutParam + if (allocated(OutData%BldNd_OutParam)) deallocate(OutData%BldNd_OutParam) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BldNd_OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(Buf, OutData%BldNd_OutParam(i1)) ! BldNd_OutParam + end do + end if + ! BldNd_BlOutNd + if (allocated(OutData%BldNd_BlOutNd)) deallocate(OutData%BldNd_BlOutNd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BldNd_BlOutNd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_BlOutNd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BldNd_BlOutNd) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BldNd_BladesOut + call RegUnpack(Buf, OutData%BldNd_BladesOut) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinAero + call RegUnpack(Buf, OutData%TFinAero) + if (RegCheckErr(Buf, RoutineName)) return + ! TFin + call AD_UnpackTFinParameterType(Buf, OutData%TFin) ! TFin +end subroutine SUBROUTINE AD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(AD_ParameterType), INTENT(IN) :: SrcParamData TYPE(AD_ParameterType), INTENT(INOUT) :: DstParamData @@ -15339,460 +7383,154 @@ SUBROUTINE AD_DestroyParam( ParamData, ErrStat, ErrMsg ) NULLIFY(ParamData%FlowField) END SUBROUTINE AD_DestroyParam - SUBROUTINE AD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AD_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! rotors allocated yes/no - IF ( ALLOCATED(InData%rotors) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotors upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - Int_BufSz = Int_BufSz + 3 ! rotors: size of buffers for each call to pack subtype - CALL AD_PackRotParameterType( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! rotors - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! rotors - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! rotors - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Db_BufSz = Db_BufSz + 1 ! DT - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1 ! AFI allocated yes/no - IF ( ALLOCATED(InData%AFI) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AFI upper/lower bounds for each dimension - DO i1 = LBOUND(InData%AFI,1), UBOUND(InData%AFI,1) - Int_BufSz = Int_BufSz + 3 ! AFI: size of buffers for each call to pack subtype - CALL AFI_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%AFI(i1), ErrStat2, ErrMsg2, .TRUE. ) ! AFI - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AFI - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AFI - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AFI - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SkewMod - Int_BufSz = Int_BufSz + 1 ! WakeMod - Int_BufSz = Int_BufSz + 3 ! FVW: size of buffers for each call to pack subtype - CALL FVW_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, .TRUE. ) ! FVW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FVW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FVW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FVW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! CompAeroMaps - Int_BufSz = Int_BufSz + 1 ! UA_Flag - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%rotors) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rotors,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotors,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - CALL AD_PackRotParameterType( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%AFI) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFI,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFI,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AFI,1), UBOUND(InData%AFI,1) - CALL AFI_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%AFI(i1), ErrStat2, ErrMsg2, OnlySize ) ! AFI - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IntKiBuf(Int_Xferred) = InData%SkewMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WakeMod - Int_Xferred = Int_Xferred + 1 - CALL FVW_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%FVW, ErrStat2, ErrMsg2, OnlySize ) ! FVW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = TRANSFER(InData%CompAeroMaps, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UA_Flag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD_PackParam - - SUBROUTINE AD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AD_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rotors not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rotors)) DEALLOCATE(OutData%rotors) - ALLOCATE(OutData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotors,1), UBOUND(OutData%rotors,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackRotParameterType( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - OutData%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFI not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AFI)) DEALLOCATE(OutData%AFI) - ALLOCATE(OutData%AFI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AFI,1), UBOUND(OutData%AFI,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AFI_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%AFI(i1), ErrStat2, ErrMsg2 ) ! AFI - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - OutData%SkewMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WakeMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FVW_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%FVW, ErrStat2, ErrMsg2 ) ! FVW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%CompAeroMaps = TRANSFER(IntKiBuf(Int_Xferred), OutData%CompAeroMaps) - Int_Xferred = Int_Xferred + 1 - OutData%UA_Flag = TRANSFER(IntKiBuf(Int_Xferred), OutData%UA_Flag) - Int_Xferred = Int_Xferred + 1 - NULLIFY(OutData%FlowField) - END SUBROUTINE AD_UnPackParam +subroutine AD_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackParam' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + ! rotors + call RegPack(Buf, allocated(InData%rotors)) + if (allocated(InData%rotors)) then + call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) + do i1 = LB(1), UB(1) + call AD_PackRotParameterType(Buf, InData%rotors(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DT + call RegPack(Buf, InData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegPack(Buf, InData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! AFI + call RegPack(Buf, allocated(InData%AFI)) + if (allocated(InData%AFI)) then + call RegPackBounds(Buf, 1, lbound(InData%AFI), ubound(InData%AFI)) + LB(1:1) = lbound(InData%AFI) + UB(1:1) = ubound(InData%AFI) + do i1 = LB(1), UB(1) + call AFI_PackParam(Buf, InData%AFI(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SkewMod + call RegPack(Buf, InData%SkewMod) + if (RegCheckErr(Buf, RoutineName)) return + ! WakeMod + call RegPack(Buf, InData%WakeMod) + if (RegCheckErr(Buf, RoutineName)) return + ! FVW + call FVW_PackParam(Buf, InData%FVW) + if (RegCheckErr(Buf, RoutineName)) return + ! CompAeroMaps + call RegPack(Buf, InData%CompAeroMaps) + if (RegCheckErr(Buf, RoutineName)) return + ! UA_Flag + call RegPack(Buf, InData%UA_Flag) + if (RegCheckErr(Buf, RoutineName)) return + ! FlowField + call RegPack(Buf, associated(InData%FlowField)) + if (associated(InData%FlowField)) then + call RegPackPointer(Buf, c_loc(InData%FlowField), PtrInIndex) + if (.not. PtrInIndex) then + call IfW_FlowField_PackFlowFieldType(Buf, InData%FlowField) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackParam' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + ! rotors + if (allocated(OutData%rotors)) deallocate(OutData%rotors) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rotors(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackRotParameterType(Buf, OutData%rotors(i1)) ! rotors + end do + end if + ! DT + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! AFI + if (allocated(OutData%AFI)) deallocate(OutData%AFI) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AFI(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFI.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AFI_UnpackParam(Buf, OutData%AFI(i1)) ! AFI + end do + end if + ! SkewMod + call RegUnpack(Buf, OutData%SkewMod) + if (RegCheckErr(Buf, RoutineName)) return + ! WakeMod + call RegUnpack(Buf, OutData%WakeMod) + if (RegCheckErr(Buf, RoutineName)) return + ! FVW + call FVW_UnpackParam(Buf, OutData%FVW) ! FVW + ! CompAeroMaps + call RegUnpack(Buf, OutData%CompAeroMaps) + if (RegCheckErr(Buf, RoutineName)) return + ! UA_Flag + call RegUnpack(Buf, OutData%UA_Flag) + if (RegCheckErr(Buf, RoutineName)) return + ! FlowField + if (associated(OutData%FlowField)) deallocate(OutData%FlowField) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%FlowField) + else + allocate(OutData%FlowField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlowField.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%FlowField) + call IfW_FlowField_UnpackFlowFieldType(Buf, OutData%FlowField) ! FlowField + end if + else + OutData%FlowField => null() + end if +end subroutine SUBROUTINE AD_CopyRotInputType( SrcRotInputTypeData, DstRotInputTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(RotInputType), INTENT(INOUT) :: SrcRotInputTypeData TYPE(RotInputType), INTENT(INOUT) :: DstRotInputTypeData @@ -15949,869 +7687,184 @@ SUBROUTINE AD_DestroyRotInputType( RotInputTypeData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE AD_DestroyRotInputType - SUBROUTINE AD_PackRotInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(RotInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_PackRotInputType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! NacelleMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%NacelleMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! NacelleMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NacelleMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NacelleMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NacelleMotion - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! TowerMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%TowerMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TowerMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TowerMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TowerMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TowerMotion - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! HubMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%HubMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! HubMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! HubMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! HubMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! HubMotion - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! BladeRootMotion allocated yes/no - IF ( ALLOCATED(InData%BladeRootMotion) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladeRootMotion upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BladeRootMotion,1), UBOUND(InData%BladeRootMotion,1) - Int_BufSz = Int_BufSz + 3 ! BladeRootMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%BladeRootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BladeRootMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeRootMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeRootMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeRootMotion - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! BladeMotion allocated yes/no - IF ( ALLOCATED(InData%BladeMotion) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladeMotion upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BladeMotion,1), UBOUND(InData%BladeMotion,1) - Int_BufSz = Int_BufSz + 3 ! BladeMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%BladeMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BladeMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeMotion - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! TFinMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%TFinMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TFinMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TFinMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TFinMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TFinMotion - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! InflowOnBlade allocated yes/no - IF ( ALLOCATED(InData%InflowOnBlade) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! InflowOnBlade upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%InflowOnBlade) ! InflowOnBlade - END IF - Int_BufSz = Int_BufSz + 1 ! InflowOnTower allocated yes/no - IF ( ALLOCATED(InData%InflowOnTower) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! InflowOnTower upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%InflowOnTower) ! InflowOnTower - END IF - Re_BufSz = Re_BufSz + SIZE(InData%InflowOnHub) ! InflowOnHub - Re_BufSz = Re_BufSz + SIZE(InData%InflowOnNacelle) ! InflowOnNacelle - Re_BufSz = Re_BufSz + SIZE(InData%InflowOnTailFin) ! InflowOnTailFin - Int_BufSz = Int_BufSz + 1 ! UserProp allocated yes/no - IF ( ALLOCATED(InData%UserProp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! UserProp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%UserProp) ! UserProp - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL MeshPack( InData%NacelleMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! NacelleMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MeshPack( InData%TowerMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TowerMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MeshPack( InData%HubMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! HubMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%BladeRootMotion) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootMotion,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootMotion,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BladeRootMotion,1), UBOUND(InData%BladeRootMotion,1) - CALL MeshPack( InData%BladeRootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BladeRootMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BladeMotion) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeMotion,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeMotion,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BladeMotion,1), UBOUND(InData%BladeMotion,1) - CALL MeshPack( InData%BladeMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BladeMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL MeshPack( InData%TFinMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TFinMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%InflowOnBlade) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InflowOnBlade,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InflowOnBlade,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InflowOnBlade,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InflowOnBlade,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InflowOnBlade,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InflowOnBlade,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%InflowOnBlade,3), UBOUND(InData%InflowOnBlade,3) - DO i2 = LBOUND(InData%InflowOnBlade,2), UBOUND(InData%InflowOnBlade,2) - DO i1 = LBOUND(InData%InflowOnBlade,1), UBOUND(InData%InflowOnBlade,1) - ReKiBuf(Re_Xferred) = InData%InflowOnBlade(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InflowOnTower) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InflowOnTower,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InflowOnTower,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InflowOnTower,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InflowOnTower,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%InflowOnTower,2), UBOUND(InData%InflowOnTower,2) - DO i1 = LBOUND(InData%InflowOnTower,1), UBOUND(InData%InflowOnTower,1) - ReKiBuf(Re_Xferred) = InData%InflowOnTower(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%InflowOnHub,1), UBOUND(InData%InflowOnHub,1) - ReKiBuf(Re_Xferred) = InData%InflowOnHub(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%InflowOnNacelle,1), UBOUND(InData%InflowOnNacelle,1) - ReKiBuf(Re_Xferred) = InData%InflowOnNacelle(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%InflowOnTailFin,1), UBOUND(InData%InflowOnTailFin,1) - ReKiBuf(Re_Xferred) = InData%InflowOnTailFin(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%UserProp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UserProp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UserProp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UserProp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UserProp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%UserProp,2), UBOUND(InData%UserProp,2) - DO i1 = LBOUND(InData%UserProp,1), UBOUND(InData%UserProp,1) - ReKiBuf(Re_Xferred) = InData%UserProp(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE AD_PackRotInputType - - SUBROUTINE AD_UnPackRotInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(RotInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackRotInputType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%NacelleMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! NacelleMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%TowerMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TowerMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%HubMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! HubMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeRootMotion not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BladeRootMotion)) DEALLOCATE(OutData%BladeRootMotion) - ALLOCATE(OutData%BladeRootMotion(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootMotion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladeRootMotion,1), UBOUND(OutData%BladeRootMotion,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%BladeRootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BladeRootMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeMotion not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BladeMotion)) DEALLOCATE(OutData%BladeMotion) - ALLOCATE(OutData%BladeMotion(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeMotion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladeMotion,1), UBOUND(OutData%BladeMotion,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%BladeMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BladeMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%TFinMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TFinMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InflowOnBlade not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InflowOnBlade)) DEALLOCATE(OutData%InflowOnBlade) - ALLOCATE(OutData%InflowOnBlade(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InflowOnBlade.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%InflowOnBlade,3), UBOUND(OutData%InflowOnBlade,3) - DO i2 = LBOUND(OutData%InflowOnBlade,2), UBOUND(OutData%InflowOnBlade,2) - DO i1 = LBOUND(OutData%InflowOnBlade,1), UBOUND(OutData%InflowOnBlade,1) - OutData%InflowOnBlade(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InflowOnTower not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InflowOnTower)) DEALLOCATE(OutData%InflowOnTower) - ALLOCATE(OutData%InflowOnTower(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InflowOnTower.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%InflowOnTower,2), UBOUND(OutData%InflowOnTower,2) - DO i1 = LBOUND(OutData%InflowOnTower,1), UBOUND(OutData%InflowOnTower,1) - OutData%InflowOnTower(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%InflowOnHub,1) - i1_u = UBOUND(OutData%InflowOnHub,1) - DO i1 = LBOUND(OutData%InflowOnHub,1), UBOUND(OutData%InflowOnHub,1) - OutData%InflowOnHub(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%InflowOnNacelle,1) - i1_u = UBOUND(OutData%InflowOnNacelle,1) - DO i1 = LBOUND(OutData%InflowOnNacelle,1), UBOUND(OutData%InflowOnNacelle,1) - OutData%InflowOnNacelle(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%InflowOnTailFin,1) - i1_u = UBOUND(OutData%InflowOnTailFin,1) - DO i1 = LBOUND(OutData%InflowOnTailFin,1), UBOUND(OutData%InflowOnTailFin,1) - OutData%InflowOnTailFin(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UserProp not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%UserProp)) DEALLOCATE(OutData%UserProp) - ALLOCATE(OutData%UserProp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UserProp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%UserProp,2), UBOUND(OutData%UserProp,2) - DO i1 = LBOUND(OutData%UserProp,1), UBOUND(OutData%UserProp,1) - OutData%UserProp(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE AD_UnPackRotInputType +subroutine AD_PackRotInputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(RotInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackRotInputType' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + if (Buf%ErrStat >= AbortErrLev) return + ! NacelleMotion + call MeshPack(Buf, InData%NacelleMotion) + if (RegCheckErr(Buf, RoutineName)) return + ! TowerMotion + call MeshPack(Buf, InData%TowerMotion) + if (RegCheckErr(Buf, RoutineName)) return + ! HubMotion + call MeshPack(Buf, InData%HubMotion) + if (RegCheckErr(Buf, RoutineName)) return + ! BladeRootMotion + call RegPack(Buf, allocated(InData%BladeRootMotion)) + if (allocated(InData%BladeRootMotion)) then + call RegPackBounds(Buf, 1, lbound(InData%BladeRootMotion), ubound(InData%BladeRootMotion)) + LB(1:1) = lbound(InData%BladeRootMotion) + UB(1:1) = ubound(InData%BladeRootMotion) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%BladeRootMotion(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BladeMotion + call RegPack(Buf, allocated(InData%BladeMotion)) + if (allocated(InData%BladeMotion)) then + call RegPackBounds(Buf, 1, lbound(InData%BladeMotion), ubound(InData%BladeMotion)) + LB(1:1) = lbound(InData%BladeMotion) + UB(1:1) = ubound(InData%BladeMotion) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%BladeMotion(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TFinMotion + call MeshPack(Buf, InData%TFinMotion) + if (RegCheckErr(Buf, RoutineName)) return + ! InflowOnBlade + call RegPack(Buf, allocated(InData%InflowOnBlade)) + if (allocated(InData%InflowOnBlade)) then + call RegPackBounds(Buf, 3, lbound(InData%InflowOnBlade), ubound(InData%InflowOnBlade)) + call RegPack(Buf, InData%InflowOnBlade) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! InflowOnTower + call RegPack(Buf, allocated(InData%InflowOnTower)) + if (allocated(InData%InflowOnTower)) then + call RegPackBounds(Buf, 2, lbound(InData%InflowOnTower), ubound(InData%InflowOnTower)) + call RegPack(Buf, InData%InflowOnTower) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! InflowOnHub + call RegPack(Buf, InData%InflowOnHub) + if (RegCheckErr(Buf, RoutineName)) return + ! InflowOnNacelle + call RegPack(Buf, InData%InflowOnNacelle) + if (RegCheckErr(Buf, RoutineName)) return + ! InflowOnTailFin + call RegPack(Buf, InData%InflowOnTailFin) + if (RegCheckErr(Buf, RoutineName)) return + ! UserProp + call RegPack(Buf, allocated(InData%UserProp)) + if (allocated(InData%UserProp)) then + call RegPackBounds(Buf, 2, lbound(InData%UserProp), ubound(InData%UserProp)) + call RegPack(Buf, InData%UserProp) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackRotInputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(RotInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackRotInputType' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! NacelleMotion + call MeshUnpack(Buf, OutData%NacelleMotion) ! NacelleMotion + ! TowerMotion + call MeshUnpack(Buf, OutData%TowerMotion) ! TowerMotion + ! HubMotion + call MeshUnpack(Buf, OutData%HubMotion) ! HubMotion + ! BladeRootMotion + if (allocated(OutData%BladeRootMotion)) deallocate(OutData%BladeRootMotion) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BladeRootMotion(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootMotion.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%BladeRootMotion(i1)) ! BladeRootMotion + end do + end if + ! BladeMotion + if (allocated(OutData%BladeMotion)) deallocate(OutData%BladeMotion) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BladeMotion(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeMotion.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%BladeMotion(i1)) ! BladeMotion + end do + end if + ! TFinMotion + call MeshUnpack(Buf, OutData%TFinMotion) ! TFinMotion + ! InflowOnBlade + if (allocated(OutData%InflowOnBlade)) deallocate(OutData%InflowOnBlade) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InflowOnBlade(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InflowOnBlade.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InflowOnBlade) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! InflowOnTower + if (allocated(OutData%InflowOnTower)) deallocate(OutData%InflowOnTower) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InflowOnTower(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InflowOnTower.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InflowOnTower) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! InflowOnHub + call RegUnpack(Buf, OutData%InflowOnHub) + if (RegCheckErr(Buf, RoutineName)) return + ! InflowOnNacelle + call RegUnpack(Buf, OutData%InflowOnNacelle) + if (RegCheckErr(Buf, RoutineName)) return + ! InflowOnTailFin + call RegUnpack(Buf, OutData%InflowOnTailFin) + if (RegCheckErr(Buf, RoutineName)) return + ! UserProp + if (allocated(OutData%UserProp)) deallocate(OutData%UserProp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%UserProp(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UserProp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%UserProp) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE AD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(AD_InputType), INTENT(INOUT) :: SrcInputData TYPE(AD_InputType), INTENT(INOUT) :: DstInputData @@ -16885,269 +7938,75 @@ SUBROUTINE AD_DestroyInput( InputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE AD_DestroyInput - SUBROUTINE AD_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AD_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! rotors allocated yes/no - IF ( ALLOCATED(InData%rotors) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotors upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - Int_BufSz = Int_BufSz + 3 ! rotors: size of buffers for each call to pack subtype - CALL AD_PackRotInputType( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! rotors - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! rotors - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! rotors - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InflowWakeVel allocated yes/no - IF ( ALLOCATED(InData%InflowWakeVel) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! InflowWakeVel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%InflowWakeVel) ! InflowWakeVel - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%rotors) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rotors,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotors,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - CALL AD_PackRotInputType( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InflowWakeVel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InflowWakeVel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InflowWakeVel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InflowWakeVel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InflowWakeVel,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%InflowWakeVel,2), UBOUND(InData%InflowWakeVel,2) - DO i1 = LBOUND(InData%InflowWakeVel,1), UBOUND(InData%InflowWakeVel,1) - ReKiBuf(Re_Xferred) = InData%InflowWakeVel(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE AD_PackInput - - SUBROUTINE AD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AD_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rotors not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rotors)) DEALLOCATE(OutData%rotors) - ALLOCATE(OutData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotors,1), UBOUND(OutData%rotors,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackRotInputType( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InflowWakeVel not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InflowWakeVel)) DEALLOCATE(OutData%InflowWakeVel) - ALLOCATE(OutData%InflowWakeVel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InflowWakeVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%InflowWakeVel,2), UBOUND(OutData%InflowWakeVel,2) - DO i1 = LBOUND(OutData%InflowWakeVel,1), UBOUND(OutData%InflowWakeVel,1) - OutData%InflowWakeVel(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE AD_UnPackInput +subroutine AD_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackInput' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + ! rotors + call RegPack(Buf, allocated(InData%rotors)) + if (allocated(InData%rotors)) then + call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) + do i1 = LB(1), UB(1) + call AD_PackRotInputType(Buf, InData%rotors(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! InflowWakeVel + call RegPack(Buf, allocated(InData%InflowWakeVel)) + if (allocated(InData%InflowWakeVel)) then + call RegPackBounds(Buf, 2, lbound(InData%InflowWakeVel), ubound(InData%InflowWakeVel)) + call RegPack(Buf, InData%InflowWakeVel) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackInput' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! rotors + if (allocated(OutData%rotors)) deallocate(OutData%rotors) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rotors(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackRotInputType(Buf, OutData%rotors(i1)) ! rotors + end do + end if + ! InflowWakeVel + if (allocated(OutData%InflowWakeVel)) deallocate(OutData%InflowWakeVel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InflowWakeVel(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InflowWakeVel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InflowWakeVel) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE AD_CopyRotOutputType( SrcRotOutputTypeData, DstRotOutputTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(RotOutputType), INTENT(INOUT) :: SrcRotOutputTypeData TYPE(RotOutputType), INTENT(INOUT) :: DstRotOutputTypeData @@ -17238,598 +8097,95 @@ SUBROUTINE AD_DestroyRotOutputType( RotOutputTypeData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE AD_DestroyRotOutputType - SUBROUTINE AD_PackRotOutputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(RotOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_PackRotOutputType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! NacelleLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%NacelleLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! NacelleLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NacelleLoad - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NacelleLoad - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NacelleLoad - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! HubLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%HubLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! HubLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! HubLoad - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! HubLoad - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! HubLoad - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! TowerLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%TowerLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TowerLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TowerLoad - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TowerLoad - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TowerLoad - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! BladeLoad allocated yes/no - IF ( ALLOCATED(InData%BladeLoad) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladeLoad upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BladeLoad,1), UBOUND(InData%BladeLoad,1) - Int_BufSz = Int_BufSz + 3 ! BladeLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%BladeLoad(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BladeLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeLoad - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeLoad - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeLoad - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! TFinLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%TFinLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TFinLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TFinLoad - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TFinLoad - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TFinLoad - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutput allocated yes/no - IF ( ALLOCATED(InData%WriteOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutput upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WriteOutput) ! WriteOutput - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL MeshPack( InData%NacelleLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! NacelleLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MeshPack( InData%HubLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! HubLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MeshPack( InData%TowerLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TowerLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%BladeLoad) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeLoad,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeLoad,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BladeLoad,1), UBOUND(InData%BladeLoad,1) - CALL MeshPack( InData%BladeLoad(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BladeLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL MeshPack( InData%TFinLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TFinLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) - ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AD_PackRotOutputType - - SUBROUTINE AD_UnPackRotOutputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(RotOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackRotOutputType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%NacelleLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! NacelleLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%HubLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! HubLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%TowerLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TowerLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeLoad not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BladeLoad)) DEALLOCATE(OutData%BladeLoad) - ALLOCATE(OutData%BladeLoad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeLoad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladeLoad,1), UBOUND(OutData%BladeLoad,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%BladeLoad(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BladeLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%TFinLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TFinLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutput)) DEALLOCATE(OutData%WriteOutput) - ALLOCATE(OutData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) - OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AD_UnPackRotOutputType +subroutine AD_PackRotOutputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(RotOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackRotOutputType' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! NacelleLoad + call MeshPack(Buf, InData%NacelleLoad) + if (RegCheckErr(Buf, RoutineName)) return + ! HubLoad + call MeshPack(Buf, InData%HubLoad) + if (RegCheckErr(Buf, RoutineName)) return + ! TowerLoad + call MeshPack(Buf, InData%TowerLoad) + if (RegCheckErr(Buf, RoutineName)) return + ! BladeLoad + call RegPack(Buf, allocated(InData%BladeLoad)) + if (allocated(InData%BladeLoad)) then + call RegPackBounds(Buf, 1, lbound(InData%BladeLoad), ubound(InData%BladeLoad)) + LB(1:1) = lbound(InData%BladeLoad) + UB(1:1) = ubound(InData%BladeLoad) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%BladeLoad(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TFinLoad + call MeshPack(Buf, InData%TFinLoad) + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutput + call RegPack(Buf, allocated(InData%WriteOutput)) + if (allocated(InData%WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPack(Buf, InData%WriteOutput) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackRotOutputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(RotOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackRotOutputType' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! NacelleLoad + call MeshUnpack(Buf, OutData%NacelleLoad) ! NacelleLoad + ! HubLoad + call MeshUnpack(Buf, OutData%HubLoad) ! HubLoad + ! TowerLoad + call MeshUnpack(Buf, OutData%TowerLoad) ! TowerLoad + ! BladeLoad + if (allocated(OutData%BladeLoad)) deallocate(OutData%BladeLoad) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BladeLoad(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeLoad.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%BladeLoad(i1)) ! BladeLoad + end do + end if + ! TFinLoad + call MeshUnpack(Buf, OutData%TFinLoad) ! TFinLoad + ! WriteOutput + if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE AD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(AD_OutputType), INTENT(INOUT) :: SrcOutputData TYPE(AD_OutputType), INTENT(INOUT) :: DstOutputData @@ -17885,220 +8241,53 @@ SUBROUTINE AD_DestroyOutput( OutputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE AD_DestroyOutput - SUBROUTINE AD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AD_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! rotors allocated yes/no - IF ( ALLOCATED(InData%rotors) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotors upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - Int_BufSz = Int_BufSz + 3 ! rotors: size of buffers for each call to pack subtype - CALL AD_PackRotOutputType( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! rotors - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! rotors - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! rotors - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%rotors) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rotors,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotors,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - CALL AD_PackRotOutputType( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - END SUBROUTINE AD_PackOutput - - SUBROUTINE AD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AD_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rotors not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rotors)) DEALLOCATE(OutData%rotors) - ALLOCATE(OutData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotors,1), UBOUND(OutData%rotors,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackRotOutputType( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - END SUBROUTINE AD_UnPackOutput +subroutine AD_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackOutput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! rotors + call RegPack(Buf, allocated(InData%rotors)) + if (allocated(InData%rotors)) then + call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) + do i1 = LB(1), UB(1) + call AD_PackRotOutputType(Buf, InData%rotors(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackOutput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! rotors + if (allocated(OutData%rotors)) deallocate(OutData%rotors) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rotors(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackRotOutputType(Buf, OutData%rotors(i1)) ! rotors + end do + end if +end subroutine SUBROUTINE AD_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) ! diff --git a/modules/aerodyn/src/AirfoilInfo_Types.f90 b/modules/aerodyn/src/AirfoilInfo_Types.f90 index ba566396c9..3f7ff3df35 100644 --- a/modules/aerodyn/src/AirfoilInfo_Types.f90 +++ b/modules/aerodyn/src/AirfoilInfo_Types.f90 @@ -277,333 +277,302 @@ SUBROUTINE AFI_DestroyUA_BL_Type( UA_BL_TypeData, ErrStat, ErrMsg ) END SUBROUTINE AFI_DestroyUA_BL_Type - SUBROUTINE AFI_PackUA_BL_Type( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AFI_UA_BL_Type), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_PackUA_BL_Type' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! alpha0 - Re_BufSz = Re_BufSz + 1 ! alpha1 - Re_BufSz = Re_BufSz + 1 ! alpha2 - Re_BufSz = Re_BufSz + 1 ! eta_e - Re_BufSz = Re_BufSz + 1 ! C_nalpha - Re_BufSz = Re_BufSz + 1 ! C_lalpha - Re_BufSz = Re_BufSz + 1 ! T_f0 - Re_BufSz = Re_BufSz + 1 ! T_V0 - Re_BufSz = Re_BufSz + 1 ! T_p - Re_BufSz = Re_BufSz + 1 ! T_VL - Re_BufSz = Re_BufSz + 1 ! b1 - Re_BufSz = Re_BufSz + 1 ! b2 - Re_BufSz = Re_BufSz + 1 ! b5 - Re_BufSz = Re_BufSz + 1 ! A1 - Re_BufSz = Re_BufSz + 1 ! A2 - Re_BufSz = Re_BufSz + 1 ! A5 - Re_BufSz = Re_BufSz + 1 ! S1 - Re_BufSz = Re_BufSz + 1 ! S2 - Re_BufSz = Re_BufSz + 1 ! S3 - Re_BufSz = Re_BufSz + 1 ! S4 - Re_BufSz = Re_BufSz + 1 ! Cn1 - Re_BufSz = Re_BufSz + 1 ! Cn2 - Re_BufSz = Re_BufSz + 1 ! St_sh - Re_BufSz = Re_BufSz + 1 ! Cd0 - Re_BufSz = Re_BufSz + 1 ! Cm0 - Re_BufSz = Re_BufSz + 1 ! k0 - Re_BufSz = Re_BufSz + 1 ! k1 - Re_BufSz = Re_BufSz + 1 ! k2 - Re_BufSz = Re_BufSz + 1 ! k3 - Re_BufSz = Re_BufSz + 1 ! k1_hat - Re_BufSz = Re_BufSz + 1 ! x_cp_bar - Re_BufSz = Re_BufSz + 1 ! UACutout - Re_BufSz = Re_BufSz + 1 ! UACutout_delta - Re_BufSz = Re_BufSz + 1 ! UACutout_blend - Re_BufSz = Re_BufSz + 1 ! filtCutOff - Re_BufSz = Re_BufSz + 1 ! alphaUpper - Re_BufSz = Re_BufSz + 1 ! alphaLower - Re_BufSz = Re_BufSz + 1 ! c_Rate - Re_BufSz = Re_BufSz + 1 ! c_RateUpper - Re_BufSz = Re_BufSz + 1 ! c_RateLower - Re_BufSz = Re_BufSz + 1 ! c_alphaLower - Re_BufSz = Re_BufSz + 1 ! c_alphaUpper - Re_BufSz = Re_BufSz + 1 ! alphaUpperWrap - Re_BufSz = Re_BufSz + 1 ! alphaLowerWrap - Re_BufSz = Re_BufSz + 1 ! c_RateWrap - Re_BufSz = Re_BufSz + 1 ! c_alphaLowerWrap - Re_BufSz = Re_BufSz + 1 ! c_alphaUpperWrap - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%alpha0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%alpha1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%alpha2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%eta_e - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_nalpha - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_lalpha - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%T_f0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%T_V0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%T_p - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%T_VL - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%b1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%b2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%b5 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%A1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%A2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%A5 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%S1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%S2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%S3 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%S4 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cn1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cn2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%St_sh - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cd0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cm0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k3 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k1_hat - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%x_cp_bar - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%UACutout - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%UACutout_delta - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%UACutout_blend - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%filtCutOff - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%alphaUpper - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%alphaLower - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%c_Rate - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%c_RateUpper - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%c_RateLower - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%c_alphaLower - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%c_alphaUpper - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%alphaUpperWrap - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%alphaLowerWrap - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%c_RateWrap - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%c_alphaLowerWrap - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%c_alphaUpperWrap - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AFI_PackUA_BL_Type - - SUBROUTINE AFI_UnPackUA_BL_Type( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AFI_UA_BL_Type), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_UnPackUA_BL_Type' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%alpha0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%alpha1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%alpha2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%eta_e = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_nalpha = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_lalpha = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%T_f0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%T_V0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%T_p = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%T_VL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%b1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%b2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%b5 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%A1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%A2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%A5 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%S1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%S2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%S3 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%S4 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cn1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cn2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%St_sh = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cd0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cm0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k3 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k1_hat = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%x_cp_bar = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%UACutout = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%UACutout_delta = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%UACutout_blend = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%filtCutOff = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%alphaUpper = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%alphaLower = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%c_Rate = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%c_RateUpper = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%c_RateLower = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%c_alphaLower = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%c_alphaUpper = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%alphaUpperWrap = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%alphaLowerWrap = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%c_RateWrap = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%c_alphaLowerWrap = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%c_alphaUpperWrap = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AFI_UnPackUA_BL_Type +subroutine AFI_PackUA_BL_Type(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AFI_UA_BL_Type), intent(in) :: InData + character(*), parameter :: RoutineName = 'AFI_PackUA_BL_Type' + if (Buf%ErrStat >= AbortErrLev) return + ! alpha0 + call RegPack(Buf, InData%alpha0) + if (RegCheckErr(Buf, RoutineName)) return + ! alpha1 + call RegPack(Buf, InData%alpha1) + if (RegCheckErr(Buf, RoutineName)) return + ! alpha2 + call RegPack(Buf, InData%alpha2) + if (RegCheckErr(Buf, RoutineName)) return + ! eta_e + call RegPack(Buf, InData%eta_e) + if (RegCheckErr(Buf, RoutineName)) return + ! C_nalpha + call RegPack(Buf, InData%C_nalpha) + if (RegCheckErr(Buf, RoutineName)) return + ! C_lalpha + call RegPack(Buf, InData%C_lalpha) + if (RegCheckErr(Buf, RoutineName)) return + ! T_f0 + call RegPack(Buf, InData%T_f0) + if (RegCheckErr(Buf, RoutineName)) return + ! T_V0 + call RegPack(Buf, InData%T_V0) + if (RegCheckErr(Buf, RoutineName)) return + ! T_p + call RegPack(Buf, InData%T_p) + if (RegCheckErr(Buf, RoutineName)) return + ! T_VL + call RegPack(Buf, InData%T_VL) + if (RegCheckErr(Buf, RoutineName)) return + ! b1 + call RegPack(Buf, InData%b1) + if (RegCheckErr(Buf, RoutineName)) return + ! b2 + call RegPack(Buf, InData%b2) + if (RegCheckErr(Buf, RoutineName)) return + ! b5 + call RegPack(Buf, InData%b5) + if (RegCheckErr(Buf, RoutineName)) return + ! A1 + call RegPack(Buf, InData%A1) + if (RegCheckErr(Buf, RoutineName)) return + ! A2 + call RegPack(Buf, InData%A2) + if (RegCheckErr(Buf, RoutineName)) return + ! A5 + call RegPack(Buf, InData%A5) + if (RegCheckErr(Buf, RoutineName)) return + ! S1 + call RegPack(Buf, InData%S1) + if (RegCheckErr(Buf, RoutineName)) return + ! S2 + call RegPack(Buf, InData%S2) + if (RegCheckErr(Buf, RoutineName)) return + ! S3 + call RegPack(Buf, InData%S3) + if (RegCheckErr(Buf, RoutineName)) return + ! S4 + call RegPack(Buf, InData%S4) + if (RegCheckErr(Buf, RoutineName)) return + ! Cn1 + call RegPack(Buf, InData%Cn1) + if (RegCheckErr(Buf, RoutineName)) return + ! Cn2 + call RegPack(Buf, InData%Cn2) + if (RegCheckErr(Buf, RoutineName)) return + ! St_sh + call RegPack(Buf, InData%St_sh) + if (RegCheckErr(Buf, RoutineName)) return + ! Cd0 + call RegPack(Buf, InData%Cd0) + if (RegCheckErr(Buf, RoutineName)) return + ! Cm0 + call RegPack(Buf, InData%Cm0) + if (RegCheckErr(Buf, RoutineName)) return + ! k0 + call RegPack(Buf, InData%k0) + if (RegCheckErr(Buf, RoutineName)) return + ! k1 + call RegPack(Buf, InData%k1) + if (RegCheckErr(Buf, RoutineName)) return + ! k2 + call RegPack(Buf, InData%k2) + if (RegCheckErr(Buf, RoutineName)) return + ! k3 + call RegPack(Buf, InData%k3) + if (RegCheckErr(Buf, RoutineName)) return + ! k1_hat + call RegPack(Buf, InData%k1_hat) + if (RegCheckErr(Buf, RoutineName)) return + ! x_cp_bar + call RegPack(Buf, InData%x_cp_bar) + if (RegCheckErr(Buf, RoutineName)) return + ! UACutout + call RegPack(Buf, InData%UACutout) + if (RegCheckErr(Buf, RoutineName)) return + ! UACutout_delta + call RegPack(Buf, InData%UACutout_delta) + if (RegCheckErr(Buf, RoutineName)) return + ! UACutout_blend + call RegPack(Buf, InData%UACutout_blend) + if (RegCheckErr(Buf, RoutineName)) return + ! filtCutOff + call RegPack(Buf, InData%filtCutOff) + if (RegCheckErr(Buf, RoutineName)) return + ! alphaUpper + call RegPack(Buf, InData%alphaUpper) + if (RegCheckErr(Buf, RoutineName)) return + ! alphaLower + call RegPack(Buf, InData%alphaLower) + if (RegCheckErr(Buf, RoutineName)) return + ! c_Rate + call RegPack(Buf, InData%c_Rate) + if (RegCheckErr(Buf, RoutineName)) return + ! c_RateUpper + call RegPack(Buf, InData%c_RateUpper) + if (RegCheckErr(Buf, RoutineName)) return + ! c_RateLower + call RegPack(Buf, InData%c_RateLower) + if (RegCheckErr(Buf, RoutineName)) return + ! c_alphaLower + call RegPack(Buf, InData%c_alphaLower) + if (RegCheckErr(Buf, RoutineName)) return + ! c_alphaUpper + call RegPack(Buf, InData%c_alphaUpper) + if (RegCheckErr(Buf, RoutineName)) return + ! alphaUpperWrap + call RegPack(Buf, InData%alphaUpperWrap) + if (RegCheckErr(Buf, RoutineName)) return + ! alphaLowerWrap + call RegPack(Buf, InData%alphaLowerWrap) + if (RegCheckErr(Buf, RoutineName)) return + ! c_RateWrap + call RegPack(Buf, InData%c_RateWrap) + if (RegCheckErr(Buf, RoutineName)) return + ! c_alphaLowerWrap + call RegPack(Buf, InData%c_alphaLowerWrap) + if (RegCheckErr(Buf, RoutineName)) return + ! c_alphaUpperWrap + call RegPack(Buf, InData%c_alphaUpperWrap) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AFI_UnPackUA_BL_Type(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AFI_UA_BL_Type), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AFI_UnPackUA_BL_Type' + if (Buf%ErrStat /= ErrID_None) return + ! alpha0 + call RegUnpack(Buf, OutData%alpha0) + if (RegCheckErr(Buf, RoutineName)) return + ! alpha1 + call RegUnpack(Buf, OutData%alpha1) + if (RegCheckErr(Buf, RoutineName)) return + ! alpha2 + call RegUnpack(Buf, OutData%alpha2) + if (RegCheckErr(Buf, RoutineName)) return + ! eta_e + call RegUnpack(Buf, OutData%eta_e) + if (RegCheckErr(Buf, RoutineName)) return + ! C_nalpha + call RegUnpack(Buf, OutData%C_nalpha) + if (RegCheckErr(Buf, RoutineName)) return + ! C_lalpha + call RegUnpack(Buf, OutData%C_lalpha) + if (RegCheckErr(Buf, RoutineName)) return + ! T_f0 + call RegUnpack(Buf, OutData%T_f0) + if (RegCheckErr(Buf, RoutineName)) return + ! T_V0 + call RegUnpack(Buf, OutData%T_V0) + if (RegCheckErr(Buf, RoutineName)) return + ! T_p + call RegUnpack(Buf, OutData%T_p) + if (RegCheckErr(Buf, RoutineName)) return + ! T_VL + call RegUnpack(Buf, OutData%T_VL) + if (RegCheckErr(Buf, RoutineName)) return + ! b1 + call RegUnpack(Buf, OutData%b1) + if (RegCheckErr(Buf, RoutineName)) return + ! b2 + call RegUnpack(Buf, OutData%b2) + if (RegCheckErr(Buf, RoutineName)) return + ! b5 + call RegUnpack(Buf, OutData%b5) + if (RegCheckErr(Buf, RoutineName)) return + ! A1 + call RegUnpack(Buf, OutData%A1) + if (RegCheckErr(Buf, RoutineName)) return + ! A2 + call RegUnpack(Buf, OutData%A2) + if (RegCheckErr(Buf, RoutineName)) return + ! A5 + call RegUnpack(Buf, OutData%A5) + if (RegCheckErr(Buf, RoutineName)) return + ! S1 + call RegUnpack(Buf, OutData%S1) + if (RegCheckErr(Buf, RoutineName)) return + ! S2 + call RegUnpack(Buf, OutData%S2) + if (RegCheckErr(Buf, RoutineName)) return + ! S3 + call RegUnpack(Buf, OutData%S3) + if (RegCheckErr(Buf, RoutineName)) return + ! S4 + call RegUnpack(Buf, OutData%S4) + if (RegCheckErr(Buf, RoutineName)) return + ! Cn1 + call RegUnpack(Buf, OutData%Cn1) + if (RegCheckErr(Buf, RoutineName)) return + ! Cn2 + call RegUnpack(Buf, OutData%Cn2) + if (RegCheckErr(Buf, RoutineName)) return + ! St_sh + call RegUnpack(Buf, OutData%St_sh) + if (RegCheckErr(Buf, RoutineName)) return + ! Cd0 + call RegUnpack(Buf, OutData%Cd0) + if (RegCheckErr(Buf, RoutineName)) return + ! Cm0 + call RegUnpack(Buf, OutData%Cm0) + if (RegCheckErr(Buf, RoutineName)) return + ! k0 + call RegUnpack(Buf, OutData%k0) + if (RegCheckErr(Buf, RoutineName)) return + ! k1 + call RegUnpack(Buf, OutData%k1) + if (RegCheckErr(Buf, RoutineName)) return + ! k2 + call RegUnpack(Buf, OutData%k2) + if (RegCheckErr(Buf, RoutineName)) return + ! k3 + call RegUnpack(Buf, OutData%k3) + if (RegCheckErr(Buf, RoutineName)) return + ! k1_hat + call RegUnpack(Buf, OutData%k1_hat) + if (RegCheckErr(Buf, RoutineName)) return + ! x_cp_bar + call RegUnpack(Buf, OutData%x_cp_bar) + if (RegCheckErr(Buf, RoutineName)) return + ! UACutout + call RegUnpack(Buf, OutData%UACutout) + if (RegCheckErr(Buf, RoutineName)) return + ! UACutout_delta + call RegUnpack(Buf, OutData%UACutout_delta) + if (RegCheckErr(Buf, RoutineName)) return + ! UACutout_blend + call RegUnpack(Buf, OutData%UACutout_blend) + if (RegCheckErr(Buf, RoutineName)) return + ! filtCutOff + call RegUnpack(Buf, OutData%filtCutOff) + if (RegCheckErr(Buf, RoutineName)) return + ! alphaUpper + call RegUnpack(Buf, OutData%alphaUpper) + if (RegCheckErr(Buf, RoutineName)) return + ! alphaLower + call RegUnpack(Buf, OutData%alphaLower) + if (RegCheckErr(Buf, RoutineName)) return + ! c_Rate + call RegUnpack(Buf, OutData%c_Rate) + if (RegCheckErr(Buf, RoutineName)) return + ! c_RateUpper + call RegUnpack(Buf, OutData%c_RateUpper) + if (RegCheckErr(Buf, RoutineName)) return + ! c_RateLower + call RegUnpack(Buf, OutData%c_RateLower) + if (RegCheckErr(Buf, RoutineName)) return + ! c_alphaLower + call RegUnpack(Buf, OutData%c_alphaLower) + if (RegCheckErr(Buf, RoutineName)) return + ! c_alphaUpper + call RegUnpack(Buf, OutData%c_alphaUpper) + if (RegCheckErr(Buf, RoutineName)) return + ! alphaUpperWrap + call RegUnpack(Buf, OutData%alphaUpperWrap) + if (RegCheckErr(Buf, RoutineName)) return + ! alphaLowerWrap + call RegUnpack(Buf, OutData%alphaLowerWrap) + if (RegCheckErr(Buf, RoutineName)) return + ! c_RateWrap + call RegUnpack(Buf, OutData%c_RateWrap) + if (RegCheckErr(Buf, RoutineName)) return + ! c_alphaLowerWrap + call RegUnpack(Buf, OutData%c_alphaLowerWrap) + if (RegCheckErr(Buf, RoutineName)) return + ! c_alphaUpperWrap + call RegUnpack(Buf, OutData%c_alphaUpperWrap) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE AFI_CopyUA_BL_Default_Type( SrcUA_BL_Default_TypeData, DstUA_BL_Default_TypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(AFI_UA_BL_Default_Type), INTENT(IN) :: SrcUA_BL_Default_TypeData TYPE(AFI_UA_BL_Default_Type), INTENT(INOUT) :: DstUA_BL_Default_TypeData @@ -671,278 +640,236 @@ SUBROUTINE AFI_DestroyUA_BL_Default_Type( UA_BL_Default_TypeData, ErrStat, ErrMs END SUBROUTINE AFI_DestroyUA_BL_Default_Type - SUBROUTINE AFI_PackUA_BL_Default_Type( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AFI_UA_BL_Default_Type), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_PackUA_BL_Default_Type' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! alpha0 - Int_BufSz = Int_BufSz + 1 ! alpha1 - Int_BufSz = Int_BufSz + 1 ! alpha2 - Int_BufSz = Int_BufSz + 1 ! eta_e - Int_BufSz = Int_BufSz + 1 ! C_nalpha - Int_BufSz = Int_BufSz + 1 ! C_lalpha - Int_BufSz = Int_BufSz + 1 ! T_f0 - Int_BufSz = Int_BufSz + 1 ! T_V0 - Int_BufSz = Int_BufSz + 1 ! T_p - Int_BufSz = Int_BufSz + 1 ! T_VL - Int_BufSz = Int_BufSz + 1 ! b1 - Int_BufSz = Int_BufSz + 1 ! b2 - Int_BufSz = Int_BufSz + 1 ! b5 - Int_BufSz = Int_BufSz + 1 ! A1 - Int_BufSz = Int_BufSz + 1 ! A2 - Int_BufSz = Int_BufSz + 1 ! A5 - Int_BufSz = Int_BufSz + 1 ! S1 - Int_BufSz = Int_BufSz + 1 ! S2 - Int_BufSz = Int_BufSz + 1 ! S3 - Int_BufSz = Int_BufSz + 1 ! S4 - Int_BufSz = Int_BufSz + 1 ! Cn1 - Int_BufSz = Int_BufSz + 1 ! Cn2 - Int_BufSz = Int_BufSz + 1 ! St_sh - Int_BufSz = Int_BufSz + 1 ! Cd0 - Int_BufSz = Int_BufSz + 1 ! Cm0 - Int_BufSz = Int_BufSz + 1 ! k0 - Int_BufSz = Int_BufSz + 1 ! k1 - Int_BufSz = Int_BufSz + 1 ! k2 - Int_BufSz = Int_BufSz + 1 ! k3 - Int_BufSz = Int_BufSz + 1 ! k1_hat - Int_BufSz = Int_BufSz + 1 ! x_cp_bar - Int_BufSz = Int_BufSz + 1 ! UACutout - Int_BufSz = Int_BufSz + 1 ! UACutout_delta - Int_BufSz = Int_BufSz + 1 ! filtCutOff - Int_BufSz = Int_BufSz + 1 ! alphaUpper - Int_BufSz = Int_BufSz + 1 ! alphaLower - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = TRANSFER(InData%alpha0, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%alpha1, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%alpha2, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%eta_e, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%C_nalpha, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%C_lalpha, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%T_f0, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%T_V0, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%T_p, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%T_VL, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%b1, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%b2, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%b5, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%A1, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%A2, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%A5, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%S1, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%S2, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%S3, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%S4, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Cn1, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Cn2, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%St_sh, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Cd0, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Cm0, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%k0, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%k1, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%k2, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%k3, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%k1_hat, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%x_cp_bar, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UACutout, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UACutout_delta, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%filtCutOff, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%alphaUpper, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%alphaLower, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AFI_PackUA_BL_Default_Type - - SUBROUTINE AFI_UnPackUA_BL_Default_Type( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AFI_UA_BL_Default_Type), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_UnPackUA_BL_Default_Type' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%alpha0 = TRANSFER(IntKiBuf(Int_Xferred), OutData%alpha0) - Int_Xferred = Int_Xferred + 1 - OutData%alpha1 = TRANSFER(IntKiBuf(Int_Xferred), OutData%alpha1) - Int_Xferred = Int_Xferred + 1 - OutData%alpha2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%alpha2) - Int_Xferred = Int_Xferred + 1 - OutData%eta_e = TRANSFER(IntKiBuf(Int_Xferred), OutData%eta_e) - Int_Xferred = Int_Xferred + 1 - OutData%C_nalpha = TRANSFER(IntKiBuf(Int_Xferred), OutData%C_nalpha) - Int_Xferred = Int_Xferred + 1 - OutData%C_lalpha = TRANSFER(IntKiBuf(Int_Xferred), OutData%C_lalpha) - Int_Xferred = Int_Xferred + 1 - OutData%T_f0 = TRANSFER(IntKiBuf(Int_Xferred), OutData%T_f0) - Int_Xferred = Int_Xferred + 1 - OutData%T_V0 = TRANSFER(IntKiBuf(Int_Xferred), OutData%T_V0) - Int_Xferred = Int_Xferred + 1 - OutData%T_p = TRANSFER(IntKiBuf(Int_Xferred), OutData%T_p) - Int_Xferred = Int_Xferred + 1 - OutData%T_VL = TRANSFER(IntKiBuf(Int_Xferred), OutData%T_VL) - Int_Xferred = Int_Xferred + 1 - OutData%b1 = TRANSFER(IntKiBuf(Int_Xferred), OutData%b1) - Int_Xferred = Int_Xferred + 1 - OutData%b2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%b2) - Int_Xferred = Int_Xferred + 1 - OutData%b5 = TRANSFER(IntKiBuf(Int_Xferred), OutData%b5) - Int_Xferred = Int_Xferred + 1 - OutData%A1 = TRANSFER(IntKiBuf(Int_Xferred), OutData%A1) - Int_Xferred = Int_Xferred + 1 - OutData%A2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%A2) - Int_Xferred = Int_Xferred + 1 - OutData%A5 = TRANSFER(IntKiBuf(Int_Xferred), OutData%A5) - Int_Xferred = Int_Xferred + 1 - OutData%S1 = TRANSFER(IntKiBuf(Int_Xferred), OutData%S1) - Int_Xferred = Int_Xferred + 1 - OutData%S2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%S2) - Int_Xferred = Int_Xferred + 1 - OutData%S3 = TRANSFER(IntKiBuf(Int_Xferred), OutData%S3) - Int_Xferred = Int_Xferred + 1 - OutData%S4 = TRANSFER(IntKiBuf(Int_Xferred), OutData%S4) - Int_Xferred = Int_Xferred + 1 - OutData%Cn1 = TRANSFER(IntKiBuf(Int_Xferred), OutData%Cn1) - Int_Xferred = Int_Xferred + 1 - OutData%Cn2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%Cn2) - Int_Xferred = Int_Xferred + 1 - OutData%St_sh = TRANSFER(IntKiBuf(Int_Xferred), OutData%St_sh) - Int_Xferred = Int_Xferred + 1 - OutData%Cd0 = TRANSFER(IntKiBuf(Int_Xferred), OutData%Cd0) - Int_Xferred = Int_Xferred + 1 - OutData%Cm0 = TRANSFER(IntKiBuf(Int_Xferred), OutData%Cm0) - Int_Xferred = Int_Xferred + 1 - OutData%k0 = TRANSFER(IntKiBuf(Int_Xferred), OutData%k0) - Int_Xferred = Int_Xferred + 1 - OutData%k1 = TRANSFER(IntKiBuf(Int_Xferred), OutData%k1) - Int_Xferred = Int_Xferred + 1 - OutData%k2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%k2) - Int_Xferred = Int_Xferred + 1 - OutData%k3 = TRANSFER(IntKiBuf(Int_Xferred), OutData%k3) - Int_Xferred = Int_Xferred + 1 - OutData%k1_hat = TRANSFER(IntKiBuf(Int_Xferred), OutData%k1_hat) - Int_Xferred = Int_Xferred + 1 - OutData%x_cp_bar = TRANSFER(IntKiBuf(Int_Xferred), OutData%x_cp_bar) - Int_Xferred = Int_Xferred + 1 - OutData%UACutout = TRANSFER(IntKiBuf(Int_Xferred), OutData%UACutout) - Int_Xferred = Int_Xferred + 1 - OutData%UACutout_delta = TRANSFER(IntKiBuf(Int_Xferred), OutData%UACutout_delta) - Int_Xferred = Int_Xferred + 1 - OutData%filtCutOff = TRANSFER(IntKiBuf(Int_Xferred), OutData%filtCutOff) - Int_Xferred = Int_Xferred + 1 - OutData%alphaUpper = TRANSFER(IntKiBuf(Int_Xferred), OutData%alphaUpper) - Int_Xferred = Int_Xferred + 1 - OutData%alphaLower = TRANSFER(IntKiBuf(Int_Xferred), OutData%alphaLower) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AFI_UnPackUA_BL_Default_Type +subroutine AFI_PackUA_BL_Default_Type(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AFI_UA_BL_Default_Type), intent(in) :: InData + character(*), parameter :: RoutineName = 'AFI_PackUA_BL_Default_Type' + if (Buf%ErrStat >= AbortErrLev) return + ! alpha0 + call RegPack(Buf, InData%alpha0) + if (RegCheckErr(Buf, RoutineName)) return + ! alpha1 + call RegPack(Buf, InData%alpha1) + if (RegCheckErr(Buf, RoutineName)) return + ! alpha2 + call RegPack(Buf, InData%alpha2) + if (RegCheckErr(Buf, RoutineName)) return + ! eta_e + call RegPack(Buf, InData%eta_e) + if (RegCheckErr(Buf, RoutineName)) return + ! C_nalpha + call RegPack(Buf, InData%C_nalpha) + if (RegCheckErr(Buf, RoutineName)) return + ! C_lalpha + call RegPack(Buf, InData%C_lalpha) + if (RegCheckErr(Buf, RoutineName)) return + ! T_f0 + call RegPack(Buf, InData%T_f0) + if (RegCheckErr(Buf, RoutineName)) return + ! T_V0 + call RegPack(Buf, InData%T_V0) + if (RegCheckErr(Buf, RoutineName)) return + ! T_p + call RegPack(Buf, InData%T_p) + if (RegCheckErr(Buf, RoutineName)) return + ! T_VL + call RegPack(Buf, InData%T_VL) + if (RegCheckErr(Buf, RoutineName)) return + ! b1 + call RegPack(Buf, InData%b1) + if (RegCheckErr(Buf, RoutineName)) return + ! b2 + call RegPack(Buf, InData%b2) + if (RegCheckErr(Buf, RoutineName)) return + ! b5 + call RegPack(Buf, InData%b5) + if (RegCheckErr(Buf, RoutineName)) return + ! A1 + call RegPack(Buf, InData%A1) + if (RegCheckErr(Buf, RoutineName)) return + ! A2 + call RegPack(Buf, InData%A2) + if (RegCheckErr(Buf, RoutineName)) return + ! A5 + call RegPack(Buf, InData%A5) + if (RegCheckErr(Buf, RoutineName)) return + ! S1 + call RegPack(Buf, InData%S1) + if (RegCheckErr(Buf, RoutineName)) return + ! S2 + call RegPack(Buf, InData%S2) + if (RegCheckErr(Buf, RoutineName)) return + ! S3 + call RegPack(Buf, InData%S3) + if (RegCheckErr(Buf, RoutineName)) return + ! S4 + call RegPack(Buf, InData%S4) + if (RegCheckErr(Buf, RoutineName)) return + ! Cn1 + call RegPack(Buf, InData%Cn1) + if (RegCheckErr(Buf, RoutineName)) return + ! Cn2 + call RegPack(Buf, InData%Cn2) + if (RegCheckErr(Buf, RoutineName)) return + ! St_sh + call RegPack(Buf, InData%St_sh) + if (RegCheckErr(Buf, RoutineName)) return + ! Cd0 + call RegPack(Buf, InData%Cd0) + if (RegCheckErr(Buf, RoutineName)) return + ! Cm0 + call RegPack(Buf, InData%Cm0) + if (RegCheckErr(Buf, RoutineName)) return + ! k0 + call RegPack(Buf, InData%k0) + if (RegCheckErr(Buf, RoutineName)) return + ! k1 + call RegPack(Buf, InData%k1) + if (RegCheckErr(Buf, RoutineName)) return + ! k2 + call RegPack(Buf, InData%k2) + if (RegCheckErr(Buf, RoutineName)) return + ! k3 + call RegPack(Buf, InData%k3) + if (RegCheckErr(Buf, RoutineName)) return + ! k1_hat + call RegPack(Buf, InData%k1_hat) + if (RegCheckErr(Buf, RoutineName)) return + ! x_cp_bar + call RegPack(Buf, InData%x_cp_bar) + if (RegCheckErr(Buf, RoutineName)) return + ! UACutout + call RegPack(Buf, InData%UACutout) + if (RegCheckErr(Buf, RoutineName)) return + ! UACutout_delta + call RegPack(Buf, InData%UACutout_delta) + if (RegCheckErr(Buf, RoutineName)) return + ! filtCutOff + call RegPack(Buf, InData%filtCutOff) + if (RegCheckErr(Buf, RoutineName)) return + ! alphaUpper + call RegPack(Buf, InData%alphaUpper) + if (RegCheckErr(Buf, RoutineName)) return + ! alphaLower + call RegPack(Buf, InData%alphaLower) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AFI_UnPackUA_BL_Default_Type(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AFI_UA_BL_Default_Type), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AFI_UnPackUA_BL_Default_Type' + if (Buf%ErrStat /= ErrID_None) return + ! alpha0 + call RegUnpack(Buf, OutData%alpha0) + if (RegCheckErr(Buf, RoutineName)) return + ! alpha1 + call RegUnpack(Buf, OutData%alpha1) + if (RegCheckErr(Buf, RoutineName)) return + ! alpha2 + call RegUnpack(Buf, OutData%alpha2) + if (RegCheckErr(Buf, RoutineName)) return + ! eta_e + call RegUnpack(Buf, OutData%eta_e) + if (RegCheckErr(Buf, RoutineName)) return + ! C_nalpha + call RegUnpack(Buf, OutData%C_nalpha) + if (RegCheckErr(Buf, RoutineName)) return + ! C_lalpha + call RegUnpack(Buf, OutData%C_lalpha) + if (RegCheckErr(Buf, RoutineName)) return + ! T_f0 + call RegUnpack(Buf, OutData%T_f0) + if (RegCheckErr(Buf, RoutineName)) return + ! T_V0 + call RegUnpack(Buf, OutData%T_V0) + if (RegCheckErr(Buf, RoutineName)) return + ! T_p + call RegUnpack(Buf, OutData%T_p) + if (RegCheckErr(Buf, RoutineName)) return + ! T_VL + call RegUnpack(Buf, OutData%T_VL) + if (RegCheckErr(Buf, RoutineName)) return + ! b1 + call RegUnpack(Buf, OutData%b1) + if (RegCheckErr(Buf, RoutineName)) return + ! b2 + call RegUnpack(Buf, OutData%b2) + if (RegCheckErr(Buf, RoutineName)) return + ! b5 + call RegUnpack(Buf, OutData%b5) + if (RegCheckErr(Buf, RoutineName)) return + ! A1 + call RegUnpack(Buf, OutData%A1) + if (RegCheckErr(Buf, RoutineName)) return + ! A2 + call RegUnpack(Buf, OutData%A2) + if (RegCheckErr(Buf, RoutineName)) return + ! A5 + call RegUnpack(Buf, OutData%A5) + if (RegCheckErr(Buf, RoutineName)) return + ! S1 + call RegUnpack(Buf, OutData%S1) + if (RegCheckErr(Buf, RoutineName)) return + ! S2 + call RegUnpack(Buf, OutData%S2) + if (RegCheckErr(Buf, RoutineName)) return + ! S3 + call RegUnpack(Buf, OutData%S3) + if (RegCheckErr(Buf, RoutineName)) return + ! S4 + call RegUnpack(Buf, OutData%S4) + if (RegCheckErr(Buf, RoutineName)) return + ! Cn1 + call RegUnpack(Buf, OutData%Cn1) + if (RegCheckErr(Buf, RoutineName)) return + ! Cn2 + call RegUnpack(Buf, OutData%Cn2) + if (RegCheckErr(Buf, RoutineName)) return + ! St_sh + call RegUnpack(Buf, OutData%St_sh) + if (RegCheckErr(Buf, RoutineName)) return + ! Cd0 + call RegUnpack(Buf, OutData%Cd0) + if (RegCheckErr(Buf, RoutineName)) return + ! Cm0 + call RegUnpack(Buf, OutData%Cm0) + if (RegCheckErr(Buf, RoutineName)) return + ! k0 + call RegUnpack(Buf, OutData%k0) + if (RegCheckErr(Buf, RoutineName)) return + ! k1 + call RegUnpack(Buf, OutData%k1) + if (RegCheckErr(Buf, RoutineName)) return + ! k2 + call RegUnpack(Buf, OutData%k2) + if (RegCheckErr(Buf, RoutineName)) return + ! k3 + call RegUnpack(Buf, OutData%k3) + if (RegCheckErr(Buf, RoutineName)) return + ! k1_hat + call RegUnpack(Buf, OutData%k1_hat) + if (RegCheckErr(Buf, RoutineName)) return + ! x_cp_bar + call RegUnpack(Buf, OutData%x_cp_bar) + if (RegCheckErr(Buf, RoutineName)) return + ! UACutout + call RegUnpack(Buf, OutData%UACutout) + if (RegCheckErr(Buf, RoutineName)) return + ! UACutout_delta + call RegUnpack(Buf, OutData%UACutout_delta) + if (RegCheckErr(Buf, RoutineName)) return + ! filtCutOff + call RegUnpack(Buf, OutData%filtCutOff) + if (RegCheckErr(Buf, RoutineName)) return + ! alphaUpper + call RegUnpack(Buf, OutData%alphaUpper) + if (RegCheckErr(Buf, RoutineName)) return + ! alphaLower + call RegUnpack(Buf, OutData%alphaLower) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE AFI_CopyTable_Type( SrcTable_TypeData, DstTable_TypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(AFI_Table_Type), INTENT(IN) :: SrcTable_TypeData TYPE(AFI_Table_Type), INTENT(INOUT) :: DstTable_TypeData @@ -1038,356 +965,124 @@ SUBROUTINE AFI_DestroyTable_Type( Table_TypeData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AFI_DestroyTable_Type - SUBROUTINE AFI_PackTable_Type( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AFI_Table_Type), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_PackTable_Type' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! Alpha allocated yes/no - IF ( ALLOCATED(InData%Alpha) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Alpha upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Alpha) ! Alpha - END IF - Int_BufSz = Int_BufSz + 1 ! Coefs allocated yes/no - IF ( ALLOCATED(InData%Coefs) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Coefs upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Coefs) ! Coefs - END IF - Int_BufSz = Int_BufSz + 1 ! SplineCoefs allocated yes/no - IF ( ALLOCATED(InData%SplineCoefs) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! SplineCoefs upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SplineCoefs) ! SplineCoefs - END IF - Re_BufSz = Re_BufSz + 1 ! UserProp - Re_BufSz = Re_BufSz + 1 ! Re - Int_BufSz = Int_BufSz + 1 ! NumAlf - Int_BufSz = Int_BufSz + 1 ! ConstData - Int_BufSz = Int_BufSz + 1 ! InclUAdata - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! UA_BL: size of buffers for each call to pack subtype - CALL AFI_PackUA_BL_Type( Re_Buf, Db_Buf, Int_Buf, InData%UA_BL, ErrStat2, ErrMsg2, .TRUE. ) ! UA_BL - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! UA_BL - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! UA_BL - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! UA_BL - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%Alpha) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Alpha,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Alpha,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Alpha,1), UBOUND(InData%Alpha,1) - ReKiBuf(Re_Xferred) = InData%Alpha(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Coefs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Coefs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Coefs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Coefs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Coefs,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Coefs,2), UBOUND(InData%Coefs,2) - DO i1 = LBOUND(InData%Coefs,1), UBOUND(InData%Coefs,1) - ReKiBuf(Re_Xferred) = InData%Coefs(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SplineCoefs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SplineCoefs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SplineCoefs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SplineCoefs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SplineCoefs,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SplineCoefs,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SplineCoefs,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%SplineCoefs,3), UBOUND(InData%SplineCoefs,3) - DO i2 = LBOUND(InData%SplineCoefs,2), UBOUND(InData%SplineCoefs,2) - DO i1 = LBOUND(InData%SplineCoefs,1), UBOUND(InData%SplineCoefs,1) - ReKiBuf(Re_Xferred) = InData%SplineCoefs(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%UserProp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Re - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumAlf - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%ConstData, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%InclUAdata, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - CALL AFI_PackUA_BL_Type( Re_Buf, Db_Buf, Int_Buf, InData%UA_BL, ErrStat2, ErrMsg2, OnlySize ) ! UA_BL - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE AFI_PackTable_Type - - SUBROUTINE AFI_UnPackTable_Type( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AFI_Table_Type), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_UnPackTable_Type' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Alpha not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Alpha)) DEALLOCATE(OutData%Alpha) - ALLOCATE(OutData%Alpha(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Alpha.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Alpha,1), UBOUND(OutData%Alpha,1) - OutData%Alpha(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Coefs not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Coefs)) DEALLOCATE(OutData%Coefs) - ALLOCATE(OutData%Coefs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Coefs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Coefs,2), UBOUND(OutData%Coefs,2) - DO i1 = LBOUND(OutData%Coefs,1), UBOUND(OutData%Coefs,1) - OutData%Coefs(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SplineCoefs not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SplineCoefs)) DEALLOCATE(OutData%SplineCoefs) - ALLOCATE(OutData%SplineCoefs(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SplineCoefs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%SplineCoefs,3), UBOUND(OutData%SplineCoefs,3) - DO i2 = LBOUND(OutData%SplineCoefs,2), UBOUND(OutData%SplineCoefs,2) - DO i1 = LBOUND(OutData%SplineCoefs,1), UBOUND(OutData%SplineCoefs,1) - OutData%SplineCoefs(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%UserProp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Re = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NumAlf = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ConstData = TRANSFER(IntKiBuf(Int_Xferred), OutData%ConstData) - Int_Xferred = Int_Xferred + 1 - OutData%InclUAdata = TRANSFER(IntKiBuf(Int_Xferred), OutData%InclUAdata) - Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AFI_UnpackUA_BL_Type( Re_Buf, Db_Buf, Int_Buf, OutData%UA_BL, ErrStat2, ErrMsg2 ) ! UA_BL - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE AFI_UnPackTable_Type +subroutine AFI_PackTable_Type(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AFI_Table_Type), intent(in) :: InData + character(*), parameter :: RoutineName = 'AFI_PackTable_Type' + if (Buf%ErrStat >= AbortErrLev) return + ! Alpha + call RegPack(Buf, allocated(InData%Alpha)) + if (allocated(InData%Alpha)) then + call RegPackBounds(Buf, 1, lbound(InData%Alpha), ubound(InData%Alpha)) + call RegPack(Buf, InData%Alpha) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Coefs + call RegPack(Buf, allocated(InData%Coefs)) + if (allocated(InData%Coefs)) then + call RegPackBounds(Buf, 2, lbound(InData%Coefs), ubound(InData%Coefs)) + call RegPack(Buf, InData%Coefs) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SplineCoefs + call RegPack(Buf, allocated(InData%SplineCoefs)) + if (allocated(InData%SplineCoefs)) then + call RegPackBounds(Buf, 3, lbound(InData%SplineCoefs), ubound(InData%SplineCoefs)) + call RegPack(Buf, InData%SplineCoefs) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! UserProp + call RegPack(Buf, InData%UserProp) + if (RegCheckErr(Buf, RoutineName)) return + ! Re + call RegPack(Buf, InData%Re) + if (RegCheckErr(Buf, RoutineName)) return + ! NumAlf + call RegPack(Buf, InData%NumAlf) + if (RegCheckErr(Buf, RoutineName)) return + ! ConstData + call RegPack(Buf, InData%ConstData) + if (RegCheckErr(Buf, RoutineName)) return + ! InclUAdata + call RegPack(Buf, InData%InclUAdata) + if (RegCheckErr(Buf, RoutineName)) return + ! UA_BL + call AFI_PackUA_BL_Type(Buf, InData%UA_BL) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AFI_UnPackTable_Type(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AFI_Table_Type), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AFI_UnPackTable_Type' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! Alpha + if (allocated(OutData%Alpha)) deallocate(OutData%Alpha) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Alpha(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Alpha.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Alpha) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Coefs + if (allocated(OutData%Coefs)) deallocate(OutData%Coefs) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Coefs(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Coefs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Coefs) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! SplineCoefs + if (allocated(OutData%SplineCoefs)) deallocate(OutData%SplineCoefs) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SplineCoefs(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SplineCoefs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SplineCoefs) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! UserProp + call RegUnpack(Buf, OutData%UserProp) + if (RegCheckErr(Buf, RoutineName)) return + ! Re + call RegUnpack(Buf, OutData%Re) + if (RegCheckErr(Buf, RoutineName)) return + ! NumAlf + call RegUnpack(Buf, OutData%NumAlf) + if (RegCheckErr(Buf, RoutineName)) return + ! ConstData + call RegUnpack(Buf, OutData%ConstData) + if (RegCheckErr(Buf, RoutineName)) return + ! InclUAdata + call RegUnpack(Buf, OutData%InclUAdata) + if (RegCheckErr(Buf, RoutineName)) return + ! UA_BL + call AFI_UnpackUA_BL_Type(Buf, OutData%UA_BL) ! UA_BL +end subroutine SUBROUTINE AFI_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(AFI_InitInputType), INTENT(IN) :: SrcInitInputData TYPE(AFI_InitInputType), INTENT(INOUT) :: DstInitInputData @@ -1427,142 +1122,68 @@ SUBROUTINE AFI_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) END SUBROUTINE AFI_DestroyInitInput - SUBROUTINE AFI_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AFI_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%FileName) ! FileName - Int_BufSz = Int_BufSz + 1 ! AFTabMod - Int_BufSz = Int_BufSz + 1 ! InCol_Alfa - Int_BufSz = Int_BufSz + 1 ! InCol_Cl - Int_BufSz = Int_BufSz + 1 ! InCol_Cd - Int_BufSz = Int_BufSz + 1 ! InCol_Cm - Int_BufSz = Int_BufSz + 1 ! InCol_Cpmin - Int_BufSz = Int_BufSz + 1 ! UA_f_cn - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%AFTabMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%InCol_Alfa - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%InCol_Cl - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%InCol_Cd - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%InCol_Cm - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%InCol_Cpmin - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UA_f_cn, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AFI_PackInitInput - - SUBROUTINE AFI_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AFI_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%FileName) - OutData%FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%AFTabMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%InCol_Alfa = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%InCol_Cl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%InCol_Cd = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%InCol_Cm = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%InCol_Cpmin = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UA_f_cn = TRANSFER(IntKiBuf(Int_Xferred), OutData%UA_f_cn) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AFI_UnPackInitInput +subroutine AFI_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AFI_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AFI_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + ! FileName + call RegPack(Buf, InData%FileName) + if (RegCheckErr(Buf, RoutineName)) return + ! AFTabMod + call RegPack(Buf, InData%AFTabMod) + if (RegCheckErr(Buf, RoutineName)) return + ! InCol_Alfa + call RegPack(Buf, InData%InCol_Alfa) + if (RegCheckErr(Buf, RoutineName)) return + ! InCol_Cl + call RegPack(Buf, InData%InCol_Cl) + if (RegCheckErr(Buf, RoutineName)) return + ! InCol_Cd + call RegPack(Buf, InData%InCol_Cd) + if (RegCheckErr(Buf, RoutineName)) return + ! InCol_Cm + call RegPack(Buf, InData%InCol_Cm) + if (RegCheckErr(Buf, RoutineName)) return + ! InCol_Cpmin + call RegPack(Buf, InData%InCol_Cpmin) + if (RegCheckErr(Buf, RoutineName)) return + ! UA_f_cn + call RegPack(Buf, InData%UA_f_cn) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AFI_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AFI_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AFI_UnPackInitInput' + if (Buf%ErrStat /= ErrID_None) return + ! FileName + call RegUnpack(Buf, OutData%FileName) + if (RegCheckErr(Buf, RoutineName)) return + ! AFTabMod + call RegUnpack(Buf, OutData%AFTabMod) + if (RegCheckErr(Buf, RoutineName)) return + ! InCol_Alfa + call RegUnpack(Buf, OutData%InCol_Alfa) + if (RegCheckErr(Buf, RoutineName)) return + ! InCol_Cl + call RegUnpack(Buf, OutData%InCol_Cl) + if (RegCheckErr(Buf, RoutineName)) return + ! InCol_Cd + call RegUnpack(Buf, OutData%InCol_Cd) + if (RegCheckErr(Buf, RoutineName)) return + ! InCol_Cm + call RegUnpack(Buf, OutData%InCol_Cm) + if (RegCheckErr(Buf, RoutineName)) return + ! InCol_Cpmin + call RegUnpack(Buf, OutData%InCol_Cpmin) + if (RegCheckErr(Buf, RoutineName)) return + ! UA_f_cn + call RegUnpack(Buf, OutData%UA_f_cn) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE AFI_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(AFI_InitOutputType), INTENT(IN) :: SrcInitOutputData TYPE(AFI_InitOutputType), INTENT(INOUT) :: DstInitOutputData @@ -1599,184 +1220,25 @@ SUBROUTINE AFI_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AFI_DestroyInitOutput - SUBROUTINE AFI_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AFI_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE AFI_PackInitOutput - - SUBROUTINE AFI_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AFI_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE AFI_UnPackInitOutput +subroutine AFI_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AFI_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AFI_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! Ver + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AFI_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AFI_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AFI_UnPackInitOutput' + if (Buf%ErrStat /= ErrID_None) return + ! Ver + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver +end subroutine SUBROUTINE AFI_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(AFI_ParameterType), INTENT(IN) :: SrcParamData TYPE(AFI_ParameterType), INTENT(INOUT) :: DstParamData @@ -1890,407 +1352,197 @@ SUBROUTINE AFI_DestroyParam( ParamData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE AFI_DestroyParam - SUBROUTINE AFI_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AFI_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! ColCd - Int_BufSz = Int_BufSz + 1 ! ColCl - Int_BufSz = Int_BufSz + 1 ! ColCm - Int_BufSz = Int_BufSz + 1 ! ColCpmin - Int_BufSz = Int_BufSz + 1 ! ColUAf - Int_BufSz = Int_BufSz + 1 ! AFTabMod - Int_BufSz = Int_BufSz + 1 ! secondVals allocated yes/no - IF ( ALLOCATED(InData%secondVals) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! secondVals upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%secondVals) ! secondVals - END IF - Int_BufSz = Int_BufSz + 1 ! InterpOrd - Re_BufSz = Re_BufSz + 1 ! RelThickness - Re_BufSz = Re_BufSz + 1 ! NonDimArea - Int_BufSz = Int_BufSz + 1 ! NumCoords - Int_BufSz = Int_BufSz + 1 ! X_Coord allocated yes/no - IF ( ALLOCATED(InData%X_Coord) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! X_Coord upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%X_Coord) ! X_Coord - END IF - Int_BufSz = Int_BufSz + 1 ! Y_Coord allocated yes/no - IF ( ALLOCATED(InData%Y_Coord) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Y_Coord upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Y_Coord) ! Y_Coord - END IF - Int_BufSz = Int_BufSz + 1 ! NumTabs - Int_BufSz = Int_BufSz + 1 ! Table allocated yes/no - IF ( ALLOCATED(InData%Table) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Table upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%Table,1), UBOUND(InData%Table,1) - Int_BufSz = Int_BufSz + 3 ! Table: size of buffers for each call to pack subtype - CALL AFI_PackTable_Type( Re_Buf, Db_Buf, Int_Buf, InData%Table(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Table - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Table - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Table - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Table - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%BL_file) ! BL_file - Int_BufSz = Int_BufSz + 1*LEN(InData%FileName) ! FileName - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%ColCd - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ColCl - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ColCm - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ColCpmin - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ColUAf - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%AFTabMod - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%secondVals) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%secondVals,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%secondVals,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%secondVals,1), UBOUND(InData%secondVals,1) - ReKiBuf(Re_Xferred) = InData%secondVals(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%InterpOrd - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RelThickness - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NonDimArea - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumCoords - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%X_Coord) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%X_Coord,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X_Coord,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%X_Coord,1), UBOUND(InData%X_Coord,1) - ReKiBuf(Re_Xferred) = InData%X_Coord(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Y_Coord) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Y_Coord,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y_Coord,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Y_Coord,1), UBOUND(InData%Y_Coord,1) - ReKiBuf(Re_Xferred) = InData%Y_Coord(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NumTabs - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Table) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Table,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Table,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Table,1), UBOUND(InData%Table,1) - CALL AFI_PackTable_Type( Re_Buf, Db_Buf, Int_Buf, InData%Table(i1), ErrStat2, ErrMsg2, OnlySize ) ! Table - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - DO I = 1, LEN(InData%BL_file) - IntKiBuf(Int_Xferred) = ICHAR(InData%BL_file(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE AFI_PackParam - - SUBROUTINE AFI_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AFI_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%ColCd = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ColCl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ColCm = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ColCpmin = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ColUAf = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%AFTabMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! secondVals not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%secondVals)) DEALLOCATE(OutData%secondVals) - ALLOCATE(OutData%secondVals(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%secondVals.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%secondVals,1), UBOUND(OutData%secondVals,1) - OutData%secondVals(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%InterpOrd = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%RelThickness = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NonDimArea = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NumCoords = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X_Coord not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%X_Coord)) DEALLOCATE(OutData%X_Coord) - ALLOCATE(OutData%X_Coord(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X_Coord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%X_Coord,1), UBOUND(OutData%X_Coord,1) - OutData%X_Coord(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Y_Coord not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Y_Coord)) DEALLOCATE(OutData%Y_Coord) - ALLOCATE(OutData%Y_Coord(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y_Coord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Y_Coord,1), UBOUND(OutData%Y_Coord,1) - OutData%Y_Coord(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%NumTabs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Table not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Table)) DEALLOCATE(OutData%Table) - ALLOCATE(OutData%Table(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Table.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Table,1), UBOUND(OutData%Table,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AFI_UnpackTable_Type( Re_Buf, Db_Buf, Int_Buf, OutData%Table(i1), ErrStat2, ErrMsg2 ) ! Table - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - DO I = 1, LEN(OutData%BL_file) - OutData%BL_file(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%FileName) - OutData%FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE AFI_UnPackParam +subroutine AFI_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AFI_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AFI_PackParam' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! ColCd + call RegPack(Buf, InData%ColCd) + if (RegCheckErr(Buf, RoutineName)) return + ! ColCl + call RegPack(Buf, InData%ColCl) + if (RegCheckErr(Buf, RoutineName)) return + ! ColCm + call RegPack(Buf, InData%ColCm) + if (RegCheckErr(Buf, RoutineName)) return + ! ColCpmin + call RegPack(Buf, InData%ColCpmin) + if (RegCheckErr(Buf, RoutineName)) return + ! ColUAf + call RegPack(Buf, InData%ColUAf) + if (RegCheckErr(Buf, RoutineName)) return + ! AFTabMod + call RegPack(Buf, InData%AFTabMod) + if (RegCheckErr(Buf, RoutineName)) return + ! secondVals + call RegPack(Buf, allocated(InData%secondVals)) + if (allocated(InData%secondVals)) then + call RegPackBounds(Buf, 1, lbound(InData%secondVals), ubound(InData%secondVals)) + call RegPack(Buf, InData%secondVals) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! InterpOrd + call RegPack(Buf, InData%InterpOrd) + if (RegCheckErr(Buf, RoutineName)) return + ! RelThickness + call RegPack(Buf, InData%RelThickness) + if (RegCheckErr(Buf, RoutineName)) return + ! NonDimArea + call RegPack(Buf, InData%NonDimArea) + if (RegCheckErr(Buf, RoutineName)) return + ! NumCoords + call RegPack(Buf, InData%NumCoords) + if (RegCheckErr(Buf, RoutineName)) return + ! X_Coord + call RegPack(Buf, allocated(InData%X_Coord)) + if (allocated(InData%X_Coord)) then + call RegPackBounds(Buf, 1, lbound(InData%X_Coord), ubound(InData%X_Coord)) + call RegPack(Buf, InData%X_Coord) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Y_Coord + call RegPack(Buf, allocated(InData%Y_Coord)) + if (allocated(InData%Y_Coord)) then + call RegPackBounds(Buf, 1, lbound(InData%Y_Coord), ubound(InData%Y_Coord)) + call RegPack(Buf, InData%Y_Coord) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NumTabs + call RegPack(Buf, InData%NumTabs) + if (RegCheckErr(Buf, RoutineName)) return + ! Table + call RegPack(Buf, allocated(InData%Table)) + if (allocated(InData%Table)) then + call RegPackBounds(Buf, 1, lbound(InData%Table), ubound(InData%Table)) + LB(1:1) = lbound(InData%Table) + UB(1:1) = ubound(InData%Table) + do i1 = LB(1), UB(1) + call AFI_PackTable_Type(Buf, InData%Table(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BL_file + call RegPack(Buf, InData%BL_file) + if (RegCheckErr(Buf, RoutineName)) return + ! FileName + call RegPack(Buf, InData%FileName) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AFI_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AFI_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AFI_UnPackParam' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! ColCd + call RegUnpack(Buf, OutData%ColCd) + if (RegCheckErr(Buf, RoutineName)) return + ! ColCl + call RegUnpack(Buf, OutData%ColCl) + if (RegCheckErr(Buf, RoutineName)) return + ! ColCm + call RegUnpack(Buf, OutData%ColCm) + if (RegCheckErr(Buf, RoutineName)) return + ! ColCpmin + call RegUnpack(Buf, OutData%ColCpmin) + if (RegCheckErr(Buf, RoutineName)) return + ! ColUAf + call RegUnpack(Buf, OutData%ColUAf) + if (RegCheckErr(Buf, RoutineName)) return + ! AFTabMod + call RegUnpack(Buf, OutData%AFTabMod) + if (RegCheckErr(Buf, RoutineName)) return + ! secondVals + if (allocated(OutData%secondVals)) deallocate(OutData%secondVals) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%secondVals(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%secondVals.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%secondVals) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! InterpOrd + call RegUnpack(Buf, OutData%InterpOrd) + if (RegCheckErr(Buf, RoutineName)) return + ! RelThickness + call RegUnpack(Buf, OutData%RelThickness) + if (RegCheckErr(Buf, RoutineName)) return + ! NonDimArea + call RegUnpack(Buf, OutData%NonDimArea) + if (RegCheckErr(Buf, RoutineName)) return + ! NumCoords + call RegUnpack(Buf, OutData%NumCoords) + if (RegCheckErr(Buf, RoutineName)) return + ! X_Coord + if (allocated(OutData%X_Coord)) deallocate(OutData%X_Coord) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%X_Coord(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%X_Coord.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%X_Coord) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Y_Coord + if (allocated(OutData%Y_Coord)) deallocate(OutData%Y_Coord) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Y_Coord(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y_Coord.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Y_Coord) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NumTabs + call RegUnpack(Buf, OutData%NumTabs) + if (RegCheckErr(Buf, RoutineName)) return + ! Table + if (allocated(OutData%Table)) deallocate(OutData%Table) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Table(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Table.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AFI_UnpackTable_Type(Buf, OutData%Table(i1)) ! Table + end do + end if + ! BL_file + call RegUnpack(Buf, OutData%BL_file) + if (RegCheckErr(Buf, RoutineName)) return + ! FileName + call RegUnpack(Buf, OutData%FileName) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE AFI_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(AFI_InputType), INTENT(IN) :: SrcInputData TYPE(AFI_InputType), INTENT(INOUT) :: DstInputData @@ -2325,113 +1577,38 @@ SUBROUTINE AFI_DestroyInput( InputData, ErrStat, ErrMsg ) END SUBROUTINE AFI_DestroyInput - SUBROUTINE AFI_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AFI_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! AoA - Re_BufSz = Re_BufSz + 1 ! UserProp - Re_BufSz = Re_BufSz + 1 ! Re - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%AoA - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%UserProp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Re - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AFI_PackInput - - SUBROUTINE AFI_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AFI_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%AoA = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%UserProp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Re = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AFI_UnPackInput +subroutine AFI_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AFI_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AFI_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + ! AoA + call RegPack(Buf, InData%AoA) + if (RegCheckErr(Buf, RoutineName)) return + ! UserProp + call RegPack(Buf, InData%UserProp) + if (RegCheckErr(Buf, RoutineName)) return + ! Re + call RegPack(Buf, InData%Re) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AFI_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AFI_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AFI_UnPackInput' + if (Buf%ErrStat /= ErrID_None) return + ! AoA + call RegUnpack(Buf, OutData%AoA) + if (RegCheckErr(Buf, RoutineName)) return + ! UserProp + call RegUnpack(Buf, OutData%UserProp) + if (RegCheckErr(Buf, RoutineName)) return + ! Re + call RegUnpack(Buf, OutData%Re) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE AFI_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(AFI_OutputType), INTENT(IN) :: SrcOutputData TYPE(AFI_OutputType), INTENT(INOUT) :: DstOutputData @@ -2472,143 +1649,74 @@ SUBROUTINE AFI_DestroyOutput( OutputData, ErrStat, ErrMsg ) END SUBROUTINE AFI_DestroyOutput - SUBROUTINE AFI_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AFI_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! Cl - Re_BufSz = Re_BufSz + 1 ! Cd - Re_BufSz = Re_BufSz + 1 ! Cm - Re_BufSz = Re_BufSz + 1 ! Cpmin - Re_BufSz = Re_BufSz + 1 ! Cd0 - Re_BufSz = Re_BufSz + 1 ! Cm0 - Re_BufSz = Re_BufSz + 1 ! f_st - Re_BufSz = Re_BufSz + 1 ! FullySeparate - Re_BufSz = Re_BufSz + 1 ! FullyAttached - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%Cl - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cm - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cpmin - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cd0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cm0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%f_st - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FullySeparate - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FullyAttached - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AFI_PackOutput - - SUBROUTINE AFI_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AFI_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%Cl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cm = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cpmin = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cd0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cm0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%f_st = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%FullySeparate = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%FullyAttached = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AFI_UnPackOutput +subroutine AFI_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AFI_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AFI_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! Cl + call RegPack(Buf, InData%Cl) + if (RegCheckErr(Buf, RoutineName)) return + ! Cd + call RegPack(Buf, InData%Cd) + if (RegCheckErr(Buf, RoutineName)) return + ! Cm + call RegPack(Buf, InData%Cm) + if (RegCheckErr(Buf, RoutineName)) return + ! Cpmin + call RegPack(Buf, InData%Cpmin) + if (RegCheckErr(Buf, RoutineName)) return + ! Cd0 + call RegPack(Buf, InData%Cd0) + if (RegCheckErr(Buf, RoutineName)) return + ! Cm0 + call RegPack(Buf, InData%Cm0) + if (RegCheckErr(Buf, RoutineName)) return + ! f_st + call RegPack(Buf, InData%f_st) + if (RegCheckErr(Buf, RoutineName)) return + ! FullySeparate + call RegPack(Buf, InData%FullySeparate) + if (RegCheckErr(Buf, RoutineName)) return + ! FullyAttached + call RegPack(Buf, InData%FullyAttached) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AFI_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AFI_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AFI_UnPackOutput' + if (Buf%ErrStat /= ErrID_None) return + ! Cl + call RegUnpack(Buf, OutData%Cl) + if (RegCheckErr(Buf, RoutineName)) return + ! Cd + call RegUnpack(Buf, OutData%Cd) + if (RegCheckErr(Buf, RoutineName)) return + ! Cm + call RegUnpack(Buf, OutData%Cm) + if (RegCheckErr(Buf, RoutineName)) return + ! Cpmin + call RegUnpack(Buf, OutData%Cpmin) + if (RegCheckErr(Buf, RoutineName)) return + ! Cd0 + call RegUnpack(Buf, OutData%Cd0) + if (RegCheckErr(Buf, RoutineName)) return + ! Cm0 + call RegUnpack(Buf, OutData%Cm0) + if (RegCheckErr(Buf, RoutineName)) return + ! f_st + call RegUnpack(Buf, OutData%f_st) + if (RegCheckErr(Buf, RoutineName)) return + ! FullySeparate + call RegUnpack(Buf, OutData%FullySeparate) + if (RegCheckErr(Buf, RoutineName)) return + ! FullyAttached + call RegUnpack(Buf, OutData%FullyAttached) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE AFI_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) ! diff --git a/modules/aerodyn/src/BEMT_Types.f90 b/modules/aerodyn/src/BEMT_Types.f90 index f1b4b40e07..026c9167cb 100644 --- a/modules/aerodyn/src/BEMT_Types.f90 +++ b/modules/aerodyn/src/BEMT_Types.f90 @@ -424,611 +424,371 @@ SUBROUTINE BEMT_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE BEMT_DestroyInitInput - SUBROUTINE BEMT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(BEMT_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! chord allocated yes/no - IF ( ALLOCATED(InData%chord) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! chord upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%chord) ! chord - END IF - Int_BufSz = Int_BufSz + 1 ! numBlades - Re_BufSz = Re_BufSz + 1 ! airDens - Re_BufSz = Re_BufSz + 1 ! kinVisc - Int_BufSz = Int_BufSz + 1 ! skewWakeMod - Re_BufSz = Re_BufSz + 1 ! aTol - Int_BufSz = Int_BufSz + 1 ! useTipLoss - Int_BufSz = Int_BufSz + 1 ! useHubLoss - Int_BufSz = Int_BufSz + 1 ! useInduction - Int_BufSz = Int_BufSz + 1 ! useTanInd - Int_BufSz = Int_BufSz + 1 ! useAIDrag - Int_BufSz = Int_BufSz + 1 ! useTIDrag - Int_BufSz = Int_BufSz + 1 ! MomentumCorr - Int_BufSz = Int_BufSz + 1 ! numBladeNodes - Int_BufSz = Int_BufSz + 1 ! numReIterations - Int_BufSz = Int_BufSz + 1 ! maxIndIterations - Int_BufSz = Int_BufSz + 1 ! AFindx allocated yes/no - IF ( ALLOCATED(InData%AFindx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AFindx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%AFindx) ! AFindx - END IF - Int_BufSz = Int_BufSz + 1 ! zHub allocated yes/no - IF ( ALLOCATED(InData%zHub) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! zHub upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%zHub) ! zHub - END IF - Int_BufSz = Int_BufSz + 1 ! zLocal allocated yes/no - IF ( ALLOCATED(InData%zLocal) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! zLocal upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%zLocal) ! zLocal - END IF - Int_BufSz = Int_BufSz + 1 ! zTip allocated yes/no - IF ( ALLOCATED(InData%zTip) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! zTip upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%zTip) ! zTip - END IF - Int_BufSz = Int_BufSz + 1 ! rLocal allocated yes/no - IF ( ALLOCATED(InData%rLocal) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! rLocal upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rLocal) ! rLocal - END IF - Int_BufSz = Int_BufSz + 1 ! rTipFix allocated yes/no - IF ( ALLOCATED(InData%rTipFix) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rTipFix upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rTipFix) ! rTipFix - END IF - Int_BufSz = Int_BufSz + 1 ! UAMod - Int_BufSz = Int_BufSz + 1 ! UA_Flag - Int_BufSz = Int_BufSz + 1 ! Flookup - Re_BufSz = Re_BufSz + 1 ! a_s - Int_BufSz = Int_BufSz + 1 ! DBEMT_Mod - Re_BufSz = Re_BufSz + 1 ! tau1_const - Re_BufSz = Re_BufSz + 1 ! yawCorrFactor - Int_BufSz = Int_BufSz + 1 ! UAOff_innerNode allocated yes/no - IF ( ALLOCATED(InData%UAOff_innerNode) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UAOff_innerNode upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%UAOff_innerNode) ! UAOff_innerNode - END IF - Int_BufSz = Int_BufSz + 1 ! UAOff_outerNode allocated yes/no - IF ( ALLOCATED(InData%UAOff_outerNode) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UAOff_outerNode upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%UAOff_outerNode) ! UAOff_outerNode - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1 ! SumPrint - Int_BufSz = Int_BufSz + 1 ! BEM_Mod - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%chord) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%chord,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chord,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%chord,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chord,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%chord,2), UBOUND(InData%chord,2) - DO i1 = LBOUND(InData%chord,1), UBOUND(InData%chord,1) - ReKiBuf(Re_Xferred) = InData%chord(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%numBlades - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%airDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%kinVisc - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%skewWakeMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%aTol - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%useTipLoss, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%useHubLoss, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%useInduction, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%useTanInd, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%useAIDrag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%useTIDrag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%MomentumCorr, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%numBladeNodes - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%numReIterations - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%maxIndIterations - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%AFindx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFindx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFindx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFindx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFindx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AFindx,2), UBOUND(InData%AFindx,2) - DO i1 = LBOUND(InData%AFindx,1), UBOUND(InData%AFindx,1) - IntKiBuf(Int_Xferred) = InData%AFindx(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%zHub) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%zHub,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zHub,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%zHub,1), UBOUND(InData%zHub,1) - ReKiBuf(Re_Xferred) = InData%zHub(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%zLocal) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%zLocal,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zLocal,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%zLocal,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zLocal,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%zLocal,2), UBOUND(InData%zLocal,2) - DO i1 = LBOUND(InData%zLocal,1), UBOUND(InData%zLocal,1) - ReKiBuf(Re_Xferred) = InData%zLocal(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%zTip) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%zTip,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zTip,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%zTip,1), UBOUND(InData%zTip,1) - ReKiBuf(Re_Xferred) = InData%zTip(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rLocal) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rLocal,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rLocal,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rLocal,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rLocal,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%rLocal,2), UBOUND(InData%rLocal,2) - DO i1 = LBOUND(InData%rLocal,1), UBOUND(InData%rLocal,1) - ReKiBuf(Re_Xferred) = InData%rLocal(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rTipFix) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rTipFix,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rTipFix,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rTipFix,1), UBOUND(InData%rTipFix,1) - ReKiBuf(Re_Xferred) = InData%rTipFix(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%UAMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UA_Flag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Flookup, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%a_s - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%DBEMT_Mod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%tau1_const - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%yawCorrFactor - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%UAOff_innerNode) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UAOff_innerNode,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UAOff_innerNode,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UAOff_innerNode,1), UBOUND(InData%UAOff_innerNode,1) - IntKiBuf(Int_Xferred) = InData%UAOff_innerNode(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%UAOff_outerNode) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UAOff_outerNode,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UAOff_outerNode,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UAOff_outerNode,1), UBOUND(InData%UAOff_outerNode,1) - IntKiBuf(Int_Xferred) = InData%UAOff_outerNode(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%BEM_Mod - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE BEMT_PackInitInput - - SUBROUTINE BEMT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(BEMT_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! chord not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%chord)) DEALLOCATE(OutData%chord) - ALLOCATE(OutData%chord(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%chord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%chord,2), UBOUND(OutData%chord,2) - DO i1 = LBOUND(OutData%chord,1), UBOUND(OutData%chord,1) - OutData%chord(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%numBlades = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%airDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%kinVisc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%skewWakeMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%aTol = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%useTipLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%useTipLoss) - Int_Xferred = Int_Xferred + 1 - OutData%useHubLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%useHubLoss) - Int_Xferred = Int_Xferred + 1 - OutData%useInduction = TRANSFER(IntKiBuf(Int_Xferred), OutData%useInduction) - Int_Xferred = Int_Xferred + 1 - OutData%useTanInd = TRANSFER(IntKiBuf(Int_Xferred), OutData%useTanInd) - Int_Xferred = Int_Xferred + 1 - OutData%useAIDrag = TRANSFER(IntKiBuf(Int_Xferred), OutData%useAIDrag) - Int_Xferred = Int_Xferred + 1 - OutData%useTIDrag = TRANSFER(IntKiBuf(Int_Xferred), OutData%useTIDrag) - Int_Xferred = Int_Xferred + 1 - OutData%MomentumCorr = TRANSFER(IntKiBuf(Int_Xferred), OutData%MomentumCorr) - Int_Xferred = Int_Xferred + 1 - OutData%numBladeNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%numReIterations = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%maxIndIterations = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFindx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AFindx)) DEALLOCATE(OutData%AFindx) - ALLOCATE(OutData%AFindx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFindx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AFindx,2), UBOUND(OutData%AFindx,2) - DO i1 = LBOUND(OutData%AFindx,1), UBOUND(OutData%AFindx,1) - OutData%AFindx(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! zHub not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%zHub)) DEALLOCATE(OutData%zHub) - ALLOCATE(OutData%zHub(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%zHub.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%zHub,1), UBOUND(OutData%zHub,1) - OutData%zHub(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! zLocal not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%zLocal)) DEALLOCATE(OutData%zLocal) - ALLOCATE(OutData%zLocal(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%zLocal.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%zLocal,2), UBOUND(OutData%zLocal,2) - DO i1 = LBOUND(OutData%zLocal,1), UBOUND(OutData%zLocal,1) - OutData%zLocal(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! zTip not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%zTip)) DEALLOCATE(OutData%zTip) - ALLOCATE(OutData%zTip(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%zTip.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%zTip,1), UBOUND(OutData%zTip,1) - OutData%zTip(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rLocal not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rLocal)) DEALLOCATE(OutData%rLocal) - ALLOCATE(OutData%rLocal(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rLocal.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%rLocal,2), UBOUND(OutData%rLocal,2) - DO i1 = LBOUND(OutData%rLocal,1), UBOUND(OutData%rLocal,1) - OutData%rLocal(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rTipFix not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rTipFix)) DEALLOCATE(OutData%rTipFix) - ALLOCATE(OutData%rTipFix(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rTipFix.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rTipFix,1), UBOUND(OutData%rTipFix,1) - OutData%rTipFix(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%UAMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UA_Flag = TRANSFER(IntKiBuf(Int_Xferred), OutData%UA_Flag) - Int_Xferred = Int_Xferred + 1 - OutData%Flookup = TRANSFER(IntKiBuf(Int_Xferred), OutData%Flookup) - Int_Xferred = Int_Xferred + 1 - OutData%a_s = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DBEMT_Mod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%tau1_const = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%yawCorrFactor = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UAOff_innerNode not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%UAOff_innerNode)) DEALLOCATE(OutData%UAOff_innerNode) - ALLOCATE(OutData%UAOff_innerNode(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UAOff_innerNode.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UAOff_innerNode,1), UBOUND(OutData%UAOff_innerNode,1) - OutData%UAOff_innerNode(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UAOff_outerNode not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%UAOff_outerNode)) DEALLOCATE(OutData%UAOff_outerNode) - ALLOCATE(OutData%UAOff_outerNode(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UAOff_outerNode.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UAOff_outerNode,1), UBOUND(OutData%UAOff_outerNode,1) - OutData%UAOff_outerNode(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) - Int_Xferred = Int_Xferred + 1 - OutData%BEM_Mod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE BEMT_UnPackInitInput +subroutine BEMT_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BEMT_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BEMT_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + ! chord + call RegPack(Buf, allocated(InData%chord)) + if (allocated(InData%chord)) then + call RegPackBounds(Buf, 2, lbound(InData%chord), ubound(InData%chord)) + call RegPack(Buf, InData%chord) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! numBlades + call RegPack(Buf, InData%numBlades) + if (RegCheckErr(Buf, RoutineName)) return + ! airDens + call RegPack(Buf, InData%airDens) + if (RegCheckErr(Buf, RoutineName)) return + ! kinVisc + call RegPack(Buf, InData%kinVisc) + if (RegCheckErr(Buf, RoutineName)) return + ! skewWakeMod + call RegPack(Buf, InData%skewWakeMod) + if (RegCheckErr(Buf, RoutineName)) return + ! aTol + call RegPack(Buf, InData%aTol) + if (RegCheckErr(Buf, RoutineName)) return + ! useTipLoss + call RegPack(Buf, InData%useTipLoss) + if (RegCheckErr(Buf, RoutineName)) return + ! useHubLoss + call RegPack(Buf, InData%useHubLoss) + if (RegCheckErr(Buf, RoutineName)) return + ! useInduction + call RegPack(Buf, InData%useInduction) + if (RegCheckErr(Buf, RoutineName)) return + ! useTanInd + call RegPack(Buf, InData%useTanInd) + if (RegCheckErr(Buf, RoutineName)) return + ! useAIDrag + call RegPack(Buf, InData%useAIDrag) + if (RegCheckErr(Buf, RoutineName)) return + ! useTIDrag + call RegPack(Buf, InData%useTIDrag) + if (RegCheckErr(Buf, RoutineName)) return + ! MomentumCorr + call RegPack(Buf, InData%MomentumCorr) + if (RegCheckErr(Buf, RoutineName)) return + ! numBladeNodes + call RegPack(Buf, InData%numBladeNodes) + if (RegCheckErr(Buf, RoutineName)) return + ! numReIterations + call RegPack(Buf, InData%numReIterations) + if (RegCheckErr(Buf, RoutineName)) return + ! maxIndIterations + call RegPack(Buf, InData%maxIndIterations) + if (RegCheckErr(Buf, RoutineName)) return + ! AFindx + call RegPack(Buf, allocated(InData%AFindx)) + if (allocated(InData%AFindx)) then + call RegPackBounds(Buf, 2, lbound(InData%AFindx), ubound(InData%AFindx)) + call RegPack(Buf, InData%AFindx) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! zHub + call RegPack(Buf, allocated(InData%zHub)) + if (allocated(InData%zHub)) then + call RegPackBounds(Buf, 1, lbound(InData%zHub), ubound(InData%zHub)) + call RegPack(Buf, InData%zHub) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! zLocal + call RegPack(Buf, allocated(InData%zLocal)) + if (allocated(InData%zLocal)) then + call RegPackBounds(Buf, 2, lbound(InData%zLocal), ubound(InData%zLocal)) + call RegPack(Buf, InData%zLocal) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! zTip + call RegPack(Buf, allocated(InData%zTip)) + if (allocated(InData%zTip)) then + call RegPackBounds(Buf, 1, lbound(InData%zTip), ubound(InData%zTip)) + call RegPack(Buf, InData%zTip) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! rLocal + call RegPack(Buf, allocated(InData%rLocal)) + if (allocated(InData%rLocal)) then + call RegPackBounds(Buf, 2, lbound(InData%rLocal), ubound(InData%rLocal)) + call RegPack(Buf, InData%rLocal) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! rTipFix + call RegPack(Buf, allocated(InData%rTipFix)) + if (allocated(InData%rTipFix)) then + call RegPackBounds(Buf, 1, lbound(InData%rTipFix), ubound(InData%rTipFix)) + call RegPack(Buf, InData%rTipFix) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! UAMod + call RegPack(Buf, InData%UAMod) + if (RegCheckErr(Buf, RoutineName)) return + ! UA_Flag + call RegPack(Buf, InData%UA_Flag) + if (RegCheckErr(Buf, RoutineName)) return + ! Flookup + call RegPack(Buf, InData%Flookup) + if (RegCheckErr(Buf, RoutineName)) return + ! a_s + call RegPack(Buf, InData%a_s) + if (RegCheckErr(Buf, RoutineName)) return + ! DBEMT_Mod + call RegPack(Buf, InData%DBEMT_Mod) + if (RegCheckErr(Buf, RoutineName)) return + ! tau1_const + call RegPack(Buf, InData%tau1_const) + if (RegCheckErr(Buf, RoutineName)) return + ! yawCorrFactor + call RegPack(Buf, InData%yawCorrFactor) + if (RegCheckErr(Buf, RoutineName)) return + ! UAOff_innerNode + call RegPack(Buf, allocated(InData%UAOff_innerNode)) + if (allocated(InData%UAOff_innerNode)) then + call RegPackBounds(Buf, 1, lbound(InData%UAOff_innerNode), ubound(InData%UAOff_innerNode)) + call RegPack(Buf, InData%UAOff_innerNode) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! UAOff_outerNode + call RegPack(Buf, allocated(InData%UAOff_outerNode)) + if (allocated(InData%UAOff_outerNode)) then + call RegPackBounds(Buf, 1, lbound(InData%UAOff_outerNode), ubound(InData%UAOff_outerNode)) + call RegPack(Buf, InData%UAOff_outerNode) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegPack(Buf, InData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! SumPrint + call RegPack(Buf, InData%SumPrint) + if (RegCheckErr(Buf, RoutineName)) return + ! BEM_Mod + call RegPack(Buf, InData%BEM_Mod) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BEMT_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BEMT_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BEMT_UnPackInitInput' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! chord + if (allocated(OutData%chord)) deallocate(OutData%chord) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%chord(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%chord.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%chord) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! numBlades + call RegUnpack(Buf, OutData%numBlades) + if (RegCheckErr(Buf, RoutineName)) return + ! airDens + call RegUnpack(Buf, OutData%airDens) + if (RegCheckErr(Buf, RoutineName)) return + ! kinVisc + call RegUnpack(Buf, OutData%kinVisc) + if (RegCheckErr(Buf, RoutineName)) return + ! skewWakeMod + call RegUnpack(Buf, OutData%skewWakeMod) + if (RegCheckErr(Buf, RoutineName)) return + ! aTol + call RegUnpack(Buf, OutData%aTol) + if (RegCheckErr(Buf, RoutineName)) return + ! useTipLoss + call RegUnpack(Buf, OutData%useTipLoss) + if (RegCheckErr(Buf, RoutineName)) return + ! useHubLoss + call RegUnpack(Buf, OutData%useHubLoss) + if (RegCheckErr(Buf, RoutineName)) return + ! useInduction + call RegUnpack(Buf, OutData%useInduction) + if (RegCheckErr(Buf, RoutineName)) return + ! useTanInd + call RegUnpack(Buf, OutData%useTanInd) + if (RegCheckErr(Buf, RoutineName)) return + ! useAIDrag + call RegUnpack(Buf, OutData%useAIDrag) + if (RegCheckErr(Buf, RoutineName)) return + ! useTIDrag + call RegUnpack(Buf, OutData%useTIDrag) + if (RegCheckErr(Buf, RoutineName)) return + ! MomentumCorr + call RegUnpack(Buf, OutData%MomentumCorr) + if (RegCheckErr(Buf, RoutineName)) return + ! numBladeNodes + call RegUnpack(Buf, OutData%numBladeNodes) + if (RegCheckErr(Buf, RoutineName)) return + ! numReIterations + call RegUnpack(Buf, OutData%numReIterations) + if (RegCheckErr(Buf, RoutineName)) return + ! maxIndIterations + call RegUnpack(Buf, OutData%maxIndIterations) + if (RegCheckErr(Buf, RoutineName)) return + ! AFindx + if (allocated(OutData%AFindx)) deallocate(OutData%AFindx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AFindx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFindx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AFindx) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! zHub + if (allocated(OutData%zHub)) deallocate(OutData%zHub) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%zHub(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%zHub.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%zHub) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! zLocal + if (allocated(OutData%zLocal)) deallocate(OutData%zLocal) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%zLocal(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%zLocal.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%zLocal) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! zTip + if (allocated(OutData%zTip)) deallocate(OutData%zTip) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%zTip(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%zTip.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%zTip) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! rLocal + if (allocated(OutData%rLocal)) deallocate(OutData%rLocal) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rLocal(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rLocal.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rLocal) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! rTipFix + if (allocated(OutData%rTipFix)) deallocate(OutData%rTipFix) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rTipFix(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rTipFix.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rTipFix) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! UAMod + call RegUnpack(Buf, OutData%UAMod) + if (RegCheckErr(Buf, RoutineName)) return + ! UA_Flag + call RegUnpack(Buf, OutData%UA_Flag) + if (RegCheckErr(Buf, RoutineName)) return + ! Flookup + call RegUnpack(Buf, OutData%Flookup) + if (RegCheckErr(Buf, RoutineName)) return + ! a_s + call RegUnpack(Buf, OutData%a_s) + if (RegCheckErr(Buf, RoutineName)) return + ! DBEMT_Mod + call RegUnpack(Buf, OutData%DBEMT_Mod) + if (RegCheckErr(Buf, RoutineName)) return + ! tau1_const + call RegUnpack(Buf, OutData%tau1_const) + if (RegCheckErr(Buf, RoutineName)) return + ! yawCorrFactor + call RegUnpack(Buf, OutData%yawCorrFactor) + if (RegCheckErr(Buf, RoutineName)) return + ! UAOff_innerNode + if (allocated(OutData%UAOff_innerNode)) deallocate(OutData%UAOff_innerNode) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%UAOff_innerNode(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UAOff_innerNode.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%UAOff_innerNode) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! UAOff_outerNode + if (allocated(OutData%UAOff_outerNode)) deallocate(OutData%UAOff_outerNode) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%UAOff_outerNode(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UAOff_outerNode.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%UAOff_outerNode) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RootName + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! SumPrint + call RegUnpack(Buf, OutData%SumPrint) + if (RegCheckErr(Buf, RoutineName)) return + ! BEM_Mod + call RegUnpack(Buf, OutData%BEM_Mod) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE BEMT_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(BEMT_InitOutputType), INTENT(IN) :: SrcInitOutputData TYPE(BEMT_InitOutputType), INTENT(INOUT) :: DstInitOutputData @@ -1065,184 +825,25 @@ SUBROUTINE BEMT_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE BEMT_DestroyInitOutput - SUBROUTINE BEMT_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(BEMT_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Version: size of buffers for each call to pack subtype - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Version, ErrStat2, ErrMsg2, .TRUE. ) ! Version - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Version - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Version - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Version - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Version, ErrStat2, ErrMsg2, OnlySize ) ! Version - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE BEMT_PackInitOutput - - SUBROUTINE BEMT_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(BEMT_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Version, ErrStat2, ErrMsg2 ) ! Version - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE BEMT_UnPackInitOutput +subroutine BEMT_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BEMT_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BEMT_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! Version + call NWTC_Library_PackProgDesc(Buf, InData%Version) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BEMT_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BEMT_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BEMT_UnPackInitOutput' + if (Buf%ErrStat /= ErrID_None) return + ! Version + call NWTC_Library_UnpackProgDesc(Buf, OutData%Version) ! Version +end subroutine SUBROUTINE BEMT_CopySkewWake_InputType( SrcSkewWake_InputTypeData, DstSkewWake_InputTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(BEMT_SkewWake_InputType), INTENT(IN) :: SrcSkewWake_InputTypeData TYPE(BEMT_SkewWake_InputType), INTENT(INOUT) :: DstSkewWake_InputTypeData @@ -1278,120 +879,38 @@ SUBROUTINE BEMT_DestroySkewWake_InputType( SkewWake_InputTypeData, ErrStat, ErrM END SUBROUTINE BEMT_DestroySkewWake_InputType - SUBROUTINE BEMT_PackSkewWake_InputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(BEMT_SkewWake_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_PackSkewWake_InputType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + SIZE(InData%v_qsw) ! v_qsw - Re_BufSz = Re_BufSz + 1 ! V0 - Re_BufSz = Re_BufSz + 1 ! R - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i1 = LBOUND(InData%v_qsw,1), UBOUND(InData%v_qsw,1) - ReKiBuf(Re_Xferred) = InData%v_qsw(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%V0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%R - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE BEMT_PackSkewWake_InputType - - SUBROUTINE BEMT_UnPackSkewWake_InputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(BEMT_SkewWake_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_UnPackSkewWake_InputType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%v_qsw,1) - i1_u = UBOUND(OutData%v_qsw,1) - DO i1 = LBOUND(OutData%v_qsw,1), UBOUND(OutData%v_qsw,1) - OutData%v_qsw(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%V0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%R = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE BEMT_UnPackSkewWake_InputType +subroutine BEMT_PackSkewWake_InputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BEMT_SkewWake_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BEMT_PackSkewWake_InputType' + if (Buf%ErrStat >= AbortErrLev) return + ! v_qsw + call RegPack(Buf, InData%v_qsw) + if (RegCheckErr(Buf, RoutineName)) return + ! V0 + call RegPack(Buf, InData%V0) + if (RegCheckErr(Buf, RoutineName)) return + ! R + call RegPack(Buf, InData%R) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BEMT_UnPackSkewWake_InputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BEMT_SkewWake_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BEMT_UnPackSkewWake_InputType' + if (Buf%ErrStat /= ErrID_None) return + ! v_qsw + call RegUnpack(Buf, OutData%v_qsw) + if (RegCheckErr(Buf, RoutineName)) return + ! V0 + call RegUnpack(Buf, OutData%V0) + if (RegCheckErr(Buf, RoutineName)) return + ! R + call RegUnpack(Buf, OutData%R) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE BEMT_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(BEMT_ContinuousStateType), INTENT(IN) :: SrcContStateData TYPE(BEMT_ContinuousStateType), INTENT(INOUT) :: DstContStateData @@ -1435,281 +954,36 @@ SUBROUTINE BEMT_DestroyContState( ContStateData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE BEMT_DestroyContState - SUBROUTINE BEMT_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(BEMT_ContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_PackContState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! UA: size of buffers for each call to pack subtype - CALL UA_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%UA, ErrStat2, ErrMsg2, .TRUE. ) ! UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! UA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! UA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! UA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! DBEMT: size of buffers for each call to pack subtype - CALL DBEMT_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%DBEMT, ErrStat2, ErrMsg2, .TRUE. ) ! DBEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DBEMT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DBEMT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DBEMT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Db_BufSz = Db_BufSz + SIZE(InData%V_w) ! V_w - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL UA_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%UA, ErrStat2, ErrMsg2, OnlySize ) ! UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL DBEMT_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%DBEMT, ErrStat2, ErrMsg2, OnlySize ) ! DBEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - DO i1 = LBOUND(InData%V_w,1), UBOUND(InData%V_w,1) - DbKiBuf(Db_Xferred) = InData%V_w(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE BEMT_PackContState - - SUBROUTINE BEMT_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(BEMT_ContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_UnPackContState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL UA_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%UA, ErrStat2, ErrMsg2 ) ! UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL DBEMT_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%DBEMT, ErrStat2, ErrMsg2 ) ! DBEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - i1_l = LBOUND(OutData%V_w,1) - i1_u = UBOUND(OutData%V_w,1) - DO i1 = LBOUND(OutData%V_w,1), UBOUND(OutData%V_w,1) - OutData%V_w(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE BEMT_UnPackContState +subroutine BEMT_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BEMT_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BEMT_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + ! UA + call UA_PackContState(Buf, InData%UA) + if (RegCheckErr(Buf, RoutineName)) return + ! DBEMT + call DBEMT_PackContState(Buf, InData%DBEMT) + if (RegCheckErr(Buf, RoutineName)) return + ! V_w + call RegPack(Buf, InData%V_w) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BEMT_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BEMT_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BEMT_UnPackContState' + if (Buf%ErrStat /= ErrID_None) return + ! UA + call UA_UnpackContState(Buf, OutData%UA) ! UA + ! DBEMT + call DBEMT_UnpackContState(Buf, OutData%DBEMT) ! DBEMT + ! V_w + call RegUnpack(Buf, OutData%V_w) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE BEMT_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(BEMT_DiscreteStateType), INTENT(IN) :: SrcDiscStateData TYPE(BEMT_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData @@ -1746,184 +1020,25 @@ SUBROUTINE BEMT_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE BEMT_DestroyDiscState - SUBROUTINE BEMT_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(BEMT_DiscreteStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_PackDiscState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! UA: size of buffers for each call to pack subtype - CALL UA_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%UA, ErrStat2, ErrMsg2, .TRUE. ) ! UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! UA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! UA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! UA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL UA_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%UA, ErrStat2, ErrMsg2, OnlySize ) ! UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE BEMT_PackDiscState - - SUBROUTINE BEMT_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(BEMT_DiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_UnPackDiscState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL UA_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%UA, ErrStat2, ErrMsg2 ) ! UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE BEMT_UnPackDiscState +subroutine BEMT_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BEMT_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BEMT_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + ! UA + call UA_PackDiscState(Buf, InData%UA) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BEMT_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BEMT_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BEMT_UnPackDiscState' + if (Buf%ErrStat /= ErrID_None) return + ! UA + call UA_UnpackDiscState(Buf, OutData%UA) ! UA +end subroutine SUBROUTINE BEMT_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(BEMT_ConstraintStateType), INTENT(IN) :: SrcConstrStateData TYPE(BEMT_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData @@ -1974,148 +1089,45 @@ SUBROUTINE BEMT_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE BEMT_DestroyConstrState - SUBROUTINE BEMT_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(BEMT_ConstraintStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_PackConstrState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! phi allocated yes/no - IF ( ALLOCATED(InData%phi) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! phi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%phi) ! phi - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%phi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%phi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%phi,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%phi,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%phi,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%phi,2), UBOUND(InData%phi,2) - DO i1 = LBOUND(InData%phi,1), UBOUND(InData%phi,1) - ReKiBuf(Re_Xferred) = InData%phi(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE BEMT_PackConstrState - - SUBROUTINE BEMT_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(BEMT_ConstraintStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_UnPackConstrState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! phi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%phi)) DEALLOCATE(OutData%phi) - ALLOCATE(OutData%phi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%phi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%phi,2), UBOUND(OutData%phi,2) - DO i1 = LBOUND(OutData%phi,1), UBOUND(OutData%phi,1) - OutData%phi(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE BEMT_UnPackConstrState +subroutine BEMT_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BEMT_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BEMT_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + ! phi + call RegPack(Buf, allocated(InData%phi)) + if (allocated(InData%phi)) then + call RegPackBounds(Buf, 2, lbound(InData%phi), ubound(InData%phi)) + call RegPack(Buf, InData%phi) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BEMT_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BEMT_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BEMT_UnPackConstrState' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! phi + if (allocated(OutData%phi)) deallocate(OutData%phi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%phi(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%phi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%phi) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE BEMT_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(BEMT_OtherStateType), INTENT(IN) :: SrcOtherStateData TYPE(BEMT_OtherStateType), INTENT(INOUT) :: DstOtherStateData @@ -2187,422 +1199,83 @@ SUBROUTINE BEMT_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) ENDDO END SUBROUTINE BEMT_DestroyOtherState - SUBROUTINE BEMT_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(BEMT_OtherStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_PackOtherState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! UA: size of buffers for each call to pack subtype - CALL UA_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%UA, ErrStat2, ErrMsg2, .TRUE. ) ! UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! UA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! UA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! UA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! DBEMT: size of buffers for each call to pack subtype - CALL DBEMT_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%DBEMT, ErrStat2, ErrMsg2, .TRUE. ) ! DBEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DBEMT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DBEMT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DBEMT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! ValidPhi allocated yes/no - IF ( ALLOCATED(InData%ValidPhi) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ValidPhi upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ValidPhi) ! ValidPhi - END IF - Int_BufSz = Int_BufSz + 1 ! nodesInitialized - DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) - Int_BufSz = Int_BufSz + 3 ! xdot: size of buffers for each call to pack subtype - CALL BEMT_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xdot - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xdot - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xdot - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xdot - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 1 ! n - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL UA_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%UA, ErrStat2, ErrMsg2, OnlySize ) ! UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL DBEMT_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%DBEMT, ErrStat2, ErrMsg2, OnlySize ) ! DBEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%ValidPhi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ValidPhi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ValidPhi,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ValidPhi,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ValidPhi,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ValidPhi,2), UBOUND(InData%ValidPhi,2) - DO i1 = LBOUND(InData%ValidPhi,1), UBOUND(InData%ValidPhi,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%ValidPhi(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%nodesInitialized, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) - CALL BEMT_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, OnlySize ) ! xdot - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - IntKiBuf(Int_Xferred) = InData%n - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE BEMT_PackOtherState - - SUBROUTINE BEMT_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(BEMT_OtherStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_UnPackOtherState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL UA_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%UA, ErrStat2, ErrMsg2 ) ! UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL DBEMT_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%DBEMT, ErrStat2, ErrMsg2 ) ! DBEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ValidPhi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ValidPhi)) DEALLOCATE(OutData%ValidPhi) - ALLOCATE(OutData%ValidPhi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ValidPhi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ValidPhi,2), UBOUND(OutData%ValidPhi,2) - DO i1 = LBOUND(OutData%ValidPhi,1), UBOUND(OutData%ValidPhi,1) - OutData%ValidPhi(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%ValidPhi(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - OutData%nodesInitialized = TRANSFER(IntKiBuf(Int_Xferred), OutData%nodesInitialized) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%xdot,1) - i1_u = UBOUND(OutData%xdot,1) - DO i1 = LBOUND(OutData%xdot,1), UBOUND(OutData%xdot,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL BEMT_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%xdot(i1), ErrStat2, ErrMsg2 ) ! xdot - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - OutData%n = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE BEMT_UnPackOtherState +subroutine BEMT_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BEMT_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BEMT_PackOtherState' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + ! UA + call UA_PackOtherState(Buf, InData%UA) + if (RegCheckErr(Buf, RoutineName)) return + ! DBEMT + call DBEMT_PackOtherState(Buf, InData%DBEMT) + if (RegCheckErr(Buf, RoutineName)) return + ! ValidPhi + call RegPack(Buf, allocated(InData%ValidPhi)) + if (allocated(InData%ValidPhi)) then + call RegPackBounds(Buf, 2, lbound(InData%ValidPhi), ubound(InData%ValidPhi)) + call RegPack(Buf, InData%ValidPhi) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! nodesInitialized + call RegPack(Buf, InData%nodesInitialized) + if (RegCheckErr(Buf, RoutineName)) return + ! xdot + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) + do i1 = LB(1), UB(1) + call BEMT_PackContState(Buf, InData%xdot(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! n + call RegPack(Buf, InData%n) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BEMT_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BEMT_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BEMT_UnPackOtherState' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! UA + call UA_UnpackOtherState(Buf, OutData%UA) ! UA + ! DBEMT + call DBEMT_UnpackOtherState(Buf, OutData%DBEMT) ! DBEMT + ! ValidPhi + if (allocated(OutData%ValidPhi)) deallocate(OutData%ValidPhi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ValidPhi(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ValidPhi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ValidPhi) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! nodesInitialized + call RegUnpack(Buf, OutData%nodesInitialized) + if (RegCheckErr(Buf, RoutineName)) return + ! xdot + LB(1:1) = lbound(OutData%xdot) + UB(1:1) = ubound(OutData%xdot) + do i1 = LB(1), UB(1) + call BEMT_UnpackContState(Buf, OutData%xdot(i1)) ! xdot + end do + ! n + call RegUnpack(Buf, OutData%n) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE BEMT_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) TYPE(BEMT_MiscVarType), INTENT(IN) :: SrcMiscData TYPE(BEMT_MiscVarType), INTENT(INOUT) :: DstMiscData @@ -2844,1086 +1517,308 @@ SUBROUTINE BEMT_DestroyMisc( MiscData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE BEMT_DestroyMisc - SUBROUTINE BEMT_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(BEMT_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! FirstWarn_Skew - Int_BufSz = Int_BufSz + 1 ! FirstWarn_Phi - Int_BufSz = Int_BufSz + 1 ! FirstWarn_BEMoff - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! UA: size of buffers for each call to pack subtype - CALL UA_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%UA, ErrStat2, ErrMsg2, .TRUE. ) ! UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! UA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! UA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! UA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! DBEMT: size of buffers for each call to pack subtype - CALL DBEMT_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%DBEMT, ErrStat2, ErrMsg2, .TRUE. ) ! DBEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DBEMT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DBEMT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DBEMT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y_UA: size of buffers for each call to pack subtype - CALL UA_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_UA, ErrStat2, ErrMsg2, .TRUE. ) ! y_UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_UA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_UA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_UA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! u_UA allocated yes/no - IF ( ALLOCATED(InData%u_UA) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! u_UA upper/lower bounds for each dimension - DO i3 = LBOUND(InData%u_UA,3), UBOUND(InData%u_UA,3) - DO i2 = LBOUND(InData%u_UA,2), UBOUND(InData%u_UA,2) - DO i1 = LBOUND(InData%u_UA,1), UBOUND(InData%u_UA,1) - Int_BufSz = Int_BufSz + 3 ! u_UA: size of buffers for each call to pack subtype - CALL UA_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_UA(i1,i2,i3), ErrStat2, ErrMsg2, .TRUE. ) ! u_UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_UA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_UA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_UA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%u_DBEMT,1), UBOUND(InData%u_DBEMT,1) - Int_BufSz = Int_BufSz + 3 ! u_DBEMT: size of buffers for each call to pack subtype - CALL DBEMT_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_DBEMT(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_DBEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_DBEMT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_DBEMT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_DBEMT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%u_SkewWake,1), UBOUND(InData%u_SkewWake,1) - Int_BufSz = Int_BufSz + 3 ! u_SkewWake: size of buffers for each call to pack subtype - CALL BEMT_PackSkewWake_InputType( Re_Buf, Db_Buf, Int_Buf, InData%u_SkewWake(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_SkewWake - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_SkewWake - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_SkewWake - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_SkewWake - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 1 ! TnInd_op allocated yes/no - IF ( ALLOCATED(InData%TnInd_op) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TnInd_op upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TnInd_op) ! TnInd_op - END IF - Int_BufSz = Int_BufSz + 1 ! AxInd_op allocated yes/no - IF ( ALLOCATED(InData%AxInd_op) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AxInd_op upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AxInd_op) ! AxInd_op - END IF - Int_BufSz = Int_BufSz + 1 ! AxInduction allocated yes/no - IF ( ALLOCATED(InData%AxInduction) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AxInduction upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AxInduction) ! AxInduction - END IF - Int_BufSz = Int_BufSz + 1 ! TanInduction allocated yes/no - IF ( ALLOCATED(InData%TanInduction) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TanInduction upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TanInduction) ! TanInduction - END IF - Int_BufSz = Int_BufSz + 1 ! UseFrozenWake - Int_BufSz = Int_BufSz + 1 ! Rtip allocated yes/no - IF ( ALLOCATED(InData%Rtip) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Rtip upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Rtip) ! Rtip - END IF - Int_BufSz = Int_BufSz + 1 ! phi allocated yes/no - IF ( ALLOCATED(InData%phi) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! phi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%phi) ! phi - END IF - Int_BufSz = Int_BufSz + 1 ! chi allocated yes/no - IF ( ALLOCATED(InData%chi) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! chi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%chi) ! chi - END IF - Int_BufSz = Int_BufSz + 1 ! ValidPhi allocated yes/no - IF ( ALLOCATED(InData%ValidPhi) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ValidPhi upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ValidPhi) ! ValidPhi - END IF - Re_BufSz = Re_BufSz + 1 ! BEM_weight - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstWarn_Skew, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstWarn_Phi, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstWarn_BEMoff, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - CALL UA_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%UA, ErrStat2, ErrMsg2, OnlySize ) ! UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL DBEMT_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%DBEMT, ErrStat2, ErrMsg2, OnlySize ) ! DBEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL UA_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_UA, ErrStat2, ErrMsg2, OnlySize ) ! y_UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%u_UA) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_UA,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_UA,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_UA,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_UA,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_UA,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_UA,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%u_UA,3), UBOUND(InData%u_UA,3) - DO i2 = LBOUND(InData%u_UA,2), UBOUND(InData%u_UA,2) - DO i1 = LBOUND(InData%u_UA,1), UBOUND(InData%u_UA,1) - CALL UA_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_UA(i1,i2,i3), ErrStat2, ErrMsg2, OnlySize ) ! u_UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%u_DBEMT,1), UBOUND(InData%u_DBEMT,1) - CALL DBEMT_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_DBEMT(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_DBEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%u_SkewWake,1), UBOUND(InData%u_SkewWake,1) - CALL BEMT_PackSkewWake_InputType( Re_Buf, Db_Buf, Int_Buf, InData%u_SkewWake(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_SkewWake - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - IF ( .NOT. ALLOCATED(InData%TnInd_op) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TnInd_op,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TnInd_op,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TnInd_op,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TnInd_op,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TnInd_op,2), UBOUND(InData%TnInd_op,2) - DO i1 = LBOUND(InData%TnInd_op,1), UBOUND(InData%TnInd_op,1) - ReKiBuf(Re_Xferred) = InData%TnInd_op(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AxInd_op) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AxInd_op,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxInd_op,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AxInd_op,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxInd_op,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AxInd_op,2), UBOUND(InData%AxInd_op,2) - DO i1 = LBOUND(InData%AxInd_op,1), UBOUND(InData%AxInd_op,1) - ReKiBuf(Re_Xferred) = InData%AxInd_op(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AxInduction) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AxInduction,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxInduction,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AxInduction,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxInduction,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AxInduction,2), UBOUND(InData%AxInduction,2) - DO i1 = LBOUND(InData%AxInduction,1), UBOUND(InData%AxInduction,1) - ReKiBuf(Re_Xferred) = InData%AxInduction(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TanInduction) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TanInduction,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TanInduction,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TanInduction,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TanInduction,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TanInduction,2), UBOUND(InData%TanInduction,2) - DO i1 = LBOUND(InData%TanInduction,1), UBOUND(InData%TanInduction,1) - ReKiBuf(Re_Xferred) = InData%TanInduction(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseFrozenWake, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Rtip) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Rtip,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Rtip,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Rtip,1), UBOUND(InData%Rtip,1) - ReKiBuf(Re_Xferred) = InData%Rtip(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%phi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%phi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%phi,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%phi,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%phi,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%phi,2), UBOUND(InData%phi,2) - DO i1 = LBOUND(InData%phi,1), UBOUND(InData%phi,1) - ReKiBuf(Re_Xferred) = InData%phi(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%chi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%chi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chi,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%chi,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chi,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%chi,2), UBOUND(InData%chi,2) - DO i1 = LBOUND(InData%chi,1), UBOUND(InData%chi,1) - ReKiBuf(Re_Xferred) = InData%chi(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ValidPhi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ValidPhi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ValidPhi,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ValidPhi,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ValidPhi,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ValidPhi,2), UBOUND(InData%ValidPhi,2) - DO i1 = LBOUND(InData%ValidPhi,1), UBOUND(InData%ValidPhi,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%ValidPhi(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%BEM_weight - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE BEMT_PackMisc - - SUBROUTINE BEMT_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(BEMT_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%FirstWarn_Skew = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn_Skew) - Int_Xferred = Int_Xferred + 1 - OutData%FirstWarn_Phi = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn_Phi) - Int_Xferred = Int_Xferred + 1 - OutData%FirstWarn_BEMoff = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn_BEMoff) - Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL UA_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%UA, ErrStat2, ErrMsg2 ) ! UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL DBEMT_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%DBEMT, ErrStat2, ErrMsg2 ) ! DBEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL UA_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_UA, ErrStat2, ErrMsg2 ) ! y_UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_UA not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%u_UA)) DEALLOCATE(OutData%u_UA) - ALLOCATE(OutData%u_UA(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_UA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%u_UA,3), UBOUND(OutData%u_UA,3) - DO i2 = LBOUND(OutData%u_UA,2), UBOUND(OutData%u_UA,2) - DO i1 = LBOUND(OutData%u_UA,1), UBOUND(OutData%u_UA,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL UA_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_UA(i1,i2,i3), ErrStat2, ErrMsg2 ) ! u_UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%u_DBEMT,1) - i1_u = UBOUND(OutData%u_DBEMT,1) - DO i1 = LBOUND(OutData%u_DBEMT,1), UBOUND(OutData%u_DBEMT,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL DBEMT_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_DBEMT(i1), ErrStat2, ErrMsg2 ) ! u_DBEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%u_SkewWake,1) - i1_u = UBOUND(OutData%u_SkewWake,1) - DO i1 = LBOUND(OutData%u_SkewWake,1), UBOUND(OutData%u_SkewWake,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL BEMT_UnpackSkewWake_InputType( Re_Buf, Db_Buf, Int_Buf, OutData%u_SkewWake(i1), ErrStat2, ErrMsg2 ) ! u_SkewWake - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TnInd_op not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TnInd_op)) DEALLOCATE(OutData%TnInd_op) - ALLOCATE(OutData%TnInd_op(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TnInd_op.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TnInd_op,2), UBOUND(OutData%TnInd_op,2) - DO i1 = LBOUND(OutData%TnInd_op,1), UBOUND(OutData%TnInd_op,1) - OutData%TnInd_op(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AxInd_op not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AxInd_op)) DEALLOCATE(OutData%AxInd_op) - ALLOCATE(OutData%AxInd_op(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxInd_op.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AxInd_op,2), UBOUND(OutData%AxInd_op,2) - DO i1 = LBOUND(OutData%AxInd_op,1), UBOUND(OutData%AxInd_op,1) - OutData%AxInd_op(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AxInduction not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AxInduction)) DEALLOCATE(OutData%AxInduction) - ALLOCATE(OutData%AxInduction(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxInduction.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AxInduction,2), UBOUND(OutData%AxInduction,2) - DO i1 = LBOUND(OutData%AxInduction,1), UBOUND(OutData%AxInduction,1) - OutData%AxInduction(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TanInduction not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TanInduction)) DEALLOCATE(OutData%TanInduction) - ALLOCATE(OutData%TanInduction(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TanInduction.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TanInduction,2), UBOUND(OutData%TanInduction,2) - DO i1 = LBOUND(OutData%TanInduction,1), UBOUND(OutData%TanInduction,1) - OutData%TanInduction(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%UseFrozenWake = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseFrozenWake) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Rtip not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Rtip)) DEALLOCATE(OutData%Rtip) - ALLOCATE(OutData%Rtip(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Rtip.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Rtip,1), UBOUND(OutData%Rtip,1) - OutData%Rtip(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! phi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%phi)) DEALLOCATE(OutData%phi) - ALLOCATE(OutData%phi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%phi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%phi,2), UBOUND(OutData%phi,2) - DO i1 = LBOUND(OutData%phi,1), UBOUND(OutData%phi,1) - OutData%phi(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! chi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%chi)) DEALLOCATE(OutData%chi) - ALLOCATE(OutData%chi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%chi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%chi,2), UBOUND(OutData%chi,2) - DO i1 = LBOUND(OutData%chi,1), UBOUND(OutData%chi,1) - OutData%chi(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ValidPhi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ValidPhi)) DEALLOCATE(OutData%ValidPhi) - ALLOCATE(OutData%ValidPhi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ValidPhi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ValidPhi,2), UBOUND(OutData%ValidPhi,2) - DO i1 = LBOUND(OutData%ValidPhi,1), UBOUND(OutData%ValidPhi,1) - OutData%ValidPhi(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%ValidPhi(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - OutData%BEM_weight = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE BEMT_UnPackMisc +subroutine BEMT_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BEMT_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BEMT_PackMisc' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + if (Buf%ErrStat >= AbortErrLev) return + ! FirstWarn_Skew + call RegPack(Buf, InData%FirstWarn_Skew) + if (RegCheckErr(Buf, RoutineName)) return + ! FirstWarn_Phi + call RegPack(Buf, InData%FirstWarn_Phi) + if (RegCheckErr(Buf, RoutineName)) return + ! FirstWarn_BEMoff + call RegPack(Buf, InData%FirstWarn_BEMoff) + if (RegCheckErr(Buf, RoutineName)) return + ! UA + call UA_PackMisc(Buf, InData%UA) + if (RegCheckErr(Buf, RoutineName)) return + ! DBEMT + call DBEMT_PackMisc(Buf, InData%DBEMT) + if (RegCheckErr(Buf, RoutineName)) return + ! y_UA + call UA_PackOutput(Buf, InData%y_UA) + if (RegCheckErr(Buf, RoutineName)) return + ! u_UA + call RegPack(Buf, allocated(InData%u_UA)) + if (allocated(InData%u_UA)) then + call RegPackBounds(Buf, 3, lbound(InData%u_UA), ubound(InData%u_UA)) + LB(1:3) = lbound(InData%u_UA) + UB(1:3) = ubound(InData%u_UA) + do i3 = LB(3), UB(3) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call UA_PackInput(Buf, InData%u_UA(i1,i2,i3)) + end do + end do + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! u_DBEMT + LB(1:1) = lbound(InData%u_DBEMT) + UB(1:1) = ubound(InData%u_DBEMT) + do i1 = LB(1), UB(1) + call DBEMT_PackInput(Buf, InData%u_DBEMT(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! u_SkewWake + LB(1:1) = lbound(InData%u_SkewWake) + UB(1:1) = ubound(InData%u_SkewWake) + do i1 = LB(1), UB(1) + call BEMT_PackSkewWake_InputType(Buf, InData%u_SkewWake(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! TnInd_op + call RegPack(Buf, allocated(InData%TnInd_op)) + if (allocated(InData%TnInd_op)) then + call RegPackBounds(Buf, 2, lbound(InData%TnInd_op), ubound(InData%TnInd_op)) + call RegPack(Buf, InData%TnInd_op) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AxInd_op + call RegPack(Buf, allocated(InData%AxInd_op)) + if (allocated(InData%AxInd_op)) then + call RegPackBounds(Buf, 2, lbound(InData%AxInd_op), ubound(InData%AxInd_op)) + call RegPack(Buf, InData%AxInd_op) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AxInduction + call RegPack(Buf, allocated(InData%AxInduction)) + if (allocated(InData%AxInduction)) then + call RegPackBounds(Buf, 2, lbound(InData%AxInduction), ubound(InData%AxInduction)) + call RegPack(Buf, InData%AxInduction) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TanInduction + call RegPack(Buf, allocated(InData%TanInduction)) + if (allocated(InData%TanInduction)) then + call RegPackBounds(Buf, 2, lbound(InData%TanInduction), ubound(InData%TanInduction)) + call RegPack(Buf, InData%TanInduction) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! UseFrozenWake + call RegPack(Buf, InData%UseFrozenWake) + if (RegCheckErr(Buf, RoutineName)) return + ! Rtip + call RegPack(Buf, allocated(InData%Rtip)) + if (allocated(InData%Rtip)) then + call RegPackBounds(Buf, 1, lbound(InData%Rtip), ubound(InData%Rtip)) + call RegPack(Buf, InData%Rtip) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! phi + call RegPack(Buf, allocated(InData%phi)) + if (allocated(InData%phi)) then + call RegPackBounds(Buf, 2, lbound(InData%phi), ubound(InData%phi)) + call RegPack(Buf, InData%phi) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! chi + call RegPack(Buf, allocated(InData%chi)) + if (allocated(InData%chi)) then + call RegPackBounds(Buf, 2, lbound(InData%chi), ubound(InData%chi)) + call RegPack(Buf, InData%chi) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ValidPhi + call RegPack(Buf, allocated(InData%ValidPhi)) + if (allocated(InData%ValidPhi)) then + call RegPackBounds(Buf, 2, lbound(InData%ValidPhi), ubound(InData%ValidPhi)) + call RegPack(Buf, InData%ValidPhi) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BEM_weight + call RegPack(Buf, InData%BEM_weight) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BEMT_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BEMT_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BEMT_UnPackMisc' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! FirstWarn_Skew + call RegUnpack(Buf, OutData%FirstWarn_Skew) + if (RegCheckErr(Buf, RoutineName)) return + ! FirstWarn_Phi + call RegUnpack(Buf, OutData%FirstWarn_Phi) + if (RegCheckErr(Buf, RoutineName)) return + ! FirstWarn_BEMoff + call RegUnpack(Buf, OutData%FirstWarn_BEMoff) + if (RegCheckErr(Buf, RoutineName)) return + ! UA + call UA_UnpackMisc(Buf, OutData%UA) ! UA + ! DBEMT + call DBEMT_UnpackMisc(Buf, OutData%DBEMT) ! DBEMT + ! y_UA + call UA_UnpackOutput(Buf, OutData%y_UA) ! y_UA + ! u_UA + if (allocated(OutData%u_UA)) deallocate(OutData%u_UA) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_UA(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_UA.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i3 = LB(3), UB(3) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call UA_UnpackInput(Buf, OutData%u_UA(i1,i2,i3)) ! u_UA + end do + end do + end do + end if + ! u_DBEMT + LB(1:1) = lbound(OutData%u_DBEMT) + UB(1:1) = ubound(OutData%u_DBEMT) + do i1 = LB(1), UB(1) + call DBEMT_UnpackInput(Buf, OutData%u_DBEMT(i1)) ! u_DBEMT + end do + ! u_SkewWake + LB(1:1) = lbound(OutData%u_SkewWake) + UB(1:1) = ubound(OutData%u_SkewWake) + do i1 = LB(1), UB(1) + call BEMT_UnpackSkewWake_InputType(Buf, OutData%u_SkewWake(i1)) ! u_SkewWake + end do + ! TnInd_op + if (allocated(OutData%TnInd_op)) deallocate(OutData%TnInd_op) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TnInd_op(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TnInd_op.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TnInd_op) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AxInd_op + if (allocated(OutData%AxInd_op)) deallocate(OutData%AxInd_op) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AxInd_op(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxInd_op.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AxInd_op) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AxInduction + if (allocated(OutData%AxInduction)) deallocate(OutData%AxInduction) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AxInduction(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxInduction.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AxInduction) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TanInduction + if (allocated(OutData%TanInduction)) deallocate(OutData%TanInduction) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TanInduction(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TanInduction.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TanInduction) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! UseFrozenWake + call RegUnpack(Buf, OutData%UseFrozenWake) + if (RegCheckErr(Buf, RoutineName)) return + ! Rtip + if (allocated(OutData%Rtip)) deallocate(OutData%Rtip) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Rtip(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Rtip.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Rtip) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! phi + if (allocated(OutData%phi)) deallocate(OutData%phi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%phi(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%phi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%phi) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! chi + if (allocated(OutData%chi)) deallocate(OutData%chi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%chi(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%chi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%chi) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ValidPhi + if (allocated(OutData%ValidPhi)) deallocate(OutData%ValidPhi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ValidPhi(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ValidPhi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ValidPhi) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BEM_weight + call RegUnpack(Buf, OutData%BEM_weight) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE BEMT_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(BEMT_ParameterType), INTENT(IN) :: SrcParamData TYPE(BEMT_ParameterType), INTENT(INOUT) :: DstParamData @@ -4066,747 +1961,359 @@ SUBROUTINE BEMT_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%BEM_Mod = SrcParamData%BEM_Mod END SUBROUTINE BEMT_CopyParam - SUBROUTINE BEMT_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(BEMT_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%chord)) THEN - DEALLOCATE(ParamData%chord) -ENDIF -IF (ALLOCATED(ParamData%AFindx)) THEN - DEALLOCATE(ParamData%AFindx) -ENDIF -IF (ALLOCATED(ParamData%tipLossConst)) THEN - DEALLOCATE(ParamData%tipLossConst) -ENDIF -IF (ALLOCATED(ParamData%hubLossConst)) THEN - DEALLOCATE(ParamData%hubLossConst) -ENDIF -IF (ALLOCATED(ParamData%zHub)) THEN - DEALLOCATE(ParamData%zHub) -ENDIF - CALL UA_DestroyParam( ParamData%UA, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DBEMT_DestroyParam( ParamData%DBEMT, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ParamData%FixedInductions)) THEN - DEALLOCATE(ParamData%FixedInductions) -ENDIF -IF (ALLOCATED(ParamData%IntegrateWeight)) THEN - DEALLOCATE(ParamData%IntegrateWeight) -ENDIF - END SUBROUTINE BEMT_DestroyParam - - SUBROUTINE BEMT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(BEMT_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! DT - Int_BufSz = Int_BufSz + 1 ! chord allocated yes/no - IF ( ALLOCATED(InData%chord) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! chord upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%chord) ! chord - END IF - Int_BufSz = Int_BufSz + 1 ! numBlades - Re_BufSz = Re_BufSz + 1 ! airDens - Re_BufSz = Re_BufSz + 1 ! kinVisc - Int_BufSz = Int_BufSz + 1 ! skewWakeMod - Re_BufSz = Re_BufSz + 1 ! aTol - Int_BufSz = Int_BufSz + 1 ! useTipLoss - Int_BufSz = Int_BufSz + 1 ! useHubLoss - Int_BufSz = Int_BufSz + 1 ! useInduction - Int_BufSz = Int_BufSz + 1 ! useTanInd - Int_BufSz = Int_BufSz + 1 ! useAIDrag - Int_BufSz = Int_BufSz + 1 ! useTIDrag - Int_BufSz = Int_BufSz + 1 ! numBladeNodes - Int_BufSz = Int_BufSz + 1 ! numReIterations - Int_BufSz = Int_BufSz + 1 ! maxIndIterations - Int_BufSz = Int_BufSz + 1 ! AFindx allocated yes/no - IF ( ALLOCATED(InData%AFindx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AFindx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%AFindx) ! AFindx - END IF - Int_BufSz = Int_BufSz + 1 ! tipLossConst allocated yes/no - IF ( ALLOCATED(InData%tipLossConst) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! tipLossConst upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%tipLossConst) ! tipLossConst - END IF - Int_BufSz = Int_BufSz + 1 ! hubLossConst allocated yes/no - IF ( ALLOCATED(InData%hubLossConst) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! hubLossConst upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%hubLossConst) ! hubLossConst - END IF - Int_BufSz = Int_BufSz + 1 ! zHub allocated yes/no - IF ( ALLOCATED(InData%zHub) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! zHub upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%zHub) ! zHub - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! UA: size of buffers for each call to pack subtype - CALL UA_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%UA, ErrStat2, ErrMsg2, .TRUE. ) ! UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! UA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! UA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! UA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! DBEMT: size of buffers for each call to pack subtype - CALL DBEMT_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%DBEMT, ErrStat2, ErrMsg2, .TRUE. ) ! DBEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DBEMT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DBEMT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DBEMT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! UA_Flag - Int_BufSz = Int_BufSz + 1 ! DBEMT_Mod - Re_BufSz = Re_BufSz + 1 ! yawCorrFactor - Int_BufSz = Int_BufSz + 1 ! FixedInductions allocated yes/no - IF ( ALLOCATED(InData%FixedInductions) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FixedInductions upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%FixedInductions) ! FixedInductions - END IF - Int_BufSz = Int_BufSz + 1 ! MomentumCorr - Re_BufSz = Re_BufSz + 1 ! rTipFixMax - Int_BufSz = Int_BufSz + 1 ! IntegrateWeight allocated yes/no - IF ( ALLOCATED(InData%IntegrateWeight) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! IntegrateWeight upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%IntegrateWeight) ! IntegrateWeight - END IF - Int_BufSz = Int_BufSz + 1 ! lin_nx - Int_BufSz = Int_BufSz + 1 ! BEM_Mod - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%chord) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%chord,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chord,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%chord,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chord,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%chord,2), UBOUND(InData%chord,2) - DO i1 = LBOUND(InData%chord,1), UBOUND(InData%chord,1) - ReKiBuf(Re_Xferred) = InData%chord(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%numBlades - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%airDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%kinVisc - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%skewWakeMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%aTol - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%useTipLoss, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%useHubLoss, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%useInduction, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%useTanInd, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%useAIDrag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%useTIDrag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%numBladeNodes - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%numReIterations - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%maxIndIterations - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%AFindx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFindx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFindx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFindx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFindx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AFindx,2), UBOUND(InData%AFindx,2) - DO i1 = LBOUND(InData%AFindx,1), UBOUND(InData%AFindx,1) - IntKiBuf(Int_Xferred) = InData%AFindx(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%tipLossConst) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%tipLossConst,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tipLossConst,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%tipLossConst,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tipLossConst,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%tipLossConst,2), UBOUND(InData%tipLossConst,2) - DO i1 = LBOUND(InData%tipLossConst,1), UBOUND(InData%tipLossConst,1) - ReKiBuf(Re_Xferred) = InData%tipLossConst(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%hubLossConst) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%hubLossConst,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%hubLossConst,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%hubLossConst,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%hubLossConst,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%hubLossConst,2), UBOUND(InData%hubLossConst,2) - DO i1 = LBOUND(InData%hubLossConst,1), UBOUND(InData%hubLossConst,1) - ReKiBuf(Re_Xferred) = InData%hubLossConst(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%zHub) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%zHub,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zHub,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%zHub,1), UBOUND(InData%zHub,1) - ReKiBuf(Re_Xferred) = InData%zHub(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - CALL UA_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%UA, ErrStat2, ErrMsg2, OnlySize ) ! UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL DBEMT_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%DBEMT, ErrStat2, ErrMsg2, OnlySize ) ! DBEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = TRANSFER(InData%UA_Flag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%DBEMT_Mod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%yawCorrFactor - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%FixedInductions) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FixedInductions,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FixedInductions,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FixedInductions,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FixedInductions,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FixedInductions,2), UBOUND(InData%FixedInductions,2) - DO i1 = LBOUND(InData%FixedInductions,1), UBOUND(InData%FixedInductions,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%FixedInductions(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%MomentumCorr, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rTipFixMax - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%IntegrateWeight) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IntegrateWeight,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IntegrateWeight,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IntegrateWeight,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IntegrateWeight,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%IntegrateWeight,2), UBOUND(InData%IntegrateWeight,2) - DO i1 = LBOUND(InData%IntegrateWeight,1), UBOUND(InData%IntegrateWeight,1) - ReKiBuf(Re_Xferred) = InData%IntegrateWeight(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%lin_nx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%BEM_Mod - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE BEMT_PackParam - - SUBROUTINE BEMT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(BEMT_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! chord not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%chord)) DEALLOCATE(OutData%chord) - ALLOCATE(OutData%chord(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%chord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%chord,2), UBOUND(OutData%chord,2) - DO i1 = LBOUND(OutData%chord,1), UBOUND(OutData%chord,1) - OutData%chord(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%numBlades = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%airDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%kinVisc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%skewWakeMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%aTol = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%useTipLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%useTipLoss) - Int_Xferred = Int_Xferred + 1 - OutData%useHubLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%useHubLoss) - Int_Xferred = Int_Xferred + 1 - OutData%useInduction = TRANSFER(IntKiBuf(Int_Xferred), OutData%useInduction) - Int_Xferred = Int_Xferred + 1 - OutData%useTanInd = TRANSFER(IntKiBuf(Int_Xferred), OutData%useTanInd) - Int_Xferred = Int_Xferred + 1 - OutData%useAIDrag = TRANSFER(IntKiBuf(Int_Xferred), OutData%useAIDrag) - Int_Xferred = Int_Xferred + 1 - OutData%useTIDrag = TRANSFER(IntKiBuf(Int_Xferred), OutData%useTIDrag) - Int_Xferred = Int_Xferred + 1 - OutData%numBladeNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%numReIterations = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%maxIndIterations = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFindx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AFindx)) DEALLOCATE(OutData%AFindx) - ALLOCATE(OutData%AFindx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFindx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AFindx,2), UBOUND(OutData%AFindx,2) - DO i1 = LBOUND(OutData%AFindx,1), UBOUND(OutData%AFindx,1) - OutData%AFindx(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! tipLossConst not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%tipLossConst)) DEALLOCATE(OutData%tipLossConst) - ALLOCATE(OutData%tipLossConst(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%tipLossConst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%tipLossConst,2), UBOUND(OutData%tipLossConst,2) - DO i1 = LBOUND(OutData%tipLossConst,1), UBOUND(OutData%tipLossConst,1) - OutData%tipLossConst(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! hubLossConst not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%hubLossConst)) DEALLOCATE(OutData%hubLossConst) - ALLOCATE(OutData%hubLossConst(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%hubLossConst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%hubLossConst,2), UBOUND(OutData%hubLossConst,2) - DO i1 = LBOUND(OutData%hubLossConst,1), UBOUND(OutData%hubLossConst,1) - OutData%hubLossConst(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! zHub not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%zHub)) DEALLOCATE(OutData%zHub) - ALLOCATE(OutData%zHub(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%zHub.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%zHub,1), UBOUND(OutData%zHub,1) - OutData%zHub(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL UA_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%UA, ErrStat2, ErrMsg2 ) ! UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + SUBROUTINE BEMT_DestroyParam( ParamData, ErrStat, ErrMsg ) + TYPE(BEMT_ParameterType), INTENT(INOUT) :: ParamData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_DestroyParam' - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL DBEMT_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%DBEMT, ErrStat2, ErrMsg2 ) ! DBEMT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + ErrStat = ErrID_None + ErrMsg = "" + +IF (ALLOCATED(ParamData%chord)) THEN + DEALLOCATE(ParamData%chord) +ENDIF +IF (ALLOCATED(ParamData%AFindx)) THEN + DEALLOCATE(ParamData%AFindx) +ENDIF +IF (ALLOCATED(ParamData%tipLossConst)) THEN + DEALLOCATE(ParamData%tipLossConst) +ENDIF +IF (ALLOCATED(ParamData%hubLossConst)) THEN + DEALLOCATE(ParamData%hubLossConst) +ENDIF +IF (ALLOCATED(ParamData%zHub)) THEN + DEALLOCATE(ParamData%zHub) +ENDIF + CALL UA_DestroyParam( ParamData%UA, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL DBEMT_DestroyParam( ParamData%DBEMT, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(ParamData%FixedInductions)) THEN + DEALLOCATE(ParamData%FixedInductions) +ENDIF +IF (ALLOCATED(ParamData%IntegrateWeight)) THEN + DEALLOCATE(ParamData%IntegrateWeight) +ENDIF + END SUBROUTINE BEMT_DestroyParam - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%UA_Flag = TRANSFER(IntKiBuf(Int_Xferred), OutData%UA_Flag) - Int_Xferred = Int_Xferred + 1 - OutData%DBEMT_Mod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%yawCorrFactor = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FixedInductions not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FixedInductions)) DEALLOCATE(OutData%FixedInductions) - ALLOCATE(OutData%FixedInductions(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FixedInductions.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FixedInductions,2), UBOUND(OutData%FixedInductions,2) - DO i1 = LBOUND(OutData%FixedInductions,1), UBOUND(OutData%FixedInductions,1) - OutData%FixedInductions(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%FixedInductions(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - OutData%MomentumCorr = TRANSFER(IntKiBuf(Int_Xferred), OutData%MomentumCorr) - Int_Xferred = Int_Xferred + 1 - OutData%rTipFixMax = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IntegrateWeight not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IntegrateWeight)) DEALLOCATE(OutData%IntegrateWeight) - ALLOCATE(OutData%IntegrateWeight(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IntegrateWeight.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%IntegrateWeight,2), UBOUND(OutData%IntegrateWeight,2) - DO i1 = LBOUND(OutData%IntegrateWeight,1), UBOUND(OutData%IntegrateWeight,1) - OutData%IntegrateWeight(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%lin_nx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%BEM_Mod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE BEMT_UnPackParam +subroutine BEMT_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BEMT_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BEMT_PackParam' + if (Buf%ErrStat >= AbortErrLev) return + ! DT + call RegPack(Buf, InData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! chord + call RegPack(Buf, allocated(InData%chord)) + if (allocated(InData%chord)) then + call RegPackBounds(Buf, 2, lbound(InData%chord), ubound(InData%chord)) + call RegPack(Buf, InData%chord) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! numBlades + call RegPack(Buf, InData%numBlades) + if (RegCheckErr(Buf, RoutineName)) return + ! airDens + call RegPack(Buf, InData%airDens) + if (RegCheckErr(Buf, RoutineName)) return + ! kinVisc + call RegPack(Buf, InData%kinVisc) + if (RegCheckErr(Buf, RoutineName)) return + ! skewWakeMod + call RegPack(Buf, InData%skewWakeMod) + if (RegCheckErr(Buf, RoutineName)) return + ! aTol + call RegPack(Buf, InData%aTol) + if (RegCheckErr(Buf, RoutineName)) return + ! useTipLoss + call RegPack(Buf, InData%useTipLoss) + if (RegCheckErr(Buf, RoutineName)) return + ! useHubLoss + call RegPack(Buf, InData%useHubLoss) + if (RegCheckErr(Buf, RoutineName)) return + ! useInduction + call RegPack(Buf, InData%useInduction) + if (RegCheckErr(Buf, RoutineName)) return + ! useTanInd + call RegPack(Buf, InData%useTanInd) + if (RegCheckErr(Buf, RoutineName)) return + ! useAIDrag + call RegPack(Buf, InData%useAIDrag) + if (RegCheckErr(Buf, RoutineName)) return + ! useTIDrag + call RegPack(Buf, InData%useTIDrag) + if (RegCheckErr(Buf, RoutineName)) return + ! numBladeNodes + call RegPack(Buf, InData%numBladeNodes) + if (RegCheckErr(Buf, RoutineName)) return + ! numReIterations + call RegPack(Buf, InData%numReIterations) + if (RegCheckErr(Buf, RoutineName)) return + ! maxIndIterations + call RegPack(Buf, InData%maxIndIterations) + if (RegCheckErr(Buf, RoutineName)) return + ! AFindx + call RegPack(Buf, allocated(InData%AFindx)) + if (allocated(InData%AFindx)) then + call RegPackBounds(Buf, 2, lbound(InData%AFindx), ubound(InData%AFindx)) + call RegPack(Buf, InData%AFindx) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! tipLossConst + call RegPack(Buf, allocated(InData%tipLossConst)) + if (allocated(InData%tipLossConst)) then + call RegPackBounds(Buf, 2, lbound(InData%tipLossConst), ubound(InData%tipLossConst)) + call RegPack(Buf, InData%tipLossConst) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! hubLossConst + call RegPack(Buf, allocated(InData%hubLossConst)) + if (allocated(InData%hubLossConst)) then + call RegPackBounds(Buf, 2, lbound(InData%hubLossConst), ubound(InData%hubLossConst)) + call RegPack(Buf, InData%hubLossConst) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! zHub + call RegPack(Buf, allocated(InData%zHub)) + if (allocated(InData%zHub)) then + call RegPackBounds(Buf, 1, lbound(InData%zHub), ubound(InData%zHub)) + call RegPack(Buf, InData%zHub) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! UA + call UA_PackParam(Buf, InData%UA) + if (RegCheckErr(Buf, RoutineName)) return + ! DBEMT + call DBEMT_PackParam(Buf, InData%DBEMT) + if (RegCheckErr(Buf, RoutineName)) return + ! UA_Flag + call RegPack(Buf, InData%UA_Flag) + if (RegCheckErr(Buf, RoutineName)) return + ! DBEMT_Mod + call RegPack(Buf, InData%DBEMT_Mod) + if (RegCheckErr(Buf, RoutineName)) return + ! yawCorrFactor + call RegPack(Buf, InData%yawCorrFactor) + if (RegCheckErr(Buf, RoutineName)) return + ! FixedInductions + call RegPack(Buf, allocated(InData%FixedInductions)) + if (allocated(InData%FixedInductions)) then + call RegPackBounds(Buf, 2, lbound(InData%FixedInductions), ubound(InData%FixedInductions)) + call RegPack(Buf, InData%FixedInductions) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MomentumCorr + call RegPack(Buf, InData%MomentumCorr) + if (RegCheckErr(Buf, RoutineName)) return + ! rTipFixMax + call RegPack(Buf, InData%rTipFixMax) + if (RegCheckErr(Buf, RoutineName)) return + ! IntegrateWeight + call RegPack(Buf, allocated(InData%IntegrateWeight)) + if (allocated(InData%IntegrateWeight)) then + call RegPackBounds(Buf, 2, lbound(InData%IntegrateWeight), ubound(InData%IntegrateWeight)) + call RegPack(Buf, InData%IntegrateWeight) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! lin_nx + call RegPack(Buf, InData%lin_nx) + if (RegCheckErr(Buf, RoutineName)) return + ! BEM_Mod + call RegPack(Buf, InData%BEM_Mod) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BEMT_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BEMT_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BEMT_UnPackParam' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! DT + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! chord + if (allocated(OutData%chord)) deallocate(OutData%chord) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%chord(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%chord.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%chord) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! numBlades + call RegUnpack(Buf, OutData%numBlades) + if (RegCheckErr(Buf, RoutineName)) return + ! airDens + call RegUnpack(Buf, OutData%airDens) + if (RegCheckErr(Buf, RoutineName)) return + ! kinVisc + call RegUnpack(Buf, OutData%kinVisc) + if (RegCheckErr(Buf, RoutineName)) return + ! skewWakeMod + call RegUnpack(Buf, OutData%skewWakeMod) + if (RegCheckErr(Buf, RoutineName)) return + ! aTol + call RegUnpack(Buf, OutData%aTol) + if (RegCheckErr(Buf, RoutineName)) return + ! useTipLoss + call RegUnpack(Buf, OutData%useTipLoss) + if (RegCheckErr(Buf, RoutineName)) return + ! useHubLoss + call RegUnpack(Buf, OutData%useHubLoss) + if (RegCheckErr(Buf, RoutineName)) return + ! useInduction + call RegUnpack(Buf, OutData%useInduction) + if (RegCheckErr(Buf, RoutineName)) return + ! useTanInd + call RegUnpack(Buf, OutData%useTanInd) + if (RegCheckErr(Buf, RoutineName)) return + ! useAIDrag + call RegUnpack(Buf, OutData%useAIDrag) + if (RegCheckErr(Buf, RoutineName)) return + ! useTIDrag + call RegUnpack(Buf, OutData%useTIDrag) + if (RegCheckErr(Buf, RoutineName)) return + ! numBladeNodes + call RegUnpack(Buf, OutData%numBladeNodes) + if (RegCheckErr(Buf, RoutineName)) return + ! numReIterations + call RegUnpack(Buf, OutData%numReIterations) + if (RegCheckErr(Buf, RoutineName)) return + ! maxIndIterations + call RegUnpack(Buf, OutData%maxIndIterations) + if (RegCheckErr(Buf, RoutineName)) return + ! AFindx + if (allocated(OutData%AFindx)) deallocate(OutData%AFindx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AFindx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFindx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AFindx) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! tipLossConst + if (allocated(OutData%tipLossConst)) deallocate(OutData%tipLossConst) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%tipLossConst(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%tipLossConst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%tipLossConst) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! hubLossConst + if (allocated(OutData%hubLossConst)) deallocate(OutData%hubLossConst) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%hubLossConst(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%hubLossConst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%hubLossConst) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! zHub + if (allocated(OutData%zHub)) deallocate(OutData%zHub) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%zHub(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%zHub.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%zHub) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! UA + call UA_UnpackParam(Buf, OutData%UA) ! UA + ! DBEMT + call DBEMT_UnpackParam(Buf, OutData%DBEMT) ! DBEMT + ! UA_Flag + call RegUnpack(Buf, OutData%UA_Flag) + if (RegCheckErr(Buf, RoutineName)) return + ! DBEMT_Mod + call RegUnpack(Buf, OutData%DBEMT_Mod) + if (RegCheckErr(Buf, RoutineName)) return + ! yawCorrFactor + call RegUnpack(Buf, OutData%yawCorrFactor) + if (RegCheckErr(Buf, RoutineName)) return + ! FixedInductions + if (allocated(OutData%FixedInductions)) deallocate(OutData%FixedInductions) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FixedInductions(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FixedInductions.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FixedInductions) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! MomentumCorr + call RegUnpack(Buf, OutData%MomentumCorr) + if (RegCheckErr(Buf, RoutineName)) return + ! rTipFixMax + call RegUnpack(Buf, OutData%rTipFixMax) + if (RegCheckErr(Buf, RoutineName)) return + ! IntegrateWeight + if (allocated(OutData%IntegrateWeight)) deallocate(OutData%IntegrateWeight) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IntegrateWeight(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IntegrateWeight.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IntegrateWeight) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! lin_nx + call RegUnpack(Buf, OutData%lin_nx) + if (RegCheckErr(Buf, RoutineName)) return + ! BEM_Mod + call RegUnpack(Buf, OutData%BEM_Mod) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE BEMT_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(BEMT_InputType), INTENT(IN) :: SrcInputData TYPE(BEMT_InputType), INTENT(INOUT) :: DstInputData @@ -5049,713 +2556,329 @@ SUBROUTINE BEMT_DestroyInput( InputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE BEMT_DestroyInput - SUBROUTINE BEMT_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(BEMT_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! theta allocated yes/no - IF ( ALLOCATED(InData%theta) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! theta upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%theta) ! theta - END IF - Re_BufSz = Re_BufSz + 1 ! chi0 - Re_BufSz = Re_BufSz + 1 ! psiSkewOffset - Int_BufSz = Int_BufSz + 1 ! psi allocated yes/no - IF ( ALLOCATED(InData%psi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! psi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%psi) ! psi - END IF - Re_BufSz = Re_BufSz + 1 ! omega - Re_BufSz = Re_BufSz + 1 ! TSR - Int_BufSz = Int_BufSz + 1 ! Vx allocated yes/no - IF ( ALLOCATED(InData%Vx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vx upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vx) ! Vx - END IF - Int_BufSz = Int_BufSz + 1 ! Vy allocated yes/no - IF ( ALLOCATED(InData%Vy) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vy upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vy) ! Vy - END IF - Int_BufSz = Int_BufSz + 1 ! Vz allocated yes/no - IF ( ALLOCATED(InData%Vz) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vz upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vz) ! Vz - END IF - Int_BufSz = Int_BufSz + 1 ! omega_z allocated yes/no - IF ( ALLOCATED(InData%omega_z) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! omega_z upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%omega_z) ! omega_z - END IF - Int_BufSz = Int_BufSz + 1 ! xVelCorr allocated yes/no - IF ( ALLOCATED(InData%xVelCorr) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! xVelCorr upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%xVelCorr) ! xVelCorr - END IF - Int_BufSz = Int_BufSz + 1 ! rLocal allocated yes/no - IF ( ALLOCATED(InData%rLocal) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! rLocal upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rLocal) ! rLocal - END IF - Re_BufSz = Re_BufSz + 1 ! Un_disk - Re_BufSz = Re_BufSz + SIZE(InData%V0) ! V0 - Db_BufSz = Db_BufSz + SIZE(InData%x_hat_disk) ! x_hat_disk - Int_BufSz = Int_BufSz + 1 ! UserProp allocated yes/no - IF ( ALLOCATED(InData%UserProp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! UserProp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%UserProp) ! UserProp - END IF - Int_BufSz = Int_BufSz + 1 ! CantAngle allocated yes/no - IF ( ALLOCATED(InData%CantAngle) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CantAngle upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CantAngle) ! CantAngle - END IF - Int_BufSz = Int_BufSz + 1 ! drdz allocated yes/no - IF ( ALLOCATED(InData%drdz) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! drdz upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%drdz) ! drdz - END IF - Int_BufSz = Int_BufSz + 1 ! toeAngle allocated yes/no - IF ( ALLOCATED(InData%toeAngle) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! toeAngle upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%toeAngle) ! toeAngle - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%theta) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%theta,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%theta,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%theta,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%theta,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%theta,2), UBOUND(InData%theta,2) - DO i1 = LBOUND(InData%theta,1), UBOUND(InData%theta,1) - ReKiBuf(Re_Xferred) = InData%theta(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%chi0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%psiSkewOffset - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%psi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%psi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%psi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%psi,1), UBOUND(InData%psi,1) - ReKiBuf(Re_Xferred) = InData%psi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%omega - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TSR - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Vx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vx,2), UBOUND(InData%Vx,2) - DO i1 = LBOUND(InData%Vx,1), UBOUND(InData%Vx,1) - ReKiBuf(Re_Xferred) = InData%Vx(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vy) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vy,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vy,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vy,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vy,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vy,2), UBOUND(InData%Vy,2) - DO i1 = LBOUND(InData%Vy,1), UBOUND(InData%Vy,1) - ReKiBuf(Re_Xferred) = InData%Vy(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vz) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vz,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vz,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vz,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vz,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vz,2), UBOUND(InData%Vz,2) - DO i1 = LBOUND(InData%Vz,1), UBOUND(InData%Vz,1) - ReKiBuf(Re_Xferred) = InData%Vz(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%omega_z) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%omega_z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%omega_z,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%omega_z,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%omega_z,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%omega_z,2), UBOUND(InData%omega_z,2) - DO i1 = LBOUND(InData%omega_z,1), UBOUND(InData%omega_z,1) - ReKiBuf(Re_Xferred) = InData%omega_z(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%xVelCorr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xVelCorr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xVelCorr,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xVelCorr,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xVelCorr,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%xVelCorr,2), UBOUND(InData%xVelCorr,2) - DO i1 = LBOUND(InData%xVelCorr,1), UBOUND(InData%xVelCorr,1) - ReKiBuf(Re_Xferred) = InData%xVelCorr(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rLocal) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rLocal,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rLocal,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rLocal,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rLocal,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%rLocal,2), UBOUND(InData%rLocal,2) - DO i1 = LBOUND(InData%rLocal,1), UBOUND(InData%rLocal,1) - ReKiBuf(Re_Xferred) = InData%rLocal(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%Un_disk - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%V0,1), UBOUND(InData%V0,1) - ReKiBuf(Re_Xferred) = InData%V0(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%x_hat_disk,1), UBOUND(InData%x_hat_disk,1) - DbKiBuf(Db_Xferred) = InData%x_hat_disk(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%UserProp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UserProp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UserProp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UserProp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UserProp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%UserProp,2), UBOUND(InData%UserProp,2) - DO i1 = LBOUND(InData%UserProp,1), UBOUND(InData%UserProp,1) - ReKiBuf(Re_Xferred) = InData%UserProp(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CantAngle) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CantAngle,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CantAngle,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CantAngle,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CantAngle,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CantAngle,2), UBOUND(InData%CantAngle,2) - DO i1 = LBOUND(InData%CantAngle,1), UBOUND(InData%CantAngle,1) - ReKiBuf(Re_Xferred) = InData%CantAngle(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%drdz) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%drdz,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%drdz,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%drdz,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%drdz,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%drdz,2), UBOUND(InData%drdz,2) - DO i1 = LBOUND(InData%drdz,1), UBOUND(InData%drdz,1) - ReKiBuf(Re_Xferred) = InData%drdz(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%toeAngle) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%toeAngle,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%toeAngle,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%toeAngle,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%toeAngle,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%toeAngle,2), UBOUND(InData%toeAngle,2) - DO i1 = LBOUND(InData%toeAngle,1), UBOUND(InData%toeAngle,1) - ReKiBuf(Re_Xferred) = InData%toeAngle(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE BEMT_PackInput - - SUBROUTINE BEMT_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(BEMT_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! theta not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%theta)) DEALLOCATE(OutData%theta) - ALLOCATE(OutData%theta(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%theta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%theta,2), UBOUND(OutData%theta,2) - DO i1 = LBOUND(OutData%theta,1), UBOUND(OutData%theta,1) - OutData%theta(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%chi0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%psiSkewOffset = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! psi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%psi)) DEALLOCATE(OutData%psi) - ALLOCATE(OutData%psi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%psi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%psi,1), UBOUND(OutData%psi,1) - OutData%psi(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%omega = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TSR = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vx)) DEALLOCATE(OutData%Vx) - ALLOCATE(OutData%Vx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vx,2), UBOUND(OutData%Vx,2) - DO i1 = LBOUND(OutData%Vx,1), UBOUND(OutData%Vx,1) - OutData%Vx(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vy not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vy)) DEALLOCATE(OutData%Vy) - ALLOCATE(OutData%Vy(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vy,2), UBOUND(OutData%Vy,2) - DO i1 = LBOUND(OutData%Vy,1), UBOUND(OutData%Vy,1) - OutData%Vy(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vz not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vz)) DEALLOCATE(OutData%Vz) - ALLOCATE(OutData%Vz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vz,2), UBOUND(OutData%Vz,2) - DO i1 = LBOUND(OutData%Vz,1), UBOUND(OutData%Vz,1) - OutData%Vz(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! omega_z not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%omega_z)) DEALLOCATE(OutData%omega_z) - ALLOCATE(OutData%omega_z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%omega_z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%omega_z,2), UBOUND(OutData%omega_z,2) - DO i1 = LBOUND(OutData%omega_z,1), UBOUND(OutData%omega_z,1) - OutData%omega_z(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xVelCorr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%xVelCorr)) DEALLOCATE(OutData%xVelCorr) - ALLOCATE(OutData%xVelCorr(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xVelCorr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%xVelCorr,2), UBOUND(OutData%xVelCorr,2) - DO i1 = LBOUND(OutData%xVelCorr,1), UBOUND(OutData%xVelCorr,1) - OutData%xVelCorr(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rLocal not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rLocal)) DEALLOCATE(OutData%rLocal) - ALLOCATE(OutData%rLocal(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rLocal.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%rLocal,2), UBOUND(OutData%rLocal,2) - DO i1 = LBOUND(OutData%rLocal,1), UBOUND(OutData%rLocal,1) - OutData%rLocal(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%Un_disk = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%V0,1) - i1_u = UBOUND(OutData%V0,1) - DO i1 = LBOUND(OutData%V0,1), UBOUND(OutData%V0,1) - OutData%V0(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%x_hat_disk,1) - i1_u = UBOUND(OutData%x_hat_disk,1) - DO i1 = LBOUND(OutData%x_hat_disk,1), UBOUND(OutData%x_hat_disk,1) - OutData%x_hat_disk(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UserProp not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%UserProp)) DEALLOCATE(OutData%UserProp) - ALLOCATE(OutData%UserProp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UserProp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%UserProp,2), UBOUND(OutData%UserProp,2) - DO i1 = LBOUND(OutData%UserProp,1), UBOUND(OutData%UserProp,1) - OutData%UserProp(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CantAngle not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CantAngle)) DEALLOCATE(OutData%CantAngle) - ALLOCATE(OutData%CantAngle(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CantAngle.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CantAngle,2), UBOUND(OutData%CantAngle,2) - DO i1 = LBOUND(OutData%CantAngle,1), UBOUND(OutData%CantAngle,1) - OutData%CantAngle(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! drdz not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%drdz)) DEALLOCATE(OutData%drdz) - ALLOCATE(OutData%drdz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%drdz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%drdz,2), UBOUND(OutData%drdz,2) - DO i1 = LBOUND(OutData%drdz,1), UBOUND(OutData%drdz,1) - OutData%drdz(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! toeAngle not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%toeAngle)) DEALLOCATE(OutData%toeAngle) - ALLOCATE(OutData%toeAngle(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%toeAngle.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%toeAngle,2), UBOUND(OutData%toeAngle,2) - DO i1 = LBOUND(OutData%toeAngle,1), UBOUND(OutData%toeAngle,1) - OutData%toeAngle(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE BEMT_UnPackInput +subroutine BEMT_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BEMT_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BEMT_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + ! theta + call RegPack(Buf, allocated(InData%theta)) + if (allocated(InData%theta)) then + call RegPackBounds(Buf, 2, lbound(InData%theta), ubound(InData%theta)) + call RegPack(Buf, InData%theta) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! chi0 + call RegPack(Buf, InData%chi0) + if (RegCheckErr(Buf, RoutineName)) return + ! psiSkewOffset + call RegPack(Buf, InData%psiSkewOffset) + if (RegCheckErr(Buf, RoutineName)) return + ! psi + call RegPack(Buf, allocated(InData%psi)) + if (allocated(InData%psi)) then + call RegPackBounds(Buf, 1, lbound(InData%psi), ubound(InData%psi)) + call RegPack(Buf, InData%psi) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! omega + call RegPack(Buf, InData%omega) + if (RegCheckErr(Buf, RoutineName)) return + ! TSR + call RegPack(Buf, InData%TSR) + if (RegCheckErr(Buf, RoutineName)) return + ! Vx + call RegPack(Buf, allocated(InData%Vx)) + if (allocated(InData%Vx)) then + call RegPackBounds(Buf, 2, lbound(InData%Vx), ubound(InData%Vx)) + call RegPack(Buf, InData%Vx) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Vy + call RegPack(Buf, allocated(InData%Vy)) + if (allocated(InData%Vy)) then + call RegPackBounds(Buf, 2, lbound(InData%Vy), ubound(InData%Vy)) + call RegPack(Buf, InData%Vy) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Vz + call RegPack(Buf, allocated(InData%Vz)) + if (allocated(InData%Vz)) then + call RegPackBounds(Buf, 2, lbound(InData%Vz), ubound(InData%Vz)) + call RegPack(Buf, InData%Vz) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! omega_z + call RegPack(Buf, allocated(InData%omega_z)) + if (allocated(InData%omega_z)) then + call RegPackBounds(Buf, 2, lbound(InData%omega_z), ubound(InData%omega_z)) + call RegPack(Buf, InData%omega_z) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! xVelCorr + call RegPack(Buf, allocated(InData%xVelCorr)) + if (allocated(InData%xVelCorr)) then + call RegPackBounds(Buf, 2, lbound(InData%xVelCorr), ubound(InData%xVelCorr)) + call RegPack(Buf, InData%xVelCorr) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! rLocal + call RegPack(Buf, allocated(InData%rLocal)) + if (allocated(InData%rLocal)) then + call RegPackBounds(Buf, 2, lbound(InData%rLocal), ubound(InData%rLocal)) + call RegPack(Buf, InData%rLocal) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Un_disk + call RegPack(Buf, InData%Un_disk) + if (RegCheckErr(Buf, RoutineName)) return + ! V0 + call RegPack(Buf, InData%V0) + if (RegCheckErr(Buf, RoutineName)) return + ! x_hat_disk + call RegPack(Buf, InData%x_hat_disk) + if (RegCheckErr(Buf, RoutineName)) return + ! UserProp + call RegPack(Buf, allocated(InData%UserProp)) + if (allocated(InData%UserProp)) then + call RegPackBounds(Buf, 2, lbound(InData%UserProp), ubound(InData%UserProp)) + call RegPack(Buf, InData%UserProp) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CantAngle + call RegPack(Buf, allocated(InData%CantAngle)) + if (allocated(InData%CantAngle)) then + call RegPackBounds(Buf, 2, lbound(InData%CantAngle), ubound(InData%CantAngle)) + call RegPack(Buf, InData%CantAngle) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! drdz + call RegPack(Buf, allocated(InData%drdz)) + if (allocated(InData%drdz)) then + call RegPackBounds(Buf, 2, lbound(InData%drdz), ubound(InData%drdz)) + call RegPack(Buf, InData%drdz) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! toeAngle + call RegPack(Buf, allocated(InData%toeAngle)) + if (allocated(InData%toeAngle)) then + call RegPackBounds(Buf, 2, lbound(InData%toeAngle), ubound(InData%toeAngle)) + call RegPack(Buf, InData%toeAngle) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BEMT_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BEMT_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BEMT_UnPackInput' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! theta + if (allocated(OutData%theta)) deallocate(OutData%theta) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%theta(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%theta.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%theta) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! chi0 + call RegUnpack(Buf, OutData%chi0) + if (RegCheckErr(Buf, RoutineName)) return + ! psiSkewOffset + call RegUnpack(Buf, OutData%psiSkewOffset) + if (RegCheckErr(Buf, RoutineName)) return + ! psi + if (allocated(OutData%psi)) deallocate(OutData%psi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%psi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%psi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%psi) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! omega + call RegUnpack(Buf, OutData%omega) + if (RegCheckErr(Buf, RoutineName)) return + ! TSR + call RegUnpack(Buf, OutData%TSR) + if (RegCheckErr(Buf, RoutineName)) return + ! Vx + if (allocated(OutData%Vx)) deallocate(OutData%Vx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vx) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Vy + if (allocated(OutData%Vy)) deallocate(OutData%Vy) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vy(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vy.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vy) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Vz + if (allocated(OutData%Vz)) deallocate(OutData%Vz) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vz(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vz) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! omega_z + if (allocated(OutData%omega_z)) deallocate(OutData%omega_z) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%omega_z(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%omega_z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%omega_z) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! xVelCorr + if (allocated(OutData%xVelCorr)) deallocate(OutData%xVelCorr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xVelCorr(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xVelCorr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%xVelCorr) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! rLocal + if (allocated(OutData%rLocal)) deallocate(OutData%rLocal) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rLocal(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rLocal.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rLocal) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Un_disk + call RegUnpack(Buf, OutData%Un_disk) + if (RegCheckErr(Buf, RoutineName)) return + ! V0 + call RegUnpack(Buf, OutData%V0) + if (RegCheckErr(Buf, RoutineName)) return + ! x_hat_disk + call RegUnpack(Buf, OutData%x_hat_disk) + if (RegCheckErr(Buf, RoutineName)) return + ! UserProp + if (allocated(OutData%UserProp)) deallocate(OutData%UserProp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%UserProp(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UserProp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%UserProp) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CantAngle + if (allocated(OutData%CantAngle)) deallocate(OutData%CantAngle) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CantAngle(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CantAngle.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CantAngle) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! drdz + if (allocated(OutData%drdz)) deallocate(OutData%drdz) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%drdz(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%drdz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%drdz) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! toeAngle + if (allocated(OutData%toeAngle)) deallocate(OutData%toeAngle) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%toeAngle(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%toeAngle.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%toeAngle) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE BEMT_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(BEMT_OutputType), INTENT(IN) :: SrcOutputData TYPE(BEMT_OutputType), INTENT(INOUT) :: DstOutputData @@ -6078,916 +3201,397 @@ SUBROUTINE BEMT_DestroyOutput( OutputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE BEMT_DestroyOutput - SUBROUTINE BEMT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(BEMT_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! Vrel allocated yes/no - IF ( ALLOCATED(InData%Vrel) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vrel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vrel) ! Vrel - END IF - Int_BufSz = Int_BufSz + 1 ! phi allocated yes/no - IF ( ALLOCATED(InData%phi) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! phi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%phi) ! phi - END IF - Int_BufSz = Int_BufSz + 1 ! axInduction allocated yes/no - IF ( ALLOCATED(InData%axInduction) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! axInduction upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%axInduction) ! axInduction - END IF - Int_BufSz = Int_BufSz + 1 ! tanInduction allocated yes/no - IF ( ALLOCATED(InData%tanInduction) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! tanInduction upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%tanInduction) ! tanInduction - END IF - Int_BufSz = Int_BufSz + 1 ! Re allocated yes/no - IF ( ALLOCATED(InData%Re) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Re upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Re) ! Re - END IF - Int_BufSz = Int_BufSz + 1 ! AOA allocated yes/no - IF ( ALLOCATED(InData%AOA) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AOA upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AOA) ! AOA - END IF - Int_BufSz = Int_BufSz + 1 ! Cx allocated yes/no - IF ( ALLOCATED(InData%Cx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Cx upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cx) ! Cx - END IF - Int_BufSz = Int_BufSz + 1 ! Cy allocated yes/no - IF ( ALLOCATED(InData%Cy) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Cy upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cy) ! Cy - END IF - Int_BufSz = Int_BufSz + 1 ! Cz allocated yes/no - IF ( ALLOCATED(InData%Cz) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Cz upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cz) ! Cz - END IF - Int_BufSz = Int_BufSz + 1 ! Cmx allocated yes/no - IF ( ALLOCATED(InData%Cmx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Cmx upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cmx) ! Cmx - END IF - Int_BufSz = Int_BufSz + 1 ! Cmy allocated yes/no - IF ( ALLOCATED(InData%Cmy) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Cmy upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cmy) ! Cmy - END IF - Int_BufSz = Int_BufSz + 1 ! Cmz allocated yes/no - IF ( ALLOCATED(InData%Cmz) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Cmz upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cmz) ! Cmz - END IF - Int_BufSz = Int_BufSz + 1 ! Cm allocated yes/no - IF ( ALLOCATED(InData%Cm) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Cm upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cm) ! Cm - END IF - Int_BufSz = Int_BufSz + 1 ! Cl allocated yes/no - IF ( ALLOCATED(InData%Cl) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Cl upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cl) ! Cl - END IF - Int_BufSz = Int_BufSz + 1 ! Cd allocated yes/no - IF ( ALLOCATED(InData%Cd) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Cd upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cd) ! Cd - END IF - Int_BufSz = Int_BufSz + 1 ! chi allocated yes/no - IF ( ALLOCATED(InData%chi) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! chi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%chi) ! chi - END IF - Int_BufSz = Int_BufSz + 1 ! Cpmin allocated yes/no - IF ( ALLOCATED(InData%Cpmin) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Cpmin upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cpmin) ! Cpmin - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%Vrel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vrel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vrel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vrel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vrel,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vrel,2), UBOUND(InData%Vrel,2) - DO i1 = LBOUND(InData%Vrel,1), UBOUND(InData%Vrel,1) - ReKiBuf(Re_Xferred) = InData%Vrel(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%phi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%phi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%phi,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%phi,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%phi,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%phi,2), UBOUND(InData%phi,2) - DO i1 = LBOUND(InData%phi,1), UBOUND(InData%phi,1) - ReKiBuf(Re_Xferred) = InData%phi(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%axInduction) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%axInduction,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%axInduction,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%axInduction,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%axInduction,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%axInduction,2), UBOUND(InData%axInduction,2) - DO i1 = LBOUND(InData%axInduction,1), UBOUND(InData%axInduction,1) - ReKiBuf(Re_Xferred) = InData%axInduction(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%tanInduction) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%tanInduction,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tanInduction,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%tanInduction,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tanInduction,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%tanInduction,2), UBOUND(InData%tanInduction,2) - DO i1 = LBOUND(InData%tanInduction,1), UBOUND(InData%tanInduction,1) - ReKiBuf(Re_Xferred) = InData%tanInduction(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Re) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Re,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Re,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Re,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Re,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Re,2), UBOUND(InData%Re,2) - DO i1 = LBOUND(InData%Re,1), UBOUND(InData%Re,1) - ReKiBuf(Re_Xferred) = InData%Re(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AOA) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AOA,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AOA,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AOA,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AOA,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AOA,2), UBOUND(InData%AOA,2) - DO i1 = LBOUND(InData%AOA,1), UBOUND(InData%AOA,1) - ReKiBuf(Re_Xferred) = InData%AOA(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Cx,2), UBOUND(InData%Cx,2) - DO i1 = LBOUND(InData%Cx,1), UBOUND(InData%Cx,1) - ReKiBuf(Re_Xferred) = InData%Cx(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cy) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cy,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cy,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cy,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cy,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Cy,2), UBOUND(InData%Cy,2) - DO i1 = LBOUND(InData%Cy,1), UBOUND(InData%Cy,1) - ReKiBuf(Re_Xferred) = InData%Cy(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cz) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cz,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cz,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cz,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cz,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Cz,2), UBOUND(InData%Cz,2) - DO i1 = LBOUND(InData%Cz,1), UBOUND(InData%Cz,1) - ReKiBuf(Re_Xferred) = InData%Cz(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cmx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cmx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cmx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cmx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cmx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Cmx,2), UBOUND(InData%Cmx,2) - DO i1 = LBOUND(InData%Cmx,1), UBOUND(InData%Cmx,1) - ReKiBuf(Re_Xferred) = InData%Cmx(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cmy) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cmy,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cmy,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cmy,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cmy,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Cmy,2), UBOUND(InData%Cmy,2) - DO i1 = LBOUND(InData%Cmy,1), UBOUND(InData%Cmy,1) - ReKiBuf(Re_Xferred) = InData%Cmy(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cmz) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cmz,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cmz,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cmz,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cmz,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Cmz,2), UBOUND(InData%Cmz,2) - DO i1 = LBOUND(InData%Cmz,1), UBOUND(InData%Cmz,1) - ReKiBuf(Re_Xferred) = InData%Cmz(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cm) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cm,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cm,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cm,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Cm,2), UBOUND(InData%Cm,2) - DO i1 = LBOUND(InData%Cm,1), UBOUND(InData%Cm,1) - ReKiBuf(Re_Xferred) = InData%Cm(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cl) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cl,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cl,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cl,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cl,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Cl,2), UBOUND(InData%Cl,2) - DO i1 = LBOUND(InData%Cl,1), UBOUND(InData%Cl,1) - ReKiBuf(Re_Xferred) = InData%Cl(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cd,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Cd,2), UBOUND(InData%Cd,2) - DO i1 = LBOUND(InData%Cd,1), UBOUND(InData%Cd,1) - ReKiBuf(Re_Xferred) = InData%Cd(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%chi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%chi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chi,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%chi,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chi,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%chi,2), UBOUND(InData%chi,2) - DO i1 = LBOUND(InData%chi,1), UBOUND(InData%chi,1) - ReKiBuf(Re_Xferred) = InData%chi(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cpmin) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cpmin,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cpmin,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cpmin,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cpmin,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Cpmin,2), UBOUND(InData%Cpmin,2) - DO i1 = LBOUND(InData%Cpmin,1), UBOUND(InData%Cpmin,1) - ReKiBuf(Re_Xferred) = InData%Cpmin(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE BEMT_PackOutput - - SUBROUTINE BEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(BEMT_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vrel not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vrel)) DEALLOCATE(OutData%Vrel) - ALLOCATE(OutData%Vrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vrel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vrel,2), UBOUND(OutData%Vrel,2) - DO i1 = LBOUND(OutData%Vrel,1), UBOUND(OutData%Vrel,1) - OutData%Vrel(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! phi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%phi)) DEALLOCATE(OutData%phi) - ALLOCATE(OutData%phi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%phi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%phi,2), UBOUND(OutData%phi,2) - DO i1 = LBOUND(OutData%phi,1), UBOUND(OutData%phi,1) - OutData%phi(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! axInduction not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%axInduction)) DEALLOCATE(OutData%axInduction) - ALLOCATE(OutData%axInduction(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%axInduction.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%axInduction,2), UBOUND(OutData%axInduction,2) - DO i1 = LBOUND(OutData%axInduction,1), UBOUND(OutData%axInduction,1) - OutData%axInduction(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! tanInduction not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%tanInduction)) DEALLOCATE(OutData%tanInduction) - ALLOCATE(OutData%tanInduction(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%tanInduction.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%tanInduction,2), UBOUND(OutData%tanInduction,2) - DO i1 = LBOUND(OutData%tanInduction,1), UBOUND(OutData%tanInduction,1) - OutData%tanInduction(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Re not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Re)) DEALLOCATE(OutData%Re) - ALLOCATE(OutData%Re(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Re.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Re,2), UBOUND(OutData%Re,2) - DO i1 = LBOUND(OutData%Re,1), UBOUND(OutData%Re,1) - OutData%Re(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AOA not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AOA)) DEALLOCATE(OutData%AOA) - ALLOCATE(OutData%AOA(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AOA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AOA,2), UBOUND(OutData%AOA,2) - DO i1 = LBOUND(OutData%AOA,1), UBOUND(OutData%AOA,1) - OutData%AOA(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Cx)) DEALLOCATE(OutData%Cx) - ALLOCATE(OutData%Cx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Cx,2), UBOUND(OutData%Cx,2) - DO i1 = LBOUND(OutData%Cx,1), UBOUND(OutData%Cx,1) - OutData%Cx(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cy not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Cy)) DEALLOCATE(OutData%Cy) - ALLOCATE(OutData%Cy(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Cy,2), UBOUND(OutData%Cy,2) - DO i1 = LBOUND(OutData%Cy,1), UBOUND(OutData%Cy,1) - OutData%Cy(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cz not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Cz)) DEALLOCATE(OutData%Cz) - ALLOCATE(OutData%Cz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Cz,2), UBOUND(OutData%Cz,2) - DO i1 = LBOUND(OutData%Cz,1), UBOUND(OutData%Cz,1) - OutData%Cz(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cmx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Cmx)) DEALLOCATE(OutData%Cmx) - ALLOCATE(OutData%Cmx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cmx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Cmx,2), UBOUND(OutData%Cmx,2) - DO i1 = LBOUND(OutData%Cmx,1), UBOUND(OutData%Cmx,1) - OutData%Cmx(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cmy not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Cmy)) DEALLOCATE(OutData%Cmy) - ALLOCATE(OutData%Cmy(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cmy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Cmy,2), UBOUND(OutData%Cmy,2) - DO i1 = LBOUND(OutData%Cmy,1), UBOUND(OutData%Cmy,1) - OutData%Cmy(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cmz not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Cmz)) DEALLOCATE(OutData%Cmz) - ALLOCATE(OutData%Cmz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cmz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Cmz,2), UBOUND(OutData%Cmz,2) - DO i1 = LBOUND(OutData%Cmz,1), UBOUND(OutData%Cmz,1) - OutData%Cmz(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cm not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Cm)) DEALLOCATE(OutData%Cm) - ALLOCATE(OutData%Cm(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Cm,2), UBOUND(OutData%Cm,2) - DO i1 = LBOUND(OutData%Cm,1), UBOUND(OutData%Cm,1) - OutData%Cm(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cl not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Cl)) DEALLOCATE(OutData%Cl) - ALLOCATE(OutData%Cl(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Cl,2), UBOUND(OutData%Cl,2) - DO i1 = LBOUND(OutData%Cl,1), UBOUND(OutData%Cl,1) - OutData%Cl(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cd not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Cd)) DEALLOCATE(OutData%Cd) - ALLOCATE(OutData%Cd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Cd,2), UBOUND(OutData%Cd,2) - DO i1 = LBOUND(OutData%Cd,1), UBOUND(OutData%Cd,1) - OutData%Cd(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! chi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%chi)) DEALLOCATE(OutData%chi) - ALLOCATE(OutData%chi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%chi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%chi,2), UBOUND(OutData%chi,2) - DO i1 = LBOUND(OutData%chi,1), UBOUND(OutData%chi,1) - OutData%chi(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cpmin not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Cpmin)) DEALLOCATE(OutData%Cpmin) - ALLOCATE(OutData%Cpmin(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cpmin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Cpmin,2), UBOUND(OutData%Cpmin,2) - DO i1 = LBOUND(OutData%Cpmin,1), UBOUND(OutData%Cpmin,1) - OutData%Cpmin(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE BEMT_UnPackOutput +subroutine BEMT_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BEMT_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BEMT_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! Vrel + call RegPack(Buf, allocated(InData%Vrel)) + if (allocated(InData%Vrel)) then + call RegPackBounds(Buf, 2, lbound(InData%Vrel), ubound(InData%Vrel)) + call RegPack(Buf, InData%Vrel) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! phi + call RegPack(Buf, allocated(InData%phi)) + if (allocated(InData%phi)) then + call RegPackBounds(Buf, 2, lbound(InData%phi), ubound(InData%phi)) + call RegPack(Buf, InData%phi) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! axInduction + call RegPack(Buf, allocated(InData%axInduction)) + if (allocated(InData%axInduction)) then + call RegPackBounds(Buf, 2, lbound(InData%axInduction), ubound(InData%axInduction)) + call RegPack(Buf, InData%axInduction) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! tanInduction + call RegPack(Buf, allocated(InData%tanInduction)) + if (allocated(InData%tanInduction)) then + call RegPackBounds(Buf, 2, lbound(InData%tanInduction), ubound(InData%tanInduction)) + call RegPack(Buf, InData%tanInduction) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Re + call RegPack(Buf, allocated(InData%Re)) + if (allocated(InData%Re)) then + call RegPackBounds(Buf, 2, lbound(InData%Re), ubound(InData%Re)) + call RegPack(Buf, InData%Re) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AOA + call RegPack(Buf, allocated(InData%AOA)) + if (allocated(InData%AOA)) then + call RegPackBounds(Buf, 2, lbound(InData%AOA), ubound(InData%AOA)) + call RegPack(Buf, InData%AOA) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Cx + call RegPack(Buf, allocated(InData%Cx)) + if (allocated(InData%Cx)) then + call RegPackBounds(Buf, 2, lbound(InData%Cx), ubound(InData%Cx)) + call RegPack(Buf, InData%Cx) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Cy + call RegPack(Buf, allocated(InData%Cy)) + if (allocated(InData%Cy)) then + call RegPackBounds(Buf, 2, lbound(InData%Cy), ubound(InData%Cy)) + call RegPack(Buf, InData%Cy) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Cz + call RegPack(Buf, allocated(InData%Cz)) + if (allocated(InData%Cz)) then + call RegPackBounds(Buf, 2, lbound(InData%Cz), ubound(InData%Cz)) + call RegPack(Buf, InData%Cz) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Cmx + call RegPack(Buf, allocated(InData%Cmx)) + if (allocated(InData%Cmx)) then + call RegPackBounds(Buf, 2, lbound(InData%Cmx), ubound(InData%Cmx)) + call RegPack(Buf, InData%Cmx) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Cmy + call RegPack(Buf, allocated(InData%Cmy)) + if (allocated(InData%Cmy)) then + call RegPackBounds(Buf, 2, lbound(InData%Cmy), ubound(InData%Cmy)) + call RegPack(Buf, InData%Cmy) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Cmz + call RegPack(Buf, allocated(InData%Cmz)) + if (allocated(InData%Cmz)) then + call RegPackBounds(Buf, 2, lbound(InData%Cmz), ubound(InData%Cmz)) + call RegPack(Buf, InData%Cmz) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Cm + call RegPack(Buf, allocated(InData%Cm)) + if (allocated(InData%Cm)) then + call RegPackBounds(Buf, 2, lbound(InData%Cm), ubound(InData%Cm)) + call RegPack(Buf, InData%Cm) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Cl + call RegPack(Buf, allocated(InData%Cl)) + if (allocated(InData%Cl)) then + call RegPackBounds(Buf, 2, lbound(InData%Cl), ubound(InData%Cl)) + call RegPack(Buf, InData%Cl) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Cd + call RegPack(Buf, allocated(InData%Cd)) + if (allocated(InData%Cd)) then + call RegPackBounds(Buf, 2, lbound(InData%Cd), ubound(InData%Cd)) + call RegPack(Buf, InData%Cd) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! chi + call RegPack(Buf, allocated(InData%chi)) + if (allocated(InData%chi)) then + call RegPackBounds(Buf, 2, lbound(InData%chi), ubound(InData%chi)) + call RegPack(Buf, InData%chi) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Cpmin + call RegPack(Buf, allocated(InData%Cpmin)) + if (allocated(InData%Cpmin)) then + call RegPackBounds(Buf, 2, lbound(InData%Cpmin), ubound(InData%Cpmin)) + call RegPack(Buf, InData%Cpmin) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BEMT_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BEMT_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BEMT_UnPackOutput' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! Vrel + if (allocated(OutData%Vrel)) deallocate(OutData%Vrel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vrel(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vrel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vrel) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! phi + if (allocated(OutData%phi)) deallocate(OutData%phi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%phi(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%phi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%phi) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! axInduction + if (allocated(OutData%axInduction)) deallocate(OutData%axInduction) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%axInduction(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%axInduction.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%axInduction) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! tanInduction + if (allocated(OutData%tanInduction)) deallocate(OutData%tanInduction) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%tanInduction(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%tanInduction.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%tanInduction) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Re + if (allocated(OutData%Re)) deallocate(OutData%Re) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Re(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Re.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Re) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AOA + if (allocated(OutData%AOA)) deallocate(OutData%AOA) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AOA(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AOA.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AOA) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Cx + if (allocated(OutData%Cx)) deallocate(OutData%Cx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Cx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Cx) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Cy + if (allocated(OutData%Cy)) deallocate(OutData%Cy) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Cy(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cy.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Cy) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Cz + if (allocated(OutData%Cz)) deallocate(OutData%Cz) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Cz(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Cz) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Cmx + if (allocated(OutData%Cmx)) deallocate(OutData%Cmx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Cmx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cmx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Cmx) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Cmy + if (allocated(OutData%Cmy)) deallocate(OutData%Cmy) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Cmy(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cmy.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Cmy) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Cmz + if (allocated(OutData%Cmz)) deallocate(OutData%Cmz) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Cmz(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cmz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Cmz) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Cm + if (allocated(OutData%Cm)) deallocate(OutData%Cm) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Cm(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Cm) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Cl + if (allocated(OutData%Cl)) deallocate(OutData%Cl) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Cl(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cl.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Cl) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Cd + if (allocated(OutData%Cd)) deallocate(OutData%Cd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Cd(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Cd) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! chi + if (allocated(OutData%chi)) deallocate(OutData%chi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%chi(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%chi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%chi) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Cpmin + if (allocated(OutData%Cpmin)) deallocate(OutData%Cpmin) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Cpmin(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cpmin.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Cpmin) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE BEMT_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) ! diff --git a/modules/aerodyn/src/DBEMT_Types.f90 b/modules/aerodyn/src/DBEMT_Types.f90 index f77964897a..550511414c 100644 --- a/modules/aerodyn/src/DBEMT_Types.f90 +++ b/modules/aerodyn/src/DBEMT_Types.f90 @@ -172,168 +172,69 @@ SUBROUTINE DBEMT_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE DBEMT_DestroyInitInput - SUBROUTINE DBEMT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(DBEMT_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! NumBlades - Int_BufSz = Int_BufSz + 1 ! NumNodes - Re_BufSz = Re_BufSz + 1 ! tau1_const - Int_BufSz = Int_BufSz + 1 ! DBEMT_Mod - Int_BufSz = Int_BufSz + 1 ! rLocal allocated yes/no - IF ( ALLOCATED(InData%rLocal) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! rLocal upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rLocal) ! rLocal - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%NumBlades - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumNodes - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%tau1_const - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%DBEMT_Mod - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%rLocal) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rLocal,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rLocal,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rLocal,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rLocal,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%rLocal,2), UBOUND(InData%rLocal,2) - DO i1 = LBOUND(InData%rLocal,1), UBOUND(InData%rLocal,1) - ReKiBuf(Re_Xferred) = InData%rLocal(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE DBEMT_PackInitInput - - SUBROUTINE DBEMT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(DBEMT_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%NumBlades = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%tau1_const = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DBEMT_Mod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rLocal not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rLocal)) DEALLOCATE(OutData%rLocal) - ALLOCATE(OutData%rLocal(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rLocal.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%rLocal,2), UBOUND(OutData%rLocal,2) - DO i1 = LBOUND(OutData%rLocal,1), UBOUND(OutData%rLocal,1) - OutData%rLocal(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE DBEMT_UnPackInitInput +subroutine DBEMT_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DBEMT_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + ! NumBlades + call RegPack(Buf, InData%NumBlades) + if (RegCheckErr(Buf, RoutineName)) return + ! NumNodes + call RegPack(Buf, InData%NumNodes) + if (RegCheckErr(Buf, RoutineName)) return + ! tau1_const + call RegPack(Buf, InData%tau1_const) + if (RegCheckErr(Buf, RoutineName)) return + ! DBEMT_Mod + call RegPack(Buf, InData%DBEMT_Mod) + if (RegCheckErr(Buf, RoutineName)) return + ! rLocal + call RegPack(Buf, allocated(InData%rLocal)) + if (allocated(InData%rLocal)) then + call RegPackBounds(Buf, 2, lbound(InData%rLocal), ubound(InData%rLocal)) + call RegPack(Buf, InData%rLocal) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DBEMT_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DBEMT_UnPackInitInput' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! NumBlades + call RegUnpack(Buf, OutData%NumBlades) + if (RegCheckErr(Buf, RoutineName)) return + ! NumNodes + call RegUnpack(Buf, OutData%NumNodes) + if (RegCheckErr(Buf, RoutineName)) return + ! tau1_const + call RegUnpack(Buf, OutData%tau1_const) + if (RegCheckErr(Buf, RoutineName)) return + ! DBEMT_Mod + call RegUnpack(Buf, OutData%DBEMT_Mod) + if (RegCheckErr(Buf, RoutineName)) return + ! rLocal + if (allocated(OutData%rLocal)) deallocate(OutData%rLocal) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rLocal(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rLocal.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rLocal) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE DBEMT_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(DBEMT_InitOutputType), INTENT(IN) :: SrcInitOutputData TYPE(DBEMT_InitOutputType), INTENT(INOUT) :: DstInitOutputData @@ -370,184 +271,25 @@ SUBROUTINE DBEMT_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE DBEMT_DestroyInitOutput - SUBROUTINE DBEMT_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(DBEMT_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE DBEMT_PackInitOutput - - SUBROUTINE DBEMT_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(DBEMT_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE DBEMT_UnPackInitOutput +subroutine DBEMT_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DBEMT_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! Ver + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DBEMT_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DBEMT_UnPackInitOutput' + if (Buf%ErrStat /= ErrID_None) return + ! Ver + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver +end subroutine SUBROUTINE DBEMT_CopyElementContinuousStateType( SrcElementContinuousStateTypeData, DstElementContinuousStateTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(DBEMT_ElementContinuousStateType), INTENT(IN) :: SrcElementContinuousStateTypeData TYPE(DBEMT_ElementContinuousStateType), INTENT(INOUT) :: DstElementContinuousStateTypeData @@ -582,121 +324,32 @@ SUBROUTINE DBEMT_DestroyElementContinuousStateType( ElementContinuousStateTypeDa END SUBROUTINE DBEMT_DestroyElementContinuousStateType - SUBROUTINE DBEMT_PackElementContinuousStateType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(DBEMT_ElementContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_PackElementContinuousStateType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + SIZE(InData%vind) ! vind - Db_BufSz = Db_BufSz + SIZE(InData%vind_1) ! vind_1 - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i1 = LBOUND(InData%vind,1), UBOUND(InData%vind,1) - DbKiBuf(Db_Xferred) = InData%vind(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%vind_1,1), UBOUND(InData%vind_1,1) - DbKiBuf(Db_Xferred) = InData%vind_1(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE DBEMT_PackElementContinuousStateType - - SUBROUTINE DBEMT_UnPackElementContinuousStateType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(DBEMT_ElementContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_UnPackElementContinuousStateType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%vind,1) - i1_u = UBOUND(OutData%vind,1) - DO i1 = LBOUND(OutData%vind,1), UBOUND(OutData%vind,1) - OutData%vind(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%vind_1,1) - i1_u = UBOUND(OutData%vind_1,1) - DO i1 = LBOUND(OutData%vind_1,1), UBOUND(OutData%vind_1,1) - OutData%vind_1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE DBEMT_UnPackElementContinuousStateType +subroutine DBEMT_PackElementContinuousStateType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_ElementContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DBEMT_PackElementContinuousStateType' + if (Buf%ErrStat >= AbortErrLev) return + ! vind + call RegPack(Buf, InData%vind) + if (RegCheckErr(Buf, RoutineName)) return + ! vind_1 + call RegPack(Buf, InData%vind_1) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DBEMT_UnPackElementContinuousStateType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_ElementContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DBEMT_UnPackElementContinuousStateType' + if (Buf%ErrStat /= ErrID_None) return + ! vind + call RegUnpack(Buf, OutData%vind) + if (RegCheckErr(Buf, RoutineName)) return + ! vind_1 + call RegUnpack(Buf, OutData%vind_1) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE DBEMT_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(DBEMT_ContinuousStateType), INTENT(IN) :: SrcContStateData TYPE(DBEMT_ContinuousStateType), INTENT(INOUT) :: DstContStateData @@ -759,233 +412,57 @@ SUBROUTINE DBEMT_DestroyContState( ContStateData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE DBEMT_DestroyContState - SUBROUTINE DBEMT_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(DBEMT_ContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_PackContState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! element allocated yes/no - IF ( ALLOCATED(InData%element) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! element upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i2 = LBOUND(InData%element,2), UBOUND(InData%element,2) - DO i1 = LBOUND(InData%element,1), UBOUND(InData%element,1) - Int_BufSz = Int_BufSz + 3 ! element: size of buffers for each call to pack subtype - CALL DBEMT_PackElementContinuousStateType( Re_Buf, Db_Buf, Int_Buf, InData%element(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! element - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! element - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! element - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! element - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%element) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%element,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%element,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%element,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%element,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%element,2), UBOUND(InData%element,2) - DO i1 = LBOUND(InData%element,1), UBOUND(InData%element,1) - CALL DBEMT_PackElementContinuousStateType( Re_Buf, Db_Buf, Int_Buf, InData%element(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! element - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END DO - END IF - END SUBROUTINE DBEMT_PackContState - - SUBROUTINE DBEMT_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(DBEMT_ContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_UnPackContState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! element not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%element)) DEALLOCATE(OutData%element) - ALLOCATE(OutData%element(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%element.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%element,2), UBOUND(OutData%element,2) - DO i1 = LBOUND(OutData%element,1), UBOUND(OutData%element,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL DBEMT_UnpackElementContinuousStateType( Re_Buf, Db_Buf, Int_Buf, OutData%element(i1,i2), ErrStat2, ErrMsg2 ) ! element - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO - END IF - END SUBROUTINE DBEMT_UnPackContState +subroutine DBEMT_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DBEMT_PackContState' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + ! element + call RegPack(Buf, allocated(InData%element)) + if (allocated(InData%element)) then + call RegPackBounds(Buf, 2, lbound(InData%element), ubound(InData%element)) + LB(1:2) = lbound(InData%element) + UB(1:2) = ubound(InData%element) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call DBEMT_PackElementContinuousStateType(Buf, InData%element(i1,i2)) + end do + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DBEMT_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DBEMT_UnPackContState' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! element + if (allocated(OutData%element)) deallocate(OutData%element) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%element(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%element.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call DBEMT_UnpackElementContinuousStateType(Buf, OutData%element(i1,i2)) ! element + end do + end do + end if +end subroutine SUBROUTINE DBEMT_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(DBEMT_DiscreteStateType), INTENT(IN) :: SrcDiscStateData TYPE(DBEMT_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData @@ -1018,103 +495,26 @@ SUBROUTINE DBEMT_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) END SUBROUTINE DBEMT_DestroyDiscState - SUBROUTINE DBEMT_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(DBEMT_DiscreteStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_PackDiscState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DBEMT_PackDiscState - - SUBROUTINE DBEMT_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(DBEMT_DiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_UnPackDiscState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyState = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DBEMT_UnPackDiscState +subroutine DBEMT_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DBEMT_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyState + call RegPack(Buf, InData%DummyState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DBEMT_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DBEMT_UnPackDiscState' + if (Buf%ErrStat /= ErrID_None) return + ! DummyState + call RegUnpack(Buf, OutData%DummyState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE DBEMT_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(DBEMT_ConstraintStateType), INTENT(IN) :: SrcConstrStateData TYPE(DBEMT_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData @@ -1147,103 +547,26 @@ SUBROUTINE DBEMT_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) END SUBROUTINE DBEMT_DestroyConstrState - SUBROUTINE DBEMT_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(DBEMT_ConstraintStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_PackConstrState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DBEMT_PackConstrState - - SUBROUTINE DBEMT_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(DBEMT_ConstraintStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_UnPackConstrState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyState = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DBEMT_UnPackConstrState +subroutine DBEMT_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DBEMT_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyState + call RegPack(Buf, InData%DummyState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DBEMT_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DBEMT_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + ! DummyState + call RegUnpack(Buf, OutData%DummyState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE DBEMT_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(DBEMT_OtherStateType), INTENT(IN) :: SrcOtherStateData TYPE(DBEMT_OtherStateType), INTENT(INOUT) :: DstOtherStateData @@ -1322,300 +645,95 @@ SUBROUTINE DBEMT_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) ENDDO END SUBROUTINE DBEMT_DestroyOtherState - SUBROUTINE DBEMT_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(DBEMT_OtherStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_PackOtherState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! areStatesInitialized allocated yes/no - IF ( ALLOCATED(InData%areStatesInitialized) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! areStatesInitialized upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%areStatesInitialized) ! areStatesInitialized - END IF - Re_BufSz = Re_BufSz + 1 ! tau1 - Re_BufSz = Re_BufSz + 1 ! tau2 - Int_BufSz = Int_BufSz + 1 ! n allocated yes/no - IF ( ALLOCATED(InData%n) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! n upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%n) ! n - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) - Int_BufSz = Int_BufSz + 3 ! xdot: size of buffers for each call to pack subtype - CALL DBEMT_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xdot - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xdot - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xdot - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xdot - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%areStatesInitialized) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%areStatesInitialized,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%areStatesInitialized,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%areStatesInitialized,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%areStatesInitialized,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%areStatesInitialized,2), UBOUND(InData%areStatesInitialized,2) - DO i1 = LBOUND(InData%areStatesInitialized,1), UBOUND(InData%areStatesInitialized,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%areStatesInitialized(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%tau1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%tau2 - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%n) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%n,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%n,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%n,2), UBOUND(InData%n,2) - DO i1 = LBOUND(InData%n,1), UBOUND(InData%n,1) - IntKiBuf(Int_Xferred) = InData%n(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) - CALL DBEMT_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, OnlySize ) ! xdot - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END SUBROUTINE DBEMT_PackOtherState - - SUBROUTINE DBEMT_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(DBEMT_OtherStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_UnPackOtherState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! areStatesInitialized not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%areStatesInitialized)) DEALLOCATE(OutData%areStatesInitialized) - ALLOCATE(OutData%areStatesInitialized(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%areStatesInitialized.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%areStatesInitialized,2), UBOUND(OutData%areStatesInitialized,2) - DO i1 = LBOUND(OutData%areStatesInitialized,1), UBOUND(OutData%areStatesInitialized,1) - OutData%areStatesInitialized(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%areStatesInitialized(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - OutData%tau1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%tau2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! n not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%n)) DEALLOCATE(OutData%n) - ALLOCATE(OutData%n(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%n.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%n,2), UBOUND(OutData%n,2) - DO i1 = LBOUND(OutData%n,1), UBOUND(OutData%n,1) - OutData%n(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%xdot,1) - i1_u = UBOUND(OutData%xdot,1) - DO i1 = LBOUND(OutData%xdot,1), UBOUND(OutData%xdot,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL DBEMT_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%xdot(i1), ErrStat2, ErrMsg2 ) ! xdot - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END SUBROUTINE DBEMT_UnPackOtherState +subroutine DBEMT_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DBEMT_PackOtherState' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + ! areStatesInitialized + call RegPack(Buf, allocated(InData%areStatesInitialized)) + if (allocated(InData%areStatesInitialized)) then + call RegPackBounds(Buf, 2, lbound(InData%areStatesInitialized), ubound(InData%areStatesInitialized)) + call RegPack(Buf, InData%areStatesInitialized) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! tau1 + call RegPack(Buf, InData%tau1) + if (RegCheckErr(Buf, RoutineName)) return + ! tau2 + call RegPack(Buf, InData%tau2) + if (RegCheckErr(Buf, RoutineName)) return + ! n + call RegPack(Buf, allocated(InData%n)) + if (allocated(InData%n)) then + call RegPackBounds(Buf, 2, lbound(InData%n), ubound(InData%n)) + call RegPack(Buf, InData%n) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! xdot + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) + do i1 = LB(1), UB(1) + call DBEMT_PackContState(Buf, InData%xdot(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DBEMT_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DBEMT_UnPackOtherState' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! areStatesInitialized + if (allocated(OutData%areStatesInitialized)) deallocate(OutData%areStatesInitialized) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%areStatesInitialized(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%areStatesInitialized.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%areStatesInitialized) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! tau1 + call RegUnpack(Buf, OutData%tau1) + if (RegCheckErr(Buf, RoutineName)) return + ! tau2 + call RegUnpack(Buf, OutData%tau2) + if (RegCheckErr(Buf, RoutineName)) return + ! n + if (allocated(OutData%n)) deallocate(OutData%n) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%n(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%n.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%n) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! xdot + LB(1:1) = lbound(OutData%xdot) + UB(1:1) = ubound(OutData%xdot) + do i1 = LB(1), UB(1) + call DBEMT_UnpackContState(Buf, OutData%xdot(i1)) ! xdot + end do +end subroutine SUBROUTINE DBEMT_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) TYPE(DBEMT_MiscVarType), INTENT(IN) :: SrcMiscData TYPE(DBEMT_MiscVarType), INTENT(INOUT) :: DstMiscData @@ -1648,103 +766,26 @@ SUBROUTINE DBEMT_DestroyMisc( MiscData, ErrStat, ErrMsg ) END SUBROUTINE DBEMT_DestroyMisc - SUBROUTINE DBEMT_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(DBEMT_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! FirstWarn_tau1 - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstWarn_tau1, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE DBEMT_PackMisc - - SUBROUTINE DBEMT_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(DBEMT_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%FirstWarn_tau1 = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn_tau1) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE DBEMT_UnPackMisc +subroutine DBEMT_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DBEMT_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + ! FirstWarn_tau1 + call RegPack(Buf, InData%FirstWarn_tau1) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DBEMT_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DBEMT_UnPackMisc' + if (Buf%ErrStat /= ErrID_None) return + ! FirstWarn_tau1 + call RegUnpack(Buf, OutData%FirstWarn_tau1) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE DBEMT_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(DBEMT_ParameterType), INTENT(IN) :: SrcParamData TYPE(DBEMT_ParameterType), INTENT(INOUT) :: DstParamData @@ -1802,183 +843,87 @@ SUBROUTINE DBEMT_DestroyParam( ParamData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE DBEMT_DestroyParam - SUBROUTINE DBEMT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(DBEMT_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! DT - Int_BufSz = Int_BufSz + 1 ! lin_nx - Int_BufSz = Int_BufSz + 1 ! NumBlades - Int_BufSz = Int_BufSz + 1 ! NumNodes - Re_BufSz = Re_BufSz + 1 ! k_0ye - Re_BufSz = Re_BufSz + 1 ! tau1_const - Int_BufSz = Int_BufSz + 1 ! spanRatio allocated yes/no - IF ( ALLOCATED(InData%spanRatio) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! spanRatio upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%spanRatio) ! spanRatio - END IF - Int_BufSz = Int_BufSz + 1 ! DBEMT_Mod - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%lin_nx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBlades - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumNodes - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k_0ye - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%tau1_const - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%spanRatio) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%spanRatio,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%spanRatio,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%spanRatio,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%spanRatio,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%spanRatio,2), UBOUND(InData%spanRatio,2) - DO i1 = LBOUND(InData%spanRatio,1), UBOUND(InData%spanRatio,1) - ReKiBuf(Re_Xferred) = InData%spanRatio(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%DBEMT_Mod - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE DBEMT_PackParam - - SUBROUTINE DBEMT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(DBEMT_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%lin_nx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumBlades = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%k_0ye = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%tau1_const = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! spanRatio not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%spanRatio)) DEALLOCATE(OutData%spanRatio) - ALLOCATE(OutData%spanRatio(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%spanRatio.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%spanRatio,2), UBOUND(OutData%spanRatio,2) - DO i1 = LBOUND(OutData%spanRatio,1), UBOUND(OutData%spanRatio,1) - OutData%spanRatio(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%DBEMT_Mod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE DBEMT_UnPackParam +subroutine DBEMT_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DBEMT_PackParam' + if (Buf%ErrStat >= AbortErrLev) return + ! DT + call RegPack(Buf, InData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! lin_nx + call RegPack(Buf, InData%lin_nx) + if (RegCheckErr(Buf, RoutineName)) return + ! NumBlades + call RegPack(Buf, InData%NumBlades) + if (RegCheckErr(Buf, RoutineName)) return + ! NumNodes + call RegPack(Buf, InData%NumNodes) + if (RegCheckErr(Buf, RoutineName)) return + ! k_0ye + call RegPack(Buf, InData%k_0ye) + if (RegCheckErr(Buf, RoutineName)) return + ! tau1_const + call RegPack(Buf, InData%tau1_const) + if (RegCheckErr(Buf, RoutineName)) return + ! spanRatio + call RegPack(Buf, allocated(InData%spanRatio)) + if (allocated(InData%spanRatio)) then + call RegPackBounds(Buf, 2, lbound(InData%spanRatio), ubound(InData%spanRatio)) + call RegPack(Buf, InData%spanRatio) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DBEMT_Mod + call RegPack(Buf, InData%DBEMT_Mod) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DBEMT_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DBEMT_UnPackParam' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! DT + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! lin_nx + call RegUnpack(Buf, OutData%lin_nx) + if (RegCheckErr(Buf, RoutineName)) return + ! NumBlades + call RegUnpack(Buf, OutData%NumBlades) + if (RegCheckErr(Buf, RoutineName)) return + ! NumNodes + call RegUnpack(Buf, OutData%NumNodes) + if (RegCheckErr(Buf, RoutineName)) return + ! k_0ye + call RegUnpack(Buf, OutData%k_0ye) + if (RegCheckErr(Buf, RoutineName)) return + ! tau1_const + call RegUnpack(Buf, OutData%tau1_const) + if (RegCheckErr(Buf, RoutineName)) return + ! spanRatio + if (allocated(OutData%spanRatio)) deallocate(OutData%spanRatio) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%spanRatio(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%spanRatio.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%spanRatio) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! DBEMT_Mod + call RegUnpack(Buf, OutData%DBEMT_Mod) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE DBEMT_CopyElementInputType( SrcElementInputTypeData, DstElementInputTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(DBEMT_ElementInputType), INTENT(IN) :: SrcElementInputTypeData TYPE(DBEMT_ElementInputType), INTENT(INOUT) :: DstElementInputTypeData @@ -2013,115 +958,32 @@ SUBROUTINE DBEMT_DestroyElementInputType( ElementInputTypeData, ErrStat, ErrMsg END SUBROUTINE DBEMT_DestroyElementInputType - SUBROUTINE DBEMT_PackElementInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(DBEMT_ElementInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_PackElementInputType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + SIZE(InData%vind_s) ! vind_s - Re_BufSz = Re_BufSz + 1 ! spanRatio - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i1 = LBOUND(InData%vind_s,1), UBOUND(InData%vind_s,1) - ReKiBuf(Re_Xferred) = InData%vind_s(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%spanRatio - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DBEMT_PackElementInputType - - SUBROUTINE DBEMT_UnPackElementInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(DBEMT_ElementInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_UnPackElementInputType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%vind_s,1) - i1_u = UBOUND(OutData%vind_s,1) - DO i1 = LBOUND(OutData%vind_s,1), UBOUND(OutData%vind_s,1) - OutData%vind_s(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%spanRatio = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DBEMT_UnPackElementInputType +subroutine DBEMT_PackElementInputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_ElementInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DBEMT_PackElementInputType' + if (Buf%ErrStat >= AbortErrLev) return + ! vind_s + call RegPack(Buf, InData%vind_s) + if (RegCheckErr(Buf, RoutineName)) return + ! spanRatio + call RegPack(Buf, InData%spanRatio) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DBEMT_UnPackElementInputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_ElementInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DBEMT_UnPackElementInputType' + if (Buf%ErrStat /= ErrID_None) return + ! vind_s + call RegUnpack(Buf, OutData%vind_s) + if (RegCheckErr(Buf, RoutineName)) return + ! spanRatio + call RegUnpack(Buf, OutData%spanRatio) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE DBEMT_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(DBEMT_InputType), INTENT(IN) :: SrcInputData TYPE(DBEMT_InputType), INTENT(INOUT) :: DstInputData @@ -2187,248 +1049,75 @@ SUBROUTINE DBEMT_DestroyInput( InputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE DBEMT_DestroyInput - SUBROUTINE DBEMT_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(DBEMT_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! AxInd_disk - Re_BufSz = Re_BufSz + 1 ! Un_disk - Re_BufSz = Re_BufSz + 1 ! R_disk - Int_BufSz = Int_BufSz + 1 ! element allocated yes/no - IF ( ALLOCATED(InData%element) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! element upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i2 = LBOUND(InData%element,2), UBOUND(InData%element,2) - DO i1 = LBOUND(InData%element,1), UBOUND(InData%element,1) - Int_BufSz = Int_BufSz + 3 ! element: size of buffers for each call to pack subtype - CALL DBEMT_PackElementInputType( Re_Buf, Db_Buf, Int_Buf, InData%element(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! element - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! element - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! element - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! element - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%AxInd_disk - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Un_disk - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%R_disk - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%element) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%element,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%element,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%element,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%element,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%element,2), UBOUND(InData%element,2) - DO i1 = LBOUND(InData%element,1), UBOUND(InData%element,1) - CALL DBEMT_PackElementInputType( Re_Buf, Db_Buf, Int_Buf, InData%element(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! element - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END DO - END IF - END SUBROUTINE DBEMT_PackInput - - SUBROUTINE DBEMT_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(DBEMT_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%AxInd_disk = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Un_disk = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%R_disk = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! element not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%element)) DEALLOCATE(OutData%element) - ALLOCATE(OutData%element(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%element.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%element,2), UBOUND(OutData%element,2) - DO i1 = LBOUND(OutData%element,1), UBOUND(OutData%element,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL DBEMT_UnpackElementInputType( Re_Buf, Db_Buf, Int_Buf, OutData%element(i1,i2), ErrStat2, ErrMsg2 ) ! element - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO - END IF - END SUBROUTINE DBEMT_UnPackInput +subroutine DBEMT_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DBEMT_PackInput' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + ! AxInd_disk + call RegPack(Buf, InData%AxInd_disk) + if (RegCheckErr(Buf, RoutineName)) return + ! Un_disk + call RegPack(Buf, InData%Un_disk) + if (RegCheckErr(Buf, RoutineName)) return + ! R_disk + call RegPack(Buf, InData%R_disk) + if (RegCheckErr(Buf, RoutineName)) return + ! element + call RegPack(Buf, allocated(InData%element)) + if (allocated(InData%element)) then + call RegPackBounds(Buf, 2, lbound(InData%element), ubound(InData%element)) + LB(1:2) = lbound(InData%element) + UB(1:2) = ubound(InData%element) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call DBEMT_PackElementInputType(Buf, InData%element(i1,i2)) + end do + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DBEMT_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DBEMT_UnPackInput' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! AxInd_disk + call RegUnpack(Buf, OutData%AxInd_disk) + if (RegCheckErr(Buf, RoutineName)) return + ! Un_disk + call RegUnpack(Buf, OutData%Un_disk) + if (RegCheckErr(Buf, RoutineName)) return + ! R_disk + call RegUnpack(Buf, OutData%R_disk) + if (RegCheckErr(Buf, RoutineName)) return + ! element + if (allocated(OutData%element)) deallocate(OutData%element) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%element(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%element.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call DBEMT_UnpackElementInputType(Buf, OutData%element(i1,i2)) ! element + end do + end do + end if +end subroutine SUBROUTINE DBEMT_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(DBEMT_OutputType), INTENT(IN) :: SrcOutputData TYPE(DBEMT_OutputType), INTENT(INOUT) :: DstOutputData @@ -2482,159 +1171,45 @@ SUBROUTINE DBEMT_DestroyOutput( OutputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE DBEMT_DestroyOutput - SUBROUTINE DBEMT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(DBEMT_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! vind allocated yes/no - IF ( ALLOCATED(InData%vind) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! vind upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%vind) ! vind - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%vind) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vind,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vind,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vind,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vind,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vind,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vind,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%vind,3), UBOUND(InData%vind,3) - DO i2 = LBOUND(InData%vind,2), UBOUND(InData%vind,2) - DO i1 = LBOUND(InData%vind,1), UBOUND(InData%vind,1) - ReKiBuf(Re_Xferred) = InData%vind(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE DBEMT_PackOutput - - SUBROUTINE DBEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(DBEMT_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! vind not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%vind)) DEALLOCATE(OutData%vind) - ALLOCATE(OutData%vind(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%vind.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%vind,3), UBOUND(OutData%vind,3) - DO i2 = LBOUND(OutData%vind,2), UBOUND(OutData%vind,2) - DO i1 = LBOUND(OutData%vind,1), UBOUND(OutData%vind,1) - OutData%vind(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE DBEMT_UnPackOutput +subroutine DBEMT_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DBEMT_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! vind + call RegPack(Buf, allocated(InData%vind)) + if (allocated(InData%vind)) then + call RegPackBounds(Buf, 3, lbound(InData%vind), ubound(InData%vind)) + call RegPack(Buf, InData%vind) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DBEMT_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DBEMT_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DBEMT_UnPackOutput' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! vind + if (allocated(OutData%vind)) deallocate(OutData%vind) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%vind(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%vind.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%vind) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE DBEMT_ElementInputType_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) ! diff --git a/modules/aerodyn/src/FVW_Types.f90 b/modules/aerodyn/src/FVW_Types.f90 index eee3c3393c..e4a045646f 100644 --- a/modules/aerodyn/src/FVW_Types.f90 +++ b/modules/aerodyn/src/FVW_Types.f90 @@ -447,317 +447,157 @@ SUBROUTINE FVW_DestroyGridOutType( GridOutTypeData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE FVW_DestroyGridOutType - SUBROUTINE FVW_PackGridOutType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(GridOutType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_PackGridOutType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%name) ! name - Int_BufSz = Int_BufSz + 1 ! type - Re_BufSz = Re_BufSz + 1 ! tStart - Re_BufSz = Re_BufSz + 1 ! tEnd - Re_BufSz = Re_BufSz + 1 ! DTout - Re_BufSz = Re_BufSz + 1 ! xStart - Re_BufSz = Re_BufSz + 1 ! yStart - Re_BufSz = Re_BufSz + 1 ! zStart - Re_BufSz = Re_BufSz + 1 ! xEnd - Re_BufSz = Re_BufSz + 1 ! yEnd - Re_BufSz = Re_BufSz + 1 ! zEnd - Int_BufSz = Int_BufSz + 1 ! nx - Int_BufSz = Int_BufSz + 1 ! ny - Int_BufSz = Int_BufSz + 1 ! nz - Int_BufSz = Int_BufSz + 1 ! uGrid allocated yes/no - IF ( ALLOCATED(InData%uGrid) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! uGrid upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%uGrid) ! uGrid - END IF - Int_BufSz = Int_BufSz + 1 ! omGrid allocated yes/no - IF ( ALLOCATED(InData%omGrid) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! omGrid upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%omGrid) ! omGrid - END IF - Db_BufSz = Db_BufSz + 1 ! tLastOutput - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%name) - IntKiBuf(Int_Xferred) = ICHAR(InData%name(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%type - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%tStart - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%tEnd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DTout - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%xStart - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%yStart - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%zStart - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%xEnd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%yEnd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%zEnd - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ny - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nz - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%uGrid) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uGrid,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uGrid,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uGrid,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uGrid,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uGrid,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uGrid,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uGrid,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uGrid,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%uGrid,4), UBOUND(InData%uGrid,4) - DO i3 = LBOUND(InData%uGrid,3), UBOUND(InData%uGrid,3) - DO i2 = LBOUND(InData%uGrid,2), UBOUND(InData%uGrid,2) - DO i1 = LBOUND(InData%uGrid,1), UBOUND(InData%uGrid,1) - ReKiBuf(Re_Xferred) = InData%uGrid(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%omGrid) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%omGrid,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%omGrid,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%omGrid,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%omGrid,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%omGrid,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%omGrid,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%omGrid,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%omGrid,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%omGrid,4), UBOUND(InData%omGrid,4) - DO i3 = LBOUND(InData%omGrid,3), UBOUND(InData%omGrid,3) - DO i2 = LBOUND(InData%omGrid,2), UBOUND(InData%omGrid,2) - DO i1 = LBOUND(InData%omGrid,1), UBOUND(InData%omGrid,1) - ReKiBuf(Re_Xferred) = InData%omGrid(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - DbKiBuf(Db_Xferred) = InData%tLastOutput - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE FVW_PackGridOutType - - SUBROUTINE FVW_UnPackGridOutType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(GridOutType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_UnPackGridOutType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%name) - OutData%name(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%type = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%tStart = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%tEnd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DTout = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%xStart = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%yStart = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%zStart = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%xEnd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%yEnd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%zEnd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%nx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ny = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nz = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! uGrid not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%uGrid)) DEALLOCATE(OutData%uGrid) - ALLOCATE(OutData%uGrid(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%uGrid.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%uGrid,4), UBOUND(OutData%uGrid,4) - DO i3 = LBOUND(OutData%uGrid,3), UBOUND(OutData%uGrid,3) - DO i2 = LBOUND(OutData%uGrid,2), UBOUND(OutData%uGrid,2) - DO i1 = LBOUND(OutData%uGrid,1), UBOUND(OutData%uGrid,1) - OutData%uGrid(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! omGrid not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%omGrid)) DEALLOCATE(OutData%omGrid) - ALLOCATE(OutData%omGrid(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%omGrid.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%omGrid,4), UBOUND(OutData%omGrid,4) - DO i3 = LBOUND(OutData%omGrid,3), UBOUND(OutData%omGrid,3) - DO i2 = LBOUND(OutData%omGrid,2), UBOUND(OutData%omGrid,2) - DO i1 = LBOUND(OutData%omGrid,1), UBOUND(OutData%omGrid,1) - OutData%omGrid(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - OutData%tLastOutput = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE FVW_UnPackGridOutType +subroutine FVW_PackGridOutType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(GridOutType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackGridOutType' + if (Buf%ErrStat >= AbortErrLev) return + ! name + call RegPack(Buf, InData%name) + if (RegCheckErr(Buf, RoutineName)) return + ! type + call RegPack(Buf, InData%type) + if (RegCheckErr(Buf, RoutineName)) return + ! tStart + call RegPack(Buf, InData%tStart) + if (RegCheckErr(Buf, RoutineName)) return + ! tEnd + call RegPack(Buf, InData%tEnd) + if (RegCheckErr(Buf, RoutineName)) return + ! DTout + call RegPack(Buf, InData%DTout) + if (RegCheckErr(Buf, RoutineName)) return + ! xStart + call RegPack(Buf, InData%xStart) + if (RegCheckErr(Buf, RoutineName)) return + ! yStart + call RegPack(Buf, InData%yStart) + if (RegCheckErr(Buf, RoutineName)) return + ! zStart + call RegPack(Buf, InData%zStart) + if (RegCheckErr(Buf, RoutineName)) return + ! xEnd + call RegPack(Buf, InData%xEnd) + if (RegCheckErr(Buf, RoutineName)) return + ! yEnd + call RegPack(Buf, InData%yEnd) + if (RegCheckErr(Buf, RoutineName)) return + ! zEnd + call RegPack(Buf, InData%zEnd) + if (RegCheckErr(Buf, RoutineName)) return + ! nx + call RegPack(Buf, InData%nx) + if (RegCheckErr(Buf, RoutineName)) return + ! ny + call RegPack(Buf, InData%ny) + if (RegCheckErr(Buf, RoutineName)) return + ! nz + call RegPack(Buf, InData%nz) + if (RegCheckErr(Buf, RoutineName)) return + ! uGrid + call RegPack(Buf, allocated(InData%uGrid)) + if (allocated(InData%uGrid)) then + call RegPackBounds(Buf, 4, lbound(InData%uGrid), ubound(InData%uGrid)) + call RegPack(Buf, InData%uGrid) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! omGrid + call RegPack(Buf, allocated(InData%omGrid)) + if (allocated(InData%omGrid)) then + call RegPackBounds(Buf, 4, lbound(InData%omGrid), ubound(InData%omGrid)) + call RegPack(Buf, InData%omGrid) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! tLastOutput + call RegPack(Buf, InData%tLastOutput) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_UnPackGridOutType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(GridOutType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackGridOutType' + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! name + call RegUnpack(Buf, OutData%name) + if (RegCheckErr(Buf, RoutineName)) return + ! type + call RegUnpack(Buf, OutData%type) + if (RegCheckErr(Buf, RoutineName)) return + ! tStart + call RegUnpack(Buf, OutData%tStart) + if (RegCheckErr(Buf, RoutineName)) return + ! tEnd + call RegUnpack(Buf, OutData%tEnd) + if (RegCheckErr(Buf, RoutineName)) return + ! DTout + call RegUnpack(Buf, OutData%DTout) + if (RegCheckErr(Buf, RoutineName)) return + ! xStart + call RegUnpack(Buf, OutData%xStart) + if (RegCheckErr(Buf, RoutineName)) return + ! yStart + call RegUnpack(Buf, OutData%yStart) + if (RegCheckErr(Buf, RoutineName)) return + ! zStart + call RegUnpack(Buf, OutData%zStart) + if (RegCheckErr(Buf, RoutineName)) return + ! xEnd + call RegUnpack(Buf, OutData%xEnd) + if (RegCheckErr(Buf, RoutineName)) return + ! yEnd + call RegUnpack(Buf, OutData%yEnd) + if (RegCheckErr(Buf, RoutineName)) return + ! zEnd + call RegUnpack(Buf, OutData%zEnd) + if (RegCheckErr(Buf, RoutineName)) return + ! nx + call RegUnpack(Buf, OutData%nx) + if (RegCheckErr(Buf, RoutineName)) return + ! ny + call RegUnpack(Buf, OutData%ny) + if (RegCheckErr(Buf, RoutineName)) return + ! nz + call RegUnpack(Buf, OutData%nz) + if (RegCheckErr(Buf, RoutineName)) return + ! uGrid + if (allocated(OutData%uGrid)) deallocate(OutData%uGrid) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%uGrid(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%uGrid.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%uGrid) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! omGrid + if (allocated(OutData%omGrid)) deallocate(OutData%omGrid) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%omGrid(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%omGrid.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%omGrid) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! tLastOutput + call RegUnpack(Buf, OutData%tLastOutput) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE FVW_CopyT_Sgmt( SrcT_SgmtData, DstT_SgmtData, CtrlCode, ErrStat, ErrMsg ) TYPE(T_Sgmt), INTENT(IN) :: SrcT_SgmtData TYPE(T_Sgmt), INTENT(INOUT) :: DstT_SgmtData @@ -858,287 +698,129 @@ SUBROUTINE FVW_DestroyT_Sgmt( T_SgmtData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE FVW_DestroyT_Sgmt - SUBROUTINE FVW_PackT_Sgmt( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(T_Sgmt), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_PackT_Sgmt' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! Points allocated yes/no - IF ( ALLOCATED(InData%Points) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Points upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Points) ! Points - END IF - Int_BufSz = Int_BufSz + 1 ! Connct allocated yes/no - IF ( ALLOCATED(InData%Connct) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Connct upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Connct) ! Connct - END IF - Int_BufSz = Int_BufSz + 1 ! Gamma allocated yes/no - IF ( ALLOCATED(InData%Gamma) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Gamma upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Gamma) ! Gamma - END IF - Int_BufSz = Int_BufSz + 1 ! Epsilon allocated yes/no - IF ( ALLOCATED(InData%Epsilon) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Epsilon upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Epsilon) ! Epsilon - END IF - Int_BufSz = Int_BufSz + 1 ! RegFunction - Int_BufSz = Int_BufSz + 1 ! nAct - Int_BufSz = Int_BufSz + 1 ! nActP - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%Points) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Points,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Points,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Points,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Points,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Points,2), UBOUND(InData%Points,2) - DO i1 = LBOUND(InData%Points,1), UBOUND(InData%Points,1) - ReKiBuf(Re_Xferred) = InData%Points(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Connct) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Connct,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Connct,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Connct,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Connct,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Connct,2), UBOUND(InData%Connct,2) - DO i1 = LBOUND(InData%Connct,1), UBOUND(InData%Connct,1) - IntKiBuf(Int_Xferred) = InData%Connct(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Gamma) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Gamma,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Gamma,1), UBOUND(InData%Gamma,1) - ReKiBuf(Re_Xferred) = InData%Gamma(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Epsilon) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Epsilon,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Epsilon,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Epsilon,1), UBOUND(InData%Epsilon,1) - ReKiBuf(Re_Xferred) = InData%Epsilon(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%RegFunction - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nAct - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nActP - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FVW_PackT_Sgmt - - SUBROUTINE FVW_UnPackT_Sgmt( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(T_Sgmt), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_UnPackT_Sgmt' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Points not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Points)) DEALLOCATE(OutData%Points) - ALLOCATE(OutData%Points(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Points.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Points,2), UBOUND(OutData%Points,2) - DO i1 = LBOUND(OutData%Points,1), UBOUND(OutData%Points,1) - OutData%Points(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Connct not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Connct)) DEALLOCATE(OutData%Connct) - ALLOCATE(OutData%Connct(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Connct.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Connct,2), UBOUND(OutData%Connct,2) - DO i1 = LBOUND(OutData%Connct,1), UBOUND(OutData%Connct,1) - OutData%Connct(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Gamma not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Gamma)) DEALLOCATE(OutData%Gamma) - ALLOCATE(OutData%Gamma(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gamma.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Gamma,1), UBOUND(OutData%Gamma,1) - OutData%Gamma(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Epsilon not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Epsilon)) DEALLOCATE(OutData%Epsilon) - ALLOCATE(OutData%Epsilon(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Epsilon.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Epsilon,1), UBOUND(OutData%Epsilon,1) - OutData%Epsilon(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%RegFunction = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nAct = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nActP = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FVW_UnPackT_Sgmt +subroutine FVW_PackT_Sgmt(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(T_Sgmt), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackT_Sgmt' + if (Buf%ErrStat >= AbortErrLev) return + ! Points + call RegPack(Buf, allocated(InData%Points)) + if (allocated(InData%Points)) then + call RegPackBounds(Buf, 2, lbound(InData%Points), ubound(InData%Points)) + call RegPack(Buf, InData%Points) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Connct + call RegPack(Buf, allocated(InData%Connct)) + if (allocated(InData%Connct)) then + call RegPackBounds(Buf, 2, lbound(InData%Connct), ubound(InData%Connct)) + call RegPack(Buf, InData%Connct) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Gamma + call RegPack(Buf, allocated(InData%Gamma)) + if (allocated(InData%Gamma)) then + call RegPackBounds(Buf, 1, lbound(InData%Gamma), ubound(InData%Gamma)) + call RegPack(Buf, InData%Gamma) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Epsilon + call RegPack(Buf, allocated(InData%Epsilon)) + if (allocated(InData%Epsilon)) then + call RegPackBounds(Buf, 1, lbound(InData%Epsilon), ubound(InData%Epsilon)) + call RegPack(Buf, InData%Epsilon) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RegFunction + call RegPack(Buf, InData%RegFunction) + if (RegCheckErr(Buf, RoutineName)) return + ! nAct + call RegPack(Buf, InData%nAct) + if (RegCheckErr(Buf, RoutineName)) return + ! nActP + call RegPack(Buf, InData%nActP) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_UnPackT_Sgmt(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(T_Sgmt), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackT_Sgmt' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! Points + if (allocated(OutData%Points)) deallocate(OutData%Points) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Points(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Points.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Points) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Connct + if (allocated(OutData%Connct)) deallocate(OutData%Connct) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Connct(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Connct.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Connct) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Gamma + if (allocated(OutData%Gamma)) deallocate(OutData%Gamma) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Gamma(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gamma.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Gamma) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Epsilon + if (allocated(OutData%Epsilon)) deallocate(OutData%Epsilon) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Epsilon(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Epsilon.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Epsilon) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RegFunction + call RegUnpack(Buf, OutData%RegFunction) + if (RegCheckErr(Buf, RoutineName)) return + ! nAct + call RegUnpack(Buf, OutData%nAct) + if (RegCheckErr(Buf, RoutineName)) return + ! nActP + call RegUnpack(Buf, OutData%nActP) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE FVW_CopyT_Part( SrcT_PartData, DstT_PartData, CtrlCode, ErrStat, ErrMsg ) TYPE(T_Part), INTENT(IN) :: SrcT_PartData TYPE(T_Part), INTENT(INOUT) :: DstT_PartData @@ -1223,244 +905,101 @@ SUBROUTINE FVW_DestroyT_Part( T_PartData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE FVW_DestroyT_Part - SUBROUTINE FVW_PackT_Part( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(T_Part), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_PackT_Part' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! P allocated yes/no - IF ( ALLOCATED(InData%P) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! P upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%P) ! P - END IF - Int_BufSz = Int_BufSz + 1 ! Alpha allocated yes/no - IF ( ALLOCATED(InData%Alpha) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Alpha upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Alpha) ! Alpha - END IF - Int_BufSz = Int_BufSz + 1 ! RegParam allocated yes/no - IF ( ALLOCATED(InData%RegParam) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RegParam upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%RegParam) ! RegParam - END IF - Int_BufSz = Int_BufSz + 1 ! RegFunction - Int_BufSz = Int_BufSz + 1 ! nAct - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%P) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%P,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%P,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%P,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%P,2), UBOUND(InData%P,2) - DO i1 = LBOUND(InData%P,1), UBOUND(InData%P,1) - ReKiBuf(Re_Xferred) = InData%P(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Alpha) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Alpha,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Alpha,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Alpha,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Alpha,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Alpha,2), UBOUND(InData%Alpha,2) - DO i1 = LBOUND(InData%Alpha,1), UBOUND(InData%Alpha,1) - ReKiBuf(Re_Xferred) = InData%Alpha(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RegParam) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RegParam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RegParam,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RegParam,1), UBOUND(InData%RegParam,1) - ReKiBuf(Re_Xferred) = InData%RegParam(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%RegFunction - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nAct - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FVW_PackT_Part - - SUBROUTINE FVW_UnPackT_Part( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(T_Part), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_UnPackT_Part' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! P not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%P)) DEALLOCATE(OutData%P) - ALLOCATE(OutData%P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%P,2), UBOUND(OutData%P,2) - DO i1 = LBOUND(OutData%P,1), UBOUND(OutData%P,1) - OutData%P(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Alpha not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Alpha)) DEALLOCATE(OutData%Alpha) - ALLOCATE(OutData%Alpha(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Alpha.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Alpha,2), UBOUND(OutData%Alpha,2) - DO i1 = LBOUND(OutData%Alpha,1), UBOUND(OutData%Alpha,1) - OutData%Alpha(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RegParam not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RegParam)) DEALLOCATE(OutData%RegParam) - ALLOCATE(OutData%RegParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RegParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RegParam,1), UBOUND(OutData%RegParam,1) - OutData%RegParam(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%RegFunction = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nAct = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FVW_UnPackT_Part +subroutine FVW_PackT_Part(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(T_Part), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackT_Part' + if (Buf%ErrStat >= AbortErrLev) return + ! P + call RegPack(Buf, allocated(InData%P)) + if (allocated(InData%P)) then + call RegPackBounds(Buf, 2, lbound(InData%P), ubound(InData%P)) + call RegPack(Buf, InData%P) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Alpha + call RegPack(Buf, allocated(InData%Alpha)) + if (allocated(InData%Alpha)) then + call RegPackBounds(Buf, 2, lbound(InData%Alpha), ubound(InData%Alpha)) + call RegPack(Buf, InData%Alpha) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RegParam + call RegPack(Buf, allocated(InData%RegParam)) + if (allocated(InData%RegParam)) then + call RegPackBounds(Buf, 1, lbound(InData%RegParam), ubound(InData%RegParam)) + call RegPack(Buf, InData%RegParam) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RegFunction + call RegPack(Buf, InData%RegFunction) + if (RegCheckErr(Buf, RoutineName)) return + ! nAct + call RegPack(Buf, InData%nAct) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_UnPackT_Part(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(T_Part), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackT_Part' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! P + if (allocated(OutData%P)) deallocate(OutData%P) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%P(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%P.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%P) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Alpha + if (allocated(OutData%Alpha)) deallocate(OutData%Alpha) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Alpha(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Alpha.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Alpha) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RegParam + if (allocated(OutData%RegParam)) deallocate(OutData%RegParam) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RegParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RegParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RegParam) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RegFunction + call RegUnpack(Buf, OutData%RegFunction) + if (RegCheckErr(Buf, RoutineName)) return + ! nAct + call RegUnpack(Buf, OutData%nAct) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE FVW_CopyWng_ParameterType( SrcWng_ParameterTypeData, DstWng_ParameterTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(Wng_ParameterType), INTENT(IN) :: SrcWng_ParameterTypeData TYPE(Wng_ParameterType), INTENT(INOUT) :: DstWng_ParameterTypeData @@ -1588,348 +1127,167 @@ SUBROUTINE FVW_DestroyWng_ParameterType( Wng_ParameterTypeData, ErrStat, ErrMsg ENDIF END SUBROUTINE FVW_DestroyWng_ParameterType - SUBROUTINE FVW_PackWng_ParameterType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Wng_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_PackWng_ParameterType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! chord_LL allocated yes/no - IF ( ALLOCATED(InData%chord_LL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! chord_LL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%chord_LL) ! chord_LL - END IF - Int_BufSz = Int_BufSz + 1 ! chord_CP allocated yes/no - IF ( ALLOCATED(InData%chord_CP) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! chord_CP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%chord_CP) ! chord_CP - END IF - Int_BufSz = Int_BufSz + 1 ! s_LL allocated yes/no - IF ( ALLOCATED(InData%s_LL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! s_LL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%s_LL) ! s_LL - END IF - Int_BufSz = Int_BufSz + 1 ! s_CP allocated yes/no - IF ( ALLOCATED(InData%s_CP) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! s_CP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%s_CP) ! s_CP - END IF - Int_BufSz = Int_BufSz + 1 ! iRotor - Int_BufSz = Int_BufSz + 1 ! AFindx allocated yes/no - IF ( ALLOCATED(InData%AFindx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AFindx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%AFindx) ! AFindx - END IF - Int_BufSz = Int_BufSz + 1 ! nSpan - Int_BufSz = Int_BufSz + 1 ! PrescribedCirculation allocated yes/no - IF ( ALLOCATED(InData%PrescribedCirculation) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PrescribedCirculation upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PrescribedCirculation) ! PrescribedCirculation - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%chord_LL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%chord_LL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chord_LL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%chord_LL,1), UBOUND(InData%chord_LL,1) - ReKiBuf(Re_Xferred) = InData%chord_LL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%chord_CP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%chord_CP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chord_CP,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%chord_CP,1), UBOUND(InData%chord_CP,1) - ReKiBuf(Re_Xferred) = InData%chord_CP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%s_LL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%s_LL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%s_LL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%s_LL,1), UBOUND(InData%s_LL,1) - ReKiBuf(Re_Xferred) = InData%s_LL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%s_CP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%s_CP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%s_CP,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%s_CP,1), UBOUND(InData%s_CP,1) - ReKiBuf(Re_Xferred) = InData%s_CP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%iRotor - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%AFindx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFindx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFindx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFindx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFindx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AFindx,2), UBOUND(InData%AFindx,2) - DO i1 = LBOUND(InData%AFindx,1), UBOUND(InData%AFindx,1) - IntKiBuf(Int_Xferred) = InData%AFindx(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%nSpan - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%PrescribedCirculation) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PrescribedCirculation,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PrescribedCirculation,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PrescribedCirculation,1), UBOUND(InData%PrescribedCirculation,1) - ReKiBuf(Re_Xferred) = InData%PrescribedCirculation(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FVW_PackWng_ParameterType - - SUBROUTINE FVW_UnPackWng_ParameterType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Wng_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_UnPackWng_ParameterType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! chord_LL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%chord_LL)) DEALLOCATE(OutData%chord_LL) - ALLOCATE(OutData%chord_LL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%chord_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%chord_LL,1), UBOUND(OutData%chord_LL,1) - OutData%chord_LL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! chord_CP not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%chord_CP)) DEALLOCATE(OutData%chord_CP) - ALLOCATE(OutData%chord_CP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%chord_CP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%chord_CP,1), UBOUND(OutData%chord_CP,1) - OutData%chord_CP(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! s_LL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%s_LL)) DEALLOCATE(OutData%s_LL) - ALLOCATE(OutData%s_LL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%s_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%s_LL,1), UBOUND(OutData%s_LL,1) - OutData%s_LL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! s_CP not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%s_CP)) DEALLOCATE(OutData%s_CP) - ALLOCATE(OutData%s_CP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%s_CP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%s_CP,1), UBOUND(OutData%s_CP,1) - OutData%s_CP(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%iRotor = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFindx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AFindx)) DEALLOCATE(OutData%AFindx) - ALLOCATE(OutData%AFindx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFindx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AFindx,2), UBOUND(OutData%AFindx,2) - DO i1 = LBOUND(OutData%AFindx,1), UBOUND(OutData%AFindx,1) - OutData%AFindx(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - OutData%nSpan = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PrescribedCirculation not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PrescribedCirculation)) DEALLOCATE(OutData%PrescribedCirculation) - ALLOCATE(OutData%PrescribedCirculation(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PrescribedCirculation.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PrescribedCirculation,1), UBOUND(OutData%PrescribedCirculation,1) - OutData%PrescribedCirculation(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FVW_UnPackWng_ParameterType +subroutine FVW_PackWng_ParameterType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Wng_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackWng_ParameterType' + if (Buf%ErrStat >= AbortErrLev) return + ! chord_LL + call RegPack(Buf, allocated(InData%chord_LL)) + if (allocated(InData%chord_LL)) then + call RegPackBounds(Buf, 1, lbound(InData%chord_LL), ubound(InData%chord_LL)) + call RegPack(Buf, InData%chord_LL) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! chord_CP + call RegPack(Buf, allocated(InData%chord_CP)) + if (allocated(InData%chord_CP)) then + call RegPackBounds(Buf, 1, lbound(InData%chord_CP), ubound(InData%chord_CP)) + call RegPack(Buf, InData%chord_CP) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! s_LL + call RegPack(Buf, allocated(InData%s_LL)) + if (allocated(InData%s_LL)) then + call RegPackBounds(Buf, 1, lbound(InData%s_LL), ubound(InData%s_LL)) + call RegPack(Buf, InData%s_LL) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! s_CP + call RegPack(Buf, allocated(InData%s_CP)) + if (allocated(InData%s_CP)) then + call RegPackBounds(Buf, 1, lbound(InData%s_CP), ubound(InData%s_CP)) + call RegPack(Buf, InData%s_CP) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! iRotor + call RegPack(Buf, InData%iRotor) + if (RegCheckErr(Buf, RoutineName)) return + ! AFindx + call RegPack(Buf, allocated(InData%AFindx)) + if (allocated(InData%AFindx)) then + call RegPackBounds(Buf, 2, lbound(InData%AFindx), ubound(InData%AFindx)) + call RegPack(Buf, InData%AFindx) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! nSpan + call RegPack(Buf, InData%nSpan) + if (RegCheckErr(Buf, RoutineName)) return + ! PrescribedCirculation + call RegPack(Buf, allocated(InData%PrescribedCirculation)) + if (allocated(InData%PrescribedCirculation)) then + call RegPackBounds(Buf, 1, lbound(InData%PrescribedCirculation), ubound(InData%PrescribedCirculation)) + call RegPack(Buf, InData%PrescribedCirculation) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_UnPackWng_ParameterType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Wng_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackWng_ParameterType' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! chord_LL + if (allocated(OutData%chord_LL)) deallocate(OutData%chord_LL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%chord_LL(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%chord_LL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%chord_LL) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! chord_CP + if (allocated(OutData%chord_CP)) deallocate(OutData%chord_CP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%chord_CP(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%chord_CP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%chord_CP) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! s_LL + if (allocated(OutData%s_LL)) deallocate(OutData%s_LL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%s_LL(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%s_LL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%s_LL) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! s_CP + if (allocated(OutData%s_CP)) deallocate(OutData%s_CP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%s_CP(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%s_CP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%s_CP) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! iRotor + call RegUnpack(Buf, OutData%iRotor) + if (RegCheckErr(Buf, RoutineName)) return + ! AFindx + if (allocated(OutData%AFindx)) deallocate(OutData%AFindx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AFindx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFindx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AFindx) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! nSpan + call RegUnpack(Buf, OutData%nSpan) + if (RegCheckErr(Buf, RoutineName)) return + ! PrescribedCirculation + if (allocated(OutData%PrescribedCirculation)) deallocate(OutData%PrescribedCirculation) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PrescribedCirculation(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PrescribedCirculation.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PrescribedCirculation) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE FVW_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(FVW_ParameterType), INTENT(IN) :: SrcParamData TYPE(FVW_ParameterType), INTENT(INOUT) :: DstParamData @@ -2050,534 +1408,357 @@ SUBROUTINE FVW_DestroyParam( ParamData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE FVW_DestroyParam - SUBROUTINE FVW_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FVW_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! nRotors - Int_BufSz = Int_BufSz + 1 ! nWings - Int_BufSz = Int_BufSz + 1 ! W allocated yes/no - IF ( ALLOCATED(InData%W) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! W upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) - Int_BufSz = Int_BufSz + 3 ! W: size of buffers for each call to pack subtype - CALL FVW_PackWng_ParameterType( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, .TRUE. ) ! W - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! W - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! W - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! W - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! Bld2Wings allocated yes/no - IF ( ALLOCATED(InData%Bld2Wings) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Bld2Wings upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Bld2Wings) ! Bld2Wings - END IF - Int_BufSz = Int_BufSz + 1 ! iNWStart - Int_BufSz = Int_BufSz + 1 ! nNWMax - Int_BufSz = Int_BufSz + 1 ! nNWFree - Int_BufSz = Int_BufSz + 1 ! nFWMax - Int_BufSz = Int_BufSz + 1 ! nFWFree - Int_BufSz = Int_BufSz + 1 ! FWShedVorticity - Int_BufSz = Int_BufSz + 1 ! IntMethod - Re_BufSz = Re_BufSz + 1 ! FreeWakeStart - Re_BufSz = Re_BufSz + 1 ! FullCircStart - Int_BufSz = Int_BufSz + 1 ! CircSolvMethod - Int_BufSz = Int_BufSz + 1 ! CircSolvMaxIter - Re_BufSz = Re_BufSz + 1 ! CircSolvConvCrit - Re_BufSz = Re_BufSz + 1 ! CircSolvRelaxation - Int_BufSz = Int_BufSz + 1 ! CircSolvPolar - Int_BufSz = Int_BufSz + 1 ! DiffusionMethod - Re_BufSz = Re_BufSz + 1 ! CoreSpreadEddyVisc - Int_BufSz = Int_BufSz + 1 ! RegDeterMethod - Int_BufSz = Int_BufSz + 1 ! RegFunction - Int_BufSz = Int_BufSz + 1 ! WakeRegMethod - Re_BufSz = Re_BufSz + 1 ! WakeRegParam - Re_BufSz = Re_BufSz + 1 ! WingRegParam - Int_BufSz = Int_BufSz + 1 ! ShearModel - Int_BufSz = Int_BufSz + 1 ! TwrShadowOnWake - Int_BufSz = Int_BufSz + SIZE(InData%VelocityMethod) ! VelocityMethod - Re_BufSz = Re_BufSz + SIZE(InData%TreeBranchFactor) ! TreeBranchFactor - Int_BufSz = Int_BufSz + SIZE(InData%PartPerSegment) ! PartPerSegment - Db_BufSz = Db_BufSz + 1 ! DTaero - Db_BufSz = Db_BufSz + 1 ! DTfvw - Re_BufSz = Re_BufSz + 1 ! KinVisc - Int_BufSz = Int_BufSz + 1 ! MHK - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Int_BufSz = Int_BufSz + 1 ! WrVTK - Int_BufSz = Int_BufSz + 1 ! VTKBlades - Db_BufSz = Db_BufSz + 1 ! DTvtk - Int_BufSz = Int_BufSz + 1 ! VTKCoord - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1*LEN(InData%VTK_OutFileRoot) ! VTK_OutFileRoot - Int_BufSz = Int_BufSz + 1*LEN(InData%VTK_OutFileBase) ! VTK_OutFileBase - Int_BufSz = Int_BufSz + 1 ! nGridOut - Int_BufSz = Int_BufSz + 1 ! InductionAtCP - Int_BufSz = Int_BufSz + 1 ! WakeAtTE - Int_BufSz = Int_BufSz + 1 ! DStallOnWake - Int_BufSz = Int_BufSz + 1 ! Induction - Re_BufSz = Re_BufSz + 1 ! kFrozenNWStart - Re_BufSz = Re_BufSz + 1 ! kFrozenNWEnd - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%nRotors - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nWings - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%W) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%W,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) - CALL FVW_PackWng_ParameterType( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, OnlySize ) ! W - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Bld2Wings) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Bld2Wings,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Bld2Wings,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Bld2Wings,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Bld2Wings,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Bld2Wings,2), UBOUND(InData%Bld2Wings,2) - DO i1 = LBOUND(InData%Bld2Wings,1), UBOUND(InData%Bld2Wings,1) - IntKiBuf(Int_Xferred) = InData%Bld2Wings(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%iNWStart - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nNWMax - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nNWFree - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nFWMax - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nFWFree - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FWShedVorticity, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%IntMethod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FreeWakeStart - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FullCircStart - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%CircSolvMethod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%CircSolvMaxIter - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CircSolvConvCrit - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CircSolvRelaxation - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%CircSolvPolar - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%DiffusionMethod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CoreSpreadEddyVisc - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%RegDeterMethod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%RegFunction - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WakeRegMethod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WakeRegParam - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WingRegParam - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ShearModel - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TwrShadowOnWake, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%VelocityMethod,1), UBOUND(InData%VelocityMethod,1) - IntKiBuf(Int_Xferred) = InData%VelocityMethod(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TreeBranchFactor,1), UBOUND(InData%TreeBranchFactor,1) - ReKiBuf(Re_Xferred) = InData%TreeBranchFactor(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%PartPerSegment,1), UBOUND(InData%PartPerSegment,1) - IntKiBuf(Int_Xferred) = InData%PartPerSegment(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DbKiBuf(Db_Xferred) = InData%DTaero - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%DTfvw - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%KinVisc - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MHK - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WrVTK - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%VTKBlades - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%DTvtk - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%VTKCoord - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%VTK_OutFileRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%VTK_OutFileRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%VTK_OutFileBase) - IntKiBuf(Int_Xferred) = ICHAR(InData%VTK_OutFileBase(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%nGridOut - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%InductionAtCP, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WakeAtTE, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%DStallOnWake, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Induction, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%kFrozenNWStart - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%kFrozenNWEnd - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE FVW_PackParam - - SUBROUTINE FVW_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FVW_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%nRotors = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nWings = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! W not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%W)) DEALLOCATE(OutData%W) - ALLOCATE(OutData%W(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%W,1), UBOUND(OutData%W,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FVW_UnpackWng_ParameterType( Re_Buf, Db_Buf, Int_Buf, OutData%W(i1), ErrStat2, ErrMsg2 ) ! W - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Bld2Wings not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Bld2Wings)) DEALLOCATE(OutData%Bld2Wings) - ALLOCATE(OutData%Bld2Wings(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Bld2Wings.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Bld2Wings,2), UBOUND(OutData%Bld2Wings,2) - DO i1 = LBOUND(OutData%Bld2Wings,1), UBOUND(OutData%Bld2Wings,1) - OutData%Bld2Wings(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - OutData%iNWStart = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nNWMax = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nNWFree = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nFWMax = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nFWFree = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FWShedVorticity = TRANSFER(IntKiBuf(Int_Xferred), OutData%FWShedVorticity) - Int_Xferred = Int_Xferred + 1 - OutData%IntMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FreeWakeStart = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%FullCircStart = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CircSolvMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CircSolvMaxIter = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CircSolvConvCrit = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CircSolvRelaxation = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CircSolvPolar = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%DiffusionMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CoreSpreadEddyVisc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RegDeterMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%RegFunction = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WakeRegMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WakeRegParam = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WingRegParam = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ShearModel = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TwrShadowOnWake = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwrShadowOnWake) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%VelocityMethod,1) - i1_u = UBOUND(OutData%VelocityMethod,1) - DO i1 = LBOUND(OutData%VelocityMethod,1), UBOUND(OutData%VelocityMethod,1) - OutData%VelocityMethod(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TreeBranchFactor,1) - i1_u = UBOUND(OutData%TreeBranchFactor,1) - DO i1 = LBOUND(OutData%TreeBranchFactor,1), UBOUND(OutData%TreeBranchFactor,1) - OutData%TreeBranchFactor(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%PartPerSegment,1) - i1_u = UBOUND(OutData%PartPerSegment,1) - DO i1 = LBOUND(OutData%PartPerSegment,1), UBOUND(OutData%PartPerSegment,1) - OutData%PartPerSegment(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%DTaero = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%DTfvw = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%KinVisc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MHK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WrVTK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%VTKBlades = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%DTvtk = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%VTKCoord = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%VTK_OutFileRoot) - OutData%VTK_OutFileRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%VTK_OutFileBase) - OutData%VTK_OutFileBase(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%nGridOut = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%InductionAtCP = TRANSFER(IntKiBuf(Int_Xferred), OutData%InductionAtCP) - Int_Xferred = Int_Xferred + 1 - OutData%WakeAtTE = TRANSFER(IntKiBuf(Int_Xferred), OutData%WakeAtTE) - Int_Xferred = Int_Xferred + 1 - OutData%DStallOnWake = TRANSFER(IntKiBuf(Int_Xferred), OutData%DStallOnWake) - Int_Xferred = Int_Xferred + 1 - OutData%Induction = TRANSFER(IntKiBuf(Int_Xferred), OutData%Induction) - Int_Xferred = Int_Xferred + 1 - OutData%kFrozenNWStart = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%kFrozenNWEnd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE FVW_UnPackParam +subroutine FVW_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FVW_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackParam' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + ! nRotors + call RegPack(Buf, InData%nRotors) + if (RegCheckErr(Buf, RoutineName)) return + ! nWings + call RegPack(Buf, InData%nWings) + if (RegCheckErr(Buf, RoutineName)) return + ! W + call RegPack(Buf, allocated(InData%W)) + if (allocated(InData%W)) then + call RegPackBounds(Buf, 1, lbound(InData%W), ubound(InData%W)) + LB(1:1) = lbound(InData%W) + UB(1:1) = ubound(InData%W) + do i1 = LB(1), UB(1) + call FVW_PackWng_ParameterType(Buf, InData%W(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Bld2Wings + call RegPack(Buf, allocated(InData%Bld2Wings)) + if (allocated(InData%Bld2Wings)) then + call RegPackBounds(Buf, 2, lbound(InData%Bld2Wings), ubound(InData%Bld2Wings)) + call RegPack(Buf, InData%Bld2Wings) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! iNWStart + call RegPack(Buf, InData%iNWStart) + if (RegCheckErr(Buf, RoutineName)) return + ! nNWMax + call RegPack(Buf, InData%nNWMax) + if (RegCheckErr(Buf, RoutineName)) return + ! nNWFree + call RegPack(Buf, InData%nNWFree) + if (RegCheckErr(Buf, RoutineName)) return + ! nFWMax + call RegPack(Buf, InData%nFWMax) + if (RegCheckErr(Buf, RoutineName)) return + ! nFWFree + call RegPack(Buf, InData%nFWFree) + if (RegCheckErr(Buf, RoutineName)) return + ! FWShedVorticity + call RegPack(Buf, InData%FWShedVorticity) + if (RegCheckErr(Buf, RoutineName)) return + ! IntMethod + call RegPack(Buf, InData%IntMethod) + if (RegCheckErr(Buf, RoutineName)) return + ! FreeWakeStart + call RegPack(Buf, InData%FreeWakeStart) + if (RegCheckErr(Buf, RoutineName)) return + ! FullCircStart + call RegPack(Buf, InData%FullCircStart) + if (RegCheckErr(Buf, RoutineName)) return + ! CircSolvMethod + call RegPack(Buf, InData%CircSolvMethod) + if (RegCheckErr(Buf, RoutineName)) return + ! CircSolvMaxIter + call RegPack(Buf, InData%CircSolvMaxIter) + if (RegCheckErr(Buf, RoutineName)) return + ! CircSolvConvCrit + call RegPack(Buf, InData%CircSolvConvCrit) + if (RegCheckErr(Buf, RoutineName)) return + ! CircSolvRelaxation + call RegPack(Buf, InData%CircSolvRelaxation) + if (RegCheckErr(Buf, RoutineName)) return + ! CircSolvPolar + call RegPack(Buf, InData%CircSolvPolar) + if (RegCheckErr(Buf, RoutineName)) return + ! DiffusionMethod + call RegPack(Buf, InData%DiffusionMethod) + if (RegCheckErr(Buf, RoutineName)) return + ! CoreSpreadEddyVisc + call RegPack(Buf, InData%CoreSpreadEddyVisc) + if (RegCheckErr(Buf, RoutineName)) return + ! RegDeterMethod + call RegPack(Buf, InData%RegDeterMethod) + if (RegCheckErr(Buf, RoutineName)) return + ! RegFunction + call RegPack(Buf, InData%RegFunction) + if (RegCheckErr(Buf, RoutineName)) return + ! WakeRegMethod + call RegPack(Buf, InData%WakeRegMethod) + if (RegCheckErr(Buf, RoutineName)) return + ! WakeRegParam + call RegPack(Buf, InData%WakeRegParam) + if (RegCheckErr(Buf, RoutineName)) return + ! WingRegParam + call RegPack(Buf, InData%WingRegParam) + if (RegCheckErr(Buf, RoutineName)) return + ! ShearModel + call RegPack(Buf, InData%ShearModel) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrShadowOnWake + call RegPack(Buf, InData%TwrShadowOnWake) + if (RegCheckErr(Buf, RoutineName)) return + ! VelocityMethod + call RegPack(Buf, InData%VelocityMethod) + if (RegCheckErr(Buf, RoutineName)) return + ! TreeBranchFactor + call RegPack(Buf, InData%TreeBranchFactor) + if (RegCheckErr(Buf, RoutineName)) return + ! PartPerSegment + call RegPack(Buf, InData%PartPerSegment) + if (RegCheckErr(Buf, RoutineName)) return + ! DTaero + call RegPack(Buf, InData%DTaero) + if (RegCheckErr(Buf, RoutineName)) return + ! DTfvw + call RegPack(Buf, InData%DTfvw) + if (RegCheckErr(Buf, RoutineName)) return + ! KinVisc + call RegPack(Buf, InData%KinVisc) + if (RegCheckErr(Buf, RoutineName)) return + ! MHK + call RegPack(Buf, InData%MHK) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDpth + call RegPack(Buf, InData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! WrVTK + call RegPack(Buf, InData%WrVTK) + if (RegCheckErr(Buf, RoutineName)) return + ! VTKBlades + call RegPack(Buf, InData%VTKBlades) + if (RegCheckErr(Buf, RoutineName)) return + ! DTvtk + call RegPack(Buf, InData%DTvtk) + if (RegCheckErr(Buf, RoutineName)) return + ! VTKCoord + call RegPack(Buf, InData%VTKCoord) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegPack(Buf, InData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! VTK_OutFileRoot + call RegPack(Buf, InData%VTK_OutFileRoot) + if (RegCheckErr(Buf, RoutineName)) return + ! VTK_OutFileBase + call RegPack(Buf, InData%VTK_OutFileBase) + if (RegCheckErr(Buf, RoutineName)) return + ! nGridOut + call RegPack(Buf, InData%nGridOut) + if (RegCheckErr(Buf, RoutineName)) return + ! InductionAtCP + call RegPack(Buf, InData%InductionAtCP) + if (RegCheckErr(Buf, RoutineName)) return + ! WakeAtTE + call RegPack(Buf, InData%WakeAtTE) + if (RegCheckErr(Buf, RoutineName)) return + ! DStallOnWake + call RegPack(Buf, InData%DStallOnWake) + if (RegCheckErr(Buf, RoutineName)) return + ! Induction + call RegPack(Buf, InData%Induction) + if (RegCheckErr(Buf, RoutineName)) return + ! kFrozenNWStart + call RegPack(Buf, InData%kFrozenNWStart) + if (RegCheckErr(Buf, RoutineName)) return + ! kFrozenNWEnd + call RegPack(Buf, InData%kFrozenNWEnd) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FVW_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackParam' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! nRotors + call RegUnpack(Buf, OutData%nRotors) + if (RegCheckErr(Buf, RoutineName)) return + ! nWings + call RegUnpack(Buf, OutData%nWings) + if (RegCheckErr(Buf, RoutineName)) return + ! W + if (allocated(OutData%W)) deallocate(OutData%W) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%W(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FVW_UnpackWng_ParameterType(Buf, OutData%W(i1)) ! W + end do + end if + ! Bld2Wings + if (allocated(OutData%Bld2Wings)) deallocate(OutData%Bld2Wings) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Bld2Wings(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Bld2Wings.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Bld2Wings) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! iNWStart + call RegUnpack(Buf, OutData%iNWStart) + if (RegCheckErr(Buf, RoutineName)) return + ! nNWMax + call RegUnpack(Buf, OutData%nNWMax) + if (RegCheckErr(Buf, RoutineName)) return + ! nNWFree + call RegUnpack(Buf, OutData%nNWFree) + if (RegCheckErr(Buf, RoutineName)) return + ! nFWMax + call RegUnpack(Buf, OutData%nFWMax) + if (RegCheckErr(Buf, RoutineName)) return + ! nFWFree + call RegUnpack(Buf, OutData%nFWFree) + if (RegCheckErr(Buf, RoutineName)) return + ! FWShedVorticity + call RegUnpack(Buf, OutData%FWShedVorticity) + if (RegCheckErr(Buf, RoutineName)) return + ! IntMethod + call RegUnpack(Buf, OutData%IntMethod) + if (RegCheckErr(Buf, RoutineName)) return + ! FreeWakeStart + call RegUnpack(Buf, OutData%FreeWakeStart) + if (RegCheckErr(Buf, RoutineName)) return + ! FullCircStart + call RegUnpack(Buf, OutData%FullCircStart) + if (RegCheckErr(Buf, RoutineName)) return + ! CircSolvMethod + call RegUnpack(Buf, OutData%CircSolvMethod) + if (RegCheckErr(Buf, RoutineName)) return + ! CircSolvMaxIter + call RegUnpack(Buf, OutData%CircSolvMaxIter) + if (RegCheckErr(Buf, RoutineName)) return + ! CircSolvConvCrit + call RegUnpack(Buf, OutData%CircSolvConvCrit) + if (RegCheckErr(Buf, RoutineName)) return + ! CircSolvRelaxation + call RegUnpack(Buf, OutData%CircSolvRelaxation) + if (RegCheckErr(Buf, RoutineName)) return + ! CircSolvPolar + call RegUnpack(Buf, OutData%CircSolvPolar) + if (RegCheckErr(Buf, RoutineName)) return + ! DiffusionMethod + call RegUnpack(Buf, OutData%DiffusionMethod) + if (RegCheckErr(Buf, RoutineName)) return + ! CoreSpreadEddyVisc + call RegUnpack(Buf, OutData%CoreSpreadEddyVisc) + if (RegCheckErr(Buf, RoutineName)) return + ! RegDeterMethod + call RegUnpack(Buf, OutData%RegDeterMethod) + if (RegCheckErr(Buf, RoutineName)) return + ! RegFunction + call RegUnpack(Buf, OutData%RegFunction) + if (RegCheckErr(Buf, RoutineName)) return + ! WakeRegMethod + call RegUnpack(Buf, OutData%WakeRegMethod) + if (RegCheckErr(Buf, RoutineName)) return + ! WakeRegParam + call RegUnpack(Buf, OutData%WakeRegParam) + if (RegCheckErr(Buf, RoutineName)) return + ! WingRegParam + call RegUnpack(Buf, OutData%WingRegParam) + if (RegCheckErr(Buf, RoutineName)) return + ! ShearModel + call RegUnpack(Buf, OutData%ShearModel) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrShadowOnWake + call RegUnpack(Buf, OutData%TwrShadowOnWake) + if (RegCheckErr(Buf, RoutineName)) return + ! VelocityMethod + call RegUnpack(Buf, OutData%VelocityMethod) + if (RegCheckErr(Buf, RoutineName)) return + ! TreeBranchFactor + call RegUnpack(Buf, OutData%TreeBranchFactor) + if (RegCheckErr(Buf, RoutineName)) return + ! PartPerSegment + call RegUnpack(Buf, OutData%PartPerSegment) + if (RegCheckErr(Buf, RoutineName)) return + ! DTaero + call RegUnpack(Buf, OutData%DTaero) + if (RegCheckErr(Buf, RoutineName)) return + ! DTfvw + call RegUnpack(Buf, OutData%DTfvw) + if (RegCheckErr(Buf, RoutineName)) return + ! KinVisc + call RegUnpack(Buf, OutData%KinVisc) + if (RegCheckErr(Buf, RoutineName)) return + ! MHK + call RegUnpack(Buf, OutData%MHK) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDpth + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! WrVTK + call RegUnpack(Buf, OutData%WrVTK) + if (RegCheckErr(Buf, RoutineName)) return + ! VTKBlades + call RegUnpack(Buf, OutData%VTKBlades) + if (RegCheckErr(Buf, RoutineName)) return + ! DTvtk + call RegUnpack(Buf, OutData%DTvtk) + if (RegCheckErr(Buf, RoutineName)) return + ! VTKCoord + call RegUnpack(Buf, OutData%VTKCoord) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! VTK_OutFileRoot + call RegUnpack(Buf, OutData%VTK_OutFileRoot) + if (RegCheckErr(Buf, RoutineName)) return + ! VTK_OutFileBase + call RegUnpack(Buf, OutData%VTK_OutFileBase) + if (RegCheckErr(Buf, RoutineName)) return + ! nGridOut + call RegUnpack(Buf, OutData%nGridOut) + if (RegCheckErr(Buf, RoutineName)) return + ! InductionAtCP + call RegUnpack(Buf, OutData%InductionAtCP) + if (RegCheckErr(Buf, RoutineName)) return + ! WakeAtTE + call RegUnpack(Buf, OutData%WakeAtTE) + if (RegCheckErr(Buf, RoutineName)) return + ! DStallOnWake + call RegUnpack(Buf, OutData%DStallOnWake) + if (RegCheckErr(Buf, RoutineName)) return + ! Induction + call RegUnpack(Buf, OutData%Induction) + if (RegCheckErr(Buf, RoutineName)) return + ! kFrozenNWStart + call RegUnpack(Buf, OutData%kFrozenNWStart) + if (RegCheckErr(Buf, RoutineName)) return + ! kFrozenNWEnd + call RegUnpack(Buf, OutData%kFrozenNWEnd) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE FVW_CopyWng_ContinuousStateType( SrcWng_ContinuousStateTypeData, DstWng_ContinuousStateTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(Wng_ContinuousStateType), INTENT(IN) :: SrcWng_ContinuousStateTypeData TYPE(Wng_ContinuousStateType), INTENT(INOUT) :: DstWng_ContinuousStateTypeData @@ -2722,429 +1903,155 @@ SUBROUTINE FVW_DestroyWng_ContinuousStateType( Wng_ContinuousStateTypeData, ErrS ENDIF END SUBROUTINE FVW_DestroyWng_ContinuousStateType - SUBROUTINE FVW_PackWng_ContinuousStateType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Wng_ContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_PackWng_ContinuousStateType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! Gamma_NW allocated yes/no - IF ( ALLOCATED(InData%Gamma_NW) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Gamma_NW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Gamma_NW) ! Gamma_NW - END IF - Int_BufSz = Int_BufSz + 1 ! Gamma_FW allocated yes/no - IF ( ALLOCATED(InData%Gamma_FW) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Gamma_FW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Gamma_FW) ! Gamma_FW - END IF - Int_BufSz = Int_BufSz + 1 ! Eps_NW allocated yes/no - IF ( ALLOCATED(InData%Eps_NW) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Eps_NW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Eps_NW) ! Eps_NW - END IF - Int_BufSz = Int_BufSz + 1 ! Eps_FW allocated yes/no - IF ( ALLOCATED(InData%Eps_FW) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Eps_FW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Eps_FW) ! Eps_FW - END IF - Int_BufSz = Int_BufSz + 1 ! r_NW allocated yes/no - IF ( ALLOCATED(InData%r_NW) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! r_NW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%r_NW) ! r_NW - END IF - Int_BufSz = Int_BufSz + 1 ! r_FW allocated yes/no - IF ( ALLOCATED(InData%r_FW) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! r_FW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%r_FW) ! r_FW - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%Gamma_NW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Gamma_NW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma_NW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Gamma_NW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma_NW,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Gamma_NW,2), UBOUND(InData%Gamma_NW,2) - DO i1 = LBOUND(InData%Gamma_NW,1), UBOUND(InData%Gamma_NW,1) - ReKiBuf(Re_Xferred) = InData%Gamma_NW(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Gamma_FW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Gamma_FW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma_FW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Gamma_FW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma_FW,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Gamma_FW,2), UBOUND(InData%Gamma_FW,2) - DO i1 = LBOUND(InData%Gamma_FW,1), UBOUND(InData%Gamma_FW,1) - ReKiBuf(Re_Xferred) = InData%Gamma_FW(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Eps_NW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Eps_NW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Eps_NW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Eps_NW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Eps_NW,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Eps_NW,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Eps_NW,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Eps_NW,3), UBOUND(InData%Eps_NW,3) - DO i2 = LBOUND(InData%Eps_NW,2), UBOUND(InData%Eps_NW,2) - DO i1 = LBOUND(InData%Eps_NW,1), UBOUND(InData%Eps_NW,1) - ReKiBuf(Re_Xferred) = InData%Eps_NW(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Eps_FW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Eps_FW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Eps_FW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Eps_FW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Eps_FW,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Eps_FW,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Eps_FW,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Eps_FW,3), UBOUND(InData%Eps_FW,3) - DO i2 = LBOUND(InData%Eps_FW,2), UBOUND(InData%Eps_FW,2) - DO i1 = LBOUND(InData%Eps_FW,1), UBOUND(InData%Eps_FW,1) - ReKiBuf(Re_Xferred) = InData%Eps_FW(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%r_NW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r_NW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_NW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r_NW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_NW,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r_NW,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_NW,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%r_NW,3), UBOUND(InData%r_NW,3) - DO i2 = LBOUND(InData%r_NW,2), UBOUND(InData%r_NW,2) - DO i1 = LBOUND(InData%r_NW,1), UBOUND(InData%r_NW,1) - ReKiBuf(Re_Xferred) = InData%r_NW(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%r_FW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r_FW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_FW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r_FW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_FW,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r_FW,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_FW,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%r_FW,3), UBOUND(InData%r_FW,3) - DO i2 = LBOUND(InData%r_FW,2), UBOUND(InData%r_FW,2) - DO i1 = LBOUND(InData%r_FW,1), UBOUND(InData%r_FW,1) - ReKiBuf(Re_Xferred) = InData%r_FW(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE FVW_PackWng_ContinuousStateType - - SUBROUTINE FVW_UnPackWng_ContinuousStateType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Wng_ContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_UnPackWng_ContinuousStateType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Gamma_NW not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Gamma_NW)) DEALLOCATE(OutData%Gamma_NW) - ALLOCATE(OutData%Gamma_NW(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gamma_NW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Gamma_NW,2), UBOUND(OutData%Gamma_NW,2) - DO i1 = LBOUND(OutData%Gamma_NW,1), UBOUND(OutData%Gamma_NW,1) - OutData%Gamma_NW(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Gamma_FW not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Gamma_FW)) DEALLOCATE(OutData%Gamma_FW) - ALLOCATE(OutData%Gamma_FW(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gamma_FW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Gamma_FW,2), UBOUND(OutData%Gamma_FW,2) - DO i1 = LBOUND(OutData%Gamma_FW,1), UBOUND(OutData%Gamma_FW,1) - OutData%Gamma_FW(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Eps_NW not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Eps_NW)) DEALLOCATE(OutData%Eps_NW) - ALLOCATE(OutData%Eps_NW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Eps_NW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Eps_NW,3), UBOUND(OutData%Eps_NW,3) - DO i2 = LBOUND(OutData%Eps_NW,2), UBOUND(OutData%Eps_NW,2) - DO i1 = LBOUND(OutData%Eps_NW,1), UBOUND(OutData%Eps_NW,1) - OutData%Eps_NW(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Eps_FW not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Eps_FW)) DEALLOCATE(OutData%Eps_FW) - ALLOCATE(OutData%Eps_FW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Eps_FW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Eps_FW,3), UBOUND(OutData%Eps_FW,3) - DO i2 = LBOUND(OutData%Eps_FW,2), UBOUND(OutData%Eps_FW,2) - DO i1 = LBOUND(OutData%Eps_FW,1), UBOUND(OutData%Eps_FW,1) - OutData%Eps_FW(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r_NW not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%r_NW)) DEALLOCATE(OutData%r_NW) - ALLOCATE(OutData%r_NW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_NW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%r_NW,3), UBOUND(OutData%r_NW,3) - DO i2 = LBOUND(OutData%r_NW,2), UBOUND(OutData%r_NW,2) - DO i1 = LBOUND(OutData%r_NW,1), UBOUND(OutData%r_NW,1) - OutData%r_NW(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r_FW not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%r_FW)) DEALLOCATE(OutData%r_FW) - ALLOCATE(OutData%r_FW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_FW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%r_FW,3), UBOUND(OutData%r_FW,3) - DO i2 = LBOUND(OutData%r_FW,2), UBOUND(OutData%r_FW,2) - DO i1 = LBOUND(OutData%r_FW,1), UBOUND(OutData%r_FW,1) - OutData%r_FW(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE FVW_UnPackWng_ContinuousStateType +subroutine FVW_PackWng_ContinuousStateType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Wng_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackWng_ContinuousStateType' + if (Buf%ErrStat >= AbortErrLev) return + ! Gamma_NW + call RegPack(Buf, allocated(InData%Gamma_NW)) + if (allocated(InData%Gamma_NW)) then + call RegPackBounds(Buf, 2, lbound(InData%Gamma_NW), ubound(InData%Gamma_NW)) + call RegPack(Buf, InData%Gamma_NW) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Gamma_FW + call RegPack(Buf, allocated(InData%Gamma_FW)) + if (allocated(InData%Gamma_FW)) then + call RegPackBounds(Buf, 2, lbound(InData%Gamma_FW), ubound(InData%Gamma_FW)) + call RegPack(Buf, InData%Gamma_FW) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Eps_NW + call RegPack(Buf, allocated(InData%Eps_NW)) + if (allocated(InData%Eps_NW)) then + call RegPackBounds(Buf, 3, lbound(InData%Eps_NW), ubound(InData%Eps_NW)) + call RegPack(Buf, InData%Eps_NW) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Eps_FW + call RegPack(Buf, allocated(InData%Eps_FW)) + if (allocated(InData%Eps_FW)) then + call RegPackBounds(Buf, 3, lbound(InData%Eps_FW), ubound(InData%Eps_FW)) + call RegPack(Buf, InData%Eps_FW) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! r_NW + call RegPack(Buf, allocated(InData%r_NW)) + if (allocated(InData%r_NW)) then + call RegPackBounds(Buf, 3, lbound(InData%r_NW), ubound(InData%r_NW)) + call RegPack(Buf, InData%r_NW) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! r_FW + call RegPack(Buf, allocated(InData%r_FW)) + if (allocated(InData%r_FW)) then + call RegPackBounds(Buf, 3, lbound(InData%r_FW), ubound(InData%r_FW)) + call RegPack(Buf, InData%r_FW) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_UnPackWng_ContinuousStateType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Wng_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackWng_ContinuousStateType' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! Gamma_NW + if (allocated(OutData%Gamma_NW)) deallocate(OutData%Gamma_NW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Gamma_NW(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gamma_NW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Gamma_NW) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Gamma_FW + if (allocated(OutData%Gamma_FW)) deallocate(OutData%Gamma_FW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Gamma_FW(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gamma_FW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Gamma_FW) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Eps_NW + if (allocated(OutData%Eps_NW)) deallocate(OutData%Eps_NW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Eps_NW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Eps_NW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Eps_NW) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Eps_FW + if (allocated(OutData%Eps_FW)) deallocate(OutData%Eps_FW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Eps_FW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Eps_FW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Eps_FW) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! r_NW + if (allocated(OutData%r_NW)) deallocate(OutData%r_NW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%r_NW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_NW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%r_NW) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! r_FW + if (allocated(OutData%r_FW)) deallocate(OutData%r_FW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%r_FW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_FW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%r_FW) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE FVW_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(FVW_ContinuousStateType), INTENT(IN) :: SrcContStateData TYPE(FVW_ContinuousStateType), INTENT(INOUT) :: DstContStateData @@ -3223,340 +2130,80 @@ SUBROUTINE FVW_DestroyContState( ContStateData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE FVW_DestroyContState - SUBROUTINE FVW_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FVW_ContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_PackContState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! W allocated yes/no - IF ( ALLOCATED(InData%W) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! W upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) - Int_BufSz = Int_BufSz + 3 ! W: size of buffers for each call to pack subtype - CALL FVW_PackWng_ContinuousStateType( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, .TRUE. ) ! W - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! W - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! W - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! W - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! UA allocated yes/no - IF ( ALLOCATED(InData%UA) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UA upper/lower bounds for each dimension - DO i1 = LBOUND(InData%UA,1), UBOUND(InData%UA,1) - Int_BufSz = Int_BufSz + 3 ! UA: size of buffers for each call to pack subtype - CALL UA_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%UA(i1), ErrStat2, ErrMsg2, .TRUE. ) ! UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! UA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! UA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! UA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%W) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%W,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) - CALL FVW_PackWng_ContinuousStateType( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, OnlySize ) ! W - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%UA) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UA,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UA,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UA,1), UBOUND(InData%UA,1) - CALL UA_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%UA(i1), ErrStat2, ErrMsg2, OnlySize ) ! UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - END SUBROUTINE FVW_PackContState - - SUBROUTINE FVW_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FVW_ContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_UnPackContState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! W not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%W)) DEALLOCATE(OutData%W) - ALLOCATE(OutData%W(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%W,1), UBOUND(OutData%W,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FVW_UnpackWng_ContinuousStateType( Re_Buf, Db_Buf, Int_Buf, OutData%W(i1), ErrStat2, ErrMsg2 ) ! W - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UA not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%UA)) DEALLOCATE(OutData%UA) - ALLOCATE(OutData%UA(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UA,1), UBOUND(OutData%UA,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL UA_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%UA(i1), ErrStat2, ErrMsg2 ) ! UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - END SUBROUTINE FVW_UnPackContState +subroutine FVW_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FVW_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackContState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! W + call RegPack(Buf, allocated(InData%W)) + if (allocated(InData%W)) then + call RegPackBounds(Buf, 1, lbound(InData%W), ubound(InData%W)) + LB(1:1) = lbound(InData%W) + UB(1:1) = ubound(InData%W) + do i1 = LB(1), UB(1) + call FVW_PackWng_ContinuousStateType(Buf, InData%W(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! UA + call RegPack(Buf, allocated(InData%UA)) + if (allocated(InData%UA)) then + call RegPackBounds(Buf, 1, lbound(InData%UA), ubound(InData%UA)) + LB(1:1) = lbound(InData%UA) + UB(1:1) = ubound(InData%UA) + do i1 = LB(1), UB(1) + call UA_PackContState(Buf, InData%UA(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FVW_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackContState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! W + if (allocated(OutData%W)) deallocate(OutData%W) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%W(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FVW_UnpackWng_ContinuousStateType(Buf, OutData%W(i1)) ! W + end do + end if + ! UA + if (allocated(OutData%UA)) deallocate(OutData%UA) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%UA(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UA.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call UA_UnpackContState(Buf, OutData%UA(i1)) ! UA + end do + end if +end subroutine SUBROUTINE FVW_CopyWng_OutputType( SrcWng_OutputTypeData, DstWng_OutputTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(Wng_OutputType), INTENT(IN) :: SrcWng_OutputTypeData TYPE(Wng_OutputType), INTENT(INOUT) :: DstWng_OutputTypeData @@ -3607,148 +2254,45 @@ SUBROUTINE FVW_DestroyWng_OutputType( Wng_OutputTypeData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE FVW_DestroyWng_OutputType - SUBROUTINE FVW_PackWng_OutputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Wng_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_PackWng_OutputType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! Vind allocated yes/no - IF ( ALLOCATED(InData%Vind) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vind upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vind) ! Vind - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%Vind) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vind,2), UBOUND(InData%Vind,2) - DO i1 = LBOUND(InData%Vind,1), UBOUND(InData%Vind,1) - ReKiBuf(Re_Xferred) = InData%Vind(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE FVW_PackWng_OutputType - - SUBROUTINE FVW_UnPackWng_OutputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Wng_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_UnPackWng_OutputType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vind not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vind)) DEALLOCATE(OutData%Vind) - ALLOCATE(OutData%Vind(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vind.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vind,2), UBOUND(OutData%Vind,2) - DO i1 = LBOUND(OutData%Vind,1), UBOUND(OutData%Vind,1) - OutData%Vind(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE FVW_UnPackWng_OutputType +subroutine FVW_PackWng_OutputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Wng_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackWng_OutputType' + if (Buf%ErrStat >= AbortErrLev) return + ! Vind + call RegPack(Buf, allocated(InData%Vind)) + if (allocated(InData%Vind)) then + call RegPackBounds(Buf, 2, lbound(InData%Vind), ubound(InData%Vind)) + call RegPack(Buf, InData%Vind) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_UnPackWng_OutputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Wng_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackWng_OutputType' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! Vind + if (allocated(OutData%Vind)) deallocate(OutData%Vind) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vind(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vind.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vind) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE FVW_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(FVW_OutputType), INTENT(IN) :: SrcOutputData TYPE(FVW_OutputType), INTENT(INOUT) :: DstOutputData @@ -3804,220 +2348,53 @@ SUBROUTINE FVW_DestroyOutput( OutputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE FVW_DestroyOutput - SUBROUTINE FVW_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FVW_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! W allocated yes/no - IF ( ALLOCATED(InData%W) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! W upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) - Int_BufSz = Int_BufSz + 3 ! W: size of buffers for each call to pack subtype - CALL FVW_PackWng_OutputType( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, .TRUE. ) ! W - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! W - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! W - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! W - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%W) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%W,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) - CALL FVW_PackWng_OutputType( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, OnlySize ) ! W - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - END SUBROUTINE FVW_PackOutput - - SUBROUTINE FVW_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FVW_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! W not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%W)) DEALLOCATE(OutData%W) - ALLOCATE(OutData%W(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%W,1), UBOUND(OutData%W,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FVW_UnpackWng_OutputType( Re_Buf, Db_Buf, Int_Buf, OutData%W(i1), ErrStat2, ErrMsg2 ) ! W - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - END SUBROUTINE FVW_UnPackOutput +subroutine FVW_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FVW_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackOutput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! W + call RegPack(Buf, allocated(InData%W)) + if (allocated(InData%W)) then + call RegPackBounds(Buf, 1, lbound(InData%W), ubound(InData%W)) + LB(1:1) = lbound(InData%W) + UB(1:1) = ubound(InData%W) + do i1 = LB(1), UB(1) + call FVW_PackWng_OutputType(Buf, InData%W(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FVW_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackOutput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! W + if (allocated(OutData%W)) deallocate(OutData%W) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%W(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FVW_UnpackWng_OutputType(Buf, OutData%W(i1)) ! W + end do + end if +end subroutine SUBROUTINE FVW_CopyWng_MiscVarType( SrcWng_MiscVarTypeData, DstWng_MiscVarTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(Wng_MiscVarType), INTENT(IN) :: SrcWng_MiscVarTypeData TYPE(Wng_MiscVarType), INTENT(INOUT) :: DstWng_MiscVarTypeData @@ -4714,2173 +3091,920 @@ SUBROUTINE FVW_DestroyWng_MiscVarType( Wng_MiscVarTypeData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE FVW_DestroyWng_MiscVarType - SUBROUTINE FVW_PackWng_MiscVarType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Wng_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_PackWng_MiscVarType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! LE allocated yes/no - IF ( ALLOCATED(InData%LE) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! LE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LE) ! LE - END IF - Int_BufSz = Int_BufSz + 1 ! TE allocated yes/no - IF ( ALLOCATED(InData%TE) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TE) ! TE - END IF - Int_BufSz = Int_BufSz + 1 ! r_LL allocated yes/no - IF ( ALLOCATED(InData%r_LL) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! r_LL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%r_LL) ! r_LL - END IF - Int_BufSz = Int_BufSz + 1 ! CP allocated yes/no - IF ( ALLOCATED(InData%CP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CP) ! CP - END IF - Int_BufSz = Int_BufSz + 1 ! Tang allocated yes/no - IF ( ALLOCATED(InData%Tang) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Tang upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Tang) ! Tang - END IF - Int_BufSz = Int_BufSz + 1 ! Norm allocated yes/no - IF ( ALLOCATED(InData%Norm) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Norm upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Norm) ! Norm - END IF - Int_BufSz = Int_BufSz + 1 ! Orth allocated yes/no - IF ( ALLOCATED(InData%Orth) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Orth upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Orth) ! Orth - END IF - Int_BufSz = Int_BufSz + 1 ! dl allocated yes/no - IF ( ALLOCATED(InData%dl) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! dl upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dl) ! dl - END IF - Int_BufSz = Int_BufSz + 1 ! Area allocated yes/no - IF ( ALLOCATED(InData%Area) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Area upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Area) ! Area - END IF - Int_BufSz = Int_BufSz + 1 ! diag_LL allocated yes/no - IF ( ALLOCATED(InData%diag_LL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! diag_LL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%diag_LL) ! diag_LL - END IF - Int_BufSz = Int_BufSz + 1 ! Vind_CP allocated yes/no - IF ( ALLOCATED(InData%Vind_CP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vind_CP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vind_CP) ! Vind_CP - END IF - Int_BufSz = Int_BufSz + 1 ! Vtot_CP allocated yes/no - IF ( ALLOCATED(InData%Vtot_CP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vtot_CP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vtot_CP) ! Vtot_CP - END IF - Int_BufSz = Int_BufSz + 1 ! Vstr_CP allocated yes/no - IF ( ALLOCATED(InData%Vstr_CP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vstr_CP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vstr_CP) ! Vstr_CP - END IF - Int_BufSz = Int_BufSz + 1 ! Vwnd_CP allocated yes/no - IF ( ALLOCATED(InData%Vwnd_CP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vwnd_CP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vwnd_CP) ! Vwnd_CP - END IF - Int_BufSz = Int_BufSz + 1 ! Vwnd_NW allocated yes/no - IF ( ALLOCATED(InData%Vwnd_NW) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Vwnd_NW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vwnd_NW) ! Vwnd_NW - END IF - Int_BufSz = Int_BufSz + 1 ! Vwnd_FW allocated yes/no - IF ( ALLOCATED(InData%Vwnd_FW) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Vwnd_FW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vwnd_FW) ! Vwnd_FW - END IF - Int_BufSz = Int_BufSz + 1 ! Vind_NW allocated yes/no - IF ( ALLOCATED(InData%Vind_NW) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Vind_NW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vind_NW) ! Vind_NW - END IF - Int_BufSz = Int_BufSz + 1 ! Vind_FW allocated yes/no - IF ( ALLOCATED(InData%Vind_FW) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Vind_FW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vind_FW) ! Vind_FW - END IF - Int_BufSz = Int_BufSz + 1 ! PitchAndTwist allocated yes/no - IF ( ALLOCATED(InData%PitchAndTwist) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PitchAndTwist upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PitchAndTwist) ! PitchAndTwist - END IF - Int_BufSz = Int_BufSz + 1 ! iTip - Int_BufSz = Int_BufSz + 1 ! iRoot - Int_BufSz = Int_BufSz + 1 ! alpha_LL allocated yes/no - IF ( ALLOCATED(InData%alpha_LL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! alpha_LL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%alpha_LL) ! alpha_LL - END IF - Int_BufSz = Int_BufSz + 1 ! Vreln_LL allocated yes/no - IF ( ALLOCATED(InData%Vreln_LL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Vreln_LL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vreln_LL) ! Vreln_LL - END IF - Int_BufSz = Int_BufSz + 1 ! u_UA allocated yes/no - IF ( ALLOCATED(InData%u_UA) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! u_UA upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i2 = LBOUND(InData%u_UA,2), UBOUND(InData%u_UA,2) - DO i1 = LBOUND(InData%u_UA,1), UBOUND(InData%u_UA,1) - Int_BufSz = Int_BufSz + 3 ! u_UA: size of buffers for each call to pack subtype - CALL UA_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_UA(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! u_UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_UA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_UA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_UA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! m_UA: size of buffers for each call to pack subtype - CALL UA_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m_UA, ErrStat2, ErrMsg2, .TRUE. ) ! m_UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m_UA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m_UA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m_UA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y_UA: size of buffers for each call to pack subtype - CALL UA_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_UA, ErrStat2, ErrMsg2, .TRUE. ) ! y_UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_UA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_UA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_UA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! p_UA: size of buffers for each call to pack subtype - CALL UA_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p_UA, ErrStat2, ErrMsg2, .TRUE. ) ! p_UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p_UA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p_UA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p_UA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Vind_LL allocated yes/no - IF ( ALLOCATED(InData%Vind_LL) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vind_LL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vind_LL) ! Vind_LL - END IF - Int_BufSz = Int_BufSz + 1 ! BN_AxInd allocated yes/no - IF ( ALLOCATED(InData%BN_AxInd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BN_AxInd upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_AxInd) ! BN_AxInd - END IF - Int_BufSz = Int_BufSz + 1 ! BN_TanInd allocated yes/no - IF ( ALLOCATED(InData%BN_TanInd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BN_TanInd upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_TanInd) ! BN_TanInd - END IF - Int_BufSz = Int_BufSz + 1 ! BN_Vrel allocated yes/no - IF ( ALLOCATED(InData%BN_Vrel) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BN_Vrel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_Vrel) ! BN_Vrel - END IF - Int_BufSz = Int_BufSz + 1 ! BN_alpha allocated yes/no - IF ( ALLOCATED(InData%BN_alpha) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BN_alpha upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_alpha) ! BN_alpha - END IF - Int_BufSz = Int_BufSz + 1 ! BN_phi allocated yes/no - IF ( ALLOCATED(InData%BN_phi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BN_phi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_phi) ! BN_phi - END IF - Int_BufSz = Int_BufSz + 1 ! BN_Re allocated yes/no - IF ( ALLOCATED(InData%BN_Re) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BN_Re upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_Re) ! BN_Re - END IF - Int_BufSz = Int_BufSz + 1 ! BN_URelWind_s allocated yes/no - IF ( ALLOCATED(InData%BN_URelWind_s) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BN_URelWind_s upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_URelWind_s) ! BN_URelWind_s - END IF - Int_BufSz = Int_BufSz + 1 ! BN_Cl_Static allocated yes/no - IF ( ALLOCATED(InData%BN_Cl_Static) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BN_Cl_Static upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_Cl_Static) ! BN_Cl_Static - END IF - Int_BufSz = Int_BufSz + 1 ! BN_Cd_Static allocated yes/no - IF ( ALLOCATED(InData%BN_Cd_Static) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BN_Cd_Static upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_Cd_Static) ! BN_Cd_Static - END IF - Int_BufSz = Int_BufSz + 1 ! BN_Cm_Static allocated yes/no - IF ( ALLOCATED(InData%BN_Cm_Static) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BN_Cm_Static upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_Cm_Static) ! BN_Cm_Static - END IF - Int_BufSz = Int_BufSz + 1 ! BN_Cpmin allocated yes/no - IF ( ALLOCATED(InData%BN_Cpmin) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BN_Cpmin upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_Cpmin) ! BN_Cpmin - END IF - Int_BufSz = Int_BufSz + 1 ! BN_Cl allocated yes/no - IF ( ALLOCATED(InData%BN_Cl) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BN_Cl upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_Cl) ! BN_Cl - END IF - Int_BufSz = Int_BufSz + 1 ! BN_Cd allocated yes/no - IF ( ALLOCATED(InData%BN_Cd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BN_Cd upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_Cd) ! BN_Cd - END IF - Int_BufSz = Int_BufSz + 1 ! BN_Cm allocated yes/no - IF ( ALLOCATED(InData%BN_Cm) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BN_Cm upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_Cm) ! BN_Cm - END IF - Int_BufSz = Int_BufSz + 1 ! BN_Cx allocated yes/no - IF ( ALLOCATED(InData%BN_Cx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BN_Cx upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_Cx) ! BN_Cx - END IF - Int_BufSz = Int_BufSz + 1 ! BN_Cy allocated yes/no - IF ( ALLOCATED(InData%BN_Cy) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BN_Cy upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_Cy) ! BN_Cy - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%LE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LE,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%LE,2), UBOUND(InData%LE,2) - DO i1 = LBOUND(InData%LE,1), UBOUND(InData%LE,1) - ReKiBuf(Re_Xferred) = InData%LE(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TE,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TE,2), UBOUND(InData%TE,2) - DO i1 = LBOUND(InData%TE,1), UBOUND(InData%TE,1) - ReKiBuf(Re_Xferred) = InData%TE(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%r_LL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r_LL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_LL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r_LL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_LL,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r_LL,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_LL,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%r_LL,3), UBOUND(InData%r_LL,3) - DO i2 = LBOUND(InData%r_LL,2), UBOUND(InData%r_LL,2) - DO i1 = LBOUND(InData%r_LL,1), UBOUND(InData%r_LL,1) - ReKiBuf(Re_Xferred) = InData%r_LL(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CP,2), UBOUND(InData%CP,2) - DO i1 = LBOUND(InData%CP,1), UBOUND(InData%CP,1) - ReKiBuf(Re_Xferred) = InData%CP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Tang) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Tang,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Tang,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Tang,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Tang,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Tang,2), UBOUND(InData%Tang,2) - DO i1 = LBOUND(InData%Tang,1), UBOUND(InData%Tang,1) - ReKiBuf(Re_Xferred) = InData%Tang(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Norm) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Norm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Norm,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Norm,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Norm,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Norm,2), UBOUND(InData%Norm,2) - DO i1 = LBOUND(InData%Norm,1), UBOUND(InData%Norm,1) - ReKiBuf(Re_Xferred) = InData%Norm(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Orth) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Orth,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Orth,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Orth,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Orth,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Orth,2), UBOUND(InData%Orth,2) - DO i1 = LBOUND(InData%Orth,1), UBOUND(InData%Orth,1) - ReKiBuf(Re_Xferred) = InData%Orth(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dl) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dl,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dl,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dl,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dl,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%dl,2), UBOUND(InData%dl,2) - DO i1 = LBOUND(InData%dl,1), UBOUND(InData%dl,1) - ReKiBuf(Re_Xferred) = InData%dl(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Area) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Area,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Area,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Area,1), UBOUND(InData%Area,1) - ReKiBuf(Re_Xferred) = InData%Area(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%diag_LL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%diag_LL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%diag_LL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%diag_LL,1), UBOUND(InData%diag_LL,1) - ReKiBuf(Re_Xferred) = InData%diag_LL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vind_CP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_CP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_CP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_CP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_CP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vind_CP,2), UBOUND(InData%Vind_CP,2) - DO i1 = LBOUND(InData%Vind_CP,1), UBOUND(InData%Vind_CP,1) - ReKiBuf(Re_Xferred) = InData%Vind_CP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vtot_CP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vtot_CP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vtot_CP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vtot_CP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vtot_CP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vtot_CP,2), UBOUND(InData%Vtot_CP,2) - DO i1 = LBOUND(InData%Vtot_CP,1), UBOUND(InData%Vtot_CP,1) - ReKiBuf(Re_Xferred) = InData%Vtot_CP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vstr_CP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vstr_CP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vstr_CP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vstr_CP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vstr_CP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vstr_CP,2), UBOUND(InData%Vstr_CP,2) - DO i1 = LBOUND(InData%Vstr_CP,1), UBOUND(InData%Vstr_CP,1) - ReKiBuf(Re_Xferred) = InData%Vstr_CP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vwnd_CP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_CP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_CP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_CP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_CP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vwnd_CP,2), UBOUND(InData%Vwnd_CP,2) - DO i1 = LBOUND(InData%Vwnd_CP,1), UBOUND(InData%Vwnd_CP,1) - ReKiBuf(Re_Xferred) = InData%Vwnd_CP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vwnd_NW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_NW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_NW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_NW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_NW,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_NW,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_NW,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Vwnd_NW,3), UBOUND(InData%Vwnd_NW,3) - DO i2 = LBOUND(InData%Vwnd_NW,2), UBOUND(InData%Vwnd_NW,2) - DO i1 = LBOUND(InData%Vwnd_NW,1), UBOUND(InData%Vwnd_NW,1) - ReKiBuf(Re_Xferred) = InData%Vwnd_NW(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vwnd_FW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_FW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_FW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_FW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_FW,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_FW,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_FW,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Vwnd_FW,3), UBOUND(InData%Vwnd_FW,3) - DO i2 = LBOUND(InData%Vwnd_FW,2), UBOUND(InData%Vwnd_FW,2) - DO i1 = LBOUND(InData%Vwnd_FW,1), UBOUND(InData%Vwnd_FW,1) - ReKiBuf(Re_Xferred) = InData%Vwnd_FW(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vind_NW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_NW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_NW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_NW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_NW,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_NW,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_NW,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Vind_NW,3), UBOUND(InData%Vind_NW,3) - DO i2 = LBOUND(InData%Vind_NW,2), UBOUND(InData%Vind_NW,2) - DO i1 = LBOUND(InData%Vind_NW,1), UBOUND(InData%Vind_NW,1) - ReKiBuf(Re_Xferred) = InData%Vind_NW(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vind_FW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_FW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_FW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_FW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_FW,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_FW,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_FW,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Vind_FW,3), UBOUND(InData%Vind_FW,3) - DO i2 = LBOUND(InData%Vind_FW,2), UBOUND(InData%Vind_FW,2) - DO i1 = LBOUND(InData%Vind_FW,1), UBOUND(InData%Vind_FW,1) - ReKiBuf(Re_Xferred) = InData%Vind_FW(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PitchAndTwist) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PitchAndTwist,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PitchAndTwist,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PitchAndTwist,1), UBOUND(InData%PitchAndTwist,1) - ReKiBuf(Re_Xferred) = InData%PitchAndTwist(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%iTip - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%iRoot - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%alpha_LL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%alpha_LL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_LL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%alpha_LL,1), UBOUND(InData%alpha_LL,1) - ReKiBuf(Re_Xferred) = InData%alpha_LL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vreln_LL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vreln_LL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vreln_LL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Vreln_LL,1), UBOUND(InData%Vreln_LL,1) - ReKiBuf(Re_Xferred) = InData%Vreln_LL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%u_UA) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_UA,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_UA,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_UA,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_UA,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%u_UA,2), UBOUND(InData%u_UA,2) - DO i1 = LBOUND(InData%u_UA,1), UBOUND(InData%u_UA,1) - CALL UA_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_UA(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! u_UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END DO - END IF - CALL UA_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m_UA, ErrStat2, ErrMsg2, OnlySize ) ! m_UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL UA_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_UA, ErrStat2, ErrMsg2, OnlySize ) ! y_UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL UA_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p_UA, ErrStat2, ErrMsg2, OnlySize ) ! p_UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%Vind_LL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_LL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_LL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_LL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_LL,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vind_LL,2), UBOUND(InData%Vind_LL,2) - DO i1 = LBOUND(InData%Vind_LL,1), UBOUND(InData%Vind_LL,1) - ReKiBuf(Re_Xferred) = InData%Vind_LL(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_AxInd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_AxInd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_AxInd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BN_AxInd,1), UBOUND(InData%BN_AxInd,1) - ReKiBuf(Re_Xferred) = InData%BN_AxInd(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_TanInd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_TanInd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_TanInd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BN_TanInd,1), UBOUND(InData%BN_TanInd,1) - ReKiBuf(Re_Xferred) = InData%BN_TanInd(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_Vrel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Vrel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Vrel,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BN_Vrel,1), UBOUND(InData%BN_Vrel,1) - ReKiBuf(Re_Xferred) = InData%BN_Vrel(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_alpha) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_alpha,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_alpha,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BN_alpha,1), UBOUND(InData%BN_alpha,1) - ReKiBuf(Re_Xferred) = InData%BN_alpha(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_phi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_phi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_phi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BN_phi,1), UBOUND(InData%BN_phi,1) - ReKiBuf(Re_Xferred) = InData%BN_phi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_Re) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Re,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Re,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BN_Re,1), UBOUND(InData%BN_Re,1) - ReKiBuf(Re_Xferred) = InData%BN_Re(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_URelWind_s) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_URelWind_s,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_URelWind_s,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_URelWind_s,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_URelWind_s,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BN_URelWind_s,2), UBOUND(InData%BN_URelWind_s,2) - DO i1 = LBOUND(InData%BN_URelWind_s,1), UBOUND(InData%BN_URelWind_s,1) - ReKiBuf(Re_Xferred) = InData%BN_URelWind_s(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_Cl_Static) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cl_Static,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cl_Static,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BN_Cl_Static,1), UBOUND(InData%BN_Cl_Static,1) - ReKiBuf(Re_Xferred) = InData%BN_Cl_Static(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_Cd_Static) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cd_Static,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cd_Static,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BN_Cd_Static,1), UBOUND(InData%BN_Cd_Static,1) - ReKiBuf(Re_Xferred) = InData%BN_Cd_Static(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_Cm_Static) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cm_Static,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cm_Static,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BN_Cm_Static,1), UBOUND(InData%BN_Cm_Static,1) - ReKiBuf(Re_Xferred) = InData%BN_Cm_Static(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_Cpmin) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cpmin,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cpmin,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BN_Cpmin,1), UBOUND(InData%BN_Cpmin,1) - ReKiBuf(Re_Xferred) = InData%BN_Cpmin(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_Cl) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cl,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cl,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BN_Cl,1), UBOUND(InData%BN_Cl,1) - ReKiBuf(Re_Xferred) = InData%BN_Cl(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_Cd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BN_Cd,1), UBOUND(InData%BN_Cd,1) - ReKiBuf(Re_Xferred) = InData%BN_Cd(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_Cm) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cm,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BN_Cm,1), UBOUND(InData%BN_Cm,1) - ReKiBuf(Re_Xferred) = InData%BN_Cm(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_Cx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BN_Cx,1), UBOUND(InData%BN_Cx,1) - ReKiBuf(Re_Xferred) = InData%BN_Cx(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BN_Cy) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cy,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cy,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BN_Cy,1), UBOUND(InData%BN_Cy,1) - ReKiBuf(Re_Xferred) = InData%BN_Cy(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FVW_PackWng_MiscVarType - - SUBROUTINE FVW_UnPackWng_MiscVarType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Wng_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_UnPackWng_MiscVarType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LE not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LE)) DEALLOCATE(OutData%LE) - ALLOCATE(OutData%LE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%LE,2), UBOUND(OutData%LE,2) - DO i1 = LBOUND(OutData%LE,1), UBOUND(OutData%LE,1) - OutData%LE(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TE not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TE)) DEALLOCATE(OutData%TE) - ALLOCATE(OutData%TE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TE,2), UBOUND(OutData%TE,2) - DO i1 = LBOUND(OutData%TE,1), UBOUND(OutData%TE,1) - OutData%TE(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r_LL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%r_LL)) DEALLOCATE(OutData%r_LL) - ALLOCATE(OutData%r_LL(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%r_LL,3), UBOUND(OutData%r_LL,3) - DO i2 = LBOUND(OutData%r_LL,2), UBOUND(OutData%r_LL,2) - DO i1 = LBOUND(OutData%r_LL,1), UBOUND(OutData%r_LL,1) - OutData%r_LL(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CP not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CP)) DEALLOCATE(OutData%CP) - ALLOCATE(OutData%CP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CP,2), UBOUND(OutData%CP,2) - DO i1 = LBOUND(OutData%CP,1), UBOUND(OutData%CP,1) - OutData%CP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Tang not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Tang)) DEALLOCATE(OutData%Tang) - ALLOCATE(OutData%Tang(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Tang.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Tang,2), UBOUND(OutData%Tang,2) - DO i1 = LBOUND(OutData%Tang,1), UBOUND(OutData%Tang,1) - OutData%Tang(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Norm not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Norm)) DEALLOCATE(OutData%Norm) - ALLOCATE(OutData%Norm(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Norm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Norm,2), UBOUND(OutData%Norm,2) - DO i1 = LBOUND(OutData%Norm,1), UBOUND(OutData%Norm,1) - OutData%Norm(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Orth not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Orth)) DEALLOCATE(OutData%Orth) - ALLOCATE(OutData%Orth(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Orth.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Orth,2), UBOUND(OutData%Orth,2) - DO i1 = LBOUND(OutData%Orth,1), UBOUND(OutData%Orth,1) - OutData%Orth(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dl not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%dl)) DEALLOCATE(OutData%dl) - ALLOCATE(OutData%dl(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%dl,2), UBOUND(OutData%dl,2) - DO i1 = LBOUND(OutData%dl,1), UBOUND(OutData%dl,1) - OutData%dl(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Area not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Area)) DEALLOCATE(OutData%Area) - ALLOCATE(OutData%Area(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Area.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Area,1), UBOUND(OutData%Area,1) - OutData%Area(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! diag_LL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%diag_LL)) DEALLOCATE(OutData%diag_LL) - ALLOCATE(OutData%diag_LL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%diag_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%diag_LL,1), UBOUND(OutData%diag_LL,1) - OutData%diag_LL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vind_CP not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vind_CP)) DEALLOCATE(OutData%Vind_CP) - ALLOCATE(OutData%Vind_CP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vind_CP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vind_CP,2), UBOUND(OutData%Vind_CP,2) - DO i1 = LBOUND(OutData%Vind_CP,1), UBOUND(OutData%Vind_CP,1) - OutData%Vind_CP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vtot_CP not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vtot_CP)) DEALLOCATE(OutData%Vtot_CP) - ALLOCATE(OutData%Vtot_CP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vtot_CP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vtot_CP,2), UBOUND(OutData%Vtot_CP,2) - DO i1 = LBOUND(OutData%Vtot_CP,1), UBOUND(OutData%Vtot_CP,1) - OutData%Vtot_CP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vstr_CP not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vstr_CP)) DEALLOCATE(OutData%Vstr_CP) - ALLOCATE(OutData%Vstr_CP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vstr_CP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vstr_CP,2), UBOUND(OutData%Vstr_CP,2) - DO i1 = LBOUND(OutData%Vstr_CP,1), UBOUND(OutData%Vstr_CP,1) - OutData%Vstr_CP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vwnd_CP not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vwnd_CP)) DEALLOCATE(OutData%Vwnd_CP) - ALLOCATE(OutData%Vwnd_CP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vwnd_CP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vwnd_CP,2), UBOUND(OutData%Vwnd_CP,2) - DO i1 = LBOUND(OutData%Vwnd_CP,1), UBOUND(OutData%Vwnd_CP,1) - OutData%Vwnd_CP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vwnd_NW not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vwnd_NW)) DEALLOCATE(OutData%Vwnd_NW) - ALLOCATE(OutData%Vwnd_NW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vwnd_NW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Vwnd_NW,3), UBOUND(OutData%Vwnd_NW,3) - DO i2 = LBOUND(OutData%Vwnd_NW,2), UBOUND(OutData%Vwnd_NW,2) - DO i1 = LBOUND(OutData%Vwnd_NW,1), UBOUND(OutData%Vwnd_NW,1) - OutData%Vwnd_NW(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vwnd_FW not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vwnd_FW)) DEALLOCATE(OutData%Vwnd_FW) - ALLOCATE(OutData%Vwnd_FW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vwnd_FW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Vwnd_FW,3), UBOUND(OutData%Vwnd_FW,3) - DO i2 = LBOUND(OutData%Vwnd_FW,2), UBOUND(OutData%Vwnd_FW,2) - DO i1 = LBOUND(OutData%Vwnd_FW,1), UBOUND(OutData%Vwnd_FW,1) - OutData%Vwnd_FW(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vind_NW not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vind_NW)) DEALLOCATE(OutData%Vind_NW) - ALLOCATE(OutData%Vind_NW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vind_NW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Vind_NW,3), UBOUND(OutData%Vind_NW,3) - DO i2 = LBOUND(OutData%Vind_NW,2), UBOUND(OutData%Vind_NW,2) - DO i1 = LBOUND(OutData%Vind_NW,1), UBOUND(OutData%Vind_NW,1) - OutData%Vind_NW(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vind_FW not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vind_FW)) DEALLOCATE(OutData%Vind_FW) - ALLOCATE(OutData%Vind_FW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vind_FW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Vind_FW,3), UBOUND(OutData%Vind_FW,3) - DO i2 = LBOUND(OutData%Vind_FW,2), UBOUND(OutData%Vind_FW,2) - DO i1 = LBOUND(OutData%Vind_FW,1), UBOUND(OutData%Vind_FW,1) - OutData%Vind_FW(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PitchAndTwist not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PitchAndTwist)) DEALLOCATE(OutData%PitchAndTwist) - ALLOCATE(OutData%PitchAndTwist(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PitchAndTwist.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PitchAndTwist,1), UBOUND(OutData%PitchAndTwist,1) - OutData%PitchAndTwist(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%iTip = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%iRoot = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! alpha_LL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%alpha_LL)) DEALLOCATE(OutData%alpha_LL) - ALLOCATE(OutData%alpha_LL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%alpha_LL,1), UBOUND(OutData%alpha_LL,1) - OutData%alpha_LL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vreln_LL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vreln_LL)) DEALLOCATE(OutData%Vreln_LL) - ALLOCATE(OutData%Vreln_LL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vreln_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Vreln_LL,1), UBOUND(OutData%Vreln_LL,1) - OutData%Vreln_LL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_UA not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%u_UA)) DEALLOCATE(OutData%u_UA) - ALLOCATE(OutData%u_UA(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_UA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%u_UA,2), UBOUND(OutData%u_UA,2) - DO i1 = LBOUND(OutData%u_UA,1), UBOUND(OutData%u_UA,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL UA_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_UA(i1,i2), ErrStat2, ErrMsg2 ) ! u_UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL UA_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m_UA, ErrStat2, ErrMsg2 ) ! m_UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL UA_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_UA, ErrStat2, ErrMsg2 ) ! y_UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL UA_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p_UA, ErrStat2, ErrMsg2 ) ! p_UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vind_LL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vind_LL)) DEALLOCATE(OutData%Vind_LL) - ALLOCATE(OutData%Vind_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vind_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vind_LL,2), UBOUND(OutData%Vind_LL,2) - DO i1 = LBOUND(OutData%Vind_LL,1), UBOUND(OutData%Vind_LL,1) - OutData%Vind_LL(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_AxInd not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BN_AxInd)) DEALLOCATE(OutData%BN_AxInd) - ALLOCATE(OutData%BN_AxInd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_AxInd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BN_AxInd,1), UBOUND(OutData%BN_AxInd,1) - OutData%BN_AxInd(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_TanInd not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BN_TanInd)) DEALLOCATE(OutData%BN_TanInd) - ALLOCATE(OutData%BN_TanInd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_TanInd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BN_TanInd,1), UBOUND(OutData%BN_TanInd,1) - OutData%BN_TanInd(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Vrel not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BN_Vrel)) DEALLOCATE(OutData%BN_Vrel) - ALLOCATE(OutData%BN_Vrel(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Vrel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BN_Vrel,1), UBOUND(OutData%BN_Vrel,1) - OutData%BN_Vrel(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_alpha not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BN_alpha)) DEALLOCATE(OutData%BN_alpha) - ALLOCATE(OutData%BN_alpha(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_alpha.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BN_alpha,1), UBOUND(OutData%BN_alpha,1) - OutData%BN_alpha(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_phi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BN_phi)) DEALLOCATE(OutData%BN_phi) - ALLOCATE(OutData%BN_phi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_phi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BN_phi,1), UBOUND(OutData%BN_phi,1) - OutData%BN_phi(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Re not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BN_Re)) DEALLOCATE(OutData%BN_Re) - ALLOCATE(OutData%BN_Re(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Re.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BN_Re,1), UBOUND(OutData%BN_Re,1) - OutData%BN_Re(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_URelWind_s not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BN_URelWind_s)) DEALLOCATE(OutData%BN_URelWind_s) - ALLOCATE(OutData%BN_URelWind_s(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_URelWind_s.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BN_URelWind_s,2), UBOUND(OutData%BN_URelWind_s,2) - DO i1 = LBOUND(OutData%BN_URelWind_s,1), UBOUND(OutData%BN_URelWind_s,1) - OutData%BN_URelWind_s(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cl_Static not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BN_Cl_Static)) DEALLOCATE(OutData%BN_Cl_Static) - ALLOCATE(OutData%BN_Cl_Static(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cl_Static.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BN_Cl_Static,1), UBOUND(OutData%BN_Cl_Static,1) - OutData%BN_Cl_Static(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cd_Static not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BN_Cd_Static)) DEALLOCATE(OutData%BN_Cd_Static) - ALLOCATE(OutData%BN_Cd_Static(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cd_Static.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BN_Cd_Static,1), UBOUND(OutData%BN_Cd_Static,1) - OutData%BN_Cd_Static(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cm_Static not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BN_Cm_Static)) DEALLOCATE(OutData%BN_Cm_Static) - ALLOCATE(OutData%BN_Cm_Static(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cm_Static.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BN_Cm_Static,1), UBOUND(OutData%BN_Cm_Static,1) - OutData%BN_Cm_Static(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cpmin not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BN_Cpmin)) DEALLOCATE(OutData%BN_Cpmin) - ALLOCATE(OutData%BN_Cpmin(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cpmin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BN_Cpmin,1), UBOUND(OutData%BN_Cpmin,1) - OutData%BN_Cpmin(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cl not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BN_Cl)) DEALLOCATE(OutData%BN_Cl) - ALLOCATE(OutData%BN_Cl(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BN_Cl,1), UBOUND(OutData%BN_Cl,1) - OutData%BN_Cl(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cd not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BN_Cd)) DEALLOCATE(OutData%BN_Cd) - ALLOCATE(OutData%BN_Cd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BN_Cd,1), UBOUND(OutData%BN_Cd,1) - OutData%BN_Cd(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cm not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BN_Cm)) DEALLOCATE(OutData%BN_Cm) - ALLOCATE(OutData%BN_Cm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BN_Cm,1), UBOUND(OutData%BN_Cm,1) - OutData%BN_Cm(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BN_Cx)) DEALLOCATE(OutData%BN_Cx) - ALLOCATE(OutData%BN_Cx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BN_Cx,1), UBOUND(OutData%BN_Cx,1) - OutData%BN_Cx(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cy not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BN_Cy)) DEALLOCATE(OutData%BN_Cy) - ALLOCATE(OutData%BN_Cy(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BN_Cy,1), UBOUND(OutData%BN_Cy,1) - OutData%BN_Cy(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FVW_UnPackWng_MiscVarType +subroutine FVW_PackWng_MiscVarType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Wng_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackWng_MiscVarType' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + if (Buf%ErrStat >= AbortErrLev) return + ! LE + call RegPack(Buf, allocated(InData%LE)) + if (allocated(InData%LE)) then + call RegPackBounds(Buf, 2, lbound(InData%LE), ubound(InData%LE)) + call RegPack(Buf, InData%LE) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TE + call RegPack(Buf, allocated(InData%TE)) + if (allocated(InData%TE)) then + call RegPackBounds(Buf, 2, lbound(InData%TE), ubound(InData%TE)) + call RegPack(Buf, InData%TE) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! r_LL + call RegPack(Buf, allocated(InData%r_LL)) + if (allocated(InData%r_LL)) then + call RegPackBounds(Buf, 3, lbound(InData%r_LL), ubound(InData%r_LL)) + call RegPack(Buf, InData%r_LL) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CP + call RegPack(Buf, allocated(InData%CP)) + if (allocated(InData%CP)) then + call RegPackBounds(Buf, 2, lbound(InData%CP), ubound(InData%CP)) + call RegPack(Buf, InData%CP) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Tang + call RegPack(Buf, allocated(InData%Tang)) + if (allocated(InData%Tang)) then + call RegPackBounds(Buf, 2, lbound(InData%Tang), ubound(InData%Tang)) + call RegPack(Buf, InData%Tang) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Norm + call RegPack(Buf, allocated(InData%Norm)) + if (allocated(InData%Norm)) then + call RegPackBounds(Buf, 2, lbound(InData%Norm), ubound(InData%Norm)) + call RegPack(Buf, InData%Norm) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Orth + call RegPack(Buf, allocated(InData%Orth)) + if (allocated(InData%Orth)) then + call RegPackBounds(Buf, 2, lbound(InData%Orth), ubound(InData%Orth)) + call RegPack(Buf, InData%Orth) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! dl + call RegPack(Buf, allocated(InData%dl)) + if (allocated(InData%dl)) then + call RegPackBounds(Buf, 2, lbound(InData%dl), ubound(InData%dl)) + call RegPack(Buf, InData%dl) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Area + call RegPack(Buf, allocated(InData%Area)) + if (allocated(InData%Area)) then + call RegPackBounds(Buf, 1, lbound(InData%Area), ubound(InData%Area)) + call RegPack(Buf, InData%Area) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! diag_LL + call RegPack(Buf, allocated(InData%diag_LL)) + if (allocated(InData%diag_LL)) then + call RegPackBounds(Buf, 1, lbound(InData%diag_LL), ubound(InData%diag_LL)) + call RegPack(Buf, InData%diag_LL) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Vind_CP + call RegPack(Buf, allocated(InData%Vind_CP)) + if (allocated(InData%Vind_CP)) then + call RegPackBounds(Buf, 2, lbound(InData%Vind_CP), ubound(InData%Vind_CP)) + call RegPack(Buf, InData%Vind_CP) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Vtot_CP + call RegPack(Buf, allocated(InData%Vtot_CP)) + if (allocated(InData%Vtot_CP)) then + call RegPackBounds(Buf, 2, lbound(InData%Vtot_CP), ubound(InData%Vtot_CP)) + call RegPack(Buf, InData%Vtot_CP) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Vstr_CP + call RegPack(Buf, allocated(InData%Vstr_CP)) + if (allocated(InData%Vstr_CP)) then + call RegPackBounds(Buf, 2, lbound(InData%Vstr_CP), ubound(InData%Vstr_CP)) + call RegPack(Buf, InData%Vstr_CP) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Vwnd_CP + call RegPack(Buf, allocated(InData%Vwnd_CP)) + if (allocated(InData%Vwnd_CP)) then + call RegPackBounds(Buf, 2, lbound(InData%Vwnd_CP), ubound(InData%Vwnd_CP)) + call RegPack(Buf, InData%Vwnd_CP) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Vwnd_NW + call RegPack(Buf, allocated(InData%Vwnd_NW)) + if (allocated(InData%Vwnd_NW)) then + call RegPackBounds(Buf, 3, lbound(InData%Vwnd_NW), ubound(InData%Vwnd_NW)) + call RegPack(Buf, InData%Vwnd_NW) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Vwnd_FW + call RegPack(Buf, allocated(InData%Vwnd_FW)) + if (allocated(InData%Vwnd_FW)) then + call RegPackBounds(Buf, 3, lbound(InData%Vwnd_FW), ubound(InData%Vwnd_FW)) + call RegPack(Buf, InData%Vwnd_FW) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Vind_NW + call RegPack(Buf, allocated(InData%Vind_NW)) + if (allocated(InData%Vind_NW)) then + call RegPackBounds(Buf, 3, lbound(InData%Vind_NW), ubound(InData%Vind_NW)) + call RegPack(Buf, InData%Vind_NW) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Vind_FW + call RegPack(Buf, allocated(InData%Vind_FW)) + if (allocated(InData%Vind_FW)) then + call RegPackBounds(Buf, 3, lbound(InData%Vind_FW), ubound(InData%Vind_FW)) + call RegPack(Buf, InData%Vind_FW) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PitchAndTwist + call RegPack(Buf, allocated(InData%PitchAndTwist)) + if (allocated(InData%PitchAndTwist)) then + call RegPackBounds(Buf, 1, lbound(InData%PitchAndTwist), ubound(InData%PitchAndTwist)) + call RegPack(Buf, InData%PitchAndTwist) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! iTip + call RegPack(Buf, InData%iTip) + if (RegCheckErr(Buf, RoutineName)) return + ! iRoot + call RegPack(Buf, InData%iRoot) + if (RegCheckErr(Buf, RoutineName)) return + ! alpha_LL + call RegPack(Buf, allocated(InData%alpha_LL)) + if (allocated(InData%alpha_LL)) then + call RegPackBounds(Buf, 1, lbound(InData%alpha_LL), ubound(InData%alpha_LL)) + call RegPack(Buf, InData%alpha_LL) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Vreln_LL + call RegPack(Buf, allocated(InData%Vreln_LL)) + if (allocated(InData%Vreln_LL)) then + call RegPackBounds(Buf, 1, lbound(InData%Vreln_LL), ubound(InData%Vreln_LL)) + call RegPack(Buf, InData%Vreln_LL) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! u_UA + call RegPack(Buf, allocated(InData%u_UA)) + if (allocated(InData%u_UA)) then + call RegPackBounds(Buf, 2, lbound(InData%u_UA), ubound(InData%u_UA)) + LB(1:2) = lbound(InData%u_UA) + UB(1:2) = ubound(InData%u_UA) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call UA_PackInput(Buf, InData%u_UA(i1,i2)) + end do + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! m_UA + call UA_PackMisc(Buf, InData%m_UA) + if (RegCheckErr(Buf, RoutineName)) return + ! y_UA + call UA_PackOutput(Buf, InData%y_UA) + if (RegCheckErr(Buf, RoutineName)) return + ! p_UA + call UA_PackParam(Buf, InData%p_UA) + if (RegCheckErr(Buf, RoutineName)) return + ! Vind_LL + call RegPack(Buf, allocated(InData%Vind_LL)) + if (allocated(InData%Vind_LL)) then + call RegPackBounds(Buf, 2, lbound(InData%Vind_LL), ubound(InData%Vind_LL)) + call RegPack(Buf, InData%Vind_LL) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BN_AxInd + call RegPack(Buf, allocated(InData%BN_AxInd)) + if (allocated(InData%BN_AxInd)) then + call RegPackBounds(Buf, 1, lbound(InData%BN_AxInd), ubound(InData%BN_AxInd)) + call RegPack(Buf, InData%BN_AxInd) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BN_TanInd + call RegPack(Buf, allocated(InData%BN_TanInd)) + if (allocated(InData%BN_TanInd)) then + call RegPackBounds(Buf, 1, lbound(InData%BN_TanInd), ubound(InData%BN_TanInd)) + call RegPack(Buf, InData%BN_TanInd) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BN_Vrel + call RegPack(Buf, allocated(InData%BN_Vrel)) + if (allocated(InData%BN_Vrel)) then + call RegPackBounds(Buf, 1, lbound(InData%BN_Vrel), ubound(InData%BN_Vrel)) + call RegPack(Buf, InData%BN_Vrel) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BN_alpha + call RegPack(Buf, allocated(InData%BN_alpha)) + if (allocated(InData%BN_alpha)) then + call RegPackBounds(Buf, 1, lbound(InData%BN_alpha), ubound(InData%BN_alpha)) + call RegPack(Buf, InData%BN_alpha) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BN_phi + call RegPack(Buf, allocated(InData%BN_phi)) + if (allocated(InData%BN_phi)) then + call RegPackBounds(Buf, 1, lbound(InData%BN_phi), ubound(InData%BN_phi)) + call RegPack(Buf, InData%BN_phi) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BN_Re + call RegPack(Buf, allocated(InData%BN_Re)) + if (allocated(InData%BN_Re)) then + call RegPackBounds(Buf, 1, lbound(InData%BN_Re), ubound(InData%BN_Re)) + call RegPack(Buf, InData%BN_Re) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BN_URelWind_s + call RegPack(Buf, allocated(InData%BN_URelWind_s)) + if (allocated(InData%BN_URelWind_s)) then + call RegPackBounds(Buf, 2, lbound(InData%BN_URelWind_s), ubound(InData%BN_URelWind_s)) + call RegPack(Buf, InData%BN_URelWind_s) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BN_Cl_Static + call RegPack(Buf, allocated(InData%BN_Cl_Static)) + if (allocated(InData%BN_Cl_Static)) then + call RegPackBounds(Buf, 1, lbound(InData%BN_Cl_Static), ubound(InData%BN_Cl_Static)) + call RegPack(Buf, InData%BN_Cl_Static) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BN_Cd_Static + call RegPack(Buf, allocated(InData%BN_Cd_Static)) + if (allocated(InData%BN_Cd_Static)) then + call RegPackBounds(Buf, 1, lbound(InData%BN_Cd_Static), ubound(InData%BN_Cd_Static)) + call RegPack(Buf, InData%BN_Cd_Static) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BN_Cm_Static + call RegPack(Buf, allocated(InData%BN_Cm_Static)) + if (allocated(InData%BN_Cm_Static)) then + call RegPackBounds(Buf, 1, lbound(InData%BN_Cm_Static), ubound(InData%BN_Cm_Static)) + call RegPack(Buf, InData%BN_Cm_Static) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BN_Cpmin + call RegPack(Buf, allocated(InData%BN_Cpmin)) + if (allocated(InData%BN_Cpmin)) then + call RegPackBounds(Buf, 1, lbound(InData%BN_Cpmin), ubound(InData%BN_Cpmin)) + call RegPack(Buf, InData%BN_Cpmin) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BN_Cl + call RegPack(Buf, allocated(InData%BN_Cl)) + if (allocated(InData%BN_Cl)) then + call RegPackBounds(Buf, 1, lbound(InData%BN_Cl), ubound(InData%BN_Cl)) + call RegPack(Buf, InData%BN_Cl) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BN_Cd + call RegPack(Buf, allocated(InData%BN_Cd)) + if (allocated(InData%BN_Cd)) then + call RegPackBounds(Buf, 1, lbound(InData%BN_Cd), ubound(InData%BN_Cd)) + call RegPack(Buf, InData%BN_Cd) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BN_Cm + call RegPack(Buf, allocated(InData%BN_Cm)) + if (allocated(InData%BN_Cm)) then + call RegPackBounds(Buf, 1, lbound(InData%BN_Cm), ubound(InData%BN_Cm)) + call RegPack(Buf, InData%BN_Cm) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BN_Cx + call RegPack(Buf, allocated(InData%BN_Cx)) + if (allocated(InData%BN_Cx)) then + call RegPackBounds(Buf, 1, lbound(InData%BN_Cx), ubound(InData%BN_Cx)) + call RegPack(Buf, InData%BN_Cx) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BN_Cy + call RegPack(Buf, allocated(InData%BN_Cy)) + if (allocated(InData%BN_Cy)) then + call RegPackBounds(Buf, 1, lbound(InData%BN_Cy), ubound(InData%BN_Cy)) + call RegPack(Buf, InData%BN_Cy) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_UnPackWng_MiscVarType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Wng_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackWng_MiscVarType' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! LE + if (allocated(OutData%LE)) deallocate(OutData%LE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LE(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LE) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TE + if (allocated(OutData%TE)) deallocate(OutData%TE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TE(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TE) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! r_LL + if (allocated(OutData%r_LL)) deallocate(OutData%r_LL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%r_LL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_LL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%r_LL) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CP + if (allocated(OutData%CP)) deallocate(OutData%CP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CP(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CP) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Tang + if (allocated(OutData%Tang)) deallocate(OutData%Tang) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Tang(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Tang.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Tang) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Norm + if (allocated(OutData%Norm)) deallocate(OutData%Norm) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Norm(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Norm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Norm) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Orth + if (allocated(OutData%Orth)) deallocate(OutData%Orth) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Orth(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Orth.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Orth) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! dl + if (allocated(OutData%dl)) deallocate(OutData%dl) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dl(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dl.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dl) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Area + if (allocated(OutData%Area)) deallocate(OutData%Area) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Area(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Area.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Area) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! diag_LL + if (allocated(OutData%diag_LL)) deallocate(OutData%diag_LL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%diag_LL(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%diag_LL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%diag_LL) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Vind_CP + if (allocated(OutData%Vind_CP)) deallocate(OutData%Vind_CP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vind_CP(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vind_CP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vind_CP) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Vtot_CP + if (allocated(OutData%Vtot_CP)) deallocate(OutData%Vtot_CP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vtot_CP(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vtot_CP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vtot_CP) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Vstr_CP + if (allocated(OutData%Vstr_CP)) deallocate(OutData%Vstr_CP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vstr_CP(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vstr_CP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vstr_CP) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Vwnd_CP + if (allocated(OutData%Vwnd_CP)) deallocate(OutData%Vwnd_CP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vwnd_CP(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vwnd_CP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vwnd_CP) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Vwnd_NW + if (allocated(OutData%Vwnd_NW)) deallocate(OutData%Vwnd_NW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vwnd_NW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vwnd_NW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vwnd_NW) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Vwnd_FW + if (allocated(OutData%Vwnd_FW)) deallocate(OutData%Vwnd_FW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vwnd_FW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vwnd_FW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vwnd_FW) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Vind_NW + if (allocated(OutData%Vind_NW)) deallocate(OutData%Vind_NW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vind_NW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vind_NW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vind_NW) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Vind_FW + if (allocated(OutData%Vind_FW)) deallocate(OutData%Vind_FW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vind_FW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vind_FW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vind_FW) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PitchAndTwist + if (allocated(OutData%PitchAndTwist)) deallocate(OutData%PitchAndTwist) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PitchAndTwist(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PitchAndTwist.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PitchAndTwist) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! iTip + call RegUnpack(Buf, OutData%iTip) + if (RegCheckErr(Buf, RoutineName)) return + ! iRoot + call RegUnpack(Buf, OutData%iRoot) + if (RegCheckErr(Buf, RoutineName)) return + ! alpha_LL + if (allocated(OutData%alpha_LL)) deallocate(OutData%alpha_LL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%alpha_LL(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_LL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%alpha_LL) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Vreln_LL + if (allocated(OutData%Vreln_LL)) deallocate(OutData%Vreln_LL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vreln_LL(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vreln_LL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vreln_LL) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! u_UA + if (allocated(OutData%u_UA)) deallocate(OutData%u_UA) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_UA(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_UA.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call UA_UnpackInput(Buf, OutData%u_UA(i1,i2)) ! u_UA + end do + end do + end if + ! m_UA + call UA_UnpackMisc(Buf, OutData%m_UA) ! m_UA + ! y_UA + call UA_UnpackOutput(Buf, OutData%y_UA) ! y_UA + ! p_UA + call UA_UnpackParam(Buf, OutData%p_UA) ! p_UA + ! Vind_LL + if (allocated(OutData%Vind_LL)) deallocate(OutData%Vind_LL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vind_LL(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vind_LL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vind_LL) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BN_AxInd + if (allocated(OutData%BN_AxInd)) deallocate(OutData%BN_AxInd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BN_AxInd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_AxInd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BN_AxInd) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BN_TanInd + if (allocated(OutData%BN_TanInd)) deallocate(OutData%BN_TanInd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BN_TanInd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_TanInd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BN_TanInd) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BN_Vrel + if (allocated(OutData%BN_Vrel)) deallocate(OutData%BN_Vrel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BN_Vrel(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Vrel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BN_Vrel) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BN_alpha + if (allocated(OutData%BN_alpha)) deallocate(OutData%BN_alpha) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BN_alpha(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_alpha.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BN_alpha) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BN_phi + if (allocated(OutData%BN_phi)) deallocate(OutData%BN_phi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BN_phi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_phi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BN_phi) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BN_Re + if (allocated(OutData%BN_Re)) deallocate(OutData%BN_Re) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BN_Re(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Re.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BN_Re) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BN_URelWind_s + if (allocated(OutData%BN_URelWind_s)) deallocate(OutData%BN_URelWind_s) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BN_URelWind_s(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_URelWind_s.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BN_URelWind_s) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BN_Cl_Static + if (allocated(OutData%BN_Cl_Static)) deallocate(OutData%BN_Cl_Static) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BN_Cl_Static(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cl_Static.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BN_Cl_Static) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BN_Cd_Static + if (allocated(OutData%BN_Cd_Static)) deallocate(OutData%BN_Cd_Static) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BN_Cd_Static(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cd_Static.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BN_Cd_Static) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BN_Cm_Static + if (allocated(OutData%BN_Cm_Static)) deallocate(OutData%BN_Cm_Static) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BN_Cm_Static(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cm_Static.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BN_Cm_Static) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BN_Cpmin + if (allocated(OutData%BN_Cpmin)) deallocate(OutData%BN_Cpmin) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BN_Cpmin(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cpmin.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BN_Cpmin) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BN_Cl + if (allocated(OutData%BN_Cl)) deallocate(OutData%BN_Cl) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BN_Cl(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cl.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BN_Cl) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BN_Cd + if (allocated(OutData%BN_Cd)) deallocate(OutData%BN_Cd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BN_Cd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BN_Cd) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BN_Cm + if (allocated(OutData%BN_Cm)) deallocate(OutData%BN_Cm) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BN_Cm(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BN_Cm) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BN_Cx + if (allocated(OutData%BN_Cx)) deallocate(OutData%BN_Cx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BN_Cx(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BN_Cx) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BN_Cy + if (allocated(OutData%BN_Cy)) deallocate(OutData%BN_Cy) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BN_Cy(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cy.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BN_Cy) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE FVW_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) TYPE(FVW_MiscVarType), INTENT(IN) :: SrcMiscData TYPE(FVW_MiscVarType), INTENT(INOUT) :: DstMiscData @@ -7047,965 +4171,237 @@ SUBROUTINE FVW_DestroyMisc( MiscData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE FVW_DestroyMisc - SUBROUTINE FVW_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FVW_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! W allocated yes/no - IF ( ALLOCATED(InData%W) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! W upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) - Int_BufSz = Int_BufSz + 3 ! W: size of buffers for each call to pack subtype - CALL FVW_PackWng_MiscVarType( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, .TRUE. ) ! W - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! W - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! W - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! W - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! FirstCall - Int_BufSz = Int_BufSz + 1 ! nNW - Int_BufSz = Int_BufSz + 1 ! nFW - Int_BufSz = Int_BufSz + 1 ! iStep - Int_BufSz = Int_BufSz + 1 ! VTKstep - Db_BufSz = Db_BufSz + 1 ! VTKlastTime - Int_BufSz = Int_BufSz + 1 ! r_wind allocated yes/no - IF ( ALLOCATED(InData%r_wind) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! r_wind upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%r_wind) ! r_wind - END IF - Int_BufSz = Int_BufSz + 1 ! ComputeWakeInduced - Db_BufSz = Db_BufSz + 1 ! OldWakeTime - Int_BufSz = Int_BufSz + 3 ! dxdt: size of buffers for each call to pack subtype - CALL FVW_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%dxdt, ErrStat2, ErrMsg2, .TRUE. ) ! dxdt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! dxdt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! dxdt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! dxdt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! x1: size of buffers for each call to pack subtype - CALL FVW_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x1, ErrStat2, ErrMsg2, .TRUE. ) ! x1 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x1 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x1 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x1 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! x2: size of buffers for each call to pack subtype - CALL FVW_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x2, ErrStat2, ErrMsg2, .TRUE. ) ! x2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Db_BufSz = Db_BufSz + 1 ! t1 - Db_BufSz = Db_BufSz + 1 ! t2 - Int_BufSz = Int_BufSz + 1 ! UA_Flag - Int_BufSz = Int_BufSz + 3 ! Sgmt: size of buffers for each call to pack subtype - CALL FVW_PackT_Sgmt( Re_Buf, Db_Buf, Int_Buf, InData%Sgmt, ErrStat2, ErrMsg2, .TRUE. ) ! Sgmt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Sgmt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Sgmt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Sgmt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Part: size of buffers for each call to pack subtype - CALL FVW_PackT_Part( Re_Buf, Db_Buf, Int_Buf, InData%Part, ErrStat2, ErrMsg2, .TRUE. ) ! Part - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Part - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Part - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Part - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! CPs allocated yes/no - IF ( ALLOCATED(InData%CPs) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CPs upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CPs) ! CPs - END IF - Int_BufSz = Int_BufSz + 1 ! Uind allocated yes/no - IF ( ALLOCATED(InData%Uind) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Uind upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Uind) ! Uind - END IF - Int_BufSz = Int_BufSz + 1 ! GridOutputs allocated yes/no - IF ( ALLOCATED(InData%GridOutputs) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! GridOutputs upper/lower bounds for each dimension - DO i1 = LBOUND(InData%GridOutputs,1), UBOUND(InData%GridOutputs,1) - Int_BufSz = Int_BufSz + 3 ! GridOutputs: size of buffers for each call to pack subtype - CALL FVW_PackGridOutType( Re_Buf, Db_Buf, Int_Buf, InData%GridOutputs(i1), ErrStat2, ErrMsg2, .TRUE. ) ! GridOutputs - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! GridOutputs - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! GridOutputs - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! GridOutputs - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%W) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%W,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) - CALL FVW_PackWng_MiscVarType( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, OnlySize ) ! W - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstCall, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nNW - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nFW - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%iStep - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%VTKstep - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%VTKlastTime - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%r_wind) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r_wind,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_wind,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r_wind,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_wind,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%r_wind,2), UBOUND(InData%r_wind,2) - DO i1 = LBOUND(InData%r_wind,1), UBOUND(InData%r_wind,1) - ReKiBuf(Re_Xferred) = InData%r_wind(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%ComputeWakeInduced, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%OldWakeTime - Db_Xferred = Db_Xferred + 1 - CALL FVW_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%dxdt, ErrStat2, ErrMsg2, OnlySize ) ! dxdt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL FVW_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x1, ErrStat2, ErrMsg2, OnlySize ) ! x1 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL FVW_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x2, ErrStat2, ErrMsg2, OnlySize ) ! x2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - DbKiBuf(Db_Xferred) = InData%t1 - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%t2 - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UA_Flag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - CALL FVW_PackT_Sgmt( Re_Buf, Db_Buf, Int_Buf, InData%Sgmt, ErrStat2, ErrMsg2, OnlySize ) ! Sgmt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL FVW_PackT_Part( Re_Buf, Db_Buf, Int_Buf, InData%Part, ErrStat2, ErrMsg2, OnlySize ) ! Part - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%CPs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CPs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CPs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CPs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CPs,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CPs,2), UBOUND(InData%CPs,2) - DO i1 = LBOUND(InData%CPs,1), UBOUND(InData%CPs,1) - ReKiBuf(Re_Xferred) = InData%CPs(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Uind) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Uind,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Uind,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Uind,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Uind,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Uind,2), UBOUND(InData%Uind,2) - DO i1 = LBOUND(InData%Uind,1), UBOUND(InData%Uind,1) - ReKiBuf(Re_Xferred) = InData%Uind(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%GridOutputs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GridOutputs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GridOutputs,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%GridOutputs,1), UBOUND(InData%GridOutputs,1) - CALL FVW_PackGridOutType( Re_Buf, Db_Buf, Int_Buf, InData%GridOutputs(i1), ErrStat2, ErrMsg2, OnlySize ) ! GridOutputs - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - END SUBROUTINE FVW_PackMisc - - SUBROUTINE FVW_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FVW_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! W not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%W)) DEALLOCATE(OutData%W) - ALLOCATE(OutData%W(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%W,1), UBOUND(OutData%W,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FVW_UnpackWng_MiscVarType( Re_Buf, Db_Buf, Int_Buf, OutData%W(i1), ErrStat2, ErrMsg2 ) ! W - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - OutData%FirstCall = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstCall) - Int_Xferred = Int_Xferred + 1 - OutData%nNW = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nFW = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%iStep = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%VTKstep = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%VTKlastTime = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r_wind not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%r_wind)) DEALLOCATE(OutData%r_wind) - ALLOCATE(OutData%r_wind(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_wind.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%r_wind,2), UBOUND(OutData%r_wind,2) - DO i1 = LBOUND(OutData%r_wind,1), UBOUND(OutData%r_wind,1) - OutData%r_wind(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%ComputeWakeInduced = TRANSFER(IntKiBuf(Int_Xferred), OutData%ComputeWakeInduced) - Int_Xferred = Int_Xferred + 1 - OutData%OldWakeTime = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FVW_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%dxdt, ErrStat2, ErrMsg2 ) ! dxdt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FVW_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x1, ErrStat2, ErrMsg2 ) ! x1 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FVW_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x2, ErrStat2, ErrMsg2 ) ! x2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%t1 = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%t2 = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%UA_Flag = TRANSFER(IntKiBuf(Int_Xferred), OutData%UA_Flag) - Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FVW_UnpackT_Sgmt( Re_Buf, Db_Buf, Int_Buf, OutData%Sgmt, ErrStat2, ErrMsg2 ) ! Sgmt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FVW_UnpackT_Part( Re_Buf, Db_Buf, Int_Buf, OutData%Part, ErrStat2, ErrMsg2 ) ! Part - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CPs not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CPs)) DEALLOCATE(OutData%CPs) - ALLOCATE(OutData%CPs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CPs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CPs,2), UBOUND(OutData%CPs,2) - DO i1 = LBOUND(OutData%CPs,1), UBOUND(OutData%CPs,1) - OutData%CPs(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Uind not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Uind)) DEALLOCATE(OutData%Uind) - ALLOCATE(OutData%Uind(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Uind.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Uind,2), UBOUND(OutData%Uind,2) - DO i1 = LBOUND(OutData%Uind,1), UBOUND(OutData%Uind,1) - OutData%Uind(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GridOutputs not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%GridOutputs)) DEALLOCATE(OutData%GridOutputs) - ALLOCATE(OutData%GridOutputs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GridOutputs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%GridOutputs,1), UBOUND(OutData%GridOutputs,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FVW_UnpackGridOutType( Re_Buf, Db_Buf, Int_Buf, OutData%GridOutputs(i1), ErrStat2, ErrMsg2 ) ! GridOutputs - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - END SUBROUTINE FVW_UnPackMisc +subroutine FVW_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FVW_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackMisc' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + ! W + call RegPack(Buf, allocated(InData%W)) + if (allocated(InData%W)) then + call RegPackBounds(Buf, 1, lbound(InData%W), ubound(InData%W)) + LB(1:1) = lbound(InData%W) + UB(1:1) = ubound(InData%W) + do i1 = LB(1), UB(1) + call FVW_PackWng_MiscVarType(Buf, InData%W(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FirstCall + call RegPack(Buf, InData%FirstCall) + if (RegCheckErr(Buf, RoutineName)) return + ! nNW + call RegPack(Buf, InData%nNW) + if (RegCheckErr(Buf, RoutineName)) return + ! nFW + call RegPack(Buf, InData%nFW) + if (RegCheckErr(Buf, RoutineName)) return + ! iStep + call RegPack(Buf, InData%iStep) + if (RegCheckErr(Buf, RoutineName)) return + ! VTKstep + call RegPack(Buf, InData%VTKstep) + if (RegCheckErr(Buf, RoutineName)) return + ! VTKlastTime + call RegPack(Buf, InData%VTKlastTime) + if (RegCheckErr(Buf, RoutineName)) return + ! r_wind + call RegPack(Buf, allocated(InData%r_wind)) + if (allocated(InData%r_wind)) then + call RegPackBounds(Buf, 2, lbound(InData%r_wind), ubound(InData%r_wind)) + call RegPack(Buf, InData%r_wind) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ComputeWakeInduced + call RegPack(Buf, InData%ComputeWakeInduced) + if (RegCheckErr(Buf, RoutineName)) return + ! OldWakeTime + call RegPack(Buf, InData%OldWakeTime) + if (RegCheckErr(Buf, RoutineName)) return + ! dxdt + call FVW_PackContState(Buf, InData%dxdt) + if (RegCheckErr(Buf, RoutineName)) return + ! x1 + call FVW_PackContState(Buf, InData%x1) + if (RegCheckErr(Buf, RoutineName)) return + ! x2 + call FVW_PackContState(Buf, InData%x2) + if (RegCheckErr(Buf, RoutineName)) return + ! t1 + call RegPack(Buf, InData%t1) + if (RegCheckErr(Buf, RoutineName)) return + ! t2 + call RegPack(Buf, InData%t2) + if (RegCheckErr(Buf, RoutineName)) return + ! UA_Flag + call RegPack(Buf, InData%UA_Flag) + if (RegCheckErr(Buf, RoutineName)) return + ! Sgmt + call FVW_PackT_Sgmt(Buf, InData%Sgmt) + if (RegCheckErr(Buf, RoutineName)) return + ! Part + call FVW_PackT_Part(Buf, InData%Part) + if (RegCheckErr(Buf, RoutineName)) return + ! CPs + call RegPack(Buf, allocated(InData%CPs)) + if (allocated(InData%CPs)) then + call RegPackBounds(Buf, 2, lbound(InData%CPs), ubound(InData%CPs)) + call RegPack(Buf, InData%CPs) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Uind + call RegPack(Buf, allocated(InData%Uind)) + if (allocated(InData%Uind)) then + call RegPackBounds(Buf, 2, lbound(InData%Uind), ubound(InData%Uind)) + call RegPack(Buf, InData%Uind) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! GridOutputs + call RegPack(Buf, allocated(InData%GridOutputs)) + if (allocated(InData%GridOutputs)) then + call RegPackBounds(Buf, 1, lbound(InData%GridOutputs), ubound(InData%GridOutputs)) + LB(1:1) = lbound(InData%GridOutputs) + UB(1:1) = ubound(InData%GridOutputs) + do i1 = LB(1), UB(1) + call FVW_PackGridOutType(Buf, InData%GridOutputs(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FVW_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackMisc' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! W + if (allocated(OutData%W)) deallocate(OutData%W) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%W(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FVW_UnpackWng_MiscVarType(Buf, OutData%W(i1)) ! W + end do + end if + ! FirstCall + call RegUnpack(Buf, OutData%FirstCall) + if (RegCheckErr(Buf, RoutineName)) return + ! nNW + call RegUnpack(Buf, OutData%nNW) + if (RegCheckErr(Buf, RoutineName)) return + ! nFW + call RegUnpack(Buf, OutData%nFW) + if (RegCheckErr(Buf, RoutineName)) return + ! iStep + call RegUnpack(Buf, OutData%iStep) + if (RegCheckErr(Buf, RoutineName)) return + ! VTKstep + call RegUnpack(Buf, OutData%VTKstep) + if (RegCheckErr(Buf, RoutineName)) return + ! VTKlastTime + call RegUnpack(Buf, OutData%VTKlastTime) + if (RegCheckErr(Buf, RoutineName)) return + ! r_wind + if (allocated(OutData%r_wind)) deallocate(OutData%r_wind) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%r_wind(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_wind.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%r_wind) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ComputeWakeInduced + call RegUnpack(Buf, OutData%ComputeWakeInduced) + if (RegCheckErr(Buf, RoutineName)) return + ! OldWakeTime + call RegUnpack(Buf, OutData%OldWakeTime) + if (RegCheckErr(Buf, RoutineName)) return + ! dxdt + call FVW_UnpackContState(Buf, OutData%dxdt) ! dxdt + ! x1 + call FVW_UnpackContState(Buf, OutData%x1) ! x1 + ! x2 + call FVW_UnpackContState(Buf, OutData%x2) ! x2 + ! t1 + call RegUnpack(Buf, OutData%t1) + if (RegCheckErr(Buf, RoutineName)) return + ! t2 + call RegUnpack(Buf, OutData%t2) + if (RegCheckErr(Buf, RoutineName)) return + ! UA_Flag + call RegUnpack(Buf, OutData%UA_Flag) + if (RegCheckErr(Buf, RoutineName)) return + ! Sgmt + call FVW_UnpackT_Sgmt(Buf, OutData%Sgmt) ! Sgmt + ! Part + call FVW_UnpackT_Part(Buf, OutData%Part) ! Part + ! CPs + if (allocated(OutData%CPs)) deallocate(OutData%CPs) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CPs(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CPs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CPs) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Uind + if (allocated(OutData%Uind)) deallocate(OutData%Uind) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Uind(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Uind.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Uind) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! GridOutputs + if (allocated(OutData%GridOutputs)) deallocate(OutData%GridOutputs) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%GridOutputs(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GridOutputs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FVW_UnpackGridOutType(Buf, OutData%GridOutputs(i1)) ! GridOutputs + end do + end if +end subroutine SUBROUTINE FVW_CopyRot_InputType( SrcRot_InputTypeData, DstRot_InputTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(Rot_InputType), INTENT(IN) :: SrcRot_InputTypeData TYPE(Rot_InputType), INTENT(INOUT) :: DstRot_InputTypeData @@ -8041,128 +4437,32 @@ SUBROUTINE FVW_DestroyRot_InputType( Rot_InputTypeData, ErrStat, ErrMsg ) END SUBROUTINE FVW_DestroyRot_InputType - SUBROUTINE FVW_PackRot_InputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Rot_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_PackRot_InputType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + SIZE(InData%HubOrientation) ! HubOrientation - Re_BufSz = Re_BufSz + SIZE(InData%HubPosition) ! HubPosition - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i2 = LBOUND(InData%HubOrientation,2), UBOUND(InData%HubOrientation,2) - DO i1 = LBOUND(InData%HubOrientation,1), UBOUND(InData%HubOrientation,1) - ReKiBuf(Re_Xferred) = InData%HubOrientation(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i1 = LBOUND(InData%HubPosition,1), UBOUND(InData%HubPosition,1) - ReKiBuf(Re_Xferred) = InData%HubPosition(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE FVW_PackRot_InputType - - SUBROUTINE FVW_UnPackRot_InputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Rot_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_UnPackRot_InputType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%HubOrientation,1) - i1_u = UBOUND(OutData%HubOrientation,1) - i2_l = LBOUND(OutData%HubOrientation,2) - i2_u = UBOUND(OutData%HubOrientation,2) - DO i2 = LBOUND(OutData%HubOrientation,2), UBOUND(OutData%HubOrientation,2) - DO i1 = LBOUND(OutData%HubOrientation,1), UBOUND(OutData%HubOrientation,1) - OutData%HubOrientation(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%HubPosition,1) - i1_u = UBOUND(OutData%HubPosition,1) - DO i1 = LBOUND(OutData%HubPosition,1), UBOUND(OutData%HubPosition,1) - OutData%HubPosition(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE FVW_UnPackRot_InputType +subroutine FVW_PackRot_InputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Rot_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackRot_InputType' + if (Buf%ErrStat >= AbortErrLev) return + ! HubOrientation + call RegPack(Buf, InData%HubOrientation) + if (RegCheckErr(Buf, RoutineName)) return + ! HubPosition + call RegPack(Buf, InData%HubPosition) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_UnPackRot_InputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Rot_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackRot_InputType' + if (Buf%ErrStat /= ErrID_None) return + ! HubOrientation + call RegUnpack(Buf, OutData%HubOrientation) + if (RegCheckErr(Buf, RoutineName)) return + ! HubPosition + call RegUnpack(Buf, OutData%HubPosition) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE FVW_CopyWng_InputType( SrcWng_InputTypeData, DstWng_InputTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(Wng_InputType), INTENT(IN) :: SrcWng_InputTypeData TYPE(Wng_InputType), INTENT(INOUT) :: DstWng_InputTypeData @@ -8228,186 +4528,67 @@ SUBROUTINE FVW_DestroyWng_InputType( Wng_InputTypeData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE FVW_DestroyWng_InputType - SUBROUTINE FVW_PackWng_InputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Wng_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_PackWng_InputType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! Vwnd_LL allocated yes/no - IF ( ALLOCATED(InData%Vwnd_LL) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vwnd_LL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vwnd_LL) ! Vwnd_LL - END IF - Int_BufSz = Int_BufSz + 1 ! omega_z allocated yes/no - IF ( ALLOCATED(InData%omega_z) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! omega_z upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%omega_z) ! omega_z - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%Vwnd_LL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_LL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_LL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_LL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_LL,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vwnd_LL,2), UBOUND(InData%Vwnd_LL,2) - DO i1 = LBOUND(InData%Vwnd_LL,1), UBOUND(InData%Vwnd_LL,1) - ReKiBuf(Re_Xferred) = InData%Vwnd_LL(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%omega_z) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%omega_z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%omega_z,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%omega_z,1), UBOUND(InData%omega_z,1) - ReKiBuf(Re_Xferred) = InData%omega_z(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FVW_PackWng_InputType - - SUBROUTINE FVW_UnPackWng_InputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Wng_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_UnPackWng_InputType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vwnd_LL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vwnd_LL)) DEALLOCATE(OutData%Vwnd_LL) - ALLOCATE(OutData%Vwnd_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vwnd_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vwnd_LL,2), UBOUND(OutData%Vwnd_LL,2) - DO i1 = LBOUND(OutData%Vwnd_LL,1), UBOUND(OutData%Vwnd_LL,1) - OutData%Vwnd_LL(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! omega_z not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%omega_z)) DEALLOCATE(OutData%omega_z) - ALLOCATE(OutData%omega_z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%omega_z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%omega_z,1), UBOUND(OutData%omega_z,1) - OutData%omega_z(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FVW_UnPackWng_InputType +subroutine FVW_PackWng_InputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Wng_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackWng_InputType' + if (Buf%ErrStat >= AbortErrLev) return + ! Vwnd_LL + call RegPack(Buf, allocated(InData%Vwnd_LL)) + if (allocated(InData%Vwnd_LL)) then + call RegPackBounds(Buf, 2, lbound(InData%Vwnd_LL), ubound(InData%Vwnd_LL)) + call RegPack(Buf, InData%Vwnd_LL) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! omega_z + call RegPack(Buf, allocated(InData%omega_z)) + if (allocated(InData%omega_z)) then + call RegPackBounds(Buf, 1, lbound(InData%omega_z), ubound(InData%omega_z)) + call RegPack(Buf, InData%omega_z) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_UnPackWng_InputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Wng_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackWng_InputType' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! Vwnd_LL + if (allocated(OutData%Vwnd_LL)) deallocate(OutData%Vwnd_LL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vwnd_LL(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vwnd_LL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vwnd_LL) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! omega_z + if (allocated(OutData%omega_z)) deallocate(OutData%omega_z) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%omega_z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%omega_z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%omega_z) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE FVW_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(FVW_InputType), INTENT(INOUT) :: SrcInputData TYPE(FVW_InputType), INTENT(INOUT) :: DstInputData @@ -8527,509 +4708,129 @@ SUBROUTINE FVW_DestroyInput( InputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE FVW_DestroyInput - SUBROUTINE FVW_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FVW_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! rotors allocated yes/no - IF ( ALLOCATED(InData%rotors) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rotors upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - Int_BufSz = Int_BufSz + 3 ! rotors: size of buffers for each call to pack subtype - CALL FVW_PackRot_InputType( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, .TRUE. ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! rotors - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! rotors - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! rotors - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! W allocated yes/no - IF ( ALLOCATED(InData%W) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! W upper/lower bounds for each dimension - DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) - Int_BufSz = Int_BufSz + 3 ! W: size of buffers for each call to pack subtype - CALL FVW_PackWng_InputType( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, .TRUE. ) ! W - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! W - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! W - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! W - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! WingsMesh allocated yes/no - IF ( ALLOCATED(InData%WingsMesh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WingsMesh upper/lower bounds for each dimension - DO i1 = LBOUND(InData%WingsMesh,1), UBOUND(InData%WingsMesh,1) - Int_BufSz = Int_BufSz + 3 ! WingsMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%WingsMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! WingsMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WingsMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WingsMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WingsMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! V_wind allocated yes/no - IF ( ALLOCATED(InData%V_wind) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! V_wind upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%V_wind) ! V_wind - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%rotors) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rotors,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rotors,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rotors,1), UBOUND(InData%rotors,1) - CALL FVW_PackRot_InputType( Re_Buf, Db_Buf, Int_Buf, InData%rotors(i1), ErrStat2, ErrMsg2, OnlySize ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%W) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%W,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) - CALL FVW_PackWng_InputType( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, OnlySize ) ! W - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WingsMesh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WingsMesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WingsMesh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WingsMesh,1), UBOUND(InData%WingsMesh,1) - CALL MeshPack( InData%WingsMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! WingsMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%V_wind) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%V_wind,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V_wind,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%V_wind,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V_wind,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%V_wind,2), UBOUND(InData%V_wind,2) - DO i1 = LBOUND(InData%V_wind,1), UBOUND(InData%V_wind,1) - ReKiBuf(Re_Xferred) = InData%V_wind(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE FVW_PackInput - - SUBROUTINE FVW_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FVW_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rotors not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rotors)) DEALLOCATE(OutData%rotors) - ALLOCATE(OutData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rotors,1), UBOUND(OutData%rotors,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FVW_UnpackRot_InputType( Re_Buf, Db_Buf, Int_Buf, OutData%rotors(i1), ErrStat2, ErrMsg2 ) ! rotors - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! W not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%W)) DEALLOCATE(OutData%W) - ALLOCATE(OutData%W(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%W,1), UBOUND(OutData%W,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FVW_UnpackWng_InputType( Re_Buf, Db_Buf, Int_Buf, OutData%W(i1), ErrStat2, ErrMsg2 ) ! W - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WingsMesh not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WingsMesh)) DEALLOCATE(OutData%WingsMesh) - ALLOCATE(OutData%WingsMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WingsMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WingsMesh,1), UBOUND(OutData%WingsMesh,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%WingsMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! WingsMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! V_wind not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%V_wind)) DEALLOCATE(OutData%V_wind) - ALLOCATE(OutData%V_wind(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%V_wind.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%V_wind,2), UBOUND(OutData%V_wind,2) - DO i1 = LBOUND(OutData%V_wind,1), UBOUND(OutData%V_wind,1) - OutData%V_wind(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE FVW_UnPackInput +subroutine FVW_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FVW_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackInput' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + ! rotors + call RegPack(Buf, allocated(InData%rotors)) + if (allocated(InData%rotors)) then + call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) + LB(1:1) = lbound(InData%rotors) + UB(1:1) = ubound(InData%rotors) + do i1 = LB(1), UB(1) + call FVW_PackRot_InputType(Buf, InData%rotors(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! W + call RegPack(Buf, allocated(InData%W)) + if (allocated(InData%W)) then + call RegPackBounds(Buf, 1, lbound(InData%W), ubound(InData%W)) + LB(1:1) = lbound(InData%W) + UB(1:1) = ubound(InData%W) + do i1 = LB(1), UB(1) + call FVW_PackWng_InputType(Buf, InData%W(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WingsMesh + call RegPack(Buf, allocated(InData%WingsMesh)) + if (allocated(InData%WingsMesh)) then + call RegPackBounds(Buf, 1, lbound(InData%WingsMesh), ubound(InData%WingsMesh)) + LB(1:1) = lbound(InData%WingsMesh) + UB(1:1) = ubound(InData%WingsMesh) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%WingsMesh(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! V_wind + call RegPack(Buf, allocated(InData%V_wind)) + if (allocated(InData%V_wind)) then + call RegPackBounds(Buf, 2, lbound(InData%V_wind), ubound(InData%V_wind)) + call RegPack(Buf, InData%V_wind) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FVW_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackInput' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! rotors + if (allocated(OutData%rotors)) deallocate(OutData%rotors) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rotors(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rotors.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FVW_UnpackRot_InputType(Buf, OutData%rotors(i1)) ! rotors + end do + end if + ! W + if (allocated(OutData%W)) deallocate(OutData%W) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%W(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FVW_UnpackWng_InputType(Buf, OutData%W(i1)) ! W + end do + end if + ! WingsMesh + if (allocated(OutData%WingsMesh)) deallocate(OutData%WingsMesh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WingsMesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WingsMesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%WingsMesh(i1)) ! WingsMesh + end do + end if + ! V_wind + if (allocated(OutData%V_wind)) deallocate(OutData%V_wind) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%V_wind(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%V_wind.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%V_wind) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE FVW_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(FVW_DiscreteStateType), INTENT(IN) :: SrcDiscStateData TYPE(FVW_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData @@ -9086,225 +4887,59 @@ SUBROUTINE FVW_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE FVW_DestroyDiscState - SUBROUTINE FVW_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FVW_DiscreteStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_PackDiscState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! Dummy - Int_BufSz = Int_BufSz + 1 ! UA allocated yes/no - IF ( ALLOCATED(InData%UA) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UA upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%UA,1), UBOUND(InData%UA,1) - Int_BufSz = Int_BufSz + 3 ! UA: size of buffers for each call to pack subtype - CALL UA_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%UA(i1), ErrStat2, ErrMsg2, .TRUE. ) ! UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! UA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! UA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! UA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%Dummy - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%UA) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UA,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UA,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UA,1), UBOUND(InData%UA,1) - CALL UA_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%UA(i1), ErrStat2, ErrMsg2, OnlySize ) ! UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - END SUBROUTINE FVW_PackDiscState - - SUBROUTINE FVW_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FVW_DiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_UnPackDiscState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%Dummy = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UA not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%UA)) DEALLOCATE(OutData%UA) - ALLOCATE(OutData%UA(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UA,1), UBOUND(OutData%UA,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL UA_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%UA(i1), ErrStat2, ErrMsg2 ) ! UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - END SUBROUTINE FVW_UnPackDiscState +subroutine FVW_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FVW_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackDiscState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! Dummy + call RegPack(Buf, InData%Dummy) + if (RegCheckErr(Buf, RoutineName)) return + ! UA + call RegPack(Buf, allocated(InData%UA)) + if (allocated(InData%UA)) then + call RegPackBounds(Buf, 1, lbound(InData%UA), ubound(InData%UA)) + LB(1:1) = lbound(InData%UA) + UB(1:1) = ubound(InData%UA) + do i1 = LB(1), UB(1) + call UA_PackDiscState(Buf, InData%UA(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FVW_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackDiscState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! Dummy + call RegUnpack(Buf, OutData%Dummy) + if (RegCheckErr(Buf, RoutineName)) return + ! UA + if (allocated(OutData%UA)) deallocate(OutData%UA) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%UA(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UA.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call UA_UnpackDiscState(Buf, OutData%UA(i1)) ! UA + end do + end if +end subroutine SUBROUTINE FVW_CopyWng_ConstraintStateType( SrcWng_ConstraintStateTypeData, DstWng_ConstraintStateTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(Wng_ConstraintStateType), INTENT(IN) :: SrcWng_ConstraintStateTypeData TYPE(Wng_ConstraintStateType), INTENT(INOUT) :: DstWng_ConstraintStateTypeData @@ -9352,137 +4987,45 @@ SUBROUTINE FVW_DestroyWng_ConstraintStateType( Wng_ConstraintStateTypeData, ErrS ENDIF END SUBROUTINE FVW_DestroyWng_ConstraintStateType - SUBROUTINE FVW_PackWng_ConstraintStateType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Wng_ConstraintStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_PackWng_ConstraintStateType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! Gamma_LL allocated yes/no - IF ( ALLOCATED(InData%Gamma_LL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Gamma_LL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Gamma_LL) ! Gamma_LL - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%Gamma_LL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Gamma_LL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma_LL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Gamma_LL,1), UBOUND(InData%Gamma_LL,1) - ReKiBuf(Re_Xferred) = InData%Gamma_LL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FVW_PackWng_ConstraintStateType - - SUBROUTINE FVW_UnPackWng_ConstraintStateType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Wng_ConstraintStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_UnPackWng_ConstraintStateType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Gamma_LL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Gamma_LL)) DEALLOCATE(OutData%Gamma_LL) - ALLOCATE(OutData%Gamma_LL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gamma_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Gamma_LL,1), UBOUND(OutData%Gamma_LL,1) - OutData%Gamma_LL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FVW_UnPackWng_ConstraintStateType +subroutine FVW_PackWng_ConstraintStateType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Wng_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackWng_ConstraintStateType' + if (Buf%ErrStat >= AbortErrLev) return + ! Gamma_LL + call RegPack(Buf, allocated(InData%Gamma_LL)) + if (allocated(InData%Gamma_LL)) then + call RegPackBounds(Buf, 1, lbound(InData%Gamma_LL), ubound(InData%Gamma_LL)) + call RegPack(Buf, InData%Gamma_LL) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_UnPackWng_ConstraintStateType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Wng_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackWng_ConstraintStateType' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! Gamma_LL + if (allocated(OutData%Gamma_LL)) deallocate(OutData%Gamma_LL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Gamma_LL(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gamma_LL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Gamma_LL) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE FVW_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(FVW_ConstraintStateType), INTENT(IN) :: SrcConstrStateData TYPE(FVW_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData @@ -9539,225 +5082,59 @@ SUBROUTINE FVW_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE FVW_DestroyConstrState - SUBROUTINE FVW_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FVW_ConstraintStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_PackConstrState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! W allocated yes/no - IF ( ALLOCATED(InData%W) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! W upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) - Int_BufSz = Int_BufSz + 3 ! W: size of buffers for each call to pack subtype - CALL FVW_PackWng_ConstraintStateType( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, .TRUE. ) ! W - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! W - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! W - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! W - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Re_BufSz = Re_BufSz + 1 ! residual - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%W) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%W,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) - CALL FVW_PackWng_ConstraintStateType( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, OnlySize ) ! W - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - ReKiBuf(Re_Xferred) = InData%residual - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE FVW_PackConstrState - - SUBROUTINE FVW_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FVW_ConstraintStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_UnPackConstrState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! W not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%W)) DEALLOCATE(OutData%W) - ALLOCATE(OutData%W(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%W,1), UBOUND(OutData%W,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FVW_UnpackWng_ConstraintStateType( Re_Buf, Db_Buf, Int_Buf, OutData%W(i1), ErrStat2, ErrMsg2 ) ! W - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - OutData%residual = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE FVW_UnPackConstrState +subroutine FVW_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FVW_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackConstrState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! W + call RegPack(Buf, allocated(InData%W)) + if (allocated(InData%W)) then + call RegPackBounds(Buf, 1, lbound(InData%W), ubound(InData%W)) + LB(1:1) = lbound(InData%W) + UB(1:1) = ubound(InData%W) + do i1 = LB(1), UB(1) + call FVW_PackWng_ConstraintStateType(Buf, InData%W(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! residual + call RegPack(Buf, InData%residual) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FVW_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackConstrState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! W + if (allocated(OutData%W)) deallocate(OutData%W) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%W(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FVW_UnpackWng_ConstraintStateType(Buf, OutData%W(i1)) ! W + end do + end if + ! residual + call RegUnpack(Buf, OutData%residual) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE FVW_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(FVW_OtherStateType), INTENT(IN) :: SrcOtherStateData TYPE(FVW_OtherStateType), INTENT(INOUT) :: DstOtherStateData @@ -9814,225 +5191,59 @@ SUBROUTINE FVW_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE FVW_DestroyOtherState - SUBROUTINE FVW_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FVW_OtherStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_PackOtherState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! Dummy - Int_BufSz = Int_BufSz + 1 ! UA allocated yes/no - IF ( ALLOCATED(InData%UA) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UA upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%UA,1), UBOUND(InData%UA,1) - Int_BufSz = Int_BufSz + 3 ! UA: size of buffers for each call to pack subtype - CALL UA_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%UA(i1), ErrStat2, ErrMsg2, .TRUE. ) ! UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! UA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! UA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! UA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%Dummy - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%UA) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UA,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UA,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UA,1), UBOUND(InData%UA,1) - CALL UA_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%UA(i1), ErrStat2, ErrMsg2, OnlySize ) ! UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - END SUBROUTINE FVW_PackOtherState - - SUBROUTINE FVW_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FVW_OtherStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_UnPackOtherState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%Dummy = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UA not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%UA)) DEALLOCATE(OutData%UA) - ALLOCATE(OutData%UA(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UA,1), UBOUND(OutData%UA,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL UA_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%UA(i1), ErrStat2, ErrMsg2 ) ! UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - END SUBROUTINE FVW_UnPackOtherState +subroutine FVW_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FVW_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackOtherState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! Dummy + call RegPack(Buf, InData%Dummy) + if (RegCheckErr(Buf, RoutineName)) return + ! UA + call RegPack(Buf, allocated(InData%UA)) + if (allocated(InData%UA)) then + call RegPackBounds(Buf, 1, lbound(InData%UA), ubound(InData%UA)) + LB(1:1) = lbound(InData%UA) + UB(1:1) = ubound(InData%UA) + do i1 = LB(1), UB(1) + call UA_PackOtherState(Buf, InData%UA(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FVW_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackOtherState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! Dummy + call RegUnpack(Buf, OutData%Dummy) + if (RegCheckErr(Buf, RoutineName)) return + ! UA + if (allocated(OutData%UA)) deallocate(OutData%UA) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%UA(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UA.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call UA_UnpackOtherState(Buf, OutData%UA(i1)) ! UA + end do + end if +end subroutine SUBROUTINE FVW_CopyWng_InitInputType( SrcWng_InitInputTypeData, DstWng_InitInputTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(Wng_InitInputType), INTENT(IN) :: SrcWng_InitInputTypeData TYPE(Wng_InitInputType), INTENT(INOUT) :: DstWng_InitInputTypeData @@ -10116,239 +5327,107 @@ SUBROUTINE FVW_DestroyWng_InitInputType( Wng_InitInputTypeData, ErrStat, ErrMsg ENDIF END SUBROUTINE FVW_DestroyWng_InitInputType - SUBROUTINE FVW_PackWng_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Wng_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_PackWng_InitInputType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! AFindx allocated yes/no - IF ( ALLOCATED(InData%AFindx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AFindx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%AFindx) ! AFindx - END IF - Int_BufSz = Int_BufSz + 1 ! chord allocated yes/no - IF ( ALLOCATED(InData%chord) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! chord upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%chord) ! chord - END IF - Int_BufSz = Int_BufSz + 1 ! RElm allocated yes/no - IF ( ALLOCATED(InData%RElm) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RElm upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%RElm) ! RElm - END IF - Int_BufSz = Int_BufSz + 1 ! iRotor - Int_BufSz = Int_BufSz + 1 ! UAOff_innerNode - Int_BufSz = Int_BufSz + 1 ! UAOff_outerNode - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%AFindx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFindx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFindx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFindx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFindx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AFindx,2), UBOUND(InData%AFindx,2) - DO i1 = LBOUND(InData%AFindx,1), UBOUND(InData%AFindx,1) - IntKiBuf(Int_Xferred) = InData%AFindx(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%chord) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%chord,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chord,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%chord,1), UBOUND(InData%chord,1) - ReKiBuf(Re_Xferred) = InData%chord(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RElm) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RElm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RElm,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RElm,1), UBOUND(InData%RElm,1) - ReKiBuf(Re_Xferred) = InData%RElm(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%iRotor - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UAOff_innerNode - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UAOff_outerNode - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FVW_PackWng_InitInputType - - SUBROUTINE FVW_UnPackWng_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Wng_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_UnPackWng_InitInputType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFindx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AFindx)) DEALLOCATE(OutData%AFindx) - ALLOCATE(OutData%AFindx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFindx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AFindx,2), UBOUND(OutData%AFindx,2) - DO i1 = LBOUND(OutData%AFindx,1), UBOUND(OutData%AFindx,1) - OutData%AFindx(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! chord not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%chord)) DEALLOCATE(OutData%chord) - ALLOCATE(OutData%chord(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%chord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%chord,1), UBOUND(OutData%chord,1) - OutData%chord(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RElm not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RElm)) DEALLOCATE(OutData%RElm) - ALLOCATE(OutData%RElm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RElm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RElm,1), UBOUND(OutData%RElm,1) - OutData%RElm(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%iRotor = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UAOff_innerNode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UAOff_outerNode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FVW_UnPackWng_InitInputType +subroutine FVW_PackWng_InitInputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Wng_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackWng_InitInputType' + if (Buf%ErrStat >= AbortErrLev) return + ! AFindx + call RegPack(Buf, allocated(InData%AFindx)) + if (allocated(InData%AFindx)) then + call RegPackBounds(Buf, 2, lbound(InData%AFindx), ubound(InData%AFindx)) + call RegPack(Buf, InData%AFindx) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! chord + call RegPack(Buf, allocated(InData%chord)) + if (allocated(InData%chord)) then + call RegPackBounds(Buf, 1, lbound(InData%chord), ubound(InData%chord)) + call RegPack(Buf, InData%chord) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RElm + call RegPack(Buf, allocated(InData%RElm)) + if (allocated(InData%RElm)) then + call RegPackBounds(Buf, 1, lbound(InData%RElm), ubound(InData%RElm)) + call RegPack(Buf, InData%RElm) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! iRotor + call RegPack(Buf, InData%iRotor) + if (RegCheckErr(Buf, RoutineName)) return + ! UAOff_innerNode + call RegPack(Buf, InData%UAOff_innerNode) + if (RegCheckErr(Buf, RoutineName)) return + ! UAOff_outerNode + call RegPack(Buf, InData%UAOff_outerNode) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_UnPackWng_InitInputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Wng_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackWng_InitInputType' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! AFindx + if (allocated(OutData%AFindx)) deallocate(OutData%AFindx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AFindx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFindx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AFindx) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! chord + if (allocated(OutData%chord)) deallocate(OutData%chord) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%chord(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%chord.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%chord) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RElm + if (allocated(OutData%RElm)) deallocate(OutData%RElm) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RElm(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RElm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RElm) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! iRotor + call RegUnpack(Buf, OutData%iRotor) + if (RegCheckErr(Buf, RoutineName)) return + ! UAOff_innerNode + call RegUnpack(Buf, OutData%UAOff_innerNode) + if (RegCheckErr(Buf, RoutineName)) return + ! UAOff_outerNode + call RegUnpack(Buf, OutData%UAOff_outerNode) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE FVW_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(FVW_InitInputType), INTENT(INOUT) :: SrcInitInputData TYPE(FVW_InitInputType), INTENT(INOUT) :: DstInitInputData @@ -10439,408 +5518,152 @@ SUBROUTINE FVW_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE FVW_DestroyInitInput - SUBROUTINE FVW_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FVW_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%FVWFileName) ! FVWFileName - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1 ! W allocated yes/no - IF ( ALLOCATED(InData%W) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! W upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) - Int_BufSz = Int_BufSz + 3 ! W: size of buffers for each call to pack subtype - CALL FVW_PackWng_InitInputType( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, .TRUE. ) ! W - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! W - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! W - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! W - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! WingsMesh allocated yes/no - IF ( ALLOCATED(InData%WingsMesh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WingsMesh upper/lower bounds for each dimension - DO i1 = LBOUND(InData%WingsMesh,1), UBOUND(InData%WingsMesh,1) - Int_BufSz = Int_BufSz + 3 ! WingsMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%WingsMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! WingsMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WingsMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WingsMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WingsMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! numBladeNodes - Db_BufSz = Db_BufSz + 1 ! DTaero - Re_BufSz = Re_BufSz + 1 ! KinVisc - Int_BufSz = Int_BufSz + 1 ! MHK - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Int_BufSz = Int_BufSz + 1 ! UAMod - Int_BufSz = Int_BufSz + 1 ! UA_Flag - Int_BufSz = Int_BufSz + 1 ! Flookup - Re_BufSz = Re_BufSz + 1 ! a_s - Int_BufSz = Int_BufSz + 1 ! SumPrint - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%FVWFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%FVWFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%W) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%W,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) - CALL FVW_PackWng_InitInputType( Re_Buf, Db_Buf, Int_Buf, InData%W(i1), ErrStat2, ErrMsg2, OnlySize ) ! W - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WingsMesh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WingsMesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WingsMesh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WingsMesh,1), UBOUND(InData%WingsMesh,1) - CALL MeshPack( InData%WingsMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! WingsMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IntKiBuf(Int_Xferred) = InData%numBladeNodes - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%DTaero - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%KinVisc - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MHK - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UAMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UA_Flag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Flookup, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%a_s - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FVW_PackInitInput - - SUBROUTINE FVW_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FVW_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%FVWFileName) - OutData%FVWFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! W not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%W)) DEALLOCATE(OutData%W) - ALLOCATE(OutData%W(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%W,1), UBOUND(OutData%W,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FVW_UnpackWng_InitInputType( Re_Buf, Db_Buf, Int_Buf, OutData%W(i1), ErrStat2, ErrMsg2 ) ! W - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WingsMesh not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WingsMesh)) DEALLOCATE(OutData%WingsMesh) - ALLOCATE(OutData%WingsMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WingsMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WingsMesh,1), UBOUND(OutData%WingsMesh,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%WingsMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! WingsMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - OutData%numBladeNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%DTaero = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%KinVisc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MHK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%UAMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UA_Flag = TRANSFER(IntKiBuf(Int_Xferred), OutData%UA_Flag) - Int_Xferred = Int_Xferred + 1 - OutData%Flookup = TRANSFER(IntKiBuf(Int_Xferred), OutData%Flookup) - Int_Xferred = Int_Xferred + 1 - OutData%a_s = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FVW_UnPackInitInput +subroutine FVW_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FVW_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackInitInput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! FVWFileName + call RegPack(Buf, InData%FVWFileName) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegPack(Buf, InData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! W + call RegPack(Buf, allocated(InData%W)) + if (allocated(InData%W)) then + call RegPackBounds(Buf, 1, lbound(InData%W), ubound(InData%W)) + LB(1:1) = lbound(InData%W) + UB(1:1) = ubound(InData%W) + do i1 = LB(1), UB(1) + call FVW_PackWng_InitInputType(Buf, InData%W(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WingsMesh + call RegPack(Buf, allocated(InData%WingsMesh)) + if (allocated(InData%WingsMesh)) then + call RegPackBounds(Buf, 1, lbound(InData%WingsMesh), ubound(InData%WingsMesh)) + LB(1:1) = lbound(InData%WingsMesh) + UB(1:1) = ubound(InData%WingsMesh) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%WingsMesh(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! numBladeNodes + call RegPack(Buf, InData%numBladeNodes) + if (RegCheckErr(Buf, RoutineName)) return + ! DTaero + call RegPack(Buf, InData%DTaero) + if (RegCheckErr(Buf, RoutineName)) return + ! KinVisc + call RegPack(Buf, InData%KinVisc) + if (RegCheckErr(Buf, RoutineName)) return + ! MHK + call RegPack(Buf, InData%MHK) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDpth + call RegPack(Buf, InData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! UAMod + call RegPack(Buf, InData%UAMod) + if (RegCheckErr(Buf, RoutineName)) return + ! UA_Flag + call RegPack(Buf, InData%UA_Flag) + if (RegCheckErr(Buf, RoutineName)) return + ! Flookup + call RegPack(Buf, InData%Flookup) + if (RegCheckErr(Buf, RoutineName)) return + ! a_s + call RegPack(Buf, InData%a_s) + if (RegCheckErr(Buf, RoutineName)) return + ! SumPrint + call RegPack(Buf, InData%SumPrint) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FVW_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackInitInput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! FVWFileName + call RegUnpack(Buf, OutData%FVWFileName) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! W + if (allocated(OutData%W)) deallocate(OutData%W) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%W(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FVW_UnpackWng_InitInputType(Buf, OutData%W(i1)) ! W + end do + end if + ! WingsMesh + if (allocated(OutData%WingsMesh)) deallocate(OutData%WingsMesh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WingsMesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WingsMesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%WingsMesh(i1)) ! WingsMesh + end do + end if + ! numBladeNodes + call RegUnpack(Buf, OutData%numBladeNodes) + if (RegCheckErr(Buf, RoutineName)) return + ! DTaero + call RegUnpack(Buf, OutData%DTaero) + if (RegCheckErr(Buf, RoutineName)) return + ! KinVisc + call RegUnpack(Buf, OutData%KinVisc) + if (RegCheckErr(Buf, RoutineName)) return + ! MHK + call RegUnpack(Buf, OutData%MHK) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDpth + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! UAMod + call RegUnpack(Buf, OutData%UAMod) + if (RegCheckErr(Buf, RoutineName)) return + ! UA_Flag + call RegUnpack(Buf, OutData%UA_Flag) + if (RegCheckErr(Buf, RoutineName)) return + ! Flookup + call RegUnpack(Buf, OutData%Flookup) + if (RegCheckErr(Buf, RoutineName)) return + ! a_s + call RegUnpack(Buf, OutData%a_s) + if (RegCheckErr(Buf, RoutineName)) return + ! SumPrint + call RegUnpack(Buf, OutData%SumPrint) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE FVW_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) TYPE(FVW_InputFile), INTENT(IN) :: SrcInputFileData TYPE(FVW_InputFile), INTENT(INOUT) :: DstInputFileData @@ -10905,281 +5728,212 @@ SUBROUTINE FVW_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) END SUBROUTINE FVW_DestroyInputFile - SUBROUTINE FVW_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FVW_InputFile), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_PackInputFile' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! CircSolvMethod - Int_BufSz = Int_BufSz + 1*LEN(InData%CirculationFile) ! CirculationFile - Int_BufSz = Int_BufSz + 1 ! CircSolvMaxIter - Re_BufSz = Re_BufSz + 1 ! CircSolvConvCrit - Re_BufSz = Re_BufSz + 1 ! CircSolvRelaxation - Int_BufSz = Int_BufSz + 1 ! IntMethod - Int_BufSz = Int_BufSz + 1 ! FreeWake - Re_BufSz = Re_BufSz + 1 ! FreeWakeStart - Re_BufSz = Re_BufSz + 1 ! FullCircStart - Db_BufSz = Db_BufSz + 1 ! DTfvw - Int_BufSz = Int_BufSz + 1 ! CircSolvPolar - Int_BufSz = Int_BufSz + 1 ! nNWPanels - Int_BufSz = Int_BufSz + 1 ! nNWPanelsFree - Int_BufSz = Int_BufSz + 1 ! nFWPanels - Int_BufSz = Int_BufSz + 1 ! nFWPanelsFree - Int_BufSz = Int_BufSz + 1 ! FWShedVorticity - Int_BufSz = Int_BufSz + 1 ! DiffusionMethod - Re_BufSz = Re_BufSz + 1 ! CoreSpreadEddyVisc - Int_BufSz = Int_BufSz + 1 ! RegDeterMethod - Int_BufSz = Int_BufSz + 1 ! RegFunction - Int_BufSz = Int_BufSz + 1 ! WakeRegMethod - Re_BufSz = Re_BufSz + 1 ! WakeRegParam - Re_BufSz = Re_BufSz + 1 ! WingRegParam - Int_BufSz = Int_BufSz + 1 ! ShearModel - Int_BufSz = Int_BufSz + 1 ! TwrShadowOnWake - Int_BufSz = Int_BufSz + SIZE(InData%VelocityMethod) ! VelocityMethod - Re_BufSz = Re_BufSz + SIZE(InData%TreeBranchFactor) ! TreeBranchFactor - Int_BufSz = Int_BufSz + SIZE(InData%PartPerSegment) ! PartPerSegment - Int_BufSz = Int_BufSz + 1 ! WrVTK - Int_BufSz = Int_BufSz + 1 ! VTKBlades - Db_BufSz = Db_BufSz + 1 ! DTvtk - Int_BufSz = Int_BufSz + 1 ! VTKCoord - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%CircSolvMethod - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%CirculationFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%CirculationFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%CircSolvMaxIter - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CircSolvConvCrit - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CircSolvRelaxation - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%IntMethod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FreeWake, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FreeWakeStart - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FullCircStart - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%DTfvw - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%CircSolvPolar - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nNWPanels - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nNWPanelsFree - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nFWPanels - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nFWPanelsFree - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FWShedVorticity, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%DiffusionMethod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CoreSpreadEddyVisc - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%RegDeterMethod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%RegFunction - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WakeRegMethod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WakeRegParam - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WingRegParam - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ShearModel - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TwrShadowOnWake, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%VelocityMethod,1), UBOUND(InData%VelocityMethod,1) - IntKiBuf(Int_Xferred) = InData%VelocityMethod(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TreeBranchFactor,1), UBOUND(InData%TreeBranchFactor,1) - ReKiBuf(Re_Xferred) = InData%TreeBranchFactor(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%PartPerSegment,1), UBOUND(InData%PartPerSegment,1) - IntKiBuf(Int_Xferred) = InData%PartPerSegment(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%WrVTK - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%VTKBlades - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%DTvtk - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%VTKCoord - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FVW_PackInputFile - - SUBROUTINE FVW_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FVW_InputFile), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_UnPackInputFile' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%CircSolvMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%CirculationFile) - OutData%CirculationFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%CircSolvMaxIter = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CircSolvConvCrit = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CircSolvRelaxation = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%IntMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FreeWake = TRANSFER(IntKiBuf(Int_Xferred), OutData%FreeWake) - Int_Xferred = Int_Xferred + 1 - OutData%FreeWakeStart = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%FullCircStart = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DTfvw = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%CircSolvPolar = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nNWPanels = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nNWPanelsFree = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nFWPanels = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nFWPanelsFree = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FWShedVorticity = TRANSFER(IntKiBuf(Int_Xferred), OutData%FWShedVorticity) - Int_Xferred = Int_Xferred + 1 - OutData%DiffusionMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CoreSpreadEddyVisc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RegDeterMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%RegFunction = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WakeRegMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WakeRegParam = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WingRegParam = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ShearModel = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TwrShadowOnWake = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwrShadowOnWake) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%VelocityMethod,1) - i1_u = UBOUND(OutData%VelocityMethod,1) - DO i1 = LBOUND(OutData%VelocityMethod,1), UBOUND(OutData%VelocityMethod,1) - OutData%VelocityMethod(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TreeBranchFactor,1) - i1_u = UBOUND(OutData%TreeBranchFactor,1) - DO i1 = LBOUND(OutData%TreeBranchFactor,1), UBOUND(OutData%TreeBranchFactor,1) - OutData%TreeBranchFactor(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%PartPerSegment,1) - i1_u = UBOUND(OutData%PartPerSegment,1) - DO i1 = LBOUND(OutData%PartPerSegment,1), UBOUND(OutData%PartPerSegment,1) - OutData%PartPerSegment(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%WrVTK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%VTKBlades = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%DTvtk = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%VTKCoord = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FVW_UnPackInputFile +subroutine FVW_PackInputFile(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FVW_InputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackInputFile' + if (Buf%ErrStat >= AbortErrLev) return + ! CircSolvMethod + call RegPack(Buf, InData%CircSolvMethod) + if (RegCheckErr(Buf, RoutineName)) return + ! CirculationFile + call RegPack(Buf, InData%CirculationFile) + if (RegCheckErr(Buf, RoutineName)) return + ! CircSolvMaxIter + call RegPack(Buf, InData%CircSolvMaxIter) + if (RegCheckErr(Buf, RoutineName)) return + ! CircSolvConvCrit + call RegPack(Buf, InData%CircSolvConvCrit) + if (RegCheckErr(Buf, RoutineName)) return + ! CircSolvRelaxation + call RegPack(Buf, InData%CircSolvRelaxation) + if (RegCheckErr(Buf, RoutineName)) return + ! IntMethod + call RegPack(Buf, InData%IntMethod) + if (RegCheckErr(Buf, RoutineName)) return + ! FreeWake + call RegPack(Buf, InData%FreeWake) + if (RegCheckErr(Buf, RoutineName)) return + ! FreeWakeStart + call RegPack(Buf, InData%FreeWakeStart) + if (RegCheckErr(Buf, RoutineName)) return + ! FullCircStart + call RegPack(Buf, InData%FullCircStart) + if (RegCheckErr(Buf, RoutineName)) return + ! DTfvw + call RegPack(Buf, InData%DTfvw) + if (RegCheckErr(Buf, RoutineName)) return + ! CircSolvPolar + call RegPack(Buf, InData%CircSolvPolar) + if (RegCheckErr(Buf, RoutineName)) return + ! nNWPanels + call RegPack(Buf, InData%nNWPanels) + if (RegCheckErr(Buf, RoutineName)) return + ! nNWPanelsFree + call RegPack(Buf, InData%nNWPanelsFree) + if (RegCheckErr(Buf, RoutineName)) return + ! nFWPanels + call RegPack(Buf, InData%nFWPanels) + if (RegCheckErr(Buf, RoutineName)) return + ! nFWPanelsFree + call RegPack(Buf, InData%nFWPanelsFree) + if (RegCheckErr(Buf, RoutineName)) return + ! FWShedVorticity + call RegPack(Buf, InData%FWShedVorticity) + if (RegCheckErr(Buf, RoutineName)) return + ! DiffusionMethod + call RegPack(Buf, InData%DiffusionMethod) + if (RegCheckErr(Buf, RoutineName)) return + ! CoreSpreadEddyVisc + call RegPack(Buf, InData%CoreSpreadEddyVisc) + if (RegCheckErr(Buf, RoutineName)) return + ! RegDeterMethod + call RegPack(Buf, InData%RegDeterMethod) + if (RegCheckErr(Buf, RoutineName)) return + ! RegFunction + call RegPack(Buf, InData%RegFunction) + if (RegCheckErr(Buf, RoutineName)) return + ! WakeRegMethod + call RegPack(Buf, InData%WakeRegMethod) + if (RegCheckErr(Buf, RoutineName)) return + ! WakeRegParam + call RegPack(Buf, InData%WakeRegParam) + if (RegCheckErr(Buf, RoutineName)) return + ! WingRegParam + call RegPack(Buf, InData%WingRegParam) + if (RegCheckErr(Buf, RoutineName)) return + ! ShearModel + call RegPack(Buf, InData%ShearModel) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrShadowOnWake + call RegPack(Buf, InData%TwrShadowOnWake) + if (RegCheckErr(Buf, RoutineName)) return + ! VelocityMethod + call RegPack(Buf, InData%VelocityMethod) + if (RegCheckErr(Buf, RoutineName)) return + ! TreeBranchFactor + call RegPack(Buf, InData%TreeBranchFactor) + if (RegCheckErr(Buf, RoutineName)) return + ! PartPerSegment + call RegPack(Buf, InData%PartPerSegment) + if (RegCheckErr(Buf, RoutineName)) return + ! WrVTK + call RegPack(Buf, InData%WrVTK) + if (RegCheckErr(Buf, RoutineName)) return + ! VTKBlades + call RegPack(Buf, InData%VTKBlades) + if (RegCheckErr(Buf, RoutineName)) return + ! DTvtk + call RegPack(Buf, InData%DTvtk) + if (RegCheckErr(Buf, RoutineName)) return + ! VTKCoord + call RegPack(Buf, InData%VTKCoord) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_UnPackInputFile(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FVW_InputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackInputFile' + if (Buf%ErrStat /= ErrID_None) return + ! CircSolvMethod + call RegUnpack(Buf, OutData%CircSolvMethod) + if (RegCheckErr(Buf, RoutineName)) return + ! CirculationFile + call RegUnpack(Buf, OutData%CirculationFile) + if (RegCheckErr(Buf, RoutineName)) return + ! CircSolvMaxIter + call RegUnpack(Buf, OutData%CircSolvMaxIter) + if (RegCheckErr(Buf, RoutineName)) return + ! CircSolvConvCrit + call RegUnpack(Buf, OutData%CircSolvConvCrit) + if (RegCheckErr(Buf, RoutineName)) return + ! CircSolvRelaxation + call RegUnpack(Buf, OutData%CircSolvRelaxation) + if (RegCheckErr(Buf, RoutineName)) return + ! IntMethod + call RegUnpack(Buf, OutData%IntMethod) + if (RegCheckErr(Buf, RoutineName)) return + ! FreeWake + call RegUnpack(Buf, OutData%FreeWake) + if (RegCheckErr(Buf, RoutineName)) return + ! FreeWakeStart + call RegUnpack(Buf, OutData%FreeWakeStart) + if (RegCheckErr(Buf, RoutineName)) return + ! FullCircStart + call RegUnpack(Buf, OutData%FullCircStart) + if (RegCheckErr(Buf, RoutineName)) return + ! DTfvw + call RegUnpack(Buf, OutData%DTfvw) + if (RegCheckErr(Buf, RoutineName)) return + ! CircSolvPolar + call RegUnpack(Buf, OutData%CircSolvPolar) + if (RegCheckErr(Buf, RoutineName)) return + ! nNWPanels + call RegUnpack(Buf, OutData%nNWPanels) + if (RegCheckErr(Buf, RoutineName)) return + ! nNWPanelsFree + call RegUnpack(Buf, OutData%nNWPanelsFree) + if (RegCheckErr(Buf, RoutineName)) return + ! nFWPanels + call RegUnpack(Buf, OutData%nFWPanels) + if (RegCheckErr(Buf, RoutineName)) return + ! nFWPanelsFree + call RegUnpack(Buf, OutData%nFWPanelsFree) + if (RegCheckErr(Buf, RoutineName)) return + ! FWShedVorticity + call RegUnpack(Buf, OutData%FWShedVorticity) + if (RegCheckErr(Buf, RoutineName)) return + ! DiffusionMethod + call RegUnpack(Buf, OutData%DiffusionMethod) + if (RegCheckErr(Buf, RoutineName)) return + ! CoreSpreadEddyVisc + call RegUnpack(Buf, OutData%CoreSpreadEddyVisc) + if (RegCheckErr(Buf, RoutineName)) return + ! RegDeterMethod + call RegUnpack(Buf, OutData%RegDeterMethod) + if (RegCheckErr(Buf, RoutineName)) return + ! RegFunction + call RegUnpack(Buf, OutData%RegFunction) + if (RegCheckErr(Buf, RoutineName)) return + ! WakeRegMethod + call RegUnpack(Buf, OutData%WakeRegMethod) + if (RegCheckErr(Buf, RoutineName)) return + ! WakeRegParam + call RegUnpack(Buf, OutData%WakeRegParam) + if (RegCheckErr(Buf, RoutineName)) return + ! WingRegParam + call RegUnpack(Buf, OutData%WingRegParam) + if (RegCheckErr(Buf, RoutineName)) return + ! ShearModel + call RegUnpack(Buf, OutData%ShearModel) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrShadowOnWake + call RegUnpack(Buf, OutData%TwrShadowOnWake) + if (RegCheckErr(Buf, RoutineName)) return + ! VelocityMethod + call RegUnpack(Buf, OutData%VelocityMethod) + if (RegCheckErr(Buf, RoutineName)) return + ! TreeBranchFactor + call RegUnpack(Buf, OutData%TreeBranchFactor) + if (RegCheckErr(Buf, RoutineName)) return + ! PartPerSegment + call RegUnpack(Buf, OutData%PartPerSegment) + if (RegCheckErr(Buf, RoutineName)) return + ! WrVTK + call RegUnpack(Buf, OutData%WrVTK) + if (RegCheckErr(Buf, RoutineName)) return + ! VTKBlades + call RegUnpack(Buf, OutData%VTKBlades) + if (RegCheckErr(Buf, RoutineName)) return + ! DTvtk + call RegUnpack(Buf, OutData%DTvtk) + if (RegCheckErr(Buf, RoutineName)) return + ! VTKCoord + call RegUnpack(Buf, OutData%VTKCoord) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE FVW_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(FVW_InitOutputType), INTENT(IN) :: SrcInitOutputData TYPE(FVW_InitOutputType), INTENT(INOUT) :: DstInitOutputData @@ -11212,103 +5966,26 @@ SUBROUTINE FVW_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) END SUBROUTINE FVW_DestroyInitOutput - SUBROUTINE FVW_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FVW_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! Dummy - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%Dummy - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FVW_PackInitOutput - - SUBROUTINE FVW_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FVW_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%Dummy = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FVW_UnPackInitOutput +subroutine FVW_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FVW_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FVW_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! Dummy + call RegPack(Buf, InData%Dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FVW_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FVW_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FVW_UnPackInitOutput' + if (Buf%ErrStat /= ErrID_None) return + ! Dummy + call RegUnpack(Buf, OutData%Dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE FVW_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) ! diff --git a/modules/aerodyn/src/UnsteadyAero_Types.f90 b/modules/aerodyn/src/UnsteadyAero_Types.f90 index 4702a51955..6b8ecfa31a 100644 --- a/modules/aerodyn/src/UnsteadyAero_Types.f90 +++ b/modules/aerodyn/src/UnsteadyAero_Types.f90 @@ -333,273 +333,143 @@ SUBROUTINE UA_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE UA_DestroyInitInput - SUBROUTINE UA_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(UA_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! dt - Int_BufSz = Int_BufSz + 1*LEN(InData%OutRootName) ! OutRootName - Int_BufSz = Int_BufSz + 1 ! c allocated yes/no - IF ( ALLOCATED(InData%c) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! c upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%c) ! c - END IF - Int_BufSz = Int_BufSz + 1 ! numBlades - Int_BufSz = Int_BufSz + 1 ! nNodesPerBlade - Int_BufSz = Int_BufSz + 1 ! UAMod - Re_BufSz = Re_BufSz + 1 ! a_s - Int_BufSz = Int_BufSz + 1 ! Flookup - Int_BufSz = Int_BufSz + 1 ! ShedEffect - Int_BufSz = Int_BufSz + 1 ! WrSum - Int_BufSz = Int_BufSz + 1 ! UAOff_innerNode allocated yes/no - IF ( ALLOCATED(InData%UAOff_innerNode) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UAOff_innerNode upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%UAOff_innerNode) ! UAOff_innerNode - END IF - Int_BufSz = Int_BufSz + 1 ! UAOff_outerNode allocated yes/no - IF ( ALLOCATED(InData%UAOff_outerNode) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UAOff_outerNode upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%UAOff_outerNode) ! UAOff_outerNode - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%dt - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(InData%OutRootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutRootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%c) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%c,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%c,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%c,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%c,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%c,2), UBOUND(InData%c,2) - DO i1 = LBOUND(InData%c,1), UBOUND(InData%c,1) - ReKiBuf(Re_Xferred) = InData%c(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%numBlades - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nNodesPerBlade - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UAMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%a_s - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Flookup, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%ShedEffect, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WrSum, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%UAOff_innerNode) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UAOff_innerNode,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UAOff_innerNode,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UAOff_innerNode,1), UBOUND(InData%UAOff_innerNode,1) - IntKiBuf(Int_Xferred) = InData%UAOff_innerNode(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%UAOff_outerNode) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UAOff_outerNode,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UAOff_outerNode,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UAOff_outerNode,1), UBOUND(InData%UAOff_outerNode,1) - IntKiBuf(Int_Xferred) = InData%UAOff_outerNode(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE UA_PackInitInput - - SUBROUTINE UA_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(UA_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%dt = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(OutData%OutRootName) - OutData%OutRootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! c not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%c)) DEALLOCATE(OutData%c) - ALLOCATE(OutData%c(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%c.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%c,2), UBOUND(OutData%c,2) - DO i1 = LBOUND(OutData%c,1), UBOUND(OutData%c,1) - OutData%c(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%numBlades = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nNodesPerBlade = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UAMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%a_s = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Flookup = TRANSFER(IntKiBuf(Int_Xferred), OutData%Flookup) - Int_Xferred = Int_Xferred + 1 - OutData%ShedEffect = TRANSFER(IntKiBuf(Int_Xferred), OutData%ShedEffect) - Int_Xferred = Int_Xferred + 1 - OutData%WrSum = TRANSFER(IntKiBuf(Int_Xferred), OutData%WrSum) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UAOff_innerNode not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%UAOff_innerNode)) DEALLOCATE(OutData%UAOff_innerNode) - ALLOCATE(OutData%UAOff_innerNode(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UAOff_innerNode.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UAOff_innerNode,1), UBOUND(OutData%UAOff_innerNode,1) - OutData%UAOff_innerNode(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UAOff_outerNode not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%UAOff_outerNode)) DEALLOCATE(OutData%UAOff_outerNode) - ALLOCATE(OutData%UAOff_outerNode(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UAOff_outerNode.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UAOff_outerNode,1), UBOUND(OutData%UAOff_outerNode,1) - OutData%UAOff_outerNode(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE UA_UnPackInitInput +subroutine UA_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(UA_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'UA_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + ! dt + call RegPack(Buf, InData%dt) + if (RegCheckErr(Buf, RoutineName)) return + ! OutRootName + call RegPack(Buf, InData%OutRootName) + if (RegCheckErr(Buf, RoutineName)) return + ! c + call RegPack(Buf, allocated(InData%c)) + if (allocated(InData%c)) then + call RegPackBounds(Buf, 2, lbound(InData%c), ubound(InData%c)) + call RegPack(Buf, InData%c) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! numBlades + call RegPack(Buf, InData%numBlades) + if (RegCheckErr(Buf, RoutineName)) return + ! nNodesPerBlade + call RegPack(Buf, InData%nNodesPerBlade) + if (RegCheckErr(Buf, RoutineName)) return + ! UAMod + call RegPack(Buf, InData%UAMod) + if (RegCheckErr(Buf, RoutineName)) return + ! a_s + call RegPack(Buf, InData%a_s) + if (RegCheckErr(Buf, RoutineName)) return + ! Flookup + call RegPack(Buf, InData%Flookup) + if (RegCheckErr(Buf, RoutineName)) return + ! ShedEffect + call RegPack(Buf, InData%ShedEffect) + if (RegCheckErr(Buf, RoutineName)) return + ! WrSum + call RegPack(Buf, InData%WrSum) + if (RegCheckErr(Buf, RoutineName)) return + ! UAOff_innerNode + call RegPack(Buf, allocated(InData%UAOff_innerNode)) + if (allocated(InData%UAOff_innerNode)) then + call RegPackBounds(Buf, 1, lbound(InData%UAOff_innerNode), ubound(InData%UAOff_innerNode)) + call RegPack(Buf, InData%UAOff_innerNode) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! UAOff_outerNode + call RegPack(Buf, allocated(InData%UAOff_outerNode)) + if (allocated(InData%UAOff_outerNode)) then + call RegPackBounds(Buf, 1, lbound(InData%UAOff_outerNode), ubound(InData%UAOff_outerNode)) + call RegPack(Buf, InData%UAOff_outerNode) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine UA_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(UA_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'UA_UnPackInitInput' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! dt + call RegUnpack(Buf, OutData%dt) + if (RegCheckErr(Buf, RoutineName)) return + ! OutRootName + call RegUnpack(Buf, OutData%OutRootName) + if (RegCheckErr(Buf, RoutineName)) return + ! c + if (allocated(OutData%c)) deallocate(OutData%c) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%c(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%c.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%c) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! numBlades + call RegUnpack(Buf, OutData%numBlades) + if (RegCheckErr(Buf, RoutineName)) return + ! nNodesPerBlade + call RegUnpack(Buf, OutData%nNodesPerBlade) + if (RegCheckErr(Buf, RoutineName)) return + ! UAMod + call RegUnpack(Buf, OutData%UAMod) + if (RegCheckErr(Buf, RoutineName)) return + ! a_s + call RegUnpack(Buf, OutData%a_s) + if (RegCheckErr(Buf, RoutineName)) return + ! Flookup + call RegUnpack(Buf, OutData%Flookup) + if (RegCheckErr(Buf, RoutineName)) return + ! ShedEffect + call RegUnpack(Buf, OutData%ShedEffect) + if (RegCheckErr(Buf, RoutineName)) return + ! WrSum + call RegUnpack(Buf, OutData%WrSum) + if (RegCheckErr(Buf, RoutineName)) return + ! UAOff_innerNode + if (allocated(OutData%UAOff_innerNode)) deallocate(OutData%UAOff_innerNode) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%UAOff_innerNode(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UAOff_innerNode.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%UAOff_innerNode) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! UAOff_outerNode + if (allocated(OutData%UAOff_outerNode)) deallocate(OutData%UAOff_outerNode) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%UAOff_outerNode(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UAOff_outerNode.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%UAOff_outerNode) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE UA_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(UA_InitOutputType), INTENT(IN) :: SrcInitOutputData TYPE(UA_InitOutputType), INTENT(INOUT) :: DstInitOutputData @@ -667,269 +537,72 @@ SUBROUTINE UA_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE UA_DestroyInitOutput - SUBROUTINE UA_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(UA_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Version: size of buffers for each call to pack subtype - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Version, ErrStat2, ErrMsg2, .TRUE. ) ! Version - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Version - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Version - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Version - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputHdr allocated yes/no - IF ( ALLOCATED(InData%WriteOutputHdr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdr upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdr)*LEN(InData%WriteOutputHdr) ! WriteOutputHdr - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputUnt allocated yes/no - IF ( ALLOCATED(InData%WriteOutputUnt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUnt upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUnt)*LEN(InData%WriteOutputUnt) ! WriteOutputUnt - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Version, ErrStat2, ErrMsg2, OnlySize ) ! Version - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%WriteOutputHdr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) - DO I = 1, LEN(InData%WriteOutputHdr) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputUnt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) - DO I = 1, LEN(InData%WriteOutputUnt) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - END SUBROUTINE UA_PackInitOutput - - SUBROUTINE UA_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(UA_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Version, ErrStat2, ErrMsg2 ) ! Version - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputHdr)) DEALLOCATE(OutData%WriteOutputHdr) - ALLOCATE(OutData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) - DO I = 1, LEN(OutData%WriteOutputHdr) - OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputUnt)) DEALLOCATE(OutData%WriteOutputUnt) - ALLOCATE(OutData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) - DO I = 1, LEN(OutData%WriteOutputUnt) - OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - END SUBROUTINE UA_UnPackInitOutput +subroutine UA_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(UA_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'UA_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! Version + call NWTC_Library_PackProgDesc(Buf, InData%Version) + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutputHdr + call RegPack(Buf, allocated(InData%WriteOutputHdr)) + if (allocated(InData%WriteOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPack(Buf, InData%WriteOutputHdr) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutputUnt + call RegPack(Buf, allocated(InData%WriteOutputUnt)) + if (allocated(InData%WriteOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPack(Buf, InData%WriteOutputUnt) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine UA_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(UA_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'UA_UnPackInitOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! Version + call NWTC_Library_UnpackProgDesc(Buf, OutData%Version) ! Version + ! WriteOutputHdr + if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WriteOutputUnt + if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE UA_CopyKelvinChainType( SrcKelvinChainTypeData, DstKelvinChainTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(UA_KelvinChainType), INTENT(IN) :: SrcKelvinChainTypeData TYPE(UA_KelvinChainType), INTENT(INOUT) :: DstKelvinChainTypeData @@ -1012,353 +685,326 @@ SUBROUTINE UA_DestroyKelvinChainType( KelvinChainTypeData, ErrStat, ErrMsg ) END SUBROUTINE UA_DestroyKelvinChainType - SUBROUTINE UA_PackKelvinChainType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(UA_KelvinChainType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_PackKelvinChainType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! Cn_prime - Re_BufSz = Re_BufSz + 1 ! C_nalpha_circ - Re_BufSz = Re_BufSz + 1 ! Kalpha_f - Re_BufSz = Re_BufSz + 1 ! Kq_f - Re_BufSz = Re_BufSz + 1 ! alpha_filt_cur - Re_BufSz = Re_BufSz + 1 ! alpha_e - Re_BufSz = Re_BufSz + 1 ! dalpha0 - Re_BufSz = Re_BufSz + 1 ! alpha_f - Re_BufSz = Re_BufSz + 1 ! Kq - Re_BufSz = Re_BufSz + 1 ! q_cur - Re_BufSz = Re_BufSz + 1 ! q_f_cur - Re_BufSz = Re_BufSz + 1 ! X1 - Re_BufSz = Re_BufSz + 1 ! X2 - Re_BufSz = Re_BufSz + 1 ! X3 - Re_BufSz = Re_BufSz + 1 ! X4 - Re_BufSz = Re_BufSz + 1 ! Kprime_alpha - Re_BufSz = Re_BufSz + 1 ! Kprime_q - Re_BufSz = Re_BufSz + 1 ! K3prime_q - Re_BufSz = Re_BufSz + 1 ! Kprimeprime_q - Re_BufSz = Re_BufSz + 1 ! Dp - Re_BufSz = Re_BufSz + 1 ! Cn_pot - Re_BufSz = Re_BufSz + 1 ! Cc_pot - Re_BufSz = Re_BufSz + 1 ! Cn_alpha_q_circ - Re_BufSz = Re_BufSz + 1 ! Cn_alpha_q_nc - Re_BufSz = Re_BufSz + 1 ! Cm_q_circ - Re_BufSz = Re_BufSz + 1 ! Cn_alpha_nc - Re_BufSz = Re_BufSz + 1 ! Cn_q_circ - Re_BufSz = Re_BufSz + 1 ! Cn_q_nc - Re_BufSz = Re_BufSz + 1 ! Cm_q_nc - Re_BufSz = Re_BufSz + 1 ! fprimeprime - Re_BufSz = Re_BufSz + 1 ! Df - Re_BufSz = Re_BufSz + 1 ! Df_c - Re_BufSz = Re_BufSz + 1 ! Df_m - Re_BufSz = Re_BufSz + 1 ! Dalphaf - Re_BufSz = Re_BufSz + 1 ! fprime - Re_BufSz = Re_BufSz + 1 ! fprime_c - Re_BufSz = Re_BufSz + 1 ! fprimeprime_c - Re_BufSz = Re_BufSz + 1 ! fprime_m - Re_BufSz = Re_BufSz + 1 ! fprimeprime_m - Re_BufSz = Re_BufSz + 1 ! Cn_v - Re_BufSz = Re_BufSz + 1 ! C_V - Re_BufSz = Re_BufSz + 1 ! Cn_FS - Re_BufSz = Re_BufSz + 1 ! T_f - Re_BufSz = Re_BufSz + 1 ! T_fc - Re_BufSz = Re_BufSz + 1 ! T_fm - Re_BufSz = Re_BufSz + 1 ! T_V - Re_BufSz = Re_BufSz + 1 ! k_alpha - Re_BufSz = Re_BufSz + 1 ! k_q - Re_BufSz = Re_BufSz + 1 ! T_alpha - Re_BufSz = Re_BufSz + 1 ! T_q - Re_BufSz = Re_BufSz + 1 ! ds - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%Cn_prime - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_nalpha_circ - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Kalpha_f - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Kq_f - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%alpha_filt_cur - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%alpha_e - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dalpha0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%alpha_f - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Kq - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%q_cur - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%q_f_cur - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%X1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%X2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%X3 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%X4 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Kprime_alpha - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Kprime_q - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%K3prime_q - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Kprimeprime_q - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Dp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cn_pot - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cc_pot - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cn_alpha_q_circ - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cn_alpha_q_nc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cm_q_circ - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cn_alpha_nc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cn_q_circ - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cn_q_nc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cm_q_nc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%fprimeprime - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Df - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Df_c - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Df_m - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Dalphaf - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%fprime - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%fprime_c - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%fprimeprime_c - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%fprime_m - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%fprimeprime_m - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cn_v - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_V - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cn_FS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%T_f - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%T_fc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%T_fm - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%T_V - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k_alpha - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k_q - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%T_alpha - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%T_q - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ds - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE UA_PackKelvinChainType - - SUBROUTINE UA_UnPackKelvinChainType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(UA_KelvinChainType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_UnPackKelvinChainType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%Cn_prime = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_nalpha_circ = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Kalpha_f = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Kq_f = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%alpha_filt_cur = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%alpha_e = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dalpha0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%alpha_f = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Kq = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%q_cur = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%q_f_cur = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%X1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%X2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%X3 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%X4 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Kprime_alpha = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Kprime_q = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%K3prime_q = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Kprimeprime_q = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Dp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_pot = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cc_pot = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_alpha_q_circ = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_alpha_q_nc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cm_q_circ = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_alpha_nc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_q_circ = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_q_nc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cm_q_nc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%fprimeprime = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Df = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Df_c = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Df_m = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Dalphaf = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%fprime = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%fprime_c = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%fprimeprime_c = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%fprime_m = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%fprimeprime_m = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_v = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_V = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_FS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%T_f = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%T_fc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%T_fm = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%T_V = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k_alpha = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k_q = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%T_alpha = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%T_q = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ds = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE UA_UnPackKelvinChainType +subroutine UA_PackKelvinChainType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(UA_KelvinChainType), intent(in) :: InData + character(*), parameter :: RoutineName = 'UA_PackKelvinChainType' + if (Buf%ErrStat >= AbortErrLev) return + ! Cn_prime + call RegPack(Buf, InData%Cn_prime) + if (RegCheckErr(Buf, RoutineName)) return + ! C_nalpha_circ + call RegPack(Buf, InData%C_nalpha_circ) + if (RegCheckErr(Buf, RoutineName)) return + ! Kalpha_f + call RegPack(Buf, InData%Kalpha_f) + if (RegCheckErr(Buf, RoutineName)) return + ! Kq_f + call RegPack(Buf, InData%Kq_f) + if (RegCheckErr(Buf, RoutineName)) return + ! alpha_filt_cur + call RegPack(Buf, InData%alpha_filt_cur) + if (RegCheckErr(Buf, RoutineName)) return + ! alpha_e + call RegPack(Buf, InData%alpha_e) + if (RegCheckErr(Buf, RoutineName)) return + ! dalpha0 + call RegPack(Buf, InData%dalpha0) + if (RegCheckErr(Buf, RoutineName)) return + ! alpha_f + call RegPack(Buf, InData%alpha_f) + if (RegCheckErr(Buf, RoutineName)) return + ! Kq + call RegPack(Buf, InData%Kq) + if (RegCheckErr(Buf, RoutineName)) return + ! q_cur + call RegPack(Buf, InData%q_cur) + if (RegCheckErr(Buf, RoutineName)) return + ! q_f_cur + call RegPack(Buf, InData%q_f_cur) + if (RegCheckErr(Buf, RoutineName)) return + ! X1 + call RegPack(Buf, InData%X1) + if (RegCheckErr(Buf, RoutineName)) return + ! X2 + call RegPack(Buf, InData%X2) + if (RegCheckErr(Buf, RoutineName)) return + ! X3 + call RegPack(Buf, InData%X3) + if (RegCheckErr(Buf, RoutineName)) return + ! X4 + call RegPack(Buf, InData%X4) + if (RegCheckErr(Buf, RoutineName)) return + ! Kprime_alpha + call RegPack(Buf, InData%Kprime_alpha) + if (RegCheckErr(Buf, RoutineName)) return + ! Kprime_q + call RegPack(Buf, InData%Kprime_q) + if (RegCheckErr(Buf, RoutineName)) return + ! K3prime_q + call RegPack(Buf, InData%K3prime_q) + if (RegCheckErr(Buf, RoutineName)) return + ! Kprimeprime_q + call RegPack(Buf, InData%Kprimeprime_q) + if (RegCheckErr(Buf, RoutineName)) return + ! Dp + call RegPack(Buf, InData%Dp) + if (RegCheckErr(Buf, RoutineName)) return + ! Cn_pot + call RegPack(Buf, InData%Cn_pot) + if (RegCheckErr(Buf, RoutineName)) return + ! Cc_pot + call RegPack(Buf, InData%Cc_pot) + if (RegCheckErr(Buf, RoutineName)) return + ! Cn_alpha_q_circ + call RegPack(Buf, InData%Cn_alpha_q_circ) + if (RegCheckErr(Buf, RoutineName)) return + ! Cn_alpha_q_nc + call RegPack(Buf, InData%Cn_alpha_q_nc) + if (RegCheckErr(Buf, RoutineName)) return + ! Cm_q_circ + call RegPack(Buf, InData%Cm_q_circ) + if (RegCheckErr(Buf, RoutineName)) return + ! Cn_alpha_nc + call RegPack(Buf, InData%Cn_alpha_nc) + if (RegCheckErr(Buf, RoutineName)) return + ! Cn_q_circ + call RegPack(Buf, InData%Cn_q_circ) + if (RegCheckErr(Buf, RoutineName)) return + ! Cn_q_nc + call RegPack(Buf, InData%Cn_q_nc) + if (RegCheckErr(Buf, RoutineName)) return + ! Cm_q_nc + call RegPack(Buf, InData%Cm_q_nc) + if (RegCheckErr(Buf, RoutineName)) return + ! fprimeprime + call RegPack(Buf, InData%fprimeprime) + if (RegCheckErr(Buf, RoutineName)) return + ! Df + call RegPack(Buf, InData%Df) + if (RegCheckErr(Buf, RoutineName)) return + ! Df_c + call RegPack(Buf, InData%Df_c) + if (RegCheckErr(Buf, RoutineName)) return + ! Df_m + call RegPack(Buf, InData%Df_m) + if (RegCheckErr(Buf, RoutineName)) return + ! Dalphaf + call RegPack(Buf, InData%Dalphaf) + if (RegCheckErr(Buf, RoutineName)) return + ! fprime + call RegPack(Buf, InData%fprime) + if (RegCheckErr(Buf, RoutineName)) return + ! fprime_c + call RegPack(Buf, InData%fprime_c) + if (RegCheckErr(Buf, RoutineName)) return + ! fprimeprime_c + call RegPack(Buf, InData%fprimeprime_c) + if (RegCheckErr(Buf, RoutineName)) return + ! fprime_m + call RegPack(Buf, InData%fprime_m) + if (RegCheckErr(Buf, RoutineName)) return + ! fprimeprime_m + call RegPack(Buf, InData%fprimeprime_m) + if (RegCheckErr(Buf, RoutineName)) return + ! Cn_v + call RegPack(Buf, InData%Cn_v) + if (RegCheckErr(Buf, RoutineName)) return + ! C_V + call RegPack(Buf, InData%C_V) + if (RegCheckErr(Buf, RoutineName)) return + ! Cn_FS + call RegPack(Buf, InData%Cn_FS) + if (RegCheckErr(Buf, RoutineName)) return + ! T_f + call RegPack(Buf, InData%T_f) + if (RegCheckErr(Buf, RoutineName)) return + ! T_fc + call RegPack(Buf, InData%T_fc) + if (RegCheckErr(Buf, RoutineName)) return + ! T_fm + call RegPack(Buf, InData%T_fm) + if (RegCheckErr(Buf, RoutineName)) return + ! T_V + call RegPack(Buf, InData%T_V) + if (RegCheckErr(Buf, RoutineName)) return + ! k_alpha + call RegPack(Buf, InData%k_alpha) + if (RegCheckErr(Buf, RoutineName)) return + ! k_q + call RegPack(Buf, InData%k_q) + if (RegCheckErr(Buf, RoutineName)) return + ! T_alpha + call RegPack(Buf, InData%T_alpha) + if (RegCheckErr(Buf, RoutineName)) return + ! T_q + call RegPack(Buf, InData%T_q) + if (RegCheckErr(Buf, RoutineName)) return + ! ds + call RegPack(Buf, InData%ds) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine UA_UnPackKelvinChainType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(UA_KelvinChainType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'UA_UnPackKelvinChainType' + if (Buf%ErrStat /= ErrID_None) return + ! Cn_prime + call RegUnpack(Buf, OutData%Cn_prime) + if (RegCheckErr(Buf, RoutineName)) return + ! C_nalpha_circ + call RegUnpack(Buf, OutData%C_nalpha_circ) + if (RegCheckErr(Buf, RoutineName)) return + ! Kalpha_f + call RegUnpack(Buf, OutData%Kalpha_f) + if (RegCheckErr(Buf, RoutineName)) return + ! Kq_f + call RegUnpack(Buf, OutData%Kq_f) + if (RegCheckErr(Buf, RoutineName)) return + ! alpha_filt_cur + call RegUnpack(Buf, OutData%alpha_filt_cur) + if (RegCheckErr(Buf, RoutineName)) return + ! alpha_e + call RegUnpack(Buf, OutData%alpha_e) + if (RegCheckErr(Buf, RoutineName)) return + ! dalpha0 + call RegUnpack(Buf, OutData%dalpha0) + if (RegCheckErr(Buf, RoutineName)) return + ! alpha_f + call RegUnpack(Buf, OutData%alpha_f) + if (RegCheckErr(Buf, RoutineName)) return + ! Kq + call RegUnpack(Buf, OutData%Kq) + if (RegCheckErr(Buf, RoutineName)) return + ! q_cur + call RegUnpack(Buf, OutData%q_cur) + if (RegCheckErr(Buf, RoutineName)) return + ! q_f_cur + call RegUnpack(Buf, OutData%q_f_cur) + if (RegCheckErr(Buf, RoutineName)) return + ! X1 + call RegUnpack(Buf, OutData%X1) + if (RegCheckErr(Buf, RoutineName)) return + ! X2 + call RegUnpack(Buf, OutData%X2) + if (RegCheckErr(Buf, RoutineName)) return + ! X3 + call RegUnpack(Buf, OutData%X3) + if (RegCheckErr(Buf, RoutineName)) return + ! X4 + call RegUnpack(Buf, OutData%X4) + if (RegCheckErr(Buf, RoutineName)) return + ! Kprime_alpha + call RegUnpack(Buf, OutData%Kprime_alpha) + if (RegCheckErr(Buf, RoutineName)) return + ! Kprime_q + call RegUnpack(Buf, OutData%Kprime_q) + if (RegCheckErr(Buf, RoutineName)) return + ! K3prime_q + call RegUnpack(Buf, OutData%K3prime_q) + if (RegCheckErr(Buf, RoutineName)) return + ! Kprimeprime_q + call RegUnpack(Buf, OutData%Kprimeprime_q) + if (RegCheckErr(Buf, RoutineName)) return + ! Dp + call RegUnpack(Buf, OutData%Dp) + if (RegCheckErr(Buf, RoutineName)) return + ! Cn_pot + call RegUnpack(Buf, OutData%Cn_pot) + if (RegCheckErr(Buf, RoutineName)) return + ! Cc_pot + call RegUnpack(Buf, OutData%Cc_pot) + if (RegCheckErr(Buf, RoutineName)) return + ! Cn_alpha_q_circ + call RegUnpack(Buf, OutData%Cn_alpha_q_circ) + if (RegCheckErr(Buf, RoutineName)) return + ! Cn_alpha_q_nc + call RegUnpack(Buf, OutData%Cn_alpha_q_nc) + if (RegCheckErr(Buf, RoutineName)) return + ! Cm_q_circ + call RegUnpack(Buf, OutData%Cm_q_circ) + if (RegCheckErr(Buf, RoutineName)) return + ! Cn_alpha_nc + call RegUnpack(Buf, OutData%Cn_alpha_nc) + if (RegCheckErr(Buf, RoutineName)) return + ! Cn_q_circ + call RegUnpack(Buf, OutData%Cn_q_circ) + if (RegCheckErr(Buf, RoutineName)) return + ! Cn_q_nc + call RegUnpack(Buf, OutData%Cn_q_nc) + if (RegCheckErr(Buf, RoutineName)) return + ! Cm_q_nc + call RegUnpack(Buf, OutData%Cm_q_nc) + if (RegCheckErr(Buf, RoutineName)) return + ! fprimeprime + call RegUnpack(Buf, OutData%fprimeprime) + if (RegCheckErr(Buf, RoutineName)) return + ! Df + call RegUnpack(Buf, OutData%Df) + if (RegCheckErr(Buf, RoutineName)) return + ! Df_c + call RegUnpack(Buf, OutData%Df_c) + if (RegCheckErr(Buf, RoutineName)) return + ! Df_m + call RegUnpack(Buf, OutData%Df_m) + if (RegCheckErr(Buf, RoutineName)) return + ! Dalphaf + call RegUnpack(Buf, OutData%Dalphaf) + if (RegCheckErr(Buf, RoutineName)) return + ! fprime + call RegUnpack(Buf, OutData%fprime) + if (RegCheckErr(Buf, RoutineName)) return + ! fprime_c + call RegUnpack(Buf, OutData%fprime_c) + if (RegCheckErr(Buf, RoutineName)) return + ! fprimeprime_c + call RegUnpack(Buf, OutData%fprimeprime_c) + if (RegCheckErr(Buf, RoutineName)) return + ! fprime_m + call RegUnpack(Buf, OutData%fprime_m) + if (RegCheckErr(Buf, RoutineName)) return + ! fprimeprime_m + call RegUnpack(Buf, OutData%fprimeprime_m) + if (RegCheckErr(Buf, RoutineName)) return + ! Cn_v + call RegUnpack(Buf, OutData%Cn_v) + if (RegCheckErr(Buf, RoutineName)) return + ! C_V + call RegUnpack(Buf, OutData%C_V) + if (RegCheckErr(Buf, RoutineName)) return + ! Cn_FS + call RegUnpack(Buf, OutData%Cn_FS) + if (RegCheckErr(Buf, RoutineName)) return + ! T_f + call RegUnpack(Buf, OutData%T_f) + if (RegCheckErr(Buf, RoutineName)) return + ! T_fc + call RegUnpack(Buf, OutData%T_fc) + if (RegCheckErr(Buf, RoutineName)) return + ! T_fm + call RegUnpack(Buf, OutData%T_fm) + if (RegCheckErr(Buf, RoutineName)) return + ! T_V + call RegUnpack(Buf, OutData%T_V) + if (RegCheckErr(Buf, RoutineName)) return + ! k_alpha + call RegUnpack(Buf, OutData%k_alpha) + if (RegCheckErr(Buf, RoutineName)) return + ! k_q + call RegUnpack(Buf, OutData%k_q) + if (RegCheckErr(Buf, RoutineName)) return + ! T_alpha + call RegUnpack(Buf, OutData%T_alpha) + if (RegCheckErr(Buf, RoutineName)) return + ! T_q + call RegUnpack(Buf, OutData%T_q) + if (RegCheckErr(Buf, RoutineName)) return + ! ds + call RegUnpack(Buf, OutData%ds) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE UA_CopyElementContinuousStateType( SrcElementContinuousStateTypeData, DstElementContinuousStateTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(UA_ElementContinuousStateType), INTENT(IN) :: SrcElementContinuousStateTypeData TYPE(UA_ElementContinuousStateType), INTENT(INOUT) :: DstElementContinuousStateTypeData @@ -1392,110 +1038,26 @@ SUBROUTINE UA_DestroyElementContinuousStateType( ElementContinuousStateTypeData, END SUBROUTINE UA_DestroyElementContinuousStateType - SUBROUTINE UA_PackElementContinuousStateType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(UA_ElementContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_PackElementContinuousStateType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + SIZE(InData%x) ! x - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - DbKiBuf(Db_Xferred) = InData%x(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE UA_PackElementContinuousStateType - - SUBROUTINE UA_UnPackElementContinuousStateType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(UA_ElementContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_UnPackElementContinuousStateType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) - OutData%x(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE UA_UnPackElementContinuousStateType +subroutine UA_PackElementContinuousStateType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(UA_ElementContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'UA_PackElementContinuousStateType' + if (Buf%ErrStat >= AbortErrLev) return + ! x + call RegPack(Buf, InData%x) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine UA_UnPackElementContinuousStateType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(UA_ElementContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'UA_UnPackElementContinuousStateType' + if (Buf%ErrStat /= ErrID_None) return + ! x + call RegUnpack(Buf, OutData%x) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE UA_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(UA_ContinuousStateType), INTENT(IN) :: SrcContStateData TYPE(UA_ContinuousStateType), INTENT(INOUT) :: DstContStateData @@ -1558,233 +1120,57 @@ SUBROUTINE UA_DestroyContState( ContStateData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE UA_DestroyContState - SUBROUTINE UA_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(UA_ContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_PackContState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! element allocated yes/no - IF ( ALLOCATED(InData%element) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! element upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i2 = LBOUND(InData%element,2), UBOUND(InData%element,2) - DO i1 = LBOUND(InData%element,1), UBOUND(InData%element,1) - Int_BufSz = Int_BufSz + 3 ! element: size of buffers for each call to pack subtype - CALL UA_PackElementContinuousStateType( Re_Buf, Db_Buf, Int_Buf, InData%element(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! element - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! element - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! element - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! element - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%element) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%element,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%element,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%element,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%element,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%element,2), UBOUND(InData%element,2) - DO i1 = LBOUND(InData%element,1), UBOUND(InData%element,1) - CALL UA_PackElementContinuousStateType( Re_Buf, Db_Buf, Int_Buf, InData%element(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! element - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END DO - END IF - END SUBROUTINE UA_PackContState - - SUBROUTINE UA_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(UA_ContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_UnPackContState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! element not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%element)) DEALLOCATE(OutData%element) - ALLOCATE(OutData%element(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%element.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%element,2), UBOUND(OutData%element,2) - DO i1 = LBOUND(OutData%element,1), UBOUND(OutData%element,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL UA_UnpackElementContinuousStateType( Re_Buf, Db_Buf, Int_Buf, OutData%element(i1,i2), ErrStat2, ErrMsg2 ) ! element - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO - END IF - END SUBROUTINE UA_UnPackContState +subroutine UA_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(UA_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'UA_PackContState' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + ! element + call RegPack(Buf, allocated(InData%element)) + if (allocated(InData%element)) then + call RegPackBounds(Buf, 2, lbound(InData%element), ubound(InData%element)) + LB(1:2) = lbound(InData%element) + UB(1:2) = ubound(InData%element) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call UA_PackElementContinuousStateType(Buf, InData%element(i1,i2)) + end do + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine UA_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(UA_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'UA_UnPackContState' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! element + if (allocated(OutData%element)) deallocate(OutData%element) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%element(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%element.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call UA_UnpackElementContinuousStateType(Buf, OutData%element(i1,i2)) ! element + end do + end do + end if +end subroutine SUBROUTINE UA_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(UA_DiscreteStateType), INTENT(IN) :: SrcDiscStateData TYPE(UA_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData @@ -2396,1916 +1782,878 @@ SUBROUTINE UA_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE UA_DestroyDiscState - SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(UA_DiscreteStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + +subroutine UA_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(UA_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'UA_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + ! alpha_minus1 + call RegPack(Buf, allocated(InData%alpha_minus1)) + if (allocated(InData%alpha_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%alpha_minus1), ubound(InData%alpha_minus1)) + call RegPack(Buf, InData%alpha_minus1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! alpha_filt_minus1 + call RegPack(Buf, allocated(InData%alpha_filt_minus1)) + if (allocated(InData%alpha_filt_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%alpha_filt_minus1), ubound(InData%alpha_filt_minus1)) + call RegPack(Buf, InData%alpha_filt_minus1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! alpha_dot + call RegPack(Buf, allocated(InData%alpha_dot)) + if (allocated(InData%alpha_dot)) then + call RegPackBounds(Buf, 2, lbound(InData%alpha_dot), ubound(InData%alpha_dot)) + call RegPack(Buf, InData%alpha_dot) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! alpha_dot_minus1 + call RegPack(Buf, allocated(InData%alpha_dot_minus1)) + if (allocated(InData%alpha_dot_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%alpha_dot_minus1), ubound(InData%alpha_dot_minus1)) + call RegPack(Buf, InData%alpha_dot_minus1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! q_minus1 + call RegPack(Buf, allocated(InData%q_minus1)) + if (allocated(InData%q_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%q_minus1), ubound(InData%q_minus1)) + call RegPack(Buf, InData%q_minus1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Kalpha_f_minus1 + call RegPack(Buf, allocated(InData%Kalpha_f_minus1)) + if (allocated(InData%Kalpha_f_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%Kalpha_f_minus1), ubound(InData%Kalpha_f_minus1)) + call RegPack(Buf, InData%Kalpha_f_minus1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Kq_f_minus1 + call RegPack(Buf, allocated(InData%Kq_f_minus1)) + if (allocated(InData%Kq_f_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%Kq_f_minus1), ubound(InData%Kq_f_minus1)) + call RegPack(Buf, InData%Kq_f_minus1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! q_f_minus1 + call RegPack(Buf, allocated(InData%q_f_minus1)) + if (allocated(InData%q_f_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%q_f_minus1), ubound(InData%q_f_minus1)) + call RegPack(Buf, InData%q_f_minus1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! X1_minus1 + call RegPack(Buf, allocated(InData%X1_minus1)) + if (allocated(InData%X1_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%X1_minus1), ubound(InData%X1_minus1)) + call RegPack(Buf, InData%X1_minus1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! X2_minus1 + call RegPack(Buf, allocated(InData%X2_minus1)) + if (allocated(InData%X2_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%X2_minus1), ubound(InData%X2_minus1)) + call RegPack(Buf, InData%X2_minus1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! X3_minus1 + call RegPack(Buf, allocated(InData%X3_minus1)) + if (allocated(InData%X3_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%X3_minus1), ubound(InData%X3_minus1)) + call RegPack(Buf, InData%X3_minus1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! X4_minus1 + call RegPack(Buf, allocated(InData%X4_minus1)) + if (allocated(InData%X4_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%X4_minus1), ubound(InData%X4_minus1)) + call RegPack(Buf, InData%X4_minus1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Kprime_alpha_minus1 + call RegPack(Buf, allocated(InData%Kprime_alpha_minus1)) + if (allocated(InData%Kprime_alpha_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%Kprime_alpha_minus1), ubound(InData%Kprime_alpha_minus1)) + call RegPack(Buf, InData%Kprime_alpha_minus1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Kprime_q_minus1 + call RegPack(Buf, allocated(InData%Kprime_q_minus1)) + if (allocated(InData%Kprime_q_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%Kprime_q_minus1), ubound(InData%Kprime_q_minus1)) + call RegPack(Buf, InData%Kprime_q_minus1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Kprimeprime_q_minus1 + call RegPack(Buf, allocated(InData%Kprimeprime_q_minus1)) + if (allocated(InData%Kprimeprime_q_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%Kprimeprime_q_minus1), ubound(InData%Kprimeprime_q_minus1)) + call RegPack(Buf, InData%Kprimeprime_q_minus1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! K3prime_q_minus1 + call RegPack(Buf, allocated(InData%K3prime_q_minus1)) + if (allocated(InData%K3prime_q_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%K3prime_q_minus1), ubound(InData%K3prime_q_minus1)) + call RegPack(Buf, InData%K3prime_q_minus1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Dp_minus1 + call RegPack(Buf, allocated(InData%Dp_minus1)) + if (allocated(InData%Dp_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%Dp_minus1), ubound(InData%Dp_minus1)) + call RegPack(Buf, InData%Dp_minus1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Cn_pot_minus1 + call RegPack(Buf, allocated(InData%Cn_pot_minus1)) + if (allocated(InData%Cn_pot_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%Cn_pot_minus1), ubound(InData%Cn_pot_minus1)) + call RegPack(Buf, InData%Cn_pot_minus1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! fprimeprime_minus1 + call RegPack(Buf, allocated(InData%fprimeprime_minus1)) + if (allocated(InData%fprimeprime_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%fprimeprime_minus1), ubound(InData%fprimeprime_minus1)) + call RegPack(Buf, InData%fprimeprime_minus1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! fprimeprime_c_minus1 + call RegPack(Buf, allocated(InData%fprimeprime_c_minus1)) + if (allocated(InData%fprimeprime_c_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%fprimeprime_c_minus1), ubound(InData%fprimeprime_c_minus1)) + call RegPack(Buf, InData%fprimeprime_c_minus1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! fprimeprime_m_minus1 + call RegPack(Buf, allocated(InData%fprimeprime_m_minus1)) + if (allocated(InData%fprimeprime_m_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%fprimeprime_m_minus1), ubound(InData%fprimeprime_m_minus1)) + call RegPack(Buf, InData%fprimeprime_m_minus1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Df_minus1 + call RegPack(Buf, allocated(InData%Df_minus1)) + if (allocated(InData%Df_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%Df_minus1), ubound(InData%Df_minus1)) + call RegPack(Buf, InData%Df_minus1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Df_c_minus1 + call RegPack(Buf, allocated(InData%Df_c_minus1)) + if (allocated(InData%Df_c_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%Df_c_minus1), ubound(InData%Df_c_minus1)) + call RegPack(Buf, InData%Df_c_minus1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Df_m_minus1 + call RegPack(Buf, allocated(InData%Df_m_minus1)) + if (allocated(InData%Df_m_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%Df_m_minus1), ubound(InData%Df_m_minus1)) + call RegPack(Buf, InData%Df_m_minus1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Dalphaf_minus1 + call RegPack(Buf, allocated(InData%Dalphaf_minus1)) + if (allocated(InData%Dalphaf_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%Dalphaf_minus1), ubound(InData%Dalphaf_minus1)) + call RegPack(Buf, InData%Dalphaf_minus1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! alphaf_minus1 + call RegPack(Buf, allocated(InData%alphaf_minus1)) + if (allocated(InData%alphaf_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%alphaf_minus1), ubound(InData%alphaf_minus1)) + call RegPack(Buf, InData%alphaf_minus1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! fprime_minus1 + call RegPack(Buf, allocated(InData%fprime_minus1)) + if (allocated(InData%fprime_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%fprime_minus1), ubound(InData%fprime_minus1)) + call RegPack(Buf, InData%fprime_minus1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! fprime_c_minus1 + call RegPack(Buf, allocated(InData%fprime_c_minus1)) + if (allocated(InData%fprime_c_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%fprime_c_minus1), ubound(InData%fprime_c_minus1)) + call RegPack(Buf, InData%fprime_c_minus1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! fprime_m_minus1 + call RegPack(Buf, allocated(InData%fprime_m_minus1)) + if (allocated(InData%fprime_m_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%fprime_m_minus1), ubound(InData%fprime_m_minus1)) + call RegPack(Buf, InData%fprime_m_minus1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! tau_V + call RegPack(Buf, allocated(InData%tau_V)) + if (allocated(InData%tau_V)) then + call RegPackBounds(Buf, 2, lbound(InData%tau_V), ubound(InData%tau_V)) + call RegPack(Buf, InData%tau_V) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! tau_V_minus1 + call RegPack(Buf, allocated(InData%tau_V_minus1)) + if (allocated(InData%tau_V_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%tau_V_minus1), ubound(InData%tau_V_minus1)) + call RegPack(Buf, InData%tau_V_minus1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Cn_v_minus1 + call RegPack(Buf, allocated(InData%Cn_v_minus1)) + if (allocated(InData%Cn_v_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%Cn_v_minus1), ubound(InData%Cn_v_minus1)) + call RegPack(Buf, InData%Cn_v_minus1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! C_V_minus1 + call RegPack(Buf, allocated(InData%C_V_minus1)) + if (allocated(InData%C_V_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%C_V_minus1), ubound(InData%C_V_minus1)) + call RegPack(Buf, InData%C_V_minus1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Cn_prime_minus1 + call RegPack(Buf, allocated(InData%Cn_prime_minus1)) + if (allocated(InData%Cn_prime_minus1)) then + call RegPackBounds(Buf, 2, lbound(InData%Cn_prime_minus1), ubound(InData%Cn_prime_minus1)) + call RegPack(Buf, InData%Cn_prime_minus1) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine UA_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(UA_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'UA_UnPackDiscState' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! alpha_minus1 + if (allocated(OutData%alpha_minus1)) deallocate(OutData%alpha_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%alpha_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%alpha_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! alpha_filt_minus1 + if (allocated(OutData%alpha_filt_minus1)) deallocate(OutData%alpha_filt_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%alpha_filt_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_filt_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%alpha_filt_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! alpha_dot + if (allocated(OutData%alpha_dot)) deallocate(OutData%alpha_dot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%alpha_dot(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_dot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%alpha_dot) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! alpha_dot_minus1 + if (allocated(OutData%alpha_dot_minus1)) deallocate(OutData%alpha_dot_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%alpha_dot_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_dot_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%alpha_dot_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! q_minus1 + if (allocated(OutData%q_minus1)) deallocate(OutData%q_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%q_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%q_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%q_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Kalpha_f_minus1 + if (allocated(OutData%Kalpha_f_minus1)) deallocate(OutData%Kalpha_f_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Kalpha_f_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kalpha_f_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Kalpha_f_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Kq_f_minus1 + if (allocated(OutData%Kq_f_minus1)) deallocate(OutData%Kq_f_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Kq_f_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kq_f_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Kq_f_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! q_f_minus1 + if (allocated(OutData%q_f_minus1)) deallocate(OutData%q_f_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%q_f_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%q_f_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%q_f_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! X1_minus1 + if (allocated(OutData%X1_minus1)) deallocate(OutData%X1_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%X1_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%X1_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%X1_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! X2_minus1 + if (allocated(OutData%X2_minus1)) deallocate(OutData%X2_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%X2_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%X2_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%X2_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! X3_minus1 + if (allocated(OutData%X3_minus1)) deallocate(OutData%X3_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%X3_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%X3_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%X3_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! X4_minus1 + if (allocated(OutData%X4_minus1)) deallocate(OutData%X4_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%X4_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%X4_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%X4_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Kprime_alpha_minus1 + if (allocated(OutData%Kprime_alpha_minus1)) deallocate(OutData%Kprime_alpha_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Kprime_alpha_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kprime_alpha_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Kprime_alpha_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Kprime_q_minus1 + if (allocated(OutData%Kprime_q_minus1)) deallocate(OutData%Kprime_q_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Kprime_q_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kprime_q_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Kprime_q_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Kprimeprime_q_minus1 + if (allocated(OutData%Kprimeprime_q_minus1)) deallocate(OutData%Kprimeprime_q_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Kprimeprime_q_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kprimeprime_q_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Kprimeprime_q_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! K3prime_q_minus1 + if (allocated(OutData%K3prime_q_minus1)) deallocate(OutData%K3prime_q_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%K3prime_q_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%K3prime_q_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%K3prime_q_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Dp_minus1 + if (allocated(OutData%Dp_minus1)) deallocate(OutData%Dp_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Dp_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dp_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Dp_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Cn_pot_minus1 + if (allocated(OutData%Cn_pot_minus1)) deallocate(OutData%Cn_pot_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Cn_pot_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cn_pot_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Cn_pot_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! fprimeprime_minus1 + if (allocated(OutData%fprimeprime_minus1)) deallocate(OutData%fprimeprime_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%fprimeprime_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprimeprime_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%fprimeprime_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! fprimeprime_c_minus1 + if (allocated(OutData%fprimeprime_c_minus1)) deallocate(OutData%fprimeprime_c_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%fprimeprime_c_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprimeprime_c_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%fprimeprime_c_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! fprimeprime_m_minus1 + if (allocated(OutData%fprimeprime_m_minus1)) deallocate(OutData%fprimeprime_m_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%fprimeprime_m_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprimeprime_m_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%fprimeprime_m_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Df_minus1 + if (allocated(OutData%Df_minus1)) deallocate(OutData%Df_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Df_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Df_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Df_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Df_c_minus1 + if (allocated(OutData%Df_c_minus1)) deallocate(OutData%Df_c_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Df_c_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Df_c_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Df_c_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Df_m_minus1 + if (allocated(OutData%Df_m_minus1)) deallocate(OutData%Df_m_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Df_m_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Df_m_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Df_m_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Dalphaf_minus1 + if (allocated(OutData%Dalphaf_minus1)) deallocate(OutData%Dalphaf_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Dalphaf_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dalphaf_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Dalphaf_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! alphaf_minus1 + if (allocated(OutData%alphaf_minus1)) deallocate(OutData%alphaf_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%alphaf_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%alphaf_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%alphaf_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! fprime_minus1 + if (allocated(OutData%fprime_minus1)) deallocate(OutData%fprime_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%fprime_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprime_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%fprime_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! fprime_c_minus1 + if (allocated(OutData%fprime_c_minus1)) deallocate(OutData%fprime_c_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%fprime_c_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprime_c_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%fprime_c_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! fprime_m_minus1 + if (allocated(OutData%fprime_m_minus1)) deallocate(OutData%fprime_m_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%fprime_m_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprime_m_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%fprime_m_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! tau_V + if (allocated(OutData%tau_V)) deallocate(OutData%tau_V) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%tau_V(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%tau_V.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%tau_V) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! tau_V_minus1 + if (allocated(OutData%tau_V_minus1)) deallocate(OutData%tau_V_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%tau_V_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%tau_V_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%tau_V_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Cn_v_minus1 + if (allocated(OutData%Cn_v_minus1)) deallocate(OutData%Cn_v_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Cn_v_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cn_v_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Cn_v_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! C_V_minus1 + if (allocated(OutData%C_V_minus1)) deallocate(OutData%C_V_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%C_V_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%C_V_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%C_V_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Cn_prime_minus1 + if (allocated(OutData%Cn_prime_minus1)) deallocate(OutData%Cn_prime_minus1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Cn_prime_minus1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cn_prime_minus1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Cn_prime_minus1) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + SUBROUTINE UA_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(UA_ConstraintStateType), INTENT(IN) :: SrcConstrStateData + TYPE(UA_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'UA_CopyConstrState' +! + ErrStat = ErrID_None + ErrMsg = "" + DstConstrStateData%DummyConstraintState = SrcConstrStateData%DummyConstraintState + END SUBROUTINE UA_CopyConstrState + + SUBROUTINE UA_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) + TYPE(UA_ConstraintStateType), INTENT(INOUT) :: ConstrStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_PackDiscState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyConstrState' - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! ErrStat = ErrID_None ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! alpha_minus1 allocated yes/no - IF ( ALLOCATED(InData%alpha_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! alpha_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%alpha_minus1) ! alpha_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! alpha_filt_minus1 allocated yes/no - IF ( ALLOCATED(InData%alpha_filt_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! alpha_filt_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%alpha_filt_minus1) ! alpha_filt_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! alpha_dot allocated yes/no - IF ( ALLOCATED(InData%alpha_dot) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! alpha_dot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%alpha_dot) ! alpha_dot - END IF - Int_BufSz = Int_BufSz + 1 ! alpha_dot_minus1 allocated yes/no - IF ( ALLOCATED(InData%alpha_dot_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! alpha_dot_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%alpha_dot_minus1) ! alpha_dot_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! q_minus1 allocated yes/no - IF ( ALLOCATED(InData%q_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! q_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%q_minus1) ! q_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! Kalpha_f_minus1 allocated yes/no - IF ( ALLOCATED(InData%Kalpha_f_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Kalpha_f_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Kalpha_f_minus1) ! Kalpha_f_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! Kq_f_minus1 allocated yes/no - IF ( ALLOCATED(InData%Kq_f_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Kq_f_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Kq_f_minus1) ! Kq_f_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! q_f_minus1 allocated yes/no - IF ( ALLOCATED(InData%q_f_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! q_f_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%q_f_minus1) ! q_f_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! X1_minus1 allocated yes/no - IF ( ALLOCATED(InData%X1_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! X1_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%X1_minus1) ! X1_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! X2_minus1 allocated yes/no - IF ( ALLOCATED(InData%X2_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! X2_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%X2_minus1) ! X2_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! X3_minus1 allocated yes/no - IF ( ALLOCATED(InData%X3_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! X3_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%X3_minus1) ! X3_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! X4_minus1 allocated yes/no - IF ( ALLOCATED(InData%X4_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! X4_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%X4_minus1) ! X4_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! Kprime_alpha_minus1 allocated yes/no - IF ( ALLOCATED(InData%Kprime_alpha_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Kprime_alpha_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Kprime_alpha_minus1) ! Kprime_alpha_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! Kprime_q_minus1 allocated yes/no - IF ( ALLOCATED(InData%Kprime_q_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Kprime_q_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Kprime_q_minus1) ! Kprime_q_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! Kprimeprime_q_minus1 allocated yes/no - IF ( ALLOCATED(InData%Kprimeprime_q_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Kprimeprime_q_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Kprimeprime_q_minus1) ! Kprimeprime_q_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! K3prime_q_minus1 allocated yes/no - IF ( ALLOCATED(InData%K3prime_q_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! K3prime_q_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%K3prime_q_minus1) ! K3prime_q_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! Dp_minus1 allocated yes/no - IF ( ALLOCATED(InData%Dp_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Dp_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Dp_minus1) ! Dp_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! Cn_pot_minus1 allocated yes/no - IF ( ALLOCATED(InData%Cn_pot_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Cn_pot_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cn_pot_minus1) ! Cn_pot_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! fprimeprime_minus1 allocated yes/no - IF ( ALLOCATED(InData%fprimeprime_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! fprimeprime_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fprimeprime_minus1) ! fprimeprime_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! fprimeprime_c_minus1 allocated yes/no - IF ( ALLOCATED(InData%fprimeprime_c_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! fprimeprime_c_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fprimeprime_c_minus1) ! fprimeprime_c_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! fprimeprime_m_minus1 allocated yes/no - IF ( ALLOCATED(InData%fprimeprime_m_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! fprimeprime_m_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fprimeprime_m_minus1) ! fprimeprime_m_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! Df_minus1 allocated yes/no - IF ( ALLOCATED(InData%Df_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Df_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Df_minus1) ! Df_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! Df_c_minus1 allocated yes/no - IF ( ALLOCATED(InData%Df_c_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Df_c_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Df_c_minus1) ! Df_c_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! Df_m_minus1 allocated yes/no - IF ( ALLOCATED(InData%Df_m_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Df_m_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Df_m_minus1) ! Df_m_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! Dalphaf_minus1 allocated yes/no - IF ( ALLOCATED(InData%Dalphaf_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Dalphaf_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Dalphaf_minus1) ! Dalphaf_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! alphaf_minus1 allocated yes/no - IF ( ALLOCATED(InData%alphaf_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! alphaf_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%alphaf_minus1) ! alphaf_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! fprime_minus1 allocated yes/no - IF ( ALLOCATED(InData%fprime_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! fprime_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fprime_minus1) ! fprime_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! fprime_c_minus1 allocated yes/no - IF ( ALLOCATED(InData%fprime_c_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! fprime_c_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fprime_c_minus1) ! fprime_c_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! fprime_m_minus1 allocated yes/no - IF ( ALLOCATED(InData%fprime_m_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! fprime_m_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fprime_m_minus1) ! fprime_m_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! tau_V allocated yes/no - IF ( ALLOCATED(InData%tau_V) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! tau_V upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%tau_V) ! tau_V - END IF - Int_BufSz = Int_BufSz + 1 ! tau_V_minus1 allocated yes/no - IF ( ALLOCATED(InData%tau_V_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! tau_V_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%tau_V_minus1) ! tau_V_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! Cn_v_minus1 allocated yes/no - IF ( ALLOCATED(InData%Cn_v_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Cn_v_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cn_v_minus1) ! Cn_v_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! C_V_minus1 allocated yes/no - IF ( ALLOCATED(InData%C_V_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! C_V_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%C_V_minus1) ! C_V_minus1 - END IF - Int_BufSz = Int_BufSz + 1 ! Cn_prime_minus1 allocated yes/no - IF ( ALLOCATED(InData%Cn_prime_minus1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Cn_prime_minus1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cn_prime_minus1) ! Cn_prime_minus1 - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%alpha_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%alpha_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%alpha_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%alpha_minus1,2), UBOUND(InData%alpha_minus1,2) - DO i1 = LBOUND(InData%alpha_minus1,1), UBOUND(InData%alpha_minus1,1) - ReKiBuf(Re_Xferred) = InData%alpha_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%alpha_filt_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%alpha_filt_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_filt_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%alpha_filt_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_filt_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%alpha_filt_minus1,2), UBOUND(InData%alpha_filt_minus1,2) - DO i1 = LBOUND(InData%alpha_filt_minus1,1), UBOUND(InData%alpha_filt_minus1,1) - ReKiBuf(Re_Xferred) = InData%alpha_filt_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%alpha_dot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%alpha_dot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_dot,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%alpha_dot,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_dot,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%alpha_dot,2), UBOUND(InData%alpha_dot,2) - DO i1 = LBOUND(InData%alpha_dot,1), UBOUND(InData%alpha_dot,1) - ReKiBuf(Re_Xferred) = InData%alpha_dot(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%alpha_dot_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%alpha_dot_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_dot_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%alpha_dot_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_dot_minus1,2) - Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%alpha_dot_minus1,2), UBOUND(InData%alpha_dot_minus1,2) - DO i1 = LBOUND(InData%alpha_dot_minus1,1), UBOUND(InData%alpha_dot_minus1,1) - ReKiBuf(Re_Xferred) = InData%alpha_dot_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%q_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%q_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%q_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%q_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%q_minus1,2) - Int_Xferred = Int_Xferred + 2 + END SUBROUTINE UA_DestroyConstrState - DO i2 = LBOUND(InData%q_minus1,2), UBOUND(InData%q_minus1,2) - DO i1 = LBOUND(InData%q_minus1,1), UBOUND(InData%q_minus1,1) - ReKiBuf(Re_Xferred) = InData%q_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Kalpha_f_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Kalpha_f_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kalpha_f_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Kalpha_f_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kalpha_f_minus1,2) - Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%Kalpha_f_minus1,2), UBOUND(InData%Kalpha_f_minus1,2) - DO i1 = LBOUND(InData%Kalpha_f_minus1,1), UBOUND(InData%Kalpha_f_minus1,1) - ReKiBuf(Re_Xferred) = InData%Kalpha_f_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO +subroutine UA_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(UA_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'UA_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyConstraintState + call RegPack(Buf, InData%DummyConstraintState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine UA_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(UA_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'UA_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + ! DummyConstraintState + call RegUnpack(Buf, OutData%DummyConstraintState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + SUBROUTINE UA_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(UA_OtherStateType), INTENT(IN) :: SrcOtherStateData + TYPE(UA_OtherStateType), INTENT(INOUT) :: DstOtherStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'UA_CopyOtherState' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcOtherStateData%FirstPass)) THEN + i1_l = LBOUND(SrcOtherStateData%FirstPass,1) + i1_u = UBOUND(SrcOtherStateData%FirstPass,1) + i2_l = LBOUND(SrcOtherStateData%FirstPass,2) + i2_u = UBOUND(SrcOtherStateData%FirstPass,2) + IF (.NOT. ALLOCATED(DstOtherStateData%FirstPass)) THEN + ALLOCATE(DstOtherStateData%FirstPass(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%FirstPass.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF ( .NOT. ALLOCATED(InData%Kq_f_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Kq_f_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kq_f_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Kq_f_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kq_f_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Kq_f_minus1,2), UBOUND(InData%Kq_f_minus1,2) - DO i1 = LBOUND(InData%Kq_f_minus1,1), UBOUND(InData%Kq_f_minus1,1) - ReKiBuf(Re_Xferred) = InData%Kq_f_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO + DstOtherStateData%FirstPass = SrcOtherStateData%FirstPass +ENDIF +IF (ALLOCATED(SrcOtherStateData%sigma1)) THEN + i1_l = LBOUND(SrcOtherStateData%sigma1,1) + i1_u = UBOUND(SrcOtherStateData%sigma1,1) + i2_l = LBOUND(SrcOtherStateData%sigma1,2) + i2_u = UBOUND(SrcOtherStateData%sigma1,2) + IF (.NOT. ALLOCATED(DstOtherStateData%sigma1)) THEN + ALLOCATE(DstOtherStateData%sigma1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%sigma1.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF ( .NOT. ALLOCATED(InData%q_f_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%q_f_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%q_f_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%q_f_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%q_f_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%q_f_minus1,2), UBOUND(InData%q_f_minus1,2) - DO i1 = LBOUND(InData%q_f_minus1,1), UBOUND(InData%q_f_minus1,1) - ReKiBuf(Re_Xferred) = InData%q_f_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%X1_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%X1_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X1_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%X1_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X1_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%X1_minus1,2), UBOUND(InData%X1_minus1,2) - DO i1 = LBOUND(InData%X1_minus1,1), UBOUND(InData%X1_minus1,1) - ReKiBuf(Re_Xferred) = InData%X1_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%X2_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%X2_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X2_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%X2_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X2_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%X2_minus1,2), UBOUND(InData%X2_minus1,2) - DO i1 = LBOUND(InData%X2_minus1,1), UBOUND(InData%X2_minus1,1) - ReKiBuf(Re_Xferred) = InData%X2_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%X3_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%X3_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X3_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%X3_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X3_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%X3_minus1,2), UBOUND(InData%X3_minus1,2) - DO i1 = LBOUND(InData%X3_minus1,1), UBOUND(InData%X3_minus1,1) - ReKiBuf(Re_Xferred) = InData%X3_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%X4_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%X4_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X4_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%X4_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X4_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%X4_minus1,2), UBOUND(InData%X4_minus1,2) - DO i1 = LBOUND(InData%X4_minus1,1), UBOUND(InData%X4_minus1,1) - ReKiBuf(Re_Xferred) = InData%X4_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Kprime_alpha_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Kprime_alpha_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kprime_alpha_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Kprime_alpha_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kprime_alpha_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Kprime_alpha_minus1,2), UBOUND(InData%Kprime_alpha_minus1,2) - DO i1 = LBOUND(InData%Kprime_alpha_minus1,1), UBOUND(InData%Kprime_alpha_minus1,1) - ReKiBuf(Re_Xferred) = InData%Kprime_alpha_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Kprime_q_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Kprime_q_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kprime_q_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Kprime_q_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kprime_q_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Kprime_q_minus1,2), UBOUND(InData%Kprime_q_minus1,2) - DO i1 = LBOUND(InData%Kprime_q_minus1,1), UBOUND(InData%Kprime_q_minus1,1) - ReKiBuf(Re_Xferred) = InData%Kprime_q_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Kprimeprime_q_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Kprimeprime_q_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kprimeprime_q_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Kprimeprime_q_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kprimeprime_q_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Kprimeprime_q_minus1,2), UBOUND(InData%Kprimeprime_q_minus1,2) - DO i1 = LBOUND(InData%Kprimeprime_q_minus1,1), UBOUND(InData%Kprimeprime_q_minus1,1) - ReKiBuf(Re_Xferred) = InData%Kprimeprime_q_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%K3prime_q_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%K3prime_q_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%K3prime_q_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%K3prime_q_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%K3prime_q_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%K3prime_q_minus1,2), UBOUND(InData%K3prime_q_minus1,2) - DO i1 = LBOUND(InData%K3prime_q_minus1,1), UBOUND(InData%K3prime_q_minus1,1) - ReKiBuf(Re_Xferred) = InData%K3prime_q_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Dp_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Dp_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dp_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Dp_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dp_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Dp_minus1,2), UBOUND(InData%Dp_minus1,2) - DO i1 = LBOUND(InData%Dp_minus1,1), UBOUND(InData%Dp_minus1,1) - ReKiBuf(Re_Xferred) = InData%Dp_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cn_pot_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cn_pot_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cn_pot_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cn_pot_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cn_pot_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Cn_pot_minus1,2), UBOUND(InData%Cn_pot_minus1,2) - DO i1 = LBOUND(InData%Cn_pot_minus1,1), UBOUND(InData%Cn_pot_minus1,1) - ReKiBuf(Re_Xferred) = InData%Cn_pot_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%fprimeprime_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fprimeprime_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprimeprime_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fprimeprime_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprimeprime_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%fprimeprime_minus1,2), UBOUND(InData%fprimeprime_minus1,2) - DO i1 = LBOUND(InData%fprimeprime_minus1,1), UBOUND(InData%fprimeprime_minus1,1) - ReKiBuf(Re_Xferred) = InData%fprimeprime_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%fprimeprime_c_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fprimeprime_c_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprimeprime_c_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fprimeprime_c_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprimeprime_c_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%fprimeprime_c_minus1,2), UBOUND(InData%fprimeprime_c_minus1,2) - DO i1 = LBOUND(InData%fprimeprime_c_minus1,1), UBOUND(InData%fprimeprime_c_minus1,1) - ReKiBuf(Re_Xferred) = InData%fprimeprime_c_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%fprimeprime_m_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fprimeprime_m_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprimeprime_m_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fprimeprime_m_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprimeprime_m_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%fprimeprime_m_minus1,2), UBOUND(InData%fprimeprime_m_minus1,2) - DO i1 = LBOUND(InData%fprimeprime_m_minus1,1), UBOUND(InData%fprimeprime_m_minus1,1) - ReKiBuf(Re_Xferred) = InData%fprimeprime_m_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Df_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Df_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Df_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Df_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Df_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Df_minus1,2), UBOUND(InData%Df_minus1,2) - DO i1 = LBOUND(InData%Df_minus1,1), UBOUND(InData%Df_minus1,1) - ReKiBuf(Re_Xferred) = InData%Df_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Df_c_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Df_c_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Df_c_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Df_c_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Df_c_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Df_c_minus1,2), UBOUND(InData%Df_c_minus1,2) - DO i1 = LBOUND(InData%Df_c_minus1,1), UBOUND(InData%Df_c_minus1,1) - ReKiBuf(Re_Xferred) = InData%Df_c_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Df_m_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Df_m_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Df_m_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Df_m_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Df_m_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Df_m_minus1,2), UBOUND(InData%Df_m_minus1,2) - DO i1 = LBOUND(InData%Df_m_minus1,1), UBOUND(InData%Df_m_minus1,1) - ReKiBuf(Re_Xferred) = InData%Df_m_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Dalphaf_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Dalphaf_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dalphaf_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Dalphaf_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dalphaf_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Dalphaf_minus1,2), UBOUND(InData%Dalphaf_minus1,2) - DO i1 = LBOUND(InData%Dalphaf_minus1,1), UBOUND(InData%Dalphaf_minus1,1) - ReKiBuf(Re_Xferred) = InData%Dalphaf_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%alphaf_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%alphaf_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alphaf_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%alphaf_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alphaf_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%alphaf_minus1,2), UBOUND(InData%alphaf_minus1,2) - DO i1 = LBOUND(InData%alphaf_minus1,1), UBOUND(InData%alphaf_minus1,1) - ReKiBuf(Re_Xferred) = InData%alphaf_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%fprime_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fprime_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprime_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fprime_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprime_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%fprime_minus1,2), UBOUND(InData%fprime_minus1,2) - DO i1 = LBOUND(InData%fprime_minus1,1), UBOUND(InData%fprime_minus1,1) - ReKiBuf(Re_Xferred) = InData%fprime_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%fprime_c_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fprime_c_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprime_c_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fprime_c_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprime_c_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%fprime_c_minus1,2), UBOUND(InData%fprime_c_minus1,2) - DO i1 = LBOUND(InData%fprime_c_minus1,1), UBOUND(InData%fprime_c_minus1,1) - ReKiBuf(Re_Xferred) = InData%fprime_c_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%fprime_m_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fprime_m_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprime_m_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fprime_m_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprime_m_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%fprime_m_minus1,2), UBOUND(InData%fprime_m_minus1,2) - DO i1 = LBOUND(InData%fprime_m_minus1,1), UBOUND(InData%fprime_m_minus1,1) - ReKiBuf(Re_Xferred) = InData%fprime_m_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%tau_V) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%tau_V,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tau_V,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%tau_V,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tau_V,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%tau_V,2), UBOUND(InData%tau_V,2) - DO i1 = LBOUND(InData%tau_V,1), UBOUND(InData%tau_V,1) - ReKiBuf(Re_Xferred) = InData%tau_V(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%tau_V_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%tau_V_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tau_V_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%tau_V_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tau_V_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%tau_V_minus1,2), UBOUND(InData%tau_V_minus1,2) - DO i1 = LBOUND(InData%tau_V_minus1,1), UBOUND(InData%tau_V_minus1,1) - ReKiBuf(Re_Xferred) = InData%tau_V_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cn_v_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cn_v_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cn_v_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cn_v_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cn_v_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Cn_v_minus1,2), UBOUND(InData%Cn_v_minus1,2) - DO i1 = LBOUND(InData%Cn_v_minus1,1), UBOUND(InData%Cn_v_minus1,1) - ReKiBuf(Re_Xferred) = InData%Cn_v_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%C_V_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C_V_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C_V_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C_V_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C_V_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%C_V_minus1,2), UBOUND(InData%C_V_minus1,2) - DO i1 = LBOUND(InData%C_V_minus1,1), UBOUND(InData%C_V_minus1,1) - ReKiBuf(Re_Xferred) = InData%C_V_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cn_prime_minus1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cn_prime_minus1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cn_prime_minus1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cn_prime_minus1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cn_prime_minus1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Cn_prime_minus1,2), UBOUND(InData%Cn_prime_minus1,2) - DO i1 = LBOUND(InData%Cn_prime_minus1,1), UBOUND(InData%Cn_prime_minus1,1) - ReKiBuf(Re_Xferred) = InData%Cn_prime_minus1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE UA_PackDiscState - - SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(UA_DiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_UnPackDiscState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! alpha_minus1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%alpha_minus1)) DEALLOCATE(OutData%alpha_minus1) - ALLOCATE(OutData%alpha_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%alpha_minus1,2), UBOUND(OutData%alpha_minus1,2) - DO i1 = LBOUND(OutData%alpha_minus1,1), UBOUND(OutData%alpha_minus1,1) - OutData%alpha_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! alpha_filt_minus1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%alpha_filt_minus1)) DEALLOCATE(OutData%alpha_filt_minus1) - ALLOCATE(OutData%alpha_filt_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_filt_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%alpha_filt_minus1,2), UBOUND(OutData%alpha_filt_minus1,2) - DO i1 = LBOUND(OutData%alpha_filt_minus1,1), UBOUND(OutData%alpha_filt_minus1,1) - OutData%alpha_filt_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! alpha_dot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%alpha_dot)) DEALLOCATE(OutData%alpha_dot) - ALLOCATE(OutData%alpha_dot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_dot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%alpha_dot,2), UBOUND(OutData%alpha_dot,2) - DO i1 = LBOUND(OutData%alpha_dot,1), UBOUND(OutData%alpha_dot,1) - OutData%alpha_dot(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! alpha_dot_minus1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%alpha_dot_minus1)) DEALLOCATE(OutData%alpha_dot_minus1) - ALLOCATE(OutData%alpha_dot_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_dot_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%alpha_dot_minus1,2), UBOUND(OutData%alpha_dot_minus1,2) - DO i1 = LBOUND(OutData%alpha_dot_minus1,1), UBOUND(OutData%alpha_dot_minus1,1) - OutData%alpha_dot_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! q_minus1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%q_minus1)) DEALLOCATE(OutData%q_minus1) - ALLOCATE(OutData%q_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%q_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%q_minus1,2), UBOUND(OutData%q_minus1,2) - DO i1 = LBOUND(OutData%q_minus1,1), UBOUND(OutData%q_minus1,1) - OutData%q_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Kalpha_f_minus1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Kalpha_f_minus1)) DEALLOCATE(OutData%Kalpha_f_minus1) - ALLOCATE(OutData%Kalpha_f_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kalpha_f_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Kalpha_f_minus1,2), UBOUND(OutData%Kalpha_f_minus1,2) - DO i1 = LBOUND(OutData%Kalpha_f_minus1,1), UBOUND(OutData%Kalpha_f_minus1,1) - OutData%Kalpha_f_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Kq_f_minus1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Kq_f_minus1)) DEALLOCATE(OutData%Kq_f_minus1) - ALLOCATE(OutData%Kq_f_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kq_f_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Kq_f_minus1,2), UBOUND(OutData%Kq_f_minus1,2) - DO i1 = LBOUND(OutData%Kq_f_minus1,1), UBOUND(OutData%Kq_f_minus1,1) - OutData%Kq_f_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! q_f_minus1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%q_f_minus1)) DEALLOCATE(OutData%q_f_minus1) - ALLOCATE(OutData%q_f_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%q_f_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%q_f_minus1,2), UBOUND(OutData%q_f_minus1,2) - DO i1 = LBOUND(OutData%q_f_minus1,1), UBOUND(OutData%q_f_minus1,1) - OutData%q_f_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X1_minus1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%X1_minus1)) DEALLOCATE(OutData%X1_minus1) - ALLOCATE(OutData%X1_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X1_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%X1_minus1,2), UBOUND(OutData%X1_minus1,2) - DO i1 = LBOUND(OutData%X1_minus1,1), UBOUND(OutData%X1_minus1,1) - OutData%X1_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X2_minus1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%X2_minus1)) DEALLOCATE(OutData%X2_minus1) - ALLOCATE(OutData%X2_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X2_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%X2_minus1,2), UBOUND(OutData%X2_minus1,2) - DO i1 = LBOUND(OutData%X2_minus1,1), UBOUND(OutData%X2_minus1,1) - OutData%X2_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X3_minus1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%X3_minus1)) DEALLOCATE(OutData%X3_minus1) - ALLOCATE(OutData%X3_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X3_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%X3_minus1,2), UBOUND(OutData%X3_minus1,2) - DO i1 = LBOUND(OutData%X3_minus1,1), UBOUND(OutData%X3_minus1,1) - OutData%X3_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X4_minus1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%X4_minus1)) DEALLOCATE(OutData%X4_minus1) - ALLOCATE(OutData%X4_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X4_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%X4_minus1,2), UBOUND(OutData%X4_minus1,2) - DO i1 = LBOUND(OutData%X4_minus1,1), UBOUND(OutData%X4_minus1,1) - OutData%X4_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Kprime_alpha_minus1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Kprime_alpha_minus1)) DEALLOCATE(OutData%Kprime_alpha_minus1) - ALLOCATE(OutData%Kprime_alpha_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kprime_alpha_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Kprime_alpha_minus1,2), UBOUND(OutData%Kprime_alpha_minus1,2) - DO i1 = LBOUND(OutData%Kprime_alpha_minus1,1), UBOUND(OutData%Kprime_alpha_minus1,1) - OutData%Kprime_alpha_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Kprime_q_minus1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Kprime_q_minus1)) DEALLOCATE(OutData%Kprime_q_minus1) - ALLOCATE(OutData%Kprime_q_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kprime_q_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Kprime_q_minus1,2), UBOUND(OutData%Kprime_q_minus1,2) - DO i1 = LBOUND(OutData%Kprime_q_minus1,1), UBOUND(OutData%Kprime_q_minus1,1) - OutData%Kprime_q_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Kprimeprime_q_minus1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Kprimeprime_q_minus1)) DEALLOCATE(OutData%Kprimeprime_q_minus1) - ALLOCATE(OutData%Kprimeprime_q_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kprimeprime_q_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Kprimeprime_q_minus1,2), UBOUND(OutData%Kprimeprime_q_minus1,2) - DO i1 = LBOUND(OutData%Kprimeprime_q_minus1,1), UBOUND(OutData%Kprimeprime_q_minus1,1) - OutData%Kprimeprime_q_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! K3prime_q_minus1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%K3prime_q_minus1)) DEALLOCATE(OutData%K3prime_q_minus1) - ALLOCATE(OutData%K3prime_q_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%K3prime_q_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%K3prime_q_minus1,2), UBOUND(OutData%K3prime_q_minus1,2) - DO i1 = LBOUND(OutData%K3prime_q_minus1,1), UBOUND(OutData%K3prime_q_minus1,1) - OutData%K3prime_q_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Dp_minus1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Dp_minus1)) DEALLOCATE(OutData%Dp_minus1) - ALLOCATE(OutData%Dp_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dp_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Dp_minus1,2), UBOUND(OutData%Dp_minus1,2) - DO i1 = LBOUND(OutData%Dp_minus1,1), UBOUND(OutData%Dp_minus1,1) - OutData%Dp_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cn_pot_minus1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Cn_pot_minus1)) DEALLOCATE(OutData%Cn_pot_minus1) - ALLOCATE(OutData%Cn_pot_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cn_pot_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Cn_pot_minus1,2), UBOUND(OutData%Cn_pot_minus1,2) - DO i1 = LBOUND(OutData%Cn_pot_minus1,1), UBOUND(OutData%Cn_pot_minus1,1) - OutData%Cn_pot_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fprimeprime_minus1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%fprimeprime_minus1)) DEALLOCATE(OutData%fprimeprime_minus1) - ALLOCATE(OutData%fprimeprime_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprimeprime_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%fprimeprime_minus1,2), UBOUND(OutData%fprimeprime_minus1,2) - DO i1 = LBOUND(OutData%fprimeprime_minus1,1), UBOUND(OutData%fprimeprime_minus1,1) - OutData%fprimeprime_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fprimeprime_c_minus1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%fprimeprime_c_minus1)) DEALLOCATE(OutData%fprimeprime_c_minus1) - ALLOCATE(OutData%fprimeprime_c_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprimeprime_c_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%fprimeprime_c_minus1,2), UBOUND(OutData%fprimeprime_c_minus1,2) - DO i1 = LBOUND(OutData%fprimeprime_c_minus1,1), UBOUND(OutData%fprimeprime_c_minus1,1) - OutData%fprimeprime_c_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fprimeprime_m_minus1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%fprimeprime_m_minus1)) DEALLOCATE(OutData%fprimeprime_m_minus1) - ALLOCATE(OutData%fprimeprime_m_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprimeprime_m_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%fprimeprime_m_minus1,2), UBOUND(OutData%fprimeprime_m_minus1,2) - DO i1 = LBOUND(OutData%fprimeprime_m_minus1,1), UBOUND(OutData%fprimeprime_m_minus1,1) - OutData%fprimeprime_m_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Df_minus1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Df_minus1)) DEALLOCATE(OutData%Df_minus1) - ALLOCATE(OutData%Df_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Df_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Df_minus1,2), UBOUND(OutData%Df_minus1,2) - DO i1 = LBOUND(OutData%Df_minus1,1), UBOUND(OutData%Df_minus1,1) - OutData%Df_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Df_c_minus1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Df_c_minus1)) DEALLOCATE(OutData%Df_c_minus1) - ALLOCATE(OutData%Df_c_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Df_c_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Df_c_minus1,2), UBOUND(OutData%Df_c_minus1,2) - DO i1 = LBOUND(OutData%Df_c_minus1,1), UBOUND(OutData%Df_c_minus1,1) - OutData%Df_c_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Df_m_minus1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Df_m_minus1)) DEALLOCATE(OutData%Df_m_minus1) - ALLOCATE(OutData%Df_m_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Df_m_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Df_m_minus1,2), UBOUND(OutData%Df_m_minus1,2) - DO i1 = LBOUND(OutData%Df_m_minus1,1), UBOUND(OutData%Df_m_minus1,1) - OutData%Df_m_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Dalphaf_minus1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Dalphaf_minus1)) DEALLOCATE(OutData%Dalphaf_minus1) - ALLOCATE(OutData%Dalphaf_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dalphaf_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Dalphaf_minus1,2), UBOUND(OutData%Dalphaf_minus1,2) - DO i1 = LBOUND(OutData%Dalphaf_minus1,1), UBOUND(OutData%Dalphaf_minus1,1) - OutData%Dalphaf_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! alphaf_minus1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%alphaf_minus1)) DEALLOCATE(OutData%alphaf_minus1) - ALLOCATE(OutData%alphaf_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%alphaf_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%alphaf_minus1,2), UBOUND(OutData%alphaf_minus1,2) - DO i1 = LBOUND(OutData%alphaf_minus1,1), UBOUND(OutData%alphaf_minus1,1) - OutData%alphaf_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fprime_minus1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%fprime_minus1)) DEALLOCATE(OutData%fprime_minus1) - ALLOCATE(OutData%fprime_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprime_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%fprime_minus1,2), UBOUND(OutData%fprime_minus1,2) - DO i1 = LBOUND(OutData%fprime_minus1,1), UBOUND(OutData%fprime_minus1,1) - OutData%fprime_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fprime_c_minus1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%fprime_c_minus1)) DEALLOCATE(OutData%fprime_c_minus1) - ALLOCATE(OutData%fprime_c_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprime_c_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%fprime_c_minus1,2), UBOUND(OutData%fprime_c_minus1,2) - DO i1 = LBOUND(OutData%fprime_c_minus1,1), UBOUND(OutData%fprime_c_minus1,1) - OutData%fprime_c_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fprime_m_minus1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%fprime_m_minus1)) DEALLOCATE(OutData%fprime_m_minus1) - ALLOCATE(OutData%fprime_m_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprime_m_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%fprime_m_minus1,2), UBOUND(OutData%fprime_m_minus1,2) - DO i1 = LBOUND(OutData%fprime_m_minus1,1), UBOUND(OutData%fprime_m_minus1,1) - OutData%fprime_m_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! tau_V not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%tau_V)) DEALLOCATE(OutData%tau_V) - ALLOCATE(OutData%tau_V(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%tau_V.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%tau_V,2), UBOUND(OutData%tau_V,2) - DO i1 = LBOUND(OutData%tau_V,1), UBOUND(OutData%tau_V,1) - OutData%tau_V(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! tau_V_minus1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%tau_V_minus1)) DEALLOCATE(OutData%tau_V_minus1) - ALLOCATE(OutData%tau_V_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%tau_V_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%tau_V_minus1,2), UBOUND(OutData%tau_V_minus1,2) - DO i1 = LBOUND(OutData%tau_V_minus1,1), UBOUND(OutData%tau_V_minus1,1) - OutData%tau_V_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cn_v_minus1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Cn_v_minus1)) DEALLOCATE(OutData%Cn_v_minus1) - ALLOCATE(OutData%Cn_v_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cn_v_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Cn_v_minus1,2), UBOUND(OutData%Cn_v_minus1,2) - DO i1 = LBOUND(OutData%Cn_v_minus1,1), UBOUND(OutData%Cn_v_minus1,1) - OutData%Cn_v_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C_V_minus1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%C_V_minus1)) DEALLOCATE(OutData%C_V_minus1) - ALLOCATE(OutData%C_V_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C_V_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%C_V_minus1,2), UBOUND(OutData%C_V_minus1,2) - DO i1 = LBOUND(OutData%C_V_minus1,1), UBOUND(OutData%C_V_minus1,1) - OutData%C_V_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cn_prime_minus1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Cn_prime_minus1)) DEALLOCATE(OutData%Cn_prime_minus1) - ALLOCATE(OutData%Cn_prime_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cn_prime_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Cn_prime_minus1,2), UBOUND(OutData%Cn_prime_minus1,2) - DO i1 = LBOUND(OutData%Cn_prime_minus1,1), UBOUND(OutData%Cn_prime_minus1,1) - OutData%Cn_prime_minus1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE UA_UnPackDiscState - - SUBROUTINE UA_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(UA_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(UA_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstraintState = SrcConstrStateData%DummyConstraintState - END SUBROUTINE UA_CopyConstrState - - SUBROUTINE UA_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(UA_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE UA_DestroyConstrState - - SUBROUTINE UA_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(UA_ConstraintStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_PackConstrState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyConstraintState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyConstraintState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE UA_PackConstrState - - SUBROUTINE UA_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(UA_ConstraintStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_UnPackConstrState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyConstraintState = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE UA_UnPackConstrState - - SUBROUTINE UA_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(UA_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(UA_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOtherStateData%FirstPass)) THEN - i1_l = LBOUND(SrcOtherStateData%FirstPass,1) - i1_u = UBOUND(SrcOtherStateData%FirstPass,1) - i2_l = LBOUND(SrcOtherStateData%FirstPass,2) - i2_u = UBOUND(SrcOtherStateData%FirstPass,2) - IF (.NOT. ALLOCATED(DstOtherStateData%FirstPass)) THEN - ALLOCATE(DstOtherStateData%FirstPass(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%FirstPass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%FirstPass = SrcOtherStateData%FirstPass -ENDIF -IF (ALLOCATED(SrcOtherStateData%sigma1)) THEN - i1_l = LBOUND(SrcOtherStateData%sigma1,1) - i1_u = UBOUND(SrcOtherStateData%sigma1,1) - i2_l = LBOUND(SrcOtherStateData%sigma1,2) - i2_u = UBOUND(SrcOtherStateData%sigma1,2) - IF (.NOT. ALLOCATED(DstOtherStateData%sigma1)) THEN - ALLOCATE(DstOtherStateData%sigma1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%sigma1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%sigma1 = SrcOtherStateData%sigma1 -ENDIF -IF (ALLOCATED(SrcOtherStateData%sigma1c)) THEN - i1_l = LBOUND(SrcOtherStateData%sigma1c,1) - i1_u = UBOUND(SrcOtherStateData%sigma1c,1) - i2_l = LBOUND(SrcOtherStateData%sigma1c,2) - i2_u = UBOUND(SrcOtherStateData%sigma1c,2) - IF (.NOT. ALLOCATED(DstOtherStateData%sigma1c)) THEN - ALLOCATE(DstOtherStateData%sigma1c(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%sigma1c.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + DstOtherStateData%sigma1 = SrcOtherStateData%sigma1 +ENDIF +IF (ALLOCATED(SrcOtherStateData%sigma1c)) THEN + i1_l = LBOUND(SrcOtherStateData%sigma1c,1) + i1_u = UBOUND(SrcOtherStateData%sigma1c,1) + i2_l = LBOUND(SrcOtherStateData%sigma1c,2) + i2_u = UBOUND(SrcOtherStateData%sigma1c,2) + IF (.NOT. ALLOCATED(DstOtherStateData%sigma1c)) THEN + ALLOCATE(DstOtherStateData%sigma1c(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%sigma1c.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF DstOtherStateData%sigma1c = SrcOtherStateData%sigma1c ENDIF @@ -4514,818 +2862,325 @@ SUBROUTINE UA_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE UA_DestroyOtherState - SUBROUTINE UA_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(UA_OtherStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_PackOtherState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! FirstPass allocated yes/no - IF ( ALLOCATED(InData%FirstPass) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FirstPass upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%FirstPass) ! FirstPass - END IF - Int_BufSz = Int_BufSz + 1 ! sigma1 allocated yes/no - IF ( ALLOCATED(InData%sigma1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! sigma1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%sigma1) ! sigma1 - END IF - Int_BufSz = Int_BufSz + 1 ! sigma1c allocated yes/no - IF ( ALLOCATED(InData%sigma1c) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! sigma1c upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%sigma1c) ! sigma1c - END IF - Int_BufSz = Int_BufSz + 1 ! sigma1m allocated yes/no - IF ( ALLOCATED(InData%sigma1m) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! sigma1m upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%sigma1m) ! sigma1m - END IF - Int_BufSz = Int_BufSz + 1 ! sigma3 allocated yes/no - IF ( ALLOCATED(InData%sigma3) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! sigma3 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%sigma3) ! sigma3 - END IF - Int_BufSz = Int_BufSz + 1 ! n allocated yes/no - IF ( ALLOCATED(InData%n) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! n upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%n) ! n - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) - Int_BufSz = Int_BufSz + 3 ! xdot: size of buffers for each call to pack subtype - CALL UA_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xdot - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xdot - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xdot - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xdot - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 1 ! t_vortexBegin allocated yes/no - IF ( ALLOCATED(InData%t_vortexBegin) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! t_vortexBegin upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%t_vortexBegin) ! t_vortexBegin - END IF - Int_BufSz = Int_BufSz + 1 ! SignOfOmega allocated yes/no - IF ( ALLOCATED(InData%SignOfOmega) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! SignOfOmega upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SignOfOmega) ! SignOfOmega - END IF - Int_BufSz = Int_BufSz + 1 ! PositivePressure allocated yes/no - IF ( ALLOCATED(InData%PositivePressure) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PositivePressure upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%PositivePressure) ! PositivePressure - END IF - Int_BufSz = Int_BufSz + 1 ! vortexOn allocated yes/no - IF ( ALLOCATED(InData%vortexOn) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! vortexOn upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%vortexOn) ! vortexOn - END IF - Int_BufSz = Int_BufSz + 1 ! BelowThreshold allocated yes/no - IF ( ALLOCATED(InData%BelowThreshold) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BelowThreshold upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BelowThreshold) ! BelowThreshold - END IF - Int_BufSz = Int_BufSz + 1 ! activeL allocated yes/no - IF ( ALLOCATED(InData%activeL) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! activeL upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%activeL) ! activeL - END IF - Int_BufSz = Int_BufSz + 1 ! activeD allocated yes/no - IF ( ALLOCATED(InData%activeD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! activeD upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%activeD) ! activeD - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%FirstPass) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FirstPass,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FirstPass,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FirstPass,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FirstPass,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FirstPass,2), UBOUND(InData%FirstPass,2) - DO i1 = LBOUND(InData%FirstPass,1), UBOUND(InData%FirstPass,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstPass(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%sigma1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%sigma1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%sigma1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%sigma1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%sigma1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%sigma1,2), UBOUND(InData%sigma1,2) - DO i1 = LBOUND(InData%sigma1,1), UBOUND(InData%sigma1,1) - ReKiBuf(Re_Xferred) = InData%sigma1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%sigma1c) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%sigma1c,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%sigma1c,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%sigma1c,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%sigma1c,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%sigma1c,2), UBOUND(InData%sigma1c,2) - DO i1 = LBOUND(InData%sigma1c,1), UBOUND(InData%sigma1c,1) - ReKiBuf(Re_Xferred) = InData%sigma1c(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%sigma1m) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%sigma1m,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%sigma1m,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%sigma1m,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%sigma1m,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%sigma1m,2), UBOUND(InData%sigma1m,2) - DO i1 = LBOUND(InData%sigma1m,1), UBOUND(InData%sigma1m,1) - ReKiBuf(Re_Xferred) = InData%sigma1m(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%sigma3) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%sigma3,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%sigma3,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%sigma3,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%sigma3,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%sigma3,2), UBOUND(InData%sigma3,2) - DO i1 = LBOUND(InData%sigma3,1), UBOUND(InData%sigma3,1) - ReKiBuf(Re_Xferred) = InData%sigma3(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%n) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%n,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%n,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%n,2), UBOUND(InData%n,2) - DO i1 = LBOUND(InData%n,1), UBOUND(InData%n,1) - IntKiBuf(Int_Xferred) = InData%n(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) - CALL UA_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, OnlySize ) ! xdot - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - IF ( .NOT. ALLOCATED(InData%t_vortexBegin) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%t_vortexBegin,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%t_vortexBegin,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%t_vortexBegin,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%t_vortexBegin,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%t_vortexBegin,2), UBOUND(InData%t_vortexBegin,2) - DO i1 = LBOUND(InData%t_vortexBegin,1), UBOUND(InData%t_vortexBegin,1) - ReKiBuf(Re_Xferred) = InData%t_vortexBegin(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SignOfOmega) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SignOfOmega,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SignOfOmega,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SignOfOmega,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SignOfOmega,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%SignOfOmega,2), UBOUND(InData%SignOfOmega,2) - DO i1 = LBOUND(InData%SignOfOmega,1), UBOUND(InData%SignOfOmega,1) - ReKiBuf(Re_Xferred) = InData%SignOfOmega(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PositivePressure) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PositivePressure,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PositivePressure,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PositivePressure,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PositivePressure,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PositivePressure,2), UBOUND(InData%PositivePressure,2) - DO i1 = LBOUND(InData%PositivePressure,1), UBOUND(InData%PositivePressure,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%PositivePressure(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%vortexOn) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vortexOn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vortexOn,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vortexOn,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vortexOn,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%vortexOn,2), UBOUND(InData%vortexOn,2) - DO i1 = LBOUND(InData%vortexOn,1), UBOUND(InData%vortexOn,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%vortexOn(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BelowThreshold) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BelowThreshold,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BelowThreshold,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BelowThreshold,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BelowThreshold,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BelowThreshold,2), UBOUND(InData%BelowThreshold,2) - DO i1 = LBOUND(InData%BelowThreshold,1), UBOUND(InData%BelowThreshold,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%BelowThreshold(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%activeL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%activeL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%activeL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%activeL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%activeL,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%activeL,2), UBOUND(InData%activeL,2) - DO i1 = LBOUND(InData%activeL,1), UBOUND(InData%activeL,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%activeL(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%activeD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%activeD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%activeD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%activeD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%activeD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%activeD,2), UBOUND(InData%activeD,2) - DO i1 = LBOUND(InData%activeD,1), UBOUND(InData%activeD,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%activeD(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE UA_PackOtherState - - SUBROUTINE UA_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(UA_OtherStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_UnPackOtherState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FirstPass not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FirstPass)) DEALLOCATE(OutData%FirstPass) - ALLOCATE(OutData%FirstPass(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FirstPass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FirstPass,2), UBOUND(OutData%FirstPass,2) - DO i1 = LBOUND(OutData%FirstPass,1), UBOUND(OutData%FirstPass,1) - OutData%FirstPass(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstPass(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! sigma1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%sigma1)) DEALLOCATE(OutData%sigma1) - ALLOCATE(OutData%sigma1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%sigma1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%sigma1,2), UBOUND(OutData%sigma1,2) - DO i1 = LBOUND(OutData%sigma1,1), UBOUND(OutData%sigma1,1) - OutData%sigma1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! sigma1c not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%sigma1c)) DEALLOCATE(OutData%sigma1c) - ALLOCATE(OutData%sigma1c(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%sigma1c.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%sigma1c,2), UBOUND(OutData%sigma1c,2) - DO i1 = LBOUND(OutData%sigma1c,1), UBOUND(OutData%sigma1c,1) - OutData%sigma1c(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! sigma1m not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%sigma1m)) DEALLOCATE(OutData%sigma1m) - ALLOCATE(OutData%sigma1m(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%sigma1m.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%sigma1m,2), UBOUND(OutData%sigma1m,2) - DO i1 = LBOUND(OutData%sigma1m,1), UBOUND(OutData%sigma1m,1) - OutData%sigma1m(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! sigma3 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%sigma3)) DEALLOCATE(OutData%sigma3) - ALLOCATE(OutData%sigma3(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%sigma3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%sigma3,2), UBOUND(OutData%sigma3,2) - DO i1 = LBOUND(OutData%sigma3,1), UBOUND(OutData%sigma3,1) - OutData%sigma3(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! n not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%n)) DEALLOCATE(OutData%n) - ALLOCATE(OutData%n(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%n.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%n,2), UBOUND(OutData%n,2) - DO i1 = LBOUND(OutData%n,1), UBOUND(OutData%n,1) - OutData%n(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%xdot,1) - i1_u = UBOUND(OutData%xdot,1) - DO i1 = LBOUND(OutData%xdot,1), UBOUND(OutData%xdot,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL UA_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%xdot(i1), ErrStat2, ErrMsg2 ) ! xdot - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! t_vortexBegin not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%t_vortexBegin)) DEALLOCATE(OutData%t_vortexBegin) - ALLOCATE(OutData%t_vortexBegin(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%t_vortexBegin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%t_vortexBegin,2), UBOUND(OutData%t_vortexBegin,2) - DO i1 = LBOUND(OutData%t_vortexBegin,1), UBOUND(OutData%t_vortexBegin,1) - OutData%t_vortexBegin(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SignOfOmega not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SignOfOmega)) DEALLOCATE(OutData%SignOfOmega) - ALLOCATE(OutData%SignOfOmega(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SignOfOmega.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%SignOfOmega,2), UBOUND(OutData%SignOfOmega,2) - DO i1 = LBOUND(OutData%SignOfOmega,1), UBOUND(OutData%SignOfOmega,1) - OutData%SignOfOmega(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PositivePressure not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PositivePressure)) DEALLOCATE(OutData%PositivePressure) - ALLOCATE(OutData%PositivePressure(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PositivePressure.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PositivePressure,2), UBOUND(OutData%PositivePressure,2) - DO i1 = LBOUND(OutData%PositivePressure,1), UBOUND(OutData%PositivePressure,1) - OutData%PositivePressure(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%PositivePressure(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! vortexOn not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%vortexOn)) DEALLOCATE(OutData%vortexOn) - ALLOCATE(OutData%vortexOn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%vortexOn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%vortexOn,2), UBOUND(OutData%vortexOn,2) - DO i1 = LBOUND(OutData%vortexOn,1), UBOUND(OutData%vortexOn,1) - OutData%vortexOn(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%vortexOn(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BelowThreshold not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BelowThreshold)) DEALLOCATE(OutData%BelowThreshold) - ALLOCATE(OutData%BelowThreshold(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BelowThreshold.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BelowThreshold,2), UBOUND(OutData%BelowThreshold,2) - DO i1 = LBOUND(OutData%BelowThreshold,1), UBOUND(OutData%BelowThreshold,1) - OutData%BelowThreshold(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%BelowThreshold(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! activeL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%activeL)) DEALLOCATE(OutData%activeL) - ALLOCATE(OutData%activeL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%activeL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%activeL,2), UBOUND(OutData%activeL,2) - DO i1 = LBOUND(OutData%activeL,1), UBOUND(OutData%activeL,1) - OutData%activeL(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%activeL(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! activeD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%activeD)) DEALLOCATE(OutData%activeD) - ALLOCATE(OutData%activeD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%activeD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%activeD,2), UBOUND(OutData%activeD,2) - DO i1 = LBOUND(OutData%activeD,1), UBOUND(OutData%activeD,1) - OutData%activeD(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%activeD(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE UA_UnPackOtherState +subroutine UA_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(UA_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'UA_PackOtherState' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + ! FirstPass + call RegPack(Buf, allocated(InData%FirstPass)) + if (allocated(InData%FirstPass)) then + call RegPackBounds(Buf, 2, lbound(InData%FirstPass), ubound(InData%FirstPass)) + call RegPack(Buf, InData%FirstPass) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! sigma1 + call RegPack(Buf, allocated(InData%sigma1)) + if (allocated(InData%sigma1)) then + call RegPackBounds(Buf, 2, lbound(InData%sigma1), ubound(InData%sigma1)) + call RegPack(Buf, InData%sigma1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! sigma1c + call RegPack(Buf, allocated(InData%sigma1c)) + if (allocated(InData%sigma1c)) then + call RegPackBounds(Buf, 2, lbound(InData%sigma1c), ubound(InData%sigma1c)) + call RegPack(Buf, InData%sigma1c) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! sigma1m + call RegPack(Buf, allocated(InData%sigma1m)) + if (allocated(InData%sigma1m)) then + call RegPackBounds(Buf, 2, lbound(InData%sigma1m), ubound(InData%sigma1m)) + call RegPack(Buf, InData%sigma1m) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! sigma3 + call RegPack(Buf, allocated(InData%sigma3)) + if (allocated(InData%sigma3)) then + call RegPackBounds(Buf, 2, lbound(InData%sigma3), ubound(InData%sigma3)) + call RegPack(Buf, InData%sigma3) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! n + call RegPack(Buf, allocated(InData%n)) + if (allocated(InData%n)) then + call RegPackBounds(Buf, 2, lbound(InData%n), ubound(InData%n)) + call RegPack(Buf, InData%n) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! xdot + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) + do i1 = LB(1), UB(1) + call UA_PackContState(Buf, InData%xdot(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! t_vortexBegin + call RegPack(Buf, allocated(InData%t_vortexBegin)) + if (allocated(InData%t_vortexBegin)) then + call RegPackBounds(Buf, 2, lbound(InData%t_vortexBegin), ubound(InData%t_vortexBegin)) + call RegPack(Buf, InData%t_vortexBegin) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SignOfOmega + call RegPack(Buf, allocated(InData%SignOfOmega)) + if (allocated(InData%SignOfOmega)) then + call RegPackBounds(Buf, 2, lbound(InData%SignOfOmega), ubound(InData%SignOfOmega)) + call RegPack(Buf, InData%SignOfOmega) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PositivePressure + call RegPack(Buf, allocated(InData%PositivePressure)) + if (allocated(InData%PositivePressure)) then + call RegPackBounds(Buf, 2, lbound(InData%PositivePressure), ubound(InData%PositivePressure)) + call RegPack(Buf, InData%PositivePressure) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! vortexOn + call RegPack(Buf, allocated(InData%vortexOn)) + if (allocated(InData%vortexOn)) then + call RegPackBounds(Buf, 2, lbound(InData%vortexOn), ubound(InData%vortexOn)) + call RegPack(Buf, InData%vortexOn) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BelowThreshold + call RegPack(Buf, allocated(InData%BelowThreshold)) + if (allocated(InData%BelowThreshold)) then + call RegPackBounds(Buf, 2, lbound(InData%BelowThreshold), ubound(InData%BelowThreshold)) + call RegPack(Buf, InData%BelowThreshold) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! activeL + call RegPack(Buf, allocated(InData%activeL)) + if (allocated(InData%activeL)) then + call RegPackBounds(Buf, 2, lbound(InData%activeL), ubound(InData%activeL)) + call RegPack(Buf, InData%activeL) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! activeD + call RegPack(Buf, allocated(InData%activeD)) + if (allocated(InData%activeD)) then + call RegPackBounds(Buf, 2, lbound(InData%activeD), ubound(InData%activeD)) + call RegPack(Buf, InData%activeD) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine UA_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(UA_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'UA_UnPackOtherState' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! FirstPass + if (allocated(OutData%FirstPass)) deallocate(OutData%FirstPass) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FirstPass(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FirstPass.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FirstPass) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! sigma1 + if (allocated(OutData%sigma1)) deallocate(OutData%sigma1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%sigma1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%sigma1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%sigma1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! sigma1c + if (allocated(OutData%sigma1c)) deallocate(OutData%sigma1c) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%sigma1c(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%sigma1c.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%sigma1c) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! sigma1m + if (allocated(OutData%sigma1m)) deallocate(OutData%sigma1m) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%sigma1m(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%sigma1m.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%sigma1m) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! sigma3 + if (allocated(OutData%sigma3)) deallocate(OutData%sigma3) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%sigma3(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%sigma3.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%sigma3) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! n + if (allocated(OutData%n)) deallocate(OutData%n) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%n(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%n.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%n) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! xdot + LB(1:1) = lbound(OutData%xdot) + UB(1:1) = ubound(OutData%xdot) + do i1 = LB(1), UB(1) + call UA_UnpackContState(Buf, OutData%xdot(i1)) ! xdot + end do + ! t_vortexBegin + if (allocated(OutData%t_vortexBegin)) deallocate(OutData%t_vortexBegin) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%t_vortexBegin(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%t_vortexBegin.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%t_vortexBegin) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! SignOfOmega + if (allocated(OutData%SignOfOmega)) deallocate(OutData%SignOfOmega) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SignOfOmega(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SignOfOmega.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SignOfOmega) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PositivePressure + if (allocated(OutData%PositivePressure)) deallocate(OutData%PositivePressure) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PositivePressure(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PositivePressure.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PositivePressure) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! vortexOn + if (allocated(OutData%vortexOn)) deallocate(OutData%vortexOn) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%vortexOn(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%vortexOn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%vortexOn) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BelowThreshold + if (allocated(OutData%BelowThreshold)) deallocate(OutData%BelowThreshold) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BelowThreshold(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BelowThreshold.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BelowThreshold) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! activeL + if (allocated(OutData%activeL)) deallocate(OutData%activeL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%activeL(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%activeL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%activeL) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! activeD + if (allocated(OutData%activeD)) deallocate(OutData%activeD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%activeD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%activeD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%activeD) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE UA_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) TYPE(UA_MiscVarType), INTENT(IN) :: SrcMiscData TYPE(UA_MiscVarType), INTENT(INOUT) :: DstMiscData @@ -5464,403 +3319,173 @@ SUBROUTINE UA_DestroyMisc( MiscData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE UA_DestroyMisc - SUBROUTINE UA_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(UA_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! FirstWarn_M - Int_BufSz = Int_BufSz + 1 ! FirstWarn_UA - Int_BufSz = Int_BufSz + 1 ! FirstWarn_UA_off - Int_BufSz = Int_BufSz + 1 ! TESF allocated yes/no - IF ( ALLOCATED(InData%TESF) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TESF upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%TESF) ! TESF - END IF - Int_BufSz = Int_BufSz + 1 ! LESF allocated yes/no - IF ( ALLOCATED(InData%LESF) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! LESF upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LESF) ! LESF - END IF - Int_BufSz = Int_BufSz + 1 ! VRTX allocated yes/no - IF ( ALLOCATED(InData%VRTX) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! VRTX upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%VRTX) ! VRTX - END IF - Int_BufSz = Int_BufSz + 1 ! T_Sh allocated yes/no - IF ( ALLOCATED(InData%T_Sh) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! T_Sh upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%T_Sh) ! T_Sh - END IF - Int_BufSz = Int_BufSz + 1 ! BEDSEP allocated yes/no - IF ( ALLOCATED(InData%BEDSEP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BEDSEP upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BEDSEP) ! BEDSEP - END IF - Int_BufSz = Int_BufSz + 1 ! weight allocated yes/no - IF ( ALLOCATED(InData%weight) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! weight upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%weight) ! weight - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstWarn_M, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstWarn_UA, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstWarn_UA_off, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TESF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TESF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TESF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TESF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TESF,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TESF,2), UBOUND(InData%TESF,2) - DO i1 = LBOUND(InData%TESF,1), UBOUND(InData%TESF,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%TESF(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LESF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LESF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LESF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LESF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LESF,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%LESF,2), UBOUND(InData%LESF,2) - DO i1 = LBOUND(InData%LESF,1), UBOUND(InData%LESF,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%LESF(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%VRTX) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VRTX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VRTX,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VRTX,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VRTX,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%VRTX,2), UBOUND(InData%VRTX,2) - DO i1 = LBOUND(InData%VRTX,1), UBOUND(InData%VRTX,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%VRTX(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%T_Sh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%T_Sh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%T_Sh,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%T_Sh,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%T_Sh,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%T_Sh,2), UBOUND(InData%T_Sh,2) - DO i1 = LBOUND(InData%T_Sh,1), UBOUND(InData%T_Sh,1) - ReKiBuf(Re_Xferred) = InData%T_Sh(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BEDSEP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BEDSEP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BEDSEP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BEDSEP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BEDSEP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BEDSEP,2), UBOUND(InData%BEDSEP,2) - DO i1 = LBOUND(InData%BEDSEP,1), UBOUND(InData%BEDSEP,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%BEDSEP(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%weight) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%weight,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%weight,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%weight,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%weight,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%weight,2), UBOUND(InData%weight,2) - DO i1 = LBOUND(InData%weight,1), UBOUND(InData%weight,1) - ReKiBuf(Re_Xferred) = InData%weight(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE UA_PackMisc - - SUBROUTINE UA_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(UA_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%FirstWarn_M = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn_M) - Int_Xferred = Int_Xferred + 1 - OutData%FirstWarn_UA = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn_UA) - Int_Xferred = Int_Xferred + 1 - OutData%FirstWarn_UA_off = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn_UA_off) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TESF not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TESF)) DEALLOCATE(OutData%TESF) - ALLOCATE(OutData%TESF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TESF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TESF,2), UBOUND(OutData%TESF,2) - DO i1 = LBOUND(OutData%TESF,1), UBOUND(OutData%TESF,1) - OutData%TESF(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%TESF(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LESF not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LESF)) DEALLOCATE(OutData%LESF) - ALLOCATE(OutData%LESF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LESF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%LESF,2), UBOUND(OutData%LESF,2) - DO i1 = LBOUND(OutData%LESF,1), UBOUND(OutData%LESF,1) - OutData%LESF(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%LESF(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VRTX not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%VRTX)) DEALLOCATE(OutData%VRTX) - ALLOCATE(OutData%VRTX(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VRTX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%VRTX,2), UBOUND(OutData%VRTX,2) - DO i1 = LBOUND(OutData%VRTX,1), UBOUND(OutData%VRTX,1) - OutData%VRTX(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%VRTX(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! T_Sh not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%T_Sh)) DEALLOCATE(OutData%T_Sh) - ALLOCATE(OutData%T_Sh(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%T_Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%T_Sh,2), UBOUND(OutData%T_Sh,2) - DO i1 = LBOUND(OutData%T_Sh,1), UBOUND(OutData%T_Sh,1) - OutData%T_Sh(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BEDSEP not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BEDSEP)) DEALLOCATE(OutData%BEDSEP) - ALLOCATE(OutData%BEDSEP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BEDSEP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BEDSEP,2), UBOUND(OutData%BEDSEP,2) - DO i1 = LBOUND(OutData%BEDSEP,1), UBOUND(OutData%BEDSEP,1) - OutData%BEDSEP(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%BEDSEP(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! weight not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%weight)) DEALLOCATE(OutData%weight) - ALLOCATE(OutData%weight(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%weight.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%weight,2), UBOUND(OutData%weight,2) - DO i1 = LBOUND(OutData%weight,1), UBOUND(OutData%weight,1) - OutData%weight(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE UA_UnPackMisc +subroutine UA_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(UA_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'UA_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + ! FirstWarn_M + call RegPack(Buf, InData%FirstWarn_M) + if (RegCheckErr(Buf, RoutineName)) return + ! FirstWarn_UA + call RegPack(Buf, InData%FirstWarn_UA) + if (RegCheckErr(Buf, RoutineName)) return + ! FirstWarn_UA_off + call RegPack(Buf, InData%FirstWarn_UA_off) + if (RegCheckErr(Buf, RoutineName)) return + ! TESF + call RegPack(Buf, allocated(InData%TESF)) + if (allocated(InData%TESF)) then + call RegPackBounds(Buf, 2, lbound(InData%TESF), ubound(InData%TESF)) + call RegPack(Buf, InData%TESF) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LESF + call RegPack(Buf, allocated(InData%LESF)) + if (allocated(InData%LESF)) then + call RegPackBounds(Buf, 2, lbound(InData%LESF), ubound(InData%LESF)) + call RegPack(Buf, InData%LESF) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! VRTX + call RegPack(Buf, allocated(InData%VRTX)) + if (allocated(InData%VRTX)) then + call RegPackBounds(Buf, 2, lbound(InData%VRTX), ubound(InData%VRTX)) + call RegPack(Buf, InData%VRTX) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! T_Sh + call RegPack(Buf, allocated(InData%T_Sh)) + if (allocated(InData%T_Sh)) then + call RegPackBounds(Buf, 2, lbound(InData%T_Sh), ubound(InData%T_Sh)) + call RegPack(Buf, InData%T_Sh) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BEDSEP + call RegPack(Buf, allocated(InData%BEDSEP)) + if (allocated(InData%BEDSEP)) then + call RegPackBounds(Buf, 2, lbound(InData%BEDSEP), ubound(InData%BEDSEP)) + call RegPack(Buf, InData%BEDSEP) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! weight + call RegPack(Buf, allocated(InData%weight)) + if (allocated(InData%weight)) then + call RegPackBounds(Buf, 2, lbound(InData%weight), ubound(InData%weight)) + call RegPack(Buf, InData%weight) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine UA_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(UA_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'UA_UnPackMisc' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! FirstWarn_M + call RegUnpack(Buf, OutData%FirstWarn_M) + if (RegCheckErr(Buf, RoutineName)) return + ! FirstWarn_UA + call RegUnpack(Buf, OutData%FirstWarn_UA) + if (RegCheckErr(Buf, RoutineName)) return + ! FirstWarn_UA_off + call RegUnpack(Buf, OutData%FirstWarn_UA_off) + if (RegCheckErr(Buf, RoutineName)) return + ! TESF + if (allocated(OutData%TESF)) deallocate(OutData%TESF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TESF(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TESF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TESF) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LESF + if (allocated(OutData%LESF)) deallocate(OutData%LESF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LESF(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LESF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LESF) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! VRTX + if (allocated(OutData%VRTX)) deallocate(OutData%VRTX) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%VRTX(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VRTX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%VRTX) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! T_Sh + if (allocated(OutData%T_Sh)) deallocate(OutData%T_Sh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%T_Sh(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%T_Sh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%T_Sh) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BEDSEP + if (allocated(OutData%BEDSEP)) deallocate(OutData%BEDSEP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BEDSEP(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BEDSEP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BEDSEP) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! weight + if (allocated(OutData%weight)) deallocate(OutData%weight) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%weight(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%weight.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%weight) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE UA_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(UA_ParameterType), INTENT(IN) :: SrcParamData TYPE(UA_ParameterType), INTENT(INOUT) :: DstParamData @@ -5942,278 +3567,151 @@ SUBROUTINE UA_DestroyParam( ParamData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE UA_DestroyParam - SUBROUTINE UA_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(UA_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! dt - Int_BufSz = Int_BufSz + 1 ! c allocated yes/no - IF ( ALLOCATED(InData%c) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! c upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%c) ! c - END IF - Int_BufSz = Int_BufSz + 1 ! numBlades - Int_BufSz = Int_BufSz + 1 ! nNodesPerBlade - Int_BufSz = Int_BufSz + 1 ! UAMod - Int_BufSz = Int_BufSz + 1 ! Flookup - Re_BufSz = Re_BufSz + 1 ! a_s - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! OutSwtch - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt - Int_BufSz = Int_BufSz + 1*LEN(InData%OutSFmt) ! OutSFmt - Int_BufSz = Int_BufSz + 1*LEN(InData%Delim) ! Delim - Int_BufSz = Int_BufSz + 1 ! UnOutFile - Int_BufSz = Int_BufSz + 1 ! ShedEffect - Int_BufSz = Int_BufSz + 1 ! lin_nx - Int_BufSz = Int_BufSz + 1 ! UA_off_forGood allocated yes/no - IF ( ALLOCATED(InData%UA_off_forGood) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! UA_off_forGood upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%UA_off_forGood) ! UA_off_forGood - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%dt - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%c) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%c,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%c,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%c,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%c,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%c,2), UBOUND(InData%c,2) - DO i1 = LBOUND(InData%c,1), UBOUND(InData%c,1) - ReKiBuf(Re_Xferred) = InData%c(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%numBlades - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nNodesPerBlade - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UAMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Flookup, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%a_s - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%OutSwtch - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutSFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%UnOutFile - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%ShedEffect, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%lin_nx - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%UA_off_forGood) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UA_off_forGood,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UA_off_forGood,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UA_off_forGood,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UA_off_forGood,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%UA_off_forGood,2), UBOUND(InData%UA_off_forGood,2) - DO i1 = LBOUND(InData%UA_off_forGood,1), UBOUND(InData%UA_off_forGood,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%UA_off_forGood(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE UA_PackParam - - SUBROUTINE UA_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(UA_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%dt = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! c not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%c)) DEALLOCATE(OutData%c) - ALLOCATE(OutData%c(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%c.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%c,2), UBOUND(OutData%c,2) - DO i1 = LBOUND(OutData%c,1), UBOUND(OutData%c,1) - OutData%c(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%numBlades = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nNodesPerBlade = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UAMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Flookup = TRANSFER(IntKiBuf(Int_Xferred), OutData%Flookup) - Int_Xferred = Int_Xferred + 1 - OutData%a_s = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%OutSwtch = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutSFmt) - OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UnOutFile = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ShedEffect = TRANSFER(IntKiBuf(Int_Xferred), OutData%ShedEffect) - Int_Xferred = Int_Xferred + 1 - OutData%lin_nx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UA_off_forGood not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%UA_off_forGood)) DEALLOCATE(OutData%UA_off_forGood) - ALLOCATE(OutData%UA_off_forGood(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UA_off_forGood.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%UA_off_forGood,2), UBOUND(OutData%UA_off_forGood,2) - DO i1 = LBOUND(OutData%UA_off_forGood,1), UBOUND(OutData%UA_off_forGood,1) - OutData%UA_off_forGood(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%UA_off_forGood(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE UA_UnPackParam +subroutine UA_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(UA_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'UA_PackParam' + if (Buf%ErrStat >= AbortErrLev) return + ! dt + call RegPack(Buf, InData%dt) + if (RegCheckErr(Buf, RoutineName)) return + ! c + call RegPack(Buf, allocated(InData%c)) + if (allocated(InData%c)) then + call RegPackBounds(Buf, 2, lbound(InData%c), ubound(InData%c)) + call RegPack(Buf, InData%c) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! numBlades + call RegPack(Buf, InData%numBlades) + if (RegCheckErr(Buf, RoutineName)) return + ! nNodesPerBlade + call RegPack(Buf, InData%nNodesPerBlade) + if (RegCheckErr(Buf, RoutineName)) return + ! UAMod + call RegPack(Buf, InData%UAMod) + if (RegCheckErr(Buf, RoutineName)) return + ! Flookup + call RegPack(Buf, InData%Flookup) + if (RegCheckErr(Buf, RoutineName)) return + ! a_s + call RegPack(Buf, InData%a_s) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegPack(Buf, InData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! OutSwtch + call RegPack(Buf, InData%OutSwtch) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFmt + call RegPack(Buf, InData%OutFmt) + if (RegCheckErr(Buf, RoutineName)) return + ! OutSFmt + call RegPack(Buf, InData%OutSFmt) + if (RegCheckErr(Buf, RoutineName)) return + ! Delim + call RegPack(Buf, InData%Delim) + if (RegCheckErr(Buf, RoutineName)) return + ! UnOutFile + call RegPack(Buf, InData%UnOutFile) + if (RegCheckErr(Buf, RoutineName)) return + ! ShedEffect + call RegPack(Buf, InData%ShedEffect) + if (RegCheckErr(Buf, RoutineName)) return + ! lin_nx + call RegPack(Buf, InData%lin_nx) + if (RegCheckErr(Buf, RoutineName)) return + ! UA_off_forGood + call RegPack(Buf, allocated(InData%UA_off_forGood)) + if (allocated(InData%UA_off_forGood)) then + call RegPackBounds(Buf, 2, lbound(InData%UA_off_forGood), ubound(InData%UA_off_forGood)) + call RegPack(Buf, InData%UA_off_forGood) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine UA_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(UA_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'UA_UnPackParam' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! dt + call RegUnpack(Buf, OutData%dt) + if (RegCheckErr(Buf, RoutineName)) return + ! c + if (allocated(OutData%c)) deallocate(OutData%c) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%c(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%c.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%c) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! numBlades + call RegUnpack(Buf, OutData%numBlades) + if (RegCheckErr(Buf, RoutineName)) return + ! nNodesPerBlade + call RegUnpack(Buf, OutData%nNodesPerBlade) + if (RegCheckErr(Buf, RoutineName)) return + ! UAMod + call RegUnpack(Buf, OutData%UAMod) + if (RegCheckErr(Buf, RoutineName)) return + ! Flookup + call RegUnpack(Buf, OutData%Flookup) + if (RegCheckErr(Buf, RoutineName)) return + ! a_s + call RegUnpack(Buf, OutData%a_s) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! OutSwtch + call RegUnpack(Buf, OutData%OutSwtch) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFmt + call RegUnpack(Buf, OutData%OutFmt) + if (RegCheckErr(Buf, RoutineName)) return + ! OutSFmt + call RegUnpack(Buf, OutData%OutSFmt) + if (RegCheckErr(Buf, RoutineName)) return + ! Delim + call RegUnpack(Buf, OutData%Delim) + if (RegCheckErr(Buf, RoutineName)) return + ! UnOutFile + call RegUnpack(Buf, OutData%UnOutFile) + if (RegCheckErr(Buf, RoutineName)) return + ! ShedEffect + call RegUnpack(Buf, OutData%ShedEffect) + if (RegCheckErr(Buf, RoutineName)) return + ! lin_nx + call RegUnpack(Buf, OutData%lin_nx) + if (RegCheckErr(Buf, RoutineName)) return + ! UA_off_forGood + if (allocated(OutData%UA_off_forGood)) deallocate(OutData%UA_off_forGood) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%UA_off_forGood(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UA_off_forGood.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%UA_off_forGood) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE UA_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(UA_InputType), INTENT(IN) :: SrcInputData TYPE(UA_InputType), INTENT(INOUT) :: DstInputData @@ -6252,135 +3750,56 @@ SUBROUTINE UA_DestroyInput( InputData, ErrStat, ErrMsg ) END SUBROUTINE UA_DestroyInput - SUBROUTINE UA_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(UA_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! U - Re_BufSz = Re_BufSz + 1 ! alpha - Re_BufSz = Re_BufSz + 1 ! Re - Re_BufSz = Re_BufSz + 1 ! UserProp - Re_BufSz = Re_BufSz + SIZE(InData%v_ac) ! v_ac - Re_BufSz = Re_BufSz + 1 ! omega - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%U - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%alpha - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Re - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%UserProp - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%v_ac,1), UBOUND(InData%v_ac,1) - ReKiBuf(Re_Xferred) = InData%v_ac(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%omega - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE UA_PackInput - - SUBROUTINE UA_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(UA_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%U = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%alpha = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Re = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%UserProp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%v_ac,1) - i1_u = UBOUND(OutData%v_ac,1) - DO i1 = LBOUND(OutData%v_ac,1), UBOUND(OutData%v_ac,1) - OutData%v_ac(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%omega = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE UA_UnPackInput +subroutine UA_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(UA_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'UA_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + ! U + call RegPack(Buf, InData%U) + if (RegCheckErr(Buf, RoutineName)) return + ! alpha + call RegPack(Buf, InData%alpha) + if (RegCheckErr(Buf, RoutineName)) return + ! Re + call RegPack(Buf, InData%Re) + if (RegCheckErr(Buf, RoutineName)) return + ! UserProp + call RegPack(Buf, InData%UserProp) + if (RegCheckErr(Buf, RoutineName)) return + ! v_ac + call RegPack(Buf, InData%v_ac) + if (RegCheckErr(Buf, RoutineName)) return + ! omega + call RegPack(Buf, InData%omega) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine UA_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(UA_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'UA_UnPackInput' + if (Buf%ErrStat /= ErrID_None) return + ! U + call RegUnpack(Buf, OutData%U) + if (RegCheckErr(Buf, RoutineName)) return + ! alpha + call RegUnpack(Buf, OutData%alpha) + if (RegCheckErr(Buf, RoutineName)) return + ! Re + call RegUnpack(Buf, OutData%Re) + if (RegCheckErr(Buf, RoutineName)) return + ! UserProp + call RegUnpack(Buf, OutData%UserProp) + if (RegCheckErr(Buf, RoutineName)) return + ! v_ac + call RegUnpack(Buf, OutData%v_ac) + if (RegCheckErr(Buf, RoutineName)) return + ! omega + call RegUnpack(Buf, OutData%omega) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE UA_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(UA_OutputType), INTENT(IN) :: SrcOutputData TYPE(UA_OutputType), INTENT(INOUT) :: DstOutputData @@ -6433,162 +3852,75 @@ SUBROUTINE UA_DestroyOutput( OutputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE UA_DestroyOutput - SUBROUTINE UA_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(UA_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! Cn - Re_BufSz = Re_BufSz + 1 ! Cc - Re_BufSz = Re_BufSz + 1 ! Cm - Re_BufSz = Re_BufSz + 1 ! Cl - Re_BufSz = Re_BufSz + 1 ! Cd - Int_BufSz = Int_BufSz + 1 ! WriteOutput allocated yes/no - IF ( ALLOCATED(InData%WriteOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutput upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WriteOutput) ! WriteOutput - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%Cn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cm - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cl - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cd - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) - ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE UA_PackOutput - - SUBROUTINE UA_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(UA_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%Cn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cm = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutput)) DEALLOCATE(OutData%WriteOutput) - ALLOCATE(OutData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) - OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE UA_UnPackOutput +subroutine UA_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(UA_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'UA_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! Cn + call RegPack(Buf, InData%Cn) + if (RegCheckErr(Buf, RoutineName)) return + ! Cc + call RegPack(Buf, InData%Cc) + if (RegCheckErr(Buf, RoutineName)) return + ! Cm + call RegPack(Buf, InData%Cm) + if (RegCheckErr(Buf, RoutineName)) return + ! Cl + call RegPack(Buf, InData%Cl) + if (RegCheckErr(Buf, RoutineName)) return + ! Cd + call RegPack(Buf, InData%Cd) + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutput + call RegPack(Buf, allocated(InData%WriteOutput)) + if (allocated(InData%WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPack(Buf, InData%WriteOutput) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine UA_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(UA_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'UA_UnPackOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! Cn + call RegUnpack(Buf, OutData%Cn) + if (RegCheckErr(Buf, RoutineName)) return + ! Cc + call RegUnpack(Buf, OutData%Cc) + if (RegCheckErr(Buf, RoutineName)) return + ! Cm + call RegUnpack(Buf, OutData%Cm) + if (RegCheckErr(Buf, RoutineName)) return + ! Cl + call RegUnpack(Buf, OutData%Cl) + if (RegCheckErr(Buf, RoutineName)) return + ! Cd + call RegUnpack(Buf, OutData%Cd) + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutput + if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE UA_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) ! diff --git a/modules/aerodyn14/src/AeroDyn14_Types.f90 b/modules/aerodyn14/src/AeroDyn14_Types.f90 index 2375d35c70..2a56e15b49 100644 --- a/modules/aerodyn14/src/AeroDyn14_Types.f90 +++ b/modules/aerodyn14/src/AeroDyn14_Types.f90 @@ -507,150 +507,44 @@ SUBROUTINE AD14_DestroyMarker( MarkerData, ErrStat, ErrMsg ) END SUBROUTINE AD14_DestroyMarker - SUBROUTINE AD14_PackMarker( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Marker), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_PackMarker' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + SIZE(InData%Position) ! Position - Re_BufSz = Re_BufSz + SIZE(InData%Orientation) ! Orientation - Re_BufSz = Re_BufSz + SIZE(InData%TranslationVel) ! TranslationVel - Re_BufSz = Re_BufSz + SIZE(InData%RotationVel) ! RotationVel - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i1 = LBOUND(InData%Position,1), UBOUND(InData%Position,1) - ReKiBuf(Re_Xferred) = InData%Position(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i2 = LBOUND(InData%Orientation,2), UBOUND(InData%Orientation,2) - DO i1 = LBOUND(InData%Orientation,1), UBOUND(InData%Orientation,1) - ReKiBuf(Re_Xferred) = InData%Orientation(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i1 = LBOUND(InData%TranslationVel,1), UBOUND(InData%TranslationVel,1) - ReKiBuf(Re_Xferred) = InData%TranslationVel(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%RotationVel,1), UBOUND(InData%RotationVel,1) - ReKiBuf(Re_Xferred) = InData%RotationVel(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE AD14_PackMarker - - SUBROUTINE AD14_UnPackMarker( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Marker), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackMarker' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%Position,1) - i1_u = UBOUND(OutData%Position,1) - DO i1 = LBOUND(OutData%Position,1), UBOUND(OutData%Position,1) - OutData%Position(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%Orientation,1) - i1_u = UBOUND(OutData%Orientation,1) - i2_l = LBOUND(OutData%Orientation,2) - i2_u = UBOUND(OutData%Orientation,2) - DO i2 = LBOUND(OutData%Orientation,2), UBOUND(OutData%Orientation,2) - DO i1 = LBOUND(OutData%Orientation,1), UBOUND(OutData%Orientation,1) - OutData%Orientation(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%TranslationVel,1) - i1_u = UBOUND(OutData%TranslationVel,1) - DO i1 = LBOUND(OutData%TranslationVel,1), UBOUND(OutData%TranslationVel,1) - OutData%TranslationVel(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%RotationVel,1) - i1_u = UBOUND(OutData%RotationVel,1) - DO i1 = LBOUND(OutData%RotationVel,1), UBOUND(OutData%RotationVel,1) - OutData%RotationVel(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE AD14_UnPackMarker +subroutine AD14_PackMarker(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Marker), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackMarker' + if (Buf%ErrStat >= AbortErrLev) return + ! Position + call RegPack(Buf, InData%Position) + if (RegCheckErr(Buf, RoutineName)) return + ! Orientation + call RegPack(Buf, InData%Orientation) + if (RegCheckErr(Buf, RoutineName)) return + ! TranslationVel + call RegPack(Buf, InData%TranslationVel) + if (RegCheckErr(Buf, RoutineName)) return + ! RotationVel + call RegPack(Buf, InData%RotationVel) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackMarker(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Marker), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackMarker' + if (Buf%ErrStat /= ErrID_None) return + ! Position + call RegUnpack(Buf, OutData%Position) + if (RegCheckErr(Buf, RoutineName)) return + ! Orientation + call RegUnpack(Buf, OutData%Orientation) + if (RegCheckErr(Buf, RoutineName)) return + ! TranslationVel + call RegUnpack(Buf, OutData%TranslationVel) + if (RegCheckErr(Buf, RoutineName)) return + ! RotationVel + call RegUnpack(Buf, OutData%RotationVel) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE AD14_CopyAeroConfig( SrcAeroConfigData, DstAeroConfigData, CtrlCode, ErrStat, ErrMsg ) TYPE(AeroConfig), INTENT(IN) :: SrcAeroConfigData TYPE(AeroConfig), INTENT(INOUT) :: DstAeroConfigData @@ -742,820 +636,94 @@ SUBROUTINE AD14_DestroyAeroConfig( AeroConfigData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AD14_DestroyAeroConfig - SUBROUTINE AD14_PackAeroConfig( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AeroConfig), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_PackAeroConfig' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! Blade allocated yes/no - IF ( ALLOCATED(InData%Blade) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Blade upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%Blade,1), UBOUND(InData%Blade,1) - Int_BufSz = Int_BufSz + 3 ! Blade: size of buffers for each call to pack subtype - CALL AD14_PackMarker( Re_Buf, Db_Buf, Int_Buf, InData%Blade(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Blade - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Blade - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Blade - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Blade - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! Hub: size of buffers for each call to pack subtype - CALL AD14_PackMarker( Re_Buf, Db_Buf, Int_Buf, InData%Hub, ErrStat2, ErrMsg2, .TRUE. ) ! Hub - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Hub - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Hub - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Hub - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! RotorFurl: size of buffers for each call to pack subtype - CALL AD14_PackMarker( Re_Buf, Db_Buf, Int_Buf, InData%RotorFurl, ErrStat2, ErrMsg2, .TRUE. ) ! RotorFurl - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! RotorFurl - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! RotorFurl - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! RotorFurl - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Nacelle: size of buffers for each call to pack subtype - CALL AD14_PackMarker( Re_Buf, Db_Buf, Int_Buf, InData%Nacelle, ErrStat2, ErrMsg2, .TRUE. ) ! Nacelle - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Nacelle - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Nacelle - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Nacelle - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! TailFin: size of buffers for each call to pack subtype - CALL AD14_PackMarker( Re_Buf, Db_Buf, Int_Buf, InData%TailFin, ErrStat2, ErrMsg2, .TRUE. ) ! TailFin - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TailFin - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TailFin - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TailFin - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Tower: size of buffers for each call to pack subtype - CALL AD14_PackMarker( Re_Buf, Db_Buf, Int_Buf, InData%Tower, ErrStat2, ErrMsg2, .TRUE. ) ! Tower - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Tower - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Tower - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Tower - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SubStructure: size of buffers for each call to pack subtype - CALL AD14_PackMarker( Re_Buf, Db_Buf, Int_Buf, InData%SubStructure, ErrStat2, ErrMsg2, .TRUE. ) ! SubStructure - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SubStructure - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SubStructure - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SubStructure - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Foundation: size of buffers for each call to pack subtype - CALL AD14_PackMarker( Re_Buf, Db_Buf, Int_Buf, InData%Foundation, ErrStat2, ErrMsg2, .TRUE. ) ! Foundation - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Foundation - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Foundation - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Foundation - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Re_BufSz = Re_BufSz + 1 ! BladeLength - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%Blade) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Blade,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Blade,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Blade,1), UBOUND(InData%Blade,1) - CALL AD14_PackMarker( Re_Buf, Db_Buf, Int_Buf, InData%Blade(i1), ErrStat2, ErrMsg2, OnlySize ) ! Blade - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL AD14_PackMarker( Re_Buf, Db_Buf, Int_Buf, InData%Hub, ErrStat2, ErrMsg2, OnlySize ) ! Hub - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD14_PackMarker( Re_Buf, Db_Buf, Int_Buf, InData%RotorFurl, ErrStat2, ErrMsg2, OnlySize ) ! RotorFurl - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD14_PackMarker( Re_Buf, Db_Buf, Int_Buf, InData%Nacelle, ErrStat2, ErrMsg2, OnlySize ) ! Nacelle - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD14_PackMarker( Re_Buf, Db_Buf, Int_Buf, InData%TailFin, ErrStat2, ErrMsg2, OnlySize ) ! TailFin - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD14_PackMarker( Re_Buf, Db_Buf, Int_Buf, InData%Tower, ErrStat2, ErrMsg2, OnlySize ) ! Tower - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD14_PackMarker( Re_Buf, Db_Buf, Int_Buf, InData%SubStructure, ErrStat2, ErrMsg2, OnlySize ) ! SubStructure - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD14_PackMarker( Re_Buf, Db_Buf, Int_Buf, InData%Foundation, ErrStat2, ErrMsg2, OnlySize ) ! Foundation - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - ReKiBuf(Re_Xferred) = InData%BladeLength - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_PackAeroConfig - - SUBROUTINE AD14_UnPackAeroConfig( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AeroConfig), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackAeroConfig' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Blade not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Blade)) DEALLOCATE(OutData%Blade) - ALLOCATE(OutData%Blade(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Blade.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Blade,1), UBOUND(OutData%Blade,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD14_UnpackMarker( Re_Buf, Db_Buf, Int_Buf, OutData%Blade(i1), ErrStat2, ErrMsg2 ) ! Blade - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD14_UnpackMarker( Re_Buf, Db_Buf, Int_Buf, OutData%Hub, ErrStat2, ErrMsg2 ) ! Hub - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD14_UnpackMarker( Re_Buf, Db_Buf, Int_Buf, OutData%RotorFurl, ErrStat2, ErrMsg2 ) ! RotorFurl - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD14_UnpackMarker( Re_Buf, Db_Buf, Int_Buf, OutData%Nacelle, ErrStat2, ErrMsg2 ) ! Nacelle - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD14_UnpackMarker( Re_Buf, Db_Buf, Int_Buf, OutData%TailFin, ErrStat2, ErrMsg2 ) ! TailFin - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD14_UnpackMarker( Re_Buf, Db_Buf, Int_Buf, OutData%Tower, ErrStat2, ErrMsg2 ) ! Tower - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD14_UnpackMarker( Re_Buf, Db_Buf, Int_Buf, OutData%SubStructure, ErrStat2, ErrMsg2 ) ! SubStructure - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD14_UnpackMarker( Re_Buf, Db_Buf, Int_Buf, OutData%Foundation, ErrStat2, ErrMsg2 ) ! Foundation - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%BladeLength = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_UnPackAeroConfig +subroutine AD14_PackAeroConfig(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AeroConfig), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackAeroConfig' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! Blade + call RegPack(Buf, allocated(InData%Blade)) + if (allocated(InData%Blade)) then + call RegPackBounds(Buf, 1, lbound(InData%Blade), ubound(InData%Blade)) + LB(1:1) = lbound(InData%Blade) + UB(1:1) = ubound(InData%Blade) + do i1 = LB(1), UB(1) + call AD14_PackMarker(Buf, InData%Blade(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Hub + call AD14_PackMarker(Buf, InData%Hub) + if (RegCheckErr(Buf, RoutineName)) return + ! RotorFurl + call AD14_PackMarker(Buf, InData%RotorFurl) + if (RegCheckErr(Buf, RoutineName)) return + ! Nacelle + call AD14_PackMarker(Buf, InData%Nacelle) + if (RegCheckErr(Buf, RoutineName)) return + ! TailFin + call AD14_PackMarker(Buf, InData%TailFin) + if (RegCheckErr(Buf, RoutineName)) return + ! Tower + call AD14_PackMarker(Buf, InData%Tower) + if (RegCheckErr(Buf, RoutineName)) return + ! SubStructure + call AD14_PackMarker(Buf, InData%SubStructure) + if (RegCheckErr(Buf, RoutineName)) return + ! Foundation + call AD14_PackMarker(Buf, InData%Foundation) + if (RegCheckErr(Buf, RoutineName)) return + ! BladeLength + call RegPack(Buf, InData%BladeLength) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackAeroConfig(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AeroConfig), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackAeroConfig' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! Blade + if (allocated(OutData%Blade)) deallocate(OutData%Blade) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Blade(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Blade.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD14_UnpackMarker(Buf, OutData%Blade(i1)) ! Blade + end do + end if + ! Hub + call AD14_UnpackMarker(Buf, OutData%Hub) ! Hub + ! RotorFurl + call AD14_UnpackMarker(Buf, OutData%RotorFurl) ! RotorFurl + ! Nacelle + call AD14_UnpackMarker(Buf, OutData%Nacelle) ! Nacelle + ! TailFin + call AD14_UnpackMarker(Buf, OutData%TailFin) ! TailFin + ! Tower + call AD14_UnpackMarker(Buf, OutData%Tower) ! Tower + ! SubStructure + call AD14_UnpackMarker(Buf, OutData%SubStructure) ! SubStructure + ! Foundation + call AD14_UnpackMarker(Buf, OutData%Foundation) ! Foundation + ! BladeLength + call RegUnpack(Buf, OutData%BladeLength) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE AD14_CopyAirFoil( SrcAirFoilData, DstAirFoilData, CtrlCode, ErrStat, ErrMsg ) TYPE(AirFoil), INTENT(IN) :: SrcAirFoilData TYPE(AirFoil), INTENT(INOUT) :: DstAirFoilData @@ -1666,333 +834,123 @@ SUBROUTINE AD14_DestroyAirFoil( AirFoilData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE AD14_DestroyAirFoil - SUBROUTINE AD14_PackAirFoil( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AirFoil), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_PackAirFoil' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! AL allocated yes/no - IF ( ALLOCATED(InData%AL) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AL) ! AL - END IF - Int_BufSz = Int_BufSz + 1 ! CD allocated yes/no - IF ( ALLOCATED(InData%CD) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! CD upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CD) ! CD - END IF - Int_BufSz = Int_BufSz + 1 ! CL allocated yes/no - IF ( ALLOCATED(InData%CL) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! CL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CL) ! CL - END IF - Int_BufSz = Int_BufSz + 1 ! CM allocated yes/no - IF ( ALLOCATED(InData%CM) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! CM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CM) ! CM - END IF - Re_BufSz = Re_BufSz + 1 ! PMC - Re_BufSz = Re_BufSz + 1 ! MulTabLoc - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%AL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AL,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AL,2), UBOUND(InData%AL,2) - DO i1 = LBOUND(InData%AL,1), UBOUND(InData%AL,1) - ReKiBuf(Re_Xferred) = InData%AL(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CD,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CD,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CD,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%CD,3), UBOUND(InData%CD,3) - DO i2 = LBOUND(InData%CD,2), UBOUND(InData%CD,2) - DO i1 = LBOUND(InData%CD,1), UBOUND(InData%CD,1) - ReKiBuf(Re_Xferred) = InData%CD(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CL,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CL,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CL,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%CL,3), UBOUND(InData%CL,3) - DO i2 = LBOUND(InData%CL,2), UBOUND(InData%CL,2) - DO i1 = LBOUND(InData%CL,1), UBOUND(InData%CL,1) - ReKiBuf(Re_Xferred) = InData%CL(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CM,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CM,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CM,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%CM,3), UBOUND(InData%CM,3) - DO i2 = LBOUND(InData%CM,2), UBOUND(InData%CM,2) - DO i1 = LBOUND(InData%CM,1), UBOUND(InData%CM,1) - ReKiBuf(Re_Xferred) = InData%CM(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%PMC - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MulTabLoc - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_PackAirFoil - - SUBROUTINE AD14_UnPackAirFoil( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AirFoil), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackAirFoil' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AL)) DEALLOCATE(OutData%AL) - ALLOCATE(OutData%AL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AL,2), UBOUND(OutData%AL,2) - DO i1 = LBOUND(OutData%AL,1), UBOUND(OutData%AL,1) - OutData%AL(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CD)) DEALLOCATE(OutData%CD) - ALLOCATE(OutData%CD(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%CD,3), UBOUND(OutData%CD,3) - DO i2 = LBOUND(OutData%CD,2), UBOUND(OutData%CD,2) - DO i1 = LBOUND(OutData%CD,1), UBOUND(OutData%CD,1) - OutData%CD(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CL)) DEALLOCATE(OutData%CL) - ALLOCATE(OutData%CL(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%CL,3), UBOUND(OutData%CL,3) - DO i2 = LBOUND(OutData%CL,2), UBOUND(OutData%CL,2) - DO i1 = LBOUND(OutData%CL,1), UBOUND(OutData%CL,1) - OutData%CL(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CM not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CM)) DEALLOCATE(OutData%CM) - ALLOCATE(OutData%CM(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%CM,3), UBOUND(OutData%CM,3) - DO i2 = LBOUND(OutData%CM,2), UBOUND(OutData%CM,2) - DO i1 = LBOUND(OutData%CM,1), UBOUND(OutData%CM,1) - OutData%CM(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%PMC = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MulTabLoc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_UnPackAirFoil +subroutine AD14_PackAirFoil(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AirFoil), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackAirFoil' + if (Buf%ErrStat >= AbortErrLev) return + ! AL + call RegPack(Buf, allocated(InData%AL)) + if (allocated(InData%AL)) then + call RegPackBounds(Buf, 2, lbound(InData%AL), ubound(InData%AL)) + call RegPack(Buf, InData%AL) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CD + call RegPack(Buf, allocated(InData%CD)) + if (allocated(InData%CD)) then + call RegPackBounds(Buf, 3, lbound(InData%CD), ubound(InData%CD)) + call RegPack(Buf, InData%CD) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CL + call RegPack(Buf, allocated(InData%CL)) + if (allocated(InData%CL)) then + call RegPackBounds(Buf, 3, lbound(InData%CL), ubound(InData%CL)) + call RegPack(Buf, InData%CL) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CM + call RegPack(Buf, allocated(InData%CM)) + if (allocated(InData%CM)) then + call RegPackBounds(Buf, 3, lbound(InData%CM), ubound(InData%CM)) + call RegPack(Buf, InData%CM) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PMC + call RegPack(Buf, InData%PMC) + if (RegCheckErr(Buf, RoutineName)) return + ! MulTabLoc + call RegPack(Buf, InData%MulTabLoc) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackAirFoil(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AirFoil), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackAirFoil' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! AL + if (allocated(OutData%AL)) deallocate(OutData%AL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AL(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AL) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CD + if (allocated(OutData%CD)) deallocate(OutData%CD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CD(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CD) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CL + if (allocated(OutData%CL)) deallocate(OutData%CL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CL) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CM + if (allocated(OutData%CM)) deallocate(OutData%CM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CM) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PMC + call RegUnpack(Buf, OutData%PMC) + if (RegCheckErr(Buf, RoutineName)) return + ! MulTabLoc + call RegUnpack(Buf, OutData%MulTabLoc) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE AD14_CopyAirFoilParms( SrcAirFoilParmsData, DstAirFoilParmsData, CtrlCode, ErrStat, ErrMsg ) TYPE(AirFoilParms), INTENT(IN) :: SrcAirFoilParmsData TYPE(AirFoilParms), INTENT(INOUT) :: DstAirFoilParmsData @@ -2106,319 +1064,151 @@ SUBROUTINE AD14_DestroyAirFoilParms( AirFoilParmsData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE AD14_DestroyAirFoilParms - SUBROUTINE AD14_PackAirFoilParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AirFoilParms), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_PackAirFoilParms' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! MaxTable - Int_BufSz = Int_BufSz + 1 ! NTables allocated yes/no - IF ( ALLOCATED(InData%NTables) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NTables upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NTables) ! NTables - END IF - Int_BufSz = Int_BufSz + 1 ! NLift allocated yes/no - IF ( ALLOCATED(InData%NLift) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NLift upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NLift) ! NLift - END IF - Int_BufSz = Int_BufSz + 1 ! NumCL - Int_BufSz = Int_BufSz + 1 ! NumFoil - Int_BufSz = Int_BufSz + 1 ! NFoil allocated yes/no - IF ( ALLOCATED(InData%NFoil) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NFoil upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NFoil) ! NFoil - END IF - Int_BufSz = Int_BufSz + 1 ! MulTabMet allocated yes/no - IF ( ALLOCATED(InData%MulTabMet) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MulTabMet upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MulTabMet) ! MulTabMet - END IF - Int_BufSz = Int_BufSz + 1 ! FoilNm allocated yes/no - IF ( ALLOCATED(InData%FoilNm) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FoilNm upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%FoilNm)*LEN(InData%FoilNm) ! FoilNm - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%MaxTable - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%NTables) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NTables,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NTables,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NTables,1), UBOUND(InData%NTables,1) - IntKiBuf(Int_Xferred) = InData%NTables(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NLift) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NLift,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NLift,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NLift,1), UBOUND(InData%NLift,1) - IntKiBuf(Int_Xferred) = InData%NLift(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NumCL - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumFoil - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%NFoil) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NFoil,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NFoil,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NFoil,1), UBOUND(InData%NFoil,1) - IntKiBuf(Int_Xferred) = InData%NFoil(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MulTabMet) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MulTabMet,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MulTabMet,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MulTabMet,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MulTabMet,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MulTabMet,2), UBOUND(InData%MulTabMet,2) - DO i1 = LBOUND(InData%MulTabMet,1), UBOUND(InData%MulTabMet,1) - ReKiBuf(Re_Xferred) = InData%MulTabMet(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FoilNm) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FoilNm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FoilNm,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FoilNm,1), UBOUND(InData%FoilNm,1) - DO I = 1, LEN(InData%FoilNm) - IntKiBuf(Int_Xferred) = ICHAR(InData%FoilNm(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - END SUBROUTINE AD14_PackAirFoilParms - - SUBROUTINE AD14_UnPackAirFoilParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AirFoilParms), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackAirFoilParms' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%MaxTable = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NTables not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NTables)) DEALLOCATE(OutData%NTables) - ALLOCATE(OutData%NTables(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NTables.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NTables,1), UBOUND(OutData%NTables,1) - OutData%NTables(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NLift not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NLift)) DEALLOCATE(OutData%NLift) - ALLOCATE(OutData%NLift(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NLift.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NLift,1), UBOUND(OutData%NLift,1) - OutData%NLift(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%NumCL = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumFoil = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NFoil not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NFoil)) DEALLOCATE(OutData%NFoil) - ALLOCATE(OutData%NFoil(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NFoil.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NFoil,1), UBOUND(OutData%NFoil,1) - OutData%NFoil(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MulTabMet not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MulTabMet)) DEALLOCATE(OutData%MulTabMet) - ALLOCATE(OutData%MulTabMet(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MulTabMet.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MulTabMet,2), UBOUND(OutData%MulTabMet,2) - DO i1 = LBOUND(OutData%MulTabMet,1), UBOUND(OutData%MulTabMet,1) - OutData%MulTabMet(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FoilNm not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FoilNm)) DEALLOCATE(OutData%FoilNm) - ALLOCATE(OutData%FoilNm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FoilNm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FoilNm,1), UBOUND(OutData%FoilNm,1) - DO I = 1, LEN(OutData%FoilNm) - OutData%FoilNm(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - END SUBROUTINE AD14_UnPackAirFoilParms +subroutine AD14_PackAirFoilParms(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AirFoilParms), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackAirFoilParms' + if (Buf%ErrStat >= AbortErrLev) return + ! MaxTable + call RegPack(Buf, InData%MaxTable) + if (RegCheckErr(Buf, RoutineName)) return + ! NTables + call RegPack(Buf, allocated(InData%NTables)) + if (allocated(InData%NTables)) then + call RegPackBounds(Buf, 1, lbound(InData%NTables), ubound(InData%NTables)) + call RegPack(Buf, InData%NTables) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NLift + call RegPack(Buf, allocated(InData%NLift)) + if (allocated(InData%NLift)) then + call RegPackBounds(Buf, 1, lbound(InData%NLift), ubound(InData%NLift)) + call RegPack(Buf, InData%NLift) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NumCL + call RegPack(Buf, InData%NumCL) + if (RegCheckErr(Buf, RoutineName)) return + ! NumFoil + call RegPack(Buf, InData%NumFoil) + if (RegCheckErr(Buf, RoutineName)) return + ! NFoil + call RegPack(Buf, allocated(InData%NFoil)) + if (allocated(InData%NFoil)) then + call RegPackBounds(Buf, 1, lbound(InData%NFoil), ubound(InData%NFoil)) + call RegPack(Buf, InData%NFoil) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MulTabMet + call RegPack(Buf, allocated(InData%MulTabMet)) + if (allocated(InData%MulTabMet)) then + call RegPackBounds(Buf, 2, lbound(InData%MulTabMet), ubound(InData%MulTabMet)) + call RegPack(Buf, InData%MulTabMet) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FoilNm + call RegPack(Buf, allocated(InData%FoilNm)) + if (allocated(InData%FoilNm)) then + call RegPackBounds(Buf, 1, lbound(InData%FoilNm), ubound(InData%FoilNm)) + call RegPack(Buf, InData%FoilNm) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackAirFoilParms(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AirFoilParms), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackAirFoilParms' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! MaxTable + call RegUnpack(Buf, OutData%MaxTable) + if (RegCheckErr(Buf, RoutineName)) return + ! NTables + if (allocated(OutData%NTables)) deallocate(OutData%NTables) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NTables(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NTables.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%NTables) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NLift + if (allocated(OutData%NLift)) deallocate(OutData%NLift) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NLift(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NLift.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%NLift) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NumCL + call RegUnpack(Buf, OutData%NumCL) + if (RegCheckErr(Buf, RoutineName)) return + ! NumFoil + call RegUnpack(Buf, OutData%NumFoil) + if (RegCheckErr(Buf, RoutineName)) return + ! NFoil + if (allocated(OutData%NFoil)) deallocate(OutData%NFoil) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NFoil(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NFoil.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%NFoil) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! MulTabMet + if (allocated(OutData%MulTabMet)) deallocate(OutData%MulTabMet) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MulTabMet(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MulTabMet.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MulTabMet) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! FoilNm + if (allocated(OutData%FoilNm)) deallocate(OutData%FoilNm) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FoilNm(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FoilNm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FoilNm) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE AD14_CopyBeddoes( SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, ErrMsg ) TYPE(Beddoes), INTENT(IN) :: SrcBeddoesData TYPE(Beddoes), INTENT(INOUT) :: DstBeddoesData @@ -3354,2835 +2144,1325 @@ SUBROUTINE AD14_DestroyBeddoes( BeddoesData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE AD14_DestroyBeddoes - SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Beddoes), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + +subroutine AD14_PackBeddoes(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Beddoes), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackBeddoes' + if (Buf%ErrStat >= AbortErrLev) return + ! ADOT + call RegPack(Buf, allocated(InData%ADOT)) + if (allocated(InData%ADOT)) then + call RegPackBounds(Buf, 2, lbound(InData%ADOT), ubound(InData%ADOT)) + call RegPack(Buf, InData%ADOT) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ADOT1 + call RegPack(Buf, allocated(InData%ADOT1)) + if (allocated(InData%ADOT1)) then + call RegPackBounds(Buf, 2, lbound(InData%ADOT1), ubound(InData%ADOT1)) + call RegPack(Buf, InData%ADOT1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AFE + call RegPack(Buf, allocated(InData%AFE)) + if (allocated(InData%AFE)) then + call RegPackBounds(Buf, 2, lbound(InData%AFE), ubound(InData%AFE)) + call RegPack(Buf, InData%AFE) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AFE1 + call RegPack(Buf, allocated(InData%AFE1)) + if (allocated(InData%AFE1)) then + call RegPackBounds(Buf, 2, lbound(InData%AFE1), ubound(InData%AFE1)) + call RegPack(Buf, InData%AFE1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AN + call RegPack(Buf, InData%AN) + if (RegCheckErr(Buf, RoutineName)) return + ! ANE + call RegPack(Buf, allocated(InData%ANE)) + if (allocated(InData%ANE)) then + call RegPackBounds(Buf, 2, lbound(InData%ANE), ubound(InData%ANE)) + call RegPack(Buf, InData%ANE) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ANE1 + call RegPack(Buf, allocated(InData%ANE1)) + if (allocated(InData%ANE1)) then + call RegPackBounds(Buf, 2, lbound(InData%ANE1), ubound(InData%ANE1)) + call RegPack(Buf, InData%ANE1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AOD + call RegPack(Buf, allocated(InData%AOD)) + if (allocated(InData%AOD)) then + call RegPackBounds(Buf, 2, lbound(InData%AOD), ubound(InData%AOD)) + call RegPack(Buf, InData%AOD) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AOL + call RegPack(Buf, allocated(InData%AOL)) + if (allocated(InData%AOL)) then + call RegPackBounds(Buf, 2, lbound(InData%AOL), ubound(InData%AOL)) + call RegPack(Buf, InData%AOL) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BEDSEP + call RegPack(Buf, allocated(InData%BEDSEP)) + if (allocated(InData%BEDSEP)) then + call RegPackBounds(Buf, 2, lbound(InData%BEDSEP), ubound(InData%BEDSEP)) + call RegPack(Buf, InData%BEDSEP) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OLDSEP + call RegPack(Buf, allocated(InData%OLDSEP)) + if (allocated(InData%OLDSEP)) then + call RegPackBounds(Buf, 2, lbound(InData%OLDSEP), ubound(InData%OLDSEP)) + call RegPack(Buf, InData%OLDSEP) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CC + call RegPack(Buf, InData%CC) + if (RegCheckErr(Buf, RoutineName)) return + ! CDO + call RegPack(Buf, allocated(InData%CDO)) + if (allocated(InData%CDO)) then + call RegPackBounds(Buf, 2, lbound(InData%CDO), ubound(InData%CDO)) + call RegPack(Buf, InData%CDO) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CMI + call RegPack(Buf, InData%CMI) + if (RegCheckErr(Buf, RoutineName)) return + ! CMQ + call RegPack(Buf, InData%CMQ) + if (RegCheckErr(Buf, RoutineName)) return + ! CN + call RegPack(Buf, InData%CN) + if (RegCheckErr(Buf, RoutineName)) return + ! CNA + call RegPack(Buf, allocated(InData%CNA)) + if (allocated(InData%CNA)) then + call RegPackBounds(Buf, 2, lbound(InData%CNA), ubound(InData%CNA)) + call RegPack(Buf, InData%CNA) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CNCP + call RegPack(Buf, InData%CNCP) + if (RegCheckErr(Buf, RoutineName)) return + ! CNIQ + call RegPack(Buf, InData%CNIQ) + if (RegCheckErr(Buf, RoutineName)) return + ! CNP + call RegPack(Buf, allocated(InData%CNP)) + if (allocated(InData%CNP)) then + call RegPackBounds(Buf, 2, lbound(InData%CNP), ubound(InData%CNP)) + call RegPack(Buf, InData%CNP) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CNP1 + call RegPack(Buf, allocated(InData%CNP1)) + if (allocated(InData%CNP1)) then + call RegPackBounds(Buf, 2, lbound(InData%CNP1), ubound(InData%CNP1)) + call RegPack(Buf, InData%CNP1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CNPD + call RegPack(Buf, allocated(InData%CNPD)) + if (allocated(InData%CNPD)) then + call RegPackBounds(Buf, 2, lbound(InData%CNPD), ubound(InData%CNPD)) + call RegPack(Buf, InData%CNPD) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CNPD1 + call RegPack(Buf, allocated(InData%CNPD1)) + if (allocated(InData%CNPD1)) then + call RegPackBounds(Buf, 2, lbound(InData%CNPD1), ubound(InData%CNPD1)) + call RegPack(Buf, InData%CNPD1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CNPOT + call RegPack(Buf, allocated(InData%CNPOT)) + if (allocated(InData%CNPOT)) then + call RegPackBounds(Buf, 2, lbound(InData%CNPOT), ubound(InData%CNPOT)) + call RegPack(Buf, InData%CNPOT) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CNPOT1 + call RegPack(Buf, allocated(InData%CNPOT1)) + if (allocated(InData%CNPOT1)) then + call RegPackBounds(Buf, 2, lbound(InData%CNPOT1), ubound(InData%CNPOT1)) + call RegPack(Buf, InData%CNPOT1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CNS + call RegPack(Buf, allocated(InData%CNS)) + if (allocated(InData%CNS)) then + call RegPackBounds(Buf, 2, lbound(InData%CNS), ubound(InData%CNS)) + call RegPack(Buf, InData%CNS) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CNSL + call RegPack(Buf, allocated(InData%CNSL)) + if (allocated(InData%CNSL)) then + call RegPackBounds(Buf, 2, lbound(InData%CNSL), ubound(InData%CNSL)) + call RegPack(Buf, InData%CNSL) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CNV + call RegPack(Buf, allocated(InData%CNV)) + if (allocated(InData%CNV)) then + call RegPackBounds(Buf, 2, lbound(InData%CNV), ubound(InData%CNV)) + call RegPack(Buf, InData%CNV) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CVN + call RegPack(Buf, allocated(InData%CVN)) + if (allocated(InData%CVN)) then + call RegPackBounds(Buf, 2, lbound(InData%CVN), ubound(InData%CVN)) + call RegPack(Buf, InData%CVN) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CVN1 + call RegPack(Buf, allocated(InData%CVN1)) + if (allocated(InData%CVN1)) then + call RegPackBounds(Buf, 2, lbound(InData%CVN1), ubound(InData%CVN1)) + call RegPack(Buf, InData%CVN1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DF + call RegPack(Buf, allocated(InData%DF)) + if (allocated(InData%DF)) then + call RegPackBounds(Buf, 2, lbound(InData%DF), ubound(InData%DF)) + call RegPack(Buf, InData%DF) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DFAFE + call RegPack(Buf, allocated(InData%DFAFE)) + if (allocated(InData%DFAFE)) then + call RegPackBounds(Buf, 2, lbound(InData%DFAFE), ubound(InData%DFAFE)) + call RegPack(Buf, InData%DFAFE) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DFAFE1 + call RegPack(Buf, allocated(InData%DFAFE1)) + if (allocated(InData%DFAFE1)) then + call RegPackBounds(Buf, 2, lbound(InData%DFAFE1), ubound(InData%DFAFE1)) + call RegPack(Buf, InData%DFAFE1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DFC + call RegPack(Buf, allocated(InData%DFC)) + if (allocated(InData%DFC)) then + call RegPackBounds(Buf, 2, lbound(InData%DFC), ubound(InData%DFC)) + call RegPack(Buf, InData%DFC) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DN + call RegPack(Buf, allocated(InData%DN)) + if (allocated(InData%DN)) then + call RegPackBounds(Buf, 2, lbound(InData%DN), ubound(InData%DN)) + call RegPack(Buf, InData%DN) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DPP + call RegPack(Buf, allocated(InData%DPP)) + if (allocated(InData%DPP)) then + call RegPackBounds(Buf, 2, lbound(InData%DPP), ubound(InData%DPP)) + call RegPack(Buf, InData%DPP) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DQ + call RegPack(Buf, allocated(InData%DQ)) + if (allocated(InData%DQ)) then + call RegPackBounds(Buf, 2, lbound(InData%DQ), ubound(InData%DQ)) + call RegPack(Buf, InData%DQ) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DQP + call RegPack(Buf, allocated(InData%DQP)) + if (allocated(InData%DQP)) then + call RegPackBounds(Buf, 2, lbound(InData%DQP), ubound(InData%DQP)) + call RegPack(Buf, InData%DQP) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DQP1 + call RegPack(Buf, allocated(InData%DQP1)) + if (allocated(InData%DQP1)) then + call RegPackBounds(Buf, 2, lbound(InData%DQP1), ubound(InData%DQP1)) + call RegPack(Buf, InData%DQP1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DS + call RegPack(Buf, InData%DS) + if (RegCheckErr(Buf, RoutineName)) return + ! FK + call RegPack(Buf, InData%FK) + if (RegCheckErr(Buf, RoutineName)) return + ! FP + call RegPack(Buf, InData%FP) + if (RegCheckErr(Buf, RoutineName)) return + ! FPC + call RegPack(Buf, InData%FPC) + if (RegCheckErr(Buf, RoutineName)) return + ! FSP + call RegPack(Buf, allocated(InData%FSP)) + if (allocated(InData%FSP)) then + call RegPackBounds(Buf, 2, lbound(InData%FSP), ubound(InData%FSP)) + call RegPack(Buf, InData%FSP) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FSP1 + call RegPack(Buf, allocated(InData%FSP1)) + if (allocated(InData%FSP1)) then + call RegPackBounds(Buf, 2, lbound(InData%FSP1), ubound(InData%FSP1)) + call RegPack(Buf, InData%FSP1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FSPC + call RegPack(Buf, allocated(InData%FSPC)) + if (allocated(InData%FSPC)) then + call RegPackBounds(Buf, 2, lbound(InData%FSPC), ubound(InData%FSPC)) + call RegPack(Buf, InData%FSPC) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FSPC1 + call RegPack(Buf, allocated(InData%FSPC1)) + if (allocated(InData%FSPC1)) then + call RegPackBounds(Buf, 2, lbound(InData%FSPC1), ubound(InData%FSPC1)) + call RegPack(Buf, InData%FSPC1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FTB + call RegPack(Buf, allocated(InData%FTB)) + if (allocated(InData%FTB)) then + call RegPackBounds(Buf, 3, lbound(InData%FTB), ubound(InData%FTB)) + call RegPack(Buf, InData%FTB) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FTBC + call RegPack(Buf, allocated(InData%FTBC)) + if (allocated(InData%FTBC)) then + call RegPackBounds(Buf, 3, lbound(InData%FTBC), ubound(InData%FTBC)) + call RegPack(Buf, InData%FTBC) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OLDCNV + call RegPack(Buf, allocated(InData%OLDCNV)) + if (allocated(InData%OLDCNV)) then + call RegPackBounds(Buf, 2, lbound(InData%OLDCNV), ubound(InData%OLDCNV)) + call RegPack(Buf, InData%OLDCNV) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OLDDF + call RegPack(Buf, allocated(InData%OLDDF)) + if (allocated(InData%OLDDF)) then + call RegPackBounds(Buf, 2, lbound(InData%OLDDF), ubound(InData%OLDDF)) + call RegPack(Buf, InData%OLDDF) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OLDDFC + call RegPack(Buf, allocated(InData%OLDDFC)) + if (allocated(InData%OLDDFC)) then + call RegPackBounds(Buf, 2, lbound(InData%OLDDFC), ubound(InData%OLDDFC)) + call RegPack(Buf, InData%OLDDFC) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OLDDN + call RegPack(Buf, allocated(InData%OLDDN)) + if (allocated(InData%OLDDN)) then + call RegPackBounds(Buf, 2, lbound(InData%OLDDN), ubound(InData%OLDDN)) + call RegPack(Buf, InData%OLDDN) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OLDDPP + call RegPack(Buf, allocated(InData%OLDDPP)) + if (allocated(InData%OLDDPP)) then + call RegPackBounds(Buf, 2, lbound(InData%OLDDPP), ubound(InData%OLDDPP)) + call RegPack(Buf, InData%OLDDPP) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OLDDQ + call RegPack(Buf, allocated(InData%OLDDQ)) + if (allocated(InData%OLDDQ)) then + call RegPackBounds(Buf, 2, lbound(InData%OLDDQ), ubound(InData%OLDDQ)) + call RegPack(Buf, InData%OLDDQ) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OLDTAU + call RegPack(Buf, allocated(InData%OLDTAU)) + if (allocated(InData%OLDTAU)) then + call RegPackBounds(Buf, 2, lbound(InData%OLDTAU), ubound(InData%OLDTAU)) + call RegPack(Buf, InData%OLDTAU) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OLDXN + call RegPack(Buf, allocated(InData%OLDXN)) + if (allocated(InData%OLDXN)) then + call RegPackBounds(Buf, 2, lbound(InData%OLDXN), ubound(InData%OLDXN)) + call RegPack(Buf, InData%OLDXN) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OLDYN + call RegPack(Buf, allocated(InData%OLDYN)) + if (allocated(InData%OLDYN)) then + call RegPackBounds(Buf, 2, lbound(InData%OLDYN), ubound(InData%OLDYN)) + call RegPack(Buf, InData%OLDYN) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! QX + call RegPack(Buf, allocated(InData%QX)) + if (allocated(InData%QX)) then + call RegPackBounds(Buf, 2, lbound(InData%QX), ubound(InData%QX)) + call RegPack(Buf, InData%QX) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! QX1 + call RegPack(Buf, allocated(InData%QX1)) + if (allocated(InData%QX1)) then + call RegPackBounds(Buf, 2, lbound(InData%QX1), ubound(InData%QX1)) + call RegPack(Buf, InData%QX1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TAU + call RegPack(Buf, allocated(InData%TAU)) + if (allocated(InData%TAU)) then + call RegPackBounds(Buf, 2, lbound(InData%TAU), ubound(InData%TAU)) + call RegPack(Buf, InData%TAU) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! XN + call RegPack(Buf, allocated(InData%XN)) + if (allocated(InData%XN)) then + call RegPackBounds(Buf, 2, lbound(InData%XN), ubound(InData%XN)) + call RegPack(Buf, InData%XN) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! YN + call RegPack(Buf, allocated(InData%YN)) + if (allocated(InData%YN)) then + call RegPackBounds(Buf, 2, lbound(InData%YN), ubound(InData%YN)) + call RegPack(Buf, InData%YN) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SHIFT + call RegPack(Buf, InData%SHIFT) + if (RegCheckErr(Buf, RoutineName)) return + ! VOR + call RegPack(Buf, InData%VOR) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackBeddoes(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Beddoes), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackBeddoes' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! ADOT + if (allocated(OutData%ADOT)) deallocate(OutData%ADOT) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ADOT(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ADOT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ADOT) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ADOT1 + if (allocated(OutData%ADOT1)) deallocate(OutData%ADOT1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ADOT1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ADOT1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ADOT1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AFE + if (allocated(OutData%AFE)) deallocate(OutData%AFE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AFE(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AFE) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AFE1 + if (allocated(OutData%AFE1)) deallocate(OutData%AFE1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AFE1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFE1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AFE1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AN + call RegUnpack(Buf, OutData%AN) + if (RegCheckErr(Buf, RoutineName)) return + ! ANE + if (allocated(OutData%ANE)) deallocate(OutData%ANE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ANE(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ANE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ANE) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ANE1 + if (allocated(OutData%ANE1)) deallocate(OutData%ANE1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ANE1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ANE1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ANE1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AOD + if (allocated(OutData%AOD)) deallocate(OutData%AOD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AOD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AOD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AOD) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AOL + if (allocated(OutData%AOL)) deallocate(OutData%AOL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AOL(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AOL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AOL) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BEDSEP + if (allocated(OutData%BEDSEP)) deallocate(OutData%BEDSEP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BEDSEP(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BEDSEP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BEDSEP) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! OLDSEP + if (allocated(OutData%OLDSEP)) deallocate(OutData%OLDSEP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OLDSEP(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDSEP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OLDSEP) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CC + call RegUnpack(Buf, OutData%CC) + if (RegCheckErr(Buf, RoutineName)) return + ! CDO + if (allocated(OutData%CDO)) deallocate(OutData%CDO) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CDO(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CDO.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CDO) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CMI + call RegUnpack(Buf, OutData%CMI) + if (RegCheckErr(Buf, RoutineName)) return + ! CMQ + call RegUnpack(Buf, OutData%CMQ) + if (RegCheckErr(Buf, RoutineName)) return + ! CN + call RegUnpack(Buf, OutData%CN) + if (RegCheckErr(Buf, RoutineName)) return + ! CNA + if (allocated(OutData%CNA)) deallocate(OutData%CNA) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CNA(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNA.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CNA) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CNCP + call RegUnpack(Buf, OutData%CNCP) + if (RegCheckErr(Buf, RoutineName)) return + ! CNIQ + call RegUnpack(Buf, OutData%CNIQ) + if (RegCheckErr(Buf, RoutineName)) return + ! CNP + if (allocated(OutData%CNP)) deallocate(OutData%CNP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CNP(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CNP) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CNP1 + if (allocated(OutData%CNP1)) deallocate(OutData%CNP1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CNP1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNP1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CNP1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CNPD + if (allocated(OutData%CNPD)) deallocate(OutData%CNPD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CNPD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNPD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CNPD) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CNPD1 + if (allocated(OutData%CNPD1)) deallocate(OutData%CNPD1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CNPD1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNPD1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CNPD1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CNPOT + if (allocated(OutData%CNPOT)) deallocate(OutData%CNPOT) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CNPOT(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNPOT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CNPOT) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CNPOT1 + if (allocated(OutData%CNPOT1)) deallocate(OutData%CNPOT1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CNPOT1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNPOT1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CNPOT1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CNS + if (allocated(OutData%CNS)) deallocate(OutData%CNS) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CNS(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CNS) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CNSL + if (allocated(OutData%CNSL)) deallocate(OutData%CNSL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CNSL(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNSL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CNSL) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CNV + if (allocated(OutData%CNV)) deallocate(OutData%CNV) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CNV(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNV.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CNV) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CVN + if (allocated(OutData%CVN)) deallocate(OutData%CVN) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CVN(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CVN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CVN) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CVN1 + if (allocated(OutData%CVN1)) deallocate(OutData%CVN1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CVN1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CVN1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CVN1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! DF + if (allocated(OutData%DF)) deallocate(OutData%DF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DF(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DF) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! DFAFE + if (allocated(OutData%DFAFE)) deallocate(OutData%DFAFE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DFAFE(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DFAFE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DFAFE) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! DFAFE1 + if (allocated(OutData%DFAFE1)) deallocate(OutData%DFAFE1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DFAFE1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DFAFE1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DFAFE1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! DFC + if (allocated(OutData%DFC)) deallocate(OutData%DFC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DFC(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DFC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DFC) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! DN + if (allocated(OutData%DN)) deallocate(OutData%DN) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DN(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DN) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! DPP + if (allocated(OutData%DPP)) deallocate(OutData%DPP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DPP(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DPP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DPP) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! DQ + if (allocated(OutData%DQ)) deallocate(OutData%DQ) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DQ(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DQ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DQ) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! DQP + if (allocated(OutData%DQP)) deallocate(OutData%DQP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DQP(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DQP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DQP) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! DQP1 + if (allocated(OutData%DQP1)) deallocate(OutData%DQP1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DQP1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DQP1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DQP1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! DS + call RegUnpack(Buf, OutData%DS) + if (RegCheckErr(Buf, RoutineName)) return + ! FK + call RegUnpack(Buf, OutData%FK) + if (RegCheckErr(Buf, RoutineName)) return + ! FP + call RegUnpack(Buf, OutData%FP) + if (RegCheckErr(Buf, RoutineName)) return + ! FPC + call RegUnpack(Buf, OutData%FPC) + if (RegCheckErr(Buf, RoutineName)) return + ! FSP + if (allocated(OutData%FSP)) deallocate(OutData%FSP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FSP(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FSP) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! FSP1 + if (allocated(OutData%FSP1)) deallocate(OutData%FSP1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FSP1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSP1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FSP1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! FSPC + if (allocated(OutData%FSPC)) deallocate(OutData%FSPC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FSPC(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSPC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FSPC) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! FSPC1 + if (allocated(OutData%FSPC1)) deallocate(OutData%FSPC1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FSPC1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSPC1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FSPC1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! FTB + if (allocated(OutData%FTB)) deallocate(OutData%FTB) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FTB(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FTB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FTB) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! FTBC + if (allocated(OutData%FTBC)) deallocate(OutData%FTBC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FTBC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FTBC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FTBC) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! OLDCNV + if (allocated(OutData%OLDCNV)) deallocate(OutData%OLDCNV) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OLDCNV(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDCNV.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OLDCNV) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! OLDDF + if (allocated(OutData%OLDDF)) deallocate(OutData%OLDDF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OLDDF(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDDF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OLDDF) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! OLDDFC + if (allocated(OutData%OLDDFC)) deallocate(OutData%OLDDFC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OLDDFC(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDDFC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OLDDFC) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! OLDDN + if (allocated(OutData%OLDDN)) deallocate(OutData%OLDDN) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OLDDN(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDDN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OLDDN) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! OLDDPP + if (allocated(OutData%OLDDPP)) deallocate(OutData%OLDDPP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OLDDPP(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDDPP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OLDDPP) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! OLDDQ + if (allocated(OutData%OLDDQ)) deallocate(OutData%OLDDQ) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OLDDQ(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDDQ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OLDDQ) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! OLDTAU + if (allocated(OutData%OLDTAU)) deallocate(OutData%OLDTAU) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OLDTAU(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDTAU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OLDTAU) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! OLDXN + if (allocated(OutData%OLDXN)) deallocate(OutData%OLDXN) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OLDXN(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDXN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OLDXN) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! OLDYN + if (allocated(OutData%OLDYN)) deallocate(OutData%OLDYN) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OLDYN(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDYN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OLDYN) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! QX + if (allocated(OutData%QX)) deallocate(OutData%QX) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%QX(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%QX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%QX) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! QX1 + if (allocated(OutData%QX1)) deallocate(OutData%QX1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%QX1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%QX1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%QX1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TAU + if (allocated(OutData%TAU)) deallocate(OutData%TAU) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TAU(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TAU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TAU) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! XN + if (allocated(OutData%XN)) deallocate(OutData%XN) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%XN(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%XN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%XN) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! YN + if (allocated(OutData%YN)) deallocate(OutData%YN) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%YN(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%YN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%YN) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! SHIFT + call RegUnpack(Buf, OutData%SHIFT) + if (RegCheckErr(Buf, RoutineName)) return + ! VOR + call RegUnpack(Buf, OutData%VOR) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + SUBROUTINE AD14_CopyBeddoesParms( SrcBeddoesParmsData, DstBeddoesParmsData, CtrlCode, ErrStat, ErrMsg ) + TYPE(BeddoesParms), INTENT(IN) :: SrcBeddoesParmsData + TYPE(BeddoesParms), INTENT(INOUT) :: DstBeddoesParmsData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD14_CopyBeddoesParms' +! + ErrStat = ErrID_None + ErrMsg = "" + DstBeddoesParmsData%AS = SrcBeddoesParmsData%AS + DstBeddoesParmsData%TF = SrcBeddoesParmsData%TF + DstBeddoesParmsData%TP = SrcBeddoesParmsData%TP + DstBeddoesParmsData%TV = SrcBeddoesParmsData%TV + DstBeddoesParmsData%TVL = SrcBeddoesParmsData%TVL + END SUBROUTINE AD14_CopyBeddoesParms + + SUBROUTINE AD14_DestroyBeddoesParms( BeddoesParmsData, ErrStat, ErrMsg ) + TYPE(BeddoesParms), INTENT(INOUT) :: BeddoesParmsData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_PackBeddoes' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyBeddoesParms' - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! ErrStat = ErrID_None ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! ADOT allocated yes/no - IF ( ALLOCATED(InData%ADOT) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ADOT upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ADOT) ! ADOT - END IF - Int_BufSz = Int_BufSz + 1 ! ADOT1 allocated yes/no - IF ( ALLOCATED(InData%ADOT1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ADOT1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ADOT1) ! ADOT1 - END IF - Int_BufSz = Int_BufSz + 1 ! AFE allocated yes/no - IF ( ALLOCATED(InData%AFE) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AFE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AFE) ! AFE - END IF - Int_BufSz = Int_BufSz + 1 ! AFE1 allocated yes/no - IF ( ALLOCATED(InData%AFE1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AFE1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AFE1) ! AFE1 - END IF - Re_BufSz = Re_BufSz + 1 ! AN - Int_BufSz = Int_BufSz + 1 ! ANE allocated yes/no - IF ( ALLOCATED(InData%ANE) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ANE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ANE) ! ANE - END IF - Int_BufSz = Int_BufSz + 1 ! ANE1 allocated yes/no - IF ( ALLOCATED(InData%ANE1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ANE1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ANE1) ! ANE1 - END IF - Int_BufSz = Int_BufSz + 1 ! AOD allocated yes/no - IF ( ALLOCATED(InData%AOD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AOD upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AOD) ! AOD - END IF - Int_BufSz = Int_BufSz + 1 ! AOL allocated yes/no - IF ( ALLOCATED(InData%AOL) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AOL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AOL) ! AOL - END IF - Int_BufSz = Int_BufSz + 1 ! BEDSEP allocated yes/no - IF ( ALLOCATED(InData%BEDSEP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BEDSEP upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BEDSEP) ! BEDSEP - END IF - Int_BufSz = Int_BufSz + 1 ! OLDSEP allocated yes/no - IF ( ALLOCATED(InData%OLDSEP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OLDSEP upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%OLDSEP) ! OLDSEP - END IF - Re_BufSz = Re_BufSz + 1 ! CC - Int_BufSz = Int_BufSz + 1 ! CDO allocated yes/no - IF ( ALLOCATED(InData%CDO) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CDO upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CDO) ! CDO - END IF - Re_BufSz = Re_BufSz + 1 ! CMI - Re_BufSz = Re_BufSz + 1 ! CMQ - Re_BufSz = Re_BufSz + 1 ! CN - Int_BufSz = Int_BufSz + 1 ! CNA allocated yes/no - IF ( ALLOCATED(InData%CNA) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CNA upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CNA) ! CNA - END IF - Re_BufSz = Re_BufSz + 1 ! CNCP - Re_BufSz = Re_BufSz + 1 ! CNIQ - Int_BufSz = Int_BufSz + 1 ! CNP allocated yes/no - IF ( ALLOCATED(InData%CNP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CNP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CNP) ! CNP - END IF - Int_BufSz = Int_BufSz + 1 ! CNP1 allocated yes/no - IF ( ALLOCATED(InData%CNP1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CNP1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CNP1) ! CNP1 - END IF - Int_BufSz = Int_BufSz + 1 ! CNPD allocated yes/no - IF ( ALLOCATED(InData%CNPD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CNPD upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CNPD) ! CNPD - END IF - Int_BufSz = Int_BufSz + 1 ! CNPD1 allocated yes/no - IF ( ALLOCATED(InData%CNPD1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CNPD1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CNPD1) ! CNPD1 - END IF - Int_BufSz = Int_BufSz + 1 ! CNPOT allocated yes/no - IF ( ALLOCATED(InData%CNPOT) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CNPOT upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CNPOT) ! CNPOT - END IF - Int_BufSz = Int_BufSz + 1 ! CNPOT1 allocated yes/no - IF ( ALLOCATED(InData%CNPOT1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CNPOT1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CNPOT1) ! CNPOT1 - END IF - Int_BufSz = Int_BufSz + 1 ! CNS allocated yes/no - IF ( ALLOCATED(InData%CNS) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CNS upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CNS) ! CNS - END IF - Int_BufSz = Int_BufSz + 1 ! CNSL allocated yes/no - IF ( ALLOCATED(InData%CNSL) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CNSL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CNSL) ! CNSL - END IF - Int_BufSz = Int_BufSz + 1 ! CNV allocated yes/no - IF ( ALLOCATED(InData%CNV) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CNV upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CNV) ! CNV - END IF - Int_BufSz = Int_BufSz + 1 ! CVN allocated yes/no - IF ( ALLOCATED(InData%CVN) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CVN upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CVN) ! CVN - END IF - Int_BufSz = Int_BufSz + 1 ! CVN1 allocated yes/no - IF ( ALLOCATED(InData%CVN1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CVN1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CVN1) ! CVN1 - END IF - Int_BufSz = Int_BufSz + 1 ! DF allocated yes/no - IF ( ALLOCATED(InData%DF) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! DF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DF) ! DF - END IF - Int_BufSz = Int_BufSz + 1 ! DFAFE allocated yes/no - IF ( ALLOCATED(InData%DFAFE) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! DFAFE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DFAFE) ! DFAFE - END IF - Int_BufSz = Int_BufSz + 1 ! DFAFE1 allocated yes/no - IF ( ALLOCATED(InData%DFAFE1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! DFAFE1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DFAFE1) ! DFAFE1 - END IF - Int_BufSz = Int_BufSz + 1 ! DFC allocated yes/no - IF ( ALLOCATED(InData%DFC) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! DFC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DFC) ! DFC - END IF - Int_BufSz = Int_BufSz + 1 ! DN allocated yes/no - IF ( ALLOCATED(InData%DN) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! DN upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DN) ! DN - END IF - Int_BufSz = Int_BufSz + 1 ! DPP allocated yes/no - IF ( ALLOCATED(InData%DPP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! DPP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DPP) ! DPP - END IF - Int_BufSz = Int_BufSz + 1 ! DQ allocated yes/no - IF ( ALLOCATED(InData%DQ) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! DQ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DQ) ! DQ - END IF - Int_BufSz = Int_BufSz + 1 ! DQP allocated yes/no - IF ( ALLOCATED(InData%DQP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! DQP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DQP) ! DQP - END IF - Int_BufSz = Int_BufSz + 1 ! DQP1 allocated yes/no - IF ( ALLOCATED(InData%DQP1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! DQP1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DQP1) ! DQP1 - END IF - Re_BufSz = Re_BufSz + 1 ! DS - Re_BufSz = Re_BufSz + 1 ! FK - Re_BufSz = Re_BufSz + 1 ! FP - Re_BufSz = Re_BufSz + 1 ! FPC - Int_BufSz = Int_BufSz + 1 ! FSP allocated yes/no - IF ( ALLOCATED(InData%FSP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FSP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FSP) ! FSP - END IF - Int_BufSz = Int_BufSz + 1 ! FSP1 allocated yes/no - IF ( ALLOCATED(InData%FSP1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FSP1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FSP1) ! FSP1 - END IF - Int_BufSz = Int_BufSz + 1 ! FSPC allocated yes/no - IF ( ALLOCATED(InData%FSPC) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FSPC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FSPC) ! FSPC - END IF - Int_BufSz = Int_BufSz + 1 ! FSPC1 allocated yes/no - IF ( ALLOCATED(InData%FSPC1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FSPC1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FSPC1) ! FSPC1 - END IF - Int_BufSz = Int_BufSz + 1 ! FTB allocated yes/no - IF ( ALLOCATED(InData%FTB) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! FTB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FTB) ! FTB - END IF - Int_BufSz = Int_BufSz + 1 ! FTBC allocated yes/no - IF ( ALLOCATED(InData%FTBC) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! FTBC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FTBC) ! FTBC - END IF - Int_BufSz = Int_BufSz + 1 ! OLDCNV allocated yes/no - IF ( ALLOCATED(InData%OLDCNV) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OLDCNV upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OLDCNV) ! OLDCNV - END IF - Int_BufSz = Int_BufSz + 1 ! OLDDF allocated yes/no - IF ( ALLOCATED(InData%OLDDF) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OLDDF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OLDDF) ! OLDDF - END IF - Int_BufSz = Int_BufSz + 1 ! OLDDFC allocated yes/no - IF ( ALLOCATED(InData%OLDDFC) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OLDDFC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OLDDFC) ! OLDDFC - END IF - Int_BufSz = Int_BufSz + 1 ! OLDDN allocated yes/no - IF ( ALLOCATED(InData%OLDDN) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OLDDN upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OLDDN) ! OLDDN - END IF - Int_BufSz = Int_BufSz + 1 ! OLDDPP allocated yes/no - IF ( ALLOCATED(InData%OLDDPP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OLDDPP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OLDDPP) ! OLDDPP - END IF - Int_BufSz = Int_BufSz + 1 ! OLDDQ allocated yes/no - IF ( ALLOCATED(InData%OLDDQ) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OLDDQ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OLDDQ) ! OLDDQ - END IF - Int_BufSz = Int_BufSz + 1 ! OLDTAU allocated yes/no - IF ( ALLOCATED(InData%OLDTAU) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OLDTAU upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OLDTAU) ! OLDTAU - END IF - Int_BufSz = Int_BufSz + 1 ! OLDXN allocated yes/no - IF ( ALLOCATED(InData%OLDXN) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OLDXN upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OLDXN) ! OLDXN - END IF - Int_BufSz = Int_BufSz + 1 ! OLDYN allocated yes/no - IF ( ALLOCATED(InData%OLDYN) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OLDYN upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OLDYN) ! OLDYN - END IF - Int_BufSz = Int_BufSz + 1 ! QX allocated yes/no - IF ( ALLOCATED(InData%QX) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! QX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%QX) ! QX - END IF - Int_BufSz = Int_BufSz + 1 ! QX1 allocated yes/no - IF ( ALLOCATED(InData%QX1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! QX1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%QX1) ! QX1 - END IF - Int_BufSz = Int_BufSz + 1 ! TAU allocated yes/no - IF ( ALLOCATED(InData%TAU) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TAU upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TAU) ! TAU - END IF - Int_BufSz = Int_BufSz + 1 ! XN allocated yes/no - IF ( ALLOCATED(InData%XN) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! XN upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%XN) ! XN - END IF - Int_BufSz = Int_BufSz + 1 ! YN allocated yes/no - IF ( ALLOCATED(InData%YN) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! YN upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%YN) ! YN - END IF - Int_BufSz = Int_BufSz + 1 ! SHIFT - Int_BufSz = Int_BufSz + 1 ! VOR - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( .NOT. ALLOCATED(InData%ADOT) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ADOT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ADOT,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ADOT,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ADOT,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ADOT,2), UBOUND(InData%ADOT,2) - DO i1 = LBOUND(InData%ADOT,1), UBOUND(InData%ADOT,1) - ReKiBuf(Re_Xferred) = InData%ADOT(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ADOT1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ADOT1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ADOT1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ADOT1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ADOT1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ADOT1,2), UBOUND(InData%ADOT1,2) - DO i1 = LBOUND(InData%ADOT1,1), UBOUND(InData%ADOT1,1) - ReKiBuf(Re_Xferred) = InData%ADOT1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AFE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFE,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AFE,2), UBOUND(InData%AFE,2) - DO i1 = LBOUND(InData%AFE,1), UBOUND(InData%AFE,1) - ReKiBuf(Re_Xferred) = InData%AFE(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AFE1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFE1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFE1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFE1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFE1,2) - Int_Xferred = Int_Xferred + 2 + END SUBROUTINE AD14_DestroyBeddoesParms - DO i2 = LBOUND(InData%AFE1,2), UBOUND(InData%AFE1,2) - DO i1 = LBOUND(InData%AFE1,1), UBOUND(InData%AFE1,1) - ReKiBuf(Re_Xferred) = InData%AFE1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%AN - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%ANE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ANE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ANE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ANE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ANE,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ANE,2), UBOUND(InData%ANE,2) - DO i1 = LBOUND(InData%ANE,1), UBOUND(InData%ANE,1) - ReKiBuf(Re_Xferred) = InData%ANE(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ANE1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ANE1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ANE1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ANE1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ANE1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ANE1,2), UBOUND(InData%ANE1,2) - DO i1 = LBOUND(InData%ANE1,1), UBOUND(InData%ANE1,1) - ReKiBuf(Re_Xferred) = InData%ANE1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AOD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AOD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AOD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AOD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AOD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AOD,2), UBOUND(InData%AOD,2) - DO i1 = LBOUND(InData%AOD,1), UBOUND(InData%AOD,1) - ReKiBuf(Re_Xferred) = InData%AOD(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AOL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AOL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AOL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AOL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AOL,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AOL,2), UBOUND(InData%AOL,2) - DO i1 = LBOUND(InData%AOL,1), UBOUND(InData%AOL,1) - ReKiBuf(Re_Xferred) = InData%AOL(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BEDSEP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BEDSEP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BEDSEP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BEDSEP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BEDSEP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BEDSEP,2), UBOUND(InData%BEDSEP,2) - DO i1 = LBOUND(InData%BEDSEP,1), UBOUND(InData%BEDSEP,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%BEDSEP(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OLDSEP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDSEP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDSEP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDSEP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDSEP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OLDSEP,2), UBOUND(InData%OLDSEP,2) - DO i1 = LBOUND(InData%OLDSEP,1), UBOUND(InData%OLDSEP,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%OLDSEP(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%CC - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%CDO) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CDO,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CDO,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CDO,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CDO,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CDO,2), UBOUND(InData%CDO,2) - DO i1 = LBOUND(InData%CDO,1), UBOUND(InData%CDO,1) - ReKiBuf(Re_Xferred) = InData%CDO(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%CMI - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CMQ - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CN - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%CNA) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNA,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNA,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNA,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNA,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CNA,2), UBOUND(InData%CNA,2) - DO i1 = LBOUND(InData%CNA,1), UBOUND(InData%CNA,1) - ReKiBuf(Re_Xferred) = InData%CNA(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%CNCP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CNIQ - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%CNP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CNP,2), UBOUND(InData%CNP,2) - DO i1 = LBOUND(InData%CNP,1), UBOUND(InData%CNP,1) - ReKiBuf(Re_Xferred) = InData%CNP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CNP1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNP1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNP1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNP1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNP1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CNP1,2), UBOUND(InData%CNP1,2) - DO i1 = LBOUND(InData%CNP1,1), UBOUND(InData%CNP1,1) - ReKiBuf(Re_Xferred) = InData%CNP1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CNPD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNPD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNPD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNPD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNPD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CNPD,2), UBOUND(InData%CNPD,2) - DO i1 = LBOUND(InData%CNPD,1), UBOUND(InData%CNPD,1) - ReKiBuf(Re_Xferred) = InData%CNPD(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CNPD1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNPD1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNPD1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNPD1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNPD1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CNPD1,2), UBOUND(InData%CNPD1,2) - DO i1 = LBOUND(InData%CNPD1,1), UBOUND(InData%CNPD1,1) - ReKiBuf(Re_Xferred) = InData%CNPD1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CNPOT) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNPOT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNPOT,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNPOT,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNPOT,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CNPOT,2), UBOUND(InData%CNPOT,2) - DO i1 = LBOUND(InData%CNPOT,1), UBOUND(InData%CNPOT,1) - ReKiBuf(Re_Xferred) = InData%CNPOT(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CNPOT1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNPOT1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNPOT1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNPOT1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNPOT1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CNPOT1,2), UBOUND(InData%CNPOT1,2) - DO i1 = LBOUND(InData%CNPOT1,1), UBOUND(InData%CNPOT1,1) - ReKiBuf(Re_Xferred) = InData%CNPOT1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CNS) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNS,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNS,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNS,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CNS,2), UBOUND(InData%CNS,2) - DO i1 = LBOUND(InData%CNS,1), UBOUND(InData%CNS,1) - ReKiBuf(Re_Xferred) = InData%CNS(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CNSL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNSL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNSL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNSL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNSL,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CNSL,2), UBOUND(InData%CNSL,2) - DO i1 = LBOUND(InData%CNSL,1), UBOUND(InData%CNSL,1) - ReKiBuf(Re_Xferred) = InData%CNSL(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CNV) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNV,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNV,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNV,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNV,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CNV,2), UBOUND(InData%CNV,2) - DO i1 = LBOUND(InData%CNV,1), UBOUND(InData%CNV,1) - ReKiBuf(Re_Xferred) = InData%CNV(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CVN) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CVN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CVN,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CVN,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CVN,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CVN,2), UBOUND(InData%CVN,2) - DO i1 = LBOUND(InData%CVN,1), UBOUND(InData%CVN,1) - ReKiBuf(Re_Xferred) = InData%CVN(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CVN1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CVN1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CVN1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CVN1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CVN1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CVN1,2), UBOUND(InData%CVN1,2) - DO i1 = LBOUND(InData%CVN1,1), UBOUND(InData%CVN1,1) - ReKiBuf(Re_Xferred) = InData%CVN1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DF,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%DF,2), UBOUND(InData%DF,2) - DO i1 = LBOUND(InData%DF,1), UBOUND(InData%DF,1) - ReKiBuf(Re_Xferred) = InData%DF(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DFAFE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DFAFE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DFAFE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DFAFE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DFAFE,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%DFAFE,2), UBOUND(InData%DFAFE,2) - DO i1 = LBOUND(InData%DFAFE,1), UBOUND(InData%DFAFE,1) - ReKiBuf(Re_Xferred) = InData%DFAFE(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DFAFE1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DFAFE1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DFAFE1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DFAFE1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DFAFE1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%DFAFE1,2), UBOUND(InData%DFAFE1,2) - DO i1 = LBOUND(InData%DFAFE1,1), UBOUND(InData%DFAFE1,1) - ReKiBuf(Re_Xferred) = InData%DFAFE1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DFC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DFC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DFC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DFC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DFC,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%DFC,2), UBOUND(InData%DFC,2) - DO i1 = LBOUND(InData%DFC,1), UBOUND(InData%DFC,1) - ReKiBuf(Re_Xferred) = InData%DFC(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DN) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DN,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DN,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DN,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%DN,2), UBOUND(InData%DN,2) - DO i1 = LBOUND(InData%DN,1), UBOUND(InData%DN,1) - ReKiBuf(Re_Xferred) = InData%DN(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DPP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DPP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DPP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DPP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DPP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%DPP,2), UBOUND(InData%DPP,2) - DO i1 = LBOUND(InData%DPP,1), UBOUND(InData%DPP,1) - ReKiBuf(Re_Xferred) = InData%DPP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DQ) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DQ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DQ,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DQ,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DQ,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%DQ,2), UBOUND(InData%DQ,2) - DO i1 = LBOUND(InData%DQ,1), UBOUND(InData%DQ,1) - ReKiBuf(Re_Xferred) = InData%DQ(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DQP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DQP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DQP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DQP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DQP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%DQP,2), UBOUND(InData%DQP,2) - DO i1 = LBOUND(InData%DQP,1), UBOUND(InData%DQP,1) - ReKiBuf(Re_Xferred) = InData%DQP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DQP1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DQP1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DQP1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DQP1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DQP1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%DQP1,2), UBOUND(InData%DQP1,2) - DO i1 = LBOUND(InData%DQP1,1), UBOUND(InData%DQP1,1) - ReKiBuf(Re_Xferred) = InData%DQP1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%DS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FK - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FPC - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%FSP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FSP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FSP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FSP,2), UBOUND(InData%FSP,2) - DO i1 = LBOUND(InData%FSP,1), UBOUND(InData%FSP,1) - ReKiBuf(Re_Xferred) = InData%FSP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FSP1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FSP1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSP1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FSP1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSP1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FSP1,2), UBOUND(InData%FSP1,2) - DO i1 = LBOUND(InData%FSP1,1), UBOUND(InData%FSP1,1) - ReKiBuf(Re_Xferred) = InData%FSP1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FSPC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FSPC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSPC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FSPC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSPC,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FSPC,2), UBOUND(InData%FSPC,2) - DO i1 = LBOUND(InData%FSPC,1), UBOUND(InData%FSPC,1) - ReKiBuf(Re_Xferred) = InData%FSPC(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FSPC1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FSPC1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSPC1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FSPC1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSPC1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FSPC1,2), UBOUND(InData%FSPC1,2) - DO i1 = LBOUND(InData%FSPC1,1), UBOUND(InData%FSPC1,1) - ReKiBuf(Re_Xferred) = InData%FSPC1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FTB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FTB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FTB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FTB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FTB,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FTB,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FTB,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%FTB,3), UBOUND(InData%FTB,3) - DO i2 = LBOUND(InData%FTB,2), UBOUND(InData%FTB,2) - DO i1 = LBOUND(InData%FTB,1), UBOUND(InData%FTB,1) - ReKiBuf(Re_Xferred) = InData%FTB(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FTBC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FTBC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FTBC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FTBC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FTBC,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FTBC,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FTBC,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%FTBC,3), UBOUND(InData%FTBC,3) - DO i2 = LBOUND(InData%FTBC,2), UBOUND(InData%FTBC,2) - DO i1 = LBOUND(InData%FTBC,1), UBOUND(InData%FTBC,1) - ReKiBuf(Re_Xferred) = InData%FTBC(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OLDCNV) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDCNV,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDCNV,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDCNV,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDCNV,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OLDCNV,2), UBOUND(InData%OLDCNV,2) - DO i1 = LBOUND(InData%OLDCNV,1), UBOUND(InData%OLDCNV,1) - ReKiBuf(Re_Xferred) = InData%OLDCNV(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OLDDF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDDF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDDF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDDF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDDF,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OLDDF,2), UBOUND(InData%OLDDF,2) - DO i1 = LBOUND(InData%OLDDF,1), UBOUND(InData%OLDDF,1) - ReKiBuf(Re_Xferred) = InData%OLDDF(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OLDDFC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDDFC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDDFC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDDFC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDDFC,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OLDDFC,2), UBOUND(InData%OLDDFC,2) - DO i1 = LBOUND(InData%OLDDFC,1), UBOUND(InData%OLDDFC,1) - ReKiBuf(Re_Xferred) = InData%OLDDFC(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OLDDN) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDDN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDDN,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDDN,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDDN,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OLDDN,2), UBOUND(InData%OLDDN,2) - DO i1 = LBOUND(InData%OLDDN,1), UBOUND(InData%OLDDN,1) - ReKiBuf(Re_Xferred) = InData%OLDDN(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OLDDPP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDDPP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDDPP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDDPP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDDPP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OLDDPP,2), UBOUND(InData%OLDDPP,2) - DO i1 = LBOUND(InData%OLDDPP,1), UBOUND(InData%OLDDPP,1) - ReKiBuf(Re_Xferred) = InData%OLDDPP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OLDDQ) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDDQ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDDQ,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDDQ,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDDQ,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OLDDQ,2), UBOUND(InData%OLDDQ,2) - DO i1 = LBOUND(InData%OLDDQ,1), UBOUND(InData%OLDDQ,1) - ReKiBuf(Re_Xferred) = InData%OLDDQ(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OLDTAU) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDTAU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDTAU,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDTAU,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDTAU,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OLDTAU,2), UBOUND(InData%OLDTAU,2) - DO i1 = LBOUND(InData%OLDTAU,1), UBOUND(InData%OLDTAU,1) - ReKiBuf(Re_Xferred) = InData%OLDTAU(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OLDXN) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDXN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDXN,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDXN,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDXN,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OLDXN,2), UBOUND(InData%OLDXN,2) - DO i1 = LBOUND(InData%OLDXN,1), UBOUND(InData%OLDXN,1) - ReKiBuf(Re_Xferred) = InData%OLDXN(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OLDYN) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDYN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDYN,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLDYN,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDYN,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OLDYN,2), UBOUND(InData%OLDYN,2) - DO i1 = LBOUND(InData%OLDYN,1), UBOUND(InData%OLDYN,1) - ReKiBuf(Re_Xferred) = InData%OLDYN(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%QX) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QX,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QX,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QX,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%QX,2), UBOUND(InData%QX,2) - DO i1 = LBOUND(InData%QX,1), UBOUND(InData%QX,1) - ReKiBuf(Re_Xferred) = InData%QX(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%QX1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QX1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QX1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QX1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QX1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%QX1,2), UBOUND(InData%QX1,2) - DO i1 = LBOUND(InData%QX1,1), UBOUND(InData%QX1,1) - ReKiBuf(Re_Xferred) = InData%QX1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TAU) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TAU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TAU,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TAU,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TAU,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TAU,2), UBOUND(InData%TAU,2) - DO i1 = LBOUND(InData%TAU,1), UBOUND(InData%TAU,1) - ReKiBuf(Re_Xferred) = InData%TAU(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%XN) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%XN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%XN,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%XN,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%XN,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%XN,2), UBOUND(InData%XN,2) - DO i1 = LBOUND(InData%XN,1), UBOUND(InData%XN,1) - ReKiBuf(Re_Xferred) = InData%XN(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%YN) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%YN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%YN,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%YN,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%YN,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%YN,2), UBOUND(InData%YN,2) - DO i1 = LBOUND(InData%YN,1), UBOUND(InData%YN,1) - ReKiBuf(Re_Xferred) = InData%YN(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%SHIFT, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%VOR, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD14_PackBeddoes - - SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Beddoes), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackBeddoes' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ADOT not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ADOT)) DEALLOCATE(OutData%ADOT) - ALLOCATE(OutData%ADOT(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ADOT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ADOT,2), UBOUND(OutData%ADOT,2) - DO i1 = LBOUND(OutData%ADOT,1), UBOUND(OutData%ADOT,1) - OutData%ADOT(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ADOT1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ADOT1)) DEALLOCATE(OutData%ADOT1) - ALLOCATE(OutData%ADOT1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ADOT1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ADOT1,2), UBOUND(OutData%ADOT1,2) - DO i1 = LBOUND(OutData%ADOT1,1), UBOUND(OutData%ADOT1,1) - OutData%ADOT1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFE not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AFE)) DEALLOCATE(OutData%AFE) - ALLOCATE(OutData%AFE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AFE,2), UBOUND(OutData%AFE,2) - DO i1 = LBOUND(OutData%AFE,1), UBOUND(OutData%AFE,1) - OutData%AFE(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFE1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AFE1)) DEALLOCATE(OutData%AFE1) - ALLOCATE(OutData%AFE1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFE1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AFE1,2), UBOUND(OutData%AFE1,2) - DO i1 = LBOUND(OutData%AFE1,1), UBOUND(OutData%AFE1,1) - OutData%AFE1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%AN = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ANE not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ANE)) DEALLOCATE(OutData%ANE) - ALLOCATE(OutData%ANE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ANE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ANE,2), UBOUND(OutData%ANE,2) - DO i1 = LBOUND(OutData%ANE,1), UBOUND(OutData%ANE,1) - OutData%ANE(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ANE1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ANE1)) DEALLOCATE(OutData%ANE1) - ALLOCATE(OutData%ANE1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ANE1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ANE1,2), UBOUND(OutData%ANE1,2) - DO i1 = LBOUND(OutData%ANE1,1), UBOUND(OutData%ANE1,1) - OutData%ANE1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AOD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AOD)) DEALLOCATE(OutData%AOD) - ALLOCATE(OutData%AOD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AOD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AOD,2), UBOUND(OutData%AOD,2) - DO i1 = LBOUND(OutData%AOD,1), UBOUND(OutData%AOD,1) - OutData%AOD(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AOL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AOL)) DEALLOCATE(OutData%AOL) - ALLOCATE(OutData%AOL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AOL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AOL,2), UBOUND(OutData%AOL,2) - DO i1 = LBOUND(OutData%AOL,1), UBOUND(OutData%AOL,1) - OutData%AOL(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BEDSEP not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BEDSEP)) DEALLOCATE(OutData%BEDSEP) - ALLOCATE(OutData%BEDSEP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BEDSEP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BEDSEP,2), UBOUND(OutData%BEDSEP,2) - DO i1 = LBOUND(OutData%BEDSEP,1), UBOUND(OutData%BEDSEP,1) - OutData%BEDSEP(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%BEDSEP(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDSEP not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OLDSEP)) DEALLOCATE(OutData%OLDSEP) - ALLOCATE(OutData%OLDSEP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDSEP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OLDSEP,2), UBOUND(OutData%OLDSEP,2) - DO i1 = LBOUND(OutData%OLDSEP,1), UBOUND(OutData%OLDSEP,1) - OutData%OLDSEP(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%OLDSEP(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - OutData%CC = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CDO not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CDO)) DEALLOCATE(OutData%CDO) - ALLOCATE(OutData%CDO(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CDO.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CDO,2), UBOUND(OutData%CDO,2) - DO i1 = LBOUND(OutData%CDO,1), UBOUND(OutData%CDO,1) - OutData%CDO(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%CMI = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CMQ = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CN = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNA not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CNA)) DEALLOCATE(OutData%CNA) - ALLOCATE(OutData%CNA(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CNA,2), UBOUND(OutData%CNA,2) - DO i1 = LBOUND(OutData%CNA,1), UBOUND(OutData%CNA,1) - OutData%CNA(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%CNCP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CNIQ = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNP not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CNP)) DEALLOCATE(OutData%CNP) - ALLOCATE(OutData%CNP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CNP,2), UBOUND(OutData%CNP,2) - DO i1 = LBOUND(OutData%CNP,1), UBOUND(OutData%CNP,1) - OutData%CNP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNP1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CNP1)) DEALLOCATE(OutData%CNP1) - ALLOCATE(OutData%CNP1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNP1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CNP1,2), UBOUND(OutData%CNP1,2) - DO i1 = LBOUND(OutData%CNP1,1), UBOUND(OutData%CNP1,1) - OutData%CNP1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNPD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CNPD)) DEALLOCATE(OutData%CNPD) - ALLOCATE(OutData%CNPD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNPD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CNPD,2), UBOUND(OutData%CNPD,2) - DO i1 = LBOUND(OutData%CNPD,1), UBOUND(OutData%CNPD,1) - OutData%CNPD(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNPD1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CNPD1)) DEALLOCATE(OutData%CNPD1) - ALLOCATE(OutData%CNPD1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNPD1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CNPD1,2), UBOUND(OutData%CNPD1,2) - DO i1 = LBOUND(OutData%CNPD1,1), UBOUND(OutData%CNPD1,1) - OutData%CNPD1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNPOT not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CNPOT)) DEALLOCATE(OutData%CNPOT) - ALLOCATE(OutData%CNPOT(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNPOT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CNPOT,2), UBOUND(OutData%CNPOT,2) - DO i1 = LBOUND(OutData%CNPOT,1), UBOUND(OutData%CNPOT,1) - OutData%CNPOT(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNPOT1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CNPOT1)) DEALLOCATE(OutData%CNPOT1) - ALLOCATE(OutData%CNPOT1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNPOT1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CNPOT1,2), UBOUND(OutData%CNPOT1,2) - DO i1 = LBOUND(OutData%CNPOT1,1), UBOUND(OutData%CNPOT1,1) - OutData%CNPOT1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNS not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CNS)) DEALLOCATE(OutData%CNS) - ALLOCATE(OutData%CNS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CNS,2), UBOUND(OutData%CNS,2) - DO i1 = LBOUND(OutData%CNS,1), UBOUND(OutData%CNS,1) - OutData%CNS(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNSL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CNSL)) DEALLOCATE(OutData%CNSL) - ALLOCATE(OutData%CNSL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNSL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CNSL,2), UBOUND(OutData%CNSL,2) - DO i1 = LBOUND(OutData%CNSL,1), UBOUND(OutData%CNSL,1) - OutData%CNSL(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNV not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CNV)) DEALLOCATE(OutData%CNV) - ALLOCATE(OutData%CNV(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CNV,2), UBOUND(OutData%CNV,2) - DO i1 = LBOUND(OutData%CNV,1), UBOUND(OutData%CNV,1) - OutData%CNV(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CVN not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CVN)) DEALLOCATE(OutData%CVN) - ALLOCATE(OutData%CVN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CVN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CVN,2), UBOUND(OutData%CVN,2) - DO i1 = LBOUND(OutData%CVN,1), UBOUND(OutData%CVN,1) - OutData%CVN(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CVN1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CVN1)) DEALLOCATE(OutData%CVN1) - ALLOCATE(OutData%CVN1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CVN1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CVN1,2), UBOUND(OutData%CVN1,2) - DO i1 = LBOUND(OutData%CVN1,1), UBOUND(OutData%CVN1,1) - OutData%CVN1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DF not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DF)) DEALLOCATE(OutData%DF) - ALLOCATE(OutData%DF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%DF,2), UBOUND(OutData%DF,2) - DO i1 = LBOUND(OutData%DF,1), UBOUND(OutData%DF,1) - OutData%DF(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DFAFE not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DFAFE)) DEALLOCATE(OutData%DFAFE) - ALLOCATE(OutData%DFAFE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DFAFE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%DFAFE,2), UBOUND(OutData%DFAFE,2) - DO i1 = LBOUND(OutData%DFAFE,1), UBOUND(OutData%DFAFE,1) - OutData%DFAFE(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DFAFE1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DFAFE1)) DEALLOCATE(OutData%DFAFE1) - ALLOCATE(OutData%DFAFE1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DFAFE1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%DFAFE1,2), UBOUND(OutData%DFAFE1,2) - DO i1 = LBOUND(OutData%DFAFE1,1), UBOUND(OutData%DFAFE1,1) - OutData%DFAFE1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DFC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DFC)) DEALLOCATE(OutData%DFC) - ALLOCATE(OutData%DFC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DFC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%DFC,2), UBOUND(OutData%DFC,2) - DO i1 = LBOUND(OutData%DFC,1), UBOUND(OutData%DFC,1) - OutData%DFC(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DN not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DN)) DEALLOCATE(OutData%DN) - ALLOCATE(OutData%DN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%DN,2), UBOUND(OutData%DN,2) - DO i1 = LBOUND(OutData%DN,1), UBOUND(OutData%DN,1) - OutData%DN(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DPP not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DPP)) DEALLOCATE(OutData%DPP) - ALLOCATE(OutData%DPP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DPP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%DPP,2), UBOUND(OutData%DPP,2) - DO i1 = LBOUND(OutData%DPP,1), UBOUND(OutData%DPP,1) - OutData%DPP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DQ not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DQ)) DEALLOCATE(OutData%DQ) - ALLOCATE(OutData%DQ(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DQ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%DQ,2), UBOUND(OutData%DQ,2) - DO i1 = LBOUND(OutData%DQ,1), UBOUND(OutData%DQ,1) - OutData%DQ(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DQP not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DQP)) DEALLOCATE(OutData%DQP) - ALLOCATE(OutData%DQP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DQP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%DQP,2), UBOUND(OutData%DQP,2) - DO i1 = LBOUND(OutData%DQP,1), UBOUND(OutData%DQP,1) - OutData%DQP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DQP1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DQP1)) DEALLOCATE(OutData%DQP1) - ALLOCATE(OutData%DQP1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DQP1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%DQP1,2), UBOUND(OutData%DQP1,2) - DO i1 = LBOUND(OutData%DQP1,1), UBOUND(OutData%DQP1,1) - OutData%DQP1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%DS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%FK = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%FP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%FPC = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FSP not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FSP)) DEALLOCATE(OutData%FSP) - ALLOCATE(OutData%FSP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FSP,2), UBOUND(OutData%FSP,2) - DO i1 = LBOUND(OutData%FSP,1), UBOUND(OutData%FSP,1) - OutData%FSP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FSP1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FSP1)) DEALLOCATE(OutData%FSP1) - ALLOCATE(OutData%FSP1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSP1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FSP1,2), UBOUND(OutData%FSP1,2) - DO i1 = LBOUND(OutData%FSP1,1), UBOUND(OutData%FSP1,1) - OutData%FSP1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FSPC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FSPC)) DEALLOCATE(OutData%FSPC) - ALLOCATE(OutData%FSPC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSPC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FSPC,2), UBOUND(OutData%FSPC,2) - DO i1 = LBOUND(OutData%FSPC,1), UBOUND(OutData%FSPC,1) - OutData%FSPC(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FSPC1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FSPC1)) DEALLOCATE(OutData%FSPC1) - ALLOCATE(OutData%FSPC1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSPC1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FSPC1,2), UBOUND(OutData%FSPC1,2) - DO i1 = LBOUND(OutData%FSPC1,1), UBOUND(OutData%FSPC1,1) - OutData%FSPC1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FTB not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FTB)) DEALLOCATE(OutData%FTB) - ALLOCATE(OutData%FTB(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FTB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%FTB,3), UBOUND(OutData%FTB,3) - DO i2 = LBOUND(OutData%FTB,2), UBOUND(OutData%FTB,2) - DO i1 = LBOUND(OutData%FTB,1), UBOUND(OutData%FTB,1) - OutData%FTB(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FTBC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FTBC)) DEALLOCATE(OutData%FTBC) - ALLOCATE(OutData%FTBC(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FTBC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%FTBC,3), UBOUND(OutData%FTBC,3) - DO i2 = LBOUND(OutData%FTBC,2), UBOUND(OutData%FTBC,2) - DO i1 = LBOUND(OutData%FTBC,1), UBOUND(OutData%FTBC,1) - OutData%FTBC(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDCNV not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OLDCNV)) DEALLOCATE(OutData%OLDCNV) - ALLOCATE(OutData%OLDCNV(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDCNV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OLDCNV,2), UBOUND(OutData%OLDCNV,2) - DO i1 = LBOUND(OutData%OLDCNV,1), UBOUND(OutData%OLDCNV,1) - OutData%OLDCNV(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDDF not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OLDDF)) DEALLOCATE(OutData%OLDDF) - ALLOCATE(OutData%OLDDF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDDF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OLDDF,2), UBOUND(OutData%OLDDF,2) - DO i1 = LBOUND(OutData%OLDDF,1), UBOUND(OutData%OLDDF,1) - OutData%OLDDF(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDDFC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OLDDFC)) DEALLOCATE(OutData%OLDDFC) - ALLOCATE(OutData%OLDDFC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDDFC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OLDDFC,2), UBOUND(OutData%OLDDFC,2) - DO i1 = LBOUND(OutData%OLDDFC,1), UBOUND(OutData%OLDDFC,1) - OutData%OLDDFC(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDDN not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OLDDN)) DEALLOCATE(OutData%OLDDN) - ALLOCATE(OutData%OLDDN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDDN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OLDDN,2), UBOUND(OutData%OLDDN,2) - DO i1 = LBOUND(OutData%OLDDN,1), UBOUND(OutData%OLDDN,1) - OutData%OLDDN(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDDPP not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OLDDPP)) DEALLOCATE(OutData%OLDDPP) - ALLOCATE(OutData%OLDDPP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDDPP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OLDDPP,2), UBOUND(OutData%OLDDPP,2) - DO i1 = LBOUND(OutData%OLDDPP,1), UBOUND(OutData%OLDDPP,1) - OutData%OLDDPP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDDQ not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OLDDQ)) DEALLOCATE(OutData%OLDDQ) - ALLOCATE(OutData%OLDDQ(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDDQ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OLDDQ,2), UBOUND(OutData%OLDDQ,2) - DO i1 = LBOUND(OutData%OLDDQ,1), UBOUND(OutData%OLDDQ,1) - OutData%OLDDQ(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDTAU not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OLDTAU)) DEALLOCATE(OutData%OLDTAU) - ALLOCATE(OutData%OLDTAU(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDTAU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OLDTAU,2), UBOUND(OutData%OLDTAU,2) - DO i1 = LBOUND(OutData%OLDTAU,1), UBOUND(OutData%OLDTAU,1) - OutData%OLDTAU(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDXN not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OLDXN)) DEALLOCATE(OutData%OLDXN) - ALLOCATE(OutData%OLDXN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDXN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OLDXN,2), UBOUND(OutData%OLDXN,2) - DO i1 = LBOUND(OutData%OLDXN,1), UBOUND(OutData%OLDXN,1) - OutData%OLDXN(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDYN not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OLDYN)) DEALLOCATE(OutData%OLDYN) - ALLOCATE(OutData%OLDYN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDYN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OLDYN,2), UBOUND(OutData%OLDYN,2) - DO i1 = LBOUND(OutData%OLDYN,1), UBOUND(OutData%OLDYN,1) - OutData%OLDYN(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QX not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%QX)) DEALLOCATE(OutData%QX) - ALLOCATE(OutData%QX(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%QX,2), UBOUND(OutData%QX,2) - DO i1 = LBOUND(OutData%QX,1), UBOUND(OutData%QX,1) - OutData%QX(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QX1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%QX1)) DEALLOCATE(OutData%QX1) - ALLOCATE(OutData%QX1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QX1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%QX1,2), UBOUND(OutData%QX1,2) - DO i1 = LBOUND(OutData%QX1,1), UBOUND(OutData%QX1,1) - OutData%QX1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TAU not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TAU)) DEALLOCATE(OutData%TAU) - ALLOCATE(OutData%TAU(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TAU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TAU,2), UBOUND(OutData%TAU,2) - DO i1 = LBOUND(OutData%TAU,1), UBOUND(OutData%TAU,1) - OutData%TAU(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! XN not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%XN)) DEALLOCATE(OutData%XN) - ALLOCATE(OutData%XN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%XN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%XN,2), UBOUND(OutData%XN,2) - DO i1 = LBOUND(OutData%XN,1), UBOUND(OutData%XN,1) - OutData%XN(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! YN not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%YN)) DEALLOCATE(OutData%YN) - ALLOCATE(OutData%YN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%YN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%YN,2), UBOUND(OutData%YN,2) - DO i1 = LBOUND(OutData%YN,1), UBOUND(OutData%YN,1) - OutData%YN(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%SHIFT = TRANSFER(IntKiBuf(Int_Xferred), OutData%SHIFT) - Int_Xferred = Int_Xferred + 1 - OutData%VOR = TRANSFER(IntKiBuf(Int_Xferred), OutData%VOR) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD14_UnPackBeddoes - - SUBROUTINE AD14_CopyBeddoesParms( SrcBeddoesParmsData, DstBeddoesParmsData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BeddoesParms), INTENT(IN) :: SrcBeddoesParmsData - TYPE(BeddoesParms), INTENT(INOUT) :: DstBeddoesParmsData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_CopyBeddoesParms' -! - ErrStat = ErrID_None - ErrMsg = "" - DstBeddoesParmsData%AS = SrcBeddoesParmsData%AS - DstBeddoesParmsData%TF = SrcBeddoesParmsData%TF - DstBeddoesParmsData%TP = SrcBeddoesParmsData%TP - DstBeddoesParmsData%TV = SrcBeddoesParmsData%TV - DstBeddoesParmsData%TVL = SrcBeddoesParmsData%TVL - END SUBROUTINE AD14_CopyBeddoesParms - - SUBROUTINE AD14_DestroyBeddoesParms( BeddoesParmsData, ErrStat, ErrMsg ) - TYPE(BeddoesParms), INTENT(INOUT) :: BeddoesParmsData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyBeddoesParms' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE AD14_DestroyBeddoesParms - - SUBROUTINE AD14_PackBeddoesParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(BeddoesParms), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_PackBeddoesParms' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! AS - Re_BufSz = Re_BufSz + 1 ! TF - Re_BufSz = Re_BufSz + 1 ! TP - Re_BufSz = Re_BufSz + 1 ! TV - Re_BufSz = Re_BufSz + 1 ! TVL - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%AS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TF - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TV - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TVL - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_PackBeddoesParms - - SUBROUTINE AD14_UnPackBeddoesParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(BeddoesParms), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackBeddoesParms' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%AS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TF = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TV = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TVL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_UnPackBeddoesParms +subroutine AD14_PackBeddoesParms(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BeddoesParms), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackBeddoesParms' + if (Buf%ErrStat >= AbortErrLev) return + ! AS + call RegPack(Buf, InData%AS) + if (RegCheckErr(Buf, RoutineName)) return + ! TF + call RegPack(Buf, InData%TF) + if (RegCheckErr(Buf, RoutineName)) return + ! TP + call RegPack(Buf, InData%TP) + if (RegCheckErr(Buf, RoutineName)) return + ! TV + call RegPack(Buf, InData%TV) + if (RegCheckErr(Buf, RoutineName)) return + ! TVL + call RegPack(Buf, InData%TVL) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackBeddoesParms(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BeddoesParms), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackBeddoesParms' + if (Buf%ErrStat /= ErrID_None) return + ! AS + call RegUnpack(Buf, OutData%AS) + if (RegCheckErr(Buf, RoutineName)) return + ! TF + call RegUnpack(Buf, OutData%TF) + if (RegCheckErr(Buf, RoutineName)) return + ! TP + call RegUnpack(Buf, OutData%TP) + if (RegCheckErr(Buf, RoutineName)) return + ! TV + call RegUnpack(Buf, OutData%TV) + if (RegCheckErr(Buf, RoutineName)) return + ! TVL + call RegUnpack(Buf, OutData%TVL) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE AD14_CopyBladeParms( SrcBladeParmsData, DstBladeParmsData, CtrlCode, ErrStat, ErrMsg ) TYPE(BladeParms), INTENT(IN) :: SrcBladeParmsData TYPE(BladeParms), INTENT(INOUT) :: DstBladeParmsData @@ -6247,185 +3527,79 @@ SUBROUTINE AD14_DestroyBladeParms( BladeParmsData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE AD14_DestroyBladeParms - SUBROUTINE AD14_PackBladeParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(BladeParms), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_PackBladeParms' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! C allocated yes/no - IF ( ALLOCATED(InData%C) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! C upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%C) ! C - END IF - Int_BufSz = Int_BufSz + 1 ! DR allocated yes/no - IF ( ALLOCATED(InData%DR) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DR upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DR) ! DR - END IF - Re_BufSz = Re_BufSz + 1 ! R - Re_BufSz = Re_BufSz + 1 ! BladeLength - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%C) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%C,1), UBOUND(InData%C,1) - ReKiBuf(Re_Xferred) = InData%C(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DR) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DR,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DR,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DR,1), UBOUND(InData%DR,1) - ReKiBuf(Re_Xferred) = InData%DR(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%R - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%BladeLength - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_PackBladeParms - - SUBROUTINE AD14_UnPackBladeParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(BladeParms), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackBladeParms' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%C)) DEALLOCATE(OutData%C) - ALLOCATE(OutData%C(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%C,1), UBOUND(OutData%C,1) - OutData%C(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DR not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DR)) DEALLOCATE(OutData%DR) - ALLOCATE(OutData%DR(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DR.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DR,1), UBOUND(OutData%DR,1) - OutData%DR(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%R = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%BladeLength = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_UnPackBladeParms +subroutine AD14_PackBladeParms(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BladeParms), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackBladeParms' + if (Buf%ErrStat >= AbortErrLev) return + ! C + call RegPack(Buf, allocated(InData%C)) + if (allocated(InData%C)) then + call RegPackBounds(Buf, 1, lbound(InData%C), ubound(InData%C)) + call RegPack(Buf, InData%C) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DR + call RegPack(Buf, allocated(InData%DR)) + if (allocated(InData%DR)) then + call RegPackBounds(Buf, 1, lbound(InData%DR), ubound(InData%DR)) + call RegPack(Buf, InData%DR) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! R + call RegPack(Buf, InData%R) + if (RegCheckErr(Buf, RoutineName)) return + ! BladeLength + call RegPack(Buf, InData%BladeLength) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackBladeParms(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BladeParms), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackBladeParms' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! C + if (allocated(OutData%C)) deallocate(OutData%C) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%C(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%C.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%C) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! DR + if (allocated(OutData%DR)) deallocate(OutData%DR) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DR(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DR.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DR) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! R + call RegUnpack(Buf, OutData%R) + if (RegCheckErr(Buf, RoutineName)) return + ! BladeLength + call RegUnpack(Buf, OutData%BladeLength) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE AD14_CopyDynInflow( SrcDynInflowData, DstDynInflowData, CtrlCode, ErrStat, ErrMsg ) TYPE(DynInflow), INTENT(IN) :: SrcDynInflowData TYPE(DynInflow), INTENT(INOUT) :: DstDynInflowData @@ -6522,469 +3696,211 @@ SUBROUTINE AD14_DestroyDynInflow( DynInflowData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE AD14_DestroyDynInflow - SUBROUTINE AD14_PackDynInflow( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(DynInflow), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_PackDynInflow' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + SIZE(InData%dAlph_dt) ! dAlph_dt - Re_BufSz = Re_BufSz + SIZE(InData%dBeta_dt) ! dBeta_dt - Re_BufSz = Re_BufSz + 1 ! DTO - Re_BufSz = Re_BufSz + SIZE(InData%old_Alph) ! old_Alph - Re_BufSz = Re_BufSz + SIZE(InData%old_Beta) ! old_Beta - Re_BufSz = Re_BufSz + 1 ! old_LmdM - Re_BufSz = Re_BufSz + 1 ! oldKai - Re_BufSz = Re_BufSz + SIZE(InData%PhiLqC) ! PhiLqC - Re_BufSz = Re_BufSz + SIZE(InData%PhiLqS) ! PhiLqS - Re_BufSz = Re_BufSz + 1 ! Pzero - Int_BufSz = Int_BufSz + 1 ! RMC_SAVE allocated yes/no - IF ( ALLOCATED(InData%RMC_SAVE) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! RMC_SAVE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%RMC_SAVE) ! RMC_SAVE - END IF - Int_BufSz = Int_BufSz + 1 ! RMS_SAVE allocated yes/no - IF ( ALLOCATED(InData%RMS_SAVE) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! RMS_SAVE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%RMS_SAVE) ! RMS_SAVE - END IF - Re_BufSz = Re_BufSz + 1 ! TipSpeed - Re_BufSz = Re_BufSz + 1 ! totalInf - Re_BufSz = Re_BufSz + 1 ! Vparam - Re_BufSz = Re_BufSz + 1 ! Vtotal - Re_BufSz = Re_BufSz + SIZE(InData%xAlpha) ! xAlpha - Re_BufSz = Re_BufSz + SIZE(InData%xBeta) ! xBeta - Re_BufSz = Re_BufSz + 1 ! xKai - Re_BufSz = Re_BufSz + 1 ! XLAMBDA_M - Re_BufSz = Re_BufSz + SIZE(InData%xLcos) ! xLcos - Re_BufSz = Re_BufSz + SIZE(InData%xLsin) ! xLsin - Int_BufSz = Int_BufSz + SIZE(InData%MminR) ! MminR - Int_BufSz = Int_BufSz + SIZE(InData%MminusR) ! MminusR - Int_BufSz = Int_BufSz + SIZE(InData%MplusR) ! MplusR - Re_BufSz = Re_BufSz + SIZE(InData%GAMMA) ! GAMMA - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i2 = LBOUND(InData%dAlph_dt,2), UBOUND(InData%dAlph_dt,2) - DO i1 = LBOUND(InData%dAlph_dt,1), UBOUND(InData%dAlph_dt,1) - ReKiBuf(Re_Xferred) = InData%dAlph_dt(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%dBeta_dt,2), UBOUND(InData%dBeta_dt,2) - DO i1 = LBOUND(InData%dBeta_dt,1), UBOUND(InData%dBeta_dt,1) - ReKiBuf(Re_Xferred) = InData%dBeta_dt(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - ReKiBuf(Re_Xferred) = InData%DTO - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%old_Alph,1), UBOUND(InData%old_Alph,1) - ReKiBuf(Re_Xferred) = InData%old_Alph(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%old_Beta,1), UBOUND(InData%old_Beta,1) - ReKiBuf(Re_Xferred) = InData%old_Beta(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%old_LmdM - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%oldKai - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%PhiLqC,1), UBOUND(InData%PhiLqC,1) - ReKiBuf(Re_Xferred) = InData%PhiLqC(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%PhiLqS,1), UBOUND(InData%PhiLqS,1) - ReKiBuf(Re_Xferred) = InData%PhiLqS(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%Pzero - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%RMC_SAVE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RMC_SAVE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RMC_SAVE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RMC_SAVE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RMC_SAVE,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RMC_SAVE,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RMC_SAVE,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%RMC_SAVE,3), UBOUND(InData%RMC_SAVE,3) - DO i2 = LBOUND(InData%RMC_SAVE,2), UBOUND(InData%RMC_SAVE,2) - DO i1 = LBOUND(InData%RMC_SAVE,1), UBOUND(InData%RMC_SAVE,1) - ReKiBuf(Re_Xferred) = InData%RMC_SAVE(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RMS_SAVE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RMS_SAVE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RMS_SAVE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RMS_SAVE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RMS_SAVE,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RMS_SAVE,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RMS_SAVE,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%RMS_SAVE,3), UBOUND(InData%RMS_SAVE,3) - DO i2 = LBOUND(InData%RMS_SAVE,2), UBOUND(InData%RMS_SAVE,2) - DO i1 = LBOUND(InData%RMS_SAVE,1), UBOUND(InData%RMS_SAVE,1) - ReKiBuf(Re_Xferred) = InData%RMS_SAVE(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%TipSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%totalInf - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Vparam - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Vtotal - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%xAlpha,1), UBOUND(InData%xAlpha,1) - ReKiBuf(Re_Xferred) = InData%xAlpha(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%xBeta,1), UBOUND(InData%xBeta,1) - ReKiBuf(Re_Xferred) = InData%xBeta(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%xKai - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%XLAMBDA_M - Re_Xferred = Re_Xferred + 1 - DO i2 = LBOUND(InData%xLcos,2), UBOUND(InData%xLcos,2) - DO i1 = LBOUND(InData%xLcos,1), UBOUND(InData%xLcos,1) - ReKiBuf(Re_Xferred) = InData%xLcos(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%xLsin,2), UBOUND(InData%xLsin,2) - DO i1 = LBOUND(InData%xLsin,1), UBOUND(InData%xLsin,1) - ReKiBuf(Re_Xferred) = InData%xLsin(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%MminR,2), UBOUND(InData%MminR,2) - DO i1 = LBOUND(InData%MminR,1), UBOUND(InData%MminR,1) - IntKiBuf(Int_Xferred) = InData%MminR(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%MminusR,2), UBOUND(InData%MminusR,2) - DO i1 = LBOUND(InData%MminusR,1), UBOUND(InData%MminusR,1) - IntKiBuf(Int_Xferred) = InData%MminusR(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%MplusR,2), UBOUND(InData%MplusR,2) - DO i1 = LBOUND(InData%MplusR,1), UBOUND(InData%MplusR,1) - IntKiBuf(Int_Xferred) = InData%MplusR(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%GAMMA,2), UBOUND(InData%GAMMA,2) - DO i1 = LBOUND(InData%GAMMA,1), UBOUND(InData%GAMMA,1) - ReKiBuf(Re_Xferred) = InData%GAMMA(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END SUBROUTINE AD14_PackDynInflow - - SUBROUTINE AD14_UnPackDynInflow( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(DynInflow), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackDynInflow' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%dAlph_dt,1) - i1_u = UBOUND(OutData%dAlph_dt,1) - i2_l = LBOUND(OutData%dAlph_dt,2) - i2_u = UBOUND(OutData%dAlph_dt,2) - DO i2 = LBOUND(OutData%dAlph_dt,2), UBOUND(OutData%dAlph_dt,2) - DO i1 = LBOUND(OutData%dAlph_dt,1), UBOUND(OutData%dAlph_dt,1) - OutData%dAlph_dt(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%dBeta_dt,1) - i1_u = UBOUND(OutData%dBeta_dt,1) - i2_l = LBOUND(OutData%dBeta_dt,2) - i2_u = UBOUND(OutData%dBeta_dt,2) - DO i2 = LBOUND(OutData%dBeta_dt,2), UBOUND(OutData%dBeta_dt,2) - DO i1 = LBOUND(OutData%dBeta_dt,1), UBOUND(OutData%dBeta_dt,1) - OutData%dBeta_dt(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - OutData%DTO = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%old_Alph,1) - i1_u = UBOUND(OutData%old_Alph,1) - DO i1 = LBOUND(OutData%old_Alph,1), UBOUND(OutData%old_Alph,1) - OutData%old_Alph(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%old_Beta,1) - i1_u = UBOUND(OutData%old_Beta,1) - DO i1 = LBOUND(OutData%old_Beta,1), UBOUND(OutData%old_Beta,1) - OutData%old_Beta(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%old_LmdM = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%oldKai = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%PhiLqC,1) - i1_u = UBOUND(OutData%PhiLqC,1) - DO i1 = LBOUND(OutData%PhiLqC,1), UBOUND(OutData%PhiLqC,1) - OutData%PhiLqC(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%PhiLqS,1) - i1_u = UBOUND(OutData%PhiLqS,1) - DO i1 = LBOUND(OutData%PhiLqS,1), UBOUND(OutData%PhiLqS,1) - OutData%PhiLqS(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%Pzero = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RMC_SAVE not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RMC_SAVE)) DEALLOCATE(OutData%RMC_SAVE) - ALLOCATE(OutData%RMC_SAVE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RMC_SAVE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%RMC_SAVE,3), UBOUND(OutData%RMC_SAVE,3) - DO i2 = LBOUND(OutData%RMC_SAVE,2), UBOUND(OutData%RMC_SAVE,2) - DO i1 = LBOUND(OutData%RMC_SAVE,1), UBOUND(OutData%RMC_SAVE,1) - OutData%RMC_SAVE(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RMS_SAVE not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RMS_SAVE)) DEALLOCATE(OutData%RMS_SAVE) - ALLOCATE(OutData%RMS_SAVE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RMS_SAVE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%RMS_SAVE,3), UBOUND(OutData%RMS_SAVE,3) - DO i2 = LBOUND(OutData%RMS_SAVE,2), UBOUND(OutData%RMS_SAVE,2) - DO i1 = LBOUND(OutData%RMS_SAVE,1), UBOUND(OutData%RMS_SAVE,1) - OutData%RMS_SAVE(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%TipSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%totalInf = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Vparam = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Vtotal = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%xAlpha,1) - i1_u = UBOUND(OutData%xAlpha,1) - DO i1 = LBOUND(OutData%xAlpha,1), UBOUND(OutData%xAlpha,1) - OutData%xAlpha(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%xBeta,1) - i1_u = UBOUND(OutData%xBeta,1) - DO i1 = LBOUND(OutData%xBeta,1), UBOUND(OutData%xBeta,1) - OutData%xBeta(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%xKai = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%XLAMBDA_M = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%xLcos,1) - i1_u = UBOUND(OutData%xLcos,1) - i2_l = LBOUND(OutData%xLcos,2) - i2_u = UBOUND(OutData%xLcos,2) - DO i2 = LBOUND(OutData%xLcos,2), UBOUND(OutData%xLcos,2) - DO i1 = LBOUND(OutData%xLcos,1), UBOUND(OutData%xLcos,1) - OutData%xLcos(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%xLsin,1) - i1_u = UBOUND(OutData%xLsin,1) - i2_l = LBOUND(OutData%xLsin,2) - i2_u = UBOUND(OutData%xLsin,2) - DO i2 = LBOUND(OutData%xLsin,2), UBOUND(OutData%xLsin,2) - DO i1 = LBOUND(OutData%xLsin,1), UBOUND(OutData%xLsin,1) - OutData%xLsin(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%MminR,1) - i1_u = UBOUND(OutData%MminR,1) - i2_l = LBOUND(OutData%MminR,2) - i2_u = UBOUND(OutData%MminR,2) - DO i2 = LBOUND(OutData%MminR,2), UBOUND(OutData%MminR,2) - DO i1 = LBOUND(OutData%MminR,1), UBOUND(OutData%MminR,1) - OutData%MminR(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%MminusR,1) - i1_u = UBOUND(OutData%MminusR,1) - i2_l = LBOUND(OutData%MminusR,2) - i2_u = UBOUND(OutData%MminusR,2) - DO i2 = LBOUND(OutData%MminusR,2), UBOUND(OutData%MminusR,2) - DO i1 = LBOUND(OutData%MminusR,1), UBOUND(OutData%MminusR,1) - OutData%MminusR(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%MplusR,1) - i1_u = UBOUND(OutData%MplusR,1) - i2_l = LBOUND(OutData%MplusR,2) - i2_u = UBOUND(OutData%MplusR,2) - DO i2 = LBOUND(OutData%MplusR,2), UBOUND(OutData%MplusR,2) - DO i1 = LBOUND(OutData%MplusR,1), UBOUND(OutData%MplusR,1) - OutData%MplusR(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%GAMMA,1) - i1_u = UBOUND(OutData%GAMMA,1) - i2_l = LBOUND(OutData%GAMMA,2) - i2_u = UBOUND(OutData%GAMMA,2) - DO i2 = LBOUND(OutData%GAMMA,2), UBOUND(OutData%GAMMA,2) - DO i1 = LBOUND(OutData%GAMMA,1), UBOUND(OutData%GAMMA,1) - OutData%GAMMA(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END SUBROUTINE AD14_UnPackDynInflow +subroutine AD14_PackDynInflow(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DynInflow), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackDynInflow' + if (Buf%ErrStat >= AbortErrLev) return + ! dAlph_dt + call RegPack(Buf, InData%dAlph_dt) + if (RegCheckErr(Buf, RoutineName)) return + ! dBeta_dt + call RegPack(Buf, InData%dBeta_dt) + if (RegCheckErr(Buf, RoutineName)) return + ! DTO + call RegPack(Buf, InData%DTO) + if (RegCheckErr(Buf, RoutineName)) return + ! old_Alph + call RegPack(Buf, InData%old_Alph) + if (RegCheckErr(Buf, RoutineName)) return + ! old_Beta + call RegPack(Buf, InData%old_Beta) + if (RegCheckErr(Buf, RoutineName)) return + ! old_LmdM + call RegPack(Buf, InData%old_LmdM) + if (RegCheckErr(Buf, RoutineName)) return + ! oldKai + call RegPack(Buf, InData%oldKai) + if (RegCheckErr(Buf, RoutineName)) return + ! PhiLqC + call RegPack(Buf, InData%PhiLqC) + if (RegCheckErr(Buf, RoutineName)) return + ! PhiLqS + call RegPack(Buf, InData%PhiLqS) + if (RegCheckErr(Buf, RoutineName)) return + ! Pzero + call RegPack(Buf, InData%Pzero) + if (RegCheckErr(Buf, RoutineName)) return + ! RMC_SAVE + call RegPack(Buf, allocated(InData%RMC_SAVE)) + if (allocated(InData%RMC_SAVE)) then + call RegPackBounds(Buf, 3, lbound(InData%RMC_SAVE), ubound(InData%RMC_SAVE)) + call RegPack(Buf, InData%RMC_SAVE) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RMS_SAVE + call RegPack(Buf, allocated(InData%RMS_SAVE)) + if (allocated(InData%RMS_SAVE)) then + call RegPackBounds(Buf, 3, lbound(InData%RMS_SAVE), ubound(InData%RMS_SAVE)) + call RegPack(Buf, InData%RMS_SAVE) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TipSpeed + call RegPack(Buf, InData%TipSpeed) + if (RegCheckErr(Buf, RoutineName)) return + ! totalInf + call RegPack(Buf, InData%totalInf) + if (RegCheckErr(Buf, RoutineName)) return + ! Vparam + call RegPack(Buf, InData%Vparam) + if (RegCheckErr(Buf, RoutineName)) return + ! Vtotal + call RegPack(Buf, InData%Vtotal) + if (RegCheckErr(Buf, RoutineName)) return + ! xAlpha + call RegPack(Buf, InData%xAlpha) + if (RegCheckErr(Buf, RoutineName)) return + ! xBeta + call RegPack(Buf, InData%xBeta) + if (RegCheckErr(Buf, RoutineName)) return + ! xKai + call RegPack(Buf, InData%xKai) + if (RegCheckErr(Buf, RoutineName)) return + ! XLAMBDA_M + call RegPack(Buf, InData%XLAMBDA_M) + if (RegCheckErr(Buf, RoutineName)) return + ! xLcos + call RegPack(Buf, InData%xLcos) + if (RegCheckErr(Buf, RoutineName)) return + ! xLsin + call RegPack(Buf, InData%xLsin) + if (RegCheckErr(Buf, RoutineName)) return + ! MminR + call RegPack(Buf, InData%MminR) + if (RegCheckErr(Buf, RoutineName)) return + ! MminusR + call RegPack(Buf, InData%MminusR) + if (RegCheckErr(Buf, RoutineName)) return + ! MplusR + call RegPack(Buf, InData%MplusR) + if (RegCheckErr(Buf, RoutineName)) return + ! GAMMA + call RegPack(Buf, InData%GAMMA) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackDynInflow(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DynInflow), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackDynInflow' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! dAlph_dt + call RegUnpack(Buf, OutData%dAlph_dt) + if (RegCheckErr(Buf, RoutineName)) return + ! dBeta_dt + call RegUnpack(Buf, OutData%dBeta_dt) + if (RegCheckErr(Buf, RoutineName)) return + ! DTO + call RegUnpack(Buf, OutData%DTO) + if (RegCheckErr(Buf, RoutineName)) return + ! old_Alph + call RegUnpack(Buf, OutData%old_Alph) + if (RegCheckErr(Buf, RoutineName)) return + ! old_Beta + call RegUnpack(Buf, OutData%old_Beta) + if (RegCheckErr(Buf, RoutineName)) return + ! old_LmdM + call RegUnpack(Buf, OutData%old_LmdM) + if (RegCheckErr(Buf, RoutineName)) return + ! oldKai + call RegUnpack(Buf, OutData%oldKai) + if (RegCheckErr(Buf, RoutineName)) return + ! PhiLqC + call RegUnpack(Buf, OutData%PhiLqC) + if (RegCheckErr(Buf, RoutineName)) return + ! PhiLqS + call RegUnpack(Buf, OutData%PhiLqS) + if (RegCheckErr(Buf, RoutineName)) return + ! Pzero + call RegUnpack(Buf, OutData%Pzero) + if (RegCheckErr(Buf, RoutineName)) return + ! RMC_SAVE + if (allocated(OutData%RMC_SAVE)) deallocate(OutData%RMC_SAVE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RMC_SAVE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RMC_SAVE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RMC_SAVE) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RMS_SAVE + if (allocated(OutData%RMS_SAVE)) deallocate(OutData%RMS_SAVE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RMS_SAVE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RMS_SAVE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RMS_SAVE) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TipSpeed + call RegUnpack(Buf, OutData%TipSpeed) + if (RegCheckErr(Buf, RoutineName)) return + ! totalInf + call RegUnpack(Buf, OutData%totalInf) + if (RegCheckErr(Buf, RoutineName)) return + ! Vparam + call RegUnpack(Buf, OutData%Vparam) + if (RegCheckErr(Buf, RoutineName)) return + ! Vtotal + call RegUnpack(Buf, OutData%Vtotal) + if (RegCheckErr(Buf, RoutineName)) return + ! xAlpha + call RegUnpack(Buf, OutData%xAlpha) + if (RegCheckErr(Buf, RoutineName)) return + ! xBeta + call RegUnpack(Buf, OutData%xBeta) + if (RegCheckErr(Buf, RoutineName)) return + ! xKai + call RegUnpack(Buf, OutData%xKai) + if (RegCheckErr(Buf, RoutineName)) return + ! XLAMBDA_M + call RegUnpack(Buf, OutData%XLAMBDA_M) + if (RegCheckErr(Buf, RoutineName)) return + ! xLcos + call RegUnpack(Buf, OutData%xLcos) + if (RegCheckErr(Buf, RoutineName)) return + ! xLsin + call RegUnpack(Buf, OutData%xLsin) + if (RegCheckErr(Buf, RoutineName)) return + ! MminR + call RegUnpack(Buf, OutData%MminR) + if (RegCheckErr(Buf, RoutineName)) return + ! MminusR + call RegUnpack(Buf, OutData%MminusR) + if (RegCheckErr(Buf, RoutineName)) return + ! MplusR + call RegUnpack(Buf, OutData%MplusR) + if (RegCheckErr(Buf, RoutineName)) return + ! GAMMA + call RegUnpack(Buf, OutData%GAMMA) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE AD14_CopyDynInflowParms( SrcDynInflowParmsData, DstDynInflowParmsData, CtrlCode, ErrStat, ErrMsg ) TYPE(DynInflowParms), INTENT(IN) :: SrcDynInflowParmsData TYPE(DynInflowParms), INTENT(INOUT) :: DstDynInflowParmsData @@ -7019,115 +3935,32 @@ SUBROUTINE AD14_DestroyDynInflowParms( DynInflowParmsData, ErrStat, ErrMsg ) END SUBROUTINE AD14_DestroyDynInflowParms - SUBROUTINE AD14_PackDynInflowParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(DynInflowParms), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_PackDynInflowParms' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! MAXINFLO - Re_BufSz = Re_BufSz + SIZE(InData%xMinv) ! xMinv - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%MAXINFLO - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%xMinv,1), UBOUND(InData%xMinv,1) - ReKiBuf(Re_Xferred) = InData%xMinv(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE AD14_PackDynInflowParms - - SUBROUTINE AD14_UnPackDynInflowParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(DynInflowParms), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackDynInflowParms' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%MAXINFLO = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%xMinv,1) - i1_u = UBOUND(OutData%xMinv,1) - DO i1 = LBOUND(OutData%xMinv,1), UBOUND(OutData%xMinv,1) - OutData%xMinv(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE AD14_UnPackDynInflowParms +subroutine AD14_PackDynInflowParms(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DynInflowParms), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackDynInflowParms' + if (Buf%ErrStat >= AbortErrLev) return + ! MAXINFLO + call RegPack(Buf, InData%MAXINFLO) + if (RegCheckErr(Buf, RoutineName)) return + ! xMinv + call RegPack(Buf, InData%xMinv) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackDynInflowParms(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DynInflowParms), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackDynInflowParms' + if (Buf%ErrStat /= ErrID_None) return + ! MAXINFLO + call RegUnpack(Buf, OutData%MAXINFLO) + if (RegCheckErr(Buf, RoutineName)) return + ! xMinv + call RegUnpack(Buf, OutData%xMinv) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE AD14_CopyElement( SrcElementData, DstElementData, CtrlCode, ErrStat, ErrMsg ) TYPE(Element), INTENT(IN) :: SrcElementData TYPE(Element), INTENT(INOUT) :: DstElementData @@ -7234,482 +4067,223 @@ SUBROUTINE AD14_CopyElement( SrcElementData, DstElementData, CtrlCode, ErrStat, i2_l = LBOUND(SrcElementData%PITNOW,2) i2_u = UBOUND(SrcElementData%PITNOW,2) IF (.NOT. ALLOCATED(DstElementData%PITNOW)) THEN - ALLOCATE(DstElementData%PITNOW(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElementData%PITNOW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElementData%PITNOW = SrcElementData%PITNOW -ENDIF - END SUBROUTINE AD14_CopyElement - - SUBROUTINE AD14_DestroyElement( ElementData, ErrStat, ErrMsg ) - TYPE(Element), INTENT(INOUT) :: ElementData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyElement' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ElementData%A)) THEN - DEALLOCATE(ElementData%A) -ENDIF -IF (ALLOCATED(ElementData%AP)) THEN - DEALLOCATE(ElementData%AP) -ENDIF -IF (ALLOCATED(ElementData%ALPHA)) THEN - DEALLOCATE(ElementData%ALPHA) -ENDIF -IF (ALLOCATED(ElementData%W2)) THEN - DEALLOCATE(ElementData%W2) -ENDIF -IF (ALLOCATED(ElementData%OLD_A_NS)) THEN - DEALLOCATE(ElementData%OLD_A_NS) -ENDIF -IF (ALLOCATED(ElementData%OLD_AP_NS)) THEN - DEALLOCATE(ElementData%OLD_AP_NS) -ENDIF -IF (ALLOCATED(ElementData%PITNOW)) THEN - DEALLOCATE(ElementData%PITNOW) -ENDIF - END SUBROUTINE AD14_DestroyElement - - SUBROUTINE AD14_PackElement( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Element), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_PackElement' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! A allocated yes/no - IF ( ALLOCATED(InData%A) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! A upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%A) ! A - END IF - Int_BufSz = Int_BufSz + 1 ! AP allocated yes/no - IF ( ALLOCATED(InData%AP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AP) ! AP - END IF - Int_BufSz = Int_BufSz + 1 ! ALPHA allocated yes/no - IF ( ALLOCATED(InData%ALPHA) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ALPHA upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ALPHA) ! ALPHA - END IF - Int_BufSz = Int_BufSz + 1 ! W2 allocated yes/no - IF ( ALLOCATED(InData%W2) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! W2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%W2) ! W2 - END IF - Int_BufSz = Int_BufSz + 1 ! OLD_A_NS allocated yes/no - IF ( ALLOCATED(InData%OLD_A_NS) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OLD_A_NS upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OLD_A_NS) ! OLD_A_NS - END IF - Int_BufSz = Int_BufSz + 1 ! OLD_AP_NS allocated yes/no - IF ( ALLOCATED(InData%OLD_AP_NS) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OLD_AP_NS upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OLD_AP_NS) ! OLD_AP_NS - END IF - Int_BufSz = Int_BufSz + 1 ! PITNOW allocated yes/no - IF ( ALLOCATED(InData%PITNOW) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PITNOW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PITNOW) ! PITNOW - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%A) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%A,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%A,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%A,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%A,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%A,2), UBOUND(InData%A,2) - DO i1 = LBOUND(InData%A,1), UBOUND(InData%A,1) - ReKiBuf(Re_Xferred) = InData%A(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AP,2), UBOUND(InData%AP,2) - DO i1 = LBOUND(InData%AP,1), UBOUND(InData%AP,1) - ReKiBuf(Re_Xferred) = InData%AP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ALPHA) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ALPHA,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ALPHA,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ALPHA,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ALPHA,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ALPHA,2), UBOUND(InData%ALPHA,2) - DO i1 = LBOUND(InData%ALPHA,1), UBOUND(InData%ALPHA,1) - ReKiBuf(Re_Xferred) = InData%ALPHA(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%W2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%W2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%W2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W2,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%W2,2), UBOUND(InData%W2,2) - DO i1 = LBOUND(InData%W2,1), UBOUND(InData%W2,1) - ReKiBuf(Re_Xferred) = InData%W2(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OLD_A_NS) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLD_A_NS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLD_A_NS,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLD_A_NS,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLD_A_NS,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OLD_A_NS,2), UBOUND(InData%OLD_A_NS,2) - DO i1 = LBOUND(InData%OLD_A_NS,1), UBOUND(InData%OLD_A_NS,1) - ReKiBuf(Re_Xferred) = InData%OLD_A_NS(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OLD_AP_NS) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLD_AP_NS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLD_AP_NS,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OLD_AP_NS,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLD_AP_NS,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OLD_AP_NS,2), UBOUND(InData%OLD_AP_NS,2) - DO i1 = LBOUND(InData%OLD_AP_NS,1), UBOUND(InData%OLD_AP_NS,1) - ReKiBuf(Re_Xferred) = InData%OLD_AP_NS(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PITNOW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PITNOW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PITNOW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PITNOW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PITNOW,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PITNOW,2), UBOUND(InData%PITNOW,2) - DO i1 = LBOUND(InData%PITNOW,1), UBOUND(InData%PITNOW,1) - ReKiBuf(Re_Xferred) = InData%PITNOW(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE AD14_PackElement - - SUBROUTINE AD14_UnPackElement( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Element), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackElement' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! A not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%A)) DEALLOCATE(OutData%A) - ALLOCATE(OutData%A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%A.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%A,2), UBOUND(OutData%A,2) - DO i1 = LBOUND(OutData%A,1), UBOUND(OutData%A,1) - OutData%A(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AP not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AP)) DEALLOCATE(OutData%AP) - ALLOCATE(OutData%AP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AP,2), UBOUND(OutData%AP,2) - DO i1 = LBOUND(OutData%AP,1), UBOUND(OutData%AP,1) - OutData%AP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ALPHA not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ALPHA)) DEALLOCATE(OutData%ALPHA) - ALLOCATE(OutData%ALPHA(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ALPHA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ALPHA,2), UBOUND(OutData%ALPHA,2) - DO i1 = LBOUND(OutData%ALPHA,1), UBOUND(OutData%ALPHA,1) - OutData%ALPHA(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! W2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%W2)) DEALLOCATE(OutData%W2) - ALLOCATE(OutData%W2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%W2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%W2,2), UBOUND(OutData%W2,2) - DO i1 = LBOUND(OutData%W2,1), UBOUND(OutData%W2,1) - OutData%W2(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLD_A_NS not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OLD_A_NS)) DEALLOCATE(OutData%OLD_A_NS) - ALLOCATE(OutData%OLD_A_NS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLD_A_NS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OLD_A_NS,2), UBOUND(OutData%OLD_A_NS,2) - DO i1 = LBOUND(OutData%OLD_A_NS,1), UBOUND(OutData%OLD_A_NS,1) - OutData%OLD_A_NS(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLD_AP_NS not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OLD_AP_NS)) DEALLOCATE(OutData%OLD_AP_NS) - ALLOCATE(OutData%OLD_AP_NS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLD_AP_NS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OLD_AP_NS,2), UBOUND(OutData%OLD_AP_NS,2) - DO i1 = LBOUND(OutData%OLD_AP_NS,1), UBOUND(OutData%OLD_AP_NS,1) - OutData%OLD_AP_NS(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PITNOW not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PITNOW)) DEALLOCATE(OutData%PITNOW) - ALLOCATE(OutData%PITNOW(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + ALLOCATE(DstElementData%PITNOW(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PITNOW.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElementData%PITNOW.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i2 = LBOUND(OutData%PITNOW,2), UBOUND(OutData%PITNOW,2) - DO i1 = LBOUND(OutData%PITNOW,1), UBOUND(OutData%PITNOW,1) - OutData%PITNOW(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO END IF - END SUBROUTINE AD14_UnPackElement + DstElementData%PITNOW = SrcElementData%PITNOW +ENDIF + END SUBROUTINE AD14_CopyElement + + SUBROUTINE AD14_DestroyElement( ElementData, ErrStat, ErrMsg ) + TYPE(Element), INTENT(INOUT) :: ElementData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyElement' + + ErrStat = ErrID_None + ErrMsg = "" + +IF (ALLOCATED(ElementData%A)) THEN + DEALLOCATE(ElementData%A) +ENDIF +IF (ALLOCATED(ElementData%AP)) THEN + DEALLOCATE(ElementData%AP) +ENDIF +IF (ALLOCATED(ElementData%ALPHA)) THEN + DEALLOCATE(ElementData%ALPHA) +ENDIF +IF (ALLOCATED(ElementData%W2)) THEN + DEALLOCATE(ElementData%W2) +ENDIF +IF (ALLOCATED(ElementData%OLD_A_NS)) THEN + DEALLOCATE(ElementData%OLD_A_NS) +ENDIF +IF (ALLOCATED(ElementData%OLD_AP_NS)) THEN + DEALLOCATE(ElementData%OLD_AP_NS) +ENDIF +IF (ALLOCATED(ElementData%PITNOW)) THEN + DEALLOCATE(ElementData%PITNOW) +ENDIF + END SUBROUTINE AD14_DestroyElement + +subroutine AD14_PackElement(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Element), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackElement' + if (Buf%ErrStat >= AbortErrLev) return + ! A + call RegPack(Buf, allocated(InData%A)) + if (allocated(InData%A)) then + call RegPackBounds(Buf, 2, lbound(InData%A), ubound(InData%A)) + call RegPack(Buf, InData%A) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AP + call RegPack(Buf, allocated(InData%AP)) + if (allocated(InData%AP)) then + call RegPackBounds(Buf, 2, lbound(InData%AP), ubound(InData%AP)) + call RegPack(Buf, InData%AP) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ALPHA + call RegPack(Buf, allocated(InData%ALPHA)) + if (allocated(InData%ALPHA)) then + call RegPackBounds(Buf, 2, lbound(InData%ALPHA), ubound(InData%ALPHA)) + call RegPack(Buf, InData%ALPHA) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! W2 + call RegPack(Buf, allocated(InData%W2)) + if (allocated(InData%W2)) then + call RegPackBounds(Buf, 2, lbound(InData%W2), ubound(InData%W2)) + call RegPack(Buf, InData%W2) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OLD_A_NS + call RegPack(Buf, allocated(InData%OLD_A_NS)) + if (allocated(InData%OLD_A_NS)) then + call RegPackBounds(Buf, 2, lbound(InData%OLD_A_NS), ubound(InData%OLD_A_NS)) + call RegPack(Buf, InData%OLD_A_NS) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OLD_AP_NS + call RegPack(Buf, allocated(InData%OLD_AP_NS)) + if (allocated(InData%OLD_AP_NS)) then + call RegPackBounds(Buf, 2, lbound(InData%OLD_AP_NS), ubound(InData%OLD_AP_NS)) + call RegPack(Buf, InData%OLD_AP_NS) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PITNOW + call RegPack(Buf, allocated(InData%PITNOW)) + if (allocated(InData%PITNOW)) then + call RegPackBounds(Buf, 2, lbound(InData%PITNOW), ubound(InData%PITNOW)) + call RegPack(Buf, InData%PITNOW) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackElement(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Element), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackElement' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! A + if (allocated(OutData%A)) deallocate(OutData%A) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%A(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%A.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%A) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AP + if (allocated(OutData%AP)) deallocate(OutData%AP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AP(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AP) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ALPHA + if (allocated(OutData%ALPHA)) deallocate(OutData%ALPHA) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ALPHA(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ALPHA.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ALPHA) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! W2 + if (allocated(OutData%W2)) deallocate(OutData%W2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%W2(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%W2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%W2) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! OLD_A_NS + if (allocated(OutData%OLD_A_NS)) deallocate(OutData%OLD_A_NS) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OLD_A_NS(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLD_A_NS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OLD_A_NS) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! OLD_AP_NS + if (allocated(OutData%OLD_AP_NS)) deallocate(OutData%OLD_AP_NS) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OLD_AP_NS(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLD_AP_NS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OLD_AP_NS) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PITNOW + if (allocated(OutData%PITNOW)) deallocate(OutData%PITNOW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PITNOW(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PITNOW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PITNOW) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE AD14_CopyElementParms( SrcElementParmsData, DstElementParmsData, CtrlCode, ErrStat, ErrMsg ) TYPE(ElementParms), INTENT(IN) :: SrcElementParmsData TYPE(ElementParms), INTENT(INOUT) :: DstElementParmsData @@ -7803,256 +4377,117 @@ SUBROUTINE AD14_DestroyElementParms( ElementParmsData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE AD14_DestroyElementParms - SUBROUTINE AD14_PackElementParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ElementParms), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_PackElementParms' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! NELM - Int_BufSz = Int_BufSz + 1 ! TWIST allocated yes/no - IF ( ALLOCATED(InData%TWIST) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TWIST upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TWIST) ! TWIST - END IF - Int_BufSz = Int_BufSz + 1 ! RELM allocated yes/no - IF ( ALLOCATED(InData%RELM) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RELM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%RELM) ! RELM - END IF - Int_BufSz = Int_BufSz + 1 ! HLCNST allocated yes/no - IF ( ALLOCATED(InData%HLCNST) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! HLCNST upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%HLCNST) ! HLCNST - END IF - Int_BufSz = Int_BufSz + 1 ! TLCNST allocated yes/no - IF ( ALLOCATED(InData%TLCNST) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TLCNST upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TLCNST) ! TLCNST - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%NELM - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TWIST) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TWIST,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TWIST,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TWIST,1), UBOUND(InData%TWIST,1) - ReKiBuf(Re_Xferred) = InData%TWIST(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RELM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RELM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RELM,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RELM,1), UBOUND(InData%RELM,1) - ReKiBuf(Re_Xferred) = InData%RELM(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%HLCNST) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%HLCNST,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HLCNST,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%HLCNST,1), UBOUND(InData%HLCNST,1) - ReKiBuf(Re_Xferred) = InData%HLCNST(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TLCNST) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TLCNST,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TLCNST,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TLCNST,1), UBOUND(InData%TLCNST,1) - ReKiBuf(Re_Xferred) = InData%TLCNST(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AD14_PackElementParms - - SUBROUTINE AD14_UnPackElementParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ElementParms), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackElementParms' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%NELM = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TWIST not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TWIST)) DEALLOCATE(OutData%TWIST) - ALLOCATE(OutData%TWIST(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TWIST.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TWIST,1), UBOUND(OutData%TWIST,1) - OutData%TWIST(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RELM not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RELM)) DEALLOCATE(OutData%RELM) - ALLOCATE(OutData%RELM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RELM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RELM,1), UBOUND(OutData%RELM,1) - OutData%RELM(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HLCNST not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%HLCNST)) DEALLOCATE(OutData%HLCNST) - ALLOCATE(OutData%HLCNST(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HLCNST.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%HLCNST,1), UBOUND(OutData%HLCNST,1) - OutData%HLCNST(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TLCNST not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TLCNST)) DEALLOCATE(OutData%TLCNST) - ALLOCATE(OutData%TLCNST(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TLCNST.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TLCNST,1), UBOUND(OutData%TLCNST,1) - OutData%TLCNST(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AD14_UnPackElementParms +subroutine AD14_PackElementParms(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ElementParms), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackElementParms' + if (Buf%ErrStat >= AbortErrLev) return + ! NELM + call RegPack(Buf, InData%NELM) + if (RegCheckErr(Buf, RoutineName)) return + ! TWIST + call RegPack(Buf, allocated(InData%TWIST)) + if (allocated(InData%TWIST)) then + call RegPackBounds(Buf, 1, lbound(InData%TWIST), ubound(InData%TWIST)) + call RegPack(Buf, InData%TWIST) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RELM + call RegPack(Buf, allocated(InData%RELM)) + if (allocated(InData%RELM)) then + call RegPackBounds(Buf, 1, lbound(InData%RELM), ubound(InData%RELM)) + call RegPack(Buf, InData%RELM) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! HLCNST + call RegPack(Buf, allocated(InData%HLCNST)) + if (allocated(InData%HLCNST)) then + call RegPackBounds(Buf, 1, lbound(InData%HLCNST), ubound(InData%HLCNST)) + call RegPack(Buf, InData%HLCNST) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TLCNST + call RegPack(Buf, allocated(InData%TLCNST)) + if (allocated(InData%TLCNST)) then + call RegPackBounds(Buf, 1, lbound(InData%TLCNST), ubound(InData%TLCNST)) + call RegPack(Buf, InData%TLCNST) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackElementParms(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ElementParms), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackElementParms' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! NELM + call RegUnpack(Buf, OutData%NELM) + if (RegCheckErr(Buf, RoutineName)) return + ! TWIST + if (allocated(OutData%TWIST)) deallocate(OutData%TWIST) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TWIST(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TWIST.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TWIST) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RELM + if (allocated(OutData%RELM)) deallocate(OutData%RELM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RELM(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RELM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RELM) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! HLCNST + if (allocated(OutData%HLCNST)) deallocate(OutData%HLCNST) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%HLCNST(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%HLCNST.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%HLCNST) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TLCNST + if (allocated(OutData%TLCNST)) deallocate(OutData%TLCNST) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TLCNST(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TLCNST.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TLCNST) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE AD14_CopyElOutParms( SrcElOutParmsData, DstElOutParmsData, CtrlCode, ErrStat, ErrMsg ) TYPE(ElOutParms), INTENT(IN) :: SrcElOutParmsData TYPE(ElOutParms), INTENT(INOUT) :: DstElOutParmsData @@ -8427,991 +4862,537 @@ SUBROUTINE AD14_DestroyElOutParms( ElOutParmsData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE AD14_DestroyElOutParms - SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ElOutParms), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_PackElOutParms' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! AAA allocated yes/no - IF ( ALLOCATED(InData%AAA) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AAA upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AAA) ! AAA - END IF - Int_BufSz = Int_BufSz + 1 ! AAP allocated yes/no - IF ( ALLOCATED(InData%AAP) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AAP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AAP) ! AAP - END IF - Int_BufSz = Int_BufSz + 1 ! ALF allocated yes/no - IF ( ALLOCATED(InData%ALF) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ALF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ALF) ! ALF - END IF - Int_BufSz = Int_BufSz + 1 ! CDD allocated yes/no - IF ( ALLOCATED(InData%CDD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CDD upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CDD) ! CDD - END IF - Int_BufSz = Int_BufSz + 1 ! CLL allocated yes/no - IF ( ALLOCATED(InData%CLL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CLL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CLL) ! CLL - END IF - Int_BufSz = Int_BufSz + 1 ! CMM allocated yes/no - IF ( ALLOCATED(InData%CMM) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CMM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CMM) ! CMM - END IF - Int_BufSz = Int_BufSz + 1 ! CNN allocated yes/no - IF ( ALLOCATED(InData%CNN) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CNN upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CNN) ! CNN - END IF - Int_BufSz = Int_BufSz + 1 ! CTT allocated yes/no - IF ( ALLOCATED(InData%CTT) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CTT upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CTT) ! CTT - END IF - Int_BufSz = Int_BufSz + 1 ! DFNSAV allocated yes/no - IF ( ALLOCATED(InData%DFNSAV) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DFNSAV upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DFNSAV) ! DFNSAV - END IF - Int_BufSz = Int_BufSz + 1 ! DFTSAV allocated yes/no - IF ( ALLOCATED(InData%DFTSAV) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DFTSAV upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DFTSAV) ! DFTSAV - END IF - Int_BufSz = Int_BufSz + 1 ! DynPres allocated yes/no - IF ( ALLOCATED(InData%DynPres) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DynPres upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DynPres) ! DynPres - END IF - Int_BufSz = Int_BufSz + 1 ! PMM allocated yes/no - IF ( ALLOCATED(InData%PMM) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PMM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PMM) ! PMM - END IF - Int_BufSz = Int_BufSz + 1 ! PITSAV allocated yes/no - IF ( ALLOCATED(InData%PITSAV) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PITSAV upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PITSAV) ! PITSAV - END IF - Int_BufSz = Int_BufSz + 1 ! ReyNum allocated yes/no - IF ( ALLOCATED(InData%ReyNum) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ReyNum upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ReyNum) ! ReyNum - END IF - Int_BufSz = Int_BufSz + 1 ! Gamma allocated yes/no - IF ( ALLOCATED(InData%Gamma) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Gamma upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Gamma) ! Gamma - END IF - Int_BufSz = Int_BufSz + 1 ! SaveVX allocated yes/no - IF ( ALLOCATED(InData%SaveVX) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! SaveVX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SaveVX) ! SaveVX - END IF - Int_BufSz = Int_BufSz + 1 ! SaveVY allocated yes/no - IF ( ALLOCATED(InData%SaveVY) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! SaveVY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SaveVY) ! SaveVY - END IF - Int_BufSz = Int_BufSz + 1 ! SaveVZ allocated yes/no - IF ( ALLOCATED(InData%SaveVZ) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! SaveVZ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SaveVZ) ! SaveVZ - END IF - Re_BufSz = Re_BufSz + 1 ! VXSAV - Re_BufSz = Re_BufSz + 1 ! VYSAV - Re_BufSz = Re_BufSz + 1 ! VZSAV - Int_BufSz = Int_BufSz + 1 ! NumWndElOut - Int_BufSz = Int_BufSz + 1 ! WndElPrList allocated yes/no - IF ( ALLOCATED(InData%WndElPrList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WndElPrList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WndElPrList) ! WndElPrList - END IF - Int_BufSz = Int_BufSz + 1 ! WndElPrNum allocated yes/no - IF ( ALLOCATED(InData%WndElPrNum) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WndElPrNum upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WndElPrNum) ! WndElPrNum - END IF - Int_BufSz = Int_BufSz + 1 ! ElPrList allocated yes/no - IF ( ALLOCATED(InData%ElPrList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ElPrList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ElPrList) ! ElPrList - END IF - Int_BufSz = Int_BufSz + 1 ! ElPrNum allocated yes/no - IF ( ALLOCATED(InData%ElPrNum) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ElPrNum upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ElPrNum) ! ElPrNum - END IF - Int_BufSz = Int_BufSz + 1 ! NumElOut - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%AAA) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AAA,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AAA,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AAA,1), UBOUND(InData%AAA,1) - ReKiBuf(Re_Xferred) = InData%AAA(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AAP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AAP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AAP,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AAP,1), UBOUND(InData%AAP,1) - ReKiBuf(Re_Xferred) = InData%AAP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ALF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ALF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ALF,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ALF,1), UBOUND(InData%ALF,1) - ReKiBuf(Re_Xferred) = InData%ALF(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CDD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CDD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CDD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CDD,1), UBOUND(InData%CDD,1) - ReKiBuf(Re_Xferred) = InData%CDD(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CLL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CLL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CLL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CLL,1), UBOUND(InData%CLL,1) - ReKiBuf(Re_Xferred) = InData%CLL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CMM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CMM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CMM,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CMM,1), UBOUND(InData%CMM,1) - ReKiBuf(Re_Xferred) = InData%CMM(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CNN) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CNN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNN,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CNN,1), UBOUND(InData%CNN,1) - ReKiBuf(Re_Xferred) = InData%CNN(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CTT) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CTT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CTT,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CTT,1), UBOUND(InData%CTT,1) - ReKiBuf(Re_Xferred) = InData%CTT(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DFNSAV) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DFNSAV,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DFNSAV,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DFNSAV,1), UBOUND(InData%DFNSAV,1) - ReKiBuf(Re_Xferred) = InData%DFNSAV(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DFTSAV) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DFTSAV,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DFTSAV,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DFTSAV,1), UBOUND(InData%DFTSAV,1) - ReKiBuf(Re_Xferred) = InData%DFTSAV(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DynPres) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DynPres,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DynPres,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DynPres,1), UBOUND(InData%DynPres,1) - ReKiBuf(Re_Xferred) = InData%DynPres(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PMM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMM,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PMM,1), UBOUND(InData%PMM,1) - ReKiBuf(Re_Xferred) = InData%PMM(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PITSAV) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PITSAV,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PITSAV,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PITSAV,1), UBOUND(InData%PITSAV,1) - ReKiBuf(Re_Xferred) = InData%PITSAV(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ReyNum) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ReyNum,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ReyNum,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ReyNum,1), UBOUND(InData%ReyNum,1) - ReKiBuf(Re_Xferred) = InData%ReyNum(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Gamma) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Gamma,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Gamma,1), UBOUND(InData%Gamma,1) - ReKiBuf(Re_Xferred) = InData%Gamma(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SaveVX) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SaveVX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SaveVX,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SaveVX,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SaveVX,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%SaveVX,2), UBOUND(InData%SaveVX,2) - DO i1 = LBOUND(InData%SaveVX,1), UBOUND(InData%SaveVX,1) - ReKiBuf(Re_Xferred) = InData%SaveVX(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SaveVY) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SaveVY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SaveVY,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SaveVY,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SaveVY,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%SaveVY,2), UBOUND(InData%SaveVY,2) - DO i1 = LBOUND(InData%SaveVY,1), UBOUND(InData%SaveVY,1) - ReKiBuf(Re_Xferred) = InData%SaveVY(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SaveVZ) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SaveVZ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SaveVZ,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SaveVZ,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SaveVZ,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%SaveVZ,2), UBOUND(InData%SaveVZ,2) - DO i1 = LBOUND(InData%SaveVZ,1), UBOUND(InData%SaveVZ,1) - ReKiBuf(Re_Xferred) = InData%SaveVZ(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%VXSAV - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VYSAV - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VZSAV - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumWndElOut - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WndElPrList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WndElPrList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WndElPrList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WndElPrList,1), UBOUND(InData%WndElPrList,1) - IntKiBuf(Int_Xferred) = InData%WndElPrList(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WndElPrNum) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WndElPrNum,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WndElPrNum,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WndElPrNum,1), UBOUND(InData%WndElPrNum,1) - IntKiBuf(Int_Xferred) = InData%WndElPrNum(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ElPrList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ElPrList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElPrList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ElPrList,1), UBOUND(InData%ElPrList,1) - IntKiBuf(Int_Xferred) = InData%ElPrList(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ElPrNum) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ElPrNum,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElPrNum,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ElPrNum,1), UBOUND(InData%ElPrNum,1) - IntKiBuf(Int_Xferred) = InData%ElPrNum(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NumElOut - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD14_PackElOutParms - - SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ElOutParms), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackElOutParms' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AAA not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AAA)) DEALLOCATE(OutData%AAA) - ALLOCATE(OutData%AAA(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AAA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AAA,1), UBOUND(OutData%AAA,1) - OutData%AAA(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AAP not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AAP)) DEALLOCATE(OutData%AAP) - ALLOCATE(OutData%AAP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AAP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AAP,1), UBOUND(OutData%AAP,1) - OutData%AAP(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ALF not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ALF)) DEALLOCATE(OutData%ALF) - ALLOCATE(OutData%ALF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ALF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ALF,1), UBOUND(OutData%ALF,1) - OutData%ALF(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CDD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CDD)) DEALLOCATE(OutData%CDD) - ALLOCATE(OutData%CDD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CDD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CDD,1), UBOUND(OutData%CDD,1) - OutData%CDD(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CLL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CLL)) DEALLOCATE(OutData%CLL) - ALLOCATE(OutData%CLL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CLL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CLL,1), UBOUND(OutData%CLL,1) - OutData%CLL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CMM not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CMM)) DEALLOCATE(OutData%CMM) - ALLOCATE(OutData%CMM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CMM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CMM,1), UBOUND(OutData%CMM,1) - OutData%CMM(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNN not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CNN)) DEALLOCATE(OutData%CNN) - ALLOCATE(OutData%CNN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CNN,1), UBOUND(OutData%CNN,1) - OutData%CNN(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CTT not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CTT)) DEALLOCATE(OutData%CTT) - ALLOCATE(OutData%CTT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CTT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CTT,1), UBOUND(OutData%CTT,1) - OutData%CTT(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DFNSAV not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DFNSAV)) DEALLOCATE(OutData%DFNSAV) - ALLOCATE(OutData%DFNSAV(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DFNSAV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DFNSAV,1), UBOUND(OutData%DFNSAV,1) - OutData%DFNSAV(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DFTSAV not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DFTSAV)) DEALLOCATE(OutData%DFTSAV) - ALLOCATE(OutData%DFTSAV(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DFTSAV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DFTSAV,1), UBOUND(OutData%DFTSAV,1) - OutData%DFTSAV(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DynPres not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DynPres)) DEALLOCATE(OutData%DynPres) - ALLOCATE(OutData%DynPres(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DynPres.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DynPres,1), UBOUND(OutData%DynPres,1) - OutData%DynPres(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMM not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PMM)) DEALLOCATE(OutData%PMM) - ALLOCATE(OutData%PMM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PMM,1), UBOUND(OutData%PMM,1) - OutData%PMM(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PITSAV not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PITSAV)) DEALLOCATE(OutData%PITSAV) - ALLOCATE(OutData%PITSAV(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PITSAV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PITSAV,1), UBOUND(OutData%PITSAV,1) - OutData%PITSAV(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ReyNum not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ReyNum)) DEALLOCATE(OutData%ReyNum) - ALLOCATE(OutData%ReyNum(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ReyNum.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ReyNum,1), UBOUND(OutData%ReyNum,1) - OutData%ReyNum(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Gamma not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Gamma)) DEALLOCATE(OutData%Gamma) - ALLOCATE(OutData%Gamma(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gamma.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Gamma,1), UBOUND(OutData%Gamma,1) - OutData%Gamma(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SaveVX not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SaveVX)) DEALLOCATE(OutData%SaveVX) - ALLOCATE(OutData%SaveVX(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SaveVX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%SaveVX,2), UBOUND(OutData%SaveVX,2) - DO i1 = LBOUND(OutData%SaveVX,1), UBOUND(OutData%SaveVX,1) - OutData%SaveVX(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SaveVY not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SaveVY)) DEALLOCATE(OutData%SaveVY) - ALLOCATE(OutData%SaveVY(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SaveVY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%SaveVY,2), UBOUND(OutData%SaveVY,2) - DO i1 = LBOUND(OutData%SaveVY,1), UBOUND(OutData%SaveVY,1) - OutData%SaveVY(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SaveVZ not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SaveVZ)) DEALLOCATE(OutData%SaveVZ) - ALLOCATE(OutData%SaveVZ(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SaveVZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%SaveVZ,2), UBOUND(OutData%SaveVZ,2) - DO i1 = LBOUND(OutData%SaveVZ,1), UBOUND(OutData%SaveVZ,1) - OutData%SaveVZ(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%VXSAV = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VYSAV = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VZSAV = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NumWndElOut = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WndElPrList not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WndElPrList)) DEALLOCATE(OutData%WndElPrList) - ALLOCATE(OutData%WndElPrList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WndElPrList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WndElPrList,1), UBOUND(OutData%WndElPrList,1) - OutData%WndElPrList(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WndElPrNum not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WndElPrNum)) DEALLOCATE(OutData%WndElPrNum) - ALLOCATE(OutData%WndElPrNum(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WndElPrNum.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WndElPrNum,1), UBOUND(OutData%WndElPrNum,1) - OutData%WndElPrNum(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElPrList not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ElPrList)) DEALLOCATE(OutData%ElPrList) - ALLOCATE(OutData%ElPrList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElPrList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ElPrList,1), UBOUND(OutData%ElPrList,1) - OutData%ElPrList(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElPrNum not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ElPrNum)) DEALLOCATE(OutData%ElPrNum) - ALLOCATE(OutData%ElPrNum(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElPrNum.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ElPrNum,1), UBOUND(OutData%ElPrNum,1) - OutData%ElPrNum(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%NumElOut = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD14_UnPackElOutParms +subroutine AD14_PackElOutParms(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ElOutParms), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackElOutParms' + if (Buf%ErrStat >= AbortErrLev) return + ! AAA + call RegPack(Buf, allocated(InData%AAA)) + if (allocated(InData%AAA)) then + call RegPackBounds(Buf, 1, lbound(InData%AAA), ubound(InData%AAA)) + call RegPack(Buf, InData%AAA) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AAP + call RegPack(Buf, allocated(InData%AAP)) + if (allocated(InData%AAP)) then + call RegPackBounds(Buf, 1, lbound(InData%AAP), ubound(InData%AAP)) + call RegPack(Buf, InData%AAP) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ALF + call RegPack(Buf, allocated(InData%ALF)) + if (allocated(InData%ALF)) then + call RegPackBounds(Buf, 1, lbound(InData%ALF), ubound(InData%ALF)) + call RegPack(Buf, InData%ALF) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CDD + call RegPack(Buf, allocated(InData%CDD)) + if (allocated(InData%CDD)) then + call RegPackBounds(Buf, 1, lbound(InData%CDD), ubound(InData%CDD)) + call RegPack(Buf, InData%CDD) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CLL + call RegPack(Buf, allocated(InData%CLL)) + if (allocated(InData%CLL)) then + call RegPackBounds(Buf, 1, lbound(InData%CLL), ubound(InData%CLL)) + call RegPack(Buf, InData%CLL) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CMM + call RegPack(Buf, allocated(InData%CMM)) + if (allocated(InData%CMM)) then + call RegPackBounds(Buf, 1, lbound(InData%CMM), ubound(InData%CMM)) + call RegPack(Buf, InData%CMM) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CNN + call RegPack(Buf, allocated(InData%CNN)) + if (allocated(InData%CNN)) then + call RegPackBounds(Buf, 1, lbound(InData%CNN), ubound(InData%CNN)) + call RegPack(Buf, InData%CNN) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CTT + call RegPack(Buf, allocated(InData%CTT)) + if (allocated(InData%CTT)) then + call RegPackBounds(Buf, 1, lbound(InData%CTT), ubound(InData%CTT)) + call RegPack(Buf, InData%CTT) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DFNSAV + call RegPack(Buf, allocated(InData%DFNSAV)) + if (allocated(InData%DFNSAV)) then + call RegPackBounds(Buf, 1, lbound(InData%DFNSAV), ubound(InData%DFNSAV)) + call RegPack(Buf, InData%DFNSAV) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DFTSAV + call RegPack(Buf, allocated(InData%DFTSAV)) + if (allocated(InData%DFTSAV)) then + call RegPackBounds(Buf, 1, lbound(InData%DFTSAV), ubound(InData%DFTSAV)) + call RegPack(Buf, InData%DFTSAV) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DynPres + call RegPack(Buf, allocated(InData%DynPres)) + if (allocated(InData%DynPres)) then + call RegPackBounds(Buf, 1, lbound(InData%DynPres), ubound(InData%DynPres)) + call RegPack(Buf, InData%DynPres) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PMM + call RegPack(Buf, allocated(InData%PMM)) + if (allocated(InData%PMM)) then + call RegPackBounds(Buf, 1, lbound(InData%PMM), ubound(InData%PMM)) + call RegPack(Buf, InData%PMM) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PITSAV + call RegPack(Buf, allocated(InData%PITSAV)) + if (allocated(InData%PITSAV)) then + call RegPackBounds(Buf, 1, lbound(InData%PITSAV), ubound(InData%PITSAV)) + call RegPack(Buf, InData%PITSAV) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ReyNum + call RegPack(Buf, allocated(InData%ReyNum)) + if (allocated(InData%ReyNum)) then + call RegPackBounds(Buf, 1, lbound(InData%ReyNum), ubound(InData%ReyNum)) + call RegPack(Buf, InData%ReyNum) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Gamma + call RegPack(Buf, allocated(InData%Gamma)) + if (allocated(InData%Gamma)) then + call RegPackBounds(Buf, 1, lbound(InData%Gamma), ubound(InData%Gamma)) + call RegPack(Buf, InData%Gamma) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SaveVX + call RegPack(Buf, allocated(InData%SaveVX)) + if (allocated(InData%SaveVX)) then + call RegPackBounds(Buf, 2, lbound(InData%SaveVX), ubound(InData%SaveVX)) + call RegPack(Buf, InData%SaveVX) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SaveVY + call RegPack(Buf, allocated(InData%SaveVY)) + if (allocated(InData%SaveVY)) then + call RegPackBounds(Buf, 2, lbound(InData%SaveVY), ubound(InData%SaveVY)) + call RegPack(Buf, InData%SaveVY) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SaveVZ + call RegPack(Buf, allocated(InData%SaveVZ)) + if (allocated(InData%SaveVZ)) then + call RegPackBounds(Buf, 2, lbound(InData%SaveVZ), ubound(InData%SaveVZ)) + call RegPack(Buf, InData%SaveVZ) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! VXSAV + call RegPack(Buf, InData%VXSAV) + if (RegCheckErr(Buf, RoutineName)) return + ! VYSAV + call RegPack(Buf, InData%VYSAV) + if (RegCheckErr(Buf, RoutineName)) return + ! VZSAV + call RegPack(Buf, InData%VZSAV) + if (RegCheckErr(Buf, RoutineName)) return + ! NumWndElOut + call RegPack(Buf, InData%NumWndElOut) + if (RegCheckErr(Buf, RoutineName)) return + ! WndElPrList + call RegPack(Buf, allocated(InData%WndElPrList)) + if (allocated(InData%WndElPrList)) then + call RegPackBounds(Buf, 1, lbound(InData%WndElPrList), ubound(InData%WndElPrList)) + call RegPack(Buf, InData%WndElPrList) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WndElPrNum + call RegPack(Buf, allocated(InData%WndElPrNum)) + if (allocated(InData%WndElPrNum)) then + call RegPackBounds(Buf, 1, lbound(InData%WndElPrNum), ubound(InData%WndElPrNum)) + call RegPack(Buf, InData%WndElPrNum) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ElPrList + call RegPack(Buf, allocated(InData%ElPrList)) + if (allocated(InData%ElPrList)) then + call RegPackBounds(Buf, 1, lbound(InData%ElPrList), ubound(InData%ElPrList)) + call RegPack(Buf, InData%ElPrList) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ElPrNum + call RegPack(Buf, allocated(InData%ElPrNum)) + if (allocated(InData%ElPrNum)) then + call RegPackBounds(Buf, 1, lbound(InData%ElPrNum), ubound(InData%ElPrNum)) + call RegPack(Buf, InData%ElPrNum) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NumElOut + call RegPack(Buf, InData%NumElOut) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackElOutParms(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ElOutParms), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackElOutParms' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! AAA + if (allocated(OutData%AAA)) deallocate(OutData%AAA) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AAA(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AAA.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AAA) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AAP + if (allocated(OutData%AAP)) deallocate(OutData%AAP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AAP(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AAP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AAP) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ALF + if (allocated(OutData%ALF)) deallocate(OutData%ALF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ALF(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ALF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ALF) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CDD + if (allocated(OutData%CDD)) deallocate(OutData%CDD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CDD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CDD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CDD) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CLL + if (allocated(OutData%CLL)) deallocate(OutData%CLL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CLL(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CLL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CLL) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CMM + if (allocated(OutData%CMM)) deallocate(OutData%CMM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CMM(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CMM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CMM) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CNN + if (allocated(OutData%CNN)) deallocate(OutData%CNN) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CNN(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CNN) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CTT + if (allocated(OutData%CTT)) deallocate(OutData%CTT) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CTT(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CTT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CTT) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! DFNSAV + if (allocated(OutData%DFNSAV)) deallocate(OutData%DFNSAV) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DFNSAV(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DFNSAV.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DFNSAV) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! DFTSAV + if (allocated(OutData%DFTSAV)) deallocate(OutData%DFTSAV) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DFTSAV(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DFTSAV.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DFTSAV) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! DynPres + if (allocated(OutData%DynPres)) deallocate(OutData%DynPres) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DynPres(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DynPres.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DynPres) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PMM + if (allocated(OutData%PMM)) deallocate(OutData%PMM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PMM(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PMM) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PITSAV + if (allocated(OutData%PITSAV)) deallocate(OutData%PITSAV) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PITSAV(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PITSAV.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PITSAV) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ReyNum + if (allocated(OutData%ReyNum)) deallocate(OutData%ReyNum) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ReyNum(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ReyNum.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ReyNum) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Gamma + if (allocated(OutData%Gamma)) deallocate(OutData%Gamma) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Gamma(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gamma.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Gamma) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! SaveVX + if (allocated(OutData%SaveVX)) deallocate(OutData%SaveVX) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SaveVX(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SaveVX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SaveVX) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! SaveVY + if (allocated(OutData%SaveVY)) deallocate(OutData%SaveVY) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SaveVY(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SaveVY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SaveVY) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! SaveVZ + if (allocated(OutData%SaveVZ)) deallocate(OutData%SaveVZ) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SaveVZ(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SaveVZ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SaveVZ) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! VXSAV + call RegUnpack(Buf, OutData%VXSAV) + if (RegCheckErr(Buf, RoutineName)) return + ! VYSAV + call RegUnpack(Buf, OutData%VYSAV) + if (RegCheckErr(Buf, RoutineName)) return + ! VZSAV + call RegUnpack(Buf, OutData%VZSAV) + if (RegCheckErr(Buf, RoutineName)) return + ! NumWndElOut + call RegUnpack(Buf, OutData%NumWndElOut) + if (RegCheckErr(Buf, RoutineName)) return + ! WndElPrList + if (allocated(OutData%WndElPrList)) deallocate(OutData%WndElPrList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WndElPrList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WndElPrList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WndElPrList) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WndElPrNum + if (allocated(OutData%WndElPrNum)) deallocate(OutData%WndElPrNum) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WndElPrNum(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WndElPrNum.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WndElPrNum) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ElPrList + if (allocated(OutData%ElPrList)) deallocate(OutData%ElPrList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ElPrList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElPrList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ElPrList) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ElPrNum + if (allocated(OutData%ElPrNum)) deallocate(OutData%ElPrNum) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ElPrNum(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElPrNum.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ElPrNum) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NumElOut + call RegUnpack(Buf, OutData%NumElOut) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE AD14_CopyInducedVel( SrcInducedVelData, DstInducedVelData, CtrlCode, ErrStat, ErrMsg ) TYPE(InducedVel), INTENT(IN) :: SrcInducedVelData TYPE(InducedVel), INTENT(INOUT) :: DstInducedVelData @@ -9434,113 +5415,36 @@ SUBROUTINE AD14_DestroyInducedVel( InducedVelData, ErrStat, ErrMsg ) INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyInducedVel' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE AD14_DestroyInducedVel - - SUBROUTINE AD14_PackInducedVel( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(InducedVel), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_PackInducedVel' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! SumInFl - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%SumInFl - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_PackInducedVel - - SUBROUTINE AD14_UnPackInducedVel( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(InducedVel), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackInducedVel' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! + CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyInducedVel' + ErrStat = ErrID_None ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%SumInFl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_UnPackInducedVel + END SUBROUTINE AD14_DestroyInducedVel + + +subroutine AD14_PackInducedVel(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(InducedVel), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackInducedVel' + if (Buf%ErrStat >= AbortErrLev) return + ! SumInFl + call RegPack(Buf, InData%SumInFl) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackInducedVel(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(InducedVel), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackInducedVel' + if (Buf%ErrStat /= ErrID_None) return + ! SumInFl + call RegUnpack(Buf, OutData%SumInFl) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE AD14_CopyInducedVelParms( SrcInducedVelParmsData, DstInducedVelParmsData, CtrlCode, ErrStat, ErrMsg ) TYPE(InducedVelParms), INTENT(IN) :: SrcInducedVelParmsData TYPE(InducedVelParms), INTENT(INOUT) :: DstInducedVelParmsData @@ -9579,133 +5483,62 @@ SUBROUTINE AD14_DestroyInducedVelParms( InducedVelParmsData, ErrStat, ErrMsg ) END SUBROUTINE AD14_DestroyInducedVelParms - SUBROUTINE AD14_PackInducedVelParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(InducedVelParms), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_PackInducedVelParms' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! AToler - Re_BufSz = Re_BufSz + 1 ! EqAIDmult - Int_BufSz = Int_BufSz + 1 ! EquilDA - Int_BufSz = Int_BufSz + 1 ! EquilDT - Int_BufSz = Int_BufSz + 1 ! TLoss - Int_BufSz = Int_BufSz + 1 ! GTech - Int_BufSz = Int_BufSz + 1 ! HLoss - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%AToler - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%EqAIDmult - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%EquilDA, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%EquilDT, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TLoss, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%GTech, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%HLoss, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD14_PackInducedVelParms - - SUBROUTINE AD14_UnPackInducedVelParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(InducedVelParms), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackInducedVelParms' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%AToler = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%EqAIDmult = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%EquilDA = TRANSFER(IntKiBuf(Int_Xferred), OutData%EquilDA) - Int_Xferred = Int_Xferred + 1 - OutData%EquilDT = TRANSFER(IntKiBuf(Int_Xferred), OutData%EquilDT) - Int_Xferred = Int_Xferred + 1 - OutData%TLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%TLoss) - Int_Xferred = Int_Xferred + 1 - OutData%GTech = TRANSFER(IntKiBuf(Int_Xferred), OutData%GTech) - Int_Xferred = Int_Xferred + 1 - OutData%HLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%HLoss) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AD14_UnPackInducedVelParms +subroutine AD14_PackInducedVelParms(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(InducedVelParms), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackInducedVelParms' + if (Buf%ErrStat >= AbortErrLev) return + ! AToler + call RegPack(Buf, InData%AToler) + if (RegCheckErr(Buf, RoutineName)) return + ! EqAIDmult + call RegPack(Buf, InData%EqAIDmult) + if (RegCheckErr(Buf, RoutineName)) return + ! EquilDA + call RegPack(Buf, InData%EquilDA) + if (RegCheckErr(Buf, RoutineName)) return + ! EquilDT + call RegPack(Buf, InData%EquilDT) + if (RegCheckErr(Buf, RoutineName)) return + ! TLoss + call RegPack(Buf, InData%TLoss) + if (RegCheckErr(Buf, RoutineName)) return + ! GTech + call RegPack(Buf, InData%GTech) + if (RegCheckErr(Buf, RoutineName)) return + ! HLoss + call RegPack(Buf, InData%HLoss) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackInducedVelParms(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(InducedVelParms), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackInducedVelParms' + if (Buf%ErrStat /= ErrID_None) return + ! AToler + call RegUnpack(Buf, OutData%AToler) + if (RegCheckErr(Buf, RoutineName)) return + ! EqAIDmult + call RegUnpack(Buf, OutData%EqAIDmult) + if (RegCheckErr(Buf, RoutineName)) return + ! EquilDA + call RegUnpack(Buf, OutData%EquilDA) + if (RegCheckErr(Buf, RoutineName)) return + ! EquilDT + call RegUnpack(Buf, OutData%EquilDT) + if (RegCheckErr(Buf, RoutineName)) return + ! TLoss + call RegUnpack(Buf, OutData%TLoss) + if (RegCheckErr(Buf, RoutineName)) return + ! GTech + call RegUnpack(Buf, OutData%GTech) + if (RegCheckErr(Buf, RoutineName)) return + ! HLoss + call RegUnpack(Buf, OutData%HLoss) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE AD14_CopyRotor( SrcRotorData, DstRotorData, CtrlCode, ErrStat, ErrMsg ) TYPE(Rotor), INTENT(IN) :: SrcRotorData TYPE(Rotor), INTENT(INOUT) :: DstRotorData @@ -9746,143 +5579,74 @@ SUBROUTINE AD14_DestroyRotor( RotorData, ErrStat, ErrMsg ) END SUBROUTINE AD14_DestroyRotor - SUBROUTINE AD14_PackRotor( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Rotor), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_PackRotor' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! AVGINFL - Re_BufSz = Re_BufSz + 1 ! CTILT - Re_BufSz = Re_BufSz + 1 ! CYaw - Re_BufSz = Re_BufSz + 1 ! REVS - Re_BufSz = Re_BufSz + 1 ! STILT - Re_BufSz = Re_BufSz + 1 ! SYaw - Re_BufSz = Re_BufSz + 1 ! TILT - Re_BufSz = Re_BufSz + 1 ! YawAng - Re_BufSz = Re_BufSz + 1 ! YawVEL - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%AVGINFL - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CTILT - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CYaw - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%REVS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%STILT - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SYaw - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TILT - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawAng - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawVEL - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_PackRotor - - SUBROUTINE AD14_UnPackRotor( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Rotor), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackRotor' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%AVGINFL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CTILT = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CYaw = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%REVS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%STILT = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SYaw = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TILT = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawAng = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawVEL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_UnPackRotor +subroutine AD14_PackRotor(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Rotor), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackRotor' + if (Buf%ErrStat >= AbortErrLev) return + ! AVGINFL + call RegPack(Buf, InData%AVGINFL) + if (RegCheckErr(Buf, RoutineName)) return + ! CTILT + call RegPack(Buf, InData%CTILT) + if (RegCheckErr(Buf, RoutineName)) return + ! CYaw + call RegPack(Buf, InData%CYaw) + if (RegCheckErr(Buf, RoutineName)) return + ! REVS + call RegPack(Buf, InData%REVS) + if (RegCheckErr(Buf, RoutineName)) return + ! STILT + call RegPack(Buf, InData%STILT) + if (RegCheckErr(Buf, RoutineName)) return + ! SYaw + call RegPack(Buf, InData%SYaw) + if (RegCheckErr(Buf, RoutineName)) return + ! TILT + call RegPack(Buf, InData%TILT) + if (RegCheckErr(Buf, RoutineName)) return + ! YawAng + call RegPack(Buf, InData%YawAng) + if (RegCheckErr(Buf, RoutineName)) return + ! YawVEL + call RegPack(Buf, InData%YawVEL) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackRotor(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Rotor), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackRotor' + if (Buf%ErrStat /= ErrID_None) return + ! AVGINFL + call RegUnpack(Buf, OutData%AVGINFL) + if (RegCheckErr(Buf, RoutineName)) return + ! CTILT + call RegUnpack(Buf, OutData%CTILT) + if (RegCheckErr(Buf, RoutineName)) return + ! CYaw + call RegUnpack(Buf, OutData%CYaw) + if (RegCheckErr(Buf, RoutineName)) return + ! REVS + call RegUnpack(Buf, OutData%REVS) + if (RegCheckErr(Buf, RoutineName)) return + ! STILT + call RegUnpack(Buf, OutData%STILT) + if (RegCheckErr(Buf, RoutineName)) return + ! SYaw + call RegUnpack(Buf, OutData%SYaw) + if (RegCheckErr(Buf, RoutineName)) return + ! TILT + call RegUnpack(Buf, OutData%TILT) + if (RegCheckErr(Buf, RoutineName)) return + ! YawAng + call RegUnpack(Buf, OutData%YawAng) + if (RegCheckErr(Buf, RoutineName)) return + ! YawVEL + call RegUnpack(Buf, OutData%YawVEL) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE AD14_CopyRotorParms( SrcRotorParmsData, DstRotorParmsData, CtrlCode, ErrStat, ErrMsg ) TYPE(RotorParms), INTENT(IN) :: SrcRotorParmsData TYPE(RotorParms), INTENT(INOUT) :: DstRotorParmsData @@ -9915,103 +5679,26 @@ SUBROUTINE AD14_DestroyRotorParms( RotorParmsData, ErrStat, ErrMsg ) END SUBROUTINE AD14_DestroyRotorParms - SUBROUTINE AD14_PackRotorParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(RotorParms), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_PackRotorParms' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! HH - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%HH - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_PackRotorParms - - SUBROUTINE AD14_UnPackRotorParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(RotorParms), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackRotorParms' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%HH = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_UnPackRotorParms +subroutine AD14_PackRotorParms(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(RotorParms), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackRotorParms' + if (Buf%ErrStat >= AbortErrLev) return + ! HH + call RegPack(Buf, InData%HH) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackRotorParms(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(RotorParms), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackRotorParms' + if (Buf%ErrStat /= ErrID_None) return + ! HH + call RegUnpack(Buf, OutData%HH) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE AD14_CopyTwrPropsParms( SrcTwrPropsParmsData, DstTwrPropsParmsData, CtrlCode, ErrStat, ErrMsg ) TYPE(TwrPropsParms), INTENT(IN) :: SrcTwrPropsParmsData TYPE(TwrPropsParms), INTENT(INOUT) :: DstTwrPropsParmsData @@ -10153,428 +5840,251 @@ SUBROUTINE AD14_DestroyTwrPropsParms( TwrPropsParmsData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE AD14_DestroyTwrPropsParms - SUBROUTINE AD14_PackTwrPropsParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(TwrPropsParms), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_PackTwrPropsParms' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! TwrHtFr allocated yes/no - IF ( ALLOCATED(InData%TwrHtFr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrHtFr upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrHtFr) ! TwrHtFr - END IF - Int_BufSz = Int_BufSz + 1 ! TwrWid allocated yes/no - IF ( ALLOCATED(InData%TwrWid) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrWid upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrWid) ! TwrWid - END IF - Int_BufSz = Int_BufSz + 1 ! TwrCD allocated yes/no - IF ( ALLOCATED(InData%TwrCD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TwrCD upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrCD) ! TwrCD - END IF - Int_BufSz = Int_BufSz + 1 ! TwrRe allocated yes/no - IF ( ALLOCATED(InData%TwrRe) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrRe upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrRe) ! TwrRe - END IF - Re_BufSz = Re_BufSz + SIZE(InData%VTwr) ! VTwr - Re_BufSz = Re_BufSz + 1 ! Tower_Wake_Constant - Int_BufSz = Int_BufSz + 1 ! NTwrCDCol allocated yes/no - IF ( ALLOCATED(InData%NTwrCDCol) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NTwrCDCol upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NTwrCDCol) ! NTwrCDCol - END IF - Int_BufSz = Int_BufSz + 1 ! NTwrHT - Int_BufSz = Int_BufSz + 1 ! NTwrRe - Int_BufSz = Int_BufSz + 1 ! NTwrCD - Int_BufSz = Int_BufSz + 1 ! TwrPotent - Int_BufSz = Int_BufSz + 1 ! TwrShadow - Re_BufSz = Re_BufSz + 1 ! ShadHWid - Re_BufSz = Re_BufSz + 1 ! TShadC1 - Re_BufSz = Re_BufSz + 1 ! TShadC2 - Re_BufSz = Re_BufSz + 1 ! TwrShad - Int_BufSz = Int_BufSz + 1 ! PJM_Version - Int_BufSz = Int_BufSz + 1*LEN(InData%TwrFile) ! TwrFile - Re_BufSz = Re_BufSz + 1 ! T_Shad_Refpt - Int_BufSz = Int_BufSz + 1 ! CalcTwrAero - Int_BufSz = Int_BufSz + 1 ! NumTwrNodes - Int_BufSz = Int_BufSz + 1 ! TwrNodeWidth allocated yes/no - IF ( ALLOCATED(InData%TwrNodeWidth) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrNodeWidth upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrNodeWidth) ! TwrNodeWidth - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%TwrHtFr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrHtFr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrHtFr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrHtFr,1), UBOUND(InData%TwrHtFr,1) - ReKiBuf(Re_Xferred) = InData%TwrHtFr(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrWid) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrWid,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrWid,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrWid,1), UBOUND(InData%TwrWid,1) - ReKiBuf(Re_Xferred) = InData%TwrWid(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrCD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrCD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrCD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrCD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrCD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TwrCD,2), UBOUND(InData%TwrCD,2) - DO i1 = LBOUND(InData%TwrCD,1), UBOUND(InData%TwrCD,1) - ReKiBuf(Re_Xferred) = InData%TwrCD(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrRe) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrRe,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrRe,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrRe,1), UBOUND(InData%TwrRe,1) - ReKiBuf(Re_Xferred) = InData%TwrRe(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DO i1 = LBOUND(InData%VTwr,1), UBOUND(InData%VTwr,1) - ReKiBuf(Re_Xferred) = InData%VTwr(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%Tower_Wake_Constant - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%NTwrCDCol) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NTwrCDCol,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NTwrCDCol,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NTwrCDCol,1), UBOUND(InData%NTwrCDCol,1) - IntKiBuf(Int_Xferred) = InData%NTwrCDCol(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NTwrHT - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NTwrRe - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NTwrCD - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TwrPotent, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TwrShadow, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ShadHWid - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TShadC1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TShadC2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TwrShad - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%PJM_Version, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%TwrFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%TwrFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf(Re_Xferred) = InData%T_Shad_Refpt - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%CalcTwrAero, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumTwrNodes - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TwrNodeWidth) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrNodeWidth,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrNodeWidth,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrNodeWidth,1), UBOUND(InData%TwrNodeWidth,1) - ReKiBuf(Re_Xferred) = InData%TwrNodeWidth(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AD14_PackTwrPropsParms - - SUBROUTINE AD14_UnPackTwrPropsParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(TwrPropsParms), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackTwrPropsParms' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrHtFr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TwrHtFr)) DEALLOCATE(OutData%TwrHtFr) - ALLOCATE(OutData%TwrHtFr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrHtFr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrHtFr,1), UBOUND(OutData%TwrHtFr,1) - OutData%TwrHtFr(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrWid not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TwrWid)) DEALLOCATE(OutData%TwrWid) - ALLOCATE(OutData%TwrWid(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrWid.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrWid,1), UBOUND(OutData%TwrWid,1) - OutData%TwrWid(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrCD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TwrCD)) DEALLOCATE(OutData%TwrCD) - ALLOCATE(OutData%TwrCD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TwrCD,2), UBOUND(OutData%TwrCD,2) - DO i1 = LBOUND(OutData%TwrCD,1), UBOUND(OutData%TwrCD,1) - OutData%TwrCD(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrRe not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TwrRe)) DEALLOCATE(OutData%TwrRe) - ALLOCATE(OutData%TwrRe(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrRe.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrRe,1), UBOUND(OutData%TwrRe,1) - OutData%TwrRe(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - i1_l = LBOUND(OutData%VTwr,1) - i1_u = UBOUND(OutData%VTwr,1) - DO i1 = LBOUND(OutData%VTwr,1), UBOUND(OutData%VTwr,1) - OutData%VTwr(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%Tower_Wake_Constant = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NTwrCDCol not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NTwrCDCol)) DEALLOCATE(OutData%NTwrCDCol) - ALLOCATE(OutData%NTwrCDCol(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NTwrCDCol.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NTwrCDCol,1), UBOUND(OutData%NTwrCDCol,1) - OutData%NTwrCDCol(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%NTwrHT = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NTwrRe = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NTwrCD = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TwrPotent = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwrPotent) - Int_Xferred = Int_Xferred + 1 - OutData%TwrShadow = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwrShadow) - Int_Xferred = Int_Xferred + 1 - OutData%ShadHWid = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TShadC1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TShadC2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TwrShad = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PJM_Version = TRANSFER(IntKiBuf(Int_Xferred), OutData%PJM_Version) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%TwrFile) - OutData%TwrFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%T_Shad_Refpt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CalcTwrAero = TRANSFER(IntKiBuf(Int_Xferred), OutData%CalcTwrAero) - Int_Xferred = Int_Xferred + 1 - OutData%NumTwrNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrNodeWidth not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TwrNodeWidth)) DEALLOCATE(OutData%TwrNodeWidth) - ALLOCATE(OutData%TwrNodeWidth(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrNodeWidth.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrNodeWidth,1), UBOUND(OutData%TwrNodeWidth,1) - OutData%TwrNodeWidth(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AD14_UnPackTwrPropsParms +subroutine AD14_PackTwrPropsParms(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(TwrPropsParms), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackTwrPropsParms' + if (Buf%ErrStat >= AbortErrLev) return + ! TwrHtFr + call RegPack(Buf, allocated(InData%TwrHtFr)) + if (allocated(InData%TwrHtFr)) then + call RegPackBounds(Buf, 1, lbound(InData%TwrHtFr), ubound(InData%TwrHtFr)) + call RegPack(Buf, InData%TwrHtFr) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TwrWid + call RegPack(Buf, allocated(InData%TwrWid)) + if (allocated(InData%TwrWid)) then + call RegPackBounds(Buf, 1, lbound(InData%TwrWid), ubound(InData%TwrWid)) + call RegPack(Buf, InData%TwrWid) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TwrCD + call RegPack(Buf, allocated(InData%TwrCD)) + if (allocated(InData%TwrCD)) then + call RegPackBounds(Buf, 2, lbound(InData%TwrCD), ubound(InData%TwrCD)) + call RegPack(Buf, InData%TwrCD) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TwrRe + call RegPack(Buf, allocated(InData%TwrRe)) + if (allocated(InData%TwrRe)) then + call RegPackBounds(Buf, 1, lbound(InData%TwrRe), ubound(InData%TwrRe)) + call RegPack(Buf, InData%TwrRe) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! VTwr + call RegPack(Buf, InData%VTwr) + if (RegCheckErr(Buf, RoutineName)) return + ! Tower_Wake_Constant + call RegPack(Buf, InData%Tower_Wake_Constant) + if (RegCheckErr(Buf, RoutineName)) return + ! NTwrCDCol + call RegPack(Buf, allocated(InData%NTwrCDCol)) + if (allocated(InData%NTwrCDCol)) then + call RegPackBounds(Buf, 1, lbound(InData%NTwrCDCol), ubound(InData%NTwrCDCol)) + call RegPack(Buf, InData%NTwrCDCol) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NTwrHT + call RegPack(Buf, InData%NTwrHT) + if (RegCheckErr(Buf, RoutineName)) return + ! NTwrRe + call RegPack(Buf, InData%NTwrRe) + if (RegCheckErr(Buf, RoutineName)) return + ! NTwrCD + call RegPack(Buf, InData%NTwrCD) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrPotent + call RegPack(Buf, InData%TwrPotent) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrShadow + call RegPack(Buf, InData%TwrShadow) + if (RegCheckErr(Buf, RoutineName)) return + ! ShadHWid + call RegPack(Buf, InData%ShadHWid) + if (RegCheckErr(Buf, RoutineName)) return + ! TShadC1 + call RegPack(Buf, InData%TShadC1) + if (RegCheckErr(Buf, RoutineName)) return + ! TShadC2 + call RegPack(Buf, InData%TShadC2) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrShad + call RegPack(Buf, InData%TwrShad) + if (RegCheckErr(Buf, RoutineName)) return + ! PJM_Version + call RegPack(Buf, InData%PJM_Version) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrFile + call RegPack(Buf, InData%TwrFile) + if (RegCheckErr(Buf, RoutineName)) return + ! T_Shad_Refpt + call RegPack(Buf, InData%T_Shad_Refpt) + if (RegCheckErr(Buf, RoutineName)) return + ! CalcTwrAero + call RegPack(Buf, InData%CalcTwrAero) + if (RegCheckErr(Buf, RoutineName)) return + ! NumTwrNodes + call RegPack(Buf, InData%NumTwrNodes) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrNodeWidth + call RegPack(Buf, allocated(InData%TwrNodeWidth)) + if (allocated(InData%TwrNodeWidth)) then + call RegPackBounds(Buf, 1, lbound(InData%TwrNodeWidth), ubound(InData%TwrNodeWidth)) + call RegPack(Buf, InData%TwrNodeWidth) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackTwrPropsParms(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(TwrPropsParms), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackTwrPropsParms' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! TwrHtFr + if (allocated(OutData%TwrHtFr)) deallocate(OutData%TwrHtFr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrHtFr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrHtFr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrHtFr) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TwrWid + if (allocated(OutData%TwrWid)) deallocate(OutData%TwrWid) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrWid(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrWid.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrWid) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TwrCD + if (allocated(OutData%TwrCD)) deallocate(OutData%TwrCD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrCD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrCD) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TwrRe + if (allocated(OutData%TwrRe)) deallocate(OutData%TwrRe) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrRe(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrRe.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrRe) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! VTwr + call RegUnpack(Buf, OutData%VTwr) + if (RegCheckErr(Buf, RoutineName)) return + ! Tower_Wake_Constant + call RegUnpack(Buf, OutData%Tower_Wake_Constant) + if (RegCheckErr(Buf, RoutineName)) return + ! NTwrCDCol + if (allocated(OutData%NTwrCDCol)) deallocate(OutData%NTwrCDCol) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NTwrCDCol(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NTwrCDCol.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%NTwrCDCol) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NTwrHT + call RegUnpack(Buf, OutData%NTwrHT) + if (RegCheckErr(Buf, RoutineName)) return + ! NTwrRe + call RegUnpack(Buf, OutData%NTwrRe) + if (RegCheckErr(Buf, RoutineName)) return + ! NTwrCD + call RegUnpack(Buf, OutData%NTwrCD) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrPotent + call RegUnpack(Buf, OutData%TwrPotent) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrShadow + call RegUnpack(Buf, OutData%TwrShadow) + if (RegCheckErr(Buf, RoutineName)) return + ! ShadHWid + call RegUnpack(Buf, OutData%ShadHWid) + if (RegCheckErr(Buf, RoutineName)) return + ! TShadC1 + call RegUnpack(Buf, OutData%TShadC1) + if (RegCheckErr(Buf, RoutineName)) return + ! TShadC2 + call RegUnpack(Buf, OutData%TShadC2) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrShad + call RegUnpack(Buf, OutData%TwrShad) + if (RegCheckErr(Buf, RoutineName)) return + ! PJM_Version + call RegUnpack(Buf, OutData%PJM_Version) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrFile + call RegUnpack(Buf, OutData%TwrFile) + if (RegCheckErr(Buf, RoutineName)) return + ! T_Shad_Refpt + call RegUnpack(Buf, OutData%T_Shad_Refpt) + if (RegCheckErr(Buf, RoutineName)) return + ! CalcTwrAero + call RegUnpack(Buf, OutData%CalcTwrAero) + if (RegCheckErr(Buf, RoutineName)) return + ! NumTwrNodes + call RegUnpack(Buf, OutData%NumTwrNodes) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrNodeWidth + if (allocated(OutData%TwrNodeWidth)) deallocate(OutData%TwrNodeWidth) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrNodeWidth(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrNodeWidth.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrNodeWidth) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE AD14_CopyWind( SrcWindData, DstWindData, CtrlCode, ErrStat, ErrMsg ) TYPE(Wind), INTENT(IN) :: SrcWindData TYPE(Wind), INTENT(INOUT) :: DstWindData @@ -10612,128 +6122,56 @@ SUBROUTINE AD14_DestroyWind( WindData, ErrStat, ErrMsg ) END SUBROUTINE AD14_DestroyWind - SUBROUTINE AD14_PackWind( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Wind), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_PackWind' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! ANGFLW - Re_BufSz = Re_BufSz + 1 ! CDEL - Re_BufSz = Re_BufSz + 1 ! VROTORX - Re_BufSz = Re_BufSz + 1 ! VROTORY - Re_BufSz = Re_BufSz + 1 ! VROTORZ - Re_BufSz = Re_BufSz + 1 ! SDEL - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%ANGFLW - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CDEL - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VROTORX - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VROTORY - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VROTORZ - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SDEL - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_PackWind - - SUBROUTINE AD14_UnPackWind( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Wind), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackWind' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%ANGFLW = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CDEL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VROTORX = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VROTORY = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VROTORZ = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SDEL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_UnPackWind +subroutine AD14_PackWind(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Wind), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackWind' + if (Buf%ErrStat >= AbortErrLev) return + ! ANGFLW + call RegPack(Buf, InData%ANGFLW) + if (RegCheckErr(Buf, RoutineName)) return + ! CDEL + call RegPack(Buf, InData%CDEL) + if (RegCheckErr(Buf, RoutineName)) return + ! VROTORX + call RegPack(Buf, InData%VROTORX) + if (RegCheckErr(Buf, RoutineName)) return + ! VROTORY + call RegPack(Buf, InData%VROTORY) + if (RegCheckErr(Buf, RoutineName)) return + ! VROTORZ + call RegPack(Buf, InData%VROTORZ) + if (RegCheckErr(Buf, RoutineName)) return + ! SDEL + call RegPack(Buf, InData%SDEL) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackWind(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Wind), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackWind' + if (Buf%ErrStat /= ErrID_None) return + ! ANGFLW + call RegUnpack(Buf, OutData%ANGFLW) + if (RegCheckErr(Buf, RoutineName)) return + ! CDEL + call RegUnpack(Buf, OutData%CDEL) + if (RegCheckErr(Buf, RoutineName)) return + ! VROTORX + call RegUnpack(Buf, OutData%VROTORX) + if (RegCheckErr(Buf, RoutineName)) return + ! VROTORY + call RegUnpack(Buf, OutData%VROTORY) + if (RegCheckErr(Buf, RoutineName)) return + ! VROTORZ + call RegUnpack(Buf, OutData%VROTORZ) + if (RegCheckErr(Buf, RoutineName)) return + ! SDEL + call RegUnpack(Buf, OutData%SDEL) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE AD14_CopyWindParms( SrcWindParmsData, DstWindParmsData, CtrlCode, ErrStat, ErrMsg ) TYPE(WindParms), INTENT(IN) :: SrcWindParmsData TYPE(WindParms), INTENT(INOUT) :: DstWindParmsData @@ -10767,108 +6205,32 @@ SUBROUTINE AD14_DestroyWindParms( WindParmsData, ErrStat, ErrMsg ) END SUBROUTINE AD14_DestroyWindParms - SUBROUTINE AD14_PackWindParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(WindParms), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_PackWindParms' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! Rho - Re_BufSz = Re_BufSz + 1 ! KinVisc - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%Rho - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%KinVisc - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_PackWindParms - - SUBROUTINE AD14_UnPackWindParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(WindParms), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackWindParms' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%Rho = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%KinVisc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_UnPackWindParms +subroutine AD14_PackWindParms(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WindParms), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackWindParms' + if (Buf%ErrStat >= AbortErrLev) return + ! Rho + call RegPack(Buf, InData%Rho) + if (RegCheckErr(Buf, RoutineName)) return + ! KinVisc + call RegPack(Buf, InData%KinVisc) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackWindParms(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WindParms), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackWindParms' + if (Buf%ErrStat /= ErrID_None) return + ! Rho + call RegUnpack(Buf, OutData%Rho) + if (RegCheckErr(Buf, RoutineName)) return + ! KinVisc + call RegUnpack(Buf, OutData%KinVisc) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE AD14_CopyPositionType( SrcPositionTypeData, DstPositionTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(PositionType), INTENT(IN) :: SrcPositionTypeData TYPE(PositionType), INTENT(INOUT) :: DstPositionTypeData @@ -10902,110 +6264,26 @@ SUBROUTINE AD14_DestroyPositionType( PositionTypeData, ErrStat, ErrMsg ) END SUBROUTINE AD14_DestroyPositionType - SUBROUTINE AD14_PackPositionType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(PositionType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_PackPositionType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + SIZE(InData%Pos) ! Pos - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i1 = LBOUND(InData%Pos,1), UBOUND(InData%Pos,1) - ReKiBuf(Re_Xferred) = InData%Pos(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE AD14_PackPositionType - - SUBROUTINE AD14_UnPackPositionType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(PositionType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackPositionType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%Pos,1) - i1_u = UBOUND(OutData%Pos,1) - DO i1 = LBOUND(OutData%Pos,1), UBOUND(OutData%Pos,1) - OutData%Pos(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE AD14_UnPackPositionType +subroutine AD14_PackPositionType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(PositionType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackPositionType' + if (Buf%ErrStat >= AbortErrLev) return + ! Pos + call RegPack(Buf, InData%Pos) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackPositionType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(PositionType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackPositionType' + if (Buf%ErrStat /= ErrID_None) return + ! Pos + call RegUnpack(Buf, OutData%Pos) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE AD14_CopyOrientationType( SrcOrientationTypeData, DstOrientationTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(OrientationType), INTENT(IN) :: SrcOrientationTypeData TYPE(OrientationType), INTENT(INOUT) :: DstOrientationTypeData @@ -11040,117 +6318,26 @@ SUBROUTINE AD14_DestroyOrientationType( OrientationTypeData, ErrStat, ErrMsg ) END SUBROUTINE AD14_DestroyOrientationType - SUBROUTINE AD14_PackOrientationType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(OrientationType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_PackOrientationType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + SIZE(InData%Orient) ! Orient - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i2 = LBOUND(InData%Orient,2), UBOUND(InData%Orient,2) - DO i1 = LBOUND(InData%Orient,1), UBOUND(InData%Orient,1) - ReKiBuf(Re_Xferred) = InData%Orient(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END SUBROUTINE AD14_PackOrientationType - - SUBROUTINE AD14_UnPackOrientationType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(OrientationType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackOrientationType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%Orient,1) - i1_u = UBOUND(OutData%Orient,1) - i2_l = LBOUND(OutData%Orient,2) - i2_u = UBOUND(OutData%Orient,2) - DO i2 = LBOUND(OutData%Orient,2), UBOUND(OutData%Orient,2) - DO i1 = LBOUND(OutData%Orient,1), UBOUND(OutData%Orient,1) - OutData%Orient(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END SUBROUTINE AD14_UnPackOrientationType +subroutine AD14_PackOrientationType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(OrientationType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackOrientationType' + if (Buf%ErrStat >= AbortErrLev) return + ! Orient + call RegPack(Buf, InData%Orient) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackOrientationType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(OrientationType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackOrientationType' + if (Buf%ErrStat /= ErrID_None) return + ! Orient + call RegUnpack(Buf, OutData%Orient) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE AD14_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(AD14_InitInputType), INTENT(IN) :: SrcInitInputData TYPE(AD14_InitInputType), INTENT(INOUT) :: DstInitInputData @@ -11221,381 +6408,115 @@ SUBROUTINE AD14_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AD14_DestroyInitInput - SUBROUTINE AD14_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AD14_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%Title) ! Title - Int_BufSz = Int_BufSz + 1*LEN(InData%OutRootName) ! OutRootName - Int_BufSz = Int_BufSz + 1*LEN(InData%ADFileName) ! ADFileName - Int_BufSz = Int_BufSz + 1 ! WrSumFile - Int_BufSz = Int_BufSz + 1 ! NumBl - Re_BufSz = Re_BufSz + 1 ! BladeLength - Int_BufSz = Int_BufSz + 1 ! LinearizeFlag - Int_BufSz = Int_BufSz + 1 ! UseDWM - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! TurbineComponents: size of buffers for each call to pack subtype - CALL AD14_PackAeroConfig( Re_Buf, Db_Buf, Int_Buf, InData%TurbineComponents, ErrStat2, ErrMsg2, .TRUE. ) ! TurbineComponents - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TurbineComponents - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TurbineComponents - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TurbineComponents - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! NumTwrNodes - Int_BufSz = Int_BufSz + 1 ! TwrNodeLocs allocated yes/no - IF ( ALLOCATED(InData%TwrNodeLocs) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TwrNodeLocs upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrNodeLocs) ! TwrNodeLocs - END IF - Re_BufSz = Re_BufSz + 1 ! HubHt - Int_BufSz = Int_BufSz + 3 ! DWM: size of buffers for each call to pack subtype - CALL DWM_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, .TRUE. ) ! DWM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DWM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DWM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DWM - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%Title) - IntKiBuf(Int_Xferred) = ICHAR(InData%Title(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutRootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutRootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%ADFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%ADFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%WrSumFile, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBl - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%BladeLength - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%LinearizeFlag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseDWM, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - CALL AD14_PackAeroConfig( Re_Buf, Db_Buf, Int_Buf, InData%TurbineComponents, ErrStat2, ErrMsg2, OnlySize ) ! TurbineComponents - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = InData%NumTwrNodes - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TwrNodeLocs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrNodeLocs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrNodeLocs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrNodeLocs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrNodeLocs,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TwrNodeLocs,2), UBOUND(InData%TwrNodeLocs,2) - DO i1 = LBOUND(InData%TwrNodeLocs,1), UBOUND(InData%TwrNodeLocs,1) - ReKiBuf(Re_Xferred) = InData%TwrNodeLocs(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%HubHt - Re_Xferred = Re_Xferred + 1 - CALL DWM_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, OnlySize ) ! DWM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE AD14_PackInitInput - - SUBROUTINE AD14_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AD14_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%Title) - OutData%Title(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutRootName) - OutData%OutRootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%ADFileName) - OutData%ADFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%WrSumFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%WrSumFile) - Int_Xferred = Int_Xferred + 1 - OutData%NumBl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%BladeLength = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LinearizeFlag = TRANSFER(IntKiBuf(Int_Xferred), OutData%LinearizeFlag) - Int_Xferred = Int_Xferred + 1 - OutData%UseDWM = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseDWM) - Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD14_UnpackAeroConfig( Re_Buf, Db_Buf, Int_Buf, OutData%TurbineComponents, ErrStat2, ErrMsg2 ) ! TurbineComponents - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%NumTwrNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrNodeLocs not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TwrNodeLocs)) DEALLOCATE(OutData%TwrNodeLocs) - ALLOCATE(OutData%TwrNodeLocs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrNodeLocs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TwrNodeLocs,2), UBOUND(OutData%TwrNodeLocs,2) - DO i1 = LBOUND(OutData%TwrNodeLocs,1), UBOUND(OutData%TwrNodeLocs,1) - OutData%TwrNodeLocs(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%HubHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL DWM_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%DWM, ErrStat2, ErrMsg2 ) ! DWM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE AD14_UnPackInitInput +subroutine AD14_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD14_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + ! Title + call RegPack(Buf, InData%Title) + if (RegCheckErr(Buf, RoutineName)) return + ! OutRootName + call RegPack(Buf, InData%OutRootName) + if (RegCheckErr(Buf, RoutineName)) return + ! ADFileName + call RegPack(Buf, InData%ADFileName) + if (RegCheckErr(Buf, RoutineName)) return + ! WrSumFile + call RegPack(Buf, InData%WrSumFile) + if (RegCheckErr(Buf, RoutineName)) return + ! NumBl + call RegPack(Buf, InData%NumBl) + if (RegCheckErr(Buf, RoutineName)) return + ! BladeLength + call RegPack(Buf, InData%BladeLength) + if (RegCheckErr(Buf, RoutineName)) return + ! LinearizeFlag + call RegPack(Buf, InData%LinearizeFlag) + if (RegCheckErr(Buf, RoutineName)) return + ! UseDWM + call RegPack(Buf, InData%UseDWM) + if (RegCheckErr(Buf, RoutineName)) return + ! TurbineComponents + call AD14_PackAeroConfig(Buf, InData%TurbineComponents) + if (RegCheckErr(Buf, RoutineName)) return + ! NumTwrNodes + call RegPack(Buf, InData%NumTwrNodes) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrNodeLocs + call RegPack(Buf, allocated(InData%TwrNodeLocs)) + if (allocated(InData%TwrNodeLocs)) then + call RegPackBounds(Buf, 2, lbound(InData%TwrNodeLocs), ubound(InData%TwrNodeLocs)) + call RegPack(Buf, InData%TwrNodeLocs) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! HubHt + call RegPack(Buf, InData%HubHt) + if (RegCheckErr(Buf, RoutineName)) return + ! DWM + call DWM_PackInitInput(Buf, InData%DWM) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD14_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackInitInput' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! Title + call RegUnpack(Buf, OutData%Title) + if (RegCheckErr(Buf, RoutineName)) return + ! OutRootName + call RegUnpack(Buf, OutData%OutRootName) + if (RegCheckErr(Buf, RoutineName)) return + ! ADFileName + call RegUnpack(Buf, OutData%ADFileName) + if (RegCheckErr(Buf, RoutineName)) return + ! WrSumFile + call RegUnpack(Buf, OutData%WrSumFile) + if (RegCheckErr(Buf, RoutineName)) return + ! NumBl + call RegUnpack(Buf, OutData%NumBl) + if (RegCheckErr(Buf, RoutineName)) return + ! BladeLength + call RegUnpack(Buf, OutData%BladeLength) + if (RegCheckErr(Buf, RoutineName)) return + ! LinearizeFlag + call RegUnpack(Buf, OutData%LinearizeFlag) + if (RegCheckErr(Buf, RoutineName)) return + ! UseDWM + call RegUnpack(Buf, OutData%UseDWM) + if (RegCheckErr(Buf, RoutineName)) return + ! TurbineComponents + call AD14_UnpackAeroConfig(Buf, OutData%TurbineComponents) ! TurbineComponents + ! NumTwrNodes + call RegUnpack(Buf, OutData%NumTwrNodes) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrNodeLocs + if (allocated(OutData%TwrNodeLocs)) deallocate(OutData%TwrNodeLocs) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrNodeLocs(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrNodeLocs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrNodeLocs) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! HubHt + call RegUnpack(Buf, OutData%HubHt) + if (RegCheckErr(Buf, RoutineName)) return + ! DWM + call DWM_UnpackInitInput(Buf, OutData%DWM) ! DWM +end subroutine SUBROUTINE AD14_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(AD14_InitOutputType), INTENT(IN) :: SrcInitOutputData TYPE(AD14_InitOutputType), INTENT(INOUT) :: DstInitOutputData @@ -11638,274 +6559,36 @@ SUBROUTINE AD14_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AD14_DestroyInitOutput - SUBROUTINE AD14_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AD14_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! DWM: size of buffers for each call to pack subtype - CALL DWM_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, .TRUE. ) ! DWM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DWM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DWM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DWM - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Re_BufSz = Re_BufSz + 1 ! AirDens - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL DWM_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, OnlySize ) ! DWM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - ReKiBuf(Re_Xferred) = InData%AirDens - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_PackInitOutput - - SUBROUTINE AD14_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AD14_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL DWM_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%DWM, ErrStat2, ErrMsg2 ) ! DWM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%AirDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AD14_UnPackInitOutput +subroutine AD14_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD14_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! Ver + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + if (RegCheckErr(Buf, RoutineName)) return + ! DWM + call DWM_PackInitOutput(Buf, InData%DWM) + if (RegCheckErr(Buf, RoutineName)) return + ! AirDens + call RegPack(Buf, InData%AirDens) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD14_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackInitOutput' + if (Buf%ErrStat /= ErrID_None) return + ! Ver + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + ! DWM + call DWM_UnpackInitOutput(Buf, OutData%DWM) ! DWM + ! AirDens + call RegUnpack(Buf, OutData%AirDens) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE AD14_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(AD14_ContinuousStateType), INTENT(IN) :: SrcContStateData TYPE(AD14_ContinuousStateType), INTENT(INOUT) :: DstContStateData @@ -11942,184 +6625,25 @@ SUBROUTINE AD14_DestroyContState( ContStateData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AD14_DestroyContState - SUBROUTINE AD14_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AD14_ContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_PackContState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! DWM: size of buffers for each call to pack subtype - CALL DWM_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, .TRUE. ) ! DWM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DWM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DWM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DWM - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL DWM_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, OnlySize ) ! DWM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE AD14_PackContState - - SUBROUTINE AD14_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AD14_ContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackContState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL DWM_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%DWM, ErrStat2, ErrMsg2 ) ! DWM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE AD14_UnPackContState +subroutine AD14_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD14_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + ! DWM + call DWM_PackContState(Buf, InData%DWM) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD14_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackContState' + if (Buf%ErrStat /= ErrID_None) return + ! DWM + call DWM_UnpackContState(Buf, OutData%DWM) ! DWM +end subroutine SUBROUTINE AD14_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(AD14_DiscreteStateType), INTENT(IN) :: SrcDiscStateData TYPE(AD14_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData @@ -12156,184 +6680,25 @@ SUBROUTINE AD14_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AD14_DestroyDiscState - SUBROUTINE AD14_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AD14_DiscreteStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_PackDiscState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! DWM: size of buffers for each call to pack subtype - CALL DWM_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, .TRUE. ) ! DWM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DWM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DWM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DWM - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL DWM_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, OnlySize ) ! DWM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE AD14_PackDiscState - - SUBROUTINE AD14_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AD14_DiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackDiscState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL DWM_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%DWM, ErrStat2, ErrMsg2 ) ! DWM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE AD14_UnPackDiscState +subroutine AD14_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD14_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + ! DWM + call DWM_PackDiscState(Buf, InData%DWM) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD14_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackDiscState' + if (Buf%ErrStat /= ErrID_None) return + ! DWM + call DWM_UnpackDiscState(Buf, OutData%DWM) ! DWM +end subroutine SUBROUTINE AD14_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(AD14_ConstraintStateType), INTENT(IN) :: SrcConstrStateData TYPE(AD14_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData @@ -12370,184 +6735,25 @@ SUBROUTINE AD14_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AD14_DestroyConstrState - SUBROUTINE AD14_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AD14_ConstraintStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_PackConstrState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! DWM: size of buffers for each call to pack subtype - CALL DWM_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, .TRUE. ) ! DWM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DWM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DWM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DWM - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL DWM_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, OnlySize ) ! DWM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE AD14_PackConstrState - - SUBROUTINE AD14_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AD14_ConstraintStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackConstrState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL DWM_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%DWM, ErrStat2, ErrMsg2 ) ! DWM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE AD14_UnPackConstrState +subroutine AD14_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD14_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + ! DWM + call DWM_PackConstrState(Buf, InData%DWM) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD14_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + ! DWM + call DWM_UnpackConstrState(Buf, OutData%DWM) ! DWM +end subroutine SUBROUTINE AD14_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(AD14_OtherStateType), INTENT(IN) :: SrcOtherStateData TYPE(AD14_OtherStateType), INTENT(INOUT) :: DstOtherStateData @@ -12584,184 +6790,25 @@ SUBROUTINE AD14_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AD14_DestroyOtherState - SUBROUTINE AD14_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AD14_OtherStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_PackOtherState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! DWM: size of buffers for each call to pack subtype - CALL DWM_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, .TRUE. ) ! DWM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DWM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DWM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DWM - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL DWM_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, OnlySize ) ! DWM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE AD14_PackOtherState - - SUBROUTINE AD14_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AD14_OtherStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackOtherState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL DWM_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%DWM, ErrStat2, ErrMsg2 ) ! DWM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE AD14_UnPackOtherState +subroutine AD14_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD14_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackOtherState' + if (Buf%ErrStat >= AbortErrLev) return + ! DWM + call DWM_PackOtherState(Buf, InData%DWM) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD14_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackOtherState' + if (Buf%ErrStat /= ErrID_None) return + ! DWM + call DWM_UnpackOtherState(Buf, OutData%DWM) ! DWM +end subroutine SUBROUTINE AD14_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) TYPE(AD14_MiscVarType), INTENT(IN) :: SrcMiscData TYPE(AD14_MiscVarType), INTENT(INOUT) :: DstMiscData @@ -12920,1271 +6967,240 @@ SUBROUTINE AD14_DestroyMisc( MiscData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE AD14_DestroyMisc - SUBROUTINE AD14_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AD14_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! DWM: size of buffers for each call to pack subtype - CALL DWM_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, .TRUE. ) ! DWM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DWM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DWM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DWM - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! DWM_Inputs: size of buffers for each call to pack subtype - CALL DWM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%DWM_Inputs, ErrStat2, ErrMsg2, .TRUE. ) ! DWM_Inputs - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DWM_Inputs - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DWM_Inputs - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DWM_Inputs - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! DWM_Outputs: size of buffers for each call to pack subtype - CALL DWM_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%DWM_Outputs, ErrStat2, ErrMsg2, .TRUE. ) ! DWM_Outputs - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DWM_Outputs - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DWM_Outputs - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DWM_Outputs - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Db_BufSz = Db_BufSz + 1 ! DT - Int_BufSz = Int_BufSz + 1 ! ElPrNum allocated yes/no - IF ( ALLOCATED(InData%ElPrNum) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ElPrNum upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ElPrNum) ! ElPrNum - END IF - Db_BufSz = Db_BufSz + 1 ! OldTime - Re_BufSz = Re_BufSz + 1 ! HubLoss - Re_BufSz = Re_BufSz + 1 ! Loss - Re_BufSz = Re_BufSz + 1 ! TipLoss - Re_BufSz = Re_BufSz + 1 ! TLpt7 - Int_BufSz = Int_BufSz + 1 ! FirstPassGTL - Int_BufSz = Int_BufSz + 1 ! SuperSonic - Int_BufSz = Int_BufSz + 1 ! AFLAGVinderr - Int_BufSz = Int_BufSz + 1 ! AFLAGTwrInflu - Int_BufSz = Int_BufSz + 1 ! OnePassDynDbg - Int_BufSz = Int_BufSz + 1 ! NoLoadsCalculated - Int_BufSz = Int_BufSz + 1 ! NERRORS - Int_BufSz = Int_BufSz + 3 ! AirFoil: size of buffers for each call to pack subtype - CALL AD14_PackAirFoil( Re_Buf, Db_Buf, Int_Buf, InData%AirFoil, ErrStat2, ErrMsg2, .TRUE. ) ! AirFoil - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AirFoil - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AirFoil - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AirFoil - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Beddoes: size of buffers for each call to pack subtype - CALL AD14_PackBeddoes( Re_Buf, Db_Buf, Int_Buf, InData%Beddoes, ErrStat2, ErrMsg2, .TRUE. ) ! Beddoes - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Beddoes - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Beddoes - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Beddoes - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! DynInflow: size of buffers for each call to pack subtype - CALL AD14_PackDynInflow( Re_Buf, Db_Buf, Int_Buf, InData%DynInflow, ErrStat2, ErrMsg2, .TRUE. ) ! DynInflow - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DynInflow - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DynInflow - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DynInflow - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Element: size of buffers for each call to pack subtype - CALL AD14_PackElement( Re_Buf, Db_Buf, Int_Buf, InData%Element, ErrStat2, ErrMsg2, .TRUE. ) ! Element - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Element - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Element - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Element - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Rotor: size of buffers for each call to pack subtype - CALL AD14_PackRotor( Re_Buf, Db_Buf, Int_Buf, InData%Rotor, ErrStat2, ErrMsg2, .TRUE. ) ! Rotor - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Rotor - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Rotor - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Rotor - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Wind: size of buffers for each call to pack subtype - CALL AD14_PackWind( Re_Buf, Db_Buf, Int_Buf, InData%Wind, ErrStat2, ErrMsg2, .TRUE. ) ! Wind - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Wind - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Wind - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Wind - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InducedVel: size of buffers for each call to pack subtype - CALL AD14_PackInducedVel( Re_Buf, Db_Buf, Int_Buf, InData%InducedVel, ErrStat2, ErrMsg2, .TRUE. ) ! InducedVel - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InducedVel - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InducedVel - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InducedVel - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! ElOut: size of buffers for each call to pack subtype - CALL AD14_PackElOutParms( Re_Buf, Db_Buf, Int_Buf, InData%ElOut, ErrStat2, ErrMsg2, .TRUE. ) ! ElOut - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ElOut - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ElOut - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ElOut - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Skew - Int_BufSz = Int_BufSz + 1 ! DynInit - Int_BufSz = Int_BufSz + 1 ! FirstWarn - Int_BufSz = Int_BufSz + 1 ! StoredForces allocated yes/no - IF ( ALLOCATED(InData%StoredForces) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! StoredForces upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StoredForces) ! StoredForces - END IF - Int_BufSz = Int_BufSz + 1 ! StoredMoments allocated yes/no - IF ( ALLOCATED(InData%StoredMoments) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! StoredMoments upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StoredMoments) ! StoredMoments - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL DWM_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, OnlySize ) ! DWM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL DWM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%DWM_Inputs, ErrStat2, ErrMsg2, OnlySize ) ! DWM_Inputs - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL DWM_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%DWM_Outputs, ErrStat2, ErrMsg2, OnlySize ) ! DWM_Outputs - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%ElPrNum) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ElPrNum,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElPrNum,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ElPrNum,1), UBOUND(InData%ElPrNum,1) - IntKiBuf(Int_Xferred) = InData%ElPrNum(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - DbKiBuf(Db_Xferred) = InData%OldTime - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubLoss - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Loss - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TipLoss - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TLpt7 - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstPassGTL, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%SuperSonic, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%AFLAGVinderr, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%AFLAGTwrInflu, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%OnePassDynDbg, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%NoLoadsCalculated, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NERRORS - Int_Xferred = Int_Xferred + 1 - CALL AD14_PackAirFoil( Re_Buf, Db_Buf, Int_Buf, InData%AirFoil, ErrStat2, ErrMsg2, OnlySize ) ! AirFoil - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD14_PackBeddoes( Re_Buf, Db_Buf, Int_Buf, InData%Beddoes, ErrStat2, ErrMsg2, OnlySize ) ! Beddoes - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD14_PackDynInflow( Re_Buf, Db_Buf, Int_Buf, InData%DynInflow, ErrStat2, ErrMsg2, OnlySize ) ! DynInflow - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD14_PackElement( Re_Buf, Db_Buf, Int_Buf, InData%Element, ErrStat2, ErrMsg2, OnlySize ) ! Element - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD14_PackRotor( Re_Buf, Db_Buf, Int_Buf, InData%Rotor, ErrStat2, ErrMsg2, OnlySize ) ! Rotor - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD14_PackWind( Re_Buf, Db_Buf, Int_Buf, InData%Wind, ErrStat2, ErrMsg2, OnlySize ) ! Wind - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD14_PackInducedVel( Re_Buf, Db_Buf, Int_Buf, InData%InducedVel, ErrStat2, ErrMsg2, OnlySize ) ! InducedVel - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD14_PackElOutParms( Re_Buf, Db_Buf, Int_Buf, InData%ElOut, ErrStat2, ErrMsg2, OnlySize ) ! ElOut - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = TRANSFER(InData%Skew, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%DynInit, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstWarn, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%StoredForces) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StoredForces,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StoredForces,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StoredForces,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StoredForces,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StoredForces,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StoredForces,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%StoredForces,3), UBOUND(InData%StoredForces,3) - DO i2 = LBOUND(InData%StoredForces,2), UBOUND(InData%StoredForces,2) - DO i1 = LBOUND(InData%StoredForces,1), UBOUND(InData%StoredForces,1) - ReKiBuf(Re_Xferred) = InData%StoredForces(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StoredMoments) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StoredMoments,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StoredMoments,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StoredMoments,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StoredMoments,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StoredMoments,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StoredMoments,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%StoredMoments,3), UBOUND(InData%StoredMoments,3) - DO i2 = LBOUND(InData%StoredMoments,2), UBOUND(InData%StoredMoments,2) - DO i1 = LBOUND(InData%StoredMoments,1), UBOUND(InData%StoredMoments,1) - ReKiBuf(Re_Xferred) = InData%StoredMoments(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE AD14_PackMisc - - SUBROUTINE AD14_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AD14_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL DWM_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%DWM, ErrStat2, ErrMsg2 ) ! DWM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL DWM_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%DWM_Inputs, ErrStat2, ErrMsg2 ) ! DWM_Inputs - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL DWM_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%DWM_Outputs, ErrStat2, ErrMsg2 ) ! DWM_Outputs - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElPrNum not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ElPrNum)) DEALLOCATE(OutData%ElPrNum) - ALLOCATE(OutData%ElPrNum(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElPrNum.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ElPrNum,1), UBOUND(OutData%ElPrNum,1) - OutData%ElPrNum(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%OldTime = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%HubLoss = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Loss = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TipLoss = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TLpt7 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%FirstPassGTL = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstPassGTL) - Int_Xferred = Int_Xferred + 1 - OutData%SuperSonic = TRANSFER(IntKiBuf(Int_Xferred), OutData%SuperSonic) - Int_Xferred = Int_Xferred + 1 - OutData%AFLAGVinderr = TRANSFER(IntKiBuf(Int_Xferred), OutData%AFLAGVinderr) - Int_Xferred = Int_Xferred + 1 - OutData%AFLAGTwrInflu = TRANSFER(IntKiBuf(Int_Xferred), OutData%AFLAGTwrInflu) - Int_Xferred = Int_Xferred + 1 - OutData%OnePassDynDbg = TRANSFER(IntKiBuf(Int_Xferred), OutData%OnePassDynDbg) - Int_Xferred = Int_Xferred + 1 - OutData%NoLoadsCalculated = TRANSFER(IntKiBuf(Int_Xferred), OutData%NoLoadsCalculated) - Int_Xferred = Int_Xferred + 1 - OutData%NERRORS = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD14_UnpackAirFoil( Re_Buf, Db_Buf, Int_Buf, OutData%AirFoil, ErrStat2, ErrMsg2 ) ! AirFoil - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD14_UnpackBeddoes( Re_Buf, Db_Buf, Int_Buf, OutData%Beddoes, ErrStat2, ErrMsg2 ) ! Beddoes - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD14_UnpackDynInflow( Re_Buf, Db_Buf, Int_Buf, OutData%DynInflow, ErrStat2, ErrMsg2 ) ! DynInflow - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD14_UnpackElement( Re_Buf, Db_Buf, Int_Buf, OutData%Element, ErrStat2, ErrMsg2 ) ! Element - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD14_UnpackRotor( Re_Buf, Db_Buf, Int_Buf, OutData%Rotor, ErrStat2, ErrMsg2 ) ! Rotor - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD14_UnpackWind( Re_Buf, Db_Buf, Int_Buf, OutData%Wind, ErrStat2, ErrMsg2 ) ! Wind - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD14_UnpackInducedVel( Re_Buf, Db_Buf, Int_Buf, OutData%InducedVel, ErrStat2, ErrMsg2 ) ! InducedVel - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD14_UnpackElOutParms( Re_Buf, Db_Buf, Int_Buf, OutData%ElOut, ErrStat2, ErrMsg2 ) ! ElOut - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%Skew = TRANSFER(IntKiBuf(Int_Xferred), OutData%Skew) - Int_Xferred = Int_Xferred + 1 - OutData%DynInit = TRANSFER(IntKiBuf(Int_Xferred), OutData%DynInit) - Int_Xferred = Int_Xferred + 1 - OutData%FirstWarn = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StoredForces not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%StoredForces)) DEALLOCATE(OutData%StoredForces) - ALLOCATE(OutData%StoredForces(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StoredForces.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%StoredForces,3), UBOUND(OutData%StoredForces,3) - DO i2 = LBOUND(OutData%StoredForces,2), UBOUND(OutData%StoredForces,2) - DO i1 = LBOUND(OutData%StoredForces,1), UBOUND(OutData%StoredForces,1) - OutData%StoredForces(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StoredMoments not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%StoredMoments)) DEALLOCATE(OutData%StoredMoments) - ALLOCATE(OutData%StoredMoments(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StoredMoments.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%StoredMoments,3), UBOUND(OutData%StoredMoments,3) - DO i2 = LBOUND(OutData%StoredMoments,2), UBOUND(OutData%StoredMoments,2) - DO i1 = LBOUND(OutData%StoredMoments,1), UBOUND(OutData%StoredMoments,1) - OutData%StoredMoments(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE AD14_UnPackMisc +subroutine AD14_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD14_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + ! DWM + call DWM_PackMisc(Buf, InData%DWM) + if (RegCheckErr(Buf, RoutineName)) return + ! DWM_Inputs + call DWM_PackInput(Buf, InData%DWM_Inputs) + if (RegCheckErr(Buf, RoutineName)) return + ! DWM_Outputs + call DWM_PackOutput(Buf, InData%DWM_Outputs) + if (RegCheckErr(Buf, RoutineName)) return + ! DT + call RegPack(Buf, InData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! ElPrNum + call RegPack(Buf, allocated(InData%ElPrNum)) + if (allocated(InData%ElPrNum)) then + call RegPackBounds(Buf, 1, lbound(InData%ElPrNum), ubound(InData%ElPrNum)) + call RegPack(Buf, InData%ElPrNum) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OldTime + call RegPack(Buf, InData%OldTime) + if (RegCheckErr(Buf, RoutineName)) return + ! HubLoss + call RegPack(Buf, InData%HubLoss) + if (RegCheckErr(Buf, RoutineName)) return + ! Loss + call RegPack(Buf, InData%Loss) + if (RegCheckErr(Buf, RoutineName)) return + ! TipLoss + call RegPack(Buf, InData%TipLoss) + if (RegCheckErr(Buf, RoutineName)) return + ! TLpt7 + call RegPack(Buf, InData%TLpt7) + if (RegCheckErr(Buf, RoutineName)) return + ! FirstPassGTL + call RegPack(Buf, InData%FirstPassGTL) + if (RegCheckErr(Buf, RoutineName)) return + ! SuperSonic + call RegPack(Buf, InData%SuperSonic) + if (RegCheckErr(Buf, RoutineName)) return + ! AFLAGVinderr + call RegPack(Buf, InData%AFLAGVinderr) + if (RegCheckErr(Buf, RoutineName)) return + ! AFLAGTwrInflu + call RegPack(Buf, InData%AFLAGTwrInflu) + if (RegCheckErr(Buf, RoutineName)) return + ! OnePassDynDbg + call RegPack(Buf, InData%OnePassDynDbg) + if (RegCheckErr(Buf, RoutineName)) return + ! NoLoadsCalculated + call RegPack(Buf, InData%NoLoadsCalculated) + if (RegCheckErr(Buf, RoutineName)) return + ! NERRORS + call RegPack(Buf, InData%NERRORS) + if (RegCheckErr(Buf, RoutineName)) return + ! AirFoil + call AD14_PackAirFoil(Buf, InData%AirFoil) + if (RegCheckErr(Buf, RoutineName)) return + ! Beddoes + call AD14_PackBeddoes(Buf, InData%Beddoes) + if (RegCheckErr(Buf, RoutineName)) return + ! DynInflow + call AD14_PackDynInflow(Buf, InData%DynInflow) + if (RegCheckErr(Buf, RoutineName)) return + ! Element + call AD14_PackElement(Buf, InData%Element) + if (RegCheckErr(Buf, RoutineName)) return + ! Rotor + call AD14_PackRotor(Buf, InData%Rotor) + if (RegCheckErr(Buf, RoutineName)) return + ! Wind + call AD14_PackWind(Buf, InData%Wind) + if (RegCheckErr(Buf, RoutineName)) return + ! InducedVel + call AD14_PackInducedVel(Buf, InData%InducedVel) + if (RegCheckErr(Buf, RoutineName)) return + ! ElOut + call AD14_PackElOutParms(Buf, InData%ElOut) + if (RegCheckErr(Buf, RoutineName)) return + ! Skew + call RegPack(Buf, InData%Skew) + if (RegCheckErr(Buf, RoutineName)) return + ! DynInit + call RegPack(Buf, InData%DynInit) + if (RegCheckErr(Buf, RoutineName)) return + ! FirstWarn + call RegPack(Buf, InData%FirstWarn) + if (RegCheckErr(Buf, RoutineName)) return + ! StoredForces + call RegPack(Buf, allocated(InData%StoredForces)) + if (allocated(InData%StoredForces)) then + call RegPackBounds(Buf, 3, lbound(InData%StoredForces), ubound(InData%StoredForces)) + call RegPack(Buf, InData%StoredForces) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! StoredMoments + call RegPack(Buf, allocated(InData%StoredMoments)) + if (allocated(InData%StoredMoments)) then + call RegPackBounds(Buf, 3, lbound(InData%StoredMoments), ubound(InData%StoredMoments)) + call RegPack(Buf, InData%StoredMoments) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD14_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackMisc' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! DWM + call DWM_UnpackMisc(Buf, OutData%DWM) ! DWM + ! DWM_Inputs + call DWM_UnpackInput(Buf, OutData%DWM_Inputs) ! DWM_Inputs + ! DWM_Outputs + call DWM_UnpackOutput(Buf, OutData%DWM_Outputs) ! DWM_Outputs + ! DT + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! ElPrNum + if (allocated(OutData%ElPrNum)) deallocate(OutData%ElPrNum) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ElPrNum(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElPrNum.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ElPrNum) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! OldTime + call RegUnpack(Buf, OutData%OldTime) + if (RegCheckErr(Buf, RoutineName)) return + ! HubLoss + call RegUnpack(Buf, OutData%HubLoss) + if (RegCheckErr(Buf, RoutineName)) return + ! Loss + call RegUnpack(Buf, OutData%Loss) + if (RegCheckErr(Buf, RoutineName)) return + ! TipLoss + call RegUnpack(Buf, OutData%TipLoss) + if (RegCheckErr(Buf, RoutineName)) return + ! TLpt7 + call RegUnpack(Buf, OutData%TLpt7) + if (RegCheckErr(Buf, RoutineName)) return + ! FirstPassGTL + call RegUnpack(Buf, OutData%FirstPassGTL) + if (RegCheckErr(Buf, RoutineName)) return + ! SuperSonic + call RegUnpack(Buf, OutData%SuperSonic) + if (RegCheckErr(Buf, RoutineName)) return + ! AFLAGVinderr + call RegUnpack(Buf, OutData%AFLAGVinderr) + if (RegCheckErr(Buf, RoutineName)) return + ! AFLAGTwrInflu + call RegUnpack(Buf, OutData%AFLAGTwrInflu) + if (RegCheckErr(Buf, RoutineName)) return + ! OnePassDynDbg + call RegUnpack(Buf, OutData%OnePassDynDbg) + if (RegCheckErr(Buf, RoutineName)) return + ! NoLoadsCalculated + call RegUnpack(Buf, OutData%NoLoadsCalculated) + if (RegCheckErr(Buf, RoutineName)) return + ! NERRORS + call RegUnpack(Buf, OutData%NERRORS) + if (RegCheckErr(Buf, RoutineName)) return + ! AirFoil + call AD14_UnpackAirFoil(Buf, OutData%AirFoil) ! AirFoil + ! Beddoes + call AD14_UnpackBeddoes(Buf, OutData%Beddoes) ! Beddoes + ! DynInflow + call AD14_UnpackDynInflow(Buf, OutData%DynInflow) ! DynInflow + ! Element + call AD14_UnpackElement(Buf, OutData%Element) ! Element + ! Rotor + call AD14_UnpackRotor(Buf, OutData%Rotor) ! Rotor + ! Wind + call AD14_UnpackWind(Buf, OutData%Wind) ! Wind + ! InducedVel + call AD14_UnpackInducedVel(Buf, OutData%InducedVel) ! InducedVel + ! ElOut + call AD14_UnpackElOutParms(Buf, OutData%ElOut) ! ElOut + ! Skew + call RegUnpack(Buf, OutData%Skew) + if (RegCheckErr(Buf, RoutineName)) return + ! DynInit + call RegUnpack(Buf, OutData%DynInit) + if (RegCheckErr(Buf, RoutineName)) return + ! FirstWarn + call RegUnpack(Buf, OutData%FirstWarn) + if (RegCheckErr(Buf, RoutineName)) return + ! StoredForces + if (allocated(OutData%StoredForces)) deallocate(OutData%StoredForces) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StoredForces(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StoredForces.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StoredForces) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! StoredMoments + if (allocated(OutData%StoredMoments)) deallocate(OutData%StoredMoments) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StoredMoments(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StoredMoments.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StoredMoments) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE AD14_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(AD14_ParameterType), INTENT(IN) :: SrcParamData TYPE(AD14_ParameterType), INTENT(INOUT) :: DstParamData @@ -14291,1078 +7307,220 @@ SUBROUTINE AD14_DestroyParam( ParamData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AD14_DestroyParam - SUBROUTINE AD14_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AD14_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%Title) ! Title - Int_BufSz = Int_BufSz + 1 ! SIUnit - Int_BufSz = Int_BufSz + 1 ! Echo - Int_BufSz = Int_BufSz + 1 ! MultiTab - Int_BufSz = Int_BufSz + 1 ! LinearizeFlag - Int_BufSz = Int_BufSz + 1 ! OutputPlottingInfo - Int_BufSz = Int_BufSz + 1 ! UseDWM - Re_BufSz = Re_BufSz + 1 ! TwoPiNB - Int_BufSz = Int_BufSz + 1 ! NumBl - Int_BufSz = Int_BufSz + 1 ! NBlInpSt - Int_BufSz = Int_BufSz + 1 ! ElemPrn - Int_BufSz = Int_BufSz + 1 ! DStall - Int_BufSz = Int_BufSz + 1 ! PMoment - Int_BufSz = Int_BufSz + 1 ! Reynolds - Int_BufSz = Int_BufSz + 1 ! DynInfl - Int_BufSz = Int_BufSz + 1 ! Wake - Int_BufSz = Int_BufSz + 1 ! Swirl - Db_BufSz = Db_BufSz + 1 ! DtAero - Re_BufSz = Re_BufSz + 1 ! HubRad - Int_BufSz = Int_BufSz + 1 ! UnEc - Int_BufSz = Int_BufSz + 1 ! UnElem - Int_BufSz = Int_BufSz + 1 ! UnWndOut - Int_BufSz = Int_BufSz + 1 ! MAXICOUNT - Int_BufSz = Int_BufSz + 1 ! WrOptFile - Int_BufSz = Int_BufSz + 1 ! DEFAULT_Wind - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! AirFoil: size of buffers for each call to pack subtype - CALL AD14_PackAirFoilParms( Re_Buf, Db_Buf, Int_Buf, InData%AirFoil, ErrStat2, ErrMsg2, .TRUE. ) ! AirFoil - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AirFoil - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AirFoil - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AirFoil - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Blade: size of buffers for each call to pack subtype - CALL AD14_PackBladeParms( Re_Buf, Db_Buf, Int_Buf, InData%Blade, ErrStat2, ErrMsg2, .TRUE. ) ! Blade - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Blade - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Blade - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Blade - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Beddoes: size of buffers for each call to pack subtype - CALL AD14_PackBeddoesParms( Re_Buf, Db_Buf, Int_Buf, InData%Beddoes, ErrStat2, ErrMsg2, .TRUE. ) ! Beddoes - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Beddoes - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Beddoes - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Beddoes - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! DynInflow: size of buffers for each call to pack subtype - CALL AD14_PackDynInflowParms( Re_Buf, Db_Buf, Int_Buf, InData%DynInflow, ErrStat2, ErrMsg2, .TRUE. ) ! DynInflow - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DynInflow - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DynInflow - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DynInflow - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Element: size of buffers for each call to pack subtype - CALL AD14_PackElementParms( Re_Buf, Db_Buf, Int_Buf, InData%Element, ErrStat2, ErrMsg2, .TRUE. ) ! Element - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Element - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Element - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Element - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! TwrProps: size of buffers for each call to pack subtype - CALL AD14_PackTwrPropsParms( Re_Buf, Db_Buf, Int_Buf, InData%TwrProps, ErrStat2, ErrMsg2, .TRUE. ) ! TwrProps - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TwrProps - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TwrProps - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TwrProps - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InducedVel: size of buffers for each call to pack subtype - CALL AD14_PackInducedVelParms( Re_Buf, Db_Buf, Int_Buf, InData%InducedVel, ErrStat2, ErrMsg2, .TRUE. ) ! InducedVel - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InducedVel - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InducedVel - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InducedVel - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Wind: size of buffers for each call to pack subtype - CALL AD14_PackWindParms( Re_Buf, Db_Buf, Int_Buf, InData%Wind, ErrStat2, ErrMsg2, .TRUE. ) ! Wind - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Wind - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Wind - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Wind - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Rotor: size of buffers for each call to pack subtype - CALL AD14_PackRotorParms( Re_Buf, Db_Buf, Int_Buf, InData%Rotor, ErrStat2, ErrMsg2, .TRUE. ) ! Rotor - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Rotor - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Rotor - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Rotor - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! DWM: size of buffers for each call to pack subtype - CALL DWM_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, .TRUE. ) ! DWM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DWM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DWM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DWM - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%Title) - IntKiBuf(Int_Xferred) = ICHAR(InData%Title(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%SIUnit, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Echo, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%MultiTab, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%LinearizeFlag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%OutputPlottingInfo, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseDWM, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TwoPiNB - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBl - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NBlInpSt - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%ElemPrn, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%DStall, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%PMoment, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Reynolds, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%DynInfl, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Wake, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Swirl, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%DtAero - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubRad - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UnEc - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UnElem - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UnWndOut - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MAXICOUNT - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WrOptFile, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%DEFAULT_Wind - Int_Xferred = Int_Xferred + 1 - CALL AD14_PackAirFoilParms( Re_Buf, Db_Buf, Int_Buf, InData%AirFoil, ErrStat2, ErrMsg2, OnlySize ) ! AirFoil - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD14_PackBladeParms( Re_Buf, Db_Buf, Int_Buf, InData%Blade, ErrStat2, ErrMsg2, OnlySize ) ! Blade - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD14_PackBeddoesParms( Re_Buf, Db_Buf, Int_Buf, InData%Beddoes, ErrStat2, ErrMsg2, OnlySize ) ! Beddoes - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD14_PackDynInflowParms( Re_Buf, Db_Buf, Int_Buf, InData%DynInflow, ErrStat2, ErrMsg2, OnlySize ) ! DynInflow - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD14_PackElementParms( Re_Buf, Db_Buf, Int_Buf, InData%Element, ErrStat2, ErrMsg2, OnlySize ) ! Element - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD14_PackTwrPropsParms( Re_Buf, Db_Buf, Int_Buf, InData%TwrProps, ErrStat2, ErrMsg2, OnlySize ) ! TwrProps - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD14_PackInducedVelParms( Re_Buf, Db_Buf, Int_Buf, InData%InducedVel, ErrStat2, ErrMsg2, OnlySize ) ! InducedVel - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD14_PackWindParms( Re_Buf, Db_Buf, Int_Buf, InData%Wind, ErrStat2, ErrMsg2, OnlySize ) ! Wind - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD14_PackRotorParms( Re_Buf, Db_Buf, Int_Buf, InData%Rotor, ErrStat2, ErrMsg2, OnlySize ) ! Rotor - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL DWM_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, OnlySize ) ! DWM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE AD14_PackParam - - SUBROUTINE AD14_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AD14_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%Title) - OutData%Title(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%SIUnit = TRANSFER(IntKiBuf(Int_Xferred), OutData%SIUnit) - Int_Xferred = Int_Xferred + 1 - OutData%Echo = TRANSFER(IntKiBuf(Int_Xferred), OutData%Echo) - Int_Xferred = Int_Xferred + 1 - OutData%MultiTab = TRANSFER(IntKiBuf(Int_Xferred), OutData%MultiTab) - Int_Xferred = Int_Xferred + 1 - OutData%LinearizeFlag = TRANSFER(IntKiBuf(Int_Xferred), OutData%LinearizeFlag) - Int_Xferred = Int_Xferred + 1 - OutData%OutputPlottingInfo = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutputPlottingInfo) - Int_Xferred = Int_Xferred + 1 - OutData%UseDWM = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseDWM) - Int_Xferred = Int_Xferred + 1 - OutData%TwoPiNB = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NumBl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NBlInpSt = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ElemPrn = TRANSFER(IntKiBuf(Int_Xferred), OutData%ElemPrn) - Int_Xferred = Int_Xferred + 1 - OutData%DStall = TRANSFER(IntKiBuf(Int_Xferred), OutData%DStall) - Int_Xferred = Int_Xferred + 1 - OutData%PMoment = TRANSFER(IntKiBuf(Int_Xferred), OutData%PMoment) - Int_Xferred = Int_Xferred + 1 - OutData%Reynolds = TRANSFER(IntKiBuf(Int_Xferred), OutData%Reynolds) - Int_Xferred = Int_Xferred + 1 - OutData%DynInfl = TRANSFER(IntKiBuf(Int_Xferred), OutData%DynInfl) - Int_Xferred = Int_Xferred + 1 - OutData%Wake = TRANSFER(IntKiBuf(Int_Xferred), OutData%Wake) - Int_Xferred = Int_Xferred + 1 - OutData%Swirl = TRANSFER(IntKiBuf(Int_Xferred), OutData%Swirl) - Int_Xferred = Int_Xferred + 1 - OutData%DtAero = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%HubRad = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%UnEc = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UnElem = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UnWndOut = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MAXICOUNT = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WrOptFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%WrOptFile) - Int_Xferred = Int_Xferred + 1 - OutData%DEFAULT_Wind = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD14_UnpackAirFoilParms( Re_Buf, Db_Buf, Int_Buf, OutData%AirFoil, ErrStat2, ErrMsg2 ) ! AirFoil - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD14_UnpackBladeParms( Re_Buf, Db_Buf, Int_Buf, OutData%Blade, ErrStat2, ErrMsg2 ) ! Blade - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD14_UnpackBeddoesParms( Re_Buf, Db_Buf, Int_Buf, OutData%Beddoes, ErrStat2, ErrMsg2 ) ! Beddoes - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD14_UnpackDynInflowParms( Re_Buf, Db_Buf, Int_Buf, OutData%DynInflow, ErrStat2, ErrMsg2 ) ! DynInflow - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD14_UnpackElementParms( Re_Buf, Db_Buf, Int_Buf, OutData%Element, ErrStat2, ErrMsg2 ) ! Element - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD14_UnpackTwrPropsParms( Re_Buf, Db_Buf, Int_Buf, OutData%TwrProps, ErrStat2, ErrMsg2 ) ! TwrProps - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD14_UnpackInducedVelParms( Re_Buf, Db_Buf, Int_Buf, OutData%InducedVel, ErrStat2, ErrMsg2 ) ! InducedVel - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD14_UnpackWindParms( Re_Buf, Db_Buf, Int_Buf, OutData%Wind, ErrStat2, ErrMsg2 ) ! Wind - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD14_UnpackRotorParms( Re_Buf, Db_Buf, Int_Buf, OutData%Rotor, ErrStat2, ErrMsg2 ) ! Rotor - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL DWM_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%DWM, ErrStat2, ErrMsg2 ) ! DWM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE AD14_UnPackParam +subroutine AD14_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD14_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackParam' + if (Buf%ErrStat >= AbortErrLev) return + ! Title + call RegPack(Buf, InData%Title) + if (RegCheckErr(Buf, RoutineName)) return + ! SIUnit + call RegPack(Buf, InData%SIUnit) + if (RegCheckErr(Buf, RoutineName)) return + ! Echo + call RegPack(Buf, InData%Echo) + if (RegCheckErr(Buf, RoutineName)) return + ! MultiTab + call RegPack(Buf, InData%MultiTab) + if (RegCheckErr(Buf, RoutineName)) return + ! LinearizeFlag + call RegPack(Buf, InData%LinearizeFlag) + if (RegCheckErr(Buf, RoutineName)) return + ! OutputPlottingInfo + call RegPack(Buf, InData%OutputPlottingInfo) + if (RegCheckErr(Buf, RoutineName)) return + ! UseDWM + call RegPack(Buf, InData%UseDWM) + if (RegCheckErr(Buf, RoutineName)) return + ! TwoPiNB + call RegPack(Buf, InData%TwoPiNB) + if (RegCheckErr(Buf, RoutineName)) return + ! NumBl + call RegPack(Buf, InData%NumBl) + if (RegCheckErr(Buf, RoutineName)) return + ! NBlInpSt + call RegPack(Buf, InData%NBlInpSt) + if (RegCheckErr(Buf, RoutineName)) return + ! ElemPrn + call RegPack(Buf, InData%ElemPrn) + if (RegCheckErr(Buf, RoutineName)) return + ! DStall + call RegPack(Buf, InData%DStall) + if (RegCheckErr(Buf, RoutineName)) return + ! PMoment + call RegPack(Buf, InData%PMoment) + if (RegCheckErr(Buf, RoutineName)) return + ! Reynolds + call RegPack(Buf, InData%Reynolds) + if (RegCheckErr(Buf, RoutineName)) return + ! DynInfl + call RegPack(Buf, InData%DynInfl) + if (RegCheckErr(Buf, RoutineName)) return + ! Wake + call RegPack(Buf, InData%Wake) + if (RegCheckErr(Buf, RoutineName)) return + ! Swirl + call RegPack(Buf, InData%Swirl) + if (RegCheckErr(Buf, RoutineName)) return + ! DtAero + call RegPack(Buf, InData%DtAero) + if (RegCheckErr(Buf, RoutineName)) return + ! HubRad + call RegPack(Buf, InData%HubRad) + if (RegCheckErr(Buf, RoutineName)) return + ! UnEc + call RegPack(Buf, InData%UnEc) + if (RegCheckErr(Buf, RoutineName)) return + ! UnElem + call RegPack(Buf, InData%UnElem) + if (RegCheckErr(Buf, RoutineName)) return + ! UnWndOut + call RegPack(Buf, InData%UnWndOut) + if (RegCheckErr(Buf, RoutineName)) return + ! MAXICOUNT + call RegPack(Buf, InData%MAXICOUNT) + if (RegCheckErr(Buf, RoutineName)) return + ! WrOptFile + call RegPack(Buf, InData%WrOptFile) + if (RegCheckErr(Buf, RoutineName)) return + ! DEFAULT_Wind + call RegPack(Buf, InData%DEFAULT_Wind) + if (RegCheckErr(Buf, RoutineName)) return + ! AirFoil + call AD14_PackAirFoilParms(Buf, InData%AirFoil) + if (RegCheckErr(Buf, RoutineName)) return + ! Blade + call AD14_PackBladeParms(Buf, InData%Blade) + if (RegCheckErr(Buf, RoutineName)) return + ! Beddoes + call AD14_PackBeddoesParms(Buf, InData%Beddoes) + if (RegCheckErr(Buf, RoutineName)) return + ! DynInflow + call AD14_PackDynInflowParms(Buf, InData%DynInflow) + if (RegCheckErr(Buf, RoutineName)) return + ! Element + call AD14_PackElementParms(Buf, InData%Element) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrProps + call AD14_PackTwrPropsParms(Buf, InData%TwrProps) + if (RegCheckErr(Buf, RoutineName)) return + ! InducedVel + call AD14_PackInducedVelParms(Buf, InData%InducedVel) + if (RegCheckErr(Buf, RoutineName)) return + ! Wind + call AD14_PackWindParms(Buf, InData%Wind) + if (RegCheckErr(Buf, RoutineName)) return + ! Rotor + call AD14_PackRotorParms(Buf, InData%Rotor) + if (RegCheckErr(Buf, RoutineName)) return + ! DWM + call DWM_PackParam(Buf, InData%DWM) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD14_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackParam' + if (Buf%ErrStat /= ErrID_None) return + ! Title + call RegUnpack(Buf, OutData%Title) + if (RegCheckErr(Buf, RoutineName)) return + ! SIUnit + call RegUnpack(Buf, OutData%SIUnit) + if (RegCheckErr(Buf, RoutineName)) return + ! Echo + call RegUnpack(Buf, OutData%Echo) + if (RegCheckErr(Buf, RoutineName)) return + ! MultiTab + call RegUnpack(Buf, OutData%MultiTab) + if (RegCheckErr(Buf, RoutineName)) return + ! LinearizeFlag + call RegUnpack(Buf, OutData%LinearizeFlag) + if (RegCheckErr(Buf, RoutineName)) return + ! OutputPlottingInfo + call RegUnpack(Buf, OutData%OutputPlottingInfo) + if (RegCheckErr(Buf, RoutineName)) return + ! UseDWM + call RegUnpack(Buf, OutData%UseDWM) + if (RegCheckErr(Buf, RoutineName)) return + ! TwoPiNB + call RegUnpack(Buf, OutData%TwoPiNB) + if (RegCheckErr(Buf, RoutineName)) return + ! NumBl + call RegUnpack(Buf, OutData%NumBl) + if (RegCheckErr(Buf, RoutineName)) return + ! NBlInpSt + call RegUnpack(Buf, OutData%NBlInpSt) + if (RegCheckErr(Buf, RoutineName)) return + ! ElemPrn + call RegUnpack(Buf, OutData%ElemPrn) + if (RegCheckErr(Buf, RoutineName)) return + ! DStall + call RegUnpack(Buf, OutData%DStall) + if (RegCheckErr(Buf, RoutineName)) return + ! PMoment + call RegUnpack(Buf, OutData%PMoment) + if (RegCheckErr(Buf, RoutineName)) return + ! Reynolds + call RegUnpack(Buf, OutData%Reynolds) + if (RegCheckErr(Buf, RoutineName)) return + ! DynInfl + call RegUnpack(Buf, OutData%DynInfl) + if (RegCheckErr(Buf, RoutineName)) return + ! Wake + call RegUnpack(Buf, OutData%Wake) + if (RegCheckErr(Buf, RoutineName)) return + ! Swirl + call RegUnpack(Buf, OutData%Swirl) + if (RegCheckErr(Buf, RoutineName)) return + ! DtAero + call RegUnpack(Buf, OutData%DtAero) + if (RegCheckErr(Buf, RoutineName)) return + ! HubRad + call RegUnpack(Buf, OutData%HubRad) + if (RegCheckErr(Buf, RoutineName)) return + ! UnEc + call RegUnpack(Buf, OutData%UnEc) + if (RegCheckErr(Buf, RoutineName)) return + ! UnElem + call RegUnpack(Buf, OutData%UnElem) + if (RegCheckErr(Buf, RoutineName)) return + ! UnWndOut + call RegUnpack(Buf, OutData%UnWndOut) + if (RegCheckErr(Buf, RoutineName)) return + ! MAXICOUNT + call RegUnpack(Buf, OutData%MAXICOUNT) + if (RegCheckErr(Buf, RoutineName)) return + ! WrOptFile + call RegUnpack(Buf, OutData%WrOptFile) + if (RegCheckErr(Buf, RoutineName)) return + ! DEFAULT_Wind + call RegUnpack(Buf, OutData%DEFAULT_Wind) + if (RegCheckErr(Buf, RoutineName)) return + ! AirFoil + call AD14_UnpackAirFoilParms(Buf, OutData%AirFoil) ! AirFoil + ! Blade + call AD14_UnpackBladeParms(Buf, OutData%Blade) ! Blade + ! Beddoes + call AD14_UnpackBeddoesParms(Buf, OutData%Beddoes) ! Beddoes + ! DynInflow + call AD14_UnpackDynInflowParms(Buf, OutData%DynInflow) ! DynInflow + ! Element + call AD14_UnpackElementParms(Buf, OutData%Element) ! Element + ! TwrProps + call AD14_UnpackTwrPropsParms(Buf, OutData%TwrProps) ! TwrProps + ! InducedVel + call AD14_UnpackInducedVelParms(Buf, OutData%InducedVel) ! InducedVel + ! Wind + call AD14_UnpackWindParms(Buf, OutData%Wind) ! Wind + ! Rotor + call AD14_UnpackRotorParms(Buf, OutData%Rotor) ! Rotor + ! DWM + call DWM_UnpackParam(Buf, OutData%DWM) ! DWM +end subroutine SUBROUTINE AD14_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(AD14_InputType), INTENT(INOUT) :: SrcInputData TYPE(AD14_InputType), INTENT(INOUT) :: DstInputData @@ -15464,498 +7622,113 @@ SUBROUTINE AD14_DestroyInput( InputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE AD14_DestroyInput - SUBROUTINE AD14_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AD14_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! InputMarkers allocated yes/no - IF ( ALLOCATED(InData%InputMarkers) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputMarkers upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%InputMarkers,1), UBOUND(InData%InputMarkers,1) - Int_BufSz = Int_BufSz + 3 ! InputMarkers: size of buffers for each call to pack subtype - CALL MeshPack( InData%InputMarkers(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! InputMarkers - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InputMarkers - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InputMarkers - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InputMarkers - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! Twr_InputMarkers: size of buffers for each call to pack subtype - CALL MeshPack( InData%Twr_InputMarkers, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! Twr_InputMarkers - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Twr_InputMarkers - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Twr_InputMarkers - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Twr_InputMarkers - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! TurbineComponents: size of buffers for each call to pack subtype - CALL AD14_PackAeroConfig( Re_Buf, Db_Buf, Int_Buf, InData%TurbineComponents, ErrStat2, ErrMsg2, .TRUE. ) ! TurbineComponents - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TurbineComponents - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TurbineComponents - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TurbineComponents - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! MulTabLoc allocated yes/no - IF ( ALLOCATED(InData%MulTabLoc) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MulTabLoc upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MulTabLoc) ! MulTabLoc - END IF - Int_BufSz = Int_BufSz + 1 ! InflowVelocity allocated yes/no - IF ( ALLOCATED(InData%InflowVelocity) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! InflowVelocity upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%InflowVelocity) ! InflowVelocity - END IF - Re_BufSz = Re_BufSz + SIZE(InData%AvgInfVel) ! AvgInfVel - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%InputMarkers) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputMarkers,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputMarkers,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InputMarkers,1), UBOUND(InData%InputMarkers,1) - CALL MeshPack( InData%InputMarkers(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! InputMarkers - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL MeshPack( InData%Twr_InputMarkers, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! Twr_InputMarkers - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD14_PackAeroConfig( Re_Buf, Db_Buf, Int_Buf, InData%TurbineComponents, ErrStat2, ErrMsg2, OnlySize ) ! TurbineComponents - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%MulTabLoc) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MulTabLoc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MulTabLoc,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MulTabLoc,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MulTabLoc,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MulTabLoc,2), UBOUND(InData%MulTabLoc,2) - DO i1 = LBOUND(InData%MulTabLoc,1), UBOUND(InData%MulTabLoc,1) - ReKiBuf(Re_Xferred) = InData%MulTabLoc(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InflowVelocity) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InflowVelocity,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InflowVelocity,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InflowVelocity,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InflowVelocity,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%InflowVelocity,2), UBOUND(InData%InflowVelocity,2) - DO i1 = LBOUND(InData%InflowVelocity,1), UBOUND(InData%InflowVelocity,1) - ReKiBuf(Re_Xferred) = InData%InflowVelocity(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%AvgInfVel,1), UBOUND(InData%AvgInfVel,1) - ReKiBuf(Re_Xferred) = InData%AvgInfVel(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE AD14_PackInput - - SUBROUTINE AD14_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AD14_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputMarkers not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InputMarkers)) DEALLOCATE(OutData%InputMarkers) - ALLOCATE(OutData%InputMarkers(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputMarkers.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InputMarkers,1), UBOUND(OutData%InputMarkers,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%InputMarkers(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! InputMarkers - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%Twr_InputMarkers, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! Twr_InputMarkers - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD14_UnpackAeroConfig( Re_Buf, Db_Buf, Int_Buf, OutData%TurbineComponents, ErrStat2, ErrMsg2 ) ! TurbineComponents - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MulTabLoc not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MulTabLoc)) DEALLOCATE(OutData%MulTabLoc) - ALLOCATE(OutData%MulTabLoc(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MulTabLoc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MulTabLoc,2), UBOUND(OutData%MulTabLoc,2) - DO i1 = LBOUND(OutData%MulTabLoc,1), UBOUND(OutData%MulTabLoc,1) - OutData%MulTabLoc(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InflowVelocity not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InflowVelocity)) DEALLOCATE(OutData%InflowVelocity) - ALLOCATE(OutData%InflowVelocity(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InflowVelocity.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%InflowVelocity,2), UBOUND(OutData%InflowVelocity,2) - DO i1 = LBOUND(OutData%InflowVelocity,1), UBOUND(OutData%InflowVelocity,1) - OutData%InflowVelocity(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%AvgInfVel,1) - i1_u = UBOUND(OutData%AvgInfVel,1) - DO i1 = LBOUND(OutData%AvgInfVel,1), UBOUND(OutData%AvgInfVel,1) - OutData%AvgInfVel(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE AD14_UnPackInput +subroutine AD14_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD14_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackInput' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + ! InputMarkers + call RegPack(Buf, allocated(InData%InputMarkers)) + if (allocated(InData%InputMarkers)) then + call RegPackBounds(Buf, 1, lbound(InData%InputMarkers), ubound(InData%InputMarkers)) + LB(1:1) = lbound(InData%InputMarkers) + UB(1:1) = ubound(InData%InputMarkers) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%InputMarkers(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Twr_InputMarkers + call MeshPack(Buf, InData%Twr_InputMarkers) + if (RegCheckErr(Buf, RoutineName)) return + ! TurbineComponents + call AD14_PackAeroConfig(Buf, InData%TurbineComponents) + if (RegCheckErr(Buf, RoutineName)) return + ! MulTabLoc + call RegPack(Buf, allocated(InData%MulTabLoc)) + if (allocated(InData%MulTabLoc)) then + call RegPackBounds(Buf, 2, lbound(InData%MulTabLoc), ubound(InData%MulTabLoc)) + call RegPack(Buf, InData%MulTabLoc) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! InflowVelocity + call RegPack(Buf, allocated(InData%InflowVelocity)) + if (allocated(InData%InflowVelocity)) then + call RegPackBounds(Buf, 2, lbound(InData%InflowVelocity), ubound(InData%InflowVelocity)) + call RegPack(Buf, InData%InflowVelocity) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AvgInfVel + call RegPack(Buf, InData%AvgInfVel) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD14_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackInput' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! InputMarkers + if (allocated(OutData%InputMarkers)) deallocate(OutData%InputMarkers) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InputMarkers(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputMarkers.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%InputMarkers(i1)) ! InputMarkers + end do + end if + ! Twr_InputMarkers + call MeshUnpack(Buf, OutData%Twr_InputMarkers) ! Twr_InputMarkers + ! TurbineComponents + call AD14_UnpackAeroConfig(Buf, OutData%TurbineComponents) ! TurbineComponents + ! MulTabLoc + if (allocated(OutData%MulTabLoc)) deallocate(OutData%MulTabLoc) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MulTabLoc(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MulTabLoc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MulTabLoc) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! InflowVelocity + if (allocated(OutData%InflowVelocity)) deallocate(OutData%InflowVelocity) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InflowVelocity(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InflowVelocity.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InflowVelocity) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AvgInfVel + call RegUnpack(Buf, OutData%AvgInfVel) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE AD14_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(AD14_OutputType), INTENT(INOUT) :: SrcOutputData TYPE(AD14_OutputType), INTENT(INOUT) :: DstOutputData @@ -16016,305 +7789,58 @@ SUBROUTINE AD14_DestroyOutput( OutputData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AD14_DestroyOutput - SUBROUTINE AD14_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AD14_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! OutputLoads allocated yes/no - IF ( ALLOCATED(InData%OutputLoads) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutputLoads upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%OutputLoads,1), UBOUND(InData%OutputLoads,1) - Int_BufSz = Int_BufSz + 3 ! OutputLoads: size of buffers for each call to pack subtype - CALL MeshPack( InData%OutputLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! OutputLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutputLoads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutputLoads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutputLoads - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! Twr_OutputLoads: size of buffers for each call to pack subtype - CALL MeshPack( InData%Twr_OutputLoads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! Twr_OutputLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Twr_OutputLoads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Twr_OutputLoads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Twr_OutputLoads - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%OutputLoads) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutputLoads,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutputLoads,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutputLoads,1), UBOUND(InData%OutputLoads,1) - CALL MeshPack( InData%OutputLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! OutputLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL MeshPack( InData%Twr_OutputLoads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! Twr_OutputLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE AD14_PackOutput - - SUBROUTINE AD14_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AD14_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutputLoads not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutputLoads)) DEALLOCATE(OutData%OutputLoads) - ALLOCATE(OutData%OutputLoads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutputLoads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutputLoads,1), UBOUND(OutData%OutputLoads,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%OutputLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! OutputLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%Twr_OutputLoads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! Twr_OutputLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE AD14_UnPackOutput +subroutine AD14_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD14_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD14_PackOutput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! OutputLoads + call RegPack(Buf, allocated(InData%OutputLoads)) + if (allocated(InData%OutputLoads)) then + call RegPackBounds(Buf, 1, lbound(InData%OutputLoads), ubound(InData%OutputLoads)) + LB(1:1) = lbound(InData%OutputLoads) + UB(1:1) = ubound(InData%OutputLoads) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%OutputLoads(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Twr_OutputLoads + call MeshPack(Buf, InData%Twr_OutputLoads) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AD14_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AD14_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD14_UnPackOutput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! OutputLoads + if (allocated(OutData%OutputLoads)) deallocate(OutData%OutputLoads) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutputLoads(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutputLoads.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%OutputLoads(i1)) ! OutputLoads + end do + end if + ! Twr_OutputLoads + call MeshUnpack(Buf, OutData%Twr_OutputLoads) ! Twr_OutputLoads +end subroutine SUBROUTINE AD14_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) ! diff --git a/modules/aerodyn14/src/DWM_Types.f90 b/modules/aerodyn14/src/DWM_Types.f90 index fc07b27626..03c0e18cc5 100644 --- a/modules/aerodyn14/src/DWM_Types.f90 +++ b/modules/aerodyn14/src/DWM_Types.f90 @@ -360,113 +360,38 @@ SUBROUTINE DWM_DestroyCVSD( CVSDData, ErrStat, ErrMsg ) END SUBROUTINE DWM_DestroyCVSD - SUBROUTINE DWM_PackCVSD( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(CVSD), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_PackCVSD' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! counter - Re_BufSz = Re_BufSz + 1 ! Denominator - Re_BufSz = Re_BufSz + 1 ! Numerator - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%counter - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Denominator - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Numerator - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DWM_PackCVSD - - SUBROUTINE DWM_UnPackCVSD( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(CVSD), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackCVSD' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%counter = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Denominator = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Numerator = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DWM_UnPackCVSD +subroutine DWM_PackCVSD(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(CVSD), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_PackCVSD' + if (Buf%ErrStat >= AbortErrLev) return + ! counter + call RegPack(Buf, InData%counter) + if (RegCheckErr(Buf, RoutineName)) return + ! Denominator + call RegPack(Buf, InData%Denominator) + if (RegCheckErr(Buf, RoutineName)) return + ! Numerator + call RegPack(Buf, InData%Numerator) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPackCVSD(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(CVSD), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPackCVSD' + if (Buf%ErrStat /= ErrID_None) return + ! counter + call RegUnpack(Buf, OutData%counter) + if (RegCheckErr(Buf, RoutineName)) return + ! Denominator + call RegUnpack(Buf, OutData%Denominator) + if (RegCheckErr(Buf, RoutineName)) return + ! Numerator + call RegUnpack(Buf, OutData%Numerator) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE DWM_Copyturbine_average_velocity_data( Srcturbine_average_velocity_dataData, Dstturbine_average_velocity_dataData, CtrlCode, ErrStat, ErrMsg ) TYPE(turbine_average_velocity_data), INTENT(IN) :: Srcturbine_average_velocity_dataData TYPE(turbine_average_velocity_data), INTENT(INOUT) :: Dstturbine_average_velocity_dataData @@ -562,266 +487,129 @@ SUBROUTINE DWM_Destroyturbine_average_velocity_data( turbine_average_velocity_da ENDIF END SUBROUTINE DWM_Destroyturbine_average_velocity_data - SUBROUTINE DWM_Packturbine_average_velocity_data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(turbine_average_velocity_data), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Packturbine_average_velocity_data' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! average_velocity_array_temp allocated yes/no - IF ( ALLOCATED(InData%average_velocity_array_temp) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! average_velocity_array_temp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%average_velocity_array_temp) ! average_velocity_array_temp - END IF - Int_BufSz = Int_BufSz + 1 ! average_velocity_array allocated yes/no - IF ( ALLOCATED(InData%average_velocity_array) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! average_velocity_array upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%average_velocity_array) ! average_velocity_array - END IF - Int_BufSz = Int_BufSz + 1 ! swept_area allocated yes/no - IF ( ALLOCATED(InData%swept_area) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! swept_area upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%swept_area) ! swept_area - END IF - Int_BufSz = Int_BufSz + 1 ! time_step_velocity - Int_BufSz = Int_BufSz + 1 ! time_step_velocity_array allocated yes/no - IF ( ALLOCATED(InData%time_step_velocity_array) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! time_step_velocity_array upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%time_step_velocity_array) ! time_step_velocity_array - END IF - Int_BufSz = Int_BufSz + 1 ! time_step_pass_velocity - Int_BufSz = Int_BufSz + 1 ! time_step_force - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%average_velocity_array_temp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%average_velocity_array_temp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%average_velocity_array_temp,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%average_velocity_array_temp,1), UBOUND(InData%average_velocity_array_temp,1) - ReKiBuf(Re_Xferred) = InData%average_velocity_array_temp(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%average_velocity_array) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%average_velocity_array,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%average_velocity_array,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%average_velocity_array,1), UBOUND(InData%average_velocity_array,1) - ReKiBuf(Re_Xferred) = InData%average_velocity_array(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%swept_area) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%swept_area,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%swept_area,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%swept_area,1), UBOUND(InData%swept_area,1) - ReKiBuf(Re_Xferred) = InData%swept_area(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%time_step_velocity - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%time_step_velocity_array) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%time_step_velocity_array,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%time_step_velocity_array,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%time_step_velocity_array,1), UBOUND(InData%time_step_velocity_array,1) - IntKiBuf(Int_Xferred) = InData%time_step_velocity_array(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%time_step_pass_velocity - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%time_step_force - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE DWM_Packturbine_average_velocity_data - - SUBROUTINE DWM_UnPackturbine_average_velocity_data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(turbine_average_velocity_data), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackturbine_average_velocity_data' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! average_velocity_array_temp not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%average_velocity_array_temp)) DEALLOCATE(OutData%average_velocity_array_temp) - ALLOCATE(OutData%average_velocity_array_temp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%average_velocity_array_temp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%average_velocity_array_temp,1), UBOUND(OutData%average_velocity_array_temp,1) - OutData%average_velocity_array_temp(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! average_velocity_array not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%average_velocity_array)) DEALLOCATE(OutData%average_velocity_array) - ALLOCATE(OutData%average_velocity_array(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%average_velocity_array.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%average_velocity_array,1), UBOUND(OutData%average_velocity_array,1) - OutData%average_velocity_array(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! swept_area not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%swept_area)) DEALLOCATE(OutData%swept_area) - ALLOCATE(OutData%swept_area(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%swept_area.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%swept_area,1), UBOUND(OutData%swept_area,1) - OutData%swept_area(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%time_step_velocity = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! time_step_velocity_array not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%time_step_velocity_array)) DEALLOCATE(OutData%time_step_velocity_array) - ALLOCATE(OutData%time_step_velocity_array(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%time_step_velocity_array.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%time_step_velocity_array,1), UBOUND(OutData%time_step_velocity_array,1) - OutData%time_step_velocity_array(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%time_step_pass_velocity = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%time_step_force = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE DWM_UnPackturbine_average_velocity_data +subroutine DWM_Packturbine_average_velocity_data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(turbine_average_velocity_data), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_Packturbine_average_velocity_data' + if (Buf%ErrStat >= AbortErrLev) return + ! average_velocity_array_temp + call RegPack(Buf, allocated(InData%average_velocity_array_temp)) + if (allocated(InData%average_velocity_array_temp)) then + call RegPackBounds(Buf, 1, lbound(InData%average_velocity_array_temp), ubound(InData%average_velocity_array_temp)) + call RegPack(Buf, InData%average_velocity_array_temp) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! average_velocity_array + call RegPack(Buf, allocated(InData%average_velocity_array)) + if (allocated(InData%average_velocity_array)) then + call RegPackBounds(Buf, 1, lbound(InData%average_velocity_array), ubound(InData%average_velocity_array)) + call RegPack(Buf, InData%average_velocity_array) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! swept_area + call RegPack(Buf, allocated(InData%swept_area)) + if (allocated(InData%swept_area)) then + call RegPackBounds(Buf, 1, lbound(InData%swept_area), ubound(InData%swept_area)) + call RegPack(Buf, InData%swept_area) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! time_step_velocity + call RegPack(Buf, InData%time_step_velocity) + if (RegCheckErr(Buf, RoutineName)) return + ! time_step_velocity_array + call RegPack(Buf, allocated(InData%time_step_velocity_array)) + if (allocated(InData%time_step_velocity_array)) then + call RegPackBounds(Buf, 1, lbound(InData%time_step_velocity_array), ubound(InData%time_step_velocity_array)) + call RegPack(Buf, InData%time_step_velocity_array) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! time_step_pass_velocity + call RegPack(Buf, InData%time_step_pass_velocity) + if (RegCheckErr(Buf, RoutineName)) return + ! time_step_force + call RegPack(Buf, InData%time_step_force) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPackturbine_average_velocity_data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(turbine_average_velocity_data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPackturbine_average_velocity_data' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! average_velocity_array_temp + if (allocated(OutData%average_velocity_array_temp)) deallocate(OutData%average_velocity_array_temp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%average_velocity_array_temp(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%average_velocity_array_temp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%average_velocity_array_temp) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! average_velocity_array + if (allocated(OutData%average_velocity_array)) deallocate(OutData%average_velocity_array) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%average_velocity_array(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%average_velocity_array.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%average_velocity_array) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! swept_area + if (allocated(OutData%swept_area)) deallocate(OutData%swept_area) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%swept_area(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%swept_area.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%swept_area) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! time_step_velocity + call RegUnpack(Buf, OutData%time_step_velocity) + if (RegCheckErr(Buf, RoutineName)) return + ! time_step_velocity_array + if (allocated(OutData%time_step_velocity_array)) deallocate(OutData%time_step_velocity_array) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%time_step_velocity_array(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%time_step_velocity_array.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%time_step_velocity_array) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! time_step_pass_velocity + call RegUnpack(Buf, OutData%time_step_pass_velocity) + if (RegCheckErr(Buf, RoutineName)) return + ! time_step_force + call RegUnpack(Buf, OutData%time_step_force) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE DWM_CopyWake_Deficit_Data( SrcWake_Deficit_DataData, DstWake_Deficit_DataData, CtrlCode, ErrStat, ErrMsg ) TYPE(DWM_Wake_Deficit_Data), INTENT(IN) :: SrcWake_Deficit_DataData TYPE(DWM_Wake_Deficit_Data), INTENT(INOUT) :: DstWake_Deficit_DataData @@ -877,173 +665,75 @@ SUBROUTINE DWM_DestroyWake_Deficit_Data( Wake_Deficit_DataData, ErrStat, ErrMsg ENDIF END SUBROUTINE DWM_DestroyWake_Deficit_Data - SUBROUTINE DWM_PackWake_Deficit_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(DWM_Wake_Deficit_Data), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_PackWake_Deficit_Data' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! np_x - Re_BufSz = Re_BufSz + 1 ! X_length - Int_BufSz = Int_BufSz + 1 ! Turb_Stress_DWM allocated yes/no - IF ( ALLOCATED(InData%Turb_Stress_DWM) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Turb_Stress_DWM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Turb_Stress_DWM) ! Turb_Stress_DWM - END IF - Int_BufSz = Int_BufSz + 1 ! n_x_vector - Int_BufSz = Int_BufSz + 1 ! n_r_vector - Re_BufSz = Re_BufSz + 1 ! ppR - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%np_x - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%X_length - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Turb_Stress_DWM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Turb_Stress_DWM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Turb_Stress_DWM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Turb_Stress_DWM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Turb_Stress_DWM,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Turb_Stress_DWM,2), UBOUND(InData%Turb_Stress_DWM,2) - DO i1 = LBOUND(InData%Turb_Stress_DWM,1), UBOUND(InData%Turb_Stress_DWM,1) - ReKiBuf(Re_Xferred) = InData%Turb_Stress_DWM(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%n_x_vector - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%n_r_vector - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ppR - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DWM_PackWake_Deficit_Data - - SUBROUTINE DWM_UnPackWake_Deficit_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(DWM_Wake_Deficit_Data), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackWake_Deficit_Data' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%np_x = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%X_length = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Turb_Stress_DWM not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Turb_Stress_DWM)) DEALLOCATE(OutData%Turb_Stress_DWM) - ALLOCATE(OutData%Turb_Stress_DWM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Turb_Stress_DWM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Turb_Stress_DWM,2), UBOUND(OutData%Turb_Stress_DWM,2) - DO i1 = LBOUND(OutData%Turb_Stress_DWM,1), UBOUND(OutData%Turb_Stress_DWM,1) - OutData%Turb_Stress_DWM(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%n_x_vector = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%n_r_vector = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ppR = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DWM_UnPackWake_Deficit_Data +subroutine DWM_PackWake_Deficit_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DWM_Wake_Deficit_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_PackWake_Deficit_Data' + if (Buf%ErrStat >= AbortErrLev) return + ! np_x + call RegPack(Buf, InData%np_x) + if (RegCheckErr(Buf, RoutineName)) return + ! X_length + call RegPack(Buf, InData%X_length) + if (RegCheckErr(Buf, RoutineName)) return + ! Turb_Stress_DWM + call RegPack(Buf, allocated(InData%Turb_Stress_DWM)) + if (allocated(InData%Turb_Stress_DWM)) then + call RegPackBounds(Buf, 2, lbound(InData%Turb_Stress_DWM), ubound(InData%Turb_Stress_DWM)) + call RegPack(Buf, InData%Turb_Stress_DWM) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! n_x_vector + call RegPack(Buf, InData%n_x_vector) + if (RegCheckErr(Buf, RoutineName)) return + ! n_r_vector + call RegPack(Buf, InData%n_r_vector) + if (RegCheckErr(Buf, RoutineName)) return + ! ppR + call RegPack(Buf, InData%ppR) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPackWake_Deficit_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DWM_Wake_Deficit_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPackWake_Deficit_Data' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! np_x + call RegUnpack(Buf, OutData%np_x) + if (RegCheckErr(Buf, RoutineName)) return + ! X_length + call RegUnpack(Buf, OutData%X_length) + if (RegCheckErr(Buf, RoutineName)) return + ! Turb_Stress_DWM + if (allocated(OutData%Turb_Stress_DWM)) deallocate(OutData%Turb_Stress_DWM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Turb_Stress_DWM(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Turb_Stress_DWM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Turb_Stress_DWM) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! n_x_vector + call RegUnpack(Buf, OutData%n_x_vector) + if (RegCheckErr(Buf, RoutineName)) return + ! n_r_vector + call RegUnpack(Buf, OutData%n_r_vector) + if (RegCheckErr(Buf, RoutineName)) return + ! ppR + call RegUnpack(Buf, OutData%ppR) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE DWM_CopyMeanderData( SrcMeanderDataData, DstMeanderDataData, CtrlCode, ErrStat, ErrMsg ) TYPE(MeanderData), INTENT(IN) :: SrcMeanderDataData TYPE(MeanderData), INTENT(INOUT) :: DstMeanderDataData @@ -1077,108 +767,32 @@ SUBROUTINE DWM_DestroyMeanderData( MeanderDataData, ErrStat, ErrMsg ) END SUBROUTINE DWM_DestroyMeanderData - SUBROUTINE DWM_PackMeanderData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MeanderData), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_PackMeanderData' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! scale_factor - Int_BufSz = Int_BufSz + 1 ! moving_time - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%scale_factor - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%moving_time - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE DWM_PackMeanderData - - SUBROUTINE DWM_UnPackMeanderData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MeanderData), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackMeanderData' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%scale_factor = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%moving_time = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE DWM_UnPackMeanderData +subroutine DWM_PackMeanderData(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MeanderData), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_PackMeanderData' + if (Buf%ErrStat >= AbortErrLev) return + ! scale_factor + call RegPack(Buf, InData%scale_factor) + if (RegCheckErr(Buf, RoutineName)) return + ! moving_time + call RegPack(Buf, InData%moving_time) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPackMeanderData(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MeanderData), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPackMeanderData' + if (Buf%ErrStat /= ErrID_None) return + ! scale_factor + call RegUnpack(Buf, OutData%scale_factor) + if (RegCheckErr(Buf, RoutineName)) return + ! moving_time + call RegUnpack(Buf, OutData%moving_time) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE DWM_Copyread_turbine_position_data( Srcread_turbine_position_dataData, Dstread_turbine_position_dataData, CtrlCode, ErrStat, ErrMsg ) TYPE(read_turbine_position_data), INTENT(IN) :: Srcread_turbine_position_dataData TYPE(read_turbine_position_data), INTENT(INOUT) :: Dstread_turbine_position_dataData @@ -1460,748 +1074,399 @@ SUBROUTINE DWM_Destroyread_turbine_position_data( read_turbine_position_dataData ENDIF END SUBROUTINE DWM_Destroyread_turbine_position_data - SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(read_turbine_position_data), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Packread_turbine_position_data' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! SimulationOrder_index - Int_BufSz = Int_BufSz + 1 ! Turbine_sort_order allocated yes/no - IF ( ALLOCATED(InData%Turbine_sort_order) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Turbine_sort_order upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Turbine_sort_order) ! Turbine_sort_order - END IF - Int_BufSz = Int_BufSz + 1 ! WT_index - Int_BufSz = Int_BufSz + 1 ! TurbineInfluenceData allocated yes/no - IF ( ALLOCATED(InData%TurbineInfluenceData) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TurbineInfluenceData upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%TurbineInfluenceData) ! TurbineInfluenceData - END IF - Int_BufSz = Int_BufSz + 1 ! upwind_turbine_index allocated yes/no - IF ( ALLOCATED(InData%upwind_turbine_index) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! upwind_turbine_index upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%upwind_turbine_index) ! upwind_turbine_index - END IF - Int_BufSz = Int_BufSz + 1 ! downwind_turbine_index allocated yes/no - IF ( ALLOCATED(InData%downwind_turbine_index) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! downwind_turbine_index upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%downwind_turbine_index) ! downwind_turbine_index - END IF - Int_BufSz = Int_BufSz + 1 ! upwindturbine_number - Int_BufSz = Int_BufSz + 1 ! downwindturbine_number - Int_BufSz = Int_BufSz + 1 ! turbine_windorigin_length allocated yes/no - IF ( ALLOCATED(InData%turbine_windorigin_length) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! turbine_windorigin_length upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%turbine_windorigin_length) ! turbine_windorigin_length - END IF - Int_BufSz = Int_BufSz + 1 ! upwind_turbine_projected_distance allocated yes/no - IF ( ALLOCATED(InData%upwind_turbine_projected_distance) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! upwind_turbine_projected_distance upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%upwind_turbine_projected_distance) ! upwind_turbine_projected_distance - END IF - Int_BufSz = Int_BufSz + 1 ! downwind_turbine_projected_distance allocated yes/no - IF ( ALLOCATED(InData%downwind_turbine_projected_distance) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! downwind_turbine_projected_distance upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%downwind_turbine_projected_distance) ! downwind_turbine_projected_distance - END IF - Int_BufSz = Int_BufSz + 1 ! turbine_angle allocated yes/no - IF ( ALLOCATED(InData%turbine_angle) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! turbine_angle upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%turbine_angle) ! turbine_angle - END IF - Int_BufSz = Int_BufSz + 1 ! upwind_align_angle allocated yes/no - IF ( ALLOCATED(InData%upwind_align_angle) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! upwind_align_angle upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%upwind_align_angle) ! upwind_align_angle - END IF - Int_BufSz = Int_BufSz + 1 ! downwind_align_angle allocated yes/no - IF ( ALLOCATED(InData%downwind_align_angle) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! downwind_align_angle upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%downwind_align_angle) ! downwind_align_angle - END IF - Int_BufSz = Int_BufSz + 1 ! upwind_turbine_Xcoor allocated yes/no - IF ( ALLOCATED(InData%upwind_turbine_Xcoor) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! upwind_turbine_Xcoor upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%upwind_turbine_Xcoor) ! upwind_turbine_Xcoor - END IF - Int_BufSz = Int_BufSz + 1 ! upwind_turbine_Ycoor allocated yes/no - IF ( ALLOCATED(InData%upwind_turbine_Ycoor) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! upwind_turbine_Ycoor upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%upwind_turbine_Ycoor) ! upwind_turbine_Ycoor - END IF - Int_BufSz = Int_BufSz + 1 ! wind_farm_Xcoor allocated yes/no - IF ( ALLOCATED(InData%wind_farm_Xcoor) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! wind_farm_Xcoor upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%wind_farm_Xcoor) ! wind_farm_Xcoor - END IF - Int_BufSz = Int_BufSz + 1 ! wind_farm_Ycoor allocated yes/no - IF ( ALLOCATED(InData%wind_farm_Ycoor) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! wind_farm_Ycoor upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%wind_farm_Ycoor) ! wind_farm_Ycoor - END IF - Int_BufSz = Int_BufSz + 1 ! downwind_turbine_Xcoor allocated yes/no - IF ( ALLOCATED(InData%downwind_turbine_Xcoor) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! downwind_turbine_Xcoor upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%downwind_turbine_Xcoor) ! downwind_turbine_Xcoor - END IF - Int_BufSz = Int_BufSz + 1 ! downwind_turbine_Ycoor allocated yes/no - IF ( ALLOCATED(InData%downwind_turbine_Ycoor) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! downwind_turbine_Ycoor upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%downwind_turbine_Ycoor) ! downwind_turbine_Ycoor - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%SimulationOrder_index - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Turbine_sort_order) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Turbine_sort_order,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Turbine_sort_order,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Turbine_sort_order,1), UBOUND(InData%Turbine_sort_order,1) - IntKiBuf(Int_Xferred) = InData%Turbine_sort_order(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%WT_index - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TurbineInfluenceData) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TurbineInfluenceData,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TurbineInfluenceData,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TurbineInfluenceData,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TurbineInfluenceData,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TurbineInfluenceData,2), UBOUND(InData%TurbineInfluenceData,2) - DO i1 = LBOUND(InData%TurbineInfluenceData,1), UBOUND(InData%TurbineInfluenceData,1) - IntKiBuf(Int_Xferred) = InData%TurbineInfluenceData(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%upwind_turbine_index) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%upwind_turbine_index,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_turbine_index,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%upwind_turbine_index,1), UBOUND(InData%upwind_turbine_index,1) - IntKiBuf(Int_Xferred) = InData%upwind_turbine_index(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%downwind_turbine_index) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%downwind_turbine_index,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%downwind_turbine_index,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%downwind_turbine_index,1), UBOUND(InData%downwind_turbine_index,1) - IntKiBuf(Int_Xferred) = InData%downwind_turbine_index(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%upwindturbine_number - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%downwindturbine_number - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%turbine_windorigin_length) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%turbine_windorigin_length,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%turbine_windorigin_length,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%turbine_windorigin_length,1), UBOUND(InData%turbine_windorigin_length,1) - ReKiBuf(Re_Xferred) = InData%turbine_windorigin_length(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%upwind_turbine_projected_distance) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%upwind_turbine_projected_distance,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_turbine_projected_distance,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%upwind_turbine_projected_distance,1), UBOUND(InData%upwind_turbine_projected_distance,1) - ReKiBuf(Re_Xferred) = InData%upwind_turbine_projected_distance(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%downwind_turbine_projected_distance) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%downwind_turbine_projected_distance,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%downwind_turbine_projected_distance,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%downwind_turbine_projected_distance,1), UBOUND(InData%downwind_turbine_projected_distance,1) - ReKiBuf(Re_Xferred) = InData%downwind_turbine_projected_distance(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%turbine_angle) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%turbine_angle,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%turbine_angle,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%turbine_angle,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%turbine_angle,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%turbine_angle,2), UBOUND(InData%turbine_angle,2) - DO i1 = LBOUND(InData%turbine_angle,1), UBOUND(InData%turbine_angle,1) - ReKiBuf(Re_Xferred) = InData%turbine_angle(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%upwind_align_angle) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%upwind_align_angle,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_align_angle,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%upwind_align_angle,1), UBOUND(InData%upwind_align_angle,1) - ReKiBuf(Re_Xferred) = InData%upwind_align_angle(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%downwind_align_angle) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%downwind_align_angle,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%downwind_align_angle,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%downwind_align_angle,1), UBOUND(InData%downwind_align_angle,1) - ReKiBuf(Re_Xferred) = InData%downwind_align_angle(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%upwind_turbine_Xcoor) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%upwind_turbine_Xcoor,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_turbine_Xcoor,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%upwind_turbine_Xcoor,1), UBOUND(InData%upwind_turbine_Xcoor,1) - ReKiBuf(Re_Xferred) = InData%upwind_turbine_Xcoor(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%upwind_turbine_Ycoor) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%upwind_turbine_Ycoor,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_turbine_Ycoor,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%upwind_turbine_Ycoor,1), UBOUND(InData%upwind_turbine_Ycoor,1) - ReKiBuf(Re_Xferred) = InData%upwind_turbine_Ycoor(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%wind_farm_Xcoor) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%wind_farm_Xcoor,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%wind_farm_Xcoor,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%wind_farm_Xcoor,1), UBOUND(InData%wind_farm_Xcoor,1) - ReKiBuf(Re_Xferred) = InData%wind_farm_Xcoor(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%wind_farm_Ycoor) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%wind_farm_Ycoor,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%wind_farm_Ycoor,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%wind_farm_Ycoor,1), UBOUND(InData%wind_farm_Ycoor,1) - ReKiBuf(Re_Xferred) = InData%wind_farm_Ycoor(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%downwind_turbine_Xcoor) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%downwind_turbine_Xcoor,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%downwind_turbine_Xcoor,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%downwind_turbine_Xcoor,1), UBOUND(InData%downwind_turbine_Xcoor,1) - ReKiBuf(Re_Xferred) = InData%downwind_turbine_Xcoor(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%downwind_turbine_Ycoor) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%downwind_turbine_Ycoor,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%downwind_turbine_Ycoor,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%downwind_turbine_Ycoor,1), UBOUND(InData%downwind_turbine_Ycoor,1) - ReKiBuf(Re_Xferred) = InData%downwind_turbine_Ycoor(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE DWM_Packread_turbine_position_data - - SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(read_turbine_position_data), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackread_turbine_position_data' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%SimulationOrder_index = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Turbine_sort_order not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Turbine_sort_order)) DEALLOCATE(OutData%Turbine_sort_order) - ALLOCATE(OutData%Turbine_sort_order(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Turbine_sort_order.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Turbine_sort_order,1), UBOUND(OutData%Turbine_sort_order,1) - OutData%Turbine_sort_order(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%WT_index = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TurbineInfluenceData not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TurbineInfluenceData)) DEALLOCATE(OutData%TurbineInfluenceData) - ALLOCATE(OutData%TurbineInfluenceData(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TurbineInfluenceData.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TurbineInfluenceData,2), UBOUND(OutData%TurbineInfluenceData,2) - DO i1 = LBOUND(OutData%TurbineInfluenceData,1), UBOUND(OutData%TurbineInfluenceData,1) - OutData%TurbineInfluenceData(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_turbine_index not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%upwind_turbine_index)) DEALLOCATE(OutData%upwind_turbine_index) - ALLOCATE(OutData%upwind_turbine_index(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_turbine_index.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%upwind_turbine_index,1), UBOUND(OutData%upwind_turbine_index,1) - OutData%upwind_turbine_index(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! downwind_turbine_index not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%downwind_turbine_index)) DEALLOCATE(OutData%downwind_turbine_index) - ALLOCATE(OutData%downwind_turbine_index(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%downwind_turbine_index.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%downwind_turbine_index,1), UBOUND(OutData%downwind_turbine_index,1) - OutData%downwind_turbine_index(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%upwindturbine_number = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%downwindturbine_number = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! turbine_windorigin_length not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%turbine_windorigin_length)) DEALLOCATE(OutData%turbine_windorigin_length) - ALLOCATE(OutData%turbine_windorigin_length(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%turbine_windorigin_length.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%turbine_windorigin_length,1), UBOUND(OutData%turbine_windorigin_length,1) - OutData%turbine_windorigin_length(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_turbine_projected_distance not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%upwind_turbine_projected_distance)) DEALLOCATE(OutData%upwind_turbine_projected_distance) - ALLOCATE(OutData%upwind_turbine_projected_distance(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_turbine_projected_distance.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%upwind_turbine_projected_distance,1), UBOUND(OutData%upwind_turbine_projected_distance,1) - OutData%upwind_turbine_projected_distance(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! downwind_turbine_projected_distance not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%downwind_turbine_projected_distance)) DEALLOCATE(OutData%downwind_turbine_projected_distance) - ALLOCATE(OutData%downwind_turbine_projected_distance(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%downwind_turbine_projected_distance.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%downwind_turbine_projected_distance,1), UBOUND(OutData%downwind_turbine_projected_distance,1) - OutData%downwind_turbine_projected_distance(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! turbine_angle not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%turbine_angle)) DEALLOCATE(OutData%turbine_angle) - ALLOCATE(OutData%turbine_angle(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%turbine_angle.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%turbine_angle,2), UBOUND(OutData%turbine_angle,2) - DO i1 = LBOUND(OutData%turbine_angle,1), UBOUND(OutData%turbine_angle,1) - OutData%turbine_angle(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_align_angle not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%upwind_align_angle)) DEALLOCATE(OutData%upwind_align_angle) - ALLOCATE(OutData%upwind_align_angle(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_align_angle.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%upwind_align_angle,1), UBOUND(OutData%upwind_align_angle,1) - OutData%upwind_align_angle(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! downwind_align_angle not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%downwind_align_angle)) DEALLOCATE(OutData%downwind_align_angle) - ALLOCATE(OutData%downwind_align_angle(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%downwind_align_angle.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%downwind_align_angle,1), UBOUND(OutData%downwind_align_angle,1) - OutData%downwind_align_angle(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_turbine_Xcoor not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%upwind_turbine_Xcoor)) DEALLOCATE(OutData%upwind_turbine_Xcoor) - ALLOCATE(OutData%upwind_turbine_Xcoor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_turbine_Xcoor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%upwind_turbine_Xcoor,1), UBOUND(OutData%upwind_turbine_Xcoor,1) - OutData%upwind_turbine_Xcoor(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_turbine_Ycoor not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%upwind_turbine_Ycoor)) DEALLOCATE(OutData%upwind_turbine_Ycoor) - ALLOCATE(OutData%upwind_turbine_Ycoor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_turbine_Ycoor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%upwind_turbine_Ycoor,1), UBOUND(OutData%upwind_turbine_Ycoor,1) - OutData%upwind_turbine_Ycoor(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! wind_farm_Xcoor not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%wind_farm_Xcoor)) DEALLOCATE(OutData%wind_farm_Xcoor) - ALLOCATE(OutData%wind_farm_Xcoor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%wind_farm_Xcoor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%wind_farm_Xcoor,1), UBOUND(OutData%wind_farm_Xcoor,1) - OutData%wind_farm_Xcoor(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! wind_farm_Ycoor not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%wind_farm_Ycoor)) DEALLOCATE(OutData%wind_farm_Ycoor) - ALLOCATE(OutData%wind_farm_Ycoor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%wind_farm_Ycoor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%wind_farm_Ycoor,1), UBOUND(OutData%wind_farm_Ycoor,1) - OutData%wind_farm_Ycoor(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! downwind_turbine_Xcoor not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%downwind_turbine_Xcoor)) DEALLOCATE(OutData%downwind_turbine_Xcoor) - ALLOCATE(OutData%downwind_turbine_Xcoor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%downwind_turbine_Xcoor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%downwind_turbine_Xcoor,1), UBOUND(OutData%downwind_turbine_Xcoor,1) - OutData%downwind_turbine_Xcoor(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! downwind_turbine_Ycoor not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%downwind_turbine_Ycoor)) DEALLOCATE(OutData%downwind_turbine_Ycoor) - ALLOCATE(OutData%downwind_turbine_Ycoor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%downwind_turbine_Ycoor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%downwind_turbine_Ycoor,1), UBOUND(OutData%downwind_turbine_Ycoor,1) - OutData%downwind_turbine_Ycoor(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE DWM_UnPackread_turbine_position_data +subroutine DWM_Packread_turbine_position_data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(read_turbine_position_data), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_Packread_turbine_position_data' + if (Buf%ErrStat >= AbortErrLev) return + ! SimulationOrder_index + call RegPack(Buf, InData%SimulationOrder_index) + if (RegCheckErr(Buf, RoutineName)) return + ! Turbine_sort_order + call RegPack(Buf, allocated(InData%Turbine_sort_order)) + if (allocated(InData%Turbine_sort_order)) then + call RegPackBounds(Buf, 1, lbound(InData%Turbine_sort_order), ubound(InData%Turbine_sort_order)) + call RegPack(Buf, InData%Turbine_sort_order) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WT_index + call RegPack(Buf, InData%WT_index) + if (RegCheckErr(Buf, RoutineName)) return + ! TurbineInfluenceData + call RegPack(Buf, allocated(InData%TurbineInfluenceData)) + if (allocated(InData%TurbineInfluenceData)) then + call RegPackBounds(Buf, 2, lbound(InData%TurbineInfluenceData), ubound(InData%TurbineInfluenceData)) + call RegPack(Buf, InData%TurbineInfluenceData) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! upwind_turbine_index + call RegPack(Buf, allocated(InData%upwind_turbine_index)) + if (allocated(InData%upwind_turbine_index)) then + call RegPackBounds(Buf, 1, lbound(InData%upwind_turbine_index), ubound(InData%upwind_turbine_index)) + call RegPack(Buf, InData%upwind_turbine_index) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! downwind_turbine_index + call RegPack(Buf, allocated(InData%downwind_turbine_index)) + if (allocated(InData%downwind_turbine_index)) then + call RegPackBounds(Buf, 1, lbound(InData%downwind_turbine_index), ubound(InData%downwind_turbine_index)) + call RegPack(Buf, InData%downwind_turbine_index) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! upwindturbine_number + call RegPack(Buf, InData%upwindturbine_number) + if (RegCheckErr(Buf, RoutineName)) return + ! downwindturbine_number + call RegPack(Buf, InData%downwindturbine_number) + if (RegCheckErr(Buf, RoutineName)) return + ! turbine_windorigin_length + call RegPack(Buf, allocated(InData%turbine_windorigin_length)) + if (allocated(InData%turbine_windorigin_length)) then + call RegPackBounds(Buf, 1, lbound(InData%turbine_windorigin_length), ubound(InData%turbine_windorigin_length)) + call RegPack(Buf, InData%turbine_windorigin_length) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! upwind_turbine_projected_distance + call RegPack(Buf, allocated(InData%upwind_turbine_projected_distance)) + if (allocated(InData%upwind_turbine_projected_distance)) then + call RegPackBounds(Buf, 1, lbound(InData%upwind_turbine_projected_distance), ubound(InData%upwind_turbine_projected_distance)) + call RegPack(Buf, InData%upwind_turbine_projected_distance) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! downwind_turbine_projected_distance + call RegPack(Buf, allocated(InData%downwind_turbine_projected_distance)) + if (allocated(InData%downwind_turbine_projected_distance)) then + call RegPackBounds(Buf, 1, lbound(InData%downwind_turbine_projected_distance), ubound(InData%downwind_turbine_projected_distance)) + call RegPack(Buf, InData%downwind_turbine_projected_distance) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! turbine_angle + call RegPack(Buf, allocated(InData%turbine_angle)) + if (allocated(InData%turbine_angle)) then + call RegPackBounds(Buf, 2, lbound(InData%turbine_angle), ubound(InData%turbine_angle)) + call RegPack(Buf, InData%turbine_angle) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! upwind_align_angle + call RegPack(Buf, allocated(InData%upwind_align_angle)) + if (allocated(InData%upwind_align_angle)) then + call RegPackBounds(Buf, 1, lbound(InData%upwind_align_angle), ubound(InData%upwind_align_angle)) + call RegPack(Buf, InData%upwind_align_angle) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! downwind_align_angle + call RegPack(Buf, allocated(InData%downwind_align_angle)) + if (allocated(InData%downwind_align_angle)) then + call RegPackBounds(Buf, 1, lbound(InData%downwind_align_angle), ubound(InData%downwind_align_angle)) + call RegPack(Buf, InData%downwind_align_angle) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! upwind_turbine_Xcoor + call RegPack(Buf, allocated(InData%upwind_turbine_Xcoor)) + if (allocated(InData%upwind_turbine_Xcoor)) then + call RegPackBounds(Buf, 1, lbound(InData%upwind_turbine_Xcoor), ubound(InData%upwind_turbine_Xcoor)) + call RegPack(Buf, InData%upwind_turbine_Xcoor) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! upwind_turbine_Ycoor + call RegPack(Buf, allocated(InData%upwind_turbine_Ycoor)) + if (allocated(InData%upwind_turbine_Ycoor)) then + call RegPackBounds(Buf, 1, lbound(InData%upwind_turbine_Ycoor), ubound(InData%upwind_turbine_Ycoor)) + call RegPack(Buf, InData%upwind_turbine_Ycoor) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! wind_farm_Xcoor + call RegPack(Buf, allocated(InData%wind_farm_Xcoor)) + if (allocated(InData%wind_farm_Xcoor)) then + call RegPackBounds(Buf, 1, lbound(InData%wind_farm_Xcoor), ubound(InData%wind_farm_Xcoor)) + call RegPack(Buf, InData%wind_farm_Xcoor) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! wind_farm_Ycoor + call RegPack(Buf, allocated(InData%wind_farm_Ycoor)) + if (allocated(InData%wind_farm_Ycoor)) then + call RegPackBounds(Buf, 1, lbound(InData%wind_farm_Ycoor), ubound(InData%wind_farm_Ycoor)) + call RegPack(Buf, InData%wind_farm_Ycoor) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! downwind_turbine_Xcoor + call RegPack(Buf, allocated(InData%downwind_turbine_Xcoor)) + if (allocated(InData%downwind_turbine_Xcoor)) then + call RegPackBounds(Buf, 1, lbound(InData%downwind_turbine_Xcoor), ubound(InData%downwind_turbine_Xcoor)) + call RegPack(Buf, InData%downwind_turbine_Xcoor) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! downwind_turbine_Ycoor + call RegPack(Buf, allocated(InData%downwind_turbine_Ycoor)) + if (allocated(InData%downwind_turbine_Ycoor)) then + call RegPackBounds(Buf, 1, lbound(InData%downwind_turbine_Ycoor), ubound(InData%downwind_turbine_Ycoor)) + call RegPack(Buf, InData%downwind_turbine_Ycoor) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPackread_turbine_position_data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(read_turbine_position_data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPackread_turbine_position_data' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! SimulationOrder_index + call RegUnpack(Buf, OutData%SimulationOrder_index) + if (RegCheckErr(Buf, RoutineName)) return + ! Turbine_sort_order + if (allocated(OutData%Turbine_sort_order)) deallocate(OutData%Turbine_sort_order) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Turbine_sort_order(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Turbine_sort_order.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Turbine_sort_order) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WT_index + call RegUnpack(Buf, OutData%WT_index) + if (RegCheckErr(Buf, RoutineName)) return + ! TurbineInfluenceData + if (allocated(OutData%TurbineInfluenceData)) deallocate(OutData%TurbineInfluenceData) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TurbineInfluenceData(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TurbineInfluenceData.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TurbineInfluenceData) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! upwind_turbine_index + if (allocated(OutData%upwind_turbine_index)) deallocate(OutData%upwind_turbine_index) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%upwind_turbine_index(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_turbine_index.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%upwind_turbine_index) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! downwind_turbine_index + if (allocated(OutData%downwind_turbine_index)) deallocate(OutData%downwind_turbine_index) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%downwind_turbine_index(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%downwind_turbine_index.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%downwind_turbine_index) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! upwindturbine_number + call RegUnpack(Buf, OutData%upwindturbine_number) + if (RegCheckErr(Buf, RoutineName)) return + ! downwindturbine_number + call RegUnpack(Buf, OutData%downwindturbine_number) + if (RegCheckErr(Buf, RoutineName)) return + ! turbine_windorigin_length + if (allocated(OutData%turbine_windorigin_length)) deallocate(OutData%turbine_windorigin_length) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%turbine_windorigin_length(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%turbine_windorigin_length.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%turbine_windorigin_length) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! upwind_turbine_projected_distance + if (allocated(OutData%upwind_turbine_projected_distance)) deallocate(OutData%upwind_turbine_projected_distance) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%upwind_turbine_projected_distance(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_turbine_projected_distance.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%upwind_turbine_projected_distance) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! downwind_turbine_projected_distance + if (allocated(OutData%downwind_turbine_projected_distance)) deallocate(OutData%downwind_turbine_projected_distance) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%downwind_turbine_projected_distance(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%downwind_turbine_projected_distance.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%downwind_turbine_projected_distance) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! turbine_angle + if (allocated(OutData%turbine_angle)) deallocate(OutData%turbine_angle) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%turbine_angle(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%turbine_angle.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%turbine_angle) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! upwind_align_angle + if (allocated(OutData%upwind_align_angle)) deallocate(OutData%upwind_align_angle) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%upwind_align_angle(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_align_angle.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%upwind_align_angle) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! downwind_align_angle + if (allocated(OutData%downwind_align_angle)) deallocate(OutData%downwind_align_angle) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%downwind_align_angle(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%downwind_align_angle.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%downwind_align_angle) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! upwind_turbine_Xcoor + if (allocated(OutData%upwind_turbine_Xcoor)) deallocate(OutData%upwind_turbine_Xcoor) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%upwind_turbine_Xcoor(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_turbine_Xcoor.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%upwind_turbine_Xcoor) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! upwind_turbine_Ycoor + if (allocated(OutData%upwind_turbine_Ycoor)) deallocate(OutData%upwind_turbine_Ycoor) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%upwind_turbine_Ycoor(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_turbine_Ycoor.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%upwind_turbine_Ycoor) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! wind_farm_Xcoor + if (allocated(OutData%wind_farm_Xcoor)) deallocate(OutData%wind_farm_Xcoor) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%wind_farm_Xcoor(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%wind_farm_Xcoor.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%wind_farm_Xcoor) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! wind_farm_Ycoor + if (allocated(OutData%wind_farm_Ycoor)) deallocate(OutData%wind_farm_Ycoor) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%wind_farm_Ycoor(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%wind_farm_Ycoor.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%wind_farm_Ycoor) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! downwind_turbine_Xcoor + if (allocated(OutData%downwind_turbine_Xcoor)) deallocate(OutData%downwind_turbine_Xcoor) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%downwind_turbine_Xcoor(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%downwind_turbine_Xcoor.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%downwind_turbine_Xcoor) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! downwind_turbine_Ycoor + if (allocated(OutData%downwind_turbine_Ycoor)) deallocate(OutData%downwind_turbine_Ycoor) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%downwind_turbine_Ycoor(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%downwind_turbine_Ycoor.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%downwind_turbine_Ycoor) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE DWM_CopyWeiMethod( SrcWeiMethodData, DstWeiMethodData, CtrlCode, ErrStat, ErrMsg ) TYPE(WeiMethod), INTENT(IN) :: SrcWeiMethodData TYPE(WeiMethod), INTENT(INOUT) :: DstWeiMethodData @@ -2250,142 +1515,51 @@ SUBROUTINE DWM_DestroyWeiMethod( WeiMethodData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE DWM_DestroyWeiMethod - SUBROUTINE DWM_PackWeiMethod( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(WeiMethod), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_PackWeiMethod' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! sweptarea allocated yes/no - IF ( ALLOCATED(InData%sweptarea) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! sweptarea upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%sweptarea) ! sweptarea - END IF - Re_BufSz = Re_BufSz + 1 ! weighting_denominator - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%sweptarea) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%sweptarea,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%sweptarea,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%sweptarea,1), UBOUND(InData%sweptarea,1) - ReKiBuf(Re_Xferred) = InData%sweptarea(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%weighting_denominator - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DWM_PackWeiMethod - - SUBROUTINE DWM_UnPackWeiMethod( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(WeiMethod), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackWeiMethod' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! sweptarea not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%sweptarea)) DEALLOCATE(OutData%sweptarea) - ALLOCATE(OutData%sweptarea(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%sweptarea.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%sweptarea,1), UBOUND(OutData%sweptarea,1) - OutData%sweptarea(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%weighting_denominator = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DWM_UnPackWeiMethod +subroutine DWM_PackWeiMethod(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WeiMethod), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_PackWeiMethod' + if (Buf%ErrStat >= AbortErrLev) return + ! sweptarea + call RegPack(Buf, allocated(InData%sweptarea)) + if (allocated(InData%sweptarea)) then + call RegPackBounds(Buf, 1, lbound(InData%sweptarea), ubound(InData%sweptarea)) + call RegPack(Buf, InData%sweptarea) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! weighting_denominator + call RegPack(Buf, InData%weighting_denominator) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPackWeiMethod(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WeiMethod), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPackWeiMethod' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! sweptarea + if (allocated(OutData%sweptarea)) deallocate(OutData%sweptarea) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%sweptarea(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%sweptarea.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%sweptarea) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! weighting_denominator + call RegUnpack(Buf, OutData%weighting_denominator) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE DWM_CopyTIDownstream( SrcTIDownstreamData, DstTIDownstreamData, CtrlCode, ErrStat, ErrMsg ) TYPE(TIDownstream), INTENT(IN) :: SrcTIDownstreamData TYPE(TIDownstream), INTENT(INOUT) :: DstTIDownstreamData @@ -2465,293 +1639,219 @@ SUBROUTINE DWM_DestroyTIDownstream( TIDownstreamData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE DWM_DestroyTIDownstream - SUBROUTINE DWM_PackTIDownstream( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(TIDownstream), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_PackTIDownstream' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! TI_downstream_matrix allocated yes/no - IF ( ALLOCATED(InData%TI_downstream_matrix) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TI_downstream_matrix upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TI_downstream_matrix) ! TI_downstream_matrix - END IF - Int_BufSz = Int_BufSz + 1 ! i - Int_BufSz = Int_BufSz + 1 ! j - Int_BufSz = Int_BufSz + 1 ! k - Int_BufSz = Int_BufSz + 1 ! cross_plane_position_ds - Int_BufSz = Int_BufSz + 1 ! cross_plane_position_TI - Int_BufSz = Int_BufSz + 1 ! distance_index - Int_BufSz = Int_BufSz + 1 ! counter1 - Int_BufSz = Int_BufSz + 1 ! counter2 - Int_BufSz = Int_BufSz + 1 ! initial_timestep - Re_BufSz = Re_BufSz + 1 ! y_axis_turbine - Re_BufSz = Re_BufSz + 1 ! z_axis_turbine - Re_BufSz = Re_BufSz + 1 ! distance - Re_BufSz = Re_BufSz + 1 ! TI_downstream_node - Re_BufSz = Re_BufSz + 1 ! TI_node_temp - Re_BufSz = Re_BufSz + 1 ! TI_node - Re_BufSz = Re_BufSz + 1 ! TI_accumulation - Re_BufSz = Re_BufSz + 1 ! TI_apprant_accumulation - Re_BufSz = Re_BufSz + 1 ! TI_average - Re_BufSz = Re_BufSz + 1 ! TI_apprant - Re_BufSz = Re_BufSz + 1 ! HubHt - Re_BufSz = Re_BufSz + 1 ! wake_center_y - Re_BufSz = Re_BufSz + 1 ! wake_center_z - Re_BufSz = Re_BufSz + 1 ! Rscale - Re_BufSz = Re_BufSz + 1 ! y - Re_BufSz = Re_BufSz + 1 ! z - Re_BufSz = Re_BufSz + 1 ! zero_spacing - Re_BufSz = Re_BufSz + 1 ! temp1 - Re_BufSz = Re_BufSz + 1 ! temp2 - Re_BufSz = Re_BufSz + 1 ! temp3 - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%TI_downstream_matrix) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TI_downstream_matrix,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI_downstream_matrix,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TI_downstream_matrix,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI_downstream_matrix,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TI_downstream_matrix,2), UBOUND(InData%TI_downstream_matrix,2) - DO i1 = LBOUND(InData%TI_downstream_matrix,1), UBOUND(InData%TI_downstream_matrix,1) - ReKiBuf(Re_Xferred) = InData%TI_downstream_matrix(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%i - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%j - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%k - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%cross_plane_position_ds - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%cross_plane_position_TI - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%distance_index - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%counter1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%counter2 - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%initial_timestep - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%y_axis_turbine - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%z_axis_turbine - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%distance - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TI_downstream_node - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TI_node_temp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TI_node - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TI_accumulation - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TI_apprant_accumulation - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TI_average - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TI_apprant - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%wake_center_y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%wake_center_z - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Rscale - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%z - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%zero_spacing - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%temp1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%temp2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%temp3 - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DWM_PackTIDownstream - - SUBROUTINE DWM_UnPackTIDownstream( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(TIDownstream), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackTIDownstream' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TI_downstream_matrix not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TI_downstream_matrix)) DEALLOCATE(OutData%TI_downstream_matrix) - ALLOCATE(OutData%TI_downstream_matrix(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI_downstream_matrix.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TI_downstream_matrix,2), UBOUND(OutData%TI_downstream_matrix,2) - DO i1 = LBOUND(OutData%TI_downstream_matrix,1), UBOUND(OutData%TI_downstream_matrix,1) - OutData%TI_downstream_matrix(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%i = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%j = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%k = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%cross_plane_position_ds = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%cross_plane_position_TI = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%distance_index = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%counter1 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%counter2 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%initial_timestep = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%y_axis_turbine = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%z_axis_turbine = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%distance = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TI_downstream_node = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TI_node_temp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TI_node = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TI_accumulation = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TI_apprant_accumulation = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TI_average = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TI_apprant = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HubHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%wake_center_y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%wake_center_z = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Rscale = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%z = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%zero_spacing = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%temp1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%temp2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%temp3 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DWM_UnPackTIDownstream +subroutine DWM_PackTIDownstream(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(TIDownstream), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_PackTIDownstream' + if (Buf%ErrStat >= AbortErrLev) return + ! TI_downstream_matrix + call RegPack(Buf, allocated(InData%TI_downstream_matrix)) + if (allocated(InData%TI_downstream_matrix)) then + call RegPackBounds(Buf, 2, lbound(InData%TI_downstream_matrix), ubound(InData%TI_downstream_matrix)) + call RegPack(Buf, InData%TI_downstream_matrix) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! i + call RegPack(Buf, InData%i) + if (RegCheckErr(Buf, RoutineName)) return + ! j + call RegPack(Buf, InData%j) + if (RegCheckErr(Buf, RoutineName)) return + ! k + call RegPack(Buf, InData%k) + if (RegCheckErr(Buf, RoutineName)) return + ! cross_plane_position_ds + call RegPack(Buf, InData%cross_plane_position_ds) + if (RegCheckErr(Buf, RoutineName)) return + ! cross_plane_position_TI + call RegPack(Buf, InData%cross_plane_position_TI) + if (RegCheckErr(Buf, RoutineName)) return + ! distance_index + call RegPack(Buf, InData%distance_index) + if (RegCheckErr(Buf, RoutineName)) return + ! counter1 + call RegPack(Buf, InData%counter1) + if (RegCheckErr(Buf, RoutineName)) return + ! counter2 + call RegPack(Buf, InData%counter2) + if (RegCheckErr(Buf, RoutineName)) return + ! initial_timestep + call RegPack(Buf, InData%initial_timestep) + if (RegCheckErr(Buf, RoutineName)) return + ! y_axis_turbine + call RegPack(Buf, InData%y_axis_turbine) + if (RegCheckErr(Buf, RoutineName)) return + ! z_axis_turbine + call RegPack(Buf, InData%z_axis_turbine) + if (RegCheckErr(Buf, RoutineName)) return + ! distance + call RegPack(Buf, InData%distance) + if (RegCheckErr(Buf, RoutineName)) return + ! TI_downstream_node + call RegPack(Buf, InData%TI_downstream_node) + if (RegCheckErr(Buf, RoutineName)) return + ! TI_node_temp + call RegPack(Buf, InData%TI_node_temp) + if (RegCheckErr(Buf, RoutineName)) return + ! TI_node + call RegPack(Buf, InData%TI_node) + if (RegCheckErr(Buf, RoutineName)) return + ! TI_accumulation + call RegPack(Buf, InData%TI_accumulation) + if (RegCheckErr(Buf, RoutineName)) return + ! TI_apprant_accumulation + call RegPack(Buf, InData%TI_apprant_accumulation) + if (RegCheckErr(Buf, RoutineName)) return + ! TI_average + call RegPack(Buf, InData%TI_average) + if (RegCheckErr(Buf, RoutineName)) return + ! TI_apprant + call RegPack(Buf, InData%TI_apprant) + if (RegCheckErr(Buf, RoutineName)) return + ! HubHt + call RegPack(Buf, InData%HubHt) + if (RegCheckErr(Buf, RoutineName)) return + ! wake_center_y + call RegPack(Buf, InData%wake_center_y) + if (RegCheckErr(Buf, RoutineName)) return + ! wake_center_z + call RegPack(Buf, InData%wake_center_z) + if (RegCheckErr(Buf, RoutineName)) return + ! Rscale + call RegPack(Buf, InData%Rscale) + if (RegCheckErr(Buf, RoutineName)) return + ! y + call RegPack(Buf, InData%y) + if (RegCheckErr(Buf, RoutineName)) return + ! z + call RegPack(Buf, InData%z) + if (RegCheckErr(Buf, RoutineName)) return + ! zero_spacing + call RegPack(Buf, InData%zero_spacing) + if (RegCheckErr(Buf, RoutineName)) return + ! temp1 + call RegPack(Buf, InData%temp1) + if (RegCheckErr(Buf, RoutineName)) return + ! temp2 + call RegPack(Buf, InData%temp2) + if (RegCheckErr(Buf, RoutineName)) return + ! temp3 + call RegPack(Buf, InData%temp3) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPackTIDownstream(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(TIDownstream), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPackTIDownstream' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! TI_downstream_matrix + if (allocated(OutData%TI_downstream_matrix)) deallocate(OutData%TI_downstream_matrix) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TI_downstream_matrix(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI_downstream_matrix.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TI_downstream_matrix) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! i + call RegUnpack(Buf, OutData%i) + if (RegCheckErr(Buf, RoutineName)) return + ! j + call RegUnpack(Buf, OutData%j) + if (RegCheckErr(Buf, RoutineName)) return + ! k + call RegUnpack(Buf, OutData%k) + if (RegCheckErr(Buf, RoutineName)) return + ! cross_plane_position_ds + call RegUnpack(Buf, OutData%cross_plane_position_ds) + if (RegCheckErr(Buf, RoutineName)) return + ! cross_plane_position_TI + call RegUnpack(Buf, OutData%cross_plane_position_TI) + if (RegCheckErr(Buf, RoutineName)) return + ! distance_index + call RegUnpack(Buf, OutData%distance_index) + if (RegCheckErr(Buf, RoutineName)) return + ! counter1 + call RegUnpack(Buf, OutData%counter1) + if (RegCheckErr(Buf, RoutineName)) return + ! counter2 + call RegUnpack(Buf, OutData%counter2) + if (RegCheckErr(Buf, RoutineName)) return + ! initial_timestep + call RegUnpack(Buf, OutData%initial_timestep) + if (RegCheckErr(Buf, RoutineName)) return + ! y_axis_turbine + call RegUnpack(Buf, OutData%y_axis_turbine) + if (RegCheckErr(Buf, RoutineName)) return + ! z_axis_turbine + call RegUnpack(Buf, OutData%z_axis_turbine) + if (RegCheckErr(Buf, RoutineName)) return + ! distance + call RegUnpack(Buf, OutData%distance) + if (RegCheckErr(Buf, RoutineName)) return + ! TI_downstream_node + call RegUnpack(Buf, OutData%TI_downstream_node) + if (RegCheckErr(Buf, RoutineName)) return + ! TI_node_temp + call RegUnpack(Buf, OutData%TI_node_temp) + if (RegCheckErr(Buf, RoutineName)) return + ! TI_node + call RegUnpack(Buf, OutData%TI_node) + if (RegCheckErr(Buf, RoutineName)) return + ! TI_accumulation + call RegUnpack(Buf, OutData%TI_accumulation) + if (RegCheckErr(Buf, RoutineName)) return + ! TI_apprant_accumulation + call RegUnpack(Buf, OutData%TI_apprant_accumulation) + if (RegCheckErr(Buf, RoutineName)) return + ! TI_average + call RegUnpack(Buf, OutData%TI_average) + if (RegCheckErr(Buf, RoutineName)) return + ! TI_apprant + call RegUnpack(Buf, OutData%TI_apprant) + if (RegCheckErr(Buf, RoutineName)) return + ! HubHt + call RegUnpack(Buf, OutData%HubHt) + if (RegCheckErr(Buf, RoutineName)) return + ! wake_center_y + call RegUnpack(Buf, OutData%wake_center_y) + if (RegCheckErr(Buf, RoutineName)) return + ! wake_center_z + call RegUnpack(Buf, OutData%wake_center_z) + if (RegCheckErr(Buf, RoutineName)) return + ! Rscale + call RegUnpack(Buf, OutData%Rscale) + if (RegCheckErr(Buf, RoutineName)) return + ! y + call RegUnpack(Buf, OutData%y) + if (RegCheckErr(Buf, RoutineName)) return + ! z + call RegUnpack(Buf, OutData%z) + if (RegCheckErr(Buf, RoutineName)) return + ! zero_spacing + call RegUnpack(Buf, OutData%zero_spacing) + if (RegCheckErr(Buf, RoutineName)) return + ! temp1 + call RegUnpack(Buf, OutData%temp1) + if (RegCheckErr(Buf, RoutineName)) return + ! temp2 + call RegUnpack(Buf, OutData%temp2) + if (RegCheckErr(Buf, RoutineName)) return + ! temp3 + call RegUnpack(Buf, OutData%temp3) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE DWM_CopyTurbKaimal( SrcTurbKaimalData, DstTurbKaimalData, CtrlCode, ErrStat, ErrMsg ) TYPE(TurbKaimal), INTENT(IN) :: SrcTurbKaimalData TYPE(TurbKaimal), INTENT(INOUT) :: DstTurbKaimalData @@ -2790,133 +1890,62 @@ SUBROUTINE DWM_DestroyTurbKaimal( TurbKaimalData, ErrStat, ErrMsg ) END SUBROUTINE DWM_DestroyTurbKaimal - SUBROUTINE DWM_PackTurbKaimal( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(TurbKaimal), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_PackTurbKaimal' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! fs - Int_BufSz = Int_BufSz + 1 ! temp_n - Int_BufSz = Int_BufSz + 1 ! i - Re_BufSz = Re_BufSz + 1 ! low_f - Re_BufSz = Re_BufSz + 1 ! high_f - Re_BufSz = Re_BufSz + 1 ! lk_facor - Re_BufSz = Re_BufSz + 1 ! STD - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%fs - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%temp_n - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%i - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%low_f - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%high_f - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%lk_facor - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%STD - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DWM_PackTurbKaimal - - SUBROUTINE DWM_UnPackTurbKaimal( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(TurbKaimal), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackTurbKaimal' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%fs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%temp_n = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%i = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%low_f = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%high_f = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%lk_facor = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%STD = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DWM_UnPackTurbKaimal +subroutine DWM_PackTurbKaimal(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(TurbKaimal), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_PackTurbKaimal' + if (Buf%ErrStat >= AbortErrLev) return + ! fs + call RegPack(Buf, InData%fs) + if (RegCheckErr(Buf, RoutineName)) return + ! temp_n + call RegPack(Buf, InData%temp_n) + if (RegCheckErr(Buf, RoutineName)) return + ! i + call RegPack(Buf, InData%i) + if (RegCheckErr(Buf, RoutineName)) return + ! low_f + call RegPack(Buf, InData%low_f) + if (RegCheckErr(Buf, RoutineName)) return + ! high_f + call RegPack(Buf, InData%high_f) + if (RegCheckErr(Buf, RoutineName)) return + ! lk_facor + call RegPack(Buf, InData%lk_facor) + if (RegCheckErr(Buf, RoutineName)) return + ! STD + call RegPack(Buf, InData%STD) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPackTurbKaimal(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(TurbKaimal), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPackTurbKaimal' + if (Buf%ErrStat /= ErrID_None) return + ! fs + call RegUnpack(Buf, OutData%fs) + if (RegCheckErr(Buf, RoutineName)) return + ! temp_n + call RegUnpack(Buf, OutData%temp_n) + if (RegCheckErr(Buf, RoutineName)) return + ! i + call RegUnpack(Buf, OutData%i) + if (RegCheckErr(Buf, RoutineName)) return + ! low_f + call RegUnpack(Buf, OutData%low_f) + if (RegCheckErr(Buf, RoutineName)) return + ! high_f + call RegUnpack(Buf, OutData%high_f) + if (RegCheckErr(Buf, RoutineName)) return + ! lk_facor + call RegUnpack(Buf, OutData%lk_facor) + if (RegCheckErr(Buf, RoutineName)) return + ! STD + call RegUnpack(Buf, OutData%STD) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE DWM_CopyShinozuka( SrcShinozukaData, DstShinozukaData, CtrlCode, ErrStat, ErrMsg ) TYPE(Shinozuka), INTENT(IN) :: SrcShinozukaData TYPE(Shinozuka), INTENT(INOUT) :: DstShinozukaData @@ -3032,329 +2061,181 @@ SUBROUTINE DWM_DestroyShinozuka( ShinozukaData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE DWM_DestroyShinozuka - SUBROUTINE DWM_PackShinozuka( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Shinozuka), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_PackShinozuka' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! f_syn allocated yes/no - IF ( ALLOCATED(InData%f_syn) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! f_syn upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%f_syn) ! f_syn - END IF - Int_BufSz = Int_BufSz + 1 ! t_syn allocated yes/no - IF ( ALLOCATED(InData%t_syn) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! t_syn upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%t_syn) ! t_syn - END IF - Int_BufSz = Int_BufSz + 1 ! phi allocated yes/no - IF ( ALLOCATED(InData%phi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! phi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%phi) ! phi - END IF - Int_BufSz = Int_BufSz + 1 ! p_k allocated yes/no - IF ( ALLOCATED(InData%p_k) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! p_k upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%p_k) ! p_k - END IF - Int_BufSz = Int_BufSz + 1 ! a_k allocated yes/no - IF ( ALLOCATED(InData%a_k) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! a_k upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%a_k) ! a_k - END IF - Int_BufSz = Int_BufSz + 1 ! num_points - Int_BufSz = Int_BufSz + 1 ! ILo - Int_BufSz = Int_BufSz + 1 ! i - Int_BufSz = Int_BufSz + 1 ! j - Re_BufSz = Re_BufSz + 1 ! dt - Re_BufSz = Re_BufSz + 1 ! t_min - Re_BufSz = Re_BufSz + 1 ! t_max - Re_BufSz = Re_BufSz + 1 ! df - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%f_syn) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%f_syn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%f_syn,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%f_syn,1), UBOUND(InData%f_syn,1) - ReKiBuf(Re_Xferred) = InData%f_syn(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%t_syn) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%t_syn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%t_syn,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%t_syn,1), UBOUND(InData%t_syn,1) - ReKiBuf(Re_Xferred) = InData%t_syn(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%phi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%phi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%phi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%phi,1), UBOUND(InData%phi,1) - ReKiBuf(Re_Xferred) = InData%phi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%p_k) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%p_k,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%p_k,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%p_k,1), UBOUND(InData%p_k,1) - ReKiBuf(Re_Xferred) = InData%p_k(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%a_k) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%a_k,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%a_k,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%a_k,1), UBOUND(InData%a_k,1) - ReKiBuf(Re_Xferred) = InData%a_k(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%num_points - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ILo - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%i - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%j - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%t_min - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%t_max - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%df - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DWM_PackShinozuka - - SUBROUTINE DWM_UnPackShinozuka( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Shinozuka), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackShinozuka' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! f_syn not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%f_syn)) DEALLOCATE(OutData%f_syn) - ALLOCATE(OutData%f_syn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%f_syn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%f_syn,1), UBOUND(OutData%f_syn,1) - OutData%f_syn(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! t_syn not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%t_syn)) DEALLOCATE(OutData%t_syn) - ALLOCATE(OutData%t_syn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%t_syn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%t_syn,1), UBOUND(OutData%t_syn,1) - OutData%t_syn(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! phi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%phi)) DEALLOCATE(OutData%phi) - ALLOCATE(OutData%phi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%phi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%phi,1), UBOUND(OutData%phi,1) - OutData%phi(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! p_k not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%p_k)) DEALLOCATE(OutData%p_k) - ALLOCATE(OutData%p_k(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%p_k.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%p_k,1), UBOUND(OutData%p_k,1) - OutData%p_k(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! a_k not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%a_k)) DEALLOCATE(OutData%a_k) - ALLOCATE(OutData%a_k(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%a_k.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%a_k,1), UBOUND(OutData%a_k,1) - OutData%a_k(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%num_points = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ILo = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%i = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%j = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%dt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%t_min = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%t_max = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%df = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DWM_UnPackShinozuka +subroutine DWM_PackShinozuka(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Shinozuka), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_PackShinozuka' + if (Buf%ErrStat >= AbortErrLev) return + ! f_syn + call RegPack(Buf, allocated(InData%f_syn)) + if (allocated(InData%f_syn)) then + call RegPackBounds(Buf, 1, lbound(InData%f_syn), ubound(InData%f_syn)) + call RegPack(Buf, InData%f_syn) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! t_syn + call RegPack(Buf, allocated(InData%t_syn)) + if (allocated(InData%t_syn)) then + call RegPackBounds(Buf, 1, lbound(InData%t_syn), ubound(InData%t_syn)) + call RegPack(Buf, InData%t_syn) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! phi + call RegPack(Buf, allocated(InData%phi)) + if (allocated(InData%phi)) then + call RegPackBounds(Buf, 1, lbound(InData%phi), ubound(InData%phi)) + call RegPack(Buf, InData%phi) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! p_k + call RegPack(Buf, allocated(InData%p_k)) + if (allocated(InData%p_k)) then + call RegPackBounds(Buf, 1, lbound(InData%p_k), ubound(InData%p_k)) + call RegPack(Buf, InData%p_k) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! a_k + call RegPack(Buf, allocated(InData%a_k)) + if (allocated(InData%a_k)) then + call RegPackBounds(Buf, 1, lbound(InData%a_k), ubound(InData%a_k)) + call RegPack(Buf, InData%a_k) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! num_points + call RegPack(Buf, InData%num_points) + if (RegCheckErr(Buf, RoutineName)) return + ! ILo + call RegPack(Buf, InData%ILo) + if (RegCheckErr(Buf, RoutineName)) return + ! i + call RegPack(Buf, InData%i) + if (RegCheckErr(Buf, RoutineName)) return + ! j + call RegPack(Buf, InData%j) + if (RegCheckErr(Buf, RoutineName)) return + ! dt + call RegPack(Buf, InData%dt) + if (RegCheckErr(Buf, RoutineName)) return + ! t_min + call RegPack(Buf, InData%t_min) + if (RegCheckErr(Buf, RoutineName)) return + ! t_max + call RegPack(Buf, InData%t_max) + if (RegCheckErr(Buf, RoutineName)) return + ! df + call RegPack(Buf, InData%df) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPackShinozuka(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Shinozuka), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPackShinozuka' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! f_syn + if (allocated(OutData%f_syn)) deallocate(OutData%f_syn) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%f_syn(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%f_syn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%f_syn) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! t_syn + if (allocated(OutData%t_syn)) deallocate(OutData%t_syn) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%t_syn(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%t_syn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%t_syn) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! phi + if (allocated(OutData%phi)) deallocate(OutData%phi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%phi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%phi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%phi) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! p_k + if (allocated(OutData%p_k)) deallocate(OutData%p_k) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%p_k(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%p_k.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%p_k) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! a_k + if (allocated(OutData%a_k)) deallocate(OutData%a_k) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%a_k(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%a_k.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%a_k) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! num_points + call RegUnpack(Buf, OutData%num_points) + if (RegCheckErr(Buf, RoutineName)) return + ! ILo + call RegUnpack(Buf, OutData%ILo) + if (RegCheckErr(Buf, RoutineName)) return + ! i + call RegUnpack(Buf, OutData%i) + if (RegCheckErr(Buf, RoutineName)) return + ! j + call RegUnpack(Buf, OutData%j) + if (RegCheckErr(Buf, RoutineName)) return + ! dt + call RegUnpack(Buf, OutData%dt) + if (RegCheckErr(Buf, RoutineName)) return + ! t_min + call RegUnpack(Buf, OutData%t_min) + if (RegCheckErr(Buf, RoutineName)) return + ! t_max + call RegUnpack(Buf, OutData%t_max) + if (RegCheckErr(Buf, RoutineName)) return + ! df + call RegUnpack(Buf, OutData%df) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE DWM_Copysmooth_out_wake_data( Srcsmooth_out_wake_dataData, Dstsmooth_out_wake_dataData, CtrlCode, ErrStat, ErrMsg ) TYPE(smooth_out_wake_data), INTENT(IN) :: Srcsmooth_out_wake_dataData TYPE(smooth_out_wake_data), INTENT(INOUT) :: Dstsmooth_out_wake_dataData @@ -3387,103 +2268,26 @@ SUBROUTINE DWM_Destroysmooth_out_wake_data( smooth_out_wake_dataData, ErrStat, E END SUBROUTINE DWM_Destroysmooth_out_wake_data - SUBROUTINE DWM_Packsmooth_out_wake_data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(smooth_out_wake_data), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Packsmooth_out_wake_data' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! length_velocity_array - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%length_velocity_array - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE DWM_Packsmooth_out_wake_data - - SUBROUTINE DWM_UnPacksmooth_out_wake_data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(smooth_out_wake_data), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPacksmooth_out_wake_data' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%length_velocity_array = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE DWM_UnPacksmooth_out_wake_data +subroutine DWM_Packsmooth_out_wake_data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(smooth_out_wake_data), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_Packsmooth_out_wake_data' + if (Buf%ErrStat >= AbortErrLev) return + ! length_velocity_array + call RegPack(Buf, InData%length_velocity_array) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPacksmooth_out_wake_data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(smooth_out_wake_data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPacksmooth_out_wake_data' + if (Buf%ErrStat /= ErrID_None) return + ! length_velocity_array + call RegUnpack(Buf, OutData%length_velocity_array) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE DWM_CopySWSV( SrcSWSVData, DstSWSVData, CtrlCode, ErrStat, ErrMsg ) TYPE(SWSV), INTENT(IN) :: SrcSWSVData TYPE(SWSV), INTENT(INOUT) :: DstSWSVData @@ -3521,128 +2325,56 @@ SUBROUTINE DWM_DestroySWSV( SWSVData, ErrStat, ErrMsg ) END SUBROUTINE DWM_DestroySWSV - SUBROUTINE DWM_PackSWSV( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SWSV), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_PackSWSV' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! p1 - Int_BufSz = Int_BufSz + 1 ! p2 - Re_BufSz = Re_BufSz + 1 ! distance - Re_BufSz = Re_BufSz + 1 ! y0 - Re_BufSz = Re_BufSz + 1 ! z0 - Re_BufSz = Re_BufSz + 1 ! unit - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%p1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%p2 - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%distance - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%y0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%z0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%unit - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DWM_PackSWSV - - SUBROUTINE DWM_UnPackSWSV( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SWSV), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackSWSV' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%p1 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%p2 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%distance = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%y0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%z0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%unit = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE DWM_UnPackSWSV +subroutine DWM_PackSWSV(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SWSV), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_PackSWSV' + if (Buf%ErrStat >= AbortErrLev) return + ! p1 + call RegPack(Buf, InData%p1) + if (RegCheckErr(Buf, RoutineName)) return + ! p2 + call RegPack(Buf, InData%p2) + if (RegCheckErr(Buf, RoutineName)) return + ! distance + call RegPack(Buf, InData%distance) + if (RegCheckErr(Buf, RoutineName)) return + ! y0 + call RegPack(Buf, InData%y0) + if (RegCheckErr(Buf, RoutineName)) return + ! z0 + call RegPack(Buf, InData%z0) + if (RegCheckErr(Buf, RoutineName)) return + ! unit + call RegPack(Buf, InData%unit) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPackSWSV(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SWSV), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPackSWSV' + if (Buf%ErrStat /= ErrID_None) return + ! p1 + call RegUnpack(Buf, OutData%p1) + if (RegCheckErr(Buf, RoutineName)) return + ! p2 + call RegUnpack(Buf, OutData%p2) + if (RegCheckErr(Buf, RoutineName)) return + ! distance + call RegUnpack(Buf, OutData%distance) + if (RegCheckErr(Buf, RoutineName)) return + ! y0 + call RegUnpack(Buf, OutData%y0) + if (RegCheckErr(Buf, RoutineName)) return + ! z0 + call RegUnpack(Buf, OutData%z0) + if (RegCheckErr(Buf, RoutineName)) return + ! unit + call RegUnpack(Buf, OutData%unit) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE DWM_Copyread_upwind_result( Srcread_upwind_resultData, Dstread_upwind_resultData, CtrlCode, ErrStat, ErrMsg ) TYPE(read_upwind_result), INTENT(IN) :: Srcread_upwind_resultData TYPE(read_upwind_result), INTENT(INOUT) :: Dstread_upwind_resultData @@ -3859,600 +2591,265 @@ SUBROUTINE DWM_Destroyread_upwind_result( read_upwind_resultData, ErrStat, ErrMs ENDIF END SUBROUTINE DWM_Destroyread_upwind_result - SUBROUTINE DWM_Packread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(read_upwind_result), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Packread_upwind_result' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! upwind_U allocated yes/no - IF ( ALLOCATED(InData%upwind_U) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! upwind_U upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%upwind_U) ! upwind_U - END IF - Int_BufSz = Int_BufSz + 1 ! upwind_wakecenter allocated yes/no - IF ( ALLOCATED(InData%upwind_wakecenter) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! upwind_wakecenter upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%upwind_wakecenter) ! upwind_wakecenter - END IF - Int_BufSz = Int_BufSz + 1 ! upwind_meanU allocated yes/no - IF ( ALLOCATED(InData%upwind_meanU) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! upwind_meanU upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%upwind_meanU) ! upwind_meanU - END IF - Int_BufSz = Int_BufSz + 1 ! upwind_TI allocated yes/no - IF ( ALLOCATED(InData%upwind_TI) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! upwind_TI upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%upwind_TI) ! upwind_TI - END IF - Int_BufSz = Int_BufSz + 1 ! upwind_small_TI allocated yes/no - IF ( ALLOCATED(InData%upwind_small_TI) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! upwind_small_TI upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%upwind_small_TI) ! upwind_small_TI - END IF - Int_BufSz = Int_BufSz + 1 ! upwind_smoothWake allocated yes/no - IF ( ALLOCATED(InData%upwind_smoothWake) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! upwind_smoothWake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%upwind_smoothWake) ! upwind_smoothWake - END IF - Int_BufSz = Int_BufSz + 1 ! velocity_aerodyn allocated yes/no - IF ( ALLOCATED(InData%velocity_aerodyn) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! velocity_aerodyn upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%velocity_aerodyn) ! velocity_aerodyn - END IF - Int_BufSz = Int_BufSz + 1 ! TI_downstream allocated yes/no - IF ( ALLOCATED(InData%TI_downstream) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TI_downstream upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TI_downstream) ! TI_downstream - END IF - Int_BufSz = Int_BufSz + 1 ! small_scale_TI_downstream allocated yes/no - IF ( ALLOCATED(InData%small_scale_TI_downstream) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! small_scale_TI_downstream upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%small_scale_TI_downstream) ! small_scale_TI_downstream - END IF - Int_BufSz = Int_BufSz + 1 ! smoothed_velocity_array allocated yes/no - IF ( ALLOCATED(InData%smoothed_velocity_array) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! smoothed_velocity_array upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%smoothed_velocity_array) ! smoothed_velocity_array - END IF - Int_BufSz = Int_BufSz + 1 ! vel_matrix allocated yes/no - IF ( ALLOCATED(InData%vel_matrix) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! vel_matrix upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%vel_matrix) ! vel_matrix - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%upwind_U) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%upwind_U,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_U,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%upwind_U,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_U,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%upwind_U,2), UBOUND(InData%upwind_U,2) - DO i1 = LBOUND(InData%upwind_U,1), UBOUND(InData%upwind_U,1) - ReKiBuf(Re_Xferred) = InData%upwind_U(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%upwind_wakecenter) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%upwind_wakecenter,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_wakecenter,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%upwind_wakecenter,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_wakecenter,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%upwind_wakecenter,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_wakecenter,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%upwind_wakecenter,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_wakecenter,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%upwind_wakecenter,4), UBOUND(InData%upwind_wakecenter,4) - DO i3 = LBOUND(InData%upwind_wakecenter,3), UBOUND(InData%upwind_wakecenter,3) - DO i2 = LBOUND(InData%upwind_wakecenter,2), UBOUND(InData%upwind_wakecenter,2) - DO i1 = LBOUND(InData%upwind_wakecenter,1), UBOUND(InData%upwind_wakecenter,1) - ReKiBuf(Re_Xferred) = InData%upwind_wakecenter(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%upwind_meanU) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%upwind_meanU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_meanU,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%upwind_meanU,1), UBOUND(InData%upwind_meanU,1) - ReKiBuf(Re_Xferred) = InData%upwind_meanU(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%upwind_TI) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%upwind_TI,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_TI,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%upwind_TI,1), UBOUND(InData%upwind_TI,1) - ReKiBuf(Re_Xferred) = InData%upwind_TI(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%upwind_small_TI) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%upwind_small_TI,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_small_TI,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%upwind_small_TI,1), UBOUND(InData%upwind_small_TI,1) - ReKiBuf(Re_Xferred) = InData%upwind_small_TI(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%upwind_smoothWake) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%upwind_smoothWake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_smoothWake,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%upwind_smoothWake,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_smoothWake,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%upwind_smoothWake,2), UBOUND(InData%upwind_smoothWake,2) - DO i1 = LBOUND(InData%upwind_smoothWake,1), UBOUND(InData%upwind_smoothWake,1) - ReKiBuf(Re_Xferred) = InData%upwind_smoothWake(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%velocity_aerodyn) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%velocity_aerodyn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%velocity_aerodyn,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%velocity_aerodyn,1), UBOUND(InData%velocity_aerodyn,1) - ReKiBuf(Re_Xferred) = InData%velocity_aerodyn(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TI_downstream) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TI_downstream,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI_downstream,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TI_downstream,1), UBOUND(InData%TI_downstream,1) - ReKiBuf(Re_Xferred) = InData%TI_downstream(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%small_scale_TI_downstream) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%small_scale_TI_downstream,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%small_scale_TI_downstream,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%small_scale_TI_downstream,1), UBOUND(InData%small_scale_TI_downstream,1) - ReKiBuf(Re_Xferred) = InData%small_scale_TI_downstream(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%smoothed_velocity_array) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%smoothed_velocity_array,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%smoothed_velocity_array,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%smoothed_velocity_array,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%smoothed_velocity_array,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%smoothed_velocity_array,2), UBOUND(InData%smoothed_velocity_array,2) - DO i1 = LBOUND(InData%smoothed_velocity_array,1), UBOUND(InData%smoothed_velocity_array,1) - ReKiBuf(Re_Xferred) = InData%smoothed_velocity_array(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%vel_matrix) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vel_matrix,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vel_matrix,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vel_matrix,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vel_matrix,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vel_matrix,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vel_matrix,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%vel_matrix,3), UBOUND(InData%vel_matrix,3) - DO i2 = LBOUND(InData%vel_matrix,2), UBOUND(InData%vel_matrix,2) - DO i1 = LBOUND(InData%vel_matrix,1), UBOUND(InData%vel_matrix,1) - ReKiBuf(Re_Xferred) = InData%vel_matrix(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE DWM_Packread_upwind_result - - SUBROUTINE DWM_UnPackread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(read_upwind_result), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackread_upwind_result' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_U not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%upwind_U)) DEALLOCATE(OutData%upwind_U) - ALLOCATE(OutData%upwind_U(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_U.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%upwind_U,2), UBOUND(OutData%upwind_U,2) - DO i1 = LBOUND(OutData%upwind_U,1), UBOUND(OutData%upwind_U,1) - OutData%upwind_U(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_wakecenter not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%upwind_wakecenter)) DEALLOCATE(OutData%upwind_wakecenter) - ALLOCATE(OutData%upwind_wakecenter(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_wakecenter.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%upwind_wakecenter,4), UBOUND(OutData%upwind_wakecenter,4) - DO i3 = LBOUND(OutData%upwind_wakecenter,3), UBOUND(OutData%upwind_wakecenter,3) - DO i2 = LBOUND(OutData%upwind_wakecenter,2), UBOUND(OutData%upwind_wakecenter,2) - DO i1 = LBOUND(OutData%upwind_wakecenter,1), UBOUND(OutData%upwind_wakecenter,1) - OutData%upwind_wakecenter(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_meanU not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%upwind_meanU)) DEALLOCATE(OutData%upwind_meanU) - ALLOCATE(OutData%upwind_meanU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_meanU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%upwind_meanU,1), UBOUND(OutData%upwind_meanU,1) - OutData%upwind_meanU(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_TI not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%upwind_TI)) DEALLOCATE(OutData%upwind_TI) - ALLOCATE(OutData%upwind_TI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_TI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%upwind_TI,1), UBOUND(OutData%upwind_TI,1) - OutData%upwind_TI(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_small_TI not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%upwind_small_TI)) DEALLOCATE(OutData%upwind_small_TI) - ALLOCATE(OutData%upwind_small_TI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_small_TI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%upwind_small_TI,1), UBOUND(OutData%upwind_small_TI,1) - OutData%upwind_small_TI(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_smoothWake not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%upwind_smoothWake)) DEALLOCATE(OutData%upwind_smoothWake) - ALLOCATE(OutData%upwind_smoothWake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_smoothWake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%upwind_smoothWake,2), UBOUND(OutData%upwind_smoothWake,2) - DO i1 = LBOUND(OutData%upwind_smoothWake,1), UBOUND(OutData%upwind_smoothWake,1) - OutData%upwind_smoothWake(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! velocity_aerodyn not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%velocity_aerodyn)) DEALLOCATE(OutData%velocity_aerodyn) - ALLOCATE(OutData%velocity_aerodyn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%velocity_aerodyn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%velocity_aerodyn,1), UBOUND(OutData%velocity_aerodyn,1) - OutData%velocity_aerodyn(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TI_downstream not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TI_downstream)) DEALLOCATE(OutData%TI_downstream) - ALLOCATE(OutData%TI_downstream(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI_downstream.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TI_downstream,1), UBOUND(OutData%TI_downstream,1) - OutData%TI_downstream(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! small_scale_TI_downstream not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%small_scale_TI_downstream)) DEALLOCATE(OutData%small_scale_TI_downstream) - ALLOCATE(OutData%small_scale_TI_downstream(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%small_scale_TI_downstream.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%small_scale_TI_downstream,1), UBOUND(OutData%small_scale_TI_downstream,1) - OutData%small_scale_TI_downstream(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! smoothed_velocity_array not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%smoothed_velocity_array)) DEALLOCATE(OutData%smoothed_velocity_array) - ALLOCATE(OutData%smoothed_velocity_array(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%smoothed_velocity_array.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%smoothed_velocity_array,2), UBOUND(OutData%smoothed_velocity_array,2) - DO i1 = LBOUND(OutData%smoothed_velocity_array,1), UBOUND(OutData%smoothed_velocity_array,1) - OutData%smoothed_velocity_array(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! vel_matrix not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%vel_matrix)) DEALLOCATE(OutData%vel_matrix) - ALLOCATE(OutData%vel_matrix(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%vel_matrix.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%vel_matrix,3), UBOUND(OutData%vel_matrix,3) - DO i2 = LBOUND(OutData%vel_matrix,2), UBOUND(OutData%vel_matrix,2) - DO i1 = LBOUND(OutData%vel_matrix,1), UBOUND(OutData%vel_matrix,1) - OutData%vel_matrix(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE DWM_UnPackread_upwind_result +subroutine DWM_Packread_upwind_result(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(read_upwind_result), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_Packread_upwind_result' + if (Buf%ErrStat >= AbortErrLev) return + ! upwind_U + call RegPack(Buf, allocated(InData%upwind_U)) + if (allocated(InData%upwind_U)) then + call RegPackBounds(Buf, 2, lbound(InData%upwind_U), ubound(InData%upwind_U)) + call RegPack(Buf, InData%upwind_U) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! upwind_wakecenter + call RegPack(Buf, allocated(InData%upwind_wakecenter)) + if (allocated(InData%upwind_wakecenter)) then + call RegPackBounds(Buf, 4, lbound(InData%upwind_wakecenter), ubound(InData%upwind_wakecenter)) + call RegPack(Buf, InData%upwind_wakecenter) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! upwind_meanU + call RegPack(Buf, allocated(InData%upwind_meanU)) + if (allocated(InData%upwind_meanU)) then + call RegPackBounds(Buf, 1, lbound(InData%upwind_meanU), ubound(InData%upwind_meanU)) + call RegPack(Buf, InData%upwind_meanU) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! upwind_TI + call RegPack(Buf, allocated(InData%upwind_TI)) + if (allocated(InData%upwind_TI)) then + call RegPackBounds(Buf, 1, lbound(InData%upwind_TI), ubound(InData%upwind_TI)) + call RegPack(Buf, InData%upwind_TI) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! upwind_small_TI + call RegPack(Buf, allocated(InData%upwind_small_TI)) + if (allocated(InData%upwind_small_TI)) then + call RegPackBounds(Buf, 1, lbound(InData%upwind_small_TI), ubound(InData%upwind_small_TI)) + call RegPack(Buf, InData%upwind_small_TI) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! upwind_smoothWake + call RegPack(Buf, allocated(InData%upwind_smoothWake)) + if (allocated(InData%upwind_smoothWake)) then + call RegPackBounds(Buf, 2, lbound(InData%upwind_smoothWake), ubound(InData%upwind_smoothWake)) + call RegPack(Buf, InData%upwind_smoothWake) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! velocity_aerodyn + call RegPack(Buf, allocated(InData%velocity_aerodyn)) + if (allocated(InData%velocity_aerodyn)) then + call RegPackBounds(Buf, 1, lbound(InData%velocity_aerodyn), ubound(InData%velocity_aerodyn)) + call RegPack(Buf, InData%velocity_aerodyn) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TI_downstream + call RegPack(Buf, allocated(InData%TI_downstream)) + if (allocated(InData%TI_downstream)) then + call RegPackBounds(Buf, 1, lbound(InData%TI_downstream), ubound(InData%TI_downstream)) + call RegPack(Buf, InData%TI_downstream) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! small_scale_TI_downstream + call RegPack(Buf, allocated(InData%small_scale_TI_downstream)) + if (allocated(InData%small_scale_TI_downstream)) then + call RegPackBounds(Buf, 1, lbound(InData%small_scale_TI_downstream), ubound(InData%small_scale_TI_downstream)) + call RegPack(Buf, InData%small_scale_TI_downstream) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! smoothed_velocity_array + call RegPack(Buf, allocated(InData%smoothed_velocity_array)) + if (allocated(InData%smoothed_velocity_array)) then + call RegPackBounds(Buf, 2, lbound(InData%smoothed_velocity_array), ubound(InData%smoothed_velocity_array)) + call RegPack(Buf, InData%smoothed_velocity_array) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! vel_matrix + call RegPack(Buf, allocated(InData%vel_matrix)) + if (allocated(InData%vel_matrix)) then + call RegPackBounds(Buf, 3, lbound(InData%vel_matrix), ubound(InData%vel_matrix)) + call RegPack(Buf, InData%vel_matrix) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPackread_upwind_result(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(read_upwind_result), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPackread_upwind_result' + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! upwind_U + if (allocated(OutData%upwind_U)) deallocate(OutData%upwind_U) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%upwind_U(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_U.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%upwind_U) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! upwind_wakecenter + if (allocated(OutData%upwind_wakecenter)) deallocate(OutData%upwind_wakecenter) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%upwind_wakecenter(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_wakecenter.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%upwind_wakecenter) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! upwind_meanU + if (allocated(OutData%upwind_meanU)) deallocate(OutData%upwind_meanU) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%upwind_meanU(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_meanU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%upwind_meanU) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! upwind_TI + if (allocated(OutData%upwind_TI)) deallocate(OutData%upwind_TI) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%upwind_TI(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_TI.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%upwind_TI) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! upwind_small_TI + if (allocated(OutData%upwind_small_TI)) deallocate(OutData%upwind_small_TI) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%upwind_small_TI(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_small_TI.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%upwind_small_TI) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! upwind_smoothWake + if (allocated(OutData%upwind_smoothWake)) deallocate(OutData%upwind_smoothWake) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%upwind_smoothWake(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_smoothWake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%upwind_smoothWake) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! velocity_aerodyn + if (allocated(OutData%velocity_aerodyn)) deallocate(OutData%velocity_aerodyn) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%velocity_aerodyn(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%velocity_aerodyn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%velocity_aerodyn) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TI_downstream + if (allocated(OutData%TI_downstream)) deallocate(OutData%TI_downstream) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TI_downstream(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI_downstream.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TI_downstream) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! small_scale_TI_downstream + if (allocated(OutData%small_scale_TI_downstream)) deallocate(OutData%small_scale_TI_downstream) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%small_scale_TI_downstream(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%small_scale_TI_downstream.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%small_scale_TI_downstream) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! smoothed_velocity_array + if (allocated(OutData%smoothed_velocity_array)) deallocate(OutData%smoothed_velocity_array) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%smoothed_velocity_array(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%smoothed_velocity_array.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%smoothed_velocity_array) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! vel_matrix + if (allocated(OutData%vel_matrix)) deallocate(OutData%vel_matrix) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%vel_matrix(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%vel_matrix.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%vel_matrix) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE DWM_Copywake_meandered_center( Srcwake_meandered_centerData, Dstwake_meandered_centerData, CtrlCode, ErrStat, ErrMsg ) TYPE(wake_meandered_center), INTENT(IN) :: Srcwake_meandered_centerData TYPE(wake_meandered_center), INTENT(INOUT) :: Dstwake_meandered_centerData @@ -4495,142 +2892,50 @@ SUBROUTINE DWM_Destroywake_meandered_center( wake_meandered_centerData, ErrStat, ErrStat = ErrID_None ErrMsg = "" -IF (ALLOCATED(wake_meandered_centerData%wake_width)) THEN - DEALLOCATE(wake_meandered_centerData%wake_width) -ENDIF - END SUBROUTINE DWM_Destroywake_meandered_center - - SUBROUTINE DWM_Packwake_meandered_center( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(wake_meandered_center), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Packwake_meandered_center' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! wake_width allocated yes/no - IF ( ALLOCATED(InData%wake_width) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! wake_width upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%wake_width) ! wake_width - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%wake_width) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%wake_width,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%wake_width,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%wake_width,1), UBOUND(InData%wake_width,1) - IntKiBuf(Int_Xferred) = InData%wake_width(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE DWM_Packwake_meandered_center - - SUBROUTINE DWM_UnPackwake_meandered_center( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(wake_meandered_center), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackwake_meandered_center' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! wake_width not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%wake_width)) DEALLOCATE(OutData%wake_width) - ALLOCATE(OutData%wake_width(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%wake_width.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%wake_width,1), UBOUND(OutData%wake_width,1) - OutData%wake_width(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE DWM_UnPackwake_meandered_center +IF (ALLOCATED(wake_meandered_centerData%wake_width)) THEN + DEALLOCATE(wake_meandered_centerData%wake_width) +ENDIF + END SUBROUTINE DWM_Destroywake_meandered_center + +subroutine DWM_Packwake_meandered_center(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(wake_meandered_center), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_Packwake_meandered_center' + if (Buf%ErrStat >= AbortErrLev) return + ! wake_width + call RegPack(Buf, allocated(InData%wake_width)) + if (allocated(InData%wake_width)) then + call RegPackBounds(Buf, 1, lbound(InData%wake_width), ubound(InData%wake_width)) + call RegPack(Buf, InData%wake_width) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPackwake_meandered_center(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(wake_meandered_center), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPackwake_meandered_center' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! wake_width + if (allocated(OutData%wake_width)) deallocate(OutData%wake_width) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%wake_width(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%wake_width.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%wake_width) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE DWM_Copyturbine_blade( Srcturbine_bladeData, Dstturbine_bladeData, CtrlCode, ErrStat, ErrMsg ) TYPE(DWM_turbine_blade), INTENT(IN) :: Srcturbine_bladeData TYPE(DWM_turbine_blade), INTENT(INOUT) :: Dstturbine_bladeData @@ -4665,113 +2970,38 @@ SUBROUTINE DWM_Destroyturbine_blade( turbine_bladeData, ErrStat, ErrMsg ) END SUBROUTINE DWM_Destroyturbine_blade - SUBROUTINE DWM_Packturbine_blade( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(DWM_turbine_blade), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Packturbine_blade' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! Aerodyn_turbine_num - Int_BufSz = Int_BufSz + 1 ! Blade_index - Int_BufSz = Int_BufSz + 1 ! Element_index - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%Aerodyn_turbine_num - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Blade_index - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Element_index - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE DWM_Packturbine_blade - - SUBROUTINE DWM_UnPackturbine_blade( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(DWM_turbine_blade), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackturbine_blade' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%Aerodyn_turbine_num = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Blade_index = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Element_index = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE DWM_UnPackturbine_blade +subroutine DWM_Packturbine_blade(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DWM_turbine_blade), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_Packturbine_blade' + if (Buf%ErrStat >= AbortErrLev) return + ! Aerodyn_turbine_num + call RegPack(Buf, InData%Aerodyn_turbine_num) + if (RegCheckErr(Buf, RoutineName)) return + ! Blade_index + call RegPack(Buf, InData%Blade_index) + if (RegCheckErr(Buf, RoutineName)) return + ! Element_index + call RegPack(Buf, InData%Element_index) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPackturbine_blade(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DWM_turbine_blade), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPackturbine_blade' + if (Buf%ErrStat /= ErrID_None) return + ! Aerodyn_turbine_num + call RegUnpack(Buf, OutData%Aerodyn_turbine_num) + if (RegCheckErr(Buf, RoutineName)) return + ! Blade_index + call RegUnpack(Buf, OutData%Blade_index) + if (RegCheckErr(Buf, RoutineName)) return + ! Element_index + call RegUnpack(Buf, OutData%Element_index) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE DWM_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(DWM_ParameterType), INTENT(IN) :: SrcParamData TYPE(DWM_ParameterType), INTENT(INOUT) :: DstParamData @@ -4901,549 +3131,247 @@ SUBROUTINE DWM_DestroyParam( ParamData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE DWM_DestroyParam - SUBROUTINE DWM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(DWM_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! velocityU allocated yes/no - IF ( ALLOCATED(InData%velocityU) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! velocityU upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%velocityU) ! velocityU - END IF - Int_BufSz = Int_BufSz + 1 ! smoothed_wake allocated yes/no - IF ( ALLOCATED(InData%smoothed_wake) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! smoothed_wake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%smoothed_wake) ! smoothed_wake - END IF - Int_BufSz = Int_BufSz + 1 ! WakePosition allocated yes/no - IF ( ALLOCATED(InData%WakePosition) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WakePosition upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WakePosition) ! WakePosition - END IF - Int_BufSz = Int_BufSz + 1 ! WakePosition_1 - Int_BufSz = Int_BufSz + 1 ! WakePosition_2 - Int_BufSz = Int_BufSz + 1 ! smooth_flag - Int_BufSz = Int_BufSz + 1 ! p_p_r - Int_BufSz = Int_BufSz + 1 ! NumWT - Int_BufSz = Int_BufSz + 1 ! Tinfluencer - Re_BufSz = Re_BufSz + 1 ! RotorR - Re_BufSz = Re_BufSz + 1 ! r_domain - Re_BufSz = Re_BufSz + 1 ! x_domain - Re_BufSz = Re_BufSz + 1 ! Uambient - Re_BufSz = Re_BufSz + 1 ! TI_amb - Re_BufSz = Re_BufSz + 1 ! TI_wake - Re_BufSz = Re_BufSz + 1 ! hub_height - Re_BufSz = Re_BufSz + 1 ! length_velocityU - Re_BufSz = Re_BufSz + 1 ! WFLowerBd - Re_BufSz = Re_BufSz + 1 ! Wind_file_Mean_u - Re_BufSz = Re_BufSz + 1 ! Winddir - Re_BufSz = Re_BufSz + 1 ! air_density - Re_BufSz = Re_BufSz + 1 ! RR - Int_BufSz = Int_BufSz + 1 ! ElementRad allocated yes/no - IF ( ALLOCATED(InData%ElementRad) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ElementRad upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ElementRad) ! ElementRad - END IF - Int_BufSz = Int_BufSz + 1 ! Bnum - Int_BufSz = Int_BufSz + 1 ! ElementNum - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! RTPD: size of buffers for each call to pack subtype - CALL DWM_Packread_turbine_position_data( Re_Buf, Db_Buf, Int_Buf, InData%RTPD, ErrStat2, ErrMsg2, .TRUE. ) ! RTPD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! RTPD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! RTPD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! RTPD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%velocityU) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%velocityU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%velocityU,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%velocityU,1), UBOUND(InData%velocityU,1) - ReKiBuf(Re_Xferred) = InData%velocityU(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%smoothed_wake) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%smoothed_wake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%smoothed_wake,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%smoothed_wake,1), UBOUND(InData%smoothed_wake,1) - ReKiBuf(Re_Xferred) = InData%smoothed_wake(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WakePosition) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WakePosition,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WakePosition,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WakePosition,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WakePosition,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WakePosition,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WakePosition,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WakePosition,3), UBOUND(InData%WakePosition,3) - DO i2 = LBOUND(InData%WakePosition,2), UBOUND(InData%WakePosition,2) - DO i1 = LBOUND(InData%WakePosition,1), UBOUND(InData%WakePosition,1) - ReKiBuf(Re_Xferred) = InData%WakePosition(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%WakePosition_1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WakePosition_2 - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%smooth_flag - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%p_p_r - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumWT - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Tinfluencer - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RotorR - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%r_domain - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%x_domain - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Uambient - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TI_amb - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TI_wake - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%hub_height - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%length_velocityU - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WFLowerBd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Wind_file_Mean_u - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Winddir - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%air_density - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RR - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%ElementRad) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ElementRad,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElementRad,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ElementRad,1), UBOUND(InData%ElementRad,1) - ReKiBuf(Re_Xferred) = InData%ElementRad(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%Bnum - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ElementNum - Int_Xferred = Int_Xferred + 1 - CALL DWM_Packread_turbine_position_data( Re_Buf, Db_Buf, Int_Buf, InData%RTPD, ErrStat2, ErrMsg2, OnlySize ) ! RTPD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL InflowWind_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE DWM_PackParam - - SUBROUTINE DWM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(DWM_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! velocityU not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%velocityU)) DEALLOCATE(OutData%velocityU) - ALLOCATE(OutData%velocityU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%velocityU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%velocityU,1), UBOUND(OutData%velocityU,1) - OutData%velocityU(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! smoothed_wake not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%smoothed_wake)) DEALLOCATE(OutData%smoothed_wake) - ALLOCATE(OutData%smoothed_wake(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%smoothed_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%smoothed_wake,1), UBOUND(OutData%smoothed_wake,1) - OutData%smoothed_wake(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WakePosition not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WakePosition)) DEALLOCATE(OutData%WakePosition) - ALLOCATE(OutData%WakePosition(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WakePosition.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WakePosition,3), UBOUND(OutData%WakePosition,3) - DO i2 = LBOUND(OutData%WakePosition,2), UBOUND(OutData%WakePosition,2) - DO i1 = LBOUND(OutData%WakePosition,1), UBOUND(OutData%WakePosition,1) - OutData%WakePosition(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%WakePosition_1 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WakePosition_2 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%smooth_flag = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%p_p_r = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumWT = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Tinfluencer = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%RotorR = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%r_domain = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%x_domain = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Uambient = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TI_amb = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TI_wake = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%hub_height = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%length_velocityU = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WFLowerBd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Wind_file_Mean_u = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Winddir = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%air_density = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RR = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElementRad not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ElementRad)) DEALLOCATE(OutData%ElementRad) - ALLOCATE(OutData%ElementRad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElementRad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ElementRad,1), UBOUND(OutData%ElementRad,1) - OutData%ElementRad(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Bnum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ElementNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL DWM_Unpackread_turbine_position_data( Re_Buf, Db_Buf, Int_Buf, OutData%RTPD, ErrStat2, ErrMsg2 ) ! RTPD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%IfW, ErrStat2, ErrMsg2 ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE DWM_UnPackParam +subroutine DWM_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DWM_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_PackParam' + if (Buf%ErrStat >= AbortErrLev) return + ! velocityU + call RegPack(Buf, allocated(InData%velocityU)) + if (allocated(InData%velocityU)) then + call RegPackBounds(Buf, 1, lbound(InData%velocityU), ubound(InData%velocityU)) + call RegPack(Buf, InData%velocityU) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! smoothed_wake + call RegPack(Buf, allocated(InData%smoothed_wake)) + if (allocated(InData%smoothed_wake)) then + call RegPackBounds(Buf, 1, lbound(InData%smoothed_wake), ubound(InData%smoothed_wake)) + call RegPack(Buf, InData%smoothed_wake) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WakePosition + call RegPack(Buf, allocated(InData%WakePosition)) + if (allocated(InData%WakePosition)) then + call RegPackBounds(Buf, 3, lbound(InData%WakePosition), ubound(InData%WakePosition)) + call RegPack(Buf, InData%WakePosition) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WakePosition_1 + call RegPack(Buf, InData%WakePosition_1) + if (RegCheckErr(Buf, RoutineName)) return + ! WakePosition_2 + call RegPack(Buf, InData%WakePosition_2) + if (RegCheckErr(Buf, RoutineName)) return + ! smooth_flag + call RegPack(Buf, InData%smooth_flag) + if (RegCheckErr(Buf, RoutineName)) return + ! p_p_r + call RegPack(Buf, InData%p_p_r) + if (RegCheckErr(Buf, RoutineName)) return + ! NumWT + call RegPack(Buf, InData%NumWT) + if (RegCheckErr(Buf, RoutineName)) return + ! Tinfluencer + call RegPack(Buf, InData%Tinfluencer) + if (RegCheckErr(Buf, RoutineName)) return + ! RotorR + call RegPack(Buf, InData%RotorR) + if (RegCheckErr(Buf, RoutineName)) return + ! r_domain + call RegPack(Buf, InData%r_domain) + if (RegCheckErr(Buf, RoutineName)) return + ! x_domain + call RegPack(Buf, InData%x_domain) + if (RegCheckErr(Buf, RoutineName)) return + ! Uambient + call RegPack(Buf, InData%Uambient) + if (RegCheckErr(Buf, RoutineName)) return + ! TI_amb + call RegPack(Buf, InData%TI_amb) + if (RegCheckErr(Buf, RoutineName)) return + ! TI_wake + call RegPack(Buf, InData%TI_wake) + if (RegCheckErr(Buf, RoutineName)) return + ! hub_height + call RegPack(Buf, InData%hub_height) + if (RegCheckErr(Buf, RoutineName)) return + ! length_velocityU + call RegPack(Buf, InData%length_velocityU) + if (RegCheckErr(Buf, RoutineName)) return + ! WFLowerBd + call RegPack(Buf, InData%WFLowerBd) + if (RegCheckErr(Buf, RoutineName)) return + ! Wind_file_Mean_u + call RegPack(Buf, InData%Wind_file_Mean_u) + if (RegCheckErr(Buf, RoutineName)) return + ! Winddir + call RegPack(Buf, InData%Winddir) + if (RegCheckErr(Buf, RoutineName)) return + ! air_density + call RegPack(Buf, InData%air_density) + if (RegCheckErr(Buf, RoutineName)) return + ! RR + call RegPack(Buf, InData%RR) + if (RegCheckErr(Buf, RoutineName)) return + ! ElementRad + call RegPack(Buf, allocated(InData%ElementRad)) + if (allocated(InData%ElementRad)) then + call RegPackBounds(Buf, 1, lbound(InData%ElementRad), ubound(InData%ElementRad)) + call RegPack(Buf, InData%ElementRad) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Bnum + call RegPack(Buf, InData%Bnum) + if (RegCheckErr(Buf, RoutineName)) return + ! ElementNum + call RegPack(Buf, InData%ElementNum) + if (RegCheckErr(Buf, RoutineName)) return + ! RTPD + call DWM_Packread_turbine_position_data(Buf, InData%RTPD) + if (RegCheckErr(Buf, RoutineName)) return + ! IfW + call InflowWind_PackParam(Buf, InData%IfW) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DWM_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPackParam' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! velocityU + if (allocated(OutData%velocityU)) deallocate(OutData%velocityU) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%velocityU(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%velocityU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%velocityU) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! smoothed_wake + if (allocated(OutData%smoothed_wake)) deallocate(OutData%smoothed_wake) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%smoothed_wake(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%smoothed_wake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%smoothed_wake) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WakePosition + if (allocated(OutData%WakePosition)) deallocate(OutData%WakePosition) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WakePosition(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WakePosition.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WakePosition) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WakePosition_1 + call RegUnpack(Buf, OutData%WakePosition_1) + if (RegCheckErr(Buf, RoutineName)) return + ! WakePosition_2 + call RegUnpack(Buf, OutData%WakePosition_2) + if (RegCheckErr(Buf, RoutineName)) return + ! smooth_flag + call RegUnpack(Buf, OutData%smooth_flag) + if (RegCheckErr(Buf, RoutineName)) return + ! p_p_r + call RegUnpack(Buf, OutData%p_p_r) + if (RegCheckErr(Buf, RoutineName)) return + ! NumWT + call RegUnpack(Buf, OutData%NumWT) + if (RegCheckErr(Buf, RoutineName)) return + ! Tinfluencer + call RegUnpack(Buf, OutData%Tinfluencer) + if (RegCheckErr(Buf, RoutineName)) return + ! RotorR + call RegUnpack(Buf, OutData%RotorR) + if (RegCheckErr(Buf, RoutineName)) return + ! r_domain + call RegUnpack(Buf, OutData%r_domain) + if (RegCheckErr(Buf, RoutineName)) return + ! x_domain + call RegUnpack(Buf, OutData%x_domain) + if (RegCheckErr(Buf, RoutineName)) return + ! Uambient + call RegUnpack(Buf, OutData%Uambient) + if (RegCheckErr(Buf, RoutineName)) return + ! TI_amb + call RegUnpack(Buf, OutData%TI_amb) + if (RegCheckErr(Buf, RoutineName)) return + ! TI_wake + call RegUnpack(Buf, OutData%TI_wake) + if (RegCheckErr(Buf, RoutineName)) return + ! hub_height + call RegUnpack(Buf, OutData%hub_height) + if (RegCheckErr(Buf, RoutineName)) return + ! length_velocityU + call RegUnpack(Buf, OutData%length_velocityU) + if (RegCheckErr(Buf, RoutineName)) return + ! WFLowerBd + call RegUnpack(Buf, OutData%WFLowerBd) + if (RegCheckErr(Buf, RoutineName)) return + ! Wind_file_Mean_u + call RegUnpack(Buf, OutData%Wind_file_Mean_u) + if (RegCheckErr(Buf, RoutineName)) return + ! Winddir + call RegUnpack(Buf, OutData%Winddir) + if (RegCheckErr(Buf, RoutineName)) return + ! air_density + call RegUnpack(Buf, OutData%air_density) + if (RegCheckErr(Buf, RoutineName)) return + ! RR + call RegUnpack(Buf, OutData%RR) + if (RegCheckErr(Buf, RoutineName)) return + ! ElementRad + if (allocated(OutData%ElementRad)) deallocate(OutData%ElementRad) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ElementRad(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElementRad.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ElementRad) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Bnum + call RegUnpack(Buf, OutData%Bnum) + if (RegCheckErr(Buf, RoutineName)) return + ! ElementNum + call RegUnpack(Buf, OutData%ElementNum) + if (RegCheckErr(Buf, RoutineName)) return + ! RTPD + call DWM_Unpackread_turbine_position_data(Buf, OutData%RTPD) ! RTPD + ! IfW + call InflowWind_UnpackParam(Buf, OutData%IfW) ! IfW +end subroutine SUBROUTINE DWM_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(DWM_OtherStateType), INTENT(IN) :: SrcOtherStateData TYPE(DWM_OtherStateType), INTENT(INOUT) :: DstOtherStateData @@ -5480,184 +3408,25 @@ SUBROUTINE DWM_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE DWM_DestroyOtherState - SUBROUTINE DWM_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(DWM_OtherStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_PackOtherState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL InflowWind_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE DWM_PackOtherState - - SUBROUTINE DWM_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(DWM_OtherStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackOtherState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%IfW, ErrStat2, ErrMsg2 ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE DWM_UnPackOtherState +subroutine DWM_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DWM_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_PackOtherState' + if (Buf%ErrStat >= AbortErrLev) return + ! IfW + call InflowWind_PackOtherState(Buf, InData%IfW) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DWM_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPackOtherState' + if (Buf%ErrStat /= ErrID_None) return + ! IfW + call InflowWind_UnpackOtherState(Buf, OutData%IfW) ! IfW +end subroutine SUBROUTINE DWM_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) TYPE(DWM_MiscVarType), INTENT(IN) :: SrcMiscData TYPE(DWM_MiscVarType), INTENT(INOUT) :: DstMiscData @@ -5799,1347 +3568,198 @@ SUBROUTINE DWM_DestroyMisc( MiscData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE DWM_DestroyMisc - SUBROUTINE DWM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(DWM_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Re_BufSz = Re_BufSz + 1 ! position_y - Re_BufSz = Re_BufSz + 1 ! position_z - Re_BufSz = Re_BufSz + 1 ! velocity_wake_mean - Re_BufSz = Re_BufSz + 1 ! shifted_velocity_Aerodyn - Re_BufSz = Re_BufSz + 1 ! U_velocity - Re_BufSz = Re_BufSz + 1 ! V_velocity - Int_BufSz = Int_BufSz + 1 ! Nforce allocated yes/no - IF ( ALLOCATED(InData%Nforce) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Nforce upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Nforce) ! Nforce - END IF - Int_BufSz = Int_BufSz + 1 ! blade_dr allocated yes/no - IF ( ALLOCATED(InData%blade_dr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! blade_dr upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%blade_dr) ! blade_dr - END IF - Re_BufSz = Re_BufSz + 1 ! NacYaw - Re_BufSz = Re_BufSz + 1 ! TI_original - Int_BufSz = Int_BufSz + 3 ! TAVD: size of buffers for each call to pack subtype - CALL DWM_Packturbine_average_velocity_data( Re_Buf, Db_Buf, Int_Buf, InData%TAVD, ErrStat2, ErrMsg2, .TRUE. ) ! TAVD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TAVD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TAVD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TAVD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! CalVelScale_data: size of buffers for each call to pack subtype - CALL DWM_PackCVSD( Re_Buf, Db_Buf, Int_Buf, InData%CalVelScale_data, ErrStat2, ErrMsg2, .TRUE. ) ! CalVelScale_data - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! CalVelScale_data - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! CalVelScale_data - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! CalVelScale_data - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! meandering_data: size of buffers for each call to pack subtype - CALL DWM_PackMeanderData( Re_Buf, Db_Buf, Int_Buf, InData%meandering_data, ErrStat2, ErrMsg2, .TRUE. ) ! meandering_data - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! meandering_data - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! meandering_data - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! meandering_data - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! weighting_method: size of buffers for each call to pack subtype - CALL DWM_PackWeiMethod( Re_Buf, Db_Buf, Int_Buf, InData%weighting_method, ErrStat2, ErrMsg2, .TRUE. ) ! weighting_method - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! weighting_method - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! weighting_method - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! weighting_method - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! TI_downstream_data: size of buffers for each call to pack subtype - CALL DWM_PackTIDownstream( Re_Buf, Db_Buf, Int_Buf, InData%TI_downstream_data, ErrStat2, ErrMsg2, .TRUE. ) ! TI_downstream_data - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TI_downstream_data - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TI_downstream_data - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TI_downstream_data - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Turbulence_KS: size of buffers for each call to pack subtype - CALL DWM_PackTurbKaimal( Re_Buf, Db_Buf, Int_Buf, InData%Turbulence_KS, ErrStat2, ErrMsg2, .TRUE. ) ! Turbulence_KS - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Turbulence_KS - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Turbulence_KS - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Turbulence_KS - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! shinozuka_data: size of buffers for each call to pack subtype - CALL DWM_PackShinozuka( Re_Buf, Db_Buf, Int_Buf, InData%shinozuka_data, ErrStat2, ErrMsg2, .TRUE. ) ! shinozuka_data - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! shinozuka_data - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! shinozuka_data - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! shinozuka_data - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SmoothOut: size of buffers for each call to pack subtype - CALL DWM_Packsmooth_out_wake_data( Re_Buf, Db_Buf, Int_Buf, InData%SmoothOut, ErrStat2, ErrMsg2, .TRUE. ) ! SmoothOut - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SmoothOut - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SmoothOut - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SmoothOut - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! smooth_wake_shifted_velocity_data: size of buffers for each call to pack subtype - CALL DWM_PackSWSV( Re_Buf, Db_Buf, Int_Buf, InData%smooth_wake_shifted_velocity_data, ErrStat2, ErrMsg2, .TRUE. ) ! smooth_wake_shifted_velocity_data - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! smooth_wake_shifted_velocity_data - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! smooth_wake_shifted_velocity_data - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! smooth_wake_shifted_velocity_data - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! DWDD: size of buffers for each call to pack subtype - CALL DWM_PackWake_Deficit_Data( Re_Buf, Db_Buf, Int_Buf, InData%DWDD, ErrStat2, ErrMsg2, .TRUE. ) ! DWDD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DWDD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DWDD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DWDD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Re_BufSz = Re_BufSz + 1 ! ct_tilde - Re_BufSz = Re_BufSz + 1 ! FAST_Time - Int_BufSz = Int_BufSz + 1 ! SDtimestep - Int_BufSz = Int_BufSz + 3 ! DWM_tb: size of buffers for each call to pack subtype - CALL DWM_Packturbine_blade( Re_Buf, Db_Buf, Int_Buf, InData%DWM_tb, ErrStat2, ErrMsg2, .TRUE. ) ! DWM_tb - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DWM_tb - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DWM_tb - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DWM_tb - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! WMC: size of buffers for each call to pack subtype - CALL DWM_Packwake_meandered_center( Re_Buf, Db_Buf, Int_Buf, InData%WMC, ErrStat2, ErrMsg2, .TRUE. ) ! WMC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WMC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WMC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WMC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL InflowWind_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - ReKiBuf(Re_Xferred) = InData%position_y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%position_z - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%velocity_wake_mean - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%shifted_velocity_Aerodyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%U_velocity - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%V_velocity - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Nforce) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Nforce,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nforce,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Nforce,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nforce,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Nforce,2), UBOUND(InData%Nforce,2) - DO i1 = LBOUND(InData%Nforce,1), UBOUND(InData%Nforce,1) - ReKiBuf(Re_Xferred) = InData%Nforce(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%blade_dr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%blade_dr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%blade_dr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%blade_dr,1), UBOUND(InData%blade_dr,1) - ReKiBuf(Re_Xferred) = InData%blade_dr(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%NacYaw - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TI_original - Re_Xferred = Re_Xferred + 1 - CALL DWM_Packturbine_average_velocity_data( Re_Buf, Db_Buf, Int_Buf, InData%TAVD, ErrStat2, ErrMsg2, OnlySize ) ! TAVD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL DWM_PackCVSD( Re_Buf, Db_Buf, Int_Buf, InData%CalVelScale_data, ErrStat2, ErrMsg2, OnlySize ) ! CalVelScale_data - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL DWM_PackMeanderData( Re_Buf, Db_Buf, Int_Buf, InData%meandering_data, ErrStat2, ErrMsg2, OnlySize ) ! meandering_data - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL DWM_PackWeiMethod( Re_Buf, Db_Buf, Int_Buf, InData%weighting_method, ErrStat2, ErrMsg2, OnlySize ) ! weighting_method - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL DWM_PackTIDownstream( Re_Buf, Db_Buf, Int_Buf, InData%TI_downstream_data, ErrStat2, ErrMsg2, OnlySize ) ! TI_downstream_data - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL DWM_PackTurbKaimal( Re_Buf, Db_Buf, Int_Buf, InData%Turbulence_KS, ErrStat2, ErrMsg2, OnlySize ) ! Turbulence_KS - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL DWM_PackShinozuka( Re_Buf, Db_Buf, Int_Buf, InData%shinozuka_data, ErrStat2, ErrMsg2, OnlySize ) ! shinozuka_data - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL DWM_Packsmooth_out_wake_data( Re_Buf, Db_Buf, Int_Buf, InData%SmoothOut, ErrStat2, ErrMsg2, OnlySize ) ! SmoothOut - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL DWM_PackSWSV( Re_Buf, Db_Buf, Int_Buf, InData%smooth_wake_shifted_velocity_data, ErrStat2, ErrMsg2, OnlySize ) ! smooth_wake_shifted_velocity_data - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL DWM_PackWake_Deficit_Data( Re_Buf, Db_Buf, Int_Buf, InData%DWDD, ErrStat2, ErrMsg2, OnlySize ) ! DWDD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - ReKiBuf(Re_Xferred) = InData%ct_tilde - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FAST_Time - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%SDtimestep - Int_Xferred = Int_Xferred + 1 - CALL DWM_Packturbine_blade( Re_Buf, Db_Buf, Int_Buf, InData%DWM_tb, ErrStat2, ErrMsg2, OnlySize ) ! DWM_tb - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL DWM_Packwake_meandered_center( Re_Buf, Db_Buf, Int_Buf, InData%WMC, ErrStat2, ErrMsg2, OnlySize ) ! WMC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE DWM_PackMisc - - SUBROUTINE DWM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(DWM_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%IfW, ErrStat2, ErrMsg2 ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%position_y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%position_z = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%velocity_wake_mean = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%shifted_velocity_Aerodyn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%U_velocity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%V_velocity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Nforce not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Nforce)) DEALLOCATE(OutData%Nforce) - ALLOCATE(OutData%Nforce(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nforce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Nforce,2), UBOUND(OutData%Nforce,2) - DO i1 = LBOUND(OutData%Nforce,1), UBOUND(OutData%Nforce,1) - OutData%Nforce(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! blade_dr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%blade_dr)) DEALLOCATE(OutData%blade_dr) - ALLOCATE(OutData%blade_dr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%blade_dr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%blade_dr,1), UBOUND(OutData%blade_dr,1) - OutData%blade_dr(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%NacYaw = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TI_original = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL DWM_Unpackturbine_average_velocity_data( Re_Buf, Db_Buf, Int_Buf, OutData%TAVD, ErrStat2, ErrMsg2 ) ! TAVD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL DWM_UnpackCVSD( Re_Buf, Db_Buf, Int_Buf, OutData%CalVelScale_data, ErrStat2, ErrMsg2 ) ! CalVelScale_data - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL DWM_UnpackMeanderData( Re_Buf, Db_Buf, Int_Buf, OutData%meandering_data, ErrStat2, ErrMsg2 ) ! meandering_data - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL DWM_UnpackWeiMethod( Re_Buf, Db_Buf, Int_Buf, OutData%weighting_method, ErrStat2, ErrMsg2 ) ! weighting_method - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL DWM_UnpackTIDownstream( Re_Buf, Db_Buf, Int_Buf, OutData%TI_downstream_data, ErrStat2, ErrMsg2 ) ! TI_downstream_data - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL DWM_UnpackTurbKaimal( Re_Buf, Db_Buf, Int_Buf, OutData%Turbulence_KS, ErrStat2, ErrMsg2 ) ! Turbulence_KS - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL DWM_UnpackShinozuka( Re_Buf, Db_Buf, Int_Buf, OutData%shinozuka_data, ErrStat2, ErrMsg2 ) ! shinozuka_data - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL DWM_Unpacksmooth_out_wake_data( Re_Buf, Db_Buf, Int_Buf, OutData%SmoothOut, ErrStat2, ErrMsg2 ) ! SmoothOut - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL DWM_UnpackSWSV( Re_Buf, Db_Buf, Int_Buf, OutData%smooth_wake_shifted_velocity_data, ErrStat2, ErrMsg2 ) ! smooth_wake_shifted_velocity_data - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL DWM_UnpackWake_Deficit_Data( Re_Buf, Db_Buf, Int_Buf, OutData%DWDD, ErrStat2, ErrMsg2 ) ! DWDD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%ct_tilde = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%FAST_Time = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SDtimestep = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL DWM_Unpackturbine_blade( Re_Buf, Db_Buf, Int_Buf, OutData%DWM_tb, ErrStat2, ErrMsg2 ) ! DWM_tb - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL DWM_Unpackwake_meandered_center( Re_Buf, Db_Buf, Int_Buf, OutData%WMC, ErrStat2, ErrMsg2 ) ! WMC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE DWM_UnPackMisc +subroutine DWM_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DWM_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + ! IfW + call InflowWind_PackMisc(Buf, InData%IfW) + if (RegCheckErr(Buf, RoutineName)) return + ! position_y + call RegPack(Buf, InData%position_y) + if (RegCheckErr(Buf, RoutineName)) return + ! position_z + call RegPack(Buf, InData%position_z) + if (RegCheckErr(Buf, RoutineName)) return + ! velocity_wake_mean + call RegPack(Buf, InData%velocity_wake_mean) + if (RegCheckErr(Buf, RoutineName)) return + ! shifted_velocity_Aerodyn + call RegPack(Buf, InData%shifted_velocity_Aerodyn) + if (RegCheckErr(Buf, RoutineName)) return + ! U_velocity + call RegPack(Buf, InData%U_velocity) + if (RegCheckErr(Buf, RoutineName)) return + ! V_velocity + call RegPack(Buf, InData%V_velocity) + if (RegCheckErr(Buf, RoutineName)) return + ! Nforce + call RegPack(Buf, allocated(InData%Nforce)) + if (allocated(InData%Nforce)) then + call RegPackBounds(Buf, 2, lbound(InData%Nforce), ubound(InData%Nforce)) + call RegPack(Buf, InData%Nforce) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! blade_dr + call RegPack(Buf, allocated(InData%blade_dr)) + if (allocated(InData%blade_dr)) then + call RegPackBounds(Buf, 1, lbound(InData%blade_dr), ubound(InData%blade_dr)) + call RegPack(Buf, InData%blade_dr) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NacYaw + call RegPack(Buf, InData%NacYaw) + if (RegCheckErr(Buf, RoutineName)) return + ! TI_original + call RegPack(Buf, InData%TI_original) + if (RegCheckErr(Buf, RoutineName)) return + ! TAVD + call DWM_Packturbine_average_velocity_data(Buf, InData%TAVD) + if (RegCheckErr(Buf, RoutineName)) return + ! CalVelScale_data + call DWM_PackCVSD(Buf, InData%CalVelScale_data) + if (RegCheckErr(Buf, RoutineName)) return + ! meandering_data + call DWM_PackMeanderData(Buf, InData%meandering_data) + if (RegCheckErr(Buf, RoutineName)) return + ! weighting_method + call DWM_PackWeiMethod(Buf, InData%weighting_method) + if (RegCheckErr(Buf, RoutineName)) return + ! TI_downstream_data + call DWM_PackTIDownstream(Buf, InData%TI_downstream_data) + if (RegCheckErr(Buf, RoutineName)) return + ! Turbulence_KS + call DWM_PackTurbKaimal(Buf, InData%Turbulence_KS) + if (RegCheckErr(Buf, RoutineName)) return + ! shinozuka_data + call DWM_PackShinozuka(Buf, InData%shinozuka_data) + if (RegCheckErr(Buf, RoutineName)) return + ! SmoothOut + call DWM_Packsmooth_out_wake_data(Buf, InData%SmoothOut) + if (RegCheckErr(Buf, RoutineName)) return + ! smooth_wake_shifted_velocity_data + call DWM_PackSWSV(Buf, InData%smooth_wake_shifted_velocity_data) + if (RegCheckErr(Buf, RoutineName)) return + ! DWDD + call DWM_PackWake_Deficit_Data(Buf, InData%DWDD) + if (RegCheckErr(Buf, RoutineName)) return + ! ct_tilde + call RegPack(Buf, InData%ct_tilde) + if (RegCheckErr(Buf, RoutineName)) return + ! FAST_Time + call RegPack(Buf, InData%FAST_Time) + if (RegCheckErr(Buf, RoutineName)) return + ! SDtimestep + call RegPack(Buf, InData%SDtimestep) + if (RegCheckErr(Buf, RoutineName)) return + ! DWM_tb + call DWM_Packturbine_blade(Buf, InData%DWM_tb) + if (RegCheckErr(Buf, RoutineName)) return + ! WMC + call DWM_Packwake_meandered_center(Buf, InData%WMC) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DWM_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPackMisc' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! IfW + call InflowWind_UnpackMisc(Buf, OutData%IfW) ! IfW + ! position_y + call RegUnpack(Buf, OutData%position_y) + if (RegCheckErr(Buf, RoutineName)) return + ! position_z + call RegUnpack(Buf, OutData%position_z) + if (RegCheckErr(Buf, RoutineName)) return + ! velocity_wake_mean + call RegUnpack(Buf, OutData%velocity_wake_mean) + if (RegCheckErr(Buf, RoutineName)) return + ! shifted_velocity_Aerodyn + call RegUnpack(Buf, OutData%shifted_velocity_Aerodyn) + if (RegCheckErr(Buf, RoutineName)) return + ! U_velocity + call RegUnpack(Buf, OutData%U_velocity) + if (RegCheckErr(Buf, RoutineName)) return + ! V_velocity + call RegUnpack(Buf, OutData%V_velocity) + if (RegCheckErr(Buf, RoutineName)) return + ! Nforce + if (allocated(OutData%Nforce)) deallocate(OutData%Nforce) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Nforce(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nforce.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Nforce) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! blade_dr + if (allocated(OutData%blade_dr)) deallocate(OutData%blade_dr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%blade_dr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%blade_dr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%blade_dr) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NacYaw + call RegUnpack(Buf, OutData%NacYaw) + if (RegCheckErr(Buf, RoutineName)) return + ! TI_original + call RegUnpack(Buf, OutData%TI_original) + if (RegCheckErr(Buf, RoutineName)) return + ! TAVD + call DWM_Unpackturbine_average_velocity_data(Buf, OutData%TAVD) ! TAVD + ! CalVelScale_data + call DWM_UnpackCVSD(Buf, OutData%CalVelScale_data) ! CalVelScale_data + ! meandering_data + call DWM_UnpackMeanderData(Buf, OutData%meandering_data) ! meandering_data + ! weighting_method + call DWM_UnpackWeiMethod(Buf, OutData%weighting_method) ! weighting_method + ! TI_downstream_data + call DWM_UnpackTIDownstream(Buf, OutData%TI_downstream_data) ! TI_downstream_data + ! Turbulence_KS + call DWM_UnpackTurbKaimal(Buf, OutData%Turbulence_KS) ! Turbulence_KS + ! shinozuka_data + call DWM_UnpackShinozuka(Buf, OutData%shinozuka_data) ! shinozuka_data + ! SmoothOut + call DWM_Unpacksmooth_out_wake_data(Buf, OutData%SmoothOut) ! SmoothOut + ! smooth_wake_shifted_velocity_data + call DWM_UnpackSWSV(Buf, OutData%smooth_wake_shifted_velocity_data) ! smooth_wake_shifted_velocity_data + ! DWDD + call DWM_UnpackWake_Deficit_Data(Buf, OutData%DWDD) ! DWDD + ! ct_tilde + call RegUnpack(Buf, OutData%ct_tilde) + if (RegCheckErr(Buf, RoutineName)) return + ! FAST_Time + call RegUnpack(Buf, OutData%FAST_Time) + if (RegCheckErr(Buf, RoutineName)) return + ! SDtimestep + call RegUnpack(Buf, OutData%SDtimestep) + if (RegCheckErr(Buf, RoutineName)) return + ! DWM_tb + call DWM_Unpackturbine_blade(Buf, OutData%DWM_tb) ! DWM_tb + ! WMC + call DWM_Unpackwake_meandered_center(Buf, OutData%WMC) ! WMC +end subroutine SUBROUTINE DWM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(DWM_InputType), INTENT(IN) :: SrcInputData TYPE(DWM_InputType), INTENT(INOUT) :: DstInputData @@ -7181,269 +3801,30 @@ SUBROUTINE DWM_DestroyInput( InputData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE DWM_DestroyInput - SUBROUTINE DWM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(DWM_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Upwind_result: size of buffers for each call to pack subtype - CALL DWM_Packread_upwind_result( Re_Buf, Db_Buf, Int_Buf, InData%Upwind_result, ErrStat2, ErrMsg2, .TRUE. ) ! Upwind_result - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Upwind_result - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Upwind_result - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Upwind_result - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL DWM_Packread_upwind_result( Re_Buf, Db_Buf, Int_Buf, InData%Upwind_result, ErrStat2, ErrMsg2, OnlySize ) ! Upwind_result - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE DWM_PackInput - - SUBROUTINE DWM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(DWM_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL DWM_Unpackread_upwind_result( Re_Buf, Db_Buf, Int_Buf, OutData%Upwind_result, ErrStat2, ErrMsg2 ) ! Upwind_result - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%IfW, ErrStat2, ErrMsg2 ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE DWM_UnPackInput +subroutine DWM_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DWM_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + ! Upwind_result + call DWM_Packread_upwind_result(Buf, InData%Upwind_result) + if (RegCheckErr(Buf, RoutineName)) return + ! IfW + call InflowWind_PackInput(Buf, InData%IfW) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DWM_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPackInput' + if (Buf%ErrStat /= ErrID_None) return + ! Upwind_result + call DWM_Unpackread_upwind_result(Buf, OutData%Upwind_result) ! Upwind_result + ! IfW + call InflowWind_UnpackInput(Buf, OutData%IfW) ! IfW +end subroutine SUBROUTINE DWM_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(DWM_OutputType), INTENT(IN) :: SrcOutputData TYPE(DWM_OutputType), INTENT(INOUT) :: DstOutputData @@ -7619,571 +4000,252 @@ SUBROUTINE DWM_DestroyOutput( OutputData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE DWM_DestroyOutput - SUBROUTINE DWM_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(DWM_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! turbine_thrust_force allocated yes/no - IF ( ALLOCATED(InData%turbine_thrust_force) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! turbine_thrust_force upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%turbine_thrust_force) ! turbine_thrust_force - END IF - Int_BufSz = Int_BufSz + 1 ! induction_factor allocated yes/no - IF ( ALLOCATED(InData%induction_factor) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! induction_factor upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%induction_factor) ! induction_factor - END IF - Int_BufSz = Int_BufSz + 1 ! r_initial allocated yes/no - IF ( ALLOCATED(InData%r_initial) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! r_initial upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%r_initial) ! r_initial - END IF - Int_BufSz = Int_BufSz + 1 ! U_initial allocated yes/no - IF ( ALLOCATED(InData%U_initial) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! U_initial upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%U_initial) ! U_initial - END IF - Int_BufSz = Int_BufSz + 1 ! Mean_FFWS_array allocated yes/no - IF ( ALLOCATED(InData%Mean_FFWS_array) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Mean_FFWS_array upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Mean_FFWS_array) ! Mean_FFWS_array - END IF - Re_BufSz = Re_BufSz + 1 ! Mean_FFWS - Re_BufSz = Re_BufSz + 1 ! TI - Re_BufSz = Re_BufSz + 1 ! TI_downstream - Int_BufSz = Int_BufSz + 1 ! wake_u allocated yes/no - IF ( ALLOCATED(InData%wake_u) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! wake_u upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%wake_u) ! wake_u - END IF - Int_BufSz = Int_BufSz + 1 ! wake_position allocated yes/no - IF ( ALLOCATED(InData%wake_position) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! wake_position upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%wake_position) ! wake_position - END IF - Int_BufSz = Int_BufSz + 1 ! smoothed_velocity_array allocated yes/no - IF ( ALLOCATED(InData%smoothed_velocity_array) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! smoothed_velocity_array upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%smoothed_velocity_array) ! smoothed_velocity_array - END IF - Re_BufSz = Re_BufSz + 1 ! AtmUscale - Re_BufSz = Re_BufSz + 1 ! du_dz_ABL - Re_BufSz = Re_BufSz + 1 ! total_SDgenpwr - Re_BufSz = Re_BufSz + 1 ! mean_SDgenpwr - Re_BufSz = Re_BufSz + 1 ! avg_ct - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%turbine_thrust_force) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%turbine_thrust_force,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%turbine_thrust_force,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%turbine_thrust_force,1), UBOUND(InData%turbine_thrust_force,1) - ReKiBuf(Re_Xferred) = InData%turbine_thrust_force(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%induction_factor) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%induction_factor,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%induction_factor,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%induction_factor,1), UBOUND(InData%induction_factor,1) - ReKiBuf(Re_Xferred) = InData%induction_factor(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%r_initial) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r_initial,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_initial,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%r_initial,1), UBOUND(InData%r_initial,1) - ReKiBuf(Re_Xferred) = InData%r_initial(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%U_initial) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%U_initial,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U_initial,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%U_initial,1), UBOUND(InData%U_initial,1) - ReKiBuf(Re_Xferred) = InData%U_initial(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Mean_FFWS_array) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Mean_FFWS_array,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mean_FFWS_array,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Mean_FFWS_array,1), UBOUND(InData%Mean_FFWS_array,1) - ReKiBuf(Re_Xferred) = InData%Mean_FFWS_array(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%Mean_FFWS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TI - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TI_downstream - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%wake_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%wake_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%wake_u,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%wake_u,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%wake_u,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%wake_u,2), UBOUND(InData%wake_u,2) - DO i1 = LBOUND(InData%wake_u,1), UBOUND(InData%wake_u,1) - ReKiBuf(Re_Xferred) = InData%wake_u(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%wake_position) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%wake_position,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%wake_position,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%wake_position,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%wake_position,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%wake_position,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%wake_position,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%wake_position,3), UBOUND(InData%wake_position,3) - DO i2 = LBOUND(InData%wake_position,2), UBOUND(InData%wake_position,2) - DO i1 = LBOUND(InData%wake_position,1), UBOUND(InData%wake_position,1) - ReKiBuf(Re_Xferred) = InData%wake_position(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%smoothed_velocity_array) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%smoothed_velocity_array,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%smoothed_velocity_array,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%smoothed_velocity_array,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%smoothed_velocity_array,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%smoothed_velocity_array,2), UBOUND(InData%smoothed_velocity_array,2) - DO i1 = LBOUND(InData%smoothed_velocity_array,1), UBOUND(InData%smoothed_velocity_array,1) - ReKiBuf(Re_Xferred) = InData%smoothed_velocity_array(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%AtmUscale - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%du_dz_ABL - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%total_SDgenpwr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%mean_SDgenpwr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%avg_ct - Re_Xferred = Re_Xferred + 1 - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE DWM_PackOutput - - SUBROUTINE DWM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(DWM_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! turbine_thrust_force not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%turbine_thrust_force)) DEALLOCATE(OutData%turbine_thrust_force) - ALLOCATE(OutData%turbine_thrust_force(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%turbine_thrust_force.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%turbine_thrust_force,1), UBOUND(OutData%turbine_thrust_force,1) - OutData%turbine_thrust_force(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! induction_factor not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%induction_factor)) DEALLOCATE(OutData%induction_factor) - ALLOCATE(OutData%induction_factor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%induction_factor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%induction_factor,1), UBOUND(OutData%induction_factor,1) - OutData%induction_factor(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r_initial not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%r_initial)) DEALLOCATE(OutData%r_initial) - ALLOCATE(OutData%r_initial(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_initial.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%r_initial,1), UBOUND(OutData%r_initial,1) - OutData%r_initial(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! U_initial not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%U_initial)) DEALLOCATE(OutData%U_initial) - ALLOCATE(OutData%U_initial(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_initial.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%U_initial,1), UBOUND(OutData%U_initial,1) - OutData%U_initial(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Mean_FFWS_array not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Mean_FFWS_array)) DEALLOCATE(OutData%Mean_FFWS_array) - ALLOCATE(OutData%Mean_FFWS_array(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mean_FFWS_array.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Mean_FFWS_array,1), UBOUND(OutData%Mean_FFWS_array,1) - OutData%Mean_FFWS_array(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Mean_FFWS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TI = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TI_downstream = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! wake_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%wake_u)) DEALLOCATE(OutData%wake_u) - ALLOCATE(OutData%wake_u(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%wake_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%wake_u,2), UBOUND(OutData%wake_u,2) - DO i1 = LBOUND(OutData%wake_u,1), UBOUND(OutData%wake_u,1) - OutData%wake_u(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! wake_position not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%wake_position)) DEALLOCATE(OutData%wake_position) - ALLOCATE(OutData%wake_position(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%wake_position.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%wake_position,3), UBOUND(OutData%wake_position,3) - DO i2 = LBOUND(OutData%wake_position,2), UBOUND(OutData%wake_position,2) - DO i1 = LBOUND(OutData%wake_position,1), UBOUND(OutData%wake_position,1) - OutData%wake_position(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! smoothed_velocity_array not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%smoothed_velocity_array)) DEALLOCATE(OutData%smoothed_velocity_array) - ALLOCATE(OutData%smoothed_velocity_array(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%smoothed_velocity_array.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%smoothed_velocity_array,2), UBOUND(OutData%smoothed_velocity_array,2) - DO i1 = LBOUND(OutData%smoothed_velocity_array,1), UBOUND(OutData%smoothed_velocity_array,1) - OutData%smoothed_velocity_array(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%AtmUscale = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%du_dz_ABL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%total_SDgenpwr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%mean_SDgenpwr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%avg_ct = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%IfW, ErrStat2, ErrMsg2 ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE DWM_UnPackOutput +subroutine DWM_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DWM_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! turbine_thrust_force + call RegPack(Buf, allocated(InData%turbine_thrust_force)) + if (allocated(InData%turbine_thrust_force)) then + call RegPackBounds(Buf, 1, lbound(InData%turbine_thrust_force), ubound(InData%turbine_thrust_force)) + call RegPack(Buf, InData%turbine_thrust_force) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! induction_factor + call RegPack(Buf, allocated(InData%induction_factor)) + if (allocated(InData%induction_factor)) then + call RegPackBounds(Buf, 1, lbound(InData%induction_factor), ubound(InData%induction_factor)) + call RegPack(Buf, InData%induction_factor) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! r_initial + call RegPack(Buf, allocated(InData%r_initial)) + if (allocated(InData%r_initial)) then + call RegPackBounds(Buf, 1, lbound(InData%r_initial), ubound(InData%r_initial)) + call RegPack(Buf, InData%r_initial) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! U_initial + call RegPack(Buf, allocated(InData%U_initial)) + if (allocated(InData%U_initial)) then + call RegPackBounds(Buf, 1, lbound(InData%U_initial), ubound(InData%U_initial)) + call RegPack(Buf, InData%U_initial) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Mean_FFWS_array + call RegPack(Buf, allocated(InData%Mean_FFWS_array)) + if (allocated(InData%Mean_FFWS_array)) then + call RegPackBounds(Buf, 1, lbound(InData%Mean_FFWS_array), ubound(InData%Mean_FFWS_array)) + call RegPack(Buf, InData%Mean_FFWS_array) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Mean_FFWS + call RegPack(Buf, InData%Mean_FFWS) + if (RegCheckErr(Buf, RoutineName)) return + ! TI + call RegPack(Buf, InData%TI) + if (RegCheckErr(Buf, RoutineName)) return + ! TI_downstream + call RegPack(Buf, InData%TI_downstream) + if (RegCheckErr(Buf, RoutineName)) return + ! wake_u + call RegPack(Buf, allocated(InData%wake_u)) + if (allocated(InData%wake_u)) then + call RegPackBounds(Buf, 2, lbound(InData%wake_u), ubound(InData%wake_u)) + call RegPack(Buf, InData%wake_u) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! wake_position + call RegPack(Buf, allocated(InData%wake_position)) + if (allocated(InData%wake_position)) then + call RegPackBounds(Buf, 3, lbound(InData%wake_position), ubound(InData%wake_position)) + call RegPack(Buf, InData%wake_position) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! smoothed_velocity_array + call RegPack(Buf, allocated(InData%smoothed_velocity_array)) + if (allocated(InData%smoothed_velocity_array)) then + call RegPackBounds(Buf, 2, lbound(InData%smoothed_velocity_array), ubound(InData%smoothed_velocity_array)) + call RegPack(Buf, InData%smoothed_velocity_array) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AtmUscale + call RegPack(Buf, InData%AtmUscale) + if (RegCheckErr(Buf, RoutineName)) return + ! du_dz_ABL + call RegPack(Buf, InData%du_dz_ABL) + if (RegCheckErr(Buf, RoutineName)) return + ! total_SDgenpwr + call RegPack(Buf, InData%total_SDgenpwr) + if (RegCheckErr(Buf, RoutineName)) return + ! mean_SDgenpwr + call RegPack(Buf, InData%mean_SDgenpwr) + if (RegCheckErr(Buf, RoutineName)) return + ! avg_ct + call RegPack(Buf, InData%avg_ct) + if (RegCheckErr(Buf, RoutineName)) return + ! IfW + call InflowWind_PackOutput(Buf, InData%IfW) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DWM_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPackOutput' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! turbine_thrust_force + if (allocated(OutData%turbine_thrust_force)) deallocate(OutData%turbine_thrust_force) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%turbine_thrust_force(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%turbine_thrust_force.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%turbine_thrust_force) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! induction_factor + if (allocated(OutData%induction_factor)) deallocate(OutData%induction_factor) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%induction_factor(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%induction_factor.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%induction_factor) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! r_initial + if (allocated(OutData%r_initial)) deallocate(OutData%r_initial) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%r_initial(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_initial.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%r_initial) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! U_initial + if (allocated(OutData%U_initial)) deallocate(OutData%U_initial) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%U_initial(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_initial.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%U_initial) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Mean_FFWS_array + if (allocated(OutData%Mean_FFWS_array)) deallocate(OutData%Mean_FFWS_array) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Mean_FFWS_array(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mean_FFWS_array.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Mean_FFWS_array) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Mean_FFWS + call RegUnpack(Buf, OutData%Mean_FFWS) + if (RegCheckErr(Buf, RoutineName)) return + ! TI + call RegUnpack(Buf, OutData%TI) + if (RegCheckErr(Buf, RoutineName)) return + ! TI_downstream + call RegUnpack(Buf, OutData%TI_downstream) + if (RegCheckErr(Buf, RoutineName)) return + ! wake_u + if (allocated(OutData%wake_u)) deallocate(OutData%wake_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%wake_u(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%wake_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%wake_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! wake_position + if (allocated(OutData%wake_position)) deallocate(OutData%wake_position) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%wake_position(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%wake_position.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%wake_position) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! smoothed_velocity_array + if (allocated(OutData%smoothed_velocity_array)) deallocate(OutData%smoothed_velocity_array) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%smoothed_velocity_array(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%smoothed_velocity_array.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%smoothed_velocity_array) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AtmUscale + call RegUnpack(Buf, OutData%AtmUscale) + if (RegCheckErr(Buf, RoutineName)) return + ! du_dz_ABL + call RegUnpack(Buf, OutData%du_dz_ABL) + if (RegCheckErr(Buf, RoutineName)) return + ! total_SDgenpwr + call RegUnpack(Buf, OutData%total_SDgenpwr) + if (RegCheckErr(Buf, RoutineName)) return + ! mean_SDgenpwr + call RegUnpack(Buf, OutData%mean_SDgenpwr) + if (RegCheckErr(Buf, RoutineName)) return + ! avg_ct + call RegUnpack(Buf, OutData%avg_ct) + if (RegCheckErr(Buf, RoutineName)) return + ! IfW + call InflowWind_UnpackOutput(Buf, OutData%IfW) ! IfW +end subroutine SUBROUTINE DWM_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(DWM_ContinuousStateType), INTENT(IN) :: SrcContStateData TYPE(DWM_ContinuousStateType), INTENT(INOUT) :: DstContStateData @@ -8221,189 +4283,31 @@ SUBROUTINE DWM_DestroyContState( ContStateData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE DWM_DestroyContState - SUBROUTINE DWM_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(DWM_ContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_PackContState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! dummy - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%dummy - Re_Xferred = Re_Xferred + 1 - CALL InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE DWM_PackContState - - SUBROUTINE DWM_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(DWM_ContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackContState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%dummy = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%IfW, ErrStat2, ErrMsg2 ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE DWM_UnPackContState +subroutine DWM_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DWM_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + ! dummy + call RegPack(Buf, InData%dummy) + if (RegCheckErr(Buf, RoutineName)) return + ! IfW + call InflowWind_PackContState(Buf, InData%IfW) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DWM_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPackContState' + if (Buf%ErrStat /= ErrID_None) return + ! dummy + call RegUnpack(Buf, OutData%dummy) + if (RegCheckErr(Buf, RoutineName)) return + ! IfW + call InflowWind_UnpackContState(Buf, OutData%IfW) ! IfW +end subroutine SUBROUTINE DWM_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(DWM_DiscreteStateType), INTENT(IN) :: SrcDiscStateData TYPE(DWM_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData @@ -8441,189 +4345,31 @@ SUBROUTINE DWM_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE DWM_DestroyDiscState - SUBROUTINE DWM_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(DWM_DiscreteStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_PackDiscState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! dummy - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%dummy - Re_Xferred = Re_Xferred + 1 - CALL InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE DWM_PackDiscState - - SUBROUTINE DWM_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(DWM_DiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackDiscState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%dummy = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%IfW, ErrStat2, ErrMsg2 ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE DWM_UnPackDiscState +subroutine DWM_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DWM_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + ! dummy + call RegPack(Buf, InData%dummy) + if (RegCheckErr(Buf, RoutineName)) return + ! IfW + call InflowWind_PackDiscState(Buf, InData%IfW) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DWM_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPackDiscState' + if (Buf%ErrStat /= ErrID_None) return + ! dummy + call RegUnpack(Buf, OutData%dummy) + if (RegCheckErr(Buf, RoutineName)) return + ! IfW + call InflowWind_UnpackDiscState(Buf, OutData%IfW) ! IfW +end subroutine SUBROUTINE DWM_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(DWM_ConstraintStateType), INTENT(IN) :: SrcConstrStateData TYPE(DWM_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData @@ -8661,189 +4407,31 @@ SUBROUTINE DWM_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE DWM_DestroyConstrState - SUBROUTINE DWM_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(DWM_ConstraintStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_PackConstrState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! dummy - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%dummy - Re_Xferred = Re_Xferred + 1 - CALL InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE DWM_PackConstrState - - SUBROUTINE DWM_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(DWM_ConstraintStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackConstrState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%dummy = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%IfW, ErrStat2, ErrMsg2 ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE DWM_UnPackConstrState +subroutine DWM_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DWM_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + ! dummy + call RegPack(Buf, InData%dummy) + if (RegCheckErr(Buf, RoutineName)) return + ! IfW + call InflowWind_PackConstrState(Buf, InData%IfW) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DWM_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + ! dummy + call RegUnpack(Buf, OutData%dummy) + if (RegCheckErr(Buf, RoutineName)) return + ! IfW + call InflowWind_UnpackConstrState(Buf, OutData%IfW) ! IfW +end subroutine SUBROUTINE DWM_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(DWM_InitInputType), INTENT(IN) :: SrcInitInputData TYPE(DWM_InitInputType), INTENT(INOUT) :: DstInitInputData @@ -8881,189 +4469,31 @@ SUBROUTINE DWM_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE DWM_DestroyInitInput - SUBROUTINE DWM_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(DWM_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! dummy - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%dummy - Re_Xferred = Re_Xferred + 1 - CALL InflowWind_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE DWM_PackInitInput - - SUBROUTINE DWM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(DWM_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%dummy = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%IfW, ErrStat2, ErrMsg2 ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE DWM_UnPackInitInput +subroutine DWM_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DWM_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + ! dummy + call RegPack(Buf, InData%dummy) + if (RegCheckErr(Buf, RoutineName)) return + ! IfW + call InflowWind_PackInitInput(Buf, InData%IfW) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DWM_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPackInitInput' + if (Buf%ErrStat /= ErrID_None) return + ! dummy + call RegUnpack(Buf, OutData%dummy) + if (RegCheckErr(Buf, RoutineName)) return + ! IfW + call InflowWind_UnpackInitInput(Buf, OutData%IfW) ! IfW +end subroutine SUBROUTINE DWM_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(DWM_InitOutputType), INTENT(IN) :: SrcInitOutputData TYPE(DWM_InitOutputType), INTENT(INOUT) :: DstInitOutputData @@ -9101,189 +4531,31 @@ SUBROUTINE DWM_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE DWM_DestroyInitOutput - SUBROUTINE DWM_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(DWM_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! dummy - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%dummy - Re_Xferred = Re_Xferred + 1 - CALL InflowWind_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE DWM_PackInitOutput - - SUBROUTINE DWM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(DWM_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%dummy = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%IfW, ErrStat2, ErrMsg2 ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE DWM_UnPackInitOutput +subroutine DWM_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(DWM_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'DWM_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! dummy + call RegPack(Buf, InData%dummy) + if (RegCheckErr(Buf, RoutineName)) return + ! IfW + call InflowWind_PackInitOutput(Buf, InData%IfW) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine DWM_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DWM_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'DWM_UnPackInitOutput' + if (Buf%ErrStat /= ErrID_None) return + ! dummy + call RegUnpack(Buf, OutData%dummy) + if (RegCheckErr(Buf, RoutineName)) return + ! IfW + call InflowWind_UnpackInitOutput(Buf, OutData%IfW) ! IfW +end subroutine SUBROUTINE DWM_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) ! diff --git a/modules/awae/src/AWAE_Types.f90 b/modules/awae/src/AWAE_Types.f90 index 4ca953b3b8..6e1eaf9ebb 100644 --- a/modules/awae/src/AWAE_Types.f90 +++ b/modules/awae/src/AWAE_Types.f90 @@ -306,181 +306,61 @@ SUBROUTINE AWAE_DestroyHighWindGrid( HighWindGridData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE AWAE_DestroyHighWindGrid - SUBROUTINE AWAE_PackHighWindGrid( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AWAE_HighWindGrid), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_PackHighWindGrid' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! data allocated yes/no - IF ( ASSOCIATED(InData%data) ) THEN - Int_BufSz = Int_BufSz + 2*5 ! data upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%data) ! data - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ASSOCIATED(InData%data) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%data,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%data,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%data,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%data,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%data,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%data,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%data,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%data,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%data,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%data,5) - Int_Xferred = Int_Xferred + 2 - - DO i5 = LBOUND(InData%data,5), UBOUND(InData%data,5) - DO i4 = LBOUND(InData%data,4), UBOUND(InData%data,4) - DO i3 = LBOUND(InData%data,3), UBOUND(InData%data,3) - DO i2 = LBOUND(InData%data,2), UBOUND(InData%data,2) - DO i1 = LBOUND(InData%data,1), UBOUND(InData%data,1) - ReKiBuf(Re_Xferred) = InData%data(i1,i2,i3,i4,i5) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - END SUBROUTINE AWAE_PackHighWindGrid - - SUBROUTINE AWAE_UnPackHighWindGrid( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AWAE_HighWindGrid), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_UnPackHighWindGrid' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! data not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i5_l = IntKiBuf( Int_Xferred ) - i5_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%data)) DEALLOCATE(OutData%data) - ALLOCATE(OutData%data(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%data.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i5 = LBOUND(OutData%data,5), UBOUND(OutData%data,5) - DO i4 = LBOUND(OutData%data,4), UBOUND(OutData%data,4) - DO i3 = LBOUND(OutData%data,3), UBOUND(OutData%data,3) - DO i2 = LBOUND(OutData%data,2), UBOUND(OutData%data,2) - DO i1 = LBOUND(OutData%data,1), UBOUND(OutData%data,1) - OutData%data(i1,i2,i3,i4,i5) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - END SUBROUTINE AWAE_UnPackHighWindGrid +subroutine AWAE_PackHighWindGrid(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_HighWindGrid), intent(in) :: InData + character(*), parameter :: RoutineName = 'AWAE_PackHighWindGrid' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + ! data + call RegPack(Buf, associated(InData%data)) + if (associated(InData%data)) then + call RegPackBounds(Buf, 5, lbound(InData%data), ubound(InData%data)) + call RegPackPointer(Buf, c_loc(InData%data), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%data) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AWAE_UnPackHighWindGrid(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_HighWindGrid), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AWAE_UnPackHighWindGrid' + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + ! data + if (associated(OutData%data)) deallocate(OutData%data) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%data, UB(1:5)-LB(1:5)) + OutData%data(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => OutData%data + else + allocate(OutData%data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%data.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%data) + call RegUnpack(Buf, OutData%data) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%data => null() + end if +end subroutine SUBROUTINE AWAE_CopyHighWindGridPtr( SrcHighWindGridPtrData, DstHighWindGridPtrData, CtrlCode, ErrStat, ErrMsg ) TYPE(AWAE_HighWindGridPtr), INTENT(IN) :: SrcHighWindGridPtrData TYPE(AWAE_HighWindGridPtr), INTENT(INOUT) :: DstHighWindGridPtrData @@ -519,104 +399,61 @@ SUBROUTINE AWAE_DestroyHighWindGridPtr( HighWindGridPtrData, ErrStat, ErrMsg ) NULLIFY(HighWindGridPtrData%data) END SUBROUTINE AWAE_DestroyHighWindGridPtr - SUBROUTINE AWAE_PackHighWindGridPtr( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AWAE_HighWindGridPtr), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_PackHighWindGridPtr' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - END SUBROUTINE AWAE_PackHighWindGridPtr - - SUBROUTINE AWAE_UnPackHighWindGridPtr( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AWAE_HighWindGridPtr), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_UnPackHighWindGridPtr' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - NULLIFY(OutData%data) - END SUBROUTINE AWAE_UnPackHighWindGridPtr +subroutine AWAE_PackHighWindGridPtr(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_HighWindGridPtr), intent(in) :: InData + character(*), parameter :: RoutineName = 'AWAE_PackHighWindGridPtr' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + ! data + call RegPack(Buf, associated(InData%data)) + if (associated(InData%data)) then + call RegPackBounds(Buf, 5, lbound(InData%data), ubound(InData%data)) + call RegPackPointer(Buf, c_loc(InData%data), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%data) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AWAE_UnPackHighWindGridPtr(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_HighWindGridPtr), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AWAE_UnPackHighWindGridPtr' + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + ! data + if (associated(OutData%data)) deallocate(OutData%data) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%data, UB(1:5)-LB(1:5)) + OutData%data(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => OutData%data + else + allocate(OutData%data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%data.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%data) + call RegUnpack(Buf, OutData%data) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%data => null() + end if +end subroutine SUBROUTINE AWAE_CopyInputFileType( SrcInputFileTypeData, DstInputFileTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(AWAE_InputFileType), INTENT(IN) :: SrcInputFileTypeData TYPE(AWAE_InputFileType), INTENT(INOUT) :: DstInputFileTypeData @@ -832,648 +669,423 @@ SUBROUTINE AWAE_DestroyInputFileType( InputFileTypeData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE AWAE_DestroyInputFileType - SUBROUTINE AWAE_PackInputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AWAE_InputFileType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_PackInputFileType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! dr - Db_BufSz = Db_BufSz + 1 ! dt_low - Int_BufSz = Int_BufSz + 1 ! NumTurbines - Int_BufSz = Int_BufSz + 1 ! NumRadii - Int_BufSz = Int_BufSz + 1 ! NumPlanes - Int_BufSz = Int_BufSz + 1*LEN(InData%WindFilePath) ! WindFilePath - Int_BufSz = Int_BufSz + 1 ! WrDisWind - Int_BufSz = Int_BufSz + 1 ! NOutDisWindXY - Int_BufSz = Int_BufSz + 1 ! OutDisWindZ allocated yes/no - IF ( ALLOCATED(InData%OutDisWindZ) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutDisWindZ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OutDisWindZ) ! OutDisWindZ - END IF - Int_BufSz = Int_BufSz + 1 ! NOutDisWindYZ - Int_BufSz = Int_BufSz + 1 ! OutDisWindX allocated yes/no - IF ( ALLOCATED(InData%OutDisWindX) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutDisWindX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OutDisWindX) ! OutDisWindX - END IF - Int_BufSz = Int_BufSz + 1 ! NOutDisWindXZ - Int_BufSz = Int_BufSz + 1 ! OutDisWindY allocated yes/no - IF ( ALLOCATED(InData%OutDisWindY) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutDisWindY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OutDisWindY) ! OutDisWindY - END IF - Db_BufSz = Db_BufSz + 1 ! WrDisDT - Int_BufSz = Int_BufSz + 1 ! ChkWndFiles - Int_BufSz = Int_BufSz + 1 ! Mod_Meander - Re_BufSz = Re_BufSz + 1 ! C_Meander - Int_BufSz = Int_BufSz + 1 ! Mod_AmbWind - Int_BufSz = Int_BufSz + 1*LEN(InData%InflowFile) ! InflowFile - Db_BufSz = Db_BufSz + 1 ! dt_high - Int_BufSz = Int_BufSz + 1 ! X0_high allocated yes/no - IF ( ALLOCATED(InData%X0_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! X0_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%X0_high) ! X0_high - END IF - Int_BufSz = Int_BufSz + 1 ! Y0_high allocated yes/no - IF ( ALLOCATED(InData%Y0_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Y0_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Y0_high) ! Y0_high - END IF - Int_BufSz = Int_BufSz + 1 ! Z0_high allocated yes/no - IF ( ALLOCATED(InData%Z0_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Z0_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Z0_high) ! Z0_high - END IF - Int_BufSz = Int_BufSz + 1 ! dX_high allocated yes/no - IF ( ALLOCATED(InData%dX_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dX_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dX_high) ! dX_high - END IF - Int_BufSz = Int_BufSz + 1 ! dY_high allocated yes/no - IF ( ALLOCATED(InData%dY_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dY_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dY_high) ! dY_high - END IF - Int_BufSz = Int_BufSz + 1 ! dZ_high allocated yes/no - IF ( ALLOCATED(InData%dZ_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dZ_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dZ_high) ! dZ_high - END IF - Int_BufSz = Int_BufSz + 1 ! nX_high - Int_BufSz = Int_BufSz + 1 ! nY_high - Int_BufSz = Int_BufSz + 1 ! nZ_high - Re_BufSz = Re_BufSz + 1 ! dX_low - Re_BufSz = Re_BufSz + 1 ! dY_low - Re_BufSz = Re_BufSz + 1 ! dZ_low - Int_BufSz = Int_BufSz + 1 ! nX_low - Int_BufSz = Int_BufSz + 1 ! nY_low - Int_BufSz = Int_BufSz + 1 ! nZ_low - Re_BufSz = Re_BufSz + 1 ! X0_low - Re_BufSz = Re_BufSz + 1 ! Y0_low - Re_BufSz = Re_BufSz + 1 ! Z0_low - Int_BufSz = Int_BufSz + 1 ! WT_Position allocated yes/no - IF ( ALLOCATED(InData%WT_Position) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WT_Position upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WT_Position) ! WT_Position - END IF - Int_BufSz = Int_BufSz + 1 ! Mod_Projection - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%dr - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%dt_low - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumTurbines - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumRadii - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumPlanes - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%WindFilePath) - IntKiBuf(Int_Xferred) = ICHAR(InData%WindFilePath(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%WrDisWind, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NOutDisWindXY - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutDisWindZ) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutDisWindZ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutDisWindZ,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutDisWindZ,1), UBOUND(InData%OutDisWindZ,1) - ReKiBuf(Re_Xferred) = InData%OutDisWindZ(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NOutDisWindYZ - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutDisWindX) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutDisWindX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutDisWindX,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutDisWindX,1), UBOUND(InData%OutDisWindX,1) - ReKiBuf(Re_Xferred) = InData%OutDisWindX(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NOutDisWindXZ - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutDisWindY) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutDisWindY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutDisWindY,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutDisWindY,1), UBOUND(InData%OutDisWindY,1) - ReKiBuf(Re_Xferred) = InData%OutDisWindY(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DbKiBuf(Db_Xferred) = InData%WrDisDT - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%ChkWndFiles, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Mod_Meander - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_Meander - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Mod_AmbWind - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%InflowFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InflowFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf(Db_Xferred) = InData%dt_high - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%X0_high) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%X0_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X0_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%X0_high,1), UBOUND(InData%X0_high,1) - ReKiBuf(Re_Xferred) = InData%X0_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Y0_high) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Y0_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y0_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Y0_high,1), UBOUND(InData%Y0_high,1) - ReKiBuf(Re_Xferred) = InData%Y0_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Z0_high) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Z0_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Z0_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Z0_high,1), UBOUND(InData%Z0_high,1) - ReKiBuf(Re_Xferred) = InData%Z0_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dX_high) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dX_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dX_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dX_high,1), UBOUND(InData%dX_high,1) - ReKiBuf(Re_Xferred) = InData%dX_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dY_high) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dY_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dY_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dY_high,1), UBOUND(InData%dY_high,1) - ReKiBuf(Re_Xferred) = InData%dY_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dZ_high) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dZ_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dZ_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dZ_high,1), UBOUND(InData%dZ_high,1) - ReKiBuf(Re_Xferred) = InData%dZ_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%nX_high - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nY_high - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nZ_high - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dX_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dY_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dZ_low - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nX_low - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nY_low - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nZ_low - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%X0_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Y0_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Z0_low - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WT_Position) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WT_Position,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WT_Position,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WT_Position,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WT_Position,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WT_Position,2), UBOUND(InData%WT_Position,2) - DO i1 = LBOUND(InData%WT_Position,1), UBOUND(InData%WT_Position,1) - ReKiBuf(Re_Xferred) = InData%WT_Position(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%Mod_Projection - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AWAE_PackInputFileType - - SUBROUTINE AWAE_UnPackInputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AWAE_InputFileType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_UnPackInputFileType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%dr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dt_low = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%NumTurbines = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumRadii = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumPlanes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%WindFilePath) - OutData%WindFilePath(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%WrDisWind = TRANSFER(IntKiBuf(Int_Xferred), OutData%WrDisWind) - Int_Xferred = Int_Xferred + 1 - OutData%NOutDisWindXY = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutDisWindZ not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutDisWindZ)) DEALLOCATE(OutData%OutDisWindZ) - ALLOCATE(OutData%OutDisWindZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutDisWindZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutDisWindZ,1), UBOUND(OutData%OutDisWindZ,1) - OutData%OutDisWindZ(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%NOutDisWindYZ = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutDisWindX not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutDisWindX)) DEALLOCATE(OutData%OutDisWindX) - ALLOCATE(OutData%OutDisWindX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutDisWindX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutDisWindX,1), UBOUND(OutData%OutDisWindX,1) - OutData%OutDisWindX(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%NOutDisWindXZ = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutDisWindY not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutDisWindY)) DEALLOCATE(OutData%OutDisWindY) - ALLOCATE(OutData%OutDisWindY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutDisWindY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutDisWindY,1), UBOUND(OutData%OutDisWindY,1) - OutData%OutDisWindY(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%WrDisDT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%ChkWndFiles = TRANSFER(IntKiBuf(Int_Xferred), OutData%ChkWndFiles) - Int_Xferred = Int_Xferred + 1 - OutData%Mod_Meander = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_Meander = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Mod_AmbWind = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%InflowFile) - OutData%InflowFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%dt_high = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X0_high not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%X0_high)) DEALLOCATE(OutData%X0_high) - ALLOCATE(OutData%X0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%X0_high,1), UBOUND(OutData%X0_high,1) - OutData%X0_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Y0_high not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Y0_high)) DEALLOCATE(OutData%Y0_high) - ALLOCATE(OutData%Y0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Y0_high,1), UBOUND(OutData%Y0_high,1) - OutData%Y0_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Z0_high not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Z0_high)) DEALLOCATE(OutData%Z0_high) - ALLOCATE(OutData%Z0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Z0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Z0_high,1), UBOUND(OutData%Z0_high,1) - OutData%Z0_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dX_high not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%dX_high)) DEALLOCATE(OutData%dX_high) - ALLOCATE(OutData%dX_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dX_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dX_high,1), UBOUND(OutData%dX_high,1) - OutData%dX_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dY_high not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%dY_high)) DEALLOCATE(OutData%dY_high) - ALLOCATE(OutData%dY_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dY_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dY_high,1), UBOUND(OutData%dY_high,1) - OutData%dY_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dZ_high not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%dZ_high)) DEALLOCATE(OutData%dZ_high) - ALLOCATE(OutData%dZ_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dZ_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dZ_high,1), UBOUND(OutData%dZ_high,1) - OutData%dZ_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%nX_high = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nY_high = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nZ_high = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%dX_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dY_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dZ_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%nX_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nY_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nZ_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%X0_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Y0_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Z0_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WT_Position not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WT_Position)) DEALLOCATE(OutData%WT_Position) - ALLOCATE(OutData%WT_Position(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WT_Position.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WT_Position,2), UBOUND(OutData%WT_Position,2) - DO i1 = LBOUND(OutData%WT_Position,1), UBOUND(OutData%WT_Position,1) - OutData%WT_Position(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%Mod_Projection = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AWAE_UnPackInputFileType +subroutine AWAE_PackInputFileType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_InputFileType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AWAE_PackInputFileType' + if (Buf%ErrStat >= AbortErrLev) return + ! dr + call RegPack(Buf, InData%dr) + if (RegCheckErr(Buf, RoutineName)) return + ! dt_low + call RegPack(Buf, InData%dt_low) + if (RegCheckErr(Buf, RoutineName)) return + ! NumTurbines + call RegPack(Buf, InData%NumTurbines) + if (RegCheckErr(Buf, RoutineName)) return + ! NumRadii + call RegPack(Buf, InData%NumRadii) + if (RegCheckErr(Buf, RoutineName)) return + ! NumPlanes + call RegPack(Buf, InData%NumPlanes) + if (RegCheckErr(Buf, RoutineName)) return + ! WindFilePath + call RegPack(Buf, InData%WindFilePath) + if (RegCheckErr(Buf, RoutineName)) return + ! WrDisWind + call RegPack(Buf, InData%WrDisWind) + if (RegCheckErr(Buf, RoutineName)) return + ! NOutDisWindXY + call RegPack(Buf, InData%NOutDisWindXY) + if (RegCheckErr(Buf, RoutineName)) return + ! OutDisWindZ + call RegPack(Buf, allocated(InData%OutDisWindZ)) + if (allocated(InData%OutDisWindZ)) then + call RegPackBounds(Buf, 1, lbound(InData%OutDisWindZ), ubound(InData%OutDisWindZ)) + call RegPack(Buf, InData%OutDisWindZ) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NOutDisWindYZ + call RegPack(Buf, InData%NOutDisWindYZ) + if (RegCheckErr(Buf, RoutineName)) return + ! OutDisWindX + call RegPack(Buf, allocated(InData%OutDisWindX)) + if (allocated(InData%OutDisWindX)) then + call RegPackBounds(Buf, 1, lbound(InData%OutDisWindX), ubound(InData%OutDisWindX)) + call RegPack(Buf, InData%OutDisWindX) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NOutDisWindXZ + call RegPack(Buf, InData%NOutDisWindXZ) + if (RegCheckErr(Buf, RoutineName)) return + ! OutDisWindY + call RegPack(Buf, allocated(InData%OutDisWindY)) + if (allocated(InData%OutDisWindY)) then + call RegPackBounds(Buf, 1, lbound(InData%OutDisWindY), ubound(InData%OutDisWindY)) + call RegPack(Buf, InData%OutDisWindY) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WrDisDT + call RegPack(Buf, InData%WrDisDT) + if (RegCheckErr(Buf, RoutineName)) return + ! ChkWndFiles + call RegPack(Buf, InData%ChkWndFiles) + if (RegCheckErr(Buf, RoutineName)) return + ! Mod_Meander + call RegPack(Buf, InData%Mod_Meander) + if (RegCheckErr(Buf, RoutineName)) return + ! C_Meander + call RegPack(Buf, InData%C_Meander) + if (RegCheckErr(Buf, RoutineName)) return + ! Mod_AmbWind + call RegPack(Buf, InData%Mod_AmbWind) + if (RegCheckErr(Buf, RoutineName)) return + ! InflowFile + call RegPack(Buf, InData%InflowFile) + if (RegCheckErr(Buf, RoutineName)) return + ! dt_high + call RegPack(Buf, InData%dt_high) + if (RegCheckErr(Buf, RoutineName)) return + ! X0_high + call RegPack(Buf, allocated(InData%X0_high)) + if (allocated(InData%X0_high)) then + call RegPackBounds(Buf, 1, lbound(InData%X0_high), ubound(InData%X0_high)) + call RegPack(Buf, InData%X0_high) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Y0_high + call RegPack(Buf, allocated(InData%Y0_high)) + if (allocated(InData%Y0_high)) then + call RegPackBounds(Buf, 1, lbound(InData%Y0_high), ubound(InData%Y0_high)) + call RegPack(Buf, InData%Y0_high) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Z0_high + call RegPack(Buf, allocated(InData%Z0_high)) + if (allocated(InData%Z0_high)) then + call RegPackBounds(Buf, 1, lbound(InData%Z0_high), ubound(InData%Z0_high)) + call RegPack(Buf, InData%Z0_high) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! dX_high + call RegPack(Buf, allocated(InData%dX_high)) + if (allocated(InData%dX_high)) then + call RegPackBounds(Buf, 1, lbound(InData%dX_high), ubound(InData%dX_high)) + call RegPack(Buf, InData%dX_high) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! dY_high + call RegPack(Buf, allocated(InData%dY_high)) + if (allocated(InData%dY_high)) then + call RegPackBounds(Buf, 1, lbound(InData%dY_high), ubound(InData%dY_high)) + call RegPack(Buf, InData%dY_high) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! dZ_high + call RegPack(Buf, allocated(InData%dZ_high)) + if (allocated(InData%dZ_high)) then + call RegPackBounds(Buf, 1, lbound(InData%dZ_high), ubound(InData%dZ_high)) + call RegPack(Buf, InData%dZ_high) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! nX_high + call RegPack(Buf, InData%nX_high) + if (RegCheckErr(Buf, RoutineName)) return + ! nY_high + call RegPack(Buf, InData%nY_high) + if (RegCheckErr(Buf, RoutineName)) return + ! nZ_high + call RegPack(Buf, InData%nZ_high) + if (RegCheckErr(Buf, RoutineName)) return + ! dX_low + call RegPack(Buf, InData%dX_low) + if (RegCheckErr(Buf, RoutineName)) return + ! dY_low + call RegPack(Buf, InData%dY_low) + if (RegCheckErr(Buf, RoutineName)) return + ! dZ_low + call RegPack(Buf, InData%dZ_low) + if (RegCheckErr(Buf, RoutineName)) return + ! nX_low + call RegPack(Buf, InData%nX_low) + if (RegCheckErr(Buf, RoutineName)) return + ! nY_low + call RegPack(Buf, InData%nY_low) + if (RegCheckErr(Buf, RoutineName)) return + ! nZ_low + call RegPack(Buf, InData%nZ_low) + if (RegCheckErr(Buf, RoutineName)) return + ! X0_low + call RegPack(Buf, InData%X0_low) + if (RegCheckErr(Buf, RoutineName)) return + ! Y0_low + call RegPack(Buf, InData%Y0_low) + if (RegCheckErr(Buf, RoutineName)) return + ! Z0_low + call RegPack(Buf, InData%Z0_low) + if (RegCheckErr(Buf, RoutineName)) return + ! WT_Position + call RegPack(Buf, allocated(InData%WT_Position)) + if (allocated(InData%WT_Position)) then + call RegPackBounds(Buf, 2, lbound(InData%WT_Position), ubound(InData%WT_Position)) + call RegPack(Buf, InData%WT_Position) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Mod_Projection + call RegPack(Buf, InData%Mod_Projection) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AWAE_UnPackInputFileType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_InputFileType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AWAE_UnPackInputFileType' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! dr + call RegUnpack(Buf, OutData%dr) + if (RegCheckErr(Buf, RoutineName)) return + ! dt_low + call RegUnpack(Buf, OutData%dt_low) + if (RegCheckErr(Buf, RoutineName)) return + ! NumTurbines + call RegUnpack(Buf, OutData%NumTurbines) + if (RegCheckErr(Buf, RoutineName)) return + ! NumRadii + call RegUnpack(Buf, OutData%NumRadii) + if (RegCheckErr(Buf, RoutineName)) return + ! NumPlanes + call RegUnpack(Buf, OutData%NumPlanes) + if (RegCheckErr(Buf, RoutineName)) return + ! WindFilePath + call RegUnpack(Buf, OutData%WindFilePath) + if (RegCheckErr(Buf, RoutineName)) return + ! WrDisWind + call RegUnpack(Buf, OutData%WrDisWind) + if (RegCheckErr(Buf, RoutineName)) return + ! NOutDisWindXY + call RegUnpack(Buf, OutData%NOutDisWindXY) + if (RegCheckErr(Buf, RoutineName)) return + ! OutDisWindZ + if (allocated(OutData%OutDisWindZ)) deallocate(OutData%OutDisWindZ) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutDisWindZ(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutDisWindZ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutDisWindZ) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NOutDisWindYZ + call RegUnpack(Buf, OutData%NOutDisWindYZ) + if (RegCheckErr(Buf, RoutineName)) return + ! OutDisWindX + if (allocated(OutData%OutDisWindX)) deallocate(OutData%OutDisWindX) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutDisWindX(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutDisWindX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutDisWindX) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NOutDisWindXZ + call RegUnpack(Buf, OutData%NOutDisWindXZ) + if (RegCheckErr(Buf, RoutineName)) return + ! OutDisWindY + if (allocated(OutData%OutDisWindY)) deallocate(OutData%OutDisWindY) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutDisWindY(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutDisWindY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutDisWindY) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WrDisDT + call RegUnpack(Buf, OutData%WrDisDT) + if (RegCheckErr(Buf, RoutineName)) return + ! ChkWndFiles + call RegUnpack(Buf, OutData%ChkWndFiles) + if (RegCheckErr(Buf, RoutineName)) return + ! Mod_Meander + call RegUnpack(Buf, OutData%Mod_Meander) + if (RegCheckErr(Buf, RoutineName)) return + ! C_Meander + call RegUnpack(Buf, OutData%C_Meander) + if (RegCheckErr(Buf, RoutineName)) return + ! Mod_AmbWind + call RegUnpack(Buf, OutData%Mod_AmbWind) + if (RegCheckErr(Buf, RoutineName)) return + ! InflowFile + call RegUnpack(Buf, OutData%InflowFile) + if (RegCheckErr(Buf, RoutineName)) return + ! dt_high + call RegUnpack(Buf, OutData%dt_high) + if (RegCheckErr(Buf, RoutineName)) return + ! X0_high + if (allocated(OutData%X0_high)) deallocate(OutData%X0_high) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%X0_high(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%X0_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%X0_high) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Y0_high + if (allocated(OutData%Y0_high)) deallocate(OutData%Y0_high) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Y0_high(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y0_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Y0_high) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Z0_high + if (allocated(OutData%Z0_high)) deallocate(OutData%Z0_high) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Z0_high(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Z0_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Z0_high) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! dX_high + if (allocated(OutData%dX_high)) deallocate(OutData%dX_high) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dX_high(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dX_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dX_high) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! dY_high + if (allocated(OutData%dY_high)) deallocate(OutData%dY_high) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dY_high(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dY_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dY_high) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! dZ_high + if (allocated(OutData%dZ_high)) deallocate(OutData%dZ_high) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dZ_high(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dZ_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dZ_high) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! nX_high + call RegUnpack(Buf, OutData%nX_high) + if (RegCheckErr(Buf, RoutineName)) return + ! nY_high + call RegUnpack(Buf, OutData%nY_high) + if (RegCheckErr(Buf, RoutineName)) return + ! nZ_high + call RegUnpack(Buf, OutData%nZ_high) + if (RegCheckErr(Buf, RoutineName)) return + ! dX_low + call RegUnpack(Buf, OutData%dX_low) + if (RegCheckErr(Buf, RoutineName)) return + ! dY_low + call RegUnpack(Buf, OutData%dY_low) + if (RegCheckErr(Buf, RoutineName)) return + ! dZ_low + call RegUnpack(Buf, OutData%dZ_low) + if (RegCheckErr(Buf, RoutineName)) return + ! nX_low + call RegUnpack(Buf, OutData%nX_low) + if (RegCheckErr(Buf, RoutineName)) return + ! nY_low + call RegUnpack(Buf, OutData%nY_low) + if (RegCheckErr(Buf, RoutineName)) return + ! nZ_low + call RegUnpack(Buf, OutData%nZ_low) + if (RegCheckErr(Buf, RoutineName)) return + ! X0_low + call RegUnpack(Buf, OutData%X0_low) + if (RegCheckErr(Buf, RoutineName)) return + ! Y0_low + call RegUnpack(Buf, OutData%Y0_low) + if (RegCheckErr(Buf, RoutineName)) return + ! Z0_low + call RegUnpack(Buf, OutData%Z0_low) + if (RegCheckErr(Buf, RoutineName)) return + ! WT_Position + if (allocated(OutData%WT_Position)) deallocate(OutData%WT_Position) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WT_Position(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WT_Position.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WT_Position) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Mod_Projection + call RegUnpack(Buf, OutData%Mod_Projection) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE AWAE_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(AWAE_InitInputType), INTENT(IN) :: SrcInitInputData TYPE(AWAE_InitInputType), INTENT(INOUT) :: DstInitInputData @@ -1513,203 +1125,43 @@ SUBROUTINE AWAE_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AWAE_DestroyInitInput - SUBROUTINE AWAE_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AWAE_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! InputFileData: size of buffers for each call to pack subtype - CALL AWAE_PackInputFileType( Re_Buf, Db_Buf, Int_Buf, InData%InputFileData, ErrStat2, ErrMsg2, .TRUE. ) ! InputFileData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InputFileData - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InputFileData - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InputFileData - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! n_high_low - Int_BufSz = Int_BufSz + 1 ! NumDT - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFileRoot) ! OutFileRoot - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL AWAE_PackInputFileType( Re_Buf, Db_Buf, Int_Buf, InData%InputFileData, ErrStat2, ErrMsg2, OnlySize ) ! InputFileData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = InData%n_high_low - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumDT - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFileRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFileRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE AWAE_PackInitInput - - SUBROUTINE AWAE_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AWAE_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AWAE_UnpackInputFileType( Re_Buf, Db_Buf, Int_Buf, OutData%InputFileData, ErrStat2, ErrMsg2 ) ! InputFileData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%n_high_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumDT = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFileRoot) - OutData%OutFileRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE AWAE_UnPackInitInput +subroutine AWAE_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AWAE_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + ! InputFileData + call AWAE_PackInputFileType(Buf, InData%InputFileData) + if (RegCheckErr(Buf, RoutineName)) return + ! n_high_low + call RegPack(Buf, InData%n_high_low) + if (RegCheckErr(Buf, RoutineName)) return + ! NumDT + call RegPack(Buf, InData%NumDT) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFileRoot + call RegPack(Buf, InData%OutFileRoot) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AWAE_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AWAE_UnPackInitInput' + if (Buf%ErrStat /= ErrID_None) return + ! InputFileData + call AWAE_UnpackInputFileType(Buf, OutData%InputFileData) ! InputFileData + ! n_high_low + call RegUnpack(Buf, OutData%n_high_low) + if (RegCheckErr(Buf, RoutineName)) return + ! NumDT + call RegUnpack(Buf, OutData%NumDT) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFileRoot + call RegUnpack(Buf, OutData%OutFileRoot) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE AWAE_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(AWAE_InitOutputType), INTENT(IN) :: SrcInitOutputData TYPE(AWAE_InitOutputType), INTENT(INOUT) :: DstInitOutputData @@ -1872,593 +1324,262 @@ SUBROUTINE AWAE_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE AWAE_DestroyInitOutput - SUBROUTINE AWAE_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AWAE_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! X0_high allocated yes/no - IF ( ALLOCATED(InData%X0_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! X0_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%X0_high) ! X0_high - END IF - Int_BufSz = Int_BufSz + 1 ! Y0_high allocated yes/no - IF ( ALLOCATED(InData%Y0_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Y0_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Y0_high) ! Y0_high - END IF - Int_BufSz = Int_BufSz + 1 ! Z0_high allocated yes/no - IF ( ALLOCATED(InData%Z0_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Z0_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Z0_high) ! Z0_high - END IF - Int_BufSz = Int_BufSz + 1 ! dX_high allocated yes/no - IF ( ALLOCATED(InData%dX_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dX_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dX_high) ! dX_high - END IF - Int_BufSz = Int_BufSz + 1 ! dY_high allocated yes/no - IF ( ALLOCATED(InData%dY_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dY_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dY_high) ! dY_high - END IF - Int_BufSz = Int_BufSz + 1 ! dZ_high allocated yes/no - IF ( ALLOCATED(InData%dZ_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dZ_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dZ_high) ! dZ_high - END IF - Int_BufSz = Int_BufSz + 1 ! nX_high - Int_BufSz = Int_BufSz + 1 ! nY_high - Int_BufSz = Int_BufSz + 1 ! nZ_high - Re_BufSz = Re_BufSz + 1 ! dX_low - Re_BufSz = Re_BufSz + 1 ! dY_low - Re_BufSz = Re_BufSz + 1 ! dZ_low - Int_BufSz = Int_BufSz + 1 ! nX_low - Int_BufSz = Int_BufSz + 1 ! nY_low - Int_BufSz = Int_BufSz + 1 ! nZ_low - Re_BufSz = Re_BufSz + 1 ! X0_low - Re_BufSz = Re_BufSz + 1 ! Y0_low - Re_BufSz = Re_BufSz + 1 ! Z0_low - Int_BufSz = Int_BufSz + 1 ! Vdist_High allocated yes/no - IF ( ALLOCATED(InData%Vdist_High) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Vdist_High upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Vdist_High,1), UBOUND(InData%Vdist_High,1) - Int_BufSz = Int_BufSz + 3 ! Vdist_High: size of buffers for each call to pack subtype - CALL AWAE_PackHighWindGridPtr( Re_Buf, Db_Buf, Int_Buf, InData%Vdist_High(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Vdist_High - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Vdist_High - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Vdist_High - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Vdist_High - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%X0_high) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%X0_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X0_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%X0_high,1), UBOUND(InData%X0_high,1) - ReKiBuf(Re_Xferred) = InData%X0_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Y0_high) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Y0_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y0_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Y0_high,1), UBOUND(InData%Y0_high,1) - ReKiBuf(Re_Xferred) = InData%Y0_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Z0_high) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Z0_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Z0_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Z0_high,1), UBOUND(InData%Z0_high,1) - ReKiBuf(Re_Xferred) = InData%Z0_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dX_high) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dX_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dX_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dX_high,1), UBOUND(InData%dX_high,1) - ReKiBuf(Re_Xferred) = InData%dX_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dY_high) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dY_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dY_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dY_high,1), UBOUND(InData%dY_high,1) - ReKiBuf(Re_Xferred) = InData%dY_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dZ_high) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dZ_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dZ_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dZ_high,1), UBOUND(InData%dZ_high,1) - ReKiBuf(Re_Xferred) = InData%dZ_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%nX_high - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nY_high - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nZ_high - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dX_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dY_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dZ_low - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nX_low - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nY_low - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nZ_low - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%X0_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Y0_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Z0_low - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Vdist_High) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vdist_High,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vdist_High,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Vdist_High,1), UBOUND(InData%Vdist_High,1) - CALL AWAE_PackHighWindGridPtr( Re_Buf, Db_Buf, Int_Buf, InData%Vdist_High(i1), ErrStat2, ErrMsg2, OnlySize ) ! Vdist_High - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - END SUBROUTINE AWAE_PackInitOutput - - SUBROUTINE AWAE_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AWAE_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X0_high not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%X0_high)) DEALLOCATE(OutData%X0_high) - ALLOCATE(OutData%X0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%X0_high,1), UBOUND(OutData%X0_high,1) - OutData%X0_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Y0_high not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Y0_high)) DEALLOCATE(OutData%Y0_high) - ALLOCATE(OutData%Y0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Y0_high,1), UBOUND(OutData%Y0_high,1) - OutData%Y0_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Z0_high not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Z0_high)) DEALLOCATE(OutData%Z0_high) - ALLOCATE(OutData%Z0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Z0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Z0_high,1), UBOUND(OutData%Z0_high,1) - OutData%Z0_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dX_high not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%dX_high)) DEALLOCATE(OutData%dX_high) - ALLOCATE(OutData%dX_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dX_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dX_high,1), UBOUND(OutData%dX_high,1) - OutData%dX_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dY_high not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%dY_high)) DEALLOCATE(OutData%dY_high) - ALLOCATE(OutData%dY_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dY_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dY_high,1), UBOUND(OutData%dY_high,1) - OutData%dY_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dZ_high not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%dZ_high)) DEALLOCATE(OutData%dZ_high) - ALLOCATE(OutData%dZ_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dZ_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dZ_high,1), UBOUND(OutData%dZ_high,1) - OutData%dZ_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%nX_high = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nY_high = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nZ_high = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%dX_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dY_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dZ_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%nX_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nY_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nZ_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%X0_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Y0_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Z0_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vdist_High not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vdist_High)) DEALLOCATE(OutData%Vdist_High) - ALLOCATE(OutData%Vdist_High(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vdist_High.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Vdist_High,1), UBOUND(OutData%Vdist_High,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AWAE_UnpackHighWindGridPtr( Re_Buf, Db_Buf, Int_Buf, OutData%Vdist_High(i1), ErrStat2, ErrMsg2 ) ! Vdist_High - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - END SUBROUTINE AWAE_UnPackInitOutput +subroutine AWAE_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AWAE_PackInitOutput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! Ver + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + if (RegCheckErr(Buf, RoutineName)) return + ! X0_high + call RegPack(Buf, allocated(InData%X0_high)) + if (allocated(InData%X0_high)) then + call RegPackBounds(Buf, 1, lbound(InData%X0_high), ubound(InData%X0_high)) + call RegPack(Buf, InData%X0_high) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Y0_high + call RegPack(Buf, allocated(InData%Y0_high)) + if (allocated(InData%Y0_high)) then + call RegPackBounds(Buf, 1, lbound(InData%Y0_high), ubound(InData%Y0_high)) + call RegPack(Buf, InData%Y0_high) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Z0_high + call RegPack(Buf, allocated(InData%Z0_high)) + if (allocated(InData%Z0_high)) then + call RegPackBounds(Buf, 1, lbound(InData%Z0_high), ubound(InData%Z0_high)) + call RegPack(Buf, InData%Z0_high) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! dX_high + call RegPack(Buf, allocated(InData%dX_high)) + if (allocated(InData%dX_high)) then + call RegPackBounds(Buf, 1, lbound(InData%dX_high), ubound(InData%dX_high)) + call RegPack(Buf, InData%dX_high) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! dY_high + call RegPack(Buf, allocated(InData%dY_high)) + if (allocated(InData%dY_high)) then + call RegPackBounds(Buf, 1, lbound(InData%dY_high), ubound(InData%dY_high)) + call RegPack(Buf, InData%dY_high) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! dZ_high + call RegPack(Buf, allocated(InData%dZ_high)) + if (allocated(InData%dZ_high)) then + call RegPackBounds(Buf, 1, lbound(InData%dZ_high), ubound(InData%dZ_high)) + call RegPack(Buf, InData%dZ_high) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! nX_high + call RegPack(Buf, InData%nX_high) + if (RegCheckErr(Buf, RoutineName)) return + ! nY_high + call RegPack(Buf, InData%nY_high) + if (RegCheckErr(Buf, RoutineName)) return + ! nZ_high + call RegPack(Buf, InData%nZ_high) + if (RegCheckErr(Buf, RoutineName)) return + ! dX_low + call RegPack(Buf, InData%dX_low) + if (RegCheckErr(Buf, RoutineName)) return + ! dY_low + call RegPack(Buf, InData%dY_low) + if (RegCheckErr(Buf, RoutineName)) return + ! dZ_low + call RegPack(Buf, InData%dZ_low) + if (RegCheckErr(Buf, RoutineName)) return + ! nX_low + call RegPack(Buf, InData%nX_low) + if (RegCheckErr(Buf, RoutineName)) return + ! nY_low + call RegPack(Buf, InData%nY_low) + if (RegCheckErr(Buf, RoutineName)) return + ! nZ_low + call RegPack(Buf, InData%nZ_low) + if (RegCheckErr(Buf, RoutineName)) return + ! X0_low + call RegPack(Buf, InData%X0_low) + if (RegCheckErr(Buf, RoutineName)) return + ! Y0_low + call RegPack(Buf, InData%Y0_low) + if (RegCheckErr(Buf, RoutineName)) return + ! Z0_low + call RegPack(Buf, InData%Z0_low) + if (RegCheckErr(Buf, RoutineName)) return + ! Vdist_High + call RegPack(Buf, allocated(InData%Vdist_High)) + if (allocated(InData%Vdist_High)) then + call RegPackBounds(Buf, 1, lbound(InData%Vdist_High), ubound(InData%Vdist_High)) + LB(1:1) = lbound(InData%Vdist_High) + UB(1:1) = ubound(InData%Vdist_High) + do i1 = LB(1), UB(1) + call AWAE_PackHighWindGridPtr(Buf, InData%Vdist_High(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AWAE_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AWAE_UnPackInitOutput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! Ver + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + ! X0_high + if (allocated(OutData%X0_high)) deallocate(OutData%X0_high) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%X0_high(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%X0_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%X0_high) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Y0_high + if (allocated(OutData%Y0_high)) deallocate(OutData%Y0_high) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Y0_high(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y0_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Y0_high) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Z0_high + if (allocated(OutData%Z0_high)) deallocate(OutData%Z0_high) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Z0_high(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Z0_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Z0_high) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! dX_high + if (allocated(OutData%dX_high)) deallocate(OutData%dX_high) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dX_high(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dX_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dX_high) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! dY_high + if (allocated(OutData%dY_high)) deallocate(OutData%dY_high) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dY_high(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dY_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dY_high) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! dZ_high + if (allocated(OutData%dZ_high)) deallocate(OutData%dZ_high) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dZ_high(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dZ_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dZ_high) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! nX_high + call RegUnpack(Buf, OutData%nX_high) + if (RegCheckErr(Buf, RoutineName)) return + ! nY_high + call RegUnpack(Buf, OutData%nY_high) + if (RegCheckErr(Buf, RoutineName)) return + ! nZ_high + call RegUnpack(Buf, OutData%nZ_high) + if (RegCheckErr(Buf, RoutineName)) return + ! dX_low + call RegUnpack(Buf, OutData%dX_low) + if (RegCheckErr(Buf, RoutineName)) return + ! dY_low + call RegUnpack(Buf, OutData%dY_low) + if (RegCheckErr(Buf, RoutineName)) return + ! dZ_low + call RegUnpack(Buf, OutData%dZ_low) + if (RegCheckErr(Buf, RoutineName)) return + ! nX_low + call RegUnpack(Buf, OutData%nX_low) + if (RegCheckErr(Buf, RoutineName)) return + ! nY_low + call RegUnpack(Buf, OutData%nY_low) + if (RegCheckErr(Buf, RoutineName)) return + ! nZ_low + call RegUnpack(Buf, OutData%nZ_low) + if (RegCheckErr(Buf, RoutineName)) return + ! X0_low + call RegUnpack(Buf, OutData%X0_low) + if (RegCheckErr(Buf, RoutineName)) return + ! Y0_low + call RegUnpack(Buf, OutData%Y0_low) + if (RegCheckErr(Buf, RoutineName)) return + ! Z0_low + call RegUnpack(Buf, OutData%Z0_low) + if (RegCheckErr(Buf, RoutineName)) return + ! Vdist_High + if (allocated(OutData%Vdist_High)) deallocate(OutData%Vdist_High) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vdist_High(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vdist_High.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AWAE_UnpackHighWindGridPtr(Buf, OutData%Vdist_High(i1)) ! Vdist_High + end do + end if +end subroutine SUBROUTINE AWAE_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(AWAE_ContinuousStateType), INTENT(IN) :: SrcContStateData TYPE(AWAE_ContinuousStateType), INTENT(INOUT) :: DstContStateData @@ -2514,220 +1635,53 @@ SUBROUTINE AWAE_DestroyContState( ContStateData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE AWAE_DestroyContState - SUBROUTINE AWAE_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AWAE_ContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_PackContState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! IfW allocated yes/no - IF ( ALLOCATED(InData%IfW) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IfW upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%IfW,1), UBOUND(InData%IfW,1) - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%IfW(i1), ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%IfW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IfW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IfW,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IfW,1), UBOUND(InData%IfW,1) - CALL InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%IfW(i1), ErrStat2, ErrMsg2, OnlySize ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - END SUBROUTINE AWAE_PackContState - - SUBROUTINE AWAE_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AWAE_ContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_UnPackContState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IfW not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IfW)) DEALLOCATE(OutData%IfW) - ALLOCATE(OutData%IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IfW,1), UBOUND(OutData%IfW,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%IfW(i1), ErrStat2, ErrMsg2 ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - END SUBROUTINE AWAE_UnPackContState +subroutine AWAE_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AWAE_PackContState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! IfW + call RegPack(Buf, allocated(InData%IfW)) + if (allocated(InData%IfW)) then + call RegPackBounds(Buf, 1, lbound(InData%IfW), ubound(InData%IfW)) + LB(1:1) = lbound(InData%IfW) + UB(1:1) = ubound(InData%IfW) + do i1 = LB(1), UB(1) + call InflowWind_PackContState(Buf, InData%IfW(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AWAE_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AWAE_UnPackContState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! IfW + if (allocated(OutData%IfW)) deallocate(OutData%IfW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IfW(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackContState(Buf, OutData%IfW(i1)) ! IfW + end do + end if +end subroutine SUBROUTINE AWAE_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(AWAE_DiscreteStateType), INTENT(IN) :: SrcDiscStateData TYPE(AWAE_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData @@ -2783,220 +1737,53 @@ SUBROUTINE AWAE_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE AWAE_DestroyDiscState - SUBROUTINE AWAE_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AWAE_DiscreteStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_PackDiscState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! IfW allocated yes/no - IF ( ALLOCATED(InData%IfW) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IfW upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%IfW,1), UBOUND(InData%IfW,1) - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%IfW(i1), ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%IfW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IfW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IfW,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IfW,1), UBOUND(InData%IfW,1) - CALL InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%IfW(i1), ErrStat2, ErrMsg2, OnlySize ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - END SUBROUTINE AWAE_PackDiscState - - SUBROUTINE AWAE_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AWAE_DiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_UnPackDiscState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IfW not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IfW)) DEALLOCATE(OutData%IfW) - ALLOCATE(OutData%IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IfW,1), UBOUND(OutData%IfW,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%IfW(i1), ErrStat2, ErrMsg2 ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - END SUBROUTINE AWAE_UnPackDiscState +subroutine AWAE_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AWAE_PackDiscState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! IfW + call RegPack(Buf, allocated(InData%IfW)) + if (allocated(InData%IfW)) then + call RegPackBounds(Buf, 1, lbound(InData%IfW), ubound(InData%IfW)) + LB(1:1) = lbound(InData%IfW) + UB(1:1) = ubound(InData%IfW) + do i1 = LB(1), UB(1) + call InflowWind_PackDiscState(Buf, InData%IfW(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AWAE_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AWAE_UnPackDiscState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! IfW + if (allocated(OutData%IfW)) deallocate(OutData%IfW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IfW(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackDiscState(Buf, OutData%IfW(i1)) ! IfW + end do + end if +end subroutine SUBROUTINE AWAE_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(AWAE_ConstraintStateType), INTENT(IN) :: SrcConstrStateData TYPE(AWAE_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData @@ -3052,220 +1839,53 @@ SUBROUTINE AWAE_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE AWAE_DestroyConstrState - SUBROUTINE AWAE_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AWAE_ConstraintStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_PackConstrState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! IfW allocated yes/no - IF ( ALLOCATED(InData%IfW) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IfW upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%IfW,1), UBOUND(InData%IfW,1) - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%IfW(i1), ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%IfW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IfW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IfW,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IfW,1), UBOUND(InData%IfW,1) - CALL InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%IfW(i1), ErrStat2, ErrMsg2, OnlySize ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - END SUBROUTINE AWAE_PackConstrState - - SUBROUTINE AWAE_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AWAE_ConstraintStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_UnPackConstrState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IfW not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IfW)) DEALLOCATE(OutData%IfW) - ALLOCATE(OutData%IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IfW,1), UBOUND(OutData%IfW,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%IfW(i1), ErrStat2, ErrMsg2 ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - END SUBROUTINE AWAE_UnPackConstrState +subroutine AWAE_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AWAE_PackConstrState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! IfW + call RegPack(Buf, allocated(InData%IfW)) + if (allocated(InData%IfW)) then + call RegPackBounds(Buf, 1, lbound(InData%IfW), ubound(InData%IfW)) + LB(1:1) = lbound(InData%IfW) + UB(1:1) = ubound(InData%IfW) + do i1 = LB(1), UB(1) + call InflowWind_PackConstrState(Buf, InData%IfW(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AWAE_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AWAE_UnPackConstrState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! IfW + if (allocated(OutData%IfW)) deallocate(OutData%IfW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IfW(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackConstrState(Buf, OutData%IfW(i1)) ! IfW + end do + end if +end subroutine SUBROUTINE AWAE_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(AWAE_OtherStateType), INTENT(IN) :: SrcOtherStateData TYPE(AWAE_OtherStateType), INTENT(INOUT) :: DstOtherStateData @@ -3321,220 +1941,53 @@ SUBROUTINE AWAE_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE AWAE_DestroyOtherState - SUBROUTINE AWAE_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AWAE_OtherStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_PackOtherState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! IfW allocated yes/no - IF ( ALLOCATED(InData%IfW) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IfW upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%IfW,1), UBOUND(InData%IfW,1) - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%IfW(i1), ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%IfW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IfW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IfW,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IfW,1), UBOUND(InData%IfW,1) - CALL InflowWind_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%IfW(i1), ErrStat2, ErrMsg2, OnlySize ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - END SUBROUTINE AWAE_PackOtherState - - SUBROUTINE AWAE_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AWAE_OtherStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_UnPackOtherState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IfW not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IfW)) DEALLOCATE(OutData%IfW) - ALLOCATE(OutData%IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IfW,1), UBOUND(OutData%IfW,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%IfW(i1), ErrStat2, ErrMsg2 ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - END SUBROUTINE AWAE_UnPackOtherState +subroutine AWAE_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AWAE_PackOtherState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! IfW + call RegPack(Buf, allocated(InData%IfW)) + if (allocated(InData%IfW)) then + call RegPackBounds(Buf, 1, lbound(InData%IfW), ubound(InData%IfW)) + LB(1:1) = lbound(InData%IfW) + UB(1:1) = ubound(InData%IfW) + do i1 = LB(1), UB(1) + call InflowWind_PackOtherState(Buf, InData%IfW(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AWAE_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AWAE_UnPackOtherState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! IfW + if (allocated(OutData%IfW)) deallocate(OutData%IfW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IfW(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackOtherState(Buf, OutData%IfW(i1)) ! IfW + end do + end if +end subroutine SUBROUTINE AWAE_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) TYPE(AWAE_MiscVarType), INTENT(IN) :: SrcMiscData TYPE(AWAE_MiscVarType), INTENT(INOUT) :: DstMiscData @@ -3906,1515 +2359,408 @@ SUBROUTINE AWAE_DestroyMisc( MiscData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE AWAE_DestroyMisc - SUBROUTINE AWAE_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AWAE_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! Vamb_low allocated yes/no - IF ( ALLOCATED(InData%Vamb_low) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Vamb_low upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vamb_low) ! Vamb_low - END IF - Int_BufSz = Int_BufSz + 1 ! Vamb_lowpol allocated yes/no - IF ( ALLOCATED(InData%Vamb_lowpol) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vamb_lowpol upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vamb_lowpol) ! Vamb_lowpol - END IF - Int_BufSz = Int_BufSz + 1 ! Vdist_low allocated yes/no - IF ( ALLOCATED(InData%Vdist_low) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Vdist_low upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vdist_low) ! Vdist_low - END IF - Int_BufSz = Int_BufSz + 1 ! Vdist_low_full allocated yes/no - IF ( ALLOCATED(InData%Vdist_low_full) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Vdist_low_full upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vdist_low_full) ! Vdist_low_full - END IF - Int_BufSz = Int_BufSz + 1 ! Vamb_High allocated yes/no - IF ( ALLOCATED(InData%Vamb_High) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Vamb_High upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%Vamb_High,1), UBOUND(InData%Vamb_High,1) - Int_BufSz = Int_BufSz + 3 ! Vamb_High: size of buffers for each call to pack subtype - CALL AWAE_PackHighWindGrid( Re_Buf, Db_Buf, Int_Buf, InData%Vamb_High(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Vamb_High - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Vamb_High - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Vamb_High - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Vamb_High - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! parallelFlag allocated yes/no - IF ( ALLOCATED(InData%parallelFlag) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! parallelFlag upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%parallelFlag) ! parallelFlag - END IF - Int_BufSz = Int_BufSz + 1 ! r_s allocated yes/no - IF ( ALLOCATED(InData%r_s) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! r_s upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%r_s) ! r_s - END IF - Int_BufSz = Int_BufSz + 1 ! r_e allocated yes/no - IF ( ALLOCATED(InData%r_e) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! r_e upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%r_e) ! r_e - END IF - Int_BufSz = Int_BufSz + 1 ! rhat_s allocated yes/no - IF ( ALLOCATED(InData%rhat_s) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! rhat_s upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rhat_s) ! rhat_s - END IF - Int_BufSz = Int_BufSz + 1 ! rhat_e allocated yes/no - IF ( ALLOCATED(InData%rhat_e) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! rhat_e upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rhat_e) ! rhat_e - END IF - Int_BufSz = Int_BufSz + 1 ! pvec_cs allocated yes/no - IF ( ALLOCATED(InData%pvec_cs) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! pvec_cs upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%pvec_cs) ! pvec_cs - END IF - Int_BufSz = Int_BufSz + 1 ! pvec_ce allocated yes/no - IF ( ALLOCATED(InData%pvec_ce) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! pvec_ce upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%pvec_ce) ! pvec_ce - END IF - Int_BufSz = Int_BufSz + 1 ! outVizXYPlane allocated yes/no - IF ( ALLOCATED(InData%outVizXYPlane) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! outVizXYPlane upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%outVizXYPlane) ! outVizXYPlane - END IF - Int_BufSz = Int_BufSz + 1 ! outVizYZPlane allocated yes/no - IF ( ALLOCATED(InData%outVizYZPlane) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! outVizYZPlane upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%outVizYZPlane) ! outVizYZPlane - END IF - Int_BufSz = Int_BufSz + 1 ! outVizXZPlane allocated yes/no - IF ( ALLOCATED(InData%outVizXZPlane) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! outVizXZPlane upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%outVizXZPlane) ! outVizXZPlane - END IF - Int_BufSz = Int_BufSz + 1 ! IfW allocated yes/no - IF ( ALLOCATED(InData%IfW) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IfW upper/lower bounds for each dimension - DO i1 = LBOUND(InData%IfW,1), UBOUND(InData%IfW,1) - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%IfW(i1), ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! u_IfW_Low: size of buffers for each call to pack subtype - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_IfW_Low, ErrStat2, ErrMsg2, .TRUE. ) ! u_IfW_Low - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_IfW_Low - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_IfW_Low - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_IfW_Low - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u_IfW_High: size of buffers for each call to pack subtype - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_IfW_High, ErrStat2, ErrMsg2, .TRUE. ) ! u_IfW_High - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_IfW_High - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_IfW_High - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_IfW_High - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y_IfW_Low: size of buffers for each call to pack subtype - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_IfW_Low, ErrStat2, ErrMsg2, .TRUE. ) ! y_IfW_Low - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_IfW_Low - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_IfW_Low - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_IfW_Low - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y_IfW_High: size of buffers for each call to pack subtype - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_IfW_High, ErrStat2, ErrMsg2, .TRUE. ) ! y_IfW_High - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_IfW_High - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_IfW_High - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_IfW_High - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%Vamb_low) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vamb_low,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vamb_low,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vamb_low,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vamb_low,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vamb_low,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vamb_low,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vamb_low,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vamb_low,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Vamb_low,4), UBOUND(InData%Vamb_low,4) - DO i3 = LBOUND(InData%Vamb_low,3), UBOUND(InData%Vamb_low,3) - DO i2 = LBOUND(InData%Vamb_low,2), UBOUND(InData%Vamb_low,2) - DO i1 = LBOUND(InData%Vamb_low,1), UBOUND(InData%Vamb_low,1) - ReKiBuf(Re_Xferred) = InData%Vamb_low(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vamb_lowpol) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vamb_lowpol,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vamb_lowpol,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vamb_lowpol,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vamb_lowpol,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vamb_lowpol,2), UBOUND(InData%Vamb_lowpol,2) - DO i1 = LBOUND(InData%Vamb_lowpol,1), UBOUND(InData%Vamb_lowpol,1) - ReKiBuf(Re_Xferred) = InData%Vamb_lowpol(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vdist_low) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vdist_low,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vdist_low,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vdist_low,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vdist_low,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vdist_low,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vdist_low,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vdist_low,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vdist_low,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Vdist_low,4), UBOUND(InData%Vdist_low,4) - DO i3 = LBOUND(InData%Vdist_low,3), UBOUND(InData%Vdist_low,3) - DO i2 = LBOUND(InData%Vdist_low,2), UBOUND(InData%Vdist_low,2) - DO i1 = LBOUND(InData%Vdist_low,1), UBOUND(InData%Vdist_low,1) - ReKiBuf(Re_Xferred) = InData%Vdist_low(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vdist_low_full) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vdist_low_full,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vdist_low_full,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vdist_low_full,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vdist_low_full,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vdist_low_full,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vdist_low_full,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vdist_low_full,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vdist_low_full,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Vdist_low_full,4), UBOUND(InData%Vdist_low_full,4) - DO i3 = LBOUND(InData%Vdist_low_full,3), UBOUND(InData%Vdist_low_full,3) - DO i2 = LBOUND(InData%Vdist_low_full,2), UBOUND(InData%Vdist_low_full,2) - DO i1 = LBOUND(InData%Vdist_low_full,1), UBOUND(InData%Vdist_low_full,1) - ReKiBuf(Re_Xferred) = InData%Vdist_low_full(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vamb_High) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vamb_High,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vamb_High,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Vamb_High,1), UBOUND(InData%Vamb_High,1) - CALL AWAE_PackHighWindGrid( Re_Buf, Db_Buf, Int_Buf, InData%Vamb_High(i1), ErrStat2, ErrMsg2, OnlySize ) ! Vamb_High - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%parallelFlag) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%parallelFlag,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%parallelFlag,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%parallelFlag,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%parallelFlag,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%parallelFlag,2), UBOUND(InData%parallelFlag,2) - DO i1 = LBOUND(InData%parallelFlag,1), UBOUND(InData%parallelFlag,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%parallelFlag(i1,i2), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%r_s) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r_s,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_s,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r_s,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_s,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%r_s,2), UBOUND(InData%r_s,2) - DO i1 = LBOUND(InData%r_s,1), UBOUND(InData%r_s,1) - ReKiBuf(Re_Xferred) = InData%r_s(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%r_e) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r_e,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_e,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r_e,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_e,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%r_e,2), UBOUND(InData%r_e,2) - DO i1 = LBOUND(InData%r_e,1), UBOUND(InData%r_e,1) - ReKiBuf(Re_Xferred) = InData%r_e(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rhat_s) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rhat_s,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rhat_s,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rhat_s,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rhat_s,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rhat_s,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rhat_s,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%rhat_s,3), UBOUND(InData%rhat_s,3) - DO i2 = LBOUND(InData%rhat_s,2), UBOUND(InData%rhat_s,2) - DO i1 = LBOUND(InData%rhat_s,1), UBOUND(InData%rhat_s,1) - ReKiBuf(Re_Xferred) = InData%rhat_s(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rhat_e) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rhat_e,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rhat_e,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rhat_e,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rhat_e,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rhat_e,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rhat_e,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%rhat_e,3), UBOUND(InData%rhat_e,3) - DO i2 = LBOUND(InData%rhat_e,2), UBOUND(InData%rhat_e,2) - DO i1 = LBOUND(InData%rhat_e,1), UBOUND(InData%rhat_e,1) - ReKiBuf(Re_Xferred) = InData%rhat_e(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%pvec_cs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%pvec_cs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pvec_cs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%pvec_cs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pvec_cs,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%pvec_cs,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pvec_cs,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%pvec_cs,3), UBOUND(InData%pvec_cs,3) - DO i2 = LBOUND(InData%pvec_cs,2), UBOUND(InData%pvec_cs,2) - DO i1 = LBOUND(InData%pvec_cs,1), UBOUND(InData%pvec_cs,1) - ReKiBuf(Re_Xferred) = InData%pvec_cs(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%pvec_ce) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%pvec_ce,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pvec_ce,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%pvec_ce,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pvec_ce,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%pvec_ce,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pvec_ce,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%pvec_ce,3), UBOUND(InData%pvec_ce,3) - DO i2 = LBOUND(InData%pvec_ce,2), UBOUND(InData%pvec_ce,2) - DO i1 = LBOUND(InData%pvec_ce,1), UBOUND(InData%pvec_ce,1) - ReKiBuf(Re_Xferred) = InData%pvec_ce(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%outVizXYPlane) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%outVizXYPlane,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%outVizXYPlane,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%outVizXYPlane,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%outVizXYPlane,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%outVizXYPlane,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%outVizXYPlane,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%outVizXYPlane,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%outVizXYPlane,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%outVizXYPlane,4), UBOUND(InData%outVizXYPlane,4) - DO i3 = LBOUND(InData%outVizXYPlane,3), UBOUND(InData%outVizXYPlane,3) - DO i2 = LBOUND(InData%outVizXYPlane,2), UBOUND(InData%outVizXYPlane,2) - DO i1 = LBOUND(InData%outVizXYPlane,1), UBOUND(InData%outVizXYPlane,1) - ReKiBuf(Re_Xferred) = InData%outVizXYPlane(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%outVizYZPlane) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%outVizYZPlane,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%outVizYZPlane,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%outVizYZPlane,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%outVizYZPlane,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%outVizYZPlane,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%outVizYZPlane,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%outVizYZPlane,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%outVizYZPlane,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%outVizYZPlane,4), UBOUND(InData%outVizYZPlane,4) - DO i3 = LBOUND(InData%outVizYZPlane,3), UBOUND(InData%outVizYZPlane,3) - DO i2 = LBOUND(InData%outVizYZPlane,2), UBOUND(InData%outVizYZPlane,2) - DO i1 = LBOUND(InData%outVizYZPlane,1), UBOUND(InData%outVizYZPlane,1) - ReKiBuf(Re_Xferred) = InData%outVizYZPlane(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%outVizXZPlane) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%outVizXZPlane,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%outVizXZPlane,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%outVizXZPlane,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%outVizXZPlane,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%outVizXZPlane,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%outVizXZPlane,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%outVizXZPlane,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%outVizXZPlane,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%outVizXZPlane,4), UBOUND(InData%outVizXZPlane,4) - DO i3 = LBOUND(InData%outVizXZPlane,3), UBOUND(InData%outVizXZPlane,3) - DO i2 = LBOUND(InData%outVizXZPlane,2), UBOUND(InData%outVizXZPlane,2) - DO i1 = LBOUND(InData%outVizXZPlane,1), UBOUND(InData%outVizXZPlane,1) - ReKiBuf(Re_Xferred) = InData%outVizXZPlane(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IfW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IfW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IfW,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IfW,1), UBOUND(InData%IfW,1) - CALL InflowWind_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%IfW(i1), ErrStat2, ErrMsg2, OnlySize ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_IfW_Low, ErrStat2, ErrMsg2, OnlySize ) ! u_IfW_Low - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_IfW_High, ErrStat2, ErrMsg2, OnlySize ) ! u_IfW_High - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_IfW_Low, ErrStat2, ErrMsg2, OnlySize ) ! y_IfW_Low - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_IfW_High, ErrStat2, ErrMsg2, OnlySize ) ! y_IfW_High - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE AWAE_PackMisc - - SUBROUTINE AWAE_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AWAE_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vamb_low not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vamb_low)) DEALLOCATE(OutData%Vamb_low) - ALLOCATE(OutData%Vamb_low(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vamb_low.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Vamb_low,4), UBOUND(OutData%Vamb_low,4) - DO i3 = LBOUND(OutData%Vamb_low,3), UBOUND(OutData%Vamb_low,3) - DO i2 = LBOUND(OutData%Vamb_low,2), UBOUND(OutData%Vamb_low,2) - DO i1 = LBOUND(OutData%Vamb_low,1), UBOUND(OutData%Vamb_low,1) - OutData%Vamb_low(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vamb_lowpol not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vamb_lowpol)) DEALLOCATE(OutData%Vamb_lowpol) - ALLOCATE(OutData%Vamb_lowpol(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vamb_lowpol.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vamb_lowpol,2), UBOUND(OutData%Vamb_lowpol,2) - DO i1 = LBOUND(OutData%Vamb_lowpol,1), UBOUND(OutData%Vamb_lowpol,1) - OutData%Vamb_lowpol(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vdist_low not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vdist_low)) DEALLOCATE(OutData%Vdist_low) - ALLOCATE(OutData%Vdist_low(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vdist_low.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Vdist_low,4), UBOUND(OutData%Vdist_low,4) - DO i3 = LBOUND(OutData%Vdist_low,3), UBOUND(OutData%Vdist_low,3) - DO i2 = LBOUND(OutData%Vdist_low,2), UBOUND(OutData%Vdist_low,2) - DO i1 = LBOUND(OutData%Vdist_low,1), UBOUND(OutData%Vdist_low,1) - OutData%Vdist_low(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vdist_low_full not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vdist_low_full)) DEALLOCATE(OutData%Vdist_low_full) - ALLOCATE(OutData%Vdist_low_full(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vdist_low_full.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Vdist_low_full,4), UBOUND(OutData%Vdist_low_full,4) - DO i3 = LBOUND(OutData%Vdist_low_full,3), UBOUND(OutData%Vdist_low_full,3) - DO i2 = LBOUND(OutData%Vdist_low_full,2), UBOUND(OutData%Vdist_low_full,2) - DO i1 = LBOUND(OutData%Vdist_low_full,1), UBOUND(OutData%Vdist_low_full,1) - OutData%Vdist_low_full(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vamb_High not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vamb_High)) DEALLOCATE(OutData%Vamb_High) - ALLOCATE(OutData%Vamb_High(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vamb_High.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Vamb_High,1), UBOUND(OutData%Vamb_High,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AWAE_UnpackHighWindGrid( Re_Buf, Db_Buf, Int_Buf, OutData%Vamb_High(i1), ErrStat2, ErrMsg2 ) ! Vamb_High - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! parallelFlag not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%parallelFlag)) DEALLOCATE(OutData%parallelFlag) - ALLOCATE(OutData%parallelFlag(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%parallelFlag.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%parallelFlag,2), UBOUND(OutData%parallelFlag,2) - DO i1 = LBOUND(OutData%parallelFlag,1), UBOUND(OutData%parallelFlag,1) - OutData%parallelFlag(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%parallelFlag(i1,i2)) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r_s not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%r_s)) DEALLOCATE(OutData%r_s) - ALLOCATE(OutData%r_s(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_s.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%r_s,2), UBOUND(OutData%r_s,2) - DO i1 = LBOUND(OutData%r_s,1), UBOUND(OutData%r_s,1) - OutData%r_s(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r_e not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%r_e)) DEALLOCATE(OutData%r_e) - ALLOCATE(OutData%r_e(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_e.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%r_e,2), UBOUND(OutData%r_e,2) - DO i1 = LBOUND(OutData%r_e,1), UBOUND(OutData%r_e,1) - OutData%r_e(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rhat_s not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rhat_s)) DEALLOCATE(OutData%rhat_s) - ALLOCATE(OutData%rhat_s(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rhat_s.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%rhat_s,3), UBOUND(OutData%rhat_s,3) - DO i2 = LBOUND(OutData%rhat_s,2), UBOUND(OutData%rhat_s,2) - DO i1 = LBOUND(OutData%rhat_s,1), UBOUND(OutData%rhat_s,1) - OutData%rhat_s(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rhat_e not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rhat_e)) DEALLOCATE(OutData%rhat_e) - ALLOCATE(OutData%rhat_e(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rhat_e.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%rhat_e,3), UBOUND(OutData%rhat_e,3) - DO i2 = LBOUND(OutData%rhat_e,2), UBOUND(OutData%rhat_e,2) - DO i1 = LBOUND(OutData%rhat_e,1), UBOUND(OutData%rhat_e,1) - OutData%rhat_e(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pvec_cs not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%pvec_cs)) DEALLOCATE(OutData%pvec_cs) - ALLOCATE(OutData%pvec_cs(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%pvec_cs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%pvec_cs,3), UBOUND(OutData%pvec_cs,3) - DO i2 = LBOUND(OutData%pvec_cs,2), UBOUND(OutData%pvec_cs,2) - DO i1 = LBOUND(OutData%pvec_cs,1), UBOUND(OutData%pvec_cs,1) - OutData%pvec_cs(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pvec_ce not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%pvec_ce)) DEALLOCATE(OutData%pvec_ce) - ALLOCATE(OutData%pvec_ce(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%pvec_ce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%pvec_ce,3), UBOUND(OutData%pvec_ce,3) - DO i2 = LBOUND(OutData%pvec_ce,2), UBOUND(OutData%pvec_ce,2) - DO i1 = LBOUND(OutData%pvec_ce,1), UBOUND(OutData%pvec_ce,1) - OutData%pvec_ce(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! outVizXYPlane not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%outVizXYPlane)) DEALLOCATE(OutData%outVizXYPlane) - ALLOCATE(OutData%outVizXYPlane(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%outVizXYPlane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%outVizXYPlane,4), UBOUND(OutData%outVizXYPlane,4) - DO i3 = LBOUND(OutData%outVizXYPlane,3), UBOUND(OutData%outVizXYPlane,3) - DO i2 = LBOUND(OutData%outVizXYPlane,2), UBOUND(OutData%outVizXYPlane,2) - DO i1 = LBOUND(OutData%outVizXYPlane,1), UBOUND(OutData%outVizXYPlane,1) - OutData%outVizXYPlane(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! outVizYZPlane not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%outVizYZPlane)) DEALLOCATE(OutData%outVizYZPlane) - ALLOCATE(OutData%outVizYZPlane(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%outVizYZPlane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%outVizYZPlane,4), UBOUND(OutData%outVizYZPlane,4) - DO i3 = LBOUND(OutData%outVizYZPlane,3), UBOUND(OutData%outVizYZPlane,3) - DO i2 = LBOUND(OutData%outVizYZPlane,2), UBOUND(OutData%outVizYZPlane,2) - DO i1 = LBOUND(OutData%outVizYZPlane,1), UBOUND(OutData%outVizYZPlane,1) - OutData%outVizYZPlane(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! outVizXZPlane not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%outVizXZPlane)) DEALLOCATE(OutData%outVizXZPlane) - ALLOCATE(OutData%outVizXZPlane(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%outVizXZPlane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%outVizXZPlane,4), UBOUND(OutData%outVizXZPlane,4) - DO i3 = LBOUND(OutData%outVizXZPlane,3), UBOUND(OutData%outVizXZPlane,3) - DO i2 = LBOUND(OutData%outVizXZPlane,2), UBOUND(OutData%outVizXZPlane,2) - DO i1 = LBOUND(OutData%outVizXZPlane,1), UBOUND(OutData%outVizXZPlane,1) - OutData%outVizXZPlane(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IfW not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IfW)) DEALLOCATE(OutData%IfW) - ALLOCATE(OutData%IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IfW,1), UBOUND(OutData%IfW,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%IfW(i1), ErrStat2, ErrMsg2 ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_IfW_Low, ErrStat2, ErrMsg2 ) ! u_IfW_Low - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_IfW_High, ErrStat2, ErrMsg2 ) ! u_IfW_High - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_IfW_Low, ErrStat2, ErrMsg2 ) ! y_IfW_Low - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_IfW_High, ErrStat2, ErrMsg2 ) ! y_IfW_High - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE AWAE_UnPackMisc +subroutine AWAE_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AWAE_PackMisc' + integer(IntKi) :: i1, i2, i3, i4 + integer(IntKi) :: LB(4), UB(4) + if (Buf%ErrStat >= AbortErrLev) return + ! Vamb_low + call RegPack(Buf, allocated(InData%Vamb_low)) + if (allocated(InData%Vamb_low)) then + call RegPackBounds(Buf, 4, lbound(InData%Vamb_low), ubound(InData%Vamb_low)) + call RegPack(Buf, InData%Vamb_low) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Vamb_lowpol + call RegPack(Buf, allocated(InData%Vamb_lowpol)) + if (allocated(InData%Vamb_lowpol)) then + call RegPackBounds(Buf, 2, lbound(InData%Vamb_lowpol), ubound(InData%Vamb_lowpol)) + call RegPack(Buf, InData%Vamb_lowpol) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Vdist_low + call RegPack(Buf, allocated(InData%Vdist_low)) + if (allocated(InData%Vdist_low)) then + call RegPackBounds(Buf, 4, lbound(InData%Vdist_low), ubound(InData%Vdist_low)) + call RegPack(Buf, InData%Vdist_low) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Vdist_low_full + call RegPack(Buf, allocated(InData%Vdist_low_full)) + if (allocated(InData%Vdist_low_full)) then + call RegPackBounds(Buf, 4, lbound(InData%Vdist_low_full), ubound(InData%Vdist_low_full)) + call RegPack(Buf, InData%Vdist_low_full) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Vamb_High + call RegPack(Buf, allocated(InData%Vamb_High)) + if (allocated(InData%Vamb_High)) then + call RegPackBounds(Buf, 1, lbound(InData%Vamb_High), ubound(InData%Vamb_High)) + LB(1:1) = lbound(InData%Vamb_High) + UB(1:1) = ubound(InData%Vamb_High) + do i1 = LB(1), UB(1) + call AWAE_PackHighWindGrid(Buf, InData%Vamb_High(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! parallelFlag + call RegPack(Buf, allocated(InData%parallelFlag)) + if (allocated(InData%parallelFlag)) then + call RegPackBounds(Buf, 2, lbound(InData%parallelFlag), ubound(InData%parallelFlag)) + call RegPack(Buf, InData%parallelFlag) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! r_s + call RegPack(Buf, allocated(InData%r_s)) + if (allocated(InData%r_s)) then + call RegPackBounds(Buf, 2, lbound(InData%r_s), ubound(InData%r_s)) + call RegPack(Buf, InData%r_s) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! r_e + call RegPack(Buf, allocated(InData%r_e)) + if (allocated(InData%r_e)) then + call RegPackBounds(Buf, 2, lbound(InData%r_e), ubound(InData%r_e)) + call RegPack(Buf, InData%r_e) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! rhat_s + call RegPack(Buf, allocated(InData%rhat_s)) + if (allocated(InData%rhat_s)) then + call RegPackBounds(Buf, 3, lbound(InData%rhat_s), ubound(InData%rhat_s)) + call RegPack(Buf, InData%rhat_s) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! rhat_e + call RegPack(Buf, allocated(InData%rhat_e)) + if (allocated(InData%rhat_e)) then + call RegPackBounds(Buf, 3, lbound(InData%rhat_e), ubound(InData%rhat_e)) + call RegPack(Buf, InData%rhat_e) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! pvec_cs + call RegPack(Buf, allocated(InData%pvec_cs)) + if (allocated(InData%pvec_cs)) then + call RegPackBounds(Buf, 3, lbound(InData%pvec_cs), ubound(InData%pvec_cs)) + call RegPack(Buf, InData%pvec_cs) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! pvec_ce + call RegPack(Buf, allocated(InData%pvec_ce)) + if (allocated(InData%pvec_ce)) then + call RegPackBounds(Buf, 3, lbound(InData%pvec_ce), ubound(InData%pvec_ce)) + call RegPack(Buf, InData%pvec_ce) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! outVizXYPlane + call RegPack(Buf, allocated(InData%outVizXYPlane)) + if (allocated(InData%outVizXYPlane)) then + call RegPackBounds(Buf, 4, lbound(InData%outVizXYPlane), ubound(InData%outVizXYPlane)) + call RegPack(Buf, InData%outVizXYPlane) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! outVizYZPlane + call RegPack(Buf, allocated(InData%outVizYZPlane)) + if (allocated(InData%outVizYZPlane)) then + call RegPackBounds(Buf, 4, lbound(InData%outVizYZPlane), ubound(InData%outVizYZPlane)) + call RegPack(Buf, InData%outVizYZPlane) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! outVizXZPlane + call RegPack(Buf, allocated(InData%outVizXZPlane)) + if (allocated(InData%outVizXZPlane)) then + call RegPackBounds(Buf, 4, lbound(InData%outVizXZPlane), ubound(InData%outVizXZPlane)) + call RegPack(Buf, InData%outVizXZPlane) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! IfW + call RegPack(Buf, allocated(InData%IfW)) + if (allocated(InData%IfW)) then + call RegPackBounds(Buf, 1, lbound(InData%IfW), ubound(InData%IfW)) + LB(1:1) = lbound(InData%IfW) + UB(1:1) = ubound(InData%IfW) + do i1 = LB(1), UB(1) + call InflowWind_PackMisc(Buf, InData%IfW(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! u_IfW_Low + call InflowWind_PackInput(Buf, InData%u_IfW_Low) + if (RegCheckErr(Buf, RoutineName)) return + ! u_IfW_High + call InflowWind_PackInput(Buf, InData%u_IfW_High) + if (RegCheckErr(Buf, RoutineName)) return + ! y_IfW_Low + call InflowWind_PackOutput(Buf, InData%y_IfW_Low) + if (RegCheckErr(Buf, RoutineName)) return + ! y_IfW_High + call InflowWind_PackOutput(Buf, InData%y_IfW_High) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AWAE_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AWAE_UnPackMisc' + integer(IntKi) :: i1, i2, i3, i4 + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! Vamb_low + if (allocated(OutData%Vamb_low)) deallocate(OutData%Vamb_low) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vamb_low(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vamb_low.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vamb_low) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Vamb_lowpol + if (allocated(OutData%Vamb_lowpol)) deallocate(OutData%Vamb_lowpol) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vamb_lowpol(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vamb_lowpol.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vamb_lowpol) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Vdist_low + if (allocated(OutData%Vdist_low)) deallocate(OutData%Vdist_low) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vdist_low(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vdist_low.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vdist_low) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Vdist_low_full + if (allocated(OutData%Vdist_low_full)) deallocate(OutData%Vdist_low_full) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vdist_low_full(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vdist_low_full.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vdist_low_full) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Vamb_High + if (allocated(OutData%Vamb_High)) deallocate(OutData%Vamb_High) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vamb_High(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vamb_High.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AWAE_UnpackHighWindGrid(Buf, OutData%Vamb_High(i1)) ! Vamb_High + end do + end if + ! parallelFlag + if (allocated(OutData%parallelFlag)) deallocate(OutData%parallelFlag) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%parallelFlag(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%parallelFlag.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%parallelFlag) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! r_s + if (allocated(OutData%r_s)) deallocate(OutData%r_s) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%r_s(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_s.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%r_s) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! r_e + if (allocated(OutData%r_e)) deallocate(OutData%r_e) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%r_e(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_e.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%r_e) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! rhat_s + if (allocated(OutData%rhat_s)) deallocate(OutData%rhat_s) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rhat_s(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rhat_s.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rhat_s) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! rhat_e + if (allocated(OutData%rhat_e)) deallocate(OutData%rhat_e) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rhat_e(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rhat_e.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rhat_e) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! pvec_cs + if (allocated(OutData%pvec_cs)) deallocate(OutData%pvec_cs) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%pvec_cs(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%pvec_cs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%pvec_cs) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! pvec_ce + if (allocated(OutData%pvec_ce)) deallocate(OutData%pvec_ce) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%pvec_ce(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%pvec_ce.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%pvec_ce) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! outVizXYPlane + if (allocated(OutData%outVizXYPlane)) deallocate(OutData%outVizXYPlane) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%outVizXYPlane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%outVizXYPlane.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%outVizXYPlane) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! outVizYZPlane + if (allocated(OutData%outVizYZPlane)) deallocate(OutData%outVizYZPlane) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%outVizYZPlane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%outVizYZPlane.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%outVizYZPlane) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! outVizXZPlane + if (allocated(OutData%outVizXZPlane)) deallocate(OutData%outVizXZPlane) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%outVizXZPlane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%outVizXZPlane.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%outVizXZPlane) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! IfW + if (allocated(OutData%IfW)) deallocate(OutData%IfW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IfW(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackMisc(Buf, OutData%IfW(i1)) ! IfW + end do + end if + ! u_IfW_Low + call InflowWind_UnpackInput(Buf, OutData%u_IfW_Low) ! u_IfW_Low + ! u_IfW_High + call InflowWind_UnpackInput(Buf, OutData%u_IfW_High) ! u_IfW_High + ! y_IfW_Low + call InflowWind_UnpackOutput(Buf, OutData%y_IfW_Low) ! y_IfW_Low + ! y_IfW_High + call InflowWind_UnpackOutput(Buf, OutData%y_IfW_High) ! y_IfW_High +end subroutine SUBROUTINE AWAE_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(AWAE_ParameterType), INTENT(IN) :: SrcParamData TYPE(AWAE_ParameterType), INTENT(INOUT) :: DstParamData @@ -5727,997 +3073,583 @@ SUBROUTINE AWAE_DestroyParam( ParamData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE AWAE_DestroyParam - SUBROUTINE AWAE_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AWAE_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%WindFilePath) ! WindFilePath - Int_BufSz = Int_BufSz + 1 ! NumTurbines - Int_BufSz = Int_BufSz + 1 ! NumRadii - Int_BufSz = Int_BufSz + 1 ! NumPlanes - Int_BufSz = Int_BufSz + 1 ! y allocated yes/no - IF ( ALLOCATED(InData%y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%y) ! y - END IF - Int_BufSz = Int_BufSz + 1 ! z allocated yes/no - IF ( ALLOCATED(InData%z) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%z) ! z - END IF - Int_BufSz = Int_BufSz + 1 ! Mod_AmbWind - Int_BufSz = Int_BufSz + 1 ! nX_low - Int_BufSz = Int_BufSz + 1 ! nY_low - Int_BufSz = Int_BufSz + 1 ! nZ_low - Int_BufSz = Int_BufSz + 1 ! NumGrid_low - Int_BufSz = Int_BufSz + 1 ! n_rp_max - Re_BufSz = Re_BufSz + 1 ! dpol - Re_BufSz = Re_BufSz + SIZE(InData%dXYZ_low) ! dXYZ_low - Re_BufSz = Re_BufSz + 1 ! dX_low - Re_BufSz = Re_BufSz + 1 ! dY_low - Re_BufSz = Re_BufSz + 1 ! dZ_low - Re_BufSz = Re_BufSz + 1 ! X0_low - Re_BufSz = Re_BufSz + 1 ! Y0_low - Re_BufSz = Re_BufSz + 1 ! Z0_low - Int_BufSz = Int_BufSz + 1 ! X0_high allocated yes/no - IF ( ALLOCATED(InData%X0_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! X0_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%X0_high) ! X0_high - END IF - Int_BufSz = Int_BufSz + 1 ! Y0_high allocated yes/no - IF ( ALLOCATED(InData%Y0_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Y0_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Y0_high) ! Y0_high - END IF - Int_BufSz = Int_BufSz + 1 ! Z0_high allocated yes/no - IF ( ALLOCATED(InData%Z0_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Z0_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Z0_high) ! Z0_high - END IF - Int_BufSz = Int_BufSz + 1 ! dX_high allocated yes/no - IF ( ALLOCATED(InData%dX_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dX_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dX_high) ! dX_high - END IF - Int_BufSz = Int_BufSz + 1 ! dY_high allocated yes/no - IF ( ALLOCATED(InData%dY_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dY_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dY_high) ! dY_high - END IF - Int_BufSz = Int_BufSz + 1 ! dZ_high allocated yes/no - IF ( ALLOCATED(InData%dZ_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dZ_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dZ_high) ! dZ_high - END IF - Int_BufSz = Int_BufSz + 1 ! nX_high - Int_BufSz = Int_BufSz + 1 ! nY_high - Int_BufSz = Int_BufSz + 1 ! nZ_high - Int_BufSz = Int_BufSz + 1 ! Grid_low allocated yes/no - IF ( ALLOCATED(InData%Grid_low) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Grid_low upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Grid_low) ! Grid_low - END IF - Int_BufSz = Int_BufSz + 1 ! Grid_high allocated yes/no - IF ( ALLOCATED(InData%Grid_high) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Grid_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Grid_high) ! Grid_high - END IF - Int_BufSz = Int_BufSz + 1 ! WT_Position allocated yes/no - IF ( ALLOCATED(InData%WT_Position) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WT_Position upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WT_Position) ! WT_Position - END IF - Int_BufSz = Int_BufSz + 1 ! n_high_low - Db_BufSz = Db_BufSz + 1 ! dt_low - Db_BufSz = Db_BufSz + 1 ! dt_high - Int_BufSz = Int_BufSz + 1 ! NumDT - Int_BufSz = Int_BufSz + 1 ! Mod_Meander - Re_BufSz = Re_BufSz + 1 ! C_Meander - Re_BufSz = Re_BufSz + 1 ! C_ScaleDiam - Int_BufSz = Int_BufSz + 1 ! Mod_Projection - Int_BufSz = Int_BufSz + 1 ! IfW allocated yes/no - IF ( ALLOCATED(InData%IfW) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IfW upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%IfW,1), UBOUND(InData%IfW,1) - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%IfW(i1), ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! WrDisSkp1 - Int_BufSz = Int_BufSz + 1 ! WrDisWind - Int_BufSz = Int_BufSz + 1 ! NOutDisWindXY - Int_BufSz = Int_BufSz + 1 ! OutDisWindZ allocated yes/no - IF ( ALLOCATED(InData%OutDisWindZ) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutDisWindZ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OutDisWindZ) ! OutDisWindZ - END IF - Int_BufSz = Int_BufSz + 1 ! NOutDisWindYZ - Int_BufSz = Int_BufSz + 1 ! OutDisWindX allocated yes/no - IF ( ALLOCATED(InData%OutDisWindX) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutDisWindX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OutDisWindX) ! OutDisWindX - END IF - Int_BufSz = Int_BufSz + 1 ! NOutDisWindXZ - Int_BufSz = Int_BufSz + 1 ! OutDisWindY allocated yes/no - IF ( ALLOCATED(InData%OutDisWindY) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutDisWindY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OutDisWindY) ! OutDisWindY - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFileRoot) ! OutFileRoot - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFileVTKRoot) ! OutFileVTKRoot - Int_BufSz = Int_BufSz + 1 ! VTK_tWidth - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%WindFilePath) - IntKiBuf(Int_Xferred) = ICHAR(InData%WindFilePath(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%NumTurbines - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumRadii - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumPlanes - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) - ReKiBuf(Re_Xferred) = InData%y(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%z) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - ReKiBuf(Re_Xferred) = InData%z(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%Mod_AmbWind - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nX_low - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nY_low - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nZ_low - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumGrid_low - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%n_rp_max - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dpol - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%dXYZ_low,1), UBOUND(InData%dXYZ_low,1) - ReKiBuf(Re_Xferred) = InData%dXYZ_low(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%dX_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dY_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dZ_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%X0_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Y0_low - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Z0_low - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%X0_high) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%X0_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X0_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%X0_high,1), UBOUND(InData%X0_high,1) - ReKiBuf(Re_Xferred) = InData%X0_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Y0_high) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Y0_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y0_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Y0_high,1), UBOUND(InData%Y0_high,1) - ReKiBuf(Re_Xferred) = InData%Y0_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Z0_high) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Z0_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Z0_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Z0_high,1), UBOUND(InData%Z0_high,1) - ReKiBuf(Re_Xferred) = InData%Z0_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dX_high) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dX_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dX_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dX_high,1), UBOUND(InData%dX_high,1) - ReKiBuf(Re_Xferred) = InData%dX_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dY_high) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dY_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dY_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dY_high,1), UBOUND(InData%dY_high,1) - ReKiBuf(Re_Xferred) = InData%dY_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dZ_high) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dZ_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dZ_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dZ_high,1), UBOUND(InData%dZ_high,1) - ReKiBuf(Re_Xferred) = InData%dZ_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%nX_high - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nY_high - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nZ_high - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Grid_low) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Grid_low,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Grid_low,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Grid_low,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Grid_low,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Grid_low,2), UBOUND(InData%Grid_low,2) - DO i1 = LBOUND(InData%Grid_low,1), UBOUND(InData%Grid_low,1) - ReKiBuf(Re_Xferred) = InData%Grid_low(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Grid_high) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Grid_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Grid_high,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Grid_high,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Grid_high,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Grid_high,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Grid_high,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Grid_high,3), UBOUND(InData%Grid_high,3) - DO i2 = LBOUND(InData%Grid_high,2), UBOUND(InData%Grid_high,2) - DO i1 = LBOUND(InData%Grid_high,1), UBOUND(InData%Grid_high,1) - ReKiBuf(Re_Xferred) = InData%Grid_high(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WT_Position) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WT_Position,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WT_Position,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WT_Position,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WT_Position,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WT_Position,2), UBOUND(InData%WT_Position,2) - DO i1 = LBOUND(InData%WT_Position,1), UBOUND(InData%WT_Position,1) - ReKiBuf(Re_Xferred) = InData%WT_Position(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%n_high_low - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%dt_low - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%dt_high - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumDT - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Mod_Meander - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_Meander - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_ScaleDiam - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Mod_Projection - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%IfW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IfW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IfW,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IfW,1), UBOUND(InData%IfW,1) - CALL InflowWind_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%IfW(i1), ErrStat2, ErrMsg2, OnlySize ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IntKiBuf(Int_Xferred) = InData%WrDisSkp1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WrDisWind, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NOutDisWindXY - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutDisWindZ) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutDisWindZ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutDisWindZ,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutDisWindZ,1), UBOUND(InData%OutDisWindZ,1) - ReKiBuf(Re_Xferred) = InData%OutDisWindZ(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NOutDisWindYZ - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutDisWindX) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutDisWindX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutDisWindX,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutDisWindX,1), UBOUND(InData%OutDisWindX,1) - ReKiBuf(Re_Xferred) = InData%OutDisWindX(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NOutDisWindXZ - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutDisWindY) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutDisWindY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutDisWindY,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutDisWindY,1), UBOUND(InData%OutDisWindY,1) - ReKiBuf(Re_Xferred) = InData%OutDisWindY(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DO I = 1, LEN(InData%OutFileRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFileRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutFileVTKRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFileVTKRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%VTK_tWidth - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AWAE_PackParam - - SUBROUTINE AWAE_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AWAE_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%WindFilePath) - OutData%WindFilePath(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%NumTurbines = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumRadii = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumPlanes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%y)) DEALLOCATE(OutData%y) - ALLOCATE(OutData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) - OutData%y(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%z)) DEALLOCATE(OutData%z) - ALLOCATE(OutData%z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) - OutData%z(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Mod_AmbWind = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nX_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nY_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nZ_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumGrid_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%n_rp_max = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%dpol = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%dXYZ_low,1) - i1_u = UBOUND(OutData%dXYZ_low,1) - DO i1 = LBOUND(OutData%dXYZ_low,1), UBOUND(OutData%dXYZ_low,1) - OutData%dXYZ_low(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%dX_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dY_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dZ_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%X0_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Y0_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Z0_low = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X0_high not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%X0_high)) DEALLOCATE(OutData%X0_high) - ALLOCATE(OutData%X0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%X0_high,1), UBOUND(OutData%X0_high,1) - OutData%X0_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Y0_high not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Y0_high)) DEALLOCATE(OutData%Y0_high) - ALLOCATE(OutData%Y0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Y0_high,1), UBOUND(OutData%Y0_high,1) - OutData%Y0_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Z0_high not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Z0_high)) DEALLOCATE(OutData%Z0_high) - ALLOCATE(OutData%Z0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Z0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Z0_high,1), UBOUND(OutData%Z0_high,1) - OutData%Z0_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dX_high not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%dX_high)) DEALLOCATE(OutData%dX_high) - ALLOCATE(OutData%dX_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dX_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dX_high,1), UBOUND(OutData%dX_high,1) - OutData%dX_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dY_high not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%dY_high)) DEALLOCATE(OutData%dY_high) - ALLOCATE(OutData%dY_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dY_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dY_high,1), UBOUND(OutData%dY_high,1) - OutData%dY_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dZ_high not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%dZ_high)) DEALLOCATE(OutData%dZ_high) - ALLOCATE(OutData%dZ_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dZ_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dZ_high,1), UBOUND(OutData%dZ_high,1) - OutData%dZ_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%nX_high = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nY_high = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nZ_high = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Grid_low not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Grid_low)) DEALLOCATE(OutData%Grid_low) - ALLOCATE(OutData%Grid_low(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Grid_low.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Grid_low,2), UBOUND(OutData%Grid_low,2) - DO i1 = LBOUND(OutData%Grid_low,1), UBOUND(OutData%Grid_low,1) - OutData%Grid_low(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Grid_high not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Grid_high)) DEALLOCATE(OutData%Grid_high) - ALLOCATE(OutData%Grid_high(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Grid_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Grid_high,3), UBOUND(OutData%Grid_high,3) - DO i2 = LBOUND(OutData%Grid_high,2), UBOUND(OutData%Grid_high,2) - DO i1 = LBOUND(OutData%Grid_high,1), UBOUND(OutData%Grid_high,1) - OutData%Grid_high(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WT_Position not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WT_Position)) DEALLOCATE(OutData%WT_Position) - ALLOCATE(OutData%WT_Position(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WT_Position.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WT_Position,2), UBOUND(OutData%WT_Position,2) - DO i1 = LBOUND(OutData%WT_Position,1), UBOUND(OutData%WT_Position,1) - OutData%WT_Position(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%n_high_low = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%dt_low = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%dt_high = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%NumDT = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Mod_Meander = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_Meander = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_ScaleDiam = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Mod_Projection = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IfW not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IfW)) DEALLOCATE(OutData%IfW) - ALLOCATE(OutData%IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IfW,1), UBOUND(OutData%IfW,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%IfW(i1), ErrStat2, ErrMsg2 ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - OutData%WrDisSkp1 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WrDisWind = TRANSFER(IntKiBuf(Int_Xferred), OutData%WrDisWind) - Int_Xferred = Int_Xferred + 1 - OutData%NOutDisWindXY = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutDisWindZ not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutDisWindZ)) DEALLOCATE(OutData%OutDisWindZ) - ALLOCATE(OutData%OutDisWindZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutDisWindZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutDisWindZ,1), UBOUND(OutData%OutDisWindZ,1) - OutData%OutDisWindZ(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%NOutDisWindYZ = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutDisWindX not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutDisWindX)) DEALLOCATE(OutData%OutDisWindX) - ALLOCATE(OutData%OutDisWindX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutDisWindX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutDisWindX,1), UBOUND(OutData%OutDisWindX,1) - OutData%OutDisWindX(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%NOutDisWindXZ = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutDisWindY not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutDisWindY)) DEALLOCATE(OutData%OutDisWindY) - ALLOCATE(OutData%OutDisWindY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutDisWindY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutDisWindY,1), UBOUND(OutData%OutDisWindY,1) - OutData%OutDisWindY(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DO I = 1, LEN(OutData%OutFileRoot) - OutData%OutFileRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutFileVTKRoot) - OutData%OutFileVTKRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%VTK_tWidth = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AWAE_UnPackParam +subroutine AWAE_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AWAE_PackParam' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + if (Buf%ErrStat >= AbortErrLev) return + ! WindFilePath + call RegPack(Buf, InData%WindFilePath) + if (RegCheckErr(Buf, RoutineName)) return + ! NumTurbines + call RegPack(Buf, InData%NumTurbines) + if (RegCheckErr(Buf, RoutineName)) return + ! NumRadii + call RegPack(Buf, InData%NumRadii) + if (RegCheckErr(Buf, RoutineName)) return + ! NumPlanes + call RegPack(Buf, InData%NumPlanes) + if (RegCheckErr(Buf, RoutineName)) return + ! y + call RegPack(Buf, allocated(InData%y)) + if (allocated(InData%y)) then + call RegPackBounds(Buf, 1, lbound(InData%y), ubound(InData%y)) + call RegPack(Buf, InData%y) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! z + call RegPack(Buf, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(Buf, 1, lbound(InData%z), ubound(InData%z)) + call RegPack(Buf, InData%z) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Mod_AmbWind + call RegPack(Buf, InData%Mod_AmbWind) + if (RegCheckErr(Buf, RoutineName)) return + ! nX_low + call RegPack(Buf, InData%nX_low) + if (RegCheckErr(Buf, RoutineName)) return + ! nY_low + call RegPack(Buf, InData%nY_low) + if (RegCheckErr(Buf, RoutineName)) return + ! nZ_low + call RegPack(Buf, InData%nZ_low) + if (RegCheckErr(Buf, RoutineName)) return + ! NumGrid_low + call RegPack(Buf, InData%NumGrid_low) + if (RegCheckErr(Buf, RoutineName)) return + ! n_rp_max + call RegPack(Buf, InData%n_rp_max) + if (RegCheckErr(Buf, RoutineName)) return + ! dpol + call RegPack(Buf, InData%dpol) + if (RegCheckErr(Buf, RoutineName)) return + ! dXYZ_low + call RegPack(Buf, InData%dXYZ_low) + if (RegCheckErr(Buf, RoutineName)) return + ! dX_low + call RegPack(Buf, InData%dX_low) + if (RegCheckErr(Buf, RoutineName)) return + ! dY_low + call RegPack(Buf, InData%dY_low) + if (RegCheckErr(Buf, RoutineName)) return + ! dZ_low + call RegPack(Buf, InData%dZ_low) + if (RegCheckErr(Buf, RoutineName)) return + ! X0_low + call RegPack(Buf, InData%X0_low) + if (RegCheckErr(Buf, RoutineName)) return + ! Y0_low + call RegPack(Buf, InData%Y0_low) + if (RegCheckErr(Buf, RoutineName)) return + ! Z0_low + call RegPack(Buf, InData%Z0_low) + if (RegCheckErr(Buf, RoutineName)) return + ! X0_high + call RegPack(Buf, allocated(InData%X0_high)) + if (allocated(InData%X0_high)) then + call RegPackBounds(Buf, 1, lbound(InData%X0_high), ubound(InData%X0_high)) + call RegPack(Buf, InData%X0_high) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Y0_high + call RegPack(Buf, allocated(InData%Y0_high)) + if (allocated(InData%Y0_high)) then + call RegPackBounds(Buf, 1, lbound(InData%Y0_high), ubound(InData%Y0_high)) + call RegPack(Buf, InData%Y0_high) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Z0_high + call RegPack(Buf, allocated(InData%Z0_high)) + if (allocated(InData%Z0_high)) then + call RegPackBounds(Buf, 1, lbound(InData%Z0_high), ubound(InData%Z0_high)) + call RegPack(Buf, InData%Z0_high) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! dX_high + call RegPack(Buf, allocated(InData%dX_high)) + if (allocated(InData%dX_high)) then + call RegPackBounds(Buf, 1, lbound(InData%dX_high), ubound(InData%dX_high)) + call RegPack(Buf, InData%dX_high) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! dY_high + call RegPack(Buf, allocated(InData%dY_high)) + if (allocated(InData%dY_high)) then + call RegPackBounds(Buf, 1, lbound(InData%dY_high), ubound(InData%dY_high)) + call RegPack(Buf, InData%dY_high) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! dZ_high + call RegPack(Buf, allocated(InData%dZ_high)) + if (allocated(InData%dZ_high)) then + call RegPackBounds(Buf, 1, lbound(InData%dZ_high), ubound(InData%dZ_high)) + call RegPack(Buf, InData%dZ_high) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! nX_high + call RegPack(Buf, InData%nX_high) + if (RegCheckErr(Buf, RoutineName)) return + ! nY_high + call RegPack(Buf, InData%nY_high) + if (RegCheckErr(Buf, RoutineName)) return + ! nZ_high + call RegPack(Buf, InData%nZ_high) + if (RegCheckErr(Buf, RoutineName)) return + ! Grid_low + call RegPack(Buf, allocated(InData%Grid_low)) + if (allocated(InData%Grid_low)) then + call RegPackBounds(Buf, 2, lbound(InData%Grid_low), ubound(InData%Grid_low)) + call RegPack(Buf, InData%Grid_low) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Grid_high + call RegPack(Buf, allocated(InData%Grid_high)) + if (allocated(InData%Grid_high)) then + call RegPackBounds(Buf, 3, lbound(InData%Grid_high), ubound(InData%Grid_high)) + call RegPack(Buf, InData%Grid_high) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WT_Position + call RegPack(Buf, allocated(InData%WT_Position)) + if (allocated(InData%WT_Position)) then + call RegPackBounds(Buf, 2, lbound(InData%WT_Position), ubound(InData%WT_Position)) + call RegPack(Buf, InData%WT_Position) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! n_high_low + call RegPack(Buf, InData%n_high_low) + if (RegCheckErr(Buf, RoutineName)) return + ! dt_low + call RegPack(Buf, InData%dt_low) + if (RegCheckErr(Buf, RoutineName)) return + ! dt_high + call RegPack(Buf, InData%dt_high) + if (RegCheckErr(Buf, RoutineName)) return + ! NumDT + call RegPack(Buf, InData%NumDT) + if (RegCheckErr(Buf, RoutineName)) return + ! Mod_Meander + call RegPack(Buf, InData%Mod_Meander) + if (RegCheckErr(Buf, RoutineName)) return + ! C_Meander + call RegPack(Buf, InData%C_Meander) + if (RegCheckErr(Buf, RoutineName)) return + ! C_ScaleDiam + call RegPack(Buf, InData%C_ScaleDiam) + if (RegCheckErr(Buf, RoutineName)) return + ! Mod_Projection + call RegPack(Buf, InData%Mod_Projection) + if (RegCheckErr(Buf, RoutineName)) return + ! IfW + call RegPack(Buf, allocated(InData%IfW)) + if (allocated(InData%IfW)) then + call RegPackBounds(Buf, 1, lbound(InData%IfW), ubound(InData%IfW)) + LB(1:1) = lbound(InData%IfW) + UB(1:1) = ubound(InData%IfW) + do i1 = LB(1), UB(1) + call InflowWind_PackParam(Buf, InData%IfW(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WrDisSkp1 + call RegPack(Buf, InData%WrDisSkp1) + if (RegCheckErr(Buf, RoutineName)) return + ! WrDisWind + call RegPack(Buf, InData%WrDisWind) + if (RegCheckErr(Buf, RoutineName)) return + ! NOutDisWindXY + call RegPack(Buf, InData%NOutDisWindXY) + if (RegCheckErr(Buf, RoutineName)) return + ! OutDisWindZ + call RegPack(Buf, allocated(InData%OutDisWindZ)) + if (allocated(InData%OutDisWindZ)) then + call RegPackBounds(Buf, 1, lbound(InData%OutDisWindZ), ubound(InData%OutDisWindZ)) + call RegPack(Buf, InData%OutDisWindZ) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NOutDisWindYZ + call RegPack(Buf, InData%NOutDisWindYZ) + if (RegCheckErr(Buf, RoutineName)) return + ! OutDisWindX + call RegPack(Buf, allocated(InData%OutDisWindX)) + if (allocated(InData%OutDisWindX)) then + call RegPackBounds(Buf, 1, lbound(InData%OutDisWindX), ubound(InData%OutDisWindX)) + call RegPack(Buf, InData%OutDisWindX) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NOutDisWindXZ + call RegPack(Buf, InData%NOutDisWindXZ) + if (RegCheckErr(Buf, RoutineName)) return + ! OutDisWindY + call RegPack(Buf, allocated(InData%OutDisWindY)) + if (allocated(InData%OutDisWindY)) then + call RegPackBounds(Buf, 1, lbound(InData%OutDisWindY), ubound(InData%OutDisWindY)) + call RegPack(Buf, InData%OutDisWindY) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OutFileRoot + call RegPack(Buf, InData%OutFileRoot) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFileVTKRoot + call RegPack(Buf, InData%OutFileVTKRoot) + if (RegCheckErr(Buf, RoutineName)) return + ! VTK_tWidth + call RegPack(Buf, InData%VTK_tWidth) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AWAE_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AWAE_UnPackParam' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! WindFilePath + call RegUnpack(Buf, OutData%WindFilePath) + if (RegCheckErr(Buf, RoutineName)) return + ! NumTurbines + call RegUnpack(Buf, OutData%NumTurbines) + if (RegCheckErr(Buf, RoutineName)) return + ! NumRadii + call RegUnpack(Buf, OutData%NumRadii) + if (RegCheckErr(Buf, RoutineName)) return + ! NumPlanes + call RegUnpack(Buf, OutData%NumPlanes) + if (RegCheckErr(Buf, RoutineName)) return + ! y + if (allocated(OutData%y)) deallocate(OutData%y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%y) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! z + if (allocated(OutData%z)) deallocate(OutData%z) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%z) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Mod_AmbWind + call RegUnpack(Buf, OutData%Mod_AmbWind) + if (RegCheckErr(Buf, RoutineName)) return + ! nX_low + call RegUnpack(Buf, OutData%nX_low) + if (RegCheckErr(Buf, RoutineName)) return + ! nY_low + call RegUnpack(Buf, OutData%nY_low) + if (RegCheckErr(Buf, RoutineName)) return + ! nZ_low + call RegUnpack(Buf, OutData%nZ_low) + if (RegCheckErr(Buf, RoutineName)) return + ! NumGrid_low + call RegUnpack(Buf, OutData%NumGrid_low) + if (RegCheckErr(Buf, RoutineName)) return + ! n_rp_max + call RegUnpack(Buf, OutData%n_rp_max) + if (RegCheckErr(Buf, RoutineName)) return + ! dpol + call RegUnpack(Buf, OutData%dpol) + if (RegCheckErr(Buf, RoutineName)) return + ! dXYZ_low + call RegUnpack(Buf, OutData%dXYZ_low) + if (RegCheckErr(Buf, RoutineName)) return + ! dX_low + call RegUnpack(Buf, OutData%dX_low) + if (RegCheckErr(Buf, RoutineName)) return + ! dY_low + call RegUnpack(Buf, OutData%dY_low) + if (RegCheckErr(Buf, RoutineName)) return + ! dZ_low + call RegUnpack(Buf, OutData%dZ_low) + if (RegCheckErr(Buf, RoutineName)) return + ! X0_low + call RegUnpack(Buf, OutData%X0_low) + if (RegCheckErr(Buf, RoutineName)) return + ! Y0_low + call RegUnpack(Buf, OutData%Y0_low) + if (RegCheckErr(Buf, RoutineName)) return + ! Z0_low + call RegUnpack(Buf, OutData%Z0_low) + if (RegCheckErr(Buf, RoutineName)) return + ! X0_high + if (allocated(OutData%X0_high)) deallocate(OutData%X0_high) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%X0_high(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%X0_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%X0_high) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Y0_high + if (allocated(OutData%Y0_high)) deallocate(OutData%Y0_high) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Y0_high(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y0_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Y0_high) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Z0_high + if (allocated(OutData%Z0_high)) deallocate(OutData%Z0_high) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Z0_high(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Z0_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Z0_high) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! dX_high + if (allocated(OutData%dX_high)) deallocate(OutData%dX_high) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dX_high(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dX_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dX_high) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! dY_high + if (allocated(OutData%dY_high)) deallocate(OutData%dY_high) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dY_high(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dY_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dY_high) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! dZ_high + if (allocated(OutData%dZ_high)) deallocate(OutData%dZ_high) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dZ_high(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dZ_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dZ_high) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! nX_high + call RegUnpack(Buf, OutData%nX_high) + if (RegCheckErr(Buf, RoutineName)) return + ! nY_high + call RegUnpack(Buf, OutData%nY_high) + if (RegCheckErr(Buf, RoutineName)) return + ! nZ_high + call RegUnpack(Buf, OutData%nZ_high) + if (RegCheckErr(Buf, RoutineName)) return + ! Grid_low + if (allocated(OutData%Grid_low)) deallocate(OutData%Grid_low) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Grid_low(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Grid_low.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Grid_low) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Grid_high + if (allocated(OutData%Grid_high)) deallocate(OutData%Grid_high) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Grid_high(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Grid_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Grid_high) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WT_Position + if (allocated(OutData%WT_Position)) deallocate(OutData%WT_Position) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WT_Position(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WT_Position.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WT_Position) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! n_high_low + call RegUnpack(Buf, OutData%n_high_low) + if (RegCheckErr(Buf, RoutineName)) return + ! dt_low + call RegUnpack(Buf, OutData%dt_low) + if (RegCheckErr(Buf, RoutineName)) return + ! dt_high + call RegUnpack(Buf, OutData%dt_high) + if (RegCheckErr(Buf, RoutineName)) return + ! NumDT + call RegUnpack(Buf, OutData%NumDT) + if (RegCheckErr(Buf, RoutineName)) return + ! Mod_Meander + call RegUnpack(Buf, OutData%Mod_Meander) + if (RegCheckErr(Buf, RoutineName)) return + ! C_Meander + call RegUnpack(Buf, OutData%C_Meander) + if (RegCheckErr(Buf, RoutineName)) return + ! C_ScaleDiam + call RegUnpack(Buf, OutData%C_ScaleDiam) + if (RegCheckErr(Buf, RoutineName)) return + ! Mod_Projection + call RegUnpack(Buf, OutData%Mod_Projection) + if (RegCheckErr(Buf, RoutineName)) return + ! IfW + if (allocated(OutData%IfW)) deallocate(OutData%IfW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IfW(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IfW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackParam(Buf, OutData%IfW(i1)) ! IfW + end do + end if + ! WrDisSkp1 + call RegUnpack(Buf, OutData%WrDisSkp1) + if (RegCheckErr(Buf, RoutineName)) return + ! WrDisWind + call RegUnpack(Buf, OutData%WrDisWind) + if (RegCheckErr(Buf, RoutineName)) return + ! NOutDisWindXY + call RegUnpack(Buf, OutData%NOutDisWindXY) + if (RegCheckErr(Buf, RoutineName)) return + ! OutDisWindZ + if (allocated(OutData%OutDisWindZ)) deallocate(OutData%OutDisWindZ) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutDisWindZ(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutDisWindZ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutDisWindZ) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NOutDisWindYZ + call RegUnpack(Buf, OutData%NOutDisWindYZ) + if (RegCheckErr(Buf, RoutineName)) return + ! OutDisWindX + if (allocated(OutData%OutDisWindX)) deallocate(OutData%OutDisWindX) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutDisWindX(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutDisWindX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutDisWindX) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NOutDisWindXZ + call RegUnpack(Buf, OutData%NOutDisWindXZ) + if (RegCheckErr(Buf, RoutineName)) return + ! OutDisWindY + if (allocated(OutData%OutDisWindY)) deallocate(OutData%OutDisWindY) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutDisWindY(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutDisWindY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutDisWindY) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! OutFileRoot + call RegUnpack(Buf, OutData%OutFileRoot) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFileVTKRoot + call RegUnpack(Buf, OutData%OutFileVTKRoot) + if (RegCheckErr(Buf, RoutineName)) return + ! VTK_tWidth + call RegUnpack(Buf, OutData%VTK_tWidth) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE AWAE_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(AWAE_OutputType), INTENT(IN) :: SrcOutputData TYPE(AWAE_OutputType), INTENT(INOUT) :: DstOutputData @@ -6824,356 +3756,119 @@ SUBROUTINE AWAE_DestroyOutput( OutputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE AWAE_DestroyOutput - SUBROUTINE AWAE_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AWAE_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! Vdist_High allocated yes/no - IF ( ALLOCATED(InData%Vdist_High) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Vdist_High upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%Vdist_High,1), UBOUND(InData%Vdist_High,1) - Int_BufSz = Int_BufSz + 3 ! Vdist_High: size of buffers for each call to pack subtype - CALL AWAE_PackHighWindGrid( Re_Buf, Db_Buf, Int_Buf, InData%Vdist_High(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Vdist_High - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Vdist_High - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Vdist_High - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Vdist_High - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! V_plane allocated yes/no - IF ( ALLOCATED(InData%V_plane) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! V_plane upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%V_plane) ! V_plane - END IF - Int_BufSz = Int_BufSz + 1 ! TI_amb allocated yes/no - IF ( ALLOCATED(InData%TI_amb) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TI_amb upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TI_amb) ! TI_amb - END IF - Int_BufSz = Int_BufSz + 1 ! Vx_wind_disk allocated yes/no - IF ( ALLOCATED(InData%Vx_wind_disk) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Vx_wind_disk upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vx_wind_disk) ! Vx_wind_disk - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%Vdist_High) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vdist_High,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vdist_High,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Vdist_High,1), UBOUND(InData%Vdist_High,1) - CALL AWAE_PackHighWindGrid( Re_Buf, Db_Buf, Int_Buf, InData%Vdist_High(i1), ErrStat2, ErrMsg2, OnlySize ) ! Vdist_High - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%V_plane) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%V_plane,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V_plane,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%V_plane,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V_plane,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%V_plane,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V_plane,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%V_plane,3), UBOUND(InData%V_plane,3) - DO i2 = LBOUND(InData%V_plane,2), UBOUND(InData%V_plane,2) - DO i1 = LBOUND(InData%V_plane,1), UBOUND(InData%V_plane,1) - ReKiBuf(Re_Xferred) = InData%V_plane(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TI_amb) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TI_amb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI_amb,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TI_amb,1), UBOUND(InData%TI_amb,1) - ReKiBuf(Re_Xferred) = InData%TI_amb(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vx_wind_disk) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vx_wind_disk,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_wind_disk,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Vx_wind_disk,1), UBOUND(InData%Vx_wind_disk,1) - ReKiBuf(Re_Xferred) = InData%Vx_wind_disk(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AWAE_PackOutput - - SUBROUTINE AWAE_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AWAE_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vdist_High not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vdist_High)) DEALLOCATE(OutData%Vdist_High) - ALLOCATE(OutData%Vdist_High(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vdist_High.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Vdist_High,1), UBOUND(OutData%Vdist_High,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AWAE_UnpackHighWindGrid( Re_Buf, Db_Buf, Int_Buf, OutData%Vdist_High(i1), ErrStat2, ErrMsg2 ) ! Vdist_High - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! V_plane not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%V_plane)) DEALLOCATE(OutData%V_plane) - ALLOCATE(OutData%V_plane(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%V_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%V_plane,3), UBOUND(OutData%V_plane,3) - DO i2 = LBOUND(OutData%V_plane,2), UBOUND(OutData%V_plane,2) - DO i1 = LBOUND(OutData%V_plane,1), UBOUND(OutData%V_plane,1) - OutData%V_plane(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TI_amb not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TI_amb)) DEALLOCATE(OutData%TI_amb) - ALLOCATE(OutData%TI_amb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI_amb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TI_amb,1), UBOUND(OutData%TI_amb,1) - OutData%TI_amb(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vx_wind_disk not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vx_wind_disk)) DEALLOCATE(OutData%Vx_wind_disk) - ALLOCATE(OutData%Vx_wind_disk(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_wind_disk.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Vx_wind_disk,1), UBOUND(OutData%Vx_wind_disk,1) - OutData%Vx_wind_disk(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE AWAE_UnPackOutput +subroutine AWAE_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AWAE_PackOutput' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + if (Buf%ErrStat >= AbortErrLev) return + ! Vdist_High + call RegPack(Buf, allocated(InData%Vdist_High)) + if (allocated(InData%Vdist_High)) then + call RegPackBounds(Buf, 1, lbound(InData%Vdist_High), ubound(InData%Vdist_High)) + LB(1:1) = lbound(InData%Vdist_High) + UB(1:1) = ubound(InData%Vdist_High) + do i1 = LB(1), UB(1) + call AWAE_PackHighWindGrid(Buf, InData%Vdist_High(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! V_plane + call RegPack(Buf, allocated(InData%V_plane)) + if (allocated(InData%V_plane)) then + call RegPackBounds(Buf, 3, lbound(InData%V_plane), ubound(InData%V_plane)) + call RegPack(Buf, InData%V_plane) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TI_amb + call RegPack(Buf, allocated(InData%TI_amb)) + if (allocated(InData%TI_amb)) then + call RegPackBounds(Buf, 1, lbound(InData%TI_amb), ubound(InData%TI_amb)) + call RegPack(Buf, InData%TI_amb) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Vx_wind_disk + call RegPack(Buf, allocated(InData%Vx_wind_disk)) + if (allocated(InData%Vx_wind_disk)) then + call RegPackBounds(Buf, 1, lbound(InData%Vx_wind_disk), ubound(InData%Vx_wind_disk)) + call RegPack(Buf, InData%Vx_wind_disk) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AWAE_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AWAE_UnPackOutput' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! Vdist_High + if (allocated(OutData%Vdist_High)) deallocate(OutData%Vdist_High) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vdist_High(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vdist_High.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AWAE_UnpackHighWindGrid(Buf, OutData%Vdist_High(i1)) ! Vdist_High + end do + end if + ! V_plane + if (allocated(OutData%V_plane)) deallocate(OutData%V_plane) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%V_plane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%V_plane.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%V_plane) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TI_amb + if (allocated(OutData%TI_amb)) deallocate(OutData%TI_amb) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TI_amb(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI_amb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TI_amb) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Vx_wind_disk + if (allocated(OutData%Vx_wind_disk)) deallocate(OutData%Vx_wind_disk) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vx_wind_disk(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_wind_disk.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vx_wind_disk) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE AWAE_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(AWAE_InputType), INTENT(IN) :: SrcInputData TYPE(AWAE_InputType), INTENT(INOUT) :: DstInputData @@ -7346,527 +4041,176 @@ SUBROUTINE AWAE_DestroyInput( InputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE AWAE_DestroyInput - SUBROUTINE AWAE_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AWAE_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! xhat_plane allocated yes/no - IF ( ALLOCATED(InData%xhat_plane) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! xhat_plane upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%xhat_plane) ! xhat_plane - END IF - Int_BufSz = Int_BufSz + 1 ! p_plane allocated yes/no - IF ( ALLOCATED(InData%p_plane) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! p_plane upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%p_plane) ! p_plane - END IF - Int_BufSz = Int_BufSz + 1 ! Vx_wake allocated yes/no - IF ( ALLOCATED(InData%Vx_wake) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Vx_wake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vx_wake) ! Vx_wake - END IF - Int_BufSz = Int_BufSz + 1 ! Vy_wake allocated yes/no - IF ( ALLOCATED(InData%Vy_wake) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Vy_wake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vy_wake) ! Vy_wake - END IF - Int_BufSz = Int_BufSz + 1 ! Vz_wake allocated yes/no - IF ( ALLOCATED(InData%Vz_wake) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Vz_wake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vz_wake) ! Vz_wake - END IF - Int_BufSz = Int_BufSz + 1 ! D_wake allocated yes/no - IF ( ALLOCATED(InData%D_wake) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! D_wake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%D_wake) ! D_wake - END IF - Int_BufSz = Int_BufSz + 1 ! WAT_k_mt allocated yes/no - IF ( ALLOCATED(InData%WAT_k_mt) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WAT_k_mt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WAT_k_mt) ! WAT_k_mt - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%xhat_plane) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xhat_plane,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xhat_plane,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xhat_plane,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xhat_plane,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xhat_plane,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xhat_plane,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%xhat_plane,3), UBOUND(InData%xhat_plane,3) - DO i2 = LBOUND(InData%xhat_plane,2), UBOUND(InData%xhat_plane,2) - DO i1 = LBOUND(InData%xhat_plane,1), UBOUND(InData%xhat_plane,1) - ReKiBuf(Re_Xferred) = InData%xhat_plane(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%p_plane) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%p_plane,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%p_plane,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%p_plane,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%p_plane,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%p_plane,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%p_plane,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%p_plane,3), UBOUND(InData%p_plane,3) - DO i2 = LBOUND(InData%p_plane,2), UBOUND(InData%p_plane,2) - DO i1 = LBOUND(InData%p_plane,1), UBOUND(InData%p_plane,1) - ReKiBuf(Re_Xferred) = InData%p_plane(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vx_wake) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vx_wake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_wake,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vx_wake,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_wake,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vx_wake,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_wake,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vx_wake,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_wake,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Vx_wake,4), UBOUND(InData%Vx_wake,4) - DO i3 = LBOUND(InData%Vx_wake,3), UBOUND(InData%Vx_wake,3) - DO i2 = LBOUND(InData%Vx_wake,2), UBOUND(InData%Vx_wake,2) - DO i1 = LBOUND(InData%Vx_wake,1), UBOUND(InData%Vx_wake,1) - ReKiBuf(Re_Xferred) = InData%Vx_wake(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vy_wake) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vy_wake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vy_wake,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vy_wake,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vy_wake,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vy_wake,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vy_wake,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vy_wake,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vy_wake,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Vy_wake,4), UBOUND(InData%Vy_wake,4) - DO i3 = LBOUND(InData%Vy_wake,3), UBOUND(InData%Vy_wake,3) - DO i2 = LBOUND(InData%Vy_wake,2), UBOUND(InData%Vy_wake,2) - DO i1 = LBOUND(InData%Vy_wake,1), UBOUND(InData%Vy_wake,1) - ReKiBuf(Re_Xferred) = InData%Vy_wake(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vz_wake) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vz_wake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vz_wake,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vz_wake,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vz_wake,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vz_wake,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vz_wake,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vz_wake,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vz_wake,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Vz_wake,4), UBOUND(InData%Vz_wake,4) - DO i3 = LBOUND(InData%Vz_wake,3), UBOUND(InData%Vz_wake,3) - DO i2 = LBOUND(InData%Vz_wake,2), UBOUND(InData%Vz_wake,2) - DO i1 = LBOUND(InData%Vz_wake,1), UBOUND(InData%Vz_wake,1) - ReKiBuf(Re_Xferred) = InData%Vz_wake(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%D_wake) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%D_wake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_wake,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%D_wake,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_wake,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%D_wake,2), UBOUND(InData%D_wake,2) - DO i1 = LBOUND(InData%D_wake,1), UBOUND(InData%D_wake,1) - ReKiBuf(Re_Xferred) = InData%D_wake(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WAT_k_mt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WAT_k_mt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAT_k_mt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WAT_k_mt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAT_k_mt,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WAT_k_mt,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAT_k_mt,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WAT_k_mt,3), UBOUND(InData%WAT_k_mt,3) - DO i2 = LBOUND(InData%WAT_k_mt,2), UBOUND(InData%WAT_k_mt,2) - DO i1 = LBOUND(InData%WAT_k_mt,1), UBOUND(InData%WAT_k_mt,1) - ReKiBuf(Re_Xferred) = InData%WAT_k_mt(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE AWAE_PackInput - - SUBROUTINE AWAE_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AWAE_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xhat_plane not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%xhat_plane)) DEALLOCATE(OutData%xhat_plane) - ALLOCATE(OutData%xhat_plane(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xhat_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%xhat_plane,3), UBOUND(OutData%xhat_plane,3) - DO i2 = LBOUND(OutData%xhat_plane,2), UBOUND(OutData%xhat_plane,2) - DO i1 = LBOUND(OutData%xhat_plane,1), UBOUND(OutData%xhat_plane,1) - OutData%xhat_plane(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! p_plane not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%p_plane)) DEALLOCATE(OutData%p_plane) - ALLOCATE(OutData%p_plane(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%p_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%p_plane,3), UBOUND(OutData%p_plane,3) - DO i2 = LBOUND(OutData%p_plane,2), UBOUND(OutData%p_plane,2) - DO i1 = LBOUND(OutData%p_plane,1), UBOUND(OutData%p_plane,1) - OutData%p_plane(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vx_wake not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vx_wake)) DEALLOCATE(OutData%Vx_wake) - ALLOCATE(OutData%Vx_wake(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Vx_wake,4), UBOUND(OutData%Vx_wake,4) - DO i3 = LBOUND(OutData%Vx_wake,3), UBOUND(OutData%Vx_wake,3) - DO i2 = LBOUND(OutData%Vx_wake,2), UBOUND(OutData%Vx_wake,2) - DO i1 = LBOUND(OutData%Vx_wake,1), UBOUND(OutData%Vx_wake,1) - OutData%Vx_wake(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vy_wake not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vy_wake)) DEALLOCATE(OutData%Vy_wake) - ALLOCATE(OutData%Vy_wake(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vy_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Vy_wake,4), UBOUND(OutData%Vy_wake,4) - DO i3 = LBOUND(OutData%Vy_wake,3), UBOUND(OutData%Vy_wake,3) - DO i2 = LBOUND(OutData%Vy_wake,2), UBOUND(OutData%Vy_wake,2) - DO i1 = LBOUND(OutData%Vy_wake,1), UBOUND(OutData%Vy_wake,1) - OutData%Vy_wake(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vz_wake not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vz_wake)) DEALLOCATE(OutData%Vz_wake) - ALLOCATE(OutData%Vz_wake(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vz_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Vz_wake,4), UBOUND(OutData%Vz_wake,4) - DO i3 = LBOUND(OutData%Vz_wake,3), UBOUND(OutData%Vz_wake,3) - DO i2 = LBOUND(OutData%Vz_wake,2), UBOUND(OutData%Vz_wake,2) - DO i1 = LBOUND(OutData%Vz_wake,1), UBOUND(OutData%Vz_wake,1) - OutData%Vz_wake(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_wake not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%D_wake)) DEALLOCATE(OutData%D_wake) - ALLOCATE(OutData%D_wake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%D_wake,2), UBOUND(OutData%D_wake,2) - DO i1 = LBOUND(OutData%D_wake,1), UBOUND(OutData%D_wake,1) - OutData%D_wake(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WAT_k_mt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WAT_k_mt)) DEALLOCATE(OutData%WAT_k_mt) - ALLOCATE(OutData%WAT_k_mt(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAT_k_mt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WAT_k_mt,3), UBOUND(OutData%WAT_k_mt,3) - DO i2 = LBOUND(OutData%WAT_k_mt,2), UBOUND(OutData%WAT_k_mt,2) - DO i1 = LBOUND(OutData%WAT_k_mt,1), UBOUND(OutData%WAT_k_mt,1) - OutData%WAT_k_mt(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE AWAE_UnPackInput +subroutine AWAE_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'AWAE_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + ! xhat_plane + call RegPack(Buf, allocated(InData%xhat_plane)) + if (allocated(InData%xhat_plane)) then + call RegPackBounds(Buf, 3, lbound(InData%xhat_plane), ubound(InData%xhat_plane)) + call RegPack(Buf, InData%xhat_plane) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! p_plane + call RegPack(Buf, allocated(InData%p_plane)) + if (allocated(InData%p_plane)) then + call RegPackBounds(Buf, 3, lbound(InData%p_plane), ubound(InData%p_plane)) + call RegPack(Buf, InData%p_plane) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Vx_wake + call RegPack(Buf, allocated(InData%Vx_wake)) + if (allocated(InData%Vx_wake)) then + call RegPackBounds(Buf, 4, lbound(InData%Vx_wake), ubound(InData%Vx_wake)) + call RegPack(Buf, InData%Vx_wake) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Vy_wake + call RegPack(Buf, allocated(InData%Vy_wake)) + if (allocated(InData%Vy_wake)) then + call RegPackBounds(Buf, 4, lbound(InData%Vy_wake), ubound(InData%Vy_wake)) + call RegPack(Buf, InData%Vy_wake) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Vz_wake + call RegPack(Buf, allocated(InData%Vz_wake)) + if (allocated(InData%Vz_wake)) then + call RegPackBounds(Buf, 4, lbound(InData%Vz_wake), ubound(InData%Vz_wake)) + call RegPack(Buf, InData%Vz_wake) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! D_wake + call RegPack(Buf, allocated(InData%D_wake)) + if (allocated(InData%D_wake)) then + call RegPackBounds(Buf, 2, lbound(InData%D_wake), ubound(InData%D_wake)) + call RegPack(Buf, InData%D_wake) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WAT_k_mt + call RegPack(Buf, allocated(InData%WAT_k_mt)) + if (allocated(InData%WAT_k_mt)) then + call RegPackBounds(Buf, 3, lbound(InData%WAT_k_mt), ubound(InData%WAT_k_mt)) + call RegPack(Buf, InData%WAT_k_mt) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine AWAE_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AWAE_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AWAE_UnPackInput' + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! xhat_plane + if (allocated(OutData%xhat_plane)) deallocate(OutData%xhat_plane) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xhat_plane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xhat_plane.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%xhat_plane) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! p_plane + if (allocated(OutData%p_plane)) deallocate(OutData%p_plane) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%p_plane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%p_plane.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%p_plane) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Vx_wake + if (allocated(OutData%Vx_wake)) deallocate(OutData%Vx_wake) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vx_wake(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_wake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vx_wake) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Vy_wake + if (allocated(OutData%Vy_wake)) deallocate(OutData%Vy_wake) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vy_wake(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vy_wake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vy_wake) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Vz_wake + if (allocated(OutData%Vz_wake)) deallocate(OutData%Vz_wake) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vz_wake(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vz_wake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vz_wake) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! D_wake + if (allocated(OutData%D_wake)) deallocate(OutData%D_wake) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%D_wake(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_wake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%D_wake) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WAT_k_mt + if (allocated(OutData%WAT_k_mt)) deallocate(OutData%WAT_k_mt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WAT_k_mt(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAT_k_mt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WAT_k_mt) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine END MODULE AWAE_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/beamdyn/src/BeamDyn_Types.f90 b/modules/beamdyn/src/BeamDyn_Types.f90 index c560461ac2..a7b2bf1219 100644 --- a/modules/beamdyn/src/BeamDyn_Types.f90 +++ b/modules/beamdyn/src/BeamDyn_Types.f90 @@ -379,234 +379,92 @@ SUBROUTINE BD_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) END SUBROUTINE BD_DestroyInitInput - SUBROUTINE BD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(BD_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%InputFile) ! InputFile - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Re_BufSz = Re_BufSz + SIZE(InData%gravity) ! gravity - Re_BufSz = Re_BufSz + SIZE(InData%GlbPos) ! GlbPos - Db_BufSz = Db_BufSz + SIZE(InData%GlbRot) ! GlbRot - Db_BufSz = Db_BufSz + SIZE(InData%RootDisp) ! RootDisp - Db_BufSz = Db_BufSz + SIZE(InData%RootOri) ! RootOri - Re_BufSz = Re_BufSz + SIZE(InData%RootVel) ! RootVel - Re_BufSz = Re_BufSz + SIZE(InData%HubPos) ! HubPos - Db_BufSz = Db_BufSz + SIZE(InData%HubRot) ! HubRot - Int_BufSz = Int_BufSz + 1 ! Linearize - Int_BufSz = Int_BufSz + 1 ! DynamicSolve - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO i1 = LBOUND(InData%gravity,1), UBOUND(InData%gravity,1) - ReKiBuf(Re_Xferred) = InData%gravity(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%GlbPos,1), UBOUND(InData%GlbPos,1) - ReKiBuf(Re_Xferred) = InData%GlbPos(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i2 = LBOUND(InData%GlbRot,2), UBOUND(InData%GlbRot,2) - DO i1 = LBOUND(InData%GlbRot,1), UBOUND(InData%GlbRot,1) - DbKiBuf(Db_Xferred) = InData%GlbRot(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DO i1 = LBOUND(InData%RootDisp,1), UBOUND(InData%RootDisp,1) - DbKiBuf(Db_Xferred) = InData%RootDisp(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i2 = LBOUND(InData%RootOri,2), UBOUND(InData%RootOri,2) - DO i1 = LBOUND(InData%RootOri,1), UBOUND(InData%RootOri,1) - DbKiBuf(Db_Xferred) = InData%RootOri(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DO i1 = LBOUND(InData%RootVel,1), UBOUND(InData%RootVel,1) - ReKiBuf(Re_Xferred) = InData%RootVel(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%HubPos,1), UBOUND(InData%HubPos,1) - ReKiBuf(Re_Xferred) = InData%HubPos(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i2 = LBOUND(InData%HubRot,2), UBOUND(InData%HubRot,2) - DO i1 = LBOUND(InData%HubRot,1), UBOUND(InData%HubRot,1) - DbKiBuf(Db_Xferred) = InData%HubRot(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%DynamicSolve, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE BD_PackInitInput - - SUBROUTINE BD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(BD_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - i1_l = LBOUND(OutData%gravity,1) - i1_u = UBOUND(OutData%gravity,1) - DO i1 = LBOUND(OutData%gravity,1), UBOUND(OutData%gravity,1) - OutData%gravity(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%GlbPos,1) - i1_u = UBOUND(OutData%GlbPos,1) - DO i1 = LBOUND(OutData%GlbPos,1), UBOUND(OutData%GlbPos,1) - OutData%GlbPos(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%GlbRot,1) - i1_u = UBOUND(OutData%GlbRot,1) - i2_l = LBOUND(OutData%GlbRot,2) - i2_u = UBOUND(OutData%GlbRot,2) - DO i2 = LBOUND(OutData%GlbRot,2), UBOUND(OutData%GlbRot,2) - DO i1 = LBOUND(OutData%GlbRot,1), UBOUND(OutData%GlbRot,1) - OutData%GlbRot(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%RootDisp,1) - i1_u = UBOUND(OutData%RootDisp,1) - DO i1 = LBOUND(OutData%RootDisp,1), UBOUND(OutData%RootDisp,1) - OutData%RootDisp(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%RootOri,1) - i1_u = UBOUND(OutData%RootOri,1) - i2_l = LBOUND(OutData%RootOri,2) - i2_u = UBOUND(OutData%RootOri,2) - DO i2 = LBOUND(OutData%RootOri,2), UBOUND(OutData%RootOri,2) - DO i1 = LBOUND(OutData%RootOri,1), UBOUND(OutData%RootOri,1) - OutData%RootOri(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%RootVel,1) - i1_u = UBOUND(OutData%RootVel,1) - DO i1 = LBOUND(OutData%RootVel,1), UBOUND(OutData%RootVel,1) - OutData%RootVel(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%HubPos,1) - i1_u = UBOUND(OutData%HubPos,1) - DO i1 = LBOUND(OutData%HubPos,1), UBOUND(OutData%HubPos,1) - OutData%HubPos(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%HubRot,1) - i1_u = UBOUND(OutData%HubRot,1) - i2_l = LBOUND(OutData%HubRot,2) - i2_u = UBOUND(OutData%HubRot,2) - DO i2 = LBOUND(OutData%HubRot,2), UBOUND(OutData%HubRot,2) - DO i1 = LBOUND(OutData%HubRot,1), UBOUND(OutData%HubRot,1) - OutData%HubRot(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) - Int_Xferred = Int_Xferred + 1 - OutData%DynamicSolve = TRANSFER(IntKiBuf(Int_Xferred), OutData%DynamicSolve) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE BD_UnPackInitInput +subroutine BD_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BD_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BD_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + ! InputFile + call RegPack(Buf, InData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegPack(Buf, InData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! gravity + call RegPack(Buf, InData%gravity) + if (RegCheckErr(Buf, RoutineName)) return + ! GlbPos + call RegPack(Buf, InData%GlbPos) + if (RegCheckErr(Buf, RoutineName)) return + ! GlbRot + call RegPack(Buf, InData%GlbRot) + if (RegCheckErr(Buf, RoutineName)) return + ! RootDisp + call RegPack(Buf, InData%RootDisp) + if (RegCheckErr(Buf, RoutineName)) return + ! RootOri + call RegPack(Buf, InData%RootOri) + if (RegCheckErr(Buf, RoutineName)) return + ! RootVel + call RegPack(Buf, InData%RootVel) + if (RegCheckErr(Buf, RoutineName)) return + ! HubPos + call RegPack(Buf, InData%HubPos) + if (RegCheckErr(Buf, RoutineName)) return + ! HubRot + call RegPack(Buf, InData%HubRot) + if (RegCheckErr(Buf, RoutineName)) return + ! Linearize + call RegPack(Buf, InData%Linearize) + if (RegCheckErr(Buf, RoutineName)) return + ! DynamicSolve + call RegPack(Buf, InData%DynamicSolve) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BD_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BD_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BD_UnPackInitInput' + if (Buf%ErrStat /= ErrID_None) return + ! InputFile + call RegUnpack(Buf, OutData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! gravity + call RegUnpack(Buf, OutData%gravity) + if (RegCheckErr(Buf, RoutineName)) return + ! GlbPos + call RegUnpack(Buf, OutData%GlbPos) + if (RegCheckErr(Buf, RoutineName)) return + ! GlbRot + call RegUnpack(Buf, OutData%GlbRot) + if (RegCheckErr(Buf, RoutineName)) return + ! RootDisp + call RegUnpack(Buf, OutData%RootDisp) + if (RegCheckErr(Buf, RoutineName)) return + ! RootOri + call RegUnpack(Buf, OutData%RootOri) + if (RegCheckErr(Buf, RoutineName)) return + ! RootVel + call RegUnpack(Buf, OutData%RootVel) + if (RegCheckErr(Buf, RoutineName)) return + ! HubPos + call RegUnpack(Buf, OutData%HubPos) + if (RegCheckErr(Buf, RoutineName)) return + ! HubRot + call RegUnpack(Buf, OutData%HubRot) + if (RegCheckErr(Buf, RoutineName)) return + ! Linearize + call RegUnpack(Buf, OutData%Linearize) + if (RegCheckErr(Buf, RoutineName)) return + ! DynamicSolve + call RegUnpack(Buf, OutData%DynamicSolve) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE BD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(BD_InitOutputType), INTENT(IN) :: SrcInitOutputData TYPE(BD_InitOutputType), INTENT(INOUT) :: DstInitOutputData @@ -813,639 +671,276 @@ SUBROUTINE BD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE BD_DestroyInitOutput - SUBROUTINE BD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(BD_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! WriteOutputHdr allocated yes/no - IF ( ALLOCATED(InData%WriteOutputHdr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdr upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdr)*LEN(InData%WriteOutputHdr) ! WriteOutputHdr - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputUnt allocated yes/no - IF ( ALLOCATED(InData%WriteOutputUnt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUnt upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUnt)*LEN(InData%WriteOutputUnt) ! WriteOutputUnt - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! kp_coordinate allocated yes/no - IF ( ALLOCATED(InData%kp_coordinate) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! kp_coordinate upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%kp_coordinate) ! kp_coordinate - END IF - Int_BufSz = Int_BufSz + 1 ! kp_total - Int_BufSz = Int_BufSz + 1 ! LinNames_y allocated yes/no - IF ( ALLOCATED(InData%LinNames_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_y)*LEN(InData%LinNames_y) ! LinNames_y - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_x allocated yes/no - IF ( ALLOCATED(InData%LinNames_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_x)*LEN(InData%LinNames_x) ! LinNames_x - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_u allocated yes/no - IF ( ALLOCATED(InData%LinNames_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_u)*LEN(InData%LinNames_u) ! LinNames_u - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_y allocated yes/no - IF ( ALLOCATED(InData%RotFrame_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_y) ! RotFrame_y - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_x allocated yes/no - IF ( ALLOCATED(InData%RotFrame_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_x) ! RotFrame_x - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_u allocated yes/no - IF ( ALLOCATED(InData%RotFrame_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_u) ! RotFrame_u - END IF - Int_BufSz = Int_BufSz + 1 ! IsLoad_u allocated yes/no - IF ( ALLOCATED(InData%IsLoad_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IsLoad_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IsLoad_u) ! IsLoad_u - END IF - Int_BufSz = Int_BufSz + 1 ! DerivOrder_x allocated yes/no - IF ( ALLOCATED(InData%DerivOrder_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DerivOrder_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%DerivOrder_x) ! DerivOrder_x - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%WriteOutputHdr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) - DO I = 1, LEN(InData%WriteOutputHdr) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputUnt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) - DO I = 1, LEN(InData%WriteOutputUnt) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%kp_coordinate) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%kp_coordinate,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%kp_coordinate,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%kp_coordinate,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%kp_coordinate,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%kp_coordinate,2), UBOUND(InData%kp_coordinate,2) - DO i1 = LBOUND(InData%kp_coordinate,1), UBOUND(InData%kp_coordinate,1) - DbKiBuf(Db_Xferred) = InData%kp_coordinate(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%kp_total - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%LinNames_y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) - DO I = 1, LEN(InData%LinNames_y) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_y(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinNames_x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_x,1), UBOUND(InData%LinNames_x,1) - DO I = 1, LEN(InData%LinNames_x) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_x(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinNames_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) - DO I = 1, LEN(InData%LinNames_u) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_u(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_y,1), UBOUND(InData%RotFrame_y,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_y(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_x,1), UBOUND(InData%RotFrame_x,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_x(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_u,1), UBOUND(InData%RotFrame_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IsLoad_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IsLoad_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DerivOrder_x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DerivOrder_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DerivOrder_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DerivOrder_x,1), UBOUND(InData%DerivOrder_x,1) - IntKiBuf(Int_Xferred) = InData%DerivOrder_x(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE BD_PackInitOutput - - SUBROUTINE BD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(BD_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputHdr)) DEALLOCATE(OutData%WriteOutputHdr) - ALLOCATE(OutData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) - DO I = 1, LEN(OutData%WriteOutputHdr) - OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputUnt)) DEALLOCATE(OutData%WriteOutputUnt) - ALLOCATE(OutData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) - DO I = 1, LEN(OutData%WriteOutputUnt) - OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! kp_coordinate not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%kp_coordinate)) DEALLOCATE(OutData%kp_coordinate) - ALLOCATE(OutData%kp_coordinate(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%kp_coordinate.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%kp_coordinate,2), UBOUND(OutData%kp_coordinate,2) - DO i1 = LBOUND(OutData%kp_coordinate,1), UBOUND(OutData%kp_coordinate,1) - OutData%kp_coordinate(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - OutData%kp_total = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LinNames_y)) DEALLOCATE(OutData%LinNames_y) - ALLOCATE(OutData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) - DO I = 1, LEN(OutData%LinNames_y) - OutData%LinNames_y(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LinNames_x)) DEALLOCATE(OutData%LinNames_x) - ALLOCATE(OutData%LinNames_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_x,1), UBOUND(OutData%LinNames_x,1) - DO I = 1, LEN(OutData%LinNames_x) - OutData%LinNames_x(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LinNames_u)) DEALLOCATE(OutData%LinNames_u) - ALLOCATE(OutData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) - DO I = 1, LEN(OutData%LinNames_u) - OutData%LinNames_u(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RotFrame_y)) DEALLOCATE(OutData%RotFrame_y) - ALLOCATE(OutData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_y,1), UBOUND(OutData%RotFrame_y,1) - OutData%RotFrame_y(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_y(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RotFrame_x)) DEALLOCATE(OutData%RotFrame_x) - ALLOCATE(OutData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_x,1), UBOUND(OutData%RotFrame_x,1) - OutData%RotFrame_x(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_x(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RotFrame_u)) DEALLOCATE(OutData%RotFrame_u) - ALLOCATE(OutData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_u,1), UBOUND(OutData%RotFrame_u,1) - OutData%RotFrame_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IsLoad_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IsLoad_u)) DEALLOCATE(OutData%IsLoad_u) - ALLOCATE(OutData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) - OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DerivOrder_x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DerivOrder_x)) DEALLOCATE(OutData%DerivOrder_x) - ALLOCATE(OutData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DerivOrder_x,1), UBOUND(OutData%DerivOrder_x,1) - OutData%DerivOrder_x(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE BD_UnPackInitOutput +subroutine BD_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BD_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BD_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! WriteOutputHdr + call RegPack(Buf, allocated(InData%WriteOutputHdr)) + if (allocated(InData%WriteOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPack(Buf, InData%WriteOutputHdr) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutputUnt + call RegPack(Buf, allocated(InData%WriteOutputUnt)) + if (allocated(InData%WriteOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPack(Buf, InData%WriteOutputUnt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Ver + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + if (RegCheckErr(Buf, RoutineName)) return + ! kp_coordinate + call RegPack(Buf, allocated(InData%kp_coordinate)) + if (allocated(InData%kp_coordinate)) then + call RegPackBounds(Buf, 2, lbound(InData%kp_coordinate), ubound(InData%kp_coordinate)) + call RegPack(Buf, InData%kp_coordinate) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! kp_total + call RegPack(Buf, InData%kp_total) + if (RegCheckErr(Buf, RoutineName)) return + ! LinNames_y + call RegPack(Buf, allocated(InData%LinNames_y)) + if (allocated(InData%LinNames_y)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) + call RegPack(Buf, InData%LinNames_y) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LinNames_x + call RegPack(Buf, allocated(InData%LinNames_x)) + if (allocated(InData%LinNames_x)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_x), ubound(InData%LinNames_x)) + call RegPack(Buf, InData%LinNames_x) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LinNames_u + call RegPack(Buf, allocated(InData%LinNames_u)) + if (allocated(InData%LinNames_u)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) + call RegPack(Buf, InData%LinNames_u) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RotFrame_y + call RegPack(Buf, allocated(InData%RotFrame_y)) + if (allocated(InData%RotFrame_y)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y), ubound(InData%RotFrame_y)) + call RegPack(Buf, InData%RotFrame_y) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RotFrame_x + call RegPack(Buf, allocated(InData%RotFrame_x)) + if (allocated(InData%RotFrame_x)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x), ubound(InData%RotFrame_x)) + call RegPack(Buf, InData%RotFrame_x) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RotFrame_u + call RegPack(Buf, allocated(InData%RotFrame_u)) + if (allocated(InData%RotFrame_u)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u), ubound(InData%RotFrame_u)) + call RegPack(Buf, InData%RotFrame_u) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! IsLoad_u + call RegPack(Buf, allocated(InData%IsLoad_u)) + if (allocated(InData%IsLoad_u)) then + call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) + call RegPack(Buf, InData%IsLoad_u) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DerivOrder_x + call RegPack(Buf, allocated(InData%DerivOrder_x)) + if (allocated(InData%DerivOrder_x)) then + call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x), ubound(InData%DerivOrder_x)) + call RegPack(Buf, InData%DerivOrder_x) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BD_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BD_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BD_UnPackInitOutput' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! WriteOutputHdr + if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WriteOutputUnt + if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Ver + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + ! kp_coordinate + if (allocated(OutData%kp_coordinate)) deallocate(OutData%kp_coordinate) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%kp_coordinate(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%kp_coordinate.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%kp_coordinate) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! kp_total + call RegUnpack(Buf, OutData%kp_total) + if (RegCheckErr(Buf, RoutineName)) return + ! LinNames_y + if (allocated(OutData%LinNames_y)) deallocate(OutData%LinNames_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LinNames_x + if (allocated(OutData%LinNames_x)) deallocate(OutData%LinNames_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LinNames_u + if (allocated(OutData%LinNames_u)) deallocate(OutData%LinNames_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RotFrame_y + if (allocated(OutData%RotFrame_y)) deallocate(OutData%RotFrame_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RotFrame_x + if (allocated(OutData%RotFrame_x)) deallocate(OutData%RotFrame_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RotFrame_u + if (allocated(OutData%RotFrame_u)) deallocate(OutData%RotFrame_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! IsLoad_u + if (allocated(OutData%IsLoad_u)) deallocate(OutData%IsLoad_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IsLoad_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IsLoad_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! DerivOrder_x + if (allocated(OutData%DerivOrder_x)) deallocate(OutData%DerivOrder_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DerivOrder_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DerivOrder_x) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE BD_CopyBladeInputData( SrcBladeInputDataData, DstBladeInputDataData, CtrlCode, ErrStat, ErrMsg ) TYPE(BladeInputData), INTENT(IN) :: SrcBladeInputDataData TYPE(BladeInputData), INTENT(INOUT) :: DstBladeInputDataData @@ -1537,281 +1032,113 @@ SUBROUTINE BD_DestroyBladeInputData( BladeInputDataData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE BD_DestroyBladeInputData - SUBROUTINE BD_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(BladeInputData), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_PackBladeInputData' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! station_total - Int_BufSz = Int_BufSz + 1 ! format_index - Int_BufSz = Int_BufSz + 1 ! station_eta allocated yes/no - IF ( ALLOCATED(InData%station_eta) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! station_eta upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%station_eta) ! station_eta - END IF - Int_BufSz = Int_BufSz + 1 ! stiff0 allocated yes/no - IF ( ALLOCATED(InData%stiff0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! stiff0 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%stiff0) ! stiff0 - END IF - Int_BufSz = Int_BufSz + 1 ! mass0 allocated yes/no - IF ( ALLOCATED(InData%mass0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! mass0 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%mass0) ! mass0 - END IF - Db_BufSz = Db_BufSz + SIZE(InData%beta) ! beta - Int_BufSz = Int_BufSz + 1 ! damp_flag - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%station_total - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%format_index - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%station_eta) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%station_eta,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%station_eta,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%station_eta,1), UBOUND(InData%station_eta,1) - DbKiBuf(Db_Xferred) = InData%station_eta(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%stiff0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%stiff0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%stiff0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%stiff0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%stiff0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%stiff0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%stiff0,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%stiff0,3), UBOUND(InData%stiff0,3) - DO i2 = LBOUND(InData%stiff0,2), UBOUND(InData%stiff0,2) - DO i1 = LBOUND(InData%stiff0,1), UBOUND(InData%stiff0,1) - DbKiBuf(Db_Xferred) = InData%stiff0(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%mass0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%mass0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%mass0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%mass0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%mass0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%mass0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%mass0,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%mass0,3), UBOUND(InData%mass0,3) - DO i2 = LBOUND(InData%mass0,2), UBOUND(InData%mass0,2) - DO i1 = LBOUND(InData%mass0,1), UBOUND(InData%mass0,1) - DbKiBuf(Db_Xferred) = InData%mass0(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%beta,1), UBOUND(InData%beta,1) - DbKiBuf(Db_Xferred) = InData%beta(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%damp_flag - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE BD_PackBladeInputData - - SUBROUTINE BD_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(BladeInputData), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_UnPackBladeInputData' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%station_total = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%format_index = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! station_eta not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%station_eta)) DEALLOCATE(OutData%station_eta) - ALLOCATE(OutData%station_eta(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%station_eta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%station_eta,1), UBOUND(OutData%station_eta,1) - OutData%station_eta(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! stiff0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%stiff0)) DEALLOCATE(OutData%stiff0) - ALLOCATE(OutData%stiff0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%stiff0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%stiff0,3), UBOUND(OutData%stiff0,3) - DO i2 = LBOUND(OutData%stiff0,2), UBOUND(OutData%stiff0,2) - DO i1 = LBOUND(OutData%stiff0,1), UBOUND(OutData%stiff0,1) - OutData%stiff0(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! mass0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%mass0)) DEALLOCATE(OutData%mass0) - ALLOCATE(OutData%mass0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%mass0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%mass0,3), UBOUND(OutData%mass0,3) - DO i2 = LBOUND(OutData%mass0,2), UBOUND(OutData%mass0,2) - DO i1 = LBOUND(OutData%mass0,1), UBOUND(OutData%mass0,1) - OutData%mass0(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%beta,1) - i1_u = UBOUND(OutData%beta,1) - DO i1 = LBOUND(OutData%beta,1), UBOUND(OutData%beta,1) - OutData%beta(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - OutData%damp_flag = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE BD_UnPackBladeInputData +subroutine BD_PackBladeInputData(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BladeInputData), intent(in) :: InData + character(*), parameter :: RoutineName = 'BD_PackBladeInputData' + if (Buf%ErrStat >= AbortErrLev) return + ! station_total + call RegPack(Buf, InData%station_total) + if (RegCheckErr(Buf, RoutineName)) return + ! format_index + call RegPack(Buf, InData%format_index) + if (RegCheckErr(Buf, RoutineName)) return + ! station_eta + call RegPack(Buf, allocated(InData%station_eta)) + if (allocated(InData%station_eta)) then + call RegPackBounds(Buf, 1, lbound(InData%station_eta), ubound(InData%station_eta)) + call RegPack(Buf, InData%station_eta) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! stiff0 + call RegPack(Buf, allocated(InData%stiff0)) + if (allocated(InData%stiff0)) then + call RegPackBounds(Buf, 3, lbound(InData%stiff0), ubound(InData%stiff0)) + call RegPack(Buf, InData%stiff0) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! mass0 + call RegPack(Buf, allocated(InData%mass0)) + if (allocated(InData%mass0)) then + call RegPackBounds(Buf, 3, lbound(InData%mass0), ubound(InData%mass0)) + call RegPack(Buf, InData%mass0) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! beta + call RegPack(Buf, InData%beta) + if (RegCheckErr(Buf, RoutineName)) return + ! damp_flag + call RegPack(Buf, InData%damp_flag) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BD_UnPackBladeInputData(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BladeInputData), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BD_UnPackBladeInputData' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! station_total + call RegUnpack(Buf, OutData%station_total) + if (RegCheckErr(Buf, RoutineName)) return + ! format_index + call RegUnpack(Buf, OutData%format_index) + if (RegCheckErr(Buf, RoutineName)) return + ! station_eta + if (allocated(OutData%station_eta)) deallocate(OutData%station_eta) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%station_eta(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%station_eta.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%station_eta) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! stiff0 + if (allocated(OutData%stiff0)) deallocate(OutData%stiff0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%stiff0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%stiff0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%stiff0) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! mass0 + if (allocated(OutData%mass0)) deallocate(OutData%mass0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%mass0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%mass0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%mass0) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! beta + call RegUnpack(Buf, OutData%beta) + if (RegCheckErr(Buf, RoutineName)) return + ! damp_flag + call RegUnpack(Buf, OutData%damp_flag) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE BD_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) TYPE(BD_InputFile), INTENT(IN) :: SrcInputFileData TYPE(BD_InputFile), INTENT(INOUT) :: DstInputFileData @@ -1958,567 +1285,324 @@ SUBROUTINE BD_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE BD_DestroyInputFile - SUBROUTINE BD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(BD_InputFile), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_PackInputFile' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! member_total - Int_BufSz = Int_BufSz + 1 ! kp_total - Int_BufSz = Int_BufSz + 1 ! kp_member allocated yes/no - IF ( ALLOCATED(InData%kp_member) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! kp_member upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%kp_member) ! kp_member - END IF - Int_BufSz = Int_BufSz + 1 ! order_elem - Int_BufSz = Int_BufSz + 1 ! load_retries - Int_BufSz = Int_BufSz + 1 ! NRMax - Int_BufSz = Int_BufSz + 1 ! quadrature - Int_BufSz = Int_BufSz + 1 ! n_fact - Int_BufSz = Int_BufSz + 1 ! refine - Db_BufSz = Db_BufSz + 1 ! rhoinf - Db_BufSz = Db_BufSz + 1 ! DTBeam - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! InpBl: size of buffers for each call to pack subtype - CALL BD_PackBladeInputData( Re_Buf, Db_Buf, Int_Buf, InData%InpBl, ErrStat2, ErrMsg2, .TRUE. ) ! InpBl - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InpBl - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InpBl - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InpBl - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%BldFile) ! BldFile - Int_BufSz = Int_BufSz + 1 ! UsePitchAct - Int_BufSz = Int_BufSz + 1 ! QuasiStaticInit - Db_BufSz = Db_BufSz + 1 ! stop_tol - Db_BufSz = Db_BufSz + 1 ! tngt_stf_pert - Db_BufSz = Db_BufSz + 1 ! tngt_stf_difftol - Int_BufSz = Int_BufSz + 1 ! kp_coordinate allocated yes/no - IF ( ALLOCATED(InData%kp_coordinate) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! kp_coordinate upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%kp_coordinate) ! kp_coordinate - END IF - Db_BufSz = Db_BufSz + 1 ! pitchJ - Db_BufSz = Db_BufSz + 1 ! pitchK - Db_BufSz = Db_BufSz + 1 ! pitchC - Int_BufSz = Int_BufSz + 1 ! Echo - Int_BufSz = Int_BufSz + 1 ! RotStates - Int_BufSz = Int_BufSz + 1 ! RelStates - Int_BufSz = Int_BufSz + 1 ! tngt_stf_fd - Int_BufSz = Int_BufSz + 1 ! tngt_stf_comp - Int_BufSz = Int_BufSz + 1 ! NNodeOuts - Int_BufSz = Int_BufSz + SIZE(InData%OutNd) ! OutNd - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! OutList allocated yes/no - IF ( ALLOCATED(InData%OutList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%OutList)*LEN(InData%OutList) ! OutList - END IF - Int_BufSz = Int_BufSz + 1 ! SumPrint - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt - Int_BufSz = Int_BufSz + 1 ! BldNd_NumOuts - Int_BufSz = Int_BufSz + 1 ! BldNd_OutList allocated yes/no - IF ( ALLOCATED(InData%BldNd_OutList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BldNd_OutList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BldNd_OutList)*LEN(InData%BldNd_OutList) ! BldNd_OutList - END IF - Int_BufSz = Int_BufSz + 1 ! BldNd_BlOutNd allocated yes/no - IF ( ALLOCATED(InData%BldNd_BlOutNd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BldNd_BlOutNd upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BldNd_BlOutNd) ! BldNd_BlOutNd - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%BldNd_BlOutNd_Str) ! BldNd_BlOutNd_Str - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%member_total - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%kp_total - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%kp_member) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%kp_member,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%kp_member,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%kp_member,1), UBOUND(InData%kp_member,1) - IntKiBuf(Int_Xferred) = InData%kp_member(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%order_elem - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%load_retries - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NRMax - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%quadrature - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%n_fact - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%refine - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%rhoinf - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%DTBeam - Db_Xferred = Db_Xferred + 1 - CALL BD_PackBladeInputData( Re_Buf, Db_Buf, Int_Buf, InData%InpBl, ErrStat2, ErrMsg2, OnlySize ) ! InpBl - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - DO I = 1, LEN(InData%BldFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%BldFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%UsePitchAct, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%QuasiStaticInit, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%stop_tol - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%tngt_stf_pert - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%tngt_stf_difftol - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%kp_coordinate) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%kp_coordinate,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%kp_coordinate,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%kp_coordinate,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%kp_coordinate,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%kp_coordinate,2), UBOUND(InData%kp_coordinate,2) - DO i1 = LBOUND(InData%kp_coordinate,1), UBOUND(InData%kp_coordinate,1) - DbKiBuf(Db_Xferred) = InData%kp_coordinate(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - DbKiBuf(Db_Xferred) = InData%pitchJ - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%pitchK - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%pitchC - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Echo, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotStates, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%RelStates, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%tngt_stf_fd, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%tngt_stf_comp, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NNodeOuts - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%OutNd,1), UBOUND(InData%OutNd,1) - IntKiBuf(Int_Xferred) = InData%OutNd(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) - DO I = 1, LEN(InData%OutList) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%BldNd_NumOuts - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BldNd_OutList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldNd_OutList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_OutList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BldNd_OutList,1), UBOUND(InData%BldNd_OutList,1) - DO I = 1, LEN(InData%BldNd_OutList) - IntKiBuf(Int_Xferred) = ICHAR(InData%BldNd_OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BldNd_BlOutNd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldNd_BlOutNd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_BlOutNd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BldNd_BlOutNd,1), UBOUND(InData%BldNd_BlOutNd,1) - IntKiBuf(Int_Xferred) = InData%BldNd_BlOutNd(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - DO I = 1, LEN(InData%BldNd_BlOutNd_Str) - IntKiBuf(Int_Xferred) = ICHAR(InData%BldNd_BlOutNd_Str(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE BD_PackInputFile - - SUBROUTINE BD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(BD_InputFile), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_UnPackInputFile' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%member_total = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%kp_total = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! kp_member not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%kp_member)) DEALLOCATE(OutData%kp_member) - ALLOCATE(OutData%kp_member(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%kp_member.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%kp_member,1), UBOUND(OutData%kp_member,1) - OutData%kp_member(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%order_elem = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%load_retries = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NRMax = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%quadrature = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%n_fact = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%refine = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%rhoinf = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%DTBeam = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL BD_UnpackBladeInputData( Re_Buf, Db_Buf, Int_Buf, OutData%InpBl, ErrStat2, ErrMsg2 ) ! InpBl - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - DO I = 1, LEN(OutData%BldFile) - OutData%BldFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UsePitchAct = TRANSFER(IntKiBuf(Int_Xferred), OutData%UsePitchAct) - Int_Xferred = Int_Xferred + 1 - OutData%QuasiStaticInit = TRANSFER(IntKiBuf(Int_Xferred), OutData%QuasiStaticInit) - Int_Xferred = Int_Xferred + 1 - OutData%stop_tol = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%tngt_stf_pert = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%tngt_stf_difftol = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! kp_coordinate not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%kp_coordinate)) DEALLOCATE(OutData%kp_coordinate) - ALLOCATE(OutData%kp_coordinate(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%kp_coordinate.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%kp_coordinate,2), UBOUND(OutData%kp_coordinate,2) - DO i1 = LBOUND(OutData%kp_coordinate,1), UBOUND(OutData%kp_coordinate,1) - OutData%kp_coordinate(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - OutData%pitchJ = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%pitchK = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%pitchC = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%Echo = TRANSFER(IntKiBuf(Int_Xferred), OutData%Echo) - Int_Xferred = Int_Xferred + 1 - OutData%RotStates = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotStates) - Int_Xferred = Int_Xferred + 1 - OutData%RelStates = TRANSFER(IntKiBuf(Int_Xferred), OutData%RelStates) - Int_Xferred = Int_Xferred + 1 - OutData%tngt_stf_fd = TRANSFER(IntKiBuf(Int_Xferred), OutData%tngt_stf_fd) - Int_Xferred = Int_Xferred + 1 - OutData%tngt_stf_comp = TRANSFER(IntKiBuf(Int_Xferred), OutData%tngt_stf_comp) - Int_Xferred = Int_Xferred + 1 - OutData%NNodeOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%OutNd,1) - i1_u = UBOUND(OutData%OutNd,1) - DO i1 = LBOUND(OutData%OutNd,1), UBOUND(OutData%OutNd,1) - OutData%OutNd(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutList not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutList)) DEALLOCATE(OutData%OutList) - ALLOCATE(OutData%OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) - DO I = 1, LEN(OutData%OutList) - OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%BldNd_NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_OutList not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BldNd_OutList)) DEALLOCATE(OutData%BldNd_OutList) - ALLOCATE(OutData%BldNd_OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BldNd_OutList,1), UBOUND(OutData%BldNd_OutList,1) - DO I = 1, LEN(OutData%BldNd_OutList) - OutData%BldNd_OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_BlOutNd not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BldNd_BlOutNd)) DEALLOCATE(OutData%BldNd_BlOutNd) - ALLOCATE(OutData%BldNd_BlOutNd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_BlOutNd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BldNd_BlOutNd,1), UBOUND(OutData%BldNd_BlOutNd,1) - OutData%BldNd_BlOutNd(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - DO I = 1, LEN(OutData%BldNd_BlOutNd_Str) - OutData%BldNd_BlOutNd_Str(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE BD_UnPackInputFile +subroutine BD_PackInputFile(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BD_InputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'BD_PackInputFile' + if (Buf%ErrStat >= AbortErrLev) return + ! member_total + call RegPack(Buf, InData%member_total) + if (RegCheckErr(Buf, RoutineName)) return + ! kp_total + call RegPack(Buf, InData%kp_total) + if (RegCheckErr(Buf, RoutineName)) return + ! kp_member + call RegPack(Buf, allocated(InData%kp_member)) + if (allocated(InData%kp_member)) then + call RegPackBounds(Buf, 1, lbound(InData%kp_member), ubound(InData%kp_member)) + call RegPack(Buf, InData%kp_member) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! order_elem + call RegPack(Buf, InData%order_elem) + if (RegCheckErr(Buf, RoutineName)) return + ! load_retries + call RegPack(Buf, InData%load_retries) + if (RegCheckErr(Buf, RoutineName)) return + ! NRMax + call RegPack(Buf, InData%NRMax) + if (RegCheckErr(Buf, RoutineName)) return + ! quadrature + call RegPack(Buf, InData%quadrature) + if (RegCheckErr(Buf, RoutineName)) return + ! n_fact + call RegPack(Buf, InData%n_fact) + if (RegCheckErr(Buf, RoutineName)) return + ! refine + call RegPack(Buf, InData%refine) + if (RegCheckErr(Buf, RoutineName)) return + ! rhoinf + call RegPack(Buf, InData%rhoinf) + if (RegCheckErr(Buf, RoutineName)) return + ! DTBeam + call RegPack(Buf, InData%DTBeam) + if (RegCheckErr(Buf, RoutineName)) return + ! InpBl + call BD_PackBladeInputData(Buf, InData%InpBl) + if (RegCheckErr(Buf, RoutineName)) return + ! BldFile + call RegPack(Buf, InData%BldFile) + if (RegCheckErr(Buf, RoutineName)) return + ! UsePitchAct + call RegPack(Buf, InData%UsePitchAct) + if (RegCheckErr(Buf, RoutineName)) return + ! QuasiStaticInit + call RegPack(Buf, InData%QuasiStaticInit) + if (RegCheckErr(Buf, RoutineName)) return + ! stop_tol + call RegPack(Buf, InData%stop_tol) + if (RegCheckErr(Buf, RoutineName)) return + ! tngt_stf_pert + call RegPack(Buf, InData%tngt_stf_pert) + if (RegCheckErr(Buf, RoutineName)) return + ! tngt_stf_difftol + call RegPack(Buf, InData%tngt_stf_difftol) + if (RegCheckErr(Buf, RoutineName)) return + ! kp_coordinate + call RegPack(Buf, allocated(InData%kp_coordinate)) + if (allocated(InData%kp_coordinate)) then + call RegPackBounds(Buf, 2, lbound(InData%kp_coordinate), ubound(InData%kp_coordinate)) + call RegPack(Buf, InData%kp_coordinate) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! pitchJ + call RegPack(Buf, InData%pitchJ) + if (RegCheckErr(Buf, RoutineName)) return + ! pitchK + call RegPack(Buf, InData%pitchK) + if (RegCheckErr(Buf, RoutineName)) return + ! pitchC + call RegPack(Buf, InData%pitchC) + if (RegCheckErr(Buf, RoutineName)) return + ! Echo + call RegPack(Buf, InData%Echo) + if (RegCheckErr(Buf, RoutineName)) return + ! RotStates + call RegPack(Buf, InData%RotStates) + if (RegCheckErr(Buf, RoutineName)) return + ! RelStates + call RegPack(Buf, InData%RelStates) + if (RegCheckErr(Buf, RoutineName)) return + ! tngt_stf_fd + call RegPack(Buf, InData%tngt_stf_fd) + if (RegCheckErr(Buf, RoutineName)) return + ! tngt_stf_comp + call RegPack(Buf, InData%tngt_stf_comp) + if (RegCheckErr(Buf, RoutineName)) return + ! NNodeOuts + call RegPack(Buf, InData%NNodeOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! OutNd + call RegPack(Buf, InData%OutNd) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegPack(Buf, InData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! OutList + call RegPack(Buf, allocated(InData%OutList)) + if (allocated(InData%OutList)) then + call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) + call RegPack(Buf, InData%OutList) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SumPrint + call RegPack(Buf, InData%SumPrint) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFmt + call RegPack(Buf, InData%OutFmt) + if (RegCheckErr(Buf, RoutineName)) return + ! BldNd_NumOuts + call RegPack(Buf, InData%BldNd_NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! BldNd_OutList + call RegPack(Buf, allocated(InData%BldNd_OutList)) + if (allocated(InData%BldNd_OutList)) then + call RegPackBounds(Buf, 1, lbound(InData%BldNd_OutList), ubound(InData%BldNd_OutList)) + call RegPack(Buf, InData%BldNd_OutList) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BldNd_BlOutNd + call RegPack(Buf, allocated(InData%BldNd_BlOutNd)) + if (allocated(InData%BldNd_BlOutNd)) then + call RegPackBounds(Buf, 1, lbound(InData%BldNd_BlOutNd), ubound(InData%BldNd_BlOutNd)) + call RegPack(Buf, InData%BldNd_BlOutNd) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BldNd_BlOutNd_Str + call RegPack(Buf, InData%BldNd_BlOutNd_Str) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BD_UnPackInputFile(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BD_InputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BD_UnPackInputFile' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! member_total + call RegUnpack(Buf, OutData%member_total) + if (RegCheckErr(Buf, RoutineName)) return + ! kp_total + call RegUnpack(Buf, OutData%kp_total) + if (RegCheckErr(Buf, RoutineName)) return + ! kp_member + if (allocated(OutData%kp_member)) deallocate(OutData%kp_member) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%kp_member(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%kp_member.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%kp_member) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! order_elem + call RegUnpack(Buf, OutData%order_elem) + if (RegCheckErr(Buf, RoutineName)) return + ! load_retries + call RegUnpack(Buf, OutData%load_retries) + if (RegCheckErr(Buf, RoutineName)) return + ! NRMax + call RegUnpack(Buf, OutData%NRMax) + if (RegCheckErr(Buf, RoutineName)) return + ! quadrature + call RegUnpack(Buf, OutData%quadrature) + if (RegCheckErr(Buf, RoutineName)) return + ! n_fact + call RegUnpack(Buf, OutData%n_fact) + if (RegCheckErr(Buf, RoutineName)) return + ! refine + call RegUnpack(Buf, OutData%refine) + if (RegCheckErr(Buf, RoutineName)) return + ! rhoinf + call RegUnpack(Buf, OutData%rhoinf) + if (RegCheckErr(Buf, RoutineName)) return + ! DTBeam + call RegUnpack(Buf, OutData%DTBeam) + if (RegCheckErr(Buf, RoutineName)) return + ! InpBl + call BD_UnpackBladeInputData(Buf, OutData%InpBl) ! InpBl + ! BldFile + call RegUnpack(Buf, OutData%BldFile) + if (RegCheckErr(Buf, RoutineName)) return + ! UsePitchAct + call RegUnpack(Buf, OutData%UsePitchAct) + if (RegCheckErr(Buf, RoutineName)) return + ! QuasiStaticInit + call RegUnpack(Buf, OutData%QuasiStaticInit) + if (RegCheckErr(Buf, RoutineName)) return + ! stop_tol + call RegUnpack(Buf, OutData%stop_tol) + if (RegCheckErr(Buf, RoutineName)) return + ! tngt_stf_pert + call RegUnpack(Buf, OutData%tngt_stf_pert) + if (RegCheckErr(Buf, RoutineName)) return + ! tngt_stf_difftol + call RegUnpack(Buf, OutData%tngt_stf_difftol) + if (RegCheckErr(Buf, RoutineName)) return + ! kp_coordinate + if (allocated(OutData%kp_coordinate)) deallocate(OutData%kp_coordinate) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%kp_coordinate(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%kp_coordinate.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%kp_coordinate) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! pitchJ + call RegUnpack(Buf, OutData%pitchJ) + if (RegCheckErr(Buf, RoutineName)) return + ! pitchK + call RegUnpack(Buf, OutData%pitchK) + if (RegCheckErr(Buf, RoutineName)) return + ! pitchC + call RegUnpack(Buf, OutData%pitchC) + if (RegCheckErr(Buf, RoutineName)) return + ! Echo + call RegUnpack(Buf, OutData%Echo) + if (RegCheckErr(Buf, RoutineName)) return + ! RotStates + call RegUnpack(Buf, OutData%RotStates) + if (RegCheckErr(Buf, RoutineName)) return + ! RelStates + call RegUnpack(Buf, OutData%RelStates) + if (RegCheckErr(Buf, RoutineName)) return + ! tngt_stf_fd + call RegUnpack(Buf, OutData%tngt_stf_fd) + if (RegCheckErr(Buf, RoutineName)) return + ! tngt_stf_comp + call RegUnpack(Buf, OutData%tngt_stf_comp) + if (RegCheckErr(Buf, RoutineName)) return + ! NNodeOuts + call RegUnpack(Buf, OutData%NNodeOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! OutNd + call RegUnpack(Buf, OutData%OutNd) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! OutList + if (allocated(OutData%OutList)) deallocate(OutData%OutList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutList) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! SumPrint + call RegUnpack(Buf, OutData%SumPrint) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFmt + call RegUnpack(Buf, OutData%OutFmt) + if (RegCheckErr(Buf, RoutineName)) return + ! BldNd_NumOuts + call RegUnpack(Buf, OutData%BldNd_NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! BldNd_OutList + if (allocated(OutData%BldNd_OutList)) deallocate(OutData%BldNd_OutList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BldNd_OutList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BldNd_OutList) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BldNd_BlOutNd + if (allocated(OutData%BldNd_BlOutNd)) deallocate(OutData%BldNd_BlOutNd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BldNd_BlOutNd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_BlOutNd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BldNd_BlOutNd) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BldNd_BlOutNd_Str + call RegUnpack(Buf, OutData%BldNd_BlOutNd_Str) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE BD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(BD_ContinuousStateType), INTENT(IN) :: SrcContStateData TYPE(BD_ContinuousStateType), INTENT(INOUT) :: DstContStateData @@ -2586,196 +1670,67 @@ SUBROUTINE BD_DestroyContState( ContStateData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE BD_DestroyContState - SUBROUTINE BD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(BD_ContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_PackContState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! q allocated yes/no - IF ( ALLOCATED(InData%q) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! q upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%q) ! q - END IF - Int_BufSz = Int_BufSz + 1 ! dqdt allocated yes/no - IF ( ALLOCATED(InData%dqdt) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! dqdt upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%dqdt) ! dqdt - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%q) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%q,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%q,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%q,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%q,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%q,2), UBOUND(InData%q,2) - DO i1 = LBOUND(InData%q,1), UBOUND(InData%q,1) - DbKiBuf(Db_Xferred) = InData%q(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dqdt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dqdt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dqdt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dqdt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dqdt,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%dqdt,2), UBOUND(InData%dqdt,2) - DO i1 = LBOUND(InData%dqdt,1), UBOUND(InData%dqdt,1) - DbKiBuf(Db_Xferred) = InData%dqdt(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE BD_PackContState - - SUBROUTINE BD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(BD_ContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_UnPackContState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! q not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%q)) DEALLOCATE(OutData%q) - ALLOCATE(OutData%q(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%q.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%q,2), UBOUND(OutData%q,2) - DO i1 = LBOUND(OutData%q,1), UBOUND(OutData%q,1) - OutData%q(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dqdt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%dqdt)) DEALLOCATE(OutData%dqdt) - ALLOCATE(OutData%dqdt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dqdt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%dqdt,2), UBOUND(OutData%dqdt,2) - DO i1 = LBOUND(OutData%dqdt,1), UBOUND(OutData%dqdt,1) - OutData%dqdt(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE BD_UnPackContState +subroutine BD_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BD_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BD_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + ! q + call RegPack(Buf, allocated(InData%q)) + if (allocated(InData%q)) then + call RegPackBounds(Buf, 2, lbound(InData%q), ubound(InData%q)) + call RegPack(Buf, InData%q) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! dqdt + call RegPack(Buf, allocated(InData%dqdt)) + if (allocated(InData%dqdt)) then + call RegPackBounds(Buf, 2, lbound(InData%dqdt), ubound(InData%dqdt)) + call RegPack(Buf, InData%dqdt) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BD_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BD_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BD_UnPackContState' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! q + if (allocated(OutData%q)) deallocate(OutData%q) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%q(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%q.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%q) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! dqdt + if (allocated(OutData%dqdt)) deallocate(OutData%dqdt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dqdt(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dqdt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dqdt) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE BD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(BD_DiscreteStateType), INTENT(IN) :: SrcDiscStateData TYPE(BD_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData @@ -2809,108 +1764,32 @@ SUBROUTINE BD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) END SUBROUTINE BD_DestroyDiscState - SUBROUTINE BD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(BD_DiscreteStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_PackDiscState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! thetaP - Re_BufSz = Re_BufSz + 1 ! thetaPD - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%thetaP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%thetaPD - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE BD_PackDiscState - - SUBROUTINE BD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(BD_DiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_UnPackDiscState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%thetaP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%thetaPD = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE BD_UnPackDiscState +subroutine BD_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BD_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BD_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + ! thetaP + call RegPack(Buf, InData%thetaP) + if (RegCheckErr(Buf, RoutineName)) return + ! thetaPD + call RegPack(Buf, InData%thetaPD) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BD_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BD_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BD_UnPackDiscState' + if (Buf%ErrStat /= ErrID_None) return + ! thetaP + call RegUnpack(Buf, OutData%thetaP) + if (RegCheckErr(Buf, RoutineName)) return + ! thetaPD + call RegUnpack(Buf, OutData%thetaPD) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE BD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(BD_ConstraintStateType), INTENT(IN) :: SrcConstrStateData TYPE(BD_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData @@ -2943,103 +1822,26 @@ SUBROUTINE BD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) END SUBROUTINE BD_DestroyConstrState - SUBROUTINE BD_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(BD_ConstraintStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_PackConstrState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyConstrState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE BD_PackConstrState - - SUBROUTINE BD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(BD_ConstraintStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_UnPackConstrState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyConstrState = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE BD_UnPackConstrState +subroutine BD_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BD_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BD_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyConstrState + call RegPack(Buf, InData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BD_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BD_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BD_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + ! DummyConstrState + call RegUnpack(Buf, OutData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE BD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(BD_OtherStateType), INTENT(IN) :: SrcOtherStateData TYPE(BD_OtherStateType), INTENT(INOUT) :: DstOtherStateData @@ -3109,206 +1911,79 @@ SUBROUTINE BD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE BD_DestroyOtherState - SUBROUTINE BD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(BD_OtherStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_PackOtherState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! acc allocated yes/no - IF ( ALLOCATED(InData%acc) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! acc upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%acc) ! acc - END IF - Int_BufSz = Int_BufSz + 1 ! xcc allocated yes/no - IF ( ALLOCATED(InData%xcc) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! xcc upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%xcc) ! xcc - END IF - Int_BufSz = Int_BufSz + 1 ! InitAcc - Int_BufSz = Int_BufSz + 1 ! RunQuasiStaticInit - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%acc) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%acc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%acc,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%acc,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%acc,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%acc,2), UBOUND(InData%acc,2) - DO i1 = LBOUND(InData%acc,1), UBOUND(InData%acc,1) - DbKiBuf(Db_Xferred) = InData%acc(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%xcc) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xcc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xcc,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xcc,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xcc,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%xcc,2), UBOUND(InData%xcc,2) - DO i1 = LBOUND(InData%xcc,1), UBOUND(InData%xcc,1) - DbKiBuf(Db_Xferred) = InData%xcc(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%InitAcc, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%RunQuasiStaticInit, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE BD_PackOtherState - - SUBROUTINE BD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(BD_OtherStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_UnPackOtherState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! acc not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%acc)) DEALLOCATE(OutData%acc) - ALLOCATE(OutData%acc(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%acc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%acc,2), UBOUND(OutData%acc,2) - DO i1 = LBOUND(OutData%acc,1), UBOUND(OutData%acc,1) - OutData%acc(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xcc not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%xcc)) DEALLOCATE(OutData%xcc) - ALLOCATE(OutData%xcc(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xcc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%xcc,2), UBOUND(OutData%xcc,2) - DO i1 = LBOUND(OutData%xcc,1), UBOUND(OutData%xcc,1) - OutData%xcc(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - OutData%InitAcc = TRANSFER(IntKiBuf(Int_Xferred), OutData%InitAcc) - Int_Xferred = Int_Xferred + 1 - OutData%RunQuasiStaticInit = TRANSFER(IntKiBuf(Int_Xferred), OutData%RunQuasiStaticInit) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE BD_UnPackOtherState +subroutine BD_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BD_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BD_PackOtherState' + if (Buf%ErrStat >= AbortErrLev) return + ! acc + call RegPack(Buf, allocated(InData%acc)) + if (allocated(InData%acc)) then + call RegPackBounds(Buf, 2, lbound(InData%acc), ubound(InData%acc)) + call RegPack(Buf, InData%acc) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! xcc + call RegPack(Buf, allocated(InData%xcc)) + if (allocated(InData%xcc)) then + call RegPackBounds(Buf, 2, lbound(InData%xcc), ubound(InData%xcc)) + call RegPack(Buf, InData%xcc) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! InitAcc + call RegPack(Buf, InData%InitAcc) + if (RegCheckErr(Buf, RoutineName)) return + ! RunQuasiStaticInit + call RegPack(Buf, InData%RunQuasiStaticInit) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BD_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BD_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BD_UnPackOtherState' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! acc + if (allocated(OutData%acc)) deallocate(OutData%acc) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%acc(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%acc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%acc) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! xcc + if (allocated(OutData%xcc)) deallocate(OutData%xcc) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xcc(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xcc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%xcc) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! InitAcc + call RegUnpack(Buf, OutData%InitAcc) + if (RegCheckErr(Buf, RoutineName)) return + ! RunQuasiStaticInit + call RegUnpack(Buf, OutData%RunQuasiStaticInit) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE BD_CopyqpParam( SrcqpParamData, DstqpParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(qpParam), INTENT(IN) :: SrcqpParamData TYPE(qpParam), INTENT(INOUT) :: DstqpParamData @@ -3379,207 +2054,67 @@ SUBROUTINE BD_DestroyqpParam( qpParamData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE BD_DestroyqpParam - SUBROUTINE BD_PackqpParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(qpParam), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_PackqpParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! mmm allocated yes/no - IF ( ALLOCATED(InData%mmm) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! mmm upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%mmm) ! mmm - END IF - Int_BufSz = Int_BufSz + 1 ! mEta allocated yes/no - IF ( ALLOCATED(InData%mEta) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! mEta upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%mEta) ! mEta - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%mmm) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%mmm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%mmm,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%mmm,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%mmm,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%mmm,2), UBOUND(InData%mmm,2) - DO i1 = LBOUND(InData%mmm,1), UBOUND(InData%mmm,1) - DbKiBuf(Db_Xferred) = InData%mmm(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%mEta) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%mEta,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%mEta,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%mEta,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%mEta,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%mEta,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%mEta,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%mEta,3), UBOUND(InData%mEta,3) - DO i2 = LBOUND(InData%mEta,2), UBOUND(InData%mEta,2) - DO i1 = LBOUND(InData%mEta,1), UBOUND(InData%mEta,1) - DbKiBuf(Db_Xferred) = InData%mEta(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE BD_PackqpParam - - SUBROUTINE BD_UnPackqpParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(qpParam), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_UnPackqpParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! mmm not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%mmm)) DEALLOCATE(OutData%mmm) - ALLOCATE(OutData%mmm(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%mmm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%mmm,2), UBOUND(OutData%mmm,2) - DO i1 = LBOUND(OutData%mmm,1), UBOUND(OutData%mmm,1) - OutData%mmm(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! mEta not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%mEta)) DEALLOCATE(OutData%mEta) - ALLOCATE(OutData%mEta(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%mEta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%mEta,3), UBOUND(OutData%mEta,3) - DO i2 = LBOUND(OutData%mEta,2), UBOUND(OutData%mEta,2) - DO i1 = LBOUND(OutData%mEta,1), UBOUND(OutData%mEta,1) - OutData%mEta(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE BD_UnPackqpParam +subroutine BD_PackqpParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(qpParam), intent(in) :: InData + character(*), parameter :: RoutineName = 'BD_PackqpParam' + if (Buf%ErrStat >= AbortErrLev) return + ! mmm + call RegPack(Buf, allocated(InData%mmm)) + if (allocated(InData%mmm)) then + call RegPackBounds(Buf, 2, lbound(InData%mmm), ubound(InData%mmm)) + call RegPack(Buf, InData%mmm) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! mEta + call RegPack(Buf, allocated(InData%mEta)) + if (allocated(InData%mEta)) then + call RegPackBounds(Buf, 3, lbound(InData%mEta), ubound(InData%mEta)) + call RegPack(Buf, InData%mEta) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BD_UnPackqpParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(qpParam), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BD_UnPackqpParam' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! mmm + if (allocated(OutData%mmm)) deallocate(OutData%mmm) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%mmm(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%mmm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%mmm) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! mEta + if (allocated(OutData%mEta)) deallocate(OutData%mEta) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%mEta(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%mEta.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%mEta) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE BD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(BD_ParameterType), INTENT(IN) :: SrcParamData TYPE(BD_ParameterType), INTENT(INOUT) :: DstParamData @@ -4167,2059 +2702,963 @@ SUBROUTINE BD_DestroyParam( ParamData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE BD_DestroyParam - SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(BD_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! dt - Db_BufSz = Db_BufSz + SIZE(InData%coef) ! coef - Db_BufSz = Db_BufSz + 1 ! rhoinf - Int_BufSz = Int_BufSz + 1 ! uuN0 allocated yes/no - IF ( ALLOCATED(InData%uuN0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! uuN0 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%uuN0) ! uuN0 - END IF - Int_BufSz = Int_BufSz + 1 ! Stif0_QP allocated yes/no - IF ( ALLOCATED(InData%Stif0_QP) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Stif0_QP upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Stif0_QP) ! Stif0_QP - END IF - Int_BufSz = Int_BufSz + 1 ! Mass0_QP allocated yes/no - IF ( ALLOCATED(InData%Mass0_QP) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Mass0_QP upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Mass0_QP) ! Mass0_QP - END IF - Db_BufSz = Db_BufSz + SIZE(InData%gravity) ! gravity - Int_BufSz = Int_BufSz + 1 ! segment_eta allocated yes/no - IF ( ALLOCATED(InData%segment_eta) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! segment_eta upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%segment_eta) ! segment_eta - END IF - Int_BufSz = Int_BufSz + 1 ! member_eta allocated yes/no - IF ( ALLOCATED(InData%member_eta) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! member_eta upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%member_eta) ! member_eta - END IF - Db_BufSz = Db_BufSz + 1 ! blade_length - Db_BufSz = Db_BufSz + 1 ! blade_mass - Db_BufSz = Db_BufSz + SIZE(InData%blade_CG) ! blade_CG - Db_BufSz = Db_BufSz + SIZE(InData%blade_IN) ! blade_IN - Db_BufSz = Db_BufSz + SIZE(InData%beta) ! beta - Db_BufSz = Db_BufSz + 1 ! tol - Db_BufSz = Db_BufSz + SIZE(InData%GlbPos) ! GlbPos - Db_BufSz = Db_BufSz + SIZE(InData%GlbRot) ! GlbRot - Db_BufSz = Db_BufSz + SIZE(InData%Glb_crv) ! Glb_crv - Int_BufSz = Int_BufSz + 1 ! QPtN allocated yes/no - IF ( ALLOCATED(InData%QPtN) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! QPtN upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%QPtN) ! QPtN - END IF - Int_BufSz = Int_BufSz + 1 ! QPtWeight allocated yes/no - IF ( ALLOCATED(InData%QPtWeight) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! QPtWeight upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%QPtWeight) ! QPtWeight - END IF - Int_BufSz = Int_BufSz + 1 ! Shp allocated yes/no - IF ( ALLOCATED(InData%Shp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Shp upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Shp) ! Shp - END IF - Int_BufSz = Int_BufSz + 1 ! ShpDer allocated yes/no - IF ( ALLOCATED(InData%ShpDer) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ShpDer upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%ShpDer) ! ShpDer - END IF - Int_BufSz = Int_BufSz + 1 ! Jacobian allocated yes/no - IF ( ALLOCATED(InData%Jacobian) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jacobian upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Jacobian) ! Jacobian - END IF - Int_BufSz = Int_BufSz + 1 ! uu0 allocated yes/no - IF ( ALLOCATED(InData%uu0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! uu0 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%uu0) ! uu0 - END IF - Int_BufSz = Int_BufSz + 1 ! rrN0 allocated yes/no - IF ( ALLOCATED(InData%rrN0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! rrN0 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%rrN0) ! rrN0 - END IF - Int_BufSz = Int_BufSz + 1 ! E10 allocated yes/no - IF ( ALLOCATED(InData%E10) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! E10 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%E10) ! E10 - END IF - Int_BufSz = Int_BufSz + 1 ! nodes_per_elem - Int_BufSz = Int_BufSz + 1 ! node_elem_idx allocated yes/no - IF ( ALLOCATED(InData%node_elem_idx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! node_elem_idx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%node_elem_idx) ! node_elem_idx - END IF - Int_BufSz = Int_BufSz + 1 ! refine - Int_BufSz = Int_BufSz + 1 ! dof_node - Int_BufSz = Int_BufSz + 1 ! dof_elem - Int_BufSz = Int_BufSz + 1 ! rot_elem - Int_BufSz = Int_BufSz + 1 ! elem_total - Int_BufSz = Int_BufSz + 1 ! node_total - Int_BufSz = Int_BufSz + 1 ! dof_total - Int_BufSz = Int_BufSz + 1 ! nqp - Int_BufSz = Int_BufSz + 1 ! analysis_type - Int_BufSz = Int_BufSz + 1 ! damp_flag - Int_BufSz = Int_BufSz + 1 ! ld_retries - Int_BufSz = Int_BufSz + 1 ! niter - Int_BufSz = Int_BufSz + 1 ! quadrature - Int_BufSz = Int_BufSz + 1 ! n_fact - Int_BufSz = Int_BufSz + 1 ! OutInputs - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! OutParam allocated yes/no - IF ( ALLOCATED(InData%OutParam) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutParam upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - Int_BufSz = Int_BufSz + 3 ! OutParam: size of buffers for each call to pack subtype - CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutParam - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutParam - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutParam - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NNodeOuts - Int_BufSz = Int_BufSz + SIZE(InData%OutNd) ! OutNd - Int_BufSz = Int_BufSz + 1 ! NdIndx allocated yes/no - IF ( ALLOCATED(InData%NdIndx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NdIndx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NdIndx) ! NdIndx - END IF - Int_BufSz = Int_BufSz + 1 ! NdIndxInverse allocated yes/no - IF ( ALLOCATED(InData%NdIndxInverse) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NdIndxInverse upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NdIndxInverse) ! NdIndxInverse - END IF - Int_BufSz = Int_BufSz + 1 ! OutNd2NdElem allocated yes/no - IF ( ALLOCATED(InData%OutNd2NdElem) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OutNd2NdElem upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%OutNd2NdElem) ! OutNd2NdElem - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt - Int_BufSz = Int_BufSz + 1 ! UsePitchAct - Re_BufSz = Re_BufSz + 1 ! pitchJ - Re_BufSz = Re_BufSz + 1 ! pitchK - Re_BufSz = Re_BufSz + 1 ! pitchC - Re_BufSz = Re_BufSz + SIZE(InData%torqM) ! torqM - Int_BufSz = Int_BufSz + 3 ! qp: size of buffers for each call to pack subtype - CALL BD_PackqpParam( Re_Buf, Db_Buf, Int_Buf, InData%qp, ErrStat2, ErrMsg2, .TRUE. ) ! qp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! qp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! qp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! qp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! qp_indx_offset - Int_BufSz = Int_BufSz + 1 ! BldMotionNodeLoc - Int_BufSz = Int_BufSz + 1 ! tngt_stf_fd - Int_BufSz = Int_BufSz + 1 ! tngt_stf_comp - Db_BufSz = Db_BufSz + 1 ! tngt_stf_pert - Db_BufSz = Db_BufSz + 1 ! tngt_stf_difftol - Int_BufSz = Int_BufSz + 1 ! BldNd_NumOuts - Int_BufSz = Int_BufSz + 1 ! BldNd_TotNumOuts - Int_BufSz = Int_BufSz + 1 ! BldNd_OutParam allocated yes/no - IF ( ALLOCATED(InData%BldNd_OutParam) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BldNd_OutParam upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BldNd_OutParam,1), UBOUND(InData%BldNd_OutParam,1) - Int_BufSz = Int_BufSz + 3 ! BldNd_OutParam: size of buffers for each call to pack subtype - CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BldNd_OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BldNd_OutParam - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BldNd_OutParam - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BldNd_OutParam - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! BldNd_BlOutNd allocated yes/no - IF ( ALLOCATED(InData%BldNd_BlOutNd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BldNd_BlOutNd upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BldNd_BlOutNd) ! BldNd_BlOutNd - END IF - Int_BufSz = Int_BufSz + 1 ! QPtw_Shp_Shp_Jac allocated yes/no - IF ( ALLOCATED(InData%QPtw_Shp_Shp_Jac) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! QPtw_Shp_Shp_Jac upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%QPtw_Shp_Shp_Jac) ! QPtw_Shp_Shp_Jac - END IF - Int_BufSz = Int_BufSz + 1 ! QPtw_Shp_ShpDer allocated yes/no - IF ( ALLOCATED(InData%QPtw_Shp_ShpDer) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! QPtw_Shp_ShpDer upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%QPtw_Shp_ShpDer) ! QPtw_Shp_ShpDer - END IF - Int_BufSz = Int_BufSz + 1 ! QPtw_ShpDer_ShpDer_Jac allocated yes/no - IF ( ALLOCATED(InData%QPtw_ShpDer_ShpDer_Jac) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! QPtw_ShpDer_ShpDer_Jac upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%QPtw_ShpDer_ShpDer_Jac) ! QPtw_ShpDer_ShpDer_Jac - END IF - Int_BufSz = Int_BufSz + 1 ! QPtw_Shp_Jac allocated yes/no - IF ( ALLOCATED(InData%QPtw_Shp_Jac) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! QPtw_Shp_Jac upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%QPtw_Shp_Jac) ! QPtw_Shp_Jac - END IF - Int_BufSz = Int_BufSz + 1 ! QPtw_ShpDer allocated yes/no - IF ( ALLOCATED(InData%QPtw_ShpDer) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! QPtw_ShpDer upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%QPtw_ShpDer) ! QPtw_ShpDer - END IF - Int_BufSz = Int_BufSz + 1 ! FEweight allocated yes/no - IF ( ALLOCATED(InData%FEweight) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FEweight upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%FEweight) ! FEweight - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_u_indx allocated yes/no - IF ( ALLOCATED(InData%Jac_u_indx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_u_indx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_u_indx) ! Jac_u_indx - END IF - Int_BufSz = Int_BufSz + 1 ! du allocated yes/no - IF ( ALLOCATED(InData%du) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! du upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%du) ! du - END IF - Db_BufSz = Db_BufSz + SIZE(InData%dx) ! dx - Int_BufSz = Int_BufSz + 1 ! Jac_ny - Int_BufSz = Int_BufSz + 1 ! Jac_nx - Int_BufSz = Int_BufSz + 1 ! RotStates - Int_BufSz = Int_BufSz + 1 ! RelStates - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%dt - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%coef,1), UBOUND(InData%coef,1) - DbKiBuf(Db_Xferred) = InData%coef(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DbKiBuf(Db_Xferred) = InData%rhoinf - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%uuN0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uuN0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uuN0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uuN0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uuN0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uuN0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uuN0,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%uuN0,3), UBOUND(InData%uuN0,3) - DO i2 = LBOUND(InData%uuN0,2), UBOUND(InData%uuN0,2) - DO i1 = LBOUND(InData%uuN0,1), UBOUND(InData%uuN0,1) - DbKiBuf(Db_Xferred) = InData%uuN0(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Stif0_QP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Stif0_QP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Stif0_QP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Stif0_QP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Stif0_QP,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Stif0_QP,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Stif0_QP,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Stif0_QP,3), UBOUND(InData%Stif0_QP,3) - DO i2 = LBOUND(InData%Stif0_QP,2), UBOUND(InData%Stif0_QP,2) - DO i1 = LBOUND(InData%Stif0_QP,1), UBOUND(InData%Stif0_QP,1) - DbKiBuf(Db_Xferred) = InData%Stif0_QP(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Mass0_QP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Mass0_QP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mass0_QP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Mass0_QP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mass0_QP,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Mass0_QP,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mass0_QP,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Mass0_QP,3), UBOUND(InData%Mass0_QP,3) - DO i2 = LBOUND(InData%Mass0_QP,2), UBOUND(InData%Mass0_QP,2) - DO i1 = LBOUND(InData%Mass0_QP,1), UBOUND(InData%Mass0_QP,1) - DbKiBuf(Db_Xferred) = InData%Mass0_QP(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%gravity,1), UBOUND(InData%gravity,1) - DbKiBuf(Db_Xferred) = InData%gravity(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%segment_eta) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%segment_eta,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%segment_eta,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%segment_eta,1), UBOUND(InData%segment_eta,1) - DbKiBuf(Db_Xferred) = InData%segment_eta(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%member_eta) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%member_eta,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%member_eta,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%member_eta,1), UBOUND(InData%member_eta,1) - DbKiBuf(Db_Xferred) = InData%member_eta(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - DbKiBuf(Db_Xferred) = InData%blade_length - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%blade_mass - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%blade_CG,1), UBOUND(InData%blade_CG,1) - DbKiBuf(Db_Xferred) = InData%blade_CG(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i2 = LBOUND(InData%blade_IN,2), UBOUND(InData%blade_IN,2) - DO i1 = LBOUND(InData%blade_IN,1), UBOUND(InData%blade_IN,1) - DbKiBuf(Db_Xferred) = InData%blade_IN(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DO i1 = LBOUND(InData%beta,1), UBOUND(InData%beta,1) - DbKiBuf(Db_Xferred) = InData%beta(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DbKiBuf(Db_Xferred) = InData%tol - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%GlbPos,1), UBOUND(InData%GlbPos,1) - DbKiBuf(Db_Xferred) = InData%GlbPos(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i2 = LBOUND(InData%GlbRot,2), UBOUND(InData%GlbRot,2) - DO i1 = LBOUND(InData%GlbRot,1), UBOUND(InData%GlbRot,1) - DbKiBuf(Db_Xferred) = InData%GlbRot(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DO i1 = LBOUND(InData%Glb_crv,1), UBOUND(InData%Glb_crv,1) - DbKiBuf(Db_Xferred) = InData%Glb_crv(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%QPtN) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtN,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%QPtN,1), UBOUND(InData%QPtN,1) - DbKiBuf(Db_Xferred) = InData%QPtN(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%QPtWeight) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtWeight,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtWeight,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%QPtWeight,1), UBOUND(InData%QPtWeight,1) - DbKiBuf(Db_Xferred) = InData%QPtWeight(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Shp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Shp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Shp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Shp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Shp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Shp,2), UBOUND(InData%Shp,2) - DO i1 = LBOUND(InData%Shp,1), UBOUND(InData%Shp,1) - DbKiBuf(Db_Xferred) = InData%Shp(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ShpDer) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ShpDer,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ShpDer,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ShpDer,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ShpDer,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ShpDer,2), UBOUND(InData%ShpDer,2) - DO i1 = LBOUND(InData%ShpDer,1), UBOUND(InData%ShpDer,1) - DbKiBuf(Db_Xferred) = InData%ShpDer(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jacobian) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jacobian,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jacobian,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jacobian,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jacobian,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jacobian,2), UBOUND(InData%Jacobian,2) - DO i1 = LBOUND(InData%Jacobian,1), UBOUND(InData%Jacobian,1) - DbKiBuf(Db_Xferred) = InData%Jacobian(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%uu0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uu0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uu0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uu0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uu0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uu0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uu0,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%uu0,3), UBOUND(InData%uu0,3) - DO i2 = LBOUND(InData%uu0,2), UBOUND(InData%uu0,2) - DO i1 = LBOUND(InData%uu0,1), UBOUND(InData%uu0,1) - DbKiBuf(Db_Xferred) = InData%uu0(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rrN0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rrN0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rrN0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rrN0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rrN0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rrN0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rrN0,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%rrN0,3), UBOUND(InData%rrN0,3) - DO i2 = LBOUND(InData%rrN0,2), UBOUND(InData%rrN0,2) - DO i1 = LBOUND(InData%rrN0,1), UBOUND(InData%rrN0,1) - DbKiBuf(Db_Xferred) = InData%rrN0(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%E10) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%E10,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%E10,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%E10,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%E10,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%E10,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%E10,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%E10,3), UBOUND(InData%E10,3) - DO i2 = LBOUND(InData%E10,2), UBOUND(InData%E10,2) - DO i1 = LBOUND(InData%E10,1), UBOUND(InData%E10,1) - DbKiBuf(Db_Xferred) = InData%E10(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%nodes_per_elem - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%node_elem_idx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%node_elem_idx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%node_elem_idx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%node_elem_idx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%node_elem_idx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%node_elem_idx,2), UBOUND(InData%node_elem_idx,2) - DO i1 = LBOUND(InData%node_elem_idx,1), UBOUND(InData%node_elem_idx,1) - IntKiBuf(Int_Xferred) = InData%node_elem_idx(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%refine - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%dof_node - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%dof_elem - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%rot_elem - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%elem_total - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%node_total - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%dof_total - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nqp - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%analysis_type - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%damp_flag - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ld_retries - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%niter - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%quadrature - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%n_fact - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%OutInputs, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutParam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParam,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NNodeOuts - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%OutNd,1), UBOUND(InData%OutNd,1) - IntKiBuf(Int_Xferred) = InData%OutNd(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%NdIndx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NdIndx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NdIndx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NdIndx,1), UBOUND(InData%NdIndx,1) - IntKiBuf(Int_Xferred) = InData%NdIndx(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NdIndxInverse) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NdIndxInverse,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NdIndxInverse,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NdIndxInverse,1), UBOUND(InData%NdIndxInverse,1) - IntKiBuf(Int_Xferred) = InData%NdIndxInverse(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OutNd2NdElem) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutNd2NdElem,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutNd2NdElem,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutNd2NdElem,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutNd2NdElem,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OutNd2NdElem,2), UBOUND(InData%OutNd2NdElem,2) - DO i1 = LBOUND(InData%OutNd2NdElem,1), UBOUND(InData%OutNd2NdElem,1) - IntKiBuf(Int_Xferred) = InData%OutNd2NdElem(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%UsePitchAct, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%pitchJ - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%pitchK - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%pitchC - Re_Xferred = Re_Xferred + 1 - DO i2 = LBOUND(InData%torqM,2), UBOUND(InData%torqM,2) - DO i1 = LBOUND(InData%torqM,1), UBOUND(InData%torqM,1) - ReKiBuf(Re_Xferred) = InData%torqM(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - CALL BD_PackqpParam( Re_Buf, Db_Buf, Int_Buf, InData%qp, ErrStat2, ErrMsg2, OnlySize ) ! qp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = InData%qp_indx_offset - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%BldMotionNodeLoc - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%tngt_stf_fd, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%tngt_stf_comp, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%tngt_stf_pert - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%tngt_stf_difftol - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%BldNd_NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%BldNd_TotNumOuts - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BldNd_OutParam) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldNd_OutParam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_OutParam,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BldNd_OutParam,1), UBOUND(InData%BldNd_OutParam,1) - CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! BldNd_OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BldNd_BlOutNd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldNd_BlOutNd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_BlOutNd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BldNd_BlOutNd,1), UBOUND(InData%BldNd_BlOutNd,1) - IntKiBuf(Int_Xferred) = InData%BldNd_BlOutNd(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%QPtw_Shp_Shp_Jac) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtw_Shp_Shp_Jac,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_Shp_Shp_Jac,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtw_Shp_Shp_Jac,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_Shp_Shp_Jac,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtw_Shp_Shp_Jac,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_Shp_Shp_Jac,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtw_Shp_Shp_Jac,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_Shp_Shp_Jac,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%QPtw_Shp_Shp_Jac,4), UBOUND(InData%QPtw_Shp_Shp_Jac,4) - DO i3 = LBOUND(InData%QPtw_Shp_Shp_Jac,3), UBOUND(InData%QPtw_Shp_Shp_Jac,3) - DO i2 = LBOUND(InData%QPtw_Shp_Shp_Jac,2), UBOUND(InData%QPtw_Shp_Shp_Jac,2) - DO i1 = LBOUND(InData%QPtw_Shp_Shp_Jac,1), UBOUND(InData%QPtw_Shp_Shp_Jac,1) - DbKiBuf(Db_Xferred) = InData%QPtw_Shp_Shp_Jac(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%QPtw_Shp_ShpDer) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtw_Shp_ShpDer,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_Shp_ShpDer,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtw_Shp_ShpDer,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_Shp_ShpDer,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtw_Shp_ShpDer,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_Shp_ShpDer,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%QPtw_Shp_ShpDer,3), UBOUND(InData%QPtw_Shp_ShpDer,3) - DO i2 = LBOUND(InData%QPtw_Shp_ShpDer,2), UBOUND(InData%QPtw_Shp_ShpDer,2) - DO i1 = LBOUND(InData%QPtw_Shp_ShpDer,1), UBOUND(InData%QPtw_Shp_ShpDer,1) - DbKiBuf(Db_Xferred) = InData%QPtw_Shp_ShpDer(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%QPtw_ShpDer_ShpDer_Jac) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtw_ShpDer_ShpDer_Jac,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_ShpDer_ShpDer_Jac,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtw_ShpDer_ShpDer_Jac,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_ShpDer_ShpDer_Jac,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtw_ShpDer_ShpDer_Jac,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_ShpDer_ShpDer_Jac,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtw_ShpDer_ShpDer_Jac,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_ShpDer_ShpDer_Jac,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%QPtw_ShpDer_ShpDer_Jac,4), UBOUND(InData%QPtw_ShpDer_ShpDer_Jac,4) - DO i3 = LBOUND(InData%QPtw_ShpDer_ShpDer_Jac,3), UBOUND(InData%QPtw_ShpDer_ShpDer_Jac,3) - DO i2 = LBOUND(InData%QPtw_ShpDer_ShpDer_Jac,2), UBOUND(InData%QPtw_ShpDer_ShpDer_Jac,2) - DO i1 = LBOUND(InData%QPtw_ShpDer_ShpDer_Jac,1), UBOUND(InData%QPtw_ShpDer_ShpDer_Jac,1) - DbKiBuf(Db_Xferred) = InData%QPtw_ShpDer_ShpDer_Jac(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%QPtw_Shp_Jac) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtw_Shp_Jac,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_Shp_Jac,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtw_Shp_Jac,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_Shp_Jac,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtw_Shp_Jac,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_Shp_Jac,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%QPtw_Shp_Jac,3), UBOUND(InData%QPtw_Shp_Jac,3) - DO i2 = LBOUND(InData%QPtw_Shp_Jac,2), UBOUND(InData%QPtw_Shp_Jac,2) - DO i1 = LBOUND(InData%QPtw_Shp_Jac,1), UBOUND(InData%QPtw_Shp_Jac,1) - DbKiBuf(Db_Xferred) = InData%QPtw_Shp_Jac(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%QPtw_ShpDer) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtw_ShpDer,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_ShpDer,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QPtw_ShpDer,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_ShpDer,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%QPtw_ShpDer,2), UBOUND(InData%QPtw_ShpDer,2) - DO i1 = LBOUND(InData%QPtw_ShpDer,1), UBOUND(InData%QPtw_ShpDer,1) - DbKiBuf(Db_Xferred) = InData%QPtw_ShpDer(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FEweight) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FEweight,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FEweight,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FEweight,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FEweight,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FEweight,2), UBOUND(InData%FEweight,2) - DO i1 = LBOUND(InData%FEweight,1), UBOUND(InData%FEweight,1) - DbKiBuf(Db_Xferred) = InData%FEweight(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jac_u_indx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_u_indx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_u_indx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jac_u_indx,2), UBOUND(InData%Jac_u_indx,2) - DO i1 = LBOUND(InData%Jac_u_indx,1), UBOUND(InData%Jac_u_indx,1) - IntKiBuf(Int_Xferred) = InData%Jac_u_indx(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%du) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%du,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%du,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%du,1), UBOUND(InData%du,1) - DbKiBuf(Db_Xferred) = InData%du(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - DO i1 = LBOUND(InData%dx,1), UBOUND(InData%dx,1) - DbKiBuf(Db_Xferred) = InData%dx(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%Jac_ny - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Jac_nx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotStates, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%RelStates, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE BD_PackParam - - SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(BD_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%dt = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%coef,1) - i1_u = UBOUND(OutData%coef,1) - DO i1 = LBOUND(OutData%coef,1), UBOUND(OutData%coef,1) - OutData%coef(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - OutData%rhoinf = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! uuN0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%uuN0)) DEALLOCATE(OutData%uuN0) - ALLOCATE(OutData%uuN0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%uuN0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%uuN0,3), UBOUND(OutData%uuN0,3) - DO i2 = LBOUND(OutData%uuN0,2), UBOUND(OutData%uuN0,2) - DO i1 = LBOUND(OutData%uuN0,1), UBOUND(OutData%uuN0,1) - OutData%uuN0(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Stif0_QP not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Stif0_QP)) DEALLOCATE(OutData%Stif0_QP) - ALLOCATE(OutData%Stif0_QP(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Stif0_QP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Stif0_QP,3), UBOUND(OutData%Stif0_QP,3) - DO i2 = LBOUND(OutData%Stif0_QP,2), UBOUND(OutData%Stif0_QP,2) - DO i1 = LBOUND(OutData%Stif0_QP,1), UBOUND(OutData%Stif0_QP,1) - OutData%Stif0_QP(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Mass0_QP not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Mass0_QP)) DEALLOCATE(OutData%Mass0_QP) - ALLOCATE(OutData%Mass0_QP(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mass0_QP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Mass0_QP,3), UBOUND(OutData%Mass0_QP,3) - DO i2 = LBOUND(OutData%Mass0_QP,2), UBOUND(OutData%Mass0_QP,2) - DO i1 = LBOUND(OutData%Mass0_QP,1), UBOUND(OutData%Mass0_QP,1) - OutData%Mass0_QP(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%gravity,1) - i1_u = UBOUND(OutData%gravity,1) - DO i1 = LBOUND(OutData%gravity,1), UBOUND(OutData%gravity,1) - OutData%gravity(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! segment_eta not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%segment_eta)) DEALLOCATE(OutData%segment_eta) - ALLOCATE(OutData%segment_eta(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%segment_eta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%segment_eta,1), UBOUND(OutData%segment_eta,1) - OutData%segment_eta(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! member_eta not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%member_eta)) DEALLOCATE(OutData%member_eta) - ALLOCATE(OutData%member_eta(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%member_eta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%member_eta,1), UBOUND(OutData%member_eta,1) - OutData%member_eta(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - OutData%blade_length = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%blade_mass = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%blade_CG,1) - i1_u = UBOUND(OutData%blade_CG,1) - DO i1 = LBOUND(OutData%blade_CG,1), UBOUND(OutData%blade_CG,1) - OutData%blade_CG(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%blade_IN,1) - i1_u = UBOUND(OutData%blade_IN,1) - i2_l = LBOUND(OutData%blade_IN,2) - i2_u = UBOUND(OutData%blade_IN,2) - DO i2 = LBOUND(OutData%blade_IN,2), UBOUND(OutData%blade_IN,2) - DO i1 = LBOUND(OutData%blade_IN,1), UBOUND(OutData%blade_IN,1) - OutData%blade_IN(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%beta,1) - i1_u = UBOUND(OutData%beta,1) - DO i1 = LBOUND(OutData%beta,1), UBOUND(OutData%beta,1) - OutData%beta(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - OutData%tol = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%GlbPos,1) - i1_u = UBOUND(OutData%GlbPos,1) - DO i1 = LBOUND(OutData%GlbPos,1), UBOUND(OutData%GlbPos,1) - OutData%GlbPos(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%GlbRot,1) - i1_u = UBOUND(OutData%GlbRot,1) - i2_l = LBOUND(OutData%GlbRot,2) - i2_u = UBOUND(OutData%GlbRot,2) - DO i2 = LBOUND(OutData%GlbRot,2), UBOUND(OutData%GlbRot,2) - DO i1 = LBOUND(OutData%GlbRot,1), UBOUND(OutData%GlbRot,1) - OutData%GlbRot(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%Glb_crv,1) - i1_u = UBOUND(OutData%Glb_crv,1) - DO i1 = LBOUND(OutData%Glb_crv,1), UBOUND(OutData%Glb_crv,1) - OutData%Glb_crv(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QPtN not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%QPtN)) DEALLOCATE(OutData%QPtN) - ALLOCATE(OutData%QPtN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%QPtN,1), UBOUND(OutData%QPtN,1) - OutData%QPtN(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QPtWeight not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%QPtWeight)) DEALLOCATE(OutData%QPtWeight) - ALLOCATE(OutData%QPtWeight(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtWeight.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%QPtWeight,1), UBOUND(OutData%QPtWeight,1) - OutData%QPtWeight(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Shp not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Shp)) DEALLOCATE(OutData%Shp) - ALLOCATE(OutData%Shp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Shp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Shp,2), UBOUND(OutData%Shp,2) - DO i1 = LBOUND(OutData%Shp,1), UBOUND(OutData%Shp,1) - OutData%Shp(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ShpDer not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ShpDer)) DEALLOCATE(OutData%ShpDer) - ALLOCATE(OutData%ShpDer(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ShpDer.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ShpDer,2), UBOUND(OutData%ShpDer,2) - DO i1 = LBOUND(OutData%ShpDer,1), UBOUND(OutData%ShpDer,1) - OutData%ShpDer(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jacobian not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Jacobian)) DEALLOCATE(OutData%Jacobian) - ALLOCATE(OutData%Jacobian(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jacobian.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jacobian,2), UBOUND(OutData%Jacobian,2) - DO i1 = LBOUND(OutData%Jacobian,1), UBOUND(OutData%Jacobian,1) - OutData%Jacobian(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! uu0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%uu0)) DEALLOCATE(OutData%uu0) - ALLOCATE(OutData%uu0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%uu0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%uu0,3), UBOUND(OutData%uu0,3) - DO i2 = LBOUND(OutData%uu0,2), UBOUND(OutData%uu0,2) - DO i1 = LBOUND(OutData%uu0,1), UBOUND(OutData%uu0,1) - OutData%uu0(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rrN0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rrN0)) DEALLOCATE(OutData%rrN0) - ALLOCATE(OutData%rrN0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rrN0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%rrN0,3), UBOUND(OutData%rrN0,3) - DO i2 = LBOUND(OutData%rrN0,2), UBOUND(OutData%rrN0,2) - DO i1 = LBOUND(OutData%rrN0,1), UBOUND(OutData%rrN0,1) - OutData%rrN0(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! E10 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%E10)) DEALLOCATE(OutData%E10) - ALLOCATE(OutData%E10(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%E10.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%E10,3), UBOUND(OutData%E10,3) - DO i2 = LBOUND(OutData%E10,2), UBOUND(OutData%E10,2) - DO i1 = LBOUND(OutData%E10,1), UBOUND(OutData%E10,1) - OutData%E10(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%nodes_per_elem = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! node_elem_idx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%node_elem_idx)) DEALLOCATE(OutData%node_elem_idx) - ALLOCATE(OutData%node_elem_idx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%node_elem_idx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%node_elem_idx,2), UBOUND(OutData%node_elem_idx,2) - DO i1 = LBOUND(OutData%node_elem_idx,1), UBOUND(OutData%node_elem_idx,1) - OutData%node_elem_idx(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - OutData%refine = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%dof_node = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%dof_elem = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%rot_elem = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%elem_total = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%node_total = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%dof_total = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nqp = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%analysis_type = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%damp_flag = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ld_retries = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%niter = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%quadrature = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%n_fact = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%OutInputs = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutInputs) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutParam)) DEALLOCATE(OutData%OutParam) - ALLOCATE(OutData%OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutParam,1), UBOUND(OutData%OutParam,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackOutParmType( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - OutData%NNodeOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%OutNd,1) - i1_u = UBOUND(OutData%OutNd,1) - DO i1 = LBOUND(OutData%OutNd,1), UBOUND(OutData%OutNd,1) - OutData%OutNd(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NdIndx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NdIndx)) DEALLOCATE(OutData%NdIndx) - ALLOCATE(OutData%NdIndx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NdIndx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NdIndx,1), UBOUND(OutData%NdIndx,1) - OutData%NdIndx(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NdIndxInverse not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NdIndxInverse)) DEALLOCATE(OutData%NdIndxInverse) - ALLOCATE(OutData%NdIndxInverse(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NdIndxInverse.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NdIndxInverse,1), UBOUND(OutData%NdIndxInverse,1) - OutData%NdIndxInverse(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutNd2NdElem not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutNd2NdElem)) DEALLOCATE(OutData%OutNd2NdElem) - ALLOCATE(OutData%OutNd2NdElem(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutNd2NdElem.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OutNd2NdElem,2), UBOUND(OutData%OutNd2NdElem,2) - DO i1 = LBOUND(OutData%OutNd2NdElem,1), UBOUND(OutData%OutNd2NdElem,1) - OutData%OutNd2NdElem(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UsePitchAct = TRANSFER(IntKiBuf(Int_Xferred), OutData%UsePitchAct) - Int_Xferred = Int_Xferred + 1 - OutData%pitchJ = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%pitchK = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%pitchC = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%torqM,1) - i1_u = UBOUND(OutData%torqM,1) - i2_l = LBOUND(OutData%torqM,2) - i2_u = UBOUND(OutData%torqM,2) - DO i2 = LBOUND(OutData%torqM,2), UBOUND(OutData%torqM,2) - DO i1 = LBOUND(OutData%torqM,1), UBOUND(OutData%torqM,1) - OutData%torqM(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL BD_UnpackqpParam( Re_Buf, Db_Buf, Int_Buf, OutData%qp, ErrStat2, ErrMsg2 ) ! qp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%qp_indx_offset = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%BldMotionNodeLoc = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%tngt_stf_fd = TRANSFER(IntKiBuf(Int_Xferred), OutData%tngt_stf_fd) - Int_Xferred = Int_Xferred + 1 - OutData%tngt_stf_comp = TRANSFER(IntKiBuf(Int_Xferred), OutData%tngt_stf_comp) - Int_Xferred = Int_Xferred + 1 - OutData%tngt_stf_pert = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%tngt_stf_difftol = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%BldNd_NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%BldNd_TotNumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_OutParam not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BldNd_OutParam)) DEALLOCATE(OutData%BldNd_OutParam) - ALLOCATE(OutData%BldNd_OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BldNd_OutParam,1), UBOUND(OutData%BldNd_OutParam,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackOutParmType( Re_Buf, Db_Buf, Int_Buf, OutData%BldNd_OutParam(i1), ErrStat2, ErrMsg2 ) ! BldNd_OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_BlOutNd not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BldNd_BlOutNd)) DEALLOCATE(OutData%BldNd_BlOutNd) - ALLOCATE(OutData%BldNd_BlOutNd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_BlOutNd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BldNd_BlOutNd,1), UBOUND(OutData%BldNd_BlOutNd,1) - OutData%BldNd_BlOutNd(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QPtw_Shp_Shp_Jac not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%QPtw_Shp_Shp_Jac)) DEALLOCATE(OutData%QPtw_Shp_Shp_Jac) - ALLOCATE(OutData%QPtw_Shp_Shp_Jac(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtw_Shp_Shp_Jac.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%QPtw_Shp_Shp_Jac,4), UBOUND(OutData%QPtw_Shp_Shp_Jac,4) - DO i3 = LBOUND(OutData%QPtw_Shp_Shp_Jac,3), UBOUND(OutData%QPtw_Shp_Shp_Jac,3) - DO i2 = LBOUND(OutData%QPtw_Shp_Shp_Jac,2), UBOUND(OutData%QPtw_Shp_Shp_Jac,2) - DO i1 = LBOUND(OutData%QPtw_Shp_Shp_Jac,1), UBOUND(OutData%QPtw_Shp_Shp_Jac,1) - OutData%QPtw_Shp_Shp_Jac(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QPtw_Shp_ShpDer not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%QPtw_Shp_ShpDer)) DEALLOCATE(OutData%QPtw_Shp_ShpDer) - ALLOCATE(OutData%QPtw_Shp_ShpDer(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtw_Shp_ShpDer.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%QPtw_Shp_ShpDer,3), UBOUND(OutData%QPtw_Shp_ShpDer,3) - DO i2 = LBOUND(OutData%QPtw_Shp_ShpDer,2), UBOUND(OutData%QPtw_Shp_ShpDer,2) - DO i1 = LBOUND(OutData%QPtw_Shp_ShpDer,1), UBOUND(OutData%QPtw_Shp_ShpDer,1) - OutData%QPtw_Shp_ShpDer(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QPtw_ShpDer_ShpDer_Jac not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%QPtw_ShpDer_ShpDer_Jac)) DEALLOCATE(OutData%QPtw_ShpDer_ShpDer_Jac) - ALLOCATE(OutData%QPtw_ShpDer_ShpDer_Jac(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtw_ShpDer_ShpDer_Jac.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,4), UBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,4) - DO i3 = LBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,3), UBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,3) - DO i2 = LBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,2), UBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,2) - DO i1 = LBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,1), UBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,1) - OutData%QPtw_ShpDer_ShpDer_Jac(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QPtw_Shp_Jac not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%QPtw_Shp_Jac)) DEALLOCATE(OutData%QPtw_Shp_Jac) - ALLOCATE(OutData%QPtw_Shp_Jac(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtw_Shp_Jac.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%QPtw_Shp_Jac,3), UBOUND(OutData%QPtw_Shp_Jac,3) - DO i2 = LBOUND(OutData%QPtw_Shp_Jac,2), UBOUND(OutData%QPtw_Shp_Jac,2) - DO i1 = LBOUND(OutData%QPtw_Shp_Jac,1), UBOUND(OutData%QPtw_Shp_Jac,1) - OutData%QPtw_Shp_Jac(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QPtw_ShpDer not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%QPtw_ShpDer)) DEALLOCATE(OutData%QPtw_ShpDer) - ALLOCATE(OutData%QPtw_ShpDer(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtw_ShpDer.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%QPtw_ShpDer,2), UBOUND(OutData%QPtw_ShpDer,2) - DO i1 = LBOUND(OutData%QPtw_ShpDer,1), UBOUND(OutData%QPtw_ShpDer,1) - OutData%QPtw_ShpDer(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FEweight not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FEweight)) DEALLOCATE(OutData%FEweight) - ALLOCATE(OutData%FEweight(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FEweight.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FEweight,2), UBOUND(OutData%FEweight,2) - DO i1 = LBOUND(OutData%FEweight,1), UBOUND(OutData%FEweight,1) - OutData%FEweight(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_u_indx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Jac_u_indx)) DEALLOCATE(OutData%Jac_u_indx) - ALLOCATE(OutData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_u_indx,2), UBOUND(OutData%Jac_u_indx,2) - DO i1 = LBOUND(OutData%Jac_u_indx,1), UBOUND(OutData%Jac_u_indx,1) - OutData%Jac_u_indx(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! du not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%du)) DEALLOCATE(OutData%du) - ALLOCATE(OutData%du(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%du,1), UBOUND(OutData%du,1) - OutData%du(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - i1_l = LBOUND(OutData%dx,1) - i1_u = UBOUND(OutData%dx,1) - DO i1 = LBOUND(OutData%dx,1), UBOUND(OutData%dx,1) - OutData%dx(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - OutData%Jac_ny = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Jac_nx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%RotStates = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotStates) - Int_Xferred = Int_Xferred + 1 - OutData%RelStates = TRANSFER(IntKiBuf(Int_Xferred), OutData%RelStates) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE BD_UnPackParam +subroutine BD_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BD_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BD_PackParam' + integer(IntKi) :: i1, i2, i3, i4 + integer(IntKi) :: LB(4), UB(4) + if (Buf%ErrStat >= AbortErrLev) return + ! dt + call RegPack(Buf, InData%dt) + if (RegCheckErr(Buf, RoutineName)) return + ! coef + call RegPack(Buf, InData%coef) + if (RegCheckErr(Buf, RoutineName)) return + ! rhoinf + call RegPack(Buf, InData%rhoinf) + if (RegCheckErr(Buf, RoutineName)) return + ! uuN0 + call RegPack(Buf, allocated(InData%uuN0)) + if (allocated(InData%uuN0)) then + call RegPackBounds(Buf, 3, lbound(InData%uuN0), ubound(InData%uuN0)) + call RegPack(Buf, InData%uuN0) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Stif0_QP + call RegPack(Buf, allocated(InData%Stif0_QP)) + if (allocated(InData%Stif0_QP)) then + call RegPackBounds(Buf, 3, lbound(InData%Stif0_QP), ubound(InData%Stif0_QP)) + call RegPack(Buf, InData%Stif0_QP) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Mass0_QP + call RegPack(Buf, allocated(InData%Mass0_QP)) + if (allocated(InData%Mass0_QP)) then + call RegPackBounds(Buf, 3, lbound(InData%Mass0_QP), ubound(InData%Mass0_QP)) + call RegPack(Buf, InData%Mass0_QP) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! gravity + call RegPack(Buf, InData%gravity) + if (RegCheckErr(Buf, RoutineName)) return + ! segment_eta + call RegPack(Buf, allocated(InData%segment_eta)) + if (allocated(InData%segment_eta)) then + call RegPackBounds(Buf, 1, lbound(InData%segment_eta), ubound(InData%segment_eta)) + call RegPack(Buf, InData%segment_eta) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! member_eta + call RegPack(Buf, allocated(InData%member_eta)) + if (allocated(InData%member_eta)) then + call RegPackBounds(Buf, 1, lbound(InData%member_eta), ubound(InData%member_eta)) + call RegPack(Buf, InData%member_eta) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! blade_length + call RegPack(Buf, InData%blade_length) + if (RegCheckErr(Buf, RoutineName)) return + ! blade_mass + call RegPack(Buf, InData%blade_mass) + if (RegCheckErr(Buf, RoutineName)) return + ! blade_CG + call RegPack(Buf, InData%blade_CG) + if (RegCheckErr(Buf, RoutineName)) return + ! blade_IN + call RegPack(Buf, InData%blade_IN) + if (RegCheckErr(Buf, RoutineName)) return + ! beta + call RegPack(Buf, InData%beta) + if (RegCheckErr(Buf, RoutineName)) return + ! tol + call RegPack(Buf, InData%tol) + if (RegCheckErr(Buf, RoutineName)) return + ! GlbPos + call RegPack(Buf, InData%GlbPos) + if (RegCheckErr(Buf, RoutineName)) return + ! GlbRot + call RegPack(Buf, InData%GlbRot) + if (RegCheckErr(Buf, RoutineName)) return + ! Glb_crv + call RegPack(Buf, InData%Glb_crv) + if (RegCheckErr(Buf, RoutineName)) return + ! QPtN + call RegPack(Buf, allocated(InData%QPtN)) + if (allocated(InData%QPtN)) then + call RegPackBounds(Buf, 1, lbound(InData%QPtN), ubound(InData%QPtN)) + call RegPack(Buf, InData%QPtN) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! QPtWeight + call RegPack(Buf, allocated(InData%QPtWeight)) + if (allocated(InData%QPtWeight)) then + call RegPackBounds(Buf, 1, lbound(InData%QPtWeight), ubound(InData%QPtWeight)) + call RegPack(Buf, InData%QPtWeight) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Shp + call RegPack(Buf, allocated(InData%Shp)) + if (allocated(InData%Shp)) then + call RegPackBounds(Buf, 2, lbound(InData%Shp), ubound(InData%Shp)) + call RegPack(Buf, InData%Shp) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ShpDer + call RegPack(Buf, allocated(InData%ShpDer)) + if (allocated(InData%ShpDer)) then + call RegPackBounds(Buf, 2, lbound(InData%ShpDer), ubound(InData%ShpDer)) + call RegPack(Buf, InData%ShpDer) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Jacobian + call RegPack(Buf, allocated(InData%Jacobian)) + if (allocated(InData%Jacobian)) then + call RegPackBounds(Buf, 2, lbound(InData%Jacobian), ubound(InData%Jacobian)) + call RegPack(Buf, InData%Jacobian) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! uu0 + call RegPack(Buf, allocated(InData%uu0)) + if (allocated(InData%uu0)) then + call RegPackBounds(Buf, 3, lbound(InData%uu0), ubound(InData%uu0)) + call RegPack(Buf, InData%uu0) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! rrN0 + call RegPack(Buf, allocated(InData%rrN0)) + if (allocated(InData%rrN0)) then + call RegPackBounds(Buf, 3, lbound(InData%rrN0), ubound(InData%rrN0)) + call RegPack(Buf, InData%rrN0) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! E10 + call RegPack(Buf, allocated(InData%E10)) + if (allocated(InData%E10)) then + call RegPackBounds(Buf, 3, lbound(InData%E10), ubound(InData%E10)) + call RegPack(Buf, InData%E10) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! nodes_per_elem + call RegPack(Buf, InData%nodes_per_elem) + if (RegCheckErr(Buf, RoutineName)) return + ! node_elem_idx + call RegPack(Buf, allocated(InData%node_elem_idx)) + if (allocated(InData%node_elem_idx)) then + call RegPackBounds(Buf, 2, lbound(InData%node_elem_idx), ubound(InData%node_elem_idx)) + call RegPack(Buf, InData%node_elem_idx) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! refine + call RegPack(Buf, InData%refine) + if (RegCheckErr(Buf, RoutineName)) return + ! dof_node + call RegPack(Buf, InData%dof_node) + if (RegCheckErr(Buf, RoutineName)) return + ! dof_elem + call RegPack(Buf, InData%dof_elem) + if (RegCheckErr(Buf, RoutineName)) return + ! rot_elem + call RegPack(Buf, InData%rot_elem) + if (RegCheckErr(Buf, RoutineName)) return + ! elem_total + call RegPack(Buf, InData%elem_total) + if (RegCheckErr(Buf, RoutineName)) return + ! node_total + call RegPack(Buf, InData%node_total) + if (RegCheckErr(Buf, RoutineName)) return + ! dof_total + call RegPack(Buf, InData%dof_total) + if (RegCheckErr(Buf, RoutineName)) return + ! nqp + call RegPack(Buf, InData%nqp) + if (RegCheckErr(Buf, RoutineName)) return + ! analysis_type + call RegPack(Buf, InData%analysis_type) + if (RegCheckErr(Buf, RoutineName)) return + ! damp_flag + call RegPack(Buf, InData%damp_flag) + if (RegCheckErr(Buf, RoutineName)) return + ! ld_retries + call RegPack(Buf, InData%ld_retries) + if (RegCheckErr(Buf, RoutineName)) return + ! niter + call RegPack(Buf, InData%niter) + if (RegCheckErr(Buf, RoutineName)) return + ! quadrature + call RegPack(Buf, InData%quadrature) + if (RegCheckErr(Buf, RoutineName)) return + ! n_fact + call RegPack(Buf, InData%n_fact) + if (RegCheckErr(Buf, RoutineName)) return + ! OutInputs + call RegPack(Buf, InData%OutInputs) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegPack(Buf, InData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! OutParam + call RegPack(Buf, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NNodeOuts + call RegPack(Buf, InData%NNodeOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! OutNd + call RegPack(Buf, InData%OutNd) + if (RegCheckErr(Buf, RoutineName)) return + ! NdIndx + call RegPack(Buf, allocated(InData%NdIndx)) + if (allocated(InData%NdIndx)) then + call RegPackBounds(Buf, 1, lbound(InData%NdIndx), ubound(InData%NdIndx)) + call RegPack(Buf, InData%NdIndx) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NdIndxInverse + call RegPack(Buf, allocated(InData%NdIndxInverse)) + if (allocated(InData%NdIndxInverse)) then + call RegPackBounds(Buf, 1, lbound(InData%NdIndxInverse), ubound(InData%NdIndxInverse)) + call RegPack(Buf, InData%NdIndxInverse) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OutNd2NdElem + call RegPack(Buf, allocated(InData%OutNd2NdElem)) + if (allocated(InData%OutNd2NdElem)) then + call RegPackBounds(Buf, 2, lbound(InData%OutNd2NdElem), ubound(InData%OutNd2NdElem)) + call RegPack(Buf, InData%OutNd2NdElem) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OutFmt + call RegPack(Buf, InData%OutFmt) + if (RegCheckErr(Buf, RoutineName)) return + ! UsePitchAct + call RegPack(Buf, InData%UsePitchAct) + if (RegCheckErr(Buf, RoutineName)) return + ! pitchJ + call RegPack(Buf, InData%pitchJ) + if (RegCheckErr(Buf, RoutineName)) return + ! pitchK + call RegPack(Buf, InData%pitchK) + if (RegCheckErr(Buf, RoutineName)) return + ! pitchC + call RegPack(Buf, InData%pitchC) + if (RegCheckErr(Buf, RoutineName)) return + ! torqM + call RegPack(Buf, InData%torqM) + if (RegCheckErr(Buf, RoutineName)) return + ! qp + call BD_PackqpParam(Buf, InData%qp) + if (RegCheckErr(Buf, RoutineName)) return + ! qp_indx_offset + call RegPack(Buf, InData%qp_indx_offset) + if (RegCheckErr(Buf, RoutineName)) return + ! BldMotionNodeLoc + call RegPack(Buf, InData%BldMotionNodeLoc) + if (RegCheckErr(Buf, RoutineName)) return + ! tngt_stf_fd + call RegPack(Buf, InData%tngt_stf_fd) + if (RegCheckErr(Buf, RoutineName)) return + ! tngt_stf_comp + call RegPack(Buf, InData%tngt_stf_comp) + if (RegCheckErr(Buf, RoutineName)) return + ! tngt_stf_pert + call RegPack(Buf, InData%tngt_stf_pert) + if (RegCheckErr(Buf, RoutineName)) return + ! tngt_stf_difftol + call RegPack(Buf, InData%tngt_stf_difftol) + if (RegCheckErr(Buf, RoutineName)) return + ! BldNd_NumOuts + call RegPack(Buf, InData%BldNd_NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! BldNd_TotNumOuts + call RegPack(Buf, InData%BldNd_TotNumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! BldNd_OutParam + call RegPack(Buf, allocated(InData%BldNd_OutParam)) + if (allocated(InData%BldNd_OutParam)) then + call RegPackBounds(Buf, 1, lbound(InData%BldNd_OutParam), ubound(InData%BldNd_OutParam)) + LB(1:1) = lbound(InData%BldNd_OutParam) + UB(1:1) = ubound(InData%BldNd_OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(Buf, InData%BldNd_OutParam(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BldNd_BlOutNd + call RegPack(Buf, allocated(InData%BldNd_BlOutNd)) + if (allocated(InData%BldNd_BlOutNd)) then + call RegPackBounds(Buf, 1, lbound(InData%BldNd_BlOutNd), ubound(InData%BldNd_BlOutNd)) + call RegPack(Buf, InData%BldNd_BlOutNd) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! QPtw_Shp_Shp_Jac + call RegPack(Buf, allocated(InData%QPtw_Shp_Shp_Jac)) + if (allocated(InData%QPtw_Shp_Shp_Jac)) then + call RegPackBounds(Buf, 4, lbound(InData%QPtw_Shp_Shp_Jac), ubound(InData%QPtw_Shp_Shp_Jac)) + call RegPack(Buf, InData%QPtw_Shp_Shp_Jac) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! QPtw_Shp_ShpDer + call RegPack(Buf, allocated(InData%QPtw_Shp_ShpDer)) + if (allocated(InData%QPtw_Shp_ShpDer)) then + call RegPackBounds(Buf, 3, lbound(InData%QPtw_Shp_ShpDer), ubound(InData%QPtw_Shp_ShpDer)) + call RegPack(Buf, InData%QPtw_Shp_ShpDer) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! QPtw_ShpDer_ShpDer_Jac + call RegPack(Buf, allocated(InData%QPtw_ShpDer_ShpDer_Jac)) + if (allocated(InData%QPtw_ShpDer_ShpDer_Jac)) then + call RegPackBounds(Buf, 4, lbound(InData%QPtw_ShpDer_ShpDer_Jac), ubound(InData%QPtw_ShpDer_ShpDer_Jac)) + call RegPack(Buf, InData%QPtw_ShpDer_ShpDer_Jac) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! QPtw_Shp_Jac + call RegPack(Buf, allocated(InData%QPtw_Shp_Jac)) + if (allocated(InData%QPtw_Shp_Jac)) then + call RegPackBounds(Buf, 3, lbound(InData%QPtw_Shp_Jac), ubound(InData%QPtw_Shp_Jac)) + call RegPack(Buf, InData%QPtw_Shp_Jac) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! QPtw_ShpDer + call RegPack(Buf, allocated(InData%QPtw_ShpDer)) + if (allocated(InData%QPtw_ShpDer)) then + call RegPackBounds(Buf, 2, lbound(InData%QPtw_ShpDer), ubound(InData%QPtw_ShpDer)) + call RegPack(Buf, InData%QPtw_ShpDer) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FEweight + call RegPack(Buf, allocated(InData%FEweight)) + if (allocated(InData%FEweight)) then + call RegPackBounds(Buf, 2, lbound(InData%FEweight), ubound(InData%FEweight)) + call RegPack(Buf, InData%FEweight) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_u_indx + call RegPack(Buf, allocated(InData%Jac_u_indx)) + if (allocated(InData%Jac_u_indx)) then + call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx), ubound(InData%Jac_u_indx)) + call RegPack(Buf, InData%Jac_u_indx) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! du + call RegPack(Buf, allocated(InData%du)) + if (allocated(InData%du)) then + call RegPackBounds(Buf, 1, lbound(InData%du), ubound(InData%du)) + call RegPack(Buf, InData%du) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! dx + call RegPack(Buf, InData%dx) + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_ny + call RegPack(Buf, InData%Jac_ny) + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_nx + call RegPack(Buf, InData%Jac_nx) + if (RegCheckErr(Buf, RoutineName)) return + ! RotStates + call RegPack(Buf, InData%RotStates) + if (RegCheckErr(Buf, RoutineName)) return + ! RelStates + call RegPack(Buf, InData%RelStates) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BD_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BD_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BD_UnPackParam' + integer(IntKi) :: i1, i2, i3, i4 + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! dt + call RegUnpack(Buf, OutData%dt) + if (RegCheckErr(Buf, RoutineName)) return + ! coef + call RegUnpack(Buf, OutData%coef) + if (RegCheckErr(Buf, RoutineName)) return + ! rhoinf + call RegUnpack(Buf, OutData%rhoinf) + if (RegCheckErr(Buf, RoutineName)) return + ! uuN0 + if (allocated(OutData%uuN0)) deallocate(OutData%uuN0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%uuN0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%uuN0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%uuN0) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Stif0_QP + if (allocated(OutData%Stif0_QP)) deallocate(OutData%Stif0_QP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Stif0_QP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Stif0_QP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Stif0_QP) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Mass0_QP + if (allocated(OutData%Mass0_QP)) deallocate(OutData%Mass0_QP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Mass0_QP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mass0_QP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Mass0_QP) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! gravity + call RegUnpack(Buf, OutData%gravity) + if (RegCheckErr(Buf, RoutineName)) return + ! segment_eta + if (allocated(OutData%segment_eta)) deallocate(OutData%segment_eta) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%segment_eta(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%segment_eta.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%segment_eta) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! member_eta + if (allocated(OutData%member_eta)) deallocate(OutData%member_eta) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%member_eta(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%member_eta.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%member_eta) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! blade_length + call RegUnpack(Buf, OutData%blade_length) + if (RegCheckErr(Buf, RoutineName)) return + ! blade_mass + call RegUnpack(Buf, OutData%blade_mass) + if (RegCheckErr(Buf, RoutineName)) return + ! blade_CG + call RegUnpack(Buf, OutData%blade_CG) + if (RegCheckErr(Buf, RoutineName)) return + ! blade_IN + call RegUnpack(Buf, OutData%blade_IN) + if (RegCheckErr(Buf, RoutineName)) return + ! beta + call RegUnpack(Buf, OutData%beta) + if (RegCheckErr(Buf, RoutineName)) return + ! tol + call RegUnpack(Buf, OutData%tol) + if (RegCheckErr(Buf, RoutineName)) return + ! GlbPos + call RegUnpack(Buf, OutData%GlbPos) + if (RegCheckErr(Buf, RoutineName)) return + ! GlbRot + call RegUnpack(Buf, OutData%GlbRot) + if (RegCheckErr(Buf, RoutineName)) return + ! Glb_crv + call RegUnpack(Buf, OutData%Glb_crv) + if (RegCheckErr(Buf, RoutineName)) return + ! QPtN + if (allocated(OutData%QPtN)) deallocate(OutData%QPtN) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%QPtN(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%QPtN) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! QPtWeight + if (allocated(OutData%QPtWeight)) deallocate(OutData%QPtWeight) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%QPtWeight(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtWeight.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%QPtWeight) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Shp + if (allocated(OutData%Shp)) deallocate(OutData%Shp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Shp(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Shp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Shp) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ShpDer + if (allocated(OutData%ShpDer)) deallocate(OutData%ShpDer) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ShpDer(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ShpDer.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ShpDer) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Jacobian + if (allocated(OutData%Jacobian)) deallocate(OutData%Jacobian) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jacobian(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jacobian.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jacobian) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! uu0 + if (allocated(OutData%uu0)) deallocate(OutData%uu0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%uu0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%uu0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%uu0) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! rrN0 + if (allocated(OutData%rrN0)) deallocate(OutData%rrN0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rrN0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rrN0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rrN0) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! E10 + if (allocated(OutData%E10)) deallocate(OutData%E10) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%E10(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%E10.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%E10) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! nodes_per_elem + call RegUnpack(Buf, OutData%nodes_per_elem) + if (RegCheckErr(Buf, RoutineName)) return + ! node_elem_idx + if (allocated(OutData%node_elem_idx)) deallocate(OutData%node_elem_idx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%node_elem_idx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%node_elem_idx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%node_elem_idx) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! refine + call RegUnpack(Buf, OutData%refine) + if (RegCheckErr(Buf, RoutineName)) return + ! dof_node + call RegUnpack(Buf, OutData%dof_node) + if (RegCheckErr(Buf, RoutineName)) return + ! dof_elem + call RegUnpack(Buf, OutData%dof_elem) + if (RegCheckErr(Buf, RoutineName)) return + ! rot_elem + call RegUnpack(Buf, OutData%rot_elem) + if (RegCheckErr(Buf, RoutineName)) return + ! elem_total + call RegUnpack(Buf, OutData%elem_total) + if (RegCheckErr(Buf, RoutineName)) return + ! node_total + call RegUnpack(Buf, OutData%node_total) + if (RegCheckErr(Buf, RoutineName)) return + ! dof_total + call RegUnpack(Buf, OutData%dof_total) + if (RegCheckErr(Buf, RoutineName)) return + ! nqp + call RegUnpack(Buf, OutData%nqp) + if (RegCheckErr(Buf, RoutineName)) return + ! analysis_type + call RegUnpack(Buf, OutData%analysis_type) + if (RegCheckErr(Buf, RoutineName)) return + ! damp_flag + call RegUnpack(Buf, OutData%damp_flag) + if (RegCheckErr(Buf, RoutineName)) return + ! ld_retries + call RegUnpack(Buf, OutData%ld_retries) + if (RegCheckErr(Buf, RoutineName)) return + ! niter + call RegUnpack(Buf, OutData%niter) + if (RegCheckErr(Buf, RoutineName)) return + ! quadrature + call RegUnpack(Buf, OutData%quadrature) + if (RegCheckErr(Buf, RoutineName)) return + ! n_fact + call RegUnpack(Buf, OutData%n_fact) + if (RegCheckErr(Buf, RoutineName)) return + ! OutInputs + call RegUnpack(Buf, OutData%OutInputs) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! OutParam + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam + end do + end if + ! NNodeOuts + call RegUnpack(Buf, OutData%NNodeOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! OutNd + call RegUnpack(Buf, OutData%OutNd) + if (RegCheckErr(Buf, RoutineName)) return + ! NdIndx + if (allocated(OutData%NdIndx)) deallocate(OutData%NdIndx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NdIndx(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NdIndx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%NdIndx) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NdIndxInverse + if (allocated(OutData%NdIndxInverse)) deallocate(OutData%NdIndxInverse) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NdIndxInverse(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NdIndxInverse.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%NdIndxInverse) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! OutNd2NdElem + if (allocated(OutData%OutNd2NdElem)) deallocate(OutData%OutNd2NdElem) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutNd2NdElem(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutNd2NdElem.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutNd2NdElem) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! OutFmt + call RegUnpack(Buf, OutData%OutFmt) + if (RegCheckErr(Buf, RoutineName)) return + ! UsePitchAct + call RegUnpack(Buf, OutData%UsePitchAct) + if (RegCheckErr(Buf, RoutineName)) return + ! pitchJ + call RegUnpack(Buf, OutData%pitchJ) + if (RegCheckErr(Buf, RoutineName)) return + ! pitchK + call RegUnpack(Buf, OutData%pitchK) + if (RegCheckErr(Buf, RoutineName)) return + ! pitchC + call RegUnpack(Buf, OutData%pitchC) + if (RegCheckErr(Buf, RoutineName)) return + ! torqM + call RegUnpack(Buf, OutData%torqM) + if (RegCheckErr(Buf, RoutineName)) return + ! qp + call BD_UnpackqpParam(Buf, OutData%qp) ! qp + ! qp_indx_offset + call RegUnpack(Buf, OutData%qp_indx_offset) + if (RegCheckErr(Buf, RoutineName)) return + ! BldMotionNodeLoc + call RegUnpack(Buf, OutData%BldMotionNodeLoc) + if (RegCheckErr(Buf, RoutineName)) return + ! tngt_stf_fd + call RegUnpack(Buf, OutData%tngt_stf_fd) + if (RegCheckErr(Buf, RoutineName)) return + ! tngt_stf_comp + call RegUnpack(Buf, OutData%tngt_stf_comp) + if (RegCheckErr(Buf, RoutineName)) return + ! tngt_stf_pert + call RegUnpack(Buf, OutData%tngt_stf_pert) + if (RegCheckErr(Buf, RoutineName)) return + ! tngt_stf_difftol + call RegUnpack(Buf, OutData%tngt_stf_difftol) + if (RegCheckErr(Buf, RoutineName)) return + ! BldNd_NumOuts + call RegUnpack(Buf, OutData%BldNd_NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! BldNd_TotNumOuts + call RegUnpack(Buf, OutData%BldNd_TotNumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! BldNd_OutParam + if (allocated(OutData%BldNd_OutParam)) deallocate(OutData%BldNd_OutParam) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BldNd_OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(Buf, OutData%BldNd_OutParam(i1)) ! BldNd_OutParam + end do + end if + ! BldNd_BlOutNd + if (allocated(OutData%BldNd_BlOutNd)) deallocate(OutData%BldNd_BlOutNd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BldNd_BlOutNd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_BlOutNd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BldNd_BlOutNd) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! QPtw_Shp_Shp_Jac + if (allocated(OutData%QPtw_Shp_Shp_Jac)) deallocate(OutData%QPtw_Shp_Shp_Jac) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%QPtw_Shp_Shp_Jac(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtw_Shp_Shp_Jac.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%QPtw_Shp_Shp_Jac) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! QPtw_Shp_ShpDer + if (allocated(OutData%QPtw_Shp_ShpDer)) deallocate(OutData%QPtw_Shp_ShpDer) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%QPtw_Shp_ShpDer(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtw_Shp_ShpDer.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%QPtw_Shp_ShpDer) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! QPtw_ShpDer_ShpDer_Jac + if (allocated(OutData%QPtw_ShpDer_ShpDer_Jac)) deallocate(OutData%QPtw_ShpDer_ShpDer_Jac) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%QPtw_ShpDer_ShpDer_Jac(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtw_ShpDer_ShpDer_Jac.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%QPtw_ShpDer_ShpDer_Jac) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! QPtw_Shp_Jac + if (allocated(OutData%QPtw_Shp_Jac)) deallocate(OutData%QPtw_Shp_Jac) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%QPtw_Shp_Jac(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtw_Shp_Jac.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%QPtw_Shp_Jac) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! QPtw_ShpDer + if (allocated(OutData%QPtw_ShpDer)) deallocate(OutData%QPtw_ShpDer) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%QPtw_ShpDer(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtw_ShpDer.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%QPtw_ShpDer) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! FEweight + if (allocated(OutData%FEweight)) deallocate(OutData%FEweight) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FEweight(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FEweight.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FEweight) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Jac_u_indx + if (allocated(OutData%Jac_u_indx)) deallocate(OutData%Jac_u_indx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jac_u_indx) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! du + if (allocated(OutData%du)) deallocate(OutData%du) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%du(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%du) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! dx + call RegUnpack(Buf, OutData%dx) + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_ny + call RegUnpack(Buf, OutData%Jac_ny) + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_nx + call RegUnpack(Buf, OutData%Jac_nx) + if (RegCheckErr(Buf, RoutineName)) return + ! RotStates + call RegUnpack(Buf, OutData%RotStates) + if (RegCheckErr(Buf, RoutineName)) return + ! RelStates + call RegUnpack(Buf, OutData%RelStates) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE BD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(BD_InputType), INTENT(INOUT) :: SrcInputData TYPE(BD_InputType), INTENT(INOUT) :: DstInputData @@ -6271,439 +3710,40 @@ SUBROUTINE BD_DestroyInput( InputData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE BD_DestroyInput - SUBROUTINE BD_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(BD_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! RootMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%RootMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! RootMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! RootMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! RootMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! RootMotion - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! PointLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%PointLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PointLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PointLoad - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PointLoad - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PointLoad - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! DistrLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%DistrLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! DistrLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DistrLoad - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DistrLoad - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DistrLoad - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! HubMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%HubMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! HubMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! HubMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! HubMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! HubMotion - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL MeshPack( InData%RootMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! RootMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MeshPack( InData%PointLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PointLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MeshPack( InData%DistrLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! DistrLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MeshPack( InData%HubMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! HubMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE BD_PackInput - - SUBROUTINE BD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(BD_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%RootMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! RootMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%PointLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PointLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%DistrLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! DistrLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%HubMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! HubMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE BD_UnPackInput +subroutine BD_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BD_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BD_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + ! RootMotion + call MeshPack(Buf, InData%RootMotion) + if (RegCheckErr(Buf, RoutineName)) return + ! PointLoad + call MeshPack(Buf, InData%PointLoad) + if (RegCheckErr(Buf, RoutineName)) return + ! DistrLoad + call MeshPack(Buf, InData%DistrLoad) + if (RegCheckErr(Buf, RoutineName)) return + ! HubMotion + call MeshPack(Buf, InData%HubMotion) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BD_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BD_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BD_UnPackInput' + if (Buf%ErrStat /= ErrID_None) return + ! RootMotion + call MeshUnpack(Buf, OutData%RootMotion) ! RootMotion + ! PointLoad + call MeshUnpack(Buf, OutData%PointLoad) ! PointLoad + ! DistrLoad + call MeshUnpack(Buf, OutData%DistrLoad) ! DistrLoad + ! HubMotion + call MeshUnpack(Buf, OutData%HubMotion) ! HubMotion +end subroutine SUBROUTINE BD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(BD_OutputType), INTENT(INOUT) :: SrcOutputData TYPE(BD_OutputType), INTENT(INOUT) :: DstOutputData @@ -6763,318 +3803,67 @@ SUBROUTINE BD_DestroyOutput( OutputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE BD_DestroyOutput - SUBROUTINE BD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(BD_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! ReactionForce: size of buffers for each call to pack subtype - CALL MeshPack( InData%ReactionForce, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! ReactionForce - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ReactionForce - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ReactionForce - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ReactionForce - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! BldMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%BldMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BldMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BldMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BldMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BldMotion - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Re_BufSz = Re_BufSz + 1 ! RootMxr - Re_BufSz = Re_BufSz + 1 ! RootMyr - Int_BufSz = Int_BufSz + 1 ! WriteOutput allocated yes/no - IF ( ALLOCATED(InData%WriteOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutput upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WriteOutput) ! WriteOutput - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL MeshPack( InData%ReactionForce, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! ReactionForce - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MeshPack( InData%BldMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BldMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - ReKiBuf(Re_Xferred) = InData%RootMxr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RootMyr - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) - ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE BD_PackOutput - - SUBROUTINE BD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(BD_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%ReactionForce, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! ReactionForce - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%BldMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BldMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%RootMxr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RootMyr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutput)) DEALLOCATE(OutData%WriteOutput) - ALLOCATE(OutData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) - OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE BD_UnPackOutput +subroutine BD_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BD_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BD_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! ReactionForce + call MeshPack(Buf, InData%ReactionForce) + if (RegCheckErr(Buf, RoutineName)) return + ! BldMotion + call MeshPack(Buf, InData%BldMotion) + if (RegCheckErr(Buf, RoutineName)) return + ! RootMxr + call RegPack(Buf, InData%RootMxr) + if (RegCheckErr(Buf, RoutineName)) return + ! RootMyr + call RegPack(Buf, InData%RootMyr) + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutput + call RegPack(Buf, allocated(InData%WriteOutput)) + if (allocated(InData%WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPack(Buf, InData%WriteOutput) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BD_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BD_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BD_UnPackOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! ReactionForce + call MeshUnpack(Buf, OutData%ReactionForce) ! ReactionForce + ! BldMotion + call MeshUnpack(Buf, OutData%BldMotion) ! BldMotion + ! RootMxr + call RegUnpack(Buf, OutData%RootMxr) + if (RegCheckErr(Buf, RoutineName)) return + ! RootMyr + call RegUnpack(Buf, OutData%RootMyr) + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutput + if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE BD_CopyEqMotionQP( SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, ErrStat, ErrMsg ) TYPE(EqMotionQP), INTENT(IN) :: SrcEqMotionQPData TYPE(EqMotionQP), INTENT(INOUT) :: DstEqMotionQPData @@ -7733,2070 +4522,705 @@ SUBROUTINE BD_DestroyEqMotionQP( EqMotionQPData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE BD_DestroyEqMotionQP - SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(EqMotionQP), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_PackEqMotionQP' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! uuu allocated yes/no - IF ( ALLOCATED(InData%uuu) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! uuu upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%uuu) ! uuu - END IF - Int_BufSz = Int_BufSz + 1 ! uup allocated yes/no - IF ( ALLOCATED(InData%uup) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! uup upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%uup) ! uup - END IF - Int_BufSz = Int_BufSz + 1 ! vvv allocated yes/no - IF ( ALLOCATED(InData%vvv) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! vvv upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%vvv) ! vvv - END IF - Int_BufSz = Int_BufSz + 1 ! vvp allocated yes/no - IF ( ALLOCATED(InData%vvp) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! vvp upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%vvp) ! vvp - END IF - Int_BufSz = Int_BufSz + 1 ! aaa allocated yes/no - IF ( ALLOCATED(InData%aaa) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! aaa upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%aaa) ! aaa - END IF - Int_BufSz = Int_BufSz + 1 ! RR0 allocated yes/no - IF ( ALLOCATED(InData%RR0) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! RR0 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%RR0) ! RR0 - END IF - Int_BufSz = Int_BufSz + 1 ! kappa allocated yes/no - IF ( ALLOCATED(InData%kappa) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! kappa upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%kappa) ! kappa - END IF - Int_BufSz = Int_BufSz + 1 ! E1 allocated yes/no - IF ( ALLOCATED(InData%E1) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! E1 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%E1) ! E1 - END IF - Int_BufSz = Int_BufSz + 1 ! Stif allocated yes/no - IF ( ALLOCATED(InData%Stif) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Stif upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Stif) ! Stif - END IF - Int_BufSz = Int_BufSz + 1 ! Fb allocated yes/no - IF ( ALLOCATED(InData%Fb) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Fb upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fb) ! Fb - END IF - Int_BufSz = Int_BufSz + 1 ! Fc allocated yes/no - IF ( ALLOCATED(InData%Fc) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Fc upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fc) ! Fc - END IF - Int_BufSz = Int_BufSz + 1 ! Fd allocated yes/no - IF ( ALLOCATED(InData%Fd) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Fd upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fd) ! Fd - END IF - Int_BufSz = Int_BufSz + 1 ! Fg allocated yes/no - IF ( ALLOCATED(InData%Fg) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Fg upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fg) ! Fg - END IF - Int_BufSz = Int_BufSz + 1 ! Fi allocated yes/no - IF ( ALLOCATED(InData%Fi) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Fi upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fi) ! Fi - END IF - Int_BufSz = Int_BufSz + 1 ! Ftemp allocated yes/no - IF ( ALLOCATED(InData%Ftemp) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Ftemp upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Ftemp) ! Ftemp - END IF - Int_BufSz = Int_BufSz + 1 ! RR0mEta allocated yes/no - IF ( ALLOCATED(InData%RR0mEta) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! RR0mEta upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%RR0mEta) ! RR0mEta - END IF - Int_BufSz = Int_BufSz + 1 ! rho allocated yes/no - IF ( ALLOCATED(InData%rho) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! rho upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%rho) ! rho - END IF - Int_BufSz = Int_BufSz + 1 ! betaC allocated yes/no - IF ( ALLOCATED(InData%betaC) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! betaC upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%betaC) ! betaC - END IF - Int_BufSz = Int_BufSz + 1 ! Gi allocated yes/no - IF ( ALLOCATED(InData%Gi) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Gi upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Gi) ! Gi - END IF - Int_BufSz = Int_BufSz + 1 ! Ki allocated yes/no - IF ( ALLOCATED(InData%Ki) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Ki upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Ki) ! Ki - END IF - Int_BufSz = Int_BufSz + 1 ! Mi allocated yes/no - IF ( ALLOCATED(InData%Mi) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Mi upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Mi) ! Mi - END IF - Int_BufSz = Int_BufSz + 1 ! Oe allocated yes/no - IF ( ALLOCATED(InData%Oe) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Oe upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Oe) ! Oe - END IF - Int_BufSz = Int_BufSz + 1 ! Pe allocated yes/no - IF ( ALLOCATED(InData%Pe) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Pe upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Pe) ! Pe - END IF - Int_BufSz = Int_BufSz + 1 ! Qe allocated yes/no - IF ( ALLOCATED(InData%Qe) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Qe upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Qe) ! Qe - END IF - Int_BufSz = Int_BufSz + 1 ! Gd allocated yes/no - IF ( ALLOCATED(InData%Gd) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Gd upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Gd) ! Gd - END IF - Int_BufSz = Int_BufSz + 1 ! Od allocated yes/no - IF ( ALLOCATED(InData%Od) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Od upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Od) ! Od - END IF - Int_BufSz = Int_BufSz + 1 ! Pd allocated yes/no - IF ( ALLOCATED(InData%Pd) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Pd upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Pd) ! Pd - END IF - Int_BufSz = Int_BufSz + 1 ! Qd allocated yes/no - IF ( ALLOCATED(InData%Qd) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Qd upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Qd) ! Qd - END IF - Int_BufSz = Int_BufSz + 1 ! Sd allocated yes/no - IF ( ALLOCATED(InData%Sd) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Sd upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Sd) ! Sd - END IF - Int_BufSz = Int_BufSz + 1 ! Xd allocated yes/no - IF ( ALLOCATED(InData%Xd) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Xd upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Xd) ! Xd - END IF - Int_BufSz = Int_BufSz + 1 ! Yd allocated yes/no - IF ( ALLOCATED(InData%Yd) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Yd upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Yd) ! Yd - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%uuu) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uuu,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uuu,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uuu,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uuu,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uuu,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uuu,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%uuu,3), UBOUND(InData%uuu,3) - DO i2 = LBOUND(InData%uuu,2), UBOUND(InData%uuu,2) - DO i1 = LBOUND(InData%uuu,1), UBOUND(InData%uuu,1) - DbKiBuf(Db_Xferred) = InData%uuu(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%uup) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uup,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uup,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uup,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uup,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uup,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uup,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%uup,3), UBOUND(InData%uup,3) - DO i2 = LBOUND(InData%uup,2), UBOUND(InData%uup,2) - DO i1 = LBOUND(InData%uup,1), UBOUND(InData%uup,1) - DbKiBuf(Db_Xferred) = InData%uup(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%vvv) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vvv,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vvv,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vvv,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vvv,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vvv,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vvv,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%vvv,3), UBOUND(InData%vvv,3) - DO i2 = LBOUND(InData%vvv,2), UBOUND(InData%vvv,2) - DO i1 = LBOUND(InData%vvv,1), UBOUND(InData%vvv,1) - DbKiBuf(Db_Xferred) = InData%vvv(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%vvp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vvp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vvp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vvp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vvp,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vvp,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vvp,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%vvp,3), UBOUND(InData%vvp,3) - DO i2 = LBOUND(InData%vvp,2), UBOUND(InData%vvp,2) - DO i1 = LBOUND(InData%vvp,1), UBOUND(InData%vvp,1) - DbKiBuf(Db_Xferred) = InData%vvp(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%aaa) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%aaa,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%aaa,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%aaa,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%aaa,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%aaa,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%aaa,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%aaa,3), UBOUND(InData%aaa,3) - DO i2 = LBOUND(InData%aaa,2), UBOUND(InData%aaa,2) - DO i1 = LBOUND(InData%aaa,1), UBOUND(InData%aaa,1) - DbKiBuf(Db_Xferred) = InData%aaa(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RR0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RR0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RR0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RR0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RR0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RR0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RR0,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RR0,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RR0,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%RR0,4), UBOUND(InData%RR0,4) - DO i3 = LBOUND(InData%RR0,3), UBOUND(InData%RR0,3) - DO i2 = LBOUND(InData%RR0,2), UBOUND(InData%RR0,2) - DO i1 = LBOUND(InData%RR0,1), UBOUND(InData%RR0,1) - DbKiBuf(Db_Xferred) = InData%RR0(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%kappa) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%kappa,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%kappa,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%kappa,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%kappa,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%kappa,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%kappa,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%kappa,3), UBOUND(InData%kappa,3) - DO i2 = LBOUND(InData%kappa,2), UBOUND(InData%kappa,2) - DO i1 = LBOUND(InData%kappa,1), UBOUND(InData%kappa,1) - DbKiBuf(Db_Xferred) = InData%kappa(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%E1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%E1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%E1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%E1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%E1,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%E1,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%E1,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%E1,3), UBOUND(InData%E1,3) - DO i2 = LBOUND(InData%E1,2), UBOUND(InData%E1,2) - DO i1 = LBOUND(InData%E1,1), UBOUND(InData%E1,1) - DbKiBuf(Db_Xferred) = InData%E1(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Stif) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Stif,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Stif,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Stif,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Stif,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Stif,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Stif,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Stif,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Stif,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Stif,4), UBOUND(InData%Stif,4) - DO i3 = LBOUND(InData%Stif,3), UBOUND(InData%Stif,3) - DO i2 = LBOUND(InData%Stif,2), UBOUND(InData%Stif,2) - DO i1 = LBOUND(InData%Stif,1), UBOUND(InData%Stif,1) - DbKiBuf(Db_Xferred) = InData%Stif(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Fb) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fb,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fb,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fb,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fb,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fb,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Fb,3), UBOUND(InData%Fb,3) - DO i2 = LBOUND(InData%Fb,2), UBOUND(InData%Fb,2) - DO i1 = LBOUND(InData%Fb,1), UBOUND(InData%Fb,1) - DbKiBuf(Db_Xferred) = InData%Fb(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Fc) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fc,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fc,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fc,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fc,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fc,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Fc,3), UBOUND(InData%Fc,3) - DO i2 = LBOUND(InData%Fc,2), UBOUND(InData%Fc,2) - DO i1 = LBOUND(InData%Fc,1), UBOUND(InData%Fc,1) - DbKiBuf(Db_Xferred) = InData%Fc(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Fd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fd,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fd,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fd,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Fd,3), UBOUND(InData%Fd,3) - DO i2 = LBOUND(InData%Fd,2), UBOUND(InData%Fd,2) - DO i1 = LBOUND(InData%Fd,1), UBOUND(InData%Fd,1) - DbKiBuf(Db_Xferred) = InData%Fd(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Fg) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fg,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fg,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fg,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fg,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fg,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fg,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Fg,3), UBOUND(InData%Fg,3) - DO i2 = LBOUND(InData%Fg,2), UBOUND(InData%Fg,2) - DO i1 = LBOUND(InData%Fg,1), UBOUND(InData%Fg,1) - DbKiBuf(Db_Xferred) = InData%Fg(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Fi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fi,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fi,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fi,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fi,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fi,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Fi,3), UBOUND(InData%Fi,3) - DO i2 = LBOUND(InData%Fi,2), UBOUND(InData%Fi,2) - DO i1 = LBOUND(InData%Fi,1), UBOUND(InData%Fi,1) - DbKiBuf(Db_Xferred) = InData%Fi(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Ftemp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ftemp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ftemp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ftemp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ftemp,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ftemp,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ftemp,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Ftemp,3), UBOUND(InData%Ftemp,3) - DO i2 = LBOUND(InData%Ftemp,2), UBOUND(InData%Ftemp,2) - DO i1 = LBOUND(InData%Ftemp,1), UBOUND(InData%Ftemp,1) - DbKiBuf(Db_Xferred) = InData%Ftemp(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RR0mEta) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RR0mEta,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RR0mEta,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RR0mEta,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RR0mEta,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RR0mEta,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RR0mEta,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%RR0mEta,3), UBOUND(InData%RR0mEta,3) - DO i2 = LBOUND(InData%RR0mEta,2), UBOUND(InData%RR0mEta,2) - DO i1 = LBOUND(InData%RR0mEta,1), UBOUND(InData%RR0mEta,1) - DbKiBuf(Db_Xferred) = InData%RR0mEta(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rho) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rho,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rho,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rho,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rho,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rho,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rho,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rho,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rho,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%rho,4), UBOUND(InData%rho,4) - DO i3 = LBOUND(InData%rho,3), UBOUND(InData%rho,3) - DO i2 = LBOUND(InData%rho,2), UBOUND(InData%rho,2) - DO i1 = LBOUND(InData%rho,1), UBOUND(InData%rho,1) - DbKiBuf(Db_Xferred) = InData%rho(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%betaC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%betaC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%betaC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%betaC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%betaC,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%betaC,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%betaC,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%betaC,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%betaC,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%betaC,4), UBOUND(InData%betaC,4) - DO i3 = LBOUND(InData%betaC,3), UBOUND(InData%betaC,3) - DO i2 = LBOUND(InData%betaC,2), UBOUND(InData%betaC,2) - DO i1 = LBOUND(InData%betaC,1), UBOUND(InData%betaC,1) - DbKiBuf(Db_Xferred) = InData%betaC(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Gi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Gi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gi,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Gi,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gi,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Gi,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gi,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Gi,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gi,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Gi,4), UBOUND(InData%Gi,4) - DO i3 = LBOUND(InData%Gi,3), UBOUND(InData%Gi,3) - DO i2 = LBOUND(InData%Gi,2), UBOUND(InData%Gi,2) - DO i1 = LBOUND(InData%Gi,1), UBOUND(InData%Gi,1) - DbKiBuf(Db_Xferred) = InData%Gi(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Ki) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ki,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ki,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ki,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ki,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ki,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ki,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ki,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ki,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Ki,4), UBOUND(InData%Ki,4) - DO i3 = LBOUND(InData%Ki,3), UBOUND(InData%Ki,3) - DO i2 = LBOUND(InData%Ki,2), UBOUND(InData%Ki,2) - DO i1 = LBOUND(InData%Ki,1), UBOUND(InData%Ki,1) - DbKiBuf(Db_Xferred) = InData%Ki(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Mi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Mi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mi,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Mi,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mi,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Mi,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mi,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Mi,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mi,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Mi,4), UBOUND(InData%Mi,4) - DO i3 = LBOUND(InData%Mi,3), UBOUND(InData%Mi,3) - DO i2 = LBOUND(InData%Mi,2), UBOUND(InData%Mi,2) - DO i1 = LBOUND(InData%Mi,1), UBOUND(InData%Mi,1) - DbKiBuf(Db_Xferred) = InData%Mi(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Oe) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Oe,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Oe,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Oe,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Oe,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Oe,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Oe,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Oe,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Oe,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Oe,4), UBOUND(InData%Oe,4) - DO i3 = LBOUND(InData%Oe,3), UBOUND(InData%Oe,3) - DO i2 = LBOUND(InData%Oe,2), UBOUND(InData%Oe,2) - DO i1 = LBOUND(InData%Oe,1), UBOUND(InData%Oe,1) - DbKiBuf(Db_Xferred) = InData%Oe(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Pe) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pe,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pe,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pe,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pe,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pe,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pe,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pe,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pe,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Pe,4), UBOUND(InData%Pe,4) - DO i3 = LBOUND(InData%Pe,3), UBOUND(InData%Pe,3) - DO i2 = LBOUND(InData%Pe,2), UBOUND(InData%Pe,2) - DO i1 = LBOUND(InData%Pe,1), UBOUND(InData%Pe,1) - DbKiBuf(Db_Xferred) = InData%Pe(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Qe) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Qe,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Qe,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Qe,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Qe,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Qe,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Qe,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Qe,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Qe,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Qe,4), UBOUND(InData%Qe,4) - DO i3 = LBOUND(InData%Qe,3), UBOUND(InData%Qe,3) - DO i2 = LBOUND(InData%Qe,2), UBOUND(InData%Qe,2) - DO i1 = LBOUND(InData%Qe,1), UBOUND(InData%Qe,1) - DbKiBuf(Db_Xferred) = InData%Qe(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Gd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Gd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Gd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gd,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Gd,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gd,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Gd,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gd,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Gd,4), UBOUND(InData%Gd,4) - DO i3 = LBOUND(InData%Gd,3), UBOUND(InData%Gd,3) - DO i2 = LBOUND(InData%Gd,2), UBOUND(InData%Gd,2) - DO i1 = LBOUND(InData%Gd,1), UBOUND(InData%Gd,1) - DbKiBuf(Db_Xferred) = InData%Gd(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Od) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Od,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Od,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Od,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Od,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Od,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Od,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Od,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Od,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Od,4), UBOUND(InData%Od,4) - DO i3 = LBOUND(InData%Od,3), UBOUND(InData%Od,3) - DO i2 = LBOUND(InData%Od,2), UBOUND(InData%Od,2) - DO i1 = LBOUND(InData%Od,1), UBOUND(InData%Od,1) - DbKiBuf(Db_Xferred) = InData%Od(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Pd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pd,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pd,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pd,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pd,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pd,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Pd,4), UBOUND(InData%Pd,4) - DO i3 = LBOUND(InData%Pd,3), UBOUND(InData%Pd,3) - DO i2 = LBOUND(InData%Pd,2), UBOUND(InData%Pd,2) - DO i1 = LBOUND(InData%Pd,1), UBOUND(InData%Pd,1) - DbKiBuf(Db_Xferred) = InData%Pd(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Qd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Qd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Qd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Qd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Qd,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Qd,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Qd,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Qd,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Qd,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Qd,4), UBOUND(InData%Qd,4) - DO i3 = LBOUND(InData%Qd,3), UBOUND(InData%Qd,3) - DO i2 = LBOUND(InData%Qd,2), UBOUND(InData%Qd,2) - DO i1 = LBOUND(InData%Qd,1), UBOUND(InData%Qd,1) - DbKiBuf(Db_Xferred) = InData%Qd(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Sd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Sd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Sd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Sd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Sd,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Sd,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Sd,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Sd,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Sd,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Sd,4), UBOUND(InData%Sd,4) - DO i3 = LBOUND(InData%Sd,3), UBOUND(InData%Sd,3) - DO i2 = LBOUND(InData%Sd,2), UBOUND(InData%Sd,2) - DO i1 = LBOUND(InData%Sd,1), UBOUND(InData%Sd,1) - DbKiBuf(Db_Xferred) = InData%Sd(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Xd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Xd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Xd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Xd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Xd,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Xd,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Xd,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Xd,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Xd,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Xd,4), UBOUND(InData%Xd,4) - DO i3 = LBOUND(InData%Xd,3), UBOUND(InData%Xd,3) - DO i2 = LBOUND(InData%Xd,2), UBOUND(InData%Xd,2) - DO i1 = LBOUND(InData%Xd,1), UBOUND(InData%Xd,1) - DbKiBuf(Db_Xferred) = InData%Xd(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Yd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Yd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Yd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Yd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Yd,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Yd,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Yd,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Yd,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Yd,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Yd,4), UBOUND(InData%Yd,4) - DO i3 = LBOUND(InData%Yd,3), UBOUND(InData%Yd,3) - DO i2 = LBOUND(InData%Yd,2), UBOUND(InData%Yd,2) - DO i1 = LBOUND(InData%Yd,1), UBOUND(InData%Yd,1) - DbKiBuf(Db_Xferred) = InData%Yd(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - END SUBROUTINE BD_PackEqMotionQP - - SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(EqMotionQP), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_UnPackEqMotionQP' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! uuu not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%uuu)) DEALLOCATE(OutData%uuu) - ALLOCATE(OutData%uuu(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%uuu.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%uuu,3), UBOUND(OutData%uuu,3) - DO i2 = LBOUND(OutData%uuu,2), UBOUND(OutData%uuu,2) - DO i1 = LBOUND(OutData%uuu,1), UBOUND(OutData%uuu,1) - OutData%uuu(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! uup not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%uup)) DEALLOCATE(OutData%uup) - ALLOCATE(OutData%uup(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%uup.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%uup,3), UBOUND(OutData%uup,3) - DO i2 = LBOUND(OutData%uup,2), UBOUND(OutData%uup,2) - DO i1 = LBOUND(OutData%uup,1), UBOUND(OutData%uup,1) - OutData%uup(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! vvv not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%vvv)) DEALLOCATE(OutData%vvv) - ALLOCATE(OutData%vvv(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%vvv.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%vvv,3), UBOUND(OutData%vvv,3) - DO i2 = LBOUND(OutData%vvv,2), UBOUND(OutData%vvv,2) - DO i1 = LBOUND(OutData%vvv,1), UBOUND(OutData%vvv,1) - OutData%vvv(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! vvp not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%vvp)) DEALLOCATE(OutData%vvp) - ALLOCATE(OutData%vvp(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%vvp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%vvp,3), UBOUND(OutData%vvp,3) - DO i2 = LBOUND(OutData%vvp,2), UBOUND(OutData%vvp,2) - DO i1 = LBOUND(OutData%vvp,1), UBOUND(OutData%vvp,1) - OutData%vvp(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! aaa not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%aaa)) DEALLOCATE(OutData%aaa) - ALLOCATE(OutData%aaa(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%aaa.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%aaa,3), UBOUND(OutData%aaa,3) - DO i2 = LBOUND(OutData%aaa,2), UBOUND(OutData%aaa,2) - DO i1 = LBOUND(OutData%aaa,1), UBOUND(OutData%aaa,1) - OutData%aaa(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RR0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RR0)) DEALLOCATE(OutData%RR0) - ALLOCATE(OutData%RR0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RR0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%RR0,4), UBOUND(OutData%RR0,4) - DO i3 = LBOUND(OutData%RR0,3), UBOUND(OutData%RR0,3) - DO i2 = LBOUND(OutData%RR0,2), UBOUND(OutData%RR0,2) - DO i1 = LBOUND(OutData%RR0,1), UBOUND(OutData%RR0,1) - OutData%RR0(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! kappa not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%kappa)) DEALLOCATE(OutData%kappa) - ALLOCATE(OutData%kappa(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%kappa.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%kappa,3), UBOUND(OutData%kappa,3) - DO i2 = LBOUND(OutData%kappa,2), UBOUND(OutData%kappa,2) - DO i1 = LBOUND(OutData%kappa,1), UBOUND(OutData%kappa,1) - OutData%kappa(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! E1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%E1)) DEALLOCATE(OutData%E1) - ALLOCATE(OutData%E1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%E1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%E1,3), UBOUND(OutData%E1,3) - DO i2 = LBOUND(OutData%E1,2), UBOUND(OutData%E1,2) - DO i1 = LBOUND(OutData%E1,1), UBOUND(OutData%E1,1) - OutData%E1(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Stif not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Stif)) DEALLOCATE(OutData%Stif) - ALLOCATE(OutData%Stif(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Stif.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Stif,4), UBOUND(OutData%Stif,4) - DO i3 = LBOUND(OutData%Stif,3), UBOUND(OutData%Stif,3) - DO i2 = LBOUND(OutData%Stif,2), UBOUND(OutData%Stif,2) - DO i1 = LBOUND(OutData%Stif,1), UBOUND(OutData%Stif,1) - OutData%Stif(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fb not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Fb)) DEALLOCATE(OutData%Fb) - ALLOCATE(OutData%Fb(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Fb,3), UBOUND(OutData%Fb,3) - DO i2 = LBOUND(OutData%Fb,2), UBOUND(OutData%Fb,2) - DO i1 = LBOUND(OutData%Fb,1), UBOUND(OutData%Fb,1) - OutData%Fb(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fc not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Fc)) DEALLOCATE(OutData%Fc) - ALLOCATE(OutData%Fc(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Fc,3), UBOUND(OutData%Fc,3) - DO i2 = LBOUND(OutData%Fc,2), UBOUND(OutData%Fc,2) - DO i1 = LBOUND(OutData%Fc,1), UBOUND(OutData%Fc,1) - OutData%Fc(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fd not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Fd)) DEALLOCATE(OutData%Fd) - ALLOCATE(OutData%Fd(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Fd,3), UBOUND(OutData%Fd,3) - DO i2 = LBOUND(OutData%Fd,2), UBOUND(OutData%Fd,2) - DO i1 = LBOUND(OutData%Fd,1), UBOUND(OutData%Fd,1) - OutData%Fd(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fg not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Fg)) DEALLOCATE(OutData%Fg) - ALLOCATE(OutData%Fg(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Fg,3), UBOUND(OutData%Fg,3) - DO i2 = LBOUND(OutData%Fg,2), UBOUND(OutData%Fg,2) - DO i1 = LBOUND(OutData%Fg,1), UBOUND(OutData%Fg,1) - OutData%Fg(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Fi)) DEALLOCATE(OutData%Fi) - ALLOCATE(OutData%Fi(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Fi,3), UBOUND(OutData%Fi,3) - DO i2 = LBOUND(OutData%Fi,2), UBOUND(OutData%Fi,2) - DO i1 = LBOUND(OutData%Fi,1), UBOUND(OutData%Fi,1) - OutData%Fi(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ftemp not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Ftemp)) DEALLOCATE(OutData%Ftemp) - ALLOCATE(OutData%Ftemp(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ftemp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Ftemp,3), UBOUND(OutData%Ftemp,3) - DO i2 = LBOUND(OutData%Ftemp,2), UBOUND(OutData%Ftemp,2) - DO i1 = LBOUND(OutData%Ftemp,1), UBOUND(OutData%Ftemp,1) - OutData%Ftemp(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RR0mEta not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RR0mEta)) DEALLOCATE(OutData%RR0mEta) - ALLOCATE(OutData%RR0mEta(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RR0mEta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%RR0mEta,3), UBOUND(OutData%RR0mEta,3) - DO i2 = LBOUND(OutData%RR0mEta,2), UBOUND(OutData%RR0mEta,2) - DO i1 = LBOUND(OutData%RR0mEta,1), UBOUND(OutData%RR0mEta,1) - OutData%RR0mEta(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rho not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rho)) DEALLOCATE(OutData%rho) - ALLOCATE(OutData%rho(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rho.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%rho,4), UBOUND(OutData%rho,4) - DO i3 = LBOUND(OutData%rho,3), UBOUND(OutData%rho,3) - DO i2 = LBOUND(OutData%rho,2), UBOUND(OutData%rho,2) - DO i1 = LBOUND(OutData%rho,1), UBOUND(OutData%rho,1) - OutData%rho(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! betaC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%betaC)) DEALLOCATE(OutData%betaC) - ALLOCATE(OutData%betaC(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%betaC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%betaC,4), UBOUND(OutData%betaC,4) - DO i3 = LBOUND(OutData%betaC,3), UBOUND(OutData%betaC,3) - DO i2 = LBOUND(OutData%betaC,2), UBOUND(OutData%betaC,2) - DO i1 = LBOUND(OutData%betaC,1), UBOUND(OutData%betaC,1) - OutData%betaC(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Gi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Gi)) DEALLOCATE(OutData%Gi) - ALLOCATE(OutData%Gi(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Gi,4), UBOUND(OutData%Gi,4) - DO i3 = LBOUND(OutData%Gi,3), UBOUND(OutData%Gi,3) - DO i2 = LBOUND(OutData%Gi,2), UBOUND(OutData%Gi,2) - DO i1 = LBOUND(OutData%Gi,1), UBOUND(OutData%Gi,1) - OutData%Gi(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ki not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Ki)) DEALLOCATE(OutData%Ki) - ALLOCATE(OutData%Ki(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ki.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Ki,4), UBOUND(OutData%Ki,4) - DO i3 = LBOUND(OutData%Ki,3), UBOUND(OutData%Ki,3) - DO i2 = LBOUND(OutData%Ki,2), UBOUND(OutData%Ki,2) - DO i1 = LBOUND(OutData%Ki,1), UBOUND(OutData%Ki,1) - OutData%Ki(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Mi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Mi)) DEALLOCATE(OutData%Mi) - ALLOCATE(OutData%Mi(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Mi,4), UBOUND(OutData%Mi,4) - DO i3 = LBOUND(OutData%Mi,3), UBOUND(OutData%Mi,3) - DO i2 = LBOUND(OutData%Mi,2), UBOUND(OutData%Mi,2) - DO i1 = LBOUND(OutData%Mi,1), UBOUND(OutData%Mi,1) - OutData%Mi(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Oe not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Oe)) DEALLOCATE(OutData%Oe) - ALLOCATE(OutData%Oe(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Oe.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Oe,4), UBOUND(OutData%Oe,4) - DO i3 = LBOUND(OutData%Oe,3), UBOUND(OutData%Oe,3) - DO i2 = LBOUND(OutData%Oe,2), UBOUND(OutData%Oe,2) - DO i1 = LBOUND(OutData%Oe,1), UBOUND(OutData%Oe,1) - OutData%Oe(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Pe not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Pe)) DEALLOCATE(OutData%Pe) - ALLOCATE(OutData%Pe(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Pe.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Pe,4), UBOUND(OutData%Pe,4) - DO i3 = LBOUND(OutData%Pe,3), UBOUND(OutData%Pe,3) - DO i2 = LBOUND(OutData%Pe,2), UBOUND(OutData%Pe,2) - DO i1 = LBOUND(OutData%Pe,1), UBOUND(OutData%Pe,1) - OutData%Pe(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Qe not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Qe)) DEALLOCATE(OutData%Qe) - ALLOCATE(OutData%Qe(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Qe.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Qe,4), UBOUND(OutData%Qe,4) - DO i3 = LBOUND(OutData%Qe,3), UBOUND(OutData%Qe,3) - DO i2 = LBOUND(OutData%Qe,2), UBOUND(OutData%Qe,2) - DO i1 = LBOUND(OutData%Qe,1), UBOUND(OutData%Qe,1) - OutData%Qe(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Gd not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Gd)) DEALLOCATE(OutData%Gd) - ALLOCATE(OutData%Gd(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Gd,4), UBOUND(OutData%Gd,4) - DO i3 = LBOUND(OutData%Gd,3), UBOUND(OutData%Gd,3) - DO i2 = LBOUND(OutData%Gd,2), UBOUND(OutData%Gd,2) - DO i1 = LBOUND(OutData%Gd,1), UBOUND(OutData%Gd,1) - OutData%Gd(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Od not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Od)) DEALLOCATE(OutData%Od) - ALLOCATE(OutData%Od(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Od.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Od,4), UBOUND(OutData%Od,4) - DO i3 = LBOUND(OutData%Od,3), UBOUND(OutData%Od,3) - DO i2 = LBOUND(OutData%Od,2), UBOUND(OutData%Od,2) - DO i1 = LBOUND(OutData%Od,1), UBOUND(OutData%Od,1) - OutData%Od(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Pd not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Pd)) DEALLOCATE(OutData%Pd) - ALLOCATE(OutData%Pd(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Pd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Pd,4), UBOUND(OutData%Pd,4) - DO i3 = LBOUND(OutData%Pd,3), UBOUND(OutData%Pd,3) - DO i2 = LBOUND(OutData%Pd,2), UBOUND(OutData%Pd,2) - DO i1 = LBOUND(OutData%Pd,1), UBOUND(OutData%Pd,1) - OutData%Pd(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Qd not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Qd)) DEALLOCATE(OutData%Qd) - ALLOCATE(OutData%Qd(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Qd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Qd,4), UBOUND(OutData%Qd,4) - DO i3 = LBOUND(OutData%Qd,3), UBOUND(OutData%Qd,3) - DO i2 = LBOUND(OutData%Qd,2), UBOUND(OutData%Qd,2) - DO i1 = LBOUND(OutData%Qd,1), UBOUND(OutData%Qd,1) - OutData%Qd(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Sd not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Sd)) DEALLOCATE(OutData%Sd) - ALLOCATE(OutData%Sd(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Sd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Sd,4), UBOUND(OutData%Sd,4) - DO i3 = LBOUND(OutData%Sd,3), UBOUND(OutData%Sd,3) - DO i2 = LBOUND(OutData%Sd,2), UBOUND(OutData%Sd,2) - DO i1 = LBOUND(OutData%Sd,1), UBOUND(OutData%Sd,1) - OutData%Sd(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Xd not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Xd)) DEALLOCATE(OutData%Xd) - ALLOCATE(OutData%Xd(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Xd,4), UBOUND(OutData%Xd,4) - DO i3 = LBOUND(OutData%Xd,3), UBOUND(OutData%Xd,3) - DO i2 = LBOUND(OutData%Xd,2), UBOUND(OutData%Xd,2) - DO i1 = LBOUND(OutData%Xd,1), UBOUND(OutData%Xd,1) - OutData%Xd(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Yd not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Yd)) DEALLOCATE(OutData%Yd) - ALLOCATE(OutData%Yd(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Yd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Yd,4), UBOUND(OutData%Yd,4) - DO i3 = LBOUND(OutData%Yd,3), UBOUND(OutData%Yd,3) - DO i2 = LBOUND(OutData%Yd,2), UBOUND(OutData%Yd,2) - DO i1 = LBOUND(OutData%Yd,1), UBOUND(OutData%Yd,1) - OutData%Yd(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - END SUBROUTINE BD_UnPackEqMotionQP +subroutine BD_PackEqMotionQP(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(EqMotionQP), intent(in) :: InData + character(*), parameter :: RoutineName = 'BD_PackEqMotionQP' + if (Buf%ErrStat >= AbortErrLev) return + ! uuu + call RegPack(Buf, allocated(InData%uuu)) + if (allocated(InData%uuu)) then + call RegPackBounds(Buf, 3, lbound(InData%uuu), ubound(InData%uuu)) + call RegPack(Buf, InData%uuu) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! uup + call RegPack(Buf, allocated(InData%uup)) + if (allocated(InData%uup)) then + call RegPackBounds(Buf, 3, lbound(InData%uup), ubound(InData%uup)) + call RegPack(Buf, InData%uup) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! vvv + call RegPack(Buf, allocated(InData%vvv)) + if (allocated(InData%vvv)) then + call RegPackBounds(Buf, 3, lbound(InData%vvv), ubound(InData%vvv)) + call RegPack(Buf, InData%vvv) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! vvp + call RegPack(Buf, allocated(InData%vvp)) + if (allocated(InData%vvp)) then + call RegPackBounds(Buf, 3, lbound(InData%vvp), ubound(InData%vvp)) + call RegPack(Buf, InData%vvp) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! aaa + call RegPack(Buf, allocated(InData%aaa)) + if (allocated(InData%aaa)) then + call RegPackBounds(Buf, 3, lbound(InData%aaa), ubound(InData%aaa)) + call RegPack(Buf, InData%aaa) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RR0 + call RegPack(Buf, allocated(InData%RR0)) + if (allocated(InData%RR0)) then + call RegPackBounds(Buf, 4, lbound(InData%RR0), ubound(InData%RR0)) + call RegPack(Buf, InData%RR0) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! kappa + call RegPack(Buf, allocated(InData%kappa)) + if (allocated(InData%kappa)) then + call RegPackBounds(Buf, 3, lbound(InData%kappa), ubound(InData%kappa)) + call RegPack(Buf, InData%kappa) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! E1 + call RegPack(Buf, allocated(InData%E1)) + if (allocated(InData%E1)) then + call RegPackBounds(Buf, 3, lbound(InData%E1), ubound(InData%E1)) + call RegPack(Buf, InData%E1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Stif + call RegPack(Buf, allocated(InData%Stif)) + if (allocated(InData%Stif)) then + call RegPackBounds(Buf, 4, lbound(InData%Stif), ubound(InData%Stif)) + call RegPack(Buf, InData%Stif) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Fb + call RegPack(Buf, allocated(InData%Fb)) + if (allocated(InData%Fb)) then + call RegPackBounds(Buf, 3, lbound(InData%Fb), ubound(InData%Fb)) + call RegPack(Buf, InData%Fb) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Fc + call RegPack(Buf, allocated(InData%Fc)) + if (allocated(InData%Fc)) then + call RegPackBounds(Buf, 3, lbound(InData%Fc), ubound(InData%Fc)) + call RegPack(Buf, InData%Fc) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Fd + call RegPack(Buf, allocated(InData%Fd)) + if (allocated(InData%Fd)) then + call RegPackBounds(Buf, 3, lbound(InData%Fd), ubound(InData%Fd)) + call RegPack(Buf, InData%Fd) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Fg + call RegPack(Buf, allocated(InData%Fg)) + if (allocated(InData%Fg)) then + call RegPackBounds(Buf, 3, lbound(InData%Fg), ubound(InData%Fg)) + call RegPack(Buf, InData%Fg) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Fi + call RegPack(Buf, allocated(InData%Fi)) + if (allocated(InData%Fi)) then + call RegPackBounds(Buf, 3, lbound(InData%Fi), ubound(InData%Fi)) + call RegPack(Buf, InData%Fi) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Ftemp + call RegPack(Buf, allocated(InData%Ftemp)) + if (allocated(InData%Ftemp)) then + call RegPackBounds(Buf, 3, lbound(InData%Ftemp), ubound(InData%Ftemp)) + call RegPack(Buf, InData%Ftemp) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RR0mEta + call RegPack(Buf, allocated(InData%RR0mEta)) + if (allocated(InData%RR0mEta)) then + call RegPackBounds(Buf, 3, lbound(InData%RR0mEta), ubound(InData%RR0mEta)) + call RegPack(Buf, InData%RR0mEta) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! rho + call RegPack(Buf, allocated(InData%rho)) + if (allocated(InData%rho)) then + call RegPackBounds(Buf, 4, lbound(InData%rho), ubound(InData%rho)) + call RegPack(Buf, InData%rho) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! betaC + call RegPack(Buf, allocated(InData%betaC)) + if (allocated(InData%betaC)) then + call RegPackBounds(Buf, 4, lbound(InData%betaC), ubound(InData%betaC)) + call RegPack(Buf, InData%betaC) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Gi + call RegPack(Buf, allocated(InData%Gi)) + if (allocated(InData%Gi)) then + call RegPackBounds(Buf, 4, lbound(InData%Gi), ubound(InData%Gi)) + call RegPack(Buf, InData%Gi) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Ki + call RegPack(Buf, allocated(InData%Ki)) + if (allocated(InData%Ki)) then + call RegPackBounds(Buf, 4, lbound(InData%Ki), ubound(InData%Ki)) + call RegPack(Buf, InData%Ki) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Mi + call RegPack(Buf, allocated(InData%Mi)) + if (allocated(InData%Mi)) then + call RegPackBounds(Buf, 4, lbound(InData%Mi), ubound(InData%Mi)) + call RegPack(Buf, InData%Mi) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Oe + call RegPack(Buf, allocated(InData%Oe)) + if (allocated(InData%Oe)) then + call RegPackBounds(Buf, 4, lbound(InData%Oe), ubound(InData%Oe)) + call RegPack(Buf, InData%Oe) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Pe + call RegPack(Buf, allocated(InData%Pe)) + if (allocated(InData%Pe)) then + call RegPackBounds(Buf, 4, lbound(InData%Pe), ubound(InData%Pe)) + call RegPack(Buf, InData%Pe) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Qe + call RegPack(Buf, allocated(InData%Qe)) + if (allocated(InData%Qe)) then + call RegPackBounds(Buf, 4, lbound(InData%Qe), ubound(InData%Qe)) + call RegPack(Buf, InData%Qe) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Gd + call RegPack(Buf, allocated(InData%Gd)) + if (allocated(InData%Gd)) then + call RegPackBounds(Buf, 4, lbound(InData%Gd), ubound(InData%Gd)) + call RegPack(Buf, InData%Gd) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Od + call RegPack(Buf, allocated(InData%Od)) + if (allocated(InData%Od)) then + call RegPackBounds(Buf, 4, lbound(InData%Od), ubound(InData%Od)) + call RegPack(Buf, InData%Od) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Pd + call RegPack(Buf, allocated(InData%Pd)) + if (allocated(InData%Pd)) then + call RegPackBounds(Buf, 4, lbound(InData%Pd), ubound(InData%Pd)) + call RegPack(Buf, InData%Pd) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Qd + call RegPack(Buf, allocated(InData%Qd)) + if (allocated(InData%Qd)) then + call RegPackBounds(Buf, 4, lbound(InData%Qd), ubound(InData%Qd)) + call RegPack(Buf, InData%Qd) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Sd + call RegPack(Buf, allocated(InData%Sd)) + if (allocated(InData%Sd)) then + call RegPackBounds(Buf, 4, lbound(InData%Sd), ubound(InData%Sd)) + call RegPack(Buf, InData%Sd) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Xd + call RegPack(Buf, allocated(InData%Xd)) + if (allocated(InData%Xd)) then + call RegPackBounds(Buf, 4, lbound(InData%Xd), ubound(InData%Xd)) + call RegPack(Buf, InData%Xd) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Yd + call RegPack(Buf, allocated(InData%Yd)) + if (allocated(InData%Yd)) then + call RegPackBounds(Buf, 4, lbound(InData%Yd), ubound(InData%Yd)) + call RegPack(Buf, InData%Yd) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BD_UnPackEqMotionQP(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(EqMotionQP), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BD_UnPackEqMotionQP' + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! uuu + if (allocated(OutData%uuu)) deallocate(OutData%uuu) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%uuu(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%uuu.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%uuu) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! uup + if (allocated(OutData%uup)) deallocate(OutData%uup) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%uup(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%uup.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%uup) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! vvv + if (allocated(OutData%vvv)) deallocate(OutData%vvv) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%vvv(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%vvv.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%vvv) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! vvp + if (allocated(OutData%vvp)) deallocate(OutData%vvp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%vvp(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%vvp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%vvp) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! aaa + if (allocated(OutData%aaa)) deallocate(OutData%aaa) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%aaa(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%aaa.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%aaa) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RR0 + if (allocated(OutData%RR0)) deallocate(OutData%RR0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RR0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RR0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RR0) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! kappa + if (allocated(OutData%kappa)) deallocate(OutData%kappa) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%kappa(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%kappa.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%kappa) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! E1 + if (allocated(OutData%E1)) deallocate(OutData%E1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%E1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%E1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%E1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Stif + if (allocated(OutData%Stif)) deallocate(OutData%Stif) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Stif(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Stif.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Stif) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Fb + if (allocated(OutData%Fb)) deallocate(OutData%Fb) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Fb(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Fb) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Fc + if (allocated(OutData%Fc)) deallocate(OutData%Fc) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Fc(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Fc) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Fd + if (allocated(OutData%Fd)) deallocate(OutData%Fd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Fd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Fd) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Fg + if (allocated(OutData%Fg)) deallocate(OutData%Fg) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Fg(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fg.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Fg) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Fi + if (allocated(OutData%Fi)) deallocate(OutData%Fi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Fi(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Fi) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Ftemp + if (allocated(OutData%Ftemp)) deallocate(OutData%Ftemp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Ftemp(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ftemp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Ftemp) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RR0mEta + if (allocated(OutData%RR0mEta)) deallocate(OutData%RR0mEta) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RR0mEta(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RR0mEta.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RR0mEta) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! rho + if (allocated(OutData%rho)) deallocate(OutData%rho) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rho(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rho.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rho) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! betaC + if (allocated(OutData%betaC)) deallocate(OutData%betaC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%betaC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%betaC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%betaC) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Gi + if (allocated(OutData%Gi)) deallocate(OutData%Gi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Gi(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Gi) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Ki + if (allocated(OutData%Ki)) deallocate(OutData%Ki) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Ki(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ki.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Ki) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Mi + if (allocated(OutData%Mi)) deallocate(OutData%Mi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Mi(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Mi) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Oe + if (allocated(OutData%Oe)) deallocate(OutData%Oe) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Oe(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Oe.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Oe) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Pe + if (allocated(OutData%Pe)) deallocate(OutData%Pe) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Pe(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Pe.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Pe) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Qe + if (allocated(OutData%Qe)) deallocate(OutData%Qe) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Qe(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Qe.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Qe) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Gd + if (allocated(OutData%Gd)) deallocate(OutData%Gd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Gd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Gd) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Od + if (allocated(OutData%Od)) deallocate(OutData%Od) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Od(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Od.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Od) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Pd + if (allocated(OutData%Pd)) deallocate(OutData%Pd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Pd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Pd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Pd) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Qd + if (allocated(OutData%Qd)) deallocate(OutData%Qd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Qd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Qd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Qd) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Sd + if (allocated(OutData%Sd)) deallocate(OutData%Sd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Sd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Sd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Sd) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Xd + if (allocated(OutData%Xd)) deallocate(OutData%Xd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Xd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Xd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Xd) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Yd + if (allocated(OutData%Yd)) deallocate(OutData%Yd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Yd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Yd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Yd) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE BD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) TYPE(BD_MiscVarType), INTENT(INOUT) :: SrcMiscData TYPE(BD_MiscVarType), INTENT(INOUT) :: DstMiscData @@ -10412,2313 +5836,724 @@ SUBROUTINE BD_DestroyMisc( MiscData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE BD_DestroyMisc - SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(BD_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! u_DistrLoad_at_y: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_DistrLoad_at_y, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_DistrLoad_at_y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_DistrLoad_at_y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_DistrLoad_at_y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_DistrLoad_at_y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y_BldMotion_at_u: size of buffers for each call to pack subtype - CALL MeshPack( InData%y_BldMotion_at_u, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! y_BldMotion_at_u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_BldMotion_at_u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_BldMotion_at_u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_BldMotion_at_u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Map_u_DistrLoad_to_y: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%Map_u_DistrLoad_to_y, ErrStat2, ErrMsg2, .TRUE. ) ! Map_u_DistrLoad_to_y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Map_u_DistrLoad_to_y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Map_u_DistrLoad_to_y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Map_u_DistrLoad_to_y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Map_y_BldMotion_to_u: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%Map_y_BldMotion_to_u, ErrStat2, ErrMsg2, .TRUE. ) ! Map_y_BldMotion_to_u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Map_y_BldMotion_to_u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Map_y_BldMotion_to_u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Map_y_BldMotion_to_u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Un_Sum - Int_BufSz = Int_BufSz + 3 ! qp: size of buffers for each call to pack subtype - CALL BD_PackEqMotionQP( Re_Buf, Db_Buf, Int_Buf, InData%qp, ErrStat2, ErrMsg2, .TRUE. ) ! qp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! qp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! qp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! qp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! lin_A allocated yes/no - IF ( ALLOCATED(InData%lin_A) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! lin_A upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%lin_A) ! lin_A - END IF - Int_BufSz = Int_BufSz + 1 ! lin_C allocated yes/no - IF ( ALLOCATED(InData%lin_C) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! lin_C upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%lin_C) ! lin_C - END IF - Int_BufSz = Int_BufSz + 1 ! Nrrr allocated yes/no - IF ( ALLOCATED(InData%Nrrr) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Nrrr upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Nrrr) ! Nrrr - END IF - Int_BufSz = Int_BufSz + 1 ! elf allocated yes/no - IF ( ALLOCATED(InData%elf) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! elf upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%elf) ! elf - END IF - Int_BufSz = Int_BufSz + 1 ! EFint allocated yes/no - IF ( ALLOCATED(InData%EFint) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! EFint upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%EFint) ! EFint - END IF - Int_BufSz = Int_BufSz + 1 ! elk allocated yes/no - IF ( ALLOCATED(InData%elk) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! elk upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%elk) ! elk - END IF - Int_BufSz = Int_BufSz + 1 ! elg allocated yes/no - IF ( ALLOCATED(InData%elg) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! elg upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%elg) ! elg - END IF - Int_BufSz = Int_BufSz + 1 ! elm allocated yes/no - IF ( ALLOCATED(InData%elm) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! elm upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%elm) ! elm - END IF - Int_BufSz = Int_BufSz + 1 ! DistrLoad_QP allocated yes/no - IF ( ALLOCATED(InData%DistrLoad_QP) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! DistrLoad_QP upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%DistrLoad_QP) ! DistrLoad_QP - END IF - Int_BufSz = Int_BufSz + 1 ! PointLoadLcl allocated yes/no - IF ( ALLOCATED(InData%PointLoadLcl) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PointLoadLcl upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%PointLoadLcl) ! PointLoadLcl - END IF - Int_BufSz = Int_BufSz + 1 ! StifK allocated yes/no - IF ( ALLOCATED(InData%StifK) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! StifK upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%StifK) ! StifK - END IF - Int_BufSz = Int_BufSz + 1 ! MassM allocated yes/no - IF ( ALLOCATED(InData%MassM) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! MassM upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%MassM) ! MassM - END IF - Int_BufSz = Int_BufSz + 1 ! DampG allocated yes/no - IF ( ALLOCATED(InData%DampG) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! DampG upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%DampG) ! DampG - END IF - Int_BufSz = Int_BufSz + 1 ! StifK_fd allocated yes/no - IF ( ALLOCATED(InData%StifK_fd) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! StifK_fd upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%StifK_fd) ! StifK_fd - END IF - Int_BufSz = Int_BufSz + 1 ! MassM_fd allocated yes/no - IF ( ALLOCATED(InData%MassM_fd) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! MassM_fd upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%MassM_fd) ! MassM_fd - END IF - Int_BufSz = Int_BufSz + 1 ! DampG_fd allocated yes/no - IF ( ALLOCATED(InData%DampG_fd) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! DampG_fd upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%DampG_fd) ! DampG_fd - END IF - Int_BufSz = Int_BufSz + 1 ! RHS allocated yes/no - IF ( ALLOCATED(InData%RHS) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! RHS upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%RHS) ! RHS - END IF - Int_BufSz = Int_BufSz + 1 ! RHS_p allocated yes/no - IF ( ALLOCATED(InData%RHS_p) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! RHS_p upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%RHS_p) ! RHS_p - END IF - Int_BufSz = Int_BufSz + 1 ! RHS_m allocated yes/no - IF ( ALLOCATED(InData%RHS_m) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! RHS_m upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%RHS_m) ! RHS_m - END IF - Int_BufSz = Int_BufSz + 1 ! BldInternalForceFE allocated yes/no - IF ( ALLOCATED(InData%BldInternalForceFE) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BldInternalForceFE upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%BldInternalForceFE) ! BldInternalForceFE - END IF - Int_BufSz = Int_BufSz + 1 ! BldInternalForceQP allocated yes/no - IF ( ALLOCATED(InData%BldInternalForceQP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BldInternalForceQP upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%BldInternalForceQP) ! BldInternalForceQP - END IF - Int_BufSz = Int_BufSz + 1 ! FirstNodeReactionLclForceMoment allocated yes/no - IF ( ALLOCATED(InData%FirstNodeReactionLclForceMoment) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FirstNodeReactionLclForceMoment upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%FirstNodeReactionLclForceMoment) ! FirstNodeReactionLclForceMoment - END IF - Int_BufSz = Int_BufSz + 1 ! Solution allocated yes/no - IF ( ALLOCATED(InData%Solution) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Solution upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Solution) ! Solution - END IF - Int_BufSz = Int_BufSz + 1 ! LP_StifK allocated yes/no - IF ( ALLOCATED(InData%LP_StifK) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! LP_StifK upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%LP_StifK) ! LP_StifK - END IF - Int_BufSz = Int_BufSz + 1 ! LP_MassM allocated yes/no - IF ( ALLOCATED(InData%LP_MassM) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! LP_MassM upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%LP_MassM) ! LP_MassM - END IF - Int_BufSz = Int_BufSz + 1 ! LP_MassM_LU allocated yes/no - IF ( ALLOCATED(InData%LP_MassM_LU) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! LP_MassM_LU upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%LP_MassM_LU) ! LP_MassM_LU - END IF - Int_BufSz = Int_BufSz + 1 ! LP_RHS allocated yes/no - IF ( ALLOCATED(InData%LP_RHS) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LP_RHS upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%LP_RHS) ! LP_RHS - END IF - Int_BufSz = Int_BufSz + 1 ! LP_StifK_LU allocated yes/no - IF ( ALLOCATED(InData%LP_StifK_LU) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! LP_StifK_LU upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%LP_StifK_LU) ! LP_StifK_LU - END IF - Int_BufSz = Int_BufSz + 1 ! LP_RHS_LU allocated yes/no - IF ( ALLOCATED(InData%LP_RHS_LU) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LP_RHS_LU upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%LP_RHS_LU) ! LP_RHS_LU - END IF - Int_BufSz = Int_BufSz + 1 ! LP_indx allocated yes/no - IF ( ALLOCATED(InData%LP_indx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LP_indx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LP_indx) ! LP_indx - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u2: size of buffers for each call to pack subtype - CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u2, ErrStat2, ErrMsg2, .TRUE. ) ! u2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL MeshPack( InData%u_DistrLoad_at_y, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_DistrLoad_at_y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MeshPack( InData%y_BldMotion_at_u, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! y_BldMotion_at_u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%Map_u_DistrLoad_to_y, ErrStat2, ErrMsg2, OnlySize ) ! Map_u_DistrLoad_to_y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%Map_y_BldMotion_to_u, ErrStat2, ErrMsg2, OnlySize ) ! Map_y_BldMotion_to_u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = InData%Un_Sum - Int_Xferred = Int_Xferred + 1 - CALL BD_PackEqMotionQP( Re_Buf, Db_Buf, Int_Buf, InData%qp, ErrStat2, ErrMsg2, OnlySize ) ! qp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%lin_A) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%lin_A,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%lin_A,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%lin_A,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%lin_A,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%lin_A,2), UBOUND(InData%lin_A,2) - DO i1 = LBOUND(InData%lin_A,1), UBOUND(InData%lin_A,1) - DbKiBuf(Db_Xferred) = InData%lin_A(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%lin_C) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%lin_C,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%lin_C,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%lin_C,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%lin_C,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%lin_C,2), UBOUND(InData%lin_C,2) - DO i1 = LBOUND(InData%lin_C,1), UBOUND(InData%lin_C,1) - DbKiBuf(Db_Xferred) = InData%lin_C(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Nrrr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Nrrr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nrrr,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Nrrr,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nrrr,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Nrrr,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nrrr,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Nrrr,3), UBOUND(InData%Nrrr,3) - DO i2 = LBOUND(InData%Nrrr,2), UBOUND(InData%Nrrr,2) - DO i1 = LBOUND(InData%Nrrr,1), UBOUND(InData%Nrrr,1) - DbKiBuf(Db_Xferred) = InData%Nrrr(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%elf) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%elf,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elf,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%elf,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elf,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%elf,2), UBOUND(InData%elf,2) - DO i1 = LBOUND(InData%elf,1), UBOUND(InData%elf,1) - DbKiBuf(Db_Xferred) = InData%elf(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%EFint) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%EFint,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EFint,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%EFint,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EFint,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%EFint,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EFint,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%EFint,3), UBOUND(InData%EFint,3) - DO i2 = LBOUND(InData%EFint,2), UBOUND(InData%EFint,2) - DO i1 = LBOUND(InData%EFint,1), UBOUND(InData%EFint,1) - DbKiBuf(Db_Xferred) = InData%EFint(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%elk) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%elk,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elk,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%elk,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elk,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%elk,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elk,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%elk,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elk,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%elk,4), UBOUND(InData%elk,4) - DO i3 = LBOUND(InData%elk,3), UBOUND(InData%elk,3) - DO i2 = LBOUND(InData%elk,2), UBOUND(InData%elk,2) - DO i1 = LBOUND(InData%elk,1), UBOUND(InData%elk,1) - DbKiBuf(Db_Xferred) = InData%elk(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%elg) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%elg,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elg,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%elg,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elg,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%elg,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elg,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%elg,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elg,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%elg,4), UBOUND(InData%elg,4) - DO i3 = LBOUND(InData%elg,3), UBOUND(InData%elg,3) - DO i2 = LBOUND(InData%elg,2), UBOUND(InData%elg,2) - DO i1 = LBOUND(InData%elg,1), UBOUND(InData%elg,1) - DbKiBuf(Db_Xferred) = InData%elg(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%elm) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%elm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elm,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%elm,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elm,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%elm,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elm,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%elm,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elm,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%elm,4), UBOUND(InData%elm,4) - DO i3 = LBOUND(InData%elm,3), UBOUND(InData%elm,3) - DO i2 = LBOUND(InData%elm,2), UBOUND(InData%elm,2) - DO i1 = LBOUND(InData%elm,1), UBOUND(InData%elm,1) - DbKiBuf(Db_Xferred) = InData%elm(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DistrLoad_QP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DistrLoad_QP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DistrLoad_QP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DistrLoad_QP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DistrLoad_QP,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DistrLoad_QP,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DistrLoad_QP,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%DistrLoad_QP,3), UBOUND(InData%DistrLoad_QP,3) - DO i2 = LBOUND(InData%DistrLoad_QP,2), UBOUND(InData%DistrLoad_QP,2) - DO i1 = LBOUND(InData%DistrLoad_QP,1), UBOUND(InData%DistrLoad_QP,1) - DbKiBuf(Db_Xferred) = InData%DistrLoad_QP(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PointLoadLcl) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PointLoadLcl,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PointLoadLcl,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PointLoadLcl,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PointLoadLcl,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PointLoadLcl,2), UBOUND(InData%PointLoadLcl,2) - DO i1 = LBOUND(InData%PointLoadLcl,1), UBOUND(InData%PointLoadLcl,1) - DbKiBuf(Db_Xferred) = InData%PointLoadLcl(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StifK) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StifK,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StifK,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StifK,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StifK,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StifK,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StifK,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StifK,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StifK,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%StifK,4), UBOUND(InData%StifK,4) - DO i3 = LBOUND(InData%StifK,3), UBOUND(InData%StifK,3) - DO i2 = LBOUND(InData%StifK,2), UBOUND(InData%StifK,2) - DO i1 = LBOUND(InData%StifK,1), UBOUND(InData%StifK,1) - DbKiBuf(Db_Xferred) = InData%StifK(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MassM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MassM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MassM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MassM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MassM,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MassM,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MassM,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MassM,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MassM,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%MassM,4), UBOUND(InData%MassM,4) - DO i3 = LBOUND(InData%MassM,3), UBOUND(InData%MassM,3) - DO i2 = LBOUND(InData%MassM,2), UBOUND(InData%MassM,2) - DO i1 = LBOUND(InData%MassM,1), UBOUND(InData%MassM,1) - DbKiBuf(Db_Xferred) = InData%MassM(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DampG) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DampG,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DampG,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DampG,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DampG,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DampG,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DampG,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DampG,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DampG,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%DampG,4), UBOUND(InData%DampG,4) - DO i3 = LBOUND(InData%DampG,3), UBOUND(InData%DampG,3) - DO i2 = LBOUND(InData%DampG,2), UBOUND(InData%DampG,2) - DO i1 = LBOUND(InData%DampG,1), UBOUND(InData%DampG,1) - DbKiBuf(Db_Xferred) = InData%DampG(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StifK_fd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StifK_fd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StifK_fd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StifK_fd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StifK_fd,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StifK_fd,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StifK_fd,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StifK_fd,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StifK_fd,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%StifK_fd,4), UBOUND(InData%StifK_fd,4) - DO i3 = LBOUND(InData%StifK_fd,3), UBOUND(InData%StifK_fd,3) - DO i2 = LBOUND(InData%StifK_fd,2), UBOUND(InData%StifK_fd,2) - DO i1 = LBOUND(InData%StifK_fd,1), UBOUND(InData%StifK_fd,1) - DbKiBuf(Db_Xferred) = InData%StifK_fd(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MassM_fd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MassM_fd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MassM_fd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MassM_fd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MassM_fd,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MassM_fd,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MassM_fd,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MassM_fd,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MassM_fd,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%MassM_fd,4), UBOUND(InData%MassM_fd,4) - DO i3 = LBOUND(InData%MassM_fd,3), UBOUND(InData%MassM_fd,3) - DO i2 = LBOUND(InData%MassM_fd,2), UBOUND(InData%MassM_fd,2) - DO i1 = LBOUND(InData%MassM_fd,1), UBOUND(InData%MassM_fd,1) - DbKiBuf(Db_Xferred) = InData%MassM_fd(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DampG_fd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DampG_fd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DampG_fd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DampG_fd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DampG_fd,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DampG_fd,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DampG_fd,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DampG_fd,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DampG_fd,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%DampG_fd,4), UBOUND(InData%DampG_fd,4) - DO i3 = LBOUND(InData%DampG_fd,3), UBOUND(InData%DampG_fd,3) - DO i2 = LBOUND(InData%DampG_fd,2), UBOUND(InData%DampG_fd,2) - DO i1 = LBOUND(InData%DampG_fd,1), UBOUND(InData%DampG_fd,1) - DbKiBuf(Db_Xferred) = InData%DampG_fd(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RHS) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RHS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RHS,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RHS,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RHS,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%RHS,2), UBOUND(InData%RHS,2) - DO i1 = LBOUND(InData%RHS,1), UBOUND(InData%RHS,1) - DbKiBuf(Db_Xferred) = InData%RHS(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RHS_p) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RHS_p,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RHS_p,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RHS_p,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RHS_p,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%RHS_p,2), UBOUND(InData%RHS_p,2) - DO i1 = LBOUND(InData%RHS_p,1), UBOUND(InData%RHS_p,1) - DbKiBuf(Db_Xferred) = InData%RHS_p(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RHS_m) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RHS_m,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RHS_m,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RHS_m,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RHS_m,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%RHS_m,2), UBOUND(InData%RHS_m,2) - DO i1 = LBOUND(InData%RHS_m,1), UBOUND(InData%RHS_m,1) - DbKiBuf(Db_Xferred) = InData%RHS_m(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BldInternalForceFE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldInternalForceFE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldInternalForceFE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldInternalForceFE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldInternalForceFE,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BldInternalForceFE,2), UBOUND(InData%BldInternalForceFE,2) - DO i1 = LBOUND(InData%BldInternalForceFE,1), UBOUND(InData%BldInternalForceFE,1) - DbKiBuf(Db_Xferred) = InData%BldInternalForceFE(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BldInternalForceQP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldInternalForceQP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldInternalForceQP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldInternalForceQP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldInternalForceQP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BldInternalForceQP,2), UBOUND(InData%BldInternalForceQP,2) - DO i1 = LBOUND(InData%BldInternalForceQP,1), UBOUND(InData%BldInternalForceQP,1) - DbKiBuf(Db_Xferred) = InData%BldInternalForceQP(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FirstNodeReactionLclForceMoment) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FirstNodeReactionLclForceMoment,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FirstNodeReactionLclForceMoment,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FirstNodeReactionLclForceMoment,1), UBOUND(InData%FirstNodeReactionLclForceMoment,1) - DbKiBuf(Db_Xferred) = InData%FirstNodeReactionLclForceMoment(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Solution) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Solution,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Solution,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Solution,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Solution,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Solution,2), UBOUND(InData%Solution,2) - DO i1 = LBOUND(InData%Solution,1), UBOUND(InData%Solution,1) - DbKiBuf(Db_Xferred) = InData%Solution(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LP_StifK) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LP_StifK,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_StifK,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LP_StifK,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_StifK,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%LP_StifK,2), UBOUND(InData%LP_StifK,2) - DO i1 = LBOUND(InData%LP_StifK,1), UBOUND(InData%LP_StifK,1) - DbKiBuf(Db_Xferred) = InData%LP_StifK(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LP_MassM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LP_MassM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_MassM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LP_MassM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_MassM,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%LP_MassM,2), UBOUND(InData%LP_MassM,2) - DO i1 = LBOUND(InData%LP_MassM,1), UBOUND(InData%LP_MassM,1) - DbKiBuf(Db_Xferred) = InData%LP_MassM(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LP_MassM_LU) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LP_MassM_LU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_MassM_LU,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LP_MassM_LU,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_MassM_LU,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%LP_MassM_LU,2), UBOUND(InData%LP_MassM_LU,2) - DO i1 = LBOUND(InData%LP_MassM_LU,1), UBOUND(InData%LP_MassM_LU,1) - DbKiBuf(Db_Xferred) = InData%LP_MassM_LU(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LP_RHS) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LP_RHS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_RHS,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LP_RHS,1), UBOUND(InData%LP_RHS,1) - DbKiBuf(Db_Xferred) = InData%LP_RHS(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LP_StifK_LU) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LP_StifK_LU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_StifK_LU,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LP_StifK_LU,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_StifK_LU,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%LP_StifK_LU,2), UBOUND(InData%LP_StifK_LU,2) - DO i1 = LBOUND(InData%LP_StifK_LU,1), UBOUND(InData%LP_StifK_LU,1) - DbKiBuf(Db_Xferred) = InData%LP_StifK_LU(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LP_RHS_LU) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LP_RHS_LU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_RHS_LU,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LP_RHS_LU,1), UBOUND(InData%LP_RHS_LU,1) - DbKiBuf(Db_Xferred) = InData%LP_RHS_LU(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LP_indx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LP_indx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_indx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LP_indx,1), UBOUND(InData%LP_indx,1) - IntKiBuf(Int_Xferred) = InData%LP_indx(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u2, ErrStat2, ErrMsg2, OnlySize ) ! u2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE BD_PackMisc - - SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(BD_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%u_DistrLoad_at_y, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_DistrLoad_at_y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%y_BldMotion_at_u, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! y_BldMotion_at_u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%Map_u_DistrLoad_to_y, ErrStat2, ErrMsg2 ) ! Map_u_DistrLoad_to_y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%Map_y_BldMotion_to_u, ErrStat2, ErrMsg2 ) ! Map_y_BldMotion_to_u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%Un_Sum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL BD_UnpackEqMotionQP( Re_Buf, Db_Buf, Int_Buf, OutData%qp, ErrStat2, ErrMsg2 ) ! qp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! lin_A not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%lin_A)) DEALLOCATE(OutData%lin_A) - ALLOCATE(OutData%lin_A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%lin_A.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%lin_A,2), UBOUND(OutData%lin_A,2) - DO i1 = LBOUND(OutData%lin_A,1), UBOUND(OutData%lin_A,1) - OutData%lin_A(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! lin_C not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%lin_C)) DEALLOCATE(OutData%lin_C) - ALLOCATE(OutData%lin_C(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%lin_C.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%lin_C,2), UBOUND(OutData%lin_C,2) - DO i1 = LBOUND(OutData%lin_C,1), UBOUND(OutData%lin_C,1) - OutData%lin_C(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Nrrr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Nrrr)) DEALLOCATE(OutData%Nrrr) - ALLOCATE(OutData%Nrrr(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nrrr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Nrrr,3), UBOUND(OutData%Nrrr,3) - DO i2 = LBOUND(OutData%Nrrr,2), UBOUND(OutData%Nrrr,2) - DO i1 = LBOUND(OutData%Nrrr,1), UBOUND(OutData%Nrrr,1) - OutData%Nrrr(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! elf not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%elf)) DEALLOCATE(OutData%elf) - ALLOCATE(OutData%elf(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%elf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%elf,2), UBOUND(OutData%elf,2) - DO i1 = LBOUND(OutData%elf,1), UBOUND(OutData%elf,1) - OutData%elf(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! EFint not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%EFint)) DEALLOCATE(OutData%EFint) - ALLOCATE(OutData%EFint(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%EFint.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%EFint,3), UBOUND(OutData%EFint,3) - DO i2 = LBOUND(OutData%EFint,2), UBOUND(OutData%EFint,2) - DO i1 = LBOUND(OutData%EFint,1), UBOUND(OutData%EFint,1) - OutData%EFint(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! elk not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%elk)) DEALLOCATE(OutData%elk) - ALLOCATE(OutData%elk(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%elk.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%elk,4), UBOUND(OutData%elk,4) - DO i3 = LBOUND(OutData%elk,3), UBOUND(OutData%elk,3) - DO i2 = LBOUND(OutData%elk,2), UBOUND(OutData%elk,2) - DO i1 = LBOUND(OutData%elk,1), UBOUND(OutData%elk,1) - OutData%elk(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! elg not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%elg)) DEALLOCATE(OutData%elg) - ALLOCATE(OutData%elg(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%elg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%elg,4), UBOUND(OutData%elg,4) - DO i3 = LBOUND(OutData%elg,3), UBOUND(OutData%elg,3) - DO i2 = LBOUND(OutData%elg,2), UBOUND(OutData%elg,2) - DO i1 = LBOUND(OutData%elg,1), UBOUND(OutData%elg,1) - OutData%elg(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! elm not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%elm)) DEALLOCATE(OutData%elm) - ALLOCATE(OutData%elm(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%elm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%elm,4), UBOUND(OutData%elm,4) - DO i3 = LBOUND(OutData%elm,3), UBOUND(OutData%elm,3) - DO i2 = LBOUND(OutData%elm,2), UBOUND(OutData%elm,2) - DO i1 = LBOUND(OutData%elm,1), UBOUND(OutData%elm,1) - OutData%elm(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DistrLoad_QP not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DistrLoad_QP)) DEALLOCATE(OutData%DistrLoad_QP) - ALLOCATE(OutData%DistrLoad_QP(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DistrLoad_QP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%DistrLoad_QP,3), UBOUND(OutData%DistrLoad_QP,3) - DO i2 = LBOUND(OutData%DistrLoad_QP,2), UBOUND(OutData%DistrLoad_QP,2) - DO i1 = LBOUND(OutData%DistrLoad_QP,1), UBOUND(OutData%DistrLoad_QP,1) - OutData%DistrLoad_QP(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PointLoadLcl not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PointLoadLcl)) DEALLOCATE(OutData%PointLoadLcl) - ALLOCATE(OutData%PointLoadLcl(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PointLoadLcl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PointLoadLcl,2), UBOUND(OutData%PointLoadLcl,2) - DO i1 = LBOUND(OutData%PointLoadLcl,1), UBOUND(OutData%PointLoadLcl,1) - OutData%PointLoadLcl(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StifK not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%StifK)) DEALLOCATE(OutData%StifK) - ALLOCATE(OutData%StifK(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StifK.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%StifK,4), UBOUND(OutData%StifK,4) - DO i3 = LBOUND(OutData%StifK,3), UBOUND(OutData%StifK,3) - DO i2 = LBOUND(OutData%StifK,2), UBOUND(OutData%StifK,2) - DO i1 = LBOUND(OutData%StifK,1), UBOUND(OutData%StifK,1) - OutData%StifK(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MassM not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MassM)) DEALLOCATE(OutData%MassM) - ALLOCATE(OutData%MassM(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MassM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%MassM,4), UBOUND(OutData%MassM,4) - DO i3 = LBOUND(OutData%MassM,3), UBOUND(OutData%MassM,3) - DO i2 = LBOUND(OutData%MassM,2), UBOUND(OutData%MassM,2) - DO i1 = LBOUND(OutData%MassM,1), UBOUND(OutData%MassM,1) - OutData%MassM(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DampG not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DampG)) DEALLOCATE(OutData%DampG) - ALLOCATE(OutData%DampG(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DampG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%DampG,4), UBOUND(OutData%DampG,4) - DO i3 = LBOUND(OutData%DampG,3), UBOUND(OutData%DampG,3) - DO i2 = LBOUND(OutData%DampG,2), UBOUND(OutData%DampG,2) - DO i1 = LBOUND(OutData%DampG,1), UBOUND(OutData%DampG,1) - OutData%DampG(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StifK_fd not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%StifK_fd)) DEALLOCATE(OutData%StifK_fd) - ALLOCATE(OutData%StifK_fd(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StifK_fd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%StifK_fd,4), UBOUND(OutData%StifK_fd,4) - DO i3 = LBOUND(OutData%StifK_fd,3), UBOUND(OutData%StifK_fd,3) - DO i2 = LBOUND(OutData%StifK_fd,2), UBOUND(OutData%StifK_fd,2) - DO i1 = LBOUND(OutData%StifK_fd,1), UBOUND(OutData%StifK_fd,1) - OutData%StifK_fd(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MassM_fd not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MassM_fd)) DEALLOCATE(OutData%MassM_fd) - ALLOCATE(OutData%MassM_fd(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MassM_fd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%MassM_fd,4), UBOUND(OutData%MassM_fd,4) - DO i3 = LBOUND(OutData%MassM_fd,3), UBOUND(OutData%MassM_fd,3) - DO i2 = LBOUND(OutData%MassM_fd,2), UBOUND(OutData%MassM_fd,2) - DO i1 = LBOUND(OutData%MassM_fd,1), UBOUND(OutData%MassM_fd,1) - OutData%MassM_fd(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DampG_fd not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DampG_fd)) DEALLOCATE(OutData%DampG_fd) - ALLOCATE(OutData%DampG_fd(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DampG_fd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%DampG_fd,4), UBOUND(OutData%DampG_fd,4) - DO i3 = LBOUND(OutData%DampG_fd,3), UBOUND(OutData%DampG_fd,3) - DO i2 = LBOUND(OutData%DampG_fd,2), UBOUND(OutData%DampG_fd,2) - DO i1 = LBOUND(OutData%DampG_fd,1), UBOUND(OutData%DampG_fd,1) - OutData%DampG_fd(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RHS not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RHS)) DEALLOCATE(OutData%RHS) - ALLOCATE(OutData%RHS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RHS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%RHS,2), UBOUND(OutData%RHS,2) - DO i1 = LBOUND(OutData%RHS,1), UBOUND(OutData%RHS,1) - OutData%RHS(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RHS_p not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RHS_p)) DEALLOCATE(OutData%RHS_p) - ALLOCATE(OutData%RHS_p(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RHS_p.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%RHS_p,2), UBOUND(OutData%RHS_p,2) - DO i1 = LBOUND(OutData%RHS_p,1), UBOUND(OutData%RHS_p,1) - OutData%RHS_p(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RHS_m not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RHS_m)) DEALLOCATE(OutData%RHS_m) - ALLOCATE(OutData%RHS_m(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RHS_m.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%RHS_m,2), UBOUND(OutData%RHS_m,2) - DO i1 = LBOUND(OutData%RHS_m,1), UBOUND(OutData%RHS_m,1) - OutData%RHS_m(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldInternalForceFE not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BldInternalForceFE)) DEALLOCATE(OutData%BldInternalForceFE) - ALLOCATE(OutData%BldInternalForceFE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldInternalForceFE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BldInternalForceFE,2), UBOUND(OutData%BldInternalForceFE,2) - DO i1 = LBOUND(OutData%BldInternalForceFE,1), UBOUND(OutData%BldInternalForceFE,1) - OutData%BldInternalForceFE(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldInternalForceQP not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BldInternalForceQP)) DEALLOCATE(OutData%BldInternalForceQP) - ALLOCATE(OutData%BldInternalForceQP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldInternalForceQP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BldInternalForceQP,2), UBOUND(OutData%BldInternalForceQP,2) - DO i1 = LBOUND(OutData%BldInternalForceQP,1), UBOUND(OutData%BldInternalForceQP,1) - OutData%BldInternalForceQP(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FirstNodeReactionLclForceMoment not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FirstNodeReactionLclForceMoment)) DEALLOCATE(OutData%FirstNodeReactionLclForceMoment) - ALLOCATE(OutData%FirstNodeReactionLclForceMoment(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FirstNodeReactionLclForceMoment.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FirstNodeReactionLclForceMoment,1), UBOUND(OutData%FirstNodeReactionLclForceMoment,1) - OutData%FirstNodeReactionLclForceMoment(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Solution not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Solution)) DEALLOCATE(OutData%Solution) - ALLOCATE(OutData%Solution(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Solution.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Solution,2), UBOUND(OutData%Solution,2) - DO i1 = LBOUND(OutData%Solution,1), UBOUND(OutData%Solution,1) - OutData%Solution(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LP_StifK not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LP_StifK)) DEALLOCATE(OutData%LP_StifK) - ALLOCATE(OutData%LP_StifK(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_StifK.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%LP_StifK,2), UBOUND(OutData%LP_StifK,2) - DO i1 = LBOUND(OutData%LP_StifK,1), UBOUND(OutData%LP_StifK,1) - OutData%LP_StifK(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LP_MassM not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LP_MassM)) DEALLOCATE(OutData%LP_MassM) - ALLOCATE(OutData%LP_MassM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_MassM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%LP_MassM,2), UBOUND(OutData%LP_MassM,2) - DO i1 = LBOUND(OutData%LP_MassM,1), UBOUND(OutData%LP_MassM,1) - OutData%LP_MassM(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LP_MassM_LU not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LP_MassM_LU)) DEALLOCATE(OutData%LP_MassM_LU) - ALLOCATE(OutData%LP_MassM_LU(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_MassM_LU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%LP_MassM_LU,2), UBOUND(OutData%LP_MassM_LU,2) - DO i1 = LBOUND(OutData%LP_MassM_LU,1), UBOUND(OutData%LP_MassM_LU,1) - OutData%LP_MassM_LU(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LP_RHS not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LP_RHS)) DEALLOCATE(OutData%LP_RHS) - ALLOCATE(OutData%LP_RHS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_RHS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LP_RHS,1), UBOUND(OutData%LP_RHS,1) - OutData%LP_RHS(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LP_StifK_LU not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LP_StifK_LU)) DEALLOCATE(OutData%LP_StifK_LU) - ALLOCATE(OutData%LP_StifK_LU(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_StifK_LU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%LP_StifK_LU,2), UBOUND(OutData%LP_StifK_LU,2) - DO i1 = LBOUND(OutData%LP_StifK_LU,1), UBOUND(OutData%LP_StifK_LU,1) - OutData%LP_StifK_LU(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LP_RHS_LU not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LP_RHS_LU)) DEALLOCATE(OutData%LP_RHS_LU) - ALLOCATE(OutData%LP_RHS_LU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_RHS_LU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LP_RHS_LU,1), UBOUND(OutData%LP_RHS_LU,1) - OutData%LP_RHS_LU(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LP_indx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LP_indx)) DEALLOCATE(OutData%LP_indx) - ALLOCATE(OutData%LP_indx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LP_indx,1), UBOUND(OutData%LP_indx,1) - OutData%LP_indx(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL BD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL BD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u2, ErrStat2, ErrMsg2 ) ! u2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE BD_UnPackMisc +subroutine BD_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BD_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'BD_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + ! u_DistrLoad_at_y + call MeshPack(Buf, InData%u_DistrLoad_at_y) + if (RegCheckErr(Buf, RoutineName)) return + ! y_BldMotion_at_u + call MeshPack(Buf, InData%y_BldMotion_at_u) + if (RegCheckErr(Buf, RoutineName)) return + ! Map_u_DistrLoad_to_y + call NWTC_Library_PackMeshMapType(Buf, InData%Map_u_DistrLoad_to_y) + if (RegCheckErr(Buf, RoutineName)) return + ! Map_y_BldMotion_to_u + call NWTC_Library_PackMeshMapType(Buf, InData%Map_y_BldMotion_to_u) + if (RegCheckErr(Buf, RoutineName)) return + ! Un_Sum + call RegPack(Buf, InData%Un_Sum) + if (RegCheckErr(Buf, RoutineName)) return + ! qp + call BD_PackEqMotionQP(Buf, InData%qp) + if (RegCheckErr(Buf, RoutineName)) return + ! lin_A + call RegPack(Buf, allocated(InData%lin_A)) + if (allocated(InData%lin_A)) then + call RegPackBounds(Buf, 2, lbound(InData%lin_A), ubound(InData%lin_A)) + call RegPack(Buf, InData%lin_A) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! lin_C + call RegPack(Buf, allocated(InData%lin_C)) + if (allocated(InData%lin_C)) then + call RegPackBounds(Buf, 2, lbound(InData%lin_C), ubound(InData%lin_C)) + call RegPack(Buf, InData%lin_C) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Nrrr + call RegPack(Buf, allocated(InData%Nrrr)) + if (allocated(InData%Nrrr)) then + call RegPackBounds(Buf, 3, lbound(InData%Nrrr), ubound(InData%Nrrr)) + call RegPack(Buf, InData%Nrrr) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! elf + call RegPack(Buf, allocated(InData%elf)) + if (allocated(InData%elf)) then + call RegPackBounds(Buf, 2, lbound(InData%elf), ubound(InData%elf)) + call RegPack(Buf, InData%elf) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! EFint + call RegPack(Buf, allocated(InData%EFint)) + if (allocated(InData%EFint)) then + call RegPackBounds(Buf, 3, lbound(InData%EFint), ubound(InData%EFint)) + call RegPack(Buf, InData%EFint) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! elk + call RegPack(Buf, allocated(InData%elk)) + if (allocated(InData%elk)) then + call RegPackBounds(Buf, 4, lbound(InData%elk), ubound(InData%elk)) + call RegPack(Buf, InData%elk) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! elg + call RegPack(Buf, allocated(InData%elg)) + if (allocated(InData%elg)) then + call RegPackBounds(Buf, 4, lbound(InData%elg), ubound(InData%elg)) + call RegPack(Buf, InData%elg) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! elm + call RegPack(Buf, allocated(InData%elm)) + if (allocated(InData%elm)) then + call RegPackBounds(Buf, 4, lbound(InData%elm), ubound(InData%elm)) + call RegPack(Buf, InData%elm) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DistrLoad_QP + call RegPack(Buf, allocated(InData%DistrLoad_QP)) + if (allocated(InData%DistrLoad_QP)) then + call RegPackBounds(Buf, 3, lbound(InData%DistrLoad_QP), ubound(InData%DistrLoad_QP)) + call RegPack(Buf, InData%DistrLoad_QP) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PointLoadLcl + call RegPack(Buf, allocated(InData%PointLoadLcl)) + if (allocated(InData%PointLoadLcl)) then + call RegPackBounds(Buf, 2, lbound(InData%PointLoadLcl), ubound(InData%PointLoadLcl)) + call RegPack(Buf, InData%PointLoadLcl) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! StifK + call RegPack(Buf, allocated(InData%StifK)) + if (allocated(InData%StifK)) then + call RegPackBounds(Buf, 4, lbound(InData%StifK), ubound(InData%StifK)) + call RegPack(Buf, InData%StifK) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MassM + call RegPack(Buf, allocated(InData%MassM)) + if (allocated(InData%MassM)) then + call RegPackBounds(Buf, 4, lbound(InData%MassM), ubound(InData%MassM)) + call RegPack(Buf, InData%MassM) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DampG + call RegPack(Buf, allocated(InData%DampG)) + if (allocated(InData%DampG)) then + call RegPackBounds(Buf, 4, lbound(InData%DampG), ubound(InData%DampG)) + call RegPack(Buf, InData%DampG) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! StifK_fd + call RegPack(Buf, allocated(InData%StifK_fd)) + if (allocated(InData%StifK_fd)) then + call RegPackBounds(Buf, 4, lbound(InData%StifK_fd), ubound(InData%StifK_fd)) + call RegPack(Buf, InData%StifK_fd) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MassM_fd + call RegPack(Buf, allocated(InData%MassM_fd)) + if (allocated(InData%MassM_fd)) then + call RegPackBounds(Buf, 4, lbound(InData%MassM_fd), ubound(InData%MassM_fd)) + call RegPack(Buf, InData%MassM_fd) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DampG_fd + call RegPack(Buf, allocated(InData%DampG_fd)) + if (allocated(InData%DampG_fd)) then + call RegPackBounds(Buf, 4, lbound(InData%DampG_fd), ubound(InData%DampG_fd)) + call RegPack(Buf, InData%DampG_fd) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RHS + call RegPack(Buf, allocated(InData%RHS)) + if (allocated(InData%RHS)) then + call RegPackBounds(Buf, 2, lbound(InData%RHS), ubound(InData%RHS)) + call RegPack(Buf, InData%RHS) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RHS_p + call RegPack(Buf, allocated(InData%RHS_p)) + if (allocated(InData%RHS_p)) then + call RegPackBounds(Buf, 2, lbound(InData%RHS_p), ubound(InData%RHS_p)) + call RegPack(Buf, InData%RHS_p) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RHS_m + call RegPack(Buf, allocated(InData%RHS_m)) + if (allocated(InData%RHS_m)) then + call RegPackBounds(Buf, 2, lbound(InData%RHS_m), ubound(InData%RHS_m)) + call RegPack(Buf, InData%RHS_m) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BldInternalForceFE + call RegPack(Buf, allocated(InData%BldInternalForceFE)) + if (allocated(InData%BldInternalForceFE)) then + call RegPackBounds(Buf, 2, lbound(InData%BldInternalForceFE), ubound(InData%BldInternalForceFE)) + call RegPack(Buf, InData%BldInternalForceFE) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BldInternalForceQP + call RegPack(Buf, allocated(InData%BldInternalForceQP)) + if (allocated(InData%BldInternalForceQP)) then + call RegPackBounds(Buf, 2, lbound(InData%BldInternalForceQP), ubound(InData%BldInternalForceQP)) + call RegPack(Buf, InData%BldInternalForceQP) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FirstNodeReactionLclForceMoment + call RegPack(Buf, allocated(InData%FirstNodeReactionLclForceMoment)) + if (allocated(InData%FirstNodeReactionLclForceMoment)) then + call RegPackBounds(Buf, 1, lbound(InData%FirstNodeReactionLclForceMoment), ubound(InData%FirstNodeReactionLclForceMoment)) + call RegPack(Buf, InData%FirstNodeReactionLclForceMoment) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Solution + call RegPack(Buf, allocated(InData%Solution)) + if (allocated(InData%Solution)) then + call RegPackBounds(Buf, 2, lbound(InData%Solution), ubound(InData%Solution)) + call RegPack(Buf, InData%Solution) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LP_StifK + call RegPack(Buf, allocated(InData%LP_StifK)) + if (allocated(InData%LP_StifK)) then + call RegPackBounds(Buf, 2, lbound(InData%LP_StifK), ubound(InData%LP_StifK)) + call RegPack(Buf, InData%LP_StifK) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LP_MassM + call RegPack(Buf, allocated(InData%LP_MassM)) + if (allocated(InData%LP_MassM)) then + call RegPackBounds(Buf, 2, lbound(InData%LP_MassM), ubound(InData%LP_MassM)) + call RegPack(Buf, InData%LP_MassM) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LP_MassM_LU + call RegPack(Buf, allocated(InData%LP_MassM_LU)) + if (allocated(InData%LP_MassM_LU)) then + call RegPackBounds(Buf, 2, lbound(InData%LP_MassM_LU), ubound(InData%LP_MassM_LU)) + call RegPack(Buf, InData%LP_MassM_LU) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LP_RHS + call RegPack(Buf, allocated(InData%LP_RHS)) + if (allocated(InData%LP_RHS)) then + call RegPackBounds(Buf, 1, lbound(InData%LP_RHS), ubound(InData%LP_RHS)) + call RegPack(Buf, InData%LP_RHS) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LP_StifK_LU + call RegPack(Buf, allocated(InData%LP_StifK_LU)) + if (allocated(InData%LP_StifK_LU)) then + call RegPackBounds(Buf, 2, lbound(InData%LP_StifK_LU), ubound(InData%LP_StifK_LU)) + call RegPack(Buf, InData%LP_StifK_LU) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LP_RHS_LU + call RegPack(Buf, allocated(InData%LP_RHS_LU)) + if (allocated(InData%LP_RHS_LU)) then + call RegPackBounds(Buf, 1, lbound(InData%LP_RHS_LU), ubound(InData%LP_RHS_LU)) + call RegPack(Buf, InData%LP_RHS_LU) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LP_indx + call RegPack(Buf, allocated(InData%LP_indx)) + if (allocated(InData%LP_indx)) then + call RegPackBounds(Buf, 1, lbound(InData%LP_indx), ubound(InData%LP_indx)) + call RegPack(Buf, InData%LP_indx) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! u + call BD_PackInput(Buf, InData%u) + if (RegCheckErr(Buf, RoutineName)) return + ! u2 + call BD_PackInput(Buf, InData%u2) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine BD_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BD_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'BD_UnPackMisc' + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! u_DistrLoad_at_y + call MeshUnpack(Buf, OutData%u_DistrLoad_at_y) ! u_DistrLoad_at_y + ! y_BldMotion_at_u + call MeshUnpack(Buf, OutData%y_BldMotion_at_u) ! y_BldMotion_at_u + ! Map_u_DistrLoad_to_y + call NWTC_Library_UnpackMeshMapType(Buf, OutData%Map_u_DistrLoad_to_y) ! Map_u_DistrLoad_to_y + ! Map_y_BldMotion_to_u + call NWTC_Library_UnpackMeshMapType(Buf, OutData%Map_y_BldMotion_to_u) ! Map_y_BldMotion_to_u + ! Un_Sum + call RegUnpack(Buf, OutData%Un_Sum) + if (RegCheckErr(Buf, RoutineName)) return + ! qp + call BD_UnpackEqMotionQP(Buf, OutData%qp) ! qp + ! lin_A + if (allocated(OutData%lin_A)) deallocate(OutData%lin_A) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%lin_A(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%lin_A.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%lin_A) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! lin_C + if (allocated(OutData%lin_C)) deallocate(OutData%lin_C) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%lin_C(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%lin_C.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%lin_C) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Nrrr + if (allocated(OutData%Nrrr)) deallocate(OutData%Nrrr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Nrrr(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nrrr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Nrrr) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! elf + if (allocated(OutData%elf)) deallocate(OutData%elf) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%elf(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%elf.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%elf) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! EFint + if (allocated(OutData%EFint)) deallocate(OutData%EFint) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%EFint(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%EFint.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%EFint) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! elk + if (allocated(OutData%elk)) deallocate(OutData%elk) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%elk(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%elk.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%elk) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! elg + if (allocated(OutData%elg)) deallocate(OutData%elg) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%elg(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%elg.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%elg) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! elm + if (allocated(OutData%elm)) deallocate(OutData%elm) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%elm(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%elm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%elm) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! DistrLoad_QP + if (allocated(OutData%DistrLoad_QP)) deallocate(OutData%DistrLoad_QP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DistrLoad_QP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DistrLoad_QP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DistrLoad_QP) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PointLoadLcl + if (allocated(OutData%PointLoadLcl)) deallocate(OutData%PointLoadLcl) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PointLoadLcl(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PointLoadLcl.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PointLoadLcl) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! StifK + if (allocated(OutData%StifK)) deallocate(OutData%StifK) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StifK(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StifK.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StifK) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! MassM + if (allocated(OutData%MassM)) deallocate(OutData%MassM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MassM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MassM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MassM) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! DampG + if (allocated(OutData%DampG)) deallocate(OutData%DampG) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DampG(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DampG.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DampG) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! StifK_fd + if (allocated(OutData%StifK_fd)) deallocate(OutData%StifK_fd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StifK_fd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StifK_fd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StifK_fd) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! MassM_fd + if (allocated(OutData%MassM_fd)) deallocate(OutData%MassM_fd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MassM_fd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MassM_fd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MassM_fd) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! DampG_fd + if (allocated(OutData%DampG_fd)) deallocate(OutData%DampG_fd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DampG_fd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DampG_fd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DampG_fd) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RHS + if (allocated(OutData%RHS)) deallocate(OutData%RHS) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RHS(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RHS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RHS) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RHS_p + if (allocated(OutData%RHS_p)) deallocate(OutData%RHS_p) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RHS_p(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RHS_p.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RHS_p) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RHS_m + if (allocated(OutData%RHS_m)) deallocate(OutData%RHS_m) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RHS_m(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RHS_m.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RHS_m) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BldInternalForceFE + if (allocated(OutData%BldInternalForceFE)) deallocate(OutData%BldInternalForceFE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BldInternalForceFE(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldInternalForceFE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BldInternalForceFE) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BldInternalForceQP + if (allocated(OutData%BldInternalForceQP)) deallocate(OutData%BldInternalForceQP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BldInternalForceQP(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldInternalForceQP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BldInternalForceQP) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! FirstNodeReactionLclForceMoment + if (allocated(OutData%FirstNodeReactionLclForceMoment)) deallocate(OutData%FirstNodeReactionLclForceMoment) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FirstNodeReactionLclForceMoment(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FirstNodeReactionLclForceMoment.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FirstNodeReactionLclForceMoment) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Solution + if (allocated(OutData%Solution)) deallocate(OutData%Solution) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Solution(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Solution.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Solution) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LP_StifK + if (allocated(OutData%LP_StifK)) deallocate(OutData%LP_StifK) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LP_StifK(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_StifK.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LP_StifK) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LP_MassM + if (allocated(OutData%LP_MassM)) deallocate(OutData%LP_MassM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LP_MassM(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_MassM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LP_MassM) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LP_MassM_LU + if (allocated(OutData%LP_MassM_LU)) deallocate(OutData%LP_MassM_LU) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LP_MassM_LU(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_MassM_LU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LP_MassM_LU) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LP_RHS + if (allocated(OutData%LP_RHS)) deallocate(OutData%LP_RHS) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LP_RHS(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_RHS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LP_RHS) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LP_StifK_LU + if (allocated(OutData%LP_StifK_LU)) deallocate(OutData%LP_StifK_LU) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LP_StifK_LU(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_StifK_LU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LP_StifK_LU) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LP_RHS_LU + if (allocated(OutData%LP_RHS_LU)) deallocate(OutData%LP_RHS_LU) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LP_RHS_LU(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_RHS_LU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LP_RHS_LU) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LP_indx + if (allocated(OutData%LP_indx)) deallocate(OutData%LP_indx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LP_indx(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_indx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LP_indx) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! u + call BD_UnpackInput(Buf, OutData%u) ! u + ! u2 + call BD_UnpackInput(Buf, OutData%u2) ! u2 +end subroutine SUBROUTINE BD_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) ! diff --git a/modules/elastodyn/src/ElastoDyn_Types.f90 b/modules/elastodyn/src/ElastoDyn_Types.f90 index 9c7a4eec8b..7afd6d490f 100644 --- a/modules/elastodyn/src/ElastoDyn_Types.f90 +++ b/modules/elastodyn/src/ElastoDyn_Types.f90 @@ -853,150 +853,68 @@ SUBROUTINE ED_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) END SUBROUTINE ED_DestroyInitInput - SUBROUTINE ED_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ED_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%InputFile) ! InputFile - Int_BufSz = Int_BufSz + 1 ! Linearize - Int_BufSz = Int_BufSz + 1*LEN(InData%ADInputFile) ! ADInputFile - Int_BufSz = Int_BufSz + 1 ! CompElast - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Re_BufSz = Re_BufSz + 1 ! Gravity - Int_BufSz = Int_BufSz + 1 ! MHK - Re_BufSz = Re_BufSz + 1 ! WtrDpth - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%ADInputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%ADInputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%CompElast, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf(Re_Xferred) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MHK - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ED_PackInitInput - - SUBROUTINE ED_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ED_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%ADInputFile) - OutData%ADInputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%CompElast = TRANSFER(IntKiBuf(Int_Xferred), OutData%CompElast) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MHK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ED_UnPackInitInput +subroutine ED_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ED_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + ! InputFile + call RegPack(Buf, InData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! Linearize + call RegPack(Buf, InData%Linearize) + if (RegCheckErr(Buf, RoutineName)) return + ! ADInputFile + call RegPack(Buf, InData%ADInputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! CompElast + call RegPack(Buf, InData%CompElast) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegPack(Buf, InData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! Gravity + call RegPack(Buf, InData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + ! MHK + call RegPack(Buf, InData%MHK) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDpth + call RegPack(Buf, InData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ED_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ED_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackInitInput' + if (Buf%ErrStat /= ErrID_None) return + ! InputFile + call RegUnpack(Buf, OutData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! Linearize + call RegUnpack(Buf, OutData%Linearize) + if (RegCheckErr(Buf, RoutineName)) return + ! ADInputFile + call RegUnpack(Buf, OutData%ADInputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! CompElast + call RegUnpack(Buf, OutData%CompElast) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! Gravity + call RegUnpack(Buf, OutData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + ! MHK + call RegUnpack(Buf, OutData%MHK) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDpth + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE ED_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(ED_InitOutputType), INTENT(IN) :: SrcInitOutputData TYPE(ED_InitOutputType), INTENT(INOUT) :: DstInitOutputData @@ -1243,807 +1161,392 @@ SUBROUTINE ED_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE ED_DestroyInitOutput - SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ED_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! WriteOutputHdr allocated yes/no - IF ( ALLOCATED(InData%WriteOutputHdr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdr upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdr)*LEN(InData%WriteOutputHdr) ! WriteOutputHdr - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputUnt allocated yes/no - IF ( ALLOCATED(InData%WriteOutputUnt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUnt upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUnt)*LEN(InData%WriteOutputUnt) ! WriteOutputUnt - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! NumBl - Int_BufSz = Int_BufSz + 1 ! BlPitch allocated yes/no - IF ( ALLOCATED(InData%BlPitch) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlPitch upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlPitch) ! BlPitch - END IF - Re_BufSz = Re_BufSz + 1 ! BladeLength - Re_BufSz = Re_BufSz + 1 ! TowerHeight - Re_BufSz = Re_BufSz + 1 ! TowerBaseHeight - Re_BufSz = Re_BufSz + 1 ! HubHt - Int_BufSz = Int_BufSz + 1 ! BldRNodes allocated yes/no - IF ( ALLOCATED(InData%BldRNodes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BldRNodes upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BldRNodes) ! BldRNodes - END IF - Int_BufSz = Int_BufSz + 1 ! TwrHNodes allocated yes/no - IF ( ALLOCATED(InData%TwrHNodes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwrHNodes upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrHNodes) ! TwrHNodes - END IF - Re_BufSz = Re_BufSz + SIZE(InData%PlatformPos) ! PlatformPos - Re_BufSz = Re_BufSz + SIZE(InData%TwrBaseRefPos) ! TwrBaseRefPos - Db_BufSz = Db_BufSz + SIZE(InData%TwrBaseTransDisp) ! TwrBaseTransDisp - Db_BufSz = Db_BufSz + SIZE(InData%TwrBaseRefOrient) ! TwrBaseRefOrient - Db_BufSz = Db_BufSz + SIZE(InData%TwrBaseOrient) ! TwrBaseOrient - Re_BufSz = Re_BufSz + 1 ! HubRad - Re_BufSz = Re_BufSz + 1 ! RotSpeed - Int_BufSz = Int_BufSz + 1 ! isFixed_GenDOF - Int_BufSz = Int_BufSz + 1 ! LinNames_y allocated yes/no - IF ( ALLOCATED(InData%LinNames_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_y)*LEN(InData%LinNames_y) ! LinNames_y - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_x allocated yes/no - IF ( ALLOCATED(InData%LinNames_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_x)*LEN(InData%LinNames_x) ! LinNames_x - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_u allocated yes/no - IF ( ALLOCATED(InData%LinNames_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_u)*LEN(InData%LinNames_u) ! LinNames_u - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_y allocated yes/no - IF ( ALLOCATED(InData%RotFrame_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_y) ! RotFrame_y - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_x allocated yes/no - IF ( ALLOCATED(InData%RotFrame_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_x) ! RotFrame_x - END IF - Int_BufSz = Int_BufSz + 1 ! DerivOrder_x allocated yes/no - IF ( ALLOCATED(InData%DerivOrder_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DerivOrder_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%DerivOrder_x) ! DerivOrder_x - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_u allocated yes/no - IF ( ALLOCATED(InData%RotFrame_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_u) ! RotFrame_u - END IF - Int_BufSz = Int_BufSz + 1 ! IsLoad_u allocated yes/no - IF ( ALLOCATED(InData%IsLoad_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IsLoad_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IsLoad_u) ! IsLoad_u - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%WriteOutputHdr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) - DO I = 1, LEN(InData%WriteOutputHdr) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputUnt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) - DO I = 1, LEN(InData%WriteOutputUnt) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = InData%NumBl - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BlPitch) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlPitch,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitch,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlPitch,1), UBOUND(InData%BlPitch,1) - ReKiBuf(Re_Xferred) = InData%BlPitch(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%BladeLength - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TowerHeight - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TowerBaseHeight - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubHt - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BldRNodes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldRNodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldRNodes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BldRNodes,1), UBOUND(InData%BldRNodes,1) - ReKiBuf(Re_Xferred) = InData%BldRNodes(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrHNodes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrHNodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrHNodes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwrHNodes,1), UBOUND(InData%TwrHNodes,1) - ReKiBuf(Re_Xferred) = InData%TwrHNodes(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DO i1 = LBOUND(InData%PlatformPos,1), UBOUND(InData%PlatformPos,1) - ReKiBuf(Re_Xferred) = InData%PlatformPos(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TwrBaseRefPos,1), UBOUND(InData%TwrBaseRefPos,1) - ReKiBuf(Re_Xferred) = InData%TwrBaseRefPos(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TwrBaseTransDisp,1), UBOUND(InData%TwrBaseTransDisp,1) - DbKiBuf(Db_Xferred) = InData%TwrBaseTransDisp(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i2 = LBOUND(InData%TwrBaseRefOrient,2), UBOUND(InData%TwrBaseRefOrient,2) - DO i1 = LBOUND(InData%TwrBaseRefOrient,1), UBOUND(InData%TwrBaseRefOrient,1) - DbKiBuf(Db_Xferred) = InData%TwrBaseRefOrient(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%TwrBaseOrient,2), UBOUND(InData%TwrBaseOrient,2) - DO i1 = LBOUND(InData%TwrBaseOrient,1), UBOUND(InData%TwrBaseOrient,1) - DbKiBuf(Db_Xferred) = InData%TwrBaseOrient(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - ReKiBuf(Re_Xferred) = InData%HubRad - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RotSpeed - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%isFixed_GenDOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%LinNames_y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) - DO I = 1, LEN(InData%LinNames_y) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_y(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinNames_x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_x,1), UBOUND(InData%LinNames_x,1) - DO I = 1, LEN(InData%LinNames_x) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_x(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinNames_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) - DO I = 1, LEN(InData%LinNames_u) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_u(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_y,1), UBOUND(InData%RotFrame_y,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_y(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_x,1), UBOUND(InData%RotFrame_x,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_x(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DerivOrder_x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DerivOrder_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DerivOrder_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DerivOrder_x,1), UBOUND(InData%DerivOrder_x,1) - IntKiBuf(Int_Xferred) = InData%DerivOrder_x(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_u,1), UBOUND(InData%RotFrame_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IsLoad_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IsLoad_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE ED_PackInitOutput - - SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ED_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputHdr)) DEALLOCATE(OutData%WriteOutputHdr) - ALLOCATE(OutData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) - DO I = 1, LEN(OutData%WriteOutputHdr) - OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputUnt)) DEALLOCATE(OutData%WriteOutputUnt) - ALLOCATE(OutData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) - DO I = 1, LEN(OutData%WriteOutputUnt) - OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%NumBl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitch not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlPitch)) DEALLOCATE(OutData%BlPitch) - ALLOCATE(OutData%BlPitch(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitch.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlPitch,1), UBOUND(OutData%BlPitch,1) - OutData%BlPitch(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%BladeLength = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TowerHeight = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TowerBaseHeight = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HubHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldRNodes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BldRNodes)) DEALLOCATE(OutData%BldRNodes) - ALLOCATE(OutData%BldRNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldRNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BldRNodes,1), UBOUND(OutData%BldRNodes,1) - OutData%BldRNodes(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrHNodes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TwrHNodes)) DEALLOCATE(OutData%TwrHNodes) - ALLOCATE(OutData%TwrHNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrHNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwrHNodes,1), UBOUND(OutData%TwrHNodes,1) - OutData%TwrHNodes(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - i1_l = LBOUND(OutData%PlatformPos,1) - i1_u = UBOUND(OutData%PlatformPos,1) - DO i1 = LBOUND(OutData%PlatformPos,1), UBOUND(OutData%PlatformPos,1) - OutData%PlatformPos(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TwrBaseRefPos,1) - i1_u = UBOUND(OutData%TwrBaseRefPos,1) - DO i1 = LBOUND(OutData%TwrBaseRefPos,1), UBOUND(OutData%TwrBaseRefPos,1) - OutData%TwrBaseRefPos(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TwrBaseTransDisp,1) - i1_u = UBOUND(OutData%TwrBaseTransDisp,1) - DO i1 = LBOUND(OutData%TwrBaseTransDisp,1), UBOUND(OutData%TwrBaseTransDisp,1) - OutData%TwrBaseTransDisp(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TwrBaseRefOrient,1) - i1_u = UBOUND(OutData%TwrBaseRefOrient,1) - i2_l = LBOUND(OutData%TwrBaseRefOrient,2) - i2_u = UBOUND(OutData%TwrBaseRefOrient,2) - DO i2 = LBOUND(OutData%TwrBaseRefOrient,2), UBOUND(OutData%TwrBaseRefOrient,2) - DO i1 = LBOUND(OutData%TwrBaseRefOrient,1), UBOUND(OutData%TwrBaseRefOrient,1) - OutData%TwrBaseRefOrient(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%TwrBaseOrient,1) - i1_u = UBOUND(OutData%TwrBaseOrient,1) - i2_l = LBOUND(OutData%TwrBaseOrient,2) - i2_u = UBOUND(OutData%TwrBaseOrient,2) - DO i2 = LBOUND(OutData%TwrBaseOrient,2), UBOUND(OutData%TwrBaseOrient,2) - DO i1 = LBOUND(OutData%TwrBaseOrient,1), UBOUND(OutData%TwrBaseOrient,1) - OutData%TwrBaseOrient(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - OutData%HubRad = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RotSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%isFixed_GenDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%isFixed_GenDOF) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LinNames_y)) DEALLOCATE(OutData%LinNames_y) - ALLOCATE(OutData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) - DO I = 1, LEN(OutData%LinNames_y) - OutData%LinNames_y(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LinNames_x)) DEALLOCATE(OutData%LinNames_x) - ALLOCATE(OutData%LinNames_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_x,1), UBOUND(OutData%LinNames_x,1) - DO I = 1, LEN(OutData%LinNames_x) - OutData%LinNames_x(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LinNames_u)) DEALLOCATE(OutData%LinNames_u) - ALLOCATE(OutData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) - DO I = 1, LEN(OutData%LinNames_u) - OutData%LinNames_u(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RotFrame_y)) DEALLOCATE(OutData%RotFrame_y) - ALLOCATE(OutData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_y,1), UBOUND(OutData%RotFrame_y,1) - OutData%RotFrame_y(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_y(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RotFrame_x)) DEALLOCATE(OutData%RotFrame_x) - ALLOCATE(OutData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_x,1), UBOUND(OutData%RotFrame_x,1) - OutData%RotFrame_x(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_x(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DerivOrder_x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DerivOrder_x)) DEALLOCATE(OutData%DerivOrder_x) - ALLOCATE(OutData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DerivOrder_x,1), UBOUND(OutData%DerivOrder_x,1) - OutData%DerivOrder_x(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RotFrame_u)) DEALLOCATE(OutData%RotFrame_u) - ALLOCATE(OutData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_u,1), UBOUND(OutData%RotFrame_u,1) - OutData%RotFrame_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IsLoad_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IsLoad_u)) DEALLOCATE(OutData%IsLoad_u) - ALLOCATE(OutData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) - OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE ED_UnPackInitOutput +subroutine ED_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ED_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! WriteOutputHdr + call RegPack(Buf, allocated(InData%WriteOutputHdr)) + if (allocated(InData%WriteOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPack(Buf, InData%WriteOutputHdr) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutputUnt + call RegPack(Buf, allocated(InData%WriteOutputUnt)) + if (allocated(InData%WriteOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPack(Buf, InData%WriteOutputUnt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Ver + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + if (RegCheckErr(Buf, RoutineName)) return + ! NumBl + call RegPack(Buf, InData%NumBl) + if (RegCheckErr(Buf, RoutineName)) return + ! BlPitch + call RegPack(Buf, allocated(InData%BlPitch)) + if (allocated(InData%BlPitch)) then + call RegPackBounds(Buf, 1, lbound(InData%BlPitch), ubound(InData%BlPitch)) + call RegPack(Buf, InData%BlPitch) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BladeLength + call RegPack(Buf, InData%BladeLength) + if (RegCheckErr(Buf, RoutineName)) return + ! TowerHeight + call RegPack(Buf, InData%TowerHeight) + if (RegCheckErr(Buf, RoutineName)) return + ! TowerBaseHeight + call RegPack(Buf, InData%TowerBaseHeight) + if (RegCheckErr(Buf, RoutineName)) return + ! HubHt + call RegPack(Buf, InData%HubHt) + if (RegCheckErr(Buf, RoutineName)) return + ! BldRNodes + call RegPack(Buf, allocated(InData%BldRNodes)) + if (allocated(InData%BldRNodes)) then + call RegPackBounds(Buf, 1, lbound(InData%BldRNodes), ubound(InData%BldRNodes)) + call RegPack(Buf, InData%BldRNodes) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TwrHNodes + call RegPack(Buf, allocated(InData%TwrHNodes)) + if (allocated(InData%TwrHNodes)) then + call RegPackBounds(Buf, 1, lbound(InData%TwrHNodes), ubound(InData%TwrHNodes)) + call RegPack(Buf, InData%TwrHNodes) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PlatformPos + call RegPack(Buf, InData%PlatformPos) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrBaseRefPos + call RegPack(Buf, InData%TwrBaseRefPos) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrBaseTransDisp + call RegPack(Buf, InData%TwrBaseTransDisp) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrBaseRefOrient + call RegPack(Buf, InData%TwrBaseRefOrient) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrBaseOrient + call RegPack(Buf, InData%TwrBaseOrient) + if (RegCheckErr(Buf, RoutineName)) return + ! HubRad + call RegPack(Buf, InData%HubRad) + if (RegCheckErr(Buf, RoutineName)) return + ! RotSpeed + call RegPack(Buf, InData%RotSpeed) + if (RegCheckErr(Buf, RoutineName)) return + ! isFixed_GenDOF + call RegPack(Buf, InData%isFixed_GenDOF) + if (RegCheckErr(Buf, RoutineName)) return + ! LinNames_y + call RegPack(Buf, allocated(InData%LinNames_y)) + if (allocated(InData%LinNames_y)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) + call RegPack(Buf, InData%LinNames_y) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LinNames_x + call RegPack(Buf, allocated(InData%LinNames_x)) + if (allocated(InData%LinNames_x)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_x), ubound(InData%LinNames_x)) + call RegPack(Buf, InData%LinNames_x) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LinNames_u + call RegPack(Buf, allocated(InData%LinNames_u)) + if (allocated(InData%LinNames_u)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) + call RegPack(Buf, InData%LinNames_u) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RotFrame_y + call RegPack(Buf, allocated(InData%RotFrame_y)) + if (allocated(InData%RotFrame_y)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y), ubound(InData%RotFrame_y)) + call RegPack(Buf, InData%RotFrame_y) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RotFrame_x + call RegPack(Buf, allocated(InData%RotFrame_x)) + if (allocated(InData%RotFrame_x)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x), ubound(InData%RotFrame_x)) + call RegPack(Buf, InData%RotFrame_x) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DerivOrder_x + call RegPack(Buf, allocated(InData%DerivOrder_x)) + if (allocated(InData%DerivOrder_x)) then + call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x), ubound(InData%DerivOrder_x)) + call RegPack(Buf, InData%DerivOrder_x) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RotFrame_u + call RegPack(Buf, allocated(InData%RotFrame_u)) + if (allocated(InData%RotFrame_u)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u), ubound(InData%RotFrame_u)) + call RegPack(Buf, InData%RotFrame_u) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! IsLoad_u + call RegPack(Buf, allocated(InData%IsLoad_u)) + if (allocated(InData%IsLoad_u)) then + call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) + call RegPack(Buf, InData%IsLoad_u) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ED_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ED_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackInitOutput' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! WriteOutputHdr + if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WriteOutputUnt + if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Ver + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + ! NumBl + call RegUnpack(Buf, OutData%NumBl) + if (RegCheckErr(Buf, RoutineName)) return + ! BlPitch + if (allocated(OutData%BlPitch)) deallocate(OutData%BlPitch) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlPitch(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitch.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlPitch) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BladeLength + call RegUnpack(Buf, OutData%BladeLength) + if (RegCheckErr(Buf, RoutineName)) return + ! TowerHeight + call RegUnpack(Buf, OutData%TowerHeight) + if (RegCheckErr(Buf, RoutineName)) return + ! TowerBaseHeight + call RegUnpack(Buf, OutData%TowerBaseHeight) + if (RegCheckErr(Buf, RoutineName)) return + ! HubHt + call RegUnpack(Buf, OutData%HubHt) + if (RegCheckErr(Buf, RoutineName)) return + ! BldRNodes + if (allocated(OutData%BldRNodes)) deallocate(OutData%BldRNodes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BldRNodes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldRNodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BldRNodes) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TwrHNodes + if (allocated(OutData%TwrHNodes)) deallocate(OutData%TwrHNodes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrHNodes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrHNodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrHNodes) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PlatformPos + call RegUnpack(Buf, OutData%PlatformPos) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrBaseRefPos + call RegUnpack(Buf, OutData%TwrBaseRefPos) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrBaseTransDisp + call RegUnpack(Buf, OutData%TwrBaseTransDisp) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrBaseRefOrient + call RegUnpack(Buf, OutData%TwrBaseRefOrient) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrBaseOrient + call RegUnpack(Buf, OutData%TwrBaseOrient) + if (RegCheckErr(Buf, RoutineName)) return + ! HubRad + call RegUnpack(Buf, OutData%HubRad) + if (RegCheckErr(Buf, RoutineName)) return + ! RotSpeed + call RegUnpack(Buf, OutData%RotSpeed) + if (RegCheckErr(Buf, RoutineName)) return + ! isFixed_GenDOF + call RegUnpack(Buf, OutData%isFixed_GenDOF) + if (RegCheckErr(Buf, RoutineName)) return + ! LinNames_y + if (allocated(OutData%LinNames_y)) deallocate(OutData%LinNames_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LinNames_x + if (allocated(OutData%LinNames_x)) deallocate(OutData%LinNames_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LinNames_u + if (allocated(OutData%LinNames_u)) deallocate(OutData%LinNames_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RotFrame_y + if (allocated(OutData%RotFrame_y)) deallocate(OutData%RotFrame_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RotFrame_x + if (allocated(OutData%RotFrame_x)) deallocate(OutData%RotFrame_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! DerivOrder_x + if (allocated(OutData%DerivOrder_x)) deallocate(OutData%DerivOrder_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DerivOrder_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DerivOrder_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RotFrame_u + if (allocated(OutData%RotFrame_u)) deallocate(OutData%RotFrame_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! IsLoad_u + if (allocated(OutData%IsLoad_u)) deallocate(OutData%IsLoad_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IsLoad_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IsLoad_u) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE ED_CopyBladeInputData( SrcBladeInputDataData, DstBladeInputDataData, CtrlCode, ErrStat, ErrMsg ) TYPE(BladeInputData), INTENT(IN) :: SrcBladeInputDataData TYPE(BladeInputData), INTENT(INOUT) :: DstBladeInputDataData @@ -2215,479 +1718,245 @@ SUBROUTINE ED_DestroyBladeInputData( BladeInputDataData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE ED_DestroyBladeInputData - SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(BladeInputData), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_PackBladeInputData' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! NBlInpSt - Int_BufSz = Int_BufSz + 1 ! BlFract allocated yes/no - IF ( ALLOCATED(InData%BlFract) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlFract upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlFract) ! BlFract - END IF - Int_BufSz = Int_BufSz + 1 ! PitchAx allocated yes/no - IF ( ALLOCATED(InData%PitchAx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PitchAx upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PitchAx) ! PitchAx - END IF - Int_BufSz = Int_BufSz + 1 ! StrcTwst allocated yes/no - IF ( ALLOCATED(InData%StrcTwst) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! StrcTwst upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StrcTwst) ! StrcTwst - END IF - Int_BufSz = Int_BufSz + 1 ! BMassDen allocated yes/no - IF ( ALLOCATED(InData%BMassDen) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BMassDen upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BMassDen) ! BMassDen - END IF - Int_BufSz = Int_BufSz + 1 ! FlpStff allocated yes/no - IF ( ALLOCATED(InData%FlpStff) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FlpStff upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FlpStff) ! FlpStff - END IF - Int_BufSz = Int_BufSz + 1 ! EdgStff allocated yes/no - IF ( ALLOCATED(InData%EdgStff) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! EdgStff upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%EdgStff) ! EdgStff - END IF - Re_BufSz = Re_BufSz + SIZE(InData%BldFlDmp) ! BldFlDmp - Re_BufSz = Re_BufSz + SIZE(InData%BldEdDmp) ! BldEdDmp - Re_BufSz = Re_BufSz + SIZE(InData%FlStTunr) ! FlStTunr - Int_BufSz = Int_BufSz + 1 ! BldFl1Sh allocated yes/no - IF ( ALLOCATED(InData%BldFl1Sh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BldFl1Sh upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BldFl1Sh) ! BldFl1Sh - END IF - Int_BufSz = Int_BufSz + 1 ! BldFl2Sh allocated yes/no - IF ( ALLOCATED(InData%BldFl2Sh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BldFl2Sh upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BldFl2Sh) ! BldFl2Sh - END IF - Int_BufSz = Int_BufSz + 1 ! BldEdgSh allocated yes/no - IF ( ALLOCATED(InData%BldEdgSh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BldEdgSh upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BldEdgSh) ! BldEdgSh - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%NBlInpSt - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BlFract) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlFract,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlFract,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlFract,1), UBOUND(InData%BlFract,1) - ReKiBuf(Re_Xferred) = InData%BlFract(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PitchAx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PitchAx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PitchAx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PitchAx,1), UBOUND(InData%PitchAx,1) - ReKiBuf(Re_Xferred) = InData%PitchAx(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StrcTwst) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StrcTwst,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StrcTwst,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%StrcTwst,1), UBOUND(InData%StrcTwst,1) - ReKiBuf(Re_Xferred) = InData%StrcTwst(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BMassDen) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BMassDen,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BMassDen,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BMassDen,1), UBOUND(InData%BMassDen,1) - ReKiBuf(Re_Xferred) = InData%BMassDen(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FlpStff) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FlpStff,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FlpStff,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FlpStff,1), UBOUND(InData%FlpStff,1) - ReKiBuf(Re_Xferred) = InData%FlpStff(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%EdgStff) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%EdgStff,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EdgStff,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%EdgStff,1), UBOUND(InData%EdgStff,1) - ReKiBuf(Re_Xferred) = InData%EdgStff(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DO i1 = LBOUND(InData%BldFlDmp,1), UBOUND(InData%BldFlDmp,1) - ReKiBuf(Re_Xferred) = InData%BldFlDmp(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%BldEdDmp,1), UBOUND(InData%BldEdDmp,1) - ReKiBuf(Re_Xferred) = InData%BldEdDmp(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%FlStTunr,1), UBOUND(InData%FlStTunr,1) - ReKiBuf(Re_Xferred) = InData%FlStTunr(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%BldFl1Sh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldFl1Sh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldFl1Sh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BldFl1Sh,1), UBOUND(InData%BldFl1Sh,1) - ReKiBuf(Re_Xferred) = InData%BldFl1Sh(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BldFl2Sh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldFl2Sh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldFl2Sh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BldFl2Sh,1), UBOUND(InData%BldFl2Sh,1) - ReKiBuf(Re_Xferred) = InData%BldFl2Sh(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BldEdgSh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldEdgSh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldEdgSh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BldEdgSh,1), UBOUND(InData%BldEdgSh,1) - ReKiBuf(Re_Xferred) = InData%BldEdgSh(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE ED_PackBladeInputData - - SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(BladeInputData), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_UnPackBladeInputData' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%NBlInpSt = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlFract not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlFract)) DEALLOCATE(OutData%BlFract) - ALLOCATE(OutData%BlFract(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlFract.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlFract,1), UBOUND(OutData%BlFract,1) - OutData%BlFract(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PitchAx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PitchAx)) DEALLOCATE(OutData%PitchAx) - ALLOCATE(OutData%PitchAx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PitchAx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PitchAx,1), UBOUND(OutData%PitchAx,1) - OutData%PitchAx(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StrcTwst not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%StrcTwst)) DEALLOCATE(OutData%StrcTwst) - ALLOCATE(OutData%StrcTwst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StrcTwst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%StrcTwst,1), UBOUND(OutData%StrcTwst,1) - OutData%StrcTwst(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BMassDen not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BMassDen)) DEALLOCATE(OutData%BMassDen) - ALLOCATE(OutData%BMassDen(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BMassDen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BMassDen,1), UBOUND(OutData%BMassDen,1) - OutData%BMassDen(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FlpStff not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FlpStff)) DEALLOCATE(OutData%FlpStff) - ALLOCATE(OutData%FlpStff(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlpStff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FlpStff,1), UBOUND(OutData%FlpStff,1) - OutData%FlpStff(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! EdgStff not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%EdgStff)) DEALLOCATE(OutData%EdgStff) - ALLOCATE(OutData%EdgStff(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%EdgStff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%EdgStff,1), UBOUND(OutData%EdgStff,1) - OutData%EdgStff(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - i1_l = LBOUND(OutData%BldFlDmp,1) - i1_u = UBOUND(OutData%BldFlDmp,1) - DO i1 = LBOUND(OutData%BldFlDmp,1), UBOUND(OutData%BldFlDmp,1) - OutData%BldFlDmp(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%BldEdDmp,1) - i1_u = UBOUND(OutData%BldEdDmp,1) - DO i1 = LBOUND(OutData%BldEdDmp,1), UBOUND(OutData%BldEdDmp,1) - OutData%BldEdDmp(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%FlStTunr,1) - i1_u = UBOUND(OutData%FlStTunr,1) - DO i1 = LBOUND(OutData%FlStTunr,1), UBOUND(OutData%FlStTunr,1) - OutData%FlStTunr(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldFl1Sh not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BldFl1Sh)) DEALLOCATE(OutData%BldFl1Sh) - ALLOCATE(OutData%BldFl1Sh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldFl1Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BldFl1Sh,1), UBOUND(OutData%BldFl1Sh,1) - OutData%BldFl1Sh(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldFl2Sh not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BldFl2Sh)) DEALLOCATE(OutData%BldFl2Sh) - ALLOCATE(OutData%BldFl2Sh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldFl2Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BldFl2Sh,1), UBOUND(OutData%BldFl2Sh,1) - OutData%BldFl2Sh(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldEdgSh not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BldEdgSh)) DEALLOCATE(OutData%BldEdgSh) - ALLOCATE(OutData%BldEdgSh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldEdgSh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BldEdgSh,1), UBOUND(OutData%BldEdgSh,1) - OutData%BldEdgSh(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE ED_UnPackBladeInputData +subroutine ED_PackBladeInputData(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BladeInputData), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackBladeInputData' + if (Buf%ErrStat >= AbortErrLev) return + ! NBlInpSt + call RegPack(Buf, InData%NBlInpSt) + if (RegCheckErr(Buf, RoutineName)) return + ! BlFract + call RegPack(Buf, allocated(InData%BlFract)) + if (allocated(InData%BlFract)) then + call RegPackBounds(Buf, 1, lbound(InData%BlFract), ubound(InData%BlFract)) + call RegPack(Buf, InData%BlFract) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PitchAx + call RegPack(Buf, allocated(InData%PitchAx)) + if (allocated(InData%PitchAx)) then + call RegPackBounds(Buf, 1, lbound(InData%PitchAx), ubound(InData%PitchAx)) + call RegPack(Buf, InData%PitchAx) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! StrcTwst + call RegPack(Buf, allocated(InData%StrcTwst)) + if (allocated(InData%StrcTwst)) then + call RegPackBounds(Buf, 1, lbound(InData%StrcTwst), ubound(InData%StrcTwst)) + call RegPack(Buf, InData%StrcTwst) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BMassDen + call RegPack(Buf, allocated(InData%BMassDen)) + if (allocated(InData%BMassDen)) then + call RegPackBounds(Buf, 1, lbound(InData%BMassDen), ubound(InData%BMassDen)) + call RegPack(Buf, InData%BMassDen) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FlpStff + call RegPack(Buf, allocated(InData%FlpStff)) + if (allocated(InData%FlpStff)) then + call RegPackBounds(Buf, 1, lbound(InData%FlpStff), ubound(InData%FlpStff)) + call RegPack(Buf, InData%FlpStff) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! EdgStff + call RegPack(Buf, allocated(InData%EdgStff)) + if (allocated(InData%EdgStff)) then + call RegPackBounds(Buf, 1, lbound(InData%EdgStff), ubound(InData%EdgStff)) + call RegPack(Buf, InData%EdgStff) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BldFlDmp + call RegPack(Buf, InData%BldFlDmp) + if (RegCheckErr(Buf, RoutineName)) return + ! BldEdDmp + call RegPack(Buf, InData%BldEdDmp) + if (RegCheckErr(Buf, RoutineName)) return + ! FlStTunr + call RegPack(Buf, InData%FlStTunr) + if (RegCheckErr(Buf, RoutineName)) return + ! BldFl1Sh + call RegPack(Buf, allocated(InData%BldFl1Sh)) + if (allocated(InData%BldFl1Sh)) then + call RegPackBounds(Buf, 1, lbound(InData%BldFl1Sh), ubound(InData%BldFl1Sh)) + call RegPack(Buf, InData%BldFl1Sh) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BldFl2Sh + call RegPack(Buf, allocated(InData%BldFl2Sh)) + if (allocated(InData%BldFl2Sh)) then + call RegPackBounds(Buf, 1, lbound(InData%BldFl2Sh), ubound(InData%BldFl2Sh)) + call RegPack(Buf, InData%BldFl2Sh) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BldEdgSh + call RegPack(Buf, allocated(InData%BldEdgSh)) + if (allocated(InData%BldEdgSh)) then + call RegPackBounds(Buf, 1, lbound(InData%BldEdgSh), ubound(InData%BldEdgSh)) + call RegPack(Buf, InData%BldEdgSh) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ED_UnPackBladeInputData(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BladeInputData), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackBladeInputData' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! NBlInpSt + call RegUnpack(Buf, OutData%NBlInpSt) + if (RegCheckErr(Buf, RoutineName)) return + ! BlFract + if (allocated(OutData%BlFract)) deallocate(OutData%BlFract) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlFract(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlFract.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlFract) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PitchAx + if (allocated(OutData%PitchAx)) deallocate(OutData%PitchAx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PitchAx(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PitchAx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PitchAx) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! StrcTwst + if (allocated(OutData%StrcTwst)) deallocate(OutData%StrcTwst) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StrcTwst(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StrcTwst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StrcTwst) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BMassDen + if (allocated(OutData%BMassDen)) deallocate(OutData%BMassDen) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BMassDen(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BMassDen.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BMassDen) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! FlpStff + if (allocated(OutData%FlpStff)) deallocate(OutData%FlpStff) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FlpStff(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlpStff.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FlpStff) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! EdgStff + if (allocated(OutData%EdgStff)) deallocate(OutData%EdgStff) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%EdgStff(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%EdgStff.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%EdgStff) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BldFlDmp + call RegUnpack(Buf, OutData%BldFlDmp) + if (RegCheckErr(Buf, RoutineName)) return + ! BldEdDmp + call RegUnpack(Buf, OutData%BldEdDmp) + if (RegCheckErr(Buf, RoutineName)) return + ! FlStTunr + call RegUnpack(Buf, OutData%FlStTunr) + if (RegCheckErr(Buf, RoutineName)) return + ! BldFl1Sh + if (allocated(OutData%BldFl1Sh)) deallocate(OutData%BldFl1Sh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BldFl1Sh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldFl1Sh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BldFl1Sh) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BldFl2Sh + if (allocated(OutData%BldFl2Sh)) deallocate(OutData%BldFl2Sh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BldFl2Sh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldFl2Sh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BldFl2Sh) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BldEdgSh + if (allocated(OutData%BldEdgSh)) deallocate(OutData%BldEdgSh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BldEdgSh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldEdgSh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BldEdgSh) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE ED_CopyBladeMeshInputData( SrcBladeMeshInputDataData, DstBladeMeshInputDataData, CtrlCode, ErrStat, ErrMsg ) TYPE(ED_BladeMeshInputData), INTENT(IN) :: SrcBladeMeshInputDataData TYPE(ED_BladeMeshInputData), INTENT(INOUT) :: DstBladeMeshInputDataData @@ -2766,218 +2035,95 @@ SUBROUTINE ED_DestroyBladeMeshInputData( BladeMeshInputDataData, ErrStat, ErrMsg ENDIF END SUBROUTINE ED_DestroyBladeMeshInputData - SUBROUTINE ED_PackBladeMeshInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ED_BladeMeshInputData), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_PackBladeMeshInputData' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! BldNodes - Int_BufSz = Int_BufSz + 1 ! RNodes allocated yes/no - IF ( ALLOCATED(InData%RNodes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RNodes upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%RNodes) ! RNodes - END IF - Int_BufSz = Int_BufSz + 1 ! AeroTwst allocated yes/no - IF ( ALLOCATED(InData%AeroTwst) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AeroTwst upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AeroTwst) ! AeroTwst - END IF - Int_BufSz = Int_BufSz + 1 ! Chord allocated yes/no - IF ( ALLOCATED(InData%Chord) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Chord upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Chord) ! Chord - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%BldNodes - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%RNodes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RNodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RNodes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RNodes,1), UBOUND(InData%RNodes,1) - ReKiBuf(Re_Xferred) = InData%RNodes(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AeroTwst) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AeroTwst,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AeroTwst,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AeroTwst,1), UBOUND(InData%AeroTwst,1) - ReKiBuf(Re_Xferred) = InData%AeroTwst(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Chord) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Chord,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Chord,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Chord,1), UBOUND(InData%Chord,1) - ReKiBuf(Re_Xferred) = InData%Chord(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE ED_PackBladeMeshInputData - - SUBROUTINE ED_UnPackBladeMeshInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ED_BladeMeshInputData), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_UnPackBladeMeshInputData' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%BldNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RNodes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RNodes)) DEALLOCATE(OutData%RNodes) - ALLOCATE(OutData%RNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RNodes,1), UBOUND(OutData%RNodes,1) - OutData%RNodes(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AeroTwst not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AeroTwst)) DEALLOCATE(OutData%AeroTwst) - ALLOCATE(OutData%AeroTwst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AeroTwst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AeroTwst,1), UBOUND(OutData%AeroTwst,1) - OutData%AeroTwst(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Chord not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Chord)) DEALLOCATE(OutData%Chord) - ALLOCATE(OutData%Chord(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Chord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Chord,1), UBOUND(OutData%Chord,1) - OutData%Chord(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE ED_UnPackBladeMeshInputData +subroutine ED_PackBladeMeshInputData(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ED_BladeMeshInputData), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackBladeMeshInputData' + if (Buf%ErrStat >= AbortErrLev) return + ! BldNodes + call RegPack(Buf, InData%BldNodes) + if (RegCheckErr(Buf, RoutineName)) return + ! RNodes + call RegPack(Buf, allocated(InData%RNodes)) + if (allocated(InData%RNodes)) then + call RegPackBounds(Buf, 1, lbound(InData%RNodes), ubound(InData%RNodes)) + call RegPack(Buf, InData%RNodes) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AeroTwst + call RegPack(Buf, allocated(InData%AeroTwst)) + if (allocated(InData%AeroTwst)) then + call RegPackBounds(Buf, 1, lbound(InData%AeroTwst), ubound(InData%AeroTwst)) + call RegPack(Buf, InData%AeroTwst) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Chord + call RegPack(Buf, allocated(InData%Chord)) + if (allocated(InData%Chord)) then + call RegPackBounds(Buf, 1, lbound(InData%Chord), ubound(InData%Chord)) + call RegPack(Buf, InData%Chord) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ED_UnPackBladeMeshInputData(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ED_BladeMeshInputData), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackBladeMeshInputData' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! BldNodes + call RegUnpack(Buf, OutData%BldNodes) + if (RegCheckErr(Buf, RoutineName)) return + ! RNodes + if (allocated(OutData%RNodes)) deallocate(OutData%RNodes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RNodes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RNodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RNodes) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AeroTwst + if (allocated(OutData%AeroTwst)) deallocate(OutData%AeroTwst) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AeroTwst(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AeroTwst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AeroTwst) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Chord + if (allocated(OutData%Chord)) deallocate(OutData%Chord) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Chord(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Chord.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Chord) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE ED_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) TYPE(ED_InputFile), INTENT(IN) :: SrcInputFileData TYPE(ED_InputFile), INTENT(INOUT) :: DstInputFileData @@ -3393,1626 +2539,1218 @@ SUBROUTINE ED_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE ED_DestroyInputFile - SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ED_InputFile), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_PackInputFile' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! DT - Int_BufSz = Int_BufSz + 1 ! FlapDOF1 - Int_BufSz = Int_BufSz + 1 ! FlapDOF2 - Int_BufSz = Int_BufSz + 1 ! EdgeDOF - Int_BufSz = Int_BufSz + 1 ! TeetDOF - Int_BufSz = Int_BufSz + 1 ! DrTrDOF - Int_BufSz = Int_BufSz + 1 ! GenDOF - Int_BufSz = Int_BufSz + 1 ! YawDOF - Int_BufSz = Int_BufSz + 1 ! TwFADOF1 - Int_BufSz = Int_BufSz + 1 ! TwFADOF2 - Int_BufSz = Int_BufSz + 1 ! TwSSDOF1 - Int_BufSz = Int_BufSz + 1 ! TwSSDOF2 - Int_BufSz = Int_BufSz + 1 ! PtfmSgDOF - Int_BufSz = Int_BufSz + 1 ! PtfmSwDOF - Int_BufSz = Int_BufSz + 1 ! PtfmHvDOF - Int_BufSz = Int_BufSz + 1 ! PtfmRDOF - Int_BufSz = Int_BufSz + 1 ! PtfmPDOF - Int_BufSz = Int_BufSz + 1 ! PtfmYDOF - Re_BufSz = Re_BufSz + 1 ! OoPDefl - Re_BufSz = Re_BufSz + 1 ! IPDefl - Int_BufSz = Int_BufSz + 1 ! BlPitch allocated yes/no - IF ( ALLOCATED(InData%BlPitch) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlPitch upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlPitch) ! BlPitch - END IF - Re_BufSz = Re_BufSz + 1 ! TeetDefl - Db_BufSz = Db_BufSz + 1 ! Azimuth - Re_BufSz = Re_BufSz + 1 ! RotSpeed - Re_BufSz = Re_BufSz + 1 ! NacYaw - Re_BufSz = Re_BufSz + 1 ! TTDspFA - Re_BufSz = Re_BufSz + 1 ! TTDspSS - Re_BufSz = Re_BufSz + 1 ! PtfmSurge - Re_BufSz = Re_BufSz + 1 ! PtfmSway - Re_BufSz = Re_BufSz + 1 ! PtfmHeave - Re_BufSz = Re_BufSz + 1 ! PtfmRoll - Re_BufSz = Re_BufSz + 1 ! PtfmPitch - Re_BufSz = Re_BufSz + 1 ! PtfmYaw - Int_BufSz = Int_BufSz + 1 ! NumBl - Re_BufSz = Re_BufSz + 1 ! TipRad - Re_BufSz = Re_BufSz + 1 ! HubRad - Int_BufSz = Int_BufSz + 1 ! PreCone allocated yes/no - IF ( ALLOCATED(InData%PreCone) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PreCone upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PreCone) ! PreCone - END IF - Re_BufSz = Re_BufSz + 1 ! HubCM - Re_BufSz = Re_BufSz + 1 ! UndSling - Re_BufSz = Re_BufSz + 1 ! Delta3 - Db_BufSz = Db_BufSz + 1 ! AzimB1Up - Re_BufSz = Re_BufSz + 1 ! OverHang - Re_BufSz = Re_BufSz + 1 ! ShftGagL - Re_BufSz = Re_BufSz + 1 ! ShftTilt - Re_BufSz = Re_BufSz + 1 ! NacCMxn - Re_BufSz = Re_BufSz + 1 ! NacCMyn - Re_BufSz = Re_BufSz + 1 ! NacCMzn - Re_BufSz = Re_BufSz + 1 ! NcIMUxn - Re_BufSz = Re_BufSz + 1 ! NcIMUyn - Re_BufSz = Re_BufSz + 1 ! NcIMUzn - Re_BufSz = Re_BufSz + 1 ! Twr2Shft - Re_BufSz = Re_BufSz + 1 ! TowerHt - Re_BufSz = Re_BufSz + 1 ! TowerBsHt - Re_BufSz = Re_BufSz + 1 ! PtfmCMxt - Re_BufSz = Re_BufSz + 1 ! PtfmCMyt - Re_BufSz = Re_BufSz + 1 ! PtfmCMzt - Re_BufSz = Re_BufSz + 1 ! PtfmRefzt - Int_BufSz = Int_BufSz + 1 ! TipMass allocated yes/no - IF ( ALLOCATED(InData%TipMass) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TipMass upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TipMass) ! TipMass - END IF - Re_BufSz = Re_BufSz + 1 ! HubMass - Re_BufSz = Re_BufSz + 1 ! HubIner - Re_BufSz = Re_BufSz + 1 ! GenIner - Re_BufSz = Re_BufSz + 1 ! NacMass - Re_BufSz = Re_BufSz + 1 ! NacYIner - Re_BufSz = Re_BufSz + 1 ! YawBrMass - Re_BufSz = Re_BufSz + 1 ! PtfmMass - Re_BufSz = Re_BufSz + 1 ! PtfmRIner - Re_BufSz = Re_BufSz + 1 ! PtfmPIner - Re_BufSz = Re_BufSz + 1 ! PtfmYIner - Re_BufSz = Re_BufSz + 1 ! BldNodes - Int_BufSz = Int_BufSz + 1 ! InpBlMesh allocated yes/no - IF ( ALLOCATED(InData%InpBlMesh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InpBlMesh upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%InpBlMesh,1), UBOUND(InData%InpBlMesh,1) - Int_BufSz = Int_BufSz + 3 ! InpBlMesh: size of buffers for each call to pack subtype - CALL ED_PackBladeMeshInputData( Re_Buf, Db_Buf, Int_Buf, InData%InpBlMesh(i1), ErrStat2, ErrMsg2, .TRUE. ) ! InpBlMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InpBlMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InpBlMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InpBlMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InpBl allocated yes/no - IF ( ALLOCATED(InData%InpBl) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InpBl upper/lower bounds for each dimension - DO i1 = LBOUND(InData%InpBl,1), UBOUND(InData%InpBl,1) - Int_BufSz = Int_BufSz + 3 ! InpBl: size of buffers for each call to pack subtype - CALL ED_PackBladeInputData( Re_Buf, Db_Buf, Int_Buf, InData%InpBl(i1), ErrStat2, ErrMsg2, .TRUE. ) ! InpBl - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InpBl - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InpBl - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InpBl - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! TeetMod - Re_BufSz = Re_BufSz + 1 ! TeetDmpP - Re_BufSz = Re_BufSz + 1 ! TeetDmp - Re_BufSz = Re_BufSz + 1 ! TeetCDmp - Re_BufSz = Re_BufSz + 1 ! TeetSStP - Re_BufSz = Re_BufSz + 1 ! TeetHStP - Re_BufSz = Re_BufSz + 1 ! TeetSSSp - Re_BufSz = Re_BufSz + 1 ! TeetHSSp - Re_BufSz = Re_BufSz + 1 ! GBoxEff - Re_BufSz = Re_BufSz + 1 ! GBRatio - Re_BufSz = Re_BufSz + 1 ! DTTorSpr - Re_BufSz = Re_BufSz + 1 ! DTTorDmp - Int_BufSz = Int_BufSz + 1 ! Furling - Int_BufSz = Int_BufSz + 1 ! TwrNodes - Int_BufSz = Int_BufSz + 1 ! SumPrint - Int_BufSz = Int_BufSz + 1 ! OutFile - Int_BufSz = Int_BufSz + 1 ! TabDelim - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt - Db_BufSz = Db_BufSz + 1 ! Tstart - Int_BufSz = Int_BufSz + 1 ! DecFact - Int_BufSz = Int_BufSz + 1 ! NTwGages - Int_BufSz = Int_BufSz + SIZE(InData%TwrGagNd) ! TwrGagNd - Int_BufSz = Int_BufSz + 1 ! NBlGages - Int_BufSz = Int_BufSz + SIZE(InData%BldGagNd) ! BldGagNd - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! OutList allocated yes/no - IF ( ALLOCATED(InData%OutList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%OutList)*LEN(InData%OutList) ! OutList - END IF - Int_BufSz = Int_BufSz + 1 ! NTwInpSt - Re_BufSz = Re_BufSz + SIZE(InData%TwrFADmp) ! TwrFADmp - Re_BufSz = Re_BufSz + SIZE(InData%TwrSSDmp) ! TwrSSDmp - Re_BufSz = Re_BufSz + SIZE(InData%FAStTunr) ! FAStTunr - Re_BufSz = Re_BufSz + SIZE(InData%SSStTunr) ! SSStTunr - Int_BufSz = Int_BufSz + 1 ! HtFract allocated yes/no - IF ( ALLOCATED(InData%HtFract) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! HtFract upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%HtFract) ! HtFract - END IF - Int_BufSz = Int_BufSz + 1 ! TMassDen allocated yes/no - IF ( ALLOCATED(InData%TMassDen) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TMassDen upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TMassDen) ! TMassDen - END IF - Int_BufSz = Int_BufSz + 1 ! TwFAStif allocated yes/no - IF ( ALLOCATED(InData%TwFAStif) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwFAStif upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwFAStif) ! TwFAStif - END IF - Int_BufSz = Int_BufSz + 1 ! TwSSStif allocated yes/no - IF ( ALLOCATED(InData%TwSSStif) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwSSStif upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwSSStif) ! TwSSStif - END IF - Int_BufSz = Int_BufSz + 1 ! TwFAM1Sh allocated yes/no - IF ( ALLOCATED(InData%TwFAM1Sh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwFAM1Sh upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwFAM1Sh) ! TwFAM1Sh - END IF - Int_BufSz = Int_BufSz + 1 ! TwFAM2Sh allocated yes/no - IF ( ALLOCATED(InData%TwFAM2Sh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwFAM2Sh upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwFAM2Sh) ! TwFAM2Sh - END IF - Int_BufSz = Int_BufSz + 1 ! TwSSM1Sh allocated yes/no - IF ( ALLOCATED(InData%TwSSM1Sh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwSSM1Sh upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwSSM1Sh) ! TwSSM1Sh - END IF - Int_BufSz = Int_BufSz + 1 ! TwSSM2Sh allocated yes/no - IF ( ALLOCATED(InData%TwSSM2Sh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TwSSM2Sh upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwSSM2Sh) ! TwSSM2Sh - END IF - Int_BufSz = Int_BufSz + 1 ! RFrlDOF - Int_BufSz = Int_BufSz + 1 ! TFrlDOF - Re_BufSz = Re_BufSz + 1 ! RotFurl - Re_BufSz = Re_BufSz + 1 ! TailFurl - Re_BufSz = Re_BufSz + 1 ! Yaw2Shft - Re_BufSz = Re_BufSz + 1 ! ShftSkew - Re_BufSz = Re_BufSz + SIZE(InData%RFrlCM_n) ! RFrlCM_n - Re_BufSz = Re_BufSz + SIZE(InData%BoomCM_n) ! BoomCM_n - Re_BufSz = Re_BufSz + SIZE(InData%TFinCM_n) ! TFinCM_n - Re_BufSz = Re_BufSz + SIZE(InData%RFrlPnt_n) ! RFrlPnt_n - Re_BufSz = Re_BufSz + 1 ! RFrlSkew - Re_BufSz = Re_BufSz + 1 ! RFrlTilt - Re_BufSz = Re_BufSz + SIZE(InData%TFrlPnt_n) ! TFrlPnt_n - Re_BufSz = Re_BufSz + 1 ! TFrlSkew - Re_BufSz = Re_BufSz + 1 ! TFrlTilt - Re_BufSz = Re_BufSz + 1 ! RFrlMass - Re_BufSz = Re_BufSz + 1 ! BoomMass - Re_BufSz = Re_BufSz + 1 ! TFinMass - Re_BufSz = Re_BufSz + 1 ! RFrlIner - Re_BufSz = Re_BufSz + 1 ! TFrlIner - Int_BufSz = Int_BufSz + 1 ! RFrlMod - Re_BufSz = Re_BufSz + 1 ! RFrlSpr - Re_BufSz = Re_BufSz + 1 ! RFrlDmp - Re_BufSz = Re_BufSz + 1 ! RFrlUSSP - Re_BufSz = Re_BufSz + 1 ! RFrlDSSP - Re_BufSz = Re_BufSz + 1 ! RFrlUSSpr - Re_BufSz = Re_BufSz + 1 ! RFrlDSSpr - Re_BufSz = Re_BufSz + 1 ! RFrlUSDP - Re_BufSz = Re_BufSz + 1 ! RFrlDSDP - Re_BufSz = Re_BufSz + 1 ! RFrlUSDmp - Re_BufSz = Re_BufSz + 1 ! RFrlDSDmp - Int_BufSz = Int_BufSz + 1 ! TFrlMod - Re_BufSz = Re_BufSz + 1 ! TFrlSpr - Re_BufSz = Re_BufSz + 1 ! TFrlDmp - Re_BufSz = Re_BufSz + 1 ! TFrlUSSP - Re_BufSz = Re_BufSz + 1 ! TFrlDSSP - Re_BufSz = Re_BufSz + 1 ! TFrlUSSpr - Re_BufSz = Re_BufSz + 1 ! TFrlDSSpr - Re_BufSz = Re_BufSz + 1 ! TFrlUSDP - Re_BufSz = Re_BufSz + 1 ! TFrlDSDP - Re_BufSz = Re_BufSz + 1 ! TFrlUSDmp - Re_BufSz = Re_BufSz + 1 ! TFrlDSDmp - Int_BufSz = Int_BufSz + 1 ! method - Int_BufSz = Int_BufSz + 1 ! BldNd_NumOuts - Int_BufSz = Int_BufSz + 1 ! BldNd_OutList allocated yes/no - IF ( ALLOCATED(InData%BldNd_OutList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BldNd_OutList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BldNd_OutList)*LEN(InData%BldNd_OutList) ! BldNd_OutList - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%BldNd_BlOutNd_Str) ! BldNd_BlOutNd_Str - Int_BufSz = Int_BufSz + 1 ! BldNd_BladesOut - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FlapDOF1, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FlapDOF2, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%EdgeDOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TeetDOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%DrTrDOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%GenDOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%YawDOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TwFADOF1, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TwFADOF2, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TwSSDOF1, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TwSSDOF2, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmSgDOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmSwDOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmHvDOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmRDOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmPDOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmYDOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%OoPDefl - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%IPDefl - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BlPitch) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlPitch,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitch,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlPitch,1), UBOUND(InData%BlPitch,1) - ReKiBuf(Re_Xferred) = InData%BlPitch(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%TeetDefl - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Azimuth - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RotSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NacYaw - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TTDspFA - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TTDspSS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmSurge - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmSway - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmHeave - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmRoll - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmPitch - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmYaw - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBl - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TipRad - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubRad - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%PreCone) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PreCone,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PreCone,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PreCone,1), UBOUND(InData%PreCone,1) - ReKiBuf(Re_Xferred) = InData%PreCone(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%HubCM - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%UndSling - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Delta3 - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%AzimB1Up - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%OverHang - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ShftGagL - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ShftTilt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NacCMxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NacCMyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NacCMzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NcIMUxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NcIMUyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NcIMUzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Twr2Shft - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TowerHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TowerBsHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmCMxt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmCMyt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmCMzt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmRefzt - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TipMass) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TipMass,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TipMass,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TipMass,1), UBOUND(InData%TipMass,1) - ReKiBuf(Re_Xferred) = InData%TipMass(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%HubMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NacMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NacYIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawBrMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmRIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmPIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmYIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%BldNodes - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%InpBlMesh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InpBlMesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InpBlMesh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InpBlMesh,1), UBOUND(InData%InpBlMesh,1) - CALL ED_PackBladeMeshInputData( Re_Buf, Db_Buf, Int_Buf, InData%InpBlMesh(i1), ErrStat2, ErrMsg2, OnlySize ) ! InpBlMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InpBl) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InpBl,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InpBl,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InpBl,1), UBOUND(InData%InpBl,1) - CALL ED_PackBladeInputData( Re_Buf, Db_Buf, Int_Buf, InData%InpBl(i1), ErrStat2, ErrMsg2, OnlySize ) ! InpBl - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IntKiBuf(Int_Xferred) = InData%TeetMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TeetDmpP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TeetDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TeetCDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TeetSStP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TeetHStP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TeetSSSp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TeetHSSp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GBoxEff - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GBRatio - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DTTorSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DTTorDmp - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Furling, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TwrNodes - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%OutFile - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TabDelim, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf(Db_Xferred) = InData%Tstart - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%DecFact - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NTwGages - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%TwrGagNd,1), UBOUND(InData%TwrGagNd,1) - IntKiBuf(Int_Xferred) = InData%TwrGagNd(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%NBlGages - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%BldGagNd,1), UBOUND(InData%BldGagNd,1) - IntKiBuf(Int_Xferred) = InData%BldGagNd(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) - DO I = 1, LEN(InData%OutList) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NTwInpSt - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%TwrFADmp,1), UBOUND(InData%TwrFADmp,1) - ReKiBuf(Re_Xferred) = InData%TwrFADmp(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TwrSSDmp,1), UBOUND(InData%TwrSSDmp,1) - ReKiBuf(Re_Xferred) = InData%TwrSSDmp(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%FAStTunr,1), UBOUND(InData%FAStTunr,1) - ReKiBuf(Re_Xferred) = InData%FAStTunr(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%SSStTunr,1), UBOUND(InData%SSStTunr,1) - ReKiBuf(Re_Xferred) = InData%SSStTunr(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%HtFract) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%HtFract,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HtFract,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%HtFract,1), UBOUND(InData%HtFract,1) - ReKiBuf(Re_Xferred) = InData%HtFract(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TMassDen) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TMassDen,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TMassDen,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TMassDen,1), UBOUND(InData%TMassDen,1) - ReKiBuf(Re_Xferred) = InData%TMassDen(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwFAStif) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwFAStif,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwFAStif,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwFAStif,1), UBOUND(InData%TwFAStif,1) - ReKiBuf(Re_Xferred) = InData%TwFAStif(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwSSStif) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwSSStif,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwSSStif,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwSSStif,1), UBOUND(InData%TwSSStif,1) - ReKiBuf(Re_Xferred) = InData%TwSSStif(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwFAM1Sh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwFAM1Sh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwFAM1Sh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwFAM1Sh,1), UBOUND(InData%TwFAM1Sh,1) - ReKiBuf(Re_Xferred) = InData%TwFAM1Sh(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwFAM2Sh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwFAM2Sh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwFAM2Sh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwFAM2Sh,1), UBOUND(InData%TwFAM2Sh,1) - ReKiBuf(Re_Xferred) = InData%TwFAM2Sh(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwSSM1Sh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwSSM1Sh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwSSM1Sh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwSSM1Sh,1), UBOUND(InData%TwSSM1Sh,1) - ReKiBuf(Re_Xferred) = InData%TwSSM1Sh(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwSSM2Sh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwSSM2Sh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwSSM2Sh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TwSSM2Sh,1), UBOUND(InData%TwSSM2Sh,1) - ReKiBuf(Re_Xferred) = InData%TwSSM2Sh(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%RFrlDOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TFrlDOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RotFurl - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TailFurl - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Yaw2Shft - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ShftSkew - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%RFrlCM_n,1), UBOUND(InData%RFrlCM_n,1) - ReKiBuf(Re_Xferred) = InData%RFrlCM_n(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%BoomCM_n,1), UBOUND(InData%BoomCM_n,1) - ReKiBuf(Re_Xferred) = InData%BoomCM_n(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TFinCM_n,1), UBOUND(InData%TFinCM_n,1) - ReKiBuf(Re_Xferred) = InData%TFinCM_n(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%RFrlPnt_n,1), UBOUND(InData%RFrlPnt_n,1) - ReKiBuf(Re_Xferred) = InData%RFrlPnt_n(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%RFrlSkew - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlTilt - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%TFrlPnt_n,1), UBOUND(InData%TFrlPnt_n,1) - ReKiBuf(Re_Xferred) = InData%TFrlPnt_n(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%TFrlSkew - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlTilt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%BoomMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFinMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlIner - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%RFrlMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlUSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlDSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlUSSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlDSSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlUSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlDSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlUSDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlDSDmp - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TFrlMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlUSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlDSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlUSSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlDSSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlUSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlDSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlUSDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlDSDmp - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%method - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%BldNd_NumOuts - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BldNd_OutList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldNd_OutList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_OutList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BldNd_OutList,1), UBOUND(InData%BldNd_OutList,1) - DO I = 1, LEN(InData%BldNd_OutList) - IntKiBuf(Int_Xferred) = ICHAR(InData%BldNd_OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - DO I = 1, LEN(InData%BldNd_BlOutNd_Str) - IntKiBuf(Int_Xferred) = ICHAR(InData%BldNd_BlOutNd_Str(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%BldNd_BladesOut - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE ED_PackInputFile - - SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ED_InputFile), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_UnPackInputFile' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%FlapDOF1 = TRANSFER(IntKiBuf(Int_Xferred), OutData%FlapDOF1) - Int_Xferred = Int_Xferred + 1 - OutData%FlapDOF2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%FlapDOF2) - Int_Xferred = Int_Xferred + 1 - OutData%EdgeDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%EdgeDOF) - Int_Xferred = Int_Xferred + 1 - OutData%TeetDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%TeetDOF) - Int_Xferred = Int_Xferred + 1 - OutData%DrTrDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%DrTrDOF) - Int_Xferred = Int_Xferred + 1 - OutData%GenDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%GenDOF) - Int_Xferred = Int_Xferred + 1 - OutData%YawDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%YawDOF) - Int_Xferred = Int_Xferred + 1 - OutData%TwFADOF1 = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwFADOF1) - Int_Xferred = Int_Xferred + 1 - OutData%TwFADOF2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwFADOF2) - Int_Xferred = Int_Xferred + 1 - OutData%TwSSDOF1 = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwSSDOF1) - Int_Xferred = Int_Xferred + 1 - OutData%TwSSDOF2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwSSDOF2) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmSgDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmSgDOF) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmSwDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmSwDOF) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmHvDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmHvDOF) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmRDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmRDOF) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmPDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmPDOF) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmYDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmYDOF) - Int_Xferred = Int_Xferred + 1 - OutData%OoPDefl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%IPDefl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitch not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlPitch)) DEALLOCATE(OutData%BlPitch) - ALLOCATE(OutData%BlPitch(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitch.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlPitch,1), UBOUND(OutData%BlPitch,1) - OutData%BlPitch(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%TeetDefl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Azimuth = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%RotSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NacYaw = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TTDspFA = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TTDspSS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmSurge = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmSway = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmHeave = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmRoll = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmPitch = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmYaw = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NumBl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TipRad = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HubRad = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PreCone not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PreCone)) DEALLOCATE(OutData%PreCone) - ALLOCATE(OutData%PreCone(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PreCone.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PreCone,1), UBOUND(OutData%PreCone,1) - OutData%PreCone(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%HubCM = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%UndSling = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Delta3 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AzimB1Up = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%OverHang = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ShftGagL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ShftTilt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NacCMxn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NacCMyn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NacCMzn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMUxn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMUyn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMUzn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Twr2Shft = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TowerHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TowerBsHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmCMxt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmCMyt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmCMzt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmRefzt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TipMass not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TipMass)) DEALLOCATE(OutData%TipMass) - ALLOCATE(OutData%TipMass(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TipMass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TipMass,1), UBOUND(OutData%TipMass,1) - OutData%TipMass(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%HubMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HubIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NacMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NacYIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmRIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmPIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmYIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%BldNodes = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InpBlMesh not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InpBlMesh)) DEALLOCATE(OutData%InpBlMesh) - ALLOCATE(OutData%InpBlMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InpBlMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InpBlMesh,1), UBOUND(OutData%InpBlMesh,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ED_UnpackBladeMeshInputData( Re_Buf, Db_Buf, Int_Buf, OutData%InpBlMesh(i1), ErrStat2, ErrMsg2 ) ! InpBlMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InpBl not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InpBl)) DEALLOCATE(OutData%InpBl) - ALLOCATE(OutData%InpBl(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InpBl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InpBl,1), UBOUND(OutData%InpBl,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ED_UnpackBladeInputData( Re_Buf, Db_Buf, Int_Buf, OutData%InpBl(i1), ErrStat2, ErrMsg2 ) ! InpBl - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - OutData%TeetMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TeetDmpP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TeetDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TeetCDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TeetSStP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TeetHStP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TeetSSSp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TeetHSSp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GBoxEff = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GBRatio = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DTTorSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DTTorDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Furling = TRANSFER(IntKiBuf(Int_Xferred), OutData%Furling) - Int_Xferred = Int_Xferred + 1 - OutData%TwrNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) - Int_Xferred = Int_Xferred + 1 - OutData%OutFile = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TabDelim = TRANSFER(IntKiBuf(Int_Xferred), OutData%TabDelim) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Tstart = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%DecFact = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NTwGages = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%TwrGagNd,1) - i1_u = UBOUND(OutData%TwrGagNd,1) - DO i1 = LBOUND(OutData%TwrGagNd,1), UBOUND(OutData%TwrGagNd,1) - OutData%TwrGagNd(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%NBlGages = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%BldGagNd,1) - i1_u = UBOUND(OutData%BldGagNd,1) - DO i1 = LBOUND(OutData%BldGagNd,1), UBOUND(OutData%BldGagNd,1) - OutData%BldGagNd(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutList not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutList)) DEALLOCATE(OutData%OutList) - ALLOCATE(OutData%OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) - DO I = 1, LEN(OutData%OutList) - OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - OutData%NTwInpSt = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%TwrFADmp,1) - i1_u = UBOUND(OutData%TwrFADmp,1) - DO i1 = LBOUND(OutData%TwrFADmp,1), UBOUND(OutData%TwrFADmp,1) - OutData%TwrFADmp(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TwrSSDmp,1) - i1_u = UBOUND(OutData%TwrSSDmp,1) - DO i1 = LBOUND(OutData%TwrSSDmp,1), UBOUND(OutData%TwrSSDmp,1) - OutData%TwrSSDmp(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%FAStTunr,1) - i1_u = UBOUND(OutData%FAStTunr,1) - DO i1 = LBOUND(OutData%FAStTunr,1), UBOUND(OutData%FAStTunr,1) - OutData%FAStTunr(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%SSStTunr,1) - i1_u = UBOUND(OutData%SSStTunr,1) - DO i1 = LBOUND(OutData%SSStTunr,1), UBOUND(OutData%SSStTunr,1) - OutData%SSStTunr(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HtFract not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%HtFract)) DEALLOCATE(OutData%HtFract) - ALLOCATE(OutData%HtFract(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HtFract.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%HtFract,1), UBOUND(OutData%HtFract,1) - OutData%HtFract(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TMassDen not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TMassDen)) DEALLOCATE(OutData%TMassDen) - ALLOCATE(OutData%TMassDen(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TMassDen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TMassDen,1), UBOUND(OutData%TMassDen,1) - OutData%TMassDen(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwFAStif not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TwFAStif)) DEALLOCATE(OutData%TwFAStif) - ALLOCATE(OutData%TwFAStif(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwFAStif.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwFAStif,1), UBOUND(OutData%TwFAStif,1) - OutData%TwFAStif(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwSSStif not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TwSSStif)) DEALLOCATE(OutData%TwSSStif) - ALLOCATE(OutData%TwSSStif(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwSSStif.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwSSStif,1), UBOUND(OutData%TwSSStif,1) - OutData%TwSSStif(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwFAM1Sh not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TwFAM1Sh)) DEALLOCATE(OutData%TwFAM1Sh) - ALLOCATE(OutData%TwFAM1Sh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwFAM1Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwFAM1Sh,1), UBOUND(OutData%TwFAM1Sh,1) - OutData%TwFAM1Sh(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwFAM2Sh not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TwFAM2Sh)) DEALLOCATE(OutData%TwFAM2Sh) - ALLOCATE(OutData%TwFAM2Sh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwFAM2Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwFAM2Sh,1), UBOUND(OutData%TwFAM2Sh,1) - OutData%TwFAM2Sh(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwSSM1Sh not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TwSSM1Sh)) DEALLOCATE(OutData%TwSSM1Sh) - ALLOCATE(OutData%TwSSM1Sh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwSSM1Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwSSM1Sh,1), UBOUND(OutData%TwSSM1Sh,1) - OutData%TwSSM1Sh(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwSSM2Sh not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TwSSM2Sh)) DEALLOCATE(OutData%TwSSM2Sh) - ALLOCATE(OutData%TwSSM2Sh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwSSM2Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TwSSM2Sh,1), UBOUND(OutData%TwSSM2Sh,1) - OutData%TwSSM2Sh(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%RFrlDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%RFrlDOF) - Int_Xferred = Int_Xferred + 1 - OutData%TFrlDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%TFrlDOF) - Int_Xferred = Int_Xferred + 1 - OutData%RotFurl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TailFurl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Yaw2Shft = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ShftSkew = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%RFrlCM_n,1) - i1_u = UBOUND(OutData%RFrlCM_n,1) - DO i1 = LBOUND(OutData%RFrlCM_n,1), UBOUND(OutData%RFrlCM_n,1) - OutData%RFrlCM_n(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%BoomCM_n,1) - i1_u = UBOUND(OutData%BoomCM_n,1) - DO i1 = LBOUND(OutData%BoomCM_n,1), UBOUND(OutData%BoomCM_n,1) - OutData%BoomCM_n(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TFinCM_n,1) - i1_u = UBOUND(OutData%TFinCM_n,1) - DO i1 = LBOUND(OutData%TFinCM_n,1), UBOUND(OutData%TFinCM_n,1) - OutData%TFinCM_n(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%RFrlPnt_n,1) - i1_u = UBOUND(OutData%RFrlPnt_n,1) - DO i1 = LBOUND(OutData%RFrlPnt_n,1), UBOUND(OutData%RFrlPnt_n,1) - OutData%RFrlPnt_n(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%RFrlSkew = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlTilt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%TFrlPnt_n,1) - i1_u = UBOUND(OutData%TFrlPnt_n,1) - DO i1 = LBOUND(OutData%TFrlPnt_n,1), UBOUND(OutData%TFrlPnt_n,1) - OutData%TFrlPnt_n(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%TFrlSkew = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlTilt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%BoomMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFinMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%RFrlSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSDP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSDP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TFrlSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSDP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSDP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%method = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%BldNd_NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_OutList not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BldNd_OutList)) DEALLOCATE(OutData%BldNd_OutList) - ALLOCATE(OutData%BldNd_OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BldNd_OutList,1), UBOUND(OutData%BldNd_OutList,1) - DO I = 1, LEN(OutData%BldNd_OutList) - OutData%BldNd_OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - DO I = 1, LEN(OutData%BldNd_BlOutNd_Str) - OutData%BldNd_BlOutNd_Str(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%BldNd_BladesOut = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE ED_UnPackInputFile +subroutine ED_PackInputFile(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ED_InputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackInputFile' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! DT + call RegPack(Buf, InData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! FlapDOF1 + call RegPack(Buf, InData%FlapDOF1) + if (RegCheckErr(Buf, RoutineName)) return + ! FlapDOF2 + call RegPack(Buf, InData%FlapDOF2) + if (RegCheckErr(Buf, RoutineName)) return + ! EdgeDOF + call RegPack(Buf, InData%EdgeDOF) + if (RegCheckErr(Buf, RoutineName)) return + ! TeetDOF + call RegPack(Buf, InData%TeetDOF) + if (RegCheckErr(Buf, RoutineName)) return + ! DrTrDOF + call RegPack(Buf, InData%DrTrDOF) + if (RegCheckErr(Buf, RoutineName)) return + ! GenDOF + call RegPack(Buf, InData%GenDOF) + if (RegCheckErr(Buf, RoutineName)) return + ! YawDOF + call RegPack(Buf, InData%YawDOF) + if (RegCheckErr(Buf, RoutineName)) return + ! TwFADOF1 + call RegPack(Buf, InData%TwFADOF1) + if (RegCheckErr(Buf, RoutineName)) return + ! TwFADOF2 + call RegPack(Buf, InData%TwFADOF2) + if (RegCheckErr(Buf, RoutineName)) return + ! TwSSDOF1 + call RegPack(Buf, InData%TwSSDOF1) + if (RegCheckErr(Buf, RoutineName)) return + ! TwSSDOF2 + call RegPack(Buf, InData%TwSSDOF2) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmSgDOF + call RegPack(Buf, InData%PtfmSgDOF) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmSwDOF + call RegPack(Buf, InData%PtfmSwDOF) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmHvDOF + call RegPack(Buf, InData%PtfmHvDOF) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmRDOF + call RegPack(Buf, InData%PtfmRDOF) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmPDOF + call RegPack(Buf, InData%PtfmPDOF) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmYDOF + call RegPack(Buf, InData%PtfmYDOF) + if (RegCheckErr(Buf, RoutineName)) return + ! OoPDefl + call RegPack(Buf, InData%OoPDefl) + if (RegCheckErr(Buf, RoutineName)) return + ! IPDefl + call RegPack(Buf, InData%IPDefl) + if (RegCheckErr(Buf, RoutineName)) return + ! BlPitch + call RegPack(Buf, allocated(InData%BlPitch)) + if (allocated(InData%BlPitch)) then + call RegPackBounds(Buf, 1, lbound(InData%BlPitch), ubound(InData%BlPitch)) + call RegPack(Buf, InData%BlPitch) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TeetDefl + call RegPack(Buf, InData%TeetDefl) + if (RegCheckErr(Buf, RoutineName)) return + ! Azimuth + call RegPack(Buf, InData%Azimuth) + if (RegCheckErr(Buf, RoutineName)) return + ! RotSpeed + call RegPack(Buf, InData%RotSpeed) + if (RegCheckErr(Buf, RoutineName)) return + ! NacYaw + call RegPack(Buf, InData%NacYaw) + if (RegCheckErr(Buf, RoutineName)) return + ! TTDspFA + call RegPack(Buf, InData%TTDspFA) + if (RegCheckErr(Buf, RoutineName)) return + ! TTDspSS + call RegPack(Buf, InData%TTDspSS) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmSurge + call RegPack(Buf, InData%PtfmSurge) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmSway + call RegPack(Buf, InData%PtfmSway) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmHeave + call RegPack(Buf, InData%PtfmHeave) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmRoll + call RegPack(Buf, InData%PtfmRoll) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmPitch + call RegPack(Buf, InData%PtfmPitch) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmYaw + call RegPack(Buf, InData%PtfmYaw) + if (RegCheckErr(Buf, RoutineName)) return + ! NumBl + call RegPack(Buf, InData%NumBl) + if (RegCheckErr(Buf, RoutineName)) return + ! TipRad + call RegPack(Buf, InData%TipRad) + if (RegCheckErr(Buf, RoutineName)) return + ! HubRad + call RegPack(Buf, InData%HubRad) + if (RegCheckErr(Buf, RoutineName)) return + ! PreCone + call RegPack(Buf, allocated(InData%PreCone)) + if (allocated(InData%PreCone)) then + call RegPackBounds(Buf, 1, lbound(InData%PreCone), ubound(InData%PreCone)) + call RegPack(Buf, InData%PreCone) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! HubCM + call RegPack(Buf, InData%HubCM) + if (RegCheckErr(Buf, RoutineName)) return + ! UndSling + call RegPack(Buf, InData%UndSling) + if (RegCheckErr(Buf, RoutineName)) return + ! Delta3 + call RegPack(Buf, InData%Delta3) + if (RegCheckErr(Buf, RoutineName)) return + ! AzimB1Up + call RegPack(Buf, InData%AzimB1Up) + if (RegCheckErr(Buf, RoutineName)) return + ! OverHang + call RegPack(Buf, InData%OverHang) + if (RegCheckErr(Buf, RoutineName)) return + ! ShftGagL + call RegPack(Buf, InData%ShftGagL) + if (RegCheckErr(Buf, RoutineName)) return + ! ShftTilt + call RegPack(Buf, InData%ShftTilt) + if (RegCheckErr(Buf, RoutineName)) return + ! NacCMxn + call RegPack(Buf, InData%NacCMxn) + if (RegCheckErr(Buf, RoutineName)) return + ! NacCMyn + call RegPack(Buf, InData%NacCMyn) + if (RegCheckErr(Buf, RoutineName)) return + ! NacCMzn + call RegPack(Buf, InData%NacCMzn) + if (RegCheckErr(Buf, RoutineName)) return + ! NcIMUxn + call RegPack(Buf, InData%NcIMUxn) + if (RegCheckErr(Buf, RoutineName)) return + ! NcIMUyn + call RegPack(Buf, InData%NcIMUyn) + if (RegCheckErr(Buf, RoutineName)) return + ! NcIMUzn + call RegPack(Buf, InData%NcIMUzn) + if (RegCheckErr(Buf, RoutineName)) return + ! Twr2Shft + call RegPack(Buf, InData%Twr2Shft) + if (RegCheckErr(Buf, RoutineName)) return + ! TowerHt + call RegPack(Buf, InData%TowerHt) + if (RegCheckErr(Buf, RoutineName)) return + ! TowerBsHt + call RegPack(Buf, InData%TowerBsHt) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmCMxt + call RegPack(Buf, InData%PtfmCMxt) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmCMyt + call RegPack(Buf, InData%PtfmCMyt) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmCMzt + call RegPack(Buf, InData%PtfmCMzt) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmRefzt + call RegPack(Buf, InData%PtfmRefzt) + if (RegCheckErr(Buf, RoutineName)) return + ! TipMass + call RegPack(Buf, allocated(InData%TipMass)) + if (allocated(InData%TipMass)) then + call RegPackBounds(Buf, 1, lbound(InData%TipMass), ubound(InData%TipMass)) + call RegPack(Buf, InData%TipMass) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! HubMass + call RegPack(Buf, InData%HubMass) + if (RegCheckErr(Buf, RoutineName)) return + ! HubIner + call RegPack(Buf, InData%HubIner) + if (RegCheckErr(Buf, RoutineName)) return + ! GenIner + call RegPack(Buf, InData%GenIner) + if (RegCheckErr(Buf, RoutineName)) return + ! NacMass + call RegPack(Buf, InData%NacMass) + if (RegCheckErr(Buf, RoutineName)) return + ! NacYIner + call RegPack(Buf, InData%NacYIner) + if (RegCheckErr(Buf, RoutineName)) return + ! YawBrMass + call RegPack(Buf, InData%YawBrMass) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmMass + call RegPack(Buf, InData%PtfmMass) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmRIner + call RegPack(Buf, InData%PtfmRIner) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmPIner + call RegPack(Buf, InData%PtfmPIner) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmYIner + call RegPack(Buf, InData%PtfmYIner) + if (RegCheckErr(Buf, RoutineName)) return + ! BldNodes + call RegPack(Buf, InData%BldNodes) + if (RegCheckErr(Buf, RoutineName)) return + ! InpBlMesh + call RegPack(Buf, allocated(InData%InpBlMesh)) + if (allocated(InData%InpBlMesh)) then + call RegPackBounds(Buf, 1, lbound(InData%InpBlMesh), ubound(InData%InpBlMesh)) + LB(1:1) = lbound(InData%InpBlMesh) + UB(1:1) = ubound(InData%InpBlMesh) + do i1 = LB(1), UB(1) + call ED_PackBladeMeshInputData(Buf, InData%InpBlMesh(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! InpBl + call RegPack(Buf, allocated(InData%InpBl)) + if (allocated(InData%InpBl)) then + call RegPackBounds(Buf, 1, lbound(InData%InpBl), ubound(InData%InpBl)) + LB(1:1) = lbound(InData%InpBl) + UB(1:1) = ubound(InData%InpBl) + do i1 = LB(1), UB(1) + call ED_PackBladeInputData(Buf, InData%InpBl(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TeetMod + call RegPack(Buf, InData%TeetMod) + if (RegCheckErr(Buf, RoutineName)) return + ! TeetDmpP + call RegPack(Buf, InData%TeetDmpP) + if (RegCheckErr(Buf, RoutineName)) return + ! TeetDmp + call RegPack(Buf, InData%TeetDmp) + if (RegCheckErr(Buf, RoutineName)) return + ! TeetCDmp + call RegPack(Buf, InData%TeetCDmp) + if (RegCheckErr(Buf, RoutineName)) return + ! TeetSStP + call RegPack(Buf, InData%TeetSStP) + if (RegCheckErr(Buf, RoutineName)) return + ! TeetHStP + call RegPack(Buf, InData%TeetHStP) + if (RegCheckErr(Buf, RoutineName)) return + ! TeetSSSp + call RegPack(Buf, InData%TeetSSSp) + if (RegCheckErr(Buf, RoutineName)) return + ! TeetHSSp + call RegPack(Buf, InData%TeetHSSp) + if (RegCheckErr(Buf, RoutineName)) return + ! GBoxEff + call RegPack(Buf, InData%GBoxEff) + if (RegCheckErr(Buf, RoutineName)) return + ! GBRatio + call RegPack(Buf, InData%GBRatio) + if (RegCheckErr(Buf, RoutineName)) return + ! DTTorSpr + call RegPack(Buf, InData%DTTorSpr) + if (RegCheckErr(Buf, RoutineName)) return + ! DTTorDmp + call RegPack(Buf, InData%DTTorDmp) + if (RegCheckErr(Buf, RoutineName)) return + ! Furling + call RegPack(Buf, InData%Furling) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrNodes + call RegPack(Buf, InData%TwrNodes) + if (RegCheckErr(Buf, RoutineName)) return + ! SumPrint + call RegPack(Buf, InData%SumPrint) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFile + call RegPack(Buf, InData%OutFile) + if (RegCheckErr(Buf, RoutineName)) return + ! TabDelim + call RegPack(Buf, InData%TabDelim) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFmt + call RegPack(Buf, InData%OutFmt) + if (RegCheckErr(Buf, RoutineName)) return + ! Tstart + call RegPack(Buf, InData%Tstart) + if (RegCheckErr(Buf, RoutineName)) return + ! DecFact + call RegPack(Buf, InData%DecFact) + if (RegCheckErr(Buf, RoutineName)) return + ! NTwGages + call RegPack(Buf, InData%NTwGages) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrGagNd + call RegPack(Buf, InData%TwrGagNd) + if (RegCheckErr(Buf, RoutineName)) return + ! NBlGages + call RegPack(Buf, InData%NBlGages) + if (RegCheckErr(Buf, RoutineName)) return + ! BldGagNd + call RegPack(Buf, InData%BldGagNd) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegPack(Buf, InData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! OutList + call RegPack(Buf, allocated(InData%OutList)) + if (allocated(InData%OutList)) then + call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) + call RegPack(Buf, InData%OutList) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NTwInpSt + call RegPack(Buf, InData%NTwInpSt) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrFADmp + call RegPack(Buf, InData%TwrFADmp) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrSSDmp + call RegPack(Buf, InData%TwrSSDmp) + if (RegCheckErr(Buf, RoutineName)) return + ! FAStTunr + call RegPack(Buf, InData%FAStTunr) + if (RegCheckErr(Buf, RoutineName)) return + ! SSStTunr + call RegPack(Buf, InData%SSStTunr) + if (RegCheckErr(Buf, RoutineName)) return + ! HtFract + call RegPack(Buf, allocated(InData%HtFract)) + if (allocated(InData%HtFract)) then + call RegPackBounds(Buf, 1, lbound(InData%HtFract), ubound(InData%HtFract)) + call RegPack(Buf, InData%HtFract) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TMassDen + call RegPack(Buf, allocated(InData%TMassDen)) + if (allocated(InData%TMassDen)) then + call RegPackBounds(Buf, 1, lbound(InData%TMassDen), ubound(InData%TMassDen)) + call RegPack(Buf, InData%TMassDen) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TwFAStif + call RegPack(Buf, allocated(InData%TwFAStif)) + if (allocated(InData%TwFAStif)) then + call RegPackBounds(Buf, 1, lbound(InData%TwFAStif), ubound(InData%TwFAStif)) + call RegPack(Buf, InData%TwFAStif) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TwSSStif + call RegPack(Buf, allocated(InData%TwSSStif)) + if (allocated(InData%TwSSStif)) then + call RegPackBounds(Buf, 1, lbound(InData%TwSSStif), ubound(InData%TwSSStif)) + call RegPack(Buf, InData%TwSSStif) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TwFAM1Sh + call RegPack(Buf, allocated(InData%TwFAM1Sh)) + if (allocated(InData%TwFAM1Sh)) then + call RegPackBounds(Buf, 1, lbound(InData%TwFAM1Sh), ubound(InData%TwFAM1Sh)) + call RegPack(Buf, InData%TwFAM1Sh) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TwFAM2Sh + call RegPack(Buf, allocated(InData%TwFAM2Sh)) + if (allocated(InData%TwFAM2Sh)) then + call RegPackBounds(Buf, 1, lbound(InData%TwFAM2Sh), ubound(InData%TwFAM2Sh)) + call RegPack(Buf, InData%TwFAM2Sh) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TwSSM1Sh + call RegPack(Buf, allocated(InData%TwSSM1Sh)) + if (allocated(InData%TwSSM1Sh)) then + call RegPackBounds(Buf, 1, lbound(InData%TwSSM1Sh), ubound(InData%TwSSM1Sh)) + call RegPack(Buf, InData%TwSSM1Sh) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TwSSM2Sh + call RegPack(Buf, allocated(InData%TwSSM2Sh)) + if (allocated(InData%TwSSM2Sh)) then + call RegPackBounds(Buf, 1, lbound(InData%TwSSM2Sh), ubound(InData%TwSSM2Sh)) + call RegPack(Buf, InData%TwSSM2Sh) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlDOF + call RegPack(Buf, InData%RFrlDOF) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlDOF + call RegPack(Buf, InData%TFrlDOF) + if (RegCheckErr(Buf, RoutineName)) return + ! RotFurl + call RegPack(Buf, InData%RotFurl) + if (RegCheckErr(Buf, RoutineName)) return + ! TailFurl + call RegPack(Buf, InData%TailFurl) + if (RegCheckErr(Buf, RoutineName)) return + ! Yaw2Shft + call RegPack(Buf, InData%Yaw2Shft) + if (RegCheckErr(Buf, RoutineName)) return + ! ShftSkew + call RegPack(Buf, InData%ShftSkew) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlCM_n + call RegPack(Buf, InData%RFrlCM_n) + if (RegCheckErr(Buf, RoutineName)) return + ! BoomCM_n + call RegPack(Buf, InData%BoomCM_n) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinCM_n + call RegPack(Buf, InData%TFinCM_n) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlPnt_n + call RegPack(Buf, InData%RFrlPnt_n) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlSkew + call RegPack(Buf, InData%RFrlSkew) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlTilt + call RegPack(Buf, InData%RFrlTilt) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlPnt_n + call RegPack(Buf, InData%TFrlPnt_n) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlSkew + call RegPack(Buf, InData%TFrlSkew) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlTilt + call RegPack(Buf, InData%TFrlTilt) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlMass + call RegPack(Buf, InData%RFrlMass) + if (RegCheckErr(Buf, RoutineName)) return + ! BoomMass + call RegPack(Buf, InData%BoomMass) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinMass + call RegPack(Buf, InData%TFinMass) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlIner + call RegPack(Buf, InData%RFrlIner) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlIner + call RegPack(Buf, InData%TFrlIner) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlMod + call RegPack(Buf, InData%RFrlMod) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlSpr + call RegPack(Buf, InData%RFrlSpr) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlDmp + call RegPack(Buf, InData%RFrlDmp) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlUSSP + call RegPack(Buf, InData%RFrlUSSP) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlDSSP + call RegPack(Buf, InData%RFrlDSSP) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlUSSpr + call RegPack(Buf, InData%RFrlUSSpr) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlDSSpr + call RegPack(Buf, InData%RFrlDSSpr) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlUSDP + call RegPack(Buf, InData%RFrlUSDP) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlDSDP + call RegPack(Buf, InData%RFrlDSDP) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlUSDmp + call RegPack(Buf, InData%RFrlUSDmp) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlDSDmp + call RegPack(Buf, InData%RFrlDSDmp) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlMod + call RegPack(Buf, InData%TFrlMod) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlSpr + call RegPack(Buf, InData%TFrlSpr) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlDmp + call RegPack(Buf, InData%TFrlDmp) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlUSSP + call RegPack(Buf, InData%TFrlUSSP) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlDSSP + call RegPack(Buf, InData%TFrlDSSP) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlUSSpr + call RegPack(Buf, InData%TFrlUSSpr) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlDSSpr + call RegPack(Buf, InData%TFrlDSSpr) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlUSDP + call RegPack(Buf, InData%TFrlUSDP) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlDSDP + call RegPack(Buf, InData%TFrlDSDP) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlUSDmp + call RegPack(Buf, InData%TFrlUSDmp) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlDSDmp + call RegPack(Buf, InData%TFrlDSDmp) + if (RegCheckErr(Buf, RoutineName)) return + ! method + call RegPack(Buf, InData%method) + if (RegCheckErr(Buf, RoutineName)) return + ! BldNd_NumOuts + call RegPack(Buf, InData%BldNd_NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! BldNd_OutList + call RegPack(Buf, allocated(InData%BldNd_OutList)) + if (allocated(InData%BldNd_OutList)) then + call RegPackBounds(Buf, 1, lbound(InData%BldNd_OutList), ubound(InData%BldNd_OutList)) + call RegPack(Buf, InData%BldNd_OutList) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BldNd_BlOutNd_Str + call RegPack(Buf, InData%BldNd_BlOutNd_Str) + if (RegCheckErr(Buf, RoutineName)) return + ! BldNd_BladesOut + call RegPack(Buf, InData%BldNd_BladesOut) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ED_UnPackInputFile(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ED_InputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackInputFile' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! DT + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! FlapDOF1 + call RegUnpack(Buf, OutData%FlapDOF1) + if (RegCheckErr(Buf, RoutineName)) return + ! FlapDOF2 + call RegUnpack(Buf, OutData%FlapDOF2) + if (RegCheckErr(Buf, RoutineName)) return + ! EdgeDOF + call RegUnpack(Buf, OutData%EdgeDOF) + if (RegCheckErr(Buf, RoutineName)) return + ! TeetDOF + call RegUnpack(Buf, OutData%TeetDOF) + if (RegCheckErr(Buf, RoutineName)) return + ! DrTrDOF + call RegUnpack(Buf, OutData%DrTrDOF) + if (RegCheckErr(Buf, RoutineName)) return + ! GenDOF + call RegUnpack(Buf, OutData%GenDOF) + if (RegCheckErr(Buf, RoutineName)) return + ! YawDOF + call RegUnpack(Buf, OutData%YawDOF) + if (RegCheckErr(Buf, RoutineName)) return + ! TwFADOF1 + call RegUnpack(Buf, OutData%TwFADOF1) + if (RegCheckErr(Buf, RoutineName)) return + ! TwFADOF2 + call RegUnpack(Buf, OutData%TwFADOF2) + if (RegCheckErr(Buf, RoutineName)) return + ! TwSSDOF1 + call RegUnpack(Buf, OutData%TwSSDOF1) + if (RegCheckErr(Buf, RoutineName)) return + ! TwSSDOF2 + call RegUnpack(Buf, OutData%TwSSDOF2) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmSgDOF + call RegUnpack(Buf, OutData%PtfmSgDOF) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmSwDOF + call RegUnpack(Buf, OutData%PtfmSwDOF) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmHvDOF + call RegUnpack(Buf, OutData%PtfmHvDOF) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmRDOF + call RegUnpack(Buf, OutData%PtfmRDOF) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmPDOF + call RegUnpack(Buf, OutData%PtfmPDOF) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmYDOF + call RegUnpack(Buf, OutData%PtfmYDOF) + if (RegCheckErr(Buf, RoutineName)) return + ! OoPDefl + call RegUnpack(Buf, OutData%OoPDefl) + if (RegCheckErr(Buf, RoutineName)) return + ! IPDefl + call RegUnpack(Buf, OutData%IPDefl) + if (RegCheckErr(Buf, RoutineName)) return + ! BlPitch + if (allocated(OutData%BlPitch)) deallocate(OutData%BlPitch) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlPitch(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitch.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlPitch) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TeetDefl + call RegUnpack(Buf, OutData%TeetDefl) + if (RegCheckErr(Buf, RoutineName)) return + ! Azimuth + call RegUnpack(Buf, OutData%Azimuth) + if (RegCheckErr(Buf, RoutineName)) return + ! RotSpeed + call RegUnpack(Buf, OutData%RotSpeed) + if (RegCheckErr(Buf, RoutineName)) return + ! NacYaw + call RegUnpack(Buf, OutData%NacYaw) + if (RegCheckErr(Buf, RoutineName)) return + ! TTDspFA + call RegUnpack(Buf, OutData%TTDspFA) + if (RegCheckErr(Buf, RoutineName)) return + ! TTDspSS + call RegUnpack(Buf, OutData%TTDspSS) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmSurge + call RegUnpack(Buf, OutData%PtfmSurge) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmSway + call RegUnpack(Buf, OutData%PtfmSway) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmHeave + call RegUnpack(Buf, OutData%PtfmHeave) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmRoll + call RegUnpack(Buf, OutData%PtfmRoll) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmPitch + call RegUnpack(Buf, OutData%PtfmPitch) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmYaw + call RegUnpack(Buf, OutData%PtfmYaw) + if (RegCheckErr(Buf, RoutineName)) return + ! NumBl + call RegUnpack(Buf, OutData%NumBl) + if (RegCheckErr(Buf, RoutineName)) return + ! TipRad + call RegUnpack(Buf, OutData%TipRad) + if (RegCheckErr(Buf, RoutineName)) return + ! HubRad + call RegUnpack(Buf, OutData%HubRad) + if (RegCheckErr(Buf, RoutineName)) return + ! PreCone + if (allocated(OutData%PreCone)) deallocate(OutData%PreCone) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PreCone(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PreCone.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PreCone) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! HubCM + call RegUnpack(Buf, OutData%HubCM) + if (RegCheckErr(Buf, RoutineName)) return + ! UndSling + call RegUnpack(Buf, OutData%UndSling) + if (RegCheckErr(Buf, RoutineName)) return + ! Delta3 + call RegUnpack(Buf, OutData%Delta3) + if (RegCheckErr(Buf, RoutineName)) return + ! AzimB1Up + call RegUnpack(Buf, OutData%AzimB1Up) + if (RegCheckErr(Buf, RoutineName)) return + ! OverHang + call RegUnpack(Buf, OutData%OverHang) + if (RegCheckErr(Buf, RoutineName)) return + ! ShftGagL + call RegUnpack(Buf, OutData%ShftGagL) + if (RegCheckErr(Buf, RoutineName)) return + ! ShftTilt + call RegUnpack(Buf, OutData%ShftTilt) + if (RegCheckErr(Buf, RoutineName)) return + ! NacCMxn + call RegUnpack(Buf, OutData%NacCMxn) + if (RegCheckErr(Buf, RoutineName)) return + ! NacCMyn + call RegUnpack(Buf, OutData%NacCMyn) + if (RegCheckErr(Buf, RoutineName)) return + ! NacCMzn + call RegUnpack(Buf, OutData%NacCMzn) + if (RegCheckErr(Buf, RoutineName)) return + ! NcIMUxn + call RegUnpack(Buf, OutData%NcIMUxn) + if (RegCheckErr(Buf, RoutineName)) return + ! NcIMUyn + call RegUnpack(Buf, OutData%NcIMUyn) + if (RegCheckErr(Buf, RoutineName)) return + ! NcIMUzn + call RegUnpack(Buf, OutData%NcIMUzn) + if (RegCheckErr(Buf, RoutineName)) return + ! Twr2Shft + call RegUnpack(Buf, OutData%Twr2Shft) + if (RegCheckErr(Buf, RoutineName)) return + ! TowerHt + call RegUnpack(Buf, OutData%TowerHt) + if (RegCheckErr(Buf, RoutineName)) return + ! TowerBsHt + call RegUnpack(Buf, OutData%TowerBsHt) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmCMxt + call RegUnpack(Buf, OutData%PtfmCMxt) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmCMyt + call RegUnpack(Buf, OutData%PtfmCMyt) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmCMzt + call RegUnpack(Buf, OutData%PtfmCMzt) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmRefzt + call RegUnpack(Buf, OutData%PtfmRefzt) + if (RegCheckErr(Buf, RoutineName)) return + ! TipMass + if (allocated(OutData%TipMass)) deallocate(OutData%TipMass) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TipMass(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TipMass.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TipMass) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! HubMass + call RegUnpack(Buf, OutData%HubMass) + if (RegCheckErr(Buf, RoutineName)) return + ! HubIner + call RegUnpack(Buf, OutData%HubIner) + if (RegCheckErr(Buf, RoutineName)) return + ! GenIner + call RegUnpack(Buf, OutData%GenIner) + if (RegCheckErr(Buf, RoutineName)) return + ! NacMass + call RegUnpack(Buf, OutData%NacMass) + if (RegCheckErr(Buf, RoutineName)) return + ! NacYIner + call RegUnpack(Buf, OutData%NacYIner) + if (RegCheckErr(Buf, RoutineName)) return + ! YawBrMass + call RegUnpack(Buf, OutData%YawBrMass) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmMass + call RegUnpack(Buf, OutData%PtfmMass) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmRIner + call RegUnpack(Buf, OutData%PtfmRIner) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmPIner + call RegUnpack(Buf, OutData%PtfmPIner) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmYIner + call RegUnpack(Buf, OutData%PtfmYIner) + if (RegCheckErr(Buf, RoutineName)) return + ! BldNodes + call RegUnpack(Buf, OutData%BldNodes) + if (RegCheckErr(Buf, RoutineName)) return + ! InpBlMesh + if (allocated(OutData%InpBlMesh)) deallocate(OutData%InpBlMesh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InpBlMesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InpBlMesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ED_UnpackBladeMeshInputData(Buf, OutData%InpBlMesh(i1)) ! InpBlMesh + end do + end if + ! InpBl + if (allocated(OutData%InpBl)) deallocate(OutData%InpBl) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InpBl(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InpBl.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ED_UnpackBladeInputData(Buf, OutData%InpBl(i1)) ! InpBl + end do + end if + ! TeetMod + call RegUnpack(Buf, OutData%TeetMod) + if (RegCheckErr(Buf, RoutineName)) return + ! TeetDmpP + call RegUnpack(Buf, OutData%TeetDmpP) + if (RegCheckErr(Buf, RoutineName)) return + ! TeetDmp + call RegUnpack(Buf, OutData%TeetDmp) + if (RegCheckErr(Buf, RoutineName)) return + ! TeetCDmp + call RegUnpack(Buf, OutData%TeetCDmp) + if (RegCheckErr(Buf, RoutineName)) return + ! TeetSStP + call RegUnpack(Buf, OutData%TeetSStP) + if (RegCheckErr(Buf, RoutineName)) return + ! TeetHStP + call RegUnpack(Buf, OutData%TeetHStP) + if (RegCheckErr(Buf, RoutineName)) return + ! TeetSSSp + call RegUnpack(Buf, OutData%TeetSSSp) + if (RegCheckErr(Buf, RoutineName)) return + ! TeetHSSp + call RegUnpack(Buf, OutData%TeetHSSp) + if (RegCheckErr(Buf, RoutineName)) return + ! GBoxEff + call RegUnpack(Buf, OutData%GBoxEff) + if (RegCheckErr(Buf, RoutineName)) return + ! GBRatio + call RegUnpack(Buf, OutData%GBRatio) + if (RegCheckErr(Buf, RoutineName)) return + ! DTTorSpr + call RegUnpack(Buf, OutData%DTTorSpr) + if (RegCheckErr(Buf, RoutineName)) return + ! DTTorDmp + call RegUnpack(Buf, OutData%DTTorDmp) + if (RegCheckErr(Buf, RoutineName)) return + ! Furling + call RegUnpack(Buf, OutData%Furling) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrNodes + call RegUnpack(Buf, OutData%TwrNodes) + if (RegCheckErr(Buf, RoutineName)) return + ! SumPrint + call RegUnpack(Buf, OutData%SumPrint) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFile + call RegUnpack(Buf, OutData%OutFile) + if (RegCheckErr(Buf, RoutineName)) return + ! TabDelim + call RegUnpack(Buf, OutData%TabDelim) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFmt + call RegUnpack(Buf, OutData%OutFmt) + if (RegCheckErr(Buf, RoutineName)) return + ! Tstart + call RegUnpack(Buf, OutData%Tstart) + if (RegCheckErr(Buf, RoutineName)) return + ! DecFact + call RegUnpack(Buf, OutData%DecFact) + if (RegCheckErr(Buf, RoutineName)) return + ! NTwGages + call RegUnpack(Buf, OutData%NTwGages) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrGagNd + call RegUnpack(Buf, OutData%TwrGagNd) + if (RegCheckErr(Buf, RoutineName)) return + ! NBlGages + call RegUnpack(Buf, OutData%NBlGages) + if (RegCheckErr(Buf, RoutineName)) return + ! BldGagNd + call RegUnpack(Buf, OutData%BldGagNd) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! OutList + if (allocated(OutData%OutList)) deallocate(OutData%OutList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutList) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NTwInpSt + call RegUnpack(Buf, OutData%NTwInpSt) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrFADmp + call RegUnpack(Buf, OutData%TwrFADmp) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrSSDmp + call RegUnpack(Buf, OutData%TwrSSDmp) + if (RegCheckErr(Buf, RoutineName)) return + ! FAStTunr + call RegUnpack(Buf, OutData%FAStTunr) + if (RegCheckErr(Buf, RoutineName)) return + ! SSStTunr + call RegUnpack(Buf, OutData%SSStTunr) + if (RegCheckErr(Buf, RoutineName)) return + ! HtFract + if (allocated(OutData%HtFract)) deallocate(OutData%HtFract) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%HtFract(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%HtFract.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%HtFract) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TMassDen + if (allocated(OutData%TMassDen)) deallocate(OutData%TMassDen) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TMassDen(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TMassDen.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TMassDen) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TwFAStif + if (allocated(OutData%TwFAStif)) deallocate(OutData%TwFAStif) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwFAStif(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwFAStif.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwFAStif) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TwSSStif + if (allocated(OutData%TwSSStif)) deallocate(OutData%TwSSStif) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwSSStif(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwSSStif.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwSSStif) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TwFAM1Sh + if (allocated(OutData%TwFAM1Sh)) deallocate(OutData%TwFAM1Sh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwFAM1Sh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwFAM1Sh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwFAM1Sh) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TwFAM2Sh + if (allocated(OutData%TwFAM2Sh)) deallocate(OutData%TwFAM2Sh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwFAM2Sh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwFAM2Sh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwFAM2Sh) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TwSSM1Sh + if (allocated(OutData%TwSSM1Sh)) deallocate(OutData%TwSSM1Sh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwSSM1Sh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwSSM1Sh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwSSM1Sh) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TwSSM2Sh + if (allocated(OutData%TwSSM2Sh)) deallocate(OutData%TwSSM2Sh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwSSM2Sh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwSSM2Sh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwSSM2Sh) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RFrlDOF + call RegUnpack(Buf, OutData%RFrlDOF) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlDOF + call RegUnpack(Buf, OutData%TFrlDOF) + if (RegCheckErr(Buf, RoutineName)) return + ! RotFurl + call RegUnpack(Buf, OutData%RotFurl) + if (RegCheckErr(Buf, RoutineName)) return + ! TailFurl + call RegUnpack(Buf, OutData%TailFurl) + if (RegCheckErr(Buf, RoutineName)) return + ! Yaw2Shft + call RegUnpack(Buf, OutData%Yaw2Shft) + if (RegCheckErr(Buf, RoutineName)) return + ! ShftSkew + call RegUnpack(Buf, OutData%ShftSkew) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlCM_n + call RegUnpack(Buf, OutData%RFrlCM_n) + if (RegCheckErr(Buf, RoutineName)) return + ! BoomCM_n + call RegUnpack(Buf, OutData%BoomCM_n) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinCM_n + call RegUnpack(Buf, OutData%TFinCM_n) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlPnt_n + call RegUnpack(Buf, OutData%RFrlPnt_n) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlSkew + call RegUnpack(Buf, OutData%RFrlSkew) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlTilt + call RegUnpack(Buf, OutData%RFrlTilt) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlPnt_n + call RegUnpack(Buf, OutData%TFrlPnt_n) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlSkew + call RegUnpack(Buf, OutData%TFrlSkew) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlTilt + call RegUnpack(Buf, OutData%TFrlTilt) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlMass + call RegUnpack(Buf, OutData%RFrlMass) + if (RegCheckErr(Buf, RoutineName)) return + ! BoomMass + call RegUnpack(Buf, OutData%BoomMass) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinMass + call RegUnpack(Buf, OutData%TFinMass) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlIner + call RegUnpack(Buf, OutData%RFrlIner) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlIner + call RegUnpack(Buf, OutData%TFrlIner) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlMod + call RegUnpack(Buf, OutData%RFrlMod) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlSpr + call RegUnpack(Buf, OutData%RFrlSpr) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlDmp + call RegUnpack(Buf, OutData%RFrlDmp) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlUSSP + call RegUnpack(Buf, OutData%RFrlUSSP) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlDSSP + call RegUnpack(Buf, OutData%RFrlDSSP) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlUSSpr + call RegUnpack(Buf, OutData%RFrlUSSpr) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlDSSpr + call RegUnpack(Buf, OutData%RFrlDSSpr) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlUSDP + call RegUnpack(Buf, OutData%RFrlUSDP) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlDSDP + call RegUnpack(Buf, OutData%RFrlDSDP) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlUSDmp + call RegUnpack(Buf, OutData%RFrlUSDmp) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlDSDmp + call RegUnpack(Buf, OutData%RFrlDSDmp) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlMod + call RegUnpack(Buf, OutData%TFrlMod) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlSpr + call RegUnpack(Buf, OutData%TFrlSpr) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlDmp + call RegUnpack(Buf, OutData%TFrlDmp) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlUSSP + call RegUnpack(Buf, OutData%TFrlUSSP) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlDSSP + call RegUnpack(Buf, OutData%TFrlDSSP) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlUSSpr + call RegUnpack(Buf, OutData%TFrlUSSpr) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlDSSpr + call RegUnpack(Buf, OutData%TFrlDSSpr) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlUSDP + call RegUnpack(Buf, OutData%TFrlUSDP) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlDSDP + call RegUnpack(Buf, OutData%TFrlDSDP) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlUSDmp + call RegUnpack(Buf, OutData%TFrlUSDmp) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlDSDmp + call RegUnpack(Buf, OutData%TFrlDSDmp) + if (RegCheckErr(Buf, RoutineName)) return + ! method + call RegUnpack(Buf, OutData%method) + if (RegCheckErr(Buf, RoutineName)) return + ! BldNd_NumOuts + call RegUnpack(Buf, OutData%BldNd_NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! BldNd_OutList + if (allocated(OutData%BldNd_OutList)) deallocate(OutData%BldNd_OutList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BldNd_OutList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BldNd_OutList) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BldNd_BlOutNd_Str + call RegUnpack(Buf, OutData%BldNd_BlOutNd_Str) + if (RegCheckErr(Buf, RoutineName)) return + ! BldNd_BladesOut + call RegUnpack(Buf, OutData%BldNd_BladesOut) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE ED_CopyCoordSys( SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, ErrMsg ) TYPE(ED_CoordSys), INTENT(IN) :: SrcCoordSysData TYPE(ED_CoordSys), INTENT(INOUT) :: DstCoordSysData @@ -5403,1450 +4141,654 @@ SUBROUTINE ED_DestroyCoordSys( CoordSysData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE ED_DestroyCoordSys - SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ED_CoordSys), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_PackCoordSys' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + SIZE(InData%a1) ! a1 - Db_BufSz = Db_BufSz + SIZE(InData%a2) ! a2 - Db_BufSz = Db_BufSz + SIZE(InData%a3) ! a3 - Db_BufSz = Db_BufSz + SIZE(InData%b1) ! b1 - Db_BufSz = Db_BufSz + SIZE(InData%b2) ! b2 - Db_BufSz = Db_BufSz + SIZE(InData%b3) ! b3 - Db_BufSz = Db_BufSz + SIZE(InData%c1) ! c1 - Db_BufSz = Db_BufSz + SIZE(InData%c2) ! c2 - Db_BufSz = Db_BufSz + SIZE(InData%c3) ! c3 - Db_BufSz = Db_BufSz + SIZE(InData%d1) ! d1 - Db_BufSz = Db_BufSz + SIZE(InData%d2) ! d2 - Db_BufSz = Db_BufSz + SIZE(InData%d3) ! d3 - Db_BufSz = Db_BufSz + SIZE(InData%e1) ! e1 - Db_BufSz = Db_BufSz + SIZE(InData%e2) ! e2 - Db_BufSz = Db_BufSz + SIZE(InData%e3) ! e3 - Db_BufSz = Db_BufSz + SIZE(InData%f1) ! f1 - Db_BufSz = Db_BufSz + SIZE(InData%f2) ! f2 - Db_BufSz = Db_BufSz + SIZE(InData%f3) ! f3 - Db_BufSz = Db_BufSz + SIZE(InData%g1) ! g1 - Db_BufSz = Db_BufSz + SIZE(InData%g2) ! g2 - Db_BufSz = Db_BufSz + SIZE(InData%g3) ! g3 - Int_BufSz = Int_BufSz + 1 ! i1 allocated yes/no - IF ( ALLOCATED(InData%i1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! i1 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%i1) ! i1 - END IF - Int_BufSz = Int_BufSz + 1 ! i2 allocated yes/no - IF ( ALLOCATED(InData%i2) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! i2 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%i2) ! i2 - END IF - Int_BufSz = Int_BufSz + 1 ! i3 allocated yes/no - IF ( ALLOCATED(InData%i3) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! i3 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%i3) ! i3 - END IF - Int_BufSz = Int_BufSz + 1 ! j1 allocated yes/no - IF ( ALLOCATED(InData%j1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! j1 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%j1) ! j1 - END IF - Int_BufSz = Int_BufSz + 1 ! j2 allocated yes/no - IF ( ALLOCATED(InData%j2) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! j2 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%j2) ! j2 - END IF - Int_BufSz = Int_BufSz + 1 ! j3 allocated yes/no - IF ( ALLOCATED(InData%j3) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! j3 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%j3) ! j3 - END IF - Int_BufSz = Int_BufSz + 1 ! m1 allocated yes/no - IF ( ALLOCATED(InData%m1) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! m1 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%m1) ! m1 - END IF - Int_BufSz = Int_BufSz + 1 ! m2 allocated yes/no - IF ( ALLOCATED(InData%m2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! m2 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%m2) ! m2 - END IF - Int_BufSz = Int_BufSz + 1 ! m3 allocated yes/no - IF ( ALLOCATED(InData%m3) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! m3 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%m3) ! m3 +subroutine ED_PackCoordSys(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ED_CoordSys), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackCoordSys' + if (Buf%ErrStat >= AbortErrLev) return + ! a1 + call RegPack(Buf, InData%a1) + if (RegCheckErr(Buf, RoutineName)) return + ! a2 + call RegPack(Buf, InData%a2) + if (RegCheckErr(Buf, RoutineName)) return + ! a3 + call RegPack(Buf, InData%a3) + if (RegCheckErr(Buf, RoutineName)) return + ! b1 + call RegPack(Buf, InData%b1) + if (RegCheckErr(Buf, RoutineName)) return + ! b2 + call RegPack(Buf, InData%b2) + if (RegCheckErr(Buf, RoutineName)) return + ! b3 + call RegPack(Buf, InData%b3) + if (RegCheckErr(Buf, RoutineName)) return + ! c1 + call RegPack(Buf, InData%c1) + if (RegCheckErr(Buf, RoutineName)) return + ! c2 + call RegPack(Buf, InData%c2) + if (RegCheckErr(Buf, RoutineName)) return + ! c3 + call RegPack(Buf, InData%c3) + if (RegCheckErr(Buf, RoutineName)) return + ! d1 + call RegPack(Buf, InData%d1) + if (RegCheckErr(Buf, RoutineName)) return + ! d2 + call RegPack(Buf, InData%d2) + if (RegCheckErr(Buf, RoutineName)) return + ! d3 + call RegPack(Buf, InData%d3) + if (RegCheckErr(Buf, RoutineName)) return + ! e1 + call RegPack(Buf, InData%e1) + if (RegCheckErr(Buf, RoutineName)) return + ! e2 + call RegPack(Buf, InData%e2) + if (RegCheckErr(Buf, RoutineName)) return + ! e3 + call RegPack(Buf, InData%e3) + if (RegCheckErr(Buf, RoutineName)) return + ! f1 + call RegPack(Buf, InData%f1) + if (RegCheckErr(Buf, RoutineName)) return + ! f2 + call RegPack(Buf, InData%f2) + if (RegCheckErr(Buf, RoutineName)) return + ! f3 + call RegPack(Buf, InData%f3) + if (RegCheckErr(Buf, RoutineName)) return + ! g1 + call RegPack(Buf, InData%g1) + if (RegCheckErr(Buf, RoutineName)) return + ! g2 + call RegPack(Buf, InData%g2) + if (RegCheckErr(Buf, RoutineName)) return + ! g3 + call RegPack(Buf, InData%g3) + if (RegCheckErr(Buf, RoutineName)) return + ! i1 + call RegPack(Buf, allocated(InData%i1)) + if (allocated(InData%i1)) then + call RegPackBounds(Buf, 2, lbound(InData%i1), ubound(InData%i1)) + call RegPack(Buf, InData%i1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! i2 + call RegPack(Buf, allocated(InData%i2)) + if (allocated(InData%i2)) then + call RegPackBounds(Buf, 2, lbound(InData%i2), ubound(InData%i2)) + call RegPack(Buf, InData%i2) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! i3 + call RegPack(Buf, allocated(InData%i3)) + if (allocated(InData%i3)) then + call RegPackBounds(Buf, 2, lbound(InData%i3), ubound(InData%i3)) + call RegPack(Buf, InData%i3) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! j1 + call RegPack(Buf, allocated(InData%j1)) + if (allocated(InData%j1)) then + call RegPackBounds(Buf, 2, lbound(InData%j1), ubound(InData%j1)) + call RegPack(Buf, InData%j1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! j2 + call RegPack(Buf, allocated(InData%j2)) + if (allocated(InData%j2)) then + call RegPackBounds(Buf, 2, lbound(InData%j2), ubound(InData%j2)) + call RegPack(Buf, InData%j2) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! j3 + call RegPack(Buf, allocated(InData%j3)) + if (allocated(InData%j3)) then + call RegPackBounds(Buf, 2, lbound(InData%j3), ubound(InData%j3)) + call RegPack(Buf, InData%j3) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! m1 + call RegPack(Buf, allocated(InData%m1)) + if (allocated(InData%m1)) then + call RegPackBounds(Buf, 3, lbound(InData%m1), ubound(InData%m1)) + call RegPack(Buf, InData%m1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! m2 + call RegPack(Buf, allocated(InData%m2)) + if (allocated(InData%m2)) then + call RegPackBounds(Buf, 3, lbound(InData%m2), ubound(InData%m2)) + call RegPack(Buf, InData%m2) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! m3 + call RegPack(Buf, allocated(InData%m3)) + if (allocated(InData%m3)) then + call RegPackBounds(Buf, 3, lbound(InData%m3), ubound(InData%m3)) + call RegPack(Buf, InData%m3) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! n1 + call RegPack(Buf, allocated(InData%n1)) + if (allocated(InData%n1)) then + call RegPackBounds(Buf, 3, lbound(InData%n1), ubound(InData%n1)) + call RegPack(Buf, InData%n1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! n2 + call RegPack(Buf, allocated(InData%n2)) + if (allocated(InData%n2)) then + call RegPackBounds(Buf, 3, lbound(InData%n2), ubound(InData%n2)) + call RegPack(Buf, InData%n2) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! n3 + call RegPack(Buf, allocated(InData%n3)) + if (allocated(InData%n3)) then + call RegPackBounds(Buf, 3, lbound(InData%n3), ubound(InData%n3)) + call RegPack(Buf, InData%n3) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! rf1 + call RegPack(Buf, InData%rf1) + if (RegCheckErr(Buf, RoutineName)) return + ! rf2 + call RegPack(Buf, InData%rf2) + if (RegCheckErr(Buf, RoutineName)) return + ! rf3 + call RegPack(Buf, InData%rf3) + if (RegCheckErr(Buf, RoutineName)) return + ! rfa + call RegPack(Buf, InData%rfa) + if (RegCheckErr(Buf, RoutineName)) return + ! t1 + call RegPack(Buf, allocated(InData%t1)) + if (allocated(InData%t1)) then + call RegPackBounds(Buf, 2, lbound(InData%t1), ubound(InData%t1)) + call RegPack(Buf, InData%t1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! t2 + call RegPack(Buf, allocated(InData%t2)) + if (allocated(InData%t2)) then + call RegPackBounds(Buf, 2, lbound(InData%t2), ubound(InData%t2)) + call RegPack(Buf, InData%t2) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! t3 + call RegPack(Buf, allocated(InData%t3)) + if (allocated(InData%t3)) then + call RegPackBounds(Buf, 2, lbound(InData%t3), ubound(InData%t3)) + call RegPack(Buf, InData%t3) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! te1 + call RegPack(Buf, allocated(InData%te1)) + if (allocated(InData%te1)) then + call RegPackBounds(Buf, 3, lbound(InData%te1), ubound(InData%te1)) + call RegPack(Buf, InData%te1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! te2 + call RegPack(Buf, allocated(InData%te2)) + if (allocated(InData%te2)) then + call RegPackBounds(Buf, 3, lbound(InData%te2), ubound(InData%te2)) + call RegPack(Buf, InData%te2) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! te3 + call RegPack(Buf, allocated(InData%te3)) + if (allocated(InData%te3)) then + call RegPackBounds(Buf, 3, lbound(InData%te3), ubound(InData%te3)) + call RegPack(Buf, InData%te3) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! tf1 + call RegPack(Buf, InData%tf1) + if (RegCheckErr(Buf, RoutineName)) return + ! tf2 + call RegPack(Buf, InData%tf2) + if (RegCheckErr(Buf, RoutineName)) return + ! tf3 + call RegPack(Buf, InData%tf3) + if (RegCheckErr(Buf, RoutineName)) return + ! tfa + call RegPack(Buf, InData%tfa) + if (RegCheckErr(Buf, RoutineName)) return + ! z1 + call RegPack(Buf, InData%z1) + if (RegCheckErr(Buf, RoutineName)) return + ! z2 + call RegPack(Buf, InData%z2) + if (RegCheckErr(Buf, RoutineName)) return + ! z3 + call RegPack(Buf, InData%z3) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ED_UnPackCoordSys(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ED_CoordSys), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackCoordSys' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! a1 + call RegUnpack(Buf, OutData%a1) + if (RegCheckErr(Buf, RoutineName)) return + ! a2 + call RegUnpack(Buf, OutData%a2) + if (RegCheckErr(Buf, RoutineName)) return + ! a3 + call RegUnpack(Buf, OutData%a3) + if (RegCheckErr(Buf, RoutineName)) return + ! b1 + call RegUnpack(Buf, OutData%b1) + if (RegCheckErr(Buf, RoutineName)) return + ! b2 + call RegUnpack(Buf, OutData%b2) + if (RegCheckErr(Buf, RoutineName)) return + ! b3 + call RegUnpack(Buf, OutData%b3) + if (RegCheckErr(Buf, RoutineName)) return + ! c1 + call RegUnpack(Buf, OutData%c1) + if (RegCheckErr(Buf, RoutineName)) return + ! c2 + call RegUnpack(Buf, OutData%c2) + if (RegCheckErr(Buf, RoutineName)) return + ! c3 + call RegUnpack(Buf, OutData%c3) + if (RegCheckErr(Buf, RoutineName)) return + ! d1 + call RegUnpack(Buf, OutData%d1) + if (RegCheckErr(Buf, RoutineName)) return + ! d2 + call RegUnpack(Buf, OutData%d2) + if (RegCheckErr(Buf, RoutineName)) return + ! d3 + call RegUnpack(Buf, OutData%d3) + if (RegCheckErr(Buf, RoutineName)) return + ! e1 + call RegUnpack(Buf, OutData%e1) + if (RegCheckErr(Buf, RoutineName)) return + ! e2 + call RegUnpack(Buf, OutData%e2) + if (RegCheckErr(Buf, RoutineName)) return + ! e3 + call RegUnpack(Buf, OutData%e3) + if (RegCheckErr(Buf, RoutineName)) return + ! f1 + call RegUnpack(Buf, OutData%f1) + if (RegCheckErr(Buf, RoutineName)) return + ! f2 + call RegUnpack(Buf, OutData%f2) + if (RegCheckErr(Buf, RoutineName)) return + ! f3 + call RegUnpack(Buf, OutData%f3) + if (RegCheckErr(Buf, RoutineName)) return + ! g1 + call RegUnpack(Buf, OutData%g1) + if (RegCheckErr(Buf, RoutineName)) return + ! g2 + call RegUnpack(Buf, OutData%g2) + if (RegCheckErr(Buf, RoutineName)) return + ! g3 + call RegUnpack(Buf, OutData%g3) + if (RegCheckErr(Buf, RoutineName)) return + ! i1 + if (allocated(OutData%i1)) deallocate(OutData%i1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%i1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%i1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%i1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! i2 + if (allocated(OutData%i2)) deallocate(OutData%i2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%i2(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%i2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%i2) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! i3 + if (allocated(OutData%i3)) deallocate(OutData%i3) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%i3(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%i3.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%i3) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! j1 + if (allocated(OutData%j1)) deallocate(OutData%j1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%j1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%j1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%j1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! j2 + if (allocated(OutData%j2)) deallocate(OutData%j2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%j2(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%j2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%j2) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! j3 + if (allocated(OutData%j3)) deallocate(OutData%j3) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%j3(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%j3.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%j3) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! m1 + if (allocated(OutData%m1)) deallocate(OutData%m1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%m1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%m1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%m1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! m2 + if (allocated(OutData%m2)) deallocate(OutData%m2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%m2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%m2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%m2) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! m3 + if (allocated(OutData%m3)) deallocate(OutData%m3) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%m3(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%m3.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%m3) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! n1 + if (allocated(OutData%n1)) deallocate(OutData%n1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%n1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%n1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%n1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! n2 + if (allocated(OutData%n2)) deallocate(OutData%n2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%n2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%n2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%n2) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! n3 + if (allocated(OutData%n3)) deallocate(OutData%n3) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%n3(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%n3.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%n3) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! rf1 + call RegUnpack(Buf, OutData%rf1) + if (RegCheckErr(Buf, RoutineName)) return + ! rf2 + call RegUnpack(Buf, OutData%rf2) + if (RegCheckErr(Buf, RoutineName)) return + ! rf3 + call RegUnpack(Buf, OutData%rf3) + if (RegCheckErr(Buf, RoutineName)) return + ! rfa + call RegUnpack(Buf, OutData%rfa) + if (RegCheckErr(Buf, RoutineName)) return + ! t1 + if (allocated(OutData%t1)) deallocate(OutData%t1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%t1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%t1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%t1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! t2 + if (allocated(OutData%t2)) deallocate(OutData%t2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%t2(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%t2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%t2) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! t3 + if (allocated(OutData%t3)) deallocate(OutData%t3) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%t3(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%t3.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%t3) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! te1 + if (allocated(OutData%te1)) deallocate(OutData%te1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%te1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%te1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%te1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! te2 + if (allocated(OutData%te2)) deallocate(OutData%te2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%te2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%te2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%te2) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! te3 + if (allocated(OutData%te3)) deallocate(OutData%te3) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%te3(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%te3.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%te3) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! tf1 + call RegUnpack(Buf, OutData%tf1) + if (RegCheckErr(Buf, RoutineName)) return + ! tf2 + call RegUnpack(Buf, OutData%tf2) + if (RegCheckErr(Buf, RoutineName)) return + ! tf3 + call RegUnpack(Buf, OutData%tf3) + if (RegCheckErr(Buf, RoutineName)) return + ! tfa + call RegUnpack(Buf, OutData%tfa) + if (RegCheckErr(Buf, RoutineName)) return + ! z1 + call RegUnpack(Buf, OutData%z1) + if (RegCheckErr(Buf, RoutineName)) return + ! z2 + call RegUnpack(Buf, OutData%z2) + if (RegCheckErr(Buf, RoutineName)) return + ! z3 + call RegUnpack(Buf, OutData%z3) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + SUBROUTINE ED_CopyActiveDOFs( SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ED_ActiveDOFs), INTENT(IN) :: SrcActiveDOFsData + TYPE(ED_ActiveDOFs), INTENT(INOUT) :: DstActiveDOFsData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ED_CopyActiveDOFs' +! + ErrStat = ErrID_None + ErrMsg = "" + DstActiveDOFsData%NActvDOF = SrcActiveDOFsData%NActvDOF + DstActiveDOFsData%NPCE = SrcActiveDOFsData%NPCE + DstActiveDOFsData%NPDE = SrcActiveDOFsData%NPDE + DstActiveDOFsData%NPIE = SrcActiveDOFsData%NPIE + DstActiveDOFsData%NPTE = SrcActiveDOFsData%NPTE + DstActiveDOFsData%NPTTE = SrcActiveDOFsData%NPTTE +IF (ALLOCATED(SrcActiveDOFsData%NPSBE)) THEN + i1_l = LBOUND(SrcActiveDOFsData%NPSBE,1) + i1_u = UBOUND(SrcActiveDOFsData%NPSBE,1) + IF (.NOT. ALLOCATED(DstActiveDOFsData%NPSBE)) THEN + ALLOCATE(DstActiveDOFsData%NPSBE(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%NPSBE.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! n1 allocated yes/no - IF ( ALLOCATED(InData%n1) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! n1 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%n1) ! n1 - END IF - Int_BufSz = Int_BufSz + 1 ! n2 allocated yes/no - IF ( ALLOCATED(InData%n2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! n2 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%n2) ! n2 - END IF - Int_BufSz = Int_BufSz + 1 ! n3 allocated yes/no - IF ( ALLOCATED(InData%n3) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! n3 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%n3) ! n3 - END IF - Db_BufSz = Db_BufSz + SIZE(InData%rf1) ! rf1 - Db_BufSz = Db_BufSz + SIZE(InData%rf2) ! rf2 - Db_BufSz = Db_BufSz + SIZE(InData%rf3) ! rf3 - Db_BufSz = Db_BufSz + SIZE(InData%rfa) ! rfa - Int_BufSz = Int_BufSz + 1 ! t1 allocated yes/no - IF ( ALLOCATED(InData%t1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! t1 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%t1) ! t1 - END IF - Int_BufSz = Int_BufSz + 1 ! t2 allocated yes/no - IF ( ALLOCATED(InData%t2) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! t2 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%t2) ! t2 - END IF - Int_BufSz = Int_BufSz + 1 ! t3 allocated yes/no - IF ( ALLOCATED(InData%t3) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! t3 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%t3) ! t3 - END IF - Int_BufSz = Int_BufSz + 1 ! te1 allocated yes/no - IF ( ALLOCATED(InData%te1) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! te1 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%te1) ! te1 - END IF - Int_BufSz = Int_BufSz + 1 ! te2 allocated yes/no - IF ( ALLOCATED(InData%te2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! te2 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%te2) ! te2 - END IF - Int_BufSz = Int_BufSz + 1 ! te3 allocated yes/no - IF ( ALLOCATED(InData%te3) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! te3 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%te3) ! te3 - END IF - Db_BufSz = Db_BufSz + SIZE(InData%tf1) ! tf1 - Db_BufSz = Db_BufSz + SIZE(InData%tf2) ! tf2 - Db_BufSz = Db_BufSz + SIZE(InData%tf3) ! tf3 - Db_BufSz = Db_BufSz + SIZE(InData%tfa) ! tfa - Db_BufSz = Db_BufSz + SIZE(InData%z1) ! z1 - Db_BufSz = Db_BufSz + SIZE(InData%z2) ! z2 - Db_BufSz = Db_BufSz + SIZE(InData%z3) ! z3 - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i1 = LBOUND(InData%a1,1), UBOUND(InData%a1,1) - DbKiBuf(Db_Xferred) = InData%a1(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%a2,1), UBOUND(InData%a2,1) - DbKiBuf(Db_Xferred) = InData%a2(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%a3,1), UBOUND(InData%a3,1) - DbKiBuf(Db_Xferred) = InData%a3(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%b1,1), UBOUND(InData%b1,1) - DbKiBuf(Db_Xferred) = InData%b1(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%b2,1), UBOUND(InData%b2,1) - DbKiBuf(Db_Xferred) = InData%b2(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%b3,1), UBOUND(InData%b3,1) - DbKiBuf(Db_Xferred) = InData%b3(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%c1,1), UBOUND(InData%c1,1) - DbKiBuf(Db_Xferred) = InData%c1(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%c2,1), UBOUND(InData%c2,1) - DbKiBuf(Db_Xferred) = InData%c2(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%c3,1), UBOUND(InData%c3,1) - DbKiBuf(Db_Xferred) = InData%c3(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%d1,1), UBOUND(InData%d1,1) - DbKiBuf(Db_Xferred) = InData%d1(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%d2,1), UBOUND(InData%d2,1) - DbKiBuf(Db_Xferred) = InData%d2(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%d3,1), UBOUND(InData%d3,1) - DbKiBuf(Db_Xferred) = InData%d3(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%e1,1), UBOUND(InData%e1,1) - DbKiBuf(Db_Xferred) = InData%e1(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%e2,1), UBOUND(InData%e2,1) - DbKiBuf(Db_Xferred) = InData%e2(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%e3,1), UBOUND(InData%e3,1) - DbKiBuf(Db_Xferred) = InData%e3(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%f1,1), UBOUND(InData%f1,1) - DbKiBuf(Db_Xferred) = InData%f1(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%f2,1), UBOUND(InData%f2,1) - DbKiBuf(Db_Xferred) = InData%f2(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%f3,1), UBOUND(InData%f3,1) - DbKiBuf(Db_Xferred) = InData%f3(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%g1,1), UBOUND(InData%g1,1) - DbKiBuf(Db_Xferred) = InData%g1(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%g2,1), UBOUND(InData%g2,1) - DbKiBuf(Db_Xferred) = InData%g2(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%g3,1), UBOUND(InData%g3,1) - DbKiBuf(Db_Xferred) = InData%g3(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%i1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%i1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%i1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%i1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%i1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%i1,2), UBOUND(InData%i1,2) - DO i1 = LBOUND(InData%i1,1), UBOUND(InData%i1,1) - DbKiBuf(Db_Xferred) = InData%i1(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%i2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%i2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%i2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%i2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%i2,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%i2,2), UBOUND(InData%i2,2) - DO i1 = LBOUND(InData%i2,1), UBOUND(InData%i2,1) - DbKiBuf(Db_Xferred) = InData%i2(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%i3) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%i3,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%i3,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%i3,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%i3,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%i3,2), UBOUND(InData%i3,2) - DO i1 = LBOUND(InData%i3,1), UBOUND(InData%i3,1) - DbKiBuf(Db_Xferred) = InData%i3(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%j1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%j1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%j1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%j1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%j1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%j1,2), UBOUND(InData%j1,2) - DO i1 = LBOUND(InData%j1,1), UBOUND(InData%j1,1) - DbKiBuf(Db_Xferred) = InData%j1(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%j2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%j2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%j2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%j2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%j2,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%j2,2), UBOUND(InData%j2,2) - DO i1 = LBOUND(InData%j2,1), UBOUND(InData%j2,1) - DbKiBuf(Db_Xferred) = InData%j2(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%j3) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%j3,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%j3,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%j3,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%j3,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%j3,2), UBOUND(InData%j3,2) - DO i1 = LBOUND(InData%j3,1), UBOUND(InData%j3,1) - DbKiBuf(Db_Xferred) = InData%j3(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%m1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%m1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%m1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m1,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%m1,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m1,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%m1,3), UBOUND(InData%m1,3) - DO i2 = LBOUND(InData%m1,2), UBOUND(InData%m1,2) - DO i1 = LBOUND(InData%m1,1), UBOUND(InData%m1,1) - DbKiBuf(Db_Xferred) = InData%m1(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%m2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%m2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%m2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%m2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%m2,3), UBOUND(InData%m2,3) - DO i2 = LBOUND(InData%m2,2), UBOUND(InData%m2,2) - DO i1 = LBOUND(InData%m2,1), UBOUND(InData%m2,1) - DbKiBuf(Db_Xferred) = InData%m2(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%m3) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%m3,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m3,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%m3,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m3,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%m3,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m3,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%m3,3), UBOUND(InData%m3,3) - DO i2 = LBOUND(InData%m3,2), UBOUND(InData%m3,2) - DO i1 = LBOUND(InData%m3,1), UBOUND(InData%m3,1) - DbKiBuf(Db_Xferred) = InData%m3(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%n1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%n1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%n1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n1,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%n1,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n1,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%n1,3), UBOUND(InData%n1,3) - DO i2 = LBOUND(InData%n1,2), UBOUND(InData%n1,2) - DO i1 = LBOUND(InData%n1,1), UBOUND(InData%n1,1) - DbKiBuf(Db_Xferred) = InData%n1(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%n2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%n2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%n2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%n2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%n2,3), UBOUND(InData%n2,3) - DO i2 = LBOUND(InData%n2,2), UBOUND(InData%n2,2) - DO i1 = LBOUND(InData%n2,1), UBOUND(InData%n2,1) - DbKiBuf(Db_Xferred) = InData%n2(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%n3) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%n3,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n3,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%n3,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n3,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%n3,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n3,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%n3,3), UBOUND(InData%n3,3) - DO i2 = LBOUND(InData%n3,2), UBOUND(InData%n3,2) - DO i1 = LBOUND(InData%n3,1), UBOUND(InData%n3,1) - DbKiBuf(Db_Xferred) = InData%n3(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%rf1,1), UBOUND(InData%rf1,1) - DbKiBuf(Db_Xferred) = InData%rf1(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rf2,1), UBOUND(InData%rf2,1) - DbKiBuf(Db_Xferred) = InData%rf2(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rf3,1), UBOUND(InData%rf3,1) - DbKiBuf(Db_Xferred) = InData%rf3(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rfa,1), UBOUND(InData%rfa,1) - DbKiBuf(Db_Xferred) = InData%rfa(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%t1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%t1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%t1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%t1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%t1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%t1,2), UBOUND(InData%t1,2) - DO i1 = LBOUND(InData%t1,1), UBOUND(InData%t1,1) - DbKiBuf(Db_Xferred) = InData%t1(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%t2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%t2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%t2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%t2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%t2,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%t2,2), UBOUND(InData%t2,2) - DO i1 = LBOUND(InData%t2,1), UBOUND(InData%t2,1) - DbKiBuf(Db_Xferred) = InData%t2(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%t3) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%t3,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%t3,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%t3,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%t3,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%t3,2), UBOUND(InData%t3,2) - DO i1 = LBOUND(InData%t3,1), UBOUND(InData%t3,1) - DbKiBuf(Db_Xferred) = InData%t3(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%te1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%te1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%te1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%te1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%te1,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%te1,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%te1,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%te1,3), UBOUND(InData%te1,3) - DO i2 = LBOUND(InData%te1,2), UBOUND(InData%te1,2) - DO i1 = LBOUND(InData%te1,1), UBOUND(InData%te1,1) - DbKiBuf(Db_Xferred) = InData%te1(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%te2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%te2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%te2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%te2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%te2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%te2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%te2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%te2,3), UBOUND(InData%te2,3) - DO i2 = LBOUND(InData%te2,2), UBOUND(InData%te2,2) - DO i1 = LBOUND(InData%te2,1), UBOUND(InData%te2,1) - DbKiBuf(Db_Xferred) = InData%te2(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%te3) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%te3,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%te3,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%te3,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%te3,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%te3,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%te3,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%te3,3), UBOUND(InData%te3,3) - DO i2 = LBOUND(InData%te3,2), UBOUND(InData%te3,2) - DO i1 = LBOUND(InData%te3,1), UBOUND(InData%te3,1) - DbKiBuf(Db_Xferred) = InData%te3(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%tf1,1), UBOUND(InData%tf1,1) - DbKiBuf(Db_Xferred) = InData%tf1(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%tf2,1), UBOUND(InData%tf2,1) - DbKiBuf(Db_Xferred) = InData%tf2(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%tf3,1), UBOUND(InData%tf3,1) - DbKiBuf(Db_Xferred) = InData%tf3(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%tfa,1), UBOUND(InData%tfa,1) - DbKiBuf(Db_Xferred) = InData%tfa(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%z1,1), UBOUND(InData%z1,1) - DbKiBuf(Db_Xferred) = InData%z1(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%z2,1), UBOUND(InData%z2,1) - DbKiBuf(Db_Xferred) = InData%z2(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%z3,1), UBOUND(InData%z3,1) - DbKiBuf(Db_Xferred) = InData%z3(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE ED_PackCoordSys - - SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ED_CoordSys), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_UnPackCoordSys' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%a1,1) - i1_u = UBOUND(OutData%a1,1) - DO i1 = LBOUND(OutData%a1,1), UBOUND(OutData%a1,1) - OutData%a1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%a2,1) - i1_u = UBOUND(OutData%a2,1) - DO i1 = LBOUND(OutData%a2,1), UBOUND(OutData%a2,1) - OutData%a2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%a3,1) - i1_u = UBOUND(OutData%a3,1) - DO i1 = LBOUND(OutData%a3,1), UBOUND(OutData%a3,1) - OutData%a3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%b1,1) - i1_u = UBOUND(OutData%b1,1) - DO i1 = LBOUND(OutData%b1,1), UBOUND(OutData%b1,1) - OutData%b1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%b2,1) - i1_u = UBOUND(OutData%b2,1) - DO i1 = LBOUND(OutData%b2,1), UBOUND(OutData%b2,1) - OutData%b2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%b3,1) - i1_u = UBOUND(OutData%b3,1) - DO i1 = LBOUND(OutData%b3,1), UBOUND(OutData%b3,1) - OutData%b3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%c1,1) - i1_u = UBOUND(OutData%c1,1) - DO i1 = LBOUND(OutData%c1,1), UBOUND(OutData%c1,1) - OutData%c1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%c2,1) - i1_u = UBOUND(OutData%c2,1) - DO i1 = LBOUND(OutData%c2,1), UBOUND(OutData%c2,1) - OutData%c2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%c3,1) - i1_u = UBOUND(OutData%c3,1) - DO i1 = LBOUND(OutData%c3,1), UBOUND(OutData%c3,1) - OutData%c3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%d1,1) - i1_u = UBOUND(OutData%d1,1) - DO i1 = LBOUND(OutData%d1,1), UBOUND(OutData%d1,1) - OutData%d1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%d2,1) - i1_u = UBOUND(OutData%d2,1) - DO i1 = LBOUND(OutData%d2,1), UBOUND(OutData%d2,1) - OutData%d2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%d3,1) - i1_u = UBOUND(OutData%d3,1) - DO i1 = LBOUND(OutData%d3,1), UBOUND(OutData%d3,1) - OutData%d3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%e1,1) - i1_u = UBOUND(OutData%e1,1) - DO i1 = LBOUND(OutData%e1,1), UBOUND(OutData%e1,1) - OutData%e1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%e2,1) - i1_u = UBOUND(OutData%e2,1) - DO i1 = LBOUND(OutData%e2,1), UBOUND(OutData%e2,1) - OutData%e2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%e3,1) - i1_u = UBOUND(OutData%e3,1) - DO i1 = LBOUND(OutData%e3,1), UBOUND(OutData%e3,1) - OutData%e3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%f1,1) - i1_u = UBOUND(OutData%f1,1) - DO i1 = LBOUND(OutData%f1,1), UBOUND(OutData%f1,1) - OutData%f1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%f2,1) - i1_u = UBOUND(OutData%f2,1) - DO i1 = LBOUND(OutData%f2,1), UBOUND(OutData%f2,1) - OutData%f2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%f3,1) - i1_u = UBOUND(OutData%f3,1) - DO i1 = LBOUND(OutData%f3,1), UBOUND(OutData%f3,1) - OutData%f3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%g1,1) - i1_u = UBOUND(OutData%g1,1) - DO i1 = LBOUND(OutData%g1,1), UBOUND(OutData%g1,1) - OutData%g1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%g2,1) - i1_u = UBOUND(OutData%g2,1) - DO i1 = LBOUND(OutData%g2,1), UBOUND(OutData%g2,1) - OutData%g2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%g3,1) - i1_u = UBOUND(OutData%g3,1) - DO i1 = LBOUND(OutData%g3,1), UBOUND(OutData%g3,1) - OutData%g3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! i1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%i1)) DEALLOCATE(OutData%i1) - ALLOCATE(OutData%i1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%i1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%i1,2), UBOUND(OutData%i1,2) - DO i1 = LBOUND(OutData%i1,1), UBOUND(OutData%i1,1) - OutData%i1(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! i2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%i2)) DEALLOCATE(OutData%i2) - ALLOCATE(OutData%i2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%i2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%i2,2), UBOUND(OutData%i2,2) - DO i1 = LBOUND(OutData%i2,1), UBOUND(OutData%i2,1) - OutData%i2(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! i3 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%i3)) DEALLOCATE(OutData%i3) - ALLOCATE(OutData%i3(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%i3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%i3,2), UBOUND(OutData%i3,2) - DO i1 = LBOUND(OutData%i3,1), UBOUND(OutData%i3,1) - OutData%i3(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! j1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%j1)) DEALLOCATE(OutData%j1) - ALLOCATE(OutData%j1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%j1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%j1,2), UBOUND(OutData%j1,2) - DO i1 = LBOUND(OutData%j1,1), UBOUND(OutData%j1,1) - OutData%j1(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! j2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%j2)) DEALLOCATE(OutData%j2) - ALLOCATE(OutData%j2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%j2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%j2,2), UBOUND(OutData%j2,2) - DO i1 = LBOUND(OutData%j2,1), UBOUND(OutData%j2,1) - OutData%j2(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! j3 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%j3)) DEALLOCATE(OutData%j3) - ALLOCATE(OutData%j3(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%j3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%j3,2), UBOUND(OutData%j3,2) - DO i1 = LBOUND(OutData%j3,1), UBOUND(OutData%j3,1) - OutData%j3(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! m1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%m1)) DEALLOCATE(OutData%m1) - ALLOCATE(OutData%m1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%m1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%m1,3), UBOUND(OutData%m1,3) - DO i2 = LBOUND(OutData%m1,2), UBOUND(OutData%m1,2) - DO i1 = LBOUND(OutData%m1,1), UBOUND(OutData%m1,1) - OutData%m1(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! m2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%m2)) DEALLOCATE(OutData%m2) - ALLOCATE(OutData%m2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%m2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%m2,3), UBOUND(OutData%m2,3) - DO i2 = LBOUND(OutData%m2,2), UBOUND(OutData%m2,2) - DO i1 = LBOUND(OutData%m2,1), UBOUND(OutData%m2,1) - OutData%m2(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! m3 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%m3)) DEALLOCATE(OutData%m3) - ALLOCATE(OutData%m3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%m3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%m3,3), UBOUND(OutData%m3,3) - DO i2 = LBOUND(OutData%m3,2), UBOUND(OutData%m3,2) - DO i1 = LBOUND(OutData%m3,1), UBOUND(OutData%m3,1) - OutData%m3(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! n1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%n1)) DEALLOCATE(OutData%n1) - ALLOCATE(OutData%n1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%n1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%n1,3), UBOUND(OutData%n1,3) - DO i2 = LBOUND(OutData%n1,2), UBOUND(OutData%n1,2) - DO i1 = LBOUND(OutData%n1,1), UBOUND(OutData%n1,1) - OutData%n1(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! n2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%n2)) DEALLOCATE(OutData%n2) - ALLOCATE(OutData%n2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%n2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%n2,3), UBOUND(OutData%n2,3) - DO i2 = LBOUND(OutData%n2,2), UBOUND(OutData%n2,2) - DO i1 = LBOUND(OutData%n2,1), UBOUND(OutData%n2,1) - OutData%n2(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! n3 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%n3)) DEALLOCATE(OutData%n3) - ALLOCATE(OutData%n3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%n3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%n3,3), UBOUND(OutData%n3,3) - DO i2 = LBOUND(OutData%n3,2), UBOUND(OutData%n3,2) - DO i1 = LBOUND(OutData%n3,1), UBOUND(OutData%n3,1) - OutData%n3(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%rf1,1) - i1_u = UBOUND(OutData%rf1,1) - DO i1 = LBOUND(OutData%rf1,1), UBOUND(OutData%rf1,1) - OutData%rf1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rf2,1) - i1_u = UBOUND(OutData%rf2,1) - DO i1 = LBOUND(OutData%rf2,1), UBOUND(OutData%rf2,1) - OutData%rf2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rf3,1) - i1_u = UBOUND(OutData%rf3,1) - DO i1 = LBOUND(OutData%rf3,1), UBOUND(OutData%rf3,1) - OutData%rf3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rfa,1) - i1_u = UBOUND(OutData%rfa,1) - DO i1 = LBOUND(OutData%rfa,1), UBOUND(OutData%rfa,1) - OutData%rfa(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! t1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%t1)) DEALLOCATE(OutData%t1) - ALLOCATE(OutData%t1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%t1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%t1,2), UBOUND(OutData%t1,2) - DO i1 = LBOUND(OutData%t1,1), UBOUND(OutData%t1,1) - OutData%t1(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! t2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%t2)) DEALLOCATE(OutData%t2) - ALLOCATE(OutData%t2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%t2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%t2,2), UBOUND(OutData%t2,2) - DO i1 = LBOUND(OutData%t2,1), UBOUND(OutData%t2,1) - OutData%t2(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! t3 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%t3)) DEALLOCATE(OutData%t3) - ALLOCATE(OutData%t3(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%t3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%t3,2), UBOUND(OutData%t3,2) - DO i1 = LBOUND(OutData%t3,1), UBOUND(OutData%t3,1) - OutData%t3(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! te1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%te1)) DEALLOCATE(OutData%te1) - ALLOCATE(OutData%te1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%te1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%te1,3), UBOUND(OutData%te1,3) - DO i2 = LBOUND(OutData%te1,2), UBOUND(OutData%te1,2) - DO i1 = LBOUND(OutData%te1,1), UBOUND(OutData%te1,1) - OutData%te1(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! te2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%te2)) DEALLOCATE(OutData%te2) - ALLOCATE(OutData%te2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%te2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%te2,3), UBOUND(OutData%te2,3) - DO i2 = LBOUND(OutData%te2,2), UBOUND(OutData%te2,2) - DO i1 = LBOUND(OutData%te2,1), UBOUND(OutData%te2,1) - OutData%te2(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! te3 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%te3)) DEALLOCATE(OutData%te3) - ALLOCATE(OutData%te3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%te3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%te3,3), UBOUND(OutData%te3,3) - DO i2 = LBOUND(OutData%te3,2), UBOUND(OutData%te3,2) - DO i1 = LBOUND(OutData%te3,1), UBOUND(OutData%te3,1) - OutData%te3(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%tf1,1) - i1_u = UBOUND(OutData%tf1,1) - DO i1 = LBOUND(OutData%tf1,1), UBOUND(OutData%tf1,1) - OutData%tf1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%tf2,1) - i1_u = UBOUND(OutData%tf2,1) - DO i1 = LBOUND(OutData%tf2,1), UBOUND(OutData%tf2,1) - OutData%tf2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%tf3,1) - i1_u = UBOUND(OutData%tf3,1) - DO i1 = LBOUND(OutData%tf3,1), UBOUND(OutData%tf3,1) - OutData%tf3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%tfa,1) - i1_u = UBOUND(OutData%tfa,1) - DO i1 = LBOUND(OutData%tfa,1), UBOUND(OutData%tfa,1) - OutData%tfa(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%z1,1) - i1_u = UBOUND(OutData%z1,1) - DO i1 = LBOUND(OutData%z1,1), UBOUND(OutData%z1,1) - OutData%z1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%z2,1) - i1_u = UBOUND(OutData%z2,1) - DO i1 = LBOUND(OutData%z2,1), UBOUND(OutData%z2,1) - OutData%z2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%z3,1) - i1_u = UBOUND(OutData%z3,1) - DO i1 = LBOUND(OutData%z3,1), UBOUND(OutData%z3,1) - OutData%z3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE ED_UnPackCoordSys - - SUBROUTINE ED_CopyActiveDOFs( SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_ActiveDOFs), INTENT(IN) :: SrcActiveDOFsData - TYPE(ED_ActiveDOFs), INTENT(INOUT) :: DstActiveDOFsData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_CopyActiveDOFs' -! - ErrStat = ErrID_None - ErrMsg = "" - DstActiveDOFsData%NActvDOF = SrcActiveDOFsData%NActvDOF - DstActiveDOFsData%NPCE = SrcActiveDOFsData%NPCE - DstActiveDOFsData%NPDE = SrcActiveDOFsData%NPDE - DstActiveDOFsData%NPIE = SrcActiveDOFsData%NPIE - DstActiveDOFsData%NPTE = SrcActiveDOFsData%NPTE - DstActiveDOFsData%NPTTE = SrcActiveDOFsData%NPTTE -IF (ALLOCATED(SrcActiveDOFsData%NPSBE)) THEN - i1_l = LBOUND(SrcActiveDOFsData%NPSBE,1) - i1_u = UBOUND(SrcActiveDOFsData%NPSBE,1) - IF (.NOT. ALLOCATED(DstActiveDOFsData%NPSBE)) THEN - ALLOCATE(DstActiveDOFsData%NPSBE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%NPSBE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstActiveDOFsData%NPSBE = SrcActiveDOFsData%NPSBE -ENDIF -IF (ALLOCATED(SrcActiveDOFsData%NPSE)) THEN - i1_l = LBOUND(SrcActiveDOFsData%NPSE,1) - i1_u = UBOUND(SrcActiveDOFsData%NPSE,1) - IF (.NOT. ALLOCATED(DstActiveDOFsData%NPSE)) THEN - ALLOCATE(DstActiveDOFsData%NPSE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%NPSE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + DstActiveDOFsData%NPSBE = SrcActiveDOFsData%NPSBE +ENDIF +IF (ALLOCATED(SrcActiveDOFsData%NPSE)) THEN + i1_l = LBOUND(SrcActiveDOFsData%NPSE,1) + i1_u = UBOUND(SrcActiveDOFsData%NPSE,1) + IF (.NOT. ALLOCATED(DstActiveDOFsData%NPSE)) THEN + ALLOCATE(DstActiveDOFsData%NPSE(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%NPSE.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF DstActiveDOFsData%NPSE = SrcActiveDOFsData%NPSE ENDIF @@ -7074,730 +5016,401 @@ SUBROUTINE ED_DestroyActiveDOFs( ActiveDOFsData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE ED_DestroyActiveDOFs - SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ED_ActiveDOFs), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_PackActiveDOFs' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! NActvDOF - Int_BufSz = Int_BufSz + 1 ! NPCE - Int_BufSz = Int_BufSz + 1 ! NPDE - Int_BufSz = Int_BufSz + 1 ! NPIE - Int_BufSz = Int_BufSz + 1 ! NPTE - Int_BufSz = Int_BufSz + 1 ! NPTTE - Int_BufSz = Int_BufSz + 1 ! NPSBE allocated yes/no - IF ( ALLOCATED(InData%NPSBE) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NPSBE upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NPSBE) ! NPSBE - END IF - Int_BufSz = Int_BufSz + 1 ! NPSE allocated yes/no - IF ( ALLOCATED(InData%NPSE) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NPSE upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NPSE) ! NPSE - END IF - Int_BufSz = Int_BufSz + 1 ! NPUE - Int_BufSz = Int_BufSz + 1 ! NPYE - Int_BufSz = Int_BufSz + 1 ! PCE allocated yes/no - IF ( ALLOCATED(InData%PCE) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PCE upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%PCE) ! PCE - END IF - Int_BufSz = Int_BufSz + 1 ! PDE allocated yes/no - IF ( ALLOCATED(InData%PDE) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PDE upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%PDE) ! PDE - END IF - Int_BufSz = Int_BufSz + 1 ! PIE allocated yes/no - IF ( ALLOCATED(InData%PIE) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PIE upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%PIE) ! PIE - END IF - Int_BufSz = Int_BufSz + 1 ! PTE allocated yes/no - IF ( ALLOCATED(InData%PTE) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PTE upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%PTE) ! PTE - END IF - Int_BufSz = Int_BufSz + 1 ! PTTE allocated yes/no - IF ( ALLOCATED(InData%PTTE) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PTTE upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%PTTE) ! PTTE - END IF - Int_BufSz = Int_BufSz + 1 ! PS allocated yes/no - IF ( ALLOCATED(InData%PS) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PS upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%PS) ! PS - END IF - Int_BufSz = Int_BufSz + 1 ! PSBE allocated yes/no - IF ( ALLOCATED(InData%PSBE) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PSBE upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%PSBE) ! PSBE - END IF - Int_BufSz = Int_BufSz + 1 ! PSE allocated yes/no - IF ( ALLOCATED(InData%PSE) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PSE upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%PSE) ! PSE - END IF - Int_BufSz = Int_BufSz + 1 ! PUE allocated yes/no - IF ( ALLOCATED(InData%PUE) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PUE upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%PUE) ! PUE - END IF - Int_BufSz = Int_BufSz + 1 ! PYE allocated yes/no - IF ( ALLOCATED(InData%PYE) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PYE upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%PYE) ! PYE - END IF - Int_BufSz = Int_BufSz + 1 ! SrtPS allocated yes/no - IF ( ALLOCATED(InData%SrtPS) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SrtPS upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%SrtPS) ! SrtPS - END IF - Int_BufSz = Int_BufSz + 1 ! SrtPSNAUG allocated yes/no - IF ( ALLOCATED(InData%SrtPSNAUG) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SrtPSNAUG upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%SrtPSNAUG) ! SrtPSNAUG - END IF - Int_BufSz = Int_BufSz + 1 ! Diag allocated yes/no - IF ( ALLOCATED(InData%Diag) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Diag upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Diag) ! Diag - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%NActvDOF - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPCE - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPDE - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPIE - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPTE - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPTTE - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%NPSBE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NPSBE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NPSBE,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NPSBE,1), UBOUND(InData%NPSBE,1) - IntKiBuf(Int_Xferred) = InData%NPSBE(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NPSE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NPSE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NPSE,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NPSE,1), UBOUND(InData%NPSE,1) - IntKiBuf(Int_Xferred) = InData%NPSE(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NPUE - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPYE - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%PCE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PCE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PCE,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PCE,1), UBOUND(InData%PCE,1) - IntKiBuf(Int_Xferred) = InData%PCE(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PDE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PDE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PDE,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PDE,1), UBOUND(InData%PDE,1) - IntKiBuf(Int_Xferred) = InData%PDE(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PIE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PIE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PIE,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PIE,1), UBOUND(InData%PIE,1) - IntKiBuf(Int_Xferred) = InData%PIE(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PTE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PTE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PTE,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PTE,1), UBOUND(InData%PTE,1) - IntKiBuf(Int_Xferred) = InData%PTE(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PTTE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PTTE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PTTE,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PTTE,1), UBOUND(InData%PTTE,1) - IntKiBuf(Int_Xferred) = InData%PTTE(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PS) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PS,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PS,1), UBOUND(InData%PS,1) - IntKiBuf(Int_Xferred) = InData%PS(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PSBE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PSBE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PSBE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PSBE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PSBE,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PSBE,2), UBOUND(InData%PSBE,2) - DO i1 = LBOUND(InData%PSBE,1), UBOUND(InData%PSBE,1) - IntKiBuf(Int_Xferred) = InData%PSBE(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PSE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PSE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PSE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PSE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PSE,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PSE,2), UBOUND(InData%PSE,2) - DO i1 = LBOUND(InData%PSE,1), UBOUND(InData%PSE,1) - IntKiBuf(Int_Xferred) = InData%PSE(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PUE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PUE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PUE,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PUE,1), UBOUND(InData%PUE,1) - IntKiBuf(Int_Xferred) = InData%PUE(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PYE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PYE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PYE,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PYE,1), UBOUND(InData%PYE,1) - IntKiBuf(Int_Xferred) = InData%PYE(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SrtPS) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SrtPS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SrtPS,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SrtPS,1), UBOUND(InData%SrtPS,1) - IntKiBuf(Int_Xferred) = InData%SrtPS(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SrtPSNAUG) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SrtPSNAUG,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SrtPSNAUG,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SrtPSNAUG,1), UBOUND(InData%SrtPSNAUG,1) - IntKiBuf(Int_Xferred) = InData%SrtPSNAUG(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Diag) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Diag,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Diag,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Diag,1), UBOUND(InData%Diag,1) - IntKiBuf(Int_Xferred) = InData%Diag(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE ED_PackActiveDOFs - - SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ED_ActiveDOFs), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_UnPackActiveDOFs' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%NActvDOF = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPCE = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPDE = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPIE = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPTE = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPTTE = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NPSBE not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NPSBE)) DEALLOCATE(OutData%NPSBE) - ALLOCATE(OutData%NPSBE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NPSBE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NPSBE,1), UBOUND(OutData%NPSBE,1) - OutData%NPSBE(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NPSE not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NPSE)) DEALLOCATE(OutData%NPSE) - ALLOCATE(OutData%NPSE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NPSE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NPSE,1), UBOUND(OutData%NPSE,1) - OutData%NPSE(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%NPUE = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPYE = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PCE not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PCE)) DEALLOCATE(OutData%PCE) - ALLOCATE(OutData%PCE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PCE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PCE,1), UBOUND(OutData%PCE,1) - OutData%PCE(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PDE not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PDE)) DEALLOCATE(OutData%PDE) - ALLOCATE(OutData%PDE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PDE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PDE,1), UBOUND(OutData%PDE,1) - OutData%PDE(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PIE not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PIE)) DEALLOCATE(OutData%PIE) - ALLOCATE(OutData%PIE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PIE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PIE,1), UBOUND(OutData%PIE,1) - OutData%PIE(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PTE not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PTE)) DEALLOCATE(OutData%PTE) - ALLOCATE(OutData%PTE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PTE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PTE,1), UBOUND(OutData%PTE,1) - OutData%PTE(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PTTE not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PTTE)) DEALLOCATE(OutData%PTTE) - ALLOCATE(OutData%PTTE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PTTE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PTTE,1), UBOUND(OutData%PTTE,1) - OutData%PTTE(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PS not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PS)) DEALLOCATE(OutData%PS) - ALLOCATE(OutData%PS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PS,1), UBOUND(OutData%PS,1) - OutData%PS(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PSBE not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PSBE)) DEALLOCATE(OutData%PSBE) - ALLOCATE(OutData%PSBE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PSBE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PSBE,2), UBOUND(OutData%PSBE,2) - DO i1 = LBOUND(OutData%PSBE,1), UBOUND(OutData%PSBE,1) - OutData%PSBE(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PSE not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PSE)) DEALLOCATE(OutData%PSE) - ALLOCATE(OutData%PSE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PSE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PSE,2), UBOUND(OutData%PSE,2) - DO i1 = LBOUND(OutData%PSE,1), UBOUND(OutData%PSE,1) - OutData%PSE(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PUE not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PUE)) DEALLOCATE(OutData%PUE) - ALLOCATE(OutData%PUE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PUE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PUE,1), UBOUND(OutData%PUE,1) - OutData%PUE(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PYE not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PYE)) DEALLOCATE(OutData%PYE) - ALLOCATE(OutData%PYE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PYE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PYE,1), UBOUND(OutData%PYE,1) - OutData%PYE(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SrtPS not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SrtPS)) DEALLOCATE(OutData%SrtPS) - ALLOCATE(OutData%SrtPS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SrtPS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SrtPS,1), UBOUND(OutData%SrtPS,1) - OutData%SrtPS(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SrtPSNAUG not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SrtPSNAUG)) DEALLOCATE(OutData%SrtPSNAUG) - ALLOCATE(OutData%SrtPSNAUG(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SrtPSNAUG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SrtPSNAUG,1), UBOUND(OutData%SrtPSNAUG,1) - OutData%SrtPSNAUG(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Diag not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Diag)) DEALLOCATE(OutData%Diag) - ALLOCATE(OutData%Diag(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Diag.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Diag,1), UBOUND(OutData%Diag,1) - OutData%Diag(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE ED_UnPackActiveDOFs +subroutine ED_PackActiveDOFs(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ED_ActiveDOFs), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackActiveDOFs' + if (Buf%ErrStat >= AbortErrLev) return + ! NActvDOF + call RegPack(Buf, InData%NActvDOF) + if (RegCheckErr(Buf, RoutineName)) return + ! NPCE + call RegPack(Buf, InData%NPCE) + if (RegCheckErr(Buf, RoutineName)) return + ! NPDE + call RegPack(Buf, InData%NPDE) + if (RegCheckErr(Buf, RoutineName)) return + ! NPIE + call RegPack(Buf, InData%NPIE) + if (RegCheckErr(Buf, RoutineName)) return + ! NPTE + call RegPack(Buf, InData%NPTE) + if (RegCheckErr(Buf, RoutineName)) return + ! NPTTE + call RegPack(Buf, InData%NPTTE) + if (RegCheckErr(Buf, RoutineName)) return + ! NPSBE + call RegPack(Buf, allocated(InData%NPSBE)) + if (allocated(InData%NPSBE)) then + call RegPackBounds(Buf, 1, lbound(InData%NPSBE), ubound(InData%NPSBE)) + call RegPack(Buf, InData%NPSBE) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NPSE + call RegPack(Buf, allocated(InData%NPSE)) + if (allocated(InData%NPSE)) then + call RegPackBounds(Buf, 1, lbound(InData%NPSE), ubound(InData%NPSE)) + call RegPack(Buf, InData%NPSE) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NPUE + call RegPack(Buf, InData%NPUE) + if (RegCheckErr(Buf, RoutineName)) return + ! NPYE + call RegPack(Buf, InData%NPYE) + if (RegCheckErr(Buf, RoutineName)) return + ! PCE + call RegPack(Buf, allocated(InData%PCE)) + if (allocated(InData%PCE)) then + call RegPackBounds(Buf, 1, lbound(InData%PCE), ubound(InData%PCE)) + call RegPack(Buf, InData%PCE) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PDE + call RegPack(Buf, allocated(InData%PDE)) + if (allocated(InData%PDE)) then + call RegPackBounds(Buf, 1, lbound(InData%PDE), ubound(InData%PDE)) + call RegPack(Buf, InData%PDE) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PIE + call RegPack(Buf, allocated(InData%PIE)) + if (allocated(InData%PIE)) then + call RegPackBounds(Buf, 1, lbound(InData%PIE), ubound(InData%PIE)) + call RegPack(Buf, InData%PIE) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PTE + call RegPack(Buf, allocated(InData%PTE)) + if (allocated(InData%PTE)) then + call RegPackBounds(Buf, 1, lbound(InData%PTE), ubound(InData%PTE)) + call RegPack(Buf, InData%PTE) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PTTE + call RegPack(Buf, allocated(InData%PTTE)) + if (allocated(InData%PTTE)) then + call RegPackBounds(Buf, 1, lbound(InData%PTTE), ubound(InData%PTTE)) + call RegPack(Buf, InData%PTTE) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PS + call RegPack(Buf, allocated(InData%PS)) + if (allocated(InData%PS)) then + call RegPackBounds(Buf, 1, lbound(InData%PS), ubound(InData%PS)) + call RegPack(Buf, InData%PS) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PSBE + call RegPack(Buf, allocated(InData%PSBE)) + if (allocated(InData%PSBE)) then + call RegPackBounds(Buf, 2, lbound(InData%PSBE), ubound(InData%PSBE)) + call RegPack(Buf, InData%PSBE) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PSE + call RegPack(Buf, allocated(InData%PSE)) + if (allocated(InData%PSE)) then + call RegPackBounds(Buf, 2, lbound(InData%PSE), ubound(InData%PSE)) + call RegPack(Buf, InData%PSE) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PUE + call RegPack(Buf, allocated(InData%PUE)) + if (allocated(InData%PUE)) then + call RegPackBounds(Buf, 1, lbound(InData%PUE), ubound(InData%PUE)) + call RegPack(Buf, InData%PUE) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PYE + call RegPack(Buf, allocated(InData%PYE)) + if (allocated(InData%PYE)) then + call RegPackBounds(Buf, 1, lbound(InData%PYE), ubound(InData%PYE)) + call RegPack(Buf, InData%PYE) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SrtPS + call RegPack(Buf, allocated(InData%SrtPS)) + if (allocated(InData%SrtPS)) then + call RegPackBounds(Buf, 1, lbound(InData%SrtPS), ubound(InData%SrtPS)) + call RegPack(Buf, InData%SrtPS) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SrtPSNAUG + call RegPack(Buf, allocated(InData%SrtPSNAUG)) + if (allocated(InData%SrtPSNAUG)) then + call RegPackBounds(Buf, 1, lbound(InData%SrtPSNAUG), ubound(InData%SrtPSNAUG)) + call RegPack(Buf, InData%SrtPSNAUG) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Diag + call RegPack(Buf, allocated(InData%Diag)) + if (allocated(InData%Diag)) then + call RegPackBounds(Buf, 1, lbound(InData%Diag), ubound(InData%Diag)) + call RegPack(Buf, InData%Diag) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ED_UnPackActiveDOFs(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ED_ActiveDOFs), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackActiveDOFs' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! NActvDOF + call RegUnpack(Buf, OutData%NActvDOF) + if (RegCheckErr(Buf, RoutineName)) return + ! NPCE + call RegUnpack(Buf, OutData%NPCE) + if (RegCheckErr(Buf, RoutineName)) return + ! NPDE + call RegUnpack(Buf, OutData%NPDE) + if (RegCheckErr(Buf, RoutineName)) return + ! NPIE + call RegUnpack(Buf, OutData%NPIE) + if (RegCheckErr(Buf, RoutineName)) return + ! NPTE + call RegUnpack(Buf, OutData%NPTE) + if (RegCheckErr(Buf, RoutineName)) return + ! NPTTE + call RegUnpack(Buf, OutData%NPTTE) + if (RegCheckErr(Buf, RoutineName)) return + ! NPSBE + if (allocated(OutData%NPSBE)) deallocate(OutData%NPSBE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NPSBE(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NPSBE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%NPSBE) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NPSE + if (allocated(OutData%NPSE)) deallocate(OutData%NPSE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NPSE(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NPSE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%NPSE) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NPUE + call RegUnpack(Buf, OutData%NPUE) + if (RegCheckErr(Buf, RoutineName)) return + ! NPYE + call RegUnpack(Buf, OutData%NPYE) + if (RegCheckErr(Buf, RoutineName)) return + ! PCE + if (allocated(OutData%PCE)) deallocate(OutData%PCE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PCE(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PCE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PCE) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PDE + if (allocated(OutData%PDE)) deallocate(OutData%PDE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PDE(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PDE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PDE) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PIE + if (allocated(OutData%PIE)) deallocate(OutData%PIE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PIE(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PIE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PIE) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PTE + if (allocated(OutData%PTE)) deallocate(OutData%PTE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PTE(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PTE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PTE) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PTTE + if (allocated(OutData%PTTE)) deallocate(OutData%PTTE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PTTE(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PTTE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PTTE) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PS + if (allocated(OutData%PS)) deallocate(OutData%PS) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PS(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PS) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PSBE + if (allocated(OutData%PSBE)) deallocate(OutData%PSBE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PSBE(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PSBE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PSBE) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PSE + if (allocated(OutData%PSE)) deallocate(OutData%PSE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PSE(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PSE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PSE) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PUE + if (allocated(OutData%PUE)) deallocate(OutData%PUE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PUE(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PUE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PUE) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PYE + if (allocated(OutData%PYE)) deallocate(OutData%PYE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PYE(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PYE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PYE) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! SrtPS + if (allocated(OutData%SrtPS)) deallocate(OutData%SrtPS) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SrtPS(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SrtPS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SrtPS) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! SrtPSNAUG + if (allocated(OutData%SrtPSNAUG)) deallocate(OutData%SrtPSNAUG) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SrtPSNAUG(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SrtPSNAUG.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SrtPSNAUG) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Diag + if (allocated(OutData%Diag)) deallocate(OutData%Diag) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Diag(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Diag.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Diag) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE ED_CopyRtHndSide( SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrStat, ErrMsg ) TYPE(ED_RtHndSide), INTENT(IN) :: SrcRtHndSideData TYPE(ED_RtHndSide), INTENT(INOUT) :: DstRtHndSideData @@ -9173,11264 +6786,6139 @@ SUBROUTINE ED_DestroyRtHndSide( RtHndSideData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE ED_DestroyRtHndSide - SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ED_RtHndSide), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + +subroutine ED_PackRtHndSide(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ED_RtHndSide), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackRtHndSide' + if (Buf%ErrStat >= AbortErrLev) return + ! rO + call RegPack(Buf, InData%rO) + if (RegCheckErr(Buf, RoutineName)) return + ! rQS + call RegPack(Buf, allocated(InData%rQS)) + if (allocated(InData%rQS)) then + call RegPackBounds(Buf, 3, lbound(InData%rQS), ubound(InData%rQS)) + call RegPack(Buf, InData%rQS) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! rS + call RegPack(Buf, allocated(InData%rS)) + if (allocated(InData%rS)) then + call RegPackBounds(Buf, 3, lbound(InData%rS), ubound(InData%rS)) + call RegPack(Buf, InData%rS) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! rS0S + call RegPack(Buf, allocated(InData%rS0S)) + if (allocated(InData%rS0S)) then + call RegPackBounds(Buf, 3, lbound(InData%rS0S), ubound(InData%rS0S)) + call RegPack(Buf, InData%rS0S) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! rT + call RegPack(Buf, allocated(InData%rT)) + if (allocated(InData%rT)) then + call RegPackBounds(Buf, 2, lbound(InData%rT), ubound(InData%rT)) + call RegPack(Buf, InData%rT) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! rT0O + call RegPack(Buf, InData%rT0O) + if (RegCheckErr(Buf, RoutineName)) return + ! rT0T + call RegPack(Buf, allocated(InData%rT0T)) + if (allocated(InData%rT0T)) then + call RegPackBounds(Buf, 2, lbound(InData%rT0T), ubound(InData%rT0T)) + call RegPack(Buf, InData%rT0T) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! rZ + call RegPack(Buf, InData%rZ) + if (RegCheckErr(Buf, RoutineName)) return + ! rZO + call RegPack(Buf, InData%rZO) + if (RegCheckErr(Buf, RoutineName)) return + ! rZT + call RegPack(Buf, allocated(InData%rZT)) + if (allocated(InData%rZT)) then + call RegPackBounds(Buf, 2, lbound(InData%rZT), ubound(InData%rZT)) + call RegPack(Buf, InData%rZT) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! rPQ + call RegPack(Buf, InData%rPQ) + if (RegCheckErr(Buf, RoutineName)) return + ! rP + call RegPack(Buf, InData%rP) + if (RegCheckErr(Buf, RoutineName)) return + ! rV + call RegPack(Buf, InData%rV) + if (RegCheckErr(Buf, RoutineName)) return + ! rJ + call RegPack(Buf, InData%rJ) + if (RegCheckErr(Buf, RoutineName)) return + ! rZY + call RegPack(Buf, InData%rZY) + if (RegCheckErr(Buf, RoutineName)) return + ! rOU + call RegPack(Buf, InData%rOU) + if (RegCheckErr(Buf, RoutineName)) return + ! rOV + call RegPack(Buf, InData%rOV) + if (RegCheckErr(Buf, RoutineName)) return + ! rVD + call RegPack(Buf, InData%rVD) + if (RegCheckErr(Buf, RoutineName)) return + ! rOW + call RegPack(Buf, InData%rOW) + if (RegCheckErr(Buf, RoutineName)) return + ! rPC + call RegPack(Buf, InData%rPC) + if (RegCheckErr(Buf, RoutineName)) return + ! rPS0 + call RegPack(Buf, allocated(InData%rPS0)) + if (allocated(InData%rPS0)) then + call RegPackBounds(Buf, 2, lbound(InData%rPS0), ubound(InData%rPS0)) + call RegPack(Buf, InData%rPS0) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! rQ + call RegPack(Buf, InData%rQ) + if (RegCheckErr(Buf, RoutineName)) return + ! rQC + call RegPack(Buf, InData%rQC) + if (RegCheckErr(Buf, RoutineName)) return + ! rVIMU + call RegPack(Buf, InData%rVIMU) + if (RegCheckErr(Buf, RoutineName)) return + ! rVP + call RegPack(Buf, InData%rVP) + if (RegCheckErr(Buf, RoutineName)) return + ! rWI + call RegPack(Buf, InData%rWI) + if (RegCheckErr(Buf, RoutineName)) return + ! rWJ + call RegPack(Buf, InData%rWJ) + if (RegCheckErr(Buf, RoutineName)) return + ! rZT0 + call RegPack(Buf, InData%rZT0) + if (RegCheckErr(Buf, RoutineName)) return + ! AngPosEF + call RegPack(Buf, allocated(InData%AngPosEF)) + if (allocated(InData%AngPosEF)) then + call RegPackBounds(Buf, 2, lbound(InData%AngPosEF), ubound(InData%AngPosEF)) + call RegPack(Buf, InData%AngPosEF) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AngPosXF + call RegPack(Buf, allocated(InData%AngPosXF)) + if (allocated(InData%AngPosXF)) then + call RegPackBounds(Buf, 2, lbound(InData%AngPosXF), ubound(InData%AngPosXF)) + call RegPack(Buf, InData%AngPosXF) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AngPosHM + call RegPack(Buf, allocated(InData%AngPosHM)) + if (allocated(InData%AngPosHM)) then + call RegPackBounds(Buf, 3, lbound(InData%AngPosHM), ubound(InData%AngPosHM)) + call RegPack(Buf, InData%AngPosHM) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AngPosXB + call RegPack(Buf, InData%AngPosXB) + if (RegCheckErr(Buf, RoutineName)) return + ! AngPosEX + call RegPack(Buf, InData%AngPosEX) + if (RegCheckErr(Buf, RoutineName)) return + ! PAngVelEA + call RegPack(Buf, allocated(InData%PAngVelEA)) + if (allocated(InData%PAngVelEA)) then + call RegPackBounds(Buf, 3, lbound(InData%PAngVelEA), ubound(InData%PAngVelEA)) + call RegPack(Buf, InData%PAngVelEA) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PAngVelEF + call RegPack(Buf, allocated(InData%PAngVelEF)) + if (allocated(InData%PAngVelEF)) then + call RegPackBounds(Buf, 4, lbound(InData%PAngVelEF), ubound(InData%PAngVelEF)) + call RegPack(Buf, InData%PAngVelEF) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PAngVelEG + call RegPack(Buf, allocated(InData%PAngVelEG)) + if (allocated(InData%PAngVelEG)) then + call RegPackBounds(Buf, 3, lbound(InData%PAngVelEG), ubound(InData%PAngVelEG)) + call RegPack(Buf, InData%PAngVelEG) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PAngVelEH + call RegPack(Buf, allocated(InData%PAngVelEH)) + if (allocated(InData%PAngVelEH)) then + call RegPackBounds(Buf, 3, lbound(InData%PAngVelEH), ubound(InData%PAngVelEH)) + call RegPack(Buf, InData%PAngVelEH) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PAngVelEL + call RegPack(Buf, allocated(InData%PAngVelEL)) + if (allocated(InData%PAngVelEL)) then + call RegPackBounds(Buf, 3, lbound(InData%PAngVelEL), ubound(InData%PAngVelEL)) + call RegPack(Buf, InData%PAngVelEL) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PAngVelEM + call RegPack(Buf, allocated(InData%PAngVelEM)) + if (allocated(InData%PAngVelEM)) then + call RegPackBounds(Buf, 5, lbound(InData%PAngVelEM), ubound(InData%PAngVelEM)) + call RegPack(Buf, InData%PAngVelEM) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AngVelEM + call RegPack(Buf, allocated(InData%AngVelEM)) + if (allocated(InData%AngVelEM)) then + call RegPackBounds(Buf, 3, lbound(InData%AngVelEM), ubound(InData%AngVelEM)) + call RegPack(Buf, InData%AngVelEM) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PAngVelEN + call RegPack(Buf, allocated(InData%PAngVelEN)) + if (allocated(InData%PAngVelEN)) then + call RegPackBounds(Buf, 3, lbound(InData%PAngVelEN), ubound(InData%PAngVelEN)) + call RegPack(Buf, InData%PAngVelEN) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AngVelEA + call RegPack(Buf, InData%AngVelEA) + if (RegCheckErr(Buf, RoutineName)) return + ! PAngVelEB + call RegPack(Buf, allocated(InData%PAngVelEB)) + if (allocated(InData%PAngVelEB)) then + call RegPackBounds(Buf, 3, lbound(InData%PAngVelEB), ubound(InData%PAngVelEB)) + call RegPack(Buf, InData%PAngVelEB) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PAngVelER + call RegPack(Buf, allocated(InData%PAngVelER)) + if (allocated(InData%PAngVelER)) then + call RegPackBounds(Buf, 3, lbound(InData%PAngVelER), ubound(InData%PAngVelER)) + call RegPack(Buf, InData%PAngVelER) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PAngVelEX + call RegPack(Buf, allocated(InData%PAngVelEX)) + if (allocated(InData%PAngVelEX)) then + call RegPackBounds(Buf, 3, lbound(InData%PAngVelEX), ubound(InData%PAngVelEX)) + call RegPack(Buf, InData%PAngVelEX) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AngVelEG + call RegPack(Buf, InData%AngVelEG) + if (RegCheckErr(Buf, RoutineName)) return + ! AngVelEH + call RegPack(Buf, InData%AngVelEH) + if (RegCheckErr(Buf, RoutineName)) return + ! AngVelEL + call RegPack(Buf, InData%AngVelEL) + if (RegCheckErr(Buf, RoutineName)) return + ! AngVelEN + call RegPack(Buf, InData%AngVelEN) + if (RegCheckErr(Buf, RoutineName)) return + ! AngVelEB + call RegPack(Buf, InData%AngVelEB) + if (RegCheckErr(Buf, RoutineName)) return + ! AngVelER + call RegPack(Buf, InData%AngVelER) + if (RegCheckErr(Buf, RoutineName)) return + ! AngVelEX + call RegPack(Buf, InData%AngVelEX) + if (RegCheckErr(Buf, RoutineName)) return + ! TeetAngVel + call RegPack(Buf, InData%TeetAngVel) + if (RegCheckErr(Buf, RoutineName)) return + ! AngAccEBt + call RegPack(Buf, InData%AngAccEBt) + if (RegCheckErr(Buf, RoutineName)) return + ! AngAccERt + call RegPack(Buf, InData%AngAccERt) + if (RegCheckErr(Buf, RoutineName)) return + ! AngAccEXt + call RegPack(Buf, InData%AngAccEXt) + if (RegCheckErr(Buf, RoutineName)) return + ! AngAccEFt + call RegPack(Buf, allocated(InData%AngAccEFt)) + if (allocated(InData%AngAccEFt)) then + call RegPackBounds(Buf, 2, lbound(InData%AngAccEFt), ubound(InData%AngAccEFt)) + call RegPack(Buf, InData%AngAccEFt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AngVelEF + call RegPack(Buf, allocated(InData%AngVelEF)) + if (allocated(InData%AngVelEF)) then + call RegPackBounds(Buf, 2, lbound(InData%AngVelEF), ubound(InData%AngVelEF)) + call RegPack(Buf, InData%AngVelEF) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AngVelHM + call RegPack(Buf, allocated(InData%AngVelHM)) + if (allocated(InData%AngVelHM)) then + call RegPackBounds(Buf, 3, lbound(InData%AngVelHM), ubound(InData%AngVelHM)) + call RegPack(Buf, InData%AngVelHM) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AngAccEAt + call RegPack(Buf, InData%AngAccEAt) + if (RegCheckErr(Buf, RoutineName)) return + ! AngAccEGt + call RegPack(Buf, InData%AngAccEGt) + if (RegCheckErr(Buf, RoutineName)) return + ! AngAccEHt + call RegPack(Buf, InData%AngAccEHt) + if (RegCheckErr(Buf, RoutineName)) return + ! AngAccEKt + call RegPack(Buf, allocated(InData%AngAccEKt)) + if (allocated(InData%AngAccEKt)) then + call RegPackBounds(Buf, 3, lbound(InData%AngAccEKt), ubound(InData%AngAccEKt)) + call RegPack(Buf, InData%AngAccEKt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AngAccENt + call RegPack(Buf, InData%AngAccENt) + if (RegCheckErr(Buf, RoutineName)) return + ! LinAccECt + call RegPack(Buf, InData%LinAccECt) + if (RegCheckErr(Buf, RoutineName)) return + ! LinAccEDt + call RegPack(Buf, InData%LinAccEDt) + if (RegCheckErr(Buf, RoutineName)) return + ! LinAccEIt + call RegPack(Buf, InData%LinAccEIt) + if (RegCheckErr(Buf, RoutineName)) return + ! LinAccEJt + call RegPack(Buf, InData%LinAccEJt) + if (RegCheckErr(Buf, RoutineName)) return + ! LinAccEUt + call RegPack(Buf, InData%LinAccEUt) + if (RegCheckErr(Buf, RoutineName)) return + ! LinAccEYt + call RegPack(Buf, InData%LinAccEYt) + if (RegCheckErr(Buf, RoutineName)) return + ! LinVelES + call RegPack(Buf, allocated(InData%LinVelES)) + if (allocated(InData%LinVelES)) then + call RegPackBounds(Buf, 3, lbound(InData%LinVelES), ubound(InData%LinVelES)) + call RegPack(Buf, InData%LinVelES) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LinVelEQ + call RegPack(Buf, InData%LinVelEQ) + if (RegCheckErr(Buf, RoutineName)) return + ! LinVelET + call RegPack(Buf, allocated(InData%LinVelET)) + if (allocated(InData%LinVelET)) then + call RegPackBounds(Buf, 2, lbound(InData%LinVelET), ubound(InData%LinVelET)) + call RegPack(Buf, InData%LinVelET) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LinVelESm2 + call RegPack(Buf, allocated(InData%LinVelESm2)) + if (allocated(InData%LinVelESm2)) then + call RegPackBounds(Buf, 1, lbound(InData%LinVelESm2), ubound(InData%LinVelESm2)) + call RegPack(Buf, InData%LinVelESm2) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PLinVelEIMU + call RegPack(Buf, allocated(InData%PLinVelEIMU)) + if (allocated(InData%PLinVelEIMU)) then + call RegPackBounds(Buf, 3, lbound(InData%PLinVelEIMU), ubound(InData%PLinVelEIMU)) + call RegPack(Buf, InData%PLinVelEIMU) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PLinVelEO + call RegPack(Buf, allocated(InData%PLinVelEO)) + if (allocated(InData%PLinVelEO)) then + call RegPackBounds(Buf, 3, lbound(InData%PLinVelEO), ubound(InData%PLinVelEO)) + call RegPack(Buf, InData%PLinVelEO) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PLinVelES + call RegPack(Buf, allocated(InData%PLinVelES)) + if (allocated(InData%PLinVelES)) then + call RegPackBounds(Buf, 5, lbound(InData%PLinVelES), ubound(InData%PLinVelES)) + call RegPack(Buf, InData%PLinVelES) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PLinVelET + call RegPack(Buf, allocated(InData%PLinVelET)) + if (allocated(InData%PLinVelET)) then + call RegPackBounds(Buf, 4, lbound(InData%PLinVelET), ubound(InData%PLinVelET)) + call RegPack(Buf, InData%PLinVelET) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PLinVelEZ + call RegPack(Buf, allocated(InData%PLinVelEZ)) + if (allocated(InData%PLinVelEZ)) then + call RegPackBounds(Buf, 3, lbound(InData%PLinVelEZ), ubound(InData%PLinVelEZ)) + call RegPack(Buf, InData%PLinVelEZ) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PLinVelEC + call RegPack(Buf, allocated(InData%PLinVelEC)) + if (allocated(InData%PLinVelEC)) then + call RegPackBounds(Buf, 3, lbound(InData%PLinVelEC), ubound(InData%PLinVelEC)) + call RegPack(Buf, InData%PLinVelEC) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PLinVelED + call RegPack(Buf, allocated(InData%PLinVelED)) + if (allocated(InData%PLinVelED)) then + call RegPackBounds(Buf, 3, lbound(InData%PLinVelED), ubound(InData%PLinVelED)) + call RegPack(Buf, InData%PLinVelED) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PLinVelEI + call RegPack(Buf, allocated(InData%PLinVelEI)) + if (allocated(InData%PLinVelEI)) then + call RegPackBounds(Buf, 3, lbound(InData%PLinVelEI), ubound(InData%PLinVelEI)) + call RegPack(Buf, InData%PLinVelEI) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PLinVelEJ + call RegPack(Buf, allocated(InData%PLinVelEJ)) + if (allocated(InData%PLinVelEJ)) then + call RegPackBounds(Buf, 3, lbound(InData%PLinVelEJ), ubound(InData%PLinVelEJ)) + call RegPack(Buf, InData%PLinVelEJ) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PLinVelEP + call RegPack(Buf, allocated(InData%PLinVelEP)) + if (allocated(InData%PLinVelEP)) then + call RegPackBounds(Buf, 3, lbound(InData%PLinVelEP), ubound(InData%PLinVelEP)) + call RegPack(Buf, InData%PLinVelEP) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PLinVelEQ + call RegPack(Buf, allocated(InData%PLinVelEQ)) + if (allocated(InData%PLinVelEQ)) then + call RegPackBounds(Buf, 3, lbound(InData%PLinVelEQ), ubound(InData%PLinVelEQ)) + call RegPack(Buf, InData%PLinVelEQ) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PLinVelEU + call RegPack(Buf, allocated(InData%PLinVelEU)) + if (allocated(InData%PLinVelEU)) then + call RegPackBounds(Buf, 3, lbound(InData%PLinVelEU), ubound(InData%PLinVelEU)) + call RegPack(Buf, InData%PLinVelEU) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PLinVelEV + call RegPack(Buf, allocated(InData%PLinVelEV)) + if (allocated(InData%PLinVelEV)) then + call RegPackBounds(Buf, 3, lbound(InData%PLinVelEV), ubound(InData%PLinVelEV)) + call RegPack(Buf, InData%PLinVelEV) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PLinVelEW + call RegPack(Buf, allocated(InData%PLinVelEW)) + if (allocated(InData%PLinVelEW)) then + call RegPackBounds(Buf, 3, lbound(InData%PLinVelEW), ubound(InData%PLinVelEW)) + call RegPack(Buf, InData%PLinVelEW) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PLinVelEY + call RegPack(Buf, allocated(InData%PLinVelEY)) + if (allocated(InData%PLinVelEY)) then + call RegPackBounds(Buf, 3, lbound(InData%PLinVelEY), ubound(InData%PLinVelEY)) + call RegPack(Buf, InData%PLinVelEY) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LinAccEIMUt + call RegPack(Buf, InData%LinAccEIMUt) + if (RegCheckErr(Buf, RoutineName)) return + ! LinAccEOt + call RegPack(Buf, InData%LinAccEOt) + if (RegCheckErr(Buf, RoutineName)) return + ! LinAccESt + call RegPack(Buf, allocated(InData%LinAccESt)) + if (allocated(InData%LinAccESt)) then + call RegPackBounds(Buf, 3, lbound(InData%LinAccESt), ubound(InData%LinAccESt)) + call RegPack(Buf, InData%LinAccESt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LinAccETt + call RegPack(Buf, allocated(InData%LinAccETt)) + if (allocated(InData%LinAccETt)) then + call RegPackBounds(Buf, 2, lbound(InData%LinAccETt), ubound(InData%LinAccETt)) + call RegPack(Buf, InData%LinAccETt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LinAccEZt + call RegPack(Buf, InData%LinAccEZt) + if (RegCheckErr(Buf, RoutineName)) return + ! LinVelEIMU + call RegPack(Buf, InData%LinVelEIMU) + if (RegCheckErr(Buf, RoutineName)) return + ! LinVelEZ + call RegPack(Buf, InData%LinVelEZ) + if (RegCheckErr(Buf, RoutineName)) return + ! LinVelEO + call RegPack(Buf, InData%LinVelEO) + if (RegCheckErr(Buf, RoutineName)) return + ! LinVelEJ + call RegPack(Buf, InData%LinVelEJ) + if (RegCheckErr(Buf, RoutineName)) return + ! FrcONcRtt + call RegPack(Buf, InData%FrcONcRtt) + if (RegCheckErr(Buf, RoutineName)) return + ! FrcPRott + call RegPack(Buf, InData%FrcPRott) + if (RegCheckErr(Buf, RoutineName)) return + ! FrcS0Bt + call RegPack(Buf, allocated(InData%FrcS0Bt)) + if (allocated(InData%FrcS0Bt)) then + call RegPackBounds(Buf, 2, lbound(InData%FrcS0Bt), ubound(InData%FrcS0Bt)) + call RegPack(Buf, InData%FrcS0Bt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FrcT0Trbt + call RegPack(Buf, InData%FrcT0Trbt) + if (RegCheckErr(Buf, RoutineName)) return + ! FSAero + call RegPack(Buf, allocated(InData%FSAero)) + if (allocated(InData%FSAero)) then + call RegPackBounds(Buf, 3, lbound(InData%FSAero), ubound(InData%FSAero)) + call RegPack(Buf, InData%FSAero) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FSTipDrag + call RegPack(Buf, allocated(InData%FSTipDrag)) + if (allocated(InData%FSTipDrag)) then + call RegPackBounds(Buf, 2, lbound(InData%FSTipDrag), ubound(InData%FSTipDrag)) + call RegPack(Buf, InData%FSTipDrag) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FTHydrot + call RegPack(Buf, allocated(InData%FTHydrot)) + if (allocated(InData%FTHydrot)) then + call RegPackBounds(Buf, 2, lbound(InData%FTHydrot), ubound(InData%FTHydrot)) + call RegPack(Buf, InData%FTHydrot) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FZHydrot + call RegPack(Buf, InData%FZHydrot) + if (RegCheckErr(Buf, RoutineName)) return + ! MFHydrot + call RegPack(Buf, allocated(InData%MFHydrot)) + if (allocated(InData%MFHydrot)) then + call RegPackBounds(Buf, 2, lbound(InData%MFHydrot), ubound(InData%MFHydrot)) + call RegPack(Buf, InData%MFHydrot) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MomBNcRtt + call RegPack(Buf, InData%MomBNcRtt) + if (RegCheckErr(Buf, RoutineName)) return + ! MomH0Bt + call RegPack(Buf, allocated(InData%MomH0Bt)) + if (allocated(InData%MomH0Bt)) then + call RegPackBounds(Buf, 2, lbound(InData%MomH0Bt), ubound(InData%MomH0Bt)) + call RegPack(Buf, InData%MomH0Bt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MomLPRott + call RegPack(Buf, InData%MomLPRott) + if (RegCheckErr(Buf, RoutineName)) return + ! MomNGnRtt + call RegPack(Buf, InData%MomNGnRtt) + if (RegCheckErr(Buf, RoutineName)) return + ! MomNTailt + call RegPack(Buf, InData%MomNTailt) + if (RegCheckErr(Buf, RoutineName)) return + ! MomX0Trbt + call RegPack(Buf, InData%MomX0Trbt) + if (RegCheckErr(Buf, RoutineName)) return + ! MMAero + call RegPack(Buf, allocated(InData%MMAero)) + if (allocated(InData%MMAero)) then + call RegPackBounds(Buf, 3, lbound(InData%MMAero), ubound(InData%MMAero)) + call RegPack(Buf, InData%MMAero) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MXHydrot + call RegPack(Buf, InData%MXHydrot) + if (RegCheckErr(Buf, RoutineName)) return + ! PFrcONcRt + call RegPack(Buf, allocated(InData%PFrcONcRt)) + if (allocated(InData%PFrcONcRt)) then + call RegPackBounds(Buf, 2, lbound(InData%PFrcONcRt), ubound(InData%PFrcONcRt)) + call RegPack(Buf, InData%PFrcONcRt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PFrcPRot + call RegPack(Buf, allocated(InData%PFrcPRot)) + if (allocated(InData%PFrcPRot)) then + call RegPackBounds(Buf, 2, lbound(InData%PFrcPRot), ubound(InData%PFrcPRot)) + call RegPack(Buf, InData%PFrcPRot) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PFrcS0B + call RegPack(Buf, allocated(InData%PFrcS0B)) + if (allocated(InData%PFrcS0B)) then + call RegPackBounds(Buf, 3, lbound(InData%PFrcS0B), ubound(InData%PFrcS0B)) + call RegPack(Buf, InData%PFrcS0B) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PFrcT0Trb + call RegPack(Buf, allocated(InData%PFrcT0Trb)) + if (allocated(InData%PFrcT0Trb)) then + call RegPackBounds(Buf, 2, lbound(InData%PFrcT0Trb), ubound(InData%PFrcT0Trb)) + call RegPack(Buf, InData%PFrcT0Trb) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PFTHydro + call RegPack(Buf, allocated(InData%PFTHydro)) + if (allocated(InData%PFTHydro)) then + call RegPackBounds(Buf, 3, lbound(InData%PFTHydro), ubound(InData%PFTHydro)) + call RegPack(Buf, InData%PFTHydro) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PFZHydro + call RegPack(Buf, InData%PFZHydro) + if (RegCheckErr(Buf, RoutineName)) return + ! PMFHydro + call RegPack(Buf, allocated(InData%PMFHydro)) + if (allocated(InData%PMFHydro)) then + call RegPackBounds(Buf, 3, lbound(InData%PMFHydro), ubound(InData%PMFHydro)) + call RegPack(Buf, InData%PMFHydro) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PMomBNcRt + call RegPack(Buf, allocated(InData%PMomBNcRt)) + if (allocated(InData%PMomBNcRt)) then + call RegPackBounds(Buf, 2, lbound(InData%PMomBNcRt), ubound(InData%PMomBNcRt)) + call RegPack(Buf, InData%PMomBNcRt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PMomH0B + call RegPack(Buf, allocated(InData%PMomH0B)) + if (allocated(InData%PMomH0B)) then + call RegPackBounds(Buf, 3, lbound(InData%PMomH0B), ubound(InData%PMomH0B)) + call RegPack(Buf, InData%PMomH0B) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PMomLPRot + call RegPack(Buf, allocated(InData%PMomLPRot)) + if (allocated(InData%PMomLPRot)) then + call RegPackBounds(Buf, 2, lbound(InData%PMomLPRot), ubound(InData%PMomLPRot)) + call RegPack(Buf, InData%PMomLPRot) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PMomNGnRt + call RegPack(Buf, allocated(InData%PMomNGnRt)) + if (allocated(InData%PMomNGnRt)) then + call RegPackBounds(Buf, 2, lbound(InData%PMomNGnRt), ubound(InData%PMomNGnRt)) + call RegPack(Buf, InData%PMomNGnRt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PMomNTail + call RegPack(Buf, allocated(InData%PMomNTail)) + if (allocated(InData%PMomNTail)) then + call RegPackBounds(Buf, 2, lbound(InData%PMomNTail), ubound(InData%PMomNTail)) + call RegPack(Buf, InData%PMomNTail) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PMomX0Trb + call RegPack(Buf, allocated(InData%PMomX0Trb)) + if (allocated(InData%PMomX0Trb)) then + call RegPackBounds(Buf, 2, lbound(InData%PMomX0Trb), ubound(InData%PMomX0Trb)) + call RegPack(Buf, InData%PMomX0Trb) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PMXHydro + call RegPack(Buf, InData%PMXHydro) + if (RegCheckErr(Buf, RoutineName)) return + ! TeetAng + call RegPack(Buf, InData%TeetAng) + if (RegCheckErr(Buf, RoutineName)) return + ! FrcVGnRtt + call RegPack(Buf, InData%FrcVGnRtt) + if (RegCheckErr(Buf, RoutineName)) return + ! FrcWTailt + call RegPack(Buf, InData%FrcWTailt) + if (RegCheckErr(Buf, RoutineName)) return + ! FrcZAllt + call RegPack(Buf, InData%FrcZAllt) + if (RegCheckErr(Buf, RoutineName)) return + ! MomXAllt + call RegPack(Buf, InData%MomXAllt) + if (RegCheckErr(Buf, RoutineName)) return + ! PFrcVGnRt + call RegPack(Buf, allocated(InData%PFrcVGnRt)) + if (allocated(InData%PFrcVGnRt)) then + call RegPackBounds(Buf, 2, lbound(InData%PFrcVGnRt), ubound(InData%PFrcVGnRt)) + call RegPack(Buf, InData%PFrcVGnRt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PFrcWTail + call RegPack(Buf, allocated(InData%PFrcWTail)) + if (allocated(InData%PFrcWTail)) then + call RegPackBounds(Buf, 2, lbound(InData%PFrcWTail), ubound(InData%PFrcWTail)) + call RegPack(Buf, InData%PFrcWTail) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PFrcZAll + call RegPack(Buf, allocated(InData%PFrcZAll)) + if (allocated(InData%PFrcZAll)) then + call RegPackBounds(Buf, 2, lbound(InData%PFrcZAll), ubound(InData%PFrcZAll)) + call RegPack(Buf, InData%PFrcZAll) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PMomXAll + call RegPack(Buf, allocated(InData%PMomXAll)) + if (allocated(InData%PMomXAll)) then + call RegPackBounds(Buf, 2, lbound(InData%PMomXAll), ubound(InData%PMomXAll)) + call RegPack(Buf, InData%PMomXAll) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TeetMom + call RegPack(Buf, InData%TeetMom) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlMom + call RegPack(Buf, InData%TFrlMom) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlMom + call RegPack(Buf, InData%RFrlMom) + if (RegCheckErr(Buf, RoutineName)) return + ! GBoxEffFac + call RegPack(Buf, InData%GBoxEffFac) + if (RegCheckErr(Buf, RoutineName)) return + ! rSAerCen + call RegPack(Buf, allocated(InData%rSAerCen)) + if (allocated(InData%rSAerCen)) then + call RegPackBounds(Buf, 3, lbound(InData%rSAerCen), ubound(InData%rSAerCen)) + call RegPack(Buf, InData%rSAerCen) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ED_UnPackRtHndSide(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ED_RtHndSide), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackRtHndSide' + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! rO + call RegUnpack(Buf, OutData%rO) + if (RegCheckErr(Buf, RoutineName)) return + ! rQS + if (allocated(OutData%rQS)) deallocate(OutData%rQS) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rQS(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rQS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rQS) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! rS + if (allocated(OutData%rS)) deallocate(OutData%rS) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rS(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rS) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! rS0S + if (allocated(OutData%rS0S)) deallocate(OutData%rS0S) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rS0S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rS0S.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rS0S) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! rT + if (allocated(OutData%rT)) deallocate(OutData%rT) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rT(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rT) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! rT0O + call RegUnpack(Buf, OutData%rT0O) + if (RegCheckErr(Buf, RoutineName)) return + ! rT0T + if (allocated(OutData%rT0T)) deallocate(OutData%rT0T) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rT0T(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rT0T.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rT0T) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! rZ + call RegUnpack(Buf, OutData%rZ) + if (RegCheckErr(Buf, RoutineName)) return + ! rZO + call RegUnpack(Buf, OutData%rZO) + if (RegCheckErr(Buf, RoutineName)) return + ! rZT + if (allocated(OutData%rZT)) deallocate(OutData%rZT) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rZT(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rZT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rZT) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! rPQ + call RegUnpack(Buf, OutData%rPQ) + if (RegCheckErr(Buf, RoutineName)) return + ! rP + call RegUnpack(Buf, OutData%rP) + if (RegCheckErr(Buf, RoutineName)) return + ! rV + call RegUnpack(Buf, OutData%rV) + if (RegCheckErr(Buf, RoutineName)) return + ! rJ + call RegUnpack(Buf, OutData%rJ) + if (RegCheckErr(Buf, RoutineName)) return + ! rZY + call RegUnpack(Buf, OutData%rZY) + if (RegCheckErr(Buf, RoutineName)) return + ! rOU + call RegUnpack(Buf, OutData%rOU) + if (RegCheckErr(Buf, RoutineName)) return + ! rOV + call RegUnpack(Buf, OutData%rOV) + if (RegCheckErr(Buf, RoutineName)) return + ! rVD + call RegUnpack(Buf, OutData%rVD) + if (RegCheckErr(Buf, RoutineName)) return + ! rOW + call RegUnpack(Buf, OutData%rOW) + if (RegCheckErr(Buf, RoutineName)) return + ! rPC + call RegUnpack(Buf, OutData%rPC) + if (RegCheckErr(Buf, RoutineName)) return + ! rPS0 + if (allocated(OutData%rPS0)) deallocate(OutData%rPS0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rPS0(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rPS0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rPS0) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! rQ + call RegUnpack(Buf, OutData%rQ) + if (RegCheckErr(Buf, RoutineName)) return + ! rQC + call RegUnpack(Buf, OutData%rQC) + if (RegCheckErr(Buf, RoutineName)) return + ! rVIMU + call RegUnpack(Buf, OutData%rVIMU) + if (RegCheckErr(Buf, RoutineName)) return + ! rVP + call RegUnpack(Buf, OutData%rVP) + if (RegCheckErr(Buf, RoutineName)) return + ! rWI + call RegUnpack(Buf, OutData%rWI) + if (RegCheckErr(Buf, RoutineName)) return + ! rWJ + call RegUnpack(Buf, OutData%rWJ) + if (RegCheckErr(Buf, RoutineName)) return + ! rZT0 + call RegUnpack(Buf, OutData%rZT0) + if (RegCheckErr(Buf, RoutineName)) return + ! AngPosEF + if (allocated(OutData%AngPosEF)) deallocate(OutData%AngPosEF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AngPosEF(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngPosEF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AngPosEF) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AngPosXF + if (allocated(OutData%AngPosXF)) deallocate(OutData%AngPosXF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AngPosXF(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngPosXF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AngPosXF) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AngPosHM + if (allocated(OutData%AngPosHM)) deallocate(OutData%AngPosHM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AngPosHM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngPosHM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AngPosHM) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AngPosXB + call RegUnpack(Buf, OutData%AngPosXB) + if (RegCheckErr(Buf, RoutineName)) return + ! AngPosEX + call RegUnpack(Buf, OutData%AngPosEX) + if (RegCheckErr(Buf, RoutineName)) return + ! PAngVelEA + if (allocated(OutData%PAngVelEA)) deallocate(OutData%PAngVelEA) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PAngVelEA(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEA.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PAngVelEA) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PAngVelEF + if (allocated(OutData%PAngVelEF)) deallocate(OutData%PAngVelEF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PAngVelEF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PAngVelEF) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PAngVelEG + if (allocated(OutData%PAngVelEG)) deallocate(OutData%PAngVelEG) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PAngVelEG(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEG.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PAngVelEG) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PAngVelEH + if (allocated(OutData%PAngVelEH)) deallocate(OutData%PAngVelEH) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PAngVelEH(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEH.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PAngVelEH) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PAngVelEL + if (allocated(OutData%PAngVelEL)) deallocate(OutData%PAngVelEL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PAngVelEL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PAngVelEL) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PAngVelEM + if (allocated(OutData%PAngVelEM)) deallocate(OutData%PAngVelEM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PAngVelEM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PAngVelEM) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AngVelEM + if (allocated(OutData%AngVelEM)) deallocate(OutData%AngVelEM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AngVelEM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngVelEM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AngVelEM) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PAngVelEN + if (allocated(OutData%PAngVelEN)) deallocate(OutData%PAngVelEN) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PAngVelEN(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PAngVelEN) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AngVelEA + call RegUnpack(Buf, OutData%AngVelEA) + if (RegCheckErr(Buf, RoutineName)) return + ! PAngVelEB + if (allocated(OutData%PAngVelEB)) deallocate(OutData%PAngVelEB) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PAngVelEB(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PAngVelEB) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PAngVelER + if (allocated(OutData%PAngVelER)) deallocate(OutData%PAngVelER) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PAngVelER(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelER.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PAngVelER) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PAngVelEX + if (allocated(OutData%PAngVelEX)) deallocate(OutData%PAngVelEX) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PAngVelEX(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PAngVelEX) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AngVelEG + call RegUnpack(Buf, OutData%AngVelEG) + if (RegCheckErr(Buf, RoutineName)) return + ! AngVelEH + call RegUnpack(Buf, OutData%AngVelEH) + if (RegCheckErr(Buf, RoutineName)) return + ! AngVelEL + call RegUnpack(Buf, OutData%AngVelEL) + if (RegCheckErr(Buf, RoutineName)) return + ! AngVelEN + call RegUnpack(Buf, OutData%AngVelEN) + if (RegCheckErr(Buf, RoutineName)) return + ! AngVelEB + call RegUnpack(Buf, OutData%AngVelEB) + if (RegCheckErr(Buf, RoutineName)) return + ! AngVelER + call RegUnpack(Buf, OutData%AngVelER) + if (RegCheckErr(Buf, RoutineName)) return + ! AngVelEX + call RegUnpack(Buf, OutData%AngVelEX) + if (RegCheckErr(Buf, RoutineName)) return + ! TeetAngVel + call RegUnpack(Buf, OutData%TeetAngVel) + if (RegCheckErr(Buf, RoutineName)) return + ! AngAccEBt + call RegUnpack(Buf, OutData%AngAccEBt) + if (RegCheckErr(Buf, RoutineName)) return + ! AngAccERt + call RegUnpack(Buf, OutData%AngAccERt) + if (RegCheckErr(Buf, RoutineName)) return + ! AngAccEXt + call RegUnpack(Buf, OutData%AngAccEXt) + if (RegCheckErr(Buf, RoutineName)) return + ! AngAccEFt + if (allocated(OutData%AngAccEFt)) deallocate(OutData%AngAccEFt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AngAccEFt(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngAccEFt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AngAccEFt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AngVelEF + if (allocated(OutData%AngVelEF)) deallocate(OutData%AngVelEF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AngVelEF(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngVelEF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AngVelEF) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AngVelHM + if (allocated(OutData%AngVelHM)) deallocate(OutData%AngVelHM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AngVelHM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngVelHM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AngVelHM) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AngAccEAt + call RegUnpack(Buf, OutData%AngAccEAt) + if (RegCheckErr(Buf, RoutineName)) return + ! AngAccEGt + call RegUnpack(Buf, OutData%AngAccEGt) + if (RegCheckErr(Buf, RoutineName)) return + ! AngAccEHt + call RegUnpack(Buf, OutData%AngAccEHt) + if (RegCheckErr(Buf, RoutineName)) return + ! AngAccEKt + if (allocated(OutData%AngAccEKt)) deallocate(OutData%AngAccEKt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AngAccEKt(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngAccEKt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AngAccEKt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AngAccENt + call RegUnpack(Buf, OutData%AngAccENt) + if (RegCheckErr(Buf, RoutineName)) return + ! LinAccECt + call RegUnpack(Buf, OutData%LinAccECt) + if (RegCheckErr(Buf, RoutineName)) return + ! LinAccEDt + call RegUnpack(Buf, OutData%LinAccEDt) + if (RegCheckErr(Buf, RoutineName)) return + ! LinAccEIt + call RegUnpack(Buf, OutData%LinAccEIt) + if (RegCheckErr(Buf, RoutineName)) return + ! LinAccEJt + call RegUnpack(Buf, OutData%LinAccEJt) + if (RegCheckErr(Buf, RoutineName)) return + ! LinAccEUt + call RegUnpack(Buf, OutData%LinAccEUt) + if (RegCheckErr(Buf, RoutineName)) return + ! LinAccEYt + call RegUnpack(Buf, OutData%LinAccEYt) + if (RegCheckErr(Buf, RoutineName)) return + ! LinVelES + if (allocated(OutData%LinVelES)) deallocate(OutData%LinVelES) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinVelES(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinVelES.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinVelES) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LinVelEQ + call RegUnpack(Buf, OutData%LinVelEQ) + if (RegCheckErr(Buf, RoutineName)) return + ! LinVelET + if (allocated(OutData%LinVelET)) deallocate(OutData%LinVelET) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinVelET(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinVelET.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinVelET) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LinVelESm2 + if (allocated(OutData%LinVelESm2)) deallocate(OutData%LinVelESm2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinVelESm2(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinVelESm2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinVelESm2) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PLinVelEIMU + if (allocated(OutData%PLinVelEIMU)) deallocate(OutData%PLinVelEIMU) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PLinVelEIMU(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEIMU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PLinVelEIMU) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PLinVelEO + if (allocated(OutData%PLinVelEO)) deallocate(OutData%PLinVelEO) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PLinVelEO(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEO.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PLinVelEO) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PLinVelES + if (allocated(OutData%PLinVelES)) deallocate(OutData%PLinVelES) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PLinVelES(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelES.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PLinVelES) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PLinVelET + if (allocated(OutData%PLinVelET)) deallocate(OutData%PLinVelET) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PLinVelET(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelET.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PLinVelET) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PLinVelEZ + if (allocated(OutData%PLinVelEZ)) deallocate(OutData%PLinVelEZ) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PLinVelEZ(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEZ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PLinVelEZ) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PLinVelEC + if (allocated(OutData%PLinVelEC)) deallocate(OutData%PLinVelEC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PLinVelEC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PLinVelEC) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PLinVelED + if (allocated(OutData%PLinVelED)) deallocate(OutData%PLinVelED) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PLinVelED(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelED.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PLinVelED) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PLinVelEI + if (allocated(OutData%PLinVelEI)) deallocate(OutData%PLinVelEI) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PLinVelEI(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEI.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PLinVelEI) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PLinVelEJ + if (allocated(OutData%PLinVelEJ)) deallocate(OutData%PLinVelEJ) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PLinVelEJ(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEJ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PLinVelEJ) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PLinVelEP + if (allocated(OutData%PLinVelEP)) deallocate(OutData%PLinVelEP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PLinVelEP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PLinVelEP) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PLinVelEQ + if (allocated(OutData%PLinVelEQ)) deallocate(OutData%PLinVelEQ) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PLinVelEQ(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEQ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PLinVelEQ) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PLinVelEU + if (allocated(OutData%PLinVelEU)) deallocate(OutData%PLinVelEU) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PLinVelEU(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PLinVelEU) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PLinVelEV + if (allocated(OutData%PLinVelEV)) deallocate(OutData%PLinVelEV) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PLinVelEV(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEV.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PLinVelEV) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PLinVelEW + if (allocated(OutData%PLinVelEW)) deallocate(OutData%PLinVelEW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PLinVelEW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PLinVelEW) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PLinVelEY + if (allocated(OutData%PLinVelEY)) deallocate(OutData%PLinVelEY) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PLinVelEY(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PLinVelEY) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LinAccEIMUt + call RegUnpack(Buf, OutData%LinAccEIMUt) + if (RegCheckErr(Buf, RoutineName)) return + ! LinAccEOt + call RegUnpack(Buf, OutData%LinAccEOt) + if (RegCheckErr(Buf, RoutineName)) return + ! LinAccESt + if (allocated(OutData%LinAccESt)) deallocate(OutData%LinAccESt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinAccESt(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinAccESt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinAccESt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LinAccETt + if (allocated(OutData%LinAccETt)) deallocate(OutData%LinAccETt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinAccETt(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinAccETt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinAccETt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LinAccEZt + call RegUnpack(Buf, OutData%LinAccEZt) + if (RegCheckErr(Buf, RoutineName)) return + ! LinVelEIMU + call RegUnpack(Buf, OutData%LinVelEIMU) + if (RegCheckErr(Buf, RoutineName)) return + ! LinVelEZ + call RegUnpack(Buf, OutData%LinVelEZ) + if (RegCheckErr(Buf, RoutineName)) return + ! LinVelEO + call RegUnpack(Buf, OutData%LinVelEO) + if (RegCheckErr(Buf, RoutineName)) return + ! LinVelEJ + call RegUnpack(Buf, OutData%LinVelEJ) + if (RegCheckErr(Buf, RoutineName)) return + ! FrcONcRtt + call RegUnpack(Buf, OutData%FrcONcRtt) + if (RegCheckErr(Buf, RoutineName)) return + ! FrcPRott + call RegUnpack(Buf, OutData%FrcPRott) + if (RegCheckErr(Buf, RoutineName)) return + ! FrcS0Bt + if (allocated(OutData%FrcS0Bt)) deallocate(OutData%FrcS0Bt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FrcS0Bt(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FrcS0Bt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FrcS0Bt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! FrcT0Trbt + call RegUnpack(Buf, OutData%FrcT0Trbt) + if (RegCheckErr(Buf, RoutineName)) return + ! FSAero + if (allocated(OutData%FSAero)) deallocate(OutData%FSAero) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FSAero(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSAero.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FSAero) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! FSTipDrag + if (allocated(OutData%FSTipDrag)) deallocate(OutData%FSTipDrag) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FSTipDrag(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSTipDrag.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FSTipDrag) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! FTHydrot + if (allocated(OutData%FTHydrot)) deallocate(OutData%FTHydrot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FTHydrot(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FTHydrot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FTHydrot) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! FZHydrot + call RegUnpack(Buf, OutData%FZHydrot) + if (RegCheckErr(Buf, RoutineName)) return + ! MFHydrot + if (allocated(OutData%MFHydrot)) deallocate(OutData%MFHydrot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MFHydrot(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MFHydrot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MFHydrot) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! MomBNcRtt + call RegUnpack(Buf, OutData%MomBNcRtt) + if (RegCheckErr(Buf, RoutineName)) return + ! MomH0Bt + if (allocated(OutData%MomH0Bt)) deallocate(OutData%MomH0Bt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MomH0Bt(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MomH0Bt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MomH0Bt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! MomLPRott + call RegUnpack(Buf, OutData%MomLPRott) + if (RegCheckErr(Buf, RoutineName)) return + ! MomNGnRtt + call RegUnpack(Buf, OutData%MomNGnRtt) + if (RegCheckErr(Buf, RoutineName)) return + ! MomNTailt + call RegUnpack(Buf, OutData%MomNTailt) + if (RegCheckErr(Buf, RoutineName)) return + ! MomX0Trbt + call RegUnpack(Buf, OutData%MomX0Trbt) + if (RegCheckErr(Buf, RoutineName)) return + ! MMAero + if (allocated(OutData%MMAero)) deallocate(OutData%MMAero) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MMAero(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MMAero.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MMAero) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! MXHydrot + call RegUnpack(Buf, OutData%MXHydrot) + if (RegCheckErr(Buf, RoutineName)) return + ! PFrcONcRt + if (allocated(OutData%PFrcONcRt)) deallocate(OutData%PFrcONcRt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PFrcONcRt(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcONcRt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PFrcONcRt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PFrcPRot + if (allocated(OutData%PFrcPRot)) deallocate(OutData%PFrcPRot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PFrcPRot(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcPRot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PFrcPRot) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PFrcS0B + if (allocated(OutData%PFrcS0B)) deallocate(OutData%PFrcS0B) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PFrcS0B(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcS0B.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PFrcS0B) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PFrcT0Trb + if (allocated(OutData%PFrcT0Trb)) deallocate(OutData%PFrcT0Trb) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PFrcT0Trb(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcT0Trb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PFrcT0Trb) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PFTHydro + if (allocated(OutData%PFTHydro)) deallocate(OutData%PFTHydro) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PFTHydro(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFTHydro.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PFTHydro) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PFZHydro + call RegUnpack(Buf, OutData%PFZHydro) + if (RegCheckErr(Buf, RoutineName)) return + ! PMFHydro + if (allocated(OutData%PMFHydro)) deallocate(OutData%PMFHydro) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PMFHydro(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMFHydro.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PMFHydro) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PMomBNcRt + if (allocated(OutData%PMomBNcRt)) deallocate(OutData%PMomBNcRt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PMomBNcRt(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomBNcRt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PMomBNcRt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PMomH0B + if (allocated(OutData%PMomH0B)) deallocate(OutData%PMomH0B) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PMomH0B(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomH0B.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PMomH0B) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PMomLPRot + if (allocated(OutData%PMomLPRot)) deallocate(OutData%PMomLPRot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PMomLPRot(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomLPRot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PMomLPRot) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PMomNGnRt + if (allocated(OutData%PMomNGnRt)) deallocate(OutData%PMomNGnRt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PMomNGnRt(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomNGnRt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PMomNGnRt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PMomNTail + if (allocated(OutData%PMomNTail)) deallocate(OutData%PMomNTail) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PMomNTail(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomNTail.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PMomNTail) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PMomX0Trb + if (allocated(OutData%PMomX0Trb)) deallocate(OutData%PMomX0Trb) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PMomX0Trb(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomX0Trb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PMomX0Trb) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PMXHydro + call RegUnpack(Buf, OutData%PMXHydro) + if (RegCheckErr(Buf, RoutineName)) return + ! TeetAng + call RegUnpack(Buf, OutData%TeetAng) + if (RegCheckErr(Buf, RoutineName)) return + ! FrcVGnRtt + call RegUnpack(Buf, OutData%FrcVGnRtt) + if (RegCheckErr(Buf, RoutineName)) return + ! FrcWTailt + call RegUnpack(Buf, OutData%FrcWTailt) + if (RegCheckErr(Buf, RoutineName)) return + ! FrcZAllt + call RegUnpack(Buf, OutData%FrcZAllt) + if (RegCheckErr(Buf, RoutineName)) return + ! MomXAllt + call RegUnpack(Buf, OutData%MomXAllt) + if (RegCheckErr(Buf, RoutineName)) return + ! PFrcVGnRt + if (allocated(OutData%PFrcVGnRt)) deallocate(OutData%PFrcVGnRt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PFrcVGnRt(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcVGnRt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PFrcVGnRt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PFrcWTail + if (allocated(OutData%PFrcWTail)) deallocate(OutData%PFrcWTail) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PFrcWTail(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcWTail.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PFrcWTail) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PFrcZAll + if (allocated(OutData%PFrcZAll)) deallocate(OutData%PFrcZAll) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PFrcZAll(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcZAll.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PFrcZAll) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PMomXAll + if (allocated(OutData%PMomXAll)) deallocate(OutData%PMomXAll) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PMomXAll(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomXAll.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PMomXAll) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TeetMom + call RegUnpack(Buf, OutData%TeetMom) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlMom + call RegUnpack(Buf, OutData%TFrlMom) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlMom + call RegUnpack(Buf, OutData%RFrlMom) + if (RegCheckErr(Buf, RoutineName)) return + ! GBoxEffFac + call RegUnpack(Buf, OutData%GBoxEffFac) + if (RegCheckErr(Buf, RoutineName)) return + ! rSAerCen + if (allocated(OutData%rSAerCen)) deallocate(OutData%rSAerCen) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rSAerCen(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rSAerCen.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rSAerCen) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + SUBROUTINE ED_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ED_ContinuousStateType), INTENT(IN) :: SrcContStateData + TYPE(ED_ContinuousStateType), INTENT(INOUT) :: DstContStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ED_CopyContState' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcContStateData%QT)) THEN + i1_l = LBOUND(SrcContStateData%QT,1) + i1_u = UBOUND(SrcContStateData%QT,1) + IF (.NOT. ALLOCATED(DstContStateData%QT)) THEN + ALLOCATE(DstContStateData%QT(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%QT.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstContStateData%QT = SrcContStateData%QT +ENDIF +IF (ALLOCATED(SrcContStateData%QDT)) THEN + i1_l = LBOUND(SrcContStateData%QDT,1) + i1_u = UBOUND(SrcContStateData%QDT,1) + IF (.NOT. ALLOCATED(DstContStateData%QDT)) THEN + ALLOCATE(DstContStateData%QDT(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%QDT.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstContStateData%QDT = SrcContStateData%QDT +ENDIF + END SUBROUTINE ED_CopyContState + + SUBROUTINE ED_DestroyContState( ContStateData, ErrStat, ErrMsg ) + TYPE(ED_ContinuousStateType), INTENT(INOUT) :: ContStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_PackRtHndSide' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyContState' - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! ErrStat = ErrID_None ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + SIZE(InData%rO) ! rO - Int_BufSz = Int_BufSz + 1 ! rQS allocated yes/no - IF ( ALLOCATED(InData%rQS) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! rQS upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%rQS) ! rQS - END IF - Int_BufSz = Int_BufSz + 1 ! rS allocated yes/no - IF ( ALLOCATED(InData%rS) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! rS upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%rS) ! rS - END IF - Int_BufSz = Int_BufSz + 1 ! rS0S allocated yes/no - IF ( ALLOCATED(InData%rS0S) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! rS0S upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%rS0S) ! rS0S - END IF - Int_BufSz = Int_BufSz + 1 ! rT allocated yes/no - IF ( ALLOCATED(InData%rT) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! rT upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%rT) ! rT - END IF - Db_BufSz = Db_BufSz + SIZE(InData%rT0O) ! rT0O - Int_BufSz = Int_BufSz + 1 ! rT0T allocated yes/no - IF ( ALLOCATED(InData%rT0T) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! rT0T upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%rT0T) ! rT0T - END IF - Db_BufSz = Db_BufSz + SIZE(InData%rZ) ! rZ - Db_BufSz = Db_BufSz + SIZE(InData%rZO) ! rZO - Int_BufSz = Int_BufSz + 1 ! rZT allocated yes/no - IF ( ALLOCATED(InData%rZT) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! rZT upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%rZT) ! rZT - END IF - Db_BufSz = Db_BufSz + SIZE(InData%rPQ) ! rPQ - Db_BufSz = Db_BufSz + SIZE(InData%rP) ! rP - Db_BufSz = Db_BufSz + SIZE(InData%rV) ! rV - Db_BufSz = Db_BufSz + SIZE(InData%rJ) ! rJ - Db_BufSz = Db_BufSz + SIZE(InData%rZY) ! rZY - Db_BufSz = Db_BufSz + SIZE(InData%rOU) ! rOU - Db_BufSz = Db_BufSz + SIZE(InData%rOV) ! rOV - Db_BufSz = Db_BufSz + SIZE(InData%rVD) ! rVD - Db_BufSz = Db_BufSz + SIZE(InData%rOW) ! rOW - Db_BufSz = Db_BufSz + SIZE(InData%rPC) ! rPC - Int_BufSz = Int_BufSz + 1 ! rPS0 allocated yes/no - IF ( ALLOCATED(InData%rPS0) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! rPS0 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%rPS0) ! rPS0 - END IF - Db_BufSz = Db_BufSz + SIZE(InData%rQ) ! rQ - Db_BufSz = Db_BufSz + SIZE(InData%rQC) ! rQC - Db_BufSz = Db_BufSz + SIZE(InData%rVIMU) ! rVIMU - Db_BufSz = Db_BufSz + SIZE(InData%rVP) ! rVP - Db_BufSz = Db_BufSz + SIZE(InData%rWI) ! rWI - Db_BufSz = Db_BufSz + SIZE(InData%rWJ) ! rWJ - Db_BufSz = Db_BufSz + SIZE(InData%rZT0) ! rZT0 - Int_BufSz = Int_BufSz + 1 ! AngPosEF allocated yes/no - IF ( ALLOCATED(InData%AngPosEF) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AngPosEF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AngPosEF) ! AngPosEF - END IF - Int_BufSz = Int_BufSz + 1 ! AngPosXF allocated yes/no - IF ( ALLOCATED(InData%AngPosXF) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AngPosXF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AngPosXF) ! AngPosXF - END IF - Int_BufSz = Int_BufSz + 1 ! AngPosHM allocated yes/no - IF ( ALLOCATED(InData%AngPosHM) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AngPosHM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AngPosHM) ! AngPosHM - END IF - Re_BufSz = Re_BufSz + SIZE(InData%AngPosXB) ! AngPosXB - Re_BufSz = Re_BufSz + SIZE(InData%AngPosEX) ! AngPosEX - Int_BufSz = Int_BufSz + 1 ! PAngVelEA allocated yes/no - IF ( ALLOCATED(InData%PAngVelEA) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PAngVelEA upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PAngVelEA) ! PAngVelEA - END IF - Int_BufSz = Int_BufSz + 1 ! PAngVelEF allocated yes/no - IF ( ALLOCATED(InData%PAngVelEF) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! PAngVelEF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PAngVelEF) ! PAngVelEF - END IF - Int_BufSz = Int_BufSz + 1 ! PAngVelEG allocated yes/no - IF ( ALLOCATED(InData%PAngVelEG) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PAngVelEG upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PAngVelEG) ! PAngVelEG - END IF - Int_BufSz = Int_BufSz + 1 ! PAngVelEH allocated yes/no - IF ( ALLOCATED(InData%PAngVelEH) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PAngVelEH upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PAngVelEH) ! PAngVelEH - END IF - Int_BufSz = Int_BufSz + 1 ! PAngVelEL allocated yes/no - IF ( ALLOCATED(InData%PAngVelEL) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PAngVelEL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PAngVelEL) ! PAngVelEL - END IF - Int_BufSz = Int_BufSz + 1 ! PAngVelEM allocated yes/no - IF ( ALLOCATED(InData%PAngVelEM) ) THEN - Int_BufSz = Int_BufSz + 2*5 ! PAngVelEM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PAngVelEM) ! PAngVelEM - END IF - Int_BufSz = Int_BufSz + 1 ! AngVelEM allocated yes/no - IF ( ALLOCATED(InData%AngVelEM) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AngVelEM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AngVelEM) ! AngVelEM - END IF - Int_BufSz = Int_BufSz + 1 ! PAngVelEN allocated yes/no - IF ( ALLOCATED(InData%PAngVelEN) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PAngVelEN upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PAngVelEN) ! PAngVelEN - END IF - Re_BufSz = Re_BufSz + SIZE(InData%AngVelEA) ! AngVelEA - Int_BufSz = Int_BufSz + 1 ! PAngVelEB allocated yes/no - IF ( ALLOCATED(InData%PAngVelEB) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PAngVelEB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PAngVelEB) ! PAngVelEB - END IF - Int_BufSz = Int_BufSz + 1 ! PAngVelER allocated yes/no - IF ( ALLOCATED(InData%PAngVelER) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PAngVelER upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PAngVelER) ! PAngVelER - END IF - Int_BufSz = Int_BufSz + 1 ! PAngVelEX allocated yes/no - IF ( ALLOCATED(InData%PAngVelEX) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PAngVelEX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PAngVelEX) ! PAngVelEX - END IF - Re_BufSz = Re_BufSz + SIZE(InData%AngVelEG) ! AngVelEG - Re_BufSz = Re_BufSz + SIZE(InData%AngVelEH) ! AngVelEH - Re_BufSz = Re_BufSz + SIZE(InData%AngVelEL) ! AngVelEL - Re_BufSz = Re_BufSz + SIZE(InData%AngVelEN) ! AngVelEN - Re_BufSz = Re_BufSz + SIZE(InData%AngVelEB) ! AngVelEB - Re_BufSz = Re_BufSz + SIZE(InData%AngVelER) ! AngVelER - Re_BufSz = Re_BufSz + SIZE(InData%AngVelEX) ! AngVelEX - Db_BufSz = Db_BufSz + 1 ! TeetAngVel - Re_BufSz = Re_BufSz + SIZE(InData%AngAccEBt) ! AngAccEBt - Re_BufSz = Re_BufSz + SIZE(InData%AngAccERt) ! AngAccERt - Re_BufSz = Re_BufSz + SIZE(InData%AngAccEXt) ! AngAccEXt - Int_BufSz = Int_BufSz + 1 ! AngAccEFt allocated yes/no - IF ( ALLOCATED(InData%AngAccEFt) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AngAccEFt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AngAccEFt) ! AngAccEFt - END IF - Int_BufSz = Int_BufSz + 1 ! AngVelEF allocated yes/no - IF ( ALLOCATED(InData%AngVelEF) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AngVelEF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AngVelEF) ! AngVelEF - END IF - Int_BufSz = Int_BufSz + 1 ! AngVelHM allocated yes/no - IF ( ALLOCATED(InData%AngVelHM) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AngVelHM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AngVelHM) ! AngVelHM - END IF - Re_BufSz = Re_BufSz + SIZE(InData%AngAccEAt) ! AngAccEAt - Re_BufSz = Re_BufSz + SIZE(InData%AngAccEGt) ! AngAccEGt - Re_BufSz = Re_BufSz + SIZE(InData%AngAccEHt) ! AngAccEHt - Int_BufSz = Int_BufSz + 1 ! AngAccEKt allocated yes/no - IF ( ALLOCATED(InData%AngAccEKt) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AngAccEKt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AngAccEKt) ! AngAccEKt - END IF - Re_BufSz = Re_BufSz + SIZE(InData%AngAccENt) ! AngAccENt - Re_BufSz = Re_BufSz + SIZE(InData%LinAccECt) ! LinAccECt - Re_BufSz = Re_BufSz + SIZE(InData%LinAccEDt) ! LinAccEDt - Re_BufSz = Re_BufSz + SIZE(InData%LinAccEIt) ! LinAccEIt - Re_BufSz = Re_BufSz + SIZE(InData%LinAccEJt) ! LinAccEJt - Re_BufSz = Re_BufSz + SIZE(InData%LinAccEUt) ! LinAccEUt - Re_BufSz = Re_BufSz + SIZE(InData%LinAccEYt) ! LinAccEYt - Int_BufSz = Int_BufSz + 1 ! LinVelES allocated yes/no - IF ( ALLOCATED(InData%LinVelES) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! LinVelES upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LinVelES) ! LinVelES - END IF - Re_BufSz = Re_BufSz + SIZE(InData%LinVelEQ) ! LinVelEQ - Int_BufSz = Int_BufSz + 1 ! LinVelET allocated yes/no - IF ( ALLOCATED(InData%LinVelET) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! LinVelET upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LinVelET) ! LinVelET - END IF - Int_BufSz = Int_BufSz + 1 ! LinVelESm2 allocated yes/no - IF ( ALLOCATED(InData%LinVelESm2) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinVelESm2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LinVelESm2) ! LinVelESm2 - END IF - Int_BufSz = Int_BufSz + 1 ! PLinVelEIMU allocated yes/no - IF ( ALLOCATED(InData%PLinVelEIMU) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PLinVelEIMU upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PLinVelEIMU) ! PLinVelEIMU - END IF - Int_BufSz = Int_BufSz + 1 ! PLinVelEO allocated yes/no - IF ( ALLOCATED(InData%PLinVelEO) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PLinVelEO upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PLinVelEO) ! PLinVelEO - END IF - Int_BufSz = Int_BufSz + 1 ! PLinVelES allocated yes/no - IF ( ALLOCATED(InData%PLinVelES) ) THEN - Int_BufSz = Int_BufSz + 2*5 ! PLinVelES upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PLinVelES) ! PLinVelES - END IF - Int_BufSz = Int_BufSz + 1 ! PLinVelET allocated yes/no - IF ( ALLOCATED(InData%PLinVelET) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! PLinVelET upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PLinVelET) ! PLinVelET - END IF - Int_BufSz = Int_BufSz + 1 ! PLinVelEZ allocated yes/no - IF ( ALLOCATED(InData%PLinVelEZ) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PLinVelEZ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PLinVelEZ) ! PLinVelEZ - END IF - Int_BufSz = Int_BufSz + 1 ! PLinVelEC allocated yes/no - IF ( ALLOCATED(InData%PLinVelEC) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PLinVelEC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PLinVelEC) ! PLinVelEC - END IF - Int_BufSz = Int_BufSz + 1 ! PLinVelED allocated yes/no - IF ( ALLOCATED(InData%PLinVelED) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PLinVelED upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PLinVelED) ! PLinVelED - END IF - Int_BufSz = Int_BufSz + 1 ! PLinVelEI allocated yes/no - IF ( ALLOCATED(InData%PLinVelEI) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PLinVelEI upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PLinVelEI) ! PLinVelEI - END IF - Int_BufSz = Int_BufSz + 1 ! PLinVelEJ allocated yes/no - IF ( ALLOCATED(InData%PLinVelEJ) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PLinVelEJ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PLinVelEJ) ! PLinVelEJ - END IF - Int_BufSz = Int_BufSz + 1 ! PLinVelEP allocated yes/no - IF ( ALLOCATED(InData%PLinVelEP) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PLinVelEP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PLinVelEP) ! PLinVelEP - END IF - Int_BufSz = Int_BufSz + 1 ! PLinVelEQ allocated yes/no - IF ( ALLOCATED(InData%PLinVelEQ) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PLinVelEQ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PLinVelEQ) ! PLinVelEQ - END IF - Int_BufSz = Int_BufSz + 1 ! PLinVelEU allocated yes/no - IF ( ALLOCATED(InData%PLinVelEU) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PLinVelEU upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PLinVelEU) ! PLinVelEU - END IF - Int_BufSz = Int_BufSz + 1 ! PLinVelEV allocated yes/no - IF ( ALLOCATED(InData%PLinVelEV) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PLinVelEV upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PLinVelEV) ! PLinVelEV - END IF - Int_BufSz = Int_BufSz + 1 ! PLinVelEW allocated yes/no - IF ( ALLOCATED(InData%PLinVelEW) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PLinVelEW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PLinVelEW) ! PLinVelEW - END IF - Int_BufSz = Int_BufSz + 1 ! PLinVelEY allocated yes/no - IF ( ALLOCATED(InData%PLinVelEY) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PLinVelEY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PLinVelEY) ! PLinVelEY - END IF - Re_BufSz = Re_BufSz + SIZE(InData%LinAccEIMUt) ! LinAccEIMUt - Re_BufSz = Re_BufSz + SIZE(InData%LinAccEOt) ! LinAccEOt - Int_BufSz = Int_BufSz + 1 ! LinAccESt allocated yes/no - IF ( ALLOCATED(InData%LinAccESt) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! LinAccESt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LinAccESt) ! LinAccESt - END IF - Int_BufSz = Int_BufSz + 1 ! LinAccETt allocated yes/no - IF ( ALLOCATED(InData%LinAccETt) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! LinAccETt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LinAccETt) ! LinAccETt - END IF - Re_BufSz = Re_BufSz + SIZE(InData%LinAccEZt) ! LinAccEZt - Re_BufSz = Re_BufSz + SIZE(InData%LinVelEIMU) ! LinVelEIMU - Re_BufSz = Re_BufSz + SIZE(InData%LinVelEZ) ! LinVelEZ - Re_BufSz = Re_BufSz + SIZE(InData%LinVelEO) ! LinVelEO - Re_BufSz = Re_BufSz + SIZE(InData%LinVelEJ) ! LinVelEJ - Re_BufSz = Re_BufSz + SIZE(InData%FrcONcRtt) ! FrcONcRtt - Re_BufSz = Re_BufSz + SIZE(InData%FrcPRott) ! FrcPRott - Int_BufSz = Int_BufSz + 1 ! FrcS0Bt allocated yes/no - IF ( ALLOCATED(InData%FrcS0Bt) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FrcS0Bt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FrcS0Bt) ! FrcS0Bt - END IF - Re_BufSz = Re_BufSz + SIZE(InData%FrcT0Trbt) ! FrcT0Trbt - Int_BufSz = Int_BufSz + 1 ! FSAero allocated yes/no - IF ( ALLOCATED(InData%FSAero) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! FSAero upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FSAero) ! FSAero - END IF - Int_BufSz = Int_BufSz + 1 ! FSTipDrag allocated yes/no - IF ( ALLOCATED(InData%FSTipDrag) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FSTipDrag upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FSTipDrag) ! FSTipDrag - END IF - Int_BufSz = Int_BufSz + 1 ! FTHydrot allocated yes/no - IF ( ALLOCATED(InData%FTHydrot) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FTHydrot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FTHydrot) ! FTHydrot - END IF - Re_BufSz = Re_BufSz + SIZE(InData%FZHydrot) ! FZHydrot - Int_BufSz = Int_BufSz + 1 ! MFHydrot allocated yes/no - IF ( ALLOCATED(InData%MFHydrot) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MFHydrot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MFHydrot) ! MFHydrot - END IF - Re_BufSz = Re_BufSz + SIZE(InData%MomBNcRtt) ! MomBNcRtt - Int_BufSz = Int_BufSz + 1 ! MomH0Bt allocated yes/no - IF ( ALLOCATED(InData%MomH0Bt) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MomH0Bt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MomH0Bt) ! MomH0Bt - END IF - Re_BufSz = Re_BufSz + SIZE(InData%MomLPRott) ! MomLPRott - Re_BufSz = Re_BufSz + SIZE(InData%MomNGnRtt) ! MomNGnRtt - Re_BufSz = Re_BufSz + SIZE(InData%MomNTailt) ! MomNTailt - Re_BufSz = Re_BufSz + SIZE(InData%MomX0Trbt) ! MomX0Trbt - Int_BufSz = Int_BufSz + 1 ! MMAero allocated yes/no - IF ( ALLOCATED(InData%MMAero) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! MMAero upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MMAero) ! MMAero - END IF - Re_BufSz = Re_BufSz + SIZE(InData%MXHydrot) ! MXHydrot - Int_BufSz = Int_BufSz + 1 ! PFrcONcRt allocated yes/no - IF ( ALLOCATED(InData%PFrcONcRt) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PFrcONcRt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PFrcONcRt) ! PFrcONcRt - END IF - Int_BufSz = Int_BufSz + 1 ! PFrcPRot allocated yes/no - IF ( ALLOCATED(InData%PFrcPRot) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PFrcPRot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PFrcPRot) ! PFrcPRot - END IF - Int_BufSz = Int_BufSz + 1 ! PFrcS0B allocated yes/no - IF ( ALLOCATED(InData%PFrcS0B) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PFrcS0B upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PFrcS0B) ! PFrcS0B - END IF - Int_BufSz = Int_BufSz + 1 ! PFrcT0Trb allocated yes/no - IF ( ALLOCATED(InData%PFrcT0Trb) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PFrcT0Trb upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PFrcT0Trb) ! PFrcT0Trb - END IF - Int_BufSz = Int_BufSz + 1 ! PFTHydro allocated yes/no - IF ( ALLOCATED(InData%PFTHydro) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PFTHydro upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PFTHydro) ! PFTHydro - END IF - Re_BufSz = Re_BufSz + SIZE(InData%PFZHydro) ! PFZHydro - Int_BufSz = Int_BufSz + 1 ! PMFHydro allocated yes/no - IF ( ALLOCATED(InData%PMFHydro) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PMFHydro upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PMFHydro) ! PMFHydro - END IF - Int_BufSz = Int_BufSz + 1 ! PMomBNcRt allocated yes/no - IF ( ALLOCATED(InData%PMomBNcRt) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PMomBNcRt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PMomBNcRt) ! PMomBNcRt - END IF - Int_BufSz = Int_BufSz + 1 ! PMomH0B allocated yes/no - IF ( ALLOCATED(InData%PMomH0B) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PMomH0B upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PMomH0B) ! PMomH0B - END IF - Int_BufSz = Int_BufSz + 1 ! PMomLPRot allocated yes/no - IF ( ALLOCATED(InData%PMomLPRot) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PMomLPRot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PMomLPRot) ! PMomLPRot - END IF - Int_BufSz = Int_BufSz + 1 ! PMomNGnRt allocated yes/no - IF ( ALLOCATED(InData%PMomNGnRt) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PMomNGnRt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PMomNGnRt) ! PMomNGnRt - END IF - Int_BufSz = Int_BufSz + 1 ! PMomNTail allocated yes/no - IF ( ALLOCATED(InData%PMomNTail) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PMomNTail upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PMomNTail) ! PMomNTail - END IF - Int_BufSz = Int_BufSz + 1 ! PMomX0Trb allocated yes/no - IF ( ALLOCATED(InData%PMomX0Trb) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PMomX0Trb upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PMomX0Trb) ! PMomX0Trb - END IF - Re_BufSz = Re_BufSz + SIZE(InData%PMXHydro) ! PMXHydro - Db_BufSz = Db_BufSz + 1 ! TeetAng - Re_BufSz = Re_BufSz + SIZE(InData%FrcVGnRtt) ! FrcVGnRtt - Re_BufSz = Re_BufSz + SIZE(InData%FrcWTailt) ! FrcWTailt - Re_BufSz = Re_BufSz + SIZE(InData%FrcZAllt) ! FrcZAllt - Re_BufSz = Re_BufSz + SIZE(InData%MomXAllt) ! MomXAllt - Int_BufSz = Int_BufSz + 1 ! PFrcVGnRt allocated yes/no - IF ( ALLOCATED(InData%PFrcVGnRt) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PFrcVGnRt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PFrcVGnRt) ! PFrcVGnRt - END IF - Int_BufSz = Int_BufSz + 1 ! PFrcWTail allocated yes/no - IF ( ALLOCATED(InData%PFrcWTail) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PFrcWTail upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PFrcWTail) ! PFrcWTail - END IF - Int_BufSz = Int_BufSz + 1 ! PFrcZAll allocated yes/no - IF ( ALLOCATED(InData%PFrcZAll) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PFrcZAll upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PFrcZAll) ! PFrcZAll - END IF - Int_BufSz = Int_BufSz + 1 ! PMomXAll allocated yes/no - IF ( ALLOCATED(InData%PMomXAll) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PMomXAll upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PMomXAll) ! PMomXAll - END IF - Re_BufSz = Re_BufSz + 1 ! TeetMom - Re_BufSz = Re_BufSz + 1 ! TFrlMom - Re_BufSz = Re_BufSz + 1 ! RFrlMom - Re_BufSz = Re_BufSz + 1 ! GBoxEffFac - Int_BufSz = Int_BufSz + 1 ! rSAerCen allocated yes/no - IF ( ALLOCATED(InData%rSAerCen) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! rSAerCen upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rSAerCen) ! rSAerCen - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i1 = LBOUND(InData%rO,1), UBOUND(InData%rO,1) - DbKiBuf(Db_Xferred) = InData%rO(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%rQS) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rQS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rQS,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rQS,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rQS,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rQS,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rQS,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%rQS,3), UBOUND(InData%rQS,3) - DO i2 = LBOUND(InData%rQS,2), UBOUND(InData%rQS,2) - DO i1 = LBOUND(InData%rQS,1), UBOUND(InData%rQS,1) - DbKiBuf(Db_Xferred) = InData%rQS(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rS) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rS,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rS,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rS,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rS,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rS,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%rS,3), UBOUND(InData%rS,3) - DO i2 = LBOUND(InData%rS,2), UBOUND(InData%rS,2) - DO i1 = LBOUND(InData%rS,1), UBOUND(InData%rS,1) - DbKiBuf(Db_Xferred) = InData%rS(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rS0S) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rS0S,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rS0S,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rS0S,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rS0S,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rS0S,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rS0S,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%rS0S,3), UBOUND(InData%rS0S,3) - DO i2 = LBOUND(InData%rS0S,2), UBOUND(InData%rS0S,2) - DO i1 = LBOUND(InData%rS0S,1), UBOUND(InData%rS0S,1) - DbKiBuf(Db_Xferred) = InData%rS0S(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rT) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rT,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rT,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rT,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%rT,2), UBOUND(InData%rT,2) - DO i1 = LBOUND(InData%rT,1), UBOUND(InData%rT,1) - DbKiBuf(Db_Xferred) = InData%rT(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%rT0O,1), UBOUND(InData%rT0O,1) - DbKiBuf(Db_Xferred) = InData%rT0O(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%rT0T) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rT0T,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rT0T,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rT0T,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rT0T,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%rT0T,2), UBOUND(InData%rT0T,2) - DO i1 = LBOUND(InData%rT0T,1), UBOUND(InData%rT0T,1) - DbKiBuf(Db_Xferred) = InData%rT0T(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%rZ,1), UBOUND(InData%rZ,1) - DbKiBuf(Db_Xferred) = InData%rZ(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rZO,1), UBOUND(InData%rZO,1) - DbKiBuf(Db_Xferred) = InData%rZO(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%rZT) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rZT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rZT,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rZT,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rZT,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%rZT,2), UBOUND(InData%rZT,2) - DO i1 = LBOUND(InData%rZT,1), UBOUND(InData%rZT,1) - DbKiBuf(Db_Xferred) = InData%rZT(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%rPQ,1), UBOUND(InData%rPQ,1) - DbKiBuf(Db_Xferred) = InData%rPQ(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rP,1), UBOUND(InData%rP,1) - DbKiBuf(Db_Xferred) = InData%rP(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rV,1), UBOUND(InData%rV,1) - DbKiBuf(Db_Xferred) = InData%rV(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rJ,1), UBOUND(InData%rJ,1) - DbKiBuf(Db_Xferred) = InData%rJ(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rZY,1), UBOUND(InData%rZY,1) - DbKiBuf(Db_Xferred) = InData%rZY(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rOU,1), UBOUND(InData%rOU,1) - DbKiBuf(Db_Xferred) = InData%rOU(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rOV,1), UBOUND(InData%rOV,1) - DbKiBuf(Db_Xferred) = InData%rOV(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rVD,1), UBOUND(InData%rVD,1) - DbKiBuf(Db_Xferred) = InData%rVD(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rOW,1), UBOUND(InData%rOW,1) - DbKiBuf(Db_Xferred) = InData%rOW(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rPC,1), UBOUND(InData%rPC,1) - DbKiBuf(Db_Xferred) = InData%rPC(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%rPS0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rPS0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rPS0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rPS0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rPS0,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%rPS0,2), UBOUND(InData%rPS0,2) - DO i1 = LBOUND(InData%rPS0,1), UBOUND(InData%rPS0,1) - DbKiBuf(Db_Xferred) = InData%rPS0(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%rQ,1), UBOUND(InData%rQ,1) - DbKiBuf(Db_Xferred) = InData%rQ(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rQC,1), UBOUND(InData%rQC,1) - DbKiBuf(Db_Xferred) = InData%rQC(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rVIMU,1), UBOUND(InData%rVIMU,1) - DbKiBuf(Db_Xferred) = InData%rVIMU(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rVP,1), UBOUND(InData%rVP,1) - DbKiBuf(Db_Xferred) = InData%rVP(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rWI,1), UBOUND(InData%rWI,1) - DbKiBuf(Db_Xferred) = InData%rWI(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rWJ,1), UBOUND(InData%rWJ,1) - DbKiBuf(Db_Xferred) = InData%rWJ(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rZT0,1), UBOUND(InData%rZT0,1) - DbKiBuf(Db_Xferred) = InData%rZT0(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%AngPosEF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngPosEF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngPosEF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngPosEF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngPosEF,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AngPosEF,2), UBOUND(InData%AngPosEF,2) - DO i1 = LBOUND(InData%AngPosEF,1), UBOUND(InData%AngPosEF,1) - ReKiBuf(Re_Xferred) = InData%AngPosEF(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AngPosXF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngPosXF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngPosXF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngPosXF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngPosXF,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AngPosXF,2), UBOUND(InData%AngPosXF,2) - DO i1 = LBOUND(InData%AngPosXF,1), UBOUND(InData%AngPosXF,1) - ReKiBuf(Re_Xferred) = InData%AngPosXF(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AngPosHM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngPosHM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngPosHM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngPosHM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngPosHM,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngPosHM,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngPosHM,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AngPosHM,3), UBOUND(InData%AngPosHM,3) - DO i2 = LBOUND(InData%AngPosHM,2), UBOUND(InData%AngPosHM,2) - DO i1 = LBOUND(InData%AngPosHM,1), UBOUND(InData%AngPosHM,1) - ReKiBuf(Re_Xferred) = InData%AngPosHM(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%AngPosXB,1), UBOUND(InData%AngPosXB,1) - ReKiBuf(Re_Xferred) = InData%AngPosXB(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%AngPosEX,1), UBOUND(InData%AngPosEX,1) - ReKiBuf(Re_Xferred) = InData%AngPosEX(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%PAngVelEA) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEA,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEA,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEA,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEA,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEA,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEA,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PAngVelEA,3), UBOUND(InData%PAngVelEA,3) - DO i2 = LBOUND(InData%PAngVelEA,2), UBOUND(InData%PAngVelEA,2) - DO i1 = LBOUND(InData%PAngVelEA,1), UBOUND(InData%PAngVelEA,1) - ReKiBuf(Re_Xferred) = InData%PAngVelEA(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PAngVelEF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEF,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEF,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEF,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEF,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEF,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%PAngVelEF,4), UBOUND(InData%PAngVelEF,4) - DO i3 = LBOUND(InData%PAngVelEF,3), UBOUND(InData%PAngVelEF,3) - DO i2 = LBOUND(InData%PAngVelEF,2), UBOUND(InData%PAngVelEF,2) - DO i1 = LBOUND(InData%PAngVelEF,1), UBOUND(InData%PAngVelEF,1) - ReKiBuf(Re_Xferred) = InData%PAngVelEF(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PAngVelEG) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEG,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEG,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEG,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEG,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEG,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEG,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PAngVelEG,3), UBOUND(InData%PAngVelEG,3) - DO i2 = LBOUND(InData%PAngVelEG,2), UBOUND(InData%PAngVelEG,2) - DO i1 = LBOUND(InData%PAngVelEG,1), UBOUND(InData%PAngVelEG,1) - ReKiBuf(Re_Xferred) = InData%PAngVelEG(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PAngVelEH) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEH,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEH,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEH,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEH,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEH,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEH,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PAngVelEH,3), UBOUND(InData%PAngVelEH,3) - DO i2 = LBOUND(InData%PAngVelEH,2), UBOUND(InData%PAngVelEH,2) - DO i1 = LBOUND(InData%PAngVelEH,1), UBOUND(InData%PAngVelEH,1) - ReKiBuf(Re_Xferred) = InData%PAngVelEH(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PAngVelEL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEL,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEL,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEL,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PAngVelEL,3), UBOUND(InData%PAngVelEL,3) - DO i2 = LBOUND(InData%PAngVelEL,2), UBOUND(InData%PAngVelEL,2) - DO i1 = LBOUND(InData%PAngVelEL,1), UBOUND(InData%PAngVelEL,1) - ReKiBuf(Re_Xferred) = InData%PAngVelEL(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PAngVelEM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEM,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEM,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEM,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEM,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEM,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEM,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEM,5) - Int_Xferred = Int_Xferred + 2 - - DO i5 = LBOUND(InData%PAngVelEM,5), UBOUND(InData%PAngVelEM,5) - DO i4 = LBOUND(InData%PAngVelEM,4), UBOUND(InData%PAngVelEM,4) - DO i3 = LBOUND(InData%PAngVelEM,3), UBOUND(InData%PAngVelEM,3) - DO i2 = LBOUND(InData%PAngVelEM,2), UBOUND(InData%PAngVelEM,2) - DO i1 = LBOUND(InData%PAngVelEM,1), UBOUND(InData%PAngVelEM,1) - ReKiBuf(Re_Xferred) = InData%PAngVelEM(i1,i2,i3,i4,i5) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AngVelEM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngVelEM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngVelEM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngVelEM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngVelEM,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngVelEM,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngVelEM,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AngVelEM,3), UBOUND(InData%AngVelEM,3) - DO i2 = LBOUND(InData%AngVelEM,2), UBOUND(InData%AngVelEM,2) - DO i1 = LBOUND(InData%AngVelEM,1), UBOUND(InData%AngVelEM,1) - ReKiBuf(Re_Xferred) = InData%AngVelEM(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PAngVelEN) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEN,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEN,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEN,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEN,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEN,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PAngVelEN,3), UBOUND(InData%PAngVelEN,3) - DO i2 = LBOUND(InData%PAngVelEN,2), UBOUND(InData%PAngVelEN,2) - DO i1 = LBOUND(InData%PAngVelEN,1), UBOUND(InData%PAngVelEN,1) - ReKiBuf(Re_Xferred) = InData%PAngVelEN(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%AngVelEA,1), UBOUND(InData%AngVelEA,1) - ReKiBuf(Re_Xferred) = InData%AngVelEA(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%PAngVelEB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEB,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEB,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEB,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PAngVelEB,3), UBOUND(InData%PAngVelEB,3) - DO i2 = LBOUND(InData%PAngVelEB,2), UBOUND(InData%PAngVelEB,2) - DO i1 = LBOUND(InData%PAngVelEB,1), UBOUND(InData%PAngVelEB,1) - ReKiBuf(Re_Xferred) = InData%PAngVelEB(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PAngVelER) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelER,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelER,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelER,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelER,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelER,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelER,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PAngVelER,3), UBOUND(InData%PAngVelER,3) - DO i2 = LBOUND(InData%PAngVelER,2), UBOUND(InData%PAngVelER,2) - DO i1 = LBOUND(InData%PAngVelER,1), UBOUND(InData%PAngVelER,1) - ReKiBuf(Re_Xferred) = InData%PAngVelER(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PAngVelEX) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEX,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEX,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEX,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PAngVelEX,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEX,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PAngVelEX,3), UBOUND(InData%PAngVelEX,3) - DO i2 = LBOUND(InData%PAngVelEX,2), UBOUND(InData%PAngVelEX,2) - DO i1 = LBOUND(InData%PAngVelEX,1), UBOUND(InData%PAngVelEX,1) - ReKiBuf(Re_Xferred) = InData%PAngVelEX(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%AngVelEG,1), UBOUND(InData%AngVelEG,1) - ReKiBuf(Re_Xferred) = InData%AngVelEG(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%AngVelEH,1), UBOUND(InData%AngVelEH,1) - ReKiBuf(Re_Xferred) = InData%AngVelEH(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%AngVelEL,1), UBOUND(InData%AngVelEL,1) - ReKiBuf(Re_Xferred) = InData%AngVelEL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%AngVelEN,1), UBOUND(InData%AngVelEN,1) - ReKiBuf(Re_Xferred) = InData%AngVelEN(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%AngVelEB,1), UBOUND(InData%AngVelEB,1) - ReKiBuf(Re_Xferred) = InData%AngVelEB(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%AngVelER,1), UBOUND(InData%AngVelER,1) - ReKiBuf(Re_Xferred) = InData%AngVelER(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%AngVelEX,1), UBOUND(InData%AngVelEX,1) - ReKiBuf(Re_Xferred) = InData%AngVelEX(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DbKiBuf(Db_Xferred) = InData%TeetAngVel - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%AngAccEBt,1), UBOUND(InData%AngAccEBt,1) - ReKiBuf(Re_Xferred) = InData%AngAccEBt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%AngAccERt,1), UBOUND(InData%AngAccERt,1) - ReKiBuf(Re_Xferred) = InData%AngAccERt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%AngAccEXt,1), UBOUND(InData%AngAccEXt,1) - ReKiBuf(Re_Xferred) = InData%AngAccEXt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%AngAccEFt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngAccEFt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngAccEFt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngAccEFt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngAccEFt,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AngAccEFt,2), UBOUND(InData%AngAccEFt,2) - DO i1 = LBOUND(InData%AngAccEFt,1), UBOUND(InData%AngAccEFt,1) - ReKiBuf(Re_Xferred) = InData%AngAccEFt(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AngVelEF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngVelEF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngVelEF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngVelEF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngVelEF,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AngVelEF,2), UBOUND(InData%AngVelEF,2) - DO i1 = LBOUND(InData%AngVelEF,1), UBOUND(InData%AngVelEF,1) - ReKiBuf(Re_Xferred) = InData%AngVelEF(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AngVelHM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngVelHM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngVelHM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngVelHM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngVelHM,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngVelHM,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngVelHM,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AngVelHM,3), UBOUND(InData%AngVelHM,3) - DO i2 = LBOUND(InData%AngVelHM,2), UBOUND(InData%AngVelHM,2) - DO i1 = LBOUND(InData%AngVelHM,1), UBOUND(InData%AngVelHM,1) - ReKiBuf(Re_Xferred) = InData%AngVelHM(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%AngAccEAt,1), UBOUND(InData%AngAccEAt,1) - ReKiBuf(Re_Xferred) = InData%AngAccEAt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%AngAccEGt,1), UBOUND(InData%AngAccEGt,1) - ReKiBuf(Re_Xferred) = InData%AngAccEGt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%AngAccEHt,1), UBOUND(InData%AngAccEHt,1) - ReKiBuf(Re_Xferred) = InData%AngAccEHt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%AngAccEKt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngAccEKt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngAccEKt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngAccEKt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngAccEKt,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngAccEKt,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngAccEKt,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AngAccEKt,3), UBOUND(InData%AngAccEKt,3) - DO i2 = LBOUND(InData%AngAccEKt,2), UBOUND(InData%AngAccEKt,2) - DO i1 = LBOUND(InData%AngAccEKt,1), UBOUND(InData%AngAccEKt,1) - ReKiBuf(Re_Xferred) = InData%AngAccEKt(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%AngAccENt,1), UBOUND(InData%AngAccENt,1) - ReKiBuf(Re_Xferred) = InData%AngAccENt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%LinAccECt,1), UBOUND(InData%LinAccECt,1) - ReKiBuf(Re_Xferred) = InData%LinAccECt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%LinAccEDt,1), UBOUND(InData%LinAccEDt,1) - ReKiBuf(Re_Xferred) = InData%LinAccEDt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%LinAccEIt,1), UBOUND(InData%LinAccEIt,1) - ReKiBuf(Re_Xferred) = InData%LinAccEIt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%LinAccEJt,1), UBOUND(InData%LinAccEJt,1) - ReKiBuf(Re_Xferred) = InData%LinAccEJt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%LinAccEUt,1), UBOUND(InData%LinAccEUt,1) - ReKiBuf(Re_Xferred) = InData%LinAccEUt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%LinAccEYt,1), UBOUND(InData%LinAccEYt,1) - ReKiBuf(Re_Xferred) = InData%LinAccEYt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%LinVelES) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinVelES,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinVelES,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinVelES,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinVelES,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinVelES,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinVelES,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%LinVelES,3), UBOUND(InData%LinVelES,3) - DO i2 = LBOUND(InData%LinVelES,2), UBOUND(InData%LinVelES,2) - DO i1 = LBOUND(InData%LinVelES,1), UBOUND(InData%LinVelES,1) - ReKiBuf(Re_Xferred) = InData%LinVelES(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%LinVelEQ,1), UBOUND(InData%LinVelEQ,1) - ReKiBuf(Re_Xferred) = InData%LinVelEQ(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%LinVelET) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinVelET,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinVelET,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinVelET,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinVelET,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%LinVelET,2), UBOUND(InData%LinVelET,2) - DO i1 = LBOUND(InData%LinVelET,1), UBOUND(InData%LinVelET,1) - ReKiBuf(Re_Xferred) = InData%LinVelET(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinVelESm2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinVelESm2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinVelESm2,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinVelESm2,1), UBOUND(InData%LinVelESm2,1) - ReKiBuf(Re_Xferred) = InData%LinVelESm2(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PLinVelEIMU) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEIMU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEIMU,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEIMU,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEIMU,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEIMU,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEIMU,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PLinVelEIMU,3), UBOUND(InData%PLinVelEIMU,3) - DO i2 = LBOUND(InData%PLinVelEIMU,2), UBOUND(InData%PLinVelEIMU,2) - DO i1 = LBOUND(InData%PLinVelEIMU,1), UBOUND(InData%PLinVelEIMU,1) - ReKiBuf(Re_Xferred) = InData%PLinVelEIMU(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PLinVelEO) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEO,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEO,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEO,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEO,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEO,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEO,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PLinVelEO,3), UBOUND(InData%PLinVelEO,3) - DO i2 = LBOUND(InData%PLinVelEO,2), UBOUND(InData%PLinVelEO,2) - DO i1 = LBOUND(InData%PLinVelEO,1), UBOUND(InData%PLinVelEO,1) - ReKiBuf(Re_Xferred) = InData%PLinVelEO(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PLinVelES) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelES,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelES,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelES,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelES,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelES,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelES,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelES,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelES,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelES,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelES,5) - Int_Xferred = Int_Xferred + 2 - - DO i5 = LBOUND(InData%PLinVelES,5), UBOUND(InData%PLinVelES,5) - DO i4 = LBOUND(InData%PLinVelES,4), UBOUND(InData%PLinVelES,4) - DO i3 = LBOUND(InData%PLinVelES,3), UBOUND(InData%PLinVelES,3) - DO i2 = LBOUND(InData%PLinVelES,2), UBOUND(InData%PLinVelES,2) - DO i1 = LBOUND(InData%PLinVelES,1), UBOUND(InData%PLinVelES,1) - ReKiBuf(Re_Xferred) = InData%PLinVelES(i1,i2,i3,i4,i5) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PLinVelET) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelET,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelET,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelET,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelET,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelET,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelET,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelET,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelET,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%PLinVelET,4), UBOUND(InData%PLinVelET,4) - DO i3 = LBOUND(InData%PLinVelET,3), UBOUND(InData%PLinVelET,3) - DO i2 = LBOUND(InData%PLinVelET,2), UBOUND(InData%PLinVelET,2) - DO i1 = LBOUND(InData%PLinVelET,1), UBOUND(InData%PLinVelET,1) - ReKiBuf(Re_Xferred) = InData%PLinVelET(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PLinVelEZ) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEZ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEZ,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEZ,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEZ,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEZ,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEZ,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PLinVelEZ,3), UBOUND(InData%PLinVelEZ,3) - DO i2 = LBOUND(InData%PLinVelEZ,2), UBOUND(InData%PLinVelEZ,2) - DO i1 = LBOUND(InData%PLinVelEZ,1), UBOUND(InData%PLinVelEZ,1) - ReKiBuf(Re_Xferred) = InData%PLinVelEZ(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PLinVelEC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEC,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEC,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEC,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PLinVelEC,3), UBOUND(InData%PLinVelEC,3) - DO i2 = LBOUND(InData%PLinVelEC,2), UBOUND(InData%PLinVelEC,2) - DO i1 = LBOUND(InData%PLinVelEC,1), UBOUND(InData%PLinVelEC,1) - ReKiBuf(Re_Xferred) = InData%PLinVelEC(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PLinVelED) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelED,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelED,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelED,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelED,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelED,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelED,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PLinVelED,3), UBOUND(InData%PLinVelED,3) - DO i2 = LBOUND(InData%PLinVelED,2), UBOUND(InData%PLinVelED,2) - DO i1 = LBOUND(InData%PLinVelED,1), UBOUND(InData%PLinVelED,1) - ReKiBuf(Re_Xferred) = InData%PLinVelED(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PLinVelEI) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEI,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEI,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEI,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEI,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEI,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEI,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PLinVelEI,3), UBOUND(InData%PLinVelEI,3) - DO i2 = LBOUND(InData%PLinVelEI,2), UBOUND(InData%PLinVelEI,2) - DO i1 = LBOUND(InData%PLinVelEI,1), UBOUND(InData%PLinVelEI,1) - ReKiBuf(Re_Xferred) = InData%PLinVelEI(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PLinVelEJ) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEJ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEJ,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEJ,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEJ,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEJ,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEJ,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PLinVelEJ,3), UBOUND(InData%PLinVelEJ,3) - DO i2 = LBOUND(InData%PLinVelEJ,2), UBOUND(InData%PLinVelEJ,2) - DO i1 = LBOUND(InData%PLinVelEJ,1), UBOUND(InData%PLinVelEJ,1) - ReKiBuf(Re_Xferred) = InData%PLinVelEJ(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PLinVelEP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEP,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEP,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEP,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PLinVelEP,3), UBOUND(InData%PLinVelEP,3) - DO i2 = LBOUND(InData%PLinVelEP,2), UBOUND(InData%PLinVelEP,2) - DO i1 = LBOUND(InData%PLinVelEP,1), UBOUND(InData%PLinVelEP,1) - ReKiBuf(Re_Xferred) = InData%PLinVelEP(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PLinVelEQ) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEQ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEQ,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEQ,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEQ,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEQ,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEQ,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PLinVelEQ,3), UBOUND(InData%PLinVelEQ,3) - DO i2 = LBOUND(InData%PLinVelEQ,2), UBOUND(InData%PLinVelEQ,2) - DO i1 = LBOUND(InData%PLinVelEQ,1), UBOUND(InData%PLinVelEQ,1) - ReKiBuf(Re_Xferred) = InData%PLinVelEQ(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PLinVelEU) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEU,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEU,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEU,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEU,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEU,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PLinVelEU,3), UBOUND(InData%PLinVelEU,3) - DO i2 = LBOUND(InData%PLinVelEU,2), UBOUND(InData%PLinVelEU,2) - DO i1 = LBOUND(InData%PLinVelEU,1), UBOUND(InData%PLinVelEU,1) - ReKiBuf(Re_Xferred) = InData%PLinVelEU(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PLinVelEV) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEV,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEV,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEV,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEV,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEV,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEV,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PLinVelEV,3), UBOUND(InData%PLinVelEV,3) - DO i2 = LBOUND(InData%PLinVelEV,2), UBOUND(InData%PLinVelEV,2) - DO i1 = LBOUND(InData%PLinVelEV,1), UBOUND(InData%PLinVelEV,1) - ReKiBuf(Re_Xferred) = InData%PLinVelEV(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PLinVelEW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEW,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEW,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEW,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PLinVelEW,3), UBOUND(InData%PLinVelEW,3) - DO i2 = LBOUND(InData%PLinVelEW,2), UBOUND(InData%PLinVelEW,2) - DO i1 = LBOUND(InData%PLinVelEW,1), UBOUND(InData%PLinVelEW,1) - ReKiBuf(Re_Xferred) = InData%PLinVelEW(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PLinVelEY) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEY,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEY,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEY,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PLinVelEY,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEY,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PLinVelEY,3), UBOUND(InData%PLinVelEY,3) - DO i2 = LBOUND(InData%PLinVelEY,2), UBOUND(InData%PLinVelEY,2) - DO i1 = LBOUND(InData%PLinVelEY,1), UBOUND(InData%PLinVelEY,1) - ReKiBuf(Re_Xferred) = InData%PLinVelEY(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%LinAccEIMUt,1), UBOUND(InData%LinAccEIMUt,1) - ReKiBuf(Re_Xferred) = InData%LinAccEIMUt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%LinAccEOt,1), UBOUND(InData%LinAccEOt,1) - ReKiBuf(Re_Xferred) = InData%LinAccEOt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%LinAccESt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinAccESt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinAccESt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinAccESt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinAccESt,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinAccESt,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinAccESt,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%LinAccESt,3), UBOUND(InData%LinAccESt,3) - DO i2 = LBOUND(InData%LinAccESt,2), UBOUND(InData%LinAccESt,2) - DO i1 = LBOUND(InData%LinAccESt,1), UBOUND(InData%LinAccESt,1) - ReKiBuf(Re_Xferred) = InData%LinAccESt(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinAccETt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinAccETt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinAccETt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinAccETt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinAccETt,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%LinAccETt,2), UBOUND(InData%LinAccETt,2) - DO i1 = LBOUND(InData%LinAccETt,1), UBOUND(InData%LinAccETt,1) - ReKiBuf(Re_Xferred) = InData%LinAccETt(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%LinAccEZt,1), UBOUND(InData%LinAccEZt,1) - ReKiBuf(Re_Xferred) = InData%LinAccEZt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%LinVelEIMU,1), UBOUND(InData%LinVelEIMU,1) - ReKiBuf(Re_Xferred) = InData%LinVelEIMU(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%LinVelEZ,1), UBOUND(InData%LinVelEZ,1) - ReKiBuf(Re_Xferred) = InData%LinVelEZ(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%LinVelEO,1), UBOUND(InData%LinVelEO,1) - ReKiBuf(Re_Xferred) = InData%LinVelEO(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%LinVelEJ,1), UBOUND(InData%LinVelEJ,1) - ReKiBuf(Re_Xferred) = InData%LinVelEJ(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%FrcONcRtt,1), UBOUND(InData%FrcONcRtt,1) - ReKiBuf(Re_Xferred) = InData%FrcONcRtt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%FrcPRott,1), UBOUND(InData%FrcPRott,1) - ReKiBuf(Re_Xferred) = InData%FrcPRott(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%FrcS0Bt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FrcS0Bt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FrcS0Bt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FrcS0Bt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FrcS0Bt,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FrcS0Bt,2), UBOUND(InData%FrcS0Bt,2) - DO i1 = LBOUND(InData%FrcS0Bt,1), UBOUND(InData%FrcS0Bt,1) - ReKiBuf(Re_Xferred) = InData%FrcS0Bt(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%FrcT0Trbt,1), UBOUND(InData%FrcT0Trbt,1) - ReKiBuf(Re_Xferred) = InData%FrcT0Trbt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%FSAero) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FSAero,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSAero,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FSAero,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSAero,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FSAero,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSAero,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%FSAero,3), UBOUND(InData%FSAero,3) - DO i2 = LBOUND(InData%FSAero,2), UBOUND(InData%FSAero,2) - DO i1 = LBOUND(InData%FSAero,1), UBOUND(InData%FSAero,1) - ReKiBuf(Re_Xferred) = InData%FSAero(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FSTipDrag) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FSTipDrag,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSTipDrag,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FSTipDrag,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSTipDrag,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FSTipDrag,2), UBOUND(InData%FSTipDrag,2) - DO i1 = LBOUND(InData%FSTipDrag,1), UBOUND(InData%FSTipDrag,1) - ReKiBuf(Re_Xferred) = InData%FSTipDrag(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FTHydrot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FTHydrot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FTHydrot,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FTHydrot,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FTHydrot,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FTHydrot,2), UBOUND(InData%FTHydrot,2) - DO i1 = LBOUND(InData%FTHydrot,1), UBOUND(InData%FTHydrot,1) - ReKiBuf(Re_Xferred) = InData%FTHydrot(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%FZHydrot,1), UBOUND(InData%FZHydrot,1) - ReKiBuf(Re_Xferred) = InData%FZHydrot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%MFHydrot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MFHydrot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MFHydrot,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MFHydrot,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MFHydrot,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MFHydrot,2), UBOUND(InData%MFHydrot,2) - DO i1 = LBOUND(InData%MFHydrot,1), UBOUND(InData%MFHydrot,1) - ReKiBuf(Re_Xferred) = InData%MFHydrot(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%MomBNcRtt,1), UBOUND(InData%MomBNcRtt,1) - ReKiBuf(Re_Xferred) = InData%MomBNcRtt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%MomH0Bt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MomH0Bt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MomH0Bt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MomH0Bt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MomH0Bt,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MomH0Bt,2), UBOUND(InData%MomH0Bt,2) - DO i1 = LBOUND(InData%MomH0Bt,1), UBOUND(InData%MomH0Bt,1) - ReKiBuf(Re_Xferred) = InData%MomH0Bt(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%MomLPRott,1), UBOUND(InData%MomLPRott,1) - ReKiBuf(Re_Xferred) = InData%MomLPRott(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%MomNGnRtt,1), UBOUND(InData%MomNGnRtt,1) - ReKiBuf(Re_Xferred) = InData%MomNGnRtt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%MomNTailt,1), UBOUND(InData%MomNTailt,1) - ReKiBuf(Re_Xferred) = InData%MomNTailt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%MomX0Trbt,1), UBOUND(InData%MomX0Trbt,1) - ReKiBuf(Re_Xferred) = InData%MomX0Trbt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%MMAero) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MMAero,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MMAero,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MMAero,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MMAero,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MMAero,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MMAero,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%MMAero,3), UBOUND(InData%MMAero,3) - DO i2 = LBOUND(InData%MMAero,2), UBOUND(InData%MMAero,2) - DO i1 = LBOUND(InData%MMAero,1), UBOUND(InData%MMAero,1) - ReKiBuf(Re_Xferred) = InData%MMAero(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%MXHydrot,1), UBOUND(InData%MXHydrot,1) - ReKiBuf(Re_Xferred) = InData%MXHydrot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%PFrcONcRt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PFrcONcRt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcONcRt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PFrcONcRt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcONcRt,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PFrcONcRt,2), UBOUND(InData%PFrcONcRt,2) - DO i1 = LBOUND(InData%PFrcONcRt,1), UBOUND(InData%PFrcONcRt,1) - ReKiBuf(Re_Xferred) = InData%PFrcONcRt(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PFrcPRot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PFrcPRot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcPRot,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PFrcPRot,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcPRot,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PFrcPRot,2), UBOUND(InData%PFrcPRot,2) - DO i1 = LBOUND(InData%PFrcPRot,1), UBOUND(InData%PFrcPRot,1) - ReKiBuf(Re_Xferred) = InData%PFrcPRot(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PFrcS0B) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PFrcS0B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcS0B,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PFrcS0B,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcS0B,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PFrcS0B,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcS0B,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PFrcS0B,3), UBOUND(InData%PFrcS0B,3) - DO i2 = LBOUND(InData%PFrcS0B,2), UBOUND(InData%PFrcS0B,2) - DO i1 = LBOUND(InData%PFrcS0B,1), UBOUND(InData%PFrcS0B,1) - ReKiBuf(Re_Xferred) = InData%PFrcS0B(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PFrcT0Trb) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PFrcT0Trb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcT0Trb,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PFrcT0Trb,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcT0Trb,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PFrcT0Trb,2), UBOUND(InData%PFrcT0Trb,2) - DO i1 = LBOUND(InData%PFrcT0Trb,1), UBOUND(InData%PFrcT0Trb,1) - ReKiBuf(Re_Xferred) = InData%PFrcT0Trb(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PFTHydro) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PFTHydro,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFTHydro,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PFTHydro,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFTHydro,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PFTHydro,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFTHydro,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PFTHydro,3), UBOUND(InData%PFTHydro,3) - DO i2 = LBOUND(InData%PFTHydro,2), UBOUND(InData%PFTHydro,2) - DO i1 = LBOUND(InData%PFTHydro,1), UBOUND(InData%PFTHydro,1) - ReKiBuf(Re_Xferred) = InData%PFTHydro(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - DO i2 = LBOUND(InData%PFZHydro,2), UBOUND(InData%PFZHydro,2) - DO i1 = LBOUND(InData%PFZHydro,1), UBOUND(InData%PFZHydro,1) - ReKiBuf(Re_Xferred) = InData%PFZHydro(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( .NOT. ALLOCATED(InData%PMFHydro) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMFHydro,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMFHydro,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMFHydro,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMFHydro,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMFHydro,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMFHydro,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PMFHydro,3), UBOUND(InData%PMFHydro,3) - DO i2 = LBOUND(InData%PMFHydro,2), UBOUND(InData%PMFHydro,2) - DO i1 = LBOUND(InData%PMFHydro,1), UBOUND(InData%PMFHydro,1) - ReKiBuf(Re_Xferred) = InData%PMFHydro(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PMomBNcRt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMomBNcRt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomBNcRt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMomBNcRt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomBNcRt,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PMomBNcRt,2), UBOUND(InData%PMomBNcRt,2) - DO i1 = LBOUND(InData%PMomBNcRt,1), UBOUND(InData%PMomBNcRt,1) - ReKiBuf(Re_Xferred) = InData%PMomBNcRt(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PMomH0B) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMomH0B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomH0B,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMomH0B,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomH0B,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMomH0B,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomH0B,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PMomH0B,3), UBOUND(InData%PMomH0B,3) - DO i2 = LBOUND(InData%PMomH0B,2), UBOUND(InData%PMomH0B,2) - DO i1 = LBOUND(InData%PMomH0B,1), UBOUND(InData%PMomH0B,1) - ReKiBuf(Re_Xferred) = InData%PMomH0B(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PMomLPRot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMomLPRot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomLPRot,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMomLPRot,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomLPRot,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PMomLPRot,2), UBOUND(InData%PMomLPRot,2) - DO i1 = LBOUND(InData%PMomLPRot,1), UBOUND(InData%PMomLPRot,1) - ReKiBuf(Re_Xferred) = InData%PMomLPRot(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PMomNGnRt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMomNGnRt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomNGnRt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMomNGnRt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomNGnRt,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PMomNGnRt,2), UBOUND(InData%PMomNGnRt,2) - DO i1 = LBOUND(InData%PMomNGnRt,1), UBOUND(InData%PMomNGnRt,1) - ReKiBuf(Re_Xferred) = InData%PMomNGnRt(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PMomNTail) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMomNTail,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomNTail,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMomNTail,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomNTail,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PMomNTail,2), UBOUND(InData%PMomNTail,2) - DO i1 = LBOUND(InData%PMomNTail,1), UBOUND(InData%PMomNTail,1) - ReKiBuf(Re_Xferred) = InData%PMomNTail(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PMomX0Trb) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMomX0Trb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomX0Trb,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMomX0Trb,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomX0Trb,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PMomX0Trb,2), UBOUND(InData%PMomX0Trb,2) - DO i1 = LBOUND(InData%PMomX0Trb,1), UBOUND(InData%PMomX0Trb,1) - ReKiBuf(Re_Xferred) = InData%PMomX0Trb(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DO i2 = LBOUND(InData%PMXHydro,2), UBOUND(InData%PMXHydro,2) - DO i1 = LBOUND(InData%PMXHydro,1), UBOUND(InData%PMXHydro,1) - ReKiBuf(Re_Xferred) = InData%PMXHydro(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DbKiBuf(Db_Xferred) = InData%TeetAng - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%FrcVGnRtt,1), UBOUND(InData%FrcVGnRtt,1) - ReKiBuf(Re_Xferred) = InData%FrcVGnRtt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%FrcWTailt,1), UBOUND(InData%FrcWTailt,1) - ReKiBuf(Re_Xferred) = InData%FrcWTailt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%FrcZAllt,1), UBOUND(InData%FrcZAllt,1) - ReKiBuf(Re_Xferred) = InData%FrcZAllt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%MomXAllt,1), UBOUND(InData%MomXAllt,1) - ReKiBuf(Re_Xferred) = InData%MomXAllt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%PFrcVGnRt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PFrcVGnRt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcVGnRt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PFrcVGnRt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcVGnRt,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PFrcVGnRt,2), UBOUND(InData%PFrcVGnRt,2) - DO i1 = LBOUND(InData%PFrcVGnRt,1), UBOUND(InData%PFrcVGnRt,1) - ReKiBuf(Re_Xferred) = InData%PFrcVGnRt(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PFrcWTail) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PFrcWTail,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcWTail,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PFrcWTail,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcWTail,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PFrcWTail,2), UBOUND(InData%PFrcWTail,2) - DO i1 = LBOUND(InData%PFrcWTail,1), UBOUND(InData%PFrcWTail,1) - ReKiBuf(Re_Xferred) = InData%PFrcWTail(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PFrcZAll) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PFrcZAll,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcZAll,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PFrcZAll,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcZAll,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PFrcZAll,2), UBOUND(InData%PFrcZAll,2) - DO i1 = LBOUND(InData%PFrcZAll,1), UBOUND(InData%PFrcZAll,1) - ReKiBuf(Re_Xferred) = InData%PFrcZAll(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PMomXAll) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMomXAll,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomXAll,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PMomXAll,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomXAll,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PMomXAll,2), UBOUND(InData%PMomXAll,2) - DO i1 = LBOUND(InData%PMomXAll,1), UBOUND(InData%PMomXAll,1) - ReKiBuf(Re_Xferred) = InData%PMomXAll(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%TeetMom - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlMom - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlMom - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GBoxEffFac - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%rSAerCen) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rSAerCen,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rSAerCen,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rSAerCen,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rSAerCen,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rSAerCen,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rSAerCen,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%rSAerCen,3), UBOUND(InData%rSAerCen,3) - DO i2 = LBOUND(InData%rSAerCen,2), UBOUND(InData%rSAerCen,2) - DO i1 = LBOUND(InData%rSAerCen,1), UBOUND(InData%rSAerCen,1) - ReKiBuf(Re_Xferred) = InData%rSAerCen(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE ED_PackRtHndSide - - SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ED_RtHndSide), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_UnPackRtHndSide' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%rO,1) - i1_u = UBOUND(OutData%rO,1) - DO i1 = LBOUND(OutData%rO,1), UBOUND(OutData%rO,1) - OutData%rO(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rQS not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rQS)) DEALLOCATE(OutData%rQS) - ALLOCATE(OutData%rQS(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rQS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%rQS,3), UBOUND(OutData%rQS,3) - DO i2 = LBOUND(OutData%rQS,2), UBOUND(OutData%rQS,2) - DO i1 = LBOUND(OutData%rQS,1), UBOUND(OutData%rQS,1) - OutData%rQS(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rS not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rS)) DEALLOCATE(OutData%rS) - ALLOCATE(OutData%rS(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%rS,3), UBOUND(OutData%rS,3) - DO i2 = LBOUND(OutData%rS,2), UBOUND(OutData%rS,2) - DO i1 = LBOUND(OutData%rS,1), UBOUND(OutData%rS,1) - OutData%rS(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rS0S not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rS0S)) DEALLOCATE(OutData%rS0S) - ALLOCATE(OutData%rS0S(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rS0S.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%rS0S,3), UBOUND(OutData%rS0S,3) - DO i2 = LBOUND(OutData%rS0S,2), UBOUND(OutData%rS0S,2) - DO i1 = LBOUND(OutData%rS0S,1), UBOUND(OutData%rS0S,1) - OutData%rS0S(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rT not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rT)) DEALLOCATE(OutData%rT) - ALLOCATE(OutData%rT(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%rT,2), UBOUND(OutData%rT,2) - DO i1 = LBOUND(OutData%rT,1), UBOUND(OutData%rT,1) - OutData%rT(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%rT0O,1) - i1_u = UBOUND(OutData%rT0O,1) - DO i1 = LBOUND(OutData%rT0O,1), UBOUND(OutData%rT0O,1) - OutData%rT0O(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rT0T not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rT0T)) DEALLOCATE(OutData%rT0T) - ALLOCATE(OutData%rT0T(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rT0T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%rT0T,2), UBOUND(OutData%rT0T,2) - DO i1 = LBOUND(OutData%rT0T,1), UBOUND(OutData%rT0T,1) - OutData%rT0T(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%rZ,1) - i1_u = UBOUND(OutData%rZ,1) - DO i1 = LBOUND(OutData%rZ,1), UBOUND(OutData%rZ,1) - OutData%rZ(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rZO,1) - i1_u = UBOUND(OutData%rZO,1) - DO i1 = LBOUND(OutData%rZO,1), UBOUND(OutData%rZO,1) - OutData%rZO(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rZT not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rZT)) DEALLOCATE(OutData%rZT) - ALLOCATE(OutData%rZT(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rZT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%rZT,2), UBOUND(OutData%rZT,2) - DO i1 = LBOUND(OutData%rZT,1), UBOUND(OutData%rZT,1) - OutData%rZT(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%rPQ,1) - i1_u = UBOUND(OutData%rPQ,1) - DO i1 = LBOUND(OutData%rPQ,1), UBOUND(OutData%rPQ,1) - OutData%rPQ(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rP,1) - i1_u = UBOUND(OutData%rP,1) - DO i1 = LBOUND(OutData%rP,1), UBOUND(OutData%rP,1) - OutData%rP(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rV,1) - i1_u = UBOUND(OutData%rV,1) - DO i1 = LBOUND(OutData%rV,1), UBOUND(OutData%rV,1) - OutData%rV(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rJ,1) - i1_u = UBOUND(OutData%rJ,1) - DO i1 = LBOUND(OutData%rJ,1), UBOUND(OutData%rJ,1) - OutData%rJ(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rZY,1) - i1_u = UBOUND(OutData%rZY,1) - DO i1 = LBOUND(OutData%rZY,1), UBOUND(OutData%rZY,1) - OutData%rZY(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rOU,1) - i1_u = UBOUND(OutData%rOU,1) - DO i1 = LBOUND(OutData%rOU,1), UBOUND(OutData%rOU,1) - OutData%rOU(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rOV,1) - i1_u = UBOUND(OutData%rOV,1) - DO i1 = LBOUND(OutData%rOV,1), UBOUND(OutData%rOV,1) - OutData%rOV(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rVD,1) - i1_u = UBOUND(OutData%rVD,1) - DO i1 = LBOUND(OutData%rVD,1), UBOUND(OutData%rVD,1) - OutData%rVD(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rOW,1) - i1_u = UBOUND(OutData%rOW,1) - DO i1 = LBOUND(OutData%rOW,1), UBOUND(OutData%rOW,1) - OutData%rOW(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rPC,1) - i1_u = UBOUND(OutData%rPC,1) - DO i1 = LBOUND(OutData%rPC,1), UBOUND(OutData%rPC,1) - OutData%rPC(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rPS0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rPS0)) DEALLOCATE(OutData%rPS0) - ALLOCATE(OutData%rPS0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rPS0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%rPS0,2), UBOUND(OutData%rPS0,2) - DO i1 = LBOUND(OutData%rPS0,1), UBOUND(OutData%rPS0,1) - OutData%rPS0(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%rQ,1) - i1_u = UBOUND(OutData%rQ,1) - DO i1 = LBOUND(OutData%rQ,1), UBOUND(OutData%rQ,1) - OutData%rQ(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rQC,1) - i1_u = UBOUND(OutData%rQC,1) - DO i1 = LBOUND(OutData%rQC,1), UBOUND(OutData%rQC,1) - OutData%rQC(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rVIMU,1) - i1_u = UBOUND(OutData%rVIMU,1) - DO i1 = LBOUND(OutData%rVIMU,1), UBOUND(OutData%rVIMU,1) - OutData%rVIMU(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rVP,1) - i1_u = UBOUND(OutData%rVP,1) - DO i1 = LBOUND(OutData%rVP,1), UBOUND(OutData%rVP,1) - OutData%rVP(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rWI,1) - i1_u = UBOUND(OutData%rWI,1) - DO i1 = LBOUND(OutData%rWI,1), UBOUND(OutData%rWI,1) - OutData%rWI(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rWJ,1) - i1_u = UBOUND(OutData%rWJ,1) - DO i1 = LBOUND(OutData%rWJ,1), UBOUND(OutData%rWJ,1) - OutData%rWJ(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rZT0,1) - i1_u = UBOUND(OutData%rZT0,1) - DO i1 = LBOUND(OutData%rZT0,1), UBOUND(OutData%rZT0,1) - OutData%rZT0(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngPosEF not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AngPosEF)) DEALLOCATE(OutData%AngPosEF) - ALLOCATE(OutData%AngPosEF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngPosEF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AngPosEF,2), UBOUND(OutData%AngPosEF,2) - DO i1 = LBOUND(OutData%AngPosEF,1), UBOUND(OutData%AngPosEF,1) - OutData%AngPosEF(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngPosXF not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AngPosXF)) DEALLOCATE(OutData%AngPosXF) - ALLOCATE(OutData%AngPosXF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngPosXF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AngPosXF,2), UBOUND(OutData%AngPosXF,2) - DO i1 = LBOUND(OutData%AngPosXF,1), UBOUND(OutData%AngPosXF,1) - OutData%AngPosXF(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngPosHM not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AngPosHM)) DEALLOCATE(OutData%AngPosHM) - ALLOCATE(OutData%AngPosHM(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngPosHM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AngPosHM,3), UBOUND(OutData%AngPosHM,3) - DO i2 = LBOUND(OutData%AngPosHM,2), UBOUND(OutData%AngPosHM,2) - DO i1 = LBOUND(OutData%AngPosHM,1), UBOUND(OutData%AngPosHM,1) - OutData%AngPosHM(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%AngPosXB,1) - i1_u = UBOUND(OutData%AngPosXB,1) - DO i1 = LBOUND(OutData%AngPosXB,1), UBOUND(OutData%AngPosXB,1) - OutData%AngPosXB(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%AngPosEX,1) - i1_u = UBOUND(OutData%AngPosEX,1) - DO i1 = LBOUND(OutData%AngPosEX,1), UBOUND(OutData%AngPosEX,1) - OutData%AngPosEX(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PAngVelEA not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PAngVelEA)) DEALLOCATE(OutData%PAngVelEA) - ALLOCATE(OutData%PAngVelEA(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PAngVelEA,3), UBOUND(OutData%PAngVelEA,3) - DO i2 = LBOUND(OutData%PAngVelEA,2), UBOUND(OutData%PAngVelEA,2) - DO i1 = LBOUND(OutData%PAngVelEA,1), UBOUND(OutData%PAngVelEA,1) - OutData%PAngVelEA(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PAngVelEF not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PAngVelEF)) DEALLOCATE(OutData%PAngVelEF) - ALLOCATE(OutData%PAngVelEF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%PAngVelEF,4), UBOUND(OutData%PAngVelEF,4) - DO i3 = LBOUND(OutData%PAngVelEF,3), UBOUND(OutData%PAngVelEF,3) - DO i2 = LBOUND(OutData%PAngVelEF,2), UBOUND(OutData%PAngVelEF,2) - DO i1 = LBOUND(OutData%PAngVelEF,1), UBOUND(OutData%PAngVelEF,1) - OutData%PAngVelEF(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PAngVelEG not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PAngVelEG)) DEALLOCATE(OutData%PAngVelEG) - ALLOCATE(OutData%PAngVelEG(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PAngVelEG,3), UBOUND(OutData%PAngVelEG,3) - DO i2 = LBOUND(OutData%PAngVelEG,2), UBOUND(OutData%PAngVelEG,2) - DO i1 = LBOUND(OutData%PAngVelEG,1), UBOUND(OutData%PAngVelEG,1) - OutData%PAngVelEG(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PAngVelEH not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PAngVelEH)) DEALLOCATE(OutData%PAngVelEH) - ALLOCATE(OutData%PAngVelEH(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEH.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PAngVelEH,3), UBOUND(OutData%PAngVelEH,3) - DO i2 = LBOUND(OutData%PAngVelEH,2), UBOUND(OutData%PAngVelEH,2) - DO i1 = LBOUND(OutData%PAngVelEH,1), UBOUND(OutData%PAngVelEH,1) - OutData%PAngVelEH(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PAngVelEL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PAngVelEL)) DEALLOCATE(OutData%PAngVelEL) - ALLOCATE(OutData%PAngVelEL(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PAngVelEL,3), UBOUND(OutData%PAngVelEL,3) - DO i2 = LBOUND(OutData%PAngVelEL,2), UBOUND(OutData%PAngVelEL,2) - DO i1 = LBOUND(OutData%PAngVelEL,1), UBOUND(OutData%PAngVelEL,1) - OutData%PAngVelEL(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PAngVelEM not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i5_l = IntKiBuf( Int_Xferred ) - i5_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PAngVelEM)) DEALLOCATE(OutData%PAngVelEM) - ALLOCATE(OutData%PAngVelEM(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i5 = LBOUND(OutData%PAngVelEM,5), UBOUND(OutData%PAngVelEM,5) - DO i4 = LBOUND(OutData%PAngVelEM,4), UBOUND(OutData%PAngVelEM,4) - DO i3 = LBOUND(OutData%PAngVelEM,3), UBOUND(OutData%PAngVelEM,3) - DO i2 = LBOUND(OutData%PAngVelEM,2), UBOUND(OutData%PAngVelEM,2) - DO i1 = LBOUND(OutData%PAngVelEM,1), UBOUND(OutData%PAngVelEM,1) - OutData%PAngVelEM(i1,i2,i3,i4,i5) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngVelEM not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AngVelEM)) DEALLOCATE(OutData%AngVelEM) - ALLOCATE(OutData%AngVelEM(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngVelEM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AngVelEM,3), UBOUND(OutData%AngVelEM,3) - DO i2 = LBOUND(OutData%AngVelEM,2), UBOUND(OutData%AngVelEM,2) - DO i1 = LBOUND(OutData%AngVelEM,1), UBOUND(OutData%AngVelEM,1) - OutData%AngVelEM(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PAngVelEN not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PAngVelEN)) DEALLOCATE(OutData%PAngVelEN) - ALLOCATE(OutData%PAngVelEN(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PAngVelEN,3), UBOUND(OutData%PAngVelEN,3) - DO i2 = LBOUND(OutData%PAngVelEN,2), UBOUND(OutData%PAngVelEN,2) - DO i1 = LBOUND(OutData%PAngVelEN,1), UBOUND(OutData%PAngVelEN,1) - OutData%PAngVelEN(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%AngVelEA,1) - i1_u = UBOUND(OutData%AngVelEA,1) - DO i1 = LBOUND(OutData%AngVelEA,1), UBOUND(OutData%AngVelEA,1) - OutData%AngVelEA(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PAngVelEB not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PAngVelEB)) DEALLOCATE(OutData%PAngVelEB) - ALLOCATE(OutData%PAngVelEB(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PAngVelEB,3), UBOUND(OutData%PAngVelEB,3) - DO i2 = LBOUND(OutData%PAngVelEB,2), UBOUND(OutData%PAngVelEB,2) - DO i1 = LBOUND(OutData%PAngVelEB,1), UBOUND(OutData%PAngVelEB,1) - OutData%PAngVelEB(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PAngVelER not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PAngVelER)) DEALLOCATE(OutData%PAngVelER) - ALLOCATE(OutData%PAngVelER(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelER.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PAngVelER,3), UBOUND(OutData%PAngVelER,3) - DO i2 = LBOUND(OutData%PAngVelER,2), UBOUND(OutData%PAngVelER,2) - DO i1 = LBOUND(OutData%PAngVelER,1), UBOUND(OutData%PAngVelER,1) - OutData%PAngVelER(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PAngVelEX not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PAngVelEX)) DEALLOCATE(OutData%PAngVelEX) - ALLOCATE(OutData%PAngVelEX(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PAngVelEX,3), UBOUND(OutData%PAngVelEX,3) - DO i2 = LBOUND(OutData%PAngVelEX,2), UBOUND(OutData%PAngVelEX,2) - DO i1 = LBOUND(OutData%PAngVelEX,1), UBOUND(OutData%PAngVelEX,1) - OutData%PAngVelEX(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%AngVelEG,1) - i1_u = UBOUND(OutData%AngVelEG,1) - DO i1 = LBOUND(OutData%AngVelEG,1), UBOUND(OutData%AngVelEG,1) - OutData%AngVelEG(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%AngVelEH,1) - i1_u = UBOUND(OutData%AngVelEH,1) - DO i1 = LBOUND(OutData%AngVelEH,1), UBOUND(OutData%AngVelEH,1) - OutData%AngVelEH(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%AngVelEL,1) - i1_u = UBOUND(OutData%AngVelEL,1) - DO i1 = LBOUND(OutData%AngVelEL,1), UBOUND(OutData%AngVelEL,1) - OutData%AngVelEL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%AngVelEN,1) - i1_u = UBOUND(OutData%AngVelEN,1) - DO i1 = LBOUND(OutData%AngVelEN,1), UBOUND(OutData%AngVelEN,1) - OutData%AngVelEN(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%AngVelEB,1) - i1_u = UBOUND(OutData%AngVelEB,1) - DO i1 = LBOUND(OutData%AngVelEB,1), UBOUND(OutData%AngVelEB,1) - OutData%AngVelEB(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%AngVelER,1) - i1_u = UBOUND(OutData%AngVelER,1) - DO i1 = LBOUND(OutData%AngVelER,1), UBOUND(OutData%AngVelER,1) - OutData%AngVelER(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%AngVelEX,1) - i1_u = UBOUND(OutData%AngVelEX,1) - DO i1 = LBOUND(OutData%AngVelEX,1), UBOUND(OutData%AngVelEX,1) - OutData%AngVelEX(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%TeetAngVel = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%AngAccEBt,1) - i1_u = UBOUND(OutData%AngAccEBt,1) - DO i1 = LBOUND(OutData%AngAccEBt,1), UBOUND(OutData%AngAccEBt,1) - OutData%AngAccEBt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%AngAccERt,1) - i1_u = UBOUND(OutData%AngAccERt,1) - DO i1 = LBOUND(OutData%AngAccERt,1), UBOUND(OutData%AngAccERt,1) - OutData%AngAccERt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%AngAccEXt,1) - i1_u = UBOUND(OutData%AngAccEXt,1) - DO i1 = LBOUND(OutData%AngAccEXt,1), UBOUND(OutData%AngAccEXt,1) - OutData%AngAccEXt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngAccEFt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AngAccEFt)) DEALLOCATE(OutData%AngAccEFt) - ALLOCATE(OutData%AngAccEFt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngAccEFt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AngAccEFt,2), UBOUND(OutData%AngAccEFt,2) - DO i1 = LBOUND(OutData%AngAccEFt,1), UBOUND(OutData%AngAccEFt,1) - OutData%AngAccEFt(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngVelEF not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AngVelEF)) DEALLOCATE(OutData%AngVelEF) - ALLOCATE(OutData%AngVelEF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngVelEF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AngVelEF,2), UBOUND(OutData%AngVelEF,2) - DO i1 = LBOUND(OutData%AngVelEF,1), UBOUND(OutData%AngVelEF,1) - OutData%AngVelEF(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngVelHM not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AngVelHM)) DEALLOCATE(OutData%AngVelHM) - ALLOCATE(OutData%AngVelHM(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngVelHM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AngVelHM,3), UBOUND(OutData%AngVelHM,3) - DO i2 = LBOUND(OutData%AngVelHM,2), UBOUND(OutData%AngVelHM,2) - DO i1 = LBOUND(OutData%AngVelHM,1), UBOUND(OutData%AngVelHM,1) - OutData%AngVelHM(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%AngAccEAt,1) - i1_u = UBOUND(OutData%AngAccEAt,1) - DO i1 = LBOUND(OutData%AngAccEAt,1), UBOUND(OutData%AngAccEAt,1) - OutData%AngAccEAt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%AngAccEGt,1) - i1_u = UBOUND(OutData%AngAccEGt,1) - DO i1 = LBOUND(OutData%AngAccEGt,1), UBOUND(OutData%AngAccEGt,1) - OutData%AngAccEGt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%AngAccEHt,1) - i1_u = UBOUND(OutData%AngAccEHt,1) - DO i1 = LBOUND(OutData%AngAccEHt,1), UBOUND(OutData%AngAccEHt,1) - OutData%AngAccEHt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngAccEKt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AngAccEKt)) DEALLOCATE(OutData%AngAccEKt) - ALLOCATE(OutData%AngAccEKt(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngAccEKt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AngAccEKt,3), UBOUND(OutData%AngAccEKt,3) - DO i2 = LBOUND(OutData%AngAccEKt,2), UBOUND(OutData%AngAccEKt,2) - DO i1 = LBOUND(OutData%AngAccEKt,1), UBOUND(OutData%AngAccEKt,1) - OutData%AngAccEKt(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%AngAccENt,1) - i1_u = UBOUND(OutData%AngAccENt,1) - DO i1 = LBOUND(OutData%AngAccENt,1), UBOUND(OutData%AngAccENt,1) - OutData%AngAccENt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%LinAccECt,1) - i1_u = UBOUND(OutData%LinAccECt,1) - DO i1 = LBOUND(OutData%LinAccECt,1), UBOUND(OutData%LinAccECt,1) - OutData%LinAccECt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%LinAccEDt,1) - i1_u = UBOUND(OutData%LinAccEDt,1) - DO i1 = LBOUND(OutData%LinAccEDt,1), UBOUND(OutData%LinAccEDt,1) - OutData%LinAccEDt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%LinAccEIt,1) - i1_u = UBOUND(OutData%LinAccEIt,1) - DO i1 = LBOUND(OutData%LinAccEIt,1), UBOUND(OutData%LinAccEIt,1) - OutData%LinAccEIt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%LinAccEJt,1) - i1_u = UBOUND(OutData%LinAccEJt,1) - DO i1 = LBOUND(OutData%LinAccEJt,1), UBOUND(OutData%LinAccEJt,1) - OutData%LinAccEJt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%LinAccEUt,1) - i1_u = UBOUND(OutData%LinAccEUt,1) - DO i1 = LBOUND(OutData%LinAccEUt,1), UBOUND(OutData%LinAccEUt,1) - OutData%LinAccEUt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%LinAccEYt,1) - i1_u = UBOUND(OutData%LinAccEYt,1) - DO i1 = LBOUND(OutData%LinAccEYt,1), UBOUND(OutData%LinAccEYt,1) - OutData%LinAccEYt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinVelES not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LinVelES)) DEALLOCATE(OutData%LinVelES) - ALLOCATE(OutData%LinVelES(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinVelES.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%LinVelES,3), UBOUND(OutData%LinVelES,3) - DO i2 = LBOUND(OutData%LinVelES,2), UBOUND(OutData%LinVelES,2) - DO i1 = LBOUND(OutData%LinVelES,1), UBOUND(OutData%LinVelES,1) - OutData%LinVelES(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%LinVelEQ,1) - i1_u = UBOUND(OutData%LinVelEQ,1) - DO i1 = LBOUND(OutData%LinVelEQ,1), UBOUND(OutData%LinVelEQ,1) - OutData%LinVelEQ(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinVelET not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LinVelET)) DEALLOCATE(OutData%LinVelET) - ALLOCATE(OutData%LinVelET(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinVelET.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%LinVelET,2), UBOUND(OutData%LinVelET,2) - DO i1 = LBOUND(OutData%LinVelET,1), UBOUND(OutData%LinVelET,1) - OutData%LinVelET(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinVelESm2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LinVelESm2)) DEALLOCATE(OutData%LinVelESm2) - ALLOCATE(OutData%LinVelESm2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinVelESm2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinVelESm2,1), UBOUND(OutData%LinVelESm2,1) - OutData%LinVelESm2(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEIMU not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PLinVelEIMU)) DEALLOCATE(OutData%PLinVelEIMU) - ALLOCATE(OutData%PLinVelEIMU(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEIMU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PLinVelEIMU,3), UBOUND(OutData%PLinVelEIMU,3) - DO i2 = LBOUND(OutData%PLinVelEIMU,2), UBOUND(OutData%PLinVelEIMU,2) - DO i1 = LBOUND(OutData%PLinVelEIMU,1), UBOUND(OutData%PLinVelEIMU,1) - OutData%PLinVelEIMU(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEO not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PLinVelEO)) DEALLOCATE(OutData%PLinVelEO) - ALLOCATE(OutData%PLinVelEO(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEO.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PLinVelEO,3), UBOUND(OutData%PLinVelEO,3) - DO i2 = LBOUND(OutData%PLinVelEO,2), UBOUND(OutData%PLinVelEO,2) - DO i1 = LBOUND(OutData%PLinVelEO,1), UBOUND(OutData%PLinVelEO,1) - OutData%PLinVelEO(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelES not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i5_l = IntKiBuf( Int_Xferred ) - i5_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PLinVelES)) DEALLOCATE(OutData%PLinVelES) - ALLOCATE(OutData%PLinVelES(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelES.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i5 = LBOUND(OutData%PLinVelES,5), UBOUND(OutData%PLinVelES,5) - DO i4 = LBOUND(OutData%PLinVelES,4), UBOUND(OutData%PLinVelES,4) - DO i3 = LBOUND(OutData%PLinVelES,3), UBOUND(OutData%PLinVelES,3) - DO i2 = LBOUND(OutData%PLinVelES,2), UBOUND(OutData%PLinVelES,2) - DO i1 = LBOUND(OutData%PLinVelES,1), UBOUND(OutData%PLinVelES,1) - OutData%PLinVelES(i1,i2,i3,i4,i5) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelET not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PLinVelET)) DEALLOCATE(OutData%PLinVelET) - ALLOCATE(OutData%PLinVelET(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelET.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%PLinVelET,4), UBOUND(OutData%PLinVelET,4) - DO i3 = LBOUND(OutData%PLinVelET,3), UBOUND(OutData%PLinVelET,3) - DO i2 = LBOUND(OutData%PLinVelET,2), UBOUND(OutData%PLinVelET,2) - DO i1 = LBOUND(OutData%PLinVelET,1), UBOUND(OutData%PLinVelET,1) - OutData%PLinVelET(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEZ not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PLinVelEZ)) DEALLOCATE(OutData%PLinVelEZ) - ALLOCATE(OutData%PLinVelEZ(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PLinVelEZ,3), UBOUND(OutData%PLinVelEZ,3) - DO i2 = LBOUND(OutData%PLinVelEZ,2), UBOUND(OutData%PLinVelEZ,2) - DO i1 = LBOUND(OutData%PLinVelEZ,1), UBOUND(OutData%PLinVelEZ,1) - OutData%PLinVelEZ(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PLinVelEC)) DEALLOCATE(OutData%PLinVelEC) - ALLOCATE(OutData%PLinVelEC(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PLinVelEC,3), UBOUND(OutData%PLinVelEC,3) - DO i2 = LBOUND(OutData%PLinVelEC,2), UBOUND(OutData%PLinVelEC,2) - DO i1 = LBOUND(OutData%PLinVelEC,1), UBOUND(OutData%PLinVelEC,1) - OutData%PLinVelEC(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelED not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PLinVelED)) DEALLOCATE(OutData%PLinVelED) - ALLOCATE(OutData%PLinVelED(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelED.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PLinVelED,3), UBOUND(OutData%PLinVelED,3) - DO i2 = LBOUND(OutData%PLinVelED,2), UBOUND(OutData%PLinVelED,2) - DO i1 = LBOUND(OutData%PLinVelED,1), UBOUND(OutData%PLinVelED,1) - OutData%PLinVelED(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEI not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PLinVelEI)) DEALLOCATE(OutData%PLinVelEI) - ALLOCATE(OutData%PLinVelEI(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PLinVelEI,3), UBOUND(OutData%PLinVelEI,3) - DO i2 = LBOUND(OutData%PLinVelEI,2), UBOUND(OutData%PLinVelEI,2) - DO i1 = LBOUND(OutData%PLinVelEI,1), UBOUND(OutData%PLinVelEI,1) - OutData%PLinVelEI(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEJ not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PLinVelEJ)) DEALLOCATE(OutData%PLinVelEJ) - ALLOCATE(OutData%PLinVelEJ(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEJ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PLinVelEJ,3), UBOUND(OutData%PLinVelEJ,3) - DO i2 = LBOUND(OutData%PLinVelEJ,2), UBOUND(OutData%PLinVelEJ,2) - DO i1 = LBOUND(OutData%PLinVelEJ,1), UBOUND(OutData%PLinVelEJ,1) - OutData%PLinVelEJ(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEP not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PLinVelEP)) DEALLOCATE(OutData%PLinVelEP) - ALLOCATE(OutData%PLinVelEP(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PLinVelEP,3), UBOUND(OutData%PLinVelEP,3) - DO i2 = LBOUND(OutData%PLinVelEP,2), UBOUND(OutData%PLinVelEP,2) - DO i1 = LBOUND(OutData%PLinVelEP,1), UBOUND(OutData%PLinVelEP,1) - OutData%PLinVelEP(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEQ not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PLinVelEQ)) DEALLOCATE(OutData%PLinVelEQ) - ALLOCATE(OutData%PLinVelEQ(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEQ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PLinVelEQ,3), UBOUND(OutData%PLinVelEQ,3) - DO i2 = LBOUND(OutData%PLinVelEQ,2), UBOUND(OutData%PLinVelEQ,2) - DO i1 = LBOUND(OutData%PLinVelEQ,1), UBOUND(OutData%PLinVelEQ,1) - OutData%PLinVelEQ(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEU not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PLinVelEU)) DEALLOCATE(OutData%PLinVelEU) - ALLOCATE(OutData%PLinVelEU(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PLinVelEU,3), UBOUND(OutData%PLinVelEU,3) - DO i2 = LBOUND(OutData%PLinVelEU,2), UBOUND(OutData%PLinVelEU,2) - DO i1 = LBOUND(OutData%PLinVelEU,1), UBOUND(OutData%PLinVelEU,1) - OutData%PLinVelEU(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEV not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PLinVelEV)) DEALLOCATE(OutData%PLinVelEV) - ALLOCATE(OutData%PLinVelEV(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PLinVelEV,3), UBOUND(OutData%PLinVelEV,3) - DO i2 = LBOUND(OutData%PLinVelEV,2), UBOUND(OutData%PLinVelEV,2) - DO i1 = LBOUND(OutData%PLinVelEV,1), UBOUND(OutData%PLinVelEV,1) - OutData%PLinVelEV(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEW not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PLinVelEW)) DEALLOCATE(OutData%PLinVelEW) - ALLOCATE(OutData%PLinVelEW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PLinVelEW,3), UBOUND(OutData%PLinVelEW,3) - DO i2 = LBOUND(OutData%PLinVelEW,2), UBOUND(OutData%PLinVelEW,2) - DO i1 = LBOUND(OutData%PLinVelEW,1), UBOUND(OutData%PLinVelEW,1) - OutData%PLinVelEW(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEY not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PLinVelEY)) DEALLOCATE(OutData%PLinVelEY) - ALLOCATE(OutData%PLinVelEY(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PLinVelEY,3), UBOUND(OutData%PLinVelEY,3) - DO i2 = LBOUND(OutData%PLinVelEY,2), UBOUND(OutData%PLinVelEY,2) - DO i1 = LBOUND(OutData%PLinVelEY,1), UBOUND(OutData%PLinVelEY,1) - OutData%PLinVelEY(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%LinAccEIMUt,1) - i1_u = UBOUND(OutData%LinAccEIMUt,1) - DO i1 = LBOUND(OutData%LinAccEIMUt,1), UBOUND(OutData%LinAccEIMUt,1) - OutData%LinAccEIMUt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%LinAccEOt,1) - i1_u = UBOUND(OutData%LinAccEOt,1) - DO i1 = LBOUND(OutData%LinAccEOt,1), UBOUND(OutData%LinAccEOt,1) - OutData%LinAccEOt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinAccESt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LinAccESt)) DEALLOCATE(OutData%LinAccESt) - ALLOCATE(OutData%LinAccESt(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinAccESt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%LinAccESt,3), UBOUND(OutData%LinAccESt,3) - DO i2 = LBOUND(OutData%LinAccESt,2), UBOUND(OutData%LinAccESt,2) - DO i1 = LBOUND(OutData%LinAccESt,1), UBOUND(OutData%LinAccESt,1) - OutData%LinAccESt(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinAccETt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LinAccETt)) DEALLOCATE(OutData%LinAccETt) - ALLOCATE(OutData%LinAccETt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinAccETt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%LinAccETt,2), UBOUND(OutData%LinAccETt,2) - DO i1 = LBOUND(OutData%LinAccETt,1), UBOUND(OutData%LinAccETt,1) - OutData%LinAccETt(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%LinAccEZt,1) - i1_u = UBOUND(OutData%LinAccEZt,1) - DO i1 = LBOUND(OutData%LinAccEZt,1), UBOUND(OutData%LinAccEZt,1) - OutData%LinAccEZt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%LinVelEIMU,1) - i1_u = UBOUND(OutData%LinVelEIMU,1) - DO i1 = LBOUND(OutData%LinVelEIMU,1), UBOUND(OutData%LinVelEIMU,1) - OutData%LinVelEIMU(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%LinVelEZ,1) - i1_u = UBOUND(OutData%LinVelEZ,1) - DO i1 = LBOUND(OutData%LinVelEZ,1), UBOUND(OutData%LinVelEZ,1) - OutData%LinVelEZ(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%LinVelEO,1) - i1_u = UBOUND(OutData%LinVelEO,1) - DO i1 = LBOUND(OutData%LinVelEO,1), UBOUND(OutData%LinVelEO,1) - OutData%LinVelEO(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%LinVelEJ,1) - i1_u = UBOUND(OutData%LinVelEJ,1) - DO i1 = LBOUND(OutData%LinVelEJ,1), UBOUND(OutData%LinVelEJ,1) - OutData%LinVelEJ(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%FrcONcRtt,1) - i1_u = UBOUND(OutData%FrcONcRtt,1) - DO i1 = LBOUND(OutData%FrcONcRtt,1), UBOUND(OutData%FrcONcRtt,1) - OutData%FrcONcRtt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%FrcPRott,1) - i1_u = UBOUND(OutData%FrcPRott,1) - DO i1 = LBOUND(OutData%FrcPRott,1), UBOUND(OutData%FrcPRott,1) - OutData%FrcPRott(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FrcS0Bt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FrcS0Bt)) DEALLOCATE(OutData%FrcS0Bt) - ALLOCATE(OutData%FrcS0Bt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FrcS0Bt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FrcS0Bt,2), UBOUND(OutData%FrcS0Bt,2) - DO i1 = LBOUND(OutData%FrcS0Bt,1), UBOUND(OutData%FrcS0Bt,1) - OutData%FrcS0Bt(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%FrcT0Trbt,1) - i1_u = UBOUND(OutData%FrcT0Trbt,1) - DO i1 = LBOUND(OutData%FrcT0Trbt,1), UBOUND(OutData%FrcT0Trbt,1) - OutData%FrcT0Trbt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FSAero not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FSAero)) DEALLOCATE(OutData%FSAero) - ALLOCATE(OutData%FSAero(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSAero.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%FSAero,3), UBOUND(OutData%FSAero,3) - DO i2 = LBOUND(OutData%FSAero,2), UBOUND(OutData%FSAero,2) - DO i1 = LBOUND(OutData%FSAero,1), UBOUND(OutData%FSAero,1) - OutData%FSAero(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FSTipDrag not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FSTipDrag)) DEALLOCATE(OutData%FSTipDrag) - ALLOCATE(OutData%FSTipDrag(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSTipDrag.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FSTipDrag,2), UBOUND(OutData%FSTipDrag,2) - DO i1 = LBOUND(OutData%FSTipDrag,1), UBOUND(OutData%FSTipDrag,1) - OutData%FSTipDrag(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FTHydrot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FTHydrot)) DEALLOCATE(OutData%FTHydrot) - ALLOCATE(OutData%FTHydrot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FTHydrot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FTHydrot,2), UBOUND(OutData%FTHydrot,2) - DO i1 = LBOUND(OutData%FTHydrot,1), UBOUND(OutData%FTHydrot,1) - OutData%FTHydrot(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%FZHydrot,1) - i1_u = UBOUND(OutData%FZHydrot,1) - DO i1 = LBOUND(OutData%FZHydrot,1), UBOUND(OutData%FZHydrot,1) - OutData%FZHydrot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MFHydrot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MFHydrot)) DEALLOCATE(OutData%MFHydrot) - ALLOCATE(OutData%MFHydrot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MFHydrot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MFHydrot,2), UBOUND(OutData%MFHydrot,2) - DO i1 = LBOUND(OutData%MFHydrot,1), UBOUND(OutData%MFHydrot,1) - OutData%MFHydrot(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%MomBNcRtt,1) - i1_u = UBOUND(OutData%MomBNcRtt,1) - DO i1 = LBOUND(OutData%MomBNcRtt,1), UBOUND(OutData%MomBNcRtt,1) - OutData%MomBNcRtt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MomH0Bt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MomH0Bt)) DEALLOCATE(OutData%MomH0Bt) - ALLOCATE(OutData%MomH0Bt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MomH0Bt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MomH0Bt,2), UBOUND(OutData%MomH0Bt,2) - DO i1 = LBOUND(OutData%MomH0Bt,1), UBOUND(OutData%MomH0Bt,1) - OutData%MomH0Bt(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%MomLPRott,1) - i1_u = UBOUND(OutData%MomLPRott,1) - DO i1 = LBOUND(OutData%MomLPRott,1), UBOUND(OutData%MomLPRott,1) - OutData%MomLPRott(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%MomNGnRtt,1) - i1_u = UBOUND(OutData%MomNGnRtt,1) - DO i1 = LBOUND(OutData%MomNGnRtt,1), UBOUND(OutData%MomNGnRtt,1) - OutData%MomNGnRtt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%MomNTailt,1) - i1_u = UBOUND(OutData%MomNTailt,1) - DO i1 = LBOUND(OutData%MomNTailt,1), UBOUND(OutData%MomNTailt,1) - OutData%MomNTailt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%MomX0Trbt,1) - i1_u = UBOUND(OutData%MomX0Trbt,1) - DO i1 = LBOUND(OutData%MomX0Trbt,1), UBOUND(OutData%MomX0Trbt,1) - OutData%MomX0Trbt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MMAero not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MMAero)) DEALLOCATE(OutData%MMAero) - ALLOCATE(OutData%MMAero(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MMAero.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%MMAero,3), UBOUND(OutData%MMAero,3) - DO i2 = LBOUND(OutData%MMAero,2), UBOUND(OutData%MMAero,2) - DO i1 = LBOUND(OutData%MMAero,1), UBOUND(OutData%MMAero,1) - OutData%MMAero(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%MXHydrot,1) - i1_u = UBOUND(OutData%MXHydrot,1) - DO i1 = LBOUND(OutData%MXHydrot,1), UBOUND(OutData%MXHydrot,1) - OutData%MXHydrot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PFrcONcRt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PFrcONcRt)) DEALLOCATE(OutData%PFrcONcRt) - ALLOCATE(OutData%PFrcONcRt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcONcRt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PFrcONcRt,2), UBOUND(OutData%PFrcONcRt,2) - DO i1 = LBOUND(OutData%PFrcONcRt,1), UBOUND(OutData%PFrcONcRt,1) - OutData%PFrcONcRt(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PFrcPRot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PFrcPRot)) DEALLOCATE(OutData%PFrcPRot) - ALLOCATE(OutData%PFrcPRot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcPRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PFrcPRot,2), UBOUND(OutData%PFrcPRot,2) - DO i1 = LBOUND(OutData%PFrcPRot,1), UBOUND(OutData%PFrcPRot,1) - OutData%PFrcPRot(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PFrcS0B not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PFrcS0B)) DEALLOCATE(OutData%PFrcS0B) - ALLOCATE(OutData%PFrcS0B(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcS0B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PFrcS0B,3), UBOUND(OutData%PFrcS0B,3) - DO i2 = LBOUND(OutData%PFrcS0B,2), UBOUND(OutData%PFrcS0B,2) - DO i1 = LBOUND(OutData%PFrcS0B,1), UBOUND(OutData%PFrcS0B,1) - OutData%PFrcS0B(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PFrcT0Trb not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PFrcT0Trb)) DEALLOCATE(OutData%PFrcT0Trb) - ALLOCATE(OutData%PFrcT0Trb(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcT0Trb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PFrcT0Trb,2), UBOUND(OutData%PFrcT0Trb,2) - DO i1 = LBOUND(OutData%PFrcT0Trb,1), UBOUND(OutData%PFrcT0Trb,1) - OutData%PFrcT0Trb(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PFTHydro not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PFTHydro)) DEALLOCATE(OutData%PFTHydro) - ALLOCATE(OutData%PFTHydro(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFTHydro.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PFTHydro,3), UBOUND(OutData%PFTHydro,3) - DO i2 = LBOUND(OutData%PFTHydro,2), UBOUND(OutData%PFTHydro,2) - DO i1 = LBOUND(OutData%PFTHydro,1), UBOUND(OutData%PFTHydro,1) - OutData%PFTHydro(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%PFZHydro,1) - i1_u = UBOUND(OutData%PFZHydro,1) - i2_l = LBOUND(OutData%PFZHydro,2) - i2_u = UBOUND(OutData%PFZHydro,2) - DO i2 = LBOUND(OutData%PFZHydro,2), UBOUND(OutData%PFZHydro,2) - DO i1 = LBOUND(OutData%PFZHydro,1), UBOUND(OutData%PFZHydro,1) - OutData%PFZHydro(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMFHydro not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PMFHydro)) DEALLOCATE(OutData%PMFHydro) - ALLOCATE(OutData%PMFHydro(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMFHydro.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PMFHydro,3), UBOUND(OutData%PMFHydro,3) - DO i2 = LBOUND(OutData%PMFHydro,2), UBOUND(OutData%PMFHydro,2) - DO i1 = LBOUND(OutData%PMFHydro,1), UBOUND(OutData%PMFHydro,1) - OutData%PMFHydro(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMomBNcRt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PMomBNcRt)) DEALLOCATE(OutData%PMomBNcRt) - ALLOCATE(OutData%PMomBNcRt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomBNcRt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PMomBNcRt,2), UBOUND(OutData%PMomBNcRt,2) - DO i1 = LBOUND(OutData%PMomBNcRt,1), UBOUND(OutData%PMomBNcRt,1) - OutData%PMomBNcRt(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMomH0B not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PMomH0B)) DEALLOCATE(OutData%PMomH0B) - ALLOCATE(OutData%PMomH0B(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomH0B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PMomH0B,3), UBOUND(OutData%PMomH0B,3) - DO i2 = LBOUND(OutData%PMomH0B,2), UBOUND(OutData%PMomH0B,2) - DO i1 = LBOUND(OutData%PMomH0B,1), UBOUND(OutData%PMomH0B,1) - OutData%PMomH0B(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMomLPRot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PMomLPRot)) DEALLOCATE(OutData%PMomLPRot) - ALLOCATE(OutData%PMomLPRot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomLPRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PMomLPRot,2), UBOUND(OutData%PMomLPRot,2) - DO i1 = LBOUND(OutData%PMomLPRot,1), UBOUND(OutData%PMomLPRot,1) - OutData%PMomLPRot(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMomNGnRt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PMomNGnRt)) DEALLOCATE(OutData%PMomNGnRt) - ALLOCATE(OutData%PMomNGnRt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomNGnRt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PMomNGnRt,2), UBOUND(OutData%PMomNGnRt,2) - DO i1 = LBOUND(OutData%PMomNGnRt,1), UBOUND(OutData%PMomNGnRt,1) - OutData%PMomNGnRt(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMomNTail not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PMomNTail)) DEALLOCATE(OutData%PMomNTail) - ALLOCATE(OutData%PMomNTail(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomNTail.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PMomNTail,2), UBOUND(OutData%PMomNTail,2) - DO i1 = LBOUND(OutData%PMomNTail,1), UBOUND(OutData%PMomNTail,1) - OutData%PMomNTail(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMomX0Trb not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PMomX0Trb)) DEALLOCATE(OutData%PMomX0Trb) - ALLOCATE(OutData%PMomX0Trb(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomX0Trb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PMomX0Trb,2), UBOUND(OutData%PMomX0Trb,2) - DO i1 = LBOUND(OutData%PMomX0Trb,1), UBOUND(OutData%PMomX0Trb,1) - OutData%PMomX0Trb(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%PMXHydro,1) - i1_u = UBOUND(OutData%PMXHydro,1) - i2_l = LBOUND(OutData%PMXHydro,2) - i2_u = UBOUND(OutData%PMXHydro,2) - DO i2 = LBOUND(OutData%PMXHydro,2), UBOUND(OutData%PMXHydro,2) - DO i1 = LBOUND(OutData%PMXHydro,1), UBOUND(OutData%PMXHydro,1) - OutData%PMXHydro(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - OutData%TeetAng = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%FrcVGnRtt,1) - i1_u = UBOUND(OutData%FrcVGnRtt,1) - DO i1 = LBOUND(OutData%FrcVGnRtt,1), UBOUND(OutData%FrcVGnRtt,1) - OutData%FrcVGnRtt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%FrcWTailt,1) - i1_u = UBOUND(OutData%FrcWTailt,1) - DO i1 = LBOUND(OutData%FrcWTailt,1), UBOUND(OutData%FrcWTailt,1) - OutData%FrcWTailt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%FrcZAllt,1) - i1_u = UBOUND(OutData%FrcZAllt,1) - DO i1 = LBOUND(OutData%FrcZAllt,1), UBOUND(OutData%FrcZAllt,1) - OutData%FrcZAllt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%MomXAllt,1) - i1_u = UBOUND(OutData%MomXAllt,1) - DO i1 = LBOUND(OutData%MomXAllt,1), UBOUND(OutData%MomXAllt,1) - OutData%MomXAllt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PFrcVGnRt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PFrcVGnRt)) DEALLOCATE(OutData%PFrcVGnRt) - ALLOCATE(OutData%PFrcVGnRt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcVGnRt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PFrcVGnRt,2), UBOUND(OutData%PFrcVGnRt,2) - DO i1 = LBOUND(OutData%PFrcVGnRt,1), UBOUND(OutData%PFrcVGnRt,1) - OutData%PFrcVGnRt(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PFrcWTail not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PFrcWTail)) DEALLOCATE(OutData%PFrcWTail) - ALLOCATE(OutData%PFrcWTail(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcWTail.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PFrcWTail,2), UBOUND(OutData%PFrcWTail,2) - DO i1 = LBOUND(OutData%PFrcWTail,1), UBOUND(OutData%PFrcWTail,1) - OutData%PFrcWTail(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PFrcZAll not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PFrcZAll)) DEALLOCATE(OutData%PFrcZAll) - ALLOCATE(OutData%PFrcZAll(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcZAll.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PFrcZAll,2), UBOUND(OutData%PFrcZAll,2) - DO i1 = LBOUND(OutData%PFrcZAll,1), UBOUND(OutData%PFrcZAll,1) - OutData%PFrcZAll(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMomXAll not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PMomXAll)) DEALLOCATE(OutData%PMomXAll) - ALLOCATE(OutData%PMomXAll(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomXAll.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PMomXAll,2), UBOUND(OutData%PMomXAll,2) - DO i1 = LBOUND(OutData%PMomXAll,1), UBOUND(OutData%PMomXAll,1) - OutData%PMomXAll(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%TeetMom = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlMom = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlMom = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GBoxEffFac = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rSAerCen not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rSAerCen)) DEALLOCATE(OutData%rSAerCen) - ALLOCATE(OutData%rSAerCen(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rSAerCen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%rSAerCen,3), UBOUND(OutData%rSAerCen,3) - DO i2 = LBOUND(OutData%rSAerCen,2), UBOUND(OutData%rSAerCen,2) - DO i1 = LBOUND(OutData%rSAerCen,1), UBOUND(OutData%rSAerCen,1) - OutData%rSAerCen(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE ED_UnPackRtHndSide - - SUBROUTINE ED_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(ED_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcContStateData%QT)) THEN - i1_l = LBOUND(SrcContStateData%QT,1) - i1_u = UBOUND(SrcContStateData%QT,1) - IF (.NOT. ALLOCATED(DstContStateData%QT)) THEN - ALLOCATE(DstContStateData%QT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%QT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstContStateData%QT = SrcContStateData%QT -ENDIF -IF (ALLOCATED(SrcContStateData%QDT)) THEN - i1_l = LBOUND(SrcContStateData%QDT,1) - i1_u = UBOUND(SrcContStateData%QDT,1) - IF (.NOT. ALLOCATED(DstContStateData%QDT)) THEN - ALLOCATE(DstContStateData%QDT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%QDT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstContStateData%QDT = SrcContStateData%QDT -ENDIF - END SUBROUTINE ED_CopyContState - - SUBROUTINE ED_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(ED_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ContStateData%QT)) THEN - DEALLOCATE(ContStateData%QT) -ENDIF -IF (ALLOCATED(ContStateData%QDT)) THEN - DEALLOCATE(ContStateData%QDT) -ENDIF - END SUBROUTINE ED_DestroyContState - - SUBROUTINE ED_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ED_ContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_PackContState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! QT allocated yes/no - IF ( ALLOCATED(InData%QT) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! QT upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%QT) ! QT - END IF - Int_BufSz = Int_BufSz + 1 ! QDT allocated yes/no - IF ( ALLOCATED(InData%QDT) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! QDT upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%QDT) ! QDT - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%QT) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QT,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%QT,1), UBOUND(InData%QT,1) - DbKiBuf(Db_Xferred) = InData%QT(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%QDT) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QDT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QDT,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%QDT,1), UBOUND(InData%QDT,1) - DbKiBuf(Db_Xferred) = InData%QDT(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE ED_PackContState - - SUBROUTINE ED_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ED_ContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_UnPackContState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QT not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%QT)) DEALLOCATE(OutData%QT) - ALLOCATE(OutData%QT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%QT,1), UBOUND(OutData%QT,1) - OutData%QT(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QDT not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%QDT)) DEALLOCATE(OutData%QDT) - ALLOCATE(OutData%QDT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QDT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%QDT,1), UBOUND(OutData%QDT,1) - OutData%QDT(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE ED_UnPackContState - - SUBROUTINE ED_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(ED_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState - END SUBROUTINE ED_CopyDiscState - - SUBROUTINE ED_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(ED_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE ED_DestroyDiscState - - SUBROUTINE ED_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ED_DiscreteStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_PackDiscState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyDiscState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ED_PackDiscState - - SUBROUTINE ED_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ED_DiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_UnPackDiscState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyDiscState = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ED_UnPackDiscState - - SUBROUTINE ED_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(ED_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE ED_CopyConstrState - - SUBROUTINE ED_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(ED_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE ED_DestroyConstrState - - SUBROUTINE ED_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ED_ConstraintStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_PackConstrState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyConstrState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ED_PackConstrState - - SUBROUTINE ED_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ED_ConstraintStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_UnPackConstrState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyConstrState = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ED_UnPackConstrState - - SUBROUTINE ED_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(ED_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%n = SrcOtherStateData%n - DO i1 = LBOUND(SrcOtherStateData%xdot,1), UBOUND(SrcOtherStateData%xdot,1) - CALL ED_CopyContState( SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -IF (ALLOCATED(SrcOtherStateData%IC)) THEN - i1_l = LBOUND(SrcOtherStateData%IC,1) - i1_u = UBOUND(SrcOtherStateData%IC,1) - IF (.NOT. ALLOCATED(DstOtherStateData%IC)) THEN - ALLOCATE(DstOtherStateData%IC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%IC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%IC = SrcOtherStateData%IC -ENDIF - DstOtherStateData%HSSBrTrq = SrcOtherStateData%HSSBrTrq - DstOtherStateData%HSSBrTrqC = SrcOtherStateData%HSSBrTrqC - DstOtherStateData%SgnPrvLSTQ = SrcOtherStateData%SgnPrvLSTQ - DstOtherStateData%SgnLSTQ = SrcOtherStateData%SgnLSTQ - END SUBROUTINE ED_CopyOtherState - - SUBROUTINE ED_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(ED_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(OtherStateData%xdot,1), UBOUND(OtherStateData%xdot,1) - CALL ED_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -IF (ALLOCATED(OtherStateData%IC)) THEN - DEALLOCATE(OtherStateData%IC) -ENDIF - END SUBROUTINE ED_DestroyOtherState - - SUBROUTINE ED_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ED_OtherStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_PackOtherState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! n - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) - Int_BufSz = Int_BufSz + 3 ! xdot: size of buffers for each call to pack subtype - CALL ED_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xdot - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xdot - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xdot - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xdot - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 1 ! IC allocated yes/no - IF ( ALLOCATED(InData%IC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IC upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IC) ! IC - END IF - Re_BufSz = Re_BufSz + 1 ! HSSBrTrq - Re_BufSz = Re_BufSz + 1 ! HSSBrTrqC - Int_BufSz = Int_BufSz + 1 ! SgnPrvLSTQ - Int_BufSz = Int_BufSz + SIZE(InData%SgnLSTQ) ! SgnLSTQ - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%n - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) - CALL ED_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, OnlySize ) ! xdot - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - IF ( .NOT. ALLOCATED(InData%IC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IC,1), UBOUND(InData%IC,1) - IntKiBuf(Int_Xferred) = InData%IC(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%HSSBrTrq - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HSSBrTrqC - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%SgnPrvLSTQ - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%SgnLSTQ,1), UBOUND(InData%SgnLSTQ,1) - IntKiBuf(Int_Xferred) = InData%SgnLSTQ(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END SUBROUTINE ED_PackOtherState - - SUBROUTINE ED_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ED_OtherStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_UnPackOtherState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%n = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%xdot,1) - i1_u = UBOUND(OutData%xdot,1) - DO i1 = LBOUND(OutData%xdot,1), UBOUND(OutData%xdot,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ED_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%xdot(i1), ErrStat2, ErrMsg2 ) ! xdot - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IC)) DEALLOCATE(OutData%IC) - ALLOCATE(OutData%IC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IC,1), UBOUND(OutData%IC,1) - OutData%IC(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%HSSBrTrq = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HSSBrTrqC = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SgnPrvLSTQ = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%SgnLSTQ,1) - i1_u = UBOUND(OutData%SgnLSTQ,1) - DO i1 = LBOUND(OutData%SgnLSTQ,1), UBOUND(OutData%SgnLSTQ,1) - OutData%SgnLSTQ(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END SUBROUTINE ED_UnPackOtherState - - SUBROUTINE ED_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(ED_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL ED_Copycoordsys( SrcMiscData%CoordSys, DstMiscData%CoordSys, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ED_Copyrthndside( SrcMiscData%RtHS, DstMiscData%RtHS, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMiscData%AllOuts)) THEN - i1_l = LBOUND(SrcMiscData%AllOuts,1) - i1_u = UBOUND(SrcMiscData%AllOuts,1) - IF (.NOT. ALLOCATED(DstMiscData%AllOuts)) THEN - ALLOCATE(DstMiscData%AllOuts(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%AllOuts = SrcMiscData%AllOuts -ENDIF -IF (ALLOCATED(SrcMiscData%AugMat)) THEN - i1_l = LBOUND(SrcMiscData%AugMat,1) - i1_u = UBOUND(SrcMiscData%AugMat,1) - i2_l = LBOUND(SrcMiscData%AugMat,2) - i2_u = UBOUND(SrcMiscData%AugMat,2) - IF (.NOT. ALLOCATED(DstMiscData%AugMat)) THEN - ALLOCATE(DstMiscData%AugMat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AugMat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%AugMat = SrcMiscData%AugMat -ENDIF -IF (ALLOCATED(SrcMiscData%AugMat_factor)) THEN - i1_l = LBOUND(SrcMiscData%AugMat_factor,1) - i1_u = UBOUND(SrcMiscData%AugMat_factor,1) - i2_l = LBOUND(SrcMiscData%AugMat_factor,2) - i2_u = UBOUND(SrcMiscData%AugMat_factor,2) - IF (.NOT. ALLOCATED(DstMiscData%AugMat_factor)) THEN - ALLOCATE(DstMiscData%AugMat_factor(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AugMat_factor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%AugMat_factor = SrcMiscData%AugMat_factor -ENDIF -IF (ALLOCATED(SrcMiscData%SolnVec)) THEN - i1_l = LBOUND(SrcMiscData%SolnVec,1) - i1_u = UBOUND(SrcMiscData%SolnVec,1) - IF (.NOT. ALLOCATED(DstMiscData%SolnVec)) THEN - ALLOCATE(DstMiscData%SolnVec(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SolnVec.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SolnVec = SrcMiscData%SolnVec -ENDIF -IF (ALLOCATED(SrcMiscData%AugMat_pivot)) THEN - i1_l = LBOUND(SrcMiscData%AugMat_pivot,1) - i1_u = UBOUND(SrcMiscData%AugMat_pivot,1) - IF (.NOT. ALLOCATED(DstMiscData%AugMat_pivot)) THEN - ALLOCATE(DstMiscData%AugMat_pivot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AugMat_pivot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%AugMat_pivot = SrcMiscData%AugMat_pivot -ENDIF -IF (ALLOCATED(SrcMiscData%OgnlGeAzRo)) THEN - i1_l = LBOUND(SrcMiscData%OgnlGeAzRo,1) - i1_u = UBOUND(SrcMiscData%OgnlGeAzRo,1) - IF (.NOT. ALLOCATED(DstMiscData%OgnlGeAzRo)) THEN - ALLOCATE(DstMiscData%OgnlGeAzRo(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%OgnlGeAzRo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%OgnlGeAzRo = SrcMiscData%OgnlGeAzRo -ENDIF -IF (ALLOCATED(SrcMiscData%QD2T)) THEN - i1_l = LBOUND(SrcMiscData%QD2T,1) - i1_u = UBOUND(SrcMiscData%QD2T,1) - IF (.NOT. ALLOCATED(DstMiscData%QD2T)) THEN - ALLOCATE(DstMiscData%QD2T(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%QD2T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%QD2T = SrcMiscData%QD2T -ENDIF - DstMiscData%IgnoreMod = SrcMiscData%IgnoreMod - END SUBROUTINE ED_CopyMisc - - SUBROUTINE ED_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(ED_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL ED_DestroyCoordSys( MiscData%CoordSys, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ED_DestroyRtHndSide( MiscData%RtHS, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MiscData%AllOuts)) THEN - DEALLOCATE(MiscData%AllOuts) -ENDIF -IF (ALLOCATED(MiscData%AugMat)) THEN - DEALLOCATE(MiscData%AugMat) -ENDIF -IF (ALLOCATED(MiscData%AugMat_factor)) THEN - DEALLOCATE(MiscData%AugMat_factor) -ENDIF -IF (ALLOCATED(MiscData%SolnVec)) THEN - DEALLOCATE(MiscData%SolnVec) -ENDIF -IF (ALLOCATED(MiscData%AugMat_pivot)) THEN - DEALLOCATE(MiscData%AugMat_pivot) -ENDIF -IF (ALLOCATED(MiscData%OgnlGeAzRo)) THEN - DEALLOCATE(MiscData%OgnlGeAzRo) -ENDIF -IF (ALLOCATED(MiscData%QD2T)) THEN - DEALLOCATE(MiscData%QD2T) -ENDIF - END SUBROUTINE ED_DestroyMisc - - SUBROUTINE ED_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ED_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! CoordSys: size of buffers for each call to pack subtype - CALL ED_PackCoordSys( Re_Buf, Db_Buf, Int_Buf, InData%CoordSys, ErrStat2, ErrMsg2, .TRUE. ) ! CoordSys - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! CoordSys - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! CoordSys - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! CoordSys - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! RtHS: size of buffers for each call to pack subtype - CALL ED_PackRtHndSide( Re_Buf, Db_Buf, Int_Buf, InData%RtHS, ErrStat2, ErrMsg2, .TRUE. ) ! RtHS - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! RtHS - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! RtHS - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! RtHS - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! AllOuts allocated yes/no - IF ( ALLOCATED(InData%AllOuts) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AllOuts upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AllOuts) ! AllOuts - END IF - Int_BufSz = Int_BufSz + 1 ! AugMat allocated yes/no - IF ( ALLOCATED(InData%AugMat) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AugMat upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%AugMat) ! AugMat - END IF - Int_BufSz = Int_BufSz + 1 ! AugMat_factor allocated yes/no - IF ( ALLOCATED(InData%AugMat_factor) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AugMat_factor upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%AugMat_factor) ! AugMat_factor - END IF - Int_BufSz = Int_BufSz + 1 ! SolnVec allocated yes/no - IF ( ALLOCATED(InData%SolnVec) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SolnVec upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%SolnVec) ! SolnVec - END IF - Int_BufSz = Int_BufSz + 1 ! AugMat_pivot allocated yes/no - IF ( ALLOCATED(InData%AugMat_pivot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AugMat_pivot upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%AugMat_pivot) ! AugMat_pivot - END IF - Int_BufSz = Int_BufSz + 1 ! OgnlGeAzRo allocated yes/no - IF ( ALLOCATED(InData%OgnlGeAzRo) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OgnlGeAzRo upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%OgnlGeAzRo) ! OgnlGeAzRo - END IF - Int_BufSz = Int_BufSz + 1 ! QD2T allocated yes/no - IF ( ALLOCATED(InData%QD2T) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! QD2T upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%QD2T) ! QD2T - END IF - Int_BufSz = Int_BufSz + 1 ! IgnoreMod - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL ED_PackCoordSys( Re_Buf, Db_Buf, Int_Buf, InData%CoordSys, ErrStat2, ErrMsg2, OnlySize ) ! CoordSys - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL ED_PackRtHndSide( Re_Buf, Db_Buf, Int_Buf, InData%RtHS, ErrStat2, ErrMsg2, OnlySize ) ! RtHS - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%AllOuts) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AllOuts,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOuts,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AllOuts,1), UBOUND(InData%AllOuts,1) - ReKiBuf(Re_Xferred) = InData%AllOuts(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AugMat) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AugMat,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AugMat,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AugMat,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AugMat,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AugMat,2), UBOUND(InData%AugMat,2) - DO i1 = LBOUND(InData%AugMat,1), UBOUND(InData%AugMat,1) - DbKiBuf(Db_Xferred) = InData%AugMat(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AugMat_factor) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AugMat_factor,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AugMat_factor,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AugMat_factor,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AugMat_factor,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AugMat_factor,2), UBOUND(InData%AugMat_factor,2) - DO i1 = LBOUND(InData%AugMat_factor,1), UBOUND(InData%AugMat_factor,1) - DbKiBuf(Db_Xferred) = InData%AugMat_factor(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SolnVec) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SolnVec,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SolnVec,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SolnVec,1), UBOUND(InData%SolnVec,1) - DbKiBuf(Db_Xferred) = InData%SolnVec(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AugMat_pivot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AugMat_pivot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AugMat_pivot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AugMat_pivot,1), UBOUND(InData%AugMat_pivot,1) - IntKiBuf(Int_Xferred) = InData%AugMat_pivot(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OgnlGeAzRo) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OgnlGeAzRo,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OgnlGeAzRo,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OgnlGeAzRo,1), UBOUND(InData%OgnlGeAzRo,1) - ReKiBuf(Re_Xferred) = InData%OgnlGeAzRo(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%QD2T) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%QD2T,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QD2T,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%QD2T,1), UBOUND(InData%QD2T,1) - DbKiBuf(Db_Xferred) = InData%QD2T(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%IgnoreMod, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE ED_PackMisc - - SUBROUTINE ED_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ED_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ED_UnpackCoordSys( Re_Buf, Db_Buf, Int_Buf, OutData%CoordSys, ErrStat2, ErrMsg2 ) ! CoordSys - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ED_UnpackRtHndSide( Re_Buf, Db_Buf, Int_Buf, OutData%RtHS, ErrStat2, ErrMsg2 ) ! RtHS - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AllOuts not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AllOuts)) DEALLOCATE(OutData%AllOuts) - ALLOCATE(OutData%AllOuts(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AllOuts,1), UBOUND(OutData%AllOuts,1) - OutData%AllOuts(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AugMat not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AugMat)) DEALLOCATE(OutData%AugMat) - ALLOCATE(OutData%AugMat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AugMat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AugMat,2), UBOUND(OutData%AugMat,2) - DO i1 = LBOUND(OutData%AugMat,1), UBOUND(OutData%AugMat,1) - OutData%AugMat(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AugMat_factor not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AugMat_factor)) DEALLOCATE(OutData%AugMat_factor) - ALLOCATE(OutData%AugMat_factor(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AugMat_factor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AugMat_factor,2), UBOUND(OutData%AugMat_factor,2) - DO i1 = LBOUND(OutData%AugMat_factor,1), UBOUND(OutData%AugMat_factor,1) - OutData%AugMat_factor(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SolnVec not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SolnVec)) DEALLOCATE(OutData%SolnVec) - ALLOCATE(OutData%SolnVec(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SolnVec.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SolnVec,1), UBOUND(OutData%SolnVec,1) - OutData%SolnVec(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AugMat_pivot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AugMat_pivot)) DEALLOCATE(OutData%AugMat_pivot) - ALLOCATE(OutData%AugMat_pivot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AugMat_pivot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AugMat_pivot,1), UBOUND(OutData%AugMat_pivot,1) - OutData%AugMat_pivot(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OgnlGeAzRo not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OgnlGeAzRo)) DEALLOCATE(OutData%OgnlGeAzRo) - ALLOCATE(OutData%OgnlGeAzRo(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OgnlGeAzRo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OgnlGeAzRo,1), UBOUND(OutData%OgnlGeAzRo,1) - OutData%OgnlGeAzRo(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QD2T not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%QD2T)) DEALLOCATE(OutData%QD2T) - ALLOCATE(OutData%QD2T(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QD2T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%QD2T,1), UBOUND(OutData%QD2T,1) - OutData%QD2T(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - OutData%IgnoreMod = TRANSFER(IntKiBuf(Int_Xferred), OutData%IgnoreMod) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE ED_UnPackMisc - - SUBROUTINE ED_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_ParameterType), INTENT(IN) :: SrcParamData - TYPE(ED_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT - DstParamData%DT24 = SrcParamData%DT24 - DstParamData%BldNodes = SrcParamData%BldNodes - DstParamData%TipNode = SrcParamData%TipNode - DstParamData%NDOF = SrcParamData%NDOF - DstParamData%TwoPiNB = SrcParamData%TwoPiNB - DstParamData%NAug = SrcParamData%NAug - DstParamData%NPH = SrcParamData%NPH -IF (ALLOCATED(SrcParamData%PH)) THEN - i1_l = LBOUND(SrcParamData%PH,1) - i1_u = UBOUND(SrcParamData%PH,1) - IF (.NOT. ALLOCATED(DstParamData%PH)) THEN - ALLOCATE(DstParamData%PH(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PH.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%PH = SrcParamData%PH -ENDIF - DstParamData%NPM = SrcParamData%NPM -IF (ALLOCATED(SrcParamData%PM)) THEN - i1_l = LBOUND(SrcParamData%PM,1) - i1_u = UBOUND(SrcParamData%PM,1) - i2_l = LBOUND(SrcParamData%PM,2) - i2_u = UBOUND(SrcParamData%PM,2) - IF (.NOT. ALLOCATED(DstParamData%PM)) THEN - ALLOCATE(DstParamData%PM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%PM = SrcParamData%PM -ENDIF -IF (ALLOCATED(SrcParamData%DOF_Flag)) THEN - i1_l = LBOUND(SrcParamData%DOF_Flag,1) - i1_u = UBOUND(SrcParamData%DOF_Flag,1) - IF (.NOT. ALLOCATED(DstParamData%DOF_Flag)) THEN - ALLOCATE(DstParamData%DOF_Flag(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DOF_Flag.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%DOF_Flag = SrcParamData%DOF_Flag -ENDIF -IF (ALLOCATED(SrcParamData%DOF_Desc)) THEN - i1_l = LBOUND(SrcParamData%DOF_Desc,1) - i1_u = UBOUND(SrcParamData%DOF_Desc,1) - IF (.NOT. ALLOCATED(DstParamData%DOF_Desc)) THEN - ALLOCATE(DstParamData%DOF_Desc(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DOF_Desc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%DOF_Desc = SrcParamData%DOF_Desc -ENDIF - CALL ED_Copyactivedofs( SrcParamData%DOFs, DstParamData%DOFs, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%OutFmt = SrcParamData%OutFmt - DstParamData%NBlGages = SrcParamData%NBlGages - DstParamData%NTwGages = SrcParamData%NTwGages -IF (ALLOCATED(SrcParamData%OutParam)) THEN - i1_l = LBOUND(SrcParamData%OutParam,1) - i1_u = UBOUND(SrcParamData%OutParam,1) - IF (.NOT. ALLOCATED(DstParamData%OutParam)) THEN - ALLOCATE(DstParamData%OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%OutParam,1), UBOUND(SrcParamData%OutParam,1) - CALL NWTC_Library_Copyoutparmtype( SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstParamData%Delim = SrcParamData%Delim - DstParamData%AvgNrmTpRd = SrcParamData%AvgNrmTpRd - DstParamData%AzimB1Up = SrcParamData%AzimB1Up - DstParamData%CosDel3 = SrcParamData%CosDel3 -IF (ALLOCATED(SrcParamData%CosPreC)) THEN - i1_l = LBOUND(SrcParamData%CosPreC,1) - i1_u = UBOUND(SrcParamData%CosPreC,1) - IF (.NOT. ALLOCATED(DstParamData%CosPreC)) THEN - ALLOCATE(DstParamData%CosPreC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CosPreC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CosPreC = SrcParamData%CosPreC -ENDIF - DstParamData%CRFrlSkew = SrcParamData%CRFrlSkew - DstParamData%CRFrlSkw2 = SrcParamData%CRFrlSkw2 - DstParamData%CRFrlTilt = SrcParamData%CRFrlTilt - DstParamData%CRFrlTlt2 = SrcParamData%CRFrlTlt2 - DstParamData%CShftSkew = SrcParamData%CShftSkew - DstParamData%CShftTilt = SrcParamData%CShftTilt - DstParamData%CSRFrlSkw = SrcParamData%CSRFrlSkw - DstParamData%CSRFrlTlt = SrcParamData%CSRFrlTlt - DstParamData%CSTFrlSkw = SrcParamData%CSTFrlSkw - DstParamData%CSTFrlTlt = SrcParamData%CSTFrlTlt - DstParamData%CTFrlSkew = SrcParamData%CTFrlSkew - DstParamData%CTFrlSkw2 = SrcParamData%CTFrlSkw2 - DstParamData%CTFrlTilt = SrcParamData%CTFrlTilt - DstParamData%CTFrlTlt2 = SrcParamData%CTFrlTlt2 - DstParamData%HubHt = SrcParamData%HubHt - DstParamData%HubCM = SrcParamData%HubCM - DstParamData%HubRad = SrcParamData%HubRad - DstParamData%NacCMxn = SrcParamData%NacCMxn - DstParamData%NacCMyn = SrcParamData%NacCMyn - DstParamData%NacCMzn = SrcParamData%NacCMzn - DstParamData%OverHang = SrcParamData%OverHang - DstParamData%ProjArea = SrcParamData%ProjArea - DstParamData%PtfmRefzt = SrcParamData%PtfmRefzt - DstParamData%RefTwrHt = SrcParamData%RefTwrHt - DstParamData%RFrlPnt_n = SrcParamData%RFrlPnt_n - DstParamData%rVDxn = SrcParamData%rVDxn - DstParamData%rVDyn = SrcParamData%rVDyn - DstParamData%rVDzn = SrcParamData%rVDzn - DstParamData%rVIMUxn = SrcParamData%rVIMUxn - DstParamData%rVIMUyn = SrcParamData%rVIMUyn - DstParamData%rVIMUzn = SrcParamData%rVIMUzn - DstParamData%rVPxn = SrcParamData%rVPxn - DstParamData%rVPyn = SrcParamData%rVPyn - DstParamData%rVPzn = SrcParamData%rVPzn - DstParamData%rWIxn = SrcParamData%rWIxn - DstParamData%rWIyn = SrcParamData%rWIyn - DstParamData%rWIzn = SrcParamData%rWIzn - DstParamData%rWJxn = SrcParamData%rWJxn - DstParamData%rWJyn = SrcParamData%rWJyn - DstParamData%rWJzn = SrcParamData%rWJzn - DstParamData%rZT0zt = SrcParamData%rZT0zt - DstParamData%rZYzt = SrcParamData%rZYzt - DstParamData%SinDel3 = SrcParamData%SinDel3 -IF (ALLOCATED(SrcParamData%SinPreC)) THEN - i1_l = LBOUND(SrcParamData%SinPreC,1) - i1_u = UBOUND(SrcParamData%SinPreC,1) - IF (.NOT. ALLOCATED(DstParamData%SinPreC)) THEN - ALLOCATE(DstParamData%SinPreC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%SinPreC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%SinPreC = SrcParamData%SinPreC -ENDIF - DstParamData%SRFrlSkew = SrcParamData%SRFrlSkew - DstParamData%SRFrlSkw2 = SrcParamData%SRFrlSkw2 - DstParamData%SRFrlTilt = SrcParamData%SRFrlTilt - DstParamData%SRFrlTlt2 = SrcParamData%SRFrlTlt2 - DstParamData%SShftSkew = SrcParamData%SShftSkew - DstParamData%SShftTilt = SrcParamData%SShftTilt - DstParamData%STFrlSkew = SrcParamData%STFrlSkew - DstParamData%STFrlSkw2 = SrcParamData%STFrlSkw2 - DstParamData%STFrlTilt = SrcParamData%STFrlTilt - DstParamData%STFrlTlt2 = SrcParamData%STFrlTlt2 - DstParamData%TFrlPnt_n = SrcParamData%TFrlPnt_n - DstParamData%TipRad = SrcParamData%TipRad - DstParamData%TowerHt = SrcParamData%TowerHt - DstParamData%TowerBsHt = SrcParamData%TowerBsHt - DstParamData%UndSling = SrcParamData%UndSling - DstParamData%NumBl = SrcParamData%NumBl -IF (ALLOCATED(SrcParamData%AxRedTFA)) THEN - i1_l = LBOUND(SrcParamData%AxRedTFA,1) - i1_u = UBOUND(SrcParamData%AxRedTFA,1) - i2_l = LBOUND(SrcParamData%AxRedTFA,2) - i2_u = UBOUND(SrcParamData%AxRedTFA,2) - i3_l = LBOUND(SrcParamData%AxRedTFA,3) - i3_u = UBOUND(SrcParamData%AxRedTFA,3) - IF (.NOT. ALLOCATED(DstParamData%AxRedTFA)) THEN - ALLOCATE(DstParamData%AxRedTFA(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AxRedTFA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AxRedTFA = SrcParamData%AxRedTFA -ENDIF -IF (ALLOCATED(SrcParamData%AxRedTSS)) THEN - i1_l = LBOUND(SrcParamData%AxRedTSS,1) - i1_u = UBOUND(SrcParamData%AxRedTSS,1) - i2_l = LBOUND(SrcParamData%AxRedTSS,2) - i2_u = UBOUND(SrcParamData%AxRedTSS,2) - i3_l = LBOUND(SrcParamData%AxRedTSS,3) - i3_u = UBOUND(SrcParamData%AxRedTSS,3) - IF (.NOT. ALLOCATED(DstParamData%AxRedTSS)) THEN - ALLOCATE(DstParamData%AxRedTSS(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AxRedTSS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AxRedTSS = SrcParamData%AxRedTSS -ENDIF - DstParamData%CTFA = SrcParamData%CTFA - DstParamData%CTSS = SrcParamData%CTSS -IF (ALLOCATED(SrcParamData%DHNodes)) THEN - i1_l = LBOUND(SrcParamData%DHNodes,1) - i1_u = UBOUND(SrcParamData%DHNodes,1) - IF (.NOT. ALLOCATED(DstParamData%DHNodes)) THEN - ALLOCATE(DstParamData%DHNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DHNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%DHNodes = SrcParamData%DHNodes -ENDIF -IF (ALLOCATED(SrcParamData%HNodes)) THEN - i1_l = LBOUND(SrcParamData%HNodes,1) - i1_u = UBOUND(SrcParamData%HNodes,1) - IF (.NOT. ALLOCATED(DstParamData%HNodes)) THEN - ALLOCATE(DstParamData%HNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%HNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%HNodes = SrcParamData%HNodes -ENDIF -IF (ALLOCATED(SrcParamData%HNodesNorm)) THEN - i1_l = LBOUND(SrcParamData%HNodesNorm,1) - i1_u = UBOUND(SrcParamData%HNodesNorm,1) - IF (.NOT. ALLOCATED(DstParamData%HNodesNorm)) THEN - ALLOCATE(DstParamData%HNodesNorm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%HNodesNorm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%HNodesNorm = SrcParamData%HNodesNorm -ENDIF - DstParamData%KTFA = SrcParamData%KTFA - DstParamData%KTSS = SrcParamData%KTSS -IF (ALLOCATED(SrcParamData%MassT)) THEN - i1_l = LBOUND(SrcParamData%MassT,1) - i1_u = UBOUND(SrcParamData%MassT,1) - IF (.NOT. ALLOCATED(DstParamData%MassT)) THEN - ALLOCATE(DstParamData%MassT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MassT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%MassT = SrcParamData%MassT -ENDIF -IF (ALLOCATED(SrcParamData%StiffTSS)) THEN - i1_l = LBOUND(SrcParamData%StiffTSS,1) - i1_u = UBOUND(SrcParamData%StiffTSS,1) - IF (.NOT. ALLOCATED(DstParamData%StiffTSS)) THEN - ALLOCATE(DstParamData%StiffTSS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StiffTSS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%StiffTSS = SrcParamData%StiffTSS -ENDIF -IF (ALLOCATED(SrcParamData%TwrFASF)) THEN - i1_l = LBOUND(SrcParamData%TwrFASF,1) - i1_u = UBOUND(SrcParamData%TwrFASF,1) - i2_l = LBOUND(SrcParamData%TwrFASF,2) - i2_u = UBOUND(SrcParamData%TwrFASF,2) - i3_l = LBOUND(SrcParamData%TwrFASF,3) - i3_u = UBOUND(SrcParamData%TwrFASF,3) - IF (.NOT. ALLOCATED(DstParamData%TwrFASF)) THEN - ALLOCATE(DstParamData%TwrFASF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TwrFASF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TwrFASF = SrcParamData%TwrFASF -ENDIF - DstParamData%TwrFlexL = SrcParamData%TwrFlexL -IF (ALLOCATED(SrcParamData%TwrSSSF)) THEN - i1_l = LBOUND(SrcParamData%TwrSSSF,1) - i1_u = UBOUND(SrcParamData%TwrSSSF,1) - i2_l = LBOUND(SrcParamData%TwrSSSF,2) - i2_u = UBOUND(SrcParamData%TwrSSSF,2) - i3_l = LBOUND(SrcParamData%TwrSSSF,3) - i3_u = UBOUND(SrcParamData%TwrSSSF,3) - IF (.NOT. ALLOCATED(DstParamData%TwrSSSF)) THEN - ALLOCATE(DstParamData%TwrSSSF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TwrSSSF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TwrSSSF = SrcParamData%TwrSSSF -ENDIF - DstParamData%TTopNode = SrcParamData%TTopNode - DstParamData%TwrNodes = SrcParamData%TwrNodes - DstParamData%MHK = SrcParamData%MHK -IF (ALLOCATED(SrcParamData%StiffTFA)) THEN - i1_l = LBOUND(SrcParamData%StiffTFA,1) - i1_u = UBOUND(SrcParamData%StiffTFA,1) - IF (.NOT. ALLOCATED(DstParamData%StiffTFA)) THEN - ALLOCATE(DstParamData%StiffTFA(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StiffTFA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%StiffTFA = SrcParamData%StiffTFA -ENDIF - DstParamData%AtfaIner = SrcParamData%AtfaIner -IF (ALLOCATED(SrcParamData%BldCG)) THEN - i1_l = LBOUND(SrcParamData%BldCG,1) - i1_u = UBOUND(SrcParamData%BldCG,1) - IF (.NOT. ALLOCATED(DstParamData%BldCG)) THEN - ALLOCATE(DstParamData%BldCG(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldCG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BldCG = SrcParamData%BldCG -ENDIF -IF (ALLOCATED(SrcParamData%BldMass)) THEN - i1_l = LBOUND(SrcParamData%BldMass,1) - i1_u = UBOUND(SrcParamData%BldMass,1) - IF (.NOT. ALLOCATED(DstParamData%BldMass)) THEN - ALLOCATE(DstParamData%BldMass(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldMass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BldMass = SrcParamData%BldMass -ENDIF - DstParamData%BoomMass = SrcParamData%BoomMass -IF (ALLOCATED(SrcParamData%FirstMom)) THEN - i1_l = LBOUND(SrcParamData%FirstMom,1) - i1_u = UBOUND(SrcParamData%FirstMom,1) - IF (.NOT. ALLOCATED(DstParamData%FirstMom)) THEN - ALLOCATE(DstParamData%FirstMom(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FirstMom.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FirstMom = SrcParamData%FirstMom -ENDIF - DstParamData%GenIner = SrcParamData%GenIner - DstParamData%Hubg1Iner = SrcParamData%Hubg1Iner - DstParamData%Hubg2Iner = SrcParamData%Hubg2Iner - DstParamData%HubMass = SrcParamData%HubMass - DstParamData%Nacd2Iner = SrcParamData%Nacd2Iner - DstParamData%NacMass = SrcParamData%NacMass - DstParamData%PtfmMass = SrcParamData%PtfmMass - DstParamData%PtfmPIner = SrcParamData%PtfmPIner - DstParamData%PtfmRIner = SrcParamData%PtfmRIner - DstParamData%PtfmYIner = SrcParamData%PtfmYIner - DstParamData%RFrlMass = SrcParamData%RFrlMass - DstParamData%RotIner = SrcParamData%RotIner - DstParamData%RotMass = SrcParamData%RotMass - DstParamData%RrfaIner = SrcParamData%RrfaIner -IF (ALLOCATED(SrcParamData%SecondMom)) THEN - i1_l = LBOUND(SrcParamData%SecondMom,1) - i1_u = UBOUND(SrcParamData%SecondMom,1) - IF (.NOT. ALLOCATED(DstParamData%SecondMom)) THEN - ALLOCATE(DstParamData%SecondMom(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%SecondMom.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%SecondMom = SrcParamData%SecondMom -ENDIF - DstParamData%TFinMass = SrcParamData%TFinMass - DstParamData%TFrlIner = SrcParamData%TFrlIner -IF (ALLOCATED(SrcParamData%TipMass)) THEN - i1_l = LBOUND(SrcParamData%TipMass,1) - i1_u = UBOUND(SrcParamData%TipMass,1) - IF (.NOT. ALLOCATED(DstParamData%TipMass)) THEN - ALLOCATE(DstParamData%TipMass(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TipMass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TipMass = SrcParamData%TipMass -ENDIF - DstParamData%TurbMass = SrcParamData%TurbMass - DstParamData%TwrMass = SrcParamData%TwrMass - DstParamData%TwrTpMass = SrcParamData%TwrTpMass - DstParamData%YawBrMass = SrcParamData%YawBrMass - DstParamData%Gravity = SrcParamData%Gravity -IF (ALLOCATED(SrcParamData%PitchAxis)) THEN - i1_l = LBOUND(SrcParamData%PitchAxis,1) - i1_u = UBOUND(SrcParamData%PitchAxis,1) - i2_l = LBOUND(SrcParamData%PitchAxis,2) - i2_u = UBOUND(SrcParamData%PitchAxis,2) - IF (.NOT. ALLOCATED(DstParamData%PitchAxis)) THEN - ALLOCATE(DstParamData%PitchAxis(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PitchAxis.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%PitchAxis = SrcParamData%PitchAxis -ENDIF -IF (ALLOCATED(SrcParamData%AeroTwst)) THEN - i1_l = LBOUND(SrcParamData%AeroTwst,1) - i1_u = UBOUND(SrcParamData%AeroTwst,1) - IF (.NOT. ALLOCATED(DstParamData%AeroTwst)) THEN - ALLOCATE(DstParamData%AeroTwst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AeroTwst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AeroTwst = SrcParamData%AeroTwst -ENDIF -IF (ALLOCATED(SrcParamData%AxRedBld)) THEN - i1_l = LBOUND(SrcParamData%AxRedBld,1) - i1_u = UBOUND(SrcParamData%AxRedBld,1) - i2_l = LBOUND(SrcParamData%AxRedBld,2) - i2_u = UBOUND(SrcParamData%AxRedBld,2) - i3_l = LBOUND(SrcParamData%AxRedBld,3) - i3_u = UBOUND(SrcParamData%AxRedBld,3) - i4_l = LBOUND(SrcParamData%AxRedBld,4) - i4_u = UBOUND(SrcParamData%AxRedBld,4) - IF (.NOT. ALLOCATED(DstParamData%AxRedBld)) THEN - ALLOCATE(DstParamData%AxRedBld(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AxRedBld.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AxRedBld = SrcParamData%AxRedBld -ENDIF -IF (ALLOCATED(SrcParamData%BldEDamp)) THEN - i1_l = LBOUND(SrcParamData%BldEDamp,1) - i1_u = UBOUND(SrcParamData%BldEDamp,1) - i2_l = LBOUND(SrcParamData%BldEDamp,2) - i2_u = UBOUND(SrcParamData%BldEDamp,2) - IF (.NOT. ALLOCATED(DstParamData%BldEDamp)) THEN - ALLOCATE(DstParamData%BldEDamp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldEDamp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BldEDamp = SrcParamData%BldEDamp -ENDIF -IF (ALLOCATED(SrcParamData%BldFDamp)) THEN - i1_l = LBOUND(SrcParamData%BldFDamp,1) - i1_u = UBOUND(SrcParamData%BldFDamp,1) - i2_l = LBOUND(SrcParamData%BldFDamp,2) - i2_u = UBOUND(SrcParamData%BldFDamp,2) - IF (.NOT. ALLOCATED(DstParamData%BldFDamp)) THEN - ALLOCATE(DstParamData%BldFDamp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldFDamp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BldFDamp = SrcParamData%BldFDamp -ENDIF - DstParamData%BldFlexL = SrcParamData%BldFlexL -IF (ALLOCATED(SrcParamData%CAeroTwst)) THEN - i1_l = LBOUND(SrcParamData%CAeroTwst,1) - i1_u = UBOUND(SrcParamData%CAeroTwst,1) - IF (.NOT. ALLOCATED(DstParamData%CAeroTwst)) THEN - ALLOCATE(DstParamData%CAeroTwst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CAeroTwst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CAeroTwst = SrcParamData%CAeroTwst -ENDIF -IF (ALLOCATED(SrcParamData%CBE)) THEN - i1_l = LBOUND(SrcParamData%CBE,1) - i1_u = UBOUND(SrcParamData%CBE,1) - i2_l = LBOUND(SrcParamData%CBE,2) - i2_u = UBOUND(SrcParamData%CBE,2) - i3_l = LBOUND(SrcParamData%CBE,3) - i3_u = UBOUND(SrcParamData%CBE,3) - IF (.NOT. ALLOCATED(DstParamData%CBE)) THEN - ALLOCATE(DstParamData%CBE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CBE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CBE = SrcParamData%CBE -ENDIF -IF (ALLOCATED(SrcParamData%CBF)) THEN - i1_l = LBOUND(SrcParamData%CBF,1) - i1_u = UBOUND(SrcParamData%CBF,1) - i2_l = LBOUND(SrcParamData%CBF,2) - i2_u = UBOUND(SrcParamData%CBF,2) - i3_l = LBOUND(SrcParamData%CBF,3) - i3_u = UBOUND(SrcParamData%CBF,3) - IF (.NOT. ALLOCATED(DstParamData%CBF)) THEN - ALLOCATE(DstParamData%CBF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CBF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CBF = SrcParamData%CBF -ENDIF -IF (ALLOCATED(SrcParamData%Chord)) THEN - i1_l = LBOUND(SrcParamData%Chord,1) - i1_u = UBOUND(SrcParamData%Chord,1) - IF (.NOT. ALLOCATED(DstParamData%Chord)) THEN - ALLOCATE(DstParamData%Chord(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Chord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Chord = SrcParamData%Chord -ENDIF -IF (ALLOCATED(SrcParamData%CThetaS)) THEN - i1_l = LBOUND(SrcParamData%CThetaS,1) - i1_u = UBOUND(SrcParamData%CThetaS,1) - i2_l = LBOUND(SrcParamData%CThetaS,2) - i2_u = UBOUND(SrcParamData%CThetaS,2) - IF (.NOT. ALLOCATED(DstParamData%CThetaS)) THEN - ALLOCATE(DstParamData%CThetaS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CThetaS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CThetaS = SrcParamData%CThetaS -ENDIF -IF (ALLOCATED(SrcParamData%DRNodes)) THEN - i1_l = LBOUND(SrcParamData%DRNodes,1) - i1_u = UBOUND(SrcParamData%DRNodes,1) - IF (.NOT. ALLOCATED(DstParamData%DRNodes)) THEN - ALLOCATE(DstParamData%DRNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DRNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%DRNodes = SrcParamData%DRNodes -ENDIF -IF (ALLOCATED(SrcParamData%FStTunr)) THEN - i1_l = LBOUND(SrcParamData%FStTunr,1) - i1_u = UBOUND(SrcParamData%FStTunr,1) - i2_l = LBOUND(SrcParamData%FStTunr,2) - i2_u = UBOUND(SrcParamData%FStTunr,2) - IF (.NOT. ALLOCATED(DstParamData%FStTunr)) THEN - ALLOCATE(DstParamData%FStTunr(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FStTunr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FStTunr = SrcParamData%FStTunr -ENDIF -IF (ALLOCATED(SrcParamData%KBE)) THEN - i1_l = LBOUND(SrcParamData%KBE,1) - i1_u = UBOUND(SrcParamData%KBE,1) - i2_l = LBOUND(SrcParamData%KBE,2) - i2_u = UBOUND(SrcParamData%KBE,2) - i3_l = LBOUND(SrcParamData%KBE,3) - i3_u = UBOUND(SrcParamData%KBE,3) - IF (.NOT. ALLOCATED(DstParamData%KBE)) THEN - ALLOCATE(DstParamData%KBE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KBE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%KBE = SrcParamData%KBE -ENDIF -IF (ALLOCATED(SrcParamData%KBF)) THEN - i1_l = LBOUND(SrcParamData%KBF,1) - i1_u = UBOUND(SrcParamData%KBF,1) - i2_l = LBOUND(SrcParamData%KBF,2) - i2_u = UBOUND(SrcParamData%KBF,2) - i3_l = LBOUND(SrcParamData%KBF,3) - i3_u = UBOUND(SrcParamData%KBF,3) - IF (.NOT. ALLOCATED(DstParamData%KBF)) THEN - ALLOCATE(DstParamData%KBF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KBF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%KBF = SrcParamData%KBF -ENDIF -IF (ALLOCATED(SrcParamData%MassB)) THEN - i1_l = LBOUND(SrcParamData%MassB,1) - i1_u = UBOUND(SrcParamData%MassB,1) - i2_l = LBOUND(SrcParamData%MassB,2) - i2_u = UBOUND(SrcParamData%MassB,2) - IF (.NOT. ALLOCATED(DstParamData%MassB)) THEN - ALLOCATE(DstParamData%MassB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MassB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%MassB = SrcParamData%MassB -ENDIF -IF (ALLOCATED(SrcParamData%RNodes)) THEN - i1_l = LBOUND(SrcParamData%RNodes,1) - i1_u = UBOUND(SrcParamData%RNodes,1) - IF (.NOT. ALLOCATED(DstParamData%RNodes)) THEN - ALLOCATE(DstParamData%RNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%RNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%RNodes = SrcParamData%RNodes -ENDIF -IF (ALLOCATED(SrcParamData%RNodesNorm)) THEN - i1_l = LBOUND(SrcParamData%RNodesNorm,1) - i1_u = UBOUND(SrcParamData%RNodesNorm,1) - IF (.NOT. ALLOCATED(DstParamData%RNodesNorm)) THEN - ALLOCATE(DstParamData%RNodesNorm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%RNodesNorm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%RNodesNorm = SrcParamData%RNodesNorm -ENDIF -IF (ALLOCATED(SrcParamData%rSAerCenn1)) THEN - i1_l = LBOUND(SrcParamData%rSAerCenn1,1) - i1_u = UBOUND(SrcParamData%rSAerCenn1,1) - i2_l = LBOUND(SrcParamData%rSAerCenn1,2) - i2_u = UBOUND(SrcParamData%rSAerCenn1,2) - IF (.NOT. ALLOCATED(DstParamData%rSAerCenn1)) THEN - ALLOCATE(DstParamData%rSAerCenn1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rSAerCenn1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%rSAerCenn1 = SrcParamData%rSAerCenn1 -ENDIF -IF (ALLOCATED(SrcParamData%rSAerCenn2)) THEN - i1_l = LBOUND(SrcParamData%rSAerCenn2,1) - i1_u = UBOUND(SrcParamData%rSAerCenn2,1) - i2_l = LBOUND(SrcParamData%rSAerCenn2,2) - i2_u = UBOUND(SrcParamData%rSAerCenn2,2) - IF (.NOT. ALLOCATED(DstParamData%rSAerCenn2)) THEN - ALLOCATE(DstParamData%rSAerCenn2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rSAerCenn2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%rSAerCenn2 = SrcParamData%rSAerCenn2 -ENDIF -IF (ALLOCATED(SrcParamData%SAeroTwst)) THEN - i1_l = LBOUND(SrcParamData%SAeroTwst,1) - i1_u = UBOUND(SrcParamData%SAeroTwst,1) - IF (.NOT. ALLOCATED(DstParamData%SAeroTwst)) THEN - ALLOCATE(DstParamData%SAeroTwst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%SAeroTwst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%SAeroTwst = SrcParamData%SAeroTwst -ENDIF -IF (ALLOCATED(SrcParamData%StiffBE)) THEN - i1_l = LBOUND(SrcParamData%StiffBE,1) - i1_u = UBOUND(SrcParamData%StiffBE,1) - i2_l = LBOUND(SrcParamData%StiffBE,2) - i2_u = UBOUND(SrcParamData%StiffBE,2) - IF (.NOT. ALLOCATED(DstParamData%StiffBE)) THEN - ALLOCATE(DstParamData%StiffBE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StiffBE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%StiffBE = SrcParamData%StiffBE -ENDIF -IF (ALLOCATED(SrcParamData%StiffBF)) THEN - i1_l = LBOUND(SrcParamData%StiffBF,1) - i1_u = UBOUND(SrcParamData%StiffBF,1) - i2_l = LBOUND(SrcParamData%StiffBF,2) - i2_u = UBOUND(SrcParamData%StiffBF,2) - IF (.NOT. ALLOCATED(DstParamData%StiffBF)) THEN - ALLOCATE(DstParamData%StiffBF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StiffBF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%StiffBF = SrcParamData%StiffBF -ENDIF -IF (ALLOCATED(SrcParamData%SThetaS)) THEN - i1_l = LBOUND(SrcParamData%SThetaS,1) - i1_u = UBOUND(SrcParamData%SThetaS,1) - i2_l = LBOUND(SrcParamData%SThetaS,2) - i2_u = UBOUND(SrcParamData%SThetaS,2) - IF (.NOT. ALLOCATED(DstParamData%SThetaS)) THEN - ALLOCATE(DstParamData%SThetaS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%SThetaS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%SThetaS = SrcParamData%SThetaS -ENDIF -IF (ALLOCATED(SrcParamData%ThetaS)) THEN - i1_l = LBOUND(SrcParamData%ThetaS,1) - i1_u = UBOUND(SrcParamData%ThetaS,1) - i2_l = LBOUND(SrcParamData%ThetaS,2) - i2_u = UBOUND(SrcParamData%ThetaS,2) - IF (.NOT. ALLOCATED(DstParamData%ThetaS)) THEN - ALLOCATE(DstParamData%ThetaS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ThetaS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ThetaS = SrcParamData%ThetaS -ENDIF -IF (ALLOCATED(SrcParamData%TwistedSF)) THEN - i1_l = LBOUND(SrcParamData%TwistedSF,1) - i1_u = UBOUND(SrcParamData%TwistedSF,1) - i2_l = LBOUND(SrcParamData%TwistedSF,2) - i2_u = UBOUND(SrcParamData%TwistedSF,2) - i3_l = LBOUND(SrcParamData%TwistedSF,3) - i3_u = UBOUND(SrcParamData%TwistedSF,3) - i4_l = LBOUND(SrcParamData%TwistedSF,4) - i4_u = UBOUND(SrcParamData%TwistedSF,4) - i5_l = LBOUND(SrcParamData%TwistedSF,5) - i5_u = UBOUND(SrcParamData%TwistedSF,5) - IF (.NOT. ALLOCATED(DstParamData%TwistedSF)) THEN - ALLOCATE(DstParamData%TwistedSF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TwistedSF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TwistedSF = SrcParamData%TwistedSF -ENDIF -IF (ALLOCATED(SrcParamData%BldFl1Sh)) THEN - i1_l = LBOUND(SrcParamData%BldFl1Sh,1) - i1_u = UBOUND(SrcParamData%BldFl1Sh,1) - i2_l = LBOUND(SrcParamData%BldFl1Sh,2) - i2_u = UBOUND(SrcParamData%BldFl1Sh,2) - IF (.NOT. ALLOCATED(DstParamData%BldFl1Sh)) THEN - ALLOCATE(DstParamData%BldFl1Sh(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldFl1Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BldFl1Sh = SrcParamData%BldFl1Sh -ENDIF -IF (ALLOCATED(SrcParamData%BldFl2Sh)) THEN - i1_l = LBOUND(SrcParamData%BldFl2Sh,1) - i1_u = UBOUND(SrcParamData%BldFl2Sh,1) - i2_l = LBOUND(SrcParamData%BldFl2Sh,2) - i2_u = UBOUND(SrcParamData%BldFl2Sh,2) - IF (.NOT. ALLOCATED(DstParamData%BldFl2Sh)) THEN - ALLOCATE(DstParamData%BldFl2Sh(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldFl2Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BldFl2Sh = SrcParamData%BldFl2Sh -ENDIF -IF (ALLOCATED(SrcParamData%BldEdgSh)) THEN - i1_l = LBOUND(SrcParamData%BldEdgSh,1) - i1_u = UBOUND(SrcParamData%BldEdgSh,1) - i2_l = LBOUND(SrcParamData%BldEdgSh,2) - i2_u = UBOUND(SrcParamData%BldEdgSh,2) - IF (.NOT. ALLOCATED(DstParamData%BldEdgSh)) THEN - ALLOCATE(DstParamData%BldEdgSh(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldEdgSh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BldEdgSh = SrcParamData%BldEdgSh -ENDIF -IF (ALLOCATED(SrcParamData%FreqBE)) THEN - i1_l = LBOUND(SrcParamData%FreqBE,1) - i1_u = UBOUND(SrcParamData%FreqBE,1) - i2_l = LBOUND(SrcParamData%FreqBE,2) - i2_u = UBOUND(SrcParamData%FreqBE,2) - i3_l = LBOUND(SrcParamData%FreqBE,3) - i3_u = UBOUND(SrcParamData%FreqBE,3) - IF (.NOT. ALLOCATED(DstParamData%FreqBE)) THEN - ALLOCATE(DstParamData%FreqBE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FreqBE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FreqBE = SrcParamData%FreqBE -ENDIF -IF (ALLOCATED(SrcParamData%FreqBF)) THEN - i1_l = LBOUND(SrcParamData%FreqBF,1) - i1_u = UBOUND(SrcParamData%FreqBF,1) - i2_l = LBOUND(SrcParamData%FreqBF,2) - i2_u = UBOUND(SrcParamData%FreqBF,2) - i3_l = LBOUND(SrcParamData%FreqBF,3) - i3_u = UBOUND(SrcParamData%FreqBF,3) - IF (.NOT. ALLOCATED(DstParamData%FreqBF)) THEN - ALLOCATE(DstParamData%FreqBF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FreqBF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FreqBF = SrcParamData%FreqBF -ENDIF - DstParamData%FreqTFA = SrcParamData%FreqTFA - DstParamData%FreqTSS = SrcParamData%FreqTSS - DstParamData%TeetCDmp = SrcParamData%TeetCDmp - DstParamData%TeetDmp = SrcParamData%TeetDmp - DstParamData%TeetDmpP = SrcParamData%TeetDmpP - DstParamData%TeetHSSp = SrcParamData%TeetHSSp - DstParamData%TeetHStP = SrcParamData%TeetHStP - DstParamData%TeetSSSp = SrcParamData%TeetSSSp - DstParamData%TeetSStP = SrcParamData%TeetSStP - DstParamData%TeetMod = SrcParamData%TeetMod - DstParamData%TFrlDmp = SrcParamData%TFrlDmp - DstParamData%TFrlDSDmp = SrcParamData%TFrlDSDmp - DstParamData%TFrlDSDP = SrcParamData%TFrlDSDP - DstParamData%TFrlDSSP = SrcParamData%TFrlDSSP - DstParamData%TFrlDSSpr = SrcParamData%TFrlDSSpr - DstParamData%TFrlSpr = SrcParamData%TFrlSpr - DstParamData%TFrlUSDmp = SrcParamData%TFrlUSDmp - DstParamData%TFrlUSDP = SrcParamData%TFrlUSDP - DstParamData%TFrlUSSP = SrcParamData%TFrlUSSP - DstParamData%TFrlUSSpr = SrcParamData%TFrlUSSpr - DstParamData%TFrlMod = SrcParamData%TFrlMod - DstParamData%RFrlDmp = SrcParamData%RFrlDmp - DstParamData%RFrlDSDmp = SrcParamData%RFrlDSDmp - DstParamData%RFrlDSDP = SrcParamData%RFrlDSDP - DstParamData%RFrlDSSP = SrcParamData%RFrlDSSP - DstParamData%RFrlDSSpr = SrcParamData%RFrlDSSpr - DstParamData%RFrlSpr = SrcParamData%RFrlSpr - DstParamData%RFrlUSDmp = SrcParamData%RFrlUSDmp - DstParamData%RFrlUSDP = SrcParamData%RFrlUSDP - DstParamData%RFrlUSSP = SrcParamData%RFrlUSSP - DstParamData%RFrlUSSpr = SrcParamData%RFrlUSSpr - DstParamData%RFrlMod = SrcParamData%RFrlMod - DstParamData%ShftGagL = SrcParamData%ShftGagL - DstParamData%BldGagNd = SrcParamData%BldGagNd - DstParamData%TwrGagNd = SrcParamData%TwrGagNd - DstParamData%TStart = SrcParamData%TStart - DstParamData%DTTorDmp = SrcParamData%DTTorDmp - DstParamData%DTTorSpr = SrcParamData%DTTorSpr - DstParamData%GBRatio = SrcParamData%GBRatio - DstParamData%GBoxEff = SrcParamData%GBoxEff - DstParamData%RotSpeed = SrcParamData%RotSpeed - DstParamData%RootName = SrcParamData%RootName -IF (ALLOCATED(SrcParamData%BElmntMass)) THEN - i1_l = LBOUND(SrcParamData%BElmntMass,1) - i1_u = UBOUND(SrcParamData%BElmntMass,1) - i2_l = LBOUND(SrcParamData%BElmntMass,2) - i2_u = UBOUND(SrcParamData%BElmntMass,2) - IF (.NOT. ALLOCATED(DstParamData%BElmntMass)) THEN - ALLOCATE(DstParamData%BElmntMass(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BElmntMass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BElmntMass = SrcParamData%BElmntMass -ENDIF -IF (ALLOCATED(SrcParamData%TElmntMass)) THEN - i1_l = LBOUND(SrcParamData%TElmntMass,1) - i1_u = UBOUND(SrcParamData%TElmntMass,1) - IF (.NOT. ALLOCATED(DstParamData%TElmntMass)) THEN - ALLOCATE(DstParamData%TElmntMass(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TElmntMass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TElmntMass = SrcParamData%TElmntMass -ENDIF - DstParamData%method = SrcParamData%method - DstParamData%PtfmCMxt = SrcParamData%PtfmCMxt - DstParamData%PtfmCMyt = SrcParamData%PtfmCMyt - DstParamData%BD4Blades = SrcParamData%BD4Blades - DstParamData%UseAD14 = SrcParamData%UseAD14 - DstParamData%BldNd_NumOuts = SrcParamData%BldNd_NumOuts - DstParamData%BldNd_TotNumOuts = SrcParamData%BldNd_TotNumOuts -IF (ALLOCATED(SrcParamData%BldNd_OutParam)) THEN - i1_l = LBOUND(SrcParamData%BldNd_OutParam,1) - i1_u = UBOUND(SrcParamData%BldNd_OutParam,1) - IF (.NOT. ALLOCATED(DstParamData%BldNd_OutParam)) THEN - ALLOCATE(DstParamData%BldNd_OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldNd_OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%BldNd_OutParam,1), UBOUND(SrcParamData%BldNd_OutParam,1) - CALL NWTC_Library_Copyoutparmtype( SrcParamData%BldNd_OutParam(i1), DstParamData%BldNd_OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstParamData%BldNd_BladesOut = SrcParamData%BldNd_BladesOut -IF (ALLOCATED(SrcParamData%Jac_u_indx)) THEN - i1_l = LBOUND(SrcParamData%Jac_u_indx,1) - i1_u = UBOUND(SrcParamData%Jac_u_indx,1) - i2_l = LBOUND(SrcParamData%Jac_u_indx,2) - i2_u = UBOUND(SrcParamData%Jac_u_indx,2) - IF (.NOT. ALLOCATED(DstParamData%Jac_u_indx)) THEN - ALLOCATE(DstParamData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx -ENDIF -IF (ALLOCATED(SrcParamData%du)) THEN - i1_l = LBOUND(SrcParamData%du,1) - i1_u = UBOUND(SrcParamData%du,1) - IF (.NOT. ALLOCATED(DstParamData%du)) THEN - ALLOCATE(DstParamData%du(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%du = SrcParamData%du -ENDIF -IF (ALLOCATED(SrcParamData%dx)) THEN - i1_l = LBOUND(SrcParamData%dx,1) - i1_u = UBOUND(SrcParamData%dx,1) - IF (.NOT. ALLOCATED(DstParamData%dx)) THEN - ALLOCATE(DstParamData%dx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%dx = SrcParamData%dx -ENDIF - DstParamData%Jac_ny = SrcParamData%Jac_ny - END SUBROUTINE ED_CopyParam - - SUBROUTINE ED_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(ED_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%PH)) THEN - DEALLOCATE(ParamData%PH) -ENDIF -IF (ALLOCATED(ParamData%PM)) THEN - DEALLOCATE(ParamData%PM) -ENDIF -IF (ALLOCATED(ParamData%DOF_Flag)) THEN - DEALLOCATE(ParamData%DOF_Flag) -ENDIF -IF (ALLOCATED(ParamData%DOF_Desc)) THEN - DEALLOCATE(ParamData%DOF_Desc) -ENDIF - CALL ED_DestroyActiveDOFs( ParamData%DOFs, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ParamData%OutParam)) THEN -DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_DestroyOutParmType( ParamData%OutParam(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%OutParam) -ENDIF -IF (ALLOCATED(ParamData%CosPreC)) THEN - DEALLOCATE(ParamData%CosPreC) -ENDIF -IF (ALLOCATED(ParamData%SinPreC)) THEN - DEALLOCATE(ParamData%SinPreC) -ENDIF -IF (ALLOCATED(ParamData%AxRedTFA)) THEN - DEALLOCATE(ParamData%AxRedTFA) -ENDIF -IF (ALLOCATED(ParamData%AxRedTSS)) THEN - DEALLOCATE(ParamData%AxRedTSS) -ENDIF -IF (ALLOCATED(ParamData%DHNodes)) THEN - DEALLOCATE(ParamData%DHNodes) -ENDIF -IF (ALLOCATED(ParamData%HNodes)) THEN - DEALLOCATE(ParamData%HNodes) -ENDIF -IF (ALLOCATED(ParamData%HNodesNorm)) THEN - DEALLOCATE(ParamData%HNodesNorm) -ENDIF -IF (ALLOCATED(ParamData%MassT)) THEN - DEALLOCATE(ParamData%MassT) -ENDIF -IF (ALLOCATED(ParamData%StiffTSS)) THEN - DEALLOCATE(ParamData%StiffTSS) -ENDIF -IF (ALLOCATED(ParamData%TwrFASF)) THEN - DEALLOCATE(ParamData%TwrFASF) -ENDIF -IF (ALLOCATED(ParamData%TwrSSSF)) THEN - DEALLOCATE(ParamData%TwrSSSF) -ENDIF -IF (ALLOCATED(ParamData%StiffTFA)) THEN - DEALLOCATE(ParamData%StiffTFA) -ENDIF -IF (ALLOCATED(ParamData%BldCG)) THEN - DEALLOCATE(ParamData%BldCG) -ENDIF -IF (ALLOCATED(ParamData%BldMass)) THEN - DEALLOCATE(ParamData%BldMass) -ENDIF -IF (ALLOCATED(ParamData%FirstMom)) THEN - DEALLOCATE(ParamData%FirstMom) -ENDIF -IF (ALLOCATED(ParamData%SecondMom)) THEN - DEALLOCATE(ParamData%SecondMom) -ENDIF -IF (ALLOCATED(ParamData%TipMass)) THEN - DEALLOCATE(ParamData%TipMass) -ENDIF -IF (ALLOCATED(ParamData%PitchAxis)) THEN - DEALLOCATE(ParamData%PitchAxis) -ENDIF -IF (ALLOCATED(ParamData%AeroTwst)) THEN - DEALLOCATE(ParamData%AeroTwst) -ENDIF -IF (ALLOCATED(ParamData%AxRedBld)) THEN - DEALLOCATE(ParamData%AxRedBld) -ENDIF -IF (ALLOCATED(ParamData%BldEDamp)) THEN - DEALLOCATE(ParamData%BldEDamp) -ENDIF -IF (ALLOCATED(ParamData%BldFDamp)) THEN - DEALLOCATE(ParamData%BldFDamp) -ENDIF -IF (ALLOCATED(ParamData%CAeroTwst)) THEN - DEALLOCATE(ParamData%CAeroTwst) -ENDIF -IF (ALLOCATED(ParamData%CBE)) THEN - DEALLOCATE(ParamData%CBE) -ENDIF -IF (ALLOCATED(ParamData%CBF)) THEN - DEALLOCATE(ParamData%CBF) -ENDIF -IF (ALLOCATED(ParamData%Chord)) THEN - DEALLOCATE(ParamData%Chord) -ENDIF -IF (ALLOCATED(ParamData%CThetaS)) THEN - DEALLOCATE(ParamData%CThetaS) -ENDIF -IF (ALLOCATED(ParamData%DRNodes)) THEN - DEALLOCATE(ParamData%DRNodes) -ENDIF -IF (ALLOCATED(ParamData%FStTunr)) THEN - DEALLOCATE(ParamData%FStTunr) -ENDIF -IF (ALLOCATED(ParamData%KBE)) THEN - DEALLOCATE(ParamData%KBE) -ENDIF -IF (ALLOCATED(ParamData%KBF)) THEN - DEALLOCATE(ParamData%KBF) -ENDIF -IF (ALLOCATED(ParamData%MassB)) THEN - DEALLOCATE(ParamData%MassB) -ENDIF -IF (ALLOCATED(ParamData%RNodes)) THEN - DEALLOCATE(ParamData%RNodes) -ENDIF -IF (ALLOCATED(ParamData%RNodesNorm)) THEN - DEALLOCATE(ParamData%RNodesNorm) -ENDIF -IF (ALLOCATED(ParamData%rSAerCenn1)) THEN - DEALLOCATE(ParamData%rSAerCenn1) -ENDIF -IF (ALLOCATED(ParamData%rSAerCenn2)) THEN - DEALLOCATE(ParamData%rSAerCenn2) -ENDIF -IF (ALLOCATED(ParamData%SAeroTwst)) THEN - DEALLOCATE(ParamData%SAeroTwst) -ENDIF -IF (ALLOCATED(ParamData%StiffBE)) THEN - DEALLOCATE(ParamData%StiffBE) -ENDIF -IF (ALLOCATED(ParamData%StiffBF)) THEN - DEALLOCATE(ParamData%StiffBF) -ENDIF -IF (ALLOCATED(ParamData%SThetaS)) THEN - DEALLOCATE(ParamData%SThetaS) -ENDIF -IF (ALLOCATED(ParamData%ThetaS)) THEN - DEALLOCATE(ParamData%ThetaS) -ENDIF -IF (ALLOCATED(ParamData%TwistedSF)) THEN - DEALLOCATE(ParamData%TwistedSF) -ENDIF -IF (ALLOCATED(ParamData%BldFl1Sh)) THEN - DEALLOCATE(ParamData%BldFl1Sh) -ENDIF -IF (ALLOCATED(ParamData%BldFl2Sh)) THEN - DEALLOCATE(ParamData%BldFl2Sh) -ENDIF -IF (ALLOCATED(ParamData%BldEdgSh)) THEN - DEALLOCATE(ParamData%BldEdgSh) -ENDIF -IF (ALLOCATED(ParamData%FreqBE)) THEN - DEALLOCATE(ParamData%FreqBE) -ENDIF -IF (ALLOCATED(ParamData%FreqBF)) THEN - DEALLOCATE(ParamData%FreqBF) -ENDIF -IF (ALLOCATED(ParamData%BElmntMass)) THEN - DEALLOCATE(ParamData%BElmntMass) -ENDIF -IF (ALLOCATED(ParamData%TElmntMass)) THEN - DEALLOCATE(ParamData%TElmntMass) -ENDIF -IF (ALLOCATED(ParamData%BldNd_OutParam)) THEN -DO i1 = LBOUND(ParamData%BldNd_OutParam,1), UBOUND(ParamData%BldNd_OutParam,1) - CALL NWTC_Library_DestroyOutParmType( ParamData%BldNd_OutParam(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%BldNd_OutParam) -ENDIF -IF (ALLOCATED(ParamData%Jac_u_indx)) THEN - DEALLOCATE(ParamData%Jac_u_indx) -ENDIF -IF (ALLOCATED(ParamData%du)) THEN - DEALLOCATE(ParamData%du) + +IF (ALLOCATED(ContStateData%QT)) THEN + DEALLOCATE(ContStateData%QT) ENDIF -IF (ALLOCATED(ParamData%dx)) THEN - DEALLOCATE(ParamData%dx) +IF (ALLOCATED(ContStateData%QDT)) THEN + DEALLOCATE(ContStateData%QDT) ENDIF - END SUBROUTINE ED_DestroyParam + END SUBROUTINE ED_DestroyContState + + +subroutine ED_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ED_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + ! QT + call RegPack(Buf, allocated(InData%QT)) + if (allocated(InData%QT)) then + call RegPackBounds(Buf, 1, lbound(InData%QT), ubound(InData%QT)) + call RegPack(Buf, InData%QT) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! QDT + call RegPack(Buf, allocated(InData%QDT)) + if (allocated(InData%QDT)) then + call RegPackBounds(Buf, 1, lbound(InData%QDT), ubound(InData%QDT)) + call RegPack(Buf, InData%QDT) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ED_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ED_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackContState' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! QT + if (allocated(OutData%QT)) deallocate(OutData%QT) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%QT(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%QT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%QT) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! QDT + if (allocated(OutData%QDT)) deallocate(OutData%QDT) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%QDT(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%QDT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%QDT) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + SUBROUTINE ED_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ED_DiscreteStateType), INTENT(IN) :: SrcDiscStateData + TYPE(ED_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ED_CopyDiscState' +! + ErrStat = ErrID_None + ErrMsg = "" + DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState + END SUBROUTINE ED_CopyDiscState - SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ED_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + SUBROUTINE ED_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) + TYPE(ED_DiscreteStateType), INTENT(INOUT) :: DiscStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyDiscState' - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! ErrStat = ErrID_None ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! DT - Db_BufSz = Db_BufSz + 1 ! DT24 - Int_BufSz = Int_BufSz + 1 ! BldNodes - Int_BufSz = Int_BufSz + 1 ! TipNode - Int_BufSz = Int_BufSz + 1 ! NDOF - Db_BufSz = Db_BufSz + 1 ! TwoPiNB - Int_BufSz = Int_BufSz + 1 ! NAug - Int_BufSz = Int_BufSz + 1 ! NPH - Int_BufSz = Int_BufSz + 1 ! PH allocated yes/no - IF ( ALLOCATED(InData%PH) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PH upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%PH) ! PH - END IF - Int_BufSz = Int_BufSz + 1 ! NPM - Int_BufSz = Int_BufSz + 1 ! PM allocated yes/no - IF ( ALLOCATED(InData%PM) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PM upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%PM) ! PM - END IF - Int_BufSz = Int_BufSz + 1 ! DOF_Flag allocated yes/no - IF ( ALLOCATED(InData%DOF_Flag) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DOF_Flag upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%DOF_Flag) ! DOF_Flag - END IF - Int_BufSz = Int_BufSz + 1 ! DOF_Desc allocated yes/no - IF ( ALLOCATED(InData%DOF_Desc) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DOF_Desc upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%DOF_Desc)*LEN(InData%DOF_Desc) ! DOF_Desc - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! DOFs: size of buffers for each call to pack subtype - CALL ED_PackActiveDOFs( Re_Buf, Db_Buf, Int_Buf, InData%DOFs, ErrStat2, ErrMsg2, .TRUE. ) ! DOFs - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DOFs - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DOFs - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DOFs - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt - Int_BufSz = Int_BufSz + 1 ! NBlGages - Int_BufSz = Int_BufSz + 1 ! NTwGages - Int_BufSz = Int_BufSz + 1 ! OutParam allocated yes/no - IF ( ALLOCATED(InData%OutParam) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutParam upper/lower bounds for each dimension - DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - Int_BufSz = Int_BufSz + 3 ! OutParam: size of buffers for each call to pack subtype - CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutParam - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutParam - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutParam - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%Delim) ! Delim - Re_BufSz = Re_BufSz + 1 ! AvgNrmTpRd - Db_BufSz = Db_BufSz + 1 ! AzimB1Up - Db_BufSz = Db_BufSz + 1 ! CosDel3 - Int_BufSz = Int_BufSz + 1 ! CosPreC allocated yes/no - IF ( ALLOCATED(InData%CosPreC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CosPreC upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%CosPreC) ! CosPreC - END IF - Db_BufSz = Db_BufSz + 1 ! CRFrlSkew - Db_BufSz = Db_BufSz + 1 ! CRFrlSkw2 - Db_BufSz = Db_BufSz + 1 ! CRFrlTilt - Db_BufSz = Db_BufSz + 1 ! CRFrlTlt2 - Db_BufSz = Db_BufSz + 1 ! CShftSkew - Db_BufSz = Db_BufSz + 1 ! CShftTilt - Db_BufSz = Db_BufSz + 1 ! CSRFrlSkw - Db_BufSz = Db_BufSz + 1 ! CSRFrlTlt - Db_BufSz = Db_BufSz + 1 ! CSTFrlSkw - Db_BufSz = Db_BufSz + 1 ! CSTFrlTlt - Db_BufSz = Db_BufSz + 1 ! CTFrlSkew - Db_BufSz = Db_BufSz + 1 ! CTFrlSkw2 - Db_BufSz = Db_BufSz + 1 ! CTFrlTilt - Db_BufSz = Db_BufSz + 1 ! CTFrlTlt2 - Re_BufSz = Re_BufSz + 1 ! HubHt - Re_BufSz = Re_BufSz + 1 ! HubCM - Re_BufSz = Re_BufSz + 1 ! HubRad - Re_BufSz = Re_BufSz + 1 ! NacCMxn - Re_BufSz = Re_BufSz + 1 ! NacCMyn - Re_BufSz = Re_BufSz + 1 ! NacCMzn - Re_BufSz = Re_BufSz + 1 ! OverHang - Re_BufSz = Re_BufSz + 1 ! ProjArea - Re_BufSz = Re_BufSz + 1 ! PtfmRefzt - Re_BufSz = Re_BufSz + 1 ! RefTwrHt - Re_BufSz = Re_BufSz + SIZE(InData%RFrlPnt_n) ! RFrlPnt_n - Re_BufSz = Re_BufSz + 1 ! rVDxn - Re_BufSz = Re_BufSz + 1 ! rVDyn - Re_BufSz = Re_BufSz + 1 ! rVDzn - Re_BufSz = Re_BufSz + 1 ! rVIMUxn - Re_BufSz = Re_BufSz + 1 ! rVIMUyn - Re_BufSz = Re_BufSz + 1 ! rVIMUzn - Re_BufSz = Re_BufSz + 1 ! rVPxn - Re_BufSz = Re_BufSz + 1 ! rVPyn - Re_BufSz = Re_BufSz + 1 ! rVPzn - Re_BufSz = Re_BufSz + 1 ! rWIxn - Re_BufSz = Re_BufSz + 1 ! rWIyn - Re_BufSz = Re_BufSz + 1 ! rWIzn - Re_BufSz = Re_BufSz + 1 ! rWJxn - Re_BufSz = Re_BufSz + 1 ! rWJyn - Re_BufSz = Re_BufSz + 1 ! rWJzn - Re_BufSz = Re_BufSz + 1 ! rZT0zt - Re_BufSz = Re_BufSz + 1 ! rZYzt - Db_BufSz = Db_BufSz + 1 ! SinDel3 - Int_BufSz = Int_BufSz + 1 ! SinPreC allocated yes/no - IF ( ALLOCATED(InData%SinPreC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SinPreC upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%SinPreC) ! SinPreC - END IF - Db_BufSz = Db_BufSz + 1 ! SRFrlSkew - Db_BufSz = Db_BufSz + 1 ! SRFrlSkw2 - Db_BufSz = Db_BufSz + 1 ! SRFrlTilt - Db_BufSz = Db_BufSz + 1 ! SRFrlTlt2 - Db_BufSz = Db_BufSz + 1 ! SShftSkew - Db_BufSz = Db_BufSz + 1 ! SShftTilt - Db_BufSz = Db_BufSz + 1 ! STFrlSkew - Db_BufSz = Db_BufSz + 1 ! STFrlSkw2 - Db_BufSz = Db_BufSz + 1 ! STFrlTilt - Db_BufSz = Db_BufSz + 1 ! STFrlTlt2 - Re_BufSz = Re_BufSz + SIZE(InData%TFrlPnt_n) ! TFrlPnt_n - Re_BufSz = Re_BufSz + 1 ! TipRad - Re_BufSz = Re_BufSz + 1 ! TowerHt - Re_BufSz = Re_BufSz + 1 ! TowerBsHt - Re_BufSz = Re_BufSz + 1 ! UndSling - Int_BufSz = Int_BufSz + 1 ! NumBl - Int_BufSz = Int_BufSz + 1 ! AxRedTFA allocated yes/no - IF ( ALLOCATED(InData%AxRedTFA) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AxRedTFA upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AxRedTFA) ! AxRedTFA - END IF - Int_BufSz = Int_BufSz + 1 ! AxRedTSS allocated yes/no - IF ( ALLOCATED(InData%AxRedTSS) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AxRedTSS upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AxRedTSS) ! AxRedTSS - END IF - Re_BufSz = Re_BufSz + SIZE(InData%CTFA) ! CTFA - Re_BufSz = Re_BufSz + SIZE(InData%CTSS) ! CTSS - Int_BufSz = Int_BufSz + 1 ! DHNodes allocated yes/no - IF ( ALLOCATED(InData%DHNodes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DHNodes upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DHNodes) ! DHNodes - END IF - Int_BufSz = Int_BufSz + 1 ! HNodes allocated yes/no - IF ( ALLOCATED(InData%HNodes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! HNodes upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%HNodes) ! HNodes - END IF - Int_BufSz = Int_BufSz + 1 ! HNodesNorm allocated yes/no - IF ( ALLOCATED(InData%HNodesNorm) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! HNodesNorm upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%HNodesNorm) ! HNodesNorm - END IF - Re_BufSz = Re_BufSz + SIZE(InData%KTFA) ! KTFA - Re_BufSz = Re_BufSz + SIZE(InData%KTSS) ! KTSS - Int_BufSz = Int_BufSz + 1 ! MassT allocated yes/no - IF ( ALLOCATED(InData%MassT) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MassT upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MassT) ! MassT - END IF - Int_BufSz = Int_BufSz + 1 ! StiffTSS allocated yes/no - IF ( ALLOCATED(InData%StiffTSS) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! StiffTSS upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StiffTSS) ! StiffTSS - END IF - Int_BufSz = Int_BufSz + 1 ! TwrFASF allocated yes/no - IF ( ALLOCATED(InData%TwrFASF) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! TwrFASF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrFASF) ! TwrFASF - END IF - Re_BufSz = Re_BufSz + 1 ! TwrFlexL - Int_BufSz = Int_BufSz + 1 ! TwrSSSF allocated yes/no - IF ( ALLOCATED(InData%TwrSSSF) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! TwrSSSF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrSSSF) ! TwrSSSF - END IF - Int_BufSz = Int_BufSz + 1 ! TTopNode - Int_BufSz = Int_BufSz + 1 ! TwrNodes - Int_BufSz = Int_BufSz + 1 ! MHK - Int_BufSz = Int_BufSz + 1 ! StiffTFA allocated yes/no - IF ( ALLOCATED(InData%StiffTFA) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! StiffTFA upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StiffTFA) ! StiffTFA - END IF - Re_BufSz = Re_BufSz + 1 ! AtfaIner - Int_BufSz = Int_BufSz + 1 ! BldCG allocated yes/no - IF ( ALLOCATED(InData%BldCG) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BldCG upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BldCG) ! BldCG - END IF - Int_BufSz = Int_BufSz + 1 ! BldMass allocated yes/no - IF ( ALLOCATED(InData%BldMass) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BldMass upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BldMass) ! BldMass - END IF - Re_BufSz = Re_BufSz + 1 ! BoomMass - Int_BufSz = Int_BufSz + 1 ! FirstMom allocated yes/no - IF ( ALLOCATED(InData%FirstMom) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FirstMom upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FirstMom) ! FirstMom - END IF - Re_BufSz = Re_BufSz + 1 ! GenIner - Re_BufSz = Re_BufSz + 1 ! Hubg1Iner - Re_BufSz = Re_BufSz + 1 ! Hubg2Iner - Re_BufSz = Re_BufSz + 1 ! HubMass - Re_BufSz = Re_BufSz + 1 ! Nacd2Iner - Re_BufSz = Re_BufSz + 1 ! NacMass - Re_BufSz = Re_BufSz + 1 ! PtfmMass - Re_BufSz = Re_BufSz + 1 ! PtfmPIner - Re_BufSz = Re_BufSz + 1 ! PtfmRIner - Re_BufSz = Re_BufSz + 1 ! PtfmYIner - Re_BufSz = Re_BufSz + 1 ! RFrlMass - Re_BufSz = Re_BufSz + 1 ! RotIner - Re_BufSz = Re_BufSz + 1 ! RotMass - Re_BufSz = Re_BufSz + 1 ! RrfaIner - Int_BufSz = Int_BufSz + 1 ! SecondMom allocated yes/no - IF ( ALLOCATED(InData%SecondMom) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SecondMom upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SecondMom) ! SecondMom - END IF - Re_BufSz = Re_BufSz + 1 ! TFinMass - Re_BufSz = Re_BufSz + 1 ! TFrlIner - Int_BufSz = Int_BufSz + 1 ! TipMass allocated yes/no - IF ( ALLOCATED(InData%TipMass) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TipMass upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TipMass) ! TipMass - END IF - Re_BufSz = Re_BufSz + 1 ! TurbMass - Re_BufSz = Re_BufSz + 1 ! TwrMass - Re_BufSz = Re_BufSz + 1 ! TwrTpMass - Re_BufSz = Re_BufSz + 1 ! YawBrMass - Re_BufSz = Re_BufSz + 1 ! Gravity - Int_BufSz = Int_BufSz + 1 ! PitchAxis allocated yes/no - IF ( ALLOCATED(InData%PitchAxis) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PitchAxis upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PitchAxis) ! PitchAxis - END IF - Int_BufSz = Int_BufSz + 1 ! AeroTwst allocated yes/no - IF ( ALLOCATED(InData%AeroTwst) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AeroTwst upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AeroTwst) ! AeroTwst - END IF - Int_BufSz = Int_BufSz + 1 ! AxRedBld allocated yes/no - IF ( ALLOCATED(InData%AxRedBld) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! AxRedBld upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AxRedBld) ! AxRedBld - END IF - Int_BufSz = Int_BufSz + 1 ! BldEDamp allocated yes/no - IF ( ALLOCATED(InData%BldEDamp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BldEDamp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BldEDamp) ! BldEDamp - END IF - Int_BufSz = Int_BufSz + 1 ! BldFDamp allocated yes/no - IF ( ALLOCATED(InData%BldFDamp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BldFDamp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BldFDamp) ! BldFDamp - END IF - Re_BufSz = Re_BufSz + 1 ! BldFlexL - Int_BufSz = Int_BufSz + 1 ! CAeroTwst allocated yes/no - IF ( ALLOCATED(InData%CAeroTwst) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CAeroTwst upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CAeroTwst) ! CAeroTwst - END IF - Int_BufSz = Int_BufSz + 1 ! CBE allocated yes/no - IF ( ALLOCATED(InData%CBE) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! CBE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CBE) ! CBE - END IF - Int_BufSz = Int_BufSz + 1 ! CBF allocated yes/no - IF ( ALLOCATED(InData%CBF) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! CBF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CBF) ! CBF - END IF - Int_BufSz = Int_BufSz + 1 ! Chord allocated yes/no - IF ( ALLOCATED(InData%Chord) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Chord upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Chord) ! Chord - END IF - Int_BufSz = Int_BufSz + 1 ! CThetaS allocated yes/no - IF ( ALLOCATED(InData%CThetaS) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CThetaS upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%CThetaS) ! CThetaS - END IF - Int_BufSz = Int_BufSz + 1 ! DRNodes allocated yes/no - IF ( ALLOCATED(InData%DRNodes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DRNodes upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DRNodes) ! DRNodes - END IF - Int_BufSz = Int_BufSz + 1 ! FStTunr allocated yes/no - IF ( ALLOCATED(InData%FStTunr) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FStTunr upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FStTunr) ! FStTunr - END IF - Int_BufSz = Int_BufSz + 1 ! KBE allocated yes/no - IF ( ALLOCATED(InData%KBE) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! KBE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%KBE) ! KBE - END IF - Int_BufSz = Int_BufSz + 1 ! KBF allocated yes/no - IF ( ALLOCATED(InData%KBF) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! KBF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%KBF) ! KBF - END IF - Int_BufSz = Int_BufSz + 1 ! MassB allocated yes/no - IF ( ALLOCATED(InData%MassB) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MassB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MassB) ! MassB - END IF - Int_BufSz = Int_BufSz + 1 ! RNodes allocated yes/no - IF ( ALLOCATED(InData%RNodes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RNodes upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%RNodes) ! RNodes - END IF - Int_BufSz = Int_BufSz + 1 ! RNodesNorm allocated yes/no - IF ( ALLOCATED(InData%RNodesNorm) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RNodesNorm upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%RNodesNorm) ! RNodesNorm - END IF - Int_BufSz = Int_BufSz + 1 ! rSAerCenn1 allocated yes/no - IF ( ALLOCATED(InData%rSAerCenn1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! rSAerCenn1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rSAerCenn1) ! rSAerCenn1 - END IF - Int_BufSz = Int_BufSz + 1 ! rSAerCenn2 allocated yes/no - IF ( ALLOCATED(InData%rSAerCenn2) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! rSAerCenn2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rSAerCenn2) ! rSAerCenn2 - END IF - Int_BufSz = Int_BufSz + 1 ! SAeroTwst allocated yes/no - IF ( ALLOCATED(InData%SAeroTwst) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SAeroTwst upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SAeroTwst) ! SAeroTwst - END IF - Int_BufSz = Int_BufSz + 1 ! StiffBE allocated yes/no - IF ( ALLOCATED(InData%StiffBE) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StiffBE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StiffBE) ! StiffBE - END IF - Int_BufSz = Int_BufSz + 1 ! StiffBF allocated yes/no - IF ( ALLOCATED(InData%StiffBF) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StiffBF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StiffBF) ! StiffBF - END IF - Int_BufSz = Int_BufSz + 1 ! SThetaS allocated yes/no - IF ( ALLOCATED(InData%SThetaS) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! SThetaS upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%SThetaS) ! SThetaS - END IF - Int_BufSz = Int_BufSz + 1 ! ThetaS allocated yes/no - IF ( ALLOCATED(InData%ThetaS) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ThetaS upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ThetaS) ! ThetaS - END IF - Int_BufSz = Int_BufSz + 1 ! TwistedSF allocated yes/no - IF ( ALLOCATED(InData%TwistedSF) ) THEN - Int_BufSz = Int_BufSz + 2*5 ! TwistedSF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwistedSF) ! TwistedSF - END IF - Int_BufSz = Int_BufSz + 1 ! BldFl1Sh allocated yes/no - IF ( ALLOCATED(InData%BldFl1Sh) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BldFl1Sh upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BldFl1Sh) ! BldFl1Sh - END IF - Int_BufSz = Int_BufSz + 1 ! BldFl2Sh allocated yes/no - IF ( ALLOCATED(InData%BldFl2Sh) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BldFl2Sh upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BldFl2Sh) ! BldFl2Sh - END IF - Int_BufSz = Int_BufSz + 1 ! BldEdgSh allocated yes/no - IF ( ALLOCATED(InData%BldEdgSh) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BldEdgSh upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BldEdgSh) ! BldEdgSh - END IF - Int_BufSz = Int_BufSz + 1 ! FreqBE allocated yes/no - IF ( ALLOCATED(InData%FreqBE) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! FreqBE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FreqBE) ! FreqBE - END IF - Int_BufSz = Int_BufSz + 1 ! FreqBF allocated yes/no - IF ( ALLOCATED(InData%FreqBF) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! FreqBF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FreqBF) ! FreqBF - END IF - Re_BufSz = Re_BufSz + SIZE(InData%FreqTFA) ! FreqTFA - Re_BufSz = Re_BufSz + SIZE(InData%FreqTSS) ! FreqTSS - Re_BufSz = Re_BufSz + 1 ! TeetCDmp - Re_BufSz = Re_BufSz + 1 ! TeetDmp - Re_BufSz = Re_BufSz + 1 ! TeetDmpP - Re_BufSz = Re_BufSz + 1 ! TeetHSSp - Re_BufSz = Re_BufSz + 1 ! TeetHStP - Re_BufSz = Re_BufSz + 1 ! TeetSSSp - Re_BufSz = Re_BufSz + 1 ! TeetSStP - Int_BufSz = Int_BufSz + 1 ! TeetMod - Re_BufSz = Re_BufSz + 1 ! TFrlDmp - Re_BufSz = Re_BufSz + 1 ! TFrlDSDmp - Re_BufSz = Re_BufSz + 1 ! TFrlDSDP - Re_BufSz = Re_BufSz + 1 ! TFrlDSSP - Re_BufSz = Re_BufSz + 1 ! TFrlDSSpr - Re_BufSz = Re_BufSz + 1 ! TFrlSpr - Re_BufSz = Re_BufSz + 1 ! TFrlUSDmp - Re_BufSz = Re_BufSz + 1 ! TFrlUSDP - Re_BufSz = Re_BufSz + 1 ! TFrlUSSP - Re_BufSz = Re_BufSz + 1 ! TFrlUSSpr - Int_BufSz = Int_BufSz + 1 ! TFrlMod - Re_BufSz = Re_BufSz + 1 ! RFrlDmp - Re_BufSz = Re_BufSz + 1 ! RFrlDSDmp - Re_BufSz = Re_BufSz + 1 ! RFrlDSDP - Re_BufSz = Re_BufSz + 1 ! RFrlDSSP - Re_BufSz = Re_BufSz + 1 ! RFrlDSSpr - Re_BufSz = Re_BufSz + 1 ! RFrlSpr - Re_BufSz = Re_BufSz + 1 ! RFrlUSDmp - Re_BufSz = Re_BufSz + 1 ! RFrlUSDP - Re_BufSz = Re_BufSz + 1 ! RFrlUSSP - Re_BufSz = Re_BufSz + 1 ! RFrlUSSpr - Int_BufSz = Int_BufSz + 1 ! RFrlMod - Re_BufSz = Re_BufSz + 1 ! ShftGagL - Int_BufSz = Int_BufSz + SIZE(InData%BldGagNd) ! BldGagNd - Int_BufSz = Int_BufSz + SIZE(InData%TwrGagNd) ! TwrGagNd - Db_BufSz = Db_BufSz + 1 ! TStart - Re_BufSz = Re_BufSz + 1 ! DTTorDmp - Re_BufSz = Re_BufSz + 1 ! DTTorSpr - Re_BufSz = Re_BufSz + 1 ! GBRatio - Re_BufSz = Re_BufSz + 1 ! GBoxEff - Re_BufSz = Re_BufSz + 1 ! RotSpeed - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1 ! BElmntMass allocated yes/no - IF ( ALLOCATED(InData%BElmntMass) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BElmntMass upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BElmntMass) ! BElmntMass - END IF - Int_BufSz = Int_BufSz + 1 ! TElmntMass allocated yes/no - IF ( ALLOCATED(InData%TElmntMass) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TElmntMass upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TElmntMass) ! TElmntMass - END IF - Int_BufSz = Int_BufSz + 1 ! method - Re_BufSz = Re_BufSz + 1 ! PtfmCMxt - Re_BufSz = Re_BufSz + 1 ! PtfmCMyt - Int_BufSz = Int_BufSz + 1 ! BD4Blades - Int_BufSz = Int_BufSz + 1 ! UseAD14 - Int_BufSz = Int_BufSz + 1 ! BldNd_NumOuts - Int_BufSz = Int_BufSz + 1 ! BldNd_TotNumOuts - Int_BufSz = Int_BufSz + 1 ! BldNd_OutParam allocated yes/no - IF ( ALLOCATED(InData%BldNd_OutParam) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BldNd_OutParam upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BldNd_OutParam,1), UBOUND(InData%BldNd_OutParam,1) - Int_BufSz = Int_BufSz + 3 ! BldNd_OutParam: size of buffers for each call to pack subtype - CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BldNd_OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BldNd_OutParam - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BldNd_OutParam - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BldNd_OutParam - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! BldNd_BladesOut - Int_BufSz = Int_BufSz + 1 ! Jac_u_indx allocated yes/no - IF ( ALLOCATED(InData%Jac_u_indx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_u_indx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_u_indx) ! Jac_u_indx - END IF - Int_BufSz = Int_BufSz + 1 ! du allocated yes/no - IF ( ALLOCATED(InData%du) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! du upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%du) ! du - END IF - Int_BufSz = Int_BufSz + 1 ! dx allocated yes/no - IF ( ALLOCATED(InData%dx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dx upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%dx) ! dx - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_ny - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%DT24 - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%BldNodes - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TipNode - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NDOF - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TwoPiNB - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NAug - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPH - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%PH) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PH,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PH,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PH,1), UBOUND(InData%PH,1) - IntKiBuf(Int_Xferred) = InData%PH(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NPM - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%PM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PM,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PM,2), UBOUND(InData%PM,2) - DO i1 = LBOUND(InData%PM,1), UBOUND(InData%PM,1) - IntKiBuf(Int_Xferred) = InData%PM(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DOF_Flag) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DOF_Flag,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DOF_Flag,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DOF_Flag,1), UBOUND(InData%DOF_Flag,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%DOF_Flag(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DOF_Desc) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DOF_Desc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DOF_Desc,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DOF_Desc,1), UBOUND(InData%DOF_Desc,1) - DO I = 1, LEN(InData%DOF_Desc) - IntKiBuf(Int_Xferred) = ICHAR(InData%DOF_Desc(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - CALL ED_PackActiveDOFs( Re_Buf, Db_Buf, Int_Buf, InData%DOFs, ErrStat2, ErrMsg2, OnlySize ) ! DOFs - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%NBlGages - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NTwGages - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutParam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParam,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf(Re_Xferred) = InData%AvgNrmTpRd - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%AzimB1Up - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CosDel3 - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%CosPreC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CosPreC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CosPreC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CosPreC,1), UBOUND(InData%CosPreC,1) - DbKiBuf(Db_Xferred) = InData%CosPreC(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - DbKiBuf(Db_Xferred) = InData%CRFrlSkew - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CRFrlSkw2 - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CRFrlTilt - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CRFrlTlt2 - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CShftSkew - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CShftTilt - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CSRFrlSkw - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CSRFrlTlt - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CSTFrlSkw - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CSTFrlTlt - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CTFrlSkew - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CTFrlSkw2 - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CTFrlTilt - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CTFrlTlt2 - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubCM - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubRad - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NacCMxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NacCMyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NacCMzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%OverHang - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ProjArea - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmRefzt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RefTwrHt - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%RFrlPnt_n,1), UBOUND(InData%RFrlPnt_n,1) - ReKiBuf(Re_Xferred) = InData%RFrlPnt_n(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%rVDxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rVDyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rVDzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rVIMUxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rVIMUyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rVIMUzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rVPxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rVPyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rVPzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rWIxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rWIyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rWIzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rWJxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rWJyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rWJzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rZT0zt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rZYzt - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%SinDel3 - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%SinPreC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SinPreC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SinPreC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SinPreC,1), UBOUND(InData%SinPreC,1) - DbKiBuf(Db_Xferred) = InData%SinPreC(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - DbKiBuf(Db_Xferred) = InData%SRFrlSkew - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%SRFrlSkw2 - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%SRFrlTilt - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%SRFrlTlt2 - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%SShftSkew - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%SShftTilt - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%STFrlSkew - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%STFrlSkw2 - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%STFrlTilt - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%STFrlTlt2 - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%TFrlPnt_n,1), UBOUND(InData%TFrlPnt_n,1) - ReKiBuf(Re_Xferred) = InData%TFrlPnt_n(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%TipRad - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TowerHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TowerBsHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%UndSling - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBl - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%AxRedTFA) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AxRedTFA,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxRedTFA,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AxRedTFA,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxRedTFA,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AxRedTFA,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxRedTFA,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AxRedTFA,3), UBOUND(InData%AxRedTFA,3) - DO i2 = LBOUND(InData%AxRedTFA,2), UBOUND(InData%AxRedTFA,2) - DO i1 = LBOUND(InData%AxRedTFA,1), UBOUND(InData%AxRedTFA,1) - ReKiBuf(Re_Xferred) = InData%AxRedTFA(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AxRedTSS) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AxRedTSS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxRedTSS,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AxRedTSS,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxRedTSS,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AxRedTSS,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxRedTSS,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AxRedTSS,3), UBOUND(InData%AxRedTSS,3) - DO i2 = LBOUND(InData%AxRedTSS,2), UBOUND(InData%AxRedTSS,2) - DO i1 = LBOUND(InData%AxRedTSS,1), UBOUND(InData%AxRedTSS,1) - ReKiBuf(Re_Xferred) = InData%AxRedTSS(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - DO i2 = LBOUND(InData%CTFA,2), UBOUND(InData%CTFA,2) - DO i1 = LBOUND(InData%CTFA,1), UBOUND(InData%CTFA,1) - ReKiBuf(Re_Xferred) = InData%CTFA(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%CTSS,2), UBOUND(InData%CTSS,2) - DO i1 = LBOUND(InData%CTSS,1), UBOUND(InData%CTSS,1) - ReKiBuf(Re_Xferred) = InData%CTSS(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( .NOT. ALLOCATED(InData%DHNodes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DHNodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DHNodes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DHNodes,1), UBOUND(InData%DHNodes,1) - ReKiBuf(Re_Xferred) = InData%DHNodes(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%HNodes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%HNodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HNodes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%HNodes,1), UBOUND(InData%HNodes,1) - ReKiBuf(Re_Xferred) = InData%HNodes(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%HNodesNorm) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%HNodesNorm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HNodesNorm,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%HNodesNorm,1), UBOUND(InData%HNodesNorm,1) - ReKiBuf(Re_Xferred) = InData%HNodesNorm(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DO i2 = LBOUND(InData%KTFA,2), UBOUND(InData%KTFA,2) - DO i1 = LBOUND(InData%KTFA,1), UBOUND(InData%KTFA,1) - ReKiBuf(Re_Xferred) = InData%KTFA(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%KTSS,2), UBOUND(InData%KTSS,2) - DO i1 = LBOUND(InData%KTSS,1), UBOUND(InData%KTSS,1) - ReKiBuf(Re_Xferred) = InData%KTSS(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( .NOT. ALLOCATED(InData%MassT) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MassT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MassT,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MassT,1), UBOUND(InData%MassT,1) - ReKiBuf(Re_Xferred) = InData%MassT(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StiffTSS) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StiffTSS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StiffTSS,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%StiffTSS,1), UBOUND(InData%StiffTSS,1) - ReKiBuf(Re_Xferred) = InData%StiffTSS(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TwrFASF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrFASF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrFASF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrFASF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrFASF,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrFASF,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrFASF,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%TwrFASF,3), UBOUND(InData%TwrFASF,3) - DO i2 = LBOUND(InData%TwrFASF,2), UBOUND(InData%TwrFASF,2) - DO i1 = LBOUND(InData%TwrFASF,1), UBOUND(InData%TwrFASF,1) - ReKiBuf(Re_Xferred) = InData%TwrFASF(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%TwrFlexL - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TwrSSSF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrSSSF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrSSSF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrSSSF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrSSSF,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrSSSF,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrSSSF,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%TwrSSSF,3), UBOUND(InData%TwrSSSF,3) - DO i2 = LBOUND(InData%TwrSSSF,2), UBOUND(InData%TwrSSSF,2) - DO i1 = LBOUND(InData%TwrSSSF,1), UBOUND(InData%TwrSSSF,1) - ReKiBuf(Re_Xferred) = InData%TwrSSSF(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%TTopNode - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TwrNodes - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MHK - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%StiffTFA) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StiffTFA,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StiffTFA,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%StiffTFA,1), UBOUND(InData%StiffTFA,1) - ReKiBuf(Re_Xferred) = InData%StiffTFA(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%AtfaIner - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BldCG) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldCG,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldCG,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BldCG,1), UBOUND(InData%BldCG,1) - ReKiBuf(Re_Xferred) = InData%BldCG(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BldMass) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldMass,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldMass,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BldMass,1), UBOUND(InData%BldMass,1) - ReKiBuf(Re_Xferred) = InData%BldMass(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%BoomMass - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%FirstMom) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FirstMom,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FirstMom,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FirstMom,1), UBOUND(InData%FirstMom,1) - ReKiBuf(Re_Xferred) = InData%FirstMom(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%GenIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Hubg1Iner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Hubg2Iner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Nacd2Iner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NacMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmPIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmRIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmYIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RotIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RotMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RrfaIner - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%SecondMom) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SecondMom,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SecondMom,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SecondMom,1), UBOUND(InData%SecondMom,1) - ReKiBuf(Re_Xferred) = InData%SecondMom(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%TFinMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlIner - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TipMass) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TipMass,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TipMass,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TipMass,1), UBOUND(InData%TipMass,1) - ReKiBuf(Re_Xferred) = InData%TipMass(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%TurbMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TwrMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TwrTpMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawBrMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%PitchAxis) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PitchAxis,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PitchAxis,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PitchAxis,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PitchAxis,2) - Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%PitchAxis,2), UBOUND(InData%PitchAxis,2) - DO i1 = LBOUND(InData%PitchAxis,1), UBOUND(InData%PitchAxis,1) - ReKiBuf(Re_Xferred) = InData%PitchAxis(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AeroTwst) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AeroTwst,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AeroTwst,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AeroTwst,1), UBOUND(InData%AeroTwst,1) - ReKiBuf(Re_Xferred) = InData%AeroTwst(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AxRedBld) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AxRedBld,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxRedBld,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AxRedBld,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxRedBld,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AxRedBld,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxRedBld,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AxRedBld,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxRedBld,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%AxRedBld,4), UBOUND(InData%AxRedBld,4) - DO i3 = LBOUND(InData%AxRedBld,3), UBOUND(InData%AxRedBld,3) - DO i2 = LBOUND(InData%AxRedBld,2), UBOUND(InData%AxRedBld,2) - DO i1 = LBOUND(InData%AxRedBld,1), UBOUND(InData%AxRedBld,1) - ReKiBuf(Re_Xferred) = InData%AxRedBld(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BldEDamp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldEDamp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldEDamp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldEDamp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldEDamp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BldEDamp,2), UBOUND(InData%BldEDamp,2) - DO i1 = LBOUND(InData%BldEDamp,1), UBOUND(InData%BldEDamp,1) - ReKiBuf(Re_Xferred) = InData%BldEDamp(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BldFDamp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldFDamp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldFDamp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldFDamp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldFDamp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BldFDamp,2), UBOUND(InData%BldFDamp,2) - DO i1 = LBOUND(InData%BldFDamp,1), UBOUND(InData%BldFDamp,1) - ReKiBuf(Re_Xferred) = InData%BldFDamp(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%BldFlexL - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%CAeroTwst) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CAeroTwst,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CAeroTwst,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CAeroTwst,1), UBOUND(InData%CAeroTwst,1) - ReKiBuf(Re_Xferred) = InData%CAeroTwst(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CBE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CBE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CBE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CBE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CBE,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CBE,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CBE,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%CBE,3), UBOUND(InData%CBE,3) - DO i2 = LBOUND(InData%CBE,2), UBOUND(InData%CBE,2) - DO i1 = LBOUND(InData%CBE,1), UBOUND(InData%CBE,1) - ReKiBuf(Re_Xferred) = InData%CBE(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CBF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CBF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CBF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CBF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CBF,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CBF,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CBF,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%CBF,3), UBOUND(InData%CBF,3) - DO i2 = LBOUND(InData%CBF,2), UBOUND(InData%CBF,2) - DO i1 = LBOUND(InData%CBF,1), UBOUND(InData%CBF,1) - ReKiBuf(Re_Xferred) = InData%CBF(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Chord) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Chord,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Chord,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Chord,1), UBOUND(InData%Chord,1) - ReKiBuf(Re_Xferred) = InData%Chord(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CThetaS) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CThetaS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CThetaS,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CThetaS,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CThetaS,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CThetaS,2), UBOUND(InData%CThetaS,2) - DO i1 = LBOUND(InData%CThetaS,1), UBOUND(InData%CThetaS,1) - DbKiBuf(Db_Xferred) = InData%CThetaS(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DRNodes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DRNodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DRNodes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DRNodes,1), UBOUND(InData%DRNodes,1) - ReKiBuf(Re_Xferred) = InData%DRNodes(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FStTunr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FStTunr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FStTunr,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FStTunr,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FStTunr,2) - Int_Xferred = Int_Xferred + 2 + END SUBROUTINE ED_DestroyDiscState - DO i2 = LBOUND(InData%FStTunr,2), UBOUND(InData%FStTunr,2) - DO i1 = LBOUND(InData%FStTunr,1), UBOUND(InData%FStTunr,1) - ReKiBuf(Re_Xferred) = InData%FStTunr(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%KBE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%KBE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%KBE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBE,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%KBE,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBE,3) - Int_Xferred = Int_Xferred + 2 - DO i3 = LBOUND(InData%KBE,3), UBOUND(InData%KBE,3) - DO i2 = LBOUND(InData%KBE,2), UBOUND(InData%KBE,2) - DO i1 = LBOUND(InData%KBE,1), UBOUND(InData%KBE,1) - ReKiBuf(Re_Xferred) = InData%KBE(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%KBF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%KBF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%KBF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBF,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%KBF,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBF,3) - Int_Xferred = Int_Xferred + 2 +subroutine ED_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ED_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyDiscState + call RegPack(Buf, InData%DummyDiscState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ED_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ED_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackDiscState' + if (Buf%ErrStat /= ErrID_None) return + ! DummyDiscState + call RegUnpack(Buf, OutData%DummyDiscState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + SUBROUTINE ED_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ED_ConstraintStateType), INTENT(IN) :: SrcConstrStateData + TYPE(ED_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ED_CopyConstrState' +! + ErrStat = ErrID_None + ErrMsg = "" + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState + END SUBROUTINE ED_CopyConstrState - DO i3 = LBOUND(InData%KBF,3), UBOUND(InData%KBF,3) - DO i2 = LBOUND(InData%KBF,2), UBOUND(InData%KBF,2) - DO i1 = LBOUND(InData%KBF,1), UBOUND(InData%KBF,1) - ReKiBuf(Re_Xferred) = InData%KBF(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MassB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MassB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MassB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MassB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MassB,2) - Int_Xferred = Int_Xferred + 2 + SUBROUTINE ED_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) + TYPE(ED_ConstraintStateType), INTENT(INOUT) :: ConstrStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyConstrState' - DO i2 = LBOUND(InData%MassB,2), UBOUND(InData%MassB,2) - DO i1 = LBOUND(InData%MassB,1), UBOUND(InData%MassB,1) - ReKiBuf(Re_Xferred) = InData%MassB(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RNodes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RNodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RNodes,1) - Int_Xferred = Int_Xferred + 2 + ErrStat = ErrID_None + ErrMsg = "" - DO i1 = LBOUND(InData%RNodes,1), UBOUND(InData%RNodes,1) - ReKiBuf(Re_Xferred) = InData%RNodes(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RNodesNorm) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RNodesNorm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RNodesNorm,1) - Int_Xferred = Int_Xferred + 2 + END SUBROUTINE ED_DestroyConstrState - DO i1 = LBOUND(InData%RNodesNorm,1), UBOUND(InData%RNodesNorm,1) - ReKiBuf(Re_Xferred) = InData%RNodesNorm(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rSAerCenn1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rSAerCenn1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rSAerCenn1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rSAerCenn1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rSAerCenn1,2) - Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%rSAerCenn1,2), UBOUND(InData%rSAerCenn1,2) - DO i1 = LBOUND(InData%rSAerCenn1,1), UBOUND(InData%rSAerCenn1,1) - ReKiBuf(Re_Xferred) = InData%rSAerCenn1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO +subroutine ED_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ED_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyConstrState + call RegPack(Buf, InData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ED_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ED_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + ! DummyConstrState + call RegUnpack(Buf, OutData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + SUBROUTINE ED_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ED_OtherStateType), INTENT(IN) :: SrcOtherStateData + TYPE(ED_OtherStateType), INTENT(INOUT) :: DstOtherStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ED_CopyOtherState' +! + ErrStat = ErrID_None + ErrMsg = "" + DstOtherStateData%n = SrcOtherStateData%n + DO i1 = LBOUND(SrcOtherStateData%xdot,1), UBOUND(SrcOtherStateData%xdot,1) + CALL ED_CopyContState( SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +IF (ALLOCATED(SrcOtherStateData%IC)) THEN + i1_l = LBOUND(SrcOtherStateData%IC,1) + i1_u = UBOUND(SrcOtherStateData%IC,1) + IF (.NOT. ALLOCATED(DstOtherStateData%IC)) THEN + ALLOCATE(DstOtherStateData%IC(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%IC.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF ( .NOT. ALLOCATED(InData%rSAerCenn2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rSAerCenn2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rSAerCenn2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rSAerCenn2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rSAerCenn2,2) - Int_Xferred = Int_Xferred + 2 + DstOtherStateData%IC = SrcOtherStateData%IC +ENDIF + DstOtherStateData%HSSBrTrq = SrcOtherStateData%HSSBrTrq + DstOtherStateData%HSSBrTrqC = SrcOtherStateData%HSSBrTrqC + DstOtherStateData%SgnPrvLSTQ = SrcOtherStateData%SgnPrvLSTQ + DstOtherStateData%SgnLSTQ = SrcOtherStateData%SgnLSTQ + END SUBROUTINE ED_CopyOtherState - DO i2 = LBOUND(InData%rSAerCenn2,2), UBOUND(InData%rSAerCenn2,2) - DO i1 = LBOUND(InData%rSAerCenn2,1), UBOUND(InData%rSAerCenn2,1) - ReKiBuf(Re_Xferred) = InData%rSAerCenn2(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SAeroTwst) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SAeroTwst,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SAeroTwst,1) - Int_Xferred = Int_Xferred + 2 + SUBROUTINE ED_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) + TYPE(ED_OtherStateType), INTENT(INOUT) :: OtherStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyOtherState' - DO i1 = LBOUND(InData%SAeroTwst,1), UBOUND(InData%SAeroTwst,1) - ReKiBuf(Re_Xferred) = InData%SAeroTwst(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StiffBE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StiffBE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StiffBE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StiffBE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StiffBE,2) - Int_Xferred = Int_Xferred + 2 + ErrStat = ErrID_None + ErrMsg = "" - DO i2 = LBOUND(InData%StiffBE,2), UBOUND(InData%StiffBE,2) - DO i1 = LBOUND(InData%StiffBE,1), UBOUND(InData%StiffBE,1) - ReKiBuf(Re_Xferred) = InData%StiffBE(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StiffBF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StiffBF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StiffBF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StiffBF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StiffBF,2) - Int_Xferred = Int_Xferred + 2 +DO i1 = LBOUND(OtherStateData%xdot,1), UBOUND(OtherStateData%xdot,1) + CALL ED_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +IF (ALLOCATED(OtherStateData%IC)) THEN + DEALLOCATE(OtherStateData%IC) +ENDIF + END SUBROUTINE ED_DestroyOtherState - DO i2 = LBOUND(InData%StiffBF,2), UBOUND(InData%StiffBF,2) - DO i1 = LBOUND(InData%StiffBF,1), UBOUND(InData%StiffBF,1) - ReKiBuf(Re_Xferred) = InData%StiffBF(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SThetaS) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SThetaS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SThetaS,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SThetaS,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SThetaS,2) - Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%SThetaS,2), UBOUND(InData%SThetaS,2) - DO i1 = LBOUND(InData%SThetaS,1), UBOUND(InData%SThetaS,1) - DbKiBuf(Db_Xferred) = InData%SThetaS(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO +subroutine ED_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ED_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackOtherState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! n + call RegPack(Buf, InData%n) + if (RegCheckErr(Buf, RoutineName)) return + ! xdot + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) + do i1 = LB(1), UB(1) + call ED_PackContState(Buf, InData%xdot(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! IC + call RegPack(Buf, allocated(InData%IC)) + if (allocated(InData%IC)) then + call RegPackBounds(Buf, 1, lbound(InData%IC), ubound(InData%IC)) + call RegPack(Buf, InData%IC) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! HSSBrTrq + call RegPack(Buf, InData%HSSBrTrq) + if (RegCheckErr(Buf, RoutineName)) return + ! HSSBrTrqC + call RegPack(Buf, InData%HSSBrTrqC) + if (RegCheckErr(Buf, RoutineName)) return + ! SgnPrvLSTQ + call RegPack(Buf, InData%SgnPrvLSTQ) + if (RegCheckErr(Buf, RoutineName)) return + ! SgnLSTQ + call RegPack(Buf, InData%SgnLSTQ) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ED_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ED_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackOtherState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! n + call RegUnpack(Buf, OutData%n) + if (RegCheckErr(Buf, RoutineName)) return + ! xdot + LB(1:1) = lbound(OutData%xdot) + UB(1:1) = ubound(OutData%xdot) + do i1 = LB(1), UB(1) + call ED_UnpackContState(Buf, OutData%xdot(i1)) ! xdot + end do + ! IC + if (allocated(OutData%IC)) deallocate(OutData%IC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IC) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! HSSBrTrq + call RegUnpack(Buf, OutData%HSSBrTrq) + if (RegCheckErr(Buf, RoutineName)) return + ! HSSBrTrqC + call RegUnpack(Buf, OutData%HSSBrTrqC) + if (RegCheckErr(Buf, RoutineName)) return + ! SgnPrvLSTQ + call RegUnpack(Buf, OutData%SgnPrvLSTQ) + if (RegCheckErr(Buf, RoutineName)) return + ! SgnLSTQ + call RegUnpack(Buf, OutData%SgnLSTQ) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + SUBROUTINE ED_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ED_MiscVarType), INTENT(IN) :: SrcMiscData + TYPE(ED_MiscVarType), INTENT(INOUT) :: DstMiscData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ED_CopyMisc' +! + ErrStat = ErrID_None + ErrMsg = "" + CALL ED_Copycoordsys( SrcMiscData%CoordSys, DstMiscData%CoordSys, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL ED_Copyrthndside( SrcMiscData%RtHS, DstMiscData%RtHS, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcMiscData%AllOuts)) THEN + i1_l = LBOUND(SrcMiscData%AllOuts,1) + i1_u = UBOUND(SrcMiscData%AllOuts,1) + IF (.NOT. ALLOCATED(DstMiscData%AllOuts)) THEN + ALLOCATE(DstMiscData%AllOuts(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF ( .NOT. ALLOCATED(InData%ThetaS) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ThetaS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ThetaS,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ThetaS,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ThetaS,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ThetaS,2), UBOUND(InData%ThetaS,2) - DO i1 = LBOUND(InData%ThetaS,1), UBOUND(InData%ThetaS,1) - ReKiBuf(Re_Xferred) = InData%ThetaS(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO + DstMiscData%AllOuts = SrcMiscData%AllOuts +ENDIF +IF (ALLOCATED(SrcMiscData%AugMat)) THEN + i1_l = LBOUND(SrcMiscData%AugMat,1) + i1_u = UBOUND(SrcMiscData%AugMat,1) + i2_l = LBOUND(SrcMiscData%AugMat,2) + i2_u = UBOUND(SrcMiscData%AugMat,2) + IF (.NOT. ALLOCATED(DstMiscData%AugMat)) THEN + ALLOCATE(DstMiscData%AugMat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AugMat.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF ( .NOT. ALLOCATED(InData%TwistedSF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwistedSF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwistedSF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwistedSF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwistedSF,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwistedSF,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwistedSF,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwistedSF,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwistedSF,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwistedSF,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwistedSF,5) - Int_Xferred = Int_Xferred + 2 - - DO i5 = LBOUND(InData%TwistedSF,5), UBOUND(InData%TwistedSF,5) - DO i4 = LBOUND(InData%TwistedSF,4), UBOUND(InData%TwistedSF,4) - DO i3 = LBOUND(InData%TwistedSF,3), UBOUND(InData%TwistedSF,3) - DO i2 = LBOUND(InData%TwistedSF,2), UBOUND(InData%TwistedSF,2) - DO i1 = LBOUND(InData%TwistedSF,1), UBOUND(InData%TwistedSF,1) - ReKiBuf(Re_Xferred) = InData%TwistedSF(i1,i2,i3,i4,i5) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO + DstMiscData%AugMat = SrcMiscData%AugMat +ENDIF +IF (ALLOCATED(SrcMiscData%AugMat_factor)) THEN + i1_l = LBOUND(SrcMiscData%AugMat_factor,1) + i1_u = UBOUND(SrcMiscData%AugMat_factor,1) + i2_l = LBOUND(SrcMiscData%AugMat_factor,2) + i2_u = UBOUND(SrcMiscData%AugMat_factor,2) + IF (.NOT. ALLOCATED(DstMiscData%AugMat_factor)) THEN + ALLOCATE(DstMiscData%AugMat_factor(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AugMat_factor.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF ( .NOT. ALLOCATED(InData%BldFl1Sh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldFl1Sh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldFl1Sh,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldFl1Sh,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldFl1Sh,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BldFl1Sh,2), UBOUND(InData%BldFl1Sh,2) - DO i1 = LBOUND(InData%BldFl1Sh,1), UBOUND(InData%BldFl1Sh,1) - ReKiBuf(Re_Xferred) = InData%BldFl1Sh(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO + DstMiscData%AugMat_factor = SrcMiscData%AugMat_factor +ENDIF +IF (ALLOCATED(SrcMiscData%SolnVec)) THEN + i1_l = LBOUND(SrcMiscData%SolnVec,1) + i1_u = UBOUND(SrcMiscData%SolnVec,1) + IF (.NOT. ALLOCATED(DstMiscData%SolnVec)) THEN + ALLOCATE(DstMiscData%SolnVec(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SolnVec.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF ( .NOT. ALLOCATED(InData%BldFl2Sh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldFl2Sh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldFl2Sh,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldFl2Sh,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldFl2Sh,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BldFl2Sh,2), UBOUND(InData%BldFl2Sh,2) - DO i1 = LBOUND(InData%BldFl2Sh,1), UBOUND(InData%BldFl2Sh,1) - ReKiBuf(Re_Xferred) = InData%BldFl2Sh(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO + DstMiscData%SolnVec = SrcMiscData%SolnVec +ENDIF +IF (ALLOCATED(SrcMiscData%AugMat_pivot)) THEN + i1_l = LBOUND(SrcMiscData%AugMat_pivot,1) + i1_u = UBOUND(SrcMiscData%AugMat_pivot,1) + IF (.NOT. ALLOCATED(DstMiscData%AugMat_pivot)) THEN + ALLOCATE(DstMiscData%AugMat_pivot(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AugMat_pivot.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF ( .NOT. ALLOCATED(InData%BldEdgSh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldEdgSh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldEdgSh,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldEdgSh,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldEdgSh,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BldEdgSh,2), UBOUND(InData%BldEdgSh,2) - DO i1 = LBOUND(InData%BldEdgSh,1), UBOUND(InData%BldEdgSh,1) - ReKiBuf(Re_Xferred) = InData%BldEdgSh(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO + DstMiscData%AugMat_pivot = SrcMiscData%AugMat_pivot +ENDIF +IF (ALLOCATED(SrcMiscData%OgnlGeAzRo)) THEN + i1_l = LBOUND(SrcMiscData%OgnlGeAzRo,1) + i1_u = UBOUND(SrcMiscData%OgnlGeAzRo,1) + IF (.NOT. ALLOCATED(DstMiscData%OgnlGeAzRo)) THEN + ALLOCATE(DstMiscData%OgnlGeAzRo(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%OgnlGeAzRo.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF ( .NOT. ALLOCATED(InData%FreqBE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FreqBE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FreqBE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FreqBE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FreqBE,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FreqBE,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FreqBE,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%FreqBE,3), UBOUND(InData%FreqBE,3) - DO i2 = LBOUND(InData%FreqBE,2), UBOUND(InData%FreqBE,2) - DO i1 = LBOUND(InData%FreqBE,1), UBOUND(InData%FreqBE,1) - ReKiBuf(Re_Xferred) = InData%FreqBE(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO + DstMiscData%OgnlGeAzRo = SrcMiscData%OgnlGeAzRo +ENDIF +IF (ALLOCATED(SrcMiscData%QD2T)) THEN + i1_l = LBOUND(SrcMiscData%QD2T,1) + i1_u = UBOUND(SrcMiscData%QD2T,1) + IF (.NOT. ALLOCATED(DstMiscData%QD2T)) THEN + ALLOCATE(DstMiscData%QD2T(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%QD2T.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF ( .NOT. ALLOCATED(InData%FreqBF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FreqBF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FreqBF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FreqBF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FreqBF,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FreqBF,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FreqBF,3) - Int_Xferred = Int_Xferred + 2 + DstMiscData%QD2T = SrcMiscData%QD2T +ENDIF + DstMiscData%IgnoreMod = SrcMiscData%IgnoreMod + END SUBROUTINE ED_CopyMisc - DO i3 = LBOUND(InData%FreqBF,3), UBOUND(InData%FreqBF,3) - DO i2 = LBOUND(InData%FreqBF,2), UBOUND(InData%FreqBF,2) - DO i1 = LBOUND(InData%FreqBF,1), UBOUND(InData%FreqBF,1) - ReKiBuf(Re_Xferred) = InData%FreqBF(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - DO i2 = LBOUND(InData%FreqTFA,2), UBOUND(InData%FreqTFA,2) - DO i1 = LBOUND(InData%FreqTFA,1), UBOUND(InData%FreqTFA,1) - ReKiBuf(Re_Xferred) = InData%FreqTFA(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%FreqTSS,2), UBOUND(InData%FreqTSS,2) - DO i1 = LBOUND(InData%FreqTSS,1), UBOUND(InData%FreqTSS,1) - ReKiBuf(Re_Xferred) = InData%FreqTSS(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - ReKiBuf(Re_Xferred) = InData%TeetCDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TeetDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TeetDmpP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TeetHSSp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TeetHStP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TeetSSSp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TeetSStP - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TeetMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlDSDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlDSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlDSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlDSSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlUSDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlUSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlUSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TFrlUSSpr - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TFrlMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlDSDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlDSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlDSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlDSSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlUSDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlUSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlUSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RFrlUSSpr - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%RFrlMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ShftGagL - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%BldGagNd,1), UBOUND(InData%BldGagNd,1) - IntKiBuf(Int_Xferred) = InData%BldGagNd(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TwrGagNd,1), UBOUND(InData%TwrGagNd,1) - IntKiBuf(Int_Xferred) = InData%TwrGagNd(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DbKiBuf(Db_Xferred) = InData%TStart - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DTTorDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DTTorSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GBRatio - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GBoxEff - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RotSpeed - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%BElmntMass) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BElmntMass,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BElmntMass,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BElmntMass,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BElmntMass,2) - Int_Xferred = Int_Xferred + 2 + SUBROUTINE ED_DestroyMisc( MiscData, ErrStat, ErrMsg ) + TYPE(ED_MiscVarType), INTENT(INOUT) :: MiscData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyMisc' - DO i2 = LBOUND(InData%BElmntMass,2), UBOUND(InData%BElmntMass,2) - DO i1 = LBOUND(InData%BElmntMass,1), UBOUND(InData%BElmntMass,1) - ReKiBuf(Re_Xferred) = InData%BElmntMass(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TElmntMass) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TElmntMass,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TElmntMass,1) - Int_Xferred = Int_Xferred + 2 + ErrStat = ErrID_None + ErrMsg = "" - DO i1 = LBOUND(InData%TElmntMass,1), UBOUND(InData%TElmntMass,1) - ReKiBuf(Re_Xferred) = InData%TElmntMass(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%method - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmCMxt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmCMyt - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%BD4Blades, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseAD14, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%BldNd_NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%BldNd_TotNumOuts - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BldNd_OutParam) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BldNd_OutParam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_OutParam,1) - Int_Xferred = Int_Xferred + 2 + CALL ED_DestroyCoordSys( MiscData%CoordSys, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL ED_DestroyRtHndSide( MiscData%RtHS, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(MiscData%AllOuts)) THEN + DEALLOCATE(MiscData%AllOuts) +ENDIF +IF (ALLOCATED(MiscData%AugMat)) THEN + DEALLOCATE(MiscData%AugMat) +ENDIF +IF (ALLOCATED(MiscData%AugMat_factor)) THEN + DEALLOCATE(MiscData%AugMat_factor) +ENDIF +IF (ALLOCATED(MiscData%SolnVec)) THEN + DEALLOCATE(MiscData%SolnVec) +ENDIF +IF (ALLOCATED(MiscData%AugMat_pivot)) THEN + DEALLOCATE(MiscData%AugMat_pivot) +ENDIF +IF (ALLOCATED(MiscData%OgnlGeAzRo)) THEN + DEALLOCATE(MiscData%OgnlGeAzRo) +ENDIF +IF (ALLOCATED(MiscData%QD2T)) THEN + DEALLOCATE(MiscData%QD2T) +ENDIF + END SUBROUTINE ED_DestroyMisc - DO i1 = LBOUND(InData%BldNd_OutParam,1), UBOUND(InData%BldNd_OutParam,1) - CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! BldNd_OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO +subroutine ED_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ED_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + ! CoordSys + call ED_PackCoordSys(Buf, InData%CoordSys) + if (RegCheckErr(Buf, RoutineName)) return + ! RtHS + call ED_PackRtHndSide(Buf, InData%RtHS) + if (RegCheckErr(Buf, RoutineName)) return + ! AllOuts + call RegPack(Buf, allocated(InData%AllOuts)) + if (allocated(InData%AllOuts)) then + call RegPackBounds(Buf, 1, lbound(InData%AllOuts), ubound(InData%AllOuts)) + call RegPack(Buf, InData%AllOuts) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AugMat + call RegPack(Buf, allocated(InData%AugMat)) + if (allocated(InData%AugMat)) then + call RegPackBounds(Buf, 2, lbound(InData%AugMat), ubound(InData%AugMat)) + call RegPack(Buf, InData%AugMat) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AugMat_factor + call RegPack(Buf, allocated(InData%AugMat_factor)) + if (allocated(InData%AugMat_factor)) then + call RegPackBounds(Buf, 2, lbound(InData%AugMat_factor), ubound(InData%AugMat_factor)) + call RegPack(Buf, InData%AugMat_factor) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SolnVec + call RegPack(Buf, allocated(InData%SolnVec)) + if (allocated(InData%SolnVec)) then + call RegPackBounds(Buf, 1, lbound(InData%SolnVec), ubound(InData%SolnVec)) + call RegPack(Buf, InData%SolnVec) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AugMat_pivot + call RegPack(Buf, allocated(InData%AugMat_pivot)) + if (allocated(InData%AugMat_pivot)) then + call RegPackBounds(Buf, 1, lbound(InData%AugMat_pivot), ubound(InData%AugMat_pivot)) + call RegPack(Buf, InData%AugMat_pivot) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OgnlGeAzRo + call RegPack(Buf, allocated(InData%OgnlGeAzRo)) + if (allocated(InData%OgnlGeAzRo)) then + call RegPackBounds(Buf, 1, lbound(InData%OgnlGeAzRo), ubound(InData%OgnlGeAzRo)) + call RegPack(Buf, InData%OgnlGeAzRo) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! QD2T + call RegPack(Buf, allocated(InData%QD2T)) + if (allocated(InData%QD2T)) then + call RegPackBounds(Buf, 1, lbound(InData%QD2T), ubound(InData%QD2T)) + call RegPack(Buf, InData%QD2T) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! IgnoreMod + call RegPack(Buf, InData%IgnoreMod) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ED_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ED_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackMisc' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! CoordSys + call ED_UnpackCoordSys(Buf, OutData%CoordSys) ! CoordSys + ! RtHS + call ED_UnpackRtHndSide(Buf, OutData%RtHS) ! RtHS + ! AllOuts + if (allocated(OutData%AllOuts)) deallocate(OutData%AllOuts) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AllOuts(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AllOuts) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AugMat + if (allocated(OutData%AugMat)) deallocate(OutData%AugMat) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AugMat(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AugMat.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AugMat) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AugMat_factor + if (allocated(OutData%AugMat_factor)) deallocate(OutData%AugMat_factor) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AugMat_factor(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AugMat_factor.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AugMat_factor) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! SolnVec + if (allocated(OutData%SolnVec)) deallocate(OutData%SolnVec) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SolnVec(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SolnVec.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SolnVec) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AugMat_pivot + if (allocated(OutData%AugMat_pivot)) deallocate(OutData%AugMat_pivot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AugMat_pivot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AugMat_pivot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AugMat_pivot) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! OgnlGeAzRo + if (allocated(OutData%OgnlGeAzRo)) deallocate(OutData%OgnlGeAzRo) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OgnlGeAzRo(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OgnlGeAzRo.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OgnlGeAzRo) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! QD2T + if (allocated(OutData%QD2T)) deallocate(OutData%QD2T) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%QD2T(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%QD2T.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%QD2T) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! IgnoreMod + call RegUnpack(Buf, OutData%IgnoreMod) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + SUBROUTINE ED_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ED_ParameterType), INTENT(IN) :: SrcParamData + TYPE(ED_ParameterType), INTENT(INOUT) :: DstParamData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 + INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ED_CopyParam' +! + ErrStat = ErrID_None + ErrMsg = "" + DstParamData%DT = SrcParamData%DT + DstParamData%DT24 = SrcParamData%DT24 + DstParamData%BldNodes = SrcParamData%BldNodes + DstParamData%TipNode = SrcParamData%TipNode + DstParamData%NDOF = SrcParamData%NDOF + DstParamData%TwoPiNB = SrcParamData%TwoPiNB + DstParamData%NAug = SrcParamData%NAug + DstParamData%NPH = SrcParamData%NPH +IF (ALLOCATED(SrcParamData%PH)) THEN + i1_l = LBOUND(SrcParamData%PH,1) + i1_u = UBOUND(SrcParamData%PH,1) + IF (.NOT. ALLOCATED(DstParamData%PH)) THEN + ALLOCATE(DstParamData%PH(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PH.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IntKiBuf(Int_Xferred) = InData%BldNd_BladesOut - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Jac_u_indx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_u_indx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_u_indx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jac_u_indx,2), UBOUND(InData%Jac_u_indx,2) - DO i1 = LBOUND(InData%Jac_u_indx,1), UBOUND(InData%Jac_u_indx,1) - IntKiBuf(Int_Xferred) = InData%Jac_u_indx(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO + DstParamData%PH = SrcParamData%PH +ENDIF + DstParamData%NPM = SrcParamData%NPM +IF (ALLOCATED(SrcParamData%PM)) THEN + i1_l = LBOUND(SrcParamData%PM,1) + i1_u = UBOUND(SrcParamData%PM,1) + i2_l = LBOUND(SrcParamData%PM,2) + i2_u = UBOUND(SrcParamData%PM,2) + IF (.NOT. ALLOCATED(DstParamData%PM)) THEN + ALLOCATE(DstParamData%PM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PM.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF ( .NOT. ALLOCATED(InData%du) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%du,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%du,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%du,1), UBOUND(InData%du,1) - DbKiBuf(Db_Xferred) = InData%du(i1) - Db_Xferred = Db_Xferred + 1 - END DO + DstParamData%PM = SrcParamData%PM +ENDIF +IF (ALLOCATED(SrcParamData%DOF_Flag)) THEN + i1_l = LBOUND(SrcParamData%DOF_Flag,1) + i1_u = UBOUND(SrcParamData%DOF_Flag,1) + IF (.NOT. ALLOCATED(DstParamData%DOF_Flag)) THEN + ALLOCATE(DstParamData%DOF_Flag(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DOF_Flag.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF ( .NOT. ALLOCATED(InData%dx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dx,1), UBOUND(InData%dx,1) - DbKiBuf(Db_Xferred) = InData%dx(i1) - Db_Xferred = Db_Xferred + 1 - END DO + DstParamData%DOF_Flag = SrcParamData%DOF_Flag +ENDIF +IF (ALLOCATED(SrcParamData%DOF_Desc)) THEN + i1_l = LBOUND(SrcParamData%DOF_Desc,1) + i1_u = UBOUND(SrcParamData%DOF_Desc,1) + IF (.NOT. ALLOCATED(DstParamData%DOF_Desc)) THEN + ALLOCATE(DstParamData%DOF_Desc(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DOF_Desc.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IntKiBuf(Int_Xferred) = InData%Jac_ny - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE ED_PackParam - - SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ED_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%DT24 = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%BldNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TipNode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NDOF = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TwoPiNB = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%NAug = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPH = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PH not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PH)) DEALLOCATE(OutData%PH) - ALLOCATE(OutData%PH(i1_l:i1_u),STAT=ErrStat2) + DstParamData%DOF_Desc = SrcParamData%DOF_Desc +ENDIF + CALL ED_Copyactivedofs( SrcParamData%DOFs, DstParamData%DOFs, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%OutFmt = SrcParamData%OutFmt + DstParamData%NBlGages = SrcParamData%NBlGages + DstParamData%NTwGages = SrcParamData%NTwGages +IF (ALLOCATED(SrcParamData%OutParam)) THEN + i1_l = LBOUND(SrcParamData%OutParam,1) + i1_u = UBOUND(SrcParamData%OutParam,1) + IF (.NOT. ALLOCATED(DstParamData%OutParam)) THEN + ALLOCATE(DstParamData%OutParam(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PH.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%PH,1), UBOUND(OutData%PH,1) - OutData%PH(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO END IF - OutData%NPM = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PM not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PM)) DEALLOCATE(OutData%PM) - ALLOCATE(OutData%PM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DO i1 = LBOUND(SrcParamData%OutParam,1), UBOUND(SrcParamData%OutParam,1) + CALL NWTC_Library_Copyoutparmtype( SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + DstParamData%Delim = SrcParamData%Delim + DstParamData%AvgNrmTpRd = SrcParamData%AvgNrmTpRd + DstParamData%AzimB1Up = SrcParamData%AzimB1Up + DstParamData%CosDel3 = SrcParamData%CosDel3 +IF (ALLOCATED(SrcParamData%CosPreC)) THEN + i1_l = LBOUND(SrcParamData%CosPreC,1) + i1_u = UBOUND(SrcParamData%CosPreC,1) + IF (.NOT. ALLOCATED(DstParamData%CosPreC)) THEN + ALLOCATE(DstParamData%CosPreC(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PM.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CosPreC.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i2 = LBOUND(OutData%PM,2), UBOUND(OutData%PM,2) - DO i1 = LBOUND(OutData%PM,1), UBOUND(OutData%PM,1) - OutData%PM(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DOF_Flag not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DOF_Flag)) DEALLOCATE(OutData%DOF_Flag) - ALLOCATE(OutData%DOF_Flag(i1_l:i1_u),STAT=ErrStat2) + DstParamData%CosPreC = SrcParamData%CosPreC +ENDIF + DstParamData%CRFrlSkew = SrcParamData%CRFrlSkew + DstParamData%CRFrlSkw2 = SrcParamData%CRFrlSkw2 + DstParamData%CRFrlTilt = SrcParamData%CRFrlTilt + DstParamData%CRFrlTlt2 = SrcParamData%CRFrlTlt2 + DstParamData%CShftSkew = SrcParamData%CShftSkew + DstParamData%CShftTilt = SrcParamData%CShftTilt + DstParamData%CSRFrlSkw = SrcParamData%CSRFrlSkw + DstParamData%CSRFrlTlt = SrcParamData%CSRFrlTlt + DstParamData%CSTFrlSkw = SrcParamData%CSTFrlSkw + DstParamData%CSTFrlTlt = SrcParamData%CSTFrlTlt + DstParamData%CTFrlSkew = SrcParamData%CTFrlSkew + DstParamData%CTFrlSkw2 = SrcParamData%CTFrlSkw2 + DstParamData%CTFrlTilt = SrcParamData%CTFrlTilt + DstParamData%CTFrlTlt2 = SrcParamData%CTFrlTlt2 + DstParamData%HubHt = SrcParamData%HubHt + DstParamData%HubCM = SrcParamData%HubCM + DstParamData%HubRad = SrcParamData%HubRad + DstParamData%NacCMxn = SrcParamData%NacCMxn + DstParamData%NacCMyn = SrcParamData%NacCMyn + DstParamData%NacCMzn = SrcParamData%NacCMzn + DstParamData%OverHang = SrcParamData%OverHang + DstParamData%ProjArea = SrcParamData%ProjArea + DstParamData%PtfmRefzt = SrcParamData%PtfmRefzt + DstParamData%RefTwrHt = SrcParamData%RefTwrHt + DstParamData%RFrlPnt_n = SrcParamData%RFrlPnt_n + DstParamData%rVDxn = SrcParamData%rVDxn + DstParamData%rVDyn = SrcParamData%rVDyn + DstParamData%rVDzn = SrcParamData%rVDzn + DstParamData%rVIMUxn = SrcParamData%rVIMUxn + DstParamData%rVIMUyn = SrcParamData%rVIMUyn + DstParamData%rVIMUzn = SrcParamData%rVIMUzn + DstParamData%rVPxn = SrcParamData%rVPxn + DstParamData%rVPyn = SrcParamData%rVPyn + DstParamData%rVPzn = SrcParamData%rVPzn + DstParamData%rWIxn = SrcParamData%rWIxn + DstParamData%rWIyn = SrcParamData%rWIyn + DstParamData%rWIzn = SrcParamData%rWIzn + DstParamData%rWJxn = SrcParamData%rWJxn + DstParamData%rWJyn = SrcParamData%rWJyn + DstParamData%rWJzn = SrcParamData%rWJzn + DstParamData%rZT0zt = SrcParamData%rZT0zt + DstParamData%rZYzt = SrcParamData%rZYzt + DstParamData%SinDel3 = SrcParamData%SinDel3 +IF (ALLOCATED(SrcParamData%SinPreC)) THEN + i1_l = LBOUND(SrcParamData%SinPreC,1) + i1_u = UBOUND(SrcParamData%SinPreC,1) + IF (.NOT. ALLOCATED(DstParamData%SinPreC)) THEN + ALLOCATE(DstParamData%SinPreC(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DOF_Flag.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%SinPreC.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%DOF_Flag,1), UBOUND(OutData%DOF_Flag,1) - OutData%DOF_Flag(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%DOF_Flag(i1)) - Int_Xferred = Int_Xferred + 1 - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DOF_Desc not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DOF_Desc)) DEALLOCATE(OutData%DOF_Desc) - ALLOCATE(OutData%DOF_Desc(i1_l:i1_u),STAT=ErrStat2) + DstParamData%SinPreC = SrcParamData%SinPreC +ENDIF + DstParamData%SRFrlSkew = SrcParamData%SRFrlSkew + DstParamData%SRFrlSkw2 = SrcParamData%SRFrlSkw2 + DstParamData%SRFrlTilt = SrcParamData%SRFrlTilt + DstParamData%SRFrlTlt2 = SrcParamData%SRFrlTlt2 + DstParamData%SShftSkew = SrcParamData%SShftSkew + DstParamData%SShftTilt = SrcParamData%SShftTilt + DstParamData%STFrlSkew = SrcParamData%STFrlSkew + DstParamData%STFrlSkw2 = SrcParamData%STFrlSkw2 + DstParamData%STFrlTilt = SrcParamData%STFrlTilt + DstParamData%STFrlTlt2 = SrcParamData%STFrlTlt2 + DstParamData%TFrlPnt_n = SrcParamData%TFrlPnt_n + DstParamData%TipRad = SrcParamData%TipRad + DstParamData%TowerHt = SrcParamData%TowerHt + DstParamData%TowerBsHt = SrcParamData%TowerBsHt + DstParamData%UndSling = SrcParamData%UndSling + DstParamData%NumBl = SrcParamData%NumBl +IF (ALLOCATED(SrcParamData%AxRedTFA)) THEN + i1_l = LBOUND(SrcParamData%AxRedTFA,1) + i1_u = UBOUND(SrcParamData%AxRedTFA,1) + i2_l = LBOUND(SrcParamData%AxRedTFA,2) + i2_u = UBOUND(SrcParamData%AxRedTFA,2) + i3_l = LBOUND(SrcParamData%AxRedTFA,3) + i3_u = UBOUND(SrcParamData%AxRedTFA,3) + IF (.NOT. ALLOCATED(DstParamData%AxRedTFA)) THEN + ALLOCATE(DstParamData%AxRedTFA(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DOF_Desc.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AxRedTFA.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%DOF_Desc,1), UBOUND(OutData%DOF_Desc,1) - DO I = 1, LEN(OutData%DOF_Desc) - OutData%DOF_Desc(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ED_UnpackActiveDOFs( Re_Buf, Db_Buf, Int_Buf, OutData%DOFs, ErrStat2, ErrMsg2 ) ! DOFs - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%NBlGages = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NTwGages = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutParam)) DEALLOCATE(OutData%OutParam) - ALLOCATE(OutData%OutParam(i1_l:i1_u),STAT=ErrStat2) + DstParamData%AxRedTFA = SrcParamData%AxRedTFA +ENDIF +IF (ALLOCATED(SrcParamData%AxRedTSS)) THEN + i1_l = LBOUND(SrcParamData%AxRedTSS,1) + i1_u = UBOUND(SrcParamData%AxRedTSS,1) + i2_l = LBOUND(SrcParamData%AxRedTSS,2) + i2_u = UBOUND(SrcParamData%AxRedTSS,2) + i3_l = LBOUND(SrcParamData%AxRedTSS,3) + i3_u = UBOUND(SrcParamData%AxRedTSS,3) + IF (.NOT. ALLOCATED(DstParamData%AxRedTSS)) THEN + ALLOCATE(DstParamData%AxRedTSS(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AxRedTSS.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%OutParam,1), UBOUND(OutData%OutParam,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackOutParmType( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO END IF - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%AvgNrmTpRd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AzimB1Up = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CosDel3 = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CosPreC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CosPreC)) DEALLOCATE(OutData%CosPreC) - ALLOCATE(OutData%CosPreC(i1_l:i1_u),STAT=ErrStat2) + DstParamData%AxRedTSS = SrcParamData%AxRedTSS +ENDIF + DstParamData%CTFA = SrcParamData%CTFA + DstParamData%CTSS = SrcParamData%CTSS +IF (ALLOCATED(SrcParamData%DHNodes)) THEN + i1_l = LBOUND(SrcParamData%DHNodes,1) + i1_u = UBOUND(SrcParamData%DHNodes,1) + IF (.NOT. ALLOCATED(DstParamData%DHNodes)) THEN + ALLOCATE(DstParamData%DHNodes(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CosPreC.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DHNodes.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%CosPreC,1), UBOUND(OutData%CosPreC,1) - OutData%CosPreC(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO END IF - OutData%CRFrlSkew = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CRFrlSkw2 = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CRFrlTilt = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CRFrlTlt2 = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CShftSkew = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CShftTilt = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CSRFrlSkw = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CSRFrlTlt = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CSTFrlSkw = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CSTFrlTlt = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CTFrlSkew = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CTFrlSkw2 = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CTFrlTilt = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CTFrlTlt2 = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%HubHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HubCM = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HubRad = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NacCMxn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NacCMyn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NacCMzn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%OverHang = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ProjArea = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmRefzt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RefTwrHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%RFrlPnt_n,1) - i1_u = UBOUND(OutData%RFrlPnt_n,1) - DO i1 = LBOUND(OutData%RFrlPnt_n,1), UBOUND(OutData%RFrlPnt_n,1) - OutData%RFrlPnt_n(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%rVDxn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rVDyn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rVDzn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rVIMUxn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rVIMUyn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rVIMUzn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rVPxn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rVPyn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rVPzn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rWIxn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rWIyn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rWIzn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rWJxn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rWJyn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rWJzn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rZT0zt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rZYzt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SinDel3 = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SinPreC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SinPreC)) DEALLOCATE(OutData%SinPreC) - ALLOCATE(OutData%SinPreC(i1_l:i1_u),STAT=ErrStat2) + DstParamData%DHNodes = SrcParamData%DHNodes +ENDIF +IF (ALLOCATED(SrcParamData%HNodes)) THEN + i1_l = LBOUND(SrcParamData%HNodes,1) + i1_u = UBOUND(SrcParamData%HNodes,1) + IF (.NOT. ALLOCATED(DstParamData%HNodes)) THEN + ALLOCATE(DstParamData%HNodes(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SinPreC.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%HNodes.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%SinPreC,1), UBOUND(OutData%SinPreC,1) - OutData%SinPreC(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO END IF - OutData%SRFrlSkew = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%SRFrlSkw2 = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%SRFrlTilt = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%SRFrlTlt2 = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%SShftSkew = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%SShftTilt = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%STFrlSkew = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%STFrlSkw2 = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%STFrlTilt = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%STFrlTlt2 = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%TFrlPnt_n,1) - i1_u = UBOUND(OutData%TFrlPnt_n,1) - DO i1 = LBOUND(OutData%TFrlPnt_n,1), UBOUND(OutData%TFrlPnt_n,1) - OutData%TFrlPnt_n(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%TipRad = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TowerHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TowerBsHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%UndSling = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NumBl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AxRedTFA not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AxRedTFA)) DEALLOCATE(OutData%AxRedTFA) - ALLOCATE(OutData%AxRedTFA(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + DstParamData%HNodes = SrcParamData%HNodes +ENDIF +IF (ALLOCATED(SrcParamData%HNodesNorm)) THEN + i1_l = LBOUND(SrcParamData%HNodesNorm,1) + i1_u = UBOUND(SrcParamData%HNodesNorm,1) + IF (.NOT. ALLOCATED(DstParamData%HNodesNorm)) THEN + ALLOCATE(DstParamData%HNodesNorm(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxRedTFA.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%HNodesNorm.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i3 = LBOUND(OutData%AxRedTFA,3), UBOUND(OutData%AxRedTFA,3) - DO i2 = LBOUND(OutData%AxRedTFA,2), UBOUND(OutData%AxRedTFA,2) - DO i1 = LBOUND(OutData%AxRedTFA,1), UBOUND(OutData%AxRedTFA,1) - OutData%AxRedTFA(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AxRedTSS not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AxRedTSS)) DEALLOCATE(OutData%AxRedTSS) - ALLOCATE(OutData%AxRedTSS(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + DstParamData%HNodesNorm = SrcParamData%HNodesNorm +ENDIF + DstParamData%KTFA = SrcParamData%KTFA + DstParamData%KTSS = SrcParamData%KTSS +IF (ALLOCATED(SrcParamData%MassT)) THEN + i1_l = LBOUND(SrcParamData%MassT,1) + i1_u = UBOUND(SrcParamData%MassT,1) + IF (.NOT. ALLOCATED(DstParamData%MassT)) THEN + ALLOCATE(DstParamData%MassT(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxRedTSS.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MassT.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i3 = LBOUND(OutData%AxRedTSS,3), UBOUND(OutData%AxRedTSS,3) - DO i2 = LBOUND(OutData%AxRedTSS,2), UBOUND(OutData%AxRedTSS,2) - DO i1 = LBOUND(OutData%AxRedTSS,1), UBOUND(OutData%AxRedTSS,1) - OutData%AxRedTSS(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO END IF - i1_l = LBOUND(OutData%CTFA,1) - i1_u = UBOUND(OutData%CTFA,1) - i2_l = LBOUND(OutData%CTFA,2) - i2_u = UBOUND(OutData%CTFA,2) - DO i2 = LBOUND(OutData%CTFA,2), UBOUND(OutData%CTFA,2) - DO i1 = LBOUND(OutData%CTFA,1), UBOUND(OutData%CTFA,1) - OutData%CTFA(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%CTSS,1) - i1_u = UBOUND(OutData%CTSS,1) - i2_l = LBOUND(OutData%CTSS,2) - i2_u = UBOUND(OutData%CTSS,2) - DO i2 = LBOUND(OutData%CTSS,2), UBOUND(OutData%CTSS,2) - DO i1 = LBOUND(OutData%CTSS,1), UBOUND(OutData%CTSS,1) - OutData%CTSS(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DHNodes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DHNodes)) DEALLOCATE(OutData%DHNodes) - ALLOCATE(OutData%DHNodes(i1_l:i1_u),STAT=ErrStat2) + DstParamData%MassT = SrcParamData%MassT +ENDIF +IF (ALLOCATED(SrcParamData%StiffTSS)) THEN + i1_l = LBOUND(SrcParamData%StiffTSS,1) + i1_u = UBOUND(SrcParamData%StiffTSS,1) + IF (.NOT. ALLOCATED(DstParamData%StiffTSS)) THEN + ALLOCATE(DstParamData%StiffTSS(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DHNodes.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StiffTSS.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%DHNodes,1), UBOUND(OutData%DHNodes,1) - OutData%DHNodes(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HNodes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%HNodes)) DEALLOCATE(OutData%HNodes) - ALLOCATE(OutData%HNodes(i1_l:i1_u),STAT=ErrStat2) + DstParamData%StiffTSS = SrcParamData%StiffTSS +ENDIF +IF (ALLOCATED(SrcParamData%TwrFASF)) THEN + i1_l = LBOUND(SrcParamData%TwrFASF,1) + i1_u = UBOUND(SrcParamData%TwrFASF,1) + i2_l = LBOUND(SrcParamData%TwrFASF,2) + i2_u = UBOUND(SrcParamData%TwrFASF,2) + i3_l = LBOUND(SrcParamData%TwrFASF,3) + i3_u = UBOUND(SrcParamData%TwrFASF,3) + IF (.NOT. ALLOCATED(DstParamData%TwrFASF)) THEN + ALLOCATE(DstParamData%TwrFASF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HNodes.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TwrFASF.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%HNodes,1), UBOUND(OutData%HNodes,1) - OutData%HNodes(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HNodesNorm not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%HNodesNorm)) DEALLOCATE(OutData%HNodesNorm) - ALLOCATE(OutData%HNodesNorm(i1_l:i1_u),STAT=ErrStat2) + DstParamData%TwrFASF = SrcParamData%TwrFASF +ENDIF + DstParamData%TwrFlexL = SrcParamData%TwrFlexL +IF (ALLOCATED(SrcParamData%TwrSSSF)) THEN + i1_l = LBOUND(SrcParamData%TwrSSSF,1) + i1_u = UBOUND(SrcParamData%TwrSSSF,1) + i2_l = LBOUND(SrcParamData%TwrSSSF,2) + i2_u = UBOUND(SrcParamData%TwrSSSF,2) + i3_l = LBOUND(SrcParamData%TwrSSSF,3) + i3_u = UBOUND(SrcParamData%TwrSSSF,3) + IF (.NOT. ALLOCATED(DstParamData%TwrSSSF)) THEN + ALLOCATE(DstParamData%TwrSSSF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HNodesNorm.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TwrSSSF.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%HNodesNorm,1), UBOUND(OutData%HNodesNorm,1) - OutData%HNodesNorm(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO END IF - i1_l = LBOUND(OutData%KTFA,1) - i1_u = UBOUND(OutData%KTFA,1) - i2_l = LBOUND(OutData%KTFA,2) - i2_u = UBOUND(OutData%KTFA,2) - DO i2 = LBOUND(OutData%KTFA,2), UBOUND(OutData%KTFA,2) - DO i1 = LBOUND(OutData%KTFA,1), UBOUND(OutData%KTFA,1) - OutData%KTFA(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%KTSS,1) - i1_u = UBOUND(OutData%KTSS,1) - i2_l = LBOUND(OutData%KTSS,2) - i2_u = UBOUND(OutData%KTSS,2) - DO i2 = LBOUND(OutData%KTSS,2), UBOUND(OutData%KTSS,2) - DO i1 = LBOUND(OutData%KTSS,1), UBOUND(OutData%KTSS,1) - OutData%KTSS(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MassT not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MassT)) DEALLOCATE(OutData%MassT) - ALLOCATE(OutData%MassT(i1_l:i1_u),STAT=ErrStat2) + DstParamData%TwrSSSF = SrcParamData%TwrSSSF +ENDIF + DstParamData%TTopNode = SrcParamData%TTopNode + DstParamData%TwrNodes = SrcParamData%TwrNodes + DstParamData%MHK = SrcParamData%MHK +IF (ALLOCATED(SrcParamData%StiffTFA)) THEN + i1_l = LBOUND(SrcParamData%StiffTFA,1) + i1_u = UBOUND(SrcParamData%StiffTFA,1) + IF (.NOT. ALLOCATED(DstParamData%StiffTFA)) THEN + ALLOCATE(DstParamData%StiffTFA(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MassT.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StiffTFA.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%MassT,1), UBOUND(OutData%MassT,1) - OutData%MassT(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StiffTSS not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%StiffTSS)) DEALLOCATE(OutData%StiffTSS) - ALLOCATE(OutData%StiffTSS(i1_l:i1_u),STAT=ErrStat2) + DstParamData%StiffTFA = SrcParamData%StiffTFA +ENDIF + DstParamData%AtfaIner = SrcParamData%AtfaIner +IF (ALLOCATED(SrcParamData%BldCG)) THEN + i1_l = LBOUND(SrcParamData%BldCG,1) + i1_u = UBOUND(SrcParamData%BldCG,1) + IF (.NOT. ALLOCATED(DstParamData%BldCG)) THEN + ALLOCATE(DstParamData%BldCG(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffTSS.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldCG.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%StiffTSS,1), UBOUND(OutData%StiffTSS,1) - OutData%StiffTSS(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrFASF not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TwrFASF)) DEALLOCATE(OutData%TwrFASF) - ALLOCATE(OutData%TwrFASF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + DstParamData%BldCG = SrcParamData%BldCG +ENDIF +IF (ALLOCATED(SrcParamData%BldMass)) THEN + i1_l = LBOUND(SrcParamData%BldMass,1) + i1_u = UBOUND(SrcParamData%BldMass,1) + IF (.NOT. ALLOCATED(DstParamData%BldMass)) THEN + ALLOCATE(DstParamData%BldMass(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrFASF.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldMass.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i3 = LBOUND(OutData%TwrFASF,3), UBOUND(OutData%TwrFASF,3) - DO i2 = LBOUND(OutData%TwrFASF,2), UBOUND(OutData%TwrFASF,2) - DO i1 = LBOUND(OutData%TwrFASF,1), UBOUND(OutData%TwrFASF,1) - OutData%TwrFASF(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO END IF - OutData%TwrFlexL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrSSSF not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TwrSSSF)) DEALLOCATE(OutData%TwrSSSF) - ALLOCATE(OutData%TwrSSSF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + DstParamData%BldMass = SrcParamData%BldMass +ENDIF + DstParamData%BoomMass = SrcParamData%BoomMass +IF (ALLOCATED(SrcParamData%FirstMom)) THEN + i1_l = LBOUND(SrcParamData%FirstMom,1) + i1_u = UBOUND(SrcParamData%FirstMom,1) + IF (.NOT. ALLOCATED(DstParamData%FirstMom)) THEN + ALLOCATE(DstParamData%FirstMom(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrSSSF.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FirstMom.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i3 = LBOUND(OutData%TwrSSSF,3), UBOUND(OutData%TwrSSSF,3) - DO i2 = LBOUND(OutData%TwrSSSF,2), UBOUND(OutData%TwrSSSF,2) - DO i1 = LBOUND(OutData%TwrSSSF,1), UBOUND(OutData%TwrSSSF,1) - OutData%TwrSSSF(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO END IF - OutData%TTopNode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TwrNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MHK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StiffTFA not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%StiffTFA)) DEALLOCATE(OutData%StiffTFA) - ALLOCATE(OutData%StiffTFA(i1_l:i1_u),STAT=ErrStat2) + DstParamData%FirstMom = SrcParamData%FirstMom +ENDIF + DstParamData%GenIner = SrcParamData%GenIner + DstParamData%Hubg1Iner = SrcParamData%Hubg1Iner + DstParamData%Hubg2Iner = SrcParamData%Hubg2Iner + DstParamData%HubMass = SrcParamData%HubMass + DstParamData%Nacd2Iner = SrcParamData%Nacd2Iner + DstParamData%NacMass = SrcParamData%NacMass + DstParamData%PtfmMass = SrcParamData%PtfmMass + DstParamData%PtfmPIner = SrcParamData%PtfmPIner + DstParamData%PtfmRIner = SrcParamData%PtfmRIner + DstParamData%PtfmYIner = SrcParamData%PtfmYIner + DstParamData%RFrlMass = SrcParamData%RFrlMass + DstParamData%RotIner = SrcParamData%RotIner + DstParamData%RotMass = SrcParamData%RotMass + DstParamData%RrfaIner = SrcParamData%RrfaIner +IF (ALLOCATED(SrcParamData%SecondMom)) THEN + i1_l = LBOUND(SrcParamData%SecondMom,1) + i1_u = UBOUND(SrcParamData%SecondMom,1) + IF (.NOT. ALLOCATED(DstParamData%SecondMom)) THEN + ALLOCATE(DstParamData%SecondMom(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffTFA.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%SecondMom.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%StiffTFA,1), UBOUND(OutData%StiffTFA,1) - OutData%StiffTFA(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO END IF - OutData%AtfaIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldCG not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BldCG)) DEALLOCATE(OutData%BldCG) - ALLOCATE(OutData%BldCG(i1_l:i1_u),STAT=ErrStat2) + DstParamData%SecondMom = SrcParamData%SecondMom +ENDIF + DstParamData%TFinMass = SrcParamData%TFinMass + DstParamData%TFrlIner = SrcParamData%TFrlIner +IF (ALLOCATED(SrcParamData%TipMass)) THEN + i1_l = LBOUND(SrcParamData%TipMass,1) + i1_u = UBOUND(SrcParamData%TipMass,1) + IF (.NOT. ALLOCATED(DstParamData%TipMass)) THEN + ALLOCATE(DstParamData%TipMass(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldCG.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TipMass.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%BldCG,1), UBOUND(OutData%BldCG,1) - OutData%BldCG(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldMass not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BldMass)) DEALLOCATE(OutData%BldMass) - ALLOCATE(OutData%BldMass(i1_l:i1_u),STAT=ErrStat2) + DstParamData%TipMass = SrcParamData%TipMass +ENDIF + DstParamData%TurbMass = SrcParamData%TurbMass + DstParamData%TwrMass = SrcParamData%TwrMass + DstParamData%TwrTpMass = SrcParamData%TwrTpMass + DstParamData%YawBrMass = SrcParamData%YawBrMass + DstParamData%Gravity = SrcParamData%Gravity +IF (ALLOCATED(SrcParamData%PitchAxis)) THEN + i1_l = LBOUND(SrcParamData%PitchAxis,1) + i1_u = UBOUND(SrcParamData%PitchAxis,1) + i2_l = LBOUND(SrcParamData%PitchAxis,2) + i2_u = UBOUND(SrcParamData%PitchAxis,2) + IF (.NOT. ALLOCATED(DstParamData%PitchAxis)) THEN + ALLOCATE(DstParamData%PitchAxis(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldMass.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PitchAxis.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%BldMass,1), UBOUND(OutData%BldMass,1) - OutData%BldMass(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO END IF - OutData%BoomMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FirstMom not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FirstMom)) DEALLOCATE(OutData%FirstMom) - ALLOCATE(OutData%FirstMom(i1_l:i1_u),STAT=ErrStat2) + DstParamData%PitchAxis = SrcParamData%PitchAxis +ENDIF +IF (ALLOCATED(SrcParamData%AeroTwst)) THEN + i1_l = LBOUND(SrcParamData%AeroTwst,1) + i1_u = UBOUND(SrcParamData%AeroTwst,1) + IF (.NOT. ALLOCATED(DstParamData%AeroTwst)) THEN + ALLOCATE(DstParamData%AeroTwst(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FirstMom.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AeroTwst.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%FirstMom,1), UBOUND(OutData%FirstMom,1) - OutData%FirstMom(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO END IF - OutData%GenIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Hubg1Iner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Hubg2Iner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HubMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Nacd2Iner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NacMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmPIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmRIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmYIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RotIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RotMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RrfaIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SecondMom not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SecondMom)) DEALLOCATE(OutData%SecondMom) - ALLOCATE(OutData%SecondMom(i1_l:i1_u),STAT=ErrStat2) + DstParamData%AeroTwst = SrcParamData%AeroTwst +ENDIF +IF (ALLOCATED(SrcParamData%AxRedBld)) THEN + i1_l = LBOUND(SrcParamData%AxRedBld,1) + i1_u = UBOUND(SrcParamData%AxRedBld,1) + i2_l = LBOUND(SrcParamData%AxRedBld,2) + i2_u = UBOUND(SrcParamData%AxRedBld,2) + i3_l = LBOUND(SrcParamData%AxRedBld,3) + i3_u = UBOUND(SrcParamData%AxRedBld,3) + i4_l = LBOUND(SrcParamData%AxRedBld,4) + i4_u = UBOUND(SrcParamData%AxRedBld,4) + IF (.NOT. ALLOCATED(DstParamData%AxRedBld)) THEN + ALLOCATE(DstParamData%AxRedBld(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SecondMom.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AxRedBld.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%SecondMom,1), UBOUND(OutData%SecondMom,1) - OutData%SecondMom(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO END IF - OutData%TFinMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlIner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TipMass not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TipMass)) DEALLOCATE(OutData%TipMass) - ALLOCATE(OutData%TipMass(i1_l:i1_u),STAT=ErrStat2) + DstParamData%AxRedBld = SrcParamData%AxRedBld +ENDIF +IF (ALLOCATED(SrcParamData%BldEDamp)) THEN + i1_l = LBOUND(SrcParamData%BldEDamp,1) + i1_u = UBOUND(SrcParamData%BldEDamp,1) + i2_l = LBOUND(SrcParamData%BldEDamp,2) + i2_u = UBOUND(SrcParamData%BldEDamp,2) + IF (.NOT. ALLOCATED(DstParamData%BldEDamp)) THEN + ALLOCATE(DstParamData%BldEDamp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TipMass.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldEDamp.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%TipMass,1), UBOUND(OutData%TipMass,1) - OutData%TipMass(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO END IF - OutData%TurbMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TwrMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TwrTpMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrMass = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PitchAxis not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PitchAxis)) DEALLOCATE(OutData%PitchAxis) - ALLOCATE(OutData%PitchAxis(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DstParamData%BldEDamp = SrcParamData%BldEDamp +ENDIF +IF (ALLOCATED(SrcParamData%BldFDamp)) THEN + i1_l = LBOUND(SrcParamData%BldFDamp,1) + i1_u = UBOUND(SrcParamData%BldFDamp,1) + i2_l = LBOUND(SrcParamData%BldFDamp,2) + i2_u = UBOUND(SrcParamData%BldFDamp,2) + IF (.NOT. ALLOCATED(DstParamData%BldFDamp)) THEN + ALLOCATE(DstParamData%BldFDamp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PitchAxis.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldFDamp.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i2 = LBOUND(OutData%PitchAxis,2), UBOUND(OutData%PitchAxis,2) - DO i1 = LBOUND(OutData%PitchAxis,1), UBOUND(OutData%PitchAxis,1) - OutData%PitchAxis(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AeroTwst not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AeroTwst)) DEALLOCATE(OutData%AeroTwst) - ALLOCATE(OutData%AeroTwst(i1_l:i1_u),STAT=ErrStat2) + DstParamData%BldFDamp = SrcParamData%BldFDamp +ENDIF + DstParamData%BldFlexL = SrcParamData%BldFlexL +IF (ALLOCATED(SrcParamData%CAeroTwst)) THEN + i1_l = LBOUND(SrcParamData%CAeroTwst,1) + i1_u = UBOUND(SrcParamData%CAeroTwst,1) + IF (.NOT. ALLOCATED(DstParamData%CAeroTwst)) THEN + ALLOCATE(DstParamData%CAeroTwst(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AeroTwst.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CAeroTwst.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%AeroTwst,1), UBOUND(OutData%AeroTwst,1) - OutData%AeroTwst(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AxRedBld not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AxRedBld)) DEALLOCATE(OutData%AxRedBld) - ALLOCATE(OutData%AxRedBld(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + DstParamData%CAeroTwst = SrcParamData%CAeroTwst +ENDIF +IF (ALLOCATED(SrcParamData%CBE)) THEN + i1_l = LBOUND(SrcParamData%CBE,1) + i1_u = UBOUND(SrcParamData%CBE,1) + i2_l = LBOUND(SrcParamData%CBE,2) + i2_u = UBOUND(SrcParamData%CBE,2) + i3_l = LBOUND(SrcParamData%CBE,3) + i3_u = UBOUND(SrcParamData%CBE,3) + IF (.NOT. ALLOCATED(DstParamData%CBE)) THEN + ALLOCATE(DstParamData%CBE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxRedBld.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CBE.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i4 = LBOUND(OutData%AxRedBld,4), UBOUND(OutData%AxRedBld,4) - DO i3 = LBOUND(OutData%AxRedBld,3), UBOUND(OutData%AxRedBld,3) - DO i2 = LBOUND(OutData%AxRedBld,2), UBOUND(OutData%AxRedBld,2) - DO i1 = LBOUND(OutData%AxRedBld,1), UBOUND(OutData%AxRedBld,1) - OutData%AxRedBld(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldEDamp not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BldEDamp)) DEALLOCATE(OutData%BldEDamp) - ALLOCATE(OutData%BldEDamp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DstParamData%CBE = SrcParamData%CBE +ENDIF +IF (ALLOCATED(SrcParamData%CBF)) THEN + i1_l = LBOUND(SrcParamData%CBF,1) + i1_u = UBOUND(SrcParamData%CBF,1) + i2_l = LBOUND(SrcParamData%CBF,2) + i2_u = UBOUND(SrcParamData%CBF,2) + i3_l = LBOUND(SrcParamData%CBF,3) + i3_u = UBOUND(SrcParamData%CBF,3) + IF (.NOT. ALLOCATED(DstParamData%CBF)) THEN + ALLOCATE(DstParamData%CBF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldEDamp.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CBF.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i2 = LBOUND(OutData%BldEDamp,2), UBOUND(OutData%BldEDamp,2) - DO i1 = LBOUND(OutData%BldEDamp,1), UBOUND(OutData%BldEDamp,1) - OutData%BldEDamp(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldFDamp not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BldFDamp)) DEALLOCATE(OutData%BldFDamp) - ALLOCATE(OutData%BldFDamp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DstParamData%CBF = SrcParamData%CBF +ENDIF +IF (ALLOCATED(SrcParamData%Chord)) THEN + i1_l = LBOUND(SrcParamData%Chord,1) + i1_u = UBOUND(SrcParamData%Chord,1) + IF (.NOT. ALLOCATED(DstParamData%Chord)) THEN + ALLOCATE(DstParamData%Chord(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldFDamp.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Chord.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i2 = LBOUND(OutData%BldFDamp,2), UBOUND(OutData%BldFDamp,2) - DO i1 = LBOUND(OutData%BldFDamp,1), UBOUND(OutData%BldFDamp,1) - OutData%BldFDamp(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO END IF - OutData%BldFlexL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CAeroTwst not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CAeroTwst)) DEALLOCATE(OutData%CAeroTwst) - ALLOCATE(OutData%CAeroTwst(i1_l:i1_u),STAT=ErrStat2) + DstParamData%Chord = SrcParamData%Chord +ENDIF +IF (ALLOCATED(SrcParamData%CThetaS)) THEN + i1_l = LBOUND(SrcParamData%CThetaS,1) + i1_u = UBOUND(SrcParamData%CThetaS,1) + i2_l = LBOUND(SrcParamData%CThetaS,2) + i2_u = UBOUND(SrcParamData%CThetaS,2) + IF (.NOT. ALLOCATED(DstParamData%CThetaS)) THEN + ALLOCATE(DstParamData%CThetaS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CAeroTwst.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CThetaS.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%CAeroTwst,1), UBOUND(OutData%CAeroTwst,1) - OutData%CAeroTwst(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CBE not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CBE)) DEALLOCATE(OutData%CBE) - ALLOCATE(OutData%CBE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + DstParamData%CThetaS = SrcParamData%CThetaS +ENDIF +IF (ALLOCATED(SrcParamData%DRNodes)) THEN + i1_l = LBOUND(SrcParamData%DRNodes,1) + i1_u = UBOUND(SrcParamData%DRNodes,1) + IF (.NOT. ALLOCATED(DstParamData%DRNodes)) THEN + ALLOCATE(DstParamData%DRNodes(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CBE.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DRNodes.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i3 = LBOUND(OutData%CBE,3), UBOUND(OutData%CBE,3) - DO i2 = LBOUND(OutData%CBE,2), UBOUND(OutData%CBE,2) - DO i1 = LBOUND(OutData%CBE,1), UBOUND(OutData%CBE,1) - OutData%CBE(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CBF not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CBF)) DEALLOCATE(OutData%CBF) - ALLOCATE(OutData%CBF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + DstParamData%DRNodes = SrcParamData%DRNodes +ENDIF +IF (ALLOCATED(SrcParamData%FStTunr)) THEN + i1_l = LBOUND(SrcParamData%FStTunr,1) + i1_u = UBOUND(SrcParamData%FStTunr,1) + i2_l = LBOUND(SrcParamData%FStTunr,2) + i2_u = UBOUND(SrcParamData%FStTunr,2) + IF (.NOT. ALLOCATED(DstParamData%FStTunr)) THEN + ALLOCATE(DstParamData%FStTunr(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CBF.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FStTunr.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i3 = LBOUND(OutData%CBF,3), UBOUND(OutData%CBF,3) - DO i2 = LBOUND(OutData%CBF,2), UBOUND(OutData%CBF,2) - DO i1 = LBOUND(OutData%CBF,1), UBOUND(OutData%CBF,1) - OutData%CBF(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Chord not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Chord)) DEALLOCATE(OutData%Chord) - ALLOCATE(OutData%Chord(i1_l:i1_u),STAT=ErrStat2) + DstParamData%FStTunr = SrcParamData%FStTunr +ENDIF +IF (ALLOCATED(SrcParamData%KBE)) THEN + i1_l = LBOUND(SrcParamData%KBE,1) + i1_u = UBOUND(SrcParamData%KBE,1) + i2_l = LBOUND(SrcParamData%KBE,2) + i2_u = UBOUND(SrcParamData%KBE,2) + i3_l = LBOUND(SrcParamData%KBE,3) + i3_u = UBOUND(SrcParamData%KBE,3) + IF (.NOT. ALLOCATED(DstParamData%KBE)) THEN + ALLOCATE(DstParamData%KBE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Chord.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KBE.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%Chord,1), UBOUND(OutData%Chord,1) - OutData%Chord(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CThetaS not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CThetaS)) DEALLOCATE(OutData%CThetaS) - ALLOCATE(OutData%CThetaS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DstParamData%KBE = SrcParamData%KBE +ENDIF +IF (ALLOCATED(SrcParamData%KBF)) THEN + i1_l = LBOUND(SrcParamData%KBF,1) + i1_u = UBOUND(SrcParamData%KBF,1) + i2_l = LBOUND(SrcParamData%KBF,2) + i2_u = UBOUND(SrcParamData%KBF,2) + i3_l = LBOUND(SrcParamData%KBF,3) + i3_u = UBOUND(SrcParamData%KBF,3) + IF (.NOT. ALLOCATED(DstParamData%KBF)) THEN + ALLOCATE(DstParamData%KBF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CThetaS.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KBF.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i2 = LBOUND(OutData%CThetaS,2), UBOUND(OutData%CThetaS,2) - DO i1 = LBOUND(OutData%CThetaS,1), UBOUND(OutData%CThetaS,1) - OutData%CThetaS(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DRNodes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DRNodes)) DEALLOCATE(OutData%DRNodes) - ALLOCATE(OutData%DRNodes(i1_l:i1_u),STAT=ErrStat2) + DstParamData%KBF = SrcParamData%KBF +ENDIF +IF (ALLOCATED(SrcParamData%MassB)) THEN + i1_l = LBOUND(SrcParamData%MassB,1) + i1_u = UBOUND(SrcParamData%MassB,1) + i2_l = LBOUND(SrcParamData%MassB,2) + i2_u = UBOUND(SrcParamData%MassB,2) + IF (.NOT. ALLOCATED(DstParamData%MassB)) THEN + ALLOCATE(DstParamData%MassB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DRNodes.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MassB.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%DRNodes,1), UBOUND(OutData%DRNodes,1) - OutData%DRNodes(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FStTunr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FStTunr)) DEALLOCATE(OutData%FStTunr) - ALLOCATE(OutData%FStTunr(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DstParamData%MassB = SrcParamData%MassB +ENDIF +IF (ALLOCATED(SrcParamData%RNodes)) THEN + i1_l = LBOUND(SrcParamData%RNodes,1) + i1_u = UBOUND(SrcParamData%RNodes,1) + IF (.NOT. ALLOCATED(DstParamData%RNodes)) THEN + ALLOCATE(DstParamData%RNodes(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FStTunr.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%RNodes.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i2 = LBOUND(OutData%FStTunr,2), UBOUND(OutData%FStTunr,2) - DO i1 = LBOUND(OutData%FStTunr,1), UBOUND(OutData%FStTunr,1) - OutData%FStTunr(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! KBE not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%KBE)) DEALLOCATE(OutData%KBE) - ALLOCATE(OutData%KBE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + DstParamData%RNodes = SrcParamData%RNodes +ENDIF +IF (ALLOCATED(SrcParamData%RNodesNorm)) THEN + i1_l = LBOUND(SrcParamData%RNodesNorm,1) + i1_u = UBOUND(SrcParamData%RNodesNorm,1) + IF (.NOT. ALLOCATED(DstParamData%RNodesNorm)) THEN + ALLOCATE(DstParamData%RNodesNorm(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%KBE.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%RNodesNorm.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i3 = LBOUND(OutData%KBE,3), UBOUND(OutData%KBE,3) - DO i2 = LBOUND(OutData%KBE,2), UBOUND(OutData%KBE,2) - DO i1 = LBOUND(OutData%KBE,1), UBOUND(OutData%KBE,1) - OutData%KBE(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! KBF not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%KBF)) DEALLOCATE(OutData%KBF) - ALLOCATE(OutData%KBF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + DstParamData%RNodesNorm = SrcParamData%RNodesNorm +ENDIF +IF (ALLOCATED(SrcParamData%rSAerCenn1)) THEN + i1_l = LBOUND(SrcParamData%rSAerCenn1,1) + i1_u = UBOUND(SrcParamData%rSAerCenn1,1) + i2_l = LBOUND(SrcParamData%rSAerCenn1,2) + i2_u = UBOUND(SrcParamData%rSAerCenn1,2) + IF (.NOT. ALLOCATED(DstParamData%rSAerCenn1)) THEN + ALLOCATE(DstParamData%rSAerCenn1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%KBF.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rSAerCenn1.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i3 = LBOUND(OutData%KBF,3), UBOUND(OutData%KBF,3) - DO i2 = LBOUND(OutData%KBF,2), UBOUND(OutData%KBF,2) - DO i1 = LBOUND(OutData%KBF,1), UBOUND(OutData%KBF,1) - OutData%KBF(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MassB not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MassB)) DEALLOCATE(OutData%MassB) - ALLOCATE(OutData%MassB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DstParamData%rSAerCenn1 = SrcParamData%rSAerCenn1 +ENDIF +IF (ALLOCATED(SrcParamData%rSAerCenn2)) THEN + i1_l = LBOUND(SrcParamData%rSAerCenn2,1) + i1_u = UBOUND(SrcParamData%rSAerCenn2,1) + i2_l = LBOUND(SrcParamData%rSAerCenn2,2) + i2_u = UBOUND(SrcParamData%rSAerCenn2,2) + IF (.NOT. ALLOCATED(DstParamData%rSAerCenn2)) THEN + ALLOCATE(DstParamData%rSAerCenn2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MassB.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rSAerCenn2.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i2 = LBOUND(OutData%MassB,2), UBOUND(OutData%MassB,2) - DO i1 = LBOUND(OutData%MassB,1), UBOUND(OutData%MassB,1) - OutData%MassB(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RNodes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RNodes)) DEALLOCATE(OutData%RNodes) - ALLOCATE(OutData%RNodes(i1_l:i1_u),STAT=ErrStat2) + DstParamData%rSAerCenn2 = SrcParamData%rSAerCenn2 +ENDIF +IF (ALLOCATED(SrcParamData%SAeroTwst)) THEN + i1_l = LBOUND(SrcParamData%SAeroTwst,1) + i1_u = UBOUND(SrcParamData%SAeroTwst,1) + IF (.NOT. ALLOCATED(DstParamData%SAeroTwst)) THEN + ALLOCATE(DstParamData%SAeroTwst(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RNodes.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%SAeroTwst.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%RNodes,1), UBOUND(OutData%RNodes,1) - OutData%RNodes(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RNodesNorm not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RNodesNorm)) DEALLOCATE(OutData%RNodesNorm) - ALLOCATE(OutData%RNodesNorm(i1_l:i1_u),STAT=ErrStat2) + DstParamData%SAeroTwst = SrcParamData%SAeroTwst +ENDIF +IF (ALLOCATED(SrcParamData%StiffBE)) THEN + i1_l = LBOUND(SrcParamData%StiffBE,1) + i1_u = UBOUND(SrcParamData%StiffBE,1) + i2_l = LBOUND(SrcParamData%StiffBE,2) + i2_u = UBOUND(SrcParamData%StiffBE,2) + IF (.NOT. ALLOCATED(DstParamData%StiffBE)) THEN + ALLOCATE(DstParamData%StiffBE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RNodesNorm.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StiffBE.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%RNodesNorm,1), UBOUND(OutData%RNodesNorm,1) - OutData%RNodesNorm(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rSAerCenn1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rSAerCenn1)) DEALLOCATE(OutData%rSAerCenn1) - ALLOCATE(OutData%rSAerCenn1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DstParamData%StiffBE = SrcParamData%StiffBE +ENDIF +IF (ALLOCATED(SrcParamData%StiffBF)) THEN + i1_l = LBOUND(SrcParamData%StiffBF,1) + i1_u = UBOUND(SrcParamData%StiffBF,1) + i2_l = LBOUND(SrcParamData%StiffBF,2) + i2_u = UBOUND(SrcParamData%StiffBF,2) + IF (.NOT. ALLOCATED(DstParamData%StiffBF)) THEN + ALLOCATE(DstParamData%StiffBF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rSAerCenn1.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StiffBF.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i2 = LBOUND(OutData%rSAerCenn1,2), UBOUND(OutData%rSAerCenn1,2) - DO i1 = LBOUND(OutData%rSAerCenn1,1), UBOUND(OutData%rSAerCenn1,1) - OutData%rSAerCenn1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rSAerCenn2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rSAerCenn2)) DEALLOCATE(OutData%rSAerCenn2) - ALLOCATE(OutData%rSAerCenn2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DstParamData%StiffBF = SrcParamData%StiffBF +ENDIF +IF (ALLOCATED(SrcParamData%SThetaS)) THEN + i1_l = LBOUND(SrcParamData%SThetaS,1) + i1_u = UBOUND(SrcParamData%SThetaS,1) + i2_l = LBOUND(SrcParamData%SThetaS,2) + i2_u = UBOUND(SrcParamData%SThetaS,2) + IF (.NOT. ALLOCATED(DstParamData%SThetaS)) THEN + ALLOCATE(DstParamData%SThetaS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rSAerCenn2.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%SThetaS.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i2 = LBOUND(OutData%rSAerCenn2,2), UBOUND(OutData%rSAerCenn2,2) - DO i1 = LBOUND(OutData%rSAerCenn2,1), UBOUND(OutData%rSAerCenn2,1) - OutData%rSAerCenn2(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SAeroTwst not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SAeroTwst)) DEALLOCATE(OutData%SAeroTwst) - ALLOCATE(OutData%SAeroTwst(i1_l:i1_u),STAT=ErrStat2) + DstParamData%SThetaS = SrcParamData%SThetaS +ENDIF +IF (ALLOCATED(SrcParamData%ThetaS)) THEN + i1_l = LBOUND(SrcParamData%ThetaS,1) + i1_u = UBOUND(SrcParamData%ThetaS,1) + i2_l = LBOUND(SrcParamData%ThetaS,2) + i2_u = UBOUND(SrcParamData%ThetaS,2) + IF (.NOT. ALLOCATED(DstParamData%ThetaS)) THEN + ALLOCATE(DstParamData%ThetaS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SAeroTwst.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ThetaS.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%SAeroTwst,1), UBOUND(OutData%SAeroTwst,1) - OutData%SAeroTwst(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StiffBE not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%StiffBE)) DEALLOCATE(OutData%StiffBE) - ALLOCATE(OutData%StiffBE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DstParamData%ThetaS = SrcParamData%ThetaS +ENDIF +IF (ALLOCATED(SrcParamData%TwistedSF)) THEN + i1_l = LBOUND(SrcParamData%TwistedSF,1) + i1_u = UBOUND(SrcParamData%TwistedSF,1) + i2_l = LBOUND(SrcParamData%TwistedSF,2) + i2_u = UBOUND(SrcParamData%TwistedSF,2) + i3_l = LBOUND(SrcParamData%TwistedSF,3) + i3_u = UBOUND(SrcParamData%TwistedSF,3) + i4_l = LBOUND(SrcParamData%TwistedSF,4) + i4_u = UBOUND(SrcParamData%TwistedSF,4) + i5_l = LBOUND(SrcParamData%TwistedSF,5) + i5_u = UBOUND(SrcParamData%TwistedSF,5) + IF (.NOT. ALLOCATED(DstParamData%TwistedSF)) THEN + ALLOCATE(DstParamData%TwistedSF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffBE.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TwistedSF.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i2 = LBOUND(OutData%StiffBE,2), UBOUND(OutData%StiffBE,2) - DO i1 = LBOUND(OutData%StiffBE,1), UBOUND(OutData%StiffBE,1) - OutData%StiffBE(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StiffBF not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%StiffBF)) DEALLOCATE(OutData%StiffBF) - ALLOCATE(OutData%StiffBF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DstParamData%TwistedSF = SrcParamData%TwistedSF +ENDIF +IF (ALLOCATED(SrcParamData%BldFl1Sh)) THEN + i1_l = LBOUND(SrcParamData%BldFl1Sh,1) + i1_u = UBOUND(SrcParamData%BldFl1Sh,1) + i2_l = LBOUND(SrcParamData%BldFl1Sh,2) + i2_u = UBOUND(SrcParamData%BldFl1Sh,2) + IF (.NOT. ALLOCATED(DstParamData%BldFl1Sh)) THEN + ALLOCATE(DstParamData%BldFl1Sh(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffBF.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldFl1Sh.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i2 = LBOUND(OutData%StiffBF,2), UBOUND(OutData%StiffBF,2) - DO i1 = LBOUND(OutData%StiffBF,1), UBOUND(OutData%StiffBF,1) - OutData%StiffBF(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SThetaS not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SThetaS)) DEALLOCATE(OutData%SThetaS) - ALLOCATE(OutData%SThetaS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DstParamData%BldFl1Sh = SrcParamData%BldFl1Sh +ENDIF +IF (ALLOCATED(SrcParamData%BldFl2Sh)) THEN + i1_l = LBOUND(SrcParamData%BldFl2Sh,1) + i1_u = UBOUND(SrcParamData%BldFl2Sh,1) + i2_l = LBOUND(SrcParamData%BldFl2Sh,2) + i2_u = UBOUND(SrcParamData%BldFl2Sh,2) + IF (.NOT. ALLOCATED(DstParamData%BldFl2Sh)) THEN + ALLOCATE(DstParamData%BldFl2Sh(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SThetaS.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldFl2Sh.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i2 = LBOUND(OutData%SThetaS,2), UBOUND(OutData%SThetaS,2) - DO i1 = LBOUND(OutData%SThetaS,1), UBOUND(OutData%SThetaS,1) - OutData%SThetaS(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ThetaS not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ThetaS)) DEALLOCATE(OutData%ThetaS) - ALLOCATE(OutData%ThetaS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DstParamData%BldFl2Sh = SrcParamData%BldFl2Sh +ENDIF +IF (ALLOCATED(SrcParamData%BldEdgSh)) THEN + i1_l = LBOUND(SrcParamData%BldEdgSh,1) + i1_u = UBOUND(SrcParamData%BldEdgSh,1) + i2_l = LBOUND(SrcParamData%BldEdgSh,2) + i2_u = UBOUND(SrcParamData%BldEdgSh,2) + IF (.NOT. ALLOCATED(DstParamData%BldEdgSh)) THEN + ALLOCATE(DstParamData%BldEdgSh(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ThetaS.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldEdgSh.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i2 = LBOUND(OutData%ThetaS,2), UBOUND(OutData%ThetaS,2) - DO i1 = LBOUND(OutData%ThetaS,1), UBOUND(OutData%ThetaS,1) - OutData%ThetaS(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwistedSF not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i5_l = IntKiBuf( Int_Xferred ) - i5_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TwistedSF)) DEALLOCATE(OutData%TwistedSF) - ALLOCATE(OutData%TwistedSF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) + DstParamData%BldEdgSh = SrcParamData%BldEdgSh +ENDIF +IF (ALLOCATED(SrcParamData%FreqBE)) THEN + i1_l = LBOUND(SrcParamData%FreqBE,1) + i1_u = UBOUND(SrcParamData%FreqBE,1) + i2_l = LBOUND(SrcParamData%FreqBE,2) + i2_u = UBOUND(SrcParamData%FreqBE,2) + i3_l = LBOUND(SrcParamData%FreqBE,3) + i3_u = UBOUND(SrcParamData%FreqBE,3) + IF (.NOT. ALLOCATED(DstParamData%FreqBE)) THEN + ALLOCATE(DstParamData%FreqBE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwistedSF.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FreqBE.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i5 = LBOUND(OutData%TwistedSF,5), UBOUND(OutData%TwistedSF,5) - DO i4 = LBOUND(OutData%TwistedSF,4), UBOUND(OutData%TwistedSF,4) - DO i3 = LBOUND(OutData%TwistedSF,3), UBOUND(OutData%TwistedSF,3) - DO i2 = LBOUND(OutData%TwistedSF,2), UBOUND(OutData%TwistedSF,2) - DO i1 = LBOUND(OutData%TwistedSF,1), UBOUND(OutData%TwistedSF,1) - OutData%TwistedSF(i1,i2,i3,i4,i5) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldFl1Sh not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BldFl1Sh)) DEALLOCATE(OutData%BldFl1Sh) - ALLOCATE(OutData%BldFl1Sh(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DstParamData%FreqBE = SrcParamData%FreqBE +ENDIF +IF (ALLOCATED(SrcParamData%FreqBF)) THEN + i1_l = LBOUND(SrcParamData%FreqBF,1) + i1_u = UBOUND(SrcParamData%FreqBF,1) + i2_l = LBOUND(SrcParamData%FreqBF,2) + i2_u = UBOUND(SrcParamData%FreqBF,2) + i3_l = LBOUND(SrcParamData%FreqBF,3) + i3_u = UBOUND(SrcParamData%FreqBF,3) + IF (.NOT. ALLOCATED(DstParamData%FreqBF)) THEN + ALLOCATE(DstParamData%FreqBF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldFl1Sh.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FreqBF.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i2 = LBOUND(OutData%BldFl1Sh,2), UBOUND(OutData%BldFl1Sh,2) - DO i1 = LBOUND(OutData%BldFl1Sh,1), UBOUND(OutData%BldFl1Sh,1) - OutData%BldFl1Sh(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldFl2Sh not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BldFl2Sh)) DEALLOCATE(OutData%BldFl2Sh) - ALLOCATE(OutData%BldFl2Sh(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DstParamData%FreqBF = SrcParamData%FreqBF +ENDIF + DstParamData%FreqTFA = SrcParamData%FreqTFA + DstParamData%FreqTSS = SrcParamData%FreqTSS + DstParamData%TeetCDmp = SrcParamData%TeetCDmp + DstParamData%TeetDmp = SrcParamData%TeetDmp + DstParamData%TeetDmpP = SrcParamData%TeetDmpP + DstParamData%TeetHSSp = SrcParamData%TeetHSSp + DstParamData%TeetHStP = SrcParamData%TeetHStP + DstParamData%TeetSSSp = SrcParamData%TeetSSSp + DstParamData%TeetSStP = SrcParamData%TeetSStP + DstParamData%TeetMod = SrcParamData%TeetMod + DstParamData%TFrlDmp = SrcParamData%TFrlDmp + DstParamData%TFrlDSDmp = SrcParamData%TFrlDSDmp + DstParamData%TFrlDSDP = SrcParamData%TFrlDSDP + DstParamData%TFrlDSSP = SrcParamData%TFrlDSSP + DstParamData%TFrlDSSpr = SrcParamData%TFrlDSSpr + DstParamData%TFrlSpr = SrcParamData%TFrlSpr + DstParamData%TFrlUSDmp = SrcParamData%TFrlUSDmp + DstParamData%TFrlUSDP = SrcParamData%TFrlUSDP + DstParamData%TFrlUSSP = SrcParamData%TFrlUSSP + DstParamData%TFrlUSSpr = SrcParamData%TFrlUSSpr + DstParamData%TFrlMod = SrcParamData%TFrlMod + DstParamData%RFrlDmp = SrcParamData%RFrlDmp + DstParamData%RFrlDSDmp = SrcParamData%RFrlDSDmp + DstParamData%RFrlDSDP = SrcParamData%RFrlDSDP + DstParamData%RFrlDSSP = SrcParamData%RFrlDSSP + DstParamData%RFrlDSSpr = SrcParamData%RFrlDSSpr + DstParamData%RFrlSpr = SrcParamData%RFrlSpr + DstParamData%RFrlUSDmp = SrcParamData%RFrlUSDmp + DstParamData%RFrlUSDP = SrcParamData%RFrlUSDP + DstParamData%RFrlUSSP = SrcParamData%RFrlUSSP + DstParamData%RFrlUSSpr = SrcParamData%RFrlUSSpr + DstParamData%RFrlMod = SrcParamData%RFrlMod + DstParamData%ShftGagL = SrcParamData%ShftGagL + DstParamData%BldGagNd = SrcParamData%BldGagNd + DstParamData%TwrGagNd = SrcParamData%TwrGagNd + DstParamData%TStart = SrcParamData%TStart + DstParamData%DTTorDmp = SrcParamData%DTTorDmp + DstParamData%DTTorSpr = SrcParamData%DTTorSpr + DstParamData%GBRatio = SrcParamData%GBRatio + DstParamData%GBoxEff = SrcParamData%GBoxEff + DstParamData%RotSpeed = SrcParamData%RotSpeed + DstParamData%RootName = SrcParamData%RootName +IF (ALLOCATED(SrcParamData%BElmntMass)) THEN + i1_l = LBOUND(SrcParamData%BElmntMass,1) + i1_u = UBOUND(SrcParamData%BElmntMass,1) + i2_l = LBOUND(SrcParamData%BElmntMass,2) + i2_u = UBOUND(SrcParamData%BElmntMass,2) + IF (.NOT. ALLOCATED(DstParamData%BElmntMass)) THEN + ALLOCATE(DstParamData%BElmntMass(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldFl2Sh.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BElmntMass.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i2 = LBOUND(OutData%BldFl2Sh,2), UBOUND(OutData%BldFl2Sh,2) - DO i1 = LBOUND(OutData%BldFl2Sh,1), UBOUND(OutData%BldFl2Sh,1) - OutData%BldFl2Sh(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldEdgSh not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BldEdgSh)) DEALLOCATE(OutData%BldEdgSh) - ALLOCATE(OutData%BldEdgSh(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DstParamData%BElmntMass = SrcParamData%BElmntMass +ENDIF +IF (ALLOCATED(SrcParamData%TElmntMass)) THEN + i1_l = LBOUND(SrcParamData%TElmntMass,1) + i1_u = UBOUND(SrcParamData%TElmntMass,1) + IF (.NOT. ALLOCATED(DstParamData%TElmntMass)) THEN + ALLOCATE(DstParamData%TElmntMass(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldEdgSh.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TElmntMass.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i2 = LBOUND(OutData%BldEdgSh,2), UBOUND(OutData%BldEdgSh,2) - DO i1 = LBOUND(OutData%BldEdgSh,1), UBOUND(OutData%BldEdgSh,1) - OutData%BldEdgSh(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FreqBE not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FreqBE)) DEALLOCATE(OutData%FreqBE) - ALLOCATE(OutData%FreqBE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + DstParamData%TElmntMass = SrcParamData%TElmntMass +ENDIF + DstParamData%method = SrcParamData%method + DstParamData%PtfmCMxt = SrcParamData%PtfmCMxt + DstParamData%PtfmCMyt = SrcParamData%PtfmCMyt + DstParamData%BD4Blades = SrcParamData%BD4Blades + DstParamData%UseAD14 = SrcParamData%UseAD14 + DstParamData%BldNd_NumOuts = SrcParamData%BldNd_NumOuts + DstParamData%BldNd_TotNumOuts = SrcParamData%BldNd_TotNumOuts +IF (ALLOCATED(SrcParamData%BldNd_OutParam)) THEN + i1_l = LBOUND(SrcParamData%BldNd_OutParam,1) + i1_u = UBOUND(SrcParamData%BldNd_OutParam,1) + IF (.NOT. ALLOCATED(DstParamData%BldNd_OutParam)) THEN + ALLOCATE(DstParamData%BldNd_OutParam(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FreqBE.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldNd_OutParam.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i3 = LBOUND(OutData%FreqBE,3), UBOUND(OutData%FreqBE,3) - DO i2 = LBOUND(OutData%FreqBE,2), UBOUND(OutData%FreqBE,2) - DO i1 = LBOUND(OutData%FreqBE,1), UBOUND(OutData%FreqBE,1) - OutData%FreqBE(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FreqBF not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FreqBF)) DEALLOCATE(OutData%FreqBF) - ALLOCATE(OutData%FreqBF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + DO i1 = LBOUND(SrcParamData%BldNd_OutParam,1), UBOUND(SrcParamData%BldNd_OutParam,1) + CALL NWTC_Library_Copyoutparmtype( SrcParamData%BldNd_OutParam(i1), DstParamData%BldNd_OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + DstParamData%BldNd_BladesOut = SrcParamData%BldNd_BladesOut +IF (ALLOCATED(SrcParamData%Jac_u_indx)) THEN + i1_l = LBOUND(SrcParamData%Jac_u_indx,1) + i1_u = UBOUND(SrcParamData%Jac_u_indx,1) + i2_l = LBOUND(SrcParamData%Jac_u_indx,2) + i2_u = UBOUND(SrcParamData%Jac_u_indx,2) + IF (.NOT. ALLOCATED(DstParamData%Jac_u_indx)) THEN + ALLOCATE(DstParamData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FreqBF.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i3 = LBOUND(OutData%FreqBF,3), UBOUND(OutData%FreqBF,3) - DO i2 = LBOUND(OutData%FreqBF,2), UBOUND(OutData%FreqBF,2) - DO i1 = LBOUND(OutData%FreqBF,1), UBOUND(OutData%FreqBF,1) - OutData%FreqBF(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO END IF - i1_l = LBOUND(OutData%FreqTFA,1) - i1_u = UBOUND(OutData%FreqTFA,1) - i2_l = LBOUND(OutData%FreqTFA,2) - i2_u = UBOUND(OutData%FreqTFA,2) - DO i2 = LBOUND(OutData%FreqTFA,2), UBOUND(OutData%FreqTFA,2) - DO i1 = LBOUND(OutData%FreqTFA,1), UBOUND(OutData%FreqTFA,1) - OutData%FreqTFA(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%FreqTSS,1) - i1_u = UBOUND(OutData%FreqTSS,1) - i2_l = LBOUND(OutData%FreqTSS,2) - i2_u = UBOUND(OutData%FreqTSS,2) - DO i2 = LBOUND(OutData%FreqTSS,2), UBOUND(OutData%FreqTSS,2) - DO i1 = LBOUND(OutData%FreqTSS,1), UBOUND(OutData%FreqTSS,1) - OutData%FreqTSS(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - OutData%TeetCDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TeetDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TeetDmpP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TeetHSSp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TeetHStP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TeetSSSp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TeetSStP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TeetMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TFrlDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSDP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSDP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%RFrlDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSDP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSDP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ShftGagL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%BldGagNd,1) - i1_u = UBOUND(OutData%BldGagNd,1) - DO i1 = LBOUND(OutData%BldGagNd,1), UBOUND(OutData%BldGagNd,1) - OutData%BldGagNd(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TwrGagNd,1) - i1_u = UBOUND(OutData%TwrGagNd,1) - DO i1 = LBOUND(OutData%TwrGagNd,1), UBOUND(OutData%TwrGagNd,1) - OutData%TwrGagNd(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%TStart = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%DTTorDmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DTTorSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GBRatio = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GBoxEff = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RotSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BElmntMass not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BElmntMass)) DEALLOCATE(OutData%BElmntMass) - ALLOCATE(OutData%BElmntMass(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx +ENDIF +IF (ALLOCATED(SrcParamData%du)) THEN + i1_l = LBOUND(SrcParamData%du,1) + i1_u = UBOUND(SrcParamData%du,1) + IF (.NOT. ALLOCATED(DstParamData%du)) THEN + ALLOCATE(DstParamData%du(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BElmntMass.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i2 = LBOUND(OutData%BElmntMass,2), UBOUND(OutData%BElmntMass,2) - DO i1 = LBOUND(OutData%BElmntMass,1), UBOUND(OutData%BElmntMass,1) - OutData%BElmntMass(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TElmntMass not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TElmntMass)) DEALLOCATE(OutData%TElmntMass) - ALLOCATE(OutData%TElmntMass(i1_l:i1_u),STAT=ErrStat2) + DstParamData%du = SrcParamData%du +ENDIF +IF (ALLOCATED(SrcParamData%dx)) THEN + i1_l = LBOUND(SrcParamData%dx,1) + i1_u = UBOUND(SrcParamData%dx,1) + IF (.NOT. ALLOCATED(DstParamData%dx)) THEN + ALLOCATE(DstParamData%dx(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TElmntMass.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dx.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%TElmntMass,1), UBOUND(OutData%TElmntMass,1) - OutData%TElmntMass(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO END IF - OutData%method = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmCMxt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmCMyt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%BD4Blades = TRANSFER(IntKiBuf(Int_Xferred), OutData%BD4Blades) - Int_Xferred = Int_Xferred + 1 - OutData%UseAD14 = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseAD14) - Int_Xferred = Int_Xferred + 1 - OutData%BldNd_NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%BldNd_TotNumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_OutParam not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BldNd_OutParam)) DEALLOCATE(OutData%BldNd_OutParam) - ALLOCATE(OutData%BldNd_OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BldNd_OutParam,1), UBOUND(OutData%BldNd_OutParam,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackOutParmType( Re_Buf, Db_Buf, Int_Buf, OutData%BldNd_OutParam(i1), ErrStat2, ErrMsg2 ) ! BldNd_OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + DstParamData%dx = SrcParamData%dx +ENDIF + DstParamData%Jac_ny = SrcParamData%Jac_ny + END SUBROUTINE ED_CopyParam + + SUBROUTINE ED_DestroyParam( ParamData, ErrStat, ErrMsg ) + TYPE(ED_ParameterType), INTENT(INOUT) :: ParamData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyParam' + + ErrStat = ErrID_None + ErrMsg = "" + +IF (ALLOCATED(ParamData%PH)) THEN + DEALLOCATE(ParamData%PH) +ENDIF +IF (ALLOCATED(ParamData%PM)) THEN + DEALLOCATE(ParamData%PM) +ENDIF +IF (ALLOCATED(ParamData%DOF_Flag)) THEN + DEALLOCATE(ParamData%DOF_Flag) +ENDIF +IF (ALLOCATED(ParamData%DOF_Desc)) THEN + DEALLOCATE(ParamData%DOF_Desc) +ENDIF + CALL ED_DestroyActiveDOFs( ParamData%DOFs, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(ParamData%OutParam)) THEN +DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) + CALL NWTC_Library_DestroyOutParmType( ParamData%OutParam(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(ParamData%OutParam) +ENDIF +IF (ALLOCATED(ParamData%CosPreC)) THEN + DEALLOCATE(ParamData%CosPreC) +ENDIF +IF (ALLOCATED(ParamData%SinPreC)) THEN + DEALLOCATE(ParamData%SinPreC) +ENDIF +IF (ALLOCATED(ParamData%AxRedTFA)) THEN + DEALLOCATE(ParamData%AxRedTFA) +ENDIF +IF (ALLOCATED(ParamData%AxRedTSS)) THEN + DEALLOCATE(ParamData%AxRedTSS) +ENDIF +IF (ALLOCATED(ParamData%DHNodes)) THEN + DEALLOCATE(ParamData%DHNodes) +ENDIF +IF (ALLOCATED(ParamData%HNodes)) THEN + DEALLOCATE(ParamData%HNodes) +ENDIF +IF (ALLOCATED(ParamData%HNodesNorm)) THEN + DEALLOCATE(ParamData%HNodesNorm) +ENDIF +IF (ALLOCATED(ParamData%MassT)) THEN + DEALLOCATE(ParamData%MassT) +ENDIF +IF (ALLOCATED(ParamData%StiffTSS)) THEN + DEALLOCATE(ParamData%StiffTSS) +ENDIF +IF (ALLOCATED(ParamData%TwrFASF)) THEN + DEALLOCATE(ParamData%TwrFASF) +ENDIF +IF (ALLOCATED(ParamData%TwrSSSF)) THEN + DEALLOCATE(ParamData%TwrSSSF) +ENDIF +IF (ALLOCATED(ParamData%StiffTFA)) THEN + DEALLOCATE(ParamData%StiffTFA) +ENDIF +IF (ALLOCATED(ParamData%BldCG)) THEN + DEALLOCATE(ParamData%BldCG) +ENDIF +IF (ALLOCATED(ParamData%BldMass)) THEN + DEALLOCATE(ParamData%BldMass) +ENDIF +IF (ALLOCATED(ParamData%FirstMom)) THEN + DEALLOCATE(ParamData%FirstMom) +ENDIF +IF (ALLOCATED(ParamData%SecondMom)) THEN + DEALLOCATE(ParamData%SecondMom) +ENDIF +IF (ALLOCATED(ParamData%TipMass)) THEN + DEALLOCATE(ParamData%TipMass) +ENDIF +IF (ALLOCATED(ParamData%PitchAxis)) THEN + DEALLOCATE(ParamData%PitchAxis) +ENDIF +IF (ALLOCATED(ParamData%AeroTwst)) THEN + DEALLOCATE(ParamData%AeroTwst) +ENDIF +IF (ALLOCATED(ParamData%AxRedBld)) THEN + DEALLOCATE(ParamData%AxRedBld) +ENDIF +IF (ALLOCATED(ParamData%BldEDamp)) THEN + DEALLOCATE(ParamData%BldEDamp) +ENDIF +IF (ALLOCATED(ParamData%BldFDamp)) THEN + DEALLOCATE(ParamData%BldFDamp) +ENDIF +IF (ALLOCATED(ParamData%CAeroTwst)) THEN + DEALLOCATE(ParamData%CAeroTwst) +ENDIF +IF (ALLOCATED(ParamData%CBE)) THEN + DEALLOCATE(ParamData%CBE) +ENDIF +IF (ALLOCATED(ParamData%CBF)) THEN + DEALLOCATE(ParamData%CBF) +ENDIF +IF (ALLOCATED(ParamData%Chord)) THEN + DEALLOCATE(ParamData%Chord) +ENDIF +IF (ALLOCATED(ParamData%CThetaS)) THEN + DEALLOCATE(ParamData%CThetaS) +ENDIF +IF (ALLOCATED(ParamData%DRNodes)) THEN + DEALLOCATE(ParamData%DRNodes) +ENDIF +IF (ALLOCATED(ParamData%FStTunr)) THEN + DEALLOCATE(ParamData%FStTunr) +ENDIF +IF (ALLOCATED(ParamData%KBE)) THEN + DEALLOCATE(ParamData%KBE) +ENDIF +IF (ALLOCATED(ParamData%KBF)) THEN + DEALLOCATE(ParamData%KBF) +ENDIF +IF (ALLOCATED(ParamData%MassB)) THEN + DEALLOCATE(ParamData%MassB) +ENDIF +IF (ALLOCATED(ParamData%RNodes)) THEN + DEALLOCATE(ParamData%RNodes) +ENDIF +IF (ALLOCATED(ParamData%RNodesNorm)) THEN + DEALLOCATE(ParamData%RNodesNorm) +ENDIF +IF (ALLOCATED(ParamData%rSAerCenn1)) THEN + DEALLOCATE(ParamData%rSAerCenn1) +ENDIF +IF (ALLOCATED(ParamData%rSAerCenn2)) THEN + DEALLOCATE(ParamData%rSAerCenn2) +ENDIF +IF (ALLOCATED(ParamData%SAeroTwst)) THEN + DEALLOCATE(ParamData%SAeroTwst) +ENDIF +IF (ALLOCATED(ParamData%StiffBE)) THEN + DEALLOCATE(ParamData%StiffBE) +ENDIF +IF (ALLOCATED(ParamData%StiffBF)) THEN + DEALLOCATE(ParamData%StiffBF) +ENDIF +IF (ALLOCATED(ParamData%SThetaS)) THEN + DEALLOCATE(ParamData%SThetaS) +ENDIF +IF (ALLOCATED(ParamData%ThetaS)) THEN + DEALLOCATE(ParamData%ThetaS) +ENDIF +IF (ALLOCATED(ParamData%TwistedSF)) THEN + DEALLOCATE(ParamData%TwistedSF) +ENDIF +IF (ALLOCATED(ParamData%BldFl1Sh)) THEN + DEALLOCATE(ParamData%BldFl1Sh) +ENDIF +IF (ALLOCATED(ParamData%BldFl2Sh)) THEN + DEALLOCATE(ParamData%BldFl2Sh) +ENDIF +IF (ALLOCATED(ParamData%BldEdgSh)) THEN + DEALLOCATE(ParamData%BldEdgSh) +ENDIF +IF (ALLOCATED(ParamData%FreqBE)) THEN + DEALLOCATE(ParamData%FreqBE) +ENDIF +IF (ALLOCATED(ParamData%FreqBF)) THEN + DEALLOCATE(ParamData%FreqBF) +ENDIF +IF (ALLOCATED(ParamData%BElmntMass)) THEN + DEALLOCATE(ParamData%BElmntMass) +ENDIF +IF (ALLOCATED(ParamData%TElmntMass)) THEN + DEALLOCATE(ParamData%TElmntMass) +ENDIF +IF (ALLOCATED(ParamData%BldNd_OutParam)) THEN +DO i1 = LBOUND(ParamData%BldNd_OutParam,1), UBOUND(ParamData%BldNd_OutParam,1) + CALL NWTC_Library_DestroyOutParmType( ParamData%BldNd_OutParam(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(ParamData%BldNd_OutParam) +ENDIF +IF (ALLOCATED(ParamData%Jac_u_indx)) THEN + DEALLOCATE(ParamData%Jac_u_indx) +ENDIF +IF (ALLOCATED(ParamData%du)) THEN + DEALLOCATE(ParamData%du) +ENDIF +IF (ALLOCATED(ParamData%dx)) THEN + DEALLOCATE(ParamData%dx) +ENDIF + END SUBROUTINE ED_DestroyParam - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - OutData%BldNd_BladesOut = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_u_indx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Jac_u_indx)) DEALLOCATE(OutData%Jac_u_indx) - ALLOCATE(OutData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_u_indx,2), UBOUND(OutData%Jac_u_indx,2) - DO i1 = LBOUND(OutData%Jac_u_indx,1), UBOUND(OutData%Jac_u_indx,1) - OutData%Jac_u_indx(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! du not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%du)) DEALLOCATE(OutData%du) - ALLOCATE(OutData%du(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%du,1), UBOUND(OutData%du,1) - OutData%du(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%dx)) DEALLOCATE(OutData%dx) - ALLOCATE(OutData%dx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dx,1), UBOUND(OutData%dx,1) - OutData%dx(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - OutData%Jac_ny = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE ED_UnPackParam +subroutine ED_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ED_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackParam' + integer(IntKi) :: i1, i2, i3, i4, i5 + integer(IntKi) :: LB(5), UB(5) + if (Buf%ErrStat >= AbortErrLev) return + ! DT + call RegPack(Buf, InData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! DT24 + call RegPack(Buf, InData%DT24) + if (RegCheckErr(Buf, RoutineName)) return + ! BldNodes + call RegPack(Buf, InData%BldNodes) + if (RegCheckErr(Buf, RoutineName)) return + ! TipNode + call RegPack(Buf, InData%TipNode) + if (RegCheckErr(Buf, RoutineName)) return + ! NDOF + call RegPack(Buf, InData%NDOF) + if (RegCheckErr(Buf, RoutineName)) return + ! TwoPiNB + call RegPack(Buf, InData%TwoPiNB) + if (RegCheckErr(Buf, RoutineName)) return + ! NAug + call RegPack(Buf, InData%NAug) + if (RegCheckErr(Buf, RoutineName)) return + ! NPH + call RegPack(Buf, InData%NPH) + if (RegCheckErr(Buf, RoutineName)) return + ! PH + call RegPack(Buf, allocated(InData%PH)) + if (allocated(InData%PH)) then + call RegPackBounds(Buf, 1, lbound(InData%PH), ubound(InData%PH)) + call RegPack(Buf, InData%PH) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NPM + call RegPack(Buf, InData%NPM) + if (RegCheckErr(Buf, RoutineName)) return + ! PM + call RegPack(Buf, allocated(InData%PM)) + if (allocated(InData%PM)) then + call RegPackBounds(Buf, 2, lbound(InData%PM), ubound(InData%PM)) + call RegPack(Buf, InData%PM) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DOF_Flag + call RegPack(Buf, allocated(InData%DOF_Flag)) + if (allocated(InData%DOF_Flag)) then + call RegPackBounds(Buf, 1, lbound(InData%DOF_Flag), ubound(InData%DOF_Flag)) + call RegPack(Buf, InData%DOF_Flag) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DOF_Desc + call RegPack(Buf, allocated(InData%DOF_Desc)) + if (allocated(InData%DOF_Desc)) then + call RegPackBounds(Buf, 1, lbound(InData%DOF_Desc), ubound(InData%DOF_Desc)) + call RegPack(Buf, InData%DOF_Desc) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DOFs + call ED_PackActiveDOFs(Buf, InData%DOFs) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegPack(Buf, InData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFmt + call RegPack(Buf, InData%OutFmt) + if (RegCheckErr(Buf, RoutineName)) return + ! NBlGages + call RegPack(Buf, InData%NBlGages) + if (RegCheckErr(Buf, RoutineName)) return + ! NTwGages + call RegPack(Buf, InData%NTwGages) + if (RegCheckErr(Buf, RoutineName)) return + ! OutParam + call RegPack(Buf, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Delim + call RegPack(Buf, InData%Delim) + if (RegCheckErr(Buf, RoutineName)) return + ! AvgNrmTpRd + call RegPack(Buf, InData%AvgNrmTpRd) + if (RegCheckErr(Buf, RoutineName)) return + ! AzimB1Up + call RegPack(Buf, InData%AzimB1Up) + if (RegCheckErr(Buf, RoutineName)) return + ! CosDel3 + call RegPack(Buf, InData%CosDel3) + if (RegCheckErr(Buf, RoutineName)) return + ! CosPreC + call RegPack(Buf, allocated(InData%CosPreC)) + if (allocated(InData%CosPreC)) then + call RegPackBounds(Buf, 1, lbound(InData%CosPreC), ubound(InData%CosPreC)) + call RegPack(Buf, InData%CosPreC) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CRFrlSkew + call RegPack(Buf, InData%CRFrlSkew) + if (RegCheckErr(Buf, RoutineName)) return + ! CRFrlSkw2 + call RegPack(Buf, InData%CRFrlSkw2) + if (RegCheckErr(Buf, RoutineName)) return + ! CRFrlTilt + call RegPack(Buf, InData%CRFrlTilt) + if (RegCheckErr(Buf, RoutineName)) return + ! CRFrlTlt2 + call RegPack(Buf, InData%CRFrlTlt2) + if (RegCheckErr(Buf, RoutineName)) return + ! CShftSkew + call RegPack(Buf, InData%CShftSkew) + if (RegCheckErr(Buf, RoutineName)) return + ! CShftTilt + call RegPack(Buf, InData%CShftTilt) + if (RegCheckErr(Buf, RoutineName)) return + ! CSRFrlSkw + call RegPack(Buf, InData%CSRFrlSkw) + if (RegCheckErr(Buf, RoutineName)) return + ! CSRFrlTlt + call RegPack(Buf, InData%CSRFrlTlt) + if (RegCheckErr(Buf, RoutineName)) return + ! CSTFrlSkw + call RegPack(Buf, InData%CSTFrlSkw) + if (RegCheckErr(Buf, RoutineName)) return + ! CSTFrlTlt + call RegPack(Buf, InData%CSTFrlTlt) + if (RegCheckErr(Buf, RoutineName)) return + ! CTFrlSkew + call RegPack(Buf, InData%CTFrlSkew) + if (RegCheckErr(Buf, RoutineName)) return + ! CTFrlSkw2 + call RegPack(Buf, InData%CTFrlSkw2) + if (RegCheckErr(Buf, RoutineName)) return + ! CTFrlTilt + call RegPack(Buf, InData%CTFrlTilt) + if (RegCheckErr(Buf, RoutineName)) return + ! CTFrlTlt2 + call RegPack(Buf, InData%CTFrlTlt2) + if (RegCheckErr(Buf, RoutineName)) return + ! HubHt + call RegPack(Buf, InData%HubHt) + if (RegCheckErr(Buf, RoutineName)) return + ! HubCM + call RegPack(Buf, InData%HubCM) + if (RegCheckErr(Buf, RoutineName)) return + ! HubRad + call RegPack(Buf, InData%HubRad) + if (RegCheckErr(Buf, RoutineName)) return + ! NacCMxn + call RegPack(Buf, InData%NacCMxn) + if (RegCheckErr(Buf, RoutineName)) return + ! NacCMyn + call RegPack(Buf, InData%NacCMyn) + if (RegCheckErr(Buf, RoutineName)) return + ! NacCMzn + call RegPack(Buf, InData%NacCMzn) + if (RegCheckErr(Buf, RoutineName)) return + ! OverHang + call RegPack(Buf, InData%OverHang) + if (RegCheckErr(Buf, RoutineName)) return + ! ProjArea + call RegPack(Buf, InData%ProjArea) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmRefzt + call RegPack(Buf, InData%PtfmRefzt) + if (RegCheckErr(Buf, RoutineName)) return + ! RefTwrHt + call RegPack(Buf, InData%RefTwrHt) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlPnt_n + call RegPack(Buf, InData%RFrlPnt_n) + if (RegCheckErr(Buf, RoutineName)) return + ! rVDxn + call RegPack(Buf, InData%rVDxn) + if (RegCheckErr(Buf, RoutineName)) return + ! rVDyn + call RegPack(Buf, InData%rVDyn) + if (RegCheckErr(Buf, RoutineName)) return + ! rVDzn + call RegPack(Buf, InData%rVDzn) + if (RegCheckErr(Buf, RoutineName)) return + ! rVIMUxn + call RegPack(Buf, InData%rVIMUxn) + if (RegCheckErr(Buf, RoutineName)) return + ! rVIMUyn + call RegPack(Buf, InData%rVIMUyn) + if (RegCheckErr(Buf, RoutineName)) return + ! rVIMUzn + call RegPack(Buf, InData%rVIMUzn) + if (RegCheckErr(Buf, RoutineName)) return + ! rVPxn + call RegPack(Buf, InData%rVPxn) + if (RegCheckErr(Buf, RoutineName)) return + ! rVPyn + call RegPack(Buf, InData%rVPyn) + if (RegCheckErr(Buf, RoutineName)) return + ! rVPzn + call RegPack(Buf, InData%rVPzn) + if (RegCheckErr(Buf, RoutineName)) return + ! rWIxn + call RegPack(Buf, InData%rWIxn) + if (RegCheckErr(Buf, RoutineName)) return + ! rWIyn + call RegPack(Buf, InData%rWIyn) + if (RegCheckErr(Buf, RoutineName)) return + ! rWIzn + call RegPack(Buf, InData%rWIzn) + if (RegCheckErr(Buf, RoutineName)) return + ! rWJxn + call RegPack(Buf, InData%rWJxn) + if (RegCheckErr(Buf, RoutineName)) return + ! rWJyn + call RegPack(Buf, InData%rWJyn) + if (RegCheckErr(Buf, RoutineName)) return + ! rWJzn + call RegPack(Buf, InData%rWJzn) + if (RegCheckErr(Buf, RoutineName)) return + ! rZT0zt + call RegPack(Buf, InData%rZT0zt) + if (RegCheckErr(Buf, RoutineName)) return + ! rZYzt + call RegPack(Buf, InData%rZYzt) + if (RegCheckErr(Buf, RoutineName)) return + ! SinDel3 + call RegPack(Buf, InData%SinDel3) + if (RegCheckErr(Buf, RoutineName)) return + ! SinPreC + call RegPack(Buf, allocated(InData%SinPreC)) + if (allocated(InData%SinPreC)) then + call RegPackBounds(Buf, 1, lbound(InData%SinPreC), ubound(InData%SinPreC)) + call RegPack(Buf, InData%SinPreC) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SRFrlSkew + call RegPack(Buf, InData%SRFrlSkew) + if (RegCheckErr(Buf, RoutineName)) return + ! SRFrlSkw2 + call RegPack(Buf, InData%SRFrlSkw2) + if (RegCheckErr(Buf, RoutineName)) return + ! SRFrlTilt + call RegPack(Buf, InData%SRFrlTilt) + if (RegCheckErr(Buf, RoutineName)) return + ! SRFrlTlt2 + call RegPack(Buf, InData%SRFrlTlt2) + if (RegCheckErr(Buf, RoutineName)) return + ! SShftSkew + call RegPack(Buf, InData%SShftSkew) + if (RegCheckErr(Buf, RoutineName)) return + ! SShftTilt + call RegPack(Buf, InData%SShftTilt) + if (RegCheckErr(Buf, RoutineName)) return + ! STFrlSkew + call RegPack(Buf, InData%STFrlSkew) + if (RegCheckErr(Buf, RoutineName)) return + ! STFrlSkw2 + call RegPack(Buf, InData%STFrlSkw2) + if (RegCheckErr(Buf, RoutineName)) return + ! STFrlTilt + call RegPack(Buf, InData%STFrlTilt) + if (RegCheckErr(Buf, RoutineName)) return + ! STFrlTlt2 + call RegPack(Buf, InData%STFrlTlt2) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlPnt_n + call RegPack(Buf, InData%TFrlPnt_n) + if (RegCheckErr(Buf, RoutineName)) return + ! TipRad + call RegPack(Buf, InData%TipRad) + if (RegCheckErr(Buf, RoutineName)) return + ! TowerHt + call RegPack(Buf, InData%TowerHt) + if (RegCheckErr(Buf, RoutineName)) return + ! TowerBsHt + call RegPack(Buf, InData%TowerBsHt) + if (RegCheckErr(Buf, RoutineName)) return + ! UndSling + call RegPack(Buf, InData%UndSling) + if (RegCheckErr(Buf, RoutineName)) return + ! NumBl + call RegPack(Buf, InData%NumBl) + if (RegCheckErr(Buf, RoutineName)) return + ! AxRedTFA + call RegPack(Buf, allocated(InData%AxRedTFA)) + if (allocated(InData%AxRedTFA)) then + call RegPackBounds(Buf, 3, lbound(InData%AxRedTFA), ubound(InData%AxRedTFA)) + call RegPack(Buf, InData%AxRedTFA) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AxRedTSS + call RegPack(Buf, allocated(InData%AxRedTSS)) + if (allocated(InData%AxRedTSS)) then + call RegPackBounds(Buf, 3, lbound(InData%AxRedTSS), ubound(InData%AxRedTSS)) + call RegPack(Buf, InData%AxRedTSS) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CTFA + call RegPack(Buf, InData%CTFA) + if (RegCheckErr(Buf, RoutineName)) return + ! CTSS + call RegPack(Buf, InData%CTSS) + if (RegCheckErr(Buf, RoutineName)) return + ! DHNodes + call RegPack(Buf, allocated(InData%DHNodes)) + if (allocated(InData%DHNodes)) then + call RegPackBounds(Buf, 1, lbound(InData%DHNodes), ubound(InData%DHNodes)) + call RegPack(Buf, InData%DHNodes) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! HNodes + call RegPack(Buf, allocated(InData%HNodes)) + if (allocated(InData%HNodes)) then + call RegPackBounds(Buf, 1, lbound(InData%HNodes), ubound(InData%HNodes)) + call RegPack(Buf, InData%HNodes) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! HNodesNorm + call RegPack(Buf, allocated(InData%HNodesNorm)) + if (allocated(InData%HNodesNorm)) then + call RegPackBounds(Buf, 1, lbound(InData%HNodesNorm), ubound(InData%HNodesNorm)) + call RegPack(Buf, InData%HNodesNorm) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! KTFA + call RegPack(Buf, InData%KTFA) + if (RegCheckErr(Buf, RoutineName)) return + ! KTSS + call RegPack(Buf, InData%KTSS) + if (RegCheckErr(Buf, RoutineName)) return + ! MassT + call RegPack(Buf, allocated(InData%MassT)) + if (allocated(InData%MassT)) then + call RegPackBounds(Buf, 1, lbound(InData%MassT), ubound(InData%MassT)) + call RegPack(Buf, InData%MassT) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! StiffTSS + call RegPack(Buf, allocated(InData%StiffTSS)) + if (allocated(InData%StiffTSS)) then + call RegPackBounds(Buf, 1, lbound(InData%StiffTSS), ubound(InData%StiffTSS)) + call RegPack(Buf, InData%StiffTSS) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TwrFASF + call RegPack(Buf, allocated(InData%TwrFASF)) + if (allocated(InData%TwrFASF)) then + call RegPackBounds(Buf, 3, lbound(InData%TwrFASF), ubound(InData%TwrFASF)) + call RegPack(Buf, InData%TwrFASF) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TwrFlexL + call RegPack(Buf, InData%TwrFlexL) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrSSSF + call RegPack(Buf, allocated(InData%TwrSSSF)) + if (allocated(InData%TwrSSSF)) then + call RegPackBounds(Buf, 3, lbound(InData%TwrSSSF), ubound(InData%TwrSSSF)) + call RegPack(Buf, InData%TwrSSSF) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TTopNode + call RegPack(Buf, InData%TTopNode) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrNodes + call RegPack(Buf, InData%TwrNodes) + if (RegCheckErr(Buf, RoutineName)) return + ! MHK + call RegPack(Buf, InData%MHK) + if (RegCheckErr(Buf, RoutineName)) return + ! StiffTFA + call RegPack(Buf, allocated(InData%StiffTFA)) + if (allocated(InData%StiffTFA)) then + call RegPackBounds(Buf, 1, lbound(InData%StiffTFA), ubound(InData%StiffTFA)) + call RegPack(Buf, InData%StiffTFA) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AtfaIner + call RegPack(Buf, InData%AtfaIner) + if (RegCheckErr(Buf, RoutineName)) return + ! BldCG + call RegPack(Buf, allocated(InData%BldCG)) + if (allocated(InData%BldCG)) then + call RegPackBounds(Buf, 1, lbound(InData%BldCG), ubound(InData%BldCG)) + call RegPack(Buf, InData%BldCG) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BldMass + call RegPack(Buf, allocated(InData%BldMass)) + if (allocated(InData%BldMass)) then + call RegPackBounds(Buf, 1, lbound(InData%BldMass), ubound(InData%BldMass)) + call RegPack(Buf, InData%BldMass) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BoomMass + call RegPack(Buf, InData%BoomMass) + if (RegCheckErr(Buf, RoutineName)) return + ! FirstMom + call RegPack(Buf, allocated(InData%FirstMom)) + if (allocated(InData%FirstMom)) then + call RegPackBounds(Buf, 1, lbound(InData%FirstMom), ubound(InData%FirstMom)) + call RegPack(Buf, InData%FirstMom) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! GenIner + call RegPack(Buf, InData%GenIner) + if (RegCheckErr(Buf, RoutineName)) return + ! Hubg1Iner + call RegPack(Buf, InData%Hubg1Iner) + if (RegCheckErr(Buf, RoutineName)) return + ! Hubg2Iner + call RegPack(Buf, InData%Hubg2Iner) + if (RegCheckErr(Buf, RoutineName)) return + ! HubMass + call RegPack(Buf, InData%HubMass) + if (RegCheckErr(Buf, RoutineName)) return + ! Nacd2Iner + call RegPack(Buf, InData%Nacd2Iner) + if (RegCheckErr(Buf, RoutineName)) return + ! NacMass + call RegPack(Buf, InData%NacMass) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmMass + call RegPack(Buf, InData%PtfmMass) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmPIner + call RegPack(Buf, InData%PtfmPIner) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmRIner + call RegPack(Buf, InData%PtfmRIner) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmYIner + call RegPack(Buf, InData%PtfmYIner) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlMass + call RegPack(Buf, InData%RFrlMass) + if (RegCheckErr(Buf, RoutineName)) return + ! RotIner + call RegPack(Buf, InData%RotIner) + if (RegCheckErr(Buf, RoutineName)) return + ! RotMass + call RegPack(Buf, InData%RotMass) + if (RegCheckErr(Buf, RoutineName)) return + ! RrfaIner + call RegPack(Buf, InData%RrfaIner) + if (RegCheckErr(Buf, RoutineName)) return + ! SecondMom + call RegPack(Buf, allocated(InData%SecondMom)) + if (allocated(InData%SecondMom)) then + call RegPackBounds(Buf, 1, lbound(InData%SecondMom), ubound(InData%SecondMom)) + call RegPack(Buf, InData%SecondMom) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TFinMass + call RegPack(Buf, InData%TFinMass) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlIner + call RegPack(Buf, InData%TFrlIner) + if (RegCheckErr(Buf, RoutineName)) return + ! TipMass + call RegPack(Buf, allocated(InData%TipMass)) + if (allocated(InData%TipMass)) then + call RegPackBounds(Buf, 1, lbound(InData%TipMass), ubound(InData%TipMass)) + call RegPack(Buf, InData%TipMass) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TurbMass + call RegPack(Buf, InData%TurbMass) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrMass + call RegPack(Buf, InData%TwrMass) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrTpMass + call RegPack(Buf, InData%TwrTpMass) + if (RegCheckErr(Buf, RoutineName)) return + ! YawBrMass + call RegPack(Buf, InData%YawBrMass) + if (RegCheckErr(Buf, RoutineName)) return + ! Gravity + call RegPack(Buf, InData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + ! PitchAxis + call RegPack(Buf, allocated(InData%PitchAxis)) + if (allocated(InData%PitchAxis)) then + call RegPackBounds(Buf, 2, lbound(InData%PitchAxis), ubound(InData%PitchAxis)) + call RegPack(Buf, InData%PitchAxis) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AeroTwst + call RegPack(Buf, allocated(InData%AeroTwst)) + if (allocated(InData%AeroTwst)) then + call RegPackBounds(Buf, 1, lbound(InData%AeroTwst), ubound(InData%AeroTwst)) + call RegPack(Buf, InData%AeroTwst) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AxRedBld + call RegPack(Buf, allocated(InData%AxRedBld)) + if (allocated(InData%AxRedBld)) then + call RegPackBounds(Buf, 4, lbound(InData%AxRedBld), ubound(InData%AxRedBld)) + call RegPack(Buf, InData%AxRedBld) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BldEDamp + call RegPack(Buf, allocated(InData%BldEDamp)) + if (allocated(InData%BldEDamp)) then + call RegPackBounds(Buf, 2, lbound(InData%BldEDamp), ubound(InData%BldEDamp)) + call RegPack(Buf, InData%BldEDamp) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BldFDamp + call RegPack(Buf, allocated(InData%BldFDamp)) + if (allocated(InData%BldFDamp)) then + call RegPackBounds(Buf, 2, lbound(InData%BldFDamp), ubound(InData%BldFDamp)) + call RegPack(Buf, InData%BldFDamp) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BldFlexL + call RegPack(Buf, InData%BldFlexL) + if (RegCheckErr(Buf, RoutineName)) return + ! CAeroTwst + call RegPack(Buf, allocated(InData%CAeroTwst)) + if (allocated(InData%CAeroTwst)) then + call RegPackBounds(Buf, 1, lbound(InData%CAeroTwst), ubound(InData%CAeroTwst)) + call RegPack(Buf, InData%CAeroTwst) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CBE + call RegPack(Buf, allocated(InData%CBE)) + if (allocated(InData%CBE)) then + call RegPackBounds(Buf, 3, lbound(InData%CBE), ubound(InData%CBE)) + call RegPack(Buf, InData%CBE) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CBF + call RegPack(Buf, allocated(InData%CBF)) + if (allocated(InData%CBF)) then + call RegPackBounds(Buf, 3, lbound(InData%CBF), ubound(InData%CBF)) + call RegPack(Buf, InData%CBF) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Chord + call RegPack(Buf, allocated(InData%Chord)) + if (allocated(InData%Chord)) then + call RegPackBounds(Buf, 1, lbound(InData%Chord), ubound(InData%Chord)) + call RegPack(Buf, InData%Chord) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CThetaS + call RegPack(Buf, allocated(InData%CThetaS)) + if (allocated(InData%CThetaS)) then + call RegPackBounds(Buf, 2, lbound(InData%CThetaS), ubound(InData%CThetaS)) + call RegPack(Buf, InData%CThetaS) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DRNodes + call RegPack(Buf, allocated(InData%DRNodes)) + if (allocated(InData%DRNodes)) then + call RegPackBounds(Buf, 1, lbound(InData%DRNodes), ubound(InData%DRNodes)) + call RegPack(Buf, InData%DRNodes) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FStTunr + call RegPack(Buf, allocated(InData%FStTunr)) + if (allocated(InData%FStTunr)) then + call RegPackBounds(Buf, 2, lbound(InData%FStTunr), ubound(InData%FStTunr)) + call RegPack(Buf, InData%FStTunr) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! KBE + call RegPack(Buf, allocated(InData%KBE)) + if (allocated(InData%KBE)) then + call RegPackBounds(Buf, 3, lbound(InData%KBE), ubound(InData%KBE)) + call RegPack(Buf, InData%KBE) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! KBF + call RegPack(Buf, allocated(InData%KBF)) + if (allocated(InData%KBF)) then + call RegPackBounds(Buf, 3, lbound(InData%KBF), ubound(InData%KBF)) + call RegPack(Buf, InData%KBF) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MassB + call RegPack(Buf, allocated(InData%MassB)) + if (allocated(InData%MassB)) then + call RegPackBounds(Buf, 2, lbound(InData%MassB), ubound(InData%MassB)) + call RegPack(Buf, InData%MassB) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RNodes + call RegPack(Buf, allocated(InData%RNodes)) + if (allocated(InData%RNodes)) then + call RegPackBounds(Buf, 1, lbound(InData%RNodes), ubound(InData%RNodes)) + call RegPack(Buf, InData%RNodes) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RNodesNorm + call RegPack(Buf, allocated(InData%RNodesNorm)) + if (allocated(InData%RNodesNorm)) then + call RegPackBounds(Buf, 1, lbound(InData%RNodesNorm), ubound(InData%RNodesNorm)) + call RegPack(Buf, InData%RNodesNorm) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! rSAerCenn1 + call RegPack(Buf, allocated(InData%rSAerCenn1)) + if (allocated(InData%rSAerCenn1)) then + call RegPackBounds(Buf, 2, lbound(InData%rSAerCenn1), ubound(InData%rSAerCenn1)) + call RegPack(Buf, InData%rSAerCenn1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! rSAerCenn2 + call RegPack(Buf, allocated(InData%rSAerCenn2)) + if (allocated(InData%rSAerCenn2)) then + call RegPackBounds(Buf, 2, lbound(InData%rSAerCenn2), ubound(InData%rSAerCenn2)) + call RegPack(Buf, InData%rSAerCenn2) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SAeroTwst + call RegPack(Buf, allocated(InData%SAeroTwst)) + if (allocated(InData%SAeroTwst)) then + call RegPackBounds(Buf, 1, lbound(InData%SAeroTwst), ubound(InData%SAeroTwst)) + call RegPack(Buf, InData%SAeroTwst) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! StiffBE + call RegPack(Buf, allocated(InData%StiffBE)) + if (allocated(InData%StiffBE)) then + call RegPackBounds(Buf, 2, lbound(InData%StiffBE), ubound(InData%StiffBE)) + call RegPack(Buf, InData%StiffBE) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! StiffBF + call RegPack(Buf, allocated(InData%StiffBF)) + if (allocated(InData%StiffBF)) then + call RegPackBounds(Buf, 2, lbound(InData%StiffBF), ubound(InData%StiffBF)) + call RegPack(Buf, InData%StiffBF) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SThetaS + call RegPack(Buf, allocated(InData%SThetaS)) + if (allocated(InData%SThetaS)) then + call RegPackBounds(Buf, 2, lbound(InData%SThetaS), ubound(InData%SThetaS)) + call RegPack(Buf, InData%SThetaS) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ThetaS + call RegPack(Buf, allocated(InData%ThetaS)) + if (allocated(InData%ThetaS)) then + call RegPackBounds(Buf, 2, lbound(InData%ThetaS), ubound(InData%ThetaS)) + call RegPack(Buf, InData%ThetaS) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TwistedSF + call RegPack(Buf, allocated(InData%TwistedSF)) + if (allocated(InData%TwistedSF)) then + call RegPackBounds(Buf, 5, lbound(InData%TwistedSF), ubound(InData%TwistedSF)) + call RegPack(Buf, InData%TwistedSF) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BldFl1Sh + call RegPack(Buf, allocated(InData%BldFl1Sh)) + if (allocated(InData%BldFl1Sh)) then + call RegPackBounds(Buf, 2, lbound(InData%BldFl1Sh), ubound(InData%BldFl1Sh)) + call RegPack(Buf, InData%BldFl1Sh) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BldFl2Sh + call RegPack(Buf, allocated(InData%BldFl2Sh)) + if (allocated(InData%BldFl2Sh)) then + call RegPackBounds(Buf, 2, lbound(InData%BldFl2Sh), ubound(InData%BldFl2Sh)) + call RegPack(Buf, InData%BldFl2Sh) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BldEdgSh + call RegPack(Buf, allocated(InData%BldEdgSh)) + if (allocated(InData%BldEdgSh)) then + call RegPackBounds(Buf, 2, lbound(InData%BldEdgSh), ubound(InData%BldEdgSh)) + call RegPack(Buf, InData%BldEdgSh) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FreqBE + call RegPack(Buf, allocated(InData%FreqBE)) + if (allocated(InData%FreqBE)) then + call RegPackBounds(Buf, 3, lbound(InData%FreqBE), ubound(InData%FreqBE)) + call RegPack(Buf, InData%FreqBE) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FreqBF + call RegPack(Buf, allocated(InData%FreqBF)) + if (allocated(InData%FreqBF)) then + call RegPackBounds(Buf, 3, lbound(InData%FreqBF), ubound(InData%FreqBF)) + call RegPack(Buf, InData%FreqBF) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FreqTFA + call RegPack(Buf, InData%FreqTFA) + if (RegCheckErr(Buf, RoutineName)) return + ! FreqTSS + call RegPack(Buf, InData%FreqTSS) + if (RegCheckErr(Buf, RoutineName)) return + ! TeetCDmp + call RegPack(Buf, InData%TeetCDmp) + if (RegCheckErr(Buf, RoutineName)) return + ! TeetDmp + call RegPack(Buf, InData%TeetDmp) + if (RegCheckErr(Buf, RoutineName)) return + ! TeetDmpP + call RegPack(Buf, InData%TeetDmpP) + if (RegCheckErr(Buf, RoutineName)) return + ! TeetHSSp + call RegPack(Buf, InData%TeetHSSp) + if (RegCheckErr(Buf, RoutineName)) return + ! TeetHStP + call RegPack(Buf, InData%TeetHStP) + if (RegCheckErr(Buf, RoutineName)) return + ! TeetSSSp + call RegPack(Buf, InData%TeetSSSp) + if (RegCheckErr(Buf, RoutineName)) return + ! TeetSStP + call RegPack(Buf, InData%TeetSStP) + if (RegCheckErr(Buf, RoutineName)) return + ! TeetMod + call RegPack(Buf, InData%TeetMod) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlDmp + call RegPack(Buf, InData%TFrlDmp) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlDSDmp + call RegPack(Buf, InData%TFrlDSDmp) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlDSDP + call RegPack(Buf, InData%TFrlDSDP) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlDSSP + call RegPack(Buf, InData%TFrlDSSP) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlDSSpr + call RegPack(Buf, InData%TFrlDSSpr) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlSpr + call RegPack(Buf, InData%TFrlSpr) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlUSDmp + call RegPack(Buf, InData%TFrlUSDmp) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlUSDP + call RegPack(Buf, InData%TFrlUSDP) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlUSSP + call RegPack(Buf, InData%TFrlUSSP) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlUSSpr + call RegPack(Buf, InData%TFrlUSSpr) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlMod + call RegPack(Buf, InData%TFrlMod) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlDmp + call RegPack(Buf, InData%RFrlDmp) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlDSDmp + call RegPack(Buf, InData%RFrlDSDmp) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlDSDP + call RegPack(Buf, InData%RFrlDSDP) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlDSSP + call RegPack(Buf, InData%RFrlDSSP) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlDSSpr + call RegPack(Buf, InData%RFrlDSSpr) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlSpr + call RegPack(Buf, InData%RFrlSpr) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlUSDmp + call RegPack(Buf, InData%RFrlUSDmp) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlUSDP + call RegPack(Buf, InData%RFrlUSDP) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlUSSP + call RegPack(Buf, InData%RFrlUSSP) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlUSSpr + call RegPack(Buf, InData%RFrlUSSpr) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlMod + call RegPack(Buf, InData%RFrlMod) + if (RegCheckErr(Buf, RoutineName)) return + ! ShftGagL + call RegPack(Buf, InData%ShftGagL) + if (RegCheckErr(Buf, RoutineName)) return + ! BldGagNd + call RegPack(Buf, InData%BldGagNd) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrGagNd + call RegPack(Buf, InData%TwrGagNd) + if (RegCheckErr(Buf, RoutineName)) return + ! TStart + call RegPack(Buf, InData%TStart) + if (RegCheckErr(Buf, RoutineName)) return + ! DTTorDmp + call RegPack(Buf, InData%DTTorDmp) + if (RegCheckErr(Buf, RoutineName)) return + ! DTTorSpr + call RegPack(Buf, InData%DTTorSpr) + if (RegCheckErr(Buf, RoutineName)) return + ! GBRatio + call RegPack(Buf, InData%GBRatio) + if (RegCheckErr(Buf, RoutineName)) return + ! GBoxEff + call RegPack(Buf, InData%GBoxEff) + if (RegCheckErr(Buf, RoutineName)) return + ! RotSpeed + call RegPack(Buf, InData%RotSpeed) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegPack(Buf, InData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! BElmntMass + call RegPack(Buf, allocated(InData%BElmntMass)) + if (allocated(InData%BElmntMass)) then + call RegPackBounds(Buf, 2, lbound(InData%BElmntMass), ubound(InData%BElmntMass)) + call RegPack(Buf, InData%BElmntMass) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TElmntMass + call RegPack(Buf, allocated(InData%TElmntMass)) + if (allocated(InData%TElmntMass)) then + call RegPackBounds(Buf, 1, lbound(InData%TElmntMass), ubound(InData%TElmntMass)) + call RegPack(Buf, InData%TElmntMass) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! method + call RegPack(Buf, InData%method) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmCMxt + call RegPack(Buf, InData%PtfmCMxt) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmCMyt + call RegPack(Buf, InData%PtfmCMyt) + if (RegCheckErr(Buf, RoutineName)) return + ! BD4Blades + call RegPack(Buf, InData%BD4Blades) + if (RegCheckErr(Buf, RoutineName)) return + ! UseAD14 + call RegPack(Buf, InData%UseAD14) + if (RegCheckErr(Buf, RoutineName)) return + ! BldNd_NumOuts + call RegPack(Buf, InData%BldNd_NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! BldNd_TotNumOuts + call RegPack(Buf, InData%BldNd_TotNumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! BldNd_OutParam + call RegPack(Buf, allocated(InData%BldNd_OutParam)) + if (allocated(InData%BldNd_OutParam)) then + call RegPackBounds(Buf, 1, lbound(InData%BldNd_OutParam), ubound(InData%BldNd_OutParam)) + LB(1:1) = lbound(InData%BldNd_OutParam) + UB(1:1) = ubound(InData%BldNd_OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(Buf, InData%BldNd_OutParam(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BldNd_BladesOut + call RegPack(Buf, InData%BldNd_BladesOut) + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_u_indx + call RegPack(Buf, allocated(InData%Jac_u_indx)) + if (allocated(InData%Jac_u_indx)) then + call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx), ubound(InData%Jac_u_indx)) + call RegPack(Buf, InData%Jac_u_indx) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! du + call RegPack(Buf, allocated(InData%du)) + if (allocated(InData%du)) then + call RegPackBounds(Buf, 1, lbound(InData%du), ubound(InData%du)) + call RegPack(Buf, InData%du) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! dx + call RegPack(Buf, allocated(InData%dx)) + if (allocated(InData%dx)) then + call RegPackBounds(Buf, 1, lbound(InData%dx), ubound(InData%dx)) + call RegPack(Buf, InData%dx) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_ny + call RegPack(Buf, InData%Jac_ny) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ED_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ED_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackParam' + integer(IntKi) :: i1, i2, i3, i4, i5 + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! DT + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! DT24 + call RegUnpack(Buf, OutData%DT24) + if (RegCheckErr(Buf, RoutineName)) return + ! BldNodes + call RegUnpack(Buf, OutData%BldNodes) + if (RegCheckErr(Buf, RoutineName)) return + ! TipNode + call RegUnpack(Buf, OutData%TipNode) + if (RegCheckErr(Buf, RoutineName)) return + ! NDOF + call RegUnpack(Buf, OutData%NDOF) + if (RegCheckErr(Buf, RoutineName)) return + ! TwoPiNB + call RegUnpack(Buf, OutData%TwoPiNB) + if (RegCheckErr(Buf, RoutineName)) return + ! NAug + call RegUnpack(Buf, OutData%NAug) + if (RegCheckErr(Buf, RoutineName)) return + ! NPH + call RegUnpack(Buf, OutData%NPH) + if (RegCheckErr(Buf, RoutineName)) return + ! PH + if (allocated(OutData%PH)) deallocate(OutData%PH) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PH(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PH.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PH) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NPM + call RegUnpack(Buf, OutData%NPM) + if (RegCheckErr(Buf, RoutineName)) return + ! PM + if (allocated(OutData%PM)) deallocate(OutData%PM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PM(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PM) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! DOF_Flag + if (allocated(OutData%DOF_Flag)) deallocate(OutData%DOF_Flag) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DOF_Flag(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DOF_Flag.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DOF_Flag) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! DOF_Desc + if (allocated(OutData%DOF_Desc)) deallocate(OutData%DOF_Desc) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DOF_Desc(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DOF_Desc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DOF_Desc) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! DOFs + call ED_UnpackActiveDOFs(Buf, OutData%DOFs) ! DOFs + ! NumOuts + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFmt + call RegUnpack(Buf, OutData%OutFmt) + if (RegCheckErr(Buf, RoutineName)) return + ! NBlGages + call RegUnpack(Buf, OutData%NBlGages) + if (RegCheckErr(Buf, RoutineName)) return + ! NTwGages + call RegUnpack(Buf, OutData%NTwGages) + if (RegCheckErr(Buf, RoutineName)) return + ! OutParam + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam + end do + end if + ! Delim + call RegUnpack(Buf, OutData%Delim) + if (RegCheckErr(Buf, RoutineName)) return + ! AvgNrmTpRd + call RegUnpack(Buf, OutData%AvgNrmTpRd) + if (RegCheckErr(Buf, RoutineName)) return + ! AzimB1Up + call RegUnpack(Buf, OutData%AzimB1Up) + if (RegCheckErr(Buf, RoutineName)) return + ! CosDel3 + call RegUnpack(Buf, OutData%CosDel3) + if (RegCheckErr(Buf, RoutineName)) return + ! CosPreC + if (allocated(OutData%CosPreC)) deallocate(OutData%CosPreC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CosPreC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CosPreC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CosPreC) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CRFrlSkew + call RegUnpack(Buf, OutData%CRFrlSkew) + if (RegCheckErr(Buf, RoutineName)) return + ! CRFrlSkw2 + call RegUnpack(Buf, OutData%CRFrlSkw2) + if (RegCheckErr(Buf, RoutineName)) return + ! CRFrlTilt + call RegUnpack(Buf, OutData%CRFrlTilt) + if (RegCheckErr(Buf, RoutineName)) return + ! CRFrlTlt2 + call RegUnpack(Buf, OutData%CRFrlTlt2) + if (RegCheckErr(Buf, RoutineName)) return + ! CShftSkew + call RegUnpack(Buf, OutData%CShftSkew) + if (RegCheckErr(Buf, RoutineName)) return + ! CShftTilt + call RegUnpack(Buf, OutData%CShftTilt) + if (RegCheckErr(Buf, RoutineName)) return + ! CSRFrlSkw + call RegUnpack(Buf, OutData%CSRFrlSkw) + if (RegCheckErr(Buf, RoutineName)) return + ! CSRFrlTlt + call RegUnpack(Buf, OutData%CSRFrlTlt) + if (RegCheckErr(Buf, RoutineName)) return + ! CSTFrlSkw + call RegUnpack(Buf, OutData%CSTFrlSkw) + if (RegCheckErr(Buf, RoutineName)) return + ! CSTFrlTlt + call RegUnpack(Buf, OutData%CSTFrlTlt) + if (RegCheckErr(Buf, RoutineName)) return + ! CTFrlSkew + call RegUnpack(Buf, OutData%CTFrlSkew) + if (RegCheckErr(Buf, RoutineName)) return + ! CTFrlSkw2 + call RegUnpack(Buf, OutData%CTFrlSkw2) + if (RegCheckErr(Buf, RoutineName)) return + ! CTFrlTilt + call RegUnpack(Buf, OutData%CTFrlTilt) + if (RegCheckErr(Buf, RoutineName)) return + ! CTFrlTlt2 + call RegUnpack(Buf, OutData%CTFrlTlt2) + if (RegCheckErr(Buf, RoutineName)) return + ! HubHt + call RegUnpack(Buf, OutData%HubHt) + if (RegCheckErr(Buf, RoutineName)) return + ! HubCM + call RegUnpack(Buf, OutData%HubCM) + if (RegCheckErr(Buf, RoutineName)) return + ! HubRad + call RegUnpack(Buf, OutData%HubRad) + if (RegCheckErr(Buf, RoutineName)) return + ! NacCMxn + call RegUnpack(Buf, OutData%NacCMxn) + if (RegCheckErr(Buf, RoutineName)) return + ! NacCMyn + call RegUnpack(Buf, OutData%NacCMyn) + if (RegCheckErr(Buf, RoutineName)) return + ! NacCMzn + call RegUnpack(Buf, OutData%NacCMzn) + if (RegCheckErr(Buf, RoutineName)) return + ! OverHang + call RegUnpack(Buf, OutData%OverHang) + if (RegCheckErr(Buf, RoutineName)) return + ! ProjArea + call RegUnpack(Buf, OutData%ProjArea) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmRefzt + call RegUnpack(Buf, OutData%PtfmRefzt) + if (RegCheckErr(Buf, RoutineName)) return + ! RefTwrHt + call RegUnpack(Buf, OutData%RefTwrHt) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlPnt_n + call RegUnpack(Buf, OutData%RFrlPnt_n) + if (RegCheckErr(Buf, RoutineName)) return + ! rVDxn + call RegUnpack(Buf, OutData%rVDxn) + if (RegCheckErr(Buf, RoutineName)) return + ! rVDyn + call RegUnpack(Buf, OutData%rVDyn) + if (RegCheckErr(Buf, RoutineName)) return + ! rVDzn + call RegUnpack(Buf, OutData%rVDzn) + if (RegCheckErr(Buf, RoutineName)) return + ! rVIMUxn + call RegUnpack(Buf, OutData%rVIMUxn) + if (RegCheckErr(Buf, RoutineName)) return + ! rVIMUyn + call RegUnpack(Buf, OutData%rVIMUyn) + if (RegCheckErr(Buf, RoutineName)) return + ! rVIMUzn + call RegUnpack(Buf, OutData%rVIMUzn) + if (RegCheckErr(Buf, RoutineName)) return + ! rVPxn + call RegUnpack(Buf, OutData%rVPxn) + if (RegCheckErr(Buf, RoutineName)) return + ! rVPyn + call RegUnpack(Buf, OutData%rVPyn) + if (RegCheckErr(Buf, RoutineName)) return + ! rVPzn + call RegUnpack(Buf, OutData%rVPzn) + if (RegCheckErr(Buf, RoutineName)) return + ! rWIxn + call RegUnpack(Buf, OutData%rWIxn) + if (RegCheckErr(Buf, RoutineName)) return + ! rWIyn + call RegUnpack(Buf, OutData%rWIyn) + if (RegCheckErr(Buf, RoutineName)) return + ! rWIzn + call RegUnpack(Buf, OutData%rWIzn) + if (RegCheckErr(Buf, RoutineName)) return + ! rWJxn + call RegUnpack(Buf, OutData%rWJxn) + if (RegCheckErr(Buf, RoutineName)) return + ! rWJyn + call RegUnpack(Buf, OutData%rWJyn) + if (RegCheckErr(Buf, RoutineName)) return + ! rWJzn + call RegUnpack(Buf, OutData%rWJzn) + if (RegCheckErr(Buf, RoutineName)) return + ! rZT0zt + call RegUnpack(Buf, OutData%rZT0zt) + if (RegCheckErr(Buf, RoutineName)) return + ! rZYzt + call RegUnpack(Buf, OutData%rZYzt) + if (RegCheckErr(Buf, RoutineName)) return + ! SinDel3 + call RegUnpack(Buf, OutData%SinDel3) + if (RegCheckErr(Buf, RoutineName)) return + ! SinPreC + if (allocated(OutData%SinPreC)) deallocate(OutData%SinPreC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SinPreC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SinPreC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SinPreC) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! SRFrlSkew + call RegUnpack(Buf, OutData%SRFrlSkew) + if (RegCheckErr(Buf, RoutineName)) return + ! SRFrlSkw2 + call RegUnpack(Buf, OutData%SRFrlSkw2) + if (RegCheckErr(Buf, RoutineName)) return + ! SRFrlTilt + call RegUnpack(Buf, OutData%SRFrlTilt) + if (RegCheckErr(Buf, RoutineName)) return + ! SRFrlTlt2 + call RegUnpack(Buf, OutData%SRFrlTlt2) + if (RegCheckErr(Buf, RoutineName)) return + ! SShftSkew + call RegUnpack(Buf, OutData%SShftSkew) + if (RegCheckErr(Buf, RoutineName)) return + ! SShftTilt + call RegUnpack(Buf, OutData%SShftTilt) + if (RegCheckErr(Buf, RoutineName)) return + ! STFrlSkew + call RegUnpack(Buf, OutData%STFrlSkew) + if (RegCheckErr(Buf, RoutineName)) return + ! STFrlSkw2 + call RegUnpack(Buf, OutData%STFrlSkw2) + if (RegCheckErr(Buf, RoutineName)) return + ! STFrlTilt + call RegUnpack(Buf, OutData%STFrlTilt) + if (RegCheckErr(Buf, RoutineName)) return + ! STFrlTlt2 + call RegUnpack(Buf, OutData%STFrlTlt2) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlPnt_n + call RegUnpack(Buf, OutData%TFrlPnt_n) + if (RegCheckErr(Buf, RoutineName)) return + ! TipRad + call RegUnpack(Buf, OutData%TipRad) + if (RegCheckErr(Buf, RoutineName)) return + ! TowerHt + call RegUnpack(Buf, OutData%TowerHt) + if (RegCheckErr(Buf, RoutineName)) return + ! TowerBsHt + call RegUnpack(Buf, OutData%TowerBsHt) + if (RegCheckErr(Buf, RoutineName)) return + ! UndSling + call RegUnpack(Buf, OutData%UndSling) + if (RegCheckErr(Buf, RoutineName)) return + ! NumBl + call RegUnpack(Buf, OutData%NumBl) + if (RegCheckErr(Buf, RoutineName)) return + ! AxRedTFA + if (allocated(OutData%AxRedTFA)) deallocate(OutData%AxRedTFA) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AxRedTFA(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxRedTFA.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AxRedTFA) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AxRedTSS + if (allocated(OutData%AxRedTSS)) deallocate(OutData%AxRedTSS) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AxRedTSS(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxRedTSS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AxRedTSS) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CTFA + call RegUnpack(Buf, OutData%CTFA) + if (RegCheckErr(Buf, RoutineName)) return + ! CTSS + call RegUnpack(Buf, OutData%CTSS) + if (RegCheckErr(Buf, RoutineName)) return + ! DHNodes + if (allocated(OutData%DHNodes)) deallocate(OutData%DHNodes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DHNodes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DHNodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DHNodes) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! HNodes + if (allocated(OutData%HNodes)) deallocate(OutData%HNodes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%HNodes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%HNodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%HNodes) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! HNodesNorm + if (allocated(OutData%HNodesNorm)) deallocate(OutData%HNodesNorm) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%HNodesNorm(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%HNodesNorm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%HNodesNorm) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! KTFA + call RegUnpack(Buf, OutData%KTFA) + if (RegCheckErr(Buf, RoutineName)) return + ! KTSS + call RegUnpack(Buf, OutData%KTSS) + if (RegCheckErr(Buf, RoutineName)) return + ! MassT + if (allocated(OutData%MassT)) deallocate(OutData%MassT) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MassT(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MassT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MassT) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! StiffTSS + if (allocated(OutData%StiffTSS)) deallocate(OutData%StiffTSS) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StiffTSS(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffTSS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StiffTSS) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TwrFASF + if (allocated(OutData%TwrFASF)) deallocate(OutData%TwrFASF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrFASF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrFASF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrFASF) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TwrFlexL + call RegUnpack(Buf, OutData%TwrFlexL) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrSSSF + if (allocated(OutData%TwrSSSF)) deallocate(OutData%TwrSSSF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrSSSF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrSSSF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrSSSF) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TTopNode + call RegUnpack(Buf, OutData%TTopNode) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrNodes + call RegUnpack(Buf, OutData%TwrNodes) + if (RegCheckErr(Buf, RoutineName)) return + ! MHK + call RegUnpack(Buf, OutData%MHK) + if (RegCheckErr(Buf, RoutineName)) return + ! StiffTFA + if (allocated(OutData%StiffTFA)) deallocate(OutData%StiffTFA) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StiffTFA(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffTFA.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StiffTFA) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AtfaIner + call RegUnpack(Buf, OutData%AtfaIner) + if (RegCheckErr(Buf, RoutineName)) return + ! BldCG + if (allocated(OutData%BldCG)) deallocate(OutData%BldCG) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BldCG(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldCG.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BldCG) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BldMass + if (allocated(OutData%BldMass)) deallocate(OutData%BldMass) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BldMass(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldMass.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BldMass) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BoomMass + call RegUnpack(Buf, OutData%BoomMass) + if (RegCheckErr(Buf, RoutineName)) return + ! FirstMom + if (allocated(OutData%FirstMom)) deallocate(OutData%FirstMom) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FirstMom(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FirstMom.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FirstMom) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! GenIner + call RegUnpack(Buf, OutData%GenIner) + if (RegCheckErr(Buf, RoutineName)) return + ! Hubg1Iner + call RegUnpack(Buf, OutData%Hubg1Iner) + if (RegCheckErr(Buf, RoutineName)) return + ! Hubg2Iner + call RegUnpack(Buf, OutData%Hubg2Iner) + if (RegCheckErr(Buf, RoutineName)) return + ! HubMass + call RegUnpack(Buf, OutData%HubMass) + if (RegCheckErr(Buf, RoutineName)) return + ! Nacd2Iner + call RegUnpack(Buf, OutData%Nacd2Iner) + if (RegCheckErr(Buf, RoutineName)) return + ! NacMass + call RegUnpack(Buf, OutData%NacMass) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmMass + call RegUnpack(Buf, OutData%PtfmMass) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmPIner + call RegUnpack(Buf, OutData%PtfmPIner) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmRIner + call RegUnpack(Buf, OutData%PtfmRIner) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmYIner + call RegUnpack(Buf, OutData%PtfmYIner) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlMass + call RegUnpack(Buf, OutData%RFrlMass) + if (RegCheckErr(Buf, RoutineName)) return + ! RotIner + call RegUnpack(Buf, OutData%RotIner) + if (RegCheckErr(Buf, RoutineName)) return + ! RotMass + call RegUnpack(Buf, OutData%RotMass) + if (RegCheckErr(Buf, RoutineName)) return + ! RrfaIner + call RegUnpack(Buf, OutData%RrfaIner) + if (RegCheckErr(Buf, RoutineName)) return + ! SecondMom + if (allocated(OutData%SecondMom)) deallocate(OutData%SecondMom) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SecondMom(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SecondMom.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SecondMom) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TFinMass + call RegUnpack(Buf, OutData%TFinMass) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlIner + call RegUnpack(Buf, OutData%TFrlIner) + if (RegCheckErr(Buf, RoutineName)) return + ! TipMass + if (allocated(OutData%TipMass)) deallocate(OutData%TipMass) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TipMass(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TipMass.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TipMass) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TurbMass + call RegUnpack(Buf, OutData%TurbMass) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrMass + call RegUnpack(Buf, OutData%TwrMass) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrTpMass + call RegUnpack(Buf, OutData%TwrTpMass) + if (RegCheckErr(Buf, RoutineName)) return + ! YawBrMass + call RegUnpack(Buf, OutData%YawBrMass) + if (RegCheckErr(Buf, RoutineName)) return + ! Gravity + call RegUnpack(Buf, OutData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + ! PitchAxis + if (allocated(OutData%PitchAxis)) deallocate(OutData%PitchAxis) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PitchAxis(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PitchAxis.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PitchAxis) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AeroTwst + if (allocated(OutData%AeroTwst)) deallocate(OutData%AeroTwst) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AeroTwst(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AeroTwst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AeroTwst) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AxRedBld + if (allocated(OutData%AxRedBld)) deallocate(OutData%AxRedBld) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AxRedBld(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxRedBld.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AxRedBld) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BldEDamp + if (allocated(OutData%BldEDamp)) deallocate(OutData%BldEDamp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BldEDamp(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldEDamp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BldEDamp) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BldFDamp + if (allocated(OutData%BldFDamp)) deallocate(OutData%BldFDamp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BldFDamp(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldFDamp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BldFDamp) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BldFlexL + call RegUnpack(Buf, OutData%BldFlexL) + if (RegCheckErr(Buf, RoutineName)) return + ! CAeroTwst + if (allocated(OutData%CAeroTwst)) deallocate(OutData%CAeroTwst) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CAeroTwst(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CAeroTwst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CAeroTwst) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CBE + if (allocated(OutData%CBE)) deallocate(OutData%CBE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CBE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CBE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CBE) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CBF + if (allocated(OutData%CBF)) deallocate(OutData%CBF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CBF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CBF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CBF) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Chord + if (allocated(OutData%Chord)) deallocate(OutData%Chord) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Chord(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Chord.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Chord) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CThetaS + if (allocated(OutData%CThetaS)) deallocate(OutData%CThetaS) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CThetaS(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CThetaS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CThetaS) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! DRNodes + if (allocated(OutData%DRNodes)) deallocate(OutData%DRNodes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DRNodes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DRNodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DRNodes) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! FStTunr + if (allocated(OutData%FStTunr)) deallocate(OutData%FStTunr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FStTunr(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FStTunr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FStTunr) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! KBE + if (allocated(OutData%KBE)) deallocate(OutData%KBE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%KBE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%KBE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%KBE) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! KBF + if (allocated(OutData%KBF)) deallocate(OutData%KBF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%KBF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%KBF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%KBF) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! MassB + if (allocated(OutData%MassB)) deallocate(OutData%MassB) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MassB(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MassB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MassB) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RNodes + if (allocated(OutData%RNodes)) deallocate(OutData%RNodes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RNodes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RNodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RNodes) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RNodesNorm + if (allocated(OutData%RNodesNorm)) deallocate(OutData%RNodesNorm) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RNodesNorm(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RNodesNorm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RNodesNorm) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! rSAerCenn1 + if (allocated(OutData%rSAerCenn1)) deallocate(OutData%rSAerCenn1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rSAerCenn1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rSAerCenn1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rSAerCenn1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! rSAerCenn2 + if (allocated(OutData%rSAerCenn2)) deallocate(OutData%rSAerCenn2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rSAerCenn2(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rSAerCenn2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rSAerCenn2) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! SAeroTwst + if (allocated(OutData%SAeroTwst)) deallocate(OutData%SAeroTwst) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SAeroTwst(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SAeroTwst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SAeroTwst) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! StiffBE + if (allocated(OutData%StiffBE)) deallocate(OutData%StiffBE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StiffBE(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffBE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StiffBE) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! StiffBF + if (allocated(OutData%StiffBF)) deallocate(OutData%StiffBF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StiffBF(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffBF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StiffBF) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! SThetaS + if (allocated(OutData%SThetaS)) deallocate(OutData%SThetaS) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SThetaS(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SThetaS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SThetaS) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ThetaS + if (allocated(OutData%ThetaS)) deallocate(OutData%ThetaS) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ThetaS(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ThetaS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ThetaS) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TwistedSF + if (allocated(OutData%TwistedSF)) deallocate(OutData%TwistedSF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwistedSF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwistedSF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwistedSF) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BldFl1Sh + if (allocated(OutData%BldFl1Sh)) deallocate(OutData%BldFl1Sh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BldFl1Sh(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldFl1Sh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BldFl1Sh) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BldFl2Sh + if (allocated(OutData%BldFl2Sh)) deallocate(OutData%BldFl2Sh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BldFl2Sh(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldFl2Sh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BldFl2Sh) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BldEdgSh + if (allocated(OutData%BldEdgSh)) deallocate(OutData%BldEdgSh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BldEdgSh(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldEdgSh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BldEdgSh) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! FreqBE + if (allocated(OutData%FreqBE)) deallocate(OutData%FreqBE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FreqBE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FreqBE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FreqBE) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! FreqBF + if (allocated(OutData%FreqBF)) deallocate(OutData%FreqBF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FreqBF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FreqBF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FreqBF) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! FreqTFA + call RegUnpack(Buf, OutData%FreqTFA) + if (RegCheckErr(Buf, RoutineName)) return + ! FreqTSS + call RegUnpack(Buf, OutData%FreqTSS) + if (RegCheckErr(Buf, RoutineName)) return + ! TeetCDmp + call RegUnpack(Buf, OutData%TeetCDmp) + if (RegCheckErr(Buf, RoutineName)) return + ! TeetDmp + call RegUnpack(Buf, OutData%TeetDmp) + if (RegCheckErr(Buf, RoutineName)) return + ! TeetDmpP + call RegUnpack(Buf, OutData%TeetDmpP) + if (RegCheckErr(Buf, RoutineName)) return + ! TeetHSSp + call RegUnpack(Buf, OutData%TeetHSSp) + if (RegCheckErr(Buf, RoutineName)) return + ! TeetHStP + call RegUnpack(Buf, OutData%TeetHStP) + if (RegCheckErr(Buf, RoutineName)) return + ! TeetSSSp + call RegUnpack(Buf, OutData%TeetSSSp) + if (RegCheckErr(Buf, RoutineName)) return + ! TeetSStP + call RegUnpack(Buf, OutData%TeetSStP) + if (RegCheckErr(Buf, RoutineName)) return + ! TeetMod + call RegUnpack(Buf, OutData%TeetMod) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlDmp + call RegUnpack(Buf, OutData%TFrlDmp) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlDSDmp + call RegUnpack(Buf, OutData%TFrlDSDmp) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlDSDP + call RegUnpack(Buf, OutData%TFrlDSDP) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlDSSP + call RegUnpack(Buf, OutData%TFrlDSSP) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlDSSpr + call RegUnpack(Buf, OutData%TFrlDSSpr) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlSpr + call RegUnpack(Buf, OutData%TFrlSpr) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlUSDmp + call RegUnpack(Buf, OutData%TFrlUSDmp) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlUSDP + call RegUnpack(Buf, OutData%TFrlUSDP) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlUSSP + call RegUnpack(Buf, OutData%TFrlUSSP) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlUSSpr + call RegUnpack(Buf, OutData%TFrlUSSpr) + if (RegCheckErr(Buf, RoutineName)) return + ! TFrlMod + call RegUnpack(Buf, OutData%TFrlMod) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlDmp + call RegUnpack(Buf, OutData%RFrlDmp) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlDSDmp + call RegUnpack(Buf, OutData%RFrlDSDmp) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlDSDP + call RegUnpack(Buf, OutData%RFrlDSDP) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlDSSP + call RegUnpack(Buf, OutData%RFrlDSSP) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlDSSpr + call RegUnpack(Buf, OutData%RFrlDSSpr) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlSpr + call RegUnpack(Buf, OutData%RFrlSpr) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlUSDmp + call RegUnpack(Buf, OutData%RFrlUSDmp) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlUSDP + call RegUnpack(Buf, OutData%RFrlUSDP) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlUSSP + call RegUnpack(Buf, OutData%RFrlUSSP) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlUSSpr + call RegUnpack(Buf, OutData%RFrlUSSpr) + if (RegCheckErr(Buf, RoutineName)) return + ! RFrlMod + call RegUnpack(Buf, OutData%RFrlMod) + if (RegCheckErr(Buf, RoutineName)) return + ! ShftGagL + call RegUnpack(Buf, OutData%ShftGagL) + if (RegCheckErr(Buf, RoutineName)) return + ! BldGagNd + call RegUnpack(Buf, OutData%BldGagNd) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrGagNd + call RegUnpack(Buf, OutData%TwrGagNd) + if (RegCheckErr(Buf, RoutineName)) return + ! TStart + call RegUnpack(Buf, OutData%TStart) + if (RegCheckErr(Buf, RoutineName)) return + ! DTTorDmp + call RegUnpack(Buf, OutData%DTTorDmp) + if (RegCheckErr(Buf, RoutineName)) return + ! DTTorSpr + call RegUnpack(Buf, OutData%DTTorSpr) + if (RegCheckErr(Buf, RoutineName)) return + ! GBRatio + call RegUnpack(Buf, OutData%GBRatio) + if (RegCheckErr(Buf, RoutineName)) return + ! GBoxEff + call RegUnpack(Buf, OutData%GBoxEff) + if (RegCheckErr(Buf, RoutineName)) return + ! RotSpeed + call RegUnpack(Buf, OutData%RotSpeed) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! BElmntMass + if (allocated(OutData%BElmntMass)) deallocate(OutData%BElmntMass) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BElmntMass(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BElmntMass.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BElmntMass) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TElmntMass + if (allocated(OutData%TElmntMass)) deallocate(OutData%TElmntMass) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TElmntMass(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TElmntMass.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TElmntMass) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! method + call RegUnpack(Buf, OutData%method) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmCMxt + call RegUnpack(Buf, OutData%PtfmCMxt) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmCMyt + call RegUnpack(Buf, OutData%PtfmCMyt) + if (RegCheckErr(Buf, RoutineName)) return + ! BD4Blades + call RegUnpack(Buf, OutData%BD4Blades) + if (RegCheckErr(Buf, RoutineName)) return + ! UseAD14 + call RegUnpack(Buf, OutData%UseAD14) + if (RegCheckErr(Buf, RoutineName)) return + ! BldNd_NumOuts + call RegUnpack(Buf, OutData%BldNd_NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! BldNd_TotNumOuts + call RegUnpack(Buf, OutData%BldNd_TotNumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! BldNd_OutParam + if (allocated(OutData%BldNd_OutParam)) deallocate(OutData%BldNd_OutParam) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BldNd_OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(Buf, OutData%BldNd_OutParam(i1)) ! BldNd_OutParam + end do + end if + ! BldNd_BladesOut + call RegUnpack(Buf, OutData%BldNd_BladesOut) + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_u_indx + if (allocated(OutData%Jac_u_indx)) deallocate(OutData%Jac_u_indx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jac_u_indx) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! du + if (allocated(OutData%du)) deallocate(OutData%du) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%du(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%du) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! dx + if (allocated(OutData%dx)) deallocate(OutData%dx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dx(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dx) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Jac_ny + call RegUnpack(Buf, OutData%Jac_ny) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE ED_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(ED_InputType), INTENT(INOUT) :: SrcInputData TYPE(ED_InputType), INTENT(INOUT) :: DstInputData @@ -20551,775 +13039,146 @@ SUBROUTINE ED_DestroyInput( InputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE ED_DestroyInput - SUBROUTINE ED_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ED_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! BladePtLoads allocated yes/no - IF ( ALLOCATED(InData%BladePtLoads) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladePtLoads upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%BladePtLoads,1), UBOUND(InData%BladePtLoads,1) - Int_BufSz = Int_BufSz + 3 ! BladePtLoads: size of buffers for each call to pack subtype - CALL MeshPack( InData%BladePtLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BladePtLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladePtLoads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladePtLoads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladePtLoads - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! PlatformPtMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%PlatformPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PlatformPtMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PlatformPtMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PlatformPtMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PlatformPtMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! TowerPtLoads: size of buffers for each call to pack subtype - CALL MeshPack( InData%TowerPtLoads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TowerPtLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TowerPtLoads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TowerPtLoads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TowerPtLoads - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! HubPtLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%HubPtLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! HubPtLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! HubPtLoad - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! HubPtLoad - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! HubPtLoad - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! NacelleLoads: size of buffers for each call to pack subtype - CALL MeshPack( InData%NacelleLoads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! NacelleLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NacelleLoads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NacelleLoads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NacelleLoads - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! TFinCMLoads: size of buffers for each call to pack subtype - CALL MeshPack( InData%TFinCMLoads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TFinCMLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TFinCMLoads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TFinCMLoads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TFinCMLoads - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! TwrAddedMass allocated yes/no - IF ( ALLOCATED(InData%TwrAddedMass) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! TwrAddedMass upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TwrAddedMass) ! TwrAddedMass - END IF - Re_BufSz = Re_BufSz + SIZE(InData%PtfmAddedMass) ! PtfmAddedMass - Int_BufSz = Int_BufSz + 1 ! BlPitchCom allocated yes/no - IF ( ALLOCATED(InData%BlPitchCom) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlPitchCom upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlPitchCom) ! BlPitchCom - END IF - Re_BufSz = Re_BufSz + 1 ! YawMom - Re_BufSz = Re_BufSz + 1 ! GenTrq - Re_BufSz = Re_BufSz + 1 ! HSSBrTrqC - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%BladePtLoads) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladePtLoads,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladePtLoads,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BladePtLoads,1), UBOUND(InData%BladePtLoads,1) - CALL MeshPack( InData%BladePtLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BladePtLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL MeshPack( InData%PlatformPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PlatformPtMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MeshPack( InData%TowerPtLoads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TowerPtLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MeshPack( InData%HubPtLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! HubPtLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MeshPack( InData%NacelleLoads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! NacelleLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MeshPack( InData%TFinCMLoads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TFinCMLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%TwrAddedMass) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrAddedMass,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrAddedMass,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrAddedMass,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrAddedMass,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TwrAddedMass,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrAddedMass,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%TwrAddedMass,3), UBOUND(InData%TwrAddedMass,3) - DO i2 = LBOUND(InData%TwrAddedMass,2), UBOUND(InData%TwrAddedMass,2) - DO i1 = LBOUND(InData%TwrAddedMass,1), UBOUND(InData%TwrAddedMass,1) - ReKiBuf(Re_Xferred) = InData%TwrAddedMass(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - DO i2 = LBOUND(InData%PtfmAddedMass,2), UBOUND(InData%PtfmAddedMass,2) - DO i1 = LBOUND(InData%PtfmAddedMass,1), UBOUND(InData%PtfmAddedMass,1) - ReKiBuf(Re_Xferred) = InData%PtfmAddedMass(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( .NOT. ALLOCATED(InData%BlPitchCom) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlPitchCom,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitchCom,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlPitchCom,1), UBOUND(InData%BlPitchCom,1) - ReKiBuf(Re_Xferred) = InData%BlPitchCom(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%YawMom - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenTrq - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HSSBrTrqC - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ED_PackInput - - SUBROUTINE ED_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ED_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladePtLoads not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BladePtLoads)) DEALLOCATE(OutData%BladePtLoads) - ALLOCATE(OutData%BladePtLoads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladePtLoads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladePtLoads,1), UBOUND(OutData%BladePtLoads,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%BladePtLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BladePtLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%PlatformPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PlatformPtMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%TowerPtLoads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TowerPtLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%HubPtLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! HubPtLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%NacelleLoads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! NacelleLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%TFinCMLoads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TFinCMLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrAddedMass not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TwrAddedMass)) DEALLOCATE(OutData%TwrAddedMass) - ALLOCATE(OutData%TwrAddedMass(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrAddedMass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%TwrAddedMass,3), UBOUND(OutData%TwrAddedMass,3) - DO i2 = LBOUND(OutData%TwrAddedMass,2), UBOUND(OutData%TwrAddedMass,2) - DO i1 = LBOUND(OutData%TwrAddedMass,1), UBOUND(OutData%TwrAddedMass,1) - OutData%TwrAddedMass(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%PtfmAddedMass,1) - i1_u = UBOUND(OutData%PtfmAddedMass,1) - i2_l = LBOUND(OutData%PtfmAddedMass,2) - i2_u = UBOUND(OutData%PtfmAddedMass,2) - DO i2 = LBOUND(OutData%PtfmAddedMass,2), UBOUND(OutData%PtfmAddedMass,2) - DO i1 = LBOUND(OutData%PtfmAddedMass,1), UBOUND(OutData%PtfmAddedMass,1) - OutData%PtfmAddedMass(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitchCom not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlPitchCom)) DEALLOCATE(OutData%BlPitchCom) - ALLOCATE(OutData%BlPitchCom(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchCom.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlPitchCom,1), UBOUND(OutData%BlPitchCom,1) - OutData%BlPitchCom(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%YawMom = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenTrq = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HSSBrTrqC = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ED_UnPackInput +subroutine ED_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ED_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackInput' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + if (Buf%ErrStat >= AbortErrLev) return + ! BladePtLoads + call RegPack(Buf, allocated(InData%BladePtLoads)) + if (allocated(InData%BladePtLoads)) then + call RegPackBounds(Buf, 1, lbound(InData%BladePtLoads), ubound(InData%BladePtLoads)) + LB(1:1) = lbound(InData%BladePtLoads) + UB(1:1) = ubound(InData%BladePtLoads) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%BladePtLoads(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PlatformPtMesh + call MeshPack(Buf, InData%PlatformPtMesh) + if (RegCheckErr(Buf, RoutineName)) return + ! TowerPtLoads + call MeshPack(Buf, InData%TowerPtLoads) + if (RegCheckErr(Buf, RoutineName)) return + ! HubPtLoad + call MeshPack(Buf, InData%HubPtLoad) + if (RegCheckErr(Buf, RoutineName)) return + ! NacelleLoads + call MeshPack(Buf, InData%NacelleLoads) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinCMLoads + call MeshPack(Buf, InData%TFinCMLoads) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrAddedMass + call RegPack(Buf, allocated(InData%TwrAddedMass)) + if (allocated(InData%TwrAddedMass)) then + call RegPackBounds(Buf, 3, lbound(InData%TwrAddedMass), ubound(InData%TwrAddedMass)) + call RegPack(Buf, InData%TwrAddedMass) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmAddedMass + call RegPack(Buf, InData%PtfmAddedMass) + if (RegCheckErr(Buf, RoutineName)) return + ! BlPitchCom + call RegPack(Buf, allocated(InData%BlPitchCom)) + if (allocated(InData%BlPitchCom)) then + call RegPackBounds(Buf, 1, lbound(InData%BlPitchCom), ubound(InData%BlPitchCom)) + call RegPack(Buf, InData%BlPitchCom) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! YawMom + call RegPack(Buf, InData%YawMom) + if (RegCheckErr(Buf, RoutineName)) return + ! GenTrq + call RegPack(Buf, InData%GenTrq) + if (RegCheckErr(Buf, RoutineName)) return + ! HSSBrTrqC + call RegPack(Buf, InData%HSSBrTrqC) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ED_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ED_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackInput' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! BladePtLoads + if (allocated(OutData%BladePtLoads)) deallocate(OutData%BladePtLoads) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BladePtLoads(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladePtLoads.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%BladePtLoads(i1)) ! BladePtLoads + end do + end if + ! PlatformPtMesh + call MeshUnpack(Buf, OutData%PlatformPtMesh) ! PlatformPtMesh + ! TowerPtLoads + call MeshUnpack(Buf, OutData%TowerPtLoads) ! TowerPtLoads + ! HubPtLoad + call MeshUnpack(Buf, OutData%HubPtLoad) ! HubPtLoad + ! NacelleLoads + call MeshUnpack(Buf, OutData%NacelleLoads) ! NacelleLoads + ! TFinCMLoads + call MeshUnpack(Buf, OutData%TFinCMLoads) ! TFinCMLoads + ! TwrAddedMass + if (allocated(OutData%TwrAddedMass)) deallocate(OutData%TwrAddedMass) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TwrAddedMass(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrAddedMass.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TwrAddedMass) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PtfmAddedMass + call RegUnpack(Buf, OutData%PtfmAddedMass) + if (RegCheckErr(Buf, RoutineName)) return + ! BlPitchCom + if (allocated(OutData%BlPitchCom)) deallocate(OutData%BlPitchCom) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlPitchCom(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchCom.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlPitchCom) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! YawMom + call RegUnpack(Buf, OutData%YawMom) + if (RegCheckErr(Buf, RoutineName)) return + ! GenTrq + call RegUnpack(Buf, OutData%GenTrq) + if (RegCheckErr(Buf, RoutineName)) return + ! HSSBrTrqC + call RegUnpack(Buf, OutData%HSSBrTrqC) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE ED_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(ED_OutputType), INTENT(INOUT) :: SrcOutputData TYPE(ED_OutputType), INTENT(INOUT) :: DstOutputData @@ -21499,1323 +13358,325 @@ SUBROUTINE ED_DestroyOutput( OutputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE ED_DestroyOutput - SUBROUTINE ED_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ED_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! BladeLn2Mesh allocated yes/no - IF ( ALLOCATED(InData%BladeLn2Mesh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladeLn2Mesh upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%BladeLn2Mesh,1), UBOUND(InData%BladeLn2Mesh,1) - Int_BufSz = Int_BufSz + 3 ! BladeLn2Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%BladeLn2Mesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BladeLn2Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeLn2Mesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeLn2Mesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeLn2Mesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! PlatformPtMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%PlatformPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PlatformPtMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PlatformPtMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PlatformPtMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PlatformPtMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! TowerLn2Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%TowerLn2Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TowerLn2Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TowerLn2Mesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TowerLn2Mesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TowerLn2Mesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! HubPtMotion14: size of buffers for each call to pack subtype - CALL MeshPack( InData%HubPtMotion14, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! HubPtMotion14 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! HubPtMotion14 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! HubPtMotion14 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! HubPtMotion14 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! HubPtMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%HubPtMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! HubPtMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! HubPtMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! HubPtMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! HubPtMotion - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! BladeRootMotion14: size of buffers for each call to pack subtype - CALL MeshPack( InData%BladeRootMotion14, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BladeRootMotion14 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeRootMotion14 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeRootMotion14 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeRootMotion14 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! BladeRootMotion allocated yes/no - IF ( ALLOCATED(InData%BladeRootMotion) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladeRootMotion upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BladeRootMotion,1), UBOUND(InData%BladeRootMotion,1) - Int_BufSz = Int_BufSz + 3 ! BladeRootMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%BladeRootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BladeRootMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeRootMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeRootMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeRootMotion - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! RotorFurlMotion14: size of buffers for each call to pack subtype - CALL MeshPack( InData%RotorFurlMotion14, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! RotorFurlMotion14 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! RotorFurlMotion14 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! RotorFurlMotion14 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! RotorFurlMotion14 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! NacelleMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%NacelleMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! NacelleMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NacelleMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NacelleMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NacelleMotion - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! TowerBaseMotion14: size of buffers for each call to pack subtype - CALL MeshPack( InData%TowerBaseMotion14, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TowerBaseMotion14 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TowerBaseMotion14 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TowerBaseMotion14 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TowerBaseMotion14 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! TFinCMMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%TFinCMMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TFinCMMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TFinCMMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TFinCMMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TFinCMMotion - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutput allocated yes/no - IF ( ALLOCATED(InData%WriteOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutput upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WriteOutput) ! WriteOutput - END IF - Int_BufSz = Int_BufSz + 1 ! BlPitch allocated yes/no - IF ( ALLOCATED(InData%BlPitch) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlPitch upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlPitch) ! BlPitch - END IF - Re_BufSz = Re_BufSz + 1 ! Yaw - Re_BufSz = Re_BufSz + 1 ! YawRate - Re_BufSz = Re_BufSz + 1 ! LSS_Spd - Re_BufSz = Re_BufSz + 1 ! HSS_Spd - Re_BufSz = Re_BufSz + 1 ! RotSpeed - Re_BufSz = Re_BufSz + 1 ! TwrAccel - Re_BufSz = Re_BufSz + 1 ! YawAngle - Re_BufSz = Re_BufSz + SIZE(InData%RootMyc) ! RootMyc - Re_BufSz = Re_BufSz + 1 ! YawBrTAxp - Re_BufSz = Re_BufSz + 1 ! YawBrTAyp - Re_BufSz = Re_BufSz + 1 ! LSSTipPxa - Re_BufSz = Re_BufSz + SIZE(InData%RootMxc) ! RootMxc - Re_BufSz = Re_BufSz + 1 ! LSSTipMxa - Re_BufSz = Re_BufSz + 1 ! LSSTipMya - Re_BufSz = Re_BufSz + 1 ! LSSTipMza - Re_BufSz = Re_BufSz + 1 ! LSSTipMys - Re_BufSz = Re_BufSz + 1 ! LSSTipMzs - Re_BufSz = Re_BufSz + 1 ! YawBrMyn - Re_BufSz = Re_BufSz + 1 ! YawBrMzn - Re_BufSz = Re_BufSz + 1 ! NcIMURAxs - Re_BufSz = Re_BufSz + 1 ! NcIMURAys - Re_BufSz = Re_BufSz + 1 ! NcIMURAzs - Re_BufSz = Re_BufSz + 1 ! RotPwr - Re_BufSz = Re_BufSz + 1 ! LSShftFxa - Re_BufSz = Re_BufSz + 1 ! LSShftFys - Re_BufSz = Re_BufSz + 1 ! LSShftFzs - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%BladeLn2Mesh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeLn2Mesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeLn2Mesh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BladeLn2Mesh,1), UBOUND(InData%BladeLn2Mesh,1) - CALL MeshPack( InData%BladeLn2Mesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BladeLn2Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL MeshPack( InData%PlatformPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PlatformPtMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MeshPack( InData%TowerLn2Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TowerLn2Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MeshPack( InData%HubPtMotion14, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! HubPtMotion14 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MeshPack( InData%HubPtMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! HubPtMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MeshPack( InData%BladeRootMotion14, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BladeRootMotion14 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%BladeRootMotion) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootMotion,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootMotion,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BladeRootMotion,1), UBOUND(InData%BladeRootMotion,1) - CALL MeshPack( InData%BladeRootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BladeRootMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL MeshPack( InData%RotorFurlMotion14, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! RotorFurlMotion14 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MeshPack( InData%NacelleMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! NacelleMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MeshPack( InData%TowerBaseMotion14, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TowerBaseMotion14 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MeshPack( InData%TFinCMMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TFinCMMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) - ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlPitch) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlPitch,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitch,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlPitch,1), UBOUND(InData%BlPitch,1) - ReKiBuf(Re_Xferred) = InData%BlPitch(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%Yaw - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawRate - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSS_Spd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HSS_Spd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RotSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TwrAccel - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawAngle - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%RootMyc,1), UBOUND(InData%RootMyc,1) - ReKiBuf(Re_Xferred) = InData%RootMyc(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%YawBrTAxp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawBrTAyp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSSTipPxa - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%RootMxc,1), UBOUND(InData%RootMxc,1) - ReKiBuf(Re_Xferred) = InData%RootMxc(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%LSSTipMxa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSSTipMya - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSSTipMza - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSSTipMys - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSSTipMzs - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawBrMyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawBrMzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NcIMURAxs - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NcIMURAys - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NcIMURAzs - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RotPwr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSShftFxa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSShftFys - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSShftFzs - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ED_PackOutput - - SUBROUTINE ED_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ED_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeLn2Mesh not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BladeLn2Mesh)) DEALLOCATE(OutData%BladeLn2Mesh) - ALLOCATE(OutData%BladeLn2Mesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeLn2Mesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladeLn2Mesh,1), UBOUND(OutData%BladeLn2Mesh,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%BladeLn2Mesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BladeLn2Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%PlatformPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PlatformPtMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%TowerLn2Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TowerLn2Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%HubPtMotion14, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! HubPtMotion14 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%HubPtMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! HubPtMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%BladeRootMotion14, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BladeRootMotion14 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeRootMotion not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BladeRootMotion)) DEALLOCATE(OutData%BladeRootMotion) - ALLOCATE(OutData%BladeRootMotion(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootMotion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladeRootMotion,1), UBOUND(OutData%BladeRootMotion,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%BladeRootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BladeRootMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%RotorFurlMotion14, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! RotorFurlMotion14 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%NacelleMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! NacelleMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%TowerBaseMotion14, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TowerBaseMotion14 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%TFinCMMotion, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TFinCMMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutput)) DEALLOCATE(OutData%WriteOutput) - ALLOCATE(OutData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) - OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitch not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlPitch)) DEALLOCATE(OutData%BlPitch) - ALLOCATE(OutData%BlPitch(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitch.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlPitch,1), UBOUND(OutData%BlPitch,1) - OutData%BlPitch(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Yaw = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawRate = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSS_Spd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HSS_Spd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RotSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TwrAccel = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawAngle = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%RootMyc,1) - i1_u = UBOUND(OutData%RootMyc,1) - DO i1 = LBOUND(OutData%RootMyc,1), UBOUND(OutData%RootMyc,1) - OutData%RootMyc(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%YawBrTAxp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrTAyp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipPxa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%RootMxc,1) - i1_u = UBOUND(OutData%RootMxc,1) - DO i1 = LBOUND(OutData%RootMxc,1), UBOUND(OutData%RootMxc,1) - OutData%RootMxc(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%LSSTipMxa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMya = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMza = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMys = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMzs = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrMyn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrMzn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMURAxs = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMURAys = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMURAzs = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RotPwr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSShftFxa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSShftFys = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSShftFzs = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ED_UnPackOutput +subroutine ED_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ED_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackOutput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! BladeLn2Mesh + call RegPack(Buf, allocated(InData%BladeLn2Mesh)) + if (allocated(InData%BladeLn2Mesh)) then + call RegPackBounds(Buf, 1, lbound(InData%BladeLn2Mesh), ubound(InData%BladeLn2Mesh)) + LB(1:1) = lbound(InData%BladeLn2Mesh) + UB(1:1) = ubound(InData%BladeLn2Mesh) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%BladeLn2Mesh(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PlatformPtMesh + call MeshPack(Buf, InData%PlatformPtMesh) + if (RegCheckErr(Buf, RoutineName)) return + ! TowerLn2Mesh + call MeshPack(Buf, InData%TowerLn2Mesh) + if (RegCheckErr(Buf, RoutineName)) return + ! HubPtMotion14 + call MeshPack(Buf, InData%HubPtMotion14) + if (RegCheckErr(Buf, RoutineName)) return + ! HubPtMotion + call MeshPack(Buf, InData%HubPtMotion) + if (RegCheckErr(Buf, RoutineName)) return + ! BladeRootMotion14 + call MeshPack(Buf, InData%BladeRootMotion14) + if (RegCheckErr(Buf, RoutineName)) return + ! BladeRootMotion + call RegPack(Buf, allocated(InData%BladeRootMotion)) + if (allocated(InData%BladeRootMotion)) then + call RegPackBounds(Buf, 1, lbound(InData%BladeRootMotion), ubound(InData%BladeRootMotion)) + LB(1:1) = lbound(InData%BladeRootMotion) + UB(1:1) = ubound(InData%BladeRootMotion) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%BladeRootMotion(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RotorFurlMotion14 + call MeshPack(Buf, InData%RotorFurlMotion14) + if (RegCheckErr(Buf, RoutineName)) return + ! NacelleMotion + call MeshPack(Buf, InData%NacelleMotion) + if (RegCheckErr(Buf, RoutineName)) return + ! TowerBaseMotion14 + call MeshPack(Buf, InData%TowerBaseMotion14) + if (RegCheckErr(Buf, RoutineName)) return + ! TFinCMMotion + call MeshPack(Buf, InData%TFinCMMotion) + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutput + call RegPack(Buf, allocated(InData%WriteOutput)) + if (allocated(InData%WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPack(Buf, InData%WriteOutput) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BlPitch + call RegPack(Buf, allocated(InData%BlPitch)) + if (allocated(InData%BlPitch)) then + call RegPackBounds(Buf, 1, lbound(InData%BlPitch), ubound(InData%BlPitch)) + call RegPack(Buf, InData%BlPitch) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Yaw + call RegPack(Buf, InData%Yaw) + if (RegCheckErr(Buf, RoutineName)) return + ! YawRate + call RegPack(Buf, InData%YawRate) + if (RegCheckErr(Buf, RoutineName)) return + ! LSS_Spd + call RegPack(Buf, InData%LSS_Spd) + if (RegCheckErr(Buf, RoutineName)) return + ! HSS_Spd + call RegPack(Buf, InData%HSS_Spd) + if (RegCheckErr(Buf, RoutineName)) return + ! RotSpeed + call RegPack(Buf, InData%RotSpeed) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrAccel + call RegPack(Buf, InData%TwrAccel) + if (RegCheckErr(Buf, RoutineName)) return + ! YawAngle + call RegPack(Buf, InData%YawAngle) + if (RegCheckErr(Buf, RoutineName)) return + ! RootMyc + call RegPack(Buf, InData%RootMyc) + if (RegCheckErr(Buf, RoutineName)) return + ! YawBrTAxp + call RegPack(Buf, InData%YawBrTAxp) + if (RegCheckErr(Buf, RoutineName)) return + ! YawBrTAyp + call RegPack(Buf, InData%YawBrTAyp) + if (RegCheckErr(Buf, RoutineName)) return + ! LSSTipPxa + call RegPack(Buf, InData%LSSTipPxa) + if (RegCheckErr(Buf, RoutineName)) return + ! RootMxc + call RegPack(Buf, InData%RootMxc) + if (RegCheckErr(Buf, RoutineName)) return + ! LSSTipMxa + call RegPack(Buf, InData%LSSTipMxa) + if (RegCheckErr(Buf, RoutineName)) return + ! LSSTipMya + call RegPack(Buf, InData%LSSTipMya) + if (RegCheckErr(Buf, RoutineName)) return + ! LSSTipMza + call RegPack(Buf, InData%LSSTipMza) + if (RegCheckErr(Buf, RoutineName)) return + ! LSSTipMys + call RegPack(Buf, InData%LSSTipMys) + if (RegCheckErr(Buf, RoutineName)) return + ! LSSTipMzs + call RegPack(Buf, InData%LSSTipMzs) + if (RegCheckErr(Buf, RoutineName)) return + ! YawBrMyn + call RegPack(Buf, InData%YawBrMyn) + if (RegCheckErr(Buf, RoutineName)) return + ! YawBrMzn + call RegPack(Buf, InData%YawBrMzn) + if (RegCheckErr(Buf, RoutineName)) return + ! NcIMURAxs + call RegPack(Buf, InData%NcIMURAxs) + if (RegCheckErr(Buf, RoutineName)) return + ! NcIMURAys + call RegPack(Buf, InData%NcIMURAys) + if (RegCheckErr(Buf, RoutineName)) return + ! NcIMURAzs + call RegPack(Buf, InData%NcIMURAzs) + if (RegCheckErr(Buf, RoutineName)) return + ! RotPwr + call RegPack(Buf, InData%RotPwr) + if (RegCheckErr(Buf, RoutineName)) return + ! LSShftFxa + call RegPack(Buf, InData%LSShftFxa) + if (RegCheckErr(Buf, RoutineName)) return + ! LSShftFys + call RegPack(Buf, InData%LSShftFys) + if (RegCheckErr(Buf, RoutineName)) return + ! LSShftFzs + call RegPack(Buf, InData%LSShftFzs) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ED_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ED_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackOutput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! BladeLn2Mesh + if (allocated(OutData%BladeLn2Mesh)) deallocate(OutData%BladeLn2Mesh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BladeLn2Mesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeLn2Mesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%BladeLn2Mesh(i1)) ! BladeLn2Mesh + end do + end if + ! PlatformPtMesh + call MeshUnpack(Buf, OutData%PlatformPtMesh) ! PlatformPtMesh + ! TowerLn2Mesh + call MeshUnpack(Buf, OutData%TowerLn2Mesh) ! TowerLn2Mesh + ! HubPtMotion14 + call MeshUnpack(Buf, OutData%HubPtMotion14) ! HubPtMotion14 + ! HubPtMotion + call MeshUnpack(Buf, OutData%HubPtMotion) ! HubPtMotion + ! BladeRootMotion14 + call MeshUnpack(Buf, OutData%BladeRootMotion14) ! BladeRootMotion14 + ! BladeRootMotion + if (allocated(OutData%BladeRootMotion)) deallocate(OutData%BladeRootMotion) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BladeRootMotion(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootMotion.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%BladeRootMotion(i1)) ! BladeRootMotion + end do + end if + ! RotorFurlMotion14 + call MeshUnpack(Buf, OutData%RotorFurlMotion14) ! RotorFurlMotion14 + ! NacelleMotion + call MeshUnpack(Buf, OutData%NacelleMotion) ! NacelleMotion + ! TowerBaseMotion14 + call MeshUnpack(Buf, OutData%TowerBaseMotion14) ! TowerBaseMotion14 + ! TFinCMMotion + call MeshUnpack(Buf, OutData%TFinCMMotion) ! TFinCMMotion + ! WriteOutput + if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BlPitch + if (allocated(OutData%BlPitch)) deallocate(OutData%BlPitch) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlPitch(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitch.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlPitch) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Yaw + call RegUnpack(Buf, OutData%Yaw) + if (RegCheckErr(Buf, RoutineName)) return + ! YawRate + call RegUnpack(Buf, OutData%YawRate) + if (RegCheckErr(Buf, RoutineName)) return + ! LSS_Spd + call RegUnpack(Buf, OutData%LSS_Spd) + if (RegCheckErr(Buf, RoutineName)) return + ! HSS_Spd + call RegUnpack(Buf, OutData%HSS_Spd) + if (RegCheckErr(Buf, RoutineName)) return + ! RotSpeed + call RegUnpack(Buf, OutData%RotSpeed) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrAccel + call RegUnpack(Buf, OutData%TwrAccel) + if (RegCheckErr(Buf, RoutineName)) return + ! YawAngle + call RegUnpack(Buf, OutData%YawAngle) + if (RegCheckErr(Buf, RoutineName)) return + ! RootMyc + call RegUnpack(Buf, OutData%RootMyc) + if (RegCheckErr(Buf, RoutineName)) return + ! YawBrTAxp + call RegUnpack(Buf, OutData%YawBrTAxp) + if (RegCheckErr(Buf, RoutineName)) return + ! YawBrTAyp + call RegUnpack(Buf, OutData%YawBrTAyp) + if (RegCheckErr(Buf, RoutineName)) return + ! LSSTipPxa + call RegUnpack(Buf, OutData%LSSTipPxa) + if (RegCheckErr(Buf, RoutineName)) return + ! RootMxc + call RegUnpack(Buf, OutData%RootMxc) + if (RegCheckErr(Buf, RoutineName)) return + ! LSSTipMxa + call RegUnpack(Buf, OutData%LSSTipMxa) + if (RegCheckErr(Buf, RoutineName)) return + ! LSSTipMya + call RegUnpack(Buf, OutData%LSSTipMya) + if (RegCheckErr(Buf, RoutineName)) return + ! LSSTipMza + call RegUnpack(Buf, OutData%LSSTipMza) + if (RegCheckErr(Buf, RoutineName)) return + ! LSSTipMys + call RegUnpack(Buf, OutData%LSSTipMys) + if (RegCheckErr(Buf, RoutineName)) return + ! LSSTipMzs + call RegUnpack(Buf, OutData%LSSTipMzs) + if (RegCheckErr(Buf, RoutineName)) return + ! YawBrMyn + call RegUnpack(Buf, OutData%YawBrMyn) + if (RegCheckErr(Buf, RoutineName)) return + ! YawBrMzn + call RegUnpack(Buf, OutData%YawBrMzn) + if (RegCheckErr(Buf, RoutineName)) return + ! NcIMURAxs + call RegUnpack(Buf, OutData%NcIMURAxs) + if (RegCheckErr(Buf, RoutineName)) return + ! NcIMURAys + call RegUnpack(Buf, OutData%NcIMURAys) + if (RegCheckErr(Buf, RoutineName)) return + ! NcIMURAzs + call RegUnpack(Buf, OutData%NcIMURAzs) + if (RegCheckErr(Buf, RoutineName)) return + ! RotPwr + call RegUnpack(Buf, OutData%RotPwr) + if (RegCheckErr(Buf, RoutineName)) return + ! LSShftFxa + call RegUnpack(Buf, OutData%LSShftFxa) + if (RegCheckErr(Buf, RoutineName)) return + ! LSShftFys + call RegUnpack(Buf, OutData%LSShftFys) + if (RegCheckErr(Buf, RoutineName)) return + ! LSShftFzs + call RegUnpack(Buf, OutData%LSShftFzs) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE ED_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) ! diff --git a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 index 6a6332cdb3..f517d60d61 100644 --- a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 +++ b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 @@ -190,126 +190,44 @@ SUBROUTINE ExtPtfm_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) END SUBROUTINE ExtPtfm_DestroyInitInput - SUBROUTINE ExtPtfm_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ExtPtfm_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%InputFile) ! InputFile - Int_BufSz = Int_BufSz + 1 ! Linearize - Re_BufSz = Re_BufSz + 1 ! PtfmRefzt - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmRefzt - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE ExtPtfm_PackInitInput - - SUBROUTINE ExtPtfm_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ExtPtfm_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmRefzt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE ExtPtfm_UnPackInitInput +subroutine ExtPtfm_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtPtfm_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + ! InputFile + call RegPack(Buf, InData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! Linearize + call RegPack(Buf, InData%Linearize) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmRefzt + call RegPack(Buf, InData%PtfmRefzt) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegPack(Buf, InData%RootName) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ExtPtfm_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtPtfm_UnPackInitInput' + if (Buf%ErrStat /= ErrID_None) return + ! InputFile + call RegUnpack(Buf, OutData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! Linearize + call RegUnpack(Buf, OutData%Linearize) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmRefzt + call RegUnpack(Buf, OutData%PtfmRefzt) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE ExtPtfm_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) TYPE(ExtPtfm_InputFile), INTENT(IN) :: SrcInputFileData TYPE(ExtPtfm_InputFile), INTENT(INOUT) :: DstInputFileData @@ -414,327 +332,183 @@ SUBROUTINE ExtPtfm_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE ExtPtfm_DestroyInputFile - SUBROUTINE ExtPtfm_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ExtPtfm_InputFile), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_PackInputFile' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! DT - Int_BufSz = Int_BufSz + 1 ! IntMethod - Int_BufSz = Int_BufSz + 1 ! FileFormat - Int_BufSz = Int_BufSz + 1*LEN(InData%RedFile) ! RedFile - Int_BufSz = Int_BufSz + 1*LEN(InData%RedFileCst) ! RedFileCst - Int_BufSz = Int_BufSz + 1 ! EquilStart - Int_BufSz = Int_BufSz + 1 ! ActiveCBDOF allocated yes/no - IF ( ALLOCATED(InData%ActiveCBDOF) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ActiveCBDOF upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ActiveCBDOF) ! ActiveCBDOF - END IF - Int_BufSz = Int_BufSz + 1 ! InitPosList allocated yes/no - IF ( ALLOCATED(InData%InitPosList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InitPosList upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%InitPosList) ! InitPosList - END IF - Int_BufSz = Int_BufSz + 1 ! InitVelList allocated yes/no - IF ( ALLOCATED(InData%InitVelList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InitVelList upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%InitVelList) ! InitVelList - END IF - Int_BufSz = Int_BufSz + 1 ! SumPrint - Int_BufSz = Int_BufSz + 1 ! OutFile - Int_BufSz = Int_BufSz + 1 ! TabDelim - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt - Db_BufSz = Db_BufSz + 1 ! Tstart - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! OutList allocated yes/no - IF ( ALLOCATED(InData%OutList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%OutList)*LEN(InData%OutList) ! OutList - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%IntMethod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%FileFormat - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RedFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%RedFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%RedFileCst) - IntKiBuf(Int_Xferred) = ICHAR(InData%RedFileCst(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%EquilStart, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%ActiveCBDOF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ActiveCBDOF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ActiveCBDOF,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ActiveCBDOF,1), UBOUND(InData%ActiveCBDOF,1) - IntKiBuf(Int_Xferred) = InData%ActiveCBDOF(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InitPosList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitPosList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitPosList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InitPosList,1), UBOUND(InData%InitPosList,1) - ReKiBuf(Re_Xferred) = InData%InitPosList(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InitVelList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitVelList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitVelList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InitVelList,1), UBOUND(InData%InitVelList,1) - ReKiBuf(Re_Xferred) = InData%InitVelList(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%OutFile - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TabDelim, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf(Db_Xferred) = InData%Tstart - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) - DO I = 1, LEN(InData%OutList) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - END SUBROUTINE ExtPtfm_PackInputFile - - SUBROUTINE ExtPtfm_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ExtPtfm_InputFile), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_UnPackInputFile' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%IntMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FileFormat = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RedFile) - OutData%RedFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%RedFileCst) - OutData%RedFileCst(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%EquilStart = TRANSFER(IntKiBuf(Int_Xferred), OutData%EquilStart) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ActiveCBDOF not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ActiveCBDOF)) DEALLOCATE(OutData%ActiveCBDOF) - ALLOCATE(OutData%ActiveCBDOF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ActiveCBDOF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ActiveCBDOF,1), UBOUND(OutData%ActiveCBDOF,1) - OutData%ActiveCBDOF(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InitPosList not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InitPosList)) DEALLOCATE(OutData%InitPosList) - ALLOCATE(OutData%InitPosList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitPosList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InitPosList,1), UBOUND(OutData%InitPosList,1) - OutData%InitPosList(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InitVelList not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InitVelList)) DEALLOCATE(OutData%InitVelList) - ALLOCATE(OutData%InitVelList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitVelList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InitVelList,1), UBOUND(OutData%InitVelList,1) - OutData%InitVelList(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) - Int_Xferred = Int_Xferred + 1 - OutData%OutFile = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TabDelim = TRANSFER(IntKiBuf(Int_Xferred), OutData%TabDelim) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Tstart = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutList not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutList)) DEALLOCATE(OutData%OutList) - ALLOCATE(OutData%OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) - DO I = 1, LEN(OutData%OutList) - OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - END SUBROUTINE ExtPtfm_UnPackInputFile +subroutine ExtPtfm_PackInputFile(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_InputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtPtfm_PackInputFile' + if (Buf%ErrStat >= AbortErrLev) return + ! DT + call RegPack(Buf, InData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! IntMethod + call RegPack(Buf, InData%IntMethod) + if (RegCheckErr(Buf, RoutineName)) return + ! FileFormat + call RegPack(Buf, InData%FileFormat) + if (RegCheckErr(Buf, RoutineName)) return + ! RedFile + call RegPack(Buf, InData%RedFile) + if (RegCheckErr(Buf, RoutineName)) return + ! RedFileCst + call RegPack(Buf, InData%RedFileCst) + if (RegCheckErr(Buf, RoutineName)) return + ! EquilStart + call RegPack(Buf, InData%EquilStart) + if (RegCheckErr(Buf, RoutineName)) return + ! ActiveCBDOF + call RegPack(Buf, allocated(InData%ActiveCBDOF)) + if (allocated(InData%ActiveCBDOF)) then + call RegPackBounds(Buf, 1, lbound(InData%ActiveCBDOF), ubound(InData%ActiveCBDOF)) + call RegPack(Buf, InData%ActiveCBDOF) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! InitPosList + call RegPack(Buf, allocated(InData%InitPosList)) + if (allocated(InData%InitPosList)) then + call RegPackBounds(Buf, 1, lbound(InData%InitPosList), ubound(InData%InitPosList)) + call RegPack(Buf, InData%InitPosList) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! InitVelList + call RegPack(Buf, allocated(InData%InitVelList)) + if (allocated(InData%InitVelList)) then + call RegPackBounds(Buf, 1, lbound(InData%InitVelList), ubound(InData%InitVelList)) + call RegPack(Buf, InData%InitVelList) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SumPrint + call RegPack(Buf, InData%SumPrint) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFile + call RegPack(Buf, InData%OutFile) + if (RegCheckErr(Buf, RoutineName)) return + ! TabDelim + call RegPack(Buf, InData%TabDelim) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFmt + call RegPack(Buf, InData%OutFmt) + if (RegCheckErr(Buf, RoutineName)) return + ! Tstart + call RegPack(Buf, InData%Tstart) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegPack(Buf, InData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! OutList + call RegPack(Buf, allocated(InData%OutList)) + if (allocated(InData%OutList)) then + call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) + call RegPack(Buf, InData%OutList) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ExtPtfm_UnPackInputFile(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_InputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtPtfm_UnPackInputFile' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! DT + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! IntMethod + call RegUnpack(Buf, OutData%IntMethod) + if (RegCheckErr(Buf, RoutineName)) return + ! FileFormat + call RegUnpack(Buf, OutData%FileFormat) + if (RegCheckErr(Buf, RoutineName)) return + ! RedFile + call RegUnpack(Buf, OutData%RedFile) + if (RegCheckErr(Buf, RoutineName)) return + ! RedFileCst + call RegUnpack(Buf, OutData%RedFileCst) + if (RegCheckErr(Buf, RoutineName)) return + ! EquilStart + call RegUnpack(Buf, OutData%EquilStart) + if (RegCheckErr(Buf, RoutineName)) return + ! ActiveCBDOF + if (allocated(OutData%ActiveCBDOF)) deallocate(OutData%ActiveCBDOF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ActiveCBDOF(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ActiveCBDOF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ActiveCBDOF) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! InitPosList + if (allocated(OutData%InitPosList)) deallocate(OutData%InitPosList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InitPosList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitPosList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InitPosList) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! InitVelList + if (allocated(OutData%InitVelList)) deallocate(OutData%InitVelList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InitVelList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitVelList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InitVelList) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! SumPrint + call RegUnpack(Buf, OutData%SumPrint) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFile + call RegUnpack(Buf, OutData%OutFile) + if (RegCheckErr(Buf, RoutineName)) return + ! TabDelim + call RegUnpack(Buf, OutData%TabDelim) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFmt + call RegUnpack(Buf, OutData%OutFmt) + if (RegCheckErr(Buf, RoutineName)) return + ! Tstart + call RegUnpack(Buf, OutData%Tstart) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! OutList + if (allocated(OutData%OutList)) deallocate(OutData%OutList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutList) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE ExtPtfm_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(ExtPtfm_InitOutputType), INTENT(IN) :: SrcInitOutputData TYPE(ExtPtfm_InitOutputType), INTENT(INOUT) :: DstInitOutputData @@ -922,585 +696,248 @@ SUBROUTINE ExtPtfm_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE ExtPtfm_DestroyInitOutput - SUBROUTINE ExtPtfm_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ExtPtfm_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputHdr allocated yes/no - IF ( ALLOCATED(InData%WriteOutputHdr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdr upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdr)*LEN(InData%WriteOutputHdr) ! WriteOutputHdr - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputUnt allocated yes/no - IF ( ALLOCATED(InData%WriteOutputUnt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUnt upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUnt)*LEN(InData%WriteOutputUnt) ! WriteOutputUnt - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_y allocated yes/no - IF ( ALLOCATED(InData%LinNames_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_y)*LEN(InData%LinNames_y) ! LinNames_y - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_x allocated yes/no - IF ( ALLOCATED(InData%LinNames_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_x)*LEN(InData%LinNames_x) ! LinNames_x - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_u allocated yes/no - IF ( ALLOCATED(InData%LinNames_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_u)*LEN(InData%LinNames_u) ! LinNames_u - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_y allocated yes/no - IF ( ALLOCATED(InData%RotFrame_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_y) ! RotFrame_y - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_x allocated yes/no - IF ( ALLOCATED(InData%RotFrame_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_x) ! RotFrame_x - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_u allocated yes/no - IF ( ALLOCATED(InData%RotFrame_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_u) ! RotFrame_u - END IF - Int_BufSz = Int_BufSz + 1 ! IsLoad_u allocated yes/no - IF ( ALLOCATED(InData%IsLoad_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IsLoad_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IsLoad_u) ! IsLoad_u - END IF - Int_BufSz = Int_BufSz + 1 ! DerivOrder_x allocated yes/no - IF ( ALLOCATED(InData%DerivOrder_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DerivOrder_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%DerivOrder_x) ! DerivOrder_x - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%WriteOutputHdr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) - DO I = 1, LEN(InData%WriteOutputHdr) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputUnt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) - DO I = 1, LEN(InData%WriteOutputUnt) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinNames_y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) - DO I = 1, LEN(InData%LinNames_y) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_y(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinNames_x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_x,1), UBOUND(InData%LinNames_x,1) - DO I = 1, LEN(InData%LinNames_x) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_x(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinNames_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) - DO I = 1, LEN(InData%LinNames_u) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_u(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_y,1), UBOUND(InData%RotFrame_y,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_y(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_x,1), UBOUND(InData%RotFrame_x,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_x(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_u,1), UBOUND(InData%RotFrame_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IsLoad_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IsLoad_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DerivOrder_x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DerivOrder_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DerivOrder_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DerivOrder_x,1), UBOUND(InData%DerivOrder_x,1) - IntKiBuf(Int_Xferred) = InData%DerivOrder_x(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE ExtPtfm_PackInitOutput - - SUBROUTINE ExtPtfm_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ExtPtfm_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputHdr)) DEALLOCATE(OutData%WriteOutputHdr) - ALLOCATE(OutData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) - DO I = 1, LEN(OutData%WriteOutputHdr) - OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputUnt)) DEALLOCATE(OutData%WriteOutputUnt) - ALLOCATE(OutData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) - DO I = 1, LEN(OutData%WriteOutputUnt) - OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LinNames_y)) DEALLOCATE(OutData%LinNames_y) - ALLOCATE(OutData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) - DO I = 1, LEN(OutData%LinNames_y) - OutData%LinNames_y(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LinNames_x)) DEALLOCATE(OutData%LinNames_x) - ALLOCATE(OutData%LinNames_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_x,1), UBOUND(OutData%LinNames_x,1) - DO I = 1, LEN(OutData%LinNames_x) - OutData%LinNames_x(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LinNames_u)) DEALLOCATE(OutData%LinNames_u) - ALLOCATE(OutData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) - DO I = 1, LEN(OutData%LinNames_u) - OutData%LinNames_u(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RotFrame_y)) DEALLOCATE(OutData%RotFrame_y) - ALLOCATE(OutData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_y,1), UBOUND(OutData%RotFrame_y,1) - OutData%RotFrame_y(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_y(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RotFrame_x)) DEALLOCATE(OutData%RotFrame_x) - ALLOCATE(OutData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_x,1), UBOUND(OutData%RotFrame_x,1) - OutData%RotFrame_x(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_x(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RotFrame_u)) DEALLOCATE(OutData%RotFrame_u) - ALLOCATE(OutData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_u,1), UBOUND(OutData%RotFrame_u,1) - OutData%RotFrame_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IsLoad_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IsLoad_u)) DEALLOCATE(OutData%IsLoad_u) - ALLOCATE(OutData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) - OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DerivOrder_x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DerivOrder_x)) DEALLOCATE(OutData%DerivOrder_x) - ALLOCATE(OutData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DerivOrder_x,1), UBOUND(OutData%DerivOrder_x,1) - OutData%DerivOrder_x(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE ExtPtfm_UnPackInitOutput +subroutine ExtPtfm_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtPtfm_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! Ver + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutputHdr + call RegPack(Buf, allocated(InData%WriteOutputHdr)) + if (allocated(InData%WriteOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPack(Buf, InData%WriteOutputHdr) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutputUnt + call RegPack(Buf, allocated(InData%WriteOutputUnt)) + if (allocated(InData%WriteOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPack(Buf, InData%WriteOutputUnt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LinNames_y + call RegPack(Buf, allocated(InData%LinNames_y)) + if (allocated(InData%LinNames_y)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) + call RegPack(Buf, InData%LinNames_y) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LinNames_x + call RegPack(Buf, allocated(InData%LinNames_x)) + if (allocated(InData%LinNames_x)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_x), ubound(InData%LinNames_x)) + call RegPack(Buf, InData%LinNames_x) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LinNames_u + call RegPack(Buf, allocated(InData%LinNames_u)) + if (allocated(InData%LinNames_u)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) + call RegPack(Buf, InData%LinNames_u) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RotFrame_y + call RegPack(Buf, allocated(InData%RotFrame_y)) + if (allocated(InData%RotFrame_y)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y), ubound(InData%RotFrame_y)) + call RegPack(Buf, InData%RotFrame_y) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RotFrame_x + call RegPack(Buf, allocated(InData%RotFrame_x)) + if (allocated(InData%RotFrame_x)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x), ubound(InData%RotFrame_x)) + call RegPack(Buf, InData%RotFrame_x) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RotFrame_u + call RegPack(Buf, allocated(InData%RotFrame_u)) + if (allocated(InData%RotFrame_u)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u), ubound(InData%RotFrame_u)) + call RegPack(Buf, InData%RotFrame_u) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! IsLoad_u + call RegPack(Buf, allocated(InData%IsLoad_u)) + if (allocated(InData%IsLoad_u)) then + call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) + call RegPack(Buf, InData%IsLoad_u) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DerivOrder_x + call RegPack(Buf, allocated(InData%DerivOrder_x)) + if (allocated(InData%DerivOrder_x)) then + call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x), ubound(InData%DerivOrder_x)) + call RegPack(Buf, InData%DerivOrder_x) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ExtPtfm_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtPtfm_UnPackInitOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! Ver + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + ! WriteOutputHdr + if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WriteOutputUnt + if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LinNames_y + if (allocated(OutData%LinNames_y)) deallocate(OutData%LinNames_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LinNames_x + if (allocated(OutData%LinNames_x)) deallocate(OutData%LinNames_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LinNames_u + if (allocated(OutData%LinNames_u)) deallocate(OutData%LinNames_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RotFrame_y + if (allocated(OutData%RotFrame_y)) deallocate(OutData%RotFrame_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RotFrame_x + if (allocated(OutData%RotFrame_x)) deallocate(OutData%RotFrame_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RotFrame_u + if (allocated(OutData%RotFrame_u)) deallocate(OutData%RotFrame_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! IsLoad_u + if (allocated(OutData%IsLoad_u)) deallocate(OutData%IsLoad_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IsLoad_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IsLoad_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! DerivOrder_x + if (allocated(OutData%DerivOrder_x)) deallocate(OutData%DerivOrder_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DerivOrder_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DerivOrder_x) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE ExtPtfm_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(ExtPtfm_ContinuousStateType), INTENT(IN) :: SrcContStateData TYPE(ExtPtfm_ContinuousStateType), INTENT(INOUT) :: DstContStateData @@ -1563,175 +1000,67 @@ SUBROUTINE ExtPtfm_DestroyContState( ContStateData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE ExtPtfm_DestroyContState - SUBROUTINE ExtPtfm_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ExtPtfm_ContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_PackContState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! qm allocated yes/no - IF ( ALLOCATED(InData%qm) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! qm upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%qm) ! qm - END IF - Int_BufSz = Int_BufSz + 1 ! qmdot allocated yes/no - IF ( ALLOCATED(InData%qmdot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! qmdot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%qmdot) ! qmdot - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%qm) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%qm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%qm,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%qm,1), UBOUND(InData%qm,1) - ReKiBuf(Re_Xferred) = InData%qm(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%qmdot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%qmdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%qmdot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%qmdot,1), UBOUND(InData%qmdot,1) - ReKiBuf(Re_Xferred) = InData%qmdot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE ExtPtfm_PackContState - - SUBROUTINE ExtPtfm_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ExtPtfm_ContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_UnPackContState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! qm not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%qm)) DEALLOCATE(OutData%qm) - ALLOCATE(OutData%qm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%qm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%qm,1), UBOUND(OutData%qm,1) - OutData%qm(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! qmdot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%qmdot)) DEALLOCATE(OutData%qmdot) - ALLOCATE(OutData%qmdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%qmdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%qmdot,1), UBOUND(OutData%qmdot,1) - OutData%qmdot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE ExtPtfm_UnPackContState +subroutine ExtPtfm_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtPtfm_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + ! qm + call RegPack(Buf, allocated(InData%qm)) + if (allocated(InData%qm)) then + call RegPackBounds(Buf, 1, lbound(InData%qm), ubound(InData%qm)) + call RegPack(Buf, InData%qm) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! qmdot + call RegPack(Buf, allocated(InData%qmdot)) + if (allocated(InData%qmdot)) then + call RegPackBounds(Buf, 1, lbound(InData%qmdot), ubound(InData%qmdot)) + call RegPack(Buf, InData%qmdot) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ExtPtfm_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtPtfm_UnPackContState' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! qm + if (allocated(OutData%qm)) deallocate(OutData%qm) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%qm(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%qm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%qm) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! qmdot + if (allocated(OutData%qmdot)) deallocate(OutData%qmdot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%qmdot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%qmdot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%qmdot) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE ExtPtfm_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(ExtPtfm_DiscreteStateType), INTENT(IN) :: SrcDiscStateData TYPE(ExtPtfm_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData @@ -1764,103 +1093,26 @@ SUBROUTINE ExtPtfm_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) END SUBROUTINE ExtPtfm_DestroyDiscState - SUBROUTINE ExtPtfm_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ExtPtfm_DiscreteStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_PackDiscState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyDiscState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ExtPtfm_PackDiscState - - SUBROUTINE ExtPtfm_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ExtPtfm_DiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_UnPackDiscState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyDiscState = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ExtPtfm_UnPackDiscState +subroutine ExtPtfm_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtPtfm_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyDiscState + call RegPack(Buf, InData%DummyDiscState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ExtPtfm_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtPtfm_UnPackDiscState' + if (Buf%ErrStat /= ErrID_None) return + ! DummyDiscState + call RegUnpack(Buf, OutData%DummyDiscState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE ExtPtfm_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(ExtPtfm_ConstraintStateType), INTENT(IN) :: SrcConstrStateData TYPE(ExtPtfm_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData @@ -1893,103 +1145,26 @@ SUBROUTINE ExtPtfm_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) END SUBROUTINE ExtPtfm_DestroyConstrState - SUBROUTINE ExtPtfm_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ExtPtfm_ConstraintStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_PackConstrState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyConstrState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ExtPtfm_PackConstrState - - SUBROUTINE ExtPtfm_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ExtPtfm_ConstraintStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_UnPackConstrState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyConstrState = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE ExtPtfm_UnPackConstrState +subroutine ExtPtfm_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtPtfm_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyConstrState + call RegPack(Buf, InData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ExtPtfm_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtPtfm_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + ! DummyConstrState + call RegUnpack(Buf, OutData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE ExtPtfm_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(ExtPtfm_OtherStateType), INTENT(IN) :: SrcOtherStateData TYPE(ExtPtfm_OtherStateType), INTENT(INOUT) :: DstOtherStateData @@ -2046,225 +1221,59 @@ SUBROUTINE ExtPtfm_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE ExtPtfm_DestroyOtherState - SUBROUTINE ExtPtfm_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ExtPtfm_OtherStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_PackOtherState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! xdot allocated yes/no - IF ( ALLOCATED(InData%xdot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xdot upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) - Int_BufSz = Int_BufSz + 3 ! xdot: size of buffers for each call to pack subtype - CALL ExtPtfm_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xdot - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xdot - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xdot - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xdot - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! n - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%xdot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xdot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) - CALL ExtPtfm_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, OnlySize ) ! xdot - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IntKiBuf(Int_Xferred) = InData%n - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE ExtPtfm_PackOtherState - - SUBROUTINE ExtPtfm_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ExtPtfm_OtherStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_UnPackOtherState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xdot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%xdot)) DEALLOCATE(OutData%xdot) - ALLOCATE(OutData%xdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%xdot,1), UBOUND(OutData%xdot,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ExtPtfm_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%xdot(i1), ErrStat2, ErrMsg2 ) ! xdot - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - OutData%n = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE ExtPtfm_UnPackOtherState +subroutine ExtPtfm_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtPtfm_PackOtherState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! xdot + call RegPack(Buf, allocated(InData%xdot)) + if (allocated(InData%xdot)) then + call RegPackBounds(Buf, 1, lbound(InData%xdot), ubound(InData%xdot)) + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) + do i1 = LB(1), UB(1) + call ExtPtfm_PackContState(Buf, InData%xdot(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! n + call RegPack(Buf, InData%n) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ExtPtfm_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtPtfm_UnPackOtherState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! xdot + if (allocated(OutData%xdot)) deallocate(OutData%xdot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xdot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xdot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ExtPtfm_UnpackContState(Buf, OutData%xdot(i1)) ! xdot + end do + end if + ! n + call RegUnpack(Buf, OutData%n) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE ExtPtfm_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) TYPE(ExtPtfm_MiscVarType), INTENT(IN) :: SrcMiscData TYPE(ExtPtfm_MiscVarType), INTENT(INOUT) :: DstMiscData @@ -2345,234 +1354,107 @@ SUBROUTINE ExtPtfm_DestroyMisc( MiscData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE ExtPtfm_DestroyMisc - SUBROUTINE ExtPtfm_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ExtPtfm_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! xFlat allocated yes/no - IF ( ALLOCATED(InData%xFlat) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xFlat upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%xFlat) ! xFlat - END IF - Re_BufSz = Re_BufSz + SIZE(InData%uFlat) ! uFlat - Int_BufSz = Int_BufSz + 1 ! F_at_t allocated yes/no - IF ( ALLOCATED(InData%F_at_t) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! F_at_t upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_at_t) ! F_at_t - END IF - Int_BufSz = Int_BufSz + 1 ! Indx - Int_BufSz = Int_BufSz + 1 ! EquilStart - Int_BufSz = Int_BufSz + 1 ! AllOuts allocated yes/no - IF ( ALLOCATED(InData%AllOuts) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AllOuts upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AllOuts) ! AllOuts - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%xFlat) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xFlat,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xFlat,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xFlat,1), UBOUND(InData%xFlat,1) - ReKiBuf(Re_Xferred) = InData%xFlat(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DO i1 = LBOUND(InData%uFlat,1), UBOUND(InData%uFlat,1) - ReKiBuf(Re_Xferred) = InData%uFlat(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%F_at_t) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_at_t,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_at_t,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%F_at_t,1), UBOUND(InData%F_at_t,1) - ReKiBuf(Re_Xferred) = InData%F_at_t(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%Indx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%EquilStart, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%AllOuts) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AllOuts,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOuts,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AllOuts,1), UBOUND(InData%AllOuts,1) - ReKiBuf(Re_Xferred) = InData%AllOuts(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE ExtPtfm_PackMisc - - SUBROUTINE ExtPtfm_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ExtPtfm_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xFlat not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%xFlat)) DEALLOCATE(OutData%xFlat) - ALLOCATE(OutData%xFlat(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xFlat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%xFlat,1), UBOUND(OutData%xFlat,1) - OutData%xFlat(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - i1_l = LBOUND(OutData%uFlat,1) - i1_u = UBOUND(OutData%uFlat,1) - DO i1 = LBOUND(OutData%uFlat,1), UBOUND(OutData%uFlat,1) - OutData%uFlat(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_at_t not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_at_t)) DEALLOCATE(OutData%F_at_t) - ALLOCATE(OutData%F_at_t(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_at_t.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%F_at_t,1), UBOUND(OutData%F_at_t,1) - OutData%F_at_t(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Indx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%EquilStart = TRANSFER(IntKiBuf(Int_Xferred), OutData%EquilStart) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AllOuts not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AllOuts)) DEALLOCATE(OutData%AllOuts) - ALLOCATE(OutData%AllOuts(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AllOuts,1), UBOUND(OutData%AllOuts,1) - OutData%AllOuts(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE ExtPtfm_UnPackMisc +subroutine ExtPtfm_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtPtfm_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + ! xFlat + call RegPack(Buf, allocated(InData%xFlat)) + if (allocated(InData%xFlat)) then + call RegPackBounds(Buf, 1, lbound(InData%xFlat), ubound(InData%xFlat)) + call RegPack(Buf, InData%xFlat) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! uFlat + call RegPack(Buf, InData%uFlat) + if (RegCheckErr(Buf, RoutineName)) return + ! F_at_t + call RegPack(Buf, allocated(InData%F_at_t)) + if (allocated(InData%F_at_t)) then + call RegPackBounds(Buf, 1, lbound(InData%F_at_t), ubound(InData%F_at_t)) + call RegPack(Buf, InData%F_at_t) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Indx + call RegPack(Buf, InData%Indx) + if (RegCheckErr(Buf, RoutineName)) return + ! EquilStart + call RegPack(Buf, InData%EquilStart) + if (RegCheckErr(Buf, RoutineName)) return + ! AllOuts + call RegPack(Buf, allocated(InData%AllOuts)) + if (allocated(InData%AllOuts)) then + call RegPackBounds(Buf, 1, lbound(InData%AllOuts), ubound(InData%AllOuts)) + call RegPack(Buf, InData%AllOuts) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ExtPtfm_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtPtfm_UnPackMisc' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! xFlat + if (allocated(OutData%xFlat)) deallocate(OutData%xFlat) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xFlat(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xFlat.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%xFlat) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! uFlat + call RegUnpack(Buf, OutData%uFlat) + if (RegCheckErr(Buf, RoutineName)) return + ! F_at_t + if (allocated(OutData%F_at_t)) deallocate(OutData%F_at_t) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_at_t(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_at_t.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_at_t) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Indx + call RegUnpack(Buf, OutData%Indx) + if (RegCheckErr(Buf, RoutineName)) return + ! EquilStart + call RegUnpack(Buf, OutData%EquilStart) + if (RegCheckErr(Buf, RoutineName)) return + ! AllOuts + if (allocated(OutData%AllOuts)) deallocate(OutData%AllOuts) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AllOuts(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AllOuts) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE ExtPtfm_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(ExtPtfm_ParameterType), INTENT(IN) :: SrcParamData TYPE(ExtPtfm_ParameterType), INTENT(INOUT) :: DstParamData @@ -3019,1320 +1901,601 @@ SUBROUTINE ExtPtfm_DestroyParam( ParamData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE ExtPtfm_DestroyParam - SUBROUTINE ExtPtfm_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ExtPtfm_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! Mass allocated yes/no - IF ( ALLOCATED(InData%Mass) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Mass upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Mass) ! Mass - END IF - Int_BufSz = Int_BufSz + 1 ! Damp allocated yes/no - IF ( ALLOCATED(InData%Damp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Damp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Damp) ! Damp - END IF - Int_BufSz = Int_BufSz + 1 ! Stff allocated yes/no - IF ( ALLOCATED(InData%Stff) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Stff upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Stff) ! Stff - END IF - Int_BufSz = Int_BufSz + 1 ! Forces allocated yes/no - IF ( ALLOCATED(InData%Forces) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Forces upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Forces) ! Forces - END IF - Int_BufSz = Int_BufSz + 1 ! times allocated yes/no - IF ( ALLOCATED(InData%times) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! times upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%times) ! times - END IF - Int_BufSz = Int_BufSz + 1 ! AMat allocated yes/no - IF ( ALLOCATED(InData%AMat) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AMat upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AMat) ! AMat - END IF - Int_BufSz = Int_BufSz + 1 ! BMat allocated yes/no - IF ( ALLOCATED(InData%BMat) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BMat upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BMat) ! BMat - END IF - Int_BufSz = Int_BufSz + 1 ! CMat allocated yes/no - IF ( ALLOCATED(InData%CMat) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CMat upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CMat) ! CMat - END IF - Int_BufSz = Int_BufSz + 1 ! DMat allocated yes/no - IF ( ALLOCATED(InData%DMat) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! DMat upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DMat) ! DMat - END IF - Int_BufSz = Int_BufSz + 1 ! FX allocated yes/no - IF ( ALLOCATED(InData%FX) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FX) ! FX - END IF - Int_BufSz = Int_BufSz + 1 ! FY allocated yes/no - IF ( ALLOCATED(InData%FY) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FY) ! FY - END IF - Int_BufSz = Int_BufSz + 1 ! M11 allocated yes/no - IF ( ALLOCATED(InData%M11) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! M11 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%M11) ! M11 - END IF - Int_BufSz = Int_BufSz + 1 ! M12 allocated yes/no - IF ( ALLOCATED(InData%M12) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! M12 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%M12) ! M12 - END IF - Int_BufSz = Int_BufSz + 1 ! M22 allocated yes/no - IF ( ALLOCATED(InData%M22) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! M22 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%M22) ! M22 - END IF - Int_BufSz = Int_BufSz + 1 ! M21 allocated yes/no - IF ( ALLOCATED(InData%M21) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! M21 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%M21) ! M21 - END IF - Int_BufSz = Int_BufSz + 1 ! K11 allocated yes/no - IF ( ALLOCATED(InData%K11) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! K11 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%K11) ! K11 - END IF - Int_BufSz = Int_BufSz + 1 ! K22 allocated yes/no - IF ( ALLOCATED(InData%K22) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! K22 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%K22) ! K22 - END IF - Int_BufSz = Int_BufSz + 1 ! C11 allocated yes/no - IF ( ALLOCATED(InData%C11) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! C11 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%C11) ! C11 - END IF - Int_BufSz = Int_BufSz + 1 ! C12 allocated yes/no - IF ( ALLOCATED(InData%C12) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! C12 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%C12) ! C12 - END IF - Int_BufSz = Int_BufSz + 1 ! C22 allocated yes/no - IF ( ALLOCATED(InData%C22) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! C22 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%C22) ! C22 - END IF - Int_BufSz = Int_BufSz + 1 ! C21 allocated yes/no - IF ( ALLOCATED(InData%C21) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! C21 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%C21) ! C21 - END IF - Db_BufSz = Db_BufSz + 1 ! EP_DeltaT - Int_BufSz = Int_BufSz + 1 ! nTimeSteps - Int_BufSz = Int_BufSz + 1 ! nCB - Int_BufSz = Int_BufSz + 1 ! nCBFull - Int_BufSz = Int_BufSz + 1 ! nTot - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! IntMethod - Int_BufSz = Int_BufSz + 1 ! ActiveCBDOF allocated yes/no - IF ( ALLOCATED(InData%ActiveCBDOF) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ActiveCBDOF upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ActiveCBDOF) ! ActiveCBDOF - END IF - Int_BufSz = Int_BufSz + 1 ! OutParam allocated yes/no - IF ( ALLOCATED(InData%OutParam) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutParam upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - Int_BufSz = Int_BufSz + 3 ! OutParam: size of buffers for each call to pack subtype - CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutParam - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutParam - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutParam - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OutParamLinIndx allocated yes/no - IF ( ALLOCATED(InData%OutParamLinIndx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OutParamLinIndx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%OutParamLinIndx) ! OutParamLinIndx - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%Mass) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Mass,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mass,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Mass,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mass,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Mass,2), UBOUND(InData%Mass,2) - DO i1 = LBOUND(InData%Mass,1), UBOUND(InData%Mass,1) - ReKiBuf(Re_Xferred) = InData%Mass(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Damp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Damp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Damp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Damp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Damp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Damp,2), UBOUND(InData%Damp,2) - DO i1 = LBOUND(InData%Damp,1), UBOUND(InData%Damp,1) - ReKiBuf(Re_Xferred) = InData%Damp(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Stff) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Stff,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Stff,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Stff,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Stff,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Stff,2), UBOUND(InData%Stff,2) - DO i1 = LBOUND(InData%Stff,1), UBOUND(InData%Stff,1) - ReKiBuf(Re_Xferred) = InData%Stff(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Forces) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Forces,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Forces,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Forces,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Forces,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Forces,2), UBOUND(InData%Forces,2) - DO i1 = LBOUND(InData%Forces,1), UBOUND(InData%Forces,1) - ReKiBuf(Re_Xferred) = InData%Forces(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%times) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%times,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%times,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%times,1), UBOUND(InData%times,1) - ReKiBuf(Re_Xferred) = InData%times(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AMat) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AMat,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AMat,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AMat,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AMat,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AMat,2), UBOUND(InData%AMat,2) - DO i1 = LBOUND(InData%AMat,1), UBOUND(InData%AMat,1) - ReKiBuf(Re_Xferred) = InData%AMat(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BMat) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BMat,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BMat,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BMat,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BMat,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BMat,2), UBOUND(InData%BMat,2) - DO i1 = LBOUND(InData%BMat,1), UBOUND(InData%BMat,1) - ReKiBuf(Re_Xferred) = InData%BMat(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CMat) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CMat,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CMat,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CMat,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CMat,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CMat,2), UBOUND(InData%CMat,2) - DO i1 = LBOUND(InData%CMat,1), UBOUND(InData%CMat,1) - ReKiBuf(Re_Xferred) = InData%CMat(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DMat) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DMat,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DMat,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DMat,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DMat,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%DMat,2), UBOUND(InData%DMat,2) - DO i1 = LBOUND(InData%DMat,1), UBOUND(InData%DMat,1) - ReKiBuf(Re_Xferred) = InData%DMat(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FX) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FX,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FX,1), UBOUND(InData%FX,1) - ReKiBuf(Re_Xferred) = InData%FX(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FY) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FY,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FY,1), UBOUND(InData%FY,1) - ReKiBuf(Re_Xferred) = InData%FY(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%M11) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M11,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M11,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M11,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M11,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%M11,2), UBOUND(InData%M11,2) - DO i1 = LBOUND(InData%M11,1), UBOUND(InData%M11,1) - ReKiBuf(Re_Xferred) = InData%M11(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%M12) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M12,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M12,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M12,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M12,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%M12,2), UBOUND(InData%M12,2) - DO i1 = LBOUND(InData%M12,1), UBOUND(InData%M12,1) - ReKiBuf(Re_Xferred) = InData%M12(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%M22) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M22,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M22,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M22,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M22,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%M22,2), UBOUND(InData%M22,2) - DO i1 = LBOUND(InData%M22,1), UBOUND(InData%M22,1) - ReKiBuf(Re_Xferred) = InData%M22(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%M21) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M21,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M21,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M21,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M21,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%M21,2), UBOUND(InData%M21,2) - DO i1 = LBOUND(InData%M21,1), UBOUND(InData%M21,1) - ReKiBuf(Re_Xferred) = InData%M21(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%K11) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%K11,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%K11,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%K11,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%K11,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%K11,2), UBOUND(InData%K11,2) - DO i1 = LBOUND(InData%K11,1), UBOUND(InData%K11,1) - ReKiBuf(Re_Xferred) = InData%K11(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%K22) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%K22,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%K22,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%K22,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%K22,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%K22,2), UBOUND(InData%K22,2) - DO i1 = LBOUND(InData%K22,1), UBOUND(InData%K22,1) - ReKiBuf(Re_Xferred) = InData%K22(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%C11) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C11,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C11,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C11,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C11,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%C11,2), UBOUND(InData%C11,2) - DO i1 = LBOUND(InData%C11,1), UBOUND(InData%C11,1) - ReKiBuf(Re_Xferred) = InData%C11(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%C12) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C12,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C12,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C12,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C12,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%C12,2), UBOUND(InData%C12,2) - DO i1 = LBOUND(InData%C12,1), UBOUND(InData%C12,1) - ReKiBuf(Re_Xferred) = InData%C12(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%C22) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C22,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C22,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C22,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C22,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%C22,2), UBOUND(InData%C22,2) - DO i1 = LBOUND(InData%C22,1), UBOUND(InData%C22,1) - ReKiBuf(Re_Xferred) = InData%C22(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%C21) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C21,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C21,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C21,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C21,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%C21,2), UBOUND(InData%C21,2) - DO i1 = LBOUND(InData%C21,1), UBOUND(InData%C21,1) - ReKiBuf(Re_Xferred) = InData%C21(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DbKiBuf(Db_Xferred) = InData%EP_DeltaT - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nTimeSteps - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nCB - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nCBFull - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nTot - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%IntMethod - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%ActiveCBDOF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ActiveCBDOF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ActiveCBDOF,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ActiveCBDOF,1), UBOUND(InData%ActiveCBDOF,1) - IntKiBuf(Int_Xferred) = InData%ActiveCBDOF(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutParam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParam,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OutParamLinIndx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutParamLinIndx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParamLinIndx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutParamLinIndx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParamLinIndx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OutParamLinIndx,2), UBOUND(InData%OutParamLinIndx,2) - DO i1 = LBOUND(InData%OutParamLinIndx,1), UBOUND(InData%OutParamLinIndx,1) - IntKiBuf(Int_Xferred) = InData%OutParamLinIndx(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE ExtPtfm_PackParam - - SUBROUTINE ExtPtfm_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ExtPtfm_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Mass not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Mass)) DEALLOCATE(OutData%Mass) - ALLOCATE(OutData%Mass(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Mass,2), UBOUND(OutData%Mass,2) - DO i1 = LBOUND(OutData%Mass,1), UBOUND(OutData%Mass,1) - OutData%Mass(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Damp not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Damp)) DEALLOCATE(OutData%Damp) - ALLOCATE(OutData%Damp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Damp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Damp,2), UBOUND(OutData%Damp,2) - DO i1 = LBOUND(OutData%Damp,1), UBOUND(OutData%Damp,1) - OutData%Damp(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Stff not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Stff)) DEALLOCATE(OutData%Stff) - ALLOCATE(OutData%Stff(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Stff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Stff,2), UBOUND(OutData%Stff,2) - DO i1 = LBOUND(OutData%Stff,1), UBOUND(OutData%Stff,1) - OutData%Stff(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Forces not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Forces)) DEALLOCATE(OutData%Forces) - ALLOCATE(OutData%Forces(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Forces.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Forces,2), UBOUND(OutData%Forces,2) - DO i1 = LBOUND(OutData%Forces,1), UBOUND(OutData%Forces,1) - OutData%Forces(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! times not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%times)) DEALLOCATE(OutData%times) - ALLOCATE(OutData%times(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%times.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%times,1), UBOUND(OutData%times,1) - OutData%times(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AMat not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AMat)) DEALLOCATE(OutData%AMat) - ALLOCATE(OutData%AMat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AMat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AMat,2), UBOUND(OutData%AMat,2) - DO i1 = LBOUND(OutData%AMat,1), UBOUND(OutData%AMat,1) - OutData%AMat(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BMat not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BMat)) DEALLOCATE(OutData%BMat) - ALLOCATE(OutData%BMat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BMat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BMat,2), UBOUND(OutData%BMat,2) - DO i1 = LBOUND(OutData%BMat,1), UBOUND(OutData%BMat,1) - OutData%BMat(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CMat not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CMat)) DEALLOCATE(OutData%CMat) - ALLOCATE(OutData%CMat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CMat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CMat,2), UBOUND(OutData%CMat,2) - DO i1 = LBOUND(OutData%CMat,1), UBOUND(OutData%CMat,1) - OutData%CMat(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DMat not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DMat)) DEALLOCATE(OutData%DMat) - ALLOCATE(OutData%DMat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DMat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%DMat,2), UBOUND(OutData%DMat,2) - DO i1 = LBOUND(OutData%DMat,1), UBOUND(OutData%DMat,1) - OutData%DMat(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FX not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FX)) DEALLOCATE(OutData%FX) - ALLOCATE(OutData%FX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FX,1), UBOUND(OutData%FX,1) - OutData%FX(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FY not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FY)) DEALLOCATE(OutData%FY) - ALLOCATE(OutData%FY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FY,1), UBOUND(OutData%FY,1) - OutData%FY(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M11 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%M11)) DEALLOCATE(OutData%M11) - ALLOCATE(OutData%M11(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M11.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%M11,2), UBOUND(OutData%M11,2) - DO i1 = LBOUND(OutData%M11,1), UBOUND(OutData%M11,1) - OutData%M11(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M12 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%M12)) DEALLOCATE(OutData%M12) - ALLOCATE(OutData%M12(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M12.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%M12,2), UBOUND(OutData%M12,2) - DO i1 = LBOUND(OutData%M12,1), UBOUND(OutData%M12,1) - OutData%M12(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M22 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%M22)) DEALLOCATE(OutData%M22) - ALLOCATE(OutData%M22(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M22.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%M22,2), UBOUND(OutData%M22,2) - DO i1 = LBOUND(OutData%M22,1), UBOUND(OutData%M22,1) - OutData%M22(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M21 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%M21)) DEALLOCATE(OutData%M21) - ALLOCATE(OutData%M21(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M21.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%M21,2), UBOUND(OutData%M21,2) - DO i1 = LBOUND(OutData%M21,1), UBOUND(OutData%M21,1) - OutData%M21(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! K11 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%K11)) DEALLOCATE(OutData%K11) - ALLOCATE(OutData%K11(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%K11.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%K11,2), UBOUND(OutData%K11,2) - DO i1 = LBOUND(OutData%K11,1), UBOUND(OutData%K11,1) - OutData%K11(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! K22 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%K22)) DEALLOCATE(OutData%K22) - ALLOCATE(OutData%K22(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%K22.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%K22,2), UBOUND(OutData%K22,2) - DO i1 = LBOUND(OutData%K22,1), UBOUND(OutData%K22,1) - OutData%K22(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C11 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%C11)) DEALLOCATE(OutData%C11) - ALLOCATE(OutData%C11(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C11.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%C11,2), UBOUND(OutData%C11,2) - DO i1 = LBOUND(OutData%C11,1), UBOUND(OutData%C11,1) - OutData%C11(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C12 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%C12)) DEALLOCATE(OutData%C12) - ALLOCATE(OutData%C12(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C12.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%C12,2), UBOUND(OutData%C12,2) - DO i1 = LBOUND(OutData%C12,1), UBOUND(OutData%C12,1) - OutData%C12(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C22 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%C22)) DEALLOCATE(OutData%C22) - ALLOCATE(OutData%C22(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C22.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%C22,2), UBOUND(OutData%C22,2) - DO i1 = LBOUND(OutData%C22,1), UBOUND(OutData%C22,1) - OutData%C22(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C21 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%C21)) DEALLOCATE(OutData%C21) - ALLOCATE(OutData%C21(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C21.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%C21,2), UBOUND(OutData%C21,2) - DO i1 = LBOUND(OutData%C21,1), UBOUND(OutData%C21,1) - OutData%C21(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%EP_DeltaT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%nTimeSteps = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nCB = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nCBFull = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nTot = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%IntMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ActiveCBDOF not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ActiveCBDOF)) DEALLOCATE(OutData%ActiveCBDOF) - ALLOCATE(OutData%ActiveCBDOF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ActiveCBDOF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ActiveCBDOF,1), UBOUND(OutData%ActiveCBDOF,1) - OutData%ActiveCBDOF(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutParam)) DEALLOCATE(OutData%OutParam) - ALLOCATE(OutData%OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutParam,1), UBOUND(OutData%OutParam,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackOutParmType( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParamLinIndx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutParamLinIndx)) DEALLOCATE(OutData%OutParamLinIndx) - ALLOCATE(OutData%OutParamLinIndx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParamLinIndx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OutParamLinIndx,2), UBOUND(OutData%OutParamLinIndx,2) - DO i1 = LBOUND(OutData%OutParamLinIndx,1), UBOUND(OutData%OutParamLinIndx,1) - OutData%OutParamLinIndx(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE ExtPtfm_UnPackParam +subroutine ExtPtfm_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtPtfm_PackParam' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + ! Mass + call RegPack(Buf, allocated(InData%Mass)) + if (allocated(InData%Mass)) then + call RegPackBounds(Buf, 2, lbound(InData%Mass), ubound(InData%Mass)) + call RegPack(Buf, InData%Mass) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Damp + call RegPack(Buf, allocated(InData%Damp)) + if (allocated(InData%Damp)) then + call RegPackBounds(Buf, 2, lbound(InData%Damp), ubound(InData%Damp)) + call RegPack(Buf, InData%Damp) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Stff + call RegPack(Buf, allocated(InData%Stff)) + if (allocated(InData%Stff)) then + call RegPackBounds(Buf, 2, lbound(InData%Stff), ubound(InData%Stff)) + call RegPack(Buf, InData%Stff) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Forces + call RegPack(Buf, allocated(InData%Forces)) + if (allocated(InData%Forces)) then + call RegPackBounds(Buf, 2, lbound(InData%Forces), ubound(InData%Forces)) + call RegPack(Buf, InData%Forces) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! times + call RegPack(Buf, allocated(InData%times)) + if (allocated(InData%times)) then + call RegPackBounds(Buf, 1, lbound(InData%times), ubound(InData%times)) + call RegPack(Buf, InData%times) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AMat + call RegPack(Buf, allocated(InData%AMat)) + if (allocated(InData%AMat)) then + call RegPackBounds(Buf, 2, lbound(InData%AMat), ubound(InData%AMat)) + call RegPack(Buf, InData%AMat) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BMat + call RegPack(Buf, allocated(InData%BMat)) + if (allocated(InData%BMat)) then + call RegPackBounds(Buf, 2, lbound(InData%BMat), ubound(InData%BMat)) + call RegPack(Buf, InData%BMat) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CMat + call RegPack(Buf, allocated(InData%CMat)) + if (allocated(InData%CMat)) then + call RegPackBounds(Buf, 2, lbound(InData%CMat), ubound(InData%CMat)) + call RegPack(Buf, InData%CMat) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DMat + call RegPack(Buf, allocated(InData%DMat)) + if (allocated(InData%DMat)) then + call RegPackBounds(Buf, 2, lbound(InData%DMat), ubound(InData%DMat)) + call RegPack(Buf, InData%DMat) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FX + call RegPack(Buf, allocated(InData%FX)) + if (allocated(InData%FX)) then + call RegPackBounds(Buf, 1, lbound(InData%FX), ubound(InData%FX)) + call RegPack(Buf, InData%FX) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FY + call RegPack(Buf, allocated(InData%FY)) + if (allocated(InData%FY)) then + call RegPackBounds(Buf, 1, lbound(InData%FY), ubound(InData%FY)) + call RegPack(Buf, InData%FY) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! M11 + call RegPack(Buf, allocated(InData%M11)) + if (allocated(InData%M11)) then + call RegPackBounds(Buf, 2, lbound(InData%M11), ubound(InData%M11)) + call RegPack(Buf, InData%M11) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! M12 + call RegPack(Buf, allocated(InData%M12)) + if (allocated(InData%M12)) then + call RegPackBounds(Buf, 2, lbound(InData%M12), ubound(InData%M12)) + call RegPack(Buf, InData%M12) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! M22 + call RegPack(Buf, allocated(InData%M22)) + if (allocated(InData%M22)) then + call RegPackBounds(Buf, 2, lbound(InData%M22), ubound(InData%M22)) + call RegPack(Buf, InData%M22) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! M21 + call RegPack(Buf, allocated(InData%M21)) + if (allocated(InData%M21)) then + call RegPackBounds(Buf, 2, lbound(InData%M21), ubound(InData%M21)) + call RegPack(Buf, InData%M21) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! K11 + call RegPack(Buf, allocated(InData%K11)) + if (allocated(InData%K11)) then + call RegPackBounds(Buf, 2, lbound(InData%K11), ubound(InData%K11)) + call RegPack(Buf, InData%K11) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! K22 + call RegPack(Buf, allocated(InData%K22)) + if (allocated(InData%K22)) then + call RegPackBounds(Buf, 2, lbound(InData%K22), ubound(InData%K22)) + call RegPack(Buf, InData%K22) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! C11 + call RegPack(Buf, allocated(InData%C11)) + if (allocated(InData%C11)) then + call RegPackBounds(Buf, 2, lbound(InData%C11), ubound(InData%C11)) + call RegPack(Buf, InData%C11) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! C12 + call RegPack(Buf, allocated(InData%C12)) + if (allocated(InData%C12)) then + call RegPackBounds(Buf, 2, lbound(InData%C12), ubound(InData%C12)) + call RegPack(Buf, InData%C12) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! C22 + call RegPack(Buf, allocated(InData%C22)) + if (allocated(InData%C22)) then + call RegPackBounds(Buf, 2, lbound(InData%C22), ubound(InData%C22)) + call RegPack(Buf, InData%C22) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! C21 + call RegPack(Buf, allocated(InData%C21)) + if (allocated(InData%C21)) then + call RegPackBounds(Buf, 2, lbound(InData%C21), ubound(InData%C21)) + call RegPack(Buf, InData%C21) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! EP_DeltaT + call RegPack(Buf, InData%EP_DeltaT) + if (RegCheckErr(Buf, RoutineName)) return + ! nTimeSteps + call RegPack(Buf, InData%nTimeSteps) + if (RegCheckErr(Buf, RoutineName)) return + ! nCB + call RegPack(Buf, InData%nCB) + if (RegCheckErr(Buf, RoutineName)) return + ! nCBFull + call RegPack(Buf, InData%nCBFull) + if (RegCheckErr(Buf, RoutineName)) return + ! nTot + call RegPack(Buf, InData%nTot) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegPack(Buf, InData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! IntMethod + call RegPack(Buf, InData%IntMethod) + if (RegCheckErr(Buf, RoutineName)) return + ! ActiveCBDOF + call RegPack(Buf, allocated(InData%ActiveCBDOF)) + if (allocated(InData%ActiveCBDOF)) then + call RegPackBounds(Buf, 1, lbound(InData%ActiveCBDOF), ubound(InData%ActiveCBDOF)) + call RegPack(Buf, InData%ActiveCBDOF) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OutParam + call RegPack(Buf, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OutParamLinIndx + call RegPack(Buf, allocated(InData%OutParamLinIndx)) + if (allocated(InData%OutParamLinIndx)) then + call RegPackBounds(Buf, 2, lbound(InData%OutParamLinIndx), ubound(InData%OutParamLinIndx)) + call RegPack(Buf, InData%OutParamLinIndx) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ExtPtfm_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtPtfm_UnPackParam' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! Mass + if (allocated(OutData%Mass)) deallocate(OutData%Mass) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Mass(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mass.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Mass) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Damp + if (allocated(OutData%Damp)) deallocate(OutData%Damp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Damp(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Damp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Damp) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Stff + if (allocated(OutData%Stff)) deallocate(OutData%Stff) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Stff(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Stff.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Stff) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Forces + if (allocated(OutData%Forces)) deallocate(OutData%Forces) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Forces(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Forces.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Forces) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! times + if (allocated(OutData%times)) deallocate(OutData%times) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%times(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%times.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%times) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AMat + if (allocated(OutData%AMat)) deallocate(OutData%AMat) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AMat(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AMat.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AMat) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BMat + if (allocated(OutData%BMat)) deallocate(OutData%BMat) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BMat(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BMat.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BMat) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CMat + if (allocated(OutData%CMat)) deallocate(OutData%CMat) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CMat(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CMat.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CMat) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! DMat + if (allocated(OutData%DMat)) deallocate(OutData%DMat) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DMat(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DMat.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DMat) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! FX + if (allocated(OutData%FX)) deallocate(OutData%FX) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FX(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FX) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! FY + if (allocated(OutData%FY)) deallocate(OutData%FY) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FY(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FY) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! M11 + if (allocated(OutData%M11)) deallocate(OutData%M11) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%M11(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%M11.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%M11) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! M12 + if (allocated(OutData%M12)) deallocate(OutData%M12) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%M12(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%M12.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%M12) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! M22 + if (allocated(OutData%M22)) deallocate(OutData%M22) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%M22(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%M22.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%M22) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! M21 + if (allocated(OutData%M21)) deallocate(OutData%M21) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%M21(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%M21.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%M21) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! K11 + if (allocated(OutData%K11)) deallocate(OutData%K11) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%K11(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%K11.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%K11) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! K22 + if (allocated(OutData%K22)) deallocate(OutData%K22) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%K22(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%K22.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%K22) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! C11 + if (allocated(OutData%C11)) deallocate(OutData%C11) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%C11(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%C11.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%C11) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! C12 + if (allocated(OutData%C12)) deallocate(OutData%C12) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%C12(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%C12.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%C12) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! C22 + if (allocated(OutData%C22)) deallocate(OutData%C22) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%C22(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%C22.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%C22) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! C21 + if (allocated(OutData%C21)) deallocate(OutData%C21) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%C21(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%C21.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%C21) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! EP_DeltaT + call RegUnpack(Buf, OutData%EP_DeltaT) + if (RegCheckErr(Buf, RoutineName)) return + ! nTimeSteps + call RegUnpack(Buf, OutData%nTimeSteps) + if (RegCheckErr(Buf, RoutineName)) return + ! nCB + call RegUnpack(Buf, OutData%nCB) + if (RegCheckErr(Buf, RoutineName)) return + ! nCBFull + call RegUnpack(Buf, OutData%nCBFull) + if (RegCheckErr(Buf, RoutineName)) return + ! nTot + call RegUnpack(Buf, OutData%nTot) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! IntMethod + call RegUnpack(Buf, OutData%IntMethod) + if (RegCheckErr(Buf, RoutineName)) return + ! ActiveCBDOF + if (allocated(OutData%ActiveCBDOF)) deallocate(OutData%ActiveCBDOF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ActiveCBDOF(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ActiveCBDOF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ActiveCBDOF) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! OutParam + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam + end do + end if + ! OutParamLinIndx + if (allocated(OutData%OutParamLinIndx)) deallocate(OutData%OutParamLinIndx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutParamLinIndx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParamLinIndx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutParamLinIndx) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE ExtPtfm_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(ExtPtfm_InputType), INTENT(INOUT) :: SrcInputData TYPE(ExtPtfm_InputType), INTENT(INOUT) :: DstInputData @@ -4369,184 +2532,25 @@ SUBROUTINE ExtPtfm_DestroyInput( InputData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE ExtPtfm_DestroyInput - SUBROUTINE ExtPtfm_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ExtPtfm_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! PtfmMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PtfmMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PtfmMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PtfmMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PtfmMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL MeshPack( InData%PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PtfmMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE ExtPtfm_PackInput - - SUBROUTINE ExtPtfm_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ExtPtfm_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PtfmMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE ExtPtfm_UnPackInput +subroutine ExtPtfm_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtPtfm_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + ! PtfmMesh + call MeshPack(Buf, InData%PtfmMesh) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ExtPtfm_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtPtfm_UnPackInput' + if (Buf%ErrStat /= ErrID_None) return + ! PtfmMesh + call MeshUnpack(Buf, OutData%PtfmMesh) ! PtfmMesh +end subroutine SUBROUTINE ExtPtfm_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: SrcOutputData TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: DstOutputData @@ -4599,223 +2603,50 @@ SUBROUTINE ExtPtfm_DestroyOutput( OutputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE ExtPtfm_DestroyOutput - SUBROUTINE ExtPtfm_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ExtPtfm_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! PtfmMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PtfmMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PtfmMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PtfmMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PtfmMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutput allocated yes/no - IF ( ALLOCATED(InData%WriteOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutput upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WriteOutput) ! WriteOutput - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL MeshPack( InData%PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PtfmMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) - ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE ExtPtfm_PackOutput - - SUBROUTINE ExtPtfm_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PtfmMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutput)) DEALLOCATE(OutData%WriteOutput) - ALLOCATE(OutData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) - OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE ExtPtfm_UnPackOutput +subroutine ExtPtfm_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'ExtPtfm_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! PtfmMesh + call MeshPack(Buf, InData%PtfmMesh) + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutput + call RegPack(Buf, allocated(InData%WriteOutput)) + if (allocated(InData%WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPack(Buf, InData%WriteOutput) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine ExtPtfm_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ExtPtfm_UnPackOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! PtfmMesh + call MeshUnpack(Buf, OutData%PtfmMesh) ! PtfmMesh + ! WriteOutput + if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE ExtPtfm_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) ! diff --git a/modules/feamooring/src/FEAMooring_Types.f90 b/modules/feamooring/src/FEAMooring_Types.f90 index 43ad17b62e..bef3481d96 100644 --- a/modules/feamooring/src/FEAMooring_Types.f90 +++ b/modules/feamooring/src/FEAMooring_Types.f90 @@ -551,908 +551,497 @@ SUBROUTINE FEAM_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE FEAM_DestroyInputFile - SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FEAM_InputFile), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_PackInputFile' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! DT - Int_BufSz = Int_BufSz + 1 ! LineCI allocated yes/no - IF ( ALLOCATED(InData%LineCI) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LineCI upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LineCI) ! LineCI - END IF - Int_BufSz = Int_BufSz + 1 ! LineCD allocated yes/no - IF ( ALLOCATED(InData%LineCD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LineCD upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LineCD) ! LineCD - END IF - Int_BufSz = Int_BufSz + 1 ! LEAStiff allocated yes/no - IF ( ALLOCATED(InData%LEAStiff) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LEAStiff upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LEAStiff) ! LEAStiff - END IF - Int_BufSz = Int_BufSz + 1 ! LMassDen allocated yes/no - IF ( ALLOCATED(InData%LMassDen) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LMassDen upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LMassDen) ! LMassDen - END IF - Int_BufSz = Int_BufSz + 1 ! LDMassDen allocated yes/no - IF ( ALLOCATED(InData%LDMassDen) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LDMassDen upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LDMassDen) ! LDMassDen - END IF - Int_BufSz = Int_BufSz + 1 ! BottmStiff allocated yes/no - IF ( ALLOCATED(InData%BottmStiff) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BottmStiff upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BottmStiff) ! BottmStiff - END IF - Int_BufSz = Int_BufSz + 1 ! LRadAnch allocated yes/no - IF ( ALLOCATED(InData%LRadAnch) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LRadAnch upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LRadAnch) ! LRadAnch - END IF - Int_BufSz = Int_BufSz + 1 ! LAngAnch allocated yes/no - IF ( ALLOCATED(InData%LAngAnch) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LAngAnch upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LAngAnch) ! LAngAnch - END IF - Int_BufSz = Int_BufSz + 1 ! LDpthAnch allocated yes/no - IF ( ALLOCATED(InData%LDpthAnch) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LDpthAnch upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LDpthAnch) ! LDpthAnch - END IF - Int_BufSz = Int_BufSz + 1 ! LRadFair allocated yes/no - IF ( ALLOCATED(InData%LRadFair) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LRadFair upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LRadFair) ! LRadFair - END IF - Int_BufSz = Int_BufSz + 1 ! LAngFair allocated yes/no - IF ( ALLOCATED(InData%LAngFair) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LAngFair upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LAngFair) ! LAngFair - END IF - Int_BufSz = Int_BufSz + 1 ! LDrftFair allocated yes/no - IF ( ALLOCATED(InData%LDrftFair) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LDrftFair upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LDrftFair) ! LDrftFair - END IF - Int_BufSz = Int_BufSz + 1 ! LUnstrLen allocated yes/no - IF ( ALLOCATED(InData%LUnstrLen) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LUnstrLen upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LUnstrLen) ! LUnstrLen - END IF - Int_BufSz = Int_BufSz + 1 ! Tension allocated yes/no - IF ( ALLOCATED(InData%Tension) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Tension upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Tension) ! Tension - END IF - Int_BufSz = Int_BufSz + 1 ! GSL allocated yes/no - IF ( ALLOCATED(InData%GSL) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! GSL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GSL) ! GSL - END IF - Int_BufSz = Int_BufSz + 1 ! GSR allocated yes/no - IF ( ALLOCATED(InData%GSR) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! GSR upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GSR) ! GSR - END IF - Int_BufSz = Int_BufSz + 1 ! GE allocated yes/no - IF ( ALLOCATED(InData%GE) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! GE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GE) ! GE - END IF - Int_BufSz = Int_BufSz + 1 ! NumLines - Int_BufSz = Int_BufSz + 1 ! NumElems - Re_BufSz = Re_BufSz + 1 ! Eps - Re_BufSz = Re_BufSz + 1 ! Gravity - Re_BufSz = Re_BufSz + 1 ! WtrDens - Int_BufSz = Int_BufSz + 1 ! MaxIter - Int_BufSz = Int_BufSz + 1 ! SumPrint - Int_BufSz = Int_BufSz + 1 ! OutFile - Int_BufSz = Int_BufSz + 1 ! TabDelim - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt - Db_BufSz = Db_BufSz + 1 ! Tstart - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! OutList allocated yes/no - IF ( ALLOCATED(InData%OutList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%OutList)*LEN(InData%OutList) ! OutList - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%LineCI) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LineCI,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineCI,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LineCI,1), UBOUND(InData%LineCI,1) - ReKiBuf(Re_Xferred) = InData%LineCI(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LineCD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LineCD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineCD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LineCD,1), UBOUND(InData%LineCD,1) - ReKiBuf(Re_Xferred) = InData%LineCD(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LEAStiff) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LEAStiff,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LEAStiff,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LEAStiff,1), UBOUND(InData%LEAStiff,1) - ReKiBuf(Re_Xferred) = InData%LEAStiff(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LMassDen) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LMassDen,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LMassDen,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LMassDen,1), UBOUND(InData%LMassDen,1) - ReKiBuf(Re_Xferred) = InData%LMassDen(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LDMassDen) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LDMassDen,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LDMassDen,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LDMassDen,1), UBOUND(InData%LDMassDen,1) - ReKiBuf(Re_Xferred) = InData%LDMassDen(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BottmStiff) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BottmStiff,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BottmStiff,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BottmStiff,1), UBOUND(InData%BottmStiff,1) - ReKiBuf(Re_Xferred) = InData%BottmStiff(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LRadAnch) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LRadAnch,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LRadAnch,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LRadAnch,1), UBOUND(InData%LRadAnch,1) - ReKiBuf(Re_Xferred) = InData%LRadAnch(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LAngAnch) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LAngAnch,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LAngAnch,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LAngAnch,1), UBOUND(InData%LAngAnch,1) - ReKiBuf(Re_Xferred) = InData%LAngAnch(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LDpthAnch) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LDpthAnch,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LDpthAnch,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LDpthAnch,1), UBOUND(InData%LDpthAnch,1) - ReKiBuf(Re_Xferred) = InData%LDpthAnch(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LRadFair) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LRadFair,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LRadFair,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LRadFair,1), UBOUND(InData%LRadFair,1) - ReKiBuf(Re_Xferred) = InData%LRadFair(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LAngFair) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LAngFair,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LAngFair,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LAngFair,1), UBOUND(InData%LAngFair,1) - ReKiBuf(Re_Xferred) = InData%LAngFair(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LDrftFair) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LDrftFair,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LDrftFair,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LDrftFair,1), UBOUND(InData%LDrftFair,1) - ReKiBuf(Re_Xferred) = InData%LDrftFair(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LUnstrLen) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LUnstrLen,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LUnstrLen,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LUnstrLen,1), UBOUND(InData%LUnstrLen,1) - ReKiBuf(Re_Xferred) = InData%LUnstrLen(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Tension) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Tension,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Tension,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Tension,1), UBOUND(InData%Tension,1) - ReKiBuf(Re_Xferred) = InData%Tension(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%GSL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GSL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GSL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GSL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GSL,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GSL,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GSL,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%GSL,3), UBOUND(InData%GSL,3) - DO i2 = LBOUND(InData%GSL,2), UBOUND(InData%GSL,2) - DO i1 = LBOUND(InData%GSL,1), UBOUND(InData%GSL,1) - ReKiBuf(Re_Xferred) = InData%GSL(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%GSR) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GSR,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GSR,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GSR,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GSR,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%GSR,2), UBOUND(InData%GSR,2) - DO i1 = LBOUND(InData%GSR,1), UBOUND(InData%GSR,1) - ReKiBuf(Re_Xferred) = InData%GSR(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%GE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GE,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GE,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GE,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%GE,3), UBOUND(InData%GE,3) - DO i2 = LBOUND(InData%GE,2), UBOUND(InData%GE,2) - DO i1 = LBOUND(InData%GE,1), UBOUND(InData%GE,1) - ReKiBuf(Re_Xferred) = InData%GE(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NumLines - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumElems - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Eps - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MaxIter - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%OutFile - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TabDelim, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf(Db_Xferred) = InData%Tstart - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) - DO I = 1, LEN(InData%OutList) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - END SUBROUTINE FEAM_PackInputFile - - SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FEAM_InputFile), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_UnPackInputFile' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineCI not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LineCI)) DEALLOCATE(OutData%LineCI) - ALLOCATE(OutData%LineCI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineCI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LineCI,1), UBOUND(OutData%LineCI,1) - OutData%LineCI(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineCD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LineCD)) DEALLOCATE(OutData%LineCD) - ALLOCATE(OutData%LineCD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineCD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LineCD,1), UBOUND(OutData%LineCD,1) - OutData%LineCD(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LEAStiff not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LEAStiff)) DEALLOCATE(OutData%LEAStiff) - ALLOCATE(OutData%LEAStiff(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LEAStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LEAStiff,1), UBOUND(OutData%LEAStiff,1) - OutData%LEAStiff(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LMassDen not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LMassDen)) DEALLOCATE(OutData%LMassDen) - ALLOCATE(OutData%LMassDen(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LMassDen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LMassDen,1), UBOUND(OutData%LMassDen,1) - OutData%LMassDen(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LDMassDen not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LDMassDen)) DEALLOCATE(OutData%LDMassDen) - ALLOCATE(OutData%LDMassDen(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LDMassDen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LDMassDen,1), UBOUND(OutData%LDMassDen,1) - OutData%LDMassDen(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BottmStiff not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BottmStiff)) DEALLOCATE(OutData%BottmStiff) - ALLOCATE(OutData%BottmStiff(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BottmStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BottmStiff,1), UBOUND(OutData%BottmStiff,1) - OutData%BottmStiff(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LRadAnch not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LRadAnch)) DEALLOCATE(OutData%LRadAnch) - ALLOCATE(OutData%LRadAnch(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LRadAnch.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LRadAnch,1), UBOUND(OutData%LRadAnch,1) - OutData%LRadAnch(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LAngAnch not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LAngAnch)) DEALLOCATE(OutData%LAngAnch) - ALLOCATE(OutData%LAngAnch(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LAngAnch.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LAngAnch,1), UBOUND(OutData%LAngAnch,1) - OutData%LAngAnch(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LDpthAnch not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LDpthAnch)) DEALLOCATE(OutData%LDpthAnch) - ALLOCATE(OutData%LDpthAnch(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LDpthAnch.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LDpthAnch,1), UBOUND(OutData%LDpthAnch,1) - OutData%LDpthAnch(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LRadFair not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LRadFair)) DEALLOCATE(OutData%LRadFair) - ALLOCATE(OutData%LRadFair(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LRadFair.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LRadFair,1), UBOUND(OutData%LRadFair,1) - OutData%LRadFair(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LAngFair not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LAngFair)) DEALLOCATE(OutData%LAngFair) - ALLOCATE(OutData%LAngFair(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LAngFair.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LAngFair,1), UBOUND(OutData%LAngFair,1) - OutData%LAngFair(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LDrftFair not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LDrftFair)) DEALLOCATE(OutData%LDrftFair) - ALLOCATE(OutData%LDrftFair(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LDrftFair.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LDrftFair,1), UBOUND(OutData%LDrftFair,1) - OutData%LDrftFair(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LUnstrLen not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LUnstrLen)) DEALLOCATE(OutData%LUnstrLen) - ALLOCATE(OutData%LUnstrLen(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LUnstrLen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LUnstrLen,1), UBOUND(OutData%LUnstrLen,1) - OutData%LUnstrLen(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Tension not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Tension)) DEALLOCATE(OutData%Tension) - ALLOCATE(OutData%Tension(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Tension.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Tension,1), UBOUND(OutData%Tension,1) - OutData%Tension(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GSL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%GSL)) DEALLOCATE(OutData%GSL) - ALLOCATE(OutData%GSL(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GSL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%GSL,3), UBOUND(OutData%GSL,3) - DO i2 = LBOUND(OutData%GSL,2), UBOUND(OutData%GSL,2) - DO i1 = LBOUND(OutData%GSL,1), UBOUND(OutData%GSL,1) - OutData%GSL(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GSR not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%GSR)) DEALLOCATE(OutData%GSR) - ALLOCATE(OutData%GSR(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GSR.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%GSR,2), UBOUND(OutData%GSR,2) - DO i1 = LBOUND(OutData%GSR,1), UBOUND(OutData%GSR,1) - OutData%GSR(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GE not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%GE)) DEALLOCATE(OutData%GE) - ALLOCATE(OutData%GE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%GE,3), UBOUND(OutData%GE,3) - DO i2 = LBOUND(OutData%GE,2), UBOUND(OutData%GE,2) - DO i1 = LBOUND(OutData%GE,1), UBOUND(OutData%GE,1) - OutData%GE(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%NumLines = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumElems = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Eps = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MaxIter = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) - Int_Xferred = Int_Xferred + 1 - OutData%OutFile = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TabDelim = TRANSFER(IntKiBuf(Int_Xferred), OutData%TabDelim) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Tstart = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutList not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutList)) DEALLOCATE(OutData%OutList) - ALLOCATE(OutData%OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) - DO I = 1, LEN(OutData%OutList) - OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - END SUBROUTINE FEAM_UnPackInputFile +subroutine FEAM_PackInputFile(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FEAM_InputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'FEAM_PackInputFile' + if (Buf%ErrStat >= AbortErrLev) return + ! DT + call RegPack(Buf, InData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! LineCI + call RegPack(Buf, allocated(InData%LineCI)) + if (allocated(InData%LineCI)) then + call RegPackBounds(Buf, 1, lbound(InData%LineCI), ubound(InData%LineCI)) + call RegPack(Buf, InData%LineCI) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LineCD + call RegPack(Buf, allocated(InData%LineCD)) + if (allocated(InData%LineCD)) then + call RegPackBounds(Buf, 1, lbound(InData%LineCD), ubound(InData%LineCD)) + call RegPack(Buf, InData%LineCD) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LEAStiff + call RegPack(Buf, allocated(InData%LEAStiff)) + if (allocated(InData%LEAStiff)) then + call RegPackBounds(Buf, 1, lbound(InData%LEAStiff), ubound(InData%LEAStiff)) + call RegPack(Buf, InData%LEAStiff) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LMassDen + call RegPack(Buf, allocated(InData%LMassDen)) + if (allocated(InData%LMassDen)) then + call RegPackBounds(Buf, 1, lbound(InData%LMassDen), ubound(InData%LMassDen)) + call RegPack(Buf, InData%LMassDen) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LDMassDen + call RegPack(Buf, allocated(InData%LDMassDen)) + if (allocated(InData%LDMassDen)) then + call RegPackBounds(Buf, 1, lbound(InData%LDMassDen), ubound(InData%LDMassDen)) + call RegPack(Buf, InData%LDMassDen) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BottmStiff + call RegPack(Buf, allocated(InData%BottmStiff)) + if (allocated(InData%BottmStiff)) then + call RegPackBounds(Buf, 1, lbound(InData%BottmStiff), ubound(InData%BottmStiff)) + call RegPack(Buf, InData%BottmStiff) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LRadAnch + call RegPack(Buf, allocated(InData%LRadAnch)) + if (allocated(InData%LRadAnch)) then + call RegPackBounds(Buf, 1, lbound(InData%LRadAnch), ubound(InData%LRadAnch)) + call RegPack(Buf, InData%LRadAnch) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LAngAnch + call RegPack(Buf, allocated(InData%LAngAnch)) + if (allocated(InData%LAngAnch)) then + call RegPackBounds(Buf, 1, lbound(InData%LAngAnch), ubound(InData%LAngAnch)) + call RegPack(Buf, InData%LAngAnch) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LDpthAnch + call RegPack(Buf, allocated(InData%LDpthAnch)) + if (allocated(InData%LDpthAnch)) then + call RegPackBounds(Buf, 1, lbound(InData%LDpthAnch), ubound(InData%LDpthAnch)) + call RegPack(Buf, InData%LDpthAnch) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LRadFair + call RegPack(Buf, allocated(InData%LRadFair)) + if (allocated(InData%LRadFair)) then + call RegPackBounds(Buf, 1, lbound(InData%LRadFair), ubound(InData%LRadFair)) + call RegPack(Buf, InData%LRadFair) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LAngFair + call RegPack(Buf, allocated(InData%LAngFair)) + if (allocated(InData%LAngFair)) then + call RegPackBounds(Buf, 1, lbound(InData%LAngFair), ubound(InData%LAngFair)) + call RegPack(Buf, InData%LAngFair) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LDrftFair + call RegPack(Buf, allocated(InData%LDrftFair)) + if (allocated(InData%LDrftFair)) then + call RegPackBounds(Buf, 1, lbound(InData%LDrftFair), ubound(InData%LDrftFair)) + call RegPack(Buf, InData%LDrftFair) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LUnstrLen + call RegPack(Buf, allocated(InData%LUnstrLen)) + if (allocated(InData%LUnstrLen)) then + call RegPackBounds(Buf, 1, lbound(InData%LUnstrLen), ubound(InData%LUnstrLen)) + call RegPack(Buf, InData%LUnstrLen) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Tension + call RegPack(Buf, allocated(InData%Tension)) + if (allocated(InData%Tension)) then + call RegPackBounds(Buf, 1, lbound(InData%Tension), ubound(InData%Tension)) + call RegPack(Buf, InData%Tension) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! GSL + call RegPack(Buf, allocated(InData%GSL)) + if (allocated(InData%GSL)) then + call RegPackBounds(Buf, 3, lbound(InData%GSL), ubound(InData%GSL)) + call RegPack(Buf, InData%GSL) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! GSR + call RegPack(Buf, allocated(InData%GSR)) + if (allocated(InData%GSR)) then + call RegPackBounds(Buf, 2, lbound(InData%GSR), ubound(InData%GSR)) + call RegPack(Buf, InData%GSR) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! GE + call RegPack(Buf, allocated(InData%GE)) + if (allocated(InData%GE)) then + call RegPackBounds(Buf, 3, lbound(InData%GE), ubound(InData%GE)) + call RegPack(Buf, InData%GE) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NumLines + call RegPack(Buf, InData%NumLines) + if (RegCheckErr(Buf, RoutineName)) return + ! NumElems + call RegPack(Buf, InData%NumElems) + if (RegCheckErr(Buf, RoutineName)) return + ! Eps + call RegPack(Buf, InData%Eps) + if (RegCheckErr(Buf, RoutineName)) return + ! Gravity + call RegPack(Buf, InData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDens + call RegPack(Buf, InData%WtrDens) + if (RegCheckErr(Buf, RoutineName)) return + ! MaxIter + call RegPack(Buf, InData%MaxIter) + if (RegCheckErr(Buf, RoutineName)) return + ! SumPrint + call RegPack(Buf, InData%SumPrint) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFile + call RegPack(Buf, InData%OutFile) + if (RegCheckErr(Buf, RoutineName)) return + ! TabDelim + call RegPack(Buf, InData%TabDelim) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFmt + call RegPack(Buf, InData%OutFmt) + if (RegCheckErr(Buf, RoutineName)) return + ! Tstart + call RegPack(Buf, InData%Tstart) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegPack(Buf, InData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! OutList + call RegPack(Buf, allocated(InData%OutList)) + if (allocated(InData%OutList)) then + call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) + call RegPack(Buf, InData%OutList) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FEAM_UnPackInputFile(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FEAM_InputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FEAM_UnPackInputFile' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! DT + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! LineCI + if (allocated(OutData%LineCI)) deallocate(OutData%LineCI) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LineCI(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineCI.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LineCI) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LineCD + if (allocated(OutData%LineCD)) deallocate(OutData%LineCD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LineCD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineCD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LineCD) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LEAStiff + if (allocated(OutData%LEAStiff)) deallocate(OutData%LEAStiff) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LEAStiff(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LEAStiff.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LEAStiff) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LMassDen + if (allocated(OutData%LMassDen)) deallocate(OutData%LMassDen) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LMassDen(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LMassDen.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LMassDen) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LDMassDen + if (allocated(OutData%LDMassDen)) deallocate(OutData%LDMassDen) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LDMassDen(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LDMassDen.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LDMassDen) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BottmStiff + if (allocated(OutData%BottmStiff)) deallocate(OutData%BottmStiff) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BottmStiff(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BottmStiff.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BottmStiff) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LRadAnch + if (allocated(OutData%LRadAnch)) deallocate(OutData%LRadAnch) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LRadAnch(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LRadAnch.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LRadAnch) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LAngAnch + if (allocated(OutData%LAngAnch)) deallocate(OutData%LAngAnch) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LAngAnch(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LAngAnch.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LAngAnch) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LDpthAnch + if (allocated(OutData%LDpthAnch)) deallocate(OutData%LDpthAnch) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LDpthAnch(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LDpthAnch.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LDpthAnch) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LRadFair + if (allocated(OutData%LRadFair)) deallocate(OutData%LRadFair) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LRadFair(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LRadFair.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LRadFair) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LAngFair + if (allocated(OutData%LAngFair)) deallocate(OutData%LAngFair) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LAngFair(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LAngFair.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LAngFair) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LDrftFair + if (allocated(OutData%LDrftFair)) deallocate(OutData%LDrftFair) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LDrftFair(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LDrftFair.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LDrftFair) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LUnstrLen + if (allocated(OutData%LUnstrLen)) deallocate(OutData%LUnstrLen) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LUnstrLen(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LUnstrLen.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LUnstrLen) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Tension + if (allocated(OutData%Tension)) deallocate(OutData%Tension) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Tension(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Tension.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Tension) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! GSL + if (allocated(OutData%GSL)) deallocate(OutData%GSL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%GSL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GSL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%GSL) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! GSR + if (allocated(OutData%GSR)) deallocate(OutData%GSR) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%GSR(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GSR.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%GSR) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! GE + if (allocated(OutData%GE)) deallocate(OutData%GE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%GE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%GE) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NumLines + call RegUnpack(Buf, OutData%NumLines) + if (RegCheckErr(Buf, RoutineName)) return + ! NumElems + call RegUnpack(Buf, OutData%NumElems) + if (RegCheckErr(Buf, RoutineName)) return + ! Eps + call RegUnpack(Buf, OutData%Eps) + if (RegCheckErr(Buf, RoutineName)) return + ! Gravity + call RegUnpack(Buf, OutData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDens + call RegUnpack(Buf, OutData%WtrDens) + if (RegCheckErr(Buf, RoutineName)) return + ! MaxIter + call RegUnpack(Buf, OutData%MaxIter) + if (RegCheckErr(Buf, RoutineName)) return + ! SumPrint + call RegUnpack(Buf, OutData%SumPrint) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFile + call RegUnpack(Buf, OutData%OutFile) + if (RegCheckErr(Buf, RoutineName)) return + ! TabDelim + call RegUnpack(Buf, OutData%TabDelim) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFmt + call RegUnpack(Buf, OutData%OutFmt) + if (RegCheckErr(Buf, RoutineName)) return + ! Tstart + call RegUnpack(Buf, OutData%Tstart) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! OutList + if (allocated(OutData%OutList)) deallocate(OutData%OutList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutList) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE FEAM_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(FEAM_InitInputType), INTENT(IN) :: SrcInitInputData TYPE(FEAM_InitInputType), INTENT(INOUT) :: DstInitInputData @@ -1546,299 +1135,125 @@ SUBROUTINE FEAM_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE FEAM_DestroyInitInput - SUBROUTINE FEAM_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FEAM_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%InputFile) ! InputFile - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Re_BufSz = Re_BufSz + SIZE(InData%PtfmInit) ! PtfmInit - Int_BufSz = Int_BufSz + 1 ! NStepWave - Int_BufSz = Int_BufSz + 1 ! WaveAcc0 allocated yes/no - IF ( ALLOCATED(InData%WaveAcc0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveAcc0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveAcc0) ! WaveAcc0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveTime allocated yes/no - IF ( ALLOCATED(InData%WaveTime) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveTime upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveTime) ! WaveTime - END IF - Int_BufSz = Int_BufSz + 1 ! WaveVel0 allocated yes/no - IF ( ALLOCATED(InData%WaveVel0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveVel0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveVel0) ! WaveVel0 - END IF - Re_BufSz = Re_BufSz + 1 ! Gravity - Re_BufSz = Re_BufSz + 1 ! WtrDens - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO i1 = LBOUND(InData%PtfmInit,1), UBOUND(InData%PtfmInit,1) - ReKiBuf(Re_Xferred) = InData%PtfmInit(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveAcc0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc0,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveAcc0,3), UBOUND(InData%WaveAcc0,3) - DO i2 = LBOUND(InData%WaveAcc0,2), UBOUND(InData%WaveAcc0,2) - DO i1 = LBOUND(InData%WaveAcc0,1), UBOUND(InData%WaveAcc0,1) - ReKiBuf(Re_Xferred) = InData%WaveAcc0(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveTime,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) - ReKiBuf(Re_Xferred) = InData%WaveTime(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveVel0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel0,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveVel0,3), UBOUND(InData%WaveVel0,3) - DO i2 = LBOUND(InData%WaveVel0,2), UBOUND(InData%WaveVel0,2) - DO i1 = LBOUND(InData%WaveVel0,1), UBOUND(InData%WaveVel0,1) - ReKiBuf(Re_Xferred) = InData%WaveVel0(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE FEAM_PackInitInput - - SUBROUTINE FEAM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FEAM_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - i1_l = LBOUND(OutData%PtfmInit,1) - i1_u = UBOUND(OutData%PtfmInit,1) - DO i1 = LBOUND(OutData%PtfmInit,1), UBOUND(OutData%PtfmInit,1) - OutData%PtfmInit(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%NStepWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveAcc0)) DEALLOCATE(OutData%WaveAcc0) - ALLOCATE(OutData%WaveAcc0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveAcc0,3), UBOUND(OutData%WaveAcc0,3) - DO i2 = LBOUND(OutData%WaveAcc0,2), UBOUND(OutData%WaveAcc0,2) - DO i1 = LBOUND(OutData%WaveAcc0,1), UBOUND(OutData%WaveAcc0,1) - OutData%WaveAcc0(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveTime)) DEALLOCATE(OutData%WaveTime) - ALLOCATE(OutData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) - OutData%WaveTime(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveVel0)) DEALLOCATE(OutData%WaveVel0) - ALLOCATE(OutData%WaveVel0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveVel0,3), UBOUND(OutData%WaveVel0,3) - DO i2 = LBOUND(OutData%WaveVel0,2), UBOUND(OutData%WaveVel0,2) - DO i1 = LBOUND(OutData%WaveVel0,1), UBOUND(OutData%WaveVel0,1) - OutData%WaveVel0(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%Gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE FEAM_UnPackInitInput +subroutine FEAM_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FEAM_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FEAM_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + ! InputFile + call RegPack(Buf, InData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegPack(Buf, InData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmInit + call RegPack(Buf, InData%PtfmInit) + if (RegCheckErr(Buf, RoutineName)) return + ! NStepWave + call RegPack(Buf, InData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveAcc0 + call RegPack(Buf, allocated(InData%WaveAcc0)) + if (allocated(InData%WaveAcc0)) then + call RegPackBounds(Buf, 3, lbound(InData%WaveAcc0), ubound(InData%WaveAcc0)) + call RegPack(Buf, InData%WaveAcc0) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveTime + call RegPack(Buf, allocated(InData%WaveTime)) + if (allocated(InData%WaveTime)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) + call RegPack(Buf, InData%WaveTime) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveVel0 + call RegPack(Buf, allocated(InData%WaveVel0)) + if (allocated(InData%WaveVel0)) then + call RegPackBounds(Buf, 3, lbound(InData%WaveVel0), ubound(InData%WaveVel0)) + call RegPack(Buf, InData%WaveVel0) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Gravity + call RegPack(Buf, InData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDens + call RegPack(Buf, InData%WtrDens) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FEAM_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FEAM_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FEAM_UnPackInitInput' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! InputFile + call RegUnpack(Buf, OutData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmInit + call RegUnpack(Buf, OutData%PtfmInit) + if (RegCheckErr(Buf, RoutineName)) return + ! NStepWave + call RegUnpack(Buf, OutData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveAcc0 + if (allocated(OutData%WaveAcc0)) deallocate(OutData%WaveAcc0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveAcc0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveAcc0) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WaveTime + if (allocated(OutData%WaveTime)) deallocate(OutData%WaveTime) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveTime(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveTime) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WaveVel0 + if (allocated(OutData%WaveVel0)) deallocate(OutData%WaveVel0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveVel0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveVel0) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Gravity + call RegUnpack(Buf, OutData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDens + call RegUnpack(Buf, OutData%WtrDens) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE FEAM_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(FEAM_InitOutputType), INTENT(IN) :: SrcInitOutputData TYPE(FEAM_InitOutputType), INTENT(INOUT) :: DstInitOutputData @@ -1996,497 +1411,204 @@ SUBROUTINE FEAM_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE FEAM_DestroyInitOutput - SUBROUTINE FEAM_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FEAM_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! WriteOutputHdr allocated yes/no - IF ( ALLOCATED(InData%WriteOutputHdr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdr upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdr)*LEN(InData%WriteOutputHdr) ! WriteOutputHdr - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputUnt allocated yes/no - IF ( ALLOCATED(InData%WriteOutputUnt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUnt upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUnt)*LEN(InData%WriteOutputUnt) ! WriteOutputUnt - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! LAnchxi allocated yes/no - IF ( ALLOCATED(InData%LAnchxi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LAnchxi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LAnchxi) ! LAnchxi - END IF - Int_BufSz = Int_BufSz + 1 ! LAnchyi allocated yes/no - IF ( ALLOCATED(InData%LAnchyi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LAnchyi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LAnchyi) ! LAnchyi - END IF - Int_BufSz = Int_BufSz + 1 ! LAnchzi allocated yes/no - IF ( ALLOCATED(InData%LAnchzi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LAnchzi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LAnchzi) ! LAnchzi - END IF - Int_BufSz = Int_BufSz + 1 ! LFairxt allocated yes/no - IF ( ALLOCATED(InData%LFairxt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LFairxt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LFairxt) ! LFairxt - END IF - Int_BufSz = Int_BufSz + 1 ! LFairyt allocated yes/no - IF ( ALLOCATED(InData%LFairyt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LFairyt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LFairyt) ! LFairyt - END IF - Int_BufSz = Int_BufSz + 1 ! LFairzt allocated yes/no - IF ( ALLOCATED(InData%LFairzt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LFairzt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LFairzt) ! LFairzt - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%WriteOutputHdr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) - DO I = 1, LEN(InData%WriteOutputHdr) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputUnt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) - DO I = 1, LEN(InData%WriteOutputUnt) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%LAnchxi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LAnchxi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LAnchxi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LAnchxi,1), UBOUND(InData%LAnchxi,1) - ReKiBuf(Re_Xferred) = InData%LAnchxi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LAnchyi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LAnchyi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LAnchyi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LAnchyi,1), UBOUND(InData%LAnchyi,1) - ReKiBuf(Re_Xferred) = InData%LAnchyi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LAnchzi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LAnchzi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LAnchzi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LAnchzi,1), UBOUND(InData%LAnchzi,1) - ReKiBuf(Re_Xferred) = InData%LAnchzi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LFairxt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LFairxt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LFairxt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LFairxt,1), UBOUND(InData%LFairxt,1) - ReKiBuf(Re_Xferred) = InData%LFairxt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LFairyt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LFairyt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LFairyt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LFairyt,1), UBOUND(InData%LFairyt,1) - ReKiBuf(Re_Xferred) = InData%LFairyt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LFairzt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LFairzt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LFairzt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LFairzt,1), UBOUND(InData%LFairzt,1) - ReKiBuf(Re_Xferred) = InData%LFairzt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FEAM_PackInitOutput - - SUBROUTINE FEAM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FEAM_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputHdr)) DEALLOCATE(OutData%WriteOutputHdr) - ALLOCATE(OutData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) - DO I = 1, LEN(OutData%WriteOutputHdr) - OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputUnt)) DEALLOCATE(OutData%WriteOutputUnt) - ALLOCATE(OutData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) - DO I = 1, LEN(OutData%WriteOutputUnt) - OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LAnchxi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LAnchxi)) DEALLOCATE(OutData%LAnchxi) - ALLOCATE(OutData%LAnchxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LAnchxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LAnchxi,1), UBOUND(OutData%LAnchxi,1) - OutData%LAnchxi(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LAnchyi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LAnchyi)) DEALLOCATE(OutData%LAnchyi) - ALLOCATE(OutData%LAnchyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LAnchyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LAnchyi,1), UBOUND(OutData%LAnchyi,1) - OutData%LAnchyi(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LAnchzi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LAnchzi)) DEALLOCATE(OutData%LAnchzi) - ALLOCATE(OutData%LAnchzi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LAnchzi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LAnchzi,1), UBOUND(OutData%LAnchzi,1) - OutData%LAnchzi(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LFairxt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LFairxt)) DEALLOCATE(OutData%LFairxt) - ALLOCATE(OutData%LFairxt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LFairxt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LFairxt,1), UBOUND(OutData%LFairxt,1) - OutData%LFairxt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LFairyt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LFairyt)) DEALLOCATE(OutData%LFairyt) - ALLOCATE(OutData%LFairyt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LFairyt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LFairyt,1), UBOUND(OutData%LFairyt,1) - OutData%LFairyt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LFairzt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LFairzt)) DEALLOCATE(OutData%LFairzt) - ALLOCATE(OutData%LFairzt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LFairzt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LFairzt,1), UBOUND(OutData%LFairzt,1) - OutData%LFairzt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FEAM_UnPackInitOutput +subroutine FEAM_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FEAM_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FEAM_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! WriteOutputHdr + call RegPack(Buf, allocated(InData%WriteOutputHdr)) + if (allocated(InData%WriteOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPack(Buf, InData%WriteOutputHdr) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutputUnt + call RegPack(Buf, allocated(InData%WriteOutputUnt)) + if (allocated(InData%WriteOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPack(Buf, InData%WriteOutputUnt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Ver + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + if (RegCheckErr(Buf, RoutineName)) return + ! LAnchxi + call RegPack(Buf, allocated(InData%LAnchxi)) + if (allocated(InData%LAnchxi)) then + call RegPackBounds(Buf, 1, lbound(InData%LAnchxi), ubound(InData%LAnchxi)) + call RegPack(Buf, InData%LAnchxi) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LAnchyi + call RegPack(Buf, allocated(InData%LAnchyi)) + if (allocated(InData%LAnchyi)) then + call RegPackBounds(Buf, 1, lbound(InData%LAnchyi), ubound(InData%LAnchyi)) + call RegPack(Buf, InData%LAnchyi) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LAnchzi + call RegPack(Buf, allocated(InData%LAnchzi)) + if (allocated(InData%LAnchzi)) then + call RegPackBounds(Buf, 1, lbound(InData%LAnchzi), ubound(InData%LAnchzi)) + call RegPack(Buf, InData%LAnchzi) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LFairxt + call RegPack(Buf, allocated(InData%LFairxt)) + if (allocated(InData%LFairxt)) then + call RegPackBounds(Buf, 1, lbound(InData%LFairxt), ubound(InData%LFairxt)) + call RegPack(Buf, InData%LFairxt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LFairyt + call RegPack(Buf, allocated(InData%LFairyt)) + if (allocated(InData%LFairyt)) then + call RegPackBounds(Buf, 1, lbound(InData%LFairyt), ubound(InData%LFairyt)) + call RegPack(Buf, InData%LFairyt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LFairzt + call RegPack(Buf, allocated(InData%LFairzt)) + if (allocated(InData%LFairzt)) then + call RegPackBounds(Buf, 1, lbound(InData%LFairzt), ubound(InData%LFairzt)) + call RegPack(Buf, InData%LFairzt) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FEAM_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FEAM_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FEAM_UnPackInitOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! WriteOutputHdr + if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WriteOutputUnt + if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Ver + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + ! LAnchxi + if (allocated(OutData%LAnchxi)) deallocate(OutData%LAnchxi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LAnchxi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LAnchxi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LAnchxi) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LAnchyi + if (allocated(OutData%LAnchyi)) deallocate(OutData%LAnchyi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LAnchyi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LAnchyi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LAnchyi) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LAnchzi + if (allocated(OutData%LAnchzi)) deallocate(OutData%LAnchzi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LAnchzi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LAnchzi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LAnchzi) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LFairxt + if (allocated(OutData%LFairxt)) deallocate(OutData%LFairxt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LFairxt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LFairxt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LFairxt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LFairyt + if (allocated(OutData%LFairyt)) deallocate(OutData%LFairyt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LFairyt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LFairyt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LFairyt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LFairzt + if (allocated(OutData%LFairzt)) deallocate(OutData%LFairzt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LFairzt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LFairzt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LFairzt) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE FEAM_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(FEAM_ContinuousStateType), INTENT(IN) :: SrcContStateData TYPE(FEAM_ContinuousStateType), INTENT(INOUT) :: DstContStateData @@ -2554,196 +1676,67 @@ SUBROUTINE FEAM_DestroyContState( ContStateData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE FEAM_DestroyContState - SUBROUTINE FEAM_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FEAM_ContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_PackContState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! GLU allocated yes/no - IF ( ALLOCATED(InData%GLU) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! GLU upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GLU) ! GLU - END IF - Int_BufSz = Int_BufSz + 1 ! GLDU allocated yes/no - IF ( ALLOCATED(InData%GLDU) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! GLDU upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GLDU) ! GLDU - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%GLU) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GLU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLU,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GLU,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLU,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%GLU,2), UBOUND(InData%GLU,2) - DO i1 = LBOUND(InData%GLU,1), UBOUND(InData%GLU,1) - ReKiBuf(Re_Xferred) = InData%GLU(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%GLDU) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GLDU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLDU,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GLDU,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLDU,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%GLDU,2), UBOUND(InData%GLDU,2) - DO i1 = LBOUND(InData%GLDU,1), UBOUND(InData%GLDU,1) - ReKiBuf(Re_Xferred) = InData%GLDU(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE FEAM_PackContState - - SUBROUTINE FEAM_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FEAM_ContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_UnPackContState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GLU not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%GLU)) DEALLOCATE(OutData%GLU) - ALLOCATE(OutData%GLU(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%GLU,2), UBOUND(OutData%GLU,2) - DO i1 = LBOUND(OutData%GLU,1), UBOUND(OutData%GLU,1) - OutData%GLU(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GLDU not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%GLDU)) DEALLOCATE(OutData%GLDU) - ALLOCATE(OutData%GLDU(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLDU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%GLDU,2), UBOUND(OutData%GLDU,2) - DO i1 = LBOUND(OutData%GLDU,1), UBOUND(OutData%GLDU,1) - OutData%GLDU(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE FEAM_UnPackContState +subroutine FEAM_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FEAM_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FEAM_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + ! GLU + call RegPack(Buf, allocated(InData%GLU)) + if (allocated(InData%GLU)) then + call RegPackBounds(Buf, 2, lbound(InData%GLU), ubound(InData%GLU)) + call RegPack(Buf, InData%GLU) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! GLDU + call RegPack(Buf, allocated(InData%GLDU)) + if (allocated(InData%GLDU)) then + call RegPackBounds(Buf, 2, lbound(InData%GLDU), ubound(InData%GLDU)) + call RegPack(Buf, InData%GLDU) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FEAM_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FEAM_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FEAM_UnPackContState' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! GLU + if (allocated(OutData%GLU)) deallocate(OutData%GLU) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%GLU(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%GLU) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! GLDU + if (allocated(OutData%GLDU)) deallocate(OutData%GLDU) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%GLDU(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLDU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%GLDU) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE FEAM_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(FEAM_DiscreteStateType), INTENT(IN) :: SrcDiscStateData TYPE(FEAM_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData @@ -2776,103 +1769,26 @@ SUBROUTINE FEAM_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) END SUBROUTINE FEAM_DestroyDiscState - SUBROUTINE FEAM_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FEAM_DiscreteStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_PackDiscState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyDiscState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE FEAM_PackDiscState - - SUBROUTINE FEAM_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FEAM_DiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_UnPackDiscState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyDiscState = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE FEAM_UnPackDiscState +subroutine FEAM_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FEAM_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FEAM_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyDiscState + call RegPack(Buf, InData%DummyDiscState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FEAM_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FEAM_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FEAM_UnPackDiscState' + if (Buf%ErrStat /= ErrID_None) return + ! DummyDiscState + call RegUnpack(Buf, OutData%DummyDiscState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE FEAM_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(FEAM_ConstraintStateType), INTENT(IN) :: SrcConstrStateData TYPE(FEAM_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData @@ -2907,121 +1823,32 @@ SUBROUTINE FEAM_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) END SUBROUTINE FEAM_DestroyConstrState - SUBROUTINE FEAM_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FEAM_ConstraintStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_PackConstrState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + SIZE(InData%TSN) ! TSN - Re_BufSz = Re_BufSz + SIZE(InData%TZER) ! TZER - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i1 = LBOUND(InData%TSN,1), UBOUND(InData%TSN,1) - ReKiBuf(Re_Xferred) = InData%TSN(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TZER,1), UBOUND(InData%TZER,1) - ReKiBuf(Re_Xferred) = InData%TZER(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE FEAM_PackConstrState - - SUBROUTINE FEAM_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FEAM_ConstraintStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_UnPackConstrState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%TSN,1) - i1_u = UBOUND(OutData%TSN,1) - DO i1 = LBOUND(OutData%TSN,1), UBOUND(OutData%TSN,1) - OutData%TSN(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TZER,1) - i1_u = UBOUND(OutData%TZER,1) - DO i1 = LBOUND(OutData%TZER,1), UBOUND(OutData%TZER,1) - OutData%TZER(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE FEAM_UnPackConstrState +subroutine FEAM_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FEAM_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FEAM_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + ! TSN + call RegPack(Buf, InData%TSN) + if (RegCheckErr(Buf, RoutineName)) return + ! TZER + call RegPack(Buf, InData%TZER) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FEAM_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FEAM_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FEAM_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + ! TSN + call RegUnpack(Buf, OutData%TSN) + if (RegCheckErr(Buf, RoutineName)) return + ! TZER + call RegUnpack(Buf, OutData%TZER) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE FEAM_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(FEAM_OtherStateType), INTENT(IN) :: SrcOtherStateData TYPE(FEAM_OtherStateType), INTENT(INOUT) :: DstOtherStateData @@ -3170,469 +1997,185 @@ SUBROUTINE FEAM_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE FEAM_DestroyOtherState - SUBROUTINE FEAM_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FEAM_OtherStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_PackOtherState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! GLU0 allocated yes/no - IF ( ALLOCATED(InData%GLU0) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! GLU0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GLU0) ! GLU0 - END IF - Int_BufSz = Int_BufSz + 1 ! GLDDU allocated yes/no - IF ( ALLOCATED(InData%GLDDU) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! GLDDU upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GLDDU) ! GLDDU - END IF - Int_BufSz = Int_BufSz + 1 ! BottomTouch - Int_BufSz = Int_BufSz + 1 ! GFORC0 allocated yes/no - IF ( ALLOCATED(InData%GFORC0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! GFORC0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GFORC0) ! GFORC0 - END IF - Int_BufSz = Int_BufSz + 1 ! GMASS0 allocated yes/no - IF ( ALLOCATED(InData%GMASS0) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! GMASS0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GMASS0) ! GMASS0 - END IF - Int_BufSz = Int_BufSz + 1 ! FAST_FPA allocated yes/no - IF ( ALLOCATED(InData%FAST_FPA) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FAST_FPA upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FAST_FPA) ! FAST_FPA - END IF - Int_BufSz = Int_BufSz + 1 ! FAST_RP allocated yes/no - IF ( ALLOCATED(InData%FAST_RP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FAST_RP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FAST_RP) ! FAST_RP - END IF - Int_BufSz = Int_BufSz + 1 ! INCR - Re_BufSz = Re_BufSz + SIZE(InData%RSDF) ! RSDF - Re_BufSz = Re_BufSz + SIZE(InData%FORC0) ! FORC0 - Re_BufSz = Re_BufSz + SIZE(InData%EMAS0) ! EMAS0 - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%GLU0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GLU0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLU0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GLU0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLU0,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%GLU0,2), UBOUND(InData%GLU0,2) - DO i1 = LBOUND(InData%GLU0,1), UBOUND(InData%GLU0,1) - ReKiBuf(Re_Xferred) = InData%GLU0(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%GLDDU) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GLDDU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLDDU,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GLDDU,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLDDU,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%GLDDU,2), UBOUND(InData%GLDDU,2) - DO i1 = LBOUND(InData%GLDDU,1), UBOUND(InData%GLDDU,1) - ReKiBuf(Re_Xferred) = InData%GLDDU(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%BottomTouch, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%GFORC0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GFORC0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GFORC0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GFORC0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GFORC0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GFORC0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GFORC0,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%GFORC0,3), UBOUND(InData%GFORC0,3) - DO i2 = LBOUND(InData%GFORC0,2), UBOUND(InData%GFORC0,2) - DO i1 = LBOUND(InData%GFORC0,1), UBOUND(InData%GFORC0,1) - ReKiBuf(Re_Xferred) = InData%GFORC0(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%GMASS0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GMASS0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GMASS0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GMASS0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GMASS0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GMASS0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GMASS0,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GMASS0,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GMASS0,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%GMASS0,4), UBOUND(InData%GMASS0,4) - DO i3 = LBOUND(InData%GMASS0,3), UBOUND(InData%GMASS0,3) - DO i2 = LBOUND(InData%GMASS0,2), UBOUND(InData%GMASS0,2) - DO i1 = LBOUND(InData%GMASS0,1), UBOUND(InData%GMASS0,1) - ReKiBuf(Re_Xferred) = InData%GMASS0(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FAST_FPA) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FAST_FPA,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAST_FPA,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FAST_FPA,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAST_FPA,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FAST_FPA,2), UBOUND(InData%FAST_FPA,2) - DO i1 = LBOUND(InData%FAST_FPA,1), UBOUND(InData%FAST_FPA,1) - ReKiBuf(Re_Xferred) = InData%FAST_FPA(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FAST_RP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FAST_RP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAST_RP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FAST_RP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAST_RP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FAST_RP,2), UBOUND(InData%FAST_RP,2) - DO i1 = LBOUND(InData%FAST_RP,1), UBOUND(InData%FAST_RP,1) - ReKiBuf(Re_Xferred) = InData%FAST_RP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%INCR - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%RSDF,1), UBOUND(InData%RSDF,1) - ReKiBuf(Re_Xferred) = InData%RSDF(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%FORC0,1), UBOUND(InData%FORC0,1) - ReKiBuf(Re_Xferred) = InData%FORC0(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i2 = LBOUND(InData%EMAS0,2), UBOUND(InData%EMAS0,2) - DO i1 = LBOUND(InData%EMAS0,1), UBOUND(InData%EMAS0,1) - ReKiBuf(Re_Xferred) = InData%EMAS0(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END SUBROUTINE FEAM_PackOtherState - - SUBROUTINE FEAM_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FEAM_OtherStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_UnPackOtherState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GLU0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%GLU0)) DEALLOCATE(OutData%GLU0) - ALLOCATE(OutData%GLU0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLU0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%GLU0,2), UBOUND(OutData%GLU0,2) - DO i1 = LBOUND(OutData%GLU0,1), UBOUND(OutData%GLU0,1) - OutData%GLU0(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GLDDU not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%GLDDU)) DEALLOCATE(OutData%GLDDU) - ALLOCATE(OutData%GLDDU(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLDDU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%GLDDU,2), UBOUND(OutData%GLDDU,2) - DO i1 = LBOUND(OutData%GLDDU,1), UBOUND(OutData%GLDDU,1) - OutData%GLDDU(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%BottomTouch = TRANSFER(IntKiBuf(Int_Xferred), OutData%BottomTouch) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GFORC0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%GFORC0)) DEALLOCATE(OutData%GFORC0) - ALLOCATE(OutData%GFORC0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GFORC0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%GFORC0,3), UBOUND(OutData%GFORC0,3) - DO i2 = LBOUND(OutData%GFORC0,2), UBOUND(OutData%GFORC0,2) - DO i1 = LBOUND(OutData%GFORC0,1), UBOUND(OutData%GFORC0,1) - OutData%GFORC0(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GMASS0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%GMASS0)) DEALLOCATE(OutData%GMASS0) - ALLOCATE(OutData%GMASS0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GMASS0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%GMASS0,4), UBOUND(OutData%GMASS0,4) - DO i3 = LBOUND(OutData%GMASS0,3), UBOUND(OutData%GMASS0,3) - DO i2 = LBOUND(OutData%GMASS0,2), UBOUND(OutData%GMASS0,2) - DO i1 = LBOUND(OutData%GMASS0,1), UBOUND(OutData%GMASS0,1) - OutData%GMASS0(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FAST_FPA not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FAST_FPA)) DEALLOCATE(OutData%FAST_FPA) - ALLOCATE(OutData%FAST_FPA(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAST_FPA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FAST_FPA,2), UBOUND(OutData%FAST_FPA,2) - DO i1 = LBOUND(OutData%FAST_FPA,1), UBOUND(OutData%FAST_FPA,1) - OutData%FAST_FPA(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FAST_RP not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FAST_RP)) DEALLOCATE(OutData%FAST_RP) - ALLOCATE(OutData%FAST_RP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAST_RP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FAST_RP,2), UBOUND(OutData%FAST_RP,2) - DO i1 = LBOUND(OutData%FAST_RP,1), UBOUND(OutData%FAST_RP,1) - OutData%FAST_RP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%INCR = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%RSDF,1) - i1_u = UBOUND(OutData%RSDF,1) - DO i1 = LBOUND(OutData%RSDF,1), UBOUND(OutData%RSDF,1) - OutData%RSDF(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%FORC0,1) - i1_u = UBOUND(OutData%FORC0,1) - DO i1 = LBOUND(OutData%FORC0,1), UBOUND(OutData%FORC0,1) - OutData%FORC0(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%EMAS0,1) - i1_u = UBOUND(OutData%EMAS0,1) - i2_l = LBOUND(OutData%EMAS0,2) - i2_u = UBOUND(OutData%EMAS0,2) - DO i2 = LBOUND(OutData%EMAS0,2), UBOUND(OutData%EMAS0,2) - DO i1 = LBOUND(OutData%EMAS0,1), UBOUND(OutData%EMAS0,1) - OutData%EMAS0(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END SUBROUTINE FEAM_UnPackOtherState +subroutine FEAM_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FEAM_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FEAM_PackOtherState' + if (Buf%ErrStat >= AbortErrLev) return + ! GLU0 + call RegPack(Buf, allocated(InData%GLU0)) + if (allocated(InData%GLU0)) then + call RegPackBounds(Buf, 2, lbound(InData%GLU0), ubound(InData%GLU0)) + call RegPack(Buf, InData%GLU0) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! GLDDU + call RegPack(Buf, allocated(InData%GLDDU)) + if (allocated(InData%GLDDU)) then + call RegPackBounds(Buf, 2, lbound(InData%GLDDU), ubound(InData%GLDDU)) + call RegPack(Buf, InData%GLDDU) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BottomTouch + call RegPack(Buf, InData%BottomTouch) + if (RegCheckErr(Buf, RoutineName)) return + ! GFORC0 + call RegPack(Buf, allocated(InData%GFORC0)) + if (allocated(InData%GFORC0)) then + call RegPackBounds(Buf, 3, lbound(InData%GFORC0), ubound(InData%GFORC0)) + call RegPack(Buf, InData%GFORC0) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! GMASS0 + call RegPack(Buf, allocated(InData%GMASS0)) + if (allocated(InData%GMASS0)) then + call RegPackBounds(Buf, 4, lbound(InData%GMASS0), ubound(InData%GMASS0)) + call RegPack(Buf, InData%GMASS0) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FAST_FPA + call RegPack(Buf, allocated(InData%FAST_FPA)) + if (allocated(InData%FAST_FPA)) then + call RegPackBounds(Buf, 2, lbound(InData%FAST_FPA), ubound(InData%FAST_FPA)) + call RegPack(Buf, InData%FAST_FPA) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FAST_RP + call RegPack(Buf, allocated(InData%FAST_RP)) + if (allocated(InData%FAST_RP)) then + call RegPackBounds(Buf, 2, lbound(InData%FAST_RP), ubound(InData%FAST_RP)) + call RegPack(Buf, InData%FAST_RP) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! INCR + call RegPack(Buf, InData%INCR) + if (RegCheckErr(Buf, RoutineName)) return + ! RSDF + call RegPack(Buf, InData%RSDF) + if (RegCheckErr(Buf, RoutineName)) return + ! FORC0 + call RegPack(Buf, InData%FORC0) + if (RegCheckErr(Buf, RoutineName)) return + ! EMAS0 + call RegPack(Buf, InData%EMAS0) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FEAM_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FEAM_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FEAM_UnPackOtherState' + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! GLU0 + if (allocated(OutData%GLU0)) deallocate(OutData%GLU0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%GLU0(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLU0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%GLU0) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! GLDDU + if (allocated(OutData%GLDDU)) deallocate(OutData%GLDDU) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%GLDDU(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLDDU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%GLDDU) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BottomTouch + call RegUnpack(Buf, OutData%BottomTouch) + if (RegCheckErr(Buf, RoutineName)) return + ! GFORC0 + if (allocated(OutData%GFORC0)) deallocate(OutData%GFORC0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%GFORC0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GFORC0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%GFORC0) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! GMASS0 + if (allocated(OutData%GMASS0)) deallocate(OutData%GMASS0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%GMASS0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GMASS0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%GMASS0) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! FAST_FPA + if (allocated(OutData%FAST_FPA)) deallocate(OutData%FAST_FPA) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FAST_FPA(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAST_FPA.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FAST_FPA) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! FAST_RP + if (allocated(OutData%FAST_RP)) deallocate(OutData%FAST_RP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FAST_RP(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAST_RP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FAST_RP) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! INCR + call RegUnpack(Buf, OutData%INCR) + if (RegCheckErr(Buf, RoutineName)) return + ! RSDF + call RegUnpack(Buf, OutData%RSDF) + if (RegCheckErr(Buf, RoutineName)) return + ! FORC0 + call RegUnpack(Buf, OutData%FORC0) + if (RegCheckErr(Buf, RoutineName)) return + ! EMAS0 + call RegUnpack(Buf, OutData%EMAS0) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE FEAM_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) TYPE(FEAM_MiscVarType), INTENT(IN) :: SrcMiscData TYPE(FEAM_MiscVarType), INTENT(INOUT) :: DstMiscData @@ -3769,865 +2312,411 @@ SUBROUTINE FEAM_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) IF (.NOT. ALLOCATED(DstMiscData%Line_Coordinate)) THEN ALLOCATE(DstMiscData%Line_Coordinate(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Line_Coordinate.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Line_Coordinate = SrcMiscData%Line_Coordinate -ENDIF -IF (ALLOCATED(SrcMiscData%Line_Tangent)) THEN - i1_l = LBOUND(SrcMiscData%Line_Tangent,1) - i1_u = UBOUND(SrcMiscData%Line_Tangent,1) - i2_l = LBOUND(SrcMiscData%Line_Tangent,2) - i2_u = UBOUND(SrcMiscData%Line_Tangent,2) - i3_l = LBOUND(SrcMiscData%Line_Tangent,3) - i3_u = UBOUND(SrcMiscData%Line_Tangent,3) - IF (.NOT. ALLOCATED(DstMiscData%Line_Tangent)) THEN - ALLOCATE(DstMiscData%Line_Tangent(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Line_Tangent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Line_Tangent = SrcMiscData%Line_Tangent -ENDIF -IF (ALLOCATED(SrcMiscData%F_Lines)) THEN - i1_l = LBOUND(SrcMiscData%F_Lines,1) - i1_u = UBOUND(SrcMiscData%F_Lines,1) - i2_l = LBOUND(SrcMiscData%F_Lines,2) - i2_u = UBOUND(SrcMiscData%F_Lines,2) - IF (.NOT. ALLOCATED(DstMiscData%F_Lines)) THEN - ALLOCATE(DstMiscData%F_Lines(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_Lines.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_Lines = SrcMiscData%F_Lines -ENDIF - DstMiscData%LastIndWave = SrcMiscData%LastIndWave - END SUBROUTINE FEAM_CopyMisc - - SUBROUTINE FEAM_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(FEAM_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MiscData%GLF)) THEN - DEALLOCATE(MiscData%GLF) -ENDIF -IF (ALLOCATED(MiscData%GLK)) THEN - DEALLOCATE(MiscData%GLK) -ENDIF -IF (ALLOCATED(MiscData%FAST_FP)) THEN - DEALLOCATE(MiscData%FAST_FP) -ENDIF -IF (ALLOCATED(MiscData%FAIR_ANG)) THEN - DEALLOCATE(MiscData%FAIR_ANG) -ENDIF -IF (ALLOCATED(MiscData%FAIR_T)) THEN - DEALLOCATE(MiscData%FAIR_T) -ENDIF -IF (ALLOCATED(MiscData%ANCH_ANG)) THEN - DEALLOCATE(MiscData%ANCH_ANG) -ENDIF -IF (ALLOCATED(MiscData%ANCH_T)) THEN - DEALLOCATE(MiscData%ANCH_T) -ENDIF -IF (ALLOCATED(MiscData%Line_Coordinate)) THEN - DEALLOCATE(MiscData%Line_Coordinate) -ENDIF -IF (ALLOCATED(MiscData%Line_Tangent)) THEN - DEALLOCATE(MiscData%Line_Tangent) -ENDIF -IF (ALLOCATED(MiscData%F_Lines)) THEN - DEALLOCATE(MiscData%F_Lines) -ENDIF - END SUBROUTINE FEAM_DestroyMisc - - SUBROUTINE FEAM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FEAM_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! GLF allocated yes/no - IF ( ALLOCATED(InData%GLF) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! GLF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GLF) ! GLF - END IF - Int_BufSz = Int_BufSz + 1 ! GLK allocated yes/no - IF ( ALLOCATED(InData%GLK) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! GLK upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GLK) ! GLK - END IF - Re_BufSz = Re_BufSz + SIZE(InData%EMASS) ! EMASS - Re_BufSz = Re_BufSz + SIZE(InData%ESTIF) ! ESTIF - Int_BufSz = Int_BufSz + 1 ! FAST_FP allocated yes/no - IF ( ALLOCATED(InData%FAST_FP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FAST_FP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FAST_FP) ! FAST_FP - END IF - Re_BufSz = Re_BufSz + SIZE(InData%FORCE) ! FORCE - Re_BufSz = Re_BufSz + SIZE(InData%FP) ! FP - Re_BufSz = Re_BufSz + SIZE(InData%U) ! U - Re_BufSz = Re_BufSz + SIZE(InData%U0) ! U0 - Re_BufSz = Re_BufSz + SIZE(InData%DU) ! DU - Re_BufSz = Re_BufSz + SIZE(InData%DDU) ! DDU - Re_BufSz = Re_BufSz + SIZE(InData%R) ! R - Re_BufSz = Re_BufSz + SIZE(InData%RP) ! RP - Re_BufSz = Re_BufSz + SIZE(InData%RHSR) ! RHSR - Re_BufSz = Re_BufSz + SIZE(InData%SLIN) ! SLIN - Re_BufSz = Re_BufSz + SIZE(InData%STIFR) ! STIFR - Int_BufSz = Int_BufSz + 1 ! FAIR_ANG allocated yes/no - IF ( ALLOCATED(InData%FAIR_ANG) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FAIR_ANG upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FAIR_ANG) ! FAIR_ANG - END IF - Int_BufSz = Int_BufSz + 1 ! FAIR_T allocated yes/no - IF ( ALLOCATED(InData%FAIR_T) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FAIR_T upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FAIR_T) ! FAIR_T - END IF - Int_BufSz = Int_BufSz + 1 ! ANCH_ANG allocated yes/no - IF ( ALLOCATED(InData%ANCH_ANG) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ANCH_ANG upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ANCH_ANG) ! ANCH_ANG - END IF - Int_BufSz = Int_BufSz + 1 ! ANCH_T allocated yes/no - IF ( ALLOCATED(InData%ANCH_T) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ANCH_T upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ANCH_T) ! ANCH_T - END IF - Int_BufSz = Int_BufSz + 1 ! Line_Coordinate allocated yes/no - IF ( ALLOCATED(InData%Line_Coordinate) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Line_Coordinate upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Line_Coordinate) ! Line_Coordinate - END IF - Int_BufSz = Int_BufSz + 1 ! Line_Tangent allocated yes/no - IF ( ALLOCATED(InData%Line_Tangent) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Line_Tangent upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Line_Tangent) ! Line_Tangent - END IF - Int_BufSz = Int_BufSz + 1 ! F_Lines allocated yes/no - IF ( ALLOCATED(InData%F_Lines) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_Lines upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_Lines) ! F_Lines - END IF - Int_BufSz = Int_BufSz + 1 ! LastIndWave - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%GLF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GLF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GLF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLF,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%GLF,2), UBOUND(InData%GLF,2) - DO i1 = LBOUND(InData%GLF,1), UBOUND(InData%GLF,1) - ReKiBuf(Re_Xferred) = InData%GLF(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%GLK) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GLK,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLK,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GLK,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLK,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GLK,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLK,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%GLK,3), UBOUND(InData%GLK,3) - DO i2 = LBOUND(InData%GLK,2), UBOUND(InData%GLK,2) - DO i1 = LBOUND(InData%GLK,1), UBOUND(InData%GLK,1) - ReKiBuf(Re_Xferred) = InData%GLK(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - DO i2 = LBOUND(InData%EMASS,2), UBOUND(InData%EMASS,2) - DO i1 = LBOUND(InData%EMASS,1), UBOUND(InData%EMASS,1) - ReKiBuf(Re_Xferred) = InData%EMASS(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%ESTIF,2), UBOUND(InData%ESTIF,2) - DO i1 = LBOUND(InData%ESTIF,1), UBOUND(InData%ESTIF,1) - ReKiBuf(Re_Xferred) = InData%ESTIF(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( .NOT. ALLOCATED(InData%FAST_FP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FAST_FP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAST_FP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FAST_FP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAST_FP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FAST_FP,2), UBOUND(InData%FAST_FP,2) - DO i1 = LBOUND(InData%FAST_FP,1), UBOUND(InData%FAST_FP,1) - ReKiBuf(Re_Xferred) = InData%FAST_FP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%FORCE,1), UBOUND(InData%FORCE,1) - ReKiBuf(Re_Xferred) = InData%FORCE(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%FP,1), UBOUND(InData%FP,1) - ReKiBuf(Re_Xferred) = InData%FP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i2 = LBOUND(InData%U,2), UBOUND(InData%U,2) - DO i1 = LBOUND(InData%U,1), UBOUND(InData%U,1) - ReKiBuf(Re_Xferred) = InData%U(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%U0,2), UBOUND(InData%U0,2) - DO i1 = LBOUND(InData%U0,1), UBOUND(InData%U0,1) - ReKiBuf(Re_Xferred) = InData%U0(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%DU,2), UBOUND(InData%DU,2) - DO i1 = LBOUND(InData%DU,1), UBOUND(InData%DU,1) - ReKiBuf(Re_Xferred) = InData%DU(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%DDU,2), UBOUND(InData%DDU,2) - DO i1 = LBOUND(InData%DDU,1), UBOUND(InData%DDU,1) - ReKiBuf(Re_Xferred) = InData%DDU(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i1 = LBOUND(InData%R,1), UBOUND(InData%R,1) - ReKiBuf(Re_Xferred) = InData%R(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%RP,1), UBOUND(InData%RP,1) - ReKiBuf(Re_Xferred) = InData%RP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%RHSR,1), UBOUND(InData%RHSR,1) - ReKiBuf(Re_Xferred) = InData%RHSR(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%SLIN,1), UBOUND(InData%SLIN,1) - ReKiBuf(Re_Xferred) = InData%SLIN(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i2 = LBOUND(InData%STIFR,2), UBOUND(InData%STIFR,2) - DO i1 = LBOUND(InData%STIFR,1), UBOUND(InData%STIFR,1) - ReKiBuf(Re_Xferred) = InData%STIFR(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( .NOT. ALLOCATED(InData%FAIR_ANG) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FAIR_ANG,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAIR_ANG,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FAIR_ANG,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAIR_ANG,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FAIR_ANG,2), UBOUND(InData%FAIR_ANG,2) - DO i1 = LBOUND(InData%FAIR_ANG,1), UBOUND(InData%FAIR_ANG,1) - ReKiBuf(Re_Xferred) = InData%FAIR_ANG(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FAIR_T) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FAIR_T,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAIR_T,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FAIR_T,1), UBOUND(InData%FAIR_T,1) - ReKiBuf(Re_Xferred) = InData%FAIR_T(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ANCH_ANG) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ANCH_ANG,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ANCH_ANG,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ANCH_ANG,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ANCH_ANG,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ANCH_ANG,2), UBOUND(InData%ANCH_ANG,2) - DO i1 = LBOUND(InData%ANCH_ANG,1), UBOUND(InData%ANCH_ANG,1) - ReKiBuf(Re_Xferred) = InData%ANCH_ANG(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ANCH_T) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ANCH_T,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ANCH_T,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ANCH_T,1), UBOUND(InData%ANCH_T,1) - ReKiBuf(Re_Xferred) = InData%ANCH_T(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Line_Coordinate) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Line_Coordinate,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Line_Coordinate,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Line_Coordinate,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Line_Coordinate,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Line_Coordinate,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Line_Coordinate,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Line_Coordinate,3), UBOUND(InData%Line_Coordinate,3) - DO i2 = LBOUND(InData%Line_Coordinate,2), UBOUND(InData%Line_Coordinate,2) - DO i1 = LBOUND(InData%Line_Coordinate,1), UBOUND(InData%Line_Coordinate,1) - ReKiBuf(Re_Xferred) = InData%Line_Coordinate(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Line_Tangent) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Line_Tangent,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Line_Tangent,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Line_Tangent,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Line_Tangent,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Line_Tangent,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Line_Tangent,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Line_Tangent,3), UBOUND(InData%Line_Tangent,3) - DO i2 = LBOUND(InData%Line_Tangent,2), UBOUND(InData%Line_Tangent,2) - DO i1 = LBOUND(InData%Line_Tangent,1), UBOUND(InData%Line_Tangent,1) - ReKiBuf(Re_Xferred) = InData%Line_Tangent(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_Lines) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_Lines,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_Lines,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_Lines,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_Lines,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_Lines,2), UBOUND(InData%F_Lines,2) - DO i1 = LBOUND(InData%F_Lines,1), UBOUND(InData%F_Lines,1) - ReKiBuf(Re_Xferred) = InData%F_Lines(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%LastIndWave - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FEAM_PackMisc - - SUBROUTINE FEAM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FEAM_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GLF not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%GLF)) DEALLOCATE(OutData%GLF) - ALLOCATE(OutData%GLF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%GLF,2), UBOUND(OutData%GLF,2) - DO i1 = LBOUND(OutData%GLF,1), UBOUND(OutData%GLF,1) - OutData%GLF(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GLK not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%GLK)) DEALLOCATE(OutData%GLK) - ALLOCATE(OutData%GLK(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLK.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%GLK,3), UBOUND(OutData%GLK,3) - DO i2 = LBOUND(OutData%GLK,2), UBOUND(OutData%GLK,2) - DO i1 = LBOUND(OutData%GLK,1), UBOUND(OutData%GLK,1) - OutData%GLK(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%EMASS,1) - i1_u = UBOUND(OutData%EMASS,1) - i2_l = LBOUND(OutData%EMASS,2) - i2_u = UBOUND(OutData%EMASS,2) - DO i2 = LBOUND(OutData%EMASS,2), UBOUND(OutData%EMASS,2) - DO i1 = LBOUND(OutData%EMASS,1), UBOUND(OutData%EMASS,1) - OutData%EMASS(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%ESTIF,1) - i1_u = UBOUND(OutData%ESTIF,1) - i2_l = LBOUND(OutData%ESTIF,2) - i2_u = UBOUND(OutData%ESTIF,2) - DO i2 = LBOUND(OutData%ESTIF,2), UBOUND(OutData%ESTIF,2) - DO i1 = LBOUND(OutData%ESTIF,1), UBOUND(OutData%ESTIF,1) - OutData%ESTIF(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FAST_FP not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FAST_FP)) DEALLOCATE(OutData%FAST_FP) - ALLOCATE(OutData%FAST_FP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAST_FP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FAST_FP,2), UBOUND(OutData%FAST_FP,2) - DO i1 = LBOUND(OutData%FAST_FP,1), UBOUND(OutData%FAST_FP,1) - OutData%FAST_FP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%FORCE,1) - i1_u = UBOUND(OutData%FORCE,1) - DO i1 = LBOUND(OutData%FORCE,1), UBOUND(OutData%FORCE,1) - OutData%FORCE(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%FP,1) - i1_u = UBOUND(OutData%FP,1) - DO i1 = LBOUND(OutData%FP,1), UBOUND(OutData%FP,1) - OutData%FP(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%U,1) - i1_u = UBOUND(OutData%U,1) - i2_l = LBOUND(OutData%U,2) - i2_u = UBOUND(OutData%U,2) - DO i2 = LBOUND(OutData%U,2), UBOUND(OutData%U,2) - DO i1 = LBOUND(OutData%U,1), UBOUND(OutData%U,1) - OutData%U(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%U0,1) - i1_u = UBOUND(OutData%U0,1) - i2_l = LBOUND(OutData%U0,2) - i2_u = UBOUND(OutData%U0,2) - DO i2 = LBOUND(OutData%U0,2), UBOUND(OutData%U0,2) - DO i1 = LBOUND(OutData%U0,1), UBOUND(OutData%U0,1) - OutData%U0(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%DU,1) - i1_u = UBOUND(OutData%DU,1) - i2_l = LBOUND(OutData%DU,2) - i2_u = UBOUND(OutData%DU,2) - DO i2 = LBOUND(OutData%DU,2), UBOUND(OutData%DU,2) - DO i1 = LBOUND(OutData%DU,1), UBOUND(OutData%DU,1) - OutData%DU(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%DDU,1) - i1_u = UBOUND(OutData%DDU,1) - i2_l = LBOUND(OutData%DDU,2) - i2_u = UBOUND(OutData%DDU,2) - DO i2 = LBOUND(OutData%DDU,2), UBOUND(OutData%DDU,2) - DO i1 = LBOUND(OutData%DDU,1), UBOUND(OutData%DDU,1) - OutData%DDU(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%R,1) - i1_u = UBOUND(OutData%R,1) - DO i1 = LBOUND(OutData%R,1), UBOUND(OutData%R,1) - OutData%R(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%RP,1) - i1_u = UBOUND(OutData%RP,1) - DO i1 = LBOUND(OutData%RP,1), UBOUND(OutData%RP,1) - OutData%RP(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%RHSR,1) - i1_u = UBOUND(OutData%RHSR,1) - DO i1 = LBOUND(OutData%RHSR,1), UBOUND(OutData%RHSR,1) - OutData%RHSR(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%SLIN,1) - i1_u = UBOUND(OutData%SLIN,1) - DO i1 = LBOUND(OutData%SLIN,1), UBOUND(OutData%SLIN,1) - OutData%SLIN(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%STIFR,1) - i1_u = UBOUND(OutData%STIFR,1) - i2_l = LBOUND(OutData%STIFR,2) - i2_u = UBOUND(OutData%STIFR,2) - DO i2 = LBOUND(OutData%STIFR,2), UBOUND(OutData%STIFR,2) - DO i1 = LBOUND(OutData%STIFR,1), UBOUND(OutData%STIFR,1) - OutData%STIFR(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FAIR_ANG not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FAIR_ANG)) DEALLOCATE(OutData%FAIR_ANG) - ALLOCATE(OutData%FAIR_ANG(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAIR_ANG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FAIR_ANG,2), UBOUND(OutData%FAIR_ANG,2) - DO i1 = LBOUND(OutData%FAIR_ANG,1), UBOUND(OutData%FAIR_ANG,1) - OutData%FAIR_ANG(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FAIR_T not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FAIR_T)) DEALLOCATE(OutData%FAIR_T) - ALLOCATE(OutData%FAIR_T(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAIR_T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FAIR_T,1), UBOUND(OutData%FAIR_T,1) - OutData%FAIR_T(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ANCH_ANG not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ANCH_ANG)) DEALLOCATE(OutData%ANCH_ANG) - ALLOCATE(OutData%ANCH_ANG(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ANCH_ANG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ANCH_ANG,2), UBOUND(OutData%ANCH_ANG,2) - DO i1 = LBOUND(OutData%ANCH_ANG,1), UBOUND(OutData%ANCH_ANG,1) - OutData%ANCH_ANG(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ANCH_T not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ANCH_T)) DEALLOCATE(OutData%ANCH_T) - ALLOCATE(OutData%ANCH_T(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ANCH_T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ANCH_T,1), UBOUND(OutData%ANCH_T,1) - OutData%ANCH_T(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Line_Coordinate not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Line_Coordinate)) DEALLOCATE(OutData%Line_Coordinate) - ALLOCATE(OutData%Line_Coordinate(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Line_Coordinate.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Line_Coordinate.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i3 = LBOUND(OutData%Line_Coordinate,3), UBOUND(OutData%Line_Coordinate,3) - DO i2 = LBOUND(OutData%Line_Coordinate,2), UBOUND(OutData%Line_Coordinate,2) - DO i1 = LBOUND(OutData%Line_Coordinate,1), UBOUND(OutData%Line_Coordinate,1) - OutData%Line_Coordinate(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Line_Tangent not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Line_Tangent)) DEALLOCATE(OutData%Line_Tangent) - ALLOCATE(OutData%Line_Tangent(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + DstMiscData%Line_Coordinate = SrcMiscData%Line_Coordinate +ENDIF +IF (ALLOCATED(SrcMiscData%Line_Tangent)) THEN + i1_l = LBOUND(SrcMiscData%Line_Tangent,1) + i1_u = UBOUND(SrcMiscData%Line_Tangent,1) + i2_l = LBOUND(SrcMiscData%Line_Tangent,2) + i2_u = UBOUND(SrcMiscData%Line_Tangent,2) + i3_l = LBOUND(SrcMiscData%Line_Tangent,3) + i3_u = UBOUND(SrcMiscData%Line_Tangent,3) + IF (.NOT. ALLOCATED(DstMiscData%Line_Tangent)) THEN + ALLOCATE(DstMiscData%Line_Tangent(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Line_Tangent.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Line_Tangent.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i3 = LBOUND(OutData%Line_Tangent,3), UBOUND(OutData%Line_Tangent,3) - DO i2 = LBOUND(OutData%Line_Tangent,2), UBOUND(OutData%Line_Tangent,2) - DO i1 = LBOUND(OutData%Line_Tangent,1), UBOUND(OutData%Line_Tangent,1) - OutData%Line_Tangent(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_Lines not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_Lines)) DEALLOCATE(OutData%F_Lines) - ALLOCATE(OutData%F_Lines(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DstMiscData%Line_Tangent = SrcMiscData%Line_Tangent +ENDIF +IF (ALLOCATED(SrcMiscData%F_Lines)) THEN + i1_l = LBOUND(SrcMiscData%F_Lines,1) + i1_u = UBOUND(SrcMiscData%F_Lines,1) + i2_l = LBOUND(SrcMiscData%F_Lines,2) + i2_u = UBOUND(SrcMiscData%F_Lines,2) + IF (.NOT. ALLOCATED(DstMiscData%F_Lines)) THEN + ALLOCATE(DstMiscData%F_Lines(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_Lines.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_Lines.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i2 = LBOUND(OutData%F_Lines,2), UBOUND(OutData%F_Lines,2) - DO i1 = LBOUND(OutData%F_Lines,1), UBOUND(OutData%F_Lines,1) - OutData%F_Lines(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO END IF - OutData%LastIndWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FEAM_UnPackMisc + DstMiscData%F_Lines = SrcMiscData%F_Lines +ENDIF + DstMiscData%LastIndWave = SrcMiscData%LastIndWave + END SUBROUTINE FEAM_CopyMisc + + SUBROUTINE FEAM_DestroyMisc( MiscData, ErrStat, ErrMsg ) + TYPE(FEAM_MiscVarType), INTENT(INOUT) :: MiscData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_DestroyMisc' + + ErrStat = ErrID_None + ErrMsg = "" + +IF (ALLOCATED(MiscData%GLF)) THEN + DEALLOCATE(MiscData%GLF) +ENDIF +IF (ALLOCATED(MiscData%GLK)) THEN + DEALLOCATE(MiscData%GLK) +ENDIF +IF (ALLOCATED(MiscData%FAST_FP)) THEN + DEALLOCATE(MiscData%FAST_FP) +ENDIF +IF (ALLOCATED(MiscData%FAIR_ANG)) THEN + DEALLOCATE(MiscData%FAIR_ANG) +ENDIF +IF (ALLOCATED(MiscData%FAIR_T)) THEN + DEALLOCATE(MiscData%FAIR_T) +ENDIF +IF (ALLOCATED(MiscData%ANCH_ANG)) THEN + DEALLOCATE(MiscData%ANCH_ANG) +ENDIF +IF (ALLOCATED(MiscData%ANCH_T)) THEN + DEALLOCATE(MiscData%ANCH_T) +ENDIF +IF (ALLOCATED(MiscData%Line_Coordinate)) THEN + DEALLOCATE(MiscData%Line_Coordinate) +ENDIF +IF (ALLOCATED(MiscData%Line_Tangent)) THEN + DEALLOCATE(MiscData%Line_Tangent) +ENDIF +IF (ALLOCATED(MiscData%F_Lines)) THEN + DEALLOCATE(MiscData%F_Lines) +ENDIF + END SUBROUTINE FEAM_DestroyMisc + +subroutine FEAM_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FEAM_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FEAM_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + ! GLF + call RegPack(Buf, allocated(InData%GLF)) + if (allocated(InData%GLF)) then + call RegPackBounds(Buf, 2, lbound(InData%GLF), ubound(InData%GLF)) + call RegPack(Buf, InData%GLF) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! GLK + call RegPack(Buf, allocated(InData%GLK)) + if (allocated(InData%GLK)) then + call RegPackBounds(Buf, 3, lbound(InData%GLK), ubound(InData%GLK)) + call RegPack(Buf, InData%GLK) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! EMASS + call RegPack(Buf, InData%EMASS) + if (RegCheckErr(Buf, RoutineName)) return + ! ESTIF + call RegPack(Buf, InData%ESTIF) + if (RegCheckErr(Buf, RoutineName)) return + ! FAST_FP + call RegPack(Buf, allocated(InData%FAST_FP)) + if (allocated(InData%FAST_FP)) then + call RegPackBounds(Buf, 2, lbound(InData%FAST_FP), ubound(InData%FAST_FP)) + call RegPack(Buf, InData%FAST_FP) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FORCE + call RegPack(Buf, InData%FORCE) + if (RegCheckErr(Buf, RoutineName)) return + ! FP + call RegPack(Buf, InData%FP) + if (RegCheckErr(Buf, RoutineName)) return + ! U + call RegPack(Buf, InData%U) + if (RegCheckErr(Buf, RoutineName)) return + ! U0 + call RegPack(Buf, InData%U0) + if (RegCheckErr(Buf, RoutineName)) return + ! DU + call RegPack(Buf, InData%DU) + if (RegCheckErr(Buf, RoutineName)) return + ! DDU + call RegPack(Buf, InData%DDU) + if (RegCheckErr(Buf, RoutineName)) return + ! R + call RegPack(Buf, InData%R) + if (RegCheckErr(Buf, RoutineName)) return + ! RP + call RegPack(Buf, InData%RP) + if (RegCheckErr(Buf, RoutineName)) return + ! RHSR + call RegPack(Buf, InData%RHSR) + if (RegCheckErr(Buf, RoutineName)) return + ! SLIN + call RegPack(Buf, InData%SLIN) + if (RegCheckErr(Buf, RoutineName)) return + ! STIFR + call RegPack(Buf, InData%STIFR) + if (RegCheckErr(Buf, RoutineName)) return + ! FAIR_ANG + call RegPack(Buf, allocated(InData%FAIR_ANG)) + if (allocated(InData%FAIR_ANG)) then + call RegPackBounds(Buf, 2, lbound(InData%FAIR_ANG), ubound(InData%FAIR_ANG)) + call RegPack(Buf, InData%FAIR_ANG) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FAIR_T + call RegPack(Buf, allocated(InData%FAIR_T)) + if (allocated(InData%FAIR_T)) then + call RegPackBounds(Buf, 1, lbound(InData%FAIR_T), ubound(InData%FAIR_T)) + call RegPack(Buf, InData%FAIR_T) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ANCH_ANG + call RegPack(Buf, allocated(InData%ANCH_ANG)) + if (allocated(InData%ANCH_ANG)) then + call RegPackBounds(Buf, 2, lbound(InData%ANCH_ANG), ubound(InData%ANCH_ANG)) + call RegPack(Buf, InData%ANCH_ANG) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ANCH_T + call RegPack(Buf, allocated(InData%ANCH_T)) + if (allocated(InData%ANCH_T)) then + call RegPackBounds(Buf, 1, lbound(InData%ANCH_T), ubound(InData%ANCH_T)) + call RegPack(Buf, InData%ANCH_T) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Line_Coordinate + call RegPack(Buf, allocated(InData%Line_Coordinate)) + if (allocated(InData%Line_Coordinate)) then + call RegPackBounds(Buf, 3, lbound(InData%Line_Coordinate), ubound(InData%Line_Coordinate)) + call RegPack(Buf, InData%Line_Coordinate) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Line_Tangent + call RegPack(Buf, allocated(InData%Line_Tangent)) + if (allocated(InData%Line_Tangent)) then + call RegPackBounds(Buf, 3, lbound(InData%Line_Tangent), ubound(InData%Line_Tangent)) + call RegPack(Buf, InData%Line_Tangent) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! F_Lines + call RegPack(Buf, allocated(InData%F_Lines)) + if (allocated(InData%F_Lines)) then + call RegPackBounds(Buf, 2, lbound(InData%F_Lines), ubound(InData%F_Lines)) + call RegPack(Buf, InData%F_Lines) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LastIndWave + call RegPack(Buf, InData%LastIndWave) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FEAM_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FEAM_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FEAM_UnPackMisc' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! GLF + if (allocated(OutData%GLF)) deallocate(OutData%GLF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%GLF(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%GLF) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! GLK + if (allocated(OutData%GLK)) deallocate(OutData%GLK) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%GLK(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLK.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%GLK) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! EMASS + call RegUnpack(Buf, OutData%EMASS) + if (RegCheckErr(Buf, RoutineName)) return + ! ESTIF + call RegUnpack(Buf, OutData%ESTIF) + if (RegCheckErr(Buf, RoutineName)) return + ! FAST_FP + if (allocated(OutData%FAST_FP)) deallocate(OutData%FAST_FP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FAST_FP(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAST_FP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FAST_FP) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! FORCE + call RegUnpack(Buf, OutData%FORCE) + if (RegCheckErr(Buf, RoutineName)) return + ! FP + call RegUnpack(Buf, OutData%FP) + if (RegCheckErr(Buf, RoutineName)) return + ! U + call RegUnpack(Buf, OutData%U) + if (RegCheckErr(Buf, RoutineName)) return + ! U0 + call RegUnpack(Buf, OutData%U0) + if (RegCheckErr(Buf, RoutineName)) return + ! DU + call RegUnpack(Buf, OutData%DU) + if (RegCheckErr(Buf, RoutineName)) return + ! DDU + call RegUnpack(Buf, OutData%DDU) + if (RegCheckErr(Buf, RoutineName)) return + ! R + call RegUnpack(Buf, OutData%R) + if (RegCheckErr(Buf, RoutineName)) return + ! RP + call RegUnpack(Buf, OutData%RP) + if (RegCheckErr(Buf, RoutineName)) return + ! RHSR + call RegUnpack(Buf, OutData%RHSR) + if (RegCheckErr(Buf, RoutineName)) return + ! SLIN + call RegUnpack(Buf, OutData%SLIN) + if (RegCheckErr(Buf, RoutineName)) return + ! STIFR + call RegUnpack(Buf, OutData%STIFR) + if (RegCheckErr(Buf, RoutineName)) return + ! FAIR_ANG + if (allocated(OutData%FAIR_ANG)) deallocate(OutData%FAIR_ANG) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FAIR_ANG(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAIR_ANG.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FAIR_ANG) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! FAIR_T + if (allocated(OutData%FAIR_T)) deallocate(OutData%FAIR_T) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FAIR_T(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAIR_T.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FAIR_T) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ANCH_ANG + if (allocated(OutData%ANCH_ANG)) deallocate(OutData%ANCH_ANG) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ANCH_ANG(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ANCH_ANG.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ANCH_ANG) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ANCH_T + if (allocated(OutData%ANCH_T)) deallocate(OutData%ANCH_T) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ANCH_T(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ANCH_T.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ANCH_T) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Line_Coordinate + if (allocated(OutData%Line_Coordinate)) deallocate(OutData%Line_Coordinate) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Line_Coordinate(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Line_Coordinate.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Line_Coordinate) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Line_Tangent + if (allocated(OutData%Line_Tangent)) deallocate(OutData%Line_Tangent) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Line_Tangent(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Line_Tangent.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Line_Tangent) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! F_Lines + if (allocated(OutData%F_Lines)) deallocate(OutData%F_Lines) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_Lines(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_Lines.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_Lines) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LastIndWave + call RegUnpack(Buf, OutData%LastIndWave) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE FEAM_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(FEAM_ParameterType), INTENT(IN) :: SrcParamData TYPE(FEAM_ParameterType), INTENT(INOUT) :: DstParamData @@ -4997,1343 +3086,631 @@ SUBROUTINE FEAM_DestroyParam( ParamData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE FEAM_DestroyParam - SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FEAM_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! DT - Re_BufSz = Re_BufSz + SIZE(InData%GRAV) ! GRAV - Re_BufSz = Re_BufSz + 1 ! Eps - Re_BufSz = Re_BufSz + 1 ! Gravity - Re_BufSz = Re_BufSz + 1 ! WtrDens - Int_BufSz = Int_BufSz + 1 ! MaxIter - Int_BufSz = Int_BufSz + 1 ! NHBD - Int_BufSz = Int_BufSz + 1 ! NDIM - Int_BufSz = Int_BufSz + 1 ! NEQ allocated yes/no - IF ( ALLOCATED(InData%NEQ) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NEQ upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NEQ) ! NEQ - END IF - Int_BufSz = Int_BufSz + 1 ! NBAND - Int_BufSz = Int_BufSz + 1 ! NumLines - Int_BufSz = Int_BufSz + 1 ! NumElems - Int_BufSz = Int_BufSz + 1 ! NumNodes - Int_BufSz = Int_BufSz + 1 ! GSL allocated yes/no - IF ( ALLOCATED(InData%GSL) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! GSL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GSL) ! GSL - END IF - Int_BufSz = Int_BufSz + 1 ! GP allocated yes/no - IF ( ALLOCATED(InData%GP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! GP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GP) ! GP - END IF - Int_BufSz = Int_BufSz + 1 ! Elength allocated yes/no - IF ( ALLOCATED(InData%Elength) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Elength upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Elength) ! Elength - END IF - Int_BufSz = Int_BufSz + 1 ! BottmElev allocated yes/no - IF ( ALLOCATED(InData%BottmElev) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BottmElev upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BottmElev) ! BottmElev - END IF - Int_BufSz = Int_BufSz + 1 ! BottmStiff allocated yes/no - IF ( ALLOCATED(InData%BottmStiff) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BottmStiff upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BottmStiff) ! BottmStiff - END IF - Int_BufSz = Int_BufSz + 1 ! LMassDen allocated yes/no - IF ( ALLOCATED(InData%LMassDen) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LMassDen upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LMassDen) ! LMassDen - END IF - Int_BufSz = Int_BufSz + 1 ! LDMassDen allocated yes/no - IF ( ALLOCATED(InData%LDMassDen) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LDMassDen upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LDMassDen) ! LDMassDen - END IF - Int_BufSz = Int_BufSz + 1 ! LEAStiff allocated yes/no - IF ( ALLOCATED(InData%LEAStiff) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LEAStiff upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LEAStiff) ! LEAStiff - END IF - Int_BufSz = Int_BufSz + 1 ! LineCI allocated yes/no - IF ( ALLOCATED(InData%LineCI) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LineCI upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LineCI) ! LineCI - END IF - Int_BufSz = Int_BufSz + 1 ! LineCD allocated yes/no - IF ( ALLOCATED(InData%LineCD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LineCD upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LineCD) ! LineCD - END IF - Int_BufSz = Int_BufSz + 1 ! Bvp allocated yes/no - IF ( ALLOCATED(InData%Bvp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Bvp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Bvp) ! Bvp - END IF - Int_BufSz = Int_BufSz + 1 ! WaveAcc0 allocated yes/no - IF ( ALLOCATED(InData%WaveAcc0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveAcc0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveAcc0) ! WaveAcc0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveTime allocated yes/no - IF ( ALLOCATED(InData%WaveTime) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveTime upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveTime) ! WaveTime - END IF - Int_BufSz = Int_BufSz + 1 ! WaveVel0 allocated yes/no - IF ( ALLOCATED(InData%WaveVel0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveVel0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveVel0) ! WaveVel0 - END IF - Int_BufSz = Int_BufSz + 1 ! NStepWave - Re_BufSz = Re_BufSz + SIZE(InData%SHAP) ! SHAP - Re_BufSz = Re_BufSz + SIZE(InData%SHAPS) ! SHAPS - Re_BufSz = Re_BufSz + SIZE(InData%GAUSSW) ! GAUSSW - Int_BufSz = Int_BufSz + 1 ! NGAUSS - Re_BufSz = Re_BufSz + SIZE(InData%SHAPT) ! SHAPT - Re_BufSz = Re_BufSz + SIZE(InData%SHAPTS) ! SHAPTS - Int_BufSz = Int_BufSz + 1 ! NTRAP - Re_BufSz = Re_BufSz + SIZE(InData%SBEND) ! SBEND - Re_BufSz = Re_BufSz + SIZE(InData%STEN) ! STEN - Re_BufSz = Re_BufSz + SIZE(InData%RMASS) ! RMASS - Re_BufSz = Re_BufSz + SIZE(InData%RADDM) ! RADDM - Re_BufSz = Re_BufSz + SIZE(InData%PMPN) ! PMPN - Re_BufSz = Re_BufSz + SIZE(InData%AM) ! AM - Re_BufSz = Re_BufSz + SIZE(InData%PM) ! PM - Int_BufSz = Int_BufSz + SIZE(InData%IDOF) ! IDOF - Int_BufSz = Int_BufSz + SIZE(InData%JDOF) ! JDOF - Re_BufSz = Re_BufSz + SIZE(InData%PPA) ! PPA - Re_BufSz = Re_BufSz + 1 ! PtfmRefzt - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1 ! OutParam allocated yes/no - IF ( ALLOCATED(InData%OutParam) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutParam upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - Int_BufSz = Int_BufSz + 3 ! OutParam: size of buffers for each call to pack subtype - CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutParam - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutParam - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutParam - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%Delim) ! Delim - Int_BufSz = Int_BufSz + 1 ! GLUZR allocated yes/no - IF ( ALLOCATED(InData%GLUZR) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! GLUZR upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GLUZR) ! GLUZR - END IF - Int_BufSz = Int_BufSz + 1 ! GTZER allocated yes/no - IF ( ALLOCATED(InData%GTZER) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! GTZER upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GTZER) ! GTZER - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%GRAV,1), UBOUND(InData%GRAV,1) - ReKiBuf(Re_Xferred) = InData%GRAV(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%Eps - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MaxIter - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NHBD - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NDIM - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%NEQ) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NEQ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NEQ,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NEQ,1), UBOUND(InData%NEQ,1) - IntKiBuf(Int_Xferred) = InData%NEQ(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NBAND - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumLines - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumElems - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumNodes - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%GSL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GSL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GSL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GSL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GSL,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GSL,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GSL,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%GSL,3), UBOUND(InData%GSL,3) - DO i2 = LBOUND(InData%GSL,2), UBOUND(InData%GSL,2) - DO i1 = LBOUND(InData%GSL,1), UBOUND(InData%GSL,1) - ReKiBuf(Re_Xferred) = InData%GSL(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%GP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%GP,2), UBOUND(InData%GP,2) - DO i1 = LBOUND(InData%GP,1), UBOUND(InData%GP,1) - ReKiBuf(Re_Xferred) = InData%GP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Elength) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Elength,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Elength,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Elength,1), UBOUND(InData%Elength,1) - ReKiBuf(Re_Xferred) = InData%Elength(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BottmElev) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BottmElev,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BottmElev,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BottmElev,1), UBOUND(InData%BottmElev,1) - ReKiBuf(Re_Xferred) = InData%BottmElev(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BottmStiff) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BottmStiff,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BottmStiff,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BottmStiff,1), UBOUND(InData%BottmStiff,1) - ReKiBuf(Re_Xferred) = InData%BottmStiff(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LMassDen) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LMassDen,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LMassDen,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LMassDen,1), UBOUND(InData%LMassDen,1) - ReKiBuf(Re_Xferred) = InData%LMassDen(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LDMassDen) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LDMassDen,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LDMassDen,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LDMassDen,1), UBOUND(InData%LDMassDen,1) - ReKiBuf(Re_Xferred) = InData%LDMassDen(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LEAStiff) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LEAStiff,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LEAStiff,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LEAStiff,1), UBOUND(InData%LEAStiff,1) - ReKiBuf(Re_Xferred) = InData%LEAStiff(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LineCI) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LineCI,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineCI,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LineCI,1), UBOUND(InData%LineCI,1) - ReKiBuf(Re_Xferred) = InData%LineCI(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LineCD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LineCD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineCD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LineCD,1), UBOUND(InData%LineCD,1) - ReKiBuf(Re_Xferred) = InData%LineCD(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Bvp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Bvp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Bvp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Bvp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Bvp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Bvp,2), UBOUND(InData%Bvp,2) - DO i1 = LBOUND(InData%Bvp,1), UBOUND(InData%Bvp,1) - ReKiBuf(Re_Xferred) = InData%Bvp(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveAcc0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc0,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveAcc0,3), UBOUND(InData%WaveAcc0,3) - DO i2 = LBOUND(InData%WaveAcc0,2), UBOUND(InData%WaveAcc0,2) - DO i1 = LBOUND(InData%WaveAcc0,1), UBOUND(InData%WaveAcc0,1) - ReKiBuf(Re_Xferred) = InData%WaveAcc0(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveTime,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) - ReKiBuf(Re_Xferred) = InData%WaveTime(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveVel0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel0,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveVel0,3), UBOUND(InData%WaveVel0,3) - DO i2 = LBOUND(InData%WaveVel0,2), UBOUND(InData%WaveVel0,2) - DO i1 = LBOUND(InData%WaveVel0,1), UBOUND(InData%WaveVel0,1) - ReKiBuf(Re_Xferred) = InData%WaveVel0(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - DO i2 = LBOUND(InData%SHAP,2), UBOUND(InData%SHAP,2) - DO i1 = LBOUND(InData%SHAP,1), UBOUND(InData%SHAP,1) - ReKiBuf(Re_Xferred) = InData%SHAP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%SHAPS,2), UBOUND(InData%SHAPS,2) - DO i1 = LBOUND(InData%SHAPS,1), UBOUND(InData%SHAPS,1) - ReKiBuf(Re_Xferred) = InData%SHAPS(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i1 = LBOUND(InData%GAUSSW,1), UBOUND(InData%GAUSSW,1) - ReKiBuf(Re_Xferred) = InData%GAUSSW(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%NGAUSS - Int_Xferred = Int_Xferred + 1 - DO i2 = LBOUND(InData%SHAPT,2), UBOUND(InData%SHAPT,2) - DO i1 = LBOUND(InData%SHAPT,1), UBOUND(InData%SHAPT,1) - ReKiBuf(Re_Xferred) = InData%SHAPT(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%SHAPTS,2), UBOUND(InData%SHAPTS,2) - DO i1 = LBOUND(InData%SHAPTS,1), UBOUND(InData%SHAPTS,1) - ReKiBuf(Re_Xferred) = InData%SHAPTS(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IntKiBuf(Int_Xferred) = InData%NTRAP - Int_Xferred = Int_Xferred + 1 - DO i2 = LBOUND(InData%SBEND,2), UBOUND(InData%SBEND,2) - DO i1 = LBOUND(InData%SBEND,1), UBOUND(InData%SBEND,1) - ReKiBuf(Re_Xferred) = InData%SBEND(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i3 = LBOUND(InData%STEN,3), UBOUND(InData%STEN,3) - DO i2 = LBOUND(InData%STEN,2), UBOUND(InData%STEN,2) - DO i1 = LBOUND(InData%STEN,1), UBOUND(InData%STEN,1) - ReKiBuf(Re_Xferred) = InData%STEN(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - DO i2 = LBOUND(InData%RMASS,2), UBOUND(InData%RMASS,2) - DO i1 = LBOUND(InData%RMASS,1), UBOUND(InData%RMASS,1) - ReKiBuf(Re_Xferred) = InData%RMASS(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i4 = LBOUND(InData%RADDM,4), UBOUND(InData%RADDM,4) - DO i3 = LBOUND(InData%RADDM,3), UBOUND(InData%RADDM,3) - DO i2 = LBOUND(InData%RADDM,2), UBOUND(InData%RADDM,2) - DO i1 = LBOUND(InData%RADDM,1), UBOUND(InData%RADDM,1) - ReKiBuf(Re_Xferred) = InData%RADDM(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - DO i2 = LBOUND(InData%PMPN,2), UBOUND(InData%PMPN,2) - DO i1 = LBOUND(InData%PMPN,1), UBOUND(InData%PMPN,1) - ReKiBuf(Re_Xferred) = InData%PMPN(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i1 = LBOUND(InData%AM,1), UBOUND(InData%AM,1) - ReKiBuf(Re_Xferred) = InData%AM(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%PM,1), UBOUND(InData%PM,1) - ReKiBuf(Re_Xferred) = InData%PM(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i2 = LBOUND(InData%IDOF,2), UBOUND(InData%IDOF,2) - DO i1 = LBOUND(InData%IDOF,1), UBOUND(InData%IDOF,1) - IntKiBuf(Int_Xferred) = InData%IDOF(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - DO i1 = LBOUND(InData%JDOF,1), UBOUND(InData%JDOF,1) - IntKiBuf(Int_Xferred) = InData%JDOF(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i3 = LBOUND(InData%PPA,3), UBOUND(InData%PPA,3) - DO i2 = LBOUND(InData%PPA,2), UBOUND(InData%PPA,2) - DO i1 = LBOUND(InData%PPA,1), UBOUND(InData%PPA,1) - ReKiBuf(Re_Xferred) = InData%PPA(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - ReKiBuf(Re_Xferred) = InData%PtfmRefzt - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutParam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParam,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%GLUZR) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GLUZR,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLUZR,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GLUZR,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLUZR,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GLUZR,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLUZR,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%GLUZR,3), UBOUND(InData%GLUZR,3) - DO i2 = LBOUND(InData%GLUZR,2), UBOUND(InData%GLUZR,2) - DO i1 = LBOUND(InData%GLUZR,1), UBOUND(InData%GLUZR,1) - ReKiBuf(Re_Xferred) = InData%GLUZR(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%GTZER) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GTZER,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GTZER,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GTZER,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GTZER,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%GTZER,2), UBOUND(InData%GTZER,2) - DO i1 = LBOUND(InData%GTZER,1), UBOUND(InData%GTZER,1) - ReKiBuf(Re_Xferred) = InData%GTZER(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE FEAM_PackParam - - SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FEAM_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%GRAV,1) - i1_u = UBOUND(OutData%GRAV,1) - DO i1 = LBOUND(OutData%GRAV,1), UBOUND(OutData%GRAV,1) - OutData%GRAV(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%Eps = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MaxIter = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NHBD = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NDIM = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NEQ not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NEQ)) DEALLOCATE(OutData%NEQ) - ALLOCATE(OutData%NEQ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NEQ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NEQ,1), UBOUND(OutData%NEQ,1) - OutData%NEQ(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%NBAND = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumLines = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumElems = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GSL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%GSL)) DEALLOCATE(OutData%GSL) - ALLOCATE(OutData%GSL(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GSL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%GSL,3), UBOUND(OutData%GSL,3) - DO i2 = LBOUND(OutData%GSL,2), UBOUND(OutData%GSL,2) - DO i1 = LBOUND(OutData%GSL,1), UBOUND(OutData%GSL,1) - OutData%GSL(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GP not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%GP)) DEALLOCATE(OutData%GP) - ALLOCATE(OutData%GP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%GP,2), UBOUND(OutData%GP,2) - DO i1 = LBOUND(OutData%GP,1), UBOUND(OutData%GP,1) - OutData%GP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Elength not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Elength)) DEALLOCATE(OutData%Elength) - ALLOCATE(OutData%Elength(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Elength.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Elength,1), UBOUND(OutData%Elength,1) - OutData%Elength(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BottmElev not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BottmElev)) DEALLOCATE(OutData%BottmElev) - ALLOCATE(OutData%BottmElev(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BottmElev.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BottmElev,1), UBOUND(OutData%BottmElev,1) - OutData%BottmElev(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BottmStiff not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BottmStiff)) DEALLOCATE(OutData%BottmStiff) - ALLOCATE(OutData%BottmStiff(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BottmStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BottmStiff,1), UBOUND(OutData%BottmStiff,1) - OutData%BottmStiff(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LMassDen not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LMassDen)) DEALLOCATE(OutData%LMassDen) - ALLOCATE(OutData%LMassDen(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LMassDen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LMassDen,1), UBOUND(OutData%LMassDen,1) - OutData%LMassDen(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LDMassDen not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LDMassDen)) DEALLOCATE(OutData%LDMassDen) - ALLOCATE(OutData%LDMassDen(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LDMassDen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LDMassDen,1), UBOUND(OutData%LDMassDen,1) - OutData%LDMassDen(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LEAStiff not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LEAStiff)) DEALLOCATE(OutData%LEAStiff) - ALLOCATE(OutData%LEAStiff(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LEAStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LEAStiff,1), UBOUND(OutData%LEAStiff,1) - OutData%LEAStiff(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineCI not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LineCI)) DEALLOCATE(OutData%LineCI) - ALLOCATE(OutData%LineCI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineCI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LineCI,1), UBOUND(OutData%LineCI,1) - OutData%LineCI(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineCD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LineCD)) DEALLOCATE(OutData%LineCD) - ALLOCATE(OutData%LineCD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineCD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LineCD,1), UBOUND(OutData%LineCD,1) - OutData%LineCD(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Bvp not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Bvp)) DEALLOCATE(OutData%Bvp) - ALLOCATE(OutData%Bvp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Bvp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Bvp,2), UBOUND(OutData%Bvp,2) - DO i1 = LBOUND(OutData%Bvp,1), UBOUND(OutData%Bvp,1) - OutData%Bvp(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveAcc0)) DEALLOCATE(OutData%WaveAcc0) - ALLOCATE(OutData%WaveAcc0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveAcc0,3), UBOUND(OutData%WaveAcc0,3) - DO i2 = LBOUND(OutData%WaveAcc0,2), UBOUND(OutData%WaveAcc0,2) - DO i1 = LBOUND(OutData%WaveAcc0,1), UBOUND(OutData%WaveAcc0,1) - OutData%WaveAcc0(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveTime)) DEALLOCATE(OutData%WaveTime) - ALLOCATE(OutData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) - OutData%WaveTime(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveVel0)) DEALLOCATE(OutData%WaveVel0) - ALLOCATE(OutData%WaveVel0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveVel0,3), UBOUND(OutData%WaveVel0,3) - DO i2 = LBOUND(OutData%WaveVel0,2), UBOUND(OutData%WaveVel0,2) - DO i1 = LBOUND(OutData%WaveVel0,1), UBOUND(OutData%WaveVel0,1) - OutData%WaveVel0(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%NStepWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%SHAP,1) - i1_u = UBOUND(OutData%SHAP,1) - i2_l = LBOUND(OutData%SHAP,2) - i2_u = UBOUND(OutData%SHAP,2) - DO i2 = LBOUND(OutData%SHAP,2), UBOUND(OutData%SHAP,2) - DO i1 = LBOUND(OutData%SHAP,1), UBOUND(OutData%SHAP,1) - OutData%SHAP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%SHAPS,1) - i1_u = UBOUND(OutData%SHAPS,1) - i2_l = LBOUND(OutData%SHAPS,2) - i2_u = UBOUND(OutData%SHAPS,2) - DO i2 = LBOUND(OutData%SHAPS,2), UBOUND(OutData%SHAPS,2) - DO i1 = LBOUND(OutData%SHAPS,1), UBOUND(OutData%SHAPS,1) - OutData%SHAPS(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%GAUSSW,1) - i1_u = UBOUND(OutData%GAUSSW,1) - DO i1 = LBOUND(OutData%GAUSSW,1), UBOUND(OutData%GAUSSW,1) - OutData%GAUSSW(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%NGAUSS = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%SHAPT,1) - i1_u = UBOUND(OutData%SHAPT,1) - i2_l = LBOUND(OutData%SHAPT,2) - i2_u = UBOUND(OutData%SHAPT,2) - DO i2 = LBOUND(OutData%SHAPT,2), UBOUND(OutData%SHAPT,2) - DO i1 = LBOUND(OutData%SHAPT,1), UBOUND(OutData%SHAPT,1) - OutData%SHAPT(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%SHAPTS,1) - i1_u = UBOUND(OutData%SHAPTS,1) - i2_l = LBOUND(OutData%SHAPTS,2) - i2_u = UBOUND(OutData%SHAPTS,2) - DO i2 = LBOUND(OutData%SHAPTS,2), UBOUND(OutData%SHAPTS,2) - DO i1 = LBOUND(OutData%SHAPTS,1), UBOUND(OutData%SHAPTS,1) - OutData%SHAPTS(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - OutData%NTRAP = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%SBEND,1) - i1_u = UBOUND(OutData%SBEND,1) - i2_l = LBOUND(OutData%SBEND,2) - i2_u = UBOUND(OutData%SBEND,2) - DO i2 = LBOUND(OutData%SBEND,2), UBOUND(OutData%SBEND,2) - DO i1 = LBOUND(OutData%SBEND,1), UBOUND(OutData%SBEND,1) - OutData%SBEND(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%STEN,1) - i1_u = UBOUND(OutData%STEN,1) - i2_l = LBOUND(OutData%STEN,2) - i2_u = UBOUND(OutData%STEN,2) - i3_l = LBOUND(OutData%STEN,3) - i3_u = UBOUND(OutData%STEN,3) - DO i3 = LBOUND(OutData%STEN,3), UBOUND(OutData%STEN,3) - DO i2 = LBOUND(OutData%STEN,2), UBOUND(OutData%STEN,2) - DO i1 = LBOUND(OutData%STEN,1), UBOUND(OutData%STEN,1) - OutData%STEN(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - i1_l = LBOUND(OutData%RMASS,1) - i1_u = UBOUND(OutData%RMASS,1) - i2_l = LBOUND(OutData%RMASS,2) - i2_u = UBOUND(OutData%RMASS,2) - DO i2 = LBOUND(OutData%RMASS,2), UBOUND(OutData%RMASS,2) - DO i1 = LBOUND(OutData%RMASS,1), UBOUND(OutData%RMASS,1) - OutData%RMASS(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%RADDM,1) - i1_u = UBOUND(OutData%RADDM,1) - i2_l = LBOUND(OutData%RADDM,2) - i2_u = UBOUND(OutData%RADDM,2) - i3_l = LBOUND(OutData%RADDM,3) - i3_u = UBOUND(OutData%RADDM,3) - i4_l = LBOUND(OutData%RADDM,4) - i4_u = UBOUND(OutData%RADDM,4) - DO i4 = LBOUND(OutData%RADDM,4), UBOUND(OutData%RADDM,4) - DO i3 = LBOUND(OutData%RADDM,3), UBOUND(OutData%RADDM,3) - DO i2 = LBOUND(OutData%RADDM,2), UBOUND(OutData%RADDM,2) - DO i1 = LBOUND(OutData%RADDM,1), UBOUND(OutData%RADDM,1) - OutData%RADDM(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - i1_l = LBOUND(OutData%PMPN,1) - i1_u = UBOUND(OutData%PMPN,1) - i2_l = LBOUND(OutData%PMPN,2) - i2_u = UBOUND(OutData%PMPN,2) - DO i2 = LBOUND(OutData%PMPN,2), UBOUND(OutData%PMPN,2) - DO i1 = LBOUND(OutData%PMPN,1), UBOUND(OutData%PMPN,1) - OutData%PMPN(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%AM,1) - i1_u = UBOUND(OutData%AM,1) - DO i1 = LBOUND(OutData%AM,1), UBOUND(OutData%AM,1) - OutData%AM(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%PM,1) - i1_u = UBOUND(OutData%PM,1) - DO i1 = LBOUND(OutData%PM,1), UBOUND(OutData%PM,1) - OutData%PM(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%IDOF,1) - i1_u = UBOUND(OutData%IDOF,1) - i2_l = LBOUND(OutData%IDOF,2) - i2_u = UBOUND(OutData%IDOF,2) - DO i2 = LBOUND(OutData%IDOF,2), UBOUND(OutData%IDOF,2) - DO i1 = LBOUND(OutData%IDOF,1), UBOUND(OutData%IDOF,1) - OutData%IDOF(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%JDOF,1) - i1_u = UBOUND(OutData%JDOF,1) - DO i1 = LBOUND(OutData%JDOF,1), UBOUND(OutData%JDOF,1) - OutData%JDOF(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%PPA,1) - i1_u = UBOUND(OutData%PPA,1) - i2_l = LBOUND(OutData%PPA,2) - i2_u = UBOUND(OutData%PPA,2) - i3_l = LBOUND(OutData%PPA,3) - i3_u = UBOUND(OutData%PPA,3) - DO i3 = LBOUND(OutData%PPA,3), UBOUND(OutData%PPA,3) - DO i2 = LBOUND(OutData%PPA,2), UBOUND(OutData%PPA,2) - DO i1 = LBOUND(OutData%PPA,1), UBOUND(OutData%PPA,1) - OutData%PPA(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - OutData%PtfmRefzt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutParam)) DEALLOCATE(OutData%OutParam) - ALLOCATE(OutData%OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutParam,1), UBOUND(OutData%OutParam,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackOutParmType( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GLUZR not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%GLUZR)) DEALLOCATE(OutData%GLUZR) - ALLOCATE(OutData%GLUZR(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLUZR.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%GLUZR,3), UBOUND(OutData%GLUZR,3) - DO i2 = LBOUND(OutData%GLUZR,2), UBOUND(OutData%GLUZR,2) - DO i1 = LBOUND(OutData%GLUZR,1), UBOUND(OutData%GLUZR,1) - OutData%GLUZR(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GTZER not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%GTZER)) DEALLOCATE(OutData%GTZER) - ALLOCATE(OutData%GTZER(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GTZER.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%GTZER,2), UBOUND(OutData%GTZER,2) - DO i1 = LBOUND(OutData%GTZER,1), UBOUND(OutData%GTZER,1) - OutData%GTZER(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE FEAM_UnPackParam +subroutine FEAM_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FEAM_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FEAM_PackParam' + integer(IntKi) :: i1, i2, i3, i4 + integer(IntKi) :: LB(4), UB(4) + if (Buf%ErrStat >= AbortErrLev) return + ! DT + call RegPack(Buf, InData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! GRAV + call RegPack(Buf, InData%GRAV) + if (RegCheckErr(Buf, RoutineName)) return + ! Eps + call RegPack(Buf, InData%Eps) + if (RegCheckErr(Buf, RoutineName)) return + ! Gravity + call RegPack(Buf, InData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDens + call RegPack(Buf, InData%WtrDens) + if (RegCheckErr(Buf, RoutineName)) return + ! MaxIter + call RegPack(Buf, InData%MaxIter) + if (RegCheckErr(Buf, RoutineName)) return + ! NHBD + call RegPack(Buf, InData%NHBD) + if (RegCheckErr(Buf, RoutineName)) return + ! NDIM + call RegPack(Buf, InData%NDIM) + if (RegCheckErr(Buf, RoutineName)) return + ! NEQ + call RegPack(Buf, allocated(InData%NEQ)) + if (allocated(InData%NEQ)) then + call RegPackBounds(Buf, 1, lbound(InData%NEQ), ubound(InData%NEQ)) + call RegPack(Buf, InData%NEQ) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NBAND + call RegPack(Buf, InData%NBAND) + if (RegCheckErr(Buf, RoutineName)) return + ! NumLines + call RegPack(Buf, InData%NumLines) + if (RegCheckErr(Buf, RoutineName)) return + ! NumElems + call RegPack(Buf, InData%NumElems) + if (RegCheckErr(Buf, RoutineName)) return + ! NumNodes + call RegPack(Buf, InData%NumNodes) + if (RegCheckErr(Buf, RoutineName)) return + ! GSL + call RegPack(Buf, allocated(InData%GSL)) + if (allocated(InData%GSL)) then + call RegPackBounds(Buf, 3, lbound(InData%GSL), ubound(InData%GSL)) + call RegPack(Buf, InData%GSL) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! GP + call RegPack(Buf, allocated(InData%GP)) + if (allocated(InData%GP)) then + call RegPackBounds(Buf, 2, lbound(InData%GP), ubound(InData%GP)) + call RegPack(Buf, InData%GP) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Elength + call RegPack(Buf, allocated(InData%Elength)) + if (allocated(InData%Elength)) then + call RegPackBounds(Buf, 1, lbound(InData%Elength), ubound(InData%Elength)) + call RegPack(Buf, InData%Elength) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BottmElev + call RegPack(Buf, allocated(InData%BottmElev)) + if (allocated(InData%BottmElev)) then + call RegPackBounds(Buf, 1, lbound(InData%BottmElev), ubound(InData%BottmElev)) + call RegPack(Buf, InData%BottmElev) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BottmStiff + call RegPack(Buf, allocated(InData%BottmStiff)) + if (allocated(InData%BottmStiff)) then + call RegPackBounds(Buf, 1, lbound(InData%BottmStiff), ubound(InData%BottmStiff)) + call RegPack(Buf, InData%BottmStiff) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LMassDen + call RegPack(Buf, allocated(InData%LMassDen)) + if (allocated(InData%LMassDen)) then + call RegPackBounds(Buf, 1, lbound(InData%LMassDen), ubound(InData%LMassDen)) + call RegPack(Buf, InData%LMassDen) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LDMassDen + call RegPack(Buf, allocated(InData%LDMassDen)) + if (allocated(InData%LDMassDen)) then + call RegPackBounds(Buf, 1, lbound(InData%LDMassDen), ubound(InData%LDMassDen)) + call RegPack(Buf, InData%LDMassDen) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LEAStiff + call RegPack(Buf, allocated(InData%LEAStiff)) + if (allocated(InData%LEAStiff)) then + call RegPackBounds(Buf, 1, lbound(InData%LEAStiff), ubound(InData%LEAStiff)) + call RegPack(Buf, InData%LEAStiff) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LineCI + call RegPack(Buf, allocated(InData%LineCI)) + if (allocated(InData%LineCI)) then + call RegPackBounds(Buf, 1, lbound(InData%LineCI), ubound(InData%LineCI)) + call RegPack(Buf, InData%LineCI) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LineCD + call RegPack(Buf, allocated(InData%LineCD)) + if (allocated(InData%LineCD)) then + call RegPackBounds(Buf, 1, lbound(InData%LineCD), ubound(InData%LineCD)) + call RegPack(Buf, InData%LineCD) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Bvp + call RegPack(Buf, allocated(InData%Bvp)) + if (allocated(InData%Bvp)) then + call RegPackBounds(Buf, 2, lbound(InData%Bvp), ubound(InData%Bvp)) + call RegPack(Buf, InData%Bvp) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveAcc0 + call RegPack(Buf, allocated(InData%WaveAcc0)) + if (allocated(InData%WaveAcc0)) then + call RegPackBounds(Buf, 3, lbound(InData%WaveAcc0), ubound(InData%WaveAcc0)) + call RegPack(Buf, InData%WaveAcc0) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveTime + call RegPack(Buf, allocated(InData%WaveTime)) + if (allocated(InData%WaveTime)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) + call RegPack(Buf, InData%WaveTime) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveVel0 + call RegPack(Buf, allocated(InData%WaveVel0)) + if (allocated(InData%WaveVel0)) then + call RegPackBounds(Buf, 3, lbound(InData%WaveVel0), ubound(InData%WaveVel0)) + call RegPack(Buf, InData%WaveVel0) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NStepWave + call RegPack(Buf, InData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + ! SHAP + call RegPack(Buf, InData%SHAP) + if (RegCheckErr(Buf, RoutineName)) return + ! SHAPS + call RegPack(Buf, InData%SHAPS) + if (RegCheckErr(Buf, RoutineName)) return + ! GAUSSW + call RegPack(Buf, InData%GAUSSW) + if (RegCheckErr(Buf, RoutineName)) return + ! NGAUSS + call RegPack(Buf, InData%NGAUSS) + if (RegCheckErr(Buf, RoutineName)) return + ! SHAPT + call RegPack(Buf, InData%SHAPT) + if (RegCheckErr(Buf, RoutineName)) return + ! SHAPTS + call RegPack(Buf, InData%SHAPTS) + if (RegCheckErr(Buf, RoutineName)) return + ! NTRAP + call RegPack(Buf, InData%NTRAP) + if (RegCheckErr(Buf, RoutineName)) return + ! SBEND + call RegPack(Buf, InData%SBEND) + if (RegCheckErr(Buf, RoutineName)) return + ! STEN + call RegPack(Buf, InData%STEN) + if (RegCheckErr(Buf, RoutineName)) return + ! RMASS + call RegPack(Buf, InData%RMASS) + if (RegCheckErr(Buf, RoutineName)) return + ! RADDM + call RegPack(Buf, InData%RADDM) + if (RegCheckErr(Buf, RoutineName)) return + ! PMPN + call RegPack(Buf, InData%PMPN) + if (RegCheckErr(Buf, RoutineName)) return + ! AM + call RegPack(Buf, InData%AM) + if (RegCheckErr(Buf, RoutineName)) return + ! PM + call RegPack(Buf, InData%PM) + if (RegCheckErr(Buf, RoutineName)) return + ! IDOF + call RegPack(Buf, InData%IDOF) + if (RegCheckErr(Buf, RoutineName)) return + ! JDOF + call RegPack(Buf, InData%JDOF) + if (RegCheckErr(Buf, RoutineName)) return + ! PPA + call RegPack(Buf, InData%PPA) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmRefzt + call RegPack(Buf, InData%PtfmRefzt) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegPack(Buf, InData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegPack(Buf, InData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! OutParam + call RegPack(Buf, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Delim + call RegPack(Buf, InData%Delim) + if (RegCheckErr(Buf, RoutineName)) return + ! GLUZR + call RegPack(Buf, allocated(InData%GLUZR)) + if (allocated(InData%GLUZR)) then + call RegPackBounds(Buf, 3, lbound(InData%GLUZR), ubound(InData%GLUZR)) + call RegPack(Buf, InData%GLUZR) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! GTZER + call RegPack(Buf, allocated(InData%GTZER)) + if (allocated(InData%GTZER)) then + call RegPackBounds(Buf, 2, lbound(InData%GTZER), ubound(InData%GTZER)) + call RegPack(Buf, InData%GTZER) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FEAM_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FEAM_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FEAM_UnPackParam' + integer(IntKi) :: i1, i2, i3, i4 + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! DT + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! GRAV + call RegUnpack(Buf, OutData%GRAV) + if (RegCheckErr(Buf, RoutineName)) return + ! Eps + call RegUnpack(Buf, OutData%Eps) + if (RegCheckErr(Buf, RoutineName)) return + ! Gravity + call RegUnpack(Buf, OutData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDens + call RegUnpack(Buf, OutData%WtrDens) + if (RegCheckErr(Buf, RoutineName)) return + ! MaxIter + call RegUnpack(Buf, OutData%MaxIter) + if (RegCheckErr(Buf, RoutineName)) return + ! NHBD + call RegUnpack(Buf, OutData%NHBD) + if (RegCheckErr(Buf, RoutineName)) return + ! NDIM + call RegUnpack(Buf, OutData%NDIM) + if (RegCheckErr(Buf, RoutineName)) return + ! NEQ + if (allocated(OutData%NEQ)) deallocate(OutData%NEQ) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NEQ(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NEQ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%NEQ) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NBAND + call RegUnpack(Buf, OutData%NBAND) + if (RegCheckErr(Buf, RoutineName)) return + ! NumLines + call RegUnpack(Buf, OutData%NumLines) + if (RegCheckErr(Buf, RoutineName)) return + ! NumElems + call RegUnpack(Buf, OutData%NumElems) + if (RegCheckErr(Buf, RoutineName)) return + ! NumNodes + call RegUnpack(Buf, OutData%NumNodes) + if (RegCheckErr(Buf, RoutineName)) return + ! GSL + if (allocated(OutData%GSL)) deallocate(OutData%GSL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%GSL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GSL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%GSL) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! GP + if (allocated(OutData%GP)) deallocate(OutData%GP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%GP(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%GP) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Elength + if (allocated(OutData%Elength)) deallocate(OutData%Elength) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Elength(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Elength.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Elength) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BottmElev + if (allocated(OutData%BottmElev)) deallocate(OutData%BottmElev) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BottmElev(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BottmElev.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BottmElev) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BottmStiff + if (allocated(OutData%BottmStiff)) deallocate(OutData%BottmStiff) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BottmStiff(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BottmStiff.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BottmStiff) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LMassDen + if (allocated(OutData%LMassDen)) deallocate(OutData%LMassDen) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LMassDen(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LMassDen.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LMassDen) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LDMassDen + if (allocated(OutData%LDMassDen)) deallocate(OutData%LDMassDen) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LDMassDen(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LDMassDen.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LDMassDen) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LEAStiff + if (allocated(OutData%LEAStiff)) deallocate(OutData%LEAStiff) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LEAStiff(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LEAStiff.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LEAStiff) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LineCI + if (allocated(OutData%LineCI)) deallocate(OutData%LineCI) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LineCI(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineCI.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LineCI) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LineCD + if (allocated(OutData%LineCD)) deallocate(OutData%LineCD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LineCD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineCD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LineCD) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Bvp + if (allocated(OutData%Bvp)) deallocate(OutData%Bvp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Bvp(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Bvp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Bvp) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WaveAcc0 + if (allocated(OutData%WaveAcc0)) deallocate(OutData%WaveAcc0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveAcc0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveAcc0) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WaveTime + if (allocated(OutData%WaveTime)) deallocate(OutData%WaveTime) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveTime(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveTime) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WaveVel0 + if (allocated(OutData%WaveVel0)) deallocate(OutData%WaveVel0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveVel0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveVel0) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NStepWave + call RegUnpack(Buf, OutData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + ! SHAP + call RegUnpack(Buf, OutData%SHAP) + if (RegCheckErr(Buf, RoutineName)) return + ! SHAPS + call RegUnpack(Buf, OutData%SHAPS) + if (RegCheckErr(Buf, RoutineName)) return + ! GAUSSW + call RegUnpack(Buf, OutData%GAUSSW) + if (RegCheckErr(Buf, RoutineName)) return + ! NGAUSS + call RegUnpack(Buf, OutData%NGAUSS) + if (RegCheckErr(Buf, RoutineName)) return + ! SHAPT + call RegUnpack(Buf, OutData%SHAPT) + if (RegCheckErr(Buf, RoutineName)) return + ! SHAPTS + call RegUnpack(Buf, OutData%SHAPTS) + if (RegCheckErr(Buf, RoutineName)) return + ! NTRAP + call RegUnpack(Buf, OutData%NTRAP) + if (RegCheckErr(Buf, RoutineName)) return + ! SBEND + call RegUnpack(Buf, OutData%SBEND) + if (RegCheckErr(Buf, RoutineName)) return + ! STEN + call RegUnpack(Buf, OutData%STEN) + if (RegCheckErr(Buf, RoutineName)) return + ! RMASS + call RegUnpack(Buf, OutData%RMASS) + if (RegCheckErr(Buf, RoutineName)) return + ! RADDM + call RegUnpack(Buf, OutData%RADDM) + if (RegCheckErr(Buf, RoutineName)) return + ! PMPN + call RegUnpack(Buf, OutData%PMPN) + if (RegCheckErr(Buf, RoutineName)) return + ! AM + call RegUnpack(Buf, OutData%AM) + if (RegCheckErr(Buf, RoutineName)) return + ! PM + call RegUnpack(Buf, OutData%PM) + if (RegCheckErr(Buf, RoutineName)) return + ! IDOF + call RegUnpack(Buf, OutData%IDOF) + if (RegCheckErr(Buf, RoutineName)) return + ! JDOF + call RegUnpack(Buf, OutData%JDOF) + if (RegCheckErr(Buf, RoutineName)) return + ! PPA + call RegUnpack(Buf, OutData%PPA) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmRefzt + call RegUnpack(Buf, OutData%PtfmRefzt) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! OutParam + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam + end do + end if + ! Delim + call RegUnpack(Buf, OutData%Delim) + if (RegCheckErr(Buf, RoutineName)) return + ! GLUZR + if (allocated(OutData%GLUZR)) deallocate(OutData%GLUZR) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%GLUZR(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLUZR.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%GLUZR) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! GTZER + if (allocated(OutData%GTZER)) deallocate(OutData%GTZER) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%GTZER(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GTZER.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%GTZER) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE FEAM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(FEAM_InputType), INTENT(INOUT) :: SrcInputData TYPE(FEAM_InputType), INTENT(INOUT) :: DstInputData @@ -6375,269 +3752,30 @@ SUBROUTINE FEAM_DestroyInput( InputData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE FEAM_DestroyInput - SUBROUTINE FEAM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FEAM_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! HydroForceLineMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%HydroForceLineMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! HydroForceLineMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! HydroForceLineMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! HydroForceLineMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! HydroForceLineMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! PtFairleadDisplacement: size of buffers for each call to pack subtype - CALL MeshPack( InData%PtFairleadDisplacement, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PtFairleadDisplacement - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PtFairleadDisplacement - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PtFairleadDisplacement - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PtFairleadDisplacement - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL MeshPack( InData%HydroForceLineMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! HydroForceLineMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MeshPack( InData%PtFairleadDisplacement, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PtFairleadDisplacement - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE FEAM_PackInput - - SUBROUTINE FEAM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FEAM_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%HydroForceLineMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! HydroForceLineMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%PtFairleadDisplacement, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PtFairleadDisplacement - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE FEAM_UnPackInput +subroutine FEAM_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FEAM_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FEAM_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + ! HydroForceLineMesh + call MeshPack(Buf, InData%HydroForceLineMesh) + if (RegCheckErr(Buf, RoutineName)) return + ! PtFairleadDisplacement + call MeshPack(Buf, InData%PtFairleadDisplacement) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FEAM_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FEAM_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FEAM_UnPackInput' + if (Buf%ErrStat /= ErrID_None) return + ! HydroForceLineMesh + call MeshUnpack(Buf, OutData%HydroForceLineMesh) ! HydroForceLineMesh + ! PtFairleadDisplacement + call MeshUnpack(Buf, OutData%PtFairleadDisplacement) ! PtFairleadDisplacement +end subroutine SUBROUTINE FEAM_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(FEAM_OutputType), INTENT(INOUT) :: SrcOutputData TYPE(FEAM_OutputType), INTENT(INOUT) :: DstOutputData @@ -6695,308 +3833,55 @@ SUBROUTINE FEAM_DestroyOutput( OutputData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE FEAM_DestroyOutput - SUBROUTINE FEAM_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FEAM_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! WriteOutput allocated yes/no - IF ( ALLOCATED(InData%WriteOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutput upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WriteOutput) ! WriteOutput - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! PtFairleadLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%PtFairleadLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PtFairleadLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PtFairleadLoad - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PtFairleadLoad - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PtFairleadLoad - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! LineMeshPosition: size of buffers for each call to pack subtype - CALL MeshPack( InData%LineMeshPosition, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! LineMeshPosition - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! LineMeshPosition - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! LineMeshPosition - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! LineMeshPosition - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) - ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - CALL MeshPack( InData%PtFairleadLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PtFairleadLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MeshPack( InData%LineMeshPosition, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! LineMeshPosition - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE FEAM_PackOutput - - SUBROUTINE FEAM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FEAM_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutput)) DEALLOCATE(OutData%WriteOutput) - ALLOCATE(OutData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) - OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%PtFairleadLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PtFairleadLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%LineMeshPosition, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! LineMeshPosition - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE FEAM_UnPackOutput +subroutine FEAM_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FEAM_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FEAM_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! WriteOutput + call RegPack(Buf, allocated(InData%WriteOutput)) + if (allocated(InData%WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPack(Buf, InData%WriteOutput) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PtFairleadLoad + call MeshPack(Buf, InData%PtFairleadLoad) + if (RegCheckErr(Buf, RoutineName)) return + ! LineMeshPosition + call MeshPack(Buf, InData%LineMeshPosition) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FEAM_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FEAM_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FEAM_UnPackOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! WriteOutput + if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PtFairleadLoad + call MeshUnpack(Buf, OutData%PtFairleadLoad) ! PtFairleadLoad + ! LineMeshPosition + call MeshUnpack(Buf, OutData%LineMeshPosition) ! LineMeshPosition +end subroutine SUBROUTINE FEAM_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) ! diff --git a/modules/hydrodyn/src/Conv_Radiation_Types.f90 b/modules/hydrodyn/src/Conv_Radiation_Types.f90 index 5dedba9458..56f0fb430e 100644 --- a/modules/hydrodyn/src/Conv_Radiation_Types.f90 +++ b/modules/hydrodyn/src/Conv_Radiation_Types.f90 @@ -193,298 +193,131 @@ SUBROUTINE Conv_Rdtn_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE Conv_Rdtn_DestroyInitInput - SUBROUTINE Conv_Rdtn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Conv_Rdtn_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! RdtnDT - Int_BufSz = Int_BufSz + 1*LEN(InData%RdtnDTChr) ! RdtnDTChr - Int_BufSz = Int_BufSz + 1 ! NBody - Re_BufSz = Re_BufSz + 1 ! HighFreq - Int_BufSz = Int_BufSz + 1*LEN(InData%WAMITFile) ! WAMITFile - Int_BufSz = Int_BufSz + 1 ! HdroAddMs allocated yes/no - IF ( ALLOCATED(InData%HdroAddMs) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! HdroAddMs upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%HdroAddMs) ! HdroAddMs - END IF - Int_BufSz = Int_BufSz + 1 ! HdroFreq allocated yes/no - IF ( ALLOCATED(InData%HdroFreq) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! HdroFreq upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%HdroFreq) ! HdroFreq - END IF - Int_BufSz = Int_BufSz + 1 ! HdroDmpng allocated yes/no - IF ( ALLOCATED(InData%HdroDmpng) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! HdroDmpng upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%HdroDmpng) ! HdroDmpng - END IF - Int_BufSz = Int_BufSz + 1 ! NInpFreq - Db_BufSz = Db_BufSz + 1 ! RdtnTMax - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%RdtnDT - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(InData%RdtnDTChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%RdtnDTChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%NBody - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HighFreq - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%WAMITFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%WAMITFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%HdroAddMs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%HdroAddMs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HdroAddMs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%HdroAddMs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HdroAddMs,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%HdroAddMs,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HdroAddMs,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%HdroAddMs,3), UBOUND(InData%HdroAddMs,3) - DO i2 = LBOUND(InData%HdroAddMs,2), UBOUND(InData%HdroAddMs,2) - DO i1 = LBOUND(InData%HdroAddMs,1), UBOUND(InData%HdroAddMs,1) - ReKiBuf(Re_Xferred) = InData%HdroAddMs(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%HdroFreq) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%HdroFreq,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HdroFreq,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%HdroFreq,1), UBOUND(InData%HdroFreq,1) - ReKiBuf(Re_Xferred) = InData%HdroFreq(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%HdroDmpng) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%HdroDmpng,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HdroDmpng,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%HdroDmpng,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HdroDmpng,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%HdroDmpng,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HdroDmpng,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%HdroDmpng,3), UBOUND(InData%HdroDmpng,3) - DO i2 = LBOUND(InData%HdroDmpng,2), UBOUND(InData%HdroDmpng,2) - DO i1 = LBOUND(InData%HdroDmpng,1), UBOUND(InData%HdroDmpng,1) - ReKiBuf(Re_Xferred) = InData%HdroDmpng(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NInpFreq - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%RdtnTMax - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE Conv_Rdtn_PackInitInput - - SUBROUTINE Conv_Rdtn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Conv_Rdtn_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%RdtnDT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(OutData%RdtnDTChr) - OutData%RdtnDTChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%NBody = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%HighFreq = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%WAMITFile) - OutData%WAMITFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HdroAddMs not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%HdroAddMs)) DEALLOCATE(OutData%HdroAddMs) - ALLOCATE(OutData%HdroAddMs(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HdroAddMs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%HdroAddMs,3), UBOUND(OutData%HdroAddMs,3) - DO i2 = LBOUND(OutData%HdroAddMs,2), UBOUND(OutData%HdroAddMs,2) - DO i1 = LBOUND(OutData%HdroAddMs,1), UBOUND(OutData%HdroAddMs,1) - OutData%HdroAddMs(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HdroFreq not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%HdroFreq)) DEALLOCATE(OutData%HdroFreq) - ALLOCATE(OutData%HdroFreq(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HdroFreq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%HdroFreq,1), UBOUND(OutData%HdroFreq,1) - OutData%HdroFreq(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HdroDmpng not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%HdroDmpng)) DEALLOCATE(OutData%HdroDmpng) - ALLOCATE(OutData%HdroDmpng(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HdroDmpng.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%HdroDmpng,3), UBOUND(OutData%HdroDmpng,3) - DO i2 = LBOUND(OutData%HdroDmpng,2), UBOUND(OutData%HdroDmpng,2) - DO i1 = LBOUND(OutData%HdroDmpng,1), UBOUND(OutData%HdroDmpng,1) - OutData%HdroDmpng(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%NInpFreq = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%RdtnTMax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE Conv_Rdtn_UnPackInitInput +subroutine Conv_Rdtn_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Conv_Rdtn_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Conv_Rdtn_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + ! RdtnDT + call RegPack(Buf, InData%RdtnDT) + if (RegCheckErr(Buf, RoutineName)) return + ! RdtnDTChr + call RegPack(Buf, InData%RdtnDTChr) + if (RegCheckErr(Buf, RoutineName)) return + ! NBody + call RegPack(Buf, InData%NBody) + if (RegCheckErr(Buf, RoutineName)) return + ! HighFreq + call RegPack(Buf, InData%HighFreq) + if (RegCheckErr(Buf, RoutineName)) return + ! WAMITFile + call RegPack(Buf, InData%WAMITFile) + if (RegCheckErr(Buf, RoutineName)) return + ! HdroAddMs + call RegPack(Buf, allocated(InData%HdroAddMs)) + if (allocated(InData%HdroAddMs)) then + call RegPackBounds(Buf, 3, lbound(InData%HdroAddMs), ubound(InData%HdroAddMs)) + call RegPack(Buf, InData%HdroAddMs) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! HdroFreq + call RegPack(Buf, allocated(InData%HdroFreq)) + if (allocated(InData%HdroFreq)) then + call RegPackBounds(Buf, 1, lbound(InData%HdroFreq), ubound(InData%HdroFreq)) + call RegPack(Buf, InData%HdroFreq) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! HdroDmpng + call RegPack(Buf, allocated(InData%HdroDmpng)) + if (allocated(InData%HdroDmpng)) then + call RegPackBounds(Buf, 3, lbound(InData%HdroDmpng), ubound(InData%HdroDmpng)) + call RegPack(Buf, InData%HdroDmpng) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NInpFreq + call RegPack(Buf, InData%NInpFreq) + if (RegCheckErr(Buf, RoutineName)) return + ! RdtnTMax + call RegPack(Buf, InData%RdtnTMax) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Conv_Rdtn_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackInitInput' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! RdtnDT + call RegUnpack(Buf, OutData%RdtnDT) + if (RegCheckErr(Buf, RoutineName)) return + ! RdtnDTChr + call RegUnpack(Buf, OutData%RdtnDTChr) + if (RegCheckErr(Buf, RoutineName)) return + ! NBody + call RegUnpack(Buf, OutData%NBody) + if (RegCheckErr(Buf, RoutineName)) return + ! HighFreq + call RegUnpack(Buf, OutData%HighFreq) + if (RegCheckErr(Buf, RoutineName)) return + ! WAMITFile + call RegUnpack(Buf, OutData%WAMITFile) + if (RegCheckErr(Buf, RoutineName)) return + ! HdroAddMs + if (allocated(OutData%HdroAddMs)) deallocate(OutData%HdroAddMs) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%HdroAddMs(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%HdroAddMs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%HdroAddMs) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! HdroFreq + if (allocated(OutData%HdroFreq)) deallocate(OutData%HdroFreq) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%HdroFreq(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%HdroFreq.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%HdroFreq) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! HdroDmpng + if (allocated(OutData%HdroDmpng)) deallocate(OutData%HdroDmpng) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%HdroDmpng(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%HdroDmpng.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%HdroDmpng) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NInpFreq + call RegUnpack(Buf, OutData%NInpFreq) + if (RegCheckErr(Buf, RoutineName)) return + ! RdtnTMax + call RegUnpack(Buf, OutData%RdtnTMax) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE Conv_Rdtn_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(Conv_Rdtn_InitOutputType), INTENT(IN) :: SrcInitOutputData TYPE(Conv_Rdtn_InitOutputType), INTENT(INOUT) :: DstInitOutputData @@ -517,103 +350,26 @@ SUBROUTINE Conv_Rdtn_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) END SUBROUTINE Conv_Rdtn_DestroyInitOutput - SUBROUTINE Conv_Rdtn_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Conv_Rdtn_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! DummyInitOut - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%DummyInitOut - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Conv_Rdtn_PackInitOutput - - SUBROUTINE Conv_Rdtn_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Conv_Rdtn_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyInitOut = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Conv_Rdtn_UnPackInitOutput +subroutine Conv_Rdtn_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Conv_Rdtn_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Conv_Rdtn_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyInitOut + call RegPack(Buf, InData%DummyInitOut) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Conv_Rdtn_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackInitOutput' + if (Buf%ErrStat /= ErrID_None) return + ! DummyInitOut + call RegUnpack(Buf, OutData%DummyInitOut) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE Conv_Rdtn_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(Conv_Rdtn_ContinuousStateType), INTENT(IN) :: SrcContStateData TYPE(Conv_Rdtn_ContinuousStateType), INTENT(INOUT) :: DstContStateData @@ -646,103 +402,26 @@ SUBROUTINE Conv_Rdtn_DestroyContState( ContStateData, ErrStat, ErrMsg ) END SUBROUTINE Conv_Rdtn_DestroyContState - SUBROUTINE Conv_Rdtn_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Conv_Rdtn_ContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_PackContState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyContState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Conv_Rdtn_PackContState - - SUBROUTINE Conv_Rdtn_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Conv_Rdtn_ContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_UnPackContState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyContState = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Conv_Rdtn_UnPackContState +subroutine Conv_Rdtn_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Conv_Rdtn_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Conv_Rdtn_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyContState + call RegPack(Buf, InData%DummyContState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Conv_Rdtn_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackContState' + if (Buf%ErrStat /= ErrID_None) return + ! DummyContState + call RegUnpack(Buf, OutData%DummyContState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE Conv_Rdtn_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(Conv_Rdtn_DiscreteStateType), INTENT(IN) :: SrcDiscStateData TYPE(Conv_Rdtn_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData @@ -794,153 +473,51 @@ SUBROUTINE Conv_Rdtn_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE Conv_Rdtn_DestroyDiscState - SUBROUTINE Conv_Rdtn_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Conv_Rdtn_DiscreteStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_PackDiscState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! XDHistory allocated yes/no - IF ( ALLOCATED(InData%XDHistory) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! XDHistory upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%XDHistory) ! XDHistory - END IF - Db_BufSz = Db_BufSz + 1 ! LastTime - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%XDHistory) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%XDHistory,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%XDHistory,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%XDHistory,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%XDHistory,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%XDHistory,2), UBOUND(InData%XDHistory,2) - DO i1 = LBOUND(InData%XDHistory,1), UBOUND(InData%XDHistory,1) - ReKiBuf(Re_Xferred) = InData%XDHistory(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DbKiBuf(Db_Xferred) = InData%LastTime - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE Conv_Rdtn_PackDiscState - - SUBROUTINE Conv_Rdtn_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Conv_Rdtn_DiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_UnPackDiscState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! XDHistory not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%XDHistory)) DEALLOCATE(OutData%XDHistory) - ALLOCATE(OutData%XDHistory(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%XDHistory.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%XDHistory,2), UBOUND(OutData%XDHistory,2) - DO i1 = LBOUND(OutData%XDHistory,1), UBOUND(OutData%XDHistory,1) - OutData%XDHistory(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%LastTime = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE Conv_Rdtn_UnPackDiscState +subroutine Conv_Rdtn_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Conv_Rdtn_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Conv_Rdtn_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + ! XDHistory + call RegPack(Buf, allocated(InData%XDHistory)) + if (allocated(InData%XDHistory)) then + call RegPackBounds(Buf, 2, lbound(InData%XDHistory), ubound(InData%XDHistory)) + call RegPack(Buf, InData%XDHistory) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LastTime + call RegPack(Buf, InData%LastTime) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Conv_Rdtn_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackDiscState' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! XDHistory + if (allocated(OutData%XDHistory)) deallocate(OutData%XDHistory) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%XDHistory(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%XDHistory.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%XDHistory) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LastTime + call RegUnpack(Buf, OutData%LastTime) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE Conv_Rdtn_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(Conv_Rdtn_ConstraintStateType), INTENT(IN) :: SrcConstrStateData TYPE(Conv_Rdtn_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData @@ -973,103 +550,26 @@ SUBROUTINE Conv_Rdtn_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) END SUBROUTINE Conv_Rdtn_DestroyConstrState - SUBROUTINE Conv_Rdtn_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Conv_Rdtn_ConstraintStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_PackConstrState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyConstrState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Conv_Rdtn_PackConstrState - - SUBROUTINE Conv_Rdtn_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Conv_Rdtn_ConstraintStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_UnPackConstrState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyConstrState = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Conv_Rdtn_UnPackConstrState +subroutine Conv_Rdtn_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Conv_Rdtn_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Conv_Rdtn_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyConstrState + call RegPack(Buf, InData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Conv_Rdtn_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + ! DummyConstrState + call RegUnpack(Buf, OutData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE Conv_Rdtn_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(Conv_Rdtn_OtherStateType), INTENT(IN) :: SrcOtherStateData TYPE(Conv_Rdtn_OtherStateType), INTENT(INOUT) :: DstOtherStateData @@ -1102,103 +602,26 @@ SUBROUTINE Conv_Rdtn_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) END SUBROUTINE Conv_Rdtn_DestroyOtherState - SUBROUTINE Conv_Rdtn_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Conv_Rdtn_OtherStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_PackOtherState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! IndRdtn - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%IndRdtn - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Conv_Rdtn_PackOtherState - - SUBROUTINE Conv_Rdtn_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Conv_Rdtn_OtherStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_UnPackOtherState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%IndRdtn = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Conv_Rdtn_UnPackOtherState +subroutine Conv_Rdtn_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Conv_Rdtn_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Conv_Rdtn_PackOtherState' + if (Buf%ErrStat >= AbortErrLev) return + ! IndRdtn + call RegPack(Buf, InData%IndRdtn) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Conv_Rdtn_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackOtherState' + if (Buf%ErrStat /= ErrID_None) return + ! IndRdtn + call RegUnpack(Buf, OutData%IndRdtn) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE Conv_Rdtn_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) TYPE(Conv_Rdtn_MiscVarType), INTENT(IN) :: SrcMiscData TYPE(Conv_Rdtn_MiscVarType), INTENT(INOUT) :: DstMiscData @@ -1231,103 +654,26 @@ SUBROUTINE Conv_Rdtn_DestroyMisc( MiscData, ErrStat, ErrMsg ) END SUBROUTINE Conv_Rdtn_DestroyMisc - SUBROUTINE Conv_Rdtn_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Conv_Rdtn_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! LastIndRdtn - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%LastIndRdtn - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Conv_Rdtn_PackMisc - - SUBROUTINE Conv_Rdtn_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Conv_Rdtn_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%LastIndRdtn = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Conv_Rdtn_UnPackMisc +subroutine Conv_Rdtn_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Conv_Rdtn_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Conv_Rdtn_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + ! LastIndRdtn + call RegPack(Buf, InData%LastIndRdtn) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Conv_Rdtn_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackMisc' + if (Buf%ErrStat /= ErrID_None) return + ! LastIndRdtn + call RegUnpack(Buf, OutData%LastIndRdtn) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE Conv_Rdtn_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(Conv_Rdtn_ParameterType), INTENT(IN) :: SrcParamData TYPE(Conv_Rdtn_ParameterType), INTENT(INOUT) :: DstParamData @@ -1386,184 +732,75 @@ SUBROUTINE Conv_Rdtn_DestroyParam( ParamData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE Conv_Rdtn_DestroyParam - SUBROUTINE Conv_Rdtn_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Conv_Rdtn_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! DT - Db_BufSz = Db_BufSz + 1 ! RdtnDT - Int_BufSz = Int_BufSz + 1 ! NBody - Int_BufSz = Int_BufSz + 1 ! RdtnKrnl allocated yes/no - IF ( ALLOCATED(InData%RdtnKrnl) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! RdtnKrnl upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%RdtnKrnl) ! RdtnKrnl - END IF - Int_BufSz = Int_BufSz + 1 ! NStepRdtn - Int_BufSz = Int_BufSz + 1 ! NStepRdtn1 - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%RdtnDT - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NBody - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%RdtnKrnl) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RdtnKrnl,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RdtnKrnl,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RdtnKrnl,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RdtnKrnl,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RdtnKrnl,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RdtnKrnl,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%RdtnKrnl,3), UBOUND(InData%RdtnKrnl,3) - DO i2 = LBOUND(InData%RdtnKrnl,2), UBOUND(InData%RdtnKrnl,2) - DO i1 = LBOUND(InData%RdtnKrnl,1), UBOUND(InData%RdtnKrnl,1) - ReKiBuf(Re_Xferred) = InData%RdtnKrnl(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NStepRdtn - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepRdtn1 - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Conv_Rdtn_PackParam - - SUBROUTINE Conv_Rdtn_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Conv_Rdtn_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%RdtnDT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%NBody = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RdtnKrnl not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RdtnKrnl)) DEALLOCATE(OutData%RdtnKrnl) - ALLOCATE(OutData%RdtnKrnl(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RdtnKrnl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%RdtnKrnl,3), UBOUND(OutData%RdtnKrnl,3) - DO i2 = LBOUND(OutData%RdtnKrnl,2), UBOUND(OutData%RdtnKrnl,2) - DO i1 = LBOUND(OutData%RdtnKrnl,1), UBOUND(OutData%RdtnKrnl,1) - OutData%RdtnKrnl(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%NStepRdtn = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NStepRdtn1 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Conv_Rdtn_UnPackParam +subroutine Conv_Rdtn_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Conv_Rdtn_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Conv_Rdtn_PackParam' + if (Buf%ErrStat >= AbortErrLev) return + ! DT + call RegPack(Buf, InData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! RdtnDT + call RegPack(Buf, InData%RdtnDT) + if (RegCheckErr(Buf, RoutineName)) return + ! NBody + call RegPack(Buf, InData%NBody) + if (RegCheckErr(Buf, RoutineName)) return + ! RdtnKrnl + call RegPack(Buf, allocated(InData%RdtnKrnl)) + if (allocated(InData%RdtnKrnl)) then + call RegPackBounds(Buf, 3, lbound(InData%RdtnKrnl), ubound(InData%RdtnKrnl)) + call RegPack(Buf, InData%RdtnKrnl) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NStepRdtn + call RegPack(Buf, InData%NStepRdtn) + if (RegCheckErr(Buf, RoutineName)) return + ! NStepRdtn1 + call RegPack(Buf, InData%NStepRdtn1) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Conv_Rdtn_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackParam' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! DT + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! RdtnDT + call RegUnpack(Buf, OutData%RdtnDT) + if (RegCheckErr(Buf, RoutineName)) return + ! NBody + call RegUnpack(Buf, OutData%NBody) + if (RegCheckErr(Buf, RoutineName)) return + ! RdtnKrnl + if (allocated(OutData%RdtnKrnl)) deallocate(OutData%RdtnKrnl) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RdtnKrnl(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RdtnKrnl.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RdtnKrnl) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NStepRdtn + call RegUnpack(Buf, OutData%NStepRdtn) + if (RegCheckErr(Buf, RoutineName)) return + ! NStepRdtn1 + call RegUnpack(Buf, OutData%NStepRdtn1) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE Conv_Rdtn_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(Conv_Rdtn_InputType), INTENT(IN) :: SrcInputData TYPE(Conv_Rdtn_InputType), INTENT(INOUT) :: DstInputData @@ -1611,137 +848,45 @@ SUBROUTINE Conv_Rdtn_DestroyInput( InputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE Conv_Rdtn_DestroyInput - SUBROUTINE Conv_Rdtn_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Conv_Rdtn_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! Velocity allocated yes/no - IF ( ALLOCATED(InData%Velocity) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Velocity upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Velocity) ! Velocity - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%Velocity) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Velocity,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Velocity,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Velocity,1), UBOUND(InData%Velocity,1) - ReKiBuf(Re_Xferred) = InData%Velocity(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE Conv_Rdtn_PackInput - - SUBROUTINE Conv_Rdtn_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Conv_Rdtn_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Velocity not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Velocity)) DEALLOCATE(OutData%Velocity) - ALLOCATE(OutData%Velocity(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Velocity.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Velocity,1), UBOUND(OutData%Velocity,1) - OutData%Velocity(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE Conv_Rdtn_UnPackInput +subroutine Conv_Rdtn_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Conv_Rdtn_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Conv_Rdtn_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + ! Velocity + call RegPack(Buf, allocated(InData%Velocity)) + if (allocated(InData%Velocity)) then + call RegPackBounds(Buf, 1, lbound(InData%Velocity), ubound(InData%Velocity)) + call RegPack(Buf, InData%Velocity) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Conv_Rdtn_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackInput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! Velocity + if (allocated(OutData%Velocity)) deallocate(OutData%Velocity) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Velocity(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Velocity.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Velocity) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE Conv_Rdtn_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(Conv_Rdtn_OutputType), INTENT(IN) :: SrcOutputData TYPE(Conv_Rdtn_OutputType), INTENT(INOUT) :: DstOutputData @@ -1789,137 +934,45 @@ SUBROUTINE Conv_Rdtn_DestroyOutput( OutputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE Conv_Rdtn_DestroyOutput - SUBROUTINE Conv_Rdtn_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Conv_Rdtn_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! F_Rdtn allocated yes/no - IF ( ALLOCATED(InData%F_Rdtn) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! F_Rdtn upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_Rdtn) ! F_Rdtn - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%F_Rdtn) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_Rdtn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_Rdtn,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%F_Rdtn,1), UBOUND(InData%F_Rdtn,1) - ReKiBuf(Re_Xferred) = InData%F_Rdtn(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE Conv_Rdtn_PackOutput - - SUBROUTINE Conv_Rdtn_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Conv_Rdtn_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_Rdtn not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_Rdtn)) DEALLOCATE(OutData%F_Rdtn) - ALLOCATE(OutData%F_Rdtn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_Rdtn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%F_Rdtn,1), UBOUND(OutData%F_Rdtn,1) - OutData%F_Rdtn(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE Conv_Rdtn_UnPackOutput +subroutine Conv_Rdtn_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Conv_Rdtn_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Conv_Rdtn_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! F_Rdtn + call RegPack(Buf, allocated(InData%F_Rdtn)) + if (allocated(InData%F_Rdtn)) then + call RegPackBounds(Buf, 1, lbound(InData%F_Rdtn), ubound(InData%F_Rdtn)) + call RegPack(Buf, InData%F_Rdtn) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Conv_Rdtn_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Conv_Rdtn_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! F_Rdtn + if (allocated(OutData%F_Rdtn)) deallocate(OutData%F_Rdtn) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_Rdtn(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_Rdtn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_Rdtn) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE Conv_Rdtn_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) ! diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index e195fcde9c..a8f4756bc8 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -543,1182 +543,469 @@ SUBROUTINE HydroDyn_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE HydroDyn_DestroyInputFile - SUBROUTINE HydroDyn_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(HydroDyn_InputFile), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_PackInputFile' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! EchoFlag - Int_BufSz = Int_BufSz + 1 ! AddF0 allocated yes/no - IF ( ALLOCATED(InData%AddF0) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AddF0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AddF0) ! AddF0 - END IF - Int_BufSz = Int_BufSz + 1 ! AddCLin allocated yes/no - IF ( ALLOCATED(InData%AddCLin) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AddCLin upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AddCLin) ! AddCLin - END IF - Int_BufSz = Int_BufSz + 1 ! AddBLin allocated yes/no - IF ( ALLOCATED(InData%AddBLin) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AddBLin upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AddBLin) ! AddBLin - END IF - Int_BufSz = Int_BufSz + 1 ! AddBQuad allocated yes/no - IF ( ALLOCATED(InData%AddBQuad) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AddBQuad upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AddBQuad) ! AddBQuad - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! SeaState: size of buffers for each call to pack subtype - CALL SeaSt_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%SeaState, ErrStat2, ErrMsg2, .TRUE. ) ! SeaState - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SeaState - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SeaState - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SeaState - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! PotFile allocated yes/no - IF ( ALLOCATED(InData%PotFile) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PotFile upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%PotFile)*LEN(InData%PotFile) ! PotFile - END IF - Int_BufSz = Int_BufSz + 1 ! nWAMITObj - Int_BufSz = Int_BufSz + 1 ! vecMultiplier - Int_BufSz = Int_BufSz + 1 ! NBody - Int_BufSz = Int_BufSz + 1 ! NBodyMod - Int_BufSz = Int_BufSz + 1 ! PtfmVol0 allocated yes/no - IF ( ALLOCATED(InData%PtfmVol0) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmVol0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmVol0) ! PtfmVol0 - END IF - Int_BufSz = Int_BufSz + 1 ! HasWAMIT - Int_BufSz = Int_BufSz + 1 ! WAMITULEN allocated yes/no - IF ( ALLOCATED(InData%WAMITULEN) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WAMITULEN upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WAMITULEN) ! WAMITULEN - END IF - Int_BufSz = Int_BufSz + 1 ! PtfmRefxt allocated yes/no - IF ( ALLOCATED(InData%PtfmRefxt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmRefxt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmRefxt) ! PtfmRefxt - END IF - Int_BufSz = Int_BufSz + 1 ! PtfmRefyt allocated yes/no - IF ( ALLOCATED(InData%PtfmRefyt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmRefyt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmRefyt) ! PtfmRefyt - END IF - Int_BufSz = Int_BufSz + 1 ! PtfmRefzt allocated yes/no - IF ( ALLOCATED(InData%PtfmRefzt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmRefzt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmRefzt) ! PtfmRefzt - END IF - Int_BufSz = Int_BufSz + 1 ! PtfmRefztRot allocated yes/no - IF ( ALLOCATED(InData%PtfmRefztRot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmRefztRot upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%PtfmRefztRot) ! PtfmRefztRot - END IF - Int_BufSz = Int_BufSz + 1 ! PtfmCOBxt allocated yes/no - IF ( ALLOCATED(InData%PtfmCOBxt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmCOBxt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmCOBxt) ! PtfmCOBxt - END IF - Int_BufSz = Int_BufSz + 1 ! PtfmCOByt allocated yes/no - IF ( ALLOCATED(InData%PtfmCOByt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmCOByt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmCOByt) ! PtfmCOByt - END IF - Int_BufSz = Int_BufSz + 3 ! WAMIT: size of buffers for each call to pack subtype - CALL WAMIT_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT, ErrStat2, ErrMsg2, .TRUE. ) ! WAMIT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMIT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMIT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMIT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! WAMIT2: size of buffers for each call to pack subtype - CALL WAMIT2_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT2, ErrStat2, ErrMsg2, .TRUE. ) ! WAMIT2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMIT2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMIT2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMIT2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Morison: size of buffers for each call to pack subtype - CALL Morison_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, .TRUE. ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Morison - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Morison - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Morison - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Echo - Int_BufSz = Int_BufSz + 1 ! PotMod - Int_BufSz = Int_BufSz + 1 ! NUserOutputs - Int_BufSz = Int_BufSz + 1 ! UserOutputs allocated yes/no - IF ( ALLOCATED(InData%UserOutputs) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UserOutputs upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%UserOutputs)*LEN(InData%UserOutputs) ! UserOutputs - END IF - Int_BufSz = Int_BufSz + 1 ! OutSwtch - Int_BufSz = Int_BufSz + 1 ! OutAll - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! OutList allocated yes/no - IF ( ALLOCATED(InData%OutList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%OutList)*LEN(InData%OutList) ! OutList - END IF - Int_BufSz = Int_BufSz + 1 ! HDSum - Int_BufSz = Int_BufSz + 1 ! UnSum - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt - Int_BufSz = Int_BufSz + 1*LEN(InData%OutSFmt) ! OutSFmt - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = TRANSFER(InData%EchoFlag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%AddF0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddF0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddF0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddF0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddF0,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AddF0,2), UBOUND(InData%AddF0,2) - DO i1 = LBOUND(InData%AddF0,1), UBOUND(InData%AddF0,1) - ReKiBuf(Re_Xferred) = InData%AddF0(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AddCLin) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddCLin,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddCLin,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddCLin,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddCLin,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddCLin,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddCLin,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AddCLin,3), UBOUND(InData%AddCLin,3) - DO i2 = LBOUND(InData%AddCLin,2), UBOUND(InData%AddCLin,2) - DO i1 = LBOUND(InData%AddCLin,1), UBOUND(InData%AddCLin,1) - ReKiBuf(Re_Xferred) = InData%AddCLin(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AddBLin) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddBLin,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddBLin,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddBLin,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddBLin,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddBLin,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddBLin,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AddBLin,3), UBOUND(InData%AddBLin,3) - DO i2 = LBOUND(InData%AddBLin,2), UBOUND(InData%AddBLin,2) - DO i1 = LBOUND(InData%AddBLin,1), UBOUND(InData%AddBLin,1) - ReKiBuf(Re_Xferred) = InData%AddBLin(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AddBQuad) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddBQuad,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddBQuad,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddBQuad,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddBQuad,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddBQuad,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddBQuad,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AddBQuad,3), UBOUND(InData%AddBQuad,3) - DO i2 = LBOUND(InData%AddBQuad,2), UBOUND(InData%AddBQuad,2) - DO i1 = LBOUND(InData%AddBQuad,1), UBOUND(InData%AddBQuad,1) - ReKiBuf(Re_Xferred) = InData%AddBQuad(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - CALL SeaSt_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%SeaState, ErrStat2, ErrMsg2, OnlySize ) ! SeaState - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%PotFile) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PotFile,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PotFile,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PotFile,1), UBOUND(InData%PotFile,1) - DO I = 1, LEN(InData%PotFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%PotFile(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IntKiBuf(Int_Xferred) = InData%nWAMITObj - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%vecMultiplier - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NBody - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NBodyMod - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%PtfmVol0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmVol0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmVol0,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmVol0,1), UBOUND(InData%PtfmVol0,1) - ReKiBuf(Re_Xferred) = InData%PtfmVol0(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%HasWAMIT, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WAMITULEN) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WAMITULEN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAMITULEN,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WAMITULEN,1), UBOUND(InData%WAMITULEN,1) - ReKiBuf(Re_Xferred) = InData%WAMITULEN(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PtfmRefxt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmRefxt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmRefxt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmRefxt,1), UBOUND(InData%PtfmRefxt,1) - ReKiBuf(Re_Xferred) = InData%PtfmRefxt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PtfmRefyt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmRefyt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmRefyt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmRefyt,1), UBOUND(InData%PtfmRefyt,1) - ReKiBuf(Re_Xferred) = InData%PtfmRefyt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PtfmRefzt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmRefzt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmRefzt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmRefzt,1), UBOUND(InData%PtfmRefzt,1) - ReKiBuf(Re_Xferred) = InData%PtfmRefzt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PtfmRefztRot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmRefztRot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmRefztRot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmRefztRot,1), UBOUND(InData%PtfmRefztRot,1) - DbKiBuf(Db_Xferred) = InData%PtfmRefztRot(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PtfmCOBxt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmCOBxt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmCOBxt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmCOBxt,1), UBOUND(InData%PtfmCOBxt,1) - ReKiBuf(Re_Xferred) = InData%PtfmCOBxt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PtfmCOByt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmCOByt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmCOByt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmCOByt,1), UBOUND(InData%PtfmCOByt,1) - ReKiBuf(Re_Xferred) = InData%PtfmCOByt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - CALL WAMIT_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT, ErrStat2, ErrMsg2, OnlySize ) ! WAMIT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL WAMIT2_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT2, ErrStat2, ErrMsg2, OnlySize ) ! WAMIT2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL Morison_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, OnlySize ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = TRANSFER(InData%Echo, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%PotMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NUserOutputs - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%UserOutputs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UserOutputs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UserOutputs,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UserOutputs,1), UBOUND(InData%UserOutputs,1) - DO I = 1, LEN(InData%UserOutputs) - IntKiBuf(Int_Xferred) = ICHAR(InData%UserOutputs(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IntKiBuf(Int_Xferred) = InData%OutSwtch - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%OutAll, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) - DO I = 1, LEN(InData%OutList) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%HDSum, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UnSum - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutSFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE HydroDyn_PackInputFile - - SUBROUTINE HydroDyn_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(HydroDyn_InputFile), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_UnPackInputFile' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%EchoFlag = TRANSFER(IntKiBuf(Int_Xferred), OutData%EchoFlag) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AddF0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AddF0)) DEALLOCATE(OutData%AddF0) - ALLOCATE(OutData%AddF0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AddF0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AddF0,2), UBOUND(OutData%AddF0,2) - DO i1 = LBOUND(OutData%AddF0,1), UBOUND(OutData%AddF0,1) - OutData%AddF0(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AddCLin not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AddCLin)) DEALLOCATE(OutData%AddCLin) - ALLOCATE(OutData%AddCLin(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AddCLin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AddCLin,3), UBOUND(OutData%AddCLin,3) - DO i2 = LBOUND(OutData%AddCLin,2), UBOUND(OutData%AddCLin,2) - DO i1 = LBOUND(OutData%AddCLin,1), UBOUND(OutData%AddCLin,1) - OutData%AddCLin(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AddBLin not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AddBLin)) DEALLOCATE(OutData%AddBLin) - ALLOCATE(OutData%AddBLin(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AddBLin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AddBLin,3), UBOUND(OutData%AddBLin,3) - DO i2 = LBOUND(OutData%AddBLin,2), UBOUND(OutData%AddBLin,2) - DO i1 = LBOUND(OutData%AddBLin,1), UBOUND(OutData%AddBLin,1) - OutData%AddBLin(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AddBQuad not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AddBQuad)) DEALLOCATE(OutData%AddBQuad) - ALLOCATE(OutData%AddBQuad(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AddBQuad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AddBQuad,3), UBOUND(OutData%AddBQuad,3) - DO i2 = LBOUND(OutData%AddBQuad,2), UBOUND(OutData%AddBQuad,2) - DO i1 = LBOUND(OutData%AddBQuad,1), UBOUND(OutData%AddBQuad,1) - OutData%AddBQuad(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SeaSt_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%SeaState, ErrStat2, ErrMsg2 ) ! SeaState - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PotFile not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PotFile)) DEALLOCATE(OutData%PotFile) - ALLOCATE(OutData%PotFile(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PotFile.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PotFile,1), UBOUND(OutData%PotFile,1) - DO I = 1, LEN(OutData%PotFile) - OutData%PotFile(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - OutData%nWAMITObj = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%vecMultiplier = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NBody = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NBodyMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmVol0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PtfmVol0)) DEALLOCATE(OutData%PtfmVol0) - ALLOCATE(OutData%PtfmVol0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmVol0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmVol0,1), UBOUND(OutData%PtfmVol0,1) - OutData%PtfmVol0(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%HasWAMIT = TRANSFER(IntKiBuf(Int_Xferred), OutData%HasWAMIT) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WAMITULEN not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WAMITULEN)) DEALLOCATE(OutData%WAMITULEN) - ALLOCATE(OutData%WAMITULEN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMITULEN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WAMITULEN,1), UBOUND(OutData%WAMITULEN,1) - OutData%WAMITULEN(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmRefxt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PtfmRefxt)) DEALLOCATE(OutData%PtfmRefxt) - ALLOCATE(OutData%PtfmRefxt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefxt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmRefxt,1), UBOUND(OutData%PtfmRefxt,1) - OutData%PtfmRefxt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmRefyt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PtfmRefyt)) DEALLOCATE(OutData%PtfmRefyt) - ALLOCATE(OutData%PtfmRefyt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefyt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmRefyt,1), UBOUND(OutData%PtfmRefyt,1) - OutData%PtfmRefyt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmRefzt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PtfmRefzt)) DEALLOCATE(OutData%PtfmRefzt) - ALLOCATE(OutData%PtfmRefzt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefzt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmRefzt,1), UBOUND(OutData%PtfmRefzt,1) - OutData%PtfmRefzt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmRefztRot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PtfmRefztRot)) DEALLOCATE(OutData%PtfmRefztRot) - ALLOCATE(OutData%PtfmRefztRot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefztRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmRefztRot,1), UBOUND(OutData%PtfmRefztRot,1) - OutData%PtfmRefztRot(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmCOBxt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PtfmCOBxt)) DEALLOCATE(OutData%PtfmCOBxt) - ALLOCATE(OutData%PtfmCOBxt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmCOBxt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmCOBxt,1), UBOUND(OutData%PtfmCOBxt,1) - OutData%PtfmCOBxt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmCOByt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PtfmCOByt)) DEALLOCATE(OutData%PtfmCOByt) - ALLOCATE(OutData%PtfmCOByt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmCOByt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmCOByt,1), UBOUND(OutData%PtfmCOByt,1) - OutData%PtfmCOByt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL WAMIT_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%WAMIT, ErrStat2, ErrMsg2 ) ! WAMIT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL WAMIT2_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%WAMIT2, ErrStat2, ErrMsg2 ) ! WAMIT2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Morison_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%Morison, ErrStat2, ErrMsg2 ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%Echo = TRANSFER(IntKiBuf(Int_Xferred), OutData%Echo) - Int_Xferred = Int_Xferred + 1 - OutData%PotMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NUserOutputs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UserOutputs not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%UserOutputs)) DEALLOCATE(OutData%UserOutputs) - ALLOCATE(OutData%UserOutputs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UserOutputs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UserOutputs,1), UBOUND(OutData%UserOutputs,1) - DO I = 1, LEN(OutData%UserOutputs) - OutData%UserOutputs(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - OutData%OutSwtch = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%OutAll = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutAll) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutList not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutList)) DEALLOCATE(OutData%OutList) - ALLOCATE(OutData%OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) - DO I = 1, LEN(OutData%OutList) - OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - OutData%HDSum = TRANSFER(IntKiBuf(Int_Xferred), OutData%HDSum) - Int_Xferred = Int_Xferred + 1 - OutData%UnSum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutSFmt) - OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE HydroDyn_UnPackInputFile +subroutine HydroDyn_PackInputFile(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_InputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'HydroDyn_PackInputFile' + if (Buf%ErrStat >= AbortErrLev) return + ! EchoFlag + call RegPack(Buf, InData%EchoFlag) + if (RegCheckErr(Buf, RoutineName)) return + ! AddF0 + call RegPack(Buf, allocated(InData%AddF0)) + if (allocated(InData%AddF0)) then + call RegPackBounds(Buf, 2, lbound(InData%AddF0), ubound(InData%AddF0)) + call RegPack(Buf, InData%AddF0) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AddCLin + call RegPack(Buf, allocated(InData%AddCLin)) + if (allocated(InData%AddCLin)) then + call RegPackBounds(Buf, 3, lbound(InData%AddCLin), ubound(InData%AddCLin)) + call RegPack(Buf, InData%AddCLin) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AddBLin + call RegPack(Buf, allocated(InData%AddBLin)) + if (allocated(InData%AddBLin)) then + call RegPackBounds(Buf, 3, lbound(InData%AddBLin), ubound(InData%AddBLin)) + call RegPack(Buf, InData%AddBLin) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AddBQuad + call RegPack(Buf, allocated(InData%AddBQuad)) + if (allocated(InData%AddBQuad)) then + call RegPackBounds(Buf, 3, lbound(InData%AddBQuad), ubound(InData%AddBQuad)) + call RegPack(Buf, InData%AddBQuad) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SeaState + call SeaSt_PackInitInput(Buf, InData%SeaState) + if (RegCheckErr(Buf, RoutineName)) return + ! PotFile + call RegPack(Buf, allocated(InData%PotFile)) + if (allocated(InData%PotFile)) then + call RegPackBounds(Buf, 1, lbound(InData%PotFile), ubound(InData%PotFile)) + call RegPack(Buf, InData%PotFile) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! nWAMITObj + call RegPack(Buf, InData%nWAMITObj) + if (RegCheckErr(Buf, RoutineName)) return + ! vecMultiplier + call RegPack(Buf, InData%vecMultiplier) + if (RegCheckErr(Buf, RoutineName)) return + ! NBody + call RegPack(Buf, InData%NBody) + if (RegCheckErr(Buf, RoutineName)) return + ! NBodyMod + call RegPack(Buf, InData%NBodyMod) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmVol0 + call RegPack(Buf, allocated(InData%PtfmVol0)) + if (allocated(InData%PtfmVol0)) then + call RegPackBounds(Buf, 1, lbound(InData%PtfmVol0), ubound(InData%PtfmVol0)) + call RegPack(Buf, InData%PtfmVol0) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! HasWAMIT + call RegPack(Buf, InData%HasWAMIT) + if (RegCheckErr(Buf, RoutineName)) return + ! WAMITULEN + call RegPack(Buf, allocated(InData%WAMITULEN)) + if (allocated(InData%WAMITULEN)) then + call RegPackBounds(Buf, 1, lbound(InData%WAMITULEN), ubound(InData%WAMITULEN)) + call RegPack(Buf, InData%WAMITULEN) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmRefxt + call RegPack(Buf, allocated(InData%PtfmRefxt)) + if (allocated(InData%PtfmRefxt)) then + call RegPackBounds(Buf, 1, lbound(InData%PtfmRefxt), ubound(InData%PtfmRefxt)) + call RegPack(Buf, InData%PtfmRefxt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmRefyt + call RegPack(Buf, allocated(InData%PtfmRefyt)) + if (allocated(InData%PtfmRefyt)) then + call RegPackBounds(Buf, 1, lbound(InData%PtfmRefyt), ubound(InData%PtfmRefyt)) + call RegPack(Buf, InData%PtfmRefyt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmRefzt + call RegPack(Buf, allocated(InData%PtfmRefzt)) + if (allocated(InData%PtfmRefzt)) then + call RegPackBounds(Buf, 1, lbound(InData%PtfmRefzt), ubound(InData%PtfmRefzt)) + call RegPack(Buf, InData%PtfmRefzt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmRefztRot + call RegPack(Buf, allocated(InData%PtfmRefztRot)) + if (allocated(InData%PtfmRefztRot)) then + call RegPackBounds(Buf, 1, lbound(InData%PtfmRefztRot), ubound(InData%PtfmRefztRot)) + call RegPack(Buf, InData%PtfmRefztRot) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmCOBxt + call RegPack(Buf, allocated(InData%PtfmCOBxt)) + if (allocated(InData%PtfmCOBxt)) then + call RegPackBounds(Buf, 1, lbound(InData%PtfmCOBxt), ubound(InData%PtfmCOBxt)) + call RegPack(Buf, InData%PtfmCOBxt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmCOByt + call RegPack(Buf, allocated(InData%PtfmCOByt)) + if (allocated(InData%PtfmCOByt)) then + call RegPackBounds(Buf, 1, lbound(InData%PtfmCOByt), ubound(InData%PtfmCOByt)) + call RegPack(Buf, InData%PtfmCOByt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WAMIT + call WAMIT_PackInitInput(Buf, InData%WAMIT) + if (RegCheckErr(Buf, RoutineName)) return + ! WAMIT2 + call WAMIT2_PackInitInput(Buf, InData%WAMIT2) + if (RegCheckErr(Buf, RoutineName)) return + ! Morison + call Morison_PackInitInput(Buf, InData%Morison) + if (RegCheckErr(Buf, RoutineName)) return + ! Echo + call RegPack(Buf, InData%Echo) + if (RegCheckErr(Buf, RoutineName)) return + ! PotMod + call RegPack(Buf, InData%PotMod) + if (RegCheckErr(Buf, RoutineName)) return + ! NUserOutputs + call RegPack(Buf, InData%NUserOutputs) + if (RegCheckErr(Buf, RoutineName)) return + ! UserOutputs + call RegPack(Buf, allocated(InData%UserOutputs)) + if (allocated(InData%UserOutputs)) then + call RegPackBounds(Buf, 1, lbound(InData%UserOutputs), ubound(InData%UserOutputs)) + call RegPack(Buf, InData%UserOutputs) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OutSwtch + call RegPack(Buf, InData%OutSwtch) + if (RegCheckErr(Buf, RoutineName)) return + ! OutAll + call RegPack(Buf, InData%OutAll) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegPack(Buf, InData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! OutList + call RegPack(Buf, allocated(InData%OutList)) + if (allocated(InData%OutList)) then + call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) + call RegPack(Buf, InData%OutList) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! HDSum + call RegPack(Buf, InData%HDSum) + if (RegCheckErr(Buf, RoutineName)) return + ! UnSum + call RegPack(Buf, InData%UnSum) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFmt + call RegPack(Buf, InData%OutFmt) + if (RegCheckErr(Buf, RoutineName)) return + ! OutSFmt + call RegPack(Buf, InData%OutSFmt) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine HydroDyn_UnPackInputFile(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_InputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'HydroDyn_UnPackInputFile' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! EchoFlag + call RegUnpack(Buf, OutData%EchoFlag) + if (RegCheckErr(Buf, RoutineName)) return + ! AddF0 + if (allocated(OutData%AddF0)) deallocate(OutData%AddF0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AddF0(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AddF0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AddF0) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AddCLin + if (allocated(OutData%AddCLin)) deallocate(OutData%AddCLin) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AddCLin(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AddCLin.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AddCLin) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AddBLin + if (allocated(OutData%AddBLin)) deallocate(OutData%AddBLin) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AddBLin(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AddBLin.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AddBLin) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AddBQuad + if (allocated(OutData%AddBQuad)) deallocate(OutData%AddBQuad) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AddBQuad(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AddBQuad.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AddBQuad) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! SeaState + call SeaSt_UnpackInitInput(Buf, OutData%SeaState) ! SeaState + ! PotFile + if (allocated(OutData%PotFile)) deallocate(OutData%PotFile) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PotFile(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PotFile.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PotFile) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! nWAMITObj + call RegUnpack(Buf, OutData%nWAMITObj) + if (RegCheckErr(Buf, RoutineName)) return + ! vecMultiplier + call RegUnpack(Buf, OutData%vecMultiplier) + if (RegCheckErr(Buf, RoutineName)) return + ! NBody + call RegUnpack(Buf, OutData%NBody) + if (RegCheckErr(Buf, RoutineName)) return + ! NBodyMod + call RegUnpack(Buf, OutData%NBodyMod) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmVol0 + if (allocated(OutData%PtfmVol0)) deallocate(OutData%PtfmVol0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PtfmVol0(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmVol0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PtfmVol0) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! HasWAMIT + call RegUnpack(Buf, OutData%HasWAMIT) + if (RegCheckErr(Buf, RoutineName)) return + ! WAMITULEN + if (allocated(OutData%WAMITULEN)) deallocate(OutData%WAMITULEN) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WAMITULEN(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMITULEN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WAMITULEN) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PtfmRefxt + if (allocated(OutData%PtfmRefxt)) deallocate(OutData%PtfmRefxt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PtfmRefxt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefxt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PtfmRefxt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PtfmRefyt + if (allocated(OutData%PtfmRefyt)) deallocate(OutData%PtfmRefyt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PtfmRefyt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefyt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PtfmRefyt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PtfmRefzt + if (allocated(OutData%PtfmRefzt)) deallocate(OutData%PtfmRefzt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PtfmRefzt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefzt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PtfmRefzt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PtfmRefztRot + if (allocated(OutData%PtfmRefztRot)) deallocate(OutData%PtfmRefztRot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PtfmRefztRot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefztRot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PtfmRefztRot) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PtfmCOBxt + if (allocated(OutData%PtfmCOBxt)) deallocate(OutData%PtfmCOBxt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PtfmCOBxt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmCOBxt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PtfmCOBxt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PtfmCOByt + if (allocated(OutData%PtfmCOByt)) deallocate(OutData%PtfmCOByt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PtfmCOByt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmCOByt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PtfmCOByt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WAMIT + call WAMIT_UnpackInitInput(Buf, OutData%WAMIT) ! WAMIT + ! WAMIT2 + call WAMIT2_UnpackInitInput(Buf, OutData%WAMIT2) ! WAMIT2 + ! Morison + call Morison_UnpackInitInput(Buf, OutData%Morison) ! Morison + ! Echo + call RegUnpack(Buf, OutData%Echo) + if (RegCheckErr(Buf, RoutineName)) return + ! PotMod + call RegUnpack(Buf, OutData%PotMod) + if (RegCheckErr(Buf, RoutineName)) return + ! NUserOutputs + call RegUnpack(Buf, OutData%NUserOutputs) + if (RegCheckErr(Buf, RoutineName)) return + ! UserOutputs + if (allocated(OutData%UserOutputs)) deallocate(OutData%UserOutputs) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%UserOutputs(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UserOutputs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%UserOutputs) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! OutSwtch + call RegUnpack(Buf, OutData%OutSwtch) + if (RegCheckErr(Buf, RoutineName)) return + ! OutAll + call RegUnpack(Buf, OutData%OutAll) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! OutList + if (allocated(OutData%OutList)) deallocate(OutData%OutList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutList) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! HDSum + call RegUnpack(Buf, OutData%HDSum) + if (RegCheckErr(Buf, RoutineName)) return + ! UnSum + call RegUnpack(Buf, OutData%UnSum) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFmt + call RegUnpack(Buf, OutData%OutFmt) + if (RegCheckErr(Buf, RoutineName)) return + ! OutSFmt + call RegUnpack(Buf, OutData%OutSFmt) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE HydroDyn_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(HydroDyn_InitInputType), INTENT(IN) :: SrcInitInputData TYPE(HydroDyn_InitInputType), INTENT(INOUT) :: DstInitInputData @@ -1824,442 +1111,285 @@ SUBROUTINE HydroDyn_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) NULLIFY(InitInputData%WaveField) END SUBROUTINE HydroDyn_DestroyInitInput - SUBROUTINE HydroDyn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(HydroDyn_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%InputFile) ! InputFile - Int_BufSz = Int_BufSz + 1 ! UseInputFile - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! PassedFileData: size of buffers for each call to pack subtype - CALL NWTC_Library_PackFileInfoType( Re_Buf, Db_Buf, Int_Buf, InData%PassedFileData, ErrStat2, ErrMsg2, .TRUE. ) ! PassedFileData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PassedFileData - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PassedFileData - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PassedFileData - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%OutRootName) ! OutRootName - Int_BufSz = Int_BufSz + 1 ! Linearize - Re_BufSz = Re_BufSz + 1 ! Gravity - Re_BufSz = Re_BufSz + 1 ! WtrDens - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Re_BufSz = Re_BufSz + 1 ! MSL2SWL - Db_BufSz = Db_BufSz + 1 ! TMax - Re_BufSz = Re_BufSz + 1 ! PtfmLocationX - Re_BufSz = Re_BufSz + 1 ! PtfmLocationY - Int_BufSz = Int_BufSz + 1 ! NStepWave - Int_BufSz = Int_BufSz + 1 ! NStepWave2 - Re_BufSz = Re_BufSz + 1 ! RhoXg - Int_BufSz = Int_BufSz + 1 ! WaveMod - Int_BufSz = Int_BufSz + 1 ! WaveStMod - Int_BufSz = Int_BufSz + 1 ! WaveDirMod - Re_BufSz = Re_BufSz + 1 ! WvLowCOff - Re_BufSz = Re_BufSz + 1 ! WvHiCOff - Re_BufSz = Re_BufSz + 1 ! WvLowCOffD - Re_BufSz = Re_BufSz + 1 ! WvHiCOffD - Re_BufSz = Re_BufSz + 1 ! WvLowCOffS - Re_BufSz = Re_BufSz + 1 ! WvHiCOffS - Int_BufSz = Int_BufSz + 1 ! InvalidWithSSExctn - Int_BufSz = Int_BufSz + 1 ! WaveElev0 allocated yes/no - IF ( ALLOCATED(InData%WaveElev0) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveElev0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev0) ! WaveElev0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElevC allocated yes/no - IF ( ALLOCATED(InData%WaveElevC) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveElevC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElevC) ! WaveElevC - END IF - Re_BufSz = Re_BufSz + 1 ! WaveDirMin - Re_BufSz = Re_BufSz + 1 ! WaveDirMax - Re_BufSz = Re_BufSz + 1 ! WaveDir - Int_BufSz = Int_BufSz + 1 ! WaveMultiDir - Re_BufSz = Re_BufSz + 1 ! WaveDOmega - Re_BufSz = Re_BufSz + 1 ! MCFD - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseInputFile, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - CALL NWTC_Library_PackFileInfoType( Re_Buf, Db_Buf, Int_Buf, InData%PassedFileData, ErrStat2, ErrMsg2, OnlySize ) ! PassedFileData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - DO I = 1, LEN(InData%OutRootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutRootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TMax - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmLocationX - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmLocationY - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepWave2 - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RhoXg - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveStMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveDirMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WvLowCOff - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WvHiCOff - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WvLowCOffD - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WvHiCOffD - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WvLowCOffS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WvHiCOffS - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%InvalidWithSSExctn, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveElev0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev0,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveElev0,1), UBOUND(InData%WaveElev0,1) - ReKiBuf(Re_Xferred) = InData%WaveElev0(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveElevC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveElevC,3), UBOUND(InData%WaveElevC,3) - DO i2 = LBOUND(InData%WaveElevC,2), UBOUND(InData%WaveElevC,2) - DO i1 = LBOUND(InData%WaveElevC,1), UBOUND(InData%WaveElevC,1) - ReKiBuf(Re_Xferred) = InData%WaveElevC(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%WaveDirMin - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDirMax - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDir - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WaveMultiDir, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDOmega - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MCFD - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE HydroDyn_PackInitInput - - SUBROUTINE HydroDyn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(HydroDyn_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UseInputFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseInputFile) - Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackFileInfoType( Re_Buf, Db_Buf, Int_Buf, OutData%PassedFileData, ErrStat2, ErrMsg2 ) ! PassedFileData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - DO I = 1, LEN(OutData%OutRootName) - OutData%OutRootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) - Int_Xferred = Int_Xferred + 1 - OutData%Gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MSL2SWL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TMax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%PtfmLocationX = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmLocationY = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NStepWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NStepWave2 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%RhoXg = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WaveStMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WaveDirMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WvLowCOff = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WvHiCOff = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WvLowCOffD = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WvHiCOffD = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WvLowCOffS = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WvHiCOffS = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%InvalidWithSSExctn = TRANSFER(IntKiBuf(Int_Xferred), OutData%InvalidWithSSExctn) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveElev0)) DEALLOCATE(OutData%WaveElev0) - ALLOCATE(OutData%WaveElev0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveElev0,1), UBOUND(OutData%WaveElev0,1) - OutData%WaveElev0(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveElevC)) DEALLOCATE(OutData%WaveElevC) - ALLOCATE(OutData%WaveElevC(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveElevC,3), UBOUND(OutData%WaveElevC,3) - DO i2 = LBOUND(OutData%WaveElevC,2), UBOUND(OutData%WaveElevC,2) - DO i1 = LBOUND(OutData%WaveElevC,1), UBOUND(OutData%WaveElevC,1) - OutData%WaveElevC(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%WaveDirMin = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDirMax = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDir = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveMultiDir = TRANSFER(IntKiBuf(Int_Xferred), OutData%WaveMultiDir) - Int_Xferred = Int_Xferred + 1 - OutData%WaveDOmega = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%MCFD = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - NULLIFY(OutData%WaveField) - END SUBROUTINE HydroDyn_UnPackInitInput +subroutine HydroDyn_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'HydroDyn_PackInitInput' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + ! InputFile + call RegPack(Buf, InData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! UseInputFile + call RegPack(Buf, InData%UseInputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! PassedFileData + call NWTC_Library_PackFileInfoType(Buf, InData%PassedFileData) + if (RegCheckErr(Buf, RoutineName)) return + ! OutRootName + call RegPack(Buf, InData%OutRootName) + if (RegCheckErr(Buf, RoutineName)) return + ! Linearize + call RegPack(Buf, InData%Linearize) + if (RegCheckErr(Buf, RoutineName)) return + ! Gravity + call RegPack(Buf, InData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDens + call RegPack(Buf, InData%WtrDens) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDpth + call RegPack(Buf, InData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! MSL2SWL + call RegPack(Buf, InData%MSL2SWL) + if (RegCheckErr(Buf, RoutineName)) return + ! TMax + call RegPack(Buf, InData%TMax) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmLocationX + call RegPack(Buf, InData%PtfmLocationX) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmLocationY + call RegPack(Buf, InData%PtfmLocationY) + if (RegCheckErr(Buf, RoutineName)) return + ! NStepWave + call RegPack(Buf, InData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + ! NStepWave2 + call RegPack(Buf, InData%NStepWave2) + if (RegCheckErr(Buf, RoutineName)) return + ! RhoXg + call RegPack(Buf, InData%RhoXg) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveMod + call RegPack(Buf, InData%WaveMod) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveStMod + call RegPack(Buf, InData%WaveStMod) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDirMod + call RegPack(Buf, InData%WaveDirMod) + if (RegCheckErr(Buf, RoutineName)) return + ! WvLowCOff + call RegPack(Buf, InData%WvLowCOff) + if (RegCheckErr(Buf, RoutineName)) return + ! WvHiCOff + call RegPack(Buf, InData%WvHiCOff) + if (RegCheckErr(Buf, RoutineName)) return + ! WvLowCOffD + call RegPack(Buf, InData%WvLowCOffD) + if (RegCheckErr(Buf, RoutineName)) return + ! WvHiCOffD + call RegPack(Buf, InData%WvHiCOffD) + if (RegCheckErr(Buf, RoutineName)) return + ! WvLowCOffS + call RegPack(Buf, InData%WvLowCOffS) + if (RegCheckErr(Buf, RoutineName)) return + ! WvHiCOffS + call RegPack(Buf, InData%WvHiCOffS) + if (RegCheckErr(Buf, RoutineName)) return + ! InvalidWithSSExctn + call RegPack(Buf, InData%InvalidWithSSExctn) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElev0 + call RegPack(Buf, allocated(InData%WaveElev0)) + if (allocated(InData%WaveElev0)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveElev0), ubound(InData%WaveElev0)) + call RegPack(Buf, InData%WaveElev0) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElevC + call RegPack(Buf, allocated(InData%WaveElevC)) + if (allocated(InData%WaveElevC)) then + call RegPackBounds(Buf, 3, lbound(InData%WaveElevC), ubound(InData%WaveElevC)) + call RegPack(Buf, InData%WaveElevC) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDirMin + call RegPack(Buf, InData%WaveDirMin) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDirMax + call RegPack(Buf, InData%WaveDirMax) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDir + call RegPack(Buf, InData%WaveDir) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveMultiDir + call RegPack(Buf, InData%WaveMultiDir) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDOmega + call RegPack(Buf, InData%WaveDOmega) + if (RegCheckErr(Buf, RoutineName)) return + ! MCFD + call RegPack(Buf, InData%MCFD) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveField + call RegPack(Buf, associated(InData%WaveField)) + if (associated(InData%WaveField)) then + call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) + if (.not. PtrInIndex) then + call SeaSt_WaveField_PackSeaSt_WaveFieldType(Buf, InData%WaveField) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine HydroDyn_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'HydroDyn_UnPackInitInput' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + ! InputFile + call RegUnpack(Buf, OutData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! UseInputFile + call RegUnpack(Buf, OutData%UseInputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! PassedFileData + call NWTC_Library_UnpackFileInfoType(Buf, OutData%PassedFileData) ! PassedFileData + ! OutRootName + call RegUnpack(Buf, OutData%OutRootName) + if (RegCheckErr(Buf, RoutineName)) return + ! Linearize + call RegUnpack(Buf, OutData%Linearize) + if (RegCheckErr(Buf, RoutineName)) return + ! Gravity + call RegUnpack(Buf, OutData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDens + call RegUnpack(Buf, OutData%WtrDens) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDpth + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! MSL2SWL + call RegUnpack(Buf, OutData%MSL2SWL) + if (RegCheckErr(Buf, RoutineName)) return + ! TMax + call RegUnpack(Buf, OutData%TMax) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmLocationX + call RegUnpack(Buf, OutData%PtfmLocationX) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmLocationY + call RegUnpack(Buf, OutData%PtfmLocationY) + if (RegCheckErr(Buf, RoutineName)) return + ! NStepWave + call RegUnpack(Buf, OutData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + ! NStepWave2 + call RegUnpack(Buf, OutData%NStepWave2) + if (RegCheckErr(Buf, RoutineName)) return + ! RhoXg + call RegUnpack(Buf, OutData%RhoXg) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveMod + call RegUnpack(Buf, OutData%WaveMod) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveStMod + call RegUnpack(Buf, OutData%WaveStMod) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDirMod + call RegUnpack(Buf, OutData%WaveDirMod) + if (RegCheckErr(Buf, RoutineName)) return + ! WvLowCOff + call RegUnpack(Buf, OutData%WvLowCOff) + if (RegCheckErr(Buf, RoutineName)) return + ! WvHiCOff + call RegUnpack(Buf, OutData%WvHiCOff) + if (RegCheckErr(Buf, RoutineName)) return + ! WvLowCOffD + call RegUnpack(Buf, OutData%WvLowCOffD) + if (RegCheckErr(Buf, RoutineName)) return + ! WvHiCOffD + call RegUnpack(Buf, OutData%WvHiCOffD) + if (RegCheckErr(Buf, RoutineName)) return + ! WvLowCOffS + call RegUnpack(Buf, OutData%WvLowCOffS) + if (RegCheckErr(Buf, RoutineName)) return + ! WvHiCOffS + call RegUnpack(Buf, OutData%WvHiCOffS) + if (RegCheckErr(Buf, RoutineName)) return + ! InvalidWithSSExctn + call RegUnpack(Buf, OutData%InvalidWithSSExctn) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElev0 + if (allocated(OutData%WaveElev0)) deallocate(OutData%WaveElev0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveElev0(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveElev0) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WaveElevC + if (allocated(OutData%WaveElevC)) deallocate(OutData%WaveElevC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveElevC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveElevC) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WaveDirMin + call RegUnpack(Buf, OutData%WaveDirMin) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDirMax + call RegUnpack(Buf, OutData%WaveDirMax) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDir + call RegUnpack(Buf, OutData%WaveDir) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveMultiDir + call RegUnpack(Buf, OutData%WaveMultiDir) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDOmega + call RegUnpack(Buf, OutData%WaveDOmega) + if (RegCheckErr(Buf, RoutineName)) return + ! MCFD + call RegUnpack(Buf, OutData%MCFD) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveField + if (associated(OutData%WaveField)) deallocate(OutData%WaveField) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveField) + else + allocate(OutData%WaveField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveField) + call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(Buf, OutData%WaveField) ! WaveField + end if + else + OutData%WaveField => null() + end if +end subroutine SUBROUTINE HydroDyn_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(HydroDyn_InitOutputType), INTENT(IN) :: SrcInitOutputData TYPE(HydroDyn_InitOutputType), INTENT(INOUT) :: DstInitOutputData @@ -2407,556 +1537,187 @@ SUBROUTINE HydroDyn_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE HydroDyn_DestroyInitOutput - SUBROUTINE HydroDyn_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(HydroDyn_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Morison: size of buffers for each call to pack subtype - CALL Morison_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, .TRUE. ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Morison - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Morison - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Morison - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputHdr allocated yes/no - IF ( ALLOCATED(InData%WriteOutputHdr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdr upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdr)*LEN(InData%WriteOutputHdr) ! WriteOutputHdr - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputUnt allocated yes/no - IF ( ALLOCATED(InData%WriteOutputUnt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUnt upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUnt)*LEN(InData%WriteOutputUnt) ! WriteOutputUnt - END IF - Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_y allocated yes/no - IF ( ALLOCATED(InData%LinNames_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_y)*LEN(InData%LinNames_y) ! LinNames_y - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_x allocated yes/no - IF ( ALLOCATED(InData%LinNames_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_x)*LEN(InData%LinNames_x) ! LinNames_x - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_u allocated yes/no - IF ( ALLOCATED(InData%LinNames_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_u)*LEN(InData%LinNames_u) ! LinNames_u - END IF - Int_BufSz = Int_BufSz + 1 ! DerivOrder_x allocated yes/no - IF ( ALLOCATED(InData%DerivOrder_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DerivOrder_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%DerivOrder_x) ! DerivOrder_x - END IF - Int_BufSz = Int_BufSz + 1 ! IsLoad_u allocated yes/no - IF ( ALLOCATED(InData%IsLoad_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IsLoad_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IsLoad_u) ! IsLoad_u - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL Morison_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, OnlySize ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%WriteOutputHdr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) - DO I = 1, LEN(InData%WriteOutputHdr) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputUnt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) - DO I = 1, LEN(InData%WriteOutputUnt) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%LinNames_y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) - DO I = 1, LEN(InData%LinNames_y) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_y(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinNames_x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_x,1), UBOUND(InData%LinNames_x,1) - DO I = 1, LEN(InData%LinNames_x) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_x(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinNames_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) - DO I = 1, LEN(InData%LinNames_u) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_u(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DerivOrder_x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DerivOrder_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DerivOrder_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DerivOrder_x,1), UBOUND(InData%DerivOrder_x,1) - IntKiBuf(Int_Xferred) = InData%DerivOrder_x(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IsLoad_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IsLoad_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE HydroDyn_PackInitOutput - - SUBROUTINE HydroDyn_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(HydroDyn_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Morison_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Morison, ErrStat2, ErrMsg2 ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputHdr)) DEALLOCATE(OutData%WriteOutputHdr) - ALLOCATE(OutData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) - DO I = 1, LEN(OutData%WriteOutputHdr) - OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputUnt)) DEALLOCATE(OutData%WriteOutputUnt) - ALLOCATE(OutData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) - DO I = 1, LEN(OutData%WriteOutputUnt) - OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LinNames_y)) DEALLOCATE(OutData%LinNames_y) - ALLOCATE(OutData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) - DO I = 1, LEN(OutData%LinNames_y) - OutData%LinNames_y(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LinNames_x)) DEALLOCATE(OutData%LinNames_x) - ALLOCATE(OutData%LinNames_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_x,1), UBOUND(OutData%LinNames_x,1) - DO I = 1, LEN(OutData%LinNames_x) - OutData%LinNames_x(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LinNames_u)) DEALLOCATE(OutData%LinNames_u) - ALLOCATE(OutData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) - DO I = 1, LEN(OutData%LinNames_u) - OutData%LinNames_u(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DerivOrder_x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DerivOrder_x)) DEALLOCATE(OutData%DerivOrder_x) - ALLOCATE(OutData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DerivOrder_x,1), UBOUND(OutData%DerivOrder_x,1) - OutData%DerivOrder_x(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IsLoad_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IsLoad_u)) DEALLOCATE(OutData%IsLoad_u) - ALLOCATE(OutData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) - OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE HydroDyn_UnPackInitOutput +subroutine HydroDyn_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'HydroDyn_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! Morison + call Morison_PackInitOutput(Buf, InData%Morison) + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutputHdr + call RegPack(Buf, allocated(InData%WriteOutputHdr)) + if (allocated(InData%WriteOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPack(Buf, InData%WriteOutputHdr) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutputUnt + call RegPack(Buf, allocated(InData%WriteOutputUnt)) + if (allocated(InData%WriteOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPack(Buf, InData%WriteOutputUnt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Ver + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + if (RegCheckErr(Buf, RoutineName)) return + ! LinNames_y + call RegPack(Buf, allocated(InData%LinNames_y)) + if (allocated(InData%LinNames_y)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) + call RegPack(Buf, InData%LinNames_y) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LinNames_x + call RegPack(Buf, allocated(InData%LinNames_x)) + if (allocated(InData%LinNames_x)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_x), ubound(InData%LinNames_x)) + call RegPack(Buf, InData%LinNames_x) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LinNames_u + call RegPack(Buf, allocated(InData%LinNames_u)) + if (allocated(InData%LinNames_u)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) + call RegPack(Buf, InData%LinNames_u) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DerivOrder_x + call RegPack(Buf, allocated(InData%DerivOrder_x)) + if (allocated(InData%DerivOrder_x)) then + call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x), ubound(InData%DerivOrder_x)) + call RegPack(Buf, InData%DerivOrder_x) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! IsLoad_u + call RegPack(Buf, allocated(InData%IsLoad_u)) + if (allocated(InData%IsLoad_u)) then + call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) + call RegPack(Buf, InData%IsLoad_u) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine HydroDyn_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'HydroDyn_UnPackInitOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! Morison + call Morison_UnpackInitOutput(Buf, OutData%Morison) ! Morison + ! WriteOutputHdr + if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WriteOutputUnt + if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Ver + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + ! LinNames_y + if (allocated(OutData%LinNames_y)) deallocate(OutData%LinNames_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LinNames_x + if (allocated(OutData%LinNames_x)) deallocate(OutData%LinNames_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LinNames_u + if (allocated(OutData%LinNames_u)) deallocate(OutData%LinNames_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! DerivOrder_x + if (allocated(OutData%DerivOrder_x)) deallocate(OutData%DerivOrder_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DerivOrder_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DerivOrder_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! IsLoad_u + if (allocated(OutData%IsLoad_u)) deallocate(OutData%IsLoad_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IsLoad_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IsLoad_u) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE HydroDyn_CopyHD_ModuleMapType( SrcHD_ModuleMapTypeData, DstHD_ModuleMapTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(HD_ModuleMapType), INTENT(INOUT) :: SrcHD_ModuleMapTypeData TYPE(HD_ModuleMapType), INTENT(INOUT) :: DstHD_ModuleMapTypeData @@ -3003,354 +1764,35 @@ SUBROUTINE HydroDyn_DestroyHD_ModuleMapType( HD_ModuleMapTypeData, ErrStat, ErrM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE HydroDyn_DestroyHD_ModuleMapType - SUBROUTINE HydroDyn_PackHD_ModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(HD_ModuleMapType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_PackHD_ModuleMapType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! uW_P_2_PRP_P: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%uW_P_2_PRP_P, ErrStat2, ErrMsg2, .TRUE. ) ! uW_P_2_PRP_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! uW_P_2_PRP_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! uW_P_2_PRP_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! uW_P_2_PRP_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! W_P_2_PRP_P: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%W_P_2_PRP_P, ErrStat2, ErrMsg2, .TRUE. ) ! W_P_2_PRP_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! W_P_2_PRP_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! W_P_2_PRP_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! W_P_2_PRP_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! M_P_2_PRP_P: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%M_P_2_PRP_P, ErrStat2, ErrMsg2, .TRUE. ) ! M_P_2_PRP_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! M_P_2_PRP_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! M_P_2_PRP_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! M_P_2_PRP_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%uW_P_2_PRP_P, ErrStat2, ErrMsg2, OnlySize ) ! uW_P_2_PRP_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%W_P_2_PRP_P, ErrStat2, ErrMsg2, OnlySize ) ! W_P_2_PRP_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%M_P_2_PRP_P, ErrStat2, ErrMsg2, OnlySize ) ! M_P_2_PRP_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE HydroDyn_PackHD_ModuleMapType - - SUBROUTINE HydroDyn_UnPackHD_ModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(HD_ModuleMapType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_UnPackHD_ModuleMapType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%uW_P_2_PRP_P, ErrStat2, ErrMsg2 ) ! uW_P_2_PRP_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%W_P_2_PRP_P, ErrStat2, ErrMsg2 ) ! W_P_2_PRP_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%M_P_2_PRP_P, ErrStat2, ErrMsg2 ) ! M_P_2_PRP_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE HydroDyn_UnPackHD_ModuleMapType +subroutine HydroDyn_PackHD_ModuleMapType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(HD_ModuleMapType), intent(in) :: InData + character(*), parameter :: RoutineName = 'HydroDyn_PackHD_ModuleMapType' + if (Buf%ErrStat >= AbortErrLev) return + ! uW_P_2_PRP_P + call NWTC_Library_PackMeshMapType(Buf, InData%uW_P_2_PRP_P) + if (RegCheckErr(Buf, RoutineName)) return + ! W_P_2_PRP_P + call NWTC_Library_PackMeshMapType(Buf, InData%W_P_2_PRP_P) + if (RegCheckErr(Buf, RoutineName)) return + ! M_P_2_PRP_P + call NWTC_Library_PackMeshMapType(Buf, InData%M_P_2_PRP_P) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine HydroDyn_UnPackHD_ModuleMapType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(HD_ModuleMapType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'HydroDyn_UnPackHD_ModuleMapType' + if (Buf%ErrStat /= ErrID_None) return + ! uW_P_2_PRP_P + call NWTC_Library_UnpackMeshMapType(Buf, OutData%uW_P_2_PRP_P) ! uW_P_2_PRP_P + ! W_P_2_PRP_P + call NWTC_Library_UnpackMeshMapType(Buf, OutData%W_P_2_PRP_P) ! W_P_2_PRP_P + ! M_P_2_PRP_P + call NWTC_Library_UnpackMeshMapType(Buf, OutData%M_P_2_PRP_P) ! M_P_2_PRP_P +end subroutine SUBROUTINE HydroDyn_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(HydroDyn_ContinuousStateType), INTENT(IN) :: SrcContStateData TYPE(HydroDyn_ContinuousStateType), INTENT(INOUT) :: DstContStateData @@ -3411,305 +1853,58 @@ SUBROUTINE HydroDyn_DestroyContState( ContStateData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE HydroDyn_DestroyContState - SUBROUTINE HydroDyn_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(HydroDyn_ContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_PackContState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! WAMIT allocated yes/no - IF ( ALLOCATED(InData%WAMIT) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WAMIT upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%WAMIT,1), UBOUND(InData%WAMIT,1) - Int_BufSz = Int_BufSz + 3 ! WAMIT: size of buffers for each call to pack subtype - CALL WAMIT_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT(i1), ErrStat2, ErrMsg2, .TRUE. ) ! WAMIT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMIT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMIT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMIT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! Morison: size of buffers for each call to pack subtype - CALL Morison_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, .TRUE. ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Morison - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Morison - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Morison - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%WAMIT) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WAMIT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAMIT,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WAMIT,1), UBOUND(InData%WAMIT,1) - CALL WAMIT_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT(i1), ErrStat2, ErrMsg2, OnlySize ) ! WAMIT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL Morison_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, OnlySize ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE HydroDyn_PackContState - - SUBROUTINE HydroDyn_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(HydroDyn_ContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_UnPackContState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WAMIT not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WAMIT)) DEALLOCATE(OutData%WAMIT) - ALLOCATE(OutData%WAMIT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WAMIT,1), UBOUND(OutData%WAMIT,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL WAMIT_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%WAMIT(i1), ErrStat2, ErrMsg2 ) ! WAMIT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Morison_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%Morison, ErrStat2, ErrMsg2 ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE HydroDyn_UnPackContState +subroutine HydroDyn_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'HydroDyn_PackContState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! WAMIT + call RegPack(Buf, allocated(InData%WAMIT)) + if (allocated(InData%WAMIT)) then + call RegPackBounds(Buf, 1, lbound(InData%WAMIT), ubound(InData%WAMIT)) + LB(1:1) = lbound(InData%WAMIT) + UB(1:1) = ubound(InData%WAMIT) + do i1 = LB(1), UB(1) + call WAMIT_PackContState(Buf, InData%WAMIT(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Morison + call Morison_PackContState(Buf, InData%Morison) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine HydroDyn_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'HydroDyn_UnPackContState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! WAMIT + if (allocated(OutData%WAMIT)) deallocate(OutData%WAMIT) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WAMIT(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call WAMIT_UnpackContState(Buf, OutData%WAMIT(i1)) ! WAMIT + end do + end if + ! Morison + call Morison_UnpackContState(Buf, OutData%Morison) ! Morison +end subroutine SUBROUTINE HydroDyn_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(HydroDyn_DiscreteStateType), INTENT(IN) :: SrcDiscStateData TYPE(HydroDyn_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData @@ -3770,305 +1965,58 @@ SUBROUTINE HydroDyn_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE HydroDyn_DestroyDiscState - SUBROUTINE HydroDyn_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(HydroDyn_DiscreteStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_PackDiscState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! WAMIT allocated yes/no - IF ( ALLOCATED(InData%WAMIT) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WAMIT upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%WAMIT,1), UBOUND(InData%WAMIT,1) - Int_BufSz = Int_BufSz + 3 ! WAMIT: size of buffers for each call to pack subtype - CALL WAMIT_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT(i1), ErrStat2, ErrMsg2, .TRUE. ) ! WAMIT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMIT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMIT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMIT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! Morison: size of buffers for each call to pack subtype - CALL Morison_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, .TRUE. ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Morison - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Morison - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Morison - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%WAMIT) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WAMIT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAMIT,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WAMIT,1), UBOUND(InData%WAMIT,1) - CALL WAMIT_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT(i1), ErrStat2, ErrMsg2, OnlySize ) ! WAMIT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL Morison_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, OnlySize ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE HydroDyn_PackDiscState - - SUBROUTINE HydroDyn_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(HydroDyn_DiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_UnPackDiscState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WAMIT not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WAMIT)) DEALLOCATE(OutData%WAMIT) - ALLOCATE(OutData%WAMIT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WAMIT,1), UBOUND(OutData%WAMIT,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL WAMIT_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%WAMIT(i1), ErrStat2, ErrMsg2 ) ! WAMIT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Morison_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%Morison, ErrStat2, ErrMsg2 ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE HydroDyn_UnPackDiscState +subroutine HydroDyn_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'HydroDyn_PackDiscState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! WAMIT + call RegPack(Buf, allocated(InData%WAMIT)) + if (allocated(InData%WAMIT)) then + call RegPackBounds(Buf, 1, lbound(InData%WAMIT), ubound(InData%WAMIT)) + LB(1:1) = lbound(InData%WAMIT) + UB(1:1) = ubound(InData%WAMIT) + do i1 = LB(1), UB(1) + call WAMIT_PackDiscState(Buf, InData%WAMIT(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Morison + call Morison_PackDiscState(Buf, InData%Morison) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine HydroDyn_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'HydroDyn_UnPackDiscState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! WAMIT + if (allocated(OutData%WAMIT)) deallocate(OutData%WAMIT) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WAMIT(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call WAMIT_UnpackDiscState(Buf, OutData%WAMIT(i1)) ! WAMIT + end do + end if + ! Morison + call Morison_UnpackDiscState(Buf, OutData%Morison) ! Morison +end subroutine SUBROUTINE HydroDyn_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(HydroDyn_ConstraintStateType), INTENT(IN) :: SrcConstrStateData TYPE(HydroDyn_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData @@ -4110,269 +2058,30 @@ SUBROUTINE HydroDyn_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE HydroDyn_DestroyConstrState - SUBROUTINE HydroDyn_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(HydroDyn_ConstraintStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_PackConstrState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! WAMIT: size of buffers for each call to pack subtype - CALL WAMIT_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT, ErrStat2, ErrMsg2, .TRUE. ) ! WAMIT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMIT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMIT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMIT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Morison: size of buffers for each call to pack subtype - CALL Morison_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, .TRUE. ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Morison - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Morison - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Morison - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL WAMIT_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT, ErrStat2, ErrMsg2, OnlySize ) ! WAMIT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL Morison_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, OnlySize ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE HydroDyn_PackConstrState - - SUBROUTINE HydroDyn_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(HydroDyn_ConstraintStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_UnPackConstrState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL WAMIT_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%WAMIT, ErrStat2, ErrMsg2 ) ! WAMIT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Morison_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%Morison, ErrStat2, ErrMsg2 ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE HydroDyn_UnPackConstrState +subroutine HydroDyn_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'HydroDyn_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + ! WAMIT + call WAMIT_PackConstrState(Buf, InData%WAMIT) + if (RegCheckErr(Buf, RoutineName)) return + ! Morison + call Morison_PackConstrState(Buf, InData%Morison) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine HydroDyn_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'HydroDyn_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + ! WAMIT + call WAMIT_UnpackConstrState(Buf, OutData%WAMIT) ! WAMIT + ! Morison + call Morison_UnpackConstrState(Buf, OutData%Morison) ! Morison +end subroutine SUBROUTINE HydroDyn_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(HydroDyn_OtherStateType), INTENT(IN) :: SrcOtherStateData TYPE(HydroDyn_OtherStateType), INTENT(INOUT) :: DstOtherStateData @@ -4433,305 +2142,58 @@ SUBROUTINE HydroDyn_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE HydroDyn_DestroyOtherState - SUBROUTINE HydroDyn_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(HydroDyn_OtherStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_PackOtherState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! WAMIT allocated yes/no - IF ( ALLOCATED(InData%WAMIT) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WAMIT upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%WAMIT,1), UBOUND(InData%WAMIT,1) - Int_BufSz = Int_BufSz + 3 ! WAMIT: size of buffers for each call to pack subtype - CALL WAMIT_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT(i1), ErrStat2, ErrMsg2, .TRUE. ) ! WAMIT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMIT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMIT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMIT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! Morison: size of buffers for each call to pack subtype - CALL Morison_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, .TRUE. ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Morison - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Morison - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Morison - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%WAMIT) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WAMIT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAMIT,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WAMIT,1), UBOUND(InData%WAMIT,1) - CALL WAMIT_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT(i1), ErrStat2, ErrMsg2, OnlySize ) ! WAMIT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL Morison_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, OnlySize ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE HydroDyn_PackOtherState - - SUBROUTINE HydroDyn_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(HydroDyn_OtherStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_UnPackOtherState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WAMIT not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WAMIT)) DEALLOCATE(OutData%WAMIT) - ALLOCATE(OutData%WAMIT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WAMIT,1), UBOUND(OutData%WAMIT,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL WAMIT_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%WAMIT(i1), ErrStat2, ErrMsg2 ) ! WAMIT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Morison_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%Morison, ErrStat2, ErrMsg2 ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE HydroDyn_UnPackOtherState +subroutine HydroDyn_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'HydroDyn_PackOtherState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! WAMIT + call RegPack(Buf, allocated(InData%WAMIT)) + if (allocated(InData%WAMIT)) then + call RegPackBounds(Buf, 1, lbound(InData%WAMIT), ubound(InData%WAMIT)) + LB(1:1) = lbound(InData%WAMIT) + UB(1:1) = ubound(InData%WAMIT) + do i1 = LB(1), UB(1) + call WAMIT_PackOtherState(Buf, InData%WAMIT(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Morison + call Morison_PackOtherState(Buf, InData%Morison) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine HydroDyn_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'HydroDyn_UnPackOtherState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! WAMIT + if (allocated(OutData%WAMIT)) deallocate(OutData%WAMIT) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WAMIT(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call WAMIT_UnpackOtherState(Buf, OutData%WAMIT(i1)) ! WAMIT + end do + end if + ! Morison + call Morison_UnpackOtherState(Buf, OutData%Morison) ! Morison +end subroutine SUBROUTINE HydroDyn_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) TYPE(HydroDyn_MiscVarType), INTENT(INOUT) :: SrcMiscData TYPE(HydroDyn_MiscVarType), INTENT(INOUT) :: DstMiscData @@ -4882,817 +2344,190 @@ SUBROUTINE HydroDyn_DestroyMisc( MiscData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE HydroDyn_DestroyMisc - SUBROUTINE HydroDyn_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(HydroDyn_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! AllHdroOrigin: size of buffers for each call to pack subtype - CALL MeshPack( InData%AllHdroOrigin, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! AllHdroOrigin - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AllHdroOrigin - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AllHdroOrigin - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AllHdroOrigin - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! HD_MeshMap: size of buffers for each call to pack subtype - CALL HydroDyn_PackHD_ModuleMapType( Re_Buf, Db_Buf, Int_Buf, InData%HD_MeshMap, ErrStat2, ErrMsg2, .TRUE. ) ! HD_MeshMap - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! HD_MeshMap - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! HD_MeshMap - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! HD_MeshMap - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Decimate - Db_BufSz = Db_BufSz + 1 ! LastOutTime - Int_BufSz = Int_BufSz + 1 ! LastIndWave - Int_BufSz = Int_BufSz + 1 ! F_PtfmAdd allocated yes/no - IF ( ALLOCATED(InData%F_PtfmAdd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! F_PtfmAdd upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_PtfmAdd) ! F_PtfmAdd - END IF - Re_BufSz = Re_BufSz + SIZE(InData%F_Hydro) ! F_Hydro - Int_BufSz = Int_BufSz + 1 ! F_Waves allocated yes/no - IF ( ALLOCATED(InData%F_Waves) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! F_Waves upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_Waves) ! F_Waves - END IF - Int_BufSz = Int_BufSz + 1 ! WAMIT allocated yes/no - IF ( ALLOCATED(InData%WAMIT) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WAMIT upper/lower bounds for each dimension - DO i1 = LBOUND(InData%WAMIT,1), UBOUND(InData%WAMIT,1) - Int_BufSz = Int_BufSz + 3 ! WAMIT: size of buffers for each call to pack subtype - CALL WAMIT_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT(i1), ErrStat2, ErrMsg2, .TRUE. ) ! WAMIT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMIT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMIT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMIT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! WAMIT2 allocated yes/no - IF ( ALLOCATED(InData%WAMIT2) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WAMIT2 upper/lower bounds for each dimension - DO i1 = LBOUND(InData%WAMIT2,1), UBOUND(InData%WAMIT2,1) - Int_BufSz = Int_BufSz + 3 ! WAMIT2: size of buffers for each call to pack subtype - CALL WAMIT2_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT2(i1), ErrStat2, ErrMsg2, .TRUE. ) ! WAMIT2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMIT2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMIT2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMIT2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! Morison: size of buffers for each call to pack subtype - CALL Morison_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, .TRUE. ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Morison - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Morison - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Morison - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! u_WAMIT allocated yes/no - IF ( ALLOCATED(InData%u_WAMIT) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_WAMIT upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_WAMIT,1), UBOUND(InData%u_WAMIT,1) - Int_BufSz = Int_BufSz + 3 ! u_WAMIT: size of buffers for each call to pack subtype - CALL WAMIT_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_WAMIT(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_WAMIT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_WAMIT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_WAMIT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_WAMIT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL MeshPack( InData%AllHdroOrigin, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! AllHdroOrigin - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL HydroDyn_PackHD_ModuleMapType( Re_Buf, Db_Buf, Int_Buf, InData%HD_MeshMap, ErrStat2, ErrMsg2, OnlySize ) ! HD_MeshMap - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = InData%Decimate - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%LastOutTime - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%LastIndWave - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%F_PtfmAdd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_PtfmAdd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_PtfmAdd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%F_PtfmAdd,1), UBOUND(InData%F_PtfmAdd,1) - ReKiBuf(Re_Xferred) = InData%F_PtfmAdd(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DO i1 = LBOUND(InData%F_Hydro,1), UBOUND(InData%F_Hydro,1) - ReKiBuf(Re_Xferred) = InData%F_Hydro(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%F_Waves) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_Waves,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_Waves,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%F_Waves,1), UBOUND(InData%F_Waves,1) - ReKiBuf(Re_Xferred) = InData%F_Waves(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WAMIT) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WAMIT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAMIT,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WAMIT,1), UBOUND(InData%WAMIT,1) - CALL WAMIT_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT(i1), ErrStat2, ErrMsg2, OnlySize ) ! WAMIT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WAMIT2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WAMIT2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAMIT2,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WAMIT2,1), UBOUND(InData%WAMIT2,1) - CALL WAMIT2_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT2(i1), ErrStat2, ErrMsg2, OnlySize ) ! WAMIT2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL Morison_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, OnlySize ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%u_WAMIT) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_WAMIT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_WAMIT,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_WAMIT,1), UBOUND(InData%u_WAMIT,1) - CALL WAMIT_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_WAMIT(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_WAMIT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - END SUBROUTINE HydroDyn_PackMisc - - SUBROUTINE HydroDyn_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(HydroDyn_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%AllHdroOrigin, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! AllHdroOrigin - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL HydroDyn_UnpackHD_ModuleMapType( Re_Buf, Db_Buf, Int_Buf, OutData%HD_MeshMap, ErrStat2, ErrMsg2 ) ! HD_MeshMap - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%Decimate = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%LastOutTime = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%LastIndWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_PtfmAdd not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_PtfmAdd)) DEALLOCATE(OutData%F_PtfmAdd) - ALLOCATE(OutData%F_PtfmAdd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_PtfmAdd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%F_PtfmAdd,1), UBOUND(OutData%F_PtfmAdd,1) - OutData%F_PtfmAdd(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - i1_l = LBOUND(OutData%F_Hydro,1) - i1_u = UBOUND(OutData%F_Hydro,1) - DO i1 = LBOUND(OutData%F_Hydro,1), UBOUND(OutData%F_Hydro,1) - OutData%F_Hydro(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_Waves not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_Waves)) DEALLOCATE(OutData%F_Waves) - ALLOCATE(OutData%F_Waves(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_Waves.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%F_Waves,1), UBOUND(OutData%F_Waves,1) - OutData%F_Waves(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WAMIT not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WAMIT)) DEALLOCATE(OutData%WAMIT) - ALLOCATE(OutData%WAMIT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WAMIT,1), UBOUND(OutData%WAMIT,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL WAMIT_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%WAMIT(i1), ErrStat2, ErrMsg2 ) ! WAMIT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WAMIT2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WAMIT2)) DEALLOCATE(OutData%WAMIT2) - ALLOCATE(OutData%WAMIT2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WAMIT2,1), UBOUND(OutData%WAMIT2,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL WAMIT2_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%WAMIT2(i1), ErrStat2, ErrMsg2 ) ! WAMIT2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Morison_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%Morison, ErrStat2, ErrMsg2 ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_WAMIT not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%u_WAMIT)) DEALLOCATE(OutData%u_WAMIT) - ALLOCATE(OutData%u_WAMIT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_WAMIT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_WAMIT,1), UBOUND(OutData%u_WAMIT,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL WAMIT_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_WAMIT(i1), ErrStat2, ErrMsg2 ) ! u_WAMIT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - END SUBROUTINE HydroDyn_UnPackMisc +subroutine HydroDyn_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'HydroDyn_PackMisc' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! AllHdroOrigin + call MeshPack(Buf, InData%AllHdroOrigin) + if (RegCheckErr(Buf, RoutineName)) return + ! HD_MeshMap + call HydroDyn_PackHD_ModuleMapType(Buf, InData%HD_MeshMap) + if (RegCheckErr(Buf, RoutineName)) return + ! Decimate + call RegPack(Buf, InData%Decimate) + if (RegCheckErr(Buf, RoutineName)) return + ! LastOutTime + call RegPack(Buf, InData%LastOutTime) + if (RegCheckErr(Buf, RoutineName)) return + ! LastIndWave + call RegPack(Buf, InData%LastIndWave) + if (RegCheckErr(Buf, RoutineName)) return + ! F_PtfmAdd + call RegPack(Buf, allocated(InData%F_PtfmAdd)) + if (allocated(InData%F_PtfmAdd)) then + call RegPackBounds(Buf, 1, lbound(InData%F_PtfmAdd), ubound(InData%F_PtfmAdd)) + call RegPack(Buf, InData%F_PtfmAdd) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! F_Hydro + call RegPack(Buf, InData%F_Hydro) + if (RegCheckErr(Buf, RoutineName)) return + ! F_Waves + call RegPack(Buf, allocated(InData%F_Waves)) + if (allocated(InData%F_Waves)) then + call RegPackBounds(Buf, 1, lbound(InData%F_Waves), ubound(InData%F_Waves)) + call RegPack(Buf, InData%F_Waves) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WAMIT + call RegPack(Buf, allocated(InData%WAMIT)) + if (allocated(InData%WAMIT)) then + call RegPackBounds(Buf, 1, lbound(InData%WAMIT), ubound(InData%WAMIT)) + LB(1:1) = lbound(InData%WAMIT) + UB(1:1) = ubound(InData%WAMIT) + do i1 = LB(1), UB(1) + call WAMIT_PackMisc(Buf, InData%WAMIT(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WAMIT2 + call RegPack(Buf, allocated(InData%WAMIT2)) + if (allocated(InData%WAMIT2)) then + call RegPackBounds(Buf, 1, lbound(InData%WAMIT2), ubound(InData%WAMIT2)) + LB(1:1) = lbound(InData%WAMIT2) + UB(1:1) = ubound(InData%WAMIT2) + do i1 = LB(1), UB(1) + call WAMIT2_PackMisc(Buf, InData%WAMIT2(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Morison + call Morison_PackMisc(Buf, InData%Morison) + if (RegCheckErr(Buf, RoutineName)) return + ! u_WAMIT + call RegPack(Buf, allocated(InData%u_WAMIT)) + if (allocated(InData%u_WAMIT)) then + call RegPackBounds(Buf, 1, lbound(InData%u_WAMIT), ubound(InData%u_WAMIT)) + LB(1:1) = lbound(InData%u_WAMIT) + UB(1:1) = ubound(InData%u_WAMIT) + do i1 = LB(1), UB(1) + call WAMIT_PackInput(Buf, InData%u_WAMIT(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine HydroDyn_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'HydroDyn_UnPackMisc' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! AllHdroOrigin + call MeshUnpack(Buf, OutData%AllHdroOrigin) ! AllHdroOrigin + ! HD_MeshMap + call HydroDyn_UnpackHD_ModuleMapType(Buf, OutData%HD_MeshMap) ! HD_MeshMap + ! Decimate + call RegUnpack(Buf, OutData%Decimate) + if (RegCheckErr(Buf, RoutineName)) return + ! LastOutTime + call RegUnpack(Buf, OutData%LastOutTime) + if (RegCheckErr(Buf, RoutineName)) return + ! LastIndWave + call RegUnpack(Buf, OutData%LastIndWave) + if (RegCheckErr(Buf, RoutineName)) return + ! F_PtfmAdd + if (allocated(OutData%F_PtfmAdd)) deallocate(OutData%F_PtfmAdd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_PtfmAdd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_PtfmAdd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_PtfmAdd) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! F_Hydro + call RegUnpack(Buf, OutData%F_Hydro) + if (RegCheckErr(Buf, RoutineName)) return + ! F_Waves + if (allocated(OutData%F_Waves)) deallocate(OutData%F_Waves) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_Waves(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_Waves.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_Waves) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WAMIT + if (allocated(OutData%WAMIT)) deallocate(OutData%WAMIT) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WAMIT(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call WAMIT_UnpackMisc(Buf, OutData%WAMIT(i1)) ! WAMIT + end do + end if + ! WAMIT2 + if (allocated(OutData%WAMIT2)) deallocate(OutData%WAMIT2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WAMIT2(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call WAMIT2_UnpackMisc(Buf, OutData%WAMIT2(i1)) ! WAMIT2 + end do + end if + ! Morison + call Morison_UnpackMisc(Buf, OutData%Morison) ! Morison + ! u_WAMIT + if (allocated(OutData%u_WAMIT)) deallocate(OutData%u_WAMIT) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_WAMIT(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_WAMIT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call WAMIT_UnpackInput(Buf, OutData%u_WAMIT(i1)) ! u_WAMIT + end do + end if +end subroutine SUBROUTINE HydroDyn_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(HydroDyn_ParameterType), INTENT(IN) :: SrcParamData TYPE(HydroDyn_ParameterType), INTENT(INOUT) :: DstParamData @@ -5946,1016 +2781,436 @@ SUBROUTINE HydroDyn_DestroyParam( ParamData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE HydroDyn_DestroyParam - SUBROUTINE HydroDyn_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(HydroDyn_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! nWAMITObj - Int_BufSz = Int_BufSz + 1 ! vecMultiplier - Int_BufSz = Int_BufSz + 1 ! WAMIT allocated yes/no - IF ( ALLOCATED(InData%WAMIT) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WAMIT upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%WAMIT,1), UBOUND(InData%WAMIT,1) - Int_BufSz = Int_BufSz + 3 ! WAMIT: size of buffers for each call to pack subtype - CALL WAMIT_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT(i1), ErrStat2, ErrMsg2, .TRUE. ) ! WAMIT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMIT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMIT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMIT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! WAMIT2 allocated yes/no - IF ( ALLOCATED(InData%WAMIT2) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WAMIT2 upper/lower bounds for each dimension - DO i1 = LBOUND(InData%WAMIT2,1), UBOUND(InData%WAMIT2,1) - Int_BufSz = Int_BufSz + 3 ! WAMIT2: size of buffers for each call to pack subtype - CALL WAMIT2_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT2(i1), ErrStat2, ErrMsg2, .TRUE. ) ! WAMIT2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMIT2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMIT2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMIT2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! WAMIT2used - Int_BufSz = Int_BufSz + 3 ! Morison: size of buffers for each call to pack subtype - CALL Morison_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, .TRUE. ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Morison - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Morison - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Morison - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! PotMod - Int_BufSz = Int_BufSz + 1 ! NBody - Int_BufSz = Int_BufSz + 1 ! NBodyMod - Int_BufSz = Int_BufSz + 1 ! totalStates - Int_BufSz = Int_BufSz + 1 ! totalExctnStates - Int_BufSz = Int_BufSz + 1 ! totalRdtnStates - Int_BufSz = Int_BufSz + 1 ! NStepWave - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Int_BufSz = Int_BufSz + 1 ! AddF0 allocated yes/no - IF ( ALLOCATED(InData%AddF0) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AddF0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AddF0) ! AddF0 - END IF - Int_BufSz = Int_BufSz + 1 ! AddCLin allocated yes/no - IF ( ALLOCATED(InData%AddCLin) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AddCLin upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AddCLin) ! AddCLin - END IF - Int_BufSz = Int_BufSz + 1 ! AddBLin allocated yes/no - IF ( ALLOCATED(InData%AddBLin) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AddBLin upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AddBLin) ! AddBLin - END IF - Int_BufSz = Int_BufSz + 1 ! AddBQuad allocated yes/no - IF ( ALLOCATED(InData%AddBQuad) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AddBQuad upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AddBQuad) ! AddBQuad - END IF - Db_BufSz = Db_BufSz + 1 ! DT - Int_BufSz = Int_BufSz + 1 ! OutParam allocated yes/no - IF ( ALLOCATED(InData%OutParam) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutParam upper/lower bounds for each dimension - DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - Int_BufSz = Int_BufSz + 3 ! OutParam: size of buffers for each call to pack subtype - CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutParam - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutParam - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutParam - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! NumTotalOuts - Int_BufSz = Int_BufSz + 1 ! OutSwtch - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt - Int_BufSz = Int_BufSz + 1*LEN(InData%OutSFmt) ! OutSFmt - Int_BufSz = Int_BufSz + 1*LEN(InData%Delim) ! Delim - Int_BufSz = Int_BufSz + 1 ! UnOutFile - Int_BufSz = Int_BufSz + 1 ! OutDec - Int_BufSz = Int_BufSz + 1 ! Jac_u_indx allocated yes/no - IF ( ALLOCATED(InData%Jac_u_indx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_u_indx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_u_indx) ! Jac_u_indx - END IF - Int_BufSz = Int_BufSz + 1 ! du allocated yes/no - IF ( ALLOCATED(InData%du) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! du upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%du) ! du - END IF - Int_BufSz = Int_BufSz + 1 ! dx allocated yes/no - IF ( ALLOCATED(InData%dx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dx upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%dx) ! dx - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_ny - Int_BufSz = Int_BufSz + 1 ! PointsToSeaState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%nWAMITObj - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%vecMultiplier - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WAMIT) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WAMIT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAMIT,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WAMIT,1), UBOUND(InData%WAMIT,1) - CALL WAMIT_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT(i1), ErrStat2, ErrMsg2, OnlySize ) ! WAMIT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WAMIT2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WAMIT2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAMIT2,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WAMIT2,1), UBOUND(InData%WAMIT2,1) - CALL WAMIT2_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT2(i1), ErrStat2, ErrMsg2, OnlySize ) ! WAMIT2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%WAMIT2used, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - CALL Morison_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, OnlySize ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = InData%PotMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NBody - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NBodyMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%totalStates - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%totalExctnStates - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%totalRdtnStates - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%AddF0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddF0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddF0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddF0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddF0,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AddF0,2), UBOUND(InData%AddF0,2) - DO i1 = LBOUND(InData%AddF0,1), UBOUND(InData%AddF0,1) - ReKiBuf(Re_Xferred) = InData%AddF0(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AddCLin) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddCLin,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddCLin,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddCLin,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddCLin,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddCLin,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddCLin,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AddCLin,3), UBOUND(InData%AddCLin,3) - DO i2 = LBOUND(InData%AddCLin,2), UBOUND(InData%AddCLin,2) - DO i1 = LBOUND(InData%AddCLin,1), UBOUND(InData%AddCLin,1) - ReKiBuf(Re_Xferred) = InData%AddCLin(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AddBLin) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddBLin,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddBLin,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddBLin,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddBLin,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddBLin,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddBLin,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AddBLin,3), UBOUND(InData%AddBLin,3) - DO i2 = LBOUND(InData%AddBLin,2), UBOUND(InData%AddBLin,2) - DO i1 = LBOUND(InData%AddBLin,1), UBOUND(InData%AddBLin,1) - ReKiBuf(Re_Xferred) = InData%AddBLin(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AddBQuad) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddBQuad,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddBQuad,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddBQuad,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddBQuad,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AddBQuad,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AddBQuad,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AddBQuad,3), UBOUND(InData%AddBQuad,3) - DO i2 = LBOUND(InData%AddBQuad,2), UBOUND(InData%AddBQuad,2) - DO i1 = LBOUND(InData%AddBQuad,1), UBOUND(InData%AddBQuad,1) - ReKiBuf(Re_Xferred) = InData%AddBQuad(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutParam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParam,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumTotalOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%OutSwtch - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutSFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%UnOutFile - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%OutDec - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Jac_u_indx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_u_indx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_u_indx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jac_u_indx,2), UBOUND(InData%Jac_u_indx,2) - DO i1 = LBOUND(InData%Jac_u_indx,1), UBOUND(InData%Jac_u_indx,1) - IntKiBuf(Int_Xferred) = InData%Jac_u_indx(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%du) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%du,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%du,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%du,1), UBOUND(InData%du,1) - DbKiBuf(Db_Xferred) = InData%du(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dx,1), UBOUND(InData%dx,1) - DbKiBuf(Db_Xferred) = InData%dx(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%Jac_ny - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%PointsToSeaState, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE HydroDyn_PackParam - - SUBROUTINE HydroDyn_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(HydroDyn_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%nWAMITObj = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%vecMultiplier = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WAMIT not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WAMIT)) DEALLOCATE(OutData%WAMIT) - ALLOCATE(OutData%WAMIT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WAMIT,1), UBOUND(OutData%WAMIT,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL WAMIT_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%WAMIT(i1), ErrStat2, ErrMsg2 ) ! WAMIT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WAMIT2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WAMIT2)) DEALLOCATE(OutData%WAMIT2) - ALLOCATE(OutData%WAMIT2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WAMIT2,1), UBOUND(OutData%WAMIT2,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL WAMIT2_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%WAMIT2(i1), ErrStat2, ErrMsg2 ) ! WAMIT2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - OutData%WAMIT2used = TRANSFER(IntKiBuf(Int_Xferred), OutData%WAMIT2used) - Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Morison_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%Morison, ErrStat2, ErrMsg2 ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%PotMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NBody = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NBodyMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%totalStates = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%totalExctnStates = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%totalRdtnStates = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - NULLIFY(OutData%WaveTime) - OutData%NStepWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AddF0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AddF0)) DEALLOCATE(OutData%AddF0) - ALLOCATE(OutData%AddF0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AddF0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AddF0,2), UBOUND(OutData%AddF0,2) - DO i1 = LBOUND(OutData%AddF0,1), UBOUND(OutData%AddF0,1) - OutData%AddF0(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AddCLin not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AddCLin)) DEALLOCATE(OutData%AddCLin) - ALLOCATE(OutData%AddCLin(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AddCLin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AddCLin,3), UBOUND(OutData%AddCLin,3) - DO i2 = LBOUND(OutData%AddCLin,2), UBOUND(OutData%AddCLin,2) - DO i1 = LBOUND(OutData%AddCLin,1), UBOUND(OutData%AddCLin,1) - OutData%AddCLin(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AddBLin not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AddBLin)) DEALLOCATE(OutData%AddBLin) - ALLOCATE(OutData%AddBLin(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AddBLin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AddBLin,3), UBOUND(OutData%AddBLin,3) - DO i2 = LBOUND(OutData%AddBLin,2), UBOUND(OutData%AddBLin,2) - DO i1 = LBOUND(OutData%AddBLin,1), UBOUND(OutData%AddBLin,1) - OutData%AddBLin(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AddBQuad not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AddBQuad)) DEALLOCATE(OutData%AddBQuad) - ALLOCATE(OutData%AddBQuad(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AddBQuad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AddBQuad,3), UBOUND(OutData%AddBQuad,3) - DO i2 = LBOUND(OutData%AddBQuad,2), UBOUND(OutData%AddBQuad,2) - DO i1 = LBOUND(OutData%AddBQuad,1), UBOUND(OutData%AddBQuad,1) - OutData%AddBQuad(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutParam)) DEALLOCATE(OutData%OutParam) - ALLOCATE(OutData%OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutParam,1), UBOUND(OutData%OutParam,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackOutParmType( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumTotalOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%OutSwtch = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutSFmt) - OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UnOutFile = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%OutDec = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_u_indx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Jac_u_indx)) DEALLOCATE(OutData%Jac_u_indx) - ALLOCATE(OutData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_u_indx,2), UBOUND(OutData%Jac_u_indx,2) - DO i1 = LBOUND(OutData%Jac_u_indx,1), UBOUND(OutData%Jac_u_indx,1) - OutData%Jac_u_indx(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! du not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%du)) DEALLOCATE(OutData%du) - ALLOCATE(OutData%du(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%du,1), UBOUND(OutData%du,1) - OutData%du(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%dx)) DEALLOCATE(OutData%dx) - ALLOCATE(OutData%dx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dx,1), UBOUND(OutData%dx,1) - OutData%dx(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - OutData%Jac_ny = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%PointsToSeaState = TRANSFER(IntKiBuf(Int_Xferred), OutData%PointsToSeaState) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE HydroDyn_UnPackParam +subroutine HydroDyn_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'HydroDyn_PackParam' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + ! nWAMITObj + call RegPack(Buf, InData%nWAMITObj) + if (RegCheckErr(Buf, RoutineName)) return + ! vecMultiplier + call RegPack(Buf, InData%vecMultiplier) + if (RegCheckErr(Buf, RoutineName)) return + ! WAMIT + call RegPack(Buf, allocated(InData%WAMIT)) + if (allocated(InData%WAMIT)) then + call RegPackBounds(Buf, 1, lbound(InData%WAMIT), ubound(InData%WAMIT)) + LB(1:1) = lbound(InData%WAMIT) + UB(1:1) = ubound(InData%WAMIT) + do i1 = LB(1), UB(1) + call WAMIT_PackParam(Buf, InData%WAMIT(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WAMIT2 + call RegPack(Buf, allocated(InData%WAMIT2)) + if (allocated(InData%WAMIT2)) then + call RegPackBounds(Buf, 1, lbound(InData%WAMIT2), ubound(InData%WAMIT2)) + LB(1:1) = lbound(InData%WAMIT2) + UB(1:1) = ubound(InData%WAMIT2) + do i1 = LB(1), UB(1) + call WAMIT2_PackParam(Buf, InData%WAMIT2(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WAMIT2used + call RegPack(Buf, InData%WAMIT2used) + if (RegCheckErr(Buf, RoutineName)) return + ! Morison + call Morison_PackParam(Buf, InData%Morison) + if (RegCheckErr(Buf, RoutineName)) return + ! PotMod + call RegPack(Buf, InData%PotMod) + if (RegCheckErr(Buf, RoutineName)) return + ! NBody + call RegPack(Buf, InData%NBody) + if (RegCheckErr(Buf, RoutineName)) return + ! NBodyMod + call RegPack(Buf, InData%NBodyMod) + if (RegCheckErr(Buf, RoutineName)) return + ! totalStates + call RegPack(Buf, InData%totalStates) + if (RegCheckErr(Buf, RoutineName)) return + ! totalExctnStates + call RegPack(Buf, InData%totalExctnStates) + if (RegCheckErr(Buf, RoutineName)) return + ! totalRdtnStates + call RegPack(Buf, InData%totalRdtnStates) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveTime + call RegPack(Buf, associated(InData%WaveTime)) + if (associated(InData%WaveTime)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) + call RegPackPointer(Buf, c_loc(InData%WaveTime), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveTime) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NStepWave + call RegPack(Buf, InData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDpth + call RegPack(Buf, InData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! AddF0 + call RegPack(Buf, allocated(InData%AddF0)) + if (allocated(InData%AddF0)) then + call RegPackBounds(Buf, 2, lbound(InData%AddF0), ubound(InData%AddF0)) + call RegPack(Buf, InData%AddF0) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AddCLin + call RegPack(Buf, allocated(InData%AddCLin)) + if (allocated(InData%AddCLin)) then + call RegPackBounds(Buf, 3, lbound(InData%AddCLin), ubound(InData%AddCLin)) + call RegPack(Buf, InData%AddCLin) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AddBLin + call RegPack(Buf, allocated(InData%AddBLin)) + if (allocated(InData%AddBLin)) then + call RegPackBounds(Buf, 3, lbound(InData%AddBLin), ubound(InData%AddBLin)) + call RegPack(Buf, InData%AddBLin) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AddBQuad + call RegPack(Buf, allocated(InData%AddBQuad)) + if (allocated(InData%AddBQuad)) then + call RegPackBounds(Buf, 3, lbound(InData%AddBQuad), ubound(InData%AddBQuad)) + call RegPack(Buf, InData%AddBQuad) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DT + call RegPack(Buf, InData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! OutParam + call RegPack(Buf, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegPack(Buf, InData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! NumTotalOuts + call RegPack(Buf, InData%NumTotalOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! OutSwtch + call RegPack(Buf, InData%OutSwtch) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFmt + call RegPack(Buf, InData%OutFmt) + if (RegCheckErr(Buf, RoutineName)) return + ! OutSFmt + call RegPack(Buf, InData%OutSFmt) + if (RegCheckErr(Buf, RoutineName)) return + ! Delim + call RegPack(Buf, InData%Delim) + if (RegCheckErr(Buf, RoutineName)) return + ! UnOutFile + call RegPack(Buf, InData%UnOutFile) + if (RegCheckErr(Buf, RoutineName)) return + ! OutDec + call RegPack(Buf, InData%OutDec) + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_u_indx + call RegPack(Buf, allocated(InData%Jac_u_indx)) + if (allocated(InData%Jac_u_indx)) then + call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx), ubound(InData%Jac_u_indx)) + call RegPack(Buf, InData%Jac_u_indx) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! du + call RegPack(Buf, allocated(InData%du)) + if (allocated(InData%du)) then + call RegPackBounds(Buf, 1, lbound(InData%du), ubound(InData%du)) + call RegPack(Buf, InData%du) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! dx + call RegPack(Buf, allocated(InData%dx)) + if (allocated(InData%dx)) then + call RegPackBounds(Buf, 1, lbound(InData%dx), ubound(InData%dx)) + call RegPack(Buf, InData%dx) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_ny + call RegPack(Buf, InData%Jac_ny) + if (RegCheckErr(Buf, RoutineName)) return + ! PointsToSeaState + call RegPack(Buf, InData%PointsToSeaState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine HydroDyn_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'HydroDyn_UnPackParam' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + ! nWAMITObj + call RegUnpack(Buf, OutData%nWAMITObj) + if (RegCheckErr(Buf, RoutineName)) return + ! vecMultiplier + call RegUnpack(Buf, OutData%vecMultiplier) + if (RegCheckErr(Buf, RoutineName)) return + ! WAMIT + if (allocated(OutData%WAMIT)) deallocate(OutData%WAMIT) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WAMIT(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call WAMIT_UnpackParam(Buf, OutData%WAMIT(i1)) ! WAMIT + end do + end if + ! WAMIT2 + if (allocated(OutData%WAMIT2)) deallocate(OutData%WAMIT2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WAMIT2(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call WAMIT2_UnpackParam(Buf, OutData%WAMIT2(i1)) ! WAMIT2 + end do + end if + ! WAMIT2used + call RegUnpack(Buf, OutData%WAMIT2used) + if (RegCheckErr(Buf, RoutineName)) return + ! Morison + call Morison_UnpackParam(Buf, OutData%Morison) ! Morison + ! PotMod + call RegUnpack(Buf, OutData%PotMod) + if (RegCheckErr(Buf, RoutineName)) return + ! NBody + call RegUnpack(Buf, OutData%NBody) + if (RegCheckErr(Buf, RoutineName)) return + ! NBodyMod + call RegUnpack(Buf, OutData%NBodyMod) + if (RegCheckErr(Buf, RoutineName)) return + ! totalStates + call RegUnpack(Buf, OutData%totalStates) + if (RegCheckErr(Buf, RoutineName)) return + ! totalExctnStates + call RegUnpack(Buf, OutData%totalExctnStates) + if (RegCheckErr(Buf, RoutineName)) return + ! totalRdtnStates + call RegUnpack(Buf, OutData%totalRdtnStates) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveTime + if (associated(OutData%WaveTime)) deallocate(OutData%WaveTime) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveTime, UB(1:1)-LB(1:1)) + OutData%WaveTime(LB(1):) => OutData%WaveTime + else + allocate(OutData%WaveTime(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveTime) + call RegUnpack(Buf, OutData%WaveTime) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveTime => null() + end if + ! NStepWave + call RegUnpack(Buf, OutData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDpth + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! AddF0 + if (allocated(OutData%AddF0)) deallocate(OutData%AddF0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AddF0(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AddF0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AddF0) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AddCLin + if (allocated(OutData%AddCLin)) deallocate(OutData%AddCLin) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AddCLin(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AddCLin.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AddCLin) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AddBLin + if (allocated(OutData%AddBLin)) deallocate(OutData%AddBLin) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AddBLin(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AddBLin.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AddBLin) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AddBQuad + if (allocated(OutData%AddBQuad)) deallocate(OutData%AddBQuad) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AddBQuad(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AddBQuad.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AddBQuad) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! DT + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! OutParam + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam + end do + end if + ! NumOuts + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! NumTotalOuts + call RegUnpack(Buf, OutData%NumTotalOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! OutSwtch + call RegUnpack(Buf, OutData%OutSwtch) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFmt + call RegUnpack(Buf, OutData%OutFmt) + if (RegCheckErr(Buf, RoutineName)) return + ! OutSFmt + call RegUnpack(Buf, OutData%OutSFmt) + if (RegCheckErr(Buf, RoutineName)) return + ! Delim + call RegUnpack(Buf, OutData%Delim) + if (RegCheckErr(Buf, RoutineName)) return + ! UnOutFile + call RegUnpack(Buf, OutData%UnOutFile) + if (RegCheckErr(Buf, RoutineName)) return + ! OutDec + call RegUnpack(Buf, OutData%OutDec) + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_u_indx + if (allocated(OutData%Jac_u_indx)) deallocate(OutData%Jac_u_indx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jac_u_indx) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! du + if (allocated(OutData%du)) deallocate(OutData%du) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%du(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%du) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! dx + if (allocated(OutData%dx)) deallocate(OutData%dx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dx(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dx) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Jac_ny + call RegUnpack(Buf, OutData%Jac_ny) + if (RegCheckErr(Buf, RoutineName)) return + ! PointsToSeaState + call RegUnpack(Buf, OutData%PointsToSeaState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE HydroDyn_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(HydroDyn_InputType), INTENT(INOUT) :: SrcInputData TYPE(HydroDyn_InputType), INTENT(INOUT) :: DstInputData @@ -7002,354 +3257,35 @@ SUBROUTINE HydroDyn_DestroyInput( InputData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE HydroDyn_DestroyInput - SUBROUTINE HydroDyn_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(HydroDyn_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Morison: size of buffers for each call to pack subtype - CALL Morison_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, .TRUE. ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Morison - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Morison - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Morison - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! WAMITMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%WAMITMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! WAMITMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMITMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMITMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMITMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! PRPMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%PRPMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PRPMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PRPMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PRPMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PRPMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL Morison_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, OnlySize ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MeshPack( InData%WAMITMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! WAMITMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MeshPack( InData%PRPMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PRPMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE HydroDyn_PackInput - - SUBROUTINE HydroDyn_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(HydroDyn_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Morison_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Morison, ErrStat2, ErrMsg2 ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%WAMITMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! WAMITMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%PRPMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PRPMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE HydroDyn_UnPackInput +subroutine HydroDyn_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'HydroDyn_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + ! Morison + call Morison_PackInput(Buf, InData%Morison) + if (RegCheckErr(Buf, RoutineName)) return + ! WAMITMesh + call MeshPack(Buf, InData%WAMITMesh) + if (RegCheckErr(Buf, RoutineName)) return + ! PRPMesh + call MeshPack(Buf, InData%PRPMesh) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine HydroDyn_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'HydroDyn_UnPackInput' + if (Buf%ErrStat /= ErrID_None) return + ! Morison + call Morison_UnpackInput(Buf, OutData%Morison) ! Morison + ! WAMITMesh + call MeshUnpack(Buf, OutData%WAMITMesh) ! WAMITMesh + ! PRPMesh + call MeshUnpack(Buf, OutData%PRPMesh) ! PRPMesh +end subroutine SUBROUTINE HydroDyn_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(HydroDyn_OutputType), INTENT(INOUT) :: SrcOutputData TYPE(HydroDyn_OutputType), INTENT(INOUT) :: DstOutputData @@ -7453,548 +3389,112 @@ SUBROUTINE HydroDyn_DestroyOutput( OutputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE HydroDyn_DestroyOutput - SUBROUTINE HydroDyn_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(HydroDyn_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! WAMIT allocated yes/no - IF ( ALLOCATED(InData%WAMIT) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WAMIT upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%WAMIT,1), UBOUND(InData%WAMIT,1) - Int_BufSz = Int_BufSz + 3 ! WAMIT: size of buffers for each call to pack subtype - CALL WAMIT_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT(i1), ErrStat2, ErrMsg2, .TRUE. ) ! WAMIT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMIT - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMIT - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMIT - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! WAMIT2 allocated yes/no - IF ( ALLOCATED(InData%WAMIT2) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WAMIT2 upper/lower bounds for each dimension - DO i1 = LBOUND(InData%WAMIT2,1), UBOUND(InData%WAMIT2,1) - Int_BufSz = Int_BufSz + 3 ! WAMIT2: size of buffers for each call to pack subtype - CALL WAMIT2_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT2(i1), ErrStat2, ErrMsg2, .TRUE. ) ! WAMIT2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMIT2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMIT2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMIT2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! Morison: size of buffers for each call to pack subtype - CALL Morison_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, .TRUE. ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Morison - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Morison - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Morison - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! WAMITMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%WAMITMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! WAMITMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WAMITMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WAMITMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WAMITMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutput allocated yes/no - IF ( ALLOCATED(InData%WriteOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutput upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WriteOutput) ! WriteOutput - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%WAMIT) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WAMIT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAMIT,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WAMIT,1), UBOUND(InData%WAMIT,1) - CALL WAMIT_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT(i1), ErrStat2, ErrMsg2, OnlySize ) ! WAMIT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WAMIT2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WAMIT2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAMIT2,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WAMIT2,1), UBOUND(InData%WAMIT2,1) - CALL WAMIT2_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT2(i1), ErrStat2, ErrMsg2, OnlySize ) ! WAMIT2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL Morison_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Morison, ErrStat2, ErrMsg2, OnlySize ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MeshPack( InData%WAMITMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! WAMITMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) - ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE HydroDyn_PackOutput - - SUBROUTINE HydroDyn_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(HydroDyn_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WAMIT not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WAMIT)) DEALLOCATE(OutData%WAMIT) - ALLOCATE(OutData%WAMIT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WAMIT,1), UBOUND(OutData%WAMIT,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL WAMIT_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%WAMIT(i1), ErrStat2, ErrMsg2 ) ! WAMIT - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WAMIT2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WAMIT2)) DEALLOCATE(OutData%WAMIT2) - ALLOCATE(OutData%WAMIT2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WAMIT2,1), UBOUND(OutData%WAMIT2,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL WAMIT2_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%WAMIT2(i1), ErrStat2, ErrMsg2 ) ! WAMIT2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Morison_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Morison, ErrStat2, ErrMsg2 ) ! Morison - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%WAMITMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! WAMITMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutput)) DEALLOCATE(OutData%WriteOutput) - ALLOCATE(OutData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) - OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE HydroDyn_UnPackOutput +subroutine HydroDyn_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'HydroDyn_PackOutput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! WAMIT + call RegPack(Buf, allocated(InData%WAMIT)) + if (allocated(InData%WAMIT)) then + call RegPackBounds(Buf, 1, lbound(InData%WAMIT), ubound(InData%WAMIT)) + LB(1:1) = lbound(InData%WAMIT) + UB(1:1) = ubound(InData%WAMIT) + do i1 = LB(1), UB(1) + call WAMIT_PackOutput(Buf, InData%WAMIT(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WAMIT2 + call RegPack(Buf, allocated(InData%WAMIT2)) + if (allocated(InData%WAMIT2)) then + call RegPackBounds(Buf, 1, lbound(InData%WAMIT2), ubound(InData%WAMIT2)) + LB(1:1) = lbound(InData%WAMIT2) + UB(1:1) = ubound(InData%WAMIT2) + do i1 = LB(1), UB(1) + call WAMIT2_PackOutput(Buf, InData%WAMIT2(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Morison + call Morison_PackOutput(Buf, InData%Morison) + if (RegCheckErr(Buf, RoutineName)) return + ! WAMITMesh + call MeshPack(Buf, InData%WAMITMesh) + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutput + call RegPack(Buf, allocated(InData%WriteOutput)) + if (allocated(InData%WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPack(Buf, InData%WriteOutput) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine HydroDyn_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'HydroDyn_UnPackOutput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! WAMIT + if (allocated(OutData%WAMIT)) deallocate(OutData%WAMIT) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WAMIT(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call WAMIT_UnpackOutput(Buf, OutData%WAMIT(i1)) ! WAMIT + end do + end if + ! WAMIT2 + if (allocated(OutData%WAMIT2)) deallocate(OutData%WAMIT2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WAMIT2(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAMIT2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call WAMIT2_UnpackOutput(Buf, OutData%WAMIT2(i1)) ! WAMIT2 + end do + end if + ! Morison + call Morison_UnpackOutput(Buf, OutData%Morison) ! Morison + ! WAMITMesh + call MeshUnpack(Buf, OutData%WAMITMesh) ! WAMITMesh + ! WriteOutput + if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE HydroDyn_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) ! diff --git a/modules/hydrodyn/src/Morison_Types.f90 b/modules/hydrodyn/src/Morison_Types.f90 index ac212b7386..e1e5551a15 100644 --- a/modules/hydrodyn/src/Morison_Types.f90 +++ b/modules/hydrodyn/src/Morison_Types.f90 @@ -475,146 +475,62 @@ SUBROUTINE Morison_DestroyJointType( JointTypeData, ErrStat, ErrMsg ) END SUBROUTINE Morison_DestroyJointType - SUBROUTINE Morison_PackJointType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Morison_JointType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_PackJointType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! JointID - Re_BufSz = Re_BufSz + SIZE(InData%Position) ! Position - Int_BufSz = Int_BufSz + 1 ! JointAxID - Int_BufSz = Int_BufSz + 1 ! JointAxIDIndx - Int_BufSz = Int_BufSz + 1 ! JointOvrlp - Int_BufSz = Int_BufSz + 1 ! NConnections - Int_BufSz = Int_BufSz + SIZE(InData%ConnectionList) ! ConnectionList - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%JointID - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%Position,1), UBOUND(InData%Position,1) - ReKiBuf(Re_Xferred) = InData%Position(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%JointAxID - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%JointAxIDIndx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%JointOvrlp - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NConnections - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%ConnectionList,1), UBOUND(InData%ConnectionList,1) - IntKiBuf(Int_Xferred) = InData%ConnectionList(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END SUBROUTINE Morison_PackJointType - - SUBROUTINE Morison_UnPackJointType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Morison_JointType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackJointType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%JointID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%Position,1) - i1_u = UBOUND(OutData%Position,1) - DO i1 = LBOUND(OutData%Position,1), UBOUND(OutData%Position,1) - OutData%Position(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%JointAxID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%JointAxIDIndx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%JointOvrlp = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NConnections = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%ConnectionList,1) - i1_u = UBOUND(OutData%ConnectionList,1) - DO i1 = LBOUND(OutData%ConnectionList,1), UBOUND(OutData%ConnectionList,1) - OutData%ConnectionList(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END SUBROUTINE Morison_UnPackJointType +subroutine Morison_PackJointType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Morison_JointType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackJointType' + if (Buf%ErrStat >= AbortErrLev) return + ! JointID + call RegPack(Buf, InData%JointID) + if (RegCheckErr(Buf, RoutineName)) return + ! Position + call RegPack(Buf, InData%Position) + if (RegCheckErr(Buf, RoutineName)) return + ! JointAxID + call RegPack(Buf, InData%JointAxID) + if (RegCheckErr(Buf, RoutineName)) return + ! JointAxIDIndx + call RegPack(Buf, InData%JointAxIDIndx) + if (RegCheckErr(Buf, RoutineName)) return + ! JointOvrlp + call RegPack(Buf, InData%JointOvrlp) + if (RegCheckErr(Buf, RoutineName)) return + ! NConnections + call RegPack(Buf, InData%NConnections) + if (RegCheckErr(Buf, RoutineName)) return + ! ConnectionList + call RegPack(Buf, InData%ConnectionList) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_UnPackJointType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Morison_JointType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackJointType' + if (Buf%ErrStat /= ErrID_None) return + ! JointID + call RegUnpack(Buf, OutData%JointID) + if (RegCheckErr(Buf, RoutineName)) return + ! Position + call RegUnpack(Buf, OutData%Position) + if (RegCheckErr(Buf, RoutineName)) return + ! JointAxID + call RegUnpack(Buf, OutData%JointAxID) + if (RegCheckErr(Buf, RoutineName)) return + ! JointAxIDIndx + call RegUnpack(Buf, OutData%JointAxIDIndx) + if (RegCheckErr(Buf, RoutineName)) return + ! JointOvrlp + call RegUnpack(Buf, OutData%JointOvrlp) + if (RegCheckErr(Buf, RoutineName)) return + ! NConnections + call RegUnpack(Buf, OutData%NConnections) + if (RegCheckErr(Buf, RoutineName)) return + ! ConnectionList + call RegUnpack(Buf, OutData%ConnectionList) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE Morison_CopyMemberPropType( SrcMemberPropTypeData, DstMemberPropTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(Morison_MemberPropType), INTENT(IN) :: SrcMemberPropTypeData TYPE(Morison_MemberPropType), INTENT(INOUT) :: DstMemberPropTypeData @@ -649,113 +565,38 @@ SUBROUTINE Morison_DestroyMemberPropType( MemberPropTypeData, ErrStat, ErrMsg ) END SUBROUTINE Morison_DestroyMemberPropType - SUBROUTINE Morison_PackMemberPropType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Morison_MemberPropType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_PackMemberPropType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! PropSetID - Re_BufSz = Re_BufSz + 1 ! PropD - Re_BufSz = Re_BufSz + 1 ! PropThck - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%PropSetID - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PropD - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PropThck - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Morison_PackMemberPropType - - SUBROUTINE Morison_UnPackMemberPropType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Morison_MemberPropType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackMemberPropType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%PropSetID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%PropD = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PropThck = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Morison_UnPackMemberPropType +subroutine Morison_PackMemberPropType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Morison_MemberPropType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackMemberPropType' + if (Buf%ErrStat >= AbortErrLev) return + ! PropSetID + call RegPack(Buf, InData%PropSetID) + if (RegCheckErr(Buf, RoutineName)) return + ! PropD + call RegPack(Buf, InData%PropD) + if (RegCheckErr(Buf, RoutineName)) return + ! PropThck + call RegPack(Buf, InData%PropThck) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_UnPackMemberPropType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Morison_MemberPropType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackMemberPropType' + if (Buf%ErrStat /= ErrID_None) return + ! PropSetID + call RegUnpack(Buf, OutData%PropSetID) + if (RegCheckErr(Buf, RoutineName)) return + ! PropD + call RegUnpack(Buf, OutData%PropD) + if (RegCheckErr(Buf, RoutineName)) return + ! PropThck + call RegUnpack(Buf, OutData%PropThck) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE Morison_CopyFilledGroupType( SrcFilledGroupTypeData, DstFilledGroupTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(Morison_FilledGroupType), INTENT(IN) :: SrcFilledGroupTypeData TYPE(Morison_FilledGroupType), INTENT(INOUT) :: DstFilledGroupTypeData @@ -807,161 +648,69 @@ SUBROUTINE Morison_DestroyFilledGroupType( FilledGroupTypeData, ErrStat, ErrMsg ENDIF END SUBROUTINE Morison_DestroyFilledGroupType - SUBROUTINE Morison_PackFilledGroupType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Morison_FilledGroupType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_PackFilledGroupType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! FillNumM - Int_BufSz = Int_BufSz + 1 ! FillMList allocated yes/no - IF ( ALLOCATED(InData%FillMList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FillMList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%FillMList) ! FillMList - END IF - Re_BufSz = Re_BufSz + 1 ! FillFSLoc - Int_BufSz = Int_BufSz + 1*LEN(InData%FillDensChr) ! FillDensChr - Re_BufSz = Re_BufSz + 1 ! FillDens - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%FillNumM - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%FillMList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FillMList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FillMList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FillMList,1), UBOUND(InData%FillMList,1) - IntKiBuf(Int_Xferred) = InData%FillMList(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%FillFSLoc - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%FillDensChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%FillDensChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf(Re_Xferred) = InData%FillDens - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Morison_PackFilledGroupType - - SUBROUTINE Morison_UnPackFilledGroupType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Morison_FilledGroupType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackFilledGroupType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%FillNumM = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FillMList not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FillMList)) DEALLOCATE(OutData%FillMList) - ALLOCATE(OutData%FillMList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FillMList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FillMList,1), UBOUND(OutData%FillMList,1) - OutData%FillMList(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%FillFSLoc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%FillDensChr) - OutData%FillDensChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%FillDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Morison_UnPackFilledGroupType +subroutine Morison_PackFilledGroupType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Morison_FilledGroupType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackFilledGroupType' + if (Buf%ErrStat >= AbortErrLev) return + ! FillNumM + call RegPack(Buf, InData%FillNumM) + if (RegCheckErr(Buf, RoutineName)) return + ! FillMList + call RegPack(Buf, allocated(InData%FillMList)) + if (allocated(InData%FillMList)) then + call RegPackBounds(Buf, 1, lbound(InData%FillMList), ubound(InData%FillMList)) + call RegPack(Buf, InData%FillMList) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FillFSLoc + call RegPack(Buf, InData%FillFSLoc) + if (RegCheckErr(Buf, RoutineName)) return + ! FillDensChr + call RegPack(Buf, InData%FillDensChr) + if (RegCheckErr(Buf, RoutineName)) return + ! FillDens + call RegPack(Buf, InData%FillDens) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_UnPackFilledGroupType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Morison_FilledGroupType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackFilledGroupType' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! FillNumM + call RegUnpack(Buf, OutData%FillNumM) + if (RegCheckErr(Buf, RoutineName)) return + ! FillMList + if (allocated(OutData%FillMList)) deallocate(OutData%FillMList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FillMList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FillMList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FillMList) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! FillFSLoc + call RegUnpack(Buf, OutData%FillFSLoc) + if (RegCheckErr(Buf, RoutineName)) return + ! FillDensChr + call RegUnpack(Buf, OutData%FillDensChr) + if (RegCheckErr(Buf, RoutineName)) return + ! FillDens + call RegUnpack(Buf, OutData%FillDens) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE Morison_CopyCoefDpths( SrcCoefDpthsData, DstCoefDpthsData, CtrlCode, ErrStat, ErrMsg ) TYPE(Morison_CoefDpths), INTENT(IN) :: SrcCoefDpthsData TYPE(Morison_CoefDpths), INTENT(INOUT) :: DstCoefDpthsData @@ -1009,178 +758,116 @@ SUBROUTINE Morison_DestroyCoefDpths( CoefDpthsData, ErrStat, ErrMsg ) END SUBROUTINE Morison_DestroyCoefDpths - SUBROUTINE Morison_PackCoefDpths( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Morison_CoefDpths), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_PackCoefDpths' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! Dpth - Re_BufSz = Re_BufSz + 1 ! DpthCd - Re_BufSz = Re_BufSz + 1 ! DpthCdMG - Re_BufSz = Re_BufSz + 1 ! DpthCa - Re_BufSz = Re_BufSz + 1 ! DpthCaMG - Re_BufSz = Re_BufSz + 1 ! DpthCp - Re_BufSz = Re_BufSz + 1 ! DpthCpMG - Re_BufSz = Re_BufSz + 1 ! DpthAxCd - Re_BufSz = Re_BufSz + 1 ! DpthAxCdMG - Re_BufSz = Re_BufSz + 1 ! DpthAxCa - Re_BufSz = Re_BufSz + 1 ! DpthAxCaMG - Re_BufSz = Re_BufSz + 1 ! DpthAxCp - Re_BufSz = Re_BufSz + 1 ! DpthAxCpMG - Re_BufSz = Re_BufSz + 1 ! DpthCb - Re_BufSz = Re_BufSz + 1 ! DpthCbMg - Int_BufSz = Int_BufSz + 1 ! DpthMCF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%Dpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DpthCd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DpthCdMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DpthCa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DpthCaMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DpthCp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DpthCpMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DpthAxCd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DpthAxCdMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DpthAxCa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DpthAxCaMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DpthAxCp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DpthAxCpMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DpthCb - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DpthCbMg - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%DpthMCF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Morison_PackCoefDpths - - SUBROUTINE Morison_UnPackCoefDpths( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Morison_CoefDpths), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackCoefDpths' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%Dpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DpthCd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DpthCdMG = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DpthCa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DpthCaMG = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DpthCp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DpthCpMG = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DpthAxCd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DpthAxCdMG = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DpthAxCa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DpthAxCaMG = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DpthAxCp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DpthAxCpMG = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DpthCb = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DpthCbMg = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DpthMCF = TRANSFER(IntKiBuf(Int_Xferred), OutData%DpthMCF) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Morison_UnPackCoefDpths +subroutine Morison_PackCoefDpths(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Morison_CoefDpths), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackCoefDpths' + if (Buf%ErrStat >= AbortErrLev) return + ! Dpth + call RegPack(Buf, InData%Dpth) + if (RegCheckErr(Buf, RoutineName)) return + ! DpthCd + call RegPack(Buf, InData%DpthCd) + if (RegCheckErr(Buf, RoutineName)) return + ! DpthCdMG + call RegPack(Buf, InData%DpthCdMG) + if (RegCheckErr(Buf, RoutineName)) return + ! DpthCa + call RegPack(Buf, InData%DpthCa) + if (RegCheckErr(Buf, RoutineName)) return + ! DpthCaMG + call RegPack(Buf, InData%DpthCaMG) + if (RegCheckErr(Buf, RoutineName)) return + ! DpthCp + call RegPack(Buf, InData%DpthCp) + if (RegCheckErr(Buf, RoutineName)) return + ! DpthCpMG + call RegPack(Buf, InData%DpthCpMG) + if (RegCheckErr(Buf, RoutineName)) return + ! DpthAxCd + call RegPack(Buf, InData%DpthAxCd) + if (RegCheckErr(Buf, RoutineName)) return + ! DpthAxCdMG + call RegPack(Buf, InData%DpthAxCdMG) + if (RegCheckErr(Buf, RoutineName)) return + ! DpthAxCa + call RegPack(Buf, InData%DpthAxCa) + if (RegCheckErr(Buf, RoutineName)) return + ! DpthAxCaMG + call RegPack(Buf, InData%DpthAxCaMG) + if (RegCheckErr(Buf, RoutineName)) return + ! DpthAxCp + call RegPack(Buf, InData%DpthAxCp) + if (RegCheckErr(Buf, RoutineName)) return + ! DpthAxCpMG + call RegPack(Buf, InData%DpthAxCpMG) + if (RegCheckErr(Buf, RoutineName)) return + ! DpthCb + call RegPack(Buf, InData%DpthCb) + if (RegCheckErr(Buf, RoutineName)) return + ! DpthCbMg + call RegPack(Buf, InData%DpthCbMg) + if (RegCheckErr(Buf, RoutineName)) return + ! DpthMCF + call RegPack(Buf, InData%DpthMCF) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_UnPackCoefDpths(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Morison_CoefDpths), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackCoefDpths' + if (Buf%ErrStat /= ErrID_None) return + ! Dpth + call RegUnpack(Buf, OutData%Dpth) + if (RegCheckErr(Buf, RoutineName)) return + ! DpthCd + call RegUnpack(Buf, OutData%DpthCd) + if (RegCheckErr(Buf, RoutineName)) return + ! DpthCdMG + call RegUnpack(Buf, OutData%DpthCdMG) + if (RegCheckErr(Buf, RoutineName)) return + ! DpthCa + call RegUnpack(Buf, OutData%DpthCa) + if (RegCheckErr(Buf, RoutineName)) return + ! DpthCaMG + call RegUnpack(Buf, OutData%DpthCaMG) + if (RegCheckErr(Buf, RoutineName)) return + ! DpthCp + call RegUnpack(Buf, OutData%DpthCp) + if (RegCheckErr(Buf, RoutineName)) return + ! DpthCpMG + call RegUnpack(Buf, OutData%DpthCpMG) + if (RegCheckErr(Buf, RoutineName)) return + ! DpthAxCd + call RegUnpack(Buf, OutData%DpthAxCd) + if (RegCheckErr(Buf, RoutineName)) return + ! DpthAxCdMG + call RegUnpack(Buf, OutData%DpthAxCdMG) + if (RegCheckErr(Buf, RoutineName)) return + ! DpthAxCa + call RegUnpack(Buf, OutData%DpthAxCa) + if (RegCheckErr(Buf, RoutineName)) return + ! DpthAxCaMG + call RegUnpack(Buf, OutData%DpthAxCaMG) + if (RegCheckErr(Buf, RoutineName)) return + ! DpthAxCp + call RegUnpack(Buf, OutData%DpthAxCp) + if (RegCheckErr(Buf, RoutineName)) return + ! DpthAxCpMG + call RegUnpack(Buf, OutData%DpthAxCpMG) + if (RegCheckErr(Buf, RoutineName)) return + ! DpthCb + call RegUnpack(Buf, OutData%DpthCb) + if (RegCheckErr(Buf, RoutineName)) return + ! DpthCbMg + call RegUnpack(Buf, OutData%DpthCbMg) + if (RegCheckErr(Buf, RoutineName)) return + ! DpthMCF + call RegUnpack(Buf, OutData%DpthMCF) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE Morison_CopyAxialCoefType( SrcAxialCoefTypeData, DstAxialCoefTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(Morison_AxialCoefType), INTENT(IN) :: SrcAxialCoefTypeData TYPE(Morison_AxialCoefType), INTENT(INOUT) :: DstAxialCoefTypeData @@ -1219,133 +906,62 @@ SUBROUTINE Morison_DestroyAxialCoefType( AxialCoefTypeData, ErrStat, ErrMsg ) END SUBROUTINE Morison_DestroyAxialCoefType - SUBROUTINE Morison_PackAxialCoefType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Morison_AxialCoefType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_PackAxialCoefType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! AxCoefID - Re_BufSz = Re_BufSz + 1 ! AxCd - Re_BufSz = Re_BufSz + 1 ! AxCa - Re_BufSz = Re_BufSz + 1 ! AxCp - Re_BufSz = Re_BufSz + 1 ! AxVnCOff - Re_BufSz = Re_BufSz + 1 ! AxFDLoFSc - Int_BufSz = Int_BufSz + 1 ! AxFDMod - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%AxCoefID - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AxCd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AxCa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AxCp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AxVnCOff - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AxFDLoFSc - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%AxFDMod - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Morison_PackAxialCoefType - - SUBROUTINE Morison_UnPackAxialCoefType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Morison_AxialCoefType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackAxialCoefType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%AxCoefID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%AxCd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AxCa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AxCp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AxVnCOff = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AxFDLoFSc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AxFDMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Morison_UnPackAxialCoefType +subroutine Morison_PackAxialCoefType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Morison_AxialCoefType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackAxialCoefType' + if (Buf%ErrStat >= AbortErrLev) return + ! AxCoefID + call RegPack(Buf, InData%AxCoefID) + if (RegCheckErr(Buf, RoutineName)) return + ! AxCd + call RegPack(Buf, InData%AxCd) + if (RegCheckErr(Buf, RoutineName)) return + ! AxCa + call RegPack(Buf, InData%AxCa) + if (RegCheckErr(Buf, RoutineName)) return + ! AxCp + call RegPack(Buf, InData%AxCp) + if (RegCheckErr(Buf, RoutineName)) return + ! AxVnCOff + call RegPack(Buf, InData%AxVnCOff) + if (RegCheckErr(Buf, RoutineName)) return + ! AxFDLoFSc + call RegPack(Buf, InData%AxFDLoFSc) + if (RegCheckErr(Buf, RoutineName)) return + ! AxFDMod + call RegPack(Buf, InData%AxFDMod) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_UnPackAxialCoefType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Morison_AxialCoefType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackAxialCoefType' + if (Buf%ErrStat /= ErrID_None) return + ! AxCoefID + call RegUnpack(Buf, OutData%AxCoefID) + if (RegCheckErr(Buf, RoutineName)) return + ! AxCd + call RegUnpack(Buf, OutData%AxCd) + if (RegCheckErr(Buf, RoutineName)) return + ! AxCa + call RegUnpack(Buf, OutData%AxCa) + if (RegCheckErr(Buf, RoutineName)) return + ! AxCp + call RegUnpack(Buf, OutData%AxCp) + if (RegCheckErr(Buf, RoutineName)) return + ! AxVnCOff + call RegUnpack(Buf, OutData%AxVnCOff) + if (RegCheckErr(Buf, RoutineName)) return + ! AxFDLoFSc + call RegUnpack(Buf, OutData%AxFDLoFSc) + if (RegCheckErr(Buf, RoutineName)) return + ! AxFDMod + call RegUnpack(Buf, OutData%AxFDMod) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE Morison_CopyMemberInputType( SrcMemberInputTypeData, DstMemberInputTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(Morison_MemberInputType), INTENT(IN) :: SrcMemberInputTypeData TYPE(Morison_MemberInputType), INTENT(INOUT) :: DstMemberInputTypeData @@ -1412,232 +1028,159 @@ SUBROUTINE Morison_DestroyMemberInputType( MemberInputTypeData, ErrStat, ErrMsg ENDIF END SUBROUTINE Morison_DestroyMemberInputType - SUBROUTINE Morison_PackMemberInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Morison_MemberInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_PackMemberInputType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! MemberID - Int_BufSz = Int_BufSz + 1 ! NodeIndx allocated yes/no - IF ( ALLOCATED(InData%NodeIndx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NodeIndx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NodeIndx) ! NodeIndx - END IF - Int_BufSz = Int_BufSz + 1 ! MJointID1 - Int_BufSz = Int_BufSz + 1 ! MJointID2 - Int_BufSz = Int_BufSz + 1 ! MJointID1Indx - Int_BufSz = Int_BufSz + 1 ! MJointID2Indx - Int_BufSz = Int_BufSz + 1 ! MPropSetID1 - Int_BufSz = Int_BufSz + 1 ! MPropSetID2 - Int_BufSz = Int_BufSz + 1 ! MPropSetID1Indx - Int_BufSz = Int_BufSz + 1 ! MPropSetID2Indx - Re_BufSz = Re_BufSz + 1 ! MDivSize - Int_BufSz = Int_BufSz + 1 ! MCoefMod - Int_BufSz = Int_BufSz + 1 ! MHstLMod - Int_BufSz = Int_BufSz + 1 ! MmbrCoefIDIndx - Int_BufSz = Int_BufSz + 1 ! MmbrFilledIDIndx - Int_BufSz = Int_BufSz + 1 ! PropPot - Int_BufSz = Int_BufSz + 1 ! PropMCF - Int_BufSz = Int_BufSz + 1 ! NElements - Re_BufSz = Re_BufSz + 1 ! RefLength - Re_BufSz = Re_BufSz + 1 ! dl - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%MemberID - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%NodeIndx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NodeIndx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodeIndx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NodeIndx,1), UBOUND(InData%NodeIndx,1) - IntKiBuf(Int_Xferred) = InData%NodeIndx(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%MJointID1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MJointID2 - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MJointID1Indx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MJointID2Indx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MPropSetID1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MPropSetID2 - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MPropSetID1Indx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MPropSetID2Indx - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MDivSize - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MCoefMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MHstLMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MmbrCoefIDIndx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MmbrFilledIDIndx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%PropPot, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%PropMCF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NElements - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RefLength - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dl - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Morison_PackMemberInputType - - SUBROUTINE Morison_UnPackMemberInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Morison_MemberInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackMemberInputType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%MemberID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodeIndx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NodeIndx)) DEALLOCATE(OutData%NodeIndx) - ALLOCATE(OutData%NodeIndx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeIndx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NodeIndx,1), UBOUND(OutData%NodeIndx,1) - OutData%NodeIndx(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%MJointID1 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MJointID2 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MJointID1Indx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MJointID2Indx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MPropSetID1 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MPropSetID2 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MPropSetID1Indx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MPropSetID2Indx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MDivSize = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MCoefMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MHstLMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MmbrCoefIDIndx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MmbrFilledIDIndx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%PropPot = TRANSFER(IntKiBuf(Int_Xferred), OutData%PropPot) - Int_Xferred = Int_Xferred + 1 - OutData%PropMCF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PropMCF) - Int_Xferred = Int_Xferred + 1 - OutData%NElements = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%RefLength = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Morison_UnPackMemberInputType +subroutine Morison_PackMemberInputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Morison_MemberInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackMemberInputType' + if (Buf%ErrStat >= AbortErrLev) return + ! MemberID + call RegPack(Buf, InData%MemberID) + if (RegCheckErr(Buf, RoutineName)) return + ! NodeIndx + call RegPack(Buf, allocated(InData%NodeIndx)) + if (allocated(InData%NodeIndx)) then + call RegPackBounds(Buf, 1, lbound(InData%NodeIndx), ubound(InData%NodeIndx)) + call RegPack(Buf, InData%NodeIndx) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MJointID1 + call RegPack(Buf, InData%MJointID1) + if (RegCheckErr(Buf, RoutineName)) return + ! MJointID2 + call RegPack(Buf, InData%MJointID2) + if (RegCheckErr(Buf, RoutineName)) return + ! MJointID1Indx + call RegPack(Buf, InData%MJointID1Indx) + if (RegCheckErr(Buf, RoutineName)) return + ! MJointID2Indx + call RegPack(Buf, InData%MJointID2Indx) + if (RegCheckErr(Buf, RoutineName)) return + ! MPropSetID1 + call RegPack(Buf, InData%MPropSetID1) + if (RegCheckErr(Buf, RoutineName)) return + ! MPropSetID2 + call RegPack(Buf, InData%MPropSetID2) + if (RegCheckErr(Buf, RoutineName)) return + ! MPropSetID1Indx + call RegPack(Buf, InData%MPropSetID1Indx) + if (RegCheckErr(Buf, RoutineName)) return + ! MPropSetID2Indx + call RegPack(Buf, InData%MPropSetID2Indx) + if (RegCheckErr(Buf, RoutineName)) return + ! MDivSize + call RegPack(Buf, InData%MDivSize) + if (RegCheckErr(Buf, RoutineName)) return + ! MCoefMod + call RegPack(Buf, InData%MCoefMod) + if (RegCheckErr(Buf, RoutineName)) return + ! MHstLMod + call RegPack(Buf, InData%MHstLMod) + if (RegCheckErr(Buf, RoutineName)) return + ! MmbrCoefIDIndx + call RegPack(Buf, InData%MmbrCoefIDIndx) + if (RegCheckErr(Buf, RoutineName)) return + ! MmbrFilledIDIndx + call RegPack(Buf, InData%MmbrFilledIDIndx) + if (RegCheckErr(Buf, RoutineName)) return + ! PropPot + call RegPack(Buf, InData%PropPot) + if (RegCheckErr(Buf, RoutineName)) return + ! PropMCF + call RegPack(Buf, InData%PropMCF) + if (RegCheckErr(Buf, RoutineName)) return + ! NElements + call RegPack(Buf, InData%NElements) + if (RegCheckErr(Buf, RoutineName)) return + ! RefLength + call RegPack(Buf, InData%RefLength) + if (RegCheckErr(Buf, RoutineName)) return + ! dl + call RegPack(Buf, InData%dl) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_UnPackMemberInputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Morison_MemberInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackMemberInputType' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! MemberID + call RegUnpack(Buf, OutData%MemberID) + if (RegCheckErr(Buf, RoutineName)) return + ! NodeIndx + if (allocated(OutData%NodeIndx)) deallocate(OutData%NodeIndx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NodeIndx(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeIndx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%NodeIndx) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! MJointID1 + call RegUnpack(Buf, OutData%MJointID1) + if (RegCheckErr(Buf, RoutineName)) return + ! MJointID2 + call RegUnpack(Buf, OutData%MJointID2) + if (RegCheckErr(Buf, RoutineName)) return + ! MJointID1Indx + call RegUnpack(Buf, OutData%MJointID1Indx) + if (RegCheckErr(Buf, RoutineName)) return + ! MJointID2Indx + call RegUnpack(Buf, OutData%MJointID2Indx) + if (RegCheckErr(Buf, RoutineName)) return + ! MPropSetID1 + call RegUnpack(Buf, OutData%MPropSetID1) + if (RegCheckErr(Buf, RoutineName)) return + ! MPropSetID2 + call RegUnpack(Buf, OutData%MPropSetID2) + if (RegCheckErr(Buf, RoutineName)) return + ! MPropSetID1Indx + call RegUnpack(Buf, OutData%MPropSetID1Indx) + if (RegCheckErr(Buf, RoutineName)) return + ! MPropSetID2Indx + call RegUnpack(Buf, OutData%MPropSetID2Indx) + if (RegCheckErr(Buf, RoutineName)) return + ! MDivSize + call RegUnpack(Buf, OutData%MDivSize) + if (RegCheckErr(Buf, RoutineName)) return + ! MCoefMod + call RegUnpack(Buf, OutData%MCoefMod) + if (RegCheckErr(Buf, RoutineName)) return + ! MHstLMod + call RegUnpack(Buf, OutData%MHstLMod) + if (RegCheckErr(Buf, RoutineName)) return + ! MmbrCoefIDIndx + call RegUnpack(Buf, OutData%MmbrCoefIDIndx) + if (RegCheckErr(Buf, RoutineName)) return + ! MmbrFilledIDIndx + call RegUnpack(Buf, OutData%MmbrFilledIDIndx) + if (RegCheckErr(Buf, RoutineName)) return + ! PropPot + call RegUnpack(Buf, OutData%PropPot) + if (RegCheckErr(Buf, RoutineName)) return + ! PropMCF + call RegUnpack(Buf, OutData%PropMCF) + if (RegCheckErr(Buf, RoutineName)) return + ! NElements + call RegUnpack(Buf, OutData%NElements) + if (RegCheckErr(Buf, RoutineName)) return + ! RefLength + call RegUnpack(Buf, OutData%RefLength) + if (RegCheckErr(Buf, RoutineName)) return + ! dl + call RegUnpack(Buf, OutData%dl) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE Morison_CopyNodeType( SrcNodeTypeData, DstNodeTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(Morison_NodeType), INTENT(IN) :: SrcNodeTypeData TYPE(Morison_NodeType), INTENT(INOUT) :: DstNodeTypeData @@ -1685,186 +1228,110 @@ SUBROUTINE Morison_DestroyNodeType( NodeTypeData, ErrStat, ErrMsg ) END SUBROUTINE Morison_DestroyNodeType - SUBROUTINE Morison_PackNodeType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Morison_NodeType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_PackNodeType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! JointIndx - Re_BufSz = Re_BufSz + SIZE(InData%Position) ! Position - Int_BufSz = Int_BufSz + 1 ! JointOvrlp - Int_BufSz = Int_BufSz + 1 ! JointAxIDIndx - Int_BufSz = Int_BufSz + 1 ! NConnections - Int_BufSz = Int_BufSz + SIZE(InData%ConnectionList) ! ConnectionList - Re_BufSz = Re_BufSz + 1 ! JAxCd - Re_BufSz = Re_BufSz + 1 ! JAxCa - Re_BufSz = Re_BufSz + 1 ! JAxCp - Re_BufSz = Re_BufSz + 1 ! JAxVnCOff - Re_BufSz = Re_BufSz + 1 ! JAxFDLoFSc - Int_BufSz = Int_BufSz + 1 ! JAxFDMod - Re_BufSz = Re_BufSz + 1 ! FillDensity - Re_BufSz = Re_BufSz + 1 ! tMG - Re_BufSz = Re_BufSz + 1 ! MGdensity - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%JointIndx - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%Position,1), UBOUND(InData%Position,1) - ReKiBuf(Re_Xferred) = InData%Position(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%JointOvrlp - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%JointAxIDIndx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NConnections - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%ConnectionList,1), UBOUND(InData%ConnectionList,1) - IntKiBuf(Int_Xferred) = InData%ConnectionList(i1) - Int_Xferred = Int_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%JAxCd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%JAxCa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%JAxCp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%JAxVnCOff - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%JAxFDLoFSc - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%JAxFDMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FillDensity - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%tMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MGdensity - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Morison_PackNodeType - - SUBROUTINE Morison_UnPackNodeType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Morison_NodeType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackNodeType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%JointIndx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%Position,1) - i1_u = UBOUND(OutData%Position,1) - DO i1 = LBOUND(OutData%Position,1), UBOUND(OutData%Position,1) - OutData%Position(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%JointOvrlp = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%JointAxIDIndx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NConnections = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%ConnectionList,1) - i1_u = UBOUND(OutData%ConnectionList,1) - DO i1 = LBOUND(OutData%ConnectionList,1), UBOUND(OutData%ConnectionList,1) - OutData%ConnectionList(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%JAxCd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%JAxCa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%JAxCp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%JAxVnCOff = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%JAxFDLoFSc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%JAxFDMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FillDensity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%tMG = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MGdensity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Morison_UnPackNodeType +subroutine Morison_PackNodeType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Morison_NodeType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackNodeType' + if (Buf%ErrStat >= AbortErrLev) return + ! JointIndx + call RegPack(Buf, InData%JointIndx) + if (RegCheckErr(Buf, RoutineName)) return + ! Position + call RegPack(Buf, InData%Position) + if (RegCheckErr(Buf, RoutineName)) return + ! JointOvrlp + call RegPack(Buf, InData%JointOvrlp) + if (RegCheckErr(Buf, RoutineName)) return + ! JointAxIDIndx + call RegPack(Buf, InData%JointAxIDIndx) + if (RegCheckErr(Buf, RoutineName)) return + ! NConnections + call RegPack(Buf, InData%NConnections) + if (RegCheckErr(Buf, RoutineName)) return + ! ConnectionList + call RegPack(Buf, InData%ConnectionList) + if (RegCheckErr(Buf, RoutineName)) return + ! JAxCd + call RegPack(Buf, InData%JAxCd) + if (RegCheckErr(Buf, RoutineName)) return + ! JAxCa + call RegPack(Buf, InData%JAxCa) + if (RegCheckErr(Buf, RoutineName)) return + ! JAxCp + call RegPack(Buf, InData%JAxCp) + if (RegCheckErr(Buf, RoutineName)) return + ! JAxVnCOff + call RegPack(Buf, InData%JAxVnCOff) + if (RegCheckErr(Buf, RoutineName)) return + ! JAxFDLoFSc + call RegPack(Buf, InData%JAxFDLoFSc) + if (RegCheckErr(Buf, RoutineName)) return + ! JAxFDMod + call RegPack(Buf, InData%JAxFDMod) + if (RegCheckErr(Buf, RoutineName)) return + ! FillDensity + call RegPack(Buf, InData%FillDensity) + if (RegCheckErr(Buf, RoutineName)) return + ! tMG + call RegPack(Buf, InData%tMG) + if (RegCheckErr(Buf, RoutineName)) return + ! MGdensity + call RegPack(Buf, InData%MGdensity) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_UnPackNodeType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Morison_NodeType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackNodeType' + if (Buf%ErrStat /= ErrID_None) return + ! JointIndx + call RegUnpack(Buf, OutData%JointIndx) + if (RegCheckErr(Buf, RoutineName)) return + ! Position + call RegUnpack(Buf, OutData%Position) + if (RegCheckErr(Buf, RoutineName)) return + ! JointOvrlp + call RegUnpack(Buf, OutData%JointOvrlp) + if (RegCheckErr(Buf, RoutineName)) return + ! JointAxIDIndx + call RegUnpack(Buf, OutData%JointAxIDIndx) + if (RegCheckErr(Buf, RoutineName)) return + ! NConnections + call RegUnpack(Buf, OutData%NConnections) + if (RegCheckErr(Buf, RoutineName)) return + ! ConnectionList + call RegUnpack(Buf, OutData%ConnectionList) + if (RegCheckErr(Buf, RoutineName)) return + ! JAxCd + call RegUnpack(Buf, OutData%JAxCd) + if (RegCheckErr(Buf, RoutineName)) return + ! JAxCa + call RegUnpack(Buf, OutData%JAxCa) + if (RegCheckErr(Buf, RoutineName)) return + ! JAxCp + call RegUnpack(Buf, OutData%JAxCp) + if (RegCheckErr(Buf, RoutineName)) return + ! JAxVnCOff + call RegUnpack(Buf, OutData%JAxVnCOff) + if (RegCheckErr(Buf, RoutineName)) return + ! JAxFDLoFSc + call RegUnpack(Buf, OutData%JAxFDLoFSc) + if (RegCheckErr(Buf, RoutineName)) return + ! JAxFDMod + call RegUnpack(Buf, OutData%JAxFDMod) + if (RegCheckErr(Buf, RoutineName)) return + ! FillDensity + call RegUnpack(Buf, OutData%FillDensity) + if (RegCheckErr(Buf, RoutineName)) return + ! tMG + call RegUnpack(Buf, OutData%tMG) + if (RegCheckErr(Buf, RoutineName)) return + ! MGdensity + call RegUnpack(Buf, OutData%MGdensity) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE Morison_CopyMemberType( SrcMemberTypeData, DstMemberTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(Morison_MemberType), INTENT(IN) :: SrcMemberTypeData TYPE(Morison_MemberType), INTENT(INOUT) :: DstMemberTypeData @@ -2528,1868 +1995,1151 @@ SUBROUTINE Morison_DestroyMemberType( MemberTypeData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE Morison_DestroyMemberType - SUBROUTINE Morison_PackMemberType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Morison_MemberType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_PackMemberType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! NodeIndx allocated yes/no - IF ( ALLOCATED(InData%NodeIndx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NodeIndx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NodeIndx) ! NodeIndx - END IF - Int_BufSz = Int_BufSz + 1 ! MemberID - Int_BufSz = Int_BufSz + 1 ! NElements - Re_BufSz = Re_BufSz + 1 ! RefLength - Re_BufSz = Re_BufSz + 1 ! cosPhi_ref - Re_BufSz = Re_BufSz + 1 ! dl - Re_BufSz = Re_BufSz + SIZE(InData%k) ! k - Re_BufSz = Re_BufSz + SIZE(InData%kkt) ! kkt - Re_BufSz = Re_BufSz + SIZE(InData%Ak) ! Ak - Int_BufSz = Int_BufSz + 1 ! R allocated yes/no - IF ( ALLOCATED(InData%R) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! R upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%R) ! R - END IF - Int_BufSz = Int_BufSz + 1 ! RMG allocated yes/no - IF ( ALLOCATED(InData%RMG) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RMG upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%RMG) ! RMG - END IF - Int_BufSz = Int_BufSz + 1 ! RMGB allocated yes/no - IF ( ALLOCATED(InData%RMGB) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RMGB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%RMGB) ! RMGB - END IF - Int_BufSz = Int_BufSz + 1 ! Rin allocated yes/no - IF ( ALLOCATED(InData%Rin) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Rin upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Rin) ! Rin - END IF - Int_BufSz = Int_BufSz + 1 ! tMG allocated yes/no - IF ( ALLOCATED(InData%tMG) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! tMG upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%tMG) ! tMG - END IF - Int_BufSz = Int_BufSz + 1 ! MGdensity allocated yes/no - IF ( ALLOCATED(InData%MGdensity) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MGdensity upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MGdensity) ! MGdensity - END IF - Int_BufSz = Int_BufSz + 1 ! dRdl_mg allocated yes/no - IF ( ALLOCATED(InData%dRdl_mg) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dRdl_mg upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dRdl_mg) ! dRdl_mg - END IF - Int_BufSz = Int_BufSz + 1 ! dRdl_mg_b allocated yes/no - IF ( ALLOCATED(InData%dRdl_mg_b) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dRdl_mg_b upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dRdl_mg_b) ! dRdl_mg_b - END IF - Int_BufSz = Int_BufSz + 1 ! dRdl_in allocated yes/no - IF ( ALLOCATED(InData%dRdl_in) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dRdl_in upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dRdl_in) ! dRdl_in - END IF - Re_BufSz = Re_BufSz + 1 ! Vinner - Re_BufSz = Re_BufSz + 1 ! Vouter - Re_BufSz = Re_BufSz + 1 ! Vballast - Re_BufSz = Re_BufSz + 1 ! Vsubmerged - Re_BufSz = Re_BufSz + 1 ! l_fill - Re_BufSz = Re_BufSz + 1 ! h_fill - Re_BufSz = Re_BufSz + 1 ! z_overfill - Re_BufSz = Re_BufSz + 1 ! h_floor - Int_BufSz = Int_BufSz + 1 ! i_floor - Int_BufSz = Int_BufSz + 1 ! doEndBuoyancy - Int_BufSz = Int_BufSz + 1 ! memfloodstatus - Int_BufSz = Int_BufSz + 1 ! floodstatus allocated yes/no - IF ( ALLOCATED(InData%floodstatus) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! floodstatus upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%floodstatus) ! floodstatus - END IF - Int_BufSz = Int_BufSz + 1 ! alpha allocated yes/no - IF ( ALLOCATED(InData%alpha) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! alpha upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%alpha) ! alpha - END IF - Int_BufSz = Int_BufSz + 1 ! alpha_fb allocated yes/no - IF ( ALLOCATED(InData%alpha_fb) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! alpha_fb upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%alpha_fb) ! alpha_fb - END IF - Int_BufSz = Int_BufSz + 1 ! alpha_fb_star allocated yes/no - IF ( ALLOCATED(InData%alpha_fb_star) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! alpha_fb_star upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%alpha_fb_star) ! alpha_fb_star - END IF - Int_BufSz = Int_BufSz + 1 ! Cd allocated yes/no - IF ( ALLOCATED(InData%Cd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Cd upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cd) ! Cd - END IF - Int_BufSz = Int_BufSz + 1 ! Ca allocated yes/no - IF ( ALLOCATED(InData%Ca) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Ca upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Ca) ! Ca - END IF - Int_BufSz = Int_BufSz + 1 ! Cp allocated yes/no - IF ( ALLOCATED(InData%Cp) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Cp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cp) ! Cp - END IF - Int_BufSz = Int_BufSz + 1 ! AxCd allocated yes/no - IF ( ALLOCATED(InData%AxCd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AxCd upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AxCd) ! AxCd - END IF - Int_BufSz = Int_BufSz + 1 ! AxCa allocated yes/no - IF ( ALLOCATED(InData%AxCa) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AxCa upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AxCa) ! AxCa - END IF - Int_BufSz = Int_BufSz + 1 ! AxCp allocated yes/no - IF ( ALLOCATED(InData%AxCp) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AxCp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AxCp) ! AxCp - END IF - Int_BufSz = Int_BufSz + 1 ! Cb allocated yes/no - IF ( ALLOCATED(InData%Cb) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Cb upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cb) ! Cb - END IF - Int_BufSz = Int_BufSz + 1 ! m_fb_l allocated yes/no - IF ( ALLOCATED(InData%m_fb_l) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! m_fb_l upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%m_fb_l) ! m_fb_l - END IF - Int_BufSz = Int_BufSz + 1 ! m_fb_u allocated yes/no - IF ( ALLOCATED(InData%m_fb_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! m_fb_u upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%m_fb_u) ! m_fb_u - END IF - Int_BufSz = Int_BufSz + 1 ! h_cfb_l allocated yes/no - IF ( ALLOCATED(InData%h_cfb_l) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! h_cfb_l upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%h_cfb_l) ! h_cfb_l - END IF - Int_BufSz = Int_BufSz + 1 ! h_cfb_u allocated yes/no - IF ( ALLOCATED(InData%h_cfb_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! h_cfb_u upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%h_cfb_u) ! h_cfb_u - END IF - Int_BufSz = Int_BufSz + 1 ! I_lfb_l allocated yes/no - IF ( ALLOCATED(InData%I_lfb_l) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! I_lfb_l upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%I_lfb_l) ! I_lfb_l - END IF - Int_BufSz = Int_BufSz + 1 ! I_lfb_u allocated yes/no - IF ( ALLOCATED(InData%I_lfb_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! I_lfb_u upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%I_lfb_u) ! I_lfb_u - END IF - Int_BufSz = Int_BufSz + 1 ! I_rfb_l allocated yes/no - IF ( ALLOCATED(InData%I_rfb_l) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! I_rfb_l upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%I_rfb_l) ! I_rfb_l - END IF - Int_BufSz = Int_BufSz + 1 ! I_rfb_u allocated yes/no - IF ( ALLOCATED(InData%I_rfb_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! I_rfb_u upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%I_rfb_u) ! I_rfb_u - END IF - Int_BufSz = Int_BufSz + 1 ! m_mg_l allocated yes/no - IF ( ALLOCATED(InData%m_mg_l) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! m_mg_l upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%m_mg_l) ! m_mg_l - END IF - Int_BufSz = Int_BufSz + 1 ! m_mg_u allocated yes/no - IF ( ALLOCATED(InData%m_mg_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! m_mg_u upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%m_mg_u) ! m_mg_u - END IF - Int_BufSz = Int_BufSz + 1 ! h_cmg_l allocated yes/no - IF ( ALLOCATED(InData%h_cmg_l) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! h_cmg_l upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%h_cmg_l) ! h_cmg_l - END IF - Int_BufSz = Int_BufSz + 1 ! h_cmg_u allocated yes/no - IF ( ALLOCATED(InData%h_cmg_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! h_cmg_u upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%h_cmg_u) ! h_cmg_u - END IF - Int_BufSz = Int_BufSz + 1 ! I_lmg_l allocated yes/no - IF ( ALLOCATED(InData%I_lmg_l) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! I_lmg_l upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%I_lmg_l) ! I_lmg_l - END IF - Int_BufSz = Int_BufSz + 1 ! I_lmg_u allocated yes/no - IF ( ALLOCATED(InData%I_lmg_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! I_lmg_u upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%I_lmg_u) ! I_lmg_u - END IF - Int_BufSz = Int_BufSz + 1 ! I_rmg_l allocated yes/no - IF ( ALLOCATED(InData%I_rmg_l) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! I_rmg_l upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%I_rmg_l) ! I_rmg_l - END IF - Int_BufSz = Int_BufSz + 1 ! I_rmg_u allocated yes/no - IF ( ALLOCATED(InData%I_rmg_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! I_rmg_u upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%I_rmg_u) ! I_rmg_u - END IF - Int_BufSz = Int_BufSz + 1 ! Cfl_fb allocated yes/no - IF ( ALLOCATED(InData%Cfl_fb) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Cfl_fb upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cfl_fb) ! Cfl_fb - END IF - Int_BufSz = Int_BufSz + 1 ! Cfr_fb allocated yes/no - IF ( ALLOCATED(InData%Cfr_fb) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Cfr_fb upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cfr_fb) ! Cfr_fb - END IF - Int_BufSz = Int_BufSz + 1 ! CM0_fb allocated yes/no - IF ( ALLOCATED(InData%CM0_fb) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CM0_fb upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CM0_fb) ! CM0_fb - END IF - Re_BufSz = Re_BufSz + 1 ! MGvolume - Re_BufSz = Re_BufSz + 1 ! MDivSize - Int_BufSz = Int_BufSz + 1 ! MCoefMod - Int_BufSz = Int_BufSz + 1 ! MmbrCoefIDIndx - Int_BufSz = Int_BufSz + 1 ! MmbrFilledIDIndx - Int_BufSz = Int_BufSz + 1 ! MHstLMod - Re_BufSz = Re_BufSz + 1 ! FillFSLoc - Re_BufSz = Re_BufSz + 1 ! FillDens - Int_BufSz = Int_BufSz + 1 ! PropPot - Int_BufSz = Int_BufSz + 1 ! PropMCF - Int_BufSz = Int_BufSz + 1 ! Flipped - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%NodeIndx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NodeIndx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodeIndx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NodeIndx,1), UBOUND(InData%NodeIndx,1) - IntKiBuf(Int_Xferred) = InData%NodeIndx(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%MemberID - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NElements - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RefLength - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%cosPhi_ref - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dl - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%k,1), UBOUND(InData%k,1) - ReKiBuf(Re_Xferred) = InData%k(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i2 = LBOUND(InData%kkt,2), UBOUND(InData%kkt,2) - DO i1 = LBOUND(InData%kkt,1), UBOUND(InData%kkt,1) - ReKiBuf(Re_Xferred) = InData%kkt(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%Ak,2), UBOUND(InData%Ak,2) - DO i1 = LBOUND(InData%Ak,1), UBOUND(InData%Ak,1) - ReKiBuf(Re_Xferred) = InData%Ak(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( .NOT. ALLOCATED(InData%R) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%R,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%R,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%R,1), UBOUND(InData%R,1) - ReKiBuf(Re_Xferred) = InData%R(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RMG) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RMG,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RMG,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RMG,1), UBOUND(InData%RMG,1) - ReKiBuf(Re_Xferred) = InData%RMG(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RMGB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RMGB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RMGB,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RMGB,1), UBOUND(InData%RMGB,1) - ReKiBuf(Re_Xferred) = InData%RMGB(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Rin) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Rin,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Rin,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Rin,1), UBOUND(InData%Rin,1) - ReKiBuf(Re_Xferred) = InData%Rin(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%tMG) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%tMG,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tMG,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%tMG,1), UBOUND(InData%tMG,1) - ReKiBuf(Re_Xferred) = InData%tMG(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MGdensity) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MGdensity,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MGdensity,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MGdensity,1), UBOUND(InData%MGdensity,1) - ReKiBuf(Re_Xferred) = InData%MGdensity(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dRdl_mg) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dRdl_mg,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dRdl_mg,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dRdl_mg,1), UBOUND(InData%dRdl_mg,1) - ReKiBuf(Re_Xferred) = InData%dRdl_mg(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dRdl_mg_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%dRdl_mg_b,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dRdl_mg_b,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dRdl_mg_b,1), UBOUND(InData%dRdl_mg_b,1) - ReKiBuf(Re_Xferred) = InData%dRdl_mg_b(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dRdl_in) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dRdl_in,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dRdl_in,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dRdl_in,1), UBOUND(InData%dRdl_in,1) - ReKiBuf(Re_Xferred) = InData%dRdl_in(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%Vinner - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Vouter - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Vballast - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Vsubmerged - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%l_fill - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%h_fill - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%z_overfill - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%h_floor - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%i_floor - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%doEndBuoyancy, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%memfloodstatus - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%floodstatus) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%floodstatus,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%floodstatus,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%floodstatus,1), UBOUND(InData%floodstatus,1) - IntKiBuf(Int_Xferred) = InData%floodstatus(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%alpha) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%alpha,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%alpha,1), UBOUND(InData%alpha,1) - ReKiBuf(Re_Xferred) = InData%alpha(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%alpha_fb) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%alpha_fb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_fb,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%alpha_fb,1), UBOUND(InData%alpha_fb,1) - ReKiBuf(Re_Xferred) = InData%alpha_fb(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%alpha_fb_star) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%alpha_fb_star,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_fb_star,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%alpha_fb_star,1), UBOUND(InData%alpha_fb_star,1) - ReKiBuf(Re_Xferred) = InData%alpha_fb_star(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Cd,1), UBOUND(InData%Cd,1) - ReKiBuf(Re_Xferred) = InData%Cd(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Ca) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ca,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ca,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Ca,1), UBOUND(InData%Ca,1) - ReKiBuf(Re_Xferred) = InData%Ca(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cp,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Cp,1), UBOUND(InData%Cp,1) - ReKiBuf(Re_Xferred) = InData%Cp(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AxCd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AxCd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxCd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AxCd,1), UBOUND(InData%AxCd,1) - ReKiBuf(Re_Xferred) = InData%AxCd(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AxCa) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AxCa,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxCa,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AxCa,1), UBOUND(InData%AxCa,1) - ReKiBuf(Re_Xferred) = InData%AxCa(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AxCp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AxCp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxCp,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AxCp,1), UBOUND(InData%AxCp,1) - ReKiBuf(Re_Xferred) = InData%AxCp(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cb) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cb,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Cb,1), UBOUND(InData%Cb,1) - ReKiBuf(Re_Xferred) = InData%Cb(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%m_fb_l) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%m_fb_l,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m_fb_l,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%m_fb_l,1), UBOUND(InData%m_fb_l,1) - ReKiBuf(Re_Xferred) = InData%m_fb_l(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%m_fb_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%m_fb_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m_fb_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%m_fb_u,1), UBOUND(InData%m_fb_u,1) - ReKiBuf(Re_Xferred) = InData%m_fb_u(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%h_cfb_l) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%h_cfb_l,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%h_cfb_l,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%h_cfb_l,1), UBOUND(InData%h_cfb_l,1) - ReKiBuf(Re_Xferred) = InData%h_cfb_l(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%h_cfb_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%h_cfb_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%h_cfb_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%h_cfb_u,1), UBOUND(InData%h_cfb_u,1) - ReKiBuf(Re_Xferred) = InData%h_cfb_u(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%I_lfb_l) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%I_lfb_l,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%I_lfb_l,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%I_lfb_l,1), UBOUND(InData%I_lfb_l,1) - ReKiBuf(Re_Xferred) = InData%I_lfb_l(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%I_lfb_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%I_lfb_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%I_lfb_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%I_lfb_u,1), UBOUND(InData%I_lfb_u,1) - ReKiBuf(Re_Xferred) = InData%I_lfb_u(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%I_rfb_l) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%I_rfb_l,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%I_rfb_l,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%I_rfb_l,1), UBOUND(InData%I_rfb_l,1) - ReKiBuf(Re_Xferred) = InData%I_rfb_l(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%I_rfb_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%I_rfb_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%I_rfb_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%I_rfb_u,1), UBOUND(InData%I_rfb_u,1) - ReKiBuf(Re_Xferred) = InData%I_rfb_u(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%m_mg_l) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%m_mg_l,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m_mg_l,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%m_mg_l,1), UBOUND(InData%m_mg_l,1) - ReKiBuf(Re_Xferred) = InData%m_mg_l(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%m_mg_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%m_mg_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m_mg_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%m_mg_u,1), UBOUND(InData%m_mg_u,1) - ReKiBuf(Re_Xferred) = InData%m_mg_u(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%h_cmg_l) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%h_cmg_l,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%h_cmg_l,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%h_cmg_l,1), UBOUND(InData%h_cmg_l,1) - ReKiBuf(Re_Xferred) = InData%h_cmg_l(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%h_cmg_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%h_cmg_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%h_cmg_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%h_cmg_u,1), UBOUND(InData%h_cmg_u,1) - ReKiBuf(Re_Xferred) = InData%h_cmg_u(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%I_lmg_l) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%I_lmg_l,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%I_lmg_l,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%I_lmg_l,1), UBOUND(InData%I_lmg_l,1) - ReKiBuf(Re_Xferred) = InData%I_lmg_l(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%I_lmg_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%I_lmg_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%I_lmg_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%I_lmg_u,1), UBOUND(InData%I_lmg_u,1) - ReKiBuf(Re_Xferred) = InData%I_lmg_u(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%I_rmg_l) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%I_rmg_l,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%I_rmg_l,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%I_rmg_l,1), UBOUND(InData%I_rmg_l,1) - ReKiBuf(Re_Xferred) = InData%I_rmg_l(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%I_rmg_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%I_rmg_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%I_rmg_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%I_rmg_u,1), UBOUND(InData%I_rmg_u,1) - ReKiBuf(Re_Xferred) = InData%I_rmg_u(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cfl_fb) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cfl_fb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cfl_fb,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Cfl_fb,1), UBOUND(InData%Cfl_fb,1) - ReKiBuf(Re_Xferred) = InData%Cfl_fb(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cfr_fb) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cfr_fb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cfr_fb,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Cfr_fb,1), UBOUND(InData%Cfr_fb,1) - ReKiBuf(Re_Xferred) = InData%Cfr_fb(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CM0_fb) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CM0_fb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CM0_fb,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CM0_fb,1), UBOUND(InData%CM0_fb,1) - ReKiBuf(Re_Xferred) = InData%CM0_fb(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%MGvolume - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MDivSize - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MCoefMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MmbrCoefIDIndx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MmbrFilledIDIndx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MHstLMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FillFSLoc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FillDens - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%PropPot, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%PropMCF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Flipped, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Morison_PackMemberType - - SUBROUTINE Morison_UnPackMemberType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Morison_MemberType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackMemberType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodeIndx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NodeIndx)) DEALLOCATE(OutData%NodeIndx) - ALLOCATE(OutData%NodeIndx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeIndx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NodeIndx,1), UBOUND(OutData%NodeIndx,1) - OutData%NodeIndx(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%MemberID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NElements = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%RefLength = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%cosPhi_ref = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%k,1) - i1_u = UBOUND(OutData%k,1) - DO i1 = LBOUND(OutData%k,1), UBOUND(OutData%k,1) - OutData%k(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%kkt,1) - i1_u = UBOUND(OutData%kkt,1) - i2_l = LBOUND(OutData%kkt,2) - i2_u = UBOUND(OutData%kkt,2) - DO i2 = LBOUND(OutData%kkt,2), UBOUND(OutData%kkt,2) - DO i1 = LBOUND(OutData%kkt,1), UBOUND(OutData%kkt,1) - OutData%kkt(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%Ak,1) - i1_u = UBOUND(OutData%Ak,1) - i2_l = LBOUND(OutData%Ak,2) - i2_u = UBOUND(OutData%Ak,2) - DO i2 = LBOUND(OutData%Ak,2), UBOUND(OutData%Ak,2) - DO i1 = LBOUND(OutData%Ak,1), UBOUND(OutData%Ak,1) - OutData%Ak(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! R not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%R)) DEALLOCATE(OutData%R) - ALLOCATE(OutData%R(i1_l:i1_u),STAT=ErrStat2) + +subroutine Morison_PackMemberType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Morison_MemberType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackMemberType' + if (Buf%ErrStat >= AbortErrLev) return + ! NodeIndx + call RegPack(Buf, allocated(InData%NodeIndx)) + if (allocated(InData%NodeIndx)) then + call RegPackBounds(Buf, 1, lbound(InData%NodeIndx), ubound(InData%NodeIndx)) + call RegPack(Buf, InData%NodeIndx) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MemberID + call RegPack(Buf, InData%MemberID) + if (RegCheckErr(Buf, RoutineName)) return + ! NElements + call RegPack(Buf, InData%NElements) + if (RegCheckErr(Buf, RoutineName)) return + ! RefLength + call RegPack(Buf, InData%RefLength) + if (RegCheckErr(Buf, RoutineName)) return + ! cosPhi_ref + call RegPack(Buf, InData%cosPhi_ref) + if (RegCheckErr(Buf, RoutineName)) return + ! dl + call RegPack(Buf, InData%dl) + if (RegCheckErr(Buf, RoutineName)) return + ! k + call RegPack(Buf, InData%k) + if (RegCheckErr(Buf, RoutineName)) return + ! kkt + call RegPack(Buf, InData%kkt) + if (RegCheckErr(Buf, RoutineName)) return + ! Ak + call RegPack(Buf, InData%Ak) + if (RegCheckErr(Buf, RoutineName)) return + ! R + call RegPack(Buf, allocated(InData%R)) + if (allocated(InData%R)) then + call RegPackBounds(Buf, 1, lbound(InData%R), ubound(InData%R)) + call RegPack(Buf, InData%R) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RMG + call RegPack(Buf, allocated(InData%RMG)) + if (allocated(InData%RMG)) then + call RegPackBounds(Buf, 1, lbound(InData%RMG), ubound(InData%RMG)) + call RegPack(Buf, InData%RMG) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RMGB + call RegPack(Buf, allocated(InData%RMGB)) + if (allocated(InData%RMGB)) then + call RegPackBounds(Buf, 1, lbound(InData%RMGB), ubound(InData%RMGB)) + call RegPack(Buf, InData%RMGB) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Rin + call RegPack(Buf, allocated(InData%Rin)) + if (allocated(InData%Rin)) then + call RegPackBounds(Buf, 1, lbound(InData%Rin), ubound(InData%Rin)) + call RegPack(Buf, InData%Rin) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! tMG + call RegPack(Buf, allocated(InData%tMG)) + if (allocated(InData%tMG)) then + call RegPackBounds(Buf, 1, lbound(InData%tMG), ubound(InData%tMG)) + call RegPack(Buf, InData%tMG) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MGdensity + call RegPack(Buf, allocated(InData%MGdensity)) + if (allocated(InData%MGdensity)) then + call RegPackBounds(Buf, 1, lbound(InData%MGdensity), ubound(InData%MGdensity)) + call RegPack(Buf, InData%MGdensity) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! dRdl_mg + call RegPack(Buf, allocated(InData%dRdl_mg)) + if (allocated(InData%dRdl_mg)) then + call RegPackBounds(Buf, 1, lbound(InData%dRdl_mg), ubound(InData%dRdl_mg)) + call RegPack(Buf, InData%dRdl_mg) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! dRdl_mg_b + call RegPack(Buf, allocated(InData%dRdl_mg_b)) + if (allocated(InData%dRdl_mg_b)) then + call RegPackBounds(Buf, 1, lbound(InData%dRdl_mg_b), ubound(InData%dRdl_mg_b)) + call RegPack(Buf, InData%dRdl_mg_b) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! dRdl_in + call RegPack(Buf, allocated(InData%dRdl_in)) + if (allocated(InData%dRdl_in)) then + call RegPackBounds(Buf, 1, lbound(InData%dRdl_in), ubound(InData%dRdl_in)) + call RegPack(Buf, InData%dRdl_in) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Vinner + call RegPack(Buf, InData%Vinner) + if (RegCheckErr(Buf, RoutineName)) return + ! Vouter + call RegPack(Buf, InData%Vouter) + if (RegCheckErr(Buf, RoutineName)) return + ! Vballast + call RegPack(Buf, InData%Vballast) + if (RegCheckErr(Buf, RoutineName)) return + ! Vsubmerged + call RegPack(Buf, InData%Vsubmerged) + if (RegCheckErr(Buf, RoutineName)) return + ! l_fill + call RegPack(Buf, InData%l_fill) + if (RegCheckErr(Buf, RoutineName)) return + ! h_fill + call RegPack(Buf, InData%h_fill) + if (RegCheckErr(Buf, RoutineName)) return + ! z_overfill + call RegPack(Buf, InData%z_overfill) + if (RegCheckErr(Buf, RoutineName)) return + ! h_floor + call RegPack(Buf, InData%h_floor) + if (RegCheckErr(Buf, RoutineName)) return + ! i_floor + call RegPack(Buf, InData%i_floor) + if (RegCheckErr(Buf, RoutineName)) return + ! doEndBuoyancy + call RegPack(Buf, InData%doEndBuoyancy) + if (RegCheckErr(Buf, RoutineName)) return + ! memfloodstatus + call RegPack(Buf, InData%memfloodstatus) + if (RegCheckErr(Buf, RoutineName)) return + ! floodstatus + call RegPack(Buf, allocated(InData%floodstatus)) + if (allocated(InData%floodstatus)) then + call RegPackBounds(Buf, 1, lbound(InData%floodstatus), ubound(InData%floodstatus)) + call RegPack(Buf, InData%floodstatus) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! alpha + call RegPack(Buf, allocated(InData%alpha)) + if (allocated(InData%alpha)) then + call RegPackBounds(Buf, 1, lbound(InData%alpha), ubound(InData%alpha)) + call RegPack(Buf, InData%alpha) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! alpha_fb + call RegPack(Buf, allocated(InData%alpha_fb)) + if (allocated(InData%alpha_fb)) then + call RegPackBounds(Buf, 1, lbound(InData%alpha_fb), ubound(InData%alpha_fb)) + call RegPack(Buf, InData%alpha_fb) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! alpha_fb_star + call RegPack(Buf, allocated(InData%alpha_fb_star)) + if (allocated(InData%alpha_fb_star)) then + call RegPackBounds(Buf, 1, lbound(InData%alpha_fb_star), ubound(InData%alpha_fb_star)) + call RegPack(Buf, InData%alpha_fb_star) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Cd + call RegPack(Buf, allocated(InData%Cd)) + if (allocated(InData%Cd)) then + call RegPackBounds(Buf, 1, lbound(InData%Cd), ubound(InData%Cd)) + call RegPack(Buf, InData%Cd) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Ca + call RegPack(Buf, allocated(InData%Ca)) + if (allocated(InData%Ca)) then + call RegPackBounds(Buf, 1, lbound(InData%Ca), ubound(InData%Ca)) + call RegPack(Buf, InData%Ca) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Cp + call RegPack(Buf, allocated(InData%Cp)) + if (allocated(InData%Cp)) then + call RegPackBounds(Buf, 1, lbound(InData%Cp), ubound(InData%Cp)) + call RegPack(Buf, InData%Cp) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AxCd + call RegPack(Buf, allocated(InData%AxCd)) + if (allocated(InData%AxCd)) then + call RegPackBounds(Buf, 1, lbound(InData%AxCd), ubound(InData%AxCd)) + call RegPack(Buf, InData%AxCd) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AxCa + call RegPack(Buf, allocated(InData%AxCa)) + if (allocated(InData%AxCa)) then + call RegPackBounds(Buf, 1, lbound(InData%AxCa), ubound(InData%AxCa)) + call RegPack(Buf, InData%AxCa) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AxCp + call RegPack(Buf, allocated(InData%AxCp)) + if (allocated(InData%AxCp)) then + call RegPackBounds(Buf, 1, lbound(InData%AxCp), ubound(InData%AxCp)) + call RegPack(Buf, InData%AxCp) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Cb + call RegPack(Buf, allocated(InData%Cb)) + if (allocated(InData%Cb)) then + call RegPackBounds(Buf, 1, lbound(InData%Cb), ubound(InData%Cb)) + call RegPack(Buf, InData%Cb) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! m_fb_l + call RegPack(Buf, allocated(InData%m_fb_l)) + if (allocated(InData%m_fb_l)) then + call RegPackBounds(Buf, 1, lbound(InData%m_fb_l), ubound(InData%m_fb_l)) + call RegPack(Buf, InData%m_fb_l) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! m_fb_u + call RegPack(Buf, allocated(InData%m_fb_u)) + if (allocated(InData%m_fb_u)) then + call RegPackBounds(Buf, 1, lbound(InData%m_fb_u), ubound(InData%m_fb_u)) + call RegPack(Buf, InData%m_fb_u) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! h_cfb_l + call RegPack(Buf, allocated(InData%h_cfb_l)) + if (allocated(InData%h_cfb_l)) then + call RegPackBounds(Buf, 1, lbound(InData%h_cfb_l), ubound(InData%h_cfb_l)) + call RegPack(Buf, InData%h_cfb_l) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! h_cfb_u + call RegPack(Buf, allocated(InData%h_cfb_u)) + if (allocated(InData%h_cfb_u)) then + call RegPackBounds(Buf, 1, lbound(InData%h_cfb_u), ubound(InData%h_cfb_u)) + call RegPack(Buf, InData%h_cfb_u) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! I_lfb_l + call RegPack(Buf, allocated(InData%I_lfb_l)) + if (allocated(InData%I_lfb_l)) then + call RegPackBounds(Buf, 1, lbound(InData%I_lfb_l), ubound(InData%I_lfb_l)) + call RegPack(Buf, InData%I_lfb_l) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! I_lfb_u + call RegPack(Buf, allocated(InData%I_lfb_u)) + if (allocated(InData%I_lfb_u)) then + call RegPackBounds(Buf, 1, lbound(InData%I_lfb_u), ubound(InData%I_lfb_u)) + call RegPack(Buf, InData%I_lfb_u) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! I_rfb_l + call RegPack(Buf, allocated(InData%I_rfb_l)) + if (allocated(InData%I_rfb_l)) then + call RegPackBounds(Buf, 1, lbound(InData%I_rfb_l), ubound(InData%I_rfb_l)) + call RegPack(Buf, InData%I_rfb_l) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! I_rfb_u + call RegPack(Buf, allocated(InData%I_rfb_u)) + if (allocated(InData%I_rfb_u)) then + call RegPackBounds(Buf, 1, lbound(InData%I_rfb_u), ubound(InData%I_rfb_u)) + call RegPack(Buf, InData%I_rfb_u) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! m_mg_l + call RegPack(Buf, allocated(InData%m_mg_l)) + if (allocated(InData%m_mg_l)) then + call RegPackBounds(Buf, 1, lbound(InData%m_mg_l), ubound(InData%m_mg_l)) + call RegPack(Buf, InData%m_mg_l) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! m_mg_u + call RegPack(Buf, allocated(InData%m_mg_u)) + if (allocated(InData%m_mg_u)) then + call RegPackBounds(Buf, 1, lbound(InData%m_mg_u), ubound(InData%m_mg_u)) + call RegPack(Buf, InData%m_mg_u) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! h_cmg_l + call RegPack(Buf, allocated(InData%h_cmg_l)) + if (allocated(InData%h_cmg_l)) then + call RegPackBounds(Buf, 1, lbound(InData%h_cmg_l), ubound(InData%h_cmg_l)) + call RegPack(Buf, InData%h_cmg_l) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! h_cmg_u + call RegPack(Buf, allocated(InData%h_cmg_u)) + if (allocated(InData%h_cmg_u)) then + call RegPackBounds(Buf, 1, lbound(InData%h_cmg_u), ubound(InData%h_cmg_u)) + call RegPack(Buf, InData%h_cmg_u) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! I_lmg_l + call RegPack(Buf, allocated(InData%I_lmg_l)) + if (allocated(InData%I_lmg_l)) then + call RegPackBounds(Buf, 1, lbound(InData%I_lmg_l), ubound(InData%I_lmg_l)) + call RegPack(Buf, InData%I_lmg_l) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! I_lmg_u + call RegPack(Buf, allocated(InData%I_lmg_u)) + if (allocated(InData%I_lmg_u)) then + call RegPackBounds(Buf, 1, lbound(InData%I_lmg_u), ubound(InData%I_lmg_u)) + call RegPack(Buf, InData%I_lmg_u) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! I_rmg_l + call RegPack(Buf, allocated(InData%I_rmg_l)) + if (allocated(InData%I_rmg_l)) then + call RegPackBounds(Buf, 1, lbound(InData%I_rmg_l), ubound(InData%I_rmg_l)) + call RegPack(Buf, InData%I_rmg_l) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! I_rmg_u + call RegPack(Buf, allocated(InData%I_rmg_u)) + if (allocated(InData%I_rmg_u)) then + call RegPackBounds(Buf, 1, lbound(InData%I_rmg_u), ubound(InData%I_rmg_u)) + call RegPack(Buf, InData%I_rmg_u) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Cfl_fb + call RegPack(Buf, allocated(InData%Cfl_fb)) + if (allocated(InData%Cfl_fb)) then + call RegPackBounds(Buf, 1, lbound(InData%Cfl_fb), ubound(InData%Cfl_fb)) + call RegPack(Buf, InData%Cfl_fb) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Cfr_fb + call RegPack(Buf, allocated(InData%Cfr_fb)) + if (allocated(InData%Cfr_fb)) then + call RegPackBounds(Buf, 1, lbound(InData%Cfr_fb), ubound(InData%Cfr_fb)) + call RegPack(Buf, InData%Cfr_fb) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CM0_fb + call RegPack(Buf, allocated(InData%CM0_fb)) + if (allocated(InData%CM0_fb)) then + call RegPackBounds(Buf, 1, lbound(InData%CM0_fb), ubound(InData%CM0_fb)) + call RegPack(Buf, InData%CM0_fb) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MGvolume + call RegPack(Buf, InData%MGvolume) + if (RegCheckErr(Buf, RoutineName)) return + ! MDivSize + call RegPack(Buf, InData%MDivSize) + if (RegCheckErr(Buf, RoutineName)) return + ! MCoefMod + call RegPack(Buf, InData%MCoefMod) + if (RegCheckErr(Buf, RoutineName)) return + ! MmbrCoefIDIndx + call RegPack(Buf, InData%MmbrCoefIDIndx) + if (RegCheckErr(Buf, RoutineName)) return + ! MmbrFilledIDIndx + call RegPack(Buf, InData%MmbrFilledIDIndx) + if (RegCheckErr(Buf, RoutineName)) return + ! MHstLMod + call RegPack(Buf, InData%MHstLMod) + if (RegCheckErr(Buf, RoutineName)) return + ! FillFSLoc + call RegPack(Buf, InData%FillFSLoc) + if (RegCheckErr(Buf, RoutineName)) return + ! FillDens + call RegPack(Buf, InData%FillDens) + if (RegCheckErr(Buf, RoutineName)) return + ! PropPot + call RegPack(Buf, InData%PropPot) + if (RegCheckErr(Buf, RoutineName)) return + ! PropMCF + call RegPack(Buf, InData%PropMCF) + if (RegCheckErr(Buf, RoutineName)) return + ! Flipped + call RegPack(Buf, InData%Flipped) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_UnPackMemberType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Morison_MemberType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackMemberType' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! NodeIndx + if (allocated(OutData%NodeIndx)) deallocate(OutData%NodeIndx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NodeIndx(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeIndx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%NodeIndx) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! MemberID + call RegUnpack(Buf, OutData%MemberID) + if (RegCheckErr(Buf, RoutineName)) return + ! NElements + call RegUnpack(Buf, OutData%NElements) + if (RegCheckErr(Buf, RoutineName)) return + ! RefLength + call RegUnpack(Buf, OutData%RefLength) + if (RegCheckErr(Buf, RoutineName)) return + ! cosPhi_ref + call RegUnpack(Buf, OutData%cosPhi_ref) + if (RegCheckErr(Buf, RoutineName)) return + ! dl + call RegUnpack(Buf, OutData%dl) + if (RegCheckErr(Buf, RoutineName)) return + ! k + call RegUnpack(Buf, OutData%k) + if (RegCheckErr(Buf, RoutineName)) return + ! kkt + call RegUnpack(Buf, OutData%kkt) + if (RegCheckErr(Buf, RoutineName)) return + ! Ak + call RegUnpack(Buf, OutData%Ak) + if (RegCheckErr(Buf, RoutineName)) return + ! R + if (allocated(OutData%R)) deallocate(OutData%R) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%R(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%R.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%R) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RMG + if (allocated(OutData%RMG)) deallocate(OutData%RMG) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RMG(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RMG.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RMG) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RMGB + if (allocated(OutData%RMGB)) deallocate(OutData%RMGB) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RMGB(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RMGB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RMGB) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Rin + if (allocated(OutData%Rin)) deallocate(OutData%Rin) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Rin(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Rin.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Rin) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! tMG + if (allocated(OutData%tMG)) deallocate(OutData%tMG) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%tMG(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%tMG.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%tMG) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! MGdensity + if (allocated(OutData%MGdensity)) deallocate(OutData%MGdensity) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MGdensity(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MGdensity.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MGdensity) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! dRdl_mg + if (allocated(OutData%dRdl_mg)) deallocate(OutData%dRdl_mg) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dRdl_mg(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dRdl_mg.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dRdl_mg) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! dRdl_mg_b + if (allocated(OutData%dRdl_mg_b)) deallocate(OutData%dRdl_mg_b) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dRdl_mg_b(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dRdl_mg_b.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dRdl_mg_b) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! dRdl_in + if (allocated(OutData%dRdl_in)) deallocate(OutData%dRdl_in) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dRdl_in(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dRdl_in.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dRdl_in) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Vinner + call RegUnpack(Buf, OutData%Vinner) + if (RegCheckErr(Buf, RoutineName)) return + ! Vouter + call RegUnpack(Buf, OutData%Vouter) + if (RegCheckErr(Buf, RoutineName)) return + ! Vballast + call RegUnpack(Buf, OutData%Vballast) + if (RegCheckErr(Buf, RoutineName)) return + ! Vsubmerged + call RegUnpack(Buf, OutData%Vsubmerged) + if (RegCheckErr(Buf, RoutineName)) return + ! l_fill + call RegUnpack(Buf, OutData%l_fill) + if (RegCheckErr(Buf, RoutineName)) return + ! h_fill + call RegUnpack(Buf, OutData%h_fill) + if (RegCheckErr(Buf, RoutineName)) return + ! z_overfill + call RegUnpack(Buf, OutData%z_overfill) + if (RegCheckErr(Buf, RoutineName)) return + ! h_floor + call RegUnpack(Buf, OutData%h_floor) + if (RegCheckErr(Buf, RoutineName)) return + ! i_floor + call RegUnpack(Buf, OutData%i_floor) + if (RegCheckErr(Buf, RoutineName)) return + ! doEndBuoyancy + call RegUnpack(Buf, OutData%doEndBuoyancy) + if (RegCheckErr(Buf, RoutineName)) return + ! memfloodstatus + call RegUnpack(Buf, OutData%memfloodstatus) + if (RegCheckErr(Buf, RoutineName)) return + ! floodstatus + if (allocated(OutData%floodstatus)) deallocate(OutData%floodstatus) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%floodstatus(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%floodstatus.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%floodstatus) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! alpha + if (allocated(OutData%alpha)) deallocate(OutData%alpha) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%alpha(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%alpha) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! alpha_fb + if (allocated(OutData%alpha_fb)) deallocate(OutData%alpha_fb) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%alpha_fb(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_fb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%alpha_fb) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! alpha_fb_star + if (allocated(OutData%alpha_fb_star)) deallocate(OutData%alpha_fb_star) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%alpha_fb_star(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_fb_star.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%alpha_fb_star) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Cd + if (allocated(OutData%Cd)) deallocate(OutData%Cd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Cd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Cd) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Ca + if (allocated(OutData%Ca)) deallocate(OutData%Ca) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Ca(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ca.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Ca) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Cp + if (allocated(OutData%Cp)) deallocate(OutData%Cp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Cp(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Cp) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AxCd + if (allocated(OutData%AxCd)) deallocate(OutData%AxCd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AxCd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxCd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AxCd) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AxCa + if (allocated(OutData%AxCa)) deallocate(OutData%AxCa) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AxCa(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxCa.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AxCa) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AxCp + if (allocated(OutData%AxCp)) deallocate(OutData%AxCp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AxCp(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxCp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AxCp) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Cb + if (allocated(OutData%Cb)) deallocate(OutData%Cb) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Cb(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Cb) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! m_fb_l + if (allocated(OutData%m_fb_l)) deallocate(OutData%m_fb_l) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%m_fb_l(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%m_fb_l.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%m_fb_l) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! m_fb_u + if (allocated(OutData%m_fb_u)) deallocate(OutData%m_fb_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%m_fb_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%m_fb_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%m_fb_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! h_cfb_l + if (allocated(OutData%h_cfb_l)) deallocate(OutData%h_cfb_l) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%h_cfb_l(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%h_cfb_l.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%h_cfb_l) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! h_cfb_u + if (allocated(OutData%h_cfb_u)) deallocate(OutData%h_cfb_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%h_cfb_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%h_cfb_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%h_cfb_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! I_lfb_l + if (allocated(OutData%I_lfb_l)) deallocate(OutData%I_lfb_l) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%I_lfb_l(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_lfb_l.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%I_lfb_l) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! I_lfb_u + if (allocated(OutData%I_lfb_u)) deallocate(OutData%I_lfb_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%I_lfb_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_lfb_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%I_lfb_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! I_rfb_l + if (allocated(OutData%I_rfb_l)) deallocate(OutData%I_rfb_l) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%I_rfb_l(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_rfb_l.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%I_rfb_l) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! I_rfb_u + if (allocated(OutData%I_rfb_u)) deallocate(OutData%I_rfb_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%I_rfb_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_rfb_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%I_rfb_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! m_mg_l + if (allocated(OutData%m_mg_l)) deallocate(OutData%m_mg_l) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%m_mg_l(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%m_mg_l.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%m_mg_l) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! m_mg_u + if (allocated(OutData%m_mg_u)) deallocate(OutData%m_mg_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%m_mg_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%m_mg_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%m_mg_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! h_cmg_l + if (allocated(OutData%h_cmg_l)) deallocate(OutData%h_cmg_l) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%h_cmg_l(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%h_cmg_l.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%h_cmg_l) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! h_cmg_u + if (allocated(OutData%h_cmg_u)) deallocate(OutData%h_cmg_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%h_cmg_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%h_cmg_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%h_cmg_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! I_lmg_l + if (allocated(OutData%I_lmg_l)) deallocate(OutData%I_lmg_l) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%I_lmg_l(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_lmg_l.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%I_lmg_l) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! I_lmg_u + if (allocated(OutData%I_lmg_u)) deallocate(OutData%I_lmg_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%I_lmg_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_lmg_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%I_lmg_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! I_rmg_l + if (allocated(OutData%I_rmg_l)) deallocate(OutData%I_rmg_l) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%I_rmg_l(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_rmg_l.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%I_rmg_l) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! I_rmg_u + if (allocated(OutData%I_rmg_u)) deallocate(OutData%I_rmg_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%I_rmg_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_rmg_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%I_rmg_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Cfl_fb + if (allocated(OutData%Cfl_fb)) deallocate(OutData%Cfl_fb) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Cfl_fb(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cfl_fb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Cfl_fb) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Cfr_fb + if (allocated(OutData%Cfr_fb)) deallocate(OutData%Cfr_fb) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Cfr_fb(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cfr_fb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Cfr_fb) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CM0_fb + if (allocated(OutData%CM0_fb)) deallocate(OutData%CM0_fb) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CM0_fb(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CM0_fb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CM0_fb) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! MGvolume + call RegUnpack(Buf, OutData%MGvolume) + if (RegCheckErr(Buf, RoutineName)) return + ! MDivSize + call RegUnpack(Buf, OutData%MDivSize) + if (RegCheckErr(Buf, RoutineName)) return + ! MCoefMod + call RegUnpack(Buf, OutData%MCoefMod) + if (RegCheckErr(Buf, RoutineName)) return + ! MmbrCoefIDIndx + call RegUnpack(Buf, OutData%MmbrCoefIDIndx) + if (RegCheckErr(Buf, RoutineName)) return + ! MmbrFilledIDIndx + call RegUnpack(Buf, OutData%MmbrFilledIDIndx) + if (RegCheckErr(Buf, RoutineName)) return + ! MHstLMod + call RegUnpack(Buf, OutData%MHstLMod) + if (RegCheckErr(Buf, RoutineName)) return + ! FillFSLoc + call RegUnpack(Buf, OutData%FillFSLoc) + if (RegCheckErr(Buf, RoutineName)) return + ! FillDens + call RegUnpack(Buf, OutData%FillDens) + if (RegCheckErr(Buf, RoutineName)) return + ! PropPot + call RegUnpack(Buf, OutData%PropPot) + if (RegCheckErr(Buf, RoutineName)) return + ! PropMCF + call RegUnpack(Buf, OutData%PropMCF) + if (RegCheckErr(Buf, RoutineName)) return + ! Flipped + call RegUnpack(Buf, OutData%Flipped) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + SUBROUTINE Morison_CopyMemberLoads( SrcMemberLoadsData, DstMemberLoadsData, CtrlCode, ErrStat, ErrMsg ) + TYPE(Morison_MemberLoads), INTENT(IN) :: SrcMemberLoadsData + TYPE(Morison_MemberLoads), INTENT(INOUT) :: DstMemberLoadsData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Morison_CopyMemberLoads' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcMemberLoadsData%F_D)) THEN + i1_l = LBOUND(SrcMemberLoadsData%F_D,1) + i1_u = UBOUND(SrcMemberLoadsData%F_D,1) + i2_l = LBOUND(SrcMemberLoadsData%F_D,2) + i2_u = UBOUND(SrcMemberLoadsData%F_D,2) + IF (.NOT. ALLOCATED(DstMemberLoadsData%F_D)) THEN + ALLOCATE(DstMemberLoadsData%F_D(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%R.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_D.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%R,1), UBOUND(OutData%R,1) - OutData%R(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RMG not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RMG)) DEALLOCATE(OutData%RMG) - ALLOCATE(OutData%RMG(i1_l:i1_u),STAT=ErrStat2) + DstMemberLoadsData%F_D = SrcMemberLoadsData%F_D +ENDIF +IF (ALLOCATED(SrcMemberLoadsData%F_I)) THEN + i1_l = LBOUND(SrcMemberLoadsData%F_I,1) + i1_u = UBOUND(SrcMemberLoadsData%F_I,1) + i2_l = LBOUND(SrcMemberLoadsData%F_I,2) + i2_u = UBOUND(SrcMemberLoadsData%F_I,2) + IF (.NOT. ALLOCATED(DstMemberLoadsData%F_I)) THEN + ALLOCATE(DstMemberLoadsData%F_I(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RMG.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_I.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%RMG,1), UBOUND(OutData%RMG,1) - OutData%RMG(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RMGB not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RMGB)) DEALLOCATE(OutData%RMGB) - ALLOCATE(OutData%RMGB(i1_l:i1_u),STAT=ErrStat2) + DstMemberLoadsData%F_I = SrcMemberLoadsData%F_I +ENDIF +IF (ALLOCATED(SrcMemberLoadsData%F_A)) THEN + i1_l = LBOUND(SrcMemberLoadsData%F_A,1) + i1_u = UBOUND(SrcMemberLoadsData%F_A,1) + i2_l = LBOUND(SrcMemberLoadsData%F_A,2) + i2_u = UBOUND(SrcMemberLoadsData%F_A,2) + IF (.NOT. ALLOCATED(DstMemberLoadsData%F_A)) THEN + ALLOCATE(DstMemberLoadsData%F_A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RMGB.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_A.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%RMGB,1), UBOUND(OutData%RMGB,1) - OutData%RMGB(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Rin not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Rin)) DEALLOCATE(OutData%Rin) - ALLOCATE(OutData%Rin(i1_l:i1_u),STAT=ErrStat2) + DstMemberLoadsData%F_A = SrcMemberLoadsData%F_A +ENDIF +IF (ALLOCATED(SrcMemberLoadsData%F_B)) THEN + i1_l = LBOUND(SrcMemberLoadsData%F_B,1) + i1_u = UBOUND(SrcMemberLoadsData%F_B,1) + i2_l = LBOUND(SrcMemberLoadsData%F_B,2) + i2_u = UBOUND(SrcMemberLoadsData%F_B,2) + IF (.NOT. ALLOCATED(DstMemberLoadsData%F_B)) THEN + ALLOCATE(DstMemberLoadsData%F_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Rin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Rin,1), UBOUND(OutData%Rin,1) - OutData%Rin(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! tMG not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%tMG)) DEALLOCATE(OutData%tMG) - ALLOCATE(OutData%tMG(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%tMG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%tMG,1), UBOUND(OutData%tMG,1) - OutData%tMG(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MGdensity not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MGdensity)) DEALLOCATE(OutData%MGdensity) - ALLOCATE(OutData%MGdensity(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MGdensity.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MGdensity,1), UBOUND(OutData%MGdensity,1) - OutData%MGdensity(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dRdl_mg not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%dRdl_mg)) DEALLOCATE(OutData%dRdl_mg) - ALLOCATE(OutData%dRdl_mg(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dRdl_mg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dRdl_mg,1), UBOUND(OutData%dRdl_mg,1) - OutData%dRdl_mg(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dRdl_mg_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%dRdl_mg_b)) DEALLOCATE(OutData%dRdl_mg_b) - ALLOCATE(OutData%dRdl_mg_b(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dRdl_mg_b.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dRdl_mg_b,1), UBOUND(OutData%dRdl_mg_b,1) - OutData%dRdl_mg_b(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dRdl_in not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%dRdl_in)) DEALLOCATE(OutData%dRdl_in) - ALLOCATE(OutData%dRdl_in(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dRdl_in.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dRdl_in,1), UBOUND(OutData%dRdl_in,1) - OutData%dRdl_in(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Vinner = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Vouter = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Vballast = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Vsubmerged = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%l_fill = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%h_fill = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%z_overfill = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%h_floor = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%i_floor = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%doEndBuoyancy = TRANSFER(IntKiBuf(Int_Xferred), OutData%doEndBuoyancy) - Int_Xferred = Int_Xferred + 1 - OutData%memfloodstatus = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! floodstatus not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%floodstatus)) DEALLOCATE(OutData%floodstatus) - ALLOCATE(OutData%floodstatus(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%floodstatus.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%floodstatus,1), UBOUND(OutData%floodstatus,1) - OutData%floodstatus(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! alpha not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%alpha)) DEALLOCATE(OutData%alpha) - ALLOCATE(OutData%alpha(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%alpha,1), UBOUND(OutData%alpha,1) - OutData%alpha(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! alpha_fb not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%alpha_fb)) DEALLOCATE(OutData%alpha_fb) - ALLOCATE(OutData%alpha_fb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_fb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%alpha_fb,1), UBOUND(OutData%alpha_fb,1) - OutData%alpha_fb(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! alpha_fb_star not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%alpha_fb_star)) DEALLOCATE(OutData%alpha_fb_star) - ALLOCATE(OutData%alpha_fb_star(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_fb_star.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%alpha_fb_star,1), UBOUND(OutData%alpha_fb_star,1) - OutData%alpha_fb_star(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cd not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Cd)) DEALLOCATE(OutData%Cd) - ALLOCATE(OutData%Cd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Cd,1), UBOUND(OutData%Cd,1) - OutData%Cd(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ca not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Ca)) DEALLOCATE(OutData%Ca) - ALLOCATE(OutData%Ca(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ca.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Ca,1), UBOUND(OutData%Ca,1) - OutData%Ca(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cp not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Cp)) DEALLOCATE(OutData%Cp) - ALLOCATE(OutData%Cp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Cp,1), UBOUND(OutData%Cp,1) - OutData%Cp(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AxCd not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AxCd)) DEALLOCATE(OutData%AxCd) - ALLOCATE(OutData%AxCd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxCd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AxCd,1), UBOUND(OutData%AxCd,1) - OutData%AxCd(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AxCa not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AxCa)) DEALLOCATE(OutData%AxCa) - ALLOCATE(OutData%AxCa(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxCa.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AxCa,1), UBOUND(OutData%AxCa,1) - OutData%AxCa(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AxCp not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AxCp)) DEALLOCATE(OutData%AxCp) - ALLOCATE(OutData%AxCp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxCp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AxCp,1), UBOUND(OutData%AxCp,1) - OutData%AxCp(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cb not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Cb)) DEALLOCATE(OutData%Cb) - ALLOCATE(OutData%Cb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Cb,1), UBOUND(OutData%Cb,1) - OutData%Cb(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! m_fb_l not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%m_fb_l)) DEALLOCATE(OutData%m_fb_l) - ALLOCATE(OutData%m_fb_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%m_fb_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%m_fb_l,1), UBOUND(OutData%m_fb_l,1) - OutData%m_fb_l(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! m_fb_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%m_fb_u)) DEALLOCATE(OutData%m_fb_u) - ALLOCATE(OutData%m_fb_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%m_fb_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%m_fb_u,1), UBOUND(OutData%m_fb_u,1) - OutData%m_fb_u(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! h_cfb_l not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%h_cfb_l)) DEALLOCATE(OutData%h_cfb_l) - ALLOCATE(OutData%h_cfb_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%h_cfb_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%h_cfb_l,1), UBOUND(OutData%h_cfb_l,1) - OutData%h_cfb_l(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! h_cfb_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%h_cfb_u)) DEALLOCATE(OutData%h_cfb_u) - ALLOCATE(OutData%h_cfb_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%h_cfb_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%h_cfb_u,1), UBOUND(OutData%h_cfb_u,1) - OutData%h_cfb_u(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! I_lfb_l not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%I_lfb_l)) DEALLOCATE(OutData%I_lfb_l) - ALLOCATE(OutData%I_lfb_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_lfb_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%I_lfb_l,1), UBOUND(OutData%I_lfb_l,1) - OutData%I_lfb_l(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! I_lfb_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%I_lfb_u)) DEALLOCATE(OutData%I_lfb_u) - ALLOCATE(OutData%I_lfb_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_lfb_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%I_lfb_u,1), UBOUND(OutData%I_lfb_u,1) - OutData%I_lfb_u(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! I_rfb_l not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%I_rfb_l)) DEALLOCATE(OutData%I_rfb_l) - ALLOCATE(OutData%I_rfb_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_rfb_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%I_rfb_l,1), UBOUND(OutData%I_rfb_l,1) - OutData%I_rfb_l(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! I_rfb_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%I_rfb_u)) DEALLOCATE(OutData%I_rfb_u) - ALLOCATE(OutData%I_rfb_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_rfb_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%I_rfb_u,1), UBOUND(OutData%I_rfb_u,1) - OutData%I_rfb_u(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! m_mg_l not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%m_mg_l)) DEALLOCATE(OutData%m_mg_l) - ALLOCATE(OutData%m_mg_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%m_mg_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%m_mg_l,1), UBOUND(OutData%m_mg_l,1) - OutData%m_mg_l(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! m_mg_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%m_mg_u)) DEALLOCATE(OutData%m_mg_u) - ALLOCATE(OutData%m_mg_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%m_mg_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%m_mg_u,1), UBOUND(OutData%m_mg_u,1) - OutData%m_mg_u(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! h_cmg_l not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%h_cmg_l)) DEALLOCATE(OutData%h_cmg_l) - ALLOCATE(OutData%h_cmg_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%h_cmg_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%h_cmg_l,1), UBOUND(OutData%h_cmg_l,1) - OutData%h_cmg_l(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! h_cmg_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%h_cmg_u)) DEALLOCATE(OutData%h_cmg_u) - ALLOCATE(OutData%h_cmg_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%h_cmg_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%h_cmg_u,1), UBOUND(OutData%h_cmg_u,1) - OutData%h_cmg_u(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! I_lmg_l not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%I_lmg_l)) DEALLOCATE(OutData%I_lmg_l) - ALLOCATE(OutData%I_lmg_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_lmg_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%I_lmg_l,1), UBOUND(OutData%I_lmg_l,1) - OutData%I_lmg_l(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! I_lmg_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%I_lmg_u)) DEALLOCATE(OutData%I_lmg_u) - ALLOCATE(OutData%I_lmg_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_lmg_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%I_lmg_u,1), UBOUND(OutData%I_lmg_u,1) - OutData%I_lmg_u(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! I_rmg_l not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%I_rmg_l)) DEALLOCATE(OutData%I_rmg_l) - ALLOCATE(OutData%I_rmg_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_rmg_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%I_rmg_l,1), UBOUND(OutData%I_rmg_l,1) - OutData%I_rmg_l(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! I_rmg_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%I_rmg_u)) DEALLOCATE(OutData%I_rmg_u) - ALLOCATE(OutData%I_rmg_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_rmg_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%I_rmg_u,1), UBOUND(OutData%I_rmg_u,1) - OutData%I_rmg_u(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cfl_fb not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Cfl_fb)) DEALLOCATE(OutData%Cfl_fb) - ALLOCATE(OutData%Cfl_fb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cfl_fb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Cfl_fb,1), UBOUND(OutData%Cfl_fb,1) - OutData%Cfl_fb(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cfr_fb not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Cfr_fb)) DEALLOCATE(OutData%Cfr_fb) - ALLOCATE(OutData%Cfr_fb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cfr_fb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Cfr_fb,1), UBOUND(OutData%Cfr_fb,1) - OutData%Cfr_fb(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CM0_fb not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CM0_fb)) DEALLOCATE(OutData%CM0_fb) - ALLOCATE(OutData%CM0_fb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CM0_fb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CM0_fb,1), UBOUND(OutData%CM0_fb,1) - OutData%CM0_fb(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%MGvolume = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MDivSize = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MCoefMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MmbrCoefIDIndx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MmbrFilledIDIndx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MHstLMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FillFSLoc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%FillDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PropPot = TRANSFER(IntKiBuf(Int_Xferred), OutData%PropPot) - Int_Xferred = Int_Xferred + 1 - OutData%PropMCF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PropMCF) - Int_Xferred = Int_Xferred + 1 - OutData%Flipped = TRANSFER(IntKiBuf(Int_Xferred), OutData%Flipped) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Morison_UnPackMemberType - - SUBROUTINE Morison_CopyMemberLoads( SrcMemberLoadsData, DstMemberLoadsData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_MemberLoads), INTENT(IN) :: SrcMemberLoadsData - TYPE(Morison_MemberLoads), INTENT(INOUT) :: DstMemberLoadsData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_CopyMemberLoads' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMemberLoadsData%F_D)) THEN - i1_l = LBOUND(SrcMemberLoadsData%F_D,1) - i1_u = UBOUND(SrcMemberLoadsData%F_D,1) - i2_l = LBOUND(SrcMemberLoadsData%F_D,2) - i2_u = UBOUND(SrcMemberLoadsData%F_D,2) - IF (.NOT. ALLOCATED(DstMemberLoadsData%F_D)) THEN - ALLOCATE(DstMemberLoadsData%F_D(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_D.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberLoadsData%F_D = SrcMemberLoadsData%F_D -ENDIF -IF (ALLOCATED(SrcMemberLoadsData%F_I)) THEN - i1_l = LBOUND(SrcMemberLoadsData%F_I,1) - i1_u = UBOUND(SrcMemberLoadsData%F_I,1) - i2_l = LBOUND(SrcMemberLoadsData%F_I,2) - i2_u = UBOUND(SrcMemberLoadsData%F_I,2) - IF (.NOT. ALLOCATED(DstMemberLoadsData%F_I)) THEN - ALLOCATE(DstMemberLoadsData%F_I(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_I.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberLoadsData%F_I = SrcMemberLoadsData%F_I -ENDIF -IF (ALLOCATED(SrcMemberLoadsData%F_A)) THEN - i1_l = LBOUND(SrcMemberLoadsData%F_A,1) - i1_u = UBOUND(SrcMemberLoadsData%F_A,1) - i2_l = LBOUND(SrcMemberLoadsData%F_A,2) - i2_u = UBOUND(SrcMemberLoadsData%F_A,2) - IF (.NOT. ALLOCATED(DstMemberLoadsData%F_A)) THEN - ALLOCATE(DstMemberLoadsData%F_A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_A.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberLoadsData%F_A = SrcMemberLoadsData%F_A -ENDIF -IF (ALLOCATED(SrcMemberLoadsData%F_B)) THEN - i1_l = LBOUND(SrcMemberLoadsData%F_B,1) - i1_u = UBOUND(SrcMemberLoadsData%F_B,1) - i2_l = LBOUND(SrcMemberLoadsData%F_B,2) - i2_u = UBOUND(SrcMemberLoadsData%F_B,2) - IF (.NOT. ALLOCATED(DstMemberLoadsData%F_B)) THEN - ALLOCATE(DstMemberLoadsData%F_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_B.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_B.', ErrStat, ErrMsg,RoutineName) + RETURN END IF END IF DstMemberLoadsData%F_B = SrcMemberLoadsData%F_B @@ -4542,628 +3292,265 @@ SUBROUTINE Morison_DestroyMemberLoads( MemberLoadsData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE Morison_DestroyMemberLoads - SUBROUTINE Morison_PackMemberLoads( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Morison_MemberLoads), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_PackMemberLoads' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! F_D allocated yes/no - IF ( ALLOCATED(InData%F_D) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_D upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_D) ! F_D - END IF - Int_BufSz = Int_BufSz + 1 ! F_I allocated yes/no - IF ( ALLOCATED(InData%F_I) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_I upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_I) ! F_I - END IF - Int_BufSz = Int_BufSz + 1 ! F_A allocated yes/no - IF ( ALLOCATED(InData%F_A) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_A upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_A) ! F_A - END IF - Int_BufSz = Int_BufSz + 1 ! F_B allocated yes/no - IF ( ALLOCATED(InData%F_B) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_B upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_B) ! F_B - END IF - Int_BufSz = Int_BufSz + 1 ! F_BF allocated yes/no - IF ( ALLOCATED(InData%F_BF) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_BF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_BF) ! F_BF - END IF - Int_BufSz = Int_BufSz + 1 ! F_If allocated yes/no - IF ( ALLOCATED(InData%F_If) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_If upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_If) ! F_If - END IF - Int_BufSz = Int_BufSz + 1 ! F_WMG allocated yes/no - IF ( ALLOCATED(InData%F_WMG) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_WMG upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_WMG) ! F_WMG - END IF - Int_BufSz = Int_BufSz + 1 ! F_IMG allocated yes/no - IF ( ALLOCATED(InData%F_IMG) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_IMG upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_IMG) ! F_IMG - END IF - Int_BufSz = Int_BufSz + 1 ! FV allocated yes/no - IF ( ALLOCATED(InData%FV) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FV upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FV) ! FV - END IF - Int_BufSz = Int_BufSz + 1 ! FA allocated yes/no - IF ( ALLOCATED(InData%FA) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FA upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FA) ! FA - END IF - Int_BufSz = Int_BufSz + 1 ! F_DP allocated yes/no - IF ( ALLOCATED(InData%F_DP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_DP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_DP) ! F_DP - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%F_D) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_D,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_D,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_D,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_D,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_D,2), UBOUND(InData%F_D,2) - DO i1 = LBOUND(InData%F_D,1), UBOUND(InData%F_D,1) - ReKiBuf(Re_Xferred) = InData%F_D(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_I) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_I,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_I,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_I,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_I,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_I,2), UBOUND(InData%F_I,2) - DO i1 = LBOUND(InData%F_I,1), UBOUND(InData%F_I,1) - ReKiBuf(Re_Xferred) = InData%F_I(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_A) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_A,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_A,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_A,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_A,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_A,2), UBOUND(InData%F_A,2) - DO i1 = LBOUND(InData%F_A,1), UBOUND(InData%F_A,1) - ReKiBuf(Re_Xferred) = InData%F_A(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_B) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_B,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_B,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_B,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_B,2), UBOUND(InData%F_B,2) - DO i1 = LBOUND(InData%F_B,1), UBOUND(InData%F_B,1) - ReKiBuf(Re_Xferred) = InData%F_B(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_BF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_BF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_BF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_BF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_BF,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_BF,2), UBOUND(InData%F_BF,2) - DO i1 = LBOUND(InData%F_BF,1), UBOUND(InData%F_BF,1) - ReKiBuf(Re_Xferred) = InData%F_BF(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_If) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_If,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_If,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_If,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_If,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_If,2), UBOUND(InData%F_If,2) - DO i1 = LBOUND(InData%F_If,1), UBOUND(InData%F_If,1) - ReKiBuf(Re_Xferred) = InData%F_If(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_WMG) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_WMG,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_WMG,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_WMG,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_WMG,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_WMG,2), UBOUND(InData%F_WMG,2) - DO i1 = LBOUND(InData%F_WMG,1), UBOUND(InData%F_WMG,1) - ReKiBuf(Re_Xferred) = InData%F_WMG(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_IMG) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_IMG,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_IMG,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_IMG,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_IMG,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_IMG,2), UBOUND(InData%F_IMG,2) - DO i1 = LBOUND(InData%F_IMG,1), UBOUND(InData%F_IMG,1) - ReKiBuf(Re_Xferred) = InData%F_IMG(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FV) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FV,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FV,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FV,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FV,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FV,2), UBOUND(InData%FV,2) - DO i1 = LBOUND(InData%FV,1), UBOUND(InData%FV,1) - ReKiBuf(Re_Xferred) = InData%FV(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FA) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FA,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FA,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FA,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FA,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FA,2), UBOUND(InData%FA,2) - DO i1 = LBOUND(InData%FA,1), UBOUND(InData%FA,1) - ReKiBuf(Re_Xferred) = InData%FA(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_DP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_DP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_DP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_DP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_DP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_DP,2), UBOUND(InData%F_DP,2) - DO i1 = LBOUND(InData%F_DP,1), UBOUND(InData%F_DP,1) - ReKiBuf(Re_Xferred) = InData%F_DP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE Morison_PackMemberLoads - - SUBROUTINE Morison_UnPackMemberLoads( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Morison_MemberLoads), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackMemberLoads' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_D not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_D)) DEALLOCATE(OutData%F_D) - ALLOCATE(OutData%F_D(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_D.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_D,2), UBOUND(OutData%F_D,2) - DO i1 = LBOUND(OutData%F_D,1), UBOUND(OutData%F_D,1) - OutData%F_D(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_I not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_I)) DEALLOCATE(OutData%F_I) - ALLOCATE(OutData%F_I(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_I.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_I,2), UBOUND(OutData%F_I,2) - DO i1 = LBOUND(OutData%F_I,1), UBOUND(OutData%F_I,1) - OutData%F_I(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_A not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_A)) DEALLOCATE(OutData%F_A) - ALLOCATE(OutData%F_A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_A.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_A,2), UBOUND(OutData%F_A,2) - DO i1 = LBOUND(OutData%F_A,1), UBOUND(OutData%F_A,1) - OutData%F_A(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_B not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_B)) DEALLOCATE(OutData%F_B) - ALLOCATE(OutData%F_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_B,2), UBOUND(OutData%F_B,2) - DO i1 = LBOUND(OutData%F_B,1), UBOUND(OutData%F_B,1) - OutData%F_B(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_BF not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_BF)) DEALLOCATE(OutData%F_BF) - ALLOCATE(OutData%F_BF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_BF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_BF,2), UBOUND(OutData%F_BF,2) - DO i1 = LBOUND(OutData%F_BF,1), UBOUND(OutData%F_BF,1) - OutData%F_BF(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_If not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_If)) DEALLOCATE(OutData%F_If) - ALLOCATE(OutData%F_If(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_If.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_If,2), UBOUND(OutData%F_If,2) - DO i1 = LBOUND(OutData%F_If,1), UBOUND(OutData%F_If,1) - OutData%F_If(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_WMG not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_WMG)) DEALLOCATE(OutData%F_WMG) - ALLOCATE(OutData%F_WMG(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_WMG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_WMG,2), UBOUND(OutData%F_WMG,2) - DO i1 = LBOUND(OutData%F_WMG,1), UBOUND(OutData%F_WMG,1) - OutData%F_WMG(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_IMG not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_IMG)) DEALLOCATE(OutData%F_IMG) - ALLOCATE(OutData%F_IMG(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_IMG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_IMG,2), UBOUND(OutData%F_IMG,2) - DO i1 = LBOUND(OutData%F_IMG,1), UBOUND(OutData%F_IMG,1) - OutData%F_IMG(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FV not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FV)) DEALLOCATE(OutData%FV) - ALLOCATE(OutData%FV(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FV,2), UBOUND(OutData%FV,2) - DO i1 = LBOUND(OutData%FV,1), UBOUND(OutData%FV,1) - OutData%FV(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FA not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FA)) DEALLOCATE(OutData%FA) - ALLOCATE(OutData%FA(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FA,2), UBOUND(OutData%FA,2) - DO i1 = LBOUND(OutData%FA,1), UBOUND(OutData%FA,1) - OutData%FA(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_DP not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_DP)) DEALLOCATE(OutData%F_DP) - ALLOCATE(OutData%F_DP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_DP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_DP,2), UBOUND(OutData%F_DP,2) - DO i1 = LBOUND(OutData%F_DP,1), UBOUND(OutData%F_DP,1) - OutData%F_DP(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE Morison_UnPackMemberLoads +subroutine Morison_PackMemberLoads(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Morison_MemberLoads), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackMemberLoads' + if (Buf%ErrStat >= AbortErrLev) return + ! F_D + call RegPack(Buf, allocated(InData%F_D)) + if (allocated(InData%F_D)) then + call RegPackBounds(Buf, 2, lbound(InData%F_D), ubound(InData%F_D)) + call RegPack(Buf, InData%F_D) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! F_I + call RegPack(Buf, allocated(InData%F_I)) + if (allocated(InData%F_I)) then + call RegPackBounds(Buf, 2, lbound(InData%F_I), ubound(InData%F_I)) + call RegPack(Buf, InData%F_I) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! F_A + call RegPack(Buf, allocated(InData%F_A)) + if (allocated(InData%F_A)) then + call RegPackBounds(Buf, 2, lbound(InData%F_A), ubound(InData%F_A)) + call RegPack(Buf, InData%F_A) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! F_B + call RegPack(Buf, allocated(InData%F_B)) + if (allocated(InData%F_B)) then + call RegPackBounds(Buf, 2, lbound(InData%F_B), ubound(InData%F_B)) + call RegPack(Buf, InData%F_B) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! F_BF + call RegPack(Buf, allocated(InData%F_BF)) + if (allocated(InData%F_BF)) then + call RegPackBounds(Buf, 2, lbound(InData%F_BF), ubound(InData%F_BF)) + call RegPack(Buf, InData%F_BF) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! F_If + call RegPack(Buf, allocated(InData%F_If)) + if (allocated(InData%F_If)) then + call RegPackBounds(Buf, 2, lbound(InData%F_If), ubound(InData%F_If)) + call RegPack(Buf, InData%F_If) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! F_WMG + call RegPack(Buf, allocated(InData%F_WMG)) + if (allocated(InData%F_WMG)) then + call RegPackBounds(Buf, 2, lbound(InData%F_WMG), ubound(InData%F_WMG)) + call RegPack(Buf, InData%F_WMG) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! F_IMG + call RegPack(Buf, allocated(InData%F_IMG)) + if (allocated(InData%F_IMG)) then + call RegPackBounds(Buf, 2, lbound(InData%F_IMG), ubound(InData%F_IMG)) + call RegPack(Buf, InData%F_IMG) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FV + call RegPack(Buf, allocated(InData%FV)) + if (allocated(InData%FV)) then + call RegPackBounds(Buf, 2, lbound(InData%FV), ubound(InData%FV)) + call RegPack(Buf, InData%FV) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FA + call RegPack(Buf, allocated(InData%FA)) + if (allocated(InData%FA)) then + call RegPackBounds(Buf, 2, lbound(InData%FA), ubound(InData%FA)) + call RegPack(Buf, InData%FA) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! F_DP + call RegPack(Buf, allocated(InData%F_DP)) + if (allocated(InData%F_DP)) then + call RegPackBounds(Buf, 2, lbound(InData%F_DP), ubound(InData%F_DP)) + call RegPack(Buf, InData%F_DP) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_UnPackMemberLoads(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Morison_MemberLoads), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackMemberLoads' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! F_D + if (allocated(OutData%F_D)) deallocate(OutData%F_D) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_D(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_D.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_D) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! F_I + if (allocated(OutData%F_I)) deallocate(OutData%F_I) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_I(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_I.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_I) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! F_A + if (allocated(OutData%F_A)) deallocate(OutData%F_A) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_A(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_A.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_A) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! F_B + if (allocated(OutData%F_B)) deallocate(OutData%F_B) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_B(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_B.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_B) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! F_BF + if (allocated(OutData%F_BF)) deallocate(OutData%F_BF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_BF(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_BF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_BF) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! F_If + if (allocated(OutData%F_If)) deallocate(OutData%F_If) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_If(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_If.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_If) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! F_WMG + if (allocated(OutData%F_WMG)) deallocate(OutData%F_WMG) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_WMG(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_WMG.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_WMG) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! F_IMG + if (allocated(OutData%F_IMG)) deallocate(OutData%F_IMG) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_IMG(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_IMG.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_IMG) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! FV + if (allocated(OutData%FV)) deallocate(OutData%FV) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FV(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FV.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FV) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! FA + if (allocated(OutData%FA)) deallocate(OutData%FA) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FA(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FA.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FA) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! F_DP + if (allocated(OutData%F_DP)) deallocate(OutData%F_DP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_DP(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_DP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_DP) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE Morison_CopyCoefMembers( SrcCoefMembersData, DstCoefMembersData, CtrlCode, ErrStat, ErrMsg ) TYPE(Morison_CoefMembers), INTENT(IN) :: SrcCoefMembersData TYPE(Morison_CoefMembers), INTENT(INOUT) :: DstCoefMembersData @@ -5225,248 +3612,200 @@ SUBROUTINE Morison_DestroyCoefMembers( CoefMembersData, ErrStat, ErrMsg ) END SUBROUTINE Morison_DestroyCoefMembers - SUBROUTINE Morison_PackCoefMembers( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Morison_CoefMembers), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_PackCoefMembers' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! MemberID - Re_BufSz = Re_BufSz + 1 ! MemberCd1 - Re_BufSz = Re_BufSz + 1 ! MemberCd2 - Re_BufSz = Re_BufSz + 1 ! MemberCdMG1 - Re_BufSz = Re_BufSz + 1 ! MemberCdMG2 - Re_BufSz = Re_BufSz + 1 ! MemberCa1 - Re_BufSz = Re_BufSz + 1 ! MemberCa2 - Re_BufSz = Re_BufSz + 1 ! MemberCaMG1 - Re_BufSz = Re_BufSz + 1 ! MemberCaMG2 - Re_BufSz = Re_BufSz + 1 ! MemberCp1 - Re_BufSz = Re_BufSz + 1 ! MemberCp2 - Re_BufSz = Re_BufSz + 1 ! MemberCpMG1 - Re_BufSz = Re_BufSz + 1 ! MemberCpMG2 - Re_BufSz = Re_BufSz + 1 ! MemberAxCd1 - Re_BufSz = Re_BufSz + 1 ! MemberAxCd2 - Re_BufSz = Re_BufSz + 1 ! MemberAxCdMG1 - Re_BufSz = Re_BufSz + 1 ! MemberAxCdMG2 - Re_BufSz = Re_BufSz + 1 ! MemberAxCa1 - Re_BufSz = Re_BufSz + 1 ! MemberAxCa2 - Re_BufSz = Re_BufSz + 1 ! MemberAxCaMG1 - Re_BufSz = Re_BufSz + 1 ! MemberAxCaMG2 - Re_BufSz = Re_BufSz + 1 ! MemberAxCp1 - Re_BufSz = Re_BufSz + 1 ! MemberAxCp2 - Re_BufSz = Re_BufSz + 1 ! MemberAxCpMG1 - Re_BufSz = Re_BufSz + 1 ! MemberAxCpMG2 - Re_BufSz = Re_BufSz + 1 ! MemberCb1 - Re_BufSz = Re_BufSz + 1 ! MemberCb2 - Re_BufSz = Re_BufSz + 1 ! MemberCbMG1 - Re_BufSz = Re_BufSz + 1 ! MemberCbMG2 - Int_BufSz = Int_BufSz + 1 ! MemberMCF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%MemberID - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberCd1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberCd2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberCdMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberCdMG2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberCa1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberCa2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberCaMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberCaMG2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberCp1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberCp2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberCpMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberCpMG2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberAxCd1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberAxCd2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberAxCdMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberAxCdMG2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberAxCa1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberAxCa2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberAxCaMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberAxCaMG2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberAxCp1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberAxCp2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberAxCpMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberAxCpMG2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberCb1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberCb2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberCbMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MemberCbMG2 - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%MemberMCF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Morison_PackCoefMembers - - SUBROUTINE Morison_UnPackCoefMembers( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Morison_CoefMembers), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackCoefMembers' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%MemberID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MemberCd1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCd2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCdMG1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCdMG2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCa1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCa2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCaMG1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCaMG2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCp1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCp2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCpMG1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCpMG2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCd1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCd2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCdMG1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCdMG2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCa1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCa2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCaMG1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCaMG2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCp1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCp2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCpMG1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCpMG2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCb1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCb2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCbMG1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCbMG2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MemberMCF = TRANSFER(IntKiBuf(Int_Xferred), OutData%MemberMCF) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Morison_UnPackCoefMembers +subroutine Morison_PackCoefMembers(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Morison_CoefMembers), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackCoefMembers' + if (Buf%ErrStat >= AbortErrLev) return + ! MemberID + call RegPack(Buf, InData%MemberID) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberCd1 + call RegPack(Buf, InData%MemberCd1) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberCd2 + call RegPack(Buf, InData%MemberCd2) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberCdMG1 + call RegPack(Buf, InData%MemberCdMG1) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberCdMG2 + call RegPack(Buf, InData%MemberCdMG2) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberCa1 + call RegPack(Buf, InData%MemberCa1) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberCa2 + call RegPack(Buf, InData%MemberCa2) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberCaMG1 + call RegPack(Buf, InData%MemberCaMG1) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberCaMG2 + call RegPack(Buf, InData%MemberCaMG2) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberCp1 + call RegPack(Buf, InData%MemberCp1) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberCp2 + call RegPack(Buf, InData%MemberCp2) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberCpMG1 + call RegPack(Buf, InData%MemberCpMG1) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberCpMG2 + call RegPack(Buf, InData%MemberCpMG2) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberAxCd1 + call RegPack(Buf, InData%MemberAxCd1) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberAxCd2 + call RegPack(Buf, InData%MemberAxCd2) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberAxCdMG1 + call RegPack(Buf, InData%MemberAxCdMG1) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberAxCdMG2 + call RegPack(Buf, InData%MemberAxCdMG2) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberAxCa1 + call RegPack(Buf, InData%MemberAxCa1) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberAxCa2 + call RegPack(Buf, InData%MemberAxCa2) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberAxCaMG1 + call RegPack(Buf, InData%MemberAxCaMG1) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberAxCaMG2 + call RegPack(Buf, InData%MemberAxCaMG2) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberAxCp1 + call RegPack(Buf, InData%MemberAxCp1) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberAxCp2 + call RegPack(Buf, InData%MemberAxCp2) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberAxCpMG1 + call RegPack(Buf, InData%MemberAxCpMG1) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberAxCpMG2 + call RegPack(Buf, InData%MemberAxCpMG2) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberCb1 + call RegPack(Buf, InData%MemberCb1) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberCb2 + call RegPack(Buf, InData%MemberCb2) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberCbMG1 + call RegPack(Buf, InData%MemberCbMG1) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberCbMG2 + call RegPack(Buf, InData%MemberCbMG2) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberMCF + call RegPack(Buf, InData%MemberMCF) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_UnPackCoefMembers(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Morison_CoefMembers), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackCoefMembers' + if (Buf%ErrStat /= ErrID_None) return + ! MemberID + call RegUnpack(Buf, OutData%MemberID) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberCd1 + call RegUnpack(Buf, OutData%MemberCd1) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberCd2 + call RegUnpack(Buf, OutData%MemberCd2) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberCdMG1 + call RegUnpack(Buf, OutData%MemberCdMG1) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberCdMG2 + call RegUnpack(Buf, OutData%MemberCdMG2) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberCa1 + call RegUnpack(Buf, OutData%MemberCa1) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberCa2 + call RegUnpack(Buf, OutData%MemberCa2) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberCaMG1 + call RegUnpack(Buf, OutData%MemberCaMG1) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberCaMG2 + call RegUnpack(Buf, OutData%MemberCaMG2) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberCp1 + call RegUnpack(Buf, OutData%MemberCp1) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberCp2 + call RegUnpack(Buf, OutData%MemberCp2) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberCpMG1 + call RegUnpack(Buf, OutData%MemberCpMG1) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberCpMG2 + call RegUnpack(Buf, OutData%MemberCpMG2) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberAxCd1 + call RegUnpack(Buf, OutData%MemberAxCd1) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberAxCd2 + call RegUnpack(Buf, OutData%MemberAxCd2) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberAxCdMG1 + call RegUnpack(Buf, OutData%MemberAxCdMG1) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberAxCdMG2 + call RegUnpack(Buf, OutData%MemberAxCdMG2) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberAxCa1 + call RegUnpack(Buf, OutData%MemberAxCa1) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberAxCa2 + call RegUnpack(Buf, OutData%MemberAxCa2) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberAxCaMG1 + call RegUnpack(Buf, OutData%MemberAxCaMG1) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberAxCaMG2 + call RegUnpack(Buf, OutData%MemberAxCaMG2) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberAxCp1 + call RegUnpack(Buf, OutData%MemberAxCp1) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberAxCp2 + call RegUnpack(Buf, OutData%MemberAxCp2) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberAxCpMG1 + call RegUnpack(Buf, OutData%MemberAxCpMG1) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberAxCpMG2 + call RegUnpack(Buf, OutData%MemberAxCpMG2) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberCb1 + call RegUnpack(Buf, OutData%MemberCb1) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberCb2 + call RegUnpack(Buf, OutData%MemberCb2) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberCbMG1 + call RegUnpack(Buf, OutData%MemberCbMG1) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberCbMG2 + call RegUnpack(Buf, OutData%MemberCbMG2) + if (RegCheckErr(Buf, RoutineName)) return + ! MemberMCF + call RegUnpack(Buf, OutData%MemberMCF) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE Morison_CopyMGDepthsType( SrcMGDepthsTypeData, DstMGDepthsTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(Morison_MGDepthsType), INTENT(IN) :: SrcMGDepthsTypeData TYPE(Morison_MGDepthsType), INTENT(INOUT) :: DstMGDepthsTypeData @@ -5501,113 +3840,38 @@ SUBROUTINE Morison_DestroyMGDepthsType( MGDepthsTypeData, ErrStat, ErrMsg ) END SUBROUTINE Morison_DestroyMGDepthsType - SUBROUTINE Morison_PackMGDepthsType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Morison_MGDepthsType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_PackMGDepthsType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! MGDpth - Re_BufSz = Re_BufSz + 1 ! MGThck - Re_BufSz = Re_BufSz + 1 ! MGDens - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%MGDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MGThck - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MGDens - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Morison_PackMGDepthsType - - SUBROUTINE Morison_UnPackMGDepthsType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Morison_MGDepthsType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackMGDepthsType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%MGDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MGThck = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MGDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Morison_UnPackMGDepthsType +subroutine Morison_PackMGDepthsType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Morison_MGDepthsType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackMGDepthsType' + if (Buf%ErrStat >= AbortErrLev) return + ! MGDpth + call RegPack(Buf, InData%MGDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! MGThck + call RegPack(Buf, InData%MGThck) + if (RegCheckErr(Buf, RoutineName)) return + ! MGDens + call RegPack(Buf, InData%MGDens) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_UnPackMGDepthsType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Morison_MGDepthsType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackMGDepthsType' + if (Buf%ErrStat /= ErrID_None) return + ! MGDpth + call RegUnpack(Buf, OutData%MGDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! MGThck + call RegUnpack(Buf, OutData%MGThck) + if (RegCheckErr(Buf, RoutineName)) return + ! MGDens + call RegUnpack(Buf, OutData%MGDens) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE Morison_CopyMOutput( SrcMOutputData, DstMOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(Morison_MOutput), INTENT(IN) :: SrcMOutputData TYPE(Morison_MOutput), INTENT(INOUT) :: DstMOutputData @@ -5733,342 +3997,173 @@ SUBROUTINE Morison_DestroyMOutput( MOutputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE Morison_DestroyMOutput - SUBROUTINE Morison_PackMOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Morison_MOutput), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_PackMOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! MemberID - Int_BufSz = Int_BufSz + 1 ! NOutLoc - Int_BufSz = Int_BufSz + 1 ! NodeLocs allocated yes/no - IF ( ALLOCATED(InData%NodeLocs) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NodeLocs upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%NodeLocs) ! NodeLocs - END IF - Int_BufSz = Int_BufSz + 1 ! MemberIDIndx - Int_BufSz = Int_BufSz + 1 ! MeshIndx1 allocated yes/no - IF ( ALLOCATED(InData%MeshIndx1) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MeshIndx1 upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%MeshIndx1) ! MeshIndx1 - END IF - Int_BufSz = Int_BufSz + 1 ! MeshIndx2 allocated yes/no - IF ( ALLOCATED(InData%MeshIndx2) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MeshIndx2 upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%MeshIndx2) ! MeshIndx2 - END IF - Int_BufSz = Int_BufSz + 1 ! MemberIndx1 allocated yes/no - IF ( ALLOCATED(InData%MemberIndx1) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MemberIndx1 upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%MemberIndx1) ! MemberIndx1 - END IF - Int_BufSz = Int_BufSz + 1 ! MemberIndx2 allocated yes/no - IF ( ALLOCATED(InData%MemberIndx2) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MemberIndx2 upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%MemberIndx2) ! MemberIndx2 - END IF - Int_BufSz = Int_BufSz + 1 ! s allocated yes/no - IF ( ALLOCATED(InData%s) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! s upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%s) ! s - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%MemberID - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NOutLoc - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%NodeLocs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NodeLocs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodeLocs,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NodeLocs,1), UBOUND(InData%NodeLocs,1) - ReKiBuf(Re_Xferred) = InData%NodeLocs(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%MemberIDIndx - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%MeshIndx1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MeshIndx1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MeshIndx1,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MeshIndx1,1), UBOUND(InData%MeshIndx1,1) - IntKiBuf(Int_Xferred) = InData%MeshIndx1(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MeshIndx2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MeshIndx2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MeshIndx2,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MeshIndx2,1), UBOUND(InData%MeshIndx2,1) - IntKiBuf(Int_Xferred) = InData%MeshIndx2(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MemberIndx1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MemberIndx1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MemberIndx1,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MemberIndx1,1), UBOUND(InData%MemberIndx1,1) - IntKiBuf(Int_Xferred) = InData%MemberIndx1(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MemberIndx2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MemberIndx2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MemberIndx2,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MemberIndx2,1), UBOUND(InData%MemberIndx2,1) - IntKiBuf(Int_Xferred) = InData%MemberIndx2(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%s) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%s,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%s,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%s,1), UBOUND(InData%s,1) - ReKiBuf(Re_Xferred) = InData%s(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE Morison_PackMOutput - - SUBROUTINE Morison_UnPackMOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Morison_MOutput), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackMOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%MemberID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NOutLoc = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodeLocs not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NodeLocs)) DEALLOCATE(OutData%NodeLocs) - ALLOCATE(OutData%NodeLocs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeLocs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NodeLocs,1), UBOUND(OutData%NodeLocs,1) - OutData%NodeLocs(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%MemberIDIndx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MeshIndx1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MeshIndx1)) DEALLOCATE(OutData%MeshIndx1) - ALLOCATE(OutData%MeshIndx1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MeshIndx1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MeshIndx1,1), UBOUND(OutData%MeshIndx1,1) - OutData%MeshIndx1(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MeshIndx2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MeshIndx2)) DEALLOCATE(OutData%MeshIndx2) - ALLOCATE(OutData%MeshIndx2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MeshIndx2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MeshIndx2,1), UBOUND(OutData%MeshIndx2,1) - OutData%MeshIndx2(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MemberIndx1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MemberIndx1)) DEALLOCATE(OutData%MemberIndx1) - ALLOCATE(OutData%MemberIndx1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MemberIndx1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MemberIndx1,1), UBOUND(OutData%MemberIndx1,1) - OutData%MemberIndx1(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MemberIndx2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MemberIndx2)) DEALLOCATE(OutData%MemberIndx2) - ALLOCATE(OutData%MemberIndx2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MemberIndx2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MemberIndx2,1), UBOUND(OutData%MemberIndx2,1) - OutData%MemberIndx2(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! s not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%s)) DEALLOCATE(OutData%s) - ALLOCATE(OutData%s(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%s.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%s,1), UBOUND(OutData%s,1) - OutData%s(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE Morison_UnPackMOutput +subroutine Morison_PackMOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Morison_MOutput), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackMOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! MemberID + call RegPack(Buf, InData%MemberID) + if (RegCheckErr(Buf, RoutineName)) return + ! NOutLoc + call RegPack(Buf, InData%NOutLoc) + if (RegCheckErr(Buf, RoutineName)) return + ! NodeLocs + call RegPack(Buf, allocated(InData%NodeLocs)) + if (allocated(InData%NodeLocs)) then + call RegPackBounds(Buf, 1, lbound(InData%NodeLocs), ubound(InData%NodeLocs)) + call RegPack(Buf, InData%NodeLocs) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MemberIDIndx + call RegPack(Buf, InData%MemberIDIndx) + if (RegCheckErr(Buf, RoutineName)) return + ! MeshIndx1 + call RegPack(Buf, allocated(InData%MeshIndx1)) + if (allocated(InData%MeshIndx1)) then + call RegPackBounds(Buf, 1, lbound(InData%MeshIndx1), ubound(InData%MeshIndx1)) + call RegPack(Buf, InData%MeshIndx1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MeshIndx2 + call RegPack(Buf, allocated(InData%MeshIndx2)) + if (allocated(InData%MeshIndx2)) then + call RegPackBounds(Buf, 1, lbound(InData%MeshIndx2), ubound(InData%MeshIndx2)) + call RegPack(Buf, InData%MeshIndx2) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MemberIndx1 + call RegPack(Buf, allocated(InData%MemberIndx1)) + if (allocated(InData%MemberIndx1)) then + call RegPackBounds(Buf, 1, lbound(InData%MemberIndx1), ubound(InData%MemberIndx1)) + call RegPack(Buf, InData%MemberIndx1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MemberIndx2 + call RegPack(Buf, allocated(InData%MemberIndx2)) + if (allocated(InData%MemberIndx2)) then + call RegPackBounds(Buf, 1, lbound(InData%MemberIndx2), ubound(InData%MemberIndx2)) + call RegPack(Buf, InData%MemberIndx2) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! s + call RegPack(Buf, allocated(InData%s)) + if (allocated(InData%s)) then + call RegPackBounds(Buf, 1, lbound(InData%s), ubound(InData%s)) + call RegPack(Buf, InData%s) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_UnPackMOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Morison_MOutput), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackMOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! MemberID + call RegUnpack(Buf, OutData%MemberID) + if (RegCheckErr(Buf, RoutineName)) return + ! NOutLoc + call RegUnpack(Buf, OutData%NOutLoc) + if (RegCheckErr(Buf, RoutineName)) return + ! NodeLocs + if (allocated(OutData%NodeLocs)) deallocate(OutData%NodeLocs) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NodeLocs(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeLocs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%NodeLocs) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! MemberIDIndx + call RegUnpack(Buf, OutData%MemberIDIndx) + if (RegCheckErr(Buf, RoutineName)) return + ! MeshIndx1 + if (allocated(OutData%MeshIndx1)) deallocate(OutData%MeshIndx1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MeshIndx1(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MeshIndx1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MeshIndx1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! MeshIndx2 + if (allocated(OutData%MeshIndx2)) deallocate(OutData%MeshIndx2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MeshIndx2(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MeshIndx2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MeshIndx2) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! MemberIndx1 + if (allocated(OutData%MemberIndx1)) deallocate(OutData%MemberIndx1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MemberIndx1(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MemberIndx1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MemberIndx1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! MemberIndx2 + if (allocated(OutData%MemberIndx2)) deallocate(OutData%MemberIndx2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MemberIndx2(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MemberIndx2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MemberIndx2) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! s + if (allocated(OutData%s)) deallocate(OutData%s) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%s(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%s.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%s) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE Morison_CopyJOutput( SrcJOutputData, DstJOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(Morison_JOutput), INTENT(IN) :: SrcJOutputData TYPE(Morison_JOutput), INTENT(INOUT) :: DstJOutputData @@ -6102,108 +4197,32 @@ SUBROUTINE Morison_DestroyJOutput( JOutputData, ErrStat, ErrMsg ) END SUBROUTINE Morison_DestroyJOutput - SUBROUTINE Morison_PackJOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Morison_JOutput), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_PackJOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! JointID - Int_BufSz = Int_BufSz + 1 ! JointIDIndx - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%JointID - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%JointIDIndx - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Morison_PackJOutput - - SUBROUTINE Morison_UnPackJOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Morison_JOutput), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackJOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%JointID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%JointIDIndx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Morison_UnPackJOutput +subroutine Morison_PackJOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Morison_JOutput), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackJOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! JointID + call RegPack(Buf, InData%JointID) + if (RegCheckErr(Buf, RoutineName)) return + ! JointIDIndx + call RegPack(Buf, InData%JointIDIndx) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_UnPackJOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Morison_JOutput), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackJOutput' + if (Buf%ErrStat /= ErrID_None) return + ! JointID + call RegUnpack(Buf, OutData%JointID) + if (RegCheckErr(Buf, RoutineName)) return + ! JointIDIndx + call RegUnpack(Buf, OutData%JointIDIndx) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE Morison_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(Morison_InitInputType), INTENT(IN) :: SrcInitInputData TYPE(Morison_InitInputType), INTENT(INOUT) :: DstInitInputData @@ -6545,1658 +4564,612 @@ SUBROUTINE Morison_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) NULLIFY(InitInputData%WaveField) END SUBROUTINE Morison_DestroyInitInput - SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Morison_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! Gravity - Re_BufSz = Re_BufSz + 1 ! WtrDens - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Re_BufSz = Re_BufSz + 1 ! MSL2SWL - Int_BufSz = Int_BufSz + 1 ! WaveDisp - Int_BufSz = Int_BufSz + 1 ! AMMod - Int_BufSz = Int_BufSz + 1 ! NJoints - Int_BufSz = Int_BufSz + 1 ! NNodes - Int_BufSz = Int_BufSz + 1 ! InpJoints allocated yes/no - IF ( ALLOCATED(InData%InpJoints) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InpJoints upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%InpJoints,1), UBOUND(InData%InpJoints,1) - Int_BufSz = Int_BufSz + 3 ! InpJoints: size of buffers for each call to pack subtype - CALL Morison_PackJointType( Re_Buf, Db_Buf, Int_Buf, InData%InpJoints(i1), ErrStat2, ErrMsg2, .TRUE. ) ! InpJoints - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InpJoints - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InpJoints - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InpJoints - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! Nodes allocated yes/no - IF ( ALLOCATED(InData%Nodes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Nodes upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Nodes,1), UBOUND(InData%Nodes,1) - Int_BufSz = Int_BufSz + 3 ! Nodes: size of buffers for each call to pack subtype - CALL Morison_PackNodeType( Re_Buf, Db_Buf, Int_Buf, InData%Nodes(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Nodes - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Nodes - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Nodes - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Nodes - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NAxCoefs - Int_BufSz = Int_BufSz + 1 ! AxialCoefs allocated yes/no - IF ( ALLOCATED(InData%AxialCoefs) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AxialCoefs upper/lower bounds for each dimension - DO i1 = LBOUND(InData%AxialCoefs,1), UBOUND(InData%AxialCoefs,1) - Int_BufSz = Int_BufSz + 3 ! AxialCoefs: size of buffers for each call to pack subtype - CALL Morison_PackAxialCoefType( Re_Buf, Db_Buf, Int_Buf, InData%AxialCoefs(i1), ErrStat2, ErrMsg2, .TRUE. ) ! AxialCoefs - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AxialCoefs - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AxialCoefs - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AxialCoefs - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NPropSets - Int_BufSz = Int_BufSz + 1 ! MPropSets allocated yes/no - IF ( ALLOCATED(InData%MPropSets) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MPropSets upper/lower bounds for each dimension - DO i1 = LBOUND(InData%MPropSets,1), UBOUND(InData%MPropSets,1) - Int_BufSz = Int_BufSz + 3 ! MPropSets: size of buffers for each call to pack subtype - CALL Morison_PackMemberPropType( Re_Buf, Db_Buf, Int_Buf, InData%MPropSets(i1), ErrStat2, ErrMsg2, .TRUE. ) ! MPropSets - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! MPropSets - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! MPropSets - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! MPropSets - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Re_BufSz = Re_BufSz + 1 ! SimplCd - Re_BufSz = Re_BufSz + 1 ! SimplCdMG - Re_BufSz = Re_BufSz + 1 ! SimplCa - Re_BufSz = Re_BufSz + 1 ! SimplCaMG - Re_BufSz = Re_BufSz + 1 ! SimplCp - Re_BufSz = Re_BufSz + 1 ! SimplCpMG - Re_BufSz = Re_BufSz + 1 ! SimplAxCd - Re_BufSz = Re_BufSz + 1 ! SimplAxCdMG - Re_BufSz = Re_BufSz + 1 ! SimplAxCa - Re_BufSz = Re_BufSz + 1 ! SimplAxCaMG - Re_BufSz = Re_BufSz + 1 ! SimplAxCp - Re_BufSz = Re_BufSz + 1 ! SimplAxCpMG - Re_BufSz = Re_BufSz + 1 ! SimplCb - Re_BufSz = Re_BufSz + 1 ! SimplCbMg - Int_BufSz = Int_BufSz + 1 ! SimplMCF - Int_BufSz = Int_BufSz + 1 ! NCoefDpth - Int_BufSz = Int_BufSz + 1 ! CoefDpths allocated yes/no - IF ( ALLOCATED(InData%CoefDpths) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CoefDpths upper/lower bounds for each dimension - DO i1 = LBOUND(InData%CoefDpths,1), UBOUND(InData%CoefDpths,1) - Int_BufSz = Int_BufSz + 3 ! CoefDpths: size of buffers for each call to pack subtype - CALL Morison_PackCoefDpths( Re_Buf, Db_Buf, Int_Buf, InData%CoefDpths(i1), ErrStat2, ErrMsg2, .TRUE. ) ! CoefDpths - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! CoefDpths - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! CoefDpths - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! CoefDpths - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NCoefMembers - Int_BufSz = Int_BufSz + 1 ! CoefMembers allocated yes/no - IF ( ALLOCATED(InData%CoefMembers) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CoefMembers upper/lower bounds for each dimension - DO i1 = LBOUND(InData%CoefMembers,1), UBOUND(InData%CoefMembers,1) - Int_BufSz = Int_BufSz + 3 ! CoefMembers: size of buffers for each call to pack subtype - CALL Morison_PackCoefMembers( Re_Buf, Db_Buf, Int_Buf, InData%CoefMembers(i1), ErrStat2, ErrMsg2, .TRUE. ) ! CoefMembers - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! CoefMembers - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! CoefMembers - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! CoefMembers - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NMembers - Int_BufSz = Int_BufSz + 1 ! InpMembers allocated yes/no - IF ( ALLOCATED(InData%InpMembers) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InpMembers upper/lower bounds for each dimension - DO i1 = LBOUND(InData%InpMembers,1), UBOUND(InData%InpMembers,1) - Int_BufSz = Int_BufSz + 3 ! InpMembers: size of buffers for each call to pack subtype - CALL Morison_PackMemberInputType( Re_Buf, Db_Buf, Int_Buf, InData%InpMembers(i1), ErrStat2, ErrMsg2, .TRUE. ) ! InpMembers - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InpMembers - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InpMembers - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InpMembers - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NFillGroups - Int_BufSz = Int_BufSz + 1 ! FilledGroups allocated yes/no - IF ( ALLOCATED(InData%FilledGroups) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FilledGroups upper/lower bounds for each dimension - DO i1 = LBOUND(InData%FilledGroups,1), UBOUND(InData%FilledGroups,1) - Int_BufSz = Int_BufSz + 3 ! FilledGroups: size of buffers for each call to pack subtype - CALL Morison_PackFilledGroupType( Re_Buf, Db_Buf, Int_Buf, InData%FilledGroups(i1), ErrStat2, ErrMsg2, .TRUE. ) ! FilledGroups - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FilledGroups - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FilledGroups - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FilledGroups - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NMGDepths - Int_BufSz = Int_BufSz + 1 ! MGDepths allocated yes/no - IF ( ALLOCATED(InData%MGDepths) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MGDepths upper/lower bounds for each dimension - DO i1 = LBOUND(InData%MGDepths,1), UBOUND(InData%MGDepths,1) - Int_BufSz = Int_BufSz + 3 ! MGDepths: size of buffers for each call to pack subtype - CALL Morison_PackMGDepthsType( Re_Buf, Db_Buf, Int_Buf, InData%MGDepths(i1), ErrStat2, ErrMsg2, .TRUE. ) ! MGDepths - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! MGDepths - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! MGDepths - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! MGDepths - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Re_BufSz = Re_BufSz + 1 ! MGTop - Re_BufSz = Re_BufSz + 1 ! MGBottom - Int_BufSz = Int_BufSz + 1 ! NMOutputs - Int_BufSz = Int_BufSz + 1 ! MOutLst allocated yes/no - IF ( ALLOCATED(InData%MOutLst) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MOutLst upper/lower bounds for each dimension - DO i1 = LBOUND(InData%MOutLst,1), UBOUND(InData%MOutLst,1) - Int_BufSz = Int_BufSz + 3 ! MOutLst: size of buffers for each call to pack subtype - CALL Morison_PackMOutput( Re_Buf, Db_Buf, Int_Buf, InData%MOutLst(i1), ErrStat2, ErrMsg2, .TRUE. ) ! MOutLst - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! MOutLst - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! MOutLst - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! MOutLst - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NJOutputs - Int_BufSz = Int_BufSz + 1 ! JOutLst allocated yes/no - IF ( ALLOCATED(InData%JOutLst) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! JOutLst upper/lower bounds for each dimension - DO i1 = LBOUND(InData%JOutLst,1), UBOUND(InData%JOutLst,1) - Int_BufSz = Int_BufSz + 3 ! JOutLst: size of buffers for each call to pack subtype - CALL Morison_PackJOutput( Re_Buf, Db_Buf, Int_Buf, InData%JOutLst(i1), ErrStat2, ErrMsg2, .TRUE. ) ! JOutLst - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! JOutLst - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! JOutLst - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! JOutLst - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OutList allocated yes/no - IF ( ALLOCATED(InData%OutList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%OutList)*LEN(InData%OutList) ! OutList - END IF - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! UnSum - Int_BufSz = Int_BufSz + 1 ! NStepWave - Int_BufSz = Int_BufSz + 1 ! WaveStMod - Re_BufSz = Re_BufSz + 1 ! MCFD - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveDisp - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%AMMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NJoints - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NNodes - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%InpJoints) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InpJoints,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InpJoints,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InpJoints,1), UBOUND(InData%InpJoints,1) - CALL Morison_PackJointType( Re_Buf, Db_Buf, Int_Buf, InData%InpJoints(i1), ErrStat2, ErrMsg2, OnlySize ) ! InpJoints - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Nodes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Nodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nodes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Nodes,1), UBOUND(InData%Nodes,1) - CALL Morison_PackNodeType( Re_Buf, Db_Buf, Int_Buf, InData%Nodes(i1), ErrStat2, ErrMsg2, OnlySize ) ! Nodes - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NAxCoefs - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%AxialCoefs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AxialCoefs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxialCoefs,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AxialCoefs,1), UBOUND(InData%AxialCoefs,1) - CALL Morison_PackAxialCoefType( Re_Buf, Db_Buf, Int_Buf, InData%AxialCoefs(i1), ErrStat2, ErrMsg2, OnlySize ) ! AxialCoefs - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NPropSets - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%MPropSets) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MPropSets,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MPropSets,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MPropSets,1), UBOUND(InData%MPropSets,1) - CALL Morison_PackMemberPropType( Re_Buf, Db_Buf, Int_Buf, InData%MPropSets(i1), ErrStat2, ErrMsg2, OnlySize ) ! MPropSets - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - ReKiBuf(Re_Xferred) = InData%SimplCd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SimplCdMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SimplCa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SimplCaMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SimplCp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SimplCpMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SimplAxCd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SimplAxCdMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SimplAxCa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SimplAxCaMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SimplAxCp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SimplAxCpMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SimplCb - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SimplCbMg - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%SimplMCF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NCoefDpth - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%CoefDpths) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CoefDpths,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CoefDpths,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CoefDpths,1), UBOUND(InData%CoefDpths,1) - CALL Morison_PackCoefDpths( Re_Buf, Db_Buf, Int_Buf, InData%CoefDpths(i1), ErrStat2, ErrMsg2, OnlySize ) ! CoefDpths - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NCoefMembers - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%CoefMembers) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CoefMembers,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CoefMembers,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CoefMembers,1), UBOUND(InData%CoefMembers,1) - CALL Morison_PackCoefMembers( Re_Buf, Db_Buf, Int_Buf, InData%CoefMembers(i1), ErrStat2, ErrMsg2, OnlySize ) ! CoefMembers - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NMembers - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%InpMembers) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InpMembers,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InpMembers,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InpMembers,1), UBOUND(InData%InpMembers,1) - CALL Morison_PackMemberInputType( Re_Buf, Db_Buf, Int_Buf, InData%InpMembers(i1), ErrStat2, ErrMsg2, OnlySize ) ! InpMembers - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NFillGroups - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%FilledGroups) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FilledGroups,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FilledGroups,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FilledGroups,1), UBOUND(InData%FilledGroups,1) - CALL Morison_PackFilledGroupType( Re_Buf, Db_Buf, Int_Buf, InData%FilledGroups(i1), ErrStat2, ErrMsg2, OnlySize ) ! FilledGroups - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NMGDepths - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%MGDepths) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MGDepths,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MGDepths,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MGDepths,1), UBOUND(InData%MGDepths,1) - CALL Morison_PackMGDepthsType( Re_Buf, Db_Buf, Int_Buf, InData%MGDepths(i1), ErrStat2, ErrMsg2, OnlySize ) ! MGDepths - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - ReKiBuf(Re_Xferred) = InData%MGTop - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MGBottom - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NMOutputs - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%MOutLst) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MOutLst,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MOutLst,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MOutLst,1), UBOUND(InData%MOutLst,1) - CALL Morison_PackMOutput( Re_Buf, Db_Buf, Int_Buf, InData%MOutLst(i1), ErrStat2, ErrMsg2, OnlySize ) ! MOutLst - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NJOutputs - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%JOutLst) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%JOutLst,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%JOutLst,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%JOutLst,1), UBOUND(InData%JOutLst,1) - CALL Morison_PackJOutput( Re_Buf, Db_Buf, Int_Buf, InData%JOutLst(i1), ErrStat2, ErrMsg2, OnlySize ) ! JOutLst - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OutList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) - DO I = 1, LEN(InData%OutList) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UnSum - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveStMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MCFD - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Morison_PackInitInput - - SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Morison_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%Gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MSL2SWL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDisp = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%AMMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NJoints = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InpJoints not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InpJoints)) DEALLOCATE(OutData%InpJoints) - ALLOCATE(OutData%InpJoints(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InpJoints.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InpJoints,1), UBOUND(OutData%InpJoints,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Morison_UnpackJointType( Re_Buf, Db_Buf, Int_Buf, OutData%InpJoints(i1), ErrStat2, ErrMsg2 ) ! InpJoints - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Nodes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Nodes)) DEALLOCATE(OutData%Nodes) - ALLOCATE(OutData%Nodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Nodes,1), UBOUND(OutData%Nodes,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Morison_UnpackNodeType( Re_Buf, Db_Buf, Int_Buf, OutData%Nodes(i1), ErrStat2, ErrMsg2 ) ! Nodes - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - OutData%NAxCoefs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AxialCoefs not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AxialCoefs)) DEALLOCATE(OutData%AxialCoefs) - ALLOCATE(OutData%AxialCoefs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxialCoefs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AxialCoefs,1), UBOUND(OutData%AxialCoefs,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Morison_UnpackAxialCoefType( Re_Buf, Db_Buf, Int_Buf, OutData%AxialCoefs(i1), ErrStat2, ErrMsg2 ) ! AxialCoefs - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - OutData%NPropSets = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MPropSets not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MPropSets)) DEALLOCATE(OutData%MPropSets) - ALLOCATE(OutData%MPropSets(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MPropSets.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MPropSets,1), UBOUND(OutData%MPropSets,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Morison_UnpackMemberPropType( Re_Buf, Db_Buf, Int_Buf, OutData%MPropSets(i1), ErrStat2, ErrMsg2 ) ! MPropSets - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - OutData%SimplCd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SimplCdMG = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SimplCa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SimplCaMG = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SimplCp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SimplCpMG = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SimplAxCd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SimplAxCdMG = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SimplAxCa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SimplAxCaMG = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SimplAxCp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SimplAxCpMG = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SimplCb = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SimplCbMg = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SimplMCF = TRANSFER(IntKiBuf(Int_Xferred), OutData%SimplMCF) - Int_Xferred = Int_Xferred + 1 - OutData%NCoefDpth = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CoefDpths not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CoefDpths)) DEALLOCATE(OutData%CoefDpths) - ALLOCATE(OutData%CoefDpths(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CoefDpths.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CoefDpths,1), UBOUND(OutData%CoefDpths,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Morison_UnpackCoefDpths( Re_Buf, Db_Buf, Int_Buf, OutData%CoefDpths(i1), ErrStat2, ErrMsg2 ) ! CoefDpths - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - OutData%NCoefMembers = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CoefMembers not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CoefMembers)) DEALLOCATE(OutData%CoefMembers) - ALLOCATE(OutData%CoefMembers(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CoefMembers.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CoefMembers,1), UBOUND(OutData%CoefMembers,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Morison_UnpackCoefMembers( Re_Buf, Db_Buf, Int_Buf, OutData%CoefMembers(i1), ErrStat2, ErrMsg2 ) ! CoefMembers - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - OutData%NMembers = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InpMembers not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InpMembers)) DEALLOCATE(OutData%InpMembers) - ALLOCATE(OutData%InpMembers(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InpMembers.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InpMembers,1), UBOUND(OutData%InpMembers,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Morison_UnpackMemberInputType( Re_Buf, Db_Buf, Int_Buf, OutData%InpMembers(i1), ErrStat2, ErrMsg2 ) ! InpMembers - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - OutData%NFillGroups = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FilledGroups not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FilledGroups)) DEALLOCATE(OutData%FilledGroups) - ALLOCATE(OutData%FilledGroups(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FilledGroups.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FilledGroups,1), UBOUND(OutData%FilledGroups,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Morison_UnpackFilledGroupType( Re_Buf, Db_Buf, Int_Buf, OutData%FilledGroups(i1), ErrStat2, ErrMsg2 ) ! FilledGroups - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - OutData%NMGDepths = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MGDepths not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MGDepths)) DEALLOCATE(OutData%MGDepths) - ALLOCATE(OutData%MGDepths(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MGDepths.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MGDepths,1), UBOUND(OutData%MGDepths,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Morison_UnpackMGDepthsType( Re_Buf, Db_Buf, Int_Buf, OutData%MGDepths(i1), ErrStat2, ErrMsg2 ) ! MGDepths - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - OutData%MGTop = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MGBottom = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NMOutputs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MOutLst not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MOutLst)) DEALLOCATE(OutData%MOutLst) - ALLOCATE(OutData%MOutLst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MOutLst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MOutLst,1), UBOUND(OutData%MOutLst,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Morison_UnpackMOutput( Re_Buf, Db_Buf, Int_Buf, OutData%MOutLst(i1), ErrStat2, ErrMsg2 ) ! MOutLst - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - OutData%NJOutputs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! JOutLst not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%JOutLst)) DEALLOCATE(OutData%JOutLst) - ALLOCATE(OutData%JOutLst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%JOutLst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%JOutLst,1), UBOUND(OutData%JOutLst,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Morison_UnpackJOutput( Re_Buf, Db_Buf, Int_Buf, OutData%JOutLst(i1), ErrStat2, ErrMsg2 ) ! JOutLst - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutList not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutList)) DEALLOCATE(OutData%OutList) - ALLOCATE(OutData%OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) - DO I = 1, LEN(OutData%OutList) - OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UnSum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NStepWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WaveStMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MCFD = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - NULLIFY(OutData%WaveField) - END SUBROUTINE Morison_UnPackInitInput +subroutine Morison_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Morison_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackInitInput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + ! Gravity + call RegPack(Buf, InData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDens + call RegPack(Buf, InData%WtrDens) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDpth + call RegPack(Buf, InData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! MSL2SWL + call RegPack(Buf, InData%MSL2SWL) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDisp + call RegPack(Buf, InData%WaveDisp) + if (RegCheckErr(Buf, RoutineName)) return + ! AMMod + call RegPack(Buf, InData%AMMod) + if (RegCheckErr(Buf, RoutineName)) return + ! NJoints + call RegPack(Buf, InData%NJoints) + if (RegCheckErr(Buf, RoutineName)) return + ! NNodes + call RegPack(Buf, InData%NNodes) + if (RegCheckErr(Buf, RoutineName)) return + ! InpJoints + call RegPack(Buf, allocated(InData%InpJoints)) + if (allocated(InData%InpJoints)) then + call RegPackBounds(Buf, 1, lbound(InData%InpJoints), ubound(InData%InpJoints)) + LB(1:1) = lbound(InData%InpJoints) + UB(1:1) = ubound(InData%InpJoints) + do i1 = LB(1), UB(1) + call Morison_PackJointType(Buf, InData%InpJoints(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Nodes + call RegPack(Buf, allocated(InData%Nodes)) + if (allocated(InData%Nodes)) then + call RegPackBounds(Buf, 1, lbound(InData%Nodes), ubound(InData%Nodes)) + LB(1:1) = lbound(InData%Nodes) + UB(1:1) = ubound(InData%Nodes) + do i1 = LB(1), UB(1) + call Morison_PackNodeType(Buf, InData%Nodes(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NAxCoefs + call RegPack(Buf, InData%NAxCoefs) + if (RegCheckErr(Buf, RoutineName)) return + ! AxialCoefs + call RegPack(Buf, allocated(InData%AxialCoefs)) + if (allocated(InData%AxialCoefs)) then + call RegPackBounds(Buf, 1, lbound(InData%AxialCoefs), ubound(InData%AxialCoefs)) + LB(1:1) = lbound(InData%AxialCoefs) + UB(1:1) = ubound(InData%AxialCoefs) + do i1 = LB(1), UB(1) + call Morison_PackAxialCoefType(Buf, InData%AxialCoefs(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NPropSets + call RegPack(Buf, InData%NPropSets) + if (RegCheckErr(Buf, RoutineName)) return + ! MPropSets + call RegPack(Buf, allocated(InData%MPropSets)) + if (allocated(InData%MPropSets)) then + call RegPackBounds(Buf, 1, lbound(InData%MPropSets), ubound(InData%MPropSets)) + LB(1:1) = lbound(InData%MPropSets) + UB(1:1) = ubound(InData%MPropSets) + do i1 = LB(1), UB(1) + call Morison_PackMemberPropType(Buf, InData%MPropSets(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SimplCd + call RegPack(Buf, InData%SimplCd) + if (RegCheckErr(Buf, RoutineName)) return + ! SimplCdMG + call RegPack(Buf, InData%SimplCdMG) + if (RegCheckErr(Buf, RoutineName)) return + ! SimplCa + call RegPack(Buf, InData%SimplCa) + if (RegCheckErr(Buf, RoutineName)) return + ! SimplCaMG + call RegPack(Buf, InData%SimplCaMG) + if (RegCheckErr(Buf, RoutineName)) return + ! SimplCp + call RegPack(Buf, InData%SimplCp) + if (RegCheckErr(Buf, RoutineName)) return + ! SimplCpMG + call RegPack(Buf, InData%SimplCpMG) + if (RegCheckErr(Buf, RoutineName)) return + ! SimplAxCd + call RegPack(Buf, InData%SimplAxCd) + if (RegCheckErr(Buf, RoutineName)) return + ! SimplAxCdMG + call RegPack(Buf, InData%SimplAxCdMG) + if (RegCheckErr(Buf, RoutineName)) return + ! SimplAxCa + call RegPack(Buf, InData%SimplAxCa) + if (RegCheckErr(Buf, RoutineName)) return + ! SimplAxCaMG + call RegPack(Buf, InData%SimplAxCaMG) + if (RegCheckErr(Buf, RoutineName)) return + ! SimplAxCp + call RegPack(Buf, InData%SimplAxCp) + if (RegCheckErr(Buf, RoutineName)) return + ! SimplAxCpMG + call RegPack(Buf, InData%SimplAxCpMG) + if (RegCheckErr(Buf, RoutineName)) return + ! SimplCb + call RegPack(Buf, InData%SimplCb) + if (RegCheckErr(Buf, RoutineName)) return + ! SimplCbMg + call RegPack(Buf, InData%SimplCbMg) + if (RegCheckErr(Buf, RoutineName)) return + ! SimplMCF + call RegPack(Buf, InData%SimplMCF) + if (RegCheckErr(Buf, RoutineName)) return + ! NCoefDpth + call RegPack(Buf, InData%NCoefDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! CoefDpths + call RegPack(Buf, allocated(InData%CoefDpths)) + if (allocated(InData%CoefDpths)) then + call RegPackBounds(Buf, 1, lbound(InData%CoefDpths), ubound(InData%CoefDpths)) + LB(1:1) = lbound(InData%CoefDpths) + UB(1:1) = ubound(InData%CoefDpths) + do i1 = LB(1), UB(1) + call Morison_PackCoefDpths(Buf, InData%CoefDpths(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NCoefMembers + call RegPack(Buf, InData%NCoefMembers) + if (RegCheckErr(Buf, RoutineName)) return + ! CoefMembers + call RegPack(Buf, allocated(InData%CoefMembers)) + if (allocated(InData%CoefMembers)) then + call RegPackBounds(Buf, 1, lbound(InData%CoefMembers), ubound(InData%CoefMembers)) + LB(1:1) = lbound(InData%CoefMembers) + UB(1:1) = ubound(InData%CoefMembers) + do i1 = LB(1), UB(1) + call Morison_PackCoefMembers(Buf, InData%CoefMembers(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NMembers + call RegPack(Buf, InData%NMembers) + if (RegCheckErr(Buf, RoutineName)) return + ! InpMembers + call RegPack(Buf, allocated(InData%InpMembers)) + if (allocated(InData%InpMembers)) then + call RegPackBounds(Buf, 1, lbound(InData%InpMembers), ubound(InData%InpMembers)) + LB(1:1) = lbound(InData%InpMembers) + UB(1:1) = ubound(InData%InpMembers) + do i1 = LB(1), UB(1) + call Morison_PackMemberInputType(Buf, InData%InpMembers(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NFillGroups + call RegPack(Buf, InData%NFillGroups) + if (RegCheckErr(Buf, RoutineName)) return + ! FilledGroups + call RegPack(Buf, allocated(InData%FilledGroups)) + if (allocated(InData%FilledGroups)) then + call RegPackBounds(Buf, 1, lbound(InData%FilledGroups), ubound(InData%FilledGroups)) + LB(1:1) = lbound(InData%FilledGroups) + UB(1:1) = ubound(InData%FilledGroups) + do i1 = LB(1), UB(1) + call Morison_PackFilledGroupType(Buf, InData%FilledGroups(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NMGDepths + call RegPack(Buf, InData%NMGDepths) + if (RegCheckErr(Buf, RoutineName)) return + ! MGDepths + call RegPack(Buf, allocated(InData%MGDepths)) + if (allocated(InData%MGDepths)) then + call RegPackBounds(Buf, 1, lbound(InData%MGDepths), ubound(InData%MGDepths)) + LB(1:1) = lbound(InData%MGDepths) + UB(1:1) = ubound(InData%MGDepths) + do i1 = LB(1), UB(1) + call Morison_PackMGDepthsType(Buf, InData%MGDepths(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MGTop + call RegPack(Buf, InData%MGTop) + if (RegCheckErr(Buf, RoutineName)) return + ! MGBottom + call RegPack(Buf, InData%MGBottom) + if (RegCheckErr(Buf, RoutineName)) return + ! NMOutputs + call RegPack(Buf, InData%NMOutputs) + if (RegCheckErr(Buf, RoutineName)) return + ! MOutLst + call RegPack(Buf, allocated(InData%MOutLst)) + if (allocated(InData%MOutLst)) then + call RegPackBounds(Buf, 1, lbound(InData%MOutLst), ubound(InData%MOutLst)) + LB(1:1) = lbound(InData%MOutLst) + UB(1:1) = ubound(InData%MOutLst) + do i1 = LB(1), UB(1) + call Morison_PackMOutput(Buf, InData%MOutLst(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NJOutputs + call RegPack(Buf, InData%NJOutputs) + if (RegCheckErr(Buf, RoutineName)) return + ! JOutLst + call RegPack(Buf, allocated(InData%JOutLst)) + if (allocated(InData%JOutLst)) then + call RegPackBounds(Buf, 1, lbound(InData%JOutLst), ubound(InData%JOutLst)) + LB(1:1) = lbound(InData%JOutLst) + UB(1:1) = ubound(InData%JOutLst) + do i1 = LB(1), UB(1) + call Morison_PackJOutput(Buf, InData%JOutLst(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OutList + call RegPack(Buf, allocated(InData%OutList)) + if (allocated(InData%OutList)) then + call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) + call RegPack(Buf, InData%OutList) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegPack(Buf, InData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! UnSum + call RegPack(Buf, InData%UnSum) + if (RegCheckErr(Buf, RoutineName)) return + ! NStepWave + call RegPack(Buf, InData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveStMod + call RegPack(Buf, InData%WaveStMod) + if (RegCheckErr(Buf, RoutineName)) return + ! MCFD + call RegPack(Buf, InData%MCFD) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveField + call RegPack(Buf, associated(InData%WaveField)) + if (associated(InData%WaveField)) then + call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) + if (.not. PtrInIndex) then + call SeaSt_WaveField_PackSeaSt_WaveFieldType(Buf, InData%WaveField) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Morison_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackInitInput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + ! Gravity + call RegUnpack(Buf, OutData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDens + call RegUnpack(Buf, OutData%WtrDens) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDpth + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! MSL2SWL + call RegUnpack(Buf, OutData%MSL2SWL) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDisp + call RegUnpack(Buf, OutData%WaveDisp) + if (RegCheckErr(Buf, RoutineName)) return + ! AMMod + call RegUnpack(Buf, OutData%AMMod) + if (RegCheckErr(Buf, RoutineName)) return + ! NJoints + call RegUnpack(Buf, OutData%NJoints) + if (RegCheckErr(Buf, RoutineName)) return + ! NNodes + call RegUnpack(Buf, OutData%NNodes) + if (RegCheckErr(Buf, RoutineName)) return + ! InpJoints + if (allocated(OutData%InpJoints)) deallocate(OutData%InpJoints) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InpJoints(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InpJoints.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Morison_UnpackJointType(Buf, OutData%InpJoints(i1)) ! InpJoints + end do + end if + ! Nodes + if (allocated(OutData%Nodes)) deallocate(OutData%Nodes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Nodes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Morison_UnpackNodeType(Buf, OutData%Nodes(i1)) ! Nodes + end do + end if + ! NAxCoefs + call RegUnpack(Buf, OutData%NAxCoefs) + if (RegCheckErr(Buf, RoutineName)) return + ! AxialCoefs + if (allocated(OutData%AxialCoefs)) deallocate(OutData%AxialCoefs) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AxialCoefs(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxialCoefs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Morison_UnpackAxialCoefType(Buf, OutData%AxialCoefs(i1)) ! AxialCoefs + end do + end if + ! NPropSets + call RegUnpack(Buf, OutData%NPropSets) + if (RegCheckErr(Buf, RoutineName)) return + ! MPropSets + if (allocated(OutData%MPropSets)) deallocate(OutData%MPropSets) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MPropSets(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MPropSets.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Morison_UnpackMemberPropType(Buf, OutData%MPropSets(i1)) ! MPropSets + end do + end if + ! SimplCd + call RegUnpack(Buf, OutData%SimplCd) + if (RegCheckErr(Buf, RoutineName)) return + ! SimplCdMG + call RegUnpack(Buf, OutData%SimplCdMG) + if (RegCheckErr(Buf, RoutineName)) return + ! SimplCa + call RegUnpack(Buf, OutData%SimplCa) + if (RegCheckErr(Buf, RoutineName)) return + ! SimplCaMG + call RegUnpack(Buf, OutData%SimplCaMG) + if (RegCheckErr(Buf, RoutineName)) return + ! SimplCp + call RegUnpack(Buf, OutData%SimplCp) + if (RegCheckErr(Buf, RoutineName)) return + ! SimplCpMG + call RegUnpack(Buf, OutData%SimplCpMG) + if (RegCheckErr(Buf, RoutineName)) return + ! SimplAxCd + call RegUnpack(Buf, OutData%SimplAxCd) + if (RegCheckErr(Buf, RoutineName)) return + ! SimplAxCdMG + call RegUnpack(Buf, OutData%SimplAxCdMG) + if (RegCheckErr(Buf, RoutineName)) return + ! SimplAxCa + call RegUnpack(Buf, OutData%SimplAxCa) + if (RegCheckErr(Buf, RoutineName)) return + ! SimplAxCaMG + call RegUnpack(Buf, OutData%SimplAxCaMG) + if (RegCheckErr(Buf, RoutineName)) return + ! SimplAxCp + call RegUnpack(Buf, OutData%SimplAxCp) + if (RegCheckErr(Buf, RoutineName)) return + ! SimplAxCpMG + call RegUnpack(Buf, OutData%SimplAxCpMG) + if (RegCheckErr(Buf, RoutineName)) return + ! SimplCb + call RegUnpack(Buf, OutData%SimplCb) + if (RegCheckErr(Buf, RoutineName)) return + ! SimplCbMg + call RegUnpack(Buf, OutData%SimplCbMg) + if (RegCheckErr(Buf, RoutineName)) return + ! SimplMCF + call RegUnpack(Buf, OutData%SimplMCF) + if (RegCheckErr(Buf, RoutineName)) return + ! NCoefDpth + call RegUnpack(Buf, OutData%NCoefDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! CoefDpths + if (allocated(OutData%CoefDpths)) deallocate(OutData%CoefDpths) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CoefDpths(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CoefDpths.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Morison_UnpackCoefDpths(Buf, OutData%CoefDpths(i1)) ! CoefDpths + end do + end if + ! NCoefMembers + call RegUnpack(Buf, OutData%NCoefMembers) + if (RegCheckErr(Buf, RoutineName)) return + ! CoefMembers + if (allocated(OutData%CoefMembers)) deallocate(OutData%CoefMembers) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CoefMembers(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CoefMembers.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Morison_UnpackCoefMembers(Buf, OutData%CoefMembers(i1)) ! CoefMembers + end do + end if + ! NMembers + call RegUnpack(Buf, OutData%NMembers) + if (RegCheckErr(Buf, RoutineName)) return + ! InpMembers + if (allocated(OutData%InpMembers)) deallocate(OutData%InpMembers) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InpMembers(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InpMembers.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Morison_UnpackMemberInputType(Buf, OutData%InpMembers(i1)) ! InpMembers + end do + end if + ! NFillGroups + call RegUnpack(Buf, OutData%NFillGroups) + if (RegCheckErr(Buf, RoutineName)) return + ! FilledGroups + if (allocated(OutData%FilledGroups)) deallocate(OutData%FilledGroups) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FilledGroups(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FilledGroups.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Morison_UnpackFilledGroupType(Buf, OutData%FilledGroups(i1)) ! FilledGroups + end do + end if + ! NMGDepths + call RegUnpack(Buf, OutData%NMGDepths) + if (RegCheckErr(Buf, RoutineName)) return + ! MGDepths + if (allocated(OutData%MGDepths)) deallocate(OutData%MGDepths) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MGDepths(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MGDepths.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Morison_UnpackMGDepthsType(Buf, OutData%MGDepths(i1)) ! MGDepths + end do + end if + ! MGTop + call RegUnpack(Buf, OutData%MGTop) + if (RegCheckErr(Buf, RoutineName)) return + ! MGBottom + call RegUnpack(Buf, OutData%MGBottom) + if (RegCheckErr(Buf, RoutineName)) return + ! NMOutputs + call RegUnpack(Buf, OutData%NMOutputs) + if (RegCheckErr(Buf, RoutineName)) return + ! MOutLst + if (allocated(OutData%MOutLst)) deallocate(OutData%MOutLst) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MOutLst(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MOutLst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Morison_UnpackMOutput(Buf, OutData%MOutLst(i1)) ! MOutLst + end do + end if + ! NJOutputs + call RegUnpack(Buf, OutData%NJOutputs) + if (RegCheckErr(Buf, RoutineName)) return + ! JOutLst + if (allocated(OutData%JOutLst)) deallocate(OutData%JOutLst) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%JOutLst(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%JOutLst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Morison_UnpackJOutput(Buf, OutData%JOutLst(i1)) ! JOutLst + end do + end if + ! OutList + if (allocated(OutData%OutList)) deallocate(OutData%OutList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutList) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NumOuts + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! UnSum + call RegUnpack(Buf, OutData%UnSum) + if (RegCheckErr(Buf, RoutineName)) return + ! NStepWave + call RegUnpack(Buf, OutData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveStMod + call RegUnpack(Buf, OutData%WaveStMod) + if (RegCheckErr(Buf, RoutineName)) return + ! MCFD + call RegUnpack(Buf, OutData%MCFD) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveField + if (associated(OutData%WaveField)) deallocate(OutData%WaveField) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveField) + else + allocate(OutData%WaveField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveField) + call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(Buf, OutData%WaveField) ! WaveField + end if + else + OutData%WaveField => null() + end if +end subroutine SUBROUTINE Morison_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(Morison_InitOutputType), INTENT(IN) :: SrcInitOutputData TYPE(Morison_InitOutputType), INTENT(INOUT) :: DstInitOutputData @@ -8259,183 +5232,67 @@ SUBROUTINE Morison_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE Morison_DestroyInitOutput - SUBROUTINE Morison_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Morison_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! WriteOutputHdr allocated yes/no - IF ( ALLOCATED(InData%WriteOutputHdr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdr upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdr)*LEN(InData%WriteOutputHdr) ! WriteOutputHdr - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputUnt allocated yes/no - IF ( ALLOCATED(InData%WriteOutputUnt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUnt upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUnt)*LEN(InData%WriteOutputUnt) ! WriteOutputUnt - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%WriteOutputHdr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) - DO I = 1, LEN(InData%WriteOutputHdr) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputUnt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) - DO I = 1, LEN(InData%WriteOutputUnt) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - END SUBROUTINE Morison_PackInitOutput - - SUBROUTINE Morison_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Morison_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputHdr)) DEALLOCATE(OutData%WriteOutputHdr) - ALLOCATE(OutData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) - DO I = 1, LEN(OutData%WriteOutputHdr) - OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputUnt)) DEALLOCATE(OutData%WriteOutputUnt) - ALLOCATE(OutData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) - DO I = 1, LEN(OutData%WriteOutputUnt) - OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - END SUBROUTINE Morison_UnPackInitOutput +subroutine Morison_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Morison_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! WriteOutputHdr + call RegPack(Buf, allocated(InData%WriteOutputHdr)) + if (allocated(InData%WriteOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPack(Buf, InData%WriteOutputHdr) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutputUnt + call RegPack(Buf, allocated(InData%WriteOutputUnt)) + if (allocated(InData%WriteOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPack(Buf, InData%WriteOutputUnt) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Morison_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackInitOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! WriteOutputHdr + if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WriteOutputUnt + if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE Morison_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(Morison_ContinuousStateType), INTENT(IN) :: SrcContStateData TYPE(Morison_ContinuousStateType), INTENT(INOUT) :: DstContStateData @@ -8468,103 +5325,26 @@ SUBROUTINE Morison_DestroyContState( ContStateData, ErrStat, ErrMsg ) END SUBROUTINE Morison_DestroyContState - SUBROUTINE Morison_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Morison_ContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_PackContState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyContState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Morison_PackContState - - SUBROUTINE Morison_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Morison_ContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackContState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyContState = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Morison_UnPackContState +subroutine Morison_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Morison_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyContState + call RegPack(Buf, InData%DummyContState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Morison_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackContState' + if (Buf%ErrStat /= ErrID_None) return + ! DummyContState + call RegUnpack(Buf, OutData%DummyContState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE Morison_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(Morison_DiscreteStateType), INTENT(IN) :: SrcDiscStateData TYPE(Morison_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData @@ -8607,142 +5387,50 @@ SUBROUTINE Morison_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) ErrStat = ErrID_None ErrMsg = "" -IF (ALLOCATED(DiscStateData%V_rel_n_FiltStat)) THEN - DEALLOCATE(DiscStateData%V_rel_n_FiltStat) -ENDIF - END SUBROUTINE Morison_DestroyDiscState - - SUBROUTINE Morison_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Morison_DiscreteStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_PackDiscState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! V_rel_n_FiltStat allocated yes/no - IF ( ALLOCATED(InData%V_rel_n_FiltStat) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! V_rel_n_FiltStat upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%V_rel_n_FiltStat) ! V_rel_n_FiltStat - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END 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%V_rel_n_FiltStat) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%V_rel_n_FiltStat,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V_rel_n_FiltStat,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%V_rel_n_FiltStat,1), UBOUND(InData%V_rel_n_FiltStat,1) - ReKiBuf(Re_Xferred) = InData%V_rel_n_FiltStat(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE Morison_PackDiscState - - SUBROUTINE Morison_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Morison_DiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackDiscState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! V_rel_n_FiltStat not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%V_rel_n_FiltStat)) DEALLOCATE(OutData%V_rel_n_FiltStat) - ALLOCATE(OutData%V_rel_n_FiltStat(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%V_rel_n_FiltStat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%V_rel_n_FiltStat,1), UBOUND(OutData%V_rel_n_FiltStat,1) - OutData%V_rel_n_FiltStat(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE Morison_UnPackDiscState - +IF (ALLOCATED(DiscStateData%V_rel_n_FiltStat)) THEN + DEALLOCATE(DiscStateData%V_rel_n_FiltStat) +ENDIF + END SUBROUTINE Morison_DestroyDiscState + + +subroutine Morison_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Morison_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + ! V_rel_n_FiltStat + call RegPack(Buf, allocated(InData%V_rel_n_FiltStat)) + if (allocated(InData%V_rel_n_FiltStat)) then + call RegPackBounds(Buf, 1, lbound(InData%V_rel_n_FiltStat), ubound(InData%V_rel_n_FiltStat)) + call RegPack(Buf, InData%V_rel_n_FiltStat) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Morison_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackDiscState' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! V_rel_n_FiltStat + if (allocated(OutData%V_rel_n_FiltStat)) deallocate(OutData%V_rel_n_FiltStat) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%V_rel_n_FiltStat(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%V_rel_n_FiltStat.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%V_rel_n_FiltStat) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE Morison_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(Morison_ConstraintStateType), INTENT(IN) :: SrcConstrStateData TYPE(Morison_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData @@ -8775,103 +5463,26 @@ SUBROUTINE Morison_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) END SUBROUTINE Morison_DestroyConstrState - SUBROUTINE Morison_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Morison_ConstraintStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_PackConstrState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyConstrState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Morison_PackConstrState - - SUBROUTINE Morison_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Morison_ConstraintStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackConstrState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyConstrState = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Morison_UnPackConstrState +subroutine Morison_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Morison_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyConstrState + call RegPack(Buf, InData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Morison_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + ! DummyConstrState + call RegUnpack(Buf, OutData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE Morison_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(Morison_OtherStateType), INTENT(IN) :: SrcOtherStateData TYPE(Morison_OtherStateType), INTENT(INOUT) :: DstOtherStateData @@ -8904,103 +5515,26 @@ SUBROUTINE Morison_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) END SUBROUTINE Morison_DestroyOtherState - SUBROUTINE Morison_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Morison_OtherStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_PackOtherState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! DummyOtherState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%DummyOtherState - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Morison_PackOtherState - - SUBROUTINE Morison_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Morison_OtherStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackOtherState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyOtherState = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Morison_UnPackOtherState +subroutine Morison_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Morison_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackOtherState' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyOtherState + call RegPack(Buf, InData%DummyOtherState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Morison_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackOtherState' + if (Buf%ErrStat /= ErrID_None) return + ! DummyOtherState + call RegUnpack(Buf, OutData%DummyOtherState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE Morison_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) TYPE(Morison_MiscVarType), INTENT(IN) :: SrcMiscData TYPE(Morison_MiscVarType), INTENT(INOUT) :: DstMiscData @@ -9333,972 +5867,433 @@ SUBROUTINE Morison_DestroyMisc( MiscData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE Morison_DestroyMisc - SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Morison_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! FV allocated yes/no - IF ( ALLOCATED(InData%FV) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FV upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FV) ! FV - END IF - Int_BufSz = Int_BufSz + 1 ! FA allocated yes/no - IF ( ALLOCATED(InData%FA) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FA upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FA) ! FA - END IF - Int_BufSz = Int_BufSz + 1 ! FAMCF allocated yes/no - IF ( ALLOCATED(InData%FAMCF) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FAMCF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FAMCF) ! FAMCF - END IF - Int_BufSz = Int_BufSz + 1 ! FDynP allocated yes/no - IF ( ALLOCATED(InData%FDynP) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FDynP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FDynP) ! FDynP - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElev allocated yes/no - IF ( ALLOCATED(InData%WaveElev) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveElev upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev) ! WaveElev - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElev1 allocated yes/no - IF ( ALLOCATED(InData%WaveElev1) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveElev1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev1) ! WaveElev1 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElev2 allocated yes/no - IF ( ALLOCATED(InData%WaveElev2) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveElev2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev2) ! WaveElev2 - END IF - Int_BufSz = Int_BufSz + 1 ! vrel allocated yes/no - IF ( ALLOCATED(InData%vrel) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! vrel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%vrel) ! vrel - END IF - Int_BufSz = Int_BufSz + 1 ! nodeInWater allocated yes/no - IF ( ALLOCATED(InData%nodeInWater) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! nodeInWater upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%nodeInWater) ! nodeInWater - END IF - Int_BufSz = Int_BufSz + 1 ! memberLoads allocated yes/no - IF ( ALLOCATED(InData%memberLoads) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! memberLoads upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%memberLoads,1), UBOUND(InData%memberLoads,1) - Int_BufSz = Int_BufSz + 3 ! memberLoads: size of buffers for each call to pack subtype - CALL Morison_PackMemberLoads( Re_Buf, Db_Buf, Int_Buf, InData%memberLoads(i1), ErrStat2, ErrMsg2, .TRUE. ) ! memberLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! memberLoads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! memberLoads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! memberLoads - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! F_B_End allocated yes/no - IF ( ALLOCATED(InData%F_B_End) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_B_End upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_B_End) ! F_B_End - END IF - Int_BufSz = Int_BufSz + 1 ! F_D_End allocated yes/no - IF ( ALLOCATED(InData%F_D_End) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_D_End upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_D_End) ! F_D_End - END IF - Int_BufSz = Int_BufSz + 1 ! F_I_End allocated yes/no - IF ( ALLOCATED(InData%F_I_End) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_I_End upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_I_End) ! F_I_End - END IF - Int_BufSz = Int_BufSz + 1 ! F_IMG_End allocated yes/no - IF ( ALLOCATED(InData%F_IMG_End) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_IMG_End upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_IMG_End) ! F_IMG_End - END IF - Int_BufSz = Int_BufSz + 1 ! F_A_End allocated yes/no - IF ( ALLOCATED(InData%F_A_End) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_A_End upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_A_End) ! F_A_End - END IF - Int_BufSz = Int_BufSz + 1 ! F_BF_End allocated yes/no - IF ( ALLOCATED(InData%F_BF_End) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_BF_End upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_BF_End) ! F_BF_End - END IF - Int_BufSz = Int_BufSz + 1 ! V_rel_n allocated yes/no - IF ( ALLOCATED(InData%V_rel_n) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! V_rel_n upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%V_rel_n) ! V_rel_n - END IF - Int_BufSz = Int_BufSz + 1 ! V_rel_n_HiPass allocated yes/no - IF ( ALLOCATED(InData%V_rel_n_HiPass) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! V_rel_n_HiPass upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%V_rel_n_HiPass) ! V_rel_n_HiPass - END IF - Int_BufSz = Int_BufSz + 1 ! LastIndWave - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%FV) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FV,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FV,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FV,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FV,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FV,2), UBOUND(InData%FV,2) - DO i1 = LBOUND(InData%FV,1), UBOUND(InData%FV,1) - ReKiBuf(Re_Xferred) = InData%FV(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FA) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FA,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FA,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FA,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FA,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FA,2), UBOUND(InData%FA,2) - DO i1 = LBOUND(InData%FA,1), UBOUND(InData%FA,1) - ReKiBuf(Re_Xferred) = InData%FA(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FAMCF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FAMCF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAMCF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FAMCF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAMCF,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FAMCF,2), UBOUND(InData%FAMCF,2) - DO i1 = LBOUND(InData%FAMCF,1), UBOUND(InData%FAMCF,1) - ReKiBuf(Re_Xferred) = InData%FAMCF(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FDynP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FDynP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FDynP,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FDynP,1), UBOUND(InData%FDynP,1) - ReKiBuf(Re_Xferred) = InData%FDynP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveElev) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveElev,1), UBOUND(InData%WaveElev,1) - ReKiBuf(Re_Xferred) = InData%WaveElev(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveElev1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev1,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveElev1,1), UBOUND(InData%WaveElev1,1) - ReKiBuf(Re_Xferred) = InData%WaveElev1(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveElev2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev2,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveElev2,1), UBOUND(InData%WaveElev2,1) - ReKiBuf(Re_Xferred) = InData%WaveElev2(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%vrel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vrel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vrel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vrel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vrel,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%vrel,2), UBOUND(InData%vrel,2) - DO i1 = LBOUND(InData%vrel,1), UBOUND(InData%vrel,1) - ReKiBuf(Re_Xferred) = InData%vrel(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%nodeInWater) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%nodeInWater,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nodeInWater,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%nodeInWater,1), UBOUND(InData%nodeInWater,1) - IntKiBuf(Int_Xferred) = InData%nodeInWater(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%memberLoads) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%memberLoads,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%memberLoads,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%memberLoads,1), UBOUND(InData%memberLoads,1) - CALL Morison_PackMemberLoads( Re_Buf, Db_Buf, Int_Buf, InData%memberLoads(i1), ErrStat2, ErrMsg2, OnlySize ) ! memberLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_B_End) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_B_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_B_End,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_B_End,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_B_End,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_B_End,2), UBOUND(InData%F_B_End,2) - DO i1 = LBOUND(InData%F_B_End,1), UBOUND(InData%F_B_End,1) - ReKiBuf(Re_Xferred) = InData%F_B_End(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_D_End) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_D_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_D_End,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_D_End,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_D_End,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_D_End,2), UBOUND(InData%F_D_End,2) - DO i1 = LBOUND(InData%F_D_End,1), UBOUND(InData%F_D_End,1) - ReKiBuf(Re_Xferred) = InData%F_D_End(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_I_End) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_I_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_I_End,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_I_End,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_I_End,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_I_End,2), UBOUND(InData%F_I_End,2) - DO i1 = LBOUND(InData%F_I_End,1), UBOUND(InData%F_I_End,1) - ReKiBuf(Re_Xferred) = InData%F_I_End(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_IMG_End) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_IMG_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_IMG_End,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_IMG_End,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_IMG_End,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_IMG_End,2), UBOUND(InData%F_IMG_End,2) - DO i1 = LBOUND(InData%F_IMG_End,1), UBOUND(InData%F_IMG_End,1) - ReKiBuf(Re_Xferred) = InData%F_IMG_End(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_A_End) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_A_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_A_End,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_A_End,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_A_End,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_A_End,2), UBOUND(InData%F_A_End,2) - DO i1 = LBOUND(InData%F_A_End,1), UBOUND(InData%F_A_End,1) - ReKiBuf(Re_Xferred) = InData%F_A_End(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_BF_End) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_BF_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_BF_End,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_BF_End,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_BF_End,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_BF_End,2), UBOUND(InData%F_BF_End,2) - DO i1 = LBOUND(InData%F_BF_End,1), UBOUND(InData%F_BF_End,1) - ReKiBuf(Re_Xferred) = InData%F_BF_End(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%V_rel_n) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%V_rel_n,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V_rel_n,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%V_rel_n,1), UBOUND(InData%V_rel_n,1) - ReKiBuf(Re_Xferred) = InData%V_rel_n(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%V_rel_n_HiPass) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%V_rel_n_HiPass,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V_rel_n_HiPass,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%V_rel_n_HiPass,1), UBOUND(InData%V_rel_n_HiPass,1) - ReKiBuf(Re_Xferred) = InData%V_rel_n_HiPass(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%LastIndWave - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Morison_PackMisc - - SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Morison_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FV not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FV)) DEALLOCATE(OutData%FV) - ALLOCATE(OutData%FV(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FV,2), UBOUND(OutData%FV,2) - DO i1 = LBOUND(OutData%FV,1), UBOUND(OutData%FV,1) - OutData%FV(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FA not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FA)) DEALLOCATE(OutData%FA) - ALLOCATE(OutData%FA(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FA,2), UBOUND(OutData%FA,2) - DO i1 = LBOUND(OutData%FA,1), UBOUND(OutData%FA,1) - OutData%FA(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FAMCF not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FAMCF)) DEALLOCATE(OutData%FAMCF) - ALLOCATE(OutData%FAMCF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAMCF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FAMCF,2), UBOUND(OutData%FAMCF,2) - DO i1 = LBOUND(OutData%FAMCF,1), UBOUND(OutData%FAMCF,1) - OutData%FAMCF(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FDynP not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FDynP)) DEALLOCATE(OutData%FDynP) - ALLOCATE(OutData%FDynP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FDynP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FDynP,1), UBOUND(OutData%FDynP,1) - OutData%FDynP(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveElev)) DEALLOCATE(OutData%WaveElev) - ALLOCATE(OutData%WaveElev(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveElev,1), UBOUND(OutData%WaveElev,1) - OutData%WaveElev(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveElev1)) DEALLOCATE(OutData%WaveElev1) - ALLOCATE(OutData%WaveElev1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveElev1,1), UBOUND(OutData%WaveElev1,1) - OutData%WaveElev1(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveElev2)) DEALLOCATE(OutData%WaveElev2) - ALLOCATE(OutData%WaveElev2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveElev2,1), UBOUND(OutData%WaveElev2,1) - OutData%WaveElev2(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! vrel not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%vrel)) DEALLOCATE(OutData%vrel) - ALLOCATE(OutData%vrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%vrel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%vrel,2), UBOUND(OutData%vrel,2) - DO i1 = LBOUND(OutData%vrel,1), UBOUND(OutData%vrel,1) - OutData%vrel(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nodeInWater not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%nodeInWater)) DEALLOCATE(OutData%nodeInWater) - ALLOCATE(OutData%nodeInWater(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nodeInWater.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%nodeInWater,1), UBOUND(OutData%nodeInWater,1) - OutData%nodeInWater(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! memberLoads not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%memberLoads)) DEALLOCATE(OutData%memberLoads) - ALLOCATE(OutData%memberLoads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%memberLoads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%memberLoads,1), UBOUND(OutData%memberLoads,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Morison_UnpackMemberLoads( Re_Buf, Db_Buf, Int_Buf, OutData%memberLoads(i1), ErrStat2, ErrMsg2 ) ! memberLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_B_End not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_B_End)) DEALLOCATE(OutData%F_B_End) - ALLOCATE(OutData%F_B_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_B_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_B_End,2), UBOUND(OutData%F_B_End,2) - DO i1 = LBOUND(OutData%F_B_End,1), UBOUND(OutData%F_B_End,1) - OutData%F_B_End(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_D_End not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_D_End)) DEALLOCATE(OutData%F_D_End) - ALLOCATE(OutData%F_D_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_D_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_D_End,2), UBOUND(OutData%F_D_End,2) - DO i1 = LBOUND(OutData%F_D_End,1), UBOUND(OutData%F_D_End,1) - OutData%F_D_End(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_I_End not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_I_End)) DEALLOCATE(OutData%F_I_End) - ALLOCATE(OutData%F_I_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_I_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_I_End,2), UBOUND(OutData%F_I_End,2) - DO i1 = LBOUND(OutData%F_I_End,1), UBOUND(OutData%F_I_End,1) - OutData%F_I_End(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_IMG_End not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_IMG_End)) DEALLOCATE(OutData%F_IMG_End) - ALLOCATE(OutData%F_IMG_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_IMG_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_IMG_End,2), UBOUND(OutData%F_IMG_End,2) - DO i1 = LBOUND(OutData%F_IMG_End,1), UBOUND(OutData%F_IMG_End,1) - OutData%F_IMG_End(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_A_End not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_A_End)) DEALLOCATE(OutData%F_A_End) - ALLOCATE(OutData%F_A_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_A_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_A_End,2), UBOUND(OutData%F_A_End,2) - DO i1 = LBOUND(OutData%F_A_End,1), UBOUND(OutData%F_A_End,1) - OutData%F_A_End(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_BF_End not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_BF_End)) DEALLOCATE(OutData%F_BF_End) - ALLOCATE(OutData%F_BF_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_BF_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_BF_End,2), UBOUND(OutData%F_BF_End,2) - DO i1 = LBOUND(OutData%F_BF_End,1), UBOUND(OutData%F_BF_End,1) - OutData%F_BF_End(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! V_rel_n not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%V_rel_n)) DEALLOCATE(OutData%V_rel_n) - ALLOCATE(OutData%V_rel_n(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%V_rel_n.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%V_rel_n,1), UBOUND(OutData%V_rel_n,1) - OutData%V_rel_n(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! V_rel_n_HiPass not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%V_rel_n_HiPass)) DEALLOCATE(OutData%V_rel_n_HiPass) - ALLOCATE(OutData%V_rel_n_HiPass(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%V_rel_n_HiPass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%V_rel_n_HiPass,1), UBOUND(OutData%V_rel_n_HiPass,1) - OutData%V_rel_n_HiPass(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%LastIndWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Morison_UnPackMisc +subroutine Morison_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Morison_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackMisc' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + ! FV + call RegPack(Buf, allocated(InData%FV)) + if (allocated(InData%FV)) then + call RegPackBounds(Buf, 2, lbound(InData%FV), ubound(InData%FV)) + call RegPack(Buf, InData%FV) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FA + call RegPack(Buf, allocated(InData%FA)) + if (allocated(InData%FA)) then + call RegPackBounds(Buf, 2, lbound(InData%FA), ubound(InData%FA)) + call RegPack(Buf, InData%FA) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FAMCF + call RegPack(Buf, allocated(InData%FAMCF)) + if (allocated(InData%FAMCF)) then + call RegPackBounds(Buf, 2, lbound(InData%FAMCF), ubound(InData%FAMCF)) + call RegPack(Buf, InData%FAMCF) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FDynP + call RegPack(Buf, allocated(InData%FDynP)) + if (allocated(InData%FDynP)) then + call RegPackBounds(Buf, 1, lbound(InData%FDynP), ubound(InData%FDynP)) + call RegPack(Buf, InData%FDynP) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElev + call RegPack(Buf, allocated(InData%WaveElev)) + if (allocated(InData%WaveElev)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveElev), ubound(InData%WaveElev)) + call RegPack(Buf, InData%WaveElev) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElev1 + call RegPack(Buf, allocated(InData%WaveElev1)) + if (allocated(InData%WaveElev1)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveElev1), ubound(InData%WaveElev1)) + call RegPack(Buf, InData%WaveElev1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElev2 + call RegPack(Buf, allocated(InData%WaveElev2)) + if (allocated(InData%WaveElev2)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveElev2), ubound(InData%WaveElev2)) + call RegPack(Buf, InData%WaveElev2) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! vrel + call RegPack(Buf, allocated(InData%vrel)) + if (allocated(InData%vrel)) then + call RegPackBounds(Buf, 2, lbound(InData%vrel), ubound(InData%vrel)) + call RegPack(Buf, InData%vrel) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! nodeInWater + call RegPack(Buf, allocated(InData%nodeInWater)) + if (allocated(InData%nodeInWater)) then + call RegPackBounds(Buf, 1, lbound(InData%nodeInWater), ubound(InData%nodeInWater)) + call RegPack(Buf, InData%nodeInWater) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! memberLoads + call RegPack(Buf, allocated(InData%memberLoads)) + if (allocated(InData%memberLoads)) then + call RegPackBounds(Buf, 1, lbound(InData%memberLoads), ubound(InData%memberLoads)) + LB(1:1) = lbound(InData%memberLoads) + UB(1:1) = ubound(InData%memberLoads) + do i1 = LB(1), UB(1) + call Morison_PackMemberLoads(Buf, InData%memberLoads(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! F_B_End + call RegPack(Buf, allocated(InData%F_B_End)) + if (allocated(InData%F_B_End)) then + call RegPackBounds(Buf, 2, lbound(InData%F_B_End), ubound(InData%F_B_End)) + call RegPack(Buf, InData%F_B_End) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! F_D_End + call RegPack(Buf, allocated(InData%F_D_End)) + if (allocated(InData%F_D_End)) then + call RegPackBounds(Buf, 2, lbound(InData%F_D_End), ubound(InData%F_D_End)) + call RegPack(Buf, InData%F_D_End) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! F_I_End + call RegPack(Buf, allocated(InData%F_I_End)) + if (allocated(InData%F_I_End)) then + call RegPackBounds(Buf, 2, lbound(InData%F_I_End), ubound(InData%F_I_End)) + call RegPack(Buf, InData%F_I_End) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! F_IMG_End + call RegPack(Buf, allocated(InData%F_IMG_End)) + if (allocated(InData%F_IMG_End)) then + call RegPackBounds(Buf, 2, lbound(InData%F_IMG_End), ubound(InData%F_IMG_End)) + call RegPack(Buf, InData%F_IMG_End) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! F_A_End + call RegPack(Buf, allocated(InData%F_A_End)) + if (allocated(InData%F_A_End)) then + call RegPackBounds(Buf, 2, lbound(InData%F_A_End), ubound(InData%F_A_End)) + call RegPack(Buf, InData%F_A_End) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! F_BF_End + call RegPack(Buf, allocated(InData%F_BF_End)) + if (allocated(InData%F_BF_End)) then + call RegPackBounds(Buf, 2, lbound(InData%F_BF_End), ubound(InData%F_BF_End)) + call RegPack(Buf, InData%F_BF_End) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! V_rel_n + call RegPack(Buf, allocated(InData%V_rel_n)) + if (allocated(InData%V_rel_n)) then + call RegPackBounds(Buf, 1, lbound(InData%V_rel_n), ubound(InData%V_rel_n)) + call RegPack(Buf, InData%V_rel_n) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! V_rel_n_HiPass + call RegPack(Buf, allocated(InData%V_rel_n_HiPass)) + if (allocated(InData%V_rel_n_HiPass)) then + call RegPackBounds(Buf, 1, lbound(InData%V_rel_n_HiPass), ubound(InData%V_rel_n_HiPass)) + call RegPack(Buf, InData%V_rel_n_HiPass) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LastIndWave + call RegPack(Buf, InData%LastIndWave) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Morison_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackMisc' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! FV + if (allocated(OutData%FV)) deallocate(OutData%FV) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FV(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FV.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FV) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! FA + if (allocated(OutData%FA)) deallocate(OutData%FA) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FA(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FA.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FA) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! FAMCF + if (allocated(OutData%FAMCF)) deallocate(OutData%FAMCF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FAMCF(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAMCF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FAMCF) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! FDynP + if (allocated(OutData%FDynP)) deallocate(OutData%FDynP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FDynP(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FDynP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FDynP) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WaveElev + if (allocated(OutData%WaveElev)) deallocate(OutData%WaveElev) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveElev(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveElev) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WaveElev1 + if (allocated(OutData%WaveElev1)) deallocate(OutData%WaveElev1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveElev1(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveElev1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WaveElev2 + if (allocated(OutData%WaveElev2)) deallocate(OutData%WaveElev2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveElev2(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveElev2) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! vrel + if (allocated(OutData%vrel)) deallocate(OutData%vrel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%vrel(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%vrel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%vrel) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! nodeInWater + if (allocated(OutData%nodeInWater)) deallocate(OutData%nodeInWater) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%nodeInWater(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%nodeInWater.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%nodeInWater) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! memberLoads + if (allocated(OutData%memberLoads)) deallocate(OutData%memberLoads) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%memberLoads(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%memberLoads.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Morison_UnpackMemberLoads(Buf, OutData%memberLoads(i1)) ! memberLoads + end do + end if + ! F_B_End + if (allocated(OutData%F_B_End)) deallocate(OutData%F_B_End) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_B_End(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_B_End.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_B_End) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! F_D_End + if (allocated(OutData%F_D_End)) deallocate(OutData%F_D_End) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_D_End(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_D_End.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_D_End) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! F_I_End + if (allocated(OutData%F_I_End)) deallocate(OutData%F_I_End) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_I_End(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_I_End.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_I_End) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! F_IMG_End + if (allocated(OutData%F_IMG_End)) deallocate(OutData%F_IMG_End) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_IMG_End(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_IMG_End.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_IMG_End) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! F_A_End + if (allocated(OutData%F_A_End)) deallocate(OutData%F_A_End) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_A_End(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_A_End.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_A_End) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! F_BF_End + if (allocated(OutData%F_BF_End)) deallocate(OutData%F_BF_End) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_BF_End(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_BF_End.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_BF_End) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! V_rel_n + if (allocated(OutData%V_rel_n)) deallocate(OutData%V_rel_n) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%V_rel_n(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%V_rel_n.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%V_rel_n) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! V_rel_n_HiPass + if (allocated(OutData%V_rel_n_HiPass)) deallocate(OutData%V_rel_n_HiPass) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%V_rel_n_HiPass(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%V_rel_n_HiPass.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%V_rel_n_HiPass) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LastIndWave + call RegUnpack(Buf, OutData%LastIndWave) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE Morison_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(Morison_ParameterType), INTENT(IN) :: SrcParamData TYPE(Morison_ParameterType), INTENT(INOUT) :: DstParamData @@ -10606,1108 +6601,477 @@ SUBROUTINE Morison_DestroyParam( ParamData, ErrStat, ErrMsg ) NULLIFY(ParamData%WaveField) END SUBROUTINE Morison_DestroyParam - SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Morison_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! DT - Re_BufSz = Re_BufSz + 1 ! Gravity - Re_BufSz = Re_BufSz + 1 ! WtrDens - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Re_BufSz = Re_BufSz + 1 ! MSL2SWL - Int_BufSz = Int_BufSz + 1 ! WaveDisp - Int_BufSz = Int_BufSz + 1 ! AMMod - Int_BufSz = Int_BufSz + 1 ! NMembers - Int_BufSz = Int_BufSz + 1 ! Members allocated yes/no - IF ( ALLOCATED(InData%Members) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Members upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%Members,1), UBOUND(InData%Members,1) - Int_BufSz = Int_BufSz + 3 ! Members: size of buffers for each call to pack subtype - CALL Morison_PackMemberType( Re_Buf, Db_Buf, Int_Buf, InData%Members(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Members - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Members - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Members - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Members - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NNodes - Int_BufSz = Int_BufSz + 1 ! NJoints - Int_BufSz = Int_BufSz + 1 ! I_MG_End allocated yes/no - IF ( ALLOCATED(InData%I_MG_End) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! I_MG_End upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%I_MG_End) ! I_MG_End - END IF - Int_BufSz = Int_BufSz + 1 ! An_End allocated yes/no - IF ( ALLOCATED(InData%An_End) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! An_End upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%An_End) ! An_End - END IF - Int_BufSz = Int_BufSz + 1 ! DragConst_End allocated yes/no - IF ( ALLOCATED(InData%DragConst_End) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DragConst_End upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DragConst_End) ! DragConst_End - END IF - Int_BufSz = Int_BufSz + 1 ! VRelNFiltConst allocated yes/no - IF ( ALLOCATED(InData%VRelNFiltConst) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! VRelNFiltConst upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%VRelNFiltConst) ! VRelNFiltConst - END IF - Int_BufSz = Int_BufSz + 1 ! DragMod_End allocated yes/no - IF ( ALLOCATED(InData%DragMod_End) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DragMod_End upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%DragMod_End) ! DragMod_End - END IF - Int_BufSz = Int_BufSz + 1 ! DragLoFSc_End allocated yes/no - IF ( ALLOCATED(InData%DragLoFSc_End) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DragLoFSc_End upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DragLoFSc_End) ! DragLoFSc_End - END IF - Int_BufSz = Int_BufSz + 1 ! F_WMG_End allocated yes/no - IF ( ALLOCATED(InData%F_WMG_End) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_WMG_End upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_WMG_End) ! F_WMG_End - END IF - Int_BufSz = Int_BufSz + 1 ! DP_Const_End allocated yes/no - IF ( ALLOCATED(InData%DP_Const_End) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! DP_Const_End upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DP_Const_End) ! DP_Const_End - END IF - Int_BufSz = Int_BufSz + 1 ! Mass_MG_End allocated yes/no - IF ( ALLOCATED(InData%Mass_MG_End) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Mass_MG_End upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Mass_MG_End) ! Mass_MG_End - END IF - Int_BufSz = Int_BufSz + 1 ! AM_End allocated yes/no - IF ( ALLOCATED(InData%AM_End) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AM_End upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AM_End) ! AM_End - END IF - Int_BufSz = Int_BufSz + 1 ! NStepWave - Int_BufSz = Int_BufSz + 1 ! NMOutputs - Int_BufSz = Int_BufSz + 1 ! MOutLst allocated yes/no - IF ( ALLOCATED(InData%MOutLst) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MOutLst upper/lower bounds for each dimension - DO i1 = LBOUND(InData%MOutLst,1), UBOUND(InData%MOutLst,1) - Int_BufSz = Int_BufSz + 3 ! MOutLst: size of buffers for each call to pack subtype - CALL Morison_PackMOutput( Re_Buf, Db_Buf, Int_Buf, InData%MOutLst(i1), ErrStat2, ErrMsg2, .TRUE. ) ! MOutLst - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! MOutLst - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! MOutLst - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! MOutLst - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NJOutputs - Int_BufSz = Int_BufSz + 1 ! JOutLst allocated yes/no - IF ( ALLOCATED(InData%JOutLst) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! JOutLst upper/lower bounds for each dimension - DO i1 = LBOUND(InData%JOutLst,1), UBOUND(InData%JOutLst,1) - Int_BufSz = Int_BufSz + 3 ! JOutLst: size of buffers for each call to pack subtype - CALL Morison_PackJOutput( Re_Buf, Db_Buf, Int_Buf, InData%JOutLst(i1), ErrStat2, ErrMsg2, .TRUE. ) ! JOutLst - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! JOutLst - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! JOutLst - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! JOutLst - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OutParam allocated yes/no - IF ( ALLOCATED(InData%OutParam) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutParam upper/lower bounds for each dimension - DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - Int_BufSz = Int_BufSz + 3 ! OutParam: size of buffers for each call to pack subtype - CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutParam - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutParam - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutParam - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! WaveStMod - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveDisp - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%AMMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NMembers - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Members) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Members,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Members,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Members,1), UBOUND(InData%Members,1) - CALL Morison_PackMemberType( Re_Buf, Db_Buf, Int_Buf, InData%Members(i1), ErrStat2, ErrMsg2, OnlySize ) ! Members - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NNodes - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NJoints - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%I_MG_End) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%I_MG_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%I_MG_End,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%I_MG_End,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%I_MG_End,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%I_MG_End,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%I_MG_End,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%I_MG_End,3), UBOUND(InData%I_MG_End,3) - DO i2 = LBOUND(InData%I_MG_End,2), UBOUND(InData%I_MG_End,2) - DO i1 = LBOUND(InData%I_MG_End,1), UBOUND(InData%I_MG_End,1) - ReKiBuf(Re_Xferred) = InData%I_MG_End(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%An_End) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%An_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%An_End,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%An_End,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%An_End,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%An_End,2), UBOUND(InData%An_End,2) - DO i1 = LBOUND(InData%An_End,1), UBOUND(InData%An_End,1) - ReKiBuf(Re_Xferred) = InData%An_End(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DragConst_End) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DragConst_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DragConst_End,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DragConst_End,1), UBOUND(InData%DragConst_End,1) - ReKiBuf(Re_Xferred) = InData%DragConst_End(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%VRelNFiltConst) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VRelNFiltConst,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VRelNFiltConst,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%VRelNFiltConst,1), UBOUND(InData%VRelNFiltConst,1) - ReKiBuf(Re_Xferred) = InData%VRelNFiltConst(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DragMod_End) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DragMod_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DragMod_End,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DragMod_End,1), UBOUND(InData%DragMod_End,1) - IntKiBuf(Int_Xferred) = InData%DragMod_End(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DragLoFSc_End) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DragLoFSc_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DragLoFSc_End,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DragLoFSc_End,1), UBOUND(InData%DragLoFSc_End,1) - ReKiBuf(Re_Xferred) = InData%DragLoFSc_End(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_WMG_End) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_WMG_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_WMG_End,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_WMG_End,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_WMG_End,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_WMG_End,2), UBOUND(InData%F_WMG_End,2) - DO i1 = LBOUND(InData%F_WMG_End,1), UBOUND(InData%F_WMG_End,1) - ReKiBuf(Re_Xferred) = InData%F_WMG_End(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DP_Const_End) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DP_Const_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DP_Const_End,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DP_Const_End,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DP_Const_End,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%DP_Const_End,2), UBOUND(InData%DP_Const_End,2) - DO i1 = LBOUND(InData%DP_Const_End,1), UBOUND(InData%DP_Const_End,1) - ReKiBuf(Re_Xferred) = InData%DP_Const_End(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Mass_MG_End) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Mass_MG_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mass_MG_End,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Mass_MG_End,1), UBOUND(InData%Mass_MG_End,1) - ReKiBuf(Re_Xferred) = InData%Mass_MG_End(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AM_End) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AM_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AM_End,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AM_End,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AM_End,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AM_End,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AM_End,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AM_End,3), UBOUND(InData%AM_End,3) - DO i2 = LBOUND(InData%AM_End,2), UBOUND(InData%AM_End,2) - DO i1 = LBOUND(InData%AM_End,1), UBOUND(InData%AM_End,1) - ReKiBuf(Re_Xferred) = InData%AM_End(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NMOutputs - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%MOutLst) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MOutLst,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MOutLst,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MOutLst,1), UBOUND(InData%MOutLst,1) - CALL Morison_PackMOutput( Re_Buf, Db_Buf, Int_Buf, InData%MOutLst(i1), ErrStat2, ErrMsg2, OnlySize ) ! MOutLst - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NJOutputs - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%JOutLst) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%JOutLst,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%JOutLst,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%JOutLst,1), UBOUND(InData%JOutLst,1) - CALL Morison_PackJOutput( Re_Buf, Db_Buf, Int_Buf, InData%JOutLst(i1), ErrStat2, ErrMsg2, OnlySize ) ! JOutLst - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutParam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParam,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveStMod - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Morison_PackParam - - SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Morison_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MSL2SWL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDisp = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%AMMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NMembers = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Members not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Members)) DEALLOCATE(OutData%Members) - ALLOCATE(OutData%Members(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Members.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Members,1), UBOUND(OutData%Members,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Morison_UnpackMemberType( Re_Buf, Db_Buf, Int_Buf, OutData%Members(i1), ErrStat2, ErrMsg2 ) ! Members - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - OutData%NNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NJoints = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! I_MG_End not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%I_MG_End)) DEALLOCATE(OutData%I_MG_End) - ALLOCATE(OutData%I_MG_End(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_MG_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%I_MG_End,3), UBOUND(OutData%I_MG_End,3) - DO i2 = LBOUND(OutData%I_MG_End,2), UBOUND(OutData%I_MG_End,2) - DO i1 = LBOUND(OutData%I_MG_End,1), UBOUND(OutData%I_MG_End,1) - OutData%I_MG_End(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! An_End not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%An_End)) DEALLOCATE(OutData%An_End) - ALLOCATE(OutData%An_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%An_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%An_End,2), UBOUND(OutData%An_End,2) - DO i1 = LBOUND(OutData%An_End,1), UBOUND(OutData%An_End,1) - OutData%An_End(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DragConst_End not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DragConst_End)) DEALLOCATE(OutData%DragConst_End) - ALLOCATE(OutData%DragConst_End(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DragConst_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DragConst_End,1), UBOUND(OutData%DragConst_End,1) - OutData%DragConst_End(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VRelNFiltConst not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%VRelNFiltConst)) DEALLOCATE(OutData%VRelNFiltConst) - ALLOCATE(OutData%VRelNFiltConst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VRelNFiltConst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%VRelNFiltConst,1), UBOUND(OutData%VRelNFiltConst,1) - OutData%VRelNFiltConst(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DragMod_End not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DragMod_End)) DEALLOCATE(OutData%DragMod_End) - ALLOCATE(OutData%DragMod_End(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DragMod_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DragMod_End,1), UBOUND(OutData%DragMod_End,1) - OutData%DragMod_End(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DragLoFSc_End not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DragLoFSc_End)) DEALLOCATE(OutData%DragLoFSc_End) - ALLOCATE(OutData%DragLoFSc_End(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DragLoFSc_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DragLoFSc_End,1), UBOUND(OutData%DragLoFSc_End,1) - OutData%DragLoFSc_End(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_WMG_End not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_WMG_End)) DEALLOCATE(OutData%F_WMG_End) - ALLOCATE(OutData%F_WMG_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_WMG_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_WMG_End,2), UBOUND(OutData%F_WMG_End,2) - DO i1 = LBOUND(OutData%F_WMG_End,1), UBOUND(OutData%F_WMG_End,1) - OutData%F_WMG_End(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DP_Const_End not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DP_Const_End)) DEALLOCATE(OutData%DP_Const_End) - ALLOCATE(OutData%DP_Const_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DP_Const_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%DP_Const_End,2), UBOUND(OutData%DP_Const_End,2) - DO i1 = LBOUND(OutData%DP_Const_End,1), UBOUND(OutData%DP_Const_End,1) - OutData%DP_Const_End(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Mass_MG_End not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Mass_MG_End)) DEALLOCATE(OutData%Mass_MG_End) - ALLOCATE(OutData%Mass_MG_End(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mass_MG_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Mass_MG_End,1), UBOUND(OutData%Mass_MG_End,1) - OutData%Mass_MG_End(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AM_End not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AM_End)) DEALLOCATE(OutData%AM_End) - ALLOCATE(OutData%AM_End(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AM_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AM_End,3), UBOUND(OutData%AM_End,3) - DO i2 = LBOUND(OutData%AM_End,2), UBOUND(OutData%AM_End,2) - DO i1 = LBOUND(OutData%AM_End,1), UBOUND(OutData%AM_End,1) - OutData%AM_End(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%NStepWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NMOutputs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MOutLst not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MOutLst)) DEALLOCATE(OutData%MOutLst) - ALLOCATE(OutData%MOutLst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MOutLst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MOutLst,1), UBOUND(OutData%MOutLst,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Morison_UnpackMOutput( Re_Buf, Db_Buf, Int_Buf, OutData%MOutLst(i1), ErrStat2, ErrMsg2 ) ! MOutLst - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - OutData%NJOutputs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! JOutLst not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%JOutLst)) DEALLOCATE(OutData%JOutLst) - ALLOCATE(OutData%JOutLst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%JOutLst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%JOutLst,1), UBOUND(OutData%JOutLst,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Morison_UnpackJOutput( Re_Buf, Db_Buf, Int_Buf, OutData%JOutLst(i1), ErrStat2, ErrMsg2 ) ! JOutLst - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutParam)) DEALLOCATE(OutData%OutParam) - ALLOCATE(OutData%OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutParam,1), UBOUND(OutData%OutParam,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackOutParmType( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WaveStMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - NULLIFY(OutData%WaveField) - END SUBROUTINE Morison_UnPackParam +subroutine Morison_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Morison_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackParam' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + ! DT + call RegPack(Buf, InData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! Gravity + call RegPack(Buf, InData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDens + call RegPack(Buf, InData%WtrDens) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDpth + call RegPack(Buf, InData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! MSL2SWL + call RegPack(Buf, InData%MSL2SWL) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDisp + call RegPack(Buf, InData%WaveDisp) + if (RegCheckErr(Buf, RoutineName)) return + ! AMMod + call RegPack(Buf, InData%AMMod) + if (RegCheckErr(Buf, RoutineName)) return + ! NMembers + call RegPack(Buf, InData%NMembers) + if (RegCheckErr(Buf, RoutineName)) return + ! Members + call RegPack(Buf, allocated(InData%Members)) + if (allocated(InData%Members)) then + call RegPackBounds(Buf, 1, lbound(InData%Members), ubound(InData%Members)) + LB(1:1) = lbound(InData%Members) + UB(1:1) = ubound(InData%Members) + do i1 = LB(1), UB(1) + call Morison_PackMemberType(Buf, InData%Members(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NNodes + call RegPack(Buf, InData%NNodes) + if (RegCheckErr(Buf, RoutineName)) return + ! NJoints + call RegPack(Buf, InData%NJoints) + if (RegCheckErr(Buf, RoutineName)) return + ! I_MG_End + call RegPack(Buf, allocated(InData%I_MG_End)) + if (allocated(InData%I_MG_End)) then + call RegPackBounds(Buf, 3, lbound(InData%I_MG_End), ubound(InData%I_MG_End)) + call RegPack(Buf, InData%I_MG_End) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! An_End + call RegPack(Buf, allocated(InData%An_End)) + if (allocated(InData%An_End)) then + call RegPackBounds(Buf, 2, lbound(InData%An_End), ubound(InData%An_End)) + call RegPack(Buf, InData%An_End) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DragConst_End + call RegPack(Buf, allocated(InData%DragConst_End)) + if (allocated(InData%DragConst_End)) then + call RegPackBounds(Buf, 1, lbound(InData%DragConst_End), ubound(InData%DragConst_End)) + call RegPack(Buf, InData%DragConst_End) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! VRelNFiltConst + call RegPack(Buf, allocated(InData%VRelNFiltConst)) + if (allocated(InData%VRelNFiltConst)) then + call RegPackBounds(Buf, 1, lbound(InData%VRelNFiltConst), ubound(InData%VRelNFiltConst)) + call RegPack(Buf, InData%VRelNFiltConst) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DragMod_End + call RegPack(Buf, allocated(InData%DragMod_End)) + if (allocated(InData%DragMod_End)) then + call RegPackBounds(Buf, 1, lbound(InData%DragMod_End), ubound(InData%DragMod_End)) + call RegPack(Buf, InData%DragMod_End) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DragLoFSc_End + call RegPack(Buf, allocated(InData%DragLoFSc_End)) + if (allocated(InData%DragLoFSc_End)) then + call RegPackBounds(Buf, 1, lbound(InData%DragLoFSc_End), ubound(InData%DragLoFSc_End)) + call RegPack(Buf, InData%DragLoFSc_End) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! F_WMG_End + call RegPack(Buf, allocated(InData%F_WMG_End)) + if (allocated(InData%F_WMG_End)) then + call RegPackBounds(Buf, 2, lbound(InData%F_WMG_End), ubound(InData%F_WMG_End)) + call RegPack(Buf, InData%F_WMG_End) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DP_Const_End + call RegPack(Buf, allocated(InData%DP_Const_End)) + if (allocated(InData%DP_Const_End)) then + call RegPackBounds(Buf, 2, lbound(InData%DP_Const_End), ubound(InData%DP_Const_End)) + call RegPack(Buf, InData%DP_Const_End) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Mass_MG_End + call RegPack(Buf, allocated(InData%Mass_MG_End)) + if (allocated(InData%Mass_MG_End)) then + call RegPackBounds(Buf, 1, lbound(InData%Mass_MG_End), ubound(InData%Mass_MG_End)) + call RegPack(Buf, InData%Mass_MG_End) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AM_End + call RegPack(Buf, allocated(InData%AM_End)) + if (allocated(InData%AM_End)) then + call RegPackBounds(Buf, 3, lbound(InData%AM_End), ubound(InData%AM_End)) + call RegPack(Buf, InData%AM_End) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NStepWave + call RegPack(Buf, InData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + ! NMOutputs + call RegPack(Buf, InData%NMOutputs) + if (RegCheckErr(Buf, RoutineName)) return + ! MOutLst + call RegPack(Buf, allocated(InData%MOutLst)) + if (allocated(InData%MOutLst)) then + call RegPackBounds(Buf, 1, lbound(InData%MOutLst), ubound(InData%MOutLst)) + LB(1:1) = lbound(InData%MOutLst) + UB(1:1) = ubound(InData%MOutLst) + do i1 = LB(1), UB(1) + call Morison_PackMOutput(Buf, InData%MOutLst(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NJOutputs + call RegPack(Buf, InData%NJOutputs) + if (RegCheckErr(Buf, RoutineName)) return + ! JOutLst + call RegPack(Buf, allocated(InData%JOutLst)) + if (allocated(InData%JOutLst)) then + call RegPackBounds(Buf, 1, lbound(InData%JOutLst), ubound(InData%JOutLst)) + LB(1:1) = lbound(InData%JOutLst) + UB(1:1) = ubound(InData%JOutLst) + do i1 = LB(1), UB(1) + call Morison_PackJOutput(Buf, InData%JOutLst(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OutParam + call RegPack(Buf, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegPack(Buf, InData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveStMod + call RegPack(Buf, InData%WaveStMod) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveField + call RegPack(Buf, associated(InData%WaveField)) + if (associated(InData%WaveField)) then + call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) + if (.not. PtrInIndex) then + call SeaSt_WaveField_PackSeaSt_WaveFieldType(Buf, InData%WaveField) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Morison_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackParam' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + ! DT + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! Gravity + call RegUnpack(Buf, OutData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDens + call RegUnpack(Buf, OutData%WtrDens) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDpth + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! MSL2SWL + call RegUnpack(Buf, OutData%MSL2SWL) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDisp + call RegUnpack(Buf, OutData%WaveDisp) + if (RegCheckErr(Buf, RoutineName)) return + ! AMMod + call RegUnpack(Buf, OutData%AMMod) + if (RegCheckErr(Buf, RoutineName)) return + ! NMembers + call RegUnpack(Buf, OutData%NMembers) + if (RegCheckErr(Buf, RoutineName)) return + ! Members + if (allocated(OutData%Members)) deallocate(OutData%Members) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Members(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Members.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Morison_UnpackMemberType(Buf, OutData%Members(i1)) ! Members + end do + end if + ! NNodes + call RegUnpack(Buf, OutData%NNodes) + if (RegCheckErr(Buf, RoutineName)) return + ! NJoints + call RegUnpack(Buf, OutData%NJoints) + if (RegCheckErr(Buf, RoutineName)) return + ! I_MG_End + if (allocated(OutData%I_MG_End)) deallocate(OutData%I_MG_End) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%I_MG_End(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%I_MG_End.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%I_MG_End) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! An_End + if (allocated(OutData%An_End)) deallocate(OutData%An_End) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%An_End(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%An_End.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%An_End) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! DragConst_End + if (allocated(OutData%DragConst_End)) deallocate(OutData%DragConst_End) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DragConst_End(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DragConst_End.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DragConst_End) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! VRelNFiltConst + if (allocated(OutData%VRelNFiltConst)) deallocate(OutData%VRelNFiltConst) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%VRelNFiltConst(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VRelNFiltConst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%VRelNFiltConst) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! DragMod_End + if (allocated(OutData%DragMod_End)) deallocate(OutData%DragMod_End) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DragMod_End(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DragMod_End.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DragMod_End) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! DragLoFSc_End + if (allocated(OutData%DragLoFSc_End)) deallocate(OutData%DragLoFSc_End) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DragLoFSc_End(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DragLoFSc_End.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DragLoFSc_End) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! F_WMG_End + if (allocated(OutData%F_WMG_End)) deallocate(OutData%F_WMG_End) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_WMG_End(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_WMG_End.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_WMG_End) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! DP_Const_End + if (allocated(OutData%DP_Const_End)) deallocate(OutData%DP_Const_End) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DP_Const_End(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DP_Const_End.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DP_Const_End) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Mass_MG_End + if (allocated(OutData%Mass_MG_End)) deallocate(OutData%Mass_MG_End) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Mass_MG_End(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mass_MG_End.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Mass_MG_End) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AM_End + if (allocated(OutData%AM_End)) deallocate(OutData%AM_End) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AM_End(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AM_End.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AM_End) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NStepWave + call RegUnpack(Buf, OutData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + ! NMOutputs + call RegUnpack(Buf, OutData%NMOutputs) + if (RegCheckErr(Buf, RoutineName)) return + ! MOutLst + if (allocated(OutData%MOutLst)) deallocate(OutData%MOutLst) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MOutLst(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MOutLst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Morison_UnpackMOutput(Buf, OutData%MOutLst(i1)) ! MOutLst + end do + end if + ! NJOutputs + call RegUnpack(Buf, OutData%NJOutputs) + if (RegCheckErr(Buf, RoutineName)) return + ! JOutLst + if (allocated(OutData%JOutLst)) deallocate(OutData%JOutLst) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%JOutLst(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%JOutLst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Morison_UnpackJOutput(Buf, OutData%JOutLst(i1)) ! JOutLst + end do + end if + ! OutParam + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam + end do + end if + ! NumOuts + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveStMod + call RegUnpack(Buf, OutData%WaveStMod) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveField + if (associated(OutData%WaveField)) deallocate(OutData%WaveField) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveField) + else + allocate(OutData%WaveField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveField) + call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(Buf, OutData%WaveField) ! WaveField + end if + else + OutData%WaveField => null() + end if +end subroutine SUBROUTINE Morison_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(Morison_InputType), INTENT(INOUT) :: SrcInputData TYPE(Morison_InputType), INTENT(INOUT) :: DstInputData @@ -11744,184 +7108,25 @@ SUBROUTINE Morison_DestroyInput( InputData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE Morison_DestroyInput - SUBROUTINE Morison_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Morison_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Mesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Mesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Mesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL MeshPack( InData%Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE Morison_PackInput - - SUBROUTINE Morison_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Morison_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE Morison_UnPackInput +subroutine Morison_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Morison_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + ! Mesh + call MeshPack(Buf, InData%Mesh) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Morison_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackInput' + if (Buf%ErrStat /= ErrID_None) return + ! Mesh + call MeshUnpack(Buf, OutData%Mesh) ! Mesh +end subroutine SUBROUTINE Morison_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(Morison_OutputType), INTENT(INOUT) :: SrcOutputData TYPE(Morison_OutputType), INTENT(INOUT) :: DstOutputData @@ -11974,223 +7179,50 @@ SUBROUTINE Morison_DestroyOutput( OutputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE Morison_DestroyOutput - SUBROUTINE Morison_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Morison_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Mesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Mesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Mesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutput allocated yes/no - IF ( ALLOCATED(InData%WriteOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutput upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WriteOutput) ! WriteOutput - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL MeshPack( InData%Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) - ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE Morison_PackOutput - - SUBROUTINE Morison_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Morison_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutput)) DEALLOCATE(OutData%WriteOutput) - ALLOCATE(OutData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) - OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE Morison_UnPackOutput +subroutine Morison_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Morison_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Morison_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! Mesh + call MeshPack(Buf, InData%Mesh) + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutput + call RegPack(Buf, allocated(InData%WriteOutput)) + if (allocated(InData%WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPack(Buf, InData%WriteOutput) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Morison_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Morison_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Morison_UnPackOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! Mesh + call MeshUnpack(Buf, OutData%Mesh) ! Mesh + ! WriteOutput + if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE Morison_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) ! diff --git a/modules/hydrodyn/src/SS_Excitation_Types.f90 b/modules/hydrodyn/src/SS_Excitation_Types.f90 index 9a98d197dc..350b0b3bff 100644 --- a/modules/hydrodyn/src/SS_Excitation_Types.f90 +++ b/modules/hydrodyn/src/SS_Excitation_Types.f90 @@ -176,257 +176,188 @@ SUBROUTINE SS_Exc_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE SS_Exc_DestroyInitInput - SUBROUTINE SS_Exc_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SS_Exc_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%InputFile) ! InputFile - Int_BufSz = Int_BufSz + 1 ! NBody - Int_BufSz = Int_BufSz + 1 ! ExctnDisp - Re_BufSz = Re_BufSz + 1 ! WaveDir - Int_BufSz = Int_BufSz + 1 ! NStepWave - Int_BufSz = Int_BufSz + 1 ! PtfmRefztRot allocated yes/no - IF ( ALLOCATED(InData%PtfmRefztRot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmRefztRot upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%PtfmRefztRot) ! PtfmRefztRot - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! SeaSt_Interp_p: size of buffers for each call to pack subtype - CALL SeaSt_Interp_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt_Interp_p, ErrStat2, ErrMsg2, .TRUE. ) ! SeaSt_Interp_p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SeaSt_Interp_p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SeaSt_Interp_p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SeaSt_Interp_p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%NBody - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ExctnDisp - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDir - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%PtfmRefztRot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmRefztRot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmRefztRot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmRefztRot,1), UBOUND(InData%PtfmRefztRot,1) - DbKiBuf(Db_Xferred) = InData%PtfmRefztRot(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - CALL SeaSt_Interp_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt_Interp_p, ErrStat2, ErrMsg2, OnlySize ) ! SeaSt_Interp_p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE SS_Exc_PackInitInput - - SUBROUTINE SS_Exc_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SS_Exc_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%NBody = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ExctnDisp = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WaveDir = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NStepWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmRefztRot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PtfmRefztRot)) DEALLOCATE(OutData%PtfmRefztRot) - ALLOCATE(OutData%PtfmRefztRot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefztRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmRefztRot,1), UBOUND(OutData%PtfmRefztRot,1) - OutData%PtfmRefztRot(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - NULLIFY(OutData%WaveElev0) - NULLIFY(OutData%WaveElev1) - NULLIFY(OutData%WaveTime) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SeaSt_Interp_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%SeaSt_Interp_p, ErrStat2, ErrMsg2 ) ! SeaSt_Interp_p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE SS_Exc_UnPackInitInput +subroutine SS_Exc_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SS_Exc_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Exc_PackInitInput' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + ! InputFile + call RegPack(Buf, InData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! NBody + call RegPack(Buf, InData%NBody) + if (RegCheckErr(Buf, RoutineName)) return + ! ExctnDisp + call RegPack(Buf, InData%ExctnDisp) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDir + call RegPack(Buf, InData%WaveDir) + if (RegCheckErr(Buf, RoutineName)) return + ! NStepWave + call RegPack(Buf, InData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmRefztRot + call RegPack(Buf, allocated(InData%PtfmRefztRot)) + if (allocated(InData%PtfmRefztRot)) then + call RegPackBounds(Buf, 1, lbound(InData%PtfmRefztRot), ubound(InData%PtfmRefztRot)) + call RegPack(Buf, InData%PtfmRefztRot) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElev0 + call RegPack(Buf, associated(InData%WaveElev0)) + if (associated(InData%WaveElev0)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveElev0), ubound(InData%WaveElev0)) + call RegPackPointer(Buf, c_loc(InData%WaveElev0), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveElev0) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElev1 + call RegPack(Buf, associated(InData%WaveElev1)) + if (associated(InData%WaveElev1)) then + call RegPackBounds(Buf, 3, lbound(InData%WaveElev1), ubound(InData%WaveElev1)) + call RegPackPointer(Buf, c_loc(InData%WaveElev1), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveElev1) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveTime + call RegPack(Buf, associated(InData%WaveTime)) + if (associated(InData%WaveTime)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) + call RegPackPointer(Buf, c_loc(InData%WaveTime), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveTime) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SeaSt_Interp_p + call SeaSt_Interp_PackParam(Buf, InData%SeaSt_Interp_p) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SS_Exc_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SS_Exc_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Exc_UnPackInitInput' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + ! InputFile + call RegUnpack(Buf, OutData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! NBody + call RegUnpack(Buf, OutData%NBody) + if (RegCheckErr(Buf, RoutineName)) return + ! ExctnDisp + call RegUnpack(Buf, OutData%ExctnDisp) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDir + call RegUnpack(Buf, OutData%WaveDir) + if (RegCheckErr(Buf, RoutineName)) return + ! NStepWave + call RegUnpack(Buf, OutData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmRefztRot + if (allocated(OutData%PtfmRefztRot)) deallocate(OutData%PtfmRefztRot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PtfmRefztRot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefztRot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PtfmRefztRot) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WaveElev0 + if (associated(OutData%WaveElev0)) deallocate(OutData%WaveElev0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveElev0, UB(1:1)-LB(1:1)) + OutData%WaveElev0(LB(1):) => OutData%WaveElev0 + else + allocate(OutData%WaveElev0(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElev0) + call RegUnpack(Buf, OutData%WaveElev0) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveElev0 => null() + end if + ! WaveElev1 + if (associated(OutData%WaveElev1)) deallocate(OutData%WaveElev1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveElev1, UB(1:3)-LB(1:3)) + OutData%WaveElev1(LB(1):,LB(2):,LB(3):) => OutData%WaveElev1 + else + allocate(OutData%WaveElev1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElev1) + call RegUnpack(Buf, OutData%WaveElev1) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveElev1 => null() + end if + ! WaveTime + if (associated(OutData%WaveTime)) deallocate(OutData%WaveTime) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveTime, UB(1:1)-LB(1:1)) + OutData%WaveTime(LB(1):) => OutData%WaveTime + else + allocate(OutData%WaveTime(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveTime) + call RegUnpack(Buf, OutData%WaveTime) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveTime => null() + end if + ! SeaSt_Interp_p + call SeaSt_Interp_UnpackParam(Buf, OutData%SeaSt_Interp_p) ! SeaSt_Interp_p +end subroutine SUBROUTINE SS_Exc_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(SS_Exc_InitOutputType), INTENT(IN) :: SrcInitOutputData TYPE(SS_Exc_InitOutputType), INTENT(INOUT) :: DstInitOutputData @@ -489,183 +420,67 @@ SUBROUTINE SS_Exc_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE SS_Exc_DestroyInitOutput - SUBROUTINE SS_Exc_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SS_Exc_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! WriteOutputHdr allocated yes/no - IF ( ALLOCATED(InData%WriteOutputHdr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdr upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdr)*LEN(InData%WriteOutputHdr) ! WriteOutputHdr - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputUnt allocated yes/no - IF ( ALLOCATED(InData%WriteOutputUnt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUnt upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUnt)*LEN(InData%WriteOutputUnt) ! WriteOutputUnt - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%WriteOutputHdr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) - DO I = 1, LEN(InData%WriteOutputHdr) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputUnt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) - DO I = 1, LEN(InData%WriteOutputUnt) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - END SUBROUTINE SS_Exc_PackInitOutput - - SUBROUTINE SS_Exc_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SS_Exc_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputHdr)) DEALLOCATE(OutData%WriteOutputHdr) - ALLOCATE(OutData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) - DO I = 1, LEN(OutData%WriteOutputHdr) - OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputUnt)) DEALLOCATE(OutData%WriteOutputUnt) - ALLOCATE(OutData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) - DO I = 1, LEN(OutData%WriteOutputUnt) - OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - END SUBROUTINE SS_Exc_UnPackInitOutput +subroutine SS_Exc_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SS_Exc_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Exc_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! WriteOutputHdr + call RegPack(Buf, allocated(InData%WriteOutputHdr)) + if (allocated(InData%WriteOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPack(Buf, InData%WriteOutputHdr) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutputUnt + call RegPack(Buf, allocated(InData%WriteOutputUnt)) + if (allocated(InData%WriteOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPack(Buf, InData%WriteOutputUnt) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SS_Exc_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SS_Exc_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Exc_UnPackInitOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! WriteOutputHdr + if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WriteOutputUnt + if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE SS_Exc_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(SS_Exc_ContinuousStateType), INTENT(IN) :: SrcContStateData TYPE(SS_Exc_ContinuousStateType), INTENT(INOUT) :: DstContStateData @@ -713,137 +528,45 @@ SUBROUTINE SS_Exc_DestroyContState( ContStateData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE SS_Exc_DestroyContState - SUBROUTINE SS_Exc_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SS_Exc_ContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_PackContState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! x allocated yes/no - IF ( ALLOCATED(InData%x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%x) ! x - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - DbKiBuf(Db_Xferred) = InData%x(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE SS_Exc_PackContState - - SUBROUTINE SS_Exc_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SS_Exc_ContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_UnPackContState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%x)) DEALLOCATE(OutData%x) - ALLOCATE(OutData%x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) - OutData%x(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE SS_Exc_UnPackContState +subroutine SS_Exc_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SS_Exc_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Exc_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + ! x + call RegPack(Buf, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(Buf, 1, lbound(InData%x), ubound(InData%x)) + call RegPack(Buf, InData%x) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SS_Exc_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SS_Exc_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Exc_UnPackContState' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! x + if (allocated(OutData%x)) deallocate(OutData%x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%x) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE SS_Exc_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(SS_Exc_DiscreteStateType), INTENT(IN) :: SrcDiscStateData TYPE(SS_Exc_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData @@ -876,103 +599,26 @@ SUBROUTINE SS_Exc_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) END SUBROUTINE SS_Exc_DestroyDiscState - SUBROUTINE SS_Exc_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SS_Exc_DiscreteStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_PackDiscState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyDiscState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SS_Exc_PackDiscState - - SUBROUTINE SS_Exc_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SS_Exc_DiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_UnPackDiscState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyDiscState = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SS_Exc_UnPackDiscState +subroutine SS_Exc_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SS_Exc_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Exc_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyDiscState + call RegPack(Buf, InData%DummyDiscState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SS_Exc_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SS_Exc_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Exc_UnPackDiscState' + if (Buf%ErrStat /= ErrID_None) return + ! DummyDiscState + call RegUnpack(Buf, OutData%DummyDiscState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE SS_Exc_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(SS_Exc_ConstraintStateType), INTENT(IN) :: SrcConstrStateData TYPE(SS_Exc_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData @@ -1005,103 +651,26 @@ SUBROUTINE SS_Exc_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) END SUBROUTINE SS_Exc_DestroyConstrState - SUBROUTINE SS_Exc_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SS_Exc_ConstraintStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_PackConstrState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyConstrState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SS_Exc_PackConstrState - - SUBROUTINE SS_Exc_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SS_Exc_ConstraintStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_UnPackConstrState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyConstrState = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SS_Exc_UnPackConstrState +subroutine SS_Exc_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SS_Exc_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Exc_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyConstrState + call RegPack(Buf, InData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SS_Exc_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SS_Exc_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Exc_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + ! DummyConstrState + call RegUnpack(Buf, OutData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE SS_Exc_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(SS_Exc_OtherStateType), INTENT(IN) :: SrcOtherStateData TYPE(SS_Exc_OtherStateType), INTENT(INOUT) :: DstOtherStateData @@ -1144,198 +713,43 @@ SUBROUTINE SS_Exc_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) ENDDO END SUBROUTINE SS_Exc_DestroyOtherState - SUBROUTINE SS_Exc_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SS_Exc_OtherStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_PackOtherState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! n - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) - Int_BufSz = Int_BufSz + 3 ! xdot: size of buffers for each call to pack subtype - CALL SS_Exc_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xdot - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xdot - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xdot - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xdot - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%n - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) - CALL SS_Exc_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, OnlySize ) ! xdot - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END SUBROUTINE SS_Exc_PackOtherState - - SUBROUTINE SS_Exc_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SS_Exc_OtherStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_UnPackOtherState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%n = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%xdot,1) - i1_u = UBOUND(OutData%xdot,1) - DO i1 = LBOUND(OutData%xdot,1), UBOUND(OutData%xdot,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SS_Exc_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%xdot(i1), ErrStat2, ErrMsg2 ) ! xdot - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END SUBROUTINE SS_Exc_UnPackOtherState +subroutine SS_Exc_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SS_Exc_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Exc_PackOtherState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! n + call RegPack(Buf, InData%n) + if (RegCheckErr(Buf, RoutineName)) return + ! xdot + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) + do i1 = LB(1), UB(1) + call SS_Exc_PackContState(Buf, InData%xdot(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SS_Exc_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SS_Exc_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Exc_UnPackOtherState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat /= ErrID_None) return + ! n + call RegUnpack(Buf, OutData%n) + if (RegCheckErr(Buf, RoutineName)) return + ! xdot + LB(1:1) = lbound(OutData%xdot) + UB(1:1) = ubound(OutData%xdot) + do i1 = LB(1), UB(1) + call SS_Exc_UnpackContState(Buf, OutData%xdot(i1)) ! xdot + end do +end subroutine SUBROUTINE SS_Exc_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) TYPE(SS_Exc_MiscVarType), INTENT(IN) :: SrcMiscData TYPE(SS_Exc_MiscVarType), INTENT(INOUT) :: DstMiscData @@ -1373,189 +787,31 @@ SUBROUTINE SS_Exc_DestroyMisc( MiscData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE SS_Exc_DestroyMisc - SUBROUTINE SS_Exc_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SS_Exc_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! LastIndWave - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! SeaSt_Interp_m: size of buffers for each call to pack subtype - CALL SeaSt_Interp_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt_Interp_m, ErrStat2, ErrMsg2, .TRUE. ) ! SeaSt_Interp_m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SeaSt_Interp_m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SeaSt_Interp_m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SeaSt_Interp_m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%LastIndWave - Int_Xferred = Int_Xferred + 1 - CALL SeaSt_Interp_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt_Interp_m, ErrStat2, ErrMsg2, OnlySize ) ! SeaSt_Interp_m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE SS_Exc_PackMisc - - SUBROUTINE SS_Exc_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SS_Exc_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%LastIndWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SeaSt_Interp_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%SeaSt_Interp_m, ErrStat2, ErrMsg2 ) ! SeaSt_Interp_m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE SS_Exc_UnPackMisc +subroutine SS_Exc_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SS_Exc_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Exc_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + ! LastIndWave + call RegPack(Buf, InData%LastIndWave) + if (RegCheckErr(Buf, RoutineName)) return + ! SeaSt_Interp_m + call SeaSt_Interp_PackMisc(Buf, InData%SeaSt_Interp_m) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SS_Exc_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SS_Exc_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Exc_UnPackMisc' + if (Buf%ErrStat /= ErrID_None) return + ! LastIndWave + call RegUnpack(Buf, OutData%LastIndWave) + if (RegCheckErr(Buf, RoutineName)) return + ! SeaSt_Interp_m + call SeaSt_Interp_UnpackMisc(Buf, OutData%SeaSt_Interp_m) ! SeaSt_Interp_m +end subroutine SUBROUTINE SS_Exc_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(SS_Exc_ParameterType), INTENT(IN) :: SrcParamData TYPE(SS_Exc_ParameterType), INTENT(INOUT) :: DstParamData @@ -1671,392 +927,260 @@ SUBROUTINE SS_Exc_DestroyParam( ParamData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE SS_Exc_DestroyParam - SUBROUTINE SS_Exc_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SS_Exc_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! DT - Int_BufSz = Int_BufSz + 1 ! NBody - Int_BufSz = Int_BufSz + 1 ! ExctnDisp - Int_BufSz = Int_BufSz + 1 ! NStepWave - Int_BufSz = Int_BufSz + 1 ! spDOF allocated yes/no - IF ( ALLOCATED(InData%spDOF) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! spDOF upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%spDOF) ! spDOF - END IF - Int_BufSz = Int_BufSz + 1 ! A allocated yes/no - IF ( ALLOCATED(InData%A) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! A upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%A) ! A - END IF - Int_BufSz = Int_BufSz + 1 ! B allocated yes/no - IF ( ALLOCATED(InData%B) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! B upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%B) ! B - END IF - Int_BufSz = Int_BufSz + 1 ! C allocated yes/no - IF ( ALLOCATED(InData%C) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! C upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%C) ! C - END IF - Int_BufSz = Int_BufSz + 1 ! numStates - Db_BufSz = Db_BufSz + 1 ! Tc - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! SeaSt_Interp_p: size of buffers for each call to pack subtype - CALL SeaSt_Interp_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt_Interp_p, ErrStat2, ErrMsg2, .TRUE. ) ! SeaSt_Interp_p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SeaSt_Interp_p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SeaSt_Interp_p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SeaSt_Interp_p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NBody - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ExctnDisp - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%spDOF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%spDOF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%spDOF,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%spDOF,1), UBOUND(InData%spDOF,1) - IntKiBuf(Int_Xferred) = InData%spDOF(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%A) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%A,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%A,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%A,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%A,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%A,2), UBOUND(InData%A,2) - DO i1 = LBOUND(InData%A,1), UBOUND(InData%A,1) - ReKiBuf(Re_Xferred) = InData%A(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%B) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%B,1), UBOUND(InData%B,1) - ReKiBuf(Re_Xferred) = InData%B(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%C) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%C,2), UBOUND(InData%C,2) - DO i1 = LBOUND(InData%C,1), UBOUND(InData%C,1) - ReKiBuf(Re_Xferred) = InData%C(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%numStates - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Tc - Db_Xferred = Db_Xferred + 1 - CALL SeaSt_Interp_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt_Interp_p, ErrStat2, ErrMsg2, OnlySize ) ! SeaSt_Interp_p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE SS_Exc_PackParam - - SUBROUTINE SS_Exc_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SS_Exc_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%NBody = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ExctnDisp = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NStepWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! spDOF not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%spDOF)) DEALLOCATE(OutData%spDOF) - ALLOCATE(OutData%spDOF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%spDOF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%spDOF,1), UBOUND(OutData%spDOF,1) - OutData%spDOF(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! A not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%A)) DEALLOCATE(OutData%A) - ALLOCATE(OutData%A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%A.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%A,2), UBOUND(OutData%A,2) - DO i1 = LBOUND(OutData%A,1), UBOUND(OutData%A,1) - OutData%A(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! B not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%B)) DEALLOCATE(OutData%B) - ALLOCATE(OutData%B(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%B,1), UBOUND(OutData%B,1) - OutData%B(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%C)) DEALLOCATE(OutData%C) - ALLOCATE(OutData%C(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%C,2), UBOUND(OutData%C,2) - DO i1 = LBOUND(OutData%C,1), UBOUND(OutData%C,1) - OutData%C(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%numStates = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Tc = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - NULLIFY(OutData%WaveElev0) - NULLIFY(OutData%WaveElev1) - NULLIFY(OutData%WaveTime) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SeaSt_Interp_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%SeaSt_Interp_p, ErrStat2, ErrMsg2 ) ! SeaSt_Interp_p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE SS_Exc_UnPackParam +subroutine SS_Exc_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SS_Exc_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Exc_PackParam' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + ! DT + call RegPack(Buf, InData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! NBody + call RegPack(Buf, InData%NBody) + if (RegCheckErr(Buf, RoutineName)) return + ! ExctnDisp + call RegPack(Buf, InData%ExctnDisp) + if (RegCheckErr(Buf, RoutineName)) return + ! NStepWave + call RegPack(Buf, InData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + ! spDOF + call RegPack(Buf, allocated(InData%spDOF)) + if (allocated(InData%spDOF)) then + call RegPackBounds(Buf, 1, lbound(InData%spDOF), ubound(InData%spDOF)) + call RegPack(Buf, InData%spDOF) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! A + call RegPack(Buf, allocated(InData%A)) + if (allocated(InData%A)) then + call RegPackBounds(Buf, 2, lbound(InData%A), ubound(InData%A)) + call RegPack(Buf, InData%A) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! B + call RegPack(Buf, allocated(InData%B)) + if (allocated(InData%B)) then + call RegPackBounds(Buf, 1, lbound(InData%B), ubound(InData%B)) + call RegPack(Buf, InData%B) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! C + call RegPack(Buf, allocated(InData%C)) + if (allocated(InData%C)) then + call RegPackBounds(Buf, 2, lbound(InData%C), ubound(InData%C)) + call RegPack(Buf, InData%C) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! numStates + call RegPack(Buf, InData%numStates) + if (RegCheckErr(Buf, RoutineName)) return + ! Tc + call RegPack(Buf, InData%Tc) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElev0 + call RegPack(Buf, associated(InData%WaveElev0)) + if (associated(InData%WaveElev0)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveElev0), ubound(InData%WaveElev0)) + call RegPackPointer(Buf, c_loc(InData%WaveElev0), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveElev0) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElev1 + call RegPack(Buf, associated(InData%WaveElev1)) + if (associated(InData%WaveElev1)) then + call RegPackBounds(Buf, 3, lbound(InData%WaveElev1), ubound(InData%WaveElev1)) + call RegPackPointer(Buf, c_loc(InData%WaveElev1), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveElev1) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveTime + call RegPack(Buf, associated(InData%WaveTime)) + if (associated(InData%WaveTime)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) + call RegPackPointer(Buf, c_loc(InData%WaveTime), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveTime) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SeaSt_Interp_p + call SeaSt_Interp_PackParam(Buf, InData%SeaSt_Interp_p) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SS_Exc_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SS_Exc_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Exc_UnPackParam' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + ! DT + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! NBody + call RegUnpack(Buf, OutData%NBody) + if (RegCheckErr(Buf, RoutineName)) return + ! ExctnDisp + call RegUnpack(Buf, OutData%ExctnDisp) + if (RegCheckErr(Buf, RoutineName)) return + ! NStepWave + call RegUnpack(Buf, OutData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + ! spDOF + if (allocated(OutData%spDOF)) deallocate(OutData%spDOF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%spDOF(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%spDOF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%spDOF) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! A + if (allocated(OutData%A)) deallocate(OutData%A) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%A(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%A.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%A) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! B + if (allocated(OutData%B)) deallocate(OutData%B) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%B(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%B) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! C + if (allocated(OutData%C)) deallocate(OutData%C) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%C(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%C.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%C) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! numStates + call RegUnpack(Buf, OutData%numStates) + if (RegCheckErr(Buf, RoutineName)) return + ! Tc + call RegUnpack(Buf, OutData%Tc) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElev0 + if (associated(OutData%WaveElev0)) deallocate(OutData%WaveElev0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveElev0, UB(1:1)-LB(1:1)) + OutData%WaveElev0(LB(1):) => OutData%WaveElev0 + else + allocate(OutData%WaveElev0(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElev0) + call RegUnpack(Buf, OutData%WaveElev0) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveElev0 => null() + end if + ! WaveElev1 + if (associated(OutData%WaveElev1)) deallocate(OutData%WaveElev1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveElev1, UB(1:3)-LB(1:3)) + OutData%WaveElev1(LB(1):,LB(2):,LB(3):) => OutData%WaveElev1 + else + allocate(OutData%WaveElev1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElev1) + call RegUnpack(Buf, OutData%WaveElev1) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveElev1 => null() + end if + ! WaveTime + if (associated(OutData%WaveTime)) deallocate(OutData%WaveTime) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveTime, UB(1:1)-LB(1:1)) + OutData%WaveTime(LB(1):) => OutData%WaveTime + else + allocate(OutData%WaveTime(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveTime) + call RegUnpack(Buf, OutData%WaveTime) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveTime => null() + end if + ! SeaSt_Interp_p + call SeaSt_Interp_UnpackParam(Buf, OutData%SeaSt_Interp_p) ! SeaSt_Interp_p +end subroutine SUBROUTINE SS_Exc_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(SS_Exc_InputType), INTENT(IN) :: SrcInputData TYPE(SS_Exc_InputType), INTENT(INOUT) :: DstInputData @@ -2107,148 +1231,45 @@ SUBROUTINE SS_Exc_DestroyInput( InputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE SS_Exc_DestroyInput - SUBROUTINE SS_Exc_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SS_Exc_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! PtfmPos allocated yes/no - IF ( ALLOCATED(InData%PtfmPos) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PtfmPos upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmPos) ! PtfmPos - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END 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%PtfmPos) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmPos,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmPos,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmPos,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmPos,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PtfmPos,2), UBOUND(InData%PtfmPos,2) - DO i1 = LBOUND(InData%PtfmPos,1), UBOUND(InData%PtfmPos,1) - ReKiBuf(Re_Xferred) = InData%PtfmPos(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE SS_Exc_PackInput - - SUBROUTINE SS_Exc_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SS_Exc_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmPos not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PtfmPos)) DEALLOCATE(OutData%PtfmPos) - ALLOCATE(OutData%PtfmPos(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmPos.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PtfmPos,2), UBOUND(OutData%PtfmPos,2) - DO i1 = LBOUND(OutData%PtfmPos,1), UBOUND(OutData%PtfmPos,1) - OutData%PtfmPos(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE SS_Exc_UnPackInput +subroutine SS_Exc_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SS_Exc_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Exc_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + ! PtfmPos + call RegPack(Buf, allocated(InData%PtfmPos)) + if (allocated(InData%PtfmPos)) then + call RegPackBounds(Buf, 2, lbound(InData%PtfmPos), ubound(InData%PtfmPos)) + call RegPack(Buf, InData%PtfmPos) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SS_Exc_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SS_Exc_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Exc_UnPackInput' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! PtfmPos + if (allocated(OutData%PtfmPos)) deallocate(OutData%PtfmPos) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PtfmPos(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmPos.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PtfmPos) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE SS_Exc_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(SS_Exc_OutputType), INTENT(IN) :: SrcOutputData TYPE(SS_Exc_OutputType), INTENT(INOUT) :: DstOutputData @@ -2311,175 +1332,67 @@ SUBROUTINE SS_Exc_DestroyOutput( OutputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE SS_Exc_DestroyOutput - SUBROUTINE SS_Exc_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SS_Exc_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! y allocated yes/no - IF ( ALLOCATED(InData%y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%y) ! y - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutput allocated yes/no - IF ( ALLOCATED(InData%WriteOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutput upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WriteOutput) ! WriteOutput - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) - ReKiBuf(Re_Xferred) = InData%y(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) - ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SS_Exc_PackOutput - - SUBROUTINE SS_Exc_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SS_Exc_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%y)) DEALLOCATE(OutData%y) - ALLOCATE(OutData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) - OutData%y(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutput)) DEALLOCATE(OutData%WriteOutput) - ALLOCATE(OutData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) - OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SS_Exc_UnPackOutput +subroutine SS_Exc_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SS_Exc_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Exc_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! y + call RegPack(Buf, allocated(InData%y)) + if (allocated(InData%y)) then + call RegPackBounds(Buf, 1, lbound(InData%y), ubound(InData%y)) + call RegPack(Buf, InData%y) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutput + call RegPack(Buf, allocated(InData%WriteOutput)) + if (allocated(InData%WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPack(Buf, InData%WriteOutput) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SS_Exc_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SS_Exc_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Exc_UnPackOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! y + if (allocated(OutData%y)) deallocate(OutData%y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%y) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WriteOutput + if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE SS_Exc_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) ! diff --git a/modules/hydrodyn/src/SS_Radiation_Types.f90 b/modules/hydrodyn/src/SS_Radiation_Types.f90 index 24ba2c23a5..930afa462d 100644 --- a/modules/hydrodyn/src/SS_Radiation_Types.f90 +++ b/modules/hydrodyn/src/SS_Radiation_Types.f90 @@ -160,189 +160,79 @@ SUBROUTINE SS_Rad_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE SS_Rad_DestroyInitInput - SUBROUTINE SS_Rad_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SS_Rad_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%InputFile) ! InputFile - Int_BufSz = Int_BufSz + 1 ! enabledDOFs allocated yes/no - IF ( ALLOCATED(InData%enabledDOFs) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! enabledDOFs upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%enabledDOFs) ! enabledDOFs - END IF - Int_BufSz = Int_BufSz + 1 ! NBody - Int_BufSz = Int_BufSz + 1 ! PtfmRefztRot allocated yes/no - IF ( ALLOCATED(InData%PtfmRefztRot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmRefztRot upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%PtfmRefztRot) ! PtfmRefztRot - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%enabledDOFs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%enabledDOFs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%enabledDOFs,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%enabledDOFs,1), UBOUND(InData%enabledDOFs,1) - ReKiBuf(Re_Xferred) = InData%enabledDOFs(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NBody - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%PtfmRefztRot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmRefztRot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmRefztRot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmRefztRot,1), UBOUND(InData%PtfmRefztRot,1) - DbKiBuf(Db_Xferred) = InData%PtfmRefztRot(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE SS_Rad_PackInitInput - - SUBROUTINE SS_Rad_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SS_Rad_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! enabledDOFs not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%enabledDOFs)) DEALLOCATE(OutData%enabledDOFs) - ALLOCATE(OutData%enabledDOFs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%enabledDOFs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%enabledDOFs,1), UBOUND(OutData%enabledDOFs,1) - OutData%enabledDOFs(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%NBody = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmRefztRot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PtfmRefztRot)) DEALLOCATE(OutData%PtfmRefztRot) - ALLOCATE(OutData%PtfmRefztRot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefztRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmRefztRot,1), UBOUND(OutData%PtfmRefztRot,1) - OutData%PtfmRefztRot(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE SS_Rad_UnPackInitInput +subroutine SS_Rad_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SS_Rad_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Rad_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + ! InputFile + call RegPack(Buf, InData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! enabledDOFs + call RegPack(Buf, allocated(InData%enabledDOFs)) + if (allocated(InData%enabledDOFs)) then + call RegPackBounds(Buf, 1, lbound(InData%enabledDOFs), ubound(InData%enabledDOFs)) + call RegPack(Buf, InData%enabledDOFs) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NBody + call RegPack(Buf, InData%NBody) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmRefztRot + call RegPack(Buf, allocated(InData%PtfmRefztRot)) + if (allocated(InData%PtfmRefztRot)) then + call RegPackBounds(Buf, 1, lbound(InData%PtfmRefztRot), ubound(InData%PtfmRefztRot)) + call RegPack(Buf, InData%PtfmRefztRot) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SS_Rad_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SS_Rad_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Rad_UnPackInitInput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! InputFile + call RegUnpack(Buf, OutData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! enabledDOFs + if (allocated(OutData%enabledDOFs)) deallocate(OutData%enabledDOFs) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%enabledDOFs(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%enabledDOFs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%enabledDOFs) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NBody + call RegUnpack(Buf, OutData%NBody) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmRefztRot + if (allocated(OutData%PtfmRefztRot)) deallocate(OutData%PtfmRefztRot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PtfmRefztRot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefztRot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PtfmRefztRot) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE SS_Rad_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(SS_Rad_InitOutputType), INTENT(IN) :: SrcInitOutputData TYPE(SS_Rad_InitOutputType), INTENT(INOUT) :: DstInitOutputData @@ -405,183 +295,67 @@ SUBROUTINE SS_Rad_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE SS_Rad_DestroyInitOutput - SUBROUTINE SS_Rad_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SS_Rad_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! WriteOutputHdr allocated yes/no - IF ( ALLOCATED(InData%WriteOutputHdr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdr upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdr)*LEN(InData%WriteOutputHdr) ! WriteOutputHdr - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputUnt allocated yes/no - IF ( ALLOCATED(InData%WriteOutputUnt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUnt upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUnt)*LEN(InData%WriteOutputUnt) ! WriteOutputUnt - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%WriteOutputHdr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) - DO I = 1, LEN(InData%WriteOutputHdr) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputUnt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) - DO I = 1, LEN(InData%WriteOutputUnt) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - END SUBROUTINE SS_Rad_PackInitOutput - - SUBROUTINE SS_Rad_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SS_Rad_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputHdr)) DEALLOCATE(OutData%WriteOutputHdr) - ALLOCATE(OutData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) - DO I = 1, LEN(OutData%WriteOutputHdr) - OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputUnt)) DEALLOCATE(OutData%WriteOutputUnt) - ALLOCATE(OutData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) - DO I = 1, LEN(OutData%WriteOutputUnt) - OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - END SUBROUTINE SS_Rad_UnPackInitOutput +subroutine SS_Rad_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SS_Rad_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Rad_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! WriteOutputHdr + call RegPack(Buf, allocated(InData%WriteOutputHdr)) + if (allocated(InData%WriteOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPack(Buf, InData%WriteOutputHdr) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutputUnt + call RegPack(Buf, allocated(InData%WriteOutputUnt)) + if (allocated(InData%WriteOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPack(Buf, InData%WriteOutputUnt) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SS_Rad_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SS_Rad_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Rad_UnPackInitOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! WriteOutputHdr + if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WriteOutputUnt + if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE SS_Rad_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(SS_Rad_ContinuousStateType), INTENT(IN) :: SrcContStateData TYPE(SS_Rad_ContinuousStateType), INTENT(INOUT) :: DstContStateData @@ -629,137 +403,45 @@ SUBROUTINE SS_Rad_DestroyContState( ContStateData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE SS_Rad_DestroyContState - SUBROUTINE SS_Rad_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SS_Rad_ContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_PackContState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! x allocated yes/no - IF ( ALLOCATED(InData%x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%x) ! x - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - DbKiBuf(Db_Xferred) = InData%x(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE SS_Rad_PackContState - - SUBROUTINE SS_Rad_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SS_Rad_ContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_UnPackContState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%x)) DEALLOCATE(OutData%x) - ALLOCATE(OutData%x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) - OutData%x(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE SS_Rad_UnPackContState +subroutine SS_Rad_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SS_Rad_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Rad_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + ! x + call RegPack(Buf, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(Buf, 1, lbound(InData%x), ubound(InData%x)) + call RegPack(Buf, InData%x) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SS_Rad_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SS_Rad_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Rad_UnPackContState' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! x + if (allocated(OutData%x)) deallocate(OutData%x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%x) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE SS_Rad_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(SS_Rad_DiscreteStateType), INTENT(IN) :: SrcDiscStateData TYPE(SS_Rad_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData @@ -792,103 +474,26 @@ SUBROUTINE SS_Rad_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) END SUBROUTINE SS_Rad_DestroyDiscState - SUBROUTINE SS_Rad_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SS_Rad_DiscreteStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_PackDiscState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyDiscState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SS_Rad_PackDiscState - - SUBROUTINE SS_Rad_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SS_Rad_DiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_UnPackDiscState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyDiscState = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SS_Rad_UnPackDiscState +subroutine SS_Rad_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SS_Rad_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Rad_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyDiscState + call RegPack(Buf, InData%DummyDiscState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SS_Rad_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SS_Rad_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Rad_UnPackDiscState' + if (Buf%ErrStat /= ErrID_None) return + ! DummyDiscState + call RegUnpack(Buf, OutData%DummyDiscState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE SS_Rad_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(SS_Rad_ConstraintStateType), INTENT(IN) :: SrcConstrStateData TYPE(SS_Rad_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData @@ -921,103 +526,26 @@ SUBROUTINE SS_Rad_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) END SUBROUTINE SS_Rad_DestroyConstrState - SUBROUTINE SS_Rad_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SS_Rad_ConstraintStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_PackConstrState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyConstrState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SS_Rad_PackConstrState - - SUBROUTINE SS_Rad_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SS_Rad_ConstraintStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_UnPackConstrState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyConstrState = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SS_Rad_UnPackConstrState +subroutine SS_Rad_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SS_Rad_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Rad_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyConstrState + call RegPack(Buf, InData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SS_Rad_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SS_Rad_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Rad_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + ! DummyConstrState + call RegUnpack(Buf, OutData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE SS_Rad_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(SS_Rad_OtherStateType), INTENT(IN) :: SrcOtherStateData TYPE(SS_Rad_OtherStateType), INTENT(INOUT) :: DstOtherStateData @@ -1060,198 +588,43 @@ SUBROUTINE SS_Rad_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) ENDDO END SUBROUTINE SS_Rad_DestroyOtherState - SUBROUTINE SS_Rad_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SS_Rad_OtherStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_PackOtherState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! n - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) - Int_BufSz = Int_BufSz + 3 ! xdot: size of buffers for each call to pack subtype - CALL SS_Rad_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xdot - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xdot - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xdot - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xdot - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%n - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) - CALL SS_Rad_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, OnlySize ) ! xdot - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END SUBROUTINE SS_Rad_PackOtherState - - SUBROUTINE SS_Rad_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SS_Rad_OtherStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_UnPackOtherState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%n = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%xdot,1) - i1_u = UBOUND(OutData%xdot,1) - DO i1 = LBOUND(OutData%xdot,1), UBOUND(OutData%xdot,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SS_Rad_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%xdot(i1), ErrStat2, ErrMsg2 ) ! xdot - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END SUBROUTINE SS_Rad_UnPackOtherState +subroutine SS_Rad_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SS_Rad_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Rad_PackOtherState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! n + call RegPack(Buf, InData%n) + if (RegCheckErr(Buf, RoutineName)) return + ! xdot + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) + do i1 = LB(1), UB(1) + call SS_Rad_PackContState(Buf, InData%xdot(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SS_Rad_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SS_Rad_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Rad_UnPackOtherState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat /= ErrID_None) return + ! n + call RegUnpack(Buf, OutData%n) + if (RegCheckErr(Buf, RoutineName)) return + ! xdot + LB(1:1) = lbound(OutData%xdot) + UB(1:1) = ubound(OutData%xdot) + do i1 = LB(1), UB(1) + call SS_Rad_UnpackContState(Buf, OutData%xdot(i1)) ! xdot + end do +end subroutine SUBROUTINE SS_Rad_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) TYPE(SS_Rad_MiscVarType), INTENT(IN) :: SrcMiscData TYPE(SS_Rad_MiscVarType), INTENT(INOUT) :: DstMiscData @@ -1284,103 +657,26 @@ SUBROUTINE SS_Rad_DestroyMisc( MiscData, ErrStat, ErrMsg ) END SUBROUTINE SS_Rad_DestroyMisc - SUBROUTINE SS_Rad_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SS_Rad_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyMiscVar - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyMiscVar - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SS_Rad_PackMisc - - SUBROUTINE SS_Rad_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SS_Rad_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyMiscVar = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SS_Rad_UnPackMisc +subroutine SS_Rad_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SS_Rad_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Rad_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyMiscVar + call RegPack(Buf, InData%DummyMiscVar) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SS_Rad_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SS_Rad_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Rad_UnPackMisc' + if (Buf%ErrStat /= ErrID_None) return + ! DummyMiscVar + call RegUnpack(Buf, OutData%DummyMiscVar) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE SS_Rad_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(SS_Rad_ParameterType), INTENT(IN) :: SrcParamData TYPE(SS_Rad_ParameterType), INTENT(INOUT) :: DstParamData @@ -1483,297 +779,129 @@ SUBROUTINE SS_Rad_DestroyParam( ParamData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE SS_Rad_DestroyParam - SUBROUTINE SS_Rad_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SS_Rad_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! DT - Int_BufSz = Int_BufSz + 1 ! A allocated yes/no - IF ( ALLOCATED(InData%A) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! A upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%A) ! A - END IF - Int_BufSz = Int_BufSz + 1 ! B allocated yes/no - IF ( ALLOCATED(InData%B) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! B upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%B) ! B - END IF - Int_BufSz = Int_BufSz + 1 ! C allocated yes/no - IF ( ALLOCATED(InData%C) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! C upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%C) ! C - END IF - Int_BufSz = Int_BufSz + 1 ! numStates - Int_BufSz = Int_BufSz + 1 ! spdof allocated yes/no - IF ( ALLOCATED(InData%spdof) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! spdof upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%spdof) ! spdof - END IF - Int_BufSz = Int_BufSz + 1 ! NBody - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%A) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%A,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%A,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%A,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%A,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%A,2), UBOUND(InData%A,2) - DO i1 = LBOUND(InData%A,1), UBOUND(InData%A,1) - ReKiBuf(Re_Xferred) = InData%A(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%B) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%B,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%B,2), UBOUND(InData%B,2) - DO i1 = LBOUND(InData%B,1), UBOUND(InData%B,1) - ReKiBuf(Re_Xferred) = InData%B(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%C) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%C,2), UBOUND(InData%C,2) - DO i1 = LBOUND(InData%C,1), UBOUND(InData%C,1) - ReKiBuf(Re_Xferred) = InData%C(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%numStates - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%spdof) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%spdof,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%spdof,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%spdof,1), UBOUND(InData%spdof,1) - IntKiBuf(Int_Xferred) = InData%spdof(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NBody - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SS_Rad_PackParam - - SUBROUTINE SS_Rad_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SS_Rad_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! A not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%A)) DEALLOCATE(OutData%A) - ALLOCATE(OutData%A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%A.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%A,2), UBOUND(OutData%A,2) - DO i1 = LBOUND(OutData%A,1), UBOUND(OutData%A,1) - OutData%A(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! B not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%B)) DEALLOCATE(OutData%B) - ALLOCATE(OutData%B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%B,2), UBOUND(OutData%B,2) - DO i1 = LBOUND(OutData%B,1), UBOUND(OutData%B,1) - OutData%B(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%C)) DEALLOCATE(OutData%C) - ALLOCATE(OutData%C(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%C,2), UBOUND(OutData%C,2) - DO i1 = LBOUND(OutData%C,1), UBOUND(OutData%C,1) - OutData%C(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%numStates = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! spdof not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%spdof)) DEALLOCATE(OutData%spdof) - ALLOCATE(OutData%spdof(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%spdof.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%spdof,1), UBOUND(OutData%spdof,1) - OutData%spdof(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%NBody = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SS_Rad_UnPackParam +subroutine SS_Rad_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SS_Rad_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Rad_PackParam' + if (Buf%ErrStat >= AbortErrLev) return + ! DT + call RegPack(Buf, InData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! A + call RegPack(Buf, allocated(InData%A)) + if (allocated(InData%A)) then + call RegPackBounds(Buf, 2, lbound(InData%A), ubound(InData%A)) + call RegPack(Buf, InData%A) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! B + call RegPack(Buf, allocated(InData%B)) + if (allocated(InData%B)) then + call RegPackBounds(Buf, 2, lbound(InData%B), ubound(InData%B)) + call RegPack(Buf, InData%B) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! C + call RegPack(Buf, allocated(InData%C)) + if (allocated(InData%C)) then + call RegPackBounds(Buf, 2, lbound(InData%C), ubound(InData%C)) + call RegPack(Buf, InData%C) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! numStates + call RegPack(Buf, InData%numStates) + if (RegCheckErr(Buf, RoutineName)) return + ! spdof + call RegPack(Buf, allocated(InData%spdof)) + if (allocated(InData%spdof)) then + call RegPackBounds(Buf, 1, lbound(InData%spdof), ubound(InData%spdof)) + call RegPack(Buf, InData%spdof) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NBody + call RegPack(Buf, InData%NBody) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SS_Rad_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SS_Rad_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Rad_UnPackParam' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! DT + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! A + if (allocated(OutData%A)) deallocate(OutData%A) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%A(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%A.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%A) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! B + if (allocated(OutData%B)) deallocate(OutData%B) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%B(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%B) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! C + if (allocated(OutData%C)) deallocate(OutData%C) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%C(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%C.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%C) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! numStates + call RegUnpack(Buf, OutData%numStates) + if (RegCheckErr(Buf, RoutineName)) return + ! spdof + if (allocated(OutData%spdof)) deallocate(OutData%spdof) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%spdof(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%spdof.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%spdof) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NBody + call RegUnpack(Buf, OutData%NBody) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE SS_Rad_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(SS_Rad_InputType), INTENT(IN) :: SrcInputData TYPE(SS_Rad_InputType), INTENT(INOUT) :: DstInputData @@ -1821,137 +949,45 @@ SUBROUTINE SS_Rad_DestroyInput( InputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE SS_Rad_DestroyInput - SUBROUTINE SS_Rad_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SS_Rad_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! dq allocated yes/no - IF ( ALLOCATED(InData%dq) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dq upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dq) ! dq - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%dq) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dq,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dq,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dq,1), UBOUND(InData%dq,1) - ReKiBuf(Re_Xferred) = InData%dq(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SS_Rad_PackInput - - SUBROUTINE SS_Rad_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SS_Rad_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dq not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%dq)) DEALLOCATE(OutData%dq) - ALLOCATE(OutData%dq(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dq,1), UBOUND(OutData%dq,1) - OutData%dq(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SS_Rad_UnPackInput +subroutine SS_Rad_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SS_Rad_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Rad_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + ! dq + call RegPack(Buf, allocated(InData%dq)) + if (allocated(InData%dq)) then + call RegPackBounds(Buf, 1, lbound(InData%dq), ubound(InData%dq)) + call RegPack(Buf, InData%dq) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SS_Rad_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SS_Rad_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Rad_UnPackInput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! dq + if (allocated(OutData%dq)) deallocate(OutData%dq) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dq(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dq.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dq) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE SS_Rad_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(SS_Rad_OutputType), INTENT(IN) :: SrcOutputData TYPE(SS_Rad_OutputType), INTENT(INOUT) :: DstOutputData @@ -2014,175 +1050,67 @@ SUBROUTINE SS_Rad_DestroyOutput( OutputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE SS_Rad_DestroyOutput - SUBROUTINE SS_Rad_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SS_Rad_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! y allocated yes/no - IF ( ALLOCATED(InData%y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%y) ! y - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutput allocated yes/no - IF ( ALLOCATED(InData%WriteOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutput upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WriteOutput) ! WriteOutput - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) - ReKiBuf(Re_Xferred) = InData%y(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) - ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SS_Rad_PackOutput - - SUBROUTINE SS_Rad_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SS_Rad_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%y)) DEALLOCATE(OutData%y) - ALLOCATE(OutData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) - OutData%y(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutput)) DEALLOCATE(OutData%WriteOutput) - ALLOCATE(OutData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) - OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SS_Rad_UnPackOutput +subroutine SS_Rad_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SS_Rad_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SS_Rad_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! y + call RegPack(Buf, allocated(InData%y)) + if (allocated(InData%y)) then + call RegPackBounds(Buf, 1, lbound(InData%y), ubound(InData%y)) + call RegPack(Buf, InData%y) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutput + call RegPack(Buf, allocated(InData%WriteOutput)) + if (allocated(InData%WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPack(Buf, InData%WriteOutput) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SS_Rad_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SS_Rad_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SS_Rad_UnPackOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! y + if (allocated(OutData%y)) deallocate(OutData%y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%y) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WriteOutput + if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE SS_Rad_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) ! diff --git a/modules/hydrodyn/src/WAMIT2_Types.f90 b/modules/hydrodyn/src/WAMIT2_Types.f90 index c25f669f91..c8fdf5ef68 100644 --- a/modules/hydrodyn/src/WAMIT2_Types.f90 +++ b/modules/hydrodyn/src/WAMIT2_Types.f90 @@ -231,413 +231,370 @@ SUBROUTINE WAMIT2_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) NULLIFY(InitInputData%WaveDirArr) END SUBROUTINE WAMIT2_DestroyInitInput - SUBROUTINE WAMIT2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(WAMIT2_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! HasWAMIT - Int_BufSz = Int_BufSz + 1*LEN(InData%WAMITFile) ! WAMITFile - Int_BufSz = Int_BufSz + 1 ! NBody - Int_BufSz = Int_BufSz + 1 ! NBodyMod - Int_BufSz = Int_BufSz + 1 ! PtfmRefxt allocated yes/no - IF ( ALLOCATED(InData%PtfmRefxt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmRefxt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmRefxt) ! PtfmRefxt - END IF - Int_BufSz = Int_BufSz + 1 ! PtfmRefyt allocated yes/no - IF ( ALLOCATED(InData%PtfmRefyt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmRefyt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmRefyt) ! PtfmRefyt - END IF - Int_BufSz = Int_BufSz + 1 ! PtfmRefzt allocated yes/no - IF ( ALLOCATED(InData%PtfmRefzt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmRefzt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmRefzt) ! PtfmRefzt - END IF - Int_BufSz = Int_BufSz + 1 ! PtfmRefztRot allocated yes/no - IF ( ALLOCATED(InData%PtfmRefztRot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmRefztRot upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%PtfmRefztRot) ! PtfmRefztRot - END IF - Re_BufSz = Re_BufSz + 1 ! WAMITULEN - Re_BufSz = Re_BufSz + 1 ! RhoXg - Int_BufSz = Int_BufSz + 1 ! NStepWave - Int_BufSz = Int_BufSz + 1 ! NStepWave2 - Re_BufSz = Re_BufSz + 1 ! WaveDOmega - Re_BufSz = Re_BufSz + 1 ! WtrDens - Re_BufSz = Re_BufSz + 1 ! Gravity - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Re_BufSz = Re_BufSz + 1 ! WaveDir - Int_BufSz = Int_BufSz + 1 ! WaveMultiDir - Re_BufSz = Re_BufSz + 1 ! WaveDirMin - Re_BufSz = Re_BufSz + 1 ! WaveDirMax - Int_BufSz = Int_BufSz + 1 ! WaveMod - Int_BufSz = Int_BufSz + 1 ! MnDrift - Int_BufSz = Int_BufSz + 1 ! NewmanApp - Int_BufSz = Int_BufSz + 1 ! DiffQTF - Int_BufSz = Int_BufSz + 1 ! SumQTF - Int_BufSz = Int_BufSz + 1 ! MnDriftF - Int_BufSz = Int_BufSz + 1 ! NewmanAppF - Int_BufSz = Int_BufSz + 1 ! DiffQTFF - Int_BufSz = Int_BufSz + 1 ! SumQTFF - Re_BufSz = Re_BufSz + 1 ! WvLowCOff - Re_BufSz = Re_BufSz + 1 ! WvHiCOff - Re_BufSz = Re_BufSz + 1 ! WvLowCOffD - Re_BufSz = Re_BufSz + 1 ! WvHiCOffD - Re_BufSz = Re_BufSz + 1 ! WvLowCOffS - Re_BufSz = Re_BufSz + 1 ! WvHiCOffS - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = TRANSFER(InData%HasWAMIT, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%WAMITFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%WAMITFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%NBody - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NBodyMod - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%PtfmRefxt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmRefxt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmRefxt,1) - Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%PtfmRefxt,1), UBOUND(InData%PtfmRefxt,1) - ReKiBuf(Re_Xferred) = InData%PtfmRefxt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PtfmRefyt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmRefyt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmRefyt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmRefyt,1), UBOUND(InData%PtfmRefyt,1) - ReKiBuf(Re_Xferred) = InData%PtfmRefyt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PtfmRefzt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmRefzt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmRefzt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmRefzt,1), UBOUND(InData%PtfmRefzt,1) - ReKiBuf(Re_Xferred) = InData%PtfmRefzt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PtfmRefztRot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmRefztRot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmRefztRot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmRefztRot,1), UBOUND(InData%PtfmRefztRot,1) - DbKiBuf(Db_Xferred) = InData%PtfmRefztRot(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%WAMITULEN - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RhoXg - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepWave2 - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDOmega - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDir - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WaveMultiDir, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDirMin - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDirMax - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MnDrift - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NewmanApp - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%DiffQTF - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%SumQTF - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%MnDriftF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%NewmanAppF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%DiffQTFF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%SumQTFF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WvLowCOff - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WvHiCOff - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WvLowCOffD - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WvHiCOffD - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WvLowCOffS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WvHiCOffS - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE WAMIT2_PackInitInput - - SUBROUTINE WAMIT2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(WAMIT2_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%HasWAMIT = TRANSFER(IntKiBuf(Int_Xferred), OutData%HasWAMIT) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%WAMITFile) - OutData%WAMITFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%NBody = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NBodyMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmRefxt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PtfmRefxt)) DEALLOCATE(OutData%PtfmRefxt) - ALLOCATE(OutData%PtfmRefxt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefxt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmRefxt,1), UBOUND(OutData%PtfmRefxt,1) - OutData%PtfmRefxt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmRefyt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PtfmRefyt)) DEALLOCATE(OutData%PtfmRefyt) - ALLOCATE(OutData%PtfmRefyt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefyt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmRefyt,1), UBOUND(OutData%PtfmRefyt,1) - OutData%PtfmRefyt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmRefzt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PtfmRefzt)) DEALLOCATE(OutData%PtfmRefzt) - ALLOCATE(OutData%PtfmRefzt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefzt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmRefzt,1), UBOUND(OutData%PtfmRefzt,1) - OutData%PtfmRefzt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmRefztRot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PtfmRefztRot)) DEALLOCATE(OutData%PtfmRefztRot) - ALLOCATE(OutData%PtfmRefztRot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefztRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmRefztRot,1), UBOUND(OutData%PtfmRefztRot,1) - OutData%PtfmRefztRot(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - OutData%WAMITULEN = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RhoXg = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NStepWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NStepWave2 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WaveDOmega = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - NULLIFY(OutData%WaveElevC0) - OutData%WaveDir = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveMultiDir = TRANSFER(IntKiBuf(Int_Xferred), OutData%WaveMultiDir) - Int_Xferred = Int_Xferred + 1 - NULLIFY(OutData%WaveDirArr) - OutData%WaveDirMin = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDirMax = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MnDrift = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NewmanApp = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%DiffQTF = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%SumQTF = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MnDriftF = TRANSFER(IntKiBuf(Int_Xferred), OutData%MnDriftF) - Int_Xferred = Int_Xferred + 1 - OutData%NewmanAppF = TRANSFER(IntKiBuf(Int_Xferred), OutData%NewmanAppF) - Int_Xferred = Int_Xferred + 1 - OutData%DiffQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%DiffQTFF) - Int_Xferred = Int_Xferred + 1 - OutData%SumQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumQTFF) - Int_Xferred = Int_Xferred + 1 - OutData%WvLowCOff = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WvHiCOff = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WvLowCOffD = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WvHiCOffD = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WvLowCOffS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WvHiCOffS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE WAMIT2_UnPackInitInput +subroutine WAMIT2_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT2_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WAMIT2_PackInitInput' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + ! HasWAMIT + call RegPack(Buf, InData%HasWAMIT) + if (RegCheckErr(Buf, RoutineName)) return + ! WAMITFile + call RegPack(Buf, InData%WAMITFile) + if (RegCheckErr(Buf, RoutineName)) return + ! NBody + call RegPack(Buf, InData%NBody) + if (RegCheckErr(Buf, RoutineName)) return + ! NBodyMod + call RegPack(Buf, InData%NBodyMod) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmRefxt + call RegPack(Buf, allocated(InData%PtfmRefxt)) + if (allocated(InData%PtfmRefxt)) then + call RegPackBounds(Buf, 1, lbound(InData%PtfmRefxt), ubound(InData%PtfmRefxt)) + call RegPack(Buf, InData%PtfmRefxt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmRefyt + call RegPack(Buf, allocated(InData%PtfmRefyt)) + if (allocated(InData%PtfmRefyt)) then + call RegPackBounds(Buf, 1, lbound(InData%PtfmRefyt), ubound(InData%PtfmRefyt)) + call RegPack(Buf, InData%PtfmRefyt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmRefzt + call RegPack(Buf, allocated(InData%PtfmRefzt)) + if (allocated(InData%PtfmRefzt)) then + call RegPackBounds(Buf, 1, lbound(InData%PtfmRefzt), ubound(InData%PtfmRefzt)) + call RegPack(Buf, InData%PtfmRefzt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmRefztRot + call RegPack(Buf, allocated(InData%PtfmRefztRot)) + if (allocated(InData%PtfmRefztRot)) then + call RegPackBounds(Buf, 1, lbound(InData%PtfmRefztRot), ubound(InData%PtfmRefztRot)) + call RegPack(Buf, InData%PtfmRefztRot) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WAMITULEN + call RegPack(Buf, InData%WAMITULEN) + if (RegCheckErr(Buf, RoutineName)) return + ! RhoXg + call RegPack(Buf, InData%RhoXg) + if (RegCheckErr(Buf, RoutineName)) return + ! NStepWave + call RegPack(Buf, InData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + ! NStepWave2 + call RegPack(Buf, InData%NStepWave2) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDOmega + call RegPack(Buf, InData%WaveDOmega) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDens + call RegPack(Buf, InData%WtrDens) + if (RegCheckErr(Buf, RoutineName)) return + ! Gravity + call RegPack(Buf, InData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDpth + call RegPack(Buf, InData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElevC0 + call RegPack(Buf, associated(InData%WaveElevC0)) + if (associated(InData%WaveElevC0)) then + call RegPackBounds(Buf, 2, lbound(InData%WaveElevC0), ubound(InData%WaveElevC0)) + call RegPackPointer(Buf, c_loc(InData%WaveElevC0), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveElevC0) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDir + call RegPack(Buf, InData%WaveDir) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveMultiDir + call RegPack(Buf, InData%WaveMultiDir) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDirArr + call RegPack(Buf, associated(InData%WaveDirArr)) + if (associated(InData%WaveDirArr)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveDirArr), ubound(InData%WaveDirArr)) + call RegPackPointer(Buf, c_loc(InData%WaveDirArr), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveDirArr) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDirMin + call RegPack(Buf, InData%WaveDirMin) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDirMax + call RegPack(Buf, InData%WaveDirMax) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveMod + call RegPack(Buf, InData%WaveMod) + if (RegCheckErr(Buf, RoutineName)) return + ! MnDrift + call RegPack(Buf, InData%MnDrift) + if (RegCheckErr(Buf, RoutineName)) return + ! NewmanApp + call RegPack(Buf, InData%NewmanApp) + if (RegCheckErr(Buf, RoutineName)) return + ! DiffQTF + call RegPack(Buf, InData%DiffQTF) + if (RegCheckErr(Buf, RoutineName)) return + ! SumQTF + call RegPack(Buf, InData%SumQTF) + if (RegCheckErr(Buf, RoutineName)) return + ! MnDriftF + call RegPack(Buf, InData%MnDriftF) + if (RegCheckErr(Buf, RoutineName)) return + ! NewmanAppF + call RegPack(Buf, InData%NewmanAppF) + if (RegCheckErr(Buf, RoutineName)) return + ! DiffQTFF + call RegPack(Buf, InData%DiffQTFF) + if (RegCheckErr(Buf, RoutineName)) return + ! SumQTFF + call RegPack(Buf, InData%SumQTFF) + if (RegCheckErr(Buf, RoutineName)) return + ! WvLowCOff + call RegPack(Buf, InData%WvLowCOff) + if (RegCheckErr(Buf, RoutineName)) return + ! WvHiCOff + call RegPack(Buf, InData%WvHiCOff) + if (RegCheckErr(Buf, RoutineName)) return + ! WvLowCOffD + call RegPack(Buf, InData%WvLowCOffD) + if (RegCheckErr(Buf, RoutineName)) return + ! WvHiCOffD + call RegPack(Buf, InData%WvHiCOffD) + if (RegCheckErr(Buf, RoutineName)) return + ! WvLowCOffS + call RegPack(Buf, InData%WvLowCOffS) + if (RegCheckErr(Buf, RoutineName)) return + ! WvHiCOffS + call RegPack(Buf, InData%WvHiCOffS) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine +subroutine WAMIT2_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT2_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WAMIT2_UnPackInitInput' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + ! HasWAMIT + call RegUnpack(Buf, OutData%HasWAMIT) + if (RegCheckErr(Buf, RoutineName)) return + ! WAMITFile + call RegUnpack(Buf, OutData%WAMITFile) + if (RegCheckErr(Buf, RoutineName)) return + ! NBody + call RegUnpack(Buf, OutData%NBody) + if (RegCheckErr(Buf, RoutineName)) return + ! NBodyMod + call RegUnpack(Buf, OutData%NBodyMod) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmRefxt + if (allocated(OutData%PtfmRefxt)) deallocate(OutData%PtfmRefxt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PtfmRefxt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefxt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PtfmRefxt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PtfmRefyt + if (allocated(OutData%PtfmRefyt)) deallocate(OutData%PtfmRefyt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PtfmRefyt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefyt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PtfmRefyt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PtfmRefzt + if (allocated(OutData%PtfmRefzt)) deallocate(OutData%PtfmRefzt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PtfmRefzt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefzt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PtfmRefzt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PtfmRefztRot + if (allocated(OutData%PtfmRefztRot)) deallocate(OutData%PtfmRefztRot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PtfmRefztRot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefztRot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PtfmRefztRot) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WAMITULEN + call RegUnpack(Buf, OutData%WAMITULEN) + if (RegCheckErr(Buf, RoutineName)) return + ! RhoXg + call RegUnpack(Buf, OutData%RhoXg) + if (RegCheckErr(Buf, RoutineName)) return + ! NStepWave + call RegUnpack(Buf, OutData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + ! NStepWave2 + call RegUnpack(Buf, OutData%NStepWave2) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDOmega + call RegUnpack(Buf, OutData%WaveDOmega) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDens + call RegUnpack(Buf, OutData%WtrDens) + if (RegCheckErr(Buf, RoutineName)) return + ! Gravity + call RegUnpack(Buf, OutData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDpth + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElevC0 + if (associated(OutData%WaveElevC0)) deallocate(OutData%WaveElevC0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveElevC0, UB(1:2)-LB(1:2)) + OutData%WaveElevC0(LB(1):,LB(2):) => OutData%WaveElevC0 + else + allocate(OutData%WaveElevC0(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElevC0) + call RegUnpack(Buf, OutData%WaveElevC0) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveElevC0 => null() + end if + ! WaveDir + call RegUnpack(Buf, OutData%WaveDir) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveMultiDir + call RegUnpack(Buf, OutData%WaveMultiDir) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDirArr + if (associated(OutData%WaveDirArr)) deallocate(OutData%WaveDirArr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveDirArr, UB(1:1)-LB(1:1)) + OutData%WaveDirArr(LB(1):) => OutData%WaveDirArr + else + allocate(OutData%WaveDirArr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveDirArr) + call RegUnpack(Buf, OutData%WaveDirArr) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveDirArr => null() + end if + ! WaveDirMin + call RegUnpack(Buf, OutData%WaveDirMin) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDirMax + call RegUnpack(Buf, OutData%WaveDirMax) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveMod + call RegUnpack(Buf, OutData%WaveMod) + if (RegCheckErr(Buf, RoutineName)) return + ! MnDrift + call RegUnpack(Buf, OutData%MnDrift) + if (RegCheckErr(Buf, RoutineName)) return + ! NewmanApp + call RegUnpack(Buf, OutData%NewmanApp) + if (RegCheckErr(Buf, RoutineName)) return + ! DiffQTF + call RegUnpack(Buf, OutData%DiffQTF) + if (RegCheckErr(Buf, RoutineName)) return + ! SumQTF + call RegUnpack(Buf, OutData%SumQTF) + if (RegCheckErr(Buf, RoutineName)) return + ! MnDriftF + call RegUnpack(Buf, OutData%MnDriftF) + if (RegCheckErr(Buf, RoutineName)) return + ! NewmanAppF + call RegUnpack(Buf, OutData%NewmanAppF) + if (RegCheckErr(Buf, RoutineName)) return + ! DiffQTFF + call RegUnpack(Buf, OutData%DiffQTFF) + if (RegCheckErr(Buf, RoutineName)) return + ! SumQTFF + call RegUnpack(Buf, OutData%SumQTFF) + if (RegCheckErr(Buf, RoutineName)) return + ! WvLowCOff + call RegUnpack(Buf, OutData%WvLowCOff) + if (RegCheckErr(Buf, RoutineName)) return + ! WvHiCOff + call RegUnpack(Buf, OutData%WvHiCOff) + if (RegCheckErr(Buf, RoutineName)) return + ! WvLowCOffD + call RegUnpack(Buf, OutData%WvLowCOffD) + if (RegCheckErr(Buf, RoutineName)) return + ! WvHiCOffD + call RegUnpack(Buf, OutData%WvHiCOffD) + if (RegCheckErr(Buf, RoutineName)) return + ! WvLowCOffS + call RegUnpack(Buf, OutData%WvLowCOffS) + if (RegCheckErr(Buf, RoutineName)) return + ! WvHiCOffS + call RegUnpack(Buf, OutData%WvHiCOffS) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE WAMIT2_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) TYPE(WAMIT2_MiscVarType), INTENT(IN) :: SrcMiscData TYPE(WAMIT2_MiscVarType), INTENT(INOUT) :: DstMiscData @@ -700,175 +657,67 @@ SUBROUTINE WAMIT2_DestroyMisc( MiscData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE WAMIT2_DestroyMisc - SUBROUTINE WAMIT2_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(WAMIT2_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! LastIndWave allocated yes/no - IF ( ALLOCATED(InData%LastIndWave) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LastIndWave upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LastIndWave) ! LastIndWave - END IF - Int_BufSz = Int_BufSz + 1 ! F_Waves2 allocated yes/no - IF ( ALLOCATED(InData%F_Waves2) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! F_Waves2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_Waves2) ! F_Waves2 - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%LastIndWave) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LastIndWave,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LastIndWave,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LastIndWave,1), UBOUND(InData%LastIndWave,1) - IntKiBuf(Int_Xferred) = InData%LastIndWave(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_Waves2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_Waves2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_Waves2,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%F_Waves2,1), UBOUND(InData%F_Waves2,1) - ReKiBuf(Re_Xferred) = InData%F_Waves2(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE WAMIT2_PackMisc - - SUBROUTINE WAMIT2_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(WAMIT2_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LastIndWave not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LastIndWave)) DEALLOCATE(OutData%LastIndWave) - ALLOCATE(OutData%LastIndWave(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LastIndWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LastIndWave,1), UBOUND(OutData%LastIndWave,1) - OutData%LastIndWave(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_Waves2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_Waves2)) DEALLOCATE(OutData%F_Waves2) - ALLOCATE(OutData%F_Waves2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_Waves2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%F_Waves2,1), UBOUND(OutData%F_Waves2,1) - OutData%F_Waves2(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE WAMIT2_UnPackMisc +subroutine WAMIT2_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT2_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WAMIT2_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + ! LastIndWave + call RegPack(Buf, allocated(InData%LastIndWave)) + if (allocated(InData%LastIndWave)) then + call RegPackBounds(Buf, 1, lbound(InData%LastIndWave), ubound(InData%LastIndWave)) + call RegPack(Buf, InData%LastIndWave) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! F_Waves2 + call RegPack(Buf, allocated(InData%F_Waves2)) + if (allocated(InData%F_Waves2)) then + call RegPackBounds(Buf, 1, lbound(InData%F_Waves2), ubound(InData%F_Waves2)) + call RegPack(Buf, InData%F_Waves2) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine +subroutine WAMIT2_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT2_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WAMIT2_UnPackMisc' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! LastIndWave + if (allocated(OutData%LastIndWave)) deallocate(OutData%LastIndWave) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LastIndWave(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LastIndWave.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LastIndWave) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! F_Waves2 + if (allocated(OutData%F_Waves2)) deallocate(OutData%F_Waves2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_Waves2(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_Waves2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_Waves2) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE WAMIT2_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(WAMIT2_ParameterType), INTENT(IN) :: SrcParamData TYPE(WAMIT2_ParameterType), INTENT(INOUT) :: DstParamData @@ -930,227 +779,111 @@ SUBROUTINE WAMIT2_DestroyParam( ParamData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE WAMIT2_DestroyParam - SUBROUTINE WAMIT2_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(WAMIT2_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! NStepWave - Int_BufSz = Int_BufSz + 1 ! NBody - Int_BufSz = Int_BufSz + 1 ! NBodyMod - Int_BufSz = Int_BufSz + 1 ! WaveExctn2 allocated yes/no - IF ( ALLOCATED(InData%WaveExctn2) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveExctn2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveExctn2) ! WaveExctn2 - END IF - Int_BufSz = Int_BufSz + SIZE(InData%MnDriftDims) ! MnDriftDims - Int_BufSz = Int_BufSz + SIZE(InData%NewmanAppDims) ! NewmanAppDims - Int_BufSz = Int_BufSz + SIZE(InData%DiffQTFDims) ! DiffQTFDims - Int_BufSz = Int_BufSz + SIZE(InData%SumQTFDims) ! SumQTFDims - Int_BufSz = Int_BufSz + 1 ! MnDriftF - Int_BufSz = Int_BufSz + 1 ! NewmanAppF - Int_BufSz = Int_BufSz + 1 ! DiffQTFF - Int_BufSz = Int_BufSz + 1 ! SumQTFF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END 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%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NBody - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NBodyMod - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveExctn2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveExctn2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveExctn2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveExctn2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveExctn2,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveExctn2,2), UBOUND(InData%WaveExctn2,2) - DO i1 = LBOUND(InData%WaveExctn2,1), UBOUND(InData%WaveExctn2,1) - ReKiBuf(Re_Xferred) = InData%WaveExctn2(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%MnDriftDims,1), UBOUND(InData%MnDriftDims,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%MnDriftDims(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%NewmanAppDims,1), UBOUND(InData%NewmanAppDims,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%NewmanAppDims(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%DiffQTFDims,1), UBOUND(InData%DiffQTFDims,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%DiffQTFDims(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%SumQTFDims,1), UBOUND(InData%SumQTFDims,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%SumQTFDims(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = TRANSFER(InData%MnDriftF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%NewmanAppF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%DiffQTFF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%SumQTFF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE WAMIT2_PackParam - - SUBROUTINE WAMIT2_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(WAMIT2_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%NStepWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NBody = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NBodyMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveExctn2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveExctn2)) DEALLOCATE(OutData%WaveExctn2) - ALLOCATE(OutData%WaveExctn2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveExctn2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveExctn2,2), UBOUND(OutData%WaveExctn2,2) - DO i1 = LBOUND(OutData%WaveExctn2,1), UBOUND(OutData%WaveExctn2,1) - OutData%WaveExctn2(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%MnDriftDims,1) - i1_u = UBOUND(OutData%MnDriftDims,1) - DO i1 = LBOUND(OutData%MnDriftDims,1), UBOUND(OutData%MnDriftDims,1) - OutData%MnDriftDims(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%MnDriftDims(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%NewmanAppDims,1) - i1_u = UBOUND(OutData%NewmanAppDims,1) - DO i1 = LBOUND(OutData%NewmanAppDims,1), UBOUND(OutData%NewmanAppDims,1) - OutData%NewmanAppDims(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%NewmanAppDims(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%DiffQTFDims,1) - i1_u = UBOUND(OutData%DiffQTFDims,1) - DO i1 = LBOUND(OutData%DiffQTFDims,1), UBOUND(OutData%DiffQTFDims,1) - OutData%DiffQTFDims(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%DiffQTFDims(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%SumQTFDims,1) - i1_u = UBOUND(OutData%SumQTFDims,1) - DO i1 = LBOUND(OutData%SumQTFDims,1), UBOUND(OutData%SumQTFDims,1) - OutData%SumQTFDims(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumQTFDims(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%MnDriftF = TRANSFER(IntKiBuf(Int_Xferred), OutData%MnDriftF) - Int_Xferred = Int_Xferred + 1 - OutData%NewmanAppF = TRANSFER(IntKiBuf(Int_Xferred), OutData%NewmanAppF) - Int_Xferred = Int_Xferred + 1 - OutData%DiffQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%DiffQTFF) - Int_Xferred = Int_Xferred + 1 - OutData%SumQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumQTFF) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE WAMIT2_UnPackParam +subroutine WAMIT2_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT2_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WAMIT2_PackParam' + if (Buf%ErrStat >= AbortErrLev) return + ! NStepWave + call RegPack(Buf, InData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + ! NBody + call RegPack(Buf, InData%NBody) + if (RegCheckErr(Buf, RoutineName)) return + ! NBodyMod + call RegPack(Buf, InData%NBodyMod) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveExctn2 + call RegPack(Buf, allocated(InData%WaveExctn2)) + if (allocated(InData%WaveExctn2)) then + call RegPackBounds(Buf, 2, lbound(InData%WaveExctn2), ubound(InData%WaveExctn2)) + call RegPack(Buf, InData%WaveExctn2) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MnDriftDims + call RegPack(Buf, InData%MnDriftDims) + if (RegCheckErr(Buf, RoutineName)) return + ! NewmanAppDims + call RegPack(Buf, InData%NewmanAppDims) + if (RegCheckErr(Buf, RoutineName)) return + ! DiffQTFDims + call RegPack(Buf, InData%DiffQTFDims) + if (RegCheckErr(Buf, RoutineName)) return + ! SumQTFDims + call RegPack(Buf, InData%SumQTFDims) + if (RegCheckErr(Buf, RoutineName)) return + ! MnDriftF + call RegPack(Buf, InData%MnDriftF) + if (RegCheckErr(Buf, RoutineName)) return + ! NewmanAppF + call RegPack(Buf, InData%NewmanAppF) + if (RegCheckErr(Buf, RoutineName)) return + ! DiffQTFF + call RegPack(Buf, InData%DiffQTFF) + if (RegCheckErr(Buf, RoutineName)) return + ! SumQTFF + call RegPack(Buf, InData%SumQTFF) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine +subroutine WAMIT2_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT2_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WAMIT2_UnPackParam' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! NStepWave + call RegUnpack(Buf, OutData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + ! NBody + call RegUnpack(Buf, OutData%NBody) + if (RegCheckErr(Buf, RoutineName)) return + ! NBodyMod + call RegUnpack(Buf, OutData%NBodyMod) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveExctn2 + if (allocated(OutData%WaveExctn2)) deallocate(OutData%WaveExctn2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveExctn2(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveExctn2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveExctn2) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! MnDriftDims + call RegUnpack(Buf, OutData%MnDriftDims) + if (RegCheckErr(Buf, RoutineName)) return + ! NewmanAppDims + call RegUnpack(Buf, OutData%NewmanAppDims) + if (RegCheckErr(Buf, RoutineName)) return + ! DiffQTFDims + call RegUnpack(Buf, OutData%DiffQTFDims) + if (RegCheckErr(Buf, RoutineName)) return + ! SumQTFDims + call RegUnpack(Buf, OutData%SumQTFDims) + if (RegCheckErr(Buf, RoutineName)) return + ! MnDriftF + call RegUnpack(Buf, OutData%MnDriftF) + if (RegCheckErr(Buf, RoutineName)) return + ! NewmanAppF + call RegUnpack(Buf, OutData%NewmanAppF) + if (RegCheckErr(Buf, RoutineName)) return + ! DiffQTFF + call RegUnpack(Buf, OutData%DiffQTFF) + if (RegCheckErr(Buf, RoutineName)) return + ! SumQTFF + call RegUnpack(Buf, OutData%SumQTFF) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE WAMIT2_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(WAMIT2_OutputType), INTENT(INOUT) :: SrcOutputData TYPE(WAMIT2_OutputType), INTENT(INOUT) :: DstOutputData @@ -1187,184 +920,25 @@ SUBROUTINE WAMIT2_DestroyOutput( OutputData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE WAMIT2_DestroyOutput - SUBROUTINE WAMIT2_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(WAMIT2_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Mesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Mesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Mesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL MeshPack( InData%Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE WAMIT2_PackOutput - - SUBROUTINE WAMIT2_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(WAMIT2_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE WAMIT2_UnPackOutput +subroutine WAMIT2_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT2_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WAMIT2_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! Mesh + call MeshPack(Buf, InData%Mesh) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine +subroutine WAMIT2_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT2_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WAMIT2_UnPackOutput' + if (Buf%ErrStat /= ErrID_None) return + ! Mesh + call MeshUnpack(Buf, OutData%Mesh) ! Mesh +end subroutine SUBROUTINE WAMIT2_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) ! diff --git a/modules/hydrodyn/src/WAMIT_Types.f90 b/modules/hydrodyn/src/WAMIT_Types.f90 index b89a163f66..a1bc9d1fc8 100644 --- a/modules/hydrodyn/src/WAMIT_Types.f90 +++ b/modules/hydrodyn/src/WAMIT_Types.f90 @@ -339,653 +339,526 @@ SUBROUTINE WAMIT_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE WAMIT_DestroyInitInput - SUBROUTINE WAMIT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(WAMIT_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! NBody - Int_BufSz = Int_BufSz + 1 ! NBodyMod - Re_BufSz = Re_BufSz + 1 ! Gravity - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Int_BufSz = Int_BufSz + 1 ! PtfmVol0 allocated yes/no - IF ( ALLOCATED(InData%PtfmVol0) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmVol0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmVol0) ! PtfmVol0 - END IF - Int_BufSz = Int_BufSz + 1 ! HasWAMIT - Re_BufSz = Re_BufSz + 1 ! WAMITULEN - Int_BufSz = Int_BufSz + 1 ! PtfmRefxt allocated yes/no - IF ( ALLOCATED(InData%PtfmRefxt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmRefxt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmRefxt) ! PtfmRefxt - END IF - Int_BufSz = Int_BufSz + 1 ! PtfmRefyt allocated yes/no - IF ( ALLOCATED(InData%PtfmRefyt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmRefyt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmRefyt) ! PtfmRefyt - END IF - Int_BufSz = Int_BufSz + 1 ! PtfmRefzt allocated yes/no - IF ( ALLOCATED(InData%PtfmRefzt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmRefzt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmRefzt) ! PtfmRefzt - END IF - Int_BufSz = Int_BufSz + 1 ! PtfmRefztRot allocated yes/no - IF ( ALLOCATED(InData%PtfmRefztRot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmRefztRot upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%PtfmRefztRot) ! PtfmRefztRot - END IF - Int_BufSz = Int_BufSz + 1 ! PtfmCOBxt allocated yes/no - IF ( ALLOCATED(InData%PtfmCOBxt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmCOBxt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmCOBxt) ! PtfmCOBxt - END IF - Int_BufSz = Int_BufSz + 1 ! PtfmCOByt allocated yes/no - IF ( ALLOCATED(InData%PtfmCOByt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PtfmCOByt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmCOByt) ! PtfmCOByt - END IF - Int_BufSz = Int_BufSz + 1 ! RdtnMod - Int_BufSz = Int_BufSz + 1 ! ExctnMod - Int_BufSz = Int_BufSz + 1 ! ExctnDisp - Re_BufSz = Re_BufSz + 1 ! ExctnCutOff - Db_BufSz = Db_BufSz + 1 ! RdtnTMax - Re_BufSz = Re_BufSz + 1 ! WaveDir - Int_BufSz = Int_BufSz + 1*LEN(InData%WAMITFile) ! WAMITFile - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Conv_Rdtn: size of buffers for each call to pack subtype - CALL Conv_Rdtn_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, .TRUE. ) ! Conv_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Conv_Rdtn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Conv_Rdtn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Conv_Rdtn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Re_BufSz = Re_BufSz + 1 ! Rhoxg - Int_BufSz = Int_BufSz + 1 ! NStepWave - Int_BufSz = Int_BufSz + 1 ! NStepWave2 - Re_BufSz = Re_BufSz + 1 ! WaveDOmega - Int_BufSz = Int_BufSz + 1 ! WaveMod - Re_BufSz = Re_BufSz + 1 ! WtrDens - Re_BufSz = Re_BufSz + 1 ! WaveDirMin - Re_BufSz = Re_BufSz + 1 ! WaveDirMax - Int_BufSz = Int_BufSz + 3 ! SeaSt_Interp_p: size of buffers for each call to pack subtype - CALL SeaSt_Interp_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt_Interp_p, ErrStat2, ErrMsg2, .TRUE. ) ! SeaSt_Interp_p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SeaSt_Interp_p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SeaSt_Interp_p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SeaSt_Interp_p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%NBody - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NBodyMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%PtfmVol0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmVol0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmVol0,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmVol0,1), UBOUND(InData%PtfmVol0,1) - ReKiBuf(Re_Xferred) = InData%PtfmVol0(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%HasWAMIT, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WAMITULEN - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%PtfmRefxt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmRefxt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmRefxt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmRefxt,1), UBOUND(InData%PtfmRefxt,1) - ReKiBuf(Re_Xferred) = InData%PtfmRefxt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PtfmRefyt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmRefyt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmRefyt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmRefyt,1), UBOUND(InData%PtfmRefyt,1) - ReKiBuf(Re_Xferred) = InData%PtfmRefyt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PtfmRefzt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmRefzt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmRefzt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmRefzt,1), UBOUND(InData%PtfmRefzt,1) - ReKiBuf(Re_Xferred) = InData%PtfmRefzt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PtfmRefztRot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmRefztRot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmRefztRot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmRefztRot,1), UBOUND(InData%PtfmRefztRot,1) - DbKiBuf(Db_Xferred) = InData%PtfmRefztRot(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PtfmCOBxt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmCOBxt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmCOBxt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmCOBxt,1), UBOUND(InData%PtfmCOBxt,1) - ReKiBuf(Re_Xferred) = InData%PtfmCOBxt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PtfmCOByt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmCOByt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmCOByt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PtfmCOByt,1), UBOUND(InData%PtfmCOByt,1) - ReKiBuf(Re_Xferred) = InData%PtfmCOByt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%RdtnMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ExctnMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ExctnDisp - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ExctnCutOff - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%RdtnTMax - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDir - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%WAMITFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%WAMITFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - CALL Conv_Rdtn_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! Conv_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - ReKiBuf(Re_Xferred) = InData%Rhoxg - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepWave2 - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDOmega - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDirMin - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDirMax - Re_Xferred = Re_Xferred + 1 - CALL SeaSt_Interp_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt_Interp_p, ErrStat2, ErrMsg2, OnlySize ) ! SeaSt_Interp_p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE WAMIT_PackInitInput - - SUBROUTINE WAMIT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(WAMIT_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%NBody = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NBodyMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmVol0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PtfmVol0)) DEALLOCATE(OutData%PtfmVol0) - ALLOCATE(OutData%PtfmVol0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmVol0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmVol0,1), UBOUND(OutData%PtfmVol0,1) - OutData%PtfmVol0(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%HasWAMIT = TRANSFER(IntKiBuf(Int_Xferred), OutData%HasWAMIT) - Int_Xferred = Int_Xferred + 1 - OutData%WAMITULEN = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmRefxt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PtfmRefxt)) DEALLOCATE(OutData%PtfmRefxt) - ALLOCATE(OutData%PtfmRefxt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefxt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmRefxt,1), UBOUND(OutData%PtfmRefxt,1) - OutData%PtfmRefxt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmRefyt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PtfmRefyt)) DEALLOCATE(OutData%PtfmRefyt) - ALLOCATE(OutData%PtfmRefyt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefyt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmRefyt,1), UBOUND(OutData%PtfmRefyt,1) - OutData%PtfmRefyt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmRefzt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PtfmRefzt)) DEALLOCATE(OutData%PtfmRefzt) - ALLOCATE(OutData%PtfmRefzt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefzt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmRefzt,1), UBOUND(OutData%PtfmRefzt,1) - OutData%PtfmRefzt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmRefztRot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PtfmRefztRot)) DEALLOCATE(OutData%PtfmRefztRot) - ALLOCATE(OutData%PtfmRefztRot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefztRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmRefztRot,1), UBOUND(OutData%PtfmRefztRot,1) - OutData%PtfmRefztRot(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmCOBxt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PtfmCOBxt)) DEALLOCATE(OutData%PtfmCOBxt) - ALLOCATE(OutData%PtfmCOBxt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmCOBxt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmCOBxt,1), UBOUND(OutData%PtfmCOBxt,1) - OutData%PtfmCOBxt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmCOByt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PtfmCOByt)) DEALLOCATE(OutData%PtfmCOByt) - ALLOCATE(OutData%PtfmCOByt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmCOByt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PtfmCOByt,1), UBOUND(OutData%PtfmCOByt,1) - OutData%PtfmCOByt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%RdtnMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ExctnMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ExctnDisp = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ExctnCutOff = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RdtnTMax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%WaveDir = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%WAMITFile) - OutData%WAMITFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Conv_Rdtn_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%Conv_Rdtn, ErrStat2, ErrMsg2 ) ! Conv_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%Rhoxg = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NStepWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NStepWave2 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WaveDOmega = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - NULLIFY(OutData%WaveElev0) - NULLIFY(OutData%WaveElev1) - NULLIFY(OutData%WaveElevC0) - NULLIFY(OutData%WaveElevC) - NULLIFY(OutData%WaveTime) - OutData%WaveMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WtrDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - NULLIFY(OutData%WaveDirArr) - OutData%WaveDirMin = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDirMax = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SeaSt_Interp_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%SeaSt_Interp_p, ErrStat2, ErrMsg2 ) ! SeaSt_Interp_p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE WAMIT_UnPackInitInput +subroutine WAMIT_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WAMIT_PackInitInput' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + ! NBody + call RegPack(Buf, InData%NBody) + if (RegCheckErr(Buf, RoutineName)) return + ! NBodyMod + call RegPack(Buf, InData%NBodyMod) + if (RegCheckErr(Buf, RoutineName)) return + ! Gravity + call RegPack(Buf, InData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDpth + call RegPack(Buf, InData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmVol0 + call RegPack(Buf, allocated(InData%PtfmVol0)) + if (allocated(InData%PtfmVol0)) then + call RegPackBounds(Buf, 1, lbound(InData%PtfmVol0), ubound(InData%PtfmVol0)) + call RegPack(Buf, InData%PtfmVol0) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! HasWAMIT + call RegPack(Buf, InData%HasWAMIT) + if (RegCheckErr(Buf, RoutineName)) return + ! WAMITULEN + call RegPack(Buf, InData%WAMITULEN) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmRefxt + call RegPack(Buf, allocated(InData%PtfmRefxt)) + if (allocated(InData%PtfmRefxt)) then + call RegPackBounds(Buf, 1, lbound(InData%PtfmRefxt), ubound(InData%PtfmRefxt)) + call RegPack(Buf, InData%PtfmRefxt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmRefyt + call RegPack(Buf, allocated(InData%PtfmRefyt)) + if (allocated(InData%PtfmRefyt)) then + call RegPackBounds(Buf, 1, lbound(InData%PtfmRefyt), ubound(InData%PtfmRefyt)) + call RegPack(Buf, InData%PtfmRefyt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmRefzt + call RegPack(Buf, allocated(InData%PtfmRefzt)) + if (allocated(InData%PtfmRefzt)) then + call RegPackBounds(Buf, 1, lbound(InData%PtfmRefzt), ubound(InData%PtfmRefzt)) + call RegPack(Buf, InData%PtfmRefzt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmRefztRot + call RegPack(Buf, allocated(InData%PtfmRefztRot)) + if (allocated(InData%PtfmRefztRot)) then + call RegPackBounds(Buf, 1, lbound(InData%PtfmRefztRot), ubound(InData%PtfmRefztRot)) + call RegPack(Buf, InData%PtfmRefztRot) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmCOBxt + call RegPack(Buf, allocated(InData%PtfmCOBxt)) + if (allocated(InData%PtfmCOBxt)) then + call RegPackBounds(Buf, 1, lbound(InData%PtfmCOBxt), ubound(InData%PtfmCOBxt)) + call RegPack(Buf, InData%PtfmCOBxt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmCOByt + call RegPack(Buf, allocated(InData%PtfmCOByt)) + if (allocated(InData%PtfmCOByt)) then + call RegPackBounds(Buf, 1, lbound(InData%PtfmCOByt), ubound(InData%PtfmCOByt)) + call RegPack(Buf, InData%PtfmCOByt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RdtnMod + call RegPack(Buf, InData%RdtnMod) + if (RegCheckErr(Buf, RoutineName)) return + ! ExctnMod + call RegPack(Buf, InData%ExctnMod) + if (RegCheckErr(Buf, RoutineName)) return + ! ExctnDisp + call RegPack(Buf, InData%ExctnDisp) + if (RegCheckErr(Buf, RoutineName)) return + ! ExctnCutOff + call RegPack(Buf, InData%ExctnCutOff) + if (RegCheckErr(Buf, RoutineName)) return + ! RdtnTMax + call RegPack(Buf, InData%RdtnTMax) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDir + call RegPack(Buf, InData%WaveDir) + if (RegCheckErr(Buf, RoutineName)) return + ! WAMITFile + call RegPack(Buf, InData%WAMITFile) + if (RegCheckErr(Buf, RoutineName)) return + ! Conv_Rdtn + call Conv_Rdtn_PackInitInput(Buf, InData%Conv_Rdtn) + if (RegCheckErr(Buf, RoutineName)) return + ! Rhoxg + call RegPack(Buf, InData%Rhoxg) + if (RegCheckErr(Buf, RoutineName)) return + ! NStepWave + call RegPack(Buf, InData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + ! NStepWave2 + call RegPack(Buf, InData%NStepWave2) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDOmega + call RegPack(Buf, InData%WaveDOmega) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElev0 + call RegPack(Buf, associated(InData%WaveElev0)) + if (associated(InData%WaveElev0)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveElev0), ubound(InData%WaveElev0)) + call RegPackPointer(Buf, c_loc(InData%WaveElev0), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveElev0) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElev1 + call RegPack(Buf, associated(InData%WaveElev1)) + if (associated(InData%WaveElev1)) then + call RegPackBounds(Buf, 3, lbound(InData%WaveElev1), ubound(InData%WaveElev1)) + call RegPackPointer(Buf, c_loc(InData%WaveElev1), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveElev1) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElevC0 + call RegPack(Buf, associated(InData%WaveElevC0)) + if (associated(InData%WaveElevC0)) then + call RegPackBounds(Buf, 2, lbound(InData%WaveElevC0), ubound(InData%WaveElevC0)) + call RegPackPointer(Buf, c_loc(InData%WaveElevC0), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveElevC0) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElevC + call RegPack(Buf, associated(InData%WaveElevC)) + if (associated(InData%WaveElevC)) then + call RegPackBounds(Buf, 3, lbound(InData%WaveElevC), ubound(InData%WaveElevC)) + call RegPackPointer(Buf, c_loc(InData%WaveElevC), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveElevC) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveTime + call RegPack(Buf, associated(InData%WaveTime)) + if (associated(InData%WaveTime)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) + call RegPackPointer(Buf, c_loc(InData%WaveTime), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveTime) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveMod + call RegPack(Buf, InData%WaveMod) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDens + call RegPack(Buf, InData%WtrDens) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDirArr + call RegPack(Buf, associated(InData%WaveDirArr)) + if (associated(InData%WaveDirArr)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveDirArr), ubound(InData%WaveDirArr)) + call RegPackPointer(Buf, c_loc(InData%WaveDirArr), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveDirArr) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDirMin + call RegPack(Buf, InData%WaveDirMin) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDirMax + call RegPack(Buf, InData%WaveDirMax) + if (RegCheckErr(Buf, RoutineName)) return + ! SeaSt_Interp_p + call SeaSt_Interp_PackParam(Buf, InData%SeaSt_Interp_p) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WAMIT_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WAMIT_UnPackInitInput' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + ! NBody + call RegUnpack(Buf, OutData%NBody) + if (RegCheckErr(Buf, RoutineName)) return + ! NBodyMod + call RegUnpack(Buf, OutData%NBodyMod) + if (RegCheckErr(Buf, RoutineName)) return + ! Gravity + call RegUnpack(Buf, OutData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDpth + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmVol0 + if (allocated(OutData%PtfmVol0)) deallocate(OutData%PtfmVol0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PtfmVol0(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmVol0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PtfmVol0) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! HasWAMIT + call RegUnpack(Buf, OutData%HasWAMIT) + if (RegCheckErr(Buf, RoutineName)) return + ! WAMITULEN + call RegUnpack(Buf, OutData%WAMITULEN) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmRefxt + if (allocated(OutData%PtfmRefxt)) deallocate(OutData%PtfmRefxt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PtfmRefxt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefxt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PtfmRefxt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PtfmRefyt + if (allocated(OutData%PtfmRefyt)) deallocate(OutData%PtfmRefyt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PtfmRefyt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefyt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PtfmRefyt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PtfmRefzt + if (allocated(OutData%PtfmRefzt)) deallocate(OutData%PtfmRefzt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PtfmRefzt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefzt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PtfmRefzt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PtfmRefztRot + if (allocated(OutData%PtfmRefztRot)) deallocate(OutData%PtfmRefztRot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PtfmRefztRot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmRefztRot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PtfmRefztRot) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PtfmCOBxt + if (allocated(OutData%PtfmCOBxt)) deallocate(OutData%PtfmCOBxt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PtfmCOBxt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmCOBxt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PtfmCOBxt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PtfmCOByt + if (allocated(OutData%PtfmCOByt)) deallocate(OutData%PtfmCOByt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PtfmCOByt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmCOByt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PtfmCOByt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RdtnMod + call RegUnpack(Buf, OutData%RdtnMod) + if (RegCheckErr(Buf, RoutineName)) return + ! ExctnMod + call RegUnpack(Buf, OutData%ExctnMod) + if (RegCheckErr(Buf, RoutineName)) return + ! ExctnDisp + call RegUnpack(Buf, OutData%ExctnDisp) + if (RegCheckErr(Buf, RoutineName)) return + ! ExctnCutOff + call RegUnpack(Buf, OutData%ExctnCutOff) + if (RegCheckErr(Buf, RoutineName)) return + ! RdtnTMax + call RegUnpack(Buf, OutData%RdtnTMax) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDir + call RegUnpack(Buf, OutData%WaveDir) + if (RegCheckErr(Buf, RoutineName)) return + ! WAMITFile + call RegUnpack(Buf, OutData%WAMITFile) + if (RegCheckErr(Buf, RoutineName)) return + ! Conv_Rdtn + call Conv_Rdtn_UnpackInitInput(Buf, OutData%Conv_Rdtn) ! Conv_Rdtn + ! Rhoxg + call RegUnpack(Buf, OutData%Rhoxg) + if (RegCheckErr(Buf, RoutineName)) return + ! NStepWave + call RegUnpack(Buf, OutData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + ! NStepWave2 + call RegUnpack(Buf, OutData%NStepWave2) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDOmega + call RegUnpack(Buf, OutData%WaveDOmega) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElev0 + if (associated(OutData%WaveElev0)) deallocate(OutData%WaveElev0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveElev0, UB(1:1)-LB(1:1)) + OutData%WaveElev0(LB(1):) => OutData%WaveElev0 + else + allocate(OutData%WaveElev0(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElev0) + call RegUnpack(Buf, OutData%WaveElev0) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveElev0 => null() + end if + ! WaveElev1 + if (associated(OutData%WaveElev1)) deallocate(OutData%WaveElev1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveElev1, UB(1:3)-LB(1:3)) + OutData%WaveElev1(LB(1):,LB(2):,LB(3):) => OutData%WaveElev1 + else + allocate(OutData%WaveElev1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElev1) + call RegUnpack(Buf, OutData%WaveElev1) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveElev1 => null() + end if + ! WaveElevC0 + if (associated(OutData%WaveElevC0)) deallocate(OutData%WaveElevC0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveElevC0, UB(1:2)-LB(1:2)) + OutData%WaveElevC0(LB(1):,LB(2):) => OutData%WaveElevC0 + else + allocate(OutData%WaveElevC0(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElevC0) + call RegUnpack(Buf, OutData%WaveElevC0) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveElevC0 => null() + end if + ! WaveElevC + if (associated(OutData%WaveElevC)) deallocate(OutData%WaveElevC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveElevC, UB(1:3)-LB(1:3)) + OutData%WaveElevC(LB(1):,LB(2):,LB(3):) => OutData%WaveElevC + else + allocate(OutData%WaveElevC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElevC) + call RegUnpack(Buf, OutData%WaveElevC) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveElevC => null() + end if + ! WaveTime + if (associated(OutData%WaveTime)) deallocate(OutData%WaveTime) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveTime, UB(1:1)-LB(1:1)) + OutData%WaveTime(LB(1):) => OutData%WaveTime + else + allocate(OutData%WaveTime(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveTime) + call RegUnpack(Buf, OutData%WaveTime) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveTime => null() + end if + ! WaveMod + call RegUnpack(Buf, OutData%WaveMod) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDens + call RegUnpack(Buf, OutData%WtrDens) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDirArr + if (associated(OutData%WaveDirArr)) deallocate(OutData%WaveDirArr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveDirArr, UB(1:1)-LB(1:1)) + OutData%WaveDirArr(LB(1):) => OutData%WaveDirArr + else + allocate(OutData%WaveDirArr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveDirArr) + call RegUnpack(Buf, OutData%WaveDirArr) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveDirArr => null() + end if + ! WaveDirMin + call RegUnpack(Buf, OutData%WaveDirMin) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDirMax + call RegUnpack(Buf, OutData%WaveDirMax) + if (RegCheckErr(Buf, RoutineName)) return + ! SeaSt_Interp_p + call SeaSt_Interp_UnpackParam(Buf, OutData%SeaSt_Interp_p) ! SeaSt_Interp_p +end subroutine SUBROUTINE WAMIT_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(WAMIT_ContinuousStateType), INTENT(IN) :: SrcContStateData TYPE(WAMIT_ContinuousStateType), INTENT(INOUT) :: DstContStateData @@ -1032,354 +905,35 @@ SUBROUTINE WAMIT_DestroyContState( ContStateData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE WAMIT_DestroyContState - SUBROUTINE WAMIT_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(WAMIT_ContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_PackContState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! SS_Rdtn: size of buffers for each call to pack subtype - CALL SS_Rad_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Rdtn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Rdtn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Rdtn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SS_Exctn: size of buffers for each call to pack subtype - CALL SS_Exc_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Exctn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Exctn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Exctn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Exctn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Conv_Rdtn: size of buffers for each call to pack subtype - CALL Conv_Rdtn_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, .TRUE. ) ! Conv_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Conv_Rdtn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Conv_Rdtn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Conv_Rdtn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL SS_Rad_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! SS_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SS_Exc_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, OnlySize ) ! SS_Exctn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL Conv_Rdtn_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! Conv_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE WAMIT_PackContState - - SUBROUTINE WAMIT_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(WAMIT_ContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_UnPackContState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SS_Rad_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Rdtn, ErrStat2, ErrMsg2 ) ! SS_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SS_Exc_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Exctn, ErrStat2, ErrMsg2 ) ! SS_Exctn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Conv_Rdtn_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%Conv_Rdtn, ErrStat2, ErrMsg2 ) ! Conv_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE WAMIT_UnPackContState +subroutine WAMIT_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WAMIT_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + ! SS_Rdtn + call SS_Rad_PackContState(Buf, InData%SS_Rdtn) + if (RegCheckErr(Buf, RoutineName)) return + ! SS_Exctn + call SS_Exc_PackContState(Buf, InData%SS_Exctn) + if (RegCheckErr(Buf, RoutineName)) return + ! Conv_Rdtn + call Conv_Rdtn_PackContState(Buf, InData%Conv_Rdtn) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WAMIT_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WAMIT_UnPackContState' + if (Buf%ErrStat /= ErrID_None) return + ! SS_Rdtn + call SS_Rad_UnpackContState(Buf, OutData%SS_Rdtn) ! SS_Rdtn + ! SS_Exctn + call SS_Exc_UnpackContState(Buf, OutData%SS_Exctn) ! SS_Exctn + ! Conv_Rdtn + call Conv_Rdtn_UnpackContState(Buf, OutData%Conv_Rdtn) ! Conv_Rdtn +end subroutine SUBROUTINE WAMIT_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(WAMIT_DiscreteStateType), INTENT(IN) :: SrcDiscStateData TYPE(WAMIT_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData @@ -1448,415 +1002,60 @@ SUBROUTINE WAMIT_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE WAMIT_DestroyDiscState - SUBROUTINE WAMIT_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(WAMIT_DiscreteStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_PackDiscState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Conv_Rdtn: size of buffers for each call to pack subtype - CALL Conv_Rdtn_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, .TRUE. ) ! Conv_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Conv_Rdtn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Conv_Rdtn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Conv_Rdtn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SS_Rdtn: size of buffers for each call to pack subtype - CALL SS_Rad_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Rdtn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Rdtn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Rdtn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SS_Exctn: size of buffers for each call to pack subtype - CALL SS_Exc_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Exctn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Exctn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Exctn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Exctn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! BdyPosFilt allocated yes/no - IF ( ALLOCATED(InData%BdyPosFilt) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! BdyPosFilt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BdyPosFilt) ! BdyPosFilt - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL Conv_Rdtn_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! Conv_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SS_Rad_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! SS_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SS_Exc_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, OnlySize ) ! SS_Exctn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%BdyPosFilt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BdyPosFilt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BdyPosFilt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BdyPosFilt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BdyPosFilt,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BdyPosFilt,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BdyPosFilt,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%BdyPosFilt,3), UBOUND(InData%BdyPosFilt,3) - DO i2 = LBOUND(InData%BdyPosFilt,2), UBOUND(InData%BdyPosFilt,2) - DO i1 = LBOUND(InData%BdyPosFilt,1), UBOUND(InData%BdyPosFilt,1) - ReKiBuf(Re_Xferred) = InData%BdyPosFilt(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE WAMIT_PackDiscState - - SUBROUTINE WAMIT_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(WAMIT_DiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (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 = 'WAMIT_UnPackDiscState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Conv_Rdtn_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%Conv_Rdtn, ErrStat2, ErrMsg2 ) ! Conv_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SS_Rad_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Rdtn, ErrStat2, ErrMsg2 ) ! SS_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SS_Exc_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Exctn, ErrStat2, ErrMsg2 ) ! SS_Exctn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BdyPosFilt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BdyPosFilt)) DEALLOCATE(OutData%BdyPosFilt) - ALLOCATE(OutData%BdyPosFilt(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BdyPosFilt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%BdyPosFilt,3), UBOUND(OutData%BdyPosFilt,3) - DO i2 = LBOUND(OutData%BdyPosFilt,2), UBOUND(OutData%BdyPosFilt,2) - DO i1 = LBOUND(OutData%BdyPosFilt,1), UBOUND(OutData%BdyPosFilt,1) - OutData%BdyPosFilt(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE WAMIT_UnPackDiscState +subroutine WAMIT_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WAMIT_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + ! Conv_Rdtn + call Conv_Rdtn_PackDiscState(Buf, InData%Conv_Rdtn) + if (RegCheckErr(Buf, RoutineName)) return + ! SS_Rdtn + call SS_Rad_PackDiscState(Buf, InData%SS_Rdtn) + if (RegCheckErr(Buf, RoutineName)) return + ! SS_Exctn + call SS_Exc_PackDiscState(Buf, InData%SS_Exctn) + if (RegCheckErr(Buf, RoutineName)) return + ! BdyPosFilt + call RegPack(Buf, allocated(InData%BdyPosFilt)) + if (allocated(InData%BdyPosFilt)) then + call RegPackBounds(Buf, 3, lbound(InData%BdyPosFilt), ubound(InData%BdyPosFilt)) + call RegPack(Buf, InData%BdyPosFilt) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WAMIT_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WAMIT_UnPackDiscState' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! Conv_Rdtn + call Conv_Rdtn_UnpackDiscState(Buf, OutData%Conv_Rdtn) ! Conv_Rdtn + ! SS_Rdtn + call SS_Rad_UnpackDiscState(Buf, OutData%SS_Rdtn) ! SS_Rdtn + ! SS_Exctn + call SS_Exc_UnpackDiscState(Buf, OutData%SS_Exctn) ! SS_Exctn + ! BdyPosFilt + if (allocated(OutData%BdyPosFilt)) deallocate(OutData%BdyPosFilt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BdyPosFilt(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BdyPosFilt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BdyPosFilt) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE WAMIT_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(WAMIT_ConstraintStateType), INTENT(IN) :: SrcConstrStateData TYPE(WAMIT_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData @@ -1903,354 +1102,35 @@ SUBROUTINE WAMIT_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE WAMIT_DestroyConstrState - SUBROUTINE WAMIT_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(WAMIT_ConstraintStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_PackConstrState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Conv_Rdtn: size of buffers for each call to pack subtype - CALL Conv_Rdtn_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, .TRUE. ) ! Conv_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Conv_Rdtn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Conv_Rdtn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Conv_Rdtn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SS_Rdtn: size of buffers for each call to pack subtype - CALL SS_Rad_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Rdtn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Rdtn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Rdtn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SS_Exctn: size of buffers for each call to pack subtype - CALL SS_Exc_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Exctn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Exctn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Exctn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Exctn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL Conv_Rdtn_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! Conv_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SS_Rad_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! SS_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SS_Exc_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, OnlySize ) ! SS_Exctn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE WAMIT_PackConstrState - - SUBROUTINE WAMIT_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(WAMIT_ConstraintStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_UnPackConstrState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Conv_Rdtn_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%Conv_Rdtn, ErrStat2, ErrMsg2 ) ! Conv_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SS_Rad_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Rdtn, ErrStat2, ErrMsg2 ) ! SS_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SS_Exc_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Exctn, ErrStat2, ErrMsg2 ) ! SS_Exctn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE WAMIT_UnPackConstrState +subroutine WAMIT_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WAMIT_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + ! Conv_Rdtn + call Conv_Rdtn_PackConstrState(Buf, InData%Conv_Rdtn) + if (RegCheckErr(Buf, RoutineName)) return + ! SS_Rdtn + call SS_Rad_PackConstrState(Buf, InData%SS_Rdtn) + if (RegCheckErr(Buf, RoutineName)) return + ! SS_Exctn + call SS_Exc_PackConstrState(Buf, InData%SS_Exctn) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WAMIT_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WAMIT_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + ! Conv_Rdtn + call Conv_Rdtn_UnpackConstrState(Buf, OutData%Conv_Rdtn) ! Conv_Rdtn + ! SS_Rdtn + call SS_Rad_UnpackConstrState(Buf, OutData%SS_Rdtn) ! SS_Rdtn + ! SS_Exctn + call SS_Exc_UnpackConstrState(Buf, OutData%SS_Exctn) ! SS_Exctn +end subroutine SUBROUTINE WAMIT_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(WAMIT_OtherStateType), INTENT(IN) :: SrcOtherStateData TYPE(WAMIT_OtherStateType), INTENT(INOUT) :: DstOtherStateData @@ -2297,354 +1177,35 @@ SUBROUTINE WAMIT_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE WAMIT_DestroyOtherState - SUBROUTINE WAMIT_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(WAMIT_OtherStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_PackOtherState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! SS_Rdtn: size of buffers for each call to pack subtype - CALL SS_Rad_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Rdtn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Rdtn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Rdtn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SS_Exctn: size of buffers for each call to pack subtype - CALL SS_Exc_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Exctn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Exctn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Exctn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Exctn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Conv_Rdtn: size of buffers for each call to pack subtype - CALL Conv_Rdtn_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, .TRUE. ) ! Conv_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Conv_Rdtn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Conv_Rdtn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Conv_Rdtn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL SS_Rad_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! SS_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SS_Exc_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, OnlySize ) ! SS_Exctn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL Conv_Rdtn_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! Conv_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE WAMIT_PackOtherState - - SUBROUTINE WAMIT_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(WAMIT_OtherStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_UnPackOtherState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SS_Rad_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Rdtn, ErrStat2, ErrMsg2 ) ! SS_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SS_Exc_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Exctn, ErrStat2, ErrMsg2 ) ! SS_Exctn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Conv_Rdtn_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%Conv_Rdtn, ErrStat2, ErrMsg2 ) ! Conv_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE WAMIT_UnPackOtherState +subroutine WAMIT_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WAMIT_PackOtherState' + if (Buf%ErrStat >= AbortErrLev) return + ! SS_Rdtn + call SS_Rad_PackOtherState(Buf, InData%SS_Rdtn) + if (RegCheckErr(Buf, RoutineName)) return + ! SS_Exctn + call SS_Exc_PackOtherState(Buf, InData%SS_Exctn) + if (RegCheckErr(Buf, RoutineName)) return + ! Conv_Rdtn + call Conv_Rdtn_PackOtherState(Buf, InData%Conv_Rdtn) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WAMIT_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WAMIT_UnPackOtherState' + if (Buf%ErrStat /= ErrID_None) return + ! SS_Rdtn + call SS_Rad_UnpackOtherState(Buf, OutData%SS_Rdtn) ! SS_Rdtn + ! SS_Exctn + call SS_Exc_UnpackOtherState(Buf, OutData%SS_Exctn) ! SS_Exctn + ! Conv_Rdtn + call Conv_Rdtn_UnpackOtherState(Buf, OutData%Conv_Rdtn) ! Conv_Rdtn +end subroutine SUBROUTINE WAMIT_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) TYPE(WAMIT_MiscVarType), INTENT(IN) :: SrcMiscData TYPE(WAMIT_MiscVarType), INTENT(INOUT) :: DstMiscData @@ -2788,1107 +1349,167 @@ SUBROUTINE WAMIT_DestroyMisc( MiscData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE WAMIT_DestroyMisc - SUBROUTINE WAMIT_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(WAMIT_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! LastIndWave - Int_BufSz = Int_BufSz + 1 ! F_HS allocated yes/no - IF ( ALLOCATED(InData%F_HS) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! F_HS upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_HS) ! F_HS - END IF - Int_BufSz = Int_BufSz + 1 ! F_Waves1 allocated yes/no - IF ( ALLOCATED(InData%F_Waves1) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! F_Waves1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_Waves1) ! F_Waves1 - END IF - Int_BufSz = Int_BufSz + 1 ! F_Rdtn allocated yes/no - IF ( ALLOCATED(InData%F_Rdtn) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! F_Rdtn upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_Rdtn) ! F_Rdtn - END IF - Int_BufSz = Int_BufSz + 1 ! F_PtfmAM allocated yes/no - IF ( ALLOCATED(InData%F_PtfmAM) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! F_PtfmAM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_PtfmAM) ! F_PtfmAM - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! SS_Rdtn: size of buffers for each call to pack subtype - CALL SS_Rad_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Rdtn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Rdtn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Rdtn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SS_Rdtn_u: size of buffers for each call to pack subtype - CALL SS_Rad_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn_u, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Rdtn_u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Rdtn_u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Rdtn_u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Rdtn_u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SS_Rdtn_y: size of buffers for each call to pack subtype - CALL SS_Rad_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn_y, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Rdtn_y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Rdtn_y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Rdtn_y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Rdtn_y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SS_Exctn: size of buffers for each call to pack subtype - CALL SS_Exc_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Exctn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Exctn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Exctn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Exctn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SS_Exctn_u: size of buffers for each call to pack subtype - CALL SS_Exc_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn_u, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Exctn_u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Exctn_u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Exctn_u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Exctn_u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SS_Exctn_y: size of buffers for each call to pack subtype - CALL SS_Exc_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn_y, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Exctn_y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Exctn_y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Exctn_y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Exctn_y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Conv_Rdtn: size of buffers for each call to pack subtype - CALL Conv_Rdtn_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, .TRUE. ) ! Conv_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Conv_Rdtn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Conv_Rdtn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Conv_Rdtn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Conv_Rdtn_u: size of buffers for each call to pack subtype - CALL Conv_Rdtn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn_u, ErrStat2, ErrMsg2, .TRUE. ) ! Conv_Rdtn_u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Conv_Rdtn_u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Conv_Rdtn_u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Conv_Rdtn_u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Conv_Rdtn_y: size of buffers for each call to pack subtype - CALL Conv_Rdtn_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn_y, ErrStat2, ErrMsg2, .TRUE. ) ! Conv_Rdtn_y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Conv_Rdtn_y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Conv_Rdtn_y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Conv_Rdtn_y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SeaSt_Interp_m: size of buffers for each call to pack subtype - CALL SeaSt_Interp_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt_Interp_m, ErrStat2, ErrMsg2, .TRUE. ) ! SeaSt_Interp_m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SeaSt_Interp_m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SeaSt_Interp_m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SeaSt_Interp_m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%LastIndWave - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%F_HS) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_HS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_HS,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%F_HS,1), UBOUND(InData%F_HS,1) - ReKiBuf(Re_Xferred) = InData%F_HS(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_Waves1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_Waves1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_Waves1,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%F_Waves1,1), UBOUND(InData%F_Waves1,1) - ReKiBuf(Re_Xferred) = InData%F_Waves1(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_Rdtn) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_Rdtn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_Rdtn,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%F_Rdtn,1), UBOUND(InData%F_Rdtn,1) - ReKiBuf(Re_Xferred) = InData%F_Rdtn(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_PtfmAM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_PtfmAM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_PtfmAM,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%F_PtfmAM,1), UBOUND(InData%F_PtfmAM,1) - ReKiBuf(Re_Xferred) = InData%F_PtfmAM(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - CALL SS_Rad_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! SS_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SS_Rad_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn_u, ErrStat2, ErrMsg2, OnlySize ) ! SS_Rdtn_u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SS_Rad_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn_y, ErrStat2, ErrMsg2, OnlySize ) ! SS_Rdtn_y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SS_Exc_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, OnlySize ) ! SS_Exctn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SS_Exc_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn_u, ErrStat2, ErrMsg2, OnlySize ) ! SS_Exctn_u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SS_Exc_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn_y, ErrStat2, ErrMsg2, OnlySize ) ! SS_Exctn_y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL Conv_Rdtn_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! Conv_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL Conv_Rdtn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn_u, ErrStat2, ErrMsg2, OnlySize ) ! Conv_Rdtn_u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL Conv_Rdtn_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn_y, ErrStat2, ErrMsg2, OnlySize ) ! Conv_Rdtn_y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SeaSt_Interp_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt_Interp_m, ErrStat2, ErrMsg2, OnlySize ) ! SeaSt_Interp_m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE WAMIT_PackMisc - - SUBROUTINE WAMIT_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(WAMIT_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%LastIndWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_HS not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_HS)) DEALLOCATE(OutData%F_HS) - ALLOCATE(OutData%F_HS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_HS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%F_HS,1), UBOUND(OutData%F_HS,1) - OutData%F_HS(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_Waves1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_Waves1)) DEALLOCATE(OutData%F_Waves1) - ALLOCATE(OutData%F_Waves1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_Waves1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%F_Waves1,1), UBOUND(OutData%F_Waves1,1) - OutData%F_Waves1(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_Rdtn not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_Rdtn)) DEALLOCATE(OutData%F_Rdtn) - ALLOCATE(OutData%F_Rdtn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_Rdtn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%F_Rdtn,1), UBOUND(OutData%F_Rdtn,1) - OutData%F_Rdtn(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_PtfmAM not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_PtfmAM)) DEALLOCATE(OutData%F_PtfmAM) - ALLOCATE(OutData%F_PtfmAM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_PtfmAM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%F_PtfmAM,1), UBOUND(OutData%F_PtfmAM,1) - OutData%F_PtfmAM(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SS_Rad_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Rdtn, ErrStat2, ErrMsg2 ) ! SS_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SS_Rad_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Rdtn_u, ErrStat2, ErrMsg2 ) ! SS_Rdtn_u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SS_Rad_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Rdtn_y, ErrStat2, ErrMsg2 ) ! SS_Rdtn_y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SS_Exc_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Exctn, ErrStat2, ErrMsg2 ) ! SS_Exctn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SS_Exc_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Exctn_u, ErrStat2, ErrMsg2 ) ! SS_Exctn_u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SS_Exc_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Exctn_y, ErrStat2, ErrMsg2 ) ! SS_Exctn_y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Conv_Rdtn_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%Conv_Rdtn, ErrStat2, ErrMsg2 ) ! Conv_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Conv_Rdtn_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Conv_Rdtn_u, ErrStat2, ErrMsg2 ) ! Conv_Rdtn_u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Conv_Rdtn_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Conv_Rdtn_y, ErrStat2, ErrMsg2 ) ! Conv_Rdtn_y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SeaSt_Interp_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%SeaSt_Interp_m, ErrStat2, ErrMsg2 ) ! SeaSt_Interp_m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE WAMIT_UnPackMisc +subroutine WAMIT_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WAMIT_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + ! LastIndWave + call RegPack(Buf, InData%LastIndWave) + if (RegCheckErr(Buf, RoutineName)) return + ! F_HS + call RegPack(Buf, allocated(InData%F_HS)) + if (allocated(InData%F_HS)) then + call RegPackBounds(Buf, 1, lbound(InData%F_HS), ubound(InData%F_HS)) + call RegPack(Buf, InData%F_HS) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! F_Waves1 + call RegPack(Buf, allocated(InData%F_Waves1)) + if (allocated(InData%F_Waves1)) then + call RegPackBounds(Buf, 1, lbound(InData%F_Waves1), ubound(InData%F_Waves1)) + call RegPack(Buf, InData%F_Waves1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! F_Rdtn + call RegPack(Buf, allocated(InData%F_Rdtn)) + if (allocated(InData%F_Rdtn)) then + call RegPackBounds(Buf, 1, lbound(InData%F_Rdtn), ubound(InData%F_Rdtn)) + call RegPack(Buf, InData%F_Rdtn) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! F_PtfmAM + call RegPack(Buf, allocated(InData%F_PtfmAM)) + if (allocated(InData%F_PtfmAM)) then + call RegPackBounds(Buf, 1, lbound(InData%F_PtfmAM), ubound(InData%F_PtfmAM)) + call RegPack(Buf, InData%F_PtfmAM) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SS_Rdtn + call SS_Rad_PackMisc(Buf, InData%SS_Rdtn) + if (RegCheckErr(Buf, RoutineName)) return + ! SS_Rdtn_u + call SS_Rad_PackInput(Buf, InData%SS_Rdtn_u) + if (RegCheckErr(Buf, RoutineName)) return + ! SS_Rdtn_y + call SS_Rad_PackOutput(Buf, InData%SS_Rdtn_y) + if (RegCheckErr(Buf, RoutineName)) return + ! SS_Exctn + call SS_Exc_PackMisc(Buf, InData%SS_Exctn) + if (RegCheckErr(Buf, RoutineName)) return + ! SS_Exctn_u + call SS_Exc_PackInput(Buf, InData%SS_Exctn_u) + if (RegCheckErr(Buf, RoutineName)) return + ! SS_Exctn_y + call SS_Exc_PackOutput(Buf, InData%SS_Exctn_y) + if (RegCheckErr(Buf, RoutineName)) return + ! Conv_Rdtn + call Conv_Rdtn_PackMisc(Buf, InData%Conv_Rdtn) + if (RegCheckErr(Buf, RoutineName)) return + ! Conv_Rdtn_u + call Conv_Rdtn_PackInput(Buf, InData%Conv_Rdtn_u) + if (RegCheckErr(Buf, RoutineName)) return + ! Conv_Rdtn_y + call Conv_Rdtn_PackOutput(Buf, InData%Conv_Rdtn_y) + if (RegCheckErr(Buf, RoutineName)) return + ! SeaSt_Interp_m + call SeaSt_Interp_PackMisc(Buf, InData%SeaSt_Interp_m) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WAMIT_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WAMIT_UnPackMisc' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! LastIndWave + call RegUnpack(Buf, OutData%LastIndWave) + if (RegCheckErr(Buf, RoutineName)) return + ! F_HS + if (allocated(OutData%F_HS)) deallocate(OutData%F_HS) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_HS(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_HS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_HS) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! F_Waves1 + if (allocated(OutData%F_Waves1)) deallocate(OutData%F_Waves1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_Waves1(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_Waves1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_Waves1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! F_Rdtn + if (allocated(OutData%F_Rdtn)) deallocate(OutData%F_Rdtn) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_Rdtn(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_Rdtn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_Rdtn) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! F_PtfmAM + if (allocated(OutData%F_PtfmAM)) deallocate(OutData%F_PtfmAM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_PtfmAM(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_PtfmAM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_PtfmAM) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! SS_Rdtn + call SS_Rad_UnpackMisc(Buf, OutData%SS_Rdtn) ! SS_Rdtn + ! SS_Rdtn_u + call SS_Rad_UnpackInput(Buf, OutData%SS_Rdtn_u) ! SS_Rdtn_u + ! SS_Rdtn_y + call SS_Rad_UnpackOutput(Buf, OutData%SS_Rdtn_y) ! SS_Rdtn_y + ! SS_Exctn + call SS_Exc_UnpackMisc(Buf, OutData%SS_Exctn) ! SS_Exctn + ! SS_Exctn_u + call SS_Exc_UnpackInput(Buf, OutData%SS_Exctn_u) ! SS_Exctn_u + ! SS_Exctn_y + call SS_Exc_UnpackOutput(Buf, OutData%SS_Exctn_y) ! SS_Exctn_y + ! Conv_Rdtn + call Conv_Rdtn_UnpackMisc(Buf, OutData%Conv_Rdtn) ! Conv_Rdtn + ! Conv_Rdtn_u + call Conv_Rdtn_UnpackInput(Buf, OutData%Conv_Rdtn_u) ! Conv_Rdtn_u + ! Conv_Rdtn_y + call Conv_Rdtn_UnpackOutput(Buf, OutData%Conv_Rdtn_y) ! Conv_Rdtn_y + ! SeaSt_Interp_m + call SeaSt_Interp_UnpackMisc(Buf, OutData%SeaSt_Interp_m) ! SeaSt_Interp_m +end subroutine SUBROUTINE WAMIT_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(WAMIT_ParameterType), INTENT(IN) :: SrcParamData TYPE(WAMIT_ParameterType), INTENT(INOUT) :: DstParamData @@ -4042,748 +1663,207 @@ SUBROUTINE WAMIT_DestroyParam( ParamData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE WAMIT_DestroyParam - SUBROUTINE WAMIT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(WAMIT_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! NBody - Int_BufSz = Int_BufSz + 1 ! NBodyMod - Int_BufSz = Int_BufSz + 1 ! F_HS_Moment_Offset allocated yes/no - IF ( ALLOCATED(InData%F_HS_Moment_Offset) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_HS_Moment_Offset upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_HS_Moment_Offset) ! F_HS_Moment_Offset - END IF - Int_BufSz = Int_BufSz + 1 ! HdroAdMsI allocated yes/no - IF ( ALLOCATED(InData%HdroAdMsI) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! HdroAdMsI upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%HdroAdMsI) ! HdroAdMsI - END IF - Int_BufSz = Int_BufSz + 1 ! HdroSttc allocated yes/no - IF ( ALLOCATED(InData%HdroSttc) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! HdroSttc upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%HdroSttc) ! HdroSttc - END IF - Int_BufSz = Int_BufSz + 1 ! RdtnMod - Int_BufSz = Int_BufSz + 1 ! ExctnMod - Int_BufSz = Int_BufSz + 1 ! ExctnDisp - Re_BufSz = Re_BufSz + 1 ! ExctnCutOff - Re_BufSz = Re_BufSz + 1 ! ExctnFiltConst - Int_BufSz = Int_BufSz + 1 ! WaveExctn allocated yes/no - IF ( ALLOCATED(InData%WaveExctn) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveExctn upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveExctn) ! WaveExctn - END IF - Int_BufSz = Int_BufSz + 1 ! WaveExctnGrid allocated yes/no - IF ( ALLOCATED(InData%WaveExctnGrid) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! WaveExctnGrid upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveExctnGrid) ! WaveExctnGrid - END IF - Int_BufSz = Int_BufSz + 1 ! NStepWave - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Conv_Rdtn: size of buffers for each call to pack subtype - CALL Conv_Rdtn_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, .TRUE. ) ! Conv_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Conv_Rdtn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Conv_Rdtn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Conv_Rdtn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SS_Rdtn: size of buffers for each call to pack subtype - CALL SS_Rad_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Rdtn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Rdtn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Rdtn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SS_Exctn: size of buffers for each call to pack subtype - CALL SS_Exc_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, .TRUE. ) ! SS_Exctn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SS_Exctn - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SS_Exctn - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SS_Exctn - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Db_BufSz = Db_BufSz + 1 ! DT - Int_BufSz = Int_BufSz + 3 ! SeaSt_Interp_p: size of buffers for each call to pack subtype - CALL SeaSt_Interp_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt_Interp_p, ErrStat2, ErrMsg2, .TRUE. ) ! SeaSt_Interp_p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SeaSt_Interp_p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SeaSt_Interp_p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SeaSt_Interp_p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%NBody - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NBodyMod - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%F_HS_Moment_Offset) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_HS_Moment_Offset,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_HS_Moment_Offset,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_HS_Moment_Offset,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_HS_Moment_Offset,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_HS_Moment_Offset,2), UBOUND(InData%F_HS_Moment_Offset,2) - DO i1 = LBOUND(InData%F_HS_Moment_Offset,1), UBOUND(InData%F_HS_Moment_Offset,1) - ReKiBuf(Re_Xferred) = InData%F_HS_Moment_Offset(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%HdroAdMsI) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%HdroAdMsI,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HdroAdMsI,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%HdroAdMsI,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HdroAdMsI,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%HdroAdMsI,2), UBOUND(InData%HdroAdMsI,2) - DO i1 = LBOUND(InData%HdroAdMsI,1), UBOUND(InData%HdroAdMsI,1) - ReKiBuf(Re_Xferred) = InData%HdroAdMsI(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%HdroSttc) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%HdroSttc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HdroSttc,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%HdroSttc,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HdroSttc,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%HdroSttc,2), UBOUND(InData%HdroSttc,2) - DO i1 = LBOUND(InData%HdroSttc,1), UBOUND(InData%HdroSttc,1) - ReKiBuf(Re_Xferred) = InData%HdroSttc(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%RdtnMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ExctnMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ExctnDisp - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ExctnCutOff - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ExctnFiltConst - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveExctn) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveExctn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveExctn,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveExctn,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveExctn,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveExctn,2), UBOUND(InData%WaveExctn,2) - DO i1 = LBOUND(InData%WaveExctn,1), UBOUND(InData%WaveExctn,1) - ReKiBuf(Re_Xferred) = InData%WaveExctn(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveExctnGrid) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveExctnGrid,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveExctnGrid,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveExctnGrid,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveExctnGrid,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveExctnGrid,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveExctnGrid,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveExctnGrid,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveExctnGrid,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%WaveExctnGrid,4), UBOUND(InData%WaveExctnGrid,4) - DO i3 = LBOUND(InData%WaveExctnGrid,3), UBOUND(InData%WaveExctnGrid,3) - DO i2 = LBOUND(InData%WaveExctnGrid,2), UBOUND(InData%WaveExctnGrid,2) - DO i1 = LBOUND(InData%WaveExctnGrid,1), UBOUND(InData%WaveExctnGrid,1) - ReKiBuf(Re_Xferred) = InData%WaveExctnGrid(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - CALL Conv_Rdtn_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! Conv_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SS_Rad_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! SS_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SS_Exc_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SS_Exctn, ErrStat2, ErrMsg2, OnlySize ) ! SS_Exctn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - CALL SeaSt_Interp_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt_Interp_p, ErrStat2, ErrMsg2, OnlySize ) ! SeaSt_Interp_p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE WAMIT_PackParam - - SUBROUTINE WAMIT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(WAMIT_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%NBody = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NBodyMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_HS_Moment_Offset not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_HS_Moment_Offset)) DEALLOCATE(OutData%F_HS_Moment_Offset) - ALLOCATE(OutData%F_HS_Moment_Offset(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_HS_Moment_Offset.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_HS_Moment_Offset,2), UBOUND(OutData%F_HS_Moment_Offset,2) - DO i1 = LBOUND(OutData%F_HS_Moment_Offset,1), UBOUND(OutData%F_HS_Moment_Offset,1) - OutData%F_HS_Moment_Offset(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HdroAdMsI not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%HdroAdMsI)) DEALLOCATE(OutData%HdroAdMsI) - ALLOCATE(OutData%HdroAdMsI(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HdroAdMsI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%HdroAdMsI,2), UBOUND(OutData%HdroAdMsI,2) - DO i1 = LBOUND(OutData%HdroAdMsI,1), UBOUND(OutData%HdroAdMsI,1) - OutData%HdroAdMsI(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HdroSttc not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%HdroSttc)) DEALLOCATE(OutData%HdroSttc) - ALLOCATE(OutData%HdroSttc(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HdroSttc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%HdroSttc,2), UBOUND(OutData%HdroSttc,2) - DO i1 = LBOUND(OutData%HdroSttc,1), UBOUND(OutData%HdroSttc,1) - OutData%HdroSttc(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%RdtnMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ExctnMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ExctnDisp = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ExctnCutOff = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ExctnFiltConst = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveExctn not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveExctn)) DEALLOCATE(OutData%WaveExctn) - ALLOCATE(OutData%WaveExctn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveExctn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveExctn,2), UBOUND(OutData%WaveExctn,2) - DO i1 = LBOUND(OutData%WaveExctn,1), UBOUND(OutData%WaveExctn,1) - OutData%WaveExctn(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveExctnGrid not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveExctnGrid)) DEALLOCATE(OutData%WaveExctnGrid) - ALLOCATE(OutData%WaveExctnGrid(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveExctnGrid.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%WaveExctnGrid,4), UBOUND(OutData%WaveExctnGrid,4) - DO i3 = LBOUND(OutData%WaveExctnGrid,3), UBOUND(OutData%WaveExctnGrid,3) - DO i2 = LBOUND(OutData%WaveExctnGrid,2), UBOUND(OutData%WaveExctnGrid,2) - DO i1 = LBOUND(OutData%WaveExctnGrid,1), UBOUND(OutData%WaveExctnGrid,1) - OutData%WaveExctnGrid(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - OutData%NStepWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Conv_Rdtn_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%Conv_Rdtn, ErrStat2, ErrMsg2 ) ! Conv_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SS_Rad_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Rdtn, ErrStat2, ErrMsg2 ) ! SS_Rdtn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SS_Exc_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%SS_Exctn, ErrStat2, ErrMsg2 ) ! SS_Exctn - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SeaSt_Interp_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%SeaSt_Interp_p, ErrStat2, ErrMsg2 ) ! SeaSt_Interp_p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE WAMIT_UnPackParam +subroutine WAMIT_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WAMIT_PackParam' + if (Buf%ErrStat >= AbortErrLev) return + ! NBody + call RegPack(Buf, InData%NBody) + if (RegCheckErr(Buf, RoutineName)) return + ! NBodyMod + call RegPack(Buf, InData%NBodyMod) + if (RegCheckErr(Buf, RoutineName)) return + ! F_HS_Moment_Offset + call RegPack(Buf, allocated(InData%F_HS_Moment_Offset)) + if (allocated(InData%F_HS_Moment_Offset)) then + call RegPackBounds(Buf, 2, lbound(InData%F_HS_Moment_Offset), ubound(InData%F_HS_Moment_Offset)) + call RegPack(Buf, InData%F_HS_Moment_Offset) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! HdroAdMsI + call RegPack(Buf, allocated(InData%HdroAdMsI)) + if (allocated(InData%HdroAdMsI)) then + call RegPackBounds(Buf, 2, lbound(InData%HdroAdMsI), ubound(InData%HdroAdMsI)) + call RegPack(Buf, InData%HdroAdMsI) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! HdroSttc + call RegPack(Buf, allocated(InData%HdroSttc)) + if (allocated(InData%HdroSttc)) then + call RegPackBounds(Buf, 2, lbound(InData%HdroSttc), ubound(InData%HdroSttc)) + call RegPack(Buf, InData%HdroSttc) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RdtnMod + call RegPack(Buf, InData%RdtnMod) + if (RegCheckErr(Buf, RoutineName)) return + ! ExctnMod + call RegPack(Buf, InData%ExctnMod) + if (RegCheckErr(Buf, RoutineName)) return + ! ExctnDisp + call RegPack(Buf, InData%ExctnDisp) + if (RegCheckErr(Buf, RoutineName)) return + ! ExctnCutOff + call RegPack(Buf, InData%ExctnCutOff) + if (RegCheckErr(Buf, RoutineName)) return + ! ExctnFiltConst + call RegPack(Buf, InData%ExctnFiltConst) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveExctn + call RegPack(Buf, allocated(InData%WaveExctn)) + if (allocated(InData%WaveExctn)) then + call RegPackBounds(Buf, 2, lbound(InData%WaveExctn), ubound(InData%WaveExctn)) + call RegPack(Buf, InData%WaveExctn) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveExctnGrid + call RegPack(Buf, allocated(InData%WaveExctnGrid)) + if (allocated(InData%WaveExctnGrid)) then + call RegPackBounds(Buf, 4, lbound(InData%WaveExctnGrid), ubound(InData%WaveExctnGrid)) + call RegPack(Buf, InData%WaveExctnGrid) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NStepWave + call RegPack(Buf, InData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + ! Conv_Rdtn + call Conv_Rdtn_PackParam(Buf, InData%Conv_Rdtn) + if (RegCheckErr(Buf, RoutineName)) return + ! SS_Rdtn + call SS_Rad_PackParam(Buf, InData%SS_Rdtn) + if (RegCheckErr(Buf, RoutineName)) return + ! SS_Exctn + call SS_Exc_PackParam(Buf, InData%SS_Exctn) + if (RegCheckErr(Buf, RoutineName)) return + ! DT + call RegPack(Buf, InData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! SeaSt_Interp_p + call SeaSt_Interp_PackParam(Buf, InData%SeaSt_Interp_p) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WAMIT_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WAMIT_UnPackParam' + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! NBody + call RegUnpack(Buf, OutData%NBody) + if (RegCheckErr(Buf, RoutineName)) return + ! NBodyMod + call RegUnpack(Buf, OutData%NBodyMod) + if (RegCheckErr(Buf, RoutineName)) return + ! F_HS_Moment_Offset + if (allocated(OutData%F_HS_Moment_Offset)) deallocate(OutData%F_HS_Moment_Offset) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_HS_Moment_Offset(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_HS_Moment_Offset.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_HS_Moment_Offset) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! HdroAdMsI + if (allocated(OutData%HdroAdMsI)) deallocate(OutData%HdroAdMsI) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%HdroAdMsI(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%HdroAdMsI.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%HdroAdMsI) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! HdroSttc + if (allocated(OutData%HdroSttc)) deallocate(OutData%HdroSttc) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%HdroSttc(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%HdroSttc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%HdroSttc) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RdtnMod + call RegUnpack(Buf, OutData%RdtnMod) + if (RegCheckErr(Buf, RoutineName)) return + ! ExctnMod + call RegUnpack(Buf, OutData%ExctnMod) + if (RegCheckErr(Buf, RoutineName)) return + ! ExctnDisp + call RegUnpack(Buf, OutData%ExctnDisp) + if (RegCheckErr(Buf, RoutineName)) return + ! ExctnCutOff + call RegUnpack(Buf, OutData%ExctnCutOff) + if (RegCheckErr(Buf, RoutineName)) return + ! ExctnFiltConst + call RegUnpack(Buf, OutData%ExctnFiltConst) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveExctn + if (allocated(OutData%WaveExctn)) deallocate(OutData%WaveExctn) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveExctn(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveExctn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveExctn) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WaveExctnGrid + if (allocated(OutData%WaveExctnGrid)) deallocate(OutData%WaveExctnGrid) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveExctnGrid(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveExctnGrid.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveExctnGrid) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NStepWave + call RegUnpack(Buf, OutData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + ! Conv_Rdtn + call Conv_Rdtn_UnpackParam(Buf, OutData%Conv_Rdtn) ! Conv_Rdtn + ! SS_Rdtn + call SS_Rad_UnpackParam(Buf, OutData%SS_Rdtn) ! SS_Rdtn + ! SS_Exctn + call SS_Exc_UnpackParam(Buf, OutData%SS_Exctn) ! SS_Exctn + ! DT + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! SeaSt_Interp_p + call SeaSt_Interp_UnpackParam(Buf, OutData%SeaSt_Interp_p) ! SeaSt_Interp_p +end subroutine SUBROUTINE WAMIT_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(WAMIT_InputType), INTENT(INOUT) :: SrcInputData TYPE(WAMIT_InputType), INTENT(INOUT) :: DstInputData @@ -4820,184 +1900,25 @@ SUBROUTINE WAMIT_DestroyInput( InputData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE WAMIT_DestroyInput - SUBROUTINE WAMIT_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(WAMIT_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Mesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Mesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Mesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL MeshPack( InData%Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE WAMIT_PackInput - - SUBROUTINE WAMIT_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(WAMIT_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE WAMIT_UnPackInput +subroutine WAMIT_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WAMIT_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + ! Mesh + call MeshPack(Buf, InData%Mesh) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WAMIT_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WAMIT_UnPackInput' + if (Buf%ErrStat /= ErrID_None) return + ! Mesh + call MeshUnpack(Buf, OutData%Mesh) ! Mesh +end subroutine SUBROUTINE WAMIT_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(WAMIT_OutputType), INTENT(INOUT) :: SrcOutputData TYPE(WAMIT_OutputType), INTENT(INOUT) :: DstOutputData @@ -5034,184 +1955,25 @@ SUBROUTINE WAMIT_DestroyOutput( OutputData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE WAMIT_DestroyOutput - SUBROUTINE WAMIT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(WAMIT_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Mesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Mesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Mesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL MeshPack( InData%Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE WAMIT_PackOutput - - SUBROUTINE WAMIT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(WAMIT_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE WAMIT_UnPackOutput +subroutine WAMIT_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WAMIT_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! Mesh + call MeshPack(Buf, InData%Mesh) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WAMIT_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WAMIT_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WAMIT_UnPackOutput' + if (Buf%ErrStat /= ErrID_None) return + ! Mesh + call MeshUnpack(Buf, OutData%Mesh) ! Mesh +end subroutine SUBROUTINE WAMIT_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) ! diff --git a/modules/icedyn/src/IceDyn_Types.f90 b/modules/icedyn/src/IceDyn_Types.f90 index 52db504a7e..f1d46cef8e 100644 --- a/modules/icedyn/src/IceDyn_Types.f90 +++ b/modules/icedyn/src/IceDyn_Types.f90 @@ -359,498 +359,431 @@ SUBROUTINE IceD_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE IceD_DestroyInputFile - SUBROUTINE IceD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(IceD_InputFile), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_PackInputFile' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! IceModel - Int_BufSz = Int_BufSz + 1 ! IceSubModel - Re_BufSz = Re_BufSz + 1 ! h - Re_BufSz = Re_BufSz + 1 ! v - Re_BufSz = Re_BufSz + 1 ! InitLoc - Re_BufSz = Re_BufSz + 1 ! t0 - Re_BufSz = Re_BufSz + 1 ! rhow - Re_BufSz = Re_BufSz + 1 ! rhoi - Int_BufSz = Int_BufSz + 1 ! Seed1 - Int_BufSz = Int_BufSz + 1 ! Seed2 - Int_BufSz = Int_BufSz + 1 ! NumLegs - Int_BufSz = Int_BufSz + 1 ! LegPosX allocated yes/no - IF ( ALLOCATED(InData%LegPosX) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LegPosX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LegPosX) ! LegPosX - END IF - Int_BufSz = Int_BufSz + 1 ! LegPosY allocated yes/no - IF ( ALLOCATED(InData%LegPosY) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LegPosY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LegPosY) ! LegPosY - END IF - Int_BufSz = Int_BufSz + 1 ! StrWd allocated yes/no - IF ( ALLOCATED(InData%StrWd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! StrWd upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StrWd) ! StrWd - END IF - Re_BufSz = Re_BufSz + 1 ! Ikm - Re_BufSz = Re_BufSz + 1 ! Ag - Re_BufSz = Re_BufSz + 1 ! Qg - Re_BufSz = Re_BufSz + 1 ! Rg - Re_BufSz = Re_BufSz + 1 ! Tice - Re_BufSz = Re_BufSz + 1 ! nu - Re_BufSz = Re_BufSz + 1 ! phi - Re_BufSz = Re_BufSz + 1 ! SigNm - Re_BufSz = Re_BufSz + 1 ! Eice - Re_BufSz = Re_BufSz + 1 ! IceStr2 - Re_BufSz = Re_BufSz + 1 ! Delmax2 - Re_BufSz = Re_BufSz + 1 ! Pitch - Re_BufSz = Re_BufSz + 1 ! miuh - Re_BufSz = Re_BufSz + 1 ! varh - Re_BufSz = Re_BufSz + 1 ! miuv - Re_BufSz = Re_BufSz + 1 ! varv - Re_BufSz = Re_BufSz + 1 ! miut - Re_BufSz = Re_BufSz + 1 ! miubr - Re_BufSz = Re_BufSz + 1 ! varbr - Re_BufSz = Re_BufSz + 1 ! miuDelm - Re_BufSz = Re_BufSz + 1 ! varDelm - Re_BufSz = Re_BufSz + 1 ! miuP - Re_BufSz = Re_BufSz + 1 ! varP - Int_BufSz = Int_BufSz + 1 ! Zn1 - Int_BufSz = Int_BufSz + 1 ! Zn2 - Re_BufSz = Re_BufSz + 1 ! ZonePitch - Re_BufSz = Re_BufSz + 1 ! PrflMean - Re_BufSz = Re_BufSz + 1 ! PrflSig - Re_BufSz = Re_BufSz + 1 ! IceStr - Re_BufSz = Re_BufSz + 1 ! Delmax - Re_BufSz = Re_BufSz + 1 ! alpha - Re_BufSz = Re_BufSz + 1 ! Dwl - Re_BufSz = Re_BufSz + 1 ! Dtp - Re_BufSz = Re_BufSz + 1 ! hr - Re_BufSz = Re_BufSz + 1 ! mu - Re_BufSz = Re_BufSz + 1 ! sigf - Re_BufSz = Re_BufSz + 1 ! StrLim - Re_BufSz = Re_BufSz + 1 ! StrRtLim - Int_BufSz = Int_BufSz + 1 ! UorD - Re_BufSz = Re_BufSz + 1 ! Ll - Re_BufSz = Re_BufSz + 1 ! Lw - Re_BufSz = Re_BufSz + 1 ! Cpa - Re_BufSz = Re_BufSz + 1 ! dpa - Re_BufSz = Re_BufSz + 1 ! Fdr - Re_BufSz = Re_BufSz + 1 ! Kic - Re_BufSz = Re_BufSz + 1 ! FspN - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%IceModel - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%IceSubModel - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%h - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%v - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%InitLoc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%t0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rhow - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rhoi - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Seed1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Seed2 - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumLegs - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%LegPosX) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LegPosX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LegPosX,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LegPosX,1), UBOUND(InData%LegPosX,1) - ReKiBuf(Re_Xferred) = InData%LegPosX(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LegPosY) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LegPosY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LegPosY,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LegPosY,1), UBOUND(InData%LegPosY,1) - ReKiBuf(Re_Xferred) = InData%LegPosY(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StrWd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StrWd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StrWd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%StrWd,1), UBOUND(InData%StrWd,1) - ReKiBuf(Re_Xferred) = InData%StrWd(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%Ikm - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Ag - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Qg - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Rg - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Tice - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%nu - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%phi - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SigNm - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Eice - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%IceStr2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Delmax2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Pitch - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%miuh - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%varh - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%miuv - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%varv - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%miut - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%miubr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%varbr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%miuDelm - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%varDelm - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%miuP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%varP - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Zn1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Zn2 - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ZonePitch - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PrflMean - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PrflSig - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%IceStr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Delmax - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%alpha - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Dwl - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Dtp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%hr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%mu - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%sigf - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StrLim - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StrRtLim - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UorD - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Ll - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Lw - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cpa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dpa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Fdr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Kic - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FspN - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IceD_PackInputFile - - SUBROUTINE IceD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(IceD_InputFile), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_UnPackInputFile' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%IceModel = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%IceSubModel = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%h = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%v = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%InitLoc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%t0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rhow = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rhoi = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Seed1 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Seed2 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumLegs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LegPosX not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LegPosX)) DEALLOCATE(OutData%LegPosX) - ALLOCATE(OutData%LegPosX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LegPosX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LegPosX,1), UBOUND(OutData%LegPosX,1) - OutData%LegPosX(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LegPosY not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LegPosY)) DEALLOCATE(OutData%LegPosY) - ALLOCATE(OutData%LegPosY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LegPosY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LegPosY,1), UBOUND(OutData%LegPosY,1) - OutData%LegPosY(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StrWd not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%StrWd)) DEALLOCATE(OutData%StrWd) - ALLOCATE(OutData%StrWd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StrWd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%StrWd,1), UBOUND(OutData%StrWd,1) - OutData%StrWd(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Ikm = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Ag = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Qg = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Rg = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Tice = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%nu = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%phi = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SigNm = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Eice = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%IceStr2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Delmax2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Pitch = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%miuh = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%varh = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%miuv = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%varv = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%miut = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%miubr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%varbr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%miuDelm = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%varDelm = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%miuP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%varP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Zn1 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Zn2 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ZonePitch = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PrflMean = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PrflSig = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%IceStr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Delmax = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%alpha = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Dwl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Dtp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%hr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%mu = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%sigf = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StrLim = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StrRtLim = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%UorD = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Ll = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Lw = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cpa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dpa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Fdr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Kic = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%FspN = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IceD_UnPackInputFile +subroutine IceD_PackInputFile(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IceD_InputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceD_PackInputFile' + if (Buf%ErrStat >= AbortErrLev) return + ! IceModel + call RegPack(Buf, InData%IceModel) + if (RegCheckErr(Buf, RoutineName)) return + ! IceSubModel + call RegPack(Buf, InData%IceSubModel) + if (RegCheckErr(Buf, RoutineName)) return + ! h + call RegPack(Buf, InData%h) + if (RegCheckErr(Buf, RoutineName)) return + ! v + call RegPack(Buf, InData%v) + if (RegCheckErr(Buf, RoutineName)) return + ! InitLoc + call RegPack(Buf, InData%InitLoc) + if (RegCheckErr(Buf, RoutineName)) return + ! t0 + call RegPack(Buf, InData%t0) + if (RegCheckErr(Buf, RoutineName)) return + ! rhow + call RegPack(Buf, InData%rhow) + if (RegCheckErr(Buf, RoutineName)) return + ! rhoi + call RegPack(Buf, InData%rhoi) + if (RegCheckErr(Buf, RoutineName)) return + ! Seed1 + call RegPack(Buf, InData%Seed1) + if (RegCheckErr(Buf, RoutineName)) return + ! Seed2 + call RegPack(Buf, InData%Seed2) + if (RegCheckErr(Buf, RoutineName)) return + ! NumLegs + call RegPack(Buf, InData%NumLegs) + if (RegCheckErr(Buf, RoutineName)) return + ! LegPosX + call RegPack(Buf, allocated(InData%LegPosX)) + if (allocated(InData%LegPosX)) then + call RegPackBounds(Buf, 1, lbound(InData%LegPosX), ubound(InData%LegPosX)) + call RegPack(Buf, InData%LegPosX) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LegPosY + call RegPack(Buf, allocated(InData%LegPosY)) + if (allocated(InData%LegPosY)) then + call RegPackBounds(Buf, 1, lbound(InData%LegPosY), ubound(InData%LegPosY)) + call RegPack(Buf, InData%LegPosY) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! StrWd + call RegPack(Buf, allocated(InData%StrWd)) + if (allocated(InData%StrWd)) then + call RegPackBounds(Buf, 1, lbound(InData%StrWd), ubound(InData%StrWd)) + call RegPack(Buf, InData%StrWd) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Ikm + call RegPack(Buf, InData%Ikm) + if (RegCheckErr(Buf, RoutineName)) return + ! Ag + call RegPack(Buf, InData%Ag) + if (RegCheckErr(Buf, RoutineName)) return + ! Qg + call RegPack(Buf, InData%Qg) + if (RegCheckErr(Buf, RoutineName)) return + ! Rg + call RegPack(Buf, InData%Rg) + if (RegCheckErr(Buf, RoutineName)) return + ! Tice + call RegPack(Buf, InData%Tice) + if (RegCheckErr(Buf, RoutineName)) return + ! nu + call RegPack(Buf, InData%nu) + if (RegCheckErr(Buf, RoutineName)) return + ! phi + call RegPack(Buf, InData%phi) + if (RegCheckErr(Buf, RoutineName)) return + ! SigNm + call RegPack(Buf, InData%SigNm) + if (RegCheckErr(Buf, RoutineName)) return + ! Eice + call RegPack(Buf, InData%Eice) + if (RegCheckErr(Buf, RoutineName)) return + ! IceStr2 + call RegPack(Buf, InData%IceStr2) + if (RegCheckErr(Buf, RoutineName)) return + ! Delmax2 + call RegPack(Buf, InData%Delmax2) + if (RegCheckErr(Buf, RoutineName)) return + ! Pitch + call RegPack(Buf, InData%Pitch) + if (RegCheckErr(Buf, RoutineName)) return + ! miuh + call RegPack(Buf, InData%miuh) + if (RegCheckErr(Buf, RoutineName)) return + ! varh + call RegPack(Buf, InData%varh) + if (RegCheckErr(Buf, RoutineName)) return + ! miuv + call RegPack(Buf, InData%miuv) + if (RegCheckErr(Buf, RoutineName)) return + ! varv + call RegPack(Buf, InData%varv) + if (RegCheckErr(Buf, RoutineName)) return + ! miut + call RegPack(Buf, InData%miut) + if (RegCheckErr(Buf, RoutineName)) return + ! miubr + call RegPack(Buf, InData%miubr) + if (RegCheckErr(Buf, RoutineName)) return + ! varbr + call RegPack(Buf, InData%varbr) + if (RegCheckErr(Buf, RoutineName)) return + ! miuDelm + call RegPack(Buf, InData%miuDelm) + if (RegCheckErr(Buf, RoutineName)) return + ! varDelm + call RegPack(Buf, InData%varDelm) + if (RegCheckErr(Buf, RoutineName)) return + ! miuP + call RegPack(Buf, InData%miuP) + if (RegCheckErr(Buf, RoutineName)) return + ! varP + call RegPack(Buf, InData%varP) + if (RegCheckErr(Buf, RoutineName)) return + ! Zn1 + call RegPack(Buf, InData%Zn1) + if (RegCheckErr(Buf, RoutineName)) return + ! Zn2 + call RegPack(Buf, InData%Zn2) + if (RegCheckErr(Buf, RoutineName)) return + ! ZonePitch + call RegPack(Buf, InData%ZonePitch) + if (RegCheckErr(Buf, RoutineName)) return + ! PrflMean + call RegPack(Buf, InData%PrflMean) + if (RegCheckErr(Buf, RoutineName)) return + ! PrflSig + call RegPack(Buf, InData%PrflSig) + if (RegCheckErr(Buf, RoutineName)) return + ! IceStr + call RegPack(Buf, InData%IceStr) + if (RegCheckErr(Buf, RoutineName)) return + ! Delmax + call RegPack(Buf, InData%Delmax) + if (RegCheckErr(Buf, RoutineName)) return + ! alpha + call RegPack(Buf, InData%alpha) + if (RegCheckErr(Buf, RoutineName)) return + ! Dwl + call RegPack(Buf, InData%Dwl) + if (RegCheckErr(Buf, RoutineName)) return + ! Dtp + call RegPack(Buf, InData%Dtp) + if (RegCheckErr(Buf, RoutineName)) return + ! hr + call RegPack(Buf, InData%hr) + if (RegCheckErr(Buf, RoutineName)) return + ! mu + call RegPack(Buf, InData%mu) + if (RegCheckErr(Buf, RoutineName)) return + ! sigf + call RegPack(Buf, InData%sigf) + if (RegCheckErr(Buf, RoutineName)) return + ! StrLim + call RegPack(Buf, InData%StrLim) + if (RegCheckErr(Buf, RoutineName)) return + ! StrRtLim + call RegPack(Buf, InData%StrRtLim) + if (RegCheckErr(Buf, RoutineName)) return + ! UorD + call RegPack(Buf, InData%UorD) + if (RegCheckErr(Buf, RoutineName)) return + ! Ll + call RegPack(Buf, InData%Ll) + if (RegCheckErr(Buf, RoutineName)) return + ! Lw + call RegPack(Buf, InData%Lw) + if (RegCheckErr(Buf, RoutineName)) return + ! Cpa + call RegPack(Buf, InData%Cpa) + if (RegCheckErr(Buf, RoutineName)) return + ! dpa + call RegPack(Buf, InData%dpa) + if (RegCheckErr(Buf, RoutineName)) return + ! Fdr + call RegPack(Buf, InData%Fdr) + if (RegCheckErr(Buf, RoutineName)) return + ! Kic + call RegPack(Buf, InData%Kic) + if (RegCheckErr(Buf, RoutineName)) return + ! FspN + call RegPack(Buf, InData%FspN) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceD_UnPackInputFile(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IceD_InputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceD_UnPackInputFile' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! IceModel + call RegUnpack(Buf, OutData%IceModel) + if (RegCheckErr(Buf, RoutineName)) return + ! IceSubModel + call RegUnpack(Buf, OutData%IceSubModel) + if (RegCheckErr(Buf, RoutineName)) return + ! h + call RegUnpack(Buf, OutData%h) + if (RegCheckErr(Buf, RoutineName)) return + ! v + call RegUnpack(Buf, OutData%v) + if (RegCheckErr(Buf, RoutineName)) return + ! InitLoc + call RegUnpack(Buf, OutData%InitLoc) + if (RegCheckErr(Buf, RoutineName)) return + ! t0 + call RegUnpack(Buf, OutData%t0) + if (RegCheckErr(Buf, RoutineName)) return + ! rhow + call RegUnpack(Buf, OutData%rhow) + if (RegCheckErr(Buf, RoutineName)) return + ! rhoi + call RegUnpack(Buf, OutData%rhoi) + if (RegCheckErr(Buf, RoutineName)) return + ! Seed1 + call RegUnpack(Buf, OutData%Seed1) + if (RegCheckErr(Buf, RoutineName)) return + ! Seed2 + call RegUnpack(Buf, OutData%Seed2) + if (RegCheckErr(Buf, RoutineName)) return + ! NumLegs + call RegUnpack(Buf, OutData%NumLegs) + if (RegCheckErr(Buf, RoutineName)) return + ! LegPosX + if (allocated(OutData%LegPosX)) deallocate(OutData%LegPosX) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LegPosX(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LegPosX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LegPosX) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LegPosY + if (allocated(OutData%LegPosY)) deallocate(OutData%LegPosY) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LegPosY(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LegPosY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LegPosY) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! StrWd + if (allocated(OutData%StrWd)) deallocate(OutData%StrWd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StrWd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StrWd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StrWd) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Ikm + call RegUnpack(Buf, OutData%Ikm) + if (RegCheckErr(Buf, RoutineName)) return + ! Ag + call RegUnpack(Buf, OutData%Ag) + if (RegCheckErr(Buf, RoutineName)) return + ! Qg + call RegUnpack(Buf, OutData%Qg) + if (RegCheckErr(Buf, RoutineName)) return + ! Rg + call RegUnpack(Buf, OutData%Rg) + if (RegCheckErr(Buf, RoutineName)) return + ! Tice + call RegUnpack(Buf, OutData%Tice) + if (RegCheckErr(Buf, RoutineName)) return + ! nu + call RegUnpack(Buf, OutData%nu) + if (RegCheckErr(Buf, RoutineName)) return + ! phi + call RegUnpack(Buf, OutData%phi) + if (RegCheckErr(Buf, RoutineName)) return + ! SigNm + call RegUnpack(Buf, OutData%SigNm) + if (RegCheckErr(Buf, RoutineName)) return + ! Eice + call RegUnpack(Buf, OutData%Eice) + if (RegCheckErr(Buf, RoutineName)) return + ! IceStr2 + call RegUnpack(Buf, OutData%IceStr2) + if (RegCheckErr(Buf, RoutineName)) return + ! Delmax2 + call RegUnpack(Buf, OutData%Delmax2) + if (RegCheckErr(Buf, RoutineName)) return + ! Pitch + call RegUnpack(Buf, OutData%Pitch) + if (RegCheckErr(Buf, RoutineName)) return + ! miuh + call RegUnpack(Buf, OutData%miuh) + if (RegCheckErr(Buf, RoutineName)) return + ! varh + call RegUnpack(Buf, OutData%varh) + if (RegCheckErr(Buf, RoutineName)) return + ! miuv + call RegUnpack(Buf, OutData%miuv) + if (RegCheckErr(Buf, RoutineName)) return + ! varv + call RegUnpack(Buf, OutData%varv) + if (RegCheckErr(Buf, RoutineName)) return + ! miut + call RegUnpack(Buf, OutData%miut) + if (RegCheckErr(Buf, RoutineName)) return + ! miubr + call RegUnpack(Buf, OutData%miubr) + if (RegCheckErr(Buf, RoutineName)) return + ! varbr + call RegUnpack(Buf, OutData%varbr) + if (RegCheckErr(Buf, RoutineName)) return + ! miuDelm + call RegUnpack(Buf, OutData%miuDelm) + if (RegCheckErr(Buf, RoutineName)) return + ! varDelm + call RegUnpack(Buf, OutData%varDelm) + if (RegCheckErr(Buf, RoutineName)) return + ! miuP + call RegUnpack(Buf, OutData%miuP) + if (RegCheckErr(Buf, RoutineName)) return + ! varP + call RegUnpack(Buf, OutData%varP) + if (RegCheckErr(Buf, RoutineName)) return + ! Zn1 + call RegUnpack(Buf, OutData%Zn1) + if (RegCheckErr(Buf, RoutineName)) return + ! Zn2 + call RegUnpack(Buf, OutData%Zn2) + if (RegCheckErr(Buf, RoutineName)) return + ! ZonePitch + call RegUnpack(Buf, OutData%ZonePitch) + if (RegCheckErr(Buf, RoutineName)) return + ! PrflMean + call RegUnpack(Buf, OutData%PrflMean) + if (RegCheckErr(Buf, RoutineName)) return + ! PrflSig + call RegUnpack(Buf, OutData%PrflSig) + if (RegCheckErr(Buf, RoutineName)) return + ! IceStr + call RegUnpack(Buf, OutData%IceStr) + if (RegCheckErr(Buf, RoutineName)) return + ! Delmax + call RegUnpack(Buf, OutData%Delmax) + if (RegCheckErr(Buf, RoutineName)) return + ! alpha + call RegUnpack(Buf, OutData%alpha) + if (RegCheckErr(Buf, RoutineName)) return + ! Dwl + call RegUnpack(Buf, OutData%Dwl) + if (RegCheckErr(Buf, RoutineName)) return + ! Dtp + call RegUnpack(Buf, OutData%Dtp) + if (RegCheckErr(Buf, RoutineName)) return + ! hr + call RegUnpack(Buf, OutData%hr) + if (RegCheckErr(Buf, RoutineName)) return + ! mu + call RegUnpack(Buf, OutData%mu) + if (RegCheckErr(Buf, RoutineName)) return + ! sigf + call RegUnpack(Buf, OutData%sigf) + if (RegCheckErr(Buf, RoutineName)) return + ! StrLim + call RegUnpack(Buf, OutData%StrLim) + if (RegCheckErr(Buf, RoutineName)) return + ! StrRtLim + call RegUnpack(Buf, OutData%StrRtLim) + if (RegCheckErr(Buf, RoutineName)) return + ! UorD + call RegUnpack(Buf, OutData%UorD) + if (RegCheckErr(Buf, RoutineName)) return + ! Ll + call RegUnpack(Buf, OutData%Ll) + if (RegCheckErr(Buf, RoutineName)) return + ! Lw + call RegUnpack(Buf, OutData%Lw) + if (RegCheckErr(Buf, RoutineName)) return + ! Cpa + call RegUnpack(Buf, OutData%Cpa) + if (RegCheckErr(Buf, RoutineName)) return + ! dpa + call RegUnpack(Buf, OutData%dpa) + if (RegCheckErr(Buf, RoutineName)) return + ! Fdr + call RegUnpack(Buf, OutData%Fdr) + if (RegCheckErr(Buf, RoutineName)) return + ! Kic + call RegUnpack(Buf, OutData%Kic) + if (RegCheckErr(Buf, RoutineName)) return + ! FspN + call RegUnpack(Buf, OutData%FspN) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE IceD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(IceD_InitInputType), INTENT(IN) :: SrcInitInputData TYPE(IceD_InitInputType), INTENT(INOUT) :: DstInitInputData @@ -889,141 +822,62 @@ SUBROUTINE IceD_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) END SUBROUTINE IceD_DestroyInitInput - SUBROUTINE IceD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(IceD_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%InputFile) ! InputFile - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Re_BufSz = Re_BufSz + 1 ! MSL2SWL - Re_BufSz = Re_BufSz + 1 ! WtrDens - Re_BufSz = Re_BufSz + 1 ! gravity - Int_BufSz = Int_BufSz + 1 ! LegNum - Db_BufSz = Db_BufSz + 1 ! TMax - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf(Re_Xferred) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%gravity - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%LegNum - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TMax - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE IceD_PackInitInput - - SUBROUTINE IceD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(IceD_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%MSL2SWL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LegNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TMax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE IceD_UnPackInitInput +subroutine IceD_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IceD_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceD_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + ! InputFile + call RegPack(Buf, InData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegPack(Buf, InData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! MSL2SWL + call RegPack(Buf, InData%MSL2SWL) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDens + call RegPack(Buf, InData%WtrDens) + if (RegCheckErr(Buf, RoutineName)) return + ! gravity + call RegPack(Buf, InData%gravity) + if (RegCheckErr(Buf, RoutineName)) return + ! LegNum + call RegPack(Buf, InData%LegNum) + if (RegCheckErr(Buf, RoutineName)) return + ! TMax + call RegPack(Buf, InData%TMax) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceD_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IceD_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceD_UnPackInitInput' + if (Buf%ErrStat /= ErrID_None) return + ! InputFile + call RegUnpack(Buf, OutData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! MSL2SWL + call RegUnpack(Buf, OutData%MSL2SWL) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDens + call RegUnpack(Buf, OutData%WtrDens) + if (RegCheckErr(Buf, RoutineName)) return + ! gravity + call RegUnpack(Buf, OutData%gravity) + if (RegCheckErr(Buf, RoutineName)) return + ! LegNum + call RegUnpack(Buf, OutData%LegNum) + if (RegCheckErr(Buf, RoutineName)) return + ! TMax + call RegUnpack(Buf, OutData%TMax) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE IceD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(IceD_InitOutputType), INTENT(IN) :: SrcInitOutputData TYPE(IceD_InitOutputType), INTENT(INOUT) :: DstInitOutputData @@ -1092,274 +946,78 @@ SUBROUTINE IceD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE IceD_DestroyInitOutput - SUBROUTINE IceD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(IceD_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! WriteOutputHdr allocated yes/no - IF ( ALLOCATED(InData%WriteOutputHdr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdr upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdr)*LEN(InData%WriteOutputHdr) ! WriteOutputHdr - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputUnt allocated yes/no - IF ( ALLOCATED(InData%WriteOutputUnt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUnt upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUnt)*LEN(InData%WriteOutputUnt) ! WriteOutputUnt - END IF - Int_BufSz = Int_BufSz + 1 ! numLegs - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%WriteOutputHdr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) - DO I = 1, LEN(InData%WriteOutputHdr) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputUnt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) - DO I = 1, LEN(InData%WriteOutputUnt) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IntKiBuf(Int_Xferred) = InData%numLegs - Int_Xferred = Int_Xferred + 1 - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE IceD_PackInitOutput - - SUBROUTINE IceD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(IceD_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputHdr)) DEALLOCATE(OutData%WriteOutputHdr) - ALLOCATE(OutData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) - DO I = 1, LEN(OutData%WriteOutputHdr) - OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputUnt)) DEALLOCATE(OutData%WriteOutputUnt) - ALLOCATE(OutData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) - DO I = 1, LEN(OutData%WriteOutputUnt) - OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - OutData%numLegs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE IceD_UnPackInitOutput +subroutine IceD_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IceD_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceD_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! WriteOutputHdr + call RegPack(Buf, allocated(InData%WriteOutputHdr)) + if (allocated(InData%WriteOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPack(Buf, InData%WriteOutputHdr) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutputUnt + call RegPack(Buf, allocated(InData%WriteOutputUnt)) + if (allocated(InData%WriteOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPack(Buf, InData%WriteOutputUnt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! numLegs + call RegPack(Buf, InData%numLegs) + if (RegCheckErr(Buf, RoutineName)) return + ! Ver + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceD_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IceD_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceD_UnPackInitOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! WriteOutputHdr + if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WriteOutputUnt + if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! numLegs + call RegUnpack(Buf, OutData%numLegs) + if (RegCheckErr(Buf, RoutineName)) return + ! Ver + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver +end subroutine SUBROUTINE IceD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(IceD_ContinuousStateType), INTENT(IN) :: SrcContStateData TYPE(IceD_ContinuousStateType), INTENT(INOUT) :: DstContStateData @@ -1393,108 +1051,32 @@ SUBROUTINE IceD_DestroyContState( ContStateData, ErrStat, ErrMsg ) END SUBROUTINE IceD_DestroyContState - SUBROUTINE IceD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(IceD_ContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_PackContState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! q - Re_BufSz = Re_BufSz + 1 ! dqdt - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%q - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dqdt - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IceD_PackContState - - SUBROUTINE IceD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(IceD_ContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_UnPackContState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%q = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dqdt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IceD_UnPackContState +subroutine IceD_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IceD_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceD_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + ! q + call RegPack(Buf, InData%q) + if (RegCheckErr(Buf, RoutineName)) return + ! dqdt + call RegPack(Buf, InData%dqdt) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceD_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IceD_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceD_UnPackContState' + if (Buf%ErrStat /= ErrID_None) return + ! q + call RegUnpack(Buf, OutData%q) + if (RegCheckErr(Buf, RoutineName)) return + ! dqdt + call RegUnpack(Buf, OutData%dqdt) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE IceD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(IceD_DiscreteStateType), INTENT(IN) :: SrcDiscStateData TYPE(IceD_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData @@ -1527,103 +1109,26 @@ SUBROUTINE IceD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) END SUBROUTINE IceD_DestroyDiscState - SUBROUTINE IceD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(IceD_DiscreteStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_PackDiscState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyDiscState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IceD_PackDiscState - - SUBROUTINE IceD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(IceD_DiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_UnPackDiscState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyDiscState = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IceD_UnPackDiscState +subroutine IceD_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IceD_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceD_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyDiscState + call RegPack(Buf, InData%DummyDiscState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceD_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IceD_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceD_UnPackDiscState' + if (Buf%ErrStat /= ErrID_None) return + ! DummyDiscState + call RegUnpack(Buf, OutData%DummyDiscState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE IceD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(IceD_ConstraintStateType), INTENT(IN) :: SrcConstrStateData TYPE(IceD_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData @@ -1656,103 +1161,26 @@ SUBROUTINE IceD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) END SUBROUTINE IceD_DestroyConstrState - SUBROUTINE IceD_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(IceD_ConstraintStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_PackConstrState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyConstrState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IceD_PackConstrState - - SUBROUTINE IceD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(IceD_ConstraintStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_UnPackConstrState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyConstrState = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IceD_UnPackConstrState +subroutine IceD_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IceD_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceD_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyConstrState + call RegPack(Buf, InData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceD_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IceD_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceD_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + ! DummyConstrState + call RegUnpack(Buf, OutData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE IceD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(IceD_OtherStateType), INTENT(IN) :: SrcOtherStateData TYPE(IceD_OtherStateType), INTENT(INOUT) :: DstOtherStateData @@ -1859,364 +1287,155 @@ SUBROUTINE IceD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE IceD_DestroyOtherState - SUBROUTINE IceD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(IceD_OtherStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_PackOtherState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! IceTthNo2 - Int_BufSz = Int_BufSz + 1 ! Nc allocated yes/no - IF ( ALLOCATED(InData%Nc) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Nc upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Nc) ! Nc - END IF - Int_BufSz = Int_BufSz + 1 ! Psum allocated yes/no - IF ( ALLOCATED(InData%Psum) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Psum upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Psum) ! Psum - END IF - Int_BufSz = Int_BufSz + 1 ! IceTthNo allocated yes/no - IF ( ALLOCATED(InData%IceTthNo) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IceTthNo upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IceTthNo) ! IceTthNo - END IF - Re_BufSz = Re_BufSz + 1 ! Beta - Db_BufSz = Db_BufSz + 1 ! Tinit - Int_BufSz = Int_BufSz + 1 ! Splitf - Re_BufSz = Re_BufSz + 1 ! dxc - Int_BufSz = Int_BufSz + 1 ! xdot allocated yes/no - IF ( ALLOCATED(InData%xdot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xdot upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) - Int_BufSz = Int_BufSz + 3 ! xdot: size of buffers for each call to pack subtype - CALL IceD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xdot - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xdot - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xdot - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xdot - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! n - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%IceTthNo2 - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Nc) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Nc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nc,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Nc,1), UBOUND(InData%Nc,1) - IntKiBuf(Int_Xferred) = InData%Nc(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Psum) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Psum,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Psum,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Psum,1), UBOUND(InData%Psum,1) - ReKiBuf(Re_Xferred) = InData%Psum(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IceTthNo) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IceTthNo,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IceTthNo,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IceTthNo,1), UBOUND(InData%IceTthNo,1) - IntKiBuf(Int_Xferred) = InData%IceTthNo(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%Beta - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Tinit - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Splitf - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dxc - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%xdot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xdot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) - CALL IceD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, OnlySize ) ! xdot - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IntKiBuf(Int_Xferred) = InData%n - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE IceD_PackOtherState - - SUBROUTINE IceD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(IceD_OtherStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_UnPackOtherState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%IceTthNo2 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Nc not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Nc)) DEALLOCATE(OutData%Nc) - ALLOCATE(OutData%Nc(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Nc,1), UBOUND(OutData%Nc,1) - OutData%Nc(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Psum not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Psum)) DEALLOCATE(OutData%Psum) - ALLOCATE(OutData%Psum(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Psum.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Psum,1), UBOUND(OutData%Psum,1) - OutData%Psum(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IceTthNo not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IceTthNo)) DEALLOCATE(OutData%IceTthNo) - ALLOCATE(OutData%IceTthNo(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IceTthNo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IceTthNo,1), UBOUND(OutData%IceTthNo,1) - OutData%IceTthNo(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%Beta = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Tinit = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Splitf = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%dxc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xdot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%xdot)) DEALLOCATE(OutData%xdot) - ALLOCATE(OutData%xdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%xdot,1), UBOUND(OutData%xdot,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%xdot(i1), ErrStat2, ErrMsg2 ) ! xdot - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - OutData%n = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE IceD_UnPackOtherState +subroutine IceD_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IceD_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceD_PackOtherState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! IceTthNo2 + call RegPack(Buf, InData%IceTthNo2) + if (RegCheckErr(Buf, RoutineName)) return + ! Nc + call RegPack(Buf, allocated(InData%Nc)) + if (allocated(InData%Nc)) then + call RegPackBounds(Buf, 1, lbound(InData%Nc), ubound(InData%Nc)) + call RegPack(Buf, InData%Nc) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Psum + call RegPack(Buf, allocated(InData%Psum)) + if (allocated(InData%Psum)) then + call RegPackBounds(Buf, 1, lbound(InData%Psum), ubound(InData%Psum)) + call RegPack(Buf, InData%Psum) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! IceTthNo + call RegPack(Buf, allocated(InData%IceTthNo)) + if (allocated(InData%IceTthNo)) then + call RegPackBounds(Buf, 1, lbound(InData%IceTthNo), ubound(InData%IceTthNo)) + call RegPack(Buf, InData%IceTthNo) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Beta + call RegPack(Buf, InData%Beta) + if (RegCheckErr(Buf, RoutineName)) return + ! Tinit + call RegPack(Buf, InData%Tinit) + if (RegCheckErr(Buf, RoutineName)) return + ! Splitf + call RegPack(Buf, InData%Splitf) + if (RegCheckErr(Buf, RoutineName)) return + ! dxc + call RegPack(Buf, InData%dxc) + if (RegCheckErr(Buf, RoutineName)) return + ! xdot + call RegPack(Buf, allocated(InData%xdot)) + if (allocated(InData%xdot)) then + call RegPackBounds(Buf, 1, lbound(InData%xdot), ubound(InData%xdot)) + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) + do i1 = LB(1), UB(1) + call IceD_PackContState(Buf, InData%xdot(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! n + call RegPack(Buf, InData%n) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceD_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IceD_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceD_UnPackOtherState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! IceTthNo2 + call RegUnpack(Buf, OutData%IceTthNo2) + if (RegCheckErr(Buf, RoutineName)) return + ! Nc + if (allocated(OutData%Nc)) deallocate(OutData%Nc) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Nc(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Nc) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Psum + if (allocated(OutData%Psum)) deallocate(OutData%Psum) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Psum(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Psum.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Psum) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! IceTthNo + if (allocated(OutData%IceTthNo)) deallocate(OutData%IceTthNo) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IceTthNo(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IceTthNo.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IceTthNo) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Beta + call RegUnpack(Buf, OutData%Beta) + if (RegCheckErr(Buf, RoutineName)) return + ! Tinit + call RegUnpack(Buf, OutData%Tinit) + if (RegCheckErr(Buf, RoutineName)) return + ! Splitf + call RegUnpack(Buf, OutData%Splitf) + if (RegCheckErr(Buf, RoutineName)) return + ! dxc + call RegUnpack(Buf, OutData%dxc) + if (RegCheckErr(Buf, RoutineName)) return + ! xdot + if (allocated(OutData%xdot)) deallocate(OutData%xdot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xdot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xdot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceD_UnpackContState(Buf, OutData%xdot(i1)) ! xdot + end do + end if + ! n + call RegUnpack(Buf, OutData%n) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE IceD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) TYPE(IceD_MiscVarType), INTENT(IN) :: SrcMiscData TYPE(IceD_MiscVarType), INTENT(INOUT) :: DstMiscData @@ -2249,103 +1468,26 @@ SUBROUTINE IceD_DestroyMisc( MiscData, ErrStat, ErrMsg ) END SUBROUTINE IceD_DestroyMisc - SUBROUTINE IceD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(IceD_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! DummyMiscVar - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%DummyMiscVar - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE IceD_PackMisc - - SUBROUTINE IceD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(IceD_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyMiscVar = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE IceD_UnPackMisc +subroutine IceD_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IceD_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceD_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyMiscVar + call RegPack(Buf, InData%DummyMiscVar) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceD_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IceD_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceD_UnPackMisc' + if (Buf%ErrStat /= ErrID_None) return + ! DummyMiscVar + call RegUnpack(Buf, OutData%DummyMiscVar) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE IceD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(IceD_ParameterType), INTENT(IN) :: SrcParamData TYPE(IceD_ParameterType), INTENT(INOUT) :: DstParamData @@ -2576,731 +1718,531 @@ SUBROUTINE IceD_DestroyParam( ParamData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE IceD_DestroyParam - SUBROUTINE IceD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(IceD_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! h - Re_BufSz = Re_BufSz + 1 ! v - Re_BufSz = Re_BufSz + 1 ! t0 - Re_BufSz = Re_BufSz + 1 ! StrWd - Re_BufSz = Re_BufSz + 1 ! dt - Re_BufSz = Re_BufSz + 1 ! InitLoc - Re_BufSz = Re_BufSz + 1 ! tolerance - Re_BufSz = Re_BufSz + 1 ! Tmax - Int_BufSz = Int_BufSz + 1 ! verif - Int_BufSz = Int_BufSz + 1 ! ModNo - Int_BufSz = Int_BufSz + 1 ! SubModNo - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! method - Int_BufSz = Int_BufSz + 1 ! TmStep - Int_BufSz = Int_BufSz + 1 ! OutName allocated yes/no - IF ( ALLOCATED(InData%OutName) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutName upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%OutName)*LEN(InData%OutName) ! OutName - END IF - Int_BufSz = Int_BufSz + 1 ! OutUnit allocated yes/no - IF ( ALLOCATED(InData%OutUnit) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutUnit upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%OutUnit)*LEN(InData%OutUnit) ! OutUnit - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Re_BufSz = Re_BufSz + 1 ! tm1a - Re_BufSz = Re_BufSz + 1 ! tm1b - Re_BufSz = Re_BufSz + 1 ! tm1c - Re_BufSz = Re_BufSz + 1 ! Fmax1a - Re_BufSz = Re_BufSz + 1 ! Fmax1b - Re_BufSz = Re_BufSz + 1 ! Fmax1c - Re_BufSz = Re_BufSz + 1 ! Ikm - Re_BufSz = Re_BufSz + 1 ! Cstr - Re_BufSz = Re_BufSz + 1 ! EiPa - Re_BufSz = Re_BufSz + 1 ! Delmax2 - Re_BufSz = Re_BufSz + 1 ! Pitch - Re_BufSz = Re_BufSz + 1 ! Kice2 - Int_BufSz = Int_BufSz + 1 ! rdmFm allocated yes/no - IF ( ALLOCATED(InData%rdmFm) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rdmFm upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rdmFm) ! rdmFm - END IF - Int_BufSz = Int_BufSz + 1 ! rdmt0 allocated yes/no - IF ( ALLOCATED(InData%rdmt0) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rdmt0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rdmt0) ! rdmt0 - END IF - Int_BufSz = Int_BufSz + 1 ! rdmtm allocated yes/no - IF ( ALLOCATED(InData%rdmtm) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rdmtm upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rdmtm) ! rdmtm - END IF - Int_BufSz = Int_BufSz + 1 ! rdmDm allocated yes/no - IF ( ALLOCATED(InData%rdmDm) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rdmDm upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rdmDm) ! rdmDm - END IF - Int_BufSz = Int_BufSz + 1 ! rdmP allocated yes/no - IF ( ALLOCATED(InData%rdmP) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rdmP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rdmP) ! rdmP - END IF - Int_BufSz = Int_BufSz + 1 ! rdmKi allocated yes/no - IF ( ALLOCATED(InData%rdmKi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! rdmKi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rdmKi) ! rdmKi - END IF - Re_BufSz = Re_BufSz + 1 ! ZonePitch - Re_BufSz = Re_BufSz + 1 ! Kice - Re_BufSz = Re_BufSz + 1 ! Delmax - Int_BufSz = Int_BufSz + 1 ! Y0 allocated yes/no - IF ( ALLOCATED(InData%Y0) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Y0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Y0) ! Y0 - END IF - Int_BufSz = Int_BufSz + 1 ! ContPrfl allocated yes/no - IF ( ALLOCATED(InData%ContPrfl) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ContPrfl upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ContPrfl) ! ContPrfl - END IF - Int_BufSz = Int_BufSz + 1 ! Zn - Re_BufSz = Re_BufSz + 1 ! rhoi - Re_BufSz = Re_BufSz + 1 ! rhow - Re_BufSz = Re_BufSz + 1 ! alphaR - Re_BufSz = Re_BufSz + 1 ! Dwl - Re_BufSz = Re_BufSz + 1 ! Zr - Re_BufSz = Re_BufSz + 1 ! RHbr - Re_BufSz = Re_BufSz + 1 ! RVbr - Re_BufSz = Re_BufSz + 1 ! Lbr - Re_BufSz = Re_BufSz + 1 ! LovR - Re_BufSz = Re_BufSz + 1 ! mu - Re_BufSz = Re_BufSz + 1 ! Wri - Re_BufSz = Re_BufSz + 1 ! WL - Re_BufSz = Re_BufSz + 1 ! Cpa - Re_BufSz = Re_BufSz + 1 ! dpa - Re_BufSz = Re_BufSz + 1 ! FdrN - Re_BufSz = Re_BufSz + 1 ! Mice - Re_BufSz = Re_BufSz + 1 ! Fsp - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%h - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%v - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%t0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StrWd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%InitLoc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%tolerance - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Tmax - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%verif - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ModNo - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%SubModNo - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%method - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TmStep - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutName) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutName,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutName,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutName,1), UBOUND(InData%OutName,1) - DO I = 1, LEN(InData%OutName) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutName(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OutUnit) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutUnit,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutUnit,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutUnit,1), UBOUND(InData%OutUnit,1) - DO I = 1, LEN(InData%OutUnit) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutUnit(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf(Re_Xferred) = InData%tm1a - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%tm1b - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%tm1c - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Fmax1a - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Fmax1b - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Fmax1c - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Ikm - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cstr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%EiPa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Delmax2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Pitch - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Kice2 - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%rdmFm) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rdmFm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdmFm,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rdmFm,1), UBOUND(InData%rdmFm,1) - ReKiBuf(Re_Xferred) = InData%rdmFm(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rdmt0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rdmt0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdmt0,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rdmt0,1), UBOUND(InData%rdmt0,1) - ReKiBuf(Re_Xferred) = InData%rdmt0(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rdmtm) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rdmtm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdmtm,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rdmtm,1), UBOUND(InData%rdmtm,1) - ReKiBuf(Re_Xferred) = InData%rdmtm(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rdmDm) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rdmDm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdmDm,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rdmDm,1), UBOUND(InData%rdmDm,1) - ReKiBuf(Re_Xferred) = InData%rdmDm(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rdmP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rdmP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdmP,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rdmP,1), UBOUND(InData%rdmP,1) - ReKiBuf(Re_Xferred) = InData%rdmP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rdmKi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rdmKi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdmKi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%rdmKi,1), UBOUND(InData%rdmKi,1) - ReKiBuf(Re_Xferred) = InData%rdmKi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%ZonePitch - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Kice - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Delmax - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Y0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Y0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y0,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Y0,1), UBOUND(InData%Y0,1) - ReKiBuf(Re_Xferred) = InData%Y0(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ContPrfl) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ContPrfl,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ContPrfl,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ContPrfl,1), UBOUND(InData%ContPrfl,1) - ReKiBuf(Re_Xferred) = InData%ContPrfl(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%Zn - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rhoi - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rhow - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%alphaR - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Dwl - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Zr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RHbr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RVbr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Lbr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LovR - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%mu - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Wri - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WL - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Cpa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dpa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%FdrN - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Mice - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Fsp - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IceD_PackParam - - SUBROUTINE IceD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(IceD_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%h = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%v = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%t0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StrWd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%InitLoc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%tolerance = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Tmax = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%verif = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ModNo = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%SubModNo = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%method = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TmStep = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutName not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutName)) DEALLOCATE(OutData%OutName) - ALLOCATE(OutData%OutName(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutName.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutName,1), UBOUND(OutData%OutName,1) - DO I = 1, LEN(OutData%OutName) - OutData%OutName(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutUnit not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutUnit)) DEALLOCATE(OutData%OutUnit) - ALLOCATE(OutData%OutUnit(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutUnit.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutUnit,1), UBOUND(OutData%OutUnit,1) - DO I = 1, LEN(OutData%OutUnit) - OutData%OutUnit(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%tm1a = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%tm1b = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%tm1c = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Fmax1a = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Fmax1b = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Fmax1c = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Ikm = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cstr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%EiPa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Delmax2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Pitch = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Kice2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rdmFm not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rdmFm)) DEALLOCATE(OutData%rdmFm) - ALLOCATE(OutData%rdmFm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmFm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rdmFm,1), UBOUND(OutData%rdmFm,1) - OutData%rdmFm(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rdmt0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rdmt0)) DEALLOCATE(OutData%rdmt0) - ALLOCATE(OutData%rdmt0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmt0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rdmt0,1), UBOUND(OutData%rdmt0,1) - OutData%rdmt0(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rdmtm not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rdmtm)) DEALLOCATE(OutData%rdmtm) - ALLOCATE(OutData%rdmtm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmtm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rdmtm,1), UBOUND(OutData%rdmtm,1) - OutData%rdmtm(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rdmDm not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rdmDm)) DEALLOCATE(OutData%rdmDm) - ALLOCATE(OutData%rdmDm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmDm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rdmDm,1), UBOUND(OutData%rdmDm,1) - OutData%rdmDm(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rdmP not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rdmP)) DEALLOCATE(OutData%rdmP) - ALLOCATE(OutData%rdmP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rdmP,1), UBOUND(OutData%rdmP,1) - OutData%rdmP(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rdmKi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rdmKi)) DEALLOCATE(OutData%rdmKi) - ALLOCATE(OutData%rdmKi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmKi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%rdmKi,1), UBOUND(OutData%rdmKi,1) - OutData%rdmKi(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%ZonePitch = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Kice = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Delmax = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Y0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Y0)) DEALLOCATE(OutData%Y0) - ALLOCATE(OutData%Y0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Y0,1), UBOUND(OutData%Y0,1) - OutData%Y0(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ContPrfl not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ContPrfl)) DEALLOCATE(OutData%ContPrfl) - ALLOCATE(OutData%ContPrfl(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ContPrfl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ContPrfl,1), UBOUND(OutData%ContPrfl,1) - OutData%ContPrfl(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Zn = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%rhoi = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rhow = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%alphaR = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Dwl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Zr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RHbr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RVbr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Lbr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LovR = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%mu = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Wri = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Cpa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dpa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%FdrN = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Mice = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Fsp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IceD_UnPackParam +subroutine IceD_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IceD_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceD_PackParam' + if (Buf%ErrStat >= AbortErrLev) return + ! h + call RegPack(Buf, InData%h) + if (RegCheckErr(Buf, RoutineName)) return + ! v + call RegPack(Buf, InData%v) + if (RegCheckErr(Buf, RoutineName)) return + ! t0 + call RegPack(Buf, InData%t0) + if (RegCheckErr(Buf, RoutineName)) return + ! StrWd + call RegPack(Buf, InData%StrWd) + if (RegCheckErr(Buf, RoutineName)) return + ! dt + call RegPack(Buf, InData%dt) + if (RegCheckErr(Buf, RoutineName)) return + ! InitLoc + call RegPack(Buf, InData%InitLoc) + if (RegCheckErr(Buf, RoutineName)) return + ! tolerance + call RegPack(Buf, InData%tolerance) + if (RegCheckErr(Buf, RoutineName)) return + ! Tmax + call RegPack(Buf, InData%Tmax) + if (RegCheckErr(Buf, RoutineName)) return + ! verif + call RegPack(Buf, InData%verif) + if (RegCheckErr(Buf, RoutineName)) return + ! ModNo + call RegPack(Buf, InData%ModNo) + if (RegCheckErr(Buf, RoutineName)) return + ! SubModNo + call RegPack(Buf, InData%SubModNo) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegPack(Buf, InData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! method + call RegPack(Buf, InData%method) + if (RegCheckErr(Buf, RoutineName)) return + ! TmStep + call RegPack(Buf, InData%TmStep) + if (RegCheckErr(Buf, RoutineName)) return + ! OutName + call RegPack(Buf, allocated(InData%OutName)) + if (allocated(InData%OutName)) then + call RegPackBounds(Buf, 1, lbound(InData%OutName), ubound(InData%OutName)) + call RegPack(Buf, InData%OutName) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OutUnit + call RegPack(Buf, allocated(InData%OutUnit)) + if (allocated(InData%OutUnit)) then + call RegPackBounds(Buf, 1, lbound(InData%OutUnit), ubound(InData%OutUnit)) + call RegPack(Buf, InData%OutUnit) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegPack(Buf, InData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! tm1a + call RegPack(Buf, InData%tm1a) + if (RegCheckErr(Buf, RoutineName)) return + ! tm1b + call RegPack(Buf, InData%tm1b) + if (RegCheckErr(Buf, RoutineName)) return + ! tm1c + call RegPack(Buf, InData%tm1c) + if (RegCheckErr(Buf, RoutineName)) return + ! Fmax1a + call RegPack(Buf, InData%Fmax1a) + if (RegCheckErr(Buf, RoutineName)) return + ! Fmax1b + call RegPack(Buf, InData%Fmax1b) + if (RegCheckErr(Buf, RoutineName)) return + ! Fmax1c + call RegPack(Buf, InData%Fmax1c) + if (RegCheckErr(Buf, RoutineName)) return + ! Ikm + call RegPack(Buf, InData%Ikm) + if (RegCheckErr(Buf, RoutineName)) return + ! Cstr + call RegPack(Buf, InData%Cstr) + if (RegCheckErr(Buf, RoutineName)) return + ! EiPa + call RegPack(Buf, InData%EiPa) + if (RegCheckErr(Buf, RoutineName)) return + ! Delmax2 + call RegPack(Buf, InData%Delmax2) + if (RegCheckErr(Buf, RoutineName)) return + ! Pitch + call RegPack(Buf, InData%Pitch) + if (RegCheckErr(Buf, RoutineName)) return + ! Kice2 + call RegPack(Buf, InData%Kice2) + if (RegCheckErr(Buf, RoutineName)) return + ! rdmFm + call RegPack(Buf, allocated(InData%rdmFm)) + if (allocated(InData%rdmFm)) then + call RegPackBounds(Buf, 1, lbound(InData%rdmFm), ubound(InData%rdmFm)) + call RegPack(Buf, InData%rdmFm) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! rdmt0 + call RegPack(Buf, allocated(InData%rdmt0)) + if (allocated(InData%rdmt0)) then + call RegPackBounds(Buf, 1, lbound(InData%rdmt0), ubound(InData%rdmt0)) + call RegPack(Buf, InData%rdmt0) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! rdmtm + call RegPack(Buf, allocated(InData%rdmtm)) + if (allocated(InData%rdmtm)) then + call RegPackBounds(Buf, 1, lbound(InData%rdmtm), ubound(InData%rdmtm)) + call RegPack(Buf, InData%rdmtm) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! rdmDm + call RegPack(Buf, allocated(InData%rdmDm)) + if (allocated(InData%rdmDm)) then + call RegPackBounds(Buf, 1, lbound(InData%rdmDm), ubound(InData%rdmDm)) + call RegPack(Buf, InData%rdmDm) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! rdmP + call RegPack(Buf, allocated(InData%rdmP)) + if (allocated(InData%rdmP)) then + call RegPackBounds(Buf, 1, lbound(InData%rdmP), ubound(InData%rdmP)) + call RegPack(Buf, InData%rdmP) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! rdmKi + call RegPack(Buf, allocated(InData%rdmKi)) + if (allocated(InData%rdmKi)) then + call RegPackBounds(Buf, 1, lbound(InData%rdmKi), ubound(InData%rdmKi)) + call RegPack(Buf, InData%rdmKi) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ZonePitch + call RegPack(Buf, InData%ZonePitch) + if (RegCheckErr(Buf, RoutineName)) return + ! Kice + call RegPack(Buf, InData%Kice) + if (RegCheckErr(Buf, RoutineName)) return + ! Delmax + call RegPack(Buf, InData%Delmax) + if (RegCheckErr(Buf, RoutineName)) return + ! Y0 + call RegPack(Buf, allocated(InData%Y0)) + if (allocated(InData%Y0)) then + call RegPackBounds(Buf, 1, lbound(InData%Y0), ubound(InData%Y0)) + call RegPack(Buf, InData%Y0) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ContPrfl + call RegPack(Buf, allocated(InData%ContPrfl)) + if (allocated(InData%ContPrfl)) then + call RegPackBounds(Buf, 1, lbound(InData%ContPrfl), ubound(InData%ContPrfl)) + call RegPack(Buf, InData%ContPrfl) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Zn + call RegPack(Buf, InData%Zn) + if (RegCheckErr(Buf, RoutineName)) return + ! rhoi + call RegPack(Buf, InData%rhoi) + if (RegCheckErr(Buf, RoutineName)) return + ! rhow + call RegPack(Buf, InData%rhow) + if (RegCheckErr(Buf, RoutineName)) return + ! alphaR + call RegPack(Buf, InData%alphaR) + if (RegCheckErr(Buf, RoutineName)) return + ! Dwl + call RegPack(Buf, InData%Dwl) + if (RegCheckErr(Buf, RoutineName)) return + ! Zr + call RegPack(Buf, InData%Zr) + if (RegCheckErr(Buf, RoutineName)) return + ! RHbr + call RegPack(Buf, InData%RHbr) + if (RegCheckErr(Buf, RoutineName)) return + ! RVbr + call RegPack(Buf, InData%RVbr) + if (RegCheckErr(Buf, RoutineName)) return + ! Lbr + call RegPack(Buf, InData%Lbr) + if (RegCheckErr(Buf, RoutineName)) return + ! LovR + call RegPack(Buf, InData%LovR) + if (RegCheckErr(Buf, RoutineName)) return + ! mu + call RegPack(Buf, InData%mu) + if (RegCheckErr(Buf, RoutineName)) return + ! Wri + call RegPack(Buf, InData%Wri) + if (RegCheckErr(Buf, RoutineName)) return + ! WL + call RegPack(Buf, InData%WL) + if (RegCheckErr(Buf, RoutineName)) return + ! Cpa + call RegPack(Buf, InData%Cpa) + if (RegCheckErr(Buf, RoutineName)) return + ! dpa + call RegPack(Buf, InData%dpa) + if (RegCheckErr(Buf, RoutineName)) return + ! FdrN + call RegPack(Buf, InData%FdrN) + if (RegCheckErr(Buf, RoutineName)) return + ! Mice + call RegPack(Buf, InData%Mice) + if (RegCheckErr(Buf, RoutineName)) return + ! Fsp + call RegPack(Buf, InData%Fsp) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceD_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IceD_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceD_UnPackParam' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! h + call RegUnpack(Buf, OutData%h) + if (RegCheckErr(Buf, RoutineName)) return + ! v + call RegUnpack(Buf, OutData%v) + if (RegCheckErr(Buf, RoutineName)) return + ! t0 + call RegUnpack(Buf, OutData%t0) + if (RegCheckErr(Buf, RoutineName)) return + ! StrWd + call RegUnpack(Buf, OutData%StrWd) + if (RegCheckErr(Buf, RoutineName)) return + ! dt + call RegUnpack(Buf, OutData%dt) + if (RegCheckErr(Buf, RoutineName)) return + ! InitLoc + call RegUnpack(Buf, OutData%InitLoc) + if (RegCheckErr(Buf, RoutineName)) return + ! tolerance + call RegUnpack(Buf, OutData%tolerance) + if (RegCheckErr(Buf, RoutineName)) return + ! Tmax + call RegUnpack(Buf, OutData%Tmax) + if (RegCheckErr(Buf, RoutineName)) return + ! verif + call RegUnpack(Buf, OutData%verif) + if (RegCheckErr(Buf, RoutineName)) return + ! ModNo + call RegUnpack(Buf, OutData%ModNo) + if (RegCheckErr(Buf, RoutineName)) return + ! SubModNo + call RegUnpack(Buf, OutData%SubModNo) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! method + call RegUnpack(Buf, OutData%method) + if (RegCheckErr(Buf, RoutineName)) return + ! TmStep + call RegUnpack(Buf, OutData%TmStep) + if (RegCheckErr(Buf, RoutineName)) return + ! OutName + if (allocated(OutData%OutName)) deallocate(OutData%OutName) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutName(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutName.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutName) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! OutUnit + if (allocated(OutData%OutUnit)) deallocate(OutData%OutUnit) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutUnit(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutUnit.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutUnit) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RootName + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! tm1a + call RegUnpack(Buf, OutData%tm1a) + if (RegCheckErr(Buf, RoutineName)) return + ! tm1b + call RegUnpack(Buf, OutData%tm1b) + if (RegCheckErr(Buf, RoutineName)) return + ! tm1c + call RegUnpack(Buf, OutData%tm1c) + if (RegCheckErr(Buf, RoutineName)) return + ! Fmax1a + call RegUnpack(Buf, OutData%Fmax1a) + if (RegCheckErr(Buf, RoutineName)) return + ! Fmax1b + call RegUnpack(Buf, OutData%Fmax1b) + if (RegCheckErr(Buf, RoutineName)) return + ! Fmax1c + call RegUnpack(Buf, OutData%Fmax1c) + if (RegCheckErr(Buf, RoutineName)) return + ! Ikm + call RegUnpack(Buf, OutData%Ikm) + if (RegCheckErr(Buf, RoutineName)) return + ! Cstr + call RegUnpack(Buf, OutData%Cstr) + if (RegCheckErr(Buf, RoutineName)) return + ! EiPa + call RegUnpack(Buf, OutData%EiPa) + if (RegCheckErr(Buf, RoutineName)) return + ! Delmax2 + call RegUnpack(Buf, OutData%Delmax2) + if (RegCheckErr(Buf, RoutineName)) return + ! Pitch + call RegUnpack(Buf, OutData%Pitch) + if (RegCheckErr(Buf, RoutineName)) return + ! Kice2 + call RegUnpack(Buf, OutData%Kice2) + if (RegCheckErr(Buf, RoutineName)) return + ! rdmFm + if (allocated(OutData%rdmFm)) deallocate(OutData%rdmFm) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rdmFm(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmFm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rdmFm) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! rdmt0 + if (allocated(OutData%rdmt0)) deallocate(OutData%rdmt0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rdmt0(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmt0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rdmt0) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! rdmtm + if (allocated(OutData%rdmtm)) deallocate(OutData%rdmtm) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rdmtm(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmtm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rdmtm) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! rdmDm + if (allocated(OutData%rdmDm)) deallocate(OutData%rdmDm) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rdmDm(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmDm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rdmDm) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! rdmP + if (allocated(OutData%rdmP)) deallocate(OutData%rdmP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rdmP(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rdmP) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! rdmKi + if (allocated(OutData%rdmKi)) deallocate(OutData%rdmKi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rdmKi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmKi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rdmKi) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ZonePitch + call RegUnpack(Buf, OutData%ZonePitch) + if (RegCheckErr(Buf, RoutineName)) return + ! Kice + call RegUnpack(Buf, OutData%Kice) + if (RegCheckErr(Buf, RoutineName)) return + ! Delmax + call RegUnpack(Buf, OutData%Delmax) + if (RegCheckErr(Buf, RoutineName)) return + ! Y0 + if (allocated(OutData%Y0)) deallocate(OutData%Y0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Y0(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Y0) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ContPrfl + if (allocated(OutData%ContPrfl)) deallocate(OutData%ContPrfl) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ContPrfl(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ContPrfl.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ContPrfl) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Zn + call RegUnpack(Buf, OutData%Zn) + if (RegCheckErr(Buf, RoutineName)) return + ! rhoi + call RegUnpack(Buf, OutData%rhoi) + if (RegCheckErr(Buf, RoutineName)) return + ! rhow + call RegUnpack(Buf, OutData%rhow) + if (RegCheckErr(Buf, RoutineName)) return + ! alphaR + call RegUnpack(Buf, OutData%alphaR) + if (RegCheckErr(Buf, RoutineName)) return + ! Dwl + call RegUnpack(Buf, OutData%Dwl) + if (RegCheckErr(Buf, RoutineName)) return + ! Zr + call RegUnpack(Buf, OutData%Zr) + if (RegCheckErr(Buf, RoutineName)) return + ! RHbr + call RegUnpack(Buf, OutData%RHbr) + if (RegCheckErr(Buf, RoutineName)) return + ! RVbr + call RegUnpack(Buf, OutData%RVbr) + if (RegCheckErr(Buf, RoutineName)) return + ! Lbr + call RegUnpack(Buf, OutData%Lbr) + if (RegCheckErr(Buf, RoutineName)) return + ! LovR + call RegUnpack(Buf, OutData%LovR) + if (RegCheckErr(Buf, RoutineName)) return + ! mu + call RegUnpack(Buf, OutData%mu) + if (RegCheckErr(Buf, RoutineName)) return + ! Wri + call RegUnpack(Buf, OutData%Wri) + if (RegCheckErr(Buf, RoutineName)) return + ! WL + call RegUnpack(Buf, OutData%WL) + if (RegCheckErr(Buf, RoutineName)) return + ! Cpa + call RegUnpack(Buf, OutData%Cpa) + if (RegCheckErr(Buf, RoutineName)) return + ! dpa + call RegUnpack(Buf, OutData%dpa) + if (RegCheckErr(Buf, RoutineName)) return + ! FdrN + call RegUnpack(Buf, OutData%FdrN) + if (RegCheckErr(Buf, RoutineName)) return + ! Mice + call RegUnpack(Buf, OutData%Mice) + if (RegCheckErr(Buf, RoutineName)) return + ! Fsp + call RegUnpack(Buf, OutData%Fsp) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE IceD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(IceD_InputType), INTENT(INOUT) :: SrcInputData TYPE(IceD_InputType), INTENT(INOUT) :: DstInputData @@ -3337,184 +2279,25 @@ SUBROUTINE IceD_DestroyInput( InputData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE IceD_DestroyInput - SUBROUTINE IceD_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(IceD_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! PointMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%PointMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PointMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PointMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PointMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PointMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL MeshPack( InData%PointMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PointMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE IceD_PackInput - - SUBROUTINE IceD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(IceD_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%PointMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PointMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE IceD_UnPackInput +subroutine IceD_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IceD_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceD_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + ! PointMesh + call MeshPack(Buf, InData%PointMesh) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceD_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IceD_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceD_UnPackInput' + if (Buf%ErrStat /= ErrID_None) return + ! PointMesh + call MeshUnpack(Buf, OutData%PointMesh) ! PointMesh +end subroutine SUBROUTINE IceD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(IceD_OutputType), INTENT(INOUT) :: SrcOutputData TYPE(IceD_OutputType), INTENT(INOUT) :: DstOutputData @@ -3567,223 +2350,50 @@ SUBROUTINE IceD_DestroyOutput( OutputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE IceD_DestroyOutput - SUBROUTINE IceD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(IceD_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! PointMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%PointMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PointMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PointMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PointMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PointMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutput allocated yes/no - IF ( ALLOCATED(InData%WriteOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutput upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WriteOutput) ! WriteOutput - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL MeshPack( InData%PointMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PointMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) - ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE IceD_PackOutput - - SUBROUTINE IceD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(IceD_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%PointMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PointMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutput)) DEALLOCATE(OutData%WriteOutput) - ALLOCATE(OutData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) - OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE IceD_UnPackOutput +subroutine IceD_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IceD_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceD_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! PointMesh + call MeshPack(Buf, InData%PointMesh) + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutput + call RegPack(Buf, allocated(InData%WriteOutput)) + if (allocated(InData%WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPack(Buf, InData%WriteOutput) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceD_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IceD_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceD_UnPackOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! PointMesh + call MeshUnpack(Buf, OutData%PointMesh) ! PointMesh + ! WriteOutput + if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE IceD_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) ! diff --git a/modules/icefloe/src/icefloe/IceFloe_Types.f90 b/modules/icefloe/src/icefloe/IceFloe_Types.f90 index c010436746..e128b7eb43 100644 --- a/modules/icefloe/src/icefloe/IceFloe_Types.f90 +++ b/modules/icefloe/src/icefloe/IceFloe_Types.f90 @@ -145,131 +145,50 @@ SUBROUTINE IceFloe_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) END SUBROUTINE IceFloe_DestroyInitInput - SUBROUTINE IceFloe_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(IceFloe_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%InputFile) ! InputFile - Re_BufSz = Re_BufSz + 1 ! simLength - Re_BufSz = Re_BufSz + 1 ! MSL2SWL - Re_BufSz = Re_BufSz + 1 ! gravity - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf(Re_Xferred) = InData%simLength - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%gravity - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE IceFloe_PackInitInput - - SUBROUTINE IceFloe_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(IceFloe_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%simLength = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MSL2SWL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE IceFloe_UnPackInitInput +subroutine IceFloe_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IceFloe_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceFloe_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + ! InputFile + call RegPack(Buf, InData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! simLength + call RegPack(Buf, InData%simLength) + if (RegCheckErr(Buf, RoutineName)) return + ! MSL2SWL + call RegPack(Buf, InData%MSL2SWL) + if (RegCheckErr(Buf, RoutineName)) return + ! gravity + call RegPack(Buf, InData%gravity) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegPack(Buf, InData%RootName) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceFloe_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IceFloe_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceFloe_UnPackInitInput' + if (Buf%ErrStat /= ErrID_None) return + ! InputFile + call RegUnpack(Buf, OutData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! simLength + call RegUnpack(Buf, OutData%simLength) + if (RegCheckErr(Buf, RoutineName)) return + ! MSL2SWL + call RegUnpack(Buf, OutData%MSL2SWL) + if (RegCheckErr(Buf, RoutineName)) return + ! gravity + call RegUnpack(Buf, OutData%gravity) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE IceFloe_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(IceFloe_InitOutputType), INTENT(IN) :: SrcInitOutputData TYPE(IceFloe_InitOutputType), INTENT(INOUT) :: DstInitOutputData @@ -337,269 +256,72 @@ SUBROUTINE IceFloe_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE IceFloe_DestroyInitOutput - SUBROUTINE IceFloe_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(IceFloe_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! WriteOutputHdr allocated yes/no - IF ( ALLOCATED(InData%WriteOutputHdr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdr upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdr)*LEN(InData%WriteOutputHdr) ! WriteOutputHdr - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputUnt allocated yes/no - IF ( ALLOCATED(InData%WriteOutputUnt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUnt upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUnt)*LEN(InData%WriteOutputUnt) ! WriteOutputUnt - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%WriteOutputHdr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) - DO I = 1, LEN(InData%WriteOutputHdr) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputUnt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) - DO I = 1, LEN(InData%WriteOutputUnt) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE IceFloe_PackInitOutput - - SUBROUTINE IceFloe_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(IceFloe_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputHdr)) DEALLOCATE(OutData%WriteOutputHdr) - ALLOCATE(OutData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) - DO I = 1, LEN(OutData%WriteOutputHdr) - OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputUnt)) DEALLOCATE(OutData%WriteOutputUnt) - ALLOCATE(OutData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) - DO I = 1, LEN(OutData%WriteOutputUnt) - OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE IceFloe_UnPackInitOutput +subroutine IceFloe_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IceFloe_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceFloe_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! WriteOutputHdr + call RegPack(Buf, allocated(InData%WriteOutputHdr)) + if (allocated(InData%WriteOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPack(Buf, InData%WriteOutputHdr) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutputUnt + call RegPack(Buf, allocated(InData%WriteOutputUnt)) + if (allocated(InData%WriteOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPack(Buf, InData%WriteOutputUnt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Ver + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceFloe_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IceFloe_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceFloe_UnPackInitOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! WriteOutputHdr + if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WriteOutputUnt + if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Ver + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver +end subroutine SUBROUTINE IceFloe_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(IceFloe_ContinuousStateType), INTENT(IN) :: SrcContStateData TYPE(IceFloe_ContinuousStateType), INTENT(INOUT) :: DstContStateData @@ -632,103 +354,26 @@ SUBROUTINE IceFloe_DestroyContState( ContStateData, ErrStat, ErrMsg ) END SUBROUTINE IceFloe_DestroyContState - SUBROUTINE IceFloe_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(IceFloe_ContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_PackContState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyContStateVar - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyContStateVar - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IceFloe_PackContState - - SUBROUTINE IceFloe_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(IceFloe_ContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_UnPackContState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyContStateVar = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IceFloe_UnPackContState +subroutine IceFloe_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IceFloe_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceFloe_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyContStateVar + call RegPack(Buf, InData%DummyContStateVar) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceFloe_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IceFloe_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceFloe_UnPackContState' + if (Buf%ErrStat /= ErrID_None) return + ! DummyContStateVar + call RegUnpack(Buf, OutData%DummyContStateVar) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE IceFloe_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(IceFloe_DiscreteStateType), INTENT(IN) :: SrcDiscStateData TYPE(IceFloe_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData @@ -761,103 +406,26 @@ SUBROUTINE IceFloe_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) END SUBROUTINE IceFloe_DestroyDiscState - SUBROUTINE IceFloe_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(IceFloe_DiscreteStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_PackDiscState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyDiscStateVar - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyDiscStateVar - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IceFloe_PackDiscState - - SUBROUTINE IceFloe_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(IceFloe_DiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_UnPackDiscState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyDiscStateVar = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IceFloe_UnPackDiscState +subroutine IceFloe_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IceFloe_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceFloe_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyDiscStateVar + call RegPack(Buf, InData%DummyDiscStateVar) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceFloe_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IceFloe_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceFloe_UnPackDiscState' + if (Buf%ErrStat /= ErrID_None) return + ! DummyDiscStateVar + call RegUnpack(Buf, OutData%DummyDiscStateVar) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE IceFloe_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(IceFloe_ConstraintStateType), INTENT(IN) :: SrcConstrStateData TYPE(IceFloe_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData @@ -890,103 +458,26 @@ SUBROUTINE IceFloe_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) END SUBROUTINE IceFloe_DestroyConstrState - SUBROUTINE IceFloe_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(IceFloe_ConstraintStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_PackConstrState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyConstrStateVar - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyConstrStateVar - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IceFloe_PackConstrState - - SUBROUTINE IceFloe_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(IceFloe_ConstraintStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_UnPackConstrState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyConstrStateVar = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IceFloe_UnPackConstrState +subroutine IceFloe_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IceFloe_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceFloe_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyConstrStateVar + call RegPack(Buf, InData%DummyConstrStateVar) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceFloe_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IceFloe_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceFloe_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + ! DummyConstrStateVar + call RegUnpack(Buf, OutData%DummyConstrStateVar) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE IceFloe_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(IceFloe_OtherStateType), INTENT(IN) :: SrcOtherStateData TYPE(IceFloe_OtherStateType), INTENT(INOUT) :: DstOtherStateData @@ -1019,103 +510,26 @@ SUBROUTINE IceFloe_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) END SUBROUTINE IceFloe_DestroyOtherState - SUBROUTINE IceFloe_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(IceFloe_OtherStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_PackOtherState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! DummyOtherState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%DummyOtherState - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE IceFloe_PackOtherState - - SUBROUTINE IceFloe_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(IceFloe_OtherStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_UnPackOtherState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyOtherState = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE IceFloe_UnPackOtherState +subroutine IceFloe_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IceFloe_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceFloe_PackOtherState' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyOtherState + call RegPack(Buf, InData%DummyOtherState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceFloe_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IceFloe_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceFloe_UnPackOtherState' + if (Buf%ErrStat /= ErrID_None) return + ! DummyOtherState + call RegUnpack(Buf, OutData%DummyOtherState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE IceFloe_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) TYPE(IceFloe_MiscVarType), INTENT(IN) :: SrcMiscData TYPE(IceFloe_MiscVarType), INTENT(INOUT) :: DstMiscData @@ -1148,103 +562,26 @@ SUBROUTINE IceFloe_DestroyMisc( MiscData, ErrStat, ErrMsg ) END SUBROUTINE IceFloe_DestroyMisc - SUBROUTINE IceFloe_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(IceFloe_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! DummyMiscVar - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%DummyMiscVar - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE IceFloe_PackMisc - - SUBROUTINE IceFloe_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(IceFloe_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyMiscVar = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE IceFloe_UnPackMisc +subroutine IceFloe_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IceFloe_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceFloe_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyMiscVar + call RegPack(Buf, InData%DummyMiscVar) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceFloe_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IceFloe_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceFloe_UnPackMisc' + if (Buf%ErrStat /= ErrID_None) return + ! DummyMiscVar + call RegUnpack(Buf, OutData%DummyMiscVar) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE IceFloe_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(IceFloe_ParameterType), INTENT(IN) :: SrcParamData TYPE(IceFloe_ParameterType), INTENT(INOUT) :: DstParamData @@ -1355,337 +692,201 @@ SUBROUTINE IceFloe_DestroyParam( ParamData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE IceFloe_DestroyParam - SUBROUTINE IceFloe_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(IceFloe_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! loadSeries allocated yes/no - IF ( ALLOCATED(InData%loadSeries) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! loadSeries upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%loadSeries) ! loadSeries - END IF - Re_BufSz = Re_BufSz + 1 ! iceVel - Re_BufSz = Re_BufSz + 1 ! iceDirection - Re_BufSz = Re_BufSz + 1 ! minStrength - Re_BufSz = Re_BufSz + 1 ! minStrengthNegVel - Re_BufSz = Re_BufSz + 1 ! defaultArea - Re_BufSz = Re_BufSz + 1 ! crushArea - Re_BufSz = Re_BufSz + 1 ! coeffStressRate - Re_BufSz = Re_BufSz + 1 ! C(4) - Re_BufSz = Re_BufSz + 1 ! dt - Re_BufSz = Re_BufSz + 1 ! rampTime - Int_BufSz = Int_BufSz + 1 ! legX allocated yes/no - IF ( ALLOCATED(InData%legX) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! legX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%legX) ! legX - END IF - Int_BufSz = Int_BufSz + 1 ! legY allocated yes/no - IF ( ALLOCATED(InData%legY) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! legY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%legY) ! legY - END IF - Int_BufSz = Int_BufSz + 1 ! ks allocated yes/no - IF ( ALLOCATED(InData%ks) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ks upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ks) ! ks - END IF - Int_BufSz = Int_BufSz + 1 ! numLegs - Int_BufSz = Int_BufSz + 1 ! iceType - Int_BufSz = Int_BufSz + 1 ! logUnitNum - Int_BufSz = Int_BufSz + 1 ! singleLoad - Int_BufSz = Int_BufSz + 1 ! initFlag - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%loadSeries) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%loadSeries,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%loadSeries,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%loadSeries,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%loadSeries,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%loadSeries,2), UBOUND(InData%loadSeries,2) - DO i1 = LBOUND(InData%loadSeries,1), UBOUND(InData%loadSeries,1) - ReKiBuf(Re_Xferred) = InData%loadSeries(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%iceVel - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%iceDirection - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%minStrength - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%minStrengthNegVel - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%defaultArea - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%crushArea - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%coeffStressRate - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C(4) - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rampTime - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%legX) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%legX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%legX,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%legX,1), UBOUND(InData%legX,1) - ReKiBuf(Re_Xferred) = InData%legX(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%legY) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%legY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%legY,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%legY,1), UBOUND(InData%legY,1) - ReKiBuf(Re_Xferred) = InData%legY(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ks) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ks,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ks,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ks,1), UBOUND(InData%ks,1) - ReKiBuf(Re_Xferred) = InData%ks(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%numLegs - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%iceType - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%logUnitNum - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%singleLoad, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%initFlag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE IceFloe_PackParam - - SUBROUTINE IceFloe_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(IceFloe_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! loadSeries not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%loadSeries)) DEALLOCATE(OutData%loadSeries) - ALLOCATE(OutData%loadSeries(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%loadSeries.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%loadSeries,2), UBOUND(OutData%loadSeries,2) - DO i1 = LBOUND(OutData%loadSeries,1), UBOUND(OutData%loadSeries,1) - OutData%loadSeries(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%iceVel = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%iceDirection = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%minStrength = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%minStrengthNegVel = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%defaultArea = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%crushArea = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%coeffStressRate = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C(4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rampTime = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! legX not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%legX)) DEALLOCATE(OutData%legX) - ALLOCATE(OutData%legX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%legX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%legX,1), UBOUND(OutData%legX,1) - OutData%legX(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! legY not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%legY)) DEALLOCATE(OutData%legY) - ALLOCATE(OutData%legY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%legY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%legY,1), UBOUND(OutData%legY,1) - OutData%legY(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ks not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ks)) DEALLOCATE(OutData%ks) - ALLOCATE(OutData%ks(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ks.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ks,1), UBOUND(OutData%ks,1) - OutData%ks(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%numLegs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%iceType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%logUnitNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%singleLoad = TRANSFER(IntKiBuf(Int_Xferred), OutData%singleLoad) - Int_Xferred = Int_Xferred + 1 - OutData%initFlag = TRANSFER(IntKiBuf(Int_Xferred), OutData%initFlag) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE IceFloe_UnPackParam +subroutine IceFloe_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IceFloe_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceFloe_PackParam' + if (Buf%ErrStat >= AbortErrLev) return + ! loadSeries + call RegPack(Buf, allocated(InData%loadSeries)) + if (allocated(InData%loadSeries)) then + call RegPackBounds(Buf, 2, lbound(InData%loadSeries), ubound(InData%loadSeries)) + call RegPack(Buf, InData%loadSeries) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! iceVel + call RegPack(Buf, InData%iceVel) + if (RegCheckErr(Buf, RoutineName)) return + ! iceDirection + call RegPack(Buf, InData%iceDirection) + if (RegCheckErr(Buf, RoutineName)) return + ! minStrength + call RegPack(Buf, InData%minStrength) + if (RegCheckErr(Buf, RoutineName)) return + ! minStrengthNegVel + call RegPack(Buf, InData%minStrengthNegVel) + if (RegCheckErr(Buf, RoutineName)) return + ! defaultArea + call RegPack(Buf, InData%defaultArea) + if (RegCheckErr(Buf, RoutineName)) return + ! crushArea + call RegPack(Buf, InData%crushArea) + if (RegCheckErr(Buf, RoutineName)) return + ! coeffStressRate + call RegPack(Buf, InData%coeffStressRate) + if (RegCheckErr(Buf, RoutineName)) return + ! C(4) + call RegPack(Buf, InData%C(4)) + if (RegCheckErr(Buf, RoutineName)) return + ! dt + call RegPack(Buf, InData%dt) + if (RegCheckErr(Buf, RoutineName)) return + ! rampTime + call RegPack(Buf, InData%rampTime) + if (RegCheckErr(Buf, RoutineName)) return + ! legX + call RegPack(Buf, allocated(InData%legX)) + if (allocated(InData%legX)) then + call RegPackBounds(Buf, 1, lbound(InData%legX), ubound(InData%legX)) + call RegPack(Buf, InData%legX) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! legY + call RegPack(Buf, allocated(InData%legY)) + if (allocated(InData%legY)) then + call RegPackBounds(Buf, 1, lbound(InData%legY), ubound(InData%legY)) + call RegPack(Buf, InData%legY) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ks + call RegPack(Buf, allocated(InData%ks)) + if (allocated(InData%ks)) then + call RegPackBounds(Buf, 1, lbound(InData%ks), ubound(InData%ks)) + call RegPack(Buf, InData%ks) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! numLegs + call RegPack(Buf, InData%numLegs) + if (RegCheckErr(Buf, RoutineName)) return + ! iceType + call RegPack(Buf, InData%iceType) + if (RegCheckErr(Buf, RoutineName)) return + ! logUnitNum + call RegPack(Buf, InData%logUnitNum) + if (RegCheckErr(Buf, RoutineName)) return + ! singleLoad + call RegPack(Buf, InData%singleLoad) + if (RegCheckErr(Buf, RoutineName)) return + ! initFlag + call RegPack(Buf, InData%initFlag) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceFloe_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IceFloe_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceFloe_UnPackParam' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! loadSeries + if (allocated(OutData%loadSeries)) deallocate(OutData%loadSeries) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%loadSeries(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%loadSeries.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%loadSeries) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! iceVel + call RegUnpack(Buf, OutData%iceVel) + if (RegCheckErr(Buf, RoutineName)) return + ! iceDirection + call RegUnpack(Buf, OutData%iceDirection) + if (RegCheckErr(Buf, RoutineName)) return + ! minStrength + call RegUnpack(Buf, OutData%minStrength) + if (RegCheckErr(Buf, RoutineName)) return + ! minStrengthNegVel + call RegUnpack(Buf, OutData%minStrengthNegVel) + if (RegCheckErr(Buf, RoutineName)) return + ! defaultArea + call RegUnpack(Buf, OutData%defaultArea) + if (RegCheckErr(Buf, RoutineName)) return + ! crushArea + call RegUnpack(Buf, OutData%crushArea) + if (RegCheckErr(Buf, RoutineName)) return + ! coeffStressRate + call RegUnpack(Buf, OutData%coeffStressRate) + if (RegCheckErr(Buf, RoutineName)) return + ! C(4) + call RegUnpack(Buf, OutData%C(4)) + if (RegCheckErr(Buf, RoutineName)) return + ! dt + call RegUnpack(Buf, OutData%dt) + if (RegCheckErr(Buf, RoutineName)) return + ! rampTime + call RegUnpack(Buf, OutData%rampTime) + if (RegCheckErr(Buf, RoutineName)) return + ! legX + if (allocated(OutData%legX)) deallocate(OutData%legX) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%legX(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%legX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%legX) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! legY + if (allocated(OutData%legY)) deallocate(OutData%legY) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%legY(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%legY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%legY) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ks + if (allocated(OutData%ks)) deallocate(OutData%ks) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ks(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ks.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ks) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! numLegs + call RegUnpack(Buf, OutData%numLegs) + if (RegCheckErr(Buf, RoutineName)) return + ! iceType + call RegUnpack(Buf, OutData%iceType) + if (RegCheckErr(Buf, RoutineName)) return + ! logUnitNum + call RegUnpack(Buf, OutData%logUnitNum) + if (RegCheckErr(Buf, RoutineName)) return + ! singleLoad + call RegUnpack(Buf, OutData%singleLoad) + if (RegCheckErr(Buf, RoutineName)) return + ! initFlag + call RegUnpack(Buf, OutData%initFlag) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE IceFloe_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(IceFloe_InputType), INTENT(INOUT) :: SrcInputData TYPE(IceFloe_InputType), INTENT(INOUT) :: DstInputData @@ -1722,184 +923,25 @@ SUBROUTINE IceFloe_DestroyInput( InputData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE IceFloe_DestroyInput - SUBROUTINE IceFloe_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(IceFloe_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! iceMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%iceMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! iceMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! iceMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! iceMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! iceMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL MeshPack( InData%iceMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! iceMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE IceFloe_PackInput - - SUBROUTINE IceFloe_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(IceFloe_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%iceMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! iceMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE IceFloe_UnPackInput +subroutine IceFloe_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IceFloe_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceFloe_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + ! iceMesh + call MeshPack(Buf, InData%iceMesh) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceFloe_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IceFloe_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceFloe_UnPackInput' + if (Buf%ErrStat /= ErrID_None) return + ! iceMesh + call MeshUnpack(Buf, OutData%iceMesh) ! iceMesh +end subroutine SUBROUTINE IceFloe_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(IceFloe_OutputType), INTENT(INOUT) :: SrcOutputData TYPE(IceFloe_OutputType), INTENT(INOUT) :: DstOutputData @@ -1952,223 +994,50 @@ SUBROUTINE IceFloe_DestroyOutput( OutputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE IceFloe_DestroyOutput - SUBROUTINE IceFloe_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(IceFloe_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! iceMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%iceMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! iceMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! iceMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! iceMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! iceMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutput allocated yes/no - IF ( ALLOCATED(InData%WriteOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutput upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WriteOutput) ! WriteOutput - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL MeshPack( InData%iceMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! iceMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) - ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE IceFloe_PackOutput - - SUBROUTINE IceFloe_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(IceFloe_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%iceMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! iceMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutput)) DEALLOCATE(OutData%WriteOutput) - ALLOCATE(OutData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) - OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE IceFloe_UnPackOutput +subroutine IceFloe_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IceFloe_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IceFloe_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! iceMesh + call MeshPack(Buf, InData%iceMesh) + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutput + call RegPack(Buf, allocated(InData%WriteOutput)) + if (allocated(InData%WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPack(Buf, InData%WriteOutput) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IceFloe_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IceFloe_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IceFloe_UnPackOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! iceMesh + call MeshUnpack(Buf, OutData%iceMesh) ! iceMesh + ! WriteOutput + if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE IceFloe_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) ! diff --git a/modules/inflowwind/src/IfW_FlowField_Types.f90 b/modules/inflowwind/src/IfW_FlowField_Types.f90 index f37bbc73cd..437c9e6280 100644 --- a/modules/inflowwind/src/IfW_FlowField_Types.f90 +++ b/modules/inflowwind/src/IfW_FlowField_Types.f90 @@ -456,760 +456,415 @@ SUBROUTINE IfW_FlowField_DestroyUniformFieldType( UniformFieldTypeData, ErrStat, ENDIF END SUBROUTINE IfW_FlowField_DestroyUniformFieldType - SUBROUTINE IfW_FlowField_PackUniformFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(UniformFieldType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_PackUniformFieldType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! RefHeight - Re_BufSz = Re_BufSz + 1 ! RefLength - Int_BufSz = Int_BufSz + 1 ! DataSize - Int_BufSz = Int_BufSz + 1 ! Time allocated yes/no - IF ( ALLOCATED(InData%Time) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Time upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Time) ! Time - END IF - Int_BufSz = Int_BufSz + 1 ! VelH allocated yes/no - IF ( ALLOCATED(InData%VelH) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! VelH upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%VelH) ! VelH - END IF - Int_BufSz = Int_BufSz + 1 ! VelHDot allocated yes/no - IF ( ALLOCATED(InData%VelHDot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! VelHDot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%VelHDot) ! VelHDot - END IF - Int_BufSz = Int_BufSz + 1 ! VelV allocated yes/no - IF ( ALLOCATED(InData%VelV) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! VelV upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%VelV) ! VelV - END IF - Int_BufSz = Int_BufSz + 1 ! VelVDot allocated yes/no - IF ( ALLOCATED(InData%VelVDot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! VelVDot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%VelVDot) ! VelVDot - END IF - Int_BufSz = Int_BufSz + 1 ! VelGust allocated yes/no - IF ( ALLOCATED(InData%VelGust) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! VelGust upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%VelGust) ! VelGust - END IF - Int_BufSz = Int_BufSz + 1 ! VelGustDot allocated yes/no - IF ( ALLOCATED(InData%VelGustDot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! VelGustDot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%VelGustDot) ! VelGustDot - END IF - Int_BufSz = Int_BufSz + 1 ! AngleH allocated yes/no - IF ( ALLOCATED(InData%AngleH) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AngleH upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AngleH) ! AngleH - END IF - Int_BufSz = Int_BufSz + 1 ! AngleHDot allocated yes/no - IF ( ALLOCATED(InData%AngleHDot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AngleHDot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AngleHDot) ! AngleHDot - END IF - Int_BufSz = Int_BufSz + 1 ! AngleV allocated yes/no - IF ( ALLOCATED(InData%AngleV) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AngleV upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AngleV) ! AngleV - END IF - Int_BufSz = Int_BufSz + 1 ! AngleVDot allocated yes/no - IF ( ALLOCATED(InData%AngleVDot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AngleVDot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AngleVDot) ! AngleVDot - END IF - Int_BufSz = Int_BufSz + 1 ! ShrH allocated yes/no - IF ( ALLOCATED(InData%ShrH) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ShrH upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ShrH) ! ShrH - END IF - Int_BufSz = Int_BufSz + 1 ! ShrHDot allocated yes/no - IF ( ALLOCATED(InData%ShrHDot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ShrHDot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ShrHDot) ! ShrHDot - END IF - Int_BufSz = Int_BufSz + 1 ! ShrV allocated yes/no - IF ( ALLOCATED(InData%ShrV) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ShrV upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ShrV) ! ShrV - END IF - Int_BufSz = Int_BufSz + 1 ! ShrVDot allocated yes/no - IF ( ALLOCATED(InData%ShrVDot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ShrVDot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ShrVDot) ! ShrVDot - END IF - Int_BufSz = Int_BufSz + 1 ! LinShrV allocated yes/no - IF ( ALLOCATED(InData%LinShrV) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinShrV upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LinShrV) ! LinShrV - END IF - Int_BufSz = Int_BufSz + 1 ! LinShrVDot allocated yes/no - IF ( ALLOCATED(InData%LinShrVDot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinShrVDot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LinShrVDot) ! LinShrVDot - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%RefHeight - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RefLength - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%DataSize - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Time) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Time,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Time,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Time,1), UBOUND(InData%Time,1) - ReKiBuf(Re_Xferred) = InData%Time(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%VelH) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VelH,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VelH,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%VelH,1), UBOUND(InData%VelH,1) - ReKiBuf(Re_Xferred) = InData%VelH(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%VelHDot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VelHDot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VelHDot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%VelHDot,1), UBOUND(InData%VelHDot,1) - ReKiBuf(Re_Xferred) = InData%VelHDot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%VelV) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VelV,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VelV,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%VelV,1), UBOUND(InData%VelV,1) - ReKiBuf(Re_Xferred) = InData%VelV(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%VelVDot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VelVDot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VelVDot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%VelVDot,1), UBOUND(InData%VelVDot,1) - ReKiBuf(Re_Xferred) = InData%VelVDot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%VelGust) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VelGust,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VelGust,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%VelGust,1), UBOUND(InData%VelGust,1) - ReKiBuf(Re_Xferred) = InData%VelGust(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%VelGustDot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VelGustDot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VelGustDot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%VelGustDot,1), UBOUND(InData%VelGustDot,1) - ReKiBuf(Re_Xferred) = InData%VelGustDot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AngleH) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngleH,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngleH,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AngleH,1), UBOUND(InData%AngleH,1) - ReKiBuf(Re_Xferred) = InData%AngleH(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AngleHDot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngleHDot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngleHDot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AngleHDot,1), UBOUND(InData%AngleHDot,1) - ReKiBuf(Re_Xferred) = InData%AngleHDot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AngleV) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngleV,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngleV,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AngleV,1), UBOUND(InData%AngleV,1) - ReKiBuf(Re_Xferred) = InData%AngleV(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AngleVDot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AngleVDot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngleVDot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AngleVDot,1), UBOUND(InData%AngleVDot,1) - ReKiBuf(Re_Xferred) = InData%AngleVDot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ShrH) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ShrH,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ShrH,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ShrH,1), UBOUND(InData%ShrH,1) - ReKiBuf(Re_Xferred) = InData%ShrH(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ShrHDot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ShrHDot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ShrHDot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ShrHDot,1), UBOUND(InData%ShrHDot,1) - ReKiBuf(Re_Xferred) = InData%ShrHDot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ShrV) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ShrV,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ShrV,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ShrV,1), UBOUND(InData%ShrV,1) - ReKiBuf(Re_Xferred) = InData%ShrV(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ShrVDot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ShrVDot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ShrVDot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ShrVDot,1), UBOUND(InData%ShrVDot,1) - ReKiBuf(Re_Xferred) = InData%ShrVDot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinShrV) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinShrV,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinShrV,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinShrV,1), UBOUND(InData%LinShrV,1) - ReKiBuf(Re_Xferred) = InData%LinShrV(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinShrVDot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinShrVDot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinShrVDot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinShrVDot,1), UBOUND(InData%LinShrVDot,1) - ReKiBuf(Re_Xferred) = InData%LinShrVDot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE IfW_FlowField_PackUniformFieldType - - SUBROUTINE IfW_FlowField_UnPackUniformFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(UniformFieldType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_UnPackUniformFieldType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%RefHeight = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RefLength = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DataSize = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Time not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Time)) DEALLOCATE(OutData%Time) - ALLOCATE(OutData%Time(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Time.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Time,1), UBOUND(OutData%Time,1) - OutData%Time(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VelH not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%VelH)) DEALLOCATE(OutData%VelH) - ALLOCATE(OutData%VelH(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelH.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%VelH,1), UBOUND(OutData%VelH,1) - OutData%VelH(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VelHDot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%VelHDot)) DEALLOCATE(OutData%VelHDot) - ALLOCATE(OutData%VelHDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelHDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%VelHDot,1), UBOUND(OutData%VelHDot,1) - OutData%VelHDot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VelV not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%VelV)) DEALLOCATE(OutData%VelV) - ALLOCATE(OutData%VelV(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%VelV,1), UBOUND(OutData%VelV,1) - OutData%VelV(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VelVDot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%VelVDot)) DEALLOCATE(OutData%VelVDot) - ALLOCATE(OutData%VelVDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelVDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%VelVDot,1), UBOUND(OutData%VelVDot,1) - OutData%VelVDot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VelGust not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%VelGust)) DEALLOCATE(OutData%VelGust) - ALLOCATE(OutData%VelGust(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelGust.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%VelGust,1), UBOUND(OutData%VelGust,1) - OutData%VelGust(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VelGustDot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%VelGustDot)) DEALLOCATE(OutData%VelGustDot) - ALLOCATE(OutData%VelGustDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelGustDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%VelGustDot,1), UBOUND(OutData%VelGustDot,1) - OutData%VelGustDot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngleH not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AngleH)) DEALLOCATE(OutData%AngleH) - ALLOCATE(OutData%AngleH(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngleH.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AngleH,1), UBOUND(OutData%AngleH,1) - OutData%AngleH(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngleHDot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AngleHDot)) DEALLOCATE(OutData%AngleHDot) - ALLOCATE(OutData%AngleHDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngleHDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AngleHDot,1), UBOUND(OutData%AngleHDot,1) - OutData%AngleHDot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngleV not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AngleV)) DEALLOCATE(OutData%AngleV) - ALLOCATE(OutData%AngleV(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngleV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AngleV,1), UBOUND(OutData%AngleV,1) - OutData%AngleV(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngleVDot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AngleVDot)) DEALLOCATE(OutData%AngleVDot) - ALLOCATE(OutData%AngleVDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngleVDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AngleVDot,1), UBOUND(OutData%AngleVDot,1) - OutData%AngleVDot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ShrH not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ShrH)) DEALLOCATE(OutData%ShrH) - ALLOCATE(OutData%ShrH(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ShrH.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ShrH,1), UBOUND(OutData%ShrH,1) - OutData%ShrH(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ShrHDot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ShrHDot)) DEALLOCATE(OutData%ShrHDot) - ALLOCATE(OutData%ShrHDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ShrHDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ShrHDot,1), UBOUND(OutData%ShrHDot,1) - OutData%ShrHDot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ShrV not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ShrV)) DEALLOCATE(OutData%ShrV) - ALLOCATE(OutData%ShrV(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ShrV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ShrV,1), UBOUND(OutData%ShrV,1) - OutData%ShrV(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ShrVDot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ShrVDot)) DEALLOCATE(OutData%ShrVDot) - ALLOCATE(OutData%ShrVDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ShrVDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ShrVDot,1), UBOUND(OutData%ShrVDot,1) - OutData%ShrVDot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinShrV not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LinShrV)) DEALLOCATE(OutData%LinShrV) - ALLOCATE(OutData%LinShrV(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinShrV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinShrV,1), UBOUND(OutData%LinShrV,1) - OutData%LinShrV(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinShrVDot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LinShrVDot)) DEALLOCATE(OutData%LinShrVDot) - ALLOCATE(OutData%LinShrVDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinShrVDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinShrVDot,1), UBOUND(OutData%LinShrVDot,1) - OutData%LinShrVDot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE IfW_FlowField_UnPackUniformFieldType +subroutine IfW_FlowField_PackUniformFieldType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(UniformFieldType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IfW_FlowField_PackUniformFieldType' + if (Buf%ErrStat >= AbortErrLev) return + ! RefHeight + call RegPack(Buf, InData%RefHeight) + if (RegCheckErr(Buf, RoutineName)) return + ! RefLength + call RegPack(Buf, InData%RefLength) + if (RegCheckErr(Buf, RoutineName)) return + ! DataSize + call RegPack(Buf, InData%DataSize) + if (RegCheckErr(Buf, RoutineName)) return + ! Time + call RegPack(Buf, allocated(InData%Time)) + if (allocated(InData%Time)) then + call RegPackBounds(Buf, 1, lbound(InData%Time), ubound(InData%Time)) + call RegPack(Buf, InData%Time) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! VelH + call RegPack(Buf, allocated(InData%VelH)) + if (allocated(InData%VelH)) then + call RegPackBounds(Buf, 1, lbound(InData%VelH), ubound(InData%VelH)) + call RegPack(Buf, InData%VelH) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! VelHDot + call RegPack(Buf, allocated(InData%VelHDot)) + if (allocated(InData%VelHDot)) then + call RegPackBounds(Buf, 1, lbound(InData%VelHDot), ubound(InData%VelHDot)) + call RegPack(Buf, InData%VelHDot) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! VelV + call RegPack(Buf, allocated(InData%VelV)) + if (allocated(InData%VelV)) then + call RegPackBounds(Buf, 1, lbound(InData%VelV), ubound(InData%VelV)) + call RegPack(Buf, InData%VelV) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! VelVDot + call RegPack(Buf, allocated(InData%VelVDot)) + if (allocated(InData%VelVDot)) then + call RegPackBounds(Buf, 1, lbound(InData%VelVDot), ubound(InData%VelVDot)) + call RegPack(Buf, InData%VelVDot) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! VelGust + call RegPack(Buf, allocated(InData%VelGust)) + if (allocated(InData%VelGust)) then + call RegPackBounds(Buf, 1, lbound(InData%VelGust), ubound(InData%VelGust)) + call RegPack(Buf, InData%VelGust) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! VelGustDot + call RegPack(Buf, allocated(InData%VelGustDot)) + if (allocated(InData%VelGustDot)) then + call RegPackBounds(Buf, 1, lbound(InData%VelGustDot), ubound(InData%VelGustDot)) + call RegPack(Buf, InData%VelGustDot) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AngleH + call RegPack(Buf, allocated(InData%AngleH)) + if (allocated(InData%AngleH)) then + call RegPackBounds(Buf, 1, lbound(InData%AngleH), ubound(InData%AngleH)) + call RegPack(Buf, InData%AngleH) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AngleHDot + call RegPack(Buf, allocated(InData%AngleHDot)) + if (allocated(InData%AngleHDot)) then + call RegPackBounds(Buf, 1, lbound(InData%AngleHDot), ubound(InData%AngleHDot)) + call RegPack(Buf, InData%AngleHDot) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AngleV + call RegPack(Buf, allocated(InData%AngleV)) + if (allocated(InData%AngleV)) then + call RegPackBounds(Buf, 1, lbound(InData%AngleV), ubound(InData%AngleV)) + call RegPack(Buf, InData%AngleV) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AngleVDot + call RegPack(Buf, allocated(InData%AngleVDot)) + if (allocated(InData%AngleVDot)) then + call RegPackBounds(Buf, 1, lbound(InData%AngleVDot), ubound(InData%AngleVDot)) + call RegPack(Buf, InData%AngleVDot) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ShrH + call RegPack(Buf, allocated(InData%ShrH)) + if (allocated(InData%ShrH)) then + call RegPackBounds(Buf, 1, lbound(InData%ShrH), ubound(InData%ShrH)) + call RegPack(Buf, InData%ShrH) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ShrHDot + call RegPack(Buf, allocated(InData%ShrHDot)) + if (allocated(InData%ShrHDot)) then + call RegPackBounds(Buf, 1, lbound(InData%ShrHDot), ubound(InData%ShrHDot)) + call RegPack(Buf, InData%ShrHDot) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ShrV + call RegPack(Buf, allocated(InData%ShrV)) + if (allocated(InData%ShrV)) then + call RegPackBounds(Buf, 1, lbound(InData%ShrV), ubound(InData%ShrV)) + call RegPack(Buf, InData%ShrV) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ShrVDot + call RegPack(Buf, allocated(InData%ShrVDot)) + if (allocated(InData%ShrVDot)) then + call RegPackBounds(Buf, 1, lbound(InData%ShrVDot), ubound(InData%ShrVDot)) + call RegPack(Buf, InData%ShrVDot) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LinShrV + call RegPack(Buf, allocated(InData%LinShrV)) + if (allocated(InData%LinShrV)) then + call RegPackBounds(Buf, 1, lbound(InData%LinShrV), ubound(InData%LinShrV)) + call RegPack(Buf, InData%LinShrV) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LinShrVDot + call RegPack(Buf, allocated(InData%LinShrVDot)) + if (allocated(InData%LinShrVDot)) then + call RegPackBounds(Buf, 1, lbound(InData%LinShrVDot), ubound(InData%LinShrVDot)) + call RegPack(Buf, InData%LinShrVDot) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IfW_FlowField_UnPackUniformFieldType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(UniformFieldType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IfW_FlowField_UnPackUniformFieldType' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! RefHeight + call RegUnpack(Buf, OutData%RefHeight) + if (RegCheckErr(Buf, RoutineName)) return + ! RefLength + call RegUnpack(Buf, OutData%RefLength) + if (RegCheckErr(Buf, RoutineName)) return + ! DataSize + call RegUnpack(Buf, OutData%DataSize) + if (RegCheckErr(Buf, RoutineName)) return + ! Time + if (allocated(OutData%Time)) deallocate(OutData%Time) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Time(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Time.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Time) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! VelH + if (allocated(OutData%VelH)) deallocate(OutData%VelH) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%VelH(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelH.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%VelH) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! VelHDot + if (allocated(OutData%VelHDot)) deallocate(OutData%VelHDot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%VelHDot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelHDot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%VelHDot) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! VelV + if (allocated(OutData%VelV)) deallocate(OutData%VelV) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%VelV(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelV.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%VelV) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! VelVDot + if (allocated(OutData%VelVDot)) deallocate(OutData%VelVDot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%VelVDot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelVDot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%VelVDot) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! VelGust + if (allocated(OutData%VelGust)) deallocate(OutData%VelGust) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%VelGust(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelGust.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%VelGust) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! VelGustDot + if (allocated(OutData%VelGustDot)) deallocate(OutData%VelGustDot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%VelGustDot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelGustDot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%VelGustDot) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AngleH + if (allocated(OutData%AngleH)) deallocate(OutData%AngleH) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AngleH(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngleH.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AngleH) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AngleHDot + if (allocated(OutData%AngleHDot)) deallocate(OutData%AngleHDot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AngleHDot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngleHDot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AngleHDot) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AngleV + if (allocated(OutData%AngleV)) deallocate(OutData%AngleV) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AngleV(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngleV.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AngleV) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AngleVDot + if (allocated(OutData%AngleVDot)) deallocate(OutData%AngleVDot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AngleVDot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngleVDot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AngleVDot) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ShrH + if (allocated(OutData%ShrH)) deallocate(OutData%ShrH) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ShrH(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ShrH.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ShrH) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ShrHDot + if (allocated(OutData%ShrHDot)) deallocate(OutData%ShrHDot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ShrHDot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ShrHDot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ShrHDot) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ShrV + if (allocated(OutData%ShrV)) deallocate(OutData%ShrV) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ShrV(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ShrV.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ShrV) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ShrVDot + if (allocated(OutData%ShrVDot)) deallocate(OutData%ShrVDot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ShrVDot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ShrVDot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ShrVDot) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LinShrV + if (allocated(OutData%LinShrV)) deallocate(OutData%LinShrV) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinShrV(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinShrV.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinShrV) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LinShrVDot + if (allocated(OutData%LinShrVDot)) deallocate(OutData%LinShrVDot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinShrVDot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinShrVDot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinShrVDot) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE IfW_FlowField_CopyUniformField_Interp( SrcUniformField_InterpData, DstUniformField_InterpData, CtrlCode, ErrStat, ErrMsg ) TYPE(UniformField_Interp), INTENT(IN) :: SrcUniformField_InterpData TYPE(UniformField_Interp), INTENT(INOUT) :: DstUniformField_InterpData @@ -1261,198 +916,140 @@ SUBROUTINE IfW_FlowField_DestroyUniformField_Interp( UniformField_InterpData, Er END SUBROUTINE IfW_FlowField_DestroyUniformField_Interp - SUBROUTINE IfW_FlowField_PackUniformField_Interp( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(UniformField_Interp), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_PackUniformField_Interp' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! VelH - Re_BufSz = Re_BufSz + 1 ! VelHDot - Re_BufSz = Re_BufSz + 1 ! VelV - Re_BufSz = Re_BufSz + 1 ! VelVDot - Re_BufSz = Re_BufSz + 1 ! VelGust - Re_BufSz = Re_BufSz + 1 ! VelGustDot - Re_BufSz = Re_BufSz + 1 ! AngleH - Re_BufSz = Re_BufSz + 1 ! AngleHDot - Re_BufSz = Re_BufSz + 1 ! AngleV - Re_BufSz = Re_BufSz + 1 ! AngleVDot - Re_BufSz = Re_BufSz + 1 ! ShrH - Re_BufSz = Re_BufSz + 1 ! ShrHDot - Re_BufSz = Re_BufSz + 1 ! ShrV - Re_BufSz = Re_BufSz + 1 ! ShrVDot - Re_BufSz = Re_BufSz + 1 ! LinShrV - Re_BufSz = Re_BufSz + 1 ! LinShrVDot - Re_BufSz = Re_BufSz + 1 ! CosAngleH - Re_BufSz = Re_BufSz + 1 ! SinAngleH - Re_BufSz = Re_BufSz + 1 ! CosAngleV - Re_BufSz = Re_BufSz + 1 ! SinAngleV - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%VelH - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VelHDot - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VelV - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VelVDot - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VelGust - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VelGustDot - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AngleH - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AngleHDot - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AngleV - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AngleVDot - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ShrH - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ShrHDot - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ShrV - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ShrVDot - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LinShrV - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LinShrVDot - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CosAngleH - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SinAngleH - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CosAngleV - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SinAngleV - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IfW_FlowField_PackUniformField_Interp - - SUBROUTINE IfW_FlowField_UnPackUniformField_Interp( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(UniformField_Interp), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_UnPackUniformField_Interp' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%VelH = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VelHDot = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VelV = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VelVDot = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VelGust = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VelGustDot = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AngleH = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AngleHDot = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AngleV = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AngleVDot = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ShrH = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ShrHDot = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ShrV = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ShrVDot = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LinShrV = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LinShrVDot = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CosAngleH = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SinAngleH = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CosAngleV = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SinAngleV = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IfW_FlowField_UnPackUniformField_Interp +subroutine IfW_FlowField_PackUniformField_Interp(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(UniformField_Interp), intent(in) :: InData + character(*), parameter :: RoutineName = 'IfW_FlowField_PackUniformField_Interp' + if (Buf%ErrStat >= AbortErrLev) return + ! VelH + call RegPack(Buf, InData%VelH) + if (RegCheckErr(Buf, RoutineName)) return + ! VelHDot + call RegPack(Buf, InData%VelHDot) + if (RegCheckErr(Buf, RoutineName)) return + ! VelV + call RegPack(Buf, InData%VelV) + if (RegCheckErr(Buf, RoutineName)) return + ! VelVDot + call RegPack(Buf, InData%VelVDot) + if (RegCheckErr(Buf, RoutineName)) return + ! VelGust + call RegPack(Buf, InData%VelGust) + if (RegCheckErr(Buf, RoutineName)) return + ! VelGustDot + call RegPack(Buf, InData%VelGustDot) + if (RegCheckErr(Buf, RoutineName)) return + ! AngleH + call RegPack(Buf, InData%AngleH) + if (RegCheckErr(Buf, RoutineName)) return + ! AngleHDot + call RegPack(Buf, InData%AngleHDot) + if (RegCheckErr(Buf, RoutineName)) return + ! AngleV + call RegPack(Buf, InData%AngleV) + if (RegCheckErr(Buf, RoutineName)) return + ! AngleVDot + call RegPack(Buf, InData%AngleVDot) + if (RegCheckErr(Buf, RoutineName)) return + ! ShrH + call RegPack(Buf, InData%ShrH) + if (RegCheckErr(Buf, RoutineName)) return + ! ShrHDot + call RegPack(Buf, InData%ShrHDot) + if (RegCheckErr(Buf, RoutineName)) return + ! ShrV + call RegPack(Buf, InData%ShrV) + if (RegCheckErr(Buf, RoutineName)) return + ! ShrVDot + call RegPack(Buf, InData%ShrVDot) + if (RegCheckErr(Buf, RoutineName)) return + ! LinShrV + call RegPack(Buf, InData%LinShrV) + if (RegCheckErr(Buf, RoutineName)) return + ! LinShrVDot + call RegPack(Buf, InData%LinShrVDot) + if (RegCheckErr(Buf, RoutineName)) return + ! CosAngleH + call RegPack(Buf, InData%CosAngleH) + if (RegCheckErr(Buf, RoutineName)) return + ! SinAngleH + call RegPack(Buf, InData%SinAngleH) + if (RegCheckErr(Buf, RoutineName)) return + ! CosAngleV + call RegPack(Buf, InData%CosAngleV) + if (RegCheckErr(Buf, RoutineName)) return + ! SinAngleV + call RegPack(Buf, InData%SinAngleV) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IfW_FlowField_UnPackUniformField_Interp(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(UniformField_Interp), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IfW_FlowField_UnPackUniformField_Interp' + if (Buf%ErrStat /= ErrID_None) return + ! VelH + call RegUnpack(Buf, OutData%VelH) + if (RegCheckErr(Buf, RoutineName)) return + ! VelHDot + call RegUnpack(Buf, OutData%VelHDot) + if (RegCheckErr(Buf, RoutineName)) return + ! VelV + call RegUnpack(Buf, OutData%VelV) + if (RegCheckErr(Buf, RoutineName)) return + ! VelVDot + call RegUnpack(Buf, OutData%VelVDot) + if (RegCheckErr(Buf, RoutineName)) return + ! VelGust + call RegUnpack(Buf, OutData%VelGust) + if (RegCheckErr(Buf, RoutineName)) return + ! VelGustDot + call RegUnpack(Buf, OutData%VelGustDot) + if (RegCheckErr(Buf, RoutineName)) return + ! AngleH + call RegUnpack(Buf, OutData%AngleH) + if (RegCheckErr(Buf, RoutineName)) return + ! AngleHDot + call RegUnpack(Buf, OutData%AngleHDot) + if (RegCheckErr(Buf, RoutineName)) return + ! AngleV + call RegUnpack(Buf, OutData%AngleV) + if (RegCheckErr(Buf, RoutineName)) return + ! AngleVDot + call RegUnpack(Buf, OutData%AngleVDot) + if (RegCheckErr(Buf, RoutineName)) return + ! ShrH + call RegUnpack(Buf, OutData%ShrH) + if (RegCheckErr(Buf, RoutineName)) return + ! ShrHDot + call RegUnpack(Buf, OutData%ShrHDot) + if (RegCheckErr(Buf, RoutineName)) return + ! ShrV + call RegUnpack(Buf, OutData%ShrV) + if (RegCheckErr(Buf, RoutineName)) return + ! ShrVDot + call RegUnpack(Buf, OutData%ShrVDot) + if (RegCheckErr(Buf, RoutineName)) return + ! LinShrV + call RegUnpack(Buf, OutData%LinShrV) + if (RegCheckErr(Buf, RoutineName)) return + ! LinShrVDot + call RegUnpack(Buf, OutData%LinShrVDot) + if (RegCheckErr(Buf, RoutineName)) return + ! CosAngleH + call RegUnpack(Buf, OutData%CosAngleH) + if (RegCheckErr(Buf, RoutineName)) return + ! SinAngleH + call RegUnpack(Buf, OutData%SinAngleH) + if (RegCheckErr(Buf, RoutineName)) return + ! CosAngleV + call RegUnpack(Buf, OutData%CosAngleV) + if (RegCheckErr(Buf, RoutineName)) return + ! SinAngleV + call RegUnpack(Buf, OutData%SinAngleV) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE IfW_FlowField_CopyGrid3DFieldType( SrcGrid3DFieldTypeData, DstGrid3DFieldTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(Grid3DFieldType), INTENT(IN) :: SrcGrid3DFieldTypeData TYPE(Grid3DFieldType), INTENT(INOUT) :: DstGrid3DFieldTypeData @@ -1636,620 +1233,335 @@ SUBROUTINE IfW_FlowField_DestroyGrid3DFieldType( Grid3DFieldTypeData, ErrStat, E ENDIF END SUBROUTINE IfW_FlowField_DestroyGrid3DFieldType - SUBROUTINE IfW_FlowField_PackGrid3DFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Grid3DFieldType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_PackGrid3DFieldType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! WindFileFormat - Int_BufSz = Int_BufSz + 1 ! WindProfileType - Int_BufSz = Int_BufSz + 1 ! Periodic - Int_BufSz = Int_BufSz + 1 ! InterpTower - Int_BufSz = Int_BufSz + 1 ! AddMeanAfterInterp - Re_BufSz = Re_BufSz + 1 ! RefHeight - Re_BufSz = Re_BufSz + 1 ! RefLength - Int_BufSz = Int_BufSz + 1 ! Vel allocated yes/no - IF ( ALLOCATED(InData%Vel) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Vel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vel) ! Vel - END IF - Int_BufSz = Int_BufSz + 1 ! Acc allocated yes/no - IF ( ALLOCATED(InData%Acc) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Acc upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Acc) ! Acc - END IF - Int_BufSz = Int_BufSz + 1 ! VelTower allocated yes/no - IF ( ALLOCATED(InData%VelTower) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! VelTower upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%VelTower) ! VelTower - END IF - Int_BufSz = Int_BufSz + 1 ! AccTower allocated yes/no - IF ( ALLOCATED(InData%AccTower) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AccTower upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AccTower) ! AccTower - END IF - Int_BufSz = Int_BufSz + 1 ! VelAvg allocated yes/no - IF ( ALLOCATED(InData%VelAvg) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! VelAvg upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%VelAvg) ! VelAvg - END IF - Int_BufSz = Int_BufSz + 1 ! AccAvg allocated yes/no - IF ( ALLOCATED(InData%AccAvg) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AccAvg upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AccAvg) ! AccAvg - END IF - Re_BufSz = Re_BufSz + 1 ! DTime - Re_BufSz = Re_BufSz + 1 ! Rate - Re_BufSz = Re_BufSz + 1 ! YHWid - Re_BufSz = Re_BufSz + 1 ! ZHWid - Re_BufSz = Re_BufSz + 1 ! GridBase - Re_BufSz = Re_BufSz + 1 ! InitXPosition - Re_BufSz = Re_BufSz + 1 ! InvDY - Re_BufSz = Re_BufSz + 1 ! InvDZ - Re_BufSz = Re_BufSz + 1 ! MeanWS - Re_BufSz = Re_BufSz + 1 ! InvMWS - Re_BufSz = Re_BufSz + 1 ! TotalTime - Int_BufSz = Int_BufSz + 1 ! NComp - Int_BufSz = Int_BufSz + 1 ! NYGrids - Int_BufSz = Int_BufSz + 1 ! NZGrids - Int_BufSz = Int_BufSz + 1 ! NTGrids - Int_BufSz = Int_BufSz + 1 ! NSteps - Re_BufSz = Re_BufSz + 1 ! PLExp - Re_BufSz = Re_BufSz + 1 ! Z0 - Re_BufSz = Re_BufSz + 1 ! VLinShr - Re_BufSz = Re_BufSz + 1 ! HLinShr - Int_BufSz = Int_BufSz + 1 ! BoxExceedAllowF - Int_BufSz = Int_BufSz + 1 ! BoxExceedAllowIdx - Int_BufSz = Int_BufSz + 1 ! BoxExceedWarned - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%WindFileFormat - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WindProfileType - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Periodic, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%InterpTower, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%AddMeanAfterInterp, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RefHeight - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RefLength - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Vel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vel,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vel,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vel,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vel,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vel,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Vel,4), UBOUND(InData%Vel,4) - DO i3 = LBOUND(InData%Vel,3), UBOUND(InData%Vel,3) - DO i2 = LBOUND(InData%Vel,2), UBOUND(InData%Vel,2) - DO i1 = LBOUND(InData%Vel,1), UBOUND(InData%Vel,1) - ReKiBuf(Re_Xferred) = InData%Vel(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Acc) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Acc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Acc,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Acc,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Acc,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Acc,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Acc,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Acc,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Acc,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Acc,4), UBOUND(InData%Acc,4) - DO i3 = LBOUND(InData%Acc,3), UBOUND(InData%Acc,3) - DO i2 = LBOUND(InData%Acc,2), UBOUND(InData%Acc,2) - DO i1 = LBOUND(InData%Acc,1), UBOUND(InData%Acc,1) - ReKiBuf(Re_Xferred) = InData%Acc(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%VelTower) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VelTower,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VelTower,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VelTower,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VelTower,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VelTower,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VelTower,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%VelTower,3), UBOUND(InData%VelTower,3) - DO i2 = LBOUND(InData%VelTower,2), UBOUND(InData%VelTower,2) - DO i1 = LBOUND(InData%VelTower,1), UBOUND(InData%VelTower,1) - ReKiBuf(Re_Xferred) = InData%VelTower(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AccTower) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AccTower,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AccTower,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AccTower,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AccTower,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AccTower,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AccTower,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AccTower,3), UBOUND(InData%AccTower,3) - DO i2 = LBOUND(InData%AccTower,2), UBOUND(InData%AccTower,2) - DO i1 = LBOUND(InData%AccTower,1), UBOUND(InData%AccTower,1) - ReKiBuf(Re_Xferred) = InData%AccTower(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%VelAvg) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VelAvg,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VelAvg,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VelAvg,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VelAvg,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VelAvg,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VelAvg,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%VelAvg,3), UBOUND(InData%VelAvg,3) - DO i2 = LBOUND(InData%VelAvg,2), UBOUND(InData%VelAvg,2) - DO i1 = LBOUND(InData%VelAvg,1), UBOUND(InData%VelAvg,1) - ReKiBuf(Re_Xferred) = InData%VelAvg(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AccAvg) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AccAvg,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AccAvg,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AccAvg,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AccAvg,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AccAvg,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AccAvg,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AccAvg,3), UBOUND(InData%AccAvg,3) - DO i2 = LBOUND(InData%AccAvg,2), UBOUND(InData%AccAvg,2) - DO i1 = LBOUND(InData%AccAvg,1), UBOUND(InData%AccAvg,1) - ReKiBuf(Re_Xferred) = InData%AccAvg(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%DTime - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Rate - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YHWid - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ZHWid - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GridBase - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%InitXPosition - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%InvDY - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%InvDZ - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MeanWS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%InvMWS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TotalTime - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NComp - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NYGrids - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NZGrids - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NTGrids - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NSteps - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PLExp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Z0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VLinShr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HLinShr - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%BoxExceedAllowF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%BoxExceedAllowIdx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%BoxExceedWarned, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE IfW_FlowField_PackGrid3DFieldType - - SUBROUTINE IfW_FlowField_UnPackGrid3DFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Grid3DFieldType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_UnPackGrid3DFieldType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%WindFileFormat = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WindProfileType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Periodic = TRANSFER(IntKiBuf(Int_Xferred), OutData%Periodic) - Int_Xferred = Int_Xferred + 1 - OutData%InterpTower = TRANSFER(IntKiBuf(Int_Xferred), OutData%InterpTower) - Int_Xferred = Int_Xferred + 1 - OutData%AddMeanAfterInterp = TRANSFER(IntKiBuf(Int_Xferred), OutData%AddMeanAfterInterp) - Int_Xferred = Int_Xferred + 1 - OutData%RefHeight = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RefLength = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vel not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vel)) DEALLOCATE(OutData%Vel) - ALLOCATE(OutData%Vel(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Vel,4), UBOUND(OutData%Vel,4) - DO i3 = LBOUND(OutData%Vel,3), UBOUND(OutData%Vel,3) - DO i2 = LBOUND(OutData%Vel,2), UBOUND(OutData%Vel,2) - DO i1 = LBOUND(OutData%Vel,1), UBOUND(OutData%Vel,1) - OutData%Vel(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Acc not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Acc)) DEALLOCATE(OutData%Acc) - ALLOCATE(OutData%Acc(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Acc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Acc,4), UBOUND(OutData%Acc,4) - DO i3 = LBOUND(OutData%Acc,3), UBOUND(OutData%Acc,3) - DO i2 = LBOUND(OutData%Acc,2), UBOUND(OutData%Acc,2) - DO i1 = LBOUND(OutData%Acc,1), UBOUND(OutData%Acc,1) - OutData%Acc(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VelTower not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%VelTower)) DEALLOCATE(OutData%VelTower) - ALLOCATE(OutData%VelTower(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelTower.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%VelTower,3), UBOUND(OutData%VelTower,3) - DO i2 = LBOUND(OutData%VelTower,2), UBOUND(OutData%VelTower,2) - DO i1 = LBOUND(OutData%VelTower,1), UBOUND(OutData%VelTower,1) - OutData%VelTower(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AccTower not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AccTower)) DEALLOCATE(OutData%AccTower) - ALLOCATE(OutData%AccTower(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AccTower.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AccTower,3), UBOUND(OutData%AccTower,3) - DO i2 = LBOUND(OutData%AccTower,2), UBOUND(OutData%AccTower,2) - DO i1 = LBOUND(OutData%AccTower,1), UBOUND(OutData%AccTower,1) - OutData%AccTower(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VelAvg not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%VelAvg)) DEALLOCATE(OutData%VelAvg) - ALLOCATE(OutData%VelAvg(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelAvg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%VelAvg,3), UBOUND(OutData%VelAvg,3) - DO i2 = LBOUND(OutData%VelAvg,2), UBOUND(OutData%VelAvg,2) - DO i1 = LBOUND(OutData%VelAvg,1), UBOUND(OutData%VelAvg,1) - OutData%VelAvg(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AccAvg not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AccAvg)) DEALLOCATE(OutData%AccAvg) - ALLOCATE(OutData%AccAvg(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AccAvg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AccAvg,3), UBOUND(OutData%AccAvg,3) - DO i2 = LBOUND(OutData%AccAvg,2), UBOUND(OutData%AccAvg,2) - DO i1 = LBOUND(OutData%AccAvg,1), UBOUND(OutData%AccAvg,1) - OutData%AccAvg(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%DTime = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Rate = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YHWid = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ZHWid = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GridBase = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%InitXPosition = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%InvDY = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%InvDZ = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MeanWS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%InvMWS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TotalTime = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NComp = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NYGrids = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NZGrids = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NTGrids = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NSteps = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%PLExp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Z0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VLinShr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HLinShr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%BoxExceedAllowF = TRANSFER(IntKiBuf(Int_Xferred), OutData%BoxExceedAllowF) - Int_Xferred = Int_Xferred + 1 - OutData%BoxExceedAllowIdx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%BoxExceedWarned = TRANSFER(IntKiBuf(Int_Xferred), OutData%BoxExceedWarned) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE IfW_FlowField_UnPackGrid3DFieldType +subroutine IfW_FlowField_PackGrid3DFieldType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Grid3DFieldType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IfW_FlowField_PackGrid3DFieldType' + if (Buf%ErrStat >= AbortErrLev) return + ! WindFileFormat + call RegPack(Buf, InData%WindFileFormat) + if (RegCheckErr(Buf, RoutineName)) return + ! WindProfileType + call RegPack(Buf, InData%WindProfileType) + if (RegCheckErr(Buf, RoutineName)) return + ! Periodic + call RegPack(Buf, InData%Periodic) + if (RegCheckErr(Buf, RoutineName)) return + ! InterpTower + call RegPack(Buf, InData%InterpTower) + if (RegCheckErr(Buf, RoutineName)) return + ! AddMeanAfterInterp + call RegPack(Buf, InData%AddMeanAfterInterp) + if (RegCheckErr(Buf, RoutineName)) return + ! RefHeight + call RegPack(Buf, InData%RefHeight) + if (RegCheckErr(Buf, RoutineName)) return + ! RefLength + call RegPack(Buf, InData%RefLength) + if (RegCheckErr(Buf, RoutineName)) return + ! Vel + call RegPack(Buf, allocated(InData%Vel)) + if (allocated(InData%Vel)) then + call RegPackBounds(Buf, 4, lbound(InData%Vel), ubound(InData%Vel)) + call RegPack(Buf, InData%Vel) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Acc + call RegPack(Buf, allocated(InData%Acc)) + if (allocated(InData%Acc)) then + call RegPackBounds(Buf, 4, lbound(InData%Acc), ubound(InData%Acc)) + call RegPack(Buf, InData%Acc) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! VelTower + call RegPack(Buf, allocated(InData%VelTower)) + if (allocated(InData%VelTower)) then + call RegPackBounds(Buf, 3, lbound(InData%VelTower), ubound(InData%VelTower)) + call RegPack(Buf, InData%VelTower) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AccTower + call RegPack(Buf, allocated(InData%AccTower)) + if (allocated(InData%AccTower)) then + call RegPackBounds(Buf, 3, lbound(InData%AccTower), ubound(InData%AccTower)) + call RegPack(Buf, InData%AccTower) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! VelAvg + call RegPack(Buf, allocated(InData%VelAvg)) + if (allocated(InData%VelAvg)) then + call RegPackBounds(Buf, 3, lbound(InData%VelAvg), ubound(InData%VelAvg)) + call RegPack(Buf, InData%VelAvg) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AccAvg + call RegPack(Buf, allocated(InData%AccAvg)) + if (allocated(InData%AccAvg)) then + call RegPackBounds(Buf, 3, lbound(InData%AccAvg), ubound(InData%AccAvg)) + call RegPack(Buf, InData%AccAvg) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DTime + call RegPack(Buf, InData%DTime) + if (RegCheckErr(Buf, RoutineName)) return + ! Rate + call RegPack(Buf, InData%Rate) + if (RegCheckErr(Buf, RoutineName)) return + ! YHWid + call RegPack(Buf, InData%YHWid) + if (RegCheckErr(Buf, RoutineName)) return + ! ZHWid + call RegPack(Buf, InData%ZHWid) + if (RegCheckErr(Buf, RoutineName)) return + ! GridBase + call RegPack(Buf, InData%GridBase) + if (RegCheckErr(Buf, RoutineName)) return + ! InitXPosition + call RegPack(Buf, InData%InitXPosition) + if (RegCheckErr(Buf, RoutineName)) return + ! InvDY + call RegPack(Buf, InData%InvDY) + if (RegCheckErr(Buf, RoutineName)) return + ! InvDZ + call RegPack(Buf, InData%InvDZ) + if (RegCheckErr(Buf, RoutineName)) return + ! MeanWS + call RegPack(Buf, InData%MeanWS) + if (RegCheckErr(Buf, RoutineName)) return + ! InvMWS + call RegPack(Buf, InData%InvMWS) + if (RegCheckErr(Buf, RoutineName)) return + ! TotalTime + call RegPack(Buf, InData%TotalTime) + if (RegCheckErr(Buf, RoutineName)) return + ! NComp + call RegPack(Buf, InData%NComp) + if (RegCheckErr(Buf, RoutineName)) return + ! NYGrids + call RegPack(Buf, InData%NYGrids) + if (RegCheckErr(Buf, RoutineName)) return + ! NZGrids + call RegPack(Buf, InData%NZGrids) + if (RegCheckErr(Buf, RoutineName)) return + ! NTGrids + call RegPack(Buf, InData%NTGrids) + if (RegCheckErr(Buf, RoutineName)) return + ! NSteps + call RegPack(Buf, InData%NSteps) + if (RegCheckErr(Buf, RoutineName)) return + ! PLExp + call RegPack(Buf, InData%PLExp) + if (RegCheckErr(Buf, RoutineName)) return + ! Z0 + call RegPack(Buf, InData%Z0) + if (RegCheckErr(Buf, RoutineName)) return + ! VLinShr + call RegPack(Buf, InData%VLinShr) + if (RegCheckErr(Buf, RoutineName)) return + ! HLinShr + call RegPack(Buf, InData%HLinShr) + if (RegCheckErr(Buf, RoutineName)) return + ! BoxExceedAllowF + call RegPack(Buf, InData%BoxExceedAllowF) + if (RegCheckErr(Buf, RoutineName)) return + ! BoxExceedAllowIdx + call RegPack(Buf, InData%BoxExceedAllowIdx) + if (RegCheckErr(Buf, RoutineName)) return + ! BoxExceedWarned + call RegPack(Buf, InData%BoxExceedWarned) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IfW_FlowField_UnPackGrid3DFieldType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Grid3DFieldType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IfW_FlowField_UnPackGrid3DFieldType' + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! WindFileFormat + call RegUnpack(Buf, OutData%WindFileFormat) + if (RegCheckErr(Buf, RoutineName)) return + ! WindProfileType + call RegUnpack(Buf, OutData%WindProfileType) + if (RegCheckErr(Buf, RoutineName)) return + ! Periodic + call RegUnpack(Buf, OutData%Periodic) + if (RegCheckErr(Buf, RoutineName)) return + ! InterpTower + call RegUnpack(Buf, OutData%InterpTower) + if (RegCheckErr(Buf, RoutineName)) return + ! AddMeanAfterInterp + call RegUnpack(Buf, OutData%AddMeanAfterInterp) + if (RegCheckErr(Buf, RoutineName)) return + ! RefHeight + call RegUnpack(Buf, OutData%RefHeight) + if (RegCheckErr(Buf, RoutineName)) return + ! RefLength + call RegUnpack(Buf, OutData%RefLength) + if (RegCheckErr(Buf, RoutineName)) return + ! Vel + if (allocated(OutData%Vel)) deallocate(OutData%Vel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vel(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vel) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Acc + if (allocated(OutData%Acc)) deallocate(OutData%Acc) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Acc(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Acc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Acc) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! VelTower + if (allocated(OutData%VelTower)) deallocate(OutData%VelTower) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%VelTower(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelTower.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%VelTower) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AccTower + if (allocated(OutData%AccTower)) deallocate(OutData%AccTower) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AccTower(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AccTower.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AccTower) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! VelAvg + if (allocated(OutData%VelAvg)) deallocate(OutData%VelAvg) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%VelAvg(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelAvg.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%VelAvg) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AccAvg + if (allocated(OutData%AccAvg)) deallocate(OutData%AccAvg) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AccAvg(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AccAvg.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AccAvg) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! DTime + call RegUnpack(Buf, OutData%DTime) + if (RegCheckErr(Buf, RoutineName)) return + ! Rate + call RegUnpack(Buf, OutData%Rate) + if (RegCheckErr(Buf, RoutineName)) return + ! YHWid + call RegUnpack(Buf, OutData%YHWid) + if (RegCheckErr(Buf, RoutineName)) return + ! ZHWid + call RegUnpack(Buf, OutData%ZHWid) + if (RegCheckErr(Buf, RoutineName)) return + ! GridBase + call RegUnpack(Buf, OutData%GridBase) + if (RegCheckErr(Buf, RoutineName)) return + ! InitXPosition + call RegUnpack(Buf, OutData%InitXPosition) + if (RegCheckErr(Buf, RoutineName)) return + ! InvDY + call RegUnpack(Buf, OutData%InvDY) + if (RegCheckErr(Buf, RoutineName)) return + ! InvDZ + call RegUnpack(Buf, OutData%InvDZ) + if (RegCheckErr(Buf, RoutineName)) return + ! MeanWS + call RegUnpack(Buf, OutData%MeanWS) + if (RegCheckErr(Buf, RoutineName)) return + ! InvMWS + call RegUnpack(Buf, OutData%InvMWS) + if (RegCheckErr(Buf, RoutineName)) return + ! TotalTime + call RegUnpack(Buf, OutData%TotalTime) + if (RegCheckErr(Buf, RoutineName)) return + ! NComp + call RegUnpack(Buf, OutData%NComp) + if (RegCheckErr(Buf, RoutineName)) return + ! NYGrids + call RegUnpack(Buf, OutData%NYGrids) + if (RegCheckErr(Buf, RoutineName)) return + ! NZGrids + call RegUnpack(Buf, OutData%NZGrids) + if (RegCheckErr(Buf, RoutineName)) return + ! NTGrids + call RegUnpack(Buf, OutData%NTGrids) + if (RegCheckErr(Buf, RoutineName)) return + ! NSteps + call RegUnpack(Buf, OutData%NSteps) + if (RegCheckErr(Buf, RoutineName)) return + ! PLExp + call RegUnpack(Buf, OutData%PLExp) + if (RegCheckErr(Buf, RoutineName)) return + ! Z0 + call RegUnpack(Buf, OutData%Z0) + if (RegCheckErr(Buf, RoutineName)) return + ! VLinShr + call RegUnpack(Buf, OutData%VLinShr) + if (RegCheckErr(Buf, RoutineName)) return + ! HLinShr + call RegUnpack(Buf, OutData%HLinShr) + if (RegCheckErr(Buf, RoutineName)) return + ! BoxExceedAllowF + call RegUnpack(Buf, OutData%BoxExceedAllowF) + if (RegCheckErr(Buf, RoutineName)) return + ! BoxExceedAllowIdx + call RegUnpack(Buf, OutData%BoxExceedAllowIdx) + if (RegCheckErr(Buf, RoutineName)) return + ! BoxExceedWarned + call RegUnpack(Buf, OutData%BoxExceedWarned) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE IfW_FlowField_CopyGrid4DFieldType( SrcGrid4DFieldTypeData, DstGrid4DFieldTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(Grid4DFieldType), INTENT(IN) :: SrcGrid4DFieldTypeData TYPE(Grid4DFieldType), INTENT(INOUT) :: DstGrid4DFieldTypeData @@ -2293,147 +1605,91 @@ SUBROUTINE IfW_FlowField_DestroyGrid4DFieldType( Grid4DFieldTypeData, ErrStat, E NULLIFY(Grid4DFieldTypeData%Vel) END SUBROUTINE IfW_FlowField_DestroyGrid4DFieldType - SUBROUTINE IfW_FlowField_PackGrid4DFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Grid4DFieldType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_PackGrid4DFieldType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + SIZE(InData%n) ! n - Re_BufSz = Re_BufSz + SIZE(InData%delta) ! delta - Re_BufSz = Re_BufSz + SIZE(InData%pZero) ! pZero - Re_BufSz = Re_BufSz + 1 ! TimeStart - Re_BufSz = Re_BufSz + 1 ! RefHeight - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i1 = LBOUND(InData%n,1), UBOUND(InData%n,1) - IntKiBuf(Int_Xferred) = InData%n(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%delta,1), UBOUND(InData%delta,1) - ReKiBuf(Re_Xferred) = InData%delta(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%pZero,1), UBOUND(InData%pZero,1) - ReKiBuf(Re_Xferred) = InData%pZero(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%TimeStart - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RefHeight - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IfW_FlowField_PackGrid4DFieldType - - SUBROUTINE IfW_FlowField_UnPackGrid4DFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Grid4DFieldType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_UnPackGrid4DFieldType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%n,1) - i1_u = UBOUND(OutData%n,1) - DO i1 = LBOUND(OutData%n,1), UBOUND(OutData%n,1) - OutData%n(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%delta,1) - i1_u = UBOUND(OutData%delta,1) - DO i1 = LBOUND(OutData%delta,1), UBOUND(OutData%delta,1) - OutData%delta(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%pZero,1) - i1_u = UBOUND(OutData%pZero,1) - DO i1 = LBOUND(OutData%pZero,1), UBOUND(OutData%pZero,1) - OutData%pZero(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - NULLIFY(OutData%Vel) - OutData%TimeStart = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RefHeight = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IfW_FlowField_UnPackGrid4DFieldType +subroutine IfW_FlowField_PackGrid4DFieldType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Grid4DFieldType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IfW_FlowField_PackGrid4DFieldType' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + ! n + call RegPack(Buf, InData%n) + if (RegCheckErr(Buf, RoutineName)) return + ! delta + call RegPack(Buf, InData%delta) + if (RegCheckErr(Buf, RoutineName)) return + ! pZero + call RegPack(Buf, InData%pZero) + if (RegCheckErr(Buf, RoutineName)) return + ! Vel + call RegPack(Buf, associated(InData%Vel)) + if (associated(InData%Vel)) then + call RegPackBounds(Buf, 5, lbound(InData%Vel), ubound(InData%Vel)) + call RegPackPointer(Buf, c_loc(InData%Vel), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%Vel) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TimeStart + call RegPack(Buf, InData%TimeStart) + if (RegCheckErr(Buf, RoutineName)) return + ! RefHeight + call RegPack(Buf, InData%RefHeight) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IfW_FlowField_UnPackGrid4DFieldType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Grid4DFieldType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IfW_FlowField_UnPackGrid4DFieldType' + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + ! n + call RegUnpack(Buf, OutData%n) + if (RegCheckErr(Buf, RoutineName)) return + ! delta + call RegUnpack(Buf, OutData%delta) + if (RegCheckErr(Buf, RoutineName)) return + ! pZero + call RegUnpack(Buf, OutData%pZero) + if (RegCheckErr(Buf, RoutineName)) return + ! Vel + if (associated(OutData%Vel)) deallocate(OutData%Vel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vel, UB(1:5)-LB(1:5)) + OutData%Vel(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => OutData%Vel + else + allocate(OutData%Vel(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Vel) + call RegUnpack(Buf, OutData%Vel) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%Vel => null() + end if + ! TimeStart + call RegUnpack(Buf, OutData%TimeStart) + if (RegCheckErr(Buf, RoutineName)) return + ! RefHeight + call RegUnpack(Buf, OutData%RefHeight) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE IfW_FlowField_CopyPointsFieldType( SrcPointsFieldTypeData, DstPointsFieldTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(PointsFieldType), INTENT(IN) :: SrcPointsFieldTypeData TYPE(PointsFieldType), INTENT(INOUT) :: DstPointsFieldTypeData @@ -2484,148 +1740,45 @@ SUBROUTINE IfW_FlowField_DestroyPointsFieldType( PointsFieldTypeData, ErrStat, E ENDIF END SUBROUTINE IfW_FlowField_DestroyPointsFieldType - SUBROUTINE IfW_FlowField_PackPointsFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(PointsFieldType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_PackPointsFieldType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! Vel allocated yes/no - IF ( ALLOCATED(InData%Vel) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vel) ! Vel - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%Vel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vel,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vel,2), UBOUND(InData%Vel,2) - DO i1 = LBOUND(InData%Vel,1), UBOUND(InData%Vel,1) - ReKiBuf(Re_Xferred) = InData%Vel(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE IfW_FlowField_PackPointsFieldType - - SUBROUTINE IfW_FlowField_UnPackPointsFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(PointsFieldType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_UnPackPointsFieldType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vel not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vel)) DEALLOCATE(OutData%Vel) - ALLOCATE(OutData%Vel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vel,2), UBOUND(OutData%Vel,2) - DO i1 = LBOUND(OutData%Vel,1), UBOUND(OutData%Vel,1) - OutData%Vel(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE IfW_FlowField_UnPackPointsFieldType +subroutine IfW_FlowField_PackPointsFieldType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(PointsFieldType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IfW_FlowField_PackPointsFieldType' + if (Buf%ErrStat >= AbortErrLev) return + ! Vel + call RegPack(Buf, allocated(InData%Vel)) + if (allocated(InData%Vel)) then + call RegPackBounds(Buf, 2, lbound(InData%Vel), ubound(InData%Vel)) + call RegPack(Buf, InData%Vel) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IfW_FlowField_UnPackPointsFieldType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(PointsFieldType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IfW_FlowField_UnPackPointsFieldType' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! Vel + if (allocated(OutData%Vel)) deallocate(OutData%Vel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vel(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vel) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE IfW_FlowField_CopyUserFieldType( SrcUserFieldTypeData, DstUserFieldTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(UserFieldType), INTENT(IN) :: SrcUserFieldTypeData TYPE(UserFieldType), INTENT(INOUT) :: DstUserFieldTypeData @@ -2658,103 +1811,26 @@ SUBROUTINE IfW_FlowField_DestroyUserFieldType( UserFieldTypeData, ErrStat, ErrMs END SUBROUTINE IfW_FlowField_DestroyUserFieldType - SUBROUTINE IfW_FlowField_PackUserFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(UserFieldType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_PackUserFieldType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! RefHeight - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%RefHeight - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IfW_FlowField_PackUserFieldType - - SUBROUTINE IfW_FlowField_UnPackUserFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(UserFieldType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_UnPackUserFieldType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%RefHeight = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE IfW_FlowField_UnPackUserFieldType +subroutine IfW_FlowField_PackUserFieldType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(UserFieldType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IfW_FlowField_PackUserFieldType' + if (Buf%ErrStat >= AbortErrLev) return + ! RefHeight + call RegPack(Buf, InData%RefHeight) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IfW_FlowField_UnPackUserFieldType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(UserFieldType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IfW_FlowField_UnPackUserFieldType' + if (Buf%ErrStat /= ErrID_None) return + ! RefHeight + call RegUnpack(Buf, OutData%RefHeight) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE IfW_FlowField_CopyFlowFieldType( SrcFlowFieldTypeData, DstFlowFieldTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(FlowFieldType), INTENT(IN) :: SrcFlowFieldTypeData TYPE(FlowFieldType), INTENT(INOUT) :: DstFlowFieldTypeData @@ -2822,600 +1898,98 @@ SUBROUTINE IfW_FlowField_DestroyFlowFieldType( FlowFieldTypeData, ErrStat, ErrMs CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE IfW_FlowField_DestroyFlowFieldType - SUBROUTINE IfW_FlowField_PackFlowFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FlowFieldType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_PackFlowFieldType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! FieldType - Re_BufSz = Re_BufSz + SIZE(InData%RefPosition) ! RefPosition - Re_BufSz = Re_BufSz + 1 ! PropagationDir - Re_BufSz = Re_BufSz + 1 ! VFlowAngle - Int_BufSz = Int_BufSz + 1 ! VelInterpCubic - Int_BufSz = Int_BufSz + 1 ! RotateWindBox - Int_BufSz = Int_BufSz + 1 ! AccFieldValid - Re_BufSz = Re_BufSz + SIZE(InData%RotToWind) ! RotToWind - Re_BufSz = Re_BufSz + SIZE(InData%RotFromWind) ! RotFromWind - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Uniform: size of buffers for each call to pack subtype - CALL IfW_FlowField_PackUniformFieldType( Re_Buf, Db_Buf, Int_Buf, InData%Uniform, ErrStat2, ErrMsg2, .TRUE. ) ! Uniform - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Uniform - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Uniform - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Uniform - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Grid3D: size of buffers for each call to pack subtype - CALL IfW_FlowField_PackGrid3DFieldType( Re_Buf, Db_Buf, Int_Buf, InData%Grid3D, ErrStat2, ErrMsg2, .TRUE. ) ! Grid3D - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Grid3D - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Grid3D - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Grid3D - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Grid4D: size of buffers for each call to pack subtype - CALL IfW_FlowField_PackGrid4DFieldType( Re_Buf, Db_Buf, Int_Buf, InData%Grid4D, ErrStat2, ErrMsg2, .TRUE. ) ! Grid4D - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Grid4D - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Grid4D - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Grid4D - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Points: size of buffers for each call to pack subtype - CALL IfW_FlowField_PackPointsFieldType( Re_Buf, Db_Buf, Int_Buf, InData%Points, ErrStat2, ErrMsg2, .TRUE. ) ! Points - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Points - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Points - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Points - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! User: size of buffers for each call to pack subtype - CALL IfW_FlowField_PackUserFieldType( Re_Buf, Db_Buf, Int_Buf, InData%User, ErrStat2, ErrMsg2, .TRUE. ) ! User - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! User - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! User - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! User - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%FieldType - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%RefPosition,1), UBOUND(InData%RefPosition,1) - ReKiBuf(Re_Xferred) = InData%RefPosition(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%PropagationDir - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VFlowAngle - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%VelInterpCubic, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotateWindBox, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%AccFieldValid, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO i2 = LBOUND(InData%RotToWind,2), UBOUND(InData%RotToWind,2) - DO i1 = LBOUND(InData%RotToWind,1), UBOUND(InData%RotToWind,1) - ReKiBuf(Re_Xferred) = InData%RotToWind(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%RotFromWind,2), UBOUND(InData%RotFromWind,2) - DO i1 = LBOUND(InData%RotFromWind,1), UBOUND(InData%RotFromWind,1) - ReKiBuf(Re_Xferred) = InData%RotFromWind(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - CALL IfW_FlowField_PackUniformFieldType( Re_Buf, Db_Buf, Int_Buf, InData%Uniform, ErrStat2, ErrMsg2, OnlySize ) ! Uniform - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL IfW_FlowField_PackGrid3DFieldType( Re_Buf, Db_Buf, Int_Buf, InData%Grid3D, ErrStat2, ErrMsg2, OnlySize ) ! Grid3D - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL IfW_FlowField_PackGrid4DFieldType( Re_Buf, Db_Buf, Int_Buf, InData%Grid4D, ErrStat2, ErrMsg2, OnlySize ) ! Grid4D - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL IfW_FlowField_PackPointsFieldType( Re_Buf, Db_Buf, Int_Buf, InData%Points, ErrStat2, ErrMsg2, OnlySize ) ! Points - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL IfW_FlowField_PackUserFieldType( Re_Buf, Db_Buf, Int_Buf, InData%User, ErrStat2, ErrMsg2, OnlySize ) ! User - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE IfW_FlowField_PackFlowFieldType - - SUBROUTINE IfW_FlowField_UnPackFlowFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FlowFieldType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_UnPackFlowFieldType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%FieldType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%RefPosition,1) - i1_u = UBOUND(OutData%RefPosition,1) - DO i1 = LBOUND(OutData%RefPosition,1), UBOUND(OutData%RefPosition,1) - OutData%RefPosition(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%PropagationDir = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VFlowAngle = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VelInterpCubic = TRANSFER(IntKiBuf(Int_Xferred), OutData%VelInterpCubic) - Int_Xferred = Int_Xferred + 1 - OutData%RotateWindBox = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotateWindBox) - Int_Xferred = Int_Xferred + 1 - OutData%AccFieldValid = TRANSFER(IntKiBuf(Int_Xferred), OutData%AccFieldValid) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%RotToWind,1) - i1_u = UBOUND(OutData%RotToWind,1) - i2_l = LBOUND(OutData%RotToWind,2) - i2_u = UBOUND(OutData%RotToWind,2) - DO i2 = LBOUND(OutData%RotToWind,2), UBOUND(OutData%RotToWind,2) - DO i1 = LBOUND(OutData%RotToWind,1), UBOUND(OutData%RotToWind,1) - OutData%RotToWind(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%RotFromWind,1) - i1_u = UBOUND(OutData%RotFromWind,1) - i2_l = LBOUND(OutData%RotFromWind,2) - i2_u = UBOUND(OutData%RotFromWind,2) - DO i2 = LBOUND(OutData%RotFromWind,2), UBOUND(OutData%RotFromWind,2) - DO i1 = LBOUND(OutData%RotFromWind,1), UBOUND(OutData%RotFromWind,1) - OutData%RotFromWind(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IfW_FlowField_UnpackUniformFieldType( Re_Buf, Db_Buf, Int_Buf, OutData%Uniform, ErrStat2, ErrMsg2 ) ! Uniform - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IfW_FlowField_UnpackGrid3DFieldType( Re_Buf, Db_Buf, Int_Buf, OutData%Grid3D, ErrStat2, ErrMsg2 ) ! Grid3D - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IfW_FlowField_UnpackGrid4DFieldType( Re_Buf, Db_Buf, Int_Buf, OutData%Grid4D, ErrStat2, ErrMsg2 ) ! Grid4D - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IfW_FlowField_UnpackPointsFieldType( Re_Buf, Db_Buf, Int_Buf, OutData%Points, ErrStat2, ErrMsg2 ) ! Points - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IfW_FlowField_UnpackUserFieldType( Re_Buf, Db_Buf, Int_Buf, OutData%User, ErrStat2, ErrMsg2 ) ! User - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE IfW_FlowField_UnPackFlowFieldType +subroutine IfW_FlowField_PackFlowFieldType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FlowFieldType), intent(in) :: InData + character(*), parameter :: RoutineName = 'IfW_FlowField_PackFlowFieldType' + if (Buf%ErrStat >= AbortErrLev) return + ! FieldType + call RegPack(Buf, InData%FieldType) + if (RegCheckErr(Buf, RoutineName)) return + ! RefPosition + call RegPack(Buf, InData%RefPosition) + if (RegCheckErr(Buf, RoutineName)) return + ! PropagationDir + call RegPack(Buf, InData%PropagationDir) + if (RegCheckErr(Buf, RoutineName)) return + ! VFlowAngle + call RegPack(Buf, InData%VFlowAngle) + if (RegCheckErr(Buf, RoutineName)) return + ! VelInterpCubic + call RegPack(Buf, InData%VelInterpCubic) + if (RegCheckErr(Buf, RoutineName)) return + ! RotateWindBox + call RegPack(Buf, InData%RotateWindBox) + if (RegCheckErr(Buf, RoutineName)) return + ! AccFieldValid + call RegPack(Buf, InData%AccFieldValid) + if (RegCheckErr(Buf, RoutineName)) return + ! RotToWind + call RegPack(Buf, InData%RotToWind) + if (RegCheckErr(Buf, RoutineName)) return + ! RotFromWind + call RegPack(Buf, InData%RotFromWind) + if (RegCheckErr(Buf, RoutineName)) return + ! Uniform + call IfW_FlowField_PackUniformFieldType(Buf, InData%Uniform) + if (RegCheckErr(Buf, RoutineName)) return + ! Grid3D + call IfW_FlowField_PackGrid3DFieldType(Buf, InData%Grid3D) + if (RegCheckErr(Buf, RoutineName)) return + ! Grid4D + call IfW_FlowField_PackGrid4DFieldType(Buf, InData%Grid4D) + if (RegCheckErr(Buf, RoutineName)) return + ! Points + call IfW_FlowField_PackPointsFieldType(Buf, InData%Points) + if (RegCheckErr(Buf, RoutineName)) return + ! User + call IfW_FlowField_PackUserFieldType(Buf, InData%User) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine IfW_FlowField_UnPackFlowFieldType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FlowFieldType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'IfW_FlowField_UnPackFlowFieldType' + if (Buf%ErrStat /= ErrID_None) return + ! FieldType + call RegUnpack(Buf, OutData%FieldType) + if (RegCheckErr(Buf, RoutineName)) return + ! RefPosition + call RegUnpack(Buf, OutData%RefPosition) + if (RegCheckErr(Buf, RoutineName)) return + ! PropagationDir + call RegUnpack(Buf, OutData%PropagationDir) + if (RegCheckErr(Buf, RoutineName)) return + ! VFlowAngle + call RegUnpack(Buf, OutData%VFlowAngle) + if (RegCheckErr(Buf, RoutineName)) return + ! VelInterpCubic + call RegUnpack(Buf, OutData%VelInterpCubic) + if (RegCheckErr(Buf, RoutineName)) return + ! RotateWindBox + call RegUnpack(Buf, OutData%RotateWindBox) + if (RegCheckErr(Buf, RoutineName)) return + ! AccFieldValid + call RegUnpack(Buf, OutData%AccFieldValid) + if (RegCheckErr(Buf, RoutineName)) return + ! RotToWind + call RegUnpack(Buf, OutData%RotToWind) + if (RegCheckErr(Buf, RoutineName)) return + ! RotFromWind + call RegUnpack(Buf, OutData%RotFromWind) + if (RegCheckErr(Buf, RoutineName)) return + ! Uniform + call IfW_FlowField_UnpackUniformFieldType(Buf, OutData%Uniform) ! Uniform + ! Grid3D + call IfW_FlowField_UnpackGrid3DFieldType(Buf, OutData%Grid3D) ! Grid3D + ! Grid4D + call IfW_FlowField_UnpackGrid4DFieldType(Buf, OutData%Grid4D) ! Grid4D + ! Points + call IfW_FlowField_UnpackPointsFieldType(Buf, OutData%Points) ! Points + ! User + call IfW_FlowField_UnpackUserFieldType(Buf, OutData%User) ! User +end subroutine END MODULE IfW_FlowField_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/inflowwind/src/InflowWind_Driver.f90 b/modules/inflowwind/src/InflowWind_Driver.f90 index 77beb83a58..f583665cdb 100644 --- a/modules/inflowwind/src/InflowWind_Driver.f90 +++ b/modules/inflowwind/src/InflowWind_Driver.f90 @@ -862,7 +862,7 @@ PROGRAM InflowWind_Driver !FFT calculations occur here. Output to file. - + call PackAndSave() !-------------------------------------------------------------------------------------------------------------------------------- !-=-=- We are done, so close everything down -=-=- @@ -925,8 +925,6 @@ PROGRAM InflowWind_Driver CALL WrScr(' InflowWind_End call 3 of 3: ok') ENDIF - - CALL DriverCleanup() CONTAINS @@ -945,6 +943,25 @@ SUBROUTINE DriverCleanup() END SUBROUTINE DriverCleanup + subroutine PackAndSave() + type(PackBuffer) :: BufOut, BufIn + integer(IntKi) :: unit + TYPE(InflowWind_ParameterType) :: IfW_p + + call InitPackBuffer(BufOut, ErrStat, ErrMsg) + call InflowWind_PackParam(BufOut, InflowWind_p) + call GetNewUnit(unit, ErrStat, ErrMsg) + call OpenBOutFile(unit, 'pack.bin', ErrStat, ErrMsg) + call WritePackBuffer(BufOut, unit, ErrStat, ErrMsg) + close(unit) + + call OpenBInpFile(unit, 'pack.bin', ErrStat, ErrMsg) + call ReadPackBuffer(BufIn, unit, ErrStat, ErrMsg) + call InflowWind_UnPackParam(BufIn, IfW_p) + close(unit) + + end subroutine + END PROGRAM InflowWind_Driver diff --git a/modules/inflowwind/src/InflowWind_IO_Types.f90 b/modules/inflowwind/src/InflowWind_IO_Types.f90 index 1d4342bf6b..d014e7960c 100644 --- a/modules/inflowwind/src/InflowWind_IO_Types.f90 +++ b/modules/inflowwind/src/InflowWind_IO_Types.f90 @@ -191,217 +191,128 @@ SUBROUTINE InflowWind_IO_DestroyWindFileDat( WindFileDatData, ErrStat, ErrMsg ) END SUBROUTINE InflowWind_IO_DestroyWindFileDat - SUBROUTINE InflowWind_IO_PackWindFileDat( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(WindFileDat), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_PackWindFileDat' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%FileName) ! FileName - Int_BufSz = Int_BufSz + 1 ! WindType - Re_BufSz = Re_BufSz + 1 ! RefHt - Int_BufSz = Int_BufSz + 1 ! RefHt_Set - Db_BufSz = Db_BufSz + 1 ! DT - Int_BufSz = Int_BufSz + 1 ! NumTSteps - Int_BufSz = Int_BufSz + 1 ! ConstantDT - Re_BufSz = Re_BufSz + SIZE(InData%TRange) ! TRange - Int_BufSz = Int_BufSz + 1 ! TRange_Limited - Re_BufSz = Re_BufSz + SIZE(InData%YRange) ! YRange - Int_BufSz = Int_BufSz + 1 ! YRange_Limited - Re_BufSz = Re_BufSz + SIZE(InData%ZRange) ! ZRange - Int_BufSz = Int_BufSz + 1 ! ZRange_Limited - Int_BufSz = Int_BufSz + 1 ! BinaryFormat - Int_BufSz = Int_BufSz + 1 ! IsBinary - Re_BufSz = Re_BufSz + SIZE(InData%TI) ! TI - Int_BufSz = Int_BufSz + 1 ! TI_listed - Re_BufSz = Re_BufSz + 1 ! MWS - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%WindType - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RefHt - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%RefHt_Set, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumTSteps - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%ConstantDT, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%TRange,1), UBOUND(InData%TRange,1) - ReKiBuf(Re_Xferred) = InData%TRange(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = TRANSFER(InData%TRange_Limited, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%YRange,1), UBOUND(InData%YRange,1) - ReKiBuf(Re_Xferred) = InData%YRange(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = TRANSFER(InData%YRange_Limited, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%ZRange,1), UBOUND(InData%ZRange,1) - ReKiBuf(Re_Xferred) = InData%ZRange(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = TRANSFER(InData%ZRange_Limited, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%BinaryFormat - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%IsBinary, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%TI,1), UBOUND(InData%TI,1) - ReKiBuf(Re_Xferred) = InData%TI(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = TRANSFER(InData%TI_listed, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MWS - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE InflowWind_IO_PackWindFileDat - - SUBROUTINE InflowWind_IO_UnPackWindFileDat( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(WindFileDat), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_UnPackWindFileDat' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%FileName) - OutData%FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%WindType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%RefHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RefHt_Set = TRANSFER(IntKiBuf(Int_Xferred), OutData%RefHt_Set) - Int_Xferred = Int_Xferred + 1 - OutData%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%NumTSteps = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ConstantDT = TRANSFER(IntKiBuf(Int_Xferred), OutData%ConstantDT) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%TRange,1) - i1_u = UBOUND(OutData%TRange,1) - DO i1 = LBOUND(OutData%TRange,1), UBOUND(OutData%TRange,1) - OutData%TRange(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%TRange_Limited = TRANSFER(IntKiBuf(Int_Xferred), OutData%TRange_Limited) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%YRange,1) - i1_u = UBOUND(OutData%YRange,1) - DO i1 = LBOUND(OutData%YRange,1), UBOUND(OutData%YRange,1) - OutData%YRange(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%YRange_Limited = TRANSFER(IntKiBuf(Int_Xferred), OutData%YRange_Limited) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%ZRange,1) - i1_u = UBOUND(OutData%ZRange,1) - DO i1 = LBOUND(OutData%ZRange,1), UBOUND(OutData%ZRange,1) - OutData%ZRange(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%ZRange_Limited = TRANSFER(IntKiBuf(Int_Xferred), OutData%ZRange_Limited) - Int_Xferred = Int_Xferred + 1 - OutData%BinaryFormat = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%IsBinary = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsBinary) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%TI,1) - i1_u = UBOUND(OutData%TI,1) - DO i1 = LBOUND(OutData%TI,1), UBOUND(OutData%TI,1) - OutData%TI(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%TI_listed = TRANSFER(IntKiBuf(Int_Xferred), OutData%TI_listed) - Int_Xferred = Int_Xferred + 1 - OutData%MWS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE InflowWind_IO_UnPackWindFileDat +subroutine InflowWind_IO_PackWindFileDat(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WindFileDat), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_IO_PackWindFileDat' + if (Buf%ErrStat >= AbortErrLev) return + ! FileName + call RegPack(Buf, InData%FileName) + if (RegCheckErr(Buf, RoutineName)) return + ! WindType + call RegPack(Buf, InData%WindType) + if (RegCheckErr(Buf, RoutineName)) return + ! RefHt + call RegPack(Buf, InData%RefHt) + if (RegCheckErr(Buf, RoutineName)) return + ! RefHt_Set + call RegPack(Buf, InData%RefHt_Set) + if (RegCheckErr(Buf, RoutineName)) return + ! DT + call RegPack(Buf, InData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! NumTSteps + call RegPack(Buf, InData%NumTSteps) + if (RegCheckErr(Buf, RoutineName)) return + ! ConstantDT + call RegPack(Buf, InData%ConstantDT) + if (RegCheckErr(Buf, RoutineName)) return + ! TRange + call RegPack(Buf, InData%TRange) + if (RegCheckErr(Buf, RoutineName)) return + ! TRange_Limited + call RegPack(Buf, InData%TRange_Limited) + if (RegCheckErr(Buf, RoutineName)) return + ! YRange + call RegPack(Buf, InData%YRange) + if (RegCheckErr(Buf, RoutineName)) return + ! YRange_Limited + call RegPack(Buf, InData%YRange_Limited) + if (RegCheckErr(Buf, RoutineName)) return + ! ZRange + call RegPack(Buf, InData%ZRange) + if (RegCheckErr(Buf, RoutineName)) return + ! ZRange_Limited + call RegPack(Buf, InData%ZRange_Limited) + if (RegCheckErr(Buf, RoutineName)) return + ! BinaryFormat + call RegPack(Buf, InData%BinaryFormat) + if (RegCheckErr(Buf, RoutineName)) return + ! IsBinary + call RegPack(Buf, InData%IsBinary) + if (RegCheckErr(Buf, RoutineName)) return + ! TI + call RegPack(Buf, InData%TI) + if (RegCheckErr(Buf, RoutineName)) return + ! TI_listed + call RegPack(Buf, InData%TI_listed) + if (RegCheckErr(Buf, RoutineName)) return + ! MWS + call RegPack(Buf, InData%MWS) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_UnPackWindFileDat(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WindFileDat), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackWindFileDat' + if (Buf%ErrStat /= ErrID_None) return + ! FileName + call RegUnpack(Buf, OutData%FileName) + if (RegCheckErr(Buf, RoutineName)) return + ! WindType + call RegUnpack(Buf, OutData%WindType) + if (RegCheckErr(Buf, RoutineName)) return + ! RefHt + call RegUnpack(Buf, OutData%RefHt) + if (RegCheckErr(Buf, RoutineName)) return + ! RefHt_Set + call RegUnpack(Buf, OutData%RefHt_Set) + if (RegCheckErr(Buf, RoutineName)) return + ! DT + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! NumTSteps + call RegUnpack(Buf, OutData%NumTSteps) + if (RegCheckErr(Buf, RoutineName)) return + ! ConstantDT + call RegUnpack(Buf, OutData%ConstantDT) + if (RegCheckErr(Buf, RoutineName)) return + ! TRange + call RegUnpack(Buf, OutData%TRange) + if (RegCheckErr(Buf, RoutineName)) return + ! TRange_Limited + call RegUnpack(Buf, OutData%TRange_Limited) + if (RegCheckErr(Buf, RoutineName)) return + ! YRange + call RegUnpack(Buf, OutData%YRange) + if (RegCheckErr(Buf, RoutineName)) return + ! YRange_Limited + call RegUnpack(Buf, OutData%YRange_Limited) + if (RegCheckErr(Buf, RoutineName)) return + ! ZRange + call RegUnpack(Buf, OutData%ZRange) + if (RegCheckErr(Buf, RoutineName)) return + ! ZRange_Limited + call RegUnpack(Buf, OutData%ZRange_Limited) + if (RegCheckErr(Buf, RoutineName)) return + ! BinaryFormat + call RegUnpack(Buf, OutData%BinaryFormat) + if (RegCheckErr(Buf, RoutineName)) return + ! IsBinary + call RegUnpack(Buf, OutData%IsBinary) + if (RegCheckErr(Buf, RoutineName)) return + ! TI + call RegUnpack(Buf, OutData%TI) + if (RegCheckErr(Buf, RoutineName)) return + ! TI_listed + call RegUnpack(Buf, OutData%TI_listed) + if (RegCheckErr(Buf, RoutineName)) return + ! MWS + call RegUnpack(Buf, OutData%MWS) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE InflowWind_IO_CopySteady_InitInputType( SrcSteady_InitInputTypeData, DstSteady_InitInputTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(Steady_InitInputType), INTENT(IN) :: SrcSteady_InitInputTypeData TYPE(Steady_InitInputType), INTENT(INOUT) :: DstSteady_InitInputTypeData @@ -436,113 +347,38 @@ SUBROUTINE InflowWind_IO_DestroySteady_InitInputType( Steady_InitInputTypeData, END SUBROUTINE InflowWind_IO_DestroySteady_InitInputType - SUBROUTINE InflowWind_IO_PackSteady_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Steady_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_PackSteady_InitInputType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! HWindSpeed - Re_BufSz = Re_BufSz + 1 ! RefHt - Re_BufSz = Re_BufSz + 1 ! PLExp - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%HWindSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RefHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PLExp - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE InflowWind_IO_PackSteady_InitInputType - - SUBROUTINE InflowWind_IO_UnPackSteady_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Steady_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_UnPackSteady_InitInputType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%HWindSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RefHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PLExp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE InflowWind_IO_UnPackSteady_InitInputType +subroutine InflowWind_IO_PackSteady_InitInputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Steady_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_IO_PackSteady_InitInputType' + if (Buf%ErrStat >= AbortErrLev) return + ! HWindSpeed + call RegPack(Buf, InData%HWindSpeed) + if (RegCheckErr(Buf, RoutineName)) return + ! RefHt + call RegPack(Buf, InData%RefHt) + if (RegCheckErr(Buf, RoutineName)) return + ! PLExp + call RegPack(Buf, InData%PLExp) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_UnPackSteady_InitInputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Steady_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackSteady_InitInputType' + if (Buf%ErrStat /= ErrID_None) return + ! HWindSpeed + call RegUnpack(Buf, OutData%HWindSpeed) + if (RegCheckErr(Buf, RoutineName)) return + ! RefHt + call RegUnpack(Buf, OutData%RefHt) + if (RegCheckErr(Buf, RoutineName)) return + ! PLExp + call RegUnpack(Buf, OutData%PLExp) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE InflowWind_IO_CopyUniform_InitInputType( SrcUniform_InitInputTypeData, DstUniform_InitInputTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(Uniform_InitInputType), INTENT(IN) :: SrcUniform_InitInputTypeData TYPE(Uniform_InitInputType), INTENT(INOUT) :: DstUniform_InitInputTypeData @@ -584,213 +420,55 @@ SUBROUTINE InflowWind_IO_DestroyUniform_InitInputType( Uniform_InitInputTypeData CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE InflowWind_IO_DestroyUniform_InitInputType - SUBROUTINE InflowWind_IO_PackUniform_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Uniform_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_PackUniform_InitInputType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%WindFileName) ! WindFileName - Re_BufSz = Re_BufSz + 1 ! RefHt - Re_BufSz = Re_BufSz + 1 ! RefLength - Re_BufSz = Re_BufSz + 1 ! PropagationDir - Int_BufSz = Int_BufSz + 1 ! UseInputFile - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! PassedFileData: size of buffers for each call to pack subtype - CALL NWTC_Library_PackFileInfoType( Re_Buf, Db_Buf, Int_Buf, InData%PassedFileData, ErrStat2, ErrMsg2, .TRUE. ) ! PassedFileData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PassedFileData - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PassedFileData - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PassedFileData - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%WindFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%WindFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf(Re_Xferred) = InData%RefHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RefLength - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PropagationDir - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseInputFile, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - CALL NWTC_Library_PackFileInfoType( Re_Buf, Db_Buf, Int_Buf, InData%PassedFileData, ErrStat2, ErrMsg2, OnlySize ) ! PassedFileData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE InflowWind_IO_PackUniform_InitInputType - - SUBROUTINE InflowWind_IO_UnPackUniform_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Uniform_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_UnPackUniform_InitInputType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%WindFileName) - OutData%WindFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%RefHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RefLength = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PropagationDir = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%UseInputFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseInputFile) - Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackFileInfoType( Re_Buf, Db_Buf, Int_Buf, OutData%PassedFileData, ErrStat2, ErrMsg2 ) ! PassedFileData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE InflowWind_IO_UnPackUniform_InitInputType +subroutine InflowWind_IO_PackUniform_InitInputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Uniform_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_IO_PackUniform_InitInputType' + if (Buf%ErrStat >= AbortErrLev) return + ! WindFileName + call RegPack(Buf, InData%WindFileName) + if (RegCheckErr(Buf, RoutineName)) return + ! RefHt + call RegPack(Buf, InData%RefHt) + if (RegCheckErr(Buf, RoutineName)) return + ! RefLength + call RegPack(Buf, InData%RefLength) + if (RegCheckErr(Buf, RoutineName)) return + ! PropagationDir + call RegPack(Buf, InData%PropagationDir) + if (RegCheckErr(Buf, RoutineName)) return + ! UseInputFile + call RegPack(Buf, InData%UseInputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! PassedFileData + call NWTC_Library_PackFileInfoType(Buf, InData%PassedFileData) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_UnPackUniform_InitInputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Uniform_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackUniform_InitInputType' + if (Buf%ErrStat /= ErrID_None) return + ! WindFileName + call RegUnpack(Buf, OutData%WindFileName) + if (RegCheckErr(Buf, RoutineName)) return + ! RefHt + call RegUnpack(Buf, OutData%RefHt) + if (RegCheckErr(Buf, RoutineName)) return + ! RefLength + call RegUnpack(Buf, OutData%RefLength) + if (RegCheckErr(Buf, RoutineName)) return + ! PropagationDir + call RegUnpack(Buf, OutData%PropagationDir) + if (RegCheckErr(Buf, RoutineName)) return + ! UseInputFile + call RegUnpack(Buf, OutData%UseInputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! PassedFileData + call NWTC_Library_UnpackFileInfoType(Buf, OutData%PassedFileData) ! PassedFileData +end subroutine SUBROUTINE InflowWind_IO_CopyGrid3D_InitInputType( SrcGrid3D_InitInputTypeData, DstGrid3D_InitInputTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(Grid3D_InitInputType), INTENT(IN) :: SrcGrid3D_InitInputTypeData TYPE(Grid3D_InitInputType), INTENT(INOUT) :: DstGrid3D_InitInputTypeData @@ -835,171 +513,92 @@ SUBROUTINE InflowWind_IO_DestroyGrid3D_InitInputType( Grid3D_InitInputTypeData, END SUBROUTINE InflowWind_IO_DestroyGrid3D_InitInputType - SUBROUTINE InflowWind_IO_PackGrid3D_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Grid3D_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_PackGrid3D_InitInputType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! ScaleMethod - Re_BufSz = Re_BufSz + SIZE(InData%SF) ! SF - Re_BufSz = Re_BufSz + SIZE(InData%SigmaF) ! SigmaF - Int_BufSz = Int_BufSz + 1 ! WindProfileType - Re_BufSz = Re_BufSz + 1 ! RefHt - Re_BufSz = Re_BufSz + 1 ! URef - Re_BufSz = Re_BufSz + 1 ! PLExp - Re_BufSz = Re_BufSz + 1 ! VLinShr - Re_BufSz = Re_BufSz + 1 ! HLinShr - Re_BufSz = Re_BufSz + 1 ! RefLength - Re_BufSz = Re_BufSz + 1 ! Z0 - Re_BufSz = Re_BufSz + 1 ! XOffset - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%ScaleMethod - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%SF,1), UBOUND(InData%SF,1) - ReKiBuf(Re_Xferred) = InData%SF(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%SigmaF,1), UBOUND(InData%SigmaF,1) - ReKiBuf(Re_Xferred) = InData%SigmaF(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%WindProfileType - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RefHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%URef - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PLExp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VLinShr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HLinShr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RefLength - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Z0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%XOffset - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE InflowWind_IO_PackGrid3D_InitInputType - - SUBROUTINE InflowWind_IO_UnPackGrid3D_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Grid3D_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_UnPackGrid3D_InitInputType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%ScaleMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%SF,1) - i1_u = UBOUND(OutData%SF,1) - DO i1 = LBOUND(OutData%SF,1), UBOUND(OutData%SF,1) - OutData%SF(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%SigmaF,1) - i1_u = UBOUND(OutData%SigmaF,1) - DO i1 = LBOUND(OutData%SigmaF,1), UBOUND(OutData%SigmaF,1) - OutData%SigmaF(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%WindProfileType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%RefHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%URef = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PLExp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VLinShr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HLinShr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RefLength = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Z0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%XOffset = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE InflowWind_IO_UnPackGrid3D_InitInputType +subroutine InflowWind_IO_PackGrid3D_InitInputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Grid3D_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_IO_PackGrid3D_InitInputType' + if (Buf%ErrStat >= AbortErrLev) return + ! ScaleMethod + call RegPack(Buf, InData%ScaleMethod) + if (RegCheckErr(Buf, RoutineName)) return + ! SF + call RegPack(Buf, InData%SF) + if (RegCheckErr(Buf, RoutineName)) return + ! SigmaF + call RegPack(Buf, InData%SigmaF) + if (RegCheckErr(Buf, RoutineName)) return + ! WindProfileType + call RegPack(Buf, InData%WindProfileType) + if (RegCheckErr(Buf, RoutineName)) return + ! RefHt + call RegPack(Buf, InData%RefHt) + if (RegCheckErr(Buf, RoutineName)) return + ! URef + call RegPack(Buf, InData%URef) + if (RegCheckErr(Buf, RoutineName)) return + ! PLExp + call RegPack(Buf, InData%PLExp) + if (RegCheckErr(Buf, RoutineName)) return + ! VLinShr + call RegPack(Buf, InData%VLinShr) + if (RegCheckErr(Buf, RoutineName)) return + ! HLinShr + call RegPack(Buf, InData%HLinShr) + if (RegCheckErr(Buf, RoutineName)) return + ! RefLength + call RegPack(Buf, InData%RefLength) + if (RegCheckErr(Buf, RoutineName)) return + ! Z0 + call RegPack(Buf, InData%Z0) + if (RegCheckErr(Buf, RoutineName)) return + ! XOffset + call RegPack(Buf, InData%XOffset) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_UnPackGrid3D_InitInputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Grid3D_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackGrid3D_InitInputType' + if (Buf%ErrStat /= ErrID_None) return + ! ScaleMethod + call RegUnpack(Buf, OutData%ScaleMethod) + if (RegCheckErr(Buf, RoutineName)) return + ! SF + call RegUnpack(Buf, OutData%SF) + if (RegCheckErr(Buf, RoutineName)) return + ! SigmaF + call RegUnpack(Buf, OutData%SigmaF) + if (RegCheckErr(Buf, RoutineName)) return + ! WindProfileType + call RegUnpack(Buf, OutData%WindProfileType) + if (RegCheckErr(Buf, RoutineName)) return + ! RefHt + call RegUnpack(Buf, OutData%RefHt) + if (RegCheckErr(Buf, RoutineName)) return + ! URef + call RegUnpack(Buf, OutData%URef) + if (RegCheckErr(Buf, RoutineName)) return + ! PLExp + call RegUnpack(Buf, OutData%PLExp) + if (RegCheckErr(Buf, RoutineName)) return + ! VLinShr + call RegUnpack(Buf, OutData%VLinShr) + if (RegCheckErr(Buf, RoutineName)) return + ! HLinShr + call RegUnpack(Buf, OutData%HLinShr) + if (RegCheckErr(Buf, RoutineName)) return + ! RefLength + call RegUnpack(Buf, OutData%RefLength) + if (RegCheckErr(Buf, RoutineName)) return + ! Z0 + call RegUnpack(Buf, OutData%Z0) + if (RegCheckErr(Buf, RoutineName)) return + ! XOffset + call RegUnpack(Buf, OutData%XOffset) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE InflowWind_IO_CopyTurbSim_InitInputType( SrcTurbSim_InitInputTypeData, DstTurbSim_InitInputTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(TurbSim_InitInputType), INTENT(IN) :: SrcTurbSim_InitInputTypeData TYPE(TurbSim_InitInputType), INTENT(INOUT) :: DstTurbSim_InitInputTypeData @@ -1032,107 +631,26 @@ SUBROUTINE InflowWind_IO_DestroyTurbSim_InitInputType( TurbSim_InitInputTypeData END SUBROUTINE InflowWind_IO_DestroyTurbSim_InitInputType - SUBROUTINE InflowWind_IO_PackTurbSim_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(TurbSim_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_PackTurbSim_InitInputType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%WindFileName) ! WindFileName - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%WindFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%WindFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE InflowWind_IO_PackTurbSim_InitInputType - - SUBROUTINE InflowWind_IO_UnPackTurbSim_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(TurbSim_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_UnPackTurbSim_InitInputType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%WindFileName) - OutData%WindFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE InflowWind_IO_UnPackTurbSim_InitInputType +subroutine InflowWind_IO_PackTurbSim_InitInputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(TurbSim_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_IO_PackTurbSim_InitInputType' + if (Buf%ErrStat >= AbortErrLev) return + ! WindFileName + call RegPack(Buf, InData%WindFileName) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_UnPackTurbSim_InitInputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(TurbSim_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackTurbSim_InitInputType' + if (Buf%ErrStat /= ErrID_None) return + ! WindFileName + call RegUnpack(Buf, OutData%WindFileName) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE InflowWind_IO_CopyBladed_InitInputType( SrcBladed_InitInputTypeData, DstBladed_InitInputTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(Bladed_InitInputType), INTENT(IN) :: SrcBladed_InitInputTypeData TYPE(Bladed_InitInputType), INTENT(INOUT) :: DstBladed_InitInputTypeData @@ -1170,132 +688,56 @@ SUBROUTINE InflowWind_IO_DestroyBladed_InitInputType( Bladed_InitInputTypeData, END SUBROUTINE InflowWind_IO_DestroyBladed_InitInputType - SUBROUTINE InflowWind_IO_PackBladed_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Bladed_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_PackBladed_InitInputType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%WindFileName) ! WindFileName - Int_BufSz = Int_BufSz + 1 ! WindType - Int_BufSz = Int_BufSz + 1 ! NativeBladedFmt - Int_BufSz = Int_BufSz + 1 ! TowerFileExist - Int_BufSz = Int_BufSz + 1 ! TurbineID - Int_BufSz = Int_BufSz + 1 ! FixedWindFileRootName - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%WindFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%WindFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%WindType - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%NativeBladedFmt, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TowerFileExist, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TurbineID - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FixedWindFileRootName, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE InflowWind_IO_PackBladed_InitInputType - - SUBROUTINE InflowWind_IO_UnPackBladed_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Bladed_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_UnPackBladed_InitInputType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%WindFileName) - OutData%WindFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%WindType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NativeBladedFmt = TRANSFER(IntKiBuf(Int_Xferred), OutData%NativeBladedFmt) - Int_Xferred = Int_Xferred + 1 - OutData%TowerFileExist = TRANSFER(IntKiBuf(Int_Xferred), OutData%TowerFileExist) - Int_Xferred = Int_Xferred + 1 - OutData%TurbineID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FixedWindFileRootName = TRANSFER(IntKiBuf(Int_Xferred), OutData%FixedWindFileRootName) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE InflowWind_IO_UnPackBladed_InitInputType +subroutine InflowWind_IO_PackBladed_InitInputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Bladed_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_IO_PackBladed_InitInputType' + if (Buf%ErrStat >= AbortErrLev) return + ! WindFileName + call RegPack(Buf, InData%WindFileName) + if (RegCheckErr(Buf, RoutineName)) return + ! WindType + call RegPack(Buf, InData%WindType) + if (RegCheckErr(Buf, RoutineName)) return + ! NativeBladedFmt + call RegPack(Buf, InData%NativeBladedFmt) + if (RegCheckErr(Buf, RoutineName)) return + ! TowerFileExist + call RegPack(Buf, InData%TowerFileExist) + if (RegCheckErr(Buf, RoutineName)) return + ! TurbineID + call RegPack(Buf, InData%TurbineID) + if (RegCheckErr(Buf, RoutineName)) return + ! FixedWindFileRootName + call RegPack(Buf, InData%FixedWindFileRootName) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_UnPackBladed_InitInputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Bladed_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackBladed_InitInputType' + if (Buf%ErrStat /= ErrID_None) return + ! WindFileName + call RegUnpack(Buf, OutData%WindFileName) + if (RegCheckErr(Buf, RoutineName)) return + ! WindType + call RegUnpack(Buf, OutData%WindType) + if (RegCheckErr(Buf, RoutineName)) return + ! NativeBladedFmt + call RegUnpack(Buf, OutData%NativeBladedFmt) + if (RegCheckErr(Buf, RoutineName)) return + ! TowerFileExist + call RegUnpack(Buf, OutData%TowerFileExist) + if (RegCheckErr(Buf, RoutineName)) return + ! TurbineID + call RegUnpack(Buf, OutData%TurbineID) + if (RegCheckErr(Buf, RoutineName)) return + ! FixedWindFileRootName + call RegUnpack(Buf, OutData%FixedWindFileRootName) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE InflowWind_IO_CopyBladed_InitOutputType( SrcBladed_InitOutputTypeData, DstBladed_InitOutputTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(Bladed_InitOutputType), INTENT(IN) :: SrcBladed_InitOutputTypeData TYPE(Bladed_InitOutputType), INTENT(INOUT) :: DstBladed_InitOutputTypeData @@ -1329,108 +771,32 @@ SUBROUTINE InflowWind_IO_DestroyBladed_InitOutputType( Bladed_InitOutputTypeData END SUBROUTINE InflowWind_IO_DestroyBladed_InitOutputType - SUBROUTINE InflowWind_IO_PackBladed_InitOutputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Bladed_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_PackBladed_InitOutputType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! PropagationDir - Re_BufSz = Re_BufSz + 1 ! VFlowAngle - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%PropagationDir - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VFlowAngle - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE InflowWind_IO_PackBladed_InitOutputType - - SUBROUTINE InflowWind_IO_UnPackBladed_InitOutputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Bladed_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_UnPackBladed_InitOutputType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%PropagationDir = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VFlowAngle = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE InflowWind_IO_UnPackBladed_InitOutputType +subroutine InflowWind_IO_PackBladed_InitOutputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Bladed_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_IO_PackBladed_InitOutputType' + if (Buf%ErrStat >= AbortErrLev) return + ! PropagationDir + call RegPack(Buf, InData%PropagationDir) + if (RegCheckErr(Buf, RoutineName)) return + ! VFlowAngle + call RegPack(Buf, InData%VFlowAngle) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_UnPackBladed_InitOutputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Bladed_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackBladed_InitOutputType' + if (Buf%ErrStat /= ErrID_None) return + ! PropagationDir + call RegUnpack(Buf, OutData%PropagationDir) + if (RegCheckErr(Buf, RoutineName)) return + ! VFlowAngle + call RegUnpack(Buf, OutData%VFlowAngle) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE InflowWind_IO_CopyHAWC_InitInputType( SrcHAWC_InitInputTypeData, DstHAWC_InitInputTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(HAWC_InitInputType), INTENT(IN) :: SrcHAWC_InitInputTypeData TYPE(HAWC_InitInputType), INTENT(INOUT) :: DstHAWC_InitInputTypeData @@ -1475,230 +841,67 @@ SUBROUTINE InflowWind_IO_DestroyHAWC_InitInputType( HAWC_InitInputTypeData, ErrS CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE InflowWind_IO_DestroyHAWC_InitInputType - SUBROUTINE InflowWind_IO_PackHAWC_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(HAWC_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_PackHAWC_InitInputType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + SIZE(InData%WindFileName)*LEN(InData%WindFileName) ! WindFileName - Int_BufSz = Int_BufSz + 1 ! nx - Int_BufSz = Int_BufSz + 1 ! ny - Int_BufSz = Int_BufSz + 1 ! nz - Re_BufSz = Re_BufSz + 1 ! dx - Re_BufSz = Re_BufSz + 1 ! dy - Re_BufSz = Re_BufSz + 1 ! dz - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! G3D: size of buffers for each call to pack subtype - CALL InflowWind_IO_PackGrid3D_InitInputType( Re_Buf, Db_Buf, Int_Buf, InData%G3D, ErrStat2, ErrMsg2, .TRUE. ) ! G3D - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! G3D - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! G3D - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! G3D - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i1 = LBOUND(InData%WindFileName,1), UBOUND(InData%WindFileName,1) - DO I = 1, LEN(InData%WindFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%WindFileName(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - IntKiBuf(Int_Xferred) = InData%nx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ny - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nz - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dx - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dy - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dz - Re_Xferred = Re_Xferred + 1 - CALL InflowWind_IO_PackGrid3D_InitInputType( Re_Buf, Db_Buf, Int_Buf, InData%G3D, ErrStat2, ErrMsg2, OnlySize ) ! G3D - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE InflowWind_IO_PackHAWC_InitInputType - - SUBROUTINE InflowWind_IO_UnPackHAWC_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(HAWC_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_UnPackHAWC_InitInputType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%WindFileName,1) - i1_u = UBOUND(OutData%WindFileName,1) - DO i1 = LBOUND(OutData%WindFileName,1), UBOUND(OutData%WindFileName,1) - DO I = 1, LEN(OutData%WindFileName) - OutData%WindFileName(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - OutData%nx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ny = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nz = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%dx = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dy = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dz = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_IO_UnpackGrid3D_InitInputType( Re_Buf, Db_Buf, Int_Buf, OutData%G3D, ErrStat2, ErrMsg2 ) ! G3D - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE InflowWind_IO_UnPackHAWC_InitInputType +subroutine InflowWind_IO_PackHAWC_InitInputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(HAWC_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_IO_PackHAWC_InitInputType' + if (Buf%ErrStat >= AbortErrLev) return + ! WindFileName + call RegPack(Buf, InData%WindFileName) + if (RegCheckErr(Buf, RoutineName)) return + ! nx + call RegPack(Buf, InData%nx) + if (RegCheckErr(Buf, RoutineName)) return + ! ny + call RegPack(Buf, InData%ny) + if (RegCheckErr(Buf, RoutineName)) return + ! nz + call RegPack(Buf, InData%nz) + if (RegCheckErr(Buf, RoutineName)) return + ! dx + call RegPack(Buf, InData%dx) + if (RegCheckErr(Buf, RoutineName)) return + ! dy + call RegPack(Buf, InData%dy) + if (RegCheckErr(Buf, RoutineName)) return + ! dz + call RegPack(Buf, InData%dz) + if (RegCheckErr(Buf, RoutineName)) return + ! G3D + call InflowWind_IO_PackGrid3D_InitInputType(Buf, InData%G3D) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_UnPackHAWC_InitInputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(HAWC_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackHAWC_InitInputType' + if (Buf%ErrStat /= ErrID_None) return + ! WindFileName + call RegUnpack(Buf, OutData%WindFileName) + if (RegCheckErr(Buf, RoutineName)) return + ! nx + call RegUnpack(Buf, OutData%nx) + if (RegCheckErr(Buf, RoutineName)) return + ! ny + call RegUnpack(Buf, OutData%ny) + if (RegCheckErr(Buf, RoutineName)) return + ! nz + call RegUnpack(Buf, OutData%nz) + if (RegCheckErr(Buf, RoutineName)) return + ! dx + call RegUnpack(Buf, OutData%dx) + if (RegCheckErr(Buf, RoutineName)) return + ! dy + call RegUnpack(Buf, OutData%dy) + if (RegCheckErr(Buf, RoutineName)) return + ! dz + call RegUnpack(Buf, OutData%dz) + if (RegCheckErr(Buf, RoutineName)) return + ! G3D + call InflowWind_IO_UnpackGrid3D_InitInputType(Buf, OutData%G3D) ! G3D +end subroutine SUBROUTINE InflowWind_IO_CopyUser_InitInputType( SrcUser_InitInputTypeData, DstUser_InitInputTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(User_InitInputType), INTENT(IN) :: SrcUser_InitInputTypeData TYPE(User_InitInputType), INTENT(INOUT) :: DstUser_InitInputTypeData @@ -1731,103 +934,26 @@ SUBROUTINE InflowWind_IO_DestroyUser_InitInputType( User_InitInputTypeData, ErrS END SUBROUTINE InflowWind_IO_DestroyUser_InitInputType - SUBROUTINE InflowWind_IO_PackUser_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(User_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_PackUser_InitInputType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! Dummy - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%Dummy - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE InflowWind_IO_PackUser_InitInputType - - SUBROUTINE InflowWind_IO_UnPackUser_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(User_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_UnPackUser_InitInputType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%Dummy = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE InflowWind_IO_UnPackUser_InitInputType +subroutine InflowWind_IO_PackUser_InitInputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(User_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_IO_PackUser_InitInputType' + if (Buf%ErrStat >= AbortErrLev) return + ! Dummy + call RegPack(Buf, InData%Dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_UnPackUser_InitInputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(User_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackUser_InitInputType' + if (Buf%ErrStat /= ErrID_None) return + ! Dummy + call RegUnpack(Buf, OutData%Dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE InflowWind_IO_CopyGrid4D_InitInputType( SrcGrid4D_InitInputTypeData, DstGrid4D_InitInputTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(Grid4D_InitInputType), INTENT(IN) :: SrcGrid4D_InitInputTypeData TYPE(Grid4D_InitInputType), INTENT(INOUT) :: DstGrid4D_InitInputTypeData @@ -1869,137 +995,79 @@ SUBROUTINE InflowWind_IO_DestroyGrid4D_InitInputType( Grid4D_InitInputTypeData, NULLIFY(Grid4D_InitInputTypeData%Vel) END SUBROUTINE InflowWind_IO_DestroyGrid4D_InitInputType - SUBROUTINE InflowWind_IO_PackGrid4D_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Grid4D_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_PackGrid4D_InitInputType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + SIZE(InData%n) ! n - Re_BufSz = Re_BufSz + SIZE(InData%delta) ! delta - Re_BufSz = Re_BufSz + SIZE(InData%pZero) ! pZero - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i1 = LBOUND(InData%n,1), UBOUND(InData%n,1) - IntKiBuf(Int_Xferred) = InData%n(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%delta,1), UBOUND(InData%delta,1) - ReKiBuf(Re_Xferred) = InData%delta(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%pZero,1), UBOUND(InData%pZero,1) - ReKiBuf(Re_Xferred) = InData%pZero(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE InflowWind_IO_PackGrid4D_InitInputType - - SUBROUTINE InflowWind_IO_UnPackGrid4D_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Grid4D_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_UnPackGrid4D_InitInputType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%n,1) - i1_u = UBOUND(OutData%n,1) - DO i1 = LBOUND(OutData%n,1), UBOUND(OutData%n,1) - OutData%n(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%delta,1) - i1_u = UBOUND(OutData%delta,1) - DO i1 = LBOUND(OutData%delta,1), UBOUND(OutData%delta,1) - OutData%delta(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%pZero,1) - i1_u = UBOUND(OutData%pZero,1) - DO i1 = LBOUND(OutData%pZero,1), UBOUND(OutData%pZero,1) - OutData%pZero(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - NULLIFY(OutData%Vel) - END SUBROUTINE InflowWind_IO_UnPackGrid4D_InitInputType +subroutine InflowWind_IO_PackGrid4D_InitInputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Grid4D_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_IO_PackGrid4D_InitInputType' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + ! n + call RegPack(Buf, InData%n) + if (RegCheckErr(Buf, RoutineName)) return + ! delta + call RegPack(Buf, InData%delta) + if (RegCheckErr(Buf, RoutineName)) return + ! pZero + call RegPack(Buf, InData%pZero) + if (RegCheckErr(Buf, RoutineName)) return + ! Vel + call RegPack(Buf, associated(InData%Vel)) + if (associated(InData%Vel)) then + call RegPackBounds(Buf, 5, lbound(InData%Vel), ubound(InData%Vel)) + call RegPackPointer(Buf, c_loc(InData%Vel), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%Vel) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_UnPackGrid4D_InitInputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Grid4D_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackGrid4D_InitInputType' + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + ! n + call RegUnpack(Buf, OutData%n) + if (RegCheckErr(Buf, RoutineName)) return + ! delta + call RegUnpack(Buf, OutData%delta) + if (RegCheckErr(Buf, RoutineName)) return + ! pZero + call RegUnpack(Buf, OutData%pZero) + if (RegCheckErr(Buf, RoutineName)) return + ! Vel + if (associated(OutData%Vel)) deallocate(OutData%Vel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Vel, UB(1:5)-LB(1:5)) + OutData%Vel(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => OutData%Vel + else + allocate(OutData%Vel(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Vel) + call RegUnpack(Buf, OutData%Vel) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%Vel => null() + end if +end subroutine SUBROUTINE InflowWind_IO_CopyPoints_InitInputType( SrcPoints_InitInputTypeData, DstPoints_InitInputTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(Points_InitInputType), INTENT(IN) :: SrcPoints_InitInputTypeData TYPE(Points_InitInputType), INTENT(INOUT) :: DstPoints_InitInputTypeData @@ -2032,102 +1100,25 @@ SUBROUTINE InflowWind_IO_DestroyPoints_InitInputType( Points_InitInputTypeData, END SUBROUTINE InflowWind_IO_DestroyPoints_InitInputType - SUBROUTINE InflowWind_IO_PackPoints_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Points_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_PackPoints_InitInputType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! NumWindPoints - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%NumWindPoints - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE InflowWind_IO_PackPoints_InitInputType - - SUBROUTINE InflowWind_IO_UnPackPoints_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Points_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_UnPackPoints_InitInputType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%NumWindPoints = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE InflowWind_IO_UnPackPoints_InitInputType +subroutine InflowWind_IO_PackPoints_InitInputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Points_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_IO_PackPoints_InitInputType' + if (Buf%ErrStat >= AbortErrLev) return + ! NumWindPoints + call RegPack(Buf, InData%NumWindPoints) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_IO_UnPackPoints_InitInputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Points_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackPoints_InitInputType' + if (Buf%ErrStat /= ErrID_None) return + ! NumWindPoints + call RegUnpack(Buf, OutData%NumWindPoints) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine END MODULE InflowWind_IO_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/inflowwind/src/InflowWind_Types.f90 b/modules/inflowwind/src/InflowWind_Types.f90 index e69719c38a..dfe8525dc1 100644 --- a/modules/inflowwind/src/InflowWind_Types.f90 +++ b/modules/inflowwind/src/InflowWind_Types.f90 @@ -382,683 +382,410 @@ SUBROUTINE InflowWind_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE InflowWind_DestroyInputFile - SUBROUTINE InflowWind_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(InflowWind_InputFile), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_PackInputFile' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! EchoFlag - Int_BufSz = Int_BufSz + 1 ! WindType - Re_BufSz = Re_BufSz + 1 ! PropagationDir - Re_BufSz = Re_BufSz + 1 ! VFlowAngle - Int_BufSz = Int_BufSz + 1 ! VelInterpCubic - Int_BufSz = Int_BufSz + 1 ! NWindVel - Int_BufSz = Int_BufSz + 1 ! WindVxiList allocated yes/no - IF ( ALLOCATED(InData%WindVxiList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WindVxiList upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WindVxiList) ! WindVxiList - END IF - Int_BufSz = Int_BufSz + 1 ! WindVyiList allocated yes/no - IF ( ALLOCATED(InData%WindVyiList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WindVyiList upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WindVyiList) ! WindVyiList - END IF - Int_BufSz = Int_BufSz + 1 ! WindVziList allocated yes/no - IF ( ALLOCATED(InData%WindVziList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WindVziList upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WindVziList) ! WindVziList - END IF - Re_BufSz = Re_BufSz + 1 ! Steady_HWindSpeed - Re_BufSz = Re_BufSz + 1 ! Steady_RefHt - Re_BufSz = Re_BufSz + 1 ! Steady_PLexp - Int_BufSz = Int_BufSz + 1*LEN(InData%Uniform_FileName) ! Uniform_FileName - Re_BufSz = Re_BufSz + 1 ! Uniform_RefHt - Re_BufSz = Re_BufSz + 1 ! Uniform_RefLength - Int_BufSz = Int_BufSz + 1*LEN(InData%TSFF_FileName) ! TSFF_FileName - Int_BufSz = Int_BufSz + 1*LEN(InData%BladedFF_FileName) ! BladedFF_FileName - Int_BufSz = Int_BufSz + 1 ! BladedFF_TowerFile - Int_BufSz = Int_BufSz + 1 ! CTTS_CoherentTurb - Int_BufSz = Int_BufSz + 1*LEN(InData%CTTS_FileName) ! CTTS_FileName - Int_BufSz = Int_BufSz + 1*LEN(InData%CTTS_Path) ! CTTS_Path - Int_BufSz = Int_BufSz + 1*LEN(InData%HAWC_FileName_u) ! HAWC_FileName_u - Int_BufSz = Int_BufSz + 1*LEN(InData%HAWC_FileName_v) ! HAWC_FileName_v - Int_BufSz = Int_BufSz + 1*LEN(InData%HAWC_FileName_w) ! HAWC_FileName_w - Int_BufSz = Int_BufSz + 1 ! HAWC_nx - Int_BufSz = Int_BufSz + 1 ! HAWC_ny - Int_BufSz = Int_BufSz + 1 ! HAWC_nz - Re_BufSz = Re_BufSz + 1 ! HAWC_dx - Re_BufSz = Re_BufSz + 1 ! HAWC_dy - Re_BufSz = Re_BufSz + 1 ! HAWC_dz - Int_BufSz = Int_BufSz + 1 ! SumPrint - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! OutList allocated yes/no - IF ( ALLOCATED(InData%OutList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%OutList)*LEN(InData%OutList) ! OutList - END IF - Int_BufSz = Int_BufSz + 1 ! SensorType - Int_BufSz = Int_BufSz + 1 ! NumBeam - Int_BufSz = Int_BufSz + 1 ! NumPulseGate - Re_BufSz = Re_BufSz + SIZE(InData%RotorApexOffsetPos) ! RotorApexOffsetPos - Int_BufSz = Int_BufSz + 1 ! FocalDistanceX allocated yes/no - IF ( ALLOCATED(InData%FocalDistanceX) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FocalDistanceX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FocalDistanceX) ! FocalDistanceX - END IF - Int_BufSz = Int_BufSz + 1 ! FocalDistanceY allocated yes/no - IF ( ALLOCATED(InData%FocalDistanceY) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FocalDistanceY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FocalDistanceY) ! FocalDistanceY - END IF - Int_BufSz = Int_BufSz + 1 ! FocalDistanceZ allocated yes/no - IF ( ALLOCATED(InData%FocalDistanceZ) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FocalDistanceZ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FocalDistanceZ) ! FocalDistanceZ - END IF - Re_BufSz = Re_BufSz + 1 ! PulseSpacing - Re_BufSz = Re_BufSz + 1 ! MeasurementInterval - Re_BufSz = Re_BufSz + 1 ! URefLid - Int_BufSz = Int_BufSz + 1 ! LidRadialVel - Int_BufSz = Int_BufSz + 1 ! ConsiderHubMotion - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! FF: size of buffers for each call to pack subtype - CALL InflowWind_IO_PackGrid3D_InitInputType( Re_Buf, Db_Buf, Int_Buf, InData%FF, ErrStat2, ErrMsg2, .TRUE. ) ! FF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FF - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FF - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FF - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = TRANSFER(InData%EchoFlag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WindType - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PropagationDir - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VFlowAngle - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%VelInterpCubic, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NWindVel - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WindVxiList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WindVxiList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindVxiList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WindVxiList,1), UBOUND(InData%WindVxiList,1) - ReKiBuf(Re_Xferred) = InData%WindVxiList(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WindVyiList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WindVyiList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindVyiList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WindVyiList,1), UBOUND(InData%WindVyiList,1) - ReKiBuf(Re_Xferred) = InData%WindVyiList(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WindVziList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WindVziList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindVziList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WindVziList,1), UBOUND(InData%WindVziList,1) - ReKiBuf(Re_Xferred) = InData%WindVziList(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%Steady_HWindSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Steady_RefHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Steady_PLexp - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%Uniform_FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%Uniform_FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf(Re_Xferred) = InData%Uniform_RefHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Uniform_RefLength - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%TSFF_FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%TSFF_FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%BladedFF_FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%BladedFF_FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%BladedFF_TowerFile, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%CTTS_CoherentTurb, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%CTTS_FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%CTTS_FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%CTTS_Path) - IntKiBuf(Int_Xferred) = ICHAR(InData%CTTS_Path(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%HAWC_FileName_u) - IntKiBuf(Int_Xferred) = ICHAR(InData%HAWC_FileName_u(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%HAWC_FileName_v) - IntKiBuf(Int_Xferred) = ICHAR(InData%HAWC_FileName_v(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%HAWC_FileName_w) - IntKiBuf(Int_Xferred) = ICHAR(InData%HAWC_FileName_w(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%HAWC_nx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%HAWC_ny - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%HAWC_nz - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HAWC_dx - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HAWC_dy - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HAWC_dz - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) - DO I = 1, LEN(InData%OutList) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IntKiBuf(Int_Xferred) = InData%SensorType - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBeam - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumPulseGate - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%RotorApexOffsetPos,1), UBOUND(InData%RotorApexOffsetPos,1) - ReKiBuf(Re_Xferred) = InData%RotorApexOffsetPos(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%FocalDistanceX) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FocalDistanceX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FocalDistanceX,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FocalDistanceX,1), UBOUND(InData%FocalDistanceX,1) - ReKiBuf(Re_Xferred) = InData%FocalDistanceX(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FocalDistanceY) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FocalDistanceY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FocalDistanceY,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FocalDistanceY,1), UBOUND(InData%FocalDistanceY,1) - ReKiBuf(Re_Xferred) = InData%FocalDistanceY(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FocalDistanceZ) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FocalDistanceZ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FocalDistanceZ,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FocalDistanceZ,1), UBOUND(InData%FocalDistanceZ,1) - ReKiBuf(Re_Xferred) = InData%FocalDistanceZ(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%PulseSpacing - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MeasurementInterval - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%URefLid - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%LidRadialVel, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ConsiderHubMotion - Int_Xferred = Int_Xferred + 1 - CALL InflowWind_IO_PackGrid3D_InitInputType( Re_Buf, Db_Buf, Int_Buf, InData%FF, ErrStat2, ErrMsg2, OnlySize ) ! FF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE InflowWind_PackInputFile - - SUBROUTINE InflowWind_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(InflowWind_InputFile), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_UnPackInputFile' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%EchoFlag = TRANSFER(IntKiBuf(Int_Xferred), OutData%EchoFlag) - Int_Xferred = Int_Xferred + 1 - OutData%WindType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%PropagationDir = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VFlowAngle = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VelInterpCubic = TRANSFER(IntKiBuf(Int_Xferred), OutData%VelInterpCubic) - Int_Xferred = Int_Xferred + 1 - OutData%NWindVel = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindVxiList not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WindVxiList)) DEALLOCATE(OutData%WindVxiList) - ALLOCATE(OutData%WindVxiList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindVxiList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WindVxiList,1), UBOUND(OutData%WindVxiList,1) - OutData%WindVxiList(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindVyiList not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WindVyiList)) DEALLOCATE(OutData%WindVyiList) - ALLOCATE(OutData%WindVyiList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindVyiList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WindVyiList,1), UBOUND(OutData%WindVyiList,1) - OutData%WindVyiList(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindVziList not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WindVziList)) DEALLOCATE(OutData%WindVziList) - ALLOCATE(OutData%WindVziList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindVziList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WindVziList,1), UBOUND(OutData%WindVziList,1) - OutData%WindVziList(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Steady_HWindSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Steady_RefHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Steady_PLexp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%Uniform_FileName) - OutData%Uniform_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Uniform_RefHt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Uniform_RefLength = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%TSFF_FileName) - OutData%TSFF_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%BladedFF_FileName) - OutData%BladedFF_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%BladedFF_TowerFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%BladedFF_TowerFile) - Int_Xferred = Int_Xferred + 1 - OutData%CTTS_CoherentTurb = TRANSFER(IntKiBuf(Int_Xferred), OutData%CTTS_CoherentTurb) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%CTTS_FileName) - OutData%CTTS_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%CTTS_Path) - OutData%CTTS_Path(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%HAWC_FileName_u) - OutData%HAWC_FileName_u(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%HAWC_FileName_v) - OutData%HAWC_FileName_v(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%HAWC_FileName_w) - OutData%HAWC_FileName_w(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%HAWC_nx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%HAWC_ny = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%HAWC_nz = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%HAWC_dx = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_dy = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_dz = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutList not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutList)) DEALLOCATE(OutData%OutList) - ALLOCATE(OutData%OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) - DO I = 1, LEN(OutData%OutList) - OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - OutData%SensorType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumBeam = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumPulseGate = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%RotorApexOffsetPos,1) - i1_u = UBOUND(OutData%RotorApexOffsetPos,1) - DO i1 = LBOUND(OutData%RotorApexOffsetPos,1), UBOUND(OutData%RotorApexOffsetPos,1) - OutData%RotorApexOffsetPos(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FocalDistanceX not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FocalDistanceX)) DEALLOCATE(OutData%FocalDistanceX) - ALLOCATE(OutData%FocalDistanceX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FocalDistanceX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FocalDistanceX,1), UBOUND(OutData%FocalDistanceX,1) - OutData%FocalDistanceX(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FocalDistanceY not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FocalDistanceY)) DEALLOCATE(OutData%FocalDistanceY) - ALLOCATE(OutData%FocalDistanceY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FocalDistanceY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FocalDistanceY,1), UBOUND(OutData%FocalDistanceY,1) - OutData%FocalDistanceY(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FocalDistanceZ not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FocalDistanceZ)) DEALLOCATE(OutData%FocalDistanceZ) - ALLOCATE(OutData%FocalDistanceZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FocalDistanceZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FocalDistanceZ,1), UBOUND(OutData%FocalDistanceZ,1) - OutData%FocalDistanceZ(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%PulseSpacing = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MeasurementInterval = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%URefLid = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LidRadialVel = TRANSFER(IntKiBuf(Int_Xferred), OutData%LidRadialVel) - Int_Xferred = Int_Xferred + 1 - OutData%ConsiderHubMotion = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_IO_UnpackGrid3D_InitInputType( Re_Buf, Db_Buf, Int_Buf, OutData%FF, ErrStat2, ErrMsg2 ) ! FF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE InflowWind_UnPackInputFile +subroutine InflowWind_PackInputFile(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_InputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_PackInputFile' + if (Buf%ErrStat >= AbortErrLev) return + ! EchoFlag + call RegPack(Buf, InData%EchoFlag) + if (RegCheckErr(Buf, RoutineName)) return + ! WindType + call RegPack(Buf, InData%WindType) + if (RegCheckErr(Buf, RoutineName)) return + ! PropagationDir + call RegPack(Buf, InData%PropagationDir) + if (RegCheckErr(Buf, RoutineName)) return + ! VFlowAngle + call RegPack(Buf, InData%VFlowAngle) + if (RegCheckErr(Buf, RoutineName)) return + ! VelInterpCubic + call RegPack(Buf, InData%VelInterpCubic) + if (RegCheckErr(Buf, RoutineName)) return + ! NWindVel + call RegPack(Buf, InData%NWindVel) + if (RegCheckErr(Buf, RoutineName)) return + ! WindVxiList + call RegPack(Buf, allocated(InData%WindVxiList)) + if (allocated(InData%WindVxiList)) then + call RegPackBounds(Buf, 1, lbound(InData%WindVxiList), ubound(InData%WindVxiList)) + call RegPack(Buf, InData%WindVxiList) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WindVyiList + call RegPack(Buf, allocated(InData%WindVyiList)) + if (allocated(InData%WindVyiList)) then + call RegPackBounds(Buf, 1, lbound(InData%WindVyiList), ubound(InData%WindVyiList)) + call RegPack(Buf, InData%WindVyiList) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WindVziList + call RegPack(Buf, allocated(InData%WindVziList)) + if (allocated(InData%WindVziList)) then + call RegPackBounds(Buf, 1, lbound(InData%WindVziList), ubound(InData%WindVziList)) + call RegPack(Buf, InData%WindVziList) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Steady_HWindSpeed + call RegPack(Buf, InData%Steady_HWindSpeed) + if (RegCheckErr(Buf, RoutineName)) return + ! Steady_RefHt + call RegPack(Buf, InData%Steady_RefHt) + if (RegCheckErr(Buf, RoutineName)) return + ! Steady_PLexp + call RegPack(Buf, InData%Steady_PLexp) + if (RegCheckErr(Buf, RoutineName)) return + ! Uniform_FileName + call RegPack(Buf, InData%Uniform_FileName) + if (RegCheckErr(Buf, RoutineName)) return + ! Uniform_RefHt + call RegPack(Buf, InData%Uniform_RefHt) + if (RegCheckErr(Buf, RoutineName)) return + ! Uniform_RefLength + call RegPack(Buf, InData%Uniform_RefLength) + if (RegCheckErr(Buf, RoutineName)) return + ! TSFF_FileName + call RegPack(Buf, InData%TSFF_FileName) + if (RegCheckErr(Buf, RoutineName)) return + ! BladedFF_FileName + call RegPack(Buf, InData%BladedFF_FileName) + if (RegCheckErr(Buf, RoutineName)) return + ! BladedFF_TowerFile + call RegPack(Buf, InData%BladedFF_TowerFile) + if (RegCheckErr(Buf, RoutineName)) return + ! CTTS_CoherentTurb + call RegPack(Buf, InData%CTTS_CoherentTurb) + if (RegCheckErr(Buf, RoutineName)) return + ! CTTS_FileName + call RegPack(Buf, InData%CTTS_FileName) + if (RegCheckErr(Buf, RoutineName)) return + ! CTTS_Path + call RegPack(Buf, InData%CTTS_Path) + if (RegCheckErr(Buf, RoutineName)) return + ! HAWC_FileName_u + call RegPack(Buf, InData%HAWC_FileName_u) + if (RegCheckErr(Buf, RoutineName)) return + ! HAWC_FileName_v + call RegPack(Buf, InData%HAWC_FileName_v) + if (RegCheckErr(Buf, RoutineName)) return + ! HAWC_FileName_w + call RegPack(Buf, InData%HAWC_FileName_w) + if (RegCheckErr(Buf, RoutineName)) return + ! HAWC_nx + call RegPack(Buf, InData%HAWC_nx) + if (RegCheckErr(Buf, RoutineName)) return + ! HAWC_ny + call RegPack(Buf, InData%HAWC_ny) + if (RegCheckErr(Buf, RoutineName)) return + ! HAWC_nz + call RegPack(Buf, InData%HAWC_nz) + if (RegCheckErr(Buf, RoutineName)) return + ! HAWC_dx + call RegPack(Buf, InData%HAWC_dx) + if (RegCheckErr(Buf, RoutineName)) return + ! HAWC_dy + call RegPack(Buf, InData%HAWC_dy) + if (RegCheckErr(Buf, RoutineName)) return + ! HAWC_dz + call RegPack(Buf, InData%HAWC_dz) + if (RegCheckErr(Buf, RoutineName)) return + ! SumPrint + call RegPack(Buf, InData%SumPrint) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegPack(Buf, InData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! OutList + call RegPack(Buf, allocated(InData%OutList)) + if (allocated(InData%OutList)) then + call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) + call RegPack(Buf, InData%OutList) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SensorType + call RegPack(Buf, InData%SensorType) + if (RegCheckErr(Buf, RoutineName)) return + ! NumBeam + call RegPack(Buf, InData%NumBeam) + if (RegCheckErr(Buf, RoutineName)) return + ! NumPulseGate + call RegPack(Buf, InData%NumPulseGate) + if (RegCheckErr(Buf, RoutineName)) return + ! RotorApexOffsetPos + call RegPack(Buf, InData%RotorApexOffsetPos) + if (RegCheckErr(Buf, RoutineName)) return + ! FocalDistanceX + call RegPack(Buf, allocated(InData%FocalDistanceX)) + if (allocated(InData%FocalDistanceX)) then + call RegPackBounds(Buf, 1, lbound(InData%FocalDistanceX), ubound(InData%FocalDistanceX)) + call RegPack(Buf, InData%FocalDistanceX) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FocalDistanceY + call RegPack(Buf, allocated(InData%FocalDistanceY)) + if (allocated(InData%FocalDistanceY)) then + call RegPackBounds(Buf, 1, lbound(InData%FocalDistanceY), ubound(InData%FocalDistanceY)) + call RegPack(Buf, InData%FocalDistanceY) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FocalDistanceZ + call RegPack(Buf, allocated(InData%FocalDistanceZ)) + if (allocated(InData%FocalDistanceZ)) then + call RegPackBounds(Buf, 1, lbound(InData%FocalDistanceZ), ubound(InData%FocalDistanceZ)) + call RegPack(Buf, InData%FocalDistanceZ) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PulseSpacing + call RegPack(Buf, InData%PulseSpacing) + if (RegCheckErr(Buf, RoutineName)) return + ! MeasurementInterval + call RegPack(Buf, InData%MeasurementInterval) + if (RegCheckErr(Buf, RoutineName)) return + ! URefLid + call RegPack(Buf, InData%URefLid) + if (RegCheckErr(Buf, RoutineName)) return + ! LidRadialVel + call RegPack(Buf, InData%LidRadialVel) + if (RegCheckErr(Buf, RoutineName)) return + ! ConsiderHubMotion + call RegPack(Buf, InData%ConsiderHubMotion) + if (RegCheckErr(Buf, RoutineName)) return + ! FF + call InflowWind_IO_PackGrid3D_InitInputType(Buf, InData%FF) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_UnPackInputFile(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_InputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_UnPackInputFile' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! EchoFlag + call RegUnpack(Buf, OutData%EchoFlag) + if (RegCheckErr(Buf, RoutineName)) return + ! WindType + call RegUnpack(Buf, OutData%WindType) + if (RegCheckErr(Buf, RoutineName)) return + ! PropagationDir + call RegUnpack(Buf, OutData%PropagationDir) + if (RegCheckErr(Buf, RoutineName)) return + ! VFlowAngle + call RegUnpack(Buf, OutData%VFlowAngle) + if (RegCheckErr(Buf, RoutineName)) return + ! VelInterpCubic + call RegUnpack(Buf, OutData%VelInterpCubic) + if (RegCheckErr(Buf, RoutineName)) return + ! NWindVel + call RegUnpack(Buf, OutData%NWindVel) + if (RegCheckErr(Buf, RoutineName)) return + ! WindVxiList + if (allocated(OutData%WindVxiList)) deallocate(OutData%WindVxiList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WindVxiList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindVxiList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WindVxiList) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WindVyiList + if (allocated(OutData%WindVyiList)) deallocate(OutData%WindVyiList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WindVyiList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindVyiList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WindVyiList) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WindVziList + if (allocated(OutData%WindVziList)) deallocate(OutData%WindVziList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WindVziList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindVziList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WindVziList) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Steady_HWindSpeed + call RegUnpack(Buf, OutData%Steady_HWindSpeed) + if (RegCheckErr(Buf, RoutineName)) return + ! Steady_RefHt + call RegUnpack(Buf, OutData%Steady_RefHt) + if (RegCheckErr(Buf, RoutineName)) return + ! Steady_PLexp + call RegUnpack(Buf, OutData%Steady_PLexp) + if (RegCheckErr(Buf, RoutineName)) return + ! Uniform_FileName + call RegUnpack(Buf, OutData%Uniform_FileName) + if (RegCheckErr(Buf, RoutineName)) return + ! Uniform_RefHt + call RegUnpack(Buf, OutData%Uniform_RefHt) + if (RegCheckErr(Buf, RoutineName)) return + ! Uniform_RefLength + call RegUnpack(Buf, OutData%Uniform_RefLength) + if (RegCheckErr(Buf, RoutineName)) return + ! TSFF_FileName + call RegUnpack(Buf, OutData%TSFF_FileName) + if (RegCheckErr(Buf, RoutineName)) return + ! BladedFF_FileName + call RegUnpack(Buf, OutData%BladedFF_FileName) + if (RegCheckErr(Buf, RoutineName)) return + ! BladedFF_TowerFile + call RegUnpack(Buf, OutData%BladedFF_TowerFile) + if (RegCheckErr(Buf, RoutineName)) return + ! CTTS_CoherentTurb + call RegUnpack(Buf, OutData%CTTS_CoherentTurb) + if (RegCheckErr(Buf, RoutineName)) return + ! CTTS_FileName + call RegUnpack(Buf, OutData%CTTS_FileName) + if (RegCheckErr(Buf, RoutineName)) return + ! CTTS_Path + call RegUnpack(Buf, OutData%CTTS_Path) + if (RegCheckErr(Buf, RoutineName)) return + ! HAWC_FileName_u + call RegUnpack(Buf, OutData%HAWC_FileName_u) + if (RegCheckErr(Buf, RoutineName)) return + ! HAWC_FileName_v + call RegUnpack(Buf, OutData%HAWC_FileName_v) + if (RegCheckErr(Buf, RoutineName)) return + ! HAWC_FileName_w + call RegUnpack(Buf, OutData%HAWC_FileName_w) + if (RegCheckErr(Buf, RoutineName)) return + ! HAWC_nx + call RegUnpack(Buf, OutData%HAWC_nx) + if (RegCheckErr(Buf, RoutineName)) return + ! HAWC_ny + call RegUnpack(Buf, OutData%HAWC_ny) + if (RegCheckErr(Buf, RoutineName)) return + ! HAWC_nz + call RegUnpack(Buf, OutData%HAWC_nz) + if (RegCheckErr(Buf, RoutineName)) return + ! HAWC_dx + call RegUnpack(Buf, OutData%HAWC_dx) + if (RegCheckErr(Buf, RoutineName)) return + ! HAWC_dy + call RegUnpack(Buf, OutData%HAWC_dy) + if (RegCheckErr(Buf, RoutineName)) return + ! HAWC_dz + call RegUnpack(Buf, OutData%HAWC_dz) + if (RegCheckErr(Buf, RoutineName)) return + ! SumPrint + call RegUnpack(Buf, OutData%SumPrint) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! OutList + if (allocated(OutData%OutList)) deallocate(OutData%OutList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutList) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! SensorType + call RegUnpack(Buf, OutData%SensorType) + if (RegCheckErr(Buf, RoutineName)) return + ! NumBeam + call RegUnpack(Buf, OutData%NumBeam) + if (RegCheckErr(Buf, RoutineName)) return + ! NumPulseGate + call RegUnpack(Buf, OutData%NumPulseGate) + if (RegCheckErr(Buf, RoutineName)) return + ! RotorApexOffsetPos + call RegUnpack(Buf, OutData%RotorApexOffsetPos) + if (RegCheckErr(Buf, RoutineName)) return + ! FocalDistanceX + if (allocated(OutData%FocalDistanceX)) deallocate(OutData%FocalDistanceX) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FocalDistanceX(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FocalDistanceX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FocalDistanceX) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! FocalDistanceY + if (allocated(OutData%FocalDistanceY)) deallocate(OutData%FocalDistanceY) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FocalDistanceY(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FocalDistanceY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FocalDistanceY) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! FocalDistanceZ + if (allocated(OutData%FocalDistanceZ)) deallocate(OutData%FocalDistanceZ) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FocalDistanceZ(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FocalDistanceZ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FocalDistanceZ) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PulseSpacing + call RegUnpack(Buf, OutData%PulseSpacing) + if (RegCheckErr(Buf, RoutineName)) return + ! MeasurementInterval + call RegUnpack(Buf, OutData%MeasurementInterval) + if (RegCheckErr(Buf, RoutineName)) return + ! URefLid + call RegUnpack(Buf, OutData%URefLid) + if (RegCheckErr(Buf, RoutineName)) return + ! LidRadialVel + call RegUnpack(Buf, OutData%LidRadialVel) + if (RegCheckErr(Buf, RoutineName)) return + ! ConsiderHubMotion + call RegUnpack(Buf, OutData%ConsiderHubMotion) + if (RegCheckErr(Buf, RoutineName)) return + ! FF + call InflowWind_IO_UnpackGrid3D_InitInputType(Buf, OutData%FF) ! FF +end subroutine SUBROUTINE InflowWind_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(InflowWind_InitInputType), INTENT(IN) :: SrcInitInputData TYPE(InflowWind_InitInputType), INTENT(INOUT) :: DstInitInputData @@ -1126,527 +853,136 @@ SUBROUTINE InflowWind_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE InflowWind_DestroyInitInput - SUBROUTINE InflowWind_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(InflowWind_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%InputFileName) ! InputFileName - Int_BufSz = Int_BufSz + 1 ! Linearize - Int_BufSz = Int_BufSz + 1 ! Use4Dext - Int_BufSz = Int_BufSz + 1 ! NumWindPoints - Int_BufSz = Int_BufSz + 1 ! TurbineID - Int_BufSz = Int_BufSz + 1 ! FixedWindFileRootName - Int_BufSz = Int_BufSz + 1 ! UseInputFile - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! PassedFileData: size of buffers for each call to pack subtype - CALL NWTC_Library_PackFileInfoType( Re_Buf, Db_Buf, Int_Buf, InData%PassedFileData, ErrStat2, ErrMsg2, .TRUE. ) ! PassedFileData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PassedFileData - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PassedFileData - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PassedFileData - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! WindType2UseInputFile - Int_BufSz = Int_BufSz + 3 ! WindType2Data: size of buffers for each call to pack subtype - CALL NWTC_Library_PackFileInfoType( Re_Buf, Db_Buf, Int_Buf, InData%WindType2Data, ErrStat2, ErrMsg2, .TRUE. ) ! WindType2Data - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WindType2Data - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WindType2Data - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WindType2Data - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! OutputAccel - Int_BufSz = Int_BufSz + 3 ! lidar: size of buffers for each call to pack subtype - CALL Lidar_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%lidar, ErrStat2, ErrMsg2, .TRUE. ) ! lidar - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! lidar - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! lidar - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! lidar - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! FDext: size of buffers for each call to pack subtype - CALL InflowWind_IO_PackGrid4D_InitInputType( Re_Buf, Db_Buf, Int_Buf, InData%FDext, ErrStat2, ErrMsg2, .TRUE. ) ! FDext - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FDext - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FDext - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FDext - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Re_BufSz = Re_BufSz + 1 ! RadAvg - Int_BufSz = Int_BufSz + 1 ! MHK - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Re_BufSz = Re_BufSz + 1 ! MSL2SWL - Int_BufSz = Int_BufSz + 1 ! BoxExceedAllowIdx - Int_BufSz = Int_BufSz + 1 ! BoxExceedAllowF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%InputFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Use4Dext, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumWindPoints - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TurbineID - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FixedWindFileRootName, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseInputFile, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - CALL NWTC_Library_PackFileInfoType( Re_Buf, Db_Buf, Int_Buf, InData%PassedFileData, ErrStat2, ErrMsg2, OnlySize ) ! PassedFileData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = TRANSFER(InData%WindType2UseInputFile, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - CALL NWTC_Library_PackFileInfoType( Re_Buf, Db_Buf, Int_Buf, InData%WindType2Data, ErrStat2, ErrMsg2, OnlySize ) ! WindType2Data - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = TRANSFER(InData%OutputAccel, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - CALL Lidar_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%lidar, ErrStat2, ErrMsg2, OnlySize ) ! lidar - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL InflowWind_IO_PackGrid4D_InitInputType( Re_Buf, Db_Buf, Int_Buf, InData%FDext, ErrStat2, ErrMsg2, OnlySize ) ! FDext - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - ReKiBuf(Re_Xferred) = InData%RadAvg - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MHK - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%BoxExceedAllowIdx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%BoxExceedAllowF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE InflowWind_PackInitInput - - SUBROUTINE InflowWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(InflowWind_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFileName) - OutData%InputFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) - Int_Xferred = Int_Xferred + 1 - OutData%Use4Dext = TRANSFER(IntKiBuf(Int_Xferred), OutData%Use4Dext) - Int_Xferred = Int_Xferred + 1 - OutData%NumWindPoints = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TurbineID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FixedWindFileRootName = TRANSFER(IntKiBuf(Int_Xferred), OutData%FixedWindFileRootName) - Int_Xferred = Int_Xferred + 1 - OutData%UseInputFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseInputFile) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackFileInfoType( Re_Buf, Db_Buf, Int_Buf, OutData%PassedFileData, ErrStat2, ErrMsg2 ) ! PassedFileData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%WindType2UseInputFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%WindType2UseInputFile) - Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackFileInfoType( Re_Buf, Db_Buf, Int_Buf, OutData%WindType2Data, ErrStat2, ErrMsg2 ) ! WindType2Data - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%OutputAccel = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutputAccel) - Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Lidar_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%lidar, ErrStat2, ErrMsg2 ) ! lidar - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_IO_UnpackGrid4D_InitInputType( Re_Buf, Db_Buf, Int_Buf, OutData%FDext, ErrStat2, ErrMsg2 ) ! FDext - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%RadAvg = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MHK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MSL2SWL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%BoxExceedAllowIdx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%BoxExceedAllowF = TRANSFER(IntKiBuf(Int_Xferred), OutData%BoxExceedAllowF) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE InflowWind_UnPackInitInput +subroutine InflowWind_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + ! InputFileName + call RegPack(Buf, InData%InputFileName) + if (RegCheckErr(Buf, RoutineName)) return + ! Linearize + call RegPack(Buf, InData%Linearize) + if (RegCheckErr(Buf, RoutineName)) return + ! Use4Dext + call RegPack(Buf, InData%Use4Dext) + if (RegCheckErr(Buf, RoutineName)) return + ! NumWindPoints + call RegPack(Buf, InData%NumWindPoints) + if (RegCheckErr(Buf, RoutineName)) return + ! TurbineID + call RegPack(Buf, InData%TurbineID) + if (RegCheckErr(Buf, RoutineName)) return + ! FixedWindFileRootName + call RegPack(Buf, InData%FixedWindFileRootName) + if (RegCheckErr(Buf, RoutineName)) return + ! UseInputFile + call RegPack(Buf, InData%UseInputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegPack(Buf, InData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! PassedFileData + call NWTC_Library_PackFileInfoType(Buf, InData%PassedFileData) + if (RegCheckErr(Buf, RoutineName)) return + ! WindType2UseInputFile + call RegPack(Buf, InData%WindType2UseInputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! WindType2Data + call NWTC_Library_PackFileInfoType(Buf, InData%WindType2Data) + if (RegCheckErr(Buf, RoutineName)) return + ! OutputAccel + call RegPack(Buf, InData%OutputAccel) + if (RegCheckErr(Buf, RoutineName)) return + ! lidar + call Lidar_PackInitInput(Buf, InData%lidar) + if (RegCheckErr(Buf, RoutineName)) return + ! FDext + call InflowWind_IO_PackGrid4D_InitInputType(Buf, InData%FDext) + if (RegCheckErr(Buf, RoutineName)) return + ! RadAvg + call RegPack(Buf, InData%RadAvg) + if (RegCheckErr(Buf, RoutineName)) return + ! MHK + call RegPack(Buf, InData%MHK) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDpth + call RegPack(Buf, InData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! MSL2SWL + call RegPack(Buf, InData%MSL2SWL) + if (RegCheckErr(Buf, RoutineName)) return + ! BoxExceedAllowIdx + call RegPack(Buf, InData%BoxExceedAllowIdx) + if (RegCheckErr(Buf, RoutineName)) return + ! BoxExceedAllowF + call RegPack(Buf, InData%BoxExceedAllowF) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_UnPackInitInput' + if (Buf%ErrStat /= ErrID_None) return + ! InputFileName + call RegUnpack(Buf, OutData%InputFileName) + if (RegCheckErr(Buf, RoutineName)) return + ! Linearize + call RegUnpack(Buf, OutData%Linearize) + if (RegCheckErr(Buf, RoutineName)) return + ! Use4Dext + call RegUnpack(Buf, OutData%Use4Dext) + if (RegCheckErr(Buf, RoutineName)) return + ! NumWindPoints + call RegUnpack(Buf, OutData%NumWindPoints) + if (RegCheckErr(Buf, RoutineName)) return + ! TurbineID + call RegUnpack(Buf, OutData%TurbineID) + if (RegCheckErr(Buf, RoutineName)) return + ! FixedWindFileRootName + call RegUnpack(Buf, OutData%FixedWindFileRootName) + if (RegCheckErr(Buf, RoutineName)) return + ! UseInputFile + call RegUnpack(Buf, OutData%UseInputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! PassedFileData + call NWTC_Library_UnpackFileInfoType(Buf, OutData%PassedFileData) ! PassedFileData + ! WindType2UseInputFile + call RegUnpack(Buf, OutData%WindType2UseInputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! WindType2Data + call NWTC_Library_UnpackFileInfoType(Buf, OutData%WindType2Data) ! WindType2Data + ! OutputAccel + call RegUnpack(Buf, OutData%OutputAccel) + if (RegCheckErr(Buf, RoutineName)) return + ! lidar + call Lidar_UnpackInitInput(Buf, OutData%lidar) ! lidar + ! FDext + call InflowWind_IO_UnpackGrid4D_InitInputType(Buf, OutData%FDext) ! FDext + ! RadAvg + call RegUnpack(Buf, OutData%RadAvg) + if (RegCheckErr(Buf, RoutineName)) return + ! MHK + call RegUnpack(Buf, OutData%MHK) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDpth + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! MSL2SWL + call RegUnpack(Buf, OutData%MSL2SWL) + if (RegCheckErr(Buf, RoutineName)) return + ! BoxExceedAllowIdx + call RegUnpack(Buf, OutData%BoxExceedAllowIdx) + if (RegCheckErr(Buf, RoutineName)) return + ! BoxExceedAllowF + call RegUnpack(Buf, OutData%BoxExceedAllowF) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE InflowWind_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(InflowWind_InitOutputType), INTENT(IN) :: SrcInitOutputData TYPE(InflowWind_InitOutputType), INTENT(INOUT) :: DstInitOutputData @@ -1796,553 +1132,220 @@ SUBROUTINE InflowWind_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) NULLIFY(InitOutputData%FlowField) END SUBROUTINE InflowWind_DestroyInitOutput - SUBROUTINE InflowWind_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(InflowWind_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! WriteOutputHdr allocated yes/no - IF ( ALLOCATED(InData%WriteOutputHdr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdr upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdr)*LEN(InData%WriteOutputHdr) ! WriteOutputHdr - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputUnt allocated yes/no - IF ( ALLOCATED(InData%WriteOutputUnt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUnt upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUnt)*LEN(InData%WriteOutputUnt) ! WriteOutputUnt - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! WindFileInfo: size of buffers for each call to pack subtype - CALL InflowWind_IO_PackWindFileDat( Re_Buf, Db_Buf, Int_Buf, InData%WindFileInfo, ErrStat2, ErrMsg2, .TRUE. ) ! WindFileInfo - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WindFileInfo - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WindFileInfo - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WindFileInfo - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_y allocated yes/no - IF ( ALLOCATED(InData%LinNames_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_y)*LEN(InData%LinNames_y) ! LinNames_y - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_u allocated yes/no - IF ( ALLOCATED(InData%LinNames_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_u)*LEN(InData%LinNames_u) ! LinNames_u - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_y allocated yes/no - IF ( ALLOCATED(InData%RotFrame_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_y) ! RotFrame_y - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_u allocated yes/no - IF ( ALLOCATED(InData%RotFrame_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_u) ! RotFrame_u - END IF - Int_BufSz = Int_BufSz + 1 ! IsLoad_u allocated yes/no - IF ( ALLOCATED(InData%IsLoad_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IsLoad_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IsLoad_u) ! IsLoad_u - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%WriteOutputHdr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) - DO I = 1, LEN(InData%WriteOutputHdr) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputUnt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) - DO I = 1, LEN(InData%WriteOutputUnt) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL InflowWind_IO_PackWindFileDat( Re_Buf, Db_Buf, Int_Buf, InData%WindFileInfo, ErrStat2, ErrMsg2, OnlySize ) ! WindFileInfo - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%LinNames_y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) - DO I = 1, LEN(InData%LinNames_y) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_y(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinNames_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) - DO I = 1, LEN(InData%LinNames_u) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_u(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_y,1), UBOUND(InData%RotFrame_y,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_y(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_u,1), UBOUND(InData%RotFrame_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IsLoad_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IsLoad_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE InflowWind_PackInitOutput - - SUBROUTINE InflowWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(InflowWind_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputHdr)) DEALLOCATE(OutData%WriteOutputHdr) - ALLOCATE(OutData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) - DO I = 1, LEN(OutData%WriteOutputHdr) - OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputUnt)) DEALLOCATE(OutData%WriteOutputUnt) - ALLOCATE(OutData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) - DO I = 1, LEN(OutData%WriteOutputUnt) - OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_IO_UnpackWindFileDat( Re_Buf, Db_Buf, Int_Buf, OutData%WindFileInfo, ErrStat2, ErrMsg2 ) ! WindFileInfo - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LinNames_y)) DEALLOCATE(OutData%LinNames_y) - ALLOCATE(OutData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) - DO I = 1, LEN(OutData%LinNames_y) - OutData%LinNames_y(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LinNames_u)) DEALLOCATE(OutData%LinNames_u) - ALLOCATE(OutData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) - DO I = 1, LEN(OutData%LinNames_u) - OutData%LinNames_u(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RotFrame_y)) DEALLOCATE(OutData%RotFrame_y) - ALLOCATE(OutData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_y,1), UBOUND(OutData%RotFrame_y,1) - OutData%RotFrame_y(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_y(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RotFrame_u)) DEALLOCATE(OutData%RotFrame_u) - ALLOCATE(OutData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_u,1), UBOUND(OutData%RotFrame_u,1) - OutData%RotFrame_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IsLoad_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IsLoad_u)) DEALLOCATE(OutData%IsLoad_u) - ALLOCATE(OutData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) - OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - NULLIFY(OutData%FlowField) - END SUBROUTINE InflowWind_UnPackInitOutput +subroutine InflowWind_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_PackInitOutput' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + ! WriteOutputHdr + call RegPack(Buf, allocated(InData%WriteOutputHdr)) + if (allocated(InData%WriteOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPack(Buf, InData%WriteOutputHdr) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutputUnt + call RegPack(Buf, allocated(InData%WriteOutputUnt)) + if (allocated(InData%WriteOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPack(Buf, InData%WriteOutputUnt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Ver + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + if (RegCheckErr(Buf, RoutineName)) return + ! WindFileInfo + call InflowWind_IO_PackWindFileDat(Buf, InData%WindFileInfo) + if (RegCheckErr(Buf, RoutineName)) return + ! LinNames_y + call RegPack(Buf, allocated(InData%LinNames_y)) + if (allocated(InData%LinNames_y)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) + call RegPack(Buf, InData%LinNames_y) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LinNames_u + call RegPack(Buf, allocated(InData%LinNames_u)) + if (allocated(InData%LinNames_u)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) + call RegPack(Buf, InData%LinNames_u) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RotFrame_y + call RegPack(Buf, allocated(InData%RotFrame_y)) + if (allocated(InData%RotFrame_y)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y), ubound(InData%RotFrame_y)) + call RegPack(Buf, InData%RotFrame_y) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RotFrame_u + call RegPack(Buf, allocated(InData%RotFrame_u)) + if (allocated(InData%RotFrame_u)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u), ubound(InData%RotFrame_u)) + call RegPack(Buf, InData%RotFrame_u) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! IsLoad_u + call RegPack(Buf, allocated(InData%IsLoad_u)) + if (allocated(InData%IsLoad_u)) then + call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) + call RegPack(Buf, InData%IsLoad_u) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FlowField + call RegPack(Buf, associated(InData%FlowField)) + if (associated(InData%FlowField)) then + call RegPackPointer(Buf, c_loc(InData%FlowField), PtrInIndex) + if (.not. PtrInIndex) then + call IfW_FlowField_PackFlowFieldType(Buf, InData%FlowField) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_UnPackInitOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + ! WriteOutputHdr + if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WriteOutputUnt + if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Ver + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + ! WindFileInfo + call InflowWind_IO_UnpackWindFileDat(Buf, OutData%WindFileInfo) ! WindFileInfo + ! LinNames_y + if (allocated(OutData%LinNames_y)) deallocate(OutData%LinNames_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LinNames_u + if (allocated(OutData%LinNames_u)) deallocate(OutData%LinNames_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RotFrame_y + if (allocated(OutData%RotFrame_y)) deallocate(OutData%RotFrame_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RotFrame_u + if (allocated(OutData%RotFrame_u)) deallocate(OutData%RotFrame_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! IsLoad_u + if (allocated(OutData%IsLoad_u)) deallocate(OutData%IsLoad_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IsLoad_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IsLoad_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! FlowField + if (associated(OutData%FlowField)) deallocate(OutData%FlowField) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%FlowField) + else + allocate(OutData%FlowField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlowField.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%FlowField) + call IfW_FlowField_UnpackFlowFieldType(Buf, OutData%FlowField) ! FlowField + end if + else + OutData%FlowField => null() + end if +end subroutine SUBROUTINE InflowWind_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(InflowWind_ParameterType), INTENT(IN) :: SrcParamData TYPE(InflowWind_ParameterType), INTENT(INOUT) :: DstParamData @@ -2497,635 +1500,209 @@ SUBROUTINE InflowWind_DestroyParam( ParamData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE InflowWind_DestroyParam - SUBROUTINE InflowWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(InflowWind_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%RootFileName) ! RootFileName - Db_BufSz = Db_BufSz + 1 ! DT - Int_BufSz = Int_BufSz + 1 ! WindViXYZprime allocated yes/no - IF ( ALLOCATED(InData%WindViXYZprime) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WindViXYZprime upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WindViXYZprime) ! WindViXYZprime - END IF - Int_BufSz = Int_BufSz + 1 ! WindViXYZ allocated yes/no - IF ( ALLOCATED(InData%WindViXYZ) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WindViXYZ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WindViXYZ) ! WindViXYZ - END IF - Int_BufSz = Int_BufSz + 1 ! FlowField allocated yes/no - IF ( ASSOCIATED(InData%FlowField) ) THEN - Int_BufSz = Int_BufSz + 2*0 ! FlowField upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! FlowField: size of buffers for each call to pack subtype - CALL IfW_FlowField_PackFlowFieldType( Re_Buf, Db_Buf, Int_Buf, InData%FlowField, ErrStat2, ErrMsg2, .TRUE. ) ! FlowField - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FlowField - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FlowField - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FlowField - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END IF - Int_BufSz = Int_BufSz + 1 ! PositionAvg allocated yes/no - IF ( ALLOCATED(InData%PositionAvg) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PositionAvg upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PositionAvg) ! PositionAvg - END IF - Int_BufSz = Int_BufSz + 1 ! NWindVel - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! OutParam allocated yes/no - IF ( ALLOCATED(InData%OutParam) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutParam upper/lower bounds for each dimension - DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - Int_BufSz = Int_BufSz + 3 ! OutParam: size of buffers for each call to pack subtype - CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutParam - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutParam - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutParam - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OutParamLinIndx allocated yes/no - IF ( ALLOCATED(InData%OutParamLinIndx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OutParamLinIndx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%OutParamLinIndx) ! OutParamLinIndx - END IF - Int_BufSz = Int_BufSz + 3 ! lidar: size of buffers for each call to pack subtype - CALL Lidar_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%lidar, ErrStat2, ErrMsg2, .TRUE. ) ! lidar - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! lidar - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! lidar - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! lidar - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! OutputAccel - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%RootFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WindViXYZprime) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WindViXYZprime,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindViXYZprime,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WindViXYZprime,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindViXYZprime,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WindViXYZprime,2), UBOUND(InData%WindViXYZprime,2) - DO i1 = LBOUND(InData%WindViXYZprime,1), UBOUND(InData%WindViXYZprime,1) - ReKiBuf(Re_Xferred) = InData%WindViXYZprime(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WindViXYZ) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WindViXYZ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindViXYZ,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WindViXYZ,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindViXYZ,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WindViXYZ,2), UBOUND(InData%WindViXYZ,2) - DO i1 = LBOUND(InData%WindViXYZ,1), UBOUND(InData%WindViXYZ,1) - ReKiBuf(Re_Xferred) = InData%WindViXYZ(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%FlowField) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - - CALL IfW_FlowField_PackFlowFieldType( Re_Buf, Db_Buf, Int_Buf, InData%FlowField, ErrStat2, ErrMsg2, OnlySize ) ! FlowField - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END IF - IF ( .NOT. ALLOCATED(InData%PositionAvg) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PositionAvg,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PositionAvg,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PositionAvg,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PositionAvg,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PositionAvg,2), UBOUND(InData%PositionAvg,2) - DO i1 = LBOUND(InData%PositionAvg,1), UBOUND(InData%PositionAvg,1) - ReKiBuf(Re_Xferred) = InData%PositionAvg(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NWindVel - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutParam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParam,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OutParamLinIndx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutParamLinIndx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParamLinIndx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutParamLinIndx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParamLinIndx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OutParamLinIndx,2), UBOUND(InData%OutParamLinIndx,2) - DO i1 = LBOUND(InData%OutParamLinIndx,1), UBOUND(InData%OutParamLinIndx,1) - IntKiBuf(Int_Xferred) = InData%OutParamLinIndx(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - CALL Lidar_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%lidar, ErrStat2, ErrMsg2, OnlySize ) ! lidar - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = TRANSFER(InData%OutputAccel, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE InflowWind_PackParam - - SUBROUTINE InflowWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(InflowWind_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%RootFileName) - OutData%RootFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindViXYZprime not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WindViXYZprime)) DEALLOCATE(OutData%WindViXYZprime) - ALLOCATE(OutData%WindViXYZprime(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindViXYZprime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WindViXYZprime,2), UBOUND(OutData%WindViXYZprime,2) - DO i1 = LBOUND(OutData%WindViXYZprime,1), UBOUND(OutData%WindViXYZprime,1) - OutData%WindViXYZprime(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindViXYZ not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WindViXYZ)) DEALLOCATE(OutData%WindViXYZ) - ALLOCATE(OutData%WindViXYZ(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindViXYZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WindViXYZ,2), UBOUND(OutData%WindViXYZ,2) - DO i1 = LBOUND(OutData%WindViXYZ,1), UBOUND(OutData%WindViXYZ,1) - OutData%WindViXYZ(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FlowField not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - IF (ASSOCIATED(OutData%FlowField)) DEALLOCATE(OutData%FlowField) - ALLOCATE(OutData%FlowField,STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlowField.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IfW_FlowField_UnpackFlowFieldType( Re_Buf, Db_Buf, Int_Buf, OutData%FlowField, ErrStat2, ErrMsg2 ) ! FlowField - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PositionAvg not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PositionAvg)) DEALLOCATE(OutData%PositionAvg) - ALLOCATE(OutData%PositionAvg(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PositionAvg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PositionAvg,2), UBOUND(OutData%PositionAvg,2) - DO i1 = LBOUND(OutData%PositionAvg,1), UBOUND(OutData%PositionAvg,1) - OutData%PositionAvg(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%NWindVel = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutParam)) DEALLOCATE(OutData%OutParam) - ALLOCATE(OutData%OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutParam,1), UBOUND(OutData%OutParam,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackOutParmType( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParamLinIndx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutParamLinIndx)) DEALLOCATE(OutData%OutParamLinIndx) - ALLOCATE(OutData%OutParamLinIndx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParamLinIndx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OutParamLinIndx,2), UBOUND(OutData%OutParamLinIndx,2) - DO i1 = LBOUND(OutData%OutParamLinIndx,1), UBOUND(OutData%OutParamLinIndx,1) - OutData%OutParamLinIndx(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Lidar_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%lidar, ErrStat2, ErrMsg2 ) ! lidar - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%OutputAccel = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutputAccel) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE InflowWind_UnPackParam +subroutine InflowWind_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_PackParam' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + ! RootFileName + call RegPack(Buf, InData%RootFileName) + if (RegCheckErr(Buf, RoutineName)) return + ! DT + call RegPack(Buf, InData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! WindViXYZprime + call RegPack(Buf, allocated(InData%WindViXYZprime)) + if (allocated(InData%WindViXYZprime)) then + call RegPackBounds(Buf, 2, lbound(InData%WindViXYZprime), ubound(InData%WindViXYZprime)) + call RegPack(Buf, InData%WindViXYZprime) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WindViXYZ + call RegPack(Buf, allocated(InData%WindViXYZ)) + if (allocated(InData%WindViXYZ)) then + call RegPackBounds(Buf, 2, lbound(InData%WindViXYZ), ubound(InData%WindViXYZ)) + call RegPack(Buf, InData%WindViXYZ) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FlowField + call RegPack(Buf, associated(InData%FlowField)) + if (associated(InData%FlowField)) then + call RegPackPointer(Buf, c_loc(InData%FlowField), PtrInIndex) + if (.not. PtrInIndex) then + call IfW_FlowField_PackFlowFieldType(Buf, InData%FlowField) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PositionAvg + call RegPack(Buf, allocated(InData%PositionAvg)) + if (allocated(InData%PositionAvg)) then + call RegPackBounds(Buf, 2, lbound(InData%PositionAvg), ubound(InData%PositionAvg)) + call RegPack(Buf, InData%PositionAvg) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NWindVel + call RegPack(Buf, InData%NWindVel) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegPack(Buf, InData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! OutParam + call RegPack(Buf, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OutParamLinIndx + call RegPack(Buf, allocated(InData%OutParamLinIndx)) + if (allocated(InData%OutParamLinIndx)) then + call RegPackBounds(Buf, 2, lbound(InData%OutParamLinIndx), ubound(InData%OutParamLinIndx)) + call RegPack(Buf, InData%OutParamLinIndx) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! lidar + call Lidar_PackParam(Buf, InData%lidar) + if (RegCheckErr(Buf, RoutineName)) return + ! OutputAccel + call RegPack(Buf, InData%OutputAccel) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_UnPackParam' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + ! RootFileName + call RegUnpack(Buf, OutData%RootFileName) + if (RegCheckErr(Buf, RoutineName)) return + ! DT + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! WindViXYZprime + if (allocated(OutData%WindViXYZprime)) deallocate(OutData%WindViXYZprime) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WindViXYZprime(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindViXYZprime.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WindViXYZprime) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WindViXYZ + if (allocated(OutData%WindViXYZ)) deallocate(OutData%WindViXYZ) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WindViXYZ(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindViXYZ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WindViXYZ) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! FlowField + if (associated(OutData%FlowField)) deallocate(OutData%FlowField) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%FlowField) + else + allocate(OutData%FlowField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlowField.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%FlowField) + call IfW_FlowField_UnpackFlowFieldType(Buf, OutData%FlowField) ! FlowField + end if + else + OutData%FlowField => null() + end if + ! PositionAvg + if (allocated(OutData%PositionAvg)) deallocate(OutData%PositionAvg) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PositionAvg(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PositionAvg.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PositionAvg) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NWindVel + call RegUnpack(Buf, OutData%NWindVel) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! OutParam + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam + end do + end if + ! OutParamLinIndx + if (allocated(OutData%OutParamLinIndx)) deallocate(OutData%OutParamLinIndx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutParamLinIndx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParamLinIndx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutParamLinIndx) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! lidar + call Lidar_UnpackParam(Buf, OutData%lidar) ! lidar + ! OutputAccel + call RegUnpack(Buf, OutData%OutputAccel) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE InflowWind_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(InflowWind_InputType), INTENT(IN) :: SrcInputData TYPE(InflowWind_InputType), INTENT(INOUT) :: DstInputData @@ -3183,262 +1760,62 @@ SUBROUTINE InflowWind_DestroyInput( InputData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE InflowWind_DestroyInput - SUBROUTINE InflowWind_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(InflowWind_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! PositionXYZ allocated yes/no - IF ( ALLOCATED(InData%PositionXYZ) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PositionXYZ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PositionXYZ) ! PositionXYZ - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! lidar: size of buffers for each call to pack subtype - CALL Lidar_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%lidar, ErrStat2, ErrMsg2, .TRUE. ) ! lidar - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! lidar - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! lidar - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! lidar - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Re_BufSz = Re_BufSz + SIZE(InData%HubPosition) ! HubPosition - Re_BufSz = Re_BufSz + SIZE(InData%HubOrientation) ! HubOrientation - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%PositionXYZ) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PositionXYZ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PositionXYZ,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PositionXYZ,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PositionXYZ,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PositionXYZ,2), UBOUND(InData%PositionXYZ,2) - DO i1 = LBOUND(InData%PositionXYZ,1), UBOUND(InData%PositionXYZ,1) - ReKiBuf(Re_Xferred) = InData%PositionXYZ(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - CALL Lidar_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%lidar, ErrStat2, ErrMsg2, OnlySize ) ! lidar - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - DO i1 = LBOUND(InData%HubPosition,1), UBOUND(InData%HubPosition,1) - ReKiBuf(Re_Xferred) = InData%HubPosition(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i2 = LBOUND(InData%HubOrientation,2), UBOUND(InData%HubOrientation,2) - DO i1 = LBOUND(InData%HubOrientation,1), UBOUND(InData%HubOrientation,1) - ReKiBuf(Re_Xferred) = InData%HubOrientation(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END SUBROUTINE InflowWind_PackInput - - SUBROUTINE InflowWind_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(InflowWind_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PositionXYZ not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PositionXYZ)) DEALLOCATE(OutData%PositionXYZ) - ALLOCATE(OutData%PositionXYZ(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PositionXYZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PositionXYZ,2), UBOUND(OutData%PositionXYZ,2) - DO i1 = LBOUND(OutData%PositionXYZ,1), UBOUND(OutData%PositionXYZ,1) - OutData%PositionXYZ(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Lidar_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%lidar, ErrStat2, ErrMsg2 ) ! lidar - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - i1_l = LBOUND(OutData%HubPosition,1) - i1_u = UBOUND(OutData%HubPosition,1) - DO i1 = LBOUND(OutData%HubPosition,1), UBOUND(OutData%HubPosition,1) - OutData%HubPosition(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%HubOrientation,1) - i1_u = UBOUND(OutData%HubOrientation,1) - i2_l = LBOUND(OutData%HubOrientation,2) - i2_u = UBOUND(OutData%HubOrientation,2) - DO i2 = LBOUND(OutData%HubOrientation,2), UBOUND(OutData%HubOrientation,2) - DO i1 = LBOUND(OutData%HubOrientation,1), UBOUND(OutData%HubOrientation,1) - OutData%HubOrientation(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END SUBROUTINE InflowWind_UnPackInput +subroutine InflowWind_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + ! PositionXYZ + call RegPack(Buf, allocated(InData%PositionXYZ)) + if (allocated(InData%PositionXYZ)) then + call RegPackBounds(Buf, 2, lbound(InData%PositionXYZ), ubound(InData%PositionXYZ)) + call RegPack(Buf, InData%PositionXYZ) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! lidar + call Lidar_PackInput(Buf, InData%lidar) + if (RegCheckErr(Buf, RoutineName)) return + ! HubPosition + call RegPack(Buf, InData%HubPosition) + if (RegCheckErr(Buf, RoutineName)) return + ! HubOrientation + call RegPack(Buf, InData%HubOrientation) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_UnPackInput' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! PositionXYZ + if (allocated(OutData%PositionXYZ)) deallocate(OutData%PositionXYZ) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PositionXYZ(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PositionXYZ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PositionXYZ) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! lidar + call Lidar_UnpackInput(Buf, OutData%lidar) ! lidar + ! HubPosition + call RegUnpack(Buf, OutData%HubPosition) + if (RegCheckErr(Buf, RoutineName)) return + ! HubOrientation + call RegUnpack(Buf, OutData%HubOrientation) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE InflowWind_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(InflowWind_OutputType), INTENT(IN) :: SrcOutputData TYPE(InflowWind_OutputType), INTENT(INOUT) :: DstOutputData @@ -3528,342 +1905,106 @@ SUBROUTINE InflowWind_DestroyOutput( OutputData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE InflowWind_DestroyOutput - SUBROUTINE InflowWind_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(InflowWind_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! VelocityUVW allocated yes/no - IF ( ALLOCATED(InData%VelocityUVW) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! VelocityUVW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%VelocityUVW) ! VelocityUVW - END IF - Int_BufSz = Int_BufSz + 1 ! AccelUVW allocated yes/no - IF ( ALLOCATED(InData%AccelUVW) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AccelUVW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AccelUVW) ! AccelUVW - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutput allocated yes/no - IF ( ALLOCATED(InData%WriteOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutput upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WriteOutput) ! WriteOutput - END IF - Re_BufSz = Re_BufSz + SIZE(InData%DiskVel) ! DiskVel - Re_BufSz = Re_BufSz + SIZE(InData%HubVel) ! HubVel - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! lidar: size of buffers for each call to pack subtype - CALL Lidar_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%lidar, ErrStat2, ErrMsg2, .TRUE. ) ! lidar - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! lidar - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! lidar - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! lidar - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%VelocityUVW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VelocityUVW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VelocityUVW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VelocityUVW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VelocityUVW,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%VelocityUVW,2), UBOUND(InData%VelocityUVW,2) - DO i1 = LBOUND(InData%VelocityUVW,1), UBOUND(InData%VelocityUVW,1) - ReKiBuf(Re_Xferred) = InData%VelocityUVW(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AccelUVW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AccelUVW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AccelUVW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AccelUVW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AccelUVW,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AccelUVW,2), UBOUND(InData%AccelUVW,2) - DO i1 = LBOUND(InData%AccelUVW,1), UBOUND(InData%AccelUVW,1) - ReKiBuf(Re_Xferred) = InData%AccelUVW(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) - ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DO i1 = LBOUND(InData%DiskVel,1), UBOUND(InData%DiskVel,1) - ReKiBuf(Re_Xferred) = InData%DiskVel(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%HubVel,1), UBOUND(InData%HubVel,1) - ReKiBuf(Re_Xferred) = InData%HubVel(i1) - Re_Xferred = Re_Xferred + 1 - END DO - CALL Lidar_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%lidar, ErrStat2, ErrMsg2, OnlySize ) ! lidar - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE InflowWind_PackOutput - - SUBROUTINE InflowWind_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(InflowWind_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VelocityUVW not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%VelocityUVW)) DEALLOCATE(OutData%VelocityUVW) - ALLOCATE(OutData%VelocityUVW(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelocityUVW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%VelocityUVW,2), UBOUND(OutData%VelocityUVW,2) - DO i1 = LBOUND(OutData%VelocityUVW,1), UBOUND(OutData%VelocityUVW,1) - OutData%VelocityUVW(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AccelUVW not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AccelUVW)) DEALLOCATE(OutData%AccelUVW) - ALLOCATE(OutData%AccelUVW(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AccelUVW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AccelUVW,2), UBOUND(OutData%AccelUVW,2) - DO i1 = LBOUND(OutData%AccelUVW,1), UBOUND(OutData%AccelUVW,1) - OutData%AccelUVW(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutput)) DEALLOCATE(OutData%WriteOutput) - ALLOCATE(OutData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) - OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - i1_l = LBOUND(OutData%DiskVel,1) - i1_u = UBOUND(OutData%DiskVel,1) - DO i1 = LBOUND(OutData%DiskVel,1), UBOUND(OutData%DiskVel,1) - OutData%DiskVel(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%HubVel,1) - i1_u = UBOUND(OutData%HubVel,1) - DO i1 = LBOUND(OutData%HubVel,1), UBOUND(OutData%HubVel,1) - OutData%HubVel(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Lidar_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%lidar, ErrStat2, ErrMsg2 ) ! lidar - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE InflowWind_UnPackOutput +subroutine InflowWind_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! VelocityUVW + call RegPack(Buf, allocated(InData%VelocityUVW)) + if (allocated(InData%VelocityUVW)) then + call RegPackBounds(Buf, 2, lbound(InData%VelocityUVW), ubound(InData%VelocityUVW)) + call RegPack(Buf, InData%VelocityUVW) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AccelUVW + call RegPack(Buf, allocated(InData%AccelUVW)) + if (allocated(InData%AccelUVW)) then + call RegPackBounds(Buf, 2, lbound(InData%AccelUVW), ubound(InData%AccelUVW)) + call RegPack(Buf, InData%AccelUVW) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutput + call RegPack(Buf, allocated(InData%WriteOutput)) + if (allocated(InData%WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPack(Buf, InData%WriteOutput) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DiskVel + call RegPack(Buf, InData%DiskVel) + if (RegCheckErr(Buf, RoutineName)) return + ! HubVel + call RegPack(Buf, InData%HubVel) + if (RegCheckErr(Buf, RoutineName)) return + ! lidar + call Lidar_PackOutput(Buf, InData%lidar) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_UnPackOutput' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! VelocityUVW + if (allocated(OutData%VelocityUVW)) deallocate(OutData%VelocityUVW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%VelocityUVW(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelocityUVW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%VelocityUVW) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AccelUVW + if (allocated(OutData%AccelUVW)) deallocate(OutData%AccelUVW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AccelUVW(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AccelUVW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AccelUVW) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WriteOutput + if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! DiskVel + call RegUnpack(Buf, OutData%DiskVel) + if (RegCheckErr(Buf, RoutineName)) return + ! HubVel + call RegUnpack(Buf, OutData%HubVel) + if (RegCheckErr(Buf, RoutineName)) return + ! lidar + call Lidar_UnpackOutput(Buf, OutData%lidar) ! lidar +end subroutine SUBROUTINE InflowWind_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(InflowWind_ContinuousStateType), INTENT(IN) :: SrcContStateData TYPE(InflowWind_ContinuousStateType), INTENT(INOUT) :: DstContStateData @@ -3896,103 +2037,26 @@ SUBROUTINE InflowWind_DestroyContState( ContStateData, ErrStat, ErrMsg ) END SUBROUTINE InflowWind_DestroyContState - SUBROUTINE InflowWind_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(InflowWind_ContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_PackContState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyContState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE InflowWind_PackContState - - SUBROUTINE InflowWind_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(InflowWind_ContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_UnPackContState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyContState = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE InflowWind_UnPackContState +subroutine InflowWind_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyContState + call RegPack(Buf, InData%DummyContState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_UnPackContState' + if (Buf%ErrStat /= ErrID_None) return + ! DummyContState + call RegUnpack(Buf, OutData%DummyContState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE InflowWind_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(InflowWind_DiscreteStateType), INTENT(IN) :: SrcDiscStateData TYPE(InflowWind_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData @@ -4025,103 +2089,26 @@ SUBROUTINE InflowWind_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) END SUBROUTINE InflowWind_DestroyDiscState - SUBROUTINE InflowWind_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(InflowWind_DiscreteStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_PackDiscState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyDiscState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE InflowWind_PackDiscState - - SUBROUTINE InflowWind_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(InflowWind_DiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_UnPackDiscState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyDiscState = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE InflowWind_UnPackDiscState +subroutine InflowWind_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyDiscState + call RegPack(Buf, InData%DummyDiscState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_UnPackDiscState' + if (Buf%ErrStat /= ErrID_None) return + ! DummyDiscState + call RegUnpack(Buf, OutData%DummyDiscState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE InflowWind_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(InflowWind_ConstraintStateType), INTENT(IN) :: SrcConstrStateData TYPE(InflowWind_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData @@ -4154,103 +2141,26 @@ SUBROUTINE InflowWind_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) END SUBROUTINE InflowWind_DestroyConstrState - SUBROUTINE InflowWind_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(InflowWind_ConstraintStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_PackConstrState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyConstrState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE InflowWind_PackConstrState - - SUBROUTINE InflowWind_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(InflowWind_ConstraintStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_UnPackConstrState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyConstrState = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE InflowWind_UnPackConstrState +subroutine InflowWind_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyConstrState + call RegPack(Buf, InData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + ! DummyConstrState + call RegUnpack(Buf, OutData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE InflowWind_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(InflowWind_OtherStateType), INTENT(IN) :: SrcOtherStateData TYPE(InflowWind_OtherStateType), INTENT(INOUT) :: DstOtherStateData @@ -4283,103 +2193,26 @@ SUBROUTINE InflowWind_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) END SUBROUTINE InflowWind_DestroyOtherState - SUBROUTINE InflowWind_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(InflowWind_OtherStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_PackOtherState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyOtherState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyOtherState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE InflowWind_PackOtherState - - SUBROUTINE InflowWind_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(InflowWind_OtherStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_UnPackOtherState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyOtherState = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE InflowWind_UnPackOtherState +subroutine InflowWind_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_PackOtherState' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyOtherState + call RegPack(Buf, InData%DummyOtherState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_UnPackOtherState' + if (Buf%ErrStat /= ErrID_None) return + ! DummyOtherState + call RegUnpack(Buf, OutData%DummyOtherState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE InflowWind_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) TYPE(InflowWind_MiscVarType), INTENT(IN) :: SrcMiscData TYPE(InflowWind_MiscVarType), INTENT(INOUT) :: DstMiscData @@ -4482,575 +2315,109 @@ SUBROUTINE InflowWind_DestroyMisc( MiscData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE InflowWind_DestroyMisc - SUBROUTINE InflowWind_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(InflowWind_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! AllOuts allocated yes/no - IF ( ALLOCATED(InData%AllOuts) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AllOuts upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AllOuts) ! AllOuts - END IF - Int_BufSz = Int_BufSz + 1 ! WindViUVW allocated yes/no - IF ( ALLOCATED(InData%WindViUVW) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WindViUVW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WindViUVW) ! WindViUVW - END IF - Int_BufSz = Int_BufSz + 1 ! WindAiUVW allocated yes/no - IF ( ALLOCATED(InData%WindAiUVW) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WindAiUVW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WindAiUVW) ! WindAiUVW - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! u_Avg: size of buffers for each call to pack subtype - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_Avg, ErrStat2, ErrMsg2, .TRUE. ) ! u_Avg - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_Avg - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_Avg - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_Avg - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y_Avg: size of buffers for each call to pack subtype - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_Avg, ErrStat2, ErrMsg2, .TRUE. ) ! y_Avg - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_Avg - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_Avg - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_Avg - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u_Hub: size of buffers for each call to pack subtype - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_Hub, ErrStat2, ErrMsg2, .TRUE. ) ! u_Hub - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_Hub - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_Hub - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_Hub - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y_Hub: size of buffers for each call to pack subtype - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_Hub, ErrStat2, ErrMsg2, .TRUE. ) ! y_Hub - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_Hub - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_Hub - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_Hub - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%AllOuts) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AllOuts,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOuts,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AllOuts,1), UBOUND(InData%AllOuts,1) - ReKiBuf(Re_Xferred) = InData%AllOuts(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WindViUVW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WindViUVW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindViUVW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WindViUVW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindViUVW,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WindViUVW,2), UBOUND(InData%WindViUVW,2) - DO i1 = LBOUND(InData%WindViUVW,1), UBOUND(InData%WindViUVW,1) - ReKiBuf(Re_Xferred) = InData%WindViUVW(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WindAiUVW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WindAiUVW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindAiUVW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WindAiUVW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindAiUVW,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WindAiUVW,2), UBOUND(InData%WindAiUVW,2) - DO i1 = LBOUND(InData%WindAiUVW,1), UBOUND(InData%WindAiUVW,1) - ReKiBuf(Re_Xferred) = InData%WindAiUVW(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_Avg, ErrStat2, ErrMsg2, OnlySize ) ! u_Avg - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_Avg, ErrStat2, ErrMsg2, OnlySize ) ! y_Avg - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_Hub, ErrStat2, ErrMsg2, OnlySize ) ! u_Hub - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_Hub, ErrStat2, ErrMsg2, OnlySize ) ! y_Hub - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE InflowWind_PackMisc - - SUBROUTINE InflowWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(InflowWind_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AllOuts not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AllOuts)) DEALLOCATE(OutData%AllOuts) - ALLOCATE(OutData%AllOuts(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AllOuts,1), UBOUND(OutData%AllOuts,1) - OutData%AllOuts(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindViUVW not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WindViUVW)) DEALLOCATE(OutData%WindViUVW) - ALLOCATE(OutData%WindViUVW(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindViUVW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WindViUVW,2), UBOUND(OutData%WindViUVW,2) - DO i1 = LBOUND(OutData%WindViUVW,1), UBOUND(OutData%WindViUVW,1) - OutData%WindViUVW(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindAiUVW not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WindAiUVW)) DEALLOCATE(OutData%WindAiUVW) - ALLOCATE(OutData%WindAiUVW(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindAiUVW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WindAiUVW,2), UBOUND(OutData%WindAiUVW,2) - DO i1 = LBOUND(OutData%WindAiUVW,1), UBOUND(OutData%WindAiUVW,1) - OutData%WindAiUVW(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_Avg, ErrStat2, ErrMsg2 ) ! u_Avg - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_Avg, ErrStat2, ErrMsg2 ) ! y_Avg - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_Hub, ErrStat2, ErrMsg2 ) ! u_Hub - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_Hub, ErrStat2, ErrMsg2 ) ! y_Hub - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE InflowWind_UnPackMisc +subroutine InflowWind_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'InflowWind_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + ! AllOuts + call RegPack(Buf, allocated(InData%AllOuts)) + if (allocated(InData%AllOuts)) then + call RegPackBounds(Buf, 1, lbound(InData%AllOuts), ubound(InData%AllOuts)) + call RegPack(Buf, InData%AllOuts) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WindViUVW + call RegPack(Buf, allocated(InData%WindViUVW)) + if (allocated(InData%WindViUVW)) then + call RegPackBounds(Buf, 2, lbound(InData%WindViUVW), ubound(InData%WindViUVW)) + call RegPack(Buf, InData%WindViUVW) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WindAiUVW + call RegPack(Buf, allocated(InData%WindAiUVW)) + if (allocated(InData%WindAiUVW)) then + call RegPackBounds(Buf, 2, lbound(InData%WindAiUVW), ubound(InData%WindAiUVW)) + call RegPack(Buf, InData%WindAiUVW) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! u_Avg + call InflowWind_PackInput(Buf, InData%u_Avg) + if (RegCheckErr(Buf, RoutineName)) return + ! y_Avg + call InflowWind_PackOutput(Buf, InData%y_Avg) + if (RegCheckErr(Buf, RoutineName)) return + ! u_Hub + call InflowWind_PackInput(Buf, InData%u_Hub) + if (RegCheckErr(Buf, RoutineName)) return + ! y_Hub + call InflowWind_PackOutput(Buf, InData%y_Hub) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine InflowWind_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'InflowWind_UnPackMisc' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! AllOuts + if (allocated(OutData%AllOuts)) deallocate(OutData%AllOuts) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AllOuts(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AllOuts) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WindViUVW + if (allocated(OutData%WindViUVW)) deallocate(OutData%WindViUVW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WindViUVW(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindViUVW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WindViUVW) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WindAiUVW + if (allocated(OutData%WindAiUVW)) deallocate(OutData%WindAiUVW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WindAiUVW(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindAiUVW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WindAiUVW) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! u_Avg + call InflowWind_UnpackInput(Buf, OutData%u_Avg) ! u_Avg + ! y_Avg + call InflowWind_UnpackOutput(Buf, OutData%y_Avg) ! y_Avg + ! u_Hub + call InflowWind_UnpackInput(Buf, OutData%u_Hub) ! u_Hub + ! y_Hub + call InflowWind_UnpackOutput(Buf, OutData%y_Hub) ! y_Hub +end subroutine SUBROUTINE InflowWind_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) ! diff --git a/modules/inflowwind/src/Lidar_Types.f90 b/modules/inflowwind/src/Lidar_Types.f90 index 7b23f352c0..cd500ab503 100644 --- a/modules/inflowwind/src/Lidar_Types.f90 +++ b/modules/inflowwind/src/Lidar_Types.f90 @@ -162,141 +162,56 @@ SUBROUTINE Lidar_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) END SUBROUTINE Lidar_DestroyInitInput - SUBROUTINE Lidar_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Lidar_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! SensorType - Db_BufSz = Db_BufSz + 1 ! Tmax - Re_BufSz = Re_BufSz + SIZE(InData%RotorApexOffsetPos) ! RotorApexOffsetPos - Re_BufSz = Re_BufSz + SIZE(InData%HubPosition) ! HubPosition - Int_BufSz = Int_BufSz + 1 ! NumPulseGate - Int_BufSz = Int_BufSz + 1 ! LidRadialVel - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%SensorType - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Tmax - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%RotorApexOffsetPos,1), UBOUND(InData%RotorApexOffsetPos,1) - ReKiBuf(Re_Xferred) = InData%RotorApexOffsetPos(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%HubPosition,1), UBOUND(InData%HubPosition,1) - ReKiBuf(Re_Xferred) = InData%HubPosition(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%NumPulseGate - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%LidRadialVel, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Lidar_PackInitInput - - SUBROUTINE Lidar_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Lidar_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%SensorType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Tmax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%RotorApexOffsetPos,1) - i1_u = UBOUND(OutData%RotorApexOffsetPos,1) - DO i1 = LBOUND(OutData%RotorApexOffsetPos,1), UBOUND(OutData%RotorApexOffsetPos,1) - OutData%RotorApexOffsetPos(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%HubPosition,1) - i1_u = UBOUND(OutData%HubPosition,1) - DO i1 = LBOUND(OutData%HubPosition,1), UBOUND(OutData%HubPosition,1) - OutData%HubPosition(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%NumPulseGate = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%LidRadialVel = TRANSFER(IntKiBuf(Int_Xferred), OutData%LidRadialVel) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Lidar_UnPackInitInput +subroutine Lidar_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Lidar_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Lidar_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + ! SensorType + call RegPack(Buf, InData%SensorType) + if (RegCheckErr(Buf, RoutineName)) return + ! Tmax + call RegPack(Buf, InData%Tmax) + if (RegCheckErr(Buf, RoutineName)) return + ! RotorApexOffsetPos + call RegPack(Buf, InData%RotorApexOffsetPos) + if (RegCheckErr(Buf, RoutineName)) return + ! HubPosition + call RegPack(Buf, InData%HubPosition) + if (RegCheckErr(Buf, RoutineName)) return + ! NumPulseGate + call RegPack(Buf, InData%NumPulseGate) + if (RegCheckErr(Buf, RoutineName)) return + ! LidRadialVel + call RegPack(Buf, InData%LidRadialVel) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Lidar_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Lidar_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Lidar_UnPackInitInput' + if (Buf%ErrStat /= ErrID_None) return + ! SensorType + call RegUnpack(Buf, OutData%SensorType) + if (RegCheckErr(Buf, RoutineName)) return + ! Tmax + call RegUnpack(Buf, OutData%Tmax) + if (RegCheckErr(Buf, RoutineName)) return + ! RotorApexOffsetPos + call RegUnpack(Buf, OutData%RotorApexOffsetPos) + if (RegCheckErr(Buf, RoutineName)) return + ! HubPosition + call RegUnpack(Buf, OutData%HubPosition) + if (RegCheckErr(Buf, RoutineName)) return + ! NumPulseGate + call RegUnpack(Buf, OutData%NumPulseGate) + if (RegCheckErr(Buf, RoutineName)) return + ! LidRadialVel + call RegUnpack(Buf, OutData%LidRadialVel) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE Lidar_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(Lidar_InitOutputType), INTENT(IN) :: SrcInitOutputData TYPE(Lidar_InitOutputType), INTENT(INOUT) :: DstInitOutputData @@ -329,103 +244,26 @@ SUBROUTINE Lidar_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) END SUBROUTINE Lidar_DestroyInitOutput - SUBROUTINE Lidar_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Lidar_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyInitOut - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyInitOut - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Lidar_PackInitOutput - - SUBROUTINE Lidar_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Lidar_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyInitOut = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Lidar_UnPackInitOutput +subroutine Lidar_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Lidar_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Lidar_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyInitOut + call RegPack(Buf, InData%DummyInitOut) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Lidar_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Lidar_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Lidar_UnPackInitOutput' + if (Buf%ErrStat /= ErrID_None) return + ! DummyInitOut + call RegUnpack(Buf, OutData%DummyInitOut) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE Lidar_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(Lidar_ParameterType), INTENT(IN) :: SrcParamData TYPE(Lidar_ParameterType), INTENT(INOUT) :: DstParamData @@ -541,374 +379,231 @@ SUBROUTINE Lidar_DestroyParam( ParamData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE Lidar_DestroyParam - SUBROUTINE Lidar_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Lidar_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! NumPulseGate - Re_BufSz = Re_BufSz + SIZE(InData%RotorApexOffsetPos) ! RotorApexOffsetPos - Re_BufSz = Re_BufSz + 1 ! RayRangeSq - Re_BufSz = Re_BufSz + 1 ! SpatialRes - Int_BufSz = Int_BufSz + 1 ! SensorType - Re_BufSz = Re_BufSz + 1 ! WtFnTrunc - Re_BufSz = Re_BufSz + 1 ! PulseRangeOne - Re_BufSz = Re_BufSz + 1 ! DeltaP - Re_BufSz = Re_BufSz + 1 ! DeltaR - Re_BufSz = Re_BufSz + 1 ! r_p - Int_BufSz = Int_BufSz + 1 ! LidRadialVel - Re_BufSz = Re_BufSz + 1 ! DisplacementLidarX - Re_BufSz = Re_BufSz + 1 ! DisplacementLidarY - Re_BufSz = Re_BufSz + 1 ! DisplacementLidarZ - Int_BufSz = Int_BufSz + 1 ! NumBeam - Int_BufSz = Int_BufSz + 1 ! FocalDistanceX allocated yes/no - IF ( ALLOCATED(InData%FocalDistanceX) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FocalDistanceX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FocalDistanceX) ! FocalDistanceX - END IF - Int_BufSz = Int_BufSz + 1 ! FocalDistanceY allocated yes/no - IF ( ALLOCATED(InData%FocalDistanceY) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FocalDistanceY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FocalDistanceY) ! FocalDistanceY - END IF - Int_BufSz = Int_BufSz + 1 ! FocalDistanceZ allocated yes/no - IF ( ALLOCATED(InData%FocalDistanceZ) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FocalDistanceZ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FocalDistanceZ) ! FocalDistanceZ - END IF - Int_BufSz = Int_BufSz + 1 ! MsrPosition allocated yes/no - IF ( ALLOCATED(InData%MsrPosition) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MsrPosition upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MsrPosition) ! MsrPosition - END IF - Re_BufSz = Re_BufSz + 1 ! PulseSpacing - Re_BufSz = Re_BufSz + 1 ! URefLid - Int_BufSz = Int_BufSz + 1 ! ConsiderHubMotion - Re_BufSz = Re_BufSz + 1 ! MeasurementInterval - Re_BufSz = Re_BufSz + SIZE(InData%LidPosition) ! LidPosition - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%NumPulseGate - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%RotorApexOffsetPos,1), UBOUND(InData%RotorApexOffsetPos,1) - ReKiBuf(Re_Xferred) = InData%RotorApexOffsetPos(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%RayRangeSq - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SpatialRes - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%SensorType - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtFnTrunc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PulseRangeOne - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DeltaP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DeltaR - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%r_p - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%LidRadialVel, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DisplacementLidarX - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DisplacementLidarY - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DisplacementLidarZ - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBeam - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%FocalDistanceX) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FocalDistanceX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FocalDistanceX,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FocalDistanceX,1), UBOUND(InData%FocalDistanceX,1) - ReKiBuf(Re_Xferred) = InData%FocalDistanceX(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FocalDistanceY) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FocalDistanceY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FocalDistanceY,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FocalDistanceY,1), UBOUND(InData%FocalDistanceY,1) - ReKiBuf(Re_Xferred) = InData%FocalDistanceY(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FocalDistanceZ) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FocalDistanceZ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FocalDistanceZ,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FocalDistanceZ,1), UBOUND(InData%FocalDistanceZ,1) - ReKiBuf(Re_Xferred) = InData%FocalDistanceZ(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MsrPosition) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MsrPosition,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MsrPosition,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MsrPosition,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MsrPosition,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MsrPosition,2), UBOUND(InData%MsrPosition,2) - DO i1 = LBOUND(InData%MsrPosition,1), UBOUND(InData%MsrPosition,1) - ReKiBuf(Re_Xferred) = InData%MsrPosition(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%PulseSpacing - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%URefLid - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ConsiderHubMotion - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MeasurementInterval - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%LidPosition,1), UBOUND(InData%LidPosition,1) - ReKiBuf(Re_Xferred) = InData%LidPosition(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE Lidar_PackParam - - SUBROUTINE Lidar_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Lidar_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%NumPulseGate = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%RotorApexOffsetPos,1) - i1_u = UBOUND(OutData%RotorApexOffsetPos,1) - DO i1 = LBOUND(OutData%RotorApexOffsetPos,1), UBOUND(OutData%RotorApexOffsetPos,1) - OutData%RotorApexOffsetPos(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%RayRangeSq = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SpatialRes = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SensorType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WtFnTrunc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PulseRangeOne = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DeltaP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DeltaR = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%r_p = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LidRadialVel = TRANSFER(IntKiBuf(Int_Xferred), OutData%LidRadialVel) - Int_Xferred = Int_Xferred + 1 - OutData%DisplacementLidarX = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DisplacementLidarY = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DisplacementLidarZ = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NumBeam = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FocalDistanceX not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FocalDistanceX)) DEALLOCATE(OutData%FocalDistanceX) - ALLOCATE(OutData%FocalDistanceX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FocalDistanceX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FocalDistanceX,1), UBOUND(OutData%FocalDistanceX,1) - OutData%FocalDistanceX(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FocalDistanceY not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FocalDistanceY)) DEALLOCATE(OutData%FocalDistanceY) - ALLOCATE(OutData%FocalDistanceY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FocalDistanceY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FocalDistanceY,1), UBOUND(OutData%FocalDistanceY,1) - OutData%FocalDistanceY(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FocalDistanceZ not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FocalDistanceZ)) DEALLOCATE(OutData%FocalDistanceZ) - ALLOCATE(OutData%FocalDistanceZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FocalDistanceZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FocalDistanceZ,1), UBOUND(OutData%FocalDistanceZ,1) - OutData%FocalDistanceZ(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MsrPosition not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MsrPosition)) DEALLOCATE(OutData%MsrPosition) - ALLOCATE(OutData%MsrPosition(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPosition.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MsrPosition,2), UBOUND(OutData%MsrPosition,2) - DO i1 = LBOUND(OutData%MsrPosition,1), UBOUND(OutData%MsrPosition,1) - OutData%MsrPosition(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%PulseSpacing = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%URefLid = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ConsiderHubMotion = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MeasurementInterval = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%LidPosition,1) - i1_u = UBOUND(OutData%LidPosition,1) - DO i1 = LBOUND(OutData%LidPosition,1), UBOUND(OutData%LidPosition,1) - OutData%LidPosition(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE Lidar_UnPackParam +subroutine Lidar_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Lidar_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Lidar_PackParam' + if (Buf%ErrStat >= AbortErrLev) return + ! NumPulseGate + call RegPack(Buf, InData%NumPulseGate) + if (RegCheckErr(Buf, RoutineName)) return + ! RotorApexOffsetPos + call RegPack(Buf, InData%RotorApexOffsetPos) + if (RegCheckErr(Buf, RoutineName)) return + ! RayRangeSq + call RegPack(Buf, InData%RayRangeSq) + if (RegCheckErr(Buf, RoutineName)) return + ! SpatialRes + call RegPack(Buf, InData%SpatialRes) + if (RegCheckErr(Buf, RoutineName)) return + ! SensorType + call RegPack(Buf, InData%SensorType) + if (RegCheckErr(Buf, RoutineName)) return + ! WtFnTrunc + call RegPack(Buf, InData%WtFnTrunc) + if (RegCheckErr(Buf, RoutineName)) return + ! PulseRangeOne + call RegPack(Buf, InData%PulseRangeOne) + if (RegCheckErr(Buf, RoutineName)) return + ! DeltaP + call RegPack(Buf, InData%DeltaP) + if (RegCheckErr(Buf, RoutineName)) return + ! DeltaR + call RegPack(Buf, InData%DeltaR) + if (RegCheckErr(Buf, RoutineName)) return + ! r_p + call RegPack(Buf, InData%r_p) + if (RegCheckErr(Buf, RoutineName)) return + ! LidRadialVel + call RegPack(Buf, InData%LidRadialVel) + if (RegCheckErr(Buf, RoutineName)) return + ! DisplacementLidarX + call RegPack(Buf, InData%DisplacementLidarX) + if (RegCheckErr(Buf, RoutineName)) return + ! DisplacementLidarY + call RegPack(Buf, InData%DisplacementLidarY) + if (RegCheckErr(Buf, RoutineName)) return + ! DisplacementLidarZ + call RegPack(Buf, InData%DisplacementLidarZ) + if (RegCheckErr(Buf, RoutineName)) return + ! NumBeam + call RegPack(Buf, InData%NumBeam) + if (RegCheckErr(Buf, RoutineName)) return + ! FocalDistanceX + call RegPack(Buf, allocated(InData%FocalDistanceX)) + if (allocated(InData%FocalDistanceX)) then + call RegPackBounds(Buf, 1, lbound(InData%FocalDistanceX), ubound(InData%FocalDistanceX)) + call RegPack(Buf, InData%FocalDistanceX) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FocalDistanceY + call RegPack(Buf, allocated(InData%FocalDistanceY)) + if (allocated(InData%FocalDistanceY)) then + call RegPackBounds(Buf, 1, lbound(InData%FocalDistanceY), ubound(InData%FocalDistanceY)) + call RegPack(Buf, InData%FocalDistanceY) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FocalDistanceZ + call RegPack(Buf, allocated(InData%FocalDistanceZ)) + if (allocated(InData%FocalDistanceZ)) then + call RegPackBounds(Buf, 1, lbound(InData%FocalDistanceZ), ubound(InData%FocalDistanceZ)) + call RegPack(Buf, InData%FocalDistanceZ) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MsrPosition + call RegPack(Buf, allocated(InData%MsrPosition)) + if (allocated(InData%MsrPosition)) then + call RegPackBounds(Buf, 2, lbound(InData%MsrPosition), ubound(InData%MsrPosition)) + call RegPack(Buf, InData%MsrPosition) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PulseSpacing + call RegPack(Buf, InData%PulseSpacing) + if (RegCheckErr(Buf, RoutineName)) return + ! URefLid + call RegPack(Buf, InData%URefLid) + if (RegCheckErr(Buf, RoutineName)) return + ! ConsiderHubMotion + call RegPack(Buf, InData%ConsiderHubMotion) + if (RegCheckErr(Buf, RoutineName)) return + ! MeasurementInterval + call RegPack(Buf, InData%MeasurementInterval) + if (RegCheckErr(Buf, RoutineName)) return + ! LidPosition + call RegPack(Buf, InData%LidPosition) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Lidar_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Lidar_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Lidar_UnPackParam' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! NumPulseGate + call RegUnpack(Buf, OutData%NumPulseGate) + if (RegCheckErr(Buf, RoutineName)) return + ! RotorApexOffsetPos + call RegUnpack(Buf, OutData%RotorApexOffsetPos) + if (RegCheckErr(Buf, RoutineName)) return + ! RayRangeSq + call RegUnpack(Buf, OutData%RayRangeSq) + if (RegCheckErr(Buf, RoutineName)) return + ! SpatialRes + call RegUnpack(Buf, OutData%SpatialRes) + if (RegCheckErr(Buf, RoutineName)) return + ! SensorType + call RegUnpack(Buf, OutData%SensorType) + if (RegCheckErr(Buf, RoutineName)) return + ! WtFnTrunc + call RegUnpack(Buf, OutData%WtFnTrunc) + if (RegCheckErr(Buf, RoutineName)) return + ! PulseRangeOne + call RegUnpack(Buf, OutData%PulseRangeOne) + if (RegCheckErr(Buf, RoutineName)) return + ! DeltaP + call RegUnpack(Buf, OutData%DeltaP) + if (RegCheckErr(Buf, RoutineName)) return + ! DeltaR + call RegUnpack(Buf, OutData%DeltaR) + if (RegCheckErr(Buf, RoutineName)) return + ! r_p + call RegUnpack(Buf, OutData%r_p) + if (RegCheckErr(Buf, RoutineName)) return + ! LidRadialVel + call RegUnpack(Buf, OutData%LidRadialVel) + if (RegCheckErr(Buf, RoutineName)) return + ! DisplacementLidarX + call RegUnpack(Buf, OutData%DisplacementLidarX) + if (RegCheckErr(Buf, RoutineName)) return + ! DisplacementLidarY + call RegUnpack(Buf, OutData%DisplacementLidarY) + if (RegCheckErr(Buf, RoutineName)) return + ! DisplacementLidarZ + call RegUnpack(Buf, OutData%DisplacementLidarZ) + if (RegCheckErr(Buf, RoutineName)) return + ! NumBeam + call RegUnpack(Buf, OutData%NumBeam) + if (RegCheckErr(Buf, RoutineName)) return + ! FocalDistanceX + if (allocated(OutData%FocalDistanceX)) deallocate(OutData%FocalDistanceX) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FocalDistanceX(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FocalDistanceX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FocalDistanceX) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! FocalDistanceY + if (allocated(OutData%FocalDistanceY)) deallocate(OutData%FocalDistanceY) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FocalDistanceY(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FocalDistanceY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FocalDistanceY) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! FocalDistanceZ + if (allocated(OutData%FocalDistanceZ)) deallocate(OutData%FocalDistanceZ) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FocalDistanceZ(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FocalDistanceZ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FocalDistanceZ) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! MsrPosition + if (allocated(OutData%MsrPosition)) deallocate(OutData%MsrPosition) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MsrPosition(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPosition.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MsrPosition) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PulseSpacing + call RegUnpack(Buf, OutData%PulseSpacing) + if (RegCheckErr(Buf, RoutineName)) return + ! URefLid + call RegUnpack(Buf, OutData%URefLid) + if (RegCheckErr(Buf, RoutineName)) return + ! ConsiderHubMotion + call RegUnpack(Buf, OutData%ConsiderHubMotion) + if (RegCheckErr(Buf, RoutineName)) return + ! MeasurementInterval + call RegUnpack(Buf, OutData%MeasurementInterval) + if (RegCheckErr(Buf, RoutineName)) return + ! LidPosition + call RegUnpack(Buf, OutData%LidPosition) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE Lidar_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(Lidar_ContinuousStateType), INTENT(IN) :: SrcContStateData TYPE(Lidar_ContinuousStateType), INTENT(INOUT) :: DstContStateData @@ -941,103 +636,26 @@ SUBROUTINE Lidar_DestroyContState( ContStateData, ErrStat, ErrMsg ) END SUBROUTINE Lidar_DestroyContState - SUBROUTINE Lidar_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Lidar_ContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_PackContState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyContState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Lidar_PackContState - - SUBROUTINE Lidar_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Lidar_ContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_UnPackContState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyContState = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Lidar_UnPackContState +subroutine Lidar_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Lidar_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Lidar_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyContState + call RegPack(Buf, InData%DummyContState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Lidar_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Lidar_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Lidar_UnPackContState' + if (Buf%ErrStat /= ErrID_None) return + ! DummyContState + call RegUnpack(Buf, OutData%DummyContState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE Lidar_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(Lidar_DiscreteStateType), INTENT(IN) :: SrcDiscStateData TYPE(Lidar_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData @@ -1070,103 +688,26 @@ SUBROUTINE Lidar_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) END SUBROUTINE Lidar_DestroyDiscState - SUBROUTINE Lidar_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Lidar_DiscreteStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_PackDiscState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyDiscState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Lidar_PackDiscState - - SUBROUTINE Lidar_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Lidar_DiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_UnPackDiscState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyDiscState = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Lidar_UnPackDiscState +subroutine Lidar_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Lidar_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Lidar_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyDiscState + call RegPack(Buf, InData%DummyDiscState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Lidar_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Lidar_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Lidar_UnPackDiscState' + if (Buf%ErrStat /= ErrID_None) return + ! DummyDiscState + call RegUnpack(Buf, OutData%DummyDiscState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE Lidar_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(Lidar_ConstraintStateType), INTENT(IN) :: SrcConstrStateData TYPE(Lidar_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData @@ -1199,103 +740,26 @@ SUBROUTINE Lidar_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) END SUBROUTINE Lidar_DestroyConstrState - SUBROUTINE Lidar_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Lidar_ConstraintStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_PackConstrState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyConstrState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Lidar_PackConstrState - - SUBROUTINE Lidar_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Lidar_ConstraintStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_UnPackConstrState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyConstrState = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Lidar_UnPackConstrState +subroutine Lidar_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Lidar_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Lidar_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyConstrState + call RegPack(Buf, InData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Lidar_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Lidar_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Lidar_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + ! DummyConstrState + call RegUnpack(Buf, OutData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE Lidar_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(Lidar_OtherStateType), INTENT(IN) :: SrcOtherStateData TYPE(Lidar_OtherStateType), INTENT(INOUT) :: DstOtherStateData @@ -1328,103 +792,26 @@ SUBROUTINE Lidar_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) END SUBROUTINE Lidar_DestroyOtherState - SUBROUTINE Lidar_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Lidar_OtherStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_PackOtherState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyOtherState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyOtherState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Lidar_PackOtherState - - SUBROUTINE Lidar_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Lidar_OtherStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_UnPackOtherState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyOtherState = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Lidar_UnPackOtherState +subroutine Lidar_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Lidar_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Lidar_PackOtherState' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyOtherState + call RegPack(Buf, InData%DummyOtherState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Lidar_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Lidar_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Lidar_UnPackOtherState' + if (Buf%ErrStat /= ErrID_None) return + ! DummyOtherState + call RegUnpack(Buf, OutData%DummyOtherState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE Lidar_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) TYPE(Lidar_MiscVarType), INTENT(IN) :: SrcMiscData TYPE(Lidar_MiscVarType), INTENT(INOUT) :: DstMiscData @@ -1457,103 +844,26 @@ SUBROUTINE Lidar_DestroyMisc( MiscData, ErrStat, ErrMsg ) END SUBROUTINE Lidar_DestroyMisc - SUBROUTINE Lidar_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Lidar_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyMiscVar - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyMiscVar - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Lidar_PackMisc - - SUBROUTINE Lidar_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Lidar_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyMiscVar = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Lidar_UnPackMisc +subroutine Lidar_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Lidar_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Lidar_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyMiscVar + call RegPack(Buf, InData%DummyMiscVar) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Lidar_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Lidar_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Lidar_UnPackMisc' + if (Buf%ErrStat /= ErrID_None) return + ! DummyMiscVar + call RegUnpack(Buf, OutData%DummyMiscVar) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE Lidar_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(Lidar_InputType), INTENT(IN) :: SrcInputData TYPE(Lidar_InputType), INTENT(INOUT) :: DstInputData @@ -1590,123 +900,50 @@ SUBROUTINE Lidar_DestroyInput( InputData, ErrStat, ErrMsg ) END SUBROUTINE Lidar_DestroyInput - SUBROUTINE Lidar_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Lidar_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! PulseLidEl - Re_BufSz = Re_BufSz + 1 ! PulseLidAz - Re_BufSz = Re_BufSz + 1 ! HubDisplacementX - Re_BufSz = Re_BufSz + 1 ! HubDisplacementY - Re_BufSz = Re_BufSz + 1 ! HubDisplacementZ - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%PulseLidEl - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PulseLidAz - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubDisplacementX - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubDisplacementY - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubDisplacementZ - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Lidar_PackInput - - SUBROUTINE Lidar_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Lidar_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%PulseLidEl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PulseLidAz = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HubDisplacementX = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HubDisplacementY = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HubDisplacementZ = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Lidar_UnPackInput +subroutine Lidar_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Lidar_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Lidar_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + ! PulseLidEl + call RegPack(Buf, InData%PulseLidEl) + if (RegCheckErr(Buf, RoutineName)) return + ! PulseLidAz + call RegPack(Buf, InData%PulseLidAz) + if (RegCheckErr(Buf, RoutineName)) return + ! HubDisplacementX + call RegPack(Buf, InData%HubDisplacementX) + if (RegCheckErr(Buf, RoutineName)) return + ! HubDisplacementY + call RegPack(Buf, InData%HubDisplacementY) + if (RegCheckErr(Buf, RoutineName)) return + ! HubDisplacementZ + call RegPack(Buf, InData%HubDisplacementZ) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Lidar_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Lidar_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Lidar_UnPackInput' + if (Buf%ErrStat /= ErrID_None) return + ! PulseLidEl + call RegUnpack(Buf, OutData%PulseLidEl) + if (RegCheckErr(Buf, RoutineName)) return + ! PulseLidAz + call RegUnpack(Buf, OutData%PulseLidAz) + if (RegCheckErr(Buf, RoutineName)) return + ! HubDisplacementX + call RegUnpack(Buf, OutData%HubDisplacementX) + if (RegCheckErr(Buf, RoutineName)) return + ! HubDisplacementY + call RegUnpack(Buf, OutData%HubDisplacementY) + if (RegCheckErr(Buf, RoutineName)) return + ! HubDisplacementZ + call RegUnpack(Buf, OutData%HubDisplacementZ) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE Lidar_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(Lidar_OutputType), INTENT(IN) :: SrcOutputData TYPE(Lidar_OutputType), INTENT(INOUT) :: DstOutputData @@ -1814,289 +1051,133 @@ SUBROUTINE Lidar_DestroyOutput( OutputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE Lidar_DestroyOutput - SUBROUTINE Lidar_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Lidar_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! LidSpeed allocated yes/no - IF ( ALLOCATED(InData%LidSpeed) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LidSpeed upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LidSpeed) ! LidSpeed - END IF - Int_BufSz = Int_BufSz + 1 ! WtTrunc allocated yes/no - IF ( ALLOCATED(InData%WtTrunc) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WtTrunc upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WtTrunc) ! WtTrunc - END IF - Int_BufSz = Int_BufSz + 1 ! MsrPositionsX allocated yes/no - IF ( ALLOCATED(InData%MsrPositionsX) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MsrPositionsX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MsrPositionsX) ! MsrPositionsX - END IF - Int_BufSz = Int_BufSz + 1 ! MsrPositionsY allocated yes/no - IF ( ALLOCATED(InData%MsrPositionsY) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MsrPositionsY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MsrPositionsY) ! MsrPositionsY - END IF - Int_BufSz = Int_BufSz + 1 ! MsrPositionsZ allocated yes/no - IF ( ALLOCATED(InData%MsrPositionsZ) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MsrPositionsZ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MsrPositionsZ) ! MsrPositionsZ - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%LidSpeed) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LidSpeed,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LidSpeed,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LidSpeed,1), UBOUND(InData%LidSpeed,1) - ReKiBuf(Re_Xferred) = InData%LidSpeed(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WtTrunc) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WtTrunc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WtTrunc,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WtTrunc,1), UBOUND(InData%WtTrunc,1) - ReKiBuf(Re_Xferred) = InData%WtTrunc(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MsrPositionsX) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MsrPositionsX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MsrPositionsX,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MsrPositionsX,1), UBOUND(InData%MsrPositionsX,1) - ReKiBuf(Re_Xferred) = InData%MsrPositionsX(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MsrPositionsY) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MsrPositionsY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MsrPositionsY,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MsrPositionsY,1), UBOUND(InData%MsrPositionsY,1) - ReKiBuf(Re_Xferred) = InData%MsrPositionsY(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MsrPositionsZ) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MsrPositionsZ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MsrPositionsZ,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MsrPositionsZ,1), UBOUND(InData%MsrPositionsZ,1) - ReKiBuf(Re_Xferred) = InData%MsrPositionsZ(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE Lidar_PackOutput - - SUBROUTINE Lidar_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Lidar_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LidSpeed not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LidSpeed)) DEALLOCATE(OutData%LidSpeed) - ALLOCATE(OutData%LidSpeed(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LidSpeed.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LidSpeed,1), UBOUND(OutData%LidSpeed,1) - OutData%LidSpeed(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WtTrunc not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WtTrunc)) DEALLOCATE(OutData%WtTrunc) - ALLOCATE(OutData%WtTrunc(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WtTrunc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WtTrunc,1), UBOUND(OutData%WtTrunc,1) - OutData%WtTrunc(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MsrPositionsX not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MsrPositionsX)) DEALLOCATE(OutData%MsrPositionsX) - ALLOCATE(OutData%MsrPositionsX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MsrPositionsX,1), UBOUND(OutData%MsrPositionsX,1) - OutData%MsrPositionsX(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MsrPositionsY not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MsrPositionsY)) DEALLOCATE(OutData%MsrPositionsY) - ALLOCATE(OutData%MsrPositionsY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MsrPositionsY,1), UBOUND(OutData%MsrPositionsY,1) - OutData%MsrPositionsY(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MsrPositionsZ not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MsrPositionsZ)) DEALLOCATE(OutData%MsrPositionsZ) - ALLOCATE(OutData%MsrPositionsZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MsrPositionsZ,1), UBOUND(OutData%MsrPositionsZ,1) - OutData%MsrPositionsZ(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE Lidar_UnPackOutput +subroutine Lidar_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Lidar_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Lidar_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! LidSpeed + call RegPack(Buf, allocated(InData%LidSpeed)) + if (allocated(InData%LidSpeed)) then + call RegPackBounds(Buf, 1, lbound(InData%LidSpeed), ubound(InData%LidSpeed)) + call RegPack(Buf, InData%LidSpeed) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WtTrunc + call RegPack(Buf, allocated(InData%WtTrunc)) + if (allocated(InData%WtTrunc)) then + call RegPackBounds(Buf, 1, lbound(InData%WtTrunc), ubound(InData%WtTrunc)) + call RegPack(Buf, InData%WtTrunc) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MsrPositionsX + call RegPack(Buf, allocated(InData%MsrPositionsX)) + if (allocated(InData%MsrPositionsX)) then + call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsX), ubound(InData%MsrPositionsX)) + call RegPack(Buf, InData%MsrPositionsX) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MsrPositionsY + call RegPack(Buf, allocated(InData%MsrPositionsY)) + if (allocated(InData%MsrPositionsY)) then + call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsY), ubound(InData%MsrPositionsY)) + call RegPack(Buf, InData%MsrPositionsY) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MsrPositionsZ + call RegPack(Buf, allocated(InData%MsrPositionsZ)) + if (allocated(InData%MsrPositionsZ)) then + call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsZ), ubound(InData%MsrPositionsZ)) + call RegPack(Buf, InData%MsrPositionsZ) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Lidar_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Lidar_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Lidar_UnPackOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! LidSpeed + if (allocated(OutData%LidSpeed)) deallocate(OutData%LidSpeed) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LidSpeed(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LidSpeed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LidSpeed) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WtTrunc + if (allocated(OutData%WtTrunc)) deallocate(OutData%WtTrunc) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WtTrunc(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WtTrunc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WtTrunc) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! MsrPositionsX + if (allocated(OutData%MsrPositionsX)) deallocate(OutData%MsrPositionsX) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MsrPositionsX(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MsrPositionsX) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! MsrPositionsY + if (allocated(OutData%MsrPositionsY)) deallocate(OutData%MsrPositionsY) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MsrPositionsY(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MsrPositionsY) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! MsrPositionsZ + if (allocated(OutData%MsrPositionsZ)) deallocate(OutData%MsrPositionsZ) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MsrPositionsZ(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsZ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MsrPositionsZ) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE Lidar_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) ! diff --git a/modules/map/src/MAP_Fortran_Types.f90 b/modules/map/src/MAP_Fortran_Types.f90 index f8acf9447f..01065f5564 100644 --- a/modules/map/src/MAP_Fortran_Types.f90 +++ b/modules/map/src/MAP_Fortran_Types.f90 @@ -85,103 +85,26 @@ SUBROUTINE MAP_Fortran_DestroyLin_InitInputType( Lin_InitInputTypeData, ErrStat, END SUBROUTINE MAP_Fortran_DestroyLin_InitInputType - SUBROUTINE MAP_Fortran_PackLin_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Lin_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Fortran_PackLin_InitInputType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! linearize - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%linearize, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE MAP_Fortran_PackLin_InitInputType - - SUBROUTINE MAP_Fortran_UnPackLin_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Lin_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Fortran_UnPackLin_InitInputType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%linearize) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE MAP_Fortran_UnPackLin_InitInputType +subroutine MAP_Fortran_PackLin_InitInputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Lin_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MAP_Fortran_PackLin_InitInputType' + if (Buf%ErrStat >= AbortErrLev) return + ! linearize + call RegPack(Buf, InData%linearize) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine +subroutine MAP_Fortran_UnPackLin_InitInputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Lin_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MAP_Fortran_UnPackLin_InitInputType' + if (Buf%ErrStat /= ErrID_None) return + ! linearize + call RegUnpack(Buf, OutData%linearize) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE MAP_Fortran_CopyLin_InitOutputType( SrcLin_InitOutputTypeData, DstLin_InitOutputTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(Lin_InitOutputType), INTENT(IN) :: SrcLin_InitOutputTypeData TYPE(Lin_InitOutputType), INTENT(INOUT) :: DstLin_InitOutputTypeData @@ -259,221 +182,89 @@ SUBROUTINE MAP_Fortran_DestroyLin_InitOutputType( Lin_InitOutputTypeData, ErrSta ENDIF END SUBROUTINE MAP_Fortran_DestroyLin_InitOutputType - SUBROUTINE MAP_Fortran_PackLin_InitOutputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Lin_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Fortran_PackLin_InitOutputType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! LinNames_y allocated yes/no - IF ( ALLOCATED(InData%LinNames_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_y)*LEN(InData%LinNames_y) ! LinNames_y - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_u allocated yes/no - IF ( ALLOCATED(InData%LinNames_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_u)*LEN(InData%LinNames_u) ! LinNames_u - END IF - Int_BufSz = Int_BufSz + 1 ! IsLoad_u allocated yes/no - IF ( ALLOCATED(InData%IsLoad_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IsLoad_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IsLoad_u) ! IsLoad_u - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%LinNames_y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_y,1) - Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) - DO I = 1, LEN(InData%LinNames_y) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_y(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinNames_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) - DO I = 1, LEN(InData%LinNames_u) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_u(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IsLoad_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IsLoad_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE MAP_Fortran_PackLin_InitOutputType - - SUBROUTINE MAP_Fortran_UnPackLin_InitOutputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Lin_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Fortran_UnPackLin_InitOutputType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LinNames_y)) DEALLOCATE(OutData%LinNames_y) - ALLOCATE(OutData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) - DO I = 1, LEN(OutData%LinNames_y) - OutData%LinNames_y(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LinNames_u)) DEALLOCATE(OutData%LinNames_u) - ALLOCATE(OutData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) - DO I = 1, LEN(OutData%LinNames_u) - OutData%LinNames_u(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IsLoad_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IsLoad_u)) DEALLOCATE(OutData%IsLoad_u) - ALLOCATE(OutData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) - OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE MAP_Fortran_UnPackLin_InitOutputType +subroutine MAP_Fortran_PackLin_InitOutputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Lin_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MAP_Fortran_PackLin_InitOutputType' + if (Buf%ErrStat >= AbortErrLev) return + ! LinNames_y + call RegPack(Buf, allocated(InData%LinNames_y)) + if (allocated(InData%LinNames_y)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) + call RegPack(Buf, InData%LinNames_y) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LinNames_u + call RegPack(Buf, allocated(InData%LinNames_u)) + if (allocated(InData%LinNames_u)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) + call RegPack(Buf, InData%LinNames_u) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! IsLoad_u + call RegPack(Buf, allocated(InData%IsLoad_u)) + if (allocated(InData%IsLoad_u)) then + call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) + call RegPack(Buf, InData%IsLoad_u) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine +subroutine MAP_Fortran_UnPackLin_InitOutputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Lin_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MAP_Fortran_UnPackLin_InitOutputType' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! LinNames_y + if (allocated(OutData%LinNames_y)) deallocate(OutData%LinNames_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LinNames_u + if (allocated(OutData%LinNames_u)) deallocate(OutData%LinNames_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! IsLoad_u + if (allocated(OutData%IsLoad_u)) deallocate(OutData%IsLoad_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IsLoad_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IsLoad_u) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE MAP_Fortran_CopyLin_ParamType( SrcLin_ParamTypeData, DstLin_ParamTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(Lin_ParamType), INTENT(IN) :: SrcLin_ParamTypeData TYPE(Lin_ParamType), INTENT(INOUT) :: DstLin_ParamTypeData @@ -526,157 +317,56 @@ SUBROUTINE MAP_Fortran_DestroyLin_ParamType( Lin_ParamTypeData, ErrStat, ErrMsg ENDIF END SUBROUTINE MAP_Fortran_DestroyLin_ParamType - SUBROUTINE MAP_Fortran_PackLin_ParamType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Lin_ParamType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Fortran_PackLin_ParamType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! Jac_u_indx allocated yes/no - IF ( ALLOCATED(InData%Jac_u_indx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_u_indx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_u_indx) ! Jac_u_indx - END IF - Db_BufSz = Db_BufSz + 1 ! du - Int_BufSz = Int_BufSz + 1 ! Jac_ny - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%Jac_u_indx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_u_indx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_u_indx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jac_u_indx,2), UBOUND(InData%Jac_u_indx,2) - DO i1 = LBOUND(InData%Jac_u_indx,1), UBOUND(InData%Jac_u_indx,1) - IntKiBuf(Int_Xferred) = InData%Jac_u_indx(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - DbKiBuf(Db_Xferred) = InData%du - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Jac_ny - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE MAP_Fortran_PackLin_ParamType - SUBROUTINE MAP_Fortran_UnPackLin_ParamType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Lin_ParamType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Fortran_UnPackLin_ParamType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_u_indx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Jac_u_indx)) DEALLOCATE(OutData%Jac_u_indx) - ALLOCATE(OutData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_u_indx,2), UBOUND(OutData%Jac_u_indx,2) - DO i1 = LBOUND(OutData%Jac_u_indx,1), UBOUND(OutData%Jac_u_indx,1) - OutData%Jac_u_indx(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - OutData%du = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%Jac_ny = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE MAP_Fortran_UnPackLin_ParamType +subroutine MAP_Fortran_PackLin_ParamType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Lin_ParamType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MAP_Fortran_PackLin_ParamType' + if (Buf%ErrStat >= AbortErrLev) return + ! Jac_u_indx + call RegPack(Buf, allocated(InData%Jac_u_indx)) + if (allocated(InData%Jac_u_indx)) then + call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx), ubound(InData%Jac_u_indx)) + call RegPack(Buf, InData%Jac_u_indx) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! du + call RegPack(Buf, InData%du) + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_ny + call RegPack(Buf, InData%Jac_ny) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine +subroutine MAP_Fortran_UnPackLin_ParamType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Lin_ParamType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MAP_Fortran_UnPackLin_ParamType' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! Jac_u_indx + if (allocated(OutData%Jac_u_indx)) deallocate(OutData%Jac_u_indx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jac_u_indx) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! du + call RegUnpack(Buf, OutData%du) + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_ny + call RegUnpack(Buf, OutData%Jac_ny) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine END MODULE MAP_Fortran_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/map/src/MAP_Types.f90 b/modules/map/src/MAP_Types.f90 index af459d0bdf..fdaf63fb3f 100644 --- a/modules/map/src/MAP_Types.f90 +++ b/modules/map/src/MAP_Types.f90 @@ -300,264 +300,92 @@ SUBROUTINE MAP_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE MAP_DestroyInitInput - SUBROUTINE MAP_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MAP_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! gravity - Db_BufSz = Db_BufSz + 1 ! sea_density - Db_BufSz = Db_BufSz + 1 ! depth - Int_BufSz = Int_BufSz + 1*LEN(InData%file_name) ! file_name - Int_BufSz = Int_BufSz + 1*LEN(InData%summary_file_name) ! summary_file_name - Int_BufSz = Int_BufSz + 1*LEN(InData%library_input_str) ! library_input_str - Int_BufSz = Int_BufSz + 1*LEN(InData%node_input_str) ! node_input_str - Int_BufSz = Int_BufSz + 1*LEN(InData%line_input_str) ! line_input_str - Int_BufSz = Int_BufSz + 1*LEN(InData%option_input_str) ! option_input_str - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! LinInitInp: size of buffers for each call to pack subtype - CALL MAP_Fortran_PackLin_InitInputType( Re_Buf, Db_Buf, Int_Buf, InData%LinInitInp, ErrStat2, ErrMsg2, .TRUE. ) ! LinInitInp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! LinInitInp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! LinInitInp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! LinInitInp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%gravity - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%sea_density - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%depth - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(InData%file_name) - IntKiBuf(Int_Xferred) = ICHAR(InData%file_name(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%summary_file_name) - IntKiBuf(Int_Xferred) = ICHAR(InData%summary_file_name(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%library_input_str) - IntKiBuf(Int_Xferred) = ICHAR(InData%library_input_str(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%node_input_str) - IntKiBuf(Int_Xferred) = ICHAR(InData%node_input_str(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%line_input_str) - IntKiBuf(Int_Xferred) = ICHAR(InData%line_input_str(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%option_input_str) - IntKiBuf(Int_Xferred) = ICHAR(InData%option_input_str(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - CALL MAP_Fortran_PackLin_InitInputType( Re_Buf, Db_Buf, Int_Buf, InData%LinInitInp, ErrStat2, ErrMsg2, OnlySize ) ! LinInitInp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE MAP_PackInitInput - - SUBROUTINE MAP_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MAP_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%gravity = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%C_obj%gravity = OutData%gravity - OutData%sea_density = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%C_obj%sea_density = OutData%sea_density - OutData%depth = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%C_obj%depth = OutData%depth - DO I = 1, LEN(OutData%file_name) - OutData%file_name(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%C_obj%file_name = TRANSFER(OutData%file_name, OutData%C_obj%file_name ) - DO I = 1, LEN(OutData%summary_file_name) - OutData%summary_file_name(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%C_obj%summary_file_name = TRANSFER(OutData%summary_file_name, OutData%C_obj%summary_file_name ) - DO I = 1, LEN(OutData%library_input_str) - OutData%library_input_str(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%C_obj%library_input_str = TRANSFER(OutData%library_input_str, OutData%C_obj%library_input_str ) - DO I = 1, LEN(OutData%node_input_str) - OutData%node_input_str(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%C_obj%node_input_str = TRANSFER(OutData%node_input_str, OutData%C_obj%node_input_str ) - DO I = 1, LEN(OutData%line_input_str) - OutData%line_input_str(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%C_obj%line_input_str = TRANSFER(OutData%line_input_str, OutData%C_obj%line_input_str ) - DO I = 1, LEN(OutData%option_input_str) - OutData%option_input_str(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%C_obj%option_input_str = TRANSFER(OutData%option_input_str, OutData%C_obj%option_input_str ) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MAP_Fortran_UnpackLin_InitInputType( Re_Buf, Db_Buf, Int_Buf, OutData%LinInitInp, ErrStat2, ErrMsg2 ) ! LinInitInp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE MAP_UnPackInitInput +subroutine MAP_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MAP_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MAP_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + ! gravity + call RegPack(Buf, InData%gravity) + if (RegCheckErr(Buf, RoutineName)) return + ! sea_density + call RegPack(Buf, InData%sea_density) + if (RegCheckErr(Buf, RoutineName)) return + ! depth + call RegPack(Buf, InData%depth) + if (RegCheckErr(Buf, RoutineName)) return + ! file_name + call RegPack(Buf, InData%file_name) + if (RegCheckErr(Buf, RoutineName)) return + ! summary_file_name + call RegPack(Buf, InData%summary_file_name) + if (RegCheckErr(Buf, RoutineName)) return + ! library_input_str + call RegPack(Buf, InData%library_input_str) + if (RegCheckErr(Buf, RoutineName)) return + ! node_input_str + call RegPack(Buf, InData%node_input_str) + if (RegCheckErr(Buf, RoutineName)) return + ! line_input_str + call RegPack(Buf, InData%line_input_str) + if (RegCheckErr(Buf, RoutineName)) return + ! option_input_str + call RegPack(Buf, InData%option_input_str) + if (RegCheckErr(Buf, RoutineName)) return + ! LinInitInp + call MAP_Fortran_PackLin_InitInputType(Buf, InData%LinInitInp) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MAP_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MAP_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MAP_UnPackInitInput' + if (Buf%ErrStat /= ErrID_None) return + ! gravity + call RegUnpack(Buf, OutData%gravity) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%gravity = OutData%gravity + ! sea_density + call RegUnpack(Buf, OutData%sea_density) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%sea_density = OutData%sea_density + ! depth + call RegUnpack(Buf, OutData%depth) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%depth = OutData%depth + ! file_name + call RegUnpack(Buf, OutData%file_name) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%file_name = transfer(OutData%file_name, OutData%C_obj%file_name ) + ! summary_file_name + call RegUnpack(Buf, OutData%summary_file_name) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%summary_file_name = transfer(OutData%summary_file_name, OutData%C_obj%summary_file_name ) + ! library_input_str + call RegUnpack(Buf, OutData%library_input_str) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%library_input_str = transfer(OutData%library_input_str, OutData%C_obj%library_input_str ) + ! node_input_str + call RegUnpack(Buf, OutData%node_input_str) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%node_input_str = transfer(OutData%node_input_str, OutData%C_obj%node_input_str ) + ! line_input_str + call RegUnpack(Buf, OutData%line_input_str) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%line_input_str = transfer(OutData%line_input_str, OutData%C_obj%line_input_str ) + ! option_input_str + call RegUnpack(Buf, OutData%option_input_str) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%option_input_str = transfer(OutData%option_input_str, OutData%C_obj%option_input_str ) + ! LinInitInp + call MAP_Fortran_UnpackLin_InitInputType(Buf, OutData%LinInitInp) ! LinInitInp +end subroutine SUBROUTINE MAP_C2Fary_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) TYPE(MAP_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat @@ -688,386 +516,102 @@ SUBROUTINE MAP_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE MAP_DestroyInitOutput - SUBROUTINE MAP_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MAP_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%progName) ! progName - Int_BufSz = Int_BufSz + 1*LEN(InData%version) ! version - Int_BufSz = Int_BufSz + 1*LEN(InData%compilingData) ! compilingData - Int_BufSz = Int_BufSz + 1 ! writeOutputHdr allocated yes/no - IF ( ALLOCATED(InData%writeOutputHdr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! writeOutputHdr upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%writeOutputHdr)*LEN(InData%writeOutputHdr) ! writeOutputHdr - END IF - Int_BufSz = Int_BufSz + 1 ! writeOutputUnt allocated yes/no - IF ( ALLOCATED(InData%writeOutputUnt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! writeOutputUnt upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%writeOutputUnt)*LEN(InData%writeOutputUnt) ! writeOutputUnt - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! LinInitOut: size of buffers for each call to pack subtype - CALL MAP_Fortran_PackLin_InitOutputType( Re_Buf, Db_Buf, Int_Buf, InData%LinInitOut, ErrStat2, ErrMsg2, .TRUE. ) ! LinInitOut - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! LinInitOut - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! LinInitOut - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! LinInitOut - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%progName) - IntKiBuf(Int_Xferred) = ICHAR(InData%progName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%version) - IntKiBuf(Int_Xferred) = ICHAR(InData%version(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%compilingData) - IntKiBuf(Int_Xferred) = ICHAR(InData%compilingData(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%writeOutputHdr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%writeOutputHdr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%writeOutputHdr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%writeOutputHdr,1), UBOUND(InData%writeOutputHdr,1) - DO I = 1, LEN(InData%writeOutputHdr) - IntKiBuf(Int_Xferred) = ICHAR(InData%writeOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%writeOutputUnt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%writeOutputUnt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%writeOutputUnt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%writeOutputUnt,1), UBOUND(InData%writeOutputUnt,1) - DO I = 1, LEN(InData%writeOutputUnt) - IntKiBuf(Int_Xferred) = ICHAR(InData%writeOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MAP_Fortran_PackLin_InitOutputType( Re_Buf, Db_Buf, Int_Buf, InData%LinInitOut, ErrStat2, ErrMsg2, OnlySize ) ! LinInitOut - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE MAP_PackInitOutput - - SUBROUTINE MAP_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MAP_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%progName) - OutData%progName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%C_obj%progName = TRANSFER(OutData%progName, OutData%C_obj%progName ) - DO I = 1, LEN(OutData%version) - OutData%version(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%C_obj%version = TRANSFER(OutData%version, OutData%C_obj%version ) - DO I = 1, LEN(OutData%compilingData) - OutData%compilingData(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%C_obj%compilingData = TRANSFER(OutData%compilingData, OutData%C_obj%compilingData ) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! writeOutputHdr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%writeOutputHdr)) DEALLOCATE(OutData%writeOutputHdr) - ALLOCATE(OutData%writeOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%writeOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%writeOutputHdr,1), UBOUND(OutData%writeOutputHdr,1) - DO I = 1, LEN(OutData%writeOutputHdr) - OutData%writeOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! writeOutputUnt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%writeOutputUnt)) DEALLOCATE(OutData%writeOutputUnt) - ALLOCATE(OutData%writeOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%writeOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%writeOutputUnt,1), UBOUND(OutData%writeOutputUnt,1) - DO I = 1, LEN(OutData%writeOutputUnt) - OutData%writeOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MAP_Fortran_UnpackLin_InitOutputType( Re_Buf, Db_Buf, Int_Buf, OutData%LinInitOut, ErrStat2, ErrMsg2 ) ! LinInitOut - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE MAP_UnPackInitOutput +subroutine MAP_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MAP_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MAP_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + ! progName + call RegPack(Buf, InData%progName) + if (RegCheckErr(Buf, RoutineName)) return + ! version + call RegPack(Buf, InData%version) + if (RegCheckErr(Buf, RoutineName)) return + ! compilingData + call RegPack(Buf, InData%compilingData) + if (RegCheckErr(Buf, RoutineName)) return + ! writeOutputHdr + call RegPack(Buf, allocated(InData%writeOutputHdr)) + if (allocated(InData%writeOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%writeOutputHdr), ubound(InData%writeOutputHdr)) + call RegPack(Buf, InData%writeOutputHdr) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! writeOutputUnt + call RegPack(Buf, allocated(InData%writeOutputUnt)) + if (allocated(InData%writeOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%writeOutputUnt), ubound(InData%writeOutputUnt)) + call RegPack(Buf, InData%writeOutputUnt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Ver + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + if (RegCheckErr(Buf, RoutineName)) return + ! LinInitOut + call MAP_Fortran_PackLin_InitOutputType(Buf, InData%LinInitOut) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MAP_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MAP_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MAP_UnPackInitOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! progName + call RegUnpack(Buf, OutData%progName) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%progName = transfer(OutData%progName, OutData%C_obj%progName ) + ! version + call RegUnpack(Buf, OutData%version) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%version = transfer(OutData%version, OutData%C_obj%version ) + ! compilingData + call RegUnpack(Buf, OutData%compilingData) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%compilingData = transfer(OutData%compilingData, OutData%C_obj%compilingData ) + ! writeOutputHdr + if (allocated(OutData%writeOutputHdr)) deallocate(OutData%writeOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%writeOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%writeOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%writeOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! writeOutputUnt + if (allocated(OutData%writeOutputUnt)) deallocate(OutData%writeOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%writeOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%writeOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%writeOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Ver + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + ! LinInitOut + call MAP_Fortran_UnpackLin_InitOutputType(Buf, OutData%LinInitOut) ! LinInitOut +end subroutine SUBROUTINE MAP_C2Fary_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) TYPE(MAP_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat @@ -1141,106 +685,31 @@ SUBROUTINE MAP_DestroyContState( ContStateData, ErrStat, ErrMsg ) END SUBROUTINE MAP_DestroyContState - SUBROUTINE MAP_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MAP_ContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_PackContState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! dummy - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%dummy - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE MAP_PackContState - - SUBROUTINE MAP_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MAP_ContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_UnPackContState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%dummy = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%C_obj%dummy = OutData%dummy - END SUBROUTINE MAP_UnPackContState +subroutine MAP_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MAP_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MAP_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + ! dummy + call RegPack(Buf, InData%dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MAP_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MAP_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MAP_UnPackContState' + if (Buf%ErrStat /= ErrID_None) return + ! dummy + call RegUnpack(Buf, OutData%dummy) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%dummy = OutData%dummy +end subroutine SUBROUTINE MAP_C2Fary_CopyContState( ContStateData, ErrStat, ErrMsg, SkipPointers ) TYPE(MAP_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat @@ -1310,106 +779,31 @@ SUBROUTINE MAP_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) END SUBROUTINE MAP_DestroyDiscState - SUBROUTINE MAP_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MAP_DiscreteStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_PackDiscState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! dummy - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%dummy - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE MAP_PackDiscState - - SUBROUTINE MAP_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MAP_DiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_UnPackDiscState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%dummy = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%C_obj%dummy = OutData%dummy - END SUBROUTINE MAP_UnPackDiscState +subroutine MAP_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MAP_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MAP_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + ! dummy + call RegPack(Buf, InData%dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MAP_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MAP_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MAP_UnPackDiscState' + if (Buf%ErrStat /= ErrID_None) return + ! dummy + call RegUnpack(Buf, OutData%dummy) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%dummy = OutData%dummy +end subroutine SUBROUTINE MAP_C2Fary_CopyDiscState( DiscStateData, ErrStat, ErrMsg, SkipPointers ) TYPE(MAP_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat @@ -1814,757 +1208,622 @@ SUBROUTINE MAP_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE MAP_DestroyOtherState - SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MAP_OtherStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_PackOtherState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! H allocated yes/no - IF ( ASSOCIATED(InData%H) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! H upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%H) ! H - END IF - Int_BufSz = Int_BufSz + 1 ! V allocated yes/no - IF ( ASSOCIATED(InData%V) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! V upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%V) ! V - END IF - Int_BufSz = Int_BufSz + 1 ! Ha allocated yes/no - IF ( ASSOCIATED(InData%Ha) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Ha upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Ha) ! Ha - END IF - Int_BufSz = Int_BufSz + 1 ! Va allocated yes/no - IF ( ASSOCIATED(InData%Va) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Va upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Va) ! Va - END IF - Int_BufSz = Int_BufSz + 1 ! x allocated yes/no - IF ( ASSOCIATED(InData%x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%x) ! x - END IF - Int_BufSz = Int_BufSz + 1 ! y allocated yes/no - IF ( ASSOCIATED(InData%y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%y) ! y - END IF - Int_BufSz = Int_BufSz + 1 ! z allocated yes/no - IF ( ASSOCIATED(InData%z) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%z) ! z - END IF - Int_BufSz = Int_BufSz + 1 ! xa allocated yes/no - IF ( ASSOCIATED(InData%xa) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xa upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%xa) ! xa - END IF - Int_BufSz = Int_BufSz + 1 ! ya allocated yes/no - IF ( ASSOCIATED(InData%ya) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ya upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%ya) ! ya - END IF - Int_BufSz = Int_BufSz + 1 ! za allocated yes/no - IF ( ASSOCIATED(InData%za) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! za upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%za) ! za - END IF - Int_BufSz = Int_BufSz + 1 ! Fx_connect allocated yes/no - IF ( ASSOCIATED(InData%Fx_connect) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Fx_connect upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fx_connect) ! Fx_connect - END IF - Int_BufSz = Int_BufSz + 1 ! Fy_connect allocated yes/no - IF ( ASSOCIATED(InData%Fy_connect) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Fy_connect upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fy_connect) ! Fy_connect - END IF - Int_BufSz = Int_BufSz + 1 ! Fz_connect allocated yes/no - IF ( ASSOCIATED(InData%Fz_connect) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Fz_connect upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fz_connect) ! Fz_connect - END IF - Int_BufSz = Int_BufSz + 1 ! Fx_anchor allocated yes/no - IF ( ASSOCIATED(InData%Fx_anchor) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Fx_anchor upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fx_anchor) ! Fx_anchor - END IF - Int_BufSz = Int_BufSz + 1 ! Fy_anchor allocated yes/no - IF ( ASSOCIATED(InData%Fy_anchor) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Fy_anchor upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fy_anchor) ! Fy_anchor - END IF - Int_BufSz = Int_BufSz + 1 ! Fz_anchor allocated yes/no - IF ( ASSOCIATED(InData%Fz_anchor) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Fz_anchor upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fz_anchor) ! Fz_anchor - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ASSOCIATED(InData%H) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%H,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%H,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%H,1), UBOUND(InData%H,1) - DbKiBuf(Db_Xferred) = InData%H(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%V) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%V,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%V,1), UBOUND(InData%V,1) - DbKiBuf(Db_Xferred) = InData%V(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%Ha) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ha,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ha,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Ha,1), UBOUND(InData%Ha,1) - DbKiBuf(Db_Xferred) = InData%Ha(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%Va) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Va,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Va,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Va,1), UBOUND(InData%Va,1) - DbKiBuf(Db_Xferred) = InData%Va(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - DbKiBuf(Db_Xferred) = InData%x(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) - DbKiBuf(Db_Xferred) = InData%y(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%z) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - DbKiBuf(Db_Xferred) = InData%z(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%xa) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xa,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xa,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xa,1), UBOUND(InData%xa,1) - DbKiBuf(Db_Xferred) = InData%xa(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%ya) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ya,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ya,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ya,1), UBOUND(InData%ya,1) - DbKiBuf(Db_Xferred) = InData%ya(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%za) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%za,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%za,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%za,1), UBOUND(InData%za,1) - DbKiBuf(Db_Xferred) = InData%za(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%Fx_connect) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fx_connect,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fx_connect,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Fx_connect,1), UBOUND(InData%Fx_connect,1) - DbKiBuf(Db_Xferred) = InData%Fx_connect(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%Fy_connect) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fy_connect,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fy_connect,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Fy_connect,1), UBOUND(InData%Fy_connect,1) - DbKiBuf(Db_Xferred) = InData%Fy_connect(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%Fz_connect) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fz_connect,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fz_connect,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Fz_connect,1), UBOUND(InData%Fz_connect,1) - DbKiBuf(Db_Xferred) = InData%Fz_connect(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%Fx_anchor) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fx_anchor,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fx_anchor,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Fx_anchor,1), UBOUND(InData%Fx_anchor,1) - DbKiBuf(Db_Xferred) = InData%Fx_anchor(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%Fy_anchor) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fy_anchor,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fy_anchor,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Fy_anchor,1), UBOUND(InData%Fy_anchor,1) - DbKiBuf(Db_Xferred) = InData%Fy_anchor(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%Fz_anchor) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fz_anchor,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fz_anchor,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Fz_anchor,1), UBOUND(InData%Fz_anchor,1) - DbKiBuf(Db_Xferred) = InData%Fz_anchor(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE MAP_PackOtherState - - SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MAP_OtherStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_UnPackOtherState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! H not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%H)) DEALLOCATE(OutData%H) - ALLOCATE(OutData%H(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%H.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%H_Len = SIZE(OutData%H) - IF (OutData%C_obj%H_Len > 0) & - OutData%C_obj%H = C_LOC( OutData%H( i1_l ) ) - DO i1 = LBOUND(OutData%H,1), UBOUND(OutData%H,1) - OutData%H(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! V not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%V)) DEALLOCATE(OutData%V) - ALLOCATE(OutData%V(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%V.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%V_Len = SIZE(OutData%V) - IF (OutData%C_obj%V_Len > 0) & - OutData%C_obj%V = C_LOC( OutData%V( i1_l ) ) - DO i1 = LBOUND(OutData%V,1), UBOUND(OutData%V,1) - OutData%V(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ha not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%Ha)) DEALLOCATE(OutData%Ha) - ALLOCATE(OutData%Ha(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ha.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%Ha_Len = SIZE(OutData%Ha) - IF (OutData%C_obj%Ha_Len > 0) & - OutData%C_obj%Ha = C_LOC( OutData%Ha( i1_l ) ) - DO i1 = LBOUND(OutData%Ha,1), UBOUND(OutData%Ha,1) - OutData%Ha(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Va not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%Va)) DEALLOCATE(OutData%Va) - ALLOCATE(OutData%Va(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Va.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%Va_Len = SIZE(OutData%Va) - IF (OutData%C_obj%Va_Len > 0) & - OutData%C_obj%Va = C_LOC( OutData%Va( i1_l ) ) - DO i1 = LBOUND(OutData%Va,1), UBOUND(OutData%Va,1) - OutData%Va(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%x)) DEALLOCATE(OutData%x) - ALLOCATE(OutData%x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%x_Len = SIZE(OutData%x) - IF (OutData%C_obj%x_Len > 0) & - OutData%C_obj%x = C_LOC( OutData%x( i1_l ) ) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) - OutData%x(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%y)) DEALLOCATE(OutData%y) - ALLOCATE(OutData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%y_Len = SIZE(OutData%y) - IF (OutData%C_obj%y_Len > 0) & - OutData%C_obj%y = C_LOC( OutData%y( i1_l ) ) - DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) - OutData%y(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%z)) DEALLOCATE(OutData%z) - ALLOCATE(OutData%z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%z_Len = SIZE(OutData%z) - IF (OutData%C_obj%z_Len > 0) & - OutData%C_obj%z = C_LOC( OutData%z( i1_l ) ) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) - OutData%z(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xa not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%xa)) DEALLOCATE(OutData%xa) - ALLOCATE(OutData%xa(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xa.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%xa_Len = SIZE(OutData%xa) - IF (OutData%C_obj%xa_Len > 0) & - OutData%C_obj%xa = C_LOC( OutData%xa( i1_l ) ) - DO i1 = LBOUND(OutData%xa,1), UBOUND(OutData%xa,1) - OutData%xa(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ya not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%ya)) DEALLOCATE(OutData%ya) - ALLOCATE(OutData%ya(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ya.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%ya_Len = SIZE(OutData%ya) - IF (OutData%C_obj%ya_Len > 0) & - OutData%C_obj%ya = C_LOC( OutData%ya( i1_l ) ) - DO i1 = LBOUND(OutData%ya,1), UBOUND(OutData%ya,1) - OutData%ya(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! za not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%za)) DEALLOCATE(OutData%za) - ALLOCATE(OutData%za(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%za.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%za_Len = SIZE(OutData%za) - IF (OutData%C_obj%za_Len > 0) & - OutData%C_obj%za = C_LOC( OutData%za( i1_l ) ) - DO i1 = LBOUND(OutData%za,1), UBOUND(OutData%za,1) - OutData%za(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fx_connect not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%Fx_connect)) DEALLOCATE(OutData%Fx_connect) - ALLOCATE(OutData%Fx_connect(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fx_connect.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%Fx_connect_Len = SIZE(OutData%Fx_connect) - IF (OutData%C_obj%Fx_connect_Len > 0) & - OutData%C_obj%Fx_connect = C_LOC( OutData%Fx_connect( i1_l ) ) - DO i1 = LBOUND(OutData%Fx_connect,1), UBOUND(OutData%Fx_connect,1) - OutData%Fx_connect(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fy_connect not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%Fy_connect)) DEALLOCATE(OutData%Fy_connect) - ALLOCATE(OutData%Fy_connect(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fy_connect.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%Fy_connect_Len = SIZE(OutData%Fy_connect) - IF (OutData%C_obj%Fy_connect_Len > 0) & - OutData%C_obj%Fy_connect = C_LOC( OutData%Fy_connect( i1_l ) ) - DO i1 = LBOUND(OutData%Fy_connect,1), UBOUND(OutData%Fy_connect,1) - OutData%Fy_connect(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fz_connect not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%Fz_connect)) DEALLOCATE(OutData%Fz_connect) - ALLOCATE(OutData%Fz_connect(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fz_connect.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%Fz_connect_Len = SIZE(OutData%Fz_connect) - IF (OutData%C_obj%Fz_connect_Len > 0) & - OutData%C_obj%Fz_connect = C_LOC( OutData%Fz_connect( i1_l ) ) - DO i1 = LBOUND(OutData%Fz_connect,1), UBOUND(OutData%Fz_connect,1) - OutData%Fz_connect(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fx_anchor not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%Fx_anchor)) DEALLOCATE(OutData%Fx_anchor) - ALLOCATE(OutData%Fx_anchor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fx_anchor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%Fx_anchor_Len = SIZE(OutData%Fx_anchor) - IF (OutData%C_obj%Fx_anchor_Len > 0) & - OutData%C_obj%Fx_anchor = C_LOC( OutData%Fx_anchor( i1_l ) ) - DO i1 = LBOUND(OutData%Fx_anchor,1), UBOUND(OutData%Fx_anchor,1) - OutData%Fx_anchor(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fy_anchor not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%Fy_anchor)) DEALLOCATE(OutData%Fy_anchor) - ALLOCATE(OutData%Fy_anchor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fy_anchor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%Fy_anchor_Len = SIZE(OutData%Fy_anchor) - IF (OutData%C_obj%Fy_anchor_Len > 0) & - OutData%C_obj%Fy_anchor = C_LOC( OutData%Fy_anchor( i1_l ) ) - DO i1 = LBOUND(OutData%Fy_anchor,1), UBOUND(OutData%Fy_anchor,1) - OutData%Fy_anchor(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fz_anchor not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%Fz_anchor)) DEALLOCATE(OutData%Fz_anchor) - ALLOCATE(OutData%Fz_anchor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fz_anchor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%Fz_anchor_Len = SIZE(OutData%Fz_anchor) - IF (OutData%C_obj%Fz_anchor_Len > 0) & - OutData%C_obj%Fz_anchor = C_LOC( OutData%Fz_anchor( i1_l ) ) - DO i1 = LBOUND(OutData%Fz_anchor,1), UBOUND(OutData%Fz_anchor,1) - OutData%Fz_anchor(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE MAP_UnPackOtherState +subroutine MAP_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MAP_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MAP_PackOtherState' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + ! H + call RegPack(Buf, associated(InData%H)) + if (associated(InData%H)) then + call RegPackBounds(Buf, 1, lbound(InData%H), ubound(InData%H)) + call RegPackPointer(Buf, c_loc(InData%H), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%H) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! V + call RegPack(Buf, associated(InData%V)) + if (associated(InData%V)) then + call RegPackBounds(Buf, 1, lbound(InData%V), ubound(InData%V)) + call RegPackPointer(Buf, c_loc(InData%V), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%V) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Ha + call RegPack(Buf, associated(InData%Ha)) + if (associated(InData%Ha)) then + call RegPackBounds(Buf, 1, lbound(InData%Ha), ubound(InData%Ha)) + call RegPackPointer(Buf, c_loc(InData%Ha), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%Ha) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Va + call RegPack(Buf, associated(InData%Va)) + if (associated(InData%Va)) then + call RegPackBounds(Buf, 1, lbound(InData%Va), ubound(InData%Va)) + call RegPackPointer(Buf, c_loc(InData%Va), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%Va) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! x + call RegPack(Buf, associated(InData%x)) + if (associated(InData%x)) then + call RegPackBounds(Buf, 1, lbound(InData%x), ubound(InData%x)) + call RegPackPointer(Buf, c_loc(InData%x), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%x) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! y + call RegPack(Buf, associated(InData%y)) + if (associated(InData%y)) then + call RegPackBounds(Buf, 1, lbound(InData%y), ubound(InData%y)) + call RegPackPointer(Buf, c_loc(InData%y), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%y) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! z + call RegPack(Buf, associated(InData%z)) + if (associated(InData%z)) then + call RegPackBounds(Buf, 1, lbound(InData%z), ubound(InData%z)) + call RegPackPointer(Buf, c_loc(InData%z), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%z) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! xa + call RegPack(Buf, associated(InData%xa)) + if (associated(InData%xa)) then + call RegPackBounds(Buf, 1, lbound(InData%xa), ubound(InData%xa)) + call RegPackPointer(Buf, c_loc(InData%xa), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%xa) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ya + call RegPack(Buf, associated(InData%ya)) + if (associated(InData%ya)) then + call RegPackBounds(Buf, 1, lbound(InData%ya), ubound(InData%ya)) + call RegPackPointer(Buf, c_loc(InData%ya), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%ya) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! za + call RegPack(Buf, associated(InData%za)) + if (associated(InData%za)) then + call RegPackBounds(Buf, 1, lbound(InData%za), ubound(InData%za)) + call RegPackPointer(Buf, c_loc(InData%za), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%za) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Fx_connect + call RegPack(Buf, associated(InData%Fx_connect)) + if (associated(InData%Fx_connect)) then + call RegPackBounds(Buf, 1, lbound(InData%Fx_connect), ubound(InData%Fx_connect)) + call RegPackPointer(Buf, c_loc(InData%Fx_connect), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%Fx_connect) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Fy_connect + call RegPack(Buf, associated(InData%Fy_connect)) + if (associated(InData%Fy_connect)) then + call RegPackBounds(Buf, 1, lbound(InData%Fy_connect), ubound(InData%Fy_connect)) + call RegPackPointer(Buf, c_loc(InData%Fy_connect), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%Fy_connect) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Fz_connect + call RegPack(Buf, associated(InData%Fz_connect)) + if (associated(InData%Fz_connect)) then + call RegPackBounds(Buf, 1, lbound(InData%Fz_connect), ubound(InData%Fz_connect)) + call RegPackPointer(Buf, c_loc(InData%Fz_connect), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%Fz_connect) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Fx_anchor + call RegPack(Buf, associated(InData%Fx_anchor)) + if (associated(InData%Fx_anchor)) then + call RegPackBounds(Buf, 1, lbound(InData%Fx_anchor), ubound(InData%Fx_anchor)) + call RegPackPointer(Buf, c_loc(InData%Fx_anchor), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%Fx_anchor) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Fy_anchor + call RegPack(Buf, associated(InData%Fy_anchor)) + if (associated(InData%Fy_anchor)) then + call RegPackBounds(Buf, 1, lbound(InData%Fy_anchor), ubound(InData%Fy_anchor)) + call RegPackPointer(Buf, c_loc(InData%Fy_anchor), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%Fy_anchor) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Fz_anchor + call RegPack(Buf, associated(InData%Fz_anchor)) + if (associated(InData%Fz_anchor)) then + call RegPackBounds(Buf, 1, lbound(InData%Fz_anchor), ubound(InData%Fz_anchor)) + call RegPackPointer(Buf, c_loc(InData%Fz_anchor), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%Fz_anchor) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MAP_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MAP_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MAP_UnPackOtherState' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + ! H + if (associated(OutData%H)) deallocate(OutData%H) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%H, UB(1:1)-LB(1:1)) + OutData%H(LB(1):) => OutData%H + else + allocate(OutData%H(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%H.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%H) + OutData%C_obj%H_Len = size(OutData%H) + if (OutData%C_obj%H_Len > 0) OutData%C_obj%H = c_loc(OutData%H(LB(1))) + call RegUnpack(Buf, OutData%H) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%H => null() + end if + ! V + if (associated(OutData%V)) deallocate(OutData%V) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%V, UB(1:1)-LB(1:1)) + OutData%V(LB(1):) => OutData%V + else + allocate(OutData%V(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%V.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%V) + OutData%C_obj%V_Len = size(OutData%V) + if (OutData%C_obj%V_Len > 0) OutData%C_obj%V = c_loc(OutData%V(LB(1))) + call RegUnpack(Buf, OutData%V) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%V => null() + end if + ! Ha + if (associated(OutData%Ha)) deallocate(OutData%Ha) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Ha, UB(1:1)-LB(1:1)) + OutData%Ha(LB(1):) => OutData%Ha + else + allocate(OutData%Ha(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ha.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Ha) + OutData%C_obj%Ha_Len = size(OutData%Ha) + if (OutData%C_obj%Ha_Len > 0) OutData%C_obj%Ha = c_loc(OutData%Ha(LB(1))) + call RegUnpack(Buf, OutData%Ha) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%Ha => null() + end if + ! Va + if (associated(OutData%Va)) deallocate(OutData%Va) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Va, UB(1:1)-LB(1:1)) + OutData%Va(LB(1):) => OutData%Va + else + allocate(OutData%Va(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Va.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Va) + OutData%C_obj%Va_Len = size(OutData%Va) + if (OutData%C_obj%Va_Len > 0) OutData%C_obj%Va = c_loc(OutData%Va(LB(1))) + call RegUnpack(Buf, OutData%Va) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%Va => null() + end if + ! x + if (associated(OutData%x)) deallocate(OutData%x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%x, UB(1:1)-LB(1:1)) + OutData%x(LB(1):) => OutData%x + else + allocate(OutData%x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%x) + OutData%C_obj%x_Len = size(OutData%x) + if (OutData%C_obj%x_Len > 0) OutData%C_obj%x = c_loc(OutData%x(LB(1))) + call RegUnpack(Buf, OutData%x) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%x => null() + end if + ! y + if (associated(OutData%y)) deallocate(OutData%y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%y, UB(1:1)-LB(1:1)) + OutData%y(LB(1):) => OutData%y + else + allocate(OutData%y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%y) + OutData%C_obj%y_Len = size(OutData%y) + if (OutData%C_obj%y_Len > 0) OutData%C_obj%y = c_loc(OutData%y(LB(1))) + call RegUnpack(Buf, OutData%y) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%y => null() + end if + ! z + if (associated(OutData%z)) deallocate(OutData%z) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%z, UB(1:1)-LB(1:1)) + OutData%z(LB(1):) => OutData%z + else + allocate(OutData%z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%z) + OutData%C_obj%z_Len = size(OutData%z) + if (OutData%C_obj%z_Len > 0) OutData%C_obj%z = c_loc(OutData%z(LB(1))) + call RegUnpack(Buf, OutData%z) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%z => null() + end if + ! xa + if (associated(OutData%xa)) deallocate(OutData%xa) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%xa, UB(1:1)-LB(1:1)) + OutData%xa(LB(1):) => OutData%xa + else + allocate(OutData%xa(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xa.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%xa) + OutData%C_obj%xa_Len = size(OutData%xa) + if (OutData%C_obj%xa_Len > 0) OutData%C_obj%xa = c_loc(OutData%xa(LB(1))) + call RegUnpack(Buf, OutData%xa) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%xa => null() + end if + ! ya + if (associated(OutData%ya)) deallocate(OutData%ya) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%ya, UB(1:1)-LB(1:1)) + OutData%ya(LB(1):) => OutData%ya + else + allocate(OutData%ya(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ya.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%ya) + OutData%C_obj%ya_Len = size(OutData%ya) + if (OutData%C_obj%ya_Len > 0) OutData%C_obj%ya = c_loc(OutData%ya(LB(1))) + call RegUnpack(Buf, OutData%ya) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%ya => null() + end if + ! za + if (associated(OutData%za)) deallocate(OutData%za) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%za, UB(1:1)-LB(1:1)) + OutData%za(LB(1):) => OutData%za + else + allocate(OutData%za(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%za.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%za) + OutData%C_obj%za_Len = size(OutData%za) + if (OutData%C_obj%za_Len > 0) OutData%C_obj%za = c_loc(OutData%za(LB(1))) + call RegUnpack(Buf, OutData%za) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%za => null() + end if + ! Fx_connect + if (associated(OutData%Fx_connect)) deallocate(OutData%Fx_connect) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Fx_connect, UB(1:1)-LB(1:1)) + OutData%Fx_connect(LB(1):) => OutData%Fx_connect + else + allocate(OutData%Fx_connect(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fx_connect.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Fx_connect) + OutData%C_obj%Fx_connect_Len = size(OutData%Fx_connect) + if (OutData%C_obj%Fx_connect_Len > 0) OutData%C_obj%Fx_connect = c_loc(OutData%Fx_connect(LB(1))) + call RegUnpack(Buf, OutData%Fx_connect) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%Fx_connect => null() + end if + ! Fy_connect + if (associated(OutData%Fy_connect)) deallocate(OutData%Fy_connect) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Fy_connect, UB(1:1)-LB(1:1)) + OutData%Fy_connect(LB(1):) => OutData%Fy_connect + else + allocate(OutData%Fy_connect(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fy_connect.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Fy_connect) + OutData%C_obj%Fy_connect_Len = size(OutData%Fy_connect) + if (OutData%C_obj%Fy_connect_Len > 0) OutData%C_obj%Fy_connect = c_loc(OutData%Fy_connect(LB(1))) + call RegUnpack(Buf, OutData%Fy_connect) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%Fy_connect => null() + end if + ! Fz_connect + if (associated(OutData%Fz_connect)) deallocate(OutData%Fz_connect) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Fz_connect, UB(1:1)-LB(1:1)) + OutData%Fz_connect(LB(1):) => OutData%Fz_connect + else + allocate(OutData%Fz_connect(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fz_connect.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Fz_connect) + OutData%C_obj%Fz_connect_Len = size(OutData%Fz_connect) + if (OutData%C_obj%Fz_connect_Len > 0) OutData%C_obj%Fz_connect = c_loc(OutData%Fz_connect(LB(1))) + call RegUnpack(Buf, OutData%Fz_connect) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%Fz_connect => null() + end if + ! Fx_anchor + if (associated(OutData%Fx_anchor)) deallocate(OutData%Fx_anchor) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Fx_anchor, UB(1:1)-LB(1:1)) + OutData%Fx_anchor(LB(1):) => OutData%Fx_anchor + else + allocate(OutData%Fx_anchor(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fx_anchor.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Fx_anchor) + OutData%C_obj%Fx_anchor_Len = size(OutData%Fx_anchor) + if (OutData%C_obj%Fx_anchor_Len > 0) OutData%C_obj%Fx_anchor = c_loc(OutData%Fx_anchor(LB(1))) + call RegUnpack(Buf, OutData%Fx_anchor) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%Fx_anchor => null() + end if + ! Fy_anchor + if (associated(OutData%Fy_anchor)) deallocate(OutData%Fy_anchor) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Fy_anchor, UB(1:1)-LB(1:1)) + OutData%Fy_anchor(LB(1):) => OutData%Fy_anchor + else + allocate(OutData%Fy_anchor(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fy_anchor.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Fy_anchor) + OutData%C_obj%Fy_anchor_Len = size(OutData%Fy_anchor) + if (OutData%C_obj%Fy_anchor_Len > 0) OutData%C_obj%Fy_anchor = c_loc(OutData%Fy_anchor(LB(1))) + call RegUnpack(Buf, OutData%Fy_anchor) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%Fy_anchor => null() + end if + ! Fz_anchor + if (associated(OutData%Fz_anchor)) deallocate(OutData%Fz_anchor) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Fz_anchor, UB(1:1)-LB(1:1)) + OutData%Fz_anchor(LB(1):) => OutData%Fz_anchor + else + allocate(OutData%Fz_anchor(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fz_anchor.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Fz_anchor) + OutData%C_obj%Fz_anchor_Len = size(OutData%Fz_anchor) + if (OutData%C_obj%Fz_anchor_Len > 0) OutData%C_obj%Fz_anchor = c_loc(OutData%Fz_anchor(LB(1))) + call RegUnpack(Buf, OutData%Fz_anchor) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%Fz_anchor => null() + end if +end subroutine SUBROUTINE MAP_C2Fary_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ) TYPE(MAP_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat @@ -3072,306 +2331,215 @@ SUBROUTINE MAP_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE MAP_DestroyConstrState - SUBROUTINE MAP_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MAP_ConstraintStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_PackConstrState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! H allocated yes/no - IF ( ASSOCIATED(InData%H) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! H upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%H) ! H - END IF - Int_BufSz = Int_BufSz + 1 ! V allocated yes/no - IF ( ASSOCIATED(InData%V) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! V upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%V) ! V - END IF - Int_BufSz = Int_BufSz + 1 ! x allocated yes/no - IF ( ASSOCIATED(InData%x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%x) ! x - END IF - Int_BufSz = Int_BufSz + 1 ! y allocated yes/no - IF ( ASSOCIATED(InData%y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%y) ! y - END IF - Int_BufSz = Int_BufSz + 1 ! z allocated yes/no - IF ( ASSOCIATED(InData%z) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%z) ! z - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ASSOCIATED(InData%H) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%H,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%H,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%H,1), UBOUND(InData%H,1) - DbKiBuf(Db_Xferred) = InData%H(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%V) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%V,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%V,1), UBOUND(InData%V,1) - DbKiBuf(Db_Xferred) = InData%V(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - DbKiBuf(Db_Xferred) = InData%x(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) - DbKiBuf(Db_Xferred) = InData%y(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%z) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - DbKiBuf(Db_Xferred) = InData%z(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE MAP_PackConstrState - - SUBROUTINE MAP_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MAP_ConstraintStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_UnPackConstrState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! H not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%H)) DEALLOCATE(OutData%H) - ALLOCATE(OutData%H(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%H.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%H_Len = SIZE(OutData%H) - IF (OutData%C_obj%H_Len > 0) & - OutData%C_obj%H = C_LOC( OutData%H( i1_l ) ) - DO i1 = LBOUND(OutData%H,1), UBOUND(OutData%H,1) - OutData%H(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! V not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%V)) DEALLOCATE(OutData%V) - ALLOCATE(OutData%V(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%V.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%V_Len = SIZE(OutData%V) - IF (OutData%C_obj%V_Len > 0) & - OutData%C_obj%V = C_LOC( OutData%V( i1_l ) ) - DO i1 = LBOUND(OutData%V,1), UBOUND(OutData%V,1) - OutData%V(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%x)) DEALLOCATE(OutData%x) - ALLOCATE(OutData%x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%x_Len = SIZE(OutData%x) - IF (OutData%C_obj%x_Len > 0) & - OutData%C_obj%x = C_LOC( OutData%x( i1_l ) ) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) - OutData%x(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%y)) DEALLOCATE(OutData%y) - ALLOCATE(OutData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%y_Len = SIZE(OutData%y) - IF (OutData%C_obj%y_Len > 0) & - OutData%C_obj%y = C_LOC( OutData%y( i1_l ) ) - DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) - OutData%y(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%z)) DEALLOCATE(OutData%z) - ALLOCATE(OutData%z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%z_Len = SIZE(OutData%z) - IF (OutData%C_obj%z_Len > 0) & - OutData%C_obj%z = C_LOC( OutData%z( i1_l ) ) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) - OutData%z(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE MAP_UnPackConstrState +subroutine MAP_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MAP_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MAP_PackConstrState' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + ! H + call RegPack(Buf, associated(InData%H)) + if (associated(InData%H)) then + call RegPackBounds(Buf, 1, lbound(InData%H), ubound(InData%H)) + call RegPackPointer(Buf, c_loc(InData%H), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%H) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! V + call RegPack(Buf, associated(InData%V)) + if (associated(InData%V)) then + call RegPackBounds(Buf, 1, lbound(InData%V), ubound(InData%V)) + call RegPackPointer(Buf, c_loc(InData%V), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%V) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! x + call RegPack(Buf, associated(InData%x)) + if (associated(InData%x)) then + call RegPackBounds(Buf, 1, lbound(InData%x), ubound(InData%x)) + call RegPackPointer(Buf, c_loc(InData%x), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%x) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! y + call RegPack(Buf, associated(InData%y)) + if (associated(InData%y)) then + call RegPackBounds(Buf, 1, lbound(InData%y), ubound(InData%y)) + call RegPackPointer(Buf, c_loc(InData%y), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%y) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! z + call RegPack(Buf, associated(InData%z)) + if (associated(InData%z)) then + call RegPackBounds(Buf, 1, lbound(InData%z), ubound(InData%z)) + call RegPackPointer(Buf, c_loc(InData%z), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%z) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MAP_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MAP_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MAP_UnPackConstrState' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + ! H + if (associated(OutData%H)) deallocate(OutData%H) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%H, UB(1:1)-LB(1:1)) + OutData%H(LB(1):) => OutData%H + else + allocate(OutData%H(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%H.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%H) + OutData%C_obj%H_Len = size(OutData%H) + if (OutData%C_obj%H_Len > 0) OutData%C_obj%H = c_loc(OutData%H(LB(1))) + call RegUnpack(Buf, OutData%H) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%H => null() + end if + ! V + if (associated(OutData%V)) deallocate(OutData%V) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%V, UB(1:1)-LB(1:1)) + OutData%V(LB(1):) => OutData%V + else + allocate(OutData%V(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%V.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%V) + OutData%C_obj%V_Len = size(OutData%V) + if (OutData%C_obj%V_Len > 0) OutData%C_obj%V = c_loc(OutData%V(LB(1))) + call RegUnpack(Buf, OutData%V) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%V => null() + end if + ! x + if (associated(OutData%x)) deallocate(OutData%x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%x, UB(1:1)-LB(1:1)) + OutData%x(LB(1):) => OutData%x + else + allocate(OutData%x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%x) + OutData%C_obj%x_Len = size(OutData%x) + if (OutData%C_obj%x_Len > 0) OutData%C_obj%x = c_loc(OutData%x(LB(1))) + call RegUnpack(Buf, OutData%x) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%x => null() + end if + ! y + if (associated(OutData%y)) deallocate(OutData%y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%y, UB(1:1)-LB(1:1)) + OutData%y(LB(1):) => OutData%y + else + allocate(OutData%y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%y) + OutData%C_obj%y_Len = size(OutData%y) + if (OutData%C_obj%y_Len > 0) OutData%C_obj%y = c_loc(OutData%y(LB(1))) + call RegUnpack(Buf, OutData%y) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%y => null() + end if + ! z + if (associated(OutData%z)) deallocate(OutData%z) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%z, UB(1:1)-LB(1:1)) + OutData%z(LB(1):) => OutData%z + else + allocate(OutData%z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%z) + OutData%C_obj%z_Len = size(OutData%z) + if (OutData%C_obj%z_Len > 0) OutData%C_obj%z = c_loc(OutData%z(LB(1))) + call RegUnpack(Buf, OutData%z) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%z => null() + end if +end subroutine SUBROUTINE MAP_C2Fary_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointers ) TYPE(MAP_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat @@ -3560,247 +2728,76 @@ SUBROUTINE MAP_DestroyParam( ParamData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE MAP_DestroyParam - SUBROUTINE MAP_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MAP_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! g - Db_BufSz = Db_BufSz + 1 ! depth - Db_BufSz = Db_BufSz + 1 ! rho_sea - Db_BufSz = Db_BufSz + 1 ! dt - Int_BufSz = Int_BufSz + SIZE(InData%InputLines)*LEN(InData%InputLines) ! InputLines - Int_BufSz = Int_BufSz + SIZE(InData%InputLineType)*LEN(InData%InputLineType) ! InputLineType - Int_BufSz = Int_BufSz + 1 ! numOuts - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! LinParams: size of buffers for each call to pack subtype - CALL MAP_Fortran_PackLin_ParamType( Re_Buf, Db_Buf, Int_Buf, InData%LinParams, ErrStat2, ErrMsg2, .TRUE. ) ! LinParams - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! LinParams - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! LinParams - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! LinParams - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%g - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%depth - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%rho_sea - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%dt - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%InputLines,1), UBOUND(InData%InputLines,1) - DO I = 1, LEN(InData%InputLines) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputLines(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - DO i1 = LBOUND(InData%InputLineType,1), UBOUND(InData%InputLineType,1) - DO I = 1, LEN(InData%InputLineType) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputLineType(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - IntKiBuf(Int_Xferred) = InData%numOuts - Int_Xferred = Int_Xferred + 1 - CALL MAP_Fortran_PackLin_ParamType( Re_Buf, Db_Buf, Int_Buf, InData%LinParams, ErrStat2, ErrMsg2, OnlySize ) ! LinParams - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE MAP_PackParam - - SUBROUTINE MAP_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MAP_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%g = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%C_obj%g = OutData%g - OutData%depth = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%C_obj%depth = OutData%depth - OutData%rho_sea = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%C_obj%rho_sea = OutData%rho_sea - OutData%dt = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%C_obj%dt = OutData%dt - i1_l = LBOUND(OutData%InputLines,1) - i1_u = UBOUND(OutData%InputLines,1) - DO i1 = LBOUND(OutData%InputLines,1), UBOUND(OutData%InputLines,1) - DO I = 1, LEN(OutData%InputLines) - OutData%InputLines(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - i1_l = LBOUND(OutData%InputLineType,1) - i1_u = UBOUND(OutData%InputLineType,1) - DO i1 = LBOUND(OutData%InputLineType,1), UBOUND(OutData%InputLineType,1) - DO I = 1, LEN(OutData%InputLineType) - OutData%InputLineType(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - OutData%numOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%numOuts = OutData%numOuts - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MAP_Fortran_UnpackLin_ParamType( Re_Buf, Db_Buf, Int_Buf, OutData%LinParams, ErrStat2, ErrMsg2 ) ! LinParams - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE MAP_UnPackParam +subroutine MAP_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MAP_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MAP_PackParam' + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + ! g + call RegPack(Buf, InData%g) + if (RegCheckErr(Buf, RoutineName)) return + ! depth + call RegPack(Buf, InData%depth) + if (RegCheckErr(Buf, RoutineName)) return + ! rho_sea + call RegPack(Buf, InData%rho_sea) + if (RegCheckErr(Buf, RoutineName)) return + ! dt + call RegPack(Buf, InData%dt) + if (RegCheckErr(Buf, RoutineName)) return + ! InputLines + call RegPack(Buf, InData%InputLines) + if (RegCheckErr(Buf, RoutineName)) return + ! InputLineType + call RegPack(Buf, InData%InputLineType) + if (RegCheckErr(Buf, RoutineName)) return + ! numOuts + call RegPack(Buf, InData%numOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! LinParams + call MAP_Fortran_PackLin_ParamType(Buf, InData%LinParams) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MAP_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MAP_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MAP_UnPackParam' + if (Buf%ErrStat /= ErrID_None) return + ! g + call RegUnpack(Buf, OutData%g) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%g = OutData%g + ! depth + call RegUnpack(Buf, OutData%depth) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%depth = OutData%depth + ! rho_sea + call RegUnpack(Buf, OutData%rho_sea) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%rho_sea = OutData%rho_sea + ! dt + call RegUnpack(Buf, OutData%dt) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%dt = OutData%dt + ! InputLines + call RegUnpack(Buf, OutData%InputLines) + if (RegCheckErr(Buf, RoutineName)) return + ! InputLineType + call RegUnpack(Buf, OutData%InputLineType) + if (RegCheckErr(Buf, RoutineName)) return + ! numOuts + call RegUnpack(Buf, OutData%numOuts) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%numOuts = OutData%numOuts + ! LinParams + call MAP_Fortran_UnpackLin_ParamType(Buf, OutData%LinParams) ! LinParams +end subroutine SUBROUTINE MAP_C2Fary_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) TYPE(MAP_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat @@ -3945,310 +2942,146 @@ SUBROUTINE MAP_DestroyInput( InputData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE MAP_DestroyInput - SUBROUTINE MAP_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MAP_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! x allocated yes/no - IF ( ASSOCIATED(InData%x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%x) ! x - END IF - Int_BufSz = Int_BufSz + 1 ! y allocated yes/no - IF ( ASSOCIATED(InData%y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%y) ! y - END IF - Int_BufSz = Int_BufSz + 1 ! z allocated yes/no - IF ( ASSOCIATED(InData%z) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%z) ! z - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! PtFairDisplacement: size of buffers for each call to pack subtype - CALL MeshPack( InData%PtFairDisplacement, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PtFairDisplacement - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PtFairDisplacement - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PtFairDisplacement - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PtFairDisplacement - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ASSOCIATED(InData%x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - DbKiBuf(Db_Xferred) = InData%x(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) - DbKiBuf(Db_Xferred) = InData%y(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%z) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - DbKiBuf(Db_Xferred) = InData%z(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - CALL MeshPack( InData%PtFairDisplacement, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PtFairDisplacement - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE MAP_PackInput - - SUBROUTINE MAP_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MAP_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%x)) DEALLOCATE(OutData%x) - ALLOCATE(OutData%x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%x_Len = SIZE(OutData%x) - IF (OutData%C_obj%x_Len > 0) & - OutData%C_obj%x = C_LOC( OutData%x( i1_l ) ) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) - OutData%x(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%y)) DEALLOCATE(OutData%y) - ALLOCATE(OutData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%y_Len = SIZE(OutData%y) - IF (OutData%C_obj%y_Len > 0) & - OutData%C_obj%y = C_LOC( OutData%y( i1_l ) ) - DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) - OutData%y(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%z)) DEALLOCATE(OutData%z) - ALLOCATE(OutData%z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%z_Len = SIZE(OutData%z) - IF (OutData%C_obj%z_Len > 0) & - OutData%C_obj%z = C_LOC( OutData%z( i1_l ) ) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) - OutData%z(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, 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%PtFairDisplacement, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PtFairDisplacement - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE MAP_UnPackInput +subroutine MAP_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MAP_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MAP_PackInput' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + ! x + call RegPack(Buf, associated(InData%x)) + if (associated(InData%x)) then + call RegPackBounds(Buf, 1, lbound(InData%x), ubound(InData%x)) + call RegPackPointer(Buf, c_loc(InData%x), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%x) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! y + call RegPack(Buf, associated(InData%y)) + if (associated(InData%y)) then + call RegPackBounds(Buf, 1, lbound(InData%y), ubound(InData%y)) + call RegPackPointer(Buf, c_loc(InData%y), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%y) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! z + call RegPack(Buf, associated(InData%z)) + if (associated(InData%z)) then + call RegPackBounds(Buf, 1, lbound(InData%z), ubound(InData%z)) + call RegPackPointer(Buf, c_loc(InData%z), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%z) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PtFairDisplacement + call MeshPack(Buf, InData%PtFairDisplacement) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MAP_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MAP_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MAP_UnPackInput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + ! x + if (associated(OutData%x)) deallocate(OutData%x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%x, UB(1:1)-LB(1:1)) + OutData%x(LB(1):) => OutData%x + else + allocate(OutData%x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%x) + OutData%C_obj%x_Len = size(OutData%x) + if (OutData%C_obj%x_Len > 0) OutData%C_obj%x = c_loc(OutData%x(LB(1))) + call RegUnpack(Buf, OutData%x) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%x => null() + end if + ! y + if (associated(OutData%y)) deallocate(OutData%y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%y, UB(1:1)-LB(1:1)) + OutData%y(LB(1):) => OutData%y + else + allocate(OutData%y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%y) + OutData%C_obj%y_Len = size(OutData%y) + if (OutData%C_obj%y_Len > 0) OutData%C_obj%y = c_loc(OutData%y(LB(1))) + call RegUnpack(Buf, OutData%y) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%y => null() + end if + ! z + if (associated(OutData%z)) deallocate(OutData%z) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%z, UB(1:1)-LB(1:1)) + OutData%z(LB(1):) => OutData%z + else + allocate(OutData%z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%z) + OutData%C_obj%z_Len = size(OutData%z) + if (OutData%C_obj%z_Len > 0) OutData%C_obj%z = c_loc(OutData%z(LB(1))) + call RegUnpack(Buf, OutData%z) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%z => null() + end if + ! PtFairDisplacement + call MeshUnpack(Buf, OutData%PtFairDisplacement) ! PtFairDisplacement +end subroutine SUBROUTINE MAP_C2Fary_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) TYPE(MAP_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat @@ -4482,389 +3315,205 @@ SUBROUTINE MAP_DestroyOutput( OutputData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE MAP_DestroyOutput - SUBROUTINE MAP_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MAP_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! Fx allocated yes/no - IF ( ASSOCIATED(InData%Fx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Fx upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fx) ! Fx - END IF - Int_BufSz = Int_BufSz + 1 ! Fy allocated yes/no - IF ( ASSOCIATED(InData%Fy) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Fy upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fy) ! Fy - END IF - Int_BufSz = Int_BufSz + 1 ! Fz allocated yes/no - IF ( ASSOCIATED(InData%Fz) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Fz upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fz) ! Fz - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutput allocated yes/no - IF ( ALLOCATED(InData%WriteOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutput upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WriteOutput) ! WriteOutput - END IF - Int_BufSz = Int_BufSz + 1 ! wrtOutput allocated yes/no - IF ( ASSOCIATED(InData%wrtOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! wrtOutput upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%wrtOutput) ! wrtOutput - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! ptFairleadLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%ptFairleadLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! ptFairleadLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ptFairleadLoad - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ptFairleadLoad - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ptFairleadLoad - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ASSOCIATED(InData%Fx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Fx,1), UBOUND(InData%Fx,1) - DbKiBuf(Db_Xferred) = InData%Fx(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%Fy) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fy,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fy,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Fy,1), UBOUND(InData%Fy,1) - DbKiBuf(Db_Xferred) = InData%Fy(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%Fz) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fz,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fz,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Fz,1), UBOUND(InData%Fz,1) - DbKiBuf(Db_Xferred) = InData%Fz(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) - ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%wrtOutput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%wrtOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%wrtOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%wrtOutput,1), UBOUND(InData%wrtOutput,1) - DbKiBuf(Db_Xferred) = InData%wrtOutput(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - CALL MeshPack( InData%ptFairleadLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! ptFairleadLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE MAP_PackOutput - - SUBROUTINE MAP_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MAP_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%Fx)) DEALLOCATE(OutData%Fx) - ALLOCATE(OutData%Fx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%Fx_Len = SIZE(OutData%Fx) - IF (OutData%C_obj%Fx_Len > 0) & - OutData%C_obj%Fx = C_LOC( OutData%Fx( i1_l ) ) - DO i1 = LBOUND(OutData%Fx,1), UBOUND(OutData%Fx,1) - OutData%Fx(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fy not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%Fy)) DEALLOCATE(OutData%Fy) - ALLOCATE(OutData%Fy(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%Fy_Len = SIZE(OutData%Fy) - IF (OutData%C_obj%Fy_Len > 0) & - OutData%C_obj%Fy = C_LOC( OutData%Fy( i1_l ) ) - DO i1 = LBOUND(OutData%Fy,1), UBOUND(OutData%Fy,1) - OutData%Fy(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fz not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%Fz)) DEALLOCATE(OutData%Fz) - ALLOCATE(OutData%Fz(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%Fz_Len = SIZE(OutData%Fz) - IF (OutData%C_obj%Fz_Len > 0) & - OutData%C_obj%Fz = C_LOC( OutData%Fz( i1_l ) ) - DO i1 = LBOUND(OutData%Fz,1), UBOUND(OutData%Fz,1) - OutData%Fz(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutput)) DEALLOCATE(OutData%WriteOutput) - ALLOCATE(OutData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) - OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! wrtOutput not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%wrtOutput)) DEALLOCATE(OutData%wrtOutput) - ALLOCATE(OutData%wrtOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%wrtOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%wrtOutput_Len = SIZE(OutData%wrtOutput) - IF (OutData%C_obj%wrtOutput_Len > 0) & - OutData%C_obj%wrtOutput = C_LOC( OutData%wrtOutput( i1_l ) ) - DO i1 = LBOUND(OutData%wrtOutput,1), UBOUND(OutData%wrtOutput,1) - OutData%wrtOutput(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%ptFairleadLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! ptFairleadLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE MAP_UnPackOutput +subroutine MAP_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MAP_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MAP_PackOutput' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + ! Fx + call RegPack(Buf, associated(InData%Fx)) + if (associated(InData%Fx)) then + call RegPackBounds(Buf, 1, lbound(InData%Fx), ubound(InData%Fx)) + call RegPackPointer(Buf, c_loc(InData%Fx), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%Fx) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Fy + call RegPack(Buf, associated(InData%Fy)) + if (associated(InData%Fy)) then + call RegPackBounds(Buf, 1, lbound(InData%Fy), ubound(InData%Fy)) + call RegPackPointer(Buf, c_loc(InData%Fy), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%Fy) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Fz + call RegPack(Buf, associated(InData%Fz)) + if (associated(InData%Fz)) then + call RegPackBounds(Buf, 1, lbound(InData%Fz), ubound(InData%Fz)) + call RegPackPointer(Buf, c_loc(InData%Fz), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%Fz) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutput + call RegPack(Buf, allocated(InData%WriteOutput)) + if (allocated(InData%WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPack(Buf, InData%WriteOutput) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! wrtOutput + call RegPack(Buf, associated(InData%wrtOutput)) + if (associated(InData%wrtOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%wrtOutput), ubound(InData%wrtOutput)) + call RegPackPointer(Buf, c_loc(InData%wrtOutput), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%wrtOutput) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ptFairleadLoad + call MeshPack(Buf, InData%ptFairleadLoad) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MAP_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MAP_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MAP_UnPackOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + ! Fx + if (associated(OutData%Fx)) deallocate(OutData%Fx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Fx, UB(1:1)-LB(1:1)) + OutData%Fx(LB(1):) => OutData%Fx + else + allocate(OutData%Fx(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Fx) + OutData%C_obj%Fx_Len = size(OutData%Fx) + if (OutData%C_obj%Fx_Len > 0) OutData%C_obj%Fx = c_loc(OutData%Fx(LB(1))) + call RegUnpack(Buf, OutData%Fx) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%Fx => null() + end if + ! Fy + if (associated(OutData%Fy)) deallocate(OutData%Fy) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Fy, UB(1:1)-LB(1:1)) + OutData%Fy(LB(1):) => OutData%Fy + else + allocate(OutData%Fy(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fy.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Fy) + OutData%C_obj%Fy_Len = size(OutData%Fy) + if (OutData%C_obj%Fy_Len > 0) OutData%C_obj%Fy = c_loc(OutData%Fy(LB(1))) + call RegUnpack(Buf, OutData%Fy) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%Fy => null() + end if + ! Fz + if (associated(OutData%Fz)) deallocate(OutData%Fz) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Fz, UB(1:1)-LB(1:1)) + OutData%Fz(LB(1):) => OutData%Fz + else + allocate(OutData%Fz(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Fz) + OutData%C_obj%Fz_Len = size(OutData%Fz) + if (OutData%C_obj%Fz_Len > 0) OutData%C_obj%Fz = c_loc(OutData%Fz(LB(1))) + call RegUnpack(Buf, OutData%Fz) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%Fz => null() + end if + ! WriteOutput + if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! wrtOutput + if (associated(OutData%wrtOutput)) deallocate(OutData%wrtOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%wrtOutput, UB(1:1)-LB(1:1)) + OutData%wrtOutput(LB(1):) => OutData%wrtOutput + else + allocate(OutData%wrtOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%wrtOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%wrtOutput) + OutData%C_obj%wrtOutput_Len = size(OutData%wrtOutput) + if (OutData%C_obj%wrtOutput_Len > 0) OutData%C_obj%wrtOutput = c_loc(OutData%wrtOutput(LB(1))) + call RegUnpack(Buf, OutData%wrtOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%wrtOutput => null() + end if + ! ptFairleadLoad + call MeshUnpack(Buf, OutData%ptFairleadLoad) ! ptFairleadLoad +end subroutine SUBROUTINE MAP_C2Fary_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) TYPE(MAP_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat diff --git a/modules/moordyn/src/MoorDyn_Types.f90 b/modules/moordyn/src/MoorDyn_Types.f90 index 127da93d94..85553db338 100644 --- a/modules/moordyn/src/MoorDyn_Types.f90 +++ b/modules/moordyn/src/MoorDyn_Types.f90 @@ -497,118 +497,44 @@ SUBROUTINE MD_DestroyInputFileType( InputFileTypeData, ErrStat, ErrMsg ) END SUBROUTINE MD_DestroyInputFileType - SUBROUTINE MD_PackInputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MD_InputFileType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackInputFileType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! DTIC - Db_BufSz = Db_BufSz + 1 ! TMaxIC - Re_BufSz = Re_BufSz + 1 ! CdScaleIC - Re_BufSz = Re_BufSz + 1 ! threshIC - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%DTIC - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TMaxIC - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CdScaleIC - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%threshIC - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE MD_PackInputFileType - - SUBROUTINE MD_UnPackInputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MD_InputFileType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackInputFileType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DTIC = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%TMaxIC = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%CdScaleIC = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%threshIC = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE MD_UnPackInputFileType +subroutine MD_PackInputFileType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MD_InputFileType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackInputFileType' + if (Buf%ErrStat >= AbortErrLev) return + ! DTIC + call RegPack(Buf, InData%DTIC) + if (RegCheckErr(Buf, RoutineName)) return + ! TMaxIC + call RegPack(Buf, InData%TMaxIC) + if (RegCheckErr(Buf, RoutineName)) return + ! CdScaleIC + call RegPack(Buf, InData%CdScaleIC) + if (RegCheckErr(Buf, RoutineName)) return + ! threshIC + call RegPack(Buf, InData%threshIC) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_UnPackInputFileType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MD_InputFileType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackInputFileType' + if (Buf%ErrStat /= ErrID_None) return + ! DTIC + call RegUnpack(Buf, OutData%DTIC) + if (RegCheckErr(Buf, RoutineName)) return + ! TMaxIC + call RegUnpack(Buf, OutData%TMaxIC) + if (RegCheckErr(Buf, RoutineName)) return + ! CdScaleIC + call RegUnpack(Buf, OutData%CdScaleIC) + if (RegCheckErr(Buf, RoutineName)) return + ! threshIC + call RegUnpack(Buf, OutData%threshIC) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE MD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(MD_InitInputType), INTENT(IN) :: SrcInitInputData TYPE(MD_InitInputType), INTENT(INOUT) :: DstInitInputData @@ -706,382 +632,154 @@ SUBROUTINE MD_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE MD_DestroyInitInput - SUBROUTINE MD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MD_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! g - Re_BufSz = Re_BufSz + 1 ! rhoW - Re_BufSz = Re_BufSz + 1 ! WtrDepth - Int_BufSz = Int_BufSz + 1 ! PtfmInit allocated yes/no - IF ( ALLOCATED(InData%PtfmInit) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PtfmInit upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PtfmInit) ! PtfmInit - END IF - Int_BufSz = Int_BufSz + 1 ! FarmSize - Int_BufSz = Int_BufSz + 1 ! TurbineRefPos allocated yes/no - IF ( ALLOCATED(InData%TurbineRefPos) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TurbineRefPos upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TurbineRefPos) ! TurbineRefPos - END IF - Re_BufSz = Re_BufSz + 1 ! Tmax - Int_BufSz = Int_BufSz + 1*LEN(InData%FileName) ! FileName - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1 ! UsePrimaryInputFile - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! PassedPrimaryInputData: size of buffers for each call to pack subtype - CALL NWTC_Library_PackFileInfoType( Re_Buf, Db_Buf, Int_Buf, InData%PassedPrimaryInputData, ErrStat2, ErrMsg2, .TRUE. ) ! PassedPrimaryInputData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PassedPrimaryInputData - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PassedPrimaryInputData - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PassedPrimaryInputData - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Echo - Int_BufSz = Int_BufSz + 1 ! OutList allocated yes/no - IF ( ALLOCATED(InData%OutList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%OutList)*LEN(InData%OutList) ! OutList - END IF - Int_BufSz = Int_BufSz + 1 ! Linearize - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%g - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rhoW - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDepth - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%PtfmInit) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmInit,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmInit,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmInit,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmInit,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PtfmInit,2), UBOUND(InData%PtfmInit,2) - DO i1 = LBOUND(InData%PtfmInit,1), UBOUND(InData%PtfmInit,1) - ReKiBuf(Re_Xferred) = InData%PtfmInit(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%FarmSize - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TurbineRefPos) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TurbineRefPos,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TurbineRefPos,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TurbineRefPos,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TurbineRefPos,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TurbineRefPos,2), UBOUND(InData%TurbineRefPos,2) - DO i1 = LBOUND(InData%TurbineRefPos,1), UBOUND(InData%TurbineRefPos,1) - ReKiBuf(Re_Xferred) = InData%TurbineRefPos(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%Tmax - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%UsePrimaryInputFile, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - CALL NWTC_Library_PackFileInfoType( Re_Buf, Db_Buf, Int_Buf, InData%PassedPrimaryInputData, ErrStat2, ErrMsg2, OnlySize ) ! PassedPrimaryInputData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = TRANSFER(InData%Echo, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) - DO I = 1, LEN(InData%OutList) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE MD_PackInitInput - - SUBROUTINE MD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MD_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%g = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rhoW = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDepth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmInit not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PtfmInit)) DEALLOCATE(OutData%PtfmInit) - ALLOCATE(OutData%PtfmInit(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmInit.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PtfmInit,2), UBOUND(OutData%PtfmInit,2) - DO i1 = LBOUND(OutData%PtfmInit,1), UBOUND(OutData%PtfmInit,1) - OutData%PtfmInit(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%FarmSize = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TurbineRefPos not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TurbineRefPos)) DEALLOCATE(OutData%TurbineRefPos) - ALLOCATE(OutData%TurbineRefPos(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TurbineRefPos.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TurbineRefPos,2), UBOUND(OutData%TurbineRefPos,2) - DO i1 = LBOUND(OutData%TurbineRefPos,1), UBOUND(OutData%TurbineRefPos,1) - OutData%TurbineRefPos(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%Tmax = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%FileName) - OutData%FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UsePrimaryInputFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%UsePrimaryInputFile) - Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackFileInfoType( Re_Buf, Db_Buf, Int_Buf, OutData%PassedPrimaryInputData, ErrStat2, ErrMsg2 ) ! PassedPrimaryInputData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%Echo = TRANSFER(IntKiBuf(Int_Xferred), OutData%Echo) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutList not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutList)) DEALLOCATE(OutData%OutList) - ALLOCATE(OutData%OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) - DO I = 1, LEN(OutData%OutList) - OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE MD_UnPackInitInput +subroutine MD_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MD_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + ! g + call RegPack(Buf, InData%g) + if (RegCheckErr(Buf, RoutineName)) return + ! rhoW + call RegPack(Buf, InData%rhoW) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDepth + call RegPack(Buf, InData%WtrDepth) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmInit + call RegPack(Buf, allocated(InData%PtfmInit)) + if (allocated(InData%PtfmInit)) then + call RegPackBounds(Buf, 2, lbound(InData%PtfmInit), ubound(InData%PtfmInit)) + call RegPack(Buf, InData%PtfmInit) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FarmSize + call RegPack(Buf, InData%FarmSize) + if (RegCheckErr(Buf, RoutineName)) return + ! TurbineRefPos + call RegPack(Buf, allocated(InData%TurbineRefPos)) + if (allocated(InData%TurbineRefPos)) then + call RegPackBounds(Buf, 2, lbound(InData%TurbineRefPos), ubound(InData%TurbineRefPos)) + call RegPack(Buf, InData%TurbineRefPos) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Tmax + call RegPack(Buf, InData%Tmax) + if (RegCheckErr(Buf, RoutineName)) return + ! FileName + call RegPack(Buf, InData%FileName) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegPack(Buf, InData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! UsePrimaryInputFile + call RegPack(Buf, InData%UsePrimaryInputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! PassedPrimaryInputData + call NWTC_Library_PackFileInfoType(Buf, InData%PassedPrimaryInputData) + if (RegCheckErr(Buf, RoutineName)) return + ! Echo + call RegPack(Buf, InData%Echo) + if (RegCheckErr(Buf, RoutineName)) return + ! OutList + call RegPack(Buf, allocated(InData%OutList)) + if (allocated(InData%OutList)) then + call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) + call RegPack(Buf, InData%OutList) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Linearize + call RegPack(Buf, InData%Linearize) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MD_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackInitInput' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! g + call RegUnpack(Buf, OutData%g) + if (RegCheckErr(Buf, RoutineName)) return + ! rhoW + call RegUnpack(Buf, OutData%rhoW) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDepth + call RegUnpack(Buf, OutData%WtrDepth) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmInit + if (allocated(OutData%PtfmInit)) deallocate(OutData%PtfmInit) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PtfmInit(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmInit.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PtfmInit) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! FarmSize + call RegUnpack(Buf, OutData%FarmSize) + if (RegCheckErr(Buf, RoutineName)) return + ! TurbineRefPos + if (allocated(OutData%TurbineRefPos)) deallocate(OutData%TurbineRefPos) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TurbineRefPos(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TurbineRefPos.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TurbineRefPos) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Tmax + call RegUnpack(Buf, OutData%Tmax) + if (RegCheckErr(Buf, RoutineName)) return + ! FileName + call RegUnpack(Buf, OutData%FileName) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! UsePrimaryInputFile + call RegUnpack(Buf, OutData%UsePrimaryInputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! PassedPrimaryInputData + call NWTC_Library_UnpackFileInfoType(Buf, OutData%PassedPrimaryInputData) ! PassedPrimaryInputData + ! Echo + call RegUnpack(Buf, OutData%Echo) + if (RegCheckErr(Buf, RoutineName)) return + ! OutList + if (allocated(OutData%OutList)) deallocate(OutData%OutList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutList) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Linearize + call RegUnpack(Buf, OutData%Linearize) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE MD_CopyLineProp( SrcLinePropData, DstLinePropData, CtrlCode, ErrStat, ErrMsg ) TYPE(MD_LineProp), INTENT(IN) :: SrcLinePropData TYPE(MD_LineProp), INTENT(INOUT) :: DstLinePropData @@ -1137,254 +835,158 @@ SUBROUTINE MD_DestroyLineProp( LinePropData, ErrStat, ErrMsg ) END SUBROUTINE MD_DestroyLineProp - SUBROUTINE MD_PackLineProp( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MD_LineProp), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackLineProp' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! IdNum - Int_BufSz = Int_BufSz + 1*LEN(InData%name) ! name - Db_BufSz = Db_BufSz + 1 ! d - Db_BufSz = Db_BufSz + 1 ! w - Db_BufSz = Db_BufSz + 1 ! EA - Db_BufSz = Db_BufSz + 1 ! EA_D - Db_BufSz = Db_BufSz + 1 ! BA - Db_BufSz = Db_BufSz + 1 ! BA_D - Db_BufSz = Db_BufSz + 1 ! EI - Db_BufSz = Db_BufSz + 1 ! Can - Db_BufSz = Db_BufSz + 1 ! Cat - Db_BufSz = Db_BufSz + 1 ! Cdn - Db_BufSz = Db_BufSz + 1 ! Cdt - Int_BufSz = Int_BufSz + 1 ! ElasticMod - Int_BufSz = Int_BufSz + 1 ! nEApoints - Db_BufSz = Db_BufSz + SIZE(InData%stiffXs) ! stiffXs - Db_BufSz = Db_BufSz + SIZE(InData%stiffYs) ! stiffYs - Int_BufSz = Int_BufSz + 1 ! nBApoints - Db_BufSz = Db_BufSz + SIZE(InData%dampXs) ! dampXs - Db_BufSz = Db_BufSz + SIZE(InData%dampYs) ! dampYs - Int_BufSz = Int_BufSz + 1 ! nEIpoints - Db_BufSz = Db_BufSz + SIZE(InData%bstiffXs) ! bstiffXs - Db_BufSz = Db_BufSz + SIZE(InData%bstiffYs) ! bstiffYs - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%IdNum - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%name) - IntKiBuf(Int_Xferred) = ICHAR(InData%name(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf(Db_Xferred) = InData%d - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%w - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%EA - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%EA_D - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%BA - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%BA_D - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%EI - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Can - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Cat - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Cdn - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Cdt - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ElasticMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nEApoints - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%stiffXs,1), UBOUND(InData%stiffXs,1) - DbKiBuf(Db_Xferred) = InData%stiffXs(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%stiffYs,1), UBOUND(InData%stiffYs,1) - DbKiBuf(Db_Xferred) = InData%stiffYs(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%nBApoints - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%dampXs,1), UBOUND(InData%dampXs,1) - DbKiBuf(Db_Xferred) = InData%dampXs(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%dampYs,1), UBOUND(InData%dampYs,1) - DbKiBuf(Db_Xferred) = InData%dampYs(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%nEIpoints - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%bstiffXs,1), UBOUND(InData%bstiffXs,1) - DbKiBuf(Db_Xferred) = InData%bstiffXs(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%bstiffYs,1), UBOUND(InData%bstiffYs,1) - DbKiBuf(Db_Xferred) = InData%bstiffYs(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE MD_PackLineProp - - SUBROUTINE MD_UnPackLineProp( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MD_LineProp), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackLineProp' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%IdNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%name) - OutData%name(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%d = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%w = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%EA = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%EA_D = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%BA = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%BA_D = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%EI = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Can = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Cat = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Cdn = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Cdt = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%ElasticMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nEApoints = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%stiffXs,1) - i1_u = UBOUND(OutData%stiffXs,1) - DO i1 = LBOUND(OutData%stiffXs,1), UBOUND(OutData%stiffXs,1) - OutData%stiffXs(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%stiffYs,1) - i1_u = UBOUND(OutData%stiffYs,1) - DO i1 = LBOUND(OutData%stiffYs,1), UBOUND(OutData%stiffYs,1) - OutData%stiffYs(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - OutData%nBApoints = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%dampXs,1) - i1_u = UBOUND(OutData%dampXs,1) - DO i1 = LBOUND(OutData%dampXs,1), UBOUND(OutData%dampXs,1) - OutData%dampXs(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%dampYs,1) - i1_u = UBOUND(OutData%dampYs,1) - DO i1 = LBOUND(OutData%dampYs,1), UBOUND(OutData%dampYs,1) - OutData%dampYs(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - OutData%nEIpoints = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%bstiffXs,1) - i1_u = UBOUND(OutData%bstiffXs,1) - DO i1 = LBOUND(OutData%bstiffXs,1), UBOUND(OutData%bstiffXs,1) - OutData%bstiffXs(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%bstiffYs,1) - i1_u = UBOUND(OutData%bstiffYs,1) - DO i1 = LBOUND(OutData%bstiffYs,1), UBOUND(OutData%bstiffYs,1) - OutData%bstiffYs(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE MD_UnPackLineProp +subroutine MD_PackLineProp(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MD_LineProp), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackLineProp' + if (Buf%ErrStat >= AbortErrLev) return + ! IdNum + call RegPack(Buf, InData%IdNum) + if (RegCheckErr(Buf, RoutineName)) return + ! name + call RegPack(Buf, InData%name) + if (RegCheckErr(Buf, RoutineName)) return + ! d + call RegPack(Buf, InData%d) + if (RegCheckErr(Buf, RoutineName)) return + ! w + call RegPack(Buf, InData%w) + if (RegCheckErr(Buf, RoutineName)) return + ! EA + call RegPack(Buf, InData%EA) + if (RegCheckErr(Buf, RoutineName)) return + ! EA_D + call RegPack(Buf, InData%EA_D) + if (RegCheckErr(Buf, RoutineName)) return + ! BA + call RegPack(Buf, InData%BA) + if (RegCheckErr(Buf, RoutineName)) return + ! BA_D + call RegPack(Buf, InData%BA_D) + if (RegCheckErr(Buf, RoutineName)) return + ! EI + call RegPack(Buf, InData%EI) + if (RegCheckErr(Buf, RoutineName)) return + ! Can + call RegPack(Buf, InData%Can) + if (RegCheckErr(Buf, RoutineName)) return + ! Cat + call RegPack(Buf, InData%Cat) + if (RegCheckErr(Buf, RoutineName)) return + ! Cdn + call RegPack(Buf, InData%Cdn) + if (RegCheckErr(Buf, RoutineName)) return + ! Cdt + call RegPack(Buf, InData%Cdt) + if (RegCheckErr(Buf, RoutineName)) return + ! ElasticMod + call RegPack(Buf, InData%ElasticMod) + if (RegCheckErr(Buf, RoutineName)) return + ! nEApoints + call RegPack(Buf, InData%nEApoints) + if (RegCheckErr(Buf, RoutineName)) return + ! stiffXs + call RegPack(Buf, InData%stiffXs) + if (RegCheckErr(Buf, RoutineName)) return + ! stiffYs + call RegPack(Buf, InData%stiffYs) + if (RegCheckErr(Buf, RoutineName)) return + ! nBApoints + call RegPack(Buf, InData%nBApoints) + if (RegCheckErr(Buf, RoutineName)) return + ! dampXs + call RegPack(Buf, InData%dampXs) + if (RegCheckErr(Buf, RoutineName)) return + ! dampYs + call RegPack(Buf, InData%dampYs) + if (RegCheckErr(Buf, RoutineName)) return + ! nEIpoints + call RegPack(Buf, InData%nEIpoints) + if (RegCheckErr(Buf, RoutineName)) return + ! bstiffXs + call RegPack(Buf, InData%bstiffXs) + if (RegCheckErr(Buf, RoutineName)) return + ! bstiffYs + call RegPack(Buf, InData%bstiffYs) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_UnPackLineProp(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MD_LineProp), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackLineProp' + if (Buf%ErrStat /= ErrID_None) return + ! IdNum + call RegUnpack(Buf, OutData%IdNum) + if (RegCheckErr(Buf, RoutineName)) return + ! name + call RegUnpack(Buf, OutData%name) + if (RegCheckErr(Buf, RoutineName)) return + ! d + call RegUnpack(Buf, OutData%d) + if (RegCheckErr(Buf, RoutineName)) return + ! w + call RegUnpack(Buf, OutData%w) + if (RegCheckErr(Buf, RoutineName)) return + ! EA + call RegUnpack(Buf, OutData%EA) + if (RegCheckErr(Buf, RoutineName)) return + ! EA_D + call RegUnpack(Buf, OutData%EA_D) + if (RegCheckErr(Buf, RoutineName)) return + ! BA + call RegUnpack(Buf, OutData%BA) + if (RegCheckErr(Buf, RoutineName)) return + ! BA_D + call RegUnpack(Buf, OutData%BA_D) + if (RegCheckErr(Buf, RoutineName)) return + ! EI + call RegUnpack(Buf, OutData%EI) + if (RegCheckErr(Buf, RoutineName)) return + ! Can + call RegUnpack(Buf, OutData%Can) + if (RegCheckErr(Buf, RoutineName)) return + ! Cat + call RegUnpack(Buf, OutData%Cat) + if (RegCheckErr(Buf, RoutineName)) return + ! Cdn + call RegUnpack(Buf, OutData%Cdn) + if (RegCheckErr(Buf, RoutineName)) return + ! Cdt + call RegUnpack(Buf, OutData%Cdt) + if (RegCheckErr(Buf, RoutineName)) return + ! ElasticMod + call RegUnpack(Buf, OutData%ElasticMod) + if (RegCheckErr(Buf, RoutineName)) return + ! nEApoints + call RegUnpack(Buf, OutData%nEApoints) + if (RegCheckErr(Buf, RoutineName)) return + ! stiffXs + call RegUnpack(Buf, OutData%stiffXs) + if (RegCheckErr(Buf, RoutineName)) return + ! stiffYs + call RegUnpack(Buf, OutData%stiffYs) + if (RegCheckErr(Buf, RoutineName)) return + ! nBApoints + call RegUnpack(Buf, OutData%nBApoints) + if (RegCheckErr(Buf, RoutineName)) return + ! dampXs + call RegUnpack(Buf, OutData%dampXs) + if (RegCheckErr(Buf, RoutineName)) return + ! dampYs + call RegUnpack(Buf, OutData%dampYs) + if (RegCheckErr(Buf, RoutineName)) return + ! nEIpoints + call RegUnpack(Buf, OutData%nEIpoints) + if (RegCheckErr(Buf, RoutineName)) return + ! bstiffXs + call RegUnpack(Buf, OutData%bstiffXs) + if (RegCheckErr(Buf, RoutineName)) return + ! bstiffYs + call RegUnpack(Buf, OutData%bstiffYs) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE MD_CopyRodProp( SrcRodPropData, DstRodPropData, CtrlCode, ErrStat, ErrMsg ) TYPE(MD_RodProp), INTENT(IN) :: SrcRodPropData TYPE(MD_RodProp), INTENT(INOUT) :: DstRodPropData @@ -1426,152 +1028,80 @@ SUBROUTINE MD_DestroyRodProp( RodPropData, ErrStat, ErrMsg ) END SUBROUTINE MD_DestroyRodProp - SUBROUTINE MD_PackRodProp( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MD_RodProp), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackRodProp' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! IdNum - Int_BufSz = Int_BufSz + 1*LEN(InData%name) ! name - Db_BufSz = Db_BufSz + 1 ! d - Db_BufSz = Db_BufSz + 1 ! w - Db_BufSz = Db_BufSz + 1 ! Can - Db_BufSz = Db_BufSz + 1 ! Cat - Db_BufSz = Db_BufSz + 1 ! Cdn - Db_BufSz = Db_BufSz + 1 ! Cdt - Db_BufSz = Db_BufSz + 1 ! CdEnd - Db_BufSz = Db_BufSz + 1 ! CaEnd - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%IdNum - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%name) - IntKiBuf(Int_Xferred) = ICHAR(InData%name(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf(Db_Xferred) = InData%d - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%w - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Can - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Cat - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Cdn - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Cdt - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CdEnd - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CaEnd - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE MD_PackRodProp - - SUBROUTINE MD_UnPackRodProp( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MD_RodProp), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackRodProp' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%IdNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%name) - OutData%name(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%d = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%w = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Can = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Cat = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Cdn = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Cdt = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%CdEnd = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%CaEnd = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE MD_UnPackRodProp +subroutine MD_PackRodProp(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MD_RodProp), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackRodProp' + if (Buf%ErrStat >= AbortErrLev) return + ! IdNum + call RegPack(Buf, InData%IdNum) + if (RegCheckErr(Buf, RoutineName)) return + ! name + call RegPack(Buf, InData%name) + if (RegCheckErr(Buf, RoutineName)) return + ! d + call RegPack(Buf, InData%d) + if (RegCheckErr(Buf, RoutineName)) return + ! w + call RegPack(Buf, InData%w) + if (RegCheckErr(Buf, RoutineName)) return + ! Can + call RegPack(Buf, InData%Can) + if (RegCheckErr(Buf, RoutineName)) return + ! Cat + call RegPack(Buf, InData%Cat) + if (RegCheckErr(Buf, RoutineName)) return + ! Cdn + call RegPack(Buf, InData%Cdn) + if (RegCheckErr(Buf, RoutineName)) return + ! Cdt + call RegPack(Buf, InData%Cdt) + if (RegCheckErr(Buf, RoutineName)) return + ! CdEnd + call RegPack(Buf, InData%CdEnd) + if (RegCheckErr(Buf, RoutineName)) return + ! CaEnd + call RegPack(Buf, InData%CaEnd) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_UnPackRodProp(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MD_RodProp), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackRodProp' + if (Buf%ErrStat /= ErrID_None) return + ! IdNum + call RegUnpack(Buf, OutData%IdNum) + if (RegCheckErr(Buf, RoutineName)) return + ! name + call RegUnpack(Buf, OutData%name) + if (RegCheckErr(Buf, RoutineName)) return + ! d + call RegUnpack(Buf, OutData%d) + if (RegCheckErr(Buf, RoutineName)) return + ! w + call RegUnpack(Buf, OutData%w) + if (RegCheckErr(Buf, RoutineName)) return + ! Can + call RegUnpack(Buf, OutData%Can) + if (RegCheckErr(Buf, RoutineName)) return + ! Cat + call RegUnpack(Buf, OutData%Cat) + if (RegCheckErr(Buf, RoutineName)) return + ! Cdn + call RegUnpack(Buf, OutData%Cdn) + if (RegCheckErr(Buf, RoutineName)) return + ! Cdt + call RegUnpack(Buf, OutData%Cdt) + if (RegCheckErr(Buf, RoutineName)) return + ! CdEnd + call RegUnpack(Buf, OutData%CdEnd) + if (RegCheckErr(Buf, RoutineName)) return + ! CaEnd + call RegUnpack(Buf, OutData%CaEnd) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE MD_CopyBody( SrcBodyData, DstBodyData, CtrlCode, ErrStat, ErrMsg ) TYPE(MD_Body), INTENT(IN) :: SrcBodyData TYPE(MD_Body), INTENT(INOUT) :: DstBodyData @@ -1631,374 +1161,176 @@ SUBROUTINE MD_DestroyBody( BodyData, ErrStat, ErrMsg ) END SUBROUTINE MD_DestroyBody - SUBROUTINE MD_PackBody( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MD_Body), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackBody' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! IdNum - Int_BufSz = Int_BufSz + 1 ! typeNum - Int_BufSz = Int_BufSz + SIZE(InData%AttachedC) ! AttachedC - Int_BufSz = Int_BufSz + SIZE(InData%AttachedR) ! AttachedR - Int_BufSz = Int_BufSz + 1 ! nAttachedC - Int_BufSz = Int_BufSz + 1 ! nAttachedR - Db_BufSz = Db_BufSz + SIZE(InData%rConnectRel) ! rConnectRel - Db_BufSz = Db_BufSz + SIZE(InData%r6RodRel) ! r6RodRel - Db_BufSz = Db_BufSz + 1 ! bodyM - Db_BufSz = Db_BufSz + 1 ! bodyV - Db_BufSz = Db_BufSz + SIZE(InData%bodyI) ! bodyI - Db_BufSz = Db_BufSz + SIZE(InData%bodyCdA) ! bodyCdA - Db_BufSz = Db_BufSz + SIZE(InData%bodyCa) ! bodyCa - Db_BufSz = Db_BufSz + 1 ! time - Db_BufSz = Db_BufSz + SIZE(InData%r6) ! r6 - Db_BufSz = Db_BufSz + SIZE(InData%v6) ! v6 - Db_BufSz = Db_BufSz + SIZE(InData%a6) ! a6 - Db_BufSz = Db_BufSz + SIZE(InData%U) ! U - Db_BufSz = Db_BufSz + SIZE(InData%Ud) ! Ud - Db_BufSz = Db_BufSz + 1 ! zeta - Db_BufSz = Db_BufSz + SIZE(InData%F6net) ! F6net - Db_BufSz = Db_BufSz + SIZE(InData%M6net) ! M6net - Db_BufSz = Db_BufSz + SIZE(InData%M) ! M - Db_BufSz = Db_BufSz + SIZE(InData%M0) ! M0 - Db_BufSz = Db_BufSz + SIZE(InData%OrMat) ! OrMat - Db_BufSz = Db_BufSz + SIZE(InData%rCG) ! rCG - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%IdNum - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%typeNum - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%AttachedC,1), UBOUND(InData%AttachedC,1) - IntKiBuf(Int_Xferred) = InData%AttachedC(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%AttachedR,1), UBOUND(InData%AttachedR,1) - IntKiBuf(Int_Xferred) = InData%AttachedR(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%nAttachedC - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nAttachedR - Int_Xferred = Int_Xferred + 1 - DO i2 = LBOUND(InData%rConnectRel,2), UBOUND(InData%rConnectRel,2) - DO i1 = LBOUND(InData%rConnectRel,1), UBOUND(InData%rConnectRel,1) - DbKiBuf(Db_Xferred) = InData%rConnectRel(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%r6RodRel,2), UBOUND(InData%r6RodRel,2) - DO i1 = LBOUND(InData%r6RodRel,1), UBOUND(InData%r6RodRel,1) - DbKiBuf(Db_Xferred) = InData%r6RodRel(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DbKiBuf(Db_Xferred) = InData%bodyM - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%bodyV - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%bodyI,1), UBOUND(InData%bodyI,1) - DbKiBuf(Db_Xferred) = InData%bodyI(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%bodyCdA,1), UBOUND(InData%bodyCdA,1) - DbKiBuf(Db_Xferred) = InData%bodyCdA(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%bodyCa,1), UBOUND(InData%bodyCa,1) - DbKiBuf(Db_Xferred) = InData%bodyCa(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DbKiBuf(Db_Xferred) = InData%time - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%r6,1), UBOUND(InData%r6,1) - DbKiBuf(Db_Xferred) = InData%r6(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%v6,1), UBOUND(InData%v6,1) - DbKiBuf(Db_Xferred) = InData%v6(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%a6,1), UBOUND(InData%a6,1) - DbKiBuf(Db_Xferred) = InData%a6(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%U,1), UBOUND(InData%U,1) - DbKiBuf(Db_Xferred) = InData%U(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%Ud,1), UBOUND(InData%Ud,1) - DbKiBuf(Db_Xferred) = InData%Ud(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DbKiBuf(Db_Xferred) = InData%zeta - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%F6net,1), UBOUND(InData%F6net,1) - DbKiBuf(Db_Xferred) = InData%F6net(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i2 = LBOUND(InData%M6net,2), UBOUND(InData%M6net,2) - DO i1 = LBOUND(InData%M6net,1), UBOUND(InData%M6net,1) - DbKiBuf(Db_Xferred) = InData%M6net(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%M,2), UBOUND(InData%M,2) - DO i1 = LBOUND(InData%M,1), UBOUND(InData%M,1) - DbKiBuf(Db_Xferred) = InData%M(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%M0,2), UBOUND(InData%M0,2) - DO i1 = LBOUND(InData%M0,1), UBOUND(InData%M0,1) - DbKiBuf(Db_Xferred) = InData%M0(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%OrMat,2), UBOUND(InData%OrMat,2) - DO i1 = LBOUND(InData%OrMat,1), UBOUND(InData%OrMat,1) - DbKiBuf(Db_Xferred) = InData%OrMat(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DO i1 = LBOUND(InData%rCG,1), UBOUND(InData%rCG,1) - DbKiBuf(Db_Xferred) = InData%rCG(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE MD_PackBody - - SUBROUTINE MD_UnPackBody( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MD_Body), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackBody' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%IdNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%typeNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%AttachedC,1) - i1_u = UBOUND(OutData%AttachedC,1) - DO i1 = LBOUND(OutData%AttachedC,1), UBOUND(OutData%AttachedC,1) - OutData%AttachedC(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%AttachedR,1) - i1_u = UBOUND(OutData%AttachedR,1) - DO i1 = LBOUND(OutData%AttachedR,1), UBOUND(OutData%AttachedR,1) - OutData%AttachedR(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%nAttachedC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nAttachedR = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%rConnectRel,1) - i1_u = UBOUND(OutData%rConnectRel,1) - i2_l = LBOUND(OutData%rConnectRel,2) - i2_u = UBOUND(OutData%rConnectRel,2) - DO i2 = LBOUND(OutData%rConnectRel,2), UBOUND(OutData%rConnectRel,2) - DO i1 = LBOUND(OutData%rConnectRel,1), UBOUND(OutData%rConnectRel,1) - OutData%rConnectRel(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%r6RodRel,1) - i1_u = UBOUND(OutData%r6RodRel,1) - i2_l = LBOUND(OutData%r6RodRel,2) - i2_u = UBOUND(OutData%r6RodRel,2) - DO i2 = LBOUND(OutData%r6RodRel,2), UBOUND(OutData%r6RodRel,2) - DO i1 = LBOUND(OutData%r6RodRel,1), UBOUND(OutData%r6RodRel,1) - OutData%r6RodRel(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - OutData%bodyM = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%bodyV = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%bodyI,1) - i1_u = UBOUND(OutData%bodyI,1) - DO i1 = LBOUND(OutData%bodyI,1), UBOUND(OutData%bodyI,1) - OutData%bodyI(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%bodyCdA,1) - i1_u = UBOUND(OutData%bodyCdA,1) - DO i1 = LBOUND(OutData%bodyCdA,1), UBOUND(OutData%bodyCdA,1) - OutData%bodyCdA(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%bodyCa,1) - i1_u = UBOUND(OutData%bodyCa,1) - DO i1 = LBOUND(OutData%bodyCa,1), UBOUND(OutData%bodyCa,1) - OutData%bodyCa(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - OutData%time = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%r6,1) - i1_u = UBOUND(OutData%r6,1) - DO i1 = LBOUND(OutData%r6,1), UBOUND(OutData%r6,1) - OutData%r6(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%v6,1) - i1_u = UBOUND(OutData%v6,1) - DO i1 = LBOUND(OutData%v6,1), UBOUND(OutData%v6,1) - OutData%v6(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%a6,1) - i1_u = UBOUND(OutData%a6,1) - DO i1 = LBOUND(OutData%a6,1), UBOUND(OutData%a6,1) - OutData%a6(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%U,1) - i1_u = UBOUND(OutData%U,1) - DO i1 = LBOUND(OutData%U,1), UBOUND(OutData%U,1) - OutData%U(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%Ud,1) - i1_u = UBOUND(OutData%Ud,1) - DO i1 = LBOUND(OutData%Ud,1), UBOUND(OutData%Ud,1) - OutData%Ud(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - OutData%zeta = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%F6net,1) - i1_u = UBOUND(OutData%F6net,1) - DO i1 = LBOUND(OutData%F6net,1), UBOUND(OutData%F6net,1) - OutData%F6net(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%M6net,1) - i1_u = UBOUND(OutData%M6net,1) - i2_l = LBOUND(OutData%M6net,2) - i2_u = UBOUND(OutData%M6net,2) - DO i2 = LBOUND(OutData%M6net,2), UBOUND(OutData%M6net,2) - DO i1 = LBOUND(OutData%M6net,1), UBOUND(OutData%M6net,1) - OutData%M6net(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%M,1) - i1_u = UBOUND(OutData%M,1) - i2_l = LBOUND(OutData%M,2) - i2_u = UBOUND(OutData%M,2) - DO i2 = LBOUND(OutData%M,2), UBOUND(OutData%M,2) - DO i1 = LBOUND(OutData%M,1), UBOUND(OutData%M,1) - OutData%M(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%M0,1) - i1_u = UBOUND(OutData%M0,1) - i2_l = LBOUND(OutData%M0,2) - i2_u = UBOUND(OutData%M0,2) - DO i2 = LBOUND(OutData%M0,2), UBOUND(OutData%M0,2) - DO i1 = LBOUND(OutData%M0,1), UBOUND(OutData%M0,1) - OutData%M0(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%OrMat,1) - i1_u = UBOUND(OutData%OrMat,1) - i2_l = LBOUND(OutData%OrMat,2) - i2_u = UBOUND(OutData%OrMat,2) - DO i2 = LBOUND(OutData%OrMat,2), UBOUND(OutData%OrMat,2) - DO i1 = LBOUND(OutData%OrMat,1), UBOUND(OutData%OrMat,1) - OutData%OrMat(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%rCG,1) - i1_u = UBOUND(OutData%rCG,1) - DO i1 = LBOUND(OutData%rCG,1), UBOUND(OutData%rCG,1) - OutData%rCG(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE MD_UnPackBody +subroutine MD_PackBody(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MD_Body), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackBody' + if (Buf%ErrStat >= AbortErrLev) return + ! IdNum + call RegPack(Buf, InData%IdNum) + if (RegCheckErr(Buf, RoutineName)) return + ! typeNum + call RegPack(Buf, InData%typeNum) + if (RegCheckErr(Buf, RoutineName)) return + ! AttachedC + call RegPack(Buf, InData%AttachedC) + if (RegCheckErr(Buf, RoutineName)) return + ! AttachedR + call RegPack(Buf, InData%AttachedR) + if (RegCheckErr(Buf, RoutineName)) return + ! nAttachedC + call RegPack(Buf, InData%nAttachedC) + if (RegCheckErr(Buf, RoutineName)) return + ! nAttachedR + call RegPack(Buf, InData%nAttachedR) + if (RegCheckErr(Buf, RoutineName)) return + ! rConnectRel + call RegPack(Buf, InData%rConnectRel) + if (RegCheckErr(Buf, RoutineName)) return + ! r6RodRel + call RegPack(Buf, InData%r6RodRel) + if (RegCheckErr(Buf, RoutineName)) return + ! bodyM + call RegPack(Buf, InData%bodyM) + if (RegCheckErr(Buf, RoutineName)) return + ! bodyV + call RegPack(Buf, InData%bodyV) + if (RegCheckErr(Buf, RoutineName)) return + ! bodyI + call RegPack(Buf, InData%bodyI) + if (RegCheckErr(Buf, RoutineName)) return + ! bodyCdA + call RegPack(Buf, InData%bodyCdA) + if (RegCheckErr(Buf, RoutineName)) return + ! bodyCa + call RegPack(Buf, InData%bodyCa) + if (RegCheckErr(Buf, RoutineName)) return + ! time + call RegPack(Buf, InData%time) + if (RegCheckErr(Buf, RoutineName)) return + ! r6 + call RegPack(Buf, InData%r6) + if (RegCheckErr(Buf, RoutineName)) return + ! v6 + call RegPack(Buf, InData%v6) + if (RegCheckErr(Buf, RoutineName)) return + ! a6 + call RegPack(Buf, InData%a6) + if (RegCheckErr(Buf, RoutineName)) return + ! U + call RegPack(Buf, InData%U) + if (RegCheckErr(Buf, RoutineName)) return + ! Ud + call RegPack(Buf, InData%Ud) + if (RegCheckErr(Buf, RoutineName)) return + ! zeta + call RegPack(Buf, InData%zeta) + if (RegCheckErr(Buf, RoutineName)) return + ! F6net + call RegPack(Buf, InData%F6net) + if (RegCheckErr(Buf, RoutineName)) return + ! M6net + call RegPack(Buf, InData%M6net) + if (RegCheckErr(Buf, RoutineName)) return + ! M + call RegPack(Buf, InData%M) + if (RegCheckErr(Buf, RoutineName)) return + ! M0 + call RegPack(Buf, InData%M0) + if (RegCheckErr(Buf, RoutineName)) return + ! OrMat + call RegPack(Buf, InData%OrMat) + if (RegCheckErr(Buf, RoutineName)) return + ! rCG + call RegPack(Buf, InData%rCG) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_UnPackBody(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MD_Body), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackBody' + if (Buf%ErrStat /= ErrID_None) return + ! IdNum + call RegUnpack(Buf, OutData%IdNum) + if (RegCheckErr(Buf, RoutineName)) return + ! typeNum + call RegUnpack(Buf, OutData%typeNum) + if (RegCheckErr(Buf, RoutineName)) return + ! AttachedC + call RegUnpack(Buf, OutData%AttachedC) + if (RegCheckErr(Buf, RoutineName)) return + ! AttachedR + call RegUnpack(Buf, OutData%AttachedR) + if (RegCheckErr(Buf, RoutineName)) return + ! nAttachedC + call RegUnpack(Buf, OutData%nAttachedC) + if (RegCheckErr(Buf, RoutineName)) return + ! nAttachedR + call RegUnpack(Buf, OutData%nAttachedR) + if (RegCheckErr(Buf, RoutineName)) return + ! rConnectRel + call RegUnpack(Buf, OutData%rConnectRel) + if (RegCheckErr(Buf, RoutineName)) return + ! r6RodRel + call RegUnpack(Buf, OutData%r6RodRel) + if (RegCheckErr(Buf, RoutineName)) return + ! bodyM + call RegUnpack(Buf, OutData%bodyM) + if (RegCheckErr(Buf, RoutineName)) return + ! bodyV + call RegUnpack(Buf, OutData%bodyV) + if (RegCheckErr(Buf, RoutineName)) return + ! bodyI + call RegUnpack(Buf, OutData%bodyI) + if (RegCheckErr(Buf, RoutineName)) return + ! bodyCdA + call RegUnpack(Buf, OutData%bodyCdA) + if (RegCheckErr(Buf, RoutineName)) return + ! bodyCa + call RegUnpack(Buf, OutData%bodyCa) + if (RegCheckErr(Buf, RoutineName)) return + ! time + call RegUnpack(Buf, OutData%time) + if (RegCheckErr(Buf, RoutineName)) return + ! r6 + call RegUnpack(Buf, OutData%r6) + if (RegCheckErr(Buf, RoutineName)) return + ! v6 + call RegUnpack(Buf, OutData%v6) + if (RegCheckErr(Buf, RoutineName)) return + ! a6 + call RegUnpack(Buf, OutData%a6) + if (RegCheckErr(Buf, RoutineName)) return + ! U + call RegUnpack(Buf, OutData%U) + if (RegCheckErr(Buf, RoutineName)) return + ! Ud + call RegUnpack(Buf, OutData%Ud) + if (RegCheckErr(Buf, RoutineName)) return + ! zeta + call RegUnpack(Buf, OutData%zeta) + if (RegCheckErr(Buf, RoutineName)) return + ! F6net + call RegUnpack(Buf, OutData%F6net) + if (RegCheckErr(Buf, RoutineName)) return + ! M6net + call RegUnpack(Buf, OutData%M6net) + if (RegCheckErr(Buf, RoutineName)) return + ! M + call RegUnpack(Buf, OutData%M) + if (RegCheckErr(Buf, RoutineName)) return + ! M0 + call RegUnpack(Buf, OutData%M0) + if (RegCheckErr(Buf, RoutineName)) return + ! OrMat + call RegUnpack(Buf, OutData%OrMat) + if (RegCheckErr(Buf, RoutineName)) return + ! rCG + call RegUnpack(Buf, OutData%rCG) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE MD_CopyConnect( SrcConnectData, DstConnectData, CtrlCode, ErrStat, ErrMsg ) TYPE(MD_Connect), INTENT(IN) :: SrcConnectData TYPE(MD_Connect), INTENT(INOUT) :: DstConnectData @@ -2069,312 +1401,177 @@ SUBROUTINE MD_DestroyConnect( ConnectData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE MD_DestroyConnect - SUBROUTINE MD_PackConnect( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MD_Connect), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackConnect' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! IdNum - Int_BufSz = Int_BufSz + 1*LEN(InData%type) ! type - Int_BufSz = Int_BufSz + 1 ! typeNum - Int_BufSz = Int_BufSz + SIZE(InData%Attached) ! Attached - Int_BufSz = Int_BufSz + SIZE(InData%Top) ! Top - Int_BufSz = Int_BufSz + 1 ! nAttached - Db_BufSz = Db_BufSz + 1 ! conM - Db_BufSz = Db_BufSz + 1 ! conV - Db_BufSz = Db_BufSz + 1 ! conFX - Db_BufSz = Db_BufSz + 1 ! conFY - Db_BufSz = Db_BufSz + 1 ! conFZ - Db_BufSz = Db_BufSz + 1 ! conCa - Db_BufSz = Db_BufSz + 1 ! conCdA - Db_BufSz = Db_BufSz + 1 ! time - Db_BufSz = Db_BufSz + SIZE(InData%r) ! r - Db_BufSz = Db_BufSz + SIZE(InData%rd) ! rd - Db_BufSz = Db_BufSz + SIZE(InData%a) ! a - Db_BufSz = Db_BufSz + SIZE(InData%U) ! U - Db_BufSz = Db_BufSz + SIZE(InData%Ud) ! Ud - Db_BufSz = Db_BufSz + 1 ! zeta - Int_BufSz = Int_BufSz + 1 ! PDyn allocated yes/no - IF ( ALLOCATED(InData%PDyn) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PDyn upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%PDyn) ! PDyn - END IF - Db_BufSz = Db_BufSz + SIZE(InData%Fnet) ! Fnet - Db_BufSz = Db_BufSz + SIZE(InData%M) ! M - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%IdNum - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%type) - IntKiBuf(Int_Xferred) = ICHAR(InData%type(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%typeNum - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%Attached,1), UBOUND(InData%Attached,1) - IntKiBuf(Int_Xferred) = InData%Attached(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%Top,1), UBOUND(InData%Top,1) - IntKiBuf(Int_Xferred) = InData%Top(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%nAttached - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%conM - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%conV - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%conFX - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%conFY - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%conFZ - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%conCa - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%conCdA - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%time - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%r,1), UBOUND(InData%r,1) - DbKiBuf(Db_Xferred) = InData%r(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%rd,1), UBOUND(InData%rd,1) - DbKiBuf(Db_Xferred) = InData%rd(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%a,1), UBOUND(InData%a,1) - DbKiBuf(Db_Xferred) = InData%a(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%U,1), UBOUND(InData%U,1) - DbKiBuf(Db_Xferred) = InData%U(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%Ud,1), UBOUND(InData%Ud,1) - DbKiBuf(Db_Xferred) = InData%Ud(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DbKiBuf(Db_Xferred) = InData%zeta - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%PDyn) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PDyn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PDyn,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PDyn,1), UBOUND(InData%PDyn,1) - DbKiBuf(Db_Xferred) = InData%PDyn(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - DO i1 = LBOUND(InData%Fnet,1), UBOUND(InData%Fnet,1) - DbKiBuf(Db_Xferred) = InData%Fnet(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i2 = LBOUND(InData%M,2), UBOUND(InData%M,2) - DO i1 = LBOUND(InData%M,1), UBOUND(InData%M,1) - DbKiBuf(Db_Xferred) = InData%M(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END SUBROUTINE MD_PackConnect - - SUBROUTINE MD_UnPackConnect( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MD_Connect), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackConnect' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%IdNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%type) - OutData%type(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%typeNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%Attached,1) - i1_u = UBOUND(OutData%Attached,1) - DO i1 = LBOUND(OutData%Attached,1), UBOUND(OutData%Attached,1) - OutData%Attached(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%Top,1) - i1_u = UBOUND(OutData%Top,1) - DO i1 = LBOUND(OutData%Top,1), UBOUND(OutData%Top,1) - OutData%Top(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%nAttached = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%conM = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%conV = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%conFX = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%conFY = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%conFZ = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%conCa = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%conCdA = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%time = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%r,1) - i1_u = UBOUND(OutData%r,1) - DO i1 = LBOUND(OutData%r,1), UBOUND(OutData%r,1) - OutData%r(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%rd,1) - i1_u = UBOUND(OutData%rd,1) - DO i1 = LBOUND(OutData%rd,1), UBOUND(OutData%rd,1) - OutData%rd(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%a,1) - i1_u = UBOUND(OutData%a,1) - DO i1 = LBOUND(OutData%a,1), UBOUND(OutData%a,1) - OutData%a(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%U,1) - i1_u = UBOUND(OutData%U,1) - DO i1 = LBOUND(OutData%U,1), UBOUND(OutData%U,1) - OutData%U(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%Ud,1) - i1_u = UBOUND(OutData%Ud,1) - DO i1 = LBOUND(OutData%Ud,1), UBOUND(OutData%Ud,1) - OutData%Ud(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - OutData%zeta = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PDyn not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PDyn)) DEALLOCATE(OutData%PDyn) - ALLOCATE(OutData%PDyn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PDyn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PDyn,1), UBOUND(OutData%PDyn,1) - OutData%PDyn(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - i1_l = LBOUND(OutData%Fnet,1) - i1_u = UBOUND(OutData%Fnet,1) - DO i1 = LBOUND(OutData%Fnet,1), UBOUND(OutData%Fnet,1) - OutData%Fnet(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%M,1) - i1_u = UBOUND(OutData%M,1) - i2_l = LBOUND(OutData%M,2) - i2_u = UBOUND(OutData%M,2) - DO i2 = LBOUND(OutData%M,2), UBOUND(OutData%M,2) - DO i1 = LBOUND(OutData%M,1), UBOUND(OutData%M,1) - OutData%M(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END SUBROUTINE MD_UnPackConnect +subroutine MD_PackConnect(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MD_Connect), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackConnect' + if (Buf%ErrStat >= AbortErrLev) return + ! IdNum + call RegPack(Buf, InData%IdNum) + if (RegCheckErr(Buf, RoutineName)) return + ! type + call RegPack(Buf, InData%type) + if (RegCheckErr(Buf, RoutineName)) return + ! typeNum + call RegPack(Buf, InData%typeNum) + if (RegCheckErr(Buf, RoutineName)) return + ! Attached + call RegPack(Buf, InData%Attached) + if (RegCheckErr(Buf, RoutineName)) return + ! Top + call RegPack(Buf, InData%Top) + if (RegCheckErr(Buf, RoutineName)) return + ! nAttached + call RegPack(Buf, InData%nAttached) + if (RegCheckErr(Buf, RoutineName)) return + ! conM + call RegPack(Buf, InData%conM) + if (RegCheckErr(Buf, RoutineName)) return + ! conV + call RegPack(Buf, InData%conV) + if (RegCheckErr(Buf, RoutineName)) return + ! conFX + call RegPack(Buf, InData%conFX) + if (RegCheckErr(Buf, RoutineName)) return + ! conFY + call RegPack(Buf, InData%conFY) + if (RegCheckErr(Buf, RoutineName)) return + ! conFZ + call RegPack(Buf, InData%conFZ) + if (RegCheckErr(Buf, RoutineName)) return + ! conCa + call RegPack(Buf, InData%conCa) + if (RegCheckErr(Buf, RoutineName)) return + ! conCdA + call RegPack(Buf, InData%conCdA) + if (RegCheckErr(Buf, RoutineName)) return + ! time + call RegPack(Buf, InData%time) + if (RegCheckErr(Buf, RoutineName)) return + ! r + call RegPack(Buf, InData%r) + if (RegCheckErr(Buf, RoutineName)) return + ! rd + call RegPack(Buf, InData%rd) + if (RegCheckErr(Buf, RoutineName)) return + ! a + call RegPack(Buf, InData%a) + if (RegCheckErr(Buf, RoutineName)) return + ! U + call RegPack(Buf, InData%U) + if (RegCheckErr(Buf, RoutineName)) return + ! Ud + call RegPack(Buf, InData%Ud) + if (RegCheckErr(Buf, RoutineName)) return + ! zeta + call RegPack(Buf, InData%zeta) + if (RegCheckErr(Buf, RoutineName)) return + ! PDyn + call RegPack(Buf, allocated(InData%PDyn)) + if (allocated(InData%PDyn)) then + call RegPackBounds(Buf, 1, lbound(InData%PDyn), ubound(InData%PDyn)) + call RegPack(Buf, InData%PDyn) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Fnet + call RegPack(Buf, InData%Fnet) + if (RegCheckErr(Buf, RoutineName)) return + ! M + call RegPack(Buf, InData%M) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_UnPackConnect(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MD_Connect), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackConnect' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! IdNum + call RegUnpack(Buf, OutData%IdNum) + if (RegCheckErr(Buf, RoutineName)) return + ! type + call RegUnpack(Buf, OutData%type) + if (RegCheckErr(Buf, RoutineName)) return + ! typeNum + call RegUnpack(Buf, OutData%typeNum) + if (RegCheckErr(Buf, RoutineName)) return + ! Attached + call RegUnpack(Buf, OutData%Attached) + if (RegCheckErr(Buf, RoutineName)) return + ! Top + call RegUnpack(Buf, OutData%Top) + if (RegCheckErr(Buf, RoutineName)) return + ! nAttached + call RegUnpack(Buf, OutData%nAttached) + if (RegCheckErr(Buf, RoutineName)) return + ! conM + call RegUnpack(Buf, OutData%conM) + if (RegCheckErr(Buf, RoutineName)) return + ! conV + call RegUnpack(Buf, OutData%conV) + if (RegCheckErr(Buf, RoutineName)) return + ! conFX + call RegUnpack(Buf, OutData%conFX) + if (RegCheckErr(Buf, RoutineName)) return + ! conFY + call RegUnpack(Buf, OutData%conFY) + if (RegCheckErr(Buf, RoutineName)) return + ! conFZ + call RegUnpack(Buf, OutData%conFZ) + if (RegCheckErr(Buf, RoutineName)) return + ! conCa + call RegUnpack(Buf, OutData%conCa) + if (RegCheckErr(Buf, RoutineName)) return + ! conCdA + call RegUnpack(Buf, OutData%conCdA) + if (RegCheckErr(Buf, RoutineName)) return + ! time + call RegUnpack(Buf, OutData%time) + if (RegCheckErr(Buf, RoutineName)) return + ! r + call RegUnpack(Buf, OutData%r) + if (RegCheckErr(Buf, RoutineName)) return + ! rd + call RegUnpack(Buf, OutData%rd) + if (RegCheckErr(Buf, RoutineName)) return + ! a + call RegUnpack(Buf, OutData%a) + if (RegCheckErr(Buf, RoutineName)) return + ! U + call RegUnpack(Buf, OutData%U) + if (RegCheckErr(Buf, RoutineName)) return + ! Ud + call RegUnpack(Buf, OutData%Ud) + if (RegCheckErr(Buf, RoutineName)) return + ! zeta + call RegUnpack(Buf, OutData%zeta) + if (RegCheckErr(Buf, RoutineName)) return + ! PDyn + if (allocated(OutData%PDyn)) deallocate(OutData%PDyn) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PDyn(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PDyn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PDyn) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Fnet + call RegUnpack(Buf, OutData%Fnet) + if (RegCheckErr(Buf, RoutineName)) return + ! M + call RegUnpack(Buf, OutData%M) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE MD_CopyRod( SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg ) TYPE(MD_Rod), INTENT(IN) :: SrcRodData TYPE(MD_Rod), INTENT(INOUT) :: DstRodData @@ -2763,1274 +1960,675 @@ SUBROUTINE MD_DestroyRod( RodData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE MD_DestroyRod - SUBROUTINE MD_PackRod( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MD_Rod), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackRod' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! IdNum - Int_BufSz = Int_BufSz + 1*LEN(InData%type) ! type - Int_BufSz = Int_BufSz + 1 ! PropsIdNum - Int_BufSz = Int_BufSz + 1 ! typeNum - Int_BufSz = Int_BufSz + SIZE(InData%AttachedA) ! AttachedA - Int_BufSz = Int_BufSz + SIZE(InData%AttachedB) ! AttachedB - Int_BufSz = Int_BufSz + SIZE(InData%TopA) ! TopA - Int_BufSz = Int_BufSz + SIZE(InData%TopB) ! TopB - Int_BufSz = Int_BufSz + 1 ! nAttachedA - Int_BufSz = Int_BufSz + 1 ! nAttachedB - Int_BufSz = Int_BufSz + SIZE(InData%OutFlagList) ! OutFlagList - Int_BufSz = Int_BufSz + 1 ! N - Int_BufSz = Int_BufSz + 1 ! endTypeA - Int_BufSz = Int_BufSz + 1 ! endTypeB - Db_BufSz = Db_BufSz + 1 ! UnstrLen - Db_BufSz = Db_BufSz + 1 ! mass - Db_BufSz = Db_BufSz + 1 ! rho - Db_BufSz = Db_BufSz + 1 ! d - Db_BufSz = Db_BufSz + 1 ! Can - Db_BufSz = Db_BufSz + 1 ! Cat - Db_BufSz = Db_BufSz + 1 ! Cdn - Db_BufSz = Db_BufSz + 1 ! Cdt - Db_BufSz = Db_BufSz + 1 ! CdEnd - Db_BufSz = Db_BufSz + 1 ! CaEnd - Db_BufSz = Db_BufSz + 1 ! time - Db_BufSz = Db_BufSz + 1 ! roll - Db_BufSz = Db_BufSz + 1 ! pitch - Db_BufSz = Db_BufSz + 1 ! h0 - Int_BufSz = Int_BufSz + 1 ! r allocated yes/no - IF ( ALLOCATED(InData%r) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! r upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%r) ! r - END IF - Int_BufSz = Int_BufSz + 1 ! rd allocated yes/no - IF ( ALLOCATED(InData%rd) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! rd upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%rd) ! rd - END IF - Db_BufSz = Db_BufSz + SIZE(InData%q) ! q - Int_BufSz = Int_BufSz + 1 ! l allocated yes/no - IF ( ALLOCATED(InData%l) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! l upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%l) ! l - END IF - Int_BufSz = Int_BufSz + 1 ! V allocated yes/no - IF ( ALLOCATED(InData%V) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! V upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%V) ! V - END IF - Int_BufSz = Int_BufSz + 1 ! U allocated yes/no - IF ( ALLOCATED(InData%U) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! U upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%U) ! U - END IF - Int_BufSz = Int_BufSz + 1 ! Ud allocated yes/no - IF ( ALLOCATED(InData%Ud) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Ud upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Ud) ! Ud - END IF - Int_BufSz = Int_BufSz + 1 ! zeta allocated yes/no - IF ( ALLOCATED(InData%zeta) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! zeta upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%zeta) ! zeta - END IF - Int_BufSz = Int_BufSz + 1 ! PDyn allocated yes/no - IF ( ALLOCATED(InData%PDyn) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PDyn upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%PDyn) ! PDyn - END IF - Int_BufSz = Int_BufSz + 1 ! W allocated yes/no - IF ( ALLOCATED(InData%W) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! W upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%W) ! W - END IF - Int_BufSz = Int_BufSz + 1 ! Bo allocated yes/no - IF ( ALLOCATED(InData%Bo) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Bo upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Bo) ! Bo - END IF - Int_BufSz = Int_BufSz + 1 ! Pd allocated yes/no - IF ( ALLOCATED(InData%Pd) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Pd upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Pd) ! Pd - END IF - Int_BufSz = Int_BufSz + 1 ! Dp allocated yes/no - IF ( ALLOCATED(InData%Dp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Dp upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Dp) ! Dp - END IF - Int_BufSz = Int_BufSz + 1 ! Dq allocated yes/no - IF ( ALLOCATED(InData%Dq) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Dq upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Dq) ! Dq - END IF - Int_BufSz = Int_BufSz + 1 ! Ap allocated yes/no - IF ( ALLOCATED(InData%Ap) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Ap upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Ap) ! Ap - END IF - Int_BufSz = Int_BufSz + 1 ! Aq allocated yes/no - IF ( ALLOCATED(InData%Aq) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Aq upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Aq) ! Aq - END IF - Int_BufSz = Int_BufSz + 1 ! B allocated yes/no - IF ( ALLOCATED(InData%B) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! B upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%B) ! B - END IF - Int_BufSz = Int_BufSz + 1 ! Fnet allocated yes/no - IF ( ALLOCATED(InData%Fnet) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Fnet upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fnet) ! Fnet - END IF - Int_BufSz = Int_BufSz + 1 ! M allocated yes/no - IF ( ALLOCATED(InData%M) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! M upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%M) ! M - END IF - Db_BufSz = Db_BufSz + SIZE(InData%FextA) ! FextA - Db_BufSz = Db_BufSz + SIZE(InData%FextB) ! FextB - Db_BufSz = Db_BufSz + SIZE(InData%Mext) ! Mext - Db_BufSz = Db_BufSz + SIZE(InData%r6) ! r6 - Db_BufSz = Db_BufSz + SIZE(InData%v6) ! v6 - Db_BufSz = Db_BufSz + SIZE(InData%a6) ! a6 - Db_BufSz = Db_BufSz + SIZE(InData%F6net) ! F6net - Db_BufSz = Db_BufSz + SIZE(InData%M6net) ! M6net - Db_BufSz = Db_BufSz + SIZE(InData%OrMat) ! OrMat - Int_BufSz = Int_BufSz + 1 ! RodUnOut - Int_BufSz = Int_BufSz + 1 ! RodWrOutput allocated yes/no - IF ( ALLOCATED(InData%RodWrOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RodWrOutput upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%RodWrOutput) ! RodWrOutput - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%IdNum - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%type) - IntKiBuf(Int_Xferred) = ICHAR(InData%type(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%PropsIdNum - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%typeNum - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%AttachedA,1), UBOUND(InData%AttachedA,1) - IntKiBuf(Int_Xferred) = InData%AttachedA(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%AttachedB,1), UBOUND(InData%AttachedB,1) - IntKiBuf(Int_Xferred) = InData%AttachedB(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TopA,1), UBOUND(InData%TopA,1) - IntKiBuf(Int_Xferred) = InData%TopA(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TopB,1), UBOUND(InData%TopB,1) - IntKiBuf(Int_Xferred) = InData%TopB(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%nAttachedA - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nAttachedB - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%OutFlagList,1), UBOUND(InData%OutFlagList,1) - IntKiBuf(Int_Xferred) = InData%OutFlagList(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%N - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%endTypeA - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%endTypeB - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%UnstrLen - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%mass - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%rho - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%d - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Can - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Cat - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Cdn - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Cdt - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CdEnd - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%CaEnd - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%time - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%roll - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%pitch - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%h0 - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%r) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%r,2), UBOUND(InData%r,2) - DO i1 = LBOUND(InData%r,1), UBOUND(InData%r,1) - DbKiBuf(Db_Xferred) = InData%r(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rd,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%rd,2), UBOUND(InData%rd,2) - DO i1 = LBOUND(InData%rd,1), UBOUND(InData%rd,1) - DbKiBuf(Db_Xferred) = InData%rd(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - DO i1 = LBOUND(InData%q,1), UBOUND(InData%q,1) - DbKiBuf(Db_Xferred) = InData%q(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%l) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%l,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%l,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%l,1), UBOUND(InData%l,1) - DbKiBuf(Db_Xferred) = InData%l(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%V) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%V,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%V,1), UBOUND(InData%V,1) - DbKiBuf(Db_Xferred) = InData%V(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%U) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%U,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%U,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%U,2), UBOUND(InData%U,2) - DO i1 = LBOUND(InData%U,1), UBOUND(InData%U,1) - DbKiBuf(Db_Xferred) = InData%U(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Ud) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ud,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ud,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ud,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ud,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Ud,2), UBOUND(InData%Ud,2) - DO i1 = LBOUND(InData%Ud,1), UBOUND(InData%Ud,1) - DbKiBuf(Db_Xferred) = InData%Ud(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%zeta) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%zeta,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zeta,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%zeta,1), UBOUND(InData%zeta,1) - DbKiBuf(Db_Xferred) = InData%zeta(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PDyn) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PDyn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PDyn,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PDyn,1), UBOUND(InData%PDyn,1) - DbKiBuf(Db_Xferred) = InData%PDyn(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%W) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%W,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%W,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%W,2), UBOUND(InData%W,2) - DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) - DbKiBuf(Db_Xferred) = InData%W(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Bo) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Bo,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Bo,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Bo,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Bo,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Bo,2), UBOUND(InData%Bo,2) - DO i1 = LBOUND(InData%Bo,1), UBOUND(InData%Bo,1) - DbKiBuf(Db_Xferred) = InData%Bo(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Pd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Pd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pd,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Pd,2), UBOUND(InData%Pd,2) - DO i1 = LBOUND(InData%Pd,1), UBOUND(InData%Pd,1) - DbKiBuf(Db_Xferred) = InData%Pd(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Dp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Dp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Dp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Dp,2), UBOUND(InData%Dp,2) - DO i1 = LBOUND(InData%Dp,1), UBOUND(InData%Dp,1) - DbKiBuf(Db_Xferred) = InData%Dp(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Dq) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Dq,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dq,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Dq,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dq,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Dq,2), UBOUND(InData%Dq,2) - DO i1 = LBOUND(InData%Dq,1), UBOUND(InData%Dq,1) - DbKiBuf(Db_Xferred) = InData%Dq(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Ap) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ap,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ap,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ap,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ap,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Ap,2), UBOUND(InData%Ap,2) - DO i1 = LBOUND(InData%Ap,1), UBOUND(InData%Ap,1) - DbKiBuf(Db_Xferred) = InData%Ap(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Aq) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Aq,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Aq,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Aq,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Aq,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Aq,2), UBOUND(InData%Aq,2) - DO i1 = LBOUND(InData%Aq,1), UBOUND(InData%Aq,1) - DbKiBuf(Db_Xferred) = InData%Aq(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%B) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%B,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%B,2), UBOUND(InData%B,2) - DO i1 = LBOUND(InData%B,1), UBOUND(InData%B,1) - DbKiBuf(Db_Xferred) = InData%B(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Fnet) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fnet,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fnet,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fnet,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fnet,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Fnet,2), UBOUND(InData%Fnet,2) - DO i1 = LBOUND(InData%Fnet,1), UBOUND(InData%Fnet,1) - DbKiBuf(Db_Xferred) = InData%Fnet(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%M) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%M,3), UBOUND(InData%M,3) - DO i2 = LBOUND(InData%M,2), UBOUND(InData%M,2) - DO i1 = LBOUND(InData%M,1), UBOUND(InData%M,1) - DbKiBuf(Db_Xferred) = InData%M(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%FextA,1), UBOUND(InData%FextA,1) - DbKiBuf(Db_Xferred) = InData%FextA(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%FextB,1), UBOUND(InData%FextB,1) - DbKiBuf(Db_Xferred) = InData%FextB(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%Mext,1), UBOUND(InData%Mext,1) - DbKiBuf(Db_Xferred) = InData%Mext(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%r6,1), UBOUND(InData%r6,1) - DbKiBuf(Db_Xferred) = InData%r6(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%v6,1), UBOUND(InData%v6,1) - DbKiBuf(Db_Xferred) = InData%v6(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%a6,1), UBOUND(InData%a6,1) - DbKiBuf(Db_Xferred) = InData%a6(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%F6net,1), UBOUND(InData%F6net,1) - DbKiBuf(Db_Xferred) = InData%F6net(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i2 = LBOUND(InData%M6net,2), UBOUND(InData%M6net,2) - DO i1 = LBOUND(InData%M6net,1), UBOUND(InData%M6net,1) - DbKiBuf(Db_Xferred) = InData%M6net(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%OrMat,2), UBOUND(InData%OrMat,2) - DO i1 = LBOUND(InData%OrMat,1), UBOUND(InData%OrMat,1) - DbKiBuf(Db_Xferred) = InData%OrMat(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - IntKiBuf(Int_Xferred) = InData%RodUnOut - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%RodWrOutput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RodWrOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RodWrOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RodWrOutput,1), UBOUND(InData%RodWrOutput,1) - DbKiBuf(Db_Xferred) = InData%RodWrOutput(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_PackRod - - SUBROUTINE MD_UnPackRod( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MD_Rod), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackRod' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%IdNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%type) - OutData%type(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%PropsIdNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%typeNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%AttachedA,1) - i1_u = UBOUND(OutData%AttachedA,1) - DO i1 = LBOUND(OutData%AttachedA,1), UBOUND(OutData%AttachedA,1) - OutData%AttachedA(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%AttachedB,1) - i1_u = UBOUND(OutData%AttachedB,1) - DO i1 = LBOUND(OutData%AttachedB,1), UBOUND(OutData%AttachedB,1) - OutData%AttachedB(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TopA,1) - i1_u = UBOUND(OutData%TopA,1) - DO i1 = LBOUND(OutData%TopA,1), UBOUND(OutData%TopA,1) - OutData%TopA(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TopB,1) - i1_u = UBOUND(OutData%TopB,1) - DO i1 = LBOUND(OutData%TopB,1), UBOUND(OutData%TopB,1) - OutData%TopB(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%nAttachedA = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nAttachedB = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%OutFlagList,1) - i1_u = UBOUND(OutData%OutFlagList,1) - DO i1 = LBOUND(OutData%OutFlagList,1), UBOUND(OutData%OutFlagList,1) - OutData%OutFlagList(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%N = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%endTypeA = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%endTypeB = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UnstrLen = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%mass = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%rho = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%d = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Can = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Cat = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Cdn = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Cdt = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%CdEnd = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%CaEnd = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%time = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%roll = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%pitch = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%h0 = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%r)) DEALLOCATE(OutData%r) - ALLOCATE(OutData%r(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%r.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%r,2), UBOUND(OutData%r,2) - DO i1 = LBOUND(OutData%r,1), UBOUND(OutData%r,1) - OutData%r(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rd not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rd)) DEALLOCATE(OutData%rd) - ALLOCATE(OutData%rd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%rd,2), UBOUND(OutData%rd,2) - DO i1 = LBOUND(OutData%rd,1), UBOUND(OutData%rd,1) - OutData%rd(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%q,1) - i1_u = UBOUND(OutData%q,1) - DO i1 = LBOUND(OutData%q,1), UBOUND(OutData%q,1) - OutData%q(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! l not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%l)) DEALLOCATE(OutData%l) - ALLOCATE(OutData%l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%l,1), UBOUND(OutData%l,1) - OutData%l(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! V not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%V)) DEALLOCATE(OutData%V) - ALLOCATE(OutData%V(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%V.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%V,1), UBOUND(OutData%V,1) - OutData%V(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! U not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%U)) DEALLOCATE(OutData%U) - ALLOCATE(OutData%U(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%U,2), UBOUND(OutData%U,2) - DO i1 = LBOUND(OutData%U,1), UBOUND(OutData%U,1) - OutData%U(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ud not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Ud)) DEALLOCATE(OutData%Ud) - ALLOCATE(OutData%Ud(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ud.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Ud,2), UBOUND(OutData%Ud,2) - DO i1 = LBOUND(OutData%Ud,1), UBOUND(OutData%Ud,1) - OutData%Ud(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! zeta not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%zeta)) DEALLOCATE(OutData%zeta) - ALLOCATE(OutData%zeta(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%zeta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%zeta,1), UBOUND(OutData%zeta,1) - OutData%zeta(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PDyn not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PDyn)) DEALLOCATE(OutData%PDyn) - ALLOCATE(OutData%PDyn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PDyn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PDyn,1), UBOUND(OutData%PDyn,1) - OutData%PDyn(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! W not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%W)) DEALLOCATE(OutData%W) - ALLOCATE(OutData%W(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%W,2), UBOUND(OutData%W,2) - DO i1 = LBOUND(OutData%W,1), UBOUND(OutData%W,1) - OutData%W(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Bo not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Bo)) DEALLOCATE(OutData%Bo) - ALLOCATE(OutData%Bo(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Bo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Bo,2), UBOUND(OutData%Bo,2) - DO i1 = LBOUND(OutData%Bo,1), UBOUND(OutData%Bo,1) - OutData%Bo(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Pd not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Pd)) DEALLOCATE(OutData%Pd) - ALLOCATE(OutData%Pd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Pd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Pd,2), UBOUND(OutData%Pd,2) - DO i1 = LBOUND(OutData%Pd,1), UBOUND(OutData%Pd,1) - OutData%Pd(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Dp not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Dp)) DEALLOCATE(OutData%Dp) - ALLOCATE(OutData%Dp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Dp,2), UBOUND(OutData%Dp,2) - DO i1 = LBOUND(OutData%Dp,1), UBOUND(OutData%Dp,1) - OutData%Dp(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Dq not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Dq)) DEALLOCATE(OutData%Dq) - ALLOCATE(OutData%Dq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Dq,2), UBOUND(OutData%Dq,2) - DO i1 = LBOUND(OutData%Dq,1), UBOUND(OutData%Dq,1) - OutData%Dq(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ap not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Ap)) DEALLOCATE(OutData%Ap) - ALLOCATE(OutData%Ap(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ap.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Ap,2), UBOUND(OutData%Ap,2) - DO i1 = LBOUND(OutData%Ap,1), UBOUND(OutData%Ap,1) - OutData%Ap(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Aq not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Aq)) DEALLOCATE(OutData%Aq) - ALLOCATE(OutData%Aq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Aq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Aq,2), UBOUND(OutData%Aq,2) - DO i1 = LBOUND(OutData%Aq,1), UBOUND(OutData%Aq,1) - OutData%Aq(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! B not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%B)) DEALLOCATE(OutData%B) - ALLOCATE(OutData%B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%B,2), UBOUND(OutData%B,2) - DO i1 = LBOUND(OutData%B,1), UBOUND(OutData%B,1) - OutData%B(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fnet not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Fnet)) DEALLOCATE(OutData%Fnet) - ALLOCATE(OutData%Fnet(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fnet.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Fnet,2), UBOUND(OutData%Fnet,2) - DO i1 = LBOUND(OutData%Fnet,1), UBOUND(OutData%Fnet,1) - OutData%Fnet(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%M)) DEALLOCATE(OutData%M) - ALLOCATE(OutData%M(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%M,3), UBOUND(OutData%M,3) - DO i2 = LBOUND(OutData%M,2), UBOUND(OutData%M,2) - DO i1 = LBOUND(OutData%M,1), UBOUND(OutData%M,1) - OutData%M(i1,i2,i3) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%FextA,1) - i1_u = UBOUND(OutData%FextA,1) - DO i1 = LBOUND(OutData%FextA,1), UBOUND(OutData%FextA,1) - OutData%FextA(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%FextB,1) - i1_u = UBOUND(OutData%FextB,1) - DO i1 = LBOUND(OutData%FextB,1), UBOUND(OutData%FextB,1) - OutData%FextB(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%Mext,1) - i1_u = UBOUND(OutData%Mext,1) - DO i1 = LBOUND(OutData%Mext,1), UBOUND(OutData%Mext,1) - OutData%Mext(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%r6,1) - i1_u = UBOUND(OutData%r6,1) - DO i1 = LBOUND(OutData%r6,1), UBOUND(OutData%r6,1) - OutData%r6(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%v6,1) - i1_u = UBOUND(OutData%v6,1) - DO i1 = LBOUND(OutData%v6,1), UBOUND(OutData%v6,1) - OutData%v6(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%a6,1) - i1_u = UBOUND(OutData%a6,1) - DO i1 = LBOUND(OutData%a6,1), UBOUND(OutData%a6,1) - OutData%a6(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%F6net,1) - i1_u = UBOUND(OutData%F6net,1) - DO i1 = LBOUND(OutData%F6net,1), UBOUND(OutData%F6net,1) - OutData%F6net(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%M6net,1) - i1_u = UBOUND(OutData%M6net,1) - i2_l = LBOUND(OutData%M6net,2) - i2_u = UBOUND(OutData%M6net,2) - DO i2 = LBOUND(OutData%M6net,2), UBOUND(OutData%M6net,2) - DO i1 = LBOUND(OutData%M6net,1), UBOUND(OutData%M6net,1) - OutData%M6net(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%OrMat,1) - i1_u = UBOUND(OutData%OrMat,1) - i2_l = LBOUND(OutData%OrMat,2) - i2_u = UBOUND(OutData%OrMat,2) - DO i2 = LBOUND(OutData%OrMat,2), UBOUND(OutData%OrMat,2) - DO i1 = LBOUND(OutData%OrMat,1), UBOUND(OutData%OrMat,1) - OutData%OrMat(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - OutData%RodUnOut = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RodWrOutput not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RodWrOutput)) DEALLOCATE(OutData%RodWrOutput) - ALLOCATE(OutData%RodWrOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodWrOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RodWrOutput,1), UBOUND(OutData%RodWrOutput,1) - OutData%RodWrOutput(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_UnPackRod +subroutine MD_PackRod(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MD_Rod), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackRod' + if (Buf%ErrStat >= AbortErrLev) return + ! IdNum + call RegPack(Buf, InData%IdNum) + if (RegCheckErr(Buf, RoutineName)) return + ! type + call RegPack(Buf, InData%type) + if (RegCheckErr(Buf, RoutineName)) return + ! PropsIdNum + call RegPack(Buf, InData%PropsIdNum) + if (RegCheckErr(Buf, RoutineName)) return + ! typeNum + call RegPack(Buf, InData%typeNum) + if (RegCheckErr(Buf, RoutineName)) return + ! AttachedA + call RegPack(Buf, InData%AttachedA) + if (RegCheckErr(Buf, RoutineName)) return + ! AttachedB + call RegPack(Buf, InData%AttachedB) + if (RegCheckErr(Buf, RoutineName)) return + ! TopA + call RegPack(Buf, InData%TopA) + if (RegCheckErr(Buf, RoutineName)) return + ! TopB + call RegPack(Buf, InData%TopB) + if (RegCheckErr(Buf, RoutineName)) return + ! nAttachedA + call RegPack(Buf, InData%nAttachedA) + if (RegCheckErr(Buf, RoutineName)) return + ! nAttachedB + call RegPack(Buf, InData%nAttachedB) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFlagList + call RegPack(Buf, InData%OutFlagList) + if (RegCheckErr(Buf, RoutineName)) return + ! N + call RegPack(Buf, InData%N) + if (RegCheckErr(Buf, RoutineName)) return + ! endTypeA + call RegPack(Buf, InData%endTypeA) + if (RegCheckErr(Buf, RoutineName)) return + ! endTypeB + call RegPack(Buf, InData%endTypeB) + if (RegCheckErr(Buf, RoutineName)) return + ! UnstrLen + call RegPack(Buf, InData%UnstrLen) + if (RegCheckErr(Buf, RoutineName)) return + ! mass + call RegPack(Buf, InData%mass) + if (RegCheckErr(Buf, RoutineName)) return + ! rho + call RegPack(Buf, InData%rho) + if (RegCheckErr(Buf, RoutineName)) return + ! d + call RegPack(Buf, InData%d) + if (RegCheckErr(Buf, RoutineName)) return + ! Can + call RegPack(Buf, InData%Can) + if (RegCheckErr(Buf, RoutineName)) return + ! Cat + call RegPack(Buf, InData%Cat) + if (RegCheckErr(Buf, RoutineName)) return + ! Cdn + call RegPack(Buf, InData%Cdn) + if (RegCheckErr(Buf, RoutineName)) return + ! Cdt + call RegPack(Buf, InData%Cdt) + if (RegCheckErr(Buf, RoutineName)) return + ! CdEnd + call RegPack(Buf, InData%CdEnd) + if (RegCheckErr(Buf, RoutineName)) return + ! CaEnd + call RegPack(Buf, InData%CaEnd) + if (RegCheckErr(Buf, RoutineName)) return + ! time + call RegPack(Buf, InData%time) + if (RegCheckErr(Buf, RoutineName)) return + ! roll + call RegPack(Buf, InData%roll) + if (RegCheckErr(Buf, RoutineName)) return + ! pitch + call RegPack(Buf, InData%pitch) + if (RegCheckErr(Buf, RoutineName)) return + ! h0 + call RegPack(Buf, InData%h0) + if (RegCheckErr(Buf, RoutineName)) return + ! r + call RegPack(Buf, allocated(InData%r)) + if (allocated(InData%r)) then + call RegPackBounds(Buf, 2, lbound(InData%r), ubound(InData%r)) + call RegPack(Buf, InData%r) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! rd + call RegPack(Buf, allocated(InData%rd)) + if (allocated(InData%rd)) then + call RegPackBounds(Buf, 2, lbound(InData%rd), ubound(InData%rd)) + call RegPack(Buf, InData%rd) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! q + call RegPack(Buf, InData%q) + if (RegCheckErr(Buf, RoutineName)) return + ! l + call RegPack(Buf, allocated(InData%l)) + if (allocated(InData%l)) then + call RegPackBounds(Buf, 1, lbound(InData%l), ubound(InData%l)) + call RegPack(Buf, InData%l) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! V + call RegPack(Buf, allocated(InData%V)) + if (allocated(InData%V)) then + call RegPackBounds(Buf, 1, lbound(InData%V), ubound(InData%V)) + call RegPack(Buf, InData%V) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! U + call RegPack(Buf, allocated(InData%U)) + if (allocated(InData%U)) then + call RegPackBounds(Buf, 2, lbound(InData%U), ubound(InData%U)) + call RegPack(Buf, InData%U) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Ud + call RegPack(Buf, allocated(InData%Ud)) + if (allocated(InData%Ud)) then + call RegPackBounds(Buf, 2, lbound(InData%Ud), ubound(InData%Ud)) + call RegPack(Buf, InData%Ud) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! zeta + call RegPack(Buf, allocated(InData%zeta)) + if (allocated(InData%zeta)) then + call RegPackBounds(Buf, 1, lbound(InData%zeta), ubound(InData%zeta)) + call RegPack(Buf, InData%zeta) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PDyn + call RegPack(Buf, allocated(InData%PDyn)) + if (allocated(InData%PDyn)) then + call RegPackBounds(Buf, 1, lbound(InData%PDyn), ubound(InData%PDyn)) + call RegPack(Buf, InData%PDyn) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! W + call RegPack(Buf, allocated(InData%W)) + if (allocated(InData%W)) then + call RegPackBounds(Buf, 2, lbound(InData%W), ubound(InData%W)) + call RegPack(Buf, InData%W) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Bo + call RegPack(Buf, allocated(InData%Bo)) + if (allocated(InData%Bo)) then + call RegPackBounds(Buf, 2, lbound(InData%Bo), ubound(InData%Bo)) + call RegPack(Buf, InData%Bo) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Pd + call RegPack(Buf, allocated(InData%Pd)) + if (allocated(InData%Pd)) then + call RegPackBounds(Buf, 2, lbound(InData%Pd), ubound(InData%Pd)) + call RegPack(Buf, InData%Pd) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Dp + call RegPack(Buf, allocated(InData%Dp)) + if (allocated(InData%Dp)) then + call RegPackBounds(Buf, 2, lbound(InData%Dp), ubound(InData%Dp)) + call RegPack(Buf, InData%Dp) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Dq + call RegPack(Buf, allocated(InData%Dq)) + if (allocated(InData%Dq)) then + call RegPackBounds(Buf, 2, lbound(InData%Dq), ubound(InData%Dq)) + call RegPack(Buf, InData%Dq) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Ap + call RegPack(Buf, allocated(InData%Ap)) + if (allocated(InData%Ap)) then + call RegPackBounds(Buf, 2, lbound(InData%Ap), ubound(InData%Ap)) + call RegPack(Buf, InData%Ap) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Aq + call RegPack(Buf, allocated(InData%Aq)) + if (allocated(InData%Aq)) then + call RegPackBounds(Buf, 2, lbound(InData%Aq), ubound(InData%Aq)) + call RegPack(Buf, InData%Aq) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! B + call RegPack(Buf, allocated(InData%B)) + if (allocated(InData%B)) then + call RegPackBounds(Buf, 2, lbound(InData%B), ubound(InData%B)) + call RegPack(Buf, InData%B) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Fnet + call RegPack(Buf, allocated(InData%Fnet)) + if (allocated(InData%Fnet)) then + call RegPackBounds(Buf, 2, lbound(InData%Fnet), ubound(InData%Fnet)) + call RegPack(Buf, InData%Fnet) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! M + call RegPack(Buf, allocated(InData%M)) + if (allocated(InData%M)) then + call RegPackBounds(Buf, 3, lbound(InData%M), ubound(InData%M)) + call RegPack(Buf, InData%M) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FextA + call RegPack(Buf, InData%FextA) + if (RegCheckErr(Buf, RoutineName)) return + ! FextB + call RegPack(Buf, InData%FextB) + if (RegCheckErr(Buf, RoutineName)) return + ! Mext + call RegPack(Buf, InData%Mext) + if (RegCheckErr(Buf, RoutineName)) return + ! r6 + call RegPack(Buf, InData%r6) + if (RegCheckErr(Buf, RoutineName)) return + ! v6 + call RegPack(Buf, InData%v6) + if (RegCheckErr(Buf, RoutineName)) return + ! a6 + call RegPack(Buf, InData%a6) + if (RegCheckErr(Buf, RoutineName)) return + ! F6net + call RegPack(Buf, InData%F6net) + if (RegCheckErr(Buf, RoutineName)) return + ! M6net + call RegPack(Buf, InData%M6net) + if (RegCheckErr(Buf, RoutineName)) return + ! OrMat + call RegPack(Buf, InData%OrMat) + if (RegCheckErr(Buf, RoutineName)) return + ! RodUnOut + call RegPack(Buf, InData%RodUnOut) + if (RegCheckErr(Buf, RoutineName)) return + ! RodWrOutput + call RegPack(Buf, allocated(InData%RodWrOutput)) + if (allocated(InData%RodWrOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%RodWrOutput), ubound(InData%RodWrOutput)) + call RegPack(Buf, InData%RodWrOutput) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_UnPackRod(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MD_Rod), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackRod' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! IdNum + call RegUnpack(Buf, OutData%IdNum) + if (RegCheckErr(Buf, RoutineName)) return + ! type + call RegUnpack(Buf, OutData%type) + if (RegCheckErr(Buf, RoutineName)) return + ! PropsIdNum + call RegUnpack(Buf, OutData%PropsIdNum) + if (RegCheckErr(Buf, RoutineName)) return + ! typeNum + call RegUnpack(Buf, OutData%typeNum) + if (RegCheckErr(Buf, RoutineName)) return + ! AttachedA + call RegUnpack(Buf, OutData%AttachedA) + if (RegCheckErr(Buf, RoutineName)) return + ! AttachedB + call RegUnpack(Buf, OutData%AttachedB) + if (RegCheckErr(Buf, RoutineName)) return + ! TopA + call RegUnpack(Buf, OutData%TopA) + if (RegCheckErr(Buf, RoutineName)) return + ! TopB + call RegUnpack(Buf, OutData%TopB) + if (RegCheckErr(Buf, RoutineName)) return + ! nAttachedA + call RegUnpack(Buf, OutData%nAttachedA) + if (RegCheckErr(Buf, RoutineName)) return + ! nAttachedB + call RegUnpack(Buf, OutData%nAttachedB) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFlagList + call RegUnpack(Buf, OutData%OutFlagList) + if (RegCheckErr(Buf, RoutineName)) return + ! N + call RegUnpack(Buf, OutData%N) + if (RegCheckErr(Buf, RoutineName)) return + ! endTypeA + call RegUnpack(Buf, OutData%endTypeA) + if (RegCheckErr(Buf, RoutineName)) return + ! endTypeB + call RegUnpack(Buf, OutData%endTypeB) + if (RegCheckErr(Buf, RoutineName)) return + ! UnstrLen + call RegUnpack(Buf, OutData%UnstrLen) + if (RegCheckErr(Buf, RoutineName)) return + ! mass + call RegUnpack(Buf, OutData%mass) + if (RegCheckErr(Buf, RoutineName)) return + ! rho + call RegUnpack(Buf, OutData%rho) + if (RegCheckErr(Buf, RoutineName)) return + ! d + call RegUnpack(Buf, OutData%d) + if (RegCheckErr(Buf, RoutineName)) return + ! Can + call RegUnpack(Buf, OutData%Can) + if (RegCheckErr(Buf, RoutineName)) return + ! Cat + call RegUnpack(Buf, OutData%Cat) + if (RegCheckErr(Buf, RoutineName)) return + ! Cdn + call RegUnpack(Buf, OutData%Cdn) + if (RegCheckErr(Buf, RoutineName)) return + ! Cdt + call RegUnpack(Buf, OutData%Cdt) + if (RegCheckErr(Buf, RoutineName)) return + ! CdEnd + call RegUnpack(Buf, OutData%CdEnd) + if (RegCheckErr(Buf, RoutineName)) return + ! CaEnd + call RegUnpack(Buf, OutData%CaEnd) + if (RegCheckErr(Buf, RoutineName)) return + ! time + call RegUnpack(Buf, OutData%time) + if (RegCheckErr(Buf, RoutineName)) return + ! roll + call RegUnpack(Buf, OutData%roll) + if (RegCheckErr(Buf, RoutineName)) return + ! pitch + call RegUnpack(Buf, OutData%pitch) + if (RegCheckErr(Buf, RoutineName)) return + ! h0 + call RegUnpack(Buf, OutData%h0) + if (RegCheckErr(Buf, RoutineName)) return + ! r + if (allocated(OutData%r)) deallocate(OutData%r) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%r(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%r.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%r) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! rd + if (allocated(OutData%rd)) deallocate(OutData%rd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rd(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rd) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! q + call RegUnpack(Buf, OutData%q) + if (RegCheckErr(Buf, RoutineName)) return + ! l + if (allocated(OutData%l)) deallocate(OutData%l) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%l(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%l.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%l) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! V + if (allocated(OutData%V)) deallocate(OutData%V) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%V(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%V.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%V) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! U + if (allocated(OutData%U)) deallocate(OutData%U) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%U(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%U.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%U) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Ud + if (allocated(OutData%Ud)) deallocate(OutData%Ud) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Ud(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ud.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Ud) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! zeta + if (allocated(OutData%zeta)) deallocate(OutData%zeta) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%zeta(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%zeta.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%zeta) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PDyn + if (allocated(OutData%PDyn)) deallocate(OutData%PDyn) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PDyn(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PDyn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PDyn) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! W + if (allocated(OutData%W)) deallocate(OutData%W) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%W(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%W) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Bo + if (allocated(OutData%Bo)) deallocate(OutData%Bo) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Bo(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Bo.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Bo) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Pd + if (allocated(OutData%Pd)) deallocate(OutData%Pd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Pd(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Pd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Pd) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Dp + if (allocated(OutData%Dp)) deallocate(OutData%Dp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Dp(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Dp) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Dq + if (allocated(OutData%Dq)) deallocate(OutData%Dq) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Dq(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dq.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Dq) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Ap + if (allocated(OutData%Ap)) deallocate(OutData%Ap) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Ap(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ap.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Ap) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Aq + if (allocated(OutData%Aq)) deallocate(OutData%Aq) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Aq(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Aq.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Aq) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! B + if (allocated(OutData%B)) deallocate(OutData%B) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%B(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%B) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Fnet + if (allocated(OutData%Fnet)) deallocate(OutData%Fnet) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Fnet(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fnet.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Fnet) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! M + if (allocated(OutData%M)) deallocate(OutData%M) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%M(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%M.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%M) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! FextA + call RegUnpack(Buf, OutData%FextA) + if (RegCheckErr(Buf, RoutineName)) return + ! FextB + call RegUnpack(Buf, OutData%FextB) + if (RegCheckErr(Buf, RoutineName)) return + ! Mext + call RegUnpack(Buf, OutData%Mext) + if (RegCheckErr(Buf, RoutineName)) return + ! r6 + call RegUnpack(Buf, OutData%r6) + if (RegCheckErr(Buf, RoutineName)) return + ! v6 + call RegUnpack(Buf, OutData%v6) + if (RegCheckErr(Buf, RoutineName)) return + ! a6 + call RegUnpack(Buf, OutData%a6) + if (RegCheckErr(Buf, RoutineName)) return + ! F6net + call RegUnpack(Buf, OutData%F6net) + if (RegCheckErr(Buf, RoutineName)) return + ! M6net + call RegUnpack(Buf, OutData%M6net) + if (RegCheckErr(Buf, RoutineName)) return + ! OrMat + call RegUnpack(Buf, OutData%OrMat) + if (RegCheckErr(Buf, RoutineName)) return + ! RodUnOut + call RegUnpack(Buf, OutData%RodUnOut) + if (RegCheckErr(Buf, RoutineName)) return + ! RodWrOutput + if (allocated(OutData%RodWrOutput)) deallocate(OutData%RodWrOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RodWrOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodWrOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RodWrOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE MD_CopyLine( SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg ) TYPE(MD_Line), INTENT(IN) :: SrcLineData TYPE(MD_Line), INTENT(INOUT) :: DstLineData @@ -4560,1723 +3158,901 @@ SUBROUTINE MD_DestroyLine( LineData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE MD_DestroyLine - SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MD_Line), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + +subroutine MD_PackLine(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MD_Line), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackLine' + if (Buf%ErrStat >= AbortErrLev) return + ! IdNum + call RegPack(Buf, InData%IdNum) + if (RegCheckErr(Buf, RoutineName)) return + ! PropsIdNum + call RegPack(Buf, InData%PropsIdNum) + if (RegCheckErr(Buf, RoutineName)) return + ! ElasticMod + call RegPack(Buf, InData%ElasticMod) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFlagList + call RegPack(Buf, InData%OutFlagList) + if (RegCheckErr(Buf, RoutineName)) return + ! CtrlChan + call RegPack(Buf, InData%CtrlChan) + if (RegCheckErr(Buf, RoutineName)) return + ! FairConnect + call RegPack(Buf, InData%FairConnect) + if (RegCheckErr(Buf, RoutineName)) return + ! AnchConnect + call RegPack(Buf, InData%AnchConnect) + if (RegCheckErr(Buf, RoutineName)) return + ! N + call RegPack(Buf, InData%N) + if (RegCheckErr(Buf, RoutineName)) return + ! endTypeA + call RegPack(Buf, InData%endTypeA) + if (RegCheckErr(Buf, RoutineName)) return + ! endTypeB + call RegPack(Buf, InData%endTypeB) + if (RegCheckErr(Buf, RoutineName)) return + ! UnstrLen + call RegPack(Buf, InData%UnstrLen) + if (RegCheckErr(Buf, RoutineName)) return + ! rho + call RegPack(Buf, InData%rho) + if (RegCheckErr(Buf, RoutineName)) return + ! d + call RegPack(Buf, InData%d) + if (RegCheckErr(Buf, RoutineName)) return + ! EA + call RegPack(Buf, InData%EA) + if (RegCheckErr(Buf, RoutineName)) return + ! EA_D + call RegPack(Buf, InData%EA_D) + if (RegCheckErr(Buf, RoutineName)) return + ! BA + call RegPack(Buf, InData%BA) + if (RegCheckErr(Buf, RoutineName)) return + ! BA_D + call RegPack(Buf, InData%BA_D) + if (RegCheckErr(Buf, RoutineName)) return + ! EI + call RegPack(Buf, InData%EI) + if (RegCheckErr(Buf, RoutineName)) return + ! Can + call RegPack(Buf, InData%Can) + if (RegCheckErr(Buf, RoutineName)) return + ! Cat + call RegPack(Buf, InData%Cat) + if (RegCheckErr(Buf, RoutineName)) return + ! Cdn + call RegPack(Buf, InData%Cdn) + if (RegCheckErr(Buf, RoutineName)) return + ! Cdt + call RegPack(Buf, InData%Cdt) + if (RegCheckErr(Buf, RoutineName)) return + ! nEApoints + call RegPack(Buf, InData%nEApoints) + if (RegCheckErr(Buf, RoutineName)) return + ! stiffXs + call RegPack(Buf, InData%stiffXs) + if (RegCheckErr(Buf, RoutineName)) return + ! stiffYs + call RegPack(Buf, InData%stiffYs) + if (RegCheckErr(Buf, RoutineName)) return + ! nBApoints + call RegPack(Buf, InData%nBApoints) + if (RegCheckErr(Buf, RoutineName)) return + ! dampXs + call RegPack(Buf, InData%dampXs) + if (RegCheckErr(Buf, RoutineName)) return + ! dampYs + call RegPack(Buf, InData%dampYs) + if (RegCheckErr(Buf, RoutineName)) return + ! nEIpoints + call RegPack(Buf, InData%nEIpoints) + if (RegCheckErr(Buf, RoutineName)) return + ! bstiffXs + call RegPack(Buf, InData%bstiffXs) + if (RegCheckErr(Buf, RoutineName)) return + ! bstiffYs + call RegPack(Buf, InData%bstiffYs) + if (RegCheckErr(Buf, RoutineName)) return + ! time + call RegPack(Buf, InData%time) + if (RegCheckErr(Buf, RoutineName)) return + ! r + call RegPack(Buf, allocated(InData%r)) + if (allocated(InData%r)) then + call RegPackBounds(Buf, 2, lbound(InData%r), ubound(InData%r)) + call RegPack(Buf, InData%r) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! rd + call RegPack(Buf, allocated(InData%rd)) + if (allocated(InData%rd)) then + call RegPackBounds(Buf, 2, lbound(InData%rd), ubound(InData%rd)) + call RegPack(Buf, InData%rd) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! q + call RegPack(Buf, allocated(InData%q)) + if (allocated(InData%q)) then + call RegPackBounds(Buf, 2, lbound(InData%q), ubound(InData%q)) + call RegPack(Buf, InData%q) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! qs + call RegPack(Buf, allocated(InData%qs)) + if (allocated(InData%qs)) then + call RegPackBounds(Buf, 2, lbound(InData%qs), ubound(InData%qs)) + call RegPack(Buf, InData%qs) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! l + call RegPack(Buf, allocated(InData%l)) + if (allocated(InData%l)) then + call RegPackBounds(Buf, 1, lbound(InData%l), ubound(InData%l)) + call RegPack(Buf, InData%l) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ld + call RegPack(Buf, allocated(InData%ld)) + if (allocated(InData%ld)) then + call RegPackBounds(Buf, 1, lbound(InData%ld), ubound(InData%ld)) + call RegPack(Buf, InData%ld) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! lstr + call RegPack(Buf, allocated(InData%lstr)) + if (allocated(InData%lstr)) then + call RegPackBounds(Buf, 1, lbound(InData%lstr), ubound(InData%lstr)) + call RegPack(Buf, InData%lstr) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! lstrd + call RegPack(Buf, allocated(InData%lstrd)) + if (allocated(InData%lstrd)) then + call RegPackBounds(Buf, 1, lbound(InData%lstrd), ubound(InData%lstrd)) + call RegPack(Buf, InData%lstrd) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Kurv + call RegPack(Buf, allocated(InData%Kurv)) + if (allocated(InData%Kurv)) then + call RegPackBounds(Buf, 1, lbound(InData%Kurv), ubound(InData%Kurv)) + call RegPack(Buf, InData%Kurv) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! dl_1 + call RegPack(Buf, allocated(InData%dl_1)) + if (allocated(InData%dl_1)) then + call RegPackBounds(Buf, 1, lbound(InData%dl_1), ubound(InData%dl_1)) + call RegPack(Buf, InData%dl_1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! V + call RegPack(Buf, allocated(InData%V)) + if (allocated(InData%V)) then + call RegPackBounds(Buf, 1, lbound(InData%V), ubound(InData%V)) + call RegPack(Buf, InData%V) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! U + call RegPack(Buf, allocated(InData%U)) + if (allocated(InData%U)) then + call RegPackBounds(Buf, 2, lbound(InData%U), ubound(InData%U)) + call RegPack(Buf, InData%U) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Ud + call RegPack(Buf, allocated(InData%Ud)) + if (allocated(InData%Ud)) then + call RegPackBounds(Buf, 2, lbound(InData%Ud), ubound(InData%Ud)) + call RegPack(Buf, InData%Ud) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! zeta + call RegPack(Buf, allocated(InData%zeta)) + if (allocated(InData%zeta)) then + call RegPackBounds(Buf, 1, lbound(InData%zeta), ubound(InData%zeta)) + call RegPack(Buf, InData%zeta) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PDyn + call RegPack(Buf, allocated(InData%PDyn)) + if (allocated(InData%PDyn)) then + call RegPackBounds(Buf, 1, lbound(InData%PDyn), ubound(InData%PDyn)) + call RegPack(Buf, InData%PDyn) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! T + call RegPack(Buf, allocated(InData%T)) + if (allocated(InData%T)) then + call RegPackBounds(Buf, 2, lbound(InData%T), ubound(InData%T)) + call RegPack(Buf, InData%T) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Td + call RegPack(Buf, allocated(InData%Td)) + if (allocated(InData%Td)) then + call RegPackBounds(Buf, 2, lbound(InData%Td), ubound(InData%Td)) + call RegPack(Buf, InData%Td) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! W + call RegPack(Buf, allocated(InData%W)) + if (allocated(InData%W)) then + call RegPackBounds(Buf, 2, lbound(InData%W), ubound(InData%W)) + call RegPack(Buf, InData%W) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Dp + call RegPack(Buf, allocated(InData%Dp)) + if (allocated(InData%Dp)) then + call RegPackBounds(Buf, 2, lbound(InData%Dp), ubound(InData%Dp)) + call RegPack(Buf, InData%Dp) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Dq + call RegPack(Buf, allocated(InData%Dq)) + if (allocated(InData%Dq)) then + call RegPackBounds(Buf, 2, lbound(InData%Dq), ubound(InData%Dq)) + call RegPack(Buf, InData%Dq) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Ap + call RegPack(Buf, allocated(InData%Ap)) + if (allocated(InData%Ap)) then + call RegPackBounds(Buf, 2, lbound(InData%Ap), ubound(InData%Ap)) + call RegPack(Buf, InData%Ap) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Aq + call RegPack(Buf, allocated(InData%Aq)) + if (allocated(InData%Aq)) then + call RegPackBounds(Buf, 2, lbound(InData%Aq), ubound(InData%Aq)) + call RegPack(Buf, InData%Aq) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! B + call RegPack(Buf, allocated(InData%B)) + if (allocated(InData%B)) then + call RegPackBounds(Buf, 2, lbound(InData%B), ubound(InData%B)) + call RegPack(Buf, InData%B) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Bs + call RegPack(Buf, allocated(InData%Bs)) + if (allocated(InData%Bs)) then + call RegPackBounds(Buf, 2, lbound(InData%Bs), ubound(InData%Bs)) + call RegPack(Buf, InData%Bs) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Fnet + call RegPack(Buf, allocated(InData%Fnet)) + if (allocated(InData%Fnet)) then + call RegPackBounds(Buf, 2, lbound(InData%Fnet), ubound(InData%Fnet)) + call RegPack(Buf, InData%Fnet) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! S + call RegPack(Buf, allocated(InData%S)) + if (allocated(InData%S)) then + call RegPackBounds(Buf, 3, lbound(InData%S), ubound(InData%S)) + call RegPack(Buf, InData%S) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! M + call RegPack(Buf, allocated(InData%M)) + if (allocated(InData%M)) then + call RegPackBounds(Buf, 3, lbound(InData%M), ubound(InData%M)) + call RegPack(Buf, InData%M) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! EndMomentA + call RegPack(Buf, InData%EndMomentA) + if (RegCheckErr(Buf, RoutineName)) return + ! EndMomentB + call RegPack(Buf, InData%EndMomentB) + if (RegCheckErr(Buf, RoutineName)) return + ! LineUnOut + call RegPack(Buf, InData%LineUnOut) + if (RegCheckErr(Buf, RoutineName)) return + ! LineWrOutput + call RegPack(Buf, allocated(InData%LineWrOutput)) + if (allocated(InData%LineWrOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%LineWrOutput), ubound(InData%LineWrOutput)) + call RegPack(Buf, InData%LineWrOutput) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_UnPackLine(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MD_Line), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackLine' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! IdNum + call RegUnpack(Buf, OutData%IdNum) + if (RegCheckErr(Buf, RoutineName)) return + ! PropsIdNum + call RegUnpack(Buf, OutData%PropsIdNum) + if (RegCheckErr(Buf, RoutineName)) return + ! ElasticMod + call RegUnpack(Buf, OutData%ElasticMod) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFlagList + call RegUnpack(Buf, OutData%OutFlagList) + if (RegCheckErr(Buf, RoutineName)) return + ! CtrlChan + call RegUnpack(Buf, OutData%CtrlChan) + if (RegCheckErr(Buf, RoutineName)) return + ! FairConnect + call RegUnpack(Buf, OutData%FairConnect) + if (RegCheckErr(Buf, RoutineName)) return + ! AnchConnect + call RegUnpack(Buf, OutData%AnchConnect) + if (RegCheckErr(Buf, RoutineName)) return + ! N + call RegUnpack(Buf, OutData%N) + if (RegCheckErr(Buf, RoutineName)) return + ! endTypeA + call RegUnpack(Buf, OutData%endTypeA) + if (RegCheckErr(Buf, RoutineName)) return + ! endTypeB + call RegUnpack(Buf, OutData%endTypeB) + if (RegCheckErr(Buf, RoutineName)) return + ! UnstrLen + call RegUnpack(Buf, OutData%UnstrLen) + if (RegCheckErr(Buf, RoutineName)) return + ! rho + call RegUnpack(Buf, OutData%rho) + if (RegCheckErr(Buf, RoutineName)) return + ! d + call RegUnpack(Buf, OutData%d) + if (RegCheckErr(Buf, RoutineName)) return + ! EA + call RegUnpack(Buf, OutData%EA) + if (RegCheckErr(Buf, RoutineName)) return + ! EA_D + call RegUnpack(Buf, OutData%EA_D) + if (RegCheckErr(Buf, RoutineName)) return + ! BA + call RegUnpack(Buf, OutData%BA) + if (RegCheckErr(Buf, RoutineName)) return + ! BA_D + call RegUnpack(Buf, OutData%BA_D) + if (RegCheckErr(Buf, RoutineName)) return + ! EI + call RegUnpack(Buf, OutData%EI) + if (RegCheckErr(Buf, RoutineName)) return + ! Can + call RegUnpack(Buf, OutData%Can) + if (RegCheckErr(Buf, RoutineName)) return + ! Cat + call RegUnpack(Buf, OutData%Cat) + if (RegCheckErr(Buf, RoutineName)) return + ! Cdn + call RegUnpack(Buf, OutData%Cdn) + if (RegCheckErr(Buf, RoutineName)) return + ! Cdt + call RegUnpack(Buf, OutData%Cdt) + if (RegCheckErr(Buf, RoutineName)) return + ! nEApoints + call RegUnpack(Buf, OutData%nEApoints) + if (RegCheckErr(Buf, RoutineName)) return + ! stiffXs + call RegUnpack(Buf, OutData%stiffXs) + if (RegCheckErr(Buf, RoutineName)) return + ! stiffYs + call RegUnpack(Buf, OutData%stiffYs) + if (RegCheckErr(Buf, RoutineName)) return + ! nBApoints + call RegUnpack(Buf, OutData%nBApoints) + if (RegCheckErr(Buf, RoutineName)) return + ! dampXs + call RegUnpack(Buf, OutData%dampXs) + if (RegCheckErr(Buf, RoutineName)) return + ! dampYs + call RegUnpack(Buf, OutData%dampYs) + if (RegCheckErr(Buf, RoutineName)) return + ! nEIpoints + call RegUnpack(Buf, OutData%nEIpoints) + if (RegCheckErr(Buf, RoutineName)) return + ! bstiffXs + call RegUnpack(Buf, OutData%bstiffXs) + if (RegCheckErr(Buf, RoutineName)) return + ! bstiffYs + call RegUnpack(Buf, OutData%bstiffYs) + if (RegCheckErr(Buf, RoutineName)) return + ! time + call RegUnpack(Buf, OutData%time) + if (RegCheckErr(Buf, RoutineName)) return + ! r + if (allocated(OutData%r)) deallocate(OutData%r) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%r(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%r.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%r) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! rd + if (allocated(OutData%rd)) deallocate(OutData%rd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rd(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rd) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! q + if (allocated(OutData%q)) deallocate(OutData%q) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%q(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%q.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%q) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! qs + if (allocated(OutData%qs)) deallocate(OutData%qs) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%qs(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%qs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%qs) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! l + if (allocated(OutData%l)) deallocate(OutData%l) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%l(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%l.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%l) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ld + if (allocated(OutData%ld)) deallocate(OutData%ld) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ld(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ld.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ld) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! lstr + if (allocated(OutData%lstr)) deallocate(OutData%lstr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%lstr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%lstr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%lstr) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! lstrd + if (allocated(OutData%lstrd)) deallocate(OutData%lstrd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%lstrd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%lstrd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%lstrd) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Kurv + if (allocated(OutData%Kurv)) deallocate(OutData%Kurv) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Kurv(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kurv.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Kurv) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! dl_1 + if (allocated(OutData%dl_1)) deallocate(OutData%dl_1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dl_1(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dl_1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dl_1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! V + if (allocated(OutData%V)) deallocate(OutData%V) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%V(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%V.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%V) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! U + if (allocated(OutData%U)) deallocate(OutData%U) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%U(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%U.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%U) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Ud + if (allocated(OutData%Ud)) deallocate(OutData%Ud) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Ud(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ud.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Ud) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! zeta + if (allocated(OutData%zeta)) deallocate(OutData%zeta) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%zeta(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%zeta.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%zeta) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PDyn + if (allocated(OutData%PDyn)) deallocate(OutData%PDyn) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PDyn(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PDyn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PDyn) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! T + if (allocated(OutData%T)) deallocate(OutData%T) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%T(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%T.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%T) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Td + if (allocated(OutData%Td)) deallocate(OutData%Td) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Td(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Td.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Td) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! W + if (allocated(OutData%W)) deallocate(OutData%W) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%W(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%W) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Dp + if (allocated(OutData%Dp)) deallocate(OutData%Dp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Dp(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Dp) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Dq + if (allocated(OutData%Dq)) deallocate(OutData%Dq) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Dq(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dq.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Dq) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Ap + if (allocated(OutData%Ap)) deallocate(OutData%Ap) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Ap(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ap.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Ap) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Aq + if (allocated(OutData%Aq)) deallocate(OutData%Aq) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Aq(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Aq.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Aq) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! B + if (allocated(OutData%B)) deallocate(OutData%B) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%B(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%B) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Bs + if (allocated(OutData%Bs)) deallocate(OutData%Bs) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Bs(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Bs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Bs) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Fnet + if (allocated(OutData%Fnet)) deallocate(OutData%Fnet) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Fnet(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fnet.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Fnet) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! S + if (allocated(OutData%S)) deallocate(OutData%S) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%S.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%S) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! M + if (allocated(OutData%M)) deallocate(OutData%M) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%M(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%M.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%M) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! EndMomentA + call RegUnpack(Buf, OutData%EndMomentA) + if (RegCheckErr(Buf, RoutineName)) return + ! EndMomentB + call RegUnpack(Buf, OutData%EndMomentB) + if (RegCheckErr(Buf, RoutineName)) return + ! LineUnOut + call RegUnpack(Buf, OutData%LineUnOut) + if (RegCheckErr(Buf, RoutineName)) return + ! LineWrOutput + if (allocated(OutData%LineWrOutput)) deallocate(OutData%LineWrOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LineWrOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineWrOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LineWrOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + SUBROUTINE MD_CopyFail( SrcFailData, DstFailData, CtrlCode, ErrStat, ErrMsg ) + TYPE(MD_Fail), INTENT(IN) :: SrcFailData + TYPE(MD_Fail), INTENT(INOUT) :: DstFailData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyFail' +! + ErrStat = ErrID_None + ErrMsg = "" + DstFailData%IdNum = SrcFailData%IdNum + END SUBROUTINE MD_CopyFail + + SUBROUTINE MD_DestroyFail( FailData, ErrStat, ErrMsg ) + TYPE(MD_Fail), INTENT(INOUT) :: FailData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackLine' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! IdNum - Int_BufSz = Int_BufSz + 1 ! PropsIdNum - Int_BufSz = Int_BufSz + 1 ! ElasticMod - Int_BufSz = Int_BufSz + SIZE(InData%OutFlagList) ! OutFlagList - Int_BufSz = Int_BufSz + 1 ! CtrlChan - Int_BufSz = Int_BufSz + 1 ! FairConnect - Int_BufSz = Int_BufSz + 1 ! AnchConnect - Int_BufSz = Int_BufSz + 1 ! N - Int_BufSz = Int_BufSz + 1 ! endTypeA - Int_BufSz = Int_BufSz + 1 ! endTypeB - Db_BufSz = Db_BufSz + 1 ! UnstrLen - Db_BufSz = Db_BufSz + 1 ! rho - Db_BufSz = Db_BufSz + 1 ! d - Db_BufSz = Db_BufSz + 1 ! EA - Db_BufSz = Db_BufSz + 1 ! EA_D - Db_BufSz = Db_BufSz + 1 ! BA - Db_BufSz = Db_BufSz + 1 ! BA_D - Db_BufSz = Db_BufSz + 1 ! EI - Db_BufSz = Db_BufSz + 1 ! Can - Db_BufSz = Db_BufSz + 1 ! Cat - Db_BufSz = Db_BufSz + 1 ! Cdn - Db_BufSz = Db_BufSz + 1 ! Cdt - Int_BufSz = Int_BufSz + 1 ! nEApoints - Db_BufSz = Db_BufSz + SIZE(InData%stiffXs) ! stiffXs - Db_BufSz = Db_BufSz + SIZE(InData%stiffYs) ! stiffYs - Int_BufSz = Int_BufSz + 1 ! nBApoints - Db_BufSz = Db_BufSz + SIZE(InData%dampXs) ! dampXs - Db_BufSz = Db_BufSz + SIZE(InData%dampYs) ! dampYs - Int_BufSz = Int_BufSz + 1 ! nEIpoints - Db_BufSz = Db_BufSz + SIZE(InData%bstiffXs) ! bstiffXs - Db_BufSz = Db_BufSz + SIZE(InData%bstiffYs) ! bstiffYs - Db_BufSz = Db_BufSz + 1 ! time - Int_BufSz = Int_BufSz + 1 ! r allocated yes/no - IF ( ALLOCATED(InData%r) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! r upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%r) ! r - END IF - Int_BufSz = Int_BufSz + 1 ! rd allocated yes/no - IF ( ALLOCATED(InData%rd) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! rd upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%rd) ! rd - END IF - Int_BufSz = Int_BufSz + 1 ! q allocated yes/no - IF ( ALLOCATED(InData%q) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! q upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%q) ! q - END IF - Int_BufSz = Int_BufSz + 1 ! qs allocated yes/no - IF ( ALLOCATED(InData%qs) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! qs upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%qs) ! qs - END IF - Int_BufSz = Int_BufSz + 1 ! l allocated yes/no - IF ( ALLOCATED(InData%l) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! l upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%l) ! l - END IF - Int_BufSz = Int_BufSz + 1 ! ld allocated yes/no - IF ( ALLOCATED(InData%ld) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ld upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%ld) ! ld - END IF - Int_BufSz = Int_BufSz + 1 ! lstr allocated yes/no - IF ( ALLOCATED(InData%lstr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! lstr upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%lstr) ! lstr - END IF - Int_BufSz = Int_BufSz + 1 ! lstrd allocated yes/no - IF ( ALLOCATED(InData%lstrd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! lstrd upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%lstrd) ! lstrd - END IF - Int_BufSz = Int_BufSz + 1 ! Kurv allocated yes/no - IF ( ALLOCATED(InData%Kurv) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Kurv upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Kurv) ! Kurv - END IF - Int_BufSz = Int_BufSz + 1 ! dl_1 allocated yes/no - IF ( ALLOCATED(InData%dl_1) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dl_1 upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%dl_1) ! dl_1 - END IF - Int_BufSz = Int_BufSz + 1 ! V allocated yes/no - IF ( ALLOCATED(InData%V) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! V upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%V) ! V - END IF - Int_BufSz = Int_BufSz + 1 ! U allocated yes/no - IF ( ALLOCATED(InData%U) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! U upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%U) ! U - END IF - Int_BufSz = Int_BufSz + 1 ! Ud allocated yes/no - IF ( ALLOCATED(InData%Ud) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Ud upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Ud) ! Ud - END IF - Int_BufSz = Int_BufSz + 1 ! zeta allocated yes/no - IF ( ALLOCATED(InData%zeta) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! zeta upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%zeta) ! zeta - END IF - Int_BufSz = Int_BufSz + 1 ! PDyn allocated yes/no - IF ( ALLOCATED(InData%PDyn) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PDyn upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%PDyn) ! PDyn - END IF - Int_BufSz = Int_BufSz + 1 ! T allocated yes/no - IF ( ALLOCATED(InData%T) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! T upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%T) ! T - END IF - Int_BufSz = Int_BufSz + 1 ! Td allocated yes/no - IF ( ALLOCATED(InData%Td) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Td upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Td) ! Td - END IF - Int_BufSz = Int_BufSz + 1 ! W allocated yes/no - IF ( ALLOCATED(InData%W) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! W upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%W) ! W - END IF - Int_BufSz = Int_BufSz + 1 ! Dp allocated yes/no - IF ( ALLOCATED(InData%Dp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Dp upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Dp) ! Dp - END IF - Int_BufSz = Int_BufSz + 1 ! Dq allocated yes/no - IF ( ALLOCATED(InData%Dq) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Dq upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Dq) ! Dq - END IF - Int_BufSz = Int_BufSz + 1 ! Ap allocated yes/no - IF ( ALLOCATED(InData%Ap) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Ap upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Ap) ! Ap - END IF - Int_BufSz = Int_BufSz + 1 ! Aq allocated yes/no - IF ( ALLOCATED(InData%Aq) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Aq upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Aq) ! Aq - END IF - Int_BufSz = Int_BufSz + 1 ! B allocated yes/no - IF ( ALLOCATED(InData%B) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! B upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%B) ! B - END IF - Int_BufSz = Int_BufSz + 1 ! Bs allocated yes/no - IF ( ALLOCATED(InData%Bs) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Bs upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Bs) ! Bs - END IF - Int_BufSz = Int_BufSz + 1 ! Fnet allocated yes/no - IF ( ALLOCATED(InData%Fnet) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Fnet upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fnet) ! Fnet - END IF - Int_BufSz = Int_BufSz + 1 ! S allocated yes/no - IF ( ALLOCATED(InData%S) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! S upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%S) ! S - END IF - Int_BufSz = Int_BufSz + 1 ! M allocated yes/no - IF ( ALLOCATED(InData%M) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! M upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%M) ! M - END IF - Db_BufSz = Db_BufSz + SIZE(InData%EndMomentA) ! EndMomentA - Db_BufSz = Db_BufSz + SIZE(InData%EndMomentB) ! EndMomentB - Int_BufSz = Int_BufSz + 1 ! LineUnOut - Int_BufSz = Int_BufSz + 1 ! LineWrOutput allocated yes/no - IF ( ALLOCATED(InData%LineWrOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LineWrOutput upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%LineWrOutput) ! LineWrOutput - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%IdNum - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%PropsIdNum - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ElasticMod - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%OutFlagList,1), UBOUND(InData%OutFlagList,1) - IntKiBuf(Int_Xferred) = InData%OutFlagList(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%CtrlChan - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%FairConnect - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%AnchConnect - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%N - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%endTypeA - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%endTypeB - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%UnstrLen - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%rho - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%d - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%EA - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%EA_D - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%BA - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%BA_D - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%EI - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Can - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Cat - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Cdn - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Cdt - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nEApoints - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%stiffXs,1), UBOUND(InData%stiffXs,1) - DbKiBuf(Db_Xferred) = InData%stiffXs(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%stiffYs,1), UBOUND(InData%stiffYs,1) - DbKiBuf(Db_Xferred) = InData%stiffYs(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%nBApoints - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%dampXs,1), UBOUND(InData%dampXs,1) - DbKiBuf(Db_Xferred) = InData%dampXs(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%dampYs,1), UBOUND(InData%dampYs,1) - DbKiBuf(Db_Xferred) = InData%dampYs(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%nEIpoints - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%bstiffXs,1), UBOUND(InData%bstiffXs,1) - DbKiBuf(Db_Xferred) = InData%bstiffXs(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%bstiffYs,1), UBOUND(InData%bstiffYs,1) - DbKiBuf(Db_Xferred) = InData%bstiffYs(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DbKiBuf(Db_Xferred) = InData%time - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%r) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%r,2), UBOUND(InData%r,2) - DO i1 = LBOUND(InData%r,1), UBOUND(InData%r,1) - DbKiBuf(Db_Xferred) = InData%r(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rd,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%rd,2), UBOUND(InData%rd,2) - DO i1 = LBOUND(InData%rd,1), UBOUND(InData%rd,1) - DbKiBuf(Db_Xferred) = InData%rd(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%q) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%q,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%q,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%q,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%q,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%q,2), UBOUND(InData%q,2) - DO i1 = LBOUND(InData%q,1), UBOUND(InData%q,1) - DbKiBuf(Db_Xferred) = InData%q(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%qs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%qs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%qs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%qs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%qs,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%qs,2), UBOUND(InData%qs,2) - DO i1 = LBOUND(InData%qs,1), UBOUND(InData%qs,1) - DbKiBuf(Db_Xferred) = InData%qs(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%l) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%l,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%l,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%l,1), UBOUND(InData%l,1) - DbKiBuf(Db_Xferred) = InData%l(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ld) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ld,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ld,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ld,1), UBOUND(InData%ld,1) - DbKiBuf(Db_Xferred) = InData%ld(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%lstr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%lstr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%lstr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%lstr,1), UBOUND(InData%lstr,1) - DbKiBuf(Db_Xferred) = InData%lstr(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%lstrd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%lstrd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%lstrd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%lstrd,1), UBOUND(InData%lstrd,1) - DbKiBuf(Db_Xferred) = InData%lstrd(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Kurv) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Kurv,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kurv,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Kurv,1), UBOUND(InData%Kurv,1) - DbKiBuf(Db_Xferred) = InData%Kurv(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dl_1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dl_1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dl_1,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dl_1,1), UBOUND(InData%dl_1,1) - DbKiBuf(Db_Xferred) = InData%dl_1(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%V) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%V,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%V,1), UBOUND(InData%V,1) - DbKiBuf(Db_Xferred) = InData%V(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%U) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%U,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%U,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%U,2), UBOUND(InData%U,2) - DO i1 = LBOUND(InData%U,1), UBOUND(InData%U,1) - DbKiBuf(Db_Xferred) = InData%U(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Ud) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ud,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ud,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ud,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ud,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Ud,2), UBOUND(InData%Ud,2) - DO i1 = LBOUND(InData%Ud,1), UBOUND(InData%Ud,1) - DbKiBuf(Db_Xferred) = InData%Ud(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%zeta) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%zeta,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zeta,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%zeta,1), UBOUND(InData%zeta,1) - DbKiBuf(Db_Xferred) = InData%zeta(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PDyn) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PDyn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PDyn,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PDyn,1), UBOUND(InData%PDyn,1) - DbKiBuf(Db_Xferred) = InData%PDyn(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%T) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%T,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%T,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%T,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%T,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%T,2), UBOUND(InData%T,2) - DO i1 = LBOUND(InData%T,1), UBOUND(InData%T,1) - DbKiBuf(Db_Xferred) = InData%T(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Td) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Td,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Td,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Td,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Td,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Td,2), UBOUND(InData%Td,2) - DO i1 = LBOUND(InData%Td,1), UBOUND(InData%Td,1) - DbKiBuf(Db_Xferred) = InData%Td(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%W) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%W,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%W,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%W,2), UBOUND(InData%W,2) - DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) - DbKiBuf(Db_Xferred) = InData%W(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Dp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Dp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Dp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Dp,2), UBOUND(InData%Dp,2) - DO i1 = LBOUND(InData%Dp,1), UBOUND(InData%Dp,1) - DbKiBuf(Db_Xferred) = InData%Dp(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Dq) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Dq,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dq,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Dq,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dq,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Dq,2), UBOUND(InData%Dq,2) - DO i1 = LBOUND(InData%Dq,1), UBOUND(InData%Dq,1) - DbKiBuf(Db_Xferred) = InData%Dq(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Ap) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ap,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ap,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ap,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ap,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Ap,2), UBOUND(InData%Ap,2) - DO i1 = LBOUND(InData%Ap,1), UBOUND(InData%Ap,1) - DbKiBuf(Db_Xferred) = InData%Ap(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Aq) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Aq,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Aq,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Aq,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Aq,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Aq,2), UBOUND(InData%Aq,2) - DO i1 = LBOUND(InData%Aq,1), UBOUND(InData%Aq,1) - DbKiBuf(Db_Xferred) = InData%Aq(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%B) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%B,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%B,2), UBOUND(InData%B,2) - DO i1 = LBOUND(InData%B,1), UBOUND(InData%B,1) - DbKiBuf(Db_Xferred) = InData%B(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Bs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Bs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Bs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Bs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Bs,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Bs,2), UBOUND(InData%Bs,2) - DO i1 = LBOUND(InData%Bs,1), UBOUND(InData%Bs,1) - DbKiBuf(Db_Xferred) = InData%Bs(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Fnet) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fnet,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fnet,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fnet,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fnet,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Fnet,2), UBOUND(InData%Fnet,2) - DO i1 = LBOUND(InData%Fnet,1), UBOUND(InData%Fnet,1) - DbKiBuf(Db_Xferred) = InData%Fnet(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%S) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%S,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%S,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%S,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%S,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%S,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%S,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%S,3), UBOUND(InData%S,3) - DO i2 = LBOUND(InData%S,2), UBOUND(InData%S,2) - DO i1 = LBOUND(InData%S,1), UBOUND(InData%S,1) - DbKiBuf(Db_Xferred) = InData%S(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%M) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%M,3), UBOUND(InData%M,3) - DO i2 = LBOUND(InData%M,2), UBOUND(InData%M,2) - DO i1 = LBOUND(InData%M,1), UBOUND(InData%M,1) - DbKiBuf(Db_Xferred) = InData%M(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - DO i1 = LBOUND(InData%EndMomentA,1), UBOUND(InData%EndMomentA,1) - DbKiBuf(Db_Xferred) = InData%EndMomentA(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%EndMomentB,1), UBOUND(InData%EndMomentB,1) - DbKiBuf(Db_Xferred) = InData%EndMomentB(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%LineUnOut - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%LineWrOutput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LineWrOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineWrOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LineWrOutput,1), UBOUND(InData%LineWrOutput,1) - DbKiBuf(Db_Xferred) = InData%LineWrOutput(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_PackLine - - SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MD_Line), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackLine' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%IdNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%PropsIdNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ElasticMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%OutFlagList,1) - i1_u = UBOUND(OutData%OutFlagList,1) - DO i1 = LBOUND(OutData%OutFlagList,1), UBOUND(OutData%OutFlagList,1) - OutData%OutFlagList(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%CtrlChan = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FairConnect = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%AnchConnect = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%N = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%endTypeA = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%endTypeB = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UnstrLen = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%rho = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%d = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%EA = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%EA_D = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%BA = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%BA_D = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%EI = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Can = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Cat = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Cdn = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Cdt = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%nEApoints = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%stiffXs,1) - i1_u = UBOUND(OutData%stiffXs,1) - DO i1 = LBOUND(OutData%stiffXs,1), UBOUND(OutData%stiffXs,1) - OutData%stiffXs(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%stiffYs,1) - i1_u = UBOUND(OutData%stiffYs,1) - DO i1 = LBOUND(OutData%stiffYs,1), UBOUND(OutData%stiffYs,1) - OutData%stiffYs(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - OutData%nBApoints = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%dampXs,1) - i1_u = UBOUND(OutData%dampXs,1) - DO i1 = LBOUND(OutData%dampXs,1), UBOUND(OutData%dampXs,1) - OutData%dampXs(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%dampYs,1) - i1_u = UBOUND(OutData%dampYs,1) - DO i1 = LBOUND(OutData%dampYs,1), UBOUND(OutData%dampYs,1) - OutData%dampYs(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - OutData%nEIpoints = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%bstiffXs,1) - i1_u = UBOUND(OutData%bstiffXs,1) - DO i1 = LBOUND(OutData%bstiffXs,1), UBOUND(OutData%bstiffXs,1) - OutData%bstiffXs(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%bstiffYs,1) - i1_u = UBOUND(OutData%bstiffYs,1) - DO i1 = LBOUND(OutData%bstiffYs,1), UBOUND(OutData%bstiffYs,1) - OutData%bstiffYs(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - OutData%time = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%r)) DEALLOCATE(OutData%r) - ALLOCATE(OutData%r(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%r.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%r,2), UBOUND(OutData%r,2) - DO i1 = LBOUND(OutData%r,1), UBOUND(OutData%r,1) - OutData%r(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rd not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rd)) DEALLOCATE(OutData%rd) - ALLOCATE(OutData%rd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%rd,2), UBOUND(OutData%rd,2) - DO i1 = LBOUND(OutData%rd,1), UBOUND(OutData%rd,1) - OutData%rd(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! q not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%q)) DEALLOCATE(OutData%q) - ALLOCATE(OutData%q(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%q.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%q,2), UBOUND(OutData%q,2) - DO i1 = LBOUND(OutData%q,1), UBOUND(OutData%q,1) - OutData%q(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! qs not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%qs)) DEALLOCATE(OutData%qs) - ALLOCATE(OutData%qs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%qs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%qs,2), UBOUND(OutData%qs,2) - DO i1 = LBOUND(OutData%qs,1), UBOUND(OutData%qs,1) - OutData%qs(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! l not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%l)) DEALLOCATE(OutData%l) - ALLOCATE(OutData%l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%l,1), UBOUND(OutData%l,1) - OutData%l(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ld not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ld)) DEALLOCATE(OutData%ld) - ALLOCATE(OutData%ld(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ld.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ld,1), UBOUND(OutData%ld,1) - OutData%ld(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! lstr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%lstr)) DEALLOCATE(OutData%lstr) - ALLOCATE(OutData%lstr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%lstr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%lstr,1), UBOUND(OutData%lstr,1) - OutData%lstr(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! lstrd not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%lstrd)) DEALLOCATE(OutData%lstrd) - ALLOCATE(OutData%lstrd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%lstrd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%lstrd,1), UBOUND(OutData%lstrd,1) - OutData%lstrd(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Kurv not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Kurv)) DEALLOCATE(OutData%Kurv) - ALLOCATE(OutData%Kurv(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kurv.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Kurv,1), UBOUND(OutData%Kurv,1) - OutData%Kurv(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dl_1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%dl_1)) DEALLOCATE(OutData%dl_1) - ALLOCATE(OutData%dl_1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dl_1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dl_1,1), UBOUND(OutData%dl_1,1) - OutData%dl_1(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! V not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%V)) DEALLOCATE(OutData%V) - ALLOCATE(OutData%V(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%V.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%V,1), UBOUND(OutData%V,1) - OutData%V(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! U not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%U)) DEALLOCATE(OutData%U) - ALLOCATE(OutData%U(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%U,2), UBOUND(OutData%U,2) - DO i1 = LBOUND(OutData%U,1), UBOUND(OutData%U,1) - OutData%U(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ud not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Ud)) DEALLOCATE(OutData%Ud) - ALLOCATE(OutData%Ud(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ud.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Ud,2), UBOUND(OutData%Ud,2) - DO i1 = LBOUND(OutData%Ud,1), UBOUND(OutData%Ud,1) - OutData%Ud(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! zeta not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%zeta)) DEALLOCATE(OutData%zeta) - ALLOCATE(OutData%zeta(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%zeta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%zeta,1), UBOUND(OutData%zeta,1) - OutData%zeta(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PDyn not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PDyn)) DEALLOCATE(OutData%PDyn) - ALLOCATE(OutData%PDyn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PDyn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PDyn,1), UBOUND(OutData%PDyn,1) - OutData%PDyn(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! T not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%T)) DEALLOCATE(OutData%T) - ALLOCATE(OutData%T(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%T,2), UBOUND(OutData%T,2) - DO i1 = LBOUND(OutData%T,1), UBOUND(OutData%T,1) - OutData%T(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Td not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Td)) DEALLOCATE(OutData%Td) - ALLOCATE(OutData%Td(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Td.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Td,2), UBOUND(OutData%Td,2) - DO i1 = LBOUND(OutData%Td,1), UBOUND(OutData%Td,1) - OutData%Td(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! W not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%W)) DEALLOCATE(OutData%W) - ALLOCATE(OutData%W(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%W,2), UBOUND(OutData%W,2) - DO i1 = LBOUND(OutData%W,1), UBOUND(OutData%W,1) - OutData%W(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Dp not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Dp)) DEALLOCATE(OutData%Dp) - ALLOCATE(OutData%Dp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Dp,2), UBOUND(OutData%Dp,2) - DO i1 = LBOUND(OutData%Dp,1), UBOUND(OutData%Dp,1) - OutData%Dp(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Dq not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Dq)) DEALLOCATE(OutData%Dq) - ALLOCATE(OutData%Dq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Dq,2), UBOUND(OutData%Dq,2) - DO i1 = LBOUND(OutData%Dq,1), UBOUND(OutData%Dq,1) - OutData%Dq(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ap not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Ap)) DEALLOCATE(OutData%Ap) - ALLOCATE(OutData%Ap(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ap.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Ap,2), UBOUND(OutData%Ap,2) - DO i1 = LBOUND(OutData%Ap,1), UBOUND(OutData%Ap,1) - OutData%Ap(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Aq not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Aq)) DEALLOCATE(OutData%Aq) - ALLOCATE(OutData%Aq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Aq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Aq,2), UBOUND(OutData%Aq,2) - DO i1 = LBOUND(OutData%Aq,1), UBOUND(OutData%Aq,1) - OutData%Aq(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! B not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%B)) DEALLOCATE(OutData%B) - ALLOCATE(OutData%B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%B,2), UBOUND(OutData%B,2) - DO i1 = LBOUND(OutData%B,1), UBOUND(OutData%B,1) - OutData%B(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Bs not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Bs)) DEALLOCATE(OutData%Bs) - ALLOCATE(OutData%Bs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Bs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Bs,2), UBOUND(OutData%Bs,2) - DO i1 = LBOUND(OutData%Bs,1), UBOUND(OutData%Bs,1) - OutData%Bs(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fnet not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Fnet)) DEALLOCATE(OutData%Fnet) - ALLOCATE(OutData%Fnet(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fnet.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Fnet,2), UBOUND(OutData%Fnet,2) - DO i1 = LBOUND(OutData%Fnet,1), UBOUND(OutData%Fnet,1) - OutData%Fnet(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! S not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%S)) DEALLOCATE(OutData%S) - ALLOCATE(OutData%S(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%S.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%S,3), UBOUND(OutData%S,3) - DO i2 = LBOUND(OutData%S,2), UBOUND(OutData%S,2) - DO i1 = LBOUND(OutData%S,1), UBOUND(OutData%S,1) - OutData%S(i1,i2,i3) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%M)) DEALLOCATE(OutData%M) - ALLOCATE(OutData%M(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%M,3), UBOUND(OutData%M,3) - DO i2 = LBOUND(OutData%M,2), UBOUND(OutData%M,2) - DO i1 = LBOUND(OutData%M,1), UBOUND(OutData%M,1) - OutData%M(i1,i2,i3) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - i1_l = LBOUND(OutData%EndMomentA,1) - i1_u = UBOUND(OutData%EndMomentA,1) - DO i1 = LBOUND(OutData%EndMomentA,1), UBOUND(OutData%EndMomentA,1) - OutData%EndMomentA(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%EndMomentB,1) - i1_u = UBOUND(OutData%EndMomentB,1) - DO i1 = LBOUND(OutData%EndMomentB,1), UBOUND(OutData%EndMomentB,1) - OutData%EndMomentB(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - OutData%LineUnOut = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineWrOutput not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LineWrOutput)) DEALLOCATE(OutData%LineWrOutput) - ALLOCATE(OutData%LineWrOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineWrOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LineWrOutput,1), UBOUND(OutData%LineWrOutput,1) - OutData%LineWrOutput(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_UnPackLine - - SUBROUTINE MD_CopyFail( SrcFailData, DstFailData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_Fail), INTENT(IN) :: SrcFailData - TYPE(MD_Fail), INTENT(INOUT) :: DstFailData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyFail' -! - ErrStat = ErrID_None - ErrMsg = "" - DstFailData%IdNum = SrcFailData%IdNum - END SUBROUTINE MD_CopyFail - - SUBROUTINE MD_DestroyFail( FailData, ErrStat, ErrMsg ) - TYPE(MD_Fail), INTENT(INOUT) :: FailData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyFail' - + CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyFail' + ErrStat = ErrID_None ErrMsg = "" END SUBROUTINE MD_DestroyFail - SUBROUTINE MD_PackFail( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MD_Fail), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackFail' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! IdNum - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%IdNum - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE MD_PackFail - - SUBROUTINE MD_UnPackFail( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MD_Fail), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackFail' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%IdNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE MD_UnPackFail +subroutine MD_PackFail(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MD_Fail), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackFail' + if (Buf%ErrStat >= AbortErrLev) return + ! IdNum + call RegPack(Buf, InData%IdNum) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_UnPackFail(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MD_Fail), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackFail' + if (Buf%ErrStat /= ErrID_None) return + ! IdNum + call RegUnpack(Buf, OutData%IdNum) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE MD_CopyOutParmType( SrcOutParmTypeData, DstOutParmTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(MD_OutParmType), INTENT(IN) :: SrcOutParmTypeData TYPE(MD_OutParmType), INTENT(INOUT) :: DstOutParmTypeData @@ -6314,136 +4090,56 @@ SUBROUTINE MD_DestroyOutParmType( OutParmTypeData, ErrStat, ErrMsg ) END SUBROUTINE MD_DestroyOutParmType - SUBROUTINE MD_PackOutParmType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MD_OutParmType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackOutParmType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%Name) ! Name - Int_BufSz = Int_BufSz + 1*LEN(InData%Units) ! Units - Int_BufSz = Int_BufSz + 1 ! QType - Int_BufSz = Int_BufSz + 1 ! OType - Int_BufSz = Int_BufSz + 1 ! NodeID - Int_BufSz = Int_BufSz + 1 ! ObjID - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%Name) - IntKiBuf(Int_Xferred) = ICHAR(InData%Name(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Units) - IntKiBuf(Int_Xferred) = ICHAR(InData%Units(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%QType - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%OType - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NodeID - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ObjID - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE MD_PackOutParmType - - SUBROUTINE MD_UnPackOutParmType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MD_OutParmType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackOutParmType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%Name) - OutData%Name(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Units) - OutData%Units(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%QType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%OType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NodeID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ObjID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE MD_UnPackOutParmType +subroutine MD_PackOutParmType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MD_OutParmType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackOutParmType' + if (Buf%ErrStat >= AbortErrLev) return + ! Name + call RegPack(Buf, InData%Name) + if (RegCheckErr(Buf, RoutineName)) return + ! Units + call RegPack(Buf, InData%Units) + if (RegCheckErr(Buf, RoutineName)) return + ! QType + call RegPack(Buf, InData%QType) + if (RegCheckErr(Buf, RoutineName)) return + ! OType + call RegPack(Buf, InData%OType) + if (RegCheckErr(Buf, RoutineName)) return + ! NodeID + call RegPack(Buf, InData%NodeID) + if (RegCheckErr(Buf, RoutineName)) return + ! ObjID + call RegPack(Buf, InData%ObjID) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_UnPackOutParmType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MD_OutParmType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackOutParmType' + if (Buf%ErrStat /= ErrID_None) return + ! Name + call RegUnpack(Buf, OutData%Name) + if (RegCheckErr(Buf, RoutineName)) return + ! Units + call RegUnpack(Buf, OutData%Units) + if (RegCheckErr(Buf, RoutineName)) return + ! QType + call RegUnpack(Buf, OutData%QType) + if (RegCheckErr(Buf, RoutineName)) return + ! OType + call RegUnpack(Buf, OutData%OType) + if (RegCheckErr(Buf, RoutineName)) return + ! NodeID + call RegUnpack(Buf, OutData%NodeID) + if (RegCheckErr(Buf, RoutineName)) return + ! ObjID + call RegUnpack(Buf, OutData%ObjID) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE MD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(MD_InitOutputType), INTENT(IN) :: SrcInitOutputData TYPE(MD_InitOutputType), INTENT(INOUT) :: DstInitOutputData @@ -6646,623 +4342,270 @@ SUBROUTINE MD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE MD_DestroyInitOutput - SUBROUTINE MD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MD_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! writeOutputHdr allocated yes/no - IF ( ALLOCATED(InData%writeOutputHdr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! writeOutputHdr upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%writeOutputHdr)*LEN(InData%writeOutputHdr) ! writeOutputHdr - END IF - Int_BufSz = Int_BufSz + 1 ! writeOutputUnt allocated yes/no - IF ( ALLOCATED(InData%writeOutputUnt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! writeOutputUnt upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%writeOutputUnt)*LEN(InData%writeOutputUnt) ! writeOutputUnt - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! CableCChanRqst allocated yes/no - IF ( ALLOCATED(InData%CableCChanRqst) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CableCChanRqst upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%CableCChanRqst) ! CableCChanRqst - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_y allocated yes/no - IF ( ALLOCATED(InData%LinNames_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_y)*LEN(InData%LinNames_y) ! LinNames_y - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_x allocated yes/no - IF ( ALLOCATED(InData%LinNames_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_x)*LEN(InData%LinNames_x) ! LinNames_x - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_u allocated yes/no - IF ( ALLOCATED(InData%LinNames_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_u)*LEN(InData%LinNames_u) ! LinNames_u - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_y allocated yes/no - IF ( ALLOCATED(InData%RotFrame_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_y) ! RotFrame_y - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_x allocated yes/no - IF ( ALLOCATED(InData%RotFrame_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_x) ! RotFrame_x - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_u allocated yes/no - IF ( ALLOCATED(InData%RotFrame_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_u) ! RotFrame_u - END IF - Int_BufSz = Int_BufSz + 1 ! IsLoad_u allocated yes/no - IF ( ALLOCATED(InData%IsLoad_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IsLoad_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IsLoad_u) ! IsLoad_u - END IF - Int_BufSz = Int_BufSz + 1 ! DerivOrder_x allocated yes/no - IF ( ALLOCATED(InData%DerivOrder_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DerivOrder_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%DerivOrder_x) ! DerivOrder_x - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%writeOutputHdr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%writeOutputHdr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%writeOutputHdr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%writeOutputHdr,1), UBOUND(InData%writeOutputHdr,1) - DO I = 1, LEN(InData%writeOutputHdr) - IntKiBuf(Int_Xferred) = ICHAR(InData%writeOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%writeOutputUnt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%writeOutputUnt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%writeOutputUnt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%writeOutputUnt,1), UBOUND(InData%writeOutputUnt,1) - DO I = 1, LEN(InData%writeOutputUnt) - IntKiBuf(Int_Xferred) = ICHAR(InData%writeOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%CableCChanRqst) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CableCChanRqst,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CableCChanRqst,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CableCChanRqst,1), UBOUND(InData%CableCChanRqst,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%CableCChanRqst(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinNames_y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) - DO I = 1, LEN(InData%LinNames_y) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_y(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinNames_x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_x,1), UBOUND(InData%LinNames_x,1) - DO I = 1, LEN(InData%LinNames_x) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_x(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinNames_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) - DO I = 1, LEN(InData%LinNames_u) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_u(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_y,1), UBOUND(InData%RotFrame_y,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_y(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_x,1), UBOUND(InData%RotFrame_x,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_x(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_u,1), UBOUND(InData%RotFrame_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IsLoad_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IsLoad_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DerivOrder_x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DerivOrder_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DerivOrder_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DerivOrder_x,1), UBOUND(InData%DerivOrder_x,1) - IntKiBuf(Int_Xferred) = InData%DerivOrder_x(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_PackInitOutput - - SUBROUTINE MD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MD_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! writeOutputHdr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%writeOutputHdr)) DEALLOCATE(OutData%writeOutputHdr) - ALLOCATE(OutData%writeOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%writeOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%writeOutputHdr,1), UBOUND(OutData%writeOutputHdr,1) - DO I = 1, LEN(OutData%writeOutputHdr) - OutData%writeOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! writeOutputUnt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%writeOutputUnt)) DEALLOCATE(OutData%writeOutputUnt) - ALLOCATE(OutData%writeOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%writeOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%writeOutputUnt,1), UBOUND(OutData%writeOutputUnt,1) - DO I = 1, LEN(OutData%writeOutputUnt) - OutData%writeOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CableCChanRqst not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CableCChanRqst)) DEALLOCATE(OutData%CableCChanRqst) - ALLOCATE(OutData%CableCChanRqst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableCChanRqst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CableCChanRqst,1), UBOUND(OutData%CableCChanRqst,1) - OutData%CableCChanRqst(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%CableCChanRqst(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LinNames_y)) DEALLOCATE(OutData%LinNames_y) - ALLOCATE(OutData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) - DO I = 1, LEN(OutData%LinNames_y) - OutData%LinNames_y(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LinNames_x)) DEALLOCATE(OutData%LinNames_x) - ALLOCATE(OutData%LinNames_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_x,1), UBOUND(OutData%LinNames_x,1) - DO I = 1, LEN(OutData%LinNames_x) - OutData%LinNames_x(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LinNames_u)) DEALLOCATE(OutData%LinNames_u) - ALLOCATE(OutData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) - DO I = 1, LEN(OutData%LinNames_u) - OutData%LinNames_u(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RotFrame_y)) DEALLOCATE(OutData%RotFrame_y) - ALLOCATE(OutData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_y,1), UBOUND(OutData%RotFrame_y,1) - OutData%RotFrame_y(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_y(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RotFrame_x)) DEALLOCATE(OutData%RotFrame_x) - ALLOCATE(OutData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_x,1), UBOUND(OutData%RotFrame_x,1) - OutData%RotFrame_x(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_x(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RotFrame_u)) DEALLOCATE(OutData%RotFrame_u) - ALLOCATE(OutData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_u,1), UBOUND(OutData%RotFrame_u,1) - OutData%RotFrame_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IsLoad_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IsLoad_u)) DEALLOCATE(OutData%IsLoad_u) - ALLOCATE(OutData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) - OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DerivOrder_x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DerivOrder_x)) DEALLOCATE(OutData%DerivOrder_x) - ALLOCATE(OutData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DerivOrder_x,1), UBOUND(OutData%DerivOrder_x,1) - OutData%DerivOrder_x(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_UnPackInitOutput +subroutine MD_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MD_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! writeOutputHdr + call RegPack(Buf, allocated(InData%writeOutputHdr)) + if (allocated(InData%writeOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%writeOutputHdr), ubound(InData%writeOutputHdr)) + call RegPack(Buf, InData%writeOutputHdr) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! writeOutputUnt + call RegPack(Buf, allocated(InData%writeOutputUnt)) + if (allocated(InData%writeOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%writeOutputUnt), ubound(InData%writeOutputUnt)) + call RegPack(Buf, InData%writeOutputUnt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Ver + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + if (RegCheckErr(Buf, RoutineName)) return + ! CableCChanRqst + call RegPack(Buf, allocated(InData%CableCChanRqst)) + if (allocated(InData%CableCChanRqst)) then + call RegPackBounds(Buf, 1, lbound(InData%CableCChanRqst), ubound(InData%CableCChanRqst)) + call RegPack(Buf, InData%CableCChanRqst) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LinNames_y + call RegPack(Buf, allocated(InData%LinNames_y)) + if (allocated(InData%LinNames_y)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) + call RegPack(Buf, InData%LinNames_y) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LinNames_x + call RegPack(Buf, allocated(InData%LinNames_x)) + if (allocated(InData%LinNames_x)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_x), ubound(InData%LinNames_x)) + call RegPack(Buf, InData%LinNames_x) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LinNames_u + call RegPack(Buf, allocated(InData%LinNames_u)) + if (allocated(InData%LinNames_u)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) + call RegPack(Buf, InData%LinNames_u) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RotFrame_y + call RegPack(Buf, allocated(InData%RotFrame_y)) + if (allocated(InData%RotFrame_y)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y), ubound(InData%RotFrame_y)) + call RegPack(Buf, InData%RotFrame_y) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RotFrame_x + call RegPack(Buf, allocated(InData%RotFrame_x)) + if (allocated(InData%RotFrame_x)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x), ubound(InData%RotFrame_x)) + call RegPack(Buf, InData%RotFrame_x) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RotFrame_u + call RegPack(Buf, allocated(InData%RotFrame_u)) + if (allocated(InData%RotFrame_u)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u), ubound(InData%RotFrame_u)) + call RegPack(Buf, InData%RotFrame_u) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! IsLoad_u + call RegPack(Buf, allocated(InData%IsLoad_u)) + if (allocated(InData%IsLoad_u)) then + call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) + call RegPack(Buf, InData%IsLoad_u) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DerivOrder_x + call RegPack(Buf, allocated(InData%DerivOrder_x)) + if (allocated(InData%DerivOrder_x)) then + call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x), ubound(InData%DerivOrder_x)) + call RegPack(Buf, InData%DerivOrder_x) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MD_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackInitOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! writeOutputHdr + if (allocated(OutData%writeOutputHdr)) deallocate(OutData%writeOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%writeOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%writeOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%writeOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! writeOutputUnt + if (allocated(OutData%writeOutputUnt)) deallocate(OutData%writeOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%writeOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%writeOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%writeOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Ver + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + ! CableCChanRqst + if (allocated(OutData%CableCChanRqst)) deallocate(OutData%CableCChanRqst) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CableCChanRqst(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableCChanRqst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CableCChanRqst) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LinNames_y + if (allocated(OutData%LinNames_y)) deallocate(OutData%LinNames_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LinNames_x + if (allocated(OutData%LinNames_x)) deallocate(OutData%LinNames_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LinNames_u + if (allocated(OutData%LinNames_u)) deallocate(OutData%LinNames_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RotFrame_y + if (allocated(OutData%RotFrame_y)) deallocate(OutData%RotFrame_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RotFrame_x + if (allocated(OutData%RotFrame_x)) deallocate(OutData%RotFrame_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RotFrame_u + if (allocated(OutData%RotFrame_u)) deallocate(OutData%RotFrame_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! IsLoad_u + if (allocated(OutData%IsLoad_u)) deallocate(OutData%IsLoad_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IsLoad_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IsLoad_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! DerivOrder_x + if (allocated(OutData%DerivOrder_x)) deallocate(OutData%DerivOrder_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DerivOrder_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DerivOrder_x) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE MD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(MD_ContinuousStateType), INTENT(IN) :: SrcContStateData TYPE(MD_ContinuousStateType), INTENT(INOUT) :: DstContStateData @@ -7310,137 +4653,45 @@ SUBROUTINE MD_DestroyContState( ContStateData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE MD_DestroyContState - SUBROUTINE MD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MD_ContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackContState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! states allocated yes/no - IF ( ALLOCATED(InData%states) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! states upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%states) ! states - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%states) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%states,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%states,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%states,1), UBOUND(InData%states,1) - DbKiBuf(Db_Xferred) = InData%states(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_PackContState - - SUBROUTINE MD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MD_ContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackContState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! states not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%states)) DEALLOCATE(OutData%states) - ALLOCATE(OutData%states(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%states.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%states,1), UBOUND(OutData%states,1) - OutData%states(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_UnPackContState +subroutine MD_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MD_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + ! states + call RegPack(Buf, allocated(InData%states)) + if (allocated(InData%states)) then + call RegPackBounds(Buf, 1, lbound(InData%states), ubound(InData%states)) + call RegPack(Buf, InData%states) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MD_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackContState' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! states + if (allocated(OutData%states)) deallocate(OutData%states) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%states(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%states.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%states) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE MD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(MD_DiscreteStateType), INTENT(IN) :: SrcDiscStateData TYPE(MD_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData @@ -7463,113 +4714,36 @@ SUBROUTINE MD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE MD_DestroyDiscState - - SUBROUTINE MD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MD_DiscreteStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackDiscState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! dummy - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%dummy - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE MD_PackDiscState - - SUBROUTINE MD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MD_DiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackDiscState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! + CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyDiscState' + ErrStat = ErrID_None ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%dummy = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE MD_UnPackDiscState + END SUBROUTINE MD_DestroyDiscState + + +subroutine MD_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MD_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + ! dummy + call RegPack(Buf, InData%dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MD_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackDiscState' + if (Buf%ErrStat /= ErrID_None) return + ! dummy + call RegUnpack(Buf, OutData%dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE MD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(MD_ConstraintStateType), INTENT(IN) :: SrcConstrStateData TYPE(MD_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData @@ -7602,103 +4776,26 @@ SUBROUTINE MD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) END SUBROUTINE MD_DestroyConstrState - SUBROUTINE MD_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MD_ConstraintStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackConstrState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! dummy - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%dummy - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE MD_PackConstrState - - SUBROUTINE MD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MD_ConstraintStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackConstrState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%dummy = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE MD_UnPackConstrState +subroutine MD_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MD_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + ! dummy + call RegPack(Buf, InData%dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MD_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + ! dummy + call RegUnpack(Buf, OutData%dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE MD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(MD_OtherStateType), INTENT(IN) :: SrcOtherStateData TYPE(MD_OtherStateType), INTENT(INOUT) :: DstOtherStateData @@ -7731,103 +4828,26 @@ SUBROUTINE MD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) END SUBROUTINE MD_DestroyOtherState - SUBROUTINE MD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MD_OtherStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackOtherState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! dummy - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%dummy - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE MD_PackOtherState - - SUBROUTINE MD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MD_OtherStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackOtherState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%dummy = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE MD_UnPackOtherState +subroutine MD_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MD_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackOtherState' + if (Buf%ErrStat >= AbortErrLev) return + ! dummy + call RegPack(Buf, InData%dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MD_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackOtherState' + if (Buf%ErrStat /= ErrID_None) return + ! dummy + call RegUnpack(Buf, OutData%dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE MD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) TYPE(MD_MiscVarType), INTENT(IN) :: SrcMiscData TYPE(MD_MiscVarType), INTENT(INOUT) :: DstMiscData @@ -8261,2069 +5281,752 @@ SUBROUTINE MD_DestroyMisc( MiscData, ErrStat, ErrMsg ) IF (ALLOCATED(MiscData%LineList)) THEN DO i1 = LBOUND(MiscData%LineList,1), UBOUND(MiscData%LineList,1) CALL MD_DestroyLine( MiscData%LineList(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%LineList) -ENDIF -IF (ALLOCATED(MiscData%FailList)) THEN -DO i1 = LBOUND(MiscData%FailList,1), UBOUND(MiscData%FailList,1) - CALL MD_DestroyFail( MiscData%FailList(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%FailList) -ENDIF -IF (ALLOCATED(MiscData%FreeConIs)) THEN - DEALLOCATE(MiscData%FreeConIs) -ENDIF -IF (ALLOCATED(MiscData%CpldConIs)) THEN - DEALLOCATE(MiscData%CpldConIs) -ENDIF -IF (ALLOCATED(MiscData%FreeRodIs)) THEN - DEALLOCATE(MiscData%FreeRodIs) -ENDIF -IF (ALLOCATED(MiscData%CpldRodIs)) THEN - DEALLOCATE(MiscData%CpldRodIs) -ENDIF -IF (ALLOCATED(MiscData%FreeBodyIs)) THEN - DEALLOCATE(MiscData%FreeBodyIs) -ENDIF -IF (ALLOCATED(MiscData%CpldBodyIs)) THEN - DEALLOCATE(MiscData%CpldBodyIs) -ENDIF -IF (ALLOCATED(MiscData%LineStateIs1)) THEN - DEALLOCATE(MiscData%LineStateIs1) -ENDIF -IF (ALLOCATED(MiscData%LineStateIsN)) THEN - DEALLOCATE(MiscData%LineStateIsN) -ENDIF -IF (ALLOCATED(MiscData%ConStateIs1)) THEN - DEALLOCATE(MiscData%ConStateIs1) -ENDIF -IF (ALLOCATED(MiscData%ConStateIsN)) THEN - DEALLOCATE(MiscData%ConStateIsN) -ENDIF -IF (ALLOCATED(MiscData%RodStateIs1)) THEN - DEALLOCATE(MiscData%RodStateIs1) -ENDIF -IF (ALLOCATED(MiscData%RodStateIsN)) THEN - DEALLOCATE(MiscData%RodStateIsN) -ENDIF -IF (ALLOCATED(MiscData%BodyStateIs1)) THEN - DEALLOCATE(MiscData%BodyStateIs1) -ENDIF -IF (ALLOCATED(MiscData%BodyStateIsN)) THEN - DEALLOCATE(MiscData%BodyStateIsN) -ENDIF - CALL MD_DestroyContState( MiscData%xTemp, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyContState( MiscData%xdTemp, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MiscData%MDWrOutput)) THEN - DEALLOCATE(MiscData%MDWrOutput) -ENDIF -IF (ALLOCATED(MiscData%BathymetryGrid)) THEN - DEALLOCATE(MiscData%BathymetryGrid) -ENDIF -IF (ALLOCATED(MiscData%BathGrid_Xs)) THEN - DEALLOCATE(MiscData%BathGrid_Xs) -ENDIF -IF (ALLOCATED(MiscData%BathGrid_Ys)) THEN - DEALLOCATE(MiscData%BathGrid_Ys) -ENDIF -IF (ALLOCATED(MiscData%BathGrid_npoints)) THEN - DEALLOCATE(MiscData%BathGrid_npoints) -ENDIF - END SUBROUTINE MD_DestroyMisc - - SUBROUTINE MD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MD_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! LineTypeList allocated yes/no - IF ( ALLOCATED(InData%LineTypeList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LineTypeList upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%LineTypeList,1), UBOUND(InData%LineTypeList,1) - Int_BufSz = Int_BufSz + 3 ! LineTypeList: size of buffers for each call to pack subtype - CALL MD_PackLineProp( Re_Buf, Db_Buf, Int_Buf, InData%LineTypeList(i1), ErrStat2, ErrMsg2, .TRUE. ) ! LineTypeList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! LineTypeList - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! LineTypeList - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! LineTypeList - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! RodTypeList allocated yes/no - IF ( ALLOCATED(InData%RodTypeList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RodTypeList upper/lower bounds for each dimension - DO i1 = LBOUND(InData%RodTypeList,1), UBOUND(InData%RodTypeList,1) - Int_BufSz = Int_BufSz + 3 ! RodTypeList: size of buffers for each call to pack subtype - CALL MD_PackRodProp( Re_Buf, Db_Buf, Int_Buf, InData%RodTypeList(i1), ErrStat2, ErrMsg2, .TRUE. ) ! RodTypeList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! RodTypeList - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! RodTypeList - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! RodTypeList - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! GroundBody: size of buffers for each call to pack subtype - CALL MD_PackBody( Re_Buf, Db_Buf, Int_Buf, InData%GroundBody, ErrStat2, ErrMsg2, .TRUE. ) ! GroundBody - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! GroundBody - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! GroundBody - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! GroundBody - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! BodyList allocated yes/no - IF ( ALLOCATED(InData%BodyList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BodyList upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BodyList,1), UBOUND(InData%BodyList,1) - Int_BufSz = Int_BufSz + 3 ! BodyList: size of buffers for each call to pack subtype - CALL MD_PackBody( Re_Buf, Db_Buf, Int_Buf, InData%BodyList(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BodyList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BodyList - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BodyList - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BodyList - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! RodList allocated yes/no - IF ( ALLOCATED(InData%RodList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RodList upper/lower bounds for each dimension - DO i1 = LBOUND(InData%RodList,1), UBOUND(InData%RodList,1) - Int_BufSz = Int_BufSz + 3 ! RodList: size of buffers for each call to pack subtype - CALL MD_PackRod( Re_Buf, Db_Buf, Int_Buf, InData%RodList(i1), ErrStat2, ErrMsg2, .TRUE. ) ! RodList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! RodList - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! RodList - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! RodList - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! ConnectList allocated yes/no - IF ( ALLOCATED(InData%ConnectList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ConnectList upper/lower bounds for each dimension - DO i1 = LBOUND(InData%ConnectList,1), UBOUND(InData%ConnectList,1) - Int_BufSz = Int_BufSz + 3 ! ConnectList: size of buffers for each call to pack subtype - CALL MD_PackConnect( Re_Buf, Db_Buf, Int_Buf, InData%ConnectList(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ConnectList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ConnectList - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ConnectList - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ConnectList - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! LineList allocated yes/no - IF ( ALLOCATED(InData%LineList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LineList upper/lower bounds for each dimension - DO i1 = LBOUND(InData%LineList,1), UBOUND(InData%LineList,1) - Int_BufSz = Int_BufSz + 3 ! LineList: size of buffers for each call to pack subtype - CALL MD_PackLine( Re_Buf, Db_Buf, Int_Buf, InData%LineList(i1), ErrStat2, ErrMsg2, .TRUE. ) ! LineList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! LineList - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! LineList - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! LineList - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! FailList allocated yes/no - IF ( ALLOCATED(InData%FailList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FailList upper/lower bounds for each dimension - DO i1 = LBOUND(InData%FailList,1), UBOUND(InData%FailList,1) - Int_BufSz = Int_BufSz + 3 ! FailList: size of buffers for each call to pack subtype - CALL MD_PackFail( Re_Buf, Db_Buf, Int_Buf, InData%FailList(i1), ErrStat2, ErrMsg2, .TRUE. ) ! FailList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FailList - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FailList - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FailList - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! FreeConIs allocated yes/no - IF ( ALLOCATED(InData%FreeConIs) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FreeConIs upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%FreeConIs) ! FreeConIs - END IF - Int_BufSz = Int_BufSz + 1 ! CpldConIs allocated yes/no - IF ( ALLOCATED(InData%CpldConIs) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CpldConIs upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%CpldConIs) ! CpldConIs - END IF - Int_BufSz = Int_BufSz + 1 ! FreeRodIs allocated yes/no - IF ( ALLOCATED(InData%FreeRodIs) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FreeRodIs upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%FreeRodIs) ! FreeRodIs - END IF - Int_BufSz = Int_BufSz + 1 ! CpldRodIs allocated yes/no - IF ( ALLOCATED(InData%CpldRodIs) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CpldRodIs upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%CpldRodIs) ! CpldRodIs - END IF - Int_BufSz = Int_BufSz + 1 ! FreeBodyIs allocated yes/no - IF ( ALLOCATED(InData%FreeBodyIs) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FreeBodyIs upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%FreeBodyIs) ! FreeBodyIs - END IF - Int_BufSz = Int_BufSz + 1 ! CpldBodyIs allocated yes/no - IF ( ALLOCATED(InData%CpldBodyIs) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CpldBodyIs upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%CpldBodyIs) ! CpldBodyIs - END IF - Int_BufSz = Int_BufSz + 1 ! LineStateIs1 allocated yes/no - IF ( ALLOCATED(InData%LineStateIs1) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LineStateIs1 upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LineStateIs1) ! LineStateIs1 - END IF - Int_BufSz = Int_BufSz + 1 ! LineStateIsN allocated yes/no - IF ( ALLOCATED(InData%LineStateIsN) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LineStateIsN upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LineStateIsN) ! LineStateIsN - END IF - Int_BufSz = Int_BufSz + 1 ! ConStateIs1 allocated yes/no - IF ( ALLOCATED(InData%ConStateIs1) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ConStateIs1 upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ConStateIs1) ! ConStateIs1 - END IF - Int_BufSz = Int_BufSz + 1 ! ConStateIsN allocated yes/no - IF ( ALLOCATED(InData%ConStateIsN) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ConStateIsN upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ConStateIsN) ! ConStateIsN - END IF - Int_BufSz = Int_BufSz + 1 ! RodStateIs1 allocated yes/no - IF ( ALLOCATED(InData%RodStateIs1) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RodStateIs1 upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RodStateIs1) ! RodStateIs1 - END IF - Int_BufSz = Int_BufSz + 1 ! RodStateIsN allocated yes/no - IF ( ALLOCATED(InData%RodStateIsN) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RodStateIsN upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RodStateIsN) ! RodStateIsN - END IF - Int_BufSz = Int_BufSz + 1 ! BodyStateIs1 allocated yes/no - IF ( ALLOCATED(InData%BodyStateIs1) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BodyStateIs1 upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BodyStateIs1) ! BodyStateIs1 - END IF - Int_BufSz = Int_BufSz + 1 ! BodyStateIsN allocated yes/no - IF ( ALLOCATED(InData%BodyStateIsN) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BodyStateIsN upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BodyStateIsN) ! BodyStateIsN - END IF - Int_BufSz = Int_BufSz + 1 ! Nx - Int_BufSz = Int_BufSz + 1 ! WaveTi - Int_BufSz = Int_BufSz + 3 ! xTemp: size of buffers for each call to pack subtype - CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xTemp, ErrStat2, ErrMsg2, .TRUE. ) ! xTemp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xTemp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xTemp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xTemp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! xdTemp: size of buffers for each call to pack subtype - CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdTemp, ErrStat2, ErrMsg2, .TRUE. ) ! xdTemp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xdTemp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xdTemp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xdTemp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Db_BufSz = Db_BufSz + SIZE(InData%zeros6) ! zeros6 - Int_BufSz = Int_BufSz + 1 ! MDWrOutput allocated yes/no - IF ( ALLOCATED(InData%MDWrOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MDWrOutput upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%MDWrOutput) ! MDWrOutput - END IF - Db_BufSz = Db_BufSz + 1 ! LastOutTime - Re_BufSz = Re_BufSz + SIZE(InData%PtfmInit) ! PtfmInit - Int_BufSz = Int_BufSz + 1 ! BathymetryGrid allocated yes/no - IF ( ALLOCATED(InData%BathymetryGrid) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BathymetryGrid upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%BathymetryGrid) ! BathymetryGrid - END IF - Int_BufSz = Int_BufSz + 1 ! BathGrid_Xs allocated yes/no - IF ( ALLOCATED(InData%BathGrid_Xs) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BathGrid_Xs upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%BathGrid_Xs) ! BathGrid_Xs - END IF - Int_BufSz = Int_BufSz + 1 ! BathGrid_Ys allocated yes/no - IF ( ALLOCATED(InData%BathGrid_Ys) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BathGrid_Ys upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%BathGrid_Ys) ! BathGrid_Ys - END IF - Int_BufSz = Int_BufSz + 1 ! BathGrid_npoints allocated yes/no - IF ( ALLOCATED(InData%BathGrid_npoints) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BathGrid_npoints upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BathGrid_npoints) ! BathGrid_npoints - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%LineTypeList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LineTypeList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineTypeList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LineTypeList,1), UBOUND(InData%LineTypeList,1) - CALL MD_PackLineProp( Re_Buf, Db_Buf, Int_Buf, InData%LineTypeList(i1), ErrStat2, ErrMsg2, OnlySize ) ! LineTypeList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RodTypeList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RodTypeList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RodTypeList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RodTypeList,1), UBOUND(InData%RodTypeList,1) - CALL MD_PackRodProp( Re_Buf, Db_Buf, Int_Buf, InData%RodTypeList(i1), ErrStat2, ErrMsg2, OnlySize ) ! RodTypeList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL MD_PackBody( Re_Buf, Db_Buf, Int_Buf, InData%GroundBody, ErrStat2, ErrMsg2, OnlySize ) ! GroundBody - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%BodyList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BodyList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BodyList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BodyList,1), UBOUND(InData%BodyList,1) - CALL MD_PackBody( Re_Buf, Db_Buf, Int_Buf, InData%BodyList(i1), ErrStat2, ErrMsg2, OnlySize ) ! BodyList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RodList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RodList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RodList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RodList,1), UBOUND(InData%RodList,1) - CALL MD_PackRod( Re_Buf, Db_Buf, Int_Buf, InData%RodList(i1), ErrStat2, ErrMsg2, OnlySize ) ! RodList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ConnectList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ConnectList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ConnectList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ConnectList,1), UBOUND(InData%ConnectList,1) - CALL MD_PackConnect( Re_Buf, Db_Buf, Int_Buf, InData%ConnectList(i1), ErrStat2, ErrMsg2, OnlySize ) ! ConnectList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LineList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LineList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LineList,1), UBOUND(InData%LineList,1) - CALL MD_PackLine( Re_Buf, Db_Buf, Int_Buf, InData%LineList(i1), ErrStat2, ErrMsg2, OnlySize ) ! LineList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FailList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FailList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FailList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FailList,1), UBOUND(InData%FailList,1) - CALL MD_PackFail( Re_Buf, Db_Buf, Int_Buf, InData%FailList(i1), ErrStat2, ErrMsg2, OnlySize ) ! FailList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FreeConIs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FreeConIs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FreeConIs,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FreeConIs,1), UBOUND(InData%FreeConIs,1) - IntKiBuf(Int_Xferred) = InData%FreeConIs(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CpldConIs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CpldConIs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CpldConIs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CpldConIs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CpldConIs,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CpldConIs,2), UBOUND(InData%CpldConIs,2) - DO i1 = LBOUND(InData%CpldConIs,1), UBOUND(InData%CpldConIs,1) - IntKiBuf(Int_Xferred) = InData%CpldConIs(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FreeRodIs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FreeRodIs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FreeRodIs,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FreeRodIs,1), UBOUND(InData%FreeRodIs,1) - IntKiBuf(Int_Xferred) = InData%FreeRodIs(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CpldRodIs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CpldRodIs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CpldRodIs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CpldRodIs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CpldRodIs,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CpldRodIs,2), UBOUND(InData%CpldRodIs,2) - DO i1 = LBOUND(InData%CpldRodIs,1), UBOUND(InData%CpldRodIs,1) - IntKiBuf(Int_Xferred) = InData%CpldRodIs(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FreeBodyIs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FreeBodyIs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FreeBodyIs,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FreeBodyIs,1), UBOUND(InData%FreeBodyIs,1) - IntKiBuf(Int_Xferred) = InData%FreeBodyIs(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CpldBodyIs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CpldBodyIs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CpldBodyIs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CpldBodyIs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CpldBodyIs,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CpldBodyIs,2), UBOUND(InData%CpldBodyIs,2) - DO i1 = LBOUND(InData%CpldBodyIs,1), UBOUND(InData%CpldBodyIs,1) - IntKiBuf(Int_Xferred) = InData%CpldBodyIs(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LineStateIs1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LineStateIs1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineStateIs1,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LineStateIs1,1), UBOUND(InData%LineStateIs1,1) - IntKiBuf(Int_Xferred) = InData%LineStateIs1(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LineStateIsN) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LineStateIsN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineStateIsN,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LineStateIsN,1), UBOUND(InData%LineStateIsN,1) - IntKiBuf(Int_Xferred) = InData%LineStateIsN(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ConStateIs1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ConStateIs1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ConStateIs1,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ConStateIs1,1), UBOUND(InData%ConStateIs1,1) - IntKiBuf(Int_Xferred) = InData%ConStateIs1(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ConStateIsN) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ConStateIsN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ConStateIsN,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ConStateIsN,1), UBOUND(InData%ConStateIsN,1) - IntKiBuf(Int_Xferred) = InData%ConStateIsN(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RodStateIs1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RodStateIs1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RodStateIs1,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RodStateIs1,1), UBOUND(InData%RodStateIs1,1) - IntKiBuf(Int_Xferred) = InData%RodStateIs1(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RodStateIsN) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RodStateIsN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RodStateIsN,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RodStateIsN,1), UBOUND(InData%RodStateIsN,1) - IntKiBuf(Int_Xferred) = InData%RodStateIsN(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BodyStateIs1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BodyStateIs1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BodyStateIs1,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BodyStateIs1,1), UBOUND(InData%BodyStateIs1,1) - IntKiBuf(Int_Xferred) = InData%BodyStateIs1(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BodyStateIsN) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BodyStateIsN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BodyStateIsN,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BodyStateIsN,1), UBOUND(InData%BodyStateIsN,1) - IntKiBuf(Int_Xferred) = InData%BodyStateIsN(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%Nx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveTi - Int_Xferred = Int_Xferred + 1 - CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xTemp, ErrStat2, ErrMsg2, OnlySize ) ! xTemp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdTemp, ErrStat2, ErrMsg2, OnlySize ) ! xdTemp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - DO i1 = LBOUND(InData%zeros6,1), UBOUND(InData%zeros6,1) - DbKiBuf(Db_Xferred) = InData%zeros6(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%MDWrOutput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MDWrOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MDWrOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MDWrOutput,1), UBOUND(InData%MDWrOutput,1) - DbKiBuf(Db_Xferred) = InData%MDWrOutput(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - DbKiBuf(Db_Xferred) = InData%LastOutTime - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%PtfmInit,1), UBOUND(InData%PtfmInit,1) - ReKiBuf(Re_Xferred) = InData%PtfmInit(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%BathymetryGrid) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BathymetryGrid,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BathymetryGrid,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BathymetryGrid,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BathymetryGrid,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BathymetryGrid,2), UBOUND(InData%BathymetryGrid,2) - DO i1 = LBOUND(InData%BathymetryGrid,1), UBOUND(InData%BathymetryGrid,1) - DbKiBuf(Db_Xferred) = InData%BathymetryGrid(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BathGrid_Xs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BathGrid_Xs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BathGrid_Xs,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BathGrid_Xs,1), UBOUND(InData%BathGrid_Xs,1) - DbKiBuf(Db_Xferred) = InData%BathGrid_Xs(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BathGrid_Ys) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BathGrid_Ys,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BathGrid_Ys,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BathGrid_Ys,1), UBOUND(InData%BathGrid_Ys,1) - DbKiBuf(Db_Xferred) = InData%BathGrid_Ys(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BathGrid_npoints) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BathGrid_npoints,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BathGrid_npoints,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BathGrid_npoints,1), UBOUND(InData%BathGrid_npoints,1) - IntKiBuf(Int_Xferred) = InData%BathGrid_npoints(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_PackMisc - - SUBROUTINE MD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MD_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineTypeList not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LineTypeList)) DEALLOCATE(OutData%LineTypeList) - ALLOCATE(OutData%LineTypeList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineTypeList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LineTypeList,1), UBOUND(OutData%LineTypeList,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_UnpackLineProp( Re_Buf, Db_Buf, Int_Buf, OutData%LineTypeList(i1), ErrStat2, ErrMsg2 ) ! LineTypeList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RodTypeList not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RodTypeList)) DEALLOCATE(OutData%RodTypeList) - ALLOCATE(OutData%RodTypeList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodTypeList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RodTypeList,1), UBOUND(OutData%RodTypeList,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_UnpackRodProp( Re_Buf, Db_Buf, Int_Buf, OutData%RodTypeList(i1), ErrStat2, ErrMsg2 ) ! RodTypeList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_UnpackBody( Re_Buf, Db_Buf, Int_Buf, OutData%GroundBody, ErrStat2, ErrMsg2 ) ! GroundBody - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BodyList not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BodyList)) DEALLOCATE(OutData%BodyList) - ALLOCATE(OutData%BodyList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BodyList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BodyList,1), UBOUND(OutData%BodyList,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_UnpackBody( Re_Buf, Db_Buf, Int_Buf, OutData%BodyList(i1), ErrStat2, ErrMsg2 ) ! BodyList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RodList not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RodList)) DEALLOCATE(OutData%RodList) - ALLOCATE(OutData%RodList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RodList,1), UBOUND(OutData%RodList,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_UnpackRod( Re_Buf, Db_Buf, Int_Buf, OutData%RodList(i1), ErrStat2, ErrMsg2 ) ! RodList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ConnectList not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ConnectList)) DEALLOCATE(OutData%ConnectList) - ALLOCATE(OutData%ConnectList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ConnectList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ConnectList,1), UBOUND(OutData%ConnectList,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_UnpackConnect( Re_Buf, Db_Buf, Int_Buf, OutData%ConnectList(i1), ErrStat2, ErrMsg2 ) ! ConnectList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineList not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LineList)) DEALLOCATE(OutData%LineList) - ALLOCATE(OutData%LineList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LineList,1), UBOUND(OutData%LineList,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_UnpackLine( Re_Buf, Db_Buf, Int_Buf, OutData%LineList(i1), ErrStat2, ErrMsg2 ) ! LineList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FailList not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FailList)) DEALLOCATE(OutData%FailList) - ALLOCATE(OutData%FailList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FailList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FailList,1), UBOUND(OutData%FailList,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_UnpackFail( Re_Buf, Db_Buf, Int_Buf, OutData%FailList(i1), ErrStat2, ErrMsg2 ) ! FailList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FreeConIs not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FreeConIs)) DEALLOCATE(OutData%FreeConIs) - ALLOCATE(OutData%FreeConIs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FreeConIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FreeConIs,1), UBOUND(OutData%FreeConIs,1) - OutData%FreeConIs(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CpldConIs not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CpldConIs)) DEALLOCATE(OutData%CpldConIs) - ALLOCATE(OutData%CpldConIs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CpldConIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CpldConIs,2), UBOUND(OutData%CpldConIs,2) - DO i1 = LBOUND(OutData%CpldConIs,1), UBOUND(OutData%CpldConIs,1) - OutData%CpldConIs(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FreeRodIs not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FreeRodIs)) DEALLOCATE(OutData%FreeRodIs) - ALLOCATE(OutData%FreeRodIs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FreeRodIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FreeRodIs,1), UBOUND(OutData%FreeRodIs,1) - OutData%FreeRodIs(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CpldRodIs not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CpldRodIs)) DEALLOCATE(OutData%CpldRodIs) - ALLOCATE(OutData%CpldRodIs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CpldRodIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CpldRodIs,2), UBOUND(OutData%CpldRodIs,2) - DO i1 = LBOUND(OutData%CpldRodIs,1), UBOUND(OutData%CpldRodIs,1) - OutData%CpldRodIs(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FreeBodyIs not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FreeBodyIs)) DEALLOCATE(OutData%FreeBodyIs) - ALLOCATE(OutData%FreeBodyIs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FreeBodyIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FreeBodyIs,1), UBOUND(OutData%FreeBodyIs,1) - OutData%FreeBodyIs(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CpldBodyIs not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CpldBodyIs)) DEALLOCATE(OutData%CpldBodyIs) - ALLOCATE(OutData%CpldBodyIs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CpldBodyIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CpldBodyIs,2), UBOUND(OutData%CpldBodyIs,2) - DO i1 = LBOUND(OutData%CpldBodyIs,1), UBOUND(OutData%CpldBodyIs,1) - OutData%CpldBodyIs(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineStateIs1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LineStateIs1)) DEALLOCATE(OutData%LineStateIs1) - ALLOCATE(OutData%LineStateIs1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineStateIs1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LineStateIs1,1), UBOUND(OutData%LineStateIs1,1) - OutData%LineStateIs1(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineStateIsN not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LineStateIsN)) DEALLOCATE(OutData%LineStateIsN) - ALLOCATE(OutData%LineStateIsN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineStateIsN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LineStateIsN,1), UBOUND(OutData%LineStateIsN,1) - OutData%LineStateIsN(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ConStateIs1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ConStateIs1)) DEALLOCATE(OutData%ConStateIs1) - ALLOCATE(OutData%ConStateIs1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ConStateIs1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ConStateIs1,1), UBOUND(OutData%ConStateIs1,1) - OutData%ConStateIs1(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ConStateIsN not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ConStateIsN)) DEALLOCATE(OutData%ConStateIsN) - ALLOCATE(OutData%ConStateIsN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ConStateIsN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ConStateIsN,1), UBOUND(OutData%ConStateIsN,1) - OutData%ConStateIsN(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RodStateIs1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RodStateIs1)) DEALLOCATE(OutData%RodStateIs1) - ALLOCATE(OutData%RodStateIs1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodStateIs1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RodStateIs1,1), UBOUND(OutData%RodStateIs1,1) - OutData%RodStateIs1(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RodStateIsN not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RodStateIsN)) DEALLOCATE(OutData%RodStateIsN) - ALLOCATE(OutData%RodStateIsN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodStateIsN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RodStateIsN,1), UBOUND(OutData%RodStateIsN,1) - OutData%RodStateIsN(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BodyStateIs1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BodyStateIs1)) DEALLOCATE(OutData%BodyStateIs1) - ALLOCATE(OutData%BodyStateIs1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BodyStateIs1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BodyStateIs1,1), UBOUND(OutData%BodyStateIs1,1) - OutData%BodyStateIs1(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BodyStateIsN not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BodyStateIsN)) DEALLOCATE(OutData%BodyStateIsN) - ALLOCATE(OutData%BodyStateIsN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BodyStateIsN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BodyStateIsN,1), UBOUND(OutData%BodyStateIsN,1) - OutData%BodyStateIsN(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%Nx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WaveTi = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%xTemp, ErrStat2, ErrMsg2 ) ! xTemp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%xdTemp, ErrStat2, ErrMsg2 ) ! xdTemp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - i1_l = LBOUND(OutData%zeros6,1) - i1_u = UBOUND(OutData%zeros6,1) - DO i1 = LBOUND(OutData%zeros6,1), UBOUND(OutData%zeros6,1) - OutData%zeros6(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MDWrOutput not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MDWrOutput)) DEALLOCATE(OutData%MDWrOutput) - ALLOCATE(OutData%MDWrOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MDWrOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MDWrOutput,1), UBOUND(OutData%MDWrOutput,1) - OutData%MDWrOutput(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - OutData%LastOutTime = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%PtfmInit,1) - i1_u = UBOUND(OutData%PtfmInit,1) - DO i1 = LBOUND(OutData%PtfmInit,1), UBOUND(OutData%PtfmInit,1) - OutData%PtfmInit(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BathymetryGrid not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BathymetryGrid)) DEALLOCATE(OutData%BathymetryGrid) - ALLOCATE(OutData%BathymetryGrid(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BathymetryGrid.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BathymetryGrid,2), UBOUND(OutData%BathymetryGrid,2) - DO i1 = LBOUND(OutData%BathymetryGrid,1), UBOUND(OutData%BathymetryGrid,1) - OutData%BathymetryGrid(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BathGrid_Xs not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BathGrid_Xs)) DEALLOCATE(OutData%BathGrid_Xs) - ALLOCATE(OutData%BathGrid_Xs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BathGrid_Xs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BathGrid_Xs,1), UBOUND(OutData%BathGrid_Xs,1) - OutData%BathGrid_Xs(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BathGrid_Ys not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BathGrid_Ys)) DEALLOCATE(OutData%BathGrid_Ys) - ALLOCATE(OutData%BathGrid_Ys(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BathGrid_Ys.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BathGrid_Ys,1), UBOUND(OutData%BathGrid_Ys,1) - OutData%BathGrid_Ys(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BathGrid_npoints not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BathGrid_npoints)) DEALLOCATE(OutData%BathGrid_npoints) - ALLOCATE(OutData%BathGrid_npoints(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BathGrid_npoints.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BathGrid_npoints,1), UBOUND(OutData%BathGrid_npoints,1) - OutData%BathGrid_npoints(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_UnPackMisc + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(MiscData%LineList) +ENDIF +IF (ALLOCATED(MiscData%FailList)) THEN +DO i1 = LBOUND(MiscData%FailList,1), UBOUND(MiscData%FailList,1) + CALL MD_DestroyFail( MiscData%FailList(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(MiscData%FailList) +ENDIF +IF (ALLOCATED(MiscData%FreeConIs)) THEN + DEALLOCATE(MiscData%FreeConIs) +ENDIF +IF (ALLOCATED(MiscData%CpldConIs)) THEN + DEALLOCATE(MiscData%CpldConIs) +ENDIF +IF (ALLOCATED(MiscData%FreeRodIs)) THEN + DEALLOCATE(MiscData%FreeRodIs) +ENDIF +IF (ALLOCATED(MiscData%CpldRodIs)) THEN + DEALLOCATE(MiscData%CpldRodIs) +ENDIF +IF (ALLOCATED(MiscData%FreeBodyIs)) THEN + DEALLOCATE(MiscData%FreeBodyIs) +ENDIF +IF (ALLOCATED(MiscData%CpldBodyIs)) THEN + DEALLOCATE(MiscData%CpldBodyIs) +ENDIF +IF (ALLOCATED(MiscData%LineStateIs1)) THEN + DEALLOCATE(MiscData%LineStateIs1) +ENDIF +IF (ALLOCATED(MiscData%LineStateIsN)) THEN + DEALLOCATE(MiscData%LineStateIsN) +ENDIF +IF (ALLOCATED(MiscData%ConStateIs1)) THEN + DEALLOCATE(MiscData%ConStateIs1) +ENDIF +IF (ALLOCATED(MiscData%ConStateIsN)) THEN + DEALLOCATE(MiscData%ConStateIsN) +ENDIF +IF (ALLOCATED(MiscData%RodStateIs1)) THEN + DEALLOCATE(MiscData%RodStateIs1) +ENDIF +IF (ALLOCATED(MiscData%RodStateIsN)) THEN + DEALLOCATE(MiscData%RodStateIsN) +ENDIF +IF (ALLOCATED(MiscData%BodyStateIs1)) THEN + DEALLOCATE(MiscData%BodyStateIs1) +ENDIF +IF (ALLOCATED(MiscData%BodyStateIsN)) THEN + DEALLOCATE(MiscData%BodyStateIsN) +ENDIF + CALL MD_DestroyContState( MiscData%xTemp, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL MD_DestroyContState( MiscData%xdTemp, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(MiscData%MDWrOutput)) THEN + DEALLOCATE(MiscData%MDWrOutput) +ENDIF +IF (ALLOCATED(MiscData%BathymetryGrid)) THEN + DEALLOCATE(MiscData%BathymetryGrid) +ENDIF +IF (ALLOCATED(MiscData%BathGrid_Xs)) THEN + DEALLOCATE(MiscData%BathGrid_Xs) +ENDIF +IF (ALLOCATED(MiscData%BathGrid_Ys)) THEN + DEALLOCATE(MiscData%BathGrid_Ys) +ENDIF +IF (ALLOCATED(MiscData%BathGrid_npoints)) THEN + DEALLOCATE(MiscData%BathGrid_npoints) +ENDIF + END SUBROUTINE MD_DestroyMisc + +subroutine MD_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MD_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackMisc' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + ! LineTypeList + call RegPack(Buf, allocated(InData%LineTypeList)) + if (allocated(InData%LineTypeList)) then + call RegPackBounds(Buf, 1, lbound(InData%LineTypeList), ubound(InData%LineTypeList)) + LB(1:1) = lbound(InData%LineTypeList) + UB(1:1) = ubound(InData%LineTypeList) + do i1 = LB(1), UB(1) + call MD_PackLineProp(Buf, InData%LineTypeList(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RodTypeList + call RegPack(Buf, allocated(InData%RodTypeList)) + if (allocated(InData%RodTypeList)) then + call RegPackBounds(Buf, 1, lbound(InData%RodTypeList), ubound(InData%RodTypeList)) + LB(1:1) = lbound(InData%RodTypeList) + UB(1:1) = ubound(InData%RodTypeList) + do i1 = LB(1), UB(1) + call MD_PackRodProp(Buf, InData%RodTypeList(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! GroundBody + call MD_PackBody(Buf, InData%GroundBody) + if (RegCheckErr(Buf, RoutineName)) return + ! BodyList + call RegPack(Buf, allocated(InData%BodyList)) + if (allocated(InData%BodyList)) then + call RegPackBounds(Buf, 1, lbound(InData%BodyList), ubound(InData%BodyList)) + LB(1:1) = lbound(InData%BodyList) + UB(1:1) = ubound(InData%BodyList) + do i1 = LB(1), UB(1) + call MD_PackBody(Buf, InData%BodyList(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RodList + call RegPack(Buf, allocated(InData%RodList)) + if (allocated(InData%RodList)) then + call RegPackBounds(Buf, 1, lbound(InData%RodList), ubound(InData%RodList)) + LB(1:1) = lbound(InData%RodList) + UB(1:1) = ubound(InData%RodList) + do i1 = LB(1), UB(1) + call MD_PackRod(Buf, InData%RodList(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ConnectList + call RegPack(Buf, allocated(InData%ConnectList)) + if (allocated(InData%ConnectList)) then + call RegPackBounds(Buf, 1, lbound(InData%ConnectList), ubound(InData%ConnectList)) + LB(1:1) = lbound(InData%ConnectList) + UB(1:1) = ubound(InData%ConnectList) + do i1 = LB(1), UB(1) + call MD_PackConnect(Buf, InData%ConnectList(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LineList + call RegPack(Buf, allocated(InData%LineList)) + if (allocated(InData%LineList)) then + call RegPackBounds(Buf, 1, lbound(InData%LineList), ubound(InData%LineList)) + LB(1:1) = lbound(InData%LineList) + UB(1:1) = ubound(InData%LineList) + do i1 = LB(1), UB(1) + call MD_PackLine(Buf, InData%LineList(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FailList + call RegPack(Buf, allocated(InData%FailList)) + if (allocated(InData%FailList)) then + call RegPackBounds(Buf, 1, lbound(InData%FailList), ubound(InData%FailList)) + LB(1:1) = lbound(InData%FailList) + UB(1:1) = ubound(InData%FailList) + do i1 = LB(1), UB(1) + call MD_PackFail(Buf, InData%FailList(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FreeConIs + call RegPack(Buf, allocated(InData%FreeConIs)) + if (allocated(InData%FreeConIs)) then + call RegPackBounds(Buf, 1, lbound(InData%FreeConIs), ubound(InData%FreeConIs)) + call RegPack(Buf, InData%FreeConIs) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CpldConIs + call RegPack(Buf, allocated(InData%CpldConIs)) + if (allocated(InData%CpldConIs)) then + call RegPackBounds(Buf, 2, lbound(InData%CpldConIs), ubound(InData%CpldConIs)) + call RegPack(Buf, InData%CpldConIs) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FreeRodIs + call RegPack(Buf, allocated(InData%FreeRodIs)) + if (allocated(InData%FreeRodIs)) then + call RegPackBounds(Buf, 1, lbound(InData%FreeRodIs), ubound(InData%FreeRodIs)) + call RegPack(Buf, InData%FreeRodIs) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CpldRodIs + call RegPack(Buf, allocated(InData%CpldRodIs)) + if (allocated(InData%CpldRodIs)) then + call RegPackBounds(Buf, 2, lbound(InData%CpldRodIs), ubound(InData%CpldRodIs)) + call RegPack(Buf, InData%CpldRodIs) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FreeBodyIs + call RegPack(Buf, allocated(InData%FreeBodyIs)) + if (allocated(InData%FreeBodyIs)) then + call RegPackBounds(Buf, 1, lbound(InData%FreeBodyIs), ubound(InData%FreeBodyIs)) + call RegPack(Buf, InData%FreeBodyIs) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CpldBodyIs + call RegPack(Buf, allocated(InData%CpldBodyIs)) + if (allocated(InData%CpldBodyIs)) then + call RegPackBounds(Buf, 2, lbound(InData%CpldBodyIs), ubound(InData%CpldBodyIs)) + call RegPack(Buf, InData%CpldBodyIs) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LineStateIs1 + call RegPack(Buf, allocated(InData%LineStateIs1)) + if (allocated(InData%LineStateIs1)) then + call RegPackBounds(Buf, 1, lbound(InData%LineStateIs1), ubound(InData%LineStateIs1)) + call RegPack(Buf, InData%LineStateIs1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LineStateIsN + call RegPack(Buf, allocated(InData%LineStateIsN)) + if (allocated(InData%LineStateIsN)) then + call RegPackBounds(Buf, 1, lbound(InData%LineStateIsN), ubound(InData%LineStateIsN)) + call RegPack(Buf, InData%LineStateIsN) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ConStateIs1 + call RegPack(Buf, allocated(InData%ConStateIs1)) + if (allocated(InData%ConStateIs1)) then + call RegPackBounds(Buf, 1, lbound(InData%ConStateIs1), ubound(InData%ConStateIs1)) + call RegPack(Buf, InData%ConStateIs1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ConStateIsN + call RegPack(Buf, allocated(InData%ConStateIsN)) + if (allocated(InData%ConStateIsN)) then + call RegPackBounds(Buf, 1, lbound(InData%ConStateIsN), ubound(InData%ConStateIsN)) + call RegPack(Buf, InData%ConStateIsN) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RodStateIs1 + call RegPack(Buf, allocated(InData%RodStateIs1)) + if (allocated(InData%RodStateIs1)) then + call RegPackBounds(Buf, 1, lbound(InData%RodStateIs1), ubound(InData%RodStateIs1)) + call RegPack(Buf, InData%RodStateIs1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RodStateIsN + call RegPack(Buf, allocated(InData%RodStateIsN)) + if (allocated(InData%RodStateIsN)) then + call RegPackBounds(Buf, 1, lbound(InData%RodStateIsN), ubound(InData%RodStateIsN)) + call RegPack(Buf, InData%RodStateIsN) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BodyStateIs1 + call RegPack(Buf, allocated(InData%BodyStateIs1)) + if (allocated(InData%BodyStateIs1)) then + call RegPackBounds(Buf, 1, lbound(InData%BodyStateIs1), ubound(InData%BodyStateIs1)) + call RegPack(Buf, InData%BodyStateIs1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BodyStateIsN + call RegPack(Buf, allocated(InData%BodyStateIsN)) + if (allocated(InData%BodyStateIsN)) then + call RegPackBounds(Buf, 1, lbound(InData%BodyStateIsN), ubound(InData%BodyStateIsN)) + call RegPack(Buf, InData%BodyStateIsN) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Nx + call RegPack(Buf, InData%Nx) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveTi + call RegPack(Buf, InData%WaveTi) + if (RegCheckErr(Buf, RoutineName)) return + ! xTemp + call MD_PackContState(Buf, InData%xTemp) + if (RegCheckErr(Buf, RoutineName)) return + ! xdTemp + call MD_PackContState(Buf, InData%xdTemp) + if (RegCheckErr(Buf, RoutineName)) return + ! zeros6 + call RegPack(Buf, InData%zeros6) + if (RegCheckErr(Buf, RoutineName)) return + ! MDWrOutput + call RegPack(Buf, allocated(InData%MDWrOutput)) + if (allocated(InData%MDWrOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%MDWrOutput), ubound(InData%MDWrOutput)) + call RegPack(Buf, InData%MDWrOutput) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LastOutTime + call RegPack(Buf, InData%LastOutTime) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmInit + call RegPack(Buf, InData%PtfmInit) + if (RegCheckErr(Buf, RoutineName)) return + ! BathymetryGrid + call RegPack(Buf, allocated(InData%BathymetryGrid)) + if (allocated(InData%BathymetryGrid)) then + call RegPackBounds(Buf, 2, lbound(InData%BathymetryGrid), ubound(InData%BathymetryGrid)) + call RegPack(Buf, InData%BathymetryGrid) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BathGrid_Xs + call RegPack(Buf, allocated(InData%BathGrid_Xs)) + if (allocated(InData%BathGrid_Xs)) then + call RegPackBounds(Buf, 1, lbound(InData%BathGrid_Xs), ubound(InData%BathGrid_Xs)) + call RegPack(Buf, InData%BathGrid_Xs) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BathGrid_Ys + call RegPack(Buf, allocated(InData%BathGrid_Ys)) + if (allocated(InData%BathGrid_Ys)) then + call RegPackBounds(Buf, 1, lbound(InData%BathGrid_Ys), ubound(InData%BathGrid_Ys)) + call RegPack(Buf, InData%BathGrid_Ys) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BathGrid_npoints + call RegPack(Buf, allocated(InData%BathGrid_npoints)) + if (allocated(InData%BathGrid_npoints)) then + call RegPackBounds(Buf, 1, lbound(InData%BathGrid_npoints), ubound(InData%BathGrid_npoints)) + call RegPack(Buf, InData%BathGrid_npoints) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MD_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackMisc' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! LineTypeList + if (allocated(OutData%LineTypeList)) deallocate(OutData%LineTypeList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LineTypeList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineTypeList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackLineProp(Buf, OutData%LineTypeList(i1)) ! LineTypeList + end do + end if + ! RodTypeList + if (allocated(OutData%RodTypeList)) deallocate(OutData%RodTypeList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RodTypeList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodTypeList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackRodProp(Buf, OutData%RodTypeList(i1)) ! RodTypeList + end do + end if + ! GroundBody + call MD_UnpackBody(Buf, OutData%GroundBody) ! GroundBody + ! BodyList + if (allocated(OutData%BodyList)) deallocate(OutData%BodyList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BodyList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BodyList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackBody(Buf, OutData%BodyList(i1)) ! BodyList + end do + end if + ! RodList + if (allocated(OutData%RodList)) deallocate(OutData%RodList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RodList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackRod(Buf, OutData%RodList(i1)) ! RodList + end do + end if + ! ConnectList + if (allocated(OutData%ConnectList)) deallocate(OutData%ConnectList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ConnectList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ConnectList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackConnect(Buf, OutData%ConnectList(i1)) ! ConnectList + end do + end if + ! LineList + if (allocated(OutData%LineList)) deallocate(OutData%LineList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LineList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackLine(Buf, OutData%LineList(i1)) ! LineList + end do + end if + ! FailList + if (allocated(OutData%FailList)) deallocate(OutData%FailList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FailList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FailList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackFail(Buf, OutData%FailList(i1)) ! FailList + end do + end if + ! FreeConIs + if (allocated(OutData%FreeConIs)) deallocate(OutData%FreeConIs) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FreeConIs(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FreeConIs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FreeConIs) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CpldConIs + if (allocated(OutData%CpldConIs)) deallocate(OutData%CpldConIs) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CpldConIs(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CpldConIs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CpldConIs) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! FreeRodIs + if (allocated(OutData%FreeRodIs)) deallocate(OutData%FreeRodIs) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FreeRodIs(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FreeRodIs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FreeRodIs) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CpldRodIs + if (allocated(OutData%CpldRodIs)) deallocate(OutData%CpldRodIs) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CpldRodIs(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CpldRodIs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CpldRodIs) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! FreeBodyIs + if (allocated(OutData%FreeBodyIs)) deallocate(OutData%FreeBodyIs) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FreeBodyIs(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FreeBodyIs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FreeBodyIs) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CpldBodyIs + if (allocated(OutData%CpldBodyIs)) deallocate(OutData%CpldBodyIs) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CpldBodyIs(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CpldBodyIs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CpldBodyIs) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LineStateIs1 + if (allocated(OutData%LineStateIs1)) deallocate(OutData%LineStateIs1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LineStateIs1(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineStateIs1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LineStateIs1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LineStateIsN + if (allocated(OutData%LineStateIsN)) deallocate(OutData%LineStateIsN) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LineStateIsN(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineStateIsN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LineStateIsN) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ConStateIs1 + if (allocated(OutData%ConStateIs1)) deallocate(OutData%ConStateIs1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ConStateIs1(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ConStateIs1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ConStateIs1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ConStateIsN + if (allocated(OutData%ConStateIsN)) deallocate(OutData%ConStateIsN) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ConStateIsN(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ConStateIsN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ConStateIsN) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RodStateIs1 + if (allocated(OutData%RodStateIs1)) deallocate(OutData%RodStateIs1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RodStateIs1(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodStateIs1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RodStateIs1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RodStateIsN + if (allocated(OutData%RodStateIsN)) deallocate(OutData%RodStateIsN) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RodStateIsN(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodStateIsN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RodStateIsN) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BodyStateIs1 + if (allocated(OutData%BodyStateIs1)) deallocate(OutData%BodyStateIs1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BodyStateIs1(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BodyStateIs1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BodyStateIs1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BodyStateIsN + if (allocated(OutData%BodyStateIsN)) deallocate(OutData%BodyStateIsN) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BodyStateIsN(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BodyStateIsN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BodyStateIsN) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Nx + call RegUnpack(Buf, OutData%Nx) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveTi + call RegUnpack(Buf, OutData%WaveTi) + if (RegCheckErr(Buf, RoutineName)) return + ! xTemp + call MD_UnpackContState(Buf, OutData%xTemp) ! xTemp + ! xdTemp + call MD_UnpackContState(Buf, OutData%xdTemp) ! xdTemp + ! zeros6 + call RegUnpack(Buf, OutData%zeros6) + if (RegCheckErr(Buf, RoutineName)) return + ! MDWrOutput + if (allocated(OutData%MDWrOutput)) deallocate(OutData%MDWrOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MDWrOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MDWrOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MDWrOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LastOutTime + call RegUnpack(Buf, OutData%LastOutTime) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmInit + call RegUnpack(Buf, OutData%PtfmInit) + if (RegCheckErr(Buf, RoutineName)) return + ! BathymetryGrid + if (allocated(OutData%BathymetryGrid)) deallocate(OutData%BathymetryGrid) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BathymetryGrid(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BathymetryGrid.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BathymetryGrid) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BathGrid_Xs + if (allocated(OutData%BathGrid_Xs)) deallocate(OutData%BathGrid_Xs) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BathGrid_Xs(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BathGrid_Xs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BathGrid_Xs) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BathGrid_Ys + if (allocated(OutData%BathGrid_Ys)) deallocate(OutData%BathGrid_Ys) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BathGrid_Ys(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BathGrid_Ys.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BathGrid_Ys) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BathGrid_npoints + if (allocated(OutData%BathGrid_npoints)) deallocate(OutData%BathGrid_npoints) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BathGrid_npoints(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BathGrid_npoints.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BathGrid_npoints) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE MD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(MD_ParameterType), INTENT(IN) :: SrcParamData TYPE(MD_ParameterType), INTENT(INOUT) :: DstParamData @@ -10808,1551 +6511,813 @@ SUBROUTINE MD_DestroyParam( ParamData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE MD_DestroyParam - SUBROUTINE MD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MD_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! nLineTypes - Int_BufSz = Int_BufSz + 1 ! nRodTypes - Int_BufSz = Int_BufSz + 1 ! nConnects - Int_BufSz = Int_BufSz + 1 ! nConnectsExtra - Int_BufSz = Int_BufSz + 1 ! nBodies - Int_BufSz = Int_BufSz + 1 ! nRods - Int_BufSz = Int_BufSz + 1 ! nLines - Int_BufSz = Int_BufSz + 1 ! nCtrlChans - Int_BufSz = Int_BufSz + 1 ! nFails - Int_BufSz = Int_BufSz + 1 ! nFreeBodies - Int_BufSz = Int_BufSz + 1 ! nFreeRods - Int_BufSz = Int_BufSz + 1 ! nFreeCons - Int_BufSz = Int_BufSz + 1 ! nCpldBodies allocated yes/no - IF ( ALLOCATED(InData%nCpldBodies) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! nCpldBodies upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%nCpldBodies) ! nCpldBodies - END IF - Int_BufSz = Int_BufSz + 1 ! nCpldRods allocated yes/no - IF ( ALLOCATED(InData%nCpldRods) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! nCpldRods upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%nCpldRods) ! nCpldRods - END IF - Int_BufSz = Int_BufSz + 1 ! nCpldCons allocated yes/no - IF ( ALLOCATED(InData%nCpldCons) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! nCpldCons upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%nCpldCons) ! nCpldCons - END IF - Int_BufSz = Int_BufSz + 1 ! NConns - Int_BufSz = Int_BufSz + 1 ! NAnchs - Db_BufSz = Db_BufSz + 1 ! Tmax - Db_BufSz = Db_BufSz + 1 ! g - Db_BufSz = Db_BufSz + 1 ! rhoW - Db_BufSz = Db_BufSz + 1 ! WtrDpth - Db_BufSz = Db_BufSz + 1 ! kBot - Db_BufSz = Db_BufSz + 1 ! cBot - Db_BufSz = Db_BufSz + 1 ! dtM0 - Db_BufSz = Db_BufSz + 1 ! dtCoupling - Int_BufSz = Int_BufSz + 1 ! NumOuts - Db_BufSz = Db_BufSz + 1 ! dtOut - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1 ! OutParam allocated yes/no - IF ( ALLOCATED(InData%OutParam) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutParam upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - Int_BufSz = Int_BufSz + 3 ! OutParam: size of buffers for each call to pack subtype - CALL MD_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutParam - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutParam - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutParam - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%Delim) ! Delim - Int_BufSz = Int_BufSz + 1 ! MDUnOut - Int_BufSz = Int_BufSz + 1*LEN(InData%PriPath) ! PriPath - Int_BufSz = Int_BufSz + 1 ! writeLog - Int_BufSz = Int_BufSz + 1 ! UnLog - Int_BufSz = Int_BufSz + 1 ! WaveKin - Int_BufSz = Int_BufSz + 1 ! Current - Int_BufSz = Int_BufSz + 1 ! nTurbines - Int_BufSz = Int_BufSz + 1 ! TurbineRefPos allocated yes/no - IF ( ALLOCATED(InData%TurbineRefPos) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TurbineRefPos upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TurbineRefPos) ! TurbineRefPos - END IF - Db_BufSz = Db_BufSz + 1 ! mu_kT - Db_BufSz = Db_BufSz + 1 ! mu_kA - Db_BufSz = Db_BufSz + 1 ! mc - Db_BufSz = Db_BufSz + 1 ! cv - Int_BufSz = Int_BufSz + 1 ! nxWave - Int_BufSz = Int_BufSz + 1 ! nyWave - Int_BufSz = Int_BufSz + 1 ! nzWave - Int_BufSz = Int_BufSz + 1 ! ntWave - Int_BufSz = Int_BufSz + 1 ! pxWave allocated yes/no - IF ( ALLOCATED(InData%pxWave) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! pxWave upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%pxWave) ! pxWave - END IF - Int_BufSz = Int_BufSz + 1 ! pyWave allocated yes/no - IF ( ALLOCATED(InData%pyWave) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! pyWave upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%pyWave) ! pyWave - END IF - Int_BufSz = Int_BufSz + 1 ! pzWave allocated yes/no - IF ( ALLOCATED(InData%pzWave) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! pzWave upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%pzWave) ! pzWave - END IF - Re_BufSz = Re_BufSz + 1 ! dtWave - Int_BufSz = Int_BufSz + 1 ! uxWave allocated yes/no - IF ( ALLOCATED(InData%uxWave) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! uxWave upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%uxWave) ! uxWave - END IF - Int_BufSz = Int_BufSz + 1 ! uyWave allocated yes/no - IF ( ALLOCATED(InData%uyWave) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! uyWave upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%uyWave) ! uyWave - END IF - Int_BufSz = Int_BufSz + 1 ! uzWave allocated yes/no - IF ( ALLOCATED(InData%uzWave) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! uzWave upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%uzWave) ! uzWave - END IF - Int_BufSz = Int_BufSz + 1 ! axWave allocated yes/no - IF ( ALLOCATED(InData%axWave) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! axWave upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%axWave) ! axWave - END IF - Int_BufSz = Int_BufSz + 1 ! ayWave allocated yes/no - IF ( ALLOCATED(InData%ayWave) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! ayWave upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ayWave) ! ayWave - END IF - Int_BufSz = Int_BufSz + 1 ! azWave allocated yes/no - IF ( ALLOCATED(InData%azWave) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! azWave upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%azWave) ! azWave - END IF - Int_BufSz = Int_BufSz + 1 ! PDyn allocated yes/no - IF ( ALLOCATED(InData%PDyn) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! PDyn upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PDyn) ! PDyn - END IF - Int_BufSz = Int_BufSz + 1 ! zeta allocated yes/no - IF ( ALLOCATED(InData%zeta) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! zeta upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%zeta) ! zeta - END IF - Int_BufSz = Int_BufSz + 1 ! nzCurrent - Int_BufSz = Int_BufSz + 1 ! pzCurrent allocated yes/no - IF ( ALLOCATED(InData%pzCurrent) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! pzCurrent upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%pzCurrent) ! pzCurrent - END IF - Int_BufSz = Int_BufSz + 1 ! uxCurrent allocated yes/no - IF ( ALLOCATED(InData%uxCurrent) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! uxCurrent upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%uxCurrent) ! uxCurrent - END IF - Int_BufSz = Int_BufSz + 1 ! uyCurrent allocated yes/no - IF ( ALLOCATED(InData%uyCurrent) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! uyCurrent upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%uyCurrent) ! uyCurrent - END IF - Int_BufSz = Int_BufSz + 1 ! Nx0 - Int_BufSz = Int_BufSz + 1 ! Jac_u_indx allocated yes/no - IF ( ALLOCATED(InData%Jac_u_indx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_u_indx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_u_indx) ! Jac_u_indx - END IF - Int_BufSz = Int_BufSz + 1 ! du allocated yes/no - IF ( ALLOCATED(InData%du) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! du upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%du) ! du - END IF - Int_BufSz = Int_BufSz + 1 ! dx allocated yes/no - IF ( ALLOCATED(InData%dx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dx upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%dx) ! dx - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_ny - Int_BufSz = Int_BufSz + 1 ! Jac_nx - Int_BufSz = Int_BufSz + 1 ! dxIdx_map2_xStateIdx allocated yes/no - IF ( ALLOCATED(InData%dxIdx_map2_xStateIdx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dxIdx_map2_xStateIdx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%dxIdx_map2_xStateIdx) ! dxIdx_map2_xStateIdx - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%nLineTypes - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nRodTypes - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nConnects - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nConnectsExtra - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nBodies - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nRods - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nLines - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nCtrlChans - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nFails - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nFreeBodies - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nFreeRods - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nFreeCons - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%nCpldBodies) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%nCpldBodies,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nCpldBodies,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%nCpldBodies,1), UBOUND(InData%nCpldBodies,1) - IntKiBuf(Int_Xferred) = InData%nCpldBodies(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%nCpldRods) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%nCpldRods,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nCpldRods,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%nCpldRods,1), UBOUND(InData%nCpldRods,1) - IntKiBuf(Int_Xferred) = InData%nCpldRods(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%nCpldCons) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%nCpldCons,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nCpldCons,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%nCpldCons,1), UBOUND(InData%nCpldCons,1) - IntKiBuf(Int_Xferred) = InData%nCpldCons(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NConns - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NAnchs - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%Tmax - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%g - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%rhoW - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%WtrDpth - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%kBot - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%cBot - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%dtM0 - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%dtCoupling - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%dtOut - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutParam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParam,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - CALL MD_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%MDUnOut - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%PriPath) - IntKiBuf(Int_Xferred) = ICHAR(InData%PriPath(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%writeLog - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UnLog - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveKin - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Current - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nTurbines - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TurbineRefPos) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TurbineRefPos,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TurbineRefPos,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TurbineRefPos,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TurbineRefPos,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TurbineRefPos,2), UBOUND(InData%TurbineRefPos,2) - DO i1 = LBOUND(InData%TurbineRefPos,1), UBOUND(InData%TurbineRefPos,1) - ReKiBuf(Re_Xferred) = InData%TurbineRefPos(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - DbKiBuf(Db_Xferred) = InData%mu_kT - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%mu_kA - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%mc - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%cv - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nxWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nyWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nzWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ntWave - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%pxWave) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%pxWave,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pxWave,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%pxWave,1), UBOUND(InData%pxWave,1) - ReKiBuf(Re_Xferred) = InData%pxWave(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%pyWave) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%pyWave,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pyWave,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%pyWave,1), UBOUND(InData%pyWave,1) - ReKiBuf(Re_Xferred) = InData%pyWave(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%pzWave) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%pzWave,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pzWave,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%pzWave,1), UBOUND(InData%pzWave,1) - ReKiBuf(Re_Xferred) = InData%pzWave(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%dtWave - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%uxWave) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uxWave,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uxWave,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uxWave,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uxWave,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uxWave,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uxWave,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uxWave,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uxWave,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%uxWave,4), UBOUND(InData%uxWave,4) - DO i3 = LBOUND(InData%uxWave,3), UBOUND(InData%uxWave,3) - DO i2 = LBOUND(InData%uxWave,2), UBOUND(InData%uxWave,2) - DO i1 = LBOUND(InData%uxWave,1), UBOUND(InData%uxWave,1) - ReKiBuf(Re_Xferred) = InData%uxWave(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%uyWave) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uyWave,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uyWave,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uyWave,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uyWave,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uyWave,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uyWave,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uyWave,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uyWave,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%uyWave,4), UBOUND(InData%uyWave,4) - DO i3 = LBOUND(InData%uyWave,3), UBOUND(InData%uyWave,3) - DO i2 = LBOUND(InData%uyWave,2), UBOUND(InData%uyWave,2) - DO i1 = LBOUND(InData%uyWave,1), UBOUND(InData%uyWave,1) - ReKiBuf(Re_Xferred) = InData%uyWave(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%uzWave) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uzWave,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uzWave,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uzWave,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uzWave,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uzWave,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uzWave,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uzWave,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uzWave,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%uzWave,4), UBOUND(InData%uzWave,4) - DO i3 = LBOUND(InData%uzWave,3), UBOUND(InData%uzWave,3) - DO i2 = LBOUND(InData%uzWave,2), UBOUND(InData%uzWave,2) - DO i1 = LBOUND(InData%uzWave,1), UBOUND(InData%uzWave,1) - ReKiBuf(Re_Xferred) = InData%uzWave(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%axWave) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%axWave,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%axWave,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%axWave,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%axWave,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%axWave,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%axWave,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%axWave,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%axWave,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%axWave,4), UBOUND(InData%axWave,4) - DO i3 = LBOUND(InData%axWave,3), UBOUND(InData%axWave,3) - DO i2 = LBOUND(InData%axWave,2), UBOUND(InData%axWave,2) - DO i1 = LBOUND(InData%axWave,1), UBOUND(InData%axWave,1) - ReKiBuf(Re_Xferred) = InData%axWave(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ayWave) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ayWave,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ayWave,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ayWave,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ayWave,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ayWave,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ayWave,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ayWave,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ayWave,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%ayWave,4), UBOUND(InData%ayWave,4) - DO i3 = LBOUND(InData%ayWave,3), UBOUND(InData%ayWave,3) - DO i2 = LBOUND(InData%ayWave,2), UBOUND(InData%ayWave,2) - DO i1 = LBOUND(InData%ayWave,1), UBOUND(InData%ayWave,1) - ReKiBuf(Re_Xferred) = InData%ayWave(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%azWave) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%azWave,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%azWave,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%azWave,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%azWave,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%azWave,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%azWave,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%azWave,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%azWave,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%azWave,4), UBOUND(InData%azWave,4) - DO i3 = LBOUND(InData%azWave,3), UBOUND(InData%azWave,3) - DO i2 = LBOUND(InData%azWave,2), UBOUND(InData%azWave,2) - DO i1 = LBOUND(InData%azWave,1), UBOUND(InData%azWave,1) - ReKiBuf(Re_Xferred) = InData%azWave(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PDyn) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PDyn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PDyn,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PDyn,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PDyn,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PDyn,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PDyn,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PDyn,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PDyn,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%PDyn,4), UBOUND(InData%PDyn,4) - DO i3 = LBOUND(InData%PDyn,3), UBOUND(InData%PDyn,3) - DO i2 = LBOUND(InData%PDyn,2), UBOUND(InData%PDyn,2) - DO i1 = LBOUND(InData%PDyn,1), UBOUND(InData%PDyn,1) - ReKiBuf(Re_Xferred) = InData%PDyn(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%zeta) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%zeta,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zeta,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%zeta,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zeta,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%zeta,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zeta,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%zeta,3), UBOUND(InData%zeta,3) - DO i2 = LBOUND(InData%zeta,2), UBOUND(InData%zeta,2) - DO i1 = LBOUND(InData%zeta,1), UBOUND(InData%zeta,1) - ReKiBuf(Re_Xferred) = InData%zeta(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%nzCurrent - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%pzCurrent) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%pzCurrent,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pzCurrent,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%pzCurrent,1), UBOUND(InData%pzCurrent,1) - ReKiBuf(Re_Xferred) = InData%pzCurrent(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%uxCurrent) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uxCurrent,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uxCurrent,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%uxCurrent,1), UBOUND(InData%uxCurrent,1) - ReKiBuf(Re_Xferred) = InData%uxCurrent(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%uyCurrent) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%uyCurrent,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uyCurrent,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%uyCurrent,1), UBOUND(InData%uyCurrent,1) - ReKiBuf(Re_Xferred) = InData%uyCurrent(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%Nx0 - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Jac_u_indx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_u_indx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_u_indx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jac_u_indx,2), UBOUND(InData%Jac_u_indx,2) - DO i1 = LBOUND(InData%Jac_u_indx,1), UBOUND(InData%Jac_u_indx,1) - IntKiBuf(Int_Xferred) = InData%Jac_u_indx(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%du) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%du,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%du,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%du,1), UBOUND(InData%du,1) - DbKiBuf(Db_Xferred) = InData%du(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dx,1), UBOUND(InData%dx,1) - DbKiBuf(Db_Xferred) = InData%dx(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%Jac_ny - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Jac_nx - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%dxIdx_map2_xStateIdx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dxIdx_map2_xStateIdx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dxIdx_map2_xStateIdx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dxIdx_map2_xStateIdx,1), UBOUND(InData%dxIdx_map2_xStateIdx,1) - IntKiBuf(Int_Xferred) = InData%dxIdx_map2_xStateIdx(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_PackParam - - SUBROUTINE MD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MD_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%nLineTypes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nRodTypes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nConnects = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nConnectsExtra = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nBodies = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nRods = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nLines = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nCtrlChans = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nFails = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nFreeBodies = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nFreeRods = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nFreeCons = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nCpldBodies not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%nCpldBodies)) DEALLOCATE(OutData%nCpldBodies) - ALLOCATE(OutData%nCpldBodies(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nCpldBodies.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%nCpldBodies,1), UBOUND(OutData%nCpldBodies,1) - OutData%nCpldBodies(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nCpldRods not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%nCpldRods)) DEALLOCATE(OutData%nCpldRods) - ALLOCATE(OutData%nCpldRods(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nCpldRods.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%nCpldRods,1), UBOUND(OutData%nCpldRods,1) - OutData%nCpldRods(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nCpldCons not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%nCpldCons)) DEALLOCATE(OutData%nCpldCons) - ALLOCATE(OutData%nCpldCons(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nCpldCons.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%nCpldCons,1), UBOUND(OutData%nCpldCons,1) - OutData%nCpldCons(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%NConns = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NAnchs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Tmax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%g = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%rhoW = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%WtrDpth = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%kBot = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%cBot = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%dtM0 = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%dtCoupling = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%dtOut = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutParam)) DEALLOCATE(OutData%OutParam) - ALLOCATE(OutData%OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutParam,1), UBOUND(OutData%OutParam,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_UnpackOutParmType( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%MDUnOut = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%PriPath) - OutData%PriPath(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%writeLog = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UnLog = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WaveKin = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Current = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nTurbines = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TurbineRefPos not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TurbineRefPos)) DEALLOCATE(OutData%TurbineRefPos) - ALLOCATE(OutData%TurbineRefPos(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TurbineRefPos.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TurbineRefPos,2), UBOUND(OutData%TurbineRefPos,2) - DO i1 = LBOUND(OutData%TurbineRefPos,1), UBOUND(OutData%TurbineRefPos,1) - OutData%TurbineRefPos(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%mu_kT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%mu_kA = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%mc = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%cv = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%nxWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nyWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nzWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ntWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pxWave not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%pxWave)) DEALLOCATE(OutData%pxWave) - ALLOCATE(OutData%pxWave(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%pxWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%pxWave,1), UBOUND(OutData%pxWave,1) - OutData%pxWave(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pyWave not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%pyWave)) DEALLOCATE(OutData%pyWave) - ALLOCATE(OutData%pyWave(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%pyWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%pyWave,1), UBOUND(OutData%pyWave,1) - OutData%pyWave(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pzWave not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%pzWave)) DEALLOCATE(OutData%pzWave) - ALLOCATE(OutData%pzWave(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%pzWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%pzWave,1), UBOUND(OutData%pzWave,1) - OutData%pzWave(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%dtWave = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! uxWave not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%uxWave)) DEALLOCATE(OutData%uxWave) - ALLOCATE(OutData%uxWave(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%uxWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%uxWave,4), UBOUND(OutData%uxWave,4) - DO i3 = LBOUND(OutData%uxWave,3), UBOUND(OutData%uxWave,3) - DO i2 = LBOUND(OutData%uxWave,2), UBOUND(OutData%uxWave,2) - DO i1 = LBOUND(OutData%uxWave,1), UBOUND(OutData%uxWave,1) - OutData%uxWave(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! uyWave not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%uyWave)) DEALLOCATE(OutData%uyWave) - ALLOCATE(OutData%uyWave(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%uyWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%uyWave,4), UBOUND(OutData%uyWave,4) - DO i3 = LBOUND(OutData%uyWave,3), UBOUND(OutData%uyWave,3) - DO i2 = LBOUND(OutData%uyWave,2), UBOUND(OutData%uyWave,2) - DO i1 = LBOUND(OutData%uyWave,1), UBOUND(OutData%uyWave,1) - OutData%uyWave(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! uzWave not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%uzWave)) DEALLOCATE(OutData%uzWave) - ALLOCATE(OutData%uzWave(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%uzWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%uzWave,4), UBOUND(OutData%uzWave,4) - DO i3 = LBOUND(OutData%uzWave,3), UBOUND(OutData%uzWave,3) - DO i2 = LBOUND(OutData%uzWave,2), UBOUND(OutData%uzWave,2) - DO i1 = LBOUND(OutData%uzWave,1), UBOUND(OutData%uzWave,1) - OutData%uzWave(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! axWave not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%axWave)) DEALLOCATE(OutData%axWave) - ALLOCATE(OutData%axWave(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%axWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%axWave,4), UBOUND(OutData%axWave,4) - DO i3 = LBOUND(OutData%axWave,3), UBOUND(OutData%axWave,3) - DO i2 = LBOUND(OutData%axWave,2), UBOUND(OutData%axWave,2) - DO i1 = LBOUND(OutData%axWave,1), UBOUND(OutData%axWave,1) - OutData%axWave(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ayWave not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ayWave)) DEALLOCATE(OutData%ayWave) - ALLOCATE(OutData%ayWave(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ayWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%ayWave,4), UBOUND(OutData%ayWave,4) - DO i3 = LBOUND(OutData%ayWave,3), UBOUND(OutData%ayWave,3) - DO i2 = LBOUND(OutData%ayWave,2), UBOUND(OutData%ayWave,2) - DO i1 = LBOUND(OutData%ayWave,1), UBOUND(OutData%ayWave,1) - OutData%ayWave(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! azWave not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%azWave)) DEALLOCATE(OutData%azWave) - ALLOCATE(OutData%azWave(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%azWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%azWave,4), UBOUND(OutData%azWave,4) - DO i3 = LBOUND(OutData%azWave,3), UBOUND(OutData%azWave,3) - DO i2 = LBOUND(OutData%azWave,2), UBOUND(OutData%azWave,2) - DO i1 = LBOUND(OutData%azWave,1), UBOUND(OutData%azWave,1) - OutData%azWave(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PDyn not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PDyn)) DEALLOCATE(OutData%PDyn) - ALLOCATE(OutData%PDyn(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PDyn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%PDyn,4), UBOUND(OutData%PDyn,4) - DO i3 = LBOUND(OutData%PDyn,3), UBOUND(OutData%PDyn,3) - DO i2 = LBOUND(OutData%PDyn,2), UBOUND(OutData%PDyn,2) - DO i1 = LBOUND(OutData%PDyn,1), UBOUND(OutData%PDyn,1) - OutData%PDyn(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! zeta not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%zeta)) DEALLOCATE(OutData%zeta) - ALLOCATE(OutData%zeta(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%zeta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%zeta,3), UBOUND(OutData%zeta,3) - DO i2 = LBOUND(OutData%zeta,2), UBOUND(OutData%zeta,2) - DO i1 = LBOUND(OutData%zeta,1), UBOUND(OutData%zeta,1) - OutData%zeta(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%nzCurrent = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pzCurrent not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%pzCurrent)) DEALLOCATE(OutData%pzCurrent) - ALLOCATE(OutData%pzCurrent(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%pzCurrent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%pzCurrent,1), UBOUND(OutData%pzCurrent,1) - OutData%pzCurrent(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! uxCurrent not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%uxCurrent)) DEALLOCATE(OutData%uxCurrent) - ALLOCATE(OutData%uxCurrent(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%uxCurrent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%uxCurrent,1), UBOUND(OutData%uxCurrent,1) - OutData%uxCurrent(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! uyCurrent not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%uyCurrent)) DEALLOCATE(OutData%uyCurrent) - ALLOCATE(OutData%uyCurrent(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%uyCurrent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%uyCurrent,1), UBOUND(OutData%uyCurrent,1) - OutData%uyCurrent(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Nx0 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_u_indx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Jac_u_indx)) DEALLOCATE(OutData%Jac_u_indx) - ALLOCATE(OutData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_u_indx,2), UBOUND(OutData%Jac_u_indx,2) - DO i1 = LBOUND(OutData%Jac_u_indx,1), UBOUND(OutData%Jac_u_indx,1) - OutData%Jac_u_indx(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! du not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%du)) DEALLOCATE(OutData%du) - ALLOCATE(OutData%du(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%du,1), UBOUND(OutData%du,1) - OutData%du(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%dx)) DEALLOCATE(OutData%dx) - ALLOCATE(OutData%dx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dx,1), UBOUND(OutData%dx,1) - OutData%dx(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - OutData%Jac_ny = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Jac_nx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dxIdx_map2_xStateIdx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%dxIdx_map2_xStateIdx)) DEALLOCATE(OutData%dxIdx_map2_xStateIdx) - ALLOCATE(OutData%dxIdx_map2_xStateIdx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dxIdx_map2_xStateIdx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dxIdx_map2_xStateIdx,1), UBOUND(OutData%dxIdx_map2_xStateIdx,1) - OutData%dxIdx_map2_xStateIdx(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_UnPackParam +subroutine MD_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MD_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackParam' + integer(IntKi) :: i1, i2, i3, i4 + integer(IntKi) :: LB(4), UB(4) + if (Buf%ErrStat >= AbortErrLev) return + ! nLineTypes + call RegPack(Buf, InData%nLineTypes) + if (RegCheckErr(Buf, RoutineName)) return + ! nRodTypes + call RegPack(Buf, InData%nRodTypes) + if (RegCheckErr(Buf, RoutineName)) return + ! nConnects + call RegPack(Buf, InData%nConnects) + if (RegCheckErr(Buf, RoutineName)) return + ! nConnectsExtra + call RegPack(Buf, InData%nConnectsExtra) + if (RegCheckErr(Buf, RoutineName)) return + ! nBodies + call RegPack(Buf, InData%nBodies) + if (RegCheckErr(Buf, RoutineName)) return + ! nRods + call RegPack(Buf, InData%nRods) + if (RegCheckErr(Buf, RoutineName)) return + ! nLines + call RegPack(Buf, InData%nLines) + if (RegCheckErr(Buf, RoutineName)) return + ! nCtrlChans + call RegPack(Buf, InData%nCtrlChans) + if (RegCheckErr(Buf, RoutineName)) return + ! nFails + call RegPack(Buf, InData%nFails) + if (RegCheckErr(Buf, RoutineName)) return + ! nFreeBodies + call RegPack(Buf, InData%nFreeBodies) + if (RegCheckErr(Buf, RoutineName)) return + ! nFreeRods + call RegPack(Buf, InData%nFreeRods) + if (RegCheckErr(Buf, RoutineName)) return + ! nFreeCons + call RegPack(Buf, InData%nFreeCons) + if (RegCheckErr(Buf, RoutineName)) return + ! nCpldBodies + call RegPack(Buf, allocated(InData%nCpldBodies)) + if (allocated(InData%nCpldBodies)) then + call RegPackBounds(Buf, 1, lbound(InData%nCpldBodies), ubound(InData%nCpldBodies)) + call RegPack(Buf, InData%nCpldBodies) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! nCpldRods + call RegPack(Buf, allocated(InData%nCpldRods)) + if (allocated(InData%nCpldRods)) then + call RegPackBounds(Buf, 1, lbound(InData%nCpldRods), ubound(InData%nCpldRods)) + call RegPack(Buf, InData%nCpldRods) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! nCpldCons + call RegPack(Buf, allocated(InData%nCpldCons)) + if (allocated(InData%nCpldCons)) then + call RegPackBounds(Buf, 1, lbound(InData%nCpldCons), ubound(InData%nCpldCons)) + call RegPack(Buf, InData%nCpldCons) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NConns + call RegPack(Buf, InData%NConns) + if (RegCheckErr(Buf, RoutineName)) return + ! NAnchs + call RegPack(Buf, InData%NAnchs) + if (RegCheckErr(Buf, RoutineName)) return + ! Tmax + call RegPack(Buf, InData%Tmax) + if (RegCheckErr(Buf, RoutineName)) return + ! g + call RegPack(Buf, InData%g) + if (RegCheckErr(Buf, RoutineName)) return + ! rhoW + call RegPack(Buf, InData%rhoW) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDpth + call RegPack(Buf, InData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! kBot + call RegPack(Buf, InData%kBot) + if (RegCheckErr(Buf, RoutineName)) return + ! cBot + call RegPack(Buf, InData%cBot) + if (RegCheckErr(Buf, RoutineName)) return + ! dtM0 + call RegPack(Buf, InData%dtM0) + if (RegCheckErr(Buf, RoutineName)) return + ! dtCoupling + call RegPack(Buf, InData%dtCoupling) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegPack(Buf, InData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! dtOut + call RegPack(Buf, InData%dtOut) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegPack(Buf, InData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! OutParam + call RegPack(Buf, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call MD_PackOutParmType(Buf, InData%OutParam(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Delim + call RegPack(Buf, InData%Delim) + if (RegCheckErr(Buf, RoutineName)) return + ! MDUnOut + call RegPack(Buf, InData%MDUnOut) + if (RegCheckErr(Buf, RoutineName)) return + ! PriPath + call RegPack(Buf, InData%PriPath) + if (RegCheckErr(Buf, RoutineName)) return + ! writeLog + call RegPack(Buf, InData%writeLog) + if (RegCheckErr(Buf, RoutineName)) return + ! UnLog + call RegPack(Buf, InData%UnLog) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveKin + call RegPack(Buf, InData%WaveKin) + if (RegCheckErr(Buf, RoutineName)) return + ! Current + call RegPack(Buf, InData%Current) + if (RegCheckErr(Buf, RoutineName)) return + ! nTurbines + call RegPack(Buf, InData%nTurbines) + if (RegCheckErr(Buf, RoutineName)) return + ! TurbineRefPos + call RegPack(Buf, allocated(InData%TurbineRefPos)) + if (allocated(InData%TurbineRefPos)) then + call RegPackBounds(Buf, 2, lbound(InData%TurbineRefPos), ubound(InData%TurbineRefPos)) + call RegPack(Buf, InData%TurbineRefPos) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! mu_kT + call RegPack(Buf, InData%mu_kT) + if (RegCheckErr(Buf, RoutineName)) return + ! mu_kA + call RegPack(Buf, InData%mu_kA) + if (RegCheckErr(Buf, RoutineName)) return + ! mc + call RegPack(Buf, InData%mc) + if (RegCheckErr(Buf, RoutineName)) return + ! cv + call RegPack(Buf, InData%cv) + if (RegCheckErr(Buf, RoutineName)) return + ! nxWave + call RegPack(Buf, InData%nxWave) + if (RegCheckErr(Buf, RoutineName)) return + ! nyWave + call RegPack(Buf, InData%nyWave) + if (RegCheckErr(Buf, RoutineName)) return + ! nzWave + call RegPack(Buf, InData%nzWave) + if (RegCheckErr(Buf, RoutineName)) return + ! ntWave + call RegPack(Buf, InData%ntWave) + if (RegCheckErr(Buf, RoutineName)) return + ! pxWave + call RegPack(Buf, allocated(InData%pxWave)) + if (allocated(InData%pxWave)) then + call RegPackBounds(Buf, 1, lbound(InData%pxWave), ubound(InData%pxWave)) + call RegPack(Buf, InData%pxWave) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! pyWave + call RegPack(Buf, allocated(InData%pyWave)) + if (allocated(InData%pyWave)) then + call RegPackBounds(Buf, 1, lbound(InData%pyWave), ubound(InData%pyWave)) + call RegPack(Buf, InData%pyWave) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! pzWave + call RegPack(Buf, allocated(InData%pzWave)) + if (allocated(InData%pzWave)) then + call RegPackBounds(Buf, 1, lbound(InData%pzWave), ubound(InData%pzWave)) + call RegPack(Buf, InData%pzWave) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! dtWave + call RegPack(Buf, InData%dtWave) + if (RegCheckErr(Buf, RoutineName)) return + ! uxWave + call RegPack(Buf, allocated(InData%uxWave)) + if (allocated(InData%uxWave)) then + call RegPackBounds(Buf, 4, lbound(InData%uxWave), ubound(InData%uxWave)) + call RegPack(Buf, InData%uxWave) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! uyWave + call RegPack(Buf, allocated(InData%uyWave)) + if (allocated(InData%uyWave)) then + call RegPackBounds(Buf, 4, lbound(InData%uyWave), ubound(InData%uyWave)) + call RegPack(Buf, InData%uyWave) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! uzWave + call RegPack(Buf, allocated(InData%uzWave)) + if (allocated(InData%uzWave)) then + call RegPackBounds(Buf, 4, lbound(InData%uzWave), ubound(InData%uzWave)) + call RegPack(Buf, InData%uzWave) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! axWave + call RegPack(Buf, allocated(InData%axWave)) + if (allocated(InData%axWave)) then + call RegPackBounds(Buf, 4, lbound(InData%axWave), ubound(InData%axWave)) + call RegPack(Buf, InData%axWave) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ayWave + call RegPack(Buf, allocated(InData%ayWave)) + if (allocated(InData%ayWave)) then + call RegPackBounds(Buf, 4, lbound(InData%ayWave), ubound(InData%ayWave)) + call RegPack(Buf, InData%ayWave) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! azWave + call RegPack(Buf, allocated(InData%azWave)) + if (allocated(InData%azWave)) then + call RegPackBounds(Buf, 4, lbound(InData%azWave), ubound(InData%azWave)) + call RegPack(Buf, InData%azWave) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PDyn + call RegPack(Buf, allocated(InData%PDyn)) + if (allocated(InData%PDyn)) then + call RegPackBounds(Buf, 4, lbound(InData%PDyn), ubound(InData%PDyn)) + call RegPack(Buf, InData%PDyn) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! zeta + call RegPack(Buf, allocated(InData%zeta)) + if (allocated(InData%zeta)) then + call RegPackBounds(Buf, 3, lbound(InData%zeta), ubound(InData%zeta)) + call RegPack(Buf, InData%zeta) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! nzCurrent + call RegPack(Buf, InData%nzCurrent) + if (RegCheckErr(Buf, RoutineName)) return + ! pzCurrent + call RegPack(Buf, allocated(InData%pzCurrent)) + if (allocated(InData%pzCurrent)) then + call RegPackBounds(Buf, 1, lbound(InData%pzCurrent), ubound(InData%pzCurrent)) + call RegPack(Buf, InData%pzCurrent) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! uxCurrent + call RegPack(Buf, allocated(InData%uxCurrent)) + if (allocated(InData%uxCurrent)) then + call RegPackBounds(Buf, 1, lbound(InData%uxCurrent), ubound(InData%uxCurrent)) + call RegPack(Buf, InData%uxCurrent) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! uyCurrent + call RegPack(Buf, allocated(InData%uyCurrent)) + if (allocated(InData%uyCurrent)) then + call RegPackBounds(Buf, 1, lbound(InData%uyCurrent), ubound(InData%uyCurrent)) + call RegPack(Buf, InData%uyCurrent) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Nx0 + call RegPack(Buf, InData%Nx0) + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_u_indx + call RegPack(Buf, allocated(InData%Jac_u_indx)) + if (allocated(InData%Jac_u_indx)) then + call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx), ubound(InData%Jac_u_indx)) + call RegPack(Buf, InData%Jac_u_indx) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! du + call RegPack(Buf, allocated(InData%du)) + if (allocated(InData%du)) then + call RegPackBounds(Buf, 1, lbound(InData%du), ubound(InData%du)) + call RegPack(Buf, InData%du) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! dx + call RegPack(Buf, allocated(InData%dx)) + if (allocated(InData%dx)) then + call RegPackBounds(Buf, 1, lbound(InData%dx), ubound(InData%dx)) + call RegPack(Buf, InData%dx) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_ny + call RegPack(Buf, InData%Jac_ny) + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_nx + call RegPack(Buf, InData%Jac_nx) + if (RegCheckErr(Buf, RoutineName)) return + ! dxIdx_map2_xStateIdx + call RegPack(Buf, allocated(InData%dxIdx_map2_xStateIdx)) + if (allocated(InData%dxIdx_map2_xStateIdx)) then + call RegPackBounds(Buf, 1, lbound(InData%dxIdx_map2_xStateIdx), ubound(InData%dxIdx_map2_xStateIdx)) + call RegPack(Buf, InData%dxIdx_map2_xStateIdx) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MD_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackParam' + integer(IntKi) :: i1, i2, i3, i4 + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! nLineTypes + call RegUnpack(Buf, OutData%nLineTypes) + if (RegCheckErr(Buf, RoutineName)) return + ! nRodTypes + call RegUnpack(Buf, OutData%nRodTypes) + if (RegCheckErr(Buf, RoutineName)) return + ! nConnects + call RegUnpack(Buf, OutData%nConnects) + if (RegCheckErr(Buf, RoutineName)) return + ! nConnectsExtra + call RegUnpack(Buf, OutData%nConnectsExtra) + if (RegCheckErr(Buf, RoutineName)) return + ! nBodies + call RegUnpack(Buf, OutData%nBodies) + if (RegCheckErr(Buf, RoutineName)) return + ! nRods + call RegUnpack(Buf, OutData%nRods) + if (RegCheckErr(Buf, RoutineName)) return + ! nLines + call RegUnpack(Buf, OutData%nLines) + if (RegCheckErr(Buf, RoutineName)) return + ! nCtrlChans + call RegUnpack(Buf, OutData%nCtrlChans) + if (RegCheckErr(Buf, RoutineName)) return + ! nFails + call RegUnpack(Buf, OutData%nFails) + if (RegCheckErr(Buf, RoutineName)) return + ! nFreeBodies + call RegUnpack(Buf, OutData%nFreeBodies) + if (RegCheckErr(Buf, RoutineName)) return + ! nFreeRods + call RegUnpack(Buf, OutData%nFreeRods) + if (RegCheckErr(Buf, RoutineName)) return + ! nFreeCons + call RegUnpack(Buf, OutData%nFreeCons) + if (RegCheckErr(Buf, RoutineName)) return + ! nCpldBodies + if (allocated(OutData%nCpldBodies)) deallocate(OutData%nCpldBodies) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%nCpldBodies(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%nCpldBodies.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%nCpldBodies) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! nCpldRods + if (allocated(OutData%nCpldRods)) deallocate(OutData%nCpldRods) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%nCpldRods(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%nCpldRods.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%nCpldRods) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! nCpldCons + if (allocated(OutData%nCpldCons)) deallocate(OutData%nCpldCons) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%nCpldCons(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%nCpldCons.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%nCpldCons) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NConns + call RegUnpack(Buf, OutData%NConns) + if (RegCheckErr(Buf, RoutineName)) return + ! NAnchs + call RegUnpack(Buf, OutData%NAnchs) + if (RegCheckErr(Buf, RoutineName)) return + ! Tmax + call RegUnpack(Buf, OutData%Tmax) + if (RegCheckErr(Buf, RoutineName)) return + ! g + call RegUnpack(Buf, OutData%g) + if (RegCheckErr(Buf, RoutineName)) return + ! rhoW + call RegUnpack(Buf, OutData%rhoW) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDpth + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! kBot + call RegUnpack(Buf, OutData%kBot) + if (RegCheckErr(Buf, RoutineName)) return + ! cBot + call RegUnpack(Buf, OutData%cBot) + if (RegCheckErr(Buf, RoutineName)) return + ! dtM0 + call RegUnpack(Buf, OutData%dtM0) + if (RegCheckErr(Buf, RoutineName)) return + ! dtCoupling + call RegUnpack(Buf, OutData%dtCoupling) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! dtOut + call RegUnpack(Buf, OutData%dtOut) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! OutParam + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam + end do + end if + ! Delim + call RegUnpack(Buf, OutData%Delim) + if (RegCheckErr(Buf, RoutineName)) return + ! MDUnOut + call RegUnpack(Buf, OutData%MDUnOut) + if (RegCheckErr(Buf, RoutineName)) return + ! PriPath + call RegUnpack(Buf, OutData%PriPath) + if (RegCheckErr(Buf, RoutineName)) return + ! writeLog + call RegUnpack(Buf, OutData%writeLog) + if (RegCheckErr(Buf, RoutineName)) return + ! UnLog + call RegUnpack(Buf, OutData%UnLog) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveKin + call RegUnpack(Buf, OutData%WaveKin) + if (RegCheckErr(Buf, RoutineName)) return + ! Current + call RegUnpack(Buf, OutData%Current) + if (RegCheckErr(Buf, RoutineName)) return + ! nTurbines + call RegUnpack(Buf, OutData%nTurbines) + if (RegCheckErr(Buf, RoutineName)) return + ! TurbineRefPos + if (allocated(OutData%TurbineRefPos)) deallocate(OutData%TurbineRefPos) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TurbineRefPos(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TurbineRefPos.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TurbineRefPos) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! mu_kT + call RegUnpack(Buf, OutData%mu_kT) + if (RegCheckErr(Buf, RoutineName)) return + ! mu_kA + call RegUnpack(Buf, OutData%mu_kA) + if (RegCheckErr(Buf, RoutineName)) return + ! mc + call RegUnpack(Buf, OutData%mc) + if (RegCheckErr(Buf, RoutineName)) return + ! cv + call RegUnpack(Buf, OutData%cv) + if (RegCheckErr(Buf, RoutineName)) return + ! nxWave + call RegUnpack(Buf, OutData%nxWave) + if (RegCheckErr(Buf, RoutineName)) return + ! nyWave + call RegUnpack(Buf, OutData%nyWave) + if (RegCheckErr(Buf, RoutineName)) return + ! nzWave + call RegUnpack(Buf, OutData%nzWave) + if (RegCheckErr(Buf, RoutineName)) return + ! ntWave + call RegUnpack(Buf, OutData%ntWave) + if (RegCheckErr(Buf, RoutineName)) return + ! pxWave + if (allocated(OutData%pxWave)) deallocate(OutData%pxWave) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%pxWave(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%pxWave.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%pxWave) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! pyWave + if (allocated(OutData%pyWave)) deallocate(OutData%pyWave) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%pyWave(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%pyWave.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%pyWave) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! pzWave + if (allocated(OutData%pzWave)) deallocate(OutData%pzWave) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%pzWave(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%pzWave.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%pzWave) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! dtWave + call RegUnpack(Buf, OutData%dtWave) + if (RegCheckErr(Buf, RoutineName)) return + ! uxWave + if (allocated(OutData%uxWave)) deallocate(OutData%uxWave) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%uxWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%uxWave.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%uxWave) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! uyWave + if (allocated(OutData%uyWave)) deallocate(OutData%uyWave) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%uyWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%uyWave.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%uyWave) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! uzWave + if (allocated(OutData%uzWave)) deallocate(OutData%uzWave) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%uzWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%uzWave.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%uzWave) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! axWave + if (allocated(OutData%axWave)) deallocate(OutData%axWave) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%axWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%axWave.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%axWave) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ayWave + if (allocated(OutData%ayWave)) deallocate(OutData%ayWave) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ayWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ayWave.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ayWave) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! azWave + if (allocated(OutData%azWave)) deallocate(OutData%azWave) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%azWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%azWave.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%azWave) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PDyn + if (allocated(OutData%PDyn)) deallocate(OutData%PDyn) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PDyn(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PDyn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PDyn) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! zeta + if (allocated(OutData%zeta)) deallocate(OutData%zeta) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%zeta(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%zeta.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%zeta) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! nzCurrent + call RegUnpack(Buf, OutData%nzCurrent) + if (RegCheckErr(Buf, RoutineName)) return + ! pzCurrent + if (allocated(OutData%pzCurrent)) deallocate(OutData%pzCurrent) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%pzCurrent(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%pzCurrent.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%pzCurrent) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! uxCurrent + if (allocated(OutData%uxCurrent)) deallocate(OutData%uxCurrent) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%uxCurrent(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%uxCurrent.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%uxCurrent) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! uyCurrent + if (allocated(OutData%uyCurrent)) deallocate(OutData%uyCurrent) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%uyCurrent(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%uyCurrent.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%uyCurrent) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Nx0 + call RegUnpack(Buf, OutData%Nx0) + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_u_indx + if (allocated(OutData%Jac_u_indx)) deallocate(OutData%Jac_u_indx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jac_u_indx) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! du + if (allocated(OutData%du)) deallocate(OutData%du) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%du(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%du) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! dx + if (allocated(OutData%dx)) deallocate(OutData%dx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dx(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dx) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Jac_ny + call RegUnpack(Buf, OutData%Jac_ny) + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_nx + call RegUnpack(Buf, OutData%Jac_nx) + if (RegCheckErr(Buf, RoutineName)) return + ! dxIdx_map2_xStateIdx + if (allocated(OutData%dxIdx_map2_xStateIdx)) deallocate(OutData%dxIdx_map2_xStateIdx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dxIdx_map2_xStateIdx(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dxIdx_map2_xStateIdx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dxIdx_map2_xStateIdx) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE MD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(MD_InputType), INTENT(INOUT) :: SrcInputData TYPE(MD_InputType), INTENT(INOUT) :: DstInputData @@ -12438,296 +7403,97 @@ SUBROUTINE MD_DestroyInput( InputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE MD_DestroyInput - SUBROUTINE MD_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MD_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! CoupledKinematics allocated yes/no - IF ( ALLOCATED(InData%CoupledKinematics) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CoupledKinematics upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%CoupledKinematics,1), UBOUND(InData%CoupledKinematics,1) - Int_BufSz = Int_BufSz + 3 ! CoupledKinematics: size of buffers for each call to pack subtype - CALL MeshPack( InData%CoupledKinematics(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! CoupledKinematics - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! CoupledKinematics - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! CoupledKinematics - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! CoupledKinematics - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! DeltaL allocated yes/no - IF ( ALLOCATED(InData%DeltaL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DeltaL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DeltaL) ! DeltaL - END IF - Int_BufSz = Int_BufSz + 1 ! DeltaLdot allocated yes/no - IF ( ALLOCATED(InData%DeltaLdot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DeltaLdot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DeltaLdot) ! DeltaLdot - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%CoupledKinematics) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CoupledKinematics,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CoupledKinematics,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CoupledKinematics,1), UBOUND(InData%CoupledKinematics,1) - CALL MeshPack( InData%CoupledKinematics(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! CoupledKinematics - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DeltaL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DeltaL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DeltaL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DeltaL,1), UBOUND(InData%DeltaL,1) - ReKiBuf(Re_Xferred) = InData%DeltaL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DeltaLdot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DeltaLdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DeltaLdot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DeltaLdot,1), UBOUND(InData%DeltaLdot,1) - ReKiBuf(Re_Xferred) = InData%DeltaLdot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_PackInput - - SUBROUTINE MD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MD_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CoupledKinematics not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CoupledKinematics)) DEALLOCATE(OutData%CoupledKinematics) - ALLOCATE(OutData%CoupledKinematics(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CoupledKinematics.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CoupledKinematics,1), UBOUND(OutData%CoupledKinematics,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%CoupledKinematics(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! CoupledKinematics - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DeltaL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DeltaL)) DEALLOCATE(OutData%DeltaL) - ALLOCATE(OutData%DeltaL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DeltaL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DeltaL,1), UBOUND(OutData%DeltaL,1) - OutData%DeltaL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DeltaLdot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DeltaLdot)) DEALLOCATE(OutData%DeltaLdot) - ALLOCATE(OutData%DeltaLdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DeltaLdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DeltaLdot,1), UBOUND(OutData%DeltaLdot,1) - OutData%DeltaLdot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_UnPackInput +subroutine MD_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MD_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackInput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! CoupledKinematics + call RegPack(Buf, allocated(InData%CoupledKinematics)) + if (allocated(InData%CoupledKinematics)) then + call RegPackBounds(Buf, 1, lbound(InData%CoupledKinematics), ubound(InData%CoupledKinematics)) + LB(1:1) = lbound(InData%CoupledKinematics) + UB(1:1) = ubound(InData%CoupledKinematics) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%CoupledKinematics(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DeltaL + call RegPack(Buf, allocated(InData%DeltaL)) + if (allocated(InData%DeltaL)) then + call RegPackBounds(Buf, 1, lbound(InData%DeltaL), ubound(InData%DeltaL)) + call RegPack(Buf, InData%DeltaL) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DeltaLdot + call RegPack(Buf, allocated(InData%DeltaLdot)) + if (allocated(InData%DeltaLdot)) then + call RegPackBounds(Buf, 1, lbound(InData%DeltaLdot), ubound(InData%DeltaLdot)) + call RegPack(Buf, InData%DeltaLdot) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MD_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackInput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! CoupledKinematics + if (allocated(OutData%CoupledKinematics)) deallocate(OutData%CoupledKinematics) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CoupledKinematics(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CoupledKinematics.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%CoupledKinematics(i1)) ! CoupledKinematics + end do + end if + ! DeltaL + if (allocated(OutData%DeltaL)) deallocate(OutData%DeltaL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DeltaL(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DeltaL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DeltaL) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! DeltaLdot + if (allocated(OutData%DeltaLdot)) deallocate(OutData%DeltaLdot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DeltaLdot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DeltaLdot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DeltaLdot) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE MD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(MD_OutputType), INTENT(INOUT) :: SrcOutputData TYPE(MD_OutputType), INTENT(INOUT) :: DstOutputData @@ -12798,258 +7564,75 @@ SUBROUTINE MD_DestroyOutput( OutputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE MD_DestroyOutput - SUBROUTINE MD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MD_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! CoupledLoads allocated yes/no - IF ( ALLOCATED(InData%CoupledLoads) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CoupledLoads upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%CoupledLoads,1), UBOUND(InData%CoupledLoads,1) - Int_BufSz = Int_BufSz + 3 ! CoupledLoads: size of buffers for each call to pack subtype - CALL MeshPack( InData%CoupledLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! CoupledLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! CoupledLoads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! CoupledLoads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! CoupledLoads - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutput allocated yes/no - IF ( ALLOCATED(InData%WriteOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutput upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WriteOutput) ! WriteOutput - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%CoupledLoads) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CoupledLoads,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CoupledLoads,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CoupledLoads,1), UBOUND(InData%CoupledLoads,1) - CALL MeshPack( InData%CoupledLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! CoupledLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) - ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_PackOutput - - SUBROUTINE MD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MD_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CoupledLoads not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CoupledLoads)) DEALLOCATE(OutData%CoupledLoads) - ALLOCATE(OutData%CoupledLoads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CoupledLoads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CoupledLoads,1), UBOUND(OutData%CoupledLoads,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%CoupledLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! CoupledLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutput)) DEALLOCATE(OutData%WriteOutput) - ALLOCATE(OutData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) - OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_UnPackOutput +subroutine MD_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MD_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'MD_PackOutput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! CoupledLoads + call RegPack(Buf, allocated(InData%CoupledLoads)) + if (allocated(InData%CoupledLoads)) then + call RegPackBounds(Buf, 1, lbound(InData%CoupledLoads), ubound(InData%CoupledLoads)) + LB(1:1) = lbound(InData%CoupledLoads) + UB(1:1) = ubound(InData%CoupledLoads) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%CoupledLoads(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutput + call RegPack(Buf, allocated(InData%WriteOutput)) + if (allocated(InData%WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPack(Buf, InData%WriteOutput) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine MD_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MD_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'MD_UnPackOutput' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! CoupledLoads + if (allocated(OutData%CoupledLoads)) deallocate(OutData%CoupledLoads) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CoupledLoads(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CoupledLoads.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%CoupledLoads(i1)) ! CoupledLoads + end do + end if + ! WriteOutput + if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE MD_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) ! diff --git a/modules/nwtc-library/CMakeLists.txt b/modules/nwtc-library/CMakeLists.txt index 8074c3d7dc..81a39fc2a0 100644 --- a/modules/nwtc-library/CMakeLists.txt +++ b/modules/nwtc-library/CMakeLists.txt @@ -14,6 +14,10 @@ # limitations under the License. # +if (GENERATE_TYPES) + generate_f90_types(src/Registry_NWTC_Library_typedef_nomesh.txt ${CMAKE_CURRENT_LIST_DIR}/src/NWTC_Library_Types.f90 -noextrap) +endif() + #------------------------------------------------------------------------------- # NWTC System File #------------------------------------------------------------------------------- @@ -55,6 +59,7 @@ set(NWTCLIBS_SOURCES src/NWTC_Base.f90 src/SingPrec.f90 + src/ModReg.f90 src/ModMesh.f90 src/ModMesh_Mapping.f90 diff --git a/modules/nwtc-library/ModRegGen.py b/modules/nwtc-library/ModRegGen.py new file mode 100644 index 0000000000..fe014a2e97 --- /dev/null +++ b/modules/nwtc-library/ModRegGen.py @@ -0,0 +1,603 @@ + +import textwrap +import itertools +from itertools import product + +type_map = { + 'C1': 'character(*)', + 'L1': 'logical', + 'I4': 'integer(B4Ki)', + 'R4': 'real(R4Ki)', + 'R8': 'real(R8Ki)', +} + +num_ranks = 5 + +module_header = ''' +module ModReg + use NWTC_Base + implicit none + + private + public :: PackBuffer + public :: WritePackBuffer, ReadPackBuffer, InitPackBuffer, RegCheckErr + public :: RegPack, RegPackBounds, RegPackPointer + public :: RegUnpack, RegUnpackBounds, RegUnpackPointer + + type :: PackBuffer + integer(B1Ki), allocatable :: Bytes(:) + integer(IntKi) :: NB + type(c_ptr), allocatable :: Pointers(:) + integer(IntKi) :: NP + integer(IntKi) :: ErrStat = ErrID_Fatal + character(ErrMsgLen) :: ErrMsg = 'PackBuffer not initialized' + end type + {ifc_lines} + +contains + + subroutine InitPackBuffer(Buf, ErrStat, ErrMsg) + type(PackBuffer), intent(inout) :: Buf + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = "InitPackBuffer" + integer(IntKi), parameter :: NumPointersInit = 128 + integer(IntKi), parameter :: NumBytesInit = 1024 + integer(IntKi) :: stat + + ErrStat = ErrID_None + ErrMsg = "" + + Buf%ErrStat = ErrID_None + Buf%ErrMsg = "" + Buf%NP = 0 + Buf%NB = 0 + + ! If pointers have not been allocated, allocate with initial size + if (.not. allocated(Buf%Pointers)) then + allocate (Buf%Pointers(NumPointersInit), stat=stat) + if (stat /= 0) then + ErrStat = ErrID_Fatal + write(ErrMsg,*) 'InitPackBuffer: Unable to init pointer index to with size of', NumPointersInit + return + end if + end if + + ! Reset all pointers to null + Buf%Pointers = c_null_ptr + + ! If byte array has not been allocated, allocate with initial size + if (.not. allocated(Buf%Bytes)) then + allocate (Buf%Bytes(NumBytesInit), stat=stat) + if (stat /= 0) then + ErrStat = ErrID_Fatal + write(ErrMsg,*) 'Grow: Unable to init buffer to', NumBytesInit, 'bytes' + return + end if + end if + + end subroutine + + subroutine WritePackBuffer(Buf, Unit, ErrStat, ErrMsg) + type(PackBuffer), intent(inout) :: Buf + integer(IntKi), intent(in) :: Unit + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = "WritePackBuffer" + integer(IntKi) :: iostat + + ErrStat = ErrID_None + ErrMsg = '' + + if (Buf%ErrStat /= ErrID_None) then + call SetErrStat(Buf%ErrStat, Buf%ErrMsg, ErrStat, ErrMsg, 'Buf%WriteFile') + return + end if + + write(Unit, iostat=iostat) Buf%NP + if (iostat /= 0) then + call SetErrStat(ErrID_Fatal, "Error writing number of pointers", ErrStat, ErrMsg, RoutineName) + return + end if + + write(Unit, iostat=iostat) Buf%NB + if (iostat /= 0) then + call SetErrStat(ErrID_Fatal, "Error writing number of bytes", ErrStat, ErrMsg, RoutineName) + return + end if + + write(Unit, iostat=iostat) Buf%Bytes(1:Buf%NB) + if (iostat /= 0) then + call SetErrStat(ErrID_Fatal, "Error writing bytes", ErrStat, ErrMsg, RoutineName) + return + end if + + end subroutine + + subroutine ReadPackBuffer(Buf, Unit, ErrStat, ErrMsg) + type(PackBuffer), intent(inout) :: Buf + integer(IntKi), intent(in) :: Unit + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = "ReadPackBuffer" + integer(IntKi) :: iostat + + ErrStat = ErrID_None + ErrMsg = '' + + ! Read number of pointers + read(Unit, iostat=iostat) Buf%NP + if (iostat /= 0) then + call SetErrStat(ErrID_Fatal, "Error reading number of pointers", ErrStat, ErrMsg, RoutineName) + return + end if + + ! If pointers are allocated, deallocate + if (allocated(Buf%Pointers)) deallocate(Buf%Pointers) + + ! Allocate pointer index and initialize pointers to null + allocate(Buf%Pointers(1:Buf%NP), stat=ErrStat) + Buf%Pointers = c_null_ptr + + ! Read number of bytes in buffer + read(Unit, iostat=iostat) Buf%NB + if (iostat /= 0) then + call SetErrStat(ErrID_Fatal, "Error reading number of bytes", ErrStat, ErrMsg, RoutineName) + return + end if + + ! If bytes are allocated, deallocate + if (allocated(Buf%Bytes)) deallocate(Buf%Bytes) + + ! Allocate bytes + allocate(Buf%Bytes(1:Buf%NB), stat=ErrStat) + + ! Read bytes + read(Unit, iostat=iostat) Buf%Bytes + if (iostat /= 0) then + call SetErrStat(ErrID_Fatal, "Error reading bytes", ErrStat, ErrMsg, RoutineName) + return + end if + + ! Clear buffer error + Buf%ErrStat = ErrID_None + Buf%ErrMsg = '' + + ! Reset Number of bytes to be used by unpack routines + Buf%NB = 0 + + end subroutine + + function RegCheckErr(Buf, RoutineName) result(Err) + type(PackBuffer), intent(inout) :: Buf + character(*), intent(in) :: RoutineName + logical :: Err + Err = Buf%ErrStat /= ErrID_None + if (Err) Buf%ErrMsg = trim(RoutineName)//": "//trim(Buf%ErrMsg) + end function + + elemental function LogicalToByte(b) result(i) + logical, intent(in) :: b + integer(B1Ki) :: i + if (b) then + i = 1_B1Ki + else + i = 0_B1Ki + end if + end function + + elemental function ByteToLogical(i) result(b) + integer(B1Ki), intent(in) :: i + logical :: b + if (i == 0) then + b = .false. + else + b = .true. + end if + end function + + subroutine RegPackPointer(Buf, Ptr, Found) + type(PackBuffer), intent(inout) :: Buf + type(c_ptr), intent(in) :: Ptr + logical, intent(out) :: Found + + type(c_ptr), allocatable :: PointersTmp(:) + integer(IntKi) :: NewSize + integer(B4Ki) :: i + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Look for pointer in index, if found, pack pointer index and return + do i = 1, Buf%NP + if (c_associated(Ptr, Buf%Pointers(i))) then + call RegPack(Buf, i) + Found = .true. + return + end if + end do + + ! Pointer was not found in index + Found = .false. + + ! If pointer index is full, grow pointer index + if (Buf%NP == size(Buf%Pointers)) then + NewSize = int(1.5_R4Ki * real(Buf%NP, R4Ki), IntKi) + call move_alloc(Buf%Pointers, PointersTmp) + allocate (Buf%Pointers(NewSize), stat=Buf%ErrStat) + if (Buf%ErrStat /= ErrID_None) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) 'RegPackPointer: Unable to allocate pointer index to', NewSize, 'bytes' + return + end if + Buf%Pointers(1:size(PointersTmp)) = PointersTmp + Buf%Pointers(size(PointersTmp)+1:) = c_null_ptr + end if + + ! Increment number of pointers, add new pointer to index + Buf%NP = Buf%NP + 1 + Buf%Pointers(Buf%NP) = Ptr + + ! Pack pointer index + call RegPack(Buf, Buf%NP) + + end subroutine + + subroutine RegUnpackPointer(Buf, Ptr, Idx) + type(PackBuffer), intent(inout) :: Buf + type(c_ptr), intent(out) :: Ptr + integer(B4Ki), intent(out) :: Idx + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Unpack pointer index + call RegUnpack(Buf, Idx) + + ! Get pointer from index + Ptr = Buf%Pointers(Idx) + + end subroutine + + subroutine RegPackBounds(Buf, R, LB, UB) + type(PackBuffer), intent(inout) :: Buf + integer(B4Ki), intent(in) :: R, LB(:), UB(:) + + ! If buffer has an error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Pack lower and upper bounds + call RegPack(Buf, LB(1:R)) + call RegPack(Buf, UB(1:R)) + if (RegCheckErr(Buf, "RegPackBounds")) return + end subroutine + + subroutine RegUnpackBounds(Buf, R, LB, UB) + type(PackBuffer), intent(inout) :: Buf + integer(B4Ki), intent(in) :: R + integer(B4Ki), intent(out) :: LB(:), UB(:) + + ! If buffer has an error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Unpack lower and upper bounds + call RegUnpack(Buf, LB(1:R)) + call RegUnpack(Buf, UB(1:R)) + if (RegCheckErr(Buf, "RegUnpackBounds")) return + end subroutine + + subroutine GrowBuffer(Buf, N) + type(PackBuffer), intent(inout) :: Buf + integer(B4Ki), intent(in) :: N + + integer(B1Ki), allocatable :: BytesTmp(:) + integer(B4Ki) :: NewSize + integer(IntKi) :: stat + + ! Return if there is a buffer error + if (Buf%ErrStat /= ErrID_None) return + + ! If buffer can hold requested bytes, return + if (size(Buf%Bytes) > Buf%NB + N) return + + ! Calculate new size + NewSize = int(real(Buf%NB + N, R4Ki) * 1.8_R4Ki, IntKi) + + ! Move allocation to temporary array and allocate buffer with new size + call move_alloc(Buf%Bytes, BytesTmp) + allocate (Buf%Bytes(NewSize), stat=stat) + if (stat /= 0) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) 'Grow: Unable to grow buffer to', NewSize, 'bytes' + return + end if + + ! Copy contents of temporary bytes to buffer + Buf%Bytes(1:size(BytesTmp)) = BytesTmp + + end subroutine +''' + + +def gen_pack(w, dt, decl, rank): + dims = '' if rank == 0 else '('+','.join([':']*rank)+')' + dt_size = int(dt[-1]) + name = f'Pack_{dt}' if rank == 0 else f'Pack_{dt}_Rank{rank}' + w.write(f'\n\n subroutine {name}(Buf, Data)') + w.write(f'\n type(PackBuffer), intent(inout) :: Buf') + w.write(f'\n {decl+", intent(in)":<38s} :: Data{dims}') + w.write(f'\n integer(IntKi) :: DataSize') + w.write(f'\n') + w.write(f'\n ! If buffer error, return') + w.write(f'\n if (Buf%ErrStat /= ErrID_None) return') + w.write(f'\n') + w.write(f'\n ! Get size of data in bytes') + if dt == 'C1' and rank == 0: + w.write(f'\n DataSize = len(Data)') + elif dt == 'C1' and rank > 0: + w.write(f'\n DataSize = len(Data({",".join(["1"]*rank)}))*size(Data)') + elif rank == 0: + w.write(f'\n DataSize = {dt_size}') + elif dt_size == 1: + w.write(f'\n DataSize = size(Data)') + else: + w.write(f'\n DataSize = {dt_size}*size(Data)') + w.write(f'\n') + w.write(f'\n ! Grow buffer to accommodate Data') + w.write(f'\n call GrowBuffer(Buf, DataSize)') + w.write(f'\n if (RegCheckErr(Buf, "{name}")) return') + w.write(f'\n') + w.write(f'\n ! Transfer data to buffer') + if dt == 'L1': + w.write(f'\n Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(LogicalToByte(Data), Buf%Bytes)') + else: + w.write(f'\n Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes)') + w.write(f'\n Buf%NB = Buf%NB + DataSize') + w.write(f'\n') + w.write(f'\n end subroutine') + + +def gen_unpack(w, dt, decl, rank): + dims = '' if rank == 0 else '('+','.join([':']*rank)+')' + dt_size = int(dt[-1]) + name = f'Unpack_{dt}' if rank == 0 else f'Unpack_{dt}_Rank{rank}' + w.write(f'\n') + w.write(f'\n subroutine {name}(Buf, Data)') + w.write(f'\n type(PackBuffer), intent(inout) :: Buf') + w.write(f'\n {decl+", intent(out)":<38s} :: Data{dims}') + w.write(f'\n integer(IntKi) :: DataSize') + w.write(f'\n') + w.write(f'\n ! If buffer error, return') + w.write(f'\n if (Buf%ErrStat /= ErrID_None) return') + w.write(f'\n') + w.write(f'\n ! Get size of data in bytes') + if dt == 'C1' and rank == 0: + w.write(f'\n DataSize = len(Data)') + elif dt == 'C1' and rank > 0: + w.write(f'\n DataSize = len(Data({",".join(["1"]*rank)}))*size(Data)') + elif rank == 0: + w.write(f'\n DataSize = {dt_size}') + elif dt_size == 1: + w.write(f'\n DataSize = size(Data)') + else: + w.write(f'\n DataSize = {dt_size}*size(Data)') + w.write(f'\n') + w.write(f'\n ! Check that buffer has sufficient bytes remaining') + w.write(f'\n if (size(Buf%Bytes) < Buf%NB + DataSize) then') + w.write(f'\n Buf%ErrStat = ErrID_Fatal') + w.write(f'\n write(Buf%ErrMsg,*) "{name}: buffer too small, requested", DataSize, "bytes"') + w.write(f'\n return') + w.write(f'\n end if') + w.write(f'\n') + w.write(f'\n ! Transfer data from buffer') + if dt == 'L1' and rank == 0: + w.write(f'\n Data = ByteToLogical(Buf%Bytes(Buf%NB+1))') + elif dt == 'L1' and rank > 0: + w.write(f'\n Data = reshape(ByteToLogical(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize)), shape(Data))') + elif rank == 0: + w.write(f'\n Data = transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data)') + else: + w.write(f'\n Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data))') + w.write(f'\n Buf%NB = Buf%NB + DataSize') + w.write(f'\n') + w.write(f'\n end subroutine') + +def gen_pack_alloc(w, dt, decl, rank): + dims = '' if rank == 0 else '('+','.join([':']*rank)+')' + name = f'PackAlloc_{dt}' + if rank > 0: name += f'_Rank{rank}' + w.write(f'\n') + w.write(f'\n subroutine {name}(Buf, Data)') + w.write(f'\n type(PackBuffer), intent(inout) :: Buf') + w.write(f'\n {decl+", allocatable, intent(in)":<38s} :: Data{dims}') + w.write(f'\n') + w.write(f'\n ! If buffer error, return') + w.write(f'\n if (Buf%ErrStat /= ErrID_None) return') + w.write(f'\n') + w.write(f'\n ! Write if allocated') + w.write(f'\n call RegPack(Buf, allocated(Data))') + w.write(f'\n if (RegCheckErr(Buf, "{name}")) return') + w.write(f'\n if (.not. allocated(Data)) return') + w.write(f'\n') + if rank > 0: + w.write(f'\n ! Write array bounds') + w.write(f'\n call RegPackBounds(Buf, {rank}, lbound(Data), ubound(Data))') + w.write(f'\n') + w.write(f'\n ! Write data to buffer') + w.write(f'\n call RegPack(Buf, Data)') + w.write(f'\n if (RegCheckErr(Buf, "{name}")) return') + w.write(f'\n') + w.write(f'\n end subroutine') + + +def gen_unpack_alloc(w, dt, decl, rank): + dims = '' if rank == 0 else '('+','.join([':']*rank)+')' + dt_size = int(dt[-1]) + name = f'UnpackAlloc_{dt}' if rank == 0 else f'UnpackAlloc_{dt}_Rank{rank}' + w.write(f'\n') + w.write(f'\n subroutine {name}(Buf, Data)') + w.write(f'\n type(PackBuffer), intent(inout) :: Buf') + w.write(f'\n {decl+", allocatable, intent(out)":<38s} :: Data{dims}') + w.write(f'\n integer(IntKi) :: stat') + w.write(f'\n logical :: IsAllocated') + if rank > 0: + w.write(f'\n integer(IntKi) :: LB({rank}), UB({rank})') + w.write(f'\n') + w.write(f'\n ! If buffer error, return') + w.write(f'\n if (Buf%ErrStat /= ErrID_None) return') + w.write(f'\n') + w.write(f'\n ! Deallocate if allocated') + w.write(f'\n if (allocated(Data)) deallocate(Data)') + w.write(f'\n') + w.write(f'\n ! Read value to see if it was allocated, return if not') + w.write(f'\n call RegUnpack(Buf, IsAllocated)') + w.write(f'\n if (RegCheckErr(Buf, "{name}")) return') + w.write(f'\n if (.not. IsAllocated) return') + w.write(f'\n') + alloc_dims = '' + if rank > 0: + w.write(f'\n ! Read array bounds') + w.write(f'\n call RegUnpackBounds(Buf, {rank}, LB, UB)') + w.write(f'\n if (RegCheckErr(Buf, "{name}")) return') + alloc_dims = '(' + ','.join([f'LB({d+1}):UB({d+1})' for d in range(rank)]) + ')' + w.write(f'\n') + w.write(f'\n ! Allocate data') + w.write(f'\n allocate(Data{alloc_dims}, stat=stat)') + w.write(f'\n if (stat /= 0) then') + w.write(f'\n Buf%ErrStat = ErrID_Fatal') + w.write(f'\n Buf%ErrMsg = "{name}: error allocating data"') + w.write(f'\n return') + w.write(f'\n end if') + w.write(f'\n') + w.write(f'\n ! Read data') + w.write(f'\n call RegUnpack(Buf, Data)') + w.write(f'\n if (RegCheckErr(Buf, "{name}")) return') + w.write(f'\n') + w.write(f'\n end subroutine') + + +def gen_pack_ptr(w, dt, decl, rank): + dims = '' if rank == 0 else '('+','.join([':']*rank)+')' + name = f'PackPtr_{dt}' + if rank > 0: name += f'_Rank{rank}' + w.write(f'\n') + w.write(f'\n subroutine {name}(Buf, Data)') + w.write(f'\n type(PackBuffer), intent(inout) :: Buf') + w.write(f'\n {decl+", pointer, intent(in)":<38s} :: Data{dims}') + w.write(f'\n logical :: PtrInIndex') + w.write(f'\n') + w.write(f'\n ! If buffer error, return') + w.write(f'\n if (Buf%ErrStat /= ErrID_None) return') + w.write(f'\n') + w.write(f'\n ! Write if associated') + w.write(f'\n call RegPack(Buf, associated(Data))') + w.write(f'\n if (RegCheckErr(Buf, "{name}")) return') + w.write(f'\n if (.not. associated(Data)) return') + if rank > 0: + w.write(f'\n') + w.write(f'\n ! Write array bounds') + w.write(f'\n call RegPackBounds(Buf, {rank}, lbound(Data), ubound(Data))') + w.write(f'\n') + w.write(f'\n ! Write pointer info') + w.write(f'\n call RegPackPointer(Buf, c_loc(Data), PtrInIndex)') + w.write(f'\n if (RegCheckErr(Buf, "{name}")) return') + w.write(f'\n if (PtrInIndex) return') + w.write(f'\n') + w.write(f'\n ! Write data to buffer') + w.write(f'\n call RegPack(Buf, Data)') + w.write(f'\n if (RegCheckErr(Buf, "{name}")) return') + w.write(f'\n') + w.write(f'\n end subroutine') + +def gen_unpack_ptr(w, dt, decl, rank): + dims = '' if rank == 0 else '('+','.join([':']*rank)+')' + dt_size = int(dt[-1]) + name = f'UnpackPtr_{dt}' if rank == 0 else f'UnpackPtr_{dt}_Rank{rank}' + w.write(f'\n') + w.write(f'\n subroutine {name}(Buf, Data)') + w.write(f'\n type(PackBuffer), intent(inout) :: Buf') + w.write(f'\n {decl+", pointer, intent(out)":<38s} :: Data{dims}') + w.write(f'\n integer(IntKi) :: PtrIdx, stat') + w.write(f'\n logical :: IsAssociated') + w.write(f'\n type(c_ptr) :: Ptr') + if rank > 0: + w.write(f'\n integer(IntKi) :: LB({rank}), UB({rank})') + w.write(f'\n') + w.write(f'\n ! If buffer error, return') + w.write(f'\n if (Buf%ErrStat /= ErrID_None) return') + w.write(f'\n') + w.write(f'\n ! If associated, deallocate and nullify') + w.write(f'\n if (associated(Data)) then') + w.write(f'\n deallocate(Data)') + w.write(f'\n nullify(Data)') + w.write(f'\n end if') + w.write(f'\n') + w.write(f'\n ! Read value to see if it was associated, return if not') + w.write(f'\n call RegUnpack(Buf, IsAssociated)') + w.write(f'\n if (RegCheckErr(Buf, "{name}")) return') + w.write(f'\n if (.not. IsAssociated) return') + if rank > 0: + w.write(f'\n') + w.write(f'\n ! Read array bounds') + w.write(f'\n call RegUnpackBounds(Buf, {rank}, LB, UB)') + w.write(f'\n') + w.write(f'\n ! Unpack pointer inf') + w.write(f'\n call RegUnpackPointer(Buf, Ptr, PtrIdx)') + w.write(f'\n if (RegCheckErr(Buf, "{name}")) return') + w.write(f'\n') + w.write(f'\n ! If pointer was in index, associate data with pointer, return') + w.write(f'\n if (c_associated(Ptr)) then') + if rank == 0: + alloc_dims = '' + w.write(f'\n call c_f_pointer(Ptr, Data)') + else: + alloc_dims = '(' + ','.join([f'LB({d+1}):UB({d+1})' for d in range(rank)]) + ')' + remap_dims = ",".join([f'LB({d+1}):' for d in range(rank)]) + w.write(f'\n call c_f_pointer(Ptr, Data, UB - LB)') # Specify shape + w.write(f'\n Data({remap_dims}) => Data') # Remap bounds + w.write(f'\n return') + w.write(f'\n end if') + w.write(f'\n') + w.write(f'\n ! Allocate data') + w.write(f'\n allocate(Data{alloc_dims}, stat=stat)') + w.write(f'\n if (stat /= 0) then') + w.write(f'\n Buf%ErrStat = ErrID_Fatal') + w.write(f'\n Buf%ErrMsg = "{name}: error allocating data"') + w.write(f'\n return') + w.write(f'\n end if') + w.write(f'\n') + w.write(f'\n ! Read data') + w.write(f'\n call RegUnpack(Buf, Data)') + w.write(f'\n if (RegCheckErr(Buf, "{name}")) return') + w.write(f'\n') + w.write(f'\n end subroutine') + +# Registry interface +ifc_lines = '' +ranks = [''] + [f'_Rank{r}' for r in range(1,num_ranks+1)] +for attr, punp in product([''], ['Pack', 'Unpack']): + ifc_lines += f'\n\n interface Reg{punp}{attr}' + funcs = [f'{punp}{attr}_{dt}{rank}'for dt, rank in product(type_map.keys(), ranks)] + lines = textwrap.wrap('module procedure :: ' + ', '.join(funcs), 80, + initial_indent=" "*6, subsequent_indent=' '*9,break_long_words=False) + ifc_lines += '\n' + ' &\n'.join(lines) + ifc_lines += '\n end interface' + +with open('src/ModReg.f90', 'w') as w: + w.write(module_header.format(ifc_lines=ifc_lines, maxrank=num_ranks)) + + # Loop through data types and ranks + for (dt,decl), rank in product(type_map.items(), range(num_ranks+1)): + gen_pack(w, dt, decl, rank) + gen_unpack(w, dt, decl, rank) + + # gen_pack_alloc(w, dt, decl, rank) + # gen_unpack_alloc(w, dt, decl, rank) + + # gen_pack_ptr(w, dt, decl, rank) + # gen_unpack_ptr(w, dt, decl, rank) + + w.write('\nend module') diff --git a/modules/nwtc-library/src/ModMesh.f90 b/modules/nwtc-library/src/ModMesh.f90 index e946a05d46..6cb8905b56 100644 --- a/modules/nwtc-library/src/ModMesh.f90 +++ b/modules/nwtc-library/src/ModMesh.f90 @@ -35,7 +35,7 @@ !! See https://nwtc.nrel.gov/FAST-Developers and https://nwtc.nrel.gov/system/files/ProgrammingHandbook_Mod20130717.pdf MODULE ModMesh use VTK, only: WrVTK_header, WrVTK_footer - + USE ModReg USE ModMesh_Types IMPLICIT NONE ! INTEGER :: DEBUG_UNIT = 74 @@ -1507,230 +1507,76 @@ END SUBROUTINE MeshDestroy !! buffers when they are no longer needed. For sibling meshes, MeshPack should be called !! separately for each sibling, because the fields allocated with the siblings are separate !! and unique to each sibling. - SUBROUTINE MeshPack ( Mesh, ReKiBuf, DbKiBuf, IntKiBuf , ErrStat, ErrMess, SizeOnly ) - - TYPE(MeshType), INTENT(IN ) :: Mesh ! Mesh being packed - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) ! Real buffer - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) ! Double buffer - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) ! Int buffer - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMess - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - - ! Local - INTEGER(IntKi) :: Re_BufSz ! number of reals in the buffer - INTEGER(IntKi) :: Re_Xferred ! number of reals transferred - INTEGER(IntKi) :: Db_BufSz ! number of doubles in the buffer - INTEGER(IntKi) :: Db_Xferred ! number of doubles transferred - INTEGER(IntKi) :: Int_BufSz ! number of integers in the buffer - INTEGER(IntKi) :: Int_Xferred ! number of integers transferred - - - INTEGER i,j, nelemnodes - LOGICAL OnlySize - INTEGER(IntKi) :: ErrStat2 - !CHARACTER(1024) :: ErrMess2 - CHARACTER(*), PARAMETER :: RoutineName = "MeshPack" + subroutine MeshPack (Buf, Mesh) + type(PackBuffer), intent(inout) :: Buf + type(MeshType), intent(in) :: Mesh ! Mesh being packed + + integer :: i,j, nelemnodes + character(*), parameter :: RoutineName = "MeshPack" + ! bjj: figure out what to do about sibling meshes... (for now, I'm going to ignore them) + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return - ErrStat = ErrID_None - ErrMess = "" - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) OnlySize = SizeOnly + ! Pack if mesh is initialized + call RegPack(Buf, Mesh%Initialized) + ! If mesh is not initialized, return + if (.not. Mesh%Initialized) return - ! bjj: figure out what to do about sibling meshes... (for now, I'm going to ignore them) - - !......................................... - ! get number of integer values - !......................................... - IF (.NOT. Mesh%Initialized) THEN ! we don't need to store any data; it's a blank mesh - Int_BufSz = 1 - ELSE ! initialized, may or may not be committed - Int_BufSz = 3 & ! number of logicals in MeshType (initialized, committed, RemapFlag) - + FIELDMASK_SIZE & ! number of logicals in MeshType (fieldmask) - + 5 ! number of non-pointer integers (ios, nnodes, nextelem, nscalars, refNode) - - !...... - ! we'll store the element structure (and call MeshCommit on Unpack if necessary to get the remaining fields like det_jac) - !...... - DO i = 1, NELEMKINDS + ! Mesh is initialized, but may or may not be committed - Int_BufSz = Int_BufSz+1 ! Mesh%ElemTable(i)%nelem - if (Mesh%ElemTable(i)%nelem > 0) Int_BufSz = Int_BufSz+1 ! number of nodes in this kind of element - - DO j = 1, Mesh%ElemTable(i)%nelem - !Int_BufSz = Int_BufSz+1 ! which kind of element - !Int_BufSz = Int_BufSz+1 ! skip Nneighbors until that's implemented (as well as neighbor list) - Int_BufSz = Int_BufSz + SIZE( Mesh%ElemTable(i)%Elements(j)%ElemNodes ) ! nodes in this element - END DO - - END DO - - END IF - - !......................................... - ! get number of real values - !......................................... - Re_BufSz = 0 - IF (Mesh%Initialized) THEN - Re_BufSz = Re_BufSz + Mesh%Nnodes * 3 ! Position - !Re_BufSz = Re_BufSz + Mesh%Nnodes * 9 ! RefOrientation - IF ( Mesh%FieldMask(MASKID_FORCE) ) Re_BufSz = Re_BufSz + Mesh%Nnodes * 3 - IF ( Mesh%FieldMask(MASKID_MOMENT) ) Re_BufSz = Re_BufSz + Mesh%Nnodes * 3 - !IF ( Mesh%FieldMask(MASKID_ORIENTATION) ) Re_BufSz = Re_BufSz + Mesh%Nnodes * 9 - !IF ( Mesh%FieldMask(MASKID_TRANSLATIONDISP) ) Re_BufSz = Re_BufSz + Mesh%Nnodes * 3 - IF ( Mesh%FieldMask(MASKID_ROTATIONVEL) ) Re_BufSz = Re_BufSz + Mesh%Nnodes * 3 - IF ( Mesh%FieldMask(MASKID_TRANSLATIONVEL) ) Re_BufSz = Re_BufSz + Mesh%Nnodes * 3 - IF ( Mesh%FieldMask(MASKID_ROTATIONACC) ) Re_BufSz = Re_BufSz + Mesh%Nnodes * 3 - IF ( Mesh%FieldMask(MASKID_TRANSLATIONACC) ) Re_BufSz = Re_BufSz + Mesh%Nnodes * 3 - IF ( Mesh%nScalars .GT. 0 ) Re_BufSz = Re_BufSz + Mesh%Nnodes * Mesh%nScalars - END IF - - !......................................... - ! get number of double values (none now) - !......................................... - Db_BufSz = 0 - IF (Mesh%Initialized) THEN - Db_BufSz = Db_BufSz + Mesh%Nnodes * 9 ! RefOrientation - IF ( Mesh%FieldMask(MASKID_ORIENTATION) ) Db_BufSz = Db_BufSz + Mesh%Nnodes * 9 - IF ( Mesh%FieldMask(MASKID_TRANSLATIONDISP) ) Db_BufSz = Db_BufSz + Mesh%Nnodes * 3 - END IF - - !......................................... - ! allocate buffer arrays - !......................................... - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMess,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMess,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMess,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + ! Logicals + call RegPack(Buf, Mesh%committed) + call RegPack(Buf, Mesh%fieldmask) + call RegPack(Buf, Mesh%RemapFlag) - - !......................................... - ! store data in buffer arrays - !......................................... - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ! ..... fill IntKiBuf ..... - - IF (.NOT. Mesh%Initialized) THEN ! we don't need to store any data; it's a blank mesh - IntKiBuf(Int_Xferred) = 0; ; Int_Xferred = Int_Xferred + 1 - ELSE ! initialized, may or may not be committed - ! transfer the logicals - IntKiBuf(Int_Xferred) = 1; Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER( Mesh%committed, IntKiBuf(1) ); Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred:Int_Xferred+FIELDMASK_SIZE-1) = TRANSFER( Mesh%fieldmask, IntKiBuf(Int_Xferred:Int_Xferred+FIELDMASK_SIZE-1) ); Int_Xferred = Int_Xferred + FIELDMASK_SIZE - IntKiBuf(Int_Xferred) = TRANSFER( Mesh%RemapFlag, IntKiBuf(1) ); Int_Xferred = Int_Xferred + 1 - ! integers - IntKiBuf(Int_Xferred) = Mesh%ios; Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = Mesh%nnodes; Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = Mesh%refnode; Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = Mesh%nextelem; Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = Mesh%nscalars; Int_Xferred = Int_Xferred + 1 + ! Integers + call RegPack(Buf, Mesh%ios) + call RegPack(Buf, Mesh%nnodes) + call RegPack(Buf, Mesh%refnode) + call RegPack(Buf, Mesh%nextelem) + call RegPack(Buf, Mesh%nscalars) + + ! Loop through element kinds + do i = 1, NELEMKINDS - ! element structure - DO i = 1, NELEMKINDS - - IntKiBuf(Int_Xferred) = Mesh%ElemTable(i)%nelem; Int_Xferred = Int_Xferred + 1 ! number of elements + ! Number of elements of this kind + call RegPack(Buf, Mesh%ElemTable(i)%nelem) + + ! If there are elements of this kind + if (Mesh%ElemTable(i)%nelem > 0) then - if (Mesh%ElemTable(i)%nelem > 0) then - nelemnodes = SIZE( Mesh%ElemTable(i)%Elements(1)%ElemNodes ); - IntKiBuf(Int_Xferred) = nelemnodes; Int_Xferred = Int_Xferred + 1 ! nodes per element - - ! nodes in this element - DO j = 1, Mesh%ElemTable(i)%nelem - IntKiBuf(Int_Xferred:Int_Xferred+nelemnodes-1) = Mesh%ElemTable(i)%Elements(j)%ElemNodes; Int_Xferred = Int_Xferred + nelemnodes - END DO - end if - - END DO - - END IF - - ! ..... fill ReKiBuf and DbKiBuf ..... - IF (Mesh%Initialized) THEN - DO i = 1, Mesh%Nnodes ! Position - ReKiBuf(Re_Xferred:Re_Xferred+2) = Mesh%Position(:,i); Re_Xferred = Re_Xferred + 3 - END DO - DO i = 1, Mesh%Nnodes ! RefOrientation - DO j = 1,3 - DbKiBuf(Db_Xferred:Db_Xferred+2) = Mesh%RefOrientation(:,j,i); Db_Xferred = Db_Xferred + 3 - ENDDO - END DO - - IF ( Mesh%FieldMask(MASKID_FORCE) ) THEN ! Force - DO i = 1, Mesh%Nnodes - ReKiBuf(Re_Xferred:Re_Xferred+2) = Mesh%Force(:,i); Re_Xferred = Re_Xferred + 3 - ENDDO - ENDIF - IF ( Mesh%FieldMask(MASKID_MOMENT) ) THEN ! Moment - DO i = 1, Mesh%Nnodes - ReKiBuf(Re_Xferred:Re_Xferred+2) = Mesh%Moment(:,i); Re_Xferred = Re_Xferred + 3 - ENDDO - ENDIF - IF ( Mesh%FieldMask(MASKID_ORIENTATION) ) THEN ! Orientation - DO i = 1, Mesh%Nnodes - DO j = 1,3 - DbKiBuf(Db_Xferred:Db_Xferred+2) = Mesh%Orientation(:,j,i); Db_Xferred = Db_Xferred + 3 - ENDDO - END DO - ENDIF - IF ( Mesh%FieldMask(MASKID_TRANSLATIONDISP) ) THEN ! TranslationDisp - DO i = 1, Mesh%Nnodes - DbKiBuf(Db_Xferred:Db_Xferred+2) = Mesh%TranslationDisp(:,i); Db_Xferred = Db_Xferred + 3 - ENDDO - ENDIF - IF ( Mesh%FieldMask(MASKID_ROTATIONVEL) ) THEN ! RotationVel - DO i = 1, Mesh%Nnodes - ReKiBuf(Re_Xferred:Re_Xferred+2) = Mesh%RotationVel(:,i); Re_Xferred = Re_Xferred + 3 - ENDDO - ENDIF - IF ( Mesh%FieldMask(MASKID_TRANSLATIONVEL) ) THEN ! TranslationVel - DO i = 1, Mesh%Nnodes - ReKiBuf(Re_Xferred:Re_Xferred+2) = Mesh%TranslationVel(:,i); Re_Xferred = Re_Xferred + 3 - ENDDO - ENDIF - IF ( Mesh%FieldMask(MASKID_ROTATIONACC) ) THEN ! RotationAcc - DO i = 1, Mesh%Nnodes - ReKiBuf(Re_Xferred:Re_Xferred+2) = Mesh%RotationAcc(:,i); Re_Xferred = Re_Xferred + 3 - ENDDO - ENDIF - IF ( Mesh%FieldMask(MASKID_TRANSLATIONACC) ) THEN ! TranslationAcc - DO i = 1, Mesh%Nnodes - ReKiBuf(Re_Xferred:Re_Xferred+2) = Mesh%TranslationAcc(:,i); Re_Xferred = Re_Xferred + 3 - ENDDO - ENDIF - - IF ( Mesh%nScalars .GT. 0 ) THEN ! n_re = n_re + Mesh%Nnodes * Mesh%nScalar - DO i = 1, Mesh%Nnodes - ReKiBuf(Re_Xferred:Re_Xferred+Mesh%nScalars-1) = Mesh%Scalars(:,i); Re_Xferred = Re_Xferred + Mesh%nScalars - ENDDO - ENDIF - - END IF - - !bjj: where are we keeping track of which ones are siblings so that we can unpack them (set pointers) properly for restart? + ! Store number of nodes per element + nelemnodes = size(Mesh%ElemTable(i)%Elements(1)%ElemNodes); + call RegPack(Buf, nelemnodes) + + ! Loop through nodes of this element type + do j = 1, Mesh%ElemTable(i)%nelem + call RegPack(Buf, Mesh%ElemTable(i)%Elements(j)%ElemNodes) + end do + end if + end do + + call RegPack(Buf, Mesh%Position) + call RegPack(Buf, Mesh%RefOrientation) + + if (Mesh%fieldmask(MASKID_FORCE)) call RegPack(Buf, Mesh%Force) + if (Mesh%fieldmask(MASKID_MOMENT)) call RegPack(Buf, Mesh%Moment) + if (Mesh%fieldmask(MASKID_ORIENTATION)) call RegPack(Buf, Mesh%Orientation) + if (Mesh%fieldmask(MASKID_TRANSLATIONDISP)) call RegPack(Buf, Mesh%TranslationDisp) + if (Mesh%fieldmask(MASKID_ROTATIONVEL)) call RegPack(Buf, Mesh%RotationVel) + if (Mesh%fieldmask(MASKID_TRANSLATIONVEL)) call RegPack(Buf, Mesh%TranslationVel) + if (Mesh%fieldmask(MASKID_TRANSLATIONACC)) call RegPack(Buf, Mesh%TranslationAcc) + if (Mesh%fieldmask(MASKID_ROTATIONACC)) call RegPack(Buf, Mesh%RotationAcc) + if (Mesh%nScalars > 0) call RegPack(Buf, Mesh%Scalars) + + !bjj: where are we keeping track of which ones are siblings so that we can unpack them (set pointers) properly for restart? + + ! If buffer error, return + if (RegCheckErr(Buf, RoutineName)) return + END SUBROUTINE MeshPack !---------------------------------------------------------------------------------------------------------------------------------- @@ -1739,221 +1585,143 @@ END SUBROUTINE MeshPack !! recreate a mesh after reading in the buffers on a restart of the program. The sense !! of the name is "unpack the mesh from buffers." The resulting mesh will be returned !! in the exact state as when the data in the buffers was packed using MeshPack. - SUBROUTINE MeshUnpack( Mesh, ReKiBuf, DbKiBuf, IntKiBuf, ErrStat, ErrMess ) + SUBROUTINE MeshUnpack(Buf, Mesh) + type(PackBuffer), intent(inout) :: Buf + type(MeshType), intent(inout) :: Mesh ! Mesh being packed + ! bjj: not implemented yet: ! If the mesh has an already recreated sibling mesh from a previous call to MeshUnpack, specify ! the existing sibling as an optional argument so that the sibling relationship is also recreated. - TYPE(MeshType), INTENT(INOUT) :: Mesh - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMess - - ! Local LOGICAL committed, RemapFlag, fieldmask(FIELDMASK_SIZE) INTEGER nScalars, ios, nnodes, nextelem, nelemnodes, nelem, refnode INTEGER i,j - - INTEGER(IntKi) :: Re_Xferred ! number of reals transferred - INTEGER(IntKi) :: Db_Xferred ! number of doubles transferred - INTEGER(IntKi) :: Int_Xferred ! number of integers transferred - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMess2 - CHARACTER(*), PARAMETER :: RoutineName = "MeshUnpack" - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 + integer(IntKi) :: EN(20) ! Element nodes - ErrStat = ErrID_None - ErrMess = "" + CHARACTER(*), PARAMETER :: RoutineName = "MeshUnpack" + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Read if mesh was initialized + call RegUnpack(Buf, Mesh%initialized) - IF (IntKiBuf(Int_Xferred) == 0 ) THEN ! this is a blank mesh - CALL MeshDestroy( Mesh, ErrStat2, ErrMess2, .TRUE. ) - CALL SetErrStat(ErrStat2,ErrMess2,ErrStat,ErrMess,RoutineName) - RETURN - END IF - - - ! initialized, may or may not be committed - - Mesh%initialized = .true.; Int_Xferred = Int_Xferred + 1 - committed = TRANSFER( IntKiBuf(Int_Xferred), Mesh%committed ); Int_Xferred = Int_Xferred + 1 - fieldmask = TRANSFER( IntKiBuf(Int_Xferred:Int_Xferred+FIELDMASK_SIZE-1), fieldmask ); Int_Xferred = Int_Xferred + FIELDMASK_SIZE - RemapFlag = TRANSFER( IntKiBuf(Int_Xferred), Mesh%RemapFlag ); Int_Xferred = Int_Xferred + 1 - ! integers - ios = IntKiBuf(Int_Xferred) ; Int_Xferred = Int_Xferred + 1 - nnodes = IntKiBuf(Int_Xferred) ; Int_Xferred = Int_Xferred + 1 - refnode = IntKiBuf(Int_Xferred) ; Int_Xferred = Int_Xferred + 1 - nextelem = IntKiBuf(Int_Xferred) ; Int_Xferred = Int_Xferred + 1 - nscalars = IntKiBuf(Int_Xferred) ; Int_Xferred = Int_Xferred + 1 - - - CALL MeshCreate( Mesh, ios, nnodes & - ,ErrStat=ErrStat2, ErrMess=ErrMess2 & - ,Force =fieldmask(MASKID_FORCE) & - ,Moment =fieldmask(MASKID_MOMENT) & - ,Orientation =fieldmask(MASKID_ORIENTATION) & - ,TranslationDisp=fieldmask(MASKID_TRANSLATIONDISP) & - ,TranslationVel =fieldmask(MASKID_TRANSLATIONVEL ) & - ,RotationVel =fieldmask(MASKID_ROTATIONVEL ) & - ,TranslationAcc =fieldmask(MASKID_TRANSLATIONACC ) & - ,RotationAcc =fieldmask(MASKID_ROTATIONACC ) & - ,nScalars = nScalars & + ! If mesh was not initialized, this is a blank mesh, destroy and return + if (.not. Mesh%initialized) THEN + call MeshDestroy( Mesh, Buf%ErrStat, Buf%ErrMsg, .TRUE. ) + return + end if + + ! Logicals + call RegUnpack(Buf, committed) + call RegUnpack(Buf, fieldmask) + call RegUnpack(Buf, RemapFlag) + + ! Integers + call RegUnpack(Buf, ios) + call RegUnpack(Buf, nnodes) + call RegUnpack(Buf, refnode) + call RegUnpack(Buf, nextelem) + call RegUnpack(Buf, nscalars) + + ! If buffer error, return + if (RegCheckErr(Buf, RoutineName)) return + + ! Create mesh + call MeshCreate(Mesh, ios, nnodes & + ,ErrStat=Buf%ErrStat, ErrMess=Buf%ErrMsg & + ,Force = fieldmask(MASKID_FORCE) & + ,Moment = fieldmask(MASKID_MOMENT) & + ,Orientation = fieldmask(MASKID_ORIENTATION) & + ,TranslationDisp = fieldmask(MASKID_TRANSLATIONDISP) & + ,TranslationVel = fieldmask(MASKID_TRANSLATIONVEL) & + ,RotationVel = fieldmask(MASKID_ROTATIONVEL) & + ,TranslationAcc = fieldmask(MASKID_TRANSLATIONACC) & + ,RotationAcc = fieldmask(MASKID_ROTATIONACC) & + ,nScalars = nScalars & ) - CALL SetErrStat(ErrStat2, ErrMess2, ErrStat, ErrMess, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + if (Buf%ErrStat >= AbortErrLev) return Mesh%RefNode = refnode Mesh%RemapFlag = RemapFlag Mesh%nextelem = nextelem - ! element structure - DO i = 1, NELEMKINDS - nelem = IntKiBuf(Int_Xferred); Int_Xferred = Int_Xferred + 1 ! number of elements - + ! element structure + DO i = 1, NELEMKINDS + + ! number of elements + call RegUnpack(Buf, nelem) + if (RegCheckErr(Buf, RoutineName)) return + + ! If there are elements of this kind if (nelem > 0) then - nelemnodes = IntKiBuf(Int_Xferred); Int_Xferred = Int_Xferred + 1 ! nodes per element + + ! Get number of nodes per element + call RegUnpack(Buf, nelemnodes) + if (RegCheckErr(Buf, RoutineName)) return - ! nodes in this element - DO j = 1,nelem - - SELECT CASE (nelemnodes) - CASE (1) - CALL MeshConstructElement( Mesh, i, ErrStat, ErrMess & - , P1 =IntKiBuf(Int_Xferred ) & - ) - CASE (2) - CALL MeshConstructElement( Mesh, i, ErrStat, ErrMess & - , P1 =IntKiBuf(Int_Xferred ),P2 =IntKiBuf(Int_Xferred+ 1) & - ) - CASE (3) - CALL MeshConstructElement( Mesh, i, ErrStat, ErrMess & - , P1 =IntKiBuf(Int_Xferred ),P2 =IntKiBuf(Int_Xferred+ 1),P3 =IntKiBuf(Int_Xferred+ 2) & - ) - CASE (4) - CALL MeshConstructElement( Mesh, i, ErrStat, ErrMess & - , P1 =IntKiBuf(Int_Xferred ),P2 =IntKiBuf(Int_Xferred+ 1),P3 =IntKiBuf(Int_Xferred+ 2) & - , P4 =IntKiBuf(Int_Xferred+ 3) & - ) - CASE (6) - CALL MeshConstructElement( Mesh, i, ErrStat, ErrMess & - , P1 =IntKiBuf(Int_Xferred ),P2 =IntKiBuf(Int_Xferred+ 1),P3 =IntKiBuf(Int_Xferred+ 2) & - , P4 =IntKiBuf(Int_Xferred+ 3),P5 =IntKiBuf(Int_Xferred+ 4),P6 =IntKiBuf(Int_Xferred+ 5) & - ) - CASE (8) - CALL MeshConstructElement( Mesh, i, ErrStat2, ErrMess2 & - , P1 =IntKiBuf(Int_Xferred ),P2 =IntKiBuf(Int_Xferred+ 1),P3 =IntKiBuf(Int_Xferred+ 2) & - , P4 =IntKiBuf(Int_Xferred+ 3),P5 =IntKiBuf(Int_Xferred+ 4),P6 =IntKiBuf(Int_Xferred+ 5) & - , P7 =IntKiBuf(Int_Xferred+ 6),P8 =IntKiBuf(Int_Xferred+ 7) & - ) - CASE (10) - CALL MeshConstructElement( Mesh, i, ErrStat, ErrMess & - , P1 =IntKiBuf(Int_Xferred ),P2 =IntKiBuf(Int_Xferred+ 1),P3 =IntKiBuf(Int_Xferred+ 2) & - , P4 =IntKiBuf(Int_Xferred+ 3),P5 =IntKiBuf(Int_Xferred+ 4),P6 =IntKiBuf(Int_Xferred+ 5) & - , P7 =IntKiBuf(Int_Xferred+ 6),P8 =IntKiBuf(Int_Xferred+ 7),P9 =IntKiBuf(Int_Xferred+ 8) & - , P10=IntKiBuf(Int_Xferred+ 9) & - ) - CASE (15) - CALL MeshConstructElement( Mesh, i, ErrStat, ErrMess & - , P1 =IntKiBuf(Int_Xferred ),P2 =IntKiBuf(Int_Xferred+ 1),P3 =IntKiBuf(Int_Xferred+ 2) & - , P4 =IntKiBuf(Int_Xferred+ 3),P5 =IntKiBuf(Int_Xferred+ 4),P6 =IntKiBuf(Int_Xferred+ 5) & - , P7 =IntKiBuf(Int_Xferred+ 6),P8 =IntKiBuf(Int_Xferred+ 7),P9 =IntKiBuf(Int_Xferred+ 8) & - , P10=IntKiBuf(Int_Xferred+ 9),P11=IntKiBuf(Int_Xferred+10),P12=IntKiBuf(Int_Xferred+11) & - , P13=IntKiBuf(Int_Xferred+12),P14=IntKiBuf(Int_Xferred+13),P15=IntKiBuf(Int_Xferred+14) & - ) - CASE (20) - CALL MeshConstructElement( Mesh, i, ErrStat, ErrMess & - , P1 =IntKiBuf(Int_Xferred ),P2 =IntKiBuf(Int_Xferred+ 1),P3 =IntKiBuf(Int_Xferred+ 2) & - , P4 =IntKiBuf(Int_Xferred+ 3),P5 =IntKiBuf(Int_Xferred+ 4),P6 =IntKiBuf(Int_Xferred+ 5) & - , P7 =IntKiBuf(Int_Xferred+ 6),P8 =IntKiBuf(Int_Xferred+ 7),P9 =IntKiBuf(Int_Xferred+ 8) & - , P10=IntKiBuf(Int_Xferred+ 9),P11=IntKiBuf(Int_Xferred+10),P12=IntKiBuf(Int_Xferred+11) & - , P13=IntKiBuf(Int_Xferred+12),P14=IntKiBuf(Int_Xferred+13),P15=IntKiBuf(Int_Xferred+14) & - , P16=IntKiBuf(Int_Xferred+15),P17=IntKiBuf(Int_Xferred+16),P18=IntKiBuf(Int_Xferred+17) & - , P19=IntKiBuf(Int_Xferred+18),P20=IntKiBuf(Int_Xferred+19) & - ) - CASE DEFAULT - CALL SetErrStat(ErrID_Fatal,"No such element. Probably manged buffer.",ErrStat,ErrMess,RoutineName) - RETURN - END SELECT - Int_Xferred = Int_Xferred + nelemnodes - END DO ! Elements of this kind - end if ! if there are any elements of this kind - - END DO ! kinds of elements - - ! ..... fill ReKiBuf ..... - DO i = 1, Mesh%Nnodes ! Position - Mesh%Position(:,i) = ReKiBuf(Re_Xferred:Re_Xferred+2); Re_Xferred = Re_Xferred + 3 - END DO - DO i = 1, Mesh%Nnodes ! RefOrientation - DO j = 1,3 - Mesh%RefOrientation(:,j,i) = DbKiBuf(Db_Xferred:Db_Xferred+2); Db_Xferred = Db_Xferred + 3 - ENDDO - END DO - - IF ( FieldMask(MASKID_FORCE) ) THEN ! Force - DO i = 1, Mesh%Nnodes - Mesh%Force(:,i) = ReKiBuf(Re_Xferred:Re_Xferred+2); Re_Xferred = Re_Xferred + 3 - ENDDO - ENDIF - IF ( FieldMask(MASKID_MOMENT) ) THEN ! Moment - DO i = 1, Mesh%Nnodes - Mesh%Moment(:,i) = ReKiBuf(Re_Xferred:Re_Xferred+2); Re_Xferred = Re_Xferred + 3 - ENDDO - ENDIF - IF ( FieldMask(MASKID_ORIENTATION) ) THEN ! Orientation - DO i = 1, Mesh%Nnodes - DO j = 1,3 - Mesh%Orientation(:,j,i) = DbKiBuf(Db_Xferred:Db_Xferred+2); Db_Xferred = Db_Xferred + 3 - ENDDO - END DO - ENDIF - IF ( FieldMask(MASKID_TRANSLATIONDISP) ) THEN ! TranslationDisp - DO i = 1, Mesh%Nnodes - Mesh%TranslationDisp(:,i) = DbKiBuf(Db_Xferred:Db_Xferred+2); Db_Xferred = Db_Xferred + 3 - ENDDO - ENDIF - IF ( FieldMask(MASKID_ROTATIONVEL) ) THEN ! RotationVel - DO i = 1, Mesh%Nnodes - Mesh%RotationVel(:,i) = ReKiBuf(Re_Xferred:Re_Xferred+2); Re_Xferred = Re_Xferred + 3 - ENDDO - ENDIF - IF ( FieldMask(MASKID_TRANSLATIONVEL) ) THEN ! TranslationVel - DO i = 1, Mesh%Nnodes - Mesh%TranslationVel(:,i) = ReKiBuf(Re_Xferred:Re_Xferred+2); Re_Xferred = Re_Xferred + 3 - ENDDO - ENDIF - IF ( FieldMask(MASKID_ROTATIONACC) ) THEN ! RotationAcc - DO i = 1, Mesh%Nnodes - Mesh%RotationAcc(:,i) = ReKiBuf(Re_Xferred:Re_Xferred+2); Re_Xferred = Re_Xferred + 3 - ENDDO - ENDIF - IF ( FieldMask(MASKID_TRANSLATIONACC) ) THEN ! TranslationAcc - DO i = 1, Mesh%Nnodes - Mesh%TranslationAcc(:,i) = ReKiBuf(Re_Xferred:Re_Xferred+2); Re_Xferred = Re_Xferred + 3 - ENDDO - ENDIF - - IF ( Mesh%nScalars .GT. 0 ) THEN ! n_re = n_re + Mesh%Nnodes * Mesh%nScalar - DO i = 1, Mesh%Nnodes - Mesh%Scalars(:,i) = ReKiBuf(Re_Xferred:Re_Xferred+Mesh%nScalars-1); Re_Xferred = Re_Xferred + Mesh%nScalars - ENDDO - ENDIF + ! Nodes in this element + do j = 1, nelem + + ! Read nodes for this element + call RegUnpack(Buf, EN(1:nelemnodes)) + + select case (nelemnodes) + case (1) + call MeshConstructElement(Mesh, i, Buf%ErrStat, Buf%ErrMsg, P1=EN(1)) + case (2) + call MeshConstructElement(Mesh, i, Buf%ErrStat, Buf%ErrMsg, P1=EN(1), P2=EN(2)) + case (3) + call MeshConstructElement(Mesh, i, Buf%ErrStat, Buf%ErrMsg, P1=EN(1), P2=EN(2), P3=EN(3)) + case (4) + call MeshConstructElement(Mesh, i, Buf%ErrStat, Buf%ErrMsg, P1=EN(1), P2=EN(2), P3=EN(3), P4=EN(4)) + case (6) + call MeshConstructElement(Mesh, i, Buf%ErrStat, Buf%ErrMsg, P1=EN(1), P2=EN(2), P3=EN(3), & + P4=EN(4), P5=EN(5), P6=EN(6)) + case (8) + call MeshConstructElement(Mesh, i, Buf%ErrStat, Buf%ErrMsg, P1=EN(1), P2=EN(2), P3=EN(3), & + P4=EN(4), P5=EN(5), P6=EN(6), P7=EN(7), P8=EN(8)) + case (10) + call MeshConstructElement(Mesh, i, Buf%ErrStat, Buf%ErrMsg, P1=EN(1), P2=EN(2), P3=EN(3), & + P4=EN(4), P5=EN(5), P6=EN(6), P7=EN(7), P8=EN(8), P9=EN(9), P10=EN(10)) + case (15) + call MeshConstructElement(Mesh, i, Buf%ErrStat, Buf%ErrMsg, P1=EN(1), P2=EN(2), P3=EN(3), & + P4=EN(4), P5=EN(5), P6=EN(6), P7=EN(7), P8=EN(8), P9=EN(9), & + P10=EN(10), P11=EN(11), P12=EN(12), P13=EN(13), P14=EN(14), P15=EN(15)) + case (20) + call MeshConstructElement(Mesh, i, Buf%ErrStat, Buf%ErrMsg, P1=EN(1), P2=EN(2), P3=EN(3), & + P4=EN(4), P5=EN(5), P6=EN(6), P7=EN(7), P8=EN(8), P9=EN(9), & + P10=EN(10), P11=EN(11), P12=EN(12), P13=EN(13), P14=EN(14), & + P15=EN(15), P16=EN(16), P17=EN(17), P18=EN(18), P19=EN(19), P20=EN(20)) + case default + call SetErrStat(ErrID_Fatal,"No such element. Probably mangled buffer.", Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end select + end do + end if + end do + + call RegUnpack(Buf, Mesh%Position) + call RegUnpack(Buf, Mesh%RefOrientation) + + if (FieldMask(MASKID_FORCE)) call RegUnpack(Buf, Mesh%Force) + if (FieldMask(MASKID_MOMENT)) call RegUnpack(Buf, Mesh%Moment) + if (FieldMask(MASKID_ORIENTATION)) call RegUnpack(Buf, Mesh%Orientation) + if (FieldMask(MASKID_TRANSLATIONDISP)) call RegUnpack(Buf, Mesh%TranslationDisp) + if (FieldMask(MASKID_ROTATIONVEL)) call RegUnpack(Buf, Mesh%RotationVel) + if (FieldMask(MASKID_TRANSLATIONVEL)) call RegUnpack(Buf, Mesh%TranslationVel) + if (FieldMask(MASKID_TRANSLATIONACC)) call RegUnpack(Buf, Mesh%TranslationAcc) + if (FieldMask(MASKID_ROTATIONACC)) call RegUnpack(Buf, Mesh%RotationAcc) + if (nScalars > 0) call RegUnpack(Buf, Mesh%Scalars) + + ! If buffer error, return + if (RegCheckErr(Buf, RoutineName)) return - ! commit the mesh - IF (committed) THEN - CALL MeshCommit(Mesh, ErrStat2, ErrMess2) - CALL SetErrStat(ErrStat2, ErrMess2, ErrStat, ErrMess, RoutineName) - END IF - - RETURN + ! Commit the mesh + if (committed) call MeshCommit(Mesh, Buf%ErrStat, Buf%ErrMsg) - END SUBROUTINE MeshUnpack + end subroutine !---------------------------------------------------------------------------------------------------------------------------------- !> Given an existing mesh and a destination mesh, create a completely new copy, a sibling, or diff --git a/modules/nwtc-library/src/ModMesh_Mapping.f90 b/modules/nwtc-library/src/ModMesh_Mapping.f90 index df2723a60b..d2e08297bd 100644 --- a/modules/nwtc-library/src/ModMesh_Mapping.f90 +++ b/modules/nwtc-library/src/ModMesh_Mapping.f90 @@ -27,6 +27,7 @@ !********************************************************************************************************************************** MODULE ModMesh_Mapping + USE ModReg USE ModMesh USE NWTC_LAPACK @@ -5768,7 +5769,7 @@ END SUBROUTINE WriteMappingTransferToFile ! ! FAST Registry !********************************************************************************************************************************* - SUBROUTINE NWTC_Library_CopyMapType( SrcMapTypeData, DstMapTypeData, CtrlCode, ErrStat, ErrMsg ) +SUBROUTINE NWTC_Library_CopyMapType( SrcMapTypeData, DstMapTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(MapType), INTENT(IN) :: SrcMapTypeData TYPE(MapType), INTENT(INOUT) :: DstMapTypeData INTEGER(IntKi), INTENT(IN ) :: CtrlCode @@ -5777,8 +5778,6 @@ SUBROUTINE NWTC_Library_CopyMapType( SrcMapTypeData, DstMapTypeData, CtrlCode, E ! Local INTEGER(IntKi) :: i,j,k INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_CopyMapType' @@ -5791,14 +5790,12 @@ SUBROUTINE NWTC_Library_CopyMapType( SrcMapTypeData, DstMapTypeData, CtrlCode, E DstMapTypeData%shape_fn = SrcMapTypeData%shape_fn END SUBROUTINE NWTC_Library_CopyMapType - SUBROUTINE NWTC_Library_DestroyMapType( MapTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE NWTC_Library_DestroyMapType( MapTypeData, ErrStat, ErrMsg ) TYPE(MapType), INTENT(INOUT) :: MapTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_DestroyMapType' @@ -5806,141 +5803,46 @@ SUBROUTINE NWTC_Library_DestroyMapType( MapTypeData, ErrStat, ErrMsg, DEALLOCATE ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE NWTC_Library_DestroyMapType - SUBROUTINE NWTC_Library_PackMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MapType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_PackMapType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! OtherMesh_Element - Db_BufSz = Db_BufSz + 1 ! distance - Db_BufSz = Db_BufSz + SIZE(InData%couple_arm) ! couple_arm - Db_BufSz = Db_BufSz + SIZE(InData%shape_fn) ! shape_fn - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%OtherMesh_Element - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%distance - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%couple_arm,1), UBOUND(InData%couple_arm,1) - DbKiBuf(Db_Xferred) = InData%couple_arm(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%shape_fn,1), UBOUND(InData%shape_fn,1) - DbKiBuf(Db_Xferred) = InData%shape_fn(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE NWTC_Library_PackMapType - - SUBROUTINE NWTC_Library_UnPackMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MapType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_UnPackMapType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%OtherMesh_Element = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%distance = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%couple_arm,1) - i1_u = UBOUND(OutData%couple_arm,1) - DO i1 = LBOUND(OutData%couple_arm,1), UBOUND(OutData%couple_arm,1) - OutData%couple_arm(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%shape_fn,1) - i1_u = UBOUND(OutData%shape_fn,1) - DO i1 = LBOUND(OutData%shape_fn,1), UBOUND(OutData%shape_fn,1) - OutData%shape_fn(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END SUBROUTINE NWTC_Library_UnPackMapType +subroutine NWTC_Library_PackMapType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MapType), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackMapType' + if (Buf%ErrStat >= AbortErrLev) return + ! OtherMesh_Element + call RegPack(Buf, InData%OtherMesh_Element) + if (RegCheckErr(Buf, RoutineName)) return + ! distance + call RegPack(Buf, InData%distance) + if (RegCheckErr(Buf, RoutineName)) return + ! couple_arm + call RegPack(Buf, InData%couple_arm) + if (RegCheckErr(Buf, RoutineName)) return + ! shape_fn + call RegPack(Buf, InData%shape_fn) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackMapType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MapType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackMapType' + if (Buf%ErrStat /= ErrID_None) return + ! OtherMesh_Element + call RegUnpack(Buf, OutData%OtherMesh_Element) + if (RegCheckErr(Buf, RoutineName)) return + ! distance + call RegUnpack(Buf, OutData%distance) + if (RegCheckErr(Buf, RoutineName)) return + ! couple_arm + call RegUnpack(Buf, OutData%couple_arm) + if (RegCheckErr(Buf, RoutineName)) return + ! shape_fn + call RegUnpack(Buf, OutData%shape_fn) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE NWTC_Library_CopyMeshMapLinearizationType( SrcMeshMapLinearizationTypeData, DstMeshMapLinearizationTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(MeshMapLinearizationType), INTENT(IN) :: SrcMeshMapLinearizationTypeData TYPE(MeshMapLinearizationType), INTENT(INOUT) :: DstMeshMapLinearizationTypeData @@ -6113,14 +6015,12 @@ SUBROUTINE NWTC_Library_CopyMeshMapLinearizationType( SrcMeshMapLinearizationTyp ENDIF END SUBROUTINE NWTC_Library_CopyMeshMapLinearizationType - SUBROUTINE NWTC_Library_DestroyMeshMapLinearizationType( MeshMapLinearizationTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE NWTC_Library_DestroyMeshMapLinearizationType( MeshMapLinearizationTypeData, ErrStat, ErrMsg ) TYPE(MeshMapLinearizationType), INTENT(INOUT) :: MeshMapLinearizationTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_DestroyMeshMapLinearizationType' @@ -6128,12 +6028,6 @@ SUBROUTINE NWTC_Library_DestroyMeshMapLinearizationType( MeshMapLinearizationTyp ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(MeshMapLinearizationTypeData%mi)) THEN DEALLOCATE(MeshMapLinearizationTypeData%mi) ENDIF @@ -6169,628 +6063,265 @@ SUBROUTINE NWTC_Library_DestroyMeshMapLinearizationType( MeshMapLinearizationTyp ENDIF END SUBROUTINE NWTC_Library_DestroyMeshMapLinearizationType - SUBROUTINE NWTC_Library_PackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MeshMapLinearizationType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_PackMeshMapLinearizationType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! mi allocated yes/no - IF ( ALLOCATED(InData%mi) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! mi upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%mi) ! mi - END IF - Int_BufSz = Int_BufSz + 1 ! fx_p allocated yes/no - IF ( ALLOCATED(InData%fx_p) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! fx_p upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%fx_p) ! fx_p - END IF - Int_BufSz = Int_BufSz + 1 ! tv_uD allocated yes/no - IF ( ALLOCATED(InData%tv_uD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! tv_uD upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%tv_uD) ! tv_uD - END IF - Int_BufSz = Int_BufSz + 1 ! tv_uS allocated yes/no - IF ( ALLOCATED(InData%tv_uS) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! tv_uS upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%tv_uS) ! tv_uS - END IF - Int_BufSz = Int_BufSz + 1 ! ta_uD allocated yes/no - IF ( ALLOCATED(InData%ta_uD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ta_uD upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%ta_uD) ! ta_uD - END IF - Int_BufSz = Int_BufSz + 1 ! ta_uS allocated yes/no - IF ( ALLOCATED(InData%ta_uS) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ta_uS upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%ta_uS) ! ta_uS - END IF - Int_BufSz = Int_BufSz + 1 ! ta_rv allocated yes/no - IF ( ALLOCATED(InData%ta_rv) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ta_rv upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%ta_rv) ! ta_rv - END IF - Int_BufSz = Int_BufSz + 1 ! li allocated yes/no - IF ( ALLOCATED(InData%li) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! li upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%li) ! li - END IF - Int_BufSz = Int_BufSz + 1 ! M_uS allocated yes/no - IF ( ALLOCATED(InData%M_uS) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! M_uS upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%M_uS) ! M_uS - END IF - Int_BufSz = Int_BufSz + 1 ! M_uD allocated yes/no - IF ( ALLOCATED(InData%M_uD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! M_uD upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%M_uD) ! M_uD - END IF - Int_BufSz = Int_BufSz + 1 ! M_f allocated yes/no - IF ( ALLOCATED(InData%M_f) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! M_f upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%M_f) ! M_f - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%mi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%mi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%mi,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%mi,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%mi,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%mi,2), UBOUND(InData%mi,2) - DO i1 = LBOUND(InData%mi,1), UBOUND(InData%mi,1) - DbKiBuf(Db_Xferred) = InData%mi(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%fx_p) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fx_p,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fx_p,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fx_p,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fx_p,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%fx_p,2), UBOUND(InData%fx_p,2) - DO i1 = LBOUND(InData%fx_p,1), UBOUND(InData%fx_p,1) - DbKiBuf(Db_Xferred) = InData%fx_p(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%tv_uD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%tv_uD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tv_uD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%tv_uD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tv_uD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%tv_uD,2), UBOUND(InData%tv_uD,2) - DO i1 = LBOUND(InData%tv_uD,1), UBOUND(InData%tv_uD,1) - DbKiBuf(Db_Xferred) = InData%tv_uD(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%tv_uS) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%tv_uS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tv_uS,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%tv_uS,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tv_uS,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%tv_uS,2), UBOUND(InData%tv_uS,2) - DO i1 = LBOUND(InData%tv_uS,1), UBOUND(InData%tv_uS,1) - DbKiBuf(Db_Xferred) = InData%tv_uS(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ta_uD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ta_uD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ta_uD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ta_uD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ta_uD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ta_uD,2), UBOUND(InData%ta_uD,2) - DO i1 = LBOUND(InData%ta_uD,1), UBOUND(InData%ta_uD,1) - DbKiBuf(Db_Xferred) = InData%ta_uD(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ta_uS) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ta_uS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ta_uS,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ta_uS,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ta_uS,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ta_uS,2), UBOUND(InData%ta_uS,2) - DO i1 = LBOUND(InData%ta_uS,1), UBOUND(InData%ta_uS,1) - DbKiBuf(Db_Xferred) = InData%ta_uS(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ta_rv) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ta_rv,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ta_rv,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ta_rv,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ta_rv,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ta_rv,2), UBOUND(InData%ta_rv,2) - DO i1 = LBOUND(InData%ta_rv,1), UBOUND(InData%ta_rv,1) - DbKiBuf(Db_Xferred) = InData%ta_rv(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%li) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%li,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%li,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%li,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%li,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%li,2), UBOUND(InData%li,2) - DO i1 = LBOUND(InData%li,1), UBOUND(InData%li,1) - DbKiBuf(Db_Xferred) = InData%li(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%M_uS) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M_uS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M_uS,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M_uS,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M_uS,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%M_uS,2), UBOUND(InData%M_uS,2) - DO i1 = LBOUND(InData%M_uS,1), UBOUND(InData%M_uS,1) - DbKiBuf(Db_Xferred) = InData%M_uS(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%M_uD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M_uD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M_uD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M_uD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M_uD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%M_uD,2), UBOUND(InData%M_uD,2) - DO i1 = LBOUND(InData%M_uD,1), UBOUND(InData%M_uD,1) - DbKiBuf(Db_Xferred) = InData%M_uD(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%M_f) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M_f,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M_f,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M_f,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M_f,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%M_f,2), UBOUND(InData%M_f,2) - DO i1 = LBOUND(InData%M_f,1), UBOUND(InData%M_f,1) - DbKiBuf(Db_Xferred) = InData%M_f(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE NWTC_Library_PackMeshMapLinearizationType - - SUBROUTINE NWTC_Library_UnPackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MeshMapLinearizationType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_UnPackMeshMapLinearizationType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! mi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%mi)) DEALLOCATE(OutData%mi) - ALLOCATE(OutData%mi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%mi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%mi,2), UBOUND(OutData%mi,2) - DO i1 = LBOUND(OutData%mi,1), UBOUND(OutData%mi,1) - OutData%mi(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fx_p not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%fx_p)) DEALLOCATE(OutData%fx_p) - ALLOCATE(OutData%fx_p(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fx_p.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%fx_p,2), UBOUND(OutData%fx_p,2) - DO i1 = LBOUND(OutData%fx_p,1), UBOUND(OutData%fx_p,1) - OutData%fx_p(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! tv_uD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%tv_uD)) DEALLOCATE(OutData%tv_uD) - ALLOCATE(OutData%tv_uD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%tv_uD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%tv_uD,2), UBOUND(OutData%tv_uD,2) - DO i1 = LBOUND(OutData%tv_uD,1), UBOUND(OutData%tv_uD,1) - OutData%tv_uD(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! tv_uS not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%tv_uS)) DEALLOCATE(OutData%tv_uS) - ALLOCATE(OutData%tv_uS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%tv_uS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%tv_uS,2), UBOUND(OutData%tv_uS,2) - DO i1 = LBOUND(OutData%tv_uS,1), UBOUND(OutData%tv_uS,1) - OutData%tv_uS(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ta_uD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ta_uD)) DEALLOCATE(OutData%ta_uD) - ALLOCATE(OutData%ta_uD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ta_uD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ta_uD,2), UBOUND(OutData%ta_uD,2) - DO i1 = LBOUND(OutData%ta_uD,1), UBOUND(OutData%ta_uD,1) - OutData%ta_uD(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ta_uS not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ta_uS)) DEALLOCATE(OutData%ta_uS) - ALLOCATE(OutData%ta_uS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ta_uS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ta_uS,2), UBOUND(OutData%ta_uS,2) - DO i1 = LBOUND(OutData%ta_uS,1), UBOUND(OutData%ta_uS,1) - OutData%ta_uS(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ta_rv not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ta_rv)) DEALLOCATE(OutData%ta_rv) - ALLOCATE(OutData%ta_rv(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ta_rv.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ta_rv,2), UBOUND(OutData%ta_rv,2) - DO i1 = LBOUND(OutData%ta_rv,1), UBOUND(OutData%ta_rv,1) - OutData%ta_rv(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! li not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%li)) DEALLOCATE(OutData%li) - ALLOCATE(OutData%li(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%li.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%li,2), UBOUND(OutData%li,2) - DO i1 = LBOUND(OutData%li,1), UBOUND(OutData%li,1) - OutData%li(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M_uS not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%M_uS)) DEALLOCATE(OutData%M_uS) - ALLOCATE(OutData%M_uS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M_uS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%M_uS,2), UBOUND(OutData%M_uS,2) - DO i1 = LBOUND(OutData%M_uS,1), UBOUND(OutData%M_uS,1) - OutData%M_uS(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M_uD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%M_uD)) DEALLOCATE(OutData%M_uD) - ALLOCATE(OutData%M_uD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M_uD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%M_uD,2), UBOUND(OutData%M_uD,2) - DO i1 = LBOUND(OutData%M_uD,1), UBOUND(OutData%M_uD,1) - OutData%M_uD(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M_f not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%M_f)) DEALLOCATE(OutData%M_f) - ALLOCATE(OutData%M_f(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M_f.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%M_f,2), UBOUND(OutData%M_f,2) - DO i1 = LBOUND(OutData%M_f,1), UBOUND(OutData%M_f,1) - OutData%M_f(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE NWTC_Library_UnPackMeshMapLinearizationType +subroutine NWTC_Library_PackMeshMapLinearizationType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MeshMapLinearizationType), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackMeshMapLinearizationType' + if (Buf%ErrStat >= AbortErrLev) return + ! mi + call RegPack(Buf, allocated(InData%mi)) + if (allocated(InData%mi)) then + call RegPackBounds(Buf, 2, lbound(InData%mi), ubound(InData%mi)) + call RegPack(Buf, InData%mi) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! fx_p + call RegPack(Buf, allocated(InData%fx_p)) + if (allocated(InData%fx_p)) then + call RegPackBounds(Buf, 2, lbound(InData%fx_p), ubound(InData%fx_p)) + call RegPack(Buf, InData%fx_p) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! tv_uD + call RegPack(Buf, allocated(InData%tv_uD)) + if (allocated(InData%tv_uD)) then + call RegPackBounds(Buf, 2, lbound(InData%tv_uD), ubound(InData%tv_uD)) + call RegPack(Buf, InData%tv_uD) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! tv_uS + call RegPack(Buf, allocated(InData%tv_uS)) + if (allocated(InData%tv_uS)) then + call RegPackBounds(Buf, 2, lbound(InData%tv_uS), ubound(InData%tv_uS)) + call RegPack(Buf, InData%tv_uS) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ta_uD + call RegPack(Buf, allocated(InData%ta_uD)) + if (allocated(InData%ta_uD)) then + call RegPackBounds(Buf, 2, lbound(InData%ta_uD), ubound(InData%ta_uD)) + call RegPack(Buf, InData%ta_uD) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ta_uS + call RegPack(Buf, allocated(InData%ta_uS)) + if (allocated(InData%ta_uS)) then + call RegPackBounds(Buf, 2, lbound(InData%ta_uS), ubound(InData%ta_uS)) + call RegPack(Buf, InData%ta_uS) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ta_rv + call RegPack(Buf, allocated(InData%ta_rv)) + if (allocated(InData%ta_rv)) then + call RegPackBounds(Buf, 2, lbound(InData%ta_rv), ubound(InData%ta_rv)) + call RegPack(Buf, InData%ta_rv) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! li + call RegPack(Buf, allocated(InData%li)) + if (allocated(InData%li)) then + call RegPackBounds(Buf, 2, lbound(InData%li), ubound(InData%li)) + call RegPack(Buf, InData%li) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! M_uS + call RegPack(Buf, allocated(InData%M_uS)) + if (allocated(InData%M_uS)) then + call RegPackBounds(Buf, 2, lbound(InData%M_uS), ubound(InData%M_uS)) + call RegPack(Buf, InData%M_uS) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! M_uD + call RegPack(Buf, allocated(InData%M_uD)) + if (allocated(InData%M_uD)) then + call RegPackBounds(Buf, 2, lbound(InData%M_uD), ubound(InData%M_uD)) + call RegPack(Buf, InData%M_uD) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! M_f + call RegPack(Buf, allocated(InData%M_f)) + if (allocated(InData%M_f)) then + call RegPackBounds(Buf, 2, lbound(InData%M_f), ubound(InData%M_f)) + call RegPack(Buf, InData%M_f) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackMeshMapLinearizationType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MeshMapLinearizationType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackMeshMapLinearizationType' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! mi + if (allocated(OutData%mi)) deallocate(OutData%mi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%mi(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%mi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%mi) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! fx_p + if (allocated(OutData%fx_p)) deallocate(OutData%fx_p) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%fx_p(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fx_p.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%fx_p) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! tv_uD + if (allocated(OutData%tv_uD)) deallocate(OutData%tv_uD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%tv_uD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%tv_uD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%tv_uD) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! tv_uS + if (allocated(OutData%tv_uS)) deallocate(OutData%tv_uS) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%tv_uS(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%tv_uS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%tv_uS) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ta_uD + if (allocated(OutData%ta_uD)) deallocate(OutData%ta_uD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ta_uD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ta_uD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ta_uD) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ta_uS + if (allocated(OutData%ta_uS)) deallocate(OutData%ta_uS) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ta_uS(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ta_uS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ta_uS) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ta_rv + if (allocated(OutData%ta_rv)) deallocate(OutData%ta_rv) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ta_rv(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ta_rv.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ta_rv) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! li + if (allocated(OutData%li)) deallocate(OutData%li) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%li(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%li.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%li) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! M_uS + if (allocated(OutData%M_uS)) deallocate(OutData%M_uS) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%M_uS(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%M_uS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%M_uS) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! M_uD + if (allocated(OutData%M_uD)) deallocate(OutData%M_uD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%M_uD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%M_uD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%M_uD) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! M_f + if (allocated(OutData%M_f)) deallocate(OutData%M_f) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%M_f(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%M_f.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%M_f) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE NWTC_Library_CopyMeshMapType( SrcMeshMapTypeData, DstMeshMapTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(MeshMapType), INTENT(INOUT) :: SrcMeshMapTypeData TYPE(MeshMapType), INTENT(INOUT) :: DstMeshMapTypeData @@ -6937,14 +6468,12 @@ SUBROUTINE NWTC_Library_CopyMeshMapType( SrcMeshMapTypeData, DstMeshMapTypeData, IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE NWTC_Library_CopyMeshMapType - SUBROUTINE NWTC_Library_DestroyMeshMapType( MeshMapTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE NWTC_Library_DestroyMeshMapType( MeshMapTypeData, ErrStat, ErrMsg ) TYPE(MeshMapType), INTENT(INOUT) :: MeshMapTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_DestroyMeshMapType' @@ -6952,29 +6481,23 @@ SUBROUTINE NWTC_Library_DestroyMeshMapType( MeshMapTypeData, ErrStat, ErrMsg, DE ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(MeshMapTypeData%MapLoads)) THEN DO i1 = LBOUND(MeshMapTypeData%MapLoads,1), UBOUND(MeshMapTypeData%MapLoads,1) - CALL NWTC_Library_Destroymaptype( MeshMapTypeData%MapLoads(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMapType( MeshMapTypeData%MapLoads(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MeshMapTypeData%MapLoads) ENDIF IF (ALLOCATED(MeshMapTypeData%MapMotions)) THEN DO i1 = LBOUND(MeshMapTypeData%MapMotions,1), UBOUND(MeshMapTypeData%MapMotions,1) - CALL NWTC_Library_Destroymaptype( MeshMapTypeData%MapMotions(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMapType( MeshMapTypeData%MapMotions(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MeshMapTypeData%MapMotions) ENDIF IF (ALLOCATED(MeshMapTypeData%MapSrcToAugmt)) THEN DO i1 = LBOUND(MeshMapTypeData%MapSrcToAugmt,1), UBOUND(MeshMapTypeData%MapSrcToAugmt,1) - CALL NWTC_Library_Destroymaptype( MeshMapTypeData%MapSrcToAugmt(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMapType( MeshMapTypeData%MapSrcToAugmt(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO DEALLOCATE(MeshMapTypeData%MapSrcToAugmt) @@ -6998,960 +6521,236 @@ SUBROUTINE NWTC_Library_DestroyMeshMapType( MeshMapTypeData, ErrStat, ErrMsg, DE IF (ALLOCATED(MeshMapTypeData%LoadLn2_M)) THEN DEALLOCATE(MeshMapTypeData%LoadLn2_M) ENDIF - CALL NWTC_Library_Destroymeshmaplinearizationtype( MeshMapTypeData%dM, ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL NWTC_Library_DestroyMeshMapLinearizationType( MeshMapTypeData%dM, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE NWTC_Library_DestroyMeshMapType - SUBROUTINE NWTC_Library_PackMeshMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MeshMapType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_PackMeshMapType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! MapLoads allocated yes/no - IF ( ALLOCATED(InData%MapLoads) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MapLoads upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%MapLoads,1), UBOUND(InData%MapLoads,1) - Int_BufSz = Int_BufSz + 3 ! MapLoads: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmaptype( Re_Buf, Db_Buf, Int_Buf, InData%MapLoads(i1), ErrStat2, ErrMsg2, .TRUE. ) ! MapLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! MapLoads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! MapLoads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! MapLoads - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! MapMotions allocated yes/no - IF ( ALLOCATED(InData%MapMotions) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MapMotions upper/lower bounds for each dimension - DO i1 = LBOUND(InData%MapMotions,1), UBOUND(InData%MapMotions,1) - Int_BufSz = Int_BufSz + 3 ! MapMotions: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmaptype( Re_Buf, Db_Buf, Int_Buf, InData%MapMotions(i1), ErrStat2, ErrMsg2, .TRUE. ) ! MapMotions - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! MapMotions - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! MapMotions - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! MapMotions - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! MapSrcToAugmt allocated yes/no - IF ( ALLOCATED(InData%MapSrcToAugmt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MapSrcToAugmt upper/lower bounds for each dimension - DO i1 = LBOUND(InData%MapSrcToAugmt,1), UBOUND(InData%MapSrcToAugmt,1) - Int_BufSz = Int_BufSz + 3 ! MapSrcToAugmt: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmaptype( Re_Buf, Db_Buf, Int_Buf, InData%MapSrcToAugmt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! MapSrcToAugmt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! MapSrcToAugmt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! MapSrcToAugmt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! MapSrcToAugmt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! Augmented_Ln2_Src: size of buffers for each call to pack subtype - CALL MeshPack( InData%Augmented_Ln2_Src, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! Augmented_Ln2_Src - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Augmented_Ln2_Src - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Augmented_Ln2_Src - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Augmented_Ln2_Src - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Lumped_Points_Src: size of buffers for each call to pack subtype - CALL MeshPack( InData%Lumped_Points_Src, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! Lumped_Points_Src - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Lumped_Points_Src - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Lumped_Points_Src - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Lumped_Points_Src - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! LoadLn2_A_Mat_Piv allocated yes/no - IF ( ALLOCATED(InData%LoadLn2_A_Mat_Piv) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LoadLn2_A_Mat_Piv upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LoadLn2_A_Mat_Piv) ! LoadLn2_A_Mat_Piv - END IF - Int_BufSz = Int_BufSz + 1 ! DisplacedPosition allocated yes/no - IF ( ALLOCATED(InData%DisplacedPosition) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! DisplacedPosition upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%DisplacedPosition) ! DisplacedPosition - END IF - Int_BufSz = Int_BufSz + 1 ! LoadLn2_A_Mat allocated yes/no - IF ( ALLOCATED(InData%LoadLn2_A_Mat) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! LoadLn2_A_Mat upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%LoadLn2_A_Mat) ! LoadLn2_A_Mat - END IF - Int_BufSz = Int_BufSz + 1 ! LoadLn2_F allocated yes/no - IF ( ALLOCATED(InData%LoadLn2_F) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! LoadLn2_F upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%LoadLn2_F) ! LoadLn2_F - END IF - Int_BufSz = Int_BufSz + 1 ! LoadLn2_M allocated yes/no - IF ( ALLOCATED(InData%LoadLn2_M) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! LoadLn2_M upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%LoadLn2_M) ! LoadLn2_M - END IF - Int_BufSz = Int_BufSz + 3 ! dM: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaplinearizationtype( Re_Buf, Db_Buf, Int_Buf, InData%dM, ErrStat2, ErrMsg2, .TRUE. ) ! dM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! dM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! dM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! dM - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%MapLoads) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MapLoads,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MapLoads,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MapLoads,1), UBOUND(InData%MapLoads,1) - CALL NWTC_Library_Packmaptype( Re_Buf, Db_Buf, Int_Buf, InData%MapLoads(i1), ErrStat2, ErrMsg2, OnlySize ) ! MapLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MapMotions) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MapMotions,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MapMotions,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MapMotions,1), UBOUND(InData%MapMotions,1) - CALL NWTC_Library_Packmaptype( Re_Buf, Db_Buf, Int_Buf, InData%MapMotions(i1), ErrStat2, ErrMsg2, OnlySize ) ! MapMotions - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MapSrcToAugmt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MapSrcToAugmt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MapSrcToAugmt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MapSrcToAugmt,1), UBOUND(InData%MapSrcToAugmt,1) - CALL NWTC_Library_Packmaptype( Re_Buf, Db_Buf, Int_Buf, InData%MapSrcToAugmt(i1), ErrStat2, ErrMsg2, OnlySize ) ! MapSrcToAugmt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL MeshPack( InData%Augmented_Ln2_Src, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! Augmented_Ln2_Src - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MeshPack( InData%Lumped_Points_Src, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! Lumped_Points_Src - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%LoadLn2_A_Mat_Piv) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LoadLn2_A_Mat_Piv,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_A_Mat_Piv,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LoadLn2_A_Mat_Piv,1), UBOUND(InData%LoadLn2_A_Mat_Piv,1) - IntKiBuf(Int_Xferred) = InData%LoadLn2_A_Mat_Piv(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DisplacedPosition) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DisplacedPosition,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DisplacedPosition,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DisplacedPosition,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DisplacedPosition,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DisplacedPosition,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DisplacedPosition,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%DisplacedPosition,3), UBOUND(InData%DisplacedPosition,3) - DO i2 = LBOUND(InData%DisplacedPosition,2), UBOUND(InData%DisplacedPosition,2) - DO i1 = LBOUND(InData%DisplacedPosition,1), UBOUND(InData%DisplacedPosition,1) - DbKiBuf(Db_Xferred) = InData%DisplacedPosition(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LoadLn2_A_Mat) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LoadLn2_A_Mat,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_A_Mat,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LoadLn2_A_Mat,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_A_Mat,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%LoadLn2_A_Mat,2), UBOUND(InData%LoadLn2_A_Mat,2) - DO i1 = LBOUND(InData%LoadLn2_A_Mat,1), UBOUND(InData%LoadLn2_A_Mat,1) - DbKiBuf(Db_Xferred) = InData%LoadLn2_A_Mat(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LoadLn2_F) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LoadLn2_F,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_F,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LoadLn2_F,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_F,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%LoadLn2_F,2), UBOUND(InData%LoadLn2_F,2) - DO i1 = LBOUND(InData%LoadLn2_F,1), UBOUND(InData%LoadLn2_F,1) - DbKiBuf(Db_Xferred) = InData%LoadLn2_F(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LoadLn2_M) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LoadLn2_M,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_M,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LoadLn2_M,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_M,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%LoadLn2_M,2), UBOUND(InData%LoadLn2_M,2) - DO i1 = LBOUND(InData%LoadLn2_M,1), UBOUND(InData%LoadLn2_M,1) - DbKiBuf(Db_Xferred) = InData%LoadLn2_M(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - CALL NWTC_Library_Packmeshmaplinearizationtype( Re_Buf, Db_Buf, Int_Buf, InData%dM, ErrStat2, ErrMsg2, OnlySize ) ! dM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE NWTC_Library_PackMeshMapType - SUBROUTINE NWTC_Library_UnPackMeshMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MeshMapType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_UnPackMeshMapType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MapLoads not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MapLoads)) DEALLOCATE(OutData%MapLoads) - ALLOCATE(OutData%MapLoads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MapLoads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MapLoads,1), UBOUND(OutData%MapLoads,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%MapLoads(i1), ErrStat2, ErrMsg2 ) ! MapLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MapMotions not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MapMotions)) DEALLOCATE(OutData%MapMotions) - ALLOCATE(OutData%MapMotions(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MapMotions.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MapMotions,1), UBOUND(OutData%MapMotions,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%MapMotions(i1), ErrStat2, ErrMsg2 ) ! MapMotions - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MapSrcToAugmt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MapSrcToAugmt)) DEALLOCATE(OutData%MapSrcToAugmt) - ALLOCATE(OutData%MapSrcToAugmt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MapSrcToAugmt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MapSrcToAugmt,1), UBOUND(OutData%MapSrcToAugmt,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%MapSrcToAugmt(i1), ErrStat2, ErrMsg2 ) ! MapSrcToAugmt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%Augmented_Ln2_Src, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! Augmented_Ln2_Src - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%Lumped_Points_Src, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! Lumped_Points_Src - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LoadLn2_A_Mat_Piv not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LoadLn2_A_Mat_Piv)) DEALLOCATE(OutData%LoadLn2_A_Mat_Piv) - ALLOCATE(OutData%LoadLn2_A_Mat_Piv(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LoadLn2_A_Mat_Piv.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LoadLn2_A_Mat_Piv,1), UBOUND(OutData%LoadLn2_A_Mat_Piv,1) - OutData%LoadLn2_A_Mat_Piv(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DisplacedPosition not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DisplacedPosition)) DEALLOCATE(OutData%DisplacedPosition) - ALLOCATE(OutData%DisplacedPosition(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DisplacedPosition.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%DisplacedPosition,3), UBOUND(OutData%DisplacedPosition,3) - DO i2 = LBOUND(OutData%DisplacedPosition,2), UBOUND(OutData%DisplacedPosition,2) - DO i1 = LBOUND(OutData%DisplacedPosition,1), UBOUND(OutData%DisplacedPosition,1) - OutData%DisplacedPosition(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LoadLn2_A_Mat not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LoadLn2_A_Mat)) DEALLOCATE(OutData%LoadLn2_A_Mat) - ALLOCATE(OutData%LoadLn2_A_Mat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LoadLn2_A_Mat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%LoadLn2_A_Mat,2), UBOUND(OutData%LoadLn2_A_Mat,2) - DO i1 = LBOUND(OutData%LoadLn2_A_Mat,1), UBOUND(OutData%LoadLn2_A_Mat,1) - OutData%LoadLn2_A_Mat(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LoadLn2_F not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LoadLn2_F)) DEALLOCATE(OutData%LoadLn2_F) - ALLOCATE(OutData%LoadLn2_F(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LoadLn2_F.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%LoadLn2_F,2), UBOUND(OutData%LoadLn2_F,2) - DO i1 = LBOUND(OutData%LoadLn2_F,1), UBOUND(OutData%LoadLn2_F,1) - OutData%LoadLn2_F(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LoadLn2_M not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LoadLn2_M)) DEALLOCATE(OutData%LoadLn2_M) - ALLOCATE(OutData%LoadLn2_M(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LoadLn2_M.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%LoadLn2_M,2), UBOUND(OutData%LoadLn2_M,2) - DO i1 = LBOUND(OutData%LoadLn2_M,1), UBOUND(OutData%LoadLn2_M,1) - OutData%LoadLn2_M(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackmeshmaplinearizationtype( Re_Buf, Db_Buf, Int_Buf, OutData%dM, ErrStat2, ErrMsg2 ) ! dM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE NWTC_Library_UnPackMeshMapType +subroutine NWTC_Library_PackMeshMapType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MeshMapType), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackMeshMapType' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + if (Buf%ErrStat >= AbortErrLev) return + ! MapLoads + call RegPack(Buf, allocated(InData%MapLoads)) + if (allocated(InData%MapLoads)) then + call RegPackBounds(Buf, 1, lbound(InData%MapLoads), ubound(InData%MapLoads)) + LB(1:1) = lbound(InData%MapLoads) + UB(1:1) = ubound(InData%MapLoads) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMapType(Buf, InData%MapLoads(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MapMotions + call RegPack(Buf, allocated(InData%MapMotions)) + if (allocated(InData%MapMotions)) then + call RegPackBounds(Buf, 1, lbound(InData%MapMotions), ubound(InData%MapMotions)) + LB(1:1) = lbound(InData%MapMotions) + UB(1:1) = ubound(InData%MapMotions) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMapType(Buf, InData%MapMotions(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MapSrcToAugmt + call RegPack(Buf, allocated(InData%MapSrcToAugmt)) + if (allocated(InData%MapSrcToAugmt)) then + call RegPackBounds(Buf, 1, lbound(InData%MapSrcToAugmt), ubound(InData%MapSrcToAugmt)) + LB(1:1) = lbound(InData%MapSrcToAugmt) + UB(1:1) = ubound(InData%MapSrcToAugmt) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMapType(Buf, InData%MapSrcToAugmt(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Augmented_Ln2_Src + call MeshPack(Buf, InData%Augmented_Ln2_Src) + if (RegCheckErr(Buf, RoutineName)) return + ! Lumped_Points_Src + call MeshPack(Buf, InData%Lumped_Points_Src) + if (RegCheckErr(Buf, RoutineName)) return + ! LoadLn2_A_Mat_Piv + call RegPack(Buf, allocated(InData%LoadLn2_A_Mat_Piv)) + if (allocated(InData%LoadLn2_A_Mat_Piv)) then + call RegPackBounds(Buf, 1, lbound(InData%LoadLn2_A_Mat_Piv), ubound(InData%LoadLn2_A_Mat_Piv)) + call RegPack(Buf, InData%LoadLn2_A_Mat_Piv) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DisplacedPosition + call RegPack(Buf, allocated(InData%DisplacedPosition)) + if (allocated(InData%DisplacedPosition)) then + call RegPackBounds(Buf, 3, lbound(InData%DisplacedPosition), ubound(InData%DisplacedPosition)) + call RegPack(Buf, InData%DisplacedPosition) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LoadLn2_A_Mat + call RegPack(Buf, allocated(InData%LoadLn2_A_Mat)) + if (allocated(InData%LoadLn2_A_Mat)) then + call RegPackBounds(Buf, 2, lbound(InData%LoadLn2_A_Mat), ubound(InData%LoadLn2_A_Mat)) + call RegPack(Buf, InData%LoadLn2_A_Mat) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LoadLn2_F + call RegPack(Buf, allocated(InData%LoadLn2_F)) + if (allocated(InData%LoadLn2_F)) then + call RegPackBounds(Buf, 2, lbound(InData%LoadLn2_F), ubound(InData%LoadLn2_F)) + call RegPack(Buf, InData%LoadLn2_F) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LoadLn2_M + call RegPack(Buf, allocated(InData%LoadLn2_M)) + if (allocated(InData%LoadLn2_M)) then + call RegPackBounds(Buf, 2, lbound(InData%LoadLn2_M), ubound(InData%LoadLn2_M)) + call RegPack(Buf, InData%LoadLn2_M) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! dM + call NWTC_Library_PackMeshMapLinearizationType(Buf, InData%dM) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackMeshMapType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MeshMapType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackMeshMapType' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! MapLoads + if (allocated(OutData%MapLoads)) deallocate(OutData%MapLoads) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MapLoads(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MapLoads.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMapType(Buf, OutData%MapLoads(i1)) ! MapLoads + end do + end if + ! MapMotions + if (allocated(OutData%MapMotions)) deallocate(OutData%MapMotions) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MapMotions(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MapMotions.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMapType(Buf, OutData%MapMotions(i1)) ! MapMotions + end do + end if + ! MapSrcToAugmt + if (allocated(OutData%MapSrcToAugmt)) deallocate(OutData%MapSrcToAugmt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MapSrcToAugmt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MapSrcToAugmt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMapType(Buf, OutData%MapSrcToAugmt(i1)) ! MapSrcToAugmt + end do + end if + ! Augmented_Ln2_Src + call MeshUnpack(Buf, OutData%Augmented_Ln2_Src) ! Augmented_Ln2_Src + ! Lumped_Points_Src + call MeshUnpack(Buf, OutData%Lumped_Points_Src) ! Lumped_Points_Src + ! LoadLn2_A_Mat_Piv + if (allocated(OutData%LoadLn2_A_Mat_Piv)) deallocate(OutData%LoadLn2_A_Mat_Piv) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LoadLn2_A_Mat_Piv(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LoadLn2_A_Mat_Piv.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LoadLn2_A_Mat_Piv) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! DisplacedPosition + if (allocated(OutData%DisplacedPosition)) deallocate(OutData%DisplacedPosition) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DisplacedPosition(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DisplacedPosition.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DisplacedPosition) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LoadLn2_A_Mat + if (allocated(OutData%LoadLn2_A_Mat)) deallocate(OutData%LoadLn2_A_Mat) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LoadLn2_A_Mat(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LoadLn2_A_Mat.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LoadLn2_A_Mat) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LoadLn2_F + if (allocated(OutData%LoadLn2_F)) deallocate(OutData%LoadLn2_F) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LoadLn2_F(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LoadLn2_F.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LoadLn2_F) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LoadLn2_M + if (allocated(OutData%LoadLn2_M)) deallocate(OutData%LoadLn2_M) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LoadLn2_M(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LoadLn2_M.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LoadLn2_M) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! dM + call NWTC_Library_UnpackMeshMapLinearizationType(Buf, OutData%dM) ! dM +end subroutine !********************************************************************************************************************************* !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/nwtc-library/src/ModReg.f90 b/modules/nwtc-library/src/ModReg.f90 new file mode 100644 index 0000000000..7d46e0b600 --- /dev/null +++ b/modules/nwtc-library/src/ModReg.f90 @@ -0,0 +1,1679 @@ + +module ModReg + use NWTC_Base + implicit none + + private + public :: PackBuffer + public :: WritePackBuffer, ReadPackBuffer, InitPackBuffer, RegCheckErr + public :: RegPack, RegPackBounds, RegPackPointer + public :: RegUnpack, RegUnpackBounds, RegUnpackPointer + + type :: PackBuffer + integer(B1Ki), allocatable :: Bytes(:) + integer(IntKi) :: NB + type(c_ptr), allocatable :: Pointers(:) + integer(IntKi) :: NP + integer(IntKi) :: ErrStat = ErrID_Fatal + character(ErrMsgLen) :: ErrMsg = 'PackBuffer not initialized' + end type + + + interface RegPack + module procedure :: Pack_C1, Pack_C1_Rank1, Pack_C1_Rank2, Pack_C1_Rank3, & + Pack_C1_Rank4, Pack_C1_Rank5, Pack_L1, Pack_L1_Rank1, Pack_L1_Rank2, & + Pack_L1_Rank3, Pack_L1_Rank4, Pack_L1_Rank5, Pack_I4, Pack_I4_Rank1, & + Pack_I4_Rank2, Pack_I4_Rank3, Pack_I4_Rank4, Pack_I4_Rank5, Pack_R4, & + Pack_R4_Rank1, Pack_R4_Rank2, Pack_R4_Rank3, Pack_R4_Rank4, & + Pack_R4_Rank5, Pack_R8, Pack_R8_Rank1, Pack_R8_Rank2, Pack_R8_Rank3, & + Pack_R8_Rank4, Pack_R8_Rank5 + end interface + + interface RegUnpack + module procedure :: Unpack_C1, Unpack_C1_Rank1, Unpack_C1_Rank2, & + Unpack_C1_Rank3, Unpack_C1_Rank4, Unpack_C1_Rank5, Unpack_L1, & + Unpack_L1_Rank1, Unpack_L1_Rank2, Unpack_L1_Rank3, Unpack_L1_Rank4, & + Unpack_L1_Rank5, Unpack_I4, Unpack_I4_Rank1, Unpack_I4_Rank2, & + Unpack_I4_Rank3, Unpack_I4_Rank4, Unpack_I4_Rank5, Unpack_R4, & + Unpack_R4_Rank1, Unpack_R4_Rank2, Unpack_R4_Rank3, Unpack_R4_Rank4, & + Unpack_R4_Rank5, Unpack_R8, Unpack_R8_Rank1, Unpack_R8_Rank2, & + Unpack_R8_Rank3, Unpack_R8_Rank4, Unpack_R8_Rank5 + end interface + +contains + + subroutine InitPackBuffer(Buf, ErrStat, ErrMsg) + type(PackBuffer), intent(inout) :: Buf + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = "InitPackBuffer" + integer(IntKi), parameter :: NumPointersInit = 128 + integer(IntKi), parameter :: NumBytesInit = 1024 + integer(IntKi) :: stat + + ErrStat = ErrID_None + ErrMsg = "" + + Buf%ErrStat = ErrID_None + Buf%ErrMsg = "" + Buf%NP = 0 + Buf%NB = 0 + + ! If pointers have not been allocated, allocate with initial size + if (.not. allocated(Buf%Pointers)) then + allocate (Buf%Pointers(NumPointersInit), stat=stat) + if (stat /= 0) then + ErrStat = ErrID_Fatal + write(ErrMsg,*) 'InitPackBuffer: Unable to init pointer index to with size of', NumPointersInit + return + end if + end if + + ! Reset all pointers to null + Buf%Pointers = c_null_ptr + + ! If byte array has not been allocated, allocate with initial size + if (.not. allocated(Buf%Bytes)) then + allocate (Buf%Bytes(NumBytesInit), stat=stat) + if (stat /= 0) then + ErrStat = ErrID_Fatal + write(ErrMsg,*) 'Grow: Unable to init buffer to', NumBytesInit, 'bytes' + return + end if + end if + + end subroutine + + subroutine WritePackBuffer(Buf, Unit, ErrStat, ErrMsg) + type(PackBuffer), intent(inout) :: Buf + integer(IntKi), intent(in) :: Unit + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = "WritePackBuffer" + integer(IntKi) :: iostat + + ErrStat = ErrID_None + ErrMsg = '' + + if (Buf%ErrStat /= ErrID_None) then + call SetErrStat(Buf%ErrStat, Buf%ErrMsg, ErrStat, ErrMsg, 'Buf%WriteFile') + return + end if + + write(Unit, iostat=iostat) Buf%NP + if (iostat /= 0) then + call SetErrStat(ErrID_Fatal, "Error writing number of pointers", ErrStat, ErrMsg, RoutineName) + return + end if + + write(Unit, iostat=iostat) Buf%NB + if (iostat /= 0) then + call SetErrStat(ErrID_Fatal, "Error writing number of bytes", ErrStat, ErrMsg, RoutineName) + return + end if + + write(Unit, iostat=iostat) Buf%Bytes(1:Buf%NB) + if (iostat /= 0) then + call SetErrStat(ErrID_Fatal, "Error writing bytes", ErrStat, ErrMsg, RoutineName) + return + end if + + end subroutine + + subroutine ReadPackBuffer(Buf, Unit, ErrStat, ErrMsg) + type(PackBuffer), intent(inout) :: Buf + integer(IntKi), intent(in) :: Unit + integer(IntKi), intent(out) :: ErrStat + character(ErrMsgLen), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = "ReadPackBuffer" + integer(IntKi) :: iostat + + ErrStat = ErrID_None + ErrMsg = '' + + ! Read number of pointers + read(Unit, iostat=iostat) Buf%NP + if (iostat /= 0) then + call SetErrStat(ErrID_Fatal, "Error reading number of pointers", ErrStat, ErrMsg, RoutineName) + return + end if + + ! If pointers are allocated, deallocate + if (allocated(Buf%Pointers)) deallocate(Buf%Pointers) + + ! Allocate pointer index and initialize pointers to null + allocate(Buf%Pointers(1:Buf%NP), stat=ErrStat) + Buf%Pointers = c_null_ptr + + ! Read number of bytes in buffer + read(Unit, iostat=iostat) Buf%NB + if (iostat /= 0) then + call SetErrStat(ErrID_Fatal, "Error reading number of bytes", ErrStat, ErrMsg, RoutineName) + return + end if + + ! If bytes are allocated, deallocate + if (allocated(Buf%Bytes)) deallocate(Buf%Bytes) + + ! Allocate bytes + allocate(Buf%Bytes(1:Buf%NB), stat=ErrStat) + + ! Read bytes + read(Unit, iostat=iostat) Buf%Bytes + if (iostat /= 0) then + call SetErrStat(ErrID_Fatal, "Error reading bytes", ErrStat, ErrMsg, RoutineName) + return + end if + + ! Clear buffer error + Buf%ErrStat = ErrID_None + Buf%ErrMsg = '' + + ! Reset Number of bytes to be used by unpack routines + Buf%NB = 0 + + end subroutine + + function RegCheckErr(Buf, RoutineName) result(Err) + type(PackBuffer), intent(inout) :: Buf + character(*), intent(in) :: RoutineName + logical :: Err + Err = Buf%ErrStat /= ErrID_None + if (Err) Buf%ErrMsg = trim(RoutineName)//": "//trim(Buf%ErrMsg) + end function + + elemental function LogicalToByte(b) result(i) + logical, intent(in) :: b + integer(B1Ki) :: i + if (b) then + i = 1_B1Ki + else + i = 0_B1Ki + end if + end function + + elemental function ByteToLogical(i) result(b) + integer(B1Ki), intent(in) :: i + logical :: b + if (i == 0) then + b = .false. + else + b = .true. + end if + end function + + subroutine RegPackPointer(Buf, Ptr, Found) + type(PackBuffer), intent(inout) :: Buf + type(c_ptr), intent(in) :: Ptr + logical, intent(out) :: Found + + type(c_ptr), allocatable :: PointersTmp(:) + integer(IntKi) :: NewSize + integer(B4Ki) :: i + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Look for pointer in index, if found, pack pointer index and return + do i = 1, Buf%NP + if (c_associated(Ptr, Buf%Pointers(i))) then + call RegPack(Buf, i) + Found = .true. + return + end if + end do + + ! Pointer was not found in index + Found = .false. + + ! If pointer index is full, grow pointer index + if (Buf%NP == size(Buf%Pointers)) then + NewSize = int(1.5_R4Ki * real(Buf%NP, R4Ki), IntKi) + call move_alloc(Buf%Pointers, PointersTmp) + allocate (Buf%Pointers(NewSize), stat=Buf%ErrStat) + if (Buf%ErrStat /= ErrID_None) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) 'RegPackPointer: Unable to allocate pointer index to', NewSize, 'bytes' + return + end if + Buf%Pointers(1:size(PointersTmp)) = PointersTmp + Buf%Pointers(size(PointersTmp)+1:) = c_null_ptr + end if + + ! Increment number of pointers, add new pointer to index + Buf%NP = Buf%NP + 1 + Buf%Pointers(Buf%NP) = Ptr + + ! Pack pointer index + call RegPack(Buf, Buf%NP) + + end subroutine + + subroutine RegUnpackPointer(Buf, Ptr, Idx) + type(PackBuffer), intent(inout) :: Buf + type(c_ptr), intent(out) :: Ptr + integer(B4Ki), intent(out) :: Idx + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Unpack pointer index + call RegUnpack(Buf, Idx) + + ! Get pointer from index + Ptr = Buf%Pointers(Idx) + + end subroutine + + subroutine RegPackBounds(Buf, R, LB, UB) + type(PackBuffer), intent(inout) :: Buf + integer(B4Ki), intent(in) :: R, LB(:), UB(:) + + ! If buffer has an error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Pack lower and upper bounds + call RegPack(Buf, LB(1:R)) + call RegPack(Buf, UB(1:R)) + if (RegCheckErr(Buf, "RegPackBounds")) return + end subroutine + + subroutine RegUnpackBounds(Buf, R, LB, UB) + type(PackBuffer), intent(inout) :: Buf + integer(B4Ki), intent(in) :: R + integer(B4Ki), intent(out) :: LB(:), UB(:) + + ! If buffer has an error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Unpack lower and upper bounds + call RegUnpack(Buf, LB(1:R)) + call RegUnpack(Buf, UB(1:R)) + if (RegCheckErr(Buf, "RegUnpackBounds")) return + end subroutine + + subroutine GrowBuffer(Buf, N) + type(PackBuffer), intent(inout) :: Buf + integer(B4Ki), intent(in) :: N + + integer(B1Ki), allocatable :: BytesTmp(:) + integer(B4Ki) :: NewSize + integer(IntKi) :: stat + + ! Return if there is a buffer error + if (Buf%ErrStat /= ErrID_None) return + + ! If buffer can hold requested bytes, return + if (size(Buf%Bytes) > Buf%NB + N) return + + ! Calculate new size + NewSize = int(real(Buf%NB + N, R4Ki) * 1.8_R4Ki, IntKi) + + ! Move allocation to temporary array and allocate buffer with new size + call move_alloc(Buf%Bytes, BytesTmp) + allocate (Buf%Bytes(NewSize), stat=stat) + if (stat /= 0) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) 'Grow: Unable to grow buffer to', NewSize, 'bytes' + return + end if + + ! Copy contents of temporary bytes to buffer + Buf%Bytes(1:size(BytesTmp)) = BytesTmp + + end subroutine + + + subroutine Pack_C1(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + character(*), intent(in) :: Data + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = len(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_C1")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_C1(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + character(*), intent(out) :: Data + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = len(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_C1: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_C1_Rank1(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + character(*), intent(in) :: Data(:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = len(Data(1))*size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_C1_Rank1")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_C1_Rank1(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + character(*), intent(out) :: Data(:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = len(Data(1))*size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_C1_Rank1: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_C1_Rank2(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + character(*), intent(in) :: Data(:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = len(Data(1,1))*size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_C1_Rank2")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_C1_Rank2(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + character(*), intent(out) :: Data(:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = len(Data(1,1))*size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_C1_Rank2: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_C1_Rank3(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + character(*), intent(in) :: Data(:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = len(Data(1,1,1))*size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_C1_Rank3")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_C1_Rank3(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + character(*), intent(out) :: Data(:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = len(Data(1,1,1))*size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_C1_Rank3: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_C1_Rank4(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + character(*), intent(in) :: Data(:,:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = len(Data(1,1,1,1))*size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_C1_Rank4")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_C1_Rank4(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + character(*), intent(out) :: Data(:,:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = len(Data(1,1,1,1))*size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_C1_Rank4: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_C1_Rank5(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + character(*), intent(in) :: Data(:,:,:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = len(Data(1,1,1,1,1))*size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_C1_Rank5")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_C1_Rank5(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + character(*), intent(out) :: Data(:,:,:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = len(Data(1,1,1,1,1))*size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_C1_Rank5: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_L1(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + logical, intent(in) :: Data + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 1 + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_L1")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(LogicalToByte(Data), Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_L1(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + logical, intent(out) :: Data + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 1 + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_L1: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = ByteToLogical(Buf%Bytes(Buf%NB+1)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_L1_Rank1(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + logical, intent(in) :: Data(:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_L1_Rank1")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(LogicalToByte(Data), Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_L1_Rank1(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + logical, intent(out) :: Data(:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_L1_Rank1: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(ByteToLogical(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize)), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_L1_Rank2(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + logical, intent(in) :: Data(:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_L1_Rank2")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(LogicalToByte(Data), Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_L1_Rank2(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + logical, intent(out) :: Data(:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_L1_Rank2: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(ByteToLogical(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize)), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_L1_Rank3(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + logical, intent(in) :: Data(:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_L1_Rank3")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(LogicalToByte(Data), Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_L1_Rank3(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + logical, intent(out) :: Data(:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_L1_Rank3: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(ByteToLogical(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize)), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_L1_Rank4(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + logical, intent(in) :: Data(:,:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_L1_Rank4")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(LogicalToByte(Data), Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_L1_Rank4(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + logical, intent(out) :: Data(:,:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_L1_Rank4: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(ByteToLogical(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize)), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_L1_Rank5(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + logical, intent(in) :: Data(:,:,:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_L1_Rank5")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(LogicalToByte(Data), Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_L1_Rank5(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + logical, intent(out) :: Data(:,:,:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_L1_Rank5: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(ByteToLogical(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize)), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_I4(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + integer(B4Ki), intent(in) :: Data + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4 + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_I4")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_I4(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + integer(B4Ki), intent(out) :: Data + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4 + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_I4: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_I4_Rank1(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + integer(B4Ki), intent(in) :: Data(:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4*size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_I4_Rank1")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_I4_Rank1(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + integer(B4Ki), intent(out) :: Data(:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4*size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_I4_Rank1: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_I4_Rank2(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + integer(B4Ki), intent(in) :: Data(:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4*size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_I4_Rank2")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_I4_Rank2(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + integer(B4Ki), intent(out) :: Data(:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4*size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_I4_Rank2: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_I4_Rank3(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + integer(B4Ki), intent(in) :: Data(:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4*size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_I4_Rank3")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_I4_Rank3(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + integer(B4Ki), intent(out) :: Data(:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4*size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_I4_Rank3: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_I4_Rank4(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + integer(B4Ki), intent(in) :: Data(:,:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4*size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_I4_Rank4")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_I4_Rank4(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + integer(B4Ki), intent(out) :: Data(:,:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4*size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_I4_Rank4: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_I4_Rank5(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + integer(B4Ki), intent(in) :: Data(:,:,:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4*size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_I4_Rank5")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_I4_Rank5(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + integer(B4Ki), intent(out) :: Data(:,:,:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4*size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_I4_Rank5: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_R4(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R4Ki), intent(in) :: Data + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4 + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_R4")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_R4(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R4Ki), intent(out) :: Data + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4 + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_R4: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_R4_Rank1(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R4Ki), intent(in) :: Data(:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4*size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_R4_Rank1")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_R4_Rank1(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R4Ki), intent(out) :: Data(:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4*size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_R4_Rank1: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_R4_Rank2(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R4Ki), intent(in) :: Data(:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4*size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_R4_Rank2")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_R4_Rank2(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R4Ki), intent(out) :: Data(:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4*size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_R4_Rank2: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_R4_Rank3(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R4Ki), intent(in) :: Data(:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4*size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_R4_Rank3")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_R4_Rank3(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R4Ki), intent(out) :: Data(:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4*size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_R4_Rank3: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_R4_Rank4(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R4Ki), intent(in) :: Data(:,:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4*size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_R4_Rank4")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_R4_Rank4(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R4Ki), intent(out) :: Data(:,:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4*size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_R4_Rank4: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_R4_Rank5(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R4Ki), intent(in) :: Data(:,:,:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4*size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_R4_Rank5")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_R4_Rank5(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R4Ki), intent(out) :: Data(:,:,:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 4*size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_R4_Rank5: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_R8(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R8Ki), intent(in) :: Data + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 8 + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_R8")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_R8(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R8Ki), intent(out) :: Data + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 8 + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_R8: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_R8_Rank1(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R8Ki), intent(in) :: Data(:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 8*size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_R8_Rank1")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_R8_Rank1(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R8Ki), intent(out) :: Data(:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 8*size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_R8_Rank1: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_R8_Rank2(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R8Ki), intent(in) :: Data(:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 8*size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_R8_Rank2")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_R8_Rank2(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R8Ki), intent(out) :: Data(:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 8*size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_R8_Rank2: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_R8_Rank3(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R8Ki), intent(in) :: Data(:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 8*size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_R8_Rank3")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_R8_Rank3(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R8Ki), intent(out) :: Data(:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 8*size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_R8_Rank3: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_R8_Rank4(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R8Ki), intent(in) :: Data(:,:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 8*size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_R8_Rank4")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_R8_Rank4(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R8Ki), intent(out) :: Data(:,:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 8*size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_R8_Rank4: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Pack_R8_Rank5(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R8Ki), intent(in) :: Data(:,:,:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 8*size(Data) + + ! Grow buffer to accommodate Data + call GrowBuffer(Buf, DataSize) + if (RegCheckErr(Buf, "Pack_R8_Rank5")) return + + ! Transfer data to buffer + Buf%Bytes(Buf%NB+1:Buf%NB+DataSize) = transfer(Data, Buf%Bytes) + Buf%NB = Buf%NB + DataSize + + end subroutine + + subroutine Unpack_R8_Rank5(Buf, Data) + type(PackBuffer), intent(inout) :: Buf + real(R8Ki), intent(out) :: Data(:,:,:,:,:) + integer(IntKi) :: DataSize + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return + + ! Get size of data in bytes + DataSize = 8*size(Data) + + ! Check that buffer has sufficient bytes remaining + if (size(Buf%Bytes) < Buf%NB + DataSize) then + Buf%ErrStat = ErrID_Fatal + write(Buf%ErrMsg,*) "Unpack_R8_Rank5: buffer too small, requested", DataSize, "bytes" + return + end if + + ! Transfer data from buffer + Data = reshape(transfer(Buf%Bytes(Buf%NB+1:Buf%NB+DataSize), Data), shape(Data)) + Buf%NB = Buf%NB + DataSize + + end subroutine +end module \ No newline at end of file diff --git a/modules/nwtc-library/src/NWTC_Base.f90 b/modules/nwtc-library/src/NWTC_Base.f90 index 2ccec45fb1..4228fe4ee2 100644 --- a/modules/nwtc-library/src/NWTC_Base.f90 +++ b/modules/nwtc-library/src/NWTC_Base.f90 @@ -81,5 +81,30 @@ MODULE NWTC_Base END TYPE DLL_Type +contains + + !======================================================================= + !> This routine sets the error status and error message for a routine + !! that may set non-AbortErrLev errors. It concatenates error messages + !! and has the ability to provide a sort of traceback message of called + !! routines (if this is called consistently). + !! Modules in the FAST framework are recommended to use it. + subroutine SetErrStat (ErrStatLcl, ErrMessLcl, ErrStat, ErrMess, RoutineName) + + INTEGER(IntKi), INTENT(IN ) :: ErrStatLcl ! Error status of the operation + CHARACTER(*), INTENT(IN ) :: ErrMessLcl ! Error message if ErrStat /= ErrID_None + + INTEGER(IntKi), INTENT(INOUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT(INOUT) :: ErrMess ! Error message if ErrStat /= ErrID_None + + CHARACTER(*), INTENT(IN ) :: RoutineName ! Name of the routine error occurred in + + IF ( ErrStatLcl /= ErrID_None ) THEN + IF (ErrStat /= ErrID_None) ErrMess = TRIM(ErrMess)//new_line('a') + ErrMess = TRIM(ErrMess)//TRIM(RoutineName)//':'//TRIM(ErrMessLcl) + ErrStat = MAX(ErrStat,ErrStatLcl) + END IF + + end subroutine END MODULE NWTC_Base diff --git a/modules/nwtc-library/src/NWTC_IO.f90 b/modules/nwtc-library/src/NWTC_IO.f90 index a1d2570ca3..b7e5707fea 100644 --- a/modules/nwtc-library/src/NWTC_IO.f90 +++ b/modules/nwtc-library/src/NWTC_IO.f90 @@ -1725,105 +1725,65 @@ END SUBROUTINE DispCopyrightLicense !======================================================================= !> This routine packs the DLL_Type (nwtc_base::dll_type) data into an integer buffer. !! It is required for the FAST Registry. It is the inverse of DLLTypeUnPack (nwtc_io::dlltypeunpack). - SUBROUTINE DLLTypePack( InData, ReKiBuf, DbKiBuf, IntKiBuf, ErrStat, ErrMsg, SizeOnly ) - - - TYPE(DLL_Type), INTENT(IN ) :: InData !< DLL data to pack (store in arrays of type ReKi, DbKi, and/or IntKi) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) !< buffer with real (ReKi) data from InData structure - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) !< buffer with double (DbKi) data from InData structure - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) !< buffer with integer (IntKi) data from InData structure - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< error status - CHARACTER(*), INTENT( OUT) :: ErrMsg !< error message - LOGICAL, OPTIONAL, INTENT(IN ) :: SizeOnly !< flag to determine if we're just looking for the size of the buffers instead of the packed data + SUBROUTINE DLLTypePack(Buf, InData) + type(PackBuffer), intent(inout) :: Buf + TYPE(DLL_Type), intent(in) :: InData !< DLL data to pack - ! Local variable - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: i,buf_start - - ErrStat = ErrID_None - ErrMsg = "" + INTEGER(IntKi) :: i - ! get size of buffer: - Int_BufSz = LEN(InData%FileName) + LEN(InData%ProcName(1))*NWTC_MAX_DLL_PROC + 1 - - ALLOCATE( IntKiBuf(Int_BufSz), STAT=ErrStat ) - IF (ErrStat /= 0 ) THEN - ErrStat = ErrID_Fatal - ErrMsg = ' DLLTypePack: Error allocating IntKiBuf.' - RETURN - END IF - - IF ( PRESENT(SizeOnly) ) THEN - IF ( SizeOnly ) RETURN - ENDIF - - !.............. - ! Fill buffer - !.............. - - ! has the DLL procedure been loaded? - IF ( C_ASSOCIATED(InData%ProcAddr(1))) THEN - IntKiBuf(1) = 1 - ELSE - IntKiBuf(1) = 0 - END IF + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return - ! Put an ascii representation of the strings in the integer array - CALL Str2IntAry( InData%FileName, IntKiBuf(2:), ErrStat, ErrMsg ) - buf_start=LEN(InData%FileName)+2 - DO i=1,NWTC_MAX_DLL_PROC - CALL Str2IntAry( InData%ProcName(i), IntKiBuf(buf_start:), ErrStat, ErrMsg ) - buf_start = buf_start + LEN(InData%ProcName(i)) - END DO + ! has the DLL procedure been loaded? + call RegPack(Buf, c_associated(InData%ProcAddr(1))) + ! Pack strings + call RegPack(Buf, InData%FileName) + do i = 1, NWTC_MAX_DLL_PROC + call RegPack(Buf, InData%ProcName(i)) + end do + + ! If buffer error, return + if (RegCheckErr(Buf, 'DLLTypeUnPack')) return END SUBROUTINE DLLTypePack !======================================================================= !> This routine unpacks the DLL_Type data from an integer buffer. !! It is required for the FAST Registry. It is the inverse of DLLTypePack (nwtc_io::dlltypepack). - SUBROUTINE DLLTypeUnPack( OutData, ReKiBuf, DbKiBuf, IntKiBuf, ErrStat, ErrMsg ) - - - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) !< buffer with real (ReKi) data to place in the OutData structure - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) !< buffer with real (DbKi) data to place in the OutData structure - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) !< buffer with integer (IntKi) data to place in the OutData structure - TYPE(DLL_Type), INTENT( OUT) :: OutData !< the reconstituted OutData structure, created from 3 buffers - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< error status/level - CHARACTER(*), INTENT( OUT) :: ErrMsg !< message corresponding to ErrStat - - ! Local variable - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: i, Int_BufEnd + subroutine DLLTypeUnPack(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(DLL_Type), intent(out) :: OutData !< Reconstituted OutData structure + + logical :: WasAssociated + integer(IntKi) :: i + + ! If buffer error, return + if (Buf%ErrStat /= ErrID_None) return - ErrStat = ErrID_None - ErrMsg = "" + ! Get flag indicating if dll was associated + call RegUnpack(Buf, WasAssociated) - IF (.NOT. ALLOCATED(IntKiBuf) ) THEN - ErrStat = ErrID_Fatal - ErrMsg = ' DLLTypeUnPack: invalid buffer.' - END IF - - ! Get an ascii representation of the strings from the integer array - Int_BufSz = LEN(OutData%FileName) + 1 - CALL IntAry2Str( IntKiBuf(2:(Int_BufSz)), OutData%FileName, ErrStat, ErrMsg ) - IF (ErrStat >= AbortErrLev) RETURN - Int_BufSz = Int_BufSz + 1 - do i=1,NWTC_MAX_DLL_PROC - Int_BufEnd=Int_BufSz+LEN(OutData%ProcName(i))-1 - CALL IntAry2Str( IntKiBuf(Int_BufSz:Int_BufEnd), OutData%ProcName(i), ErrStat, ErrMsg ) - IF (ErrStat >= AbortErrLev) RETURN - Int_BufSz = Int_BufSz+LEN(OutData%ProcName(i)) + ! Unpack strings + call RegUnpack(Buf, OutData%FileName) + do i = 1, NWTC_MAX_DLL_PROC + call RegUnpack(Buf, OutData%ProcName(i)) end do + + ! If buffer error, return + if (RegCheckErr(Buf, 'DLLTypeUnPack')) return - - IF ( IntKiBuf(1) == 1 .AND. LEN_TRIM(OutData%FileName) > 0 .AND. LEN_TRIM(OutData%ProcName(1)) > 0 ) THEN - CALL LoadDynamicLib( OutData, ErrStat, ErrMsg ) + ! If dll was loaded, and data in filename and procname, load dll + IF (WasAssociated .AND. LEN_TRIM(OutData%FileName) > 0 .AND. LEN_TRIM(OutData%ProcName(1)) > 0) THEN + CALL LoadDynamicLib(OutData, Buf%ErrStat, Buf%ErrMsg) else ! Nullifying OutData%FileAddr = INT(0,C_INTPTR_T) OutData%FileAddrX = C_NULL_PTR OutData%ProcAddr = C_NULL_FUNPTR END IF + + ! If buffer error, return + if (RegCheckErr(Buf, 'DLLTypeUnPack')) return END SUBROUTINE DLLTypeUnPack !======================================================================= diff --git a/modules/nwtc-library/src/NWTC_Library.f90 b/modules/nwtc-library/src/NWTC_Library.f90 index 77d1388f8c..9772468d1b 100644 --- a/modules/nwtc-library/src/NWTC_Library.f90 +++ b/modules/nwtc-library/src/NWTC_Library.f90 @@ -74,6 +74,7 @@ MODULE NWTC_Library USE NWTC_Library_Types USE NWTC_Num ! technically we don't need to specify this if we have ModMesh (because ModMesh USEs NWTC_Num) USE ModMesh + USE ModReg #ifndef NO_MESHMAPPING ! Note that ModMesh_Mapping also includes LAPACK routines diff --git a/modules/nwtc-library/src/NWTC_Library_Types.f90 b/modules/nwtc-library/src/NWTC_Library_Types.f90 index ebe2e74a6c..5f2be5a87e 100644 --- a/modules/nwtc-library/src/NWTC_Library_Types.f90 +++ b/modules/nwtc-library/src/NWTC_Library_Types.f90 @@ -24,13 +24,15 @@ ! limitations under the License. ! ! -! bjj: modifications made +! W A R N I N G : This file was automatically generated from the FAST registry. Changes made to this file may be lost. +! !********************************************************************************************************************************* !> This module contains the user-defined types needed in NWTC_Library. It also contains copy, destroy, pack, and !! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. MODULE NWTC_Library_Types !--------------------------------------------------------------------------------------------------------------------------------- USE SysSubs +USE ModReg IMPLICIT NONE ! ========= ProgDesc ======= TYPE, PUBLIC :: ProgDesc @@ -84,38 +86,6 @@ MODULE NWTC_Library_Types END TYPE NWTC_RandomNumber_ParameterType ! ======================= CONTAINS - -!======================================================================= -!> This routine sets the error status and error message for a routine -!! that may set non-AbortErrLev errors. It concatenates error messages -!! and has the ability to provide a sort of traceback message of called -!! routines (if this is called consistently). -!! Modules in the FAST framework are recommend to use it. - SUBROUTINE SetErrStat ( ErrStatLcl, ErrMessLcl, ErrStat, ErrMess, RoutineName ) - - ! This routine is placed in this file because it is called in code generated by the FAST Registry (and I don't feel like putting it in the Sys files) ... be careful not to delete this routine! - - - INTEGER(IntKi), INTENT(IN ) :: ErrStatLcl ! Error status of the operation - CHARACTER(*), INTENT(IN ) :: ErrMessLcl ! Error message if ErrStat /= ErrID_None - - INTEGER(IntKi), INTENT(INOUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT(INOUT) :: ErrMess ! Error message if ErrStat /= ErrID_None - - CHARACTER(*), INTENT(IN ) :: RoutineName ! Name of the routine error occurred in - - - IF ( ErrStatLcl /= ErrID_None ) THEN - - IF (ErrStat /= ErrID_None) ErrMess = TRIM(ErrMess)//NewLine - ErrMess = TRIM(ErrMess)//TRIM(RoutineName)//':'//TRIM(ErrMessLcl) - ErrStat = MAX(ErrStat,ErrStatLcl) - - END IF - - END SUBROUTINE SetErrStat -!======================================================================= - SUBROUTINE NWTC_Library_CopyProgDesc( SrcProgDescData, DstProgDescData, CtrlCode, ErrStat, ErrMsg ) TYPE(ProgDesc), INTENT(IN) :: SrcProgDescData TYPE(ProgDesc), INTENT(INOUT) :: DstProgDescData @@ -124,8 +94,6 @@ SUBROUTINE NWTC_Library_CopyProgDesc( SrcProgDescData, DstProgDescData, CtrlCode CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_CopyProgDesc' @@ -137,14 +105,12 @@ SUBROUTINE NWTC_Library_CopyProgDesc( SrcProgDescData, DstProgDescData, CtrlCode DstProgDescData%Date = SrcProgDescData%Date END SUBROUTINE NWTC_Library_CopyProgDesc - SUBROUTINE NWTC_Library_DestroyProgDesc( ProgDescData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE NWTC_Library_DestroyProgDesc( ProgDescData, ErrStat, ErrMsg ) TYPE(ProgDesc), INTENT(INOUT) :: ProgDescData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_DestroyProgDesc' @@ -152,135 +118,40 @@ SUBROUTINE NWTC_Library_DestroyProgDesc( ProgDescData, ErrStat, ErrMsg, DEALLOCA ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE NWTC_Library_DestroyProgDesc - SUBROUTINE NWTC_Library_PackProgDesc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ProgDesc), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_PackProgDesc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%Name) ! Name - Int_BufSz = Int_BufSz + 1*LEN(InData%Ver) ! Ver - Int_BufSz = Int_BufSz + 1*LEN(InData%Date) ! Date - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%Name) - IntKiBuf(Int_Xferred) = ICHAR(InData%Name(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Ver) - IntKiBuf(Int_Xferred) = ICHAR(InData%Ver(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Date) - IntKiBuf(Int_Xferred) = ICHAR(InData%Date(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE NWTC_Library_PackProgDesc - - SUBROUTINE NWTC_Library_UnPackProgDesc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ProgDesc), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_UnPackProgDesc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%Name) - OutData%Name(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Ver) - OutData%Ver(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Date) - OutData%Date(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE NWTC_Library_UnPackProgDesc +subroutine NWTC_Library_PackProgDesc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ProgDesc), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackProgDesc' + if (Buf%ErrStat >= AbortErrLev) return + ! Name + call RegPack(Buf, InData%Name) + if (RegCheckErr(Buf, RoutineName)) return + ! Ver + call RegPack(Buf, InData%Ver) + if (RegCheckErr(Buf, RoutineName)) return + ! Date + call RegPack(Buf, InData%Date) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackProgDesc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ProgDesc), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackProgDesc' + if (Buf%ErrStat /= ErrID_None) return + ! Name + call RegUnpack(Buf, OutData%Name) + if (RegCheckErr(Buf, RoutineName)) return + ! Ver + call RegUnpack(Buf, OutData%Ver) + if (RegCheckErr(Buf, RoutineName)) return + ! Date + call RegUnpack(Buf, OutData%Date) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE NWTC_Library_CopyFASTdataType( SrcFASTdataTypeData, DstFASTdataTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(FASTdataType), INTENT(IN) :: SrcFASTdataTypeData TYPE(FASTdataType), INTENT(INOUT) :: DstFASTdataTypeData @@ -342,14 +213,12 @@ SUBROUTINE NWTC_Library_CopyFASTdataType( SrcFASTdataTypeData, DstFASTdataTypeDa ENDIF END SUBROUTINE NWTC_Library_CopyFASTdataType - SUBROUTINE NWTC_Library_DestroyFASTdataType( FASTdataTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE NWTC_Library_DestroyFASTdataType( FASTdataTypeData, ErrStat, ErrMsg ) TYPE(FASTdataType), INTENT(INOUT) :: FASTdataTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_DestroyFASTdataType' @@ -357,12 +226,6 @@ SUBROUTINE NWTC_Library_DestroyFASTdataType( FASTdataTypeData, ErrStat, ErrMsg, ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(FASTdataTypeData%ChanNames)) THEN DEALLOCATE(FASTdataTypeData%ChanNames) ENDIF @@ -374,265 +237,119 @@ SUBROUTINE NWTC_Library_DestroyFASTdataType( FASTdataTypeData, ErrStat, ErrMsg, ENDIF END SUBROUTINE NWTC_Library_DestroyFASTdataType - SUBROUTINE NWTC_Library_PackFASTdataType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FASTdataType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_PackFASTdataType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%File) ! File - Int_BufSz = Int_BufSz + 1*LEN(InData%Descr) ! Descr - Int_BufSz = Int_BufSz + 1 ! NumChans - Int_BufSz = Int_BufSz + 1 ! NumRecs - Db_BufSz = Db_BufSz + 1 ! TimeStep - Int_BufSz = Int_BufSz + 1 ! ChanNames allocated yes/no - IF ( ALLOCATED(InData%ChanNames) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ChanNames upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ChanNames)*LEN(InData%ChanNames) ! ChanNames - END IF - Int_BufSz = Int_BufSz + 1 ! ChanUnits allocated yes/no - IF ( ALLOCATED(InData%ChanUnits) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ChanUnits upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ChanUnits)*LEN(InData%ChanUnits) ! ChanUnits - END IF - Int_BufSz = Int_BufSz + 1 ! Data allocated yes/no - IF ( ALLOCATED(InData%Data) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Data upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Data) ! Data - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%File) - IntKiBuf(Int_Xferred) = ICHAR(InData%File(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Descr) - IntKiBuf(Int_Xferred) = ICHAR(InData%Descr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%NumChans - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumRecs - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TimeStep - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%ChanNames) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ChanNames,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChanNames,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ChanNames,1), UBOUND(InData%ChanNames,1) - DO I = 1, LEN(InData%ChanNames) - IntKiBuf(Int_Xferred) = ICHAR(InData%ChanNames(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ChanUnits) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ChanUnits,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChanUnits,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ChanUnits,1), UBOUND(InData%ChanUnits,1) - DO I = 1, LEN(InData%ChanUnits) - IntKiBuf(Int_Xferred) = ICHAR(InData%ChanUnits(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Data) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Data,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Data,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Data,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Data,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Data,2), UBOUND(InData%Data,2) - DO i1 = LBOUND(InData%Data,1), UBOUND(InData%Data,1) - ReKiBuf(Re_Xferred) = InData%Data(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE NWTC_Library_PackFASTdataType - - SUBROUTINE NWTC_Library_UnPackFASTdataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FASTdataType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_UnPackFASTdataType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%File) - OutData%File(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Descr) - OutData%Descr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%NumChans = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumRecs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TimeStep = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ChanNames not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ChanNames)) DEALLOCATE(OutData%ChanNames) - ALLOCATE(OutData%ChanNames(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChanNames.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ChanNames,1), UBOUND(OutData%ChanNames,1) - DO I = 1, LEN(OutData%ChanNames) - OutData%ChanNames(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ChanUnits not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ChanUnits)) DEALLOCATE(OutData%ChanUnits) - ALLOCATE(OutData%ChanUnits(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChanUnits.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ChanUnits,1), UBOUND(OutData%ChanUnits,1) - DO I = 1, LEN(OutData%ChanUnits) - OutData%ChanUnits(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Data not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Data)) DEALLOCATE(OutData%Data) - ALLOCATE(OutData%Data(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Data.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Data,2), UBOUND(OutData%Data,2) - DO i1 = LBOUND(OutData%Data,1), UBOUND(OutData%Data,1) - OutData%Data(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE NWTC_Library_UnPackFASTdataType +subroutine NWTC_Library_PackFASTdataType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FASTdataType), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackFASTdataType' + if (Buf%ErrStat >= AbortErrLev) return + ! File + call RegPack(Buf, InData%File) + if (RegCheckErr(Buf, RoutineName)) return + ! Descr + call RegPack(Buf, InData%Descr) + if (RegCheckErr(Buf, RoutineName)) return + ! NumChans + call RegPack(Buf, InData%NumChans) + if (RegCheckErr(Buf, RoutineName)) return + ! NumRecs + call RegPack(Buf, InData%NumRecs) + if (RegCheckErr(Buf, RoutineName)) return + ! TimeStep + call RegPack(Buf, InData%TimeStep) + if (RegCheckErr(Buf, RoutineName)) return + ! ChanNames + call RegPack(Buf, allocated(InData%ChanNames)) + if (allocated(InData%ChanNames)) then + call RegPackBounds(Buf, 1, lbound(InData%ChanNames), ubound(InData%ChanNames)) + call RegPack(Buf, InData%ChanNames) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ChanUnits + call RegPack(Buf, allocated(InData%ChanUnits)) + if (allocated(InData%ChanUnits)) then + call RegPackBounds(Buf, 1, lbound(InData%ChanUnits), ubound(InData%ChanUnits)) + call RegPack(Buf, InData%ChanUnits) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Data + call RegPack(Buf, allocated(InData%Data)) + if (allocated(InData%Data)) then + call RegPackBounds(Buf, 2, lbound(InData%Data), ubound(InData%Data)) + call RegPack(Buf, InData%Data) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackFASTdataType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FASTdataType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackFASTdataType' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! File + call RegUnpack(Buf, OutData%File) + if (RegCheckErr(Buf, RoutineName)) return + ! Descr + call RegUnpack(Buf, OutData%Descr) + if (RegCheckErr(Buf, RoutineName)) return + ! NumChans + call RegUnpack(Buf, OutData%NumChans) + if (RegCheckErr(Buf, RoutineName)) return + ! NumRecs + call RegUnpack(Buf, OutData%NumRecs) + if (RegCheckErr(Buf, RoutineName)) return + ! TimeStep + call RegUnpack(Buf, OutData%TimeStep) + if (RegCheckErr(Buf, RoutineName)) return + ! ChanNames + if (allocated(OutData%ChanNames)) deallocate(OutData%ChanNames) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ChanNames(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChanNames.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ChanNames) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ChanUnits + if (allocated(OutData%ChanUnits)) deallocate(OutData%ChanUnits) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ChanUnits(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChanUnits.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ChanUnits) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Data + if (allocated(OutData%Data)) deallocate(OutData%Data) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Data(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Data.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Data) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE NWTC_Library_CopyOutParmType( SrcOutParmTypeData, DstOutParmTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(OutParmType), INTENT(IN) :: SrcOutParmTypeData TYPE(OutParmType), INTENT(INOUT) :: DstOutParmTypeData @@ -653,14 +370,12 @@ SUBROUTINE NWTC_Library_CopyOutParmType( SrcOutParmTypeData, DstOutParmTypeData, DstOutParmTypeData%SignM = SrcOutParmTypeData%SignM END SUBROUTINE NWTC_Library_CopyOutParmType - SUBROUTINE NWTC_Library_DestroyOutParmType( OutParmTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE NWTC_Library_DestroyOutParmType( OutParmTypeData, ErrStat, ErrMsg ) TYPE(OutParmType), INTENT(INOUT) :: OutParmTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_DestroyOutParmType' @@ -668,134 +383,46 @@ SUBROUTINE NWTC_Library_DestroyOutParmType( OutParmTypeData, ErrStat, ErrMsg, DE ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE NWTC_Library_DestroyOutParmType - SUBROUTINE NWTC_Library_PackOutParmType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(OutParmType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_PackOutParmType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! Indx - Int_BufSz = Int_BufSz + 1*LEN(InData%Name) ! Name - Int_BufSz = Int_BufSz + 1*LEN(InData%Units) ! Units - Int_BufSz = Int_BufSz + 1 ! SignM - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%Indx - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%Name) - IntKiBuf(Int_Xferred) = ICHAR(InData%Name(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Units) - IntKiBuf(Int_Xferred) = ICHAR(InData%Units(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%SignM - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE NWTC_Library_PackOutParmType - - SUBROUTINE NWTC_Library_UnPackOutParmType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(OutParmType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_UnPackOutParmType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%Indx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%Name) - OutData%Name(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Units) - OutData%Units(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%SignM = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE NWTC_Library_UnPackOutParmType +subroutine NWTC_Library_PackOutParmType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(OutParmType), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackOutParmType' + if (Buf%ErrStat >= AbortErrLev) return + ! Indx + call RegPack(Buf, InData%Indx) + if (RegCheckErr(Buf, RoutineName)) return + ! Name + call RegPack(Buf, InData%Name) + if (RegCheckErr(Buf, RoutineName)) return + ! Units + call RegPack(Buf, InData%Units) + if (RegCheckErr(Buf, RoutineName)) return + ! SignM + call RegPack(Buf, InData%SignM) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackOutParmType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(OutParmType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackOutParmType' + if (Buf%ErrStat /= ErrID_None) return + ! Indx + call RegUnpack(Buf, OutData%Indx) + if (RegCheckErr(Buf, RoutineName)) return + ! Name + call RegUnpack(Buf, OutData%Name) + if (RegCheckErr(Buf, RoutineName)) return + ! Units + call RegUnpack(Buf, OutData%Units) + if (RegCheckErr(Buf, RoutineName)) return + ! SignM + call RegUnpack(Buf, OutData%SignM) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE NWTC_Library_CopyFileInfoType( SrcFileInfoTypeData, DstFileInfoTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(FileInfoType), INTENT(IN) :: SrcFileInfoTypeData TYPE(FileInfoType), INTENT(INOUT) :: DstFileInfoTypeData @@ -863,14 +490,12 @@ SUBROUTINE NWTC_Library_CopyFileInfoType( SrcFileInfoTypeData, DstFileInfoTypeDa ENDIF END SUBROUTINE NWTC_Library_CopyFileInfoType - SUBROUTINE NWTC_Library_DestroyFileInfoType( FileInfoTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE NWTC_Library_DestroyFileInfoType( FileInfoTypeData, ErrStat, ErrMsg ) TYPE(FileInfoType), INTENT(INOUT) :: FileInfoTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_DestroyFileInfoType' @@ -878,12 +503,6 @@ SUBROUTINE NWTC_Library_DestroyFileInfoType( FileInfoTypeData, ErrStat, ErrMsg, ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(FileInfoTypeData%FileLine)) THEN DEALLOCATE(FileInfoTypeData%FileLine) ENDIF @@ -898,269 +517,123 @@ SUBROUTINE NWTC_Library_DestroyFileInfoType( FileInfoTypeData, ErrStat, ErrMsg, ENDIF END SUBROUTINE NWTC_Library_DestroyFileInfoType - SUBROUTINE NWTC_Library_PackFileInfoType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FileInfoType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_PackFileInfoType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! NumLines - Int_BufSz = Int_BufSz + 1 ! NumFiles - Int_BufSz = Int_BufSz + 1 ! FileLine allocated yes/no - IF ( ALLOCATED(InData%FileLine) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FileLine upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%FileLine) ! FileLine - END IF - Int_BufSz = Int_BufSz + 1 ! FileIndx allocated yes/no - IF ( ALLOCATED(InData%FileIndx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FileIndx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%FileIndx) ! FileIndx - END IF - Int_BufSz = Int_BufSz + 1 ! FileList allocated yes/no - IF ( ALLOCATED(InData%FileList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FileList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%FileList)*LEN(InData%FileList) ! FileList - END IF - Int_BufSz = Int_BufSz + 1 ! Lines allocated yes/no - IF ( ALLOCATED(InData%Lines) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Lines upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Lines)*LEN(InData%Lines) ! Lines - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%NumLines - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumFiles - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%FileLine) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FileLine,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FileLine,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FileLine,1), UBOUND(InData%FileLine,1) - IntKiBuf(Int_Xferred) = InData%FileLine(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FileIndx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FileIndx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FileIndx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FileIndx,1), UBOUND(InData%FileIndx,1) - IntKiBuf(Int_Xferred) = InData%FileIndx(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FileList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FileList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FileList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FileList,1), UBOUND(InData%FileList,1) - DO I = 1, LEN(InData%FileList) - IntKiBuf(Int_Xferred) = ICHAR(InData%FileList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Lines) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Lines,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Lines,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Lines,1), UBOUND(InData%Lines,1) - DO I = 1, LEN(InData%Lines) - IntKiBuf(Int_Xferred) = ICHAR(InData%Lines(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - END SUBROUTINE NWTC_Library_PackFileInfoType - - SUBROUTINE NWTC_Library_UnPackFileInfoType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FileInfoType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_UnPackFileInfoType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%NumLines = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumFiles = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FileLine not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FileLine)) DEALLOCATE(OutData%FileLine) - ALLOCATE(OutData%FileLine(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FileLine.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FileLine,1), UBOUND(OutData%FileLine,1) - OutData%FileLine(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FileIndx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FileIndx)) DEALLOCATE(OutData%FileIndx) - ALLOCATE(OutData%FileIndx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FileIndx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FileIndx,1), UBOUND(OutData%FileIndx,1) - OutData%FileIndx(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FileList not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FileList)) DEALLOCATE(OutData%FileList) - ALLOCATE(OutData%FileList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FileList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FileList,1), UBOUND(OutData%FileList,1) - DO I = 1, LEN(OutData%FileList) - OutData%FileList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Lines not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Lines)) DEALLOCATE(OutData%Lines) - ALLOCATE(OutData%Lines(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Lines.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Lines,1), UBOUND(OutData%Lines,1) - DO I = 1, LEN(OutData%Lines) - OutData%Lines(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - END SUBROUTINE NWTC_Library_UnPackFileInfoType +subroutine NWTC_Library_PackFileInfoType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FileInfoType), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackFileInfoType' + if (Buf%ErrStat >= AbortErrLev) return + ! NumLines + call RegPack(Buf, InData%NumLines) + if (RegCheckErr(Buf, RoutineName)) return + ! NumFiles + call RegPack(Buf, InData%NumFiles) + if (RegCheckErr(Buf, RoutineName)) return + ! FileLine + call RegPack(Buf, allocated(InData%FileLine)) + if (allocated(InData%FileLine)) then + call RegPackBounds(Buf, 1, lbound(InData%FileLine), ubound(InData%FileLine)) + call RegPack(Buf, InData%FileLine) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FileIndx + call RegPack(Buf, allocated(InData%FileIndx)) + if (allocated(InData%FileIndx)) then + call RegPackBounds(Buf, 1, lbound(InData%FileIndx), ubound(InData%FileIndx)) + call RegPack(Buf, InData%FileIndx) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FileList + call RegPack(Buf, allocated(InData%FileList)) + if (allocated(InData%FileList)) then + call RegPackBounds(Buf, 1, lbound(InData%FileList), ubound(InData%FileList)) + call RegPack(Buf, InData%FileList) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Lines + call RegPack(Buf, allocated(InData%Lines)) + if (allocated(InData%Lines)) then + call RegPackBounds(Buf, 1, lbound(InData%Lines), ubound(InData%Lines)) + call RegPack(Buf, InData%Lines) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackFileInfoType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FileInfoType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackFileInfoType' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! NumLines + call RegUnpack(Buf, OutData%NumLines) + if (RegCheckErr(Buf, RoutineName)) return + ! NumFiles + call RegUnpack(Buf, OutData%NumFiles) + if (RegCheckErr(Buf, RoutineName)) return + ! FileLine + if (allocated(OutData%FileLine)) deallocate(OutData%FileLine) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FileLine(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FileLine.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FileLine) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! FileIndx + if (allocated(OutData%FileIndx)) deallocate(OutData%FileIndx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FileIndx(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FileIndx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FileIndx) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! FileList + if (allocated(OutData%FileList)) deallocate(OutData%FileList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FileList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FileList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FileList) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Lines + if (allocated(OutData%Lines)) deallocate(OutData%Lines) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Lines(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Lines.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Lines) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE NWTC_Library_CopyQuaternion( SrcQuaternionData, DstQuaternionData, CtrlCode, ErrStat, ErrMsg ) TYPE(Quaternion), INTENT(IN) :: SrcQuaternionData TYPE(Quaternion), INTENT(INOUT) :: DstQuaternionData @@ -1180,14 +653,12 @@ SUBROUTINE NWTC_Library_CopyQuaternion( SrcQuaternionData, DstQuaternionData, Ct DstQuaternionData%v = SrcQuaternionData%v END SUBROUTINE NWTC_Library_CopyQuaternion - SUBROUTINE NWTC_Library_DestroyQuaternion( QuaternionData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE NWTC_Library_DestroyQuaternion( QuaternionData, ErrStat, ErrMsg ) TYPE(Quaternion), INTENT(INOUT) :: QuaternionData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_DestroyQuaternion' @@ -1195,123 +666,34 @@ SUBROUTINE NWTC_Library_DestroyQuaternion( QuaternionData, ErrStat, ErrMsg, DEAL ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - END SUBROUTINE NWTC_Library_DestroyQuaternion - SUBROUTINE NWTC_Library_PackQuaternion( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Quaternion), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_PackQuaternion' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! q0 - Re_BufSz = Re_BufSz + SIZE(InData%v) ! v - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%q0 - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%v,1), UBOUND(InData%v,1) - ReKiBuf(Re_Xferred) = InData%v(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE NWTC_Library_PackQuaternion - - SUBROUTINE NWTC_Library_UnPackQuaternion( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Quaternion), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_UnPackQuaternion' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%q0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%v,1) - i1_u = UBOUND(OutData%v,1) - DO i1 = LBOUND(OutData%v,1), UBOUND(OutData%v,1) - OutData%v(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE NWTC_Library_UnPackQuaternion +subroutine NWTC_Library_PackQuaternion(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Quaternion), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackQuaternion' + if (Buf%ErrStat >= AbortErrLev) return + ! q0 + call RegPack(Buf, InData%q0) + if (RegCheckErr(Buf, RoutineName)) return + ! v + call RegPack(Buf, InData%v) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackQuaternion(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Quaternion), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackQuaternion' + if (Buf%ErrStat /= ErrID_None) return + ! q0 + call RegUnpack(Buf, OutData%q0) + if (RegCheckErr(Buf, RoutineName)) return + ! v + call RegUnpack(Buf, OutData%v) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE NWTC_Library_CopyNWTC_RandomNumber_ParameterType( SrcNWTC_RandomNumber_ParameterTypeData, DstNWTC_RandomNumber_ParameterTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(NWTC_RandomNumber_ParameterType), INTENT(IN) :: SrcNWTC_RandomNumber_ParameterTypeData TYPE(NWTC_RandomNumber_ParameterType), INTENT(INOUT) :: DstNWTC_RandomNumber_ParameterTypeData @@ -1344,14 +726,12 @@ SUBROUTINE NWTC_Library_CopyNWTC_RandomNumber_ParameterType( SrcNWTC_RandomNumbe DstNWTC_RandomNumber_ParameterTypeData%RNG_type = SrcNWTC_RandomNumber_ParameterTypeData%RNG_type END SUBROUTINE NWTC_Library_CopyNWTC_RandomNumber_ParameterType - SUBROUTINE NWTC_Library_DestroyNWTC_RandomNumber_ParameterType( NWTC_RandomNumber_ParameterTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + SUBROUTINE NWTC_Library_DestroyNWTC_RandomNumber_ParameterType( NWTC_RandomNumber_ParameterTypeData, ErrStat, ErrMsg ) TYPE(NWTC_RandomNumber_ParameterType), INTENT(INOUT) :: NWTC_RandomNumber_ParameterTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - LOGICAL :: DEALLOCATEpointers_local INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_DestroyNWTC_RandomNumber_ParameterType' @@ -1359,172 +739,67 @@ SUBROUTINE NWTC_Library_DestroyNWTC_RandomNumber_ParameterType( NWTC_RandomNumbe ErrStat = ErrID_None ErrMsg = "" - IF (PRESENT(DEALLOCATEpointers)) THEN - DEALLOCATEpointers_local = DEALLOCATEpointers - ELSE - DEALLOCATEpointers_local = .true. - END IF - IF (ALLOCATED(NWTC_RandomNumber_ParameterTypeData%RandSeedAry)) THEN DEALLOCATE(NWTC_RandomNumber_ParameterTypeData%RandSeedAry) ENDIF END SUBROUTINE NWTC_Library_DestroyNWTC_RandomNumber_ParameterType - SUBROUTINE NWTC_Library_PackNWTC_RandomNumber_ParameterType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(NWTC_RandomNumber_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_PackNWTC_RandomNumber_ParameterType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! pRNG - Int_BufSz = Int_BufSz + SIZE(InData%RandSeed) ! RandSeed - Int_BufSz = Int_BufSz + 1 ! RandSeedAry allocated yes/no - IF ( ALLOCATED(InData%RandSeedAry) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RandSeedAry upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RandSeedAry) ! RandSeedAry - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%RNG_type) ! RNG_type - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%pRNG - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%RandSeed,1), UBOUND(InData%RandSeed,1) - IntKiBuf(Int_Xferred) = InData%RandSeed(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%RandSeedAry) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RandSeedAry,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RandSeedAry,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RandSeedAry,1), UBOUND(InData%RandSeedAry,1) - IntKiBuf(Int_Xferred) = InData%RandSeedAry(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - DO I = 1, LEN(InData%RNG_type) - IntKiBuf(Int_Xferred) = ICHAR(InData%RNG_type(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE NWTC_Library_PackNWTC_RandomNumber_ParameterType - - SUBROUTINE NWTC_Library_UnPackNWTC_RandomNumber_ParameterType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(NWTC_RandomNumber_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_UnPackNWTC_RandomNumber_ParameterType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%pRNG = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%RandSeed,1) - i1_u = UBOUND(OutData%RandSeed,1) - DO i1 = LBOUND(OutData%RandSeed,1), UBOUND(OutData%RandSeed,1) - OutData%RandSeed(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RandSeedAry not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RandSeedAry)) DEALLOCATE(OutData%RandSeedAry) - ALLOCATE(OutData%RandSeedAry(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RandSeedAry.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RandSeedAry,1), UBOUND(OutData%RandSeedAry,1) - OutData%RandSeedAry(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - DO I = 1, LEN(OutData%RNG_type) - OutData%RNG_type(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE NWTC_Library_UnPackNWTC_RandomNumber_ParameterType +subroutine NWTC_Library_PackNWTC_RandomNumber_ParameterType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(NWTC_RandomNumber_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'NWTC_Library_PackNWTC_RandomNumber_ParameterType' + if (Buf%ErrStat >= AbortErrLev) return + ! pRNG + call RegPack(Buf, InData%pRNG) + if (RegCheckErr(Buf, RoutineName)) return + ! RandSeed + call RegPack(Buf, InData%RandSeed) + if (RegCheckErr(Buf, RoutineName)) return + ! RandSeedAry + call RegPack(Buf, allocated(InData%RandSeedAry)) + if (allocated(InData%RandSeedAry)) then + call RegPackBounds(Buf, 1, lbound(InData%RandSeedAry), ubound(InData%RandSeedAry)) + call RegPack(Buf, InData%RandSeedAry) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RNG_type + call RegPack(Buf, InData%RNG_type) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine NWTC_Library_UnPackNWTC_RandomNumber_ParameterType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(NWTC_RandomNumber_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'NWTC_Library_UnPackNWTC_RandomNumber_ParameterType' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! pRNG + call RegUnpack(Buf, OutData%pRNG) + if (RegCheckErr(Buf, RoutineName)) return + ! RandSeed + call RegUnpack(Buf, OutData%RandSeed) + if (RegCheckErr(Buf, RoutineName)) return + ! RandSeedAry + if (allocated(OutData%RandSeedAry)) deallocate(OutData%RandSeedAry) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RandSeedAry(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RandSeedAry.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RandSeedAry) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RNG_type + call RegUnpack(Buf, OutData%RNG_type) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine END MODULE NWTC_Library_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/nwtc-library/src/SingPrec.f90 b/modules/nwtc-library/src/SingPrec.f90 index edcfcf1740..ca549f768c 100644 --- a/modules/nwtc-library/src/SingPrec.f90 +++ b/modules/nwtc-library/src/SingPrec.f90 @@ -29,22 +29,31 @@ MODULE Precision !.................................................................................................................................. #ifdef HAS_FORTRAN2008_FEATURES -USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY: real32, real64, real128 +USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY: real32, real64, real128, int8, int16, int32, int64 #endif -IMPLICIT NONE +IMPLICIT NONE + +#ifdef HAS_FORTRAN2008_FEATURES + +INTEGER, PARAMETER :: B1Ki = int8 !< Kind for one-byte whole numbers +INTEGER, PARAMETER :: B2Ki = int16 !< Kind for two-byte whole numbers +INTEGER, PARAMETER :: B4Ki = int32 !< Kind for four-byte whole numbers +INTEGER, PARAMETER :: B8Ki = int64 !< Kind for eight-byte whole numbers + +INTEGER, PARAMETER :: R4Ki = real32 !< Kind for four-byte, floating-point numbers +INTEGER, PARAMETER :: R8Ki = real64 !< Kind for eight-byte floating-point numbers + +#else INTEGER, PARAMETER :: B1Ki = SELECTED_INT_KIND( 2 ) !< Kind for one-byte whole numbers INTEGER, PARAMETER :: B2Ki = SELECTED_INT_KIND( 4 ) !< Kind for two-byte whole numbers INTEGER, PARAMETER :: B4Ki = SELECTED_INT_KIND( 9 ) !< Kind for four-byte whole numbers INTEGER, PARAMETER :: B8Ki = SELECTED_INT_KIND( 18 ) !< Kind for eight-byte whole numbers -#ifdef HAS_FORTRAN2008_FEATURES -INTEGER, PARAMETER :: R4Ki = real32 !< Kind for four-byte, floating-point numbers -INTEGER, PARAMETER :: R8Ki = real64 !< Kind for eight-byte floating-point numbers -#else INTEGER, PARAMETER :: R4Ki = SELECTED_REAL_KIND( 6, 30 ) !< Kind for four-byte, floating-point numbers INTEGER, PARAMETER :: R8Ki = SELECTED_REAL_KIND( 14, 300 ) !< Kind for eight-byte floating-point numbers + #endif INTEGER, PARAMETER :: BYTES_IN_R4Ki = 4 !< Number of bytes per R4Ki number diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index c795815058..5a9ab6adc7 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -7053,11 +7053,7 @@ SUBROUTINE FAST_CreateCheckpoint_T(t_initial, n_t_global, NumTurbines, Turbine, INTEGER(IntKi), OPTIONAL, INTENT(INOUT) :: Unit !< unit number for output file ! local variables: - REAL(ReKi), ALLOCATABLE :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE :: IntKiBuf(:) - - INTEGER(B4Ki) :: ArraySizes(3) + type(PackBuffer) :: Buf INTEGER(IntKi) :: unOut ! unit number for output file INTEGER(IntKi) :: old_avrSwap1 ! previous value of avrSwap(1) !hack for Bladed DLL checkpoint/restore @@ -7072,19 +7068,15 @@ SUBROUTINE FAST_CreateCheckpoint_T(t_initial, n_t_global, NumTurbines, Turbine, ErrStat = ErrID_None ErrMsg = "" - ! Get the arrays of data to be stored in the output file - CALL FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Turbine, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - + ! Initialize the pack buffer + call InitPackBuffer(Buf, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev) return - ArraySizes = 0 - IF ( ALLOCATED(ReKiBuf) ) ArraySizes(1) = SIZE(ReKiBuf) - IF ( ALLOCATED(DbKiBuf) ) ArraySizes(2) = SIZE(DbKiBuf) - IF ( ALLOCATED(IntKiBuf) ) ArraySizes(3) = SIZE(IntKiBuf) + ! Get the arrays of data to be stored in the output file + call FAST_PackTurbineType(Buf, Turbine) + call SetErrStat(Buf%ErrStat, Buf%ErrMsg, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev) return FileName = TRIM(CheckpointRoot)//'.chkp' DLLFileName = TRIM(CheckpointRoot)//'.dll.chkp' @@ -7098,37 +7090,24 @@ SUBROUTINE FAST_CreateCheckpoint_T(t_initial, n_t_global, NumTurbines, Turbine, CALL OpenBOutFile ( unOut, FileName, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) if (ErrStat >= AbortErrLev ) then - call cleanup() + IF (.NOT. PRESENT(Unit)) THEN CLOSE(unOut) unOut = -1 - END IF - - RETURN + end if + return end if - ! checkpoint file header: - WRITE (unOut, IOSTAT=ErrStat2) INT(ReKi ,B4Ki) ! let's make sure we've got the correct number of bytes for reals on restart. - WRITE (unOut, IOSTAT=ErrStat2) INT(DbKi ,B4Ki) ! let's make sure we've got the correct number of bytes for doubles on restart. - WRITE (unOut, IOSTAT=ErrStat2) INT(IntKi ,B4Ki) ! let's make sure we've got the correct number of bytes for integers on restart. - WRITE (unOut, IOSTAT=ErrStat2) AbortErrLev - WRITE (unOut, IOSTAT=ErrStat2) NumTurbines ! Number of turbines - WRITE (unOut, IOSTAT=ErrStat2) t_initial ! initial time - WRITE (unOut, IOSTAT=ErrStat2) n_t_global ! current time step + ! Checkpoint file header: + WRITE (unOut, IOSTAT=ErrStat2) AbortErrLev ! Abort error level + WRITE (unOut, IOSTAT=ErrStat2) NumTurbines ! Number of turbines + WRITE (unOut, IOSTAT=ErrStat2) t_initial ! initial time + WRITE (unOut, IOSTAT=ErrStat2) n_t_global ! current time step END IF - - ! data from current turbine at time step: - WRITE (unOut, IOSTAT=ErrStat2) ArraySizes ! Number of reals, doubles, and integers written to file - WRITE (unOut, IOSTAT=ErrStat2) ReKiBuf ! Packed reals - WRITE (unOut, IOSTAT=ErrStat2) DbKiBuf ! Packed doubles - WRITE (unOut, IOSTAT=ErrStat2) IntKiBuf ! Packed integers - - - IF ( ALLOCATED(ReKiBuf) ) DEALLOCATE(ReKiBuf) - IF ( ALLOCATED(DbKiBuf) ) DEALLOCATE(DbKiBuf) - IF ( ALLOCATED(IntKiBuf) ) DEALLOCATE(IntKiBuf) + ! data from current turbine at time step: + call WritePackBuffer(Buf, unOut, ErrStat2, ErrMsg2) !CALL FAST_CreateCheckpoint(t_initial, n_t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & ! Turbine%ED, Turbine%SrvD, Turbine%AD, Turbine%IfW, & @@ -7136,6 +7115,7 @@ SUBROUTINE FAST_CreateCheckpoint_T(t_initial, n_t_global, NumTurbines, Turbine, ! Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) + ! If last turbine or no unit, close output unit IF (Turbine%TurbID == NumTurbines .OR. .NOT. PRESENT(Unit)) THEN CLOSE(unOut) unOut = -1 @@ -7164,16 +7144,7 @@ SUBROUTINE FAST_CreateCheckpoint_T(t_initial, n_t_global, NumTurbines, Turbine, Turbine%SrvD%m%dll_data%SimStatus = Turbine%SrvD%m%dll_data%avrSWAP( 1) end if END IF - - - call cleanup() -contains - subroutine cleanup() - IF ( ALLOCATED(ReKiBuf) ) DEALLOCATE(ReKiBuf) - IF ( ALLOCATED(DbKiBuf) ) DEALLOCATE(DbKiBuf) - IF ( ALLOCATED(IntKiBuf) ) DEALLOCATE(IntKiBuf) - end subroutine cleanup END SUBROUTINE FAST_CreateCheckpoint_T !---------------------------------------------------------------------------------------------------------------------------------- !> Routine that calls FAST_RestoreFromCheckpoint_T for an array of Turbine data structures. @@ -7236,11 +7207,7 @@ SUBROUTINE FAST_RestoreFromCheckpoint_T(t_initial, n_t_global, NumTurbines, Turb INTEGER(IntKi), OPTIONAL, INTENT(INOUT) :: Unit !< unit number for output file ! local variables: - REAL(ReKi), ALLOCATABLE :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE :: IntKiBuf(:) - - INTEGER(B4Ki) :: ArraySizes(3) + type(PackBuffer) :: Buf INTEGER(IntKi) :: unIn ! unit number for input file INTEGER(IntKi) :: old_avrSwap1 ! previous value of avrSwap(1) !hack for Bladed DLL checkpoint/restore @@ -7265,61 +7232,31 @@ SUBROUTINE FAST_RestoreFromCheckpoint_T(t_initial, n_t_global, NumTurbines, Turb CALL GetNewUnit( unIn, ErrStat2, ErrMsg2 ) - CALL OpenBInpFile ( unIn, FileName, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev ) RETURN - - ! checkpoint file header: - READ (unIn, IOSTAT=ErrStat2) ArraySizes ! let's make sure we've got the correct number of bytes for reals, doubles, and integers on restart. - - IF ( ArraySizes(1) /= ReKi ) CALL SetErrStat(ErrID_Fatal,"ReKi on restart is different than when checkpoint file was created.",ErrStat,ErrMsg,RoutineName) - IF ( ArraySizes(2) /= DbKi ) CALL SetErrStat(ErrID_Fatal,"DbKi on restart is different than when checkpoint file was created.",ErrStat,ErrMsg,RoutineName) - IF ( ArraySizes(3) /= IntKi ) CALL SetErrStat(ErrID_Fatal,"IntKi on restart is different than when checkpoint file was created.",ErrStat,ErrMsg,RoutineName) - IF (ErrStat >= AbortErrLev) THEN - CLOSE(unIn) - unIn = -1 - IF (PRESENT(Unit)) Unit = unIn - RETURN - END IF + CALL OpenBInpFile(unIn, FileName, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev ) return - READ (unIn, IOSTAT=ErrStat2) AbortErrLev - READ (unIn, IOSTAT=ErrStat2) NumTurbines ! Number of turbines - READ (unIn, IOSTAT=ErrStat2) t_initial ! initial time - READ (unIn, IOSTAT=ErrStat2) n_t_global ! current time step + READ (unIn, IOSTAT=ErrStat2) AbortErrLev ! Abort error level + READ (unIn, IOSTAT=ErrStat2) NumTurbines ! Number of turbines + READ (unIn, IOSTAT=ErrStat2) t_initial ! initial time + READ (unIn, IOSTAT=ErrStat2) n_t_global ! current time step END IF ! in case the Turbine data structure isn't empty on entry of this routine: call FAST_DestroyTurbineType( Turbine, ErrStat2, ErrMsg2 ) - - ! data from current time step: - READ (unIn, IOSTAT=ErrStat2) ArraySizes ! Number of reals, doubles, and integers written to file - - ALLOCATE(ReKiBuf( ArraySizes(1)), STAT=ErrStat2) - IF (ErrStat2 /=0) CALL SetErrStat(ErrID_Fatal, "Could not allocate ReKiBuf", ErrStat, ErrMsg, RoutineName ) - ALLOCATE(DbKiBuf( ArraySizes(2)), STAT=ErrStat2) - IF (ErrStat2 /=0) CALL SetErrStat(ErrID_Fatal, "Could not allocate DbKiBuf", ErrStat, ErrMsg, RoutineName ) - ALLOCATE(IntKiBuf(ArraySizes(3)), STAT=ErrStat2) - IF (ErrStat2 /=0) CALL SetErrStat(ErrID_Fatal, "Could not allocate IntKiBuf", ErrStat, ErrMsg, RoutineName ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) return ! Read the packed arrays - IF (ErrStat < AbortErrLev) THEN - - READ (unIn, IOSTAT=ErrStat2) ReKiBuf ! Packed reals - IF (ErrStat2 /=0) CALL SetErrStat(ErrID_Fatal, "Could not read ReKiBuf", ErrStat, ErrMsg, RoutineName ) - READ (unIn, IOSTAT=ErrStat2) DbKiBuf ! Packed doubles - IF (ErrStat2 /=0) CALL SetErrStat(ErrID_Fatal, "Could not read DbKiBuf", ErrStat, ErrMsg, RoutineName ) - READ (unIn, IOSTAT=ErrStat2) IntKiBuf ! Packed integers - IF (ErrStat2 /=0) CALL SetErrStat(ErrID_Fatal, "Could not read IntKiBuf", ErrStat, ErrMsg, RoutineName ) - - END IF + call ReadPackBuffer(Buf, unIn, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return ! Put the arrays back in the data types - IF (ErrStat < AbortErrLev) THEN - CALL FAST_UnpackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Turbine, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - + call FAST_UnpackTurbineType(Buf, Turbine) + call SetErrStat(Buf%ErrStat, Buf%ErrMsg, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev) return ! close file if necessary (do this after unpacking turbine data, so that TurbID is set) IF (Turbine%TurbID == NumTurbines .OR. .NOT. PRESENT(Unit)) THEN @@ -7329,15 +7266,9 @@ SUBROUTINE FAST_RestoreFromCheckpoint_T(t_initial, n_t_global, NumTurbines, Turb IF (PRESENT(Unit)) Unit = unIn - - IF ( ALLOCATED(ReKiBuf) ) DEALLOCATE(ReKiBuf) - IF ( ALLOCATED(DbKiBuf) ) DEALLOCATE(DbKiBuf) - IF ( ALLOCATED(IntKiBuf) ) DEALLOCATE(IntKiBuf) - - ! A sort-of hack to restore MAP DLL data (in particular Turbine%MAP%OtherSt%C_Obj%object) - ! these must be the same variables that are used in MAP_Init because they get allocated in the DLL and - ! destroyed in MAP_End (also, inside the DLL) + ! these must be the same variables that are used in MAP_Init because they get allocated in the DLL and + ! destroyed in MAP_End (also, inside the DLL) IF (Turbine%p_FAST%CompMooring == Module_MAP) THEN CALL MAP_Restart( Turbine%MAP%Input(1), Turbine%MAP%p, Turbine%MAP%x(STATE_CURR), Turbine%MAP%xd(STATE_CURR), & Turbine%MAP%z(STATE_CURR), Turbine%MAP%OtherSt, Turbine%MAP%y, ErrStat2, ErrMsg2 ) @@ -7371,7 +7302,6 @@ SUBROUTINE FAST_RestoreFromCheckpoint_T(t_initial, n_t_global, NumTurbines, Turb Turbine%HD%p%PointsToSeaState = .false. ! since the pointers aren't pointing to the same data as SeaState after restart, set this to avoid memory leaks and deallocation problems - ! deal with files that were open: IF (Turbine%p_FAST%WrTxtOutFile) THEN CALL OpenFunkFileAppend ( Turbine%y_FAST%UnOu, TRIM(Turbine%p_FAST%OutFileRoot)//'.out', ErrStat2, ErrMsg2) @@ -7380,8 +7310,8 @@ SUBROUTINE FAST_RestoreFromCheckpoint_T(t_initial, n_t_global, NumTurbines, Turb CALL WrFileNR ( Turbine%y_FAST%UnOu, '#Restarting here') WRITE(Turbine%y_FAST%UnOu, '()') END IF - ! (ignoring for now; will have fort.x files if any were open [though I printed a warning about not outputting binary files earlier]) + ! (ignoring for now; will have fort.x files if any were open [though I printed a warning about not outputting binary files earlier]) END SUBROUTINE FAST_RestoreFromCheckpoint_T !---------------------------------------------------------------------------------------------------------------------------------- diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index 893900335c..dd11271f03 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -860,159 +860,45 @@ SUBROUTINE FAST_DestroyVTK_BLSurfaceType( VTK_BLSurfaceTypeData, ErrStat, ErrMsg ENDIF END SUBROUTINE FAST_DestroyVTK_BLSurfaceType - SUBROUTINE FAST_PackVTK_BLSurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FAST_VTK_BLSurfaceType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackVTK_BLSurfaceType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! AirfoilCoords allocated yes/no - IF ( ALLOCATED(InData%AirfoilCoords) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AirfoilCoords upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AirfoilCoords) ! AirfoilCoords - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%AirfoilCoords) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AirfoilCoords,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AirfoilCoords,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AirfoilCoords,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AirfoilCoords,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AirfoilCoords,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AirfoilCoords,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%AirfoilCoords,3), UBOUND(InData%AirfoilCoords,3) - DO i2 = LBOUND(InData%AirfoilCoords,2), UBOUND(InData%AirfoilCoords,2) - DO i1 = LBOUND(InData%AirfoilCoords,1), UBOUND(InData%AirfoilCoords,1) - ReKiBuf(Re_Xferred) = InData%AirfoilCoords(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE FAST_PackVTK_BLSurfaceType - - SUBROUTINE FAST_UnPackVTK_BLSurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FAST_VTK_BLSurfaceType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackVTK_BLSurfaceType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AirfoilCoords not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AirfoilCoords)) DEALLOCATE(OutData%AirfoilCoords) - ALLOCATE(OutData%AirfoilCoords(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AirfoilCoords.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%AirfoilCoords,3), UBOUND(OutData%AirfoilCoords,3) - DO i2 = LBOUND(OutData%AirfoilCoords,2), UBOUND(OutData%AirfoilCoords,2) - DO i1 = LBOUND(OutData%AirfoilCoords,1), UBOUND(OutData%AirfoilCoords,1) - OutData%AirfoilCoords(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE FAST_UnPackVTK_BLSurfaceType +subroutine FAST_PackVTK_BLSurfaceType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FAST_VTK_BLSurfaceType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackVTK_BLSurfaceType' + if (Buf%ErrStat >= AbortErrLev) return + ! AirfoilCoords + call RegPack(Buf, allocated(InData%AirfoilCoords)) + if (allocated(InData%AirfoilCoords)) then + call RegPackBounds(Buf, 3, lbound(InData%AirfoilCoords), ubound(InData%AirfoilCoords)) + call RegPack(Buf, InData%AirfoilCoords) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackVTK_BLSurfaceType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FAST_VTK_BLSurfaceType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackVTK_BLSurfaceType' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! AirfoilCoords + if (allocated(OutData%AirfoilCoords)) deallocate(OutData%AirfoilCoords) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AirfoilCoords(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AirfoilCoords.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AirfoilCoords) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE FAST_CopyVTK_SurfaceType( SrcVTK_SurfaceTypeData, DstVTK_SurfaceTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(FAST_VTK_SurfaceType), INTENT(IN) :: SrcVTK_SurfaceTypeData TYPE(FAST_VTK_SurfaceType), INTENT(INOUT) :: DstVTK_SurfaceTypeData @@ -1138,436 +1024,171 @@ SUBROUTINE FAST_DestroyVTK_SurfaceType( VTK_SurfaceTypeData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE FAST_DestroyVTK_SurfaceType - SUBROUTINE FAST_PackVTK_SurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FAST_VTK_SurfaceType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackVTK_SurfaceType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! NumSectors - Re_BufSz = Re_BufSz + 1 ! HubRad - Re_BufSz = Re_BufSz + 1 ! GroundRad - Re_BufSz = Re_BufSz + SIZE(InData%NacelleBox) ! NacelleBox - Int_BufSz = Int_BufSz + 1 ! TowerRad allocated yes/no - IF ( ALLOCATED(InData%TowerRad) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TowerRad upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TowerRad) ! TowerRad - END IF - Int_BufSz = Int_BufSz + SIZE(InData%NWaveElevPts) ! NWaveElevPts - Int_BufSz = Int_BufSz + 1 ! WaveElevXY allocated yes/no - IF ( ALLOCATED(InData%WaveElevXY) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveElevXY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElevXY) ! WaveElevXY - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElev allocated yes/no - IF ( ALLOCATED(InData%WaveElev) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveElev upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev) ! WaveElev - END IF - Int_BufSz = Int_BufSz + 1 ! BladeShape allocated yes/no - IF ( ALLOCATED(InData%BladeShape) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladeShape upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%BladeShape,1), UBOUND(InData%BladeShape,1) - Int_BufSz = Int_BufSz + 3 ! BladeShape: size of buffers for each call to pack subtype - CALL FAST_PackVTK_BLSurfaceType( Re_Buf, Db_Buf, Int_Buf, InData%BladeShape(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BladeShape - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeShape - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeShape - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeShape - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! MorisonRad allocated yes/no - IF ( ALLOCATED(InData%MorisonRad) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MorisonRad upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MorisonRad) ! MorisonRad - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%NumSectors - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HubRad - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GroundRad - Re_Xferred = Re_Xferred + 1 - DO i2 = LBOUND(InData%NacelleBox,2), UBOUND(InData%NacelleBox,2) - DO i1 = LBOUND(InData%NacelleBox,1), UBOUND(InData%NacelleBox,1) - ReKiBuf(Re_Xferred) = InData%NacelleBox(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( .NOT. ALLOCATED(InData%TowerRad) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TowerRad,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TowerRad,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TowerRad,1), UBOUND(InData%TowerRad,1) - ReKiBuf(Re_Xferred) = InData%TowerRad(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DO i1 = LBOUND(InData%NWaveElevPts,1), UBOUND(InData%NWaveElevPts,1) - IntKiBuf(Int_Xferred) = InData%NWaveElevPts(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%WaveElevXY) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevXY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevXY,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevXY,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevXY,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveElevXY,2), UBOUND(InData%WaveElevXY,2) - DO i1 = LBOUND(InData%WaveElevXY,1), UBOUND(InData%WaveElevXY,1) - ReKiBuf(Re_Xferred) = InData%WaveElevXY(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveElev) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveElev,2), UBOUND(InData%WaveElev,2) - DO i1 = LBOUND(InData%WaveElev,1), UBOUND(InData%WaveElev,1) - ReKiBuf(Re_Xferred) = InData%WaveElev(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BladeShape) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeShape,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeShape,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BladeShape,1), UBOUND(InData%BladeShape,1) - CALL FAST_PackVTK_BLSurfaceType( Re_Buf, Db_Buf, Int_Buf, InData%BladeShape(i1), ErrStat2, ErrMsg2, OnlySize ) ! BladeShape - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MorisonRad) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MorisonRad,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MorisonRad,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MorisonRad,1), UBOUND(InData%MorisonRad,1) - ReKiBuf(Re_Xferred) = InData%MorisonRad(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_PackVTK_SurfaceType - - SUBROUTINE FAST_UnPackVTK_SurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FAST_VTK_SurfaceType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackVTK_SurfaceType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%NumSectors = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%HubRad = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%GroundRad = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%NacelleBox,1) - i1_u = UBOUND(OutData%NacelleBox,1) - i2_l = LBOUND(OutData%NacelleBox,2) - i2_u = UBOUND(OutData%NacelleBox,2) - DO i2 = LBOUND(OutData%NacelleBox,2), UBOUND(OutData%NacelleBox,2) - DO i1 = LBOUND(OutData%NacelleBox,1), UBOUND(OutData%NacelleBox,1) - OutData%NacelleBox(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TowerRad not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TowerRad)) DEALLOCATE(OutData%TowerRad) - ALLOCATE(OutData%TowerRad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TowerRad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TowerRad,1), UBOUND(OutData%TowerRad,1) - OutData%TowerRad(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - i1_l = LBOUND(OutData%NWaveElevPts,1) - i1_u = UBOUND(OutData%NWaveElevPts,1) - DO i1 = LBOUND(OutData%NWaveElevPts,1), UBOUND(OutData%NWaveElevPts,1) - OutData%NWaveElevPts(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevXY not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveElevXY)) DEALLOCATE(OutData%WaveElevXY) - ALLOCATE(OutData%WaveElevXY(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevXY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveElevXY,2), UBOUND(OutData%WaveElevXY,2) - DO i1 = LBOUND(OutData%WaveElevXY,1), UBOUND(OutData%WaveElevXY,1) - OutData%WaveElevXY(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveElev)) DEALLOCATE(OutData%WaveElev) - ALLOCATE(OutData%WaveElev(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveElev,2), UBOUND(OutData%WaveElev,2) - DO i1 = LBOUND(OutData%WaveElev,1), UBOUND(OutData%WaveElev,1) - OutData%WaveElev(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeShape not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BladeShape)) DEALLOCATE(OutData%BladeShape) - ALLOCATE(OutData%BladeShape(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeShape.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladeShape,1), UBOUND(OutData%BladeShape,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FAST_UnpackVTK_BLSurfaceType( Re_Buf, Db_Buf, Int_Buf, OutData%BladeShape(i1), ErrStat2, ErrMsg2 ) ! BladeShape - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MorisonRad not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MorisonRad)) DEALLOCATE(OutData%MorisonRad) - ALLOCATE(OutData%MorisonRad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MorisonRad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MorisonRad,1), UBOUND(OutData%MorisonRad,1) - OutData%MorisonRad(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_UnPackVTK_SurfaceType +subroutine FAST_PackVTK_SurfaceType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FAST_VTK_SurfaceType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackVTK_SurfaceType' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + ! NumSectors + call RegPack(Buf, InData%NumSectors) + if (RegCheckErr(Buf, RoutineName)) return + ! HubRad + call RegPack(Buf, InData%HubRad) + if (RegCheckErr(Buf, RoutineName)) return + ! GroundRad + call RegPack(Buf, InData%GroundRad) + if (RegCheckErr(Buf, RoutineName)) return + ! NacelleBox + call RegPack(Buf, InData%NacelleBox) + if (RegCheckErr(Buf, RoutineName)) return + ! TowerRad + call RegPack(Buf, allocated(InData%TowerRad)) + if (allocated(InData%TowerRad)) then + call RegPackBounds(Buf, 1, lbound(InData%TowerRad), ubound(InData%TowerRad)) + call RegPack(Buf, InData%TowerRad) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NWaveElevPts + call RegPack(Buf, InData%NWaveElevPts) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElevXY + call RegPack(Buf, allocated(InData%WaveElevXY)) + if (allocated(InData%WaveElevXY)) then + call RegPackBounds(Buf, 2, lbound(InData%WaveElevXY), ubound(InData%WaveElevXY)) + call RegPack(Buf, InData%WaveElevXY) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElev + call RegPack(Buf, allocated(InData%WaveElev)) + if (allocated(InData%WaveElev)) then + call RegPackBounds(Buf, 2, lbound(InData%WaveElev), ubound(InData%WaveElev)) + call RegPack(Buf, InData%WaveElev) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BladeShape + call RegPack(Buf, allocated(InData%BladeShape)) + if (allocated(InData%BladeShape)) then + call RegPackBounds(Buf, 1, lbound(InData%BladeShape), ubound(InData%BladeShape)) + LB(1:1) = lbound(InData%BladeShape) + UB(1:1) = ubound(InData%BladeShape) + do i1 = LB(1), UB(1) + call FAST_PackVTK_BLSurfaceType(Buf, InData%BladeShape(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MorisonRad + call RegPack(Buf, allocated(InData%MorisonRad)) + if (allocated(InData%MorisonRad)) then + call RegPackBounds(Buf, 1, lbound(InData%MorisonRad), ubound(InData%MorisonRad)) + call RegPack(Buf, InData%MorisonRad) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackVTK_SurfaceType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FAST_VTK_SurfaceType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackVTK_SurfaceType' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! NumSectors + call RegUnpack(Buf, OutData%NumSectors) + if (RegCheckErr(Buf, RoutineName)) return + ! HubRad + call RegUnpack(Buf, OutData%HubRad) + if (RegCheckErr(Buf, RoutineName)) return + ! GroundRad + call RegUnpack(Buf, OutData%GroundRad) + if (RegCheckErr(Buf, RoutineName)) return + ! NacelleBox + call RegUnpack(Buf, OutData%NacelleBox) + if (RegCheckErr(Buf, RoutineName)) return + ! TowerRad + if (allocated(OutData%TowerRad)) deallocate(OutData%TowerRad) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TowerRad(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TowerRad.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TowerRad) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NWaveElevPts + call RegUnpack(Buf, OutData%NWaveElevPts) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElevXY + if (allocated(OutData%WaveElevXY)) deallocate(OutData%WaveElevXY) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveElevXY(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevXY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveElevXY) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WaveElev + if (allocated(OutData%WaveElev)) deallocate(OutData%WaveElev) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveElev(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveElev) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BladeShape + if (allocated(OutData%BladeShape)) deallocate(OutData%BladeShape) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BladeShape(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeShape.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FAST_UnpackVTK_BLSurfaceType(Buf, OutData%BladeShape(i1)) ! BladeShape + end do + end if + ! MorisonRad + if (allocated(OutData%MorisonRad)) deallocate(OutData%MorisonRad) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MorisonRad(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MorisonRad.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MorisonRad) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE FAST_CopyVTK_ModeShapeType( SrcVTK_ModeShapeTypeData, DstVTK_ModeShapeTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(FAST_VTK_ModeShapeType), INTENT(IN) :: SrcVTK_ModeShapeTypeData TYPE(FAST_VTK_ModeShapeType), INTENT(INOUT) :: DstVTK_ModeShapeTypeData @@ -1707,412 +1328,197 @@ SUBROUTINE FAST_DestroyVTK_ModeShapeType( VTK_ModeShapeTypeData, ErrStat, ErrMsg ENDIF END SUBROUTINE FAST_DestroyVTK_ModeShapeType - SUBROUTINE FAST_PackVTK_ModeShapeType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FAST_VTK_ModeShapeType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackVTK_ModeShapeType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%CheckpointRoot) ! CheckpointRoot - Int_BufSz = Int_BufSz + 1*LEN(InData%MatlabFileName) ! MatlabFileName - Int_BufSz = Int_BufSz + 1 ! VTKLinModes - Int_BufSz = Int_BufSz + 1 ! VTKModes allocated yes/no - IF ( ALLOCATED(InData%VTKModes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! VTKModes upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%VTKModes) ! VTKModes - END IF - Int_BufSz = Int_BufSz + 1 ! VTKLinTim - Int_BufSz = Int_BufSz + 1 ! VTKNLinTimes - Re_BufSz = Re_BufSz + 1 ! VTKLinScale - Re_BufSz = Re_BufSz + 1 ! VTKLinPhase - Int_BufSz = Int_BufSz + 1 ! DampingRatio allocated yes/no - IF ( ALLOCATED(InData%DampingRatio) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DampingRatio upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%DampingRatio) ! DampingRatio - END IF - Int_BufSz = Int_BufSz + 1 ! NaturalFreq_Hz allocated yes/no - IF ( ALLOCATED(InData%NaturalFreq_Hz) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NaturalFreq_Hz upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%NaturalFreq_Hz) ! NaturalFreq_Hz - END IF - Int_BufSz = Int_BufSz + 1 ! DampedFreq_Hz allocated yes/no - IF ( ALLOCATED(InData%DampedFreq_Hz) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DampedFreq_Hz upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%DampedFreq_Hz) ! DampedFreq_Hz - END IF - Int_BufSz = Int_BufSz + 1 ! x_eig_magnitude allocated yes/no - IF ( ALLOCATED(InData%x_eig_magnitude) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! x_eig_magnitude upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%x_eig_magnitude) ! x_eig_magnitude - END IF - Int_BufSz = Int_BufSz + 1 ! x_eig_phase allocated yes/no - IF ( ALLOCATED(InData%x_eig_phase) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! x_eig_phase upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%x_eig_phase) ! x_eig_phase - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%CheckpointRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%CheckpointRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%MatlabFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%MatlabFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%VTKLinModes - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%VTKModes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VTKModes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VTKModes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%VTKModes,1), UBOUND(InData%VTKModes,1) - IntKiBuf(Int_Xferred) = InData%VTKModes(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%VTKLinTim - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%VTKNLinTimes - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VTKLinScale - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VTKLinPhase - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%DampingRatio) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DampingRatio,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DampingRatio,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DampingRatio,1), UBOUND(InData%DampingRatio,1) - DbKiBuf(Db_Xferred) = InData%DampingRatio(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NaturalFreq_Hz) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NaturalFreq_Hz,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NaturalFreq_Hz,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NaturalFreq_Hz,1), UBOUND(InData%NaturalFreq_Hz,1) - DbKiBuf(Db_Xferred) = InData%NaturalFreq_Hz(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DampedFreq_Hz) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DampedFreq_Hz,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DampedFreq_Hz,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DampedFreq_Hz,1), UBOUND(InData%DampedFreq_Hz,1) - DbKiBuf(Db_Xferred) = InData%DampedFreq_Hz(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%x_eig_magnitude) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x_eig_magnitude,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_eig_magnitude,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x_eig_magnitude,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_eig_magnitude,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x_eig_magnitude,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_eig_magnitude,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%x_eig_magnitude,3), UBOUND(InData%x_eig_magnitude,3) - DO i2 = LBOUND(InData%x_eig_magnitude,2), UBOUND(InData%x_eig_magnitude,2) - DO i1 = LBOUND(InData%x_eig_magnitude,1), UBOUND(InData%x_eig_magnitude,1) - DbKiBuf(Db_Xferred) = InData%x_eig_magnitude(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%x_eig_phase) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x_eig_phase,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_eig_phase,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x_eig_phase,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_eig_phase,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x_eig_phase,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_eig_phase,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%x_eig_phase,3), UBOUND(InData%x_eig_phase,3) - DO i2 = LBOUND(InData%x_eig_phase,2), UBOUND(InData%x_eig_phase,2) - DO i1 = LBOUND(InData%x_eig_phase,1), UBOUND(InData%x_eig_phase,1) - DbKiBuf(Db_Xferred) = InData%x_eig_phase(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE FAST_PackVTK_ModeShapeType - - SUBROUTINE FAST_UnPackVTK_ModeShapeType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FAST_VTK_ModeShapeType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackVTK_ModeShapeType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%CheckpointRoot) - OutData%CheckpointRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%MatlabFileName) - OutData%MatlabFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%VTKLinModes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VTKModes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%VTKModes)) DEALLOCATE(OutData%VTKModes) - ALLOCATE(OutData%VTKModes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VTKModes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%VTKModes,1), UBOUND(OutData%VTKModes,1) - OutData%VTKModes(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%VTKLinTim = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%VTKNLinTimes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%VTKLinScale = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VTKLinPhase = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DampingRatio not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DampingRatio)) DEALLOCATE(OutData%DampingRatio) - ALLOCATE(OutData%DampingRatio(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DampingRatio.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DampingRatio,1), UBOUND(OutData%DampingRatio,1) - OutData%DampingRatio(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NaturalFreq_Hz not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NaturalFreq_Hz)) DEALLOCATE(OutData%NaturalFreq_Hz) - ALLOCATE(OutData%NaturalFreq_Hz(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NaturalFreq_Hz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NaturalFreq_Hz,1), UBOUND(OutData%NaturalFreq_Hz,1) - OutData%NaturalFreq_Hz(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DampedFreq_Hz not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DampedFreq_Hz)) DEALLOCATE(OutData%DampedFreq_Hz) - ALLOCATE(OutData%DampedFreq_Hz(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DampedFreq_Hz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DampedFreq_Hz,1), UBOUND(OutData%DampedFreq_Hz,1) - OutData%DampedFreq_Hz(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_eig_magnitude not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%x_eig_magnitude)) DEALLOCATE(OutData%x_eig_magnitude) - ALLOCATE(OutData%x_eig_magnitude(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_eig_magnitude.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%x_eig_magnitude,3), UBOUND(OutData%x_eig_magnitude,3) - DO i2 = LBOUND(OutData%x_eig_magnitude,2), UBOUND(OutData%x_eig_magnitude,2) - DO i1 = LBOUND(OutData%x_eig_magnitude,1), UBOUND(OutData%x_eig_magnitude,1) - OutData%x_eig_magnitude(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_eig_phase not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%x_eig_phase)) DEALLOCATE(OutData%x_eig_phase) - ALLOCATE(OutData%x_eig_phase(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_eig_phase.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%x_eig_phase,3), UBOUND(OutData%x_eig_phase,3) - DO i2 = LBOUND(OutData%x_eig_phase,2), UBOUND(OutData%x_eig_phase,2) - DO i1 = LBOUND(OutData%x_eig_phase,1), UBOUND(OutData%x_eig_phase,1) - OutData%x_eig_phase(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE FAST_UnPackVTK_ModeShapeType +subroutine FAST_PackVTK_ModeShapeType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FAST_VTK_ModeShapeType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackVTK_ModeShapeType' + if (Buf%ErrStat >= AbortErrLev) return + ! CheckpointRoot + call RegPack(Buf, InData%CheckpointRoot) + if (RegCheckErr(Buf, RoutineName)) return + ! MatlabFileName + call RegPack(Buf, InData%MatlabFileName) + if (RegCheckErr(Buf, RoutineName)) return + ! VTKLinModes + call RegPack(Buf, InData%VTKLinModes) + if (RegCheckErr(Buf, RoutineName)) return + ! VTKModes + call RegPack(Buf, allocated(InData%VTKModes)) + if (allocated(InData%VTKModes)) then + call RegPackBounds(Buf, 1, lbound(InData%VTKModes), ubound(InData%VTKModes)) + call RegPack(Buf, InData%VTKModes) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! VTKLinTim + call RegPack(Buf, InData%VTKLinTim) + if (RegCheckErr(Buf, RoutineName)) return + ! VTKNLinTimes + call RegPack(Buf, InData%VTKNLinTimes) + if (RegCheckErr(Buf, RoutineName)) return + ! VTKLinScale + call RegPack(Buf, InData%VTKLinScale) + if (RegCheckErr(Buf, RoutineName)) return + ! VTKLinPhase + call RegPack(Buf, InData%VTKLinPhase) + if (RegCheckErr(Buf, RoutineName)) return + ! DampingRatio + call RegPack(Buf, allocated(InData%DampingRatio)) + if (allocated(InData%DampingRatio)) then + call RegPackBounds(Buf, 1, lbound(InData%DampingRatio), ubound(InData%DampingRatio)) + call RegPack(Buf, InData%DampingRatio) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NaturalFreq_Hz + call RegPack(Buf, allocated(InData%NaturalFreq_Hz)) + if (allocated(InData%NaturalFreq_Hz)) then + call RegPackBounds(Buf, 1, lbound(InData%NaturalFreq_Hz), ubound(InData%NaturalFreq_Hz)) + call RegPack(Buf, InData%NaturalFreq_Hz) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DampedFreq_Hz + call RegPack(Buf, allocated(InData%DampedFreq_Hz)) + if (allocated(InData%DampedFreq_Hz)) then + call RegPackBounds(Buf, 1, lbound(InData%DampedFreq_Hz), ubound(InData%DampedFreq_Hz)) + call RegPack(Buf, InData%DampedFreq_Hz) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! x_eig_magnitude + call RegPack(Buf, allocated(InData%x_eig_magnitude)) + if (allocated(InData%x_eig_magnitude)) then + call RegPackBounds(Buf, 3, lbound(InData%x_eig_magnitude), ubound(InData%x_eig_magnitude)) + call RegPack(Buf, InData%x_eig_magnitude) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! x_eig_phase + call RegPack(Buf, allocated(InData%x_eig_phase)) + if (allocated(InData%x_eig_phase)) then + call RegPackBounds(Buf, 3, lbound(InData%x_eig_phase), ubound(InData%x_eig_phase)) + call RegPack(Buf, InData%x_eig_phase) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackVTK_ModeShapeType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FAST_VTK_ModeShapeType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackVTK_ModeShapeType' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! CheckpointRoot + call RegUnpack(Buf, OutData%CheckpointRoot) + if (RegCheckErr(Buf, RoutineName)) return + ! MatlabFileName + call RegUnpack(Buf, OutData%MatlabFileName) + if (RegCheckErr(Buf, RoutineName)) return + ! VTKLinModes + call RegUnpack(Buf, OutData%VTKLinModes) + if (RegCheckErr(Buf, RoutineName)) return + ! VTKModes + if (allocated(OutData%VTKModes)) deallocate(OutData%VTKModes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%VTKModes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%VTKModes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%VTKModes) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! VTKLinTim + call RegUnpack(Buf, OutData%VTKLinTim) + if (RegCheckErr(Buf, RoutineName)) return + ! VTKNLinTimes + call RegUnpack(Buf, OutData%VTKNLinTimes) + if (RegCheckErr(Buf, RoutineName)) return + ! VTKLinScale + call RegUnpack(Buf, OutData%VTKLinScale) + if (RegCheckErr(Buf, RoutineName)) return + ! VTKLinPhase + call RegUnpack(Buf, OutData%VTKLinPhase) + if (RegCheckErr(Buf, RoutineName)) return + ! DampingRatio + if (allocated(OutData%DampingRatio)) deallocate(OutData%DampingRatio) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DampingRatio(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DampingRatio.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DampingRatio) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NaturalFreq_Hz + if (allocated(OutData%NaturalFreq_Hz)) deallocate(OutData%NaturalFreq_Hz) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NaturalFreq_Hz(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NaturalFreq_Hz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%NaturalFreq_Hz) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! DampedFreq_Hz + if (allocated(OutData%DampedFreq_Hz)) deallocate(OutData%DampedFreq_Hz) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DampedFreq_Hz(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DampedFreq_Hz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DampedFreq_Hz) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! x_eig_magnitude + if (allocated(OutData%x_eig_magnitude)) deallocate(OutData%x_eig_magnitude) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_eig_magnitude(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_eig_magnitude.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%x_eig_magnitude) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! x_eig_phase + if (allocated(OutData%x_eig_phase)) deallocate(OutData%x_eig_phase) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_eig_phase(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_eig_phase.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%x_eig_phase) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE FAST_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(FAST_ParameterType), INTENT(IN) :: SrcParamData TYPE(FAST_ParameterType), INTENT(INOUT) :: DstParamData @@ -2247,840 +1653,582 @@ SUBROUTINE FAST_DestroyParam( ParamData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE FAST_DestroyParam - SUBROUTINE FAST_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FAST_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! DT - Db_BufSz = Db_BufSz + SIZE(InData%DT_module) ! DT_module - Int_BufSz = Int_BufSz + SIZE(InData%n_substeps) ! n_substeps - Int_BufSz = Int_BufSz + 1 ! n_TMax_m1 - Db_BufSz = Db_BufSz + 1 ! TMax - Int_BufSz = Int_BufSz + 1 ! InterpOrder - Int_BufSz = Int_BufSz + 1 ! NumCrctn - Int_BufSz = Int_BufSz + 1 ! KMax - Int_BufSz = Int_BufSz + 1 ! numIceLegs - Int_BufSz = Int_BufSz + 1 ! nBeams - Int_BufSz = Int_BufSz + 1 ! BD_OutputSibling - Int_BufSz = Int_BufSz + SIZE(InData%ModuleInitialized) ! ModuleInitialized - Db_BufSz = Db_BufSz + 1 ! DT_Ujac - Re_BufSz = Re_BufSz + 1 ! UJacSclFact - Int_BufSz = Int_BufSz + SIZE(InData%SizeJac_Opt1) ! SizeJac_Opt1 - Int_BufSz = Int_BufSz + 1 ! SolveOption - Int_BufSz = Int_BufSz + 1 ! CompElast - Int_BufSz = Int_BufSz + 1 ! CompInflow - Int_BufSz = Int_BufSz + 1 ! CompAero - Int_BufSz = Int_BufSz + 1 ! CompServo - Int_BufSz = Int_BufSz + 1 ! CompSeaSt - Int_BufSz = Int_BufSz + 1 ! CompHydro - Int_BufSz = Int_BufSz + 1 ! CompSub - Int_BufSz = Int_BufSz + 1 ! CompMooring - Int_BufSz = Int_BufSz + 1 ! CompIce - Int_BufSz = Int_BufSz + 1 ! MHK - Int_BufSz = Int_BufSz + 1 ! UseDWM - Int_BufSz = Int_BufSz + 1 ! Linearize - Int_BufSz = Int_BufSz + 1 ! WaveFieldMod - Int_BufSz = Int_BufSz + 1 ! FarmIntegration - Re_BufSz = Re_BufSz + SIZE(InData%TurbinePos) ! TurbinePos - Re_BufSz = Re_BufSz + 1 ! Gravity - Re_BufSz = Re_BufSz + 1 ! AirDens - Re_BufSz = Re_BufSz + 1 ! WtrDens - Re_BufSz = Re_BufSz + 1 ! KinVisc - Re_BufSz = Re_BufSz + 1 ! SpdSound - Re_BufSz = Re_BufSz + 1 ! Patm - Re_BufSz = Re_BufSz + 1 ! Pvap - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Re_BufSz = Re_BufSz + 1 ! MSL2SWL - Int_BufSz = Int_BufSz + 1*LEN(InData%EDFile) ! EDFile - Int_BufSz = Int_BufSz + SIZE(InData%BDBldFile)*LEN(InData%BDBldFile) ! BDBldFile - Int_BufSz = Int_BufSz + 1*LEN(InData%InflowFile) ! InflowFile - Int_BufSz = Int_BufSz + 1*LEN(InData%AeroFile) ! AeroFile - Int_BufSz = Int_BufSz + 1*LEN(InData%ServoFile) ! ServoFile - Int_BufSz = Int_BufSz + 1*LEN(InData%SeaStFile) ! SeaStFile - Int_BufSz = Int_BufSz + 1*LEN(InData%HydroFile) ! HydroFile - Int_BufSz = Int_BufSz + 1*LEN(InData%SubFile) ! SubFile - Int_BufSz = Int_BufSz + 1*LEN(InData%MooringFile) ! MooringFile - Int_BufSz = Int_BufSz + 1*LEN(InData%IceFile) ! IceFile - Db_BufSz = Db_BufSz + 1 ! TStart - Db_BufSz = Db_BufSz + 1 ! DT_Out - Int_BufSz = Int_BufSz + 1 ! WrSttsTime - Int_BufSz = Int_BufSz + 1 ! n_SttsTime - Int_BufSz = Int_BufSz + 1 ! n_ChkptTime - Int_BufSz = Int_BufSz + 1 ! n_DT_Out - Int_BufSz = Int_BufSz + 1 ! n_VTKTime - Int_BufSz = Int_BufSz + 1 ! TurbineType - Int_BufSz = Int_BufSz + 1 ! WrBinOutFile - Int_BufSz = Int_BufSz + 1 ! WrTxtOutFile - Int_BufSz = Int_BufSz + 1 ! WrBinMod - Int_BufSz = Int_BufSz + 1 ! SumPrint - Int_BufSz = Int_BufSz + 1 ! WrVTK - Int_BufSz = Int_BufSz + 1 ! VTK_Type - Int_BufSz = Int_BufSz + 1 ! VTK_fields - Int_BufSz = Int_BufSz + 1*LEN(InData%Delim) ! Delim - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt_t) ! OutFmt_t - Int_BufSz = Int_BufSz + 1 ! FmtWidth - Int_BufSz = Int_BufSz + 1 ! TChanLen - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFileRoot) ! OutFileRoot - Int_BufSz = Int_BufSz + 1*LEN(InData%FTitle) ! FTitle - Int_BufSz = Int_BufSz + 1*LEN(InData%VTK_OutFileRoot) ! VTK_OutFileRoot - Int_BufSz = Int_BufSz + 1 ! VTK_tWidth - Db_BufSz = Db_BufSz + 1 ! VTK_fps - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! VTK_surface: size of buffers for each call to pack subtype - CALL FAST_PackVTK_SurfaceType( Re_Buf, Db_Buf, Int_Buf, InData%VTK_surface, ErrStat2, ErrMsg2, .TRUE. ) ! VTK_surface - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! VTK_surface - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! VTK_surface - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! VTK_surface - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%Tdesc) ! Tdesc - Int_BufSz = Int_BufSz + 1 ! CalcSteady - Int_BufSz = Int_BufSz + 1 ! TrimCase - Re_BufSz = Re_BufSz + 1 ! TrimTol - Re_BufSz = Re_BufSz + 1 ! TrimGain - Re_BufSz = Re_BufSz + 1 ! Twr_Kdmp - Re_BufSz = Re_BufSz + 1 ! Bld_Kdmp - Int_BufSz = Int_BufSz + 1 ! NLinTimes - Db_BufSz = Db_BufSz + 1 ! AzimDelta - Int_BufSz = Int_BufSz + 1 ! LinInputs - Int_BufSz = Int_BufSz + 1 ! LinOutputs - Int_BufSz = Int_BufSz + 1 ! LinOutJac - Int_BufSz = Int_BufSz + 1 ! LinOutMod - Int_BufSz = Int_BufSz + 3 ! VTK_modes: size of buffers for each call to pack subtype - CALL FAST_PackVTK_ModeShapeType( Re_Buf, Db_Buf, Int_Buf, InData%VTK_modes, ErrStat2, ErrMsg2, .TRUE. ) ! VTK_modes - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! VTK_modes - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! VTK_modes - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! VTK_modes - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! UseSC - Int_BufSz = Int_BufSz + 1 ! Lin_NumMods - Int_BufSz = Int_BufSz + SIZE(InData%Lin_ModOrder) ! Lin_ModOrder - Int_BufSz = Int_BufSz + 1 ! LinInterpOrder - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%DT_module,1), UBOUND(InData%DT_module,1) - DbKiBuf(Db_Xferred) = InData%DT_module(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%n_substeps,1), UBOUND(InData%n_substeps,1) - IntKiBuf(Int_Xferred) = InData%n_substeps(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%n_TMax_m1 - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TMax - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%InterpOrder - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumCrctn - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%KMax - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%numIceLegs - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nBeams - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%BD_OutputSibling, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%ModuleInitialized,1), UBOUND(InData%ModuleInitialized,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%ModuleInitialized(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - DbKiBuf(Db_Xferred) = InData%DT_Ujac - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%UJacSclFact - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%SizeJac_Opt1,1), UBOUND(InData%SizeJac_Opt1,1) - IntKiBuf(Int_Xferred) = InData%SizeJac_Opt1(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%SolveOption - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%CompElast - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%CompInflow - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%CompAero - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%CompServo - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%CompSeaSt - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%CompHydro - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%CompSub - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%CompMooring - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%CompIce - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%MHK - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseDWM, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveFieldMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FarmIntegration, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%TurbinePos,1), UBOUND(InData%TurbinePos,1) - ReKiBuf(Re_Xferred) = InData%TurbinePos(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AirDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%KinVisc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SpdSound - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Patm - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Pvap - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%EDFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%EDFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO i1 = LBOUND(InData%BDBldFile,1), UBOUND(InData%BDBldFile,1) - DO I = 1, LEN(InData%BDBldFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%BDBldFile(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - DO I = 1, LEN(InData%InflowFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InflowFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%AeroFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%AeroFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%ServoFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%ServoFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%SeaStFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%SeaStFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%HydroFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%HydroFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%SubFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%SubFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%MooringFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%MooringFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%IceFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%IceFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf(Db_Xferred) = InData%TStart - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%DT_Out - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WrSttsTime, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%n_SttsTime - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%n_ChkptTime - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%n_DT_Out - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%n_VTKTime - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TurbineType - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WrBinOutFile, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WrTxtOutFile, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WrBinMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WrVTK - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%VTK_Type - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%VTK_fields, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutFmt_t) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt_t(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%FmtWidth - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TChanLen - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFileRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFileRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%FTitle) - IntKiBuf(Int_Xferred) = ICHAR(InData%FTitle(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%VTK_OutFileRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%VTK_OutFileRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%VTK_tWidth - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%VTK_fps - Db_Xferred = Db_Xferred + 1 - CALL FAST_PackVTK_SurfaceType( Re_Buf, Db_Buf, Int_Buf, InData%VTK_surface, ErrStat2, ErrMsg2, OnlySize ) ! VTK_surface - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - DO I = 1, LEN(InData%Tdesc) - IntKiBuf(Int_Xferred) = ICHAR(InData%Tdesc(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%CalcSteady, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TrimCase - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TrimTol - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TrimGain - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Twr_Kdmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Bld_Kdmp - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NLinTimes - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%AzimDelta - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%LinInputs - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%LinOutputs - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%LinOutJac, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%LinOutMod, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - CALL FAST_PackVTK_ModeShapeType( Re_Buf, Db_Buf, Int_Buf, InData%VTK_modes, ErrStat2, ErrMsg2, OnlySize ) ! VTK_modes - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseSC, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Lin_NumMods - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%Lin_ModOrder,1), UBOUND(InData%Lin_ModOrder,1) - IntKiBuf(Int_Xferred) = InData%Lin_ModOrder(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%LinInterpOrder - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FAST_PackParam - - SUBROUTINE FAST_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FAST_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%DT_module,1) - i1_u = UBOUND(OutData%DT_module,1) - DO i1 = LBOUND(OutData%DT_module,1), UBOUND(OutData%DT_module,1) - OutData%DT_module(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%n_substeps,1) - i1_u = UBOUND(OutData%n_substeps,1) - DO i1 = LBOUND(OutData%n_substeps,1), UBOUND(OutData%n_substeps,1) - OutData%n_substeps(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%n_TMax_m1 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TMax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%InterpOrder = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumCrctn = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%KMax = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%numIceLegs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nBeams = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%BD_OutputSibling = TRANSFER(IntKiBuf(Int_Xferred), OutData%BD_OutputSibling) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%ModuleInitialized,1) - i1_u = UBOUND(OutData%ModuleInitialized,1) - DO i1 = LBOUND(OutData%ModuleInitialized,1), UBOUND(OutData%ModuleInitialized,1) - OutData%ModuleInitialized(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%ModuleInitialized(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%DT_Ujac = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%UJacSclFact = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%SizeJac_Opt1,1) - i1_u = UBOUND(OutData%SizeJac_Opt1,1) - DO i1 = LBOUND(OutData%SizeJac_Opt1,1), UBOUND(OutData%SizeJac_Opt1,1) - OutData%SizeJac_Opt1(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%SolveOption = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CompElast = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CompInflow = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CompAero = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CompServo = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CompSeaSt = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CompHydro = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CompSub = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CompMooring = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CompIce = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%MHK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UseDWM = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseDWM) - Int_Xferred = Int_Xferred + 1 - OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) - Int_Xferred = Int_Xferred + 1 - OutData%WaveFieldMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FarmIntegration = TRANSFER(IntKiBuf(Int_Xferred), OutData%FarmIntegration) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%TurbinePos,1) - i1_u = UBOUND(OutData%TurbinePos,1) - DO i1 = LBOUND(OutData%TurbinePos,1), UBOUND(OutData%TurbinePos,1) - OutData%TurbinePos(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%Gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AirDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%KinVisc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SpdSound = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Patm = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Pvap = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MSL2SWL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%EDFile) - OutData%EDFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - i1_l = LBOUND(OutData%BDBldFile,1) - i1_u = UBOUND(OutData%BDBldFile,1) - DO i1 = LBOUND(OutData%BDBldFile,1), UBOUND(OutData%BDBldFile,1) - DO I = 1, LEN(OutData%BDBldFile) - OutData%BDBldFile(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - DO I = 1, LEN(OutData%InflowFile) - OutData%InflowFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%AeroFile) - OutData%AeroFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%ServoFile) - OutData%ServoFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%SeaStFile) - OutData%SeaStFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%HydroFile) - OutData%HydroFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%SubFile) - OutData%SubFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%MooringFile) - OutData%MooringFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%IceFile) - OutData%IceFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%TStart = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%DT_Out = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%WrSttsTime = TRANSFER(IntKiBuf(Int_Xferred), OutData%WrSttsTime) - Int_Xferred = Int_Xferred + 1 - OutData%n_SttsTime = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%n_ChkptTime = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%n_DT_Out = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%n_VTKTime = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TurbineType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WrBinOutFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%WrBinOutFile) - Int_Xferred = Int_Xferred + 1 - OutData%WrTxtOutFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%WrTxtOutFile) - Int_Xferred = Int_Xferred + 1 - OutData%WrBinMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) - Int_Xferred = Int_Xferred + 1 - OutData%WrVTK = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%VTK_Type = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%VTK_fields = TRANSFER(IntKiBuf(Int_Xferred), OutData%VTK_fields) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutFmt_t) - OutData%OutFmt_t(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%FmtWidth = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TChanLen = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFileRoot) - OutData%OutFileRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%FTitle) - OutData%FTitle(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%VTK_OutFileRoot) - OutData%VTK_OutFileRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%VTK_tWidth = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%VTK_fps = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FAST_UnpackVTK_SurfaceType( Re_Buf, Db_Buf, Int_Buf, OutData%VTK_surface, ErrStat2, ErrMsg2 ) ! VTK_surface - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - DO I = 1, LEN(OutData%Tdesc) - OutData%Tdesc(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%CalcSteady = TRANSFER(IntKiBuf(Int_Xferred), OutData%CalcSteady) - Int_Xferred = Int_Xferred + 1 - OutData%TrimCase = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TrimTol = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TrimGain = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Twr_Kdmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Bld_Kdmp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NLinTimes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%AzimDelta = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%LinInputs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%LinOutputs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%LinOutJac = TRANSFER(IntKiBuf(Int_Xferred), OutData%LinOutJac) - Int_Xferred = Int_Xferred + 1 - OutData%LinOutMod = TRANSFER(IntKiBuf(Int_Xferred), OutData%LinOutMod) - Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FAST_UnpackVTK_ModeShapeType( Re_Buf, Db_Buf, Int_Buf, OutData%VTK_modes, ErrStat2, ErrMsg2 ) ! VTK_modes - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%UseSC = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseSC) - Int_Xferred = Int_Xferred + 1 - OutData%Lin_NumMods = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%Lin_ModOrder,1) - i1_u = UBOUND(OutData%Lin_ModOrder,1) - DO i1 = LBOUND(OutData%Lin_ModOrder,1), UBOUND(OutData%Lin_ModOrder,1) - OutData%Lin_ModOrder(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%LinInterpOrder = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FAST_UnPackParam +subroutine FAST_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FAST_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackParam' + if (Buf%ErrStat >= AbortErrLev) return + ! DT + call RegPack(Buf, InData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! DT_module + call RegPack(Buf, InData%DT_module) + if (RegCheckErr(Buf, RoutineName)) return + ! n_substeps + call RegPack(Buf, InData%n_substeps) + if (RegCheckErr(Buf, RoutineName)) return + ! n_TMax_m1 + call RegPack(Buf, InData%n_TMax_m1) + if (RegCheckErr(Buf, RoutineName)) return + ! TMax + call RegPack(Buf, InData%TMax) + if (RegCheckErr(Buf, RoutineName)) return + ! InterpOrder + call RegPack(Buf, InData%InterpOrder) + if (RegCheckErr(Buf, RoutineName)) return + ! NumCrctn + call RegPack(Buf, InData%NumCrctn) + if (RegCheckErr(Buf, RoutineName)) return + ! KMax + call RegPack(Buf, InData%KMax) + if (RegCheckErr(Buf, RoutineName)) return + ! numIceLegs + call RegPack(Buf, InData%numIceLegs) + if (RegCheckErr(Buf, RoutineName)) return + ! nBeams + call RegPack(Buf, InData%nBeams) + if (RegCheckErr(Buf, RoutineName)) return + ! BD_OutputSibling + call RegPack(Buf, InData%BD_OutputSibling) + if (RegCheckErr(Buf, RoutineName)) return + ! ModuleInitialized + call RegPack(Buf, InData%ModuleInitialized) + if (RegCheckErr(Buf, RoutineName)) return + ! DT_Ujac + call RegPack(Buf, InData%DT_Ujac) + if (RegCheckErr(Buf, RoutineName)) return + ! UJacSclFact + call RegPack(Buf, InData%UJacSclFact) + if (RegCheckErr(Buf, RoutineName)) return + ! SizeJac_Opt1 + call RegPack(Buf, InData%SizeJac_Opt1) + if (RegCheckErr(Buf, RoutineName)) return + ! SolveOption + call RegPack(Buf, InData%SolveOption) + if (RegCheckErr(Buf, RoutineName)) return + ! CompElast + call RegPack(Buf, InData%CompElast) + if (RegCheckErr(Buf, RoutineName)) return + ! CompInflow + call RegPack(Buf, InData%CompInflow) + if (RegCheckErr(Buf, RoutineName)) return + ! CompAero + call RegPack(Buf, InData%CompAero) + if (RegCheckErr(Buf, RoutineName)) return + ! CompServo + call RegPack(Buf, InData%CompServo) + if (RegCheckErr(Buf, RoutineName)) return + ! CompSeaSt + call RegPack(Buf, InData%CompSeaSt) + if (RegCheckErr(Buf, RoutineName)) return + ! CompHydro + call RegPack(Buf, InData%CompHydro) + if (RegCheckErr(Buf, RoutineName)) return + ! CompSub + call RegPack(Buf, InData%CompSub) + if (RegCheckErr(Buf, RoutineName)) return + ! CompMooring + call RegPack(Buf, InData%CompMooring) + if (RegCheckErr(Buf, RoutineName)) return + ! CompIce + call RegPack(Buf, InData%CompIce) + if (RegCheckErr(Buf, RoutineName)) return + ! MHK + call RegPack(Buf, InData%MHK) + if (RegCheckErr(Buf, RoutineName)) return + ! UseDWM + call RegPack(Buf, InData%UseDWM) + if (RegCheckErr(Buf, RoutineName)) return + ! Linearize + call RegPack(Buf, InData%Linearize) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveFieldMod + call RegPack(Buf, InData%WaveFieldMod) + if (RegCheckErr(Buf, RoutineName)) return + ! FarmIntegration + call RegPack(Buf, InData%FarmIntegration) + if (RegCheckErr(Buf, RoutineName)) return + ! TurbinePos + call RegPack(Buf, InData%TurbinePos) + if (RegCheckErr(Buf, RoutineName)) return + ! Gravity + call RegPack(Buf, InData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + ! AirDens + call RegPack(Buf, InData%AirDens) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDens + call RegPack(Buf, InData%WtrDens) + if (RegCheckErr(Buf, RoutineName)) return + ! KinVisc + call RegPack(Buf, InData%KinVisc) + if (RegCheckErr(Buf, RoutineName)) return + ! SpdSound + call RegPack(Buf, InData%SpdSound) + if (RegCheckErr(Buf, RoutineName)) return + ! Patm + call RegPack(Buf, InData%Patm) + if (RegCheckErr(Buf, RoutineName)) return + ! Pvap + call RegPack(Buf, InData%Pvap) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDpth + call RegPack(Buf, InData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! MSL2SWL + call RegPack(Buf, InData%MSL2SWL) + if (RegCheckErr(Buf, RoutineName)) return + ! EDFile + call RegPack(Buf, InData%EDFile) + if (RegCheckErr(Buf, RoutineName)) return + ! BDBldFile + call RegPack(Buf, InData%BDBldFile) + if (RegCheckErr(Buf, RoutineName)) return + ! InflowFile + call RegPack(Buf, InData%InflowFile) + if (RegCheckErr(Buf, RoutineName)) return + ! AeroFile + call RegPack(Buf, InData%AeroFile) + if (RegCheckErr(Buf, RoutineName)) return + ! ServoFile + call RegPack(Buf, InData%ServoFile) + if (RegCheckErr(Buf, RoutineName)) return + ! SeaStFile + call RegPack(Buf, InData%SeaStFile) + if (RegCheckErr(Buf, RoutineName)) return + ! HydroFile + call RegPack(Buf, InData%HydroFile) + if (RegCheckErr(Buf, RoutineName)) return + ! SubFile + call RegPack(Buf, InData%SubFile) + if (RegCheckErr(Buf, RoutineName)) return + ! MooringFile + call RegPack(Buf, InData%MooringFile) + if (RegCheckErr(Buf, RoutineName)) return + ! IceFile + call RegPack(Buf, InData%IceFile) + if (RegCheckErr(Buf, RoutineName)) return + ! TStart + call RegPack(Buf, InData%TStart) + if (RegCheckErr(Buf, RoutineName)) return + ! DT_Out + call RegPack(Buf, InData%DT_Out) + if (RegCheckErr(Buf, RoutineName)) return + ! WrSttsTime + call RegPack(Buf, InData%WrSttsTime) + if (RegCheckErr(Buf, RoutineName)) return + ! n_SttsTime + call RegPack(Buf, InData%n_SttsTime) + if (RegCheckErr(Buf, RoutineName)) return + ! n_ChkptTime + call RegPack(Buf, InData%n_ChkptTime) + if (RegCheckErr(Buf, RoutineName)) return + ! n_DT_Out + call RegPack(Buf, InData%n_DT_Out) + if (RegCheckErr(Buf, RoutineName)) return + ! n_VTKTime + call RegPack(Buf, InData%n_VTKTime) + if (RegCheckErr(Buf, RoutineName)) return + ! TurbineType + call RegPack(Buf, InData%TurbineType) + if (RegCheckErr(Buf, RoutineName)) return + ! WrBinOutFile + call RegPack(Buf, InData%WrBinOutFile) + if (RegCheckErr(Buf, RoutineName)) return + ! WrTxtOutFile + call RegPack(Buf, InData%WrTxtOutFile) + if (RegCheckErr(Buf, RoutineName)) return + ! WrBinMod + call RegPack(Buf, InData%WrBinMod) + if (RegCheckErr(Buf, RoutineName)) return + ! SumPrint + call RegPack(Buf, InData%SumPrint) + if (RegCheckErr(Buf, RoutineName)) return + ! WrVTK + call RegPack(Buf, InData%WrVTK) + if (RegCheckErr(Buf, RoutineName)) return + ! VTK_Type + call RegPack(Buf, InData%VTK_Type) + if (RegCheckErr(Buf, RoutineName)) return + ! VTK_fields + call RegPack(Buf, InData%VTK_fields) + if (RegCheckErr(Buf, RoutineName)) return + ! Delim + call RegPack(Buf, InData%Delim) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFmt + call RegPack(Buf, InData%OutFmt) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFmt_t + call RegPack(Buf, InData%OutFmt_t) + if (RegCheckErr(Buf, RoutineName)) return + ! FmtWidth + call RegPack(Buf, InData%FmtWidth) + if (RegCheckErr(Buf, RoutineName)) return + ! TChanLen + call RegPack(Buf, InData%TChanLen) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFileRoot + call RegPack(Buf, InData%OutFileRoot) + if (RegCheckErr(Buf, RoutineName)) return + ! FTitle + call RegPack(Buf, InData%FTitle) + if (RegCheckErr(Buf, RoutineName)) return + ! VTK_OutFileRoot + call RegPack(Buf, InData%VTK_OutFileRoot) + if (RegCheckErr(Buf, RoutineName)) return + ! VTK_tWidth + call RegPack(Buf, InData%VTK_tWidth) + if (RegCheckErr(Buf, RoutineName)) return + ! VTK_fps + call RegPack(Buf, InData%VTK_fps) + if (RegCheckErr(Buf, RoutineName)) return + ! VTK_surface + call FAST_PackVTK_SurfaceType(Buf, InData%VTK_surface) + if (RegCheckErr(Buf, RoutineName)) return + ! Tdesc + call RegPack(Buf, InData%Tdesc) + if (RegCheckErr(Buf, RoutineName)) return + ! CalcSteady + call RegPack(Buf, InData%CalcSteady) + if (RegCheckErr(Buf, RoutineName)) return + ! TrimCase + call RegPack(Buf, InData%TrimCase) + if (RegCheckErr(Buf, RoutineName)) return + ! TrimTol + call RegPack(Buf, InData%TrimTol) + if (RegCheckErr(Buf, RoutineName)) return + ! TrimGain + call RegPack(Buf, InData%TrimGain) + if (RegCheckErr(Buf, RoutineName)) return + ! Twr_Kdmp + call RegPack(Buf, InData%Twr_Kdmp) + if (RegCheckErr(Buf, RoutineName)) return + ! Bld_Kdmp + call RegPack(Buf, InData%Bld_Kdmp) + if (RegCheckErr(Buf, RoutineName)) return + ! NLinTimes + call RegPack(Buf, InData%NLinTimes) + if (RegCheckErr(Buf, RoutineName)) return + ! AzimDelta + call RegPack(Buf, InData%AzimDelta) + if (RegCheckErr(Buf, RoutineName)) return + ! LinInputs + call RegPack(Buf, InData%LinInputs) + if (RegCheckErr(Buf, RoutineName)) return + ! LinOutputs + call RegPack(Buf, InData%LinOutputs) + if (RegCheckErr(Buf, RoutineName)) return + ! LinOutJac + call RegPack(Buf, InData%LinOutJac) + if (RegCheckErr(Buf, RoutineName)) return + ! LinOutMod + call RegPack(Buf, InData%LinOutMod) + if (RegCheckErr(Buf, RoutineName)) return + ! VTK_modes + call FAST_PackVTK_ModeShapeType(Buf, InData%VTK_modes) + if (RegCheckErr(Buf, RoutineName)) return + ! UseSC + call RegPack(Buf, InData%UseSC) + if (RegCheckErr(Buf, RoutineName)) return + ! Lin_NumMods + call RegPack(Buf, InData%Lin_NumMods) + if (RegCheckErr(Buf, RoutineName)) return + ! Lin_ModOrder + call RegPack(Buf, InData%Lin_ModOrder) + if (RegCheckErr(Buf, RoutineName)) return + ! LinInterpOrder + call RegPack(Buf, InData%LinInterpOrder) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FAST_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackParam' + if (Buf%ErrStat /= ErrID_None) return + ! DT + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! DT_module + call RegUnpack(Buf, OutData%DT_module) + if (RegCheckErr(Buf, RoutineName)) return + ! n_substeps + call RegUnpack(Buf, OutData%n_substeps) + if (RegCheckErr(Buf, RoutineName)) return + ! n_TMax_m1 + call RegUnpack(Buf, OutData%n_TMax_m1) + if (RegCheckErr(Buf, RoutineName)) return + ! TMax + call RegUnpack(Buf, OutData%TMax) + if (RegCheckErr(Buf, RoutineName)) return + ! InterpOrder + call RegUnpack(Buf, OutData%InterpOrder) + if (RegCheckErr(Buf, RoutineName)) return + ! NumCrctn + call RegUnpack(Buf, OutData%NumCrctn) + if (RegCheckErr(Buf, RoutineName)) return + ! KMax + call RegUnpack(Buf, OutData%KMax) + if (RegCheckErr(Buf, RoutineName)) return + ! numIceLegs + call RegUnpack(Buf, OutData%numIceLegs) + if (RegCheckErr(Buf, RoutineName)) return + ! nBeams + call RegUnpack(Buf, OutData%nBeams) + if (RegCheckErr(Buf, RoutineName)) return + ! BD_OutputSibling + call RegUnpack(Buf, OutData%BD_OutputSibling) + if (RegCheckErr(Buf, RoutineName)) return + ! ModuleInitialized + call RegUnpack(Buf, OutData%ModuleInitialized) + if (RegCheckErr(Buf, RoutineName)) return + ! DT_Ujac + call RegUnpack(Buf, OutData%DT_Ujac) + if (RegCheckErr(Buf, RoutineName)) return + ! UJacSclFact + call RegUnpack(Buf, OutData%UJacSclFact) + if (RegCheckErr(Buf, RoutineName)) return + ! SizeJac_Opt1 + call RegUnpack(Buf, OutData%SizeJac_Opt1) + if (RegCheckErr(Buf, RoutineName)) return + ! SolveOption + call RegUnpack(Buf, OutData%SolveOption) + if (RegCheckErr(Buf, RoutineName)) return + ! CompElast + call RegUnpack(Buf, OutData%CompElast) + if (RegCheckErr(Buf, RoutineName)) return + ! CompInflow + call RegUnpack(Buf, OutData%CompInflow) + if (RegCheckErr(Buf, RoutineName)) return + ! CompAero + call RegUnpack(Buf, OutData%CompAero) + if (RegCheckErr(Buf, RoutineName)) return + ! CompServo + call RegUnpack(Buf, OutData%CompServo) + if (RegCheckErr(Buf, RoutineName)) return + ! CompSeaSt + call RegUnpack(Buf, OutData%CompSeaSt) + if (RegCheckErr(Buf, RoutineName)) return + ! CompHydro + call RegUnpack(Buf, OutData%CompHydro) + if (RegCheckErr(Buf, RoutineName)) return + ! CompSub + call RegUnpack(Buf, OutData%CompSub) + if (RegCheckErr(Buf, RoutineName)) return + ! CompMooring + call RegUnpack(Buf, OutData%CompMooring) + if (RegCheckErr(Buf, RoutineName)) return + ! CompIce + call RegUnpack(Buf, OutData%CompIce) + if (RegCheckErr(Buf, RoutineName)) return + ! MHK + call RegUnpack(Buf, OutData%MHK) + if (RegCheckErr(Buf, RoutineName)) return + ! UseDWM + call RegUnpack(Buf, OutData%UseDWM) + if (RegCheckErr(Buf, RoutineName)) return + ! Linearize + call RegUnpack(Buf, OutData%Linearize) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveFieldMod + call RegUnpack(Buf, OutData%WaveFieldMod) + if (RegCheckErr(Buf, RoutineName)) return + ! FarmIntegration + call RegUnpack(Buf, OutData%FarmIntegration) + if (RegCheckErr(Buf, RoutineName)) return + ! TurbinePos + call RegUnpack(Buf, OutData%TurbinePos) + if (RegCheckErr(Buf, RoutineName)) return + ! Gravity + call RegUnpack(Buf, OutData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + ! AirDens + call RegUnpack(Buf, OutData%AirDens) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDens + call RegUnpack(Buf, OutData%WtrDens) + if (RegCheckErr(Buf, RoutineName)) return + ! KinVisc + call RegUnpack(Buf, OutData%KinVisc) + if (RegCheckErr(Buf, RoutineName)) return + ! SpdSound + call RegUnpack(Buf, OutData%SpdSound) + if (RegCheckErr(Buf, RoutineName)) return + ! Patm + call RegUnpack(Buf, OutData%Patm) + if (RegCheckErr(Buf, RoutineName)) return + ! Pvap + call RegUnpack(Buf, OutData%Pvap) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDpth + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! MSL2SWL + call RegUnpack(Buf, OutData%MSL2SWL) + if (RegCheckErr(Buf, RoutineName)) return + ! EDFile + call RegUnpack(Buf, OutData%EDFile) + if (RegCheckErr(Buf, RoutineName)) return + ! BDBldFile + call RegUnpack(Buf, OutData%BDBldFile) + if (RegCheckErr(Buf, RoutineName)) return + ! InflowFile + call RegUnpack(Buf, OutData%InflowFile) + if (RegCheckErr(Buf, RoutineName)) return + ! AeroFile + call RegUnpack(Buf, OutData%AeroFile) + if (RegCheckErr(Buf, RoutineName)) return + ! ServoFile + call RegUnpack(Buf, OutData%ServoFile) + if (RegCheckErr(Buf, RoutineName)) return + ! SeaStFile + call RegUnpack(Buf, OutData%SeaStFile) + if (RegCheckErr(Buf, RoutineName)) return + ! HydroFile + call RegUnpack(Buf, OutData%HydroFile) + if (RegCheckErr(Buf, RoutineName)) return + ! SubFile + call RegUnpack(Buf, OutData%SubFile) + if (RegCheckErr(Buf, RoutineName)) return + ! MooringFile + call RegUnpack(Buf, OutData%MooringFile) + if (RegCheckErr(Buf, RoutineName)) return + ! IceFile + call RegUnpack(Buf, OutData%IceFile) + if (RegCheckErr(Buf, RoutineName)) return + ! TStart + call RegUnpack(Buf, OutData%TStart) + if (RegCheckErr(Buf, RoutineName)) return + ! DT_Out + call RegUnpack(Buf, OutData%DT_Out) + if (RegCheckErr(Buf, RoutineName)) return + ! WrSttsTime + call RegUnpack(Buf, OutData%WrSttsTime) + if (RegCheckErr(Buf, RoutineName)) return + ! n_SttsTime + call RegUnpack(Buf, OutData%n_SttsTime) + if (RegCheckErr(Buf, RoutineName)) return + ! n_ChkptTime + call RegUnpack(Buf, OutData%n_ChkptTime) + if (RegCheckErr(Buf, RoutineName)) return + ! n_DT_Out + call RegUnpack(Buf, OutData%n_DT_Out) + if (RegCheckErr(Buf, RoutineName)) return + ! n_VTKTime + call RegUnpack(Buf, OutData%n_VTKTime) + if (RegCheckErr(Buf, RoutineName)) return + ! TurbineType + call RegUnpack(Buf, OutData%TurbineType) + if (RegCheckErr(Buf, RoutineName)) return + ! WrBinOutFile + call RegUnpack(Buf, OutData%WrBinOutFile) + if (RegCheckErr(Buf, RoutineName)) return + ! WrTxtOutFile + call RegUnpack(Buf, OutData%WrTxtOutFile) + if (RegCheckErr(Buf, RoutineName)) return + ! WrBinMod + call RegUnpack(Buf, OutData%WrBinMod) + if (RegCheckErr(Buf, RoutineName)) return + ! SumPrint + call RegUnpack(Buf, OutData%SumPrint) + if (RegCheckErr(Buf, RoutineName)) return + ! WrVTK + call RegUnpack(Buf, OutData%WrVTK) + if (RegCheckErr(Buf, RoutineName)) return + ! VTK_Type + call RegUnpack(Buf, OutData%VTK_Type) + if (RegCheckErr(Buf, RoutineName)) return + ! VTK_fields + call RegUnpack(Buf, OutData%VTK_fields) + if (RegCheckErr(Buf, RoutineName)) return + ! Delim + call RegUnpack(Buf, OutData%Delim) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFmt + call RegUnpack(Buf, OutData%OutFmt) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFmt_t + call RegUnpack(Buf, OutData%OutFmt_t) + if (RegCheckErr(Buf, RoutineName)) return + ! FmtWidth + call RegUnpack(Buf, OutData%FmtWidth) + if (RegCheckErr(Buf, RoutineName)) return + ! TChanLen + call RegUnpack(Buf, OutData%TChanLen) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFileRoot + call RegUnpack(Buf, OutData%OutFileRoot) + if (RegCheckErr(Buf, RoutineName)) return + ! FTitle + call RegUnpack(Buf, OutData%FTitle) + if (RegCheckErr(Buf, RoutineName)) return + ! VTK_OutFileRoot + call RegUnpack(Buf, OutData%VTK_OutFileRoot) + if (RegCheckErr(Buf, RoutineName)) return + ! VTK_tWidth + call RegUnpack(Buf, OutData%VTK_tWidth) + if (RegCheckErr(Buf, RoutineName)) return + ! VTK_fps + call RegUnpack(Buf, OutData%VTK_fps) + if (RegCheckErr(Buf, RoutineName)) return + ! VTK_surface + call FAST_UnpackVTK_SurfaceType(Buf, OutData%VTK_surface) ! VTK_surface + ! Tdesc + call RegUnpack(Buf, OutData%Tdesc) + if (RegCheckErr(Buf, RoutineName)) return + ! CalcSteady + call RegUnpack(Buf, OutData%CalcSteady) + if (RegCheckErr(Buf, RoutineName)) return + ! TrimCase + call RegUnpack(Buf, OutData%TrimCase) + if (RegCheckErr(Buf, RoutineName)) return + ! TrimTol + call RegUnpack(Buf, OutData%TrimTol) + if (RegCheckErr(Buf, RoutineName)) return + ! TrimGain + call RegUnpack(Buf, OutData%TrimGain) + if (RegCheckErr(Buf, RoutineName)) return + ! Twr_Kdmp + call RegUnpack(Buf, OutData%Twr_Kdmp) + if (RegCheckErr(Buf, RoutineName)) return + ! Bld_Kdmp + call RegUnpack(Buf, OutData%Bld_Kdmp) + if (RegCheckErr(Buf, RoutineName)) return + ! NLinTimes + call RegUnpack(Buf, OutData%NLinTimes) + if (RegCheckErr(Buf, RoutineName)) return + ! AzimDelta + call RegUnpack(Buf, OutData%AzimDelta) + if (RegCheckErr(Buf, RoutineName)) return + ! LinInputs + call RegUnpack(Buf, OutData%LinInputs) + if (RegCheckErr(Buf, RoutineName)) return + ! LinOutputs + call RegUnpack(Buf, OutData%LinOutputs) + if (RegCheckErr(Buf, RoutineName)) return + ! LinOutJac + call RegUnpack(Buf, OutData%LinOutJac) + if (RegCheckErr(Buf, RoutineName)) return + ! LinOutMod + call RegUnpack(Buf, OutData%LinOutMod) + if (RegCheckErr(Buf, RoutineName)) return + ! VTK_modes + call FAST_UnpackVTK_ModeShapeType(Buf, OutData%VTK_modes) ! VTK_modes + ! UseSC + call RegUnpack(Buf, OutData%UseSC) + if (RegCheckErr(Buf, RoutineName)) return + ! Lin_NumMods + call RegUnpack(Buf, OutData%Lin_NumMods) + if (RegCheckErr(Buf, RoutineName)) return + ! Lin_ModOrder + call RegUnpack(Buf, OutData%Lin_ModOrder) + if (RegCheckErr(Buf, RoutineName)) return + ! LinInterpOrder + call RegUnpack(Buf, OutData%LinInterpOrder) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE FAST_CopyLinStateSave( SrcLinStateSaveData, DstLinStateSaveData, CtrlCode, ErrStat, ErrMsg ) TYPE(FAST_LinStateSave), INTENT(INOUT) :: SrcLinStateSaveData TYPE(FAST_LinStateSave), INTENT(INOUT) :: DstLinStateSaveData @@ -4646,9649 +3794,6811 @@ SUBROUTINE FAST_DestroyLinStateSave( LinStateSaveData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE FAST_DestroyLinStateSave - SUBROUTINE FAST_PackLinStateSave( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FAST_LinStateSave), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackLinStateSave' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! x_IceD allocated yes/no - IF ( ALLOCATED(InData%x_IceD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! x_IceD upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i2 = LBOUND(InData%x_IceD,2), UBOUND(InData%x_IceD,2) - DO i1 = LBOUND(InData%x_IceD,1), UBOUND(InData%x_IceD,1) - Int_BufSz = Int_BufSz + 3 ! x_IceD: size of buffers for each call to pack subtype - CALL IceD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_IceD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! x_IceD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x_IceD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x_IceD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x_IceD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! xd_IceD allocated yes/no - IF ( ALLOCATED(InData%xd_IceD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! xd_IceD upper/lower bounds for each dimension - DO i2 = LBOUND(InData%xd_IceD,2), UBOUND(InData%xd_IceD,2) - DO i1 = LBOUND(InData%xd_IceD,1), UBOUND(InData%xd_IceD,1) - Int_BufSz = Int_BufSz + 3 ! xd_IceD: size of buffers for each call to pack subtype - CALL IceD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_IceD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! xd_IceD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! xd_IceD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd_IceD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd_IceD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! z_IceD allocated yes/no - IF ( ALLOCATED(InData%z_IceD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! z_IceD upper/lower bounds for each dimension - DO i2 = LBOUND(InData%z_IceD,2), UBOUND(InData%z_IceD,2) - DO i1 = LBOUND(InData%z_IceD,1), UBOUND(InData%z_IceD,1) - Int_BufSz = Int_BufSz + 3 ! z_IceD: size of buffers for each call to pack subtype - CALL IceD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_IceD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! z_IceD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z_IceD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z_IceD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z_IceD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO +subroutine FAST_PackLinStateSave(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FAST_LinStateSave), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackLinStateSave' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + ! x_IceD + call RegPack(Buf, allocated(InData%x_IceD)) + if (allocated(InData%x_IceD)) then + call RegPackBounds(Buf, 2, lbound(InData%x_IceD), ubound(InData%x_IceD)) + LB(1:2) = lbound(InData%x_IceD) + UB(1:2) = ubound(InData%x_IceD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_PackContState(Buf, InData%x_IceD(i1,i2)) + end do + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! xd_IceD + call RegPack(Buf, allocated(InData%xd_IceD)) + if (allocated(InData%xd_IceD)) then + call RegPackBounds(Buf, 2, lbound(InData%xd_IceD), ubound(InData%xd_IceD)) + LB(1:2) = lbound(InData%xd_IceD) + UB(1:2) = ubound(InData%xd_IceD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_PackDiscState(Buf, InData%xd_IceD(i1,i2)) + end do + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! z_IceD + call RegPack(Buf, allocated(InData%z_IceD)) + if (allocated(InData%z_IceD)) then + call RegPackBounds(Buf, 2, lbound(InData%z_IceD), ubound(InData%z_IceD)) + LB(1:2) = lbound(InData%z_IceD) + UB(1:2) = ubound(InData%z_IceD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_PackConstrState(Buf, InData%z_IceD(i1,i2)) + end do + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OtherSt_IceD + call RegPack(Buf, allocated(InData%OtherSt_IceD)) + if (allocated(InData%OtherSt_IceD)) then + call RegPackBounds(Buf, 2, lbound(InData%OtherSt_IceD), ubound(InData%OtherSt_IceD)) + LB(1:2) = lbound(InData%OtherSt_IceD) + UB(1:2) = ubound(InData%OtherSt_IceD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_PackOtherState(Buf, InData%OtherSt_IceD(i1,i2)) + end do + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! u_IceD + call RegPack(Buf, allocated(InData%u_IceD)) + if (allocated(InData%u_IceD)) then + call RegPackBounds(Buf, 2, lbound(InData%u_IceD), ubound(InData%u_IceD)) + LB(1:2) = lbound(InData%u_IceD) + UB(1:2) = ubound(InData%u_IceD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_PackInput(Buf, InData%u_IceD(i1,i2)) + end do + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! x_BD + call RegPack(Buf, allocated(InData%x_BD)) + if (allocated(InData%x_BD)) then + call RegPackBounds(Buf, 2, lbound(InData%x_BD), ubound(InData%x_BD)) + LB(1:2) = lbound(InData%x_BD) + UB(1:2) = ubound(InData%x_BD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_PackContState(Buf, InData%x_BD(i1,i2)) + end do + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! xd_BD + call RegPack(Buf, allocated(InData%xd_BD)) + if (allocated(InData%xd_BD)) then + call RegPackBounds(Buf, 2, lbound(InData%xd_BD), ubound(InData%xd_BD)) + LB(1:2) = lbound(InData%xd_BD) + UB(1:2) = ubound(InData%xd_BD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_PackDiscState(Buf, InData%xd_BD(i1,i2)) + end do + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! z_BD + call RegPack(Buf, allocated(InData%z_BD)) + if (allocated(InData%z_BD)) then + call RegPackBounds(Buf, 2, lbound(InData%z_BD), ubound(InData%z_BD)) + LB(1:2) = lbound(InData%z_BD) + UB(1:2) = ubound(InData%z_BD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_PackConstrState(Buf, InData%z_BD(i1,i2)) + end do + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OtherSt_BD + call RegPack(Buf, allocated(InData%OtherSt_BD)) + if (allocated(InData%OtherSt_BD)) then + call RegPackBounds(Buf, 2, lbound(InData%OtherSt_BD), ubound(InData%OtherSt_BD)) + LB(1:2) = lbound(InData%OtherSt_BD) + UB(1:2) = ubound(InData%OtherSt_BD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_PackOtherState(Buf, InData%OtherSt_BD(i1,i2)) + end do + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! u_BD + call RegPack(Buf, allocated(InData%u_BD)) + if (allocated(InData%u_BD)) then + call RegPackBounds(Buf, 2, lbound(InData%u_BD), ubound(InData%u_BD)) + LB(1:2) = lbound(InData%u_BD) + UB(1:2) = ubound(InData%u_BD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_PackInput(Buf, InData%u_BD(i1,i2)) + end do + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! x_ED + call RegPack(Buf, allocated(InData%x_ED)) + if (allocated(InData%x_ED)) then + call RegPackBounds(Buf, 1, lbound(InData%x_ED), ubound(InData%x_ED)) + LB(1:1) = lbound(InData%x_ED) + UB(1:1) = ubound(InData%x_ED) + do i1 = LB(1), UB(1) + call ED_PackContState(Buf, InData%x_ED(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! xd_ED + call RegPack(Buf, allocated(InData%xd_ED)) + if (allocated(InData%xd_ED)) then + call RegPackBounds(Buf, 1, lbound(InData%xd_ED), ubound(InData%xd_ED)) + LB(1:1) = lbound(InData%xd_ED) + UB(1:1) = ubound(InData%xd_ED) + do i1 = LB(1), UB(1) + call ED_PackDiscState(Buf, InData%xd_ED(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! z_ED + call RegPack(Buf, allocated(InData%z_ED)) + if (allocated(InData%z_ED)) then + call RegPackBounds(Buf, 1, lbound(InData%z_ED), ubound(InData%z_ED)) + LB(1:1) = lbound(InData%z_ED) + UB(1:1) = ubound(InData%z_ED) + do i1 = LB(1), UB(1) + call ED_PackConstrState(Buf, InData%z_ED(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OtherSt_ED + call RegPack(Buf, allocated(InData%OtherSt_ED)) + if (allocated(InData%OtherSt_ED)) then + call RegPackBounds(Buf, 1, lbound(InData%OtherSt_ED), ubound(InData%OtherSt_ED)) + LB(1:1) = lbound(InData%OtherSt_ED) + UB(1:1) = ubound(InData%OtherSt_ED) + do i1 = LB(1), UB(1) + call ED_PackOtherState(Buf, InData%OtherSt_ED(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! u_ED + call RegPack(Buf, allocated(InData%u_ED)) + if (allocated(InData%u_ED)) then + call RegPackBounds(Buf, 1, lbound(InData%u_ED), ubound(InData%u_ED)) + LB(1:1) = lbound(InData%u_ED) + UB(1:1) = ubound(InData%u_ED) + do i1 = LB(1), UB(1) + call ED_PackInput(Buf, InData%u_ED(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! x_SrvD + call RegPack(Buf, allocated(InData%x_SrvD)) + if (allocated(InData%x_SrvD)) then + call RegPackBounds(Buf, 1, lbound(InData%x_SrvD), ubound(InData%x_SrvD)) + LB(1:1) = lbound(InData%x_SrvD) + UB(1:1) = ubound(InData%x_SrvD) + do i1 = LB(1), UB(1) + call SrvD_PackContState(Buf, InData%x_SrvD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! xd_SrvD + call RegPack(Buf, allocated(InData%xd_SrvD)) + if (allocated(InData%xd_SrvD)) then + call RegPackBounds(Buf, 1, lbound(InData%xd_SrvD), ubound(InData%xd_SrvD)) + LB(1:1) = lbound(InData%xd_SrvD) + UB(1:1) = ubound(InData%xd_SrvD) + do i1 = LB(1), UB(1) + call SrvD_PackDiscState(Buf, InData%xd_SrvD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! z_SrvD + call RegPack(Buf, allocated(InData%z_SrvD)) + if (allocated(InData%z_SrvD)) then + call RegPackBounds(Buf, 1, lbound(InData%z_SrvD), ubound(InData%z_SrvD)) + LB(1:1) = lbound(InData%z_SrvD) + UB(1:1) = ubound(InData%z_SrvD) + do i1 = LB(1), UB(1) + call SrvD_PackConstrState(Buf, InData%z_SrvD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OtherSt_SrvD + call RegPack(Buf, allocated(InData%OtherSt_SrvD)) + if (allocated(InData%OtherSt_SrvD)) then + call RegPackBounds(Buf, 1, lbound(InData%OtherSt_SrvD), ubound(InData%OtherSt_SrvD)) + LB(1:1) = lbound(InData%OtherSt_SrvD) + UB(1:1) = ubound(InData%OtherSt_SrvD) + do i1 = LB(1), UB(1) + call SrvD_PackOtherState(Buf, InData%OtherSt_SrvD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! u_SrvD + call RegPack(Buf, allocated(InData%u_SrvD)) + if (allocated(InData%u_SrvD)) then + call RegPackBounds(Buf, 1, lbound(InData%u_SrvD), ubound(InData%u_SrvD)) + LB(1:1) = lbound(InData%u_SrvD) + UB(1:1) = ubound(InData%u_SrvD) + do i1 = LB(1), UB(1) + call SrvD_PackInput(Buf, InData%u_SrvD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! x_AD + call RegPack(Buf, allocated(InData%x_AD)) + if (allocated(InData%x_AD)) then + call RegPackBounds(Buf, 1, lbound(InData%x_AD), ubound(InData%x_AD)) + LB(1:1) = lbound(InData%x_AD) + UB(1:1) = ubound(InData%x_AD) + do i1 = LB(1), UB(1) + call AD_PackContState(Buf, InData%x_AD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! xd_AD + call RegPack(Buf, allocated(InData%xd_AD)) + if (allocated(InData%xd_AD)) then + call RegPackBounds(Buf, 1, lbound(InData%xd_AD), ubound(InData%xd_AD)) + LB(1:1) = lbound(InData%xd_AD) + UB(1:1) = ubound(InData%xd_AD) + do i1 = LB(1), UB(1) + call AD_PackDiscState(Buf, InData%xd_AD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! z_AD + call RegPack(Buf, allocated(InData%z_AD)) + if (allocated(InData%z_AD)) then + call RegPackBounds(Buf, 1, lbound(InData%z_AD), ubound(InData%z_AD)) + LB(1:1) = lbound(InData%z_AD) + UB(1:1) = ubound(InData%z_AD) + do i1 = LB(1), UB(1) + call AD_PackConstrState(Buf, InData%z_AD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OtherSt_AD + call RegPack(Buf, allocated(InData%OtherSt_AD)) + if (allocated(InData%OtherSt_AD)) then + call RegPackBounds(Buf, 1, lbound(InData%OtherSt_AD), ubound(InData%OtherSt_AD)) + LB(1:1) = lbound(InData%OtherSt_AD) + UB(1:1) = ubound(InData%OtherSt_AD) + do i1 = LB(1), UB(1) + call AD_PackOtherState(Buf, InData%OtherSt_AD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! u_AD + call RegPack(Buf, allocated(InData%u_AD)) + if (allocated(InData%u_AD)) then + call RegPackBounds(Buf, 1, lbound(InData%u_AD), ubound(InData%u_AD)) + LB(1:1) = lbound(InData%u_AD) + UB(1:1) = ubound(InData%u_AD) + do i1 = LB(1), UB(1) + call AD_PackInput(Buf, InData%u_AD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! x_IfW + call RegPack(Buf, allocated(InData%x_IfW)) + if (allocated(InData%x_IfW)) then + call RegPackBounds(Buf, 1, lbound(InData%x_IfW), ubound(InData%x_IfW)) + LB(1:1) = lbound(InData%x_IfW) + UB(1:1) = ubound(InData%x_IfW) + do i1 = LB(1), UB(1) + call InflowWind_PackContState(Buf, InData%x_IfW(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! xd_IfW + call RegPack(Buf, allocated(InData%xd_IfW)) + if (allocated(InData%xd_IfW)) then + call RegPackBounds(Buf, 1, lbound(InData%xd_IfW), ubound(InData%xd_IfW)) + LB(1:1) = lbound(InData%xd_IfW) + UB(1:1) = ubound(InData%xd_IfW) + do i1 = LB(1), UB(1) + call InflowWind_PackDiscState(Buf, InData%xd_IfW(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! z_IfW + call RegPack(Buf, allocated(InData%z_IfW)) + if (allocated(InData%z_IfW)) then + call RegPackBounds(Buf, 1, lbound(InData%z_IfW), ubound(InData%z_IfW)) + LB(1:1) = lbound(InData%z_IfW) + UB(1:1) = ubound(InData%z_IfW) + do i1 = LB(1), UB(1) + call InflowWind_PackConstrState(Buf, InData%z_IfW(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OtherSt_IfW + call RegPack(Buf, allocated(InData%OtherSt_IfW)) + if (allocated(InData%OtherSt_IfW)) then + call RegPackBounds(Buf, 1, lbound(InData%OtherSt_IfW), ubound(InData%OtherSt_IfW)) + LB(1:1) = lbound(InData%OtherSt_IfW) + UB(1:1) = ubound(InData%OtherSt_IfW) + do i1 = LB(1), UB(1) + call InflowWind_PackOtherState(Buf, InData%OtherSt_IfW(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! u_IfW + call RegPack(Buf, allocated(InData%u_IfW)) + if (allocated(InData%u_IfW)) then + call RegPackBounds(Buf, 1, lbound(InData%u_IfW), ubound(InData%u_IfW)) + LB(1:1) = lbound(InData%u_IfW) + UB(1:1) = ubound(InData%u_IfW) + do i1 = LB(1), UB(1) + call InflowWind_PackInput(Buf, InData%u_IfW(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! x_SD + call RegPack(Buf, allocated(InData%x_SD)) + if (allocated(InData%x_SD)) then + call RegPackBounds(Buf, 1, lbound(InData%x_SD), ubound(InData%x_SD)) + LB(1:1) = lbound(InData%x_SD) + UB(1:1) = ubound(InData%x_SD) + do i1 = LB(1), UB(1) + call SD_PackContState(Buf, InData%x_SD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! xd_SD + call RegPack(Buf, allocated(InData%xd_SD)) + if (allocated(InData%xd_SD)) then + call RegPackBounds(Buf, 1, lbound(InData%xd_SD), ubound(InData%xd_SD)) + LB(1:1) = lbound(InData%xd_SD) + UB(1:1) = ubound(InData%xd_SD) + do i1 = LB(1), UB(1) + call SD_PackDiscState(Buf, InData%xd_SD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! z_SD + call RegPack(Buf, allocated(InData%z_SD)) + if (allocated(InData%z_SD)) then + call RegPackBounds(Buf, 1, lbound(InData%z_SD), ubound(InData%z_SD)) + LB(1:1) = lbound(InData%z_SD) + UB(1:1) = ubound(InData%z_SD) + do i1 = LB(1), UB(1) + call SD_PackConstrState(Buf, InData%z_SD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OtherSt_SD + call RegPack(Buf, allocated(InData%OtherSt_SD)) + if (allocated(InData%OtherSt_SD)) then + call RegPackBounds(Buf, 1, lbound(InData%OtherSt_SD), ubound(InData%OtherSt_SD)) + LB(1:1) = lbound(InData%OtherSt_SD) + UB(1:1) = ubound(InData%OtherSt_SD) + do i1 = LB(1), UB(1) + call SD_PackOtherState(Buf, InData%OtherSt_SD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! u_SD + call RegPack(Buf, allocated(InData%u_SD)) + if (allocated(InData%u_SD)) then + call RegPackBounds(Buf, 1, lbound(InData%u_SD), ubound(InData%u_SD)) + LB(1:1) = lbound(InData%u_SD) + UB(1:1) = ubound(InData%u_SD) + do i1 = LB(1), UB(1) + call SD_PackInput(Buf, InData%u_SD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! x_ExtPtfm + call RegPack(Buf, allocated(InData%x_ExtPtfm)) + if (allocated(InData%x_ExtPtfm)) then + call RegPackBounds(Buf, 1, lbound(InData%x_ExtPtfm), ubound(InData%x_ExtPtfm)) + LB(1:1) = lbound(InData%x_ExtPtfm) + UB(1:1) = ubound(InData%x_ExtPtfm) + do i1 = LB(1), UB(1) + call ExtPtfm_PackContState(Buf, InData%x_ExtPtfm(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! xd_ExtPtfm + call RegPack(Buf, allocated(InData%xd_ExtPtfm)) + if (allocated(InData%xd_ExtPtfm)) then + call RegPackBounds(Buf, 1, lbound(InData%xd_ExtPtfm), ubound(InData%xd_ExtPtfm)) + LB(1:1) = lbound(InData%xd_ExtPtfm) + UB(1:1) = ubound(InData%xd_ExtPtfm) + do i1 = LB(1), UB(1) + call ExtPtfm_PackDiscState(Buf, InData%xd_ExtPtfm(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! z_ExtPtfm + call RegPack(Buf, allocated(InData%z_ExtPtfm)) + if (allocated(InData%z_ExtPtfm)) then + call RegPackBounds(Buf, 1, lbound(InData%z_ExtPtfm), ubound(InData%z_ExtPtfm)) + LB(1:1) = lbound(InData%z_ExtPtfm) + UB(1:1) = ubound(InData%z_ExtPtfm) + do i1 = LB(1), UB(1) + call ExtPtfm_PackConstrState(Buf, InData%z_ExtPtfm(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OtherSt_ExtPtfm + call RegPack(Buf, allocated(InData%OtherSt_ExtPtfm)) + if (allocated(InData%OtherSt_ExtPtfm)) then + call RegPackBounds(Buf, 1, lbound(InData%OtherSt_ExtPtfm), ubound(InData%OtherSt_ExtPtfm)) + LB(1:1) = lbound(InData%OtherSt_ExtPtfm) + UB(1:1) = ubound(InData%OtherSt_ExtPtfm) + do i1 = LB(1), UB(1) + call ExtPtfm_PackOtherState(Buf, InData%OtherSt_ExtPtfm(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! u_ExtPtfm + call RegPack(Buf, allocated(InData%u_ExtPtfm)) + if (allocated(InData%u_ExtPtfm)) then + call RegPackBounds(Buf, 1, lbound(InData%u_ExtPtfm), ubound(InData%u_ExtPtfm)) + LB(1:1) = lbound(InData%u_ExtPtfm) + UB(1:1) = ubound(InData%u_ExtPtfm) + do i1 = LB(1), UB(1) + call ExtPtfm_PackInput(Buf, InData%u_ExtPtfm(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! x_HD + call RegPack(Buf, allocated(InData%x_HD)) + if (allocated(InData%x_HD)) then + call RegPackBounds(Buf, 1, lbound(InData%x_HD), ubound(InData%x_HD)) + LB(1:1) = lbound(InData%x_HD) + UB(1:1) = ubound(InData%x_HD) + do i1 = LB(1), UB(1) + call HydroDyn_PackContState(Buf, InData%x_HD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! xd_HD + call RegPack(Buf, allocated(InData%xd_HD)) + if (allocated(InData%xd_HD)) then + call RegPackBounds(Buf, 1, lbound(InData%xd_HD), ubound(InData%xd_HD)) + LB(1:1) = lbound(InData%xd_HD) + UB(1:1) = ubound(InData%xd_HD) + do i1 = LB(1), UB(1) + call HydroDyn_PackDiscState(Buf, InData%xd_HD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! z_HD + call RegPack(Buf, allocated(InData%z_HD)) + if (allocated(InData%z_HD)) then + call RegPackBounds(Buf, 1, lbound(InData%z_HD), ubound(InData%z_HD)) + LB(1:1) = lbound(InData%z_HD) + UB(1:1) = ubound(InData%z_HD) + do i1 = LB(1), UB(1) + call HydroDyn_PackConstrState(Buf, InData%z_HD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OtherSt_HD + call RegPack(Buf, allocated(InData%OtherSt_HD)) + if (allocated(InData%OtherSt_HD)) then + call RegPackBounds(Buf, 1, lbound(InData%OtherSt_HD), ubound(InData%OtherSt_HD)) + LB(1:1) = lbound(InData%OtherSt_HD) + UB(1:1) = ubound(InData%OtherSt_HD) + do i1 = LB(1), UB(1) + call HydroDyn_PackOtherState(Buf, InData%OtherSt_HD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! u_HD + call RegPack(Buf, allocated(InData%u_HD)) + if (allocated(InData%u_HD)) then + call RegPackBounds(Buf, 1, lbound(InData%u_HD), ubound(InData%u_HD)) + LB(1:1) = lbound(InData%u_HD) + UB(1:1) = ubound(InData%u_HD) + do i1 = LB(1), UB(1) + call HydroDyn_PackInput(Buf, InData%u_HD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! x_IceF + call RegPack(Buf, allocated(InData%x_IceF)) + if (allocated(InData%x_IceF)) then + call RegPackBounds(Buf, 1, lbound(InData%x_IceF), ubound(InData%x_IceF)) + LB(1:1) = lbound(InData%x_IceF) + UB(1:1) = ubound(InData%x_IceF) + do i1 = LB(1), UB(1) + call IceFloe_PackContState(Buf, InData%x_IceF(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! xd_IceF + call RegPack(Buf, allocated(InData%xd_IceF)) + if (allocated(InData%xd_IceF)) then + call RegPackBounds(Buf, 1, lbound(InData%xd_IceF), ubound(InData%xd_IceF)) + LB(1:1) = lbound(InData%xd_IceF) + UB(1:1) = ubound(InData%xd_IceF) + do i1 = LB(1), UB(1) + call IceFloe_PackDiscState(Buf, InData%xd_IceF(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! z_IceF + call RegPack(Buf, allocated(InData%z_IceF)) + if (allocated(InData%z_IceF)) then + call RegPackBounds(Buf, 1, lbound(InData%z_IceF), ubound(InData%z_IceF)) + LB(1:1) = lbound(InData%z_IceF) + UB(1:1) = ubound(InData%z_IceF) + do i1 = LB(1), UB(1) + call IceFloe_PackConstrState(Buf, InData%z_IceF(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OtherSt_IceF + call RegPack(Buf, allocated(InData%OtherSt_IceF)) + if (allocated(InData%OtherSt_IceF)) then + call RegPackBounds(Buf, 1, lbound(InData%OtherSt_IceF), ubound(InData%OtherSt_IceF)) + LB(1:1) = lbound(InData%OtherSt_IceF) + UB(1:1) = ubound(InData%OtherSt_IceF) + do i1 = LB(1), UB(1) + call IceFloe_PackOtherState(Buf, InData%OtherSt_IceF(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! u_IceF + call RegPack(Buf, allocated(InData%u_IceF)) + if (allocated(InData%u_IceF)) then + call RegPackBounds(Buf, 1, lbound(InData%u_IceF), ubound(InData%u_IceF)) + LB(1:1) = lbound(InData%u_IceF) + UB(1:1) = ubound(InData%u_IceF) + do i1 = LB(1), UB(1) + call IceFloe_PackInput(Buf, InData%u_IceF(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! x_MAP + call RegPack(Buf, allocated(InData%x_MAP)) + if (allocated(InData%x_MAP)) then + call RegPackBounds(Buf, 1, lbound(InData%x_MAP), ubound(InData%x_MAP)) + LB(1:1) = lbound(InData%x_MAP) + UB(1:1) = ubound(InData%x_MAP) + do i1 = LB(1), UB(1) + call MAP_PackContState(Buf, InData%x_MAP(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! xd_MAP + call RegPack(Buf, allocated(InData%xd_MAP)) + if (allocated(InData%xd_MAP)) then + call RegPackBounds(Buf, 1, lbound(InData%xd_MAP), ubound(InData%xd_MAP)) + LB(1:1) = lbound(InData%xd_MAP) + UB(1:1) = ubound(InData%xd_MAP) + do i1 = LB(1), UB(1) + call MAP_PackDiscState(Buf, InData%xd_MAP(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! z_MAP + call RegPack(Buf, allocated(InData%z_MAP)) + if (allocated(InData%z_MAP)) then + call RegPackBounds(Buf, 1, lbound(InData%z_MAP), ubound(InData%z_MAP)) + LB(1:1) = lbound(InData%z_MAP) + UB(1:1) = ubound(InData%z_MAP) + do i1 = LB(1), UB(1) + call MAP_PackConstrState(Buf, InData%z_MAP(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! u_MAP + call RegPack(Buf, allocated(InData%u_MAP)) + if (allocated(InData%u_MAP)) then + call RegPackBounds(Buf, 1, lbound(InData%u_MAP), ubound(InData%u_MAP)) + LB(1:1) = lbound(InData%u_MAP) + UB(1:1) = ubound(InData%u_MAP) + do i1 = LB(1), UB(1) + call MAP_PackInput(Buf, InData%u_MAP(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! x_FEAM + call RegPack(Buf, allocated(InData%x_FEAM)) + if (allocated(InData%x_FEAM)) then + call RegPackBounds(Buf, 1, lbound(InData%x_FEAM), ubound(InData%x_FEAM)) + LB(1:1) = lbound(InData%x_FEAM) + UB(1:1) = ubound(InData%x_FEAM) + do i1 = LB(1), UB(1) + call FEAM_PackContState(Buf, InData%x_FEAM(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! xd_FEAM + call RegPack(Buf, allocated(InData%xd_FEAM)) + if (allocated(InData%xd_FEAM)) then + call RegPackBounds(Buf, 1, lbound(InData%xd_FEAM), ubound(InData%xd_FEAM)) + LB(1:1) = lbound(InData%xd_FEAM) + UB(1:1) = ubound(InData%xd_FEAM) + do i1 = LB(1), UB(1) + call FEAM_PackDiscState(Buf, InData%xd_FEAM(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! z_FEAM + call RegPack(Buf, allocated(InData%z_FEAM)) + if (allocated(InData%z_FEAM)) then + call RegPackBounds(Buf, 1, lbound(InData%z_FEAM), ubound(InData%z_FEAM)) + LB(1:1) = lbound(InData%z_FEAM) + UB(1:1) = ubound(InData%z_FEAM) + do i1 = LB(1), UB(1) + call FEAM_PackConstrState(Buf, InData%z_FEAM(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OtherSt_FEAM + call RegPack(Buf, allocated(InData%OtherSt_FEAM)) + if (allocated(InData%OtherSt_FEAM)) then + call RegPackBounds(Buf, 1, lbound(InData%OtherSt_FEAM), ubound(InData%OtherSt_FEAM)) + LB(1:1) = lbound(InData%OtherSt_FEAM) + UB(1:1) = ubound(InData%OtherSt_FEAM) + do i1 = LB(1), UB(1) + call FEAM_PackOtherState(Buf, InData%OtherSt_FEAM(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! u_FEAM + call RegPack(Buf, allocated(InData%u_FEAM)) + if (allocated(InData%u_FEAM)) then + call RegPackBounds(Buf, 1, lbound(InData%u_FEAM), ubound(InData%u_FEAM)) + LB(1:1) = lbound(InData%u_FEAM) + UB(1:1) = ubound(InData%u_FEAM) + do i1 = LB(1), UB(1) + call FEAM_PackInput(Buf, InData%u_FEAM(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! x_MD + call RegPack(Buf, allocated(InData%x_MD)) + if (allocated(InData%x_MD)) then + call RegPackBounds(Buf, 1, lbound(InData%x_MD), ubound(InData%x_MD)) + LB(1:1) = lbound(InData%x_MD) + UB(1:1) = ubound(InData%x_MD) + do i1 = LB(1), UB(1) + call MD_PackContState(Buf, InData%x_MD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! xd_MD + call RegPack(Buf, allocated(InData%xd_MD)) + if (allocated(InData%xd_MD)) then + call RegPackBounds(Buf, 1, lbound(InData%xd_MD), ubound(InData%xd_MD)) + LB(1:1) = lbound(InData%xd_MD) + UB(1:1) = ubound(InData%xd_MD) + do i1 = LB(1), UB(1) + call MD_PackDiscState(Buf, InData%xd_MD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! z_MD + call RegPack(Buf, allocated(InData%z_MD)) + if (allocated(InData%z_MD)) then + call RegPackBounds(Buf, 1, lbound(InData%z_MD), ubound(InData%z_MD)) + LB(1:1) = lbound(InData%z_MD) + UB(1:1) = ubound(InData%z_MD) + do i1 = LB(1), UB(1) + call MD_PackConstrState(Buf, InData%z_MD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OtherSt_MD + call RegPack(Buf, allocated(InData%OtherSt_MD)) + if (allocated(InData%OtherSt_MD)) then + call RegPackBounds(Buf, 1, lbound(InData%OtherSt_MD), ubound(InData%OtherSt_MD)) + LB(1:1) = lbound(InData%OtherSt_MD) + UB(1:1) = ubound(InData%OtherSt_MD) + do i1 = LB(1), UB(1) + call MD_PackOtherState(Buf, InData%OtherSt_MD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! u_MD + call RegPack(Buf, allocated(InData%u_MD)) + if (allocated(InData%u_MD)) then + call RegPackBounds(Buf, 1, lbound(InData%u_MD), ubound(InData%u_MD)) + LB(1:1) = lbound(InData%u_MD) + UB(1:1) = ubound(InData%u_MD) + do i1 = LB(1), UB(1) + call MD_PackInput(Buf, InData%u_MD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackLinStateSave(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FAST_LinStateSave), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackLinStateSave' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! x_IceD + if (allocated(OutData%x_IceD)) deallocate(OutData%x_IceD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_IceD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_IceD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_UnpackContState(Buf, OutData%x_IceD(i1,i2)) ! x_IceD + end do + end do + end if + ! xd_IceD + if (allocated(OutData%xd_IceD)) deallocate(OutData%xd_IceD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xd_IceD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_IceD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_UnpackDiscState(Buf, OutData%xd_IceD(i1,i2)) ! xd_IceD + end do + end do + end if + ! z_IceD + if (allocated(OutData%z_IceD)) deallocate(OutData%z_IceD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z_IceD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_IceD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_UnpackConstrState(Buf, OutData%z_IceD(i1,i2)) ! z_IceD + end do + end do + end if + ! OtherSt_IceD + if (allocated(OutData%OtherSt_IceD)) deallocate(OutData%OtherSt_IceD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OtherSt_IceD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_IceD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_UnpackOtherState(Buf, OutData%OtherSt_IceD(i1,i2)) ! OtherSt_IceD + end do + end do + end if + ! u_IceD + if (allocated(OutData%u_IceD)) deallocate(OutData%u_IceD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_IceD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_IceD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_UnpackInput(Buf, OutData%u_IceD(i1,i2)) ! u_IceD + end do + end do + end if + ! x_BD + if (allocated(OutData%x_BD)) deallocate(OutData%x_BD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_BD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_BD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_UnpackContState(Buf, OutData%x_BD(i1,i2)) ! x_BD + end do + end do + end if + ! xd_BD + if (allocated(OutData%xd_BD)) deallocate(OutData%xd_BD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xd_BD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_BD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_UnpackDiscState(Buf, OutData%xd_BD(i1,i2)) ! xd_BD + end do + end do + end if + ! z_BD + if (allocated(OutData%z_BD)) deallocate(OutData%z_BD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z_BD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_BD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_UnpackConstrState(Buf, OutData%z_BD(i1,i2)) ! z_BD + end do + end do + end if + ! OtherSt_BD + if (allocated(OutData%OtherSt_BD)) deallocate(OutData%OtherSt_BD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OtherSt_BD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_BD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_UnpackOtherState(Buf, OutData%OtherSt_BD(i1,i2)) ! OtherSt_BD + end do + end do + end if + ! u_BD + if (allocated(OutData%u_BD)) deallocate(OutData%u_BD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_BD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_UnpackInput(Buf, OutData%u_BD(i1,i2)) ! u_BD + end do + end do + end if + ! x_ED + if (allocated(OutData%x_ED)) deallocate(OutData%x_ED) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_ED(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_ED.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ED_UnpackContState(Buf, OutData%x_ED(i1)) ! x_ED + end do + end if + ! xd_ED + if (allocated(OutData%xd_ED)) deallocate(OutData%xd_ED) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xd_ED(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_ED.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ED_UnpackDiscState(Buf, OutData%xd_ED(i1)) ! xd_ED + end do + end if + ! z_ED + if (allocated(OutData%z_ED)) deallocate(OutData%z_ED) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z_ED(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_ED.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ED_UnpackConstrState(Buf, OutData%z_ED(i1)) ! z_ED + end do + end if + ! OtherSt_ED + if (allocated(OutData%OtherSt_ED)) deallocate(OutData%OtherSt_ED) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OtherSt_ED(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_ED.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ED_UnpackOtherState(Buf, OutData%OtherSt_ED(i1)) ! OtherSt_ED + end do + end if + ! u_ED + if (allocated(OutData%u_ED)) deallocate(OutData%u_ED) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_ED(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_ED.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ED_UnpackInput(Buf, OutData%u_ED(i1)) ! u_ED + end do + end if + ! x_SrvD + if (allocated(OutData%x_SrvD)) deallocate(OutData%x_SrvD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_SrvD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_SrvD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SrvD_UnpackContState(Buf, OutData%x_SrvD(i1)) ! x_SrvD + end do + end if + ! xd_SrvD + if (allocated(OutData%xd_SrvD)) deallocate(OutData%xd_SrvD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xd_SrvD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_SrvD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SrvD_UnpackDiscState(Buf, OutData%xd_SrvD(i1)) ! xd_SrvD + end do + end if + ! z_SrvD + if (allocated(OutData%z_SrvD)) deallocate(OutData%z_SrvD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z_SrvD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_SrvD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SrvD_UnpackConstrState(Buf, OutData%z_SrvD(i1)) ! z_SrvD + end do + end if + ! OtherSt_SrvD + if (allocated(OutData%OtherSt_SrvD)) deallocate(OutData%OtherSt_SrvD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OtherSt_SrvD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_SrvD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SrvD_UnpackOtherState(Buf, OutData%OtherSt_SrvD(i1)) ! OtherSt_SrvD + end do + end if + ! u_SrvD + if (allocated(OutData%u_SrvD)) deallocate(OutData%u_SrvD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_SrvD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SrvD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SrvD_UnpackInput(Buf, OutData%u_SrvD(i1)) ! u_SrvD + end do + end if + ! x_AD + if (allocated(OutData%x_AD)) deallocate(OutData%x_AD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_AD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_AD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackContState(Buf, OutData%x_AD(i1)) ! x_AD + end do + end if + ! xd_AD + if (allocated(OutData%xd_AD)) deallocate(OutData%xd_AD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xd_AD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_AD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackDiscState(Buf, OutData%xd_AD(i1)) ! xd_AD + end do + end if + ! z_AD + if (allocated(OutData%z_AD)) deallocate(OutData%z_AD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z_AD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_AD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackConstrState(Buf, OutData%z_AD(i1)) ! z_AD + end do + end if + ! OtherSt_AD + if (allocated(OutData%OtherSt_AD)) deallocate(OutData%OtherSt_AD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OtherSt_AD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_AD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackOtherState(Buf, OutData%OtherSt_AD(i1)) ! OtherSt_AD + end do + end if + ! u_AD + if (allocated(OutData%u_AD)) deallocate(OutData%u_AD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_AD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_AD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackInput(Buf, OutData%u_AD(i1)) ! u_AD + end do + end if + ! x_IfW + if (allocated(OutData%x_IfW)) deallocate(OutData%x_IfW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_IfW(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_IfW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackContState(Buf, OutData%x_IfW(i1)) ! x_IfW + end do + end if + ! xd_IfW + if (allocated(OutData%xd_IfW)) deallocate(OutData%xd_IfW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xd_IfW(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_IfW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackDiscState(Buf, OutData%xd_IfW(i1)) ! xd_IfW + end do + end if + ! z_IfW + if (allocated(OutData%z_IfW)) deallocate(OutData%z_IfW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z_IfW(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_IfW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackConstrState(Buf, OutData%z_IfW(i1)) ! z_IfW + end do + end if + ! OtherSt_IfW + if (allocated(OutData%OtherSt_IfW)) deallocate(OutData%OtherSt_IfW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OtherSt_IfW(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_IfW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackOtherState(Buf, OutData%OtherSt_IfW(i1)) ! OtherSt_IfW + end do + end if + ! u_IfW + if (allocated(OutData%u_IfW)) deallocate(OutData%u_IfW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_IfW(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_IfW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackInput(Buf, OutData%u_IfW(i1)) ! u_IfW + end do + end if + ! x_SD + if (allocated(OutData%x_SD)) deallocate(OutData%x_SD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_SD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_SD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackContState(Buf, OutData%x_SD(i1)) ! x_SD + end do + end if + ! xd_SD + if (allocated(OutData%xd_SD)) deallocate(OutData%xd_SD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xd_SD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_SD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackDiscState(Buf, OutData%xd_SD(i1)) ! xd_SD + end do + end if + ! z_SD + if (allocated(OutData%z_SD)) deallocate(OutData%z_SD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z_SD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_SD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackConstrState(Buf, OutData%z_SD(i1)) ! z_SD + end do + end if + ! OtherSt_SD + if (allocated(OutData%OtherSt_SD)) deallocate(OutData%OtherSt_SD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OtherSt_SD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_SD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackOtherState(Buf, OutData%OtherSt_SD(i1)) ! OtherSt_SD + end do + end if + ! u_SD + if (allocated(OutData%u_SD)) deallocate(OutData%u_SD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_SD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackInput(Buf, OutData%u_SD(i1)) ! u_SD + end do + end if + ! x_ExtPtfm + if (allocated(OutData%x_ExtPtfm)) deallocate(OutData%x_ExtPtfm) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_ExtPtfm(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_ExtPtfm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ExtPtfm_UnpackContState(Buf, OutData%x_ExtPtfm(i1)) ! x_ExtPtfm + end do + end if + ! xd_ExtPtfm + if (allocated(OutData%xd_ExtPtfm)) deallocate(OutData%xd_ExtPtfm) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xd_ExtPtfm(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_ExtPtfm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ExtPtfm_UnpackDiscState(Buf, OutData%xd_ExtPtfm(i1)) ! xd_ExtPtfm + end do + end if + ! z_ExtPtfm + if (allocated(OutData%z_ExtPtfm)) deallocate(OutData%z_ExtPtfm) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z_ExtPtfm(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_ExtPtfm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ExtPtfm_UnpackConstrState(Buf, OutData%z_ExtPtfm(i1)) ! z_ExtPtfm + end do + end if + ! OtherSt_ExtPtfm + if (allocated(OutData%OtherSt_ExtPtfm)) deallocate(OutData%OtherSt_ExtPtfm) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OtherSt_ExtPtfm(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_ExtPtfm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ExtPtfm_UnpackOtherState(Buf, OutData%OtherSt_ExtPtfm(i1)) ! OtherSt_ExtPtfm + end do + end if + ! u_ExtPtfm + if (allocated(OutData%u_ExtPtfm)) deallocate(OutData%u_ExtPtfm) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_ExtPtfm(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_ExtPtfm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ExtPtfm_UnpackInput(Buf, OutData%u_ExtPtfm(i1)) ! u_ExtPtfm + end do + end if + ! x_HD + if (allocated(OutData%x_HD)) deallocate(OutData%x_HD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_HD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_HD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call HydroDyn_UnpackContState(Buf, OutData%x_HD(i1)) ! x_HD + end do + end if + ! xd_HD + if (allocated(OutData%xd_HD)) deallocate(OutData%xd_HD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xd_HD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_HD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call HydroDyn_UnpackDiscState(Buf, OutData%xd_HD(i1)) ! xd_HD + end do + end if + ! z_HD + if (allocated(OutData%z_HD)) deallocate(OutData%z_HD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z_HD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_HD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call HydroDyn_UnpackConstrState(Buf, OutData%z_HD(i1)) ! z_HD + end do + end if + ! OtherSt_HD + if (allocated(OutData%OtherSt_HD)) deallocate(OutData%OtherSt_HD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OtherSt_HD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_HD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call HydroDyn_UnpackOtherState(Buf, OutData%OtherSt_HD(i1)) ! OtherSt_HD + end do + end if + ! u_HD + if (allocated(OutData%u_HD)) deallocate(OutData%u_HD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_HD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_HD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call HydroDyn_UnpackInput(Buf, OutData%u_HD(i1)) ! u_HD + end do + end if + ! x_IceF + if (allocated(OutData%x_IceF)) deallocate(OutData%x_IceF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_IceF(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_IceF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceFloe_UnpackContState(Buf, OutData%x_IceF(i1)) ! x_IceF + end do + end if + ! xd_IceF + if (allocated(OutData%xd_IceF)) deallocate(OutData%xd_IceF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xd_IceF(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_IceF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceFloe_UnpackDiscState(Buf, OutData%xd_IceF(i1)) ! xd_IceF + end do + end if + ! z_IceF + if (allocated(OutData%z_IceF)) deallocate(OutData%z_IceF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z_IceF(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_IceF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceFloe_UnpackConstrState(Buf, OutData%z_IceF(i1)) ! z_IceF + end do + end if + ! OtherSt_IceF + if (allocated(OutData%OtherSt_IceF)) deallocate(OutData%OtherSt_IceF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OtherSt_IceF(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_IceF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceFloe_UnpackOtherState(Buf, OutData%OtherSt_IceF(i1)) ! OtherSt_IceF + end do + end if + ! u_IceF + if (allocated(OutData%u_IceF)) deallocate(OutData%u_IceF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_IceF(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_IceF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceFloe_UnpackInput(Buf, OutData%u_IceF(i1)) ! u_IceF + end do + end if + ! x_MAP + if (allocated(OutData%x_MAP)) deallocate(OutData%x_MAP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_MAP(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_MAP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MAP_UnpackContState(Buf, OutData%x_MAP(i1)) ! x_MAP + end do + end if + ! xd_MAP + if (allocated(OutData%xd_MAP)) deallocate(OutData%xd_MAP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xd_MAP(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_MAP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MAP_UnpackDiscState(Buf, OutData%xd_MAP(i1)) ! xd_MAP + end do + end if + ! z_MAP + if (allocated(OutData%z_MAP)) deallocate(OutData%z_MAP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z_MAP(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_MAP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MAP_UnpackConstrState(Buf, OutData%z_MAP(i1)) ! z_MAP + end do + end if + ! u_MAP + if (allocated(OutData%u_MAP)) deallocate(OutData%u_MAP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_MAP(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_MAP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MAP_UnpackInput(Buf, OutData%u_MAP(i1)) ! u_MAP + end do + end if + ! x_FEAM + if (allocated(OutData%x_FEAM)) deallocate(OutData%x_FEAM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_FEAM(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_FEAM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FEAM_UnpackContState(Buf, OutData%x_FEAM(i1)) ! x_FEAM + end do + end if + ! xd_FEAM + if (allocated(OutData%xd_FEAM)) deallocate(OutData%xd_FEAM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xd_FEAM(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_FEAM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FEAM_UnpackDiscState(Buf, OutData%xd_FEAM(i1)) ! xd_FEAM + end do + end if + ! z_FEAM + if (allocated(OutData%z_FEAM)) deallocate(OutData%z_FEAM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z_FEAM(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_FEAM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FEAM_UnpackConstrState(Buf, OutData%z_FEAM(i1)) ! z_FEAM + end do + end if + ! OtherSt_FEAM + if (allocated(OutData%OtherSt_FEAM)) deallocate(OutData%OtherSt_FEAM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OtherSt_FEAM(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_FEAM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FEAM_UnpackOtherState(Buf, OutData%OtherSt_FEAM(i1)) ! OtherSt_FEAM + end do + end if + ! u_FEAM + if (allocated(OutData%u_FEAM)) deallocate(OutData%u_FEAM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_FEAM(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_FEAM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FEAM_UnpackInput(Buf, OutData%u_FEAM(i1)) ! u_FEAM + end do + end if + ! x_MD + if (allocated(OutData%x_MD)) deallocate(OutData%x_MD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_MD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_MD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackContState(Buf, OutData%x_MD(i1)) ! x_MD + end do + end if + ! xd_MD + if (allocated(OutData%xd_MD)) deallocate(OutData%xd_MD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xd_MD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_MD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackDiscState(Buf, OutData%xd_MD(i1)) ! xd_MD + end do + end if + ! z_MD + if (allocated(OutData%z_MD)) deallocate(OutData%z_MD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z_MD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_MD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackConstrState(Buf, OutData%z_MD(i1)) ! z_MD + end do + end if + ! OtherSt_MD + if (allocated(OutData%OtherSt_MD)) deallocate(OutData%OtherSt_MD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OtherSt_MD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_MD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackOtherState(Buf, OutData%OtherSt_MD(i1)) ! OtherSt_MD + end do + end if + ! u_MD + if (allocated(OutData%u_MD)) deallocate(OutData%u_MD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_MD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_MD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackInput(Buf, OutData%u_MD(i1)) ! u_MD + end do + end if +end subroutine + SUBROUTINE FAST_CopyLinType( SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FAST_LinType), INTENT(IN) :: SrcLinTypeData + TYPE(FAST_LinType), INTENT(INOUT) :: DstLinTypeData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyLinType' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcLinTypeData%Names_u)) THEN + i1_l = LBOUND(SrcLinTypeData%Names_u,1) + i1_u = UBOUND(SrcLinTypeData%Names_u,1) + IF (.NOT. ALLOCATED(DstLinTypeData%Names_u)) THEN + ALLOCATE(DstLinTypeData%Names_u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! OtherSt_IceD allocated yes/no - IF ( ALLOCATED(InData%OtherSt_IceD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OtherSt_IceD upper/lower bounds for each dimension - DO i2 = LBOUND(InData%OtherSt_IceD,2), UBOUND(InData%OtherSt_IceD,2) - DO i1 = LBOUND(InData%OtherSt_IceD,1), UBOUND(InData%OtherSt_IceD,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt_IceD: size of buffers for each call to pack subtype - CALL IceD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_IceD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_IceD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_IceD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_IceD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_IceD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO + DstLinTypeData%Names_u = SrcLinTypeData%Names_u +ENDIF +IF (ALLOCATED(SrcLinTypeData%Names_y)) THEN + i1_l = LBOUND(SrcLinTypeData%Names_y,1) + i1_u = UBOUND(SrcLinTypeData%Names_y,1) + IF (.NOT. ALLOCATED(DstLinTypeData%Names_y)) THEN + ALLOCATE(DstLinTypeData%Names_y(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_y.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! u_IceD allocated yes/no - IF ( ALLOCATED(InData%u_IceD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! u_IceD upper/lower bounds for each dimension - DO i2 = LBOUND(InData%u_IceD,2), UBOUND(InData%u_IceD,2) - DO i1 = LBOUND(InData%u_IceD,1), UBOUND(InData%u_IceD,1) - Int_BufSz = Int_BufSz + 3 ! u_IceD: size of buffers for each call to pack subtype - CALL IceD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_IceD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! u_IceD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_IceD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_IceD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_IceD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO + DstLinTypeData%Names_y = SrcLinTypeData%Names_y +ENDIF +IF (ALLOCATED(SrcLinTypeData%Names_x)) THEN + i1_l = LBOUND(SrcLinTypeData%Names_x,1) + i1_u = UBOUND(SrcLinTypeData%Names_x,1) + IF (.NOT. ALLOCATED(DstLinTypeData%Names_x)) THEN + ALLOCATE(DstLinTypeData%Names_x(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! x_BD allocated yes/no - IF ( ALLOCATED(InData%x_BD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! x_BD upper/lower bounds for each dimension - DO i2 = LBOUND(InData%x_BD,2), UBOUND(InData%x_BD,2) - DO i1 = LBOUND(InData%x_BD,1), UBOUND(InData%x_BD,1) - Int_BufSz = Int_BufSz + 3 ! x_BD: size of buffers for each call to pack subtype - CALL BD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_BD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! x_BD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x_BD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x_BD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x_BD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO + DstLinTypeData%Names_x = SrcLinTypeData%Names_x +ENDIF +IF (ALLOCATED(SrcLinTypeData%Names_xd)) THEN + i1_l = LBOUND(SrcLinTypeData%Names_xd,1) + i1_u = UBOUND(SrcLinTypeData%Names_xd,1) + IF (.NOT. ALLOCATED(DstLinTypeData%Names_xd)) THEN + ALLOCATE(DstLinTypeData%Names_xd(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_xd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! xd_BD allocated yes/no - IF ( ALLOCATED(InData%xd_BD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! xd_BD upper/lower bounds for each dimension - DO i2 = LBOUND(InData%xd_BD,2), UBOUND(InData%xd_BD,2) - DO i1 = LBOUND(InData%xd_BD,1), UBOUND(InData%xd_BD,1) - Int_BufSz = Int_BufSz + 3 ! xd_BD: size of buffers for each call to pack subtype - CALL BD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_BD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! xd_BD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd_BD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd_BD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd_BD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO + DstLinTypeData%Names_xd = SrcLinTypeData%Names_xd +ENDIF +IF (ALLOCATED(SrcLinTypeData%Names_z)) THEN + i1_l = LBOUND(SrcLinTypeData%Names_z,1) + i1_u = UBOUND(SrcLinTypeData%Names_z,1) + IF (.NOT. ALLOCATED(DstLinTypeData%Names_z)) THEN + ALLOCATE(DstLinTypeData%Names_z(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_z.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! z_BD allocated yes/no - IF ( ALLOCATED(InData%z_BD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! z_BD upper/lower bounds for each dimension - DO i2 = LBOUND(InData%z_BD,2), UBOUND(InData%z_BD,2) - DO i1 = LBOUND(InData%z_BD,1), UBOUND(InData%z_BD,1) - Int_BufSz = Int_BufSz + 3 ! z_BD: size of buffers for each call to pack subtype - CALL BD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_BD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! z_BD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z_BD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z_BD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z_BD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO + DstLinTypeData%Names_z = SrcLinTypeData%Names_z +ENDIF +IF (ALLOCATED(SrcLinTypeData%op_u)) THEN + i1_l = LBOUND(SrcLinTypeData%op_u,1) + i1_u = UBOUND(SrcLinTypeData%op_u,1) + IF (.NOT. ALLOCATED(DstLinTypeData%op_u)) THEN + ALLOCATE(DstLinTypeData%op_u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! OtherSt_BD allocated yes/no - IF ( ALLOCATED(InData%OtherSt_BD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OtherSt_BD upper/lower bounds for each dimension - DO i2 = LBOUND(InData%OtherSt_BD,2), UBOUND(InData%OtherSt_BD,2) - DO i1 = LBOUND(InData%OtherSt_BD,1), UBOUND(InData%OtherSt_BD,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt_BD: size of buffers for each call to pack subtype - CALL BD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_BD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_BD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_BD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_BD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_BD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO + DstLinTypeData%op_u = SrcLinTypeData%op_u +ENDIF +IF (ALLOCATED(SrcLinTypeData%op_y)) THEN + i1_l = LBOUND(SrcLinTypeData%op_y,1) + i1_u = UBOUND(SrcLinTypeData%op_y,1) + IF (.NOT. ALLOCATED(DstLinTypeData%op_y)) THEN + ALLOCATE(DstLinTypeData%op_y(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_y.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! u_BD allocated yes/no - IF ( ALLOCATED(InData%u_BD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! u_BD upper/lower bounds for each dimension - DO i2 = LBOUND(InData%u_BD,2), UBOUND(InData%u_BD,2) - DO i1 = LBOUND(InData%u_BD,1), UBOUND(InData%u_BD,1) - Int_BufSz = Int_BufSz + 3 ! u_BD: size of buffers for each call to pack subtype - CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_BD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! u_BD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_BD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_BD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_BD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! x_ED allocated yes/no - IF ( ALLOCATED(InData%x_ED) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x_ED upper/lower bounds for each dimension - DO i1 = LBOUND(InData%x_ED,1), UBOUND(InData%x_ED,1) - Int_BufSz = Int_BufSz + 3 ! x_ED: size of buffers for each call to pack subtype - CALL ED_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_ED(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_ED - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x_ED - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x_ED - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x_ED - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO + DstLinTypeData%op_y = SrcLinTypeData%op_y +ENDIF +IF (ALLOCATED(SrcLinTypeData%op_x)) THEN + i1_l = LBOUND(SrcLinTypeData%op_x,1) + i1_u = UBOUND(SrcLinTypeData%op_x,1) + IF (.NOT. ALLOCATED(DstLinTypeData%op_x)) THEN + ALLOCATE(DstLinTypeData%op_x(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! xd_ED allocated yes/no - IF ( ALLOCATED(InData%xd_ED) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xd_ED upper/lower bounds for each dimension - DO i1 = LBOUND(InData%xd_ED,1), UBOUND(InData%xd_ED,1) - Int_BufSz = Int_BufSz + 3 ! xd_ED: size of buffers for each call to pack subtype - CALL ED_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_ED(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_ED - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd_ED - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd_ED - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd_ED - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO + DstLinTypeData%op_x = SrcLinTypeData%op_x +ENDIF +IF (ALLOCATED(SrcLinTypeData%op_dx)) THEN + i1_l = LBOUND(SrcLinTypeData%op_dx,1) + i1_u = UBOUND(SrcLinTypeData%op_dx,1) + IF (.NOT. ALLOCATED(DstLinTypeData%op_dx)) THEN + ALLOCATE(DstLinTypeData%op_dx(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_dx.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! z_ED allocated yes/no - IF ( ALLOCATED(InData%z_ED) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z_ED upper/lower bounds for each dimension - DO i1 = LBOUND(InData%z_ED,1), UBOUND(InData%z_ED,1) - Int_BufSz = Int_BufSz + 3 ! z_ED: size of buffers for each call to pack subtype - CALL ED_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_ED(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_ED - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z_ED - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z_ED - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z_ED - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO + DstLinTypeData%op_dx = SrcLinTypeData%op_dx +ENDIF +IF (ALLOCATED(SrcLinTypeData%op_xd)) THEN + i1_l = LBOUND(SrcLinTypeData%op_xd,1) + i1_u = UBOUND(SrcLinTypeData%op_xd,1) + IF (.NOT. ALLOCATED(DstLinTypeData%op_xd)) THEN + ALLOCATE(DstLinTypeData%op_xd(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_xd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! OtherSt_ED allocated yes/no - IF ( ALLOCATED(InData%OtherSt_ED) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OtherSt_ED upper/lower bounds for each dimension - DO i1 = LBOUND(InData%OtherSt_ED,1), UBOUND(InData%OtherSt_ED,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt_ED: size of buffers for each call to pack subtype - CALL ED_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_ED(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_ED - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_ED - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_ED - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_ED - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO + DstLinTypeData%op_xd = SrcLinTypeData%op_xd +ENDIF +IF (ALLOCATED(SrcLinTypeData%op_z)) THEN + i1_l = LBOUND(SrcLinTypeData%op_z,1) + i1_u = UBOUND(SrcLinTypeData%op_z,1) + IF (.NOT. ALLOCATED(DstLinTypeData%op_z)) THEN + ALLOCATE(DstLinTypeData%op_z(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_z.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! u_ED allocated yes/no - IF ( ALLOCATED(InData%u_ED) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_ED upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_ED,1), UBOUND(InData%u_ED,1) - Int_BufSz = Int_BufSz + 3 ! u_ED: size of buffers for each call to pack subtype - CALL ED_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_ED(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_ED - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_ED - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_ED - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_ED - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO + DstLinTypeData%op_z = SrcLinTypeData%op_z +ENDIF +IF (ALLOCATED(SrcLinTypeData%op_x_eig_mag)) THEN + i1_l = LBOUND(SrcLinTypeData%op_x_eig_mag,1) + i1_u = UBOUND(SrcLinTypeData%op_x_eig_mag,1) + IF (.NOT. ALLOCATED(DstLinTypeData%op_x_eig_mag)) THEN + ALLOCATE(DstLinTypeData%op_x_eig_mag(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_x_eig_mag.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! x_SrvD allocated yes/no - IF ( ALLOCATED(InData%x_SrvD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x_SrvD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%x_SrvD,1), UBOUND(InData%x_SrvD,1) - Int_BufSz = Int_BufSz + 3 ! x_SrvD: size of buffers for each call to pack subtype - CALL SrvD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_SrvD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_SrvD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x_SrvD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x_SrvD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x_SrvD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO + DstLinTypeData%op_x_eig_mag = SrcLinTypeData%op_x_eig_mag +ENDIF +IF (ALLOCATED(SrcLinTypeData%op_x_eig_phase)) THEN + i1_l = LBOUND(SrcLinTypeData%op_x_eig_phase,1) + i1_u = UBOUND(SrcLinTypeData%op_x_eig_phase,1) + IF (.NOT. ALLOCATED(DstLinTypeData%op_x_eig_phase)) THEN + ALLOCATE(DstLinTypeData%op_x_eig_phase(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_x_eig_phase.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! xd_SrvD allocated yes/no - IF ( ALLOCATED(InData%xd_SrvD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xd_SrvD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%xd_SrvD,1), UBOUND(InData%xd_SrvD,1) - Int_BufSz = Int_BufSz + 3 ! xd_SrvD: size of buffers for each call to pack subtype - CALL SrvD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_SrvD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_SrvD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd_SrvD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd_SrvD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd_SrvD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO + DstLinTypeData%op_x_eig_phase = SrcLinTypeData%op_x_eig_phase +ENDIF +IF (ALLOCATED(SrcLinTypeData%Use_u)) THEN + i1_l = LBOUND(SrcLinTypeData%Use_u,1) + i1_u = UBOUND(SrcLinTypeData%Use_u,1) + IF (.NOT. ALLOCATED(DstLinTypeData%Use_u)) THEN + ALLOCATE(DstLinTypeData%Use_u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Use_u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! z_SrvD allocated yes/no - IF ( ALLOCATED(InData%z_SrvD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z_SrvD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%z_SrvD,1), UBOUND(InData%z_SrvD,1) - Int_BufSz = Int_BufSz + 3 ! z_SrvD: size of buffers for each call to pack subtype - CALL SrvD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_SrvD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_SrvD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z_SrvD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z_SrvD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z_SrvD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO + DstLinTypeData%Use_u = SrcLinTypeData%Use_u +ENDIF +IF (ALLOCATED(SrcLinTypeData%Use_y)) THEN + i1_l = LBOUND(SrcLinTypeData%Use_y,1) + i1_u = UBOUND(SrcLinTypeData%Use_y,1) + IF (.NOT. ALLOCATED(DstLinTypeData%Use_y)) THEN + ALLOCATE(DstLinTypeData%Use_y(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Use_y.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! OtherSt_SrvD allocated yes/no - IF ( ALLOCATED(InData%OtherSt_SrvD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OtherSt_SrvD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%OtherSt_SrvD,1), UBOUND(InData%OtherSt_SrvD,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt_SrvD: size of buffers for each call to pack subtype - CALL SrvD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_SrvD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_SrvD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_SrvD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_SrvD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_SrvD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO + DstLinTypeData%Use_y = SrcLinTypeData%Use_y +ENDIF +IF (ALLOCATED(SrcLinTypeData%A)) THEN + i1_l = LBOUND(SrcLinTypeData%A,1) + i1_u = UBOUND(SrcLinTypeData%A,1) + i2_l = LBOUND(SrcLinTypeData%A,2) + i2_u = UBOUND(SrcLinTypeData%A,2) + IF (.NOT. ALLOCATED(DstLinTypeData%A)) THEN + ALLOCATE(DstLinTypeData%A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%A.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! u_SrvD allocated yes/no - IF ( ALLOCATED(InData%u_SrvD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_SrvD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_SrvD,1), UBOUND(InData%u_SrvD,1) - Int_BufSz = Int_BufSz + 3 ! u_SrvD: size of buffers for each call to pack subtype - CALL SrvD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_SrvD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_SrvD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_SrvD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_SrvD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_SrvD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO + DstLinTypeData%A = SrcLinTypeData%A +ENDIF +IF (ALLOCATED(SrcLinTypeData%B)) THEN + i1_l = LBOUND(SrcLinTypeData%B,1) + i1_u = UBOUND(SrcLinTypeData%B,1) + i2_l = LBOUND(SrcLinTypeData%B,2) + i2_u = UBOUND(SrcLinTypeData%B,2) + IF (.NOT. ALLOCATED(DstLinTypeData%B)) THEN + ALLOCATE(DstLinTypeData%B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%B.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! x_AD allocated yes/no - IF ( ALLOCATED(InData%x_AD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x_AD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%x_AD,1), UBOUND(InData%x_AD,1) - Int_BufSz = Int_BufSz + 3 ! x_AD: size of buffers for each call to pack subtype - CALL AD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_AD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x_AD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x_AD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x_AD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO + DstLinTypeData%B = SrcLinTypeData%B +ENDIF +IF (ALLOCATED(SrcLinTypeData%C)) THEN + i1_l = LBOUND(SrcLinTypeData%C,1) + i1_u = UBOUND(SrcLinTypeData%C,1) + i2_l = LBOUND(SrcLinTypeData%C,2) + i2_u = UBOUND(SrcLinTypeData%C,2) + IF (.NOT. ALLOCATED(DstLinTypeData%C)) THEN + ALLOCATE(DstLinTypeData%C(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%C.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! xd_AD allocated yes/no - IF ( ALLOCATED(InData%xd_AD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xd_AD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%xd_AD,1), UBOUND(InData%xd_AD,1) - Int_BufSz = Int_BufSz + 3 ! xd_AD: size of buffers for each call to pack subtype - CALL AD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_AD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd_AD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd_AD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd_AD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO + DstLinTypeData%C = SrcLinTypeData%C +ENDIF +IF (ALLOCATED(SrcLinTypeData%D)) THEN + i1_l = LBOUND(SrcLinTypeData%D,1) + i1_u = UBOUND(SrcLinTypeData%D,1) + i2_l = LBOUND(SrcLinTypeData%D,2) + i2_u = UBOUND(SrcLinTypeData%D,2) + IF (.NOT. ALLOCATED(DstLinTypeData%D)) THEN + ALLOCATE(DstLinTypeData%D(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%D.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! z_AD allocated yes/no - IF ( ALLOCATED(InData%z_AD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z_AD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%z_AD,1), UBOUND(InData%z_AD,1) - Int_BufSz = Int_BufSz + 3 ! z_AD: size of buffers for each call to pack subtype - CALL AD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_AD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z_AD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z_AD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z_AD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO + DstLinTypeData%D = SrcLinTypeData%D +ENDIF +IF (ALLOCATED(SrcLinTypeData%StateRotation)) THEN + i1_l = LBOUND(SrcLinTypeData%StateRotation,1) + i1_u = UBOUND(SrcLinTypeData%StateRotation,1) + i2_l = LBOUND(SrcLinTypeData%StateRotation,2) + i2_u = UBOUND(SrcLinTypeData%StateRotation,2) + IF (.NOT. ALLOCATED(DstLinTypeData%StateRotation)) THEN + ALLOCATE(DstLinTypeData%StateRotation(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%StateRotation.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! OtherSt_AD allocated yes/no - IF ( ALLOCATED(InData%OtherSt_AD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OtherSt_AD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%OtherSt_AD,1), UBOUND(InData%OtherSt_AD,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt_AD: size of buffers for each call to pack subtype - CALL AD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_AD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_AD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_AD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_AD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO + DstLinTypeData%StateRotation = SrcLinTypeData%StateRotation +ENDIF +IF (ALLOCATED(SrcLinTypeData%StateRel_x)) THEN + i1_l = LBOUND(SrcLinTypeData%StateRel_x,1) + i1_u = UBOUND(SrcLinTypeData%StateRel_x,1) + i2_l = LBOUND(SrcLinTypeData%StateRel_x,2) + i2_u = UBOUND(SrcLinTypeData%StateRel_x,2) + IF (.NOT. ALLOCATED(DstLinTypeData%StateRel_x)) THEN + ALLOCATE(DstLinTypeData%StateRel_x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%StateRel_x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! u_AD allocated yes/no - IF ( ALLOCATED(InData%u_AD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_AD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_AD,1), UBOUND(InData%u_AD,1) - Int_BufSz = Int_BufSz + 3 ! u_AD: size of buffers for each call to pack subtype - CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_AD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_AD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_AD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_AD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO + DstLinTypeData%StateRel_x = SrcLinTypeData%StateRel_x +ENDIF +IF (ALLOCATED(SrcLinTypeData%StateRel_xdot)) THEN + i1_l = LBOUND(SrcLinTypeData%StateRel_xdot,1) + i1_u = UBOUND(SrcLinTypeData%StateRel_xdot,1) + i2_l = LBOUND(SrcLinTypeData%StateRel_xdot,2) + i2_u = UBOUND(SrcLinTypeData%StateRel_xdot,2) + IF (.NOT. ALLOCATED(DstLinTypeData%StateRel_xdot)) THEN + ALLOCATE(DstLinTypeData%StateRel_xdot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%StateRel_xdot.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! x_IfW allocated yes/no - IF ( ALLOCATED(InData%x_IfW) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x_IfW upper/lower bounds for each dimension - DO i1 = LBOUND(InData%x_IfW,1), UBOUND(InData%x_IfW,1) - Int_BufSz = Int_BufSz + 3 ! x_IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_IfW(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x_IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x_IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x_IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO + DstLinTypeData%StateRel_xdot = SrcLinTypeData%StateRel_xdot +ENDIF +IF (ALLOCATED(SrcLinTypeData%IsLoad_u)) THEN + i1_l = LBOUND(SrcLinTypeData%IsLoad_u,1) + i1_u = UBOUND(SrcLinTypeData%IsLoad_u,1) + IF (.NOT. ALLOCATED(DstLinTypeData%IsLoad_u)) THEN + ALLOCATE(DstLinTypeData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! xd_IfW allocated yes/no - IF ( ALLOCATED(InData%xd_IfW) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xd_IfW upper/lower bounds for each dimension - DO i1 = LBOUND(InData%xd_IfW,1), UBOUND(InData%xd_IfW,1) - Int_BufSz = Int_BufSz + 3 ! xd_IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_IfW(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd_IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd_IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd_IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO + DstLinTypeData%IsLoad_u = SrcLinTypeData%IsLoad_u +ENDIF +IF (ALLOCATED(SrcLinTypeData%RotFrame_u)) THEN + i1_l = LBOUND(SrcLinTypeData%RotFrame_u,1) + i1_u = UBOUND(SrcLinTypeData%RotFrame_u,1) + IF (.NOT. ALLOCATED(DstLinTypeData%RotFrame_u)) THEN + ALLOCATE(DstLinTypeData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! z_IfW allocated yes/no - IF ( ALLOCATED(InData%z_IfW) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z_IfW upper/lower bounds for each dimension - DO i1 = LBOUND(InData%z_IfW,1), UBOUND(InData%z_IfW,1) - Int_BufSz = Int_BufSz + 3 ! z_IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_IfW(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z_IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z_IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z_IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO + DstLinTypeData%RotFrame_u = SrcLinTypeData%RotFrame_u +ENDIF +IF (ALLOCATED(SrcLinTypeData%RotFrame_y)) THEN + i1_l = LBOUND(SrcLinTypeData%RotFrame_y,1) + i1_u = UBOUND(SrcLinTypeData%RotFrame_y,1) + IF (.NOT. ALLOCATED(DstLinTypeData%RotFrame_y)) THEN + ALLOCATE(DstLinTypeData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! OtherSt_IfW allocated yes/no - IF ( ALLOCATED(InData%OtherSt_IfW) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OtherSt_IfW upper/lower bounds for each dimension - DO i1 = LBOUND(InData%OtherSt_IfW,1), UBOUND(InData%OtherSt_IfW,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt_IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_IfW(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO + DstLinTypeData%RotFrame_y = SrcLinTypeData%RotFrame_y +ENDIF +IF (ALLOCATED(SrcLinTypeData%RotFrame_x)) THEN + i1_l = LBOUND(SrcLinTypeData%RotFrame_x,1) + i1_u = UBOUND(SrcLinTypeData%RotFrame_x,1) + IF (.NOT. ALLOCATED(DstLinTypeData%RotFrame_x)) THEN + ALLOCATE(DstLinTypeData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! u_IfW allocated yes/no - IF ( ALLOCATED(InData%u_IfW) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_IfW upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_IfW,1), UBOUND(InData%u_IfW,1) - Int_BufSz = Int_BufSz + 3 ! u_IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_IfW(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO + DstLinTypeData%RotFrame_x = SrcLinTypeData%RotFrame_x +ENDIF +IF (ALLOCATED(SrcLinTypeData%RotFrame_z)) THEN + i1_l = LBOUND(SrcLinTypeData%RotFrame_z,1) + i1_u = UBOUND(SrcLinTypeData%RotFrame_z,1) + IF (.NOT. ALLOCATED(DstLinTypeData%RotFrame_z)) THEN + ALLOCATE(DstLinTypeData%RotFrame_z(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_z.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! x_SD allocated yes/no - IF ( ALLOCATED(InData%x_SD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x_SD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%x_SD,1), UBOUND(InData%x_SD,1) - Int_BufSz = Int_BufSz + 3 ! x_SD: size of buffers for each call to pack subtype - CALL SD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_SD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_SD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x_SD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x_SD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x_SD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! xd_SD allocated yes/no - IF ( ALLOCATED(InData%xd_SD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xd_SD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%xd_SD,1), UBOUND(InData%xd_SD,1) - Int_BufSz = Int_BufSz + 3 ! xd_SD: size of buffers for each call to pack subtype - CALL SD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_SD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_SD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd_SD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd_SD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd_SD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! z_SD allocated yes/no - IF ( ALLOCATED(InData%z_SD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z_SD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%z_SD,1), UBOUND(InData%z_SD,1) - Int_BufSz = Int_BufSz + 3 ! z_SD: size of buffers for each call to pack subtype - CALL SD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_SD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_SD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z_SD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z_SD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z_SD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OtherSt_SD allocated yes/no - IF ( ALLOCATED(InData%OtherSt_SD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OtherSt_SD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%OtherSt_SD,1), UBOUND(InData%OtherSt_SD,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt_SD: size of buffers for each call to pack subtype - CALL SD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_SD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_SD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_SD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_SD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_SD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_SD allocated yes/no - IF ( ALLOCATED(InData%u_SD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_SD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_SD,1), UBOUND(InData%u_SD,1) - Int_BufSz = Int_BufSz + 3 ! u_SD: size of buffers for each call to pack subtype - CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_SD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_SD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_SD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_SD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_SD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! x_ExtPtfm allocated yes/no - IF ( ALLOCATED(InData%x_ExtPtfm) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x_ExtPtfm upper/lower bounds for each dimension - DO i1 = LBOUND(InData%x_ExtPtfm,1), UBOUND(InData%x_ExtPtfm,1) - Int_BufSz = Int_BufSz + 3 ! x_ExtPtfm: size of buffers for each call to pack subtype - CALL ExtPtfm_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_ExtPtfm(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_ExtPtfm - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x_ExtPtfm - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x_ExtPtfm - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x_ExtPtfm - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO + DstLinTypeData%RotFrame_z = SrcLinTypeData%RotFrame_z +ENDIF +IF (ALLOCATED(SrcLinTypeData%DerivOrder_x)) THEN + i1_l = LBOUND(SrcLinTypeData%DerivOrder_x,1) + i1_u = UBOUND(SrcLinTypeData%DerivOrder_x,1) + IF (.NOT. ALLOCATED(DstLinTypeData%DerivOrder_x)) THEN + ALLOCATE(DstLinTypeData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! xd_ExtPtfm allocated yes/no - IF ( ALLOCATED(InData%xd_ExtPtfm) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xd_ExtPtfm upper/lower bounds for each dimension - DO i1 = LBOUND(InData%xd_ExtPtfm,1), UBOUND(InData%xd_ExtPtfm,1) - Int_BufSz = Int_BufSz + 3 ! xd_ExtPtfm: size of buffers for each call to pack subtype - CALL ExtPtfm_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_ExtPtfm(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_ExtPtfm - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + DstLinTypeData%DerivOrder_x = SrcLinTypeData%DerivOrder_x +ENDIF + DstLinTypeData%SizeLin = SrcLinTypeData%SizeLin + DstLinTypeData%LinStartIndx = SrcLinTypeData%LinStartIndx + DstLinTypeData%NumOutputs = SrcLinTypeData%NumOutputs + END SUBROUTINE FAST_CopyLinType - IF(ALLOCATED(Re_Buf)) THEN ! xd_ExtPtfm - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd_ExtPtfm - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd_ExtPtfm - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! z_ExtPtfm allocated yes/no - IF ( ALLOCATED(InData%z_ExtPtfm) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z_ExtPtfm upper/lower bounds for each dimension - DO i1 = LBOUND(InData%z_ExtPtfm,1), UBOUND(InData%z_ExtPtfm,1) - Int_BufSz = Int_BufSz + 3 ! z_ExtPtfm: size of buffers for each call to pack subtype - CALL ExtPtfm_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_ExtPtfm(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_ExtPtfm - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + SUBROUTINE FAST_DestroyLinType( LinTypeData, ErrStat, ErrMsg ) + TYPE(FAST_LinType), INTENT(INOUT) :: LinTypeData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyLinType' - IF(ALLOCATED(Re_Buf)) THEN ! z_ExtPtfm - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z_ExtPtfm - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z_ExtPtfm - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OtherSt_ExtPtfm allocated yes/no - IF ( ALLOCATED(InData%OtherSt_ExtPtfm) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OtherSt_ExtPtfm upper/lower bounds for each dimension - DO i1 = LBOUND(InData%OtherSt_ExtPtfm,1), UBOUND(InData%OtherSt_ExtPtfm,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt_ExtPtfm: size of buffers for each call to pack subtype - CALL ExtPtfm_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_ExtPtfm(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_ExtPtfm - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + ErrStat = ErrID_None + ErrMsg = "" - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_ExtPtfm - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_ExtPtfm - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_ExtPtfm - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_ExtPtfm allocated yes/no - IF ( ALLOCATED(InData%u_ExtPtfm) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_ExtPtfm upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_ExtPtfm,1), UBOUND(InData%u_ExtPtfm,1) - Int_BufSz = Int_BufSz + 3 ! u_ExtPtfm: size of buffers for each call to pack subtype - CALL ExtPtfm_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_ExtPtfm(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_ExtPtfm - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN +IF (ALLOCATED(LinTypeData%Names_u)) THEN + DEALLOCATE(LinTypeData%Names_u) +ENDIF +IF (ALLOCATED(LinTypeData%Names_y)) THEN + DEALLOCATE(LinTypeData%Names_y) +ENDIF +IF (ALLOCATED(LinTypeData%Names_x)) THEN + DEALLOCATE(LinTypeData%Names_x) +ENDIF +IF (ALLOCATED(LinTypeData%Names_xd)) THEN + DEALLOCATE(LinTypeData%Names_xd) +ENDIF +IF (ALLOCATED(LinTypeData%Names_z)) THEN + DEALLOCATE(LinTypeData%Names_z) +ENDIF +IF (ALLOCATED(LinTypeData%op_u)) THEN + DEALLOCATE(LinTypeData%op_u) +ENDIF +IF (ALLOCATED(LinTypeData%op_y)) THEN + DEALLOCATE(LinTypeData%op_y) +ENDIF +IF (ALLOCATED(LinTypeData%op_x)) THEN + DEALLOCATE(LinTypeData%op_x) +ENDIF +IF (ALLOCATED(LinTypeData%op_dx)) THEN + DEALLOCATE(LinTypeData%op_dx) +ENDIF +IF (ALLOCATED(LinTypeData%op_xd)) THEN + DEALLOCATE(LinTypeData%op_xd) +ENDIF +IF (ALLOCATED(LinTypeData%op_z)) THEN + DEALLOCATE(LinTypeData%op_z) +ENDIF +IF (ALLOCATED(LinTypeData%op_x_eig_mag)) THEN + DEALLOCATE(LinTypeData%op_x_eig_mag) +ENDIF +IF (ALLOCATED(LinTypeData%op_x_eig_phase)) THEN + DEALLOCATE(LinTypeData%op_x_eig_phase) +ENDIF +IF (ALLOCATED(LinTypeData%Use_u)) THEN + DEALLOCATE(LinTypeData%Use_u) +ENDIF +IF (ALLOCATED(LinTypeData%Use_y)) THEN + DEALLOCATE(LinTypeData%Use_y) +ENDIF +IF (ALLOCATED(LinTypeData%A)) THEN + DEALLOCATE(LinTypeData%A) +ENDIF +IF (ALLOCATED(LinTypeData%B)) THEN + DEALLOCATE(LinTypeData%B) +ENDIF +IF (ALLOCATED(LinTypeData%C)) THEN + DEALLOCATE(LinTypeData%C) +ENDIF +IF (ALLOCATED(LinTypeData%D)) THEN + DEALLOCATE(LinTypeData%D) +ENDIF +IF (ALLOCATED(LinTypeData%StateRotation)) THEN + DEALLOCATE(LinTypeData%StateRotation) +ENDIF +IF (ALLOCATED(LinTypeData%StateRel_x)) THEN + DEALLOCATE(LinTypeData%StateRel_x) +ENDIF +IF (ALLOCATED(LinTypeData%StateRel_xdot)) THEN + DEALLOCATE(LinTypeData%StateRel_xdot) +ENDIF +IF (ALLOCATED(LinTypeData%IsLoad_u)) THEN + DEALLOCATE(LinTypeData%IsLoad_u) +ENDIF +IF (ALLOCATED(LinTypeData%RotFrame_u)) THEN + DEALLOCATE(LinTypeData%RotFrame_u) +ENDIF +IF (ALLOCATED(LinTypeData%RotFrame_y)) THEN + DEALLOCATE(LinTypeData%RotFrame_y) +ENDIF +IF (ALLOCATED(LinTypeData%RotFrame_x)) THEN + DEALLOCATE(LinTypeData%RotFrame_x) +ENDIF +IF (ALLOCATED(LinTypeData%RotFrame_z)) THEN + DEALLOCATE(LinTypeData%RotFrame_z) +ENDIF +IF (ALLOCATED(LinTypeData%DerivOrder_x)) THEN + DEALLOCATE(LinTypeData%DerivOrder_x) +ENDIF + END SUBROUTINE FAST_DestroyLinType - IF(ALLOCATED(Re_Buf)) THEN ! u_ExtPtfm - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_ExtPtfm - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_ExtPtfm - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! x_HD allocated yes/no - IF ( ALLOCATED(InData%x_HD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x_HD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%x_HD,1), UBOUND(InData%x_HD,1) - Int_BufSz = Int_BufSz + 3 ! x_HD: size of buffers for each call to pack subtype - CALL HydroDyn_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_HD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_HD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! x_HD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x_HD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x_HD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO +subroutine FAST_PackLinType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FAST_LinType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackLinType' + if (Buf%ErrStat >= AbortErrLev) return + ! Names_u + call RegPack(Buf, allocated(InData%Names_u)) + if (allocated(InData%Names_u)) then + call RegPackBounds(Buf, 1, lbound(InData%Names_u), ubound(InData%Names_u)) + call RegPack(Buf, InData%Names_u) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Names_y + call RegPack(Buf, allocated(InData%Names_y)) + if (allocated(InData%Names_y)) then + call RegPackBounds(Buf, 1, lbound(InData%Names_y), ubound(InData%Names_y)) + call RegPack(Buf, InData%Names_y) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Names_x + call RegPack(Buf, allocated(InData%Names_x)) + if (allocated(InData%Names_x)) then + call RegPackBounds(Buf, 1, lbound(InData%Names_x), ubound(InData%Names_x)) + call RegPack(Buf, InData%Names_x) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Names_xd + call RegPack(Buf, allocated(InData%Names_xd)) + if (allocated(InData%Names_xd)) then + call RegPackBounds(Buf, 1, lbound(InData%Names_xd), ubound(InData%Names_xd)) + call RegPack(Buf, InData%Names_xd) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Names_z + call RegPack(Buf, allocated(InData%Names_z)) + if (allocated(InData%Names_z)) then + call RegPackBounds(Buf, 1, lbound(InData%Names_z), ubound(InData%Names_z)) + call RegPack(Buf, InData%Names_z) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! op_u + call RegPack(Buf, allocated(InData%op_u)) + if (allocated(InData%op_u)) then + call RegPackBounds(Buf, 1, lbound(InData%op_u), ubound(InData%op_u)) + call RegPack(Buf, InData%op_u) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! op_y + call RegPack(Buf, allocated(InData%op_y)) + if (allocated(InData%op_y)) then + call RegPackBounds(Buf, 1, lbound(InData%op_y), ubound(InData%op_y)) + call RegPack(Buf, InData%op_y) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! op_x + call RegPack(Buf, allocated(InData%op_x)) + if (allocated(InData%op_x)) then + call RegPackBounds(Buf, 1, lbound(InData%op_x), ubound(InData%op_x)) + call RegPack(Buf, InData%op_x) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! op_dx + call RegPack(Buf, allocated(InData%op_dx)) + if (allocated(InData%op_dx)) then + call RegPackBounds(Buf, 1, lbound(InData%op_dx), ubound(InData%op_dx)) + call RegPack(Buf, InData%op_dx) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! op_xd + call RegPack(Buf, allocated(InData%op_xd)) + if (allocated(InData%op_xd)) then + call RegPackBounds(Buf, 1, lbound(InData%op_xd), ubound(InData%op_xd)) + call RegPack(Buf, InData%op_xd) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! op_z + call RegPack(Buf, allocated(InData%op_z)) + if (allocated(InData%op_z)) then + call RegPackBounds(Buf, 1, lbound(InData%op_z), ubound(InData%op_z)) + call RegPack(Buf, InData%op_z) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! op_x_eig_mag + call RegPack(Buf, allocated(InData%op_x_eig_mag)) + if (allocated(InData%op_x_eig_mag)) then + call RegPackBounds(Buf, 1, lbound(InData%op_x_eig_mag), ubound(InData%op_x_eig_mag)) + call RegPack(Buf, InData%op_x_eig_mag) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! op_x_eig_phase + call RegPack(Buf, allocated(InData%op_x_eig_phase)) + if (allocated(InData%op_x_eig_phase)) then + call RegPackBounds(Buf, 1, lbound(InData%op_x_eig_phase), ubound(InData%op_x_eig_phase)) + call RegPack(Buf, InData%op_x_eig_phase) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Use_u + call RegPack(Buf, allocated(InData%Use_u)) + if (allocated(InData%Use_u)) then + call RegPackBounds(Buf, 1, lbound(InData%Use_u), ubound(InData%Use_u)) + call RegPack(Buf, InData%Use_u) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Use_y + call RegPack(Buf, allocated(InData%Use_y)) + if (allocated(InData%Use_y)) then + call RegPackBounds(Buf, 1, lbound(InData%Use_y), ubound(InData%Use_y)) + call RegPack(Buf, InData%Use_y) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! A + call RegPack(Buf, allocated(InData%A)) + if (allocated(InData%A)) then + call RegPackBounds(Buf, 2, lbound(InData%A), ubound(InData%A)) + call RegPack(Buf, InData%A) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! B + call RegPack(Buf, allocated(InData%B)) + if (allocated(InData%B)) then + call RegPackBounds(Buf, 2, lbound(InData%B), ubound(InData%B)) + call RegPack(Buf, InData%B) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! C + call RegPack(Buf, allocated(InData%C)) + if (allocated(InData%C)) then + call RegPackBounds(Buf, 2, lbound(InData%C), ubound(InData%C)) + call RegPack(Buf, InData%C) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! D + call RegPack(Buf, allocated(InData%D)) + if (allocated(InData%D)) then + call RegPackBounds(Buf, 2, lbound(InData%D), ubound(InData%D)) + call RegPack(Buf, InData%D) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! StateRotation + call RegPack(Buf, allocated(InData%StateRotation)) + if (allocated(InData%StateRotation)) then + call RegPackBounds(Buf, 2, lbound(InData%StateRotation), ubound(InData%StateRotation)) + call RegPack(Buf, InData%StateRotation) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! StateRel_x + call RegPack(Buf, allocated(InData%StateRel_x)) + if (allocated(InData%StateRel_x)) then + call RegPackBounds(Buf, 2, lbound(InData%StateRel_x), ubound(InData%StateRel_x)) + call RegPack(Buf, InData%StateRel_x) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! StateRel_xdot + call RegPack(Buf, allocated(InData%StateRel_xdot)) + if (allocated(InData%StateRel_xdot)) then + call RegPackBounds(Buf, 2, lbound(InData%StateRel_xdot), ubound(InData%StateRel_xdot)) + call RegPack(Buf, InData%StateRel_xdot) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! IsLoad_u + call RegPack(Buf, allocated(InData%IsLoad_u)) + if (allocated(InData%IsLoad_u)) then + call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) + call RegPack(Buf, InData%IsLoad_u) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RotFrame_u + call RegPack(Buf, allocated(InData%RotFrame_u)) + if (allocated(InData%RotFrame_u)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u), ubound(InData%RotFrame_u)) + call RegPack(Buf, InData%RotFrame_u) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RotFrame_y + call RegPack(Buf, allocated(InData%RotFrame_y)) + if (allocated(InData%RotFrame_y)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y), ubound(InData%RotFrame_y)) + call RegPack(Buf, InData%RotFrame_y) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RotFrame_x + call RegPack(Buf, allocated(InData%RotFrame_x)) + if (allocated(InData%RotFrame_x)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x), ubound(InData%RotFrame_x)) + call RegPack(Buf, InData%RotFrame_x) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RotFrame_z + call RegPack(Buf, allocated(InData%RotFrame_z)) + if (allocated(InData%RotFrame_z)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_z), ubound(InData%RotFrame_z)) + call RegPack(Buf, InData%RotFrame_z) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DerivOrder_x + call RegPack(Buf, allocated(InData%DerivOrder_x)) + if (allocated(InData%DerivOrder_x)) then + call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x), ubound(InData%DerivOrder_x)) + call RegPack(Buf, InData%DerivOrder_x) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SizeLin + call RegPack(Buf, InData%SizeLin) + if (RegCheckErr(Buf, RoutineName)) return + ! LinStartIndx + call RegPack(Buf, InData%LinStartIndx) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOutputs + call RegPack(Buf, InData%NumOutputs) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackLinType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FAST_LinType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackLinType' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! Names_u + if (allocated(OutData%Names_u)) deallocate(OutData%Names_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Names_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Names_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Names_y + if (allocated(OutData%Names_y)) deallocate(OutData%Names_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Names_y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Names_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Names_x + if (allocated(OutData%Names_x)) deallocate(OutData%Names_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Names_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Names_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Names_xd + if (allocated(OutData%Names_xd)) deallocate(OutData%Names_xd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Names_xd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_xd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Names_xd) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Names_z + if (allocated(OutData%Names_z)) deallocate(OutData%Names_z) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Names_z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Names_z) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! op_u + if (allocated(OutData%op_u)) deallocate(OutData%op_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%op_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%op_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! op_y + if (allocated(OutData%op_y)) deallocate(OutData%op_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%op_y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%op_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! op_x + if (allocated(OutData%op_x)) deallocate(OutData%op_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%op_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%op_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! op_dx + if (allocated(OutData%op_dx)) deallocate(OutData%op_dx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%op_dx(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_dx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%op_dx) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! op_xd + if (allocated(OutData%op_xd)) deallocate(OutData%op_xd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%op_xd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_xd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%op_xd) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! op_z + if (allocated(OutData%op_z)) deallocate(OutData%op_z) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%op_z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%op_z) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! op_x_eig_mag + if (allocated(OutData%op_x_eig_mag)) deallocate(OutData%op_x_eig_mag) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%op_x_eig_mag(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_x_eig_mag.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%op_x_eig_mag) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! op_x_eig_phase + if (allocated(OutData%op_x_eig_phase)) deallocate(OutData%op_x_eig_phase) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%op_x_eig_phase(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_x_eig_phase.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%op_x_eig_phase) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Use_u + if (allocated(OutData%Use_u)) deallocate(OutData%Use_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Use_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Use_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Use_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Use_y + if (allocated(OutData%Use_y)) deallocate(OutData%Use_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Use_y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Use_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Use_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! A + if (allocated(OutData%A)) deallocate(OutData%A) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%A(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%A.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%A) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! B + if (allocated(OutData%B)) deallocate(OutData%B) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%B(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%B) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! C + if (allocated(OutData%C)) deallocate(OutData%C) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%C(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%C.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%C) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! D + if (allocated(OutData%D)) deallocate(OutData%D) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%D(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%D.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%D) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! StateRotation + if (allocated(OutData%StateRotation)) deallocate(OutData%StateRotation) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StateRotation(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StateRotation.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StateRotation) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! StateRel_x + if (allocated(OutData%StateRel_x)) deallocate(OutData%StateRel_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StateRel_x(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StateRel_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StateRel_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! StateRel_xdot + if (allocated(OutData%StateRel_xdot)) deallocate(OutData%StateRel_xdot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StateRel_xdot(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StateRel_xdot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StateRel_xdot) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! IsLoad_u + if (allocated(OutData%IsLoad_u)) deallocate(OutData%IsLoad_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IsLoad_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IsLoad_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RotFrame_u + if (allocated(OutData%RotFrame_u)) deallocate(OutData%RotFrame_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RotFrame_y + if (allocated(OutData%RotFrame_y)) deallocate(OutData%RotFrame_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RotFrame_x + if (allocated(OutData%RotFrame_x)) deallocate(OutData%RotFrame_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RotFrame_z + if (allocated(OutData%RotFrame_z)) deallocate(OutData%RotFrame_z) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_z) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! DerivOrder_x + if (allocated(OutData%DerivOrder_x)) deallocate(OutData%DerivOrder_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DerivOrder_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DerivOrder_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! SizeLin + call RegUnpack(Buf, OutData%SizeLin) + if (RegCheckErr(Buf, RoutineName)) return + ! LinStartIndx + call RegUnpack(Buf, OutData%LinStartIndx) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOutputs + call RegUnpack(Buf, OutData%NumOutputs) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + SUBROUTINE FAST_CopyModLinType( SrcModLinTypeData, DstModLinTypeData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FAST_ModLinType), INTENT(IN) :: SrcModLinTypeData + TYPE(FAST_ModLinType), INTENT(INOUT) :: DstModLinTypeData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyModLinType' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcModLinTypeData%Instance)) THEN + i1_l = LBOUND(SrcModLinTypeData%Instance,1) + i1_u = UBOUND(SrcModLinTypeData%Instance,1) + IF (.NOT. ALLOCATED(DstModLinTypeData%Instance)) THEN + ALLOCATE(DstModLinTypeData%Instance(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%Instance.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! xd_HD allocated yes/no - IF ( ALLOCATED(InData%xd_HD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xd_HD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%xd_HD,1), UBOUND(InData%xd_HD,1) - Int_BufSz = Int_BufSz + 3 ! xd_HD: size of buffers for each call to pack subtype - CALL HydroDyn_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_HD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_HD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + DO i1 = LBOUND(SrcModLinTypeData%Instance,1), UBOUND(SrcModLinTypeData%Instance,1) + CALL FAST_Copylintype( SrcModLinTypeData%Instance(i1), DstModLinTypeData%Instance(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + END SUBROUTINE FAST_CopyModLinType - IF(ALLOCATED(Re_Buf)) THEN ! xd_HD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd_HD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd_HD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! z_HD allocated yes/no - IF ( ALLOCATED(InData%z_HD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z_HD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%z_HD,1), UBOUND(InData%z_HD,1) - Int_BufSz = Int_BufSz + 3 ! z_HD: size of buffers for each call to pack subtype - CALL HydroDyn_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_HD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_HD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + SUBROUTINE FAST_DestroyModLinType( ModLinTypeData, ErrStat, ErrMsg ) + TYPE(FAST_ModLinType), INTENT(INOUT) :: ModLinTypeData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyModLinType' - IF(ALLOCATED(Re_Buf)) THEN ! z_HD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z_HD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z_HD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OtherSt_HD allocated yes/no - IF ( ALLOCATED(InData%OtherSt_HD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OtherSt_HD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%OtherSt_HD,1), UBOUND(InData%OtherSt_HD,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt_HD: size of buffers for each call to pack subtype - CALL HydroDyn_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_HD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_HD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + ErrStat = ErrID_None + ErrMsg = "" - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_HD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_HD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_HD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_HD allocated yes/no - IF ( ALLOCATED(InData%u_HD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_HD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_HD,1), UBOUND(InData%u_HD,1) - Int_BufSz = Int_BufSz + 3 ! u_HD: size of buffers for each call to pack subtype - CALL HydroDyn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_HD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_HD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN +IF (ALLOCATED(ModLinTypeData%Instance)) THEN +DO i1 = LBOUND(ModLinTypeData%Instance,1), UBOUND(ModLinTypeData%Instance,1) + CALL FAST_DestroyLinType( ModLinTypeData%Instance(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(ModLinTypeData%Instance) +ENDIF + END SUBROUTINE FAST_DestroyModLinType - IF(ALLOCATED(Re_Buf)) THEN ! u_HD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_HD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_HD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! x_IceF allocated yes/no - IF ( ALLOCATED(InData%x_IceF) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x_IceF upper/lower bounds for each dimension - DO i1 = LBOUND(InData%x_IceF,1), UBOUND(InData%x_IceF,1) - Int_BufSz = Int_BufSz + 3 ! x_IceF: size of buffers for each call to pack subtype - CALL IceFloe_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_IceF(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_IceF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! x_IceF - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x_IceF - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x_IceF - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! xd_IceF allocated yes/no - IF ( ALLOCATED(InData%xd_IceF) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xd_IceF upper/lower bounds for each dimension - DO i1 = LBOUND(InData%xd_IceF,1), UBOUND(InData%xd_IceF,1) - Int_BufSz = Int_BufSz + 3 ! xd_IceF: size of buffers for each call to pack subtype - CALL IceFloe_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_IceF(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_IceF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN +subroutine FAST_PackModLinType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FAST_ModLinType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackModLinType' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! Instance + call RegPack(Buf, allocated(InData%Instance)) + if (allocated(InData%Instance)) then + call RegPackBounds(Buf, 1, lbound(InData%Instance), ubound(InData%Instance)) + LB(1:1) = lbound(InData%Instance) + UB(1:1) = ubound(InData%Instance) + do i1 = LB(1), UB(1) + call FAST_PackLinType(Buf, InData%Instance(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackModLinType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FAST_ModLinType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackModLinType' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! Instance + if (allocated(OutData%Instance)) deallocate(OutData%Instance) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Instance(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Instance.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FAST_UnpackLinType(Buf, OutData%Instance(i1)) ! Instance + end do + end if +end subroutine + SUBROUTINE FAST_CopyLinFileType( SrcLinFileTypeData, DstLinFileTypeData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FAST_LinFileType), INTENT(IN) :: SrcLinFileTypeData + TYPE(FAST_LinFileType), INTENT(INOUT) :: DstLinFileTypeData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyLinFileType' +! + ErrStat = ErrID_None + ErrMsg = "" + DO i1 = LBOUND(SrcLinFileTypeData%Modules,1), UBOUND(SrcLinFileTypeData%Modules,1) + CALL FAST_Copymodlintype( SrcLinFileTypeData%Modules(i1), DstLinFileTypeData%Modules(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + CALL FAST_Copylintype( SrcLinFileTypeData%Glue, DstLinFileTypeData%Glue, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + DstLinFileTypeData%RotSpeed = SrcLinFileTypeData%RotSpeed + DstLinFileTypeData%Azimuth = SrcLinFileTypeData%Azimuth + DstLinFileTypeData%WindSpeed = SrcLinFileTypeData%WindSpeed + END SUBROUTINE FAST_CopyLinFileType - IF(ALLOCATED(Re_Buf)) THEN ! xd_IceF - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd_IceF - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd_IceF - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! z_IceF allocated yes/no - IF ( ALLOCATED(InData%z_IceF) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z_IceF upper/lower bounds for each dimension - DO i1 = LBOUND(InData%z_IceF,1), UBOUND(InData%z_IceF,1) - Int_BufSz = Int_BufSz + 3 ! z_IceF: size of buffers for each call to pack subtype - CALL IceFloe_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_IceF(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_IceF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + SUBROUTINE FAST_DestroyLinFileType( LinFileTypeData, ErrStat, ErrMsg ) + TYPE(FAST_LinFileType), INTENT(INOUT) :: LinFileTypeData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyLinFileType' - IF(ALLOCATED(Re_Buf)) THEN ! z_IceF - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z_IceF - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z_IceF - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OtherSt_IceF allocated yes/no - IF ( ALLOCATED(InData%OtherSt_IceF) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OtherSt_IceF upper/lower bounds for each dimension - DO i1 = LBOUND(InData%OtherSt_IceF,1), UBOUND(InData%OtherSt_IceF,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt_IceF: size of buffers for each call to pack subtype - CALL IceFloe_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_IceF(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_IceF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + ErrStat = ErrID_None + ErrMsg = "" - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_IceF - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_IceF - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_IceF - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_IceF allocated yes/no - IF ( ALLOCATED(InData%u_IceF) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_IceF upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_IceF,1), UBOUND(InData%u_IceF,1) - Int_BufSz = Int_BufSz + 3 ! u_IceF: size of buffers for each call to pack subtype - CALL IceFloe_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_IceF(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_IceF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN +DO i1 = LBOUND(LinFileTypeData%Modules,1), UBOUND(LinFileTypeData%Modules,1) + CALL FAST_DestroyModLinType( LinFileTypeData%Modules(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + CALL FAST_DestroyLinType( LinFileTypeData%Glue, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END SUBROUTINE FAST_DestroyLinFileType - IF(ALLOCATED(Re_Buf)) THEN ! u_IceF - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_IceF - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_IceF - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! x_MAP allocated yes/no - IF ( ALLOCATED(InData%x_MAP) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x_MAP upper/lower bounds for each dimension - DO i1 = LBOUND(InData%x_MAP,1), UBOUND(InData%x_MAP,1) - Int_BufSz = Int_BufSz + 3 ! x_MAP: size of buffers for each call to pack subtype - CALL MAP_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_MAP(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_MAP - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! x_MAP - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x_MAP - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x_MAP - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO +subroutine FAST_PackLinFileType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FAST_LinFileType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackLinFileType' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! Modules + LB(1:1) = lbound(InData%Modules) + UB(1:1) = ubound(InData%Modules) + do i1 = LB(1), UB(1) + call FAST_PackModLinType(Buf, InData%Modules(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! Glue + call FAST_PackLinType(Buf, InData%Glue) + if (RegCheckErr(Buf, RoutineName)) return + ! RotSpeed + call RegPack(Buf, InData%RotSpeed) + if (RegCheckErr(Buf, RoutineName)) return + ! Azimuth + call RegPack(Buf, InData%Azimuth) + if (RegCheckErr(Buf, RoutineName)) return + ! WindSpeed + call RegPack(Buf, InData%WindSpeed) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackLinFileType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FAST_LinFileType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackLinFileType' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat /= ErrID_None) return + ! Modules + LB(1:1) = lbound(OutData%Modules) + UB(1:1) = ubound(OutData%Modules) + do i1 = LB(1), UB(1) + call FAST_UnpackModLinType(Buf, OutData%Modules(i1)) ! Modules + end do + ! Glue + call FAST_UnpackLinType(Buf, OutData%Glue) ! Glue + ! RotSpeed + call RegUnpack(Buf, OutData%RotSpeed) + if (RegCheckErr(Buf, RoutineName)) return + ! Azimuth + call RegUnpack(Buf, OutData%Azimuth) + if (RegCheckErr(Buf, RoutineName)) return + ! WindSpeed + call RegUnpack(Buf, OutData%WindSpeed) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + SUBROUTINE FAST_CopyMiscLinType( SrcMiscLinTypeData, DstMiscLinTypeData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FAST_MiscLinType), INTENT(IN) :: SrcMiscLinTypeData + TYPE(FAST_MiscLinType), INTENT(INOUT) :: DstMiscLinTypeData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyMiscLinType' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcMiscLinTypeData%LinTimes)) THEN + i1_l = LBOUND(SrcMiscLinTypeData%LinTimes,1) + i1_u = UBOUND(SrcMiscLinTypeData%LinTimes,1) + IF (.NOT. ALLOCATED(DstMiscLinTypeData%LinTimes)) THEN + ALLOCATE(DstMiscLinTypeData%LinTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%LinTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! xd_MAP allocated yes/no - IF ( ALLOCATED(InData%xd_MAP) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xd_MAP upper/lower bounds for each dimension - DO i1 = LBOUND(InData%xd_MAP,1), UBOUND(InData%xd_MAP,1) - Int_BufSz = Int_BufSz + 3 ! xd_MAP: size of buffers for each call to pack subtype - CALL MAP_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_MAP(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_MAP - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd_MAP - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd_MAP - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd_MAP - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! z_MAP allocated yes/no - IF ( ALLOCATED(InData%z_MAP) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z_MAP upper/lower bounds for each dimension - DO i1 = LBOUND(InData%z_MAP,1), UBOUND(InData%z_MAP,1) - Int_BufSz = Int_BufSz + 3 ! z_MAP: size of buffers for each call to pack subtype - CALL MAP_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_MAP(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_MAP - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z_MAP - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z_MAP - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z_MAP - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_MAP allocated yes/no - IF ( ALLOCATED(InData%u_MAP) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_MAP upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_MAP,1), UBOUND(InData%u_MAP,1) - Int_BufSz = Int_BufSz + 3 ! u_MAP: size of buffers for each call to pack subtype - CALL MAP_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_MAP(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_MAP - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_MAP - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_MAP - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_MAP - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! x_FEAM allocated yes/no - IF ( ALLOCATED(InData%x_FEAM) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x_FEAM upper/lower bounds for each dimension - DO i1 = LBOUND(InData%x_FEAM,1), UBOUND(InData%x_FEAM,1) - Int_BufSz = Int_BufSz + 3 ! x_FEAM: size of buffers for each call to pack subtype - CALL FEAM_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_FEAM(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_FEAM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x_FEAM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x_FEAM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x_FEAM - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! xd_FEAM allocated yes/no - IF ( ALLOCATED(InData%xd_FEAM) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xd_FEAM upper/lower bounds for each dimension - DO i1 = LBOUND(InData%xd_FEAM,1), UBOUND(InData%xd_FEAM,1) - Int_BufSz = Int_BufSz + 3 ! xd_FEAM: size of buffers for each call to pack subtype - CALL FEAM_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_FEAM(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_FEAM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd_FEAM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd_FEAM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd_FEAM - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! z_FEAM allocated yes/no - IF ( ALLOCATED(InData%z_FEAM) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z_FEAM upper/lower bounds for each dimension - DO i1 = LBOUND(InData%z_FEAM,1), UBOUND(InData%z_FEAM,1) - Int_BufSz = Int_BufSz + 3 ! z_FEAM: size of buffers for each call to pack subtype - CALL FEAM_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_FEAM(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_FEAM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z_FEAM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z_FEAM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z_FEAM - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OtherSt_FEAM allocated yes/no - IF ( ALLOCATED(InData%OtherSt_FEAM) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OtherSt_FEAM upper/lower bounds for each dimension - DO i1 = LBOUND(InData%OtherSt_FEAM,1), UBOUND(InData%OtherSt_FEAM,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt_FEAM: size of buffers for each call to pack subtype - CALL FEAM_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_FEAM(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_FEAM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_FEAM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_FEAM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_FEAM - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_FEAM allocated yes/no - IF ( ALLOCATED(InData%u_FEAM) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_FEAM upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_FEAM,1), UBOUND(InData%u_FEAM,1) - Int_BufSz = Int_BufSz + 3 ! u_FEAM: size of buffers for each call to pack subtype - CALL FEAM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_FEAM(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_FEAM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_FEAM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_FEAM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_FEAM - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! x_MD allocated yes/no - IF ( ALLOCATED(InData%x_MD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x_MD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%x_MD,1), UBOUND(InData%x_MD,1) - Int_BufSz = Int_BufSz + 3 ! x_MD: size of buffers for each call to pack subtype - CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_MD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_MD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x_MD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x_MD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x_MD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! xd_MD allocated yes/no - IF ( ALLOCATED(InData%xd_MD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xd_MD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%xd_MD,1), UBOUND(InData%xd_MD,1) - Int_BufSz = Int_BufSz + 3 ! xd_MD: size of buffers for each call to pack subtype - CALL MD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_MD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_MD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd_MD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd_MD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd_MD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! z_MD allocated yes/no - IF ( ALLOCATED(InData%z_MD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z_MD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%z_MD,1), UBOUND(InData%z_MD,1) - Int_BufSz = Int_BufSz + 3 ! z_MD: size of buffers for each call to pack subtype - CALL MD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_MD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_MD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z_MD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z_MD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z_MD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OtherSt_MD allocated yes/no - IF ( ALLOCATED(InData%OtherSt_MD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OtherSt_MD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%OtherSt_MD,1), UBOUND(InData%OtherSt_MD,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt_MD: size of buffers for each call to pack subtype - CALL MD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_MD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_MD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_MD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_MD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_MD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_MD allocated yes/no - IF ( ALLOCATED(InData%u_MD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_MD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_MD,1), UBOUND(InData%u_MD,1) - Int_BufSz = Int_BufSz + 3 ! u_MD: size of buffers for each call to pack subtype - CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_MD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_MD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_MD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_MD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_MD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO + DstMiscLinTypeData%LinTimes = SrcMiscLinTypeData%LinTimes +ENDIF + DstMiscLinTypeData%CopyOP_CtrlCode = SrcMiscLinTypeData%CopyOP_CtrlCode +IF (ALLOCATED(SrcMiscLinTypeData%AzimTarget)) THEN + i1_l = LBOUND(SrcMiscLinTypeData%AzimTarget,1) + i1_u = UBOUND(SrcMiscLinTypeData%AzimTarget,1) + IF (.NOT. ALLOCATED(DstMiscLinTypeData%AzimTarget)) THEN + ALLOCATE(DstMiscLinTypeData%AzimTarget(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%AzimTarget.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + DstMiscLinTypeData%AzimTarget = SrcMiscLinTypeData%AzimTarget +ENDIF + DstMiscLinTypeData%IsConverged = SrcMiscLinTypeData%IsConverged + DstMiscLinTypeData%FoundSteady = SrcMiscLinTypeData%FoundSteady + DstMiscLinTypeData%ForceLin = SrcMiscLinTypeData%ForceLin + DstMiscLinTypeData%n_rot = SrcMiscLinTypeData%n_rot + DstMiscLinTypeData%AzimIndx = SrcMiscLinTypeData%AzimIndx + DstMiscLinTypeData%NextLinTimeIndx = SrcMiscLinTypeData%NextLinTimeIndx +IF (ALLOCATED(SrcMiscLinTypeData%Psi)) THEN + i1_l = LBOUND(SrcMiscLinTypeData%Psi,1) + i1_u = UBOUND(SrcMiscLinTypeData%Psi,1) + IF (.NOT. ALLOCATED(DstMiscLinTypeData%Psi)) THEN + ALLOCATE(DstMiscLinTypeData%Psi(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%Psi.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + DstMiscLinTypeData%Psi = SrcMiscLinTypeData%Psi +ENDIF +IF (ALLOCATED(SrcMiscLinTypeData%y_interp)) THEN + i1_l = LBOUND(SrcMiscLinTypeData%y_interp,1) + i1_u = UBOUND(SrcMiscLinTypeData%y_interp,1) + IF (.NOT. ALLOCATED(DstMiscLinTypeData%y_interp)) THEN + ALLOCATE(DstMiscLinTypeData%y_interp(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%y_interp.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + DstMiscLinTypeData%y_interp = SrcMiscLinTypeData%y_interp +ENDIF +IF (ALLOCATED(SrcMiscLinTypeData%y_ref)) THEN + i1_l = LBOUND(SrcMiscLinTypeData%y_ref,1) + i1_u = UBOUND(SrcMiscLinTypeData%y_ref,1) + IF (.NOT. ALLOCATED(DstMiscLinTypeData%y_ref)) THEN + ALLOCATE(DstMiscLinTypeData%y_ref(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%y_ref.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%x_IceD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x_IceD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_IceD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x_IceD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_IceD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%x_IceD,2), UBOUND(InData%x_IceD,2) - DO i1 = LBOUND(InData%x_IceD,1), UBOUND(InData%x_IceD,1) - CALL IceD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_IceD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! x_IceD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END DO + DstMiscLinTypeData%y_ref = SrcMiscLinTypeData%y_ref +ENDIF +IF (ALLOCATED(SrcMiscLinTypeData%Y_prevRot)) THEN + i1_l = LBOUND(SrcMiscLinTypeData%Y_prevRot,1) + i1_u = UBOUND(SrcMiscLinTypeData%Y_prevRot,1) + i2_l = LBOUND(SrcMiscLinTypeData%Y_prevRot,2) + i2_u = UBOUND(SrcMiscLinTypeData%Y_prevRot,2) + IF (.NOT. ALLOCATED(DstMiscLinTypeData%Y_prevRot)) THEN + ALLOCATE(DstMiscLinTypeData%Y_prevRot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%Y_prevRot.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF ( .NOT. ALLOCATED(InData%xd_IceD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_IceD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_IceD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_IceD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_IceD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%xd_IceD,2), UBOUND(InData%xd_IceD,2) - DO i1 = LBOUND(InData%xd_IceD,1), UBOUND(InData%xd_IceD,1) - CALL IceD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_IceD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! xd_IceD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + DstMiscLinTypeData%Y_prevRot = SrcMiscLinTypeData%Y_prevRot +ENDIF + END SUBROUTINE FAST_CopyMiscLinType - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%z_IceD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z_IceD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_IceD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z_IceD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_IceD,2) - Int_Xferred = Int_Xferred + 2 + SUBROUTINE FAST_DestroyMiscLinType( MiscLinTypeData, ErrStat, ErrMsg ) + TYPE(FAST_MiscLinType), INTENT(INOUT) :: MiscLinTypeData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyMiscLinType' - DO i2 = LBOUND(InData%z_IceD,2), UBOUND(InData%z_IceD,2) - DO i1 = LBOUND(InData%z_IceD,1), UBOUND(InData%z_IceD,1) - CALL IceD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_IceD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! z_IceD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + ErrStat = ErrID_None + ErrMsg = "" - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OtherSt_IceD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_IceD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_IceD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_IceD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_IceD,2) - Int_Xferred = Int_Xferred + 2 +IF (ALLOCATED(MiscLinTypeData%LinTimes)) THEN + DEALLOCATE(MiscLinTypeData%LinTimes) +ENDIF +IF (ALLOCATED(MiscLinTypeData%AzimTarget)) THEN + DEALLOCATE(MiscLinTypeData%AzimTarget) +ENDIF +IF (ALLOCATED(MiscLinTypeData%Psi)) THEN + DEALLOCATE(MiscLinTypeData%Psi) +ENDIF +IF (ALLOCATED(MiscLinTypeData%y_interp)) THEN + DEALLOCATE(MiscLinTypeData%y_interp) +ENDIF +IF (ALLOCATED(MiscLinTypeData%y_ref)) THEN + DEALLOCATE(MiscLinTypeData%y_ref) +ENDIF +IF (ALLOCATED(MiscLinTypeData%Y_prevRot)) THEN + DEALLOCATE(MiscLinTypeData%Y_prevRot) +ENDIF + END SUBROUTINE FAST_DestroyMiscLinType - DO i2 = LBOUND(InData%OtherSt_IceD,2), UBOUND(InData%OtherSt_IceD,2) - DO i1 = LBOUND(InData%OtherSt_IceD,1), UBOUND(InData%OtherSt_IceD,1) - CALL IceD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_IceD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_IceD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END DO +subroutine FAST_PackMiscLinType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FAST_MiscLinType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackMiscLinType' + if (Buf%ErrStat >= AbortErrLev) return + ! LinTimes + call RegPack(Buf, allocated(InData%LinTimes)) + if (allocated(InData%LinTimes)) then + call RegPackBounds(Buf, 1, lbound(InData%LinTimes), ubound(InData%LinTimes)) + call RegPack(Buf, InData%LinTimes) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CopyOP_CtrlCode + call RegPack(Buf, InData%CopyOP_CtrlCode) + if (RegCheckErr(Buf, RoutineName)) return + ! AzimTarget + call RegPack(Buf, allocated(InData%AzimTarget)) + if (allocated(InData%AzimTarget)) then + call RegPackBounds(Buf, 1, lbound(InData%AzimTarget), ubound(InData%AzimTarget)) + call RegPack(Buf, InData%AzimTarget) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! IsConverged + call RegPack(Buf, InData%IsConverged) + if (RegCheckErr(Buf, RoutineName)) return + ! FoundSteady + call RegPack(Buf, InData%FoundSteady) + if (RegCheckErr(Buf, RoutineName)) return + ! ForceLin + call RegPack(Buf, InData%ForceLin) + if (RegCheckErr(Buf, RoutineName)) return + ! n_rot + call RegPack(Buf, InData%n_rot) + if (RegCheckErr(Buf, RoutineName)) return + ! AzimIndx + call RegPack(Buf, InData%AzimIndx) + if (RegCheckErr(Buf, RoutineName)) return + ! NextLinTimeIndx + call RegPack(Buf, InData%NextLinTimeIndx) + if (RegCheckErr(Buf, RoutineName)) return + ! Psi + call RegPack(Buf, allocated(InData%Psi)) + if (allocated(InData%Psi)) then + call RegPackBounds(Buf, 1, lbound(InData%Psi), ubound(InData%Psi)) + call RegPack(Buf, InData%Psi) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! y_interp + call RegPack(Buf, allocated(InData%y_interp)) + if (allocated(InData%y_interp)) then + call RegPackBounds(Buf, 1, lbound(InData%y_interp), ubound(InData%y_interp)) + call RegPack(Buf, InData%y_interp) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! y_ref + call RegPack(Buf, allocated(InData%y_ref)) + if (allocated(InData%y_ref)) then + call RegPackBounds(Buf, 1, lbound(InData%y_ref), ubound(InData%y_ref)) + call RegPack(Buf, InData%y_ref) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Y_prevRot + call RegPack(Buf, allocated(InData%Y_prevRot)) + if (allocated(InData%Y_prevRot)) then + call RegPackBounds(Buf, 2, lbound(InData%Y_prevRot), ubound(InData%Y_prevRot)) + call RegPack(Buf, InData%Y_prevRot) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackMiscLinType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FAST_MiscLinType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackMiscLinType' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! LinTimes + if (allocated(OutData%LinTimes)) deallocate(OutData%LinTimes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinTimes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinTimes) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CopyOP_CtrlCode + call RegUnpack(Buf, OutData%CopyOP_CtrlCode) + if (RegCheckErr(Buf, RoutineName)) return + ! AzimTarget + if (allocated(OutData%AzimTarget)) deallocate(OutData%AzimTarget) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AzimTarget(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AzimTarget.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AzimTarget) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! IsConverged + call RegUnpack(Buf, OutData%IsConverged) + if (RegCheckErr(Buf, RoutineName)) return + ! FoundSteady + call RegUnpack(Buf, OutData%FoundSteady) + if (RegCheckErr(Buf, RoutineName)) return + ! ForceLin + call RegUnpack(Buf, OutData%ForceLin) + if (RegCheckErr(Buf, RoutineName)) return + ! n_rot + call RegUnpack(Buf, OutData%n_rot) + if (RegCheckErr(Buf, RoutineName)) return + ! AzimIndx + call RegUnpack(Buf, OutData%AzimIndx) + if (RegCheckErr(Buf, RoutineName)) return + ! NextLinTimeIndx + call RegUnpack(Buf, OutData%NextLinTimeIndx) + if (RegCheckErr(Buf, RoutineName)) return + ! Psi + if (allocated(OutData%Psi)) deallocate(OutData%Psi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Psi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Psi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Psi) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! y_interp + if (allocated(OutData%y_interp)) deallocate(OutData%y_interp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%y_interp(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_interp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%y_interp) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! y_ref + if (allocated(OutData%y_ref)) deallocate(OutData%y_ref) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%y_ref(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_ref.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%y_ref) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Y_prevRot + if (allocated(OutData%Y_prevRot)) deallocate(OutData%Y_prevRot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Y_prevRot(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y_prevRot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Y_prevRot) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + SUBROUTINE FAST_CopyOutputFileType( SrcOutputFileTypeData, DstOutputFileTypeData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FAST_OutputFileType), INTENT(INOUT) :: SrcOutputFileTypeData + TYPE(FAST_OutputFileType), INTENT(INOUT) :: DstOutputFileTypeData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyOutputFileType' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcOutputFileTypeData%TimeData)) THEN + i1_l = LBOUND(SrcOutputFileTypeData%TimeData,1) + i1_u = UBOUND(SrcOutputFileTypeData%TimeData,1) + IF (.NOT. ALLOCATED(DstOutputFileTypeData%TimeData)) THEN + ALLOCATE(DstOutputFileTypeData%TimeData(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%TimeData.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF ( .NOT. ALLOCATED(InData%u_IceD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_IceD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_IceD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_IceD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_IceD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%u_IceD,2), UBOUND(InData%u_IceD,2) - DO i1 = LBOUND(InData%u_IceD,1), UBOUND(InData%u_IceD,1) - CALL IceD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_IceD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! u_IceD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END DO + DstOutputFileTypeData%TimeData = SrcOutputFileTypeData%TimeData +ENDIF +IF (ALLOCATED(SrcOutputFileTypeData%AllOutData)) THEN + i1_l = LBOUND(SrcOutputFileTypeData%AllOutData,1) + i1_u = UBOUND(SrcOutputFileTypeData%AllOutData,1) + i2_l = LBOUND(SrcOutputFileTypeData%AllOutData,2) + i2_u = UBOUND(SrcOutputFileTypeData%AllOutData,2) + IF (.NOT. ALLOCATED(DstOutputFileTypeData%AllOutData)) THEN + ALLOCATE(DstOutputFileTypeData%AllOutData(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%AllOutData.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF ( .NOT. ALLOCATED(InData%x_BD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x_BD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_BD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x_BD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_BD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%x_BD,2), UBOUND(InData%x_BD,2) - DO i1 = LBOUND(InData%x_BD,1), UBOUND(InData%x_BD,1) - CALL BD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_BD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! x_BD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END DO + DstOutputFileTypeData%AllOutData = SrcOutputFileTypeData%AllOutData +ENDIF + DstOutputFileTypeData%n_Out = SrcOutputFileTypeData%n_Out + DstOutputFileTypeData%NOutSteps = SrcOutputFileTypeData%NOutSteps + DstOutputFileTypeData%numOuts = SrcOutputFileTypeData%numOuts + DstOutputFileTypeData%UnOu = SrcOutputFileTypeData%UnOu + DstOutputFileTypeData%UnSum = SrcOutputFileTypeData%UnSum + DstOutputFileTypeData%UnGra = SrcOutputFileTypeData%UnGra + DstOutputFileTypeData%FileDescLines = SrcOutputFileTypeData%FileDescLines +IF (ALLOCATED(SrcOutputFileTypeData%ChannelNames)) THEN + i1_l = LBOUND(SrcOutputFileTypeData%ChannelNames,1) + i1_u = UBOUND(SrcOutputFileTypeData%ChannelNames,1) + IF (.NOT. ALLOCATED(DstOutputFileTypeData%ChannelNames)) THEN + ALLOCATE(DstOutputFileTypeData%ChannelNames(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%ChannelNames.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF ( .NOT. ALLOCATED(InData%xd_BD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_BD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_BD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_BD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_BD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%xd_BD,2), UBOUND(InData%xd_BD,2) - DO i1 = LBOUND(InData%xd_BD,1), UBOUND(InData%xd_BD,1) - CALL BD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_BD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! xd_BD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END DO + DstOutputFileTypeData%ChannelNames = SrcOutputFileTypeData%ChannelNames +ENDIF +IF (ALLOCATED(SrcOutputFileTypeData%ChannelUnits)) THEN + i1_l = LBOUND(SrcOutputFileTypeData%ChannelUnits,1) + i1_u = UBOUND(SrcOutputFileTypeData%ChannelUnits,1) + IF (.NOT. ALLOCATED(DstOutputFileTypeData%ChannelUnits)) THEN + ALLOCATE(DstOutputFileTypeData%ChannelUnits(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%ChannelUnits.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF ( .NOT. ALLOCATED(InData%z_BD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z_BD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_BD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z_BD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_BD,2) - Int_Xferred = Int_Xferred + 2 + DstOutputFileTypeData%ChannelUnits = SrcOutputFileTypeData%ChannelUnits +ENDIF + DO i1 = LBOUND(SrcOutputFileTypeData%Module_Ver,1), UBOUND(SrcOutputFileTypeData%Module_Ver,1) + CALL NWTC_Library_Copyprogdesc( SrcOutputFileTypeData%Module_Ver(i1), DstOutputFileTypeData%Module_Ver(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DstOutputFileTypeData%Module_Abrev = SrcOutputFileTypeData%Module_Abrev + DstOutputFileTypeData%WriteThisStep = SrcOutputFileTypeData%WriteThisStep + DstOutputFileTypeData%VTK_count = SrcOutputFileTypeData%VTK_count + DstOutputFileTypeData%VTK_LastWaveIndx = SrcOutputFileTypeData%VTK_LastWaveIndx + CALL FAST_Copylinfiletype( SrcOutputFileTypeData%Lin, DstOutputFileTypeData%Lin, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + DstOutputFileTypeData%ActualChanLen = SrcOutputFileTypeData%ActualChanLen + CALL FAST_Copylinstatesave( SrcOutputFileTypeData%op, DstOutputFileTypeData%op, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + DstOutputFileTypeData%DriverWriteOutput = SrcOutputFileTypeData%DriverWriteOutput + END SUBROUTINE FAST_CopyOutputFileType - DO i2 = LBOUND(InData%z_BD,2), UBOUND(InData%z_BD,2) - DO i1 = LBOUND(InData%z_BD,1), UBOUND(InData%z_BD,1) - CALL BD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_BD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! z_BD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + SUBROUTINE FAST_DestroyOutputFileType( OutputFileTypeData, ErrStat, ErrMsg ) + TYPE(FAST_OutputFileType), INTENT(INOUT) :: OutputFileTypeData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyOutputFileType' - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OtherSt_BD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_BD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_BD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_BD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_BD,2) - Int_Xferred = Int_Xferred + 2 + ErrStat = ErrID_None + ErrMsg = "" - DO i2 = LBOUND(InData%OtherSt_BD,2), UBOUND(InData%OtherSt_BD,2) - DO i1 = LBOUND(InData%OtherSt_BD,1), UBOUND(InData%OtherSt_BD,1) - CALL BD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_BD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_BD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN +IF (ALLOCATED(OutputFileTypeData%TimeData)) THEN + DEALLOCATE(OutputFileTypeData%TimeData) +ENDIF +IF (ALLOCATED(OutputFileTypeData%AllOutData)) THEN + DEALLOCATE(OutputFileTypeData%AllOutData) +ENDIF +IF (ALLOCATED(OutputFileTypeData%ChannelNames)) THEN + DEALLOCATE(OutputFileTypeData%ChannelNames) +ENDIF +IF (ALLOCATED(OutputFileTypeData%ChannelUnits)) THEN + DEALLOCATE(OutputFileTypeData%ChannelUnits) +ENDIF +DO i1 = LBOUND(OutputFileTypeData%Module_Ver,1), UBOUND(OutputFileTypeData%Module_Ver,1) + CALL NWTC_Library_DestroyProgDesc( OutputFileTypeData%Module_Ver(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + CALL FAST_DestroyLinFileType( OutputFileTypeData%Lin, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL FAST_DestroyLinStateSave( OutputFileTypeData%op, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END SUBROUTINE FAST_DestroyOutputFileType - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%u_BD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_BD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_BD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_BD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_BD,2) - Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%u_BD,2), UBOUND(InData%u_BD,2) - DO i1 = LBOUND(InData%u_BD,1), UBOUND(InData%u_BD,1) - CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_BD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! u_BD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%x_ED) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x_ED,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_ED,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x_ED,1), UBOUND(InData%x_ED,1) - CALL ED_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_ED(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_ED - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%xd_ED) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_ED,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_ED,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xd_ED,1), UBOUND(InData%xd_ED,1) - CALL ED_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_ED(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_ED - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%z_ED) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z_ED,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_ED,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z_ED,1), UBOUND(InData%z_ED,1) - CALL ED_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_ED(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_ED - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OtherSt_ED) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_ED,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_ED,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OtherSt_ED,1), UBOUND(InData%OtherSt_ED,1) - CALL ED_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_ED(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_ED - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%u_ED) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_ED,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_ED,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_ED,1), UBOUND(InData%u_ED,1) - CALL ED_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_ED(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_ED - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%x_SrvD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x_SrvD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_SrvD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x_SrvD,1), UBOUND(InData%x_SrvD,1) - CALL SrvD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_SrvD(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_SrvD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%xd_SrvD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_SrvD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_SrvD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xd_SrvD,1), UBOUND(InData%xd_SrvD,1) - CALL SrvD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_SrvD(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_SrvD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%z_SrvD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z_SrvD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_SrvD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z_SrvD,1), UBOUND(InData%z_SrvD,1) - CALL SrvD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_SrvD(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_SrvD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OtherSt_SrvD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_SrvD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_SrvD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OtherSt_SrvD,1), UBOUND(InData%OtherSt_SrvD,1) - CALL SrvD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_SrvD(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_SrvD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%u_SrvD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_SrvD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_SrvD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_SrvD,1), UBOUND(InData%u_SrvD,1) - CALL SrvD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_SrvD(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_SrvD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%x_AD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x_AD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_AD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x_AD,1), UBOUND(InData%x_AD,1) - CALL AD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_AD(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%xd_AD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_AD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_AD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xd_AD,1), UBOUND(InData%xd_AD,1) - CALL AD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_AD(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%z_AD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z_AD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_AD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z_AD,1), UBOUND(InData%z_AD,1) - CALL AD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_AD(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO +subroutine FAST_PackOutputFileType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FAST_OutputFileType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackOutputFileType' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + ! TimeData + call RegPack(Buf, allocated(InData%TimeData)) + if (allocated(InData%TimeData)) then + call RegPackBounds(Buf, 1, lbound(InData%TimeData), ubound(InData%TimeData)) + call RegPack(Buf, InData%TimeData) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AllOutData + call RegPack(Buf, allocated(InData%AllOutData)) + if (allocated(InData%AllOutData)) then + call RegPackBounds(Buf, 2, lbound(InData%AllOutData), ubound(InData%AllOutData)) + call RegPack(Buf, InData%AllOutData) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! n_Out + call RegPack(Buf, InData%n_Out) + if (RegCheckErr(Buf, RoutineName)) return + ! NOutSteps + call RegPack(Buf, InData%NOutSteps) + if (RegCheckErr(Buf, RoutineName)) return + ! numOuts + call RegPack(Buf, InData%numOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! UnOu + call RegPack(Buf, InData%UnOu) + if (RegCheckErr(Buf, RoutineName)) return + ! UnSum + call RegPack(Buf, InData%UnSum) + if (RegCheckErr(Buf, RoutineName)) return + ! UnGra + call RegPack(Buf, InData%UnGra) + if (RegCheckErr(Buf, RoutineName)) return + ! FileDescLines + call RegPack(Buf, InData%FileDescLines) + if (RegCheckErr(Buf, RoutineName)) return + ! ChannelNames + call RegPack(Buf, allocated(InData%ChannelNames)) + if (allocated(InData%ChannelNames)) then + call RegPackBounds(Buf, 1, lbound(InData%ChannelNames), ubound(InData%ChannelNames)) + call RegPack(Buf, InData%ChannelNames) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ChannelUnits + call RegPack(Buf, allocated(InData%ChannelUnits)) + if (allocated(InData%ChannelUnits)) then + call RegPackBounds(Buf, 1, lbound(InData%ChannelUnits), ubound(InData%ChannelUnits)) + call RegPack(Buf, InData%ChannelUnits) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Module_Ver + LB(1:1) = lbound(InData%Module_Ver) + UB(1:1) = ubound(InData%Module_Ver) + do i1 = LB(1), UB(1) + call NWTC_Library_PackProgDesc(Buf, InData%Module_Ver(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! Module_Abrev + call RegPack(Buf, InData%Module_Abrev) + if (RegCheckErr(Buf, RoutineName)) return + ! WriteThisStep + call RegPack(Buf, InData%WriteThisStep) + if (RegCheckErr(Buf, RoutineName)) return + ! VTK_count + call RegPack(Buf, InData%VTK_count) + if (RegCheckErr(Buf, RoutineName)) return + ! VTK_LastWaveIndx + call RegPack(Buf, InData%VTK_LastWaveIndx) + if (RegCheckErr(Buf, RoutineName)) return + ! Lin + call FAST_PackLinFileType(Buf, InData%Lin) + if (RegCheckErr(Buf, RoutineName)) return + ! ActualChanLen + call RegPack(Buf, InData%ActualChanLen) + if (RegCheckErr(Buf, RoutineName)) return + ! op + call FAST_PackLinStateSave(Buf, InData%op) + if (RegCheckErr(Buf, RoutineName)) return + ! DriverWriteOutput + call RegPack(Buf, InData%DriverWriteOutput) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackOutputFileType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FAST_OutputFileType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackOutputFileType' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! TimeData + if (allocated(OutData%TimeData)) deallocate(OutData%TimeData) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TimeData(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TimeData.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TimeData) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AllOutData + if (allocated(OutData%AllOutData)) deallocate(OutData%AllOutData) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AllOutData(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOutData.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AllOutData) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! n_Out + call RegUnpack(Buf, OutData%n_Out) + if (RegCheckErr(Buf, RoutineName)) return + ! NOutSteps + call RegUnpack(Buf, OutData%NOutSteps) + if (RegCheckErr(Buf, RoutineName)) return + ! numOuts + call RegUnpack(Buf, OutData%numOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! UnOu + call RegUnpack(Buf, OutData%UnOu) + if (RegCheckErr(Buf, RoutineName)) return + ! UnSum + call RegUnpack(Buf, OutData%UnSum) + if (RegCheckErr(Buf, RoutineName)) return + ! UnGra + call RegUnpack(Buf, OutData%UnGra) + if (RegCheckErr(Buf, RoutineName)) return + ! FileDescLines + call RegUnpack(Buf, OutData%FileDescLines) + if (RegCheckErr(Buf, RoutineName)) return + ! ChannelNames + if (allocated(OutData%ChannelNames)) deallocate(OutData%ChannelNames) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ChannelNames(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChannelNames.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ChannelNames) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ChannelUnits + if (allocated(OutData%ChannelUnits)) deallocate(OutData%ChannelUnits) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ChannelUnits(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChannelUnits.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ChannelUnits) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Module_Ver + LB(1:1) = lbound(OutData%Module_Ver) + UB(1:1) = ubound(OutData%Module_Ver) + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackProgDesc(Buf, OutData%Module_Ver(i1)) ! Module_Ver + end do + ! Module_Abrev + call RegUnpack(Buf, OutData%Module_Abrev) + if (RegCheckErr(Buf, RoutineName)) return + ! WriteThisStep + call RegUnpack(Buf, OutData%WriteThisStep) + if (RegCheckErr(Buf, RoutineName)) return + ! VTK_count + call RegUnpack(Buf, OutData%VTK_count) + if (RegCheckErr(Buf, RoutineName)) return + ! VTK_LastWaveIndx + call RegUnpack(Buf, OutData%VTK_LastWaveIndx) + if (RegCheckErr(Buf, RoutineName)) return + ! Lin + call FAST_UnpackLinFileType(Buf, OutData%Lin) ! Lin + ! ActualChanLen + call RegUnpack(Buf, OutData%ActualChanLen) + if (RegCheckErr(Buf, RoutineName)) return + ! op + call FAST_UnpackLinStateSave(Buf, OutData%op) ! op + ! DriverWriteOutput + call RegUnpack(Buf, OutData%DriverWriteOutput) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + SUBROUTINE FAST_CopyIceDyn_Data( SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(IceDyn_Data), INTENT(INOUT) :: SrcIceDyn_DataData + TYPE(IceDyn_Data), INTENT(INOUT) :: DstIceDyn_DataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyIceDyn_Data' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcIceDyn_DataData%x)) THEN + i1_l = LBOUND(SrcIceDyn_DataData%x,1) + i1_u = UBOUND(SrcIceDyn_DataData%x,1) + i2_l = LBOUND(SrcIceDyn_DataData%x,2) + i2_u = UBOUND(SrcIceDyn_DataData%x,2) + IF (.NOT. ALLOCATED(DstIceDyn_DataData%x)) THEN + ALLOCATE(DstIceDyn_DataData%x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF ( .NOT. ALLOCATED(InData%OtherSt_AD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_AD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_AD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OtherSt_AD,1), UBOUND(InData%OtherSt_AD,1) - CALL AD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_AD(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO + DO i2 = LBOUND(SrcIceDyn_DataData%x,2), UBOUND(SrcIceDyn_DataData%x,2) + DO i1 = LBOUND(SrcIceDyn_DataData%x,1), UBOUND(SrcIceDyn_DataData%x,1) + CALL IceD_CopyContState( SrcIceDyn_DataData%x(i1,i2), DstIceDyn_DataData%x(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + ENDDO +ENDIF +IF (ALLOCATED(SrcIceDyn_DataData%xd)) THEN + i1_l = LBOUND(SrcIceDyn_DataData%xd,1) + i1_u = UBOUND(SrcIceDyn_DataData%xd,1) + i2_l = LBOUND(SrcIceDyn_DataData%xd,2) + i2_u = UBOUND(SrcIceDyn_DataData%xd,2) + IF (.NOT. ALLOCATED(DstIceDyn_DataData%xd)) THEN + ALLOCATE(DstIceDyn_DataData%xd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%xd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF ( .NOT. ALLOCATED(InData%u_AD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_AD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_AD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_AD,1), UBOUND(InData%u_AD,1) - CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_AD(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO + DO i2 = LBOUND(SrcIceDyn_DataData%xd,2), UBOUND(SrcIceDyn_DataData%xd,2) + DO i1 = LBOUND(SrcIceDyn_DataData%xd,1), UBOUND(SrcIceDyn_DataData%xd,1) + CALL IceD_CopyDiscState( SrcIceDyn_DataData%xd(i1,i2), DstIceDyn_DataData%xd(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + ENDDO +ENDIF +IF (ALLOCATED(SrcIceDyn_DataData%z)) THEN + i1_l = LBOUND(SrcIceDyn_DataData%z,1) + i1_u = UBOUND(SrcIceDyn_DataData%z,1) + i2_l = LBOUND(SrcIceDyn_DataData%z,2) + i2_u = UBOUND(SrcIceDyn_DataData%z,2) + IF (.NOT. ALLOCATED(DstIceDyn_DataData%z)) THEN + ALLOCATE(DstIceDyn_DataData%z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%z.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF ( .NOT. ALLOCATED(InData%x_IfW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x_IfW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_IfW,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x_IfW,1), UBOUND(InData%x_IfW,1) - CALL InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_IfW(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO + DO i2 = LBOUND(SrcIceDyn_DataData%z,2), UBOUND(SrcIceDyn_DataData%z,2) + DO i1 = LBOUND(SrcIceDyn_DataData%z,1), UBOUND(SrcIceDyn_DataData%z,1) + CALL IceD_CopyConstrState( SrcIceDyn_DataData%z(i1,i2), DstIceDyn_DataData%z(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + ENDDO +ENDIF +IF (ALLOCATED(SrcIceDyn_DataData%OtherSt)) THEN + i1_l = LBOUND(SrcIceDyn_DataData%OtherSt,1) + i1_u = UBOUND(SrcIceDyn_DataData%OtherSt,1) + i2_l = LBOUND(SrcIceDyn_DataData%OtherSt,2) + i2_u = UBOUND(SrcIceDyn_DataData%OtherSt,2) + IF (.NOT. ALLOCATED(DstIceDyn_DataData%OtherSt)) THEN + ALLOCATE(DstIceDyn_DataData%OtherSt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%OtherSt.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF ( .NOT. ALLOCATED(InData%xd_IfW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_IfW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_IfW,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xd_IfW,1), UBOUND(InData%xd_IfW,1) - CALL InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_IfW(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO + DO i2 = LBOUND(SrcIceDyn_DataData%OtherSt,2), UBOUND(SrcIceDyn_DataData%OtherSt,2) + DO i1 = LBOUND(SrcIceDyn_DataData%OtherSt,1), UBOUND(SrcIceDyn_DataData%OtherSt,1) + CALL IceD_CopyOtherState( SrcIceDyn_DataData%OtherSt(i1,i2), DstIceDyn_DataData%OtherSt(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + ENDDO +ENDIF +IF (ALLOCATED(SrcIceDyn_DataData%p)) THEN + i1_l = LBOUND(SrcIceDyn_DataData%p,1) + i1_u = UBOUND(SrcIceDyn_DataData%p,1) + IF (.NOT. ALLOCATED(DstIceDyn_DataData%p)) THEN + ALLOCATE(DstIceDyn_DataData%p(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%p.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF ( .NOT. ALLOCATED(InData%z_IfW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z_IfW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_IfW,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z_IfW,1), UBOUND(InData%z_IfW,1) - CALL InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_IfW(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO + DO i1 = LBOUND(SrcIceDyn_DataData%p,1), UBOUND(SrcIceDyn_DataData%p,1) + CALL IceD_CopyParam( SrcIceDyn_DataData%p(i1), DstIceDyn_DataData%p(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcIceDyn_DataData%u)) THEN + i1_l = LBOUND(SrcIceDyn_DataData%u,1) + i1_u = UBOUND(SrcIceDyn_DataData%u,1) + IF (.NOT. ALLOCATED(DstIceDyn_DataData%u)) THEN + ALLOCATE(DstIceDyn_DataData%u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF ( .NOT. ALLOCATED(InData%OtherSt_IfW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_IfW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_IfW,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OtherSt_IfW,1), UBOUND(InData%OtherSt_IfW,1) - CALL InflowWind_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_IfW(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO + DO i1 = LBOUND(SrcIceDyn_DataData%u,1), UBOUND(SrcIceDyn_DataData%u,1) + CALL IceD_CopyInput( SrcIceDyn_DataData%u(i1), DstIceDyn_DataData%u(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcIceDyn_DataData%y)) THEN + i1_l = LBOUND(SrcIceDyn_DataData%y,1) + i1_u = UBOUND(SrcIceDyn_DataData%y,1) + IF (.NOT. ALLOCATED(DstIceDyn_DataData%y)) THEN + ALLOCATE(DstIceDyn_DataData%y(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%y.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF ( .NOT. ALLOCATED(InData%u_IfW) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_IfW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_IfW,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_IfW,1), UBOUND(InData%u_IfW,1) - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_IfW(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO + DO i1 = LBOUND(SrcIceDyn_DataData%y,1), UBOUND(SrcIceDyn_DataData%y,1) + CALL IceD_CopyOutput( SrcIceDyn_DataData%y(i1), DstIceDyn_DataData%y(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcIceDyn_DataData%m)) THEN + i1_l = LBOUND(SrcIceDyn_DataData%m,1) + i1_u = UBOUND(SrcIceDyn_DataData%m,1) + IF (.NOT. ALLOCATED(DstIceDyn_DataData%m)) THEN + ALLOCATE(DstIceDyn_DataData%m(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%m.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF ( .NOT. ALLOCATED(InData%x_SD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x_SD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_SD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x_SD,1), UBOUND(InData%x_SD,1) - CALL SD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_SD(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_SD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO + DO i1 = LBOUND(SrcIceDyn_DataData%m,1), UBOUND(SrcIceDyn_DataData%m,1) + CALL IceD_CopyMisc( SrcIceDyn_DataData%m(i1), DstIceDyn_DataData%m(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcIceDyn_DataData%Input)) THEN + i1_l = LBOUND(SrcIceDyn_DataData%Input,1) + i1_u = UBOUND(SrcIceDyn_DataData%Input,1) + i2_l = LBOUND(SrcIceDyn_DataData%Input,2) + i2_u = UBOUND(SrcIceDyn_DataData%Input,2) + IF (.NOT. ALLOCATED(DstIceDyn_DataData%Input)) THEN + ALLOCATE(DstIceDyn_DataData%Input(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF ( .NOT. ALLOCATED(InData%xd_SD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_SD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_SD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xd_SD,1), UBOUND(InData%xd_SD,1) - CALL SD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_SD(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_SD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO + DO i2 = LBOUND(SrcIceDyn_DataData%Input,2), UBOUND(SrcIceDyn_DataData%Input,2) + DO i1 = LBOUND(SrcIceDyn_DataData%Input,1), UBOUND(SrcIceDyn_DataData%Input,1) + CALL IceD_CopyInput( SrcIceDyn_DataData%Input(i1,i2), DstIceDyn_DataData%Input(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + ENDDO +ENDIF +IF (ALLOCATED(SrcIceDyn_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcIceDyn_DataData%InputTimes,1) + i1_u = UBOUND(SrcIceDyn_DataData%InputTimes,1) + i2_l = LBOUND(SrcIceDyn_DataData%InputTimes,2) + i2_u = UBOUND(SrcIceDyn_DataData%InputTimes,2) + IF (.NOT. ALLOCATED(DstIceDyn_DataData%InputTimes)) THEN + ALLOCATE(DstIceDyn_DataData%InputTimes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF ( .NOT. ALLOCATED(InData%z_SD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z_SD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_SD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z_SD,1), UBOUND(InData%z_SD,1) - CALL SD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_SD(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_SD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + DstIceDyn_DataData%InputTimes = SrcIceDyn_DataData%InputTimes +ENDIF + END SUBROUTINE FAST_CopyIceDyn_Data - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OtherSt_SD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_SD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_SD,1) - Int_Xferred = Int_Xferred + 2 + SUBROUTINE FAST_DestroyIceDyn_Data( IceDyn_DataData, ErrStat, ErrMsg ) + TYPE(IceDyn_Data), INTENT(INOUT) :: IceDyn_DataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyIceDyn_Data' - DO i1 = LBOUND(InData%OtherSt_SD,1), UBOUND(InData%OtherSt_SD,1) - CALL SD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_SD(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_SD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + ErrStat = ErrID_None + ErrMsg = "" - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%u_SD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_SD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_SD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_SD,1), UBOUND(InData%u_SD,1) - CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_SD(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_SD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%x_ExtPtfm) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x_ExtPtfm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_ExtPtfm,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x_ExtPtfm,1), UBOUND(InData%x_ExtPtfm,1) - CALL ExtPtfm_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_ExtPtfm(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_ExtPtfm - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%xd_ExtPtfm) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_ExtPtfm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_ExtPtfm,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xd_ExtPtfm,1), UBOUND(InData%xd_ExtPtfm,1) - CALL ExtPtfm_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_ExtPtfm(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_ExtPtfm - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%z_ExtPtfm) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z_ExtPtfm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_ExtPtfm,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z_ExtPtfm,1), UBOUND(InData%z_ExtPtfm,1) - CALL ExtPtfm_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_ExtPtfm(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_ExtPtfm - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OtherSt_ExtPtfm) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_ExtPtfm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_ExtPtfm,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OtherSt_ExtPtfm,1), UBOUND(InData%OtherSt_ExtPtfm,1) - CALL ExtPtfm_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_ExtPtfm(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_ExtPtfm - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%u_ExtPtfm) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_ExtPtfm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_ExtPtfm,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_ExtPtfm,1), UBOUND(InData%u_ExtPtfm,1) - CALL ExtPtfm_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_ExtPtfm(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_ExtPtfm - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%x_HD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x_HD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_HD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x_HD,1), UBOUND(InData%x_HD,1) - CALL HydroDyn_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_HD(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_HD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%xd_HD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_HD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_HD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xd_HD,1), UBOUND(InData%xd_HD,1) - CALL HydroDyn_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_HD(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_HD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%z_HD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z_HD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_HD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z_HD,1), UBOUND(InData%z_HD,1) - CALL HydroDyn_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_HD(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_HD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OtherSt_HD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_HD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_HD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OtherSt_HD,1), UBOUND(InData%OtherSt_HD,1) - CALL HydroDyn_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_HD(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_HD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%u_HD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_HD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_HD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_HD,1), UBOUND(InData%u_HD,1) - CALL HydroDyn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_HD(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_HD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%x_IceF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x_IceF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_IceF,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x_IceF,1), UBOUND(InData%x_IceF,1) - CALL IceFloe_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_IceF(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_IceF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%xd_IceF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_IceF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_IceF,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xd_IceF,1), UBOUND(InData%xd_IceF,1) - CALL IceFloe_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_IceF(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_IceF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%z_IceF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z_IceF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_IceF,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z_IceF,1), UBOUND(InData%z_IceF,1) - CALL IceFloe_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_IceF(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_IceF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OtherSt_IceF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_IceF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_IceF,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OtherSt_IceF,1), UBOUND(InData%OtherSt_IceF,1) - CALL IceFloe_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_IceF(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_IceF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%u_IceF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_IceF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_IceF,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_IceF,1), UBOUND(InData%u_IceF,1) - CALL IceFloe_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_IceF(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_IceF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%x_MAP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x_MAP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_MAP,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x_MAP,1), UBOUND(InData%x_MAP,1) - CALL MAP_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_MAP(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_MAP - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%xd_MAP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_MAP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_MAP,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xd_MAP,1), UBOUND(InData%xd_MAP,1) - CALL MAP_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_MAP(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_MAP - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%z_MAP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z_MAP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_MAP,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z_MAP,1), UBOUND(InData%z_MAP,1) - CALL MAP_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_MAP(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_MAP - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%u_MAP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_MAP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_MAP,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_MAP,1), UBOUND(InData%u_MAP,1) - CALL MAP_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_MAP(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_MAP - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%x_FEAM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x_FEAM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_FEAM,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x_FEAM,1), UBOUND(InData%x_FEAM,1) - CALL FEAM_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_FEAM(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_FEAM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%xd_FEAM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_FEAM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_FEAM,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xd_FEAM,1), UBOUND(InData%xd_FEAM,1) - CALL FEAM_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_FEAM(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_FEAM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%z_FEAM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z_FEAM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_FEAM,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z_FEAM,1), UBOUND(InData%z_FEAM,1) - CALL FEAM_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_FEAM(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_FEAM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OtherSt_FEAM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_FEAM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_FEAM,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OtherSt_FEAM,1), UBOUND(InData%OtherSt_FEAM,1) - CALL FEAM_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_FEAM(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_FEAM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%u_FEAM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_FEAM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_FEAM,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_FEAM,1), UBOUND(InData%u_FEAM,1) - CALL FEAM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_FEAM(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_FEAM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%x_MD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x_MD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_MD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x_MD,1), UBOUND(InData%x_MD,1) - CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_MD(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_MD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%xd_MD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_MD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_MD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xd_MD,1), UBOUND(InData%xd_MD,1) - CALL MD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_MD(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_MD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%z_MD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z_MD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_MD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z_MD,1), UBOUND(InData%z_MD,1) - CALL MD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_MD(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_MD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OtherSt_MD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_MD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_MD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OtherSt_MD,1), UBOUND(InData%OtherSt_MD,1) - CALL MD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_MD(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_MD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%u_MD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_MD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_MD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_MD,1), UBOUND(InData%u_MD,1) - CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_MD(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_MD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN +IF (ALLOCATED(IceDyn_DataData%x)) THEN +DO i2 = LBOUND(IceDyn_DataData%x,2), UBOUND(IceDyn_DataData%x,2) +DO i1 = LBOUND(IceDyn_DataData%x,1), UBOUND(IceDyn_DataData%x,1) + CALL IceD_DestroyContState( IceDyn_DataData%x(i1,i2), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +ENDDO + DEALLOCATE(IceDyn_DataData%x) +ENDIF +IF (ALLOCATED(IceDyn_DataData%xd)) THEN +DO i2 = LBOUND(IceDyn_DataData%xd,2), UBOUND(IceDyn_DataData%xd,2) +DO i1 = LBOUND(IceDyn_DataData%xd,1), UBOUND(IceDyn_DataData%xd,1) + CALL IceD_DestroyDiscState( IceDyn_DataData%xd(i1,i2), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +ENDDO + DEALLOCATE(IceDyn_DataData%xd) +ENDIF +IF (ALLOCATED(IceDyn_DataData%z)) THEN +DO i2 = LBOUND(IceDyn_DataData%z,2), UBOUND(IceDyn_DataData%z,2) +DO i1 = LBOUND(IceDyn_DataData%z,1), UBOUND(IceDyn_DataData%z,1) + CALL IceD_DestroyConstrState( IceDyn_DataData%z(i1,i2), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +ENDDO + DEALLOCATE(IceDyn_DataData%z) +ENDIF +IF (ALLOCATED(IceDyn_DataData%OtherSt)) THEN +DO i2 = LBOUND(IceDyn_DataData%OtherSt,2), UBOUND(IceDyn_DataData%OtherSt,2) +DO i1 = LBOUND(IceDyn_DataData%OtherSt,1), UBOUND(IceDyn_DataData%OtherSt,1) + CALL IceD_DestroyOtherState( IceDyn_DataData%OtherSt(i1,i2), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +ENDDO + DEALLOCATE(IceDyn_DataData%OtherSt) +ENDIF +IF (ALLOCATED(IceDyn_DataData%p)) THEN +DO i1 = LBOUND(IceDyn_DataData%p,1), UBOUND(IceDyn_DataData%p,1) + CALL IceD_DestroyParam( IceDyn_DataData%p(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(IceDyn_DataData%p) +ENDIF +IF (ALLOCATED(IceDyn_DataData%u)) THEN +DO i1 = LBOUND(IceDyn_DataData%u,1), UBOUND(IceDyn_DataData%u,1) + CALL IceD_DestroyInput( IceDyn_DataData%u(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(IceDyn_DataData%u) +ENDIF +IF (ALLOCATED(IceDyn_DataData%y)) THEN +DO i1 = LBOUND(IceDyn_DataData%y,1), UBOUND(IceDyn_DataData%y,1) + CALL IceD_DestroyOutput( IceDyn_DataData%y(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(IceDyn_DataData%y) +ENDIF +IF (ALLOCATED(IceDyn_DataData%m)) THEN +DO i1 = LBOUND(IceDyn_DataData%m,1), UBOUND(IceDyn_DataData%m,1) + CALL IceD_DestroyMisc( IceDyn_DataData%m(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(IceDyn_DataData%m) +ENDIF +IF (ALLOCATED(IceDyn_DataData%Input)) THEN +DO i2 = LBOUND(IceDyn_DataData%Input,2), UBOUND(IceDyn_DataData%Input,2) +DO i1 = LBOUND(IceDyn_DataData%Input,1), UBOUND(IceDyn_DataData%Input,1) + CALL IceD_DestroyInput( IceDyn_DataData%Input(i1,i2), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +ENDDO + DEALLOCATE(IceDyn_DataData%Input) +ENDIF +IF (ALLOCATED(IceDyn_DataData%InputTimes)) THEN + DEALLOCATE(IceDyn_DataData%InputTimes) +ENDIF + END SUBROUTINE FAST_DestroyIceDyn_Data - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - END SUBROUTINE FAST_PackLinStateSave - SUBROUTINE FAST_UnPackLinStateSave( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FAST_LinStateSave), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackLinStateSave' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_IceD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%x_IceD)) DEALLOCATE(OutData%x_IceD) - ALLOCATE(OutData%x_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) +subroutine FAST_PackIceDyn_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IceDyn_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackIceDyn_Data' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + ! x + call RegPack(Buf, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(Buf, 2, lbound(InData%x), ubound(InData%x)) + LB(1:2) = lbound(InData%x) + UB(1:2) = ubound(InData%x) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_PackContState(Buf, InData%x(i1,i2)) + end do + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! xd + call RegPack(Buf, allocated(InData%xd)) + if (allocated(InData%xd)) then + call RegPackBounds(Buf, 2, lbound(InData%xd), ubound(InData%xd)) + LB(1:2) = lbound(InData%xd) + UB(1:2) = ubound(InData%xd) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_PackDiscState(Buf, InData%xd(i1,i2)) + end do + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! z + call RegPack(Buf, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(Buf, 2, lbound(InData%z), ubound(InData%z)) + LB(1:2) = lbound(InData%z) + UB(1:2) = ubound(InData%z) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_PackConstrState(Buf, InData%z(i1,i2)) + end do + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OtherSt + call RegPack(Buf, allocated(InData%OtherSt)) + if (allocated(InData%OtherSt)) then + call RegPackBounds(Buf, 2, lbound(InData%OtherSt), ubound(InData%OtherSt)) + LB(1:2) = lbound(InData%OtherSt) + UB(1:2) = ubound(InData%OtherSt) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_PackOtherState(Buf, InData%OtherSt(i1,i2)) + end do + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! p + call RegPack(Buf, allocated(InData%p)) + if (allocated(InData%p)) then + call RegPackBounds(Buf, 1, lbound(InData%p), ubound(InData%p)) + LB(1:1) = lbound(InData%p) + UB(1:1) = ubound(InData%p) + do i1 = LB(1), UB(1) + call IceD_PackParam(Buf, InData%p(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! u + call RegPack(Buf, allocated(InData%u)) + if (allocated(InData%u)) then + call RegPackBounds(Buf, 1, lbound(InData%u), ubound(InData%u)) + LB(1:1) = lbound(InData%u) + UB(1:1) = ubound(InData%u) + do i1 = LB(1), UB(1) + call IceD_PackInput(Buf, InData%u(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! y + call RegPack(Buf, allocated(InData%y)) + if (allocated(InData%y)) then + call RegPackBounds(Buf, 1, lbound(InData%y), ubound(InData%y)) + LB(1:1) = lbound(InData%y) + UB(1:1) = ubound(InData%y) + do i1 = LB(1), UB(1) + call IceD_PackOutput(Buf, InData%y(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! m + call RegPack(Buf, allocated(InData%m)) + if (allocated(InData%m)) then + call RegPackBounds(Buf, 1, lbound(InData%m), ubound(InData%m)) + LB(1:1) = lbound(InData%m) + UB(1:1) = ubound(InData%m) + do i1 = LB(1), UB(1) + call IceD_PackMisc(Buf, InData%m(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Input + call RegPack(Buf, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(Buf, 2, lbound(InData%Input), ubound(InData%Input)) + LB(1:2) = lbound(InData%Input) + UB(1:2) = ubound(InData%Input) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_PackInput(Buf, InData%Input(i1,i2)) + end do + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! InputTimes + call RegPack(Buf, allocated(InData%InputTimes)) + if (allocated(InData%InputTimes)) then + call RegPackBounds(Buf, 2, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPack(Buf, InData%InputTimes) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackIceDyn_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IceDyn_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackIceDyn_Data' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! x + if (allocated(OutData%x)) deallocate(OutData%x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_UnpackContState(Buf, OutData%x(i1,i2)) ! x + end do + end do + end if + ! xd + if (allocated(OutData%xd)) deallocate(OutData%xd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xd(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_UnpackDiscState(Buf, OutData%xd(i1,i2)) ! xd + end do + end do + end if + ! z + if (allocated(OutData%z)) deallocate(OutData%z) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_UnpackConstrState(Buf, OutData%z(i1,i2)) ! z + end do + end do + end if + ! OtherSt + if (allocated(OutData%OtherSt)) deallocate(OutData%OtherSt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OtherSt(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_UnpackOtherState(Buf, OutData%OtherSt(i1,i2)) ! OtherSt + end do + end do + end if + ! p + if (allocated(OutData%p)) deallocate(OutData%p) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%p(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%p.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceD_UnpackParam(Buf, OutData%p(i1)) ! p + end do + end if + ! u + if (allocated(OutData%u)) deallocate(OutData%u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceD_UnpackInput(Buf, OutData%u(i1)) ! u + end do + end if + ! y + if (allocated(OutData%y)) deallocate(OutData%y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceD_UnpackOutput(Buf, OutData%y(i1)) ! y + end do + end if + ! m + if (allocated(OutData%m)) deallocate(OutData%m) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%m(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%m.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceD_UnpackMisc(Buf, OutData%m(i1)) ! m + end do + end if + ! Input + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_UnpackInput(Buf, OutData%Input(i1,i2)) ! Input + end do + end do + end if + ! InputTimes + if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InputTimes(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InputTimes) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + SUBROUTINE FAST_CopyBeamDyn_Data( SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(BeamDyn_Data), INTENT(INOUT) :: SrcBeamDyn_DataData + TYPE(BeamDyn_Data), INTENT(INOUT) :: DstBeamDyn_DataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyBeamDyn_Data' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcBeamDyn_DataData%x)) THEN + i1_l = LBOUND(SrcBeamDyn_DataData%x,1) + i1_u = UBOUND(SrcBeamDyn_DataData%x,1) + i2_l = LBOUND(SrcBeamDyn_DataData%x,2) + i2_u = UBOUND(SrcBeamDyn_DataData%x,2) + IF (.NOT. ALLOCATED(DstBeamDyn_DataData%x)) THEN + ALLOCATE(DstBeamDyn_DataData%x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_IceD.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%x.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i2 = LBOUND(OutData%x_IceD,2), UBOUND(OutData%x_IceD,2) - DO i1 = LBOUND(OutData%x_IceD,1), UBOUND(OutData%x_IceD,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_IceD(i1,i2), ErrStat2, ErrMsg2 ) ! x_IceD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_IceD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%xd_IceD)) DEALLOCATE(OutData%xd_IceD) - ALLOCATE(OutData%xd_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DO i2 = LBOUND(SrcBeamDyn_DataData%x,2), UBOUND(SrcBeamDyn_DataData%x,2) + DO i1 = LBOUND(SrcBeamDyn_DataData%x,1), UBOUND(SrcBeamDyn_DataData%x,1) + CALL BD_CopyContState( SrcBeamDyn_DataData%x(i1,i2), DstBeamDyn_DataData%x(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + ENDDO +ENDIF +IF (ALLOCATED(SrcBeamDyn_DataData%xd)) THEN + i1_l = LBOUND(SrcBeamDyn_DataData%xd,1) + i1_u = UBOUND(SrcBeamDyn_DataData%xd,1) + i2_l = LBOUND(SrcBeamDyn_DataData%xd,2) + i2_u = UBOUND(SrcBeamDyn_DataData%xd,2) + IF (.NOT. ALLOCATED(DstBeamDyn_DataData%xd)) THEN + ALLOCATE(DstBeamDyn_DataData%xd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_IceD.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%xd.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i2 = LBOUND(OutData%xd_IceD,2), UBOUND(OutData%xd_IceD,2) - DO i1 = LBOUND(OutData%xd_IceD,1), UBOUND(OutData%xd_IceD,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_IceD(i1,i2), ErrStat2, ErrMsg2 ) ! xd_IceD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z_IceD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%z_IceD)) DEALLOCATE(OutData%z_IceD) - ALLOCATE(OutData%z_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DO i2 = LBOUND(SrcBeamDyn_DataData%xd,2), UBOUND(SrcBeamDyn_DataData%xd,2) + DO i1 = LBOUND(SrcBeamDyn_DataData%xd,1), UBOUND(SrcBeamDyn_DataData%xd,1) + CALL BD_CopyDiscState( SrcBeamDyn_DataData%xd(i1,i2), DstBeamDyn_DataData%xd(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + ENDDO +ENDIF +IF (ALLOCATED(SrcBeamDyn_DataData%z)) THEN + i1_l = LBOUND(SrcBeamDyn_DataData%z,1) + i1_u = UBOUND(SrcBeamDyn_DataData%z,1) + i2_l = LBOUND(SrcBeamDyn_DataData%z,2) + i2_u = UBOUND(SrcBeamDyn_DataData%z,2) + IF (.NOT. ALLOCATED(DstBeamDyn_DataData%z)) THEN + ALLOCATE(DstBeamDyn_DataData%z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_IceD.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%z.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i2 = LBOUND(OutData%z_IceD,2), UBOUND(OutData%z_IceD,2) - DO i1 = LBOUND(OutData%z_IceD,1), UBOUND(OutData%z_IceD,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_IceD(i1,i2), ErrStat2, ErrMsg2 ) ! z_IceD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt_IceD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OtherSt_IceD)) DEALLOCATE(OutData%OtherSt_IceD) - ALLOCATE(OutData%OtherSt_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DO i2 = LBOUND(SrcBeamDyn_DataData%z,2), UBOUND(SrcBeamDyn_DataData%z,2) + DO i1 = LBOUND(SrcBeamDyn_DataData%z,1), UBOUND(SrcBeamDyn_DataData%z,1) + CALL BD_CopyConstrState( SrcBeamDyn_DataData%z(i1,i2), DstBeamDyn_DataData%z(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + ENDDO +ENDIF +IF (ALLOCATED(SrcBeamDyn_DataData%OtherSt)) THEN + i1_l = LBOUND(SrcBeamDyn_DataData%OtherSt,1) + i1_u = UBOUND(SrcBeamDyn_DataData%OtherSt,1) + i2_l = LBOUND(SrcBeamDyn_DataData%OtherSt,2) + i2_u = UBOUND(SrcBeamDyn_DataData%OtherSt,2) + IF (.NOT. ALLOCATED(DstBeamDyn_DataData%OtherSt)) THEN + ALLOCATE(DstBeamDyn_DataData%OtherSt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_IceD.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%OtherSt.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i2 = LBOUND(OutData%OtherSt_IceD,2), UBOUND(OutData%OtherSt_IceD,2) - DO i1 = LBOUND(OutData%OtherSt_IceD,1), UBOUND(OutData%OtherSt_IceD,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_IceD(i1,i2), ErrStat2, ErrMsg2 ) ! OtherSt_IceD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_IceD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%u_IceD)) DEALLOCATE(OutData%u_IceD) - ALLOCATE(OutData%u_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_IceD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%u_IceD,2), UBOUND(OutData%u_IceD,2) - DO i1 = LBOUND(OutData%u_IceD,1), UBOUND(OutData%u_IceD,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_IceD(i1,i2), ErrStat2, ErrMsg2 ) ! u_IceD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_BD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%x_BD)) DEALLOCATE(OutData%x_BD) - ALLOCATE(OutData%x_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_BD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%x_BD,2), UBOUND(OutData%x_BD,2) - DO i1 = LBOUND(OutData%x_BD,1), UBOUND(OutData%x_BD,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL BD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_BD(i1,i2), ErrStat2, ErrMsg2 ) ! x_BD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_BD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%xd_BD)) DEALLOCATE(OutData%xd_BD) - ALLOCATE(OutData%xd_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_BD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%xd_BD,2), UBOUND(OutData%xd_BD,2) - DO i1 = LBOUND(OutData%xd_BD,1), UBOUND(OutData%xd_BD,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL BD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_BD(i1,i2), ErrStat2, ErrMsg2 ) ! xd_BD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z_BD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%z_BD)) DEALLOCATE(OutData%z_BD) - ALLOCATE(OutData%z_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DO i2 = LBOUND(SrcBeamDyn_DataData%OtherSt,2), UBOUND(SrcBeamDyn_DataData%OtherSt,2) + DO i1 = LBOUND(SrcBeamDyn_DataData%OtherSt,1), UBOUND(SrcBeamDyn_DataData%OtherSt,1) + CALL BD_CopyOtherState( SrcBeamDyn_DataData%OtherSt(i1,i2), DstBeamDyn_DataData%OtherSt(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + ENDDO +ENDIF +IF (ALLOCATED(SrcBeamDyn_DataData%p)) THEN + i1_l = LBOUND(SrcBeamDyn_DataData%p,1) + i1_u = UBOUND(SrcBeamDyn_DataData%p,1) + IF (.NOT. ALLOCATED(DstBeamDyn_DataData%p)) THEN + ALLOCATE(DstBeamDyn_DataData%p(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_BD.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%p.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i2 = LBOUND(OutData%z_BD,2), UBOUND(OutData%z_BD,2) - DO i1 = LBOUND(OutData%z_BD,1), UBOUND(OutData%z_BD,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL BD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_BD(i1,i2), ErrStat2, ErrMsg2 ) ! z_BD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt_BD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OtherSt_BD)) DEALLOCATE(OutData%OtherSt_BD) - ALLOCATE(OutData%OtherSt_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DO i1 = LBOUND(SrcBeamDyn_DataData%p,1), UBOUND(SrcBeamDyn_DataData%p,1) + CALL BD_CopyParam( SrcBeamDyn_DataData%p(i1), DstBeamDyn_DataData%p(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcBeamDyn_DataData%u)) THEN + i1_l = LBOUND(SrcBeamDyn_DataData%u,1) + i1_u = UBOUND(SrcBeamDyn_DataData%u,1) + IF (.NOT. ALLOCATED(DstBeamDyn_DataData%u)) THEN + ALLOCATE(DstBeamDyn_DataData%u(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_BD.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%u.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i2 = LBOUND(OutData%OtherSt_BD,2), UBOUND(OutData%OtherSt_BD,2) - DO i1 = LBOUND(OutData%OtherSt_BD,1), UBOUND(OutData%OtherSt_BD,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL BD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_BD(i1,i2), ErrStat2, ErrMsg2 ) ! OtherSt_BD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_BD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%u_BD)) DEALLOCATE(OutData%u_BD) - ALLOCATE(OutData%u_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DO i1 = LBOUND(SrcBeamDyn_DataData%u,1), UBOUND(SrcBeamDyn_DataData%u,1) + CALL BD_CopyInput( SrcBeamDyn_DataData%u(i1), DstBeamDyn_DataData%u(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcBeamDyn_DataData%y)) THEN + i1_l = LBOUND(SrcBeamDyn_DataData%y,1) + i1_u = UBOUND(SrcBeamDyn_DataData%y,1) + IF (.NOT. ALLOCATED(DstBeamDyn_DataData%y)) THEN + ALLOCATE(DstBeamDyn_DataData%y(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BD.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%y.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i2 = LBOUND(OutData%u_BD,2), UBOUND(OutData%u_BD,2) - DO i1 = LBOUND(OutData%u_BD,1), UBOUND(OutData%u_BD,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL BD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_BD(i1,i2), ErrStat2, ErrMsg2 ) ! u_BD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_ED not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%x_ED)) DEALLOCATE(OutData%x_ED) - ALLOCATE(OutData%x_ED(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(SrcBeamDyn_DataData%y,1), UBOUND(SrcBeamDyn_DataData%y,1) + CALL BD_CopyOutput( SrcBeamDyn_DataData%y(i1), DstBeamDyn_DataData%y(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcBeamDyn_DataData%m)) THEN + i1_l = LBOUND(SrcBeamDyn_DataData%m,1) + i1_u = UBOUND(SrcBeamDyn_DataData%m,1) + IF (.NOT. ALLOCATED(DstBeamDyn_DataData%m)) THEN + ALLOCATE(DstBeamDyn_DataData%m(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_ED.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%m.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%x_ED,1), UBOUND(OutData%x_ED,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ED_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_ED(i1), ErrStat2, ErrMsg2 ) ! x_ED - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_ED not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%xd_ED)) DEALLOCATE(OutData%xd_ED) - ALLOCATE(OutData%xd_ED(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(SrcBeamDyn_DataData%m,1), UBOUND(SrcBeamDyn_DataData%m,1) + CALL BD_CopyMisc( SrcBeamDyn_DataData%m(i1), DstBeamDyn_DataData%m(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcBeamDyn_DataData%Output)) THEN + i1_l = LBOUND(SrcBeamDyn_DataData%Output,1) + i1_u = UBOUND(SrcBeamDyn_DataData%Output,1) + i2_l = LBOUND(SrcBeamDyn_DataData%Output,2) + i2_u = UBOUND(SrcBeamDyn_DataData%Output,2) + IF (.NOT. ALLOCATED(DstBeamDyn_DataData%Output)) THEN + ALLOCATE(DstBeamDyn_DataData%Output(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_ED.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%xd_ED,1), UBOUND(OutData%xd_ED,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ED_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_ED(i1), ErrStat2, ErrMsg2 ) ! xd_ED - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z_ED not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%z_ED)) DEALLOCATE(OutData%z_ED) - ALLOCATE(OutData%z_ED(i1_l:i1_u),STAT=ErrStat2) + DO i2 = LBOUND(SrcBeamDyn_DataData%Output,2), UBOUND(SrcBeamDyn_DataData%Output,2) + DO i1 = LBOUND(SrcBeamDyn_DataData%Output,1), UBOUND(SrcBeamDyn_DataData%Output,1) + CALL BD_CopyOutput( SrcBeamDyn_DataData%Output(i1,i2), DstBeamDyn_DataData%Output(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + ENDDO +ENDIF +IF (ALLOCATED(SrcBeamDyn_DataData%y_interp)) THEN + i1_l = LBOUND(SrcBeamDyn_DataData%y_interp,1) + i1_u = UBOUND(SrcBeamDyn_DataData%y_interp,1) + IF (.NOT. ALLOCATED(DstBeamDyn_DataData%y_interp)) THEN + ALLOCATE(DstBeamDyn_DataData%y_interp(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_ED.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%y_interp.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%z_ED,1), UBOUND(OutData%z_ED,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ED_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_ED(i1), ErrStat2, ErrMsg2 ) ! z_ED - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt_ED not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OtherSt_ED)) DEALLOCATE(OutData%OtherSt_ED) - ALLOCATE(OutData%OtherSt_ED(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(SrcBeamDyn_DataData%y_interp,1), UBOUND(SrcBeamDyn_DataData%y_interp,1) + CALL BD_CopyOutput( SrcBeamDyn_DataData%y_interp(i1), DstBeamDyn_DataData%y_interp(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcBeamDyn_DataData%Input)) THEN + i1_l = LBOUND(SrcBeamDyn_DataData%Input,1) + i1_u = UBOUND(SrcBeamDyn_DataData%Input,1) + i2_l = LBOUND(SrcBeamDyn_DataData%Input,2) + i2_u = UBOUND(SrcBeamDyn_DataData%Input,2) + IF (.NOT. ALLOCATED(DstBeamDyn_DataData%Input)) THEN + ALLOCATE(DstBeamDyn_DataData%Input(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_ED.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%OtherSt_ED,1), UBOUND(OutData%OtherSt_ED,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ED_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_ED(i1), ErrStat2, ErrMsg2 ) ! OtherSt_ED - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_ED not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%u_ED)) DEALLOCATE(OutData%u_ED) - ALLOCATE(OutData%u_ED(i1_l:i1_u),STAT=ErrStat2) + DO i2 = LBOUND(SrcBeamDyn_DataData%Input,2), UBOUND(SrcBeamDyn_DataData%Input,2) + DO i1 = LBOUND(SrcBeamDyn_DataData%Input,1), UBOUND(SrcBeamDyn_DataData%Input,1) + CALL BD_CopyInput( SrcBeamDyn_DataData%Input(i1,i2), DstBeamDyn_DataData%Input(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + ENDDO +ENDIF +IF (ALLOCATED(SrcBeamDyn_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcBeamDyn_DataData%InputTimes,1) + i1_u = UBOUND(SrcBeamDyn_DataData%InputTimes,1) + i2_l = LBOUND(SrcBeamDyn_DataData%InputTimes,2) + i2_u = UBOUND(SrcBeamDyn_DataData%InputTimes,2) + IF (.NOT. ALLOCATED(DstBeamDyn_DataData%InputTimes)) THEN + ALLOCATE(DstBeamDyn_DataData%InputTimes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_ED.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%u_ED,1), UBOUND(OutData%u_ED,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ED_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_ED(i1), ErrStat2, ErrMsg2 ) ! u_ED - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_SrvD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%x_SrvD)) DEALLOCATE(OutData%x_SrvD) - ALLOCATE(OutData%x_SrvD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_SrvD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%x_SrvD,1), UBOUND(OutData%x_SrvD,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SrvD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_SrvD(i1), ErrStat2, ErrMsg2 ) ! x_SrvD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + DstBeamDyn_DataData%InputTimes = SrcBeamDyn_DataData%InputTimes +ENDIF + END SUBROUTINE FAST_CopyBeamDyn_Data - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_SrvD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%xd_SrvD)) DEALLOCATE(OutData%xd_SrvD) - ALLOCATE(OutData%xd_SrvD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_SrvD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%xd_SrvD,1), UBOUND(OutData%xd_SrvD,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SrvD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_SrvD(i1), ErrStat2, ErrMsg2 ) ! xd_SrvD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + SUBROUTINE FAST_DestroyBeamDyn_Data( BeamDyn_DataData, ErrStat, ErrMsg ) + TYPE(BeamDyn_Data), INTENT(INOUT) :: BeamDyn_DataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyBeamDyn_Data' - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z_SrvD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%z_SrvD)) DEALLOCATE(OutData%z_SrvD) - ALLOCATE(OutData%z_SrvD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_SrvD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%z_SrvD,1), UBOUND(OutData%z_SrvD,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SrvD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_SrvD(i1), ErrStat2, ErrMsg2 ) ! z_SrvD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + ErrStat = ErrID_None + ErrMsg = "" - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt_SrvD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OtherSt_SrvD)) DEALLOCATE(OutData%OtherSt_SrvD) - ALLOCATE(OutData%OtherSt_SrvD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_SrvD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OtherSt_SrvD,1), UBOUND(OutData%OtherSt_SrvD,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SrvD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_SrvD(i1), ErrStat2, ErrMsg2 ) ! OtherSt_SrvD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN +IF (ALLOCATED(BeamDyn_DataData%x)) THEN +DO i2 = LBOUND(BeamDyn_DataData%x,2), UBOUND(BeamDyn_DataData%x,2) +DO i1 = LBOUND(BeamDyn_DataData%x,1), UBOUND(BeamDyn_DataData%x,1) + CALL BD_DestroyContState( BeamDyn_DataData%x(i1,i2), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +ENDDO + DEALLOCATE(BeamDyn_DataData%x) +ENDIF +IF (ALLOCATED(BeamDyn_DataData%xd)) THEN +DO i2 = LBOUND(BeamDyn_DataData%xd,2), UBOUND(BeamDyn_DataData%xd,2) +DO i1 = LBOUND(BeamDyn_DataData%xd,1), UBOUND(BeamDyn_DataData%xd,1) + CALL BD_DestroyDiscState( BeamDyn_DataData%xd(i1,i2), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +ENDDO + DEALLOCATE(BeamDyn_DataData%xd) +ENDIF +IF (ALLOCATED(BeamDyn_DataData%z)) THEN +DO i2 = LBOUND(BeamDyn_DataData%z,2), UBOUND(BeamDyn_DataData%z,2) +DO i1 = LBOUND(BeamDyn_DataData%z,1), UBOUND(BeamDyn_DataData%z,1) + CALL BD_DestroyConstrState( BeamDyn_DataData%z(i1,i2), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +ENDDO + DEALLOCATE(BeamDyn_DataData%z) +ENDIF +IF (ALLOCATED(BeamDyn_DataData%OtherSt)) THEN +DO i2 = LBOUND(BeamDyn_DataData%OtherSt,2), UBOUND(BeamDyn_DataData%OtherSt,2) +DO i1 = LBOUND(BeamDyn_DataData%OtherSt,1), UBOUND(BeamDyn_DataData%OtherSt,1) + CALL BD_DestroyOtherState( BeamDyn_DataData%OtherSt(i1,i2), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +ENDDO + DEALLOCATE(BeamDyn_DataData%OtherSt) +ENDIF +IF (ALLOCATED(BeamDyn_DataData%p)) THEN +DO i1 = LBOUND(BeamDyn_DataData%p,1), UBOUND(BeamDyn_DataData%p,1) + CALL BD_DestroyParam( BeamDyn_DataData%p(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(BeamDyn_DataData%p) +ENDIF +IF (ALLOCATED(BeamDyn_DataData%u)) THEN +DO i1 = LBOUND(BeamDyn_DataData%u,1), UBOUND(BeamDyn_DataData%u,1) + CALL BD_DestroyInput( BeamDyn_DataData%u(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(BeamDyn_DataData%u) +ENDIF +IF (ALLOCATED(BeamDyn_DataData%y)) THEN +DO i1 = LBOUND(BeamDyn_DataData%y,1), UBOUND(BeamDyn_DataData%y,1) + CALL BD_DestroyOutput( BeamDyn_DataData%y(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(BeamDyn_DataData%y) +ENDIF +IF (ALLOCATED(BeamDyn_DataData%m)) THEN +DO i1 = LBOUND(BeamDyn_DataData%m,1), UBOUND(BeamDyn_DataData%m,1) + CALL BD_DestroyMisc( BeamDyn_DataData%m(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(BeamDyn_DataData%m) +ENDIF +IF (ALLOCATED(BeamDyn_DataData%Output)) THEN +DO i2 = LBOUND(BeamDyn_DataData%Output,2), UBOUND(BeamDyn_DataData%Output,2) +DO i1 = LBOUND(BeamDyn_DataData%Output,1), UBOUND(BeamDyn_DataData%Output,1) + CALL BD_DestroyOutput( BeamDyn_DataData%Output(i1,i2), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +ENDDO + DEALLOCATE(BeamDyn_DataData%Output) +ENDIF +IF (ALLOCATED(BeamDyn_DataData%y_interp)) THEN +DO i1 = LBOUND(BeamDyn_DataData%y_interp,1), UBOUND(BeamDyn_DataData%y_interp,1) + CALL BD_DestroyOutput( BeamDyn_DataData%y_interp(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(BeamDyn_DataData%y_interp) +ENDIF +IF (ALLOCATED(BeamDyn_DataData%Input)) THEN +DO i2 = LBOUND(BeamDyn_DataData%Input,2), UBOUND(BeamDyn_DataData%Input,2) +DO i1 = LBOUND(BeamDyn_DataData%Input,1), UBOUND(BeamDyn_DataData%Input,1) + CALL BD_DestroyInput( BeamDyn_DataData%Input(i1,i2), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +ENDDO + DEALLOCATE(BeamDyn_DataData%Input) +ENDIF +IF (ALLOCATED(BeamDyn_DataData%InputTimes)) THEN + DEALLOCATE(BeamDyn_DataData%InputTimes) +ENDIF + END SUBROUTINE FAST_DestroyBeamDyn_Data - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_SrvD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%u_SrvD)) DEALLOCATE(OutData%u_SrvD) - ALLOCATE(OutData%u_SrvD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SrvD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_SrvD,1), UBOUND(OutData%u_SrvD,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SrvD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_SrvD(i1), ErrStat2, ErrMsg2 ) ! u_SrvD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_AD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%x_AD)) DEALLOCATE(OutData%x_AD) - ALLOCATE(OutData%x_AD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_AD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%x_AD,1), UBOUND(OutData%x_AD,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_AD(i1), ErrStat2, ErrMsg2 ) ! x_AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_AD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%xd_AD)) DEALLOCATE(OutData%xd_AD) - ALLOCATE(OutData%xd_AD(i1_l:i1_u),STAT=ErrStat2) +subroutine FAST_PackBeamDyn_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BeamDyn_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackBeamDyn_Data' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + ! x + call RegPack(Buf, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(Buf, 2, lbound(InData%x), ubound(InData%x)) + LB(1:2) = lbound(InData%x) + UB(1:2) = ubound(InData%x) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_PackContState(Buf, InData%x(i1,i2)) + end do + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! xd + call RegPack(Buf, allocated(InData%xd)) + if (allocated(InData%xd)) then + call RegPackBounds(Buf, 2, lbound(InData%xd), ubound(InData%xd)) + LB(1:2) = lbound(InData%xd) + UB(1:2) = ubound(InData%xd) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_PackDiscState(Buf, InData%xd(i1,i2)) + end do + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! z + call RegPack(Buf, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(Buf, 2, lbound(InData%z), ubound(InData%z)) + LB(1:2) = lbound(InData%z) + UB(1:2) = ubound(InData%z) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_PackConstrState(Buf, InData%z(i1,i2)) + end do + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OtherSt + call RegPack(Buf, allocated(InData%OtherSt)) + if (allocated(InData%OtherSt)) then + call RegPackBounds(Buf, 2, lbound(InData%OtherSt), ubound(InData%OtherSt)) + LB(1:2) = lbound(InData%OtherSt) + UB(1:2) = ubound(InData%OtherSt) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_PackOtherState(Buf, InData%OtherSt(i1,i2)) + end do + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! p + call RegPack(Buf, allocated(InData%p)) + if (allocated(InData%p)) then + call RegPackBounds(Buf, 1, lbound(InData%p), ubound(InData%p)) + LB(1:1) = lbound(InData%p) + UB(1:1) = ubound(InData%p) + do i1 = LB(1), UB(1) + call BD_PackParam(Buf, InData%p(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! u + call RegPack(Buf, allocated(InData%u)) + if (allocated(InData%u)) then + call RegPackBounds(Buf, 1, lbound(InData%u), ubound(InData%u)) + LB(1:1) = lbound(InData%u) + UB(1:1) = ubound(InData%u) + do i1 = LB(1), UB(1) + call BD_PackInput(Buf, InData%u(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! y + call RegPack(Buf, allocated(InData%y)) + if (allocated(InData%y)) then + call RegPackBounds(Buf, 1, lbound(InData%y), ubound(InData%y)) + LB(1:1) = lbound(InData%y) + UB(1:1) = ubound(InData%y) + do i1 = LB(1), UB(1) + call BD_PackOutput(Buf, InData%y(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! m + call RegPack(Buf, allocated(InData%m)) + if (allocated(InData%m)) then + call RegPackBounds(Buf, 1, lbound(InData%m), ubound(InData%m)) + LB(1:1) = lbound(InData%m) + UB(1:1) = ubound(InData%m) + do i1 = LB(1), UB(1) + call BD_PackMisc(Buf, InData%m(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Output + call RegPack(Buf, allocated(InData%Output)) + if (allocated(InData%Output)) then + call RegPackBounds(Buf, 2, lbound(InData%Output), ubound(InData%Output)) + LB(1:2) = lbound(InData%Output) + UB(1:2) = ubound(InData%Output) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_PackOutput(Buf, InData%Output(i1,i2)) + end do + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! y_interp + call RegPack(Buf, allocated(InData%y_interp)) + if (allocated(InData%y_interp)) then + call RegPackBounds(Buf, 1, lbound(InData%y_interp), ubound(InData%y_interp)) + LB(1:1) = lbound(InData%y_interp) + UB(1:1) = ubound(InData%y_interp) + do i1 = LB(1), UB(1) + call BD_PackOutput(Buf, InData%y_interp(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Input + call RegPack(Buf, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(Buf, 2, lbound(InData%Input), ubound(InData%Input)) + LB(1:2) = lbound(InData%Input) + UB(1:2) = ubound(InData%Input) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_PackInput(Buf, InData%Input(i1,i2)) + end do + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! InputTimes + call RegPack(Buf, allocated(InData%InputTimes)) + if (allocated(InData%InputTimes)) then + call RegPackBounds(Buf, 2, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPack(Buf, InData%InputTimes) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackBeamDyn_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BeamDyn_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackBeamDyn_Data' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! x + if (allocated(OutData%x)) deallocate(OutData%x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_UnpackContState(Buf, OutData%x(i1,i2)) ! x + end do + end do + end if + ! xd + if (allocated(OutData%xd)) deallocate(OutData%xd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xd(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_UnpackDiscState(Buf, OutData%xd(i1,i2)) ! xd + end do + end do + end if + ! z + if (allocated(OutData%z)) deallocate(OutData%z) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_UnpackConstrState(Buf, OutData%z(i1,i2)) ! z + end do + end do + end if + ! OtherSt + if (allocated(OutData%OtherSt)) deallocate(OutData%OtherSt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OtherSt(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_UnpackOtherState(Buf, OutData%OtherSt(i1,i2)) ! OtherSt + end do + end do + end if + ! p + if (allocated(OutData%p)) deallocate(OutData%p) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%p(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%p.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call BD_UnpackParam(Buf, OutData%p(i1)) ! p + end do + end if + ! u + if (allocated(OutData%u)) deallocate(OutData%u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call BD_UnpackInput(Buf, OutData%u(i1)) ! u + end do + end if + ! y + if (allocated(OutData%y)) deallocate(OutData%y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call BD_UnpackOutput(Buf, OutData%y(i1)) ! y + end do + end if + ! m + if (allocated(OutData%m)) deallocate(OutData%m) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%m(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%m.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call BD_UnpackMisc(Buf, OutData%m(i1)) ! m + end do + end if + ! Output + if (allocated(OutData%Output)) deallocate(OutData%Output) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Output(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_UnpackOutput(Buf, OutData%Output(i1,i2)) ! Output + end do + end do + end if + ! y_interp + if (allocated(OutData%y_interp)) deallocate(OutData%y_interp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%y_interp(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_interp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call BD_UnpackOutput(Buf, OutData%y_interp(i1)) ! y_interp + end do + end if + ! Input + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_UnpackInput(Buf, OutData%Input(i1,i2)) ! Input + end do + end do + end if + ! InputTimes + if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InputTimes(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InputTimes) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + SUBROUTINE FAST_CopyElastoDyn_Data( SrcElastoDyn_DataData, DstElastoDyn_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ElastoDyn_Data), INTENT(INOUT) :: SrcElastoDyn_DataData + TYPE(ElastoDyn_Data), INTENT(INOUT) :: DstElastoDyn_DataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyElastoDyn_Data' +! + ErrStat = ErrID_None + ErrMsg = "" + DO i1 = LBOUND(SrcElastoDyn_DataData%x,1), UBOUND(SrcElastoDyn_DataData%x,1) + CALL ED_CopyContState( SrcElastoDyn_DataData%x(i1), DstElastoDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcElastoDyn_DataData%xd,1), UBOUND(SrcElastoDyn_DataData%xd,1) + CALL ED_CopyDiscState( SrcElastoDyn_DataData%xd(i1), DstElastoDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcElastoDyn_DataData%z,1), UBOUND(SrcElastoDyn_DataData%z,1) + CALL ED_CopyConstrState( SrcElastoDyn_DataData%z(i1), DstElastoDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcElastoDyn_DataData%OtherSt,1), UBOUND(SrcElastoDyn_DataData%OtherSt,1) + CALL ED_CopyOtherState( SrcElastoDyn_DataData%OtherSt(i1), DstElastoDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + CALL ED_CopyParam( SrcElastoDyn_DataData%p, DstElastoDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL ED_CopyInput( SrcElastoDyn_DataData%u, DstElastoDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL ED_CopyOutput( SrcElastoDyn_DataData%y, DstElastoDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL ED_CopyMisc( SrcElastoDyn_DataData%m, DstElastoDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcElastoDyn_DataData%Output)) THEN + i1_l = LBOUND(SrcElastoDyn_DataData%Output,1) + i1_u = UBOUND(SrcElastoDyn_DataData%Output,1) + IF (.NOT. ALLOCATED(DstElastoDyn_DataData%Output)) THEN + ALLOCATE(DstElastoDyn_DataData%Output(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_AD.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%xd_AD,1), UBOUND(OutData%xd_AD,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_AD(i1), ErrStat2, ErrMsg2 ) ! xd_AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z_AD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%z_AD)) DEALLOCATE(OutData%z_AD) - ALLOCATE(OutData%z_AD(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(SrcElastoDyn_DataData%Output,1), UBOUND(SrcElastoDyn_DataData%Output,1) + CALL ED_CopyOutput( SrcElastoDyn_DataData%Output(i1), DstElastoDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + CALL ED_CopyOutput( SrcElastoDyn_DataData%y_interp, DstElastoDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcElastoDyn_DataData%Input)) THEN + i1_l = LBOUND(SrcElastoDyn_DataData%Input,1) + i1_u = UBOUND(SrcElastoDyn_DataData%Input,1) + IF (.NOT. ALLOCATED(DstElastoDyn_DataData%Input)) THEN + ALLOCATE(DstElastoDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_AD.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%z_AD,1), UBOUND(OutData%z_AD,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_AD(i1), ErrStat2, ErrMsg2 ) ! z_AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt_AD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OtherSt_AD)) DEALLOCATE(OutData%OtherSt_AD) - ALLOCATE(OutData%OtherSt_AD(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(SrcElastoDyn_DataData%Input,1), UBOUND(SrcElastoDyn_DataData%Input,1) + CALL ED_CopyInput( SrcElastoDyn_DataData%Input(i1), DstElastoDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcElastoDyn_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcElastoDyn_DataData%InputTimes,1) + i1_u = UBOUND(SrcElastoDyn_DataData%InputTimes,1) + IF (.NOT. ALLOCATED(DstElastoDyn_DataData%InputTimes)) THEN + ALLOCATE(DstElastoDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_AD.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%OtherSt_AD,1), UBOUND(OutData%OtherSt_AD,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_AD(i1), ErrStat2, ErrMsg2 ) ! OtherSt_AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_AD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%u_AD)) DEALLOCATE(OutData%u_AD) - ALLOCATE(OutData%u_AD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_AD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_AD,1), UBOUND(OutData%u_AD,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_AD(i1), ErrStat2, ErrMsg2 ) ! u_AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + DstElastoDyn_DataData%InputTimes = SrcElastoDyn_DataData%InputTimes +ENDIF + END SUBROUTINE FAST_CopyElastoDyn_Data - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_IfW not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%x_IfW)) DEALLOCATE(OutData%x_IfW) - ALLOCATE(OutData%x_IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%x_IfW,1), UBOUND(OutData%x_IfW,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_IfW(i1), ErrStat2, ErrMsg2 ) ! x_IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + SUBROUTINE FAST_DestroyElastoDyn_Data( ElastoDyn_DataData, ErrStat, ErrMsg ) + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ElastoDyn_DataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyElastoDyn_Data' - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_IfW not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%xd_IfW)) DEALLOCATE(OutData%xd_IfW) - ALLOCATE(OutData%xd_IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%xd_IfW,1), UBOUND(OutData%xd_IfW,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_IfW(i1), ErrStat2, ErrMsg2 ) ! xd_IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + ErrStat = ErrID_None + ErrMsg = "" - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z_IfW not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%z_IfW)) DEALLOCATE(OutData%z_IfW) - ALLOCATE(OutData%z_IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%z_IfW,1), UBOUND(OutData%z_IfW,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_IfW(i1), ErrStat2, ErrMsg2 ) ! z_IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN +DO i1 = LBOUND(ElastoDyn_DataData%x,1), UBOUND(ElastoDyn_DataData%x,1) + CALL ED_DestroyContState( ElastoDyn_DataData%x(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +DO i1 = LBOUND(ElastoDyn_DataData%xd,1), UBOUND(ElastoDyn_DataData%xd,1) + CALL ED_DestroyDiscState( ElastoDyn_DataData%xd(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +DO i1 = LBOUND(ElastoDyn_DataData%z,1), UBOUND(ElastoDyn_DataData%z,1) + CALL ED_DestroyConstrState( ElastoDyn_DataData%z(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +DO i1 = LBOUND(ElastoDyn_DataData%OtherSt,1), UBOUND(ElastoDyn_DataData%OtherSt,1) + CALL ED_DestroyOtherState( ElastoDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + CALL ED_DestroyParam( ElastoDyn_DataData%p, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL ED_DestroyInput( ElastoDyn_DataData%u, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL ED_DestroyOutput( ElastoDyn_DataData%y, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL ED_DestroyMisc( ElastoDyn_DataData%m, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(ElastoDyn_DataData%Output)) THEN +DO i1 = LBOUND(ElastoDyn_DataData%Output,1), UBOUND(ElastoDyn_DataData%Output,1) + CALL ED_DestroyOutput( ElastoDyn_DataData%Output(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(ElastoDyn_DataData%Output) +ENDIF + CALL ED_DestroyOutput( ElastoDyn_DataData%y_interp, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(ElastoDyn_DataData%Input)) THEN +DO i1 = LBOUND(ElastoDyn_DataData%Input,1), UBOUND(ElastoDyn_DataData%Input,1) + CALL ED_DestroyInput( ElastoDyn_DataData%Input(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(ElastoDyn_DataData%Input) +ENDIF +IF (ALLOCATED(ElastoDyn_DataData%InputTimes)) THEN + DEALLOCATE(ElastoDyn_DataData%InputTimes) +ENDIF + END SUBROUTINE FAST_DestroyElastoDyn_Data - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt_IfW not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OtherSt_IfW)) DEALLOCATE(OutData%OtherSt_IfW) - ALLOCATE(OutData%OtherSt_IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OtherSt_IfW,1), UBOUND(OutData%OtherSt_IfW,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_IfW(i1), ErrStat2, ErrMsg2 ) ! OtherSt_IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_IfW not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%u_IfW)) DEALLOCATE(OutData%u_IfW) - ALLOCATE(OutData%u_IfW(i1_l:i1_u),STAT=ErrStat2) +subroutine FAST_PackElastoDyn_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ElastoDyn_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackElastoDyn_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! x + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call ED_PackContState(Buf, InData%x(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! xd + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call ED_PackDiscState(Buf, InData%xd(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! z + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call ED_PackConstrState(Buf, InData%z(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! OtherSt + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call ED_PackOtherState(Buf, InData%OtherSt(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! p + call ED_PackParam(Buf, InData%p) + if (RegCheckErr(Buf, RoutineName)) return + ! u + call ED_PackInput(Buf, InData%u) + if (RegCheckErr(Buf, RoutineName)) return + ! y + call ED_PackOutput(Buf, InData%y) + if (RegCheckErr(Buf, RoutineName)) return + ! m + call ED_PackMisc(Buf, InData%m) + if (RegCheckErr(Buf, RoutineName)) return + ! Output + call RegPack(Buf, allocated(InData%Output)) + if (allocated(InData%Output)) then + call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) + LB(1:1) = lbound(InData%Output) + UB(1:1) = ubound(InData%Output) + do i1 = LB(1), UB(1) + call ED_PackOutput(Buf, InData%Output(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! y_interp + call ED_PackOutput(Buf, InData%y_interp) + if (RegCheckErr(Buf, RoutineName)) return + ! Input + call RegPack(Buf, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call ED_PackInput(Buf, InData%Input(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! InputTimes + call RegPack(Buf, allocated(InData%InputTimes)) + if (allocated(InData%InputTimes)) then + call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPack(Buf, InData%InputTimes) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackElastoDyn_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ElastoDyn_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackElastoDyn_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! x + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) + do i1 = LB(1), UB(1) + call ED_UnpackContState(Buf, OutData%x(i1)) ! x + end do + ! xd + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) + do i1 = LB(1), UB(1) + call ED_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + end do + ! z + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) + do i1 = LB(1), UB(1) + call ED_UnpackConstrState(Buf, OutData%z(i1)) ! z + end do + ! OtherSt + LB(1:1) = lbound(OutData%OtherSt) + UB(1:1) = ubound(OutData%OtherSt) + do i1 = LB(1), UB(1) + call ED_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + end do + ! p + call ED_UnpackParam(Buf, OutData%p) ! p + ! u + call ED_UnpackInput(Buf, OutData%u) ! u + ! y + call ED_UnpackOutput(Buf, OutData%y) ! y + ! m + call ED_UnpackMisc(Buf, OutData%m) ! m + ! Output + if (allocated(OutData%Output)) deallocate(OutData%Output) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Output(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ED_UnpackOutput(Buf, OutData%Output(i1)) ! Output + end do + end if + ! y_interp + call ED_UnpackOutput(Buf, OutData%y_interp) ! y_interp + ! Input + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ED_UnpackInput(Buf, OutData%Input(i1)) ! Input + end do + end if + ! InputTimes + if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InputTimes) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + SUBROUTINE FAST_CopyServoDyn_Data( SrcServoDyn_DataData, DstServoDyn_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrcServoDyn_DataData + TYPE(ServoDyn_Data), INTENT(INOUT) :: DstServoDyn_DataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyServoDyn_Data' +! + ErrStat = ErrID_None + ErrMsg = "" + DO i1 = LBOUND(SrcServoDyn_DataData%x,1), UBOUND(SrcServoDyn_DataData%x,1) + CALL SrvD_CopyContState( SrcServoDyn_DataData%x(i1), DstServoDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcServoDyn_DataData%xd,1), UBOUND(SrcServoDyn_DataData%xd,1) + CALL SrvD_CopyDiscState( SrcServoDyn_DataData%xd(i1), DstServoDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcServoDyn_DataData%z,1), UBOUND(SrcServoDyn_DataData%z,1) + CALL SrvD_CopyConstrState( SrcServoDyn_DataData%z(i1), DstServoDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcServoDyn_DataData%OtherSt,1), UBOUND(SrcServoDyn_DataData%OtherSt,1) + CALL SrvD_CopyOtherState( SrcServoDyn_DataData%OtherSt(i1), DstServoDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + CALL SrvD_CopyParam( SrcServoDyn_DataData%p, DstServoDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL SrvD_CopyInput( SrcServoDyn_DataData%u, DstServoDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL SrvD_CopyOutput( SrcServoDyn_DataData%y, DstServoDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL SrvD_CopyMisc( SrcServoDyn_DataData%m, DstServoDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcServoDyn_DataData%Output)) THEN + i1_l = LBOUND(SrcServoDyn_DataData%Output,1) + i1_u = UBOUND(SrcServoDyn_DataData%Output,1) + IF (.NOT. ALLOCATED(DstServoDyn_DataData%Output)) THEN + ALLOCATE(DstServoDyn_DataData%Output(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_IfW.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%u_IfW,1), UBOUND(OutData%u_IfW,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_IfW(i1), ErrStat2, ErrMsg2 ) ! u_IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_SD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%x_SD)) DEALLOCATE(OutData%x_SD) - ALLOCATE(OutData%x_SD(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(SrcServoDyn_DataData%Output,1), UBOUND(SrcServoDyn_DataData%Output,1) + CALL SrvD_CopyOutput( SrcServoDyn_DataData%Output(i1), DstServoDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + CALL SrvD_CopyOutput( SrcServoDyn_DataData%y_interp, DstServoDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcServoDyn_DataData%Input)) THEN + i1_l = LBOUND(SrcServoDyn_DataData%Input,1) + i1_u = UBOUND(SrcServoDyn_DataData%Input,1) + IF (.NOT. ALLOCATED(DstServoDyn_DataData%Input)) THEN + ALLOCATE(DstServoDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_SD.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%x_SD,1), UBOUND(OutData%x_SD,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_SD(i1), ErrStat2, ErrMsg2 ) ! x_SD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_SD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%xd_SD)) DEALLOCATE(OutData%xd_SD) - ALLOCATE(OutData%xd_SD(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(SrcServoDyn_DataData%Input,1), UBOUND(SrcServoDyn_DataData%Input,1) + CALL SrvD_CopyInput( SrcServoDyn_DataData%Input(i1), DstServoDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcServoDyn_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcServoDyn_DataData%InputTimes,1) + i1_u = UBOUND(SrcServoDyn_DataData%InputTimes,1) + IF (.NOT. ALLOCATED(DstServoDyn_DataData%InputTimes)) THEN + ALLOCATE(DstServoDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_SD.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%xd_SD,1), UBOUND(OutData%xd_SD,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_SD(i1), ErrStat2, ErrMsg2 ) ! xd_SD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z_SD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%z_SD)) DEALLOCATE(OutData%z_SD) - ALLOCATE(OutData%z_SD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_SD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%z_SD,1), UBOUND(OutData%z_SD,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_SD(i1), ErrStat2, ErrMsg2 ) ! z_SD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + DstServoDyn_DataData%InputTimes = SrcServoDyn_DataData%InputTimes +ENDIF + END SUBROUTINE FAST_CopyServoDyn_Data - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt_SD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OtherSt_SD)) DEALLOCATE(OutData%OtherSt_SD) - ALLOCATE(OutData%OtherSt_SD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_SD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OtherSt_SD,1), UBOUND(OutData%OtherSt_SD,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_SD(i1), ErrStat2, ErrMsg2 ) ! OtherSt_SD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_SD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%u_SD)) DEALLOCATE(OutData%u_SD) - ALLOCATE(OutData%u_SD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_SD,1), UBOUND(OutData%u_SD,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_SD(i1), ErrStat2, ErrMsg2 ) ! u_SD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_ExtPtfm not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%x_ExtPtfm)) DEALLOCATE(OutData%x_ExtPtfm) - ALLOCATE(OutData%x_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_ExtPtfm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%x_ExtPtfm,1), UBOUND(OutData%x_ExtPtfm,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ExtPtfm_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_ExtPtfm(i1), ErrStat2, ErrMsg2 ) ! x_ExtPtfm - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_ExtPtfm not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%xd_ExtPtfm)) DEALLOCATE(OutData%xd_ExtPtfm) - ALLOCATE(OutData%xd_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_ExtPtfm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%xd_ExtPtfm,1), UBOUND(OutData%xd_ExtPtfm,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ExtPtfm_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_ExtPtfm(i1), ErrStat2, ErrMsg2 ) ! xd_ExtPtfm - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z_ExtPtfm not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%z_ExtPtfm)) DEALLOCATE(OutData%z_ExtPtfm) - ALLOCATE(OutData%z_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_ExtPtfm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%z_ExtPtfm,1), UBOUND(OutData%z_ExtPtfm,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ExtPtfm_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_ExtPtfm(i1), ErrStat2, ErrMsg2 ) ! z_ExtPtfm - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt_ExtPtfm not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OtherSt_ExtPtfm)) DEALLOCATE(OutData%OtherSt_ExtPtfm) - ALLOCATE(OutData%OtherSt_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_ExtPtfm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OtherSt_ExtPtfm,1), UBOUND(OutData%OtherSt_ExtPtfm,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ExtPtfm_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_ExtPtfm(i1), ErrStat2, ErrMsg2 ) ! OtherSt_ExtPtfm - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_ExtPtfm not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%u_ExtPtfm)) DEALLOCATE(OutData%u_ExtPtfm) - ALLOCATE(OutData%u_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_ExtPtfm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_ExtPtfm,1), UBOUND(OutData%u_ExtPtfm,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ExtPtfm_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_ExtPtfm(i1), ErrStat2, ErrMsg2 ) ! u_ExtPtfm - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_HD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%x_HD)) DEALLOCATE(OutData%x_HD) - ALLOCATE(OutData%x_HD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_HD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%x_HD,1), UBOUND(OutData%x_HD,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL HydroDyn_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_HD(i1), ErrStat2, ErrMsg2 ) ! x_HD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_HD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%xd_HD)) DEALLOCATE(OutData%xd_HD) - ALLOCATE(OutData%xd_HD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_HD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%xd_HD,1), UBOUND(OutData%xd_HD,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL HydroDyn_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_HD(i1), ErrStat2, ErrMsg2 ) ! xd_HD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z_HD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%z_HD)) DEALLOCATE(OutData%z_HD) - ALLOCATE(OutData%z_HD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_HD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%z_HD,1), UBOUND(OutData%z_HD,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL HydroDyn_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_HD(i1), ErrStat2, ErrMsg2 ) ! z_HD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt_HD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OtherSt_HD)) DEALLOCATE(OutData%OtherSt_HD) - ALLOCATE(OutData%OtherSt_HD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_HD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OtherSt_HD,1), UBOUND(OutData%OtherSt_HD,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL HydroDyn_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_HD(i1), ErrStat2, ErrMsg2 ) ! OtherSt_HD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_HD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%u_HD)) DEALLOCATE(OutData%u_HD) - ALLOCATE(OutData%u_HD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_HD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_HD,1), UBOUND(OutData%u_HD,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL HydroDyn_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_HD(i1), ErrStat2, ErrMsg2 ) ! u_HD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_IceF not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%x_IceF)) DEALLOCATE(OutData%x_IceF) - ALLOCATE(OutData%x_IceF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_IceF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%x_IceF,1), UBOUND(OutData%x_IceF,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceFloe_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_IceF(i1), ErrStat2, ErrMsg2 ) ! x_IceF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_IceF not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%xd_IceF)) DEALLOCATE(OutData%xd_IceF) - ALLOCATE(OutData%xd_IceF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_IceF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%xd_IceF,1), UBOUND(OutData%xd_IceF,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceFloe_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_IceF(i1), ErrStat2, ErrMsg2 ) ! xd_IceF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z_IceF not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%z_IceF)) DEALLOCATE(OutData%z_IceF) - ALLOCATE(OutData%z_IceF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_IceF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%z_IceF,1), UBOUND(OutData%z_IceF,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceFloe_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_IceF(i1), ErrStat2, ErrMsg2 ) ! z_IceF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt_IceF not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OtherSt_IceF)) DEALLOCATE(OutData%OtherSt_IceF) - ALLOCATE(OutData%OtherSt_IceF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_IceF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OtherSt_IceF,1), UBOUND(OutData%OtherSt_IceF,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceFloe_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_IceF(i1), ErrStat2, ErrMsg2 ) ! OtherSt_IceF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_IceF not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%u_IceF)) DEALLOCATE(OutData%u_IceF) - ALLOCATE(OutData%u_IceF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_IceF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_IceF,1), UBOUND(OutData%u_IceF,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceFloe_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_IceF(i1), ErrStat2, ErrMsg2 ) ! u_IceF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_MAP not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%x_MAP)) DEALLOCATE(OutData%x_MAP) - ALLOCATE(OutData%x_MAP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_MAP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%x_MAP,1), UBOUND(OutData%x_MAP,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MAP_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_MAP(i1), ErrStat2, ErrMsg2 ) ! x_MAP - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_MAP not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%xd_MAP)) DEALLOCATE(OutData%xd_MAP) - ALLOCATE(OutData%xd_MAP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_MAP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%xd_MAP,1), UBOUND(OutData%xd_MAP,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MAP_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_MAP(i1), ErrStat2, ErrMsg2 ) ! xd_MAP - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z_MAP not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%z_MAP)) DEALLOCATE(OutData%z_MAP) - ALLOCATE(OutData%z_MAP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_MAP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%z_MAP,1), UBOUND(OutData%z_MAP,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MAP_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_MAP(i1), ErrStat2, ErrMsg2 ) ! z_MAP - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_MAP not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%u_MAP)) DEALLOCATE(OutData%u_MAP) - ALLOCATE(OutData%u_MAP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_MAP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_MAP,1), UBOUND(OutData%u_MAP,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MAP_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_MAP(i1), ErrStat2, ErrMsg2 ) ! u_MAP - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_FEAM not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%x_FEAM)) DEALLOCATE(OutData%x_FEAM) - ALLOCATE(OutData%x_FEAM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_FEAM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%x_FEAM,1), UBOUND(OutData%x_FEAM,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FEAM_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_FEAM(i1), ErrStat2, ErrMsg2 ) ! x_FEAM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_FEAM not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%xd_FEAM)) DEALLOCATE(OutData%xd_FEAM) - ALLOCATE(OutData%xd_FEAM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_FEAM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%xd_FEAM,1), UBOUND(OutData%xd_FEAM,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FEAM_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_FEAM(i1), ErrStat2, ErrMsg2 ) ! xd_FEAM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z_FEAM not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%z_FEAM)) DEALLOCATE(OutData%z_FEAM) - ALLOCATE(OutData%z_FEAM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_FEAM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%z_FEAM,1), UBOUND(OutData%z_FEAM,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FEAM_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_FEAM(i1), ErrStat2, ErrMsg2 ) ! z_FEAM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt_FEAM not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OtherSt_FEAM)) DEALLOCATE(OutData%OtherSt_FEAM) - ALLOCATE(OutData%OtherSt_FEAM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_FEAM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OtherSt_FEAM,1), UBOUND(OutData%OtherSt_FEAM,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FEAM_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_FEAM(i1), ErrStat2, ErrMsg2 ) ! OtherSt_FEAM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_FEAM not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%u_FEAM)) DEALLOCATE(OutData%u_FEAM) - ALLOCATE(OutData%u_FEAM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_FEAM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_FEAM,1), UBOUND(OutData%u_FEAM,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FEAM_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_FEAM(i1), ErrStat2, ErrMsg2 ) ! u_FEAM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_MD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%x_MD)) DEALLOCATE(OutData%x_MD) - ALLOCATE(OutData%x_MD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_MD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%x_MD,1), UBOUND(OutData%x_MD,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_MD(i1), ErrStat2, ErrMsg2 ) ! x_MD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_MD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%xd_MD)) DEALLOCATE(OutData%xd_MD) - ALLOCATE(OutData%xd_MD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_MD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%xd_MD,1), UBOUND(OutData%xd_MD,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_MD(i1), ErrStat2, ErrMsg2 ) ! xd_MD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z_MD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%z_MD)) DEALLOCATE(OutData%z_MD) - ALLOCATE(OutData%z_MD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_MD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%z_MD,1), UBOUND(OutData%z_MD,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_MD(i1), ErrStat2, ErrMsg2 ) ! z_MD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + SUBROUTINE FAST_DestroyServoDyn_Data( ServoDyn_DataData, ErrStat, ErrMsg ) + TYPE(ServoDyn_Data), INTENT(INOUT) :: ServoDyn_DataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyServoDyn_Data' - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt_MD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OtherSt_MD)) DEALLOCATE(OutData%OtherSt_MD) - ALLOCATE(OutData%OtherSt_MD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_MD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OtherSt_MD,1), UBOUND(OutData%OtherSt_MD,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_MD(i1), ErrStat2, ErrMsg2 ) ! OtherSt_MD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + ErrStat = ErrID_None + ErrMsg = "" - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_MD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%u_MD)) DEALLOCATE(OutData%u_MD) - ALLOCATE(OutData%u_MD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_MD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_MD,1), UBOUND(OutData%u_MD,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_MD(i1), ErrStat2, ErrMsg2 ) ! u_MD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN +DO i1 = LBOUND(ServoDyn_DataData%x,1), UBOUND(ServoDyn_DataData%x,1) + CALL SrvD_DestroyContState( ServoDyn_DataData%x(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +DO i1 = LBOUND(ServoDyn_DataData%xd,1), UBOUND(ServoDyn_DataData%xd,1) + CALL SrvD_DestroyDiscState( ServoDyn_DataData%xd(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +DO i1 = LBOUND(ServoDyn_DataData%z,1), UBOUND(ServoDyn_DataData%z,1) + CALL SrvD_DestroyConstrState( ServoDyn_DataData%z(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +DO i1 = LBOUND(ServoDyn_DataData%OtherSt,1), UBOUND(ServoDyn_DataData%OtherSt,1) + CALL SrvD_DestroyOtherState( ServoDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + CALL SrvD_DestroyParam( ServoDyn_DataData%p, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL SrvD_DestroyInput( ServoDyn_DataData%u, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL SrvD_DestroyOutput( ServoDyn_DataData%y, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL SrvD_DestroyMisc( ServoDyn_DataData%m, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(ServoDyn_DataData%Output)) THEN +DO i1 = LBOUND(ServoDyn_DataData%Output,1), UBOUND(ServoDyn_DataData%Output,1) + CALL SrvD_DestroyOutput( ServoDyn_DataData%Output(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(ServoDyn_DataData%Output) +ENDIF + CALL SrvD_DestroyOutput( ServoDyn_DataData%y_interp, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(ServoDyn_DataData%Input)) THEN +DO i1 = LBOUND(ServoDyn_DataData%Input,1), UBOUND(ServoDyn_DataData%Input,1) + CALL SrvD_DestroyInput( ServoDyn_DataData%Input(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(ServoDyn_DataData%Input) +ENDIF +IF (ALLOCATED(ServoDyn_DataData%InputTimes)) THEN + DEALLOCATE(ServoDyn_DataData%InputTimes) +ENDIF + END SUBROUTINE FAST_DestroyServoDyn_Data - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - END SUBROUTINE FAST_UnPackLinStateSave - SUBROUTINE FAST_CopyLinType( SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_LinType), INTENT(IN) :: SrcLinTypeData - TYPE(FAST_LinType), INTENT(INOUT) :: DstLinTypeData +subroutine FAST_PackServoDyn_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ServoDyn_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackServoDyn_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! x + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call SrvD_PackContState(Buf, InData%x(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! xd + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call SrvD_PackDiscState(Buf, InData%xd(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! z + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call SrvD_PackConstrState(Buf, InData%z(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! OtherSt + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call SrvD_PackOtherState(Buf, InData%OtherSt(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! p + call SrvD_PackParam(Buf, InData%p) + if (RegCheckErr(Buf, RoutineName)) return + ! u + call SrvD_PackInput(Buf, InData%u) + if (RegCheckErr(Buf, RoutineName)) return + ! y + call SrvD_PackOutput(Buf, InData%y) + if (RegCheckErr(Buf, RoutineName)) return + ! m + call SrvD_PackMisc(Buf, InData%m) + if (RegCheckErr(Buf, RoutineName)) return + ! Output + call RegPack(Buf, allocated(InData%Output)) + if (allocated(InData%Output)) then + call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) + LB(1:1) = lbound(InData%Output) + UB(1:1) = ubound(InData%Output) + do i1 = LB(1), UB(1) + call SrvD_PackOutput(Buf, InData%Output(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! y_interp + call SrvD_PackOutput(Buf, InData%y_interp) + if (RegCheckErr(Buf, RoutineName)) return + ! Input + call RegPack(Buf, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call SrvD_PackInput(Buf, InData%Input(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! InputTimes + call RegPack(Buf, allocated(InData%InputTimes)) + if (allocated(InData%InputTimes)) then + call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPack(Buf, InData%InputTimes) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackServoDyn_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ServoDyn_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackServoDyn_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! x + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) + do i1 = LB(1), UB(1) + call SrvD_UnpackContState(Buf, OutData%x(i1)) ! x + end do + ! xd + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) + do i1 = LB(1), UB(1) + call SrvD_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + end do + ! z + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) + do i1 = LB(1), UB(1) + call SrvD_UnpackConstrState(Buf, OutData%z(i1)) ! z + end do + ! OtherSt + LB(1:1) = lbound(OutData%OtherSt) + UB(1:1) = ubound(OutData%OtherSt) + do i1 = LB(1), UB(1) + call SrvD_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + end do + ! p + call SrvD_UnpackParam(Buf, OutData%p) ! p + ! u + call SrvD_UnpackInput(Buf, OutData%u) ! u + ! y + call SrvD_UnpackOutput(Buf, OutData%y) ! y + ! m + call SrvD_UnpackMisc(Buf, OutData%m) ! m + ! Output + if (allocated(OutData%Output)) deallocate(OutData%Output) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Output(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SrvD_UnpackOutput(Buf, OutData%Output(i1)) ! Output + end do + end if + ! y_interp + call SrvD_UnpackOutput(Buf, OutData%y_interp) ! y_interp + ! Input + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SrvD_UnpackInput(Buf, OutData%Input(i1)) ! Input + end do + end if + ! InputTimes + if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InputTimes) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + SUBROUTINE FAST_CopyAeroDyn14_Data( SrcAeroDyn14_DataData, DstAeroDyn14_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(AeroDyn14_Data), INTENT(INOUT) :: SrcAeroDyn14_DataData + TYPE(AeroDyn14_Data), INTENT(INOUT) :: DstAeroDyn14_DataData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local INTEGER(IntKi) :: i,j,k INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyLinType' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyAeroDyn14_Data' ! ErrStat = ErrID_None ErrMsg = "" -IF (ALLOCATED(SrcLinTypeData%Names_u)) THEN - i1_l = LBOUND(SrcLinTypeData%Names_u,1) - i1_u = UBOUND(SrcLinTypeData%Names_u,1) - IF (.NOT. ALLOCATED(DstLinTypeData%Names_u)) THEN - ALLOCATE(DstLinTypeData%Names_u(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(SrcAeroDyn14_DataData%x,1), UBOUND(SrcAeroDyn14_DataData%x,1) + CALL AD14_CopyContState( SrcAeroDyn14_DataData%x(i1), DstAeroDyn14_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcAeroDyn14_DataData%xd,1), UBOUND(SrcAeroDyn14_DataData%xd,1) + CALL AD14_CopyDiscState( SrcAeroDyn14_DataData%xd(i1), DstAeroDyn14_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcAeroDyn14_DataData%z,1), UBOUND(SrcAeroDyn14_DataData%z,1) + CALL AD14_CopyConstrState( SrcAeroDyn14_DataData%z(i1), DstAeroDyn14_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcAeroDyn14_DataData%OtherSt,1), UBOUND(SrcAeroDyn14_DataData%OtherSt,1) + CALL AD14_CopyOtherState( SrcAeroDyn14_DataData%OtherSt(i1), DstAeroDyn14_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + CALL AD14_CopyParam( SrcAeroDyn14_DataData%p, DstAeroDyn14_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL AD14_CopyInput( SrcAeroDyn14_DataData%u, DstAeroDyn14_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL AD14_CopyOutput( SrcAeroDyn14_DataData%y, DstAeroDyn14_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL AD14_CopyMisc( SrcAeroDyn14_DataData%m, DstAeroDyn14_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcAeroDyn14_DataData%Input)) THEN + i1_l = LBOUND(SrcAeroDyn14_DataData%Input,1) + i1_u = UBOUND(SrcAeroDyn14_DataData%Input,1) + IF (.NOT. ALLOCATED(DstAeroDyn14_DataData%Input)) THEN + ALLOCATE(DstAeroDyn14_DataData%Input(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_u.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn14_DataData%Input.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%Names_u = SrcLinTypeData%Names_u + DO i1 = LBOUND(SrcAeroDyn14_DataData%Input,1), UBOUND(SrcAeroDyn14_DataData%Input,1) + CALL AD14_CopyInput( SrcAeroDyn14_DataData%Input(i1), DstAeroDyn14_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%Names_y)) THEN - i1_l = LBOUND(SrcLinTypeData%Names_y,1) - i1_u = UBOUND(SrcLinTypeData%Names_y,1) - IF (.NOT. ALLOCATED(DstLinTypeData%Names_y)) THEN - ALLOCATE(DstLinTypeData%Names_y(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcAeroDyn14_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcAeroDyn14_DataData%InputTimes,1) + i1_u = UBOUND(SrcAeroDyn14_DataData%InputTimes,1) + IF (.NOT. ALLOCATED(DstAeroDyn14_DataData%InputTimes)) THEN + ALLOCATE(DstAeroDyn14_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_y.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn14_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%Names_y = SrcLinTypeData%Names_y + DstAeroDyn14_DataData%InputTimes = SrcAeroDyn14_DataData%InputTimes ENDIF -IF (ALLOCATED(SrcLinTypeData%Names_x)) THEN - i1_l = LBOUND(SrcLinTypeData%Names_x,1) - i1_u = UBOUND(SrcLinTypeData%Names_x,1) - IF (.NOT. ALLOCATED(DstLinTypeData%Names_x)) THEN - ALLOCATE(DstLinTypeData%Names_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%Names_x = SrcLinTypeData%Names_x + END SUBROUTINE FAST_CopyAeroDyn14_Data + + SUBROUTINE FAST_DestroyAeroDyn14_Data( AeroDyn14_DataData, ErrStat, ErrMsg ) + TYPE(AeroDyn14_Data), INTENT(INOUT) :: AeroDyn14_DataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyAeroDyn14_Data' + + ErrStat = ErrID_None + ErrMsg = "" + +DO i1 = LBOUND(AeroDyn14_DataData%x,1), UBOUND(AeroDyn14_DataData%x,1) + CALL AD14_DestroyContState( AeroDyn14_DataData%x(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +DO i1 = LBOUND(AeroDyn14_DataData%xd,1), UBOUND(AeroDyn14_DataData%xd,1) + CALL AD14_DestroyDiscState( AeroDyn14_DataData%xd(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +DO i1 = LBOUND(AeroDyn14_DataData%z,1), UBOUND(AeroDyn14_DataData%z,1) + CALL AD14_DestroyConstrState( AeroDyn14_DataData%z(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +DO i1 = LBOUND(AeroDyn14_DataData%OtherSt,1), UBOUND(AeroDyn14_DataData%OtherSt,1) + CALL AD14_DestroyOtherState( AeroDyn14_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + CALL AD14_DestroyParam( AeroDyn14_DataData%p, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL AD14_DestroyInput( AeroDyn14_DataData%u, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL AD14_DestroyOutput( AeroDyn14_DataData%y, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL AD14_DestroyMisc( AeroDyn14_DataData%m, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(AeroDyn14_DataData%Input)) THEN +DO i1 = LBOUND(AeroDyn14_DataData%Input,1), UBOUND(AeroDyn14_DataData%Input,1) + CALL AD14_DestroyInput( AeroDyn14_DataData%Input(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(AeroDyn14_DataData%Input) ENDIF -IF (ALLOCATED(SrcLinTypeData%Names_xd)) THEN - i1_l = LBOUND(SrcLinTypeData%Names_xd,1) - i1_u = UBOUND(SrcLinTypeData%Names_xd,1) - IF (.NOT. ALLOCATED(DstLinTypeData%Names_xd)) THEN - ALLOCATE(DstLinTypeData%Names_xd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%Names_xd = SrcLinTypeData%Names_xd +IF (ALLOCATED(AeroDyn14_DataData%InputTimes)) THEN + DEALLOCATE(AeroDyn14_DataData%InputTimes) ENDIF -IF (ALLOCATED(SrcLinTypeData%Names_z)) THEN - i1_l = LBOUND(SrcLinTypeData%Names_z,1) - i1_u = UBOUND(SrcLinTypeData%Names_z,1) - IF (.NOT. ALLOCATED(DstLinTypeData%Names_z)) THEN - ALLOCATE(DstLinTypeData%Names_z(i1_l:i1_u),STAT=ErrStat2) + END SUBROUTINE FAST_DestroyAeroDyn14_Data + + +subroutine FAST_PackAeroDyn14_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AeroDyn14_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackAeroDyn14_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! x + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call AD14_PackContState(Buf, InData%x(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! xd + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call AD14_PackDiscState(Buf, InData%xd(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! z + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call AD14_PackConstrState(Buf, InData%z(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! OtherSt + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call AD14_PackOtherState(Buf, InData%OtherSt(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! p + call AD14_PackParam(Buf, InData%p) + if (RegCheckErr(Buf, RoutineName)) return + ! u + call AD14_PackInput(Buf, InData%u) + if (RegCheckErr(Buf, RoutineName)) return + ! y + call AD14_PackOutput(Buf, InData%y) + if (RegCheckErr(Buf, RoutineName)) return + ! m + call AD14_PackMisc(Buf, InData%m) + if (RegCheckErr(Buf, RoutineName)) return + ! Input + call RegPack(Buf, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call AD14_PackInput(Buf, InData%Input(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! InputTimes + call RegPack(Buf, allocated(InData%InputTimes)) + if (allocated(InData%InputTimes)) then + call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPack(Buf, InData%InputTimes) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackAeroDyn14_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AeroDyn14_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackAeroDyn14_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! x + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) + do i1 = LB(1), UB(1) + call AD14_UnpackContState(Buf, OutData%x(i1)) ! x + end do + ! xd + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) + do i1 = LB(1), UB(1) + call AD14_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + end do + ! z + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) + do i1 = LB(1), UB(1) + call AD14_UnpackConstrState(Buf, OutData%z(i1)) ! z + end do + ! OtherSt + LB(1:1) = lbound(OutData%OtherSt) + UB(1:1) = ubound(OutData%OtherSt) + do i1 = LB(1), UB(1) + call AD14_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + end do + ! p + call AD14_UnpackParam(Buf, OutData%p) ! p + ! u + call AD14_UnpackInput(Buf, OutData%u) ! u + ! y + call AD14_UnpackOutput(Buf, OutData%y) ! y + ! m + call AD14_UnpackMisc(Buf, OutData%m) ! m + ! Input + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD14_UnpackInput(Buf, OutData%Input(i1)) ! Input + end do + end if + ! InputTimes + if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InputTimes) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + SUBROUTINE FAST_CopyAeroDyn_Data( SrcAeroDyn_DataData, DstAeroDyn_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(AeroDyn_Data), INTENT(INOUT) :: SrcAeroDyn_DataData + TYPE(AeroDyn_Data), INTENT(INOUT) :: DstAeroDyn_DataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyAeroDyn_Data' +! + ErrStat = ErrID_None + ErrMsg = "" + DO i1 = LBOUND(SrcAeroDyn_DataData%x,1), UBOUND(SrcAeroDyn_DataData%x,1) + CALL AD_CopyContState( SrcAeroDyn_DataData%x(i1), DstAeroDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcAeroDyn_DataData%xd,1), UBOUND(SrcAeroDyn_DataData%xd,1) + CALL AD_CopyDiscState( SrcAeroDyn_DataData%xd(i1), DstAeroDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcAeroDyn_DataData%z,1), UBOUND(SrcAeroDyn_DataData%z,1) + CALL AD_CopyConstrState( SrcAeroDyn_DataData%z(i1), DstAeroDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcAeroDyn_DataData%OtherSt,1), UBOUND(SrcAeroDyn_DataData%OtherSt,1) + CALL AD_CopyOtherState( SrcAeroDyn_DataData%OtherSt(i1), DstAeroDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + CALL AD_CopyParam( SrcAeroDyn_DataData%p, DstAeroDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL AD_CopyInput( SrcAeroDyn_DataData%u, DstAeroDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL AD_CopyOutput( SrcAeroDyn_DataData%y, DstAeroDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL AD_CopyMisc( SrcAeroDyn_DataData%m, DstAeroDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcAeroDyn_DataData%Output)) THEN + i1_l = LBOUND(SrcAeroDyn_DataData%Output,1) + i1_u = UBOUND(SrcAeroDyn_DataData%Output,1) + IF (.NOT. ALLOCATED(DstAeroDyn_DataData%Output)) THEN + ALLOCATE(DstAeroDyn_DataData%Output(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_z.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%Names_z = SrcLinTypeData%Names_z + DO i1 = LBOUND(SrcAeroDyn_DataData%Output,1), UBOUND(SrcAeroDyn_DataData%Output,1) + CALL AD_CopyOutput( SrcAeroDyn_DataData%Output(i1), DstAeroDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%op_u)) THEN - i1_l = LBOUND(SrcLinTypeData%op_u,1) - i1_u = UBOUND(SrcLinTypeData%op_u,1) - IF (.NOT. ALLOCATED(DstLinTypeData%op_u)) THEN - ALLOCATE(DstLinTypeData%op_u(i1_l:i1_u),STAT=ErrStat2) + CALL AD_CopyOutput( SrcAeroDyn_DataData%y_interp, DstAeroDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcAeroDyn_DataData%Input)) THEN + i1_l = LBOUND(SrcAeroDyn_DataData%Input,1) + i1_u = UBOUND(SrcAeroDyn_DataData%Input,1) + IF (.NOT. ALLOCATED(DstAeroDyn_DataData%Input)) THEN + ALLOCATE(DstAeroDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_u.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%op_u = SrcLinTypeData%op_u + DO i1 = LBOUND(SrcAeroDyn_DataData%Input,1), UBOUND(SrcAeroDyn_DataData%Input,1) + CALL AD_CopyInput( SrcAeroDyn_DataData%Input(i1), DstAeroDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%op_y)) THEN - i1_l = LBOUND(SrcLinTypeData%op_y,1) - i1_u = UBOUND(SrcLinTypeData%op_y,1) - IF (.NOT. ALLOCATED(DstLinTypeData%op_y)) THEN - ALLOCATE(DstLinTypeData%op_y(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcAeroDyn_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcAeroDyn_DataData%InputTimes,1) + i1_u = UBOUND(SrcAeroDyn_DataData%InputTimes,1) + IF (.NOT. ALLOCATED(DstAeroDyn_DataData%InputTimes)) THEN + ALLOCATE(DstAeroDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_y.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%op_y = SrcLinTypeData%op_y + DstAeroDyn_DataData%InputTimes = SrcAeroDyn_DataData%InputTimes ENDIF -IF (ALLOCATED(SrcLinTypeData%op_x)) THEN - i1_l = LBOUND(SrcLinTypeData%op_x,1) - i1_u = UBOUND(SrcLinTypeData%op_x,1) - IF (.NOT. ALLOCATED(DstLinTypeData%op_x)) THEN - ALLOCATE(DstLinTypeData%op_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%op_x = SrcLinTypeData%op_x + END SUBROUTINE FAST_CopyAeroDyn_Data + + SUBROUTINE FAST_DestroyAeroDyn_Data( AeroDyn_DataData, ErrStat, ErrMsg ) + TYPE(AeroDyn_Data), INTENT(INOUT) :: AeroDyn_DataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyAeroDyn_Data' + + ErrStat = ErrID_None + ErrMsg = "" + +DO i1 = LBOUND(AeroDyn_DataData%x,1), UBOUND(AeroDyn_DataData%x,1) + CALL AD_DestroyContState( AeroDyn_DataData%x(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +DO i1 = LBOUND(AeroDyn_DataData%xd,1), UBOUND(AeroDyn_DataData%xd,1) + CALL AD_DestroyDiscState( AeroDyn_DataData%xd(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +DO i1 = LBOUND(AeroDyn_DataData%z,1), UBOUND(AeroDyn_DataData%z,1) + CALL AD_DestroyConstrState( AeroDyn_DataData%z(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +DO i1 = LBOUND(AeroDyn_DataData%OtherSt,1), UBOUND(AeroDyn_DataData%OtherSt,1) + CALL AD_DestroyOtherState( AeroDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + CALL AD_DestroyParam( AeroDyn_DataData%p, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL AD_DestroyInput( AeroDyn_DataData%u, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL AD_DestroyOutput( AeroDyn_DataData%y, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL AD_DestroyMisc( AeroDyn_DataData%m, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(AeroDyn_DataData%Output)) THEN +DO i1 = LBOUND(AeroDyn_DataData%Output,1), UBOUND(AeroDyn_DataData%Output,1) + CALL AD_DestroyOutput( AeroDyn_DataData%Output(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(AeroDyn_DataData%Output) ENDIF -IF (ALLOCATED(SrcLinTypeData%op_dx)) THEN - i1_l = LBOUND(SrcLinTypeData%op_dx,1) - i1_u = UBOUND(SrcLinTypeData%op_dx,1) - IF (.NOT. ALLOCATED(DstLinTypeData%op_dx)) THEN - ALLOCATE(DstLinTypeData%op_dx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_dx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%op_dx = SrcLinTypeData%op_dx + CALL AD_DestroyOutput( AeroDyn_DataData%y_interp, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(AeroDyn_DataData%Input)) THEN +DO i1 = LBOUND(AeroDyn_DataData%Input,1), UBOUND(AeroDyn_DataData%Input,1) + CALL AD_DestroyInput( AeroDyn_DataData%Input(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(AeroDyn_DataData%Input) ENDIF -IF (ALLOCATED(SrcLinTypeData%op_xd)) THEN - i1_l = LBOUND(SrcLinTypeData%op_xd,1) - i1_u = UBOUND(SrcLinTypeData%op_xd,1) - IF (.NOT. ALLOCATED(DstLinTypeData%op_xd)) THEN - ALLOCATE(DstLinTypeData%op_xd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%op_xd = SrcLinTypeData%op_xd +IF (ALLOCATED(AeroDyn_DataData%InputTimes)) THEN + DEALLOCATE(AeroDyn_DataData%InputTimes) ENDIF -IF (ALLOCATED(SrcLinTypeData%op_z)) THEN - i1_l = LBOUND(SrcLinTypeData%op_z,1) - i1_u = UBOUND(SrcLinTypeData%op_z,1) - IF (.NOT. ALLOCATED(DstLinTypeData%op_z)) THEN - ALLOCATE(DstLinTypeData%op_z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%op_z = SrcLinTypeData%op_z -ENDIF -IF (ALLOCATED(SrcLinTypeData%op_x_eig_mag)) THEN - i1_l = LBOUND(SrcLinTypeData%op_x_eig_mag,1) - i1_u = UBOUND(SrcLinTypeData%op_x_eig_mag,1) - IF (.NOT. ALLOCATED(DstLinTypeData%op_x_eig_mag)) THEN - ALLOCATE(DstLinTypeData%op_x_eig_mag(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_x_eig_mag.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%op_x_eig_mag = SrcLinTypeData%op_x_eig_mag -ENDIF -IF (ALLOCATED(SrcLinTypeData%op_x_eig_phase)) THEN - i1_l = LBOUND(SrcLinTypeData%op_x_eig_phase,1) - i1_u = UBOUND(SrcLinTypeData%op_x_eig_phase,1) - IF (.NOT. ALLOCATED(DstLinTypeData%op_x_eig_phase)) THEN - ALLOCATE(DstLinTypeData%op_x_eig_phase(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_x_eig_phase.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%op_x_eig_phase = SrcLinTypeData%op_x_eig_phase -ENDIF -IF (ALLOCATED(SrcLinTypeData%Use_u)) THEN - i1_l = LBOUND(SrcLinTypeData%Use_u,1) - i1_u = UBOUND(SrcLinTypeData%Use_u,1) - IF (.NOT. ALLOCATED(DstLinTypeData%Use_u)) THEN - ALLOCATE(DstLinTypeData%Use_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Use_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%Use_u = SrcLinTypeData%Use_u -ENDIF -IF (ALLOCATED(SrcLinTypeData%Use_y)) THEN - i1_l = LBOUND(SrcLinTypeData%Use_y,1) - i1_u = UBOUND(SrcLinTypeData%Use_y,1) - IF (.NOT. ALLOCATED(DstLinTypeData%Use_y)) THEN - ALLOCATE(DstLinTypeData%Use_y(i1_l:i1_u),STAT=ErrStat2) + END SUBROUTINE FAST_DestroyAeroDyn_Data + + +subroutine FAST_PackAeroDyn_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AeroDyn_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackAeroDyn_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! x + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call AD_PackContState(Buf, InData%x(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! xd + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call AD_PackDiscState(Buf, InData%xd(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! z + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call AD_PackConstrState(Buf, InData%z(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! OtherSt + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call AD_PackOtherState(Buf, InData%OtherSt(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! p + call AD_PackParam(Buf, InData%p) + if (RegCheckErr(Buf, RoutineName)) return + ! u + call AD_PackInput(Buf, InData%u) + if (RegCheckErr(Buf, RoutineName)) return + ! y + call AD_PackOutput(Buf, InData%y) + if (RegCheckErr(Buf, RoutineName)) return + ! m + call AD_PackMisc(Buf, InData%m) + if (RegCheckErr(Buf, RoutineName)) return + ! Output + call RegPack(Buf, allocated(InData%Output)) + if (allocated(InData%Output)) then + call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) + LB(1:1) = lbound(InData%Output) + UB(1:1) = ubound(InData%Output) + do i1 = LB(1), UB(1) + call AD_PackOutput(Buf, InData%Output(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! y_interp + call AD_PackOutput(Buf, InData%y_interp) + if (RegCheckErr(Buf, RoutineName)) return + ! Input + call RegPack(Buf, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call AD_PackInput(Buf, InData%Input(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! InputTimes + call RegPack(Buf, allocated(InData%InputTimes)) + if (allocated(InData%InputTimes)) then + call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPack(Buf, InData%InputTimes) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackAeroDyn_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(AeroDyn_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackAeroDyn_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! x + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) + do i1 = LB(1), UB(1) + call AD_UnpackContState(Buf, OutData%x(i1)) ! x + end do + ! xd + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) + do i1 = LB(1), UB(1) + call AD_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + end do + ! z + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) + do i1 = LB(1), UB(1) + call AD_UnpackConstrState(Buf, OutData%z(i1)) ! z + end do + ! OtherSt + LB(1:1) = lbound(OutData%OtherSt) + UB(1:1) = ubound(OutData%OtherSt) + do i1 = LB(1), UB(1) + call AD_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + end do + ! p + call AD_UnpackParam(Buf, OutData%p) ! p + ! u + call AD_UnpackInput(Buf, OutData%u) ! u + ! y + call AD_UnpackOutput(Buf, OutData%y) ! y + ! m + call AD_UnpackMisc(Buf, OutData%m) ! m + ! Output + if (allocated(OutData%Output)) deallocate(OutData%Output) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Output(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackOutput(Buf, OutData%Output(i1)) ! Output + end do + end if + ! y_interp + call AD_UnpackOutput(Buf, OutData%y_interp) ! y_interp + ! Input + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackInput(Buf, OutData%Input(i1)) ! Input + end do + end if + ! InputTimes + if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InputTimes) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + SUBROUTINE FAST_CopyInflowWind_Data( SrcInflowWind_DataData, DstInflowWind_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(InflowWind_Data), INTENT(IN) :: SrcInflowWind_DataData + TYPE(InflowWind_Data), INTENT(INOUT) :: DstInflowWind_DataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyInflowWind_Data' +! + ErrStat = ErrID_None + ErrMsg = "" + DO i1 = LBOUND(SrcInflowWind_DataData%x,1), UBOUND(SrcInflowWind_DataData%x,1) + CALL InflowWind_CopyContState( SrcInflowWind_DataData%x(i1), DstInflowWind_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcInflowWind_DataData%xd,1), UBOUND(SrcInflowWind_DataData%xd,1) + CALL InflowWind_CopyDiscState( SrcInflowWind_DataData%xd(i1), DstInflowWind_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcInflowWind_DataData%z,1), UBOUND(SrcInflowWind_DataData%z,1) + CALL InflowWind_CopyConstrState( SrcInflowWind_DataData%z(i1), DstInflowWind_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcInflowWind_DataData%OtherSt,1), UBOUND(SrcInflowWind_DataData%OtherSt,1) + CALL InflowWind_CopyOtherState( SrcInflowWind_DataData%OtherSt(i1), DstInflowWind_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + CALL InflowWind_CopyParam( SrcInflowWind_DataData%p, DstInflowWind_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL InflowWind_CopyInput( SrcInflowWind_DataData%u, DstInflowWind_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL InflowWind_CopyOutput( SrcInflowWind_DataData%y, DstInflowWind_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL InflowWind_CopyMisc( SrcInflowWind_DataData%m, DstInflowWind_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcInflowWind_DataData%Output)) THEN + i1_l = LBOUND(SrcInflowWind_DataData%Output,1) + i1_u = UBOUND(SrcInflowWind_DataData%Output,1) + IF (.NOT. ALLOCATED(DstInflowWind_DataData%Output)) THEN + ALLOCATE(DstInflowWind_DataData%Output(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Use_y.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%Output.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%Use_y = SrcLinTypeData%Use_y + DO i1 = LBOUND(SrcInflowWind_DataData%Output,1), UBOUND(SrcInflowWind_DataData%Output,1) + CALL InflowWind_CopyOutput( SrcInflowWind_DataData%Output(i1), DstInflowWind_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%A)) THEN - i1_l = LBOUND(SrcLinTypeData%A,1) - i1_u = UBOUND(SrcLinTypeData%A,1) - i2_l = LBOUND(SrcLinTypeData%A,2) - i2_u = UBOUND(SrcLinTypeData%A,2) - IF (.NOT. ALLOCATED(DstLinTypeData%A)) THEN - ALLOCATE(DstLinTypeData%A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + CALL InflowWind_CopyOutput( SrcInflowWind_DataData%y_interp, DstInflowWind_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcInflowWind_DataData%Input)) THEN + i1_l = LBOUND(SrcInflowWind_DataData%Input,1) + i1_u = UBOUND(SrcInflowWind_DataData%Input,1) + IF (.NOT. ALLOCATED(DstInflowWind_DataData%Input)) THEN + ALLOCATE(DstInflowWind_DataData%Input(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%A.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%Input.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%A = SrcLinTypeData%A + DO i1 = LBOUND(SrcInflowWind_DataData%Input,1), UBOUND(SrcInflowWind_DataData%Input,1) + CALL InflowWind_CopyInput( SrcInflowWind_DataData%Input(i1), DstInflowWind_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%B)) THEN - i1_l = LBOUND(SrcLinTypeData%B,1) - i1_u = UBOUND(SrcLinTypeData%B,1) - i2_l = LBOUND(SrcLinTypeData%B,2) - i2_u = UBOUND(SrcLinTypeData%B,2) - IF (.NOT. ALLOCATED(DstLinTypeData%B)) THEN - ALLOCATE(DstLinTypeData%B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) +IF (ALLOCATED(SrcInflowWind_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcInflowWind_DataData%InputTimes,1) + i1_u = UBOUND(SrcInflowWind_DataData%InputTimes,1) + IF (.NOT. ALLOCATED(DstInflowWind_DataData%InputTimes)) THEN + ALLOCATE(DstInflowWind_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%B.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%B = SrcLinTypeData%B + DstInflowWind_DataData%InputTimes = SrcInflowWind_DataData%InputTimes ENDIF -IF (ALLOCATED(SrcLinTypeData%C)) THEN - i1_l = LBOUND(SrcLinTypeData%C,1) - i1_u = UBOUND(SrcLinTypeData%C,1) - i2_l = LBOUND(SrcLinTypeData%C,2) - i2_u = UBOUND(SrcLinTypeData%C,2) - IF (.NOT. ALLOCATED(DstLinTypeData%C)) THEN - ALLOCATE(DstLinTypeData%C(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%C.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%C = SrcLinTypeData%C + END SUBROUTINE FAST_CopyInflowWind_Data + + SUBROUTINE FAST_DestroyInflowWind_Data( InflowWind_DataData, ErrStat, ErrMsg ) + TYPE(InflowWind_Data), INTENT(INOUT) :: InflowWind_DataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyInflowWind_Data' + + ErrStat = ErrID_None + ErrMsg = "" + +DO i1 = LBOUND(InflowWind_DataData%x,1), UBOUND(InflowWind_DataData%x,1) + CALL InflowWind_DestroyContState( InflowWind_DataData%x(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +DO i1 = LBOUND(InflowWind_DataData%xd,1), UBOUND(InflowWind_DataData%xd,1) + CALL InflowWind_DestroyDiscState( InflowWind_DataData%xd(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +DO i1 = LBOUND(InflowWind_DataData%z,1), UBOUND(InflowWind_DataData%z,1) + CALL InflowWind_DestroyConstrState( InflowWind_DataData%z(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +DO i1 = LBOUND(InflowWind_DataData%OtherSt,1), UBOUND(InflowWind_DataData%OtherSt,1) + CALL InflowWind_DestroyOtherState( InflowWind_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + CALL InflowWind_DestroyParam( InflowWind_DataData%p, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL InflowWind_DestroyInput( InflowWind_DataData%u, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL InflowWind_DestroyOutput( InflowWind_DataData%y, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL InflowWind_DestroyMisc( InflowWind_DataData%m, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(InflowWind_DataData%Output)) THEN +DO i1 = LBOUND(InflowWind_DataData%Output,1), UBOUND(InflowWind_DataData%Output,1) + CALL InflowWind_DestroyOutput( InflowWind_DataData%Output(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(InflowWind_DataData%Output) ENDIF -IF (ALLOCATED(SrcLinTypeData%D)) THEN - i1_l = LBOUND(SrcLinTypeData%D,1) - i1_u = UBOUND(SrcLinTypeData%D,1) - i2_l = LBOUND(SrcLinTypeData%D,2) - i2_u = UBOUND(SrcLinTypeData%D,2) - IF (.NOT. ALLOCATED(DstLinTypeData%D)) THEN - ALLOCATE(DstLinTypeData%D(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%D.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%D = SrcLinTypeData%D + CALL InflowWind_DestroyOutput( InflowWind_DataData%y_interp, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(InflowWind_DataData%Input)) THEN +DO i1 = LBOUND(InflowWind_DataData%Input,1), UBOUND(InflowWind_DataData%Input,1) + CALL InflowWind_DestroyInput( InflowWind_DataData%Input(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(InflowWind_DataData%Input) ENDIF -IF (ALLOCATED(SrcLinTypeData%StateRotation)) THEN - i1_l = LBOUND(SrcLinTypeData%StateRotation,1) - i1_u = UBOUND(SrcLinTypeData%StateRotation,1) - i2_l = LBOUND(SrcLinTypeData%StateRotation,2) - i2_u = UBOUND(SrcLinTypeData%StateRotation,2) - IF (.NOT. ALLOCATED(DstLinTypeData%StateRotation)) THEN - ALLOCATE(DstLinTypeData%StateRotation(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%StateRotation.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%StateRotation = SrcLinTypeData%StateRotation +IF (ALLOCATED(InflowWind_DataData%InputTimes)) THEN + DEALLOCATE(InflowWind_DataData%InputTimes) ENDIF -IF (ALLOCATED(SrcLinTypeData%StateRel_x)) THEN - i1_l = LBOUND(SrcLinTypeData%StateRel_x,1) - i1_u = UBOUND(SrcLinTypeData%StateRel_x,1) - i2_l = LBOUND(SrcLinTypeData%StateRel_x,2) - i2_u = UBOUND(SrcLinTypeData%StateRel_x,2) - IF (.NOT. ALLOCATED(DstLinTypeData%StateRel_x)) THEN - ALLOCATE(DstLinTypeData%StateRel_x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%StateRel_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%StateRel_x = SrcLinTypeData%StateRel_x -ENDIF -IF (ALLOCATED(SrcLinTypeData%StateRel_xdot)) THEN - i1_l = LBOUND(SrcLinTypeData%StateRel_xdot,1) - i1_u = UBOUND(SrcLinTypeData%StateRel_xdot,1) - i2_l = LBOUND(SrcLinTypeData%StateRel_xdot,2) - i2_u = UBOUND(SrcLinTypeData%StateRel_xdot,2) - IF (.NOT. ALLOCATED(DstLinTypeData%StateRel_xdot)) THEN - ALLOCATE(DstLinTypeData%StateRel_xdot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%StateRel_xdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%StateRel_xdot = SrcLinTypeData%StateRel_xdot -ENDIF -IF (ALLOCATED(SrcLinTypeData%IsLoad_u)) THEN - i1_l = LBOUND(SrcLinTypeData%IsLoad_u,1) - i1_u = UBOUND(SrcLinTypeData%IsLoad_u,1) - IF (.NOT. ALLOCATED(DstLinTypeData%IsLoad_u)) THEN - ALLOCATE(DstLinTypeData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%IsLoad_u = SrcLinTypeData%IsLoad_u -ENDIF -IF (ALLOCATED(SrcLinTypeData%RotFrame_u)) THEN - i1_l = LBOUND(SrcLinTypeData%RotFrame_u,1) - i1_u = UBOUND(SrcLinTypeData%RotFrame_u,1) - IF (.NOT. ALLOCATED(DstLinTypeData%RotFrame_u)) THEN - ALLOCATE(DstLinTypeData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%RotFrame_u = SrcLinTypeData%RotFrame_u -ENDIF -IF (ALLOCATED(SrcLinTypeData%RotFrame_y)) THEN - i1_l = LBOUND(SrcLinTypeData%RotFrame_y,1) - i1_u = UBOUND(SrcLinTypeData%RotFrame_y,1) - IF (.NOT. ALLOCATED(DstLinTypeData%RotFrame_y)) THEN - ALLOCATE(DstLinTypeData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%RotFrame_y = SrcLinTypeData%RotFrame_y -ENDIF -IF (ALLOCATED(SrcLinTypeData%RotFrame_x)) THEN - i1_l = LBOUND(SrcLinTypeData%RotFrame_x,1) - i1_u = UBOUND(SrcLinTypeData%RotFrame_x,1) - IF (.NOT. ALLOCATED(DstLinTypeData%RotFrame_x)) THEN - ALLOCATE(DstLinTypeData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%RotFrame_x = SrcLinTypeData%RotFrame_x -ENDIF -IF (ALLOCATED(SrcLinTypeData%RotFrame_z)) THEN - i1_l = LBOUND(SrcLinTypeData%RotFrame_z,1) - i1_u = UBOUND(SrcLinTypeData%RotFrame_z,1) - IF (.NOT. ALLOCATED(DstLinTypeData%RotFrame_z)) THEN - ALLOCATE(DstLinTypeData%RotFrame_z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%RotFrame_z = SrcLinTypeData%RotFrame_z -ENDIF -IF (ALLOCATED(SrcLinTypeData%DerivOrder_x)) THEN - i1_l = LBOUND(SrcLinTypeData%DerivOrder_x,1) - i1_u = UBOUND(SrcLinTypeData%DerivOrder_x,1) - IF (.NOT. ALLOCATED(DstLinTypeData%DerivOrder_x)) THEN - ALLOCATE(DstLinTypeData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%DerivOrder_x = SrcLinTypeData%DerivOrder_x -ENDIF - DstLinTypeData%SizeLin = SrcLinTypeData%SizeLin - DstLinTypeData%LinStartIndx = SrcLinTypeData%LinStartIndx - DstLinTypeData%NumOutputs = SrcLinTypeData%NumOutputs - END SUBROUTINE FAST_CopyLinType + END SUBROUTINE FAST_DestroyInflowWind_Data - SUBROUTINE FAST_DestroyLinType( LinTypeData, ErrStat, ErrMsg ) - TYPE(FAST_LinType), INTENT(INOUT) :: LinTypeData + +subroutine FAST_PackInflowWind_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackInflowWind_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! x + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call InflowWind_PackContState(Buf, InData%x(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! xd + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call InflowWind_PackDiscState(Buf, InData%xd(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! z + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call InflowWind_PackConstrState(Buf, InData%z(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! OtherSt + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call InflowWind_PackOtherState(Buf, InData%OtherSt(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! p + call InflowWind_PackParam(Buf, InData%p) + if (RegCheckErr(Buf, RoutineName)) return + ! u + call InflowWind_PackInput(Buf, InData%u) + if (RegCheckErr(Buf, RoutineName)) return + ! y + call InflowWind_PackOutput(Buf, InData%y) + if (RegCheckErr(Buf, RoutineName)) return + ! m + call InflowWind_PackMisc(Buf, InData%m) + if (RegCheckErr(Buf, RoutineName)) return + ! Output + call RegPack(Buf, allocated(InData%Output)) + if (allocated(InData%Output)) then + call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) + LB(1:1) = lbound(InData%Output) + UB(1:1) = ubound(InData%Output) + do i1 = LB(1), UB(1) + call InflowWind_PackOutput(Buf, InData%Output(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! y_interp + call InflowWind_PackOutput(Buf, InData%y_interp) + if (RegCheckErr(Buf, RoutineName)) return + ! Input + call RegPack(Buf, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call InflowWind_PackInput(Buf, InData%Input(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! InputTimes + call RegPack(Buf, allocated(InData%InputTimes)) + if (allocated(InData%InputTimes)) then + call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPack(Buf, InData%InputTimes) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackInflowWind_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(InflowWind_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackInflowWind_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! x + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) + do i1 = LB(1), UB(1) + call InflowWind_UnpackContState(Buf, OutData%x(i1)) ! x + end do + ! xd + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) + do i1 = LB(1), UB(1) + call InflowWind_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + end do + ! z + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) + do i1 = LB(1), UB(1) + call InflowWind_UnpackConstrState(Buf, OutData%z(i1)) ! z + end do + ! OtherSt + LB(1:1) = lbound(OutData%OtherSt) + UB(1:1) = ubound(OutData%OtherSt) + do i1 = LB(1), UB(1) + call InflowWind_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + end do + ! p + call InflowWind_UnpackParam(Buf, OutData%p) ! p + ! u + call InflowWind_UnpackInput(Buf, OutData%u) ! u + ! y + call InflowWind_UnpackOutput(Buf, OutData%y) ! y + ! m + call InflowWind_UnpackMisc(Buf, OutData%m) ! m + ! Output + if (allocated(OutData%Output)) deallocate(OutData%Output) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Output(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackOutput(Buf, OutData%Output(i1)) ! Output + end do + end if + ! y_interp + call InflowWind_UnpackOutput(Buf, OutData%y_interp) ! y_interp + ! Input + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackInput(Buf, OutData%Input(i1)) ! Input + end do + end if + ! InputTimes + if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InputTimes) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + SUBROUTINE FAST_CopyOpenFOAM_Data( SrcOpenFOAM_DataData, DstOpenFOAM_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(OpenFOAM_Data), INTENT(INOUT) :: SrcOpenFOAM_DataData + TYPE(OpenFOAM_Data), INTENT(INOUT) :: DstOpenFOAM_DataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyOpenFOAM_Data' +! + ErrStat = ErrID_None + ErrMsg = "" + CALL OpFM_CopyInput( SrcOpenFOAM_DataData%u, DstOpenFOAM_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL OpFM_CopyOutput( SrcOpenFOAM_DataData%y, DstOpenFOAM_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL OpFM_CopyParam( SrcOpenFOAM_DataData%p, DstOpenFOAM_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL OpFM_CopyMisc( SrcOpenFOAM_DataData%m, DstOpenFOAM_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + END SUBROUTINE FAST_CopyOpenFOAM_Data + + SUBROUTINE FAST_DestroyOpenFOAM_Data( OpenFOAM_DataData, ErrStat, ErrMsg ) + TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpenFOAM_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyLinType' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyOpenFOAM_Data' ErrStat = ErrID_None ErrMsg = "" -IF (ALLOCATED(LinTypeData%Names_u)) THEN - DEALLOCATE(LinTypeData%Names_u) -ENDIF -IF (ALLOCATED(LinTypeData%Names_y)) THEN - DEALLOCATE(LinTypeData%Names_y) -ENDIF -IF (ALLOCATED(LinTypeData%Names_x)) THEN - DEALLOCATE(LinTypeData%Names_x) -ENDIF -IF (ALLOCATED(LinTypeData%Names_xd)) THEN - DEALLOCATE(LinTypeData%Names_xd) -ENDIF -IF (ALLOCATED(LinTypeData%Names_z)) THEN - DEALLOCATE(LinTypeData%Names_z) -ENDIF -IF (ALLOCATED(LinTypeData%op_u)) THEN - DEALLOCATE(LinTypeData%op_u) -ENDIF -IF (ALLOCATED(LinTypeData%op_y)) THEN - DEALLOCATE(LinTypeData%op_y) -ENDIF -IF (ALLOCATED(LinTypeData%op_x)) THEN - DEALLOCATE(LinTypeData%op_x) -ENDIF -IF (ALLOCATED(LinTypeData%op_dx)) THEN - DEALLOCATE(LinTypeData%op_dx) -ENDIF -IF (ALLOCATED(LinTypeData%op_xd)) THEN - DEALLOCATE(LinTypeData%op_xd) -ENDIF -IF (ALLOCATED(LinTypeData%op_z)) THEN - DEALLOCATE(LinTypeData%op_z) -ENDIF -IF (ALLOCATED(LinTypeData%op_x_eig_mag)) THEN - DEALLOCATE(LinTypeData%op_x_eig_mag) -ENDIF -IF (ALLOCATED(LinTypeData%op_x_eig_phase)) THEN - DEALLOCATE(LinTypeData%op_x_eig_phase) -ENDIF -IF (ALLOCATED(LinTypeData%Use_u)) THEN - DEALLOCATE(LinTypeData%Use_u) -ENDIF -IF (ALLOCATED(LinTypeData%Use_y)) THEN - DEALLOCATE(LinTypeData%Use_y) -ENDIF -IF (ALLOCATED(LinTypeData%A)) THEN - DEALLOCATE(LinTypeData%A) -ENDIF -IF (ALLOCATED(LinTypeData%B)) THEN - DEALLOCATE(LinTypeData%B) -ENDIF -IF (ALLOCATED(LinTypeData%C)) THEN - DEALLOCATE(LinTypeData%C) -ENDIF -IF (ALLOCATED(LinTypeData%D)) THEN - DEALLOCATE(LinTypeData%D) -ENDIF -IF (ALLOCATED(LinTypeData%StateRotation)) THEN - DEALLOCATE(LinTypeData%StateRotation) -ENDIF -IF (ALLOCATED(LinTypeData%StateRel_x)) THEN - DEALLOCATE(LinTypeData%StateRel_x) -ENDIF -IF (ALLOCATED(LinTypeData%StateRel_xdot)) THEN - DEALLOCATE(LinTypeData%StateRel_xdot) -ENDIF -IF (ALLOCATED(LinTypeData%IsLoad_u)) THEN - DEALLOCATE(LinTypeData%IsLoad_u) -ENDIF -IF (ALLOCATED(LinTypeData%RotFrame_u)) THEN - DEALLOCATE(LinTypeData%RotFrame_u) -ENDIF -IF (ALLOCATED(LinTypeData%RotFrame_y)) THEN - DEALLOCATE(LinTypeData%RotFrame_y) -ENDIF -IF (ALLOCATED(LinTypeData%RotFrame_x)) THEN - DEALLOCATE(LinTypeData%RotFrame_x) -ENDIF -IF (ALLOCATED(LinTypeData%RotFrame_z)) THEN - DEALLOCATE(LinTypeData%RotFrame_z) -ENDIF -IF (ALLOCATED(LinTypeData%DerivOrder_x)) THEN - DEALLOCATE(LinTypeData%DerivOrder_x) -ENDIF - END SUBROUTINE FAST_DestroyLinType + CALL OpFM_DestroyInput( OpenFOAM_DataData%u, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL OpFM_DestroyOutput( OpenFOAM_DataData%y, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL OpFM_DestroyParam( OpenFOAM_DataData%p, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL OpFM_DestroyMisc( OpenFOAM_DataData%m, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END SUBROUTINE FAST_DestroyOpenFOAM_Data + + +subroutine FAST_PackOpenFOAM_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(OpenFOAM_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackOpenFOAM_Data' + if (Buf%ErrStat >= AbortErrLev) return + ! u + call OpFM_PackInput(Buf, InData%u) + if (RegCheckErr(Buf, RoutineName)) return + ! y + call OpFM_PackOutput(Buf, InData%y) + if (RegCheckErr(Buf, RoutineName)) return + ! p + call OpFM_PackParam(Buf, InData%p) + if (RegCheckErr(Buf, RoutineName)) return + ! m + call OpFM_PackMisc(Buf, InData%m) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackOpenFOAM_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(OpenFOAM_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackOpenFOAM_Data' + if (Buf%ErrStat /= ErrID_None) return + ! u + call OpFM_UnpackInput(Buf, OutData%u) ! u + ! y + call OpFM_UnpackOutput(Buf, OutData%y) ! y + ! p + call OpFM_UnpackParam(Buf, OutData%p) ! p + ! m + call OpFM_UnpackMisc(Buf, OutData%m) ! m +end subroutine + SUBROUTINE FAST_CopySCDataEx_Data( SrcSCDataEx_DataData, DstSCDataEx_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(SCDataEx_Data), INTENT(IN) :: SrcSCDataEx_DataData + TYPE(SCDataEx_Data), INTENT(INOUT) :: DstSCDataEx_DataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopySCDataEx_Data' +! + ErrStat = ErrID_None + ErrMsg = "" + CALL SC_DX_CopyInput( SrcSCDataEx_DataData%u, DstSCDataEx_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL SC_DX_CopyOutput( SrcSCDataEx_DataData%y, DstSCDataEx_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL SC_DX_CopyParam( SrcSCDataEx_DataData%p, DstSCDataEx_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + END SUBROUTINE FAST_CopySCDataEx_Data - SUBROUTINE FAST_PackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FAST_LinType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + SUBROUTINE FAST_DestroySCDataEx_Data( SCDataEx_DataData, ErrStat, ErrMsg ) + TYPE(SCDataEx_Data), INTENT(INOUT) :: SCDataEx_DataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackLinType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroySCDataEx_Data' - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! ErrStat = ErrID_None ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! Names_u allocated yes/no - IF ( ALLOCATED(InData%Names_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Names_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Names_u)*LEN(InData%Names_u) ! Names_u - END IF - Int_BufSz = Int_BufSz + 1 ! Names_y allocated yes/no - IF ( ALLOCATED(InData%Names_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Names_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Names_y)*LEN(InData%Names_y) ! Names_y - END IF - Int_BufSz = Int_BufSz + 1 ! Names_x allocated yes/no - IF ( ALLOCATED(InData%Names_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Names_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Names_x)*LEN(InData%Names_x) ! Names_x - END IF - Int_BufSz = Int_BufSz + 1 ! Names_xd allocated yes/no - IF ( ALLOCATED(InData%Names_xd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Names_xd upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Names_xd)*LEN(InData%Names_xd) ! Names_xd - END IF - Int_BufSz = Int_BufSz + 1 ! Names_z allocated yes/no - IF ( ALLOCATED(InData%Names_z) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Names_z upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Names_z)*LEN(InData%Names_z) ! Names_z - END IF - Int_BufSz = Int_BufSz + 1 ! op_u allocated yes/no - IF ( ALLOCATED(InData%op_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! op_u upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%op_u) ! op_u - END IF - Int_BufSz = Int_BufSz + 1 ! op_y allocated yes/no - IF ( ALLOCATED(InData%op_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! op_y upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%op_y) ! op_y - END IF - Int_BufSz = Int_BufSz + 1 ! op_x allocated yes/no - IF ( ALLOCATED(InData%op_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! op_x upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%op_x) ! op_x - END IF - Int_BufSz = Int_BufSz + 1 ! op_dx allocated yes/no - IF ( ALLOCATED(InData%op_dx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! op_dx upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%op_dx) ! op_dx - END IF - Int_BufSz = Int_BufSz + 1 ! op_xd allocated yes/no - IF ( ALLOCATED(InData%op_xd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! op_xd upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%op_xd) ! op_xd - END IF - Int_BufSz = Int_BufSz + 1 ! op_z allocated yes/no - IF ( ALLOCATED(InData%op_z) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! op_z upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%op_z) ! op_z - END IF - Int_BufSz = Int_BufSz + 1 ! op_x_eig_mag allocated yes/no - IF ( ALLOCATED(InData%op_x_eig_mag) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! op_x_eig_mag upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%op_x_eig_mag) ! op_x_eig_mag - END IF - Int_BufSz = Int_BufSz + 1 ! op_x_eig_phase allocated yes/no - IF ( ALLOCATED(InData%op_x_eig_phase) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! op_x_eig_phase upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%op_x_eig_phase) ! op_x_eig_phase - END IF - Int_BufSz = Int_BufSz + 1 ! Use_u allocated yes/no - IF ( ALLOCATED(InData%Use_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Use_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Use_u) ! Use_u - END IF - Int_BufSz = Int_BufSz + 1 ! Use_y allocated yes/no - IF ( ALLOCATED(InData%Use_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Use_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Use_y) ! Use_y - END IF - Int_BufSz = Int_BufSz + 1 ! A allocated yes/no - IF ( ALLOCATED(InData%A) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! A upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%A) ! A - END IF - Int_BufSz = Int_BufSz + 1 ! B allocated yes/no - IF ( ALLOCATED(InData%B) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! B upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%B) ! B - END IF - Int_BufSz = Int_BufSz + 1 ! C allocated yes/no - IF ( ALLOCATED(InData%C) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! C upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%C) ! C - END IF - Int_BufSz = Int_BufSz + 1 ! D allocated yes/no - IF ( ALLOCATED(InData%D) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! D upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%D) ! D - END IF - Int_BufSz = Int_BufSz + 1 ! StateRotation allocated yes/no - IF ( ALLOCATED(InData%StateRotation) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StateRotation upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%StateRotation) ! StateRotation - END IF - Int_BufSz = Int_BufSz + 1 ! StateRel_x allocated yes/no - IF ( ALLOCATED(InData%StateRel_x) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StateRel_x upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%StateRel_x) ! StateRel_x - END IF - Int_BufSz = Int_BufSz + 1 ! StateRel_xdot allocated yes/no - IF ( ALLOCATED(InData%StateRel_xdot) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StateRel_xdot upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%StateRel_xdot) ! StateRel_xdot - END IF - Int_BufSz = Int_BufSz + 1 ! IsLoad_u allocated yes/no - IF ( ALLOCATED(InData%IsLoad_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IsLoad_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IsLoad_u) ! IsLoad_u - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_u allocated yes/no - IF ( ALLOCATED(InData%RotFrame_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_u) ! RotFrame_u - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_y allocated yes/no - IF ( ALLOCATED(InData%RotFrame_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_y) ! RotFrame_y - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_x allocated yes/no - IF ( ALLOCATED(InData%RotFrame_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_x) ! RotFrame_x - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_z allocated yes/no - IF ( ALLOCATED(InData%RotFrame_z) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_z upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_z) ! RotFrame_z - END IF - Int_BufSz = Int_BufSz + 1 ! DerivOrder_x allocated yes/no - IF ( ALLOCATED(InData%DerivOrder_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DerivOrder_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%DerivOrder_x) ! DerivOrder_x - END IF - Int_BufSz = Int_BufSz + SIZE(InData%SizeLin) ! SizeLin - Int_BufSz = Int_BufSz + SIZE(InData%LinStartIndx) ! LinStartIndx - Int_BufSz = Int_BufSz + 1 ! NumOutputs - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%Names_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Names_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Names_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Names_u,1), UBOUND(InData%Names_u,1) - DO I = 1, LEN(InData%Names_u) - IntKiBuf(Int_Xferred) = ICHAR(InData%Names_u(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Names_y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Names_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Names_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Names_y,1), UBOUND(InData%Names_y,1) - DO I = 1, LEN(InData%Names_y) - IntKiBuf(Int_Xferred) = ICHAR(InData%Names_y(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Names_x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Names_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Names_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Names_x,1), UBOUND(InData%Names_x,1) - DO I = 1, LEN(InData%Names_x) - IntKiBuf(Int_Xferred) = ICHAR(InData%Names_x(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Names_xd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Names_xd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Names_xd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Names_xd,1), UBOUND(InData%Names_xd,1) - DO I = 1, LEN(InData%Names_xd) - IntKiBuf(Int_Xferred) = ICHAR(InData%Names_xd(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Names_z) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Names_z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Names_z,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Names_z,1), UBOUND(InData%Names_z,1) - DO I = 1, LEN(InData%Names_z) - IntKiBuf(Int_Xferred) = ICHAR(InData%Names_z(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%op_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%op_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%op_u,1), UBOUND(InData%op_u,1) - ReKiBuf(Re_Xferred) = InData%op_u(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%op_y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%op_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%op_y,1), UBOUND(InData%op_y,1) - ReKiBuf(Re_Xferred) = InData%op_y(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%op_x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%op_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%op_x,1), UBOUND(InData%op_x,1) - ReKiBuf(Re_Xferred) = InData%op_x(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%op_dx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%op_dx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_dx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%op_dx,1), UBOUND(InData%op_dx,1) - ReKiBuf(Re_Xferred) = InData%op_dx(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%op_xd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%op_xd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_xd,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%op_xd,1), UBOUND(InData%op_xd,1) - ReKiBuf(Re_Xferred) = InData%op_xd(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%op_z) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%op_z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_z,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%op_z,1), UBOUND(InData%op_z,1) - ReKiBuf(Re_Xferred) = InData%op_z(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%op_x_eig_mag) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%op_x_eig_mag,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_x_eig_mag,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%op_x_eig_mag,1), UBOUND(InData%op_x_eig_mag,1) - DbKiBuf(Db_Xferred) = InData%op_x_eig_mag(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%op_x_eig_phase) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%op_x_eig_phase,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_x_eig_phase,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%op_x_eig_phase,1), UBOUND(InData%op_x_eig_phase,1) - DbKiBuf(Db_Xferred) = InData%op_x_eig_phase(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Use_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Use_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Use_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Use_u,1), UBOUND(InData%Use_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%Use_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Use_y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Use_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Use_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Use_y,1), UBOUND(InData%Use_y,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%Use_y(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%A) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%A,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%A,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%A,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%A,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%A,2), UBOUND(InData%A,2) - DO i1 = LBOUND(InData%A,1), UBOUND(InData%A,1) - DbKiBuf(Db_Xferred) = InData%A(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%B) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%B,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B,2) - Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%B,2), UBOUND(InData%B,2) - DO i1 = LBOUND(InData%B,1), UBOUND(InData%B,1) - DbKiBuf(Db_Xferred) = InData%B(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%C) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%C,2), UBOUND(InData%C,2) - DO i1 = LBOUND(InData%C,1), UBOUND(InData%C,1) - DbKiBuf(Db_Xferred) = InData%C(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%D) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%D,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%D,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%D,2), UBOUND(InData%D,2) - DO i1 = LBOUND(InData%D,1), UBOUND(InData%D,1) - DbKiBuf(Db_Xferred) = InData%D(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StateRotation) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StateRotation,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StateRotation,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StateRotation,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StateRotation,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%StateRotation,2), UBOUND(InData%StateRotation,2) - DO i1 = LBOUND(InData%StateRotation,1), UBOUND(InData%StateRotation,1) - DbKiBuf(Db_Xferred) = InData%StateRotation(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StateRel_x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StateRel_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StateRel_x,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StateRel_x,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StateRel_x,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%StateRel_x,2), UBOUND(InData%StateRel_x,2) - DO i1 = LBOUND(InData%StateRel_x,1), UBOUND(InData%StateRel_x,1) - DbKiBuf(Db_Xferred) = InData%StateRel_x(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StateRel_xdot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StateRel_xdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StateRel_xdot,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StateRel_xdot,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StateRel_xdot,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%StateRel_xdot,2), UBOUND(InData%StateRel_xdot,2) - DO i1 = LBOUND(InData%StateRel_xdot,1), UBOUND(InData%StateRel_xdot,1) - DbKiBuf(Db_Xferred) = InData%StateRel_xdot(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IsLoad_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IsLoad_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_u,1), UBOUND(InData%RotFrame_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_y,1), UBOUND(InData%RotFrame_y,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_y(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_x,1), UBOUND(InData%RotFrame_x,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_x(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_z) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_z,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_z,1), UBOUND(InData%RotFrame_z,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_z(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DerivOrder_x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DerivOrder_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DerivOrder_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DerivOrder_x,1), UBOUND(InData%DerivOrder_x,1) - IntKiBuf(Int_Xferred) = InData%DerivOrder_x(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - DO i1 = LBOUND(InData%SizeLin,1), UBOUND(InData%SizeLin,1) - IntKiBuf(Int_Xferred) = InData%SizeLin(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%LinStartIndx,1), UBOUND(InData%LinStartIndx,1) - IntKiBuf(Int_Xferred) = InData%LinStartIndx(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%NumOutputs - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FAST_PackLinType + CALL SC_DX_DestroyInput( SCDataEx_DataData%u, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL SC_DX_DestroyOutput( SCDataEx_DataData%y, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL SC_DX_DestroyParam( SCDataEx_DataData%p, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END SUBROUTINE FAST_DestroySCDataEx_Data - SUBROUTINE FAST_UnPackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FAST_LinType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackLinType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Names_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Names_u)) DEALLOCATE(OutData%Names_u) - ALLOCATE(OutData%Names_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Names_u,1), UBOUND(OutData%Names_u,1) - DO I = 1, LEN(OutData%Names_u) - OutData%Names_u(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Names_y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Names_y)) DEALLOCATE(OutData%Names_y) - ALLOCATE(OutData%Names_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Names_y,1), UBOUND(OutData%Names_y,1) - DO I = 1, LEN(OutData%Names_y) - OutData%Names_y(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Names_x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Names_x)) DEALLOCATE(OutData%Names_x) - ALLOCATE(OutData%Names_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Names_x,1), UBOUND(OutData%Names_x,1) - DO I = 1, LEN(OutData%Names_x) - OutData%Names_x(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Names_xd not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Names_xd)) DEALLOCATE(OutData%Names_xd) - ALLOCATE(OutData%Names_xd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Names_xd,1), UBOUND(OutData%Names_xd,1) - DO I = 1, LEN(OutData%Names_xd) - OutData%Names_xd(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Names_z not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Names_z)) DEALLOCATE(OutData%Names_z) - ALLOCATE(OutData%Names_z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Names_z,1), UBOUND(OutData%Names_z,1) - DO I = 1, LEN(OutData%Names_z) - OutData%Names_z(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%op_u)) DEALLOCATE(OutData%op_u) - ALLOCATE(OutData%op_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%op_u,1), UBOUND(OutData%op_u,1) - OutData%op_u(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%op_y)) DEALLOCATE(OutData%op_y) - ALLOCATE(OutData%op_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%op_y,1), UBOUND(OutData%op_y,1) - OutData%op_y(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%op_x)) DEALLOCATE(OutData%op_x) - ALLOCATE(OutData%op_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%op_x,1), UBOUND(OutData%op_x,1) - OutData%op_x(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_dx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%op_dx)) DEALLOCATE(OutData%op_dx) - ALLOCATE(OutData%op_dx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_dx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%op_dx,1), UBOUND(OutData%op_dx,1) - OutData%op_dx(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_xd not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%op_xd)) DEALLOCATE(OutData%op_xd) - ALLOCATE(OutData%op_xd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%op_xd,1), UBOUND(OutData%op_xd,1) - OutData%op_xd(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_z not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%op_z)) DEALLOCATE(OutData%op_z) - ALLOCATE(OutData%op_z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%op_z,1), UBOUND(OutData%op_z,1) - OutData%op_z(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_x_eig_mag not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%op_x_eig_mag)) DEALLOCATE(OutData%op_x_eig_mag) - ALLOCATE(OutData%op_x_eig_mag(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_x_eig_mag.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%op_x_eig_mag,1), UBOUND(OutData%op_x_eig_mag,1) - OutData%op_x_eig_mag(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_x_eig_phase not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%op_x_eig_phase)) DEALLOCATE(OutData%op_x_eig_phase) - ALLOCATE(OutData%op_x_eig_phase(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_x_eig_phase.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%op_x_eig_phase,1), UBOUND(OutData%op_x_eig_phase,1) - OutData%op_x_eig_phase(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Use_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Use_u)) DEALLOCATE(OutData%Use_u) - ALLOCATE(OutData%Use_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Use_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Use_u,1), UBOUND(OutData%Use_u,1) - OutData%Use_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%Use_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Use_y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Use_y)) DEALLOCATE(OutData%Use_y) - ALLOCATE(OutData%Use_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Use_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Use_y,1), UBOUND(OutData%Use_y,1) - OutData%Use_y(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%Use_y(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! A not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%A)) DEALLOCATE(OutData%A) - ALLOCATE(OutData%A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%A.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%A,2), UBOUND(OutData%A,2) - DO i1 = LBOUND(OutData%A,1), UBOUND(OutData%A,1) - OutData%A(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! B not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%B)) DEALLOCATE(OutData%B) - ALLOCATE(OutData%B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%B,2), UBOUND(OutData%B,2) - DO i1 = LBOUND(OutData%B,1), UBOUND(OutData%B,1) - OutData%B(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%C)) DEALLOCATE(OutData%C) - ALLOCATE(OutData%C(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%C,2), UBOUND(OutData%C,2) - DO i1 = LBOUND(OutData%C,1), UBOUND(OutData%C,1) - OutData%C(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%D)) DEALLOCATE(OutData%D) - ALLOCATE(OutData%D(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%D,2), UBOUND(OutData%D,2) - DO i1 = LBOUND(OutData%D,1), UBOUND(OutData%D,1) - OutData%D(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StateRotation not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%StateRotation)) DEALLOCATE(OutData%StateRotation) - ALLOCATE(OutData%StateRotation(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StateRotation.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%StateRotation,2), UBOUND(OutData%StateRotation,2) - DO i1 = LBOUND(OutData%StateRotation,1), UBOUND(OutData%StateRotation,1) - OutData%StateRotation(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StateRel_x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%StateRel_x)) DEALLOCATE(OutData%StateRel_x) - ALLOCATE(OutData%StateRel_x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StateRel_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%StateRel_x,2), UBOUND(OutData%StateRel_x,2) - DO i1 = LBOUND(OutData%StateRel_x,1), UBOUND(OutData%StateRel_x,1) - OutData%StateRel_x(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StateRel_xdot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%StateRel_xdot)) DEALLOCATE(OutData%StateRel_xdot) - ALLOCATE(OutData%StateRel_xdot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StateRel_xdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%StateRel_xdot,2), UBOUND(OutData%StateRel_xdot,2) - DO i1 = LBOUND(OutData%StateRel_xdot,1), UBOUND(OutData%StateRel_xdot,1) - OutData%StateRel_xdot(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IsLoad_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IsLoad_u)) DEALLOCATE(OutData%IsLoad_u) - ALLOCATE(OutData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) - OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RotFrame_u)) DEALLOCATE(OutData%RotFrame_u) - ALLOCATE(OutData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_u,1), UBOUND(OutData%RotFrame_u,1) - OutData%RotFrame_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RotFrame_y)) DEALLOCATE(OutData%RotFrame_y) - ALLOCATE(OutData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_y,1), UBOUND(OutData%RotFrame_y,1) - OutData%RotFrame_y(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_y(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RotFrame_x)) DEALLOCATE(OutData%RotFrame_x) - ALLOCATE(OutData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_x,1), UBOUND(OutData%RotFrame_x,1) - OutData%RotFrame_x(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_x(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_z not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RotFrame_z)) DEALLOCATE(OutData%RotFrame_z) - ALLOCATE(OutData%RotFrame_z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_z,1), UBOUND(OutData%RotFrame_z,1) - OutData%RotFrame_z(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_z(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DerivOrder_x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DerivOrder_x)) DEALLOCATE(OutData%DerivOrder_x) - ALLOCATE(OutData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DerivOrder_x,1), UBOUND(OutData%DerivOrder_x,1) - OutData%DerivOrder_x(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - i1_l = LBOUND(OutData%SizeLin,1) - i1_u = UBOUND(OutData%SizeLin,1) - DO i1 = LBOUND(OutData%SizeLin,1), UBOUND(OutData%SizeLin,1) - OutData%SizeLin(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%LinStartIndx,1) - i1_u = UBOUND(OutData%LinStartIndx,1) - DO i1 = LBOUND(OutData%LinStartIndx,1), UBOUND(OutData%LinStartIndx,1) - OutData%LinStartIndx(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%NumOutputs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FAST_UnPackLinType - SUBROUTINE FAST_CopyModLinType( SrcModLinTypeData, DstModLinTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_ModLinType), INTENT(IN) :: SrcModLinTypeData - TYPE(FAST_ModLinType), INTENT(INOUT) :: DstModLinTypeData +subroutine FAST_PackSCDataEx_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SCDataEx_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackSCDataEx_Data' + if (Buf%ErrStat >= AbortErrLev) return + ! u + call SC_DX_PackInput(Buf, InData%u) + if (RegCheckErr(Buf, RoutineName)) return + ! y + call SC_DX_PackOutput(Buf, InData%y) + if (RegCheckErr(Buf, RoutineName)) return + ! p + call SC_DX_PackParam(Buf, InData%p) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackSCDataEx_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SCDataEx_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackSCDataEx_Data' + if (Buf%ErrStat /= ErrID_None) return + ! u + call SC_DX_UnpackInput(Buf, OutData%u) ! u + ! y + call SC_DX_UnpackOutput(Buf, OutData%y) ! y + ! p + call SC_DX_UnpackParam(Buf, OutData%p) ! p +end subroutine + SUBROUTINE FAST_CopySubDyn_Data( SrcSubDyn_DataData, DstSubDyn_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(SubDyn_Data), INTENT(INOUT) :: SrcSubDyn_DataData + TYPE(SubDyn_Data), INTENT(INOUT) :: DstSubDyn_DataData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg @@ -14297,267 +10607,325 @@ SUBROUTINE FAST_CopyModLinType( SrcModLinTypeData, DstModLinTypeData, CtrlCode, INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyModLinType' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopySubDyn_Data' ! ErrStat = ErrID_None ErrMsg = "" -IF (ALLOCATED(SrcModLinTypeData%Instance)) THEN - i1_l = LBOUND(SrcModLinTypeData%Instance,1) - i1_u = UBOUND(SrcModLinTypeData%Instance,1) - IF (.NOT. ALLOCATED(DstModLinTypeData%Instance)) THEN - ALLOCATE(DstModLinTypeData%Instance(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(SrcSubDyn_DataData%x,1), UBOUND(SrcSubDyn_DataData%x,1) + CALL SD_CopyContState( SrcSubDyn_DataData%x(i1), DstSubDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcSubDyn_DataData%xd,1), UBOUND(SrcSubDyn_DataData%xd,1) + CALL SD_CopyDiscState( SrcSubDyn_DataData%xd(i1), DstSubDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcSubDyn_DataData%z,1), UBOUND(SrcSubDyn_DataData%z,1) + CALL SD_CopyConstrState( SrcSubDyn_DataData%z(i1), DstSubDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcSubDyn_DataData%OtherSt,1), UBOUND(SrcSubDyn_DataData%OtherSt,1) + CALL SD_CopyOtherState( SrcSubDyn_DataData%OtherSt(i1), DstSubDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + CALL SD_CopyParam( SrcSubDyn_DataData%p, DstSubDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL SD_CopyInput( SrcSubDyn_DataData%u, DstSubDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL SD_CopyOutput( SrcSubDyn_DataData%y, DstSubDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL SD_CopyMisc( SrcSubDyn_DataData%m, DstSubDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcSubDyn_DataData%Input)) THEN + i1_l = LBOUND(SrcSubDyn_DataData%Input,1) + i1_u = UBOUND(SrcSubDyn_DataData%Input,1) + IF (.NOT. ALLOCATED(DstSubDyn_DataData%Input)) THEN + ALLOCATE(DstSubDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%Instance.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcModLinTypeData%Instance,1), UBOUND(SrcModLinTypeData%Instance,1) - CALL FAST_Copylintype( SrcModLinTypeData%Instance(i1), DstModLinTypeData%Instance(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcSubDyn_DataData%Input,1), UBOUND(SrcSubDyn_DataData%Input,1) + CALL SD_CopyInput( SrcSubDyn_DataData%Input(i1), DstSubDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF - END SUBROUTINE FAST_CopyModLinType - - SUBROUTINE FAST_DestroyModLinType( ModLinTypeData, ErrStat, ErrMsg ) - TYPE(FAST_ModLinType), INTENT(INOUT) :: ModLinTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyModLinType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ModLinTypeData%Instance)) THEN -DO i1 = LBOUND(ModLinTypeData%Instance,1), UBOUND(ModLinTypeData%Instance,1) - CALL FAST_DestroyLinType( ModLinTypeData%Instance(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModLinTypeData%Instance) -ENDIF - END SUBROUTINE FAST_DestroyModLinType - - SUBROUTINE FAST_PackModLinType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FAST_ModLinType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackModLinType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! Instance allocated yes/no - IF ( ALLOCATED(InData%Instance) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Instance upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%Instance,1), UBOUND(InData%Instance,1) - Int_BufSz = Int_BufSz + 3 ! Instance: size of buffers for each call to pack subtype - CALL FAST_PackLinType( Re_Buf, Db_Buf, Int_Buf, InData%Instance(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Instance - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Instance - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Instance - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Instance - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF +IF (ALLOCATED(SrcSubDyn_DataData%Output)) THEN + i1_l = LBOUND(SrcSubDyn_DataData%Output,1) + i1_u = UBOUND(SrcSubDyn_DataData%Output,1) + IF (.NOT. ALLOCATED(DstSubDyn_DataData%Output)) THEN + ALLOCATE(DstSubDyn_DataData%Output(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%Instance) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Instance,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Instance,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Instance,1), UBOUND(InData%Instance,1) - CALL FAST_PackLinType( Re_Buf, Db_Buf, Int_Buf, InData%Instance(i1), ErrStat2, ErrMsg2, OnlySize ) ! Instance - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO + DO i1 = LBOUND(SrcSubDyn_DataData%Output,1), UBOUND(SrcSubDyn_DataData%Output,1) + CALL SD_CopyOutput( SrcSubDyn_DataData%Output(i1), DstSubDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + CALL SD_CopyOutput( SrcSubDyn_DataData%y_interp, DstSubDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcSubDyn_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcSubDyn_DataData%InputTimes,1) + i1_u = UBOUND(SrcSubDyn_DataData%InputTimes,1) + IF (.NOT. ALLOCATED(DstSubDyn_DataData%InputTimes)) THEN + ALLOCATE(DstSubDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - END SUBROUTINE FAST_PackModLinType + DstSubDyn_DataData%InputTimes = SrcSubDyn_DataData%InputTimes +ENDIF + END SUBROUTINE FAST_CopySubDyn_Data - SUBROUTINE FAST_UnPackModLinType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FAST_ModLinType), INTENT(INOUT) :: OutData + SUBROUTINE FAST_DestroySubDyn_Data( SubDyn_DataData, ErrStat, ErrMsg ) + TYPE(SubDyn_Data), INTENT(INOUT) :: SubDyn_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackModLinType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroySubDyn_Data' + ErrStat = ErrID_None ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Instance not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Instance)) DEALLOCATE(OutData%Instance) - ALLOCATE(OutData%Instance(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Instance.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Instance,1), UBOUND(OutData%Instance,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FAST_UnpackLinType( Re_Buf, Db_Buf, Int_Buf, OutData%Instance(i1), ErrStat2, ErrMsg2 ) ! Instance - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - END SUBROUTINE FAST_UnPackModLinType +DO i1 = LBOUND(SubDyn_DataData%x,1), UBOUND(SubDyn_DataData%x,1) + CALL SD_DestroyContState( SubDyn_DataData%x(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +DO i1 = LBOUND(SubDyn_DataData%xd,1), UBOUND(SubDyn_DataData%xd,1) + CALL SD_DestroyDiscState( SubDyn_DataData%xd(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +DO i1 = LBOUND(SubDyn_DataData%z,1), UBOUND(SubDyn_DataData%z,1) + CALL SD_DestroyConstrState( SubDyn_DataData%z(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +DO i1 = LBOUND(SubDyn_DataData%OtherSt,1), UBOUND(SubDyn_DataData%OtherSt,1) + CALL SD_DestroyOtherState( SubDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + CALL SD_DestroyParam( SubDyn_DataData%p, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL SD_DestroyInput( SubDyn_DataData%u, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL SD_DestroyOutput( SubDyn_DataData%y, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL SD_DestroyMisc( SubDyn_DataData%m, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(SubDyn_DataData%Input)) THEN +DO i1 = LBOUND(SubDyn_DataData%Input,1), UBOUND(SubDyn_DataData%Input,1) + CALL SD_DestroyInput( SubDyn_DataData%Input(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(SubDyn_DataData%Input) +ENDIF +IF (ALLOCATED(SubDyn_DataData%Output)) THEN +DO i1 = LBOUND(SubDyn_DataData%Output,1), UBOUND(SubDyn_DataData%Output,1) + CALL SD_DestroyOutput( SubDyn_DataData%Output(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(SubDyn_DataData%Output) +ENDIF + CALL SD_DestroyOutput( SubDyn_DataData%y_interp, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(SubDyn_DataData%InputTimes)) THEN + DEALLOCATE(SubDyn_DataData%InputTimes) +ENDIF + END SUBROUTINE FAST_DestroySubDyn_Data - SUBROUTINE FAST_CopyLinFileType( SrcLinFileTypeData, DstLinFileTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_LinFileType), INTENT(IN) :: SrcLinFileTypeData - TYPE(FAST_LinFileType), INTENT(INOUT) :: DstLinFileTypeData + +subroutine FAST_PackSubDyn_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SubDyn_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackSubDyn_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! x + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call SD_PackContState(Buf, InData%x(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! xd + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call SD_PackDiscState(Buf, InData%xd(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! z + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call SD_PackConstrState(Buf, InData%z(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! OtherSt + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call SD_PackOtherState(Buf, InData%OtherSt(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! p + call SD_PackParam(Buf, InData%p) + if (RegCheckErr(Buf, RoutineName)) return + ! u + call SD_PackInput(Buf, InData%u) + if (RegCheckErr(Buf, RoutineName)) return + ! y + call SD_PackOutput(Buf, InData%y) + if (RegCheckErr(Buf, RoutineName)) return + ! m + call SD_PackMisc(Buf, InData%m) + if (RegCheckErr(Buf, RoutineName)) return + ! Input + call RegPack(Buf, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call SD_PackInput(Buf, InData%Input(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Output + call RegPack(Buf, allocated(InData%Output)) + if (allocated(InData%Output)) then + call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) + LB(1:1) = lbound(InData%Output) + UB(1:1) = ubound(InData%Output) + do i1 = LB(1), UB(1) + call SD_PackOutput(Buf, InData%Output(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! y_interp + call SD_PackOutput(Buf, InData%y_interp) + if (RegCheckErr(Buf, RoutineName)) return + ! InputTimes + call RegPack(Buf, allocated(InData%InputTimes)) + if (allocated(InData%InputTimes)) then + call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPack(Buf, InData%InputTimes) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackSubDyn_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SubDyn_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackSubDyn_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! x + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) + do i1 = LB(1), UB(1) + call SD_UnpackContState(Buf, OutData%x(i1)) ! x + end do + ! xd + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) + do i1 = LB(1), UB(1) + call SD_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + end do + ! z + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) + do i1 = LB(1), UB(1) + call SD_UnpackConstrState(Buf, OutData%z(i1)) ! z + end do + ! OtherSt + LB(1:1) = lbound(OutData%OtherSt) + UB(1:1) = ubound(OutData%OtherSt) + do i1 = LB(1), UB(1) + call SD_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + end do + ! p + call SD_UnpackParam(Buf, OutData%p) ! p + ! u + call SD_UnpackInput(Buf, OutData%u) ! u + ! y + call SD_UnpackOutput(Buf, OutData%y) ! y + ! m + call SD_UnpackMisc(Buf, OutData%m) ! m + ! Input + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackInput(Buf, OutData%Input(i1)) ! Input + end do + end if + ! Output + if (allocated(OutData%Output)) deallocate(OutData%Output) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Output(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackOutput(Buf, OutData%Output(i1)) ! Output + end do + end if + ! y_interp + call SD_UnpackOutput(Buf, OutData%y_interp) ! y_interp + ! InputTimes + if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InputTimes) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + SUBROUTINE FAST_CopyExtPtfm_Data( SrcExtPtfm_DataData, DstExtPtfm_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ExtPtfm_Data), INTENT(INOUT) :: SrcExtPtfm_DataData + TYPE(ExtPtfm_Data), INTENT(INOUT) :: DstExtPtfm_DataData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg @@ -14566,5029 +10934,1768 @@ SUBROUTINE FAST_CopyLinFileType( SrcLinFileTypeData, DstLinFileTypeData, CtrlCod INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyLinFileType' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyExtPtfm_Data' ! ErrStat = ErrID_None ErrMsg = "" - DO i1 = LBOUND(SrcLinFileTypeData%Modules,1), UBOUND(SrcLinFileTypeData%Modules,1) - CALL FAST_Copymodlintype( SrcLinFileTypeData%Modules(i1), DstLinFileTypeData%Modules(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcExtPtfm_DataData%x,1), UBOUND(SrcExtPtfm_DataData%x,1) + CALL ExtPtfm_CopyContState( SrcExtPtfm_DataData%x(i1), DstExtPtfm_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - CALL FAST_Copylintype( SrcLinFileTypeData%Glue, DstLinFileTypeData%Glue, CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcExtPtfm_DataData%xd,1), UBOUND(SrcExtPtfm_DataData%xd,1) + CALL ExtPtfm_CopyDiscState( SrcExtPtfm_DataData%xd(i1), DstExtPtfm_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - DstLinFileTypeData%RotSpeed = SrcLinFileTypeData%RotSpeed - DstLinFileTypeData%Azimuth = SrcLinFileTypeData%Azimuth - DstLinFileTypeData%WindSpeed = SrcLinFileTypeData%WindSpeed - END SUBROUTINE FAST_CopyLinFileType + ENDDO + DO i1 = LBOUND(SrcExtPtfm_DataData%z,1), UBOUND(SrcExtPtfm_DataData%z,1) + CALL ExtPtfm_CopyConstrState( SrcExtPtfm_DataData%z(i1), DstExtPtfm_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcExtPtfm_DataData%OtherSt,1), UBOUND(SrcExtPtfm_DataData%OtherSt,1) + CALL ExtPtfm_CopyOtherState( SrcExtPtfm_DataData%OtherSt(i1), DstExtPtfm_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + CALL ExtPtfm_CopyParam( SrcExtPtfm_DataData%p, DstExtPtfm_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL ExtPtfm_CopyInput( SrcExtPtfm_DataData%u, DstExtPtfm_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL ExtPtfm_CopyOutput( SrcExtPtfm_DataData%y, DstExtPtfm_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL ExtPtfm_CopyMisc( SrcExtPtfm_DataData%m, DstExtPtfm_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcExtPtfm_DataData%Input)) THEN + i1_l = LBOUND(SrcExtPtfm_DataData%Input,1) + i1_u = UBOUND(SrcExtPtfm_DataData%Input,1) + IF (.NOT. ALLOCATED(DstExtPtfm_DataData%Input)) THEN + ALLOCATE(DstExtPtfm_DataData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstExtPtfm_DataData%Input.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcExtPtfm_DataData%Input,1), UBOUND(SrcExtPtfm_DataData%Input,1) + CALL ExtPtfm_CopyInput( SrcExtPtfm_DataData%Input(i1), DstExtPtfm_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcExtPtfm_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcExtPtfm_DataData%InputTimes,1) + i1_u = UBOUND(SrcExtPtfm_DataData%InputTimes,1) + IF (.NOT. ALLOCATED(DstExtPtfm_DataData%InputTimes)) THEN + ALLOCATE(DstExtPtfm_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstExtPtfm_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstExtPtfm_DataData%InputTimes = SrcExtPtfm_DataData%InputTimes +ENDIF + END SUBROUTINE FAST_CopyExtPtfm_Data - SUBROUTINE FAST_DestroyLinFileType( LinFileTypeData, ErrStat, ErrMsg ) - TYPE(FAST_LinFileType), INTENT(INOUT) :: LinFileTypeData + SUBROUTINE FAST_DestroyExtPtfm_Data( ExtPtfm_DataData, ErrStat, ErrMsg ) + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyLinFileType' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyExtPtfm_Data' ErrStat = ErrID_None ErrMsg = "" -DO i1 = LBOUND(LinFileTypeData%Modules,1), UBOUND(LinFileTypeData%Modules,1) - CALL FAST_DestroyModLinType( LinFileTypeData%Modules(i1), ErrStat2, ErrMsg2 ) +DO i1 = LBOUND(ExtPtfm_DataData%x,1), UBOUND(ExtPtfm_DataData%x,1) + CALL ExtPtfm_DestroyContState( ExtPtfm_DataData%x(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO - CALL FAST_DestroyLinType( LinFileTypeData%Glue, ErrStat2, ErrMsg2 ) +DO i1 = LBOUND(ExtPtfm_DataData%xd,1), UBOUND(ExtPtfm_DataData%xd,1) + CALL ExtPtfm_DestroyDiscState( ExtPtfm_DataData%xd(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE FAST_DestroyLinFileType - - SUBROUTINE FAST_PackLinFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FAST_LinFileType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackLinFileType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%Modules,1), UBOUND(InData%Modules,1) - Int_BufSz = Int_BufSz + 3 ! Modules: size of buffers for each call to pack subtype - CALL FAST_PackModLinType( Re_Buf, Db_Buf, Int_Buf, InData%Modules(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Modules - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Modules - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Modules - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Modules - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! Glue: size of buffers for each call to pack subtype - CALL FAST_PackLinType( Re_Buf, Db_Buf, Int_Buf, InData%Glue, ErrStat2, ErrMsg2, .TRUE. ) ! Glue - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Glue - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Glue - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Glue - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Re_BufSz = Re_BufSz + 1 ! RotSpeed - Re_BufSz = Re_BufSz + 1 ! Azimuth - Re_BufSz = Re_BufSz + 1 ! WindSpeed - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i1 = LBOUND(InData%Modules,1), UBOUND(InData%Modules,1) - CALL FAST_PackModLinType( Re_Buf, Db_Buf, Int_Buf, InData%Modules(i1), ErrStat2, ErrMsg2, OnlySize ) ! Modules - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - CALL FAST_PackLinType( Re_Buf, Db_Buf, Int_Buf, InData%Glue, ErrStat2, ErrMsg2, OnlySize ) ! Glue - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - ReKiBuf(Re_Xferred) = InData%RotSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Azimuth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WindSpeed - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE FAST_PackLinFileType - - SUBROUTINE FAST_UnPackLinFileType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FAST_LinFileType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackLinFileType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%Modules,1) - i1_u = UBOUND(OutData%Modules,1) - DO i1 = LBOUND(OutData%Modules,1), UBOUND(OutData%Modules,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FAST_UnpackModLinType( Re_Buf, Db_Buf, Int_Buf, OutData%Modules(i1), ErrStat2, ErrMsg2 ) ! Modules - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FAST_UnpackLinType( Re_Buf, Db_Buf, Int_Buf, OutData%Glue, ErrStat2, ErrMsg2 ) ! Glue - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN +ENDDO +DO i1 = LBOUND(ExtPtfm_DataData%z,1), UBOUND(ExtPtfm_DataData%z,1) + CALL ExtPtfm_DestroyConstrState( ExtPtfm_DataData%z(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +DO i1 = LBOUND(ExtPtfm_DataData%OtherSt,1), UBOUND(ExtPtfm_DataData%OtherSt,1) + CALL ExtPtfm_DestroyOtherState( ExtPtfm_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + CALL ExtPtfm_DestroyParam( ExtPtfm_DataData%p, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL ExtPtfm_DestroyInput( ExtPtfm_DataData%u, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL ExtPtfm_DestroyOutput( ExtPtfm_DataData%y, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL ExtPtfm_DestroyMisc( ExtPtfm_DataData%m, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(ExtPtfm_DataData%Input)) THEN +DO i1 = LBOUND(ExtPtfm_DataData%Input,1), UBOUND(ExtPtfm_DataData%Input,1) + CALL ExtPtfm_DestroyInput( ExtPtfm_DataData%Input(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(ExtPtfm_DataData%Input) +ENDIF +IF (ALLOCATED(ExtPtfm_DataData%InputTimes)) THEN + DEALLOCATE(ExtPtfm_DataData%InputTimes) +ENDIF + END SUBROUTINE FAST_DestroyExtPtfm_Data - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%RotSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Azimuth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WindSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE FAST_UnPackLinFileType - SUBROUTINE FAST_CopyMiscLinType( SrcMiscLinTypeData, DstMiscLinTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_MiscLinType), INTENT(IN) :: SrcMiscLinTypeData - TYPE(FAST_MiscLinType), INTENT(INOUT) :: DstMiscLinTypeData +subroutine FAST_PackExtPtfm_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackExtPtfm_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! x + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call ExtPtfm_PackContState(Buf, InData%x(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! xd + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call ExtPtfm_PackDiscState(Buf, InData%xd(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! z + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call ExtPtfm_PackConstrState(Buf, InData%z(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! OtherSt + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call ExtPtfm_PackOtherState(Buf, InData%OtherSt(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! p + call ExtPtfm_PackParam(Buf, InData%p) + if (RegCheckErr(Buf, RoutineName)) return + ! u + call ExtPtfm_PackInput(Buf, InData%u) + if (RegCheckErr(Buf, RoutineName)) return + ! y + call ExtPtfm_PackOutput(Buf, InData%y) + if (RegCheckErr(Buf, RoutineName)) return + ! m + call ExtPtfm_PackMisc(Buf, InData%m) + if (RegCheckErr(Buf, RoutineName)) return + ! Input + call RegPack(Buf, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call ExtPtfm_PackInput(Buf, InData%Input(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! InputTimes + call RegPack(Buf, allocated(InData%InputTimes)) + if (allocated(InData%InputTimes)) then + call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPack(Buf, InData%InputTimes) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackExtPtfm_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ExtPtfm_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackExtPtfm_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! x + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) + do i1 = LB(1), UB(1) + call ExtPtfm_UnpackContState(Buf, OutData%x(i1)) ! x + end do + ! xd + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) + do i1 = LB(1), UB(1) + call ExtPtfm_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + end do + ! z + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) + do i1 = LB(1), UB(1) + call ExtPtfm_UnpackConstrState(Buf, OutData%z(i1)) ! z + end do + ! OtherSt + LB(1:1) = lbound(OutData%OtherSt) + UB(1:1) = ubound(OutData%OtherSt) + do i1 = LB(1), UB(1) + call ExtPtfm_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + end do + ! p + call ExtPtfm_UnpackParam(Buf, OutData%p) ! p + ! u + call ExtPtfm_UnpackInput(Buf, OutData%u) ! u + ! y + call ExtPtfm_UnpackOutput(Buf, OutData%y) ! y + ! m + call ExtPtfm_UnpackMisc(Buf, OutData%m) ! m + ! Input + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ExtPtfm_UnpackInput(Buf, OutData%Input(i1)) ! Input + end do + end if + ! InputTimes + if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InputTimes) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + SUBROUTINE FAST_CopySeaState_Data( SrcSeaState_DataData, DstSeaState_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(SeaState_Data), INTENT(IN) :: SrcSeaState_DataData + TYPE(SeaState_Data), INTENT(INOUT) :: DstSeaState_DataData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local INTEGER(IntKi) :: i,j,k INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyMiscLinType' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopySeaState_Data' ! ErrStat = ErrID_None ErrMsg = "" -IF (ALLOCATED(SrcMiscLinTypeData%LinTimes)) THEN - i1_l = LBOUND(SrcMiscLinTypeData%LinTimes,1) - i1_u = UBOUND(SrcMiscLinTypeData%LinTimes,1) - IF (.NOT. ALLOCATED(DstMiscLinTypeData%LinTimes)) THEN - ALLOCATE(DstMiscLinTypeData%LinTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%LinTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscLinTypeData%LinTimes = SrcMiscLinTypeData%LinTimes -ENDIF - DstMiscLinTypeData%CopyOP_CtrlCode = SrcMiscLinTypeData%CopyOP_CtrlCode -IF (ALLOCATED(SrcMiscLinTypeData%AzimTarget)) THEN - i1_l = LBOUND(SrcMiscLinTypeData%AzimTarget,1) - i1_u = UBOUND(SrcMiscLinTypeData%AzimTarget,1) - IF (.NOT. ALLOCATED(DstMiscLinTypeData%AzimTarget)) THEN - ALLOCATE(DstMiscLinTypeData%AzimTarget(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%AzimTarget.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscLinTypeData%AzimTarget = SrcMiscLinTypeData%AzimTarget -ENDIF - DstMiscLinTypeData%IsConverged = SrcMiscLinTypeData%IsConverged - DstMiscLinTypeData%FoundSteady = SrcMiscLinTypeData%FoundSteady - DstMiscLinTypeData%ForceLin = SrcMiscLinTypeData%ForceLin - DstMiscLinTypeData%n_rot = SrcMiscLinTypeData%n_rot - DstMiscLinTypeData%AzimIndx = SrcMiscLinTypeData%AzimIndx - DstMiscLinTypeData%NextLinTimeIndx = SrcMiscLinTypeData%NextLinTimeIndx -IF (ALLOCATED(SrcMiscLinTypeData%Psi)) THEN - i1_l = LBOUND(SrcMiscLinTypeData%Psi,1) - i1_u = UBOUND(SrcMiscLinTypeData%Psi,1) - IF (.NOT. ALLOCATED(DstMiscLinTypeData%Psi)) THEN - ALLOCATE(DstMiscLinTypeData%Psi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%Psi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscLinTypeData%Psi = SrcMiscLinTypeData%Psi -ENDIF -IF (ALLOCATED(SrcMiscLinTypeData%y_interp)) THEN - i1_l = LBOUND(SrcMiscLinTypeData%y_interp,1) - i1_u = UBOUND(SrcMiscLinTypeData%y_interp,1) - IF (.NOT. ALLOCATED(DstMiscLinTypeData%y_interp)) THEN - ALLOCATE(DstMiscLinTypeData%y_interp(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(SrcSeaState_DataData%x,1), UBOUND(SrcSeaState_DataData%x,1) + CALL SeaSt_CopyContState( SrcSeaState_DataData%x(i1), DstSeaState_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcSeaState_DataData%xd,1), UBOUND(SrcSeaState_DataData%xd,1) + CALL SeaSt_CopyDiscState( SrcSeaState_DataData%xd(i1), DstSeaState_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcSeaState_DataData%z,1), UBOUND(SrcSeaState_DataData%z,1) + CALL SeaSt_CopyConstrState( SrcSeaState_DataData%z(i1), DstSeaState_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcSeaState_DataData%OtherSt,1), UBOUND(SrcSeaState_DataData%OtherSt,1) + CALL SeaSt_CopyOtherState( SrcSeaState_DataData%OtherSt(i1), DstSeaState_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + CALL SeaSt_CopyParam( SrcSeaState_DataData%p, DstSeaState_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL SeaSt_CopyInput( SrcSeaState_DataData%u, DstSeaState_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL SeaSt_CopyOutput( SrcSeaState_DataData%y, DstSeaState_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL SeaSt_CopyMisc( SrcSeaState_DataData%m, DstSeaState_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcSeaState_DataData%Input)) THEN + i1_l = LBOUND(SrcSeaState_DataData%Input,1) + i1_u = UBOUND(SrcSeaState_DataData%Input,1) + IF (.NOT. ALLOCATED(DstSeaState_DataData%Input)) THEN + ALLOCATE(DstSeaState_DataData%Input(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%y_interp.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaState_DataData%Input.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstMiscLinTypeData%y_interp = SrcMiscLinTypeData%y_interp + DO i1 = LBOUND(SrcSeaState_DataData%Input,1), UBOUND(SrcSeaState_DataData%Input,1) + CALL SeaSt_CopyInput( SrcSeaState_DataData%Input(i1), DstSeaState_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(SrcMiscLinTypeData%y_ref)) THEN - i1_l = LBOUND(SrcMiscLinTypeData%y_ref,1) - i1_u = UBOUND(SrcMiscLinTypeData%y_ref,1) - IF (.NOT. ALLOCATED(DstMiscLinTypeData%y_ref)) THEN - ALLOCATE(DstMiscLinTypeData%y_ref(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcSeaState_DataData%Output)) THEN + i1_l = LBOUND(SrcSeaState_DataData%Output,1) + i1_u = UBOUND(SrcSeaState_DataData%Output,1) + IF (.NOT. ALLOCATED(DstSeaState_DataData%Output)) THEN + ALLOCATE(DstSeaState_DataData%Output(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%y_ref.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaState_DataData%Output.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstMiscLinTypeData%y_ref = SrcMiscLinTypeData%y_ref + DO i1 = LBOUND(SrcSeaState_DataData%Output,1), UBOUND(SrcSeaState_DataData%Output,1) + CALL SeaSt_CopyOutput( SrcSeaState_DataData%Output(i1), DstSeaState_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(SrcMiscLinTypeData%Y_prevRot)) THEN - i1_l = LBOUND(SrcMiscLinTypeData%Y_prevRot,1) - i1_u = UBOUND(SrcMiscLinTypeData%Y_prevRot,1) - i2_l = LBOUND(SrcMiscLinTypeData%Y_prevRot,2) - i2_u = UBOUND(SrcMiscLinTypeData%Y_prevRot,2) - IF (.NOT. ALLOCATED(DstMiscLinTypeData%Y_prevRot)) THEN - ALLOCATE(DstMiscLinTypeData%Y_prevRot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + CALL SeaSt_CopyOutput( SrcSeaState_DataData%y_interp, DstSeaState_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcSeaState_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcSeaState_DataData%InputTimes,1) + i1_u = UBOUND(SrcSeaState_DataData%InputTimes,1) + IF (.NOT. ALLOCATED(DstSeaState_DataData%InputTimes)) THEN + ALLOCATE(DstSeaState_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%Y_prevRot.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaState_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstMiscLinTypeData%Y_prevRot = SrcMiscLinTypeData%Y_prevRot + DstSeaState_DataData%InputTimes = SrcSeaState_DataData%InputTimes ENDIF - END SUBROUTINE FAST_CopyMiscLinType + END SUBROUTINE FAST_CopySeaState_Data - SUBROUTINE FAST_DestroyMiscLinType( MiscLinTypeData, ErrStat, ErrMsg ) - TYPE(FAST_MiscLinType), INTENT(INOUT) :: MiscLinTypeData + SUBROUTINE FAST_DestroySeaState_Data( SeaState_DataData, ErrStat, ErrMsg ) + TYPE(SeaState_Data), INTENT(INOUT) :: SeaState_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyMiscLinType' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroySeaState_Data' ErrStat = ErrID_None ErrMsg = "" -IF (ALLOCATED(MiscLinTypeData%LinTimes)) THEN - DEALLOCATE(MiscLinTypeData%LinTimes) -ENDIF -IF (ALLOCATED(MiscLinTypeData%AzimTarget)) THEN - DEALLOCATE(MiscLinTypeData%AzimTarget) -ENDIF -IF (ALLOCATED(MiscLinTypeData%Psi)) THEN - DEALLOCATE(MiscLinTypeData%Psi) -ENDIF -IF (ALLOCATED(MiscLinTypeData%y_interp)) THEN - DEALLOCATE(MiscLinTypeData%y_interp) +DO i1 = LBOUND(SeaState_DataData%x,1), UBOUND(SeaState_DataData%x,1) + CALL SeaSt_DestroyContState( SeaState_DataData%x(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +DO i1 = LBOUND(SeaState_DataData%xd,1), UBOUND(SeaState_DataData%xd,1) + CALL SeaSt_DestroyDiscState( SeaState_DataData%xd(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +DO i1 = LBOUND(SeaState_DataData%z,1), UBOUND(SeaState_DataData%z,1) + CALL SeaSt_DestroyConstrState( SeaState_DataData%z(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +DO i1 = LBOUND(SeaState_DataData%OtherSt,1), UBOUND(SeaState_DataData%OtherSt,1) + CALL SeaSt_DestroyOtherState( SeaState_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + CALL SeaSt_DestroyParam( SeaState_DataData%p, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL SeaSt_DestroyInput( SeaState_DataData%u, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL SeaSt_DestroyOutput( SeaState_DataData%y, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL SeaSt_DestroyMisc( SeaState_DataData%m, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(SeaState_DataData%Input)) THEN +DO i1 = LBOUND(SeaState_DataData%Input,1), UBOUND(SeaState_DataData%Input,1) + CALL SeaSt_DestroyInput( SeaState_DataData%Input(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(SeaState_DataData%Input) ENDIF -IF (ALLOCATED(MiscLinTypeData%y_ref)) THEN - DEALLOCATE(MiscLinTypeData%y_ref) +IF (ALLOCATED(SeaState_DataData%Output)) THEN +DO i1 = LBOUND(SeaState_DataData%Output,1), UBOUND(SeaState_DataData%Output,1) + CALL SeaSt_DestroyOutput( SeaState_DataData%Output(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(SeaState_DataData%Output) ENDIF -IF (ALLOCATED(MiscLinTypeData%Y_prevRot)) THEN - DEALLOCATE(MiscLinTypeData%Y_prevRot) + CALL SeaSt_DestroyOutput( SeaState_DataData%y_interp, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(SeaState_DataData%InputTimes)) THEN + DEALLOCATE(SeaState_DataData%InputTimes) ENDIF - END SUBROUTINE FAST_DestroyMiscLinType - - SUBROUTINE FAST_PackMiscLinType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FAST_MiscLinType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackMiscLinType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! LinTimes allocated yes/no - IF ( ALLOCATED(InData%LinTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%LinTimes) ! LinTimes - END IF - Int_BufSz = Int_BufSz + 1 ! CopyOP_CtrlCode - Int_BufSz = Int_BufSz + 1 ! AzimTarget allocated yes/no - IF ( ALLOCATED(InData%AzimTarget) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AzimTarget upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%AzimTarget) ! AzimTarget - END IF - Int_BufSz = Int_BufSz + 1 ! IsConverged - Int_BufSz = Int_BufSz + 1 ! FoundSteady - Int_BufSz = Int_BufSz + 1 ! ForceLin - Int_BufSz = Int_BufSz + 1 ! n_rot - Int_BufSz = Int_BufSz + 1 ! AzimIndx - Int_BufSz = Int_BufSz + 1 ! NextLinTimeIndx - Int_BufSz = Int_BufSz + 1 ! Psi allocated yes/no - IF ( ALLOCATED(InData%Psi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Psi upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Psi) ! Psi - END IF - Int_BufSz = Int_BufSz + 1 ! y_interp allocated yes/no - IF ( ALLOCATED(InData%y_interp) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y_interp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%y_interp) ! y_interp - END IF - Int_BufSz = Int_BufSz + 1 ! y_ref allocated yes/no - IF ( ALLOCATED(InData%y_ref) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y_ref upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%y_ref) ! y_ref - END IF - Int_BufSz = Int_BufSz + 1 ! Y_prevRot allocated yes/no - IF ( ALLOCATED(InData%Y_prevRot) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Y_prevRot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Y_prevRot) ! Y_prevRot - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%LinTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinTimes,1), UBOUND(InData%LinTimes,1) - DbKiBuf(Db_Xferred) = InData%LinTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%CopyOP_CtrlCode - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%AzimTarget) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AzimTarget,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AzimTarget,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AzimTarget,1), UBOUND(InData%AzimTarget,1) - DbKiBuf(Db_Xferred) = InData%AzimTarget(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%IsConverged, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%FoundSteady, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%ForceLin, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%n_rot - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%AzimIndx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NextLinTimeIndx - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Psi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Psi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Psi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Psi,1), UBOUND(InData%Psi,1) - DbKiBuf(Db_Xferred) = InData%Psi(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%y_interp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%y_interp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y_interp,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y_interp,1), UBOUND(InData%y_interp,1) - ReKiBuf(Re_Xferred) = InData%y_interp(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%y_ref) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%y_ref,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y_ref,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y_ref,1), UBOUND(InData%y_ref,1) - ReKiBuf(Re_Xferred) = InData%y_ref(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Y_prevRot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Y_prevRot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y_prevRot,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Y_prevRot,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y_prevRot,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Y_prevRot,2), UBOUND(InData%Y_prevRot,2) - DO i1 = LBOUND(InData%Y_prevRot,1), UBOUND(InData%Y_prevRot,1) - ReKiBuf(Re_Xferred) = InData%Y_prevRot(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE FAST_PackMiscLinType + END SUBROUTINE FAST_DestroySeaState_Data - SUBROUTINE FAST_UnPackMiscLinType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FAST_MiscLinType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackMiscLinType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinTimes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LinTimes)) DEALLOCATE(OutData%LinTimes) - ALLOCATE(OutData%LinTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinTimes,1), UBOUND(OutData%LinTimes,1) - OutData%LinTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - OutData%CopyOP_CtrlCode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AzimTarget not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AzimTarget)) DEALLOCATE(OutData%AzimTarget) - ALLOCATE(OutData%AzimTarget(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AzimTarget.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AzimTarget,1), UBOUND(OutData%AzimTarget,1) - OutData%AzimTarget(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - OutData%IsConverged = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsConverged) - Int_Xferred = Int_Xferred + 1 - OutData%FoundSteady = TRANSFER(IntKiBuf(Int_Xferred), OutData%FoundSteady) - Int_Xferred = Int_Xferred + 1 - OutData%ForceLin = TRANSFER(IntKiBuf(Int_Xferred), OutData%ForceLin) - Int_Xferred = Int_Xferred + 1 - OutData%n_rot = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%AzimIndx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NextLinTimeIndx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Psi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Psi)) DEALLOCATE(OutData%Psi) - ALLOCATE(OutData%Psi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Psi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Psi,1), UBOUND(OutData%Psi,1) - OutData%Psi(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y_interp not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%y_interp)) DEALLOCATE(OutData%y_interp) - ALLOCATE(OutData%y_interp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_interp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y_interp,1), UBOUND(OutData%y_interp,1) - OutData%y_interp(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y_ref not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%y_ref)) DEALLOCATE(OutData%y_ref) - ALLOCATE(OutData%y_ref(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_ref.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y_ref,1), UBOUND(OutData%y_ref,1) - OutData%y_ref(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Y_prevRot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Y_prevRot)) DEALLOCATE(OutData%Y_prevRot) - ALLOCATE(OutData%Y_prevRot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y_prevRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Y_prevRot,2), UBOUND(OutData%Y_prevRot,2) - DO i1 = LBOUND(OutData%Y_prevRot,1), UBOUND(OutData%Y_prevRot,1) - OutData%Y_prevRot(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE FAST_UnPackMiscLinType - SUBROUTINE FAST_CopyOutputFileType( SrcOutputFileTypeData, DstOutputFileTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_OutputFileType), INTENT(INOUT) :: SrcOutputFileTypeData - TYPE(FAST_OutputFileType), INTENT(INOUT) :: DstOutputFileTypeData +subroutine FAST_PackSeaState_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SeaState_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackSeaState_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! x + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call SeaSt_PackContState(Buf, InData%x(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! xd + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call SeaSt_PackDiscState(Buf, InData%xd(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! z + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call SeaSt_PackConstrState(Buf, InData%z(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! OtherSt + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call SeaSt_PackOtherState(Buf, InData%OtherSt(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! p + call SeaSt_PackParam(Buf, InData%p) + if (RegCheckErr(Buf, RoutineName)) return + ! u + call SeaSt_PackInput(Buf, InData%u) + if (RegCheckErr(Buf, RoutineName)) return + ! y + call SeaSt_PackOutput(Buf, InData%y) + if (RegCheckErr(Buf, RoutineName)) return + ! m + call SeaSt_PackMisc(Buf, InData%m) + if (RegCheckErr(Buf, RoutineName)) return + ! Input + call RegPack(Buf, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call SeaSt_PackInput(Buf, InData%Input(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Output + call RegPack(Buf, allocated(InData%Output)) + if (allocated(InData%Output)) then + call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) + LB(1:1) = lbound(InData%Output) + UB(1:1) = ubound(InData%Output) + do i1 = LB(1), UB(1) + call SeaSt_PackOutput(Buf, InData%Output(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! y_interp + call SeaSt_PackOutput(Buf, InData%y_interp) + if (RegCheckErr(Buf, RoutineName)) return + ! InputTimes + call RegPack(Buf, allocated(InData%InputTimes)) + if (allocated(InData%InputTimes)) then + call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPack(Buf, InData%InputTimes) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackSeaState_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SeaState_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackSeaState_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! x + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) + do i1 = LB(1), UB(1) + call SeaSt_UnpackContState(Buf, OutData%x(i1)) ! x + end do + ! xd + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) + do i1 = LB(1), UB(1) + call SeaSt_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + end do + ! z + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) + do i1 = LB(1), UB(1) + call SeaSt_UnpackConstrState(Buf, OutData%z(i1)) ! z + end do + ! OtherSt + LB(1:1) = lbound(OutData%OtherSt) + UB(1:1) = ubound(OutData%OtherSt) + do i1 = LB(1), UB(1) + call SeaSt_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + end do + ! p + call SeaSt_UnpackParam(Buf, OutData%p) ! p + ! u + call SeaSt_UnpackInput(Buf, OutData%u) ! u + ! y + call SeaSt_UnpackOutput(Buf, OutData%y) ! y + ! m + call SeaSt_UnpackMisc(Buf, OutData%m) ! m + ! Input + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SeaSt_UnpackInput(Buf, OutData%Input(i1)) ! Input + end do + end if + ! Output + if (allocated(OutData%Output)) deallocate(OutData%Output) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Output(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SeaSt_UnpackOutput(Buf, OutData%Output(i1)) ! Output + end do + end if + ! y_interp + call SeaSt_UnpackOutput(Buf, OutData%y_interp) ! y_interp + ! InputTimes + if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InputTimes) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + SUBROUTINE FAST_CopyHydroDyn_Data( SrcHydroDyn_DataData, DstHydroDyn_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(HydroDyn_Data), INTENT(INOUT) :: SrcHydroDyn_DataData + TYPE(HydroDyn_Data), INTENT(INOUT) :: DstHydroDyn_DataData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local INTEGER(IntKi) :: i,j,k INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyOutputFileType' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyHydroDyn_Data' ! ErrStat = ErrID_None ErrMsg = "" -IF (ALLOCATED(SrcOutputFileTypeData%TimeData)) THEN - i1_l = LBOUND(SrcOutputFileTypeData%TimeData,1) - i1_u = UBOUND(SrcOutputFileTypeData%TimeData,1) - IF (.NOT. ALLOCATED(DstOutputFileTypeData%TimeData)) THEN - ALLOCATE(DstOutputFileTypeData%TimeData(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%TimeData.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputFileTypeData%TimeData = SrcOutputFileTypeData%TimeData -ENDIF -IF (ALLOCATED(SrcOutputFileTypeData%AllOutData)) THEN - i1_l = LBOUND(SrcOutputFileTypeData%AllOutData,1) - i1_u = UBOUND(SrcOutputFileTypeData%AllOutData,1) - i2_l = LBOUND(SrcOutputFileTypeData%AllOutData,2) - i2_u = UBOUND(SrcOutputFileTypeData%AllOutData,2) - IF (.NOT. ALLOCATED(DstOutputFileTypeData%AllOutData)) THEN - ALLOCATE(DstOutputFileTypeData%AllOutData(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DO i1 = LBOUND(SrcHydroDyn_DataData%x,1), UBOUND(SrcHydroDyn_DataData%x,1) + CALL HydroDyn_CopyContState( SrcHydroDyn_DataData%x(i1), DstHydroDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcHydroDyn_DataData%xd,1), UBOUND(SrcHydroDyn_DataData%xd,1) + CALL HydroDyn_CopyDiscState( SrcHydroDyn_DataData%xd(i1), DstHydroDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcHydroDyn_DataData%z,1), UBOUND(SrcHydroDyn_DataData%z,1) + CALL HydroDyn_CopyConstrState( SrcHydroDyn_DataData%z(i1), DstHydroDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcHydroDyn_DataData%OtherSt,1), UBOUND(SrcHydroDyn_DataData%OtherSt,1) + CALL HydroDyn_CopyOtherState( SrcHydroDyn_DataData%OtherSt(i1), DstHydroDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + CALL HydroDyn_CopyParam( SrcHydroDyn_DataData%p, DstHydroDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL HydroDyn_CopyInput( SrcHydroDyn_DataData%u, DstHydroDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL HydroDyn_CopyOutput( SrcHydroDyn_DataData%y, DstHydroDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL HydroDyn_CopyMisc( SrcHydroDyn_DataData%m, DstHydroDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcHydroDyn_DataData%Output)) THEN + i1_l = LBOUND(SrcHydroDyn_DataData%Output,1) + i1_u = UBOUND(SrcHydroDyn_DataData%Output,1) + IF (.NOT. ALLOCATED(DstHydroDyn_DataData%Output)) THEN + ALLOCATE(DstHydroDyn_DataData%Output(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%AllOutData.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstOutputFileTypeData%AllOutData = SrcOutputFileTypeData%AllOutData + DO i1 = LBOUND(SrcHydroDyn_DataData%Output,1), UBOUND(SrcHydroDyn_DataData%Output,1) + CALL HydroDyn_CopyOutput( SrcHydroDyn_DataData%Output(i1), DstHydroDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF - DstOutputFileTypeData%n_Out = SrcOutputFileTypeData%n_Out - DstOutputFileTypeData%NOutSteps = SrcOutputFileTypeData%NOutSteps - DstOutputFileTypeData%numOuts = SrcOutputFileTypeData%numOuts - DstOutputFileTypeData%UnOu = SrcOutputFileTypeData%UnOu - DstOutputFileTypeData%UnSum = SrcOutputFileTypeData%UnSum - DstOutputFileTypeData%UnGra = SrcOutputFileTypeData%UnGra - DstOutputFileTypeData%FileDescLines = SrcOutputFileTypeData%FileDescLines -IF (ALLOCATED(SrcOutputFileTypeData%ChannelNames)) THEN - i1_l = LBOUND(SrcOutputFileTypeData%ChannelNames,1) - i1_u = UBOUND(SrcOutputFileTypeData%ChannelNames,1) - IF (.NOT. ALLOCATED(DstOutputFileTypeData%ChannelNames)) THEN - ALLOCATE(DstOutputFileTypeData%ChannelNames(i1_l:i1_u),STAT=ErrStat2) + CALL HydroDyn_CopyOutput( SrcHydroDyn_DataData%y_interp, DstHydroDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcHydroDyn_DataData%Input)) THEN + i1_l = LBOUND(SrcHydroDyn_DataData%Input,1) + i1_u = UBOUND(SrcHydroDyn_DataData%Input,1) + IF (.NOT. ALLOCATED(DstHydroDyn_DataData%Input)) THEN + ALLOCATE(DstHydroDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%ChannelNames.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstOutputFileTypeData%ChannelNames = SrcOutputFileTypeData%ChannelNames + DO i1 = LBOUND(SrcHydroDyn_DataData%Input,1), UBOUND(SrcHydroDyn_DataData%Input,1) + CALL HydroDyn_CopyInput( SrcHydroDyn_DataData%Input(i1), DstHydroDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(SrcOutputFileTypeData%ChannelUnits)) THEN - i1_l = LBOUND(SrcOutputFileTypeData%ChannelUnits,1) - i1_u = UBOUND(SrcOutputFileTypeData%ChannelUnits,1) - IF (.NOT. ALLOCATED(DstOutputFileTypeData%ChannelUnits)) THEN - ALLOCATE(DstOutputFileTypeData%ChannelUnits(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcHydroDyn_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcHydroDyn_DataData%InputTimes,1) + i1_u = UBOUND(SrcHydroDyn_DataData%InputTimes,1) + IF (.NOT. ALLOCATED(DstHydroDyn_DataData%InputTimes)) THEN + ALLOCATE(DstHydroDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%ChannelUnits.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstOutputFileTypeData%ChannelUnits = SrcOutputFileTypeData%ChannelUnits + DstHydroDyn_DataData%InputTimes = SrcHydroDyn_DataData%InputTimes ENDIF - DO i1 = LBOUND(SrcOutputFileTypeData%Module_Ver,1), UBOUND(SrcOutputFileTypeData%Module_Ver,1) - CALL NWTC_Library_Copyprogdesc( SrcOutputFileTypeData%Module_Ver(i1), DstOutputFileTypeData%Module_Ver(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DstOutputFileTypeData%Module_Abrev = SrcOutputFileTypeData%Module_Abrev - DstOutputFileTypeData%WriteThisStep = SrcOutputFileTypeData%WriteThisStep - DstOutputFileTypeData%VTK_count = SrcOutputFileTypeData%VTK_count - DstOutputFileTypeData%VTK_LastWaveIndx = SrcOutputFileTypeData%VTK_LastWaveIndx - CALL FAST_Copylinfiletype( SrcOutputFileTypeData%Lin, DstOutputFileTypeData%Lin, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstOutputFileTypeData%ActualChanLen = SrcOutputFileTypeData%ActualChanLen - CALL FAST_Copylinstatesave( SrcOutputFileTypeData%op, DstOutputFileTypeData%op, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstOutputFileTypeData%DriverWriteOutput = SrcOutputFileTypeData%DriverWriteOutput - END SUBROUTINE FAST_CopyOutputFileType + END SUBROUTINE FAST_CopyHydroDyn_Data - SUBROUTINE FAST_DestroyOutputFileType( OutputFileTypeData, ErrStat, ErrMsg ) - TYPE(FAST_OutputFileType), INTENT(INOUT) :: OutputFileTypeData + SUBROUTINE FAST_DestroyHydroDyn_Data( HydroDyn_DataData, ErrStat, ErrMsg ) + TYPE(HydroDyn_Data), INTENT(INOUT) :: HydroDyn_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyOutputFileType' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyHydroDyn_Data' ErrStat = ErrID_None ErrMsg = "" -IF (ALLOCATED(OutputFileTypeData%TimeData)) THEN - DEALLOCATE(OutputFileTypeData%TimeData) -ENDIF -IF (ALLOCATED(OutputFileTypeData%AllOutData)) THEN - DEALLOCATE(OutputFileTypeData%AllOutData) -ENDIF -IF (ALLOCATED(OutputFileTypeData%ChannelNames)) THEN - DEALLOCATE(OutputFileTypeData%ChannelNames) -ENDIF -IF (ALLOCATED(OutputFileTypeData%ChannelUnits)) THEN - DEALLOCATE(OutputFileTypeData%ChannelUnits) -ENDIF -DO i1 = LBOUND(OutputFileTypeData%Module_Ver,1), UBOUND(OutputFileTypeData%Module_Ver,1) - CALL NWTC_Library_DestroyProgDesc( OutputFileTypeData%Module_Ver(i1), ErrStat2, ErrMsg2 ) +DO i1 = LBOUND(HydroDyn_DataData%x,1), UBOUND(HydroDyn_DataData%x,1) + CALL HydroDyn_DestroyContState( HydroDyn_DataData%x(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO - CALL FAST_DestroyLinFileType( OutputFileTypeData%Lin, ErrStat2, ErrMsg2 ) +DO i1 = LBOUND(HydroDyn_DataData%xd,1), UBOUND(HydroDyn_DataData%xd,1) + CALL HydroDyn_DestroyDiscState( HydroDyn_DataData%xd(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroyLinStateSave( OutputFileTypeData%op, ErrStat2, ErrMsg2 ) +ENDDO +DO i1 = LBOUND(HydroDyn_DataData%z,1), UBOUND(HydroDyn_DataData%z,1) + CALL HydroDyn_DestroyConstrState( HydroDyn_DataData%z(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE FAST_DestroyOutputFileType - - SUBROUTINE FAST_PackOutputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FAST_OutputFileType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackOutputFileType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! TimeData allocated yes/no - IF ( ALLOCATED(InData%TimeData) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TimeData upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%TimeData) ! TimeData - END IF - Int_BufSz = Int_BufSz + 1 ! AllOutData allocated yes/no - IF ( ALLOCATED(InData%AllOutData) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AllOutData upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AllOutData) ! AllOutData - END IF - Int_BufSz = Int_BufSz + 1 ! n_Out - Int_BufSz = Int_BufSz + 1 ! NOutSteps - Int_BufSz = Int_BufSz + SIZE(InData%numOuts) ! numOuts - Int_BufSz = Int_BufSz + 1 ! UnOu - Int_BufSz = Int_BufSz + 1 ! UnSum - Int_BufSz = Int_BufSz + 1 ! UnGra - Int_BufSz = Int_BufSz + SIZE(InData%FileDescLines)*LEN(InData%FileDescLines) ! FileDescLines - Int_BufSz = Int_BufSz + 1 ! ChannelNames allocated yes/no - IF ( ALLOCATED(InData%ChannelNames) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ChannelNames upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ChannelNames)*LEN(InData%ChannelNames) ! ChannelNames - END IF - Int_BufSz = Int_BufSz + 1 ! ChannelUnits allocated yes/no - IF ( ALLOCATED(InData%ChannelUnits) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ChannelUnits upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ChannelUnits)*LEN(InData%ChannelUnits) ! ChannelUnits - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%Module_Ver,1), UBOUND(InData%Module_Ver,1) - Int_BufSz = Int_BufSz + 3 ! Module_Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Module_Ver(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Module_Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Module_Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Module_Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Module_Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + SIZE(InData%Module_Abrev)*LEN(InData%Module_Abrev) ! Module_Abrev - Int_BufSz = Int_BufSz + 1 ! WriteThisStep - Int_BufSz = Int_BufSz + 1 ! VTK_count - Int_BufSz = Int_BufSz + 1 ! VTK_LastWaveIndx - Int_BufSz = Int_BufSz + 3 ! Lin: size of buffers for each call to pack subtype - CALL FAST_PackLinFileType( Re_Buf, Db_Buf, Int_Buf, InData%Lin, ErrStat2, ErrMsg2, .TRUE. ) ! Lin - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Lin - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Lin - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Lin - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! ActualChanLen - Int_BufSz = Int_BufSz + 3 ! op: size of buffers for each call to pack subtype - CALL FAST_PackLinStateSave( Re_Buf, Db_Buf, Int_Buf, InData%op, ErrStat2, ErrMsg2, .TRUE. ) ! op - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! op - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! op - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! op - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Re_BufSz = Re_BufSz + SIZE(InData%DriverWriteOutput) ! DriverWriteOutput - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%TimeData) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TimeData,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TimeData,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TimeData,1), UBOUND(InData%TimeData,1) - DbKiBuf(Db_Xferred) = InData%TimeData(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AllOutData) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AllOutData,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOutData,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AllOutData,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOutData,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AllOutData,2), UBOUND(InData%AllOutData,2) - DO i1 = LBOUND(InData%AllOutData,1), UBOUND(InData%AllOutData,1) - ReKiBuf(Re_Xferred) = InData%AllOutData(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%n_Out - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NOutSteps - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%numOuts,1), UBOUND(InData%numOuts,1) - IntKiBuf(Int_Xferred) = InData%numOuts(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%UnOu - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UnSum - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UnGra - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%FileDescLines,1), UBOUND(InData%FileDescLines,1) - DO I = 1, LEN(InData%FileDescLines) - IntKiBuf(Int_Xferred) = ICHAR(InData%FileDescLines(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - IF ( .NOT. ALLOCATED(InData%ChannelNames) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ChannelNames,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChannelNames,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ChannelNames,1), UBOUND(InData%ChannelNames,1) - DO I = 1, LEN(InData%ChannelNames) - IntKiBuf(Int_Xferred) = ICHAR(InData%ChannelNames(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ChannelUnits) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ChannelUnits,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChannelUnits,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ChannelUnits,1), UBOUND(InData%ChannelUnits,1) - DO I = 1, LEN(InData%ChannelUnits) - IntKiBuf(Int_Xferred) = ICHAR(InData%ChannelUnits(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - DO i1 = LBOUND(InData%Module_Ver,1), UBOUND(InData%Module_Ver,1) - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Module_Ver(i1), ErrStat2, ErrMsg2, OnlySize ) ! Module_Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%Module_Abrev,1), UBOUND(InData%Module_Abrev,1) - DO I = 1, LEN(InData%Module_Abrev) - IntKiBuf(Int_Xferred) = ICHAR(InData%Module_Abrev(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - IntKiBuf(Int_Xferred) = TRANSFER(InData%WriteThisStep, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%VTK_count - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%VTK_LastWaveIndx - Int_Xferred = Int_Xferred + 1 - CALL FAST_PackLinFileType( Re_Buf, Db_Buf, Int_Buf, InData%Lin, ErrStat2, ErrMsg2, OnlySize ) ! Lin - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = InData%ActualChanLen - Int_Xferred = Int_Xferred + 1 - CALL FAST_PackLinStateSave( Re_Buf, Db_Buf, Int_Buf, InData%op, ErrStat2, ErrMsg2, OnlySize ) ! op - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - DO i1 = LBOUND(InData%DriverWriteOutput,1), UBOUND(InData%DriverWriteOutput,1) - ReKiBuf(Re_Xferred) = InData%DriverWriteOutput(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE FAST_PackOutputFileType - - SUBROUTINE FAST_UnPackOutputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FAST_OutputFileType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackOutputFileType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TimeData not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TimeData)) DEALLOCATE(OutData%TimeData) - ALLOCATE(OutData%TimeData(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TimeData.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TimeData,1), UBOUND(OutData%TimeData,1) - OutData%TimeData(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AllOutData not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AllOutData)) DEALLOCATE(OutData%AllOutData) - ALLOCATE(OutData%AllOutData(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOutData.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AllOutData,2), UBOUND(OutData%AllOutData,2) - DO i1 = LBOUND(OutData%AllOutData,1), UBOUND(OutData%AllOutData,1) - OutData%AllOutData(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%n_Out = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NOutSteps = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%numOuts,1) - i1_u = UBOUND(OutData%numOuts,1) - DO i1 = LBOUND(OutData%numOuts,1), UBOUND(OutData%numOuts,1) - OutData%numOuts(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%UnOu = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UnSum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UnGra = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%FileDescLines,1) - i1_u = UBOUND(OutData%FileDescLines,1) - DO i1 = LBOUND(OutData%FileDescLines,1), UBOUND(OutData%FileDescLines,1) - DO I = 1, LEN(OutData%FileDescLines) - OutData%FileDescLines(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ChannelNames not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ChannelNames)) DEALLOCATE(OutData%ChannelNames) - ALLOCATE(OutData%ChannelNames(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChannelNames.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ChannelNames,1), UBOUND(OutData%ChannelNames,1) - DO I = 1, LEN(OutData%ChannelNames) - OutData%ChannelNames(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ChannelUnits not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ChannelUnits)) DEALLOCATE(OutData%ChannelUnits) - ALLOCATE(OutData%ChannelUnits(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChannelUnits.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ChannelUnits,1), UBOUND(OutData%ChannelUnits,1) - DO I = 1, LEN(OutData%ChannelUnits) - OutData%ChannelUnits(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - i1_l = LBOUND(OutData%Module_Ver,1) - i1_u = UBOUND(OutData%Module_Ver,1) - DO i1 = LBOUND(OutData%Module_Ver,1), UBOUND(OutData%Module_Ver,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Module_Ver(i1), ErrStat2, ErrMsg2 ) ! Module_Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%Module_Abrev,1) - i1_u = UBOUND(OutData%Module_Abrev,1) - DO i1 = LBOUND(OutData%Module_Abrev,1), UBOUND(OutData%Module_Abrev,1) - DO I = 1, LEN(OutData%Module_Abrev) - OutData%Module_Abrev(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - OutData%WriteThisStep = TRANSFER(IntKiBuf(Int_Xferred), OutData%WriteThisStep) - Int_Xferred = Int_Xferred + 1 - OutData%VTK_count = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%VTK_LastWaveIndx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FAST_UnpackLinFileType( Re_Buf, Db_Buf, Int_Buf, OutData%Lin, ErrStat2, ErrMsg2 ) ! Lin - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%ActualChanLen = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FAST_UnpackLinStateSave( Re_Buf, Db_Buf, Int_Buf, OutData%op, ErrStat2, ErrMsg2 ) ! op - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN +ENDDO +DO i1 = LBOUND(HydroDyn_DataData%OtherSt,1), UBOUND(HydroDyn_DataData%OtherSt,1) + CALL HydroDyn_DestroyOtherState( HydroDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + CALL HydroDyn_DestroyParam( HydroDyn_DataData%p, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL HydroDyn_DestroyInput( HydroDyn_DataData%u, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL HydroDyn_DestroyOutput( HydroDyn_DataData%y, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL HydroDyn_DestroyMisc( HydroDyn_DataData%m, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(HydroDyn_DataData%Output)) THEN +DO i1 = LBOUND(HydroDyn_DataData%Output,1), UBOUND(HydroDyn_DataData%Output,1) + CALL HydroDyn_DestroyOutput( HydroDyn_DataData%Output(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(HydroDyn_DataData%Output) +ENDIF + CALL HydroDyn_DestroyOutput( HydroDyn_DataData%y_interp, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(HydroDyn_DataData%Input)) THEN +DO i1 = LBOUND(HydroDyn_DataData%Input,1), UBOUND(HydroDyn_DataData%Input,1) + CALL HydroDyn_DestroyInput( HydroDyn_DataData%Input(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(HydroDyn_DataData%Input) +ENDIF +IF (ALLOCATED(HydroDyn_DataData%InputTimes)) THEN + DEALLOCATE(HydroDyn_DataData%InputTimes) +ENDIF + END SUBROUTINE FAST_DestroyHydroDyn_Data - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - i1_l = LBOUND(OutData%DriverWriteOutput,1) - i1_u = UBOUND(OutData%DriverWriteOutput,1) - DO i1 = LBOUND(OutData%DriverWriteOutput,1), UBOUND(OutData%DriverWriteOutput,1) - OutData%DriverWriteOutput(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE FAST_UnPackOutputFileType - SUBROUTINE FAST_CopyIceDyn_Data( SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceDyn_Data), INTENT(INOUT) :: SrcIceDyn_DataData - TYPE(IceDyn_Data), INTENT(INOUT) :: DstIceDyn_DataData +subroutine FAST_PackHydroDyn_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackHydroDyn_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! x + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call HydroDyn_PackContState(Buf, InData%x(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! xd + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call HydroDyn_PackDiscState(Buf, InData%xd(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! z + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call HydroDyn_PackConstrState(Buf, InData%z(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! OtherSt + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call HydroDyn_PackOtherState(Buf, InData%OtherSt(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! p + call HydroDyn_PackParam(Buf, InData%p) + if (RegCheckErr(Buf, RoutineName)) return + ! u + call HydroDyn_PackInput(Buf, InData%u) + if (RegCheckErr(Buf, RoutineName)) return + ! y + call HydroDyn_PackOutput(Buf, InData%y) + if (RegCheckErr(Buf, RoutineName)) return + ! m + call HydroDyn_PackMisc(Buf, InData%m) + if (RegCheckErr(Buf, RoutineName)) return + ! Output + call RegPack(Buf, allocated(InData%Output)) + if (allocated(InData%Output)) then + call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) + LB(1:1) = lbound(InData%Output) + UB(1:1) = ubound(InData%Output) + do i1 = LB(1), UB(1) + call HydroDyn_PackOutput(Buf, InData%Output(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! y_interp + call HydroDyn_PackOutput(Buf, InData%y_interp) + if (RegCheckErr(Buf, RoutineName)) return + ! Input + call RegPack(Buf, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call HydroDyn_PackInput(Buf, InData%Input(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! InputTimes + call RegPack(Buf, allocated(InData%InputTimes)) + if (allocated(InData%InputTimes)) then + call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPack(Buf, InData%InputTimes) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackHydroDyn_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(HydroDyn_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackHydroDyn_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! x + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) + do i1 = LB(1), UB(1) + call HydroDyn_UnpackContState(Buf, OutData%x(i1)) ! x + end do + ! xd + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) + do i1 = LB(1), UB(1) + call HydroDyn_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + end do + ! z + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) + do i1 = LB(1), UB(1) + call HydroDyn_UnpackConstrState(Buf, OutData%z(i1)) ! z + end do + ! OtherSt + LB(1:1) = lbound(OutData%OtherSt) + UB(1:1) = ubound(OutData%OtherSt) + do i1 = LB(1), UB(1) + call HydroDyn_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + end do + ! p + call HydroDyn_UnpackParam(Buf, OutData%p) ! p + ! u + call HydroDyn_UnpackInput(Buf, OutData%u) ! u + ! y + call HydroDyn_UnpackOutput(Buf, OutData%y) ! y + ! m + call HydroDyn_UnpackMisc(Buf, OutData%m) ! m + ! Output + if (allocated(OutData%Output)) deallocate(OutData%Output) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Output(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call HydroDyn_UnpackOutput(Buf, OutData%Output(i1)) ! Output + end do + end if + ! y_interp + call HydroDyn_UnpackOutput(Buf, OutData%y_interp) ! y_interp + ! Input + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call HydroDyn_UnpackInput(Buf, OutData%Input(i1)) ! Input + end do + end if + ! InputTimes + if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InputTimes) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + SUBROUTINE FAST_CopyIceFloe_Data( SrcIceFloe_DataData, DstIceFloe_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(IceFloe_Data), INTENT(INOUT) :: SrcIceFloe_DataData + TYPE(IceFloe_Data), INTENT(INOUT) :: DstIceFloe_DataData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local INTEGER(IntKi) :: i,j,k INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyIceDyn_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyIceFloe_Data' ! ErrStat = ErrID_None ErrMsg = "" -IF (ALLOCATED(SrcIceDyn_DataData%x)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%x,1) - i1_u = UBOUND(SrcIceDyn_DataData%x,1) - i2_l = LBOUND(SrcIceDyn_DataData%x,2) - i2_u = UBOUND(SrcIceDyn_DataData%x,2) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%x)) THEN - ALLOCATE(DstIceDyn_DataData%x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcIceDyn_DataData%x,2), UBOUND(SrcIceDyn_DataData%x,2) - DO i1 = LBOUND(SrcIceDyn_DataData%x,1), UBOUND(SrcIceDyn_DataData%x,1) - CALL IceD_CopyContState( SrcIceDyn_DataData%x(i1,i2), DstIceDyn_DataData%x(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcIceFloe_DataData%x,1), UBOUND(SrcIceFloe_DataData%x,1) + CALL IceFloe_CopyContState( SrcIceFloe_DataData%x(i1), DstIceFloe_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%xd)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%xd,1) - i1_u = UBOUND(SrcIceDyn_DataData%xd,1) - i2_l = LBOUND(SrcIceDyn_DataData%xd,2) - i2_u = UBOUND(SrcIceDyn_DataData%xd,2) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%xd)) THEN - ALLOCATE(DstIceDyn_DataData%xd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcIceDyn_DataData%xd,2), UBOUND(SrcIceDyn_DataData%xd,2) - DO i1 = LBOUND(SrcIceDyn_DataData%xd,1), UBOUND(SrcIceDyn_DataData%xd,1) - CALL IceD_CopyDiscState( SrcIceDyn_DataData%xd(i1,i2), DstIceDyn_DataData%xd(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcIceFloe_DataData%xd,1), UBOUND(SrcIceFloe_DataData%xd,1) + CALL IceFloe_CopyDiscState( SrcIceFloe_DataData%xd(i1), DstIceFloe_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%z)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%z,1) - i1_u = UBOUND(SrcIceDyn_DataData%z,1) - i2_l = LBOUND(SrcIceDyn_DataData%z,2) - i2_u = UBOUND(SrcIceDyn_DataData%z,2) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%z)) THEN - ALLOCATE(DstIceDyn_DataData%z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcIceDyn_DataData%z,2), UBOUND(SrcIceDyn_DataData%z,2) - DO i1 = LBOUND(SrcIceDyn_DataData%z,1), UBOUND(SrcIceDyn_DataData%z,1) - CALL IceD_CopyConstrState( SrcIceDyn_DataData%z(i1,i2), DstIceDyn_DataData%z(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcIceFloe_DataData%z,1), UBOUND(SrcIceFloe_DataData%z,1) + CALL IceFloe_CopyConstrState( SrcIceFloe_DataData%z(i1), DstIceFloe_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%OtherSt)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%OtherSt,1) - i1_u = UBOUND(SrcIceDyn_DataData%OtherSt,1) - i2_l = LBOUND(SrcIceDyn_DataData%OtherSt,2) - i2_u = UBOUND(SrcIceDyn_DataData%OtherSt,2) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%OtherSt)) THEN - ALLOCATE(DstIceDyn_DataData%OtherSt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%OtherSt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcIceDyn_DataData%OtherSt,2), UBOUND(SrcIceDyn_DataData%OtherSt,2) - DO i1 = LBOUND(SrcIceDyn_DataData%OtherSt,1), UBOUND(SrcIceDyn_DataData%OtherSt,1) - CALL IceD_CopyOtherState( SrcIceDyn_DataData%OtherSt(i1,i2), DstIceDyn_DataData%OtherSt(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcIceFloe_DataData%OtherSt,1), UBOUND(SrcIceFloe_DataData%OtherSt,1) + CALL IceFloe_CopyOtherState( SrcIceFloe_DataData%OtherSt(i1), DstIceFloe_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%p)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%p,1) - i1_u = UBOUND(SrcIceDyn_DataData%p,1) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%p)) THEN - ALLOCATE(DstIceDyn_DataData%p(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%p.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcIceDyn_DataData%p,1), UBOUND(SrcIceDyn_DataData%p,1) - CALL IceD_CopyParam( SrcIceDyn_DataData%p(i1), DstIceDyn_DataData%p(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL IceFloe_CopyParam( SrcIceFloe_DataData%p, DstIceFloe_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%u)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%u,1) - i1_u = UBOUND(SrcIceDyn_DataData%u,1) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%u)) THEN - ALLOCATE(DstIceDyn_DataData%u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcIceDyn_DataData%u,1), UBOUND(SrcIceDyn_DataData%u,1) - CALL IceD_CopyInput( SrcIceDyn_DataData%u(i1), DstIceDyn_DataData%u(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL IceFloe_CopyInput( SrcIceFloe_DataData%u, DstIceFloe_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%y)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%y,1) - i1_u = UBOUND(SrcIceDyn_DataData%y,1) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%y)) THEN - ALLOCATE(DstIceDyn_DataData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcIceDyn_DataData%y,1), UBOUND(SrcIceDyn_DataData%y,1) - CALL IceD_CopyOutput( SrcIceDyn_DataData%y(i1), DstIceDyn_DataData%y(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL IceFloe_CopyOutput( SrcIceFloe_DataData%y, DstIceFloe_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%m)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%m,1) - i1_u = UBOUND(SrcIceDyn_DataData%m,1) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%m)) THEN - ALLOCATE(DstIceDyn_DataData%m(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%m.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcIceDyn_DataData%m,1), UBOUND(SrcIceDyn_DataData%m,1) - CALL IceD_CopyMisc( SrcIceDyn_DataData%m(i1), DstIceDyn_DataData%m(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL IceFloe_CopyMisc( SrcIceFloe_DataData%m, DstIceFloe_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%Input,1) - i1_u = UBOUND(SrcIceDyn_DataData%Input,1) - i2_l = LBOUND(SrcIceDyn_DataData%Input,2) - i2_u = UBOUND(SrcIceDyn_DataData%Input,2) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%Input)) THEN - ALLOCATE(DstIceDyn_DataData%Input(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) +IF (ALLOCATED(SrcIceFloe_DataData%Input)) THEN + i1_l = LBOUND(SrcIceFloe_DataData%Input,1) + i1_u = UBOUND(SrcIceFloe_DataData%Input,1) + IF (.NOT. ALLOCATED(DstIceFloe_DataData%Input)) THEN + ALLOCATE(DstIceFloe_DataData%Input(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceFloe_DataData%Input.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i2 = LBOUND(SrcIceDyn_DataData%Input,2), UBOUND(SrcIceDyn_DataData%Input,2) - DO i1 = LBOUND(SrcIceDyn_DataData%Input,1), UBOUND(SrcIceDyn_DataData%Input,1) - CALL IceD_CopyInput( SrcIceDyn_DataData%Input(i1,i2), DstIceDyn_DataData%Input(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcIceFloe_DataData%Input,1), UBOUND(SrcIceFloe_DataData%Input,1) + CALL IceFloe_CopyInput( SrcIceFloe_DataData%Input(i1), DstIceFloe_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - ENDDO ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcIceDyn_DataData%InputTimes,1) - i2_l = LBOUND(SrcIceDyn_DataData%InputTimes,2) - i2_u = UBOUND(SrcIceDyn_DataData%InputTimes,2) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%InputTimes)) THEN - ALLOCATE(DstIceDyn_DataData%InputTimes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) +IF (ALLOCATED(SrcIceFloe_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcIceFloe_DataData%InputTimes,1) + i1_u = UBOUND(SrcIceFloe_DataData%InputTimes,1) + IF (.NOT. ALLOCATED(DstIceFloe_DataData%InputTimes)) THEN + ALLOCATE(DstIceFloe_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceFloe_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstIceDyn_DataData%InputTimes = SrcIceDyn_DataData%InputTimes + DstIceFloe_DataData%InputTimes = SrcIceFloe_DataData%InputTimes ENDIF - END SUBROUTINE FAST_CopyIceDyn_Data + END SUBROUTINE FAST_CopyIceFloe_Data - SUBROUTINE FAST_DestroyIceDyn_Data( IceDyn_DataData, ErrStat, ErrMsg ) - TYPE(IceDyn_Data), INTENT(INOUT) :: IceDyn_DataData + SUBROUTINE FAST_DestroyIceFloe_Data( IceFloe_DataData, ErrStat, ErrMsg ) + TYPE(IceFloe_Data), INTENT(INOUT) :: IceFloe_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyIceDyn_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyIceFloe_Data' ErrStat = ErrID_None ErrMsg = "" -IF (ALLOCATED(IceDyn_DataData%x)) THEN -DO i2 = LBOUND(IceDyn_DataData%x,2), UBOUND(IceDyn_DataData%x,2) -DO i1 = LBOUND(IceDyn_DataData%x,1), UBOUND(IceDyn_DataData%x,1) - CALL IceD_DestroyContState( IceDyn_DataData%x(i1,i2), ErrStat2, ErrMsg2 ) +DO i1 = LBOUND(IceFloe_DataData%x,1), UBOUND(IceFloe_DataData%x,1) + CALL IceFloe_DestroyContState( IceFloe_DataData%x(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO -ENDDO - DEALLOCATE(IceDyn_DataData%x) -ENDIF -IF (ALLOCATED(IceDyn_DataData%xd)) THEN -DO i2 = LBOUND(IceDyn_DataData%xd,2), UBOUND(IceDyn_DataData%xd,2) -DO i1 = LBOUND(IceDyn_DataData%xd,1), UBOUND(IceDyn_DataData%xd,1) - CALL IceD_DestroyDiscState( IceDyn_DataData%xd(i1,i2), ErrStat2, ErrMsg2 ) +DO i1 = LBOUND(IceFloe_DataData%xd,1), UBOUND(IceFloe_DataData%xd,1) + CALL IceFloe_DestroyDiscState( IceFloe_DataData%xd(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO -ENDDO - DEALLOCATE(IceDyn_DataData%xd) -ENDIF -IF (ALLOCATED(IceDyn_DataData%z)) THEN -DO i2 = LBOUND(IceDyn_DataData%z,2), UBOUND(IceDyn_DataData%z,2) -DO i1 = LBOUND(IceDyn_DataData%z,1), UBOUND(IceDyn_DataData%z,1) - CALL IceD_DestroyConstrState( IceDyn_DataData%z(i1,i2), ErrStat2, ErrMsg2 ) +DO i1 = LBOUND(IceFloe_DataData%z,1), UBOUND(IceFloe_DataData%z,1) + CALL IceFloe_DestroyConstrState( IceFloe_DataData%z(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO -ENDDO - DEALLOCATE(IceDyn_DataData%z) -ENDIF -IF (ALLOCATED(IceDyn_DataData%OtherSt)) THEN -DO i2 = LBOUND(IceDyn_DataData%OtherSt,2), UBOUND(IceDyn_DataData%OtherSt,2) -DO i1 = LBOUND(IceDyn_DataData%OtherSt,1), UBOUND(IceDyn_DataData%OtherSt,1) - CALL IceD_DestroyOtherState( IceDyn_DataData%OtherSt(i1,i2), ErrStat2, ErrMsg2 ) +DO i1 = LBOUND(IceFloe_DataData%OtherSt,1), UBOUND(IceFloe_DataData%OtherSt,1) + CALL IceFloe_DestroyOtherState( IceFloe_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO -ENDDO - DEALLOCATE(IceDyn_DataData%OtherSt) -ENDIF -IF (ALLOCATED(IceDyn_DataData%p)) THEN -DO i1 = LBOUND(IceDyn_DataData%p,1), UBOUND(IceDyn_DataData%p,1) - CALL IceD_DestroyParam( IceDyn_DataData%p(i1), ErrStat2, ErrMsg2 ) + CALL IceFloe_DestroyParam( IceFloe_DataData%p, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(IceDyn_DataData%p) -ENDIF -IF (ALLOCATED(IceDyn_DataData%u)) THEN -DO i1 = LBOUND(IceDyn_DataData%u,1), UBOUND(IceDyn_DataData%u,1) - CALL IceD_DestroyInput( IceDyn_DataData%u(i1), ErrStat2, ErrMsg2 ) + CALL IceFloe_DestroyInput( IceFloe_DataData%u, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(IceDyn_DataData%u) -ENDIF -IF (ALLOCATED(IceDyn_DataData%y)) THEN -DO i1 = LBOUND(IceDyn_DataData%y,1), UBOUND(IceDyn_DataData%y,1) - CALL IceD_DestroyOutput( IceDyn_DataData%y(i1), ErrStat2, ErrMsg2 ) + CALL IceFloe_DestroyOutput( IceFloe_DataData%y, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(IceDyn_DataData%y) -ENDIF -IF (ALLOCATED(IceDyn_DataData%m)) THEN -DO i1 = LBOUND(IceDyn_DataData%m,1), UBOUND(IceDyn_DataData%m,1) - CALL IceD_DestroyMisc( IceDyn_DataData%m(i1), ErrStat2, ErrMsg2 ) + CALL IceFloe_DestroyMisc( IceFloe_DataData%m, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(IceDyn_DataData%m) -ENDIF -IF (ALLOCATED(IceDyn_DataData%Input)) THEN -DO i2 = LBOUND(IceDyn_DataData%Input,2), UBOUND(IceDyn_DataData%Input,2) -DO i1 = LBOUND(IceDyn_DataData%Input,1), UBOUND(IceDyn_DataData%Input,1) - CALL IceD_DestroyInput( IceDyn_DataData%Input(i1,i2), ErrStat2, ErrMsg2 ) +IF (ALLOCATED(IceFloe_DataData%Input)) THEN +DO i1 = LBOUND(IceFloe_DataData%Input,1), UBOUND(IceFloe_DataData%Input,1) + CALL IceFloe_DestroyInput( IceFloe_DataData%Input(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO -ENDDO - DEALLOCATE(IceDyn_DataData%Input) + DEALLOCATE(IceFloe_DataData%Input) ENDIF -IF (ALLOCATED(IceDyn_DataData%InputTimes)) THEN - DEALLOCATE(IceDyn_DataData%InputTimes) +IF (ALLOCATED(IceFloe_DataData%InputTimes)) THEN + DEALLOCATE(IceFloe_DataData%InputTimes) ENDIF - END SUBROUTINE FAST_DestroyIceDyn_Data - - SUBROUTINE FAST_PackIceDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(IceDyn_Data), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackIceDyn_Data' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! x allocated yes/no - IF ( ALLOCATED(InData%x) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! x upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i2 = LBOUND(InData%x,2), UBOUND(InData%x,2) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL IceD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! xd allocated yes/no - IF ( ALLOCATED(InData%xd) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! xd upper/lower bounds for each dimension - DO i2 = LBOUND(InData%xd,2), UBOUND(InData%xd,2) - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL IceD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + END SUBROUTINE FAST_DestroyIceFloe_Data - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! z allocated yes/no - IF ( ALLOCATED(InData%z) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! z upper/lower bounds for each dimension - DO i2 = LBOUND(InData%z,2), UBOUND(InData%z,2) - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL IceD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OtherSt allocated yes/no - IF ( ALLOCATED(InData%OtherSt) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OtherSt upper/lower bounds for each dimension - DO i2 = LBOUND(InData%OtherSt,2), UBOUND(InData%OtherSt,2) - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL IceD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! p allocated yes/no - IF ( ALLOCATED(InData%p) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! p upper/lower bounds for each dimension - DO i1 = LBOUND(InData%p,1), UBOUND(InData%p,1) - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL IceD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p(i1), ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u allocated yes/no - IF ( ALLOCATED(InData%u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u,1), UBOUND(InData%u,1) - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL IceD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! y allocated yes/no - IF ( ALLOCATED(InData%y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y upper/lower bounds for each dimension - DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL IceD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y(i1), ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! m allocated yes/no - IF ( ALLOCATED(InData%m) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! m upper/lower bounds for each dimension - DO i1 = LBOUND(InData%m,1), UBOUND(InData%m,1) - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL IceD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m(i1), ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Input upper/lower bounds for each dimension - DO i2 = LBOUND(InData%Input,2), UBOUND(InData%Input,2) - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL IceD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%x,2), UBOUND(InData%x,2) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL IceD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%xd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%xd,2), UBOUND(InData%xd,2) - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL IceD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%z) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%z,2), UBOUND(InData%z,2) - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL IceD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OtherSt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OtherSt,2), UBOUND(InData%OtherSt,2) - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL IceD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%p) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%p,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%p,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%p,1), UBOUND(InData%p,1) - CALL IceD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p(i1), ErrStat2, ErrMsg2, OnlySize ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u,1), UBOUND(InData%u,1) - CALL IceD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u(i1), ErrStat2, ErrMsg2, OnlySize ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) - CALL IceD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y(i1), ErrStat2, ErrMsg2, OnlySize ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%m) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%m,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%m,1), UBOUND(InData%m,1) - CALL IceD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m(i1), ErrStat2, ErrMsg2, OnlySize ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Input) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Input,2), UBOUND(InData%Input,2) - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL IceD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%InputTimes,2), UBOUND(InData%InputTimes,2) - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE FAST_PackIceDyn_Data - - SUBROUTINE FAST_UnPackIceDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(IceDyn_Data), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackIceDyn_Data' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%x)) DEALLOCATE(OutData%x) - ALLOCATE(OutData%x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%x,2), UBOUND(OutData%x,2) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1,i2), ErrStat2, ErrMsg2 ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%xd)) DEALLOCATE(OutData%xd) - ALLOCATE(OutData%xd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%xd,2), UBOUND(OutData%xd,2) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1,i2), ErrStat2, ErrMsg2 ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%z)) DEALLOCATE(OutData%z) - ALLOCATE(OutData%z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%z,2), UBOUND(OutData%z,2) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1,i2), ErrStat2, ErrMsg2 ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OtherSt)) DEALLOCATE(OutData%OtherSt) - ALLOCATE(OutData%OtherSt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OtherSt,2), UBOUND(OutData%OtherSt,2) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1,i2), ErrStat2, ErrMsg2 ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! p not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%p)) DEALLOCATE(OutData%p) - ALLOCATE(OutData%p(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%p.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%p,1), UBOUND(OutData%p,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p(i1), ErrStat2, ErrMsg2 ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%u)) DEALLOCATE(OutData%u) - ALLOCATE(OutData%u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u,1), UBOUND(OutData%u,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u(i1), ErrStat2, ErrMsg2 ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%y)) DEALLOCATE(OutData%y) - ALLOCATE(OutData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y(i1), ErrStat2, ErrMsg2 ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! m not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%m)) DEALLOCATE(OutData%m) - ALLOCATE(OutData%m(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%m.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%m,1), UBOUND(OutData%m,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m(i1), ErrStat2, ErrMsg2 ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Input,2), UBOUND(OutData%Input,2) - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1,i2), ErrStat2, ErrMsg2 ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%InputTimes,2), UBOUND(OutData%InputTimes,2) - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE FAST_UnPackIceDyn_Data - - SUBROUTINE FAST_CopyBeamDyn_Data( SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BeamDyn_Data), INTENT(INOUT) :: SrcBeamDyn_DataData - TYPE(BeamDyn_Data), INTENT(INOUT) :: DstBeamDyn_DataData +subroutine FAST_PackIceFloe_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IceFloe_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackIceFloe_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! x + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call IceFloe_PackContState(Buf, InData%x(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! xd + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call IceFloe_PackDiscState(Buf, InData%xd(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! z + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call IceFloe_PackConstrState(Buf, InData%z(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! OtherSt + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call IceFloe_PackOtherState(Buf, InData%OtherSt(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! p + call IceFloe_PackParam(Buf, InData%p) + if (RegCheckErr(Buf, RoutineName)) return + ! u + call IceFloe_PackInput(Buf, InData%u) + if (RegCheckErr(Buf, RoutineName)) return + ! y + call IceFloe_PackOutput(Buf, InData%y) + if (RegCheckErr(Buf, RoutineName)) return + ! m + call IceFloe_PackMisc(Buf, InData%m) + if (RegCheckErr(Buf, RoutineName)) return + ! Input + call RegPack(Buf, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call IceFloe_PackInput(Buf, InData%Input(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! InputTimes + call RegPack(Buf, allocated(InData%InputTimes)) + if (allocated(InData%InputTimes)) then + call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPack(Buf, InData%InputTimes) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackIceFloe_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IceFloe_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackIceFloe_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! x + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) + do i1 = LB(1), UB(1) + call IceFloe_UnpackContState(Buf, OutData%x(i1)) ! x + end do + ! xd + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) + do i1 = LB(1), UB(1) + call IceFloe_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + end do + ! z + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) + do i1 = LB(1), UB(1) + call IceFloe_UnpackConstrState(Buf, OutData%z(i1)) ! z + end do + ! OtherSt + LB(1:1) = lbound(OutData%OtherSt) + UB(1:1) = ubound(OutData%OtherSt) + do i1 = LB(1), UB(1) + call IceFloe_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + end do + ! p + call IceFloe_UnpackParam(Buf, OutData%p) ! p + ! u + call IceFloe_UnpackInput(Buf, OutData%u) ! u + ! y + call IceFloe_UnpackOutput(Buf, OutData%y) ! y + ! m + call IceFloe_UnpackMisc(Buf, OutData%m) ! m + ! Input + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceFloe_UnpackInput(Buf, OutData%Input(i1)) ! Input + end do + end if + ! InputTimes + if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InputTimes) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + SUBROUTINE FAST_CopyMAP_Data( SrcMAP_DataData, DstMAP_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(MAP_Data), INTENT(INOUT) :: SrcMAP_DataData + TYPE(MAP_Data), INTENT(INOUT) :: DstMAP_DataData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local INTEGER(IntKi) :: i,j,k INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyBeamDyn_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyMAP_Data' ! ErrStat = ErrID_None ErrMsg = "" -IF (ALLOCATED(SrcBeamDyn_DataData%x)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%x,1) - i1_u = UBOUND(SrcBeamDyn_DataData%x,1) - i2_l = LBOUND(SrcBeamDyn_DataData%x,2) - i2_u = UBOUND(SrcBeamDyn_DataData%x,2) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%x)) THEN - ALLOCATE(DstBeamDyn_DataData%x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcBeamDyn_DataData%x,2), UBOUND(SrcBeamDyn_DataData%x,2) - DO i1 = LBOUND(SrcBeamDyn_DataData%x,1), UBOUND(SrcBeamDyn_DataData%x,1) - CALL BD_CopyContState( SrcBeamDyn_DataData%x(i1,i2), DstBeamDyn_DataData%x(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcMAP_DataData%x,1), UBOUND(SrcMAP_DataData%x,1) + CALL MAP_CopyContState( SrcMAP_DataData%x(i1), DstMAP_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%xd)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%xd,1) - i1_u = UBOUND(SrcBeamDyn_DataData%xd,1) - i2_l = LBOUND(SrcBeamDyn_DataData%xd,2) - i2_u = UBOUND(SrcBeamDyn_DataData%xd,2) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%xd)) THEN - ALLOCATE(DstBeamDyn_DataData%xd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcBeamDyn_DataData%xd,2), UBOUND(SrcBeamDyn_DataData%xd,2) - DO i1 = LBOUND(SrcBeamDyn_DataData%xd,1), UBOUND(SrcBeamDyn_DataData%xd,1) - CALL BD_CopyDiscState( SrcBeamDyn_DataData%xd(i1,i2), DstBeamDyn_DataData%xd(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcMAP_DataData%xd,1), UBOUND(SrcMAP_DataData%xd,1) + CALL MAP_CopyDiscState( SrcMAP_DataData%xd(i1), DstMAP_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%z)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%z,1) - i1_u = UBOUND(SrcBeamDyn_DataData%z,1) - i2_l = LBOUND(SrcBeamDyn_DataData%z,2) - i2_u = UBOUND(SrcBeamDyn_DataData%z,2) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%z)) THEN - ALLOCATE(DstBeamDyn_DataData%z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcBeamDyn_DataData%z,2), UBOUND(SrcBeamDyn_DataData%z,2) - DO i1 = LBOUND(SrcBeamDyn_DataData%z,1), UBOUND(SrcBeamDyn_DataData%z,1) - CALL BD_CopyConstrState( SrcBeamDyn_DataData%z(i1,i2), DstBeamDyn_DataData%z(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcMAP_DataData%z,1), UBOUND(SrcMAP_DataData%z,1) + CALL MAP_CopyConstrState( SrcMAP_DataData%z(i1), DstMAP_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%OtherSt)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%OtherSt,1) - i1_u = UBOUND(SrcBeamDyn_DataData%OtherSt,1) - i2_l = LBOUND(SrcBeamDyn_DataData%OtherSt,2) - i2_u = UBOUND(SrcBeamDyn_DataData%OtherSt,2) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%OtherSt)) THEN - ALLOCATE(DstBeamDyn_DataData%OtherSt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%OtherSt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcBeamDyn_DataData%OtherSt,2), UBOUND(SrcBeamDyn_DataData%OtherSt,2) - DO i1 = LBOUND(SrcBeamDyn_DataData%OtherSt,1), UBOUND(SrcBeamDyn_DataData%OtherSt,1) - CALL BD_CopyOtherState( SrcBeamDyn_DataData%OtherSt(i1,i2), DstBeamDyn_DataData%OtherSt(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + CALL MAP_CopyOtherState( SrcMAP_DataData%OtherSt, DstMAP_DataData%OtherSt, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%p)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%p,1) - i1_u = UBOUND(SrcBeamDyn_DataData%p,1) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%p)) THEN - ALLOCATE(DstBeamDyn_DataData%p(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%p.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcBeamDyn_DataData%p,1), UBOUND(SrcBeamDyn_DataData%p,1) - CALL BD_CopyParam( SrcBeamDyn_DataData%p(i1), DstBeamDyn_DataData%p(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL MAP_CopyParam( SrcMAP_DataData%p, DstMAP_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%u)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%u,1) - i1_u = UBOUND(SrcBeamDyn_DataData%u,1) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%u)) THEN - ALLOCATE(DstBeamDyn_DataData%u(i1_l:i1_u),STAT=ErrStat2) + CALL MAP_CopyInput( SrcMAP_DataData%u, DstMAP_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MAP_CopyOutput( SrcMAP_DataData%y, DstMAP_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MAP_CopyOtherState( SrcMAP_DataData%OtherSt_old, DstMAP_DataData%OtherSt_old, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcMAP_DataData%Output)) THEN + i1_l = LBOUND(SrcMAP_DataData%Output,1) + i1_u = UBOUND(SrcMAP_DataData%Output,1) + IF (.NOT. ALLOCATED(DstMAP_DataData%Output)) THEN + ALLOCATE(DstMAP_DataData%Output(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%u.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%Output.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcBeamDyn_DataData%u,1), UBOUND(SrcBeamDyn_DataData%u,1) - CALL BD_CopyInput( SrcBeamDyn_DataData%u(i1), DstBeamDyn_DataData%u(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcMAP_DataData%Output,1), UBOUND(SrcMAP_DataData%Output,1) + CALL MAP_CopyOutput( SrcMAP_DataData%Output(i1), DstMAP_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%y)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%y,1) - i1_u = UBOUND(SrcBeamDyn_DataData%y,1) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%y)) THEN - ALLOCATE(DstBeamDyn_DataData%y(i1_l:i1_u),STAT=ErrStat2) + CALL MAP_CopyOutput( SrcMAP_DataData%y_interp, DstMAP_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcMAP_DataData%Input)) THEN + i1_l = LBOUND(SrcMAP_DataData%Input,1) + i1_u = UBOUND(SrcMAP_DataData%Input,1) + IF (.NOT. ALLOCATED(DstMAP_DataData%Input)) THEN + ALLOCATE(DstMAP_DataData%Input(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%y.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%Input.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcBeamDyn_DataData%y,1), UBOUND(SrcBeamDyn_DataData%y,1) - CALL BD_CopyOutput( SrcBeamDyn_DataData%y(i1), DstBeamDyn_DataData%y(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcMAP_DataData%Input,1), UBOUND(SrcMAP_DataData%Input,1) + CALL MAP_CopyInput( SrcMAP_DataData%Input(i1), DstMAP_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%m)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%m,1) - i1_u = UBOUND(SrcBeamDyn_DataData%m,1) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%m)) THEN - ALLOCATE(DstBeamDyn_DataData%m(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcMAP_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcMAP_DataData%InputTimes,1) + i1_u = UBOUND(SrcMAP_DataData%InputTimes,1) + IF (.NOT. ALLOCATED(DstMAP_DataData%InputTimes)) THEN + ALLOCATE(DstMAP_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%m.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcBeamDyn_DataData%m,1), UBOUND(SrcBeamDyn_DataData%m,1) - CALL BD_CopyMisc( SrcBeamDyn_DataData%m(i1), DstBeamDyn_DataData%m(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO + DstMAP_DataData%InputTimes = SrcMAP_DataData%InputTimes ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%Output)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%Output,1) - i1_u = UBOUND(SrcBeamDyn_DataData%Output,1) - i2_l = LBOUND(SrcBeamDyn_DataData%Output,2) - i2_u = UBOUND(SrcBeamDyn_DataData%Output,2) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%Output)) THEN - ALLOCATE(DstBeamDyn_DataData%Output(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcBeamDyn_DataData%Output,2), UBOUND(SrcBeamDyn_DataData%Output,2) - DO i1 = LBOUND(SrcBeamDyn_DataData%Output,1), UBOUND(SrcBeamDyn_DataData%Output,1) - CALL BD_CopyOutput( SrcBeamDyn_DataData%Output(i1,i2), DstBeamDyn_DataData%Output(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + END SUBROUTINE FAST_CopyMAP_Data + + SUBROUTINE FAST_DestroyMAP_Data( MAP_DataData, ErrStat, ErrMsg ) + TYPE(MAP_Data), INTENT(INOUT) :: MAP_DataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyMAP_Data' + + ErrStat = ErrID_None + ErrMsg = "" + +DO i1 = LBOUND(MAP_DataData%x,1), UBOUND(MAP_DataData%x,1) + CALL MAP_DestroyContState( MAP_DataData%x(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +DO i1 = LBOUND(MAP_DataData%xd,1), UBOUND(MAP_DataData%xd,1) + CALL MAP_DestroyDiscState( MAP_DataData%xd(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +DO i1 = LBOUND(MAP_DataData%z,1), UBOUND(MAP_DataData%z,1) + CALL MAP_DestroyConstrState( MAP_DataData%z(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + CALL MAP_DestroyOtherState( MAP_DataData%OtherSt, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL MAP_DestroyParam( MAP_DataData%p, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL MAP_DestroyInput( MAP_DataData%u, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL MAP_DestroyOutput( MAP_DataData%y, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL MAP_DestroyOtherState( MAP_DataData%OtherSt_old, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(MAP_DataData%Output)) THEN +DO i1 = LBOUND(MAP_DataData%Output,1), UBOUND(MAP_DataData%Output,1) + CALL MAP_DestroyOutput( MAP_DataData%Output(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(MAP_DataData%Output) +ENDIF + CALL MAP_DestroyOutput( MAP_DataData%y_interp, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(MAP_DataData%Input)) THEN +DO i1 = LBOUND(MAP_DataData%Input,1), UBOUND(MAP_DataData%Input,1) + CALL MAP_DestroyInput( MAP_DataData%Input(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(MAP_DataData%Input) +ENDIF +IF (ALLOCATED(MAP_DataData%InputTimes)) THEN + DEALLOCATE(MAP_DataData%InputTimes) +ENDIF + END SUBROUTINE FAST_DestroyMAP_Data + + +subroutine FAST_PackMAP_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MAP_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackMAP_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! x + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call MAP_PackContState(Buf, InData%x(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! xd + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call MAP_PackDiscState(Buf, InData%xd(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! z + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call MAP_PackConstrState(Buf, InData%z(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! OtherSt + call MAP_PackOtherState(Buf, InData%OtherSt) + if (RegCheckErr(Buf, RoutineName)) return + ! p + call MAP_PackParam(Buf, InData%p) + if (RegCheckErr(Buf, RoutineName)) return + ! u + call MAP_PackInput(Buf, InData%u) + if (RegCheckErr(Buf, RoutineName)) return + ! y + call MAP_PackOutput(Buf, InData%y) + if (RegCheckErr(Buf, RoutineName)) return + ! OtherSt_old + call MAP_PackOtherState(Buf, InData%OtherSt_old) + if (RegCheckErr(Buf, RoutineName)) return + ! Output + call RegPack(Buf, allocated(InData%Output)) + if (allocated(InData%Output)) then + call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) + LB(1:1) = lbound(InData%Output) + UB(1:1) = ubound(InData%Output) + do i1 = LB(1), UB(1) + call MAP_PackOutput(Buf, InData%Output(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! y_interp + call MAP_PackOutput(Buf, InData%y_interp) + if (RegCheckErr(Buf, RoutineName)) return + ! Input + call RegPack(Buf, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call MAP_PackInput(Buf, InData%Input(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! InputTimes + call RegPack(Buf, allocated(InData%InputTimes)) + if (allocated(InData%InputTimes)) then + call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPack(Buf, InData%InputTimes) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackMAP_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MAP_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackMAP_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! x + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) + do i1 = LB(1), UB(1) + call MAP_UnpackContState(Buf, OutData%x(i1)) ! x + end do + ! xd + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) + do i1 = LB(1), UB(1) + call MAP_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + end do + ! z + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) + do i1 = LB(1), UB(1) + call MAP_UnpackConstrState(Buf, OutData%z(i1)) ! z + end do + ! OtherSt + call MAP_UnpackOtherState(Buf, OutData%OtherSt) ! OtherSt + ! p + call MAP_UnpackParam(Buf, OutData%p) ! p + ! u + call MAP_UnpackInput(Buf, OutData%u) ! u + ! y + call MAP_UnpackOutput(Buf, OutData%y) ! y + ! OtherSt_old + call MAP_UnpackOtherState(Buf, OutData%OtherSt_old) ! OtherSt_old + ! Output + if (allocated(OutData%Output)) deallocate(OutData%Output) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Output(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MAP_UnpackOutput(Buf, OutData%Output(i1)) ! Output + end do + end if + ! y_interp + call MAP_UnpackOutput(Buf, OutData%y_interp) ! y_interp + ! Input + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MAP_UnpackInput(Buf, OutData%Input(i1)) ! Input + end do + end if + ! InputTimes + if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InputTimes) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + SUBROUTINE FAST_CopyFEAMooring_Data( SrcFEAMooring_DataData, DstFEAMooring_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FEAMooring_Data), INTENT(INOUT) :: SrcFEAMooring_DataData + TYPE(FEAMooring_Data), INTENT(INOUT) :: DstFEAMooring_DataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyFEAMooring_Data' +! + ErrStat = ErrID_None + ErrMsg = "" + DO i1 = LBOUND(SrcFEAMooring_DataData%x,1), UBOUND(SrcFEAMooring_DataData%x,1) + CALL FEAM_CopyContState( SrcFEAMooring_DataData%x(i1), DstFEAMooring_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO + DO i1 = LBOUND(SrcFEAMooring_DataData%xd,1), UBOUND(SrcFEAMooring_DataData%xd,1) + CALL FEAM_CopyDiscState( SrcFEAMooring_DataData%xd(i1), DstFEAMooring_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%y_interp)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%y_interp,1) - i1_u = UBOUND(SrcBeamDyn_DataData%y_interp,1) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%y_interp)) THEN - ALLOCATE(DstBeamDyn_DataData%y_interp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%y_interp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcBeamDyn_DataData%y_interp,1), UBOUND(SrcBeamDyn_DataData%y_interp,1) - CALL BD_CopyOutput( SrcBeamDyn_DataData%y_interp(i1), DstBeamDyn_DataData%y_interp(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcFEAMooring_DataData%z,1), UBOUND(SrcFEAMooring_DataData%z,1) + CALL FEAM_CopyConstrState( SrcFEAMooring_DataData%z(i1), DstFEAMooring_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%Input,1) - i1_u = UBOUND(SrcBeamDyn_DataData%Input,1) - i2_l = LBOUND(SrcBeamDyn_DataData%Input,2) - i2_u = UBOUND(SrcBeamDyn_DataData%Input,2) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%Input)) THEN - ALLOCATE(DstBeamDyn_DataData%Input(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DO i1 = LBOUND(SrcFEAMooring_DataData%OtherSt,1), UBOUND(SrcFEAMooring_DataData%OtherSt,1) + CALL FEAM_CopyOtherState( SrcFEAMooring_DataData%OtherSt(i1), DstFEAMooring_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + CALL FEAM_CopyParam( SrcFEAMooring_DataData%p, DstFEAMooring_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL FEAM_CopyInput( SrcFEAMooring_DataData%u, DstFEAMooring_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL FEAM_CopyOutput( SrcFEAMooring_DataData%y, DstFEAMooring_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL FEAM_CopyMisc( SrcFEAMooring_DataData%m, DstFEAMooring_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcFEAMooring_DataData%Input)) THEN + i1_l = LBOUND(SrcFEAMooring_DataData%Input,1) + i1_u = UBOUND(SrcFEAMooring_DataData%Input,1) + IF (.NOT. ALLOCATED(DstFEAMooring_DataData%Input)) THEN + ALLOCATE(DstFEAMooring_DataData%Input(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFEAMooring_DataData%Input.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i2 = LBOUND(SrcBeamDyn_DataData%Input,2), UBOUND(SrcBeamDyn_DataData%Input,2) - DO i1 = LBOUND(SrcBeamDyn_DataData%Input,1), UBOUND(SrcBeamDyn_DataData%Input,1) - CALL BD_CopyInput( SrcBeamDyn_DataData%Input(i1,i2), DstBeamDyn_DataData%Input(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcFEAMooring_DataData%Input,1), UBOUND(SrcFEAMooring_DataData%Input,1) + CALL FEAM_CopyInput( SrcFEAMooring_DataData%Input(i1), DstFEAMooring_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - ENDDO ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcBeamDyn_DataData%InputTimes,1) - i2_l = LBOUND(SrcBeamDyn_DataData%InputTimes,2) - i2_u = UBOUND(SrcBeamDyn_DataData%InputTimes,2) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%InputTimes)) THEN - ALLOCATE(DstBeamDyn_DataData%InputTimes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) +IF (ALLOCATED(SrcFEAMooring_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcFEAMooring_DataData%InputTimes,1) + i1_u = UBOUND(SrcFEAMooring_DataData%InputTimes,1) + IF (.NOT. ALLOCATED(DstFEAMooring_DataData%InputTimes)) THEN + ALLOCATE(DstFEAMooring_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFEAMooring_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstBeamDyn_DataData%InputTimes = SrcBeamDyn_DataData%InputTimes + DstFEAMooring_DataData%InputTimes = SrcFEAMooring_DataData%InputTimes ENDIF - END SUBROUTINE FAST_CopyBeamDyn_Data + END SUBROUTINE FAST_CopyFEAMooring_Data - SUBROUTINE FAST_DestroyBeamDyn_Data( BeamDyn_DataData, ErrStat, ErrMsg ) - TYPE(BeamDyn_Data), INTENT(INOUT) :: BeamDyn_DataData + SUBROUTINE FAST_DestroyFEAMooring_Data( FEAMooring_DataData, ErrStat, ErrMsg ) + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAMooring_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyBeamDyn_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyFEAMooring_Data' ErrStat = ErrID_None ErrMsg = "" -IF (ALLOCATED(BeamDyn_DataData%x)) THEN -DO i2 = LBOUND(BeamDyn_DataData%x,2), UBOUND(BeamDyn_DataData%x,2) -DO i1 = LBOUND(BeamDyn_DataData%x,1), UBOUND(BeamDyn_DataData%x,1) - CALL BD_DestroyContState( BeamDyn_DataData%x(i1,i2), ErrStat2, ErrMsg2 ) +DO i1 = LBOUND(FEAMooring_DataData%x,1), UBOUND(FEAMooring_DataData%x,1) + CALL FEAM_DestroyContState( FEAMooring_DataData%x(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO -ENDDO - DEALLOCATE(BeamDyn_DataData%x) -ENDIF -IF (ALLOCATED(BeamDyn_DataData%xd)) THEN -DO i2 = LBOUND(BeamDyn_DataData%xd,2), UBOUND(BeamDyn_DataData%xd,2) -DO i1 = LBOUND(BeamDyn_DataData%xd,1), UBOUND(BeamDyn_DataData%xd,1) - CALL BD_DestroyDiscState( BeamDyn_DataData%xd(i1,i2), ErrStat2, ErrMsg2 ) +DO i1 = LBOUND(FEAMooring_DataData%xd,1), UBOUND(FEAMooring_DataData%xd,1) + CALL FEAM_DestroyDiscState( FEAMooring_DataData%xd(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO -ENDDO - DEALLOCATE(BeamDyn_DataData%xd) -ENDIF -IF (ALLOCATED(BeamDyn_DataData%z)) THEN -DO i2 = LBOUND(BeamDyn_DataData%z,2), UBOUND(BeamDyn_DataData%z,2) -DO i1 = LBOUND(BeamDyn_DataData%z,1), UBOUND(BeamDyn_DataData%z,1) - CALL BD_DestroyConstrState( BeamDyn_DataData%z(i1,i2), ErrStat2, ErrMsg2 ) +DO i1 = LBOUND(FEAMooring_DataData%z,1), UBOUND(FEAMooring_DataData%z,1) + CALL FEAM_DestroyConstrState( FEAMooring_DataData%z(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO -ENDDO - DEALLOCATE(BeamDyn_DataData%z) -ENDIF -IF (ALLOCATED(BeamDyn_DataData%OtherSt)) THEN -DO i2 = LBOUND(BeamDyn_DataData%OtherSt,2), UBOUND(BeamDyn_DataData%OtherSt,2) -DO i1 = LBOUND(BeamDyn_DataData%OtherSt,1), UBOUND(BeamDyn_DataData%OtherSt,1) - CALL BD_DestroyOtherState( BeamDyn_DataData%OtherSt(i1,i2), ErrStat2, ErrMsg2 ) +DO i1 = LBOUND(FEAMooring_DataData%OtherSt,1), UBOUND(FEAMooring_DataData%OtherSt,1) + CALL FEAM_DestroyOtherState( FEAMooring_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO -ENDDO - DEALLOCATE(BeamDyn_DataData%OtherSt) -ENDIF -IF (ALLOCATED(BeamDyn_DataData%p)) THEN -DO i1 = LBOUND(BeamDyn_DataData%p,1), UBOUND(BeamDyn_DataData%p,1) - CALL BD_DestroyParam( BeamDyn_DataData%p(i1), ErrStat2, ErrMsg2 ) + CALL FEAM_DestroyParam( FEAMooring_DataData%p, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(BeamDyn_DataData%p) -ENDIF -IF (ALLOCATED(BeamDyn_DataData%u)) THEN -DO i1 = LBOUND(BeamDyn_DataData%u,1), UBOUND(BeamDyn_DataData%u,1) - CALL BD_DestroyInput( BeamDyn_DataData%u(i1), ErrStat2, ErrMsg2 ) + CALL FEAM_DestroyInput( FEAMooring_DataData%u, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(BeamDyn_DataData%u) -ENDIF -IF (ALLOCATED(BeamDyn_DataData%y)) THEN -DO i1 = LBOUND(BeamDyn_DataData%y,1), UBOUND(BeamDyn_DataData%y,1) - CALL BD_DestroyOutput( BeamDyn_DataData%y(i1), ErrStat2, ErrMsg2 ) + CALL FEAM_DestroyOutput( FEAMooring_DataData%y, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(BeamDyn_DataData%y) -ENDIF -IF (ALLOCATED(BeamDyn_DataData%m)) THEN -DO i1 = LBOUND(BeamDyn_DataData%m,1), UBOUND(BeamDyn_DataData%m,1) - CALL BD_DestroyMisc( BeamDyn_DataData%m(i1), ErrStat2, ErrMsg2 ) + CALL FEAM_DestroyMisc( FEAMooring_DataData%m, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(BeamDyn_DataData%m) -ENDIF -IF (ALLOCATED(BeamDyn_DataData%Output)) THEN -DO i2 = LBOUND(BeamDyn_DataData%Output,2), UBOUND(BeamDyn_DataData%Output,2) -DO i1 = LBOUND(BeamDyn_DataData%Output,1), UBOUND(BeamDyn_DataData%Output,1) - CALL BD_DestroyOutput( BeamDyn_DataData%Output(i1,i2), ErrStat2, ErrMsg2 ) +IF (ALLOCATED(FEAMooring_DataData%Input)) THEN +DO i1 = LBOUND(FEAMooring_DataData%Input,1), UBOUND(FEAMooring_DataData%Input,1) + CALL FEAM_DestroyInput( FEAMooring_DataData%Input(i1), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO -ENDDO - DEALLOCATE(BeamDyn_DataData%Output) + DEALLOCATE(FEAMooring_DataData%Input) ENDIF -IF (ALLOCATED(BeamDyn_DataData%y_interp)) THEN -DO i1 = LBOUND(BeamDyn_DataData%y_interp,1), UBOUND(BeamDyn_DataData%y_interp,1) - CALL BD_DestroyOutput( BeamDyn_DataData%y_interp(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(BeamDyn_DataData%y_interp) +IF (ALLOCATED(FEAMooring_DataData%InputTimes)) THEN + DEALLOCATE(FEAMooring_DataData%InputTimes) ENDIF -IF (ALLOCATED(BeamDyn_DataData%Input)) THEN -DO i2 = LBOUND(BeamDyn_DataData%Input,2), UBOUND(BeamDyn_DataData%Input,2) -DO i1 = LBOUND(BeamDyn_DataData%Input,1), UBOUND(BeamDyn_DataData%Input,1) - CALL BD_DestroyInput( BeamDyn_DataData%Input(i1,i2), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(BeamDyn_DataData%Input) -ENDIF -IF (ALLOCATED(BeamDyn_DataData%InputTimes)) THEN - DEALLOCATE(BeamDyn_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyBeamDyn_Data - - SUBROUTINE FAST_PackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(BeamDyn_Data), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackBeamDyn_Data' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! x allocated yes/no - IF ( ALLOCATED(InData%x) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! x upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i2 = LBOUND(InData%x,2), UBOUND(InData%x,2) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL BD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! xd allocated yes/no - IF ( ALLOCATED(InData%xd) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! xd upper/lower bounds for each dimension - DO i2 = LBOUND(InData%xd,2), UBOUND(InData%xd,2) - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL BD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! z allocated yes/no - IF ( ALLOCATED(InData%z) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! z upper/lower bounds for each dimension - DO i2 = LBOUND(InData%z,2), UBOUND(InData%z,2) - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL BD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OtherSt allocated yes/no - IF ( ALLOCATED(InData%OtherSt) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OtherSt upper/lower bounds for each dimension - DO i2 = LBOUND(InData%OtherSt,2), UBOUND(InData%OtherSt,2) - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL BD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! p allocated yes/no - IF ( ALLOCATED(InData%p) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! p upper/lower bounds for each dimension - DO i1 = LBOUND(InData%p,1), UBOUND(InData%p,1) - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL BD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p(i1), ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u allocated yes/no - IF ( ALLOCATED(InData%u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u,1), UBOUND(InData%u,1) - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! y allocated yes/no - IF ( ALLOCATED(InData%y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y upper/lower bounds for each dimension - DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL BD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y(i1), ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! m allocated yes/no - IF ( ALLOCATED(InData%m) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! m upper/lower bounds for each dimension - DO i1 = LBOUND(InData%m,1), UBOUND(InData%m,1) - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL BD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m(i1), ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no - IF ( ALLOCATED(InData%Output) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Output upper/lower bounds for each dimension - DO i2 = LBOUND(InData%Output,2), UBOUND(InData%Output,2) - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype - CALL BD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Output - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Output - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Output - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! y_interp allocated yes/no - IF ( ALLOCATED(InData%y_interp) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y_interp upper/lower bounds for each dimension - DO i1 = LBOUND(InData%y_interp,1), UBOUND(InData%y_interp,1) - Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype - CALL BD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp(i1), ErrStat2, ErrMsg2, .TRUE. ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_interp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_interp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_interp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Input upper/lower bounds for each dimension - DO i2 = LBOUND(InData%Input,2), UBOUND(InData%Input,2) - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%x,2), UBOUND(InData%x,2) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL BD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%xd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%xd,2), UBOUND(InData%xd,2) - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL BD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%z) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%z,2), UBOUND(InData%z,2) - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL BD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OtherSt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%OtherSt,2), UBOUND(InData%OtherSt,2) - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL BD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%p) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%p,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%p,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%p,1), UBOUND(InData%p,1) - CALL BD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p(i1), ErrStat2, ErrMsg2, OnlySize ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u,1), UBOUND(InData%u,1) - CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u(i1), ErrStat2, ErrMsg2, OnlySize ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) - CALL BD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y(i1), ErrStat2, ErrMsg2, OnlySize ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%m) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%m,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%m,1), UBOUND(InData%m,1) - CALL BD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m(i1), ErrStat2, ErrMsg2, OnlySize ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Output) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Output,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Output,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Output,2), UBOUND(InData%Output,2) - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - CALL BD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%y_interp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%y_interp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y_interp,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y_interp,1), UBOUND(InData%y_interp,1) - CALL BD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp(i1), ErrStat2, ErrMsg2, OnlySize ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Input) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Input,2), UBOUND(InData%Input,2) - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%InputTimes,2), UBOUND(InData%InputTimes,2) - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE FAST_PackBeamDyn_Data - - SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(BeamDyn_Data), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackBeamDyn_Data' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%x)) DEALLOCATE(OutData%x) - ALLOCATE(OutData%x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%x,2), UBOUND(OutData%x,2) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL BD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1,i2), ErrStat2, ErrMsg2 ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%xd)) DEALLOCATE(OutData%xd) - ALLOCATE(OutData%xd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%xd,2), UBOUND(OutData%xd,2) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL BD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1,i2), ErrStat2, ErrMsg2 ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%z)) DEALLOCATE(OutData%z) - ALLOCATE(OutData%z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%z,2), UBOUND(OutData%z,2) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL BD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1,i2), ErrStat2, ErrMsg2 ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OtherSt)) DEALLOCATE(OutData%OtherSt) - ALLOCATE(OutData%OtherSt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OtherSt,2), UBOUND(OutData%OtherSt,2) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL BD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1,i2), ErrStat2, ErrMsg2 ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! p not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%p)) DEALLOCATE(OutData%p) - ALLOCATE(OutData%p(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%p.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%p,1), UBOUND(OutData%p,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL BD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p(i1), ErrStat2, ErrMsg2 ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%u)) DEALLOCATE(OutData%u) - ALLOCATE(OutData%u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u,1), UBOUND(OutData%u,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL BD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u(i1), ErrStat2, ErrMsg2 ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%y)) DEALLOCATE(OutData%y) - ALLOCATE(OutData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL BD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y(i1), ErrStat2, ErrMsg2 ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! m not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%m)) DEALLOCATE(OutData%m) - ALLOCATE(OutData%m(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%m.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%m,1), UBOUND(OutData%m,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL BD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m(i1), ErrStat2, ErrMsg2 ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Output not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Output)) DEALLOCATE(OutData%Output) - ALLOCATE(OutData%Output(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Output,2), UBOUND(OutData%Output,2) - DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL BD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1,i2), ErrStat2, ErrMsg2 ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y_interp not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%y_interp)) DEALLOCATE(OutData%y_interp) - ALLOCATE(OutData%y_interp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_interp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y_interp,1), UBOUND(OutData%y_interp,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL BD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp(i1), ErrStat2, ErrMsg2 ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Input,2), UBOUND(OutData%Input,2) - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL BD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1,i2), ErrStat2, ErrMsg2 ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + END SUBROUTINE FAST_DestroyFEAMooring_Data - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%InputTimes,2), UBOUND(OutData%InputTimes,2) - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE FAST_UnPackBeamDyn_Data - SUBROUTINE FAST_CopyElastoDyn_Data( SrcElastoDyn_DataData, DstElastoDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ElastoDyn_Data), INTENT(INOUT) :: SrcElastoDyn_DataData - TYPE(ElastoDyn_Data), INTENT(INOUT) :: DstElastoDyn_DataData +subroutine FAST_PackFEAMooring_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FEAMooring_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackFEAMooring_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! x + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call FEAM_PackContState(Buf, InData%x(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! xd + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call FEAM_PackDiscState(Buf, InData%xd(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! z + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call FEAM_PackConstrState(Buf, InData%z(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! OtherSt + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call FEAM_PackOtherState(Buf, InData%OtherSt(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! p + call FEAM_PackParam(Buf, InData%p) + if (RegCheckErr(Buf, RoutineName)) return + ! u + call FEAM_PackInput(Buf, InData%u) + if (RegCheckErr(Buf, RoutineName)) return + ! y + call FEAM_PackOutput(Buf, InData%y) + if (RegCheckErr(Buf, RoutineName)) return + ! m + call FEAM_PackMisc(Buf, InData%m) + if (RegCheckErr(Buf, RoutineName)) return + ! Input + call RegPack(Buf, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call FEAM_PackInput(Buf, InData%Input(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! InputTimes + call RegPack(Buf, allocated(InData%InputTimes)) + if (allocated(InData%InputTimes)) then + call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPack(Buf, InData%InputTimes) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackFEAMooring_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FEAMooring_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackFEAMooring_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! x + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) + do i1 = LB(1), UB(1) + call FEAM_UnpackContState(Buf, OutData%x(i1)) ! x + end do + ! xd + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) + do i1 = LB(1), UB(1) + call FEAM_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + end do + ! z + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) + do i1 = LB(1), UB(1) + call FEAM_UnpackConstrState(Buf, OutData%z(i1)) ! z + end do + ! OtherSt + LB(1:1) = lbound(OutData%OtherSt) + UB(1:1) = ubound(OutData%OtherSt) + do i1 = LB(1), UB(1) + call FEAM_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + end do + ! p + call FEAM_UnpackParam(Buf, OutData%p) ! p + ! u + call FEAM_UnpackInput(Buf, OutData%u) ! u + ! y + call FEAM_UnpackOutput(Buf, OutData%y) ! y + ! m + call FEAM_UnpackMisc(Buf, OutData%m) ! m + ! Input + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FEAM_UnpackInput(Buf, OutData%Input(i1)) ! Input + end do + end if + ! InputTimes + if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InputTimes) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + SUBROUTINE FAST_CopyMoorDyn_Data( SrcMoorDyn_DataData, DstMoorDyn_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(MoorDyn_Data), INTENT(INOUT) :: SrcMoorDyn_DataData + TYPE(MoorDyn_Data), INTENT(INOUT) :: DstMoorDyn_DataData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg @@ -19597,24950 +12704,2287 @@ SUBROUTINE FAST_CopyElastoDyn_Data( SrcElastoDyn_DataData, DstElastoDyn_DataData INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyElastoDyn_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyMoorDyn_Data' ! ErrStat = ErrID_None ErrMsg = "" - DO i1 = LBOUND(SrcElastoDyn_DataData%x,1), UBOUND(SrcElastoDyn_DataData%x,1) - CALL ED_CopyContState( SrcElastoDyn_DataData%x(i1), DstElastoDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcMoorDyn_DataData%x,1), UBOUND(SrcMoorDyn_DataData%x,1) + CALL MD_CopyContState( SrcMoorDyn_DataData%x(i1), DstMoorDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - DO i1 = LBOUND(SrcElastoDyn_DataData%xd,1), UBOUND(SrcElastoDyn_DataData%xd,1) - CALL ED_CopyDiscState( SrcElastoDyn_DataData%xd(i1), DstElastoDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcMoorDyn_DataData%xd,1), UBOUND(SrcMoorDyn_DataData%xd,1) + CALL MD_CopyDiscState( SrcMoorDyn_DataData%xd(i1), DstMoorDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - DO i1 = LBOUND(SrcElastoDyn_DataData%z,1), UBOUND(SrcElastoDyn_DataData%z,1) - CALL ED_CopyConstrState( SrcElastoDyn_DataData%z(i1), DstElastoDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcMoorDyn_DataData%z,1), UBOUND(SrcMoorDyn_DataData%z,1) + CALL MD_CopyConstrState( SrcMoorDyn_DataData%z(i1), DstMoorDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - DO i1 = LBOUND(SrcElastoDyn_DataData%OtherSt,1), UBOUND(SrcElastoDyn_DataData%OtherSt,1) - CALL ED_CopyOtherState( SrcElastoDyn_DataData%OtherSt(i1), DstElastoDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcMoorDyn_DataData%OtherSt,1), UBOUND(SrcMoorDyn_DataData%OtherSt,1) + CALL MD_CopyOtherState( SrcMoorDyn_DataData%OtherSt(i1), DstMoorDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - CALL ED_CopyParam( SrcElastoDyn_DataData%p, DstElastoDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL MD_CopyParam( SrcMoorDyn_DataData%p, DstMoorDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - CALL ED_CopyInput( SrcElastoDyn_DataData%u, DstElastoDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL MD_CopyInput( SrcMoorDyn_DataData%u, DstMoorDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - CALL ED_CopyOutput( SrcElastoDyn_DataData%y, DstElastoDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL MD_CopyOutput( SrcMoorDyn_DataData%y, DstMoorDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - CALL ED_CopyMisc( SrcElastoDyn_DataData%m, DstElastoDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) + CALL MD_CopyMisc( SrcMoorDyn_DataData%m, DstMoorDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcElastoDyn_DataData%Output)) THEN - i1_l = LBOUND(SrcElastoDyn_DataData%Output,1) - i1_u = UBOUND(SrcElastoDyn_DataData%Output,1) - IF (.NOT. ALLOCATED(DstElastoDyn_DataData%Output)) THEN - ALLOCATE(DstElastoDyn_DataData%Output(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcMoorDyn_DataData%Output)) THEN + i1_l = LBOUND(SrcMoorDyn_DataData%Output,1) + i1_u = UBOUND(SrcMoorDyn_DataData%Output,1) + IF (.NOT. ALLOCATED(DstMoorDyn_DataData%Output)) THEN + ALLOCATE(DstMoorDyn_DataData%Output(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcElastoDyn_DataData%Output,1), UBOUND(SrcElastoDyn_DataData%Output,1) - CALL ED_CopyOutput( SrcElastoDyn_DataData%Output(i1), DstElastoDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcMoorDyn_DataData%Output,1), UBOUND(SrcMoorDyn_DataData%Output,1) + CALL MD_CopyOutput( SrcMoorDyn_DataData%Output(i1), DstMoorDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF - CALL ED_CopyOutput( SrcElastoDyn_DataData%y_interp, DstElastoDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) + CALL MD_CopyOutput( SrcMoorDyn_DataData%y_interp, DstMoorDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcElastoDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcElastoDyn_DataData%Input,1) - i1_u = UBOUND(SrcElastoDyn_DataData%Input,1) - IF (.NOT. ALLOCATED(DstElastoDyn_DataData%Input)) THEN - ALLOCATE(DstElastoDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcMoorDyn_DataData%Input)) THEN + i1_l = LBOUND(SrcMoorDyn_DataData%Input,1) + i1_u = UBOUND(SrcMoorDyn_DataData%Input,1) + IF (.NOT. ALLOCATED(DstMoorDyn_DataData%Input)) THEN + ALLOCATE(DstMoorDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcElastoDyn_DataData%Input,1), UBOUND(SrcElastoDyn_DataData%Input,1) - CALL ED_CopyInput( SrcElastoDyn_DataData%Input(i1), DstElastoDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcMoorDyn_DataData%Input,1), UBOUND(SrcMoorDyn_DataData%Input,1) + CALL MD_CopyInput( SrcMoorDyn_DataData%Input(i1), DstMoorDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF -IF (ALLOCATED(SrcElastoDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcElastoDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcElastoDyn_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstElastoDyn_DataData%InputTimes)) THEN - ALLOCATE(DstElastoDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcMoorDyn_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcMoorDyn_DataData%InputTimes,1) + i1_u = UBOUND(SrcMoorDyn_DataData%InputTimes,1) + IF (.NOT. ALLOCATED(DstMoorDyn_DataData%InputTimes)) THEN + ALLOCATE(DstMoorDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstElastoDyn_DataData%InputTimes = SrcElastoDyn_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyElastoDyn_Data - - SUBROUTINE FAST_DestroyElastoDyn_Data( ElastoDyn_DataData, ErrStat, ErrMsg ) - TYPE(ElastoDyn_Data), INTENT(INOUT) :: ElastoDyn_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyElastoDyn_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(ElastoDyn_DataData%x,1), UBOUND(ElastoDyn_DataData%x,1) - CALL ED_DestroyContState( ElastoDyn_DataData%x(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(ElastoDyn_DataData%xd,1), UBOUND(ElastoDyn_DataData%xd,1) - CALL ED_DestroyDiscState( ElastoDyn_DataData%xd(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(ElastoDyn_DataData%z,1), UBOUND(ElastoDyn_DataData%z,1) - CALL ED_DestroyConstrState( ElastoDyn_DataData%z(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(ElastoDyn_DataData%OtherSt,1), UBOUND(ElastoDyn_DataData%OtherSt,1) - CALL ED_DestroyOtherState( ElastoDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL ED_DestroyParam( ElastoDyn_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ED_DestroyInput( ElastoDyn_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ED_DestroyOutput( ElastoDyn_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ED_DestroyMisc( ElastoDyn_DataData%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ElastoDyn_DataData%Output)) THEN -DO i1 = LBOUND(ElastoDyn_DataData%Output,1), UBOUND(ElastoDyn_DataData%Output,1) - CALL ED_DestroyOutput( ElastoDyn_DataData%Output(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ElastoDyn_DataData%Output) -ENDIF - CALL ED_DestroyOutput( ElastoDyn_DataData%y_interp, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ElastoDyn_DataData%Input)) THEN -DO i1 = LBOUND(ElastoDyn_DataData%Input,1), UBOUND(ElastoDyn_DataData%Input,1) - CALL ED_DestroyInput( ElastoDyn_DataData%Input(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ElastoDyn_DataData%Input) -ENDIF -IF (ALLOCATED(ElastoDyn_DataData%InputTimes)) THEN - DEALLOCATE(ElastoDyn_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyElastoDyn_Data - - SUBROUTINE FAST_PackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ElastoDyn_Data), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackElastoDyn_Data' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL ED_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL ED_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL ED_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL ED_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL ED_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL ED_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL ED_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL ED_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no - IF ( ALLOCATED(InData%Output) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype - CALL ED_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Output - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Output - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Output - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype - CALL ED_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_interp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_interp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_interp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL ED_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL ED_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL ED_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL ED_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL ED_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - CALL ED_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL ED_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL ED_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL ED_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%Output) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Output,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - CALL ED_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL ED_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%Input) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL ED_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_PackElastoDyn_Data - - SUBROUTINE FAST_UnPackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ElastoDyn_Data), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackElastoDyn_Data' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ED_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ED_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ED_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ED_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ED_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ED_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ED_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ED_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Output not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Output)) DEALLOCATE(OutData%Output) - ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ED_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ED_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ED_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_UnPackElastoDyn_Data - - SUBROUTINE FAST_CopyServoDyn_Data( SrcServoDyn_DataData, DstServoDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ServoDyn_Data), INTENT(INOUT) :: SrcServoDyn_DataData - TYPE(ServoDyn_Data), INTENT(INOUT) :: DstServoDyn_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyServoDyn_Data' -! - ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcServoDyn_DataData%x,1), UBOUND(SrcServoDyn_DataData%x,1) - CALL SrvD_CopyContState( SrcServoDyn_DataData%x(i1), DstServoDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcServoDyn_DataData%xd,1), UBOUND(SrcServoDyn_DataData%xd,1) - CALL SrvD_CopyDiscState( SrcServoDyn_DataData%xd(i1), DstServoDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcServoDyn_DataData%z,1), UBOUND(SrcServoDyn_DataData%z,1) - CALL SrvD_CopyConstrState( SrcServoDyn_DataData%z(i1), DstServoDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcServoDyn_DataData%OtherSt,1), UBOUND(SrcServoDyn_DataData%OtherSt,1) - CALL SrvD_CopyOtherState( SrcServoDyn_DataData%OtherSt(i1), DstServoDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL SrvD_CopyParam( SrcServoDyn_DataData%p, DstServoDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SrvD_CopyInput( SrcServoDyn_DataData%u, DstServoDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SrvD_CopyOutput( SrcServoDyn_DataData%y, DstServoDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SrvD_CopyMisc( SrcServoDyn_DataData%m, DstServoDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcServoDyn_DataData%Output)) THEN - i1_l = LBOUND(SrcServoDyn_DataData%Output,1) - i1_u = UBOUND(SrcServoDyn_DataData%Output,1) - IF (.NOT. ALLOCATED(DstServoDyn_DataData%Output)) THEN - ALLOCATE(DstServoDyn_DataData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcServoDyn_DataData%Output,1), UBOUND(SrcServoDyn_DataData%Output,1) - CALL SrvD_CopyOutput( SrcServoDyn_DataData%Output(i1), DstServoDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL SrvD_CopyOutput( SrcServoDyn_DataData%y_interp, DstServoDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcServoDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcServoDyn_DataData%Input,1) - i1_u = UBOUND(SrcServoDyn_DataData%Input,1) - IF (.NOT. ALLOCATED(DstServoDyn_DataData%Input)) THEN - ALLOCATE(DstServoDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcServoDyn_DataData%Input,1), UBOUND(SrcServoDyn_DataData%Input,1) - CALL SrvD_CopyInput( SrcServoDyn_DataData%Input(i1), DstServoDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcServoDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcServoDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcServoDyn_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstServoDyn_DataData%InputTimes)) THEN - ALLOCATE(DstServoDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstServoDyn_DataData%InputTimes = SrcServoDyn_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyServoDyn_Data - - SUBROUTINE FAST_DestroyServoDyn_Data( ServoDyn_DataData, ErrStat, ErrMsg ) - TYPE(ServoDyn_Data), INTENT(INOUT) :: ServoDyn_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyServoDyn_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(ServoDyn_DataData%x,1), UBOUND(ServoDyn_DataData%x,1) - CALL SrvD_DestroyContState( ServoDyn_DataData%x(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(ServoDyn_DataData%xd,1), UBOUND(ServoDyn_DataData%xd,1) - CALL SrvD_DestroyDiscState( ServoDyn_DataData%xd(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(ServoDyn_DataData%z,1), UBOUND(ServoDyn_DataData%z,1) - CALL SrvD_DestroyConstrState( ServoDyn_DataData%z(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(ServoDyn_DataData%OtherSt,1), UBOUND(ServoDyn_DataData%OtherSt,1) - CALL SrvD_DestroyOtherState( ServoDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL SrvD_DestroyParam( ServoDyn_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SrvD_DestroyInput( ServoDyn_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SrvD_DestroyOutput( ServoDyn_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SrvD_DestroyMisc( ServoDyn_DataData%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ServoDyn_DataData%Output)) THEN -DO i1 = LBOUND(ServoDyn_DataData%Output,1), UBOUND(ServoDyn_DataData%Output,1) - CALL SrvD_DestroyOutput( ServoDyn_DataData%Output(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ServoDyn_DataData%Output) -ENDIF - CALL SrvD_DestroyOutput( ServoDyn_DataData%y_interp, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ServoDyn_DataData%Input)) THEN -DO i1 = LBOUND(ServoDyn_DataData%Input,1), UBOUND(ServoDyn_DataData%Input,1) - CALL SrvD_DestroyInput( ServoDyn_DataData%Input(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ServoDyn_DataData%Input) -ENDIF -IF (ALLOCATED(ServoDyn_DataData%InputTimes)) THEN - DEALLOCATE(ServoDyn_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyServoDyn_Data - - SUBROUTINE FAST_PackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ServoDyn_Data), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackServoDyn_Data' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL SrvD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL SrvD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL SrvD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL SrvD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL SrvD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL SrvD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL SrvD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL SrvD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no - IF ( ALLOCATED(InData%Output) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype - CALL SrvD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Output - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Output - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Output - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype - CALL SrvD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_interp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_interp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_interp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL SrvD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL SrvD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL SrvD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL SrvD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL SrvD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - CALL SrvD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SrvD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SrvD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SrvD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%Output) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Output,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - CALL SrvD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL SrvD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%Input) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL SrvD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_PackServoDyn_Data - - SUBROUTINE FAST_UnPackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ServoDyn_Data), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackServoDyn_Data' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SrvD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SrvD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SrvD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SrvD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SrvD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SrvD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SrvD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SrvD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Output not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Output)) DEALLOCATE(OutData%Output) - ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SrvD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SrvD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SrvD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_UnPackServoDyn_Data - - SUBROUTINE FAST_CopyAeroDyn14_Data( SrcAeroDyn14_DataData, DstAeroDyn14_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AeroDyn14_Data), INTENT(INOUT) :: SrcAeroDyn14_DataData - TYPE(AeroDyn14_Data), INTENT(INOUT) :: DstAeroDyn14_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyAeroDyn14_Data' -! - ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcAeroDyn14_DataData%x,1), UBOUND(SrcAeroDyn14_DataData%x,1) - CALL AD14_CopyContState( SrcAeroDyn14_DataData%x(i1), DstAeroDyn14_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcAeroDyn14_DataData%xd,1), UBOUND(SrcAeroDyn14_DataData%xd,1) - CALL AD14_CopyDiscState( SrcAeroDyn14_DataData%xd(i1), DstAeroDyn14_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcAeroDyn14_DataData%z,1), UBOUND(SrcAeroDyn14_DataData%z,1) - CALL AD14_CopyConstrState( SrcAeroDyn14_DataData%z(i1), DstAeroDyn14_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcAeroDyn14_DataData%OtherSt,1), UBOUND(SrcAeroDyn14_DataData%OtherSt,1) - CALL AD14_CopyOtherState( SrcAeroDyn14_DataData%OtherSt(i1), DstAeroDyn14_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL AD14_CopyParam( SrcAeroDyn14_DataData%p, DstAeroDyn14_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_CopyInput( SrcAeroDyn14_DataData%u, DstAeroDyn14_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_CopyOutput( SrcAeroDyn14_DataData%y, DstAeroDyn14_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_CopyMisc( SrcAeroDyn14_DataData%m, DstAeroDyn14_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcAeroDyn14_DataData%Input)) THEN - i1_l = LBOUND(SrcAeroDyn14_DataData%Input,1) - i1_u = UBOUND(SrcAeroDyn14_DataData%Input,1) - IF (.NOT. ALLOCATED(DstAeroDyn14_DataData%Input)) THEN - ALLOCATE(DstAeroDyn14_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn14_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcAeroDyn14_DataData%Input,1), UBOUND(SrcAeroDyn14_DataData%Input,1) - CALL AD14_CopyInput( SrcAeroDyn14_DataData%Input(i1), DstAeroDyn14_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcAeroDyn14_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcAeroDyn14_DataData%InputTimes,1) - i1_u = UBOUND(SrcAeroDyn14_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstAeroDyn14_DataData%InputTimes)) THEN - ALLOCATE(DstAeroDyn14_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn14_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstAeroDyn14_DataData%InputTimes = SrcAeroDyn14_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyAeroDyn14_Data - - SUBROUTINE FAST_DestroyAeroDyn14_Data( AeroDyn14_DataData, ErrStat, ErrMsg ) - TYPE(AeroDyn14_Data), INTENT(INOUT) :: AeroDyn14_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyAeroDyn14_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(AeroDyn14_DataData%x,1), UBOUND(AeroDyn14_DataData%x,1) - CALL AD14_DestroyContState( AeroDyn14_DataData%x(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(AeroDyn14_DataData%xd,1), UBOUND(AeroDyn14_DataData%xd,1) - CALL AD14_DestroyDiscState( AeroDyn14_DataData%xd(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(AeroDyn14_DataData%z,1), UBOUND(AeroDyn14_DataData%z,1) - CALL AD14_DestroyConstrState( AeroDyn14_DataData%z(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(AeroDyn14_DataData%OtherSt,1), UBOUND(AeroDyn14_DataData%OtherSt,1) - CALL AD14_DestroyOtherState( AeroDyn14_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL AD14_DestroyParam( AeroDyn14_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyInput( AeroDyn14_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyOutput( AeroDyn14_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyMisc( AeroDyn14_DataData%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(AeroDyn14_DataData%Input)) THEN -DO i1 = LBOUND(AeroDyn14_DataData%Input,1), UBOUND(AeroDyn14_DataData%Input,1) - CALL AD14_DestroyInput( AeroDyn14_DataData%Input(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(AeroDyn14_DataData%Input) -ENDIF -IF (ALLOCATED(AeroDyn14_DataData%InputTimes)) THEN - DEALLOCATE(AeroDyn14_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyAeroDyn14_Data - - SUBROUTINE FAST_PackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AeroDyn14_Data), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackAeroDyn14_Data' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL AD14_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL AD14_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL AD14_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL AD14_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL AD14_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL AD14_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL AD14_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL AD14_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL AD14_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL AD14_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL AD14_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL AD14_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL AD14_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - CALL AD14_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD14_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD14_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD14_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%Input) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL AD14_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_PackAeroDyn14_Data - - SUBROUTINE FAST_UnPackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AeroDyn14_Data), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackAeroDyn14_Data' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD14_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD14_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD14_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD14_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD14_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD14_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD14_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD14_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD14_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_UnPackAeroDyn14_Data - - SUBROUTINE FAST_CopyAeroDyn_Data( SrcAeroDyn_DataData, DstAeroDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AeroDyn_Data), INTENT(INOUT) :: SrcAeroDyn_DataData - TYPE(AeroDyn_Data), INTENT(INOUT) :: DstAeroDyn_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyAeroDyn_Data' -! - ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcAeroDyn_DataData%x,1), UBOUND(SrcAeroDyn_DataData%x,1) - CALL AD_CopyContState( SrcAeroDyn_DataData%x(i1), DstAeroDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcAeroDyn_DataData%xd,1), UBOUND(SrcAeroDyn_DataData%xd,1) - CALL AD_CopyDiscState( SrcAeroDyn_DataData%xd(i1), DstAeroDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcAeroDyn_DataData%z,1), UBOUND(SrcAeroDyn_DataData%z,1) - CALL AD_CopyConstrState( SrcAeroDyn_DataData%z(i1), DstAeroDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcAeroDyn_DataData%OtherSt,1), UBOUND(SrcAeroDyn_DataData%OtherSt,1) - CALL AD_CopyOtherState( SrcAeroDyn_DataData%OtherSt(i1), DstAeroDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL AD_CopyParam( SrcAeroDyn_DataData%p, DstAeroDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD_CopyInput( SrcAeroDyn_DataData%u, DstAeroDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD_CopyOutput( SrcAeroDyn_DataData%y, DstAeroDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD_CopyMisc( SrcAeroDyn_DataData%m, DstAeroDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcAeroDyn_DataData%Output)) THEN - i1_l = LBOUND(SrcAeroDyn_DataData%Output,1) - i1_u = UBOUND(SrcAeroDyn_DataData%Output,1) - IF (.NOT. ALLOCATED(DstAeroDyn_DataData%Output)) THEN - ALLOCATE(DstAeroDyn_DataData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcAeroDyn_DataData%Output,1), UBOUND(SrcAeroDyn_DataData%Output,1) - CALL AD_CopyOutput( SrcAeroDyn_DataData%Output(i1), DstAeroDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL AD_CopyOutput( SrcAeroDyn_DataData%y_interp, DstAeroDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcAeroDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcAeroDyn_DataData%Input,1) - i1_u = UBOUND(SrcAeroDyn_DataData%Input,1) - IF (.NOT. ALLOCATED(DstAeroDyn_DataData%Input)) THEN - ALLOCATE(DstAeroDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcAeroDyn_DataData%Input,1), UBOUND(SrcAeroDyn_DataData%Input,1) - CALL AD_CopyInput( SrcAeroDyn_DataData%Input(i1), DstAeroDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcAeroDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcAeroDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcAeroDyn_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstAeroDyn_DataData%InputTimes)) THEN - ALLOCATE(DstAeroDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstAeroDyn_DataData%InputTimes = SrcAeroDyn_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyAeroDyn_Data - - SUBROUTINE FAST_DestroyAeroDyn_Data( AeroDyn_DataData, ErrStat, ErrMsg ) - TYPE(AeroDyn_Data), INTENT(INOUT) :: AeroDyn_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyAeroDyn_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(AeroDyn_DataData%x,1), UBOUND(AeroDyn_DataData%x,1) - CALL AD_DestroyContState( AeroDyn_DataData%x(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(AeroDyn_DataData%xd,1), UBOUND(AeroDyn_DataData%xd,1) - CALL AD_DestroyDiscState( AeroDyn_DataData%xd(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(AeroDyn_DataData%z,1), UBOUND(AeroDyn_DataData%z,1) - CALL AD_DestroyConstrState( AeroDyn_DataData%z(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(AeroDyn_DataData%OtherSt,1), UBOUND(AeroDyn_DataData%OtherSt,1) - CALL AD_DestroyOtherState( AeroDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL AD_DestroyParam( AeroDyn_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD_DestroyInput( AeroDyn_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD_DestroyOutput( AeroDyn_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD_DestroyMisc( AeroDyn_DataData%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(AeroDyn_DataData%Output)) THEN -DO i1 = LBOUND(AeroDyn_DataData%Output,1), UBOUND(AeroDyn_DataData%Output,1) - CALL AD_DestroyOutput( AeroDyn_DataData%Output(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(AeroDyn_DataData%Output) -ENDIF - CALL AD_DestroyOutput( AeroDyn_DataData%y_interp, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(AeroDyn_DataData%Input)) THEN -DO i1 = LBOUND(AeroDyn_DataData%Input,1), UBOUND(AeroDyn_DataData%Input,1) - CALL AD_DestroyInput( AeroDyn_DataData%Input(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(AeroDyn_DataData%Input) -ENDIF -IF (ALLOCATED(AeroDyn_DataData%InputTimes)) THEN - DEALLOCATE(AeroDyn_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyAeroDyn_Data - - SUBROUTINE FAST_PackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AeroDyn_Data), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackAeroDyn_Data' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL AD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL AD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL AD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL AD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL AD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL AD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no - IF ( ALLOCATED(InData%Output) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype - CALL AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Output - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Output - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Output - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype - CALL AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_interp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_interp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_interp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL AD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL AD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL AD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL AD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - CALL AD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%Output) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Output,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - CALL AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%Input) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_PackAeroDyn_Data - - SUBROUTINE FAST_UnPackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AeroDyn_Data), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackAeroDyn_Data' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Output not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Output)) DEALLOCATE(OutData%Output) - ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_UnPackAeroDyn_Data - - SUBROUTINE FAST_CopyInflowWind_Data( SrcInflowWind_DataData, DstInflowWind_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(InflowWind_Data), INTENT(IN) :: SrcInflowWind_DataData - TYPE(InflowWind_Data), INTENT(INOUT) :: DstInflowWind_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyInflowWind_Data' -! - ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcInflowWind_DataData%x,1), UBOUND(SrcInflowWind_DataData%x,1) - CALL InflowWind_CopyContState( SrcInflowWind_DataData%x(i1), DstInflowWind_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcInflowWind_DataData%xd,1), UBOUND(SrcInflowWind_DataData%xd,1) - CALL InflowWind_CopyDiscState( SrcInflowWind_DataData%xd(i1), DstInflowWind_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcInflowWind_DataData%z,1), UBOUND(SrcInflowWind_DataData%z,1) - CALL InflowWind_CopyConstrState( SrcInflowWind_DataData%z(i1), DstInflowWind_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcInflowWind_DataData%OtherSt,1), UBOUND(SrcInflowWind_DataData%OtherSt,1) - CALL InflowWind_CopyOtherState( SrcInflowWind_DataData%OtherSt(i1), DstInflowWind_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL InflowWind_CopyParam( SrcInflowWind_DataData%p, DstInflowWind_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyInput( SrcInflowWind_DataData%u, DstInflowWind_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyOutput( SrcInflowWind_DataData%y, DstInflowWind_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyMisc( SrcInflowWind_DataData%m, DstInflowWind_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInflowWind_DataData%Output)) THEN - i1_l = LBOUND(SrcInflowWind_DataData%Output,1) - i1_u = UBOUND(SrcInflowWind_DataData%Output,1) - IF (.NOT. ALLOCATED(DstInflowWind_DataData%Output)) THEN - ALLOCATE(DstInflowWind_DataData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInflowWind_DataData%Output,1), UBOUND(SrcInflowWind_DataData%Output,1) - CALL InflowWind_CopyOutput( SrcInflowWind_DataData%Output(i1), DstInflowWind_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL InflowWind_CopyOutput( SrcInflowWind_DataData%y_interp, DstInflowWind_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInflowWind_DataData%Input)) THEN - i1_l = LBOUND(SrcInflowWind_DataData%Input,1) - i1_u = UBOUND(SrcInflowWind_DataData%Input,1) - IF (.NOT. ALLOCATED(DstInflowWind_DataData%Input)) THEN - ALLOCATE(DstInflowWind_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInflowWind_DataData%Input,1), UBOUND(SrcInflowWind_DataData%Input,1) - CALL InflowWind_CopyInput( SrcInflowWind_DataData%Input(i1), DstInflowWind_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInflowWind_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcInflowWind_DataData%InputTimes,1) - i1_u = UBOUND(SrcInflowWind_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstInflowWind_DataData%InputTimes)) THEN - ALLOCATE(DstInflowWind_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInflowWind_DataData%InputTimes = SrcInflowWind_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyInflowWind_Data - - SUBROUTINE FAST_DestroyInflowWind_Data( InflowWind_DataData, ErrStat, ErrMsg ) - TYPE(InflowWind_Data), INTENT(INOUT) :: InflowWind_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyInflowWind_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(InflowWind_DataData%x,1), UBOUND(InflowWind_DataData%x,1) - CALL InflowWind_DestroyContState( InflowWind_DataData%x(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(InflowWind_DataData%xd,1), UBOUND(InflowWind_DataData%xd,1) - CALL InflowWind_DestroyDiscState( InflowWind_DataData%xd(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(InflowWind_DataData%z,1), UBOUND(InflowWind_DataData%z,1) - CALL InflowWind_DestroyConstrState( InflowWind_DataData%z(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(InflowWind_DataData%OtherSt,1), UBOUND(InflowWind_DataData%OtherSt,1) - CALL InflowWind_DestroyOtherState( InflowWind_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL InflowWind_DestroyParam( InflowWind_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyInput( InflowWind_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyOutput( InflowWind_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyMisc( InflowWind_DataData%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InflowWind_DataData%Output)) THEN -DO i1 = LBOUND(InflowWind_DataData%Output,1), UBOUND(InflowWind_DataData%Output,1) - CALL InflowWind_DestroyOutput( InflowWind_DataData%Output(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InflowWind_DataData%Output) -ENDIF - CALL InflowWind_DestroyOutput( InflowWind_DataData%y_interp, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InflowWind_DataData%Input)) THEN -DO i1 = LBOUND(InflowWind_DataData%Input,1), UBOUND(InflowWind_DataData%Input,1) - CALL InflowWind_DestroyInput( InflowWind_DataData%Input(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InflowWind_DataData%Input) -ENDIF -IF (ALLOCATED(InflowWind_DataData%InputTimes)) THEN - DEALLOCATE(InflowWind_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyInflowWind_Data - - SUBROUTINE FAST_PackInflowWind_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(InflowWind_Data), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackInflowWind_Data' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL InflowWind_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL InflowWind_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL InflowWind_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no - IF ( ALLOCATED(InData%Output) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Output - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Output - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Output - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_interp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_interp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_interp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL InflowWind_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - CALL InflowWind_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL InflowWind_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%Output) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Output,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%Input) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_PackInflowWind_Data - - SUBROUTINE FAST_UnPackInflowWind_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(InflowWind_Data), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackInflowWind_Data' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Output not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Output)) DEALLOCATE(OutData%Output) - ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_UnPackInflowWind_Data - - SUBROUTINE FAST_CopyOpenFOAM_Data( SrcOpenFOAM_DataData, DstOpenFOAM_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(OpenFOAM_Data), INTENT(INOUT) :: SrcOpenFOAM_DataData - TYPE(OpenFOAM_Data), INTENT(INOUT) :: DstOpenFOAM_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyOpenFOAM_Data' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL OpFM_CopyInput( SrcOpenFOAM_DataData%u, DstOpenFOAM_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL OpFM_CopyOutput( SrcOpenFOAM_DataData%y, DstOpenFOAM_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL OpFM_CopyParam( SrcOpenFOAM_DataData%p, DstOpenFOAM_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL OpFM_CopyMisc( SrcOpenFOAM_DataData%m, DstOpenFOAM_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE FAST_CopyOpenFOAM_Data - - SUBROUTINE FAST_DestroyOpenFOAM_Data( OpenFOAM_DataData, ErrStat, ErrMsg ) - TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpenFOAM_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyOpenFOAM_Data' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL OpFM_DestroyInput( OpenFOAM_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL OpFM_DestroyOutput( OpenFOAM_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL OpFM_DestroyParam( OpenFOAM_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL OpFM_DestroyMisc( OpenFOAM_DataData%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE FAST_DestroyOpenFOAM_Data - - SUBROUTINE FAST_PackOpenFOAM_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(OpenFOAM_Data), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackOpenFOAM_Data' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL OpFM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL OpFM_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL OpFM_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL OpFM_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL OpFM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL OpFM_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL OpFM_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL OpFM_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE FAST_PackOpenFOAM_Data - - SUBROUTINE FAST_UnPackOpenFOAM_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(OpenFOAM_Data), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackOpenFOAM_Data' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL OpFM_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL OpFM_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL OpFM_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL OpFM_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE FAST_UnPackOpenFOAM_Data - - SUBROUTINE FAST_CopySCDataEx_Data( SrcSCDataEx_DataData, DstSCDataEx_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SCDataEx_Data), INTENT(IN) :: SrcSCDataEx_DataData - TYPE(SCDataEx_Data), INTENT(INOUT) :: DstSCDataEx_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopySCDataEx_Data' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL SC_DX_CopyInput( SrcSCDataEx_DataData%u, DstSCDataEx_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SC_DX_CopyOutput( SrcSCDataEx_DataData%y, DstSCDataEx_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SC_DX_CopyParam( SrcSCDataEx_DataData%p, DstSCDataEx_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE FAST_CopySCDataEx_Data - - SUBROUTINE FAST_DestroySCDataEx_Data( SCDataEx_DataData, ErrStat, ErrMsg ) - TYPE(SCDataEx_Data), INTENT(INOUT) :: SCDataEx_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroySCDataEx_Data' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL SC_DX_DestroyInput( SCDataEx_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SC_DX_DestroyOutput( SCDataEx_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SC_DX_DestroyParam( SCDataEx_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE FAST_DestroySCDataEx_Data - - SUBROUTINE FAST_PackSCDataEx_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SCDataEx_Data), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackSCDataEx_Data' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL SC_DX_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL SC_DX_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL SC_DX_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL SC_DX_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SC_DX_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SC_DX_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE FAST_PackSCDataEx_Data - - SUBROUTINE FAST_UnPackSCDataEx_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SCDataEx_Data), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackSCDataEx_Data' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SC_DX_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SC_DX_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SC_DX_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE FAST_UnPackSCDataEx_Data - - SUBROUTINE FAST_CopySubDyn_Data( SrcSubDyn_DataData, DstSubDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SubDyn_Data), INTENT(INOUT) :: SrcSubDyn_DataData - TYPE(SubDyn_Data), INTENT(INOUT) :: DstSubDyn_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopySubDyn_Data' -! - ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcSubDyn_DataData%x,1), UBOUND(SrcSubDyn_DataData%x,1) - CALL SD_CopyContState( SrcSubDyn_DataData%x(i1), DstSubDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcSubDyn_DataData%xd,1), UBOUND(SrcSubDyn_DataData%xd,1) - CALL SD_CopyDiscState( SrcSubDyn_DataData%xd(i1), DstSubDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcSubDyn_DataData%z,1), UBOUND(SrcSubDyn_DataData%z,1) - CALL SD_CopyConstrState( SrcSubDyn_DataData%z(i1), DstSubDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcSubDyn_DataData%OtherSt,1), UBOUND(SrcSubDyn_DataData%OtherSt,1) - CALL SD_CopyOtherState( SrcSubDyn_DataData%OtherSt(i1), DstSubDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL SD_CopyParam( SrcSubDyn_DataData%p, DstSubDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SD_CopyInput( SrcSubDyn_DataData%u, DstSubDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SD_CopyOutput( SrcSubDyn_DataData%y, DstSubDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SD_CopyMisc( SrcSubDyn_DataData%m, DstSubDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcSubDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcSubDyn_DataData%Input,1) - i1_u = UBOUND(SrcSubDyn_DataData%Input,1) - IF (.NOT. ALLOCATED(DstSubDyn_DataData%Input)) THEN - ALLOCATE(DstSubDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcSubDyn_DataData%Input,1), UBOUND(SrcSubDyn_DataData%Input,1) - CALL SD_CopyInput( SrcSubDyn_DataData%Input(i1), DstSubDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcSubDyn_DataData%Output)) THEN - i1_l = LBOUND(SrcSubDyn_DataData%Output,1) - i1_u = UBOUND(SrcSubDyn_DataData%Output,1) - IF (.NOT. ALLOCATED(DstSubDyn_DataData%Output)) THEN - ALLOCATE(DstSubDyn_DataData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcSubDyn_DataData%Output,1), UBOUND(SrcSubDyn_DataData%Output,1) - CALL SD_CopyOutput( SrcSubDyn_DataData%Output(i1), DstSubDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL SD_CopyOutput( SrcSubDyn_DataData%y_interp, DstSubDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcSubDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcSubDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcSubDyn_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstSubDyn_DataData%InputTimes)) THEN - ALLOCATE(DstSubDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstSubDyn_DataData%InputTimes = SrcSubDyn_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopySubDyn_Data - - SUBROUTINE FAST_DestroySubDyn_Data( SubDyn_DataData, ErrStat, ErrMsg ) - TYPE(SubDyn_Data), INTENT(INOUT) :: SubDyn_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroySubDyn_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(SubDyn_DataData%x,1), UBOUND(SubDyn_DataData%x,1) - CALL SD_DestroyContState( SubDyn_DataData%x(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(SubDyn_DataData%xd,1), UBOUND(SubDyn_DataData%xd,1) - CALL SD_DestroyDiscState( SubDyn_DataData%xd(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(SubDyn_DataData%z,1), UBOUND(SubDyn_DataData%z,1) - CALL SD_DestroyConstrState( SubDyn_DataData%z(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(SubDyn_DataData%OtherSt,1), UBOUND(SubDyn_DataData%OtherSt,1) - CALL SD_DestroyOtherState( SubDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL SD_DestroyParam( SubDyn_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SD_DestroyInput( SubDyn_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SD_DestroyOutput( SubDyn_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SD_DestroyMisc( SubDyn_DataData%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(SubDyn_DataData%Input)) THEN -DO i1 = LBOUND(SubDyn_DataData%Input,1), UBOUND(SubDyn_DataData%Input,1) - CALL SD_DestroyInput( SubDyn_DataData%Input(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(SubDyn_DataData%Input) -ENDIF -IF (ALLOCATED(SubDyn_DataData%Output)) THEN -DO i1 = LBOUND(SubDyn_DataData%Output,1), UBOUND(SubDyn_DataData%Output,1) - CALL SD_DestroyOutput( SubDyn_DataData%Output(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(SubDyn_DataData%Output) -ENDIF - CALL SD_DestroyOutput( SubDyn_DataData%y_interp, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(SubDyn_DataData%InputTimes)) THEN - DEALLOCATE(SubDyn_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroySubDyn_Data - - SUBROUTINE FAST_PackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SubDyn_Data), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackSubDyn_Data' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL SD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL SD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL SD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL SD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL SD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL SD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL SD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no - IF ( ALLOCATED(InData%Output) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype - CALL SD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Output - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Output - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Output - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype - CALL SD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_interp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_interp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_interp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL SD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL SD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL SD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL SD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - CALL SD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%Input) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Output) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Output,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - CALL SD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL SD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_PackSubDyn_Data - - SUBROUTINE FAST_UnPackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SubDyn_Data), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackSubDyn_Data' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Output not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Output)) DEALLOCATE(OutData%Output) - ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_UnPackSubDyn_Data - - SUBROUTINE FAST_CopyExtPtfm_Data( SrcExtPtfm_DataData, DstExtPtfm_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtPtfm_Data), INTENT(INOUT) :: SrcExtPtfm_DataData - TYPE(ExtPtfm_Data), INTENT(INOUT) :: DstExtPtfm_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyExtPtfm_Data' -! - ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcExtPtfm_DataData%x,1), UBOUND(SrcExtPtfm_DataData%x,1) - CALL ExtPtfm_CopyContState( SrcExtPtfm_DataData%x(i1), DstExtPtfm_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcExtPtfm_DataData%xd,1), UBOUND(SrcExtPtfm_DataData%xd,1) - CALL ExtPtfm_CopyDiscState( SrcExtPtfm_DataData%xd(i1), DstExtPtfm_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcExtPtfm_DataData%z,1), UBOUND(SrcExtPtfm_DataData%z,1) - CALL ExtPtfm_CopyConstrState( SrcExtPtfm_DataData%z(i1), DstExtPtfm_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcExtPtfm_DataData%OtherSt,1), UBOUND(SrcExtPtfm_DataData%OtherSt,1) - CALL ExtPtfm_CopyOtherState( SrcExtPtfm_DataData%OtherSt(i1), DstExtPtfm_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL ExtPtfm_CopyParam( SrcExtPtfm_DataData%p, DstExtPtfm_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ExtPtfm_CopyInput( SrcExtPtfm_DataData%u, DstExtPtfm_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ExtPtfm_CopyOutput( SrcExtPtfm_DataData%y, DstExtPtfm_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ExtPtfm_CopyMisc( SrcExtPtfm_DataData%m, DstExtPtfm_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcExtPtfm_DataData%Input)) THEN - i1_l = LBOUND(SrcExtPtfm_DataData%Input,1) - i1_u = UBOUND(SrcExtPtfm_DataData%Input,1) - IF (.NOT. ALLOCATED(DstExtPtfm_DataData%Input)) THEN - ALLOCATE(DstExtPtfm_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstExtPtfm_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcExtPtfm_DataData%Input,1), UBOUND(SrcExtPtfm_DataData%Input,1) - CALL ExtPtfm_CopyInput( SrcExtPtfm_DataData%Input(i1), DstExtPtfm_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcExtPtfm_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcExtPtfm_DataData%InputTimes,1) - i1_u = UBOUND(SrcExtPtfm_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstExtPtfm_DataData%InputTimes)) THEN - ALLOCATE(DstExtPtfm_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstExtPtfm_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstExtPtfm_DataData%InputTimes = SrcExtPtfm_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyExtPtfm_Data - - SUBROUTINE FAST_DestroyExtPtfm_Data( ExtPtfm_DataData, ErrStat, ErrMsg ) - TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyExtPtfm_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(ExtPtfm_DataData%x,1), UBOUND(ExtPtfm_DataData%x,1) - CALL ExtPtfm_DestroyContState( ExtPtfm_DataData%x(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(ExtPtfm_DataData%xd,1), UBOUND(ExtPtfm_DataData%xd,1) - CALL ExtPtfm_DestroyDiscState( ExtPtfm_DataData%xd(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(ExtPtfm_DataData%z,1), UBOUND(ExtPtfm_DataData%z,1) - CALL ExtPtfm_DestroyConstrState( ExtPtfm_DataData%z(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(ExtPtfm_DataData%OtherSt,1), UBOUND(ExtPtfm_DataData%OtherSt,1) - CALL ExtPtfm_DestroyOtherState( ExtPtfm_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL ExtPtfm_DestroyParam( ExtPtfm_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ExtPtfm_DestroyInput( ExtPtfm_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ExtPtfm_DestroyOutput( ExtPtfm_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ExtPtfm_DestroyMisc( ExtPtfm_DataData%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ExtPtfm_DataData%Input)) THEN -DO i1 = LBOUND(ExtPtfm_DataData%Input,1), UBOUND(ExtPtfm_DataData%Input,1) - CALL ExtPtfm_DestroyInput( ExtPtfm_DataData%Input(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ExtPtfm_DataData%Input) -ENDIF -IF (ALLOCATED(ExtPtfm_DataData%InputTimes)) THEN - DEALLOCATE(ExtPtfm_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyExtPtfm_Data - - SUBROUTINE FAST_PackExtPtfm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ExtPtfm_Data), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackExtPtfm_Data' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL ExtPtfm_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL ExtPtfm_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL ExtPtfm_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL ExtPtfm_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL ExtPtfm_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL ExtPtfm_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL ExtPtfm_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL ExtPtfm_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL ExtPtfm_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL ExtPtfm_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL ExtPtfm_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL ExtPtfm_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL ExtPtfm_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - CALL ExtPtfm_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL ExtPtfm_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL ExtPtfm_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL ExtPtfm_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%Input) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL ExtPtfm_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_PackExtPtfm_Data - - SUBROUTINE FAST_UnPackExtPtfm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ExtPtfm_Data), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackExtPtfm_Data' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ExtPtfm_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ExtPtfm_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ExtPtfm_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ExtPtfm_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ExtPtfm_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ExtPtfm_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ExtPtfm_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ExtPtfm_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ExtPtfm_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_UnPackExtPtfm_Data - - SUBROUTINE FAST_CopySeaState_Data( SrcSeaState_DataData, DstSeaState_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SeaState_Data), INTENT(IN) :: SrcSeaState_DataData - TYPE(SeaState_Data), INTENT(INOUT) :: DstSeaState_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopySeaState_Data' -! - ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcSeaState_DataData%x,1), UBOUND(SrcSeaState_DataData%x,1) - CALL SeaSt_CopyContState( SrcSeaState_DataData%x(i1), DstSeaState_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcSeaState_DataData%xd,1), UBOUND(SrcSeaState_DataData%xd,1) - CALL SeaSt_CopyDiscState( SrcSeaState_DataData%xd(i1), DstSeaState_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcSeaState_DataData%z,1), UBOUND(SrcSeaState_DataData%z,1) - CALL SeaSt_CopyConstrState( SrcSeaState_DataData%z(i1), DstSeaState_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcSeaState_DataData%OtherSt,1), UBOUND(SrcSeaState_DataData%OtherSt,1) - CALL SeaSt_CopyOtherState( SrcSeaState_DataData%OtherSt(i1), DstSeaState_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL SeaSt_CopyParam( SrcSeaState_DataData%p, DstSeaState_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SeaSt_CopyInput( SrcSeaState_DataData%u, DstSeaState_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SeaSt_CopyOutput( SrcSeaState_DataData%y, DstSeaState_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SeaSt_CopyMisc( SrcSeaState_DataData%m, DstSeaState_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcSeaState_DataData%Input)) THEN - i1_l = LBOUND(SrcSeaState_DataData%Input,1) - i1_u = UBOUND(SrcSeaState_DataData%Input,1) - IF (.NOT. ALLOCATED(DstSeaState_DataData%Input)) THEN - ALLOCATE(DstSeaState_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaState_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcSeaState_DataData%Input,1), UBOUND(SrcSeaState_DataData%Input,1) - CALL SeaSt_CopyInput( SrcSeaState_DataData%Input(i1), DstSeaState_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcSeaState_DataData%Output)) THEN - i1_l = LBOUND(SrcSeaState_DataData%Output,1) - i1_u = UBOUND(SrcSeaState_DataData%Output,1) - IF (.NOT. ALLOCATED(DstSeaState_DataData%Output)) THEN - ALLOCATE(DstSeaState_DataData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaState_DataData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcSeaState_DataData%Output,1), UBOUND(SrcSeaState_DataData%Output,1) - CALL SeaSt_CopyOutput( SrcSeaState_DataData%Output(i1), DstSeaState_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL SeaSt_CopyOutput( SrcSeaState_DataData%y_interp, DstSeaState_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcSeaState_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcSeaState_DataData%InputTimes,1) - i1_u = UBOUND(SrcSeaState_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstSeaState_DataData%InputTimes)) THEN - ALLOCATE(DstSeaState_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaState_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstSeaState_DataData%InputTimes = SrcSeaState_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopySeaState_Data - - SUBROUTINE FAST_DestroySeaState_Data( SeaState_DataData, ErrStat, ErrMsg ) - TYPE(SeaState_Data), INTENT(INOUT) :: SeaState_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroySeaState_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(SeaState_DataData%x,1), UBOUND(SeaState_DataData%x,1) - CALL SeaSt_DestroyContState( SeaState_DataData%x(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(SeaState_DataData%xd,1), UBOUND(SeaState_DataData%xd,1) - CALL SeaSt_DestroyDiscState( SeaState_DataData%xd(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(SeaState_DataData%z,1), UBOUND(SeaState_DataData%z,1) - CALL SeaSt_DestroyConstrState( SeaState_DataData%z(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(SeaState_DataData%OtherSt,1), UBOUND(SeaState_DataData%OtherSt,1) - CALL SeaSt_DestroyOtherState( SeaState_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL SeaSt_DestroyParam( SeaState_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SeaSt_DestroyInput( SeaState_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SeaSt_DestroyOutput( SeaState_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SeaSt_DestroyMisc( SeaState_DataData%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(SeaState_DataData%Input)) THEN -DO i1 = LBOUND(SeaState_DataData%Input,1), UBOUND(SeaState_DataData%Input,1) - CALL SeaSt_DestroyInput( SeaState_DataData%Input(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(SeaState_DataData%Input) -ENDIF -IF (ALLOCATED(SeaState_DataData%Output)) THEN -DO i1 = LBOUND(SeaState_DataData%Output,1), UBOUND(SeaState_DataData%Output,1) - CALL SeaSt_DestroyOutput( SeaState_DataData%Output(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(SeaState_DataData%Output) -ENDIF - CALL SeaSt_DestroyOutput( SeaState_DataData%y_interp, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(SeaState_DataData%InputTimes)) THEN - DEALLOCATE(SeaState_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroySeaState_Data - - SUBROUTINE FAST_PackSeaState_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(SeaState_Data), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackSeaState_Data' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL SeaSt_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL SeaSt_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL SeaSt_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL SeaSt_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL SeaSt_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL SeaSt_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 SeaSt_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL SeaSt_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL SeaSt_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no - IF ( ALLOCATED(InData%Output) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype - CALL SeaSt_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Output - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Output - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Output - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype - CALL SeaSt_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_interp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_interp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_interp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL SeaSt_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL SeaSt_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL SeaSt_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL SeaSt_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - CALL SeaSt_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 SeaSt_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 SeaSt_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SeaSt_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%Input) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL SeaSt_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Output) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Output,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - CALL SeaSt_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL SeaSt_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_PackSeaState_Data - - SUBROUTINE FAST_UnPackSeaState_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(SeaState_Data), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackSeaState_Data' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SeaSt_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SeaSt_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SeaSt_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SeaSt_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SeaSt_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 SeaSt_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 SeaSt_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SeaSt_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SeaSt_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Output not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Output)) DEALLOCATE(OutData%Output) - ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SeaSt_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SeaSt_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_UnPackSeaState_Data - - SUBROUTINE FAST_CopyHydroDyn_Data( SrcHydroDyn_DataData, DstHydroDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HydroDyn_Data), INTENT(INOUT) :: SrcHydroDyn_DataData - TYPE(HydroDyn_Data), INTENT(INOUT) :: DstHydroDyn_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyHydroDyn_Data' -! - ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcHydroDyn_DataData%x,1), UBOUND(SrcHydroDyn_DataData%x,1) - CALL HydroDyn_CopyContState( SrcHydroDyn_DataData%x(i1), DstHydroDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcHydroDyn_DataData%xd,1), UBOUND(SrcHydroDyn_DataData%xd,1) - CALL HydroDyn_CopyDiscState( SrcHydroDyn_DataData%xd(i1), DstHydroDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcHydroDyn_DataData%z,1), UBOUND(SrcHydroDyn_DataData%z,1) - CALL HydroDyn_CopyConstrState( SrcHydroDyn_DataData%z(i1), DstHydroDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcHydroDyn_DataData%OtherSt,1), UBOUND(SrcHydroDyn_DataData%OtherSt,1) - CALL HydroDyn_CopyOtherState( SrcHydroDyn_DataData%OtherSt(i1), DstHydroDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL HydroDyn_CopyParam( SrcHydroDyn_DataData%p, DstHydroDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL HydroDyn_CopyInput( SrcHydroDyn_DataData%u, DstHydroDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL HydroDyn_CopyOutput( SrcHydroDyn_DataData%y, DstHydroDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL HydroDyn_CopyMisc( SrcHydroDyn_DataData%m, DstHydroDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcHydroDyn_DataData%Output)) THEN - i1_l = LBOUND(SrcHydroDyn_DataData%Output,1) - i1_u = UBOUND(SrcHydroDyn_DataData%Output,1) - IF (.NOT. ALLOCATED(DstHydroDyn_DataData%Output)) THEN - ALLOCATE(DstHydroDyn_DataData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcHydroDyn_DataData%Output,1), UBOUND(SrcHydroDyn_DataData%Output,1) - CALL HydroDyn_CopyOutput( SrcHydroDyn_DataData%Output(i1), DstHydroDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL HydroDyn_CopyOutput( SrcHydroDyn_DataData%y_interp, DstHydroDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcHydroDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcHydroDyn_DataData%Input,1) - i1_u = UBOUND(SrcHydroDyn_DataData%Input,1) - IF (.NOT. ALLOCATED(DstHydroDyn_DataData%Input)) THEN - ALLOCATE(DstHydroDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcHydroDyn_DataData%Input,1), UBOUND(SrcHydroDyn_DataData%Input,1) - CALL HydroDyn_CopyInput( SrcHydroDyn_DataData%Input(i1), DstHydroDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcHydroDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcHydroDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcHydroDyn_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstHydroDyn_DataData%InputTimes)) THEN - ALLOCATE(DstHydroDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstHydroDyn_DataData%InputTimes = SrcHydroDyn_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyHydroDyn_Data - - SUBROUTINE FAST_DestroyHydroDyn_Data( HydroDyn_DataData, ErrStat, ErrMsg ) - TYPE(HydroDyn_Data), INTENT(INOUT) :: HydroDyn_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyHydroDyn_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(HydroDyn_DataData%x,1), UBOUND(HydroDyn_DataData%x,1) - CALL HydroDyn_DestroyContState( HydroDyn_DataData%x(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(HydroDyn_DataData%xd,1), UBOUND(HydroDyn_DataData%xd,1) - CALL HydroDyn_DestroyDiscState( HydroDyn_DataData%xd(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(HydroDyn_DataData%z,1), UBOUND(HydroDyn_DataData%z,1) - CALL HydroDyn_DestroyConstrState( HydroDyn_DataData%z(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(HydroDyn_DataData%OtherSt,1), UBOUND(HydroDyn_DataData%OtherSt,1) - CALL HydroDyn_DestroyOtherState( HydroDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL HydroDyn_DestroyParam( HydroDyn_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL HydroDyn_DestroyInput( HydroDyn_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL HydroDyn_DestroyOutput( HydroDyn_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL HydroDyn_DestroyMisc( HydroDyn_DataData%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(HydroDyn_DataData%Output)) THEN -DO i1 = LBOUND(HydroDyn_DataData%Output,1), UBOUND(HydroDyn_DataData%Output,1) - CALL HydroDyn_DestroyOutput( HydroDyn_DataData%Output(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(HydroDyn_DataData%Output) -ENDIF - CALL HydroDyn_DestroyOutput( HydroDyn_DataData%y_interp, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(HydroDyn_DataData%Input)) THEN -DO i1 = LBOUND(HydroDyn_DataData%Input,1), UBOUND(HydroDyn_DataData%Input,1) - CALL HydroDyn_DestroyInput( HydroDyn_DataData%Input(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(HydroDyn_DataData%Input) -ENDIF -IF (ALLOCATED(HydroDyn_DataData%InputTimes)) THEN - DEALLOCATE(HydroDyn_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyHydroDyn_Data - - SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(HydroDyn_Data), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackHydroDyn_Data' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL HydroDyn_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL HydroDyn_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL HydroDyn_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL HydroDyn_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL HydroDyn_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL HydroDyn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL HydroDyn_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL HydroDyn_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no - IF ( ALLOCATED(InData%Output) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype - CALL HydroDyn_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Output - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Output - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Output - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype - CALL HydroDyn_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_interp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_interp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_interp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL HydroDyn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL HydroDyn_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL HydroDyn_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL HydroDyn_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL HydroDyn_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - CALL HydroDyn_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL HydroDyn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL HydroDyn_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL HydroDyn_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%Output) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Output,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - CALL HydroDyn_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL HydroDyn_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%Input) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL HydroDyn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_PackHydroDyn_Data - - SUBROUTINE FAST_UnPackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(HydroDyn_Data), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackHydroDyn_Data' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL HydroDyn_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL HydroDyn_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL HydroDyn_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL HydroDyn_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL HydroDyn_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL HydroDyn_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL HydroDyn_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL HydroDyn_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Output not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Output)) DEALLOCATE(OutData%Output) - ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL HydroDyn_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL HydroDyn_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL HydroDyn_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_UnPackHydroDyn_Data - - SUBROUTINE FAST_CopyIceFloe_Data( SrcIceFloe_DataData, DstIceFloe_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceFloe_Data), INTENT(INOUT) :: SrcIceFloe_DataData - TYPE(IceFloe_Data), INTENT(INOUT) :: DstIceFloe_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyIceFloe_Data' -! - ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcIceFloe_DataData%x,1), UBOUND(SrcIceFloe_DataData%x,1) - CALL IceFloe_CopyContState( SrcIceFloe_DataData%x(i1), DstIceFloe_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcIceFloe_DataData%xd,1), UBOUND(SrcIceFloe_DataData%xd,1) - CALL IceFloe_CopyDiscState( SrcIceFloe_DataData%xd(i1), DstIceFloe_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcIceFloe_DataData%z,1), UBOUND(SrcIceFloe_DataData%z,1) - CALL IceFloe_CopyConstrState( SrcIceFloe_DataData%z(i1), DstIceFloe_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcIceFloe_DataData%OtherSt,1), UBOUND(SrcIceFloe_DataData%OtherSt,1) - CALL IceFloe_CopyOtherState( SrcIceFloe_DataData%OtherSt(i1), DstIceFloe_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL IceFloe_CopyParam( SrcIceFloe_DataData%p, DstIceFloe_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL IceFloe_CopyInput( SrcIceFloe_DataData%u, DstIceFloe_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL IceFloe_CopyOutput( SrcIceFloe_DataData%y, DstIceFloe_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL IceFloe_CopyMisc( SrcIceFloe_DataData%m, DstIceFloe_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcIceFloe_DataData%Input)) THEN - i1_l = LBOUND(SrcIceFloe_DataData%Input,1) - i1_u = UBOUND(SrcIceFloe_DataData%Input,1) - IF (.NOT. ALLOCATED(DstIceFloe_DataData%Input)) THEN - ALLOCATE(DstIceFloe_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceFloe_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcIceFloe_DataData%Input,1), UBOUND(SrcIceFloe_DataData%Input,1) - CALL IceFloe_CopyInput( SrcIceFloe_DataData%Input(i1), DstIceFloe_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcIceFloe_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcIceFloe_DataData%InputTimes,1) - i1_u = UBOUND(SrcIceFloe_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstIceFloe_DataData%InputTimes)) THEN - ALLOCATE(DstIceFloe_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceFloe_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstIceFloe_DataData%InputTimes = SrcIceFloe_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyIceFloe_Data - - SUBROUTINE FAST_DestroyIceFloe_Data( IceFloe_DataData, ErrStat, ErrMsg ) - TYPE(IceFloe_Data), INTENT(INOUT) :: IceFloe_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyIceFloe_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(IceFloe_DataData%x,1), UBOUND(IceFloe_DataData%x,1) - CALL IceFloe_DestroyContState( IceFloe_DataData%x(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(IceFloe_DataData%xd,1), UBOUND(IceFloe_DataData%xd,1) - CALL IceFloe_DestroyDiscState( IceFloe_DataData%xd(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(IceFloe_DataData%z,1), UBOUND(IceFloe_DataData%z,1) - CALL IceFloe_DestroyConstrState( IceFloe_DataData%z(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(IceFloe_DataData%OtherSt,1), UBOUND(IceFloe_DataData%OtherSt,1) - CALL IceFloe_DestroyOtherState( IceFloe_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL IceFloe_DestroyParam( IceFloe_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL IceFloe_DestroyInput( IceFloe_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL IceFloe_DestroyOutput( IceFloe_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL IceFloe_DestroyMisc( IceFloe_DataData%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(IceFloe_DataData%Input)) THEN -DO i1 = LBOUND(IceFloe_DataData%Input,1), UBOUND(IceFloe_DataData%Input,1) - CALL IceFloe_DestroyInput( IceFloe_DataData%Input(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(IceFloe_DataData%Input) -ENDIF -IF (ALLOCATED(IceFloe_DataData%InputTimes)) THEN - DEALLOCATE(IceFloe_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyIceFloe_Data - - SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(IceFloe_Data), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackIceFloe_Data' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL IceFloe_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL IceFloe_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL IceFloe_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL IceFloe_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL IceFloe_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL IceFloe_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL IceFloe_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL IceFloe_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL IceFloe_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL IceFloe_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL IceFloe_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL IceFloe_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL IceFloe_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - CALL IceFloe_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL IceFloe_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL IceFloe_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL IceFloe_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%Input) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL IceFloe_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_PackIceFloe_Data - - SUBROUTINE FAST_UnPackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(IceFloe_Data), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackIceFloe_Data' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceFloe_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceFloe_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceFloe_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceFloe_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceFloe_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceFloe_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceFloe_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceFloe_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceFloe_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_UnPackIceFloe_Data - - SUBROUTINE FAST_CopyMAP_Data( SrcMAP_DataData, DstMAP_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MAP_Data), INTENT(INOUT) :: SrcMAP_DataData - TYPE(MAP_Data), INTENT(INOUT) :: DstMAP_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyMAP_Data' -! - ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcMAP_DataData%x,1), UBOUND(SrcMAP_DataData%x,1) - CALL MAP_CopyContState( SrcMAP_DataData%x(i1), DstMAP_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcMAP_DataData%xd,1), UBOUND(SrcMAP_DataData%xd,1) - CALL MAP_CopyDiscState( SrcMAP_DataData%xd(i1), DstMAP_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcMAP_DataData%z,1), UBOUND(SrcMAP_DataData%z,1) - CALL MAP_CopyConstrState( SrcMAP_DataData%z(i1), DstMAP_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL MAP_CopyOtherState( SrcMAP_DataData%OtherSt, DstMAP_DataData%OtherSt, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MAP_CopyParam( SrcMAP_DataData%p, DstMAP_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MAP_CopyInput( SrcMAP_DataData%u, DstMAP_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MAP_CopyOutput( SrcMAP_DataData%y, DstMAP_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MAP_CopyOtherState( SrcMAP_DataData%OtherSt_old, DstMAP_DataData%OtherSt_old, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMAP_DataData%Output)) THEN - i1_l = LBOUND(SrcMAP_DataData%Output,1) - i1_u = UBOUND(SrcMAP_DataData%Output,1) - IF (.NOT. ALLOCATED(DstMAP_DataData%Output)) THEN - ALLOCATE(DstMAP_DataData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMAP_DataData%Output,1), UBOUND(SrcMAP_DataData%Output,1) - CALL MAP_CopyOutput( SrcMAP_DataData%Output(i1), DstMAP_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL MAP_CopyOutput( SrcMAP_DataData%y_interp, DstMAP_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMAP_DataData%Input)) THEN - i1_l = LBOUND(SrcMAP_DataData%Input,1) - i1_u = UBOUND(SrcMAP_DataData%Input,1) - IF (.NOT. ALLOCATED(DstMAP_DataData%Input)) THEN - ALLOCATE(DstMAP_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMAP_DataData%Input,1), UBOUND(SrcMAP_DataData%Input,1) - CALL MAP_CopyInput( SrcMAP_DataData%Input(i1), DstMAP_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMAP_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcMAP_DataData%InputTimes,1) - i1_u = UBOUND(SrcMAP_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstMAP_DataData%InputTimes)) THEN - ALLOCATE(DstMAP_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMAP_DataData%InputTimes = SrcMAP_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyMAP_Data - - SUBROUTINE FAST_DestroyMAP_Data( MAP_DataData, ErrStat, ErrMsg ) - TYPE(MAP_Data), INTENT(INOUT) :: MAP_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyMAP_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(MAP_DataData%x,1), UBOUND(MAP_DataData%x,1) - CALL MAP_DestroyContState( MAP_DataData%x(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(MAP_DataData%xd,1), UBOUND(MAP_DataData%xd,1) - CALL MAP_DestroyDiscState( MAP_DataData%xd(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(MAP_DataData%z,1), UBOUND(MAP_DataData%z,1) - CALL MAP_DestroyConstrState( MAP_DataData%z(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL MAP_DestroyOtherState( MAP_DataData%OtherSt, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MAP_DestroyParam( MAP_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MAP_DestroyInput( MAP_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MAP_DestroyOutput( MAP_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MAP_DestroyOtherState( MAP_DataData%OtherSt_old, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MAP_DataData%Output)) THEN -DO i1 = LBOUND(MAP_DataData%Output,1), UBOUND(MAP_DataData%Output,1) - CALL MAP_DestroyOutput( MAP_DataData%Output(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MAP_DataData%Output) -ENDIF - CALL MAP_DestroyOutput( MAP_DataData%y_interp, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MAP_DataData%Input)) THEN -DO i1 = LBOUND(MAP_DataData%Input,1), UBOUND(MAP_DataData%Input,1) - CALL MAP_DestroyInput( MAP_DataData%Input(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MAP_DataData%Input) -ENDIF -IF (ALLOCATED(MAP_DataData%InputTimes)) THEN - DEALLOCATE(MAP_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyMAP_Data - - SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MAP_Data), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackMAP_Data' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL MAP_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL MAP_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL MAP_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL MAP_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL MAP_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL MAP_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL MAP_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OtherSt_old: size of buffers for each call to pack subtype - CALL MAP_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_old, ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_old - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_old - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_old - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_old - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no - IF ( ALLOCATED(InData%Output) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype - CALL MAP_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Output - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Output - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Output - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype - CALL MAP_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_interp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_interp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_interp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL MAP_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL MAP_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL MAP_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL MAP_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - CALL MAP_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MAP_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MAP_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MAP_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MAP_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_old, ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_old - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%Output) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Output,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - CALL MAP_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL MAP_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%Input) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL MAP_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_PackMAP_Data - - SUBROUTINE FAST_UnPackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MAP_Data), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackMAP_Data' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MAP_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MAP_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MAP_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MAP_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt, ErrStat2, ErrMsg2 ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MAP_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MAP_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MAP_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MAP_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_old, ErrStat2, ErrMsg2 ) ! OtherSt_old - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Output not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Output)) DEALLOCATE(OutData%Output) - ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MAP_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MAP_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MAP_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_UnPackMAP_Data - - SUBROUTINE FAST_CopyFEAMooring_Data( SrcFEAMooring_DataData, DstFEAMooring_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FEAMooring_Data), INTENT(INOUT) :: SrcFEAMooring_DataData - TYPE(FEAMooring_Data), INTENT(INOUT) :: DstFEAMooring_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyFEAMooring_Data' -! - ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcFEAMooring_DataData%x,1), UBOUND(SrcFEAMooring_DataData%x,1) - CALL FEAM_CopyContState( SrcFEAMooring_DataData%x(i1), DstFEAMooring_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcFEAMooring_DataData%xd,1), UBOUND(SrcFEAMooring_DataData%xd,1) - CALL FEAM_CopyDiscState( SrcFEAMooring_DataData%xd(i1), DstFEAMooring_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcFEAMooring_DataData%z,1), UBOUND(SrcFEAMooring_DataData%z,1) - CALL FEAM_CopyConstrState( SrcFEAMooring_DataData%z(i1), DstFEAMooring_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcFEAMooring_DataData%OtherSt,1), UBOUND(SrcFEAMooring_DataData%OtherSt,1) - CALL FEAM_CopyOtherState( SrcFEAMooring_DataData%OtherSt(i1), DstFEAMooring_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL FEAM_CopyParam( SrcFEAMooring_DataData%p, DstFEAMooring_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FEAM_CopyInput( SrcFEAMooring_DataData%u, DstFEAMooring_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FEAM_CopyOutput( SrcFEAMooring_DataData%y, DstFEAMooring_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FEAM_CopyMisc( SrcFEAMooring_DataData%m, DstFEAMooring_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcFEAMooring_DataData%Input)) THEN - i1_l = LBOUND(SrcFEAMooring_DataData%Input,1) - i1_u = UBOUND(SrcFEAMooring_DataData%Input,1) - IF (.NOT. ALLOCATED(DstFEAMooring_DataData%Input)) THEN - ALLOCATE(DstFEAMooring_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFEAMooring_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcFEAMooring_DataData%Input,1), UBOUND(SrcFEAMooring_DataData%Input,1) - CALL FEAM_CopyInput( SrcFEAMooring_DataData%Input(i1), DstFEAMooring_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcFEAMooring_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcFEAMooring_DataData%InputTimes,1) - i1_u = UBOUND(SrcFEAMooring_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstFEAMooring_DataData%InputTimes)) THEN - ALLOCATE(DstFEAMooring_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFEAMooring_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstFEAMooring_DataData%InputTimes = SrcFEAMooring_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyFEAMooring_Data - - SUBROUTINE FAST_DestroyFEAMooring_Data( FEAMooring_DataData, ErrStat, ErrMsg ) - TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAMooring_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyFEAMooring_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(FEAMooring_DataData%x,1), UBOUND(FEAMooring_DataData%x,1) - CALL FEAM_DestroyContState( FEAMooring_DataData%x(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(FEAMooring_DataData%xd,1), UBOUND(FEAMooring_DataData%xd,1) - CALL FEAM_DestroyDiscState( FEAMooring_DataData%xd(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(FEAMooring_DataData%z,1), UBOUND(FEAMooring_DataData%z,1) - CALL FEAM_DestroyConstrState( FEAMooring_DataData%z(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(FEAMooring_DataData%OtherSt,1), UBOUND(FEAMooring_DataData%OtherSt,1) - CALL FEAM_DestroyOtherState( FEAMooring_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL FEAM_DestroyParam( FEAMooring_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FEAM_DestroyInput( FEAMooring_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FEAM_DestroyOutput( FEAMooring_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FEAM_DestroyMisc( FEAMooring_DataData%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(FEAMooring_DataData%Input)) THEN -DO i1 = LBOUND(FEAMooring_DataData%Input,1), UBOUND(FEAMooring_DataData%Input,1) - CALL FEAM_DestroyInput( FEAMooring_DataData%Input(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(FEAMooring_DataData%Input) -ENDIF -IF (ALLOCATED(FEAMooring_DataData%InputTimes)) THEN - DEALLOCATE(FEAMooring_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyFEAMooring_Data - - SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FEAMooring_Data), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackFEAMooring_Data' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL FEAM_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL FEAM_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL FEAM_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL FEAM_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL FEAM_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL FEAM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL FEAM_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL FEAM_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL FEAM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL FEAM_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL FEAM_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL FEAM_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL FEAM_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - CALL FEAM_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL FEAM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL FEAM_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL FEAM_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%Input) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL FEAM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_PackFEAMooring_Data - - SUBROUTINE FAST_UnPackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FEAMooring_Data), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackFEAMooring_Data' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FEAM_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FEAM_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FEAM_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FEAM_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FEAM_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FEAM_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FEAM_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FEAM_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FEAM_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_UnPackFEAMooring_Data - - SUBROUTINE FAST_CopyMoorDyn_Data( SrcMoorDyn_DataData, DstMoorDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MoorDyn_Data), INTENT(INOUT) :: SrcMoorDyn_DataData - TYPE(MoorDyn_Data), INTENT(INOUT) :: DstMoorDyn_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyMoorDyn_Data' -! - ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcMoorDyn_DataData%x,1), UBOUND(SrcMoorDyn_DataData%x,1) - CALL MD_CopyContState( SrcMoorDyn_DataData%x(i1), DstMoorDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcMoorDyn_DataData%xd,1), UBOUND(SrcMoorDyn_DataData%xd,1) - CALL MD_CopyDiscState( SrcMoorDyn_DataData%xd(i1), DstMoorDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcMoorDyn_DataData%z,1), UBOUND(SrcMoorDyn_DataData%z,1) - CALL MD_CopyConstrState( SrcMoorDyn_DataData%z(i1), DstMoorDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcMoorDyn_DataData%OtherSt,1), UBOUND(SrcMoorDyn_DataData%OtherSt,1) - CALL MD_CopyOtherState( SrcMoorDyn_DataData%OtherSt(i1), DstMoorDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL MD_CopyParam( SrcMoorDyn_DataData%p, DstMoorDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MD_CopyInput( SrcMoorDyn_DataData%u, DstMoorDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MD_CopyOutput( SrcMoorDyn_DataData%y, DstMoorDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MD_CopyMisc( SrcMoorDyn_DataData%m, DstMoorDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMoorDyn_DataData%Output)) THEN - i1_l = LBOUND(SrcMoorDyn_DataData%Output,1) - i1_u = UBOUND(SrcMoorDyn_DataData%Output,1) - IF (.NOT. ALLOCATED(DstMoorDyn_DataData%Output)) THEN - ALLOCATE(DstMoorDyn_DataData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMoorDyn_DataData%Output,1), UBOUND(SrcMoorDyn_DataData%Output,1) - CALL MD_CopyOutput( SrcMoorDyn_DataData%Output(i1), DstMoorDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL MD_CopyOutput( SrcMoorDyn_DataData%y_interp, DstMoorDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMoorDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcMoorDyn_DataData%Input,1) - i1_u = UBOUND(SrcMoorDyn_DataData%Input,1) - IF (.NOT. ALLOCATED(DstMoorDyn_DataData%Input)) THEN - ALLOCATE(DstMoorDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMoorDyn_DataData%Input,1), UBOUND(SrcMoorDyn_DataData%Input,1) - CALL MD_CopyInput( SrcMoorDyn_DataData%Input(i1), DstMoorDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMoorDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcMoorDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcMoorDyn_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstMoorDyn_DataData%InputTimes)) THEN - ALLOCATE(DstMoorDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMoorDyn_DataData%InputTimes = SrcMoorDyn_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyMoorDyn_Data - - SUBROUTINE FAST_DestroyMoorDyn_Data( MoorDyn_DataData, ErrStat, ErrMsg ) - TYPE(MoorDyn_Data), INTENT(INOUT) :: MoorDyn_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyMoorDyn_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(MoorDyn_DataData%x,1), UBOUND(MoorDyn_DataData%x,1) - CALL MD_DestroyContState( MoorDyn_DataData%x(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(MoorDyn_DataData%xd,1), UBOUND(MoorDyn_DataData%xd,1) - CALL MD_DestroyDiscState( MoorDyn_DataData%xd(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(MoorDyn_DataData%z,1), UBOUND(MoorDyn_DataData%z,1) - CALL MD_DestroyConstrState( MoorDyn_DataData%z(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(MoorDyn_DataData%OtherSt,1), UBOUND(MoorDyn_DataData%OtherSt,1) - CALL MD_DestroyOtherState( MoorDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL MD_DestroyParam( MoorDyn_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyInput( MoorDyn_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyOutput( MoorDyn_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyMisc( MoorDyn_DataData%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MoorDyn_DataData%Output)) THEN -DO i1 = LBOUND(MoorDyn_DataData%Output,1), UBOUND(MoorDyn_DataData%Output,1) - CALL MD_DestroyOutput( MoorDyn_DataData%Output(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MoorDyn_DataData%Output) -ENDIF - CALL MD_DestroyOutput( MoorDyn_DataData%y_interp, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MoorDyn_DataData%Input)) THEN -DO i1 = LBOUND(MoorDyn_DataData%Input,1), UBOUND(MoorDyn_DataData%Input,1) - CALL MD_DestroyInput( MoorDyn_DataData%Input(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MoorDyn_DataData%Input) -ENDIF -IF (ALLOCATED(MoorDyn_DataData%InputTimes)) THEN - DEALLOCATE(MoorDyn_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyMoorDyn_Data - - SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MoorDyn_Data), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackMoorDyn_Data' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL MD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL MD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL MD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL MD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL MD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL MD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no - IF ( ALLOCATED(InData%Output) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype - CALL MD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Output - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Output - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Output - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype - CALL MD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_interp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_interp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_interp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL MD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL MD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL MD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - CALL MD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%Output) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Output,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - CALL MD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL MD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%Input) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_PackMoorDyn_Data - - SUBROUTINE FAST_UnPackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MoorDyn_Data), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackMoorDyn_Data' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Output not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Output)) DEALLOCATE(OutData%Output) - ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_UnPackMoorDyn_Data - - SUBROUTINE FAST_CopyOrcaFlex_Data( SrcOrcaFlex_DataData, DstOrcaFlex_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(OrcaFlex_Data), INTENT(INOUT) :: SrcOrcaFlex_DataData - TYPE(OrcaFlex_Data), INTENT(INOUT) :: DstOrcaFlex_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyOrcaFlex_Data' -! - ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcOrcaFlex_DataData%x,1), UBOUND(SrcOrcaFlex_DataData%x,1) - CALL Orca_CopyContState( SrcOrcaFlex_DataData%x(i1), DstOrcaFlex_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcOrcaFlex_DataData%xd,1), UBOUND(SrcOrcaFlex_DataData%xd,1) - CALL Orca_CopyDiscState( SrcOrcaFlex_DataData%xd(i1), DstOrcaFlex_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcOrcaFlex_DataData%z,1), UBOUND(SrcOrcaFlex_DataData%z,1) - CALL Orca_CopyConstrState( SrcOrcaFlex_DataData%z(i1), DstOrcaFlex_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcOrcaFlex_DataData%OtherSt,1), UBOUND(SrcOrcaFlex_DataData%OtherSt,1) - CALL Orca_CopyOtherState( SrcOrcaFlex_DataData%OtherSt(i1), DstOrcaFlex_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL Orca_CopyParam( SrcOrcaFlex_DataData%p, DstOrcaFlex_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Orca_CopyInput( SrcOrcaFlex_DataData%u, DstOrcaFlex_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Orca_CopyOutput( SrcOrcaFlex_DataData%y, DstOrcaFlex_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Orca_CopyMisc( SrcOrcaFlex_DataData%m, DstOrcaFlex_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcOrcaFlex_DataData%Input)) THEN - i1_l = LBOUND(SrcOrcaFlex_DataData%Input,1) - i1_u = UBOUND(SrcOrcaFlex_DataData%Input,1) - IF (.NOT. ALLOCATED(DstOrcaFlex_DataData%Input)) THEN - ALLOCATE(DstOrcaFlex_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOrcaFlex_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOrcaFlex_DataData%Input,1), UBOUND(SrcOrcaFlex_DataData%Input,1) - CALL Orca_CopyInput( SrcOrcaFlex_DataData%Input(i1), DstOrcaFlex_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcOrcaFlex_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcOrcaFlex_DataData%InputTimes,1) - i1_u = UBOUND(SrcOrcaFlex_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstOrcaFlex_DataData%InputTimes)) THEN - ALLOCATE(DstOrcaFlex_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOrcaFlex_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOrcaFlex_DataData%InputTimes = SrcOrcaFlex_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyOrcaFlex_Data - - SUBROUTINE FAST_DestroyOrcaFlex_Data( OrcaFlex_DataData, ErrStat, ErrMsg ) - TYPE(OrcaFlex_Data), INTENT(INOUT) :: OrcaFlex_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyOrcaFlex_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(OrcaFlex_DataData%x,1), UBOUND(OrcaFlex_DataData%x,1) - CALL Orca_DestroyContState( OrcaFlex_DataData%x(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(OrcaFlex_DataData%xd,1), UBOUND(OrcaFlex_DataData%xd,1) - CALL Orca_DestroyDiscState( OrcaFlex_DataData%xd(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(OrcaFlex_DataData%z,1), UBOUND(OrcaFlex_DataData%z,1) - CALL Orca_DestroyConstrState( OrcaFlex_DataData%z(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(OrcaFlex_DataData%OtherSt,1), UBOUND(OrcaFlex_DataData%OtherSt,1) - CALL Orca_DestroyOtherState( OrcaFlex_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL Orca_DestroyParam( OrcaFlex_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Orca_DestroyInput( OrcaFlex_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Orca_DestroyOutput( OrcaFlex_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Orca_DestroyMisc( OrcaFlex_DataData%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(OrcaFlex_DataData%Input)) THEN -DO i1 = LBOUND(OrcaFlex_DataData%Input,1), UBOUND(OrcaFlex_DataData%Input,1) - CALL Orca_DestroyInput( OrcaFlex_DataData%Input(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OrcaFlex_DataData%Input) -ENDIF -IF (ALLOCATED(OrcaFlex_DataData%InputTimes)) THEN - DEALLOCATE(OrcaFlex_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyOrcaFlex_Data - - SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(OrcaFlex_Data), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackOrcaFlex_Data' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL Orca_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL Orca_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL Orca_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL Orca_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL Orca_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL Orca_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL Orca_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL Orca_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL Orca_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL Orca_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL Orca_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL Orca_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL Orca_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - CALL Orca_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL Orca_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL Orca_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL Orca_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%Input) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL Orca_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) - DbKiBuf(Db_Xferred) = InData%InputTimes(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_PackOrcaFlex_Data - - SUBROUTINE FAST_UnPackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(OrcaFlex_Data), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackOrcaFlex_Data' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Orca_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Orca_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Orca_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Orca_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Orca_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Orca_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Orca_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Orca_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Orca_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) - OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE FAST_UnPackOrcaFlex_Data - - SUBROUTINE FAST_CopyModuleMapType( SrcModuleMapTypeData, DstModuleMapTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: SrcModuleMapTypeData - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: DstModuleMapTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyModuleMapType' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcModuleMapTypeData%ED_P_2_BD_P)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%ED_P_2_BD_P,1) - i1_u = UBOUND(SrcModuleMapTypeData%ED_P_2_BD_P,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%ED_P_2_BD_P)) THEN - ALLOCATE(DstModuleMapTypeData%ED_P_2_BD_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_P_2_BD_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%ED_P_2_BD_P,1), UBOUND(SrcModuleMapTypeData%ED_P_2_BD_P,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_BD_P(i1), DstModuleMapTypeData%ED_P_2_BD_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%BD_P_2_ED_P)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%BD_P_2_ED_P,1) - i1_u = UBOUND(SrcModuleMapTypeData%BD_P_2_ED_P,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%BD_P_2_ED_P)) THEN - ALLOCATE(DstModuleMapTypeData%BD_P_2_ED_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BD_P_2_ED_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%BD_P_2_ED_P,1), UBOUND(SrcModuleMapTypeData%BD_P_2_ED_P,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%BD_P_2_ED_P(i1), DstModuleMapTypeData%BD_P_2_ED_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%ED_P_2_BD_P_Hub)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%ED_P_2_BD_P_Hub,1) - i1_u = UBOUND(SrcModuleMapTypeData%ED_P_2_BD_P_Hub,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%ED_P_2_BD_P_Hub)) THEN - ALLOCATE(DstModuleMapTypeData%ED_P_2_BD_P_Hub(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_P_2_BD_P_Hub.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%ED_P_2_BD_P_Hub,1), UBOUND(SrcModuleMapTypeData%ED_P_2_BD_P_Hub,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_BD_P_Hub(i1), DstModuleMapTypeData%ED_P_2_BD_P_Hub(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_HD_PRP_P, DstModuleMapTypeData%ED_P_2_HD_PRP_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SubStructure_2_HD_W_P, DstModuleMapTypeData%SubStructure_2_HD_W_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%HD_W_P_2_SubStructure, DstModuleMapTypeData%HD_W_P_2_SubStructure, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SubStructure_2_HD_M_P, DstModuleMapTypeData%SubStructure_2_HD_M_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%HD_M_P_2_SubStructure, DstModuleMapTypeData%HD_M_P_2_SubStructure, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%Structure_2_Mooring, DstModuleMapTypeData%Structure_2_Mooring, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%Mooring_2_Structure, DstModuleMapTypeData%Mooring_2_Structure, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_SD_TP, DstModuleMapTypeData%ED_P_2_SD_TP, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SD_TP_2_ED_P, DstModuleMapTypeData%SD_TP_2_ED_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcModuleMapTypeData%ED_P_2_NStC_P_N)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%ED_P_2_NStC_P_N,1) - i1_u = UBOUND(SrcModuleMapTypeData%ED_P_2_NStC_P_N,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%ED_P_2_NStC_P_N)) THEN - ALLOCATE(DstModuleMapTypeData%ED_P_2_NStC_P_N(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_P_2_NStC_P_N.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%ED_P_2_NStC_P_N,1), UBOUND(SrcModuleMapTypeData%ED_P_2_NStC_P_N,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_NStC_P_N(i1), DstModuleMapTypeData%ED_P_2_NStC_P_N(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%NStC_P_2_ED_P_N)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%NStC_P_2_ED_P_N,1) - i1_u = UBOUND(SrcModuleMapTypeData%NStC_P_2_ED_P_N,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%NStC_P_2_ED_P_N)) THEN - ALLOCATE(DstModuleMapTypeData%NStC_P_2_ED_P_N(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%NStC_P_2_ED_P_N.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%NStC_P_2_ED_P_N,1), UBOUND(SrcModuleMapTypeData%NStC_P_2_ED_P_N,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%NStC_P_2_ED_P_N(i1), DstModuleMapTypeData%NStC_P_2_ED_P_N(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%ED_L_2_TStC_P_T)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%ED_L_2_TStC_P_T,1) - i1_u = UBOUND(SrcModuleMapTypeData%ED_L_2_TStC_P_T,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%ED_L_2_TStC_P_T)) THEN - ALLOCATE(DstModuleMapTypeData%ED_L_2_TStC_P_T(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_L_2_TStC_P_T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%ED_L_2_TStC_P_T,1), UBOUND(SrcModuleMapTypeData%ED_L_2_TStC_P_T,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_L_2_TStC_P_T(i1), DstModuleMapTypeData%ED_L_2_TStC_P_T(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%TStC_P_2_ED_P_T)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%TStC_P_2_ED_P_T,1) - i1_u = UBOUND(SrcModuleMapTypeData%TStC_P_2_ED_P_T,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%TStC_P_2_ED_P_T)) THEN - ALLOCATE(DstModuleMapTypeData%TStC_P_2_ED_P_T(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%TStC_P_2_ED_P_T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%TStC_P_2_ED_P_T,1), UBOUND(SrcModuleMapTypeData%TStC_P_2_ED_P_T,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%TStC_P_2_ED_P_T(i1), DstModuleMapTypeData%TStC_P_2_ED_P_T(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%ED_L_2_BStC_P_B)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%ED_L_2_BStC_P_B,1) - i1_u = UBOUND(SrcModuleMapTypeData%ED_L_2_BStC_P_B,1) - i2_l = LBOUND(SrcModuleMapTypeData%ED_L_2_BStC_P_B,2) - i2_u = UBOUND(SrcModuleMapTypeData%ED_L_2_BStC_P_B,2) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%ED_L_2_BStC_P_B)) THEN - ALLOCATE(DstModuleMapTypeData%ED_L_2_BStC_P_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_L_2_BStC_P_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcModuleMapTypeData%ED_L_2_BStC_P_B,2), UBOUND(SrcModuleMapTypeData%ED_L_2_BStC_P_B,2) - DO i1 = LBOUND(SrcModuleMapTypeData%ED_L_2_BStC_P_B,1), UBOUND(SrcModuleMapTypeData%ED_L_2_BStC_P_B,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_L_2_BStC_P_B(i1,i2), DstModuleMapTypeData%ED_L_2_BStC_P_B(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%BStC_P_2_ED_P_B)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%BStC_P_2_ED_P_B,1) - i1_u = UBOUND(SrcModuleMapTypeData%BStC_P_2_ED_P_B,1) - i2_l = LBOUND(SrcModuleMapTypeData%BStC_P_2_ED_P_B,2) - i2_u = UBOUND(SrcModuleMapTypeData%BStC_P_2_ED_P_B,2) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%BStC_P_2_ED_P_B)) THEN - ALLOCATE(DstModuleMapTypeData%BStC_P_2_ED_P_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BStC_P_2_ED_P_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcModuleMapTypeData%BStC_P_2_ED_P_B,2), UBOUND(SrcModuleMapTypeData%BStC_P_2_ED_P_B,2) - DO i1 = LBOUND(SrcModuleMapTypeData%BStC_P_2_ED_P_B,1), UBOUND(SrcModuleMapTypeData%BStC_P_2_ED_P_B,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%BStC_P_2_ED_P_B(i1,i2), DstModuleMapTypeData%BStC_P_2_ED_P_B(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%BD_L_2_BStC_P_B)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%BD_L_2_BStC_P_B,1) - i1_u = UBOUND(SrcModuleMapTypeData%BD_L_2_BStC_P_B,1) - i2_l = LBOUND(SrcModuleMapTypeData%BD_L_2_BStC_P_B,2) - i2_u = UBOUND(SrcModuleMapTypeData%BD_L_2_BStC_P_B,2) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%BD_L_2_BStC_P_B)) THEN - ALLOCATE(DstModuleMapTypeData%BD_L_2_BStC_P_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BD_L_2_BStC_P_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcModuleMapTypeData%BD_L_2_BStC_P_B,2), UBOUND(SrcModuleMapTypeData%BD_L_2_BStC_P_B,2) - DO i1 = LBOUND(SrcModuleMapTypeData%BD_L_2_BStC_P_B,1), UBOUND(SrcModuleMapTypeData%BD_L_2_BStC_P_B,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%BD_L_2_BStC_P_B(i1,i2), DstModuleMapTypeData%BD_L_2_BStC_P_B(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%BStC_P_2_BD_P_B)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%BStC_P_2_BD_P_B,1) - i1_u = UBOUND(SrcModuleMapTypeData%BStC_P_2_BD_P_B,1) - i2_l = LBOUND(SrcModuleMapTypeData%BStC_P_2_BD_P_B,2) - i2_u = UBOUND(SrcModuleMapTypeData%BStC_P_2_BD_P_B,2) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%BStC_P_2_BD_P_B)) THEN - ALLOCATE(DstModuleMapTypeData%BStC_P_2_BD_P_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BStC_P_2_BD_P_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcModuleMapTypeData%BStC_P_2_BD_P_B,2), UBOUND(SrcModuleMapTypeData%BStC_P_2_BD_P_B,2) - DO i1 = LBOUND(SrcModuleMapTypeData%BStC_P_2_BD_P_B,1), UBOUND(SrcModuleMapTypeData%BStC_P_2_BD_P_B,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%BStC_P_2_BD_P_B(i1,i2), DstModuleMapTypeData%BStC_P_2_BD_P_B(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%SStC_P_P_2_SubStructure)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%SStC_P_P_2_SubStructure,1) - i1_u = UBOUND(SrcModuleMapTypeData%SStC_P_P_2_SubStructure,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%SStC_P_P_2_SubStructure)) THEN - ALLOCATE(DstModuleMapTypeData%SStC_P_P_2_SubStructure(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%SStC_P_P_2_SubStructure.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%SStC_P_P_2_SubStructure,1), UBOUND(SrcModuleMapTypeData%SStC_P_P_2_SubStructure,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SStC_P_P_2_SubStructure(i1), DstModuleMapTypeData%SStC_P_P_2_SubStructure(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%SubStructure_2_SStC_P_P)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%SubStructure_2_SStC_P_P,1) - i1_u = UBOUND(SrcModuleMapTypeData%SubStructure_2_SStC_P_P,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%SubStructure_2_SStC_P_P)) THEN - ALLOCATE(DstModuleMapTypeData%SubStructure_2_SStC_P_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%SubStructure_2_SStC_P_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%SubStructure_2_SStC_P_P,1), UBOUND(SrcModuleMapTypeData%SubStructure_2_SStC_P_P,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SubStructure_2_SStC_P_P(i1), DstModuleMapTypeData%SubStructure_2_SStC_P_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_SrvD_P_P, DstModuleMapTypeData%ED_P_2_SrvD_P_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcModuleMapTypeData%BDED_L_2_AD_L_B)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%BDED_L_2_AD_L_B,1) - i1_u = UBOUND(SrcModuleMapTypeData%BDED_L_2_AD_L_B,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%BDED_L_2_AD_L_B)) THEN - ALLOCATE(DstModuleMapTypeData%BDED_L_2_AD_L_B(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BDED_L_2_AD_L_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%BDED_L_2_AD_L_B,1), UBOUND(SrcModuleMapTypeData%BDED_L_2_AD_L_B,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%BDED_L_2_AD_L_B(i1), DstModuleMapTypeData%BDED_L_2_AD_L_B(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%AD_L_2_BDED_B)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%AD_L_2_BDED_B,1) - i1_u = UBOUND(SrcModuleMapTypeData%AD_L_2_BDED_B,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%AD_L_2_BDED_B)) THEN - ALLOCATE(DstModuleMapTypeData%AD_L_2_BDED_B(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%AD_L_2_BDED_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%AD_L_2_BDED_B,1), UBOUND(SrcModuleMapTypeData%AD_L_2_BDED_B,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%AD_L_2_BDED_B(i1), DstModuleMapTypeData%AD_L_2_BDED_B(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%BD_L_2_BD_L)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%BD_L_2_BD_L,1) - i1_u = UBOUND(SrcModuleMapTypeData%BD_L_2_BD_L,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%BD_L_2_BD_L)) THEN - ALLOCATE(DstModuleMapTypeData%BD_L_2_BD_L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BD_L_2_BD_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%BD_L_2_BD_L,1), UBOUND(SrcModuleMapTypeData%BD_L_2_BD_L,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%BD_L_2_BD_L(i1), DstModuleMapTypeData%BD_L_2_BD_L(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_AD_P_N, DstModuleMapTypeData%ED_P_2_AD_P_N, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%AD_P_2_ED_P_N, DstModuleMapTypeData%AD_P_2_ED_P_N, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_AD_P_TF, DstModuleMapTypeData%ED_P_2_AD_P_TF, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%AD_P_2_ED_P_TF, DstModuleMapTypeData%AD_P_2_ED_P_TF, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_L_2_AD_L_T, DstModuleMapTypeData%ED_L_2_AD_L_T, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%AD_L_2_ED_P_T, DstModuleMapTypeData%AD_L_2_ED_P_T, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcModuleMapTypeData%ED_P_2_AD_P_R)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%ED_P_2_AD_P_R,1) - i1_u = UBOUND(SrcModuleMapTypeData%ED_P_2_AD_P_R,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%ED_P_2_AD_P_R)) THEN - ALLOCATE(DstModuleMapTypeData%ED_P_2_AD_P_R(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_P_2_AD_P_R.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%ED_P_2_AD_P_R,1), UBOUND(SrcModuleMapTypeData%ED_P_2_AD_P_R,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_AD_P_R(i1), DstModuleMapTypeData%ED_P_2_AD_P_R(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_AD_P_H, DstModuleMapTypeData%ED_P_2_AD_P_H, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%AD_P_2_ED_P_H, DstModuleMapTypeData%AD_P_2_ED_P_H, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%IceF_P_2_SD_P, DstModuleMapTypeData%IceF_P_2_SD_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SDy3_P_2_IceF_P, DstModuleMapTypeData%SDy3_P_2_IceF_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcModuleMapTypeData%IceD_P_2_SD_P)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%IceD_P_2_SD_P,1) - i1_u = UBOUND(SrcModuleMapTypeData%IceD_P_2_SD_P,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%IceD_P_2_SD_P)) THEN - ALLOCATE(DstModuleMapTypeData%IceD_P_2_SD_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%IceD_P_2_SD_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%IceD_P_2_SD_P,1), UBOUND(SrcModuleMapTypeData%IceD_P_2_SD_P,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%IceD_P_2_SD_P(i1), DstModuleMapTypeData%IceD_P_2_SD_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%SDy3_P_2_IceD_P)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%SDy3_P_2_IceD_P,1) - i1_u = UBOUND(SrcModuleMapTypeData%SDy3_P_2_IceD_P,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%SDy3_P_2_IceD_P)) THEN - ALLOCATE(DstModuleMapTypeData%SDy3_P_2_IceD_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%SDy3_P_2_IceD_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%SDy3_P_2_IceD_P,1), UBOUND(SrcModuleMapTypeData%SDy3_P_2_IceD_P,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SDy3_P_2_IceD_P(i1), DstModuleMapTypeData%SDy3_P_2_IceD_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%Jacobian_Opt1)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%Jacobian_Opt1,1) - i1_u = UBOUND(SrcModuleMapTypeData%Jacobian_Opt1,1) - i2_l = LBOUND(SrcModuleMapTypeData%Jacobian_Opt1,2) - i2_u = UBOUND(SrcModuleMapTypeData%Jacobian_Opt1,2) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%Jacobian_Opt1)) THEN - ALLOCATE(DstModuleMapTypeData%Jacobian_Opt1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%Jacobian_Opt1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstModuleMapTypeData%Jacobian_Opt1 = SrcModuleMapTypeData%Jacobian_Opt1 -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%Jacobian_pivot)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%Jacobian_pivot,1) - i1_u = UBOUND(SrcModuleMapTypeData%Jacobian_pivot,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%Jacobian_pivot)) THEN - ALLOCATE(DstModuleMapTypeData%Jacobian_pivot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%Jacobian_pivot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstModuleMapTypeData%Jacobian_pivot = SrcModuleMapTypeData%Jacobian_pivot -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%Jac_u_indx)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%Jac_u_indx,1) - i1_u = UBOUND(SrcModuleMapTypeData%Jac_u_indx,1) - i2_l = LBOUND(SrcModuleMapTypeData%Jac_u_indx,2) - i2_u = UBOUND(SrcModuleMapTypeData%Jac_u_indx,2) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%Jac_u_indx)) THEN - ALLOCATE(DstModuleMapTypeData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstModuleMapTypeData%Jac_u_indx = SrcModuleMapTypeData%Jac_u_indx -ENDIF - CALL MeshCopy( SrcModuleMapTypeData%u_ED_NacelleLoads, DstModuleMapTypeData%u_ED_NacelleLoads, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%SubstructureLoads_Tmp, DstModuleMapTypeData%SubstructureLoads_Tmp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%SubstructureLoads_Tmp2, DstModuleMapTypeData%SubstructureLoads_Tmp2, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%PlatformLoads_Tmp, DstModuleMapTypeData%PlatformLoads_Tmp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%PlatformLoads_Tmp2, DstModuleMapTypeData%PlatformLoads_Tmp2, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%SubstructureLoads_Tmp_Farm, DstModuleMapTypeData%SubstructureLoads_Tmp_Farm, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_ED_TowerPtloads, DstModuleMapTypeData%u_ED_TowerPtloads, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcModuleMapTypeData%u_ED_BladePtLoads)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%u_ED_BladePtLoads,1) - i1_u = UBOUND(SrcModuleMapTypeData%u_ED_BladePtLoads,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%u_ED_BladePtLoads)) THEN - ALLOCATE(DstModuleMapTypeData%u_ED_BladePtLoads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_ED_BladePtLoads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%u_ED_BladePtLoads,1), UBOUND(SrcModuleMapTypeData%u_ED_BladePtLoads,1) - CALL MeshCopy( SrcModuleMapTypeData%u_ED_BladePtLoads(i1), DstModuleMapTypeData%u_ED_BladePtLoads(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL MeshCopy( SrcModuleMapTypeData%u_SD_TPMesh, DstModuleMapTypeData%u_SD_TPMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_HD_M_Mesh, DstModuleMapTypeData%u_HD_M_Mesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_HD_W_Mesh, DstModuleMapTypeData%u_HD_W_Mesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_ED_HubPtLoad, DstModuleMapTypeData%u_ED_HubPtLoad, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_ED_HubPtLoad_2, DstModuleMapTypeData%u_ED_HubPtLoad_2, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcModuleMapTypeData%u_BD_RootMotion)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%u_BD_RootMotion,1) - i1_u = UBOUND(SrcModuleMapTypeData%u_BD_RootMotion,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%u_BD_RootMotion)) THEN - ALLOCATE(DstModuleMapTypeData%u_BD_RootMotion(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_BD_RootMotion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%u_BD_RootMotion,1), UBOUND(SrcModuleMapTypeData%u_BD_RootMotion,1) - CALL MeshCopy( SrcModuleMapTypeData%u_BD_RootMotion(i1), DstModuleMapTypeData%u_BD_RootMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%y_BD_BldMotion_4Loads)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%y_BD_BldMotion_4Loads,1) - i1_u = UBOUND(SrcModuleMapTypeData%y_BD_BldMotion_4Loads,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%y_BD_BldMotion_4Loads)) THEN - ALLOCATE(DstModuleMapTypeData%y_BD_BldMotion_4Loads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%y_BD_BldMotion_4Loads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%y_BD_BldMotion_4Loads,1), UBOUND(SrcModuleMapTypeData%y_BD_BldMotion_4Loads,1) - CALL MeshCopy( SrcModuleMapTypeData%y_BD_BldMotion_4Loads(i1), DstModuleMapTypeData%y_BD_BldMotion_4Loads(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%u_BD_Distrload)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%u_BD_Distrload,1) - i1_u = UBOUND(SrcModuleMapTypeData%u_BD_Distrload,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%u_BD_Distrload)) THEN - ALLOCATE(DstModuleMapTypeData%u_BD_Distrload(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_BD_Distrload.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%u_BD_Distrload,1), UBOUND(SrcModuleMapTypeData%u_BD_Distrload,1) - CALL MeshCopy( SrcModuleMapTypeData%u_BD_Distrload(i1), DstModuleMapTypeData%u_BD_Distrload(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL MeshCopy( SrcModuleMapTypeData%u_Orca_PtfmMesh, DstModuleMapTypeData%u_Orca_PtfmMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_ExtPtfm_PtfmMesh, DstModuleMapTypeData%u_ExtPtfm_PtfmMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE FAST_CopyModuleMapType - - SUBROUTINE FAST_DestroyModuleMapType( ModuleMapTypeData, ErrStat, ErrMsg ) - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: ModuleMapTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyModuleMapType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ModuleMapTypeData%ED_P_2_BD_P)) THEN -DO i1 = LBOUND(ModuleMapTypeData%ED_P_2_BD_P,1), UBOUND(ModuleMapTypeData%ED_P_2_BD_P,1) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_P_2_BD_P(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%ED_P_2_BD_P) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%BD_P_2_ED_P)) THEN -DO i1 = LBOUND(ModuleMapTypeData%BD_P_2_ED_P,1), UBOUND(ModuleMapTypeData%BD_P_2_ED_P,1) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%BD_P_2_ED_P(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%BD_P_2_ED_P) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%ED_P_2_BD_P_Hub)) THEN -DO i1 = LBOUND(ModuleMapTypeData%ED_P_2_BD_P_Hub,1), UBOUND(ModuleMapTypeData%ED_P_2_BD_P_Hub,1) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_P_2_BD_P_Hub(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%ED_P_2_BD_P_Hub) -ENDIF - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_P_2_HD_PRP_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%SubStructure_2_HD_W_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%HD_W_P_2_SubStructure, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%SubStructure_2_HD_M_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%HD_M_P_2_SubStructure, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%Structure_2_Mooring, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%Mooring_2_Structure, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%SD_TP_2_ED_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ModuleMapTypeData%ED_P_2_NStC_P_N)) THEN -DO i1 = LBOUND(ModuleMapTypeData%ED_P_2_NStC_P_N,1), UBOUND(ModuleMapTypeData%ED_P_2_NStC_P_N,1) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_P_2_NStC_P_N(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%ED_P_2_NStC_P_N) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%NStC_P_2_ED_P_N)) THEN -DO i1 = LBOUND(ModuleMapTypeData%NStC_P_2_ED_P_N,1), UBOUND(ModuleMapTypeData%NStC_P_2_ED_P_N,1) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%NStC_P_2_ED_P_N(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%NStC_P_2_ED_P_N) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%ED_L_2_TStC_P_T)) THEN -DO i1 = LBOUND(ModuleMapTypeData%ED_L_2_TStC_P_T,1), UBOUND(ModuleMapTypeData%ED_L_2_TStC_P_T,1) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_L_2_TStC_P_T(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%ED_L_2_TStC_P_T) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%TStC_P_2_ED_P_T)) THEN -DO i1 = LBOUND(ModuleMapTypeData%TStC_P_2_ED_P_T,1), UBOUND(ModuleMapTypeData%TStC_P_2_ED_P_T,1) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%TStC_P_2_ED_P_T(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%TStC_P_2_ED_P_T) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%ED_L_2_BStC_P_B)) THEN -DO i2 = LBOUND(ModuleMapTypeData%ED_L_2_BStC_P_B,2), UBOUND(ModuleMapTypeData%ED_L_2_BStC_P_B,2) -DO i1 = LBOUND(ModuleMapTypeData%ED_L_2_BStC_P_B,1), UBOUND(ModuleMapTypeData%ED_L_2_BStC_P_B,1) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(ModuleMapTypeData%ED_L_2_BStC_P_B) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%BStC_P_2_ED_P_B)) THEN -DO i2 = LBOUND(ModuleMapTypeData%BStC_P_2_ED_P_B,2), UBOUND(ModuleMapTypeData%BStC_P_2_ED_P_B,2) -DO i1 = LBOUND(ModuleMapTypeData%BStC_P_2_ED_P_B,1), UBOUND(ModuleMapTypeData%BStC_P_2_ED_P_B,1) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%BStC_P_2_ED_P_B(i1,i2), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(ModuleMapTypeData%BStC_P_2_ED_P_B) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%BD_L_2_BStC_P_B)) THEN -DO i2 = LBOUND(ModuleMapTypeData%BD_L_2_BStC_P_B,2), UBOUND(ModuleMapTypeData%BD_L_2_BStC_P_B,2) -DO i1 = LBOUND(ModuleMapTypeData%BD_L_2_BStC_P_B,1), UBOUND(ModuleMapTypeData%BD_L_2_BStC_P_B,1) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%BD_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(ModuleMapTypeData%BD_L_2_BStC_P_B) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%BStC_P_2_BD_P_B)) THEN -DO i2 = LBOUND(ModuleMapTypeData%BStC_P_2_BD_P_B,2), UBOUND(ModuleMapTypeData%BStC_P_2_BD_P_B,2) -DO i1 = LBOUND(ModuleMapTypeData%BStC_P_2_BD_P_B,1), UBOUND(ModuleMapTypeData%BStC_P_2_BD_P_B,1) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%BStC_P_2_BD_P_B(i1,i2), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(ModuleMapTypeData%BStC_P_2_BD_P_B) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%SStC_P_P_2_SubStructure)) THEN -DO i1 = LBOUND(ModuleMapTypeData%SStC_P_P_2_SubStructure,1), UBOUND(ModuleMapTypeData%SStC_P_P_2_SubStructure,1) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%SStC_P_P_2_SubStructure(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%SStC_P_P_2_SubStructure) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%SubStructure_2_SStC_P_P)) THEN -DO i1 = LBOUND(ModuleMapTypeData%SubStructure_2_SStC_P_P,1), UBOUND(ModuleMapTypeData%SubStructure_2_SStC_P_P,1) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%SubStructure_2_SStC_P_P(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%SubStructure_2_SStC_P_P) -ENDIF - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_P_2_SrvD_P_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ModuleMapTypeData%BDED_L_2_AD_L_B)) THEN -DO i1 = LBOUND(ModuleMapTypeData%BDED_L_2_AD_L_B,1), UBOUND(ModuleMapTypeData%BDED_L_2_AD_L_B,1) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%BDED_L_2_AD_L_B(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%BDED_L_2_AD_L_B) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%AD_L_2_BDED_B)) THEN -DO i1 = LBOUND(ModuleMapTypeData%AD_L_2_BDED_B,1), UBOUND(ModuleMapTypeData%AD_L_2_BDED_B,1) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%AD_L_2_BDED_B(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%AD_L_2_BDED_B) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%BD_L_2_BD_L)) THEN -DO i1 = LBOUND(ModuleMapTypeData%BD_L_2_BD_L,1), UBOUND(ModuleMapTypeData%BD_L_2_BD_L,1) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%BD_L_2_BD_L(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%BD_L_2_BD_L) -ENDIF - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%AD_P_2_ED_P_N, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%AD_P_2_ED_P_TF, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ModuleMapTypeData%ED_P_2_AD_P_R)) THEN -DO i1 = LBOUND(ModuleMapTypeData%ED_P_2_AD_P_R,1), UBOUND(ModuleMapTypeData%ED_P_2_AD_P_R,1) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%ED_P_2_AD_P_R) -ENDIF - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%AD_P_2_ED_P_H, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%IceF_P_2_SD_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%SDy3_P_2_IceF_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ModuleMapTypeData%IceD_P_2_SD_P)) THEN -DO i1 = LBOUND(ModuleMapTypeData%IceD_P_2_SD_P,1), UBOUND(ModuleMapTypeData%IceD_P_2_SD_P,1) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%IceD_P_2_SD_P(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%IceD_P_2_SD_P) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%SDy3_P_2_IceD_P)) THEN -DO i1 = LBOUND(ModuleMapTypeData%SDy3_P_2_IceD_P,1), UBOUND(ModuleMapTypeData%SDy3_P_2_IceD_P,1) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%SDy3_P_2_IceD_P(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%SDy3_P_2_IceD_P) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%Jacobian_Opt1)) THEN - DEALLOCATE(ModuleMapTypeData%Jacobian_Opt1) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%Jacobian_pivot)) THEN - DEALLOCATE(ModuleMapTypeData%Jacobian_pivot) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%Jac_u_indx)) THEN - DEALLOCATE(ModuleMapTypeData%Jac_u_indx) -ENDIF - CALL MeshDestroy( ModuleMapTypeData%u_ED_NacelleLoads, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( ModuleMapTypeData%SubstructureLoads_Tmp, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( ModuleMapTypeData%SubstructureLoads_Tmp2, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( ModuleMapTypeData%PlatformLoads_Tmp, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( ModuleMapTypeData%PlatformLoads_Tmp2, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( ModuleMapTypeData%SubstructureLoads_Tmp_Farm, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( ModuleMapTypeData%u_ED_TowerPtloads, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ModuleMapTypeData%u_ED_BladePtLoads)) THEN -DO i1 = LBOUND(ModuleMapTypeData%u_ED_BladePtLoads,1), UBOUND(ModuleMapTypeData%u_ED_BladePtLoads,1) - CALL MeshDestroy( ModuleMapTypeData%u_ED_BladePtLoads(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%u_ED_BladePtLoads) -ENDIF - CALL MeshDestroy( ModuleMapTypeData%u_SD_TPMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( ModuleMapTypeData%u_HD_M_Mesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( ModuleMapTypeData%u_HD_W_Mesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( ModuleMapTypeData%u_ED_HubPtLoad, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( ModuleMapTypeData%u_ED_HubPtLoad_2, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ModuleMapTypeData%u_BD_RootMotion)) THEN -DO i1 = LBOUND(ModuleMapTypeData%u_BD_RootMotion,1), UBOUND(ModuleMapTypeData%u_BD_RootMotion,1) - CALL MeshDestroy( ModuleMapTypeData%u_BD_RootMotion(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%u_BD_RootMotion) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%y_BD_BldMotion_4Loads)) THEN -DO i1 = LBOUND(ModuleMapTypeData%y_BD_BldMotion_4Loads,1), UBOUND(ModuleMapTypeData%y_BD_BldMotion_4Loads,1) - CALL MeshDestroy( ModuleMapTypeData%y_BD_BldMotion_4Loads(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%y_BD_BldMotion_4Loads) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%u_BD_Distrload)) THEN -DO i1 = LBOUND(ModuleMapTypeData%u_BD_Distrload,1), UBOUND(ModuleMapTypeData%u_BD_Distrload,1) - CALL MeshDestroy( ModuleMapTypeData%u_BD_Distrload(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%u_BD_Distrload) -ENDIF - CALL MeshDestroy( ModuleMapTypeData%u_Orca_PtfmMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( ModuleMapTypeData%u_ExtPtfm_PtfmMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE FAST_DestroyModuleMapType - - SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FAST_ModuleMapType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackModuleMapType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! ED_P_2_BD_P allocated yes/no - IF ( ALLOCATED(InData%ED_P_2_BD_P) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ED_P_2_BD_P upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%ED_P_2_BD_P,1), UBOUND(InData%ED_P_2_BD_P,1) - Int_BufSz = Int_BufSz + 3 ! ED_P_2_BD_P: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_BD_P(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_BD_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_BD_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_BD_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_BD_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! BD_P_2_ED_P allocated yes/no - IF ( ALLOCATED(InData%BD_P_2_ED_P) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BD_P_2_ED_P upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BD_P_2_ED_P,1), UBOUND(InData%BD_P_2_ED_P,1) - Int_BufSz = Int_BufSz + 3 ! BD_P_2_ED_P: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%BD_P_2_ED_P(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BD_P_2_ED_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BD_P_2_ED_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BD_P_2_ED_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BD_P_2_ED_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! ED_P_2_BD_P_Hub allocated yes/no - IF ( ALLOCATED(InData%ED_P_2_BD_P_Hub) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ED_P_2_BD_P_Hub upper/lower bounds for each dimension - DO i1 = LBOUND(InData%ED_P_2_BD_P_Hub,1), UBOUND(InData%ED_P_2_BD_P_Hub,1) - Int_BufSz = Int_BufSz + 3 ! ED_P_2_BD_P_Hub: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_BD_P_Hub(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_BD_P_Hub - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_BD_P_Hub - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_BD_P_Hub - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_BD_P_Hub - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! ED_P_2_HD_PRP_P: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_HD_PRP_P, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_HD_PRP_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_HD_PRP_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_HD_PRP_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_HD_PRP_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SubStructure_2_HD_W_P: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%SubStructure_2_HD_W_P, ErrStat2, ErrMsg2, .TRUE. ) ! SubStructure_2_HD_W_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SubStructure_2_HD_W_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SubStructure_2_HD_W_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SubStructure_2_HD_W_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! HD_W_P_2_SubStructure: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%HD_W_P_2_SubStructure, ErrStat2, ErrMsg2, .TRUE. ) ! HD_W_P_2_SubStructure - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! HD_W_P_2_SubStructure - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! HD_W_P_2_SubStructure - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! HD_W_P_2_SubStructure - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SubStructure_2_HD_M_P: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%SubStructure_2_HD_M_P, ErrStat2, ErrMsg2, .TRUE. ) ! SubStructure_2_HD_M_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SubStructure_2_HD_M_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SubStructure_2_HD_M_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SubStructure_2_HD_M_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! HD_M_P_2_SubStructure: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%HD_M_P_2_SubStructure, ErrStat2, ErrMsg2, .TRUE. ) ! HD_M_P_2_SubStructure - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! HD_M_P_2_SubStructure - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! HD_M_P_2_SubStructure - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! HD_M_P_2_SubStructure - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Structure_2_Mooring: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%Structure_2_Mooring, ErrStat2, ErrMsg2, .TRUE. ) ! Structure_2_Mooring - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Structure_2_Mooring - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Structure_2_Mooring - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Structure_2_Mooring - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Mooring_2_Structure: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%Mooring_2_Structure, ErrStat2, ErrMsg2, .TRUE. ) ! Mooring_2_Structure - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Mooring_2_Structure - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Mooring_2_Structure - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Mooring_2_Structure - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! ED_P_2_SD_TP: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_SD_TP, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_SD_TP - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_SD_TP - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_SD_TP - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_SD_TP - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SD_TP_2_ED_P: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%SD_TP_2_ED_P, ErrStat2, ErrMsg2, .TRUE. ) ! SD_TP_2_ED_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SD_TP_2_ED_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SD_TP_2_ED_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SD_TP_2_ED_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! ED_P_2_NStC_P_N allocated yes/no - IF ( ALLOCATED(InData%ED_P_2_NStC_P_N) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ED_P_2_NStC_P_N upper/lower bounds for each dimension - DO i1 = LBOUND(InData%ED_P_2_NStC_P_N,1), UBOUND(InData%ED_P_2_NStC_P_N,1) - Int_BufSz = Int_BufSz + 3 ! ED_P_2_NStC_P_N: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_NStC_P_N(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_NStC_P_N - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_NStC_P_N - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_NStC_P_N - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_NStC_P_N - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NStC_P_2_ED_P_N allocated yes/no - IF ( ALLOCATED(InData%NStC_P_2_ED_P_N) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NStC_P_2_ED_P_N upper/lower bounds for each dimension - DO i1 = LBOUND(InData%NStC_P_2_ED_P_N,1), UBOUND(InData%NStC_P_2_ED_P_N,1) - Int_BufSz = Int_BufSz + 3 ! NStC_P_2_ED_P_N: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%NStC_P_2_ED_P_N(i1), ErrStat2, ErrMsg2, .TRUE. ) ! NStC_P_2_ED_P_N - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NStC_P_2_ED_P_N - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NStC_P_2_ED_P_N - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NStC_P_2_ED_P_N - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! ED_L_2_TStC_P_T allocated yes/no - IF ( ALLOCATED(InData%ED_L_2_TStC_P_T) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ED_L_2_TStC_P_T upper/lower bounds for each dimension - DO i1 = LBOUND(InData%ED_L_2_TStC_P_T,1), UBOUND(InData%ED_L_2_TStC_P_T,1) - Int_BufSz = Int_BufSz + 3 ! ED_L_2_TStC_P_T: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_L_2_TStC_P_T(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ED_L_2_TStC_P_T - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_L_2_TStC_P_T - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_L_2_TStC_P_T - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_L_2_TStC_P_T - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! TStC_P_2_ED_P_T allocated yes/no - IF ( ALLOCATED(InData%TStC_P_2_ED_P_T) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TStC_P_2_ED_P_T upper/lower bounds for each dimension - DO i1 = LBOUND(InData%TStC_P_2_ED_P_T,1), UBOUND(InData%TStC_P_2_ED_P_T,1) - Int_BufSz = Int_BufSz + 3 ! TStC_P_2_ED_P_T: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%TStC_P_2_ED_P_T(i1), ErrStat2, ErrMsg2, .TRUE. ) ! TStC_P_2_ED_P_T - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TStC_P_2_ED_P_T - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TStC_P_2_ED_P_T - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TStC_P_2_ED_P_T - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! ED_L_2_BStC_P_B allocated yes/no - IF ( ALLOCATED(InData%ED_L_2_BStC_P_B) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ED_L_2_BStC_P_B upper/lower bounds for each dimension - DO i2 = LBOUND(InData%ED_L_2_BStC_P_B,2), UBOUND(InData%ED_L_2_BStC_P_B,2) - DO i1 = LBOUND(InData%ED_L_2_BStC_P_B,1), UBOUND(InData%ED_L_2_BStC_P_B,1) - Int_BufSz = Int_BufSz + 3 ! ED_L_2_BStC_P_B: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! ED_L_2_BStC_P_B - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_L_2_BStC_P_B - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_L_2_BStC_P_B - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_L_2_BStC_P_B - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! BStC_P_2_ED_P_B allocated yes/no - IF ( ALLOCATED(InData%BStC_P_2_ED_P_B) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BStC_P_2_ED_P_B upper/lower bounds for each dimension - DO i2 = LBOUND(InData%BStC_P_2_ED_P_B,2), UBOUND(InData%BStC_P_2_ED_P_B,2) - DO i1 = LBOUND(InData%BStC_P_2_ED_P_B,1), UBOUND(InData%BStC_P_2_ED_P_B,1) - Int_BufSz = Int_BufSz + 3 ! BStC_P_2_ED_P_B: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%BStC_P_2_ED_P_B(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! BStC_P_2_ED_P_B - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BStC_P_2_ED_P_B - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BStC_P_2_ED_P_B - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BStC_P_2_ED_P_B - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! BD_L_2_BStC_P_B allocated yes/no - IF ( ALLOCATED(InData%BD_L_2_BStC_P_B) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BD_L_2_BStC_P_B upper/lower bounds for each dimension - DO i2 = LBOUND(InData%BD_L_2_BStC_P_B,2), UBOUND(InData%BD_L_2_BStC_P_B,2) - DO i1 = LBOUND(InData%BD_L_2_BStC_P_B,1), UBOUND(InData%BD_L_2_BStC_P_B,1) - Int_BufSz = Int_BufSz + 3 ! BD_L_2_BStC_P_B: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%BD_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! BD_L_2_BStC_P_B - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BD_L_2_BStC_P_B - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BD_L_2_BStC_P_B - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BD_L_2_BStC_P_B - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! BStC_P_2_BD_P_B allocated yes/no - IF ( ALLOCATED(InData%BStC_P_2_BD_P_B) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BStC_P_2_BD_P_B upper/lower bounds for each dimension - DO i2 = LBOUND(InData%BStC_P_2_BD_P_B,2), UBOUND(InData%BStC_P_2_BD_P_B,2) - DO i1 = LBOUND(InData%BStC_P_2_BD_P_B,1), UBOUND(InData%BStC_P_2_BD_P_B,1) - Int_BufSz = Int_BufSz + 3 ! BStC_P_2_BD_P_B: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%BStC_P_2_BD_P_B(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! BStC_P_2_BD_P_B - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BStC_P_2_BD_P_B - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BStC_P_2_BD_P_B - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BStC_P_2_BD_P_B - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SStC_P_P_2_SubStructure allocated yes/no - IF ( ALLOCATED(InData%SStC_P_P_2_SubStructure) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SStC_P_P_2_SubStructure upper/lower bounds for each dimension - DO i1 = LBOUND(InData%SStC_P_P_2_SubStructure,1), UBOUND(InData%SStC_P_P_2_SubStructure,1) - Int_BufSz = Int_BufSz + 3 ! SStC_P_P_2_SubStructure: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%SStC_P_P_2_SubStructure(i1), ErrStat2, ErrMsg2, .TRUE. ) ! SStC_P_P_2_SubStructure - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SStC_P_P_2_SubStructure - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SStC_P_P_2_SubStructure - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SStC_P_P_2_SubStructure - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SubStructure_2_SStC_P_P allocated yes/no - IF ( ALLOCATED(InData%SubStructure_2_SStC_P_P) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SubStructure_2_SStC_P_P upper/lower bounds for each dimension - DO i1 = LBOUND(InData%SubStructure_2_SStC_P_P,1), UBOUND(InData%SubStructure_2_SStC_P_P,1) - Int_BufSz = Int_BufSz + 3 ! SubStructure_2_SStC_P_P: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%SubStructure_2_SStC_P_P(i1), ErrStat2, ErrMsg2, .TRUE. ) ! SubStructure_2_SStC_P_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SubStructure_2_SStC_P_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SubStructure_2_SStC_P_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SubStructure_2_SStC_P_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! ED_P_2_SrvD_P_P: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_SrvD_P_P, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_SrvD_P_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_SrvD_P_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_SrvD_P_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_SrvD_P_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! BDED_L_2_AD_L_B allocated yes/no - IF ( ALLOCATED(InData%BDED_L_2_AD_L_B) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BDED_L_2_AD_L_B upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BDED_L_2_AD_L_B,1), UBOUND(InData%BDED_L_2_AD_L_B,1) - Int_BufSz = Int_BufSz + 3 ! BDED_L_2_AD_L_B: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%BDED_L_2_AD_L_B(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BDED_L_2_AD_L_B - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BDED_L_2_AD_L_B - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BDED_L_2_AD_L_B - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BDED_L_2_AD_L_B - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! AD_L_2_BDED_B allocated yes/no - IF ( ALLOCATED(InData%AD_L_2_BDED_B) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AD_L_2_BDED_B upper/lower bounds for each dimension - DO i1 = LBOUND(InData%AD_L_2_BDED_B,1), UBOUND(InData%AD_L_2_BDED_B,1) - Int_BufSz = Int_BufSz + 3 ! AD_L_2_BDED_B: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%AD_L_2_BDED_B(i1), ErrStat2, ErrMsg2, .TRUE. ) ! AD_L_2_BDED_B - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD_L_2_BDED_B - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD_L_2_BDED_B - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD_L_2_BDED_B - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! BD_L_2_BD_L allocated yes/no - IF ( ALLOCATED(InData%BD_L_2_BD_L) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BD_L_2_BD_L upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BD_L_2_BD_L,1), UBOUND(InData%BD_L_2_BD_L,1) - Int_BufSz = Int_BufSz + 3 ! BD_L_2_BD_L: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%BD_L_2_BD_L(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BD_L_2_BD_L - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BD_L_2_BD_L - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BD_L_2_BD_L - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BD_L_2_BD_L - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! ED_P_2_AD_P_N: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_N - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_AD_P_N - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_AD_P_N - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_AD_P_N - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! AD_P_2_ED_P_N: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_ED_P_N, ErrStat2, ErrMsg2, .TRUE. ) ! AD_P_2_ED_P_N - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD_P_2_ED_P_N - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD_P_2_ED_P_N - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD_P_2_ED_P_N - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! ED_P_2_AD_P_TF: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_TF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_AD_P_TF - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_AD_P_TF - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_AD_P_TF - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! AD_P_2_ED_P_TF: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_ED_P_TF, ErrStat2, ErrMsg2, .TRUE. ) ! AD_P_2_ED_P_TF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD_P_2_ED_P_TF - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD_P_2_ED_P_TF - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD_P_2_ED_P_TF - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! ED_L_2_AD_L_T: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2, .TRUE. ) ! ED_L_2_AD_L_T - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_L_2_AD_L_T - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_L_2_AD_L_T - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_L_2_AD_L_T - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! AD_L_2_ED_P_T: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2, .TRUE. ) ! AD_L_2_ED_P_T - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD_L_2_ED_P_T - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD_L_2_ED_P_T - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD_L_2_ED_P_T - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! ED_P_2_AD_P_R allocated yes/no - IF ( ALLOCATED(InData%ED_P_2_AD_P_R) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ED_P_2_AD_P_R upper/lower bounds for each dimension - DO i1 = LBOUND(InData%ED_P_2_AD_P_R,1), UBOUND(InData%ED_P_2_AD_P_R,1) - Int_BufSz = Int_BufSz + 3 ! ED_P_2_AD_P_R: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_R - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_AD_P_R - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_AD_P_R - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_AD_P_R - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! ED_P_2_AD_P_H: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_H - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_AD_P_H - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_AD_P_H - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_AD_P_H - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! AD_P_2_ED_P_H: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_ED_P_H, ErrStat2, ErrMsg2, .TRUE. ) ! AD_P_2_ED_P_H - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD_P_2_ED_P_H - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD_P_2_ED_P_H - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD_P_2_ED_P_H - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! IceF_P_2_SD_P: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%IceF_P_2_SD_P, ErrStat2, ErrMsg2, .TRUE. ) ! IceF_P_2_SD_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IceF_P_2_SD_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IceF_P_2_SD_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IceF_P_2_SD_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SDy3_P_2_IceF_P: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%SDy3_P_2_IceF_P, ErrStat2, ErrMsg2, .TRUE. ) ! SDy3_P_2_IceF_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SDy3_P_2_IceF_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SDy3_P_2_IceF_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SDy3_P_2_IceF_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! IceD_P_2_SD_P allocated yes/no - IF ( ALLOCATED(InData%IceD_P_2_SD_P) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IceD_P_2_SD_P upper/lower bounds for each dimension - DO i1 = LBOUND(InData%IceD_P_2_SD_P,1), UBOUND(InData%IceD_P_2_SD_P,1) - Int_BufSz = Int_BufSz + 3 ! IceD_P_2_SD_P: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%IceD_P_2_SD_P(i1), ErrStat2, ErrMsg2, .TRUE. ) ! IceD_P_2_SD_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IceD_P_2_SD_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IceD_P_2_SD_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IceD_P_2_SD_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SDy3_P_2_IceD_P allocated yes/no - IF ( ALLOCATED(InData%SDy3_P_2_IceD_P) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SDy3_P_2_IceD_P upper/lower bounds for each dimension - DO i1 = LBOUND(InData%SDy3_P_2_IceD_P,1), UBOUND(InData%SDy3_P_2_IceD_P,1) - Int_BufSz = Int_BufSz + 3 ! SDy3_P_2_IceD_P: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%SDy3_P_2_IceD_P(i1), ErrStat2, ErrMsg2, .TRUE. ) ! SDy3_P_2_IceD_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SDy3_P_2_IceD_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SDy3_P_2_IceD_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SDy3_P_2_IceD_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! Jacobian_Opt1 allocated yes/no - IF ( ALLOCATED(InData%Jacobian_Opt1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jacobian_Opt1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Jacobian_Opt1) ! Jacobian_Opt1 - END IF - Int_BufSz = Int_BufSz + 1 ! Jacobian_pivot allocated yes/no - IF ( ALLOCATED(InData%Jacobian_pivot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Jacobian_pivot upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jacobian_pivot) ! Jacobian_pivot - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_u_indx allocated yes/no - IF ( ALLOCATED(InData%Jac_u_indx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_u_indx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_u_indx) ! Jac_u_indx - END IF - Int_BufSz = Int_BufSz + 3 ! u_ED_NacelleLoads: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_ED_NacelleLoads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_ED_NacelleLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_ED_NacelleLoads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_ED_NacelleLoads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_ED_NacelleLoads - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SubstructureLoads_Tmp: size of buffers for each call to pack subtype - CALL MeshPack( InData%SubstructureLoads_Tmp, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! SubstructureLoads_Tmp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SubstructureLoads_Tmp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SubstructureLoads_Tmp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SubstructureLoads_Tmp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SubstructureLoads_Tmp2: size of buffers for each call to pack subtype - CALL MeshPack( InData%SubstructureLoads_Tmp2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! SubstructureLoads_Tmp2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SubstructureLoads_Tmp2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SubstructureLoads_Tmp2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SubstructureLoads_Tmp2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! PlatformLoads_Tmp: size of buffers for each call to pack subtype - CALL MeshPack( InData%PlatformLoads_Tmp, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PlatformLoads_Tmp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PlatformLoads_Tmp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PlatformLoads_Tmp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PlatformLoads_Tmp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! PlatformLoads_Tmp2: size of buffers for each call to pack subtype - CALL MeshPack( InData%PlatformLoads_Tmp2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PlatformLoads_Tmp2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PlatformLoads_Tmp2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PlatformLoads_Tmp2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PlatformLoads_Tmp2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SubstructureLoads_Tmp_Farm: size of buffers for each call to pack subtype - CALL MeshPack( InData%SubstructureLoads_Tmp_Farm, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! SubstructureLoads_Tmp_Farm - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SubstructureLoads_Tmp_Farm - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SubstructureLoads_Tmp_Farm - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SubstructureLoads_Tmp_Farm - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u_ED_TowerPtloads: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_ED_TowerPtloads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_ED_TowerPtloads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_ED_TowerPtloads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_ED_TowerPtloads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_ED_TowerPtloads - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! u_ED_BladePtLoads allocated yes/no - IF ( ALLOCATED(InData%u_ED_BladePtLoads) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_ED_BladePtLoads upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_ED_BladePtLoads,1), UBOUND(InData%u_ED_BladePtLoads,1) - Int_BufSz = Int_BufSz + 3 ! u_ED_BladePtLoads: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_ED_BladePtLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_ED_BladePtLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_ED_BladePtLoads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_ED_BladePtLoads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_ED_BladePtLoads - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! u_SD_TPMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_SD_TPMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_SD_TPMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_SD_TPMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_SD_TPMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_SD_TPMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u_HD_M_Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_HD_M_Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_HD_M_Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_HD_M_Mesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_HD_M_Mesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_HD_M_Mesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u_HD_W_Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_HD_W_Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_HD_W_Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_HD_W_Mesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_HD_W_Mesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_HD_W_Mesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u_ED_HubPtLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_ED_HubPtLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_ED_HubPtLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_ED_HubPtLoad - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_ED_HubPtLoad - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_ED_HubPtLoad - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u_ED_HubPtLoad_2: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_ED_HubPtLoad_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_ED_HubPtLoad_2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_ED_HubPtLoad_2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_ED_HubPtLoad_2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_ED_HubPtLoad_2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! u_BD_RootMotion allocated yes/no - IF ( ALLOCATED(InData%u_BD_RootMotion) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_BD_RootMotion upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_BD_RootMotion,1), UBOUND(InData%u_BD_RootMotion,1) - Int_BufSz = Int_BufSz + 3 ! u_BD_RootMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_BD_RootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_BD_RootMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_BD_RootMotion - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_BD_RootMotion - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_BD_RootMotion - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! y_BD_BldMotion_4Loads allocated yes/no - IF ( ALLOCATED(InData%y_BD_BldMotion_4Loads) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y_BD_BldMotion_4Loads upper/lower bounds for each dimension - DO i1 = LBOUND(InData%y_BD_BldMotion_4Loads,1), UBOUND(InData%y_BD_BldMotion_4Loads,1) - Int_BufSz = Int_BufSz + 3 ! y_BD_BldMotion_4Loads: size of buffers for each call to pack subtype - CALL MeshPack( InData%y_BD_BldMotion_4Loads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! y_BD_BldMotion_4Loads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_BD_BldMotion_4Loads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_BD_BldMotion_4Loads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_BD_BldMotion_4Loads - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_BD_Distrload allocated yes/no - IF ( ALLOCATED(InData%u_BD_Distrload) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_BD_Distrload upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_BD_Distrload,1), UBOUND(InData%u_BD_Distrload,1) - Int_BufSz = Int_BufSz + 3 ! u_BD_Distrload: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_BD_Distrload(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_BD_Distrload - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_BD_Distrload - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_BD_Distrload - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_BD_Distrload - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! u_Orca_PtfmMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_Orca_PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_Orca_PtfmMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_Orca_PtfmMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_Orca_PtfmMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_Orca_PtfmMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u_ExtPtfm_PtfmMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_ExtPtfm_PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_ExtPtfm_PtfmMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_ExtPtfm_PtfmMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_ExtPtfm_PtfmMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_ExtPtfm_PtfmMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%ED_P_2_BD_P) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ED_P_2_BD_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ED_P_2_BD_P,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ED_P_2_BD_P,1), UBOUND(InData%ED_P_2_BD_P,1) - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_BD_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_BD_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BD_P_2_ED_P) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BD_P_2_ED_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BD_P_2_ED_P,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BD_P_2_ED_P,1), UBOUND(InData%BD_P_2_ED_P,1) - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%BD_P_2_ED_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! BD_P_2_ED_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ED_P_2_BD_P_Hub) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ED_P_2_BD_P_Hub,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ED_P_2_BD_P_Hub,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ED_P_2_BD_P_Hub,1), UBOUND(InData%ED_P_2_BD_P_Hub,1) - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_BD_P_Hub(i1), ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_BD_P_Hub - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_HD_PRP_P, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_HD_PRP_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%SubStructure_2_HD_W_P, ErrStat2, ErrMsg2, OnlySize ) ! SubStructure_2_HD_W_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%HD_W_P_2_SubStructure, ErrStat2, ErrMsg2, OnlySize ) ! HD_W_P_2_SubStructure - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%SubStructure_2_HD_M_P, ErrStat2, ErrMsg2, OnlySize ) ! SubStructure_2_HD_M_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%HD_M_P_2_SubStructure, ErrStat2, ErrMsg2, OnlySize ) ! HD_M_P_2_SubStructure - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%Structure_2_Mooring, ErrStat2, ErrMsg2, OnlySize ) ! Structure_2_Mooring - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%Mooring_2_Structure, ErrStat2, ErrMsg2, OnlySize ) ! Mooring_2_Structure - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_SD_TP, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_SD_TP - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%SD_TP_2_ED_P, ErrStat2, ErrMsg2, OnlySize ) ! SD_TP_2_ED_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%ED_P_2_NStC_P_N) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ED_P_2_NStC_P_N,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ED_P_2_NStC_P_N,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ED_P_2_NStC_P_N,1), UBOUND(InData%ED_P_2_NStC_P_N,1) - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_NStC_P_N(i1), ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_NStC_P_N - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NStC_P_2_ED_P_N) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NStC_P_2_ED_P_N,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NStC_P_2_ED_P_N,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NStC_P_2_ED_P_N,1), UBOUND(InData%NStC_P_2_ED_P_N,1) - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%NStC_P_2_ED_P_N(i1), ErrStat2, ErrMsg2, OnlySize ) ! NStC_P_2_ED_P_N - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ED_L_2_TStC_P_T) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ED_L_2_TStC_P_T,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ED_L_2_TStC_P_T,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ED_L_2_TStC_P_T,1), UBOUND(InData%ED_L_2_TStC_P_T,1) - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_L_2_TStC_P_T(i1), ErrStat2, ErrMsg2, OnlySize ) ! ED_L_2_TStC_P_T - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TStC_P_2_ED_P_T) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TStC_P_2_ED_P_T,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TStC_P_2_ED_P_T,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TStC_P_2_ED_P_T,1), UBOUND(InData%TStC_P_2_ED_P_T,1) - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%TStC_P_2_ED_P_T(i1), ErrStat2, ErrMsg2, OnlySize ) ! TStC_P_2_ED_P_T - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ED_L_2_BStC_P_B) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ED_L_2_BStC_P_B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ED_L_2_BStC_P_B,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ED_L_2_BStC_P_B,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ED_L_2_BStC_P_B,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ED_L_2_BStC_P_B,2), UBOUND(InData%ED_L_2_BStC_P_B,2) - DO i1 = LBOUND(InData%ED_L_2_BStC_P_B,1), UBOUND(InData%ED_L_2_BStC_P_B,1) - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! ED_L_2_BStC_P_B - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BStC_P_2_ED_P_B) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BStC_P_2_ED_P_B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStC_P_2_ED_P_B,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BStC_P_2_ED_P_B,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStC_P_2_ED_P_B,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BStC_P_2_ED_P_B,2), UBOUND(InData%BStC_P_2_ED_P_B,2) - DO i1 = LBOUND(InData%BStC_P_2_ED_P_B,1), UBOUND(InData%BStC_P_2_ED_P_B,1) - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%BStC_P_2_ED_P_B(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! BStC_P_2_ED_P_B - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BD_L_2_BStC_P_B) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BD_L_2_BStC_P_B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BD_L_2_BStC_P_B,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BD_L_2_BStC_P_B,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BD_L_2_BStC_P_B,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BD_L_2_BStC_P_B,2), UBOUND(InData%BD_L_2_BStC_P_B,2) - DO i1 = LBOUND(InData%BD_L_2_BStC_P_B,1), UBOUND(InData%BD_L_2_BStC_P_B,1) - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%BD_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! BD_L_2_BStC_P_B - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BStC_P_2_BD_P_B) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BStC_P_2_BD_P_B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStC_P_2_BD_P_B,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BStC_P_2_BD_P_B,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStC_P_2_BD_P_B,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BStC_P_2_BD_P_B,2), UBOUND(InData%BStC_P_2_BD_P_B,2) - DO i1 = LBOUND(InData%BStC_P_2_BD_P_B,1), UBOUND(InData%BStC_P_2_BD_P_B,1) - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%BStC_P_2_BD_P_B(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! BStC_P_2_BD_P_B - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SStC_P_P_2_SubStructure) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SStC_P_P_2_SubStructure,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SStC_P_P_2_SubStructure,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SStC_P_P_2_SubStructure,1), UBOUND(InData%SStC_P_P_2_SubStructure,1) - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%SStC_P_P_2_SubStructure(i1), ErrStat2, ErrMsg2, OnlySize ) ! SStC_P_P_2_SubStructure - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SubStructure_2_SStC_P_P) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SubStructure_2_SStC_P_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SubStructure_2_SStC_P_P,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SubStructure_2_SStC_P_P,1), UBOUND(InData%SubStructure_2_SStC_P_P,1) - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%SubStructure_2_SStC_P_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! SubStructure_2_SStC_P_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_SrvD_P_P, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_SrvD_P_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%BDED_L_2_AD_L_B) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BDED_L_2_AD_L_B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BDED_L_2_AD_L_B,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BDED_L_2_AD_L_B,1), UBOUND(InData%BDED_L_2_AD_L_B,1) - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%BDED_L_2_AD_L_B(i1), ErrStat2, ErrMsg2, OnlySize ) ! BDED_L_2_AD_L_B - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AD_L_2_BDED_B) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AD_L_2_BDED_B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AD_L_2_BDED_B,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AD_L_2_BDED_B,1), UBOUND(InData%AD_L_2_BDED_B,1) - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%AD_L_2_BDED_B(i1), ErrStat2, ErrMsg2, OnlySize ) ! AD_L_2_BDED_B - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BD_L_2_BD_L) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BD_L_2_BD_L,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BD_L_2_BD_L,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BD_L_2_BD_L,1), UBOUND(InData%BD_L_2_BD_L,1) - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%BD_L_2_BD_L(i1), ErrStat2, ErrMsg2, OnlySize ) ! BD_L_2_BD_L - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_N - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_ED_P_N, ErrStat2, ErrMsg2, OnlySize ) ! AD_P_2_ED_P_N - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_TF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_ED_P_TF, ErrStat2, ErrMsg2, OnlySize ) ! AD_P_2_ED_P_TF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2, OnlySize ) ! ED_L_2_AD_L_T - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2, OnlySize ) ! AD_L_2_ED_P_T - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%ED_P_2_AD_P_R) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ED_P_2_AD_P_R,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ED_P_2_AD_P_R,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ED_P_2_AD_P_R,1), UBOUND(InData%ED_P_2_AD_P_R,1) - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_R - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_H - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%AD_P_2_ED_P_H, ErrStat2, ErrMsg2, OnlySize ) ! AD_P_2_ED_P_H - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%IceF_P_2_SD_P, ErrStat2, ErrMsg2, OnlySize ) ! IceF_P_2_SD_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%SDy3_P_2_IceF_P, ErrStat2, ErrMsg2, OnlySize ) ! SDy3_P_2_IceF_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%IceD_P_2_SD_P) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IceD_P_2_SD_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IceD_P_2_SD_P,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IceD_P_2_SD_P,1), UBOUND(InData%IceD_P_2_SD_P,1) - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%IceD_P_2_SD_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! IceD_P_2_SD_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SDy3_P_2_IceD_P) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SDy3_P_2_IceD_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SDy3_P_2_IceD_P,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SDy3_P_2_IceD_P,1), UBOUND(InData%SDy3_P_2_IceD_P,1) - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%SDy3_P_2_IceD_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! SDy3_P_2_IceD_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jacobian_Opt1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jacobian_Opt1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jacobian_Opt1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jacobian_Opt1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jacobian_Opt1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jacobian_Opt1,2), UBOUND(InData%Jacobian_Opt1,2) - DO i1 = LBOUND(InData%Jacobian_Opt1,1), UBOUND(InData%Jacobian_Opt1,1) - ReKiBuf(Re_Xferred) = InData%Jacobian_Opt1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jacobian_pivot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jacobian_pivot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jacobian_pivot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Jacobian_pivot,1), UBOUND(InData%Jacobian_pivot,1) - IntKiBuf(Int_Xferred) = InData%Jacobian_pivot(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jac_u_indx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_u_indx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_u_indx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jac_u_indx,2), UBOUND(InData%Jac_u_indx,2) - DO i1 = LBOUND(InData%Jac_u_indx,1), UBOUND(InData%Jac_u_indx,1) - IntKiBuf(Int_Xferred) = InData%Jac_u_indx(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - CALL MeshPack( InData%u_ED_NacelleLoads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_ED_NacelleLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MeshPack( InData%SubstructureLoads_Tmp, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! SubstructureLoads_Tmp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = 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%SubstructureLoads_Tmp2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! SubstructureLoads_Tmp2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = 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%PlatformLoads_Tmp, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PlatformLoads_Tmp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = 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%PlatformLoads_Tmp2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PlatformLoads_Tmp2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = 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%SubstructureLoads_Tmp_Farm, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! SubstructureLoads_Tmp_Farm - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MeshPack( InData%u_ED_TowerPtloads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_ED_TowerPtloads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%u_ED_BladePtLoads) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_ED_BladePtLoads,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_ED_BladePtLoads,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_ED_BladePtLoads,1), UBOUND(InData%u_ED_BladePtLoads,1) - CALL MeshPack( InData%u_ED_BladePtLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_ED_BladePtLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL MeshPack( InData%u_SD_TPMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_SD_TPMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MeshPack( InData%u_HD_M_Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_HD_M_Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MeshPack( InData%u_HD_W_Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_HD_W_Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MeshPack( InData%u_ED_HubPtLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_ED_HubPtLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MeshPack( InData%u_ED_HubPtLoad_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_ED_HubPtLoad_2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + DstMoorDyn_DataData%InputTimes = SrcMoorDyn_DataData%InputTimes +ENDIF + END SUBROUTINE FAST_CopyMoorDyn_Data - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%u_BD_RootMotion) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_BD_RootMotion,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_BD_RootMotion,1) - Int_Xferred = Int_Xferred + 2 + SUBROUTINE FAST_DestroyMoorDyn_Data( MoorDyn_DataData, ErrStat, ErrMsg ) + TYPE(MoorDyn_Data), INTENT(INOUT) :: MoorDyn_DataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyMoorDyn_Data' - DO i1 = LBOUND(InData%u_BD_RootMotion,1), UBOUND(InData%u_BD_RootMotion,1) - CALL MeshPack( InData%u_BD_RootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_BD_RootMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + ErrStat = ErrID_None + ErrMsg = "" - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%y_BD_BldMotion_4Loads) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%y_BD_BldMotion_4Loads,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y_BD_BldMotion_4Loads,1) - Int_Xferred = Int_Xferred + 2 +DO i1 = LBOUND(MoorDyn_DataData%x,1), UBOUND(MoorDyn_DataData%x,1) + CALL MD_DestroyContState( MoorDyn_DataData%x(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +DO i1 = LBOUND(MoorDyn_DataData%xd,1), UBOUND(MoorDyn_DataData%xd,1) + CALL MD_DestroyDiscState( MoorDyn_DataData%xd(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +DO i1 = LBOUND(MoorDyn_DataData%z,1), UBOUND(MoorDyn_DataData%z,1) + CALL MD_DestroyConstrState( MoorDyn_DataData%z(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +DO i1 = LBOUND(MoorDyn_DataData%OtherSt,1), UBOUND(MoorDyn_DataData%OtherSt,1) + CALL MD_DestroyOtherState( MoorDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + CALL MD_DestroyParam( MoorDyn_DataData%p, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL MD_DestroyInput( MoorDyn_DataData%u, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL MD_DestroyOutput( MoorDyn_DataData%y, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL MD_DestroyMisc( MoorDyn_DataData%m, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(MoorDyn_DataData%Output)) THEN +DO i1 = LBOUND(MoorDyn_DataData%Output,1), UBOUND(MoorDyn_DataData%Output,1) + CALL MD_DestroyOutput( MoorDyn_DataData%Output(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(MoorDyn_DataData%Output) +ENDIF + CALL MD_DestroyOutput( MoorDyn_DataData%y_interp, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(MoorDyn_DataData%Input)) THEN +DO i1 = LBOUND(MoorDyn_DataData%Input,1), UBOUND(MoorDyn_DataData%Input,1) + CALL MD_DestroyInput( MoorDyn_DataData%Input(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(MoorDyn_DataData%Input) +ENDIF +IF (ALLOCATED(MoorDyn_DataData%InputTimes)) THEN + DEALLOCATE(MoorDyn_DataData%InputTimes) +ENDIF + END SUBROUTINE FAST_DestroyMoorDyn_Data - DO i1 = LBOUND(InData%y_BD_BldMotion_4Loads,1), UBOUND(InData%y_BD_BldMotion_4Loads,1) - CALL MeshPack( InData%y_BD_BldMotion_4Loads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! y_BD_BldMotion_4Loads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO +subroutine FAST_PackMoorDyn_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MoorDyn_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackMoorDyn_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! x + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call MD_PackContState(Buf, InData%x(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! xd + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call MD_PackDiscState(Buf, InData%xd(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! z + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call MD_PackConstrState(Buf, InData%z(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! OtherSt + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call MD_PackOtherState(Buf, InData%OtherSt(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! p + call MD_PackParam(Buf, InData%p) + if (RegCheckErr(Buf, RoutineName)) return + ! u + call MD_PackInput(Buf, InData%u) + if (RegCheckErr(Buf, RoutineName)) return + ! y + call MD_PackOutput(Buf, InData%y) + if (RegCheckErr(Buf, RoutineName)) return + ! m + call MD_PackMisc(Buf, InData%m) + if (RegCheckErr(Buf, RoutineName)) return + ! Output + call RegPack(Buf, allocated(InData%Output)) + if (allocated(InData%Output)) then + call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) + LB(1:1) = lbound(InData%Output) + UB(1:1) = ubound(InData%Output) + do i1 = LB(1), UB(1) + call MD_PackOutput(Buf, InData%Output(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! y_interp + call MD_PackOutput(Buf, InData%y_interp) + if (RegCheckErr(Buf, RoutineName)) return + ! Input + call RegPack(Buf, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call MD_PackInput(Buf, InData%Input(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! InputTimes + call RegPack(Buf, allocated(InData%InputTimes)) + if (allocated(InData%InputTimes)) then + call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPack(Buf, InData%InputTimes) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackMoorDyn_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MoorDyn_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackMoorDyn_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! x + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) + do i1 = LB(1), UB(1) + call MD_UnpackContState(Buf, OutData%x(i1)) ! x + end do + ! xd + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) + do i1 = LB(1), UB(1) + call MD_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + end do + ! z + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) + do i1 = LB(1), UB(1) + call MD_UnpackConstrState(Buf, OutData%z(i1)) ! z + end do + ! OtherSt + LB(1:1) = lbound(OutData%OtherSt) + UB(1:1) = ubound(OutData%OtherSt) + do i1 = LB(1), UB(1) + call MD_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + end do + ! p + call MD_UnpackParam(Buf, OutData%p) ! p + ! u + call MD_UnpackInput(Buf, OutData%u) ! u + ! y + call MD_UnpackOutput(Buf, OutData%y) ! y + ! m + call MD_UnpackMisc(Buf, OutData%m) ! m + ! Output + if (allocated(OutData%Output)) deallocate(OutData%Output) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Output(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackOutput(Buf, OutData%Output(i1)) ! Output + end do + end if + ! y_interp + call MD_UnpackOutput(Buf, OutData%y_interp) ! y_interp + ! Input + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackInput(Buf, OutData%Input(i1)) ! Input + end do + end if + ! InputTimes + if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InputTimes) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + SUBROUTINE FAST_CopyOrcaFlex_Data( SrcOrcaFlex_DataData, DstOrcaFlex_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(OrcaFlex_Data), INTENT(INOUT) :: SrcOrcaFlex_DataData + TYPE(OrcaFlex_Data), INTENT(INOUT) :: DstOrcaFlex_DataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyOrcaFlex_Data' +! + ErrStat = ErrID_None + ErrMsg = "" + DO i1 = LBOUND(SrcOrcaFlex_DataData%x,1), UBOUND(SrcOrcaFlex_DataData%x,1) + CALL Orca_CopyContState( SrcOrcaFlex_DataData%x(i1), DstOrcaFlex_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcOrcaFlex_DataData%xd,1), UBOUND(SrcOrcaFlex_DataData%xd,1) + CALL Orca_CopyDiscState( SrcOrcaFlex_DataData%xd(i1), DstOrcaFlex_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcOrcaFlex_DataData%z,1), UBOUND(SrcOrcaFlex_DataData%z,1) + CALL Orca_CopyConstrState( SrcOrcaFlex_DataData%z(i1), DstOrcaFlex_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcOrcaFlex_DataData%OtherSt,1), UBOUND(SrcOrcaFlex_DataData%OtherSt,1) + CALL Orca_CopyOtherState( SrcOrcaFlex_DataData%OtherSt(i1), DstOrcaFlex_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + CALL Orca_CopyParam( SrcOrcaFlex_DataData%p, DstOrcaFlex_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL Orca_CopyInput( SrcOrcaFlex_DataData%u, DstOrcaFlex_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL Orca_CopyOutput( SrcOrcaFlex_DataData%y, DstOrcaFlex_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL Orca_CopyMisc( SrcOrcaFlex_DataData%m, DstOrcaFlex_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcOrcaFlex_DataData%Input)) THEN + i1_l = LBOUND(SrcOrcaFlex_DataData%Input,1) + i1_u = UBOUND(SrcOrcaFlex_DataData%Input,1) + IF (.NOT. ALLOCATED(DstOrcaFlex_DataData%Input)) THEN + ALLOCATE(DstOrcaFlex_DataData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOrcaFlex_DataData%Input.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF ( .NOT. ALLOCATED(InData%u_BD_Distrload) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_BD_Distrload,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_BD_Distrload,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_BD_Distrload,1), UBOUND(InData%u_BD_Distrload,1) - CALL MeshPack( InData%u_BD_Distrload(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_BD_Distrload - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO + DO i1 = LBOUND(SrcOrcaFlex_DataData%Input,1), UBOUND(SrcOrcaFlex_DataData%Input,1) + CALL Orca_CopyInput( SrcOrcaFlex_DataData%Input(i1), DstOrcaFlex_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcOrcaFlex_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcOrcaFlex_DataData%InputTimes,1) + i1_u = UBOUND(SrcOrcaFlex_DataData%InputTimes,1) + IF (.NOT. ALLOCATED(DstOrcaFlex_DataData%InputTimes)) THEN + ALLOCATE(DstOrcaFlex_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOrcaFlex_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - CALL MeshPack( InData%u_Orca_PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_Orca_PtfmMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MeshPack( InData%u_ExtPtfm_PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_ExtPtfm_PtfmMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE FAST_PackModuleMapType + DstOrcaFlex_DataData%InputTimes = SrcOrcaFlex_DataData%InputTimes +ENDIF + END SUBROUTINE FAST_CopyOrcaFlex_Data - SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: OutData + SUBROUTINE FAST_DestroyOrcaFlex_Data( OrcaFlex_DataData, ErrStat, ErrMsg ) + TYPE(OrcaFlex_Data), INTENT(INOUT) :: OrcaFlex_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackModuleMapType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyOrcaFlex_Data' + ErrStat = ErrID_None ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ED_P_2_BD_P not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ED_P_2_BD_P)) DEALLOCATE(OutData%ED_P_2_BD_P) - ALLOCATE(OutData%ED_P_2_BD_P(i1_l:i1_u),STAT=ErrStat2) + +DO i1 = LBOUND(OrcaFlex_DataData%x,1), UBOUND(OrcaFlex_DataData%x,1) + CALL Orca_DestroyContState( OrcaFlex_DataData%x(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +DO i1 = LBOUND(OrcaFlex_DataData%xd,1), UBOUND(OrcaFlex_DataData%xd,1) + CALL Orca_DestroyDiscState( OrcaFlex_DataData%xd(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +DO i1 = LBOUND(OrcaFlex_DataData%z,1), UBOUND(OrcaFlex_DataData%z,1) + CALL Orca_DestroyConstrState( OrcaFlex_DataData%z(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +DO i1 = LBOUND(OrcaFlex_DataData%OtherSt,1), UBOUND(OrcaFlex_DataData%OtherSt,1) + CALL Orca_DestroyOtherState( OrcaFlex_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + CALL Orca_DestroyParam( OrcaFlex_DataData%p, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL Orca_DestroyInput( OrcaFlex_DataData%u, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL Orca_DestroyOutput( OrcaFlex_DataData%y, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL Orca_DestroyMisc( OrcaFlex_DataData%m, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(OrcaFlex_DataData%Input)) THEN +DO i1 = LBOUND(OrcaFlex_DataData%Input,1), UBOUND(OrcaFlex_DataData%Input,1) + CALL Orca_DestroyInput( OrcaFlex_DataData%Input(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(OrcaFlex_DataData%Input) +ENDIF +IF (ALLOCATED(OrcaFlex_DataData%InputTimes)) THEN + DEALLOCATE(OrcaFlex_DataData%InputTimes) +ENDIF + END SUBROUTINE FAST_DestroyOrcaFlex_Data + + +subroutine FAST_PackOrcaFlex_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(OrcaFlex_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackOrcaFlex_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! x + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call Orca_PackContState(Buf, InData%x(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! xd + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call Orca_PackDiscState(Buf, InData%xd(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! z + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call Orca_PackConstrState(Buf, InData%z(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! OtherSt + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call Orca_PackOtherState(Buf, InData%OtherSt(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + ! p + call Orca_PackParam(Buf, InData%p) + if (RegCheckErr(Buf, RoutineName)) return + ! u + call Orca_PackInput(Buf, InData%u) + if (RegCheckErr(Buf, RoutineName)) return + ! y + call Orca_PackOutput(Buf, InData%y) + if (RegCheckErr(Buf, RoutineName)) return + ! m + call Orca_PackMisc(Buf, InData%m) + if (RegCheckErr(Buf, RoutineName)) return + ! Input + call RegPack(Buf, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call Orca_PackInput(Buf, InData%Input(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! InputTimes + call RegPack(Buf, allocated(InData%InputTimes)) + if (allocated(InData%InputTimes)) then + call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPack(Buf, InData%InputTimes) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackOrcaFlex_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(OrcaFlex_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackOrcaFlex_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! x + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) + do i1 = LB(1), UB(1) + call Orca_UnpackContState(Buf, OutData%x(i1)) ! x + end do + ! xd + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) + do i1 = LB(1), UB(1) + call Orca_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + end do + ! z + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) + do i1 = LB(1), UB(1) + call Orca_UnpackConstrState(Buf, OutData%z(i1)) ! z + end do + ! OtherSt + LB(1:1) = lbound(OutData%OtherSt) + UB(1:1) = ubound(OutData%OtherSt) + do i1 = LB(1), UB(1) + call Orca_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + end do + ! p + call Orca_UnpackParam(Buf, OutData%p) ! p + ! u + call Orca_UnpackInput(Buf, OutData%u) ! u + ! y + call Orca_UnpackOutput(Buf, OutData%y) ! y + ! m + call Orca_UnpackMisc(Buf, OutData%m) ! m + ! Input + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call Orca_UnpackInput(Buf, OutData%Input(i1)) ! Input + end do + end if + ! InputTimes + if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InputTimes) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + SUBROUTINE FAST_CopyModuleMapType( SrcModuleMapTypeData, DstModuleMapTypeData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: SrcModuleMapTypeData + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: DstModuleMapTypeData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyModuleMapType' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcModuleMapTypeData%ED_P_2_BD_P)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%ED_P_2_BD_P,1) + i1_u = UBOUND(SrcModuleMapTypeData%ED_P_2_BD_P,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%ED_P_2_BD_P)) THEN + ALLOCATE(DstModuleMapTypeData%ED_P_2_BD_P(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_BD_P.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_P_2_BD_P.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%ED_P_2_BD_P,1), UBOUND(OutData%ED_P_2_BD_P,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_BD_P(i1), ErrStat2, ErrMsg2 ) ! ED_P_2_BD_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BD_P_2_ED_P not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BD_P_2_ED_P)) DEALLOCATE(OutData%BD_P_2_ED_P) - ALLOCATE(OutData%BD_P_2_ED_P(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(SrcModuleMapTypeData%ED_P_2_BD_P,1), UBOUND(SrcModuleMapTypeData%ED_P_2_BD_P,1) + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_BD_P(i1), DstModuleMapTypeData%ED_P_2_BD_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcModuleMapTypeData%BD_P_2_ED_P)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%BD_P_2_ED_P,1) + i1_u = UBOUND(SrcModuleMapTypeData%BD_P_2_ED_P,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%BD_P_2_ED_P)) THEN + ALLOCATE(DstModuleMapTypeData%BD_P_2_ED_P(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BD_P_2_ED_P.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BD_P_2_ED_P.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%BD_P_2_ED_P,1), UBOUND(OutData%BD_P_2_ED_P,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%BD_P_2_ED_P(i1), ErrStat2, ErrMsg2 ) ! BD_P_2_ED_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ED_P_2_BD_P_Hub not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ED_P_2_BD_P_Hub)) DEALLOCATE(OutData%ED_P_2_BD_P_Hub) - ALLOCATE(OutData%ED_P_2_BD_P_Hub(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(SrcModuleMapTypeData%BD_P_2_ED_P,1), UBOUND(SrcModuleMapTypeData%BD_P_2_ED_P,1) + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%BD_P_2_ED_P(i1), DstModuleMapTypeData%BD_P_2_ED_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcModuleMapTypeData%ED_P_2_BD_P_Hub)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%ED_P_2_BD_P_Hub,1) + i1_u = UBOUND(SrcModuleMapTypeData%ED_P_2_BD_P_Hub,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%ED_P_2_BD_P_Hub)) THEN + ALLOCATE(DstModuleMapTypeData%ED_P_2_BD_P_Hub(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_BD_P_Hub.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_P_2_BD_P_Hub.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%ED_P_2_BD_P_Hub,1), UBOUND(OutData%ED_P_2_BD_P_Hub,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_BD_P_Hub(i1), ErrStat2, ErrMsg2 ) ! ED_P_2_BD_P_Hub - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_HD_PRP_P, ErrStat2, ErrMsg2 ) ! ED_P_2_HD_PRP_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%SubStructure_2_HD_W_P, ErrStat2, ErrMsg2 ) ! SubStructure_2_HD_W_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%HD_W_P_2_SubStructure, ErrStat2, ErrMsg2 ) ! HD_W_P_2_SubStructure - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%SubStructure_2_HD_M_P, ErrStat2, ErrMsg2 ) ! SubStructure_2_HD_M_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%HD_M_P_2_SubStructure, ErrStat2, ErrMsg2 ) ! HD_M_P_2_SubStructure - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%Structure_2_Mooring, ErrStat2, ErrMsg2 ) ! Structure_2_Mooring - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%Mooring_2_Structure, ErrStat2, ErrMsg2 ) ! Mooring_2_Structure - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) ! ED_P_2_SD_TP - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%SD_TP_2_ED_P, ErrStat2, ErrMsg2 ) ! SD_TP_2_ED_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ED_P_2_NStC_P_N not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ED_P_2_NStC_P_N)) DEALLOCATE(OutData%ED_P_2_NStC_P_N) - ALLOCATE(OutData%ED_P_2_NStC_P_N(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(SrcModuleMapTypeData%ED_P_2_BD_P_Hub,1), UBOUND(SrcModuleMapTypeData%ED_P_2_BD_P_Hub,1) + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_BD_P_Hub(i1), DstModuleMapTypeData%ED_P_2_BD_P_Hub(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_HD_PRP_P, DstModuleMapTypeData%ED_P_2_HD_PRP_P, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SubStructure_2_HD_W_P, DstModuleMapTypeData%SubStructure_2_HD_W_P, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%HD_W_P_2_SubStructure, DstModuleMapTypeData%HD_W_P_2_SubStructure, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SubStructure_2_HD_M_P, DstModuleMapTypeData%SubStructure_2_HD_M_P, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%HD_M_P_2_SubStructure, DstModuleMapTypeData%HD_M_P_2_SubStructure, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%Structure_2_Mooring, DstModuleMapTypeData%Structure_2_Mooring, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%Mooring_2_Structure, DstModuleMapTypeData%Mooring_2_Structure, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_SD_TP, DstModuleMapTypeData%ED_P_2_SD_TP, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SD_TP_2_ED_P, DstModuleMapTypeData%SD_TP_2_ED_P, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcModuleMapTypeData%ED_P_2_NStC_P_N)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%ED_P_2_NStC_P_N,1) + i1_u = UBOUND(SrcModuleMapTypeData%ED_P_2_NStC_P_N,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%ED_P_2_NStC_P_N)) THEN + ALLOCATE(DstModuleMapTypeData%ED_P_2_NStC_P_N(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_NStC_P_N.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_P_2_NStC_P_N.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%ED_P_2_NStC_P_N,1), UBOUND(OutData%ED_P_2_NStC_P_N,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_NStC_P_N(i1), ErrStat2, ErrMsg2 ) ! ED_P_2_NStC_P_N - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NStC_P_2_ED_P_N not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NStC_P_2_ED_P_N)) DEALLOCATE(OutData%NStC_P_2_ED_P_N) - ALLOCATE(OutData%NStC_P_2_ED_P_N(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(SrcModuleMapTypeData%ED_P_2_NStC_P_N,1), UBOUND(SrcModuleMapTypeData%ED_P_2_NStC_P_N,1) + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_NStC_P_N(i1), DstModuleMapTypeData%ED_P_2_NStC_P_N(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcModuleMapTypeData%NStC_P_2_ED_P_N)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%NStC_P_2_ED_P_N,1) + i1_u = UBOUND(SrcModuleMapTypeData%NStC_P_2_ED_P_N,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%NStC_P_2_ED_P_N)) THEN + ALLOCATE(DstModuleMapTypeData%NStC_P_2_ED_P_N(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC_P_2_ED_P_N.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%NStC_P_2_ED_P_N.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%NStC_P_2_ED_P_N,1), UBOUND(OutData%NStC_P_2_ED_P_N,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%NStC_P_2_ED_P_N(i1), ErrStat2, ErrMsg2 ) ! NStC_P_2_ED_P_N - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ED_L_2_TStC_P_T not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ED_L_2_TStC_P_T)) DEALLOCATE(OutData%ED_L_2_TStC_P_T) - ALLOCATE(OutData%ED_L_2_TStC_P_T(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(SrcModuleMapTypeData%NStC_P_2_ED_P_N,1), UBOUND(SrcModuleMapTypeData%NStC_P_2_ED_P_N,1) + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%NStC_P_2_ED_P_N(i1), DstModuleMapTypeData%NStC_P_2_ED_P_N(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcModuleMapTypeData%ED_L_2_TStC_P_T)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%ED_L_2_TStC_P_T,1) + i1_u = UBOUND(SrcModuleMapTypeData%ED_L_2_TStC_P_T,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%ED_L_2_TStC_P_T)) THEN + ALLOCATE(DstModuleMapTypeData%ED_L_2_TStC_P_T(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_L_2_TStC_P_T.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_L_2_TStC_P_T.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%ED_L_2_TStC_P_T,1), UBOUND(OutData%ED_L_2_TStC_P_T,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%ED_L_2_TStC_P_T(i1), ErrStat2, ErrMsg2 ) ! ED_L_2_TStC_P_T - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TStC_P_2_ED_P_T not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TStC_P_2_ED_P_T)) DEALLOCATE(OutData%TStC_P_2_ED_P_T) - ALLOCATE(OutData%TStC_P_2_ED_P_T(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(SrcModuleMapTypeData%ED_L_2_TStC_P_T,1), UBOUND(SrcModuleMapTypeData%ED_L_2_TStC_P_T,1) + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_L_2_TStC_P_T(i1), DstModuleMapTypeData%ED_L_2_TStC_P_T(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcModuleMapTypeData%TStC_P_2_ED_P_T)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%TStC_P_2_ED_P_T,1) + i1_u = UBOUND(SrcModuleMapTypeData%TStC_P_2_ED_P_T,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%TStC_P_2_ED_P_T)) THEN + ALLOCATE(DstModuleMapTypeData%TStC_P_2_ED_P_T(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC_P_2_ED_P_T.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%TStC_P_2_ED_P_T.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%TStC_P_2_ED_P_T,1), UBOUND(OutData%TStC_P_2_ED_P_T,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%TStC_P_2_ED_P_T(i1), ErrStat2, ErrMsg2 ) ! TStC_P_2_ED_P_T - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ED_L_2_BStC_P_B not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ED_L_2_BStC_P_B)) DEALLOCATE(OutData%ED_L_2_BStC_P_B) - ALLOCATE(OutData%ED_L_2_BStC_P_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DO i1 = LBOUND(SrcModuleMapTypeData%TStC_P_2_ED_P_T,1), UBOUND(SrcModuleMapTypeData%TStC_P_2_ED_P_T,1) + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%TStC_P_2_ED_P_T(i1), DstModuleMapTypeData%TStC_P_2_ED_P_T(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcModuleMapTypeData%ED_L_2_BStC_P_B)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%ED_L_2_BStC_P_B,1) + i1_u = UBOUND(SrcModuleMapTypeData%ED_L_2_BStC_P_B,1) + i2_l = LBOUND(SrcModuleMapTypeData%ED_L_2_BStC_P_B,2) + i2_u = UBOUND(SrcModuleMapTypeData%ED_L_2_BStC_P_B,2) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%ED_L_2_BStC_P_B)) THEN + ALLOCATE(DstModuleMapTypeData%ED_L_2_BStC_P_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_L_2_BStC_P_B.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_L_2_BStC_P_B.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i2 = LBOUND(OutData%ED_L_2_BStC_P_B,2), UBOUND(OutData%ED_L_2_BStC_P_B,2) - DO i1 = LBOUND(OutData%ED_L_2_BStC_P_B,1), UBOUND(OutData%ED_L_2_BStC_P_B,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%ED_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2 ) ! ED_L_2_BStC_P_B - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BStC_P_2_ED_P_B not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BStC_P_2_ED_P_B)) DEALLOCATE(OutData%BStC_P_2_ED_P_B) - ALLOCATE(OutData%BStC_P_2_ED_P_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DO i2 = LBOUND(SrcModuleMapTypeData%ED_L_2_BStC_P_B,2), UBOUND(SrcModuleMapTypeData%ED_L_2_BStC_P_B,2) + DO i1 = LBOUND(SrcModuleMapTypeData%ED_L_2_BStC_P_B,1), UBOUND(SrcModuleMapTypeData%ED_L_2_BStC_P_B,1) + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_L_2_BStC_P_B(i1,i2), DstModuleMapTypeData%ED_L_2_BStC_P_B(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + ENDDO +ENDIF +IF (ALLOCATED(SrcModuleMapTypeData%BStC_P_2_ED_P_B)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%BStC_P_2_ED_P_B,1) + i1_u = UBOUND(SrcModuleMapTypeData%BStC_P_2_ED_P_B,1) + i2_l = LBOUND(SrcModuleMapTypeData%BStC_P_2_ED_P_B,2) + i2_u = UBOUND(SrcModuleMapTypeData%BStC_P_2_ED_P_B,2) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%BStC_P_2_ED_P_B)) THEN + ALLOCATE(DstModuleMapTypeData%BStC_P_2_ED_P_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC_P_2_ED_P_B.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BStC_P_2_ED_P_B.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i2 = LBOUND(OutData%BStC_P_2_ED_P_B,2), UBOUND(OutData%BStC_P_2_ED_P_B,2) - DO i1 = LBOUND(OutData%BStC_P_2_ED_P_B,1), UBOUND(OutData%BStC_P_2_ED_P_B,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%BStC_P_2_ED_P_B(i1,i2), ErrStat2, ErrMsg2 ) ! BStC_P_2_ED_P_B - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BD_L_2_BStC_P_B not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BD_L_2_BStC_P_B)) DEALLOCATE(OutData%BD_L_2_BStC_P_B) - ALLOCATE(OutData%BD_L_2_BStC_P_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DO i2 = LBOUND(SrcModuleMapTypeData%BStC_P_2_ED_P_B,2), UBOUND(SrcModuleMapTypeData%BStC_P_2_ED_P_B,2) + DO i1 = LBOUND(SrcModuleMapTypeData%BStC_P_2_ED_P_B,1), UBOUND(SrcModuleMapTypeData%BStC_P_2_ED_P_B,1) + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%BStC_P_2_ED_P_B(i1,i2), DstModuleMapTypeData%BStC_P_2_ED_P_B(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + ENDDO +ENDIF +IF (ALLOCATED(SrcModuleMapTypeData%BD_L_2_BStC_P_B)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%BD_L_2_BStC_P_B,1) + i1_u = UBOUND(SrcModuleMapTypeData%BD_L_2_BStC_P_B,1) + i2_l = LBOUND(SrcModuleMapTypeData%BD_L_2_BStC_P_B,2) + i2_u = UBOUND(SrcModuleMapTypeData%BD_L_2_BStC_P_B,2) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%BD_L_2_BStC_P_B)) THEN + ALLOCATE(DstModuleMapTypeData%BD_L_2_BStC_P_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BD_L_2_BStC_P_B.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BD_L_2_BStC_P_B.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i2 = LBOUND(OutData%BD_L_2_BStC_P_B,2), UBOUND(OutData%BD_L_2_BStC_P_B,2) - DO i1 = LBOUND(OutData%BD_L_2_BStC_P_B,1), UBOUND(OutData%BD_L_2_BStC_P_B,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%BD_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2 ) ! BD_L_2_BStC_P_B - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BStC_P_2_BD_P_B not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BStC_P_2_BD_P_B)) DEALLOCATE(OutData%BStC_P_2_BD_P_B) - ALLOCATE(OutData%BStC_P_2_BD_P_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DO i2 = LBOUND(SrcModuleMapTypeData%BD_L_2_BStC_P_B,2), UBOUND(SrcModuleMapTypeData%BD_L_2_BStC_P_B,2) + DO i1 = LBOUND(SrcModuleMapTypeData%BD_L_2_BStC_P_B,1), UBOUND(SrcModuleMapTypeData%BD_L_2_BStC_P_B,1) + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%BD_L_2_BStC_P_B(i1,i2), DstModuleMapTypeData%BD_L_2_BStC_P_B(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + ENDDO +ENDIF +IF (ALLOCATED(SrcModuleMapTypeData%BStC_P_2_BD_P_B)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%BStC_P_2_BD_P_B,1) + i1_u = UBOUND(SrcModuleMapTypeData%BStC_P_2_BD_P_B,1) + i2_l = LBOUND(SrcModuleMapTypeData%BStC_P_2_BD_P_B,2) + i2_u = UBOUND(SrcModuleMapTypeData%BStC_P_2_BD_P_B,2) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%BStC_P_2_BD_P_B)) THEN + ALLOCATE(DstModuleMapTypeData%BStC_P_2_BD_P_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC_P_2_BD_P_B.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BStC_P_2_BD_P_B.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i2 = LBOUND(OutData%BStC_P_2_BD_P_B,2), UBOUND(OutData%BStC_P_2_BD_P_B,2) - DO i1 = LBOUND(OutData%BStC_P_2_BD_P_B,1), UBOUND(OutData%BStC_P_2_BD_P_B,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%BStC_P_2_BD_P_B(i1,i2), ErrStat2, ErrMsg2 ) ! BStC_P_2_BD_P_B - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SStC_P_P_2_SubStructure not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SStC_P_P_2_SubStructure)) DEALLOCATE(OutData%SStC_P_P_2_SubStructure) - ALLOCATE(OutData%SStC_P_P_2_SubStructure(i1_l:i1_u),STAT=ErrStat2) + DO i2 = LBOUND(SrcModuleMapTypeData%BStC_P_2_BD_P_B,2), UBOUND(SrcModuleMapTypeData%BStC_P_2_BD_P_B,2) + DO i1 = LBOUND(SrcModuleMapTypeData%BStC_P_2_BD_P_B,1), UBOUND(SrcModuleMapTypeData%BStC_P_2_BD_P_B,1) + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%BStC_P_2_BD_P_B(i1,i2), DstModuleMapTypeData%BStC_P_2_BD_P_B(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + ENDDO +ENDIF +IF (ALLOCATED(SrcModuleMapTypeData%SStC_P_P_2_SubStructure)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%SStC_P_P_2_SubStructure,1) + i1_u = UBOUND(SrcModuleMapTypeData%SStC_P_P_2_SubStructure,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%SStC_P_P_2_SubStructure)) THEN + ALLOCATE(DstModuleMapTypeData%SStC_P_P_2_SubStructure(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC_P_P_2_SubStructure.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%SStC_P_P_2_SubStructure.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%SStC_P_P_2_SubStructure,1), UBOUND(OutData%SStC_P_P_2_SubStructure,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%SStC_P_P_2_SubStructure(i1), ErrStat2, ErrMsg2 ) ! SStC_P_P_2_SubStructure - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SubStructure_2_SStC_P_P not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SubStructure_2_SStC_P_P)) DEALLOCATE(OutData%SubStructure_2_SStC_P_P) - ALLOCATE(OutData%SubStructure_2_SStC_P_P(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(SrcModuleMapTypeData%SStC_P_P_2_SubStructure,1), UBOUND(SrcModuleMapTypeData%SStC_P_P_2_SubStructure,1) + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SStC_P_P_2_SubStructure(i1), DstModuleMapTypeData%SStC_P_P_2_SubStructure(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcModuleMapTypeData%SubStructure_2_SStC_P_P)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%SubStructure_2_SStC_P_P,1) + i1_u = UBOUND(SrcModuleMapTypeData%SubStructure_2_SStC_P_P,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%SubStructure_2_SStC_P_P)) THEN + ALLOCATE(DstModuleMapTypeData%SubStructure_2_SStC_P_P(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SubStructure_2_SStC_P_P.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%SubStructure_2_SStC_P_P.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%SubStructure_2_SStC_P_P,1), UBOUND(OutData%SubStructure_2_SStC_P_P,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%SubStructure_2_SStC_P_P(i1), ErrStat2, ErrMsg2 ) ! SubStructure_2_SStC_P_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_SrvD_P_P, ErrStat2, ErrMsg2 ) ! ED_P_2_SrvD_P_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BDED_L_2_AD_L_B not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BDED_L_2_AD_L_B)) DEALLOCATE(OutData%BDED_L_2_AD_L_B) - ALLOCATE(OutData%BDED_L_2_AD_L_B(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(SrcModuleMapTypeData%SubStructure_2_SStC_P_P,1), UBOUND(SrcModuleMapTypeData%SubStructure_2_SStC_P_P,1) + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SubStructure_2_SStC_P_P(i1), DstModuleMapTypeData%SubStructure_2_SStC_P_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_SrvD_P_P, DstModuleMapTypeData%ED_P_2_SrvD_P_P, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcModuleMapTypeData%BDED_L_2_AD_L_B)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%BDED_L_2_AD_L_B,1) + i1_u = UBOUND(SrcModuleMapTypeData%BDED_L_2_AD_L_B,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%BDED_L_2_AD_L_B)) THEN + ALLOCATE(DstModuleMapTypeData%BDED_L_2_AD_L_B(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BDED_L_2_AD_L_B.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BDED_L_2_AD_L_B.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%BDED_L_2_AD_L_B,1), UBOUND(OutData%BDED_L_2_AD_L_B,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%BDED_L_2_AD_L_B(i1), ErrStat2, ErrMsg2 ) ! BDED_L_2_AD_L_B - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AD_L_2_BDED_B not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AD_L_2_BDED_B)) DEALLOCATE(OutData%AD_L_2_BDED_B) - ALLOCATE(OutData%AD_L_2_BDED_B(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(SrcModuleMapTypeData%BDED_L_2_AD_L_B,1), UBOUND(SrcModuleMapTypeData%BDED_L_2_AD_L_B,1) + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%BDED_L_2_AD_L_B(i1), DstModuleMapTypeData%BDED_L_2_AD_L_B(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcModuleMapTypeData%AD_L_2_BDED_B)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%AD_L_2_BDED_B,1) + i1_u = UBOUND(SrcModuleMapTypeData%AD_L_2_BDED_B,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%AD_L_2_BDED_B)) THEN + ALLOCATE(DstModuleMapTypeData%AD_L_2_BDED_B(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AD_L_2_BDED_B.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%AD_L_2_BDED_B.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%AD_L_2_BDED_B,1), UBOUND(OutData%AD_L_2_BDED_B,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%AD_L_2_BDED_B(i1), ErrStat2, ErrMsg2 ) ! AD_L_2_BDED_B - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BD_L_2_BD_L not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BD_L_2_BD_L)) DEALLOCATE(OutData%BD_L_2_BD_L) - ALLOCATE(OutData%BD_L_2_BD_L(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(SrcModuleMapTypeData%AD_L_2_BDED_B,1), UBOUND(SrcModuleMapTypeData%AD_L_2_BDED_B,1) + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%AD_L_2_BDED_B(i1), DstModuleMapTypeData%AD_L_2_BDED_B(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcModuleMapTypeData%BD_L_2_BD_L)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%BD_L_2_BD_L,1) + i1_u = UBOUND(SrcModuleMapTypeData%BD_L_2_BD_L,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%BD_L_2_BD_L)) THEN + ALLOCATE(DstModuleMapTypeData%BD_L_2_BD_L(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BD_L_2_BD_L.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BD_L_2_BD_L.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%BD_L_2_BD_L,1), UBOUND(OutData%BD_L_2_BD_L,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%BD_L_2_BD_L(i1), ErrStat2, ErrMsg2 ) ! BD_L_2_BD_L - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_N - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%AD_P_2_ED_P_N, ErrStat2, ErrMsg2 ) ! AD_P_2_ED_P_N - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_TF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%AD_P_2_ED_P_TF, ErrStat2, ErrMsg2 ) ! AD_P_2_ED_P_TF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2 ) ! ED_L_2_AD_L_T - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2 ) ! AD_L_2_ED_P_T - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ED_P_2_AD_P_R not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ED_P_2_AD_P_R)) DEALLOCATE(OutData%ED_P_2_AD_P_R) - ALLOCATE(OutData%ED_P_2_AD_P_R(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(SrcModuleMapTypeData%BD_L_2_BD_L,1), UBOUND(SrcModuleMapTypeData%BD_L_2_BD_L,1) + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%BD_L_2_BD_L(i1), DstModuleMapTypeData%BD_L_2_BD_L(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_AD_P_N, DstModuleMapTypeData%ED_P_2_AD_P_N, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%AD_P_2_ED_P_N, DstModuleMapTypeData%AD_P_2_ED_P_N, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_AD_P_TF, DstModuleMapTypeData%ED_P_2_AD_P_TF, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%AD_P_2_ED_P_TF, DstModuleMapTypeData%AD_P_2_ED_P_TF, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_L_2_AD_L_T, DstModuleMapTypeData%ED_L_2_AD_L_T, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%AD_L_2_ED_P_T, DstModuleMapTypeData%AD_L_2_ED_P_T, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcModuleMapTypeData%ED_P_2_AD_P_R)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%ED_P_2_AD_P_R,1) + i1_u = UBOUND(SrcModuleMapTypeData%ED_P_2_AD_P_R,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%ED_P_2_AD_P_R)) THEN + ALLOCATE(DstModuleMapTypeData%ED_P_2_AD_P_R(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_AD_P_R.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_P_2_AD_P_R.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%ED_P_2_AD_P_R,1), UBOUND(OutData%ED_P_2_AD_P_R,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_R - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_H - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%AD_P_2_ED_P_H, ErrStat2, ErrMsg2 ) ! AD_P_2_ED_P_H - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%IceF_P_2_SD_P, ErrStat2, ErrMsg2 ) ! IceF_P_2_SD_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%SDy3_P_2_IceF_P, ErrStat2, ErrMsg2 ) ! SDy3_P_2_IceF_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IceD_P_2_SD_P not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IceD_P_2_SD_P)) DEALLOCATE(OutData%IceD_P_2_SD_P) - ALLOCATE(OutData%IceD_P_2_SD_P(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(SrcModuleMapTypeData%ED_P_2_AD_P_R,1), UBOUND(SrcModuleMapTypeData%ED_P_2_AD_P_R,1) + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_AD_P_R(i1), DstModuleMapTypeData%ED_P_2_AD_P_R(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_AD_P_H, DstModuleMapTypeData%ED_P_2_AD_P_H, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%AD_P_2_ED_P_H, DstModuleMapTypeData%AD_P_2_ED_P_H, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%IceF_P_2_SD_P, DstModuleMapTypeData%IceF_P_2_SD_P, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SDy3_P_2_IceF_P, DstModuleMapTypeData%SDy3_P_2_IceF_P, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcModuleMapTypeData%IceD_P_2_SD_P)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%IceD_P_2_SD_P,1) + i1_u = UBOUND(SrcModuleMapTypeData%IceD_P_2_SD_P,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%IceD_P_2_SD_P)) THEN + ALLOCATE(DstModuleMapTypeData%IceD_P_2_SD_P(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IceD_P_2_SD_P.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%IceD_P_2_SD_P.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%IceD_P_2_SD_P,1), UBOUND(OutData%IceD_P_2_SD_P,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%IceD_P_2_SD_P(i1), ErrStat2, ErrMsg2 ) ! IceD_P_2_SD_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SDy3_P_2_IceD_P not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SDy3_P_2_IceD_P)) DEALLOCATE(OutData%SDy3_P_2_IceD_P) - ALLOCATE(OutData%SDy3_P_2_IceD_P(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(SrcModuleMapTypeData%IceD_P_2_SD_P,1), UBOUND(SrcModuleMapTypeData%IceD_P_2_SD_P,1) + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%IceD_P_2_SD_P(i1), DstModuleMapTypeData%IceD_P_2_SD_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcModuleMapTypeData%SDy3_P_2_IceD_P)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%SDy3_P_2_IceD_P,1) + i1_u = UBOUND(SrcModuleMapTypeData%SDy3_P_2_IceD_P,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%SDy3_P_2_IceD_P)) THEN + ALLOCATE(DstModuleMapTypeData%SDy3_P_2_IceD_P(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SDy3_P_2_IceD_P.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%SDy3_P_2_IceD_P.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%SDy3_P_2_IceD_P,1), UBOUND(OutData%SDy3_P_2_IceD_P,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%SDy3_P_2_IceD_P(i1), ErrStat2, ErrMsg2 ) ! SDy3_P_2_IceD_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jacobian_Opt1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Jacobian_Opt1)) DEALLOCATE(OutData%Jacobian_Opt1) - ALLOCATE(OutData%Jacobian_Opt1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DO i1 = LBOUND(SrcModuleMapTypeData%SDy3_P_2_IceD_P,1), UBOUND(SrcModuleMapTypeData%SDy3_P_2_IceD_P,1) + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SDy3_P_2_IceD_P(i1), DstModuleMapTypeData%SDy3_P_2_IceD_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcModuleMapTypeData%Jacobian_Opt1)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%Jacobian_Opt1,1) + i1_u = UBOUND(SrcModuleMapTypeData%Jacobian_Opt1,1) + i2_l = LBOUND(SrcModuleMapTypeData%Jacobian_Opt1,2) + i2_u = UBOUND(SrcModuleMapTypeData%Jacobian_Opt1,2) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%Jacobian_Opt1)) THEN + ALLOCATE(DstModuleMapTypeData%Jacobian_Opt1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jacobian_Opt1.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%Jacobian_Opt1.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i2 = LBOUND(OutData%Jacobian_Opt1,2), UBOUND(OutData%Jacobian_Opt1,2) - DO i1 = LBOUND(OutData%Jacobian_Opt1,1), UBOUND(OutData%Jacobian_Opt1,1) - OutData%Jacobian_Opt1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jacobian_pivot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Jacobian_pivot)) DEALLOCATE(OutData%Jacobian_pivot) - ALLOCATE(OutData%Jacobian_pivot(i1_l:i1_u),STAT=ErrStat2) + DstModuleMapTypeData%Jacobian_Opt1 = SrcModuleMapTypeData%Jacobian_Opt1 +ENDIF +IF (ALLOCATED(SrcModuleMapTypeData%Jacobian_pivot)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%Jacobian_pivot,1) + i1_u = UBOUND(SrcModuleMapTypeData%Jacobian_pivot,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%Jacobian_pivot)) THEN + ALLOCATE(DstModuleMapTypeData%Jacobian_pivot(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jacobian_pivot.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%Jacobian_pivot.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%Jacobian_pivot,1), UBOUND(OutData%Jacobian_pivot,1) - OutData%Jacobian_pivot(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_u_indx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Jac_u_indx)) DEALLOCATE(OutData%Jac_u_indx) - ALLOCATE(OutData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DstModuleMapTypeData%Jacobian_pivot = SrcModuleMapTypeData%Jacobian_pivot +ENDIF +IF (ALLOCATED(SrcModuleMapTypeData%Jac_u_indx)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%Jac_u_indx,1) + i1_u = UBOUND(SrcModuleMapTypeData%Jac_u_indx,1) + i2_l = LBOUND(SrcModuleMapTypeData%Jac_u_indx,2) + i2_u = UBOUND(SrcModuleMapTypeData%Jac_u_indx,2) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%Jac_u_indx)) THEN + ALLOCATE(DstModuleMapTypeData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i2 = LBOUND(OutData%Jac_u_indx,2), UBOUND(OutData%Jac_u_indx,2) - DO i1 = LBOUND(OutData%Jac_u_indx,1), UBOUND(OutData%Jac_u_indx,1) - OutData%Jac_u_indx(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%u_ED_NacelleLoads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ED_NacelleLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%SubstructureLoads_Tmp, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! SubstructureLoads_Tmp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, 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%SubstructureLoads_Tmp2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! SubstructureLoads_Tmp2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, 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%PlatformLoads_Tmp, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PlatformLoads_Tmp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, 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%PlatformLoads_Tmp2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PlatformLoads_Tmp2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, 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%SubstructureLoads_Tmp_Farm, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! SubstructureLoads_Tmp_Farm - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%u_ED_TowerPtloads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ED_TowerPtloads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_ED_BladePtLoads not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%u_ED_BladePtLoads)) DEALLOCATE(OutData%u_ED_BladePtLoads) - ALLOCATE(OutData%u_ED_BladePtLoads(i1_l:i1_u),STAT=ErrStat2) + DstModuleMapTypeData%Jac_u_indx = SrcModuleMapTypeData%Jac_u_indx +ENDIF + CALL MeshCopy( SrcModuleMapTypeData%u_ED_NacelleLoads, DstModuleMapTypeData%u_ED_NacelleLoads, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MeshCopy( SrcModuleMapTypeData%SubstructureLoads_Tmp, DstModuleMapTypeData%SubstructureLoads_Tmp, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MeshCopy( SrcModuleMapTypeData%SubstructureLoads_Tmp2, DstModuleMapTypeData%SubstructureLoads_Tmp2, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MeshCopy( SrcModuleMapTypeData%PlatformLoads_Tmp, DstModuleMapTypeData%PlatformLoads_Tmp, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MeshCopy( SrcModuleMapTypeData%PlatformLoads_Tmp2, DstModuleMapTypeData%PlatformLoads_Tmp2, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MeshCopy( SrcModuleMapTypeData%SubstructureLoads_Tmp_Farm, DstModuleMapTypeData%SubstructureLoads_Tmp_Farm, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MeshCopy( SrcModuleMapTypeData%u_ED_TowerPtloads, DstModuleMapTypeData%u_ED_TowerPtloads, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcModuleMapTypeData%u_ED_BladePtLoads)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%u_ED_BladePtLoads,1) + i1_u = UBOUND(SrcModuleMapTypeData%u_ED_BladePtLoads,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%u_ED_BladePtLoads)) THEN + ALLOCATE(DstModuleMapTypeData%u_ED_BladePtLoads(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_ED_BladePtLoads.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_ED_BladePtLoads.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%u_ED_BladePtLoads,1), UBOUND(OutData%u_ED_BladePtLoads,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%u_ED_BladePtLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ED_BladePtLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%u_SD_TPMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_SD_TPMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%u_HD_M_Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_HD_M_Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%u_HD_W_Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_HD_W_Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%u_ED_HubPtLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ED_HubPtLoad - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%u_ED_HubPtLoad_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ED_HubPtLoad_2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_BD_RootMotion not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%u_BD_RootMotion)) DEALLOCATE(OutData%u_BD_RootMotion) - ALLOCATE(OutData%u_BD_RootMotion(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(SrcModuleMapTypeData%u_ED_BladePtLoads,1), UBOUND(SrcModuleMapTypeData%u_ED_BladePtLoads,1) + CALL MeshCopy( SrcModuleMapTypeData%u_ED_BladePtLoads(i1), DstModuleMapTypeData%u_ED_BladePtLoads(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + CALL MeshCopy( SrcModuleMapTypeData%u_SD_TPMesh, DstModuleMapTypeData%u_SD_TPMesh, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MeshCopy( SrcModuleMapTypeData%u_HD_M_Mesh, DstModuleMapTypeData%u_HD_M_Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MeshCopy( SrcModuleMapTypeData%u_HD_W_Mesh, DstModuleMapTypeData%u_HD_W_Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MeshCopy( SrcModuleMapTypeData%u_ED_HubPtLoad, DstModuleMapTypeData%u_ED_HubPtLoad, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MeshCopy( SrcModuleMapTypeData%u_ED_HubPtLoad_2, DstModuleMapTypeData%u_ED_HubPtLoad_2, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcModuleMapTypeData%u_BD_RootMotion)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%u_BD_RootMotion,1) + i1_u = UBOUND(SrcModuleMapTypeData%u_BD_RootMotion,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%u_BD_RootMotion)) THEN + ALLOCATE(DstModuleMapTypeData%u_BD_RootMotion(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BD_RootMotion.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_BD_RootMotion.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%u_BD_RootMotion,1), UBOUND(OutData%u_BD_RootMotion,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%u_BD_RootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_BD_RootMotion - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y_BD_BldMotion_4Loads not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%y_BD_BldMotion_4Loads)) DEALLOCATE(OutData%y_BD_BldMotion_4Loads) - ALLOCATE(OutData%y_BD_BldMotion_4Loads(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(SrcModuleMapTypeData%u_BD_RootMotion,1), UBOUND(SrcModuleMapTypeData%u_BD_RootMotion,1) + CALL MeshCopy( SrcModuleMapTypeData%u_BD_RootMotion(i1), DstModuleMapTypeData%u_BD_RootMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcModuleMapTypeData%y_BD_BldMotion_4Loads)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%y_BD_BldMotion_4Loads,1) + i1_u = UBOUND(SrcModuleMapTypeData%y_BD_BldMotion_4Loads,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%y_BD_BldMotion_4Loads)) THEN + ALLOCATE(DstModuleMapTypeData%y_BD_BldMotion_4Loads(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_BD_BldMotion_4Loads.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%y_BD_BldMotion_4Loads.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%y_BD_BldMotion_4Loads,1), UBOUND(OutData%y_BD_BldMotion_4Loads,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%y_BD_BldMotion_4Loads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! y_BD_BldMotion_4Loads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_BD_Distrload not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%u_BD_Distrload)) DEALLOCATE(OutData%u_BD_Distrload) - ALLOCATE(OutData%u_BD_Distrload(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(SrcModuleMapTypeData%y_BD_BldMotion_4Loads,1), UBOUND(SrcModuleMapTypeData%y_BD_BldMotion_4Loads,1) + CALL MeshCopy( SrcModuleMapTypeData%y_BD_BldMotion_4Loads(i1), DstModuleMapTypeData%y_BD_BldMotion_4Loads(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcModuleMapTypeData%u_BD_Distrload)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%u_BD_Distrload,1) + i1_u = UBOUND(SrcModuleMapTypeData%u_BD_Distrload,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%u_BD_Distrload)) THEN + ALLOCATE(DstModuleMapTypeData%u_BD_Distrload(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BD_Distrload.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_BD_Distrload.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%u_BD_Distrload,1), UBOUND(OutData%u_BD_Distrload,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%u_BD_Distrload(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_BD_Distrload - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%u_Orca_PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_Orca_PtfmMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + DO i1 = LBOUND(SrcModuleMapTypeData%u_BD_Distrload,1), UBOUND(SrcModuleMapTypeData%u_BD_Distrload,1) + CALL MeshCopy( SrcModuleMapTypeData%u_BD_Distrload(i1), DstModuleMapTypeData%u_BD_Distrload(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + CALL MeshCopy( SrcModuleMapTypeData%u_Orca_PtfmMesh, DstModuleMapTypeData%u_Orca_PtfmMesh, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MeshCopy( SrcModuleMapTypeData%u_ExtPtfm_PtfmMesh, DstModuleMapTypeData%u_ExtPtfm_PtfmMesh, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + END SUBROUTINE FAST_CopyModuleMapType + + SUBROUTINE FAST_DestroyModuleMapType( ModuleMapTypeData, ErrStat, ErrMsg ) + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: ModuleMapTypeData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyModuleMapType' + + ErrStat = ErrID_None + ErrMsg = "" - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%u_ExtPtfm_PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ExtPtfm_PtfmMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN +IF (ALLOCATED(ModuleMapTypeData%ED_P_2_BD_P)) THEN +DO i1 = LBOUND(ModuleMapTypeData%ED_P_2_BD_P,1), UBOUND(ModuleMapTypeData%ED_P_2_BD_P,1) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_P_2_BD_P(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(ModuleMapTypeData%ED_P_2_BD_P) +ENDIF +IF (ALLOCATED(ModuleMapTypeData%BD_P_2_ED_P)) THEN +DO i1 = LBOUND(ModuleMapTypeData%BD_P_2_ED_P,1), UBOUND(ModuleMapTypeData%BD_P_2_ED_P,1) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%BD_P_2_ED_P(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(ModuleMapTypeData%BD_P_2_ED_P) +ENDIF +IF (ALLOCATED(ModuleMapTypeData%ED_P_2_BD_P_Hub)) THEN +DO i1 = LBOUND(ModuleMapTypeData%ED_P_2_BD_P_Hub,1), UBOUND(ModuleMapTypeData%ED_P_2_BD_P_Hub,1) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_P_2_BD_P_Hub(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(ModuleMapTypeData%ED_P_2_BD_P_Hub) +ENDIF + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_P_2_HD_PRP_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%SubStructure_2_HD_W_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%HD_W_P_2_SubStructure, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%SubStructure_2_HD_M_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%HD_M_P_2_SubStructure, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%Structure_2_Mooring, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%Mooring_2_Structure, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%SD_TP_2_ED_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(ModuleMapTypeData%ED_P_2_NStC_P_N)) THEN +DO i1 = LBOUND(ModuleMapTypeData%ED_P_2_NStC_P_N,1), UBOUND(ModuleMapTypeData%ED_P_2_NStC_P_N,1) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_P_2_NStC_P_N(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(ModuleMapTypeData%ED_P_2_NStC_P_N) +ENDIF +IF (ALLOCATED(ModuleMapTypeData%NStC_P_2_ED_P_N)) THEN +DO i1 = LBOUND(ModuleMapTypeData%NStC_P_2_ED_P_N,1), UBOUND(ModuleMapTypeData%NStC_P_2_ED_P_N,1) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%NStC_P_2_ED_P_N(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(ModuleMapTypeData%NStC_P_2_ED_P_N) +ENDIF +IF (ALLOCATED(ModuleMapTypeData%ED_L_2_TStC_P_T)) THEN +DO i1 = LBOUND(ModuleMapTypeData%ED_L_2_TStC_P_T,1), UBOUND(ModuleMapTypeData%ED_L_2_TStC_P_T,1) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_L_2_TStC_P_T(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(ModuleMapTypeData%ED_L_2_TStC_P_T) +ENDIF +IF (ALLOCATED(ModuleMapTypeData%TStC_P_2_ED_P_T)) THEN +DO i1 = LBOUND(ModuleMapTypeData%TStC_P_2_ED_P_T,1), UBOUND(ModuleMapTypeData%TStC_P_2_ED_P_T,1) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%TStC_P_2_ED_P_T(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(ModuleMapTypeData%TStC_P_2_ED_P_T) +ENDIF +IF (ALLOCATED(ModuleMapTypeData%ED_L_2_BStC_P_B)) THEN +DO i2 = LBOUND(ModuleMapTypeData%ED_L_2_BStC_P_B,2), UBOUND(ModuleMapTypeData%ED_L_2_BStC_P_B,2) +DO i1 = LBOUND(ModuleMapTypeData%ED_L_2_BStC_P_B,1), UBOUND(ModuleMapTypeData%ED_L_2_BStC_P_B,1) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +ENDDO + DEALLOCATE(ModuleMapTypeData%ED_L_2_BStC_P_B) +ENDIF +IF (ALLOCATED(ModuleMapTypeData%BStC_P_2_ED_P_B)) THEN +DO i2 = LBOUND(ModuleMapTypeData%BStC_P_2_ED_P_B,2), UBOUND(ModuleMapTypeData%BStC_P_2_ED_P_B,2) +DO i1 = LBOUND(ModuleMapTypeData%BStC_P_2_ED_P_B,1), UBOUND(ModuleMapTypeData%BStC_P_2_ED_P_B,1) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%BStC_P_2_ED_P_B(i1,i2), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +ENDDO + DEALLOCATE(ModuleMapTypeData%BStC_P_2_ED_P_B) +ENDIF +IF (ALLOCATED(ModuleMapTypeData%BD_L_2_BStC_P_B)) THEN +DO i2 = LBOUND(ModuleMapTypeData%BD_L_2_BStC_P_B,2), UBOUND(ModuleMapTypeData%BD_L_2_BStC_P_B,2) +DO i1 = LBOUND(ModuleMapTypeData%BD_L_2_BStC_P_B,1), UBOUND(ModuleMapTypeData%BD_L_2_BStC_P_B,1) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%BD_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +ENDDO + DEALLOCATE(ModuleMapTypeData%BD_L_2_BStC_P_B) +ENDIF +IF (ALLOCATED(ModuleMapTypeData%BStC_P_2_BD_P_B)) THEN +DO i2 = LBOUND(ModuleMapTypeData%BStC_P_2_BD_P_B,2), UBOUND(ModuleMapTypeData%BStC_P_2_BD_P_B,2) +DO i1 = LBOUND(ModuleMapTypeData%BStC_P_2_BD_P_B,1), UBOUND(ModuleMapTypeData%BStC_P_2_BD_P_B,1) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%BStC_P_2_BD_P_B(i1,i2), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO +ENDDO + DEALLOCATE(ModuleMapTypeData%BStC_P_2_BD_P_B) +ENDIF +IF (ALLOCATED(ModuleMapTypeData%SStC_P_P_2_SubStructure)) THEN +DO i1 = LBOUND(ModuleMapTypeData%SStC_P_P_2_SubStructure,1), UBOUND(ModuleMapTypeData%SStC_P_P_2_SubStructure,1) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%SStC_P_P_2_SubStructure(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(ModuleMapTypeData%SStC_P_P_2_SubStructure) +ENDIF +IF (ALLOCATED(ModuleMapTypeData%SubStructure_2_SStC_P_P)) THEN +DO i1 = LBOUND(ModuleMapTypeData%SubStructure_2_SStC_P_P,1), UBOUND(ModuleMapTypeData%SubStructure_2_SStC_P_P,1) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%SubStructure_2_SStC_P_P(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(ModuleMapTypeData%SubStructure_2_SStC_P_P) +ENDIF + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_P_2_SrvD_P_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(ModuleMapTypeData%BDED_L_2_AD_L_B)) THEN +DO i1 = LBOUND(ModuleMapTypeData%BDED_L_2_AD_L_B,1), UBOUND(ModuleMapTypeData%BDED_L_2_AD_L_B,1) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%BDED_L_2_AD_L_B(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(ModuleMapTypeData%BDED_L_2_AD_L_B) +ENDIF +IF (ALLOCATED(ModuleMapTypeData%AD_L_2_BDED_B)) THEN +DO i1 = LBOUND(ModuleMapTypeData%AD_L_2_BDED_B,1), UBOUND(ModuleMapTypeData%AD_L_2_BDED_B,1) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%AD_L_2_BDED_B(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(ModuleMapTypeData%AD_L_2_BDED_B) +ENDIF +IF (ALLOCATED(ModuleMapTypeData%BD_L_2_BD_L)) THEN +DO i1 = LBOUND(ModuleMapTypeData%BD_L_2_BD_L,1), UBOUND(ModuleMapTypeData%BD_L_2_BD_L,1) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%BD_L_2_BD_L(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(ModuleMapTypeData%BD_L_2_BD_L) +ENDIF + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%AD_P_2_ED_P_N, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%AD_P_2_ED_P_TF, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(ModuleMapTypeData%ED_P_2_AD_P_R)) THEN +DO i1 = LBOUND(ModuleMapTypeData%ED_P_2_AD_P_R,1), UBOUND(ModuleMapTypeData%ED_P_2_AD_P_R,1) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(ModuleMapTypeData%ED_P_2_AD_P_R) +ENDIF + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%AD_P_2_ED_P_H, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%IceF_P_2_SD_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%SDy3_P_2_IceF_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(ModuleMapTypeData%IceD_P_2_SD_P)) THEN +DO i1 = LBOUND(ModuleMapTypeData%IceD_P_2_SD_P,1), UBOUND(ModuleMapTypeData%IceD_P_2_SD_P,1) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%IceD_P_2_SD_P(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(ModuleMapTypeData%IceD_P_2_SD_P) +ENDIF +IF (ALLOCATED(ModuleMapTypeData%SDy3_P_2_IceD_P)) THEN +DO i1 = LBOUND(ModuleMapTypeData%SDy3_P_2_IceD_P,1), UBOUND(ModuleMapTypeData%SDy3_P_2_IceD_P,1) + CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%SDy3_P_2_IceD_P(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(ModuleMapTypeData%SDy3_P_2_IceD_P) +ENDIF +IF (ALLOCATED(ModuleMapTypeData%Jacobian_Opt1)) THEN + DEALLOCATE(ModuleMapTypeData%Jacobian_Opt1) +ENDIF +IF (ALLOCATED(ModuleMapTypeData%Jacobian_pivot)) THEN + DEALLOCATE(ModuleMapTypeData%Jacobian_pivot) +ENDIF +IF (ALLOCATED(ModuleMapTypeData%Jac_u_indx)) THEN + DEALLOCATE(ModuleMapTypeData%Jac_u_indx) +ENDIF + CALL MeshDestroy( ModuleMapTypeData%u_ED_NacelleLoads, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL MeshDestroy( ModuleMapTypeData%SubstructureLoads_Tmp, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL MeshDestroy( ModuleMapTypeData%SubstructureLoads_Tmp2, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL MeshDestroy( ModuleMapTypeData%PlatformLoads_Tmp, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL MeshDestroy( ModuleMapTypeData%PlatformLoads_Tmp2, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL MeshDestroy( ModuleMapTypeData%SubstructureLoads_Tmp_Farm, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL MeshDestroy( ModuleMapTypeData%u_ED_TowerPtloads, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(ModuleMapTypeData%u_ED_BladePtLoads)) THEN +DO i1 = LBOUND(ModuleMapTypeData%u_ED_BladePtLoads,1), UBOUND(ModuleMapTypeData%u_ED_BladePtLoads,1) + CALL MeshDestroy( ModuleMapTypeData%u_ED_BladePtLoads(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(ModuleMapTypeData%u_ED_BladePtLoads) +ENDIF + CALL MeshDestroy( ModuleMapTypeData%u_SD_TPMesh, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL MeshDestroy( ModuleMapTypeData%u_HD_M_Mesh, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL MeshDestroy( ModuleMapTypeData%u_HD_W_Mesh, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL MeshDestroy( ModuleMapTypeData%u_ED_HubPtLoad, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL MeshDestroy( ModuleMapTypeData%u_ED_HubPtLoad_2, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +IF (ALLOCATED(ModuleMapTypeData%u_BD_RootMotion)) THEN +DO i1 = LBOUND(ModuleMapTypeData%u_BD_RootMotion,1), UBOUND(ModuleMapTypeData%u_BD_RootMotion,1) + CALL MeshDestroy( ModuleMapTypeData%u_BD_RootMotion(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(ModuleMapTypeData%u_BD_RootMotion) +ENDIF +IF (ALLOCATED(ModuleMapTypeData%y_BD_BldMotion_4Loads)) THEN +DO i1 = LBOUND(ModuleMapTypeData%y_BD_BldMotion_4Loads,1), UBOUND(ModuleMapTypeData%y_BD_BldMotion_4Loads,1) + CALL MeshDestroy( ModuleMapTypeData%y_BD_BldMotion_4Loads(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(ModuleMapTypeData%y_BD_BldMotion_4Loads) +ENDIF +IF (ALLOCATED(ModuleMapTypeData%u_BD_Distrload)) THEN +DO i1 = LBOUND(ModuleMapTypeData%u_BD_Distrload,1), UBOUND(ModuleMapTypeData%u_BD_Distrload,1) + CALL MeshDestroy( ModuleMapTypeData%u_BD_Distrload(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(ModuleMapTypeData%u_BD_Distrload) +ENDIF + CALL MeshDestroy( ModuleMapTypeData%u_Orca_PtfmMesh, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL MeshDestroy( ModuleMapTypeData%u_ExtPtfm_PtfmMesh, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END SUBROUTINE FAST_DestroyModuleMapType - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE FAST_UnPackModuleMapType +subroutine FAST_PackModuleMapType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FAST_ModuleMapType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackModuleMapType' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + ! ED_P_2_BD_P + call RegPack(Buf, allocated(InData%ED_P_2_BD_P)) + if (allocated(InData%ED_P_2_BD_P)) then + call RegPackBounds(Buf, 1, lbound(InData%ED_P_2_BD_P), ubound(InData%ED_P_2_BD_P)) + LB(1:1) = lbound(InData%ED_P_2_BD_P) + UB(1:1) = ubound(InData%ED_P_2_BD_P) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_BD_P(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BD_P_2_ED_P + call RegPack(Buf, allocated(InData%BD_P_2_ED_P)) + if (allocated(InData%BD_P_2_ED_P)) then + call RegPackBounds(Buf, 1, lbound(InData%BD_P_2_ED_P), ubound(InData%BD_P_2_ED_P)) + LB(1:1) = lbound(InData%BD_P_2_ED_P) + UB(1:1) = ubound(InData%BD_P_2_ED_P) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%BD_P_2_ED_P(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ED_P_2_BD_P_Hub + call RegPack(Buf, allocated(InData%ED_P_2_BD_P_Hub)) + if (allocated(InData%ED_P_2_BD_P_Hub)) then + call RegPackBounds(Buf, 1, lbound(InData%ED_P_2_BD_P_Hub), ubound(InData%ED_P_2_BD_P_Hub)) + LB(1:1) = lbound(InData%ED_P_2_BD_P_Hub) + UB(1:1) = ubound(InData%ED_P_2_BD_P_Hub) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_BD_P_Hub(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ED_P_2_HD_PRP_P + call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_HD_PRP_P) + if (RegCheckErr(Buf, RoutineName)) return + ! SubStructure_2_HD_W_P + call NWTC_Library_PackMeshMapType(Buf, InData%SubStructure_2_HD_W_P) + if (RegCheckErr(Buf, RoutineName)) return + ! HD_W_P_2_SubStructure + call NWTC_Library_PackMeshMapType(Buf, InData%HD_W_P_2_SubStructure) + if (RegCheckErr(Buf, RoutineName)) return + ! SubStructure_2_HD_M_P + call NWTC_Library_PackMeshMapType(Buf, InData%SubStructure_2_HD_M_P) + if (RegCheckErr(Buf, RoutineName)) return + ! HD_M_P_2_SubStructure + call NWTC_Library_PackMeshMapType(Buf, InData%HD_M_P_2_SubStructure) + if (RegCheckErr(Buf, RoutineName)) return + ! Structure_2_Mooring + call NWTC_Library_PackMeshMapType(Buf, InData%Structure_2_Mooring) + if (RegCheckErr(Buf, RoutineName)) return + ! Mooring_2_Structure + call NWTC_Library_PackMeshMapType(Buf, InData%Mooring_2_Structure) + if (RegCheckErr(Buf, RoutineName)) return + ! ED_P_2_SD_TP + call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_SD_TP) + if (RegCheckErr(Buf, RoutineName)) return + ! SD_TP_2_ED_P + call NWTC_Library_PackMeshMapType(Buf, InData%SD_TP_2_ED_P) + if (RegCheckErr(Buf, RoutineName)) return + ! ED_P_2_NStC_P_N + call RegPack(Buf, allocated(InData%ED_P_2_NStC_P_N)) + if (allocated(InData%ED_P_2_NStC_P_N)) then + call RegPackBounds(Buf, 1, lbound(InData%ED_P_2_NStC_P_N), ubound(InData%ED_P_2_NStC_P_N)) + LB(1:1) = lbound(InData%ED_P_2_NStC_P_N) + UB(1:1) = ubound(InData%ED_P_2_NStC_P_N) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_NStC_P_N(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NStC_P_2_ED_P_N + call RegPack(Buf, allocated(InData%NStC_P_2_ED_P_N)) + if (allocated(InData%NStC_P_2_ED_P_N)) then + call RegPackBounds(Buf, 1, lbound(InData%NStC_P_2_ED_P_N), ubound(InData%NStC_P_2_ED_P_N)) + LB(1:1) = lbound(InData%NStC_P_2_ED_P_N) + UB(1:1) = ubound(InData%NStC_P_2_ED_P_N) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%NStC_P_2_ED_P_N(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ED_L_2_TStC_P_T + call RegPack(Buf, allocated(InData%ED_L_2_TStC_P_T)) + if (allocated(InData%ED_L_2_TStC_P_T)) then + call RegPackBounds(Buf, 1, lbound(InData%ED_L_2_TStC_P_T), ubound(InData%ED_L_2_TStC_P_T)) + LB(1:1) = lbound(InData%ED_L_2_TStC_P_T) + UB(1:1) = ubound(InData%ED_L_2_TStC_P_T) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%ED_L_2_TStC_P_T(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TStC_P_2_ED_P_T + call RegPack(Buf, allocated(InData%TStC_P_2_ED_P_T)) + if (allocated(InData%TStC_P_2_ED_P_T)) then + call RegPackBounds(Buf, 1, lbound(InData%TStC_P_2_ED_P_T), ubound(InData%TStC_P_2_ED_P_T)) + LB(1:1) = lbound(InData%TStC_P_2_ED_P_T) + UB(1:1) = ubound(InData%TStC_P_2_ED_P_T) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%TStC_P_2_ED_P_T(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ED_L_2_BStC_P_B + call RegPack(Buf, allocated(InData%ED_L_2_BStC_P_B)) + if (allocated(InData%ED_L_2_BStC_P_B)) then + call RegPackBounds(Buf, 2, lbound(InData%ED_L_2_BStC_P_B), ubound(InData%ED_L_2_BStC_P_B)) + LB(1:2) = lbound(InData%ED_L_2_BStC_P_B) + UB(1:2) = ubound(InData%ED_L_2_BStC_P_B) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%ED_L_2_BStC_P_B(i1,i2)) + end do + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BStC_P_2_ED_P_B + call RegPack(Buf, allocated(InData%BStC_P_2_ED_P_B)) + if (allocated(InData%BStC_P_2_ED_P_B)) then + call RegPackBounds(Buf, 2, lbound(InData%BStC_P_2_ED_P_B), ubound(InData%BStC_P_2_ED_P_B)) + LB(1:2) = lbound(InData%BStC_P_2_ED_P_B) + UB(1:2) = ubound(InData%BStC_P_2_ED_P_B) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%BStC_P_2_ED_P_B(i1,i2)) + end do + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BD_L_2_BStC_P_B + call RegPack(Buf, allocated(InData%BD_L_2_BStC_P_B)) + if (allocated(InData%BD_L_2_BStC_P_B)) then + call RegPackBounds(Buf, 2, lbound(InData%BD_L_2_BStC_P_B), ubound(InData%BD_L_2_BStC_P_B)) + LB(1:2) = lbound(InData%BD_L_2_BStC_P_B) + UB(1:2) = ubound(InData%BD_L_2_BStC_P_B) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%BD_L_2_BStC_P_B(i1,i2)) + end do + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BStC_P_2_BD_P_B + call RegPack(Buf, allocated(InData%BStC_P_2_BD_P_B)) + if (allocated(InData%BStC_P_2_BD_P_B)) then + call RegPackBounds(Buf, 2, lbound(InData%BStC_P_2_BD_P_B), ubound(InData%BStC_P_2_BD_P_B)) + LB(1:2) = lbound(InData%BStC_P_2_BD_P_B) + UB(1:2) = ubound(InData%BStC_P_2_BD_P_B) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%BStC_P_2_BD_P_B(i1,i2)) + end do + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SStC_P_P_2_SubStructure + call RegPack(Buf, allocated(InData%SStC_P_P_2_SubStructure)) + if (allocated(InData%SStC_P_P_2_SubStructure)) then + call RegPackBounds(Buf, 1, lbound(InData%SStC_P_P_2_SubStructure), ubound(InData%SStC_P_P_2_SubStructure)) + LB(1:1) = lbound(InData%SStC_P_P_2_SubStructure) + UB(1:1) = ubound(InData%SStC_P_P_2_SubStructure) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%SStC_P_P_2_SubStructure(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SubStructure_2_SStC_P_P + call RegPack(Buf, allocated(InData%SubStructure_2_SStC_P_P)) + if (allocated(InData%SubStructure_2_SStC_P_P)) then + call RegPackBounds(Buf, 1, lbound(InData%SubStructure_2_SStC_P_P), ubound(InData%SubStructure_2_SStC_P_P)) + LB(1:1) = lbound(InData%SubStructure_2_SStC_P_P) + UB(1:1) = ubound(InData%SubStructure_2_SStC_P_P) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%SubStructure_2_SStC_P_P(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ED_P_2_SrvD_P_P + call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_SrvD_P_P) + if (RegCheckErr(Buf, RoutineName)) return + ! BDED_L_2_AD_L_B + call RegPack(Buf, allocated(InData%BDED_L_2_AD_L_B)) + if (allocated(InData%BDED_L_2_AD_L_B)) then + call RegPackBounds(Buf, 1, lbound(InData%BDED_L_2_AD_L_B), ubound(InData%BDED_L_2_AD_L_B)) + LB(1:1) = lbound(InData%BDED_L_2_AD_L_B) + UB(1:1) = ubound(InData%BDED_L_2_AD_L_B) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%BDED_L_2_AD_L_B(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AD_L_2_BDED_B + call RegPack(Buf, allocated(InData%AD_L_2_BDED_B)) + if (allocated(InData%AD_L_2_BDED_B)) then + call RegPackBounds(Buf, 1, lbound(InData%AD_L_2_BDED_B), ubound(InData%AD_L_2_BDED_B)) + LB(1:1) = lbound(InData%AD_L_2_BDED_B) + UB(1:1) = ubound(InData%AD_L_2_BDED_B) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%AD_L_2_BDED_B(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BD_L_2_BD_L + call RegPack(Buf, allocated(InData%BD_L_2_BD_L)) + if (allocated(InData%BD_L_2_BD_L)) then + call RegPackBounds(Buf, 1, lbound(InData%BD_L_2_BD_L), ubound(InData%BD_L_2_BD_L)) + LB(1:1) = lbound(InData%BD_L_2_BD_L) + UB(1:1) = ubound(InData%BD_L_2_BD_L) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%BD_L_2_BD_L(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ED_P_2_AD_P_N + call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_AD_P_N) + if (RegCheckErr(Buf, RoutineName)) return + ! AD_P_2_ED_P_N + call NWTC_Library_PackMeshMapType(Buf, InData%AD_P_2_ED_P_N) + if (RegCheckErr(Buf, RoutineName)) return + ! ED_P_2_AD_P_TF + call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_AD_P_TF) + if (RegCheckErr(Buf, RoutineName)) return + ! AD_P_2_ED_P_TF + call NWTC_Library_PackMeshMapType(Buf, InData%AD_P_2_ED_P_TF) + if (RegCheckErr(Buf, RoutineName)) return + ! ED_L_2_AD_L_T + call NWTC_Library_PackMeshMapType(Buf, InData%ED_L_2_AD_L_T) + if (RegCheckErr(Buf, RoutineName)) return + ! AD_L_2_ED_P_T + call NWTC_Library_PackMeshMapType(Buf, InData%AD_L_2_ED_P_T) + if (RegCheckErr(Buf, RoutineName)) return + ! ED_P_2_AD_P_R + call RegPack(Buf, allocated(InData%ED_P_2_AD_P_R)) + if (allocated(InData%ED_P_2_AD_P_R)) then + call RegPackBounds(Buf, 1, lbound(InData%ED_P_2_AD_P_R), ubound(InData%ED_P_2_AD_P_R)) + LB(1:1) = lbound(InData%ED_P_2_AD_P_R) + UB(1:1) = ubound(InData%ED_P_2_AD_P_R) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_AD_P_R(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ED_P_2_AD_P_H + call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_AD_P_H) + if (RegCheckErr(Buf, RoutineName)) return + ! AD_P_2_ED_P_H + call NWTC_Library_PackMeshMapType(Buf, InData%AD_P_2_ED_P_H) + if (RegCheckErr(Buf, RoutineName)) return + ! IceF_P_2_SD_P + call NWTC_Library_PackMeshMapType(Buf, InData%IceF_P_2_SD_P) + if (RegCheckErr(Buf, RoutineName)) return + ! SDy3_P_2_IceF_P + call NWTC_Library_PackMeshMapType(Buf, InData%SDy3_P_2_IceF_P) + if (RegCheckErr(Buf, RoutineName)) return + ! IceD_P_2_SD_P + call RegPack(Buf, allocated(InData%IceD_P_2_SD_P)) + if (allocated(InData%IceD_P_2_SD_P)) then + call RegPackBounds(Buf, 1, lbound(InData%IceD_P_2_SD_P), ubound(InData%IceD_P_2_SD_P)) + LB(1:1) = lbound(InData%IceD_P_2_SD_P) + UB(1:1) = ubound(InData%IceD_P_2_SD_P) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%IceD_P_2_SD_P(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SDy3_P_2_IceD_P + call RegPack(Buf, allocated(InData%SDy3_P_2_IceD_P)) + if (allocated(InData%SDy3_P_2_IceD_P)) then + call RegPackBounds(Buf, 1, lbound(InData%SDy3_P_2_IceD_P), ubound(InData%SDy3_P_2_IceD_P)) + LB(1:1) = lbound(InData%SDy3_P_2_IceD_P) + UB(1:1) = ubound(InData%SDy3_P_2_IceD_P) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%SDy3_P_2_IceD_P(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Jacobian_Opt1 + call RegPack(Buf, allocated(InData%Jacobian_Opt1)) + if (allocated(InData%Jacobian_Opt1)) then + call RegPackBounds(Buf, 2, lbound(InData%Jacobian_Opt1), ubound(InData%Jacobian_Opt1)) + call RegPack(Buf, InData%Jacobian_Opt1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Jacobian_pivot + call RegPack(Buf, allocated(InData%Jacobian_pivot)) + if (allocated(InData%Jacobian_pivot)) then + call RegPackBounds(Buf, 1, lbound(InData%Jacobian_pivot), ubound(InData%Jacobian_pivot)) + call RegPack(Buf, InData%Jacobian_pivot) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_u_indx + call RegPack(Buf, allocated(InData%Jac_u_indx)) + if (allocated(InData%Jac_u_indx)) then + call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx), ubound(InData%Jac_u_indx)) + call RegPack(Buf, InData%Jac_u_indx) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! u_ED_NacelleLoads + call MeshPack(Buf, InData%u_ED_NacelleLoads) + if (RegCheckErr(Buf, RoutineName)) return + ! SubstructureLoads_Tmp + call MeshPack(Buf, InData%SubstructureLoads_Tmp) + if (RegCheckErr(Buf, RoutineName)) return + ! SubstructureLoads_Tmp2 + call MeshPack(Buf, InData%SubstructureLoads_Tmp2) + if (RegCheckErr(Buf, RoutineName)) return + ! PlatformLoads_Tmp + call MeshPack(Buf, InData%PlatformLoads_Tmp) + if (RegCheckErr(Buf, RoutineName)) return + ! PlatformLoads_Tmp2 + call MeshPack(Buf, InData%PlatformLoads_Tmp2) + if (RegCheckErr(Buf, RoutineName)) return + ! SubstructureLoads_Tmp_Farm + call MeshPack(Buf, InData%SubstructureLoads_Tmp_Farm) + if (RegCheckErr(Buf, RoutineName)) return + ! u_ED_TowerPtloads + call MeshPack(Buf, InData%u_ED_TowerPtloads) + if (RegCheckErr(Buf, RoutineName)) return + ! u_ED_BladePtLoads + call RegPack(Buf, allocated(InData%u_ED_BladePtLoads)) + if (allocated(InData%u_ED_BladePtLoads)) then + call RegPackBounds(Buf, 1, lbound(InData%u_ED_BladePtLoads), ubound(InData%u_ED_BladePtLoads)) + LB(1:1) = lbound(InData%u_ED_BladePtLoads) + UB(1:1) = ubound(InData%u_ED_BladePtLoads) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%u_ED_BladePtLoads(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! u_SD_TPMesh + call MeshPack(Buf, InData%u_SD_TPMesh) + if (RegCheckErr(Buf, RoutineName)) return + ! u_HD_M_Mesh + call MeshPack(Buf, InData%u_HD_M_Mesh) + if (RegCheckErr(Buf, RoutineName)) return + ! u_HD_W_Mesh + call MeshPack(Buf, InData%u_HD_W_Mesh) + if (RegCheckErr(Buf, RoutineName)) return + ! u_ED_HubPtLoad + call MeshPack(Buf, InData%u_ED_HubPtLoad) + if (RegCheckErr(Buf, RoutineName)) return + ! u_ED_HubPtLoad_2 + call MeshPack(Buf, InData%u_ED_HubPtLoad_2) + if (RegCheckErr(Buf, RoutineName)) return + ! u_BD_RootMotion + call RegPack(Buf, allocated(InData%u_BD_RootMotion)) + if (allocated(InData%u_BD_RootMotion)) then + call RegPackBounds(Buf, 1, lbound(InData%u_BD_RootMotion), ubound(InData%u_BD_RootMotion)) + LB(1:1) = lbound(InData%u_BD_RootMotion) + UB(1:1) = ubound(InData%u_BD_RootMotion) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%u_BD_RootMotion(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! y_BD_BldMotion_4Loads + call RegPack(Buf, allocated(InData%y_BD_BldMotion_4Loads)) + if (allocated(InData%y_BD_BldMotion_4Loads)) then + call RegPackBounds(Buf, 1, lbound(InData%y_BD_BldMotion_4Loads), ubound(InData%y_BD_BldMotion_4Loads)) + LB(1:1) = lbound(InData%y_BD_BldMotion_4Loads) + UB(1:1) = ubound(InData%y_BD_BldMotion_4Loads) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%y_BD_BldMotion_4Loads(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! u_BD_Distrload + call RegPack(Buf, allocated(InData%u_BD_Distrload)) + if (allocated(InData%u_BD_Distrload)) then + call RegPackBounds(Buf, 1, lbound(InData%u_BD_Distrload), ubound(InData%u_BD_Distrload)) + LB(1:1) = lbound(InData%u_BD_Distrload) + UB(1:1) = ubound(InData%u_BD_Distrload) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%u_BD_Distrload(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! u_Orca_PtfmMesh + call MeshPack(Buf, InData%u_Orca_PtfmMesh) + if (RegCheckErr(Buf, RoutineName)) return + ! u_ExtPtfm_PtfmMesh + call MeshPack(Buf, InData%u_ExtPtfm_PtfmMesh) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackModuleMapType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FAST_ModuleMapType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackModuleMapType' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! ED_P_2_BD_P + if (allocated(OutData%ED_P_2_BD_P)) deallocate(OutData%ED_P_2_BD_P) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ED_P_2_BD_P(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_BD_P.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_BD_P(i1)) ! ED_P_2_BD_P + end do + end if + ! BD_P_2_ED_P + if (allocated(OutData%BD_P_2_ED_P)) deallocate(OutData%BD_P_2_ED_P) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BD_P_2_ED_P(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BD_P_2_ED_P.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%BD_P_2_ED_P(i1)) ! BD_P_2_ED_P + end do + end if + ! ED_P_2_BD_P_Hub + if (allocated(OutData%ED_P_2_BD_P_Hub)) deallocate(OutData%ED_P_2_BD_P_Hub) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ED_P_2_BD_P_Hub(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_BD_P_Hub.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_BD_P_Hub(i1)) ! ED_P_2_BD_P_Hub + end do + end if + ! ED_P_2_HD_PRP_P + call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_HD_PRP_P) ! ED_P_2_HD_PRP_P + ! SubStructure_2_HD_W_P + call NWTC_Library_UnpackMeshMapType(Buf, OutData%SubStructure_2_HD_W_P) ! SubStructure_2_HD_W_P + ! HD_W_P_2_SubStructure + call NWTC_Library_UnpackMeshMapType(Buf, OutData%HD_W_P_2_SubStructure) ! HD_W_P_2_SubStructure + ! SubStructure_2_HD_M_P + call NWTC_Library_UnpackMeshMapType(Buf, OutData%SubStructure_2_HD_M_P) ! SubStructure_2_HD_M_P + ! HD_M_P_2_SubStructure + call NWTC_Library_UnpackMeshMapType(Buf, OutData%HD_M_P_2_SubStructure) ! HD_M_P_2_SubStructure + ! Structure_2_Mooring + call NWTC_Library_UnpackMeshMapType(Buf, OutData%Structure_2_Mooring) ! Structure_2_Mooring + ! Mooring_2_Structure + call NWTC_Library_UnpackMeshMapType(Buf, OutData%Mooring_2_Structure) ! Mooring_2_Structure + ! ED_P_2_SD_TP + call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_SD_TP) ! ED_P_2_SD_TP + ! SD_TP_2_ED_P + call NWTC_Library_UnpackMeshMapType(Buf, OutData%SD_TP_2_ED_P) ! SD_TP_2_ED_P + ! ED_P_2_NStC_P_N + if (allocated(OutData%ED_P_2_NStC_P_N)) deallocate(OutData%ED_P_2_NStC_P_N) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ED_P_2_NStC_P_N(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_NStC_P_N.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_NStC_P_N(i1)) ! ED_P_2_NStC_P_N + end do + end if + ! NStC_P_2_ED_P_N + if (allocated(OutData%NStC_P_2_ED_P_N)) deallocate(OutData%NStC_P_2_ED_P_N) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NStC_P_2_ED_P_N(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC_P_2_ED_P_N.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%NStC_P_2_ED_P_N(i1)) ! NStC_P_2_ED_P_N + end do + end if + ! ED_L_2_TStC_P_T + if (allocated(OutData%ED_L_2_TStC_P_T)) deallocate(OutData%ED_L_2_TStC_P_T) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ED_L_2_TStC_P_T(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_L_2_TStC_P_T.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_L_2_TStC_P_T(i1)) ! ED_L_2_TStC_P_T + end do + end if + ! TStC_P_2_ED_P_T + if (allocated(OutData%TStC_P_2_ED_P_T)) deallocate(OutData%TStC_P_2_ED_P_T) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TStC_P_2_ED_P_T(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC_P_2_ED_P_T.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%TStC_P_2_ED_P_T(i1)) ! TStC_P_2_ED_P_T + end do + end if + ! ED_L_2_BStC_P_B + if (allocated(OutData%ED_L_2_BStC_P_B)) deallocate(OutData%ED_L_2_BStC_P_B) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ED_L_2_BStC_P_B(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_L_2_BStC_P_B.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_L_2_BStC_P_B(i1,i2)) ! ED_L_2_BStC_P_B + end do + end do + end if + ! BStC_P_2_ED_P_B + if (allocated(OutData%BStC_P_2_ED_P_B)) deallocate(OutData%BStC_P_2_ED_P_B) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BStC_P_2_ED_P_B(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC_P_2_ED_P_B.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%BStC_P_2_ED_P_B(i1,i2)) ! BStC_P_2_ED_P_B + end do + end do + end if + ! BD_L_2_BStC_P_B + if (allocated(OutData%BD_L_2_BStC_P_B)) deallocate(OutData%BD_L_2_BStC_P_B) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BD_L_2_BStC_P_B(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BD_L_2_BStC_P_B.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%BD_L_2_BStC_P_B(i1,i2)) ! BD_L_2_BStC_P_B + end do + end do + end if + ! BStC_P_2_BD_P_B + if (allocated(OutData%BStC_P_2_BD_P_B)) deallocate(OutData%BStC_P_2_BD_P_B) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BStC_P_2_BD_P_B(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC_P_2_BD_P_B.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%BStC_P_2_BD_P_B(i1,i2)) ! BStC_P_2_BD_P_B + end do + end do + end if + ! SStC_P_P_2_SubStructure + if (allocated(OutData%SStC_P_P_2_SubStructure)) deallocate(OutData%SStC_P_P_2_SubStructure) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SStC_P_P_2_SubStructure(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC_P_P_2_SubStructure.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%SStC_P_P_2_SubStructure(i1)) ! SStC_P_P_2_SubStructure + end do + end if + ! SubStructure_2_SStC_P_P + if (allocated(OutData%SubStructure_2_SStC_P_P)) deallocate(OutData%SubStructure_2_SStC_P_P) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SubStructure_2_SStC_P_P(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SubStructure_2_SStC_P_P.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%SubStructure_2_SStC_P_P(i1)) ! SubStructure_2_SStC_P_P + end do + end if + ! ED_P_2_SrvD_P_P + call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_SrvD_P_P) ! ED_P_2_SrvD_P_P + ! BDED_L_2_AD_L_B + if (allocated(OutData%BDED_L_2_AD_L_B)) deallocate(OutData%BDED_L_2_AD_L_B) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BDED_L_2_AD_L_B(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BDED_L_2_AD_L_B.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%BDED_L_2_AD_L_B(i1)) ! BDED_L_2_AD_L_B + end do + end if + ! AD_L_2_BDED_B + if (allocated(OutData%AD_L_2_BDED_B)) deallocate(OutData%AD_L_2_BDED_B) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AD_L_2_BDED_B(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AD_L_2_BDED_B.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%AD_L_2_BDED_B(i1)) ! AD_L_2_BDED_B + end do + end if + ! BD_L_2_BD_L + if (allocated(OutData%BD_L_2_BD_L)) deallocate(OutData%BD_L_2_BD_L) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BD_L_2_BD_L(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BD_L_2_BD_L.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%BD_L_2_BD_L(i1)) ! BD_L_2_BD_L + end do + end if + ! ED_P_2_AD_P_N + call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_AD_P_N) ! ED_P_2_AD_P_N + ! AD_P_2_ED_P_N + call NWTC_Library_UnpackMeshMapType(Buf, OutData%AD_P_2_ED_P_N) ! AD_P_2_ED_P_N + ! ED_P_2_AD_P_TF + call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_AD_P_TF) ! ED_P_2_AD_P_TF + ! AD_P_2_ED_P_TF + call NWTC_Library_UnpackMeshMapType(Buf, OutData%AD_P_2_ED_P_TF) ! AD_P_2_ED_P_TF + ! ED_L_2_AD_L_T + call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_L_2_AD_L_T) ! ED_L_2_AD_L_T + ! AD_L_2_ED_P_T + call NWTC_Library_UnpackMeshMapType(Buf, OutData%AD_L_2_ED_P_T) ! AD_L_2_ED_P_T + ! ED_P_2_AD_P_R + if (allocated(OutData%ED_P_2_AD_P_R)) deallocate(OutData%ED_P_2_AD_P_R) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ED_P_2_AD_P_R(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_AD_P_R.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_AD_P_R(i1)) ! ED_P_2_AD_P_R + end do + end if + ! ED_P_2_AD_P_H + call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_AD_P_H) ! ED_P_2_AD_P_H + ! AD_P_2_ED_P_H + call NWTC_Library_UnpackMeshMapType(Buf, OutData%AD_P_2_ED_P_H) ! AD_P_2_ED_P_H + ! IceF_P_2_SD_P + call NWTC_Library_UnpackMeshMapType(Buf, OutData%IceF_P_2_SD_P) ! IceF_P_2_SD_P + ! SDy3_P_2_IceF_P + call NWTC_Library_UnpackMeshMapType(Buf, OutData%SDy3_P_2_IceF_P) ! SDy3_P_2_IceF_P + ! IceD_P_2_SD_P + if (allocated(OutData%IceD_P_2_SD_P)) deallocate(OutData%IceD_P_2_SD_P) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IceD_P_2_SD_P(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IceD_P_2_SD_P.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%IceD_P_2_SD_P(i1)) ! IceD_P_2_SD_P + end do + end if + ! SDy3_P_2_IceD_P + if (allocated(OutData%SDy3_P_2_IceD_P)) deallocate(OutData%SDy3_P_2_IceD_P) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SDy3_P_2_IceD_P(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SDy3_P_2_IceD_P.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%SDy3_P_2_IceD_P(i1)) ! SDy3_P_2_IceD_P + end do + end if + ! Jacobian_Opt1 + if (allocated(OutData%Jacobian_Opt1)) deallocate(OutData%Jacobian_Opt1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jacobian_Opt1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jacobian_Opt1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jacobian_Opt1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Jacobian_pivot + if (allocated(OutData%Jacobian_pivot)) deallocate(OutData%Jacobian_pivot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jacobian_pivot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jacobian_pivot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jacobian_pivot) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Jac_u_indx + if (allocated(OutData%Jac_u_indx)) deallocate(OutData%Jac_u_indx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jac_u_indx) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! u_ED_NacelleLoads + call MeshUnpack(Buf, OutData%u_ED_NacelleLoads) ! u_ED_NacelleLoads + ! SubstructureLoads_Tmp + call MeshUnpack(Buf, OutData%SubstructureLoads_Tmp) ! SubstructureLoads_Tmp + ! SubstructureLoads_Tmp2 + call MeshUnpack(Buf, OutData%SubstructureLoads_Tmp2) ! SubstructureLoads_Tmp2 + ! PlatformLoads_Tmp + call MeshUnpack(Buf, OutData%PlatformLoads_Tmp) ! PlatformLoads_Tmp + ! PlatformLoads_Tmp2 + call MeshUnpack(Buf, OutData%PlatformLoads_Tmp2) ! PlatformLoads_Tmp2 + ! SubstructureLoads_Tmp_Farm + call MeshUnpack(Buf, OutData%SubstructureLoads_Tmp_Farm) ! SubstructureLoads_Tmp_Farm + ! u_ED_TowerPtloads + call MeshUnpack(Buf, OutData%u_ED_TowerPtloads) ! u_ED_TowerPtloads + ! u_ED_BladePtLoads + if (allocated(OutData%u_ED_BladePtLoads)) deallocate(OutData%u_ED_BladePtLoads) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_ED_BladePtLoads(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_ED_BladePtLoads.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%u_ED_BladePtLoads(i1)) ! u_ED_BladePtLoads + end do + end if + ! u_SD_TPMesh + call MeshUnpack(Buf, OutData%u_SD_TPMesh) ! u_SD_TPMesh + ! u_HD_M_Mesh + call MeshUnpack(Buf, OutData%u_HD_M_Mesh) ! u_HD_M_Mesh + ! u_HD_W_Mesh + call MeshUnpack(Buf, OutData%u_HD_W_Mesh) ! u_HD_W_Mesh + ! u_ED_HubPtLoad + call MeshUnpack(Buf, OutData%u_ED_HubPtLoad) ! u_ED_HubPtLoad + ! u_ED_HubPtLoad_2 + call MeshUnpack(Buf, OutData%u_ED_HubPtLoad_2) ! u_ED_HubPtLoad_2 + ! u_BD_RootMotion + if (allocated(OutData%u_BD_RootMotion)) deallocate(OutData%u_BD_RootMotion) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_BD_RootMotion(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BD_RootMotion.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%u_BD_RootMotion(i1)) ! u_BD_RootMotion + end do + end if + ! y_BD_BldMotion_4Loads + if (allocated(OutData%y_BD_BldMotion_4Loads)) deallocate(OutData%y_BD_BldMotion_4Loads) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%y_BD_BldMotion_4Loads(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_BD_BldMotion_4Loads.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%y_BD_BldMotion_4Loads(i1)) ! y_BD_BldMotion_4Loads + end do + end if + ! u_BD_Distrload + if (allocated(OutData%u_BD_Distrload)) deallocate(OutData%u_BD_Distrload) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_BD_Distrload(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BD_Distrload.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%u_BD_Distrload(i1)) ! u_BD_Distrload + end do + end if + ! u_Orca_PtfmMesh + call MeshUnpack(Buf, OutData%u_Orca_PtfmMesh) ! u_Orca_PtfmMesh + ! u_ExtPtfm_PtfmMesh + call MeshUnpack(Buf, OutData%u_ExtPtfm_PtfmMesh) ! u_ExtPtfm_PtfmMesh +end subroutine SUBROUTINE FAST_CopyExternInputType( SrcExternInputTypeData, DstExternInputTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(FAST_ExternInputType), INTENT(IN) :: SrcExternInputTypeData TYPE(FAST_ExternInputType), INTENT(INOUT) :: DstExternInputTypeData @@ -44583,179 +15027,80 @@ SUBROUTINE FAST_DestroyExternInputType( ExternInputTypeData, ErrStat, ErrMsg ) END SUBROUTINE FAST_DestroyExternInputType - SUBROUTINE FAST_PackExternInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FAST_ExternInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackExternInputType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! GenTrq - Re_BufSz = Re_BufSz + 1 ! ElecPwr - Re_BufSz = Re_BufSz + 1 ! YawPosCom - Re_BufSz = Re_BufSz + 1 ! YawRateCom - Re_BufSz = Re_BufSz + SIZE(InData%BlPitchCom) ! BlPitchCom - Re_BufSz = Re_BufSz + SIZE(InData%BlAirfoilCom) ! BlAirfoilCom - Re_BufSz = Re_BufSz + 1 ! HSSBrFrac - Re_BufSz = Re_BufSz + SIZE(InData%LidarFocus) ! LidarFocus - Re_BufSz = Re_BufSz + SIZE(InData%CableDeltaL) ! CableDeltaL - Re_BufSz = Re_BufSz + SIZE(InData%CableDeltaLdot) ! CableDeltaLdot - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%GenTrq - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ElecPwr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawPosCom - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawRateCom - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%BlPitchCom,1), UBOUND(InData%BlPitchCom,1) - ReKiBuf(Re_Xferred) = InData%BlPitchCom(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%BlAirfoilCom,1), UBOUND(InData%BlAirfoilCom,1) - ReKiBuf(Re_Xferred) = InData%BlAirfoilCom(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%HSSBrFrac - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%LidarFocus,1), UBOUND(InData%LidarFocus,1) - ReKiBuf(Re_Xferred) = InData%LidarFocus(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%CableDeltaL,1), UBOUND(InData%CableDeltaL,1) - ReKiBuf(Re_Xferred) = InData%CableDeltaL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%CableDeltaLdot,1), UBOUND(InData%CableDeltaLdot,1) - ReKiBuf(Re_Xferred) = InData%CableDeltaLdot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE FAST_PackExternInputType - - SUBROUTINE FAST_UnPackExternInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FAST_ExternInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackExternInputType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%GenTrq = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ElecPwr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawPosCom = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawRateCom = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%BlPitchCom,1) - i1_u = UBOUND(OutData%BlPitchCom,1) - DO i1 = LBOUND(OutData%BlPitchCom,1), UBOUND(OutData%BlPitchCom,1) - OutData%BlPitchCom(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%BlAirfoilCom,1) - i1_u = UBOUND(OutData%BlAirfoilCom,1) - DO i1 = LBOUND(OutData%BlAirfoilCom,1), UBOUND(OutData%BlAirfoilCom,1) - OutData%BlAirfoilCom(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%HSSBrFrac = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%LidarFocus,1) - i1_u = UBOUND(OutData%LidarFocus,1) - DO i1 = LBOUND(OutData%LidarFocus,1), UBOUND(OutData%LidarFocus,1) - OutData%LidarFocus(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%CableDeltaL,1) - i1_u = UBOUND(OutData%CableDeltaL,1) - DO i1 = LBOUND(OutData%CableDeltaL,1), UBOUND(OutData%CableDeltaL,1) - OutData%CableDeltaL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%CableDeltaLdot,1) - i1_u = UBOUND(OutData%CableDeltaLdot,1) - DO i1 = LBOUND(OutData%CableDeltaLdot,1), UBOUND(OutData%CableDeltaLdot,1) - OutData%CableDeltaLdot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END SUBROUTINE FAST_UnPackExternInputType +subroutine FAST_PackExternInputType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FAST_ExternInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackExternInputType' + if (Buf%ErrStat >= AbortErrLev) return + ! GenTrq + call RegPack(Buf, InData%GenTrq) + if (RegCheckErr(Buf, RoutineName)) return + ! ElecPwr + call RegPack(Buf, InData%ElecPwr) + if (RegCheckErr(Buf, RoutineName)) return + ! YawPosCom + call RegPack(Buf, InData%YawPosCom) + if (RegCheckErr(Buf, RoutineName)) return + ! YawRateCom + call RegPack(Buf, InData%YawRateCom) + if (RegCheckErr(Buf, RoutineName)) return + ! BlPitchCom + call RegPack(Buf, InData%BlPitchCom) + if (RegCheckErr(Buf, RoutineName)) return + ! BlAirfoilCom + call RegPack(Buf, InData%BlAirfoilCom) + if (RegCheckErr(Buf, RoutineName)) return + ! HSSBrFrac + call RegPack(Buf, InData%HSSBrFrac) + if (RegCheckErr(Buf, RoutineName)) return + ! LidarFocus + call RegPack(Buf, InData%LidarFocus) + if (RegCheckErr(Buf, RoutineName)) return + ! CableDeltaL + call RegPack(Buf, InData%CableDeltaL) + if (RegCheckErr(Buf, RoutineName)) return + ! CableDeltaLdot + call RegPack(Buf, InData%CableDeltaLdot) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackExternInputType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FAST_ExternInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackExternInputType' + if (Buf%ErrStat /= ErrID_None) return + ! GenTrq + call RegUnpack(Buf, OutData%GenTrq) + if (RegCheckErr(Buf, RoutineName)) return + ! ElecPwr + call RegUnpack(Buf, OutData%ElecPwr) + if (RegCheckErr(Buf, RoutineName)) return + ! YawPosCom + call RegUnpack(Buf, OutData%YawPosCom) + if (RegCheckErr(Buf, RoutineName)) return + ! YawRateCom + call RegUnpack(Buf, OutData%YawRateCom) + if (RegCheckErr(Buf, RoutineName)) return + ! BlPitchCom + call RegUnpack(Buf, OutData%BlPitchCom) + if (RegCheckErr(Buf, RoutineName)) return + ! BlAirfoilCom + call RegUnpack(Buf, OutData%BlAirfoilCom) + if (RegCheckErr(Buf, RoutineName)) return + ! HSSBrFrac + call RegUnpack(Buf, OutData%HSSBrFrac) + if (RegCheckErr(Buf, RoutineName)) return + ! LidarFocus + call RegUnpack(Buf, OutData%LidarFocus) + if (RegCheckErr(Buf, RoutineName)) return + ! CableDeltaL + call RegUnpack(Buf, OutData%CableDeltaL) + if (RegCheckErr(Buf, RoutineName)) return + ! CableDeltaLdot + call RegUnpack(Buf, OutData%CableDeltaLdot) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE FAST_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) TYPE(FAST_MiscVarType), INTENT(IN) :: SrcMiscData TYPE(FAST_MiscVarType), INTENT(INOUT) :: DstMiscData @@ -44779,355 +15124,112 @@ SUBROUTINE FAST_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) DstMiscData%UsrTime2 = SrcMiscData%UsrTime2 DstMiscData%StrtTime = SrcMiscData%StrtTime DstMiscData%SimStrtTime = SrcMiscData%SimStrtTime - DstMiscData%calcJacobian = SrcMiscData%calcJacobian - CALL FAST_Copyexterninputtype( SrcMiscData%ExternInput, DstMiscData%ExternInput, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copymisclintype( SrcMiscData%Lin, DstMiscData%Lin, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE FAST_CopyMisc - - SUBROUTINE FAST_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(FAST_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL FAST_DestroyExternInputType( MiscData%ExternInput, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroyMiscLinType( MiscData%Lin, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE FAST_DestroyMisc - - SUBROUTINE FAST_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FAST_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! TiLstPrn - Db_BufSz = Db_BufSz + 1 ! t_global - Db_BufSz = Db_BufSz + 1 ! NextJacCalcTime - Re_BufSz = Re_BufSz + 1 ! PrevClockTime - Re_BufSz = Re_BufSz + 1 ! UsrTime1 - Re_BufSz = Re_BufSz + 1 ! UsrTime2 - Int_BufSz = Int_BufSz + SIZE(InData%StrtTime) ! StrtTime - Int_BufSz = Int_BufSz + SIZE(InData%SimStrtTime) ! SimStrtTime - Int_BufSz = Int_BufSz + 1 ! calcJacobian - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! ExternInput: size of buffers for each call to pack subtype - CALL FAST_PackExternInputType( Re_Buf, Db_Buf, Int_Buf, InData%ExternInput, ErrStat2, ErrMsg2, .TRUE. ) ! ExternInput - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ExternInput - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ExternInput - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ExternInput - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Lin: size of buffers for each call to pack subtype - CALL FAST_PackMiscLinType( Re_Buf, Db_Buf, Int_Buf, InData%Lin, ErrStat2, ErrMsg2, .TRUE. ) ! Lin - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Lin - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Lin - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Lin - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%TiLstPrn - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%t_global - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%NextJacCalcTime - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PrevClockTime - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%UsrTime1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%UsrTime2 - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%StrtTime,1), UBOUND(InData%StrtTime,1) - IntKiBuf(Int_Xferred) = InData%StrtTime(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%SimStrtTime,1), UBOUND(InData%SimStrtTime,1) - IntKiBuf(Int_Xferred) = InData%SimStrtTime(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = TRANSFER(InData%calcJacobian, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - CALL FAST_PackExternInputType( Re_Buf, Db_Buf, Int_Buf, InData%ExternInput, ErrStat2, ErrMsg2, OnlySize ) ! ExternInput - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL FAST_PackMiscLinType( Re_Buf, Db_Buf, Int_Buf, InData%Lin, ErrStat2, ErrMsg2, OnlySize ) ! Lin - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE FAST_PackMisc + DstMiscData%calcJacobian = SrcMiscData%calcJacobian + CALL FAST_Copyexterninputtype( SrcMiscData%ExternInput, DstMiscData%ExternInput, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL FAST_Copymisclintype( SrcMiscData%Lin, DstMiscData%Lin, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + END SUBROUTINE FAST_CopyMisc - SUBROUTINE FAST_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FAST_MiscVarType), INTENT(INOUT) :: OutData + SUBROUTINE FAST_DestroyMisc( MiscData, ErrStat, ErrMsg ) + TYPE(FAST_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyMisc' + ErrStat = ErrID_None ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%TiLstPrn = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%t_global = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%NextJacCalcTime = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%PrevClockTime = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%UsrTime1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%UsrTime2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%StrtTime,1) - i1_u = UBOUND(OutData%StrtTime,1) - DO i1 = LBOUND(OutData%StrtTime,1), UBOUND(OutData%StrtTime,1) - OutData%StrtTime(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%SimStrtTime,1) - i1_u = UBOUND(OutData%SimStrtTime,1) - DO i1 = LBOUND(OutData%SimStrtTime,1), UBOUND(OutData%SimStrtTime,1) - OutData%SimStrtTime(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%calcJacobian = TRANSFER(IntKiBuf(Int_Xferred), OutData%calcJacobian) - Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FAST_UnpackExternInputType( Re_Buf, Db_Buf, Int_Buf, OutData%ExternInput, ErrStat2, ErrMsg2 ) ! ExternInput - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FAST_UnpackMiscLinType( Re_Buf, Db_Buf, Int_Buf, OutData%Lin, ErrStat2, ErrMsg2 ) ! Lin - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + CALL FAST_DestroyExternInputType( MiscData%ExternInput, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL FAST_DestroyMiscLinType( MiscData%Lin, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END SUBROUTINE FAST_DestroyMisc - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE FAST_UnPackMisc +subroutine FAST_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FAST_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + ! TiLstPrn + call RegPack(Buf, InData%TiLstPrn) + if (RegCheckErr(Buf, RoutineName)) return + ! t_global + call RegPack(Buf, InData%t_global) + if (RegCheckErr(Buf, RoutineName)) return + ! NextJacCalcTime + call RegPack(Buf, InData%NextJacCalcTime) + if (RegCheckErr(Buf, RoutineName)) return + ! PrevClockTime + call RegPack(Buf, InData%PrevClockTime) + if (RegCheckErr(Buf, RoutineName)) return + ! UsrTime1 + call RegPack(Buf, InData%UsrTime1) + if (RegCheckErr(Buf, RoutineName)) return + ! UsrTime2 + call RegPack(Buf, InData%UsrTime2) + if (RegCheckErr(Buf, RoutineName)) return + ! StrtTime + call RegPack(Buf, InData%StrtTime) + if (RegCheckErr(Buf, RoutineName)) return + ! SimStrtTime + call RegPack(Buf, InData%SimStrtTime) + if (RegCheckErr(Buf, RoutineName)) return + ! calcJacobian + call RegPack(Buf, InData%calcJacobian) + if (RegCheckErr(Buf, RoutineName)) return + ! ExternInput + call FAST_PackExternInputType(Buf, InData%ExternInput) + if (RegCheckErr(Buf, RoutineName)) return + ! Lin + call FAST_PackMiscLinType(Buf, InData%Lin) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FAST_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackMisc' + if (Buf%ErrStat /= ErrID_None) return + ! TiLstPrn + call RegUnpack(Buf, OutData%TiLstPrn) + if (RegCheckErr(Buf, RoutineName)) return + ! t_global + call RegUnpack(Buf, OutData%t_global) + if (RegCheckErr(Buf, RoutineName)) return + ! NextJacCalcTime + call RegUnpack(Buf, OutData%NextJacCalcTime) + if (RegCheckErr(Buf, RoutineName)) return + ! PrevClockTime + call RegUnpack(Buf, OutData%PrevClockTime) + if (RegCheckErr(Buf, RoutineName)) return + ! UsrTime1 + call RegUnpack(Buf, OutData%UsrTime1) + if (RegCheckErr(Buf, RoutineName)) return + ! UsrTime2 + call RegUnpack(Buf, OutData%UsrTime2) + if (RegCheckErr(Buf, RoutineName)) return + ! StrtTime + call RegUnpack(Buf, OutData%StrtTime) + if (RegCheckErr(Buf, RoutineName)) return + ! SimStrtTime + call RegUnpack(Buf, OutData%SimStrtTime) + if (RegCheckErr(Buf, RoutineName)) return + ! calcJacobian + call RegUnpack(Buf, OutData%calcJacobian) + if (RegCheckErr(Buf, RoutineName)) return + ! ExternInput + call FAST_UnpackExternInputType(Buf, OutData%ExternInput) ! ExternInput + ! Lin + call FAST_UnpackMiscLinType(Buf, OutData%Lin) ! Lin +end subroutine SUBROUTINE FAST_CopyInitData( SrcInitDataData, DstInitDataData, CtrlCode, ErrStat, ErrMsg ) TYPE(FAST_InitData), INTENT(INOUT) :: SrcInitDataData TYPE(FAST_InitData), INTENT(INOUT) :: DstInitDataData @@ -45348,3025 +15450,218 @@ SUBROUTINE FAST_DestroyInitData( InitDataData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE FAST_DestroyInitData - SUBROUTINE FAST_PackInitData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FAST_InitData), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackInitData' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! InData_ED: size of buffers for each call to pack subtype - CALL ED_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_ED, ErrStat2, ErrMsg2, .TRUE. ) ! InData_ED - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_ED - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_ED - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_ED - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OutData_ED: size of buffers for each call to pack subtype - CALL ED_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_ED, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_ED - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_ED - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_ED - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_ED - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InData_BD: size of buffers for each call to pack subtype - CALL BD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_BD, ErrStat2, ErrMsg2, .TRUE. ) ! InData_BD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_BD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_BD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_BD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! OutData_BD allocated yes/no - IF ( ALLOCATED(InData%OutData_BD) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutData_BD upper/lower bounds for each dimension - DO i1 = LBOUND(InData%OutData_BD,1), UBOUND(InData%OutData_BD,1) - Int_BufSz = Int_BufSz + 3 ! OutData_BD: size of buffers for each call to pack subtype - CALL BD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_BD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutData_BD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_BD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_BD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_BD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! InData_SrvD: size of buffers for each call to pack subtype - CALL SrvD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_SrvD, ErrStat2, ErrMsg2, .TRUE. ) ! InData_SrvD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_SrvD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_SrvD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_SrvD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OutData_SrvD: size of buffers for each call to pack subtype - CALL SrvD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_SrvD, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_SrvD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_SrvD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_SrvD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_SrvD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InData_AD14: size of buffers for each call to pack subtype - CALL AD14_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_AD14, ErrStat2, ErrMsg2, .TRUE. ) ! InData_AD14 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_AD14 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_AD14 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_AD14 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OutData_AD14: size of buffers for each call to pack subtype - CALL AD14_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_AD14, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_AD14 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_AD14 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_AD14 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_AD14 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InData_AD: size of buffers for each call to pack subtype - CALL AD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_AD, ErrStat2, ErrMsg2, .TRUE. ) ! InData_AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_AD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_AD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_AD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OutData_AD: size of buffers for each call to pack subtype - CALL AD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_AD, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_AD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_AD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_AD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InData_IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_IfW, ErrStat2, ErrMsg2, .TRUE. ) ! InData_IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OutData_IfW: size of buffers for each call to pack subtype - CALL InflowWind_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_IfW, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InData_OpFM: size of buffers for each call to pack subtype - CALL OpFM_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_OpFM, ErrStat2, ErrMsg2, .TRUE. ) ! InData_OpFM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_OpFM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_OpFM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_OpFM - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OutData_OpFM: size of buffers for each call to pack subtype - CALL OpFM_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_OpFM, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_OpFM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_OpFM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_OpFM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_OpFM - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InData_SeaSt: size of buffers for each call to pack subtype - CALL SeaSt_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_SeaSt, ErrStat2, ErrMsg2, .TRUE. ) ! InData_SeaSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_SeaSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_SeaSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_SeaSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OutData_SeaSt: size of buffers for each call to pack subtype - CALL SeaSt_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_SeaSt, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_SeaSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_SeaSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_SeaSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_SeaSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InData_HD: size of buffers for each call to pack subtype - CALL HydroDyn_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_HD, ErrStat2, ErrMsg2, .TRUE. ) ! InData_HD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_HD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_HD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_HD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OutData_HD: size of buffers for each call to pack subtype - CALL HydroDyn_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_HD, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_HD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_HD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_HD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_HD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InData_SD: size of buffers for each call to pack subtype - CALL SD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_SD, ErrStat2, ErrMsg2, .TRUE. ) ! InData_SD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_SD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_SD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_SD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OutData_SD: size of buffers for each call to pack subtype - CALL SD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_SD, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_SD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_SD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_SD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_SD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InData_ExtPtfm: size of buffers for each call to pack subtype - CALL ExtPtfm_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_ExtPtfm, ErrStat2, ErrMsg2, .TRUE. ) ! InData_ExtPtfm - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_ExtPtfm - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_ExtPtfm - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_ExtPtfm - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OutData_ExtPtfm: size of buffers for each call to pack subtype - CALL ExtPtfm_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_ExtPtfm, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_ExtPtfm - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_ExtPtfm - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_ExtPtfm - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_ExtPtfm - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InData_MAP: size of buffers for each call to pack subtype - CALL MAP_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_MAP, ErrStat2, ErrMsg2, .TRUE. ) ! InData_MAP - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_MAP - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_MAP - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_MAP - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OutData_MAP: size of buffers for each call to pack subtype - CALL MAP_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_MAP, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_MAP - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_MAP - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_MAP - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_MAP - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InData_FEAM: size of buffers for each call to pack subtype - CALL FEAM_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_FEAM, ErrStat2, ErrMsg2, .TRUE. ) ! InData_FEAM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_FEAM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_FEAM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_FEAM - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OutData_FEAM: size of buffers for each call to pack subtype - CALL FEAM_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_FEAM, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_FEAM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_FEAM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_FEAM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_FEAM - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InData_MD: size of buffers for each call to pack subtype - CALL MD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_MD, ErrStat2, ErrMsg2, .TRUE. ) ! InData_MD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_MD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_MD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_MD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OutData_MD: size of buffers for each call to pack subtype - CALL MD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_MD, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_MD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_MD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_MD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_MD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InData_Orca: size of buffers for each call to pack subtype - CALL Orca_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_Orca, ErrStat2, ErrMsg2, .TRUE. ) ! InData_Orca - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_Orca - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_Orca - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_Orca - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OutData_Orca: size of buffers for each call to pack subtype - CALL Orca_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_Orca, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_Orca - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_Orca - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_Orca - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_Orca - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InData_IceF: size of buffers for each call to pack subtype - CALL IceFloe_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_IceF, ErrStat2, ErrMsg2, .TRUE. ) ! InData_IceF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_IceF - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_IceF - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_IceF - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OutData_IceF: size of buffers for each call to pack subtype - CALL IceFloe_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_IceF, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_IceF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_IceF - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_IceF - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_IceF - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! InData_IceD: size of buffers for each call to pack subtype - CALL IceD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_IceD, ErrStat2, ErrMsg2, .TRUE. ) ! InData_IceD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InData_IceD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InData_IceD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InData_IceD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OutData_IceD: size of buffers for each call to pack subtype - CALL IceD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_IceD, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_IceD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutData_IceD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutData_IceD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutData_IceD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL ED_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_ED, ErrStat2, ErrMsg2, OnlySize ) ! InData_ED - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL ED_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_ED, ErrStat2, ErrMsg2, OnlySize ) ! OutData_ED - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL BD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_BD, ErrStat2, ErrMsg2, OnlySize ) ! InData_BD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%OutData_BD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutData_BD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutData_BD,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutData_BD,1), UBOUND(InData%OutData_BD,1) - CALL BD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_BD(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutData_BD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL SrvD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_SrvD, ErrStat2, ErrMsg2, OnlySize ) ! InData_SrvD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SrvD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_SrvD, ErrStat2, ErrMsg2, OnlySize ) ! OutData_SrvD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD14_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_AD14, ErrStat2, ErrMsg2, OnlySize ) ! InData_AD14 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD14_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_AD14, ErrStat2, ErrMsg2, OnlySize ) ! OutData_AD14 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_AD, ErrStat2, ErrMsg2, OnlySize ) ! InData_AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_AD, ErrStat2, ErrMsg2, OnlySize ) ! OutData_AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL InflowWind_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_IfW, ErrStat2, ErrMsg2, OnlySize ) ! InData_IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL InflowWind_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_IfW, ErrStat2, ErrMsg2, OnlySize ) ! OutData_IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL OpFM_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_OpFM, ErrStat2, ErrMsg2, OnlySize ) ! InData_OpFM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL OpFM_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_OpFM, ErrStat2, ErrMsg2, OnlySize ) ! OutData_OpFM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SeaSt_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_SeaSt, ErrStat2, ErrMsg2, OnlySize ) ! InData_SeaSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SeaSt_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_SeaSt, ErrStat2, ErrMsg2, OnlySize ) ! OutData_SeaSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL HydroDyn_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_HD, ErrStat2, ErrMsg2, OnlySize ) ! InData_HD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL HydroDyn_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_HD, ErrStat2, ErrMsg2, OnlySize ) ! OutData_HD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_SD, ErrStat2, ErrMsg2, OnlySize ) ! InData_SD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_SD, ErrStat2, ErrMsg2, OnlySize ) ! OutData_SD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL ExtPtfm_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_ExtPtfm, ErrStat2, ErrMsg2, OnlySize ) ! InData_ExtPtfm - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL ExtPtfm_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_ExtPtfm, ErrStat2, ErrMsg2, OnlySize ) ! OutData_ExtPtfm - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MAP_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_MAP, ErrStat2, ErrMsg2, OnlySize ) ! InData_MAP - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MAP_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_MAP, ErrStat2, ErrMsg2, OnlySize ) ! OutData_MAP - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL FEAM_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_FEAM, ErrStat2, ErrMsg2, OnlySize ) ! InData_FEAM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL FEAM_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_FEAM, ErrStat2, ErrMsg2, OnlySize ) ! OutData_FEAM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_MD, ErrStat2, ErrMsg2, OnlySize ) ! InData_MD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_MD, ErrStat2, ErrMsg2, OnlySize ) ! OutData_MD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL Orca_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_Orca, ErrStat2, ErrMsg2, OnlySize ) ! InData_Orca - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL Orca_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_Orca, ErrStat2, ErrMsg2, OnlySize ) ! OutData_Orca - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL IceFloe_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_IceF, ErrStat2, ErrMsg2, OnlySize ) ! InData_IceF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL IceFloe_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_IceF, ErrStat2, ErrMsg2, OnlySize ) ! OutData_IceF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL IceD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_IceD, ErrStat2, ErrMsg2, OnlySize ) ! InData_IceD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL IceD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_IceD, ErrStat2, ErrMsg2, OnlySize ) ! OutData_IceD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE FAST_PackInitData - - SUBROUTINE FAST_UnPackInitData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FAST_InitData), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackInitData' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ED_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_ED, ErrStat2, ErrMsg2 ) ! InData_ED - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ED_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_ED, ErrStat2, ErrMsg2 ) ! OutData_ED - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL BD_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_BD, ErrStat2, ErrMsg2 ) ! InData_BD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutData_BD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutData_BD)) DEALLOCATE(OutData%OutData_BD) - ALLOCATE(OutData%OutData_BD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutData_BD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutData_BD,1), UBOUND(OutData%OutData_BD,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL BD_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_BD(i1), ErrStat2, ErrMsg2 ) ! OutData_BD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SrvD_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_SrvD, ErrStat2, ErrMsg2 ) ! InData_SrvD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SrvD_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_SrvD, ErrStat2, ErrMsg2 ) ! OutData_SrvD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD14_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_AD14, ErrStat2, ErrMsg2 ) ! InData_AD14 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD14_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_AD14, ErrStat2, ErrMsg2 ) ! OutData_AD14 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_AD, ErrStat2, ErrMsg2 ) ! InData_AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_AD, ErrStat2, ErrMsg2 ) ! OutData_AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_IfW, ErrStat2, ErrMsg2 ) ! InData_IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_IfW, ErrStat2, ErrMsg2 ) ! OutData_IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL OpFM_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_OpFM, ErrStat2, ErrMsg2 ) ! InData_OpFM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL OpFM_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_OpFM, ErrStat2, ErrMsg2 ) ! OutData_OpFM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SeaSt_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_SeaSt, ErrStat2, ErrMsg2 ) ! InData_SeaSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SeaSt_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_SeaSt, ErrStat2, ErrMsg2 ) ! OutData_SeaSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL HydroDyn_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_HD, ErrStat2, ErrMsg2 ) ! InData_HD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL HydroDyn_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_HD, ErrStat2, ErrMsg2 ) ! OutData_HD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_SD, ErrStat2, ErrMsg2 ) ! InData_SD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_SD, ErrStat2, ErrMsg2 ) ! OutData_SD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ExtPtfm_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_ExtPtfm, ErrStat2, ErrMsg2 ) ! InData_ExtPtfm - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ExtPtfm_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_ExtPtfm, ErrStat2, ErrMsg2 ) ! OutData_ExtPtfm - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MAP_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_MAP, ErrStat2, ErrMsg2 ) ! InData_MAP - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MAP_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_MAP, ErrStat2, ErrMsg2 ) ! OutData_MAP - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FEAM_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_FEAM, ErrStat2, ErrMsg2 ) ! InData_FEAM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FEAM_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_FEAM, ErrStat2, ErrMsg2 ) ! OutData_FEAM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_MD, ErrStat2, ErrMsg2 ) ! InData_MD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_MD, ErrStat2, ErrMsg2 ) ! OutData_MD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Orca_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_Orca, ErrStat2, ErrMsg2 ) ! InData_Orca - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Orca_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_Orca, ErrStat2, ErrMsg2 ) ! OutData_Orca - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceFloe_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_IceF, ErrStat2, ErrMsg2 ) ! InData_IceF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceFloe_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_IceF, ErrStat2, ErrMsg2 ) ! OutData_IceF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceD_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_IceD, ErrStat2, ErrMsg2 ) ! InData_IceD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceD_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_IceD, ErrStat2, ErrMsg2 ) ! OutData_IceD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE FAST_UnPackInitData +subroutine FAST_PackInitData(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FAST_InitData), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackInitData' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! InData_ED + call ED_PackInitInput(Buf, InData%InData_ED) + if (RegCheckErr(Buf, RoutineName)) return + ! OutData_ED + call ED_PackInitOutput(Buf, InData%OutData_ED) + if (RegCheckErr(Buf, RoutineName)) return + ! InData_BD + call BD_PackInitInput(Buf, InData%InData_BD) + if (RegCheckErr(Buf, RoutineName)) return + ! OutData_BD + call RegPack(Buf, allocated(InData%OutData_BD)) + if (allocated(InData%OutData_BD)) then + call RegPackBounds(Buf, 1, lbound(InData%OutData_BD), ubound(InData%OutData_BD)) + LB(1:1) = lbound(InData%OutData_BD) + UB(1:1) = ubound(InData%OutData_BD) + do i1 = LB(1), UB(1) + call BD_PackInitOutput(Buf, InData%OutData_BD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! InData_SrvD + call SrvD_PackInitInput(Buf, InData%InData_SrvD) + if (RegCheckErr(Buf, RoutineName)) return + ! OutData_SrvD + call SrvD_PackInitOutput(Buf, InData%OutData_SrvD) + if (RegCheckErr(Buf, RoutineName)) return + ! InData_AD14 + call AD14_PackInitInput(Buf, InData%InData_AD14) + if (RegCheckErr(Buf, RoutineName)) return + ! OutData_AD14 + call AD14_PackInitOutput(Buf, InData%OutData_AD14) + if (RegCheckErr(Buf, RoutineName)) return + ! InData_AD + call AD_PackInitInput(Buf, InData%InData_AD) + if (RegCheckErr(Buf, RoutineName)) return + ! OutData_AD + call AD_PackInitOutput(Buf, InData%OutData_AD) + if (RegCheckErr(Buf, RoutineName)) return + ! InData_IfW + call InflowWind_PackInitInput(Buf, InData%InData_IfW) + if (RegCheckErr(Buf, RoutineName)) return + ! OutData_IfW + call InflowWind_PackInitOutput(Buf, InData%OutData_IfW) + if (RegCheckErr(Buf, RoutineName)) return + ! InData_OpFM + call OpFM_PackInitInput(Buf, InData%InData_OpFM) + if (RegCheckErr(Buf, RoutineName)) return + ! OutData_OpFM + call OpFM_PackInitOutput(Buf, InData%OutData_OpFM) + if (RegCheckErr(Buf, RoutineName)) return + ! InData_SeaSt + call SeaSt_PackInitInput(Buf, InData%InData_SeaSt) + if (RegCheckErr(Buf, RoutineName)) return + ! OutData_SeaSt + call SeaSt_PackInitOutput(Buf, InData%OutData_SeaSt) + if (RegCheckErr(Buf, RoutineName)) return + ! InData_HD + call HydroDyn_PackInitInput(Buf, InData%InData_HD) + if (RegCheckErr(Buf, RoutineName)) return + ! OutData_HD + call HydroDyn_PackInitOutput(Buf, InData%OutData_HD) + if (RegCheckErr(Buf, RoutineName)) return + ! InData_SD + call SD_PackInitInput(Buf, InData%InData_SD) + if (RegCheckErr(Buf, RoutineName)) return + ! OutData_SD + call SD_PackInitOutput(Buf, InData%OutData_SD) + if (RegCheckErr(Buf, RoutineName)) return + ! InData_ExtPtfm + call ExtPtfm_PackInitInput(Buf, InData%InData_ExtPtfm) + if (RegCheckErr(Buf, RoutineName)) return + ! OutData_ExtPtfm + call ExtPtfm_PackInitOutput(Buf, InData%OutData_ExtPtfm) + if (RegCheckErr(Buf, RoutineName)) return + ! InData_MAP + call MAP_PackInitInput(Buf, InData%InData_MAP) + if (RegCheckErr(Buf, RoutineName)) return + ! OutData_MAP + call MAP_PackInitOutput(Buf, InData%OutData_MAP) + if (RegCheckErr(Buf, RoutineName)) return + ! InData_FEAM + call FEAM_PackInitInput(Buf, InData%InData_FEAM) + if (RegCheckErr(Buf, RoutineName)) return + ! OutData_FEAM + call FEAM_PackInitOutput(Buf, InData%OutData_FEAM) + if (RegCheckErr(Buf, RoutineName)) return + ! InData_MD + call MD_PackInitInput(Buf, InData%InData_MD) + if (RegCheckErr(Buf, RoutineName)) return + ! OutData_MD + call MD_PackInitOutput(Buf, InData%OutData_MD) + if (RegCheckErr(Buf, RoutineName)) return + ! InData_Orca + call Orca_PackInitInput(Buf, InData%InData_Orca) + if (RegCheckErr(Buf, RoutineName)) return + ! OutData_Orca + call Orca_PackInitOutput(Buf, InData%OutData_Orca) + if (RegCheckErr(Buf, RoutineName)) return + ! InData_IceF + call IceFloe_PackInitInput(Buf, InData%InData_IceF) + if (RegCheckErr(Buf, RoutineName)) return + ! OutData_IceF + call IceFloe_PackInitOutput(Buf, InData%OutData_IceF) + if (RegCheckErr(Buf, RoutineName)) return + ! InData_IceD + call IceD_PackInitInput(Buf, InData%InData_IceD) + if (RegCheckErr(Buf, RoutineName)) return + ! OutData_IceD + call IceD_PackInitOutput(Buf, InData%OutData_IceD) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackInitData(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FAST_InitData), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackInitData' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! InData_ED + call ED_UnpackInitInput(Buf, OutData%InData_ED) ! InData_ED + ! OutData_ED + call ED_UnpackInitOutput(Buf, OutData%OutData_ED) ! OutData_ED + ! InData_BD + call BD_UnpackInitInput(Buf, OutData%InData_BD) ! InData_BD + ! OutData_BD + if (allocated(OutData%OutData_BD)) deallocate(OutData%OutData_BD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutData_BD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutData_BD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call BD_UnpackInitOutput(Buf, OutData%OutData_BD(i1)) ! OutData_BD + end do + end if + ! InData_SrvD + call SrvD_UnpackInitInput(Buf, OutData%InData_SrvD) ! InData_SrvD + ! OutData_SrvD + call SrvD_UnpackInitOutput(Buf, OutData%OutData_SrvD) ! OutData_SrvD + ! InData_AD14 + call AD14_UnpackInitInput(Buf, OutData%InData_AD14) ! InData_AD14 + ! OutData_AD14 + call AD14_UnpackInitOutput(Buf, OutData%OutData_AD14) ! OutData_AD14 + ! InData_AD + call AD_UnpackInitInput(Buf, OutData%InData_AD) ! InData_AD + ! OutData_AD + call AD_UnpackInitOutput(Buf, OutData%OutData_AD) ! OutData_AD + ! InData_IfW + call InflowWind_UnpackInitInput(Buf, OutData%InData_IfW) ! InData_IfW + ! OutData_IfW + call InflowWind_UnpackInitOutput(Buf, OutData%OutData_IfW) ! OutData_IfW + ! InData_OpFM + call OpFM_UnpackInitInput(Buf, OutData%InData_OpFM) ! InData_OpFM + ! OutData_OpFM + call OpFM_UnpackInitOutput(Buf, OutData%OutData_OpFM) ! OutData_OpFM + ! InData_SeaSt + call SeaSt_UnpackInitInput(Buf, OutData%InData_SeaSt) ! InData_SeaSt + ! OutData_SeaSt + call SeaSt_UnpackInitOutput(Buf, OutData%OutData_SeaSt) ! OutData_SeaSt + ! InData_HD + call HydroDyn_UnpackInitInput(Buf, OutData%InData_HD) ! InData_HD + ! OutData_HD + call HydroDyn_UnpackInitOutput(Buf, OutData%OutData_HD) ! OutData_HD + ! InData_SD + call SD_UnpackInitInput(Buf, OutData%InData_SD) ! InData_SD + ! OutData_SD + call SD_UnpackInitOutput(Buf, OutData%OutData_SD) ! OutData_SD + ! InData_ExtPtfm + call ExtPtfm_UnpackInitInput(Buf, OutData%InData_ExtPtfm) ! InData_ExtPtfm + ! OutData_ExtPtfm + call ExtPtfm_UnpackInitOutput(Buf, OutData%OutData_ExtPtfm) ! OutData_ExtPtfm + ! InData_MAP + call MAP_UnpackInitInput(Buf, OutData%InData_MAP) ! InData_MAP + ! OutData_MAP + call MAP_UnpackInitOutput(Buf, OutData%OutData_MAP) ! OutData_MAP + ! InData_FEAM + call FEAM_UnpackInitInput(Buf, OutData%InData_FEAM) ! InData_FEAM + ! OutData_FEAM + call FEAM_UnpackInitOutput(Buf, OutData%OutData_FEAM) ! OutData_FEAM + ! InData_MD + call MD_UnpackInitInput(Buf, OutData%InData_MD) ! InData_MD + ! OutData_MD + call MD_UnpackInitOutput(Buf, OutData%OutData_MD) ! OutData_MD + ! InData_Orca + call Orca_UnpackInitInput(Buf, OutData%InData_Orca) ! InData_Orca + ! OutData_Orca + call Orca_UnpackInitOutput(Buf, OutData%OutData_Orca) ! OutData_Orca + ! InData_IceF + call IceFloe_UnpackInitInput(Buf, OutData%InData_IceF) ! InData_IceF + ! OutData_IceF + call IceFloe_UnpackInitOutput(Buf, OutData%OutData_IceF) ! OutData_IceF + ! InData_IceD + call IceD_UnpackInitInput(Buf, OutData%InData_IceD) ! InData_IceD + ! OutData_IceD + call IceD_UnpackInitOutput(Buf, OutData%OutData_IceD) ! OutData_IceD +end subroutine SUBROUTINE FAST_CopyExternInitType( SrcExternInitTypeData, DstExternInitTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(FAST_ExternInitType), INTENT(IN) :: SrcExternInitTypeData TYPE(FAST_ExternInitType), INTENT(INOUT) :: DstExternInitTypeData @@ -48452,293 +15747,207 @@ SUBROUTINE FAST_DestroyExternInitType( ExternInitTypeData, ErrStat, ErrMsg ) NULLIFY(ExternInitTypeData%windGrid_data) END SUBROUTINE FAST_DestroyExternInitType - SUBROUTINE FAST_PackExternInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FAST_ExternInitType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackExternInitType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! Tmax - Int_BufSz = Int_BufSz + 1 ! SensorType - Int_BufSz = Int_BufSz + 1 ! LidRadialVel - Int_BufSz = Int_BufSz + 1 ! TurbineID - Re_BufSz = Re_BufSz + SIZE(InData%TurbinePos) ! TurbinePos - Int_BufSz = Int_BufSz + 1 ! WaveFieldMod - Int_BufSz = Int_BufSz + 1 ! NumSC2CtrlGlob - Int_BufSz = Int_BufSz + 1 ! NumSC2Ctrl - Int_BufSz = Int_BufSz + 1 ! NumCtrl2SC - Int_BufSz = Int_BufSz + 1 ! fromSCGlob allocated yes/no - IF ( ALLOCATED(InData%fromSCGlob) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! fromSCGlob upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fromSCGlob) ! fromSCGlob - END IF - Int_BufSz = Int_BufSz + 1 ! fromSC allocated yes/no - IF ( ALLOCATED(InData%fromSC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! fromSC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fromSC) ! fromSC - END IF - Int_BufSz = Int_BufSz + 1 ! FarmIntegration - Int_BufSz = Int_BufSz + SIZE(InData%windGrid_n) ! windGrid_n - Re_BufSz = Re_BufSz + SIZE(InData%windGrid_delta) ! windGrid_delta - Re_BufSz = Re_BufSz + SIZE(InData%windGrid_pZero) ! windGrid_pZero - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1 ! NumActForcePtsBlade - Int_BufSz = Int_BufSz + 1 ! NumActForcePtsTower - Int_BufSz = Int_BufSz + 1 ! NodeClusterType - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%Tmax - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%SensorType - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%LidRadialVel, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TurbineID - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%TurbinePos,1), UBOUND(InData%TurbinePos,1) - ReKiBuf(Re_Xferred) = InData%TurbinePos(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%WaveFieldMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumSC2CtrlGlob - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumSC2Ctrl - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumCtrl2SC - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%fromSCGlob) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fromSCGlob,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fromSCGlob,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%fromSCGlob,1), UBOUND(InData%fromSCGlob,1) - ReKiBuf(Re_Xferred) = InData%fromSCGlob(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%fromSC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fromSC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fromSC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%fromSC,1), UBOUND(InData%fromSC,1) - ReKiBuf(Re_Xferred) = InData%fromSC(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%FarmIntegration, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%windGrid_n,1), UBOUND(InData%windGrid_n,1) - IntKiBuf(Int_Xferred) = InData%windGrid_n(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%windGrid_delta,1), UBOUND(InData%windGrid_delta,1) - ReKiBuf(Re_Xferred) = InData%windGrid_delta(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%windGrid_pZero,1), UBOUND(InData%windGrid_pZero,1) - ReKiBuf(Re_Xferred) = InData%windGrid_pZero(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%NumActForcePtsBlade - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumActForcePtsTower - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NodeClusterType - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FAST_PackExternInitType - - SUBROUTINE FAST_UnPackExternInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FAST_ExternInitType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackExternInitType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%Tmax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%SensorType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%LidRadialVel = TRANSFER(IntKiBuf(Int_Xferred), OutData%LidRadialVel) - Int_Xferred = Int_Xferred + 1 - OutData%TurbineID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%TurbinePos,1) - i1_u = UBOUND(OutData%TurbinePos,1) - DO i1 = LBOUND(OutData%TurbinePos,1), UBOUND(OutData%TurbinePos,1) - OutData%TurbinePos(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%WaveFieldMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumSC2CtrlGlob = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumSC2Ctrl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumCtrl2SC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fromSCGlob not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%fromSCGlob)) DEALLOCATE(OutData%fromSCGlob) - ALLOCATE(OutData%fromSCGlob(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSCGlob.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%fromSCGlob,1), UBOUND(OutData%fromSCGlob,1) - OutData%fromSCGlob(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fromSC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%fromSC)) DEALLOCATE(OutData%fromSC) - ALLOCATE(OutData%fromSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%fromSC,1), UBOUND(OutData%fromSC,1) - OutData%fromSC(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%FarmIntegration = TRANSFER(IntKiBuf(Int_Xferred), OutData%FarmIntegration) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%windGrid_n,1) - i1_u = UBOUND(OutData%windGrid_n,1) - DO i1 = LBOUND(OutData%windGrid_n,1), UBOUND(OutData%windGrid_n,1) - OutData%windGrid_n(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%windGrid_delta,1) - i1_u = UBOUND(OutData%windGrid_delta,1) - DO i1 = LBOUND(OutData%windGrid_delta,1), UBOUND(OutData%windGrid_delta,1) - OutData%windGrid_delta(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%windGrid_pZero,1) - i1_u = UBOUND(OutData%windGrid_pZero,1) - DO i1 = LBOUND(OutData%windGrid_pZero,1), UBOUND(OutData%windGrid_pZero,1) - OutData%windGrid_pZero(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - NULLIFY(OutData%windGrid_data) - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%NumActForcePtsBlade = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumActForcePtsTower = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NodeClusterType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FAST_UnPackExternInitType +subroutine FAST_PackExternInitType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FAST_ExternInitType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackExternInitType' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + ! Tmax + call RegPack(Buf, InData%Tmax) + if (RegCheckErr(Buf, RoutineName)) return + ! SensorType + call RegPack(Buf, InData%SensorType) + if (RegCheckErr(Buf, RoutineName)) return + ! LidRadialVel + call RegPack(Buf, InData%LidRadialVel) + if (RegCheckErr(Buf, RoutineName)) return + ! TurbineID + call RegPack(Buf, InData%TurbineID) + if (RegCheckErr(Buf, RoutineName)) return + ! TurbinePos + call RegPack(Buf, InData%TurbinePos) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveFieldMod + call RegPack(Buf, InData%WaveFieldMod) + if (RegCheckErr(Buf, RoutineName)) return + ! NumSC2CtrlGlob + call RegPack(Buf, InData%NumSC2CtrlGlob) + if (RegCheckErr(Buf, RoutineName)) return + ! NumSC2Ctrl + call RegPack(Buf, InData%NumSC2Ctrl) + if (RegCheckErr(Buf, RoutineName)) return + ! NumCtrl2SC + call RegPack(Buf, InData%NumCtrl2SC) + if (RegCheckErr(Buf, RoutineName)) return + ! fromSCGlob + call RegPack(Buf, allocated(InData%fromSCGlob)) + if (allocated(InData%fromSCGlob)) then + call RegPackBounds(Buf, 1, lbound(InData%fromSCGlob), ubound(InData%fromSCGlob)) + call RegPack(Buf, InData%fromSCGlob) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! fromSC + call RegPack(Buf, allocated(InData%fromSC)) + if (allocated(InData%fromSC)) then + call RegPackBounds(Buf, 1, lbound(InData%fromSC), ubound(InData%fromSC)) + call RegPack(Buf, InData%fromSC) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FarmIntegration + call RegPack(Buf, InData%FarmIntegration) + if (RegCheckErr(Buf, RoutineName)) return + ! windGrid_n + call RegPack(Buf, InData%windGrid_n) + if (RegCheckErr(Buf, RoutineName)) return + ! windGrid_delta + call RegPack(Buf, InData%windGrid_delta) + if (RegCheckErr(Buf, RoutineName)) return + ! windGrid_pZero + call RegPack(Buf, InData%windGrid_pZero) + if (RegCheckErr(Buf, RoutineName)) return + ! windGrid_data + call RegPack(Buf, associated(InData%windGrid_data)) + if (associated(InData%windGrid_data)) then + call RegPackBounds(Buf, 5, lbound(InData%windGrid_data), ubound(InData%windGrid_data)) + call RegPackPointer(Buf, c_loc(InData%windGrid_data), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%windGrid_data) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegPack(Buf, InData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! NumActForcePtsBlade + call RegPack(Buf, InData%NumActForcePtsBlade) + if (RegCheckErr(Buf, RoutineName)) return + ! NumActForcePtsTower + call RegPack(Buf, InData%NumActForcePtsTower) + if (RegCheckErr(Buf, RoutineName)) return + ! NodeClusterType + call RegPack(Buf, InData%NodeClusterType) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackExternInitType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FAST_ExternInitType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackExternInitType' + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + ! Tmax + call RegUnpack(Buf, OutData%Tmax) + if (RegCheckErr(Buf, RoutineName)) return + ! SensorType + call RegUnpack(Buf, OutData%SensorType) + if (RegCheckErr(Buf, RoutineName)) return + ! LidRadialVel + call RegUnpack(Buf, OutData%LidRadialVel) + if (RegCheckErr(Buf, RoutineName)) return + ! TurbineID + call RegUnpack(Buf, OutData%TurbineID) + if (RegCheckErr(Buf, RoutineName)) return + ! TurbinePos + call RegUnpack(Buf, OutData%TurbinePos) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveFieldMod + call RegUnpack(Buf, OutData%WaveFieldMod) + if (RegCheckErr(Buf, RoutineName)) return + ! NumSC2CtrlGlob + call RegUnpack(Buf, OutData%NumSC2CtrlGlob) + if (RegCheckErr(Buf, RoutineName)) return + ! NumSC2Ctrl + call RegUnpack(Buf, OutData%NumSC2Ctrl) + if (RegCheckErr(Buf, RoutineName)) return + ! NumCtrl2SC + call RegUnpack(Buf, OutData%NumCtrl2SC) + if (RegCheckErr(Buf, RoutineName)) return + ! fromSCGlob + if (allocated(OutData%fromSCGlob)) deallocate(OutData%fromSCGlob) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%fromSCGlob(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSCGlob.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%fromSCGlob) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! fromSC + if (allocated(OutData%fromSC)) deallocate(OutData%fromSC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%fromSC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%fromSC) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! FarmIntegration + call RegUnpack(Buf, OutData%FarmIntegration) + if (RegCheckErr(Buf, RoutineName)) return + ! windGrid_n + call RegUnpack(Buf, OutData%windGrid_n) + if (RegCheckErr(Buf, RoutineName)) return + ! windGrid_delta + call RegUnpack(Buf, OutData%windGrid_delta) + if (RegCheckErr(Buf, RoutineName)) return + ! windGrid_pZero + call RegUnpack(Buf, OutData%windGrid_pZero) + if (RegCheckErr(Buf, RoutineName)) return + ! windGrid_data + if (associated(OutData%windGrid_data)) deallocate(OutData%windGrid_data) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%windGrid_data, UB(1:5)-LB(1:5)) + OutData%windGrid_data(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => OutData%windGrid_data + else + allocate(OutData%windGrid_data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%windGrid_data.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%windGrid_data) + call RegUnpack(Buf, OutData%windGrid_data) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%windGrid_data => null() + end if + ! RootName + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! NumActForcePtsBlade + call RegUnpack(Buf, OutData%NumActForcePtsBlade) + if (RegCheckErr(Buf, RoutineName)) return + ! NumActForcePtsTower + call RegUnpack(Buf, OutData%NumActForcePtsTower) + if (RegCheckErr(Buf, RoutineName)) return + ! NodeClusterType + call RegUnpack(Buf, OutData%NodeClusterType) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE FAST_CopyTurbineType( SrcTurbineTypeData, DstTurbineTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(FAST_TurbineType), INTENT(INOUT) :: SrcTurbineTypeData TYPE(FAST_TurbineType), INTENT(INOUT) :: DstTurbineTypeData @@ -48881,1973 +16090,135 @@ SUBROUTINE FAST_DestroyTurbineType( TurbineTypeData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE FAST_DestroyTurbineType - SUBROUTINE FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FAST_TurbineType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackTurbineType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! TurbID - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! p_FAST: size of buffers for each call to pack subtype - CALL FAST_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p_FAST, ErrStat2, ErrMsg2, .TRUE. ) ! p_FAST - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p_FAST - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p_FAST - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p_FAST - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y_FAST: size of buffers for each call to pack subtype - CALL FAST_PackOutputFileType( Re_Buf, Db_Buf, Int_Buf, InData%y_FAST, ErrStat2, ErrMsg2, .TRUE. ) ! y_FAST - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_FAST - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_FAST - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_FAST - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m_FAST: size of buffers for each call to pack subtype - CALL FAST_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m_FAST, ErrStat2, ErrMsg2, .TRUE. ) ! m_FAST - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m_FAST - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m_FAST - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m_FAST - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! MeshMapData: size of buffers for each call to pack subtype - CALL FAST_PackModuleMapType( Re_Buf, Db_Buf, Int_Buf, InData%MeshMapData, ErrStat2, ErrMsg2, .TRUE. ) ! MeshMapData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! MeshMapData - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! MeshMapData - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! MeshMapData - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! ED: size of buffers for each call to pack subtype - CALL FAST_PackElastoDyn_Data( Re_Buf, Db_Buf, Int_Buf, InData%ED, ErrStat2, ErrMsg2, .TRUE. ) ! ED - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! BD: size of buffers for each call to pack subtype - CALL FAST_PackBeamDyn_Data( Re_Buf, Db_Buf, Int_Buf, InData%BD, ErrStat2, ErrMsg2, .TRUE. ) ! BD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SrvD: size of buffers for each call to pack subtype - CALL FAST_PackServoDyn_Data( Re_Buf, Db_Buf, Int_Buf, InData%SrvD, ErrStat2, ErrMsg2, .TRUE. ) ! SrvD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SrvD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SrvD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SrvD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! AD: size of buffers for each call to pack subtype - CALL FAST_PackAeroDyn_Data( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, .TRUE. ) ! AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! AD14: size of buffers for each call to pack subtype - CALL FAST_PackAeroDyn14_Data( Re_Buf, Db_Buf, Int_Buf, InData%AD14, ErrStat2, ErrMsg2, .TRUE. ) ! AD14 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AD14 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD14 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD14 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! IfW: size of buffers for each call to pack subtype - CALL FAST_PackInflowWind_Data( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, .TRUE. ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IfW - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IfW - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IfW - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! OpFM: size of buffers for each call to pack subtype - CALL FAST_PackOpenFOAM_Data( Re_Buf, Db_Buf, Int_Buf, InData%OpFM, ErrStat2, ErrMsg2, .TRUE. ) ! OpFM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OpFM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OpFM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OpFM - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SC_DX: size of buffers for each call to pack subtype - CALL FAST_PackSCDataEx_Data( Re_Buf, Db_Buf, Int_Buf, InData%SC_DX, ErrStat2, ErrMsg2, .TRUE. ) ! SC_DX - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SC_DX - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SC_DX - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SC_DX - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SeaSt: size of buffers for each call to pack subtype - CALL FAST_PackSeaState_Data( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt, ErrStat2, ErrMsg2, .TRUE. ) ! SeaSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SeaSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SeaSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SeaSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! HD: size of buffers for each call to pack subtype - CALL FAST_PackHydroDyn_Data( Re_Buf, Db_Buf, Int_Buf, InData%HD, ErrStat2, ErrMsg2, .TRUE. ) ! HD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! HD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! HD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! HD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SD: size of buffers for each call to pack subtype - CALL FAST_PackSubDyn_Data( Re_Buf, Db_Buf, Int_Buf, InData%SD, ErrStat2, ErrMsg2, .TRUE. ) ! SD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! MAP: size of buffers for each call to pack subtype - CALL FAST_PackMAP_Data( Re_Buf, Db_Buf, Int_Buf, InData%MAP, ErrStat2, ErrMsg2, .TRUE. ) ! MAP - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! MAP - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! MAP - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! MAP - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! FEAM: size of buffers for each call to pack subtype - CALL FAST_PackFEAMooring_Data( Re_Buf, Db_Buf, Int_Buf, InData%FEAM, ErrStat2, ErrMsg2, .TRUE. ) ! FEAM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! FEAM - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! FEAM - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! FEAM - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! MD: size of buffers for each call to pack subtype - CALL FAST_PackMoorDyn_Data( Re_Buf, Db_Buf, Int_Buf, InData%MD, ErrStat2, ErrMsg2, .TRUE. ) ! MD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! MD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! MD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! MD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Orca: size of buffers for each call to pack subtype - CALL FAST_PackOrcaFlex_Data( Re_Buf, Db_Buf, Int_Buf, InData%Orca, ErrStat2, ErrMsg2, .TRUE. ) ! Orca - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Orca - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Orca - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Orca - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! IceF: size of buffers for each call to pack subtype - CALL FAST_PackIceFloe_Data( Re_Buf, Db_Buf, Int_Buf, InData%IceF, ErrStat2, ErrMsg2, .TRUE. ) ! IceF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IceF - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IceF - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IceF - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! IceD: size of buffers for each call to pack subtype - CALL FAST_PackIceDyn_Data( Re_Buf, Db_Buf, Int_Buf, InData%IceD, ErrStat2, ErrMsg2, .TRUE. ) ! IceD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IceD - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IceD - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IceD - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! ExtPtfm: size of buffers for each call to pack subtype - CALL FAST_PackExtPtfm_Data( Re_Buf, Db_Buf, Int_Buf, InData%ExtPtfm, ErrStat2, ErrMsg2, .TRUE. ) ! ExtPtfm - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ExtPtfm - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ExtPtfm - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ExtPtfm - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%TurbID - Int_Xferred = Int_Xferred + 1 - CALL FAST_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p_FAST, ErrStat2, ErrMsg2, OnlySize ) ! p_FAST - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL FAST_PackOutputFileType( Re_Buf, Db_Buf, Int_Buf, InData%y_FAST, ErrStat2, ErrMsg2, OnlySize ) ! y_FAST - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL FAST_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m_FAST, ErrStat2, ErrMsg2, OnlySize ) ! m_FAST - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL FAST_PackModuleMapType( Re_Buf, Db_Buf, Int_Buf, InData%MeshMapData, ErrStat2, ErrMsg2, OnlySize ) ! MeshMapData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL FAST_PackElastoDyn_Data( Re_Buf, Db_Buf, Int_Buf, InData%ED, ErrStat2, ErrMsg2, OnlySize ) ! ED - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL FAST_PackBeamDyn_Data( Re_Buf, Db_Buf, Int_Buf, InData%BD, ErrStat2, ErrMsg2, OnlySize ) ! BD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL FAST_PackServoDyn_Data( Re_Buf, Db_Buf, Int_Buf, InData%SrvD, ErrStat2, ErrMsg2, OnlySize ) ! SrvD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL FAST_PackAeroDyn_Data( Re_Buf, Db_Buf, Int_Buf, InData%AD, ErrStat2, ErrMsg2, OnlySize ) ! AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL FAST_PackAeroDyn14_Data( Re_Buf, Db_Buf, Int_Buf, InData%AD14, ErrStat2, ErrMsg2, OnlySize ) ! AD14 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL FAST_PackInflowWind_Data( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL FAST_PackOpenFOAM_Data( Re_Buf, Db_Buf, Int_Buf, InData%OpFM, ErrStat2, ErrMsg2, OnlySize ) ! OpFM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL FAST_PackSCDataEx_Data( Re_Buf, Db_Buf, Int_Buf, InData%SC_DX, ErrStat2, ErrMsg2, OnlySize ) ! SC_DX - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL FAST_PackSeaState_Data( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt, ErrStat2, ErrMsg2, OnlySize ) ! SeaSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL FAST_PackHydroDyn_Data( Re_Buf, Db_Buf, Int_Buf, InData%HD, ErrStat2, ErrMsg2, OnlySize ) ! HD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL FAST_PackSubDyn_Data( Re_Buf, Db_Buf, Int_Buf, InData%SD, ErrStat2, ErrMsg2, OnlySize ) ! SD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL FAST_PackMAP_Data( Re_Buf, Db_Buf, Int_Buf, InData%MAP, ErrStat2, ErrMsg2, OnlySize ) ! MAP - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL FAST_PackFEAMooring_Data( Re_Buf, Db_Buf, Int_Buf, InData%FEAM, ErrStat2, ErrMsg2, OnlySize ) ! FEAM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL FAST_PackMoorDyn_Data( Re_Buf, Db_Buf, Int_Buf, InData%MD, ErrStat2, ErrMsg2, OnlySize ) ! MD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL FAST_PackOrcaFlex_Data( Re_Buf, Db_Buf, Int_Buf, InData%Orca, ErrStat2, ErrMsg2, OnlySize ) ! Orca - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL FAST_PackIceFloe_Data( Re_Buf, Db_Buf, Int_Buf, InData%IceF, ErrStat2, ErrMsg2, OnlySize ) ! IceF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL FAST_PackIceDyn_Data( Re_Buf, Db_Buf, Int_Buf, InData%IceD, ErrStat2, ErrMsg2, OnlySize ) ! IceD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL FAST_PackExtPtfm_Data( Re_Buf, Db_Buf, Int_Buf, InData%ExtPtfm, ErrStat2, ErrMsg2, OnlySize ) ! ExtPtfm - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE FAST_PackTurbineType - - SUBROUTINE FAST_UnPackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FAST_TurbineType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackTurbineType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%TurbID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FAST_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p_FAST, ErrStat2, ErrMsg2 ) ! p_FAST - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FAST_UnpackOutputFileType( Re_Buf, Db_Buf, Int_Buf, OutData%y_FAST, ErrStat2, ErrMsg2 ) ! y_FAST - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FAST_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m_FAST, ErrStat2, ErrMsg2 ) ! m_FAST - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FAST_UnpackModuleMapType( Re_Buf, Db_Buf, Int_Buf, OutData%MeshMapData, ErrStat2, ErrMsg2 ) ! MeshMapData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FAST_UnpackElastoDyn_Data( Re_Buf, Db_Buf, Int_Buf, OutData%ED, ErrStat2, ErrMsg2 ) ! ED - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FAST_UnpackBeamDyn_Data( Re_Buf, Db_Buf, Int_Buf, OutData%BD, ErrStat2, ErrMsg2 ) ! BD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FAST_UnpackServoDyn_Data( Re_Buf, Db_Buf, Int_Buf, OutData%SrvD, ErrStat2, ErrMsg2 ) ! SrvD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FAST_UnpackAeroDyn_Data( Re_Buf, Db_Buf, Int_Buf, OutData%AD, ErrStat2, ErrMsg2 ) ! AD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FAST_UnpackAeroDyn14_Data( Re_Buf, Db_Buf, Int_Buf, OutData%AD14, ErrStat2, ErrMsg2 ) ! AD14 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FAST_UnpackInflowWind_Data( Re_Buf, Db_Buf, Int_Buf, OutData%IfW, ErrStat2, ErrMsg2 ) ! IfW - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FAST_UnpackOpenFOAM_Data( Re_Buf, Db_Buf, Int_Buf, OutData%OpFM, ErrStat2, ErrMsg2 ) ! OpFM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FAST_UnpackSCDataEx_Data( Re_Buf, Db_Buf, Int_Buf, OutData%SC_DX, ErrStat2, ErrMsg2 ) ! SC_DX - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FAST_UnpackSeaState_Data( Re_Buf, Db_Buf, Int_Buf, OutData%SeaSt, ErrStat2, ErrMsg2 ) ! SeaSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FAST_UnpackHydroDyn_Data( Re_Buf, Db_Buf, Int_Buf, OutData%HD, ErrStat2, ErrMsg2 ) ! HD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FAST_UnpackSubDyn_Data( Re_Buf, Db_Buf, Int_Buf, OutData%SD, ErrStat2, ErrMsg2 ) ! SD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FAST_UnpackMAP_Data( Re_Buf, Db_Buf, Int_Buf, OutData%MAP, ErrStat2, ErrMsg2 ) ! MAP - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FAST_UnpackFEAMooring_Data( Re_Buf, Db_Buf, Int_Buf, OutData%FEAM, ErrStat2, ErrMsg2 ) ! FEAM - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FAST_UnpackMoorDyn_Data( Re_Buf, Db_Buf, Int_Buf, OutData%MD, ErrStat2, ErrMsg2 ) ! MD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FAST_UnpackOrcaFlex_Data( Re_Buf, Db_Buf, Int_Buf, OutData%Orca, ErrStat2, ErrMsg2 ) ! Orca - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FAST_UnpackIceFloe_Data( Re_Buf, Db_Buf, Int_Buf, OutData%IceF, ErrStat2, ErrMsg2 ) ! IceF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FAST_UnpackIceDyn_Data( Re_Buf, Db_Buf, Int_Buf, OutData%IceD, ErrStat2, ErrMsg2 ) ! IceD - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FAST_UnpackExtPtfm_Data( Re_Buf, Db_Buf, Int_Buf, OutData%ExtPtfm, ErrStat2, ErrMsg2 ) ! ExtPtfm - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE FAST_UnPackTurbineType +subroutine FAST_PackTurbineType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FAST_TurbineType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackTurbineType' + if (Buf%ErrStat >= AbortErrLev) return + ! TurbID + call RegPack(Buf, InData%TurbID) + if (RegCheckErr(Buf, RoutineName)) return + ! p_FAST + call FAST_PackParam(Buf, InData%p_FAST) + if (RegCheckErr(Buf, RoutineName)) return + ! y_FAST + call FAST_PackOutputFileType(Buf, InData%y_FAST) + if (RegCheckErr(Buf, RoutineName)) return + ! m_FAST + call FAST_PackMisc(Buf, InData%m_FAST) + if (RegCheckErr(Buf, RoutineName)) return + ! MeshMapData + call FAST_PackModuleMapType(Buf, InData%MeshMapData) + if (RegCheckErr(Buf, RoutineName)) return + ! ED + call FAST_PackElastoDyn_Data(Buf, InData%ED) + if (RegCheckErr(Buf, RoutineName)) return + ! BD + call FAST_PackBeamDyn_Data(Buf, InData%BD) + if (RegCheckErr(Buf, RoutineName)) return + ! SrvD + call FAST_PackServoDyn_Data(Buf, InData%SrvD) + if (RegCheckErr(Buf, RoutineName)) return + ! AD + call FAST_PackAeroDyn_Data(Buf, InData%AD) + if (RegCheckErr(Buf, RoutineName)) return + ! AD14 + call FAST_PackAeroDyn14_Data(Buf, InData%AD14) + if (RegCheckErr(Buf, RoutineName)) return + ! IfW + call FAST_PackInflowWind_Data(Buf, InData%IfW) + if (RegCheckErr(Buf, RoutineName)) return + ! OpFM + call FAST_PackOpenFOAM_Data(Buf, InData%OpFM) + if (RegCheckErr(Buf, RoutineName)) return + ! SC_DX + call FAST_PackSCDataEx_Data(Buf, InData%SC_DX) + if (RegCheckErr(Buf, RoutineName)) return + ! SeaSt + call FAST_PackSeaState_Data(Buf, InData%SeaSt) + if (RegCheckErr(Buf, RoutineName)) return + ! HD + call FAST_PackHydroDyn_Data(Buf, InData%HD) + if (RegCheckErr(Buf, RoutineName)) return + ! SD + call FAST_PackSubDyn_Data(Buf, InData%SD) + if (RegCheckErr(Buf, RoutineName)) return + ! MAP + call FAST_PackMAP_Data(Buf, InData%MAP) + if (RegCheckErr(Buf, RoutineName)) return + ! FEAM + call FAST_PackFEAMooring_Data(Buf, InData%FEAM) + if (RegCheckErr(Buf, RoutineName)) return + ! MD + call FAST_PackMoorDyn_Data(Buf, InData%MD) + if (RegCheckErr(Buf, RoutineName)) return + ! Orca + call FAST_PackOrcaFlex_Data(Buf, InData%Orca) + if (RegCheckErr(Buf, RoutineName)) return + ! IceF + call FAST_PackIceFloe_Data(Buf, InData%IceF) + if (RegCheckErr(Buf, RoutineName)) return + ! IceD + call FAST_PackIceDyn_Data(Buf, InData%IceD) + if (RegCheckErr(Buf, RoutineName)) return + ! ExtPtfm + call FAST_PackExtPtfm_Data(Buf, InData%ExtPtfm) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackTurbineType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FAST_TurbineType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackTurbineType' + if (Buf%ErrStat /= ErrID_None) return + ! TurbID + call RegUnpack(Buf, OutData%TurbID) + if (RegCheckErr(Buf, RoutineName)) return + ! p_FAST + call FAST_UnpackParam(Buf, OutData%p_FAST) ! p_FAST + ! y_FAST + call FAST_UnpackOutputFileType(Buf, OutData%y_FAST) ! y_FAST + ! m_FAST + call FAST_UnpackMisc(Buf, OutData%m_FAST) ! m_FAST + ! MeshMapData + call FAST_UnpackModuleMapType(Buf, OutData%MeshMapData) ! MeshMapData + ! ED + call FAST_UnpackElastoDyn_Data(Buf, OutData%ED) ! ED + ! BD + call FAST_UnpackBeamDyn_Data(Buf, OutData%BD) ! BD + ! SrvD + call FAST_UnpackServoDyn_Data(Buf, OutData%SrvD) ! SrvD + ! AD + call FAST_UnpackAeroDyn_Data(Buf, OutData%AD) ! AD + ! AD14 + call FAST_UnpackAeroDyn14_Data(Buf, OutData%AD14) ! AD14 + ! IfW + call FAST_UnpackInflowWind_Data(Buf, OutData%IfW) ! IfW + ! OpFM + call FAST_UnpackOpenFOAM_Data(Buf, OutData%OpFM) ! OpFM + ! SC_DX + call FAST_UnpackSCDataEx_Data(Buf, OutData%SC_DX) ! SC_DX + ! SeaSt + call FAST_UnpackSeaState_Data(Buf, OutData%SeaSt) ! SeaSt + ! HD + call FAST_UnpackHydroDyn_Data(Buf, OutData%HD) ! HD + ! SD + call FAST_UnpackSubDyn_Data(Buf, OutData%SD) ! SD + ! MAP + call FAST_UnpackMAP_Data(Buf, OutData%MAP) ! MAP + ! FEAM + call FAST_UnpackFEAMooring_Data(Buf, OutData%FEAM) ! FEAM + ! MD + call FAST_UnpackMoorDyn_Data(Buf, OutData%MD) ! MD + ! Orca + call FAST_UnpackOrcaFlex_Data(Buf, OutData%Orca) ! Orca + ! IceF + call FAST_UnpackIceFloe_Data(Buf, OutData%IceF) ! IceF + ! IceD + call FAST_UnpackIceDyn_Data(Buf, OutData%IceD) ! IceD + ! ExtPtfm + call FAST_UnpackExtPtfm_Data(Buf, OutData%ExtPtfm) ! ExtPtfm +end subroutine END MODULE FAST_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/openfast-registry/src/registry_gen_fortran.cpp b/modules/openfast-registry/src/registry_gen_fortran.cpp index f16d6c354b..22fc1422cf 100644 --- a/modules/openfast-registry/src/registry_gen_fortran.cpp +++ b/modules/openfast-registry/src/registry_gen_fortran.cpp @@ -1,4 +1,5 @@ #include +#include #include "registry.hpp" #include "templates.hpp" @@ -64,6 +65,7 @@ void Registry::gen_fortran_module(const Module &mod, const std::string &out_dir) auto file_name = mod.name + "_Types.f90"; auto file_path = out_dir + "/" + file_name; std::cerr << "generating " << file_name << std::endl; + bool is_NWTC_Library = false; // Open file, exit if error std::ofstream w(file_path); @@ -83,7 +85,8 @@ void Registry::gen_fortran_module(const Module &mod, const std::string &out_dir) // If this is the NWTC Library, we're not going to print "USE NWTC_Library" if (tolower(mod.name).compare("nwtc_library") == 0) - w << "USE SysSubs\n"; + w << "USE SysSubs\n" + << "USE ModReg\n"; else w << "USE NWTC_Library\n"; @@ -523,630 +526,305 @@ void gen_pack(std::ostream &w, const Module &mod, const DataType::Derived &ddt, { auto ddt_data = ddt.name_short + "Data"; auto routine_name = mod.nickname + "_Pack" + ddt.name_short; - - w << " SUBROUTINE " << routine_name - << "( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly )\n"; - w << " REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:)\n"; - w << " REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:)\n"; - w << " INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:)\n"; - w << " TYPE(" << ddt.type_fortran << "), INTENT(IN) :: InData\n"; - w << " INTEGER(IntKi), INTENT( OUT) :: ErrStat\n"; - w << " CHARACTER(*), INTENT( OUT) :: ErrMsg\n"; - w << " LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly\n"; - w << " ! Local variables\n"; - w << " INTEGER(IntKi) :: Re_BufSz\n"; - w << " INTEGER(IntKi) :: Re_Xferred\n"; - w << " INTEGER(IntKi) :: Db_BufSz\n"; - w << " INTEGER(IntKi) :: Db_Xferred\n"; - w << " INTEGER(IntKi) :: Int_BufSz\n"; - w << " INTEGER(IntKi) :: Int_Xferred\n"; - w << " INTEGER(IntKi) :: i,i1,i2,i3,i4,i5\n"; - w << " LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers\n"; - w << " INTEGER(IntKi) :: ErrStat2\n"; - w << " CHARACTER(ErrMsgLen) :: ErrMsg2\n"; - w << " CHARACTER(*), PARAMETER :: RoutineName = '" << routine_name << "'\n"; - - w << " ! buffers to store subtypes, if any\n"; - w << " REAL(ReKi), ALLOCATABLE :: Re_Buf(:)\n"; - w << " REAL(DbKi), ALLOCATABLE :: Db_Buf(:)\n"; - w << " INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:)\n\n"; - - w << " OnlySize = .FALSE.\n"; - w << " IF ( PRESENT(SizeOnly) ) THEN\n"; - w << " OnlySize = SizeOnly\n"; - w << " ENDIF\n"; - w << " !\n"; - - w << " ErrStat = ErrID_None\n"; - w << " ErrMsg = \"\"\n"; - w << " Re_BufSz = 0\n"; - w << " Db_BufSz = 0\n"; - w << " Int_BufSz = 0\n"; - - bool frst = true; - - // Loop through fields in derived data type - for (auto &field : ddt.fields) + std::string indent("\n"); + + bool has_alloc = std::any_of(ddt.fields.begin(), ddt.fields.end(), [](Field f) + { return f.is_allocatable; }); + bool has_ptr = std::any_of(ddt.fields.begin(), ddt.fields.end(), [](Field f) + { return f.is_pointer; }); + bool has_ddt_array = std::any_of(ddt.fields.begin(), ddt.fields.end(), [](Field f) + { return f.data_type->tag == DataType::Tag::Derived && f.rank > 0; }); + + w << indent << "subroutine " << routine_name << "(Buf, Indata)"; + indent += " "; + w << indent << "type(PackBuffer), intent(inout) :: Buf"; + w << indent << "type(" << ddt.type_fortran << "), intent(in) :: InData"; + w << indent << "character(*), parameter :: RoutineName = '" << routine_name << "'"; + if (has_ddt_array) { - // Skip non-target pointer fields - if (field.is_pointer && !field.is_target) - continue; - - auto assoc_alloc = field.is_pointer ? "ASSOCIATED" : "ALLOCATED"; - auto field_dims = field.name + dimstr(field.rank); - - // If this field is allocatable - if (field.is_allocatable) - { - w << " Int_BufSz = Int_BufSz + 1 ! " << field.name << " allocated yes/no\n"; - w << " IF ( " << assoc_alloc << "(InData%" << field.name << ") ) THEN\n"; - w << " Int_BufSz = Int_BufSz + 2*" << field.rank << " ! " << field.name - << " upper/lower bounds for each dimension\n"; - } - - // call individual routines to pack data from subtypes: - if (field.data_type->tag == DataType::Tag::Derived) - { - auto &field_ddt = field.data_type->derived; - if (frst) - { - w << " ! Allocate buffers for subtypes, if any (we'll get sizes from these) \n"; - frst = false; - } - - // Loop through dims and generate DO loops - for (int d = field.rank; d >= 1; d--) - w << " DO i" << d << " = LBOUND(InData%" << field.name << "," << d - << "), UBOUND(InData%" << field.name << "," << d << ")\n"; - - // Increment buffer size to store allocated flag, lower bound, upper bound - w << " Int_BufSz = Int_BufSz + 3 ! " << field.name - << ": size of buffers for each call to pack subtype\n"; - - // Call pack function based on type - if (field_ddt.name.compare("MeshType") == 0) - { - w << " CALL MeshPack( InData%" << field_dims - << ", Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! " << field.name - << " \n"; - } - else if (field_ddt.name.compare("DLL_Type") == 0) - { - w << " CALL DLLTypePack( InData%" << field_dims - << ", Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! " << field.name - << " \n"; - } - else if (field.data_type->tag == DataType::Tag::Derived) - { - w << " CALL " << field_ddt.module->nickname << "_Pack" << field_ddt.name_short - << "( Re_Buf, Db_Buf, Int_Buf, InData%" << field_dims - << ", ErrStat2, ErrMsg2, .TRUE. ) ! " << field.name << " \n"; - } - - w << " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)\n"; - w << " IF (ErrStat >= AbortErrLev) RETURN\n\n"; - - w << " IF(ALLOCATED(Re_Buf)) THEN ! " << field.name << "\n"; - w << " Re_BufSz = Re_BufSz + SIZE( Re_Buf )\n"; - w << " DEALLOCATE(Re_Buf)\n"; - w << " END IF\n"; - - w << " IF(ALLOCATED(Db_Buf)) THEN ! " << field.name << "\n"; - w << " Db_BufSz = Db_BufSz + SIZE( Db_Buf )\n"; - w << " DEALLOCATE(Db_Buf)\n"; - w << " END IF\n"; - - w << " IF(ALLOCATED(Int_Buf)) THEN ! " << field.name << "\n"; - w << " Int_BufSz = Int_BufSz + SIZE( Int_Buf )\n"; - w << " DEALLOCATE(Int_Buf)\n"; - w << " END IF\n"; - - for (int d = field.rank; d >= 1; d--) - w << " END DO\n"; - } - // intrinsic data types - else - { - // do all dimensions of arrays (no need for loop over i%d) - - std::string size = field.rank > 0 ? "SIZE(InData%" + field.name + ")" : "1"; - - if (field.data_type->tag == DataType::Tag::Real) - { - if (field.data_type->basic.bit_size == 64) - w << " Db_BufSz = Db_BufSz + " << size << " ! " << field.name << "\n"; - else - w << " Re_BufSz = Re_BufSz + " << size << " ! " << field.name << "\n"; - } - else if (field.data_type->tag == DataType::Tag::Integer || - field.data_type->tag == DataType::Tag::Logical) - { - w << " Int_BufSz = Int_BufSz + " << size << " ! " << field.name << "\n"; - } - else if (field.data_type->tag == DataType::Tag::Character) - { - w << " Int_BufSz = Int_BufSz + " << size << "*LEN(InData%" << field.name - << ") ! " << field.name << "\n"; - } - } - - // Close IF ALLOCATED statement - if (field.is_allocatable) - w << " END IF\n"; + w << indent << "integer(IntKi) :: "; + for (int i = 1; i <= ddt.max_rank; i++) + w << (i > 1 ? ", " : "") << "i" << i; + w << ""; + w << indent << "integer(IntKi) :: LB(" << ddt.max_rank << "), UB(" << ddt.max_rank << ")"; + } + if (has_ptr) + { + w << indent << "logical :: PtrInIndex"; } - // Allocate buffers - w << " IF ( Re_BufSz .GT. 0 ) THEN \n"; - w << " ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 )\n"; - w << " IF (ErrStat2 /= 0) THEN \n"; - w << " CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName)\n"; - w << " RETURN\n"; - w << " END IF\n"; - w << " END IF\n"; - - w << " IF ( Db_BufSz .GT. 0 ) THEN \n"; - w << " ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 )\n"; - w << " IF (ErrStat2 /= 0) THEN \n"; - w << " CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName)\n"; - w << " RETURN\n"; - w << " END IF\n"; - w << " END IF\n"; - - w << " IF ( Int_BufSz .GT. 0 ) THEN \n"; - w << " ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 )\n"; - w << " IF (ErrStat2 /= 0) THEN \n"; - w << " CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName)\n"; - w << " RETURN\n"; - w << " END IF\n"; - w << " END IF\n"; - w << " IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them)\n\n"; + w << indent << "if (Buf%ErrStat >= AbortErrLev) return"; if (gen_c_code) { - w << " IF (C_ASSOCIATED(InData%C_obj%object)) "; - w << "CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName)\n\n"; + w << indent << "if (c_associated(InData%C_obj%object)) then"; + w << indent << " call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName)"; + w << indent << " return"; + w << indent << "end if"; } - w << " Re_Xferred = 1\n"; - w << " Db_Xferred = 1\n"; - w << " Int_Xferred = 1\n\n"; - - std::string mainIndent = ""; - // Pack data for (auto &field : ddt.fields) { - // Skip pack non-target pointer fields - if (field.is_pointer && !field.is_target) - continue; + auto assoc_alloc = field.is_pointer ? "associated" : "allocated"; + auto var = "InData%" + field.name; - auto assoc_alloc = field.is_pointer ? "ASSOCIATED" : "ALLOCATED"; - auto field_dims = field.name + dimstr(field.rank); + w << indent << "! " << field.name; if (field.is_allocatable) { - // store whether the data type is allocated and the bounds of each dimension - w << " IF ( .NOT. " << assoc_alloc << "(InData%" << field.name << ") ) THEN\n"; - w << " IntKiBuf( Int_Xferred ) = 0\n"; // not allocated - w << " Int_Xferred = Int_Xferred + 1\n"; - w << " ELSE\n"; - w << " IntKiBuf( Int_Xferred ) = 1\n"; // allocated - w << " Int_Xferred = Int_Xferred + 1\n"; - for (int d = 1; d <= field.rank; d++) + w << indent << "call RegPack(Buf, " << assoc_alloc << "(" << var << "))"; + w << indent << "if (" << assoc_alloc << "(" << var << ")) then"; + indent += " "; + if (field.rank > 0) { - w << " IntKiBuf( Int_Xferred ) = LBOUND(InData%" << field.name << "," << d - << ")\n"; - w << " IntKiBuf( Int_Xferred + 1) = UBOUND(InData%" << field.name << "," << d - << ")\n"; - w << " Int_Xferred = Int_Xferred + 2\n"; + w << indent << "call RegPackBounds(Buf, " << field.rank << ", lbound(" << var << "), ubound(" << var << "))"; } - w << "\n"; - mainIndent = " "; } - else + if (field.is_pointer) { - mainIndent = ""; + w << indent << "call RegPackPointer(Buf, c_loc(" << var << "), PtrInIndex)"; + w << indent << "if (.not. PtrInIndex) then"; + indent += " "; } // call individual routines to pack data from subtypes: if (field.data_type->tag == DataType::Tag::Derived) { - if (frst == 1) + auto field_dims = var + dimstr(field.rank); + + if (field.rank > 0) { - w << " ! Allocate buffers for subtypes, if any (we'll get sizes from these) \n"; - frst = false; + w << indent << "LB(1:" << field.rank << ") = lbound(" << var << ")"; + w << indent << "UB(1:" << field.rank << ") = ubound(" << var << ")"; } for (int d = field.rank; d >= 1; d--) { - w << " DO i" << d << " = LBOUND(InData%" << field.name << "," << d - << "), UBOUND(InData%" << field.name << "," << d << ")\n"; + w << indent << "do i" << d << " = LB(" << d << "), UB(" << d << ")"; + indent += " "; } if (field.data_type->derived.name.compare("MeshType") == 0) { - w << " CALL MeshPack( InData%" << field_dims - << ", Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! " << field.name - << " \n"; + w << indent << "call MeshPack(Buf, " << field_dims << ") "; } else if (field.data_type->derived.name.compare("DLL_Type") == 0) { - w << " CALL DLLTypePack( InData%" << field_dims - << ", Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! " << field.name - << " \n"; + w << indent << "call DLLTypePack(Buf, " << field_dims << ") "; } else { - w << " CALL " << field.data_type->derived.module->nickname << "_Pack" - << field.data_type->derived.name_short << "( Re_Buf, Db_Buf, Int_Buf, InData%" << field_dims - << ", ErrStat2, ErrMsg2, OnlySize ) ! " << field.name << " \n"; + w << indent << "call " << field.data_type->derived.module->nickname << "_Pack" + << field.data_type->derived.name_short << "(Buf, " << field_dims << ") "; } - w << " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)\n"; - w << " IF (ErrStat >= AbortErrLev) RETURN\n\n"; - - w << " IF(ALLOCATED(Re_Buf)) THEN\n"; - w << " IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1\n"; - w << " IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf\n"; - w << " Re_Xferred = Re_Xferred + SIZE(Re_Buf)\n"; - w << " DEALLOCATE(Re_Buf)\n"; - w << " ELSE\n"; - w << " IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1\n"; - w << " ENDIF\n"; - - w << " IF(ALLOCATED(Db_Buf)) THEN\n"; - w << " IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1\n"; - w << " IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf\n"; - w << " Db_Xferred = Db_Xferred + SIZE(Db_Buf)\n"; - w << " DEALLOCATE(Db_Buf)\n"; - w << " ELSE\n"; - w << " IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1\n"; - w << " ENDIF\n"; - - w << " IF(ALLOCATED(Int_Buf)) THEN\n"; - w << " IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1\n"; - w << " IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf\n"; - w << " Int_Xferred = Int_Xferred + SIZE(Int_Buf)\n"; - w << " DEALLOCATE(Int_Buf)\n"; - w << " ELSE\n"; - w << " IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1\n"; - w << " ENDIF\n"; - for (int d = field.rank; d >= 1; d--) { - w << " END DO\n"; + indent = indent.substr(0, indent.size() - 3); + w << indent << "end do"; } } else { - // intrinsic data types - // do all dimensions of arrays (no need for loop over i%d) - auto indent = " " + mainIndent; - - for (int d = field.rank; d >= 1; d--) - { - w << indent << " DO i" << d << " = LBOUND(InData%" << field.name << "," << d - << "), UBOUND(InData%" << field.name << "," << d << ")\n"; - indent += " "; - } - - if (field.data_type->tag == DataType::Tag::Real) - { - if (field.data_type->basic.bit_size == 64) - { - w << indent << " DbKiBuf(Db_Xferred) = InData%" << field_dims << "\n"; - w << indent << " Db_Xferred = Db_Xferred + 1\n"; - } - else - { - w << indent << " ReKiBuf(Re_Xferred) = InData%" << field_dims << "\n"; - w << indent << " Re_Xferred = Re_Xferred + 1\n"; - } - } - else if (field.data_type->tag == DataType::Tag::Integer) - { - w << indent << " IntKiBuf(Int_Xferred) = InData%" << field_dims << "\n"; - w << indent << " Int_Xferred = Int_Xferred + 1\n"; - } - else if (field.data_type->tag == DataType::Tag::Logical) - { - w << indent << " IntKiBuf(Int_Xferred) = TRANSFER(InData%" << field_dims - << ", IntKiBuf(1))\n"; - w << indent << " Int_Xferred = Int_Xferred + 1\n"; - } - else if (field.data_type->tag == DataType::Tag::Character) - { - w << indent << " DO I = 1, LEN(InData%" << field.name << ")\n"; - w << indent << " IntKiBuf(Int_Xferred) = ICHAR(InData%" << field_dims - << "(I:I), IntKi)\n"; - w << indent << " Int_Xferred = Int_Xferred + 1\n"; - w << indent << " END DO ! I\n"; - } + // Intrinsic types are handled by generic Pack method on buffer + w << indent << "call RegPack(Buf, " << var << ")"; + } - for (int d = field.rank; d >= 1; d--) - { - indent = " " + mainIndent; - for (int i = 1; i < d; i++) - indent += " "; - w << indent << " END DO\n"; - } + if (field.is_pointer) + { + indent = indent.substr(0, indent.size() - 3); + w << indent << "end if"; } if (field.is_allocatable) - w << " END IF\n"; + { + indent = indent.substr(0, indent.size() - 3); + w << indent << "end if"; + } + + // Check for errors after packing each variable + w << indent << "if (RegCheckErr(Buf, RoutineName)) return"; } - w << " END SUBROUTINE " << routine_name << "\n\n"; + indent = indent.substr(0, indent.size() - 3); + w << indent << "end subroutine"; + w << indent; } void gen_unpack(std::ostream &w, const Module &mod, const DataType::Derived &ddt, bool gen_c_code) { auto routine_name = mod.nickname + "_UnPack" + ddt.name_short; - - w << " SUBROUTINE " << routine_name - << "( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg )\n"; - w << " REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:)\n"; - w << " REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:)\n"; - w << " INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:)\n"; - w << " TYPE(" << ddt.type_fortran << "), INTENT(INOUT) :: OutData\n"; - w << " INTEGER(IntKi), INTENT( OUT) :: ErrStat\n"; - w << " CHARACTER(*), INTENT( OUT) :: ErrMsg\n"; - w << " ! Local variables\n"; - w << " INTEGER(IntKi) :: Buf_size\n"; - w << " INTEGER(IntKi) :: Re_Xferred\n"; - w << " INTEGER(IntKi) :: Db_Xferred\n"; - w << " INTEGER(IntKi) :: Int_Xferred\n"; - w << " INTEGER(IntKi) :: i\n"; - for (int d = 1; d <= ddt.max_rank; d++) + std::string indent("\n"); + + bool has_alloc = std::any_of(ddt.fields.begin(), ddt.fields.end(), [](Field f) + { return f.is_allocatable; }); + bool has_ptr = std::any_of(ddt.fields.begin(), ddt.fields.end(), [](Field f) + { return f.is_pointer; }); + bool has_ddt_array = std::any_of(ddt.fields.begin(), ddt.fields.end(), [](Field f) + { return f.data_type->tag == DataType::Tag::Derived && f.rank > 0; }); + + w << indent << "subroutine " << routine_name << "(Buf, OutData)"; + indent += " "; + w << indent << "type(PackBuffer), intent(inout) :: Buf"; + w << indent << "type(" << ddt.type_fortran << "), intent(inout) :: OutData"; + w << indent << "character(*), parameter :: RoutineName = '" << routine_name << "'"; + if (has_ddt_array) { - w << " INTEGER(IntKi) :: i" << d << ", i" << d << "_l, i" << d - << "_u ! bounds (upper/lower) for an array dimension " << d << "\n"; + w << indent << "integer(IntKi) :: "; + for (int i = 1; i <= ddt.max_rank; i++) + w << (i > 1 ? ", " : "") << "i" << i; + w << ""; } - w << " INTEGER(IntKi) :: ErrStat2\n"; - w << " CHARACTER(ErrMsgLen) :: ErrMsg2\n"; - w << " CHARACTER(*), PARAMETER :: RoutineName = '" << routine_name << "'\n"; - - w << " ! buffers to store meshes, if any\n"; - w << " REAL(ReKi), ALLOCATABLE :: Re_Buf(:)\n"; - w << " REAL(DbKi), ALLOCATABLE :: Db_Buf(:)\n"; - w << " INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:)\n"; - w << " !\n"; - w << " ErrStat = ErrID_None\n"; - w << " ErrMsg = \"\"\n"; - w << " Re_Xferred = 1\n"; - w << " Db_Xferred = 1\n"; - w << " Int_Xferred = 1\n"; + if (has_ddt_array || has_alloc) + { + w << indent << "integer(IntKi) :: LB(" << ddt.max_rank << "), UB(" << ddt.max_rank << ")"; + } + if (has_alloc) + { + w << indent << "integer(IntKi) :: stat"; + w << indent << "logical :: IsAllocAssoc"; + } + if (has_ptr) + { + w << indent << "integer(IntKi) :: PtrIdx"; + w << indent << "type(c_ptr) :: Ptr"; + } + w << indent << "if (Buf%ErrStat /= ErrID_None) return"; // BJJ: TODO: if there are C types, we're going to have to associate with C data structures.... // Loop through fields and generate code to unpack data for (auto &field : ddt.fields) { - std::string mainIndent; auto field_dims = field.name + dimstr(field.rank); std::string var = "OutData%" + field.name; std::string var_dims = "OutData%" + field.name + dimstr(field.rank); std::string var_c = "OutData%C_obj%" + field.name; + auto assoc_alloc = field.is_pointer ? "associated" : "allocated"; - // Nullify non-target pointer fields and continue - if (field.is_pointer && !field.is_target) - { - w << " NULLIFY(" << var << ")\n"; - continue; - } + w << indent << "! " << field.name << ""; if (field.is_allocatable) { - auto assoc_alloc = field.is_pointer ? "ASSOCIATED" : "ALLOCATED"; - - // determine if the array was allocated when packed: - w << " IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! " << field.name - << " not allocated\n"; - w << " Int_Xferred = Int_Xferred + 1\n"; - w << " ELSE\n"; - w << " Int_Xferred = Int_Xferred + 1\n"; - - std::string dims; - for (int d = 1; d <= field.rank; d++) + w << indent << "if (" << assoc_alloc << "(" << var << ")) deallocate(" << var << ")"; + w << indent << "call RegUnpack(Buf, IsAllocAssoc)"; + w << indent << "if (RegCheckErr(Buf, RoutineName)) return"; + w << indent << "if (IsAllocAssoc) then"; + indent += " "; + if (field.rank > 0) { - w << " i" << d << "_l = IntKiBuf( Int_Xferred )\n"; - w << " i" << d << "_u = IntKiBuf( Int_Xferred + 1)\n"; - w << " Int_Xferred = Int_Xferred + 2\n"; - dims += (d == 1 ? "(i" : "i") + std::to_string(d) + "_l:i" + - std::to_string(d) + "_u" + (d == field.rank ? ")" : ","); + w << indent << "call RegUnpackBounds(Buf, " << field.rank << ", LB, UB)"; + w << indent << "if (RegCheckErr(Buf, RoutineName)) return"; } + } - w << " IF (" << assoc_alloc << "(" << var << ")) DEALLOCATE(" << var << ")\n"; - w << " ALLOCATE(" << var << dims << ",STAT=ErrStat2)\n"; - w << " IF (ErrStat2 /= 0) THEN \n"; - w << " CALL SetErrStat(ErrID_Fatal, 'Error allocating " << var - << ".', ErrStat, ErrMsg,RoutineName)\n"; - w << " RETURN\n"; - w << " END IF\n"; - - // bjj: this needs to be updated if we've got multiple dimension arrays - if (gen_c_code && field.is_pointer) + if (field.is_pointer) + { + w << indent << "call RegUnpackPointer(Buf, Ptr, PtrIdx)"; + w << indent << "if (RegCheckErr(Buf, RoutineName)) return"; + w << indent << "if (c_associated(Ptr)) then"; + if (field.rank == 0) { - w << " " << var_c << "_Len = SIZE(" << var << ")\n"; - w << " IF (" << var_c << "_Len > 0) &\n"; - w << " " << var_c << " = C_LOC( " << var << "("; + w << indent << " call c_f_pointer(Ptr, " << var << ")"; + } + else + { + auto rank = std::to_string(field.rank); + w << indent << " call c_f_pointer(Ptr, " << var << ", UB(1:" << rank << ")-LB(1:" << rank << "))"; + std::string remap_dims; for (int d = 1; d <= field.rank; d++) - w << (d > 1 ? "," : "") << " i" << d << "_l"; - w << " ) )\n"; + remap_dims += std::string(d > 1 ? "," : "") + "LB(" + std::to_string(d) + "):"; + w << indent << " " << var << "(" << remap_dims << ") => " << var; } - mainIndent = " "; + w << indent << "else"; + indent += " "; } - else + + if (field.is_allocatable) { + std::string dims; for (int d = 1; d <= field.rank; d++) - { - w << " i" << d << "_l = LBOUND(" << var << "," << d << ")\n"; - w << " i" << d << "_u = UBOUND(" << var << "," << d << ")\n"; - } - mainIndent = ""; + dims += std::string(d == 1 ? "(" : "") + "LB(" + std::to_string(d) + ")" + + ":UB(" + std::to_string(d) + ")" + (d < field.rank ? "," : ")"); + w << indent << "allocate(" << var << dims << ",stat=stat)"; + w << indent << "if (stat /= 0) then "; + w << indent << " call SetErrStat(ErrID_Fatal, 'Error allocating " << var << ".', Buf%ErrStat, Buf%ErrMsg, RoutineName)"; + w << indent << " return"; + w << indent << "end if"; } - // Call individual routines to pack data from subtypes: - if (field.data_type->tag == DataType::Tag::Derived) + // If this is a pointer, set pointer in buffer pointer index + if (field.is_pointer) { - for (int d = field.rank; d >= 1; d--) - { - w << " DO i" << d << " = LBOUND(" << var << "," << d << "), UBOUND(" << var - << "," << d << ")\n"; - } + w << indent << "Buf%Pointers(PtrIdx) = c_loc(" << var << ")"; + } - // initialize buffers to send to subtype-unpack routines: - - // reals: - w << " Buf_size=IntKiBuf( Int_Xferred )\n"; - w << " Int_Xferred = Int_Xferred + 1\n"; - w << " IF(Buf_size > 0) THEN\n"; - w << " ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2)\n"; - w << " IF (ErrStat2 /= 0) THEN \n"; - w << " CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName)\n"; - w << " RETURN\n"; - w << " END IF\n"; - w << " Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 )\n"; - w << " Re_Xferred = Re_Xferred + Buf_size\n"; - w << " END IF\n"; - - // doubles: - w << " Buf_size=IntKiBuf( Int_Xferred )\n"; - w << " Int_Xferred = Int_Xferred + 1\n"; - w << " IF(Buf_size > 0) THEN\n"; - w << " ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2)\n"; - w << " IF (ErrStat2 /= 0) THEN \n"; - w << " CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName)\n"; - w << " RETURN\n"; - w << " END IF\n"; - w << " Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 )\n"; - w << " Db_Xferred = Db_Xferred + Buf_size\n"; - w << " END IF\n"; - - // integers: - w << " Buf_size=IntKiBuf( Int_Xferred )\n"; - w << " Int_Xferred = Int_Xferred + 1\n"; - w << " IF(Buf_size > 0) THEN\n"; - w << " ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2)\n"; - w << " IF (ErrStat2 /= 0) THEN \n"; - w << " CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName)\n"; - w << " RETURN\n"; - w << " END IF\n"; - w << " Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 )\n"; - w << " Int_Xferred = Int_Xferred + Buf_size\n"; - w << " END IF\n"; + // bjj: this needs to be updated if we've got multiple dimension arrays + if (gen_c_code && field.is_pointer) + { + w << indent << var_c << "_Len = size(" << var << ")"; + w << indent << "if (" << var_c << "_Len > 0) " << var_c << " = c_loc(" << var << "("; + for (int d = 1; d <= field.rank; d++) + w << (d > 1 ? "," : "") << "LB(" << d << ")"; + w << "))"; + } - if (field.data_type->derived.name.compare("MeshType") == 0) - { - w << " CALL MeshUnpack( " << var_dims - << ", Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! " << field.name << " \n"; - } - else if (field.data_type->derived.name.compare("DLL_Type") == 0) - { - w << " CALL DLLTypeUnpack( " << var_dims - << ", Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! " << field.name << " \n"; - } - else + // Call individual routines to unpack data from subtypes: + if (field.data_type->tag == DataType::Tag::Derived) + { + // Get bounds for non-allocated field + if (field.rank > 0 && !field.is_allocatable) { - w << " CALL " << field.data_type->derived.module->nickname << "_Unpack" - << field.data_type->derived.name_short << "( Re_Buf, Db_Buf, Int_Buf, " << var_dims - << ", ErrStat2, ErrMsg2 ) ! " << field.name << " \n"; + w << indent << "LB(1:" << field.rank << ") = lbound(" << var << ")"; + w << indent << "UB(1:" << field.rank << ") = ubound(" << var << ")"; } - w << " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)\n"; - w << " IF (ErrStat >= AbortErrLev) RETURN\n\n"; - w << " IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf )\n"; - w << " IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf )\n"; - w << " IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf)\n"; - for (int d = field.rank; d >= 1; d--) - w << " END DO\n"; - } - else - { - auto indent = " " + mainIndent; for (int d = field.rank; d >= 1; d--) { - w << indent << " DO i" << d << " = LBOUND(" << var << "," << d - << "), UBOUND(OutData%" << field.name << "," << d << ")\n"; - indent += " "; + w << indent << "do i" << d << " = LB(" << d << "), UB(" << d << ")"; + indent += " "; } - if (field.data_type->tag == DataType::Tag::Real && - field.data_type->basic.bit_size <= 32) - { - if (gen_c_code && field.is_pointer) - { - w << indent << " " << var_dims << " = REAL(ReKiBuf(Re_Xferred), C_FLOAT)\n"; - } - else if (field.data_type->basic.bit_size == 32) - { - w << indent << " " << var_dims << " = REAL(ReKiBuf(Re_Xferred), SiKi)\n"; - } - else - { - w << indent << " " << var_dims << " = ReKiBuf(Re_Xferred)\n"; - } - w << indent << " Re_Xferred = Re_Xferred + 1\n"; - } - else if (field.data_type->tag == DataType::Tag::Real && - field.data_type->basic.bit_size == 64) - { - if (gen_c_code && field.is_pointer) - { - w << indent << " " << var_dims << " = REAL(DbKiBuf(Db_Xferred), C_DOUBLE)\n"; - } - else if (field.data_type->basic.type_fortran.compare("REAL(R8Ki)") == 0) - { - w << indent << " " << var_dims << " = REAL(DbKiBuf(Db_Xferred), R8Ki)\n"; - } - else - { - w << indent << " " << var_dims << " = DbKiBuf(Db_Xferred)\n"; - } - w << indent << " Db_Xferred = Db_Xferred + 1\n"; - } - else if (field.data_type->tag == DataType::Tag::Integer) + if (field.data_type->derived.name.compare("MeshType") == 0) { - w << indent << " " << var_dims << " = IntKiBuf(Int_Xferred)\n"; - w << indent << " Int_Xferred = Int_Xferred + 1\n"; + w << indent << "call MeshUnpack(Buf, " << var_dims << ") ! " << field.name << " "; } - else if (field.data_type->tag == DataType::Tag::Logical) + else if (field.data_type->derived.name.compare("DLL_Type") == 0) { - w << indent << " " << var_dims << " = TRANSFER(IntKiBuf(Int_Xferred), OutData%" - << field_dims << ")\n"; - w << indent << " Int_Xferred = Int_Xferred + 1\n"; + w << indent << "call DLLTypeUnpack(Buf, " << var_dims << ") ! " << field.name << " "; } - else if (field.data_type->tag == DataType::Tag::Character) + else { - - w << indent << " DO I = 1, LEN(" << var << ")\n"; - w << indent << " " << var_dims << "(I:I) = CHAR(IntKiBuf(Int_Xferred))\n"; - w << indent << " Int_Xferred = Int_Xferred + 1\n"; - w << indent << " END DO ! I\n"; + w << indent << "call " << field.data_type->derived.module->nickname << "_Unpack" + << field.data_type->derived.name_short << "(Buf, " << var_dims << ") ! " << field.name << " "; } for (int d = field.rank; d >= 1; d--) { - indent = " " + mainIndent; - for (int i = 1; i < d; i++) - indent += " "; - w << indent << " END DO\n"; + indent = indent.substr(0, indent.size() - 3); + w << indent << "end do"; } + } + else + { + // Intrinsic types are handled by generic unpack method on buffer + w << indent << "call RegUnpack(Buf, " << var << ")"; + w << indent << "if (RegCheckErr(Buf, RoutineName)) return"; // need to move scalars and strings to the %c_obj% type, too! // compare with copy routine if (gen_c_code && !field.is_pointer && field.rank == 0) { - std::string var_c = "OutData%C_obj%" + field.name; switch (field.data_type->tag) { case DataType::Tag::Real: case DataType::Tag::Integer: case DataType::Tag::Logical: - w << " " << var_c << " = " << var << "\n"; + w << indent << var_c << " = " << var << ""; break; case DataType::Tag::Character: - w << " " << var_c << " = TRANSFER(" << var << ", " << var_c << " )\n"; + w << indent << var_c << " = transfer(" << var << ", " << var_c << " )"; break; case DataType::Tag::Derived: break; @@ -1154,11 +832,27 @@ void gen_unpack(std::ostream &w, const Module &mod, const DataType::Derived &ddt } } + if (field.is_pointer) + { + indent = indent.substr(0, indent.size() - 3); + w << indent << "end if"; + } + if (field.is_allocatable) - w << " END IF\n"; + { + indent = indent.substr(0, indent.size() - 3); + if (field.is_pointer) + { + w << indent << "else"; + w << indent << " " << var << " => null()"; + } + w << indent << "end if"; + } } - w << " END SUBROUTINE " << routine_name << "\n\n"; + indent = indent.substr(0, indent.size() - 3); + w << indent << "end subroutine"; + w << indent; } void gen_extint_order(std::ostream &w, const Module &mod, std::string uy, const int order, diff --git a/modules/openfoam/src/OpenFOAM_Types.f90 b/modules/openfoam/src/OpenFOAM_Types.f90 index 8f08e34127..c29a2c345e 100644 --- a/modules/openfoam/src/OpenFOAM_Types.f90 +++ b/modules/openfoam/src/OpenFOAM_Types.f90 @@ -288,219 +288,146 @@ SUBROUTINE OpFM_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE OpFM_DestroyInitInput - SUBROUTINE OpFM_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(OpFM_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! NumActForcePtsBlade - Int_BufSz = Int_BufSz + 1 ! NumActForcePtsTower - Int_BufSz = Int_BufSz + 1 ! StructBldRNodes allocated yes/no - IF ( ASSOCIATED(InData%StructBldRNodes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! StructBldRNodes upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StructBldRNodes) ! StructBldRNodes - END IF - Int_BufSz = Int_BufSz + 1 ! StructTwrHNodes allocated yes/no - IF ( ASSOCIATED(InData%StructTwrHNodes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! StructTwrHNodes upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StructTwrHNodes) ! StructTwrHNodes - END IF - Re_BufSz = Re_BufSz + 1 ! BladeLength - Re_BufSz = Re_BufSz + 1 ! TowerHeight - Re_BufSz = Re_BufSz + 1 ! TowerBaseHeight - Int_BufSz = Int_BufSz + 1 ! NodeClusterType - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%NumActForcePtsBlade - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumActForcePtsTower - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ASSOCIATED(InData%StructBldRNodes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StructBldRNodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StructBldRNodes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%StructBldRNodes,1), UBOUND(InData%StructBldRNodes,1) - ReKiBuf(Re_Xferred) = InData%StructBldRNodes(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%StructTwrHNodes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StructTwrHNodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StructTwrHNodes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%StructTwrHNodes,1), UBOUND(InData%StructTwrHNodes,1) - ReKiBuf(Re_Xferred) = InData%StructTwrHNodes(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%BladeLength - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TowerHeight - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TowerBaseHeight - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NodeClusterType - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE OpFM_PackInitInput - - SUBROUTINE OpFM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(OpFM_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%NumActForcePtsBlade = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumActForcePtsBlade = OutData%NumActForcePtsBlade - OutData%NumActForcePtsTower = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumActForcePtsTower = OutData%NumActForcePtsTower - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StructBldRNodes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%StructBldRNodes)) DEALLOCATE(OutData%StructBldRNodes) - ALLOCATE(OutData%StructBldRNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StructBldRNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%StructBldRNodes_Len = SIZE(OutData%StructBldRNodes) - IF (OutData%C_obj%StructBldRNodes_Len > 0) & - OutData%C_obj%StructBldRNodes = C_LOC( OutData%StructBldRNodes( i1_l ) ) - DO i1 = LBOUND(OutData%StructBldRNodes,1), UBOUND(OutData%StructBldRNodes,1) - OutData%StructBldRNodes(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StructTwrHNodes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%StructTwrHNodes)) DEALLOCATE(OutData%StructTwrHNodes) - ALLOCATE(OutData%StructTwrHNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StructTwrHNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%StructTwrHNodes_Len = SIZE(OutData%StructTwrHNodes) - IF (OutData%C_obj%StructTwrHNodes_Len > 0) & - OutData%C_obj%StructTwrHNodes = C_LOC( OutData%StructTwrHNodes( i1_l ) ) - DO i1 = LBOUND(OutData%StructTwrHNodes,1), UBOUND(OutData%StructTwrHNodes,1) - OutData%StructTwrHNodes(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%BladeLength = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_obj%BladeLength = OutData%BladeLength - OutData%TowerHeight = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_obj%TowerHeight = OutData%TowerHeight - OutData%TowerBaseHeight = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_obj%TowerBaseHeight = OutData%TowerBaseHeight - OutData%NodeClusterType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NodeClusterType = OutData%NodeClusterType - END SUBROUTINE OpFM_UnPackInitInput +subroutine OpFM_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(OpFM_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'OpFM_PackInitInput' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + ! NumActForcePtsBlade + call RegPack(Buf, InData%NumActForcePtsBlade) + if (RegCheckErr(Buf, RoutineName)) return + ! NumActForcePtsTower + call RegPack(Buf, InData%NumActForcePtsTower) + if (RegCheckErr(Buf, RoutineName)) return + ! StructBldRNodes + call RegPack(Buf, associated(InData%StructBldRNodes)) + if (associated(InData%StructBldRNodes)) then + call RegPackBounds(Buf, 1, lbound(InData%StructBldRNodes), ubound(InData%StructBldRNodes)) + call RegPackPointer(Buf, c_loc(InData%StructBldRNodes), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%StructBldRNodes) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! StructTwrHNodes + call RegPack(Buf, associated(InData%StructTwrHNodes)) + if (associated(InData%StructTwrHNodes)) then + call RegPackBounds(Buf, 1, lbound(InData%StructTwrHNodes), ubound(InData%StructTwrHNodes)) + call RegPackPointer(Buf, c_loc(InData%StructTwrHNodes), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%StructTwrHNodes) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BladeLength + call RegPack(Buf, InData%BladeLength) + if (RegCheckErr(Buf, RoutineName)) return + ! TowerHeight + call RegPack(Buf, InData%TowerHeight) + if (RegCheckErr(Buf, RoutineName)) return + ! TowerBaseHeight + call RegPack(Buf, InData%TowerBaseHeight) + if (RegCheckErr(Buf, RoutineName)) return + ! NodeClusterType + call RegPack(Buf, InData%NodeClusterType) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine OpFM_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(OpFM_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'OpFM_UnPackInitInput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + ! NumActForcePtsBlade + call RegUnpack(Buf, OutData%NumActForcePtsBlade) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%NumActForcePtsBlade = OutData%NumActForcePtsBlade + ! NumActForcePtsTower + call RegUnpack(Buf, OutData%NumActForcePtsTower) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%NumActForcePtsTower = OutData%NumActForcePtsTower + ! StructBldRNodes + if (associated(OutData%StructBldRNodes)) deallocate(OutData%StructBldRNodes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%StructBldRNodes, UB(1:1)-LB(1:1)) + OutData%StructBldRNodes(LB(1):) => OutData%StructBldRNodes + else + allocate(OutData%StructBldRNodes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StructBldRNodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%StructBldRNodes) + OutData%C_obj%StructBldRNodes_Len = size(OutData%StructBldRNodes) + if (OutData%C_obj%StructBldRNodes_Len > 0) OutData%C_obj%StructBldRNodes = c_loc(OutData%StructBldRNodes(LB(1))) + call RegUnpack(Buf, OutData%StructBldRNodes) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%StructBldRNodes => null() + end if + ! StructTwrHNodes + if (associated(OutData%StructTwrHNodes)) deallocate(OutData%StructTwrHNodes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%StructTwrHNodes, UB(1:1)-LB(1:1)) + OutData%StructTwrHNodes(LB(1):) => OutData%StructTwrHNodes + else + allocate(OutData%StructTwrHNodes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StructTwrHNodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%StructTwrHNodes) + OutData%C_obj%StructTwrHNodes_Len = size(OutData%StructTwrHNodes) + if (OutData%C_obj%StructTwrHNodes_Len > 0) OutData%C_obj%StructTwrHNodes = c_loc(OutData%StructTwrHNodes(LB(1))) + call RegUnpack(Buf, OutData%StructTwrHNodes) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%StructTwrHNodes => null() + end if + ! BladeLength + call RegUnpack(Buf, OutData%BladeLength) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%BladeLength = OutData%BladeLength + ! TowerHeight + call RegUnpack(Buf, OutData%TowerHeight) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%TowerHeight = OutData%TowerHeight + ! TowerBaseHeight + call RegUnpack(Buf, OutData%TowerBaseHeight) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%TowerBaseHeight = OutData%TowerBaseHeight + ! NodeClusterType + call RegUnpack(Buf, OutData%NodeClusterType) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%NodeClusterType = OutData%NodeClusterType +end subroutine SUBROUTINE OpFM_C2Fary_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) TYPE(OpFM_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat @@ -656,271 +583,76 @@ SUBROUTINE OpFM_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE OpFM_DestroyInitOutput - SUBROUTINE OpFM_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(OpFM_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! WriteOutputHdr allocated yes/no - IF ( ALLOCATED(InData%WriteOutputHdr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdr upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdr)*LEN(InData%WriteOutputHdr) ! WriteOutputHdr - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputUnt allocated yes/no - IF ( ALLOCATED(InData%WriteOutputUnt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUnt upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUnt)*LEN(InData%WriteOutputUnt) ! WriteOutputUnt - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%WriteOutputHdr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) - DO I = 1, LEN(InData%WriteOutputHdr) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputUnt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) - DO I = 1, LEN(InData%WriteOutputUnt) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE OpFM_PackInitOutput - - SUBROUTINE OpFM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(OpFM_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputHdr)) DEALLOCATE(OutData%WriteOutputHdr) - ALLOCATE(OutData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) - DO I = 1, LEN(OutData%WriteOutputHdr) - OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputUnt)) DEALLOCATE(OutData%WriteOutputUnt) - ALLOCATE(OutData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) - DO I = 1, LEN(OutData%WriteOutputUnt) - OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE OpFM_UnPackInitOutput +subroutine OpFM_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(OpFM_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'OpFM_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + ! WriteOutputHdr + call RegPack(Buf, allocated(InData%WriteOutputHdr)) + if (allocated(InData%WriteOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPack(Buf, InData%WriteOutputHdr) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutputUnt + call RegPack(Buf, allocated(InData%WriteOutputUnt)) + if (allocated(InData%WriteOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPack(Buf, InData%WriteOutputUnt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Ver + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine OpFM_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(OpFM_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'OpFM_UnPackInitOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! WriteOutputHdr + if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WriteOutputUnt + if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Ver + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver +end subroutine SUBROUTINE OpFM_C2Fary_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) TYPE(OpFM_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat @@ -1079,582 +811,138 @@ SUBROUTINE OpFM_DestroyMisc( MiscData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE OpFM_DestroyMisc - SUBROUTINE OpFM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(OpFM_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! ActForceMotionsPoints allocated yes/no - IF ( ALLOCATED(InData%ActForceMotionsPoints) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ActForceMotionsPoints upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%ActForceMotionsPoints,1), UBOUND(InData%ActForceMotionsPoints,1) - Int_BufSz = Int_BufSz + 3 ! ActForceMotionsPoints: size of buffers for each call to pack subtype - CALL MeshPack( InData%ActForceMotionsPoints(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! ActForceMotionsPoints - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ActForceMotionsPoints - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ActForceMotionsPoints - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ActForceMotionsPoints - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! ActForceLoadsPoints allocated yes/no - IF ( ALLOCATED(InData%ActForceLoadsPoints) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ActForceLoadsPoints upper/lower bounds for each dimension - DO i1 = LBOUND(InData%ActForceLoadsPoints,1), UBOUND(InData%ActForceLoadsPoints,1) - Int_BufSz = Int_BufSz + 3 ! ActForceLoadsPoints: size of buffers for each call to pack subtype - CALL MeshPack( InData%ActForceLoadsPoints(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! ActForceLoadsPoints - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ActForceLoadsPoints - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ActForceLoadsPoints - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ActForceLoadsPoints - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! Line2_to_Point_Loads allocated yes/no - IF ( ALLOCATED(InData%Line2_to_Point_Loads) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Line2_to_Point_Loads upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Line2_to_Point_Loads,1), UBOUND(InData%Line2_to_Point_Loads,1) - Int_BufSz = Int_BufSz + 3 ! Line2_to_Point_Loads: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%Line2_to_Point_Loads(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Line2_to_Point_Loads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Line2_to_Point_Loads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Line2_to_Point_Loads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Line2_to_Point_Loads - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! Line2_to_Point_Motions allocated yes/no - IF ( ALLOCATED(InData%Line2_to_Point_Motions) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Line2_to_Point_Motions upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Line2_to_Point_Motions,1), UBOUND(InData%Line2_to_Point_Motions,1) - Int_BufSz = Int_BufSz + 3 ! Line2_to_Point_Motions: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%Line2_to_Point_Motions(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Line2_to_Point_Motions - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Line2_to_Point_Motions - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Line2_to_Point_Motions - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Line2_to_Point_Motions - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%ActForceMotionsPoints) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ActForceMotionsPoints,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ActForceMotionsPoints,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ActForceMotionsPoints,1), UBOUND(InData%ActForceMotionsPoints,1) - CALL MeshPack( InData%ActForceMotionsPoints(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! ActForceMotionsPoints - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ActForceLoadsPoints) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ActForceLoadsPoints,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ActForceLoadsPoints,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ActForceLoadsPoints,1), UBOUND(InData%ActForceLoadsPoints,1) - CALL MeshPack( InData%ActForceLoadsPoints(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! ActForceLoadsPoints - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Line2_to_Point_Loads) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Line2_to_Point_Loads,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Line2_to_Point_Loads,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Line2_to_Point_Loads,1), UBOUND(InData%Line2_to_Point_Loads,1) - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%Line2_to_Point_Loads(i1), ErrStat2, ErrMsg2, OnlySize ) ! Line2_to_Point_Loads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Line2_to_Point_Motions) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Line2_to_Point_Motions,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Line2_to_Point_Motions,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Line2_to_Point_Motions,1), UBOUND(InData%Line2_to_Point_Motions,1) - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%Line2_to_Point_Motions(i1), ErrStat2, ErrMsg2, OnlySize ) ! Line2_to_Point_Motions - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - END SUBROUTINE OpFM_PackMisc - - SUBROUTINE OpFM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(OpFM_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ActForceMotionsPoints not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ActForceMotionsPoints)) DEALLOCATE(OutData%ActForceMotionsPoints) - ALLOCATE(OutData%ActForceMotionsPoints(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ActForceMotionsPoints.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ActForceMotionsPoints,1), UBOUND(OutData%ActForceMotionsPoints,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%ActForceMotionsPoints(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! ActForceMotionsPoints - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ActForceLoadsPoints not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ActForceLoadsPoints)) DEALLOCATE(OutData%ActForceLoadsPoints) - ALLOCATE(OutData%ActForceLoadsPoints(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ActForceLoadsPoints.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ActForceLoadsPoints,1), UBOUND(OutData%ActForceLoadsPoints,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%ActForceLoadsPoints(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! ActForceLoadsPoints - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Line2_to_Point_Loads not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Line2_to_Point_Loads)) DEALLOCATE(OutData%Line2_to_Point_Loads) - ALLOCATE(OutData%Line2_to_Point_Loads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Line2_to_Point_Loads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Line2_to_Point_Loads,1), UBOUND(OutData%Line2_to_Point_Loads,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%Line2_to_Point_Loads(i1), ErrStat2, ErrMsg2 ) ! Line2_to_Point_Loads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Line2_to_Point_Motions not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Line2_to_Point_Motions)) DEALLOCATE(OutData%Line2_to_Point_Motions) - ALLOCATE(OutData%Line2_to_Point_Motions(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Line2_to_Point_Motions.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Line2_to_Point_Motions,1), UBOUND(OutData%Line2_to_Point_Motions,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%Line2_to_Point_Motions(i1), ErrStat2, ErrMsg2 ) ! Line2_to_Point_Motions - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - END SUBROUTINE OpFM_UnPackMisc +subroutine OpFM_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(OpFM_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'OpFM_PackMisc' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + ! ActForceMotionsPoints + call RegPack(Buf, allocated(InData%ActForceMotionsPoints)) + if (allocated(InData%ActForceMotionsPoints)) then + call RegPackBounds(Buf, 1, lbound(InData%ActForceMotionsPoints), ubound(InData%ActForceMotionsPoints)) + LB(1:1) = lbound(InData%ActForceMotionsPoints) + UB(1:1) = ubound(InData%ActForceMotionsPoints) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%ActForceMotionsPoints(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ActForceLoadsPoints + call RegPack(Buf, allocated(InData%ActForceLoadsPoints)) + if (allocated(InData%ActForceLoadsPoints)) then + call RegPackBounds(Buf, 1, lbound(InData%ActForceLoadsPoints), ubound(InData%ActForceLoadsPoints)) + LB(1:1) = lbound(InData%ActForceLoadsPoints) + UB(1:1) = ubound(InData%ActForceLoadsPoints) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%ActForceLoadsPoints(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Line2_to_Point_Loads + call RegPack(Buf, allocated(InData%Line2_to_Point_Loads)) + if (allocated(InData%Line2_to_Point_Loads)) then + call RegPackBounds(Buf, 1, lbound(InData%Line2_to_Point_Loads), ubound(InData%Line2_to_Point_Loads)) + LB(1:1) = lbound(InData%Line2_to_Point_Loads) + UB(1:1) = ubound(InData%Line2_to_Point_Loads) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%Line2_to_Point_Loads(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Line2_to_Point_Motions + call RegPack(Buf, allocated(InData%Line2_to_Point_Motions)) + if (allocated(InData%Line2_to_Point_Motions)) then + call RegPackBounds(Buf, 1, lbound(InData%Line2_to_Point_Motions), ubound(InData%Line2_to_Point_Motions)) + LB(1:1) = lbound(InData%Line2_to_Point_Motions) + UB(1:1) = ubound(InData%Line2_to_Point_Motions) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%Line2_to_Point_Motions(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine OpFM_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(OpFM_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'OpFM_UnPackMisc' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! ActForceMotionsPoints + if (allocated(OutData%ActForceMotionsPoints)) deallocate(OutData%ActForceMotionsPoints) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ActForceMotionsPoints(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ActForceMotionsPoints.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%ActForceMotionsPoints(i1)) ! ActForceMotionsPoints + end do + end if + ! ActForceLoadsPoints + if (allocated(OutData%ActForceLoadsPoints)) deallocate(OutData%ActForceLoadsPoints) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ActForceLoadsPoints(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ActForceLoadsPoints.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%ActForceLoadsPoints(i1)) ! ActForceLoadsPoints + end do + end if + ! Line2_to_Point_Loads + if (allocated(OutData%Line2_to_Point_Loads)) deallocate(OutData%Line2_to_Point_Loads) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Line2_to_Point_Loads(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Line2_to_Point_Loads.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%Line2_to_Point_Loads(i1)) ! Line2_to_Point_Loads + end do + end if + ! Line2_to_Point_Motions + if (allocated(OutData%Line2_to_Point_Motions)) deallocate(OutData%Line2_to_Point_Motions) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Line2_to_Point_Motions(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Line2_to_Point_Motions.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%Line2_to_Point_Motions(i1)) ! Line2_to_Point_Motions + end do + end if +end subroutine SUBROUTINE OpFM_C2Fary_CopyMisc( MiscData, ErrStat, ErrMsg, SkipPointers ) TYPE(OpFM_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat @@ -1785,249 +1073,181 @@ SUBROUTINE OpFM_DestroyParam( ParamData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE OpFM_DestroyParam - SUBROUTINE OpFM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(OpFM_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! AirDens - Int_BufSz = Int_BufSz + 1 ! NumBl - Int_BufSz = Int_BufSz + 1 ! NMappings - Int_BufSz = Int_BufSz + 1 ! NnodesVel - Int_BufSz = Int_BufSz + 1 ! NnodesForce - Int_BufSz = Int_BufSz + 1 ! NnodesForceBlade - Int_BufSz = Int_BufSz + 1 ! NnodesForceTower - Int_BufSz = Int_BufSz + 1 ! forceBldRnodes allocated yes/no - IF ( ASSOCIATED(InData%forceBldRnodes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! forceBldRnodes upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%forceBldRnodes) ! forceBldRnodes - END IF - Int_BufSz = Int_BufSz + 1 ! forceTwrHnodes allocated yes/no - IF ( ASSOCIATED(InData%forceTwrHnodes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! forceTwrHnodes upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%forceTwrHnodes) ! forceTwrHnodes - END IF - Re_BufSz = Re_BufSz + 1 ! BladeLength - Re_BufSz = Re_BufSz + 1 ! TowerHeight - Re_BufSz = Re_BufSz + 1 ! TowerBaseHeight - Int_BufSz = Int_BufSz + 1 ! NodeClusterType - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%AirDens - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBl - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NMappings - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NnodesVel - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NnodesForce - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NnodesForceBlade - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NnodesForceTower - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ASSOCIATED(InData%forceBldRnodes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%forceBldRnodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%forceBldRnodes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%forceBldRnodes,1), UBOUND(InData%forceBldRnodes,1) - ReKiBuf(Re_Xferred) = InData%forceBldRnodes(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%forceTwrHnodes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%forceTwrHnodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%forceTwrHnodes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%forceTwrHnodes,1), UBOUND(InData%forceTwrHnodes,1) - ReKiBuf(Re_Xferred) = InData%forceTwrHnodes(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%BladeLength - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TowerHeight - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TowerBaseHeight - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NodeClusterType - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE OpFM_PackParam - - SUBROUTINE OpFM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(OpFM_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%AirDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_obj%AirDens = OutData%AirDens - OutData%NumBl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumBl = OutData%NumBl - OutData%NMappings = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NMappings = OutData%NMappings - OutData%NnodesVel = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NnodesVel = OutData%NnodesVel - OutData%NnodesForce = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NnodesForce = OutData%NnodesForce - OutData%NnodesForceBlade = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NnodesForceBlade = OutData%NnodesForceBlade - OutData%NnodesForceTower = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NnodesForceTower = OutData%NnodesForceTower - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! forceBldRnodes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%forceBldRnodes)) DEALLOCATE(OutData%forceBldRnodes) - ALLOCATE(OutData%forceBldRnodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%forceBldRnodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%forceBldRnodes_Len = SIZE(OutData%forceBldRnodes) - IF (OutData%C_obj%forceBldRnodes_Len > 0) & - OutData%C_obj%forceBldRnodes = C_LOC( OutData%forceBldRnodes( i1_l ) ) - DO i1 = LBOUND(OutData%forceBldRnodes,1), UBOUND(OutData%forceBldRnodes,1) - OutData%forceBldRnodes(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! forceTwrHnodes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%forceTwrHnodes)) DEALLOCATE(OutData%forceTwrHnodes) - ALLOCATE(OutData%forceTwrHnodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%forceTwrHnodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%forceTwrHnodes_Len = SIZE(OutData%forceTwrHnodes) - IF (OutData%C_obj%forceTwrHnodes_Len > 0) & - OutData%C_obj%forceTwrHnodes = C_LOC( OutData%forceTwrHnodes( i1_l ) ) - DO i1 = LBOUND(OutData%forceTwrHnodes,1), UBOUND(OutData%forceTwrHnodes,1) - OutData%forceTwrHnodes(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%BladeLength = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_obj%BladeLength = OutData%BladeLength - OutData%TowerHeight = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_obj%TowerHeight = OutData%TowerHeight - OutData%TowerBaseHeight = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_obj%TowerBaseHeight = OutData%TowerBaseHeight - OutData%NodeClusterType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NodeClusterType = OutData%NodeClusterType - END SUBROUTINE OpFM_UnPackParam +subroutine OpFM_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(OpFM_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'OpFM_PackParam' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + ! AirDens + call RegPack(Buf, InData%AirDens) + if (RegCheckErr(Buf, RoutineName)) return + ! NumBl + call RegPack(Buf, InData%NumBl) + if (RegCheckErr(Buf, RoutineName)) return + ! NMappings + call RegPack(Buf, InData%NMappings) + if (RegCheckErr(Buf, RoutineName)) return + ! NnodesVel + call RegPack(Buf, InData%NnodesVel) + if (RegCheckErr(Buf, RoutineName)) return + ! NnodesForce + call RegPack(Buf, InData%NnodesForce) + if (RegCheckErr(Buf, RoutineName)) return + ! NnodesForceBlade + call RegPack(Buf, InData%NnodesForceBlade) + if (RegCheckErr(Buf, RoutineName)) return + ! NnodesForceTower + call RegPack(Buf, InData%NnodesForceTower) + if (RegCheckErr(Buf, RoutineName)) return + ! forceBldRnodes + call RegPack(Buf, associated(InData%forceBldRnodes)) + if (associated(InData%forceBldRnodes)) then + call RegPackBounds(Buf, 1, lbound(InData%forceBldRnodes), ubound(InData%forceBldRnodes)) + call RegPackPointer(Buf, c_loc(InData%forceBldRnodes), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%forceBldRnodes) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! forceTwrHnodes + call RegPack(Buf, associated(InData%forceTwrHnodes)) + if (associated(InData%forceTwrHnodes)) then + call RegPackBounds(Buf, 1, lbound(InData%forceTwrHnodes), ubound(InData%forceTwrHnodes)) + call RegPackPointer(Buf, c_loc(InData%forceTwrHnodes), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%forceTwrHnodes) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BladeLength + call RegPack(Buf, InData%BladeLength) + if (RegCheckErr(Buf, RoutineName)) return + ! TowerHeight + call RegPack(Buf, InData%TowerHeight) + if (RegCheckErr(Buf, RoutineName)) return + ! TowerBaseHeight + call RegPack(Buf, InData%TowerBaseHeight) + if (RegCheckErr(Buf, RoutineName)) return + ! NodeClusterType + call RegPack(Buf, InData%NodeClusterType) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine OpFM_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(OpFM_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'OpFM_UnPackParam' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + ! AirDens + call RegUnpack(Buf, OutData%AirDens) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%AirDens = OutData%AirDens + ! NumBl + call RegUnpack(Buf, OutData%NumBl) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%NumBl = OutData%NumBl + ! NMappings + call RegUnpack(Buf, OutData%NMappings) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%NMappings = OutData%NMappings + ! NnodesVel + call RegUnpack(Buf, OutData%NnodesVel) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%NnodesVel = OutData%NnodesVel + ! NnodesForce + call RegUnpack(Buf, OutData%NnodesForce) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%NnodesForce = OutData%NnodesForce + ! NnodesForceBlade + call RegUnpack(Buf, OutData%NnodesForceBlade) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%NnodesForceBlade = OutData%NnodesForceBlade + ! NnodesForceTower + call RegUnpack(Buf, OutData%NnodesForceTower) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%NnodesForceTower = OutData%NnodesForceTower + ! forceBldRnodes + if (associated(OutData%forceBldRnodes)) deallocate(OutData%forceBldRnodes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%forceBldRnodes, UB(1:1)-LB(1:1)) + OutData%forceBldRnodes(LB(1):) => OutData%forceBldRnodes + else + allocate(OutData%forceBldRnodes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%forceBldRnodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%forceBldRnodes) + OutData%C_obj%forceBldRnodes_Len = size(OutData%forceBldRnodes) + if (OutData%C_obj%forceBldRnodes_Len > 0) OutData%C_obj%forceBldRnodes = c_loc(OutData%forceBldRnodes(LB(1))) + call RegUnpack(Buf, OutData%forceBldRnodes) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%forceBldRnodes => null() + end if + ! forceTwrHnodes + if (associated(OutData%forceTwrHnodes)) deallocate(OutData%forceTwrHnodes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%forceTwrHnodes, UB(1:1)-LB(1:1)) + OutData%forceTwrHnodes(LB(1):) => OutData%forceTwrHnodes + else + allocate(OutData%forceTwrHnodes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%forceTwrHnodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%forceTwrHnodes) + OutData%C_obj%forceTwrHnodes_Len = size(OutData%forceTwrHnodes) + if (OutData%C_obj%forceTwrHnodes_Len > 0) OutData%C_obj%forceTwrHnodes = c_loc(OutData%forceTwrHnodes(LB(1))) + call RegUnpack(Buf, OutData%forceTwrHnodes) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%forceTwrHnodes => null() + end if + ! BladeLength + call RegUnpack(Buf, OutData%BladeLength) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%BladeLength = OutData%BladeLength + ! TowerHeight + call RegUnpack(Buf, OutData%TowerHeight) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%TowerHeight = OutData%TowerHeight + ! TowerBaseHeight + call RegUnpack(Buf, OutData%TowerBaseHeight) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%TowerBaseHeight = OutData%TowerBaseHeight + ! NodeClusterType + call RegUnpack(Buf, OutData%NodeClusterType) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%NodeClusterType = OutData%NodeClusterType +end subroutine SUBROUTINE OpFM_C2Fary_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) TYPE(OpFM_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat @@ -2515,798 +1735,659 @@ SUBROUTINE OpFM_DestroyInput( InputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE OpFM_DestroyInput - SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(OpFM_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! pxVel allocated yes/no - IF ( ASSOCIATED(InData%pxVel) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! pxVel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%pxVel) ! pxVel - END IF - Int_BufSz = Int_BufSz + 1 ! pyVel allocated yes/no - IF ( ASSOCIATED(InData%pyVel) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! pyVel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%pyVel) ! pyVel - END IF - Int_BufSz = Int_BufSz + 1 ! pzVel allocated yes/no - IF ( ASSOCIATED(InData%pzVel) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! pzVel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%pzVel) ! pzVel - END IF - Int_BufSz = Int_BufSz + 1 ! pxForce allocated yes/no - IF ( ASSOCIATED(InData%pxForce) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! pxForce upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%pxForce) ! pxForce - END IF - Int_BufSz = Int_BufSz + 1 ! pyForce allocated yes/no - IF ( ASSOCIATED(InData%pyForce) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! pyForce upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%pyForce) ! pyForce - END IF - Int_BufSz = Int_BufSz + 1 ! pzForce allocated yes/no - IF ( ASSOCIATED(InData%pzForce) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! pzForce upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%pzForce) ! pzForce - END IF - Int_BufSz = Int_BufSz + 1 ! xdotForce allocated yes/no - IF ( ASSOCIATED(InData%xdotForce) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xdotForce upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%xdotForce) ! xdotForce - END IF - Int_BufSz = Int_BufSz + 1 ! ydotForce allocated yes/no - IF ( ASSOCIATED(InData%ydotForce) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ydotForce upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ydotForce) ! ydotForce - END IF - Int_BufSz = Int_BufSz + 1 ! zdotForce allocated yes/no - IF ( ASSOCIATED(InData%zdotForce) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! zdotForce upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%zdotForce) ! zdotForce - END IF - Int_BufSz = Int_BufSz + 1 ! pOrientation allocated yes/no - IF ( ASSOCIATED(InData%pOrientation) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! pOrientation upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%pOrientation) ! pOrientation - END IF - Int_BufSz = Int_BufSz + 1 ! fx allocated yes/no - IF ( ASSOCIATED(InData%fx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! fx upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fx) ! fx - END IF - Int_BufSz = Int_BufSz + 1 ! fy allocated yes/no - IF ( ASSOCIATED(InData%fy) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! fy upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fy) ! fy - END IF - Int_BufSz = Int_BufSz + 1 ! fz allocated yes/no - IF ( ASSOCIATED(InData%fz) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! fz upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fz) ! fz - END IF - Int_BufSz = Int_BufSz + 1 ! momentx allocated yes/no - IF ( ASSOCIATED(InData%momentx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! momentx upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%momentx) ! momentx - END IF - Int_BufSz = Int_BufSz + 1 ! momenty allocated yes/no - IF ( ASSOCIATED(InData%momenty) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! momenty upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%momenty) ! momenty - END IF - Int_BufSz = Int_BufSz + 1 ! momentz allocated yes/no - IF ( ASSOCIATED(InData%momentz) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! momentz upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%momentz) ! momentz - END IF - Int_BufSz = Int_BufSz + 1 ! forceNodesChord allocated yes/no - IF ( ASSOCIATED(InData%forceNodesChord) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! forceNodesChord upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%forceNodesChord) ! forceNodesChord - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ASSOCIATED(InData%pxVel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%pxVel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pxVel,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%pxVel,1), UBOUND(InData%pxVel,1) - ReKiBuf(Re_Xferred) = InData%pxVel(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%pyVel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%pyVel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pyVel,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%pyVel,1), UBOUND(InData%pyVel,1) - ReKiBuf(Re_Xferred) = InData%pyVel(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%pzVel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%pzVel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pzVel,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%pzVel,1), UBOUND(InData%pzVel,1) - ReKiBuf(Re_Xferred) = InData%pzVel(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%pxForce) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%pxForce,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pxForce,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%pxForce,1), UBOUND(InData%pxForce,1) - ReKiBuf(Re_Xferred) = InData%pxForce(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%pyForce) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%pyForce,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pyForce,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%pyForce,1), UBOUND(InData%pyForce,1) - ReKiBuf(Re_Xferred) = InData%pyForce(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%pzForce) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%pzForce,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pzForce,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%pzForce,1), UBOUND(InData%pzForce,1) - ReKiBuf(Re_Xferred) = InData%pzForce(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%xdotForce) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xdotForce,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xdotForce,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xdotForce,1), UBOUND(InData%xdotForce,1) - ReKiBuf(Re_Xferred) = InData%xdotForce(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%ydotForce) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ydotForce,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ydotForce,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ydotForce,1), UBOUND(InData%ydotForce,1) - ReKiBuf(Re_Xferred) = InData%ydotForce(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%zdotForce) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%zdotForce,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zdotForce,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%zdotForce,1), UBOUND(InData%zdotForce,1) - ReKiBuf(Re_Xferred) = InData%zdotForce(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%pOrientation) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%pOrientation,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pOrientation,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%pOrientation,1), UBOUND(InData%pOrientation,1) - ReKiBuf(Re_Xferred) = InData%pOrientation(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%fx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%fx,1), UBOUND(InData%fx,1) - ReKiBuf(Re_Xferred) = InData%fx(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%fy) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fy,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fy,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%fy,1), UBOUND(InData%fy,1) - ReKiBuf(Re_Xferred) = InData%fy(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%fz) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fz,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fz,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%fz,1), UBOUND(InData%fz,1) - ReKiBuf(Re_Xferred) = InData%fz(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%momentx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%momentx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%momentx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%momentx,1), UBOUND(InData%momentx,1) - ReKiBuf(Re_Xferred) = InData%momentx(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%momenty) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%momenty,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%momenty,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%momenty,1), UBOUND(InData%momenty,1) - ReKiBuf(Re_Xferred) = InData%momenty(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%momentz) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%momentz,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%momentz,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%momentz,1), UBOUND(InData%momentz,1) - ReKiBuf(Re_Xferred) = InData%momentz(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%forceNodesChord) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%forceNodesChord,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%forceNodesChord,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%forceNodesChord,1), UBOUND(InData%forceNodesChord,1) - ReKiBuf(Re_Xferred) = InData%forceNodesChord(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE OpFM_PackInput - - SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(OpFM_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pxVel not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%pxVel)) DEALLOCATE(OutData%pxVel) - ALLOCATE(OutData%pxVel(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%pxVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%pxVel_Len = SIZE(OutData%pxVel) - IF (OutData%C_obj%pxVel_Len > 0) & - OutData%C_obj%pxVel = C_LOC( OutData%pxVel( i1_l ) ) - DO i1 = LBOUND(OutData%pxVel,1), UBOUND(OutData%pxVel,1) - OutData%pxVel(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pyVel not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%pyVel)) DEALLOCATE(OutData%pyVel) - ALLOCATE(OutData%pyVel(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%pyVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%pyVel_Len = SIZE(OutData%pyVel) - IF (OutData%C_obj%pyVel_Len > 0) & - OutData%C_obj%pyVel = C_LOC( OutData%pyVel( i1_l ) ) - DO i1 = LBOUND(OutData%pyVel,1), UBOUND(OutData%pyVel,1) - OutData%pyVel(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pzVel not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%pzVel)) DEALLOCATE(OutData%pzVel) - ALLOCATE(OutData%pzVel(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%pzVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%pzVel_Len = SIZE(OutData%pzVel) - IF (OutData%C_obj%pzVel_Len > 0) & - OutData%C_obj%pzVel = C_LOC( OutData%pzVel( i1_l ) ) - DO i1 = LBOUND(OutData%pzVel,1), UBOUND(OutData%pzVel,1) - OutData%pzVel(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pxForce not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%pxForce)) DEALLOCATE(OutData%pxForce) - ALLOCATE(OutData%pxForce(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%pxForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%pxForce_Len = SIZE(OutData%pxForce) - IF (OutData%C_obj%pxForce_Len > 0) & - OutData%C_obj%pxForce = C_LOC( OutData%pxForce( i1_l ) ) - DO i1 = LBOUND(OutData%pxForce,1), UBOUND(OutData%pxForce,1) - OutData%pxForce(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pyForce not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%pyForce)) DEALLOCATE(OutData%pyForce) - ALLOCATE(OutData%pyForce(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%pyForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%pyForce_Len = SIZE(OutData%pyForce) - IF (OutData%C_obj%pyForce_Len > 0) & - OutData%C_obj%pyForce = C_LOC( OutData%pyForce( i1_l ) ) - DO i1 = LBOUND(OutData%pyForce,1), UBOUND(OutData%pyForce,1) - OutData%pyForce(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pzForce not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%pzForce)) DEALLOCATE(OutData%pzForce) - ALLOCATE(OutData%pzForce(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%pzForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%pzForce_Len = SIZE(OutData%pzForce) - IF (OutData%C_obj%pzForce_Len > 0) & - OutData%C_obj%pzForce = C_LOC( OutData%pzForce( i1_l ) ) - DO i1 = LBOUND(OutData%pzForce,1), UBOUND(OutData%pzForce,1) - OutData%pzForce(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xdotForce not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%xdotForce)) DEALLOCATE(OutData%xdotForce) - ALLOCATE(OutData%xdotForce(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xdotForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%xdotForce_Len = SIZE(OutData%xdotForce) - IF (OutData%C_obj%xdotForce_Len > 0) & - OutData%C_obj%xdotForce = C_LOC( OutData%xdotForce( i1_l ) ) - DO i1 = LBOUND(OutData%xdotForce,1), UBOUND(OutData%xdotForce,1) - OutData%xdotForce(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ydotForce not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%ydotForce)) DEALLOCATE(OutData%ydotForce) - ALLOCATE(OutData%ydotForce(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ydotForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%ydotForce_Len = SIZE(OutData%ydotForce) - IF (OutData%C_obj%ydotForce_Len > 0) & - OutData%C_obj%ydotForce = C_LOC( OutData%ydotForce( i1_l ) ) - DO i1 = LBOUND(OutData%ydotForce,1), UBOUND(OutData%ydotForce,1) - OutData%ydotForce(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! zdotForce not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%zdotForce)) DEALLOCATE(OutData%zdotForce) - ALLOCATE(OutData%zdotForce(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%zdotForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%zdotForce_Len = SIZE(OutData%zdotForce) - IF (OutData%C_obj%zdotForce_Len > 0) & - OutData%C_obj%zdotForce = C_LOC( OutData%zdotForce( i1_l ) ) - DO i1 = LBOUND(OutData%zdotForce,1), UBOUND(OutData%zdotForce,1) - OutData%zdotForce(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pOrientation not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%pOrientation)) DEALLOCATE(OutData%pOrientation) - ALLOCATE(OutData%pOrientation(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%pOrientation.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%pOrientation_Len = SIZE(OutData%pOrientation) - IF (OutData%C_obj%pOrientation_Len > 0) & - OutData%C_obj%pOrientation = C_LOC( OutData%pOrientation( i1_l ) ) - DO i1 = LBOUND(OutData%pOrientation,1), UBOUND(OutData%pOrientation,1) - OutData%pOrientation(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%fx)) DEALLOCATE(OutData%fx) - ALLOCATE(OutData%fx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%fx_Len = SIZE(OutData%fx) - IF (OutData%C_obj%fx_Len > 0) & - OutData%C_obj%fx = C_LOC( OutData%fx( i1_l ) ) - DO i1 = LBOUND(OutData%fx,1), UBOUND(OutData%fx,1) - OutData%fx(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fy not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%fy)) DEALLOCATE(OutData%fy) - ALLOCATE(OutData%fy(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%fy_Len = SIZE(OutData%fy) - IF (OutData%C_obj%fy_Len > 0) & - OutData%C_obj%fy = C_LOC( OutData%fy( i1_l ) ) - DO i1 = LBOUND(OutData%fy,1), UBOUND(OutData%fy,1) - OutData%fy(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fz not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%fz)) DEALLOCATE(OutData%fz) - ALLOCATE(OutData%fz(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%fz_Len = SIZE(OutData%fz) - IF (OutData%C_obj%fz_Len > 0) & - OutData%C_obj%fz = C_LOC( OutData%fz( i1_l ) ) - DO i1 = LBOUND(OutData%fz,1), UBOUND(OutData%fz,1) - OutData%fz(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! momentx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%momentx)) DEALLOCATE(OutData%momentx) - ALLOCATE(OutData%momentx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%momentx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%momentx_Len = SIZE(OutData%momentx) - IF (OutData%C_obj%momentx_Len > 0) & - OutData%C_obj%momentx = C_LOC( OutData%momentx( i1_l ) ) - DO i1 = LBOUND(OutData%momentx,1), UBOUND(OutData%momentx,1) - OutData%momentx(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! momenty not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%momenty)) DEALLOCATE(OutData%momenty) - ALLOCATE(OutData%momenty(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%momenty.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%momenty_Len = SIZE(OutData%momenty) - IF (OutData%C_obj%momenty_Len > 0) & - OutData%C_obj%momenty = C_LOC( OutData%momenty( i1_l ) ) - DO i1 = LBOUND(OutData%momenty,1), UBOUND(OutData%momenty,1) - OutData%momenty(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! momentz not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%momentz)) DEALLOCATE(OutData%momentz) - ALLOCATE(OutData%momentz(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%momentz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%momentz_Len = SIZE(OutData%momentz) - IF (OutData%C_obj%momentz_Len > 0) & - OutData%C_obj%momentz = C_LOC( OutData%momentz( i1_l ) ) - DO i1 = LBOUND(OutData%momentz,1), UBOUND(OutData%momentz,1) - OutData%momentz(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! forceNodesChord not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%forceNodesChord)) DEALLOCATE(OutData%forceNodesChord) - ALLOCATE(OutData%forceNodesChord(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%forceNodesChord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%forceNodesChord_Len = SIZE(OutData%forceNodesChord) - IF (OutData%C_obj%forceNodesChord_Len > 0) & - OutData%C_obj%forceNodesChord = C_LOC( OutData%forceNodesChord( i1_l ) ) - DO i1 = LBOUND(OutData%forceNodesChord,1), UBOUND(OutData%forceNodesChord,1) - OutData%forceNodesChord(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE OpFM_UnPackInput +subroutine OpFM_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(OpFM_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'OpFM_PackInput' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + ! pxVel + call RegPack(Buf, associated(InData%pxVel)) + if (associated(InData%pxVel)) then + call RegPackBounds(Buf, 1, lbound(InData%pxVel), ubound(InData%pxVel)) + call RegPackPointer(Buf, c_loc(InData%pxVel), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%pxVel) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! pyVel + call RegPack(Buf, associated(InData%pyVel)) + if (associated(InData%pyVel)) then + call RegPackBounds(Buf, 1, lbound(InData%pyVel), ubound(InData%pyVel)) + call RegPackPointer(Buf, c_loc(InData%pyVel), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%pyVel) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! pzVel + call RegPack(Buf, associated(InData%pzVel)) + if (associated(InData%pzVel)) then + call RegPackBounds(Buf, 1, lbound(InData%pzVel), ubound(InData%pzVel)) + call RegPackPointer(Buf, c_loc(InData%pzVel), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%pzVel) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! pxForce + call RegPack(Buf, associated(InData%pxForce)) + if (associated(InData%pxForce)) then + call RegPackBounds(Buf, 1, lbound(InData%pxForce), ubound(InData%pxForce)) + call RegPackPointer(Buf, c_loc(InData%pxForce), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%pxForce) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! pyForce + call RegPack(Buf, associated(InData%pyForce)) + if (associated(InData%pyForce)) then + call RegPackBounds(Buf, 1, lbound(InData%pyForce), ubound(InData%pyForce)) + call RegPackPointer(Buf, c_loc(InData%pyForce), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%pyForce) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! pzForce + call RegPack(Buf, associated(InData%pzForce)) + if (associated(InData%pzForce)) then + call RegPackBounds(Buf, 1, lbound(InData%pzForce), ubound(InData%pzForce)) + call RegPackPointer(Buf, c_loc(InData%pzForce), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%pzForce) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! xdotForce + call RegPack(Buf, associated(InData%xdotForce)) + if (associated(InData%xdotForce)) then + call RegPackBounds(Buf, 1, lbound(InData%xdotForce), ubound(InData%xdotForce)) + call RegPackPointer(Buf, c_loc(InData%xdotForce), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%xdotForce) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ydotForce + call RegPack(Buf, associated(InData%ydotForce)) + if (associated(InData%ydotForce)) then + call RegPackBounds(Buf, 1, lbound(InData%ydotForce), ubound(InData%ydotForce)) + call RegPackPointer(Buf, c_loc(InData%ydotForce), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%ydotForce) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! zdotForce + call RegPack(Buf, associated(InData%zdotForce)) + if (associated(InData%zdotForce)) then + call RegPackBounds(Buf, 1, lbound(InData%zdotForce), ubound(InData%zdotForce)) + call RegPackPointer(Buf, c_loc(InData%zdotForce), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%zdotForce) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! pOrientation + call RegPack(Buf, associated(InData%pOrientation)) + if (associated(InData%pOrientation)) then + call RegPackBounds(Buf, 1, lbound(InData%pOrientation), ubound(InData%pOrientation)) + call RegPackPointer(Buf, c_loc(InData%pOrientation), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%pOrientation) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! fx + call RegPack(Buf, associated(InData%fx)) + if (associated(InData%fx)) then + call RegPackBounds(Buf, 1, lbound(InData%fx), ubound(InData%fx)) + call RegPackPointer(Buf, c_loc(InData%fx), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%fx) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! fy + call RegPack(Buf, associated(InData%fy)) + if (associated(InData%fy)) then + call RegPackBounds(Buf, 1, lbound(InData%fy), ubound(InData%fy)) + call RegPackPointer(Buf, c_loc(InData%fy), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%fy) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! fz + call RegPack(Buf, associated(InData%fz)) + if (associated(InData%fz)) then + call RegPackBounds(Buf, 1, lbound(InData%fz), ubound(InData%fz)) + call RegPackPointer(Buf, c_loc(InData%fz), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%fz) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! momentx + call RegPack(Buf, associated(InData%momentx)) + if (associated(InData%momentx)) then + call RegPackBounds(Buf, 1, lbound(InData%momentx), ubound(InData%momentx)) + call RegPackPointer(Buf, c_loc(InData%momentx), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%momentx) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! momenty + call RegPack(Buf, associated(InData%momenty)) + if (associated(InData%momenty)) then + call RegPackBounds(Buf, 1, lbound(InData%momenty), ubound(InData%momenty)) + call RegPackPointer(Buf, c_loc(InData%momenty), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%momenty) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! momentz + call RegPack(Buf, associated(InData%momentz)) + if (associated(InData%momentz)) then + call RegPackBounds(Buf, 1, lbound(InData%momentz), ubound(InData%momentz)) + call RegPackPointer(Buf, c_loc(InData%momentz), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%momentz) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! forceNodesChord + call RegPack(Buf, associated(InData%forceNodesChord)) + if (associated(InData%forceNodesChord)) then + call RegPackBounds(Buf, 1, lbound(InData%forceNodesChord), ubound(InData%forceNodesChord)) + call RegPackPointer(Buf, c_loc(InData%forceNodesChord), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%forceNodesChord) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine OpFM_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(OpFM_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'OpFM_UnPackInput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + ! pxVel + if (associated(OutData%pxVel)) deallocate(OutData%pxVel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%pxVel, UB(1:1)-LB(1:1)) + OutData%pxVel(LB(1):) => OutData%pxVel + else + allocate(OutData%pxVel(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%pxVel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%pxVel) + OutData%C_obj%pxVel_Len = size(OutData%pxVel) + if (OutData%C_obj%pxVel_Len > 0) OutData%C_obj%pxVel = c_loc(OutData%pxVel(LB(1))) + call RegUnpack(Buf, OutData%pxVel) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%pxVel => null() + end if + ! pyVel + if (associated(OutData%pyVel)) deallocate(OutData%pyVel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%pyVel, UB(1:1)-LB(1:1)) + OutData%pyVel(LB(1):) => OutData%pyVel + else + allocate(OutData%pyVel(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%pyVel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%pyVel) + OutData%C_obj%pyVel_Len = size(OutData%pyVel) + if (OutData%C_obj%pyVel_Len > 0) OutData%C_obj%pyVel = c_loc(OutData%pyVel(LB(1))) + call RegUnpack(Buf, OutData%pyVel) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%pyVel => null() + end if + ! pzVel + if (associated(OutData%pzVel)) deallocate(OutData%pzVel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%pzVel, UB(1:1)-LB(1:1)) + OutData%pzVel(LB(1):) => OutData%pzVel + else + allocate(OutData%pzVel(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%pzVel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%pzVel) + OutData%C_obj%pzVel_Len = size(OutData%pzVel) + if (OutData%C_obj%pzVel_Len > 0) OutData%C_obj%pzVel = c_loc(OutData%pzVel(LB(1))) + call RegUnpack(Buf, OutData%pzVel) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%pzVel => null() + end if + ! pxForce + if (associated(OutData%pxForce)) deallocate(OutData%pxForce) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%pxForce, UB(1:1)-LB(1:1)) + OutData%pxForce(LB(1):) => OutData%pxForce + else + allocate(OutData%pxForce(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%pxForce.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%pxForce) + OutData%C_obj%pxForce_Len = size(OutData%pxForce) + if (OutData%C_obj%pxForce_Len > 0) OutData%C_obj%pxForce = c_loc(OutData%pxForce(LB(1))) + call RegUnpack(Buf, OutData%pxForce) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%pxForce => null() + end if + ! pyForce + if (associated(OutData%pyForce)) deallocate(OutData%pyForce) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%pyForce, UB(1:1)-LB(1:1)) + OutData%pyForce(LB(1):) => OutData%pyForce + else + allocate(OutData%pyForce(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%pyForce.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%pyForce) + OutData%C_obj%pyForce_Len = size(OutData%pyForce) + if (OutData%C_obj%pyForce_Len > 0) OutData%C_obj%pyForce = c_loc(OutData%pyForce(LB(1))) + call RegUnpack(Buf, OutData%pyForce) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%pyForce => null() + end if + ! pzForce + if (associated(OutData%pzForce)) deallocate(OutData%pzForce) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%pzForce, UB(1:1)-LB(1:1)) + OutData%pzForce(LB(1):) => OutData%pzForce + else + allocate(OutData%pzForce(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%pzForce.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%pzForce) + OutData%C_obj%pzForce_Len = size(OutData%pzForce) + if (OutData%C_obj%pzForce_Len > 0) OutData%C_obj%pzForce = c_loc(OutData%pzForce(LB(1))) + call RegUnpack(Buf, OutData%pzForce) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%pzForce => null() + end if + ! xdotForce + if (associated(OutData%xdotForce)) deallocate(OutData%xdotForce) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%xdotForce, UB(1:1)-LB(1:1)) + OutData%xdotForce(LB(1):) => OutData%xdotForce + else + allocate(OutData%xdotForce(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xdotForce.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%xdotForce) + OutData%C_obj%xdotForce_Len = size(OutData%xdotForce) + if (OutData%C_obj%xdotForce_Len > 0) OutData%C_obj%xdotForce = c_loc(OutData%xdotForce(LB(1))) + call RegUnpack(Buf, OutData%xdotForce) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%xdotForce => null() + end if + ! ydotForce + if (associated(OutData%ydotForce)) deallocate(OutData%ydotForce) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%ydotForce, UB(1:1)-LB(1:1)) + OutData%ydotForce(LB(1):) => OutData%ydotForce + else + allocate(OutData%ydotForce(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ydotForce.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%ydotForce) + OutData%C_obj%ydotForce_Len = size(OutData%ydotForce) + if (OutData%C_obj%ydotForce_Len > 0) OutData%C_obj%ydotForce = c_loc(OutData%ydotForce(LB(1))) + call RegUnpack(Buf, OutData%ydotForce) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%ydotForce => null() + end if + ! zdotForce + if (associated(OutData%zdotForce)) deallocate(OutData%zdotForce) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%zdotForce, UB(1:1)-LB(1:1)) + OutData%zdotForce(LB(1):) => OutData%zdotForce + else + allocate(OutData%zdotForce(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%zdotForce.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%zdotForce) + OutData%C_obj%zdotForce_Len = size(OutData%zdotForce) + if (OutData%C_obj%zdotForce_Len > 0) OutData%C_obj%zdotForce = c_loc(OutData%zdotForce(LB(1))) + call RegUnpack(Buf, OutData%zdotForce) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%zdotForce => null() + end if + ! pOrientation + if (associated(OutData%pOrientation)) deallocate(OutData%pOrientation) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%pOrientation, UB(1:1)-LB(1:1)) + OutData%pOrientation(LB(1):) => OutData%pOrientation + else + allocate(OutData%pOrientation(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%pOrientation.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%pOrientation) + OutData%C_obj%pOrientation_Len = size(OutData%pOrientation) + if (OutData%C_obj%pOrientation_Len > 0) OutData%C_obj%pOrientation = c_loc(OutData%pOrientation(LB(1))) + call RegUnpack(Buf, OutData%pOrientation) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%pOrientation => null() + end if + ! fx + if (associated(OutData%fx)) deallocate(OutData%fx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%fx, UB(1:1)-LB(1:1)) + OutData%fx(LB(1):) => OutData%fx + else + allocate(OutData%fx(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%fx) + OutData%C_obj%fx_Len = size(OutData%fx) + if (OutData%C_obj%fx_Len > 0) OutData%C_obj%fx = c_loc(OutData%fx(LB(1))) + call RegUnpack(Buf, OutData%fx) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%fx => null() + end if + ! fy + if (associated(OutData%fy)) deallocate(OutData%fy) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%fy, UB(1:1)-LB(1:1)) + OutData%fy(LB(1):) => OutData%fy + else + allocate(OutData%fy(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fy.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%fy) + OutData%C_obj%fy_Len = size(OutData%fy) + if (OutData%C_obj%fy_Len > 0) OutData%C_obj%fy = c_loc(OutData%fy(LB(1))) + call RegUnpack(Buf, OutData%fy) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%fy => null() + end if + ! fz + if (associated(OutData%fz)) deallocate(OutData%fz) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%fz, UB(1:1)-LB(1:1)) + OutData%fz(LB(1):) => OutData%fz + else + allocate(OutData%fz(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%fz) + OutData%C_obj%fz_Len = size(OutData%fz) + if (OutData%C_obj%fz_Len > 0) OutData%C_obj%fz = c_loc(OutData%fz(LB(1))) + call RegUnpack(Buf, OutData%fz) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%fz => null() + end if + ! momentx + if (associated(OutData%momentx)) deallocate(OutData%momentx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%momentx, UB(1:1)-LB(1:1)) + OutData%momentx(LB(1):) => OutData%momentx + else + allocate(OutData%momentx(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%momentx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%momentx) + OutData%C_obj%momentx_Len = size(OutData%momentx) + if (OutData%C_obj%momentx_Len > 0) OutData%C_obj%momentx = c_loc(OutData%momentx(LB(1))) + call RegUnpack(Buf, OutData%momentx) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%momentx => null() + end if + ! momenty + if (associated(OutData%momenty)) deallocate(OutData%momenty) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%momenty, UB(1:1)-LB(1:1)) + OutData%momenty(LB(1):) => OutData%momenty + else + allocate(OutData%momenty(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%momenty.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%momenty) + OutData%C_obj%momenty_Len = size(OutData%momenty) + if (OutData%C_obj%momenty_Len > 0) OutData%C_obj%momenty = c_loc(OutData%momenty(LB(1))) + call RegUnpack(Buf, OutData%momenty) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%momenty => null() + end if + ! momentz + if (associated(OutData%momentz)) deallocate(OutData%momentz) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%momentz, UB(1:1)-LB(1:1)) + OutData%momentz(LB(1):) => OutData%momentz + else + allocate(OutData%momentz(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%momentz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%momentz) + OutData%C_obj%momentz_Len = size(OutData%momentz) + if (OutData%C_obj%momentz_Len > 0) OutData%C_obj%momentz = c_loc(OutData%momentz(LB(1))) + call RegUnpack(Buf, OutData%momentz) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%momentz => null() + end if + ! forceNodesChord + if (associated(OutData%forceNodesChord)) deallocate(OutData%forceNodesChord) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%forceNodesChord, UB(1:1)-LB(1:1)) + OutData%forceNodesChord(LB(1):) => OutData%forceNodesChord + else + allocate(OutData%forceNodesChord(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%forceNodesChord.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%forceNodesChord) + OutData%C_obj%forceNodesChord_Len = size(OutData%forceNodesChord) + if (OutData%C_obj%forceNodesChord_Len > 0) OutData%C_obj%forceNodesChord = c_loc(OutData%forceNodesChord(LB(1))) + call RegUnpack(Buf, OutData%forceNodesChord) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%forceNodesChord => null() + end if +end subroutine SUBROUTINE OpFM_C2Fary_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) TYPE(OpFM_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat @@ -3808,262 +2889,163 @@ SUBROUTINE OpFM_DestroyOutput( OutputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE OpFM_DestroyOutput - SUBROUTINE OpFM_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(OpFM_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! u allocated yes/no - IF ( ASSOCIATED(InData%u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%u) ! u - END IF - Int_BufSz = Int_BufSz + 1 ! v allocated yes/no - IF ( ASSOCIATED(InData%v) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! v upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%v) ! v - END IF - Int_BufSz = Int_BufSz + 1 ! w allocated yes/no - IF ( ASSOCIATED(InData%w) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! w upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%w) ! w - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutput allocated yes/no - IF ( ALLOCATED(InData%WriteOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutput upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WriteOutput) ! WriteOutput - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ASSOCIATED(InData%u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u,1), UBOUND(InData%u,1) - ReKiBuf(Re_Xferred) = InData%u(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%v) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%v,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%v,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%v,1), UBOUND(InData%v,1) - ReKiBuf(Re_Xferred) = InData%v(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%w) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%w,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%w,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%w,1), UBOUND(InData%w,1) - ReKiBuf(Re_Xferred) = InData%w(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) - ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE OpFM_PackOutput - - SUBROUTINE OpFM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(OpFM_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%u)) DEALLOCATE(OutData%u) - ALLOCATE(OutData%u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%u_Len = SIZE(OutData%u) - IF (OutData%C_obj%u_Len > 0) & - OutData%C_obj%u = C_LOC( OutData%u( i1_l ) ) - DO i1 = LBOUND(OutData%u,1), UBOUND(OutData%u,1) - OutData%u(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! v not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%v)) DEALLOCATE(OutData%v) - ALLOCATE(OutData%v(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%v.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%v_Len = SIZE(OutData%v) - IF (OutData%C_obj%v_Len > 0) & - OutData%C_obj%v = C_LOC( OutData%v( i1_l ) ) - DO i1 = LBOUND(OutData%v,1), UBOUND(OutData%v,1) - OutData%v(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! w not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%w)) DEALLOCATE(OutData%w) - ALLOCATE(OutData%w(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%w.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%w_Len = SIZE(OutData%w) - IF (OutData%C_obj%w_Len > 0) & - OutData%C_obj%w = C_LOC( OutData%w( i1_l ) ) - DO i1 = LBOUND(OutData%w,1), UBOUND(OutData%w,1) - OutData%w(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutput)) DEALLOCATE(OutData%WriteOutput) - ALLOCATE(OutData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) - OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE OpFM_UnPackOutput +subroutine OpFM_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(OpFM_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'OpFM_PackOutput' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + ! u + call RegPack(Buf, associated(InData%u)) + if (associated(InData%u)) then + call RegPackBounds(Buf, 1, lbound(InData%u), ubound(InData%u)) + call RegPackPointer(Buf, c_loc(InData%u), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%u) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! v + call RegPack(Buf, associated(InData%v)) + if (associated(InData%v)) then + call RegPackBounds(Buf, 1, lbound(InData%v), ubound(InData%v)) + call RegPackPointer(Buf, c_loc(InData%v), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%v) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! w + call RegPack(Buf, associated(InData%w)) + if (associated(InData%w)) then + call RegPackBounds(Buf, 1, lbound(InData%w), ubound(InData%w)) + call RegPackPointer(Buf, c_loc(InData%w), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%w) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutput + call RegPack(Buf, allocated(InData%WriteOutput)) + if (allocated(InData%WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPack(Buf, InData%WriteOutput) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine OpFM_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(OpFM_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'OpFM_UnPackOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + ! u + if (associated(OutData%u)) deallocate(OutData%u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%u, UB(1:1)-LB(1:1)) + OutData%u(LB(1):) => OutData%u + else + allocate(OutData%u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%u) + OutData%C_obj%u_Len = size(OutData%u) + if (OutData%C_obj%u_Len > 0) OutData%C_obj%u = c_loc(OutData%u(LB(1))) + call RegUnpack(Buf, OutData%u) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%u => null() + end if + ! v + if (associated(OutData%v)) deallocate(OutData%v) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%v, UB(1:1)-LB(1:1)) + OutData%v(LB(1):) => OutData%v + else + allocate(OutData%v(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%v.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%v) + OutData%C_obj%v_Len = size(OutData%v) + if (OutData%C_obj%v_Len > 0) OutData%C_obj%v = c_loc(OutData%v(LB(1))) + call RegUnpack(Buf, OutData%v) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%v => null() + end if + ! w + if (associated(OutData%w)) deallocate(OutData%w) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%w, UB(1:1)-LB(1:1)) + OutData%w(LB(1):) => OutData%w + else + allocate(OutData%w(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%w.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%w) + OutData%C_obj%w_Len = size(OutData%w) + if (OutData%C_obj%w_Len > 0) OutData%C_obj%w = c_loc(OutData%w(LB(1))) + call RegUnpack(Buf, OutData%w) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%w => null() + end if + ! WriteOutput + if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE OpFM_C2Fary_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) TYPE(OpFM_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat diff --git a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 index 17ffff59f8..14be89415b 100644 --- a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 +++ b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 @@ -141,121 +141,38 @@ SUBROUTINE Orca_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) END SUBROUTINE Orca_DestroyInitInput - SUBROUTINE Orca_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Orca_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%InputFile) ! InputFile - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Re_BufSz = Re_BufSz + 1 ! TMax - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf(Re_Xferred) = InData%TMax - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Orca_PackInitInput - - SUBROUTINE Orca_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Orca_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%TMax = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Orca_UnPackInitInput +subroutine Orca_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Orca_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Orca_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + ! InputFile + call RegPack(Buf, InData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegPack(Buf, InData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! TMax + call RegPack(Buf, InData%TMax) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Orca_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Orca_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Orca_UnPackInitInput' + if (Buf%ErrStat /= ErrID_None) return + ! InputFile + call RegUnpack(Buf, OutData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! TMax + call RegUnpack(Buf, OutData%TMax) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE Orca_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(Orca_InitOutputType), INTENT(IN) :: SrcInitOutputData TYPE(Orca_InitOutputType), INTENT(INOUT) :: DstInitOutputData @@ -323,269 +240,72 @@ SUBROUTINE Orca_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE Orca_DestroyInitOutput - SUBROUTINE Orca_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Orca_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputHdr allocated yes/no - IF ( ALLOCATED(InData%WriteOutputHdr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdr upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdr)*LEN(InData%WriteOutputHdr) ! WriteOutputHdr - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputUnt allocated yes/no - IF ( ALLOCATED(InData%WriteOutputUnt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUnt upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUnt)*LEN(InData%WriteOutputUnt) ! WriteOutputUnt - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%WriteOutputHdr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) - DO I = 1, LEN(InData%WriteOutputHdr) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputUnt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) - DO I = 1, LEN(InData%WriteOutputUnt) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - END SUBROUTINE Orca_PackInitOutput - - SUBROUTINE Orca_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Orca_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputHdr)) DEALLOCATE(OutData%WriteOutputHdr) - ALLOCATE(OutData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) - DO I = 1, LEN(OutData%WriteOutputHdr) - OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputUnt)) DEALLOCATE(OutData%WriteOutputUnt) - ALLOCATE(OutData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) - DO I = 1, LEN(OutData%WriteOutputUnt) - OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - END SUBROUTINE Orca_UnPackInitOutput +subroutine Orca_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Orca_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Orca_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! Ver + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutputHdr + call RegPack(Buf, allocated(InData%WriteOutputHdr)) + if (allocated(InData%WriteOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPack(Buf, InData%WriteOutputHdr) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutputUnt + call RegPack(Buf, allocated(InData%WriteOutputUnt)) + if (allocated(InData%WriteOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPack(Buf, InData%WriteOutputUnt) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Orca_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Orca_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Orca_UnPackInitOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! Ver + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + ! WriteOutputHdr + if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WriteOutputUnt + if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE Orca_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) TYPE(Orca_InputFile), INTENT(IN) :: SrcInputFileData TYPE(Orca_InputFile), INTENT(INOUT) :: DstInputFileData @@ -622,143 +342,50 @@ SUBROUTINE Orca_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) END SUBROUTINE Orca_DestroyInputFile - SUBROUTINE Orca_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Orca_InputFile), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_PackInputFile' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%DLL_FileName) ! DLL_FileName - Int_BufSz = Int_BufSz + 1*LEN(InData%DLL_InitProcName) ! DLL_InitProcName - Int_BufSz = Int_BufSz + 1*LEN(InData%DLL_CalcProcName) ! DLL_CalcProcName - Int_BufSz = Int_BufSz + 1*LEN(InData%DLL_EndProcName) ! DLL_EndProcName - Int_BufSz = Int_BufSz + 1*LEN(InData%DirRoot) ! DirRoot - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%DLL_FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%DLL_InitProcName) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_InitProcName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%DLL_CalcProcName) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_CalcProcName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%DLL_EndProcName) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_EndProcName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%DirRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%DirRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE Orca_PackInputFile - - SUBROUTINE Orca_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Orca_InputFile), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_UnPackInputFile' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%DLL_FileName) - OutData%DLL_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%DLL_InitProcName) - OutData%DLL_InitProcName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%DLL_CalcProcName) - OutData%DLL_CalcProcName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%DLL_EndProcName) - OutData%DLL_EndProcName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%DirRoot) - OutData%DirRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE Orca_UnPackInputFile +subroutine Orca_PackInputFile(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Orca_InputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'Orca_PackInputFile' + if (Buf%ErrStat >= AbortErrLev) return + ! DLL_FileName + call RegPack(Buf, InData%DLL_FileName) + if (RegCheckErr(Buf, RoutineName)) return + ! DLL_InitProcName + call RegPack(Buf, InData%DLL_InitProcName) + if (RegCheckErr(Buf, RoutineName)) return + ! DLL_CalcProcName + call RegPack(Buf, InData%DLL_CalcProcName) + if (RegCheckErr(Buf, RoutineName)) return + ! DLL_EndProcName + call RegPack(Buf, InData%DLL_EndProcName) + if (RegCheckErr(Buf, RoutineName)) return + ! DirRoot + call RegPack(Buf, InData%DirRoot) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Orca_UnPackInputFile(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Orca_InputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Orca_UnPackInputFile' + if (Buf%ErrStat /= ErrID_None) return + ! DLL_FileName + call RegUnpack(Buf, OutData%DLL_FileName) + if (RegCheckErr(Buf, RoutineName)) return + ! DLL_InitProcName + call RegUnpack(Buf, OutData%DLL_InitProcName) + if (RegCheckErr(Buf, RoutineName)) return + ! DLL_CalcProcName + call RegUnpack(Buf, OutData%DLL_CalcProcName) + if (RegCheckErr(Buf, RoutineName)) return + ! DLL_EndProcName + call RegUnpack(Buf, OutData%DLL_EndProcName) + if (RegCheckErr(Buf, RoutineName)) return + ! DirRoot + call RegUnpack(Buf, OutData%DirRoot) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE Orca_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(Orca_OtherStateType), INTENT(IN) :: SrcOtherStateData TYPE(Orca_OtherStateType), INTENT(INOUT) :: DstOtherStateData @@ -791,103 +418,26 @@ SUBROUTINE Orca_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) END SUBROUTINE Orca_DestroyOtherState - SUBROUTINE Orca_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Orca_OtherStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_PackOtherState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyOtherState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyOtherState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Orca_PackOtherState - - SUBROUTINE Orca_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Orca_OtherStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_UnPackOtherState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyOtherState = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Orca_UnPackOtherState +subroutine Orca_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Orca_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Orca_PackOtherState' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyOtherState + call RegPack(Buf, InData%DummyOtherState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Orca_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Orca_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Orca_UnPackOtherState' + if (Buf%ErrStat /= ErrID_None) return + ! DummyOtherState + call RegUnpack(Buf, OutData%DummyOtherState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE Orca_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) TYPE(Orca_MiscVarType), INTENT(IN) :: SrcMiscData TYPE(Orca_MiscVarType), INTENT(INOUT) :: DstMiscData @@ -940,182 +490,69 @@ SUBROUTINE Orca_DestroyMisc( MiscData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE Orca_DestroyMisc - SUBROUTINE Orca_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Orca_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + SIZE(InData%PtfmAM) ! PtfmAM - Re_BufSz = Re_BufSz + SIZE(InData%PtfmFt) ! PtfmFt - Re_BufSz = Re_BufSz + SIZE(InData%F_PtfmAM) ! F_PtfmAM - Int_BufSz = Int_BufSz + 1 ! AllOuts allocated yes/no - IF ( ALLOCATED(InData%AllOuts) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AllOuts upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AllOuts) ! AllOuts - END IF - Db_BufSz = Db_BufSz + 1 ! LastTimeStep - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i2 = LBOUND(InData%PtfmAM,2), UBOUND(InData%PtfmAM,2) - DO i1 = LBOUND(InData%PtfmAM,1), UBOUND(InData%PtfmAM,1) - ReKiBuf(Re_Xferred) = InData%PtfmAM(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - DO i1 = LBOUND(InData%PtfmFt,1), UBOUND(InData%PtfmFt,1) - ReKiBuf(Re_Xferred) = InData%PtfmFt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%F_PtfmAM,1), UBOUND(InData%F_PtfmAM,1) - ReKiBuf(Re_Xferred) = InData%F_PtfmAM(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%AllOuts) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AllOuts,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOuts,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AllOuts,1), UBOUND(InData%AllOuts,1) - ReKiBuf(Re_Xferred) = InData%AllOuts(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DbKiBuf(Db_Xferred) = InData%LastTimeStep - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE Orca_PackMisc - - SUBROUTINE Orca_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Orca_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%PtfmAM,1) - i1_u = UBOUND(OutData%PtfmAM,1) - i2_l = LBOUND(OutData%PtfmAM,2) - i2_u = UBOUND(OutData%PtfmAM,2) - DO i2 = LBOUND(OutData%PtfmAM,2), UBOUND(OutData%PtfmAM,2) - DO i1 = LBOUND(OutData%PtfmAM,1), UBOUND(OutData%PtfmAM,1) - OutData%PtfmAM(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%PtfmFt,1) - i1_u = UBOUND(OutData%PtfmFt,1) - DO i1 = LBOUND(OutData%PtfmFt,1), UBOUND(OutData%PtfmFt,1) - OutData%PtfmFt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%F_PtfmAM,1) - i1_u = UBOUND(OutData%F_PtfmAM,1) - DO i1 = LBOUND(OutData%F_PtfmAM,1), UBOUND(OutData%F_PtfmAM,1) - OutData%F_PtfmAM(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AllOuts not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AllOuts)) DEALLOCATE(OutData%AllOuts) - ALLOCATE(OutData%AllOuts(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AllOuts,1), UBOUND(OutData%AllOuts,1) - OutData%AllOuts(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%LastTimeStep = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE Orca_UnPackMisc +subroutine Orca_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Orca_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Orca_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + ! PtfmAM + call RegPack(Buf, InData%PtfmAM) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmFt + call RegPack(Buf, InData%PtfmFt) + if (RegCheckErr(Buf, RoutineName)) return + ! F_PtfmAM + call RegPack(Buf, InData%F_PtfmAM) + if (RegCheckErr(Buf, RoutineName)) return + ! AllOuts + call RegPack(Buf, allocated(InData%AllOuts)) + if (allocated(InData%AllOuts)) then + call RegPackBounds(Buf, 1, lbound(InData%AllOuts), ubound(InData%AllOuts)) + call RegPack(Buf, InData%AllOuts) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LastTimeStep + call RegPack(Buf, InData%LastTimeStep) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Orca_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Orca_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Orca_UnPackMisc' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! PtfmAM + call RegUnpack(Buf, OutData%PtfmAM) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmFt + call RegUnpack(Buf, OutData%PtfmFt) + if (RegCheckErr(Buf, RoutineName)) return + ! F_PtfmAM + call RegUnpack(Buf, OutData%F_PtfmAM) + if (RegCheckErr(Buf, RoutineName)) return + ! AllOuts + if (allocated(OutData%AllOuts)) deallocate(OutData%AllOuts) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AllOuts(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AllOuts) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LastTimeStep + call RegUnpack(Buf, OutData%LastTimeStep) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE Orca_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(Orca_ParameterType), INTENT(IN) :: SrcParamData TYPE(Orca_ParameterType), INTENT(INOUT) :: DstParamData @@ -1178,329 +615,82 @@ SUBROUTINE Orca_DestroyParam( ParamData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE Orca_DestroyParam - SUBROUTINE Orca_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Orca_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! DT - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! DLL_Orca: size of buffers for each call to pack subtype - CALL DLLTypePack( InData%DLL_Orca, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! DLL_Orca - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DLL_Orca - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DLL_Orca - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DLL_Orca - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%SimNamePath) ! SimNamePath - Int_BufSz = Int_BufSz + 1 ! SimNamePathLen - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! OutParam allocated yes/no - IF ( ALLOCATED(InData%OutParam) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutParam upper/lower bounds for each dimension - DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - Int_BufSz = Int_BufSz + 3 ! OutParam: size of buffers for each call to pack subtype - CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutParam - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutParam - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutParam - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - CALL DLLTypePack( InData%DLL_Orca, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! DLL_Orca - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - DO I = 1, LEN(InData%SimNamePath) - IntKiBuf(Int_Xferred) = ICHAR(InData%SimNamePath(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%SimNamePathLen - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutParam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParam,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - END SUBROUTINE Orca_PackParam - - SUBROUTINE Orca_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Orca_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL DLLTypeUnpack( OutData%DLL_Orca, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! DLL_Orca - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - DO I = 1, LEN(OutData%SimNamePath) - OutData%SimNamePath(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%SimNamePathLen = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutParam)) DEALLOCATE(OutData%OutParam) - ALLOCATE(OutData%OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutParam,1), UBOUND(OutData%OutParam,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackOutParmType( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - END SUBROUTINE Orca_UnPackParam +subroutine Orca_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Orca_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Orca_PackParam' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! DT + call RegPack(Buf, InData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! DLL_Orca + call DLLTypePack(Buf, InData%DLL_Orca) + if (RegCheckErr(Buf, RoutineName)) return + ! SimNamePath + call RegPack(Buf, InData%SimNamePath) + if (RegCheckErr(Buf, RoutineName)) return + ! SimNamePathLen + call RegPack(Buf, InData%SimNamePathLen) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegPack(Buf, InData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! OutParam + call RegPack(Buf, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Orca_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Orca_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Orca_UnPackParam' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! DT + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! DLL_Orca + call DLLTypeUnpack(Buf, OutData%DLL_Orca) ! DLL_Orca + ! SimNamePath + call RegUnpack(Buf, OutData%SimNamePath) + if (RegCheckErr(Buf, RoutineName)) return + ! SimNamePathLen + call RegUnpack(Buf, OutData%SimNamePathLen) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! OutParam + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam + end do + end if +end subroutine SUBROUTINE Orca_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(Orca_InputType), INTENT(INOUT) :: SrcInputData TYPE(Orca_InputType), INTENT(INOUT) :: DstInputData @@ -1537,184 +727,25 @@ SUBROUTINE Orca_DestroyInput( InputData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE Orca_DestroyInput - SUBROUTINE Orca_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Orca_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! PtfmMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PtfmMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PtfmMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PtfmMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PtfmMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL MeshPack( InData%PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PtfmMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE Orca_PackInput - - SUBROUTINE Orca_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Orca_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PtfmMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE Orca_UnPackInput +subroutine Orca_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Orca_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Orca_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + ! PtfmMesh + call MeshPack(Buf, InData%PtfmMesh) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Orca_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Orca_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Orca_UnPackInput' + if (Buf%ErrStat /= ErrID_None) return + ! PtfmMesh + call MeshUnpack(Buf, OutData%PtfmMesh) ! PtfmMesh +end subroutine SUBROUTINE Orca_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(Orca_OutputType), INTENT(INOUT) :: SrcOutputData TYPE(Orca_OutputType), INTENT(INOUT) :: DstOutputData @@ -1767,223 +798,50 @@ SUBROUTINE Orca_DestroyOutput( OutputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE Orca_DestroyOutput - SUBROUTINE Orca_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Orca_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! PtfmMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PtfmMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PtfmMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PtfmMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PtfmMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutput allocated yes/no - IF ( ALLOCATED(InData%WriteOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutput upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WriteOutput) ! WriteOutput - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL MeshPack( InData%PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PtfmMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) - ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE Orca_PackOutput - - SUBROUTINE Orca_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Orca_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PtfmMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutput)) DEALLOCATE(OutData%WriteOutput) - ALLOCATE(OutData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) - OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE Orca_UnPackOutput +subroutine Orca_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Orca_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Orca_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! PtfmMesh + call MeshPack(Buf, InData%PtfmMesh) + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutput + call RegPack(Buf, allocated(InData%WriteOutput)) + if (allocated(InData%WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPack(Buf, InData%WriteOutput) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Orca_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Orca_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Orca_UnPackOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! PtfmMesh + call MeshUnpack(Buf, OutData%PtfmMesh) ! PtfmMesh + ! WriteOutput + if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE Orca_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(Orca_ContinuousStateType), INTENT(IN) :: SrcContStateData TYPE(Orca_ContinuousStateType), INTENT(INOUT) :: DstContStateData @@ -2016,103 +874,26 @@ SUBROUTINE Orca_DestroyContState( ContStateData, ErrStat, ErrMsg ) END SUBROUTINE Orca_DestroyContState - SUBROUTINE Orca_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Orca_ContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_PackContState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! Dummy - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%Dummy - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Orca_PackContState - - SUBROUTINE Orca_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Orca_ContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_UnPackContState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%Dummy = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Orca_UnPackContState +subroutine Orca_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Orca_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Orca_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + ! Dummy + call RegPack(Buf, InData%Dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Orca_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Orca_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Orca_UnPackContState' + if (Buf%ErrStat /= ErrID_None) return + ! Dummy + call RegUnpack(Buf, OutData%Dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE Orca_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(Orca_DiscreteStateType), INTENT(IN) :: SrcDiscStateData TYPE(Orca_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData @@ -2145,103 +926,26 @@ SUBROUTINE Orca_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) END SUBROUTINE Orca_DestroyDiscState - SUBROUTINE Orca_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Orca_DiscreteStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_PackDiscState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! Dummy - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%Dummy - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Orca_PackDiscState - - SUBROUTINE Orca_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Orca_DiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_UnPackDiscState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%Dummy = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Orca_UnPackDiscState +subroutine Orca_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Orca_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Orca_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + ! Dummy + call RegPack(Buf, InData%Dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Orca_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Orca_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Orca_UnPackDiscState' + if (Buf%ErrStat /= ErrID_None) return + ! Dummy + call RegUnpack(Buf, OutData%Dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE Orca_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(Orca_ConstraintStateType), INTENT(IN) :: SrcConstrStateData TYPE(Orca_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData @@ -2274,103 +978,26 @@ SUBROUTINE Orca_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) END SUBROUTINE Orca_DestroyConstrState - SUBROUTINE Orca_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Orca_ConstraintStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_PackConstrState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyConstrState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Orca_PackConstrState - - SUBROUTINE Orca_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Orca_ConstraintStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_UnPackConstrState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyConstrState = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Orca_UnPackConstrState +subroutine Orca_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Orca_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Orca_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyConstrState + call RegPack(Buf, InData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Orca_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Orca_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Orca_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + ! DummyConstrState + call RegUnpack(Buf, OutData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE Orca_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) ! diff --git a/modules/seastate/src/Current_Types.f90 b/modules/seastate/src/Current_Types.f90 index 060b993dfc..3fcbe4cefa 100644 --- a/modules/seastate/src/Current_Types.f90 +++ b/modules/seastate/src/Current_Types.f90 @@ -118,205 +118,117 @@ SUBROUTINE Current_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE Current_DestroyInitInput - SUBROUTINE Current_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Current_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! CurrSSV0 - Int_BufSz = Int_BufSz + 1*LEN(InData%CurrSSDirChr) ! CurrSSDirChr - Re_BufSz = Re_BufSz + 1 ! CurrSSDir - Re_BufSz = Re_BufSz + 1 ! CurrNSRef - Re_BufSz = Re_BufSz + 1 ! CurrNSV0 - Re_BufSz = Re_BufSz + 1 ! CurrNSDir - Re_BufSz = Re_BufSz + 1 ! CurrDIV - Re_BufSz = Re_BufSz + 1 ! CurrDIDir - Int_BufSz = Int_BufSz + 1 ! CurrMod - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Int_BufSz = Int_BufSz + 1 ! WaveKinGridzi allocated yes/no - IF ( ALLOCATED(InData%WaveKinGridzi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveKinGridzi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveKinGridzi) ! WaveKinGridzi - END IF - Int_BufSz = Int_BufSz + 1 ! NGridPts - Int_BufSz = Int_BufSz + 1*LEN(InData%DirRoot) ! DirRoot - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%CurrSSV0 - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%CurrSSDirChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%CurrSSDirChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf(Re_Xferred) = InData%CurrSSDir - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CurrNSRef - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CurrNSV0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CurrNSDir - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CurrDIV - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CurrDIDir - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%CurrMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveKinGridzi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveKinGridzi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinGridzi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveKinGridzi,1), UBOUND(InData%WaveKinGridzi,1) - ReKiBuf(Re_Xferred) = InData%WaveKinGridzi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NGridPts - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%DirRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%DirRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE Current_PackInitInput - - SUBROUTINE Current_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Current_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%CurrSSV0 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%CurrSSDirChr) - OutData%CurrSSDirChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%CurrSSDir = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%CurrNSRef = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%CurrNSV0 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%CurrNSDir = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%CurrDIV = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%CurrDIDir = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%CurrMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WtrDpth = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinGridzi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveKinGridzi)) DEALLOCATE(OutData%WaveKinGridzi) - ALLOCATE(OutData%WaveKinGridzi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinGridzi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveKinGridzi,1), UBOUND(OutData%WaveKinGridzi,1) - OutData%WaveKinGridzi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%NGridPts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%DirRoot) - OutData%DirRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE Current_UnPackInitInput +subroutine Current_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Current_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Current_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + ! CurrSSV0 + call RegPack(Buf, InData%CurrSSV0) + if (RegCheckErr(Buf, RoutineName)) return + ! CurrSSDirChr + call RegPack(Buf, InData%CurrSSDirChr) + if (RegCheckErr(Buf, RoutineName)) return + ! CurrSSDir + call RegPack(Buf, InData%CurrSSDir) + if (RegCheckErr(Buf, RoutineName)) return + ! CurrNSRef + call RegPack(Buf, InData%CurrNSRef) + if (RegCheckErr(Buf, RoutineName)) return + ! CurrNSV0 + call RegPack(Buf, InData%CurrNSV0) + if (RegCheckErr(Buf, RoutineName)) return + ! CurrNSDir + call RegPack(Buf, InData%CurrNSDir) + if (RegCheckErr(Buf, RoutineName)) return + ! CurrDIV + call RegPack(Buf, InData%CurrDIV) + if (RegCheckErr(Buf, RoutineName)) return + ! CurrDIDir + call RegPack(Buf, InData%CurrDIDir) + if (RegCheckErr(Buf, RoutineName)) return + ! CurrMod + call RegPack(Buf, InData%CurrMod) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDpth + call RegPack(Buf, InData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveKinGridzi + call RegPack(Buf, allocated(InData%WaveKinGridzi)) + if (allocated(InData%WaveKinGridzi)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridzi), ubound(InData%WaveKinGridzi)) + call RegPack(Buf, InData%WaveKinGridzi) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NGridPts + call RegPack(Buf, InData%NGridPts) + if (RegCheckErr(Buf, RoutineName)) return + ! DirRoot + call RegPack(Buf, InData%DirRoot) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine +subroutine Current_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Current_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Current_UnPackInitInput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! CurrSSV0 + call RegUnpack(Buf, OutData%CurrSSV0) + if (RegCheckErr(Buf, RoutineName)) return + ! CurrSSDirChr + call RegUnpack(Buf, OutData%CurrSSDirChr) + if (RegCheckErr(Buf, RoutineName)) return + ! CurrSSDir + call RegUnpack(Buf, OutData%CurrSSDir) + if (RegCheckErr(Buf, RoutineName)) return + ! CurrNSRef + call RegUnpack(Buf, OutData%CurrNSRef) + if (RegCheckErr(Buf, RoutineName)) return + ! CurrNSV0 + call RegUnpack(Buf, OutData%CurrNSV0) + if (RegCheckErr(Buf, RoutineName)) return + ! CurrNSDir + call RegUnpack(Buf, OutData%CurrNSDir) + if (RegCheckErr(Buf, RoutineName)) return + ! CurrDIV + call RegUnpack(Buf, OutData%CurrDIV) + if (RegCheckErr(Buf, RoutineName)) return + ! CurrDIDir + call RegUnpack(Buf, OutData%CurrDIDir) + if (RegCheckErr(Buf, RoutineName)) return + ! CurrMod + call RegUnpack(Buf, OutData%CurrMod) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDpth + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveKinGridzi + if (allocated(OutData%WaveKinGridzi)) deallocate(OutData%WaveKinGridzi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveKinGridzi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinGridzi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveKinGridzi) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NGridPts + call RegUnpack(Buf, OutData%NGridPts) + if (RegCheckErr(Buf, RoutineName)) return + ! DirRoot + call RegUnpack(Buf, OutData%DirRoot) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE Current_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(Current_InitOutputType), INTENT(IN) :: SrcInitOutputData TYPE(Current_InitOutputType), INTENT(INOUT) :: DstInitOutputData @@ -381,184 +293,78 @@ SUBROUTINE Current_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE Current_DestroyInitOutput - SUBROUTINE Current_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Current_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! CurrVxi allocated yes/no - IF ( ALLOCATED(InData%CurrVxi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CurrVxi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CurrVxi) ! CurrVxi - END IF - Int_BufSz = Int_BufSz + 1 ! CurrVyi allocated yes/no - IF ( ALLOCATED(InData%CurrVyi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CurrVyi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CurrVyi) ! CurrVyi - END IF - Re_BufSz = Re_BufSz + 1 ! PCurrVxiPz0 - Re_BufSz = Re_BufSz + 1 ! PCurrVyiPz0 - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%CurrVxi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CurrVxi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CurrVxi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CurrVxi,1), UBOUND(InData%CurrVxi,1) - ReKiBuf(Re_Xferred) = InData%CurrVxi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CurrVyi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CurrVyi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CurrVyi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CurrVyi,1), UBOUND(InData%CurrVyi,1) - ReKiBuf(Re_Xferred) = InData%CurrVyi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%PCurrVxiPz0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PCurrVyiPz0 - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Current_PackInitOutput - SUBROUTINE Current_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Current_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CurrVxi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CurrVxi)) DEALLOCATE(OutData%CurrVxi) - ALLOCATE(OutData%CurrVxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CurrVxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CurrVxi,1), UBOUND(OutData%CurrVxi,1) - OutData%CurrVxi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CurrVyi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CurrVyi)) DEALLOCATE(OutData%CurrVyi) - ALLOCATE(OutData%CurrVyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CurrVyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CurrVyi,1), UBOUND(OutData%CurrVyi,1) - OutData%CurrVyi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%PCurrVxiPz0 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%PCurrVyiPz0 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Current_UnPackInitOutput +subroutine Current_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Current_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Current_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! CurrVxi + call RegPack(Buf, allocated(InData%CurrVxi)) + if (allocated(InData%CurrVxi)) then + call RegPackBounds(Buf, 1, lbound(InData%CurrVxi), ubound(InData%CurrVxi)) + call RegPack(Buf, InData%CurrVxi) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CurrVyi + call RegPack(Buf, allocated(InData%CurrVyi)) + if (allocated(InData%CurrVyi)) then + call RegPackBounds(Buf, 1, lbound(InData%CurrVyi), ubound(InData%CurrVyi)) + call RegPack(Buf, InData%CurrVyi) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PCurrVxiPz0 + call RegPack(Buf, InData%PCurrVxiPz0) + if (RegCheckErr(Buf, RoutineName)) return + ! PCurrVyiPz0 + call RegPack(Buf, InData%PCurrVyiPz0) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine +subroutine Current_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Current_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Current_UnPackInitOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! CurrVxi + if (allocated(OutData%CurrVxi)) deallocate(OutData%CurrVxi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CurrVxi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CurrVxi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CurrVxi) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CurrVyi + if (allocated(OutData%CurrVyi)) deallocate(OutData%CurrVyi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CurrVyi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CurrVyi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CurrVyi) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PCurrVxiPz0 + call RegUnpack(Buf, OutData%PCurrVxiPz0) + if (RegCheckErr(Buf, RoutineName)) return + ! PCurrVyiPz0 + call RegUnpack(Buf, OutData%PCurrVyiPz0) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine END MODULE Current_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/src/SeaSt_WaveField_Types.f90 b/modules/seastate/src/SeaSt_WaveField_Types.f90 index 4b06eacd1d..57c84dcbc7 100644 --- a/modules/seastate/src/SeaSt_WaveField_Types.f90 +++ b/modules/seastate/src/SeaSt_WaveField_Types.f90 @@ -393,1103 +393,375 @@ SUBROUTINE SeaSt_WaveField_DestroySeaSt_WaveFieldType( SeaSt_WaveFieldTypeData, ENDIF END SUBROUTINE SeaSt_WaveField_DestroySeaSt_WaveFieldType - SUBROUTINE SeaSt_WaveField_PackSeaSt_WaveFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SeaSt_WaveFieldType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_WaveField_PackSeaSt_WaveFieldType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! WaveTime allocated yes/no - IF ( ALLOCATED(InData%WaveTime) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveTime upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveTime) ! WaveTime - END IF - Int_BufSz = Int_BufSz + 1 ! WaveDynP allocated yes/no - IF ( ALLOCATED(InData%WaveDynP) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! WaveDynP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveDynP) ! WaveDynP - END IF - Int_BufSz = Int_BufSz + 1 ! WaveAcc allocated yes/no - IF ( ALLOCATED(InData%WaveAcc) ) THEN - Int_BufSz = Int_BufSz + 2*5 ! WaveAcc upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveAcc) ! WaveAcc - END IF - Int_BufSz = Int_BufSz + 1 ! WaveAccMCF allocated yes/no - IF ( ALLOCATED(InData%WaveAccMCF) ) THEN - Int_BufSz = Int_BufSz + 2*5 ! WaveAccMCF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveAccMCF) ! WaveAccMCF - END IF - Int_BufSz = Int_BufSz + 1 ! WaveVel allocated yes/no - IF ( ALLOCATED(InData%WaveVel) ) THEN - Int_BufSz = Int_BufSz + 2*5 ! WaveVel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveVel) ! WaveVel - END IF - Int_BufSz = Int_BufSz + 1 ! PWaveDynP0 allocated yes/no - IF ( ALLOCATED(InData%PWaveDynP0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PWaveDynP0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PWaveDynP0) ! PWaveDynP0 - END IF - Int_BufSz = Int_BufSz + 1 ! PWaveAcc0 allocated yes/no - IF ( ALLOCATED(InData%PWaveAcc0) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! PWaveAcc0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PWaveAcc0) ! PWaveAcc0 - END IF - Int_BufSz = Int_BufSz + 1 ! PWaveAccMCF0 allocated yes/no - IF ( ALLOCATED(InData%PWaveAccMCF0) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! PWaveAccMCF0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PWaveAccMCF0) ! PWaveAccMCF0 - END IF - Int_BufSz = Int_BufSz + 1 ! PWaveVel0 allocated yes/no - IF ( ALLOCATED(InData%PWaveVel0) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! PWaveVel0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PWaveVel0) ! PWaveVel0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElev0 allocated yes/no - IF ( ALLOCATED(InData%WaveElev0) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveElev0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev0) ! WaveElev0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElev1 allocated yes/no - IF ( ALLOCATED(InData%WaveElev1) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveElev1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev1) ! WaveElev1 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElev2 allocated yes/no - IF ( ALLOCATED(InData%WaveElev2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveElev2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev2) ! WaveElev2 - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! SeaSt_Interp_p: size of buffers for each call to pack subtype - CALL SeaSt_Interp_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt_Interp_p, ErrStat2, ErrMsg2, .TRUE. ) ! SeaSt_Interp_p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SeaSt_Interp_p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SeaSt_Interp_p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SeaSt_Interp_p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! WaveStMod - Re_BufSz = Re_BufSz + 1 ! EffWtrDpth - Re_BufSz = Re_BufSz + 1 ! MSL2SWL - Int_BufSz = Int_BufSz + 1 ! WaveElevC allocated yes/no - IF ( ALLOCATED(InData%WaveElevC) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveElevC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElevC) ! WaveElevC - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElevC0 allocated yes/no - IF ( ALLOCATED(InData%WaveElevC0) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveElevC0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElevC0) ! WaveElevC0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveDirArr allocated yes/no - IF ( ALLOCATED(InData%WaveDirArr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveDirArr upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveDirArr) ! WaveDirArr - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveTime,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) - ReKiBuf(Re_Xferred) = InData%WaveTime(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveDynP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%WaveDynP,4), UBOUND(InData%WaveDynP,4) - DO i3 = LBOUND(InData%WaveDynP,3), UBOUND(InData%WaveDynP,3) - DO i2 = LBOUND(InData%WaveDynP,2), UBOUND(InData%WaveDynP,2) - DO i1 = LBOUND(InData%WaveDynP,1), UBOUND(InData%WaveDynP,1) - ReKiBuf(Re_Xferred) = InData%WaveDynP(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveAcc) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,5) - Int_Xferred = Int_Xferred + 2 - - DO i5 = LBOUND(InData%WaveAcc,5), UBOUND(InData%WaveAcc,5) - DO i4 = LBOUND(InData%WaveAcc,4), UBOUND(InData%WaveAcc,4) - DO i3 = LBOUND(InData%WaveAcc,3), UBOUND(InData%WaveAcc,3) - DO i2 = LBOUND(InData%WaveAcc,2), UBOUND(InData%WaveAcc,2) - DO i1 = LBOUND(InData%WaveAcc,1), UBOUND(InData%WaveAcc,1) - ReKiBuf(Re_Xferred) = InData%WaveAcc(i1,i2,i3,i4,i5) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveAccMCF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAccMCF,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAccMCF,5) - Int_Xferred = Int_Xferred + 2 - - DO i5 = LBOUND(InData%WaveAccMCF,5), UBOUND(InData%WaveAccMCF,5) - DO i4 = LBOUND(InData%WaveAccMCF,4), UBOUND(InData%WaveAccMCF,4) - DO i3 = LBOUND(InData%WaveAccMCF,3), UBOUND(InData%WaveAccMCF,3) - DO i2 = LBOUND(InData%WaveAccMCF,2), UBOUND(InData%WaveAccMCF,2) - DO i1 = LBOUND(InData%WaveAccMCF,1), UBOUND(InData%WaveAccMCF,1) - ReKiBuf(Re_Xferred) = InData%WaveAccMCF(i1,i2,i3,i4,i5) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveVel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,5) - Int_Xferred = Int_Xferred + 2 - - DO i5 = LBOUND(InData%WaveVel,5), UBOUND(InData%WaveVel,5) - DO i4 = LBOUND(InData%WaveVel,4), UBOUND(InData%WaveVel,4) - DO i3 = LBOUND(InData%WaveVel,3), UBOUND(InData%WaveVel,3) - DO i2 = LBOUND(InData%WaveVel,2), UBOUND(InData%WaveVel,2) - DO i1 = LBOUND(InData%WaveVel,1), UBOUND(InData%WaveVel,1) - ReKiBuf(Re_Xferred) = InData%WaveVel(i1,i2,i3,i4,i5) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PWaveDynP0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveDynP0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveDynP0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveDynP0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveDynP0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveDynP0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveDynP0,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PWaveDynP0,3), UBOUND(InData%PWaveDynP0,3) - DO i2 = LBOUND(InData%PWaveDynP0,2), UBOUND(InData%PWaveDynP0,2) - DO i1 = LBOUND(InData%PWaveDynP0,1), UBOUND(InData%PWaveDynP0,1) - ReKiBuf(Re_Xferred) = InData%PWaveDynP0(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PWaveAcc0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%PWaveAcc0,4), UBOUND(InData%PWaveAcc0,4) - DO i3 = LBOUND(InData%PWaveAcc0,3), UBOUND(InData%PWaveAcc0,3) - DO i2 = LBOUND(InData%PWaveAcc0,2), UBOUND(InData%PWaveAcc0,2) - DO i1 = LBOUND(InData%PWaveAcc0,1), UBOUND(InData%PWaveAcc0,1) - ReKiBuf(Re_Xferred) = InData%PWaveAcc0(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PWaveAccMCF0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAccMCF0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAccMCF0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAccMCF0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAccMCF0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAccMCF0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAccMCF0,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAccMCF0,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAccMCF0,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%PWaveAccMCF0,4), UBOUND(InData%PWaveAccMCF0,4) - DO i3 = LBOUND(InData%PWaveAccMCF0,3), UBOUND(InData%PWaveAccMCF0,3) - DO i2 = LBOUND(InData%PWaveAccMCF0,2), UBOUND(InData%PWaveAccMCF0,2) - DO i1 = LBOUND(InData%PWaveAccMCF0,1), UBOUND(InData%PWaveAccMCF0,1) - ReKiBuf(Re_Xferred) = InData%PWaveAccMCF0(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PWaveVel0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%PWaveVel0,4), UBOUND(InData%PWaveVel0,4) - DO i3 = LBOUND(InData%PWaveVel0,3), UBOUND(InData%PWaveVel0,3) - DO i2 = LBOUND(InData%PWaveVel0,2), UBOUND(InData%PWaveVel0,2) - DO i1 = LBOUND(InData%PWaveVel0,1), UBOUND(InData%PWaveVel0,1) - ReKiBuf(Re_Xferred) = InData%PWaveVel0(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveElev0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev0,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveElev0,1), UBOUND(InData%WaveElev0,1) - ReKiBuf(Re_Xferred) = InData%WaveElev0(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveElev1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev1,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev1,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev1,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveElev1,3), UBOUND(InData%WaveElev1,3) - DO i2 = LBOUND(InData%WaveElev1,2), UBOUND(InData%WaveElev1,2) - DO i1 = LBOUND(InData%WaveElev1,1), UBOUND(InData%WaveElev1,1) - ReKiBuf(Re_Xferred) = InData%WaveElev1(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveElev2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveElev2,3), UBOUND(InData%WaveElev2,3) - DO i2 = LBOUND(InData%WaveElev2,2), UBOUND(InData%WaveElev2,2) - DO i1 = LBOUND(InData%WaveElev2,1), UBOUND(InData%WaveElev2,1) - ReKiBuf(Re_Xferred) = InData%WaveElev2(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - CALL SeaSt_Interp_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt_Interp_p, ErrStat2, ErrMsg2, OnlySize ) ! SeaSt_Interp_p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = InData%WaveStMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%EffWtrDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveElevC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveElevC,3), UBOUND(InData%WaveElevC,3) - DO i2 = LBOUND(InData%WaveElevC,2), UBOUND(InData%WaveElevC,2) - DO i1 = LBOUND(InData%WaveElevC,1), UBOUND(InData%WaveElevC,1) - ReKiBuf(Re_Xferred) = InData%WaveElevC(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveElevC0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC0,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveElevC0,2), UBOUND(InData%WaveElevC0,2) - DO i1 = LBOUND(InData%WaveElevC0,1), UBOUND(InData%WaveElevC0,1) - ReKiBuf(Re_Xferred) = InData%WaveElevC0(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveDirArr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDirArr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDirArr,1) - Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WaveDirArr,1), UBOUND(InData%WaveDirArr,1) - ReKiBuf(Re_Xferred) = InData%WaveDirArr(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SeaSt_WaveField_PackSeaSt_WaveFieldType - - SUBROUTINE SeaSt_WaveField_UnPackSeaSt_WaveFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SeaSt_WaveFieldType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_WaveField_UnPackSeaSt_WaveFieldType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveTime)) DEALLOCATE(OutData%WaveTime) - ALLOCATE(OutData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) - OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveDynP)) DEALLOCATE(OutData%WaveDynP) - ALLOCATE(OutData%WaveDynP(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%WaveDynP,4), UBOUND(OutData%WaveDynP,4) - DO i3 = LBOUND(OutData%WaveDynP,3), UBOUND(OutData%WaveDynP,3) - DO i2 = LBOUND(OutData%WaveDynP,2), UBOUND(OutData%WaveDynP,2) - DO i1 = LBOUND(OutData%WaveDynP,1), UBOUND(OutData%WaveDynP,1) - OutData%WaveDynP(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i5_l = IntKiBuf( Int_Xferred ) - i5_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveAcc)) DEALLOCATE(OutData%WaveAcc) - ALLOCATE(OutData%WaveAcc(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i5 = LBOUND(OutData%WaveAcc,5), UBOUND(OutData%WaveAcc,5) - DO i4 = LBOUND(OutData%WaveAcc,4), UBOUND(OutData%WaveAcc,4) - DO i3 = LBOUND(OutData%WaveAcc,3), UBOUND(OutData%WaveAcc,3) - DO i2 = LBOUND(OutData%WaveAcc,2), UBOUND(OutData%WaveAcc,2) - DO i1 = LBOUND(OutData%WaveAcc,1), UBOUND(OutData%WaveAcc,1) - OutData%WaveAcc(i1,i2,i3,i4,i5) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAccMCF not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i5_l = IntKiBuf( Int_Xferred ) - i5_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveAccMCF)) DEALLOCATE(OutData%WaveAccMCF) - ALLOCATE(OutData%WaveAccMCF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAccMCF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i5 = LBOUND(OutData%WaveAccMCF,5), UBOUND(OutData%WaveAccMCF,5) - DO i4 = LBOUND(OutData%WaveAccMCF,4), UBOUND(OutData%WaveAccMCF,4) - DO i3 = LBOUND(OutData%WaveAccMCF,3), UBOUND(OutData%WaveAccMCF,3) - DO i2 = LBOUND(OutData%WaveAccMCF,2), UBOUND(OutData%WaveAccMCF,2) - DO i1 = LBOUND(OutData%WaveAccMCF,1), UBOUND(OutData%WaveAccMCF,1) - OutData%WaveAccMCF(i1,i2,i3,i4,i5) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i5_l = IntKiBuf( Int_Xferred ) - i5_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveVel)) DEALLOCATE(OutData%WaveVel) - ALLOCATE(OutData%WaveVel(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i5 = LBOUND(OutData%WaveVel,5), UBOUND(OutData%WaveVel,5) - DO i4 = LBOUND(OutData%WaveVel,4), UBOUND(OutData%WaveVel,4) - DO i3 = LBOUND(OutData%WaveVel,3), UBOUND(OutData%WaveVel,3) - DO i2 = LBOUND(OutData%WaveVel,2), UBOUND(OutData%WaveVel,2) - DO i1 = LBOUND(OutData%WaveVel,1), UBOUND(OutData%WaveVel,1) - OutData%WaveVel(i1,i2,i3,i4,i5) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveDynP0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PWaveDynP0)) DEALLOCATE(OutData%PWaveDynP0) - ALLOCATE(OutData%PWaveDynP0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveDynP0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PWaveDynP0,3), UBOUND(OutData%PWaveDynP0,3) - DO i2 = LBOUND(OutData%PWaveDynP0,2), UBOUND(OutData%PWaveDynP0,2) - DO i1 = LBOUND(OutData%PWaveDynP0,1), UBOUND(OutData%PWaveDynP0,1) - OutData%PWaveDynP0(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveAcc0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PWaveAcc0)) DEALLOCATE(OutData%PWaveAcc0) - ALLOCATE(OutData%PWaveAcc0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAcc0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%PWaveAcc0,4), UBOUND(OutData%PWaveAcc0,4) - DO i3 = LBOUND(OutData%PWaveAcc0,3), UBOUND(OutData%PWaveAcc0,3) - DO i2 = LBOUND(OutData%PWaveAcc0,2), UBOUND(OutData%PWaveAcc0,2) - DO i1 = LBOUND(OutData%PWaveAcc0,1), UBOUND(OutData%PWaveAcc0,1) - OutData%PWaveAcc0(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveAccMCF0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PWaveAccMCF0)) DEALLOCATE(OutData%PWaveAccMCF0) - ALLOCATE(OutData%PWaveAccMCF0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAccMCF0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%PWaveAccMCF0,4), UBOUND(OutData%PWaveAccMCF0,4) - DO i3 = LBOUND(OutData%PWaveAccMCF0,3), UBOUND(OutData%PWaveAccMCF0,3) - DO i2 = LBOUND(OutData%PWaveAccMCF0,2), UBOUND(OutData%PWaveAccMCF0,2) - DO i1 = LBOUND(OutData%PWaveAccMCF0,1), UBOUND(OutData%PWaveAccMCF0,1) - OutData%PWaveAccMCF0(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveVel0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PWaveVel0)) DEALLOCATE(OutData%PWaveVel0) - ALLOCATE(OutData%PWaveVel0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveVel0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%PWaveVel0,4), UBOUND(OutData%PWaveVel0,4) - DO i3 = LBOUND(OutData%PWaveVel0,3), UBOUND(OutData%PWaveVel0,3) - DO i2 = LBOUND(OutData%PWaveVel0,2), UBOUND(OutData%PWaveVel0,2) - DO i1 = LBOUND(OutData%PWaveVel0,1), UBOUND(OutData%PWaveVel0,1) - OutData%PWaveVel0(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveElev0)) DEALLOCATE(OutData%WaveElev0) - ALLOCATE(OutData%WaveElev0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveElev0,1), UBOUND(OutData%WaveElev0,1) - OutData%WaveElev0(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveElev1)) DEALLOCATE(OutData%WaveElev1) - ALLOCATE(OutData%WaveElev1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveElev1,3), UBOUND(OutData%WaveElev1,3) - DO i2 = LBOUND(OutData%WaveElev1,2), UBOUND(OutData%WaveElev1,2) - DO i1 = LBOUND(OutData%WaveElev1,1), UBOUND(OutData%WaveElev1,1) - OutData%WaveElev1(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveElev2)) DEALLOCATE(OutData%WaveElev2) - ALLOCATE(OutData%WaveElev2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveElev2,3), UBOUND(OutData%WaveElev2,3) - DO i2 = LBOUND(OutData%WaveElev2,2), UBOUND(OutData%WaveElev2,2) - DO i1 = LBOUND(OutData%WaveElev2,1), UBOUND(OutData%WaveElev2,1) - OutData%WaveElev2(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SeaSt_Interp_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%SeaSt_Interp_p, ErrStat2, ErrMsg2 ) ! SeaSt_Interp_p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%WaveStMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%EffWtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MSL2SWL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveElevC)) DEALLOCATE(OutData%WaveElevC) - ALLOCATE(OutData%WaveElevC(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveElevC,3), UBOUND(OutData%WaveElevC,3) - DO i2 = LBOUND(OutData%WaveElevC,2), UBOUND(OutData%WaveElevC,2) - DO i1 = LBOUND(OutData%WaveElevC,1), UBOUND(OutData%WaveElevC,1) - OutData%WaveElevC(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevC0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveElevC0)) DEALLOCATE(OutData%WaveElevC0) - ALLOCATE(OutData%WaveElevC0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveElevC0,2), UBOUND(OutData%WaveElevC0,2) - DO i1 = LBOUND(OutData%WaveElevC0,1), UBOUND(OutData%WaveElevC0,1) - OutData%WaveElevC0(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDirArr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveDirArr)) DEALLOCATE(OutData%WaveDirArr) - ALLOCATE(OutData%WaveDirArr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveDirArr,1), UBOUND(OutData%WaveDirArr,1) - OutData%WaveDirArr(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SeaSt_WaveField_UnPackSeaSt_WaveFieldType +subroutine SeaSt_WaveField_PackSeaSt_WaveFieldType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_WaveFieldType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_WaveField_PackSeaSt_WaveFieldType' + if (Buf%ErrStat >= AbortErrLev) return + ! WaveTime + call RegPack(Buf, allocated(InData%WaveTime)) + if (allocated(InData%WaveTime)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) + call RegPack(Buf, InData%WaveTime) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDynP + call RegPack(Buf, allocated(InData%WaveDynP)) + if (allocated(InData%WaveDynP)) then + call RegPackBounds(Buf, 4, lbound(InData%WaveDynP), ubound(InData%WaveDynP)) + call RegPack(Buf, InData%WaveDynP) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveAcc + call RegPack(Buf, allocated(InData%WaveAcc)) + if (allocated(InData%WaveAcc)) then + call RegPackBounds(Buf, 5, lbound(InData%WaveAcc), ubound(InData%WaveAcc)) + call RegPack(Buf, InData%WaveAcc) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveAccMCF + call RegPack(Buf, allocated(InData%WaveAccMCF)) + if (allocated(InData%WaveAccMCF)) then + call RegPackBounds(Buf, 5, lbound(InData%WaveAccMCF), ubound(InData%WaveAccMCF)) + call RegPack(Buf, InData%WaveAccMCF) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveVel + call RegPack(Buf, allocated(InData%WaveVel)) + if (allocated(InData%WaveVel)) then + call RegPackBounds(Buf, 5, lbound(InData%WaveVel), ubound(InData%WaveVel)) + call RegPack(Buf, InData%WaveVel) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PWaveDynP0 + call RegPack(Buf, allocated(InData%PWaveDynP0)) + if (allocated(InData%PWaveDynP0)) then + call RegPackBounds(Buf, 3, lbound(InData%PWaveDynP0), ubound(InData%PWaveDynP0)) + call RegPack(Buf, InData%PWaveDynP0) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PWaveAcc0 + call RegPack(Buf, allocated(InData%PWaveAcc0)) + if (allocated(InData%PWaveAcc0)) then + call RegPackBounds(Buf, 4, lbound(InData%PWaveAcc0), ubound(InData%PWaveAcc0)) + call RegPack(Buf, InData%PWaveAcc0) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PWaveAccMCF0 + call RegPack(Buf, allocated(InData%PWaveAccMCF0)) + if (allocated(InData%PWaveAccMCF0)) then + call RegPackBounds(Buf, 4, lbound(InData%PWaveAccMCF0), ubound(InData%PWaveAccMCF0)) + call RegPack(Buf, InData%PWaveAccMCF0) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PWaveVel0 + call RegPack(Buf, allocated(InData%PWaveVel0)) + if (allocated(InData%PWaveVel0)) then + call RegPackBounds(Buf, 4, lbound(InData%PWaveVel0), ubound(InData%PWaveVel0)) + call RegPack(Buf, InData%PWaveVel0) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElev0 + call RegPack(Buf, allocated(InData%WaveElev0)) + if (allocated(InData%WaveElev0)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveElev0), ubound(InData%WaveElev0)) + call RegPack(Buf, InData%WaveElev0) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElev1 + call RegPack(Buf, allocated(InData%WaveElev1)) + if (allocated(InData%WaveElev1)) then + call RegPackBounds(Buf, 3, lbound(InData%WaveElev1), ubound(InData%WaveElev1)) + call RegPack(Buf, InData%WaveElev1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElev2 + call RegPack(Buf, allocated(InData%WaveElev2)) + if (allocated(InData%WaveElev2)) then + call RegPackBounds(Buf, 3, lbound(InData%WaveElev2), ubound(InData%WaveElev2)) + call RegPack(Buf, InData%WaveElev2) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SeaSt_Interp_p + call SeaSt_Interp_PackParam(Buf, InData%SeaSt_Interp_p) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveStMod + call RegPack(Buf, InData%WaveStMod) + if (RegCheckErr(Buf, RoutineName)) return + ! EffWtrDpth + call RegPack(Buf, InData%EffWtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! MSL2SWL + call RegPack(Buf, InData%MSL2SWL) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElevC + call RegPack(Buf, allocated(InData%WaveElevC)) + if (allocated(InData%WaveElevC)) then + call RegPackBounds(Buf, 3, lbound(InData%WaveElevC), ubound(InData%WaveElevC)) + call RegPack(Buf, InData%WaveElevC) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElevC0 + call RegPack(Buf, allocated(InData%WaveElevC0)) + if (allocated(InData%WaveElevC0)) then + call RegPackBounds(Buf, 2, lbound(InData%WaveElevC0), ubound(InData%WaveElevC0)) + call RegPack(Buf, InData%WaveElevC0) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDirArr + call RegPack(Buf, allocated(InData%WaveDirArr)) + if (allocated(InData%WaveDirArr)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveDirArr), ubound(InData%WaveDirArr)) + call RegPack(Buf, InData%WaveDirArr) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine +subroutine SeaSt_WaveField_UnPackSeaSt_WaveFieldType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_WaveFieldType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_WaveField_UnPackSeaSt_WaveFieldType' + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! WaveTime + if (allocated(OutData%WaveTime)) deallocate(OutData%WaveTime) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveTime(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveTime) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WaveDynP + if (allocated(OutData%WaveDynP)) deallocate(OutData%WaveDynP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveDynP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveDynP) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WaveAcc + if (allocated(OutData%WaveAcc)) deallocate(OutData%WaveAcc) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveAcc(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveAcc) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WaveAccMCF + if (allocated(OutData%WaveAccMCF)) deallocate(OutData%WaveAccMCF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveAccMCF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAccMCF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveAccMCF) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WaveVel + if (allocated(OutData%WaveVel)) deallocate(OutData%WaveVel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveVel(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveVel) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PWaveDynP0 + if (allocated(OutData%PWaveDynP0)) deallocate(OutData%PWaveDynP0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PWaveDynP0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveDynP0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PWaveDynP0) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PWaveAcc0 + if (allocated(OutData%PWaveAcc0)) deallocate(OutData%PWaveAcc0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PWaveAcc0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAcc0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PWaveAcc0) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PWaveAccMCF0 + if (allocated(OutData%PWaveAccMCF0)) deallocate(OutData%PWaveAccMCF0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PWaveAccMCF0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAccMCF0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PWaveAccMCF0) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PWaveVel0 + if (allocated(OutData%PWaveVel0)) deallocate(OutData%PWaveVel0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PWaveVel0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveVel0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PWaveVel0) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WaveElev0 + if (allocated(OutData%WaveElev0)) deallocate(OutData%WaveElev0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveElev0(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveElev0) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WaveElev1 + if (allocated(OutData%WaveElev1)) deallocate(OutData%WaveElev1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveElev1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveElev1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WaveElev2 + if (allocated(OutData%WaveElev2)) deallocate(OutData%WaveElev2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveElev2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveElev2) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! SeaSt_Interp_p + call SeaSt_Interp_UnpackParam(Buf, OutData%SeaSt_Interp_p) ! SeaSt_Interp_p + ! WaveStMod + call RegUnpack(Buf, OutData%WaveStMod) + if (RegCheckErr(Buf, RoutineName)) return + ! EffWtrDpth + call RegUnpack(Buf, OutData%EffWtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! MSL2SWL + call RegUnpack(Buf, OutData%MSL2SWL) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElevC + if (allocated(OutData%WaveElevC)) deallocate(OutData%WaveElevC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveElevC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveElevC) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WaveElevC0 + if (allocated(OutData%WaveElevC0)) deallocate(OutData%WaveElevC0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveElevC0(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveElevC0) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WaveDirArr + if (allocated(OutData%WaveDirArr)) deallocate(OutData%WaveDirArr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveDirArr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveDirArr) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine END MODULE SeaSt_WaveField_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index 91dd0e054c..3f89957c89 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -656,7 +656,7 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init SUBROUTINE CleanUp() CALL SeaSt_DestroyInputFile( InputFileData, ErrStat2, ErrMsg2 );CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL NWTC_Library_DestroyFileInfoType(InFileInfo,ErrStat2, ErrMsg2, DEALLOCATEpointers = .FALSE. );CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + CALL NWTC_Library_DestroyFileInfoType(InFileInfo,ErrStat2, ErrMsg2);CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! Note: all pointers possibly allocated in Waves_init and Waves2_init are transferred to SeaSt parameters before deallocating them: CALL Waves_DestroyInitOutput( Waves_InitOut, ErrStat2, ErrMsg2 ); CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) diff --git a/modules/seastate/src/SeaState_Interp_Types.f90 b/modules/seastate/src/SeaState_Interp_Types.f90 index 685dcba373..17f6469154 100644 --- a/modules/seastate/src/SeaState_Interp_Types.f90 +++ b/modules/seastate/src/SeaState_Interp_Types.f90 @@ -100,137 +100,44 @@ SUBROUTINE SeaSt_Interp_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) END SUBROUTINE SeaSt_Interp_DestroyInitInput - SUBROUTINE SeaSt_Interp_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(SeaSt_Interp_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 = 'SeaSt_Interp_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + SIZE(InData%n) ! n - Re_BufSz = Re_BufSz + SIZE(InData%delta) ! delta - Re_BufSz = Re_BufSz + SIZE(InData%pZero) ! pZero - Re_BufSz = Re_BufSz + 1 ! Z_Depth - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i1 = LBOUND(InData%n,1), UBOUND(InData%n,1) - IntKiBuf(Int_Xferred) = InData%n(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%delta,1), UBOUND(InData%delta,1) - ReKiBuf(Re_Xferred) = InData%delta(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%pZero,1), UBOUND(InData%pZero,1) - ReKiBuf(Re_Xferred) = InData%pZero(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%Z_Depth - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SeaSt_Interp_PackInitInput - - SUBROUTINE SeaSt_Interp_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(SeaSt_Interp_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_Interp_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 - i1_l = LBOUND(OutData%n,1) - i1_u = UBOUND(OutData%n,1) - DO i1 = LBOUND(OutData%n,1), UBOUND(OutData%n,1) - OutData%n(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%delta,1) - i1_u = UBOUND(OutData%delta,1) - DO i1 = LBOUND(OutData%delta,1), UBOUND(OutData%delta,1) - OutData%delta(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%pZero,1) - i1_u = UBOUND(OutData%pZero,1) - DO i1 = LBOUND(OutData%pZero,1), UBOUND(OutData%pZero,1) - OutData%pZero(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%Z_Depth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SeaSt_Interp_UnPackInitInput +subroutine SeaSt_Interp_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_Interp_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_Interp_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + ! n + call RegPack(Buf, InData%n) + if (RegCheckErr(Buf, RoutineName)) return + ! delta + call RegPack(Buf, InData%delta) + if (RegCheckErr(Buf, RoutineName)) return + ! pZero + call RegPack(Buf, InData%pZero) + if (RegCheckErr(Buf, RoutineName)) return + ! Z_Depth + call RegPack(Buf, InData%Z_Depth) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SeaSt_Interp_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_Interp_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_Interp_UnPackInitInput' + if (Buf%ErrStat /= ErrID_None) return + ! n + call RegUnpack(Buf, OutData%n) + if (RegCheckErr(Buf, RoutineName)) return + ! delta + call RegUnpack(Buf, OutData%delta) + if (RegCheckErr(Buf, RoutineName)) return + ! pZero + call RegUnpack(Buf, OutData%pZero) + if (RegCheckErr(Buf, RoutineName)) return + ! Z_Depth + call RegUnpack(Buf, OutData%Z_Depth) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE SeaSt_Interp_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(SeaSt_Interp_InitOutputType), INTENT(IN) :: SrcInitOutputData TYPE(SeaSt_Interp_InitOutputType), INTENT(INOUT) :: DstInitOutputData @@ -267,184 +174,25 @@ SUBROUTINE SeaSt_Interp_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE SeaSt_Interp_DestroyInitOutput - SUBROUTINE SeaSt_Interp_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(SeaSt_Interp_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 = 'SeaSt_Interp_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE SeaSt_Interp_PackInitOutput - - SUBROUTINE SeaSt_Interp_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(SeaSt_Interp_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_Interp_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE SeaSt_Interp_UnPackInitOutput +subroutine SeaSt_Interp_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_Interp_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_Interp_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! Ver + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SeaSt_Interp_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_Interp_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_Interp_UnPackInitOutput' + if (Buf%ErrStat /= ErrID_None) return + ! Ver + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver +end subroutine SUBROUTINE SeaSt_Interp_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) TYPE(SeaSt_Interp_MiscVarType), INTENT(IN) :: SrcMiscData TYPE(SeaSt_Interp_MiscVarType), INTENT(INOUT) :: DstMiscData @@ -482,148 +230,50 @@ SUBROUTINE SeaSt_Interp_DestroyMisc( MiscData, ErrStat, ErrMsg ) END SUBROUTINE SeaSt_Interp_DestroyMisc - SUBROUTINE SeaSt_Interp_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(SeaSt_Interp_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 = 'SeaSt_Interp_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + SIZE(InData%N3D) ! N3D - Re_BufSz = Re_BufSz + SIZE(InData%N4D) ! N4D - Int_BufSz = Int_BufSz + SIZE(InData%Indx_Lo) ! Indx_Lo - Int_BufSz = Int_BufSz + SIZE(InData%Indx_Hi) ! Indx_Hi - Int_BufSz = Int_BufSz + 1 ! FirstWarn_Clamp - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END 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%N3D,1), UBOUND(InData%N3D,1) - ReKiBuf(Re_Xferred) = InData%N3D(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%N4D,1), UBOUND(InData%N4D,1) - ReKiBuf(Re_Xferred) = InData%N4D(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%Indx_Lo,1), UBOUND(InData%Indx_Lo,1) - IntKiBuf(Int_Xferred) = InData%Indx_Lo(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%Indx_Hi,1), UBOUND(InData%Indx_Hi,1) - IntKiBuf(Int_Xferred) = InData%Indx_Hi(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstWarn_Clamp, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SeaSt_Interp_PackMisc - - SUBROUTINE SeaSt_Interp_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(SeaSt_Interp_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 = 'SeaSt_Interp_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%N3D,1) - i1_u = UBOUND(OutData%N3D,1) - DO i1 = LBOUND(OutData%N3D,1), UBOUND(OutData%N3D,1) - OutData%N3D(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%N4D,1) - i1_u = UBOUND(OutData%N4D,1) - DO i1 = LBOUND(OutData%N4D,1), UBOUND(OutData%N4D,1) - OutData%N4D(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%Indx_Lo,1) - i1_u = UBOUND(OutData%Indx_Lo,1) - DO i1 = LBOUND(OutData%Indx_Lo,1), UBOUND(OutData%Indx_Lo,1) - OutData%Indx_Lo(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%Indx_Hi,1) - i1_u = UBOUND(OutData%Indx_Hi,1) - DO i1 = LBOUND(OutData%Indx_Hi,1), UBOUND(OutData%Indx_Hi,1) - OutData%Indx_Hi(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%FirstWarn_Clamp = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn_Clamp) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SeaSt_Interp_UnPackMisc +subroutine SeaSt_Interp_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_Interp_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_Interp_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + ! N3D + call RegPack(Buf, InData%N3D) + if (RegCheckErr(Buf, RoutineName)) return + ! N4D + call RegPack(Buf, InData%N4D) + if (RegCheckErr(Buf, RoutineName)) return + ! Indx_Lo + call RegPack(Buf, InData%Indx_Lo) + if (RegCheckErr(Buf, RoutineName)) return + ! Indx_Hi + call RegPack(Buf, InData%Indx_Hi) + if (RegCheckErr(Buf, RoutineName)) return + ! FirstWarn_Clamp + call RegPack(Buf, InData%FirstWarn_Clamp) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SeaSt_Interp_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_Interp_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_Interp_UnPackMisc' + if (Buf%ErrStat /= ErrID_None) return + ! N3D + call RegUnpack(Buf, OutData%N3D) + if (RegCheckErr(Buf, RoutineName)) return + ! N4D + call RegUnpack(Buf, OutData%N4D) + if (RegCheckErr(Buf, RoutineName)) return + ! Indx_Lo + call RegUnpack(Buf, OutData%Indx_Lo) + if (RegCheckErr(Buf, RoutineName)) return + ! Indx_Hi + call RegUnpack(Buf, OutData%Indx_Hi) + if (RegCheckErr(Buf, RoutineName)) return + ! FirstWarn_Clamp + call RegUnpack(Buf, OutData%FirstWarn_Clamp) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE SeaSt_Interp_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(SeaSt_Interp_ParameterType), INTENT(IN) :: SrcParamData TYPE(SeaSt_Interp_ParameterType), INTENT(INOUT) :: DstParamData @@ -660,136 +310,43 @@ SUBROUTINE SeaSt_Interp_DestroyParam( ParamData, ErrStat, ErrMsg ) END SUBROUTINE SeaSt_Interp_DestroyParam - SUBROUTINE SeaSt_Interp_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(SeaSt_Interp_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 = 'SeaSt_Interp_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + SIZE(InData%n) ! n - Re_BufSz = Re_BufSz + SIZE(InData%delta) ! delta - Re_BufSz = Re_BufSz + SIZE(InData%pZero) ! pZero - Re_BufSz = Re_BufSz + 1 ! Z_Depth - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i1 = LBOUND(InData%n,1), UBOUND(InData%n,1) - IntKiBuf(Int_Xferred) = InData%n(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%delta,1), UBOUND(InData%delta,1) - ReKiBuf(Re_Xferred) = InData%delta(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%pZero,1), UBOUND(InData%pZero,1) - ReKiBuf(Re_Xferred) = InData%pZero(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%Z_Depth - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SeaSt_Interp_PackParam - - SUBROUTINE SeaSt_Interp_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(SeaSt_Interp_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_Interp_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%n,1) - i1_u = UBOUND(OutData%n,1) - DO i1 = LBOUND(OutData%n,1), UBOUND(OutData%n,1) - OutData%n(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%delta,1) - i1_u = UBOUND(OutData%delta,1) - DO i1 = LBOUND(OutData%delta,1), UBOUND(OutData%delta,1) - OutData%delta(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%pZero,1) - i1_u = UBOUND(OutData%pZero,1) - DO i1 = LBOUND(OutData%pZero,1), UBOUND(OutData%pZero,1) - OutData%pZero(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%Z_Depth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SeaSt_Interp_UnPackParam +subroutine SeaSt_Interp_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_Interp_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_Interp_PackParam' + if (Buf%ErrStat >= AbortErrLev) return + ! n + call RegPack(Buf, InData%n) + if (RegCheckErr(Buf, RoutineName)) return + ! delta + call RegPack(Buf, InData%delta) + if (RegCheckErr(Buf, RoutineName)) return + ! pZero + call RegPack(Buf, InData%pZero) + if (RegCheckErr(Buf, RoutineName)) return + ! Z_Depth + call RegPack(Buf, InData%Z_Depth) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SeaSt_Interp_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_Interp_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_Interp_UnPackParam' + if (Buf%ErrStat /= ErrID_None) return + ! n + call RegUnpack(Buf, OutData%n) + if (RegCheckErr(Buf, RoutineName)) return + ! delta + call RegUnpack(Buf, OutData%delta) + if (RegCheckErr(Buf, RoutineName)) return + ! pZero + call RegUnpack(Buf, OutData%pZero) + if (RegCheckErr(Buf, RoutineName)) return + ! Z_Depth + call RegUnpack(Buf, OutData%Z_Depth) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine END MODULE SeaState_Interp_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index b5127ace11..7258f37f9d 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -374,680 +374,272 @@ SUBROUTINE SeaSt_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE SeaSt_DestroyInputFile - SUBROUTINE SeaSt_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SeaSt_InputFile), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_PackInputFile' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! EchoFlag - Re_BufSz = Re_BufSz + 1 ! MSL2SWL - Re_BufSz = Re_BufSz + 1 ! X_HalfWidth - Re_BufSz = Re_BufSz + 1 ! Y_HalfWidth - Re_BufSz = Re_BufSz + 1 ! Z_Depth - Int_BufSz = Int_BufSz + 1 ! NX - Int_BufSz = Int_BufSz + 1 ! NY - Int_BufSz = Int_BufSz + 1 ! NZ - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Waves: size of buffers for each call to pack subtype - CALL Waves_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%Waves, ErrStat2, ErrMsg2, .TRUE. ) ! Waves - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Waves - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Waves - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Waves - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Waves2: size of buffers for each call to pack subtype - CALL Waves2_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%Waves2, ErrStat2, ErrMsg2, .TRUE. ) ! Waves2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Waves2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Waves2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Waves2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Current: size of buffers for each call to pack subtype - CALL Current_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%Current, ErrStat2, ErrMsg2, .TRUE. ) ! Current - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Current - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Current - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Current - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Echo - Int_BufSz = Int_BufSz + 1 ! NWaveElev - Int_BufSz = Int_BufSz + 1 ! WaveElevxi allocated yes/no - IF ( ALLOCATED(InData%WaveElevxi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveElevxi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElevxi) ! WaveElevxi - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElevyi allocated yes/no - IF ( ALLOCATED(InData%WaveElevyi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveElevyi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElevyi) ! WaveElevyi - END IF - Int_BufSz = Int_BufSz + 1 ! NWaveKin - Int_BufSz = Int_BufSz + 1 ! WaveKinxi allocated yes/no - IF ( ALLOCATED(InData%WaveKinxi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveKinxi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveKinxi) ! WaveKinxi - END IF - Int_BufSz = Int_BufSz + 1 ! WaveKinyi allocated yes/no - IF ( ALLOCATED(InData%WaveKinyi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveKinyi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveKinyi) ! WaveKinyi - END IF - Int_BufSz = Int_BufSz + 1 ! WaveKinzi allocated yes/no - IF ( ALLOCATED(InData%WaveKinzi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveKinzi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveKinzi) ! WaveKinzi - END IF - Int_BufSz = Int_BufSz + 1 ! OutSwtch - Int_BufSz = Int_BufSz + 1 ! OutAll - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! OutList allocated yes/no - IF ( ALLOCATED(InData%OutList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%OutList)*LEN(InData%OutList) ! OutList - END IF - Int_BufSz = Int_BufSz + 1 ! SeaStSum - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt - Int_BufSz = Int_BufSz + 1*LEN(InData%OutSFmt) ! OutSFmt - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = TRANSFER(InData%EchoFlag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%X_HalfWidth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Y_HalfWidth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Z_Depth - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NX - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NY - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NZ - Int_Xferred = Int_Xferred + 1 - CALL Waves_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%Waves, ErrStat2, ErrMsg2, OnlySize ) ! Waves - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL Waves2_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%Waves2, ErrStat2, ErrMsg2, OnlySize ) ! Waves2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL Current_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%Current, ErrStat2, ErrMsg2, OnlySize ) ! Current - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = TRANSFER(InData%Echo, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NWaveElev - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveElevxi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevxi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevxi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveElevxi,1), UBOUND(InData%WaveElevxi,1) - ReKiBuf(Re_Xferred) = InData%WaveElevxi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveElevyi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevyi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevyi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveElevyi,1), UBOUND(InData%WaveElevyi,1) - ReKiBuf(Re_Xferred) = InData%WaveElevyi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NWaveKin - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveKinxi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveKinxi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinxi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveKinxi,1), UBOUND(InData%WaveKinxi,1) - ReKiBuf(Re_Xferred) = InData%WaveKinxi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveKinyi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveKinyi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinyi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveKinyi,1), UBOUND(InData%WaveKinyi,1) - ReKiBuf(Re_Xferred) = InData%WaveKinyi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveKinzi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveKinzi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinzi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveKinzi,1), UBOUND(InData%WaveKinzi,1) - ReKiBuf(Re_Xferred) = InData%WaveKinzi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%OutSwtch - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%OutAll, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) - DO I = 1, LEN(InData%OutList) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%SeaStSum, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutSFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE SeaSt_PackInputFile - - SUBROUTINE SeaSt_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SeaSt_InputFile), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_UnPackInputFile' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%EchoFlag = TRANSFER(IntKiBuf(Int_Xferred), OutData%EchoFlag) - Int_Xferred = Int_Xferred + 1 - OutData%MSL2SWL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%X_HalfWidth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Y_HalfWidth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Z_Depth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NX = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NY = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NZ = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Waves_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%Waves, ErrStat2, ErrMsg2 ) ! Waves - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Waves2_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%Waves2, ErrStat2, ErrMsg2 ) ! Waves2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Current_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%Current, ErrStat2, ErrMsg2 ) ! Current - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%Echo = TRANSFER(IntKiBuf(Int_Xferred), OutData%Echo) - Int_Xferred = Int_Xferred + 1 - OutData%NWaveElev = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevxi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveElevxi)) DEALLOCATE(OutData%WaveElevxi) - ALLOCATE(OutData%WaveElevxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveElevxi,1), UBOUND(OutData%WaveElevxi,1) - OutData%WaveElevxi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevyi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveElevyi)) DEALLOCATE(OutData%WaveElevyi) - ALLOCATE(OutData%WaveElevyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveElevyi,1), UBOUND(OutData%WaveElevyi,1) - OutData%WaveElevyi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%NWaveKin = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinxi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveKinxi)) DEALLOCATE(OutData%WaveKinxi) - ALLOCATE(OutData%WaveKinxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveKinxi,1), UBOUND(OutData%WaveKinxi,1) - OutData%WaveKinxi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinyi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveKinyi)) DEALLOCATE(OutData%WaveKinyi) - ALLOCATE(OutData%WaveKinyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveKinyi,1), UBOUND(OutData%WaveKinyi,1) - OutData%WaveKinyi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinzi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveKinzi)) DEALLOCATE(OutData%WaveKinzi) - ALLOCATE(OutData%WaveKinzi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinzi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveKinzi,1), UBOUND(OutData%WaveKinzi,1) - OutData%WaveKinzi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%OutSwtch = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%OutAll = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutAll) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutList not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutList)) DEALLOCATE(OutData%OutList) - ALLOCATE(OutData%OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) - DO I = 1, LEN(OutData%OutList) - OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - OutData%SeaStSum = TRANSFER(IntKiBuf(Int_Xferred), OutData%SeaStSum) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutSFmt) - OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE SeaSt_UnPackInputFile +subroutine SeaSt_PackInputFile(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_InputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_PackInputFile' + if (Buf%ErrStat >= AbortErrLev) return + ! EchoFlag + call RegPack(Buf, InData%EchoFlag) + if (RegCheckErr(Buf, RoutineName)) return + ! MSL2SWL + call RegPack(Buf, InData%MSL2SWL) + if (RegCheckErr(Buf, RoutineName)) return + ! X_HalfWidth + call RegPack(Buf, InData%X_HalfWidth) + if (RegCheckErr(Buf, RoutineName)) return + ! Y_HalfWidth + call RegPack(Buf, InData%Y_HalfWidth) + if (RegCheckErr(Buf, RoutineName)) return + ! Z_Depth + call RegPack(Buf, InData%Z_Depth) + if (RegCheckErr(Buf, RoutineName)) return + ! NX + call RegPack(Buf, InData%NX) + if (RegCheckErr(Buf, RoutineName)) return + ! NY + call RegPack(Buf, InData%NY) + if (RegCheckErr(Buf, RoutineName)) return + ! NZ + call RegPack(Buf, InData%NZ) + if (RegCheckErr(Buf, RoutineName)) return + ! Waves + call Waves_PackInitInput(Buf, InData%Waves) + if (RegCheckErr(Buf, RoutineName)) return + ! Waves2 + call Waves2_PackInitInput(Buf, InData%Waves2) + if (RegCheckErr(Buf, RoutineName)) return + ! Current + call Current_PackInitInput(Buf, InData%Current) + if (RegCheckErr(Buf, RoutineName)) return + ! Echo + call RegPack(Buf, InData%Echo) + if (RegCheckErr(Buf, RoutineName)) return + ! NWaveElev + call RegPack(Buf, InData%NWaveElev) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElevxi + call RegPack(Buf, allocated(InData%WaveElevxi)) + if (allocated(InData%WaveElevxi)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveElevxi), ubound(InData%WaveElevxi)) + call RegPack(Buf, InData%WaveElevxi) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElevyi + call RegPack(Buf, allocated(InData%WaveElevyi)) + if (allocated(InData%WaveElevyi)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveElevyi), ubound(InData%WaveElevyi)) + call RegPack(Buf, InData%WaveElevyi) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NWaveKin + call RegPack(Buf, InData%NWaveKin) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveKinxi + call RegPack(Buf, allocated(InData%WaveKinxi)) + if (allocated(InData%WaveKinxi)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveKinxi), ubound(InData%WaveKinxi)) + call RegPack(Buf, InData%WaveKinxi) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveKinyi + call RegPack(Buf, allocated(InData%WaveKinyi)) + if (allocated(InData%WaveKinyi)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveKinyi), ubound(InData%WaveKinyi)) + call RegPack(Buf, InData%WaveKinyi) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveKinzi + call RegPack(Buf, allocated(InData%WaveKinzi)) + if (allocated(InData%WaveKinzi)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveKinzi), ubound(InData%WaveKinzi)) + call RegPack(Buf, InData%WaveKinzi) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OutSwtch + call RegPack(Buf, InData%OutSwtch) + if (RegCheckErr(Buf, RoutineName)) return + ! OutAll + call RegPack(Buf, InData%OutAll) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegPack(Buf, InData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! OutList + call RegPack(Buf, allocated(InData%OutList)) + if (allocated(InData%OutList)) then + call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) + call RegPack(Buf, InData%OutList) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SeaStSum + call RegPack(Buf, InData%SeaStSum) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFmt + call RegPack(Buf, InData%OutFmt) + if (RegCheckErr(Buf, RoutineName)) return + ! OutSFmt + call RegPack(Buf, InData%OutSFmt) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SeaSt_UnPackInputFile(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_InputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_UnPackInputFile' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! EchoFlag + call RegUnpack(Buf, OutData%EchoFlag) + if (RegCheckErr(Buf, RoutineName)) return + ! MSL2SWL + call RegUnpack(Buf, OutData%MSL2SWL) + if (RegCheckErr(Buf, RoutineName)) return + ! X_HalfWidth + call RegUnpack(Buf, OutData%X_HalfWidth) + if (RegCheckErr(Buf, RoutineName)) return + ! Y_HalfWidth + call RegUnpack(Buf, OutData%Y_HalfWidth) + if (RegCheckErr(Buf, RoutineName)) return + ! Z_Depth + call RegUnpack(Buf, OutData%Z_Depth) + if (RegCheckErr(Buf, RoutineName)) return + ! NX + call RegUnpack(Buf, OutData%NX) + if (RegCheckErr(Buf, RoutineName)) return + ! NY + call RegUnpack(Buf, OutData%NY) + if (RegCheckErr(Buf, RoutineName)) return + ! NZ + call RegUnpack(Buf, OutData%NZ) + if (RegCheckErr(Buf, RoutineName)) return + ! Waves + call Waves_UnpackInitInput(Buf, OutData%Waves) ! Waves + ! Waves2 + call Waves2_UnpackInitInput(Buf, OutData%Waves2) ! Waves2 + ! Current + call Current_UnpackInitInput(Buf, OutData%Current) ! Current + ! Echo + call RegUnpack(Buf, OutData%Echo) + if (RegCheckErr(Buf, RoutineName)) return + ! NWaveElev + call RegUnpack(Buf, OutData%NWaveElev) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElevxi + if (allocated(OutData%WaveElevxi)) deallocate(OutData%WaveElevxi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveElevxi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevxi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveElevxi) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WaveElevyi + if (allocated(OutData%WaveElevyi)) deallocate(OutData%WaveElevyi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveElevyi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevyi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveElevyi) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NWaveKin + call RegUnpack(Buf, OutData%NWaveKin) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveKinxi + if (allocated(OutData%WaveKinxi)) deallocate(OutData%WaveKinxi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveKinxi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinxi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveKinxi) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WaveKinyi + if (allocated(OutData%WaveKinyi)) deallocate(OutData%WaveKinyi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveKinyi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinyi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveKinyi) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WaveKinzi + if (allocated(OutData%WaveKinzi)) deallocate(OutData%WaveKinzi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveKinzi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinzi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveKinzi) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! OutSwtch + call RegUnpack(Buf, OutData%OutSwtch) + if (RegCheckErr(Buf, RoutineName)) return + ! OutAll + call RegUnpack(Buf, OutData%OutAll) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! OutList + if (allocated(OutData%OutList)) deallocate(OutData%OutList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutList) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! SeaStSum + call RegUnpack(Buf, OutData%SeaStSum) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFmt + call RegUnpack(Buf, OutData%OutFmt) + if (RegCheckErr(Buf, RoutineName)) return + ! OutSFmt + call RegUnpack(Buf, OutData%OutSFmt) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE SeaSt_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(SeaSt_InitInputType), INTENT(IN) :: SrcInitInputData TYPE(SeaSt_InitInputType), INTENT(INOUT) :: DstInitInputData @@ -1117,312 +709,134 @@ SUBROUTINE SeaSt_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE SeaSt_DestroyInitInput - SUBROUTINE SeaSt_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(SeaSt_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 = 'SeaSt_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%InputFile) ! InputFile - Int_BufSz = Int_BufSz + 1 ! UseInputFile - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! PassedFileData: size of buffers for each call to pack subtype - CALL NWTC_Library_PackFileInfoType( Re_Buf, Db_Buf, Int_Buf, InData%PassedFileData, ErrStat2, ErrMsg2, .TRUE. ) ! PassedFileData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PassedFileData - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PassedFileData - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PassedFileData - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%OutRootName) ! OutRootName - Re_BufSz = Re_BufSz + 1 ! Gravity - Re_BufSz = Re_BufSz + 1 ! defWtrDens - Re_BufSz = Re_BufSz + 1 ! defWtrDpth - Re_BufSz = Re_BufSz + 1 ! defMSL2SWL - Db_BufSz = Db_BufSz + 1 ! TMax - Int_BufSz = Int_BufSz + 1 ! WaveElevXY allocated yes/no - IF ( ALLOCATED(InData%WaveElevXY) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveElevXY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElevXY) ! WaveElevXY - END IF - Int_BufSz = Int_BufSz + 1 ! WaveFieldMod - Re_BufSz = Re_BufSz + 1 ! PtfmLocationX - Re_BufSz = Re_BufSz + 1 ! PtfmLocationY - Int_BufSz = Int_BufSz + 1 ! WrWvKinMod - Int_BufSz = Int_BufSz + 1 ! HasIce - 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) = TRANSFER(InData%UseInputFile, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - CALL NWTC_Library_PackFileInfoType( Re_Buf, Db_Buf, Int_Buf, InData%PassedFileData, ErrStat2, ErrMsg2, OnlySize ) ! PassedFileData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - DO I = 1, LEN(InData%OutRootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutRootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf(Re_Xferred) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%defWtrDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%defWtrDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%defMSL2SWL - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TMax - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveElevXY) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevXY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevXY,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevXY,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevXY,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveElevXY,2), UBOUND(InData%WaveElevXY,2) - DO i1 = LBOUND(InData%WaveElevXY,1), UBOUND(InData%WaveElevXY,1) - ReKiBuf(Re_Xferred) = InData%WaveElevXY(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%WaveFieldMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmLocationX - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmLocationY - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WrWvKinMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%HasIce, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SeaSt_PackInitInput - - SUBROUTINE SeaSt_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(SeaSt_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UseInputFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseInputFile) - Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackFileInfoType( Re_Buf, Db_Buf, Int_Buf, OutData%PassedFileData, ErrStat2, ErrMsg2 ) ! PassedFileData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - DO I = 1, LEN(OutData%OutRootName) - OutData%OutRootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%defWtrDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%defWtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%defMSL2SWL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TMax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevXY not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveElevXY)) DEALLOCATE(OutData%WaveElevXY) - ALLOCATE(OutData%WaveElevXY(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevXY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveElevXY,2), UBOUND(OutData%WaveElevXY,2) - DO i1 = LBOUND(OutData%WaveElevXY,1), UBOUND(OutData%WaveElevXY,1) - OutData%WaveElevXY(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%WaveFieldMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmLocationX = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmLocationY = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WrWvKinMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%HasIce = TRANSFER(IntKiBuf(Int_Xferred), OutData%HasIce) - Int_Xferred = Int_Xferred + 1 - OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SeaSt_UnPackInitInput +subroutine SeaSt_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + ! InputFile + call RegPack(Buf, InData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! UseInputFile + call RegPack(Buf, InData%UseInputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! PassedFileData + call NWTC_Library_PackFileInfoType(Buf, InData%PassedFileData) + if (RegCheckErr(Buf, RoutineName)) return + ! OutRootName + call RegPack(Buf, InData%OutRootName) + if (RegCheckErr(Buf, RoutineName)) return + ! Gravity + call RegPack(Buf, InData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + ! defWtrDens + call RegPack(Buf, InData%defWtrDens) + if (RegCheckErr(Buf, RoutineName)) return + ! defWtrDpth + call RegPack(Buf, InData%defWtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! defMSL2SWL + call RegPack(Buf, InData%defMSL2SWL) + if (RegCheckErr(Buf, RoutineName)) return + ! TMax + call RegPack(Buf, InData%TMax) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElevXY + call RegPack(Buf, allocated(InData%WaveElevXY)) + if (allocated(InData%WaveElevXY)) then + call RegPackBounds(Buf, 2, lbound(InData%WaveElevXY), ubound(InData%WaveElevXY)) + call RegPack(Buf, InData%WaveElevXY) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveFieldMod + call RegPack(Buf, InData%WaveFieldMod) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmLocationX + call RegPack(Buf, InData%PtfmLocationX) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmLocationY + call RegPack(Buf, InData%PtfmLocationY) + if (RegCheckErr(Buf, RoutineName)) return + ! WrWvKinMod + call RegPack(Buf, InData%WrWvKinMod) + if (RegCheckErr(Buf, RoutineName)) return + ! HasIce + call RegPack(Buf, InData%HasIce) + if (RegCheckErr(Buf, RoutineName)) return + ! Linearize + call RegPack(Buf, InData%Linearize) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SeaSt_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_UnPackInitInput' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! InputFile + call RegUnpack(Buf, OutData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! UseInputFile + call RegUnpack(Buf, OutData%UseInputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! PassedFileData + call NWTC_Library_UnpackFileInfoType(Buf, OutData%PassedFileData) ! PassedFileData + ! OutRootName + call RegUnpack(Buf, OutData%OutRootName) + if (RegCheckErr(Buf, RoutineName)) return + ! Gravity + call RegUnpack(Buf, OutData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + ! defWtrDens + call RegUnpack(Buf, OutData%defWtrDens) + if (RegCheckErr(Buf, RoutineName)) return + ! defWtrDpth + call RegUnpack(Buf, OutData%defWtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! defMSL2SWL + call RegUnpack(Buf, OutData%defMSL2SWL) + if (RegCheckErr(Buf, RoutineName)) return + ! TMax + call RegUnpack(Buf, OutData%TMax) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElevXY + if (allocated(OutData%WaveElevXY)) deallocate(OutData%WaveElevXY) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveElevXY(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevXY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveElevXY) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WaveFieldMod + call RegUnpack(Buf, OutData%WaveFieldMod) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmLocationX + call RegUnpack(Buf, OutData%PtfmLocationX) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmLocationY + call RegUnpack(Buf, OutData%PtfmLocationY) + if (RegCheckErr(Buf, RoutineName)) return + ! WrWvKinMod + call RegUnpack(Buf, OutData%WrWvKinMod) + if (RegCheckErr(Buf, RoutineName)) return + ! HasIce + call RegUnpack(Buf, OutData%HasIce) + if (RegCheckErr(Buf, RoutineName)) return + ! Linearize + call RegUnpack(Buf, OutData%Linearize) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE SeaSt_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(SeaSt_InitOutputType), INTENT(IN) :: SrcInitOutputData TYPE(SeaSt_InitOutputType), INTENT(INOUT) :: DstInitOutputData @@ -1570,532 +984,789 @@ SUBROUTINE SeaSt_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) NULLIFY(InitOutputData%WaveField) END SUBROUTINE SeaSt_DestroyInitOutput - SUBROUTINE SeaSt_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(SeaSt_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 = 'SeaSt_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! WriteOutputHdr allocated yes/no - IF ( ALLOCATED(InData%WriteOutputHdr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdr upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdr)*LEN(InData%WriteOutputHdr) ! WriteOutputHdr - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputUnt allocated yes/no - IF ( ALLOCATED(InData%WriteOutputUnt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUnt upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUnt)*LEN(InData%WriteOutputUnt) ! WriteOutputUnt - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Re_BufSz = Re_BufSz + 1 ! WtrDens - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Re_BufSz = Re_BufSz + 1 ! MSL2SWL - Re_BufSz = Re_BufSz + 1 ! WaveDirMin - Re_BufSz = Re_BufSz + 1 ! WaveDirMax - Re_BufSz = Re_BufSz + 1 ! WaveDir - Int_BufSz = Int_BufSz + 1 ! WaveMultiDir - Re_BufSz = Re_BufSz + 1 ! WaveDOmega - Re_BufSz = Re_BufSz + 1 ! RhoXg - Int_BufSz = Int_BufSz + 1 ! NStepWave - Int_BufSz = Int_BufSz + 1 ! NStepWave2 - Int_BufSz = Int_BufSz + 1 ! WaveMod - Int_BufSz = Int_BufSz + 1 ! WaveStMod - Int_BufSz = Int_BufSz + 1 ! WaveDirMod - Re_BufSz = Re_BufSz + 1 ! WvLowCOff - Re_BufSz = Re_BufSz + 1 ! WvHiCOff - Re_BufSz = Re_BufSz + 1 ! WvLowCOffD - Re_BufSz = Re_BufSz + 1 ! WvHiCOffD - Re_BufSz = Re_BufSz + 1 ! WvLowCOffS - Re_BufSz = Re_BufSz + 1 ! WvHiCOffS - Int_BufSz = Int_BufSz + 1 ! InvalidWithSSExctn - Int_BufSz = Int_BufSz + 3 ! SeaSt_Interp_p: size of buffers for each call to pack subtype - CALL SeaSt_Interp_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt_Interp_p, ErrStat2, ErrMsg2, .TRUE. ) ! SeaSt_Interp_p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SeaSt_Interp_p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SeaSt_Interp_p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SeaSt_Interp_p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Re_BufSz = Re_BufSz + 1 ! MCFD - Int_BufSz = Int_BufSz + 1 ! WaveElevSeries allocated yes/no - IF ( ALLOCATED(InData%WaveElevSeries) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveElevSeries upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElevSeries) ! WaveElevSeries - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%WriteOutputHdr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) - DO I = 1, LEN(InData%WriteOutputHdr) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputUnt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) - DO I = 1, LEN(InData%WriteOutputUnt) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - ReKiBuf(Re_Xferred) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDirMin - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDirMax - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDir - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WaveMultiDir, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDOmega - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RhoXg - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepWave2 - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveStMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveDirMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WvLowCOff - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WvHiCOff - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WvLowCOffD - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WvHiCOffD - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WvLowCOffS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WvHiCOffS - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%InvalidWithSSExctn, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - CALL SeaSt_Interp_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt_Interp_p, ErrStat2, ErrMsg2, OnlySize ) ! SeaSt_Interp_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 - ReKiBuf(Re_Xferred) = InData%MCFD - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveElevSeries) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevSeries,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevSeries,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevSeries,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevSeries,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveElevSeries,2), UBOUND(InData%WaveElevSeries,2) - DO i1 = LBOUND(InData%WaveElevSeries,1), UBOUND(InData%WaveElevSeries,1) - ReKiBuf(Re_Xferred) = InData%WaveElevSeries(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE SeaSt_PackInitOutput - - SUBROUTINE SeaSt_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(SeaSt_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputHdr)) DEALLOCATE(OutData%WriteOutputHdr) - ALLOCATE(OutData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) - DO I = 1, LEN(OutData%WriteOutputHdr) - OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputUnt)) DEALLOCATE(OutData%WriteOutputUnt) - ALLOCATE(OutData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) - DO I = 1, LEN(OutData%WriteOutputUnt) - OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%WtrDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MSL2SWL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - NULLIFY(OutData%WaveElevC0) - NULLIFY(OutData%WaveElevC) - NULLIFY(OutData%WaveDirArr) - OutData%WaveDirMin = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDirMax = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDir = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveMultiDir = TRANSFER(IntKiBuf(Int_Xferred), OutData%WaveMultiDir) - Int_Xferred = Int_Xferred + 1 - OutData%WaveDOmega = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - NULLIFY(OutData%WaveDynP) - NULLIFY(OutData%WaveAcc) - NULLIFY(OutData%WaveAccMCF) - NULLIFY(OutData%WaveVel) - NULLIFY(OutData%PWaveDynP0) - NULLIFY(OutData%PWaveAcc0) - NULLIFY(OutData%PWaveAccMCF0) - NULLIFY(OutData%PWaveVel0) - NULLIFY(OutData%WaveElev1) - NULLIFY(OutData%WaveElev2) - NULLIFY(OutData%WaveElev0) - NULLIFY(OutData%WaveTime) - OutData%RhoXg = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%NStepWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NStepWave2 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WaveMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WaveStMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WaveDirMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WvLowCOff = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WvHiCOff = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WvLowCOffD = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WvHiCOffD = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WvLowCOffS = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WvHiCOffS = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%InvalidWithSSExctn = TRANSFER(IntKiBuf(Int_Xferred), OutData%InvalidWithSSExctn) - 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 SeaSt_Interp_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%SeaSt_Interp_p, ErrStat2, ErrMsg2 ) ! SeaSt_Interp_p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%MCFD = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevSeries not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveElevSeries)) DEALLOCATE(OutData%WaveElevSeries) - ALLOCATE(OutData%WaveElevSeries(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevSeries.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveElevSeries,2), UBOUND(OutData%WaveElevSeries,2) - DO i1 = LBOUND(OutData%WaveElevSeries,1), UBOUND(OutData%WaveElevSeries,1) - OutData%WaveElevSeries(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - NULLIFY(OutData%WaveField) - END SUBROUTINE SeaSt_UnPackInitOutput +subroutine SeaSt_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_PackInitOutput' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + ! WriteOutputHdr + call RegPack(Buf, allocated(InData%WriteOutputHdr)) + if (allocated(InData%WriteOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPack(Buf, InData%WriteOutputHdr) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutputUnt + call RegPack(Buf, allocated(InData%WriteOutputUnt)) + if (allocated(InData%WriteOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPack(Buf, InData%WriteOutputUnt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Ver + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDens + call RegPack(Buf, InData%WtrDens) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDpth + call RegPack(Buf, InData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! MSL2SWL + call RegPack(Buf, InData%MSL2SWL) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElevC0 + call RegPack(Buf, associated(InData%WaveElevC0)) + if (associated(InData%WaveElevC0)) then + call RegPackBounds(Buf, 2, lbound(InData%WaveElevC0), ubound(InData%WaveElevC0)) + call RegPackPointer(Buf, c_loc(InData%WaveElevC0), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveElevC0) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElevC + call RegPack(Buf, associated(InData%WaveElevC)) + if (associated(InData%WaveElevC)) then + call RegPackBounds(Buf, 3, lbound(InData%WaveElevC), ubound(InData%WaveElevC)) + call RegPackPointer(Buf, c_loc(InData%WaveElevC), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveElevC) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDirArr + call RegPack(Buf, associated(InData%WaveDirArr)) + if (associated(InData%WaveDirArr)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveDirArr), ubound(InData%WaveDirArr)) + call RegPackPointer(Buf, c_loc(InData%WaveDirArr), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveDirArr) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDirMin + call RegPack(Buf, InData%WaveDirMin) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDirMax + call RegPack(Buf, InData%WaveDirMax) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDir + call RegPack(Buf, InData%WaveDir) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveMultiDir + call RegPack(Buf, InData%WaveMultiDir) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDOmega + call RegPack(Buf, InData%WaveDOmega) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDynP + call RegPack(Buf, associated(InData%WaveDynP)) + if (associated(InData%WaveDynP)) then + call RegPackBounds(Buf, 4, lbound(InData%WaveDynP), ubound(InData%WaveDynP)) + call RegPackPointer(Buf, c_loc(InData%WaveDynP), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveDynP) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveAcc + call RegPack(Buf, associated(InData%WaveAcc)) + if (associated(InData%WaveAcc)) then + call RegPackBounds(Buf, 5, lbound(InData%WaveAcc), ubound(InData%WaveAcc)) + call RegPackPointer(Buf, c_loc(InData%WaveAcc), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveAcc) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveAccMCF + call RegPack(Buf, associated(InData%WaveAccMCF)) + if (associated(InData%WaveAccMCF)) then + call RegPackBounds(Buf, 5, lbound(InData%WaveAccMCF), ubound(InData%WaveAccMCF)) + call RegPackPointer(Buf, c_loc(InData%WaveAccMCF), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveAccMCF) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveVel + call RegPack(Buf, associated(InData%WaveVel)) + if (associated(InData%WaveVel)) then + call RegPackBounds(Buf, 5, lbound(InData%WaveVel), ubound(InData%WaveVel)) + call RegPackPointer(Buf, c_loc(InData%WaveVel), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveVel) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PWaveDynP0 + call RegPack(Buf, associated(InData%PWaveDynP0)) + if (associated(InData%PWaveDynP0)) then + call RegPackBounds(Buf, 3, lbound(InData%PWaveDynP0), ubound(InData%PWaveDynP0)) + call RegPackPointer(Buf, c_loc(InData%PWaveDynP0), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%PWaveDynP0) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PWaveAcc0 + call RegPack(Buf, associated(InData%PWaveAcc0)) + if (associated(InData%PWaveAcc0)) then + call RegPackBounds(Buf, 4, lbound(InData%PWaveAcc0), ubound(InData%PWaveAcc0)) + call RegPackPointer(Buf, c_loc(InData%PWaveAcc0), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%PWaveAcc0) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PWaveAccMCF0 + call RegPack(Buf, associated(InData%PWaveAccMCF0)) + if (associated(InData%PWaveAccMCF0)) then + call RegPackBounds(Buf, 4, lbound(InData%PWaveAccMCF0), ubound(InData%PWaveAccMCF0)) + call RegPackPointer(Buf, c_loc(InData%PWaveAccMCF0), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%PWaveAccMCF0) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PWaveVel0 + call RegPack(Buf, associated(InData%PWaveVel0)) + if (associated(InData%PWaveVel0)) then + call RegPackBounds(Buf, 4, lbound(InData%PWaveVel0), ubound(InData%PWaveVel0)) + call RegPackPointer(Buf, c_loc(InData%PWaveVel0), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%PWaveVel0) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElev1 + call RegPack(Buf, associated(InData%WaveElev1)) + if (associated(InData%WaveElev1)) then + call RegPackBounds(Buf, 3, lbound(InData%WaveElev1), ubound(InData%WaveElev1)) + call RegPackPointer(Buf, c_loc(InData%WaveElev1), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveElev1) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElev2 + call RegPack(Buf, associated(InData%WaveElev2)) + if (associated(InData%WaveElev2)) then + call RegPackBounds(Buf, 3, lbound(InData%WaveElev2), ubound(InData%WaveElev2)) + call RegPackPointer(Buf, c_loc(InData%WaveElev2), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveElev2) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElev0 + call RegPack(Buf, associated(InData%WaveElev0)) + if (associated(InData%WaveElev0)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveElev0), ubound(InData%WaveElev0)) + call RegPackPointer(Buf, c_loc(InData%WaveElev0), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveElev0) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveTime + call RegPack(Buf, associated(InData%WaveTime)) + if (associated(InData%WaveTime)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) + call RegPackPointer(Buf, c_loc(InData%WaveTime), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveTime) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RhoXg + call RegPack(Buf, InData%RhoXg) + if (RegCheckErr(Buf, RoutineName)) return + ! NStepWave + call RegPack(Buf, InData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + ! NStepWave2 + call RegPack(Buf, InData%NStepWave2) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveMod + call RegPack(Buf, InData%WaveMod) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveStMod + call RegPack(Buf, InData%WaveStMod) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDirMod + call RegPack(Buf, InData%WaveDirMod) + if (RegCheckErr(Buf, RoutineName)) return + ! WvLowCOff + call RegPack(Buf, InData%WvLowCOff) + if (RegCheckErr(Buf, RoutineName)) return + ! WvHiCOff + call RegPack(Buf, InData%WvHiCOff) + if (RegCheckErr(Buf, RoutineName)) return + ! WvLowCOffD + call RegPack(Buf, InData%WvLowCOffD) + if (RegCheckErr(Buf, RoutineName)) return + ! WvHiCOffD + call RegPack(Buf, InData%WvHiCOffD) + if (RegCheckErr(Buf, RoutineName)) return + ! WvLowCOffS + call RegPack(Buf, InData%WvLowCOffS) + if (RegCheckErr(Buf, RoutineName)) return + ! WvHiCOffS + call RegPack(Buf, InData%WvHiCOffS) + if (RegCheckErr(Buf, RoutineName)) return + ! InvalidWithSSExctn + call RegPack(Buf, InData%InvalidWithSSExctn) + if (RegCheckErr(Buf, RoutineName)) return + ! SeaSt_Interp_p + call SeaSt_Interp_PackParam(Buf, InData%SeaSt_Interp_p) + if (RegCheckErr(Buf, RoutineName)) return + ! MCFD + call RegPack(Buf, InData%MCFD) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElevSeries + call RegPack(Buf, allocated(InData%WaveElevSeries)) + if (allocated(InData%WaveElevSeries)) then + call RegPackBounds(Buf, 2, lbound(InData%WaveElevSeries), ubound(InData%WaveElevSeries)) + call RegPack(Buf, InData%WaveElevSeries) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveField + call RegPack(Buf, associated(InData%WaveField)) + if (associated(InData%WaveField)) then + call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) + if (.not. PtrInIndex) then + call SeaSt_WaveField_PackSeaSt_WaveFieldType(Buf, InData%WaveField) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SeaSt_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_UnPackInitOutput' + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + ! WriteOutputHdr + if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WriteOutputUnt + if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Ver + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + ! WtrDens + call RegUnpack(Buf, OutData%WtrDens) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDpth + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! MSL2SWL + call RegUnpack(Buf, OutData%MSL2SWL) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElevC0 + if (associated(OutData%WaveElevC0)) deallocate(OutData%WaveElevC0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveElevC0, UB(1:2)-LB(1:2)) + OutData%WaveElevC0(LB(1):,LB(2):) => OutData%WaveElevC0 + else + allocate(OutData%WaveElevC0(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElevC0) + call RegUnpack(Buf, OutData%WaveElevC0) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveElevC0 => null() + end if + ! WaveElevC + if (associated(OutData%WaveElevC)) deallocate(OutData%WaveElevC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveElevC, UB(1:3)-LB(1:3)) + OutData%WaveElevC(LB(1):,LB(2):,LB(3):) => OutData%WaveElevC + else + allocate(OutData%WaveElevC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElevC) + call RegUnpack(Buf, OutData%WaveElevC) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveElevC => null() + end if + ! WaveDirArr + if (associated(OutData%WaveDirArr)) deallocate(OutData%WaveDirArr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveDirArr, UB(1:1)-LB(1:1)) + OutData%WaveDirArr(LB(1):) => OutData%WaveDirArr + else + allocate(OutData%WaveDirArr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveDirArr) + call RegUnpack(Buf, OutData%WaveDirArr) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveDirArr => null() + end if + ! WaveDirMin + call RegUnpack(Buf, OutData%WaveDirMin) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDirMax + call RegUnpack(Buf, OutData%WaveDirMax) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDir + call RegUnpack(Buf, OutData%WaveDir) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveMultiDir + call RegUnpack(Buf, OutData%WaveMultiDir) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDOmega + call RegUnpack(Buf, OutData%WaveDOmega) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDynP + if (associated(OutData%WaveDynP)) deallocate(OutData%WaveDynP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveDynP, UB(1:4)-LB(1:4)) + OutData%WaveDynP(LB(1):,LB(2):,LB(3):,LB(4):) => OutData%WaveDynP + else + allocate(OutData%WaveDynP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveDynP) + call RegUnpack(Buf, OutData%WaveDynP) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveDynP => null() + end if + ! WaveAcc + if (associated(OutData%WaveAcc)) deallocate(OutData%WaveAcc) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveAcc, UB(1:5)-LB(1:5)) + OutData%WaveAcc(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => OutData%WaveAcc + else + allocate(OutData%WaveAcc(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveAcc) + call RegUnpack(Buf, OutData%WaveAcc) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveAcc => null() + end if + ! WaveAccMCF + if (associated(OutData%WaveAccMCF)) deallocate(OutData%WaveAccMCF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveAccMCF, UB(1:5)-LB(1:5)) + OutData%WaveAccMCF(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => OutData%WaveAccMCF + else + allocate(OutData%WaveAccMCF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAccMCF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveAccMCF) + call RegUnpack(Buf, OutData%WaveAccMCF) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveAccMCF => null() + end if + ! WaveVel + if (associated(OutData%WaveVel)) deallocate(OutData%WaveVel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveVel, UB(1:5)-LB(1:5)) + OutData%WaveVel(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => OutData%WaveVel + else + allocate(OutData%WaveVel(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveVel) + call RegUnpack(Buf, OutData%WaveVel) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveVel => null() + end if + ! PWaveDynP0 + if (associated(OutData%PWaveDynP0)) deallocate(OutData%PWaveDynP0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%PWaveDynP0, UB(1:3)-LB(1:3)) + OutData%PWaveDynP0(LB(1):,LB(2):,LB(3):) => OutData%PWaveDynP0 + else + allocate(OutData%PWaveDynP0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveDynP0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%PWaveDynP0) + call RegUnpack(Buf, OutData%PWaveDynP0) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%PWaveDynP0 => null() + end if + ! PWaveAcc0 + if (associated(OutData%PWaveAcc0)) deallocate(OutData%PWaveAcc0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%PWaveAcc0, UB(1:4)-LB(1:4)) + OutData%PWaveAcc0(LB(1):,LB(2):,LB(3):,LB(4):) => OutData%PWaveAcc0 + else + allocate(OutData%PWaveAcc0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAcc0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%PWaveAcc0) + call RegUnpack(Buf, OutData%PWaveAcc0) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%PWaveAcc0 => null() + end if + ! PWaveAccMCF0 + if (associated(OutData%PWaveAccMCF0)) deallocate(OutData%PWaveAccMCF0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%PWaveAccMCF0, UB(1:4)-LB(1:4)) + OutData%PWaveAccMCF0(LB(1):,LB(2):,LB(3):,LB(4):) => OutData%PWaveAccMCF0 + else + allocate(OutData%PWaveAccMCF0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAccMCF0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%PWaveAccMCF0) + call RegUnpack(Buf, OutData%PWaveAccMCF0) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%PWaveAccMCF0 => null() + end if + ! PWaveVel0 + if (associated(OutData%PWaveVel0)) deallocate(OutData%PWaveVel0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%PWaveVel0, UB(1:4)-LB(1:4)) + OutData%PWaveVel0(LB(1):,LB(2):,LB(3):,LB(4):) => OutData%PWaveVel0 + else + allocate(OutData%PWaveVel0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveVel0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%PWaveVel0) + call RegUnpack(Buf, OutData%PWaveVel0) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%PWaveVel0 => null() + end if + ! WaveElev1 + if (associated(OutData%WaveElev1)) deallocate(OutData%WaveElev1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveElev1, UB(1:3)-LB(1:3)) + OutData%WaveElev1(LB(1):,LB(2):,LB(3):) => OutData%WaveElev1 + else + allocate(OutData%WaveElev1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElev1) + call RegUnpack(Buf, OutData%WaveElev1) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveElev1 => null() + end if + ! WaveElev2 + if (associated(OutData%WaveElev2)) deallocate(OutData%WaveElev2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveElev2, UB(1:3)-LB(1:3)) + OutData%WaveElev2(LB(1):,LB(2):,LB(3):) => OutData%WaveElev2 + else + allocate(OutData%WaveElev2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElev2) + call RegUnpack(Buf, OutData%WaveElev2) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveElev2 => null() + end if + ! WaveElev0 + if (associated(OutData%WaveElev0)) deallocate(OutData%WaveElev0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveElev0, UB(1:1)-LB(1:1)) + OutData%WaveElev0(LB(1):) => OutData%WaveElev0 + else + allocate(OutData%WaveElev0(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElev0) + call RegUnpack(Buf, OutData%WaveElev0) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveElev0 => null() + end if + ! WaveTime + if (associated(OutData%WaveTime)) deallocate(OutData%WaveTime) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveTime, UB(1:1)-LB(1:1)) + OutData%WaveTime(LB(1):) => OutData%WaveTime + else + allocate(OutData%WaveTime(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveTime) + call RegUnpack(Buf, OutData%WaveTime) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveTime => null() + end if + ! RhoXg + call RegUnpack(Buf, OutData%RhoXg) + if (RegCheckErr(Buf, RoutineName)) return + ! NStepWave + call RegUnpack(Buf, OutData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + ! NStepWave2 + call RegUnpack(Buf, OutData%NStepWave2) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveMod + call RegUnpack(Buf, OutData%WaveMod) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveStMod + call RegUnpack(Buf, OutData%WaveStMod) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDirMod + call RegUnpack(Buf, OutData%WaveDirMod) + if (RegCheckErr(Buf, RoutineName)) return + ! WvLowCOff + call RegUnpack(Buf, OutData%WvLowCOff) + if (RegCheckErr(Buf, RoutineName)) return + ! WvHiCOff + call RegUnpack(Buf, OutData%WvHiCOff) + if (RegCheckErr(Buf, RoutineName)) return + ! WvLowCOffD + call RegUnpack(Buf, OutData%WvLowCOffD) + if (RegCheckErr(Buf, RoutineName)) return + ! WvHiCOffD + call RegUnpack(Buf, OutData%WvHiCOffD) + if (RegCheckErr(Buf, RoutineName)) return + ! WvLowCOffS + call RegUnpack(Buf, OutData%WvLowCOffS) + if (RegCheckErr(Buf, RoutineName)) return + ! WvHiCOffS + call RegUnpack(Buf, OutData%WvHiCOffS) + if (RegCheckErr(Buf, RoutineName)) return + ! InvalidWithSSExctn + call RegUnpack(Buf, OutData%InvalidWithSSExctn) + if (RegCheckErr(Buf, RoutineName)) return + ! SeaSt_Interp_p + call SeaSt_Interp_UnpackParam(Buf, OutData%SeaSt_Interp_p) ! SeaSt_Interp_p + ! MCFD + call RegUnpack(Buf, OutData%MCFD) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElevSeries + if (allocated(OutData%WaveElevSeries)) deallocate(OutData%WaveElevSeries) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveElevSeries(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevSeries.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveElevSeries) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WaveField + if (associated(OutData%WaveField)) deallocate(OutData%WaveField) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveField) + else + allocate(OutData%WaveField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveField) + call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(Buf, OutData%WaveField) ! WaveField + end if + else + OutData%WaveField => null() + end if +end subroutine SUBROUTINE SeaSt_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(SeaSt_ContinuousStateType), INTENT(IN) :: SrcContStateData TYPE(SeaSt_ContinuousStateType), INTENT(INOUT) :: DstContStateData @@ -2128,103 +1799,26 @@ SUBROUTINE SeaSt_DestroyContState( ContStateData, ErrStat, ErrMsg ) END SUBROUTINE SeaSt_DestroyContState - SUBROUTINE SeaSt_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(SeaSt_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 = 'SeaSt_PackContState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! UnusedStates - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%UnusedStates - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE SeaSt_PackContState - - SUBROUTINE SeaSt_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(SeaSt_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 = 'SeaSt_UnPackContState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%UnusedStates = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE SeaSt_UnPackContState +subroutine SeaSt_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + ! UnusedStates + call RegPack(Buf, InData%UnusedStates) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SeaSt_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_UnPackContState' + if (Buf%ErrStat /= ErrID_None) return + ! UnusedStates + call RegUnpack(Buf, OutData%UnusedStates) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE SeaSt_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(SeaSt_DiscreteStateType), INTENT(IN) :: SrcDiscStateData TYPE(SeaSt_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData @@ -2257,103 +1851,26 @@ SUBROUTINE SeaSt_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) END SUBROUTINE SeaSt_DestroyDiscState - SUBROUTINE SeaSt_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(SeaSt_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 = 'SeaSt_PackDiscState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! UnusedStates - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%UnusedStates - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE SeaSt_PackDiscState - - SUBROUTINE SeaSt_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(SeaSt_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 = 'SeaSt_UnPackDiscState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%UnusedStates = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE SeaSt_UnPackDiscState +subroutine SeaSt_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + ! UnusedStates + call RegPack(Buf, InData%UnusedStates) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SeaSt_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_UnPackDiscState' + if (Buf%ErrStat /= ErrID_None) return + ! UnusedStates + call RegUnpack(Buf, OutData%UnusedStates) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE SeaSt_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(SeaSt_ConstraintStateType), INTENT(IN) :: SrcConstrStateData TYPE(SeaSt_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData @@ -2386,103 +1903,26 @@ SUBROUTINE SeaSt_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) END SUBROUTINE SeaSt_DestroyConstrState - SUBROUTINE SeaSt_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(SeaSt_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 = 'SeaSt_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 - Db_BufSz = Db_BufSz + 1 ! UnusedStates - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%UnusedStates - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE SeaSt_PackConstrState - - SUBROUTINE SeaSt_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(SeaSt_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 = 'SeaSt_UnPackConstrState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%UnusedStates = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE SeaSt_UnPackConstrState +subroutine SeaSt_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + ! UnusedStates + call RegPack(Buf, InData%UnusedStates) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SeaSt_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + ! UnusedStates + call RegUnpack(Buf, OutData%UnusedStates) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE SeaSt_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(SeaSt_OtherStateType), INTENT(IN) :: SrcOtherStateData TYPE(SeaSt_OtherStateType), INTENT(INOUT) :: DstOtherStateData @@ -2515,103 +1955,26 @@ SUBROUTINE SeaSt_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) END SUBROUTINE SeaSt_DestroyOtherState - SUBROUTINE SeaSt_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(SeaSt_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 = 'SeaSt_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 - Db_BufSz = Db_BufSz + 1 ! UnusedStates - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%UnusedStates - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE SeaSt_PackOtherState - - SUBROUTINE SeaSt_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(SeaSt_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 = 'SeaSt_UnPackOtherState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%UnusedStates = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END SUBROUTINE SeaSt_UnPackOtherState +subroutine SeaSt_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_PackOtherState' + if (Buf%ErrStat >= AbortErrLev) return + ! UnusedStates + call RegPack(Buf, InData%UnusedStates) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SeaSt_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_UnPackOtherState' + if (Buf%ErrStat /= ErrID_None) return + ! UnusedStates + call RegUnpack(Buf, OutData%UnusedStates) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE SeaSt_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) TYPE(SeaSt_MiscVarType), INTENT(IN) :: SrcMiscData TYPE(SeaSt_MiscVarType), INTENT(INOUT) :: DstMiscData @@ -2651,199 +2014,43 @@ SUBROUTINE SeaSt_DestroyMisc( MiscData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE SeaSt_DestroyMisc - SUBROUTINE SeaSt_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(SeaSt_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 = 'SeaSt_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! Decimate - Db_BufSz = Db_BufSz + 1 ! LastOutTime - Int_BufSz = Int_BufSz + 1 ! LastIndWave - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! SeaSt_Interp_m: size of buffers for each call to pack subtype - CALL SeaSt_Interp_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt_Interp_m, ErrStat2, ErrMsg2, .TRUE. ) ! SeaSt_Interp_m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SeaSt_Interp_m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SeaSt_Interp_m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SeaSt_Interp_m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%Decimate - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%LastOutTime - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%LastIndWave - Int_Xferred = Int_Xferred + 1 - CALL SeaSt_Interp_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt_Interp_m, ErrStat2, ErrMsg2, OnlySize ) ! SeaSt_Interp_m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE SeaSt_PackMisc - - SUBROUTINE SeaSt_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(SeaSt_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%Decimate = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%LastOutTime = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%LastIndWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SeaSt_Interp_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%SeaSt_Interp_m, ErrStat2, ErrMsg2 ) ! SeaSt_Interp_m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE SeaSt_UnPackMisc +subroutine SeaSt_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + ! Decimate + call RegPack(Buf, InData%Decimate) + if (RegCheckErr(Buf, RoutineName)) return + ! LastOutTime + call RegPack(Buf, InData%LastOutTime) + if (RegCheckErr(Buf, RoutineName)) return + ! LastIndWave + call RegPack(Buf, InData%LastIndWave) + if (RegCheckErr(Buf, RoutineName)) return + ! SeaSt_Interp_m + call SeaSt_Interp_PackMisc(Buf, InData%SeaSt_Interp_m) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SeaSt_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_UnPackMisc' + if (Buf%ErrStat /= ErrID_None) return + ! Decimate + call RegUnpack(Buf, OutData%Decimate) + if (RegCheckErr(Buf, RoutineName)) return + ! LastOutTime + call RegUnpack(Buf, OutData%LastOutTime) + if (RegCheckErr(Buf, RoutineName)) return + ! LastIndWave + call RegUnpack(Buf, OutData%LastIndWave) + if (RegCheckErr(Buf, RoutineName)) return + ! SeaSt_Interp_m + call SeaSt_Interp_UnpackMisc(Buf, OutData%SeaSt_Interp_m) ! SeaSt_Interp_m +end subroutine SUBROUTINE SeaSt_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(SeaSt_ParameterType), INTENT(IN) :: SrcParamData TYPE(SeaSt_ParameterType), INTENT(INOUT) :: DstParamData @@ -3054,829 +2261,781 @@ SUBROUTINE SeaSt_DestroyParam( ParamData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE SeaSt_DestroyParam - SUBROUTINE SeaSt_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(SeaSt_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 = 'SeaSt_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 ! Waves2: size of buffers for each call to pack subtype - CALL Waves2_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%Waves2, ErrStat2, ErrMsg2, .TRUE. ) ! Waves2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Waves2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Waves2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Waves2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Db_BufSz = Db_BufSz + 1 ! WaveDT - Int_BufSz = Int_BufSz + 1 ! NGridPts - Int_BufSz = Int_BufSz + SIZE(InData%NGrid) ! NGrid - Re_BufSz = Re_BufSz + SIZE(InData%deltaGrid) ! deltaGrid - Re_BufSz = Re_BufSz + 1 ! X_HalfWidth - Re_BufSz = Re_BufSz + 1 ! Y_HalfWidth - Re_BufSz = Re_BufSz + 1 ! Z_Depth - Int_BufSz = Int_BufSz + 1 ! NStepWave - Int_BufSz = Int_BufSz + 1 ! NWaveElev - Int_BufSz = Int_BufSz + 1 ! WaveElevxi allocated yes/no - IF ( ALLOCATED(InData%WaveElevxi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveElevxi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElevxi) ! WaveElevxi - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElevyi allocated yes/no - IF ( ALLOCATED(InData%WaveElevyi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveElevyi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElevyi) ! WaveElevyi - END IF - Int_BufSz = Int_BufSz + 1 ! NWaveKin - Int_BufSz = Int_BufSz + 1 ! WaveKinxi allocated yes/no - IF ( ALLOCATED(InData%WaveKinxi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveKinxi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveKinxi) ! WaveKinxi - END IF - Int_BufSz = Int_BufSz + 1 ! WaveKinyi allocated yes/no - IF ( ALLOCATED(InData%WaveKinyi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveKinyi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveKinyi) ! WaveKinyi - END IF - Int_BufSz = Int_BufSz + 1 ! WaveKinzi allocated yes/no - IF ( ALLOCATED(InData%WaveKinzi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveKinzi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveKinzi) ! WaveKinzi - END IF - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Db_BufSz = Db_BufSz + 1 ! DT - Int_BufSz = Int_BufSz + 1 ! WaveStMod - Int_BufSz = Int_BufSz + 1 ! OutParam allocated yes/no - IF ( ALLOCATED(InData%OutParam) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutParam upper/lower bounds for each dimension - DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - Int_BufSz = Int_BufSz + 3 ! OutParam: size of buffers for each call to pack subtype - CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutParam - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutParam - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutParam - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! OutSwtch - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt - Int_BufSz = Int_BufSz + 1*LEN(InData%OutSFmt) ! OutSFmt - Int_BufSz = Int_BufSz + 1*LEN(InData%Delim) ! Delim - Int_BufSz = Int_BufSz + 1 ! UnOutFile - Int_BufSz = Int_BufSz + 1 ! OutDec - Int_BufSz = Int_BufSz + 3 ! SeaSt_Interp_p: size of buffers for each call to pack subtype - CALL SeaSt_Interp_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt_Interp_p, ErrStat2, ErrMsg2, .TRUE. ) ! SeaSt_Interp_p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SeaSt_Interp_p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SeaSt_Interp_p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SeaSt_Interp_p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! WaveField allocated yes/no - IF ( ASSOCIATED(InData%WaveField) ) THEN - Int_BufSz = Int_BufSz + 2*0 ! WaveField upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + 3 ! WaveField: size of buffers for each call to pack subtype - CALL SeaSt_WaveField_PackSeaSt_WaveFieldType( Re_Buf, Db_Buf, Int_Buf, InData%WaveField, ErrStat2, ErrMsg2, .TRUE. ) ! WaveField - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WaveField - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WaveField - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WaveField - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END 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 Waves2_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%Waves2, ErrStat2, ErrMsg2, OnlySize ) ! Waves2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - DbKiBuf(Db_Xferred) = InData%WaveDT - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NGridPts - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%NGrid,1), UBOUND(InData%NGrid,1) - IntKiBuf(Int_Xferred) = InData%NGrid(i1) - Int_Xferred = Int_Xferred + 1 - END DO - DO i1 = LBOUND(InData%deltaGrid,1), UBOUND(InData%deltaGrid,1) - ReKiBuf(Re_Xferred) = InData%deltaGrid(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%X_HalfWidth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Y_HalfWidth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Z_Depth - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NWaveElev - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveElevxi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevxi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevxi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveElevxi,1), UBOUND(InData%WaveElevxi,1) - ReKiBuf(Re_Xferred) = InData%WaveElevxi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveElevyi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevyi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevyi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveElevyi,1), UBOUND(InData%WaveElevyi,1) - ReKiBuf(Re_Xferred) = InData%WaveElevyi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NWaveKin - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveKinxi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveKinxi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinxi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveKinxi,1), UBOUND(InData%WaveKinxi,1) - ReKiBuf(Re_Xferred) = InData%WaveKinxi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveKinyi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveKinyi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinyi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveKinyi,1), UBOUND(InData%WaveKinyi,1) - ReKiBuf(Re_Xferred) = InData%WaveKinyi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveKinzi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveKinzi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinzi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveKinzi,1), UBOUND(InData%WaveKinzi,1) - ReKiBuf(Re_Xferred) = InData%WaveKinzi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveStMod - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutParam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParam,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%OutSwtch - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutSFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%UnOutFile - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%OutDec - Int_Xferred = Int_Xferred + 1 - CALL SeaSt_Interp_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SeaSt_Interp_p, ErrStat2, ErrMsg2, OnlySize ) ! SeaSt_Interp_p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ASSOCIATED(InData%WaveField) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - - CALL SeaSt_WaveField_PackSeaSt_WaveFieldType( Re_Buf, Db_Buf, Int_Buf, InData%WaveField, ErrStat2, ErrMsg2, OnlySize ) ! WaveField - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END IF - END SUBROUTINE SeaSt_PackParam - - SUBROUTINE SeaSt_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(SeaSt_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_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 Waves2_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%Waves2, ErrStat2, ErrMsg2 ) ! Waves2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - NULLIFY(OutData%WaveTime) - OutData%WaveDT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%NGridPts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%NGrid,1) - i1_u = UBOUND(OutData%NGrid,1) - DO i1 = LBOUND(OutData%NGrid,1), UBOUND(OutData%NGrid,1) - OutData%NGrid(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - i1_l = LBOUND(OutData%deltaGrid,1) - i1_u = UBOUND(OutData%deltaGrid,1) - DO i1 = LBOUND(OutData%deltaGrid,1), UBOUND(OutData%deltaGrid,1) - OutData%deltaGrid(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%X_HalfWidth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Y_HalfWidth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Z_Depth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NStepWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NWaveElev = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevxi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveElevxi)) DEALLOCATE(OutData%WaveElevxi) - ALLOCATE(OutData%WaveElevxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveElevxi,1), UBOUND(OutData%WaveElevxi,1) - OutData%WaveElevxi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevyi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveElevyi)) DEALLOCATE(OutData%WaveElevyi) - ALLOCATE(OutData%WaveElevyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveElevyi,1), UBOUND(OutData%WaveElevyi,1) - OutData%WaveElevyi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - NULLIFY(OutData%WaveElev1) - NULLIFY(OutData%WaveElev2) - NULLIFY(OutData%PWaveDynP0) - NULLIFY(OutData%WaveDynP) - NULLIFY(OutData%WaveAcc) - NULLIFY(OutData%PWaveAcc0) - NULLIFY(OutData%WaveVel) - NULLIFY(OutData%PWaveVel0) - NULLIFY(OutData%WaveAccMCF) - NULLIFY(OutData%WaveDirArr) - NULLIFY(OutData%WaveElevC0) - NULLIFY(OutData%PWaveAccMCF0) - OutData%NWaveKin = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinxi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveKinxi)) DEALLOCATE(OutData%WaveKinxi) - ALLOCATE(OutData%WaveKinxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveKinxi,1), UBOUND(OutData%WaveKinxi,1) - OutData%WaveKinxi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinyi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveKinyi)) DEALLOCATE(OutData%WaveKinyi) - ALLOCATE(OutData%WaveKinyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveKinyi,1), UBOUND(OutData%WaveKinyi,1) - OutData%WaveKinyi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinzi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveKinzi)) DEALLOCATE(OutData%WaveKinzi) - ALLOCATE(OutData%WaveKinzi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinzi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveKinzi,1), UBOUND(OutData%WaveKinzi,1) - OutData%WaveKinzi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%WaveStMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutParam)) DEALLOCATE(OutData%OutParam) - ALLOCATE(OutData%OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutParam,1), UBOUND(OutData%OutParam,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackOutParmType( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%OutSwtch = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutSFmt) - OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UnOutFile = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%OutDec = 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 SeaSt_Interp_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%SeaSt_Interp_p, ErrStat2, ErrMsg2 ) ! SeaSt_Interp_p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveField not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - IF (ASSOCIATED(OutData%WaveField)) DEALLOCATE(OutData%WaveField) - ALLOCATE(OutData%WaveField,STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', ErrStat, ErrMsg,RoutineName) - RETURN - 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 SeaSt_WaveField_UnpackSeaSt_WaveFieldType( Re_Buf, Db_Buf, Int_Buf, OutData%WaveField, ErrStat2, ErrMsg2 ) ! WaveField - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END IF - END SUBROUTINE SeaSt_UnPackParam +subroutine SeaSt_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_PackParam' + integer(IntKi) :: i1, i2, i3, i4, i5 + integer(IntKi) :: LB(5), UB(5) + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + ! Waves2 + call Waves2_PackParam(Buf, InData%Waves2) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveTime + call RegPack(Buf, associated(InData%WaveTime)) + if (associated(InData%WaveTime)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) + call RegPackPointer(Buf, c_loc(InData%WaveTime), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveTime) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDT + call RegPack(Buf, InData%WaveDT) + if (RegCheckErr(Buf, RoutineName)) return + ! NGridPts + call RegPack(Buf, InData%NGridPts) + if (RegCheckErr(Buf, RoutineName)) return + ! NGrid + call RegPack(Buf, InData%NGrid) + if (RegCheckErr(Buf, RoutineName)) return + ! deltaGrid + call RegPack(Buf, InData%deltaGrid) + if (RegCheckErr(Buf, RoutineName)) return + ! X_HalfWidth + call RegPack(Buf, InData%X_HalfWidth) + if (RegCheckErr(Buf, RoutineName)) return + ! Y_HalfWidth + call RegPack(Buf, InData%Y_HalfWidth) + if (RegCheckErr(Buf, RoutineName)) return + ! Z_Depth + call RegPack(Buf, InData%Z_Depth) + if (RegCheckErr(Buf, RoutineName)) return + ! NStepWave + call RegPack(Buf, InData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + ! NWaveElev + call RegPack(Buf, InData%NWaveElev) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElevxi + call RegPack(Buf, allocated(InData%WaveElevxi)) + if (allocated(InData%WaveElevxi)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveElevxi), ubound(InData%WaveElevxi)) + call RegPack(Buf, InData%WaveElevxi) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElevyi + call RegPack(Buf, allocated(InData%WaveElevyi)) + if (allocated(InData%WaveElevyi)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveElevyi), ubound(InData%WaveElevyi)) + call RegPack(Buf, InData%WaveElevyi) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElev1 + call RegPack(Buf, associated(InData%WaveElev1)) + if (associated(InData%WaveElev1)) then + call RegPackBounds(Buf, 3, lbound(InData%WaveElev1), ubound(InData%WaveElev1)) + call RegPackPointer(Buf, c_loc(InData%WaveElev1), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveElev1) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElev2 + call RegPack(Buf, associated(InData%WaveElev2)) + if (associated(InData%WaveElev2)) then + call RegPackBounds(Buf, 3, lbound(InData%WaveElev2), ubound(InData%WaveElev2)) + call RegPackPointer(Buf, c_loc(InData%WaveElev2), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveElev2) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PWaveDynP0 + call RegPack(Buf, associated(InData%PWaveDynP0)) + if (associated(InData%PWaveDynP0)) then + call RegPackBounds(Buf, 3, lbound(InData%PWaveDynP0), ubound(InData%PWaveDynP0)) + call RegPackPointer(Buf, c_loc(InData%PWaveDynP0), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%PWaveDynP0) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDynP + call RegPack(Buf, associated(InData%WaveDynP)) + if (associated(InData%WaveDynP)) then + call RegPackBounds(Buf, 4, lbound(InData%WaveDynP), ubound(InData%WaveDynP)) + call RegPackPointer(Buf, c_loc(InData%WaveDynP), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveDynP) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveAcc + call RegPack(Buf, associated(InData%WaveAcc)) + if (associated(InData%WaveAcc)) then + call RegPackBounds(Buf, 5, lbound(InData%WaveAcc), ubound(InData%WaveAcc)) + call RegPackPointer(Buf, c_loc(InData%WaveAcc), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveAcc) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PWaveAcc0 + call RegPack(Buf, associated(InData%PWaveAcc0)) + if (associated(InData%PWaveAcc0)) then + call RegPackBounds(Buf, 4, lbound(InData%PWaveAcc0), ubound(InData%PWaveAcc0)) + call RegPackPointer(Buf, c_loc(InData%PWaveAcc0), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%PWaveAcc0) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveVel + call RegPack(Buf, associated(InData%WaveVel)) + if (associated(InData%WaveVel)) then + call RegPackBounds(Buf, 5, lbound(InData%WaveVel), ubound(InData%WaveVel)) + call RegPackPointer(Buf, c_loc(InData%WaveVel), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveVel) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PWaveVel0 + call RegPack(Buf, associated(InData%PWaveVel0)) + if (associated(InData%PWaveVel0)) then + call RegPackBounds(Buf, 4, lbound(InData%PWaveVel0), ubound(InData%PWaveVel0)) + call RegPackPointer(Buf, c_loc(InData%PWaveVel0), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%PWaveVel0) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveAccMCF + call RegPack(Buf, associated(InData%WaveAccMCF)) + if (associated(InData%WaveAccMCF)) then + call RegPackBounds(Buf, 5, lbound(InData%WaveAccMCF), ubound(InData%WaveAccMCF)) + call RegPackPointer(Buf, c_loc(InData%WaveAccMCF), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveAccMCF) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDirArr + call RegPack(Buf, associated(InData%WaveDirArr)) + if (associated(InData%WaveDirArr)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveDirArr), ubound(InData%WaveDirArr)) + call RegPackPointer(Buf, c_loc(InData%WaveDirArr), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveDirArr) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElevC0 + call RegPack(Buf, associated(InData%WaveElevC0)) + if (associated(InData%WaveElevC0)) then + call RegPackBounds(Buf, 2, lbound(InData%WaveElevC0), ubound(InData%WaveElevC0)) + call RegPackPointer(Buf, c_loc(InData%WaveElevC0), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveElevC0) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PWaveAccMCF0 + call RegPack(Buf, associated(InData%PWaveAccMCF0)) + if (associated(InData%PWaveAccMCF0)) then + call RegPackBounds(Buf, 4, lbound(InData%PWaveAccMCF0), ubound(InData%PWaveAccMCF0)) + call RegPackPointer(Buf, c_loc(InData%PWaveAccMCF0), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%PWaveAccMCF0) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NWaveKin + call RegPack(Buf, InData%NWaveKin) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveKinxi + call RegPack(Buf, allocated(InData%WaveKinxi)) + if (allocated(InData%WaveKinxi)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveKinxi), ubound(InData%WaveKinxi)) + call RegPack(Buf, InData%WaveKinxi) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveKinyi + call RegPack(Buf, allocated(InData%WaveKinyi)) + if (allocated(InData%WaveKinyi)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveKinyi), ubound(InData%WaveKinyi)) + call RegPack(Buf, InData%WaveKinyi) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveKinzi + call RegPack(Buf, allocated(InData%WaveKinzi)) + if (allocated(InData%WaveKinzi)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveKinzi), ubound(InData%WaveKinzi)) + call RegPack(Buf, InData%WaveKinzi) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDpth + call RegPack(Buf, InData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! DT + call RegPack(Buf, InData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveStMod + call RegPack(Buf, InData%WaveStMod) + if (RegCheckErr(Buf, RoutineName)) return + ! OutParam + call RegPack(Buf, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegPack(Buf, InData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! OutSwtch + call RegPack(Buf, InData%OutSwtch) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFmt + call RegPack(Buf, InData%OutFmt) + if (RegCheckErr(Buf, RoutineName)) return + ! OutSFmt + call RegPack(Buf, InData%OutSFmt) + if (RegCheckErr(Buf, RoutineName)) return + ! Delim + call RegPack(Buf, InData%Delim) + if (RegCheckErr(Buf, RoutineName)) return + ! UnOutFile + call RegPack(Buf, InData%UnOutFile) + if (RegCheckErr(Buf, RoutineName)) return + ! OutDec + call RegPack(Buf, InData%OutDec) + if (RegCheckErr(Buf, RoutineName)) return + ! SeaSt_Interp_p + call SeaSt_Interp_PackParam(Buf, InData%SeaSt_Interp_p) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveField + call RegPack(Buf, associated(InData%WaveField)) + if (associated(InData%WaveField)) then + call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) + if (.not. PtrInIndex) then + call SeaSt_WaveField_PackSeaSt_WaveFieldType(Buf, InData%WaveField) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SeaSt_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_UnPackParam' + integer(IntKi) :: i1, i2, i3, i4, i5 + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + ! Waves2 + call Waves2_UnpackParam(Buf, OutData%Waves2) ! Waves2 + ! WaveTime + if (associated(OutData%WaveTime)) deallocate(OutData%WaveTime) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveTime, UB(1:1)-LB(1:1)) + OutData%WaveTime(LB(1):) => OutData%WaveTime + else + allocate(OutData%WaveTime(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveTime) + call RegUnpack(Buf, OutData%WaveTime) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveTime => null() + end if + ! WaveDT + call RegUnpack(Buf, OutData%WaveDT) + if (RegCheckErr(Buf, RoutineName)) return + ! NGridPts + call RegUnpack(Buf, OutData%NGridPts) + if (RegCheckErr(Buf, RoutineName)) return + ! NGrid + call RegUnpack(Buf, OutData%NGrid) + if (RegCheckErr(Buf, RoutineName)) return + ! deltaGrid + call RegUnpack(Buf, OutData%deltaGrid) + if (RegCheckErr(Buf, RoutineName)) return + ! X_HalfWidth + call RegUnpack(Buf, OutData%X_HalfWidth) + if (RegCheckErr(Buf, RoutineName)) return + ! Y_HalfWidth + call RegUnpack(Buf, OutData%Y_HalfWidth) + if (RegCheckErr(Buf, RoutineName)) return + ! Z_Depth + call RegUnpack(Buf, OutData%Z_Depth) + if (RegCheckErr(Buf, RoutineName)) return + ! NStepWave + call RegUnpack(Buf, OutData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + ! NWaveElev + call RegUnpack(Buf, OutData%NWaveElev) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElevxi + if (allocated(OutData%WaveElevxi)) deallocate(OutData%WaveElevxi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveElevxi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevxi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveElevxi) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WaveElevyi + if (allocated(OutData%WaveElevyi)) deallocate(OutData%WaveElevyi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveElevyi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevyi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveElevyi) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WaveElev1 + if (associated(OutData%WaveElev1)) deallocate(OutData%WaveElev1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveElev1, UB(1:3)-LB(1:3)) + OutData%WaveElev1(LB(1):,LB(2):,LB(3):) => OutData%WaveElev1 + else + allocate(OutData%WaveElev1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElev1) + call RegUnpack(Buf, OutData%WaveElev1) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveElev1 => null() + end if + ! WaveElev2 + if (associated(OutData%WaveElev2)) deallocate(OutData%WaveElev2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveElev2, UB(1:3)-LB(1:3)) + OutData%WaveElev2(LB(1):,LB(2):,LB(3):) => OutData%WaveElev2 + else + allocate(OutData%WaveElev2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElev2) + call RegUnpack(Buf, OutData%WaveElev2) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveElev2 => null() + end if + ! PWaveDynP0 + if (associated(OutData%PWaveDynP0)) deallocate(OutData%PWaveDynP0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%PWaveDynP0, UB(1:3)-LB(1:3)) + OutData%PWaveDynP0(LB(1):,LB(2):,LB(3):) => OutData%PWaveDynP0 + else + allocate(OutData%PWaveDynP0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveDynP0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%PWaveDynP0) + call RegUnpack(Buf, OutData%PWaveDynP0) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%PWaveDynP0 => null() + end if + ! WaveDynP + if (associated(OutData%WaveDynP)) deallocate(OutData%WaveDynP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveDynP, UB(1:4)-LB(1:4)) + OutData%WaveDynP(LB(1):,LB(2):,LB(3):,LB(4):) => OutData%WaveDynP + else + allocate(OutData%WaveDynP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveDynP) + call RegUnpack(Buf, OutData%WaveDynP) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveDynP => null() + end if + ! WaveAcc + if (associated(OutData%WaveAcc)) deallocate(OutData%WaveAcc) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveAcc, UB(1:5)-LB(1:5)) + OutData%WaveAcc(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => OutData%WaveAcc + else + allocate(OutData%WaveAcc(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveAcc) + call RegUnpack(Buf, OutData%WaveAcc) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveAcc => null() + end if + ! PWaveAcc0 + if (associated(OutData%PWaveAcc0)) deallocate(OutData%PWaveAcc0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%PWaveAcc0, UB(1:4)-LB(1:4)) + OutData%PWaveAcc0(LB(1):,LB(2):,LB(3):,LB(4):) => OutData%PWaveAcc0 + else + allocate(OutData%PWaveAcc0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAcc0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%PWaveAcc0) + call RegUnpack(Buf, OutData%PWaveAcc0) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%PWaveAcc0 => null() + end if + ! WaveVel + if (associated(OutData%WaveVel)) deallocate(OutData%WaveVel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveVel, UB(1:5)-LB(1:5)) + OutData%WaveVel(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => OutData%WaveVel + else + allocate(OutData%WaveVel(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveVel) + call RegUnpack(Buf, OutData%WaveVel) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveVel => null() + end if + ! PWaveVel0 + if (associated(OutData%PWaveVel0)) deallocate(OutData%PWaveVel0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%PWaveVel0, UB(1:4)-LB(1:4)) + OutData%PWaveVel0(LB(1):,LB(2):,LB(3):,LB(4):) => OutData%PWaveVel0 + else + allocate(OutData%PWaveVel0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveVel0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%PWaveVel0) + call RegUnpack(Buf, OutData%PWaveVel0) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%PWaveVel0 => null() + end if + ! WaveAccMCF + if (associated(OutData%WaveAccMCF)) deallocate(OutData%WaveAccMCF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveAccMCF, UB(1:5)-LB(1:5)) + OutData%WaveAccMCF(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => OutData%WaveAccMCF + else + allocate(OutData%WaveAccMCF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAccMCF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveAccMCF) + call RegUnpack(Buf, OutData%WaveAccMCF) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveAccMCF => null() + end if + ! WaveDirArr + if (associated(OutData%WaveDirArr)) deallocate(OutData%WaveDirArr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveDirArr, UB(1:1)-LB(1:1)) + OutData%WaveDirArr(LB(1):) => OutData%WaveDirArr + else + allocate(OutData%WaveDirArr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveDirArr) + call RegUnpack(Buf, OutData%WaveDirArr) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveDirArr => null() + end if + ! WaveElevC0 + if (associated(OutData%WaveElevC0)) deallocate(OutData%WaveElevC0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveElevC0, UB(1:2)-LB(1:2)) + OutData%WaveElevC0(LB(1):,LB(2):) => OutData%WaveElevC0 + else + allocate(OutData%WaveElevC0(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElevC0) + call RegUnpack(Buf, OutData%WaveElevC0) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveElevC0 => null() + end if + ! PWaveAccMCF0 + if (associated(OutData%PWaveAccMCF0)) deallocate(OutData%PWaveAccMCF0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%PWaveAccMCF0, UB(1:4)-LB(1:4)) + OutData%PWaveAccMCF0(LB(1):,LB(2):,LB(3):,LB(4):) => OutData%PWaveAccMCF0 + else + allocate(OutData%PWaveAccMCF0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAccMCF0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%PWaveAccMCF0) + call RegUnpack(Buf, OutData%PWaveAccMCF0) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%PWaveAccMCF0 => null() + end if + ! NWaveKin + call RegUnpack(Buf, OutData%NWaveKin) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveKinxi + if (allocated(OutData%WaveKinxi)) deallocate(OutData%WaveKinxi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveKinxi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinxi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveKinxi) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WaveKinyi + if (allocated(OutData%WaveKinyi)) deallocate(OutData%WaveKinyi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveKinyi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinyi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveKinyi) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WaveKinzi + if (allocated(OutData%WaveKinzi)) deallocate(OutData%WaveKinzi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveKinzi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinzi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveKinzi) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WtrDpth + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! DT + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveStMod + call RegUnpack(Buf, OutData%WaveStMod) + if (RegCheckErr(Buf, RoutineName)) return + ! OutParam + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam + end do + end if + ! NumOuts + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! OutSwtch + call RegUnpack(Buf, OutData%OutSwtch) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFmt + call RegUnpack(Buf, OutData%OutFmt) + if (RegCheckErr(Buf, RoutineName)) return + ! OutSFmt + call RegUnpack(Buf, OutData%OutSFmt) + if (RegCheckErr(Buf, RoutineName)) return + ! Delim + call RegUnpack(Buf, OutData%Delim) + if (RegCheckErr(Buf, RoutineName)) return + ! UnOutFile + call RegUnpack(Buf, OutData%UnOutFile) + if (RegCheckErr(Buf, RoutineName)) return + ! OutDec + call RegUnpack(Buf, OutData%OutDec) + if (RegCheckErr(Buf, RoutineName)) return + ! SeaSt_Interp_p + call SeaSt_Interp_UnpackParam(Buf, OutData%SeaSt_Interp_p) ! SeaSt_Interp_p + ! WaveField + if (associated(OutData%WaveField)) deallocate(OutData%WaveField) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveField) + else + allocate(OutData%WaveField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveField.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveField) + call SeaSt_WaveField_UnpackSeaSt_WaveFieldType(Buf, OutData%WaveField) ! WaveField + end if + else + OutData%WaveField => null() + end if +end subroutine SUBROUTINE SeaSt_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(SeaSt_InputType), INTENT(IN) :: SrcInputData TYPE(SeaSt_InputType), INTENT(INOUT) :: DstInputData @@ -3909,103 +3068,26 @@ SUBROUTINE SeaSt_DestroyInput( InputData, ErrStat, ErrMsg ) END SUBROUTINE SeaSt_DestroyInput - SUBROUTINE SeaSt_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(SeaSt_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 = 'SeaSt_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyInput - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyInput - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SeaSt_PackInput - - SUBROUTINE SeaSt_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(SeaSt_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 = 'SeaSt_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyInput = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SeaSt_UnPackInput +subroutine SeaSt_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyInput + call RegPack(Buf, InData%DummyInput) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SeaSt_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_UnPackInput' + if (Buf%ErrStat /= ErrID_None) return + ! DummyInput + call RegUnpack(Buf, OutData%DummyInput) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE SeaSt_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(SeaSt_OutputType), INTENT(IN) :: SrcOutputData TYPE(SeaSt_OutputType), INTENT(INOUT) :: DstOutputData @@ -4053,136 +3135,44 @@ SUBROUTINE SeaSt_DestroyOutput( OutputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE SeaSt_DestroyOutput - SUBROUTINE SeaSt_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(SeaSt_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 = 'SeaSt_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! WriteOutput allocated yes/no - IF ( ALLOCATED(InData%WriteOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutput upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WriteOutput) ! WriteOutput - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) - ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SeaSt_PackOutput - - SUBROUTINE SeaSt_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(SeaSt_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutput)) DEALLOCATE(OutData%WriteOutput) - ALLOCATE(OutData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) - OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SeaSt_UnPackOutput +subroutine SeaSt_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! WriteOutput + call RegPack(Buf, allocated(InData%WriteOutput)) + if (allocated(InData%WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPack(Buf, InData%WriteOutput) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SeaSt_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SeaSt_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_UnPackOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! WriteOutput + if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine END MODULE SeaState_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/src/Waves2_Types.f90 b/modules/seastate/src/Waves2_Types.f90 index c5015bbfae..018da7718e 100644 --- a/modules/seastate/src/Waves2_Types.f90 +++ b/modules/seastate/src/Waves2_Types.f90 @@ -179,308 +179,299 @@ SUBROUTINE Waves2_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE Waves2_DestroyInitInput - SUBROUTINE Waves2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Waves2_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! Gravity - Re_BufSz = Re_BufSz + 1 ! WtrDens - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Int_BufSz = Int_BufSz + 1 ! NStepWave - Int_BufSz = Int_BufSz + 1 ! NStepWave2 - Re_BufSz = Re_BufSz + 1 ! WaveDOmega - Int_BufSz = Int_BufSz + 1 ! WaveStMod - Int_BufSz = Int_BufSz + 1 ! WaveMultiDir - Int_BufSz = Int_BufSz + SIZE(InData%nGrid) ! nGrid - Int_BufSz = Int_BufSz + 1 ! NWaveElevGrid - Int_BufSz = Int_BufSz + 1 ! NWaveKinGrid - Int_BufSz = Int_BufSz + 1 ! WaveKinGridxi allocated yes/no - IF ( ALLOCATED(InData%WaveKinGridxi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveKinGridxi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveKinGridxi) ! WaveKinGridxi - END IF - Int_BufSz = Int_BufSz + 1 ! WaveKinGridyi allocated yes/no - IF ( ALLOCATED(InData%WaveKinGridyi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveKinGridyi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveKinGridyi) ! WaveKinGridyi - END IF - Int_BufSz = Int_BufSz + 1 ! WaveKinGridzi allocated yes/no - IF ( ALLOCATED(InData%WaveKinGridzi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveKinGridzi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveKinGridzi) ! WaveKinGridzi - END IF - Int_BufSz = Int_BufSz + 1 ! WvDiffQTFF - Int_BufSz = Int_BufSz + 1 ! WvSumQTFF - Re_BufSz = Re_BufSz + 1 ! WvLowCOffD - Re_BufSz = Re_BufSz + 1 ! WvHiCOffD - Re_BufSz = Re_BufSz + 1 ! WvLowCOffS - Re_BufSz = Re_BufSz + 1 ! WvHiCOffS - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepWave2 - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDOmega - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveStMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WaveMultiDir, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%nGrid,1), UBOUND(InData%nGrid,1) - IntKiBuf(Int_Xferred) = InData%nGrid(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%NWaveElevGrid - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NWaveKinGrid - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveKinGridxi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveKinGridxi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinGridxi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveKinGridxi,1), UBOUND(InData%WaveKinGridxi,1) - ReKiBuf(Re_Xferred) = InData%WaveKinGridxi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveKinGridyi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveKinGridyi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinGridyi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveKinGridyi,1), UBOUND(InData%WaveKinGridyi,1) - ReKiBuf(Re_Xferred) = InData%WaveKinGridyi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveKinGridzi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveKinGridzi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinGridzi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveKinGridzi,1), UBOUND(InData%WaveKinGridzi,1) - ReKiBuf(Re_Xferred) = InData%WaveKinGridzi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%WvDiffQTFF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WvSumQTFF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WvLowCOffD - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WvHiCOffD - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WvLowCOffS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WvHiCOffS - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Waves2_PackInitInput - - SUBROUTINE Waves2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Waves2_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%Gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NStepWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NStepWave2 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WaveDOmega = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveStMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WaveMultiDir = TRANSFER(IntKiBuf(Int_Xferred), OutData%WaveMultiDir) - Int_Xferred = Int_Xferred + 1 - NULLIFY(OutData%WaveDirArr) - NULLIFY(OutData%WaveElevC0) - NULLIFY(OutData%WaveTime) - i1_l = LBOUND(OutData%nGrid,1) - i1_u = UBOUND(OutData%nGrid,1) - DO i1 = LBOUND(OutData%nGrid,1), UBOUND(OutData%nGrid,1) - OutData%nGrid(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%NWaveElevGrid = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NWaveKinGrid = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinGridxi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveKinGridxi)) DEALLOCATE(OutData%WaveKinGridxi) - ALLOCATE(OutData%WaveKinGridxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinGridxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveKinGridxi,1), UBOUND(OutData%WaveKinGridxi,1) - OutData%WaveKinGridxi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinGridyi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveKinGridyi)) DEALLOCATE(OutData%WaveKinGridyi) - ALLOCATE(OutData%WaveKinGridyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinGridyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveKinGridyi,1), UBOUND(OutData%WaveKinGridyi,1) - OutData%WaveKinGridyi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinGridzi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveKinGridzi)) DEALLOCATE(OutData%WaveKinGridzi) - ALLOCATE(OutData%WaveKinGridzi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinGridzi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveKinGridzi,1), UBOUND(OutData%WaveKinGridzi,1) - OutData%WaveKinGridzi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%WvDiffQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%WvDiffQTFF) - Int_Xferred = Int_Xferred + 1 - OutData%WvSumQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%WvSumQTFF) - Int_Xferred = Int_Xferred + 1 - OutData%WvLowCOffD = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WvHiCOffD = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WvLowCOffS = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WvHiCOffS = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Waves2_UnPackInitInput +subroutine Waves2_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Waves2_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Waves2_PackInitInput' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + ! Gravity + call RegPack(Buf, InData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDens + call RegPack(Buf, InData%WtrDens) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDpth + call RegPack(Buf, InData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! NStepWave + call RegPack(Buf, InData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + ! NStepWave2 + call RegPack(Buf, InData%NStepWave2) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDOmega + call RegPack(Buf, InData%WaveDOmega) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveStMod + call RegPack(Buf, InData%WaveStMod) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveMultiDir + call RegPack(Buf, InData%WaveMultiDir) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDirArr + call RegPack(Buf, associated(InData%WaveDirArr)) + if (associated(InData%WaveDirArr)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveDirArr), ubound(InData%WaveDirArr)) + call RegPackPointer(Buf, c_loc(InData%WaveDirArr), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveDirArr) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElevC0 + call RegPack(Buf, associated(InData%WaveElevC0)) + if (associated(InData%WaveElevC0)) then + call RegPackBounds(Buf, 2, lbound(InData%WaveElevC0), ubound(InData%WaveElevC0)) + call RegPackPointer(Buf, c_loc(InData%WaveElevC0), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveElevC0) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveTime + call RegPack(Buf, associated(InData%WaveTime)) + if (associated(InData%WaveTime)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) + call RegPackPointer(Buf, c_loc(InData%WaveTime), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveTime) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! nGrid + call RegPack(Buf, InData%nGrid) + if (RegCheckErr(Buf, RoutineName)) return + ! NWaveElevGrid + call RegPack(Buf, InData%NWaveElevGrid) + if (RegCheckErr(Buf, RoutineName)) return + ! NWaveKinGrid + call RegPack(Buf, InData%NWaveKinGrid) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveKinGridxi + call RegPack(Buf, allocated(InData%WaveKinGridxi)) + if (allocated(InData%WaveKinGridxi)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridxi), ubound(InData%WaveKinGridxi)) + call RegPack(Buf, InData%WaveKinGridxi) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveKinGridyi + call RegPack(Buf, allocated(InData%WaveKinGridyi)) + if (allocated(InData%WaveKinGridyi)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridyi), ubound(InData%WaveKinGridyi)) + call RegPack(Buf, InData%WaveKinGridyi) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveKinGridzi + call RegPack(Buf, allocated(InData%WaveKinGridzi)) + if (allocated(InData%WaveKinGridzi)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridzi), ubound(InData%WaveKinGridzi)) + call RegPack(Buf, InData%WaveKinGridzi) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WvDiffQTFF + call RegPack(Buf, InData%WvDiffQTFF) + if (RegCheckErr(Buf, RoutineName)) return + ! WvSumQTFF + call RegPack(Buf, InData%WvSumQTFF) + if (RegCheckErr(Buf, RoutineName)) return + ! WvLowCOffD + call RegPack(Buf, InData%WvLowCOffD) + if (RegCheckErr(Buf, RoutineName)) return + ! WvHiCOffD + call RegPack(Buf, InData%WvHiCOffD) + if (RegCheckErr(Buf, RoutineName)) return + ! WvLowCOffS + call RegPack(Buf, InData%WvLowCOffS) + if (RegCheckErr(Buf, RoutineName)) return + ! WvHiCOffS + call RegPack(Buf, InData%WvHiCOffS) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Waves2_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Waves2_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Waves2_UnPackInitInput' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + ! Gravity + call RegUnpack(Buf, OutData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDens + call RegUnpack(Buf, OutData%WtrDens) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDpth + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! NStepWave + call RegUnpack(Buf, OutData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + ! NStepWave2 + call RegUnpack(Buf, OutData%NStepWave2) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDOmega + call RegUnpack(Buf, OutData%WaveDOmega) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveStMod + call RegUnpack(Buf, OutData%WaveStMod) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveMultiDir + call RegUnpack(Buf, OutData%WaveMultiDir) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDirArr + if (associated(OutData%WaveDirArr)) deallocate(OutData%WaveDirArr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveDirArr, UB(1:1)-LB(1:1)) + OutData%WaveDirArr(LB(1):) => OutData%WaveDirArr + else + allocate(OutData%WaveDirArr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveDirArr) + call RegUnpack(Buf, OutData%WaveDirArr) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveDirArr => null() + end if + ! WaveElevC0 + if (associated(OutData%WaveElevC0)) deallocate(OutData%WaveElevC0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveElevC0, UB(1:2)-LB(1:2)) + OutData%WaveElevC0(LB(1):,LB(2):) => OutData%WaveElevC0 + else + allocate(OutData%WaveElevC0(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElevC0) + call RegUnpack(Buf, OutData%WaveElevC0) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveElevC0 => null() + end if + ! WaveTime + if (associated(OutData%WaveTime)) deallocate(OutData%WaveTime) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveTime, UB(1:1)-LB(1:1)) + OutData%WaveTime(LB(1):) => OutData%WaveTime + else + allocate(OutData%WaveTime(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveTime) + call RegUnpack(Buf, OutData%WaveTime) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveTime => null() + end if + ! nGrid + call RegUnpack(Buf, OutData%nGrid) + if (RegCheckErr(Buf, RoutineName)) return + ! NWaveElevGrid + call RegUnpack(Buf, OutData%NWaveElevGrid) + if (RegCheckErr(Buf, RoutineName)) return + ! NWaveKinGrid + call RegUnpack(Buf, OutData%NWaveKinGrid) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveKinGridxi + if (allocated(OutData%WaveKinGridxi)) deallocate(OutData%WaveKinGridxi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveKinGridxi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinGridxi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveKinGridxi) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WaveKinGridyi + if (allocated(OutData%WaveKinGridyi)) deallocate(OutData%WaveKinGridyi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveKinGridyi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinGridyi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveKinGridyi) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WaveKinGridzi + if (allocated(OutData%WaveKinGridzi)) deallocate(OutData%WaveKinGridzi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveKinGridzi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinGridzi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveKinGridzi) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WvDiffQTFF + call RegUnpack(Buf, OutData%WvDiffQTFF) + if (RegCheckErr(Buf, RoutineName)) return + ! WvSumQTFF + call RegUnpack(Buf, OutData%WvSumQTFF) + if (RegCheckErr(Buf, RoutineName)) return + ! WvLowCOffD + call RegUnpack(Buf, OutData%WvLowCOffD) + if (RegCheckErr(Buf, RoutineName)) return + ! WvHiCOffD + call RegUnpack(Buf, OutData%WvHiCOffD) + if (RegCheckErr(Buf, RoutineName)) return + ! WvLowCOffS + call RegUnpack(Buf, OutData%WvLowCOffS) + if (RegCheckErr(Buf, RoutineName)) return + ! WvHiCOffS + call RegUnpack(Buf, OutData%WvHiCOffS) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE Waves2_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(Waves2_InitOutputType), INTENT(IN) :: SrcInitOutputData TYPE(Waves2_InitOutputType), INTENT(INOUT) :: DstInitOutputData @@ -653,552 +644,193 @@ SUBROUTINE Waves2_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) NULLIFY(InitOutputData%WaveElev2) END SUBROUTINE Waves2_DestroyInitOutput - SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Waves2_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! WaveAcc2D allocated yes/no - IF ( ALLOCATED(InData%WaveAcc2D) ) THEN - Int_BufSz = Int_BufSz + 2*5 ! WaveAcc2D upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveAcc2D) ! WaveAcc2D - END IF - Int_BufSz = Int_BufSz + 1 ! WaveDynP2D allocated yes/no - IF ( ALLOCATED(InData%WaveDynP2D) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! WaveDynP2D upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveDynP2D) ! WaveDynP2D - END IF - Int_BufSz = Int_BufSz + 1 ! WaveAcc2S allocated yes/no - IF ( ALLOCATED(InData%WaveAcc2S) ) THEN - Int_BufSz = Int_BufSz + 2*5 ! WaveAcc2S upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveAcc2S) ! WaveAcc2S - END IF - Int_BufSz = Int_BufSz + 1 ! WaveDynP2S allocated yes/no - IF ( ALLOCATED(InData%WaveDynP2S) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! WaveDynP2S upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveDynP2S) ! WaveDynP2S - END IF - Int_BufSz = Int_BufSz + 1 ! WaveVel2D allocated yes/no - IF ( ALLOCATED(InData%WaveVel2D) ) THEN - Int_BufSz = Int_BufSz + 2*5 ! WaveVel2D upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveVel2D) ! WaveVel2D - END IF - Int_BufSz = Int_BufSz + 1 ! WaveVel2S allocated yes/no - IF ( ALLOCATED(InData%WaveVel2S) ) THEN - Int_BufSz = Int_BufSz + 2*5 ! WaveVel2S upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveVel2S) ! WaveVel2S - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END 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%WaveAcc2D) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2D,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2D,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2D,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2D,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2D,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2D,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2D,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2D,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2D,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2D,5) - Int_Xferred = Int_Xferred + 2 - - DO i5 = LBOUND(InData%WaveAcc2D,5), UBOUND(InData%WaveAcc2D,5) - DO i4 = LBOUND(InData%WaveAcc2D,4), UBOUND(InData%WaveAcc2D,4) - DO i3 = LBOUND(InData%WaveAcc2D,3), UBOUND(InData%WaveAcc2D,3) - DO i2 = LBOUND(InData%WaveAcc2D,2), UBOUND(InData%WaveAcc2D,2) - DO i1 = LBOUND(InData%WaveAcc2D,1), UBOUND(InData%WaveAcc2D,1) - ReKiBuf(Re_Xferred) = InData%WaveAcc2D(i1,i2,i3,i4,i5) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveDynP2D) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP2D,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2D,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP2D,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2D,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP2D,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2D,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP2D,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2D,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%WaveDynP2D,4), UBOUND(InData%WaveDynP2D,4) - DO i3 = LBOUND(InData%WaveDynP2D,3), UBOUND(InData%WaveDynP2D,3) - DO i2 = LBOUND(InData%WaveDynP2D,2), UBOUND(InData%WaveDynP2D,2) - DO i1 = LBOUND(InData%WaveDynP2D,1), UBOUND(InData%WaveDynP2D,1) - ReKiBuf(Re_Xferred) = InData%WaveDynP2D(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveAcc2S) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2S,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2S,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2S,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2S,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2S,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2S,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2S,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2S,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2S,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2S,5) - Int_Xferred = Int_Xferred + 2 - - DO i5 = LBOUND(InData%WaveAcc2S,5), UBOUND(InData%WaveAcc2S,5) - DO i4 = LBOUND(InData%WaveAcc2S,4), UBOUND(InData%WaveAcc2S,4) - DO i3 = LBOUND(InData%WaveAcc2S,3), UBOUND(InData%WaveAcc2S,3) - DO i2 = LBOUND(InData%WaveAcc2S,2), UBOUND(InData%WaveAcc2S,2) - DO i1 = LBOUND(InData%WaveAcc2S,1), UBOUND(InData%WaveAcc2S,1) - ReKiBuf(Re_Xferred) = InData%WaveAcc2S(i1,i2,i3,i4,i5) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveDynP2S) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP2S,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2S,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP2S,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2S,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP2S,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2S,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP2S,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2S,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%WaveDynP2S,4), UBOUND(InData%WaveDynP2S,4) - DO i3 = LBOUND(InData%WaveDynP2S,3), UBOUND(InData%WaveDynP2S,3) - DO i2 = LBOUND(InData%WaveDynP2S,2), UBOUND(InData%WaveDynP2S,2) - DO i1 = LBOUND(InData%WaveDynP2S,1), UBOUND(InData%WaveDynP2S,1) - ReKiBuf(Re_Xferred) = InData%WaveDynP2S(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveVel2D) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2D,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2D,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2D,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2D,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2D,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2D,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2D,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2D,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2D,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2D,5) - Int_Xferred = Int_Xferred + 2 - - DO i5 = LBOUND(InData%WaveVel2D,5), UBOUND(InData%WaveVel2D,5) - DO i4 = LBOUND(InData%WaveVel2D,4), UBOUND(InData%WaveVel2D,4) - DO i3 = LBOUND(InData%WaveVel2D,3), UBOUND(InData%WaveVel2D,3) - DO i2 = LBOUND(InData%WaveVel2D,2), UBOUND(InData%WaveVel2D,2) - DO i1 = LBOUND(InData%WaveVel2D,1), UBOUND(InData%WaveVel2D,1) - ReKiBuf(Re_Xferred) = InData%WaveVel2D(i1,i2,i3,i4,i5) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveVel2S) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2S,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2S,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2S,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2S,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2S,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2S,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2S,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2S,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2S,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2S,5) - Int_Xferred = Int_Xferred + 2 - - DO i5 = LBOUND(InData%WaveVel2S,5), UBOUND(InData%WaveVel2S,5) - DO i4 = LBOUND(InData%WaveVel2S,4), UBOUND(InData%WaveVel2S,4) - DO i3 = LBOUND(InData%WaveVel2S,3), UBOUND(InData%WaveVel2S,3) - DO i2 = LBOUND(InData%WaveVel2S,2), UBOUND(InData%WaveVel2S,2) - DO i1 = LBOUND(InData%WaveVel2S,1), UBOUND(InData%WaveVel2S,1) - ReKiBuf(Re_Xferred) = InData%WaveVel2S(i1,i2,i3,i4,i5) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - END SUBROUTINE Waves2_PackInitOutput - - SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Waves2_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc2D not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i5_l = IntKiBuf( Int_Xferred ) - i5_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveAcc2D)) DEALLOCATE(OutData%WaveAcc2D) - ALLOCATE(OutData%WaveAcc2D(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc2D.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i5 = LBOUND(OutData%WaveAcc2D,5), UBOUND(OutData%WaveAcc2D,5) - DO i4 = LBOUND(OutData%WaveAcc2D,4), UBOUND(OutData%WaveAcc2D,4) - DO i3 = LBOUND(OutData%WaveAcc2D,3), UBOUND(OutData%WaveAcc2D,3) - DO i2 = LBOUND(OutData%WaveAcc2D,2), UBOUND(OutData%WaveAcc2D,2) - DO i1 = LBOUND(OutData%WaveAcc2D,1), UBOUND(OutData%WaveAcc2D,1) - OutData%WaveAcc2D(i1,i2,i3,i4,i5) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP2D not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveDynP2D)) DEALLOCATE(OutData%WaveDynP2D) - ALLOCATE(OutData%WaveDynP2D(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP2D.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%WaveDynP2D,4), UBOUND(OutData%WaveDynP2D,4) - DO i3 = LBOUND(OutData%WaveDynP2D,3), UBOUND(OutData%WaveDynP2D,3) - DO i2 = LBOUND(OutData%WaveDynP2D,2), UBOUND(OutData%WaveDynP2D,2) - DO i1 = LBOUND(OutData%WaveDynP2D,1), UBOUND(OutData%WaveDynP2D,1) - OutData%WaveDynP2D(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc2S not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i5_l = IntKiBuf( Int_Xferred ) - i5_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveAcc2S)) DEALLOCATE(OutData%WaveAcc2S) - ALLOCATE(OutData%WaveAcc2S(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc2S.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i5 = LBOUND(OutData%WaveAcc2S,5), UBOUND(OutData%WaveAcc2S,5) - DO i4 = LBOUND(OutData%WaveAcc2S,4), UBOUND(OutData%WaveAcc2S,4) - DO i3 = LBOUND(OutData%WaveAcc2S,3), UBOUND(OutData%WaveAcc2S,3) - DO i2 = LBOUND(OutData%WaveAcc2S,2), UBOUND(OutData%WaveAcc2S,2) - DO i1 = LBOUND(OutData%WaveAcc2S,1), UBOUND(OutData%WaveAcc2S,1) - OutData%WaveAcc2S(i1,i2,i3,i4,i5) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP2S not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveDynP2S)) DEALLOCATE(OutData%WaveDynP2S) - ALLOCATE(OutData%WaveDynP2S(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP2S.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%WaveDynP2S,4), UBOUND(OutData%WaveDynP2S,4) - DO i3 = LBOUND(OutData%WaveDynP2S,3), UBOUND(OutData%WaveDynP2S,3) - DO i2 = LBOUND(OutData%WaveDynP2S,2), UBOUND(OutData%WaveDynP2S,2) - DO i1 = LBOUND(OutData%WaveDynP2S,1), UBOUND(OutData%WaveDynP2S,1) - OutData%WaveDynP2S(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel2D not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i5_l = IntKiBuf( Int_Xferred ) - i5_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveVel2D)) DEALLOCATE(OutData%WaveVel2D) - ALLOCATE(OutData%WaveVel2D(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel2D.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i5 = LBOUND(OutData%WaveVel2D,5), UBOUND(OutData%WaveVel2D,5) - DO i4 = LBOUND(OutData%WaveVel2D,4), UBOUND(OutData%WaveVel2D,4) - DO i3 = LBOUND(OutData%WaveVel2D,3), UBOUND(OutData%WaveVel2D,3) - DO i2 = LBOUND(OutData%WaveVel2D,2), UBOUND(OutData%WaveVel2D,2) - DO i1 = LBOUND(OutData%WaveVel2D,1), UBOUND(OutData%WaveVel2D,1) - OutData%WaveVel2D(i1,i2,i3,i4,i5) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel2S not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i5_l = IntKiBuf( Int_Xferred ) - i5_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveVel2S)) DEALLOCATE(OutData%WaveVel2S) - ALLOCATE(OutData%WaveVel2S(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel2S.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i5 = LBOUND(OutData%WaveVel2S,5), UBOUND(OutData%WaveVel2S,5) - DO i4 = LBOUND(OutData%WaveVel2S,4), UBOUND(OutData%WaveVel2S,4) - DO i3 = LBOUND(OutData%WaveVel2S,3), UBOUND(OutData%WaveVel2S,3) - DO i2 = LBOUND(OutData%WaveVel2S,2), UBOUND(OutData%WaveVel2S,2) - DO i1 = LBOUND(OutData%WaveVel2S,1), UBOUND(OutData%WaveVel2S,1) - OutData%WaveVel2S(i1,i2,i3,i4,i5) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF - NULLIFY(OutData%WaveElev2) - END SUBROUTINE Waves2_UnPackInitOutput +subroutine Waves2_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Waves2_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Waves2_PackInitOutput' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + ! WaveAcc2D + call RegPack(Buf, allocated(InData%WaveAcc2D)) + if (allocated(InData%WaveAcc2D)) then + call RegPackBounds(Buf, 5, lbound(InData%WaveAcc2D), ubound(InData%WaveAcc2D)) + call RegPack(Buf, InData%WaveAcc2D) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDynP2D + call RegPack(Buf, allocated(InData%WaveDynP2D)) + if (allocated(InData%WaveDynP2D)) then + call RegPackBounds(Buf, 4, lbound(InData%WaveDynP2D), ubound(InData%WaveDynP2D)) + call RegPack(Buf, InData%WaveDynP2D) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveAcc2S + call RegPack(Buf, allocated(InData%WaveAcc2S)) + if (allocated(InData%WaveAcc2S)) then + call RegPackBounds(Buf, 5, lbound(InData%WaveAcc2S), ubound(InData%WaveAcc2S)) + call RegPack(Buf, InData%WaveAcc2S) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDynP2S + call RegPack(Buf, allocated(InData%WaveDynP2S)) + if (allocated(InData%WaveDynP2S)) then + call RegPackBounds(Buf, 4, lbound(InData%WaveDynP2S), ubound(InData%WaveDynP2S)) + call RegPack(Buf, InData%WaveDynP2S) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveVel2D + call RegPack(Buf, allocated(InData%WaveVel2D)) + if (allocated(InData%WaveVel2D)) then + call RegPackBounds(Buf, 5, lbound(InData%WaveVel2D), ubound(InData%WaveVel2D)) + call RegPack(Buf, InData%WaveVel2D) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveVel2S + call RegPack(Buf, allocated(InData%WaveVel2S)) + if (allocated(InData%WaveVel2S)) then + call RegPackBounds(Buf, 5, lbound(InData%WaveVel2S), ubound(InData%WaveVel2S)) + call RegPack(Buf, InData%WaveVel2S) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElev2 + call RegPack(Buf, associated(InData%WaveElev2)) + if (associated(InData%WaveElev2)) then + call RegPackBounds(Buf, 3, lbound(InData%WaveElev2), ubound(InData%WaveElev2)) + call RegPackPointer(Buf, c_loc(InData%WaveElev2), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveElev2) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Waves2_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Waves2_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Waves2_UnPackInitOutput' + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + ! WaveAcc2D + if (allocated(OutData%WaveAcc2D)) deallocate(OutData%WaveAcc2D) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveAcc2D(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc2D.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveAcc2D) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WaveDynP2D + if (allocated(OutData%WaveDynP2D)) deallocate(OutData%WaveDynP2D) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveDynP2D(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP2D.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveDynP2D) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WaveAcc2S + if (allocated(OutData%WaveAcc2S)) deallocate(OutData%WaveAcc2S) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveAcc2S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc2S.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveAcc2S) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WaveDynP2S + if (allocated(OutData%WaveDynP2S)) deallocate(OutData%WaveDynP2S) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveDynP2S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP2S.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveDynP2S) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WaveVel2D + if (allocated(OutData%WaveVel2D)) deallocate(OutData%WaveVel2D) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveVel2D(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel2D.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveVel2D) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WaveVel2S + if (allocated(OutData%WaveVel2S)) deallocate(OutData%WaveVel2S) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveVel2S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel2S.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveVel2S) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WaveElev2 + if (associated(OutData%WaveElev2)) deallocate(OutData%WaveElev2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveElev2, UB(1:3)-LB(1:3)) + OutData%WaveElev2(LB(1):,LB(2):,LB(3):) => OutData%WaveElev2 + else + allocate(OutData%WaveElev2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElev2) + call RegUnpack(Buf, OutData%WaveElev2) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveElev2 => null() + end if +end subroutine SUBROUTINE Waves2_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(Waves2_ParameterType), INTENT(IN) :: SrcParamData TYPE(Waves2_ParameterType), INTENT(INOUT) :: DstParamData @@ -1232,107 +864,31 @@ SUBROUTINE Waves2_DestroyParam( ParamData, ErrStat, ErrMsg ) END SUBROUTINE Waves2_DestroyParam - SUBROUTINE Waves2_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Waves2_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! WvDiffQTFF - Int_BufSz = Int_BufSz + 1 ! WvSumQTFF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = TRANSFER(InData%WvDiffQTFF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WvSumQTFF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Waves2_PackParam - - SUBROUTINE Waves2_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Waves2_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%WvDiffQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%WvDiffQTFF) - Int_Xferred = Int_Xferred + 1 - OutData%WvSumQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%WvSumQTFF) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Waves2_UnPackParam +subroutine Waves2_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Waves2_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Waves2_PackParam' + if (Buf%ErrStat >= AbortErrLev) return + ! WvDiffQTFF + call RegPack(Buf, InData%WvDiffQTFF) + if (RegCheckErr(Buf, RoutineName)) return + ! WvSumQTFF + call RegPack(Buf, InData%WvSumQTFF) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine Waves2_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Waves2_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Waves2_UnPackParam' + if (Buf%ErrStat /= ErrID_None) return + ! WvDiffQTFF + call RegUnpack(Buf, OutData%WvDiffQTFF) + if (RegCheckErr(Buf, RoutineName)) return + ! WvSumQTFF + call RegUnpack(Buf, OutData%WvSumQTFF) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine END MODULE Waves2_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/seastate/src/Waves_Types.f90 b/modules/seastate/src/Waves_Types.f90 index 2384e74cb7..71e3d448c3 100644 --- a/modules/seastate/src/Waves_Types.f90 +++ b/modules/seastate/src/Waves_Types.f90 @@ -262,607 +262,378 @@ SUBROUTINE Waves_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE Waves_DestroyInitInput - SUBROUTINE Waves_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Waves_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%InputFile) ! InputFile - Int_BufSz = Int_BufSz + 1*LEN(InData%DirRoot) ! DirRoot - Int_BufSz = Int_BufSz + 1*LEN(InData%WvKinFile) ! WvKinFile - Re_BufSz = Re_BufSz + 1 ! Gravity - Int_BufSz = Int_BufSz + SIZE(InData%nGrid) ! nGrid - Re_BufSz = Re_BufSz + 1 ! WvLowCOff - Re_BufSz = Re_BufSz + 1 ! WvHiCOff - Re_BufSz = Re_BufSz + 1 ! WaveDir - Int_BufSz = Int_BufSz + 1 ! WaveNDir - Int_BufSz = Int_BufSz + 1 ! WaveMultiDir - Int_BufSz = Int_BufSz + 1 ! WaveDirMod - Re_BufSz = Re_BufSz + 1 ! WaveDirSpread - Re_BufSz = Re_BufSz + 1 ! WaveDirRange - Db_BufSz = Db_BufSz + 1 ! WaveDT - Re_BufSz = Re_BufSz + 1 ! WaveHs - Int_BufSz = Int_BufSz + 1 ! WaveMod - Int_BufSz = Int_BufSz + 1*LEN(InData%WaveModChr) ! WaveModChr - Int_BufSz = Int_BufSz + 1 ! WaveNDAmp - Re_BufSz = Re_BufSz + 1 ! WavePhase - Re_BufSz = Re_BufSz + 1 ! WavePkShp - Int_BufSz = Int_BufSz + 1*LEN(InData%WavePkShpChr) ! WavePkShpChr - Int_BufSz = Int_BufSz + SIZE(InData%WaveSeed) ! WaveSeed - Int_BufSz = Int_BufSz + 1 ! WaveStMod - Db_BufSz = Db_BufSz + 1 ! WaveTMax - Re_BufSz = Re_BufSz + 1 ! WaveTp - Re_BufSz = Re_BufSz + 1 ! WtrDens - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Int_BufSz = Int_BufSz + 1 ! NWaveElevGrid - Int_BufSz = Int_BufSz + 1 ! NWaveKinGrid - Int_BufSz = Int_BufSz + 1 ! WaveKinGridxi allocated yes/no - IF ( ALLOCATED(InData%WaveKinGridxi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveKinGridxi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveKinGridxi) ! WaveKinGridxi - END IF - Int_BufSz = Int_BufSz + 1 ! WaveKinGridyi allocated yes/no - IF ( ALLOCATED(InData%WaveKinGridyi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveKinGridyi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveKinGridyi) ! WaveKinGridyi - END IF - Int_BufSz = Int_BufSz + 1 ! WaveKinGridzi allocated yes/no - IF ( ALLOCATED(InData%WaveKinGridzi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveKinGridzi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveKinGridzi) ! WaveKinGridzi - END IF - Int_BufSz = Int_BufSz + 1 ! CurrVxi allocated yes/no - IF ( ALLOCATED(InData%CurrVxi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CurrVxi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CurrVxi) ! CurrVxi - END IF - Int_BufSz = Int_BufSz + 1 ! CurrVyi allocated yes/no - IF ( ALLOCATED(InData%CurrVyi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CurrVyi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CurrVyi) ! CurrVyi - END IF - Re_BufSz = Re_BufSz + 1 ! PCurrVxiPz0 - Re_BufSz = Re_BufSz + 1 ! PCurrVyiPz0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! RNG: size of buffers for each call to pack subtype - CALL NWTC_Library_PackNWTC_RandomNumber_ParameterType( Re_Buf, Db_Buf, Int_Buf, InData%RNG, ErrStat2, ErrMsg2, .TRUE. ) ! RNG - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! RNG - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! RNG - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! RNG - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! ConstWaveMod - Re_BufSz = Re_BufSz + 1 ! CrestHmax - Re_BufSz = Re_BufSz + 1 ! CrestTime - Re_BufSz = Re_BufSz + 1 ! CrestXi - Re_BufSz = Re_BufSz + 1 ! CrestYi - Re_BufSz = Re_BufSz + 1 ! MCFD - Int_BufSz = Int_BufSz + 1 ! WaveFieldMod - Re_BufSz = Re_BufSz + 1 ! PtfmLocationX - Re_BufSz = Re_BufSz + 1 ! PtfmLocationY - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%DirRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%DirRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%WvKinFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%WvKinFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf(Re_Xferred) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%nGrid,1), UBOUND(InData%nGrid,1) - IntKiBuf(Int_Xferred) = InData%nGrid(i1) - Int_Xferred = Int_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%WvLowCOff - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WvHiCOff - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDir - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveNDir - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WaveMultiDir, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveDirMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDirSpread - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDirRange - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%WaveDT - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveHs - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveMod - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%WaveModChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%WaveModChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%WaveNDAmp, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WavePhase - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WavePkShp - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%WavePkShpChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%WavePkShpChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO i1 = LBOUND(InData%WaveSeed,1), UBOUND(InData%WaveSeed,1) - IntKiBuf(Int_Xferred) = InData%WaveSeed(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%WaveStMod - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%WaveTMax - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveTp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NWaveElevGrid - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NWaveKinGrid - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveKinGridxi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveKinGridxi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinGridxi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveKinGridxi,1), UBOUND(InData%WaveKinGridxi,1) - ReKiBuf(Re_Xferred) = InData%WaveKinGridxi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveKinGridyi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveKinGridyi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinGridyi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveKinGridyi,1), UBOUND(InData%WaveKinGridyi,1) - ReKiBuf(Re_Xferred) = InData%WaveKinGridyi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveKinGridzi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveKinGridzi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinGridzi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveKinGridzi,1), UBOUND(InData%WaveKinGridzi,1) - ReKiBuf(Re_Xferred) = InData%WaveKinGridzi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CurrVxi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CurrVxi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CurrVxi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CurrVxi,1), UBOUND(InData%CurrVxi,1) - ReKiBuf(Re_Xferred) = InData%CurrVxi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CurrVyi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CurrVyi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CurrVyi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CurrVyi,1), UBOUND(InData%CurrVyi,1) - ReKiBuf(Re_Xferred) = InData%CurrVyi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%PCurrVxiPz0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PCurrVyiPz0 - Re_Xferred = Re_Xferred + 1 - CALL NWTC_Library_PackNWTC_RandomNumber_ParameterType( Re_Buf, Db_Buf, Int_Buf, InData%RNG, ErrStat2, ErrMsg2, OnlySize ) ! RNG - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = InData%ConstWaveMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CrestHmax - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CrestTime - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CrestXi - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CrestYi - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MCFD - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveFieldMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmLocationX - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmLocationY - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Waves_PackInitInput - - SUBROUTINE Waves_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Waves_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%DirRoot) - OutData%DirRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%WvKinFile) - OutData%WvKinFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%nGrid,1) - i1_u = UBOUND(OutData%nGrid,1) - DO i1 = LBOUND(OutData%nGrid,1), UBOUND(OutData%nGrid,1) - OutData%nGrid(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%WvLowCOff = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WvHiCOff = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDir = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveNDir = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WaveMultiDir = TRANSFER(IntKiBuf(Int_Xferred), OutData%WaveMultiDir) - Int_Xferred = Int_Xferred + 1 - OutData%WaveDirMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WaveDirSpread = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDirRange = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%WaveHs = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%WaveModChr) - OutData%WaveModChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%WaveNDAmp = TRANSFER(IntKiBuf(Int_Xferred), OutData%WaveNDAmp) - Int_Xferred = Int_Xferred + 1 - OutData%WavePhase = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WavePkShp = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%WavePkShpChr) - OutData%WavePkShpChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - i1_l = LBOUND(OutData%WaveSeed,1) - i1_u = UBOUND(OutData%WaveSeed,1) - DO i1 = LBOUND(OutData%WaveSeed,1), UBOUND(OutData%WaveSeed,1) - OutData%WaveSeed(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%WaveStMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WaveTMax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%WaveTp = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NWaveElevGrid = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NWaveKinGrid = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinGridxi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveKinGridxi)) DEALLOCATE(OutData%WaveKinGridxi) - ALLOCATE(OutData%WaveKinGridxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinGridxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveKinGridxi,1), UBOUND(OutData%WaveKinGridxi,1) - OutData%WaveKinGridxi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinGridyi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveKinGridyi)) DEALLOCATE(OutData%WaveKinGridyi) - ALLOCATE(OutData%WaveKinGridyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinGridyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveKinGridyi,1), UBOUND(OutData%WaveKinGridyi,1) - OutData%WaveKinGridyi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinGridzi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveKinGridzi)) DEALLOCATE(OutData%WaveKinGridzi) - ALLOCATE(OutData%WaveKinGridzi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinGridzi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveKinGridzi,1), UBOUND(OutData%WaveKinGridzi,1) - OutData%WaveKinGridzi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CurrVxi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CurrVxi)) DEALLOCATE(OutData%CurrVxi) - ALLOCATE(OutData%CurrVxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CurrVxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CurrVxi,1), UBOUND(OutData%CurrVxi,1) - OutData%CurrVxi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CurrVyi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CurrVyi)) DEALLOCATE(OutData%CurrVyi) - ALLOCATE(OutData%CurrVyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CurrVyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CurrVyi,1), UBOUND(OutData%CurrVyi,1) - OutData%CurrVyi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%PCurrVxiPz0 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%PCurrVyiPz0 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackNWTC_RandomNumber_ParameterType( Re_Buf, Db_Buf, Int_Buf, OutData%RNG, ErrStat2, ErrMsg2 ) ! RNG - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%ConstWaveMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CrestHmax = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%CrestTime = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%CrestXi = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%CrestYi = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%MCFD = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveFieldMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmLocationX = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmLocationY = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Waves_UnPackInitInput +subroutine Waves_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Waves_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Waves_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + ! InputFile + call RegPack(Buf, InData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! DirRoot + call RegPack(Buf, InData%DirRoot) + if (RegCheckErr(Buf, RoutineName)) return + ! WvKinFile + call RegPack(Buf, InData%WvKinFile) + if (RegCheckErr(Buf, RoutineName)) return + ! Gravity + call RegPack(Buf, InData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + ! nGrid + call RegPack(Buf, InData%nGrid) + if (RegCheckErr(Buf, RoutineName)) return + ! WvLowCOff + call RegPack(Buf, InData%WvLowCOff) + if (RegCheckErr(Buf, RoutineName)) return + ! WvHiCOff + call RegPack(Buf, InData%WvHiCOff) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDir + call RegPack(Buf, InData%WaveDir) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveNDir + call RegPack(Buf, InData%WaveNDir) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveMultiDir + call RegPack(Buf, InData%WaveMultiDir) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDirMod + call RegPack(Buf, InData%WaveDirMod) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDirSpread + call RegPack(Buf, InData%WaveDirSpread) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDirRange + call RegPack(Buf, InData%WaveDirRange) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDT + call RegPack(Buf, InData%WaveDT) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveHs + call RegPack(Buf, InData%WaveHs) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveMod + call RegPack(Buf, InData%WaveMod) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveModChr + call RegPack(Buf, InData%WaveModChr) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveNDAmp + call RegPack(Buf, InData%WaveNDAmp) + if (RegCheckErr(Buf, RoutineName)) return + ! WavePhase + call RegPack(Buf, InData%WavePhase) + if (RegCheckErr(Buf, RoutineName)) return + ! WavePkShp + call RegPack(Buf, InData%WavePkShp) + if (RegCheckErr(Buf, RoutineName)) return + ! WavePkShpChr + call RegPack(Buf, InData%WavePkShpChr) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveSeed + call RegPack(Buf, InData%WaveSeed) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveStMod + call RegPack(Buf, InData%WaveStMod) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveTMax + call RegPack(Buf, InData%WaveTMax) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveTp + call RegPack(Buf, InData%WaveTp) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDens + call RegPack(Buf, InData%WtrDens) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDpth + call RegPack(Buf, InData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! NWaveElevGrid + call RegPack(Buf, InData%NWaveElevGrid) + if (RegCheckErr(Buf, RoutineName)) return + ! NWaveKinGrid + call RegPack(Buf, InData%NWaveKinGrid) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveKinGridxi + call RegPack(Buf, allocated(InData%WaveKinGridxi)) + if (allocated(InData%WaveKinGridxi)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridxi), ubound(InData%WaveKinGridxi)) + call RegPack(Buf, InData%WaveKinGridxi) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveKinGridyi + call RegPack(Buf, allocated(InData%WaveKinGridyi)) + if (allocated(InData%WaveKinGridyi)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridyi), ubound(InData%WaveKinGridyi)) + call RegPack(Buf, InData%WaveKinGridyi) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveKinGridzi + call RegPack(Buf, allocated(InData%WaveKinGridzi)) + if (allocated(InData%WaveKinGridzi)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridzi), ubound(InData%WaveKinGridzi)) + call RegPack(Buf, InData%WaveKinGridzi) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CurrVxi + call RegPack(Buf, allocated(InData%CurrVxi)) + if (allocated(InData%CurrVxi)) then + call RegPackBounds(Buf, 1, lbound(InData%CurrVxi), ubound(InData%CurrVxi)) + call RegPack(Buf, InData%CurrVxi) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CurrVyi + call RegPack(Buf, allocated(InData%CurrVyi)) + if (allocated(InData%CurrVyi)) then + call RegPackBounds(Buf, 1, lbound(InData%CurrVyi), ubound(InData%CurrVyi)) + call RegPack(Buf, InData%CurrVyi) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PCurrVxiPz0 + call RegPack(Buf, InData%PCurrVxiPz0) + if (RegCheckErr(Buf, RoutineName)) return + ! PCurrVyiPz0 + call RegPack(Buf, InData%PCurrVyiPz0) + if (RegCheckErr(Buf, RoutineName)) return + ! RNG + call NWTC_Library_PackNWTC_RandomNumber_ParameterType(Buf, InData%RNG) + if (RegCheckErr(Buf, RoutineName)) return + ! ConstWaveMod + call RegPack(Buf, InData%ConstWaveMod) + if (RegCheckErr(Buf, RoutineName)) return + ! CrestHmax + call RegPack(Buf, InData%CrestHmax) + if (RegCheckErr(Buf, RoutineName)) return + ! CrestTime + call RegPack(Buf, InData%CrestTime) + if (RegCheckErr(Buf, RoutineName)) return + ! CrestXi + call RegPack(Buf, InData%CrestXi) + if (RegCheckErr(Buf, RoutineName)) return + ! CrestYi + call RegPack(Buf, InData%CrestYi) + if (RegCheckErr(Buf, RoutineName)) return + ! MCFD + call RegPack(Buf, InData%MCFD) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveFieldMod + call RegPack(Buf, InData%WaveFieldMod) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmLocationX + call RegPack(Buf, InData%PtfmLocationX) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmLocationY + call RegPack(Buf, InData%PtfmLocationY) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine +subroutine Waves_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Waves_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Waves_UnPackInitInput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! InputFile + call RegUnpack(Buf, OutData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! DirRoot + call RegUnpack(Buf, OutData%DirRoot) + if (RegCheckErr(Buf, RoutineName)) return + ! WvKinFile + call RegUnpack(Buf, OutData%WvKinFile) + if (RegCheckErr(Buf, RoutineName)) return + ! Gravity + call RegUnpack(Buf, OutData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + ! nGrid + call RegUnpack(Buf, OutData%nGrid) + if (RegCheckErr(Buf, RoutineName)) return + ! WvLowCOff + call RegUnpack(Buf, OutData%WvLowCOff) + if (RegCheckErr(Buf, RoutineName)) return + ! WvHiCOff + call RegUnpack(Buf, OutData%WvHiCOff) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDir + call RegUnpack(Buf, OutData%WaveDir) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveNDir + call RegUnpack(Buf, OutData%WaveNDir) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveMultiDir + call RegUnpack(Buf, OutData%WaveMultiDir) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDirMod + call RegUnpack(Buf, OutData%WaveDirMod) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDirSpread + call RegUnpack(Buf, OutData%WaveDirSpread) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDirRange + call RegUnpack(Buf, OutData%WaveDirRange) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDT + call RegUnpack(Buf, OutData%WaveDT) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveHs + call RegUnpack(Buf, OutData%WaveHs) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveMod + call RegUnpack(Buf, OutData%WaveMod) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveModChr + call RegUnpack(Buf, OutData%WaveModChr) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveNDAmp + call RegUnpack(Buf, OutData%WaveNDAmp) + if (RegCheckErr(Buf, RoutineName)) return + ! WavePhase + call RegUnpack(Buf, OutData%WavePhase) + if (RegCheckErr(Buf, RoutineName)) return + ! WavePkShp + call RegUnpack(Buf, OutData%WavePkShp) + if (RegCheckErr(Buf, RoutineName)) return + ! WavePkShpChr + call RegUnpack(Buf, OutData%WavePkShpChr) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveSeed + call RegUnpack(Buf, OutData%WaveSeed) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveStMod + call RegUnpack(Buf, OutData%WaveStMod) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveTMax + call RegUnpack(Buf, OutData%WaveTMax) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveTp + call RegUnpack(Buf, OutData%WaveTp) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDens + call RegUnpack(Buf, OutData%WtrDens) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDpth + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! NWaveElevGrid + call RegUnpack(Buf, OutData%NWaveElevGrid) + if (RegCheckErr(Buf, RoutineName)) return + ! NWaveKinGrid + call RegUnpack(Buf, OutData%NWaveKinGrid) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveKinGridxi + if (allocated(OutData%WaveKinGridxi)) deallocate(OutData%WaveKinGridxi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveKinGridxi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinGridxi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveKinGridxi) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WaveKinGridyi + if (allocated(OutData%WaveKinGridyi)) deallocate(OutData%WaveKinGridyi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveKinGridyi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinGridyi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveKinGridyi) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WaveKinGridzi + if (allocated(OutData%WaveKinGridzi)) deallocate(OutData%WaveKinGridzi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveKinGridzi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinGridzi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveKinGridzi) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CurrVxi + if (allocated(OutData%CurrVxi)) deallocate(OutData%CurrVxi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CurrVxi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CurrVxi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CurrVxi) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CurrVyi + if (allocated(OutData%CurrVyi)) deallocate(OutData%CurrVyi) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CurrVyi(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CurrVyi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CurrVyi) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PCurrVxiPz0 + call RegUnpack(Buf, OutData%PCurrVxiPz0) + if (RegCheckErr(Buf, RoutineName)) return + ! PCurrVyiPz0 + call RegUnpack(Buf, OutData%PCurrVyiPz0) + if (RegCheckErr(Buf, RoutineName)) return + ! RNG + call NWTC_Library_UnpackNWTC_RandomNumber_ParameterType(Buf, OutData%RNG) ! RNG + ! ConstWaveMod + call RegUnpack(Buf, OutData%ConstWaveMod) + if (RegCheckErr(Buf, RoutineName)) return + ! CrestHmax + call RegUnpack(Buf, OutData%CrestHmax) + if (RegCheckErr(Buf, RoutineName)) return + ! CrestTime + call RegUnpack(Buf, OutData%CrestTime) + if (RegCheckErr(Buf, RoutineName)) return + ! CrestXi + call RegUnpack(Buf, OutData%CrestXi) + if (RegCheckErr(Buf, RoutineName)) return + ! CrestYi + call RegUnpack(Buf, OutData%CrestYi) + if (RegCheckErr(Buf, RoutineName)) return + ! MCFD + call RegUnpack(Buf, OutData%MCFD) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveFieldMod + call RegUnpack(Buf, OutData%WaveFieldMod) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmLocationX + call RegUnpack(Buf, OutData%PtfmLocationX) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmLocationY + call RegUnpack(Buf, OutData%PtfmLocationY) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE Waves_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(Waves_InitOutputType), INTENT(IN) :: SrcInitOutputData TYPE(Waves_InitOutputType), INTENT(INOUT) :: DstInitOutputData @@ -965,250 +736,537 @@ SUBROUTINE Waves_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) NULLIFY(InitOutputData%WaveTime) END SUBROUTINE Waves_DestroyInitOutput - SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Waves_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! WaveElevC allocated yes/no - IF ( ALLOCATED(InData%WaveElevC) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveElevC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElevC) ! WaveElevC - END IF - Re_BufSz = Re_BufSz + 1 ! WaveDirMin - Re_BufSz = Re_BufSz + 1 ! WaveDirMax - Int_BufSz = Int_BufSz + 1 ! WaveNDir - Re_BufSz = Re_BufSz + 1 ! WaveDOmega - Int_BufSz = Int_BufSz + 1 ! WaveElev0 allocated yes/no - IF ( ALLOCATED(InData%WaveElev0) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveElev0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev0) ! WaveElev0 - END IF - Db_BufSz = Db_BufSz + 1 ! WaveTMax - Re_BufSz = Re_BufSz + 1 ! RhoXg - Int_BufSz = Int_BufSz + 1 ! NStepWave - Int_BufSz = Int_BufSz + 1 ! NStepWave2 - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%WaveElevC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveElevC,3), UBOUND(InData%WaveElevC,3) - DO i2 = LBOUND(InData%WaveElevC,2), UBOUND(InData%WaveElevC,2) - DO i1 = LBOUND(InData%WaveElevC,1), UBOUND(InData%WaveElevC,1) - ReKiBuf(Re_Xferred) = InData%WaveElevC(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%WaveDirMin - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDirMax - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveNDir - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDOmega - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveElev0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev0,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveElev0,1), UBOUND(InData%WaveElev0,1) - ReKiBuf(Re_Xferred) = InData%WaveElev0(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DbKiBuf(Db_Xferred) = InData%WaveTMax - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RhoXg - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepWave2 - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Waves_PackInitOutput - SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Waves_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - NULLIFY(OutData%WaveElevC0) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveElevC)) DEALLOCATE(OutData%WaveElevC) - ALLOCATE(OutData%WaveElevC(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveElevC,3), UBOUND(OutData%WaveElevC,3) - DO i2 = LBOUND(OutData%WaveElevC,2), UBOUND(OutData%WaveElevC,2) - DO i1 = LBOUND(OutData%WaveElevC,1), UBOUND(OutData%WaveElevC,1) - OutData%WaveElevC(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - NULLIFY(OutData%WaveDirArr) - OutData%WaveDirMin = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDirMax = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveNDir = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WaveDOmega = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - NULLIFY(OutData%WaveDynP) - NULLIFY(OutData%WaveAcc) - NULLIFY(OutData%WaveAccMCF) - NULLIFY(OutData%WaveVel) - NULLIFY(OutData%PWaveDynP0) - NULLIFY(OutData%PWaveAcc0) - NULLIFY(OutData%PWaveAccMCF0) - NULLIFY(OutData%PWaveVel0) - NULLIFY(OutData%WaveElev) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveElev0)) DEALLOCATE(OutData%WaveElev0) - ALLOCATE(OutData%WaveElev0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveElev0,1), UBOUND(OutData%WaveElev0,1) - OutData%WaveElev0(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - NULLIFY(OutData%WaveTime) - OutData%WaveTMax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%RhoXg = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%NStepWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NStepWave2 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Waves_UnPackInitOutput +subroutine Waves_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(Waves_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'Waves_PackInitOutput' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + ! WaveElevC0 + call RegPack(Buf, associated(InData%WaveElevC0)) + if (associated(InData%WaveElevC0)) then + call RegPackBounds(Buf, 2, lbound(InData%WaveElevC0), ubound(InData%WaveElevC0)) + call RegPackPointer(Buf, c_loc(InData%WaveElevC0), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveElevC0) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElevC + call RegPack(Buf, allocated(InData%WaveElevC)) + if (allocated(InData%WaveElevC)) then + call RegPackBounds(Buf, 3, lbound(InData%WaveElevC), ubound(InData%WaveElevC)) + call RegPack(Buf, InData%WaveElevC) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDirArr + call RegPack(Buf, associated(InData%WaveDirArr)) + if (associated(InData%WaveDirArr)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveDirArr), ubound(InData%WaveDirArr)) + call RegPackPointer(Buf, c_loc(InData%WaveDirArr), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveDirArr) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDirMin + call RegPack(Buf, InData%WaveDirMin) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDirMax + call RegPack(Buf, InData%WaveDirMax) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveNDir + call RegPack(Buf, InData%WaveNDir) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDOmega + call RegPack(Buf, InData%WaveDOmega) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDynP + call RegPack(Buf, associated(InData%WaveDynP)) + if (associated(InData%WaveDynP)) then + call RegPackBounds(Buf, 4, lbound(InData%WaveDynP), ubound(InData%WaveDynP)) + call RegPackPointer(Buf, c_loc(InData%WaveDynP), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveDynP) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveAcc + call RegPack(Buf, associated(InData%WaveAcc)) + if (associated(InData%WaveAcc)) then + call RegPackBounds(Buf, 5, lbound(InData%WaveAcc), ubound(InData%WaveAcc)) + call RegPackPointer(Buf, c_loc(InData%WaveAcc), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveAcc) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveAccMCF + call RegPack(Buf, associated(InData%WaveAccMCF)) + if (associated(InData%WaveAccMCF)) then + call RegPackBounds(Buf, 5, lbound(InData%WaveAccMCF), ubound(InData%WaveAccMCF)) + call RegPackPointer(Buf, c_loc(InData%WaveAccMCF), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveAccMCF) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveVel + call RegPack(Buf, associated(InData%WaveVel)) + if (associated(InData%WaveVel)) then + call RegPackBounds(Buf, 5, lbound(InData%WaveVel), ubound(InData%WaveVel)) + call RegPackPointer(Buf, c_loc(InData%WaveVel), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveVel) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PWaveDynP0 + call RegPack(Buf, associated(InData%PWaveDynP0)) + if (associated(InData%PWaveDynP0)) then + call RegPackBounds(Buf, 3, lbound(InData%PWaveDynP0), ubound(InData%PWaveDynP0)) + call RegPackPointer(Buf, c_loc(InData%PWaveDynP0), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%PWaveDynP0) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PWaveAcc0 + call RegPack(Buf, associated(InData%PWaveAcc0)) + if (associated(InData%PWaveAcc0)) then + call RegPackBounds(Buf, 4, lbound(InData%PWaveAcc0), ubound(InData%PWaveAcc0)) + call RegPackPointer(Buf, c_loc(InData%PWaveAcc0), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%PWaveAcc0) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PWaveAccMCF0 + call RegPack(Buf, associated(InData%PWaveAccMCF0)) + if (associated(InData%PWaveAccMCF0)) then + call RegPackBounds(Buf, 4, lbound(InData%PWaveAccMCF0), ubound(InData%PWaveAccMCF0)) + call RegPackPointer(Buf, c_loc(InData%PWaveAccMCF0), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%PWaveAccMCF0) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PWaveVel0 + call RegPack(Buf, associated(InData%PWaveVel0)) + if (associated(InData%PWaveVel0)) then + call RegPackBounds(Buf, 4, lbound(InData%PWaveVel0), ubound(InData%PWaveVel0)) + call RegPackPointer(Buf, c_loc(InData%PWaveVel0), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%PWaveVel0) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElev + call RegPack(Buf, associated(InData%WaveElev)) + if (associated(InData%WaveElev)) then + call RegPackBounds(Buf, 3, lbound(InData%WaveElev), ubound(InData%WaveElev)) + call RegPackPointer(Buf, c_loc(InData%WaveElev), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveElev) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveElev0 + call RegPack(Buf, allocated(InData%WaveElev0)) + if (allocated(InData%WaveElev0)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveElev0), ubound(InData%WaveElev0)) + call RegPack(Buf, InData%WaveElev0) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveTime + call RegPack(Buf, associated(InData%WaveTime)) + if (associated(InData%WaveTime)) then + call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) + call RegPackPointer(Buf, c_loc(InData%WaveTime), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%WaveTime) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WaveTMax + call RegPack(Buf, InData%WaveTMax) + if (RegCheckErr(Buf, RoutineName)) return + ! RhoXg + call RegPack(Buf, InData%RhoXg) + if (RegCheckErr(Buf, RoutineName)) return + ! NStepWave + call RegPack(Buf, InData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + ! NStepWave2 + call RegPack(Buf, InData%NStepWave2) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine +subroutine Waves_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(Waves_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'Waves_UnPackInitOutput' + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + ! WaveElevC0 + if (associated(OutData%WaveElevC0)) deallocate(OutData%WaveElevC0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveElevC0, UB(1:2)-LB(1:2)) + OutData%WaveElevC0(LB(1):,LB(2):) => OutData%WaveElevC0 + else + allocate(OutData%WaveElevC0(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElevC0) + call RegUnpack(Buf, OutData%WaveElevC0) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveElevC0 => null() + end if + ! WaveElevC + if (allocated(OutData%WaveElevC)) deallocate(OutData%WaveElevC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveElevC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveElevC) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WaveDirArr + if (associated(OutData%WaveDirArr)) deallocate(OutData%WaveDirArr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveDirArr, UB(1:1)-LB(1:1)) + OutData%WaveDirArr(LB(1):) => OutData%WaveDirArr + else + allocate(OutData%WaveDirArr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveDirArr) + call RegUnpack(Buf, OutData%WaveDirArr) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveDirArr => null() + end if + ! WaveDirMin + call RegUnpack(Buf, OutData%WaveDirMin) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDirMax + call RegUnpack(Buf, OutData%WaveDirMax) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveNDir + call RegUnpack(Buf, OutData%WaveNDir) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDOmega + call RegUnpack(Buf, OutData%WaveDOmega) + if (RegCheckErr(Buf, RoutineName)) return + ! WaveDynP + if (associated(OutData%WaveDynP)) deallocate(OutData%WaveDynP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveDynP, UB(1:4)-LB(1:4)) + OutData%WaveDynP(LB(1):,LB(2):,LB(3):,LB(4):) => OutData%WaveDynP + else + allocate(OutData%WaveDynP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveDynP) + call RegUnpack(Buf, OutData%WaveDynP) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveDynP => null() + end if + ! WaveAcc + if (associated(OutData%WaveAcc)) deallocate(OutData%WaveAcc) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveAcc, UB(1:5)-LB(1:5)) + OutData%WaveAcc(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => OutData%WaveAcc + else + allocate(OutData%WaveAcc(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveAcc) + call RegUnpack(Buf, OutData%WaveAcc) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveAcc => null() + end if + ! WaveAccMCF + if (associated(OutData%WaveAccMCF)) deallocate(OutData%WaveAccMCF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveAccMCF, UB(1:5)-LB(1:5)) + OutData%WaveAccMCF(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => OutData%WaveAccMCF + else + allocate(OutData%WaveAccMCF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAccMCF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveAccMCF) + call RegUnpack(Buf, OutData%WaveAccMCF) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveAccMCF => null() + end if + ! WaveVel + if (associated(OutData%WaveVel)) deallocate(OutData%WaveVel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 5, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveVel, UB(1:5)-LB(1:5)) + OutData%WaveVel(LB(1):,LB(2):,LB(3):,LB(4):,LB(5):) => OutData%WaveVel + else + allocate(OutData%WaveVel(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveVel) + call RegUnpack(Buf, OutData%WaveVel) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveVel => null() + end if + ! PWaveDynP0 + if (associated(OutData%PWaveDynP0)) deallocate(OutData%PWaveDynP0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%PWaveDynP0, UB(1:3)-LB(1:3)) + OutData%PWaveDynP0(LB(1):,LB(2):,LB(3):) => OutData%PWaveDynP0 + else + allocate(OutData%PWaveDynP0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveDynP0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%PWaveDynP0) + call RegUnpack(Buf, OutData%PWaveDynP0) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%PWaveDynP0 => null() + end if + ! PWaveAcc0 + if (associated(OutData%PWaveAcc0)) deallocate(OutData%PWaveAcc0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%PWaveAcc0, UB(1:4)-LB(1:4)) + OutData%PWaveAcc0(LB(1):,LB(2):,LB(3):,LB(4):) => OutData%PWaveAcc0 + else + allocate(OutData%PWaveAcc0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAcc0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%PWaveAcc0) + call RegUnpack(Buf, OutData%PWaveAcc0) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%PWaveAcc0 => null() + end if + ! PWaveAccMCF0 + if (associated(OutData%PWaveAccMCF0)) deallocate(OutData%PWaveAccMCF0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%PWaveAccMCF0, UB(1:4)-LB(1:4)) + OutData%PWaveAccMCF0(LB(1):,LB(2):,LB(3):,LB(4):) => OutData%PWaveAccMCF0 + else + allocate(OutData%PWaveAccMCF0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAccMCF0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%PWaveAccMCF0) + call RegUnpack(Buf, OutData%PWaveAccMCF0) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%PWaveAccMCF0 => null() + end if + ! PWaveVel0 + if (associated(OutData%PWaveVel0)) deallocate(OutData%PWaveVel0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%PWaveVel0, UB(1:4)-LB(1:4)) + OutData%PWaveVel0(LB(1):,LB(2):,LB(3):,LB(4):) => OutData%PWaveVel0 + else + allocate(OutData%PWaveVel0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveVel0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%PWaveVel0) + call RegUnpack(Buf, OutData%PWaveVel0) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%PWaveVel0 => null() + end if + ! WaveElev + if (associated(OutData%WaveElev)) deallocate(OutData%WaveElev) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveElev, UB(1:3)-LB(1:3)) + OutData%WaveElev(LB(1):,LB(2):,LB(3):) => OutData%WaveElev + else + allocate(OutData%WaveElev(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveElev) + call RegUnpack(Buf, OutData%WaveElev) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveElev => null() + end if + ! WaveElev0 + if (allocated(OutData%WaveElev0)) deallocate(OutData%WaveElev0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WaveElev0(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WaveElev0) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WaveTime + if (associated(OutData%WaveTime)) deallocate(OutData%WaveTime) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%WaveTime, UB(1:1)-LB(1:1)) + OutData%WaveTime(LB(1):) => OutData%WaveTime + else + allocate(OutData%WaveTime(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%WaveTime) + call RegUnpack(Buf, OutData%WaveTime) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%WaveTime => null() + end if + ! WaveTMax + call RegUnpack(Buf, OutData%WaveTMax) + if (RegCheckErr(Buf, RoutineName)) return + ! RhoXg + call RegUnpack(Buf, OutData%RhoXg) + if (RegCheckErr(Buf, RoutineName)) return + ! NStepWave + call RegUnpack(Buf, OutData%NStepWave) + if (RegCheckErr(Buf, RoutineName)) return + ! NStepWave2 + call RegUnpack(Buf, OutData%NStepWave2) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine END MODULE Waves_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/servodyn/src/ServoDyn_Types.f90 b/modules/servodyn/src/ServoDyn_Types.f90 index 8c398b1638..d999f6a2e8 100644 --- a/modules/servodyn/src/ServoDyn_Types.f90 +++ b/modules/servodyn/src/ServoDyn_Types.f90 @@ -842,999 +842,496 @@ SUBROUTINE SrvD_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE SrvD_DestroyInitInput - SUBROUTINE SrvD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SrvD_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%InputFile) ! InputFile - Int_BufSz = Int_BufSz + 1 ! Linearize - Int_BufSz = Int_BufSz + 1 ! NumBl - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1 ! BlPitchInit allocated yes/no - IF ( ALLOCATED(InData%BlPitchInit) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlPitchInit upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlPitchInit) ! BlPitchInit - END IF - Re_BufSz = Re_BufSz + SIZE(InData%Gravity) ! Gravity - Re_BufSz = Re_BufSz + SIZE(InData%NacRefPos) ! NacRefPos - Db_BufSz = Db_BufSz + SIZE(InData%NacTransDisp) ! NacTransDisp - Db_BufSz = Db_BufSz + SIZE(InData%NacOrient) ! NacOrient - Db_BufSz = Db_BufSz + SIZE(InData%NacRefOrient) ! NacRefOrient - Re_BufSz = Re_BufSz + SIZE(InData%TwrBaseRefPos) ! TwrBaseRefPos - Db_BufSz = Db_BufSz + SIZE(InData%TwrBaseTransDisp) ! TwrBaseTransDisp - Db_BufSz = Db_BufSz + SIZE(InData%TwrBaseOrient) ! TwrBaseOrient - Db_BufSz = Db_BufSz + SIZE(InData%TwrBaseRefOrient) ! TwrBaseRefOrient - Re_BufSz = Re_BufSz + SIZE(InData%PtfmRefPos) ! PtfmRefPos - Db_BufSz = Db_BufSz + SIZE(InData%PtfmTransDisp) ! PtfmTransDisp - Db_BufSz = Db_BufSz + SIZE(InData%PtfmOrient) ! PtfmOrient - Db_BufSz = Db_BufSz + SIZE(InData%PtfmRefOrient) ! PtfmRefOrient - Db_BufSz = Db_BufSz + 1 ! Tmax - Re_BufSz = Re_BufSz + 1 ! AvgWindSpeed - Re_BufSz = Re_BufSz + 1 ! AirDens - Int_BufSz = Int_BufSz + 1 ! NumSC2CtrlGlob - Int_BufSz = Int_BufSz + 1 ! NumSC2Ctrl - Int_BufSz = Int_BufSz + 1 ! NumCtrl2SC - Int_BufSz = Int_BufSz + 1 ! TrimCase - Re_BufSz = Re_BufSz + 1 ! TrimGain - Re_BufSz = Re_BufSz + 1 ! RotSpeedRef - Int_BufSz = Int_BufSz + 1 ! BladeRootRefPos allocated yes/no - IF ( ALLOCATED(InData%BladeRootRefPos) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BladeRootRefPos upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BladeRootRefPos) ! BladeRootRefPos - END IF - Int_BufSz = Int_BufSz + 1 ! BladeRootTransDisp allocated yes/no - IF ( ALLOCATED(InData%BladeRootTransDisp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BladeRootTransDisp upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%BladeRootTransDisp) ! BladeRootTransDisp - END IF - Int_BufSz = Int_BufSz + 1 ! BladeRootOrient allocated yes/no - IF ( ALLOCATED(InData%BladeRootOrient) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! BladeRootOrient upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%BladeRootOrient) ! BladeRootOrient - END IF - Int_BufSz = Int_BufSz + 1 ! BladeRootRefOrient allocated yes/no - IF ( ALLOCATED(InData%BladeRootRefOrient) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! BladeRootRefOrient upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%BladeRootRefOrient) ! BladeRootRefOrient - END IF - Int_BufSz = Int_BufSz + 1 ! UseInputFile - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! PassedPrimaryInputData: size of buffers for each call to pack subtype - CALL NWTC_Library_PackFileInfoType( Re_Buf, Db_Buf, Int_Buf, InData%PassedPrimaryInputData, ErrStat2, ErrMsg2, .TRUE. ) ! PassedPrimaryInputData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PassedPrimaryInputData - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PassedPrimaryInputData - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PassedPrimaryInputData - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! NumCableControl - Int_BufSz = Int_BufSz + 1 ! CableControlRequestor allocated yes/no - IF ( ALLOCATED(InData%CableControlRequestor) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CableControlRequestor upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%CableControlRequestor)*LEN(InData%CableControlRequestor) ! CableControlRequestor - END IF - Int_BufSz = Int_BufSz + 1 ! InterpOrder - Int_BufSz = Int_BufSz + 1 ! fromSCGlob allocated yes/no - IF ( ALLOCATED(InData%fromSCGlob) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! fromSCGlob upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fromSCGlob) ! fromSCGlob - END IF - Int_BufSz = Int_BufSz + 1 ! fromSC allocated yes/no - IF ( ALLOCATED(InData%fromSC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! fromSC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fromSC) ! fromSC - END IF - Int_BufSz = Int_BufSz + 1 ! LidSpeed allocated yes/no - IF ( ALLOCATED(InData%LidSpeed) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LidSpeed upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LidSpeed) ! LidSpeed - END IF - Int_BufSz = Int_BufSz + 1 ! MsrPositionsX allocated yes/no - IF ( ALLOCATED(InData%MsrPositionsX) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MsrPositionsX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MsrPositionsX) ! MsrPositionsX - END IF - Int_BufSz = Int_BufSz + 1 ! MsrPositionsY allocated yes/no - IF ( ALLOCATED(InData%MsrPositionsY) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MsrPositionsY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MsrPositionsY) ! MsrPositionsY - END IF - Int_BufSz = Int_BufSz + 1 ! MsrPositionsZ allocated yes/no - IF ( ALLOCATED(InData%MsrPositionsZ) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MsrPositionsZ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MsrPositionsZ) ! MsrPositionsZ - END IF - Int_BufSz = Int_BufSz + 1 ! SensorType - Int_BufSz = Int_BufSz + 1 ! NumBeam - Int_BufSz = Int_BufSz + 1 ! NumPulseGate - Re_BufSz = Re_BufSz + 1 ! PulseSpacing - Re_BufSz = Re_BufSz + 1 ! URefLid - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBl - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%BlPitchInit) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlPitchInit,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitchInit,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlPitchInit,1), UBOUND(InData%BlPitchInit,1) - ReKiBuf(Re_Xferred) = InData%BlPitchInit(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DO i1 = LBOUND(InData%Gravity,1), UBOUND(InData%Gravity,1) - ReKiBuf(Re_Xferred) = InData%Gravity(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%NacRefPos,1), UBOUND(InData%NacRefPos,1) - ReKiBuf(Re_Xferred) = InData%NacRefPos(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%NacTransDisp,1), UBOUND(InData%NacTransDisp,1) - DbKiBuf(Db_Xferred) = InData%NacTransDisp(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i2 = LBOUND(InData%NacOrient,2), UBOUND(InData%NacOrient,2) - DO i1 = LBOUND(InData%NacOrient,1), UBOUND(InData%NacOrient,1) - DbKiBuf(Db_Xferred) = InData%NacOrient(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%NacRefOrient,2), UBOUND(InData%NacRefOrient,2) - DO i1 = LBOUND(InData%NacRefOrient,1), UBOUND(InData%NacRefOrient,1) - DbKiBuf(Db_Xferred) = InData%NacRefOrient(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DO i1 = LBOUND(InData%TwrBaseRefPos,1), UBOUND(InData%TwrBaseRefPos,1) - ReKiBuf(Re_Xferred) = InData%TwrBaseRefPos(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%TwrBaseTransDisp,1), UBOUND(InData%TwrBaseTransDisp,1) - DbKiBuf(Db_Xferred) = InData%TwrBaseTransDisp(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i2 = LBOUND(InData%TwrBaseOrient,2), UBOUND(InData%TwrBaseOrient,2) - DO i1 = LBOUND(InData%TwrBaseOrient,1), UBOUND(InData%TwrBaseOrient,1) - DbKiBuf(Db_Xferred) = InData%TwrBaseOrient(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%TwrBaseRefOrient,2), UBOUND(InData%TwrBaseRefOrient,2) - DO i1 = LBOUND(InData%TwrBaseRefOrient,1), UBOUND(InData%TwrBaseRefOrient,1) - DbKiBuf(Db_Xferred) = InData%TwrBaseRefOrient(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DO i1 = LBOUND(InData%PtfmRefPos,1), UBOUND(InData%PtfmRefPos,1) - ReKiBuf(Re_Xferred) = InData%PtfmRefPos(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%PtfmTransDisp,1), UBOUND(InData%PtfmTransDisp,1) - DbKiBuf(Db_Xferred) = InData%PtfmTransDisp(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i2 = LBOUND(InData%PtfmOrient,2), UBOUND(InData%PtfmOrient,2) - DO i1 = LBOUND(InData%PtfmOrient,1), UBOUND(InData%PtfmOrient,1) - DbKiBuf(Db_Xferred) = InData%PtfmOrient(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DO i2 = LBOUND(InData%PtfmRefOrient,2), UBOUND(InData%PtfmRefOrient,2) - DO i1 = LBOUND(InData%PtfmRefOrient,1), UBOUND(InData%PtfmRefOrient,1) - DbKiBuf(Db_Xferred) = InData%PtfmRefOrient(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - DbKiBuf(Db_Xferred) = InData%Tmax - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AvgWindSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AirDens - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumSC2CtrlGlob - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumSC2Ctrl - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumCtrl2SC - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TrimCase - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TrimGain - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RotSpeedRef - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BladeRootRefPos) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootRefPos,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootRefPos,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootRefPos,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootRefPos,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BladeRootRefPos,2), UBOUND(InData%BladeRootRefPos,2) - DO i1 = LBOUND(InData%BladeRootRefPos,1), UBOUND(InData%BladeRootRefPos,1) - ReKiBuf(Re_Xferred) = InData%BladeRootRefPos(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BladeRootTransDisp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootTransDisp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootTransDisp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootTransDisp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootTransDisp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BladeRootTransDisp,2), UBOUND(InData%BladeRootTransDisp,2) - DO i1 = LBOUND(InData%BladeRootTransDisp,1), UBOUND(InData%BladeRootTransDisp,1) - DbKiBuf(Db_Xferred) = InData%BladeRootTransDisp(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BladeRootOrient) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootOrient,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootOrient,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootOrient,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootOrient,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootOrient,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootOrient,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%BladeRootOrient,3), UBOUND(InData%BladeRootOrient,3) - DO i2 = LBOUND(InData%BladeRootOrient,2), UBOUND(InData%BladeRootOrient,2) - DO i1 = LBOUND(InData%BladeRootOrient,1), UBOUND(InData%BladeRootOrient,1) - DbKiBuf(Db_Xferred) = InData%BladeRootOrient(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BladeRootRefOrient) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootRefOrient,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootRefOrient,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootRefOrient,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootRefOrient,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BladeRootRefOrient,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootRefOrient,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%BladeRootRefOrient,3), UBOUND(InData%BladeRootRefOrient,3) - DO i2 = LBOUND(InData%BladeRootRefOrient,2), UBOUND(InData%BladeRootRefOrient,2) - DO i1 = LBOUND(InData%BladeRootRefOrient,1), UBOUND(InData%BladeRootRefOrient,1) - DbKiBuf(Db_Xferred) = InData%BladeRootRefOrient(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseInputFile, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - CALL NWTC_Library_PackFileInfoType( Re_Buf, Db_Buf, Int_Buf, InData%PassedPrimaryInputData, ErrStat2, ErrMsg2, OnlySize ) ! PassedPrimaryInputData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = InData%NumCableControl - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%CableControlRequestor) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CableControlRequestor,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CableControlRequestor,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CableControlRequestor,1), UBOUND(InData%CableControlRequestor,1) - DO I = 1, LEN(InData%CableControlRequestor) - IntKiBuf(Int_Xferred) = ICHAR(InData%CableControlRequestor(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IntKiBuf(Int_Xferred) = InData%InterpOrder - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%fromSCGlob) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fromSCGlob,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fromSCGlob,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%fromSCGlob,1), UBOUND(InData%fromSCGlob,1) - ReKiBuf(Re_Xferred) = InData%fromSCGlob(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%fromSC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fromSC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fromSC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%fromSC,1), UBOUND(InData%fromSC,1) - ReKiBuf(Re_Xferred) = InData%fromSC(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LidSpeed) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LidSpeed,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LidSpeed,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LidSpeed,1), UBOUND(InData%LidSpeed,1) - ReKiBuf(Re_Xferred) = InData%LidSpeed(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MsrPositionsX) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MsrPositionsX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MsrPositionsX,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MsrPositionsX,1), UBOUND(InData%MsrPositionsX,1) - ReKiBuf(Re_Xferred) = InData%MsrPositionsX(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MsrPositionsY) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MsrPositionsY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MsrPositionsY,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MsrPositionsY,1), UBOUND(InData%MsrPositionsY,1) - ReKiBuf(Re_Xferred) = InData%MsrPositionsY(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MsrPositionsZ) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MsrPositionsZ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MsrPositionsZ,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MsrPositionsZ,1), UBOUND(InData%MsrPositionsZ,1) - ReKiBuf(Re_Xferred) = InData%MsrPositionsZ(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%SensorType - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBeam - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumPulseGate - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PulseSpacing - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%URefLid - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SrvD_PackInitInput - - SUBROUTINE SrvD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SrvD_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) - Int_Xferred = Int_Xferred + 1 - OutData%NumBl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitchInit not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlPitchInit)) DEALLOCATE(OutData%BlPitchInit) - ALLOCATE(OutData%BlPitchInit(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchInit.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlPitchInit,1), UBOUND(OutData%BlPitchInit,1) - OutData%BlPitchInit(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - i1_l = LBOUND(OutData%Gravity,1) - i1_u = UBOUND(OutData%Gravity,1) - DO i1 = LBOUND(OutData%Gravity,1), UBOUND(OutData%Gravity,1) - OutData%Gravity(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%NacRefPos,1) - i1_u = UBOUND(OutData%NacRefPos,1) - DO i1 = LBOUND(OutData%NacRefPos,1), UBOUND(OutData%NacRefPos,1) - OutData%NacRefPos(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%NacTransDisp,1) - i1_u = UBOUND(OutData%NacTransDisp,1) - DO i1 = LBOUND(OutData%NacTransDisp,1), UBOUND(OutData%NacTransDisp,1) - OutData%NacTransDisp(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%NacOrient,1) - i1_u = UBOUND(OutData%NacOrient,1) - i2_l = LBOUND(OutData%NacOrient,2) - i2_u = UBOUND(OutData%NacOrient,2) - DO i2 = LBOUND(OutData%NacOrient,2), UBOUND(OutData%NacOrient,2) - DO i1 = LBOUND(OutData%NacOrient,1), UBOUND(OutData%NacOrient,1) - OutData%NacOrient(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%NacRefOrient,1) - i1_u = UBOUND(OutData%NacRefOrient,1) - i2_l = LBOUND(OutData%NacRefOrient,2) - i2_u = UBOUND(OutData%NacRefOrient,2) - DO i2 = LBOUND(OutData%NacRefOrient,2), UBOUND(OutData%NacRefOrient,2) - DO i1 = LBOUND(OutData%NacRefOrient,1), UBOUND(OutData%NacRefOrient,1) - OutData%NacRefOrient(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%TwrBaseRefPos,1) - i1_u = UBOUND(OutData%TwrBaseRefPos,1) - DO i1 = LBOUND(OutData%TwrBaseRefPos,1), UBOUND(OutData%TwrBaseRefPos,1) - OutData%TwrBaseRefPos(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TwrBaseTransDisp,1) - i1_u = UBOUND(OutData%TwrBaseTransDisp,1) - DO i1 = LBOUND(OutData%TwrBaseTransDisp,1), UBOUND(OutData%TwrBaseTransDisp,1) - OutData%TwrBaseTransDisp(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%TwrBaseOrient,1) - i1_u = UBOUND(OutData%TwrBaseOrient,1) - i2_l = LBOUND(OutData%TwrBaseOrient,2) - i2_u = UBOUND(OutData%TwrBaseOrient,2) - DO i2 = LBOUND(OutData%TwrBaseOrient,2), UBOUND(OutData%TwrBaseOrient,2) - DO i1 = LBOUND(OutData%TwrBaseOrient,1), UBOUND(OutData%TwrBaseOrient,1) - OutData%TwrBaseOrient(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%TwrBaseRefOrient,1) - i1_u = UBOUND(OutData%TwrBaseRefOrient,1) - i2_l = LBOUND(OutData%TwrBaseRefOrient,2) - i2_u = UBOUND(OutData%TwrBaseRefOrient,2) - DO i2 = LBOUND(OutData%TwrBaseRefOrient,2), UBOUND(OutData%TwrBaseRefOrient,2) - DO i1 = LBOUND(OutData%TwrBaseRefOrient,1), UBOUND(OutData%TwrBaseRefOrient,1) - OutData%TwrBaseRefOrient(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%PtfmRefPos,1) - i1_u = UBOUND(OutData%PtfmRefPos,1) - DO i1 = LBOUND(OutData%PtfmRefPos,1), UBOUND(OutData%PtfmRefPos,1) - OutData%PtfmRefPos(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%PtfmTransDisp,1) - i1_u = UBOUND(OutData%PtfmTransDisp,1) - DO i1 = LBOUND(OutData%PtfmTransDisp,1), UBOUND(OutData%PtfmTransDisp,1) - OutData%PtfmTransDisp(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%PtfmOrient,1) - i1_u = UBOUND(OutData%PtfmOrient,1) - i2_l = LBOUND(OutData%PtfmOrient,2) - i2_u = UBOUND(OutData%PtfmOrient,2) - DO i2 = LBOUND(OutData%PtfmOrient,2), UBOUND(OutData%PtfmOrient,2) - DO i1 = LBOUND(OutData%PtfmOrient,1), UBOUND(OutData%PtfmOrient,1) - OutData%PtfmOrient(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%PtfmRefOrient,1) - i1_u = UBOUND(OutData%PtfmRefOrient,1) - i2_l = LBOUND(OutData%PtfmRefOrient,2) - i2_u = UBOUND(OutData%PtfmRefOrient,2) - DO i2 = LBOUND(OutData%PtfmRefOrient,2), UBOUND(OutData%PtfmRefOrient,2) - DO i1 = LBOUND(OutData%PtfmRefOrient,1), UBOUND(OutData%PtfmRefOrient,1) - OutData%PtfmRefOrient(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - OutData%Tmax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%AvgWindSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AirDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NumSC2CtrlGlob = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumSC2Ctrl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumCtrl2SC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TrimCase = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TrimGain = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RotSpeedRef = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeRootRefPos not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BladeRootRefPos)) DEALLOCATE(OutData%BladeRootRefPos) - ALLOCATE(OutData%BladeRootRefPos(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootRefPos.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BladeRootRefPos,2), UBOUND(OutData%BladeRootRefPos,2) - DO i1 = LBOUND(OutData%BladeRootRefPos,1), UBOUND(OutData%BladeRootRefPos,1) - OutData%BladeRootRefPos(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeRootTransDisp not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BladeRootTransDisp)) DEALLOCATE(OutData%BladeRootTransDisp) - ALLOCATE(OutData%BladeRootTransDisp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootTransDisp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BladeRootTransDisp,2), UBOUND(OutData%BladeRootTransDisp,2) - DO i1 = LBOUND(OutData%BladeRootTransDisp,1), UBOUND(OutData%BladeRootTransDisp,1) - OutData%BladeRootTransDisp(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeRootOrient not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BladeRootOrient)) DEALLOCATE(OutData%BladeRootOrient) - ALLOCATE(OutData%BladeRootOrient(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootOrient.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%BladeRootOrient,3), UBOUND(OutData%BladeRootOrient,3) - DO i2 = LBOUND(OutData%BladeRootOrient,2), UBOUND(OutData%BladeRootOrient,2) - DO i1 = LBOUND(OutData%BladeRootOrient,1), UBOUND(OutData%BladeRootOrient,1) - OutData%BladeRootOrient(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeRootRefOrient not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BladeRootRefOrient)) DEALLOCATE(OutData%BladeRootRefOrient) - ALLOCATE(OutData%BladeRootRefOrient(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootRefOrient.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%BladeRootRefOrient,3), UBOUND(OutData%BladeRootRefOrient,3) - DO i2 = LBOUND(OutData%BladeRootRefOrient,2), UBOUND(OutData%BladeRootRefOrient,2) - DO i1 = LBOUND(OutData%BladeRootRefOrient,1), UBOUND(OutData%BladeRootRefOrient,1) - OutData%BladeRootRefOrient(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%UseInputFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseInputFile) - Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackFileInfoType( Re_Buf, Db_Buf, Int_Buf, OutData%PassedPrimaryInputData, ErrStat2, ErrMsg2 ) ! PassedPrimaryInputData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%NumCableControl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CableControlRequestor not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CableControlRequestor)) DEALLOCATE(OutData%CableControlRequestor) - ALLOCATE(OutData%CableControlRequestor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableControlRequestor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CableControlRequestor,1), UBOUND(OutData%CableControlRequestor,1) - DO I = 1, LEN(OutData%CableControlRequestor) - OutData%CableControlRequestor(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - OutData%InterpOrder = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fromSCGlob not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%fromSCGlob)) DEALLOCATE(OutData%fromSCGlob) - ALLOCATE(OutData%fromSCGlob(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSCGlob.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%fromSCGlob,1), UBOUND(OutData%fromSCGlob,1) - OutData%fromSCGlob(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fromSC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%fromSC)) DEALLOCATE(OutData%fromSC) - ALLOCATE(OutData%fromSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%fromSC,1), UBOUND(OutData%fromSC,1) - OutData%fromSC(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LidSpeed not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LidSpeed)) DEALLOCATE(OutData%LidSpeed) - ALLOCATE(OutData%LidSpeed(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LidSpeed.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LidSpeed,1), UBOUND(OutData%LidSpeed,1) - OutData%LidSpeed(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MsrPositionsX not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MsrPositionsX)) DEALLOCATE(OutData%MsrPositionsX) - ALLOCATE(OutData%MsrPositionsX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MsrPositionsX,1), UBOUND(OutData%MsrPositionsX,1) - OutData%MsrPositionsX(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MsrPositionsY not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MsrPositionsY)) DEALLOCATE(OutData%MsrPositionsY) - ALLOCATE(OutData%MsrPositionsY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MsrPositionsY,1), UBOUND(OutData%MsrPositionsY,1) - OutData%MsrPositionsY(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MsrPositionsZ not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MsrPositionsZ)) DEALLOCATE(OutData%MsrPositionsZ) - ALLOCATE(OutData%MsrPositionsZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MsrPositionsZ,1), UBOUND(OutData%MsrPositionsZ,1) - OutData%MsrPositionsZ(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%SensorType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumBeam = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumPulseGate = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%PulseSpacing = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%URefLid = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SrvD_UnPackInitInput +subroutine SrvD_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + ! InputFile + call RegPack(Buf, InData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! Linearize + call RegPack(Buf, InData%Linearize) + if (RegCheckErr(Buf, RoutineName)) return + ! NumBl + call RegPack(Buf, InData%NumBl) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegPack(Buf, InData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! BlPitchInit + call RegPack(Buf, allocated(InData%BlPitchInit)) + if (allocated(InData%BlPitchInit)) then + call RegPackBounds(Buf, 1, lbound(InData%BlPitchInit), ubound(InData%BlPitchInit)) + call RegPack(Buf, InData%BlPitchInit) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Gravity + call RegPack(Buf, InData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + ! NacRefPos + call RegPack(Buf, InData%NacRefPos) + if (RegCheckErr(Buf, RoutineName)) return + ! NacTransDisp + call RegPack(Buf, InData%NacTransDisp) + if (RegCheckErr(Buf, RoutineName)) return + ! NacOrient + call RegPack(Buf, InData%NacOrient) + if (RegCheckErr(Buf, RoutineName)) return + ! NacRefOrient + call RegPack(Buf, InData%NacRefOrient) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrBaseRefPos + call RegPack(Buf, InData%TwrBaseRefPos) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrBaseTransDisp + call RegPack(Buf, InData%TwrBaseTransDisp) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrBaseOrient + call RegPack(Buf, InData%TwrBaseOrient) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrBaseRefOrient + call RegPack(Buf, InData%TwrBaseRefOrient) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmRefPos + call RegPack(Buf, InData%PtfmRefPos) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmTransDisp + call RegPack(Buf, InData%PtfmTransDisp) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmOrient + call RegPack(Buf, InData%PtfmOrient) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmRefOrient + call RegPack(Buf, InData%PtfmRefOrient) + if (RegCheckErr(Buf, RoutineName)) return + ! Tmax + call RegPack(Buf, InData%Tmax) + if (RegCheckErr(Buf, RoutineName)) return + ! AvgWindSpeed + call RegPack(Buf, InData%AvgWindSpeed) + if (RegCheckErr(Buf, RoutineName)) return + ! AirDens + call RegPack(Buf, InData%AirDens) + if (RegCheckErr(Buf, RoutineName)) return + ! NumSC2CtrlGlob + call RegPack(Buf, InData%NumSC2CtrlGlob) + if (RegCheckErr(Buf, RoutineName)) return + ! NumSC2Ctrl + call RegPack(Buf, InData%NumSC2Ctrl) + if (RegCheckErr(Buf, RoutineName)) return + ! NumCtrl2SC + call RegPack(Buf, InData%NumCtrl2SC) + if (RegCheckErr(Buf, RoutineName)) return + ! TrimCase + call RegPack(Buf, InData%TrimCase) + if (RegCheckErr(Buf, RoutineName)) return + ! TrimGain + call RegPack(Buf, InData%TrimGain) + if (RegCheckErr(Buf, RoutineName)) return + ! RotSpeedRef + call RegPack(Buf, InData%RotSpeedRef) + if (RegCheckErr(Buf, RoutineName)) return + ! BladeRootRefPos + call RegPack(Buf, allocated(InData%BladeRootRefPos)) + if (allocated(InData%BladeRootRefPos)) then + call RegPackBounds(Buf, 2, lbound(InData%BladeRootRefPos), ubound(InData%BladeRootRefPos)) + call RegPack(Buf, InData%BladeRootRefPos) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BladeRootTransDisp + call RegPack(Buf, allocated(InData%BladeRootTransDisp)) + if (allocated(InData%BladeRootTransDisp)) then + call RegPackBounds(Buf, 2, lbound(InData%BladeRootTransDisp), ubound(InData%BladeRootTransDisp)) + call RegPack(Buf, InData%BladeRootTransDisp) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BladeRootOrient + call RegPack(Buf, allocated(InData%BladeRootOrient)) + if (allocated(InData%BladeRootOrient)) then + call RegPackBounds(Buf, 3, lbound(InData%BladeRootOrient), ubound(InData%BladeRootOrient)) + call RegPack(Buf, InData%BladeRootOrient) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BladeRootRefOrient + call RegPack(Buf, allocated(InData%BladeRootRefOrient)) + if (allocated(InData%BladeRootRefOrient)) then + call RegPackBounds(Buf, 3, lbound(InData%BladeRootRefOrient), ubound(InData%BladeRootRefOrient)) + call RegPack(Buf, InData%BladeRootRefOrient) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! UseInputFile + call RegPack(Buf, InData%UseInputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! PassedPrimaryInputData + call NWTC_Library_PackFileInfoType(Buf, InData%PassedPrimaryInputData) + if (RegCheckErr(Buf, RoutineName)) return + ! NumCableControl + call RegPack(Buf, InData%NumCableControl) + if (RegCheckErr(Buf, RoutineName)) return + ! CableControlRequestor + call RegPack(Buf, allocated(InData%CableControlRequestor)) + if (allocated(InData%CableControlRequestor)) then + call RegPackBounds(Buf, 1, lbound(InData%CableControlRequestor), ubound(InData%CableControlRequestor)) + call RegPack(Buf, InData%CableControlRequestor) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! InterpOrder + call RegPack(Buf, InData%InterpOrder) + if (RegCheckErr(Buf, RoutineName)) return + ! fromSCGlob + call RegPack(Buf, allocated(InData%fromSCGlob)) + if (allocated(InData%fromSCGlob)) then + call RegPackBounds(Buf, 1, lbound(InData%fromSCGlob), ubound(InData%fromSCGlob)) + call RegPack(Buf, InData%fromSCGlob) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! fromSC + call RegPack(Buf, allocated(InData%fromSC)) + if (allocated(InData%fromSC)) then + call RegPackBounds(Buf, 1, lbound(InData%fromSC), ubound(InData%fromSC)) + call RegPack(Buf, InData%fromSC) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LidSpeed + call RegPack(Buf, allocated(InData%LidSpeed)) + if (allocated(InData%LidSpeed)) then + call RegPackBounds(Buf, 1, lbound(InData%LidSpeed), ubound(InData%LidSpeed)) + call RegPack(Buf, InData%LidSpeed) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MsrPositionsX + call RegPack(Buf, allocated(InData%MsrPositionsX)) + if (allocated(InData%MsrPositionsX)) then + call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsX), ubound(InData%MsrPositionsX)) + call RegPack(Buf, InData%MsrPositionsX) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MsrPositionsY + call RegPack(Buf, allocated(InData%MsrPositionsY)) + if (allocated(InData%MsrPositionsY)) then + call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsY), ubound(InData%MsrPositionsY)) + call RegPack(Buf, InData%MsrPositionsY) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MsrPositionsZ + call RegPack(Buf, allocated(InData%MsrPositionsZ)) + if (allocated(InData%MsrPositionsZ)) then + call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsZ), ubound(InData%MsrPositionsZ)) + call RegPack(Buf, InData%MsrPositionsZ) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SensorType + call RegPack(Buf, InData%SensorType) + if (RegCheckErr(Buf, RoutineName)) return + ! NumBeam + call RegPack(Buf, InData%NumBeam) + if (RegCheckErr(Buf, RoutineName)) return + ! NumPulseGate + call RegPack(Buf, InData%NumPulseGate) + if (RegCheckErr(Buf, RoutineName)) return + ! PulseSpacing + call RegPack(Buf, InData%PulseSpacing) + if (RegCheckErr(Buf, RoutineName)) return + ! URefLid + call RegPack(Buf, InData%URefLid) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SrvD_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SrvD_UnPackInitInput' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! InputFile + call RegUnpack(Buf, OutData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! Linearize + call RegUnpack(Buf, OutData%Linearize) + if (RegCheckErr(Buf, RoutineName)) return + ! NumBl + call RegUnpack(Buf, OutData%NumBl) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! BlPitchInit + if (allocated(OutData%BlPitchInit)) deallocate(OutData%BlPitchInit) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlPitchInit(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchInit.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlPitchInit) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Gravity + call RegUnpack(Buf, OutData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + ! NacRefPos + call RegUnpack(Buf, OutData%NacRefPos) + if (RegCheckErr(Buf, RoutineName)) return + ! NacTransDisp + call RegUnpack(Buf, OutData%NacTransDisp) + if (RegCheckErr(Buf, RoutineName)) return + ! NacOrient + call RegUnpack(Buf, OutData%NacOrient) + if (RegCheckErr(Buf, RoutineName)) return + ! NacRefOrient + call RegUnpack(Buf, OutData%NacRefOrient) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrBaseRefPos + call RegUnpack(Buf, OutData%TwrBaseRefPos) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrBaseTransDisp + call RegUnpack(Buf, OutData%TwrBaseTransDisp) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrBaseOrient + call RegUnpack(Buf, OutData%TwrBaseOrient) + if (RegCheckErr(Buf, RoutineName)) return + ! TwrBaseRefOrient + call RegUnpack(Buf, OutData%TwrBaseRefOrient) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmRefPos + call RegUnpack(Buf, OutData%PtfmRefPos) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmTransDisp + call RegUnpack(Buf, OutData%PtfmTransDisp) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmOrient + call RegUnpack(Buf, OutData%PtfmOrient) + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmRefOrient + call RegUnpack(Buf, OutData%PtfmRefOrient) + if (RegCheckErr(Buf, RoutineName)) return + ! Tmax + call RegUnpack(Buf, OutData%Tmax) + if (RegCheckErr(Buf, RoutineName)) return + ! AvgWindSpeed + call RegUnpack(Buf, OutData%AvgWindSpeed) + if (RegCheckErr(Buf, RoutineName)) return + ! AirDens + call RegUnpack(Buf, OutData%AirDens) + if (RegCheckErr(Buf, RoutineName)) return + ! NumSC2CtrlGlob + call RegUnpack(Buf, OutData%NumSC2CtrlGlob) + if (RegCheckErr(Buf, RoutineName)) return + ! NumSC2Ctrl + call RegUnpack(Buf, OutData%NumSC2Ctrl) + if (RegCheckErr(Buf, RoutineName)) return + ! NumCtrl2SC + call RegUnpack(Buf, OutData%NumCtrl2SC) + if (RegCheckErr(Buf, RoutineName)) return + ! TrimCase + call RegUnpack(Buf, OutData%TrimCase) + if (RegCheckErr(Buf, RoutineName)) return + ! TrimGain + call RegUnpack(Buf, OutData%TrimGain) + if (RegCheckErr(Buf, RoutineName)) return + ! RotSpeedRef + call RegUnpack(Buf, OutData%RotSpeedRef) + if (RegCheckErr(Buf, RoutineName)) return + ! BladeRootRefPos + if (allocated(OutData%BladeRootRefPos)) deallocate(OutData%BladeRootRefPos) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BladeRootRefPos(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootRefPos.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BladeRootRefPos) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BladeRootTransDisp + if (allocated(OutData%BladeRootTransDisp)) deallocate(OutData%BladeRootTransDisp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BladeRootTransDisp(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootTransDisp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BladeRootTransDisp) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BladeRootOrient + if (allocated(OutData%BladeRootOrient)) deallocate(OutData%BladeRootOrient) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BladeRootOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootOrient.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BladeRootOrient) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BladeRootRefOrient + if (allocated(OutData%BladeRootRefOrient)) deallocate(OutData%BladeRootRefOrient) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BladeRootRefOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootRefOrient.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BladeRootRefOrient) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! UseInputFile + call RegUnpack(Buf, OutData%UseInputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! PassedPrimaryInputData + call NWTC_Library_UnpackFileInfoType(Buf, OutData%PassedPrimaryInputData) ! PassedPrimaryInputData + ! NumCableControl + call RegUnpack(Buf, OutData%NumCableControl) + if (RegCheckErr(Buf, RoutineName)) return + ! CableControlRequestor + if (allocated(OutData%CableControlRequestor)) deallocate(OutData%CableControlRequestor) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CableControlRequestor(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableControlRequestor.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CableControlRequestor) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! InterpOrder + call RegUnpack(Buf, OutData%InterpOrder) + if (RegCheckErr(Buf, RoutineName)) return + ! fromSCGlob + if (allocated(OutData%fromSCGlob)) deallocate(OutData%fromSCGlob) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%fromSCGlob(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSCGlob.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%fromSCGlob) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! fromSC + if (allocated(OutData%fromSC)) deallocate(OutData%fromSC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%fromSC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%fromSC) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LidSpeed + if (allocated(OutData%LidSpeed)) deallocate(OutData%LidSpeed) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LidSpeed(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LidSpeed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LidSpeed) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! MsrPositionsX + if (allocated(OutData%MsrPositionsX)) deallocate(OutData%MsrPositionsX) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MsrPositionsX(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MsrPositionsX) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! MsrPositionsY + if (allocated(OutData%MsrPositionsY)) deallocate(OutData%MsrPositionsY) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MsrPositionsY(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MsrPositionsY) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! MsrPositionsZ + if (allocated(OutData%MsrPositionsZ)) deallocate(OutData%MsrPositionsZ) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MsrPositionsZ(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsZ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MsrPositionsZ) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! SensorType + call RegUnpack(Buf, OutData%SensorType) + if (RegCheckErr(Buf, RoutineName)) return + ! NumBeam + call RegUnpack(Buf, OutData%NumBeam) + if (RegCheckErr(Buf, RoutineName)) return + ! NumPulseGate + call RegUnpack(Buf, OutData%NumPulseGate) + if (RegCheckErr(Buf, RoutineName)) return + ! PulseSpacing + call RegUnpack(Buf, OutData%PulseSpacing) + if (RegCheckErr(Buf, RoutineName)) return + ! URefLid + call RegUnpack(Buf, OutData%URefLid) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE SrvD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(SrvD_InitOutputType), INTENT(IN) :: SrcInitOutputData TYPE(SrvD_InitOutputType), INTENT(INOUT) :: DstInitOutputData @@ -2024,595 +1521,260 @@ SUBROUTINE SrvD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE SrvD_DestroyInitOutput - SUBROUTINE SrvD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SrvD_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! WriteOutputHdr allocated yes/no - IF ( ALLOCATED(InData%WriteOutputHdr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdr upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdr)*LEN(InData%WriteOutputHdr) ! WriteOutputHdr - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputUnt allocated yes/no - IF ( ALLOCATED(InData%WriteOutputUnt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUnt upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUnt)*LEN(InData%WriteOutputUnt) ! WriteOutputUnt - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! CouplingScheme - Int_BufSz = Int_BufSz + 1 ! UseHSSBrake - Int_BufSz = Int_BufSz + 1 ! LinNames_y allocated yes/no - IF ( ALLOCATED(InData%LinNames_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_y)*LEN(InData%LinNames_y) ! LinNames_y - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_x allocated yes/no - IF ( ALLOCATED(InData%LinNames_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_x)*LEN(InData%LinNames_x) ! LinNames_x - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_u allocated yes/no - IF ( ALLOCATED(InData%LinNames_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_u)*LEN(InData%LinNames_u) ! LinNames_u - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_y allocated yes/no - IF ( ALLOCATED(InData%RotFrame_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_y) ! RotFrame_y - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_x allocated yes/no - IF ( ALLOCATED(InData%RotFrame_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_x) ! RotFrame_x - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_u allocated yes/no - IF ( ALLOCATED(InData%RotFrame_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_u) ! RotFrame_u - END IF - Int_BufSz = Int_BufSz + 1 ! IsLoad_u allocated yes/no - IF ( ALLOCATED(InData%IsLoad_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IsLoad_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IsLoad_u) ! IsLoad_u - END IF - Int_BufSz = Int_BufSz + 1 ! DerivOrder_x allocated yes/no - IF ( ALLOCATED(InData%DerivOrder_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DerivOrder_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%DerivOrder_x) ! DerivOrder_x - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%WriteOutputHdr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) - DO I = 1, LEN(InData%WriteOutputHdr) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputUnt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) - DO I = 1, LEN(InData%WriteOutputUnt) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = InData%CouplingScheme - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseHSSBrake, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%LinNames_y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) - DO I = 1, LEN(InData%LinNames_y) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_y(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinNames_x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_x,1), UBOUND(InData%LinNames_x,1) - DO I = 1, LEN(InData%LinNames_x) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_x(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinNames_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) - DO I = 1, LEN(InData%LinNames_u) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_u(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_y,1), UBOUND(InData%RotFrame_y,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_y(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_x,1), UBOUND(InData%RotFrame_x,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_x(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_u,1), UBOUND(InData%RotFrame_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IsLoad_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IsLoad_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DerivOrder_x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DerivOrder_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DerivOrder_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DerivOrder_x,1), UBOUND(InData%DerivOrder_x,1) - IntKiBuf(Int_Xferred) = InData%DerivOrder_x(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE SrvD_PackInitOutput - - SUBROUTINE SrvD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SrvD_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputHdr)) DEALLOCATE(OutData%WriteOutputHdr) - ALLOCATE(OutData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) - DO I = 1, LEN(OutData%WriteOutputHdr) - OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputUnt)) DEALLOCATE(OutData%WriteOutputUnt) - ALLOCATE(OutData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) - DO I = 1, LEN(OutData%WriteOutputUnt) - OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%CouplingScheme = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UseHSSBrake = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseHSSBrake) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LinNames_y)) DEALLOCATE(OutData%LinNames_y) - ALLOCATE(OutData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) - DO I = 1, LEN(OutData%LinNames_y) - OutData%LinNames_y(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LinNames_x)) DEALLOCATE(OutData%LinNames_x) - ALLOCATE(OutData%LinNames_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_x,1), UBOUND(OutData%LinNames_x,1) - DO I = 1, LEN(OutData%LinNames_x) - OutData%LinNames_x(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LinNames_u)) DEALLOCATE(OutData%LinNames_u) - ALLOCATE(OutData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) - DO I = 1, LEN(OutData%LinNames_u) - OutData%LinNames_u(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RotFrame_y)) DEALLOCATE(OutData%RotFrame_y) - ALLOCATE(OutData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_y,1), UBOUND(OutData%RotFrame_y,1) - OutData%RotFrame_y(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_y(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RotFrame_x)) DEALLOCATE(OutData%RotFrame_x) - ALLOCATE(OutData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_x,1), UBOUND(OutData%RotFrame_x,1) - OutData%RotFrame_x(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_x(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RotFrame_u)) DEALLOCATE(OutData%RotFrame_u) - ALLOCATE(OutData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_u,1), UBOUND(OutData%RotFrame_u,1) - OutData%RotFrame_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IsLoad_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IsLoad_u)) DEALLOCATE(OutData%IsLoad_u) - ALLOCATE(OutData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) - OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DerivOrder_x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DerivOrder_x)) DEALLOCATE(OutData%DerivOrder_x) - ALLOCATE(OutData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DerivOrder_x,1), UBOUND(OutData%DerivOrder_x,1) - OutData%DerivOrder_x(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE SrvD_UnPackInitOutput +subroutine SrvD_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! WriteOutputHdr + call RegPack(Buf, allocated(InData%WriteOutputHdr)) + if (allocated(InData%WriteOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPack(Buf, InData%WriteOutputHdr) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutputUnt + call RegPack(Buf, allocated(InData%WriteOutputUnt)) + if (allocated(InData%WriteOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPack(Buf, InData%WriteOutputUnt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Ver + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + if (RegCheckErr(Buf, RoutineName)) return + ! CouplingScheme + call RegPack(Buf, InData%CouplingScheme) + if (RegCheckErr(Buf, RoutineName)) return + ! UseHSSBrake + call RegPack(Buf, InData%UseHSSBrake) + if (RegCheckErr(Buf, RoutineName)) return + ! LinNames_y + call RegPack(Buf, allocated(InData%LinNames_y)) + if (allocated(InData%LinNames_y)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) + call RegPack(Buf, InData%LinNames_y) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LinNames_x + call RegPack(Buf, allocated(InData%LinNames_x)) + if (allocated(InData%LinNames_x)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_x), ubound(InData%LinNames_x)) + call RegPack(Buf, InData%LinNames_x) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LinNames_u + call RegPack(Buf, allocated(InData%LinNames_u)) + if (allocated(InData%LinNames_u)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) + call RegPack(Buf, InData%LinNames_u) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RotFrame_y + call RegPack(Buf, allocated(InData%RotFrame_y)) + if (allocated(InData%RotFrame_y)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y), ubound(InData%RotFrame_y)) + call RegPack(Buf, InData%RotFrame_y) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RotFrame_x + call RegPack(Buf, allocated(InData%RotFrame_x)) + if (allocated(InData%RotFrame_x)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x), ubound(InData%RotFrame_x)) + call RegPack(Buf, InData%RotFrame_x) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RotFrame_u + call RegPack(Buf, allocated(InData%RotFrame_u)) + if (allocated(InData%RotFrame_u)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u), ubound(InData%RotFrame_u)) + call RegPack(Buf, InData%RotFrame_u) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! IsLoad_u + call RegPack(Buf, allocated(InData%IsLoad_u)) + if (allocated(InData%IsLoad_u)) then + call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) + call RegPack(Buf, InData%IsLoad_u) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DerivOrder_x + call RegPack(Buf, allocated(InData%DerivOrder_x)) + if (allocated(InData%DerivOrder_x)) then + call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x), ubound(InData%DerivOrder_x)) + call RegPack(Buf, InData%DerivOrder_x) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SrvD_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SrvD_UnPackInitOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! WriteOutputHdr + if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WriteOutputUnt + if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Ver + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + ! CouplingScheme + call RegUnpack(Buf, OutData%CouplingScheme) + if (RegCheckErr(Buf, RoutineName)) return + ! UseHSSBrake + call RegUnpack(Buf, OutData%UseHSSBrake) + if (RegCheckErr(Buf, RoutineName)) return + ! LinNames_y + if (allocated(OutData%LinNames_y)) deallocate(OutData%LinNames_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LinNames_x + if (allocated(OutData%LinNames_x)) deallocate(OutData%LinNames_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LinNames_u + if (allocated(OutData%LinNames_u)) deallocate(OutData%LinNames_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RotFrame_y + if (allocated(OutData%RotFrame_y)) deallocate(OutData%RotFrame_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RotFrame_x + if (allocated(OutData%RotFrame_x)) deallocate(OutData%RotFrame_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RotFrame_u + if (allocated(OutData%RotFrame_u)) deallocate(OutData%RotFrame_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! IsLoad_u + if (allocated(OutData%IsLoad_u)) deallocate(OutData%IsLoad_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IsLoad_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IsLoad_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! DerivOrder_x + if (allocated(OutData%DerivOrder_x)) deallocate(OutData%DerivOrder_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DerivOrder_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DerivOrder_x) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE SrvD_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) TYPE(SrvD_InputFile), INTENT(IN) :: SrcInputFileData TYPE(SrvD_InputFile), INTENT(INOUT) :: DstInputFileData @@ -2830,819 +1992,657 @@ SUBROUTINE SrvD_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE SrvD_DestroyInputFile - SUBROUTINE SrvD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SrvD_InputFile), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_PackInputFile' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! DT - Int_BufSz = Int_BufSz + 1 ! Echo - Int_BufSz = Int_BufSz + 1 ! PCMode - Db_BufSz = Db_BufSz + 1 ! TPCOn - Db_BufSz = Db_BufSz + SIZE(InData%TPitManS) ! TPitManS - Re_BufSz = Re_BufSz + SIZE(InData%PitManRat) ! PitManRat - Re_BufSz = Re_BufSz + SIZE(InData%BlPitchF) ! BlPitchF - Int_BufSz = Int_BufSz + 1 ! VSContrl - Int_BufSz = Int_BufSz + 1 ! GenModel - Re_BufSz = Re_BufSz + 1 ! GenEff - Int_BufSz = Int_BufSz + 1 ! GenTiStr - Int_BufSz = Int_BufSz + 1 ! GenTiStp - Re_BufSz = Re_BufSz + 1 ! SpdGenOn - Db_BufSz = Db_BufSz + 1 ! TimGenOn - Db_BufSz = Db_BufSz + 1 ! TimGenOf - Re_BufSz = Re_BufSz + 1 ! VS_RtGnSp - Re_BufSz = Re_BufSz + 1 ! VS_RtTq - Re_BufSz = Re_BufSz + 1 ! VS_Rgn2K - Re_BufSz = Re_BufSz + 1 ! VS_SlPc - Re_BufSz = Re_BufSz + 1 ! SIG_SlPc - Re_BufSz = Re_BufSz + 1 ! SIG_SySp - Re_BufSz = Re_BufSz + 1 ! SIG_RtTq - Re_BufSz = Re_BufSz + 1 ! SIG_PORt - Re_BufSz = Re_BufSz + 1 ! TEC_Freq - Int_BufSz = Int_BufSz + 1 ! TEC_NPol - Re_BufSz = Re_BufSz + 1 ! TEC_SRes - Re_BufSz = Re_BufSz + 1 ! TEC_RRes - Re_BufSz = Re_BufSz + 1 ! TEC_VLL - Re_BufSz = Re_BufSz + 1 ! TEC_SLR - Re_BufSz = Re_BufSz + 1 ! TEC_RLR - Re_BufSz = Re_BufSz + 1 ! TEC_MR - Int_BufSz = Int_BufSz + 1 ! HSSBrMode - Db_BufSz = Db_BufSz + 1 ! THSSBrDp - Db_BufSz = Db_BufSz + 1 ! HSSBrDT - Re_BufSz = Re_BufSz + 1 ! HSSBrTqF - Int_BufSz = Int_BufSz + 1 ! YCMode - Db_BufSz = Db_BufSz + 1 ! TYCOn - Re_BufSz = Re_BufSz + 1 ! YawNeut - Re_BufSz = Re_BufSz + 1 ! YawSpr - Re_BufSz = Re_BufSz + 1 ! YawDamp - Db_BufSz = Db_BufSz + 1 ! TYawManS - Re_BufSz = Re_BufSz + 1 ! YawManRat - Re_BufSz = Re_BufSz + 1 ! NacYawF - Int_BufSz = Int_BufSz + 1 ! SumPrint - Int_BufSz = Int_BufSz + 1 ! OutFile - Int_BufSz = Int_BufSz + 1 ! TabDelim - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt - Db_BufSz = Db_BufSz + 1 ! Tstart - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! OutList allocated yes/no - IF ( ALLOCATED(InData%OutList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%OutList)*LEN(InData%OutList) ! OutList - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%DLL_FileName) ! DLL_FileName - Int_BufSz = Int_BufSz + 1*LEN(InData%DLL_ProcName) ! DLL_ProcName - Int_BufSz = Int_BufSz + 1*LEN(InData%DLL_InFile) ! DLL_InFile - Db_BufSz = Db_BufSz + 1 ! DLL_DT - Int_BufSz = Int_BufSz + 1 ! DLL_Ramp - Re_BufSz = Re_BufSz + 1 ! BPCutoff - Re_BufSz = Re_BufSz + 1 ! NacYaw_North - Int_BufSz = Int_BufSz + 1 ! Ptch_Cntrl - Re_BufSz = Re_BufSz + 1 ! Ptch_SetPnt - Re_BufSz = Re_BufSz + 1 ! Ptch_Min - Re_BufSz = Re_BufSz + 1 ! Ptch_Max - Re_BufSz = Re_BufSz + 1 ! PtchRate_Min - Re_BufSz = Re_BufSz + 1 ! PtchRate_Max - Re_BufSz = Re_BufSz + 1 ! Gain_OM - Re_BufSz = Re_BufSz + 1 ! GenSpd_MinOM - Re_BufSz = Re_BufSz + 1 ! GenSpd_MaxOM - Re_BufSz = Re_BufSz + 1 ! GenSpd_Dem - Re_BufSz = Re_BufSz + 1 ! GenTrq_Dem - Re_BufSz = Re_BufSz + 1 ! GenPwr_Dem - Int_BufSz = Int_BufSz + 1 ! DLL_NumTrq - Int_BufSz = Int_BufSz + 1 ! GenSpd_TLU allocated yes/no - IF ( ALLOCATED(InData%GenSpd_TLU) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! GenSpd_TLU upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GenSpd_TLU) ! GenSpd_TLU - END IF - Int_BufSz = Int_BufSz + 1 ! GenTrq_TLU allocated yes/no - IF ( ALLOCATED(InData%GenTrq_TLU) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! GenTrq_TLU upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GenTrq_TLU) ! GenTrq_TLU - END IF - Int_BufSz = Int_BufSz + 1 ! UseLegacyInterface - Int_BufSz = Int_BufSz + 1 ! NumBStC - Int_BufSz = Int_BufSz + 1 ! BStCfiles allocated yes/no - IF ( ALLOCATED(InData%BStCfiles) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BStCfiles upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BStCfiles)*LEN(InData%BStCfiles) ! BStCfiles - END IF - Int_BufSz = Int_BufSz + 1 ! NumNStC - Int_BufSz = Int_BufSz + 1 ! NStCfiles allocated yes/no - IF ( ALLOCATED(InData%NStCfiles) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NStCfiles upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NStCfiles)*LEN(InData%NStCfiles) ! NStCfiles - END IF - Int_BufSz = Int_BufSz + 1 ! NumTStC - Int_BufSz = Int_BufSz + 1 ! TStCfiles allocated yes/no - IF ( ALLOCATED(InData%TStCfiles) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TStCfiles upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%TStCfiles)*LEN(InData%TStCfiles) ! TStCfiles - END IF - Int_BufSz = Int_BufSz + 1 ! NumSStC - Int_BufSz = Int_BufSz + 1 ! SStCfiles allocated yes/no - IF ( ALLOCATED(InData%SStCfiles) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SStCfiles upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%SStCfiles)*LEN(InData%SStCfiles) ! SStCfiles - END IF - Int_BufSz = Int_BufSz + 1 ! AfCmode - Re_BufSz = Re_BufSz + 1 ! AfC_Mean - Re_BufSz = Re_BufSz + 1 ! AfC_Amp - Re_BufSz = Re_BufSz + 1 ! AfC_Phase - Int_BufSz = Int_BufSz + 1 ! CCmode - Int_BufSz = Int_BufSz + 1 ! EXavrSWAP - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Echo, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%PCMode - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TPCOn - Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%TPitManS,1), UBOUND(InData%TPitManS,1) - DbKiBuf(Db_Xferred) = InData%TPitManS(i1) - Db_Xferred = Db_Xferred + 1 - END DO - DO i1 = LBOUND(InData%PitManRat,1), UBOUND(InData%PitManRat,1) - ReKiBuf(Re_Xferred) = InData%PitManRat(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%BlPitchF,1), UBOUND(InData%BlPitchF,1) - ReKiBuf(Re_Xferred) = InData%BlPitchF(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%VSContrl - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%GenModel - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenEff - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%GenTiStr, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%GenTiStp, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SpdGenOn - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TimGenOn - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TimGenOf - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VS_RtGnSp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VS_RtTq - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VS_Rgn2K - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VS_SlPc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SIG_SlPc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SIG_SySp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SIG_RtTq - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SIG_PORt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_Freq - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TEC_NPol - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_SRes - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_RRes - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_VLL - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_SLR - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_RLR - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_MR - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%HSSBrMode - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%THSSBrDp - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%HSSBrDT - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HSSBrTqF - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%YCMode - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TYCOn - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawNeut - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawDamp - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TYawManS - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawManRat - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NacYawF - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%OutFile - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TabDelim, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf(Db_Xferred) = InData%Tstart - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) - DO I = 1, LEN(InData%OutList) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - DO I = 1, LEN(InData%DLL_FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%DLL_ProcName) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_ProcName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%DLL_InFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_InFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf(Db_Xferred) = InData%DLL_DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%DLL_Ramp, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%BPCutoff - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NacYaw_North - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Ptch_Cntrl - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Ptch_SetPnt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Ptch_Min - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Ptch_Max - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtchRate_Min - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtchRate_Max - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Gain_OM - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenSpd_MinOM - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenSpd_MaxOM - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenSpd_Dem - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenTrq_Dem - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenPwr_Dem - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%DLL_NumTrq - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%GenSpd_TLU) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GenSpd_TLU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GenSpd_TLU,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%GenSpd_TLU,1), UBOUND(InData%GenSpd_TLU,1) - ReKiBuf(Re_Xferred) = InData%GenSpd_TLU(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%GenTrq_TLU) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GenTrq_TLU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GenTrq_TLU,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%GenTrq_TLU,1), UBOUND(InData%GenTrq_TLU,1) - ReKiBuf(Re_Xferred) = InData%GenTrq_TLU(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseLegacyInterface, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBStC - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BStCfiles) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BStCfiles,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStCfiles,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BStCfiles,1), UBOUND(InData%BStCfiles,1) - DO I = 1, LEN(InData%BStCfiles) - IntKiBuf(Int_Xferred) = ICHAR(InData%BStCfiles(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NumNStC - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%NStCfiles) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NStCfiles,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NStCfiles,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NStCfiles,1), UBOUND(InData%NStCfiles,1) - DO I = 1, LEN(InData%NStCfiles) - IntKiBuf(Int_Xferred) = ICHAR(InData%NStCfiles(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NumTStC - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TStCfiles) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TStCfiles,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TStCfiles,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TStCfiles,1), UBOUND(InData%TStCfiles,1) - DO I = 1, LEN(InData%TStCfiles) - IntKiBuf(Int_Xferred) = ICHAR(InData%TStCfiles(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NumSStC - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%SStCfiles) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SStCfiles,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SStCfiles,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SStCfiles,1), UBOUND(InData%SStCfiles,1) - DO I = 1, LEN(InData%SStCfiles) - IntKiBuf(Int_Xferred) = ICHAR(InData%SStCfiles(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IntKiBuf(Int_Xferred) = InData%AfCmode - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AfC_Mean - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AfC_Amp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AfC_Phase - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%CCmode - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%EXavrSWAP, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SrvD_PackInputFile - - SUBROUTINE SrvD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SrvD_InputFile), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_UnPackInputFile' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Echo = TRANSFER(IntKiBuf(Int_Xferred), OutData%Echo) - Int_Xferred = Int_Xferred + 1 - OutData%PCMode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TPCOn = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%TPitManS,1) - i1_u = UBOUND(OutData%TPitManS,1) - DO i1 = LBOUND(OutData%TPitManS,1), UBOUND(OutData%TPitManS,1) - OutData%TPitManS(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - i1_l = LBOUND(OutData%PitManRat,1) - i1_u = UBOUND(OutData%PitManRat,1) - DO i1 = LBOUND(OutData%PitManRat,1), UBOUND(OutData%PitManRat,1) - OutData%PitManRat(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%BlPitchF,1) - i1_u = UBOUND(OutData%BlPitchF,1) - DO i1 = LBOUND(OutData%BlPitchF,1), UBOUND(OutData%BlPitchF,1) - OutData%BlPitchF(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%VSContrl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%GenModel = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%GenEff = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenTiStr = TRANSFER(IntKiBuf(Int_Xferred), OutData%GenTiStr) - Int_Xferred = Int_Xferred + 1 - OutData%GenTiStp = TRANSFER(IntKiBuf(Int_Xferred), OutData%GenTiStp) - Int_Xferred = Int_Xferred + 1 - OutData%SpdGenOn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TimGenOn = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%TimGenOf = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%VS_RtGnSp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VS_RtTq = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VS_Rgn2K = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VS_SlPc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_SlPc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_SySp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_RtTq = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_PORt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_Freq = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_NPol = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TEC_SRes = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_RRes = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_VLL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_SLR = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_RLR = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_MR = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HSSBrMode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%THSSBrDp = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%HSSBrDT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%HSSBrTqF = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YCMode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TYCOn = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%YawNeut = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawDamp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TYawManS = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%YawManRat = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NacYawF = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) - Int_Xferred = Int_Xferred + 1 - OutData%OutFile = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TabDelim = TRANSFER(IntKiBuf(Int_Xferred), OutData%TabDelim) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Tstart = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutList not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutList)) DEALLOCATE(OutData%OutList) - ALLOCATE(OutData%OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) - DO I = 1, LEN(OutData%OutList) - OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - DO I = 1, LEN(OutData%DLL_FileName) - OutData%DLL_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%DLL_ProcName) - OutData%DLL_ProcName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%DLL_InFile) - OutData%DLL_InFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%DLL_DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%DLL_Ramp = TRANSFER(IntKiBuf(Int_Xferred), OutData%DLL_Ramp) - Int_Xferred = Int_Xferred + 1 - OutData%BPCutoff = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NacYaw_North = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Ptch_Cntrl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Ptch_SetPnt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Ptch_Min = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Ptch_Max = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtchRate_Min = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtchRate_Max = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Gain_OM = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenSpd_MinOM = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenSpd_MaxOM = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenSpd_Dem = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenTrq_Dem = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenPwr_Dem = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DLL_NumTrq = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GenSpd_TLU not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%GenSpd_TLU)) DEALLOCATE(OutData%GenSpd_TLU) - ALLOCATE(OutData%GenSpd_TLU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GenSpd_TLU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%GenSpd_TLU,1), UBOUND(OutData%GenSpd_TLU,1) - OutData%GenSpd_TLU(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GenTrq_TLU not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%GenTrq_TLU)) DEALLOCATE(OutData%GenTrq_TLU) - ALLOCATE(OutData%GenTrq_TLU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GenTrq_TLU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%GenTrq_TLU,1), UBOUND(OutData%GenTrq_TLU,1) - OutData%GenTrq_TLU(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%UseLegacyInterface = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseLegacyInterface) - Int_Xferred = Int_Xferred + 1 - OutData%NumBStC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BStCfiles not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BStCfiles)) DEALLOCATE(OutData%BStCfiles) - ALLOCATE(OutData%BStCfiles(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStCfiles.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BStCfiles,1), UBOUND(OutData%BStCfiles,1) - DO I = 1, LEN(OutData%BStCfiles) - OutData%BStCfiles(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - OutData%NumNStC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NStCfiles not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NStCfiles)) DEALLOCATE(OutData%NStCfiles) - ALLOCATE(OutData%NStCfiles(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStCfiles.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NStCfiles,1), UBOUND(OutData%NStCfiles,1) - DO I = 1, LEN(OutData%NStCfiles) - OutData%NStCfiles(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - OutData%NumTStC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TStCfiles not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TStCfiles)) DEALLOCATE(OutData%TStCfiles) - ALLOCATE(OutData%TStCfiles(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStCfiles.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TStCfiles,1), UBOUND(OutData%TStCfiles,1) - DO I = 1, LEN(OutData%TStCfiles) - OutData%TStCfiles(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - OutData%NumSStC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SStCfiles not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SStCfiles)) DEALLOCATE(OutData%SStCfiles) - ALLOCATE(OutData%SStCfiles(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStCfiles.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SStCfiles,1), UBOUND(OutData%SStCfiles,1) - DO I = 1, LEN(OutData%SStCfiles) - OutData%SStCfiles(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - OutData%AfCmode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%AfC_Mean = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AfC_Amp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AfC_Phase = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CCmode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%EXavrSWAP = TRANSFER(IntKiBuf(Int_Xferred), OutData%EXavrSWAP) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SrvD_UnPackInputFile +subroutine SrvD_PackInputFile(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_InputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackInputFile' + if (Buf%ErrStat >= AbortErrLev) return + ! DT + call RegPack(Buf, InData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! Echo + call RegPack(Buf, InData%Echo) + if (RegCheckErr(Buf, RoutineName)) return + ! PCMode + call RegPack(Buf, InData%PCMode) + if (RegCheckErr(Buf, RoutineName)) return + ! TPCOn + call RegPack(Buf, InData%TPCOn) + if (RegCheckErr(Buf, RoutineName)) return + ! TPitManS + call RegPack(Buf, InData%TPitManS) + if (RegCheckErr(Buf, RoutineName)) return + ! PitManRat + call RegPack(Buf, InData%PitManRat) + if (RegCheckErr(Buf, RoutineName)) return + ! BlPitchF + call RegPack(Buf, InData%BlPitchF) + if (RegCheckErr(Buf, RoutineName)) return + ! VSContrl + call RegPack(Buf, InData%VSContrl) + if (RegCheckErr(Buf, RoutineName)) return + ! GenModel + call RegPack(Buf, InData%GenModel) + if (RegCheckErr(Buf, RoutineName)) return + ! GenEff + call RegPack(Buf, InData%GenEff) + if (RegCheckErr(Buf, RoutineName)) return + ! GenTiStr + call RegPack(Buf, InData%GenTiStr) + if (RegCheckErr(Buf, RoutineName)) return + ! GenTiStp + call RegPack(Buf, InData%GenTiStp) + if (RegCheckErr(Buf, RoutineName)) return + ! SpdGenOn + call RegPack(Buf, InData%SpdGenOn) + if (RegCheckErr(Buf, RoutineName)) return + ! TimGenOn + call RegPack(Buf, InData%TimGenOn) + if (RegCheckErr(Buf, RoutineName)) return + ! TimGenOf + call RegPack(Buf, InData%TimGenOf) + if (RegCheckErr(Buf, RoutineName)) return + ! VS_RtGnSp + call RegPack(Buf, InData%VS_RtGnSp) + if (RegCheckErr(Buf, RoutineName)) return + ! VS_RtTq + call RegPack(Buf, InData%VS_RtTq) + if (RegCheckErr(Buf, RoutineName)) return + ! VS_Rgn2K + call RegPack(Buf, InData%VS_Rgn2K) + if (RegCheckErr(Buf, RoutineName)) return + ! VS_SlPc + call RegPack(Buf, InData%VS_SlPc) + if (RegCheckErr(Buf, RoutineName)) return + ! SIG_SlPc + call RegPack(Buf, InData%SIG_SlPc) + if (RegCheckErr(Buf, RoutineName)) return + ! SIG_SySp + call RegPack(Buf, InData%SIG_SySp) + if (RegCheckErr(Buf, RoutineName)) return + ! SIG_RtTq + call RegPack(Buf, InData%SIG_RtTq) + if (RegCheckErr(Buf, RoutineName)) return + ! SIG_PORt + call RegPack(Buf, InData%SIG_PORt) + if (RegCheckErr(Buf, RoutineName)) return + ! TEC_Freq + call RegPack(Buf, InData%TEC_Freq) + if (RegCheckErr(Buf, RoutineName)) return + ! TEC_NPol + call RegPack(Buf, InData%TEC_NPol) + if (RegCheckErr(Buf, RoutineName)) return + ! TEC_SRes + call RegPack(Buf, InData%TEC_SRes) + if (RegCheckErr(Buf, RoutineName)) return + ! TEC_RRes + call RegPack(Buf, InData%TEC_RRes) + if (RegCheckErr(Buf, RoutineName)) return + ! TEC_VLL + call RegPack(Buf, InData%TEC_VLL) + if (RegCheckErr(Buf, RoutineName)) return + ! TEC_SLR + call RegPack(Buf, InData%TEC_SLR) + if (RegCheckErr(Buf, RoutineName)) return + ! TEC_RLR + call RegPack(Buf, InData%TEC_RLR) + if (RegCheckErr(Buf, RoutineName)) return + ! TEC_MR + call RegPack(Buf, InData%TEC_MR) + if (RegCheckErr(Buf, RoutineName)) return + ! HSSBrMode + call RegPack(Buf, InData%HSSBrMode) + if (RegCheckErr(Buf, RoutineName)) return + ! THSSBrDp + call RegPack(Buf, InData%THSSBrDp) + if (RegCheckErr(Buf, RoutineName)) return + ! HSSBrDT + call RegPack(Buf, InData%HSSBrDT) + if (RegCheckErr(Buf, RoutineName)) return + ! HSSBrTqF + call RegPack(Buf, InData%HSSBrTqF) + if (RegCheckErr(Buf, RoutineName)) return + ! YCMode + call RegPack(Buf, InData%YCMode) + if (RegCheckErr(Buf, RoutineName)) return + ! TYCOn + call RegPack(Buf, InData%TYCOn) + if (RegCheckErr(Buf, RoutineName)) return + ! YawNeut + call RegPack(Buf, InData%YawNeut) + if (RegCheckErr(Buf, RoutineName)) return + ! YawSpr + call RegPack(Buf, InData%YawSpr) + if (RegCheckErr(Buf, RoutineName)) return + ! YawDamp + call RegPack(Buf, InData%YawDamp) + if (RegCheckErr(Buf, RoutineName)) return + ! TYawManS + call RegPack(Buf, InData%TYawManS) + if (RegCheckErr(Buf, RoutineName)) return + ! YawManRat + call RegPack(Buf, InData%YawManRat) + if (RegCheckErr(Buf, RoutineName)) return + ! NacYawF + call RegPack(Buf, InData%NacYawF) + if (RegCheckErr(Buf, RoutineName)) return + ! SumPrint + call RegPack(Buf, InData%SumPrint) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFile + call RegPack(Buf, InData%OutFile) + if (RegCheckErr(Buf, RoutineName)) return + ! TabDelim + call RegPack(Buf, InData%TabDelim) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFmt + call RegPack(Buf, InData%OutFmt) + if (RegCheckErr(Buf, RoutineName)) return + ! Tstart + call RegPack(Buf, InData%Tstart) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegPack(Buf, InData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! OutList + call RegPack(Buf, allocated(InData%OutList)) + if (allocated(InData%OutList)) then + call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) + call RegPack(Buf, InData%OutList) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DLL_FileName + call RegPack(Buf, InData%DLL_FileName) + if (RegCheckErr(Buf, RoutineName)) return + ! DLL_ProcName + call RegPack(Buf, InData%DLL_ProcName) + if (RegCheckErr(Buf, RoutineName)) return + ! DLL_InFile + call RegPack(Buf, InData%DLL_InFile) + if (RegCheckErr(Buf, RoutineName)) return + ! DLL_DT + call RegPack(Buf, InData%DLL_DT) + if (RegCheckErr(Buf, RoutineName)) return + ! DLL_Ramp + call RegPack(Buf, InData%DLL_Ramp) + if (RegCheckErr(Buf, RoutineName)) return + ! BPCutoff + call RegPack(Buf, InData%BPCutoff) + if (RegCheckErr(Buf, RoutineName)) return + ! NacYaw_North + call RegPack(Buf, InData%NacYaw_North) + if (RegCheckErr(Buf, RoutineName)) return + ! Ptch_Cntrl + call RegPack(Buf, InData%Ptch_Cntrl) + if (RegCheckErr(Buf, RoutineName)) return + ! Ptch_SetPnt + call RegPack(Buf, InData%Ptch_SetPnt) + if (RegCheckErr(Buf, RoutineName)) return + ! Ptch_Min + call RegPack(Buf, InData%Ptch_Min) + if (RegCheckErr(Buf, RoutineName)) return + ! Ptch_Max + call RegPack(Buf, InData%Ptch_Max) + if (RegCheckErr(Buf, RoutineName)) return + ! PtchRate_Min + call RegPack(Buf, InData%PtchRate_Min) + if (RegCheckErr(Buf, RoutineName)) return + ! PtchRate_Max + call RegPack(Buf, InData%PtchRate_Max) + if (RegCheckErr(Buf, RoutineName)) return + ! Gain_OM + call RegPack(Buf, InData%Gain_OM) + if (RegCheckErr(Buf, RoutineName)) return + ! GenSpd_MinOM + call RegPack(Buf, InData%GenSpd_MinOM) + if (RegCheckErr(Buf, RoutineName)) return + ! GenSpd_MaxOM + call RegPack(Buf, InData%GenSpd_MaxOM) + if (RegCheckErr(Buf, RoutineName)) return + ! GenSpd_Dem + call RegPack(Buf, InData%GenSpd_Dem) + if (RegCheckErr(Buf, RoutineName)) return + ! GenTrq_Dem + call RegPack(Buf, InData%GenTrq_Dem) + if (RegCheckErr(Buf, RoutineName)) return + ! GenPwr_Dem + call RegPack(Buf, InData%GenPwr_Dem) + if (RegCheckErr(Buf, RoutineName)) return + ! DLL_NumTrq + call RegPack(Buf, InData%DLL_NumTrq) + if (RegCheckErr(Buf, RoutineName)) return + ! GenSpd_TLU + call RegPack(Buf, allocated(InData%GenSpd_TLU)) + if (allocated(InData%GenSpd_TLU)) then + call RegPackBounds(Buf, 1, lbound(InData%GenSpd_TLU), ubound(InData%GenSpd_TLU)) + call RegPack(Buf, InData%GenSpd_TLU) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! GenTrq_TLU + call RegPack(Buf, allocated(InData%GenTrq_TLU)) + if (allocated(InData%GenTrq_TLU)) then + call RegPackBounds(Buf, 1, lbound(InData%GenTrq_TLU), ubound(InData%GenTrq_TLU)) + call RegPack(Buf, InData%GenTrq_TLU) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! UseLegacyInterface + call RegPack(Buf, InData%UseLegacyInterface) + if (RegCheckErr(Buf, RoutineName)) return + ! NumBStC + call RegPack(Buf, InData%NumBStC) + if (RegCheckErr(Buf, RoutineName)) return + ! BStCfiles + call RegPack(Buf, allocated(InData%BStCfiles)) + if (allocated(InData%BStCfiles)) then + call RegPackBounds(Buf, 1, lbound(InData%BStCfiles), ubound(InData%BStCfiles)) + call RegPack(Buf, InData%BStCfiles) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NumNStC + call RegPack(Buf, InData%NumNStC) + if (RegCheckErr(Buf, RoutineName)) return + ! NStCfiles + call RegPack(Buf, allocated(InData%NStCfiles)) + if (allocated(InData%NStCfiles)) then + call RegPackBounds(Buf, 1, lbound(InData%NStCfiles), ubound(InData%NStCfiles)) + call RegPack(Buf, InData%NStCfiles) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NumTStC + call RegPack(Buf, InData%NumTStC) + if (RegCheckErr(Buf, RoutineName)) return + ! TStCfiles + call RegPack(Buf, allocated(InData%TStCfiles)) + if (allocated(InData%TStCfiles)) then + call RegPackBounds(Buf, 1, lbound(InData%TStCfiles), ubound(InData%TStCfiles)) + call RegPack(Buf, InData%TStCfiles) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NumSStC + call RegPack(Buf, InData%NumSStC) + if (RegCheckErr(Buf, RoutineName)) return + ! SStCfiles + call RegPack(Buf, allocated(InData%SStCfiles)) + if (allocated(InData%SStCfiles)) then + call RegPackBounds(Buf, 1, lbound(InData%SStCfiles), ubound(InData%SStCfiles)) + call RegPack(Buf, InData%SStCfiles) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AfCmode + call RegPack(Buf, InData%AfCmode) + if (RegCheckErr(Buf, RoutineName)) return + ! AfC_Mean + call RegPack(Buf, InData%AfC_Mean) + if (RegCheckErr(Buf, RoutineName)) return + ! AfC_Amp + call RegPack(Buf, InData%AfC_Amp) + if (RegCheckErr(Buf, RoutineName)) return + ! AfC_Phase + call RegPack(Buf, InData%AfC_Phase) + if (RegCheckErr(Buf, RoutineName)) return + ! CCmode + call RegPack(Buf, InData%CCmode) + if (RegCheckErr(Buf, RoutineName)) return + ! EXavrSWAP + call RegPack(Buf, InData%EXavrSWAP) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SrvD_UnPackInputFile(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_InputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SrvD_UnPackInputFile' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! DT + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! Echo + call RegUnpack(Buf, OutData%Echo) + if (RegCheckErr(Buf, RoutineName)) return + ! PCMode + call RegUnpack(Buf, OutData%PCMode) + if (RegCheckErr(Buf, RoutineName)) return + ! TPCOn + call RegUnpack(Buf, OutData%TPCOn) + if (RegCheckErr(Buf, RoutineName)) return + ! TPitManS + call RegUnpack(Buf, OutData%TPitManS) + if (RegCheckErr(Buf, RoutineName)) return + ! PitManRat + call RegUnpack(Buf, OutData%PitManRat) + if (RegCheckErr(Buf, RoutineName)) return + ! BlPitchF + call RegUnpack(Buf, OutData%BlPitchF) + if (RegCheckErr(Buf, RoutineName)) return + ! VSContrl + call RegUnpack(Buf, OutData%VSContrl) + if (RegCheckErr(Buf, RoutineName)) return + ! GenModel + call RegUnpack(Buf, OutData%GenModel) + if (RegCheckErr(Buf, RoutineName)) return + ! GenEff + call RegUnpack(Buf, OutData%GenEff) + if (RegCheckErr(Buf, RoutineName)) return + ! GenTiStr + call RegUnpack(Buf, OutData%GenTiStr) + if (RegCheckErr(Buf, RoutineName)) return + ! GenTiStp + call RegUnpack(Buf, OutData%GenTiStp) + if (RegCheckErr(Buf, RoutineName)) return + ! SpdGenOn + call RegUnpack(Buf, OutData%SpdGenOn) + if (RegCheckErr(Buf, RoutineName)) return + ! TimGenOn + call RegUnpack(Buf, OutData%TimGenOn) + if (RegCheckErr(Buf, RoutineName)) return + ! TimGenOf + call RegUnpack(Buf, OutData%TimGenOf) + if (RegCheckErr(Buf, RoutineName)) return + ! VS_RtGnSp + call RegUnpack(Buf, OutData%VS_RtGnSp) + if (RegCheckErr(Buf, RoutineName)) return + ! VS_RtTq + call RegUnpack(Buf, OutData%VS_RtTq) + if (RegCheckErr(Buf, RoutineName)) return + ! VS_Rgn2K + call RegUnpack(Buf, OutData%VS_Rgn2K) + if (RegCheckErr(Buf, RoutineName)) return + ! VS_SlPc + call RegUnpack(Buf, OutData%VS_SlPc) + if (RegCheckErr(Buf, RoutineName)) return + ! SIG_SlPc + call RegUnpack(Buf, OutData%SIG_SlPc) + if (RegCheckErr(Buf, RoutineName)) return + ! SIG_SySp + call RegUnpack(Buf, OutData%SIG_SySp) + if (RegCheckErr(Buf, RoutineName)) return + ! SIG_RtTq + call RegUnpack(Buf, OutData%SIG_RtTq) + if (RegCheckErr(Buf, RoutineName)) return + ! SIG_PORt + call RegUnpack(Buf, OutData%SIG_PORt) + if (RegCheckErr(Buf, RoutineName)) return + ! TEC_Freq + call RegUnpack(Buf, OutData%TEC_Freq) + if (RegCheckErr(Buf, RoutineName)) return + ! TEC_NPol + call RegUnpack(Buf, OutData%TEC_NPol) + if (RegCheckErr(Buf, RoutineName)) return + ! TEC_SRes + call RegUnpack(Buf, OutData%TEC_SRes) + if (RegCheckErr(Buf, RoutineName)) return + ! TEC_RRes + call RegUnpack(Buf, OutData%TEC_RRes) + if (RegCheckErr(Buf, RoutineName)) return + ! TEC_VLL + call RegUnpack(Buf, OutData%TEC_VLL) + if (RegCheckErr(Buf, RoutineName)) return + ! TEC_SLR + call RegUnpack(Buf, OutData%TEC_SLR) + if (RegCheckErr(Buf, RoutineName)) return + ! TEC_RLR + call RegUnpack(Buf, OutData%TEC_RLR) + if (RegCheckErr(Buf, RoutineName)) return + ! TEC_MR + call RegUnpack(Buf, OutData%TEC_MR) + if (RegCheckErr(Buf, RoutineName)) return + ! HSSBrMode + call RegUnpack(Buf, OutData%HSSBrMode) + if (RegCheckErr(Buf, RoutineName)) return + ! THSSBrDp + call RegUnpack(Buf, OutData%THSSBrDp) + if (RegCheckErr(Buf, RoutineName)) return + ! HSSBrDT + call RegUnpack(Buf, OutData%HSSBrDT) + if (RegCheckErr(Buf, RoutineName)) return + ! HSSBrTqF + call RegUnpack(Buf, OutData%HSSBrTqF) + if (RegCheckErr(Buf, RoutineName)) return + ! YCMode + call RegUnpack(Buf, OutData%YCMode) + if (RegCheckErr(Buf, RoutineName)) return + ! TYCOn + call RegUnpack(Buf, OutData%TYCOn) + if (RegCheckErr(Buf, RoutineName)) return + ! YawNeut + call RegUnpack(Buf, OutData%YawNeut) + if (RegCheckErr(Buf, RoutineName)) return + ! YawSpr + call RegUnpack(Buf, OutData%YawSpr) + if (RegCheckErr(Buf, RoutineName)) return + ! YawDamp + call RegUnpack(Buf, OutData%YawDamp) + if (RegCheckErr(Buf, RoutineName)) return + ! TYawManS + call RegUnpack(Buf, OutData%TYawManS) + if (RegCheckErr(Buf, RoutineName)) return + ! YawManRat + call RegUnpack(Buf, OutData%YawManRat) + if (RegCheckErr(Buf, RoutineName)) return + ! NacYawF + call RegUnpack(Buf, OutData%NacYawF) + if (RegCheckErr(Buf, RoutineName)) return + ! SumPrint + call RegUnpack(Buf, OutData%SumPrint) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFile + call RegUnpack(Buf, OutData%OutFile) + if (RegCheckErr(Buf, RoutineName)) return + ! TabDelim + call RegUnpack(Buf, OutData%TabDelim) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFmt + call RegUnpack(Buf, OutData%OutFmt) + if (RegCheckErr(Buf, RoutineName)) return + ! Tstart + call RegUnpack(Buf, OutData%Tstart) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! OutList + if (allocated(OutData%OutList)) deallocate(OutData%OutList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OutList) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! DLL_FileName + call RegUnpack(Buf, OutData%DLL_FileName) + if (RegCheckErr(Buf, RoutineName)) return + ! DLL_ProcName + call RegUnpack(Buf, OutData%DLL_ProcName) + if (RegCheckErr(Buf, RoutineName)) return + ! DLL_InFile + call RegUnpack(Buf, OutData%DLL_InFile) + if (RegCheckErr(Buf, RoutineName)) return + ! DLL_DT + call RegUnpack(Buf, OutData%DLL_DT) + if (RegCheckErr(Buf, RoutineName)) return + ! DLL_Ramp + call RegUnpack(Buf, OutData%DLL_Ramp) + if (RegCheckErr(Buf, RoutineName)) return + ! BPCutoff + call RegUnpack(Buf, OutData%BPCutoff) + if (RegCheckErr(Buf, RoutineName)) return + ! NacYaw_North + call RegUnpack(Buf, OutData%NacYaw_North) + if (RegCheckErr(Buf, RoutineName)) return + ! Ptch_Cntrl + call RegUnpack(Buf, OutData%Ptch_Cntrl) + if (RegCheckErr(Buf, RoutineName)) return + ! Ptch_SetPnt + call RegUnpack(Buf, OutData%Ptch_SetPnt) + if (RegCheckErr(Buf, RoutineName)) return + ! Ptch_Min + call RegUnpack(Buf, OutData%Ptch_Min) + if (RegCheckErr(Buf, RoutineName)) return + ! Ptch_Max + call RegUnpack(Buf, OutData%Ptch_Max) + if (RegCheckErr(Buf, RoutineName)) return + ! PtchRate_Min + call RegUnpack(Buf, OutData%PtchRate_Min) + if (RegCheckErr(Buf, RoutineName)) return + ! PtchRate_Max + call RegUnpack(Buf, OutData%PtchRate_Max) + if (RegCheckErr(Buf, RoutineName)) return + ! Gain_OM + call RegUnpack(Buf, OutData%Gain_OM) + if (RegCheckErr(Buf, RoutineName)) return + ! GenSpd_MinOM + call RegUnpack(Buf, OutData%GenSpd_MinOM) + if (RegCheckErr(Buf, RoutineName)) return + ! GenSpd_MaxOM + call RegUnpack(Buf, OutData%GenSpd_MaxOM) + if (RegCheckErr(Buf, RoutineName)) return + ! GenSpd_Dem + call RegUnpack(Buf, OutData%GenSpd_Dem) + if (RegCheckErr(Buf, RoutineName)) return + ! GenTrq_Dem + call RegUnpack(Buf, OutData%GenTrq_Dem) + if (RegCheckErr(Buf, RoutineName)) return + ! GenPwr_Dem + call RegUnpack(Buf, OutData%GenPwr_Dem) + if (RegCheckErr(Buf, RoutineName)) return + ! DLL_NumTrq + call RegUnpack(Buf, OutData%DLL_NumTrq) + if (RegCheckErr(Buf, RoutineName)) return + ! GenSpd_TLU + if (allocated(OutData%GenSpd_TLU)) deallocate(OutData%GenSpd_TLU) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%GenSpd_TLU(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GenSpd_TLU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%GenSpd_TLU) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! GenTrq_TLU + if (allocated(OutData%GenTrq_TLU)) deallocate(OutData%GenTrq_TLU) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%GenTrq_TLU(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GenTrq_TLU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%GenTrq_TLU) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! UseLegacyInterface + call RegUnpack(Buf, OutData%UseLegacyInterface) + if (RegCheckErr(Buf, RoutineName)) return + ! NumBStC + call RegUnpack(Buf, OutData%NumBStC) + if (RegCheckErr(Buf, RoutineName)) return + ! BStCfiles + if (allocated(OutData%BStCfiles)) deallocate(OutData%BStCfiles) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BStCfiles(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStCfiles.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BStCfiles) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NumNStC + call RegUnpack(Buf, OutData%NumNStC) + if (RegCheckErr(Buf, RoutineName)) return + ! NStCfiles + if (allocated(OutData%NStCfiles)) deallocate(OutData%NStCfiles) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NStCfiles(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStCfiles.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%NStCfiles) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NumTStC + call RegUnpack(Buf, OutData%NumTStC) + if (RegCheckErr(Buf, RoutineName)) return + ! TStCfiles + if (allocated(OutData%TStCfiles)) deallocate(OutData%TStCfiles) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TStCfiles(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStCfiles.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TStCfiles) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NumSStC + call RegUnpack(Buf, OutData%NumSStC) + if (RegCheckErr(Buf, RoutineName)) return + ! SStCfiles + if (allocated(OutData%SStCfiles)) deallocate(OutData%SStCfiles) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SStCfiles(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStCfiles.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SStCfiles) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AfCmode + call RegUnpack(Buf, OutData%AfCmode) + if (RegCheckErr(Buf, RoutineName)) return + ! AfC_Mean + call RegUnpack(Buf, OutData%AfC_Mean) + if (RegCheckErr(Buf, RoutineName)) return + ! AfC_Amp + call RegUnpack(Buf, OutData%AfC_Amp) + if (RegCheckErr(Buf, RoutineName)) return + ! AfC_Phase + call RegUnpack(Buf, OutData%AfC_Phase) + if (RegCheckErr(Buf, RoutineName)) return + ! CCmode + call RegUnpack(Buf, OutData%CCmode) + if (RegCheckErr(Buf, RoutineName)) return + ! EXavrSWAP + call RegUnpack(Buf, OutData%EXavrSWAP) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE SrvD_CopyBladedDLLType( SrcBladedDLLTypeData, DstBladedDLLTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(BladedDLLType), INTENT(IN) :: SrcBladedDLLTypeData TYPE(BladedDLLType), INTENT(INOUT) :: DstBladedDLLTypeData @@ -4149,1631 +3149,1001 @@ SUBROUTINE SrvD_DestroyBladedDLLType( BladedDLLTypeData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE SrvD_DestroyBladedDLLType - SUBROUTINE SrvD_PackBladedDLLType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(BladedDLLType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_PackBladedDLLType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! avrSWAP allocated yes/no - IF ( ALLOCATED(InData%avrSWAP) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! avrSWAP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%avrSWAP) ! avrSWAP - END IF - Re_BufSz = Re_BufSz + 1 ! HSSBrTrqDemand - Re_BufSz = Re_BufSz + 1 ! YawRateCom - Re_BufSz = Re_BufSz + 1 ! GenTrq - Int_BufSz = Int_BufSz + 1 ! GenState - Re_BufSz = Re_BufSz + SIZE(InData%BlPitchCom) ! BlPitchCom - Re_BufSz = Re_BufSz + SIZE(InData%PrevBlPitch) ! PrevBlPitch - Re_BufSz = Re_BufSz + SIZE(InData%BlAirfoilCom) ! BlAirfoilCom - Re_BufSz = Re_BufSz + SIZE(InData%PrevBlAirfoilCom) ! PrevBlAirfoilCom - Re_BufSz = Re_BufSz + 1 ! ElecPwr_prev - Re_BufSz = Re_BufSz + 1 ! GenTrq_prev - Int_BufSz = Int_BufSz + 1 ! toSC allocated yes/no - IF ( ALLOCATED(InData%toSC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! toSC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%toSC) ! toSC - END IF - Int_BufSz = Int_BufSz + 1 ! initialized - Int_BufSz = Int_BufSz + 1 ! NumLogChannels - Int_BufSz = Int_BufSz + 1 ! LogChannels_OutParam allocated yes/no - IF ( ALLOCATED(InData%LogChannels_OutParam) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LogChannels_OutParam upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%LogChannels_OutParam,1), UBOUND(InData%LogChannels_OutParam,1) - Int_BufSz = Int_BufSz + 3 ! LogChannels_OutParam: size of buffers for each call to pack subtype - CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%LogChannels_OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! LogChannels_OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! LogChannels_OutParam - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! LogChannels_OutParam - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! LogChannels_OutParam - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! LogChannels allocated yes/no - IF ( ALLOCATED(InData%LogChannels) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LogChannels upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LogChannels) ! LogChannels - END IF - Int_BufSz = Int_BufSz + 1 ! ErrStat - Int_BufSz = Int_BufSz + 1*LEN(InData%ErrMsg) ! ErrMsg - Db_BufSz = Db_BufSz + 1 ! CurrentTime - Int_BufSz = Int_BufSz + 1 ! SimStatus - Int_BufSz = Int_BufSz + 1 ! ShaftBrakeStatusBinaryFlag - Int_BufSz = Int_BufSz + 1 ! HSSBrDeployed - Db_BufSz = Db_BufSz + 1 ! TimeHSSBrFullyDeployed - Db_BufSz = Db_BufSz + 1 ! TimeHSSBrDeployed - Int_BufSz = Int_BufSz + 1 ! OverrideYawRateWithTorque - Re_BufSz = Re_BufSz + 1 ! YawTorqueDemand - Int_BufSz = Int_BufSz + 1 ! BlPitchInput allocated yes/no - IF ( ALLOCATED(InData%BlPitchInput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlPitchInput upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlPitchInput) ! BlPitchInput - END IF - Re_BufSz = Re_BufSz + 1 ! YawAngleFromNorth - Re_BufSz = Re_BufSz + 1 ! HorWindV - Re_BufSz = Re_BufSz + 1 ! HSS_Spd - Re_BufSz = Re_BufSz + 1 ! YawErr - Re_BufSz = Re_BufSz + 1 ! RotSpeed - Re_BufSz = Re_BufSz + 1 ! YawBrTAxp - Re_BufSz = Re_BufSz + 1 ! YawBrTAyp - Re_BufSz = Re_BufSz + 1 ! LSSTipMys - Re_BufSz = Re_BufSz + 1 ! LSSTipMzs - Re_BufSz = Re_BufSz + 1 ! LSSTipMya - Re_BufSz = Re_BufSz + 1 ! LSSTipMza - Re_BufSz = Re_BufSz + 1 ! LSSTipPxa - Re_BufSz = Re_BufSz + 1 ! Yaw - Re_BufSz = Re_BufSz + 1 ! YawRate - Re_BufSz = Re_BufSz + 1 ! YawBrMyn - Re_BufSz = Re_BufSz + 1 ! YawBrMzn - Re_BufSz = Re_BufSz + 1 ! NcIMURAxs - Re_BufSz = Re_BufSz + 1 ! NcIMURAys - Re_BufSz = Re_BufSz + 1 ! NcIMURAzs - Re_BufSz = Re_BufSz + 1 ! RotPwr - Re_BufSz = Re_BufSz + 1 ! LSSTipMxa - Re_BufSz = Re_BufSz + SIZE(InData%RootMyc) ! RootMyc - Re_BufSz = Re_BufSz + SIZE(InData%RootMxc) ! RootMxc - Re_BufSz = Re_BufSz + 1 ! LSShftFxa - Re_BufSz = Re_BufSz + 1 ! LSShftFys - Re_BufSz = Re_BufSz + 1 ! LSShftFzs - Int_BufSz = Int_BufSz + 1 ! LidSpeed allocated yes/no - IF ( ALLOCATED(InData%LidSpeed) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LidSpeed upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LidSpeed) ! LidSpeed - END IF - Int_BufSz = Int_BufSz + 1 ! MsrPositionsX allocated yes/no - IF ( ALLOCATED(InData%MsrPositionsX) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MsrPositionsX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MsrPositionsX) ! MsrPositionsX - END IF - Int_BufSz = Int_BufSz + 1 ! MsrPositionsY allocated yes/no - IF ( ALLOCATED(InData%MsrPositionsY) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MsrPositionsY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MsrPositionsY) ! MsrPositionsY - END IF - Int_BufSz = Int_BufSz + 1 ! MsrPositionsZ allocated yes/no - IF ( ALLOCATED(InData%MsrPositionsZ) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MsrPositionsZ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MsrPositionsZ) ! MsrPositionsZ - END IF - Int_BufSz = Int_BufSz + 1 ! SensorType - Int_BufSz = Int_BufSz + 1 ! NumBeam - Int_BufSz = Int_BufSz + 1 ! NumPulseGate - Int_BufSz = Int_BufSz + 1 ! PulseSpacing - Int_BufSz = Int_BufSz + 1 ! URefLid - Db_BufSz = Db_BufSz + 1 ! DLL_DT - Int_BufSz = Int_BufSz + 1*LEN(InData%DLL_InFile) ! DLL_InFile - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Re_BufSz = Re_BufSz + 1 ! GenTrq_Dem - Re_BufSz = Re_BufSz + 1 ! GenSpd_Dem - Re_BufSz = Re_BufSz + 1 ! Ptch_Max - Re_BufSz = Re_BufSz + 1 ! Ptch_Min - Re_BufSz = Re_BufSz + 1 ! Ptch_SetPnt - Re_BufSz = Re_BufSz + 1 ! PtchRate_Max - Re_BufSz = Re_BufSz + 1 ! PtchRate_Min - Re_BufSz = Re_BufSz + 1 ! GenPwr_Dem - Re_BufSz = Re_BufSz + 1 ! Gain_OM - Re_BufSz = Re_BufSz + 1 ! GenSpd_MaxOM - Re_BufSz = Re_BufSz + 1 ! GenSpd_MinOM - Int_BufSz = Int_BufSz + 1 ! Ptch_Cntrl - Int_BufSz = Int_BufSz + 1 ! DLL_NumTrq - Int_BufSz = Int_BufSz + 1 ! GenSpd_TLU allocated yes/no - IF ( ALLOCATED(InData%GenSpd_TLU) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! GenSpd_TLU upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GenSpd_TLU) ! GenSpd_TLU - END IF - Int_BufSz = Int_BufSz + 1 ! GenTrq_TLU allocated yes/no - IF ( ALLOCATED(InData%GenTrq_TLU) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! GenTrq_TLU upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GenTrq_TLU) ! GenTrq_TLU - END IF - Int_BufSz = Int_BufSz + 1 ! Yaw_Cntrl - Int_BufSz = Int_BufSz + 1 ! PrevCableDeltaL allocated yes/no - IF ( ALLOCATED(InData%PrevCableDeltaL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PrevCableDeltaL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PrevCableDeltaL) ! PrevCableDeltaL - END IF - Int_BufSz = Int_BufSz + 1 ! PrevCableDeltaLdot allocated yes/no - IF ( ALLOCATED(InData%PrevCableDeltaLdot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PrevCableDeltaLdot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PrevCableDeltaLdot) ! PrevCableDeltaLdot - END IF - Int_BufSz = Int_BufSz + 1 ! CableDeltaL allocated yes/no - IF ( ALLOCATED(InData%CableDeltaL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CableDeltaL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CableDeltaL) ! CableDeltaL - END IF - Int_BufSz = Int_BufSz + 1 ! CableDeltaLdot allocated yes/no - IF ( ALLOCATED(InData%CableDeltaLdot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CableDeltaLdot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CableDeltaLdot) ! CableDeltaLdot - END IF - Int_BufSz = Int_BufSz + 1 ! PrevStCCmdStiff allocated yes/no - IF ( ALLOCATED(InData%PrevStCCmdStiff) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PrevStCCmdStiff upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PrevStCCmdStiff) ! PrevStCCmdStiff - END IF - Int_BufSz = Int_BufSz + 1 ! PrevStCCmdDamp allocated yes/no - IF ( ALLOCATED(InData%PrevStCCmdDamp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PrevStCCmdDamp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PrevStCCmdDamp) ! PrevStCCmdDamp - END IF - Int_BufSz = Int_BufSz + 1 ! PrevStCCmdBrake allocated yes/no - IF ( ALLOCATED(InData%PrevStCCmdBrake) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PrevStCCmdBrake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PrevStCCmdBrake) ! PrevStCCmdBrake - END IF - Int_BufSz = Int_BufSz + 1 ! PrevStCCmdForce allocated yes/no - IF ( ALLOCATED(InData%PrevStCCmdForce) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PrevStCCmdForce upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PrevStCCmdForce) ! PrevStCCmdForce - END IF - Int_BufSz = Int_BufSz + 1 ! StCCmdStiff allocated yes/no - IF ( ALLOCATED(InData%StCCmdStiff) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StCCmdStiff upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StCCmdStiff) ! StCCmdStiff - END IF - Int_BufSz = Int_BufSz + 1 ! StCCmdDamp allocated yes/no - IF ( ALLOCATED(InData%StCCmdDamp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StCCmdDamp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StCCmdDamp) ! StCCmdDamp - END IF - Int_BufSz = Int_BufSz + 1 ! StCCmdBrake allocated yes/no - IF ( ALLOCATED(InData%StCCmdBrake) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StCCmdBrake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StCCmdBrake) ! StCCmdBrake - END IF - Int_BufSz = Int_BufSz + 1 ! StCCmdForce allocated yes/no - IF ( ALLOCATED(InData%StCCmdForce) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StCCmdForce upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StCCmdForce) ! StCCmdForce - END IF - Int_BufSz = Int_BufSz + 1 ! StCMeasDisp allocated yes/no - IF ( ALLOCATED(InData%StCMeasDisp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StCMeasDisp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StCMeasDisp) ! StCMeasDisp - END IF - Int_BufSz = Int_BufSz + 1 ! StCMeasVel allocated yes/no - IF ( ALLOCATED(InData%StCMeasVel) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StCMeasVel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StCMeasVel) ! StCMeasVel - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%avrSWAP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%avrSWAP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%avrSWAP,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%avrSWAP,1), UBOUND(InData%avrSWAP,1) - ReKiBuf(Re_Xferred) = InData%avrSWAP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%HSSBrTrqDemand - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawRateCom - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenTrq - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%GenState - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%BlPitchCom,1), UBOUND(InData%BlPitchCom,1) - ReKiBuf(Re_Xferred) = InData%BlPitchCom(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%PrevBlPitch,1), UBOUND(InData%PrevBlPitch,1) - ReKiBuf(Re_Xferred) = InData%PrevBlPitch(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%BlAirfoilCom,1), UBOUND(InData%BlAirfoilCom,1) - ReKiBuf(Re_Xferred) = InData%BlAirfoilCom(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%PrevBlAirfoilCom,1), UBOUND(InData%PrevBlAirfoilCom,1) - ReKiBuf(Re_Xferred) = InData%PrevBlAirfoilCom(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%ElecPwr_prev - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenTrq_prev - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%toSC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%toSC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%toSC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%toSC,1), UBOUND(InData%toSC,1) - ReKiBuf(Re_Xferred) = InData%toSC(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%initialized, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumLogChannels - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%LogChannels_OutParam) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LogChannels_OutParam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LogChannels_OutParam,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LogChannels_OutParam,1), UBOUND(InData%LogChannels_OutParam,1) - CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%LogChannels_OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! LogChannels_OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LogChannels) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LogChannels,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LogChannels,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LogChannels,1), UBOUND(InData%LogChannels,1) - ReKiBuf(Re_Xferred) = InData%LogChannels(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%ErrStat - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%ErrMsg) - IntKiBuf(Int_Xferred) = ICHAR(InData%ErrMsg(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf(Db_Xferred) = InData%CurrentTime - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%SimStatus - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ShaftBrakeStatusBinaryFlag - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%HSSBrDeployed, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TimeHSSBrFullyDeployed - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TimeHSSBrDeployed - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%OverrideYawRateWithTorque, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawTorqueDemand - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BlPitchInput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlPitchInput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitchInput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlPitchInput,1), UBOUND(InData%BlPitchInput,1) - ReKiBuf(Re_Xferred) = InData%BlPitchInput(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%YawAngleFromNorth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HorWindV - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HSS_Spd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawErr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RotSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawBrTAxp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawBrTAyp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSSTipMys - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSSTipMzs - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSSTipMya - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSSTipMza - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSSTipPxa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Yaw - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawRate - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawBrMyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawBrMzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NcIMURAxs - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NcIMURAys - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NcIMURAzs - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RotPwr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSSTipMxa - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%RootMyc,1), UBOUND(InData%RootMyc,1) - ReKiBuf(Re_Xferred) = InData%RootMyc(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%RootMxc,1), UBOUND(InData%RootMxc,1) - ReKiBuf(Re_Xferred) = InData%RootMxc(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%LSShftFxa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSShftFys - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSShftFzs - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%LidSpeed) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LidSpeed,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LidSpeed,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LidSpeed,1), UBOUND(InData%LidSpeed,1) - ReKiBuf(Re_Xferred) = InData%LidSpeed(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MsrPositionsX) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MsrPositionsX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MsrPositionsX,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MsrPositionsX,1), UBOUND(InData%MsrPositionsX,1) - ReKiBuf(Re_Xferred) = InData%MsrPositionsX(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MsrPositionsY) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MsrPositionsY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MsrPositionsY,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MsrPositionsY,1), UBOUND(InData%MsrPositionsY,1) - ReKiBuf(Re_Xferred) = InData%MsrPositionsY(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MsrPositionsZ) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MsrPositionsZ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MsrPositionsZ,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MsrPositionsZ,1), UBOUND(InData%MsrPositionsZ,1) - ReKiBuf(Re_Xferred) = InData%MsrPositionsZ(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%SensorType - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBeam - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumPulseGate - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%PulseSpacing - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%URefLid - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%DLL_DT - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(InData%DLL_InFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_InFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf(Re_Xferred) = InData%GenTrq_Dem - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenSpd_Dem - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Ptch_Max - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Ptch_Min - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Ptch_SetPnt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtchRate_Max - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtchRate_Min - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenPwr_Dem - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Gain_OM - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenSpd_MaxOM - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenSpd_MinOM - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Ptch_Cntrl - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%DLL_NumTrq - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%GenSpd_TLU) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GenSpd_TLU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GenSpd_TLU,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%GenSpd_TLU,1), UBOUND(InData%GenSpd_TLU,1) - ReKiBuf(Re_Xferred) = InData%GenSpd_TLU(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%GenTrq_TLU) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GenTrq_TLU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GenTrq_TLU,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%GenTrq_TLU,1), UBOUND(InData%GenTrq_TLU,1) - ReKiBuf(Re_Xferred) = InData%GenTrq_TLU(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%Yaw_Cntrl - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%PrevCableDeltaL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PrevCableDeltaL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PrevCableDeltaL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PrevCableDeltaL,1), UBOUND(InData%PrevCableDeltaL,1) - ReKiBuf(Re_Xferred) = InData%PrevCableDeltaL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PrevCableDeltaLdot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PrevCableDeltaLdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PrevCableDeltaLdot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PrevCableDeltaLdot,1), UBOUND(InData%PrevCableDeltaLdot,1) - ReKiBuf(Re_Xferred) = InData%PrevCableDeltaLdot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CableDeltaL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CableDeltaL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CableDeltaL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CableDeltaL,1), UBOUND(InData%CableDeltaL,1) - ReKiBuf(Re_Xferred) = InData%CableDeltaL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CableDeltaLdot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CableDeltaLdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CableDeltaLdot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CableDeltaLdot,1), UBOUND(InData%CableDeltaLdot,1) - ReKiBuf(Re_Xferred) = InData%CableDeltaLdot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PrevStCCmdStiff) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PrevStCCmdStiff,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PrevStCCmdStiff,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PrevStCCmdStiff,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PrevStCCmdStiff,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PrevStCCmdStiff,2), UBOUND(InData%PrevStCCmdStiff,2) - DO i1 = LBOUND(InData%PrevStCCmdStiff,1), UBOUND(InData%PrevStCCmdStiff,1) - ReKiBuf(Re_Xferred) = InData%PrevStCCmdStiff(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PrevStCCmdDamp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PrevStCCmdDamp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PrevStCCmdDamp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PrevStCCmdDamp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PrevStCCmdDamp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PrevStCCmdDamp,2), UBOUND(InData%PrevStCCmdDamp,2) - DO i1 = LBOUND(InData%PrevStCCmdDamp,1), UBOUND(InData%PrevStCCmdDamp,1) - ReKiBuf(Re_Xferred) = InData%PrevStCCmdDamp(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PrevStCCmdBrake) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PrevStCCmdBrake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PrevStCCmdBrake,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PrevStCCmdBrake,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PrevStCCmdBrake,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PrevStCCmdBrake,2), UBOUND(InData%PrevStCCmdBrake,2) - DO i1 = LBOUND(InData%PrevStCCmdBrake,1), UBOUND(InData%PrevStCCmdBrake,1) - ReKiBuf(Re_Xferred) = InData%PrevStCCmdBrake(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PrevStCCmdForce) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PrevStCCmdForce,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PrevStCCmdForce,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PrevStCCmdForce,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PrevStCCmdForce,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PrevStCCmdForce,2), UBOUND(InData%PrevStCCmdForce,2) - DO i1 = LBOUND(InData%PrevStCCmdForce,1), UBOUND(InData%PrevStCCmdForce,1) - ReKiBuf(Re_Xferred) = InData%PrevStCCmdForce(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StCCmdStiff) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StCCmdStiff,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StCCmdStiff,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StCCmdStiff,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StCCmdStiff,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%StCCmdStiff,2), UBOUND(InData%StCCmdStiff,2) - DO i1 = LBOUND(InData%StCCmdStiff,1), UBOUND(InData%StCCmdStiff,1) - ReKiBuf(Re_Xferred) = InData%StCCmdStiff(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StCCmdDamp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StCCmdDamp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StCCmdDamp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StCCmdDamp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StCCmdDamp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%StCCmdDamp,2), UBOUND(InData%StCCmdDamp,2) - DO i1 = LBOUND(InData%StCCmdDamp,1), UBOUND(InData%StCCmdDamp,1) - ReKiBuf(Re_Xferred) = InData%StCCmdDamp(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StCCmdBrake) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StCCmdBrake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StCCmdBrake,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StCCmdBrake,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StCCmdBrake,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%StCCmdBrake,2), UBOUND(InData%StCCmdBrake,2) - DO i1 = LBOUND(InData%StCCmdBrake,1), UBOUND(InData%StCCmdBrake,1) - ReKiBuf(Re_Xferred) = InData%StCCmdBrake(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StCCmdForce) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StCCmdForce,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StCCmdForce,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StCCmdForce,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StCCmdForce,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%StCCmdForce,2), UBOUND(InData%StCCmdForce,2) - DO i1 = LBOUND(InData%StCCmdForce,1), UBOUND(InData%StCCmdForce,1) - ReKiBuf(Re_Xferred) = InData%StCCmdForce(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StCMeasDisp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StCMeasDisp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StCMeasDisp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StCMeasDisp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StCMeasDisp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%StCMeasDisp,2), UBOUND(InData%StCMeasDisp,2) - DO i1 = LBOUND(InData%StCMeasDisp,1), UBOUND(InData%StCMeasDisp,1) - ReKiBuf(Re_Xferred) = InData%StCMeasDisp(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StCMeasVel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StCMeasVel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StCMeasVel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StCMeasVel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StCMeasVel,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%StCMeasVel,2), UBOUND(InData%StCMeasVel,2) - DO i1 = LBOUND(InData%StCMeasVel,1), UBOUND(InData%StCMeasVel,1) - ReKiBuf(Re_Xferred) = InData%StCMeasVel(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE SrvD_PackBladedDLLType - - SUBROUTINE SrvD_UnPackBladedDLLType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(BladedDLLType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_UnPackBladedDLLType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! avrSWAP not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%avrSWAP)) DEALLOCATE(OutData%avrSWAP) - ALLOCATE(OutData%avrSWAP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%avrSWAP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%avrSWAP,1), UBOUND(OutData%avrSWAP,1) - OutData%avrSWAP(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%HSSBrTrqDemand = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawRateCom = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenTrq = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenState = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%BlPitchCom,1) - i1_u = UBOUND(OutData%BlPitchCom,1) - DO i1 = LBOUND(OutData%BlPitchCom,1), UBOUND(OutData%BlPitchCom,1) - OutData%BlPitchCom(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%PrevBlPitch,1) - i1_u = UBOUND(OutData%PrevBlPitch,1) - DO i1 = LBOUND(OutData%PrevBlPitch,1), UBOUND(OutData%PrevBlPitch,1) - OutData%PrevBlPitch(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%BlAirfoilCom,1) - i1_u = UBOUND(OutData%BlAirfoilCom,1) - DO i1 = LBOUND(OutData%BlAirfoilCom,1), UBOUND(OutData%BlAirfoilCom,1) - OutData%BlAirfoilCom(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%PrevBlAirfoilCom,1) - i1_u = UBOUND(OutData%PrevBlAirfoilCom,1) - DO i1 = LBOUND(OutData%PrevBlAirfoilCom,1), UBOUND(OutData%PrevBlAirfoilCom,1) - OutData%PrevBlAirfoilCom(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%ElecPwr_prev = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenTrq_prev = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! toSC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%toSC)) DEALLOCATE(OutData%toSC) - ALLOCATE(OutData%toSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%toSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%toSC,1), UBOUND(OutData%toSC,1) - OutData%toSC(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%initialized = TRANSFER(IntKiBuf(Int_Xferred), OutData%initialized) - Int_Xferred = Int_Xferred + 1 - OutData%NumLogChannels = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LogChannels_OutParam not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LogChannels_OutParam)) DEALLOCATE(OutData%LogChannels_OutParam) - ALLOCATE(OutData%LogChannels_OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LogChannels_OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LogChannels_OutParam,1), UBOUND(OutData%LogChannels_OutParam,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackOutParmType( Re_Buf, Db_Buf, Int_Buf, OutData%LogChannels_OutParam(i1), ErrStat2, ErrMsg2 ) ! LogChannels_OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LogChannels not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LogChannels)) DEALLOCATE(OutData%LogChannels) - ALLOCATE(OutData%LogChannels(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LogChannels.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LogChannels,1), UBOUND(OutData%LogChannels,1) - OutData%LogChannels(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%ErrStat = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%ErrMsg) - OutData%ErrMsg(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%CurrentTime = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%SimStatus = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ShaftBrakeStatusBinaryFlag = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%HSSBrDeployed = TRANSFER(IntKiBuf(Int_Xferred), OutData%HSSBrDeployed) - Int_Xferred = Int_Xferred + 1 - OutData%TimeHSSBrFullyDeployed = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%TimeHSSBrDeployed = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%OverrideYawRateWithTorque = TRANSFER(IntKiBuf(Int_Xferred), OutData%OverrideYawRateWithTorque) - Int_Xferred = Int_Xferred + 1 - OutData%YawTorqueDemand = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitchInput not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlPitchInput)) DEALLOCATE(OutData%BlPitchInput) - ALLOCATE(OutData%BlPitchInput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchInput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlPitchInput,1), UBOUND(OutData%BlPitchInput,1) - OutData%BlPitchInput(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%YawAngleFromNorth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HorWindV = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HSS_Spd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawErr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RotSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrTAxp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrTAyp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMys = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMzs = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMya = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMza = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipPxa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Yaw = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawRate = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrMyn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrMzn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMURAxs = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMURAys = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMURAzs = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RotPwr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMxa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%RootMyc,1) - i1_u = UBOUND(OutData%RootMyc,1) - DO i1 = LBOUND(OutData%RootMyc,1), UBOUND(OutData%RootMyc,1) - OutData%RootMyc(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%RootMxc,1) - i1_u = UBOUND(OutData%RootMxc,1) - DO i1 = LBOUND(OutData%RootMxc,1), UBOUND(OutData%RootMxc,1) - OutData%RootMxc(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%LSShftFxa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSShftFys = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSShftFzs = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LidSpeed not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LidSpeed)) DEALLOCATE(OutData%LidSpeed) - ALLOCATE(OutData%LidSpeed(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LidSpeed.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LidSpeed,1), UBOUND(OutData%LidSpeed,1) - OutData%LidSpeed(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MsrPositionsX not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MsrPositionsX)) DEALLOCATE(OutData%MsrPositionsX) - ALLOCATE(OutData%MsrPositionsX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MsrPositionsX,1), UBOUND(OutData%MsrPositionsX,1) - OutData%MsrPositionsX(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MsrPositionsY not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MsrPositionsY)) DEALLOCATE(OutData%MsrPositionsY) - ALLOCATE(OutData%MsrPositionsY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MsrPositionsY,1), UBOUND(OutData%MsrPositionsY,1) - OutData%MsrPositionsY(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MsrPositionsZ not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MsrPositionsZ)) DEALLOCATE(OutData%MsrPositionsZ) - ALLOCATE(OutData%MsrPositionsZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MsrPositionsZ,1), UBOUND(OutData%MsrPositionsZ,1) - OutData%MsrPositionsZ(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%SensorType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumBeam = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumPulseGate = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%PulseSpacing = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%URefLid = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%DLL_DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(OutData%DLL_InFile) - OutData%DLL_InFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%GenTrq_Dem = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenSpd_Dem = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Ptch_Max = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Ptch_Min = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Ptch_SetPnt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtchRate_Max = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtchRate_Min = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenPwr_Dem = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Gain_OM = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenSpd_MaxOM = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenSpd_MinOM = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Ptch_Cntrl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%DLL_NumTrq = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GenSpd_TLU not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%GenSpd_TLU)) DEALLOCATE(OutData%GenSpd_TLU) - ALLOCATE(OutData%GenSpd_TLU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GenSpd_TLU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%GenSpd_TLU,1), UBOUND(OutData%GenSpd_TLU,1) - OutData%GenSpd_TLU(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GenTrq_TLU not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%GenTrq_TLU)) DEALLOCATE(OutData%GenTrq_TLU) - ALLOCATE(OutData%GenTrq_TLU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GenTrq_TLU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%GenTrq_TLU,1), UBOUND(OutData%GenTrq_TLU,1) - OutData%GenTrq_TLU(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Yaw_Cntrl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PrevCableDeltaL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PrevCableDeltaL)) DEALLOCATE(OutData%PrevCableDeltaL) - ALLOCATE(OutData%PrevCableDeltaL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PrevCableDeltaL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PrevCableDeltaL,1), UBOUND(OutData%PrevCableDeltaL,1) - OutData%PrevCableDeltaL(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PrevCableDeltaLdot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PrevCableDeltaLdot)) DEALLOCATE(OutData%PrevCableDeltaLdot) - ALLOCATE(OutData%PrevCableDeltaLdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PrevCableDeltaLdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PrevCableDeltaLdot,1), UBOUND(OutData%PrevCableDeltaLdot,1) - OutData%PrevCableDeltaLdot(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CableDeltaL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CableDeltaL)) DEALLOCATE(OutData%CableDeltaL) - ALLOCATE(OutData%CableDeltaL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableDeltaL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CableDeltaL,1), UBOUND(OutData%CableDeltaL,1) - OutData%CableDeltaL(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CableDeltaLdot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CableDeltaLdot)) DEALLOCATE(OutData%CableDeltaLdot) - ALLOCATE(OutData%CableDeltaLdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableDeltaLdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CableDeltaLdot,1), UBOUND(OutData%CableDeltaLdot,1) - OutData%CableDeltaLdot(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PrevStCCmdStiff not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PrevStCCmdStiff)) DEALLOCATE(OutData%PrevStCCmdStiff) - ALLOCATE(OutData%PrevStCCmdStiff(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PrevStCCmdStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PrevStCCmdStiff,2), UBOUND(OutData%PrevStCCmdStiff,2) - DO i1 = LBOUND(OutData%PrevStCCmdStiff,1), UBOUND(OutData%PrevStCCmdStiff,1) - OutData%PrevStCCmdStiff(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PrevStCCmdDamp not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PrevStCCmdDamp)) DEALLOCATE(OutData%PrevStCCmdDamp) - ALLOCATE(OutData%PrevStCCmdDamp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PrevStCCmdDamp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PrevStCCmdDamp,2), UBOUND(OutData%PrevStCCmdDamp,2) - DO i1 = LBOUND(OutData%PrevStCCmdDamp,1), UBOUND(OutData%PrevStCCmdDamp,1) - OutData%PrevStCCmdDamp(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PrevStCCmdBrake not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PrevStCCmdBrake)) DEALLOCATE(OutData%PrevStCCmdBrake) - ALLOCATE(OutData%PrevStCCmdBrake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PrevStCCmdBrake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PrevStCCmdBrake,2), UBOUND(OutData%PrevStCCmdBrake,2) - DO i1 = LBOUND(OutData%PrevStCCmdBrake,1), UBOUND(OutData%PrevStCCmdBrake,1) - OutData%PrevStCCmdBrake(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PrevStCCmdForce not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PrevStCCmdForce)) DEALLOCATE(OutData%PrevStCCmdForce) - ALLOCATE(OutData%PrevStCCmdForce(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PrevStCCmdForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PrevStCCmdForce,2), UBOUND(OutData%PrevStCCmdForce,2) - DO i1 = LBOUND(OutData%PrevStCCmdForce,1), UBOUND(OutData%PrevStCCmdForce,1) - OutData%PrevStCCmdForce(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StCCmdStiff not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%StCCmdStiff)) DEALLOCATE(OutData%StCCmdStiff) - ALLOCATE(OutData%StCCmdStiff(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StCCmdStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%StCCmdStiff,2), UBOUND(OutData%StCCmdStiff,2) - DO i1 = LBOUND(OutData%StCCmdStiff,1), UBOUND(OutData%StCCmdStiff,1) - OutData%StCCmdStiff(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StCCmdDamp not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%StCCmdDamp)) DEALLOCATE(OutData%StCCmdDamp) - ALLOCATE(OutData%StCCmdDamp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StCCmdDamp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%StCCmdDamp,2), UBOUND(OutData%StCCmdDamp,2) - DO i1 = LBOUND(OutData%StCCmdDamp,1), UBOUND(OutData%StCCmdDamp,1) - OutData%StCCmdDamp(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StCCmdBrake not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%StCCmdBrake)) DEALLOCATE(OutData%StCCmdBrake) - ALLOCATE(OutData%StCCmdBrake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StCCmdBrake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%StCCmdBrake,2), UBOUND(OutData%StCCmdBrake,2) - DO i1 = LBOUND(OutData%StCCmdBrake,1), UBOUND(OutData%StCCmdBrake,1) - OutData%StCCmdBrake(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StCCmdForce not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%StCCmdForce)) DEALLOCATE(OutData%StCCmdForce) - ALLOCATE(OutData%StCCmdForce(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StCCmdForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%StCCmdForce,2), UBOUND(OutData%StCCmdForce,2) - DO i1 = LBOUND(OutData%StCCmdForce,1), UBOUND(OutData%StCCmdForce,1) - OutData%StCCmdForce(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StCMeasDisp not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%StCMeasDisp)) DEALLOCATE(OutData%StCMeasDisp) - ALLOCATE(OutData%StCMeasDisp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StCMeasDisp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%StCMeasDisp,2), UBOUND(OutData%StCMeasDisp,2) - DO i1 = LBOUND(OutData%StCMeasDisp,1), UBOUND(OutData%StCMeasDisp,1) - OutData%StCMeasDisp(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StCMeasVel not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%StCMeasVel)) DEALLOCATE(OutData%StCMeasVel) - ALLOCATE(OutData%StCMeasVel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StCMeasVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%StCMeasVel,2), UBOUND(OutData%StCMeasVel,2) - DO i1 = LBOUND(OutData%StCMeasVel,1), UBOUND(OutData%StCMeasVel,1) - OutData%StCMeasVel(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE SrvD_UnPackBladedDLLType +subroutine SrvD_PackBladedDLLType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(BladedDLLType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackBladedDLLType' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + ! avrSWAP + call RegPack(Buf, allocated(InData%avrSWAP)) + if (allocated(InData%avrSWAP)) then + call RegPackBounds(Buf, 1, lbound(InData%avrSWAP), ubound(InData%avrSWAP)) + call RegPack(Buf, InData%avrSWAP) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! HSSBrTrqDemand + call RegPack(Buf, InData%HSSBrTrqDemand) + if (RegCheckErr(Buf, RoutineName)) return + ! YawRateCom + call RegPack(Buf, InData%YawRateCom) + if (RegCheckErr(Buf, RoutineName)) return + ! GenTrq + call RegPack(Buf, InData%GenTrq) + if (RegCheckErr(Buf, RoutineName)) return + ! GenState + call RegPack(Buf, InData%GenState) + if (RegCheckErr(Buf, RoutineName)) return + ! BlPitchCom + call RegPack(Buf, InData%BlPitchCom) + if (RegCheckErr(Buf, RoutineName)) return + ! PrevBlPitch + call RegPack(Buf, InData%PrevBlPitch) + if (RegCheckErr(Buf, RoutineName)) return + ! BlAirfoilCom + call RegPack(Buf, InData%BlAirfoilCom) + if (RegCheckErr(Buf, RoutineName)) return + ! PrevBlAirfoilCom + call RegPack(Buf, InData%PrevBlAirfoilCom) + if (RegCheckErr(Buf, RoutineName)) return + ! ElecPwr_prev + call RegPack(Buf, InData%ElecPwr_prev) + if (RegCheckErr(Buf, RoutineName)) return + ! GenTrq_prev + call RegPack(Buf, InData%GenTrq_prev) + if (RegCheckErr(Buf, RoutineName)) return + ! toSC + call RegPack(Buf, allocated(InData%toSC)) + if (allocated(InData%toSC)) then + call RegPackBounds(Buf, 1, lbound(InData%toSC), ubound(InData%toSC)) + call RegPack(Buf, InData%toSC) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! initialized + call RegPack(Buf, InData%initialized) + if (RegCheckErr(Buf, RoutineName)) return + ! NumLogChannels + call RegPack(Buf, InData%NumLogChannels) + if (RegCheckErr(Buf, RoutineName)) return + ! LogChannels_OutParam + call RegPack(Buf, allocated(InData%LogChannels_OutParam)) + if (allocated(InData%LogChannels_OutParam)) then + call RegPackBounds(Buf, 1, lbound(InData%LogChannels_OutParam), ubound(InData%LogChannels_OutParam)) + LB(1:1) = lbound(InData%LogChannels_OutParam) + UB(1:1) = ubound(InData%LogChannels_OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(Buf, InData%LogChannels_OutParam(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LogChannels + call RegPack(Buf, allocated(InData%LogChannels)) + if (allocated(InData%LogChannels)) then + call RegPackBounds(Buf, 1, lbound(InData%LogChannels), ubound(InData%LogChannels)) + call RegPack(Buf, InData%LogChannels) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ErrStat + call RegPack(Buf, InData%ErrStat) + if (RegCheckErr(Buf, RoutineName)) return + ! ErrMsg + call RegPack(Buf, InData%ErrMsg) + if (RegCheckErr(Buf, RoutineName)) return + ! CurrentTime + call RegPack(Buf, InData%CurrentTime) + if (RegCheckErr(Buf, RoutineName)) return + ! SimStatus + call RegPack(Buf, InData%SimStatus) + if (RegCheckErr(Buf, RoutineName)) return + ! ShaftBrakeStatusBinaryFlag + call RegPack(Buf, InData%ShaftBrakeStatusBinaryFlag) + if (RegCheckErr(Buf, RoutineName)) return + ! HSSBrDeployed + call RegPack(Buf, InData%HSSBrDeployed) + if (RegCheckErr(Buf, RoutineName)) return + ! TimeHSSBrFullyDeployed + call RegPack(Buf, InData%TimeHSSBrFullyDeployed) + if (RegCheckErr(Buf, RoutineName)) return + ! TimeHSSBrDeployed + call RegPack(Buf, InData%TimeHSSBrDeployed) + if (RegCheckErr(Buf, RoutineName)) return + ! OverrideYawRateWithTorque + call RegPack(Buf, InData%OverrideYawRateWithTorque) + if (RegCheckErr(Buf, RoutineName)) return + ! YawTorqueDemand + call RegPack(Buf, InData%YawTorqueDemand) + if (RegCheckErr(Buf, RoutineName)) return + ! BlPitchInput + call RegPack(Buf, allocated(InData%BlPitchInput)) + if (allocated(InData%BlPitchInput)) then + call RegPackBounds(Buf, 1, lbound(InData%BlPitchInput), ubound(InData%BlPitchInput)) + call RegPack(Buf, InData%BlPitchInput) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! YawAngleFromNorth + call RegPack(Buf, InData%YawAngleFromNorth) + if (RegCheckErr(Buf, RoutineName)) return + ! HorWindV + call RegPack(Buf, InData%HorWindV) + if (RegCheckErr(Buf, RoutineName)) return + ! HSS_Spd + call RegPack(Buf, InData%HSS_Spd) + if (RegCheckErr(Buf, RoutineName)) return + ! YawErr + call RegPack(Buf, InData%YawErr) + if (RegCheckErr(Buf, RoutineName)) return + ! RotSpeed + call RegPack(Buf, InData%RotSpeed) + if (RegCheckErr(Buf, RoutineName)) return + ! YawBrTAxp + call RegPack(Buf, InData%YawBrTAxp) + if (RegCheckErr(Buf, RoutineName)) return + ! YawBrTAyp + call RegPack(Buf, InData%YawBrTAyp) + if (RegCheckErr(Buf, RoutineName)) return + ! LSSTipMys + call RegPack(Buf, InData%LSSTipMys) + if (RegCheckErr(Buf, RoutineName)) return + ! LSSTipMzs + call RegPack(Buf, InData%LSSTipMzs) + if (RegCheckErr(Buf, RoutineName)) return + ! LSSTipMya + call RegPack(Buf, InData%LSSTipMya) + if (RegCheckErr(Buf, RoutineName)) return + ! LSSTipMza + call RegPack(Buf, InData%LSSTipMza) + if (RegCheckErr(Buf, RoutineName)) return + ! LSSTipPxa + call RegPack(Buf, InData%LSSTipPxa) + if (RegCheckErr(Buf, RoutineName)) return + ! Yaw + call RegPack(Buf, InData%Yaw) + if (RegCheckErr(Buf, RoutineName)) return + ! YawRate + call RegPack(Buf, InData%YawRate) + if (RegCheckErr(Buf, RoutineName)) return + ! YawBrMyn + call RegPack(Buf, InData%YawBrMyn) + if (RegCheckErr(Buf, RoutineName)) return + ! YawBrMzn + call RegPack(Buf, InData%YawBrMzn) + if (RegCheckErr(Buf, RoutineName)) return + ! NcIMURAxs + call RegPack(Buf, InData%NcIMURAxs) + if (RegCheckErr(Buf, RoutineName)) return + ! NcIMURAys + call RegPack(Buf, InData%NcIMURAys) + if (RegCheckErr(Buf, RoutineName)) return + ! NcIMURAzs + call RegPack(Buf, InData%NcIMURAzs) + if (RegCheckErr(Buf, RoutineName)) return + ! RotPwr + call RegPack(Buf, InData%RotPwr) + if (RegCheckErr(Buf, RoutineName)) return + ! LSSTipMxa + call RegPack(Buf, InData%LSSTipMxa) + if (RegCheckErr(Buf, RoutineName)) return + ! RootMyc + call RegPack(Buf, InData%RootMyc) + if (RegCheckErr(Buf, RoutineName)) return + ! RootMxc + call RegPack(Buf, InData%RootMxc) + if (RegCheckErr(Buf, RoutineName)) return + ! LSShftFxa + call RegPack(Buf, InData%LSShftFxa) + if (RegCheckErr(Buf, RoutineName)) return + ! LSShftFys + call RegPack(Buf, InData%LSShftFys) + if (RegCheckErr(Buf, RoutineName)) return + ! LSShftFzs + call RegPack(Buf, InData%LSShftFzs) + if (RegCheckErr(Buf, RoutineName)) return + ! LidSpeed + call RegPack(Buf, allocated(InData%LidSpeed)) + if (allocated(InData%LidSpeed)) then + call RegPackBounds(Buf, 1, lbound(InData%LidSpeed), ubound(InData%LidSpeed)) + call RegPack(Buf, InData%LidSpeed) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MsrPositionsX + call RegPack(Buf, allocated(InData%MsrPositionsX)) + if (allocated(InData%MsrPositionsX)) then + call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsX), ubound(InData%MsrPositionsX)) + call RegPack(Buf, InData%MsrPositionsX) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MsrPositionsY + call RegPack(Buf, allocated(InData%MsrPositionsY)) + if (allocated(InData%MsrPositionsY)) then + call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsY), ubound(InData%MsrPositionsY)) + call RegPack(Buf, InData%MsrPositionsY) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MsrPositionsZ + call RegPack(Buf, allocated(InData%MsrPositionsZ)) + if (allocated(InData%MsrPositionsZ)) then + call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsZ), ubound(InData%MsrPositionsZ)) + call RegPack(Buf, InData%MsrPositionsZ) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SensorType + call RegPack(Buf, InData%SensorType) + if (RegCheckErr(Buf, RoutineName)) return + ! NumBeam + call RegPack(Buf, InData%NumBeam) + if (RegCheckErr(Buf, RoutineName)) return + ! NumPulseGate + call RegPack(Buf, InData%NumPulseGate) + if (RegCheckErr(Buf, RoutineName)) return + ! PulseSpacing + call RegPack(Buf, InData%PulseSpacing) + if (RegCheckErr(Buf, RoutineName)) return + ! URefLid + call RegPack(Buf, InData%URefLid) + if (RegCheckErr(Buf, RoutineName)) return + ! DLL_DT + call RegPack(Buf, InData%DLL_DT) + if (RegCheckErr(Buf, RoutineName)) return + ! DLL_InFile + call RegPack(Buf, InData%DLL_InFile) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegPack(Buf, InData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! GenTrq_Dem + call RegPack(Buf, InData%GenTrq_Dem) + if (RegCheckErr(Buf, RoutineName)) return + ! GenSpd_Dem + call RegPack(Buf, InData%GenSpd_Dem) + if (RegCheckErr(Buf, RoutineName)) return + ! Ptch_Max + call RegPack(Buf, InData%Ptch_Max) + if (RegCheckErr(Buf, RoutineName)) return + ! Ptch_Min + call RegPack(Buf, InData%Ptch_Min) + if (RegCheckErr(Buf, RoutineName)) return + ! Ptch_SetPnt + call RegPack(Buf, InData%Ptch_SetPnt) + if (RegCheckErr(Buf, RoutineName)) return + ! PtchRate_Max + call RegPack(Buf, InData%PtchRate_Max) + if (RegCheckErr(Buf, RoutineName)) return + ! PtchRate_Min + call RegPack(Buf, InData%PtchRate_Min) + if (RegCheckErr(Buf, RoutineName)) return + ! GenPwr_Dem + call RegPack(Buf, InData%GenPwr_Dem) + if (RegCheckErr(Buf, RoutineName)) return + ! Gain_OM + call RegPack(Buf, InData%Gain_OM) + if (RegCheckErr(Buf, RoutineName)) return + ! GenSpd_MaxOM + call RegPack(Buf, InData%GenSpd_MaxOM) + if (RegCheckErr(Buf, RoutineName)) return + ! GenSpd_MinOM + call RegPack(Buf, InData%GenSpd_MinOM) + if (RegCheckErr(Buf, RoutineName)) return + ! Ptch_Cntrl + call RegPack(Buf, InData%Ptch_Cntrl) + if (RegCheckErr(Buf, RoutineName)) return + ! DLL_NumTrq + call RegPack(Buf, InData%DLL_NumTrq) + if (RegCheckErr(Buf, RoutineName)) return + ! GenSpd_TLU + call RegPack(Buf, allocated(InData%GenSpd_TLU)) + if (allocated(InData%GenSpd_TLU)) then + call RegPackBounds(Buf, 1, lbound(InData%GenSpd_TLU), ubound(InData%GenSpd_TLU)) + call RegPack(Buf, InData%GenSpd_TLU) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! GenTrq_TLU + call RegPack(Buf, allocated(InData%GenTrq_TLU)) + if (allocated(InData%GenTrq_TLU)) then + call RegPackBounds(Buf, 1, lbound(InData%GenTrq_TLU), ubound(InData%GenTrq_TLU)) + call RegPack(Buf, InData%GenTrq_TLU) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Yaw_Cntrl + call RegPack(Buf, InData%Yaw_Cntrl) + if (RegCheckErr(Buf, RoutineName)) return + ! PrevCableDeltaL + call RegPack(Buf, allocated(InData%PrevCableDeltaL)) + if (allocated(InData%PrevCableDeltaL)) then + call RegPackBounds(Buf, 1, lbound(InData%PrevCableDeltaL), ubound(InData%PrevCableDeltaL)) + call RegPack(Buf, InData%PrevCableDeltaL) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PrevCableDeltaLdot + call RegPack(Buf, allocated(InData%PrevCableDeltaLdot)) + if (allocated(InData%PrevCableDeltaLdot)) then + call RegPackBounds(Buf, 1, lbound(InData%PrevCableDeltaLdot), ubound(InData%PrevCableDeltaLdot)) + call RegPack(Buf, InData%PrevCableDeltaLdot) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CableDeltaL + call RegPack(Buf, allocated(InData%CableDeltaL)) + if (allocated(InData%CableDeltaL)) then + call RegPackBounds(Buf, 1, lbound(InData%CableDeltaL), ubound(InData%CableDeltaL)) + call RegPack(Buf, InData%CableDeltaL) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CableDeltaLdot + call RegPack(Buf, allocated(InData%CableDeltaLdot)) + if (allocated(InData%CableDeltaLdot)) then + call RegPackBounds(Buf, 1, lbound(InData%CableDeltaLdot), ubound(InData%CableDeltaLdot)) + call RegPack(Buf, InData%CableDeltaLdot) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PrevStCCmdStiff + call RegPack(Buf, allocated(InData%PrevStCCmdStiff)) + if (allocated(InData%PrevStCCmdStiff)) then + call RegPackBounds(Buf, 2, lbound(InData%PrevStCCmdStiff), ubound(InData%PrevStCCmdStiff)) + call RegPack(Buf, InData%PrevStCCmdStiff) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PrevStCCmdDamp + call RegPack(Buf, allocated(InData%PrevStCCmdDamp)) + if (allocated(InData%PrevStCCmdDamp)) then + call RegPackBounds(Buf, 2, lbound(InData%PrevStCCmdDamp), ubound(InData%PrevStCCmdDamp)) + call RegPack(Buf, InData%PrevStCCmdDamp) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PrevStCCmdBrake + call RegPack(Buf, allocated(InData%PrevStCCmdBrake)) + if (allocated(InData%PrevStCCmdBrake)) then + call RegPackBounds(Buf, 2, lbound(InData%PrevStCCmdBrake), ubound(InData%PrevStCCmdBrake)) + call RegPack(Buf, InData%PrevStCCmdBrake) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PrevStCCmdForce + call RegPack(Buf, allocated(InData%PrevStCCmdForce)) + if (allocated(InData%PrevStCCmdForce)) then + call RegPackBounds(Buf, 2, lbound(InData%PrevStCCmdForce), ubound(InData%PrevStCCmdForce)) + call RegPack(Buf, InData%PrevStCCmdForce) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! StCCmdStiff + call RegPack(Buf, allocated(InData%StCCmdStiff)) + if (allocated(InData%StCCmdStiff)) then + call RegPackBounds(Buf, 2, lbound(InData%StCCmdStiff), ubound(InData%StCCmdStiff)) + call RegPack(Buf, InData%StCCmdStiff) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! StCCmdDamp + call RegPack(Buf, allocated(InData%StCCmdDamp)) + if (allocated(InData%StCCmdDamp)) then + call RegPackBounds(Buf, 2, lbound(InData%StCCmdDamp), ubound(InData%StCCmdDamp)) + call RegPack(Buf, InData%StCCmdDamp) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! StCCmdBrake + call RegPack(Buf, allocated(InData%StCCmdBrake)) + if (allocated(InData%StCCmdBrake)) then + call RegPackBounds(Buf, 2, lbound(InData%StCCmdBrake), ubound(InData%StCCmdBrake)) + call RegPack(Buf, InData%StCCmdBrake) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! StCCmdForce + call RegPack(Buf, allocated(InData%StCCmdForce)) + if (allocated(InData%StCCmdForce)) then + call RegPackBounds(Buf, 2, lbound(InData%StCCmdForce), ubound(InData%StCCmdForce)) + call RegPack(Buf, InData%StCCmdForce) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! StCMeasDisp + call RegPack(Buf, allocated(InData%StCMeasDisp)) + if (allocated(InData%StCMeasDisp)) then + call RegPackBounds(Buf, 2, lbound(InData%StCMeasDisp), ubound(InData%StCMeasDisp)) + call RegPack(Buf, InData%StCMeasDisp) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! StCMeasVel + call RegPack(Buf, allocated(InData%StCMeasVel)) + if (allocated(InData%StCMeasVel)) then + call RegPackBounds(Buf, 2, lbound(InData%StCMeasVel), ubound(InData%StCMeasVel)) + call RegPack(Buf, InData%StCMeasVel) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SrvD_UnPackBladedDLLType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(BladedDLLType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SrvD_UnPackBladedDLLType' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! avrSWAP + if (allocated(OutData%avrSWAP)) deallocate(OutData%avrSWAP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%avrSWAP(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%avrSWAP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%avrSWAP) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! HSSBrTrqDemand + call RegUnpack(Buf, OutData%HSSBrTrqDemand) + if (RegCheckErr(Buf, RoutineName)) return + ! YawRateCom + call RegUnpack(Buf, OutData%YawRateCom) + if (RegCheckErr(Buf, RoutineName)) return + ! GenTrq + call RegUnpack(Buf, OutData%GenTrq) + if (RegCheckErr(Buf, RoutineName)) return + ! GenState + call RegUnpack(Buf, OutData%GenState) + if (RegCheckErr(Buf, RoutineName)) return + ! BlPitchCom + call RegUnpack(Buf, OutData%BlPitchCom) + if (RegCheckErr(Buf, RoutineName)) return + ! PrevBlPitch + call RegUnpack(Buf, OutData%PrevBlPitch) + if (RegCheckErr(Buf, RoutineName)) return + ! BlAirfoilCom + call RegUnpack(Buf, OutData%BlAirfoilCom) + if (RegCheckErr(Buf, RoutineName)) return + ! PrevBlAirfoilCom + call RegUnpack(Buf, OutData%PrevBlAirfoilCom) + if (RegCheckErr(Buf, RoutineName)) return + ! ElecPwr_prev + call RegUnpack(Buf, OutData%ElecPwr_prev) + if (RegCheckErr(Buf, RoutineName)) return + ! GenTrq_prev + call RegUnpack(Buf, OutData%GenTrq_prev) + if (RegCheckErr(Buf, RoutineName)) return + ! toSC + if (allocated(OutData%toSC)) deallocate(OutData%toSC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%toSC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%toSC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%toSC) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! initialized + call RegUnpack(Buf, OutData%initialized) + if (RegCheckErr(Buf, RoutineName)) return + ! NumLogChannels + call RegUnpack(Buf, OutData%NumLogChannels) + if (RegCheckErr(Buf, RoutineName)) return + ! LogChannels_OutParam + if (allocated(OutData%LogChannels_OutParam)) deallocate(OutData%LogChannels_OutParam) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LogChannels_OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LogChannels_OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(Buf, OutData%LogChannels_OutParam(i1)) ! LogChannels_OutParam + end do + end if + ! LogChannels + if (allocated(OutData%LogChannels)) deallocate(OutData%LogChannels) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LogChannels(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LogChannels.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LogChannels) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ErrStat + call RegUnpack(Buf, OutData%ErrStat) + if (RegCheckErr(Buf, RoutineName)) return + ! ErrMsg + call RegUnpack(Buf, OutData%ErrMsg) + if (RegCheckErr(Buf, RoutineName)) return + ! CurrentTime + call RegUnpack(Buf, OutData%CurrentTime) + if (RegCheckErr(Buf, RoutineName)) return + ! SimStatus + call RegUnpack(Buf, OutData%SimStatus) + if (RegCheckErr(Buf, RoutineName)) return + ! ShaftBrakeStatusBinaryFlag + call RegUnpack(Buf, OutData%ShaftBrakeStatusBinaryFlag) + if (RegCheckErr(Buf, RoutineName)) return + ! HSSBrDeployed + call RegUnpack(Buf, OutData%HSSBrDeployed) + if (RegCheckErr(Buf, RoutineName)) return + ! TimeHSSBrFullyDeployed + call RegUnpack(Buf, OutData%TimeHSSBrFullyDeployed) + if (RegCheckErr(Buf, RoutineName)) return + ! TimeHSSBrDeployed + call RegUnpack(Buf, OutData%TimeHSSBrDeployed) + if (RegCheckErr(Buf, RoutineName)) return + ! OverrideYawRateWithTorque + call RegUnpack(Buf, OutData%OverrideYawRateWithTorque) + if (RegCheckErr(Buf, RoutineName)) return + ! YawTorqueDemand + call RegUnpack(Buf, OutData%YawTorqueDemand) + if (RegCheckErr(Buf, RoutineName)) return + ! BlPitchInput + if (allocated(OutData%BlPitchInput)) deallocate(OutData%BlPitchInput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlPitchInput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchInput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlPitchInput) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! YawAngleFromNorth + call RegUnpack(Buf, OutData%YawAngleFromNorth) + if (RegCheckErr(Buf, RoutineName)) return + ! HorWindV + call RegUnpack(Buf, OutData%HorWindV) + if (RegCheckErr(Buf, RoutineName)) return + ! HSS_Spd + call RegUnpack(Buf, OutData%HSS_Spd) + if (RegCheckErr(Buf, RoutineName)) return + ! YawErr + call RegUnpack(Buf, OutData%YawErr) + if (RegCheckErr(Buf, RoutineName)) return + ! RotSpeed + call RegUnpack(Buf, OutData%RotSpeed) + if (RegCheckErr(Buf, RoutineName)) return + ! YawBrTAxp + call RegUnpack(Buf, OutData%YawBrTAxp) + if (RegCheckErr(Buf, RoutineName)) return + ! YawBrTAyp + call RegUnpack(Buf, OutData%YawBrTAyp) + if (RegCheckErr(Buf, RoutineName)) return + ! LSSTipMys + call RegUnpack(Buf, OutData%LSSTipMys) + if (RegCheckErr(Buf, RoutineName)) return + ! LSSTipMzs + call RegUnpack(Buf, OutData%LSSTipMzs) + if (RegCheckErr(Buf, RoutineName)) return + ! LSSTipMya + call RegUnpack(Buf, OutData%LSSTipMya) + if (RegCheckErr(Buf, RoutineName)) return + ! LSSTipMza + call RegUnpack(Buf, OutData%LSSTipMza) + if (RegCheckErr(Buf, RoutineName)) return + ! LSSTipPxa + call RegUnpack(Buf, OutData%LSSTipPxa) + if (RegCheckErr(Buf, RoutineName)) return + ! Yaw + call RegUnpack(Buf, OutData%Yaw) + if (RegCheckErr(Buf, RoutineName)) return + ! YawRate + call RegUnpack(Buf, OutData%YawRate) + if (RegCheckErr(Buf, RoutineName)) return + ! YawBrMyn + call RegUnpack(Buf, OutData%YawBrMyn) + if (RegCheckErr(Buf, RoutineName)) return + ! YawBrMzn + call RegUnpack(Buf, OutData%YawBrMzn) + if (RegCheckErr(Buf, RoutineName)) return + ! NcIMURAxs + call RegUnpack(Buf, OutData%NcIMURAxs) + if (RegCheckErr(Buf, RoutineName)) return + ! NcIMURAys + call RegUnpack(Buf, OutData%NcIMURAys) + if (RegCheckErr(Buf, RoutineName)) return + ! NcIMURAzs + call RegUnpack(Buf, OutData%NcIMURAzs) + if (RegCheckErr(Buf, RoutineName)) return + ! RotPwr + call RegUnpack(Buf, OutData%RotPwr) + if (RegCheckErr(Buf, RoutineName)) return + ! LSSTipMxa + call RegUnpack(Buf, OutData%LSSTipMxa) + if (RegCheckErr(Buf, RoutineName)) return + ! RootMyc + call RegUnpack(Buf, OutData%RootMyc) + if (RegCheckErr(Buf, RoutineName)) return + ! RootMxc + call RegUnpack(Buf, OutData%RootMxc) + if (RegCheckErr(Buf, RoutineName)) return + ! LSShftFxa + call RegUnpack(Buf, OutData%LSShftFxa) + if (RegCheckErr(Buf, RoutineName)) return + ! LSShftFys + call RegUnpack(Buf, OutData%LSShftFys) + if (RegCheckErr(Buf, RoutineName)) return + ! LSShftFzs + call RegUnpack(Buf, OutData%LSShftFzs) + if (RegCheckErr(Buf, RoutineName)) return + ! LidSpeed + if (allocated(OutData%LidSpeed)) deallocate(OutData%LidSpeed) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LidSpeed(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LidSpeed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LidSpeed) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! MsrPositionsX + if (allocated(OutData%MsrPositionsX)) deallocate(OutData%MsrPositionsX) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MsrPositionsX(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MsrPositionsX) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! MsrPositionsY + if (allocated(OutData%MsrPositionsY)) deallocate(OutData%MsrPositionsY) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MsrPositionsY(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MsrPositionsY) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! MsrPositionsZ + if (allocated(OutData%MsrPositionsZ)) deallocate(OutData%MsrPositionsZ) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MsrPositionsZ(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsZ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MsrPositionsZ) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! SensorType + call RegUnpack(Buf, OutData%SensorType) + if (RegCheckErr(Buf, RoutineName)) return + ! NumBeam + call RegUnpack(Buf, OutData%NumBeam) + if (RegCheckErr(Buf, RoutineName)) return + ! NumPulseGate + call RegUnpack(Buf, OutData%NumPulseGate) + if (RegCheckErr(Buf, RoutineName)) return + ! PulseSpacing + call RegUnpack(Buf, OutData%PulseSpacing) + if (RegCheckErr(Buf, RoutineName)) return + ! URefLid + call RegUnpack(Buf, OutData%URefLid) + if (RegCheckErr(Buf, RoutineName)) return + ! DLL_DT + call RegUnpack(Buf, OutData%DLL_DT) + if (RegCheckErr(Buf, RoutineName)) return + ! DLL_InFile + call RegUnpack(Buf, OutData%DLL_InFile) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! GenTrq_Dem + call RegUnpack(Buf, OutData%GenTrq_Dem) + if (RegCheckErr(Buf, RoutineName)) return + ! GenSpd_Dem + call RegUnpack(Buf, OutData%GenSpd_Dem) + if (RegCheckErr(Buf, RoutineName)) return + ! Ptch_Max + call RegUnpack(Buf, OutData%Ptch_Max) + if (RegCheckErr(Buf, RoutineName)) return + ! Ptch_Min + call RegUnpack(Buf, OutData%Ptch_Min) + if (RegCheckErr(Buf, RoutineName)) return + ! Ptch_SetPnt + call RegUnpack(Buf, OutData%Ptch_SetPnt) + if (RegCheckErr(Buf, RoutineName)) return + ! PtchRate_Max + call RegUnpack(Buf, OutData%PtchRate_Max) + if (RegCheckErr(Buf, RoutineName)) return + ! PtchRate_Min + call RegUnpack(Buf, OutData%PtchRate_Min) + if (RegCheckErr(Buf, RoutineName)) return + ! GenPwr_Dem + call RegUnpack(Buf, OutData%GenPwr_Dem) + if (RegCheckErr(Buf, RoutineName)) return + ! Gain_OM + call RegUnpack(Buf, OutData%Gain_OM) + if (RegCheckErr(Buf, RoutineName)) return + ! GenSpd_MaxOM + call RegUnpack(Buf, OutData%GenSpd_MaxOM) + if (RegCheckErr(Buf, RoutineName)) return + ! GenSpd_MinOM + call RegUnpack(Buf, OutData%GenSpd_MinOM) + if (RegCheckErr(Buf, RoutineName)) return + ! Ptch_Cntrl + call RegUnpack(Buf, OutData%Ptch_Cntrl) + if (RegCheckErr(Buf, RoutineName)) return + ! DLL_NumTrq + call RegUnpack(Buf, OutData%DLL_NumTrq) + if (RegCheckErr(Buf, RoutineName)) return + ! GenSpd_TLU + if (allocated(OutData%GenSpd_TLU)) deallocate(OutData%GenSpd_TLU) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%GenSpd_TLU(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GenSpd_TLU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%GenSpd_TLU) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! GenTrq_TLU + if (allocated(OutData%GenTrq_TLU)) deallocate(OutData%GenTrq_TLU) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%GenTrq_TLU(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%GenTrq_TLU.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%GenTrq_TLU) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Yaw_Cntrl + call RegUnpack(Buf, OutData%Yaw_Cntrl) + if (RegCheckErr(Buf, RoutineName)) return + ! PrevCableDeltaL + if (allocated(OutData%PrevCableDeltaL)) deallocate(OutData%PrevCableDeltaL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PrevCableDeltaL(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PrevCableDeltaL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PrevCableDeltaL) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PrevCableDeltaLdot + if (allocated(OutData%PrevCableDeltaLdot)) deallocate(OutData%PrevCableDeltaLdot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PrevCableDeltaLdot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PrevCableDeltaLdot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PrevCableDeltaLdot) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CableDeltaL + if (allocated(OutData%CableDeltaL)) deallocate(OutData%CableDeltaL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CableDeltaL(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableDeltaL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CableDeltaL) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CableDeltaLdot + if (allocated(OutData%CableDeltaLdot)) deallocate(OutData%CableDeltaLdot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CableDeltaLdot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableDeltaLdot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CableDeltaLdot) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PrevStCCmdStiff + if (allocated(OutData%PrevStCCmdStiff)) deallocate(OutData%PrevStCCmdStiff) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PrevStCCmdStiff(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PrevStCCmdStiff.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PrevStCCmdStiff) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PrevStCCmdDamp + if (allocated(OutData%PrevStCCmdDamp)) deallocate(OutData%PrevStCCmdDamp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PrevStCCmdDamp(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PrevStCCmdDamp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PrevStCCmdDamp) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PrevStCCmdBrake + if (allocated(OutData%PrevStCCmdBrake)) deallocate(OutData%PrevStCCmdBrake) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PrevStCCmdBrake(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PrevStCCmdBrake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PrevStCCmdBrake) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PrevStCCmdForce + if (allocated(OutData%PrevStCCmdForce)) deallocate(OutData%PrevStCCmdForce) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PrevStCCmdForce(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PrevStCCmdForce.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PrevStCCmdForce) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! StCCmdStiff + if (allocated(OutData%StCCmdStiff)) deallocate(OutData%StCCmdStiff) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StCCmdStiff(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StCCmdStiff.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StCCmdStiff) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! StCCmdDamp + if (allocated(OutData%StCCmdDamp)) deallocate(OutData%StCCmdDamp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StCCmdDamp(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StCCmdDamp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StCCmdDamp) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! StCCmdBrake + if (allocated(OutData%StCCmdBrake)) deallocate(OutData%StCCmdBrake) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StCCmdBrake(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StCCmdBrake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StCCmdBrake) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! StCCmdForce + if (allocated(OutData%StCCmdForce)) deallocate(OutData%StCCmdForce) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StCCmdForce(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StCCmdForce.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StCCmdForce) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! StCMeasDisp + if (allocated(OutData%StCMeasDisp)) deallocate(OutData%StCMeasDisp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StCMeasDisp(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StCMeasDisp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StCMeasDisp) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! StCMeasVel + if (allocated(OutData%StCMeasVel)) deallocate(OutData%StCMeasVel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StCMeasVel(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StCMeasVel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StCMeasVel) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE SrvD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(SrvD_ContinuousStateType), INTENT(IN) :: SrcContStateData TYPE(SrvD_ContinuousStateType), INTENT(INOUT) :: DstContStateData @@ -5899,585 +4269,140 @@ SUBROUTINE SrvD_DestroyContState( ContStateData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE SrvD_DestroyContState - SUBROUTINE SrvD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SrvD_ContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_PackContState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyContState - Int_BufSz = Int_BufSz + 1 ! BStC allocated yes/no - IF ( ALLOCATED(InData%BStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BStC upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%BStC,1), UBOUND(InData%BStC,1) - Int_BufSz = Int_BufSz + 3 ! BStC: size of buffers for each call to pack subtype - CALL StC_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%BStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NStC allocated yes/no - IF ( ALLOCATED(InData%NStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%NStC,1), UBOUND(InData%NStC,1) - Int_BufSz = Int_BufSz + 3 ! NStC: size of buffers for each call to pack subtype - CALL StC_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%NStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! TStC allocated yes/no - IF ( ALLOCATED(InData%TStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%TStC,1), UBOUND(InData%TStC,1) - Int_BufSz = Int_BufSz + 3 ! TStC: size of buffers for each call to pack subtype - CALL StC_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%TStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SStC allocated yes/no - IF ( ALLOCATED(InData%SStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%SStC,1), UBOUND(InData%SStC,1) - Int_BufSz = Int_BufSz + 3 ! SStC: size of buffers for each call to pack subtype - CALL StC_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%SStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BStC,1), UBOUND(InData%BStC,1) - CALL StC_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%BStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NStC,1), UBOUND(InData%NStC,1) - CALL StC_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%NStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TStC,1), UBOUND(InData%TStC,1) - CALL StC_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%TStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SStC,1), UBOUND(InData%SStC,1) - CALL StC_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%SStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - END SUBROUTINE SrvD_PackContState - - SUBROUTINE SrvD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SrvD_ContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_UnPackContState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyContState = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BStC)) DEALLOCATE(OutData%BStC) - ALLOCATE(OutData%BStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BStC,1), UBOUND(OutData%BStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%BStC(i1), ErrStat2, ErrMsg2 ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NStC)) DEALLOCATE(OutData%NStC) - ALLOCATE(OutData%NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NStC,1), UBOUND(OutData%NStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%NStC(i1), ErrStat2, ErrMsg2 ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TStC)) DEALLOCATE(OutData%TStC) - ALLOCATE(OutData%TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TStC,1), UBOUND(OutData%TStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%TStC(i1), ErrStat2, ErrMsg2 ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SStC)) DEALLOCATE(OutData%SStC) - ALLOCATE(OutData%SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SStC,1), UBOUND(OutData%SStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%SStC(i1), ErrStat2, ErrMsg2 ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - END SUBROUTINE SrvD_UnPackContState +subroutine SrvD_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackContState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! DummyContState + call RegPack(Buf, InData%DummyContState) + if (RegCheckErr(Buf, RoutineName)) return + ! BStC + call RegPack(Buf, allocated(InData%BStC)) + if (allocated(InData%BStC)) then + call RegPackBounds(Buf, 1, lbound(InData%BStC), ubound(InData%BStC)) + LB(1:1) = lbound(InData%BStC) + UB(1:1) = ubound(InData%BStC) + do i1 = LB(1), UB(1) + call StC_PackContState(Buf, InData%BStC(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NStC + call RegPack(Buf, allocated(InData%NStC)) + if (allocated(InData%NStC)) then + call RegPackBounds(Buf, 1, lbound(InData%NStC), ubound(InData%NStC)) + LB(1:1) = lbound(InData%NStC) + UB(1:1) = ubound(InData%NStC) + do i1 = LB(1), UB(1) + call StC_PackContState(Buf, InData%NStC(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TStC + call RegPack(Buf, allocated(InData%TStC)) + if (allocated(InData%TStC)) then + call RegPackBounds(Buf, 1, lbound(InData%TStC), ubound(InData%TStC)) + LB(1:1) = lbound(InData%TStC) + UB(1:1) = ubound(InData%TStC) + do i1 = LB(1), UB(1) + call StC_PackContState(Buf, InData%TStC(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SStC + call RegPack(Buf, allocated(InData%SStC)) + if (allocated(InData%SStC)) then + call RegPackBounds(Buf, 1, lbound(InData%SStC), ubound(InData%SStC)) + LB(1:1) = lbound(InData%SStC) + UB(1:1) = ubound(InData%SStC) + do i1 = LB(1), UB(1) + call StC_PackContState(Buf, InData%SStC(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SrvD_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SrvD_UnPackContState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! DummyContState + call RegUnpack(Buf, OutData%DummyContState) + if (RegCheckErr(Buf, RoutineName)) return + ! BStC + if (allocated(OutData%BStC)) deallocate(OutData%BStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackContState(Buf, OutData%BStC(i1)) ! BStC + end do + end if + ! NStC + if (allocated(OutData%NStC)) deallocate(OutData%NStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackContState(Buf, OutData%NStC(i1)) ! NStC + end do + end if + ! TStC + if (allocated(OutData%TStC)) deallocate(OutData%TStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackContState(Buf, OutData%TStC(i1)) ! TStC + end do + end if + ! SStC + if (allocated(OutData%SStC)) deallocate(OutData%SStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackContState(Buf, OutData%SStC(i1)) ! SStC + end do + end if +end subroutine SUBROUTINE SrvD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(SrvD_DiscreteStateType), INTENT(IN) :: SrcDiscStateData TYPE(SrvD_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData @@ -6603,585 +4528,140 @@ SUBROUTINE SrvD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE SrvD_DestroyDiscState - SUBROUTINE SrvD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SrvD_DiscreteStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_PackDiscState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! CtrlOffset - Int_BufSz = Int_BufSz + 1 ! BStC allocated yes/no - IF ( ALLOCATED(InData%BStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BStC upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%BStC,1), UBOUND(InData%BStC,1) - Int_BufSz = Int_BufSz + 3 ! BStC: size of buffers for each call to pack subtype - CALL StC_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%BStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NStC allocated yes/no - IF ( ALLOCATED(InData%NStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%NStC,1), UBOUND(InData%NStC,1) - Int_BufSz = Int_BufSz + 3 ! NStC: size of buffers for each call to pack subtype - CALL StC_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%NStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! TStC allocated yes/no - IF ( ALLOCATED(InData%TStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%TStC,1), UBOUND(InData%TStC,1) - Int_BufSz = Int_BufSz + 3 ! TStC: size of buffers for each call to pack subtype - CALL StC_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%TStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SStC allocated yes/no - IF ( ALLOCATED(InData%SStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%SStC,1), UBOUND(InData%SStC,1) - Int_BufSz = Int_BufSz + 3 ! SStC: size of buffers for each call to pack subtype - CALL StC_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%SStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%CtrlOffset - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BStC,1), UBOUND(InData%BStC,1) - CALL StC_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%BStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NStC,1), UBOUND(InData%NStC,1) - CALL StC_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%NStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TStC,1), UBOUND(InData%TStC,1) - CALL StC_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%TStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SStC,1), UBOUND(InData%SStC,1) - CALL StC_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%SStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - END SUBROUTINE SrvD_PackDiscState - - SUBROUTINE SrvD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SrvD_DiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_UnPackDiscState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%CtrlOffset = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BStC)) DEALLOCATE(OutData%BStC) - ALLOCATE(OutData%BStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BStC,1), UBOUND(OutData%BStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%BStC(i1), ErrStat2, ErrMsg2 ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NStC)) DEALLOCATE(OutData%NStC) - ALLOCATE(OutData%NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NStC,1), UBOUND(OutData%NStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%NStC(i1), ErrStat2, ErrMsg2 ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TStC)) DEALLOCATE(OutData%TStC) - ALLOCATE(OutData%TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TStC,1), UBOUND(OutData%TStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%TStC(i1), ErrStat2, ErrMsg2 ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SStC)) DEALLOCATE(OutData%SStC) - ALLOCATE(OutData%SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SStC,1), UBOUND(OutData%SStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%SStC(i1), ErrStat2, ErrMsg2 ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - END SUBROUTINE SrvD_UnPackDiscState +subroutine SrvD_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackDiscState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! CtrlOffset + call RegPack(Buf, InData%CtrlOffset) + if (RegCheckErr(Buf, RoutineName)) return + ! BStC + call RegPack(Buf, allocated(InData%BStC)) + if (allocated(InData%BStC)) then + call RegPackBounds(Buf, 1, lbound(InData%BStC), ubound(InData%BStC)) + LB(1:1) = lbound(InData%BStC) + UB(1:1) = ubound(InData%BStC) + do i1 = LB(1), UB(1) + call StC_PackDiscState(Buf, InData%BStC(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NStC + call RegPack(Buf, allocated(InData%NStC)) + if (allocated(InData%NStC)) then + call RegPackBounds(Buf, 1, lbound(InData%NStC), ubound(InData%NStC)) + LB(1:1) = lbound(InData%NStC) + UB(1:1) = ubound(InData%NStC) + do i1 = LB(1), UB(1) + call StC_PackDiscState(Buf, InData%NStC(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TStC + call RegPack(Buf, allocated(InData%TStC)) + if (allocated(InData%TStC)) then + call RegPackBounds(Buf, 1, lbound(InData%TStC), ubound(InData%TStC)) + LB(1:1) = lbound(InData%TStC) + UB(1:1) = ubound(InData%TStC) + do i1 = LB(1), UB(1) + call StC_PackDiscState(Buf, InData%TStC(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SStC + call RegPack(Buf, allocated(InData%SStC)) + if (allocated(InData%SStC)) then + call RegPackBounds(Buf, 1, lbound(InData%SStC), ubound(InData%SStC)) + LB(1:1) = lbound(InData%SStC) + UB(1:1) = ubound(InData%SStC) + do i1 = LB(1), UB(1) + call StC_PackDiscState(Buf, InData%SStC(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SrvD_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SrvD_UnPackDiscState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! CtrlOffset + call RegUnpack(Buf, OutData%CtrlOffset) + if (RegCheckErr(Buf, RoutineName)) return + ! BStC + if (allocated(OutData%BStC)) deallocate(OutData%BStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackDiscState(Buf, OutData%BStC(i1)) ! BStC + end do + end if + ! NStC + if (allocated(OutData%NStC)) deallocate(OutData%NStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackDiscState(Buf, OutData%NStC(i1)) ! NStC + end do + end if + ! TStC + if (allocated(OutData%TStC)) deallocate(OutData%TStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackDiscState(Buf, OutData%TStC(i1)) ! TStC + end do + end if + ! SStC + if (allocated(OutData%SStC)) deallocate(OutData%SStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackDiscState(Buf, OutData%SStC(i1)) ! SStC + end do + end if +end subroutine SUBROUTINE SrvD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(SrvD_ConstraintStateType), INTENT(IN) :: SrcConstrStateData TYPE(SrvD_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData @@ -7307,585 +4787,140 @@ SUBROUTINE SrvD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE SrvD_DestroyConstrState - SUBROUTINE SrvD_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SrvD_ConstraintStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_PackConstrState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyConstrState - Int_BufSz = Int_BufSz + 1 ! BStC allocated yes/no - IF ( ALLOCATED(InData%BStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BStC upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%BStC,1), UBOUND(InData%BStC,1) - Int_BufSz = Int_BufSz + 3 ! BStC: size of buffers for each call to pack subtype - CALL StC_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%BStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NStC allocated yes/no - IF ( ALLOCATED(InData%NStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%NStC,1), UBOUND(InData%NStC,1) - Int_BufSz = Int_BufSz + 3 ! NStC: size of buffers for each call to pack subtype - CALL StC_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%NStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! TStC allocated yes/no - IF ( ALLOCATED(InData%TStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%TStC,1), UBOUND(InData%TStC,1) - Int_BufSz = Int_BufSz + 3 ! TStC: size of buffers for each call to pack subtype - CALL StC_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%TStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SStC allocated yes/no - IF ( ALLOCATED(InData%SStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%SStC,1), UBOUND(InData%SStC,1) - Int_BufSz = Int_BufSz + 3 ! SStC: size of buffers for each call to pack subtype - CALL StC_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%SStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BStC,1), UBOUND(InData%BStC,1) - CALL StC_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%BStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NStC,1), UBOUND(InData%NStC,1) - CALL StC_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%NStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TStC,1), UBOUND(InData%TStC,1) - CALL StC_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%TStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SStC,1), UBOUND(InData%SStC,1) - CALL StC_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%SStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - END SUBROUTINE SrvD_PackConstrState - - SUBROUTINE SrvD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SrvD_ConstraintStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_UnPackConstrState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyConstrState = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BStC)) DEALLOCATE(OutData%BStC) - ALLOCATE(OutData%BStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BStC,1), UBOUND(OutData%BStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%BStC(i1), ErrStat2, ErrMsg2 ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NStC)) DEALLOCATE(OutData%NStC) - ALLOCATE(OutData%NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NStC,1), UBOUND(OutData%NStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%NStC(i1), ErrStat2, ErrMsg2 ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TStC)) DEALLOCATE(OutData%TStC) - ALLOCATE(OutData%TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TStC,1), UBOUND(OutData%TStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%TStC(i1), ErrStat2, ErrMsg2 ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SStC)) DEALLOCATE(OutData%SStC) - ALLOCATE(OutData%SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SStC,1), UBOUND(OutData%SStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%SStC(i1), ErrStat2, ErrMsg2 ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - END SUBROUTINE SrvD_UnPackConstrState +subroutine SrvD_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackConstrState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! DummyConstrState + call RegPack(Buf, InData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return + ! BStC + call RegPack(Buf, allocated(InData%BStC)) + if (allocated(InData%BStC)) then + call RegPackBounds(Buf, 1, lbound(InData%BStC), ubound(InData%BStC)) + LB(1:1) = lbound(InData%BStC) + UB(1:1) = ubound(InData%BStC) + do i1 = LB(1), UB(1) + call StC_PackConstrState(Buf, InData%BStC(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NStC + call RegPack(Buf, allocated(InData%NStC)) + if (allocated(InData%NStC)) then + call RegPackBounds(Buf, 1, lbound(InData%NStC), ubound(InData%NStC)) + LB(1:1) = lbound(InData%NStC) + UB(1:1) = ubound(InData%NStC) + do i1 = LB(1), UB(1) + call StC_PackConstrState(Buf, InData%NStC(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TStC + call RegPack(Buf, allocated(InData%TStC)) + if (allocated(InData%TStC)) then + call RegPackBounds(Buf, 1, lbound(InData%TStC), ubound(InData%TStC)) + LB(1:1) = lbound(InData%TStC) + UB(1:1) = ubound(InData%TStC) + do i1 = LB(1), UB(1) + call StC_PackConstrState(Buf, InData%TStC(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SStC + call RegPack(Buf, allocated(InData%SStC)) + if (allocated(InData%SStC)) then + call RegPackBounds(Buf, 1, lbound(InData%SStC), ubound(InData%SStC)) + LB(1:1) = lbound(InData%SStC) + UB(1:1) = ubound(InData%SStC) + do i1 = LB(1), UB(1) + call StC_PackConstrState(Buf, InData%SStC(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SrvD_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SrvD_UnPackConstrState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! DummyConstrState + call RegUnpack(Buf, OutData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return + ! BStC + if (allocated(OutData%BStC)) deallocate(OutData%BStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackConstrState(Buf, OutData%BStC(i1)) ! BStC + end do + end if + ! NStC + if (allocated(OutData%NStC)) deallocate(OutData%NStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackConstrState(Buf, OutData%NStC(i1)) ! NStC + end do + end if + ! TStC + if (allocated(OutData%TStC)) deallocate(OutData%TStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackConstrState(Buf, OutData%TStC(i1)) ! TStC + end do + end if + ! SStC + if (allocated(OutData%SStC)) deallocate(OutData%SStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackConstrState(Buf, OutData%SStC(i1)) ! SStC + end do + end if +end subroutine SUBROUTINE SrvD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(SrvD_OtherStateType), INTENT(IN) :: SrcOtherStateData TYPE(SrvD_OtherStateType), INTENT(INOUT) :: DstOtherStateData @@ -8106,838 +5141,302 @@ SUBROUTINE SrvD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE SrvD_DestroyOtherState - SUBROUTINE SrvD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SrvD_OtherStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_PackOtherState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! BegPitMan allocated yes/no - IF ( ALLOCATED(InData%BegPitMan) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BegPitMan upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BegPitMan) ! BegPitMan - END IF - Int_BufSz = Int_BufSz + 1 ! BlPitchI allocated yes/no - IF ( ALLOCATED(InData%BlPitchI) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlPitchI upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlPitchI) ! BlPitchI - END IF - Int_BufSz = Int_BufSz + 1 ! TPitManE allocated yes/no - IF ( ALLOCATED(InData%TPitManE) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TPitManE upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%TPitManE) ! TPitManE - END IF - Int_BufSz = Int_BufSz + 1 ! BegYawMan - Re_BufSz = Re_BufSz + 1 ! NacYawI - Db_BufSz = Db_BufSz + 1 ! TYawManE - Re_BufSz = Re_BufSz + 1 ! YawPosComInt - Int_BufSz = Int_BufSz + 1 ! BegTpBr allocated yes/no - IF ( ALLOCATED(InData%BegTpBr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BegTpBr upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BegTpBr) ! BegTpBr - END IF - Int_BufSz = Int_BufSz + 1 ! TTpBrDp allocated yes/no - IF ( ALLOCATED(InData%TTpBrDp) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TTpBrDp upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%TTpBrDp) ! TTpBrDp - END IF - Int_BufSz = Int_BufSz + 1 ! TTpBrFl allocated yes/no - IF ( ALLOCATED(InData%TTpBrFl) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TTpBrFl upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%TTpBrFl) ! TTpBrFl - END IF - Int_BufSz = Int_BufSz + 1 ! Off4Good - Int_BufSz = Int_BufSz + 1 ! GenOnLine - Int_BufSz = Int_BufSz + 1 ! BStC allocated yes/no - IF ( ALLOCATED(InData%BStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BStC upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%BStC,1), UBOUND(InData%BStC,1) - Int_BufSz = Int_BufSz + 3 ! BStC: size of buffers for each call to pack subtype - CALL StC_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%BStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NStC allocated yes/no - IF ( ALLOCATED(InData%NStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%NStC,1), UBOUND(InData%NStC,1) - Int_BufSz = Int_BufSz + 3 ! NStC: size of buffers for each call to pack subtype - CALL StC_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%NStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! TStC allocated yes/no - IF ( ALLOCATED(InData%TStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%TStC,1), UBOUND(InData%TStC,1) - Int_BufSz = Int_BufSz + 3 ! TStC: size of buffers for each call to pack subtype - CALL StC_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%TStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SStC allocated yes/no - IF ( ALLOCATED(InData%SStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%SStC,1), UBOUND(InData%SStC,1) - Int_BufSz = Int_BufSz + 3 ! SStC: size of buffers for each call to pack subtype - CALL StC_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%SStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%BegPitMan) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BegPitMan,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BegPitMan,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BegPitMan,1), UBOUND(InData%BegPitMan,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%BegPitMan(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlPitchI) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlPitchI,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitchI,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlPitchI,1), UBOUND(InData%BlPitchI,1) - ReKiBuf(Re_Xferred) = InData%BlPitchI(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TPitManE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TPitManE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TPitManE,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TPitManE,1), UBOUND(InData%TPitManE,1) - DbKiBuf(Db_Xferred) = InData%TPitManE(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%BegYawMan, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NacYawI - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TYawManE - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawPosComInt - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BegTpBr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BegTpBr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BegTpBr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BegTpBr,1), UBOUND(InData%BegTpBr,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%BegTpBr(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TTpBrDp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TTpBrDp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TTpBrDp,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TTpBrDp,1), UBOUND(InData%TTpBrDp,1) - DbKiBuf(Db_Xferred) = InData%TTpBrDp(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TTpBrFl) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TTpBrFl,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TTpBrFl,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TTpBrFl,1), UBOUND(InData%TTpBrFl,1) - DbKiBuf(Db_Xferred) = InData%TTpBrFl(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%Off4Good, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%GenOnLine, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BStC,1), UBOUND(InData%BStC,1) - CALL StC_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%BStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NStC,1), UBOUND(InData%NStC,1) - CALL StC_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%NStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TStC,1), UBOUND(InData%TStC,1) - CALL StC_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%TStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SStC,1), UBOUND(InData%SStC,1) - CALL StC_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%SStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - END SUBROUTINE SrvD_PackOtherState - - SUBROUTINE SrvD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SrvD_OtherStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_UnPackOtherState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BegPitMan not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BegPitMan)) DEALLOCATE(OutData%BegPitMan) - ALLOCATE(OutData%BegPitMan(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BegPitMan.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BegPitMan,1), UBOUND(OutData%BegPitMan,1) - OutData%BegPitMan(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%BegPitMan(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitchI not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlPitchI)) DEALLOCATE(OutData%BlPitchI) - ALLOCATE(OutData%BlPitchI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlPitchI,1), UBOUND(OutData%BlPitchI,1) - OutData%BlPitchI(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TPitManE not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TPitManE)) DEALLOCATE(OutData%TPitManE) - ALLOCATE(OutData%TPitManE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TPitManE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TPitManE,1), UBOUND(OutData%TPitManE,1) - OutData%TPitManE(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - OutData%BegYawMan = TRANSFER(IntKiBuf(Int_Xferred), OutData%BegYawMan) - Int_Xferred = Int_Xferred + 1 - OutData%NacYawI = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TYawManE = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%YawPosComInt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BegTpBr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BegTpBr)) DEALLOCATE(OutData%BegTpBr) - ALLOCATE(OutData%BegTpBr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BegTpBr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BegTpBr,1), UBOUND(OutData%BegTpBr,1) - OutData%BegTpBr(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%BegTpBr(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TTpBrDp not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TTpBrDp)) DEALLOCATE(OutData%TTpBrDp) - ALLOCATE(OutData%TTpBrDp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TTpBrDp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TTpBrDp,1), UBOUND(OutData%TTpBrDp,1) - OutData%TTpBrDp(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TTpBrFl not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TTpBrFl)) DEALLOCATE(OutData%TTpBrFl) - ALLOCATE(OutData%TTpBrFl(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TTpBrFl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TTpBrFl,1), UBOUND(OutData%TTpBrFl,1) - OutData%TTpBrFl(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - OutData%Off4Good = TRANSFER(IntKiBuf(Int_Xferred), OutData%Off4Good) - Int_Xferred = Int_Xferred + 1 - OutData%GenOnLine = TRANSFER(IntKiBuf(Int_Xferred), OutData%GenOnLine) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BStC)) DEALLOCATE(OutData%BStC) - ALLOCATE(OutData%BStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BStC,1), UBOUND(OutData%BStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%BStC(i1), ErrStat2, ErrMsg2 ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NStC)) DEALLOCATE(OutData%NStC) - ALLOCATE(OutData%NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NStC,1), UBOUND(OutData%NStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%NStC(i1), ErrStat2, ErrMsg2 ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TStC)) DEALLOCATE(OutData%TStC) - ALLOCATE(OutData%TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TStC,1), UBOUND(OutData%TStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%TStC(i1), ErrStat2, ErrMsg2 ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SStC)) DEALLOCATE(OutData%SStC) - ALLOCATE(OutData%SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SStC,1), UBOUND(OutData%SStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%SStC(i1), ErrStat2, ErrMsg2 ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - END SUBROUTINE SrvD_UnPackOtherState +subroutine SrvD_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackOtherState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! BegPitMan + call RegPack(Buf, allocated(InData%BegPitMan)) + if (allocated(InData%BegPitMan)) then + call RegPackBounds(Buf, 1, lbound(InData%BegPitMan), ubound(InData%BegPitMan)) + call RegPack(Buf, InData%BegPitMan) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BlPitchI + call RegPack(Buf, allocated(InData%BlPitchI)) + if (allocated(InData%BlPitchI)) then + call RegPackBounds(Buf, 1, lbound(InData%BlPitchI), ubound(InData%BlPitchI)) + call RegPack(Buf, InData%BlPitchI) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TPitManE + call RegPack(Buf, allocated(InData%TPitManE)) + if (allocated(InData%TPitManE)) then + call RegPackBounds(Buf, 1, lbound(InData%TPitManE), ubound(InData%TPitManE)) + call RegPack(Buf, InData%TPitManE) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BegYawMan + call RegPack(Buf, InData%BegYawMan) + if (RegCheckErr(Buf, RoutineName)) return + ! NacYawI + call RegPack(Buf, InData%NacYawI) + if (RegCheckErr(Buf, RoutineName)) return + ! TYawManE + call RegPack(Buf, InData%TYawManE) + if (RegCheckErr(Buf, RoutineName)) return + ! YawPosComInt + call RegPack(Buf, InData%YawPosComInt) + if (RegCheckErr(Buf, RoutineName)) return + ! BegTpBr + call RegPack(Buf, allocated(InData%BegTpBr)) + if (allocated(InData%BegTpBr)) then + call RegPackBounds(Buf, 1, lbound(InData%BegTpBr), ubound(InData%BegTpBr)) + call RegPack(Buf, InData%BegTpBr) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TTpBrDp + call RegPack(Buf, allocated(InData%TTpBrDp)) + if (allocated(InData%TTpBrDp)) then + call RegPackBounds(Buf, 1, lbound(InData%TTpBrDp), ubound(InData%TTpBrDp)) + call RegPack(Buf, InData%TTpBrDp) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TTpBrFl + call RegPack(Buf, allocated(InData%TTpBrFl)) + if (allocated(InData%TTpBrFl)) then + call RegPackBounds(Buf, 1, lbound(InData%TTpBrFl), ubound(InData%TTpBrFl)) + call RegPack(Buf, InData%TTpBrFl) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Off4Good + call RegPack(Buf, InData%Off4Good) + if (RegCheckErr(Buf, RoutineName)) return + ! GenOnLine + call RegPack(Buf, InData%GenOnLine) + if (RegCheckErr(Buf, RoutineName)) return + ! BStC + call RegPack(Buf, allocated(InData%BStC)) + if (allocated(InData%BStC)) then + call RegPackBounds(Buf, 1, lbound(InData%BStC), ubound(InData%BStC)) + LB(1:1) = lbound(InData%BStC) + UB(1:1) = ubound(InData%BStC) + do i1 = LB(1), UB(1) + call StC_PackOtherState(Buf, InData%BStC(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NStC + call RegPack(Buf, allocated(InData%NStC)) + if (allocated(InData%NStC)) then + call RegPackBounds(Buf, 1, lbound(InData%NStC), ubound(InData%NStC)) + LB(1:1) = lbound(InData%NStC) + UB(1:1) = ubound(InData%NStC) + do i1 = LB(1), UB(1) + call StC_PackOtherState(Buf, InData%NStC(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TStC + call RegPack(Buf, allocated(InData%TStC)) + if (allocated(InData%TStC)) then + call RegPackBounds(Buf, 1, lbound(InData%TStC), ubound(InData%TStC)) + LB(1:1) = lbound(InData%TStC) + UB(1:1) = ubound(InData%TStC) + do i1 = LB(1), UB(1) + call StC_PackOtherState(Buf, InData%TStC(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SStC + call RegPack(Buf, allocated(InData%SStC)) + if (allocated(InData%SStC)) then + call RegPackBounds(Buf, 1, lbound(InData%SStC), ubound(InData%SStC)) + LB(1:1) = lbound(InData%SStC) + UB(1:1) = ubound(InData%SStC) + do i1 = LB(1), UB(1) + call StC_PackOtherState(Buf, InData%SStC(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SrvD_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SrvD_UnPackOtherState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! BegPitMan + if (allocated(OutData%BegPitMan)) deallocate(OutData%BegPitMan) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BegPitMan(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BegPitMan.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BegPitMan) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BlPitchI + if (allocated(OutData%BlPitchI)) deallocate(OutData%BlPitchI) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlPitchI(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchI.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlPitchI) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TPitManE + if (allocated(OutData%TPitManE)) deallocate(OutData%TPitManE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TPitManE(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TPitManE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TPitManE) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BegYawMan + call RegUnpack(Buf, OutData%BegYawMan) + if (RegCheckErr(Buf, RoutineName)) return + ! NacYawI + call RegUnpack(Buf, OutData%NacYawI) + if (RegCheckErr(Buf, RoutineName)) return + ! TYawManE + call RegUnpack(Buf, OutData%TYawManE) + if (RegCheckErr(Buf, RoutineName)) return + ! YawPosComInt + call RegUnpack(Buf, OutData%YawPosComInt) + if (RegCheckErr(Buf, RoutineName)) return + ! BegTpBr + if (allocated(OutData%BegTpBr)) deallocate(OutData%BegTpBr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BegTpBr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BegTpBr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BegTpBr) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TTpBrDp + if (allocated(OutData%TTpBrDp)) deallocate(OutData%TTpBrDp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TTpBrDp(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TTpBrDp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TTpBrDp) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TTpBrFl + if (allocated(OutData%TTpBrFl)) deallocate(OutData%TTpBrFl) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TTpBrFl(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TTpBrFl.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TTpBrFl) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Off4Good + call RegUnpack(Buf, OutData%Off4Good) + if (RegCheckErr(Buf, RoutineName)) return + ! GenOnLine + call RegUnpack(Buf, OutData%GenOnLine) + if (RegCheckErr(Buf, RoutineName)) return + ! BStC + if (allocated(OutData%BStC)) deallocate(OutData%BStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackOtherState(Buf, OutData%BStC(i1)) ! BStC + end do + end if + ! NStC + if (allocated(OutData%NStC)) deallocate(OutData%NStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackOtherState(Buf, OutData%NStC(i1)) ! NStC + end do + end if + ! TStC + if (allocated(OutData%TStC)) deallocate(OutData%TStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackOtherState(Buf, OutData%TStC(i1)) ! TStC + end do + end if + ! SStC + if (allocated(OutData%SStC)) deallocate(OutData%SStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackOtherState(Buf, OutData%SStC(i1)) ! SStC + end do + end if +end subroutine SUBROUTINE SrvD_CopyModuleMapType( SrcModuleMapTypeData, DstModuleMapTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(SrvD_ModuleMapType), INTENT(INOUT) :: SrcModuleMapTypeData TYPE(SrvD_ModuleMapType), INTENT(INOUT) :: DstModuleMapTypeData @@ -9167,1085 +5666,250 @@ SUBROUTINE SrvD_DestroyModuleMapType( ModuleMapTypeData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE SrvD_DestroyModuleMapType - SUBROUTINE SrvD_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SrvD_ModuleMapType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_PackModuleMapType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! u_BStC_Mot2_BStC allocated yes/no - IF ( ALLOCATED(InData%u_BStC_Mot2_BStC) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! u_BStC_Mot2_BStC upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i2 = LBOUND(InData%u_BStC_Mot2_BStC,2), UBOUND(InData%u_BStC_Mot2_BStC,2) - DO i1 = LBOUND(InData%u_BStC_Mot2_BStC,1), UBOUND(InData%u_BStC_Mot2_BStC,1) - Int_BufSz = Int_BufSz + 3 ! u_BStC_Mot2_BStC: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%u_BStC_Mot2_BStC(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! u_BStC_Mot2_BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_BStC_Mot2_BStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_BStC_Mot2_BStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_BStC_Mot2_BStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_NStC_Mot2_NStC allocated yes/no - IF ( ALLOCATED(InData%u_NStC_Mot2_NStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_NStC_Mot2_NStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_NStC_Mot2_NStC,1), UBOUND(InData%u_NStC_Mot2_NStC,1) - Int_BufSz = Int_BufSz + 3 ! u_NStC_Mot2_NStC: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%u_NStC_Mot2_NStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_NStC_Mot2_NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_NStC_Mot2_NStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_NStC_Mot2_NStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_NStC_Mot2_NStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_TStC_Mot2_TStC allocated yes/no - IF ( ALLOCATED(InData%u_TStC_Mot2_TStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_TStC_Mot2_TStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_TStC_Mot2_TStC,1), UBOUND(InData%u_TStC_Mot2_TStC,1) - Int_BufSz = Int_BufSz + 3 ! u_TStC_Mot2_TStC: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%u_TStC_Mot2_TStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_TStC_Mot2_TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_TStC_Mot2_TStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_TStC_Mot2_TStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_TStC_Mot2_TStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_SStC_Mot2_SStC allocated yes/no - IF ( ALLOCATED(InData%u_SStC_Mot2_SStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_SStC_Mot2_SStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_SStC_Mot2_SStC,1), UBOUND(InData%u_SStC_Mot2_SStC,1) - Int_BufSz = Int_BufSz + 3 ! u_SStC_Mot2_SStC: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%u_SStC_Mot2_SStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_SStC_Mot2_SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_SStC_Mot2_SStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_SStC_Mot2_SStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_SStC_Mot2_SStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! BStC_Frc2_y_BStC allocated yes/no - IF ( ALLOCATED(InData%BStC_Frc2_y_BStC) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BStC_Frc2_y_BStC upper/lower bounds for each dimension - DO i2 = LBOUND(InData%BStC_Frc2_y_BStC,2), UBOUND(InData%BStC_Frc2_y_BStC,2) - DO i1 = LBOUND(InData%BStC_Frc2_y_BStC,1), UBOUND(InData%BStC_Frc2_y_BStC,1) - Int_BufSz = Int_BufSz + 3 ! BStC_Frc2_y_BStC: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%BStC_Frc2_y_BStC(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! BStC_Frc2_y_BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BStC_Frc2_y_BStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BStC_Frc2_y_BStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BStC_Frc2_y_BStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NStC_Frc2_y_NStC allocated yes/no - IF ( ALLOCATED(InData%NStC_Frc2_y_NStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NStC_Frc2_y_NStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%NStC_Frc2_y_NStC,1), UBOUND(InData%NStC_Frc2_y_NStC,1) - Int_BufSz = Int_BufSz + 3 ! NStC_Frc2_y_NStC: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%NStC_Frc2_y_NStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! NStC_Frc2_y_NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NStC_Frc2_y_NStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NStC_Frc2_y_NStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NStC_Frc2_y_NStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! TStC_Frc2_y_TStC allocated yes/no - IF ( ALLOCATED(InData%TStC_Frc2_y_TStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TStC_Frc2_y_TStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%TStC_Frc2_y_TStC,1), UBOUND(InData%TStC_Frc2_y_TStC,1) - Int_BufSz = Int_BufSz + 3 ! TStC_Frc2_y_TStC: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%TStC_Frc2_y_TStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! TStC_Frc2_y_TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TStC_Frc2_y_TStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TStC_Frc2_y_TStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TStC_Frc2_y_TStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SStC_Frc2_y_SStC allocated yes/no - IF ( ALLOCATED(InData%SStC_Frc2_y_SStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SStC_Frc2_y_SStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%SStC_Frc2_y_SStC,1), UBOUND(InData%SStC_Frc2_y_SStC,1) - Int_BufSz = Int_BufSz + 3 ! SStC_Frc2_y_SStC: size of buffers for each call to pack subtype - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%SStC_Frc2_y_SStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! SStC_Frc2_y_SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SStC_Frc2_y_SStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SStC_Frc2_y_SStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SStC_Frc2_y_SStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%u_BStC_Mot2_BStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_BStC_Mot2_BStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_BStC_Mot2_BStC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_BStC_Mot2_BStC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_BStC_Mot2_BStC,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%u_BStC_Mot2_BStC,2), UBOUND(InData%u_BStC_Mot2_BStC,2) - DO i1 = LBOUND(InData%u_BStC_Mot2_BStC,1), UBOUND(InData%u_BStC_Mot2_BStC,1) - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%u_BStC_Mot2_BStC(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! u_BStC_Mot2_BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%u_NStC_Mot2_NStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_NStC_Mot2_NStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_NStC_Mot2_NStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_NStC_Mot2_NStC,1), UBOUND(InData%u_NStC_Mot2_NStC,1) - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%u_NStC_Mot2_NStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_NStC_Mot2_NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%u_TStC_Mot2_TStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_TStC_Mot2_TStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_TStC_Mot2_TStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_TStC_Mot2_TStC,1), UBOUND(InData%u_TStC_Mot2_TStC,1) - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%u_TStC_Mot2_TStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_TStC_Mot2_TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%u_SStC_Mot2_SStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_SStC_Mot2_SStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_SStC_Mot2_SStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_SStC_Mot2_SStC,1), UBOUND(InData%u_SStC_Mot2_SStC,1) - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%u_SStC_Mot2_SStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_SStC_Mot2_SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BStC_Frc2_y_BStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BStC_Frc2_y_BStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStC_Frc2_y_BStC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BStC_Frc2_y_BStC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStC_Frc2_y_BStC,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BStC_Frc2_y_BStC,2), UBOUND(InData%BStC_Frc2_y_BStC,2) - DO i1 = LBOUND(InData%BStC_Frc2_y_BStC,1), UBOUND(InData%BStC_Frc2_y_BStC,1) - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%BStC_Frc2_y_BStC(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! BStC_Frc2_y_BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NStC_Frc2_y_NStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NStC_Frc2_y_NStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NStC_Frc2_y_NStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NStC_Frc2_y_NStC,1), UBOUND(InData%NStC_Frc2_y_NStC,1) - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%NStC_Frc2_y_NStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! NStC_Frc2_y_NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TStC_Frc2_y_TStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TStC_Frc2_y_TStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TStC_Frc2_y_TStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TStC_Frc2_y_TStC,1), UBOUND(InData%TStC_Frc2_y_TStC,1) - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%TStC_Frc2_y_TStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! TStC_Frc2_y_TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SStC_Frc2_y_SStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SStC_Frc2_y_SStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SStC_Frc2_y_SStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SStC_Frc2_y_SStC,1), UBOUND(InData%SStC_Frc2_y_SStC,1) - CALL NWTC_Library_PackMeshMapType( Re_Buf, Db_Buf, Int_Buf, InData%SStC_Frc2_y_SStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! SStC_Frc2_y_SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - END SUBROUTINE SrvD_PackModuleMapType - - SUBROUTINE SrvD_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SrvD_ModuleMapType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_UnPackModuleMapType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_BStC_Mot2_BStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%u_BStC_Mot2_BStC)) DEALLOCATE(OutData%u_BStC_Mot2_BStC) - ALLOCATE(OutData%u_BStC_Mot2_BStC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BStC_Mot2_BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%u_BStC_Mot2_BStC,2), UBOUND(OutData%u_BStC_Mot2_BStC,2) - DO i1 = LBOUND(OutData%u_BStC_Mot2_BStC,1), UBOUND(OutData%u_BStC_Mot2_BStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%u_BStC_Mot2_BStC(i1,i2), ErrStat2, ErrMsg2 ) ! u_BStC_Mot2_BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_NStC_Mot2_NStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%u_NStC_Mot2_NStC)) DEALLOCATE(OutData%u_NStC_Mot2_NStC) - ALLOCATE(OutData%u_NStC_Mot2_NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_NStC_Mot2_NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_NStC_Mot2_NStC,1), UBOUND(OutData%u_NStC_Mot2_NStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%u_NStC_Mot2_NStC(i1), ErrStat2, ErrMsg2 ) ! u_NStC_Mot2_NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_TStC_Mot2_TStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%u_TStC_Mot2_TStC)) DEALLOCATE(OutData%u_TStC_Mot2_TStC) - ALLOCATE(OutData%u_TStC_Mot2_TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_TStC_Mot2_TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_TStC_Mot2_TStC,1), UBOUND(OutData%u_TStC_Mot2_TStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%u_TStC_Mot2_TStC(i1), ErrStat2, ErrMsg2 ) ! u_TStC_Mot2_TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_SStC_Mot2_SStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%u_SStC_Mot2_SStC)) DEALLOCATE(OutData%u_SStC_Mot2_SStC) - ALLOCATE(OutData%u_SStC_Mot2_SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SStC_Mot2_SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_SStC_Mot2_SStC,1), UBOUND(OutData%u_SStC_Mot2_SStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%u_SStC_Mot2_SStC(i1), ErrStat2, ErrMsg2 ) ! u_SStC_Mot2_SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BStC_Frc2_y_BStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BStC_Frc2_y_BStC)) DEALLOCATE(OutData%BStC_Frc2_y_BStC) - ALLOCATE(OutData%BStC_Frc2_y_BStC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC_Frc2_y_BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BStC_Frc2_y_BStC,2), UBOUND(OutData%BStC_Frc2_y_BStC,2) - DO i1 = LBOUND(OutData%BStC_Frc2_y_BStC,1), UBOUND(OutData%BStC_Frc2_y_BStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%BStC_Frc2_y_BStC(i1,i2), ErrStat2, ErrMsg2 ) ! BStC_Frc2_y_BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NStC_Frc2_y_NStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NStC_Frc2_y_NStC)) DEALLOCATE(OutData%NStC_Frc2_y_NStC) - ALLOCATE(OutData%NStC_Frc2_y_NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC_Frc2_y_NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NStC_Frc2_y_NStC,1), UBOUND(OutData%NStC_Frc2_y_NStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%NStC_Frc2_y_NStC(i1), ErrStat2, ErrMsg2 ) ! NStC_Frc2_y_NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TStC_Frc2_y_TStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TStC_Frc2_y_TStC)) DEALLOCATE(OutData%TStC_Frc2_y_TStC) - ALLOCATE(OutData%TStC_Frc2_y_TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC_Frc2_y_TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TStC_Frc2_y_TStC,1), UBOUND(OutData%TStC_Frc2_y_TStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%TStC_Frc2_y_TStC(i1), ErrStat2, ErrMsg2 ) ! TStC_Frc2_y_TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SStC_Frc2_y_SStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SStC_Frc2_y_SStC)) DEALLOCATE(OutData%SStC_Frc2_y_SStC) - ALLOCATE(OutData%SStC_Frc2_y_SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC_Frc2_y_SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SStC_Frc2_y_SStC,1), UBOUND(OutData%SStC_Frc2_y_SStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackMeshMapType( Re_Buf, Db_Buf, Int_Buf, OutData%SStC_Frc2_y_SStC(i1), ErrStat2, ErrMsg2 ) ! SStC_Frc2_y_SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - END SUBROUTINE SrvD_UnPackModuleMapType +subroutine SrvD_PackModuleMapType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_ModuleMapType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackModuleMapType' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + ! u_BStC_Mot2_BStC + call RegPack(Buf, allocated(InData%u_BStC_Mot2_BStC)) + if (allocated(InData%u_BStC_Mot2_BStC)) then + call RegPackBounds(Buf, 2, lbound(InData%u_BStC_Mot2_BStC), ubound(InData%u_BStC_Mot2_BStC)) + LB(1:2) = lbound(InData%u_BStC_Mot2_BStC) + UB(1:2) = ubound(InData%u_BStC_Mot2_BStC) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%u_BStC_Mot2_BStC(i1,i2)) + end do + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! u_NStC_Mot2_NStC + call RegPack(Buf, allocated(InData%u_NStC_Mot2_NStC)) + if (allocated(InData%u_NStC_Mot2_NStC)) then + call RegPackBounds(Buf, 1, lbound(InData%u_NStC_Mot2_NStC), ubound(InData%u_NStC_Mot2_NStC)) + LB(1:1) = lbound(InData%u_NStC_Mot2_NStC) + UB(1:1) = ubound(InData%u_NStC_Mot2_NStC) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%u_NStC_Mot2_NStC(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! u_TStC_Mot2_TStC + call RegPack(Buf, allocated(InData%u_TStC_Mot2_TStC)) + if (allocated(InData%u_TStC_Mot2_TStC)) then + call RegPackBounds(Buf, 1, lbound(InData%u_TStC_Mot2_TStC), ubound(InData%u_TStC_Mot2_TStC)) + LB(1:1) = lbound(InData%u_TStC_Mot2_TStC) + UB(1:1) = ubound(InData%u_TStC_Mot2_TStC) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%u_TStC_Mot2_TStC(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! u_SStC_Mot2_SStC + call RegPack(Buf, allocated(InData%u_SStC_Mot2_SStC)) + if (allocated(InData%u_SStC_Mot2_SStC)) then + call RegPackBounds(Buf, 1, lbound(InData%u_SStC_Mot2_SStC), ubound(InData%u_SStC_Mot2_SStC)) + LB(1:1) = lbound(InData%u_SStC_Mot2_SStC) + UB(1:1) = ubound(InData%u_SStC_Mot2_SStC) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%u_SStC_Mot2_SStC(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BStC_Frc2_y_BStC + call RegPack(Buf, allocated(InData%BStC_Frc2_y_BStC)) + if (allocated(InData%BStC_Frc2_y_BStC)) then + call RegPackBounds(Buf, 2, lbound(InData%BStC_Frc2_y_BStC), ubound(InData%BStC_Frc2_y_BStC)) + LB(1:2) = lbound(InData%BStC_Frc2_y_BStC) + UB(1:2) = ubound(InData%BStC_Frc2_y_BStC) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%BStC_Frc2_y_BStC(i1,i2)) + end do + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NStC_Frc2_y_NStC + call RegPack(Buf, allocated(InData%NStC_Frc2_y_NStC)) + if (allocated(InData%NStC_Frc2_y_NStC)) then + call RegPackBounds(Buf, 1, lbound(InData%NStC_Frc2_y_NStC), ubound(InData%NStC_Frc2_y_NStC)) + LB(1:1) = lbound(InData%NStC_Frc2_y_NStC) + UB(1:1) = ubound(InData%NStC_Frc2_y_NStC) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%NStC_Frc2_y_NStC(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TStC_Frc2_y_TStC + call RegPack(Buf, allocated(InData%TStC_Frc2_y_TStC)) + if (allocated(InData%TStC_Frc2_y_TStC)) then + call RegPackBounds(Buf, 1, lbound(InData%TStC_Frc2_y_TStC), ubound(InData%TStC_Frc2_y_TStC)) + LB(1:1) = lbound(InData%TStC_Frc2_y_TStC) + UB(1:1) = ubound(InData%TStC_Frc2_y_TStC) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%TStC_Frc2_y_TStC(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SStC_Frc2_y_SStC + call RegPack(Buf, allocated(InData%SStC_Frc2_y_SStC)) + if (allocated(InData%SStC_Frc2_y_SStC)) then + call RegPackBounds(Buf, 1, lbound(InData%SStC_Frc2_y_SStC), ubound(InData%SStC_Frc2_y_SStC)) + LB(1:1) = lbound(InData%SStC_Frc2_y_SStC) + UB(1:1) = ubound(InData%SStC_Frc2_y_SStC) + do i1 = LB(1), UB(1) + call NWTC_Library_PackMeshMapType(Buf, InData%SStC_Frc2_y_SStC(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SrvD_UnPackModuleMapType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_ModuleMapType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SrvD_UnPackModuleMapType' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! u_BStC_Mot2_BStC + if (allocated(OutData%u_BStC_Mot2_BStC)) deallocate(OutData%u_BStC_Mot2_BStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_BStC_Mot2_BStC(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BStC_Mot2_BStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%u_BStC_Mot2_BStC(i1,i2)) ! u_BStC_Mot2_BStC + end do + end do + end if + ! u_NStC_Mot2_NStC + if (allocated(OutData%u_NStC_Mot2_NStC)) deallocate(OutData%u_NStC_Mot2_NStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_NStC_Mot2_NStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_NStC_Mot2_NStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%u_NStC_Mot2_NStC(i1)) ! u_NStC_Mot2_NStC + end do + end if + ! u_TStC_Mot2_TStC + if (allocated(OutData%u_TStC_Mot2_TStC)) deallocate(OutData%u_TStC_Mot2_TStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_TStC_Mot2_TStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_TStC_Mot2_TStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%u_TStC_Mot2_TStC(i1)) ! u_TStC_Mot2_TStC + end do + end if + ! u_SStC_Mot2_SStC + if (allocated(OutData%u_SStC_Mot2_SStC)) deallocate(OutData%u_SStC_Mot2_SStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_SStC_Mot2_SStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SStC_Mot2_SStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%u_SStC_Mot2_SStC(i1)) ! u_SStC_Mot2_SStC + end do + end if + ! BStC_Frc2_y_BStC + if (allocated(OutData%BStC_Frc2_y_BStC)) deallocate(OutData%BStC_Frc2_y_BStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BStC_Frc2_y_BStC(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC_Frc2_y_BStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%BStC_Frc2_y_BStC(i1,i2)) ! BStC_Frc2_y_BStC + end do + end do + end if + ! NStC_Frc2_y_NStC + if (allocated(OutData%NStC_Frc2_y_NStC)) deallocate(OutData%NStC_Frc2_y_NStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NStC_Frc2_y_NStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC_Frc2_y_NStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%NStC_Frc2_y_NStC(i1)) ! NStC_Frc2_y_NStC + end do + end if + ! TStC_Frc2_y_TStC + if (allocated(OutData%TStC_Frc2_y_TStC)) deallocate(OutData%TStC_Frc2_y_TStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TStC_Frc2_y_TStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC_Frc2_y_TStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%TStC_Frc2_y_TStC(i1)) ! TStC_Frc2_y_TStC + end do + end if + ! SStC_Frc2_y_SStC + if (allocated(OutData%SStC_Frc2_y_SStC)) deallocate(OutData%SStC_Frc2_y_SStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SStC_Frc2_y_SStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC_Frc2_y_SStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackMeshMapType(Buf, OutData%SStC_Frc2_y_SStC(i1)) ! SStC_Frc2_y_SStC + end do + end if +end subroutine SUBROUTINE SrvD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) TYPE(SrvD_MiscVarType), INTENT(INOUT) :: SrcMiscData TYPE(SrvD_MiscVarType), INTENT(INOUT) :: DstMiscData @@ -10575,1850 +6239,455 @@ SUBROUTINE SrvD_DestroyMisc( MiscData, ErrStat, ErrMsg ) ENDDO ENDDO DEALLOCATE(MiscData%u_SStC) -ENDIF -IF (ALLOCATED(MiscData%y_BStC)) THEN -DO i1 = LBOUND(MiscData%y_BStC,1), UBOUND(MiscData%y_BStC,1) - CALL StC_DestroyOutput( MiscData%y_BStC(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%y_BStC) -ENDIF -IF (ALLOCATED(MiscData%y_NStC)) THEN -DO i1 = LBOUND(MiscData%y_NStC,1), UBOUND(MiscData%y_NStC,1) - CALL StC_DestroyOutput( MiscData%y_NStC(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%y_NStC) -ENDIF -IF (ALLOCATED(MiscData%y_TStC)) THEN -DO i1 = LBOUND(MiscData%y_TStC,1), UBOUND(MiscData%y_TStC,1) - CALL StC_DestroyOutput( MiscData%y_TStC(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%y_TStC) -ENDIF -IF (ALLOCATED(MiscData%y_SStC)) THEN -DO i1 = LBOUND(MiscData%y_SStC,1), UBOUND(MiscData%y_SStC,1) - CALL StC_DestroyOutput( MiscData%y_SStC(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%y_SStC) -ENDIF - CALL SrvD_DestroyModuleMapType( MiscData%SrvD_MeshMap, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE SrvD_DestroyMisc - - SUBROUTINE SrvD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SrvD_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! LastTimeCalled - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! dll_data: size of buffers for each call to pack subtype - CALL SrvD_PackBladedDLLType( Re_Buf, Db_Buf, Int_Buf, InData%dll_data, ErrStat2, ErrMsg2, .TRUE. ) ! dll_data - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! dll_data - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! dll_data - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! dll_data - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! FirstWarn - Db_BufSz = Db_BufSz + 1 ! LastTimeFiltered - Int_BufSz = Int_BufSz + 1 ! xd_BlPitchFilter allocated yes/no - IF ( ALLOCATED(InData%xd_BlPitchFilter) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xd_BlPitchFilter upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%xd_BlPitchFilter) ! xd_BlPitchFilter - END IF - Int_BufSz = Int_BufSz + 1 ! BStC allocated yes/no - IF ( ALLOCATED(InData%BStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BStC,1), UBOUND(InData%BStC,1) - Int_BufSz = Int_BufSz + 3 ! BStC: size of buffers for each call to pack subtype - CALL StC_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%BStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NStC allocated yes/no - IF ( ALLOCATED(InData%NStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%NStC,1), UBOUND(InData%NStC,1) - Int_BufSz = Int_BufSz + 3 ! NStC: size of buffers for each call to pack subtype - CALL StC_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%NStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! TStC allocated yes/no - IF ( ALLOCATED(InData%TStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%TStC,1), UBOUND(InData%TStC,1) - Int_BufSz = Int_BufSz + 3 ! TStC: size of buffers for each call to pack subtype - CALL StC_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%TStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SStC allocated yes/no - IF ( ALLOCATED(InData%SStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%SStC,1), UBOUND(InData%SStC,1) - Int_BufSz = Int_BufSz + 3 ! SStC: size of buffers for each call to pack subtype - CALL StC_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%SStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_BStC allocated yes/no - IF ( ALLOCATED(InData%u_BStC) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! u_BStC upper/lower bounds for each dimension - DO i2 = LBOUND(InData%u_BStC,2), UBOUND(InData%u_BStC,2) - DO i1 = LBOUND(InData%u_BStC,1), UBOUND(InData%u_BStC,1) - Int_BufSz = Int_BufSz + 3 ! u_BStC: size of buffers for each call to pack subtype - CALL StC_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_BStC(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! u_BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_BStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_BStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_BStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_NStC allocated yes/no - IF ( ALLOCATED(InData%u_NStC) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! u_NStC upper/lower bounds for each dimension - DO i2 = LBOUND(InData%u_NStC,2), UBOUND(InData%u_NStC,2) - DO i1 = LBOUND(InData%u_NStC,1), UBOUND(InData%u_NStC,1) - Int_BufSz = Int_BufSz + 3 ! u_NStC: size of buffers for each call to pack subtype - CALL StC_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_NStC(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! u_NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_NStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_NStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_NStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_TStC allocated yes/no - IF ( ALLOCATED(InData%u_TStC) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! u_TStC upper/lower bounds for each dimension - DO i2 = LBOUND(InData%u_TStC,2), UBOUND(InData%u_TStC,2) - DO i1 = LBOUND(InData%u_TStC,1), UBOUND(InData%u_TStC,1) - Int_BufSz = Int_BufSz + 3 ! u_TStC: size of buffers for each call to pack subtype - CALL StC_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_TStC(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! u_TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_TStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_TStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_TStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u_SStC allocated yes/no - IF ( ALLOCATED(InData%u_SStC) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! u_SStC upper/lower bounds for each dimension - DO i2 = LBOUND(InData%u_SStC,2), UBOUND(InData%u_SStC,2) - DO i1 = LBOUND(InData%u_SStC,1), UBOUND(InData%u_SStC,1) - Int_BufSz = Int_BufSz + 3 ! u_SStC: size of buffers for each call to pack subtype - CALL StC_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_SStC(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! u_SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_SStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_SStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_SStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! y_BStC allocated yes/no - IF ( ALLOCATED(InData%y_BStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y_BStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%y_BStC,1), UBOUND(InData%y_BStC,1) - Int_BufSz = Int_BufSz + 3 ! y_BStC: size of buffers for each call to pack subtype - CALL StC_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_BStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! y_BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_BStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_BStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_BStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! y_NStC allocated yes/no - IF ( ALLOCATED(InData%y_NStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y_NStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%y_NStC,1), UBOUND(InData%y_NStC,1) - Int_BufSz = Int_BufSz + 3 ! y_NStC: size of buffers for each call to pack subtype - CALL StC_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_NStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! y_NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_NStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_NStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_NStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! y_TStC allocated yes/no - IF ( ALLOCATED(InData%y_TStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y_TStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%y_TStC,1), UBOUND(InData%y_TStC,1) - Int_BufSz = Int_BufSz + 3 ! y_TStC: size of buffers for each call to pack subtype - CALL StC_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_TStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! y_TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_TStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_TStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_TStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! y_SStC allocated yes/no - IF ( ALLOCATED(InData%y_SStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y_SStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%y_SStC,1), UBOUND(InData%y_SStC,1) - Int_BufSz = Int_BufSz + 3 ! y_SStC: size of buffers for each call to pack subtype - CALL StC_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_SStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! y_SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_SStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_SStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_SStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! SrvD_MeshMap: size of buffers for each call to pack subtype - CALL SrvD_PackModuleMapType( Re_Buf, Db_Buf, Int_Buf, InData%SrvD_MeshMap, ErrStat2, ErrMsg2, .TRUE. ) ! SrvD_MeshMap - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SrvD_MeshMap - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SrvD_MeshMap - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SrvD_MeshMap - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! PrevTstepNcall - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%LastTimeCalled - Db_Xferred = Db_Xferred + 1 - CALL SrvD_PackBladedDLLType( Re_Buf, Db_Buf, Int_Buf, InData%dll_data, ErrStat2, ErrMsg2, OnlySize ) ! dll_data - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstWarn, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%LastTimeFiltered - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%xd_BlPitchFilter) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_BlPitchFilter,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_BlPitchFilter,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xd_BlPitchFilter,1), UBOUND(InData%xd_BlPitchFilter,1) - ReKiBuf(Re_Xferred) = InData%xd_BlPitchFilter(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BStC,1), UBOUND(InData%BStC,1) - CALL StC_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%BStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NStC,1), UBOUND(InData%NStC,1) - CALL StC_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%NStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TStC,1), UBOUND(InData%TStC,1) - CALL StC_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%TStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SStC,1), UBOUND(InData%SStC,1) - CALL StC_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%SStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%u_BStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_BStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_BStC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_BStC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_BStC,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%u_BStC,2), UBOUND(InData%u_BStC,2) - DO i1 = LBOUND(InData%u_BStC,1), UBOUND(InData%u_BStC,1) - CALL StC_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_BStC(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! u_BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%u_NStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_NStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_NStC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_NStC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_NStC,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%u_NStC,2), UBOUND(InData%u_NStC,2) - DO i1 = LBOUND(InData%u_NStC,1), UBOUND(InData%u_NStC,1) - CALL StC_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_NStC(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! u_NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%u_TStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_TStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_TStC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_TStC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_TStC,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%u_TStC,2), UBOUND(InData%u_TStC,2) - DO i1 = LBOUND(InData%u_TStC,1), UBOUND(InData%u_TStC,1) - CALL StC_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_TStC(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! u_TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%u_SStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_SStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_SStC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_SStC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_SStC,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%u_SStC,2), UBOUND(InData%u_SStC,2) - DO i1 = LBOUND(InData%u_SStC,1), UBOUND(InData%u_SStC,1) - CALL StC_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_SStC(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! u_SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%y_BStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%y_BStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y_BStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y_BStC,1), UBOUND(InData%y_BStC,1) - CALL StC_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_BStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! y_BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%y_NStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%y_NStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y_NStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y_NStC,1), UBOUND(InData%y_NStC,1) - CALL StC_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_NStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! y_NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%y_TStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%y_TStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y_TStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y_TStC,1), UBOUND(InData%y_TStC,1) - CALL StC_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_TStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! y_TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%y_SStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%y_SStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y_SStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y_SStC,1), UBOUND(InData%y_SStC,1) - CALL StC_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_SStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! y_SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL SrvD_PackModuleMapType( Re_Buf, Db_Buf, Int_Buf, InData%SrvD_MeshMap, ErrStat2, ErrMsg2, OnlySize ) ! SrvD_MeshMap - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = InData%PrevTstepNcall - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SrvD_PackMisc - - SUBROUTINE SrvD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SrvD_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%LastTimeCalled = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SrvD_UnpackBladedDLLType( Re_Buf, Db_Buf, Int_Buf, OutData%dll_data, ErrStat2, ErrMsg2 ) ! dll_data - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%FirstWarn = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn) - Int_Xferred = Int_Xferred + 1 - OutData%LastTimeFiltered = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_BlPitchFilter not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%xd_BlPitchFilter)) DEALLOCATE(OutData%xd_BlPitchFilter) - ALLOCATE(OutData%xd_BlPitchFilter(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_BlPitchFilter.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%xd_BlPitchFilter,1), UBOUND(OutData%xd_BlPitchFilter,1) - OutData%xd_BlPitchFilter(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BStC)) DEALLOCATE(OutData%BStC) - ALLOCATE(OutData%BStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BStC,1), UBOUND(OutData%BStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%BStC(i1), ErrStat2, ErrMsg2 ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NStC)) DEALLOCATE(OutData%NStC) - ALLOCATE(OutData%NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NStC,1), UBOUND(OutData%NStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%NStC(i1), ErrStat2, ErrMsg2 ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TStC)) DEALLOCATE(OutData%TStC) - ALLOCATE(OutData%TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TStC,1), UBOUND(OutData%TStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%TStC(i1), ErrStat2, ErrMsg2 ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SStC)) DEALLOCATE(OutData%SStC) - ALLOCATE(OutData%SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SStC,1), UBOUND(OutData%SStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%SStC(i1), ErrStat2, ErrMsg2 ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_BStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%u_BStC)) DEALLOCATE(OutData%u_BStC) - ALLOCATE(OutData%u_BStC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%u_BStC,2), UBOUND(OutData%u_BStC,2) - DO i1 = LBOUND(OutData%u_BStC,1), UBOUND(OutData%u_BStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_BStC(i1,i2), ErrStat2, ErrMsg2 ) ! u_BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_NStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%u_NStC)) DEALLOCATE(OutData%u_NStC) - ALLOCATE(OutData%u_NStC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%u_NStC,2), UBOUND(OutData%u_NStC,2) - DO i1 = LBOUND(OutData%u_NStC,1), UBOUND(OutData%u_NStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_NStC(i1,i2), ErrStat2, ErrMsg2 ) ! u_NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_TStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%u_TStC)) DEALLOCATE(OutData%u_TStC) - ALLOCATE(OutData%u_TStC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%u_TStC,2), UBOUND(OutData%u_TStC,2) - DO i1 = LBOUND(OutData%u_TStC,1), UBOUND(OutData%u_TStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_TStC(i1,i2), ErrStat2, ErrMsg2 ) ! u_TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_SStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%u_SStC)) DEALLOCATE(OutData%u_SStC) - ALLOCATE(OutData%u_SStC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%u_SStC,2), UBOUND(OutData%u_SStC,2) - DO i1 = LBOUND(OutData%u_SStC,1), UBOUND(OutData%u_SStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_SStC(i1,i2), ErrStat2, ErrMsg2 ) ! u_SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y_BStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%y_BStC)) DEALLOCATE(OutData%y_BStC) - ALLOCATE(OutData%y_BStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y_BStC,1), UBOUND(OutData%y_BStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_BStC(i1), ErrStat2, ErrMsg2 ) ! y_BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y_NStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%y_NStC)) DEALLOCATE(OutData%y_NStC) - ALLOCATE(OutData%y_NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y_NStC,1), UBOUND(OutData%y_NStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_NStC(i1), ErrStat2, ErrMsg2 ) ! y_NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y_TStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%y_TStC)) DEALLOCATE(OutData%y_TStC) - ALLOCATE(OutData%y_TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y_TStC,1), UBOUND(OutData%y_TStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_TStC(i1), ErrStat2, ErrMsg2 ) ! y_TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y_SStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%y_SStC)) DEALLOCATE(OutData%y_SStC) - ALLOCATE(OutData%y_SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y_SStC,1), UBOUND(OutData%y_SStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_SStC(i1), ErrStat2, ErrMsg2 ) ! y_SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SrvD_UnpackModuleMapType( Re_Buf, Db_Buf, Int_Buf, OutData%SrvD_MeshMap, ErrStat2, ErrMsg2 ) ! SrvD_MeshMap - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN +ENDIF +IF (ALLOCATED(MiscData%y_BStC)) THEN +DO i1 = LBOUND(MiscData%y_BStC,1), UBOUND(MiscData%y_BStC,1) + CALL StC_DestroyOutput( MiscData%y_BStC(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(MiscData%y_BStC) +ENDIF +IF (ALLOCATED(MiscData%y_NStC)) THEN +DO i1 = LBOUND(MiscData%y_NStC,1), UBOUND(MiscData%y_NStC,1) + CALL StC_DestroyOutput( MiscData%y_NStC(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(MiscData%y_NStC) +ENDIF +IF (ALLOCATED(MiscData%y_TStC)) THEN +DO i1 = LBOUND(MiscData%y_TStC,1), UBOUND(MiscData%y_TStC,1) + CALL StC_DestroyOutput( MiscData%y_TStC(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(MiscData%y_TStC) +ENDIF +IF (ALLOCATED(MiscData%y_SStC)) THEN +DO i1 = LBOUND(MiscData%y_SStC,1), UBOUND(MiscData%y_SStC,1) + CALL StC_DestroyOutput( MiscData%y_SStC(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(MiscData%y_SStC) +ENDIF + CALL SrvD_DestroyModuleMapType( MiscData%SrvD_MeshMap, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END SUBROUTINE SrvD_DestroyMisc - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%PrevTstepNcall = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SrvD_UnPackMisc +subroutine SrvD_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackMisc' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + ! LastTimeCalled + call RegPack(Buf, InData%LastTimeCalled) + if (RegCheckErr(Buf, RoutineName)) return + ! dll_data + call SrvD_PackBladedDLLType(Buf, InData%dll_data) + if (RegCheckErr(Buf, RoutineName)) return + ! FirstWarn + call RegPack(Buf, InData%FirstWarn) + if (RegCheckErr(Buf, RoutineName)) return + ! LastTimeFiltered + call RegPack(Buf, InData%LastTimeFiltered) + if (RegCheckErr(Buf, RoutineName)) return + ! xd_BlPitchFilter + call RegPack(Buf, allocated(InData%xd_BlPitchFilter)) + if (allocated(InData%xd_BlPitchFilter)) then + call RegPackBounds(Buf, 1, lbound(InData%xd_BlPitchFilter), ubound(InData%xd_BlPitchFilter)) + call RegPack(Buf, InData%xd_BlPitchFilter) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BStC + call RegPack(Buf, allocated(InData%BStC)) + if (allocated(InData%BStC)) then + call RegPackBounds(Buf, 1, lbound(InData%BStC), ubound(InData%BStC)) + LB(1:1) = lbound(InData%BStC) + UB(1:1) = ubound(InData%BStC) + do i1 = LB(1), UB(1) + call StC_PackMisc(Buf, InData%BStC(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NStC + call RegPack(Buf, allocated(InData%NStC)) + if (allocated(InData%NStC)) then + call RegPackBounds(Buf, 1, lbound(InData%NStC), ubound(InData%NStC)) + LB(1:1) = lbound(InData%NStC) + UB(1:1) = ubound(InData%NStC) + do i1 = LB(1), UB(1) + call StC_PackMisc(Buf, InData%NStC(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TStC + call RegPack(Buf, allocated(InData%TStC)) + if (allocated(InData%TStC)) then + call RegPackBounds(Buf, 1, lbound(InData%TStC), ubound(InData%TStC)) + LB(1:1) = lbound(InData%TStC) + UB(1:1) = ubound(InData%TStC) + do i1 = LB(1), UB(1) + call StC_PackMisc(Buf, InData%TStC(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SStC + call RegPack(Buf, allocated(InData%SStC)) + if (allocated(InData%SStC)) then + call RegPackBounds(Buf, 1, lbound(InData%SStC), ubound(InData%SStC)) + LB(1:1) = lbound(InData%SStC) + UB(1:1) = ubound(InData%SStC) + do i1 = LB(1), UB(1) + call StC_PackMisc(Buf, InData%SStC(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! u_BStC + call RegPack(Buf, allocated(InData%u_BStC)) + if (allocated(InData%u_BStC)) then + call RegPackBounds(Buf, 2, lbound(InData%u_BStC), ubound(InData%u_BStC)) + LB(1:2) = lbound(InData%u_BStC) + UB(1:2) = ubound(InData%u_BStC) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_PackInput(Buf, InData%u_BStC(i1,i2)) + end do + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! u_NStC + call RegPack(Buf, allocated(InData%u_NStC)) + if (allocated(InData%u_NStC)) then + call RegPackBounds(Buf, 2, lbound(InData%u_NStC), ubound(InData%u_NStC)) + LB(1:2) = lbound(InData%u_NStC) + UB(1:2) = ubound(InData%u_NStC) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_PackInput(Buf, InData%u_NStC(i1,i2)) + end do + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! u_TStC + call RegPack(Buf, allocated(InData%u_TStC)) + if (allocated(InData%u_TStC)) then + call RegPackBounds(Buf, 2, lbound(InData%u_TStC), ubound(InData%u_TStC)) + LB(1:2) = lbound(InData%u_TStC) + UB(1:2) = ubound(InData%u_TStC) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_PackInput(Buf, InData%u_TStC(i1,i2)) + end do + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! u_SStC + call RegPack(Buf, allocated(InData%u_SStC)) + if (allocated(InData%u_SStC)) then + call RegPackBounds(Buf, 2, lbound(InData%u_SStC), ubound(InData%u_SStC)) + LB(1:2) = lbound(InData%u_SStC) + UB(1:2) = ubound(InData%u_SStC) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_PackInput(Buf, InData%u_SStC(i1,i2)) + end do + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! y_BStC + call RegPack(Buf, allocated(InData%y_BStC)) + if (allocated(InData%y_BStC)) then + call RegPackBounds(Buf, 1, lbound(InData%y_BStC), ubound(InData%y_BStC)) + LB(1:1) = lbound(InData%y_BStC) + UB(1:1) = ubound(InData%y_BStC) + do i1 = LB(1), UB(1) + call StC_PackOutput(Buf, InData%y_BStC(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! y_NStC + call RegPack(Buf, allocated(InData%y_NStC)) + if (allocated(InData%y_NStC)) then + call RegPackBounds(Buf, 1, lbound(InData%y_NStC), ubound(InData%y_NStC)) + LB(1:1) = lbound(InData%y_NStC) + UB(1:1) = ubound(InData%y_NStC) + do i1 = LB(1), UB(1) + call StC_PackOutput(Buf, InData%y_NStC(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! y_TStC + call RegPack(Buf, allocated(InData%y_TStC)) + if (allocated(InData%y_TStC)) then + call RegPackBounds(Buf, 1, lbound(InData%y_TStC), ubound(InData%y_TStC)) + LB(1:1) = lbound(InData%y_TStC) + UB(1:1) = ubound(InData%y_TStC) + do i1 = LB(1), UB(1) + call StC_PackOutput(Buf, InData%y_TStC(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! y_SStC + call RegPack(Buf, allocated(InData%y_SStC)) + if (allocated(InData%y_SStC)) then + call RegPackBounds(Buf, 1, lbound(InData%y_SStC), ubound(InData%y_SStC)) + LB(1:1) = lbound(InData%y_SStC) + UB(1:1) = ubound(InData%y_SStC) + do i1 = LB(1), UB(1) + call StC_PackOutput(Buf, InData%y_SStC(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SrvD_MeshMap + call SrvD_PackModuleMapType(Buf, InData%SrvD_MeshMap) + if (RegCheckErr(Buf, RoutineName)) return + ! PrevTstepNcall + call RegPack(Buf, InData%PrevTstepNcall) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SrvD_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SrvD_UnPackMisc' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! LastTimeCalled + call RegUnpack(Buf, OutData%LastTimeCalled) + if (RegCheckErr(Buf, RoutineName)) return + ! dll_data + call SrvD_UnpackBladedDLLType(Buf, OutData%dll_data) ! dll_data + ! FirstWarn + call RegUnpack(Buf, OutData%FirstWarn) + if (RegCheckErr(Buf, RoutineName)) return + ! LastTimeFiltered + call RegUnpack(Buf, OutData%LastTimeFiltered) + if (RegCheckErr(Buf, RoutineName)) return + ! xd_BlPitchFilter + if (allocated(OutData%xd_BlPitchFilter)) deallocate(OutData%xd_BlPitchFilter) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xd_BlPitchFilter(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_BlPitchFilter.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%xd_BlPitchFilter) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BStC + if (allocated(OutData%BStC)) deallocate(OutData%BStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackMisc(Buf, OutData%BStC(i1)) ! BStC + end do + end if + ! NStC + if (allocated(OutData%NStC)) deallocate(OutData%NStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackMisc(Buf, OutData%NStC(i1)) ! NStC + end do + end if + ! TStC + if (allocated(OutData%TStC)) deallocate(OutData%TStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackMisc(Buf, OutData%TStC(i1)) ! TStC + end do + end if + ! SStC + if (allocated(OutData%SStC)) deallocate(OutData%SStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackMisc(Buf, OutData%SStC(i1)) ! SStC + end do + end if + ! u_BStC + if (allocated(OutData%u_BStC)) deallocate(OutData%u_BStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_BStC(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_UnpackInput(Buf, OutData%u_BStC(i1,i2)) ! u_BStC + end do + end do + end if + ! u_NStC + if (allocated(OutData%u_NStC)) deallocate(OutData%u_NStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_NStC(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_NStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_UnpackInput(Buf, OutData%u_NStC(i1,i2)) ! u_NStC + end do + end do + end if + ! u_TStC + if (allocated(OutData%u_TStC)) deallocate(OutData%u_TStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_TStC(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_TStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_UnpackInput(Buf, OutData%u_TStC(i1,i2)) ! u_TStC + end do + end do + end if + ! u_SStC + if (allocated(OutData%u_SStC)) deallocate(OutData%u_SStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_SStC(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_UnpackInput(Buf, OutData%u_SStC(i1,i2)) ! u_SStC + end do + end do + end if + ! y_BStC + if (allocated(OutData%y_BStC)) deallocate(OutData%y_BStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%y_BStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_BStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackOutput(Buf, OutData%y_BStC(i1)) ! y_BStC + end do + end if + ! y_NStC + if (allocated(OutData%y_NStC)) deallocate(OutData%y_NStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%y_NStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_NStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackOutput(Buf, OutData%y_NStC(i1)) ! y_NStC + end do + end if + ! y_TStC + if (allocated(OutData%y_TStC)) deallocate(OutData%y_TStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%y_TStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_TStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackOutput(Buf, OutData%y_TStC(i1)) ! y_TStC + end do + end if + ! y_SStC + if (allocated(OutData%y_SStC)) deallocate(OutData%y_SStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%y_SStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_SStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackOutput(Buf, OutData%y_SStC(i1)) ! y_SStC + end do + end if + ! SrvD_MeshMap + call SrvD_UnpackModuleMapType(Buf, OutData%SrvD_MeshMap) ! SrvD_MeshMap + ! PrevTstepNcall + call RegUnpack(Buf, OutData%PrevTstepNcall) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE SrvD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(SrvD_ParameterType), INTENT(IN) :: SrcParamData TYPE(SrvD_ParameterType), INTENT(INOUT) :: DstParamData @@ -13003,2303 +7272,1247 @@ SUBROUTINE SrvD_DestroyParam( ParamData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(ParamData%Jac_Idx_SStC_u)) THEN DEALLOCATE(ParamData%Jac_Idx_SStC_u) -ENDIF -IF (ALLOCATED(ParamData%Jac_Idx_BStC_x)) THEN - DEALLOCATE(ParamData%Jac_Idx_BStC_x) -ENDIF -IF (ALLOCATED(ParamData%Jac_Idx_NStC_x)) THEN - DEALLOCATE(ParamData%Jac_Idx_NStC_x) -ENDIF -IF (ALLOCATED(ParamData%Jac_Idx_TStC_x)) THEN - DEALLOCATE(ParamData%Jac_Idx_TStC_x) -ENDIF -IF (ALLOCATED(ParamData%Jac_Idx_SStC_x)) THEN - DEALLOCATE(ParamData%Jac_Idx_SStC_x) -ENDIF -IF (ALLOCATED(ParamData%Jac_Idx_BStC_y)) THEN - DEALLOCATE(ParamData%Jac_Idx_BStC_y) -ENDIF -IF (ALLOCATED(ParamData%Jac_Idx_NStC_y)) THEN - DEALLOCATE(ParamData%Jac_Idx_NStC_y) -ENDIF -IF (ALLOCATED(ParamData%Jac_Idx_TStC_y)) THEN - DEALLOCATE(ParamData%Jac_Idx_TStC_y) -ENDIF -IF (ALLOCATED(ParamData%Jac_Idx_SStC_y)) THEN - DEALLOCATE(ParamData%Jac_Idx_SStC_y) -ENDIF - END SUBROUTINE SrvD_DestroyParam - - SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SrvD_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! DT - Db_BufSz = Db_BufSz + 1 ! HSSBrDT - Re_BufSz = Re_BufSz + 1 ! HSSBrTqF - Re_BufSz = Re_BufSz + 1 ! SIG_POSl - Re_BufSz = Re_BufSz + 1 ! SIG_POTq - Re_BufSz = Re_BufSz + 1 ! SIG_SlPc - Re_BufSz = Re_BufSz + 1 ! SIG_Slop - Re_BufSz = Re_BufSz + 1 ! SIG_SySp - Re_BufSz = Re_BufSz + 1 ! TEC_A0 - Re_BufSz = Re_BufSz + 1 ! TEC_C0 - Re_BufSz = Re_BufSz + 1 ! TEC_C1 - Re_BufSz = Re_BufSz + 1 ! TEC_C2 - Re_BufSz = Re_BufSz + 1 ! TEC_K2 - Re_BufSz = Re_BufSz + 1 ! TEC_MR - Re_BufSz = Re_BufSz + 1 ! TEC_Re1 - Re_BufSz = Re_BufSz + 1 ! TEC_RLR - Re_BufSz = Re_BufSz + 1 ! TEC_RRes - Re_BufSz = Re_BufSz + 1 ! TEC_SRes - Re_BufSz = Re_BufSz + 1 ! TEC_SySp - Re_BufSz = Re_BufSz + 1 ! TEC_V1a - Re_BufSz = Re_BufSz + 1 ! TEC_VLL - Re_BufSz = Re_BufSz + 1 ! TEC_Xe1 - Re_BufSz = Re_BufSz + 1 ! GenEff - Int_BufSz = Int_BufSz + 1 ! BlPitchInit allocated yes/no - IF ( ALLOCATED(InData%BlPitchInit) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlPitchInit upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlPitchInit) ! BlPitchInit - END IF - Int_BufSz = Int_BufSz + 1 ! BlPitchF allocated yes/no - IF ( ALLOCATED(InData%BlPitchF) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlPitchF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlPitchF) ! BlPitchF - END IF - Int_BufSz = Int_BufSz + 1 ! PitManRat allocated yes/no - IF ( ALLOCATED(InData%PitManRat) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! PitManRat upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PitManRat) ! PitManRat - END IF - Re_BufSz = Re_BufSz + 1 ! YawManRat - Re_BufSz = Re_BufSz + 1 ! NacYawF - Re_BufSz = Re_BufSz + 1 ! SpdGenOn - Db_BufSz = Db_BufSz + 1 ! THSSBrDp - Db_BufSz = Db_BufSz + 1 ! THSSBrFl - Db_BufSz = Db_BufSz + 1 ! TimGenOf - Db_BufSz = Db_BufSz + 1 ! TimGenOn - Db_BufSz = Db_BufSz + 1 ! TPCOn - Int_BufSz = Int_BufSz + 1 ! TPitManS allocated yes/no - IF ( ALLOCATED(InData%TPitManS) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TPitManS upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%TPitManS) ! TPitManS - END IF - Db_BufSz = Db_BufSz + 1 ! TYawManS - Db_BufSz = Db_BufSz + 1 ! TYCOn - Re_BufSz = Re_BufSz + 1 ! VS_RtGnSp - Re_BufSz = Re_BufSz + 1 ! VS_RtTq - Re_BufSz = Re_BufSz + 1 ! VS_Slope - Re_BufSz = Re_BufSz + 1 ! VS_SlPc - Re_BufSz = Re_BufSz + 1 ! VS_SySp - Re_BufSz = Re_BufSz + 1 ! VS_TrGnSp - Re_BufSz = Re_BufSz + 1 ! YawPosCom - Re_BufSz = Re_BufSz + 1 ! YawRateCom - Int_BufSz = Int_BufSz + 1 ! GenModel - Int_BufSz = Int_BufSz + 1 ! HSSBrMode - Int_BufSz = Int_BufSz + 1 ! PCMode - Int_BufSz = Int_BufSz + 1 ! VSContrl - Int_BufSz = Int_BufSz + 1 ! YCMode - Int_BufSz = Int_BufSz + 1 ! GenTiStp - Int_BufSz = Int_BufSz + 1 ! GenTiStr - Re_BufSz = Re_BufSz + 1 ! VS_Rgn2K - Re_BufSz = Re_BufSz + 1 ! YawNeut - Re_BufSz = Re_BufSz + 1 ! YawSpr - Re_BufSz = Re_BufSz + 1 ! YawDamp - Db_BufSz = Db_BufSz + 1 ! TpBrDT - Int_BufSz = Int_BufSz + 1 ! TBDepISp allocated yes/no - IF ( ALLOCATED(InData%TBDepISp) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TBDepISp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TBDepISp) ! TBDepISp - END IF - Re_BufSz = Re_BufSz + 1 ! TBDrConN - Re_BufSz = Re_BufSz + 1 ! TBDrConD - Int_BufSz = Int_BufSz + 1 ! NumBl - Int_BufSz = Int_BufSz + 1 ! NumBStC - Int_BufSz = Int_BufSz + 1 ! NumNStC - Int_BufSz = Int_BufSz + 1 ! NumTStC - Int_BufSz = Int_BufSz + 1 ! NumSStC - Int_BufSz = Int_BufSz + 1 ! AfCmode - Re_BufSz = Re_BufSz + 1 ! AfC_Mean - Re_BufSz = Re_BufSz + 1 ! AfC_Amp - Re_BufSz = Re_BufSz + 1 ! AfC_Phase - Int_BufSz = Int_BufSz + 1 ! CCmode - Int_BufSz = Int_BufSz + 1 ! StCCmode - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! NumOuts_DLL - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1 ! OutParam allocated yes/no - IF ( ALLOCATED(InData%OutParam) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutParam upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - Int_BufSz = Int_BufSz + 3 ! OutParam: size of buffers for each call to pack subtype - CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutParam - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutParam - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutParam - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%Delim) ! Delim - Int_BufSz = Int_BufSz + 1 ! UseBladedInterface - Int_BufSz = Int_BufSz + 1 ! UseLegacyInterface - Int_BufSz = Int_BufSz + 3 ! DLL_Trgt: size of buffers for each call to pack subtype - CALL DLLTypePack( InData%DLL_Trgt, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! DLL_Trgt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DLL_Trgt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DLL_Trgt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DLL_Trgt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! DLL_Ramp - Re_BufSz = Re_BufSz + 1 ! BlAlpha - Int_BufSz = Int_BufSz + 1 ! DLL_n - Int_BufSz = Int_BufSz + 1 ! avcOUTNAME_LEN - Re_BufSz = Re_BufSz + 1 ! NacYaw_North - Re_BufSz = Re_BufSz + 1 ! AvgWindSpeed - Re_BufSz = Re_BufSz + 1 ! AirDens - Int_BufSz = Int_BufSz + 1 ! TrimCase - Re_BufSz = Re_BufSz + 1 ! TrimGain - Re_BufSz = Re_BufSz + 1 ! RotSpeedRef - Int_BufSz = Int_BufSz + 1 ! BStC allocated yes/no - IF ( ALLOCATED(InData%BStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BStC,1), UBOUND(InData%BStC,1) - Int_BufSz = Int_BufSz + 3 ! BStC: size of buffers for each call to pack subtype - CALL StC_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%BStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NStC allocated yes/no - IF ( ALLOCATED(InData%NStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%NStC,1), UBOUND(InData%NStC,1) - Int_BufSz = Int_BufSz + 3 ! NStC: size of buffers for each call to pack subtype - CALL StC_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%NStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! TStC allocated yes/no - IF ( ALLOCATED(InData%TStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%TStC,1), UBOUND(InData%TStC,1) - Int_BufSz = Int_BufSz + 3 ! TStC: size of buffers for each call to pack subtype - CALL StC_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%TStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SStC allocated yes/no - IF ( ALLOCATED(InData%SStC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SStC upper/lower bounds for each dimension - DO i1 = LBOUND(InData%SStC,1), UBOUND(InData%SStC,1) - Int_BufSz = Int_BufSz + 3 ! SStC: size of buffers for each call to pack subtype - CALL StC_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SStC(i1), ErrStat2, ErrMsg2, .TRUE. ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SStC - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SStC - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SStC - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InterpOrder - Int_BufSz = Int_BufSz + 1 ! EXavrSWAP - Int_BufSz = Int_BufSz + 1 ! NumCableControl - Int_BufSz = Int_BufSz + 1 ! NumStC_Control - Int_BufSz = Int_BufSz + 1 ! StCMeasNumPerChan allocated yes/no - IF ( ALLOCATED(InData%StCMeasNumPerChan) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! StCMeasNumPerChan upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%StCMeasNumPerChan) ! StCMeasNumPerChan - END IF - Int_BufSz = Int_BufSz + 1 ! UseSC - Int_BufSz = Int_BufSz + 1 ! Jac_u_indx allocated yes/no - IF ( ALLOCATED(InData%Jac_u_indx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_u_indx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_u_indx) ! Jac_u_indx - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_x_indx allocated yes/no - IF ( ALLOCATED(InData%Jac_x_indx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_x_indx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_x_indx) ! Jac_x_indx - END IF - Int_BufSz = Int_BufSz + 1 ! du allocated yes/no - IF ( ALLOCATED(InData%du) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! du upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%du) ! du - END IF - Int_BufSz = Int_BufSz + 1 ! dx allocated yes/no - IF ( ALLOCATED(InData%dx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dx upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dx) ! dx - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_nu - Int_BufSz = Int_BufSz + 1 ! Jac_ny - Int_BufSz = Int_BufSz + 1 ! Jac_nx - Int_BufSz = Int_BufSz + 1 ! Jac_Idx_BStC_u allocated yes/no - IF ( ALLOCATED(InData%Jac_Idx_BStC_u) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Jac_Idx_BStC_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_Idx_BStC_u) ! Jac_Idx_BStC_u - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_Idx_NStC_u allocated yes/no - IF ( ALLOCATED(InData%Jac_Idx_NStC_u) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_Idx_NStC_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_Idx_NStC_u) ! Jac_Idx_NStC_u - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_Idx_TStC_u allocated yes/no - IF ( ALLOCATED(InData%Jac_Idx_TStC_u) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_Idx_TStC_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_Idx_TStC_u) ! Jac_Idx_TStC_u - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_Idx_SStC_u allocated yes/no - IF ( ALLOCATED(InData%Jac_Idx_SStC_u) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_Idx_SStC_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_Idx_SStC_u) ! Jac_Idx_SStC_u - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_Idx_BStC_x allocated yes/no - IF ( ALLOCATED(InData%Jac_Idx_BStC_x) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Jac_Idx_BStC_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_Idx_BStC_x) ! Jac_Idx_BStC_x - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_Idx_NStC_x allocated yes/no - IF ( ALLOCATED(InData%Jac_Idx_NStC_x) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_Idx_NStC_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_Idx_NStC_x) ! Jac_Idx_NStC_x - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_Idx_TStC_x allocated yes/no - IF ( ALLOCATED(InData%Jac_Idx_TStC_x) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_Idx_TStC_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_Idx_TStC_x) ! Jac_Idx_TStC_x - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_Idx_SStC_x allocated yes/no - IF ( ALLOCATED(InData%Jac_Idx_SStC_x) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_Idx_SStC_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_Idx_SStC_x) ! Jac_Idx_SStC_x - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_Idx_BStC_y allocated yes/no - IF ( ALLOCATED(InData%Jac_Idx_BStC_y) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Jac_Idx_BStC_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_Idx_BStC_y) ! Jac_Idx_BStC_y - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_Idx_NStC_y allocated yes/no - IF ( ALLOCATED(InData%Jac_Idx_NStC_y) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_Idx_NStC_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_Idx_NStC_y) ! Jac_Idx_NStC_y - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_Idx_TStC_y allocated yes/no - IF ( ALLOCATED(InData%Jac_Idx_TStC_y) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_Idx_TStC_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_Idx_TStC_y) ! Jac_Idx_TStC_y - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_Idx_SStC_y allocated yes/no - IF ( ALLOCATED(InData%Jac_Idx_SStC_y) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_Idx_SStC_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_Idx_SStC_y) ! Jac_Idx_SStC_y - END IF - Int_BufSz = Int_BufSz + 1 ! SensorType - Int_BufSz = Int_BufSz + 1 ! NumBeam - Int_BufSz = Int_BufSz + 1 ! NumPulseGate - Re_BufSz = Re_BufSz + 1 ! PulseSpacing - Re_BufSz = Re_BufSz + 1 ! URefLid - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%HSSBrDT - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HSSBrTqF - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SIG_POSl - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SIG_POTq - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SIG_SlPc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SIG_Slop - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SIG_SySp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_A0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_C0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_C1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_C2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_K2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_MR - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_Re1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_RLR - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_RRes - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_SRes - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_SySp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_V1a - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_VLL - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TEC_Xe1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenEff - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BlPitchInit) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlPitchInit,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitchInit,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlPitchInit,1), UBOUND(InData%BlPitchInit,1) - ReKiBuf(Re_Xferred) = InData%BlPitchInit(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlPitchF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlPitchF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitchF,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlPitchF,1), UBOUND(InData%BlPitchF,1) - ReKiBuf(Re_Xferred) = InData%BlPitchF(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PitManRat) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PitManRat,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PitManRat,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%PitManRat,1), UBOUND(InData%PitManRat,1) - ReKiBuf(Re_Xferred) = InData%PitManRat(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%YawManRat - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NacYawF - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%SpdGenOn - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%THSSBrDp - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%THSSBrFl - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TimGenOf - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TimGenOn - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TPCOn - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TPitManS) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TPitManS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TPitManS,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TPitManS,1), UBOUND(InData%TPitManS,1) - DbKiBuf(Db_Xferred) = InData%TPitManS(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - DbKiBuf(Db_Xferred) = InData%TYawManS - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TYCOn - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VS_RtGnSp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VS_RtTq - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VS_Slope - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VS_SlPc - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VS_SySp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VS_TrGnSp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawPosCom - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawRateCom - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%GenModel - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%HSSBrMode - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%PCMode - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%VSContrl - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%YCMode - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%GenTiStp, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%GenTiStr, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%VS_Rgn2K - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawNeut - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawDamp - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%TpBrDT - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TBDepISp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TBDepISp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TBDepISp,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TBDepISp,1), UBOUND(InData%TBDepISp,1) - ReKiBuf(Re_Xferred) = InData%TBDepISp(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%TBDrConN - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TBDrConD - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBl - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBStC - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumNStC - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumTStC - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumSStC - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%AfCmode - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AfC_Mean - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AfC_Amp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AfC_Phase - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%CCmode - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%StCCmode - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts_DLL - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutParam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParam,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseBladedInterface, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseLegacyInterface, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - CALL DLLTypePack( InData%DLL_Trgt, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! DLL_Trgt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = TRANSFER(InData%DLL_Ramp, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%BlAlpha - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%DLL_n - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%avcOUTNAME_LEN - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NacYaw_North - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AvgWindSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%AirDens - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%TrimCase - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TrimGain - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RotSpeedRef - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BStC,1), UBOUND(InData%BStC,1) - CALL StC_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%BStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NStC,1), UBOUND(InData%NStC,1) - CALL StC_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%NStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TStC,1), UBOUND(InData%TStC,1) - CALL StC_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%TStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SStC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SStC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SStC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SStC,1), UBOUND(InData%SStC,1) - CALL StC_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%SStC(i1), ErrStat2, ErrMsg2, OnlySize ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IntKiBuf(Int_Xferred) = InData%InterpOrder - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%EXavrSWAP, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumCableControl - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumStC_Control - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%StCMeasNumPerChan) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StCMeasNumPerChan,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StCMeasNumPerChan,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%StCMeasNumPerChan,1), UBOUND(InData%StCMeasNumPerChan,1) - IntKiBuf(Int_Xferred) = InData%StCMeasNumPerChan(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseSC, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Jac_u_indx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_u_indx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_u_indx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jac_u_indx,2), UBOUND(InData%Jac_u_indx,2) - DO i1 = LBOUND(InData%Jac_u_indx,1), UBOUND(InData%Jac_u_indx,1) - IntKiBuf(Int_Xferred) = InData%Jac_u_indx(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jac_x_indx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_x_indx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_x_indx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_x_indx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_x_indx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jac_x_indx,2), UBOUND(InData%Jac_x_indx,2) - DO i1 = LBOUND(InData%Jac_x_indx,1), UBOUND(InData%Jac_x_indx,1) - IntKiBuf(Int_Xferred) = InData%Jac_x_indx(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%du) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%du,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%du,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%du,1), UBOUND(InData%du,1) - DbKiBuf(Db_Xferred) = InData%du(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dx,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dx,1), UBOUND(InData%dx,1) - ReKiBuf(Re_Xferred) = InData%dx(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%Jac_nu - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Jac_ny - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Jac_nx - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Jac_Idx_BStC_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_BStC_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_BStC_u,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_BStC_u,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_BStC_u,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_BStC_u,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_BStC_u,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Jac_Idx_BStC_u,3), UBOUND(InData%Jac_Idx_BStC_u,3) - DO i2 = LBOUND(InData%Jac_Idx_BStC_u,2), UBOUND(InData%Jac_Idx_BStC_u,2) - DO i1 = LBOUND(InData%Jac_Idx_BStC_u,1), UBOUND(InData%Jac_Idx_BStC_u,1) - IntKiBuf(Int_Xferred) = InData%Jac_Idx_BStC_u(i1,i2,i3) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jac_Idx_NStC_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_NStC_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_NStC_u,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_NStC_u,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_NStC_u,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jac_Idx_NStC_u,2), UBOUND(InData%Jac_Idx_NStC_u,2) - DO i1 = LBOUND(InData%Jac_Idx_NStC_u,1), UBOUND(InData%Jac_Idx_NStC_u,1) - IntKiBuf(Int_Xferred) = InData%Jac_Idx_NStC_u(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jac_Idx_TStC_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_TStC_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_TStC_u,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_TStC_u,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_TStC_u,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jac_Idx_TStC_u,2), UBOUND(InData%Jac_Idx_TStC_u,2) - DO i1 = LBOUND(InData%Jac_Idx_TStC_u,1), UBOUND(InData%Jac_Idx_TStC_u,1) - IntKiBuf(Int_Xferred) = InData%Jac_Idx_TStC_u(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jac_Idx_SStC_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_SStC_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_SStC_u,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_SStC_u,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_SStC_u,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jac_Idx_SStC_u,2), UBOUND(InData%Jac_Idx_SStC_u,2) - DO i1 = LBOUND(InData%Jac_Idx_SStC_u,1), UBOUND(InData%Jac_Idx_SStC_u,1) - IntKiBuf(Int_Xferred) = InData%Jac_Idx_SStC_u(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jac_Idx_BStC_x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_BStC_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_BStC_x,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_BStC_x,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_BStC_x,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_BStC_x,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_BStC_x,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Jac_Idx_BStC_x,3), UBOUND(InData%Jac_Idx_BStC_x,3) - DO i2 = LBOUND(InData%Jac_Idx_BStC_x,2), UBOUND(InData%Jac_Idx_BStC_x,2) - DO i1 = LBOUND(InData%Jac_Idx_BStC_x,1), UBOUND(InData%Jac_Idx_BStC_x,1) - IntKiBuf(Int_Xferred) = InData%Jac_Idx_BStC_x(i1,i2,i3) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jac_Idx_NStC_x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_NStC_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_NStC_x,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_NStC_x,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_NStC_x,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jac_Idx_NStC_x,2), UBOUND(InData%Jac_Idx_NStC_x,2) - DO i1 = LBOUND(InData%Jac_Idx_NStC_x,1), UBOUND(InData%Jac_Idx_NStC_x,1) - IntKiBuf(Int_Xferred) = InData%Jac_Idx_NStC_x(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jac_Idx_TStC_x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_TStC_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_TStC_x,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_TStC_x,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_TStC_x,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jac_Idx_TStC_x,2), UBOUND(InData%Jac_Idx_TStC_x,2) - DO i1 = LBOUND(InData%Jac_Idx_TStC_x,1), UBOUND(InData%Jac_Idx_TStC_x,1) - IntKiBuf(Int_Xferred) = InData%Jac_Idx_TStC_x(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jac_Idx_SStC_x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_SStC_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_SStC_x,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_SStC_x,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_SStC_x,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jac_Idx_SStC_x,2), UBOUND(InData%Jac_Idx_SStC_x,2) - DO i1 = LBOUND(InData%Jac_Idx_SStC_x,1), UBOUND(InData%Jac_Idx_SStC_x,1) - IntKiBuf(Int_Xferred) = InData%Jac_Idx_SStC_x(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jac_Idx_BStC_y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_BStC_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_BStC_y,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_BStC_y,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_BStC_y,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_BStC_y,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_BStC_y,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Jac_Idx_BStC_y,3), UBOUND(InData%Jac_Idx_BStC_y,3) - DO i2 = LBOUND(InData%Jac_Idx_BStC_y,2), UBOUND(InData%Jac_Idx_BStC_y,2) - DO i1 = LBOUND(InData%Jac_Idx_BStC_y,1), UBOUND(InData%Jac_Idx_BStC_y,1) - IntKiBuf(Int_Xferred) = InData%Jac_Idx_BStC_y(i1,i2,i3) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jac_Idx_NStC_y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_NStC_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_NStC_y,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_NStC_y,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_NStC_y,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jac_Idx_NStC_y,2), UBOUND(InData%Jac_Idx_NStC_y,2) - DO i1 = LBOUND(InData%Jac_Idx_NStC_y,1), UBOUND(InData%Jac_Idx_NStC_y,1) - IntKiBuf(Int_Xferred) = InData%Jac_Idx_NStC_y(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jac_Idx_TStC_y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_TStC_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_TStC_y,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_TStC_y,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_TStC_y,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jac_Idx_TStC_y,2), UBOUND(InData%Jac_Idx_TStC_y,2) - DO i1 = LBOUND(InData%Jac_Idx_TStC_y,1), UBOUND(InData%Jac_Idx_TStC_y,1) - IntKiBuf(Int_Xferred) = InData%Jac_Idx_TStC_y(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jac_Idx_SStC_y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_SStC_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_SStC_y,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_Idx_SStC_y,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_Idx_SStC_y,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jac_Idx_SStC_y,2), UBOUND(InData%Jac_Idx_SStC_y,2) - DO i1 = LBOUND(InData%Jac_Idx_SStC_y,1), UBOUND(InData%Jac_Idx_SStC_y,1) - IntKiBuf(Int_Xferred) = InData%Jac_Idx_SStC_y(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%SensorType - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBeam - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumPulseGate - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PulseSpacing - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%URefLid - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SrvD_PackParam - - SUBROUTINE SrvD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SrvD_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%HSSBrDT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%HSSBrTqF = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_POSl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_POTq = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_SlPc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_Slop = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_SySp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_A0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_C0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_C1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_C2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_K2 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_MR = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_Re1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_RLR = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_RRes = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_SRes = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_SySp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_V1a = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_VLL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_Xe1 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenEff = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitchInit not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlPitchInit)) DEALLOCATE(OutData%BlPitchInit) - ALLOCATE(OutData%BlPitchInit(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchInit.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlPitchInit,1), UBOUND(OutData%BlPitchInit,1) - OutData%BlPitchInit(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitchF not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlPitchF)) DEALLOCATE(OutData%BlPitchF) - ALLOCATE(OutData%BlPitchF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlPitchF,1), UBOUND(OutData%BlPitchF,1) - OutData%BlPitchF(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PitManRat not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PitManRat)) DEALLOCATE(OutData%PitManRat) - ALLOCATE(OutData%PitManRat(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PitManRat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%PitManRat,1), UBOUND(OutData%PitManRat,1) - OutData%PitManRat(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%YawManRat = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NacYawF = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%SpdGenOn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%THSSBrDp = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%THSSBrFl = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%TimGenOf = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%TimGenOn = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%TPCOn = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TPitManS not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TPitManS)) DEALLOCATE(OutData%TPitManS) - ALLOCATE(OutData%TPitManS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TPitManS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TPitManS,1), UBOUND(OutData%TPitManS,1) - OutData%TPitManS(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - OutData%TYawManS = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%TYCOn = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%VS_RtGnSp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VS_RtTq = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VS_Slope = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VS_SlPc = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VS_SySp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%VS_TrGnSp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawPosCom = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawRateCom = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenModel = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%HSSBrMode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%PCMode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%VSContrl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%YCMode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%GenTiStp = TRANSFER(IntKiBuf(Int_Xferred), OutData%GenTiStp) - Int_Xferred = Int_Xferred + 1 - OutData%GenTiStr = TRANSFER(IntKiBuf(Int_Xferred), OutData%GenTiStr) - Int_Xferred = Int_Xferred + 1 - OutData%VS_Rgn2K = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawNeut = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawSpr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawDamp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TpBrDT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TBDepISp not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TBDepISp)) DEALLOCATE(OutData%TBDepISp) - ALLOCATE(OutData%TBDepISp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TBDepISp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TBDepISp,1), UBOUND(OutData%TBDepISp,1) - OutData%TBDepISp(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%TBDrConN = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TBDrConD = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NumBl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumBStC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumNStC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumTStC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumSStC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%AfCmode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%AfC_Mean = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AfC_Amp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AfC_Phase = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CCmode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%StCCmode = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts_DLL = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutParam)) DEALLOCATE(OutData%OutParam) - ALLOCATE(OutData%OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutParam,1), UBOUND(OutData%OutParam,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackOutParmType( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UseBladedInterface = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseBladedInterface) - Int_Xferred = Int_Xferred + 1 - OutData%UseLegacyInterface = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseLegacyInterface) - Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL DLLTypeUnpack( OutData%DLL_Trgt, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! DLL_Trgt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%DLL_Ramp = TRANSFER(IntKiBuf(Int_Xferred), OutData%DLL_Ramp) - Int_Xferred = Int_Xferred + 1 - OutData%BlAlpha = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DLL_n = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%avcOUTNAME_LEN = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NacYaw_North = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AvgWindSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%AirDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TrimCase = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%TrimGain = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RotSpeedRef = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BStC)) DEALLOCATE(OutData%BStC) - ALLOCATE(OutData%BStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BStC,1), UBOUND(OutData%BStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%BStC(i1), ErrStat2, ErrMsg2 ) ! BStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NStC)) DEALLOCATE(OutData%NStC) - ALLOCATE(OutData%NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NStC,1), UBOUND(OutData%NStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%NStC(i1), ErrStat2, ErrMsg2 ) ! NStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TStC)) DEALLOCATE(OutData%TStC) - ALLOCATE(OutData%TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TStC,1), UBOUND(OutData%TStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%TStC(i1), ErrStat2, ErrMsg2 ) ! TStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SStC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SStC)) DEALLOCATE(OutData%SStC) - ALLOCATE(OutData%SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SStC,1), UBOUND(OutData%SStC,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL StC_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%SStC(i1), ErrStat2, ErrMsg2 ) ! SStC - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - OutData%InterpOrder = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%EXavrSWAP = TRANSFER(IntKiBuf(Int_Xferred), OutData%EXavrSWAP) - Int_Xferred = Int_Xferred + 1 - OutData%NumCableControl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumStC_Control = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StCMeasNumPerChan not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%StCMeasNumPerChan)) DEALLOCATE(OutData%StCMeasNumPerChan) - ALLOCATE(OutData%StCMeasNumPerChan(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StCMeasNumPerChan.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%StCMeasNumPerChan,1), UBOUND(OutData%StCMeasNumPerChan,1) - OutData%StCMeasNumPerChan(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%UseSC = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseSC) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_u_indx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Jac_u_indx)) DEALLOCATE(OutData%Jac_u_indx) - ALLOCATE(OutData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_u_indx,2), UBOUND(OutData%Jac_u_indx,2) - DO i1 = LBOUND(OutData%Jac_u_indx,1), UBOUND(OutData%Jac_u_indx,1) - OutData%Jac_u_indx(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_x_indx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Jac_x_indx)) DEALLOCATE(OutData%Jac_x_indx) - ALLOCATE(OutData%Jac_x_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_x_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_x_indx,2), UBOUND(OutData%Jac_x_indx,2) - DO i1 = LBOUND(OutData%Jac_x_indx,1), UBOUND(OutData%Jac_x_indx,1) - OutData%Jac_x_indx(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! du not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%du)) DEALLOCATE(OutData%du) - ALLOCATE(OutData%du(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%du,1), UBOUND(OutData%du,1) - OutData%du(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%dx)) DEALLOCATE(OutData%dx) - ALLOCATE(OutData%dx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dx,1), UBOUND(OutData%dx,1) - OutData%dx(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Jac_nu = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Jac_ny = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Jac_nx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_Idx_BStC_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Jac_Idx_BStC_u)) DEALLOCATE(OutData%Jac_Idx_BStC_u) - ALLOCATE(OutData%Jac_Idx_BStC_u(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_BStC_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Jac_Idx_BStC_u,3), UBOUND(OutData%Jac_Idx_BStC_u,3) - DO i2 = LBOUND(OutData%Jac_Idx_BStC_u,2), UBOUND(OutData%Jac_Idx_BStC_u,2) - DO i1 = LBOUND(OutData%Jac_Idx_BStC_u,1), UBOUND(OutData%Jac_Idx_BStC_u,1) - OutData%Jac_Idx_BStC_u(i1,i2,i3) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_Idx_NStC_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Jac_Idx_NStC_u)) DEALLOCATE(OutData%Jac_Idx_NStC_u) - ALLOCATE(OutData%Jac_Idx_NStC_u(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_NStC_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_Idx_NStC_u,2), UBOUND(OutData%Jac_Idx_NStC_u,2) - DO i1 = LBOUND(OutData%Jac_Idx_NStC_u,1), UBOUND(OutData%Jac_Idx_NStC_u,1) - OutData%Jac_Idx_NStC_u(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_Idx_TStC_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Jac_Idx_TStC_u)) DEALLOCATE(OutData%Jac_Idx_TStC_u) - ALLOCATE(OutData%Jac_Idx_TStC_u(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_TStC_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_Idx_TStC_u,2), UBOUND(OutData%Jac_Idx_TStC_u,2) - DO i1 = LBOUND(OutData%Jac_Idx_TStC_u,1), UBOUND(OutData%Jac_Idx_TStC_u,1) - OutData%Jac_Idx_TStC_u(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_Idx_SStC_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Jac_Idx_SStC_u)) DEALLOCATE(OutData%Jac_Idx_SStC_u) - ALLOCATE(OutData%Jac_Idx_SStC_u(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_SStC_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_Idx_SStC_u,2), UBOUND(OutData%Jac_Idx_SStC_u,2) - DO i1 = LBOUND(OutData%Jac_Idx_SStC_u,1), UBOUND(OutData%Jac_Idx_SStC_u,1) - OutData%Jac_Idx_SStC_u(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_Idx_BStC_x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Jac_Idx_BStC_x)) DEALLOCATE(OutData%Jac_Idx_BStC_x) - ALLOCATE(OutData%Jac_Idx_BStC_x(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_BStC_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Jac_Idx_BStC_x,3), UBOUND(OutData%Jac_Idx_BStC_x,3) - DO i2 = LBOUND(OutData%Jac_Idx_BStC_x,2), UBOUND(OutData%Jac_Idx_BStC_x,2) - DO i1 = LBOUND(OutData%Jac_Idx_BStC_x,1), UBOUND(OutData%Jac_Idx_BStC_x,1) - OutData%Jac_Idx_BStC_x(i1,i2,i3) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_Idx_NStC_x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Jac_Idx_NStC_x)) DEALLOCATE(OutData%Jac_Idx_NStC_x) - ALLOCATE(OutData%Jac_Idx_NStC_x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_NStC_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_Idx_NStC_x,2), UBOUND(OutData%Jac_Idx_NStC_x,2) - DO i1 = LBOUND(OutData%Jac_Idx_NStC_x,1), UBOUND(OutData%Jac_Idx_NStC_x,1) - OutData%Jac_Idx_NStC_x(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_Idx_TStC_x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Jac_Idx_TStC_x)) DEALLOCATE(OutData%Jac_Idx_TStC_x) - ALLOCATE(OutData%Jac_Idx_TStC_x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_TStC_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_Idx_TStC_x,2), UBOUND(OutData%Jac_Idx_TStC_x,2) - DO i1 = LBOUND(OutData%Jac_Idx_TStC_x,1), UBOUND(OutData%Jac_Idx_TStC_x,1) - OutData%Jac_Idx_TStC_x(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_Idx_SStC_x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Jac_Idx_SStC_x)) DEALLOCATE(OutData%Jac_Idx_SStC_x) - ALLOCATE(OutData%Jac_Idx_SStC_x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_SStC_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_Idx_SStC_x,2), UBOUND(OutData%Jac_Idx_SStC_x,2) - DO i1 = LBOUND(OutData%Jac_Idx_SStC_x,1), UBOUND(OutData%Jac_Idx_SStC_x,1) - OutData%Jac_Idx_SStC_x(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_Idx_BStC_y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Jac_Idx_BStC_y)) DEALLOCATE(OutData%Jac_Idx_BStC_y) - ALLOCATE(OutData%Jac_Idx_BStC_y(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_BStC_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Jac_Idx_BStC_y,3), UBOUND(OutData%Jac_Idx_BStC_y,3) - DO i2 = LBOUND(OutData%Jac_Idx_BStC_y,2), UBOUND(OutData%Jac_Idx_BStC_y,2) - DO i1 = LBOUND(OutData%Jac_Idx_BStC_y,1), UBOUND(OutData%Jac_Idx_BStC_y,1) - OutData%Jac_Idx_BStC_y(i1,i2,i3) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_Idx_NStC_y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Jac_Idx_NStC_y)) DEALLOCATE(OutData%Jac_Idx_NStC_y) - ALLOCATE(OutData%Jac_Idx_NStC_y(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_NStC_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_Idx_NStC_y,2), UBOUND(OutData%Jac_Idx_NStC_y,2) - DO i1 = LBOUND(OutData%Jac_Idx_NStC_y,1), UBOUND(OutData%Jac_Idx_NStC_y,1) - OutData%Jac_Idx_NStC_y(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_Idx_TStC_y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Jac_Idx_TStC_y)) DEALLOCATE(OutData%Jac_Idx_TStC_y) - ALLOCATE(OutData%Jac_Idx_TStC_y(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_TStC_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_Idx_TStC_y,2), UBOUND(OutData%Jac_Idx_TStC_y,2) - DO i1 = LBOUND(OutData%Jac_Idx_TStC_y,1), UBOUND(OutData%Jac_Idx_TStC_y,1) - OutData%Jac_Idx_TStC_y(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_Idx_SStC_y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Jac_Idx_SStC_y)) DEALLOCATE(OutData%Jac_Idx_SStC_y) - ALLOCATE(OutData%Jac_Idx_SStC_y(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_SStC_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_Idx_SStC_y,2), UBOUND(OutData%Jac_Idx_SStC_y,2) - DO i1 = LBOUND(OutData%Jac_Idx_SStC_y,1), UBOUND(OutData%Jac_Idx_SStC_y,1) - OutData%Jac_Idx_SStC_y(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - OutData%SensorType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumBeam = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumPulseGate = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%PulseSpacing = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%URefLid = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SrvD_UnPackParam +ENDIF +IF (ALLOCATED(ParamData%Jac_Idx_BStC_x)) THEN + DEALLOCATE(ParamData%Jac_Idx_BStC_x) +ENDIF +IF (ALLOCATED(ParamData%Jac_Idx_NStC_x)) THEN + DEALLOCATE(ParamData%Jac_Idx_NStC_x) +ENDIF +IF (ALLOCATED(ParamData%Jac_Idx_TStC_x)) THEN + DEALLOCATE(ParamData%Jac_Idx_TStC_x) +ENDIF +IF (ALLOCATED(ParamData%Jac_Idx_SStC_x)) THEN + DEALLOCATE(ParamData%Jac_Idx_SStC_x) +ENDIF +IF (ALLOCATED(ParamData%Jac_Idx_BStC_y)) THEN + DEALLOCATE(ParamData%Jac_Idx_BStC_y) +ENDIF +IF (ALLOCATED(ParamData%Jac_Idx_NStC_y)) THEN + DEALLOCATE(ParamData%Jac_Idx_NStC_y) +ENDIF +IF (ALLOCATED(ParamData%Jac_Idx_TStC_y)) THEN + DEALLOCATE(ParamData%Jac_Idx_TStC_y) +ENDIF +IF (ALLOCATED(ParamData%Jac_Idx_SStC_y)) THEN + DEALLOCATE(ParamData%Jac_Idx_SStC_y) +ENDIF + END SUBROUTINE SrvD_DestroyParam + +subroutine SrvD_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackParam' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + if (Buf%ErrStat >= AbortErrLev) return + ! DT + call RegPack(Buf, InData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! HSSBrDT + call RegPack(Buf, InData%HSSBrDT) + if (RegCheckErr(Buf, RoutineName)) return + ! HSSBrTqF + call RegPack(Buf, InData%HSSBrTqF) + if (RegCheckErr(Buf, RoutineName)) return + ! SIG_POSl + call RegPack(Buf, InData%SIG_POSl) + if (RegCheckErr(Buf, RoutineName)) return + ! SIG_POTq + call RegPack(Buf, InData%SIG_POTq) + if (RegCheckErr(Buf, RoutineName)) return + ! SIG_SlPc + call RegPack(Buf, InData%SIG_SlPc) + if (RegCheckErr(Buf, RoutineName)) return + ! SIG_Slop + call RegPack(Buf, InData%SIG_Slop) + if (RegCheckErr(Buf, RoutineName)) return + ! SIG_SySp + call RegPack(Buf, InData%SIG_SySp) + if (RegCheckErr(Buf, RoutineName)) return + ! TEC_A0 + call RegPack(Buf, InData%TEC_A0) + if (RegCheckErr(Buf, RoutineName)) return + ! TEC_C0 + call RegPack(Buf, InData%TEC_C0) + if (RegCheckErr(Buf, RoutineName)) return + ! TEC_C1 + call RegPack(Buf, InData%TEC_C1) + if (RegCheckErr(Buf, RoutineName)) return + ! TEC_C2 + call RegPack(Buf, InData%TEC_C2) + if (RegCheckErr(Buf, RoutineName)) return + ! TEC_K2 + call RegPack(Buf, InData%TEC_K2) + if (RegCheckErr(Buf, RoutineName)) return + ! TEC_MR + call RegPack(Buf, InData%TEC_MR) + if (RegCheckErr(Buf, RoutineName)) return + ! TEC_Re1 + call RegPack(Buf, InData%TEC_Re1) + if (RegCheckErr(Buf, RoutineName)) return + ! TEC_RLR + call RegPack(Buf, InData%TEC_RLR) + if (RegCheckErr(Buf, RoutineName)) return + ! TEC_RRes + call RegPack(Buf, InData%TEC_RRes) + if (RegCheckErr(Buf, RoutineName)) return + ! TEC_SRes + call RegPack(Buf, InData%TEC_SRes) + if (RegCheckErr(Buf, RoutineName)) return + ! TEC_SySp + call RegPack(Buf, InData%TEC_SySp) + if (RegCheckErr(Buf, RoutineName)) return + ! TEC_V1a + call RegPack(Buf, InData%TEC_V1a) + if (RegCheckErr(Buf, RoutineName)) return + ! TEC_VLL + call RegPack(Buf, InData%TEC_VLL) + if (RegCheckErr(Buf, RoutineName)) return + ! TEC_Xe1 + call RegPack(Buf, InData%TEC_Xe1) + if (RegCheckErr(Buf, RoutineName)) return + ! GenEff + call RegPack(Buf, InData%GenEff) + if (RegCheckErr(Buf, RoutineName)) return + ! BlPitchInit + call RegPack(Buf, allocated(InData%BlPitchInit)) + if (allocated(InData%BlPitchInit)) then + call RegPackBounds(Buf, 1, lbound(InData%BlPitchInit), ubound(InData%BlPitchInit)) + call RegPack(Buf, InData%BlPitchInit) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BlPitchF + call RegPack(Buf, allocated(InData%BlPitchF)) + if (allocated(InData%BlPitchF)) then + call RegPackBounds(Buf, 1, lbound(InData%BlPitchF), ubound(InData%BlPitchF)) + call RegPack(Buf, InData%BlPitchF) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PitManRat + call RegPack(Buf, allocated(InData%PitManRat)) + if (allocated(InData%PitManRat)) then + call RegPackBounds(Buf, 1, lbound(InData%PitManRat), ubound(InData%PitManRat)) + call RegPack(Buf, InData%PitManRat) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! YawManRat + call RegPack(Buf, InData%YawManRat) + if (RegCheckErr(Buf, RoutineName)) return + ! NacYawF + call RegPack(Buf, InData%NacYawF) + if (RegCheckErr(Buf, RoutineName)) return + ! SpdGenOn + call RegPack(Buf, InData%SpdGenOn) + if (RegCheckErr(Buf, RoutineName)) return + ! THSSBrDp + call RegPack(Buf, InData%THSSBrDp) + if (RegCheckErr(Buf, RoutineName)) return + ! THSSBrFl + call RegPack(Buf, InData%THSSBrFl) + if (RegCheckErr(Buf, RoutineName)) return + ! TimGenOf + call RegPack(Buf, InData%TimGenOf) + if (RegCheckErr(Buf, RoutineName)) return + ! TimGenOn + call RegPack(Buf, InData%TimGenOn) + if (RegCheckErr(Buf, RoutineName)) return + ! TPCOn + call RegPack(Buf, InData%TPCOn) + if (RegCheckErr(Buf, RoutineName)) return + ! TPitManS + call RegPack(Buf, allocated(InData%TPitManS)) + if (allocated(InData%TPitManS)) then + call RegPackBounds(Buf, 1, lbound(InData%TPitManS), ubound(InData%TPitManS)) + call RegPack(Buf, InData%TPitManS) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TYawManS + call RegPack(Buf, InData%TYawManS) + if (RegCheckErr(Buf, RoutineName)) return + ! TYCOn + call RegPack(Buf, InData%TYCOn) + if (RegCheckErr(Buf, RoutineName)) return + ! VS_RtGnSp + call RegPack(Buf, InData%VS_RtGnSp) + if (RegCheckErr(Buf, RoutineName)) return + ! VS_RtTq + call RegPack(Buf, InData%VS_RtTq) + if (RegCheckErr(Buf, RoutineName)) return + ! VS_Slope + call RegPack(Buf, InData%VS_Slope) + if (RegCheckErr(Buf, RoutineName)) return + ! VS_SlPc + call RegPack(Buf, InData%VS_SlPc) + if (RegCheckErr(Buf, RoutineName)) return + ! VS_SySp + call RegPack(Buf, InData%VS_SySp) + if (RegCheckErr(Buf, RoutineName)) return + ! VS_TrGnSp + call RegPack(Buf, InData%VS_TrGnSp) + if (RegCheckErr(Buf, RoutineName)) return + ! YawPosCom + call RegPack(Buf, InData%YawPosCom) + if (RegCheckErr(Buf, RoutineName)) return + ! YawRateCom + call RegPack(Buf, InData%YawRateCom) + if (RegCheckErr(Buf, RoutineName)) return + ! GenModel + call RegPack(Buf, InData%GenModel) + if (RegCheckErr(Buf, RoutineName)) return + ! HSSBrMode + call RegPack(Buf, InData%HSSBrMode) + if (RegCheckErr(Buf, RoutineName)) return + ! PCMode + call RegPack(Buf, InData%PCMode) + if (RegCheckErr(Buf, RoutineName)) return + ! VSContrl + call RegPack(Buf, InData%VSContrl) + if (RegCheckErr(Buf, RoutineName)) return + ! YCMode + call RegPack(Buf, InData%YCMode) + if (RegCheckErr(Buf, RoutineName)) return + ! GenTiStp + call RegPack(Buf, InData%GenTiStp) + if (RegCheckErr(Buf, RoutineName)) return + ! GenTiStr + call RegPack(Buf, InData%GenTiStr) + if (RegCheckErr(Buf, RoutineName)) return + ! VS_Rgn2K + call RegPack(Buf, InData%VS_Rgn2K) + if (RegCheckErr(Buf, RoutineName)) return + ! YawNeut + call RegPack(Buf, InData%YawNeut) + if (RegCheckErr(Buf, RoutineName)) return + ! YawSpr + call RegPack(Buf, InData%YawSpr) + if (RegCheckErr(Buf, RoutineName)) return + ! YawDamp + call RegPack(Buf, InData%YawDamp) + if (RegCheckErr(Buf, RoutineName)) return + ! TpBrDT + call RegPack(Buf, InData%TpBrDT) + if (RegCheckErr(Buf, RoutineName)) return + ! TBDepISp + call RegPack(Buf, allocated(InData%TBDepISp)) + if (allocated(InData%TBDepISp)) then + call RegPackBounds(Buf, 1, lbound(InData%TBDepISp), ubound(InData%TBDepISp)) + call RegPack(Buf, InData%TBDepISp) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TBDrConN + call RegPack(Buf, InData%TBDrConN) + if (RegCheckErr(Buf, RoutineName)) return + ! TBDrConD + call RegPack(Buf, InData%TBDrConD) + if (RegCheckErr(Buf, RoutineName)) return + ! NumBl + call RegPack(Buf, InData%NumBl) + if (RegCheckErr(Buf, RoutineName)) return + ! NumBStC + call RegPack(Buf, InData%NumBStC) + if (RegCheckErr(Buf, RoutineName)) return + ! NumNStC + call RegPack(Buf, InData%NumNStC) + if (RegCheckErr(Buf, RoutineName)) return + ! NumTStC + call RegPack(Buf, InData%NumTStC) + if (RegCheckErr(Buf, RoutineName)) return + ! NumSStC + call RegPack(Buf, InData%NumSStC) + if (RegCheckErr(Buf, RoutineName)) return + ! AfCmode + call RegPack(Buf, InData%AfCmode) + if (RegCheckErr(Buf, RoutineName)) return + ! AfC_Mean + call RegPack(Buf, InData%AfC_Mean) + if (RegCheckErr(Buf, RoutineName)) return + ! AfC_Amp + call RegPack(Buf, InData%AfC_Amp) + if (RegCheckErr(Buf, RoutineName)) return + ! AfC_Phase + call RegPack(Buf, InData%AfC_Phase) + if (RegCheckErr(Buf, RoutineName)) return + ! CCmode + call RegPack(Buf, InData%CCmode) + if (RegCheckErr(Buf, RoutineName)) return + ! StCCmode + call RegPack(Buf, InData%StCCmode) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegPack(Buf, InData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts_DLL + call RegPack(Buf, InData%NumOuts_DLL) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegPack(Buf, InData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! OutParam + call RegPack(Buf, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Delim + call RegPack(Buf, InData%Delim) + if (RegCheckErr(Buf, RoutineName)) return + ! UseBladedInterface + call RegPack(Buf, InData%UseBladedInterface) + if (RegCheckErr(Buf, RoutineName)) return + ! UseLegacyInterface + call RegPack(Buf, InData%UseLegacyInterface) + if (RegCheckErr(Buf, RoutineName)) return + ! DLL_Trgt + call DLLTypePack(Buf, InData%DLL_Trgt) + if (RegCheckErr(Buf, RoutineName)) return + ! DLL_Ramp + call RegPack(Buf, InData%DLL_Ramp) + if (RegCheckErr(Buf, RoutineName)) return + ! BlAlpha + call RegPack(Buf, InData%BlAlpha) + if (RegCheckErr(Buf, RoutineName)) return + ! DLL_n + call RegPack(Buf, InData%DLL_n) + if (RegCheckErr(Buf, RoutineName)) return + ! avcOUTNAME_LEN + call RegPack(Buf, InData%avcOUTNAME_LEN) + if (RegCheckErr(Buf, RoutineName)) return + ! NacYaw_North + call RegPack(Buf, InData%NacYaw_North) + if (RegCheckErr(Buf, RoutineName)) return + ! AvgWindSpeed + call RegPack(Buf, InData%AvgWindSpeed) + if (RegCheckErr(Buf, RoutineName)) return + ! AirDens + call RegPack(Buf, InData%AirDens) + if (RegCheckErr(Buf, RoutineName)) return + ! TrimCase + call RegPack(Buf, InData%TrimCase) + if (RegCheckErr(Buf, RoutineName)) return + ! TrimGain + call RegPack(Buf, InData%TrimGain) + if (RegCheckErr(Buf, RoutineName)) return + ! RotSpeedRef + call RegPack(Buf, InData%RotSpeedRef) + if (RegCheckErr(Buf, RoutineName)) return + ! BStC + call RegPack(Buf, allocated(InData%BStC)) + if (allocated(InData%BStC)) then + call RegPackBounds(Buf, 1, lbound(InData%BStC), ubound(InData%BStC)) + LB(1:1) = lbound(InData%BStC) + UB(1:1) = ubound(InData%BStC) + do i1 = LB(1), UB(1) + call StC_PackParam(Buf, InData%BStC(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NStC + call RegPack(Buf, allocated(InData%NStC)) + if (allocated(InData%NStC)) then + call RegPackBounds(Buf, 1, lbound(InData%NStC), ubound(InData%NStC)) + LB(1:1) = lbound(InData%NStC) + UB(1:1) = ubound(InData%NStC) + do i1 = LB(1), UB(1) + call StC_PackParam(Buf, InData%NStC(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TStC + call RegPack(Buf, allocated(InData%TStC)) + if (allocated(InData%TStC)) then + call RegPackBounds(Buf, 1, lbound(InData%TStC), ubound(InData%TStC)) + LB(1:1) = lbound(InData%TStC) + UB(1:1) = ubound(InData%TStC) + do i1 = LB(1), UB(1) + call StC_PackParam(Buf, InData%TStC(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SStC + call RegPack(Buf, allocated(InData%SStC)) + if (allocated(InData%SStC)) then + call RegPackBounds(Buf, 1, lbound(InData%SStC), ubound(InData%SStC)) + LB(1:1) = lbound(InData%SStC) + UB(1:1) = ubound(InData%SStC) + do i1 = LB(1), UB(1) + call StC_PackParam(Buf, InData%SStC(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! InterpOrder + call RegPack(Buf, InData%InterpOrder) + if (RegCheckErr(Buf, RoutineName)) return + ! EXavrSWAP + call RegPack(Buf, InData%EXavrSWAP) + if (RegCheckErr(Buf, RoutineName)) return + ! NumCableControl + call RegPack(Buf, InData%NumCableControl) + if (RegCheckErr(Buf, RoutineName)) return + ! NumStC_Control + call RegPack(Buf, InData%NumStC_Control) + if (RegCheckErr(Buf, RoutineName)) return + ! StCMeasNumPerChan + call RegPack(Buf, allocated(InData%StCMeasNumPerChan)) + if (allocated(InData%StCMeasNumPerChan)) then + call RegPackBounds(Buf, 1, lbound(InData%StCMeasNumPerChan), ubound(InData%StCMeasNumPerChan)) + call RegPack(Buf, InData%StCMeasNumPerChan) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! UseSC + call RegPack(Buf, InData%UseSC) + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_u_indx + call RegPack(Buf, allocated(InData%Jac_u_indx)) + if (allocated(InData%Jac_u_indx)) then + call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx), ubound(InData%Jac_u_indx)) + call RegPack(Buf, InData%Jac_u_indx) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_x_indx + call RegPack(Buf, allocated(InData%Jac_x_indx)) + if (allocated(InData%Jac_x_indx)) then + call RegPackBounds(Buf, 2, lbound(InData%Jac_x_indx), ubound(InData%Jac_x_indx)) + call RegPack(Buf, InData%Jac_x_indx) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! du + call RegPack(Buf, allocated(InData%du)) + if (allocated(InData%du)) then + call RegPackBounds(Buf, 1, lbound(InData%du), ubound(InData%du)) + call RegPack(Buf, InData%du) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! dx + call RegPack(Buf, allocated(InData%dx)) + if (allocated(InData%dx)) then + call RegPackBounds(Buf, 1, lbound(InData%dx), ubound(InData%dx)) + call RegPack(Buf, InData%dx) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_nu + call RegPack(Buf, InData%Jac_nu) + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_ny + call RegPack(Buf, InData%Jac_ny) + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_nx + call RegPack(Buf, InData%Jac_nx) + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_Idx_BStC_u + call RegPack(Buf, allocated(InData%Jac_Idx_BStC_u)) + if (allocated(InData%Jac_Idx_BStC_u)) then + call RegPackBounds(Buf, 3, lbound(InData%Jac_Idx_BStC_u), ubound(InData%Jac_Idx_BStC_u)) + call RegPack(Buf, InData%Jac_Idx_BStC_u) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_Idx_NStC_u + call RegPack(Buf, allocated(InData%Jac_Idx_NStC_u)) + if (allocated(InData%Jac_Idx_NStC_u)) then + call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_NStC_u), ubound(InData%Jac_Idx_NStC_u)) + call RegPack(Buf, InData%Jac_Idx_NStC_u) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_Idx_TStC_u + call RegPack(Buf, allocated(InData%Jac_Idx_TStC_u)) + if (allocated(InData%Jac_Idx_TStC_u)) then + call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_TStC_u), ubound(InData%Jac_Idx_TStC_u)) + call RegPack(Buf, InData%Jac_Idx_TStC_u) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_Idx_SStC_u + call RegPack(Buf, allocated(InData%Jac_Idx_SStC_u)) + if (allocated(InData%Jac_Idx_SStC_u)) then + call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_SStC_u), ubound(InData%Jac_Idx_SStC_u)) + call RegPack(Buf, InData%Jac_Idx_SStC_u) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_Idx_BStC_x + call RegPack(Buf, allocated(InData%Jac_Idx_BStC_x)) + if (allocated(InData%Jac_Idx_BStC_x)) then + call RegPackBounds(Buf, 3, lbound(InData%Jac_Idx_BStC_x), ubound(InData%Jac_Idx_BStC_x)) + call RegPack(Buf, InData%Jac_Idx_BStC_x) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_Idx_NStC_x + call RegPack(Buf, allocated(InData%Jac_Idx_NStC_x)) + if (allocated(InData%Jac_Idx_NStC_x)) then + call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_NStC_x), ubound(InData%Jac_Idx_NStC_x)) + call RegPack(Buf, InData%Jac_Idx_NStC_x) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_Idx_TStC_x + call RegPack(Buf, allocated(InData%Jac_Idx_TStC_x)) + if (allocated(InData%Jac_Idx_TStC_x)) then + call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_TStC_x), ubound(InData%Jac_Idx_TStC_x)) + call RegPack(Buf, InData%Jac_Idx_TStC_x) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_Idx_SStC_x + call RegPack(Buf, allocated(InData%Jac_Idx_SStC_x)) + if (allocated(InData%Jac_Idx_SStC_x)) then + call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_SStC_x), ubound(InData%Jac_Idx_SStC_x)) + call RegPack(Buf, InData%Jac_Idx_SStC_x) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_Idx_BStC_y + call RegPack(Buf, allocated(InData%Jac_Idx_BStC_y)) + if (allocated(InData%Jac_Idx_BStC_y)) then + call RegPackBounds(Buf, 3, lbound(InData%Jac_Idx_BStC_y), ubound(InData%Jac_Idx_BStC_y)) + call RegPack(Buf, InData%Jac_Idx_BStC_y) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_Idx_NStC_y + call RegPack(Buf, allocated(InData%Jac_Idx_NStC_y)) + if (allocated(InData%Jac_Idx_NStC_y)) then + call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_NStC_y), ubound(InData%Jac_Idx_NStC_y)) + call RegPack(Buf, InData%Jac_Idx_NStC_y) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_Idx_TStC_y + call RegPack(Buf, allocated(InData%Jac_Idx_TStC_y)) + if (allocated(InData%Jac_Idx_TStC_y)) then + call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_TStC_y), ubound(InData%Jac_Idx_TStC_y)) + call RegPack(Buf, InData%Jac_Idx_TStC_y) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_Idx_SStC_y + call RegPack(Buf, allocated(InData%Jac_Idx_SStC_y)) + if (allocated(InData%Jac_Idx_SStC_y)) then + call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_SStC_y), ubound(InData%Jac_Idx_SStC_y)) + call RegPack(Buf, InData%Jac_Idx_SStC_y) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SensorType + call RegPack(Buf, InData%SensorType) + if (RegCheckErr(Buf, RoutineName)) return + ! NumBeam + call RegPack(Buf, InData%NumBeam) + if (RegCheckErr(Buf, RoutineName)) return + ! NumPulseGate + call RegPack(Buf, InData%NumPulseGate) + if (RegCheckErr(Buf, RoutineName)) return + ! PulseSpacing + call RegPack(Buf, InData%PulseSpacing) + if (RegCheckErr(Buf, RoutineName)) return + ! URefLid + call RegPack(Buf, InData%URefLid) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SrvD_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SrvD_UnPackParam' + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! DT + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! HSSBrDT + call RegUnpack(Buf, OutData%HSSBrDT) + if (RegCheckErr(Buf, RoutineName)) return + ! HSSBrTqF + call RegUnpack(Buf, OutData%HSSBrTqF) + if (RegCheckErr(Buf, RoutineName)) return + ! SIG_POSl + call RegUnpack(Buf, OutData%SIG_POSl) + if (RegCheckErr(Buf, RoutineName)) return + ! SIG_POTq + call RegUnpack(Buf, OutData%SIG_POTq) + if (RegCheckErr(Buf, RoutineName)) return + ! SIG_SlPc + call RegUnpack(Buf, OutData%SIG_SlPc) + if (RegCheckErr(Buf, RoutineName)) return + ! SIG_Slop + call RegUnpack(Buf, OutData%SIG_Slop) + if (RegCheckErr(Buf, RoutineName)) return + ! SIG_SySp + call RegUnpack(Buf, OutData%SIG_SySp) + if (RegCheckErr(Buf, RoutineName)) return + ! TEC_A0 + call RegUnpack(Buf, OutData%TEC_A0) + if (RegCheckErr(Buf, RoutineName)) return + ! TEC_C0 + call RegUnpack(Buf, OutData%TEC_C0) + if (RegCheckErr(Buf, RoutineName)) return + ! TEC_C1 + call RegUnpack(Buf, OutData%TEC_C1) + if (RegCheckErr(Buf, RoutineName)) return + ! TEC_C2 + call RegUnpack(Buf, OutData%TEC_C2) + if (RegCheckErr(Buf, RoutineName)) return + ! TEC_K2 + call RegUnpack(Buf, OutData%TEC_K2) + if (RegCheckErr(Buf, RoutineName)) return + ! TEC_MR + call RegUnpack(Buf, OutData%TEC_MR) + if (RegCheckErr(Buf, RoutineName)) return + ! TEC_Re1 + call RegUnpack(Buf, OutData%TEC_Re1) + if (RegCheckErr(Buf, RoutineName)) return + ! TEC_RLR + call RegUnpack(Buf, OutData%TEC_RLR) + if (RegCheckErr(Buf, RoutineName)) return + ! TEC_RRes + call RegUnpack(Buf, OutData%TEC_RRes) + if (RegCheckErr(Buf, RoutineName)) return + ! TEC_SRes + call RegUnpack(Buf, OutData%TEC_SRes) + if (RegCheckErr(Buf, RoutineName)) return + ! TEC_SySp + call RegUnpack(Buf, OutData%TEC_SySp) + if (RegCheckErr(Buf, RoutineName)) return + ! TEC_V1a + call RegUnpack(Buf, OutData%TEC_V1a) + if (RegCheckErr(Buf, RoutineName)) return + ! TEC_VLL + call RegUnpack(Buf, OutData%TEC_VLL) + if (RegCheckErr(Buf, RoutineName)) return + ! TEC_Xe1 + call RegUnpack(Buf, OutData%TEC_Xe1) + if (RegCheckErr(Buf, RoutineName)) return + ! GenEff + call RegUnpack(Buf, OutData%GenEff) + if (RegCheckErr(Buf, RoutineName)) return + ! BlPitchInit + if (allocated(OutData%BlPitchInit)) deallocate(OutData%BlPitchInit) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlPitchInit(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchInit.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlPitchInit) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BlPitchF + if (allocated(OutData%BlPitchF)) deallocate(OutData%BlPitchF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlPitchF(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlPitchF) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PitManRat + if (allocated(OutData%PitManRat)) deallocate(OutData%PitManRat) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PitManRat(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PitManRat.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PitManRat) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! YawManRat + call RegUnpack(Buf, OutData%YawManRat) + if (RegCheckErr(Buf, RoutineName)) return + ! NacYawF + call RegUnpack(Buf, OutData%NacYawF) + if (RegCheckErr(Buf, RoutineName)) return + ! SpdGenOn + call RegUnpack(Buf, OutData%SpdGenOn) + if (RegCheckErr(Buf, RoutineName)) return + ! THSSBrDp + call RegUnpack(Buf, OutData%THSSBrDp) + if (RegCheckErr(Buf, RoutineName)) return + ! THSSBrFl + call RegUnpack(Buf, OutData%THSSBrFl) + if (RegCheckErr(Buf, RoutineName)) return + ! TimGenOf + call RegUnpack(Buf, OutData%TimGenOf) + if (RegCheckErr(Buf, RoutineName)) return + ! TimGenOn + call RegUnpack(Buf, OutData%TimGenOn) + if (RegCheckErr(Buf, RoutineName)) return + ! TPCOn + call RegUnpack(Buf, OutData%TPCOn) + if (RegCheckErr(Buf, RoutineName)) return + ! TPitManS + if (allocated(OutData%TPitManS)) deallocate(OutData%TPitManS) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TPitManS(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TPitManS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TPitManS) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TYawManS + call RegUnpack(Buf, OutData%TYawManS) + if (RegCheckErr(Buf, RoutineName)) return + ! TYCOn + call RegUnpack(Buf, OutData%TYCOn) + if (RegCheckErr(Buf, RoutineName)) return + ! VS_RtGnSp + call RegUnpack(Buf, OutData%VS_RtGnSp) + if (RegCheckErr(Buf, RoutineName)) return + ! VS_RtTq + call RegUnpack(Buf, OutData%VS_RtTq) + if (RegCheckErr(Buf, RoutineName)) return + ! VS_Slope + call RegUnpack(Buf, OutData%VS_Slope) + if (RegCheckErr(Buf, RoutineName)) return + ! VS_SlPc + call RegUnpack(Buf, OutData%VS_SlPc) + if (RegCheckErr(Buf, RoutineName)) return + ! VS_SySp + call RegUnpack(Buf, OutData%VS_SySp) + if (RegCheckErr(Buf, RoutineName)) return + ! VS_TrGnSp + call RegUnpack(Buf, OutData%VS_TrGnSp) + if (RegCheckErr(Buf, RoutineName)) return + ! YawPosCom + call RegUnpack(Buf, OutData%YawPosCom) + if (RegCheckErr(Buf, RoutineName)) return + ! YawRateCom + call RegUnpack(Buf, OutData%YawRateCom) + if (RegCheckErr(Buf, RoutineName)) return + ! GenModel + call RegUnpack(Buf, OutData%GenModel) + if (RegCheckErr(Buf, RoutineName)) return + ! HSSBrMode + call RegUnpack(Buf, OutData%HSSBrMode) + if (RegCheckErr(Buf, RoutineName)) return + ! PCMode + call RegUnpack(Buf, OutData%PCMode) + if (RegCheckErr(Buf, RoutineName)) return + ! VSContrl + call RegUnpack(Buf, OutData%VSContrl) + if (RegCheckErr(Buf, RoutineName)) return + ! YCMode + call RegUnpack(Buf, OutData%YCMode) + if (RegCheckErr(Buf, RoutineName)) return + ! GenTiStp + call RegUnpack(Buf, OutData%GenTiStp) + if (RegCheckErr(Buf, RoutineName)) return + ! GenTiStr + call RegUnpack(Buf, OutData%GenTiStr) + if (RegCheckErr(Buf, RoutineName)) return + ! VS_Rgn2K + call RegUnpack(Buf, OutData%VS_Rgn2K) + if (RegCheckErr(Buf, RoutineName)) return + ! YawNeut + call RegUnpack(Buf, OutData%YawNeut) + if (RegCheckErr(Buf, RoutineName)) return + ! YawSpr + call RegUnpack(Buf, OutData%YawSpr) + if (RegCheckErr(Buf, RoutineName)) return + ! YawDamp + call RegUnpack(Buf, OutData%YawDamp) + if (RegCheckErr(Buf, RoutineName)) return + ! TpBrDT + call RegUnpack(Buf, OutData%TpBrDT) + if (RegCheckErr(Buf, RoutineName)) return + ! TBDepISp + if (allocated(OutData%TBDepISp)) deallocate(OutData%TBDepISp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TBDepISp(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TBDepISp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TBDepISp) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TBDrConN + call RegUnpack(Buf, OutData%TBDrConN) + if (RegCheckErr(Buf, RoutineName)) return + ! TBDrConD + call RegUnpack(Buf, OutData%TBDrConD) + if (RegCheckErr(Buf, RoutineName)) return + ! NumBl + call RegUnpack(Buf, OutData%NumBl) + if (RegCheckErr(Buf, RoutineName)) return + ! NumBStC + call RegUnpack(Buf, OutData%NumBStC) + if (RegCheckErr(Buf, RoutineName)) return + ! NumNStC + call RegUnpack(Buf, OutData%NumNStC) + if (RegCheckErr(Buf, RoutineName)) return + ! NumTStC + call RegUnpack(Buf, OutData%NumTStC) + if (RegCheckErr(Buf, RoutineName)) return + ! NumSStC + call RegUnpack(Buf, OutData%NumSStC) + if (RegCheckErr(Buf, RoutineName)) return + ! AfCmode + call RegUnpack(Buf, OutData%AfCmode) + if (RegCheckErr(Buf, RoutineName)) return + ! AfC_Mean + call RegUnpack(Buf, OutData%AfC_Mean) + if (RegCheckErr(Buf, RoutineName)) return + ! AfC_Amp + call RegUnpack(Buf, OutData%AfC_Amp) + if (RegCheckErr(Buf, RoutineName)) return + ! AfC_Phase + call RegUnpack(Buf, OutData%AfC_Phase) + if (RegCheckErr(Buf, RoutineName)) return + ! CCmode + call RegUnpack(Buf, OutData%CCmode) + if (RegCheckErr(Buf, RoutineName)) return + ! StCCmode + call RegUnpack(Buf, OutData%StCCmode) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts_DLL + call RegUnpack(Buf, OutData%NumOuts_DLL) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! OutParam + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam + end do + end if + ! Delim + call RegUnpack(Buf, OutData%Delim) + if (RegCheckErr(Buf, RoutineName)) return + ! UseBladedInterface + call RegUnpack(Buf, OutData%UseBladedInterface) + if (RegCheckErr(Buf, RoutineName)) return + ! UseLegacyInterface + call RegUnpack(Buf, OutData%UseLegacyInterface) + if (RegCheckErr(Buf, RoutineName)) return + ! DLL_Trgt + call DLLTypeUnpack(Buf, OutData%DLL_Trgt) ! DLL_Trgt + ! DLL_Ramp + call RegUnpack(Buf, OutData%DLL_Ramp) + if (RegCheckErr(Buf, RoutineName)) return + ! BlAlpha + call RegUnpack(Buf, OutData%BlAlpha) + if (RegCheckErr(Buf, RoutineName)) return + ! DLL_n + call RegUnpack(Buf, OutData%DLL_n) + if (RegCheckErr(Buf, RoutineName)) return + ! avcOUTNAME_LEN + call RegUnpack(Buf, OutData%avcOUTNAME_LEN) + if (RegCheckErr(Buf, RoutineName)) return + ! NacYaw_North + call RegUnpack(Buf, OutData%NacYaw_North) + if (RegCheckErr(Buf, RoutineName)) return + ! AvgWindSpeed + call RegUnpack(Buf, OutData%AvgWindSpeed) + if (RegCheckErr(Buf, RoutineName)) return + ! AirDens + call RegUnpack(Buf, OutData%AirDens) + if (RegCheckErr(Buf, RoutineName)) return + ! TrimCase + call RegUnpack(Buf, OutData%TrimCase) + if (RegCheckErr(Buf, RoutineName)) return + ! TrimGain + call RegUnpack(Buf, OutData%TrimGain) + if (RegCheckErr(Buf, RoutineName)) return + ! RotSpeedRef + call RegUnpack(Buf, OutData%RotSpeedRef) + if (RegCheckErr(Buf, RoutineName)) return + ! BStC + if (allocated(OutData%BStC)) deallocate(OutData%BStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackParam(Buf, OutData%BStC(i1)) ! BStC + end do + end if + ! NStC + if (allocated(OutData%NStC)) deallocate(OutData%NStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackParam(Buf, OutData%NStC(i1)) ! NStC + end do + end if + ! TStC + if (allocated(OutData%TStC)) deallocate(OutData%TStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackParam(Buf, OutData%TStC(i1)) ! TStC + end do + end if + ! SStC + if (allocated(OutData%SStC)) deallocate(OutData%SStC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SStC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call StC_UnpackParam(Buf, OutData%SStC(i1)) ! SStC + end do + end if + ! InterpOrder + call RegUnpack(Buf, OutData%InterpOrder) + if (RegCheckErr(Buf, RoutineName)) return + ! EXavrSWAP + call RegUnpack(Buf, OutData%EXavrSWAP) + if (RegCheckErr(Buf, RoutineName)) return + ! NumCableControl + call RegUnpack(Buf, OutData%NumCableControl) + if (RegCheckErr(Buf, RoutineName)) return + ! NumStC_Control + call RegUnpack(Buf, OutData%NumStC_Control) + if (RegCheckErr(Buf, RoutineName)) return + ! StCMeasNumPerChan + if (allocated(OutData%StCMeasNumPerChan)) deallocate(OutData%StCMeasNumPerChan) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StCMeasNumPerChan(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StCMeasNumPerChan.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StCMeasNumPerChan) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! UseSC + call RegUnpack(Buf, OutData%UseSC) + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_u_indx + if (allocated(OutData%Jac_u_indx)) deallocate(OutData%Jac_u_indx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jac_u_indx) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Jac_x_indx + if (allocated(OutData%Jac_x_indx)) deallocate(OutData%Jac_x_indx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jac_x_indx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_x_indx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jac_x_indx) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! du + if (allocated(OutData%du)) deallocate(OutData%du) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%du(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%du) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! dx + if (allocated(OutData%dx)) deallocate(OutData%dx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dx(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dx) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Jac_nu + call RegUnpack(Buf, OutData%Jac_nu) + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_ny + call RegUnpack(Buf, OutData%Jac_ny) + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_nx + call RegUnpack(Buf, OutData%Jac_nx) + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_Idx_BStC_u + if (allocated(OutData%Jac_Idx_BStC_u)) deallocate(OutData%Jac_Idx_BStC_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jac_Idx_BStC_u(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_BStC_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jac_Idx_BStC_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Jac_Idx_NStC_u + if (allocated(OutData%Jac_Idx_NStC_u)) deallocate(OutData%Jac_Idx_NStC_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jac_Idx_NStC_u(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_NStC_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jac_Idx_NStC_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Jac_Idx_TStC_u + if (allocated(OutData%Jac_Idx_TStC_u)) deallocate(OutData%Jac_Idx_TStC_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jac_Idx_TStC_u(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_TStC_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jac_Idx_TStC_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Jac_Idx_SStC_u + if (allocated(OutData%Jac_Idx_SStC_u)) deallocate(OutData%Jac_Idx_SStC_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jac_Idx_SStC_u(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_SStC_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jac_Idx_SStC_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Jac_Idx_BStC_x + if (allocated(OutData%Jac_Idx_BStC_x)) deallocate(OutData%Jac_Idx_BStC_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jac_Idx_BStC_x(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_BStC_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jac_Idx_BStC_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Jac_Idx_NStC_x + if (allocated(OutData%Jac_Idx_NStC_x)) deallocate(OutData%Jac_Idx_NStC_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jac_Idx_NStC_x(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_NStC_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jac_Idx_NStC_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Jac_Idx_TStC_x + if (allocated(OutData%Jac_Idx_TStC_x)) deallocate(OutData%Jac_Idx_TStC_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jac_Idx_TStC_x(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_TStC_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jac_Idx_TStC_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Jac_Idx_SStC_x + if (allocated(OutData%Jac_Idx_SStC_x)) deallocate(OutData%Jac_Idx_SStC_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jac_Idx_SStC_x(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_SStC_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jac_Idx_SStC_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Jac_Idx_BStC_y + if (allocated(OutData%Jac_Idx_BStC_y)) deallocate(OutData%Jac_Idx_BStC_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jac_Idx_BStC_y(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_BStC_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jac_Idx_BStC_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Jac_Idx_NStC_y + if (allocated(OutData%Jac_Idx_NStC_y)) deallocate(OutData%Jac_Idx_NStC_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jac_Idx_NStC_y(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_NStC_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jac_Idx_NStC_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Jac_Idx_TStC_y + if (allocated(OutData%Jac_Idx_TStC_y)) deallocate(OutData%Jac_Idx_TStC_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jac_Idx_TStC_y(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_TStC_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jac_Idx_TStC_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Jac_Idx_SStC_y + if (allocated(OutData%Jac_Idx_SStC_y)) deallocate(OutData%Jac_Idx_SStC_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jac_Idx_SStC_y(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_Idx_SStC_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jac_Idx_SStC_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! SensorType + call RegUnpack(Buf, OutData%SensorType) + if (RegCheckErr(Buf, RoutineName)) return + ! NumBeam + call RegUnpack(Buf, OutData%NumBeam) + if (RegCheckErr(Buf, RoutineName)) return + ! NumPulseGate + call RegUnpack(Buf, OutData%NumPulseGate) + if (RegCheckErr(Buf, RoutineName)) return + ! PulseSpacing + call RegUnpack(Buf, OutData%PulseSpacing) + if (RegCheckErr(Buf, RoutineName)) return + ! URefLid + call RegUnpack(Buf, OutData%URefLid) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE SrvD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(SrvD_InputType), INTENT(INOUT) :: SrcInputData TYPE(SrvD_InputType), INTENT(INOUT) :: DstInputData @@ -15650,1316 +8863,611 @@ SUBROUTINE SrvD_DestroyInput( InputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE SrvD_DestroyInput - SUBROUTINE SrvD_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SrvD_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! BlPitch allocated yes/no - IF ( ALLOCATED(InData%BlPitch) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlPitch upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlPitch) ! BlPitch - END IF - Re_BufSz = Re_BufSz + 1 ! Yaw - Re_BufSz = Re_BufSz + 1 ! YawRate - Re_BufSz = Re_BufSz + 1 ! LSS_Spd - Re_BufSz = Re_BufSz + 1 ! HSS_Spd - Re_BufSz = Re_BufSz + 1 ! RotSpeed - Re_BufSz = Re_BufSz + 1 ! ExternalYawPosCom - Re_BufSz = Re_BufSz + 1 ! ExternalYawRateCom - Int_BufSz = Int_BufSz + 1 ! ExternalBlPitchCom allocated yes/no - IF ( ALLOCATED(InData%ExternalBlPitchCom) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ExternalBlPitchCom upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ExternalBlPitchCom) ! ExternalBlPitchCom - END IF - Re_BufSz = Re_BufSz + 1 ! ExternalGenTrq - Re_BufSz = Re_BufSz + 1 ! ExternalElecPwr - Re_BufSz = Re_BufSz + 1 ! ExternalHSSBrFrac - Int_BufSz = Int_BufSz + 1 ! ExternalBlAirfoilCom allocated yes/no - IF ( ALLOCATED(InData%ExternalBlAirfoilCom) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ExternalBlAirfoilCom upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ExternalBlAirfoilCom) ! ExternalBlAirfoilCom - END IF - Int_BufSz = Int_BufSz + 1 ! ExternalCableDeltaL allocated yes/no - IF ( ALLOCATED(InData%ExternalCableDeltaL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ExternalCableDeltaL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ExternalCableDeltaL) ! ExternalCableDeltaL - END IF - Int_BufSz = Int_BufSz + 1 ! ExternalCableDeltaLdot allocated yes/no - IF ( ALLOCATED(InData%ExternalCableDeltaLdot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ExternalCableDeltaLdot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ExternalCableDeltaLdot) ! ExternalCableDeltaLdot - END IF - Re_BufSz = Re_BufSz + 1 ! TwrAccel - Re_BufSz = Re_BufSz + 1 ! YawErr - Re_BufSz = Re_BufSz + 1 ! WindDir - Re_BufSz = Re_BufSz + SIZE(InData%RootMyc) ! RootMyc - Re_BufSz = Re_BufSz + 1 ! YawBrTAxp - Re_BufSz = Re_BufSz + 1 ! YawBrTAyp - Re_BufSz = Re_BufSz + 1 ! LSSTipPxa - Re_BufSz = Re_BufSz + SIZE(InData%RootMxc) ! RootMxc - Re_BufSz = Re_BufSz + 1 ! LSSTipMxa - Re_BufSz = Re_BufSz + 1 ! LSSTipMya - Re_BufSz = Re_BufSz + 1 ! LSSTipMza - Re_BufSz = Re_BufSz + 1 ! LSSTipMys - Re_BufSz = Re_BufSz + 1 ! LSSTipMzs - Re_BufSz = Re_BufSz + 1 ! YawBrMyn - Re_BufSz = Re_BufSz + 1 ! YawBrMzn - Re_BufSz = Re_BufSz + 1 ! NcIMURAxs - Re_BufSz = Re_BufSz + 1 ! NcIMURAys - Re_BufSz = Re_BufSz + 1 ! NcIMURAzs - Re_BufSz = Re_BufSz + 1 ! RotPwr - Re_BufSz = Re_BufSz + 1 ! HorWindV - Re_BufSz = Re_BufSz + 1 ! YawAngle - Re_BufSz = Re_BufSz + 1 ! LSShftFxa - Re_BufSz = Re_BufSz + 1 ! LSShftFys - Re_BufSz = Re_BufSz + 1 ! LSShftFzs - Int_BufSz = Int_BufSz + 1 ! fromSC allocated yes/no - IF ( ALLOCATED(InData%fromSC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! fromSC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fromSC) ! fromSC - END IF - Int_BufSz = Int_BufSz + 1 ! fromSCglob allocated yes/no - IF ( ALLOCATED(InData%fromSCglob) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! fromSCglob upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fromSCglob) ! fromSCglob - END IF - Int_BufSz = Int_BufSz + 1 ! Lidar allocated yes/no - IF ( ALLOCATED(InData%Lidar) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Lidar upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Lidar) ! Lidar - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! PtfmMotionMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%PtfmMotionMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PtfmMotionMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PtfmMotionMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PtfmMotionMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PtfmMotionMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! BStCMotionMesh allocated yes/no - IF ( ALLOCATED(InData%BStCMotionMesh) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BStCMotionMesh upper/lower bounds for each dimension - DO i2 = LBOUND(InData%BStCMotionMesh,2), UBOUND(InData%BStCMotionMesh,2) - DO i1 = LBOUND(InData%BStCMotionMesh,1), UBOUND(InData%BStCMotionMesh,1) - Int_BufSz = Int_BufSz + 3 ! BStCMotionMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%BStCMotionMesh(i1,i2), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BStCMotionMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BStCMotionMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BStCMotionMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BStCMotionMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NStCMotionMesh allocated yes/no - IF ( ALLOCATED(InData%NStCMotionMesh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NStCMotionMesh upper/lower bounds for each dimension - DO i1 = LBOUND(InData%NStCMotionMesh,1), UBOUND(InData%NStCMotionMesh,1) - Int_BufSz = Int_BufSz + 3 ! NStCMotionMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%NStCMotionMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! NStCMotionMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NStCMotionMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NStCMotionMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NStCMotionMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! TStCMotionMesh allocated yes/no - IF ( ALLOCATED(InData%TStCMotionMesh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TStCMotionMesh upper/lower bounds for each dimension - DO i1 = LBOUND(InData%TStCMotionMesh,1), UBOUND(InData%TStCMotionMesh,1) - Int_BufSz = Int_BufSz + 3 ! TStCMotionMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%TStCMotionMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TStCMotionMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TStCMotionMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TStCMotionMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TStCMotionMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SStCMotionMesh allocated yes/no - IF ( ALLOCATED(InData%SStCMotionMesh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SStCMotionMesh upper/lower bounds for each dimension - DO i1 = LBOUND(InData%SStCMotionMesh,1), UBOUND(InData%SStCMotionMesh,1) - Int_BufSz = Int_BufSz + 3 ! SStCMotionMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%SStCMotionMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! SStCMotionMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SStCMotionMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SStCMotionMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SStCMotionMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! LidSpeed allocated yes/no - IF ( ALLOCATED(InData%LidSpeed) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LidSpeed upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LidSpeed) ! LidSpeed - END IF - Int_BufSz = Int_BufSz + 1 ! MsrPositionsX allocated yes/no - IF ( ALLOCATED(InData%MsrPositionsX) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MsrPositionsX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MsrPositionsX) ! MsrPositionsX - END IF - Int_BufSz = Int_BufSz + 1 ! MsrPositionsY allocated yes/no - IF ( ALLOCATED(InData%MsrPositionsY) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MsrPositionsY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MsrPositionsY) ! MsrPositionsY - END IF - Int_BufSz = Int_BufSz + 1 ! MsrPositionsZ allocated yes/no - IF ( ALLOCATED(InData%MsrPositionsZ) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MsrPositionsZ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MsrPositionsZ) ! MsrPositionsZ - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%BlPitch) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlPitch,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitch,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlPitch,1), UBOUND(InData%BlPitch,1) - ReKiBuf(Re_Xferred) = InData%BlPitch(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%Yaw - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawRate - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSS_Spd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HSS_Spd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RotSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ExternalYawPosCom - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ExternalYawRateCom - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%ExternalBlPitchCom) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ExternalBlPitchCom,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ExternalBlPitchCom,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ExternalBlPitchCom,1), UBOUND(InData%ExternalBlPitchCom,1) - ReKiBuf(Re_Xferred) = InData%ExternalBlPitchCom(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%ExternalGenTrq - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ExternalElecPwr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ExternalHSSBrFrac - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%ExternalBlAirfoilCom) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ExternalBlAirfoilCom,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ExternalBlAirfoilCom,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ExternalBlAirfoilCom,1), UBOUND(InData%ExternalBlAirfoilCom,1) - ReKiBuf(Re_Xferred) = InData%ExternalBlAirfoilCom(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ExternalCableDeltaL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ExternalCableDeltaL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ExternalCableDeltaL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ExternalCableDeltaL,1), UBOUND(InData%ExternalCableDeltaL,1) - ReKiBuf(Re_Xferred) = InData%ExternalCableDeltaL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ExternalCableDeltaLdot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ExternalCableDeltaLdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ExternalCableDeltaLdot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ExternalCableDeltaLdot,1), UBOUND(InData%ExternalCableDeltaLdot,1) - ReKiBuf(Re_Xferred) = InData%ExternalCableDeltaLdot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%TwrAccel - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawErr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WindDir - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%RootMyc,1), UBOUND(InData%RootMyc,1) - ReKiBuf(Re_Xferred) = InData%RootMyc(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%YawBrTAxp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawBrTAyp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSSTipPxa - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%RootMxc,1), UBOUND(InData%RootMxc,1) - ReKiBuf(Re_Xferred) = InData%RootMxc(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%LSSTipMxa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSSTipMya - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSSTipMza - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSSTipMys - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSSTipMzs - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawBrMyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawBrMzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NcIMURAxs - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NcIMURAys - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%NcIMURAzs - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%RotPwr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HorWindV - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YawAngle - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSShftFxa - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSShftFys - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%LSShftFzs - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%fromSC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fromSC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fromSC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%fromSC,1), UBOUND(InData%fromSC,1) - ReKiBuf(Re_Xferred) = InData%fromSC(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%fromSCglob) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fromSCglob,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fromSCglob,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%fromSCglob,1), UBOUND(InData%fromSCglob,1) - ReKiBuf(Re_Xferred) = InData%fromSCglob(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Lidar) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Lidar,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Lidar,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Lidar,1), UBOUND(InData%Lidar,1) - ReKiBuf(Re_Xferred) = InData%Lidar(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - CALL MeshPack( InData%PtfmMotionMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PtfmMotionMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%BStCMotionMesh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BStCMotionMesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStCMotionMesh,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BStCMotionMesh,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStCMotionMesh,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BStCMotionMesh,2), UBOUND(InData%BStCMotionMesh,2) - DO i1 = LBOUND(InData%BStCMotionMesh,1), UBOUND(InData%BStCMotionMesh,1) - CALL MeshPack( InData%BStCMotionMesh(i1,i2), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BStCMotionMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NStCMotionMesh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NStCMotionMesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NStCMotionMesh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NStCMotionMesh,1), UBOUND(InData%NStCMotionMesh,1) - CALL MeshPack( InData%NStCMotionMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! NStCMotionMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TStCMotionMesh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TStCMotionMesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TStCMotionMesh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TStCMotionMesh,1), UBOUND(InData%TStCMotionMesh,1) - CALL MeshPack( InData%TStCMotionMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TStCMotionMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SStCMotionMesh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SStCMotionMesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SStCMotionMesh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SStCMotionMesh,1), UBOUND(InData%SStCMotionMesh,1) - CALL MeshPack( InData%SStCMotionMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! SStCMotionMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LidSpeed) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LidSpeed,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LidSpeed,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LidSpeed,1), UBOUND(InData%LidSpeed,1) - ReKiBuf(Re_Xferred) = InData%LidSpeed(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MsrPositionsX) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MsrPositionsX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MsrPositionsX,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MsrPositionsX,1), UBOUND(InData%MsrPositionsX,1) - ReKiBuf(Re_Xferred) = InData%MsrPositionsX(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MsrPositionsY) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MsrPositionsY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MsrPositionsY,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MsrPositionsY,1), UBOUND(InData%MsrPositionsY,1) - ReKiBuf(Re_Xferred) = InData%MsrPositionsY(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MsrPositionsZ) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MsrPositionsZ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MsrPositionsZ,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MsrPositionsZ,1), UBOUND(InData%MsrPositionsZ,1) - ReKiBuf(Re_Xferred) = InData%MsrPositionsZ(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SrvD_PackInput - - SUBROUTINE SrvD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SrvD_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitch not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlPitch)) DEALLOCATE(OutData%BlPitch) - ALLOCATE(OutData%BlPitch(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitch.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlPitch,1), UBOUND(OutData%BlPitch,1) - OutData%BlPitch(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Yaw = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawRate = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSS_Spd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HSS_Spd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RotSpeed = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ExternalYawPosCom = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ExternalYawRateCom = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ExternalBlPitchCom not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ExternalBlPitchCom)) DEALLOCATE(OutData%ExternalBlPitchCom) - ALLOCATE(OutData%ExternalBlPitchCom(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ExternalBlPitchCom.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ExternalBlPitchCom,1), UBOUND(OutData%ExternalBlPitchCom,1) - OutData%ExternalBlPitchCom(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%ExternalGenTrq = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ExternalElecPwr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ExternalHSSBrFrac = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ExternalBlAirfoilCom not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ExternalBlAirfoilCom)) DEALLOCATE(OutData%ExternalBlAirfoilCom) - ALLOCATE(OutData%ExternalBlAirfoilCom(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ExternalBlAirfoilCom.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ExternalBlAirfoilCom,1), UBOUND(OutData%ExternalBlAirfoilCom,1) - OutData%ExternalBlAirfoilCom(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ExternalCableDeltaL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ExternalCableDeltaL)) DEALLOCATE(OutData%ExternalCableDeltaL) - ALLOCATE(OutData%ExternalCableDeltaL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ExternalCableDeltaL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ExternalCableDeltaL,1), UBOUND(OutData%ExternalCableDeltaL,1) - OutData%ExternalCableDeltaL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ExternalCableDeltaLdot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ExternalCableDeltaLdot)) DEALLOCATE(OutData%ExternalCableDeltaLdot) - ALLOCATE(OutData%ExternalCableDeltaLdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ExternalCableDeltaLdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ExternalCableDeltaLdot,1), UBOUND(OutData%ExternalCableDeltaLdot,1) - OutData%ExternalCableDeltaLdot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%TwrAccel = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawErr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WindDir = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%RootMyc,1) - i1_u = UBOUND(OutData%RootMyc,1) - DO i1 = LBOUND(OutData%RootMyc,1), UBOUND(OutData%RootMyc,1) - OutData%RootMyc(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%YawBrTAxp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrTAyp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipPxa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%RootMxc,1) - i1_u = UBOUND(OutData%RootMxc,1) - DO i1 = LBOUND(OutData%RootMxc,1), UBOUND(OutData%RootMxc,1) - OutData%RootMxc(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%LSSTipMxa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMya = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMza = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMys = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMzs = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrMyn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrMzn = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMURAxs = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMURAys = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMURAzs = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%RotPwr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HorWindV = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YawAngle = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSShftFxa = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSShftFys = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%LSShftFzs = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fromSC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%fromSC)) DEALLOCATE(OutData%fromSC) - ALLOCATE(OutData%fromSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%fromSC,1), UBOUND(OutData%fromSC,1) - OutData%fromSC(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fromSCglob not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%fromSCglob)) DEALLOCATE(OutData%fromSCglob) - ALLOCATE(OutData%fromSCglob(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSCglob.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%fromSCglob,1), UBOUND(OutData%fromSCglob,1) - OutData%fromSCglob(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Lidar not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Lidar)) DEALLOCATE(OutData%Lidar) - ALLOCATE(OutData%Lidar(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Lidar.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Lidar,1), UBOUND(OutData%Lidar,1) - OutData%Lidar(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%PtfmMotionMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PtfmMotionMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BStCMotionMesh not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BStCMotionMesh)) DEALLOCATE(OutData%BStCMotionMesh) - ALLOCATE(OutData%BStCMotionMesh(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStCMotionMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BStCMotionMesh,2), UBOUND(OutData%BStCMotionMesh,2) - DO i1 = LBOUND(OutData%BStCMotionMesh,1), UBOUND(OutData%BStCMotionMesh,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%BStCMotionMesh(i1,i2), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BStCMotionMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NStCMotionMesh not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NStCMotionMesh)) DEALLOCATE(OutData%NStCMotionMesh) - ALLOCATE(OutData%NStCMotionMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStCMotionMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NStCMotionMesh,1), UBOUND(OutData%NStCMotionMesh,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%NStCMotionMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! NStCMotionMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TStCMotionMesh not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TStCMotionMesh)) DEALLOCATE(OutData%TStCMotionMesh) - ALLOCATE(OutData%TStCMotionMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStCMotionMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TStCMotionMesh,1), UBOUND(OutData%TStCMotionMesh,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%TStCMotionMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TStCMotionMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SStCMotionMesh not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SStCMotionMesh)) DEALLOCATE(OutData%SStCMotionMesh) - ALLOCATE(OutData%SStCMotionMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStCMotionMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SStCMotionMesh,1), UBOUND(OutData%SStCMotionMesh,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%SStCMotionMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! SStCMotionMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LidSpeed not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LidSpeed)) DEALLOCATE(OutData%LidSpeed) - ALLOCATE(OutData%LidSpeed(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LidSpeed.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LidSpeed,1), UBOUND(OutData%LidSpeed,1) - OutData%LidSpeed(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MsrPositionsX not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MsrPositionsX)) DEALLOCATE(OutData%MsrPositionsX) - ALLOCATE(OutData%MsrPositionsX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MsrPositionsX,1), UBOUND(OutData%MsrPositionsX,1) - OutData%MsrPositionsX(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MsrPositionsY not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MsrPositionsY)) DEALLOCATE(OutData%MsrPositionsY) - ALLOCATE(OutData%MsrPositionsY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MsrPositionsY,1), UBOUND(OutData%MsrPositionsY,1) - OutData%MsrPositionsY(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MsrPositionsZ not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MsrPositionsZ)) DEALLOCATE(OutData%MsrPositionsZ) - ALLOCATE(OutData%MsrPositionsZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MsrPositionsZ,1), UBOUND(OutData%MsrPositionsZ,1) - OutData%MsrPositionsZ(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SrvD_UnPackInput +subroutine SrvD_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackInput' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + ! BlPitch + call RegPack(Buf, allocated(InData%BlPitch)) + if (allocated(InData%BlPitch)) then + call RegPackBounds(Buf, 1, lbound(InData%BlPitch), ubound(InData%BlPitch)) + call RegPack(Buf, InData%BlPitch) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Yaw + call RegPack(Buf, InData%Yaw) + if (RegCheckErr(Buf, RoutineName)) return + ! YawRate + call RegPack(Buf, InData%YawRate) + if (RegCheckErr(Buf, RoutineName)) return + ! LSS_Spd + call RegPack(Buf, InData%LSS_Spd) + if (RegCheckErr(Buf, RoutineName)) return + ! HSS_Spd + call RegPack(Buf, InData%HSS_Spd) + if (RegCheckErr(Buf, RoutineName)) return + ! RotSpeed + call RegPack(Buf, InData%RotSpeed) + if (RegCheckErr(Buf, RoutineName)) return + ! ExternalYawPosCom + call RegPack(Buf, InData%ExternalYawPosCom) + if (RegCheckErr(Buf, RoutineName)) return + ! ExternalYawRateCom + call RegPack(Buf, InData%ExternalYawRateCom) + if (RegCheckErr(Buf, RoutineName)) return + ! ExternalBlPitchCom + call RegPack(Buf, allocated(InData%ExternalBlPitchCom)) + if (allocated(InData%ExternalBlPitchCom)) then + call RegPackBounds(Buf, 1, lbound(InData%ExternalBlPitchCom), ubound(InData%ExternalBlPitchCom)) + call RegPack(Buf, InData%ExternalBlPitchCom) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ExternalGenTrq + call RegPack(Buf, InData%ExternalGenTrq) + if (RegCheckErr(Buf, RoutineName)) return + ! ExternalElecPwr + call RegPack(Buf, InData%ExternalElecPwr) + if (RegCheckErr(Buf, RoutineName)) return + ! ExternalHSSBrFrac + call RegPack(Buf, InData%ExternalHSSBrFrac) + if (RegCheckErr(Buf, RoutineName)) return + ! ExternalBlAirfoilCom + call RegPack(Buf, allocated(InData%ExternalBlAirfoilCom)) + if (allocated(InData%ExternalBlAirfoilCom)) then + call RegPackBounds(Buf, 1, lbound(InData%ExternalBlAirfoilCom), ubound(InData%ExternalBlAirfoilCom)) + call RegPack(Buf, InData%ExternalBlAirfoilCom) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ExternalCableDeltaL + call RegPack(Buf, allocated(InData%ExternalCableDeltaL)) + if (allocated(InData%ExternalCableDeltaL)) then + call RegPackBounds(Buf, 1, lbound(InData%ExternalCableDeltaL), ubound(InData%ExternalCableDeltaL)) + call RegPack(Buf, InData%ExternalCableDeltaL) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ExternalCableDeltaLdot + call RegPack(Buf, allocated(InData%ExternalCableDeltaLdot)) + if (allocated(InData%ExternalCableDeltaLdot)) then + call RegPackBounds(Buf, 1, lbound(InData%ExternalCableDeltaLdot), ubound(InData%ExternalCableDeltaLdot)) + call RegPack(Buf, InData%ExternalCableDeltaLdot) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TwrAccel + call RegPack(Buf, InData%TwrAccel) + if (RegCheckErr(Buf, RoutineName)) return + ! YawErr + call RegPack(Buf, InData%YawErr) + if (RegCheckErr(Buf, RoutineName)) return + ! WindDir + call RegPack(Buf, InData%WindDir) + if (RegCheckErr(Buf, RoutineName)) return + ! RootMyc + call RegPack(Buf, InData%RootMyc) + if (RegCheckErr(Buf, RoutineName)) return + ! YawBrTAxp + call RegPack(Buf, InData%YawBrTAxp) + if (RegCheckErr(Buf, RoutineName)) return + ! YawBrTAyp + call RegPack(Buf, InData%YawBrTAyp) + if (RegCheckErr(Buf, RoutineName)) return + ! LSSTipPxa + call RegPack(Buf, InData%LSSTipPxa) + if (RegCheckErr(Buf, RoutineName)) return + ! RootMxc + call RegPack(Buf, InData%RootMxc) + if (RegCheckErr(Buf, RoutineName)) return + ! LSSTipMxa + call RegPack(Buf, InData%LSSTipMxa) + if (RegCheckErr(Buf, RoutineName)) return + ! LSSTipMya + call RegPack(Buf, InData%LSSTipMya) + if (RegCheckErr(Buf, RoutineName)) return + ! LSSTipMza + call RegPack(Buf, InData%LSSTipMza) + if (RegCheckErr(Buf, RoutineName)) return + ! LSSTipMys + call RegPack(Buf, InData%LSSTipMys) + if (RegCheckErr(Buf, RoutineName)) return + ! LSSTipMzs + call RegPack(Buf, InData%LSSTipMzs) + if (RegCheckErr(Buf, RoutineName)) return + ! YawBrMyn + call RegPack(Buf, InData%YawBrMyn) + if (RegCheckErr(Buf, RoutineName)) return + ! YawBrMzn + call RegPack(Buf, InData%YawBrMzn) + if (RegCheckErr(Buf, RoutineName)) return + ! NcIMURAxs + call RegPack(Buf, InData%NcIMURAxs) + if (RegCheckErr(Buf, RoutineName)) return + ! NcIMURAys + call RegPack(Buf, InData%NcIMURAys) + if (RegCheckErr(Buf, RoutineName)) return + ! NcIMURAzs + call RegPack(Buf, InData%NcIMURAzs) + if (RegCheckErr(Buf, RoutineName)) return + ! RotPwr + call RegPack(Buf, InData%RotPwr) + if (RegCheckErr(Buf, RoutineName)) return + ! HorWindV + call RegPack(Buf, InData%HorWindV) + if (RegCheckErr(Buf, RoutineName)) return + ! YawAngle + call RegPack(Buf, InData%YawAngle) + if (RegCheckErr(Buf, RoutineName)) return + ! LSShftFxa + call RegPack(Buf, InData%LSShftFxa) + if (RegCheckErr(Buf, RoutineName)) return + ! LSShftFys + call RegPack(Buf, InData%LSShftFys) + if (RegCheckErr(Buf, RoutineName)) return + ! LSShftFzs + call RegPack(Buf, InData%LSShftFzs) + if (RegCheckErr(Buf, RoutineName)) return + ! fromSC + call RegPack(Buf, allocated(InData%fromSC)) + if (allocated(InData%fromSC)) then + call RegPackBounds(Buf, 1, lbound(InData%fromSC), ubound(InData%fromSC)) + call RegPack(Buf, InData%fromSC) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! fromSCglob + call RegPack(Buf, allocated(InData%fromSCglob)) + if (allocated(InData%fromSCglob)) then + call RegPackBounds(Buf, 1, lbound(InData%fromSCglob), ubound(InData%fromSCglob)) + call RegPack(Buf, InData%fromSCglob) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Lidar + call RegPack(Buf, allocated(InData%Lidar)) + if (allocated(InData%Lidar)) then + call RegPackBounds(Buf, 1, lbound(InData%Lidar), ubound(InData%Lidar)) + call RegPack(Buf, InData%Lidar) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PtfmMotionMesh + call MeshPack(Buf, InData%PtfmMotionMesh) + if (RegCheckErr(Buf, RoutineName)) return + ! BStCMotionMesh + call RegPack(Buf, allocated(InData%BStCMotionMesh)) + if (allocated(InData%BStCMotionMesh)) then + call RegPackBounds(Buf, 2, lbound(InData%BStCMotionMesh), ubound(InData%BStCMotionMesh)) + LB(1:2) = lbound(InData%BStCMotionMesh) + UB(1:2) = ubound(InData%BStCMotionMesh) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%BStCMotionMesh(i1,i2)) + end do + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NStCMotionMesh + call RegPack(Buf, allocated(InData%NStCMotionMesh)) + if (allocated(InData%NStCMotionMesh)) then + call RegPackBounds(Buf, 1, lbound(InData%NStCMotionMesh), ubound(InData%NStCMotionMesh)) + LB(1:1) = lbound(InData%NStCMotionMesh) + UB(1:1) = ubound(InData%NStCMotionMesh) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%NStCMotionMesh(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TStCMotionMesh + call RegPack(Buf, allocated(InData%TStCMotionMesh)) + if (allocated(InData%TStCMotionMesh)) then + call RegPackBounds(Buf, 1, lbound(InData%TStCMotionMesh), ubound(InData%TStCMotionMesh)) + LB(1:1) = lbound(InData%TStCMotionMesh) + UB(1:1) = ubound(InData%TStCMotionMesh) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%TStCMotionMesh(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SStCMotionMesh + call RegPack(Buf, allocated(InData%SStCMotionMesh)) + if (allocated(InData%SStCMotionMesh)) then + call RegPackBounds(Buf, 1, lbound(InData%SStCMotionMesh), ubound(InData%SStCMotionMesh)) + LB(1:1) = lbound(InData%SStCMotionMesh) + UB(1:1) = ubound(InData%SStCMotionMesh) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%SStCMotionMesh(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LidSpeed + call RegPack(Buf, allocated(InData%LidSpeed)) + if (allocated(InData%LidSpeed)) then + call RegPackBounds(Buf, 1, lbound(InData%LidSpeed), ubound(InData%LidSpeed)) + call RegPack(Buf, InData%LidSpeed) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MsrPositionsX + call RegPack(Buf, allocated(InData%MsrPositionsX)) + if (allocated(InData%MsrPositionsX)) then + call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsX), ubound(InData%MsrPositionsX)) + call RegPack(Buf, InData%MsrPositionsX) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MsrPositionsY + call RegPack(Buf, allocated(InData%MsrPositionsY)) + if (allocated(InData%MsrPositionsY)) then + call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsY), ubound(InData%MsrPositionsY)) + call RegPack(Buf, InData%MsrPositionsY) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MsrPositionsZ + call RegPack(Buf, allocated(InData%MsrPositionsZ)) + if (allocated(InData%MsrPositionsZ)) then + call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsZ), ubound(InData%MsrPositionsZ)) + call RegPack(Buf, InData%MsrPositionsZ) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SrvD_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SrvD_UnPackInput' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! BlPitch + if (allocated(OutData%BlPitch)) deallocate(OutData%BlPitch) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlPitch(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitch.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlPitch) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Yaw + call RegUnpack(Buf, OutData%Yaw) + if (RegCheckErr(Buf, RoutineName)) return + ! YawRate + call RegUnpack(Buf, OutData%YawRate) + if (RegCheckErr(Buf, RoutineName)) return + ! LSS_Spd + call RegUnpack(Buf, OutData%LSS_Spd) + if (RegCheckErr(Buf, RoutineName)) return + ! HSS_Spd + call RegUnpack(Buf, OutData%HSS_Spd) + if (RegCheckErr(Buf, RoutineName)) return + ! RotSpeed + call RegUnpack(Buf, OutData%RotSpeed) + if (RegCheckErr(Buf, RoutineName)) return + ! ExternalYawPosCom + call RegUnpack(Buf, OutData%ExternalYawPosCom) + if (RegCheckErr(Buf, RoutineName)) return + ! ExternalYawRateCom + call RegUnpack(Buf, OutData%ExternalYawRateCom) + if (RegCheckErr(Buf, RoutineName)) return + ! ExternalBlPitchCom + if (allocated(OutData%ExternalBlPitchCom)) deallocate(OutData%ExternalBlPitchCom) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ExternalBlPitchCom(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ExternalBlPitchCom.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ExternalBlPitchCom) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ExternalGenTrq + call RegUnpack(Buf, OutData%ExternalGenTrq) + if (RegCheckErr(Buf, RoutineName)) return + ! ExternalElecPwr + call RegUnpack(Buf, OutData%ExternalElecPwr) + if (RegCheckErr(Buf, RoutineName)) return + ! ExternalHSSBrFrac + call RegUnpack(Buf, OutData%ExternalHSSBrFrac) + if (RegCheckErr(Buf, RoutineName)) return + ! ExternalBlAirfoilCom + if (allocated(OutData%ExternalBlAirfoilCom)) deallocate(OutData%ExternalBlAirfoilCom) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ExternalBlAirfoilCom(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ExternalBlAirfoilCom.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ExternalBlAirfoilCom) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ExternalCableDeltaL + if (allocated(OutData%ExternalCableDeltaL)) deallocate(OutData%ExternalCableDeltaL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ExternalCableDeltaL(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ExternalCableDeltaL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ExternalCableDeltaL) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ExternalCableDeltaLdot + if (allocated(OutData%ExternalCableDeltaLdot)) deallocate(OutData%ExternalCableDeltaLdot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ExternalCableDeltaLdot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ExternalCableDeltaLdot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ExternalCableDeltaLdot) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TwrAccel + call RegUnpack(Buf, OutData%TwrAccel) + if (RegCheckErr(Buf, RoutineName)) return + ! YawErr + call RegUnpack(Buf, OutData%YawErr) + if (RegCheckErr(Buf, RoutineName)) return + ! WindDir + call RegUnpack(Buf, OutData%WindDir) + if (RegCheckErr(Buf, RoutineName)) return + ! RootMyc + call RegUnpack(Buf, OutData%RootMyc) + if (RegCheckErr(Buf, RoutineName)) return + ! YawBrTAxp + call RegUnpack(Buf, OutData%YawBrTAxp) + if (RegCheckErr(Buf, RoutineName)) return + ! YawBrTAyp + call RegUnpack(Buf, OutData%YawBrTAyp) + if (RegCheckErr(Buf, RoutineName)) return + ! LSSTipPxa + call RegUnpack(Buf, OutData%LSSTipPxa) + if (RegCheckErr(Buf, RoutineName)) return + ! RootMxc + call RegUnpack(Buf, OutData%RootMxc) + if (RegCheckErr(Buf, RoutineName)) return + ! LSSTipMxa + call RegUnpack(Buf, OutData%LSSTipMxa) + if (RegCheckErr(Buf, RoutineName)) return + ! LSSTipMya + call RegUnpack(Buf, OutData%LSSTipMya) + if (RegCheckErr(Buf, RoutineName)) return + ! LSSTipMza + call RegUnpack(Buf, OutData%LSSTipMza) + if (RegCheckErr(Buf, RoutineName)) return + ! LSSTipMys + call RegUnpack(Buf, OutData%LSSTipMys) + if (RegCheckErr(Buf, RoutineName)) return + ! LSSTipMzs + call RegUnpack(Buf, OutData%LSSTipMzs) + if (RegCheckErr(Buf, RoutineName)) return + ! YawBrMyn + call RegUnpack(Buf, OutData%YawBrMyn) + if (RegCheckErr(Buf, RoutineName)) return + ! YawBrMzn + call RegUnpack(Buf, OutData%YawBrMzn) + if (RegCheckErr(Buf, RoutineName)) return + ! NcIMURAxs + call RegUnpack(Buf, OutData%NcIMURAxs) + if (RegCheckErr(Buf, RoutineName)) return + ! NcIMURAys + call RegUnpack(Buf, OutData%NcIMURAys) + if (RegCheckErr(Buf, RoutineName)) return + ! NcIMURAzs + call RegUnpack(Buf, OutData%NcIMURAzs) + if (RegCheckErr(Buf, RoutineName)) return + ! RotPwr + call RegUnpack(Buf, OutData%RotPwr) + if (RegCheckErr(Buf, RoutineName)) return + ! HorWindV + call RegUnpack(Buf, OutData%HorWindV) + if (RegCheckErr(Buf, RoutineName)) return + ! YawAngle + call RegUnpack(Buf, OutData%YawAngle) + if (RegCheckErr(Buf, RoutineName)) return + ! LSShftFxa + call RegUnpack(Buf, OutData%LSShftFxa) + if (RegCheckErr(Buf, RoutineName)) return + ! LSShftFys + call RegUnpack(Buf, OutData%LSShftFys) + if (RegCheckErr(Buf, RoutineName)) return + ! LSShftFzs + call RegUnpack(Buf, OutData%LSShftFzs) + if (RegCheckErr(Buf, RoutineName)) return + ! fromSC + if (allocated(OutData%fromSC)) deallocate(OutData%fromSC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%fromSC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%fromSC) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! fromSCglob + if (allocated(OutData%fromSCglob)) deallocate(OutData%fromSCglob) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%fromSCglob(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSCglob.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%fromSCglob) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Lidar + if (allocated(OutData%Lidar)) deallocate(OutData%Lidar) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Lidar(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Lidar.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Lidar) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PtfmMotionMesh + call MeshUnpack(Buf, OutData%PtfmMotionMesh) ! PtfmMotionMesh + ! BStCMotionMesh + if (allocated(OutData%BStCMotionMesh)) deallocate(OutData%BStCMotionMesh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BStCMotionMesh(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStCMotionMesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%BStCMotionMesh(i1,i2)) ! BStCMotionMesh + end do + end do + end if + ! NStCMotionMesh + if (allocated(OutData%NStCMotionMesh)) deallocate(OutData%NStCMotionMesh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NStCMotionMesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStCMotionMesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%NStCMotionMesh(i1)) ! NStCMotionMesh + end do + end if + ! TStCMotionMesh + if (allocated(OutData%TStCMotionMesh)) deallocate(OutData%TStCMotionMesh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TStCMotionMesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStCMotionMesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%TStCMotionMesh(i1)) ! TStCMotionMesh + end do + end if + ! SStCMotionMesh + if (allocated(OutData%SStCMotionMesh)) deallocate(OutData%SStCMotionMesh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SStCMotionMesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStCMotionMesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%SStCMotionMesh(i1)) ! SStCMotionMesh + end do + end if + ! LidSpeed + if (allocated(OutData%LidSpeed)) deallocate(OutData%LidSpeed) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LidSpeed(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LidSpeed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LidSpeed) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! MsrPositionsX + if (allocated(OutData%MsrPositionsX)) deallocate(OutData%MsrPositionsX) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MsrPositionsX(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MsrPositionsX) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! MsrPositionsY + if (allocated(OutData%MsrPositionsY)) deallocate(OutData%MsrPositionsY) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MsrPositionsY(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsY.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MsrPositionsY) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! MsrPositionsZ + if (allocated(OutData%MsrPositionsZ)) deallocate(OutData%MsrPositionsZ) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MsrPositionsZ(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MsrPositionsZ.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MsrPositionsZ) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE SrvD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(SrvD_OutputType), INTENT(INOUT) :: SrcOutputData TYPE(SrvD_OutputType), INTENT(INOUT) :: DstOutputData @@ -17215,917 +9723,338 @@ SUBROUTINE SrvD_DestroyOutput( OutputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE SrvD_DestroyOutput - SUBROUTINE SrvD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SrvD_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! WriteOutput allocated yes/no - IF ( ALLOCATED(InData%WriteOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutput upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WriteOutput) ! WriteOutput - END IF - Int_BufSz = Int_BufSz + 1 ! BlPitchCom allocated yes/no - IF ( ALLOCATED(InData%BlPitchCom) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlPitchCom upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlPitchCom) ! BlPitchCom - END IF - Int_BufSz = Int_BufSz + 1 ! BlAirfoilCom allocated yes/no - IF ( ALLOCATED(InData%BlAirfoilCom) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BlAirfoilCom upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlAirfoilCom) ! BlAirfoilCom - END IF - Re_BufSz = Re_BufSz + 1 ! YawMom - Re_BufSz = Re_BufSz + 1 ! GenTrq - Re_BufSz = Re_BufSz + 1 ! HSSBrTrqC - Re_BufSz = Re_BufSz + 1 ! ElecPwr - Int_BufSz = Int_BufSz + 1 ! TBDrCon allocated yes/no - IF ( ALLOCATED(InData%TBDrCon) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TBDrCon upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TBDrCon) ! TBDrCon - END IF - Int_BufSz = Int_BufSz + 1 ! Lidar allocated yes/no - IF ( ALLOCATED(InData%Lidar) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Lidar upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Lidar) ! Lidar - END IF - Int_BufSz = Int_BufSz + 1 ! CableDeltaL allocated yes/no - IF ( ALLOCATED(InData%CableDeltaL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CableDeltaL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CableDeltaL) ! CableDeltaL - END IF - Int_BufSz = Int_BufSz + 1 ! CableDeltaLdot allocated yes/no - IF ( ALLOCATED(InData%CableDeltaLdot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CableDeltaLdot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CableDeltaLdot) ! CableDeltaLdot - END IF - Int_BufSz = Int_BufSz + 1 ! BStCLoadMesh allocated yes/no - IF ( ALLOCATED(InData%BStCLoadMesh) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BStCLoadMesh upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i2 = LBOUND(InData%BStCLoadMesh,2), UBOUND(InData%BStCLoadMesh,2) - DO i1 = LBOUND(InData%BStCLoadMesh,1), UBOUND(InData%BStCLoadMesh,1) - Int_BufSz = Int_BufSz + 3 ! BStCLoadMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%BStCLoadMesh(i1,i2), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! BStCLoadMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BStCLoadMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BStCLoadMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BStCLoadMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NStCLoadMesh allocated yes/no - IF ( ALLOCATED(InData%NStCLoadMesh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NStCLoadMesh upper/lower bounds for each dimension - DO i1 = LBOUND(InData%NStCLoadMesh,1), UBOUND(InData%NStCLoadMesh,1) - Int_BufSz = Int_BufSz + 3 ! NStCLoadMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%NStCLoadMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! NStCLoadMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NStCLoadMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NStCLoadMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NStCLoadMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! TStCLoadMesh allocated yes/no - IF ( ALLOCATED(InData%TStCLoadMesh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TStCLoadMesh upper/lower bounds for each dimension - DO i1 = LBOUND(InData%TStCLoadMesh,1), UBOUND(InData%TStCLoadMesh,1) - Int_BufSz = Int_BufSz + 3 ! TStCLoadMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%TStCLoadMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TStCLoadMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TStCLoadMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TStCLoadMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TStCLoadMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SStCLoadMesh allocated yes/no - IF ( ALLOCATED(InData%SStCLoadMesh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SStCLoadMesh upper/lower bounds for each dimension - DO i1 = LBOUND(InData%SStCLoadMesh,1), UBOUND(InData%SStCLoadMesh,1) - Int_BufSz = Int_BufSz + 3 ! SStCLoadMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%SStCLoadMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! SStCLoadMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SStCLoadMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SStCLoadMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SStCLoadMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! toSC allocated yes/no - IF ( ALLOCATED(InData%toSC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! toSC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%toSC) ! toSC - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) - ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlPitchCom) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlPitchCom,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitchCom,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlPitchCom,1), UBOUND(InData%BlPitchCom,1) - ReKiBuf(Re_Xferred) = InData%BlPitchCom(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BlAirfoilCom) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlAirfoilCom,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlAirfoilCom,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BlAirfoilCom,1), UBOUND(InData%BlAirfoilCom,1) - ReKiBuf(Re_Xferred) = InData%BlAirfoilCom(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%YawMom - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%GenTrq - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%HSSBrTrqC - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ElecPwr - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TBDrCon) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TBDrCon,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TBDrCon,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TBDrCon,1), UBOUND(InData%TBDrCon,1) - ReKiBuf(Re_Xferred) = InData%TBDrCon(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Lidar) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Lidar,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Lidar,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Lidar,1), UBOUND(InData%Lidar,1) - ReKiBuf(Re_Xferred) = InData%Lidar(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CableDeltaL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CableDeltaL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CableDeltaL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CableDeltaL,1), UBOUND(InData%CableDeltaL,1) - ReKiBuf(Re_Xferred) = InData%CableDeltaL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CableDeltaLdot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CableDeltaLdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CableDeltaLdot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CableDeltaLdot,1), UBOUND(InData%CableDeltaLdot,1) - ReKiBuf(Re_Xferred) = InData%CableDeltaLdot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BStCLoadMesh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BStCLoadMesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStCLoadMesh,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BStCLoadMesh,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BStCLoadMesh,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BStCLoadMesh,2), UBOUND(InData%BStCLoadMesh,2) - DO i1 = LBOUND(InData%BStCLoadMesh,1), UBOUND(InData%BStCLoadMesh,1) - CALL MeshPack( InData%BStCLoadMesh(i1,i2), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! BStCLoadMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NStCLoadMesh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NStCLoadMesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NStCLoadMesh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NStCLoadMesh,1), UBOUND(InData%NStCLoadMesh,1) - CALL MeshPack( InData%NStCLoadMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! NStCLoadMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TStCLoadMesh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TStCLoadMesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TStCLoadMesh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TStCLoadMesh,1), UBOUND(InData%TStCLoadMesh,1) - CALL MeshPack( InData%TStCLoadMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TStCLoadMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SStCLoadMesh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SStCLoadMesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SStCLoadMesh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SStCLoadMesh,1), UBOUND(InData%SStCLoadMesh,1) - CALL MeshPack( InData%SStCLoadMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! SStCLoadMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%toSC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%toSC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%toSC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%toSC,1), UBOUND(InData%toSC,1) - ReKiBuf(Re_Xferred) = InData%toSC(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SrvD_PackOutput - - SUBROUTINE SrvD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SrvD_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutput)) DEALLOCATE(OutData%WriteOutput) - ALLOCATE(OutData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) - OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitchCom not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlPitchCom)) DEALLOCATE(OutData%BlPitchCom) - ALLOCATE(OutData%BlPitchCom(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchCom.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlPitchCom,1), UBOUND(OutData%BlPitchCom,1) - OutData%BlPitchCom(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlAirfoilCom not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BlAirfoilCom)) DEALLOCATE(OutData%BlAirfoilCom) - ALLOCATE(OutData%BlAirfoilCom(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlAirfoilCom.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BlAirfoilCom,1), UBOUND(OutData%BlAirfoilCom,1) - OutData%BlAirfoilCom(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%YawMom = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%GenTrq = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%HSSBrTrqC = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ElecPwr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TBDrCon not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TBDrCon)) DEALLOCATE(OutData%TBDrCon) - ALLOCATE(OutData%TBDrCon(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TBDrCon.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TBDrCon,1), UBOUND(OutData%TBDrCon,1) - OutData%TBDrCon(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Lidar not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Lidar)) DEALLOCATE(OutData%Lidar) - ALLOCATE(OutData%Lidar(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Lidar.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Lidar,1), UBOUND(OutData%Lidar,1) - OutData%Lidar(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CableDeltaL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CableDeltaL)) DEALLOCATE(OutData%CableDeltaL) - ALLOCATE(OutData%CableDeltaL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableDeltaL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CableDeltaL,1), UBOUND(OutData%CableDeltaL,1) - OutData%CableDeltaL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CableDeltaLdot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CableDeltaLdot)) DEALLOCATE(OutData%CableDeltaLdot) - ALLOCATE(OutData%CableDeltaLdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableDeltaLdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CableDeltaLdot,1), UBOUND(OutData%CableDeltaLdot,1) - OutData%CableDeltaLdot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BStCLoadMesh not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BStCLoadMesh)) DEALLOCATE(OutData%BStCLoadMesh) - ALLOCATE(OutData%BStCLoadMesh(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStCLoadMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%BStCLoadMesh,2), UBOUND(OutData%BStCLoadMesh,2) - DO i1 = LBOUND(OutData%BStCLoadMesh,1), UBOUND(OutData%BStCLoadMesh,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%BStCLoadMesh(i1,i2), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! BStCLoadMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NStCLoadMesh not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NStCLoadMesh)) DEALLOCATE(OutData%NStCLoadMesh) - ALLOCATE(OutData%NStCLoadMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStCLoadMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NStCLoadMesh,1), UBOUND(OutData%NStCLoadMesh,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%NStCLoadMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! NStCLoadMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TStCLoadMesh not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TStCLoadMesh)) DEALLOCATE(OutData%TStCLoadMesh) - ALLOCATE(OutData%TStCLoadMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStCLoadMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TStCLoadMesh,1), UBOUND(OutData%TStCLoadMesh,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%TStCLoadMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TStCLoadMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SStCLoadMesh not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SStCLoadMesh)) DEALLOCATE(OutData%SStCLoadMesh) - ALLOCATE(OutData%SStCLoadMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStCLoadMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SStCLoadMesh,1), UBOUND(OutData%SStCLoadMesh,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%SStCLoadMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! SStCLoadMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! toSC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%toSC)) DEALLOCATE(OutData%toSC) - ALLOCATE(OutData%toSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%toSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%toSC,1), UBOUND(OutData%toSC,1) - OutData%toSC(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SrvD_UnPackOutput +subroutine SrvD_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackOutput' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + ! WriteOutput + call RegPack(Buf, allocated(InData%WriteOutput)) + if (allocated(InData%WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPack(Buf, InData%WriteOutput) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BlPitchCom + call RegPack(Buf, allocated(InData%BlPitchCom)) + if (allocated(InData%BlPitchCom)) then + call RegPackBounds(Buf, 1, lbound(InData%BlPitchCom), ubound(InData%BlPitchCom)) + call RegPack(Buf, InData%BlPitchCom) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BlAirfoilCom + call RegPack(Buf, allocated(InData%BlAirfoilCom)) + if (allocated(InData%BlAirfoilCom)) then + call RegPackBounds(Buf, 1, lbound(InData%BlAirfoilCom), ubound(InData%BlAirfoilCom)) + call RegPack(Buf, InData%BlAirfoilCom) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! YawMom + call RegPack(Buf, InData%YawMom) + if (RegCheckErr(Buf, RoutineName)) return + ! GenTrq + call RegPack(Buf, InData%GenTrq) + if (RegCheckErr(Buf, RoutineName)) return + ! HSSBrTrqC + call RegPack(Buf, InData%HSSBrTrqC) + if (RegCheckErr(Buf, RoutineName)) return + ! ElecPwr + call RegPack(Buf, InData%ElecPwr) + if (RegCheckErr(Buf, RoutineName)) return + ! TBDrCon + call RegPack(Buf, allocated(InData%TBDrCon)) + if (allocated(InData%TBDrCon)) then + call RegPackBounds(Buf, 1, lbound(InData%TBDrCon), ubound(InData%TBDrCon)) + call RegPack(Buf, InData%TBDrCon) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Lidar + call RegPack(Buf, allocated(InData%Lidar)) + if (allocated(InData%Lidar)) then + call RegPackBounds(Buf, 1, lbound(InData%Lidar), ubound(InData%Lidar)) + call RegPack(Buf, InData%Lidar) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CableDeltaL + call RegPack(Buf, allocated(InData%CableDeltaL)) + if (allocated(InData%CableDeltaL)) then + call RegPackBounds(Buf, 1, lbound(InData%CableDeltaL), ubound(InData%CableDeltaL)) + call RegPack(Buf, InData%CableDeltaL) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CableDeltaLdot + call RegPack(Buf, allocated(InData%CableDeltaLdot)) + if (allocated(InData%CableDeltaLdot)) then + call RegPackBounds(Buf, 1, lbound(InData%CableDeltaLdot), ubound(InData%CableDeltaLdot)) + call RegPack(Buf, InData%CableDeltaLdot) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! BStCLoadMesh + call RegPack(Buf, allocated(InData%BStCLoadMesh)) + if (allocated(InData%BStCLoadMesh)) then + call RegPackBounds(Buf, 2, lbound(InData%BStCLoadMesh), ubound(InData%BStCLoadMesh)) + LB(1:2) = lbound(InData%BStCLoadMesh) + UB(1:2) = ubound(InData%BStCLoadMesh) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%BStCLoadMesh(i1,i2)) + end do + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NStCLoadMesh + call RegPack(Buf, allocated(InData%NStCLoadMesh)) + if (allocated(InData%NStCLoadMesh)) then + call RegPackBounds(Buf, 1, lbound(InData%NStCLoadMesh), ubound(InData%NStCLoadMesh)) + LB(1:1) = lbound(InData%NStCLoadMesh) + UB(1:1) = ubound(InData%NStCLoadMesh) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%NStCLoadMesh(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TStCLoadMesh + call RegPack(Buf, allocated(InData%TStCLoadMesh)) + if (allocated(InData%TStCLoadMesh)) then + call RegPackBounds(Buf, 1, lbound(InData%TStCLoadMesh), ubound(InData%TStCLoadMesh)) + LB(1:1) = lbound(InData%TStCLoadMesh) + UB(1:1) = ubound(InData%TStCLoadMesh) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%TStCLoadMesh(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SStCLoadMesh + call RegPack(Buf, allocated(InData%SStCLoadMesh)) + if (allocated(InData%SStCLoadMesh)) then + call RegPackBounds(Buf, 1, lbound(InData%SStCLoadMesh), ubound(InData%SStCLoadMesh)) + LB(1:1) = lbound(InData%SStCLoadMesh) + UB(1:1) = ubound(InData%SStCLoadMesh) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%SStCLoadMesh(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! toSC + call RegPack(Buf, allocated(InData%toSC)) + if (allocated(InData%toSC)) then + call RegPackBounds(Buf, 1, lbound(InData%toSC), ubound(InData%toSC)) + call RegPack(Buf, InData%toSC) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SrvD_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SrvD_UnPackOutput' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! WriteOutput + if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BlPitchCom + if (allocated(OutData%BlPitchCom)) deallocate(OutData%BlPitchCom) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlPitchCom(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchCom.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlPitchCom) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BlAirfoilCom + if (allocated(OutData%BlAirfoilCom)) deallocate(OutData%BlAirfoilCom) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BlAirfoilCom(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlAirfoilCom.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%BlAirfoilCom) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! YawMom + call RegUnpack(Buf, OutData%YawMom) + if (RegCheckErr(Buf, RoutineName)) return + ! GenTrq + call RegUnpack(Buf, OutData%GenTrq) + if (RegCheckErr(Buf, RoutineName)) return + ! HSSBrTrqC + call RegUnpack(Buf, OutData%HSSBrTrqC) + if (RegCheckErr(Buf, RoutineName)) return + ! ElecPwr + call RegUnpack(Buf, OutData%ElecPwr) + if (RegCheckErr(Buf, RoutineName)) return + ! TBDrCon + if (allocated(OutData%TBDrCon)) deallocate(OutData%TBDrCon) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TBDrCon(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TBDrCon.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TBDrCon) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Lidar + if (allocated(OutData%Lidar)) deallocate(OutData%Lidar) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Lidar(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Lidar.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Lidar) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CableDeltaL + if (allocated(OutData%CableDeltaL)) deallocate(OutData%CableDeltaL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CableDeltaL(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableDeltaL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CableDeltaL) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CableDeltaLdot + if (allocated(OutData%CableDeltaLdot)) deallocate(OutData%CableDeltaLdot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CableDeltaLdot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableDeltaLdot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CableDeltaLdot) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! BStCLoadMesh + if (allocated(OutData%BStCLoadMesh)) deallocate(OutData%BStCLoadMesh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%BStCLoadMesh(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BStCLoadMesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%BStCLoadMesh(i1,i2)) ! BStCLoadMesh + end do + end do + end if + ! NStCLoadMesh + if (allocated(OutData%NStCLoadMesh)) deallocate(OutData%NStCLoadMesh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NStCLoadMesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NStCLoadMesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%NStCLoadMesh(i1)) ! NStCLoadMesh + end do + end if + ! TStCLoadMesh + if (allocated(OutData%TStCLoadMesh)) deallocate(OutData%TStCLoadMesh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TStCLoadMesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TStCLoadMesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%TStCLoadMesh(i1)) ! TStCLoadMesh + end do + end if + ! SStCLoadMesh + if (allocated(OutData%SStCLoadMesh)) deallocate(OutData%SStCLoadMesh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SStCLoadMesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SStCLoadMesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%SStCLoadMesh(i1)) ! SStCLoadMesh + end do + end if + ! toSC + if (allocated(OutData%toSC)) deallocate(OutData%toSC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%toSC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%toSC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%toSC) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE SrvD_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) ! diff --git a/modules/servodyn/src/StrucCtrl_Types.f90 b/modules/servodyn/src/StrucCtrl_Types.f90 index 5eb8655303..f82fb8c5d7 100644 --- a/modules/servodyn/src/StrucCtrl_Types.f90 +++ b/modules/servodyn/src/StrucCtrl_Types.f90 @@ -394,565 +394,467 @@ SUBROUTINE StC_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE StC_DestroyInputFile - SUBROUTINE StC_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(StC_InputFile), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_PackInputFile' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%StCFileName) ! StCFileName - Int_BufSz = Int_BufSz + 1 ! Echo - Int_BufSz = Int_BufSz + 1 ! StC_CMODE - Int_BufSz = Int_BufSz + 1 ! StC_SA_MODE - Int_BufSz = Int_BufSz + 1 ! StC_DOF_MODE - Int_BufSz = Int_BufSz + 1 ! StC_X_DOF - Int_BufSz = Int_BufSz + 1 ! StC_Y_DOF - Int_BufSz = Int_BufSz + 1 ! StC_Z_DOF - Re_BufSz = Re_BufSz + 1 ! StC_X_DSP - Re_BufSz = Re_BufSz + 1 ! StC_Y_DSP - Re_BufSz = Re_BufSz + 1 ! StC_Z_DSP - Int_BufSz = Int_BufSz + 1*LEN(InData%StC_Z_PreLdC) ! StC_Z_PreLdC - Re_BufSz = Re_BufSz + 1 ! StC_X_M - Re_BufSz = Re_BufSz + 1 ! StC_Y_M - Re_BufSz = Re_BufSz + 1 ! StC_Z_M - Re_BufSz = Re_BufSz + 1 ! StC_XY_M - Re_BufSz = Re_BufSz + 1 ! StC_X_K - Re_BufSz = Re_BufSz + 1 ! StC_Y_K - Re_BufSz = Re_BufSz + 1 ! StC_Z_K - Re_BufSz = Re_BufSz + 1 ! StC_X_C - Re_BufSz = Re_BufSz + 1 ! StC_Y_C - Re_BufSz = Re_BufSz + 1 ! StC_Z_C - Re_BufSz = Re_BufSz + 1 ! StC_X_PSP - Re_BufSz = Re_BufSz + 1 ! StC_X_NSP - Re_BufSz = Re_BufSz + 1 ! StC_Y_PSP - Re_BufSz = Re_BufSz + 1 ! StC_Y_NSP - Re_BufSz = Re_BufSz + 1 ! StC_Z_PSP - Re_BufSz = Re_BufSz + 1 ! StC_Z_NSP - Re_BufSz = Re_BufSz + 1 ! StC_X_KS - Re_BufSz = Re_BufSz + 1 ! StC_X_CS - Re_BufSz = Re_BufSz + 1 ! StC_Y_KS - Re_BufSz = Re_BufSz + 1 ! StC_Y_CS - Re_BufSz = Re_BufSz + 1 ! StC_Z_KS - Re_BufSz = Re_BufSz + 1 ! StC_Z_CS - Re_BufSz = Re_BufSz + 1 ! StC_P_X - Re_BufSz = Re_BufSz + 1 ! StC_P_Y - Re_BufSz = Re_BufSz + 1 ! StC_P_Z - Re_BufSz = Re_BufSz + 1 ! StC_X_C_HIGH - Re_BufSz = Re_BufSz + 1 ! StC_X_C_LOW - Re_BufSz = Re_BufSz + 1 ! StC_Y_C_HIGH - Re_BufSz = Re_BufSz + 1 ! StC_Y_C_LOW - Re_BufSz = Re_BufSz + 1 ! StC_Z_C_HIGH - Re_BufSz = Re_BufSz + 1 ! StC_Z_C_LOW - Re_BufSz = Re_BufSz + 1 ! StC_X_C_BRAKE - Re_BufSz = Re_BufSz + 1 ! StC_Y_C_BRAKE - Re_BufSz = Re_BufSz + 1 ! StC_Z_C_BRAKE - Re_BufSz = Re_BufSz + 1 ! L_X - Re_BufSz = Re_BufSz + 1 ! B_X - Re_BufSz = Re_BufSz + 1 ! area_X - Re_BufSz = Re_BufSz + 1 ! area_ratio_X - Re_BufSz = Re_BufSz + 1 ! headLossCoeff_X - Re_BufSz = Re_BufSz + 1 ! rho_X - Re_BufSz = Re_BufSz + 1 ! L_Y - Re_BufSz = Re_BufSz + 1 ! B_Y - Re_BufSz = Re_BufSz + 1 ! area_Y - Re_BufSz = Re_BufSz + 1 ! area_ratio_Y - Re_BufSz = Re_BufSz + 1 ! headLossCoeff_Y - Re_BufSz = Re_BufSz + 1 ! rho_Y - Int_BufSz = Int_BufSz + 1 ! USE_F_TBL - Int_BufSz = Int_BufSz + 1 ! NKInpSt - Int_BufSz = Int_BufSz + 1*LEN(InData%StC_F_TBL_FILE) ! StC_F_TBL_FILE - Int_BufSz = Int_BufSz + 1 ! F_TBL allocated yes/no - IF ( ALLOCATED(InData%F_TBL) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_TBL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_TBL) ! F_TBL - END IF - Int_BufSz = Int_BufSz + 1 ! PrescribedForcesCoordSys - Int_BufSz = Int_BufSz + 1*LEN(InData%PrescribedForcesFile) ! PrescribedForcesFile - Int_BufSz = Int_BufSz + 1 ! StC_PrescribedForce allocated yes/no - IF ( ALLOCATED(InData%StC_PrescribedForce) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StC_PrescribedForce upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StC_PrescribedForce) ! StC_PrescribedForce - END IF - Int_BufSz = Int_BufSz + 1 ! StC_CChan allocated yes/no - IF ( ALLOCATED(InData%StC_CChan) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! StC_CChan upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%StC_CChan) ! StC_CChan - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%StCFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%StCFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%Echo, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%StC_CMODE - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%StC_SA_MODE - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%StC_DOF_MODE - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%StC_X_DOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%StC_Y_DOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%StC_Z_DOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_X_DSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Y_DSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Z_DSP - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%StC_Z_PreLdC) - IntKiBuf(Int_Xferred) = ICHAR(InData%StC_Z_PreLdC(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf(Re_Xferred) = InData%StC_X_M - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Y_M - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Z_M - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_XY_M - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_X_K - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Y_K - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Z_K - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_X_C - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Y_C - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Z_C - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_X_PSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_X_NSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Y_PSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Y_NSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Z_PSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Z_NSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_X_KS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_X_CS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Y_KS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Y_CS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Z_KS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Z_CS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_P_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_P_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_P_Z - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_X_C_HIGH - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_X_C_LOW - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Y_C_HIGH - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Y_C_LOW - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Z_C_HIGH - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Z_C_LOW - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_X_C_BRAKE - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Y_C_BRAKE - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Z_C_BRAKE - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%L_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%B_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%area_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%area_ratio_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%headLossCoeff_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rho_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%L_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%B_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%area_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%area_ratio_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%headLossCoeff_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rho_Y - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%USE_F_TBL, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NKInpSt - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%StC_F_TBL_FILE) - IntKiBuf(Int_Xferred) = ICHAR(InData%StC_F_TBL_FILE(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%F_TBL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_TBL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_TBL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_TBL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_TBL,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_TBL,2), UBOUND(InData%F_TBL,2) - DO i1 = LBOUND(InData%F_TBL,1), UBOUND(InData%F_TBL,1) - ReKiBuf(Re_Xferred) = InData%F_TBL(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%PrescribedForcesCoordSys - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%PrescribedForcesFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%PrescribedForcesFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%StC_PrescribedForce) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StC_PrescribedForce,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StC_PrescribedForce,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StC_PrescribedForce,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StC_PrescribedForce,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%StC_PrescribedForce,2), UBOUND(InData%StC_PrescribedForce,2) - DO i1 = LBOUND(InData%StC_PrescribedForce,1), UBOUND(InData%StC_PrescribedForce,1) - ReKiBuf(Re_Xferred) = InData%StC_PrescribedForce(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StC_CChan) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StC_CChan,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StC_CChan,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%StC_CChan,1), UBOUND(InData%StC_CChan,1) - IntKiBuf(Int_Xferred) = InData%StC_CChan(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE StC_PackInputFile - - SUBROUTINE StC_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(StC_InputFile), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_UnPackInputFile' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%StCFileName) - OutData%StCFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Echo = TRANSFER(IntKiBuf(Int_Xferred), OutData%Echo) - Int_Xferred = Int_Xferred + 1 - OutData%StC_CMODE = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%StC_SA_MODE = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%StC_DOF_MODE = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%StC_X_DOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%StC_X_DOF) - Int_Xferred = Int_Xferred + 1 - OutData%StC_Y_DOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%StC_Y_DOF) - Int_Xferred = Int_Xferred + 1 - OutData%StC_Z_DOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%StC_Z_DOF) - Int_Xferred = Int_Xferred + 1 - OutData%StC_X_DSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Y_DSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Z_DSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%StC_Z_PreLdC) - OutData%StC_Z_PreLdC(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%StC_X_M = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Y_M = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Z_M = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_XY_M = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_X_K = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Y_K = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Z_K = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_X_C = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Y_C = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Z_C = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_X_PSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_X_NSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Y_PSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Y_NSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Z_PSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Z_NSP = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_X_KS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_X_CS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Y_KS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Y_CS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Z_KS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Z_CS = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_P_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_P_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_P_Z = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_X_C_HIGH = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_X_C_LOW = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Y_C_HIGH = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Y_C_LOW = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Z_C_HIGH = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Z_C_LOW = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_X_C_BRAKE = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Y_C_BRAKE = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Z_C_BRAKE = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%L_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%B_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%area_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%area_ratio_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%headLossCoeff_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rho_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%L_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%B_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%area_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%area_ratio_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%headLossCoeff_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rho_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%USE_F_TBL = TRANSFER(IntKiBuf(Int_Xferred), OutData%USE_F_TBL) - Int_Xferred = Int_Xferred + 1 - OutData%NKInpSt = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%StC_F_TBL_FILE) - OutData%StC_F_TBL_FILE(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_TBL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_TBL)) DEALLOCATE(OutData%F_TBL) - ALLOCATE(OutData%F_TBL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_TBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_TBL,2), UBOUND(OutData%F_TBL,2) - DO i1 = LBOUND(OutData%F_TBL,1), UBOUND(OutData%F_TBL,1) - OutData%F_TBL(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%PrescribedForcesCoordSys = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%PrescribedForcesFile) - OutData%PrescribedForcesFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StC_PrescribedForce not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%StC_PrescribedForce)) DEALLOCATE(OutData%StC_PrescribedForce) - ALLOCATE(OutData%StC_PrescribedForce(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StC_PrescribedForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%StC_PrescribedForce,2), UBOUND(OutData%StC_PrescribedForce,2) - DO i1 = LBOUND(OutData%StC_PrescribedForce,1), UBOUND(OutData%StC_PrescribedForce,1) - OutData%StC_PrescribedForce(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StC_CChan not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%StC_CChan)) DEALLOCATE(OutData%StC_CChan) - ALLOCATE(OutData%StC_CChan(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StC_CChan.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%StC_CChan,1), UBOUND(OutData%StC_CChan,1) - OutData%StC_CChan(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE StC_UnPackInputFile +subroutine StC_PackInputFile(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(StC_InputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'StC_PackInputFile' + if (Buf%ErrStat >= AbortErrLev) return + ! StCFileName + call RegPack(Buf, InData%StCFileName) + if (RegCheckErr(Buf, RoutineName)) return + ! Echo + call RegPack(Buf, InData%Echo) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_CMODE + call RegPack(Buf, InData%StC_CMODE) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_SA_MODE + call RegPack(Buf, InData%StC_SA_MODE) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_DOF_MODE + call RegPack(Buf, InData%StC_DOF_MODE) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_X_DOF + call RegPack(Buf, InData%StC_X_DOF) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Y_DOF + call RegPack(Buf, InData%StC_Y_DOF) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Z_DOF + call RegPack(Buf, InData%StC_Z_DOF) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_X_DSP + call RegPack(Buf, InData%StC_X_DSP) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Y_DSP + call RegPack(Buf, InData%StC_Y_DSP) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Z_DSP + call RegPack(Buf, InData%StC_Z_DSP) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Z_PreLdC + call RegPack(Buf, InData%StC_Z_PreLdC) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_X_M + call RegPack(Buf, InData%StC_X_M) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Y_M + call RegPack(Buf, InData%StC_Y_M) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Z_M + call RegPack(Buf, InData%StC_Z_M) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_XY_M + call RegPack(Buf, InData%StC_XY_M) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_X_K + call RegPack(Buf, InData%StC_X_K) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Y_K + call RegPack(Buf, InData%StC_Y_K) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Z_K + call RegPack(Buf, InData%StC_Z_K) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_X_C + call RegPack(Buf, InData%StC_X_C) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Y_C + call RegPack(Buf, InData%StC_Y_C) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Z_C + call RegPack(Buf, InData%StC_Z_C) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_X_PSP + call RegPack(Buf, InData%StC_X_PSP) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_X_NSP + call RegPack(Buf, InData%StC_X_NSP) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Y_PSP + call RegPack(Buf, InData%StC_Y_PSP) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Y_NSP + call RegPack(Buf, InData%StC_Y_NSP) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Z_PSP + call RegPack(Buf, InData%StC_Z_PSP) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Z_NSP + call RegPack(Buf, InData%StC_Z_NSP) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_X_KS + call RegPack(Buf, InData%StC_X_KS) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_X_CS + call RegPack(Buf, InData%StC_X_CS) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Y_KS + call RegPack(Buf, InData%StC_Y_KS) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Y_CS + call RegPack(Buf, InData%StC_Y_CS) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Z_KS + call RegPack(Buf, InData%StC_Z_KS) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Z_CS + call RegPack(Buf, InData%StC_Z_CS) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_P_X + call RegPack(Buf, InData%StC_P_X) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_P_Y + call RegPack(Buf, InData%StC_P_Y) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_P_Z + call RegPack(Buf, InData%StC_P_Z) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_X_C_HIGH + call RegPack(Buf, InData%StC_X_C_HIGH) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_X_C_LOW + call RegPack(Buf, InData%StC_X_C_LOW) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Y_C_HIGH + call RegPack(Buf, InData%StC_Y_C_HIGH) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Y_C_LOW + call RegPack(Buf, InData%StC_Y_C_LOW) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Z_C_HIGH + call RegPack(Buf, InData%StC_Z_C_HIGH) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Z_C_LOW + call RegPack(Buf, InData%StC_Z_C_LOW) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_X_C_BRAKE + call RegPack(Buf, InData%StC_X_C_BRAKE) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Y_C_BRAKE + call RegPack(Buf, InData%StC_Y_C_BRAKE) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Z_C_BRAKE + call RegPack(Buf, InData%StC_Z_C_BRAKE) + if (RegCheckErr(Buf, RoutineName)) return + ! L_X + call RegPack(Buf, InData%L_X) + if (RegCheckErr(Buf, RoutineName)) return + ! B_X + call RegPack(Buf, InData%B_X) + if (RegCheckErr(Buf, RoutineName)) return + ! area_X + call RegPack(Buf, InData%area_X) + if (RegCheckErr(Buf, RoutineName)) return + ! area_ratio_X + call RegPack(Buf, InData%area_ratio_X) + if (RegCheckErr(Buf, RoutineName)) return + ! headLossCoeff_X + call RegPack(Buf, InData%headLossCoeff_X) + if (RegCheckErr(Buf, RoutineName)) return + ! rho_X + call RegPack(Buf, InData%rho_X) + if (RegCheckErr(Buf, RoutineName)) return + ! L_Y + call RegPack(Buf, InData%L_Y) + if (RegCheckErr(Buf, RoutineName)) return + ! B_Y + call RegPack(Buf, InData%B_Y) + if (RegCheckErr(Buf, RoutineName)) return + ! area_Y + call RegPack(Buf, InData%area_Y) + if (RegCheckErr(Buf, RoutineName)) return + ! area_ratio_Y + call RegPack(Buf, InData%area_ratio_Y) + if (RegCheckErr(Buf, RoutineName)) return + ! headLossCoeff_Y + call RegPack(Buf, InData%headLossCoeff_Y) + if (RegCheckErr(Buf, RoutineName)) return + ! rho_Y + call RegPack(Buf, InData%rho_Y) + if (RegCheckErr(Buf, RoutineName)) return + ! USE_F_TBL + call RegPack(Buf, InData%USE_F_TBL) + if (RegCheckErr(Buf, RoutineName)) return + ! NKInpSt + call RegPack(Buf, InData%NKInpSt) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_F_TBL_FILE + call RegPack(Buf, InData%StC_F_TBL_FILE) + if (RegCheckErr(Buf, RoutineName)) return + ! F_TBL + call RegPack(Buf, allocated(InData%F_TBL)) + if (allocated(InData%F_TBL)) then + call RegPackBounds(Buf, 2, lbound(InData%F_TBL), ubound(InData%F_TBL)) + call RegPack(Buf, InData%F_TBL) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PrescribedForcesCoordSys + call RegPack(Buf, InData%PrescribedForcesCoordSys) + if (RegCheckErr(Buf, RoutineName)) return + ! PrescribedForcesFile + call RegPack(Buf, InData%PrescribedForcesFile) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_PrescribedForce + call RegPack(Buf, allocated(InData%StC_PrescribedForce)) + if (allocated(InData%StC_PrescribedForce)) then + call RegPackBounds(Buf, 2, lbound(InData%StC_PrescribedForce), ubound(InData%StC_PrescribedForce)) + call RegPack(Buf, InData%StC_PrescribedForce) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! StC_CChan + call RegPack(Buf, allocated(InData%StC_CChan)) + if (allocated(InData%StC_CChan)) then + call RegPackBounds(Buf, 1, lbound(InData%StC_CChan), ubound(InData%StC_CChan)) + call RegPack(Buf, InData%StC_CChan) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine StC_UnPackInputFile(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(StC_InputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'StC_UnPackInputFile' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! StCFileName + call RegUnpack(Buf, OutData%StCFileName) + if (RegCheckErr(Buf, RoutineName)) return + ! Echo + call RegUnpack(Buf, OutData%Echo) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_CMODE + call RegUnpack(Buf, OutData%StC_CMODE) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_SA_MODE + call RegUnpack(Buf, OutData%StC_SA_MODE) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_DOF_MODE + call RegUnpack(Buf, OutData%StC_DOF_MODE) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_X_DOF + call RegUnpack(Buf, OutData%StC_X_DOF) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Y_DOF + call RegUnpack(Buf, OutData%StC_Y_DOF) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Z_DOF + call RegUnpack(Buf, OutData%StC_Z_DOF) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_X_DSP + call RegUnpack(Buf, OutData%StC_X_DSP) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Y_DSP + call RegUnpack(Buf, OutData%StC_Y_DSP) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Z_DSP + call RegUnpack(Buf, OutData%StC_Z_DSP) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Z_PreLdC + call RegUnpack(Buf, OutData%StC_Z_PreLdC) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_X_M + call RegUnpack(Buf, OutData%StC_X_M) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Y_M + call RegUnpack(Buf, OutData%StC_Y_M) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Z_M + call RegUnpack(Buf, OutData%StC_Z_M) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_XY_M + call RegUnpack(Buf, OutData%StC_XY_M) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_X_K + call RegUnpack(Buf, OutData%StC_X_K) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Y_K + call RegUnpack(Buf, OutData%StC_Y_K) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Z_K + call RegUnpack(Buf, OutData%StC_Z_K) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_X_C + call RegUnpack(Buf, OutData%StC_X_C) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Y_C + call RegUnpack(Buf, OutData%StC_Y_C) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Z_C + call RegUnpack(Buf, OutData%StC_Z_C) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_X_PSP + call RegUnpack(Buf, OutData%StC_X_PSP) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_X_NSP + call RegUnpack(Buf, OutData%StC_X_NSP) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Y_PSP + call RegUnpack(Buf, OutData%StC_Y_PSP) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Y_NSP + call RegUnpack(Buf, OutData%StC_Y_NSP) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Z_PSP + call RegUnpack(Buf, OutData%StC_Z_PSP) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Z_NSP + call RegUnpack(Buf, OutData%StC_Z_NSP) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_X_KS + call RegUnpack(Buf, OutData%StC_X_KS) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_X_CS + call RegUnpack(Buf, OutData%StC_X_CS) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Y_KS + call RegUnpack(Buf, OutData%StC_Y_KS) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Y_CS + call RegUnpack(Buf, OutData%StC_Y_CS) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Z_KS + call RegUnpack(Buf, OutData%StC_Z_KS) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Z_CS + call RegUnpack(Buf, OutData%StC_Z_CS) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_P_X + call RegUnpack(Buf, OutData%StC_P_X) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_P_Y + call RegUnpack(Buf, OutData%StC_P_Y) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_P_Z + call RegUnpack(Buf, OutData%StC_P_Z) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_X_C_HIGH + call RegUnpack(Buf, OutData%StC_X_C_HIGH) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_X_C_LOW + call RegUnpack(Buf, OutData%StC_X_C_LOW) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Y_C_HIGH + call RegUnpack(Buf, OutData%StC_Y_C_HIGH) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Y_C_LOW + call RegUnpack(Buf, OutData%StC_Y_C_LOW) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Z_C_HIGH + call RegUnpack(Buf, OutData%StC_Z_C_HIGH) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Z_C_LOW + call RegUnpack(Buf, OutData%StC_Z_C_LOW) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_X_C_BRAKE + call RegUnpack(Buf, OutData%StC_X_C_BRAKE) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Y_C_BRAKE + call RegUnpack(Buf, OutData%StC_Y_C_BRAKE) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Z_C_BRAKE + call RegUnpack(Buf, OutData%StC_Z_C_BRAKE) + if (RegCheckErr(Buf, RoutineName)) return + ! L_X + call RegUnpack(Buf, OutData%L_X) + if (RegCheckErr(Buf, RoutineName)) return + ! B_X + call RegUnpack(Buf, OutData%B_X) + if (RegCheckErr(Buf, RoutineName)) return + ! area_X + call RegUnpack(Buf, OutData%area_X) + if (RegCheckErr(Buf, RoutineName)) return + ! area_ratio_X + call RegUnpack(Buf, OutData%area_ratio_X) + if (RegCheckErr(Buf, RoutineName)) return + ! headLossCoeff_X + call RegUnpack(Buf, OutData%headLossCoeff_X) + if (RegCheckErr(Buf, RoutineName)) return + ! rho_X + call RegUnpack(Buf, OutData%rho_X) + if (RegCheckErr(Buf, RoutineName)) return + ! L_Y + call RegUnpack(Buf, OutData%L_Y) + if (RegCheckErr(Buf, RoutineName)) return + ! B_Y + call RegUnpack(Buf, OutData%B_Y) + if (RegCheckErr(Buf, RoutineName)) return + ! area_Y + call RegUnpack(Buf, OutData%area_Y) + if (RegCheckErr(Buf, RoutineName)) return + ! area_ratio_Y + call RegUnpack(Buf, OutData%area_ratio_Y) + if (RegCheckErr(Buf, RoutineName)) return + ! headLossCoeff_Y + call RegUnpack(Buf, OutData%headLossCoeff_Y) + if (RegCheckErr(Buf, RoutineName)) return + ! rho_Y + call RegUnpack(Buf, OutData%rho_Y) + if (RegCheckErr(Buf, RoutineName)) return + ! USE_F_TBL + call RegUnpack(Buf, OutData%USE_F_TBL) + if (RegCheckErr(Buf, RoutineName)) return + ! NKInpSt + call RegUnpack(Buf, OutData%NKInpSt) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_F_TBL_FILE + call RegUnpack(Buf, OutData%StC_F_TBL_FILE) + if (RegCheckErr(Buf, RoutineName)) return + ! F_TBL + if (allocated(OutData%F_TBL)) deallocate(OutData%F_TBL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_TBL(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_TBL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_TBL) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PrescribedForcesCoordSys + call RegUnpack(Buf, OutData%PrescribedForcesCoordSys) + if (RegCheckErr(Buf, RoutineName)) return + ! PrescribedForcesFile + call RegUnpack(Buf, OutData%PrescribedForcesFile) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_PrescribedForce + if (allocated(OutData%StC_PrescribedForce)) deallocate(OutData%StC_PrescribedForce) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StC_PrescribedForce(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StC_PrescribedForce.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StC_PrescribedForce) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! StC_CChan + if (allocated(OutData%StC_CChan)) deallocate(OutData%StC_CChan) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StC_CChan(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StC_CChan.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StC_CChan) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE StC_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(StC_InitInputType), INTENT(IN) :: SrcInitInputData TYPE(StC_InitInputType), INTENT(INOUT) :: DstInitInputData @@ -1075,528 +977,157 @@ SUBROUTINE StC_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE StC_DestroyInitInput - SUBROUTINE StC_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(StC_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%InputFile) ! InputFile - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Re_BufSz = Re_BufSz + SIZE(InData%Gravity) ! Gravity - Int_BufSz = Int_BufSz + 1 ! NumMeshPts - Int_BufSz = Int_BufSz + 1 ! InitRefPos allocated yes/no - IF ( ALLOCATED(InData%InitRefPos) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! InitRefPos upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%InitRefPos) ! InitRefPos - END IF - Int_BufSz = Int_BufSz + 1 ! InitTransDisp allocated yes/no - IF ( ALLOCATED(InData%InitTransDisp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! InitTransDisp upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InitTransDisp) ! InitTransDisp - END IF - Int_BufSz = Int_BufSz + 1 ! InitOrient allocated yes/no - IF ( ALLOCATED(InData%InitOrient) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! InitOrient upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InitOrient) ! InitOrient - END IF - Int_BufSz = Int_BufSz + 1 ! InitRefOrient allocated yes/no - IF ( ALLOCATED(InData%InitRefOrient) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! InitRefOrient upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InitRefOrient) ! InitRefOrient - END IF - Int_BufSz = Int_BufSz + 1 ! UseInputFile - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! PassedPrimaryInputData: size of buffers for each call to pack subtype - CALL NWTC_Library_PackFileInfoType( Re_Buf, Db_Buf, Int_Buf, InData%PassedPrimaryInputData, ErrStat2, ErrMsg2, .TRUE. ) ! PassedPrimaryInputData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PassedPrimaryInputData - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PassedPrimaryInputData - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PassedPrimaryInputData - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! UseInputFile_PrescribeFrc - Int_BufSz = Int_BufSz + 3 ! PassedPrescribeFrcData: size of buffers for each call to pack subtype - CALL NWTC_Library_PackFileInfoType( Re_Buf, Db_Buf, Int_Buf, InData%PassedPrescribeFrcData, ErrStat2, ErrMsg2, .TRUE. ) ! PassedPrescribeFrcData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! PassedPrescribeFrcData - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! PassedPrescribeFrcData - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! PassedPrescribeFrcData - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO i1 = LBOUND(InData%Gravity,1), UBOUND(InData%Gravity,1) - ReKiBuf(Re_Xferred) = InData%Gravity(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%NumMeshPts - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%InitRefPos) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitRefPos,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitRefPos,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitRefPos,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitRefPos,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%InitRefPos,2), UBOUND(InData%InitRefPos,2) - DO i1 = LBOUND(InData%InitRefPos,1), UBOUND(InData%InitRefPos,1) - ReKiBuf(Re_Xferred) = InData%InitRefPos(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InitTransDisp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitTransDisp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitTransDisp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitTransDisp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitTransDisp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%InitTransDisp,2), UBOUND(InData%InitTransDisp,2) - DO i1 = LBOUND(InData%InitTransDisp,1), UBOUND(InData%InitTransDisp,1) - DbKiBuf(Db_Xferred) = InData%InitTransDisp(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InitOrient) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitOrient,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitOrient,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitOrient,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitOrient,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitOrient,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitOrient,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%InitOrient,3), UBOUND(InData%InitOrient,3) - DO i2 = LBOUND(InData%InitOrient,2), UBOUND(InData%InitOrient,2) - DO i1 = LBOUND(InData%InitOrient,1), UBOUND(InData%InitOrient,1) - DbKiBuf(Db_Xferred) = InData%InitOrient(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InitRefOrient) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitRefOrient,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitRefOrient,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitRefOrient,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitRefOrient,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitRefOrient,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitRefOrient,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%InitRefOrient,3), UBOUND(InData%InitRefOrient,3) - DO i2 = LBOUND(InData%InitRefOrient,2), UBOUND(InData%InitRefOrient,2) - DO i1 = LBOUND(InData%InitRefOrient,1), UBOUND(InData%InitRefOrient,1) - DbKiBuf(Db_Xferred) = InData%InitRefOrient(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseInputFile, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - CALL NWTC_Library_PackFileInfoType( Re_Buf, Db_Buf, Int_Buf, InData%PassedPrimaryInputData, ErrStat2, ErrMsg2, OnlySize ) ! PassedPrimaryInputData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = TRANSFER(InData%UseInputFile_PrescribeFrc, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - CALL NWTC_Library_PackFileInfoType( Re_Buf, Db_Buf, Int_Buf, InData%PassedPrescribeFrcData, ErrStat2, ErrMsg2, OnlySize ) ! PassedPrescribeFrcData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE StC_PackInitInput - - SUBROUTINE StC_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(StC_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - i1_l = LBOUND(OutData%Gravity,1) - i1_u = UBOUND(OutData%Gravity,1) - DO i1 = LBOUND(OutData%Gravity,1), UBOUND(OutData%Gravity,1) - OutData%Gravity(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%NumMeshPts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InitRefPos not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InitRefPos)) DEALLOCATE(OutData%InitRefPos) - ALLOCATE(OutData%InitRefPos(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitRefPos.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%InitRefPos,2), UBOUND(OutData%InitRefPos,2) - DO i1 = LBOUND(OutData%InitRefPos,1), UBOUND(OutData%InitRefPos,1) - OutData%InitRefPos(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InitTransDisp not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InitTransDisp)) DEALLOCATE(OutData%InitTransDisp) - ALLOCATE(OutData%InitTransDisp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitTransDisp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%InitTransDisp,2), UBOUND(OutData%InitTransDisp,2) - DO i1 = LBOUND(OutData%InitTransDisp,1), UBOUND(OutData%InitTransDisp,1) - OutData%InitTransDisp(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InitOrient not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InitOrient)) DEALLOCATE(OutData%InitOrient) - ALLOCATE(OutData%InitOrient(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitOrient.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%InitOrient,3), UBOUND(OutData%InitOrient,3) - DO i2 = LBOUND(OutData%InitOrient,2), UBOUND(OutData%InitOrient,2) - DO i1 = LBOUND(OutData%InitOrient,1), UBOUND(OutData%InitOrient,1) - OutData%InitOrient(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InitRefOrient not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InitRefOrient)) DEALLOCATE(OutData%InitRefOrient) - ALLOCATE(OutData%InitRefOrient(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitRefOrient.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%InitRefOrient,3), UBOUND(OutData%InitRefOrient,3) - DO i2 = LBOUND(OutData%InitRefOrient,2), UBOUND(OutData%InitRefOrient,2) - DO i1 = LBOUND(OutData%InitRefOrient,1), UBOUND(OutData%InitRefOrient,1) - OutData%InitRefOrient(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - OutData%UseInputFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseInputFile) - Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackFileInfoType( Re_Buf, Db_Buf, Int_Buf, OutData%PassedPrimaryInputData, ErrStat2, ErrMsg2 ) ! PassedPrimaryInputData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%UseInputFile_PrescribeFrc = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseInputFile_PrescribeFrc) - Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackFileInfoType( Re_Buf, Db_Buf, Int_Buf, OutData%PassedPrescribeFrcData, ErrStat2, ErrMsg2 ) ! PassedPrescribeFrcData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE StC_UnPackInitInput +subroutine StC_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(StC_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'StC_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + ! InputFile + call RegPack(Buf, InData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegPack(Buf, InData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! Gravity + call RegPack(Buf, InData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + ! NumMeshPts + call RegPack(Buf, InData%NumMeshPts) + if (RegCheckErr(Buf, RoutineName)) return + ! InitRefPos + call RegPack(Buf, allocated(InData%InitRefPos)) + if (allocated(InData%InitRefPos)) then + call RegPackBounds(Buf, 2, lbound(InData%InitRefPos), ubound(InData%InitRefPos)) + call RegPack(Buf, InData%InitRefPos) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! InitTransDisp + call RegPack(Buf, allocated(InData%InitTransDisp)) + if (allocated(InData%InitTransDisp)) then + call RegPackBounds(Buf, 2, lbound(InData%InitTransDisp), ubound(InData%InitTransDisp)) + call RegPack(Buf, InData%InitTransDisp) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! InitOrient + call RegPack(Buf, allocated(InData%InitOrient)) + if (allocated(InData%InitOrient)) then + call RegPackBounds(Buf, 3, lbound(InData%InitOrient), ubound(InData%InitOrient)) + call RegPack(Buf, InData%InitOrient) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! InitRefOrient + call RegPack(Buf, allocated(InData%InitRefOrient)) + if (allocated(InData%InitRefOrient)) then + call RegPackBounds(Buf, 3, lbound(InData%InitRefOrient), ubound(InData%InitRefOrient)) + call RegPack(Buf, InData%InitRefOrient) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! UseInputFile + call RegPack(Buf, InData%UseInputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! PassedPrimaryInputData + call NWTC_Library_PackFileInfoType(Buf, InData%PassedPrimaryInputData) + if (RegCheckErr(Buf, RoutineName)) return + ! UseInputFile_PrescribeFrc + call RegPack(Buf, InData%UseInputFile_PrescribeFrc) + if (RegCheckErr(Buf, RoutineName)) return + ! PassedPrescribeFrcData + call NWTC_Library_PackFileInfoType(Buf, InData%PassedPrescribeFrcData) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine StC_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(StC_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'StC_UnPackInitInput' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! InputFile + call RegUnpack(Buf, OutData%InputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! Gravity + call RegUnpack(Buf, OutData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + ! NumMeshPts + call RegUnpack(Buf, OutData%NumMeshPts) + if (RegCheckErr(Buf, RoutineName)) return + ! InitRefPos + if (allocated(OutData%InitRefPos)) deallocate(OutData%InitRefPos) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InitRefPos(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitRefPos.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InitRefPos) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! InitTransDisp + if (allocated(OutData%InitTransDisp)) deallocate(OutData%InitTransDisp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InitTransDisp(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitTransDisp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InitTransDisp) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! InitOrient + if (allocated(OutData%InitOrient)) deallocate(OutData%InitOrient) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InitOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitOrient.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InitOrient) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! InitRefOrient + if (allocated(OutData%InitRefOrient)) deallocate(OutData%InitRefOrient) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InitRefOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitRefOrient.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InitRefOrient) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! UseInputFile + call RegUnpack(Buf, OutData%UseInputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! PassedPrimaryInputData + call NWTC_Library_UnpackFileInfoType(Buf, OutData%PassedPrimaryInputData) ! PassedPrimaryInputData + ! UseInputFile_PrescribeFrc + call RegUnpack(Buf, OutData%UseInputFile_PrescribeFrc) + if (RegCheckErr(Buf, RoutineName)) return + ! PassedPrescribeFrcData + call NWTC_Library_UnpackFileInfoType(Buf, OutData%PassedPrescribeFrcData) ! PassedPrescribeFrcData +end subroutine SUBROUTINE StC_CopyCtrlChanInitInfoType( SrcCtrlChanInitInfoTypeData, DstCtrlChanInitInfoTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(StC_CtrlChanInitInfoType), INTENT(IN) :: SrcCtrlChanInitInfoTypeData TYPE(StC_CtrlChanInitInfoType), INTENT(INOUT) :: DstCtrlChanInitInfoTypeData @@ -1747,430 +1278,177 @@ SUBROUTINE StC_DestroyCtrlChanInitInfoType( CtrlChanInitInfoTypeData, ErrStat, E ENDIF END SUBROUTINE StC_DestroyCtrlChanInitInfoType - SUBROUTINE StC_PackCtrlChanInitInfoType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(StC_CtrlChanInitInfoType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_PackCtrlChanInitInfoType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! Requestor allocated yes/no - IF ( ALLOCATED(InData%Requestor) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Requestor upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Requestor)*LEN(InData%Requestor) ! Requestor - END IF - Int_BufSz = Int_BufSz + 1 ! InitStiff allocated yes/no - IF ( ALLOCATED(InData%InitStiff) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! InitStiff upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%InitStiff) ! InitStiff - END IF - Int_BufSz = Int_BufSz + 1 ! InitDamp allocated yes/no - IF ( ALLOCATED(InData%InitDamp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! InitDamp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%InitDamp) ! InitDamp - END IF - Int_BufSz = Int_BufSz + 1 ! InitBrake allocated yes/no - IF ( ALLOCATED(InData%InitBrake) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! InitBrake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%InitBrake) ! InitBrake - END IF - Int_BufSz = Int_BufSz + 1 ! InitForce allocated yes/no - IF ( ALLOCATED(InData%InitForce) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! InitForce upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%InitForce) ! InitForce - END IF - Int_BufSz = Int_BufSz + 1 ! InitMeasDisp allocated yes/no - IF ( ALLOCATED(InData%InitMeasDisp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! InitMeasDisp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%InitMeasDisp) ! InitMeasDisp - END IF - Int_BufSz = Int_BufSz + 1 ! InitMeasVel allocated yes/no - IF ( ALLOCATED(InData%InitMeasVel) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! InitMeasVel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%InitMeasVel) ! InitMeasVel - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%Requestor) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Requestor,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Requestor,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Requestor,1), UBOUND(InData%Requestor,1) - DO I = 1, LEN(InData%Requestor) - IntKiBuf(Int_Xferred) = ICHAR(InData%Requestor(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InitStiff) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitStiff,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitStiff,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitStiff,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitStiff,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%InitStiff,2), UBOUND(InData%InitStiff,2) - DO i1 = LBOUND(InData%InitStiff,1), UBOUND(InData%InitStiff,1) - ReKiBuf(Re_Xferred) = InData%InitStiff(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InitDamp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitDamp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitDamp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitDamp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitDamp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%InitDamp,2), UBOUND(InData%InitDamp,2) - DO i1 = LBOUND(InData%InitDamp,1), UBOUND(InData%InitDamp,1) - ReKiBuf(Re_Xferred) = InData%InitDamp(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InitBrake) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitBrake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitBrake,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitBrake,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitBrake,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%InitBrake,2), UBOUND(InData%InitBrake,2) - DO i1 = LBOUND(InData%InitBrake,1), UBOUND(InData%InitBrake,1) - ReKiBuf(Re_Xferred) = InData%InitBrake(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InitForce) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitForce,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitForce,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitForce,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitForce,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%InitForce,2), UBOUND(InData%InitForce,2) - DO i1 = LBOUND(InData%InitForce,1), UBOUND(InData%InitForce,1) - ReKiBuf(Re_Xferred) = InData%InitForce(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InitMeasDisp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitMeasDisp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitMeasDisp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitMeasDisp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitMeasDisp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%InitMeasDisp,2), UBOUND(InData%InitMeasDisp,2) - DO i1 = LBOUND(InData%InitMeasDisp,1), UBOUND(InData%InitMeasDisp,1) - ReKiBuf(Re_Xferred) = InData%InitMeasDisp(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InitMeasVel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitMeasVel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitMeasVel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InitMeasVel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitMeasVel,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%InitMeasVel,2), UBOUND(InData%InitMeasVel,2) - DO i1 = LBOUND(InData%InitMeasVel,1), UBOUND(InData%InitMeasVel,1) - ReKiBuf(Re_Xferred) = InData%InitMeasVel(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE StC_PackCtrlChanInitInfoType - - SUBROUTINE StC_UnPackCtrlChanInitInfoType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(StC_CtrlChanInitInfoType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_UnPackCtrlChanInitInfoType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Requestor not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Requestor)) DEALLOCATE(OutData%Requestor) - ALLOCATE(OutData%Requestor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Requestor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Requestor,1), UBOUND(OutData%Requestor,1) - DO I = 1, LEN(OutData%Requestor) - OutData%Requestor(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InitStiff not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InitStiff)) DEALLOCATE(OutData%InitStiff) - ALLOCATE(OutData%InitStiff(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%InitStiff,2), UBOUND(OutData%InitStiff,2) - DO i1 = LBOUND(OutData%InitStiff,1), UBOUND(OutData%InitStiff,1) - OutData%InitStiff(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InitDamp not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InitDamp)) DEALLOCATE(OutData%InitDamp) - ALLOCATE(OutData%InitDamp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitDamp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%InitDamp,2), UBOUND(OutData%InitDamp,2) - DO i1 = LBOUND(OutData%InitDamp,1), UBOUND(OutData%InitDamp,1) - OutData%InitDamp(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InitBrake not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InitBrake)) DEALLOCATE(OutData%InitBrake) - ALLOCATE(OutData%InitBrake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitBrake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%InitBrake,2), UBOUND(OutData%InitBrake,2) - DO i1 = LBOUND(OutData%InitBrake,1), UBOUND(OutData%InitBrake,1) - OutData%InitBrake(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InitForce not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InitForce)) DEALLOCATE(OutData%InitForce) - ALLOCATE(OutData%InitForce(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%InitForce,2), UBOUND(OutData%InitForce,2) - DO i1 = LBOUND(OutData%InitForce,1), UBOUND(OutData%InitForce,1) - OutData%InitForce(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InitMeasDisp not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InitMeasDisp)) DEALLOCATE(OutData%InitMeasDisp) - ALLOCATE(OutData%InitMeasDisp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitMeasDisp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%InitMeasDisp,2), UBOUND(OutData%InitMeasDisp,2) - DO i1 = LBOUND(OutData%InitMeasDisp,1), UBOUND(OutData%InitMeasDisp,1) - OutData%InitMeasDisp(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InitMeasVel not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InitMeasVel)) DEALLOCATE(OutData%InitMeasVel) - ALLOCATE(OutData%InitMeasVel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitMeasVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%InitMeasVel,2), UBOUND(OutData%InitMeasVel,2) - DO i1 = LBOUND(OutData%InitMeasVel,1), UBOUND(OutData%InitMeasVel,1) - OutData%InitMeasVel(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE StC_UnPackCtrlChanInitInfoType +subroutine StC_PackCtrlChanInitInfoType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(StC_CtrlChanInitInfoType), intent(in) :: InData + character(*), parameter :: RoutineName = 'StC_PackCtrlChanInitInfoType' + if (Buf%ErrStat >= AbortErrLev) return + ! Requestor + call RegPack(Buf, allocated(InData%Requestor)) + if (allocated(InData%Requestor)) then + call RegPackBounds(Buf, 1, lbound(InData%Requestor), ubound(InData%Requestor)) + call RegPack(Buf, InData%Requestor) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! InitStiff + call RegPack(Buf, allocated(InData%InitStiff)) + if (allocated(InData%InitStiff)) then + call RegPackBounds(Buf, 2, lbound(InData%InitStiff), ubound(InData%InitStiff)) + call RegPack(Buf, InData%InitStiff) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! InitDamp + call RegPack(Buf, allocated(InData%InitDamp)) + if (allocated(InData%InitDamp)) then + call RegPackBounds(Buf, 2, lbound(InData%InitDamp), ubound(InData%InitDamp)) + call RegPack(Buf, InData%InitDamp) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! InitBrake + call RegPack(Buf, allocated(InData%InitBrake)) + if (allocated(InData%InitBrake)) then + call RegPackBounds(Buf, 2, lbound(InData%InitBrake), ubound(InData%InitBrake)) + call RegPack(Buf, InData%InitBrake) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! InitForce + call RegPack(Buf, allocated(InData%InitForce)) + if (allocated(InData%InitForce)) then + call RegPackBounds(Buf, 2, lbound(InData%InitForce), ubound(InData%InitForce)) + call RegPack(Buf, InData%InitForce) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! InitMeasDisp + call RegPack(Buf, allocated(InData%InitMeasDisp)) + if (allocated(InData%InitMeasDisp)) then + call RegPackBounds(Buf, 2, lbound(InData%InitMeasDisp), ubound(InData%InitMeasDisp)) + call RegPack(Buf, InData%InitMeasDisp) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! InitMeasVel + call RegPack(Buf, allocated(InData%InitMeasVel)) + if (allocated(InData%InitMeasVel)) then + call RegPackBounds(Buf, 2, lbound(InData%InitMeasVel), ubound(InData%InitMeasVel)) + call RegPack(Buf, InData%InitMeasVel) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine StC_UnPackCtrlChanInitInfoType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(StC_CtrlChanInitInfoType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'StC_UnPackCtrlChanInitInfoType' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! Requestor + if (allocated(OutData%Requestor)) deallocate(OutData%Requestor) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Requestor(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Requestor.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Requestor) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! InitStiff + if (allocated(OutData%InitStiff)) deallocate(OutData%InitStiff) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InitStiff(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitStiff.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InitStiff) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! InitDamp + if (allocated(OutData%InitDamp)) deallocate(OutData%InitDamp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InitDamp(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitDamp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InitDamp) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! InitBrake + if (allocated(OutData%InitBrake)) deallocate(OutData%InitBrake) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InitBrake(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitBrake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InitBrake) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! InitForce + if (allocated(OutData%InitForce)) deallocate(OutData%InitForce) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InitForce(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitForce.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InitForce) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! InitMeasDisp + if (allocated(OutData%InitMeasDisp)) deallocate(OutData%InitMeasDisp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InitMeasDisp(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitMeasDisp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InitMeasDisp) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! InitMeasVel + if (allocated(OutData%InitMeasVel)) deallocate(OutData%InitMeasVel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%InitMeasVel(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitMeasVel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%InitMeasVel) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE StC_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(StC_InitOutputType), INTENT(IN) :: SrcInitOutputData TYPE(StC_InitOutputType), INTENT(INOUT) :: DstInitOutputData @@ -2221,148 +1499,45 @@ SUBROUTINE StC_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE StC_DestroyInitOutput - SUBROUTINE StC_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(StC_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! RelPosition allocated yes/no - IF ( ALLOCATED(InData%RelPosition) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! RelPosition upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%RelPosition) ! RelPosition - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%RelPosition) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RelPosition,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RelPosition,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RelPosition,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RelPosition,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%RelPosition,2), UBOUND(InData%RelPosition,2) - DO i1 = LBOUND(InData%RelPosition,1), UBOUND(InData%RelPosition,1) - ReKiBuf(Re_Xferred) = InData%RelPosition(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE StC_PackInitOutput - - SUBROUTINE StC_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(StC_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RelPosition not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RelPosition)) DEALLOCATE(OutData%RelPosition) - ALLOCATE(OutData%RelPosition(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RelPosition.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%RelPosition,2), UBOUND(OutData%RelPosition,2) - DO i1 = LBOUND(OutData%RelPosition,1), UBOUND(OutData%RelPosition,1) - OutData%RelPosition(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE StC_UnPackInitOutput +subroutine StC_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(StC_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'StC_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! RelPosition + call RegPack(Buf, allocated(InData%RelPosition)) + if (allocated(InData%RelPosition)) then + call RegPackBounds(Buf, 2, lbound(InData%RelPosition), ubound(InData%RelPosition)) + call RegPack(Buf, InData%RelPosition) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine StC_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(StC_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'StC_UnPackInitOutput' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! RelPosition + if (allocated(OutData%RelPosition)) deallocate(OutData%RelPosition) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RelPosition(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RelPosition.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RelPosition) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE StC_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(StC_ContinuousStateType), INTENT(IN) :: SrcContStateData TYPE(StC_ContinuousStateType), INTENT(INOUT) :: DstContStateData @@ -2413,148 +1588,45 @@ SUBROUTINE StC_DestroyContState( ContStateData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE StC_DestroyContState - SUBROUTINE StC_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(StC_ContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_PackContState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! StC_x allocated yes/no - IF ( ALLOCATED(InData%StC_x) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StC_x upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StC_x) ! StC_x - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%StC_x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StC_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StC_x,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StC_x,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StC_x,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%StC_x,2), UBOUND(InData%StC_x,2) - DO i1 = LBOUND(InData%StC_x,1), UBOUND(InData%StC_x,1) - ReKiBuf(Re_Xferred) = InData%StC_x(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE StC_PackContState - - SUBROUTINE StC_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(StC_ContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_UnPackContState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StC_x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%StC_x)) DEALLOCATE(OutData%StC_x) - ALLOCATE(OutData%StC_x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StC_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%StC_x,2), UBOUND(OutData%StC_x,2) - DO i1 = LBOUND(OutData%StC_x,1), UBOUND(OutData%StC_x,1) - OutData%StC_x(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE StC_UnPackContState +subroutine StC_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(StC_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'StC_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + ! StC_x + call RegPack(Buf, allocated(InData%StC_x)) + if (allocated(InData%StC_x)) then + call RegPackBounds(Buf, 2, lbound(InData%StC_x), ubound(InData%StC_x)) + call RegPack(Buf, InData%StC_x) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine StC_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(StC_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'StC_UnPackContState' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! StC_x + if (allocated(OutData%StC_x)) deallocate(OutData%StC_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StC_x(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StC_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StC_x) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE StC_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(StC_DiscreteStateType), INTENT(IN) :: SrcDiscStateData TYPE(StC_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData @@ -2587,103 +1659,26 @@ SUBROUTINE StC_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) END SUBROUTINE StC_DestroyDiscState - SUBROUTINE StC_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(StC_DiscreteStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_PackDiscState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyDiscState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE StC_PackDiscState - - SUBROUTINE StC_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(StC_DiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_UnPackDiscState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyDiscState = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE StC_UnPackDiscState +subroutine StC_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(StC_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'StC_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyDiscState + call RegPack(Buf, InData%DummyDiscState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine StC_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(StC_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'StC_UnPackDiscState' + if (Buf%ErrStat /= ErrID_None) return + ! DummyDiscState + call RegUnpack(Buf, OutData%DummyDiscState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE StC_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(StC_ConstraintStateType), INTENT(IN) :: SrcConstrStateData TYPE(StC_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData @@ -2716,103 +1711,26 @@ SUBROUTINE StC_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) END SUBROUTINE StC_DestroyConstrState - SUBROUTINE StC_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(StC_ConstraintStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_PackConstrState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyConstrState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE StC_PackConstrState - - SUBROUTINE StC_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(StC_ConstraintStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_UnPackConstrState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyConstrState = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE StC_UnPackConstrState +subroutine StC_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(StC_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'StC_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyConstrState + call RegPack(Buf, InData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine StC_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(StC_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'StC_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + ! DummyConstrState + call RegUnpack(Buf, OutData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE StC_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(StC_OtherStateType), INTENT(IN) :: SrcOtherStateData TYPE(StC_OtherStateType), INTENT(INOUT) :: DstOtherStateData @@ -2845,103 +1763,26 @@ SUBROUTINE StC_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) END SUBROUTINE StC_DestroyOtherState - SUBROUTINE StC_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(StC_OtherStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_PackOtherState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyOtherState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyOtherState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE StC_PackOtherState - - SUBROUTINE StC_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(StC_OtherStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_UnPackOtherState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyOtherState = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE StC_UnPackOtherState +subroutine StC_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(StC_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'StC_PackOtherState' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyOtherState + call RegPack(Buf, InData%DummyOtherState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine StC_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(StC_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'StC_UnPackOtherState' + if (Buf%ErrStat /= ErrID_None) return + ! DummyOtherState + call RegUnpack(Buf, OutData%DummyOtherState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE StC_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) TYPE(StC_MiscVarType), INTENT(IN) :: SrcMiscData TYPE(StC_MiscVarType), INTENT(INOUT) :: DstMiscData @@ -3265,921 +2106,403 @@ SUBROUTINE StC_DestroyMisc( MiscData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE StC_DestroyMisc - SUBROUTINE StC_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(StC_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! F_stop allocated yes/no - IF ( ALLOCATED(InData%F_stop) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_stop upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_stop) ! F_stop - END IF - Int_BufSz = Int_BufSz + 1 ! F_ext allocated yes/no - IF ( ALLOCATED(InData%F_ext) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_ext upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_ext) ! F_ext - END IF - Int_BufSz = Int_BufSz + 1 ! F_fr allocated yes/no - IF ( ALLOCATED(InData%F_fr) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_fr upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_fr) ! F_fr - END IF - Int_BufSz = Int_BufSz + 1 ! K allocated yes/no - IF ( ALLOCATED(InData%K) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! K upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%K) ! K - END IF - Int_BufSz = Int_BufSz + 1 ! C_ctrl allocated yes/no - IF ( ALLOCATED(InData%C_ctrl) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! C_ctrl upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%C_ctrl) ! C_ctrl - END IF - Int_BufSz = Int_BufSz + 1 ! C_Brake allocated yes/no - IF ( ALLOCATED(InData%C_Brake) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! C_Brake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%C_Brake) ! C_Brake - END IF - Int_BufSz = Int_BufSz + 1 ! F_table allocated yes/no - IF ( ALLOCATED(InData%F_table) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_table upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_table) ! F_table - END IF - Int_BufSz = Int_BufSz + 1 ! F_k allocated yes/no - IF ( ALLOCATED(InData%F_k) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_k upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_k) ! F_k - END IF - Int_BufSz = Int_BufSz + 1 ! a_G allocated yes/no - IF ( ALLOCATED(InData%a_G) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! a_G upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%a_G) ! a_G - END IF - Int_BufSz = Int_BufSz + 1 ! rdisp_P allocated yes/no - IF ( ALLOCATED(InData%rdisp_P) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! rdisp_P upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rdisp_P) ! rdisp_P - END IF - Int_BufSz = Int_BufSz + 1 ! rdot_P allocated yes/no - IF ( ALLOCATED(InData%rdot_P) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! rdot_P upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rdot_P) ! rdot_P - END IF - Int_BufSz = Int_BufSz + 1 ! rddot_P allocated yes/no - IF ( ALLOCATED(InData%rddot_P) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! rddot_P upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rddot_P) ! rddot_P - END IF - Int_BufSz = Int_BufSz + 1 ! omega_P allocated yes/no - IF ( ALLOCATED(InData%omega_P) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! omega_P upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%omega_P) ! omega_P - END IF - Int_BufSz = Int_BufSz + 1 ! alpha_P allocated yes/no - IF ( ALLOCATED(InData%alpha_P) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! alpha_P upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%alpha_P) ! alpha_P - END IF - Int_BufSz = Int_BufSz + 1 ! F_P allocated yes/no - IF ( ALLOCATED(InData%F_P) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_P upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_P) ! F_P - END IF - Int_BufSz = Int_BufSz + 1 ! M_P allocated yes/no - IF ( ALLOCATED(InData%M_P) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! M_P upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%M_P) ! M_P - END IF - Int_BufSz = Int_BufSz + 1 ! Acc allocated yes/no - IF ( ALLOCATED(InData%Acc) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Acc upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Acc) ! Acc - END IF - Int_BufSz = Int_BufSz + 1 ! PrescribedInterpIdx - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%F_stop) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_stop,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_stop,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_stop,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_stop,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_stop,2), UBOUND(InData%F_stop,2) - DO i1 = LBOUND(InData%F_stop,1), UBOUND(InData%F_stop,1) - ReKiBuf(Re_Xferred) = InData%F_stop(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_ext) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_ext,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_ext,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_ext,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_ext,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_ext,2), UBOUND(InData%F_ext,2) - DO i1 = LBOUND(InData%F_ext,1), UBOUND(InData%F_ext,1) - ReKiBuf(Re_Xferred) = InData%F_ext(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_fr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_fr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_fr,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_fr,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_fr,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_fr,2), UBOUND(InData%F_fr,2) - DO i1 = LBOUND(InData%F_fr,1), UBOUND(InData%F_fr,1) - ReKiBuf(Re_Xferred) = InData%F_fr(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%K) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%K,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%K,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%K,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%K,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%K,2), UBOUND(InData%K,2) - DO i1 = LBOUND(InData%K,1), UBOUND(InData%K,1) - ReKiBuf(Re_Xferred) = InData%K(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%C_ctrl) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C_ctrl,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C_ctrl,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C_ctrl,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C_ctrl,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%C_ctrl,2), UBOUND(InData%C_ctrl,2) - DO i1 = LBOUND(InData%C_ctrl,1), UBOUND(InData%C_ctrl,1) - ReKiBuf(Re_Xferred) = InData%C_ctrl(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%C_Brake) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C_Brake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C_Brake,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C_Brake,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C_Brake,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%C_Brake,2), UBOUND(InData%C_Brake,2) - DO i1 = LBOUND(InData%C_Brake,1), UBOUND(InData%C_Brake,1) - ReKiBuf(Re_Xferred) = InData%C_Brake(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_table) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_table,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_table,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_table,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_table,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_table,2), UBOUND(InData%F_table,2) - DO i1 = LBOUND(InData%F_table,1), UBOUND(InData%F_table,1) - ReKiBuf(Re_Xferred) = InData%F_table(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_k) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_k,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_k,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_k,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_k,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_k,2), UBOUND(InData%F_k,2) - DO i1 = LBOUND(InData%F_k,1), UBOUND(InData%F_k,1) - ReKiBuf(Re_Xferred) = InData%F_k(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%a_G) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%a_G,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%a_G,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%a_G,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%a_G,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%a_G,2), UBOUND(InData%a_G,2) - DO i1 = LBOUND(InData%a_G,1), UBOUND(InData%a_G,1) - ReKiBuf(Re_Xferred) = InData%a_G(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rdisp_P) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rdisp_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdisp_P,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rdisp_P,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdisp_P,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%rdisp_P,2), UBOUND(InData%rdisp_P,2) - DO i1 = LBOUND(InData%rdisp_P,1), UBOUND(InData%rdisp_P,1) - ReKiBuf(Re_Xferred) = InData%rdisp_P(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rdot_P) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rdot_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdot_P,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rdot_P,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdot_P,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%rdot_P,2), UBOUND(InData%rdot_P,2) - DO i1 = LBOUND(InData%rdot_P,1), UBOUND(InData%rdot_P,1) - ReKiBuf(Re_Xferred) = InData%rdot_P(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%rddot_P) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rddot_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rddot_P,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rddot_P,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rddot_P,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%rddot_P,2), UBOUND(InData%rddot_P,2) - DO i1 = LBOUND(InData%rddot_P,1), UBOUND(InData%rddot_P,1) - ReKiBuf(Re_Xferred) = InData%rddot_P(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%omega_P) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%omega_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%omega_P,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%omega_P,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%omega_P,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%omega_P,2), UBOUND(InData%omega_P,2) - DO i1 = LBOUND(InData%omega_P,1), UBOUND(InData%omega_P,1) - ReKiBuf(Re_Xferred) = InData%omega_P(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%alpha_P) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%alpha_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_P,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%alpha_P,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_P,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%alpha_P,2), UBOUND(InData%alpha_P,2) - DO i1 = LBOUND(InData%alpha_P,1), UBOUND(InData%alpha_P,1) - ReKiBuf(Re_Xferred) = InData%alpha_P(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_P) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_P,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_P,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_P,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_P,2), UBOUND(InData%F_P,2) - DO i1 = LBOUND(InData%F_P,1), UBOUND(InData%F_P,1) - ReKiBuf(Re_Xferred) = InData%F_P(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%M_P) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M_P,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M_P,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M_P,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%M_P,2), UBOUND(InData%M_P,2) - DO i1 = LBOUND(InData%M_P,1), UBOUND(InData%M_P,1) - ReKiBuf(Re_Xferred) = InData%M_P(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Acc) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Acc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Acc,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Acc,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Acc,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Acc,2), UBOUND(InData%Acc,2) - DO i1 = LBOUND(InData%Acc,1), UBOUND(InData%Acc,1) - ReKiBuf(Re_Xferred) = InData%Acc(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%PrescribedInterpIdx - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE StC_PackMisc - - SUBROUTINE StC_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(StC_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_stop not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_stop)) DEALLOCATE(OutData%F_stop) - ALLOCATE(OutData%F_stop(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_stop.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_stop,2), UBOUND(OutData%F_stop,2) - DO i1 = LBOUND(OutData%F_stop,1), UBOUND(OutData%F_stop,1) - OutData%F_stop(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_ext not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_ext)) DEALLOCATE(OutData%F_ext) - ALLOCATE(OutData%F_ext(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_ext.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_ext,2), UBOUND(OutData%F_ext,2) - DO i1 = LBOUND(OutData%F_ext,1), UBOUND(OutData%F_ext,1) - OutData%F_ext(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_fr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_fr)) DEALLOCATE(OutData%F_fr) - ALLOCATE(OutData%F_fr(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_fr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_fr,2), UBOUND(OutData%F_fr,2) - DO i1 = LBOUND(OutData%F_fr,1), UBOUND(OutData%F_fr,1) - OutData%F_fr(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! K not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%K)) DEALLOCATE(OutData%K) - ALLOCATE(OutData%K(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%K.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%K,2), UBOUND(OutData%K,2) - DO i1 = LBOUND(OutData%K,1), UBOUND(OutData%K,1) - OutData%K(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C_ctrl not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%C_ctrl)) DEALLOCATE(OutData%C_ctrl) - ALLOCATE(OutData%C_ctrl(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C_ctrl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%C_ctrl,2), UBOUND(OutData%C_ctrl,2) - DO i1 = LBOUND(OutData%C_ctrl,1), UBOUND(OutData%C_ctrl,1) - OutData%C_ctrl(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C_Brake not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%C_Brake)) DEALLOCATE(OutData%C_Brake) - ALLOCATE(OutData%C_Brake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C_Brake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%C_Brake,2), UBOUND(OutData%C_Brake,2) - DO i1 = LBOUND(OutData%C_Brake,1), UBOUND(OutData%C_Brake,1) - OutData%C_Brake(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_table not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_table)) DEALLOCATE(OutData%F_table) - ALLOCATE(OutData%F_table(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_table.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_table,2), UBOUND(OutData%F_table,2) - DO i1 = LBOUND(OutData%F_table,1), UBOUND(OutData%F_table,1) - OutData%F_table(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_k not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_k)) DEALLOCATE(OutData%F_k) - ALLOCATE(OutData%F_k(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_k.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_k,2), UBOUND(OutData%F_k,2) - DO i1 = LBOUND(OutData%F_k,1), UBOUND(OutData%F_k,1) - OutData%F_k(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! a_G not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%a_G)) DEALLOCATE(OutData%a_G) - ALLOCATE(OutData%a_G(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%a_G.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%a_G,2), UBOUND(OutData%a_G,2) - DO i1 = LBOUND(OutData%a_G,1), UBOUND(OutData%a_G,1) - OutData%a_G(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rdisp_P not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rdisp_P)) DEALLOCATE(OutData%rdisp_P) - ALLOCATE(OutData%rdisp_P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdisp_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%rdisp_P,2), UBOUND(OutData%rdisp_P,2) - DO i1 = LBOUND(OutData%rdisp_P,1), UBOUND(OutData%rdisp_P,1) - OutData%rdisp_P(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rdot_P not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rdot_P)) DEALLOCATE(OutData%rdot_P) - ALLOCATE(OutData%rdot_P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdot_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%rdot_P,2), UBOUND(OutData%rdot_P,2) - DO i1 = LBOUND(OutData%rdot_P,1), UBOUND(OutData%rdot_P,1) - OutData%rdot_P(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rddot_P not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rddot_P)) DEALLOCATE(OutData%rddot_P) - ALLOCATE(OutData%rddot_P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rddot_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%rddot_P,2), UBOUND(OutData%rddot_P,2) - DO i1 = LBOUND(OutData%rddot_P,1), UBOUND(OutData%rddot_P,1) - OutData%rddot_P(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! omega_P not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%omega_P)) DEALLOCATE(OutData%omega_P) - ALLOCATE(OutData%omega_P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%omega_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%omega_P,2), UBOUND(OutData%omega_P,2) - DO i1 = LBOUND(OutData%omega_P,1), UBOUND(OutData%omega_P,1) - OutData%omega_P(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! alpha_P not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%alpha_P)) DEALLOCATE(OutData%alpha_P) - ALLOCATE(OutData%alpha_P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%alpha_P,2), UBOUND(OutData%alpha_P,2) - DO i1 = LBOUND(OutData%alpha_P,1), UBOUND(OutData%alpha_P,1) - OutData%alpha_P(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_P not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_P)) DEALLOCATE(OutData%F_P) - ALLOCATE(OutData%F_P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_P,2), UBOUND(OutData%F_P,2) - DO i1 = LBOUND(OutData%F_P,1), UBOUND(OutData%F_P,1) - OutData%F_P(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M_P not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%M_P)) DEALLOCATE(OutData%M_P) - ALLOCATE(OutData%M_P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%M_P,2), UBOUND(OutData%M_P,2) - DO i1 = LBOUND(OutData%M_P,1), UBOUND(OutData%M_P,1) - OutData%M_P(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Acc not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Acc)) DEALLOCATE(OutData%Acc) - ALLOCATE(OutData%Acc(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Acc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Acc,2), UBOUND(OutData%Acc,2) - DO i1 = LBOUND(OutData%Acc,1), UBOUND(OutData%Acc,1) - OutData%Acc(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%PrescribedInterpIdx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE StC_UnPackMisc +subroutine StC_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(StC_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'StC_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + ! F_stop + call RegPack(Buf, allocated(InData%F_stop)) + if (allocated(InData%F_stop)) then + call RegPackBounds(Buf, 2, lbound(InData%F_stop), ubound(InData%F_stop)) + call RegPack(Buf, InData%F_stop) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! F_ext + call RegPack(Buf, allocated(InData%F_ext)) + if (allocated(InData%F_ext)) then + call RegPackBounds(Buf, 2, lbound(InData%F_ext), ubound(InData%F_ext)) + call RegPack(Buf, InData%F_ext) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! F_fr + call RegPack(Buf, allocated(InData%F_fr)) + if (allocated(InData%F_fr)) then + call RegPackBounds(Buf, 2, lbound(InData%F_fr), ubound(InData%F_fr)) + call RegPack(Buf, InData%F_fr) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! K + call RegPack(Buf, allocated(InData%K)) + if (allocated(InData%K)) then + call RegPackBounds(Buf, 2, lbound(InData%K), ubound(InData%K)) + call RegPack(Buf, InData%K) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! C_ctrl + call RegPack(Buf, allocated(InData%C_ctrl)) + if (allocated(InData%C_ctrl)) then + call RegPackBounds(Buf, 2, lbound(InData%C_ctrl), ubound(InData%C_ctrl)) + call RegPack(Buf, InData%C_ctrl) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! C_Brake + call RegPack(Buf, allocated(InData%C_Brake)) + if (allocated(InData%C_Brake)) then + call RegPackBounds(Buf, 2, lbound(InData%C_Brake), ubound(InData%C_Brake)) + call RegPack(Buf, InData%C_Brake) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! F_table + call RegPack(Buf, allocated(InData%F_table)) + if (allocated(InData%F_table)) then + call RegPackBounds(Buf, 2, lbound(InData%F_table), ubound(InData%F_table)) + call RegPack(Buf, InData%F_table) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! F_k + call RegPack(Buf, allocated(InData%F_k)) + if (allocated(InData%F_k)) then + call RegPackBounds(Buf, 2, lbound(InData%F_k), ubound(InData%F_k)) + call RegPack(Buf, InData%F_k) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! a_G + call RegPack(Buf, allocated(InData%a_G)) + if (allocated(InData%a_G)) then + call RegPackBounds(Buf, 2, lbound(InData%a_G), ubound(InData%a_G)) + call RegPack(Buf, InData%a_G) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! rdisp_P + call RegPack(Buf, allocated(InData%rdisp_P)) + if (allocated(InData%rdisp_P)) then + call RegPackBounds(Buf, 2, lbound(InData%rdisp_P), ubound(InData%rdisp_P)) + call RegPack(Buf, InData%rdisp_P) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! rdot_P + call RegPack(Buf, allocated(InData%rdot_P)) + if (allocated(InData%rdot_P)) then + call RegPackBounds(Buf, 2, lbound(InData%rdot_P), ubound(InData%rdot_P)) + call RegPack(Buf, InData%rdot_P) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! rddot_P + call RegPack(Buf, allocated(InData%rddot_P)) + if (allocated(InData%rddot_P)) then + call RegPackBounds(Buf, 2, lbound(InData%rddot_P), ubound(InData%rddot_P)) + call RegPack(Buf, InData%rddot_P) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! omega_P + call RegPack(Buf, allocated(InData%omega_P)) + if (allocated(InData%omega_P)) then + call RegPackBounds(Buf, 2, lbound(InData%omega_P), ubound(InData%omega_P)) + call RegPack(Buf, InData%omega_P) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! alpha_P + call RegPack(Buf, allocated(InData%alpha_P)) + if (allocated(InData%alpha_P)) then + call RegPackBounds(Buf, 2, lbound(InData%alpha_P), ubound(InData%alpha_P)) + call RegPack(Buf, InData%alpha_P) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! F_P + call RegPack(Buf, allocated(InData%F_P)) + if (allocated(InData%F_P)) then + call RegPackBounds(Buf, 2, lbound(InData%F_P), ubound(InData%F_P)) + call RegPack(Buf, InData%F_P) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! M_P + call RegPack(Buf, allocated(InData%M_P)) + if (allocated(InData%M_P)) then + call RegPackBounds(Buf, 2, lbound(InData%M_P), ubound(InData%M_P)) + call RegPack(Buf, InData%M_P) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Acc + call RegPack(Buf, allocated(InData%Acc)) + if (allocated(InData%Acc)) then + call RegPackBounds(Buf, 2, lbound(InData%Acc), ubound(InData%Acc)) + call RegPack(Buf, InData%Acc) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PrescribedInterpIdx + call RegPack(Buf, InData%PrescribedInterpIdx) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine StC_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(StC_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'StC_UnPackMisc' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! F_stop + if (allocated(OutData%F_stop)) deallocate(OutData%F_stop) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_stop(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_stop.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_stop) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! F_ext + if (allocated(OutData%F_ext)) deallocate(OutData%F_ext) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_ext(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_ext.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_ext) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! F_fr + if (allocated(OutData%F_fr)) deallocate(OutData%F_fr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_fr(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_fr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_fr) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! K + if (allocated(OutData%K)) deallocate(OutData%K) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%K(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%K.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%K) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! C_ctrl + if (allocated(OutData%C_ctrl)) deallocate(OutData%C_ctrl) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%C_ctrl(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%C_ctrl.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%C_ctrl) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! C_Brake + if (allocated(OutData%C_Brake)) deallocate(OutData%C_Brake) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%C_Brake(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%C_Brake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%C_Brake) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! F_table + if (allocated(OutData%F_table)) deallocate(OutData%F_table) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_table(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_table.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_table) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! F_k + if (allocated(OutData%F_k)) deallocate(OutData%F_k) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_k(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_k.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_k) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! a_G + if (allocated(OutData%a_G)) deallocate(OutData%a_G) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%a_G(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%a_G.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%a_G) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! rdisp_P + if (allocated(OutData%rdisp_P)) deallocate(OutData%rdisp_P) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rdisp_P(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdisp_P.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rdisp_P) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! rdot_P + if (allocated(OutData%rdot_P)) deallocate(OutData%rdot_P) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rdot_P(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdot_P.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rdot_P) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! rddot_P + if (allocated(OutData%rddot_P)) deallocate(OutData%rddot_P) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%rddot_P(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%rddot_P.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%rddot_P) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! omega_P + if (allocated(OutData%omega_P)) deallocate(OutData%omega_P) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%omega_P(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%omega_P.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%omega_P) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! alpha_P + if (allocated(OutData%alpha_P)) deallocate(OutData%alpha_P) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%alpha_P(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_P.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%alpha_P) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! F_P + if (allocated(OutData%F_P)) deallocate(OutData%F_P) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_P(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_P.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_P) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! M_P + if (allocated(OutData%M_P)) deallocate(OutData%M_P) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%M_P(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%M_P.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%M_P) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Acc + if (allocated(OutData%Acc)) deallocate(OutData%Acc) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Acc(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Acc.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Acc) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PrescribedInterpIdx + call RegUnpack(Buf, OutData%PrescribedInterpIdx) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE StC_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(StC_ParameterType), INTENT(IN) :: SrcParamData TYPE(StC_ParameterType), INTENT(INOUT) :: DstParamData @@ -4310,508 +2633,377 @@ SUBROUTINE StC_DestroyParam( ParamData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE StC_DestroyParam - SUBROUTINE StC_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(StC_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! DT - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1 ! StC_DOF_MODE - Int_BufSz = Int_BufSz + 1 ! StC_X_DOF - Int_BufSz = Int_BufSz + 1 ! StC_Y_DOF - Int_BufSz = Int_BufSz + 1 ! StC_Z_DOF - Re_BufSz = Re_BufSz + 1 ! StC_Z_PreLd - Re_BufSz = Re_BufSz + 1 ! M_X - Re_BufSz = Re_BufSz + 1 ! M_Y - Re_BufSz = Re_BufSz + 1 ! M_Z - Re_BufSz = Re_BufSz + 1 ! M_XY - Re_BufSz = Re_BufSz + 1 ! K_X - Re_BufSz = Re_BufSz + 1 ! K_Y - Re_BufSz = Re_BufSz + 1 ! K_Z - Re_BufSz = Re_BufSz + 1 ! C_X - Re_BufSz = Re_BufSz + 1 ! C_Y - Re_BufSz = Re_BufSz + 1 ! C_Z - Re_BufSz = Re_BufSz + SIZE(InData%K_S) ! K_S - Re_BufSz = Re_BufSz + SIZE(InData%C_S) ! C_S - Re_BufSz = Re_BufSz + SIZE(InData%P_SP) ! P_SP - Re_BufSz = Re_BufSz + SIZE(InData%N_SP) ! N_SP - Re_BufSz = Re_BufSz + SIZE(InData%Gravity) ! Gravity - Int_BufSz = Int_BufSz + 1 ! StC_CMODE - Int_BufSz = Int_BufSz + 1 ! StC_SA_MODE - Re_BufSz = Re_BufSz + 1 ! StC_X_C_HIGH - Re_BufSz = Re_BufSz + 1 ! StC_X_C_LOW - Re_BufSz = Re_BufSz + 1 ! StC_Y_C_HIGH - Re_BufSz = Re_BufSz + 1 ! StC_Y_C_LOW - Re_BufSz = Re_BufSz + 1 ! StC_Z_C_HIGH - Re_BufSz = Re_BufSz + 1 ! StC_Z_C_LOW - Re_BufSz = Re_BufSz + 1 ! StC_X_C_BRAKE - Re_BufSz = Re_BufSz + 1 ! StC_Y_C_BRAKE - Re_BufSz = Re_BufSz + 1 ! StC_Z_C_BRAKE - Re_BufSz = Re_BufSz + 1 ! L_X - Re_BufSz = Re_BufSz + 1 ! B_X - Re_BufSz = Re_BufSz + 1 ! area_X - Re_BufSz = Re_BufSz + 1 ! area_ratio_X - Re_BufSz = Re_BufSz + 1 ! headLossCoeff_X - Re_BufSz = Re_BufSz + 1 ! rho_X - Re_BufSz = Re_BufSz + 1 ! L_Y - Re_BufSz = Re_BufSz + 1 ! B_Y - Re_BufSz = Re_BufSz + 1 ! area_Y - Re_BufSz = Re_BufSz + 1 ! area_ratio_Y - Re_BufSz = Re_BufSz + 1 ! headLossCoeff_Y - Re_BufSz = Re_BufSz + 1 ! rho_Y - Int_BufSz = Int_BufSz + 1 ! Use_F_TBL - Int_BufSz = Int_BufSz + 1 ! F_TBL allocated yes/no - IF ( ALLOCATED(InData%F_TBL) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_TBL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_TBL) ! F_TBL - END IF - Int_BufSz = Int_BufSz + 1 ! NumMeshPts - Int_BufSz = Int_BufSz + 1 ! PrescribedForcesCoordSys - Int_BufSz = Int_BufSz + 1 ! StC_PrescribedForce allocated yes/no - IF ( ALLOCATED(InData%StC_PrescribedForce) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StC_PrescribedForce upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StC_PrescribedForce) ! StC_PrescribedForce - END IF - Int_BufSz = Int_BufSz + 1 ! StC_CChan allocated yes/no - IF ( ALLOCATED(InData%StC_CChan) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! StC_CChan upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%StC_CChan) ! StC_CChan - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%StC_DOF_MODE - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%StC_X_DOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%StC_Y_DOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%StC_Z_DOF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Z_PreLd - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%M_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%M_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%M_Z - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%M_XY - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%K_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%K_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%K_Z - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_Z - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%K_S,1), UBOUND(InData%K_S,1) - ReKiBuf(Re_Xferred) = InData%K_S(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%C_S,1), UBOUND(InData%C_S,1) - ReKiBuf(Re_Xferred) = InData%C_S(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%P_SP,1), UBOUND(InData%P_SP,1) - ReKiBuf(Re_Xferred) = InData%P_SP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%N_SP,1), UBOUND(InData%N_SP,1) - ReKiBuf(Re_Xferred) = InData%N_SP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%Gravity,1), UBOUND(InData%Gravity,1) - ReKiBuf(Re_Xferred) = InData%Gravity(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%StC_CMODE - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%StC_SA_MODE - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_X_C_HIGH - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_X_C_LOW - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Y_C_HIGH - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Y_C_LOW - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Z_C_HIGH - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Z_C_LOW - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_X_C_BRAKE - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Y_C_BRAKE - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%StC_Z_C_BRAKE - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%L_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%B_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%area_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%area_ratio_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%headLossCoeff_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rho_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%L_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%B_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%area_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%area_ratio_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%headLossCoeff_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rho_Y - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Use_F_TBL, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%F_TBL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_TBL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_TBL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_TBL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_TBL,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_TBL,2), UBOUND(InData%F_TBL,2) - DO i1 = LBOUND(InData%F_TBL,1), UBOUND(InData%F_TBL,1) - ReKiBuf(Re_Xferred) = InData%F_TBL(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NumMeshPts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%PrescribedForcesCoordSys - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%StC_PrescribedForce) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StC_PrescribedForce,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StC_PrescribedForce,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StC_PrescribedForce,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StC_PrescribedForce,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%StC_PrescribedForce,2), UBOUND(InData%StC_PrescribedForce,2) - DO i1 = LBOUND(InData%StC_PrescribedForce,1), UBOUND(InData%StC_PrescribedForce,1) - ReKiBuf(Re_Xferred) = InData%StC_PrescribedForce(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StC_CChan) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StC_CChan,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StC_CChan,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%StC_CChan,1), UBOUND(InData%StC_CChan,1) - IntKiBuf(Int_Xferred) = InData%StC_CChan(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE StC_PackParam - - SUBROUTINE StC_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(StC_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%StC_DOF_MODE = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%StC_X_DOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%StC_X_DOF) - Int_Xferred = Int_Xferred + 1 - OutData%StC_Y_DOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%StC_Y_DOF) - Int_Xferred = Int_Xferred + 1 - OutData%StC_Z_DOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%StC_Z_DOF) - Int_Xferred = Int_Xferred + 1 - OutData%StC_Z_PreLd = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%M_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%M_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%M_Z = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%M_XY = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%K_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%K_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%K_Z = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_Z = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%K_S,1) - i1_u = UBOUND(OutData%K_S,1) - DO i1 = LBOUND(OutData%K_S,1), UBOUND(OutData%K_S,1) - OutData%K_S(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%C_S,1) - i1_u = UBOUND(OutData%C_S,1) - DO i1 = LBOUND(OutData%C_S,1), UBOUND(OutData%C_S,1) - OutData%C_S(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%P_SP,1) - i1_u = UBOUND(OutData%P_SP,1) - DO i1 = LBOUND(OutData%P_SP,1), UBOUND(OutData%P_SP,1) - OutData%P_SP(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%N_SP,1) - i1_u = UBOUND(OutData%N_SP,1) - DO i1 = LBOUND(OutData%N_SP,1), UBOUND(OutData%N_SP,1) - OutData%N_SP(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%Gravity,1) - i1_u = UBOUND(OutData%Gravity,1) - DO i1 = LBOUND(OutData%Gravity,1), UBOUND(OutData%Gravity,1) - OutData%Gravity(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%StC_CMODE = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%StC_SA_MODE = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%StC_X_C_HIGH = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_X_C_LOW = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Y_C_HIGH = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Y_C_LOW = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Z_C_HIGH = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Z_C_LOW = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_X_C_BRAKE = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Y_C_BRAKE = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%StC_Z_C_BRAKE = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%L_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%B_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%area_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%area_ratio_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%headLossCoeff_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rho_X = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%L_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%B_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%area_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%area_ratio_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%headLossCoeff_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rho_Y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Use_F_TBL = TRANSFER(IntKiBuf(Int_Xferred), OutData%Use_F_TBL) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_TBL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_TBL)) DEALLOCATE(OutData%F_TBL) - ALLOCATE(OutData%F_TBL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_TBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_TBL,2), UBOUND(OutData%F_TBL,2) - DO i1 = LBOUND(OutData%F_TBL,1), UBOUND(OutData%F_TBL,1) - OutData%F_TBL(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%NumMeshPts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%PrescribedForcesCoordSys = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StC_PrescribedForce not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%StC_PrescribedForce)) DEALLOCATE(OutData%StC_PrescribedForce) - ALLOCATE(OutData%StC_PrescribedForce(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StC_PrescribedForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%StC_PrescribedForce,2), UBOUND(OutData%StC_PrescribedForce,2) - DO i1 = LBOUND(OutData%StC_PrescribedForce,1), UBOUND(OutData%StC_PrescribedForce,1) - OutData%StC_PrescribedForce(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StC_CChan not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%StC_CChan)) DEALLOCATE(OutData%StC_CChan) - ALLOCATE(OutData%StC_CChan(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StC_CChan.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%StC_CChan,1), UBOUND(OutData%StC_CChan,1) - OutData%StC_CChan(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE StC_UnPackParam +subroutine StC_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(StC_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'StC_PackParam' + if (Buf%ErrStat >= AbortErrLev) return + ! DT + call RegPack(Buf, InData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegPack(Buf, InData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_DOF_MODE + call RegPack(Buf, InData%StC_DOF_MODE) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_X_DOF + call RegPack(Buf, InData%StC_X_DOF) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Y_DOF + call RegPack(Buf, InData%StC_Y_DOF) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Z_DOF + call RegPack(Buf, InData%StC_Z_DOF) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Z_PreLd + call RegPack(Buf, InData%StC_Z_PreLd) + if (RegCheckErr(Buf, RoutineName)) return + ! M_X + call RegPack(Buf, InData%M_X) + if (RegCheckErr(Buf, RoutineName)) return + ! M_Y + call RegPack(Buf, InData%M_Y) + if (RegCheckErr(Buf, RoutineName)) return + ! M_Z + call RegPack(Buf, InData%M_Z) + if (RegCheckErr(Buf, RoutineName)) return + ! M_XY + call RegPack(Buf, InData%M_XY) + if (RegCheckErr(Buf, RoutineName)) return + ! K_X + call RegPack(Buf, InData%K_X) + if (RegCheckErr(Buf, RoutineName)) return + ! K_Y + call RegPack(Buf, InData%K_Y) + if (RegCheckErr(Buf, RoutineName)) return + ! K_Z + call RegPack(Buf, InData%K_Z) + if (RegCheckErr(Buf, RoutineName)) return + ! C_X + call RegPack(Buf, InData%C_X) + if (RegCheckErr(Buf, RoutineName)) return + ! C_Y + call RegPack(Buf, InData%C_Y) + if (RegCheckErr(Buf, RoutineName)) return + ! C_Z + call RegPack(Buf, InData%C_Z) + if (RegCheckErr(Buf, RoutineName)) return + ! K_S + call RegPack(Buf, InData%K_S) + if (RegCheckErr(Buf, RoutineName)) return + ! C_S + call RegPack(Buf, InData%C_S) + if (RegCheckErr(Buf, RoutineName)) return + ! P_SP + call RegPack(Buf, InData%P_SP) + if (RegCheckErr(Buf, RoutineName)) return + ! N_SP + call RegPack(Buf, InData%N_SP) + if (RegCheckErr(Buf, RoutineName)) return + ! Gravity + call RegPack(Buf, InData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_CMODE + call RegPack(Buf, InData%StC_CMODE) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_SA_MODE + call RegPack(Buf, InData%StC_SA_MODE) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_X_C_HIGH + call RegPack(Buf, InData%StC_X_C_HIGH) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_X_C_LOW + call RegPack(Buf, InData%StC_X_C_LOW) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Y_C_HIGH + call RegPack(Buf, InData%StC_Y_C_HIGH) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Y_C_LOW + call RegPack(Buf, InData%StC_Y_C_LOW) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Z_C_HIGH + call RegPack(Buf, InData%StC_Z_C_HIGH) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Z_C_LOW + call RegPack(Buf, InData%StC_Z_C_LOW) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_X_C_BRAKE + call RegPack(Buf, InData%StC_X_C_BRAKE) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Y_C_BRAKE + call RegPack(Buf, InData%StC_Y_C_BRAKE) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Z_C_BRAKE + call RegPack(Buf, InData%StC_Z_C_BRAKE) + if (RegCheckErr(Buf, RoutineName)) return + ! L_X + call RegPack(Buf, InData%L_X) + if (RegCheckErr(Buf, RoutineName)) return + ! B_X + call RegPack(Buf, InData%B_X) + if (RegCheckErr(Buf, RoutineName)) return + ! area_X + call RegPack(Buf, InData%area_X) + if (RegCheckErr(Buf, RoutineName)) return + ! area_ratio_X + call RegPack(Buf, InData%area_ratio_X) + if (RegCheckErr(Buf, RoutineName)) return + ! headLossCoeff_X + call RegPack(Buf, InData%headLossCoeff_X) + if (RegCheckErr(Buf, RoutineName)) return + ! rho_X + call RegPack(Buf, InData%rho_X) + if (RegCheckErr(Buf, RoutineName)) return + ! L_Y + call RegPack(Buf, InData%L_Y) + if (RegCheckErr(Buf, RoutineName)) return + ! B_Y + call RegPack(Buf, InData%B_Y) + if (RegCheckErr(Buf, RoutineName)) return + ! area_Y + call RegPack(Buf, InData%area_Y) + if (RegCheckErr(Buf, RoutineName)) return + ! area_ratio_Y + call RegPack(Buf, InData%area_ratio_Y) + if (RegCheckErr(Buf, RoutineName)) return + ! headLossCoeff_Y + call RegPack(Buf, InData%headLossCoeff_Y) + if (RegCheckErr(Buf, RoutineName)) return + ! rho_Y + call RegPack(Buf, InData%rho_Y) + if (RegCheckErr(Buf, RoutineName)) return + ! Use_F_TBL + call RegPack(Buf, InData%Use_F_TBL) + if (RegCheckErr(Buf, RoutineName)) return + ! F_TBL + call RegPack(Buf, allocated(InData%F_TBL)) + if (allocated(InData%F_TBL)) then + call RegPackBounds(Buf, 2, lbound(InData%F_TBL), ubound(InData%F_TBL)) + call RegPack(Buf, InData%F_TBL) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NumMeshPts + call RegPack(Buf, InData%NumMeshPts) + if (RegCheckErr(Buf, RoutineName)) return + ! PrescribedForcesCoordSys + call RegPack(Buf, InData%PrescribedForcesCoordSys) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_PrescribedForce + call RegPack(Buf, allocated(InData%StC_PrescribedForce)) + if (allocated(InData%StC_PrescribedForce)) then + call RegPackBounds(Buf, 2, lbound(InData%StC_PrescribedForce), ubound(InData%StC_PrescribedForce)) + call RegPack(Buf, InData%StC_PrescribedForce) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! StC_CChan + call RegPack(Buf, allocated(InData%StC_CChan)) + if (allocated(InData%StC_CChan)) then + call RegPackBounds(Buf, 1, lbound(InData%StC_CChan), ubound(InData%StC_CChan)) + call RegPack(Buf, InData%StC_CChan) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine StC_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(StC_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'StC_UnPackParam' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! DT + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_DOF_MODE + call RegUnpack(Buf, OutData%StC_DOF_MODE) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_X_DOF + call RegUnpack(Buf, OutData%StC_X_DOF) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Y_DOF + call RegUnpack(Buf, OutData%StC_Y_DOF) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Z_DOF + call RegUnpack(Buf, OutData%StC_Z_DOF) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Z_PreLd + call RegUnpack(Buf, OutData%StC_Z_PreLd) + if (RegCheckErr(Buf, RoutineName)) return + ! M_X + call RegUnpack(Buf, OutData%M_X) + if (RegCheckErr(Buf, RoutineName)) return + ! M_Y + call RegUnpack(Buf, OutData%M_Y) + if (RegCheckErr(Buf, RoutineName)) return + ! M_Z + call RegUnpack(Buf, OutData%M_Z) + if (RegCheckErr(Buf, RoutineName)) return + ! M_XY + call RegUnpack(Buf, OutData%M_XY) + if (RegCheckErr(Buf, RoutineName)) return + ! K_X + call RegUnpack(Buf, OutData%K_X) + if (RegCheckErr(Buf, RoutineName)) return + ! K_Y + call RegUnpack(Buf, OutData%K_Y) + if (RegCheckErr(Buf, RoutineName)) return + ! K_Z + call RegUnpack(Buf, OutData%K_Z) + if (RegCheckErr(Buf, RoutineName)) return + ! C_X + call RegUnpack(Buf, OutData%C_X) + if (RegCheckErr(Buf, RoutineName)) return + ! C_Y + call RegUnpack(Buf, OutData%C_Y) + if (RegCheckErr(Buf, RoutineName)) return + ! C_Z + call RegUnpack(Buf, OutData%C_Z) + if (RegCheckErr(Buf, RoutineName)) return + ! K_S + call RegUnpack(Buf, OutData%K_S) + if (RegCheckErr(Buf, RoutineName)) return + ! C_S + call RegUnpack(Buf, OutData%C_S) + if (RegCheckErr(Buf, RoutineName)) return + ! P_SP + call RegUnpack(Buf, OutData%P_SP) + if (RegCheckErr(Buf, RoutineName)) return + ! N_SP + call RegUnpack(Buf, OutData%N_SP) + if (RegCheckErr(Buf, RoutineName)) return + ! Gravity + call RegUnpack(Buf, OutData%Gravity) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_CMODE + call RegUnpack(Buf, OutData%StC_CMODE) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_SA_MODE + call RegUnpack(Buf, OutData%StC_SA_MODE) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_X_C_HIGH + call RegUnpack(Buf, OutData%StC_X_C_HIGH) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_X_C_LOW + call RegUnpack(Buf, OutData%StC_X_C_LOW) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Y_C_HIGH + call RegUnpack(Buf, OutData%StC_Y_C_HIGH) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Y_C_LOW + call RegUnpack(Buf, OutData%StC_Y_C_LOW) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Z_C_HIGH + call RegUnpack(Buf, OutData%StC_Z_C_HIGH) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Z_C_LOW + call RegUnpack(Buf, OutData%StC_Z_C_LOW) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_X_C_BRAKE + call RegUnpack(Buf, OutData%StC_X_C_BRAKE) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Y_C_BRAKE + call RegUnpack(Buf, OutData%StC_Y_C_BRAKE) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_Z_C_BRAKE + call RegUnpack(Buf, OutData%StC_Z_C_BRAKE) + if (RegCheckErr(Buf, RoutineName)) return + ! L_X + call RegUnpack(Buf, OutData%L_X) + if (RegCheckErr(Buf, RoutineName)) return + ! B_X + call RegUnpack(Buf, OutData%B_X) + if (RegCheckErr(Buf, RoutineName)) return + ! area_X + call RegUnpack(Buf, OutData%area_X) + if (RegCheckErr(Buf, RoutineName)) return + ! area_ratio_X + call RegUnpack(Buf, OutData%area_ratio_X) + if (RegCheckErr(Buf, RoutineName)) return + ! headLossCoeff_X + call RegUnpack(Buf, OutData%headLossCoeff_X) + if (RegCheckErr(Buf, RoutineName)) return + ! rho_X + call RegUnpack(Buf, OutData%rho_X) + if (RegCheckErr(Buf, RoutineName)) return + ! L_Y + call RegUnpack(Buf, OutData%L_Y) + if (RegCheckErr(Buf, RoutineName)) return + ! B_Y + call RegUnpack(Buf, OutData%B_Y) + if (RegCheckErr(Buf, RoutineName)) return + ! area_Y + call RegUnpack(Buf, OutData%area_Y) + if (RegCheckErr(Buf, RoutineName)) return + ! area_ratio_Y + call RegUnpack(Buf, OutData%area_ratio_Y) + if (RegCheckErr(Buf, RoutineName)) return + ! headLossCoeff_Y + call RegUnpack(Buf, OutData%headLossCoeff_Y) + if (RegCheckErr(Buf, RoutineName)) return + ! rho_Y + call RegUnpack(Buf, OutData%rho_Y) + if (RegCheckErr(Buf, RoutineName)) return + ! Use_F_TBL + call RegUnpack(Buf, OutData%Use_F_TBL) + if (RegCheckErr(Buf, RoutineName)) return + ! F_TBL + if (allocated(OutData%F_TBL)) deallocate(OutData%F_TBL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_TBL(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_TBL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_TBL) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NumMeshPts + call RegUnpack(Buf, OutData%NumMeshPts) + if (RegCheckErr(Buf, RoutineName)) return + ! PrescribedForcesCoordSys + call RegUnpack(Buf, OutData%PrescribedForcesCoordSys) + if (RegCheckErr(Buf, RoutineName)) return + ! StC_PrescribedForce + if (allocated(OutData%StC_PrescribedForce)) deallocate(OutData%StC_PrescribedForce) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StC_PrescribedForce(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StC_PrescribedForce.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StC_PrescribedForce) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! StC_CChan + if (allocated(OutData%StC_CChan)) deallocate(OutData%StC_CChan) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StC_CChan(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StC_CChan.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StC_CChan) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE StC_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(StC_InputType), INTENT(INOUT) :: SrcInputData TYPE(StC_InputType), INTENT(INOUT) :: DstInputData @@ -4936,413 +3128,141 @@ SUBROUTINE StC_DestroyInput( InputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE StC_DestroyInput - SUBROUTINE StC_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(StC_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! Mesh allocated yes/no - IF ( ALLOCATED(InData%Mesh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Mesh upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%Mesh,1), UBOUND(InData%Mesh,1) - Int_BufSz = Int_BufSz + 3 ! Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%Mesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Mesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Mesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Mesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! CmdStiff allocated yes/no - IF ( ALLOCATED(InData%CmdStiff) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CmdStiff upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CmdStiff) ! CmdStiff - END IF - Int_BufSz = Int_BufSz + 1 ! CmdDamp allocated yes/no - IF ( ALLOCATED(InData%CmdDamp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CmdDamp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CmdDamp) ! CmdDamp - END IF - Int_BufSz = Int_BufSz + 1 ! CmdBrake allocated yes/no - IF ( ALLOCATED(InData%CmdBrake) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CmdBrake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CmdBrake) ! CmdBrake - END IF - Int_BufSz = Int_BufSz + 1 ! CmdForce allocated yes/no - IF ( ALLOCATED(InData%CmdForce) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CmdForce upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CmdForce) ! CmdForce - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%Mesh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Mesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mesh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Mesh,1), UBOUND(InData%Mesh,1) - CALL MeshPack( InData%Mesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CmdStiff) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CmdStiff,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CmdStiff,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CmdStiff,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CmdStiff,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CmdStiff,2), UBOUND(InData%CmdStiff,2) - DO i1 = LBOUND(InData%CmdStiff,1), UBOUND(InData%CmdStiff,1) - ReKiBuf(Re_Xferred) = InData%CmdStiff(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CmdDamp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CmdDamp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CmdDamp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CmdDamp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CmdDamp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CmdDamp,2), UBOUND(InData%CmdDamp,2) - DO i1 = LBOUND(InData%CmdDamp,1), UBOUND(InData%CmdDamp,1) - ReKiBuf(Re_Xferred) = InData%CmdDamp(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CmdBrake) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CmdBrake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CmdBrake,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CmdBrake,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CmdBrake,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CmdBrake,2), UBOUND(InData%CmdBrake,2) - DO i1 = LBOUND(InData%CmdBrake,1), UBOUND(InData%CmdBrake,1) - ReKiBuf(Re_Xferred) = InData%CmdBrake(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CmdForce) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CmdForce,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CmdForce,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CmdForce,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CmdForce,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CmdForce,2), UBOUND(InData%CmdForce,2) - DO i1 = LBOUND(InData%CmdForce,1), UBOUND(InData%CmdForce,1) - ReKiBuf(Re_Xferred) = InData%CmdForce(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE StC_PackInput - - SUBROUTINE StC_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(StC_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Mesh not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Mesh)) DEALLOCATE(OutData%Mesh) - ALLOCATE(OutData%Mesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Mesh,1), UBOUND(OutData%Mesh,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%Mesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CmdStiff not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CmdStiff)) DEALLOCATE(OutData%CmdStiff) - ALLOCATE(OutData%CmdStiff(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CmdStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CmdStiff,2), UBOUND(OutData%CmdStiff,2) - DO i1 = LBOUND(OutData%CmdStiff,1), UBOUND(OutData%CmdStiff,1) - OutData%CmdStiff(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CmdDamp not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CmdDamp)) DEALLOCATE(OutData%CmdDamp) - ALLOCATE(OutData%CmdDamp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CmdDamp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CmdDamp,2), UBOUND(OutData%CmdDamp,2) - DO i1 = LBOUND(OutData%CmdDamp,1), UBOUND(OutData%CmdDamp,1) - OutData%CmdDamp(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CmdBrake not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CmdBrake)) DEALLOCATE(OutData%CmdBrake) - ALLOCATE(OutData%CmdBrake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CmdBrake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CmdBrake,2), UBOUND(OutData%CmdBrake,2) - DO i1 = LBOUND(OutData%CmdBrake,1), UBOUND(OutData%CmdBrake,1) - OutData%CmdBrake(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CmdForce not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CmdForce)) DEALLOCATE(OutData%CmdForce) - ALLOCATE(OutData%CmdForce(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CmdForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CmdForce,2), UBOUND(OutData%CmdForce,2) - DO i1 = LBOUND(OutData%CmdForce,1), UBOUND(OutData%CmdForce,1) - OutData%CmdForce(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE StC_UnPackInput +subroutine StC_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(StC_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'StC_PackInput' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + ! Mesh + call RegPack(Buf, allocated(InData%Mesh)) + if (allocated(InData%Mesh)) then + call RegPackBounds(Buf, 1, lbound(InData%Mesh), ubound(InData%Mesh)) + LB(1:1) = lbound(InData%Mesh) + UB(1:1) = ubound(InData%Mesh) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%Mesh(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CmdStiff + call RegPack(Buf, allocated(InData%CmdStiff)) + if (allocated(InData%CmdStiff)) then + call RegPackBounds(Buf, 2, lbound(InData%CmdStiff), ubound(InData%CmdStiff)) + call RegPack(Buf, InData%CmdStiff) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CmdDamp + call RegPack(Buf, allocated(InData%CmdDamp)) + if (allocated(InData%CmdDamp)) then + call RegPackBounds(Buf, 2, lbound(InData%CmdDamp), ubound(InData%CmdDamp)) + call RegPack(Buf, InData%CmdDamp) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CmdBrake + call RegPack(Buf, allocated(InData%CmdBrake)) + if (allocated(InData%CmdBrake)) then + call RegPackBounds(Buf, 2, lbound(InData%CmdBrake), ubound(InData%CmdBrake)) + call RegPack(Buf, InData%CmdBrake) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CmdForce + call RegPack(Buf, allocated(InData%CmdForce)) + if (allocated(InData%CmdForce)) then + call RegPackBounds(Buf, 2, lbound(InData%CmdForce), ubound(InData%CmdForce)) + call RegPack(Buf, InData%CmdForce) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine StC_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(StC_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'StC_UnPackInput' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! Mesh + if (allocated(OutData%Mesh)) deallocate(OutData%Mesh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Mesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%Mesh(i1)) ! Mesh + end do + end if + ! CmdStiff + if (allocated(OutData%CmdStiff)) deallocate(OutData%CmdStiff) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CmdStiff(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CmdStiff.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CmdStiff) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CmdDamp + if (allocated(OutData%CmdDamp)) deallocate(OutData%CmdDamp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CmdDamp(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CmdDamp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CmdDamp) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CmdBrake + if (allocated(OutData%CmdBrake)) deallocate(OutData%CmdBrake) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CmdBrake(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CmdBrake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CmdBrake) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CmdForce + if (allocated(OutData%CmdForce)) deallocate(OutData%CmdForce) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CmdForce(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CmdForce.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CmdForce) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE StC_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(StC_OutputType), INTENT(INOUT) :: SrcOutputData TYPE(StC_OutputType), INTENT(INOUT) :: DstOutputData @@ -5433,317 +3353,97 @@ SUBROUTINE StC_DestroyOutput( OutputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE StC_DestroyOutput - SUBROUTINE StC_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(StC_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! Mesh allocated yes/no - IF ( ALLOCATED(InData%Mesh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Mesh upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%Mesh,1), UBOUND(InData%Mesh,1) - Int_BufSz = Int_BufSz + 3 ! Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%Mesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Mesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Mesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Mesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! MeasDisp allocated yes/no - IF ( ALLOCATED(InData%MeasDisp) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MeasDisp upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MeasDisp) ! MeasDisp - END IF - Int_BufSz = Int_BufSz + 1 ! MeasVel allocated yes/no - IF ( ALLOCATED(InData%MeasVel) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MeasVel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MeasVel) ! MeasVel - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%Mesh) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Mesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mesh,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Mesh,1), UBOUND(InData%Mesh,1) - CALL MeshPack( InData%Mesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MeasDisp) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MeasDisp,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MeasDisp,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MeasDisp,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MeasDisp,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MeasDisp,2), UBOUND(InData%MeasDisp,2) - DO i1 = LBOUND(InData%MeasDisp,1), UBOUND(InData%MeasDisp,1) - ReKiBuf(Re_Xferred) = InData%MeasDisp(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MeasVel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MeasVel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MeasVel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MeasVel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MeasVel,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MeasVel,2), UBOUND(InData%MeasVel,2) - DO i1 = LBOUND(InData%MeasVel,1), UBOUND(InData%MeasVel,1) - ReKiBuf(Re_Xferred) = InData%MeasVel(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE StC_PackOutput - - SUBROUTINE StC_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(StC_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Mesh not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Mesh)) DEALLOCATE(OutData%Mesh) - ALLOCATE(OutData%Mesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Mesh,1), UBOUND(OutData%Mesh,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%Mesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MeasDisp not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MeasDisp)) DEALLOCATE(OutData%MeasDisp) - ALLOCATE(OutData%MeasDisp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MeasDisp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MeasDisp,2), UBOUND(OutData%MeasDisp,2) - DO i1 = LBOUND(OutData%MeasDisp,1), UBOUND(OutData%MeasDisp,1) - OutData%MeasDisp(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MeasVel not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MeasVel)) DEALLOCATE(OutData%MeasVel) - ALLOCATE(OutData%MeasVel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MeasVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MeasVel,2), UBOUND(OutData%MeasVel,2) - DO i1 = LBOUND(OutData%MeasVel,1), UBOUND(OutData%MeasVel,1) - OutData%MeasVel(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE StC_UnPackOutput +subroutine StC_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(StC_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'StC_PackOutput' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + ! Mesh + call RegPack(Buf, allocated(InData%Mesh)) + if (allocated(InData%Mesh)) then + call RegPackBounds(Buf, 1, lbound(InData%Mesh), ubound(InData%Mesh)) + LB(1:1) = lbound(InData%Mesh) + UB(1:1) = ubound(InData%Mesh) + do i1 = LB(1), UB(1) + call MeshPack(Buf, InData%Mesh(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MeasDisp + call RegPack(Buf, allocated(InData%MeasDisp)) + if (allocated(InData%MeasDisp)) then + call RegPackBounds(Buf, 2, lbound(InData%MeasDisp), ubound(InData%MeasDisp)) + call RegPack(Buf, InData%MeasDisp) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MeasVel + call RegPack(Buf, allocated(InData%MeasVel)) + if (allocated(InData%MeasVel)) then + call RegPackBounds(Buf, 2, lbound(InData%MeasVel), ubound(InData%MeasVel)) + call RegPack(Buf, InData%MeasVel) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine StC_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(StC_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'StC_UnPackOutput' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! Mesh + if (allocated(OutData%Mesh)) deallocate(OutData%Mesh) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Mesh(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mesh.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MeshUnpack(Buf, OutData%Mesh(i1)) ! Mesh + end do + end if + ! MeasDisp + if (allocated(OutData%MeasDisp)) deallocate(OutData%MeasDisp) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MeasDisp(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MeasDisp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MeasDisp) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! MeasVel + if (allocated(OutData%MeasVel)) deallocate(OutData%MeasVel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MeasVel(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MeasVel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MeasVel) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE StC_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) ! diff --git a/modules/subdyn/src/SubDyn_Types.f90 b/modules/subdyn/src/SubDyn_Types.f90 index c57f414fd8..f5ee30b7b9 100644 --- a/modules/subdyn/src/SubDyn_Types.f90 +++ b/modules/subdyn/src/SubDyn_Types.f90 @@ -389,137 +389,45 @@ SUBROUTINE SD_DestroyIList( IListData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE SD_DestroyIList - SUBROUTINE SD_PackIList( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(IList), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackIList' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! List allocated yes/no - IF ( ALLOCATED(InData%List) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! List upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%List) ! List - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%List) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%List,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%List,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%List,1), UBOUND(InData%List,1) - IntKiBuf(Int_Xferred) = InData%List(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_PackIList - - SUBROUTINE SD_UnPackIList( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(IList), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackIList' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! List not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%List)) DEALLOCATE(OutData%List) - ALLOCATE(OutData%List(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%List.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%List,1), UBOUND(OutData%List,1) - OutData%List(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_UnPackIList +subroutine SD_PackIList(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(IList), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackIList' + if (Buf%ErrStat >= AbortErrLev) return + ! List + call RegPack(Buf, allocated(InData%List)) + if (allocated(InData%List)) then + call RegPackBounds(Buf, 1, lbound(InData%List), ubound(InData%List)) + call RegPack(Buf, InData%List) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SD_UnPackIList(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(IList), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackIList' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! List + if (allocated(OutData%List)) deallocate(OutData%List) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%List(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%List.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%List) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE SD_CopyMeshAuxDataType( SrcMeshAuxDataTypeData, DstMeshAuxDataTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(MeshAuxDataType), INTENT(IN) :: SrcMeshAuxDataTypeData TYPE(MeshAuxDataType), INTENT(INOUT) :: DstMeshAuxDataTypeData @@ -682,478 +590,189 @@ SUBROUTINE SD_DestroyMeshAuxDataType( MeshAuxDataTypeData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE SD_DestroyMeshAuxDataType - SUBROUTINE SD_PackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MeshAuxDataType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackMeshAuxDataType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! MemberID - Int_BufSz = Int_BufSz + 1 ! NOutCnt - Int_BufSz = Int_BufSz + 1 ! NodeCnt allocated yes/no - IF ( ALLOCATED(InData%NodeCnt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NodeCnt upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NodeCnt) ! NodeCnt - END IF - Int_BufSz = Int_BufSz + 1 ! NodeIDs allocated yes/no - IF ( ALLOCATED(InData%NodeIDs) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NodeIDs upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NodeIDs) ! NodeIDs - END IF - Int_BufSz = Int_BufSz + 1 ! ElmIDs allocated yes/no - IF ( ALLOCATED(InData%ElmIDs) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ElmIDs upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ElmIDs) ! ElmIDs - END IF - Int_BufSz = Int_BufSz + 1 ! ElmNds allocated yes/no - IF ( ALLOCATED(InData%ElmNds) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ElmNds upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ElmNds) ! ElmNds - END IF - Int_BufSz = Int_BufSz + 1 ! Me allocated yes/no - IF ( ALLOCATED(InData%Me) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Me upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Me) ! Me - END IF - Int_BufSz = Int_BufSz + 1 ! Ke allocated yes/no - IF ( ALLOCATED(InData%Ke) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Ke upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Ke) ! Ke - END IF - Int_BufSz = Int_BufSz + 1 ! Fg allocated yes/no - IF ( ALLOCATED(InData%Fg) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Fg upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Fg) ! Fg - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%MemberID - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NOutCnt - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%NodeCnt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NodeCnt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodeCnt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NodeCnt,1), UBOUND(InData%NodeCnt,1) - IntKiBuf(Int_Xferred) = InData%NodeCnt(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NodeIDs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NodeIDs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodeIDs,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NodeIDs,1), UBOUND(InData%NodeIDs,1) - IntKiBuf(Int_Xferred) = InData%NodeIDs(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ElmIDs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ElmIDs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElmIDs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ElmIDs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElmIDs,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ElmIDs,2), UBOUND(InData%ElmIDs,2) - DO i1 = LBOUND(InData%ElmIDs,1), UBOUND(InData%ElmIDs,1) - IntKiBuf(Int_Xferred) = InData%ElmIDs(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ElmNds) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ElmNds,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElmNds,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ElmNds,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElmNds,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ElmNds,2), UBOUND(InData%ElmNds,2) - DO i1 = LBOUND(InData%ElmNds,1), UBOUND(InData%ElmNds,1) - IntKiBuf(Int_Xferred) = InData%ElmNds(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Me) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Me,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Me,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Me,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Me,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Me,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Me,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Me,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Me,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Me,4), UBOUND(InData%Me,4) - DO i3 = LBOUND(InData%Me,3), UBOUND(InData%Me,3) - DO i2 = LBOUND(InData%Me,2), UBOUND(InData%Me,2) - DO i1 = LBOUND(InData%Me,1), UBOUND(InData%Me,1) - DbKiBuf(Db_Xferred) = InData%Me(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Ke) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ke,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ke,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ke,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ke,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ke,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ke,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ke,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ke,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Ke,4), UBOUND(InData%Ke,4) - DO i3 = LBOUND(InData%Ke,3), UBOUND(InData%Ke,3) - DO i2 = LBOUND(InData%Ke,2), UBOUND(InData%Ke,2) - DO i1 = LBOUND(InData%Ke,1), UBOUND(InData%Ke,1) - DbKiBuf(Db_Xferred) = InData%Ke(i1,i2,i3,i4) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Fg) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fg,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fg,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fg,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fg,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fg,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fg,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Fg,3), UBOUND(InData%Fg,3) - DO i2 = LBOUND(InData%Fg,2), UBOUND(InData%Fg,2) - DO i1 = LBOUND(InData%Fg,1), UBOUND(InData%Fg,1) - DbKiBuf(Db_Xferred) = InData%Fg(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE SD_PackMeshAuxDataType - - SUBROUTINE SD_UnPackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MeshAuxDataType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackMeshAuxDataType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%MemberID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NOutCnt = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodeCnt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NodeCnt)) DEALLOCATE(OutData%NodeCnt) - ALLOCATE(OutData%NodeCnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeCnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NodeCnt,1), UBOUND(OutData%NodeCnt,1) - OutData%NodeCnt(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodeIDs not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NodeIDs)) DEALLOCATE(OutData%NodeIDs) - ALLOCATE(OutData%NodeIDs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeIDs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NodeIDs,1), UBOUND(OutData%NodeIDs,1) - OutData%NodeIDs(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElmIDs not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ElmIDs)) DEALLOCATE(OutData%ElmIDs) - ALLOCATE(OutData%ElmIDs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElmIDs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ElmIDs,2), UBOUND(OutData%ElmIDs,2) - DO i1 = LBOUND(OutData%ElmIDs,1), UBOUND(OutData%ElmIDs,1) - OutData%ElmIDs(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElmNds not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ElmNds)) DEALLOCATE(OutData%ElmNds) - ALLOCATE(OutData%ElmNds(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElmNds.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ElmNds,2), UBOUND(OutData%ElmNds,2) - DO i1 = LBOUND(OutData%ElmNds,1), UBOUND(OutData%ElmNds,1) - OutData%ElmNds(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Me not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Me)) DEALLOCATE(OutData%Me) - ALLOCATE(OutData%Me(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Me.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Me,4), UBOUND(OutData%Me,4) - DO i3 = LBOUND(OutData%Me,3), UBOUND(OutData%Me,3) - DO i2 = LBOUND(OutData%Me,2), UBOUND(OutData%Me,2) - DO i1 = LBOUND(OutData%Me,1), UBOUND(OutData%Me,1) - OutData%Me(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ke not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Ke)) DEALLOCATE(OutData%Ke) - ALLOCATE(OutData%Ke(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ke.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Ke,4), UBOUND(OutData%Ke,4) - DO i3 = LBOUND(OutData%Ke,3), UBOUND(OutData%Ke,3) - DO i2 = LBOUND(OutData%Ke,2), UBOUND(OutData%Ke,2) - DO i1 = LBOUND(OutData%Ke,1), UBOUND(OutData%Ke,1) - OutData%Ke(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fg not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Fg)) DEALLOCATE(OutData%Fg) - ALLOCATE(OutData%Fg(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Fg,3), UBOUND(OutData%Fg,3) - DO i2 = LBOUND(OutData%Fg,2), UBOUND(OutData%Fg,2) - DO i1 = LBOUND(OutData%Fg,1), UBOUND(OutData%Fg,1) - OutData%Fg(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE SD_UnPackMeshAuxDataType +subroutine SD_PackMeshAuxDataType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(MeshAuxDataType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackMeshAuxDataType' + if (Buf%ErrStat >= AbortErrLev) return + ! MemberID + call RegPack(Buf, InData%MemberID) + if (RegCheckErr(Buf, RoutineName)) return + ! NOutCnt + call RegPack(Buf, InData%NOutCnt) + if (RegCheckErr(Buf, RoutineName)) return + ! NodeCnt + call RegPack(Buf, allocated(InData%NodeCnt)) + if (allocated(InData%NodeCnt)) then + call RegPackBounds(Buf, 1, lbound(InData%NodeCnt), ubound(InData%NodeCnt)) + call RegPack(Buf, InData%NodeCnt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NodeIDs + call RegPack(Buf, allocated(InData%NodeIDs)) + if (allocated(InData%NodeIDs)) then + call RegPackBounds(Buf, 1, lbound(InData%NodeIDs), ubound(InData%NodeIDs)) + call RegPack(Buf, InData%NodeIDs) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ElmIDs + call RegPack(Buf, allocated(InData%ElmIDs)) + if (allocated(InData%ElmIDs)) then + call RegPackBounds(Buf, 2, lbound(InData%ElmIDs), ubound(InData%ElmIDs)) + call RegPack(Buf, InData%ElmIDs) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ElmNds + call RegPack(Buf, allocated(InData%ElmNds)) + if (allocated(InData%ElmNds)) then + call RegPackBounds(Buf, 2, lbound(InData%ElmNds), ubound(InData%ElmNds)) + call RegPack(Buf, InData%ElmNds) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Me + call RegPack(Buf, allocated(InData%Me)) + if (allocated(InData%Me)) then + call RegPackBounds(Buf, 4, lbound(InData%Me), ubound(InData%Me)) + call RegPack(Buf, InData%Me) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Ke + call RegPack(Buf, allocated(InData%Ke)) + if (allocated(InData%Ke)) then + call RegPackBounds(Buf, 4, lbound(InData%Ke), ubound(InData%Ke)) + call RegPack(Buf, InData%Ke) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Fg + call RegPack(Buf, allocated(InData%Fg)) + if (allocated(InData%Fg)) then + call RegPackBounds(Buf, 3, lbound(InData%Fg), ubound(InData%Fg)) + call RegPack(Buf, InData%Fg) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SD_UnPackMeshAuxDataType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(MeshAuxDataType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackMeshAuxDataType' + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! MemberID + call RegUnpack(Buf, OutData%MemberID) + if (RegCheckErr(Buf, RoutineName)) return + ! NOutCnt + call RegUnpack(Buf, OutData%NOutCnt) + if (RegCheckErr(Buf, RoutineName)) return + ! NodeCnt + if (allocated(OutData%NodeCnt)) deallocate(OutData%NodeCnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NodeCnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeCnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%NodeCnt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NodeIDs + if (allocated(OutData%NodeIDs)) deallocate(OutData%NodeIDs) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NodeIDs(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeIDs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%NodeIDs) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ElmIDs + if (allocated(OutData%ElmIDs)) deallocate(OutData%ElmIDs) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ElmIDs(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElmIDs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ElmIDs) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ElmNds + if (allocated(OutData%ElmNds)) deallocate(OutData%ElmNds) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ElmNds(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElmNds.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ElmNds) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Me + if (allocated(OutData%Me)) deallocate(OutData%Me) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Me(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Me.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Me) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Ke + if (allocated(OutData%Ke)) deallocate(OutData%Ke) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 4, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Ke(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ke.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Ke) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Fg + if (allocated(OutData%Fg)) deallocate(OutData%Fg) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Fg(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fg.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Fg) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE SD_CopyCB_MatArrays( SrcCB_MatArraysData, DstCB_MatArraysData, CtrlCode, ErrStat, ErrMsg ) TYPE(CB_MatArrays), INTENT(IN) :: SrcCB_MatArraysData TYPE(CB_MatArrays), INTENT(INOUT) :: DstCB_MatArraysData @@ -1287,378 +906,155 @@ SUBROUTINE SD_DestroyCB_MatArrays( CB_MatArraysData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE SD_DestroyCB_MatArrays - SUBROUTINE SD_PackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(CB_MatArrays), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackCB_MatArrays' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! MBB allocated yes/no - IF ( ALLOCATED(InData%MBB) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MBB upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%MBB) ! MBB - END IF - Int_BufSz = Int_BufSz + 1 ! MBM allocated yes/no - IF ( ALLOCATED(InData%MBM) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MBM upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%MBM) ! MBM - END IF - Int_BufSz = Int_BufSz + 1 ! KBB allocated yes/no - IF ( ALLOCATED(InData%KBB) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! KBB upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%KBB) ! KBB - END IF - Int_BufSz = Int_BufSz + 1 ! PhiL allocated yes/no - IF ( ALLOCATED(InData%PhiL) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PhiL upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%PhiL) ! PhiL - END IF - Int_BufSz = Int_BufSz + 1 ! PhiR allocated yes/no - IF ( ALLOCATED(InData%PhiR) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PhiR upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%PhiR) ! PhiR - END IF - Int_BufSz = Int_BufSz + 1 ! OmegaL allocated yes/no - IF ( ALLOCATED(InData%OmegaL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OmegaL upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%OmegaL) ! OmegaL - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%MBB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MBB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MBB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBB,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MBB,2), UBOUND(InData%MBB,2) - DO i1 = LBOUND(InData%MBB,1), UBOUND(InData%MBB,1) - DbKiBuf(Db_Xferred) = InData%MBB(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MBM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MBM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MBM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBM,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MBM,2), UBOUND(InData%MBM,2) - DO i1 = LBOUND(InData%MBM,1), UBOUND(InData%MBM,1) - DbKiBuf(Db_Xferred) = InData%MBM(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%KBB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%KBB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%KBB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBB,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%KBB,2), UBOUND(InData%KBB,2) - DO i1 = LBOUND(InData%KBB,1), UBOUND(InData%KBB,1) - DbKiBuf(Db_Xferred) = InData%KBB(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PhiL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiL,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PhiL,2), UBOUND(InData%PhiL,2) - DO i1 = LBOUND(InData%PhiL,1), UBOUND(InData%PhiL,1) - DbKiBuf(Db_Xferred) = InData%PhiL(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PhiR) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiR,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiR,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiR,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiR,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PhiR,2), UBOUND(InData%PhiR,2) - DO i1 = LBOUND(InData%PhiR,1), UBOUND(InData%PhiR,1) - DbKiBuf(Db_Xferred) = InData%PhiR(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OmegaL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OmegaL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OmegaL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OmegaL,1), UBOUND(InData%OmegaL,1) - DbKiBuf(Db_Xferred) = InData%OmegaL(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_PackCB_MatArrays - - SUBROUTINE SD_UnPackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(CB_MatArrays), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackCB_MatArrays' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MBB not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MBB)) DEALLOCATE(OutData%MBB) - ALLOCATE(OutData%MBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MBB,2), UBOUND(OutData%MBB,2) - DO i1 = LBOUND(OutData%MBB,1), UBOUND(OutData%MBB,1) - OutData%MBB(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MBM not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MBM)) DEALLOCATE(OutData%MBM) - ALLOCATE(OutData%MBM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MBM,2), UBOUND(OutData%MBM,2) - DO i1 = LBOUND(OutData%MBM,1), UBOUND(OutData%MBM,1) - OutData%MBM(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! KBB not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%KBB)) DEALLOCATE(OutData%KBB) - ALLOCATE(OutData%KBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%KBB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%KBB,2), UBOUND(OutData%KBB,2) - DO i1 = LBOUND(OutData%KBB,1), UBOUND(OutData%KBB,1) - OutData%KBB(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PhiL)) DEALLOCATE(OutData%PhiL) - ALLOCATE(OutData%PhiL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PhiL,2), UBOUND(OutData%PhiL,2) - DO i1 = LBOUND(OutData%PhiL,1), UBOUND(OutData%PhiL,1) - OutData%PhiL(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiR not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PhiR)) DEALLOCATE(OutData%PhiR) - ALLOCATE(OutData%PhiR(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiR.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PhiR,2), UBOUND(OutData%PhiR,2) - DO i1 = LBOUND(OutData%PhiR,1), UBOUND(OutData%PhiR,1) - OutData%PhiR(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OmegaL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OmegaL)) DEALLOCATE(OutData%OmegaL) - ALLOCATE(OutData%OmegaL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OmegaL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OmegaL,1), UBOUND(OutData%OmegaL,1) - OutData%OmegaL(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_UnPackCB_MatArrays +subroutine SD_PackCB_MatArrays(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(CB_MatArrays), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackCB_MatArrays' + if (Buf%ErrStat >= AbortErrLev) return + ! MBB + call RegPack(Buf, allocated(InData%MBB)) + if (allocated(InData%MBB)) then + call RegPackBounds(Buf, 2, lbound(InData%MBB), ubound(InData%MBB)) + call RegPack(Buf, InData%MBB) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MBM + call RegPack(Buf, allocated(InData%MBM)) + if (allocated(InData%MBM)) then + call RegPackBounds(Buf, 2, lbound(InData%MBM), ubound(InData%MBM)) + call RegPack(Buf, InData%MBM) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! KBB + call RegPack(Buf, allocated(InData%KBB)) + if (allocated(InData%KBB)) then + call RegPackBounds(Buf, 2, lbound(InData%KBB), ubound(InData%KBB)) + call RegPack(Buf, InData%KBB) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PhiL + call RegPack(Buf, allocated(InData%PhiL)) + if (allocated(InData%PhiL)) then + call RegPackBounds(Buf, 2, lbound(InData%PhiL), ubound(InData%PhiL)) + call RegPack(Buf, InData%PhiL) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PhiR + call RegPack(Buf, allocated(InData%PhiR)) + if (allocated(InData%PhiR)) then + call RegPackBounds(Buf, 2, lbound(InData%PhiR), ubound(InData%PhiR)) + call RegPack(Buf, InData%PhiR) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OmegaL + call RegPack(Buf, allocated(InData%OmegaL)) + if (allocated(InData%OmegaL)) then + call RegPackBounds(Buf, 1, lbound(InData%OmegaL), ubound(InData%OmegaL)) + call RegPack(Buf, InData%OmegaL) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SD_UnPackCB_MatArrays(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(CB_MatArrays), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackCB_MatArrays' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! MBB + if (allocated(OutData%MBB)) deallocate(OutData%MBB) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MBB(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MBB) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! MBM + if (allocated(OutData%MBM)) deallocate(OutData%MBM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MBM(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MBM) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! KBB + if (allocated(OutData%KBB)) deallocate(OutData%KBB) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%KBB(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%KBB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%KBB) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PhiL + if (allocated(OutData%PhiL)) deallocate(OutData%PhiL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PhiL(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PhiL) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PhiR + if (allocated(OutData%PhiR)) deallocate(OutData%PhiR) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PhiR(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiR.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PhiR) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! OmegaL + if (allocated(OutData%OmegaL)) deallocate(OutData%OmegaL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OmegaL(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OmegaL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%OmegaL) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE SD_CopyElemPropType( SrcElemPropTypeData, DstElemPropTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(ElemPropType), INTENT(IN) :: SrcElemPropTypeData TYPE(ElemPropType), INTENT(INOUT) :: DstElemPropTypeData @@ -1707,193 +1103,110 @@ SUBROUTINE SD_DestroyElemPropType( ElemPropTypeData, ErrStat, ErrMsg ) END SUBROUTINE SD_DestroyElemPropType - SUBROUTINE SD_PackElemPropType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ElemPropType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackElemPropType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! eType - Re_BufSz = Re_BufSz + 1 ! Length - Re_BufSz = Re_BufSz + 1 ! Ixx - Re_BufSz = Re_BufSz + 1 ! Iyy - Re_BufSz = Re_BufSz + 1 ! Jzz - Int_BufSz = Int_BufSz + 1 ! Shear - Re_BufSz = Re_BufSz + 1 ! Kappa_x - Re_BufSz = Re_BufSz + 1 ! Kappa_y - Re_BufSz = Re_BufSz + 1 ! YoungE - Re_BufSz = Re_BufSz + 1 ! ShearG - Re_BufSz = Re_BufSz + SIZE(InData%D) ! D - Re_BufSz = Re_BufSz + 1 ! Area - Re_BufSz = Re_BufSz + 1 ! Rho - Re_BufSz = Re_BufSz + 1 ! T0 - Db_BufSz = Db_BufSz + SIZE(InData%DirCos) ! DirCos - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%eType - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Length - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Ixx - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Iyy - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Jzz - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Shear, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Kappa_x - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Kappa_y - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%YoungE - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%ShearG - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%D,1), UBOUND(InData%D,1) - ReKiBuf(Re_Xferred) = InData%D(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%Area - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Rho - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%T0 - Re_Xferred = Re_Xferred + 1 - DO i2 = LBOUND(InData%DirCos,2), UBOUND(InData%DirCos,2) - DO i1 = LBOUND(InData%DirCos,1), UBOUND(InData%DirCos,1) - DbKiBuf(Db_Xferred) = InData%DirCos(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END SUBROUTINE SD_PackElemPropType - - SUBROUTINE SD_UnPackElemPropType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ElemPropType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackElemPropType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%eType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Length = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Ixx = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Iyy = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Jzz = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Shear = TRANSFER(IntKiBuf(Int_Xferred), OutData%Shear) - Int_Xferred = Int_Xferred + 1 - OutData%Kappa_x = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Kappa_y = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%YoungE = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%ShearG = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%D,1) - i1_u = UBOUND(OutData%D,1) - DO i1 = LBOUND(OutData%D,1), UBOUND(OutData%D,1) - OutData%D(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%Area = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Rho = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%T0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%DirCos,1) - i1_u = UBOUND(OutData%DirCos,1) - i2_l = LBOUND(OutData%DirCos,2) - i2_u = UBOUND(OutData%DirCos,2) - DO i2 = LBOUND(OutData%DirCos,2), UBOUND(OutData%DirCos,2) - DO i1 = LBOUND(OutData%DirCos,1), UBOUND(OutData%DirCos,1) - OutData%DirCos(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END SUBROUTINE SD_UnPackElemPropType +subroutine SD_PackElemPropType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ElemPropType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackElemPropType' + if (Buf%ErrStat >= AbortErrLev) return + ! eType + call RegPack(Buf, InData%eType) + if (RegCheckErr(Buf, RoutineName)) return + ! Length + call RegPack(Buf, InData%Length) + if (RegCheckErr(Buf, RoutineName)) return + ! Ixx + call RegPack(Buf, InData%Ixx) + if (RegCheckErr(Buf, RoutineName)) return + ! Iyy + call RegPack(Buf, InData%Iyy) + if (RegCheckErr(Buf, RoutineName)) return + ! Jzz + call RegPack(Buf, InData%Jzz) + if (RegCheckErr(Buf, RoutineName)) return + ! Shear + call RegPack(Buf, InData%Shear) + if (RegCheckErr(Buf, RoutineName)) return + ! Kappa_x + call RegPack(Buf, InData%Kappa_x) + if (RegCheckErr(Buf, RoutineName)) return + ! Kappa_y + call RegPack(Buf, InData%Kappa_y) + if (RegCheckErr(Buf, RoutineName)) return + ! YoungE + call RegPack(Buf, InData%YoungE) + if (RegCheckErr(Buf, RoutineName)) return + ! ShearG + call RegPack(Buf, InData%ShearG) + if (RegCheckErr(Buf, RoutineName)) return + ! D + call RegPack(Buf, InData%D) + if (RegCheckErr(Buf, RoutineName)) return + ! Area + call RegPack(Buf, InData%Area) + if (RegCheckErr(Buf, RoutineName)) return + ! Rho + call RegPack(Buf, InData%Rho) + if (RegCheckErr(Buf, RoutineName)) return + ! T0 + call RegPack(Buf, InData%T0) + if (RegCheckErr(Buf, RoutineName)) return + ! DirCos + call RegPack(Buf, InData%DirCos) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SD_UnPackElemPropType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ElemPropType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackElemPropType' + if (Buf%ErrStat /= ErrID_None) return + ! eType + call RegUnpack(Buf, OutData%eType) + if (RegCheckErr(Buf, RoutineName)) return + ! Length + call RegUnpack(Buf, OutData%Length) + if (RegCheckErr(Buf, RoutineName)) return + ! Ixx + call RegUnpack(Buf, OutData%Ixx) + if (RegCheckErr(Buf, RoutineName)) return + ! Iyy + call RegUnpack(Buf, OutData%Iyy) + if (RegCheckErr(Buf, RoutineName)) return + ! Jzz + call RegUnpack(Buf, OutData%Jzz) + if (RegCheckErr(Buf, RoutineName)) return + ! Shear + call RegUnpack(Buf, OutData%Shear) + if (RegCheckErr(Buf, RoutineName)) return + ! Kappa_x + call RegUnpack(Buf, OutData%Kappa_x) + if (RegCheckErr(Buf, RoutineName)) return + ! Kappa_y + call RegUnpack(Buf, OutData%Kappa_y) + if (RegCheckErr(Buf, RoutineName)) return + ! YoungE + call RegUnpack(Buf, OutData%YoungE) + if (RegCheckErr(Buf, RoutineName)) return + ! ShearG + call RegUnpack(Buf, OutData%ShearG) + if (RegCheckErr(Buf, RoutineName)) return + ! D + call RegUnpack(Buf, OutData%D) + if (RegCheckErr(Buf, RoutineName)) return + ! Area + call RegUnpack(Buf, OutData%Area) + if (RegCheckErr(Buf, RoutineName)) return + ! Rho + call RegUnpack(Buf, OutData%Rho) + if (RegCheckErr(Buf, RoutineName)) return + ! T0 + call RegUnpack(Buf, OutData%T0) + if (RegCheckErr(Buf, RoutineName)) return + ! DirCos + call RegUnpack(Buf, OutData%DirCos) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE SD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(SD_InitInputType), INTENT(INOUT) :: SrcInitInputData TYPE(SD_InitInputType), INTENT(INOUT) :: DstInitInputData @@ -1959,294 +1272,92 @@ SUBROUTINE SD_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE SD_DestroyInitInput - SUBROUTINE SD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SD_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%SDInputFile) ! SDInputFile - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Re_BufSz = Re_BufSz + 1 ! g - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Re_BufSz = Re_BufSz + SIZE(InData%TP_RefPoint) ! TP_RefPoint - Re_BufSz = Re_BufSz + 1 ! SubRotateZ - Int_BufSz = Int_BufSz + 1 ! SoilStiffness allocated yes/no - IF ( ALLOCATED(InData%SoilStiffness) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! SoilStiffness upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SoilStiffness) ! SoilStiffness - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! SoilMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%SoilMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! SoilMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SoilMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SoilMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SoilMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Linearize - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%SDInputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%SDInputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf(Re_Xferred) = InData%g - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%TP_RefPoint,1), UBOUND(InData%TP_RefPoint,1) - ReKiBuf(Re_Xferred) = InData%TP_RefPoint(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%SubRotateZ - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%SoilStiffness) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SoilStiffness,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SoilStiffness,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SoilStiffness,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SoilStiffness,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SoilStiffness,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SoilStiffness,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%SoilStiffness,3), UBOUND(InData%SoilStiffness,3) - DO i2 = LBOUND(InData%SoilStiffness,2), UBOUND(InData%SoilStiffness,2) - DO i1 = LBOUND(InData%SoilStiffness,1), UBOUND(InData%SoilStiffness,1) - ReKiBuf(Re_Xferred) = InData%SoilStiffness(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - CALL MeshPack( InData%SoilMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! SoilMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SD_PackInitInput - - SUBROUTINE SD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SD_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%SDInputFile) - OutData%SDInputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%g = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%TP_RefPoint,1) - i1_u = UBOUND(OutData%TP_RefPoint,1) - DO i1 = LBOUND(OutData%TP_RefPoint,1), UBOUND(OutData%TP_RefPoint,1) - OutData%TP_RefPoint(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%SubRotateZ = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SoilStiffness not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SoilStiffness)) DEALLOCATE(OutData%SoilStiffness) - ALLOCATE(OutData%SoilStiffness(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SoilStiffness.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%SoilStiffness,3), UBOUND(OutData%SoilStiffness,3) - DO i2 = LBOUND(OutData%SoilStiffness,2), UBOUND(OutData%SoilStiffness,2) - DO i1 = LBOUND(OutData%SoilStiffness,1), UBOUND(OutData%SoilStiffness,1) - OutData%SoilStiffness(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%SoilMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! SoilMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SD_UnPackInitInput +subroutine SD_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SD_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + ! SDInputFile + call RegPack(Buf, InData%SDInputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegPack(Buf, InData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! g + call RegPack(Buf, InData%g) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDpth + call RegPack(Buf, InData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! TP_RefPoint + call RegPack(Buf, InData%TP_RefPoint) + if (RegCheckErr(Buf, RoutineName)) return + ! SubRotateZ + call RegPack(Buf, InData%SubRotateZ) + if (RegCheckErr(Buf, RoutineName)) return + ! SoilStiffness + call RegPack(Buf, allocated(InData%SoilStiffness)) + if (allocated(InData%SoilStiffness)) then + call RegPackBounds(Buf, 3, lbound(InData%SoilStiffness), ubound(InData%SoilStiffness)) + call RegPack(Buf, InData%SoilStiffness) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SoilMesh + call MeshPack(Buf, InData%SoilMesh) + if (RegCheckErr(Buf, RoutineName)) return + ! Linearize + call RegPack(Buf, InData%Linearize) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SD_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SD_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackInitInput' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! SDInputFile + call RegUnpack(Buf, OutData%SDInputFile) + if (RegCheckErr(Buf, RoutineName)) return + ! RootName + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! g + call RegUnpack(Buf, OutData%g) + if (RegCheckErr(Buf, RoutineName)) return + ! WtrDpth + call RegUnpack(Buf, OutData%WtrDpth) + if (RegCheckErr(Buf, RoutineName)) return + ! TP_RefPoint + call RegUnpack(Buf, OutData%TP_RefPoint) + if (RegCheckErr(Buf, RoutineName)) return + ! SubRotateZ + call RegUnpack(Buf, OutData%SubRotateZ) + if (RegCheckErr(Buf, RoutineName)) return + ! SoilStiffness + if (allocated(OutData%SoilStiffness)) deallocate(OutData%SoilStiffness) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SoilStiffness(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SoilStiffness.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SoilStiffness) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! SoilMesh + call MeshUnpack(Buf, OutData%SoilMesh) ! SoilMesh + ! Linearize + call RegUnpack(Buf, OutData%Linearize) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE SD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(SD_InitOutputType), INTENT(IN) :: SrcInitOutputData TYPE(SD_InitOutputType), INTENT(INOUT) :: DstInitOutputData @@ -2449,623 +1560,270 @@ SUBROUTINE SD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE SD_DestroyInitOutput - SUBROUTINE SD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SD_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! WriteOutputHdr allocated yes/no - IF ( ALLOCATED(InData%WriteOutputHdr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdr upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdr)*LEN(InData%WriteOutputHdr) ! WriteOutputHdr - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputUnt allocated yes/no - IF ( ALLOCATED(InData%WriteOutputUnt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUnt upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUnt)*LEN(InData%WriteOutputUnt) ! WriteOutputUnt - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_y allocated yes/no - IF ( ALLOCATED(InData%LinNames_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_y)*LEN(InData%LinNames_y) ! LinNames_y - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_x allocated yes/no - IF ( ALLOCATED(InData%LinNames_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_x)*LEN(InData%LinNames_x) ! LinNames_x - END IF - Int_BufSz = Int_BufSz + 1 ! LinNames_u allocated yes/no - IF ( ALLOCATED(InData%LinNames_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinNames_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LinNames_u)*LEN(InData%LinNames_u) ! LinNames_u - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_y allocated yes/no - IF ( ALLOCATED(InData%RotFrame_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_y) ! RotFrame_y - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_x allocated yes/no - IF ( ALLOCATED(InData%RotFrame_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_x) ! RotFrame_x - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_u allocated yes/no - IF ( ALLOCATED(InData%RotFrame_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_u) ! RotFrame_u - END IF - Int_BufSz = Int_BufSz + 1 ! IsLoad_u allocated yes/no - IF ( ALLOCATED(InData%IsLoad_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IsLoad_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IsLoad_u) ! IsLoad_u - END IF - Int_BufSz = Int_BufSz + 1 ! DerivOrder_x allocated yes/no - IF ( ALLOCATED(InData%DerivOrder_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DerivOrder_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%DerivOrder_x) ! DerivOrder_x - END IF - Int_BufSz = Int_BufSz + 1 ! CableCChanRqst allocated yes/no - IF ( ALLOCATED(InData%CableCChanRqst) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CableCChanRqst upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%CableCChanRqst) ! CableCChanRqst - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%WriteOutputHdr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) - DO I = 1, LEN(InData%WriteOutputHdr) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputUnt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) - DO I = 1, LEN(InData%WriteOutputUnt) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%LinNames_y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) - DO I = 1, LEN(InData%LinNames_y) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_y(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinNames_x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_x,1), UBOUND(InData%LinNames_x,1) - DO I = 1, LEN(InData%LinNames_x) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_x(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%LinNames_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) - DO I = 1, LEN(InData%LinNames_u) - IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_u(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_y,1), UBOUND(InData%RotFrame_y,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_y(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_x,1), UBOUND(InData%RotFrame_x,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_x(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%RotFrame_u,1), UBOUND(InData%RotFrame_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IsLoad_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IsLoad_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DerivOrder_x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DerivOrder_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DerivOrder_x,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DerivOrder_x,1), UBOUND(InData%DerivOrder_x,1) - IntKiBuf(Int_Xferred) = InData%DerivOrder_x(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CableCChanRqst) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CableCChanRqst,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CableCChanRqst,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CableCChanRqst,1), UBOUND(InData%CableCChanRqst,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%CableCChanRqst(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_PackInitOutput - - SUBROUTINE SD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SD_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputHdr)) DEALLOCATE(OutData%WriteOutputHdr) - ALLOCATE(OutData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) - DO I = 1, LEN(OutData%WriteOutputHdr) - OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputUnt)) DEALLOCATE(OutData%WriteOutputUnt) - ALLOCATE(OutData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) - DO I = 1, LEN(OutData%WriteOutputUnt) - OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LinNames_y)) DEALLOCATE(OutData%LinNames_y) - ALLOCATE(OutData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) - DO I = 1, LEN(OutData%LinNames_y) - OutData%LinNames_y(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LinNames_x)) DEALLOCATE(OutData%LinNames_x) - ALLOCATE(OutData%LinNames_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_x,1), UBOUND(OutData%LinNames_x,1) - DO I = 1, LEN(OutData%LinNames_x) - OutData%LinNames_x(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LinNames_u)) DEALLOCATE(OutData%LinNames_u) - ALLOCATE(OutData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) - DO I = 1, LEN(OutData%LinNames_u) - OutData%LinNames_u(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RotFrame_y)) DEALLOCATE(OutData%RotFrame_y) - ALLOCATE(OutData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_y,1), UBOUND(OutData%RotFrame_y,1) - OutData%RotFrame_y(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_y(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RotFrame_x)) DEALLOCATE(OutData%RotFrame_x) - ALLOCATE(OutData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_x,1), UBOUND(OutData%RotFrame_x,1) - OutData%RotFrame_x(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_x(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RotFrame_u)) DEALLOCATE(OutData%RotFrame_u) - ALLOCATE(OutData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%RotFrame_u,1), UBOUND(OutData%RotFrame_u,1) - OutData%RotFrame_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IsLoad_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IsLoad_u)) DEALLOCATE(OutData%IsLoad_u) - ALLOCATE(OutData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) - OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DerivOrder_x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DerivOrder_x)) DEALLOCATE(OutData%DerivOrder_x) - ALLOCATE(OutData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DerivOrder_x,1), UBOUND(OutData%DerivOrder_x,1) - OutData%DerivOrder_x(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CableCChanRqst not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CableCChanRqst)) DEALLOCATE(OutData%CableCChanRqst) - ALLOCATE(OutData%CableCChanRqst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableCChanRqst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CableCChanRqst,1), UBOUND(OutData%CableCChanRqst,1) - OutData%CableCChanRqst(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%CableCChanRqst(i1)) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_UnPackInitOutput +subroutine SD_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SD_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! WriteOutputHdr + call RegPack(Buf, allocated(InData%WriteOutputHdr)) + if (allocated(InData%WriteOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPack(Buf, InData%WriteOutputHdr) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutputUnt + call RegPack(Buf, allocated(InData%WriteOutputUnt)) + if (allocated(InData%WriteOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPack(Buf, InData%WriteOutputUnt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Ver + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + if (RegCheckErr(Buf, RoutineName)) return + ! LinNames_y + call RegPack(Buf, allocated(InData%LinNames_y)) + if (allocated(InData%LinNames_y)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) + call RegPack(Buf, InData%LinNames_y) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LinNames_x + call RegPack(Buf, allocated(InData%LinNames_x)) + if (allocated(InData%LinNames_x)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_x), ubound(InData%LinNames_x)) + call RegPack(Buf, InData%LinNames_x) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LinNames_u + call RegPack(Buf, allocated(InData%LinNames_u)) + if (allocated(InData%LinNames_u)) then + call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) + call RegPack(Buf, InData%LinNames_u) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RotFrame_y + call RegPack(Buf, allocated(InData%RotFrame_y)) + if (allocated(InData%RotFrame_y)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y), ubound(InData%RotFrame_y)) + call RegPack(Buf, InData%RotFrame_y) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RotFrame_x + call RegPack(Buf, allocated(InData%RotFrame_x)) + if (allocated(InData%RotFrame_x)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x), ubound(InData%RotFrame_x)) + call RegPack(Buf, InData%RotFrame_x) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! RotFrame_u + call RegPack(Buf, allocated(InData%RotFrame_u)) + if (allocated(InData%RotFrame_u)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u), ubound(InData%RotFrame_u)) + call RegPack(Buf, InData%RotFrame_u) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! IsLoad_u + call RegPack(Buf, allocated(InData%IsLoad_u)) + if (allocated(InData%IsLoad_u)) then + call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) + call RegPack(Buf, InData%IsLoad_u) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DerivOrder_x + call RegPack(Buf, allocated(InData%DerivOrder_x)) + if (allocated(InData%DerivOrder_x)) then + call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x), ubound(InData%DerivOrder_x)) + call RegPack(Buf, InData%DerivOrder_x) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CableCChanRqst + call RegPack(Buf, allocated(InData%CableCChanRqst)) + if (allocated(InData%CableCChanRqst)) then + call RegPackBounds(Buf, 1, lbound(InData%CableCChanRqst), ubound(InData%CableCChanRqst)) + call RegPack(Buf, InData%CableCChanRqst) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SD_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SD_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackInitOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! WriteOutputHdr + if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WriteOutputUnt + if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Ver + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + ! LinNames_y + if (allocated(OutData%LinNames_y)) deallocate(OutData%LinNames_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LinNames_x + if (allocated(OutData%LinNames_x)) deallocate(OutData%LinNames_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LinNames_u + if (allocated(OutData%LinNames_u)) deallocate(OutData%LinNames_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%LinNames_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%LinNames_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RotFrame_y + if (allocated(OutData%RotFrame_y)) deallocate(OutData%RotFrame_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RotFrame_x + if (allocated(OutData%RotFrame_x)) deallocate(OutData%RotFrame_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! RotFrame_u + if (allocated(OutData%RotFrame_u)) deallocate(OutData%RotFrame_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%RotFrame_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! IsLoad_u + if (allocated(OutData%IsLoad_u)) deallocate(OutData%IsLoad_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IsLoad_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IsLoad_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! DerivOrder_x + if (allocated(OutData%DerivOrder_x)) deallocate(OutData%DerivOrder_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DerivOrder_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DerivOrder_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CableCChanRqst + if (allocated(OutData%CableCChanRqst)) deallocate(OutData%CableCChanRqst) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CableCChanRqst(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableCChanRqst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CableCChanRqst) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE SD_CopyInitType( SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(SD_InitType), INTENT(IN) :: SrcInitTypeData TYPE(SD_InitType), INTENT(INOUT) :: DstInitTypeData @@ -3561,1480 +2319,745 @@ SUBROUTINE SD_DestroyInitType( InitTypeData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE SD_DestroyInitType - SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SD_InitType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackInitType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Re_BufSz = Re_BufSz + SIZE(InData%TP_RefPoint) ! TP_RefPoint - Re_BufSz = Re_BufSz + 1 ! SubRotateZ - Re_BufSz = Re_BufSz + 1 ! g - Db_BufSz = Db_BufSz + 1 ! DT - Int_BufSz = Int_BufSz + 1 ! NJoints - Int_BufSz = Int_BufSz + 1 ! NPropSetsX - Int_BufSz = Int_BufSz + 1 ! NPropSetsB - Int_BufSz = Int_BufSz + 1 ! NPropSetsC - Int_BufSz = Int_BufSz + 1 ! NPropSetsR - Int_BufSz = Int_BufSz + 1 ! NCMass - Int_BufSz = Int_BufSz + 1 ! NCOSMs - Int_BufSz = Int_BufSz + 1 ! FEMMod - Int_BufSz = Int_BufSz + 1 ! NDiv - Int_BufSz = Int_BufSz + 1 ! CBMod - Int_BufSz = Int_BufSz + 1 ! Joints allocated yes/no - IF ( ALLOCATED(InData%Joints) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Joints upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Joints) ! Joints - END IF - Int_BufSz = Int_BufSz + 1 ! PropSetsB allocated yes/no - IF ( ALLOCATED(InData%PropSetsB) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PropSetsB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PropSetsB) ! PropSetsB - END IF - Int_BufSz = Int_BufSz + 1 ! PropSetsC allocated yes/no - IF ( ALLOCATED(InData%PropSetsC) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PropSetsC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PropSetsC) ! PropSetsC - END IF - Int_BufSz = Int_BufSz + 1 ! PropSetsR allocated yes/no - IF ( ALLOCATED(InData%PropSetsR) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PropSetsR upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PropSetsR) ! PropSetsR - END IF - Int_BufSz = Int_BufSz + 1 ! PropSetsX allocated yes/no - IF ( ALLOCATED(InData%PropSetsX) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PropSetsX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PropSetsX) ! PropSetsX - END IF - Int_BufSz = Int_BufSz + 1 ! COSMs allocated yes/no - IF ( ALLOCATED(InData%COSMs) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! COSMs upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%COSMs) ! COSMs - END IF - Int_BufSz = Int_BufSz + 1 ! CMass allocated yes/no - IF ( ALLOCATED(InData%CMass) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CMass upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CMass) ! CMass - END IF - Int_BufSz = Int_BufSz + 1 ! JDampings allocated yes/no - IF ( ALLOCATED(InData%JDampings) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! JDampings upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%JDampings) ! JDampings - END IF - Int_BufSz = Int_BufSz + 1 ! GuyanDampMod - Re_BufSz = Re_BufSz + SIZE(InData%RayleighDamp) ! RayleighDamp - Re_BufSz = Re_BufSz + SIZE(InData%GuyanDampMat) ! GuyanDampMat - Int_BufSz = Int_BufSz + 1 ! Members allocated yes/no - IF ( ALLOCATED(InData%Members) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Members upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Members) ! Members - END IF - Int_BufSz = Int_BufSz + 1 ! SSOutList allocated yes/no - IF ( ALLOCATED(InData%SSOutList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SSOutList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%SSOutList)*LEN(InData%SSOutList) ! SSOutList - END IF - Int_BufSz = Int_BufSz + 1 ! OutCOSM - Int_BufSz = Int_BufSz + 1 ! TabDelim - Int_BufSz = Int_BufSz + 1 ! SSIK allocated yes/no - IF ( ALLOCATED(InData%SSIK) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! SSIK upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%SSIK) ! SSIK - END IF - Int_BufSz = Int_BufSz + 1 ! SSIM allocated yes/no - IF ( ALLOCATED(InData%SSIM) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! SSIM upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%SSIM) ! SSIM - END IF - Int_BufSz = Int_BufSz + 1 ! SSIfile allocated yes/no - IF ( ALLOCATED(InData%SSIfile) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SSIfile upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%SSIfile)*LEN(InData%SSIfile) ! SSIfile - END IF - Int_BufSz = Int_BufSz + 1 ! Soil_K allocated yes/no - IF ( ALLOCATED(InData%Soil_K) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Soil_K upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Soil_K) ! Soil_K - END IF - Int_BufSz = Int_BufSz + 1 ! Soil_Points allocated yes/no - IF ( ALLOCATED(InData%Soil_Points) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Soil_Points upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Soil_Points) ! Soil_Points - END IF - Int_BufSz = Int_BufSz + 1 ! Soil_Nodes allocated yes/no - IF ( ALLOCATED(InData%Soil_Nodes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Soil_Nodes upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Soil_Nodes) ! Soil_Nodes - END IF - Int_BufSz = Int_BufSz + 1 ! NElem - Int_BufSz = Int_BufSz + 1 ! NPropB - Int_BufSz = Int_BufSz + 1 ! NPropC - Int_BufSz = Int_BufSz + 1 ! NPropR - Int_BufSz = Int_BufSz + 1 ! Nodes allocated yes/no - IF ( ALLOCATED(InData%Nodes) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Nodes upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Nodes) ! Nodes - END IF - Int_BufSz = Int_BufSz + 1 ! PropsB allocated yes/no - IF ( ALLOCATED(InData%PropsB) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PropsB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PropsB) ! PropsB - END IF - Int_BufSz = Int_BufSz + 1 ! PropsC allocated yes/no - IF ( ALLOCATED(InData%PropsC) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PropsC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PropsC) ! PropsC - END IF - Int_BufSz = Int_BufSz + 1 ! PropsR allocated yes/no - IF ( ALLOCATED(InData%PropsR) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PropsR upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PropsR) ! PropsR - END IF - Int_BufSz = Int_BufSz + 1 ! K allocated yes/no - IF ( ALLOCATED(InData%K) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! K upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%K) ! K - END IF - Int_BufSz = Int_BufSz + 1 ! M allocated yes/no - IF ( ALLOCATED(InData%M) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! M upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%M) ! M - END IF - Int_BufSz = Int_BufSz + 1 ! ElemProps allocated yes/no - IF ( ALLOCATED(InData%ElemProps) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ElemProps upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ElemProps) ! ElemProps - END IF - Int_BufSz = Int_BufSz + 1 ! MemberNodes allocated yes/no - IF ( ALLOCATED(InData%MemberNodes) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MemberNodes upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%MemberNodes) ! MemberNodes - END IF - Int_BufSz = Int_BufSz + 1 ! NodesConnN allocated yes/no - IF ( ALLOCATED(InData%NodesConnN) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! NodesConnN upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NodesConnN) ! NodesConnN - END IF - Int_BufSz = Int_BufSz + 1 ! NodesConnE allocated yes/no - IF ( ALLOCATED(InData%NodesConnE) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! NodesConnE upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NodesConnE) ! NodesConnE - END IF - Int_BufSz = Int_BufSz + 1 ! SSSum - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO i1 = LBOUND(InData%TP_RefPoint,1), UBOUND(InData%TP_RefPoint,1) - ReKiBuf(Re_Xferred) = InData%TP_RefPoint(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%SubRotateZ - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%g - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NJoints - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPropSetsX - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPropSetsB - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPropSetsC - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPropSetsR - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NCMass - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NCOSMs - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%FEMMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NDiv - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%CBMod, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Joints) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Joints,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Joints,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Joints,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Joints,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Joints,2), UBOUND(InData%Joints,2) - DO i1 = LBOUND(InData%Joints,1), UBOUND(InData%Joints,1) - ReKiBuf(Re_Xferred) = InData%Joints(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PropSetsB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropSetsB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSetsB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropSetsB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSetsB,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PropSetsB,2), UBOUND(InData%PropSetsB,2) - DO i1 = LBOUND(InData%PropSetsB,1), UBOUND(InData%PropSetsB,1) - ReKiBuf(Re_Xferred) = InData%PropSetsB(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PropSetsC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropSetsC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSetsC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropSetsC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSetsC,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PropSetsC,2), UBOUND(InData%PropSetsC,2) - DO i1 = LBOUND(InData%PropSetsC,1), UBOUND(InData%PropSetsC,1) - ReKiBuf(Re_Xferred) = InData%PropSetsC(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PropSetsR) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropSetsR,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSetsR,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropSetsR,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSetsR,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PropSetsR,2), UBOUND(InData%PropSetsR,2) - DO i1 = LBOUND(InData%PropSetsR,1), UBOUND(InData%PropSetsR,1) - ReKiBuf(Re_Xferred) = InData%PropSetsR(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PropSetsX) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropSetsX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSetsX,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropSetsX,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSetsX,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PropSetsX,2), UBOUND(InData%PropSetsX,2) - DO i1 = LBOUND(InData%PropSetsX,1), UBOUND(InData%PropSetsX,1) - ReKiBuf(Re_Xferred) = InData%PropSetsX(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%COSMs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%COSMs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%COSMs,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%COSMs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%COSMs,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%COSMs,2), UBOUND(InData%COSMs,2) - DO i1 = LBOUND(InData%COSMs,1), UBOUND(InData%COSMs,1) - DbKiBuf(Db_Xferred) = InData%COSMs(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CMass) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CMass,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CMass,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CMass,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CMass,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CMass,2), UBOUND(InData%CMass,2) - DO i1 = LBOUND(InData%CMass,1), UBOUND(InData%CMass,1) - ReKiBuf(Re_Xferred) = InData%CMass(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%JDampings) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%JDampings,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%JDampings,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%JDampings,1), UBOUND(InData%JDampings,1) - ReKiBuf(Re_Xferred) = InData%JDampings(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%GuyanDampMod - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%RayleighDamp,1), UBOUND(InData%RayleighDamp,1) - ReKiBuf(Re_Xferred) = InData%RayleighDamp(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i2 = LBOUND(InData%GuyanDampMat,2), UBOUND(InData%GuyanDampMat,2) - DO i1 = LBOUND(InData%GuyanDampMat,1), UBOUND(InData%GuyanDampMat,1) - ReKiBuf(Re_Xferred) = InData%GuyanDampMat(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( .NOT. ALLOCATED(InData%Members) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Members,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Members,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Members,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Members,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Members,2), UBOUND(InData%Members,2) - DO i1 = LBOUND(InData%Members,1), UBOUND(InData%Members,1) - IntKiBuf(Int_Xferred) = InData%Members(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SSOutList) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SSOutList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SSOutList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SSOutList,1), UBOUND(InData%SSOutList,1) - DO I = 1, LEN(InData%SSOutList) - IntKiBuf(Int_Xferred) = ICHAR(InData%SSOutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%OutCOSM, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%TabDelim, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%SSIK) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SSIK,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SSIK,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SSIK,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SSIK,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%SSIK,2), UBOUND(InData%SSIK,2) - DO i1 = LBOUND(InData%SSIK,1), UBOUND(InData%SSIK,1) - DbKiBuf(Db_Xferred) = InData%SSIK(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SSIM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SSIM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SSIM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SSIM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SSIM,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%SSIM,2), UBOUND(InData%SSIM,2) - DO i1 = LBOUND(InData%SSIM,1), UBOUND(InData%SSIM,1) - DbKiBuf(Db_Xferred) = InData%SSIM(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SSIfile) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SSIfile,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SSIfile,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SSIfile,1), UBOUND(InData%SSIfile,1) - DO I = 1, LEN(InData%SSIfile) - IntKiBuf(Int_Xferred) = ICHAR(InData%SSIfile(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Soil_K) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Soil_K,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Soil_K,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Soil_K,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Soil_K,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Soil_K,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Soil_K,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Soil_K,3), UBOUND(InData%Soil_K,3) - DO i2 = LBOUND(InData%Soil_K,2), UBOUND(InData%Soil_K,2) - DO i1 = LBOUND(InData%Soil_K,1), UBOUND(InData%Soil_K,1) - ReKiBuf(Re_Xferred) = InData%Soil_K(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Soil_Points) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Soil_Points,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Soil_Points,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Soil_Points,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Soil_Points,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Soil_Points,2), UBOUND(InData%Soil_Points,2) - DO i1 = LBOUND(InData%Soil_Points,1), UBOUND(InData%Soil_Points,1) - ReKiBuf(Re_Xferred) = InData%Soil_Points(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Soil_Nodes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Soil_Nodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Soil_Nodes,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Soil_Nodes,1), UBOUND(InData%Soil_Nodes,1) - IntKiBuf(Int_Xferred) = InData%Soil_Nodes(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NElem - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPropB - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPropC - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NPropR - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Nodes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Nodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nodes,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Nodes,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nodes,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Nodes,2), UBOUND(InData%Nodes,2) - DO i1 = LBOUND(InData%Nodes,1), UBOUND(InData%Nodes,1) - ReKiBuf(Re_Xferred) = InData%Nodes(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PropsB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropsB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropsB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropsB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropsB,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PropsB,2), UBOUND(InData%PropsB,2) - DO i1 = LBOUND(InData%PropsB,1), UBOUND(InData%PropsB,1) - ReKiBuf(Re_Xferred) = InData%PropsB(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PropsC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropsC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropsC,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropsC,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropsC,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PropsC,2), UBOUND(InData%PropsC,2) - DO i1 = LBOUND(InData%PropsC,1), UBOUND(InData%PropsC,1) - ReKiBuf(Re_Xferred) = InData%PropsC(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PropsR) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropsR,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropsR,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PropsR,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropsR,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PropsR,2), UBOUND(InData%PropsR,2) - DO i1 = LBOUND(InData%PropsR,1), UBOUND(InData%PropsR,1) - ReKiBuf(Re_Xferred) = InData%PropsR(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%K) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%K,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%K,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%K,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%K,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%K,2), UBOUND(InData%K,2) - DO i1 = LBOUND(InData%K,1), UBOUND(InData%K,1) - DbKiBuf(Db_Xferred) = InData%K(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%M) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%M,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%M,2), UBOUND(InData%M,2) - DO i1 = LBOUND(InData%M,1), UBOUND(InData%M,1) - DbKiBuf(Db_Xferred) = InData%M(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ElemProps) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ElemProps,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElemProps,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ElemProps,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElemProps,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ElemProps,2), UBOUND(InData%ElemProps,2) - DO i1 = LBOUND(InData%ElemProps,1), UBOUND(InData%ElemProps,1) - ReKiBuf(Re_Xferred) = InData%ElemProps(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MemberNodes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MemberNodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MemberNodes,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MemberNodes,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MemberNodes,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MemberNodes,2), UBOUND(InData%MemberNodes,2) - DO i1 = LBOUND(InData%MemberNodes,1), UBOUND(InData%MemberNodes,1) - IntKiBuf(Int_Xferred) = InData%MemberNodes(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NodesConnN) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NodesConnN,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodesConnN,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NodesConnN,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodesConnN,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%NodesConnN,2), UBOUND(InData%NodesConnN,2) - DO i1 = LBOUND(InData%NodesConnN,1), UBOUND(InData%NodesConnN,1) - IntKiBuf(Int_Xferred) = InData%NodesConnN(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NodesConnE) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NodesConnE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodesConnE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NodesConnE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodesConnE,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%NodesConnE,2), UBOUND(InData%NodesConnE,2) - DO i1 = LBOUND(InData%NodesConnE,1), UBOUND(InData%NodesConnE,1) - IntKiBuf(Int_Xferred) = InData%NodesConnE(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%SSSum, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SD_PackInitType - - SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SD_InitType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackInitType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - i1_l = LBOUND(OutData%TP_RefPoint,1) - i1_u = UBOUND(OutData%TP_RefPoint,1) - DO i1 = LBOUND(OutData%TP_RefPoint,1), UBOUND(OutData%TP_RefPoint,1) - OutData%TP_RefPoint(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%SubRotateZ = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%g = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%NJoints = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPropSetsX = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPropSetsB = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPropSetsC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPropSetsR = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NCMass = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NCOSMs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FEMMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NDiv = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%CBMod = TRANSFER(IntKiBuf(Int_Xferred), OutData%CBMod) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Joints not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Joints)) DEALLOCATE(OutData%Joints) - ALLOCATE(OutData%Joints(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Joints.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Joints,2), UBOUND(OutData%Joints,2) - DO i1 = LBOUND(OutData%Joints,1), UBOUND(OutData%Joints,1) - OutData%Joints(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PropSetsB not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PropSetsB)) DEALLOCATE(OutData%PropSetsB) - ALLOCATE(OutData%PropSetsB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropSetsB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PropSetsB,2), UBOUND(OutData%PropSetsB,2) - DO i1 = LBOUND(OutData%PropSetsB,1), UBOUND(OutData%PropSetsB,1) - OutData%PropSetsB(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PropSetsC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PropSetsC)) DEALLOCATE(OutData%PropSetsC) - ALLOCATE(OutData%PropSetsC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropSetsC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PropSetsC,2), UBOUND(OutData%PropSetsC,2) - DO i1 = LBOUND(OutData%PropSetsC,1), UBOUND(OutData%PropSetsC,1) - OutData%PropSetsC(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PropSetsR not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PropSetsR)) DEALLOCATE(OutData%PropSetsR) - ALLOCATE(OutData%PropSetsR(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropSetsR.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PropSetsR,2), UBOUND(OutData%PropSetsR,2) - DO i1 = LBOUND(OutData%PropSetsR,1), UBOUND(OutData%PropSetsR,1) - OutData%PropSetsR(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PropSetsX not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PropSetsX)) DEALLOCATE(OutData%PropSetsX) - ALLOCATE(OutData%PropSetsX(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropSetsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PropSetsX,2), UBOUND(OutData%PropSetsX,2) - DO i1 = LBOUND(OutData%PropSetsX,1), UBOUND(OutData%PropSetsX,1) - OutData%PropSetsX(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! COSMs not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%COSMs)) DEALLOCATE(OutData%COSMs) - ALLOCATE(OutData%COSMs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%COSMs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%COSMs,2), UBOUND(OutData%COSMs,2) - DO i1 = LBOUND(OutData%COSMs,1), UBOUND(OutData%COSMs,1) - OutData%COSMs(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CMass not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CMass)) DEALLOCATE(OutData%CMass) - ALLOCATE(OutData%CMass(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CMass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CMass,2), UBOUND(OutData%CMass,2) - DO i1 = LBOUND(OutData%CMass,1), UBOUND(OutData%CMass,1) - OutData%CMass(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! JDampings not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%JDampings)) DEALLOCATE(OutData%JDampings) - ALLOCATE(OutData%JDampings(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%JDampings.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%JDampings,1), UBOUND(OutData%JDampings,1) - OutData%JDampings(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%GuyanDampMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%RayleighDamp,1) - i1_u = UBOUND(OutData%RayleighDamp,1) - DO i1 = LBOUND(OutData%RayleighDamp,1), UBOUND(OutData%RayleighDamp,1) - OutData%RayleighDamp(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%GuyanDampMat,1) - i1_u = UBOUND(OutData%GuyanDampMat,1) - i2_l = LBOUND(OutData%GuyanDampMat,2) - i2_u = UBOUND(OutData%GuyanDampMat,2) - DO i2 = LBOUND(OutData%GuyanDampMat,2), UBOUND(OutData%GuyanDampMat,2) - DO i1 = LBOUND(OutData%GuyanDampMat,1), UBOUND(OutData%GuyanDampMat,1) - OutData%GuyanDampMat(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Members not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Members)) DEALLOCATE(OutData%Members) - ALLOCATE(OutData%Members(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Members.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Members,2), UBOUND(OutData%Members,2) - DO i1 = LBOUND(OutData%Members,1), UBOUND(OutData%Members,1) - OutData%Members(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SSOutList not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SSOutList)) DEALLOCATE(OutData%SSOutList) - ALLOCATE(OutData%SSOutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SSOutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SSOutList,1), UBOUND(OutData%SSOutList,1) - DO I = 1, LEN(OutData%SSOutList) - OutData%SSOutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - OutData%OutCOSM = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutCOSM) - Int_Xferred = Int_Xferred + 1 - OutData%TabDelim = TRANSFER(IntKiBuf(Int_Xferred), OutData%TabDelim) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SSIK not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SSIK)) DEALLOCATE(OutData%SSIK) - ALLOCATE(OutData%SSIK(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SSIK.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%SSIK,2), UBOUND(OutData%SSIK,2) - DO i1 = LBOUND(OutData%SSIK,1), UBOUND(OutData%SSIK,1) - OutData%SSIK(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SSIM not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SSIM)) DEALLOCATE(OutData%SSIM) - ALLOCATE(OutData%SSIM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SSIM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%SSIM,2), UBOUND(OutData%SSIM,2) - DO i1 = LBOUND(OutData%SSIM,1), UBOUND(OutData%SSIM,1) - OutData%SSIM(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SSIfile not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SSIfile)) DEALLOCATE(OutData%SSIfile) - ALLOCATE(OutData%SSIfile(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SSIfile.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SSIfile,1), UBOUND(OutData%SSIfile,1) - DO I = 1, LEN(OutData%SSIfile) - OutData%SSIfile(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Soil_K not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Soil_K)) DEALLOCATE(OutData%Soil_K) - ALLOCATE(OutData%Soil_K(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Soil_K.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Soil_K,3), UBOUND(OutData%Soil_K,3) - DO i2 = LBOUND(OutData%Soil_K,2), UBOUND(OutData%Soil_K,2) - DO i1 = LBOUND(OutData%Soil_K,1), UBOUND(OutData%Soil_K,1) - OutData%Soil_K(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Soil_Points not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Soil_Points)) DEALLOCATE(OutData%Soil_Points) - ALLOCATE(OutData%Soil_Points(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Soil_Points.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Soil_Points,2), UBOUND(OutData%Soil_Points,2) - DO i1 = LBOUND(OutData%Soil_Points,1), UBOUND(OutData%Soil_Points,1) - OutData%Soil_Points(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Soil_Nodes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Soil_Nodes)) DEALLOCATE(OutData%Soil_Nodes) - ALLOCATE(OutData%Soil_Nodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Soil_Nodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Soil_Nodes,1), UBOUND(OutData%Soil_Nodes,1) - OutData%Soil_Nodes(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%NElem = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPropB = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPropC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NPropR = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Nodes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Nodes)) DEALLOCATE(OutData%Nodes) - ALLOCATE(OutData%Nodes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Nodes,2), UBOUND(OutData%Nodes,2) - DO i1 = LBOUND(OutData%Nodes,1), UBOUND(OutData%Nodes,1) - OutData%Nodes(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PropsB not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PropsB)) DEALLOCATE(OutData%PropsB) - ALLOCATE(OutData%PropsB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropsB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PropsB,2), UBOUND(OutData%PropsB,2) - DO i1 = LBOUND(OutData%PropsB,1), UBOUND(OutData%PropsB,1) - OutData%PropsB(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PropsC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PropsC)) DEALLOCATE(OutData%PropsC) - ALLOCATE(OutData%PropsC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropsC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PropsC,2), UBOUND(OutData%PropsC,2) - DO i1 = LBOUND(OutData%PropsC,1), UBOUND(OutData%PropsC,1) - OutData%PropsC(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PropsR not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PropsR)) DEALLOCATE(OutData%PropsR) - ALLOCATE(OutData%PropsR(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropsR.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PropsR,2), UBOUND(OutData%PropsR,2) - DO i1 = LBOUND(OutData%PropsR,1), UBOUND(OutData%PropsR,1) - OutData%PropsR(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! K not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%K)) DEALLOCATE(OutData%K) - ALLOCATE(OutData%K(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%K.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%K,2), UBOUND(OutData%K,2) - DO i1 = LBOUND(OutData%K,1), UBOUND(OutData%K,1) - OutData%K(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%M)) DEALLOCATE(OutData%M) - ALLOCATE(OutData%M(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%M,2), UBOUND(OutData%M,2) - DO i1 = LBOUND(OutData%M,1), UBOUND(OutData%M,1) - OutData%M(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElemProps not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ElemProps)) DEALLOCATE(OutData%ElemProps) - ALLOCATE(OutData%ElemProps(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElemProps.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ElemProps,2), UBOUND(OutData%ElemProps,2) - DO i1 = LBOUND(OutData%ElemProps,1), UBOUND(OutData%ElemProps,1) - OutData%ElemProps(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MemberNodes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MemberNodes)) DEALLOCATE(OutData%MemberNodes) - ALLOCATE(OutData%MemberNodes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MemberNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MemberNodes,2), UBOUND(OutData%MemberNodes,2) - DO i1 = LBOUND(OutData%MemberNodes,1), UBOUND(OutData%MemberNodes,1) - OutData%MemberNodes(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodesConnN not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NodesConnN)) DEALLOCATE(OutData%NodesConnN) - ALLOCATE(OutData%NodesConnN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodesConnN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%NodesConnN,2), UBOUND(OutData%NodesConnN,2) - DO i1 = LBOUND(OutData%NodesConnN,1), UBOUND(OutData%NodesConnN,1) - OutData%NodesConnN(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodesConnE not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NodesConnE)) DEALLOCATE(OutData%NodesConnE) - ALLOCATE(OutData%NodesConnE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodesConnE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%NodesConnE,2), UBOUND(OutData%NodesConnE,2) - DO i1 = LBOUND(OutData%NodesConnE,1), UBOUND(OutData%NodesConnE,1) - OutData%NodesConnE(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - OutData%SSSum = TRANSFER(IntKiBuf(Int_Xferred), OutData%SSSum) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SD_UnPackInitType +subroutine SD_PackInitType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SD_InitType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackInitType' + if (Buf%ErrStat >= AbortErrLev) return + ! RootName + call RegPack(Buf, InData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! TP_RefPoint + call RegPack(Buf, InData%TP_RefPoint) + if (RegCheckErr(Buf, RoutineName)) return + ! SubRotateZ + call RegPack(Buf, InData%SubRotateZ) + if (RegCheckErr(Buf, RoutineName)) return + ! g + call RegPack(Buf, InData%g) + if (RegCheckErr(Buf, RoutineName)) return + ! DT + call RegPack(Buf, InData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! NJoints + call RegPack(Buf, InData%NJoints) + if (RegCheckErr(Buf, RoutineName)) return + ! NPropSetsX + call RegPack(Buf, InData%NPropSetsX) + if (RegCheckErr(Buf, RoutineName)) return + ! NPropSetsB + call RegPack(Buf, InData%NPropSetsB) + if (RegCheckErr(Buf, RoutineName)) return + ! NPropSetsC + call RegPack(Buf, InData%NPropSetsC) + if (RegCheckErr(Buf, RoutineName)) return + ! NPropSetsR + call RegPack(Buf, InData%NPropSetsR) + if (RegCheckErr(Buf, RoutineName)) return + ! NCMass + call RegPack(Buf, InData%NCMass) + if (RegCheckErr(Buf, RoutineName)) return + ! NCOSMs + call RegPack(Buf, InData%NCOSMs) + if (RegCheckErr(Buf, RoutineName)) return + ! FEMMod + call RegPack(Buf, InData%FEMMod) + if (RegCheckErr(Buf, RoutineName)) return + ! NDiv + call RegPack(Buf, InData%NDiv) + if (RegCheckErr(Buf, RoutineName)) return + ! CBMod + call RegPack(Buf, InData%CBMod) + if (RegCheckErr(Buf, RoutineName)) return + ! Joints + call RegPack(Buf, allocated(InData%Joints)) + if (allocated(InData%Joints)) then + call RegPackBounds(Buf, 2, lbound(InData%Joints), ubound(InData%Joints)) + call RegPack(Buf, InData%Joints) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PropSetsB + call RegPack(Buf, allocated(InData%PropSetsB)) + if (allocated(InData%PropSetsB)) then + call RegPackBounds(Buf, 2, lbound(InData%PropSetsB), ubound(InData%PropSetsB)) + call RegPack(Buf, InData%PropSetsB) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PropSetsC + call RegPack(Buf, allocated(InData%PropSetsC)) + if (allocated(InData%PropSetsC)) then + call RegPackBounds(Buf, 2, lbound(InData%PropSetsC), ubound(InData%PropSetsC)) + call RegPack(Buf, InData%PropSetsC) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PropSetsR + call RegPack(Buf, allocated(InData%PropSetsR)) + if (allocated(InData%PropSetsR)) then + call RegPackBounds(Buf, 2, lbound(InData%PropSetsR), ubound(InData%PropSetsR)) + call RegPack(Buf, InData%PropSetsR) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PropSetsX + call RegPack(Buf, allocated(InData%PropSetsX)) + if (allocated(InData%PropSetsX)) then + call RegPackBounds(Buf, 2, lbound(InData%PropSetsX), ubound(InData%PropSetsX)) + call RegPack(Buf, InData%PropSetsX) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! COSMs + call RegPack(Buf, allocated(InData%COSMs)) + if (allocated(InData%COSMs)) then + call RegPackBounds(Buf, 2, lbound(InData%COSMs), ubound(InData%COSMs)) + call RegPack(Buf, InData%COSMs) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CMass + call RegPack(Buf, allocated(InData%CMass)) + if (allocated(InData%CMass)) then + call RegPackBounds(Buf, 2, lbound(InData%CMass), ubound(InData%CMass)) + call RegPack(Buf, InData%CMass) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! JDampings + call RegPack(Buf, allocated(InData%JDampings)) + if (allocated(InData%JDampings)) then + call RegPackBounds(Buf, 1, lbound(InData%JDampings), ubound(InData%JDampings)) + call RegPack(Buf, InData%JDampings) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! GuyanDampMod + call RegPack(Buf, InData%GuyanDampMod) + if (RegCheckErr(Buf, RoutineName)) return + ! RayleighDamp + call RegPack(Buf, InData%RayleighDamp) + if (RegCheckErr(Buf, RoutineName)) return + ! GuyanDampMat + call RegPack(Buf, InData%GuyanDampMat) + if (RegCheckErr(Buf, RoutineName)) return + ! Members + call RegPack(Buf, allocated(InData%Members)) + if (allocated(InData%Members)) then + call RegPackBounds(Buf, 2, lbound(InData%Members), ubound(InData%Members)) + call RegPack(Buf, InData%Members) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SSOutList + call RegPack(Buf, allocated(InData%SSOutList)) + if (allocated(InData%SSOutList)) then + call RegPackBounds(Buf, 1, lbound(InData%SSOutList), ubound(InData%SSOutList)) + call RegPack(Buf, InData%SSOutList) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OutCOSM + call RegPack(Buf, InData%OutCOSM) + if (RegCheckErr(Buf, RoutineName)) return + ! TabDelim + call RegPack(Buf, InData%TabDelim) + if (RegCheckErr(Buf, RoutineName)) return + ! SSIK + call RegPack(Buf, allocated(InData%SSIK)) + if (allocated(InData%SSIK)) then + call RegPackBounds(Buf, 2, lbound(InData%SSIK), ubound(InData%SSIK)) + call RegPack(Buf, InData%SSIK) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SSIM + call RegPack(Buf, allocated(InData%SSIM)) + if (allocated(InData%SSIM)) then + call RegPackBounds(Buf, 2, lbound(InData%SSIM), ubound(InData%SSIM)) + call RegPack(Buf, InData%SSIM) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SSIfile + call RegPack(Buf, allocated(InData%SSIfile)) + if (allocated(InData%SSIfile)) then + call RegPackBounds(Buf, 1, lbound(InData%SSIfile), ubound(InData%SSIfile)) + call RegPack(Buf, InData%SSIfile) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Soil_K + call RegPack(Buf, allocated(InData%Soil_K)) + if (allocated(InData%Soil_K)) then + call RegPackBounds(Buf, 3, lbound(InData%Soil_K), ubound(InData%Soil_K)) + call RegPack(Buf, InData%Soil_K) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Soil_Points + call RegPack(Buf, allocated(InData%Soil_Points)) + if (allocated(InData%Soil_Points)) then + call RegPackBounds(Buf, 2, lbound(InData%Soil_Points), ubound(InData%Soil_Points)) + call RegPack(Buf, InData%Soil_Points) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Soil_Nodes + call RegPack(Buf, allocated(InData%Soil_Nodes)) + if (allocated(InData%Soil_Nodes)) then + call RegPackBounds(Buf, 1, lbound(InData%Soil_Nodes), ubound(InData%Soil_Nodes)) + call RegPack(Buf, InData%Soil_Nodes) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NElem + call RegPack(Buf, InData%NElem) + if (RegCheckErr(Buf, RoutineName)) return + ! NPropB + call RegPack(Buf, InData%NPropB) + if (RegCheckErr(Buf, RoutineName)) return + ! NPropC + call RegPack(Buf, InData%NPropC) + if (RegCheckErr(Buf, RoutineName)) return + ! NPropR + call RegPack(Buf, InData%NPropR) + if (RegCheckErr(Buf, RoutineName)) return + ! Nodes + call RegPack(Buf, allocated(InData%Nodes)) + if (allocated(InData%Nodes)) then + call RegPackBounds(Buf, 2, lbound(InData%Nodes), ubound(InData%Nodes)) + call RegPack(Buf, InData%Nodes) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PropsB + call RegPack(Buf, allocated(InData%PropsB)) + if (allocated(InData%PropsB)) then + call RegPackBounds(Buf, 2, lbound(InData%PropsB), ubound(InData%PropsB)) + call RegPack(Buf, InData%PropsB) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PropsC + call RegPack(Buf, allocated(InData%PropsC)) + if (allocated(InData%PropsC)) then + call RegPackBounds(Buf, 2, lbound(InData%PropsC), ubound(InData%PropsC)) + call RegPack(Buf, InData%PropsC) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PropsR + call RegPack(Buf, allocated(InData%PropsR)) + if (allocated(InData%PropsR)) then + call RegPackBounds(Buf, 2, lbound(InData%PropsR), ubound(InData%PropsR)) + call RegPack(Buf, InData%PropsR) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! K + call RegPack(Buf, allocated(InData%K)) + if (allocated(InData%K)) then + call RegPackBounds(Buf, 2, lbound(InData%K), ubound(InData%K)) + call RegPack(Buf, InData%K) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! M + call RegPack(Buf, allocated(InData%M)) + if (allocated(InData%M)) then + call RegPackBounds(Buf, 2, lbound(InData%M), ubound(InData%M)) + call RegPack(Buf, InData%M) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ElemProps + call RegPack(Buf, allocated(InData%ElemProps)) + if (allocated(InData%ElemProps)) then + call RegPackBounds(Buf, 2, lbound(InData%ElemProps), ubound(InData%ElemProps)) + call RegPack(Buf, InData%ElemProps) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MemberNodes + call RegPack(Buf, allocated(InData%MemberNodes)) + if (allocated(InData%MemberNodes)) then + call RegPackBounds(Buf, 2, lbound(InData%MemberNodes), ubound(InData%MemberNodes)) + call RegPack(Buf, InData%MemberNodes) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NodesConnN + call RegPack(Buf, allocated(InData%NodesConnN)) + if (allocated(InData%NodesConnN)) then + call RegPackBounds(Buf, 2, lbound(InData%NodesConnN), ubound(InData%NodesConnN)) + call RegPack(Buf, InData%NodesConnN) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NodesConnE + call RegPack(Buf, allocated(InData%NodesConnE)) + if (allocated(InData%NodesConnE)) then + call RegPackBounds(Buf, 2, lbound(InData%NodesConnE), ubound(InData%NodesConnE)) + call RegPack(Buf, InData%NodesConnE) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SSSum + call RegPack(Buf, InData%SSSum) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SD_UnPackInitType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SD_InitType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackInitType' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! RootName + call RegUnpack(Buf, OutData%RootName) + if (RegCheckErr(Buf, RoutineName)) return + ! TP_RefPoint + call RegUnpack(Buf, OutData%TP_RefPoint) + if (RegCheckErr(Buf, RoutineName)) return + ! SubRotateZ + call RegUnpack(Buf, OutData%SubRotateZ) + if (RegCheckErr(Buf, RoutineName)) return + ! g + call RegUnpack(Buf, OutData%g) + if (RegCheckErr(Buf, RoutineName)) return + ! DT + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! NJoints + call RegUnpack(Buf, OutData%NJoints) + if (RegCheckErr(Buf, RoutineName)) return + ! NPropSetsX + call RegUnpack(Buf, OutData%NPropSetsX) + if (RegCheckErr(Buf, RoutineName)) return + ! NPropSetsB + call RegUnpack(Buf, OutData%NPropSetsB) + if (RegCheckErr(Buf, RoutineName)) return + ! NPropSetsC + call RegUnpack(Buf, OutData%NPropSetsC) + if (RegCheckErr(Buf, RoutineName)) return + ! NPropSetsR + call RegUnpack(Buf, OutData%NPropSetsR) + if (RegCheckErr(Buf, RoutineName)) return + ! NCMass + call RegUnpack(Buf, OutData%NCMass) + if (RegCheckErr(Buf, RoutineName)) return + ! NCOSMs + call RegUnpack(Buf, OutData%NCOSMs) + if (RegCheckErr(Buf, RoutineName)) return + ! FEMMod + call RegUnpack(Buf, OutData%FEMMod) + if (RegCheckErr(Buf, RoutineName)) return + ! NDiv + call RegUnpack(Buf, OutData%NDiv) + if (RegCheckErr(Buf, RoutineName)) return + ! CBMod + call RegUnpack(Buf, OutData%CBMod) + if (RegCheckErr(Buf, RoutineName)) return + ! Joints + if (allocated(OutData%Joints)) deallocate(OutData%Joints) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Joints(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Joints.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Joints) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PropSetsB + if (allocated(OutData%PropSetsB)) deallocate(OutData%PropSetsB) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PropSetsB(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropSetsB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PropSetsB) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PropSetsC + if (allocated(OutData%PropSetsC)) deallocate(OutData%PropSetsC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PropSetsC(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropSetsC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PropSetsC) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PropSetsR + if (allocated(OutData%PropSetsR)) deallocate(OutData%PropSetsR) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PropSetsR(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropSetsR.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PropSetsR) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PropSetsX + if (allocated(OutData%PropSetsX)) deallocate(OutData%PropSetsX) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PropSetsX(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropSetsX.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PropSetsX) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! COSMs + if (allocated(OutData%COSMs)) deallocate(OutData%COSMs) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%COSMs(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%COSMs.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%COSMs) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CMass + if (allocated(OutData%CMass)) deallocate(OutData%CMass) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CMass(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CMass.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CMass) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! JDampings + if (allocated(OutData%JDampings)) deallocate(OutData%JDampings) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%JDampings(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%JDampings.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%JDampings) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! GuyanDampMod + call RegUnpack(Buf, OutData%GuyanDampMod) + if (RegCheckErr(Buf, RoutineName)) return + ! RayleighDamp + call RegUnpack(Buf, OutData%RayleighDamp) + if (RegCheckErr(Buf, RoutineName)) return + ! GuyanDampMat + call RegUnpack(Buf, OutData%GuyanDampMat) + if (RegCheckErr(Buf, RoutineName)) return + ! Members + if (allocated(OutData%Members)) deallocate(OutData%Members) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Members(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Members.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Members) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! SSOutList + if (allocated(OutData%SSOutList)) deallocate(OutData%SSOutList) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SSOutList(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SSOutList.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SSOutList) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! OutCOSM + call RegUnpack(Buf, OutData%OutCOSM) + if (RegCheckErr(Buf, RoutineName)) return + ! TabDelim + call RegUnpack(Buf, OutData%TabDelim) + if (RegCheckErr(Buf, RoutineName)) return + ! SSIK + if (allocated(OutData%SSIK)) deallocate(OutData%SSIK) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SSIK(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SSIK.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SSIK) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! SSIM + if (allocated(OutData%SSIM)) deallocate(OutData%SSIM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SSIM(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SSIM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SSIM) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! SSIfile + if (allocated(OutData%SSIfile)) deallocate(OutData%SSIfile) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SSIfile(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SSIfile.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SSIfile) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Soil_K + if (allocated(OutData%Soil_K)) deallocate(OutData%Soil_K) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Soil_K(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Soil_K.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Soil_K) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Soil_Points + if (allocated(OutData%Soil_Points)) deallocate(OutData%Soil_Points) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Soil_Points(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Soil_Points.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Soil_Points) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Soil_Nodes + if (allocated(OutData%Soil_Nodes)) deallocate(OutData%Soil_Nodes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Soil_Nodes(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Soil_Nodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Soil_Nodes) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NElem + call RegUnpack(Buf, OutData%NElem) + if (RegCheckErr(Buf, RoutineName)) return + ! NPropB + call RegUnpack(Buf, OutData%NPropB) + if (RegCheckErr(Buf, RoutineName)) return + ! NPropC + call RegUnpack(Buf, OutData%NPropC) + if (RegCheckErr(Buf, RoutineName)) return + ! NPropR + call RegUnpack(Buf, OutData%NPropR) + if (RegCheckErr(Buf, RoutineName)) return + ! Nodes + if (allocated(OutData%Nodes)) deallocate(OutData%Nodes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Nodes(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Nodes) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PropsB + if (allocated(OutData%PropsB)) deallocate(OutData%PropsB) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PropsB(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropsB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PropsB) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PropsC + if (allocated(OutData%PropsC)) deallocate(OutData%PropsC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PropsC(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropsC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PropsC) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PropsR + if (allocated(OutData%PropsR)) deallocate(OutData%PropsR) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PropsR(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropsR.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PropsR) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! K + if (allocated(OutData%K)) deallocate(OutData%K) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%K(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%K.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%K) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! M + if (allocated(OutData%M)) deallocate(OutData%M) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%M(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%M.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%M) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ElemProps + if (allocated(OutData%ElemProps)) deallocate(OutData%ElemProps) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ElemProps(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElemProps.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ElemProps) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! MemberNodes + if (allocated(OutData%MemberNodes)) deallocate(OutData%MemberNodes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MemberNodes(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MemberNodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MemberNodes) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NodesConnN + if (allocated(OutData%NodesConnN)) deallocate(OutData%NodesConnN) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NodesConnN(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodesConnN.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%NodesConnN) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NodesConnE + if (allocated(OutData%NodesConnE)) deallocate(OutData%NodesConnE) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NodesConnE(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodesConnE.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%NodesConnE) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! SSSum + call RegUnpack(Buf, OutData%SSSum) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE SD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(SD_ContinuousStateType), INTENT(IN) :: SrcContStateData TYPE(SD_ContinuousStateType), INTENT(INOUT) :: DstContStateData @@ -5097,175 +3120,67 @@ SUBROUTINE SD_DestroyContState( ContStateData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE SD_DestroyContState - SUBROUTINE SD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SD_ContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackContState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! qm allocated yes/no - IF ( ALLOCATED(InData%qm) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! qm upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%qm) ! qm - END IF - Int_BufSz = Int_BufSz + 1 ! qmdot allocated yes/no - IF ( ALLOCATED(InData%qmdot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! qmdot upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%qmdot) ! qmdot - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%qm) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%qm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%qm,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%qm,1), UBOUND(InData%qm,1) - DbKiBuf(Db_Xferred) = InData%qm(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%qmdot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%qmdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%qmdot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%qmdot,1), UBOUND(InData%qmdot,1) - DbKiBuf(Db_Xferred) = InData%qmdot(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_PackContState - - SUBROUTINE SD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SD_ContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackContState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! qm not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%qm)) DEALLOCATE(OutData%qm) - ALLOCATE(OutData%qm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%qm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%qm,1), UBOUND(OutData%qm,1) - OutData%qm(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! qmdot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%qmdot)) DEALLOCATE(OutData%qmdot) - ALLOCATE(OutData%qmdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%qmdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%qmdot,1), UBOUND(OutData%qmdot,1) - OutData%qmdot(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_UnPackContState +subroutine SD_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SD_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + ! qm + call RegPack(Buf, allocated(InData%qm)) + if (allocated(InData%qm)) then + call RegPackBounds(Buf, 1, lbound(InData%qm), ubound(InData%qm)) + call RegPack(Buf, InData%qm) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! qmdot + call RegPack(Buf, allocated(InData%qmdot)) + if (allocated(InData%qmdot)) then + call RegPackBounds(Buf, 1, lbound(InData%qmdot), ubound(InData%qmdot)) + call RegPack(Buf, InData%qmdot) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SD_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SD_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackContState' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! qm + if (allocated(OutData%qm)) deallocate(OutData%qm) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%qm(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%qm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%qm) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! qmdot + if (allocated(OutData%qmdot)) deallocate(OutData%qmdot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%qmdot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%qmdot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%qmdot) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE SD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(SD_DiscreteStateType), INTENT(IN) :: SrcDiscStateData TYPE(SD_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData @@ -5298,103 +3213,26 @@ SUBROUTINE SD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) END SUBROUTINE SD_DestroyDiscState - SUBROUTINE SD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SD_DiscreteStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackDiscState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyDiscState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SD_PackDiscState - - SUBROUTINE SD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SD_DiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackDiscState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyDiscState = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SD_UnPackDiscState +subroutine SD_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SD_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyDiscState + call RegPack(Buf, InData%DummyDiscState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SD_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SD_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackDiscState' + if (Buf%ErrStat /= ErrID_None) return + ! DummyDiscState + call RegUnpack(Buf, OutData%DummyDiscState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE SD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(SD_ConstraintStateType), INTENT(IN) :: SrcConstrStateData TYPE(SD_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData @@ -5427,103 +3265,26 @@ SUBROUTINE SD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) END SUBROUTINE SD_DestroyConstrState - SUBROUTINE SD_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SD_ConstraintStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackConstrState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyConstrState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SD_PackConstrState - - SUBROUTINE SD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SD_ConstraintStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackConstrState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyConstrState = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SD_UnPackConstrState +subroutine SD_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SD_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyConstrState + call RegPack(Buf, InData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SD_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SD_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + ! DummyConstrState + call RegUnpack(Buf, OutData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE SD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(SD_OtherStateType), INTENT(IN) :: SrcOtherStateData TYPE(SD_OtherStateType), INTENT(INOUT) :: DstOtherStateData @@ -5580,225 +3341,59 @@ SUBROUTINE SD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE SD_DestroyOtherState - SUBROUTINE SD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SD_OtherStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackOtherState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! xdot allocated yes/no - IF ( ALLOCATED(InData%xdot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! xdot upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) - Int_BufSz = Int_BufSz + 3 ! xdot: size of buffers for each call to pack subtype - CALL SD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xdot - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xdot - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xdot - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xdot - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! n - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%xdot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xdot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) - CALL SD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, OnlySize ) ! xdot - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IntKiBuf(Int_Xferred) = InData%n - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SD_PackOtherState - - SUBROUTINE SD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SD_OtherStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackOtherState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xdot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%xdot)) DEALLOCATE(OutData%xdot) - ALLOCATE(OutData%xdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%xdot,1), UBOUND(OutData%xdot,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%xdot(i1), ErrStat2, ErrMsg2 ) ! xdot - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - OutData%n = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SD_UnPackOtherState +subroutine SD_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SD_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackOtherState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + ! xdot + call RegPack(Buf, allocated(InData%xdot)) + if (allocated(InData%xdot)) then + call RegPackBounds(Buf, 1, lbound(InData%xdot), ubound(InData%xdot)) + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) + do i1 = LB(1), UB(1) + call SD_PackContState(Buf, InData%xdot(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! n + call RegPack(Buf, InData%n) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SD_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SD_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackOtherState' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! xdot + if (allocated(OutData%xdot)) deallocate(OutData%xdot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xdot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xdot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackContState(Buf, OutData%xdot(i1)) ! xdot + end do + end if + ! n + call RegUnpack(Buf, OutData%n) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE SD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) TYPE(SD_MiscVarType), INTENT(IN) :: SrcMiscData TYPE(SD_MiscVarType), INTENT(INOUT) :: DstMiscData @@ -6196,1054 +3791,581 @@ SUBROUTINE SD_DestroyMisc( MiscData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE SD_DestroyMisc - SUBROUTINE SD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SD_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! qmdotdot allocated yes/no - IF ( ALLOCATED(InData%qmdotdot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! qmdotdot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%qmdotdot) ! qmdotdot - END IF - Re_BufSz = Re_BufSz + SIZE(InData%u_TP) ! u_TP - Re_BufSz = Re_BufSz + SIZE(InData%udot_TP) ! udot_TP - Re_BufSz = Re_BufSz + SIZE(InData%udotdot_TP) ! udotdot_TP - Int_BufSz = Int_BufSz + 1 ! F_L allocated yes/no - IF ( ALLOCATED(InData%F_L) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! F_L upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_L) ! F_L - END IF - Int_BufSz = Int_BufSz + 1 ! F_L2 allocated yes/no - IF ( ALLOCATED(InData%F_L2) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! F_L2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_L2) ! F_L2 - END IF - Int_BufSz = Int_BufSz + 1 ! UR_bar allocated yes/no - IF ( ALLOCATED(InData%UR_bar) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UR_bar upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%UR_bar) ! UR_bar - END IF - Int_BufSz = Int_BufSz + 1 ! UR_bar_dot allocated yes/no - IF ( ALLOCATED(InData%UR_bar_dot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UR_bar_dot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%UR_bar_dot) ! UR_bar_dot - END IF - Int_BufSz = Int_BufSz + 1 ! UR_bar_dotdot allocated yes/no - IF ( ALLOCATED(InData%UR_bar_dotdot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UR_bar_dotdot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%UR_bar_dotdot) ! UR_bar_dotdot - END IF - Int_BufSz = Int_BufSz + 1 ! UL allocated yes/no - IF ( ALLOCATED(InData%UL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%UL) ! UL - END IF - Int_BufSz = Int_BufSz + 1 ! UL_NS allocated yes/no - IF ( ALLOCATED(InData%UL_NS) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UL_NS upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%UL_NS) ! UL_NS - END IF - Int_BufSz = Int_BufSz + 1 ! UL_dot allocated yes/no - IF ( ALLOCATED(InData%UL_dot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UL_dot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%UL_dot) ! UL_dot - END IF - Int_BufSz = Int_BufSz + 1 ! UL_dotdot allocated yes/no - IF ( ALLOCATED(InData%UL_dotdot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UL_dotdot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%UL_dotdot) ! UL_dotdot - END IF - Int_BufSz = Int_BufSz + 1 ! DU_full allocated yes/no - IF ( ALLOCATED(InData%DU_full) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DU_full upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DU_full) ! DU_full - END IF - Int_BufSz = Int_BufSz + 1 ! U_full allocated yes/no - IF ( ALLOCATED(InData%U_full) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! U_full upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%U_full) ! U_full - END IF - Int_BufSz = Int_BufSz + 1 ! U_full_NS allocated yes/no - IF ( ALLOCATED(InData%U_full_NS) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! U_full_NS upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%U_full_NS) ! U_full_NS - END IF - Int_BufSz = Int_BufSz + 1 ! U_full_dot allocated yes/no - IF ( ALLOCATED(InData%U_full_dot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! U_full_dot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%U_full_dot) ! U_full_dot - END IF - Int_BufSz = Int_BufSz + 1 ! U_full_dotdot allocated yes/no - IF ( ALLOCATED(InData%U_full_dotdot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! U_full_dotdot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%U_full_dotdot) ! U_full_dotdot - END IF - Int_BufSz = Int_BufSz + 1 ! U_full_elast allocated yes/no - IF ( ALLOCATED(InData%U_full_elast) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! U_full_elast upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%U_full_elast) ! U_full_elast - END IF - Int_BufSz = Int_BufSz + 1 ! U_red allocated yes/no - IF ( ALLOCATED(InData%U_red) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! U_red upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%U_red) ! U_red - END IF - Int_BufSz = Int_BufSz + 1 ! FC_unit allocated yes/no - IF ( ALLOCATED(InData%FC_unit) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FC_unit upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FC_unit) ! FC_unit - END IF - Int_BufSz = Int_BufSz + 1 ! SDWrOutput allocated yes/no - IF ( ALLOCATED(InData%SDWrOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SDWrOutput upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SDWrOutput) ! SDWrOutput - END IF - Int_BufSz = Int_BufSz + 1 ! AllOuts allocated yes/no - IF ( ALLOCATED(InData%AllOuts) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AllOuts upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AllOuts) ! AllOuts - END IF - Db_BufSz = Db_BufSz + 1 ! LastOutTime - Int_BufSz = Int_BufSz + 1 ! Decimat - Int_BufSz = Int_BufSz + 1 ! Fext allocated yes/no - IF ( ALLOCATED(InData%Fext) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Fext upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Fext) ! Fext - END IF - Int_BufSz = Int_BufSz + 1 ! Fext_red allocated yes/no - IF ( ALLOCATED(InData%Fext_red) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Fext_red upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Fext_red) ! Fext_red - END IF - Int_BufSz = Int_BufSz + 1 ! UL_SIM allocated yes/no - IF ( ALLOCATED(InData%UL_SIM) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UL_SIM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%UL_SIM) ! UL_SIM - END IF - Int_BufSz = Int_BufSz + 1 ! UL_0m allocated yes/no - IF ( ALLOCATED(InData%UL_0m) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! UL_0m upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%UL_0m) ! UL_0m - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%qmdotdot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%qmdotdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%qmdotdot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%qmdotdot,1), UBOUND(InData%qmdotdot,1) - ReKiBuf(Re_Xferred) = InData%qmdotdot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DO i1 = LBOUND(InData%u_TP,1), UBOUND(InData%u_TP,1) - ReKiBuf(Re_Xferred) = InData%u_TP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%udot_TP,1), UBOUND(InData%udot_TP,1) - ReKiBuf(Re_Xferred) = InData%udot_TP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO i1 = LBOUND(InData%udotdot_TP,1), UBOUND(InData%udotdot_TP,1) - ReKiBuf(Re_Xferred) = InData%udotdot_TP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%F_L) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_L,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_L,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%F_L,1), UBOUND(InData%F_L,1) - ReKiBuf(Re_Xferred) = InData%F_L(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_L2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_L2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_L2,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%F_L2,1), UBOUND(InData%F_L2,1) - ReKiBuf(Re_Xferred) = InData%F_L2(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%UR_bar) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UR_bar,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UR_bar,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UR_bar,1), UBOUND(InData%UR_bar,1) - ReKiBuf(Re_Xferred) = InData%UR_bar(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%UR_bar_dot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UR_bar_dot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UR_bar_dot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UR_bar_dot,1), UBOUND(InData%UR_bar_dot,1) - ReKiBuf(Re_Xferred) = InData%UR_bar_dot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%UR_bar_dotdot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UR_bar_dotdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UR_bar_dotdot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UR_bar_dotdot,1), UBOUND(InData%UR_bar_dotdot,1) - ReKiBuf(Re_Xferred) = InData%UR_bar_dotdot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%UL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UL,1), UBOUND(InData%UL,1) - ReKiBuf(Re_Xferred) = InData%UL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%UL_NS) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UL_NS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UL_NS,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UL_NS,1), UBOUND(InData%UL_NS,1) - ReKiBuf(Re_Xferred) = InData%UL_NS(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%UL_dot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UL_dot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UL_dot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UL_dot,1), UBOUND(InData%UL_dot,1) - ReKiBuf(Re_Xferred) = InData%UL_dot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%UL_dotdot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UL_dotdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UL_dotdot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UL_dotdot,1), UBOUND(InData%UL_dotdot,1) - ReKiBuf(Re_Xferred) = InData%UL_dotdot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DU_full) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DU_full,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DU_full,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%DU_full,1), UBOUND(InData%DU_full,1) - ReKiBuf(Re_Xferred) = InData%DU_full(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%U_full) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%U_full,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U_full,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%U_full,1), UBOUND(InData%U_full,1) - ReKiBuf(Re_Xferred) = InData%U_full(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%U_full_NS) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%U_full_NS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U_full_NS,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%U_full_NS,1), UBOUND(InData%U_full_NS,1) - ReKiBuf(Re_Xferred) = InData%U_full_NS(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%U_full_dot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%U_full_dot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U_full_dot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%U_full_dot,1), UBOUND(InData%U_full_dot,1) - ReKiBuf(Re_Xferred) = InData%U_full_dot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%U_full_dotdot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%U_full_dotdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U_full_dotdot,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%U_full_dotdot,1), UBOUND(InData%U_full_dotdot,1) - ReKiBuf(Re_Xferred) = InData%U_full_dotdot(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%U_full_elast) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%U_full_elast,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U_full_elast,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%U_full_elast,1), UBOUND(InData%U_full_elast,1) - ReKiBuf(Re_Xferred) = InData%U_full_elast(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%U_red) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%U_red,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U_red,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%U_red,1), UBOUND(InData%U_red,1) - ReKiBuf(Re_Xferred) = InData%U_red(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FC_unit) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FC_unit,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FC_unit,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FC_unit,1), UBOUND(InData%FC_unit,1) - ReKiBuf(Re_Xferred) = InData%FC_unit(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SDWrOutput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SDWrOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SDWrOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SDWrOutput,1), UBOUND(InData%SDWrOutput,1) - ReKiBuf(Re_Xferred) = InData%SDWrOutput(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AllOuts) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AllOuts,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOuts,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AllOuts,1), UBOUND(InData%AllOuts,1) - ReKiBuf(Re_Xferred) = InData%AllOuts(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DbKiBuf(Db_Xferred) = InData%LastOutTime - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Decimat - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Fext) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fext,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fext,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Fext,1), UBOUND(InData%Fext,1) - ReKiBuf(Re_Xferred) = InData%Fext(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Fext_red) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Fext_red,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fext_red,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Fext_red,1), UBOUND(InData%Fext_red,1) - ReKiBuf(Re_Xferred) = InData%Fext_red(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%UL_SIM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UL_SIM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UL_SIM,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UL_SIM,1), UBOUND(InData%UL_SIM,1) - ReKiBuf(Re_Xferred) = InData%UL_SIM(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%UL_0m) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%UL_0m,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UL_0m,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%UL_0m,1), UBOUND(InData%UL_0m,1) - ReKiBuf(Re_Xferred) = InData%UL_0m(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_PackMisc - - SUBROUTINE SD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SD_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! qmdotdot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%qmdotdot)) DEALLOCATE(OutData%qmdotdot) - ALLOCATE(OutData%qmdotdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%qmdotdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%qmdotdot,1), UBOUND(OutData%qmdotdot,1) - OutData%qmdotdot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - i1_l = LBOUND(OutData%u_TP,1) - i1_u = UBOUND(OutData%u_TP,1) - DO i1 = LBOUND(OutData%u_TP,1), UBOUND(OutData%u_TP,1) - OutData%u_TP(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%udot_TP,1) - i1_u = UBOUND(OutData%udot_TP,1) - DO i1 = LBOUND(OutData%udot_TP,1), UBOUND(OutData%udot_TP,1) - OutData%udot_TP(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - i1_l = LBOUND(OutData%udotdot_TP,1) - i1_u = UBOUND(OutData%udotdot_TP,1) - DO i1 = LBOUND(OutData%udotdot_TP,1), UBOUND(OutData%udotdot_TP,1) - OutData%udotdot_TP(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_L not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_L)) DEALLOCATE(OutData%F_L) - ALLOCATE(OutData%F_L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%F_L,1), UBOUND(OutData%F_L,1) - OutData%F_L(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_L2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_L2)) DEALLOCATE(OutData%F_L2) - ALLOCATE(OutData%F_L2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_L2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%F_L2,1), UBOUND(OutData%F_L2,1) - OutData%F_L2(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UR_bar not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%UR_bar)) DEALLOCATE(OutData%UR_bar) - ALLOCATE(OutData%UR_bar(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UR_bar.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UR_bar,1), UBOUND(OutData%UR_bar,1) - OutData%UR_bar(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UR_bar_dot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%UR_bar_dot)) DEALLOCATE(OutData%UR_bar_dot) - ALLOCATE(OutData%UR_bar_dot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UR_bar_dot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UR_bar_dot,1), UBOUND(OutData%UR_bar_dot,1) - OutData%UR_bar_dot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UR_bar_dotdot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%UR_bar_dotdot)) DEALLOCATE(OutData%UR_bar_dotdot) - ALLOCATE(OutData%UR_bar_dotdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UR_bar_dotdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UR_bar_dotdot,1), UBOUND(OutData%UR_bar_dotdot,1) - OutData%UR_bar_dotdot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%UL)) DEALLOCATE(OutData%UL) - ALLOCATE(OutData%UL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UL,1), UBOUND(OutData%UL,1) - OutData%UL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UL_NS not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%UL_NS)) DEALLOCATE(OutData%UL_NS) - ALLOCATE(OutData%UL_NS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL_NS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UL_NS,1), UBOUND(OutData%UL_NS,1) - OutData%UL_NS(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UL_dot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%UL_dot)) DEALLOCATE(OutData%UL_dot) - ALLOCATE(OutData%UL_dot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL_dot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UL_dot,1), UBOUND(OutData%UL_dot,1) - OutData%UL_dot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UL_dotdot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%UL_dotdot)) DEALLOCATE(OutData%UL_dotdot) - ALLOCATE(OutData%UL_dotdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL_dotdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UL_dotdot,1), UBOUND(OutData%UL_dotdot,1) - OutData%UL_dotdot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DU_full not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DU_full)) DEALLOCATE(OutData%DU_full) - ALLOCATE(OutData%DU_full(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DU_full.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%DU_full,1), UBOUND(OutData%DU_full,1) - OutData%DU_full(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! U_full not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%U_full)) DEALLOCATE(OutData%U_full) - ALLOCATE(OutData%U_full(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_full.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%U_full,1), UBOUND(OutData%U_full,1) - OutData%U_full(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! U_full_NS not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%U_full_NS)) DEALLOCATE(OutData%U_full_NS) - ALLOCATE(OutData%U_full_NS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_full_NS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%U_full_NS,1), UBOUND(OutData%U_full_NS,1) - OutData%U_full_NS(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! U_full_dot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%U_full_dot)) DEALLOCATE(OutData%U_full_dot) - ALLOCATE(OutData%U_full_dot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_full_dot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%U_full_dot,1), UBOUND(OutData%U_full_dot,1) - OutData%U_full_dot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! U_full_dotdot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%U_full_dotdot)) DEALLOCATE(OutData%U_full_dotdot) - ALLOCATE(OutData%U_full_dotdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_full_dotdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%U_full_dotdot,1), UBOUND(OutData%U_full_dotdot,1) - OutData%U_full_dotdot(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! U_full_elast not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%U_full_elast)) DEALLOCATE(OutData%U_full_elast) - ALLOCATE(OutData%U_full_elast(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_full_elast.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%U_full_elast,1), UBOUND(OutData%U_full_elast,1) - OutData%U_full_elast(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! U_red not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%U_red)) DEALLOCATE(OutData%U_red) - ALLOCATE(OutData%U_red(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_red.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%U_red,1), UBOUND(OutData%U_red,1) - OutData%U_red(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FC_unit not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FC_unit)) DEALLOCATE(OutData%FC_unit) - ALLOCATE(OutData%FC_unit(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FC_unit.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FC_unit,1), UBOUND(OutData%FC_unit,1) - OutData%FC_unit(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SDWrOutput not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SDWrOutput)) DEALLOCATE(OutData%SDWrOutput) - ALLOCATE(OutData%SDWrOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SDWrOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SDWrOutput,1), UBOUND(OutData%SDWrOutput,1) - OutData%SDWrOutput(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AllOuts not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AllOuts)) DEALLOCATE(OutData%AllOuts) - ALLOCATE(OutData%AllOuts(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AllOuts,1), UBOUND(OutData%AllOuts,1) - OutData%AllOuts(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%LastOutTime = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%Decimat = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fext not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Fext)) DEALLOCATE(OutData%Fext) - ALLOCATE(OutData%Fext(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fext.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Fext,1), UBOUND(OutData%Fext,1) - OutData%Fext(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fext_red not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Fext_red)) DEALLOCATE(OutData%Fext_red) - ALLOCATE(OutData%Fext_red(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fext_red.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Fext_red,1), UBOUND(OutData%Fext_red,1) - OutData%Fext_red(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UL_SIM not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%UL_SIM)) DEALLOCATE(OutData%UL_SIM) - ALLOCATE(OutData%UL_SIM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL_SIM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UL_SIM,1), UBOUND(OutData%UL_SIM,1) - OutData%UL_SIM(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UL_0m not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%UL_0m)) DEALLOCATE(OutData%UL_0m) - ALLOCATE(OutData%UL_0m(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL_0m.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%UL_0m,1), UBOUND(OutData%UL_0m,1) - OutData%UL_0m(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_UnPackMisc +subroutine SD_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SD_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + ! qmdotdot + call RegPack(Buf, allocated(InData%qmdotdot)) + if (allocated(InData%qmdotdot)) then + call RegPackBounds(Buf, 1, lbound(InData%qmdotdot), ubound(InData%qmdotdot)) + call RegPack(Buf, InData%qmdotdot) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! u_TP + call RegPack(Buf, InData%u_TP) + if (RegCheckErr(Buf, RoutineName)) return + ! udot_TP + call RegPack(Buf, InData%udot_TP) + if (RegCheckErr(Buf, RoutineName)) return + ! udotdot_TP + call RegPack(Buf, InData%udotdot_TP) + if (RegCheckErr(Buf, RoutineName)) return + ! F_L + call RegPack(Buf, allocated(InData%F_L)) + if (allocated(InData%F_L)) then + call RegPackBounds(Buf, 1, lbound(InData%F_L), ubound(InData%F_L)) + call RegPack(Buf, InData%F_L) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! F_L2 + call RegPack(Buf, allocated(InData%F_L2)) + if (allocated(InData%F_L2)) then + call RegPackBounds(Buf, 1, lbound(InData%F_L2), ubound(InData%F_L2)) + call RegPack(Buf, InData%F_L2) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! UR_bar + call RegPack(Buf, allocated(InData%UR_bar)) + if (allocated(InData%UR_bar)) then + call RegPackBounds(Buf, 1, lbound(InData%UR_bar), ubound(InData%UR_bar)) + call RegPack(Buf, InData%UR_bar) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! UR_bar_dot + call RegPack(Buf, allocated(InData%UR_bar_dot)) + if (allocated(InData%UR_bar_dot)) then + call RegPackBounds(Buf, 1, lbound(InData%UR_bar_dot), ubound(InData%UR_bar_dot)) + call RegPack(Buf, InData%UR_bar_dot) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! UR_bar_dotdot + call RegPack(Buf, allocated(InData%UR_bar_dotdot)) + if (allocated(InData%UR_bar_dotdot)) then + call RegPackBounds(Buf, 1, lbound(InData%UR_bar_dotdot), ubound(InData%UR_bar_dotdot)) + call RegPack(Buf, InData%UR_bar_dotdot) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! UL + call RegPack(Buf, allocated(InData%UL)) + if (allocated(InData%UL)) then + call RegPackBounds(Buf, 1, lbound(InData%UL), ubound(InData%UL)) + call RegPack(Buf, InData%UL) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! UL_NS + call RegPack(Buf, allocated(InData%UL_NS)) + if (allocated(InData%UL_NS)) then + call RegPackBounds(Buf, 1, lbound(InData%UL_NS), ubound(InData%UL_NS)) + call RegPack(Buf, InData%UL_NS) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! UL_dot + call RegPack(Buf, allocated(InData%UL_dot)) + if (allocated(InData%UL_dot)) then + call RegPackBounds(Buf, 1, lbound(InData%UL_dot), ubound(InData%UL_dot)) + call RegPack(Buf, InData%UL_dot) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! UL_dotdot + call RegPack(Buf, allocated(InData%UL_dotdot)) + if (allocated(InData%UL_dotdot)) then + call RegPackBounds(Buf, 1, lbound(InData%UL_dotdot), ubound(InData%UL_dotdot)) + call RegPack(Buf, InData%UL_dotdot) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DU_full + call RegPack(Buf, allocated(InData%DU_full)) + if (allocated(InData%DU_full)) then + call RegPackBounds(Buf, 1, lbound(InData%DU_full), ubound(InData%DU_full)) + call RegPack(Buf, InData%DU_full) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! U_full + call RegPack(Buf, allocated(InData%U_full)) + if (allocated(InData%U_full)) then + call RegPackBounds(Buf, 1, lbound(InData%U_full), ubound(InData%U_full)) + call RegPack(Buf, InData%U_full) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! U_full_NS + call RegPack(Buf, allocated(InData%U_full_NS)) + if (allocated(InData%U_full_NS)) then + call RegPackBounds(Buf, 1, lbound(InData%U_full_NS), ubound(InData%U_full_NS)) + call RegPack(Buf, InData%U_full_NS) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! U_full_dot + call RegPack(Buf, allocated(InData%U_full_dot)) + if (allocated(InData%U_full_dot)) then + call RegPackBounds(Buf, 1, lbound(InData%U_full_dot), ubound(InData%U_full_dot)) + call RegPack(Buf, InData%U_full_dot) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! U_full_dotdot + call RegPack(Buf, allocated(InData%U_full_dotdot)) + if (allocated(InData%U_full_dotdot)) then + call RegPackBounds(Buf, 1, lbound(InData%U_full_dotdot), ubound(InData%U_full_dotdot)) + call RegPack(Buf, InData%U_full_dotdot) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! U_full_elast + call RegPack(Buf, allocated(InData%U_full_elast)) + if (allocated(InData%U_full_elast)) then + call RegPackBounds(Buf, 1, lbound(InData%U_full_elast), ubound(InData%U_full_elast)) + call RegPack(Buf, InData%U_full_elast) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! U_red + call RegPack(Buf, allocated(InData%U_red)) + if (allocated(InData%U_red)) then + call RegPackBounds(Buf, 1, lbound(InData%U_red), ubound(InData%U_red)) + call RegPack(Buf, InData%U_red) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FC_unit + call RegPack(Buf, allocated(InData%FC_unit)) + if (allocated(InData%FC_unit)) then + call RegPackBounds(Buf, 1, lbound(InData%FC_unit), ubound(InData%FC_unit)) + call RegPack(Buf, InData%FC_unit) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! SDWrOutput + call RegPack(Buf, allocated(InData%SDWrOutput)) + if (allocated(InData%SDWrOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%SDWrOutput), ubound(InData%SDWrOutput)) + call RegPack(Buf, InData%SDWrOutput) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AllOuts + call RegPack(Buf, allocated(InData%AllOuts)) + if (allocated(InData%AllOuts)) then + call RegPackBounds(Buf, 1, lbound(InData%AllOuts), ubound(InData%AllOuts)) + call RegPack(Buf, InData%AllOuts) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! LastOutTime + call RegPack(Buf, InData%LastOutTime) + if (RegCheckErr(Buf, RoutineName)) return + ! Decimat + call RegPack(Buf, InData%Decimat) + if (RegCheckErr(Buf, RoutineName)) return + ! Fext + call RegPack(Buf, allocated(InData%Fext)) + if (allocated(InData%Fext)) then + call RegPackBounds(Buf, 1, lbound(InData%Fext), ubound(InData%Fext)) + call RegPack(Buf, InData%Fext) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Fext_red + call RegPack(Buf, allocated(InData%Fext_red)) + if (allocated(InData%Fext_red)) then + call RegPackBounds(Buf, 1, lbound(InData%Fext_red), ubound(InData%Fext_red)) + call RegPack(Buf, InData%Fext_red) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! UL_SIM + call RegPack(Buf, allocated(InData%UL_SIM)) + if (allocated(InData%UL_SIM)) then + call RegPackBounds(Buf, 1, lbound(InData%UL_SIM), ubound(InData%UL_SIM)) + call RegPack(Buf, InData%UL_SIM) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! UL_0m + call RegPack(Buf, allocated(InData%UL_0m)) + if (allocated(InData%UL_0m)) then + call RegPackBounds(Buf, 1, lbound(InData%UL_0m), ubound(InData%UL_0m)) + call RegPack(Buf, InData%UL_0m) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SD_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SD_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackMisc' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! qmdotdot + if (allocated(OutData%qmdotdot)) deallocate(OutData%qmdotdot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%qmdotdot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%qmdotdot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%qmdotdot) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! u_TP + call RegUnpack(Buf, OutData%u_TP) + if (RegCheckErr(Buf, RoutineName)) return + ! udot_TP + call RegUnpack(Buf, OutData%udot_TP) + if (RegCheckErr(Buf, RoutineName)) return + ! udotdot_TP + call RegUnpack(Buf, OutData%udotdot_TP) + if (RegCheckErr(Buf, RoutineName)) return + ! F_L + if (allocated(OutData%F_L)) deallocate(OutData%F_L) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_L(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_L.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_L) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! F_L2 + if (allocated(OutData%F_L2)) deallocate(OutData%F_L2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%F_L2(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_L2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%F_L2) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! UR_bar + if (allocated(OutData%UR_bar)) deallocate(OutData%UR_bar) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%UR_bar(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UR_bar.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%UR_bar) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! UR_bar_dot + if (allocated(OutData%UR_bar_dot)) deallocate(OutData%UR_bar_dot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%UR_bar_dot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UR_bar_dot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%UR_bar_dot) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! UR_bar_dotdot + if (allocated(OutData%UR_bar_dotdot)) deallocate(OutData%UR_bar_dotdot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%UR_bar_dotdot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UR_bar_dotdot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%UR_bar_dotdot) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! UL + if (allocated(OutData%UL)) deallocate(OutData%UL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%UL(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%UL) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! UL_NS + if (allocated(OutData%UL_NS)) deallocate(OutData%UL_NS) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%UL_NS(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL_NS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%UL_NS) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! UL_dot + if (allocated(OutData%UL_dot)) deallocate(OutData%UL_dot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%UL_dot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL_dot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%UL_dot) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! UL_dotdot + if (allocated(OutData%UL_dotdot)) deallocate(OutData%UL_dotdot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%UL_dotdot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL_dotdot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%UL_dotdot) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! DU_full + if (allocated(OutData%DU_full)) deallocate(OutData%DU_full) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DU_full(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DU_full.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DU_full) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! U_full + if (allocated(OutData%U_full)) deallocate(OutData%U_full) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%U_full(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_full.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%U_full) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! U_full_NS + if (allocated(OutData%U_full_NS)) deallocate(OutData%U_full_NS) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%U_full_NS(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_full_NS.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%U_full_NS) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! U_full_dot + if (allocated(OutData%U_full_dot)) deallocate(OutData%U_full_dot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%U_full_dot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_full_dot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%U_full_dot) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! U_full_dotdot + if (allocated(OutData%U_full_dotdot)) deallocate(OutData%U_full_dotdot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%U_full_dotdot(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_full_dotdot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%U_full_dotdot) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! U_full_elast + if (allocated(OutData%U_full_elast)) deallocate(OutData%U_full_elast) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%U_full_elast(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_full_elast.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%U_full_elast) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! U_red + if (allocated(OutData%U_red)) deallocate(OutData%U_red) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%U_red(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_red.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%U_red) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! FC_unit + if (allocated(OutData%FC_unit)) deallocate(OutData%FC_unit) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FC_unit(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FC_unit.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FC_unit) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! SDWrOutput + if (allocated(OutData%SDWrOutput)) deallocate(OutData%SDWrOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%SDWrOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%SDWrOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%SDWrOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AllOuts + if (allocated(OutData%AllOuts)) deallocate(OutData%AllOuts) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AllOuts(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AllOuts) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! LastOutTime + call RegUnpack(Buf, OutData%LastOutTime) + if (RegCheckErr(Buf, RoutineName)) return + ! Decimat + call RegUnpack(Buf, OutData%Decimat) + if (RegCheckErr(Buf, RoutineName)) return + ! Fext + if (allocated(OutData%Fext)) deallocate(OutData%Fext) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Fext(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fext.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Fext) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Fext_red + if (allocated(OutData%Fext_red)) deallocate(OutData%Fext_red) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Fext_red(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fext_red.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Fext_red) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! UL_SIM + if (allocated(OutData%UL_SIM)) deallocate(OutData%UL_SIM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%UL_SIM(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL_SIM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%UL_SIM) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! UL_0m + if (allocated(OutData%UL_0m)) deallocate(OutData%UL_0m) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%UL_0m(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL_0m.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%UL_0m) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE SD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(SD_ParameterType), INTENT(IN) :: SrcParamData TYPE(SD_ParameterType), INTENT(INOUT) :: DstParamData @@ -8330,3495 +5452,1623 @@ SUBROUTINE SD_DestroyParam( ParamData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE SD_DestroyParam - SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SD_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! SDDeltaT - Int_BufSz = Int_BufSz + 1 ! IntMethod - Int_BufSz = Int_BufSz + 1 ! nDOF - Int_BufSz = Int_BufSz + 1 ! nDOF_red - Int_BufSz = Int_BufSz + 1 ! Nmembers - Int_BufSz = Int_BufSz + 1 ! Elems allocated yes/no - IF ( ALLOCATED(InData%Elems) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Elems upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Elems) ! Elems - END IF - Int_BufSz = Int_BufSz + 1 ! ElemProps allocated yes/no - IF ( ALLOCATED(InData%ElemProps) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ElemProps upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%ElemProps,1), UBOUND(InData%ElemProps,1) - Int_BufSz = Int_BufSz + 3 ! ElemProps: size of buffers for each call to pack subtype - CALL SD_PackElemPropType( Re_Buf, Db_Buf, Int_Buf, InData%ElemProps(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ElemProps - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ElemProps - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ElemProps - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ElemProps - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! FG allocated yes/no - IF ( ALLOCATED(InData%FG) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FG upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%FG) ! FG - END IF - Int_BufSz = Int_BufSz + 1 ! DP0 allocated yes/no - IF ( ALLOCATED(InData%DP0) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! DP0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DP0) ! DP0 - END IF - Int_BufSz = Int_BufSz + 1 ! NodeID2JointID allocated yes/no - IF ( ALLOCATED(InData%NodeID2JointID) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NodeID2JointID upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%NodeID2JointID) ! NodeID2JointID - END IF - Int_BufSz = Int_BufSz + 1 ! reduced - Int_BufSz = Int_BufSz + 1 ! T_red allocated yes/no - IF ( ALLOCATED(InData%T_red) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! T_red upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%T_red) ! T_red - END IF - Int_BufSz = Int_BufSz + 1 ! T_red_T allocated yes/no - IF ( ALLOCATED(InData%T_red_T) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! T_red_T upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%T_red_T) ! T_red_T - END IF - Int_BufSz = Int_BufSz + 1 ! NodesDOF allocated yes/no - IF ( ALLOCATED(InData%NodesDOF) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NodesDOF upper/lower bounds for each dimension - DO i1 = LBOUND(InData%NodesDOF,1), UBOUND(InData%NodesDOF,1) - Int_BufSz = Int_BufSz + 3 ! NodesDOF: size of buffers for each call to pack subtype - CALL SD_PackIList( Re_Buf, Db_Buf, Int_Buf, InData%NodesDOF(i1), ErrStat2, ErrMsg2, .TRUE. ) ! NodesDOF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NodesDOF - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NodesDOF - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NodesDOF - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NodesDOFred allocated yes/no - IF ( ALLOCATED(InData%NodesDOFred) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! NodesDOFred upper/lower bounds for each dimension - DO i1 = LBOUND(InData%NodesDOFred,1), UBOUND(InData%NodesDOFred,1) - Int_BufSz = Int_BufSz + 3 ! NodesDOFred: size of buffers for each call to pack subtype - CALL SD_PackIList( Re_Buf, Db_Buf, Int_Buf, InData%NodesDOFred(i1), ErrStat2, ErrMsg2, .TRUE. ) ! NodesDOFred - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! NodesDOFred - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! NodesDOFred - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! NodesDOFred - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! ElemsDOF allocated yes/no - IF ( ALLOCATED(InData%ElemsDOF) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! ElemsDOF upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ElemsDOF) ! ElemsDOF - END IF - Int_BufSz = Int_BufSz + 1 ! DOFred2Nodes allocated yes/no - IF ( ALLOCATED(InData%DOFred2Nodes) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! DOFred2Nodes upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%DOFred2Nodes) ! DOFred2Nodes - END IF - Int_BufSz = Int_BufSz + 1 ! CtrlElem2Channel allocated yes/no - IF ( ALLOCATED(InData%CtrlElem2Channel) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CtrlElem2Channel upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%CtrlElem2Channel) ! CtrlElem2Channel - END IF - Int_BufSz = Int_BufSz + 1 ! nDOFM - Int_BufSz = Int_BufSz + 1 ! SttcSolve - Int_BufSz = Int_BufSz + 1 ! GuyanLoadCorrection - Int_BufSz = Int_BufSz + 1 ! Floating - Int_BufSz = Int_BufSz + 1 ! KMMDiag allocated yes/no - IF ( ALLOCATED(InData%KMMDiag) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! KMMDiag upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%KMMDiag) ! KMMDiag - END IF - Int_BufSz = Int_BufSz + 1 ! CMMDiag allocated yes/no - IF ( ALLOCATED(InData%CMMDiag) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CMMDiag upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CMMDiag) ! CMMDiag - END IF - Int_BufSz = Int_BufSz + 1 ! MMB allocated yes/no - IF ( ALLOCATED(InData%MMB) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MMB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MMB) ! MMB - END IF - Int_BufSz = Int_BufSz + 1 ! MBmmB allocated yes/no - IF ( ALLOCATED(InData%MBmmB) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MBmmB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MBmmB) ! MBmmB - END IF - Int_BufSz = Int_BufSz + 1 ! C1_11 allocated yes/no - IF ( ALLOCATED(InData%C1_11) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! C1_11 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%C1_11) ! C1_11 - END IF - Int_BufSz = Int_BufSz + 1 ! C1_12 allocated yes/no - IF ( ALLOCATED(InData%C1_12) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! C1_12 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%C1_12) ! C1_12 - END IF - Int_BufSz = Int_BufSz + 1 ! D1_141 allocated yes/no - IF ( ALLOCATED(InData%D1_141) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! D1_141 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%D1_141) ! D1_141 - END IF - Int_BufSz = Int_BufSz + 1 ! D1_142 allocated yes/no - IF ( ALLOCATED(InData%D1_142) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! D1_142 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%D1_142) ! D1_142 - END IF - Int_BufSz = Int_BufSz + 1 ! PhiM allocated yes/no - IF ( ALLOCATED(InData%PhiM) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PhiM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PhiM) ! PhiM - END IF - Int_BufSz = Int_BufSz + 1 ! C2_61 allocated yes/no - IF ( ALLOCATED(InData%C2_61) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! C2_61 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%C2_61) ! C2_61 - END IF - Int_BufSz = Int_BufSz + 1 ! C2_62 allocated yes/no - IF ( ALLOCATED(InData%C2_62) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! C2_62 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%C2_62) ! C2_62 - END IF - Int_BufSz = Int_BufSz + 1 ! PhiRb_TI allocated yes/no - IF ( ALLOCATED(InData%PhiRb_TI) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PhiRb_TI upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PhiRb_TI) ! PhiRb_TI - END IF - Int_BufSz = Int_BufSz + 1 ! D2_63 allocated yes/no - IF ( ALLOCATED(InData%D2_63) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! D2_63 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%D2_63) ! D2_63 - END IF - Int_BufSz = Int_BufSz + 1 ! D2_64 allocated yes/no - IF ( ALLOCATED(InData%D2_64) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! D2_64 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%D2_64) ! D2_64 - END IF - Int_BufSz = Int_BufSz + 1 ! MBB allocated yes/no - IF ( ALLOCATED(InData%MBB) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MBB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MBB) ! MBB - END IF - Int_BufSz = Int_BufSz + 1 ! KBB allocated yes/no - IF ( ALLOCATED(InData%KBB) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! KBB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%KBB) ! KBB - END IF - Int_BufSz = Int_BufSz + 1 ! CBB allocated yes/no - IF ( ALLOCATED(InData%CBB) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CBB upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CBB) ! CBB - END IF - Int_BufSz = Int_BufSz + 1 ! CMM allocated yes/no - IF ( ALLOCATED(InData%CMM) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CMM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CMM) ! CMM - END IF - Int_BufSz = Int_BufSz + 1 ! MBM allocated yes/no - IF ( ALLOCATED(InData%MBM) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MBM upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MBM) ! MBM - END IF - Int_BufSz = Int_BufSz + 1 ! PhiL_T allocated yes/no - IF ( ALLOCATED(InData%PhiL_T) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PhiL_T upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PhiL_T) ! PhiL_T - END IF - Int_BufSz = Int_BufSz + 1 ! PhiLInvOmgL2 allocated yes/no - IF ( ALLOCATED(InData%PhiLInvOmgL2) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PhiLInvOmgL2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PhiLInvOmgL2) ! PhiLInvOmgL2 - END IF - Int_BufSz = Int_BufSz + 1 ! KLLm1 allocated yes/no - IF ( ALLOCATED(InData%KLLm1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! KLLm1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%KLLm1) ! KLLm1 - END IF - Int_BufSz = Int_BufSz + 1 ! AM2Jac allocated yes/no - IF ( ALLOCATED(InData%AM2Jac) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AM2Jac upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AM2Jac) ! AM2Jac - END IF - Int_BufSz = Int_BufSz + 1 ! AM2JacPiv allocated yes/no - IF ( ALLOCATED(InData%AM2JacPiv) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AM2JacPiv upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%AM2JacPiv) ! AM2JacPiv - END IF - Int_BufSz = Int_BufSz + 1 ! TI allocated yes/no - IF ( ALLOCATED(InData%TI) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TI upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TI) ! TI - END IF - Int_BufSz = Int_BufSz + 1 ! TIreact allocated yes/no - IF ( ALLOCATED(InData%TIreact) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TIreact upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TIreact) ! TIreact - END IF - Int_BufSz = Int_BufSz + 1 ! nNodes - Int_BufSz = Int_BufSz + 1 ! nNodes_I - Int_BufSz = Int_BufSz + 1 ! nNodes_L - Int_BufSz = Int_BufSz + 1 ! nNodes_C - Int_BufSz = Int_BufSz + 1 ! Nodes_I allocated yes/no - IF ( ALLOCATED(InData%Nodes_I) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Nodes_I upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Nodes_I) ! Nodes_I - END IF - Int_BufSz = Int_BufSz + 1 ! Nodes_L allocated yes/no - IF ( ALLOCATED(InData%Nodes_L) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Nodes_L upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Nodes_L) ! Nodes_L - END IF - Int_BufSz = Int_BufSz + 1 ! Nodes_C allocated yes/no - IF ( ALLOCATED(InData%Nodes_C) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Nodes_C upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Nodes_C) ! Nodes_C - END IF - Int_BufSz = Int_BufSz + 1 ! nDOFI__ - Int_BufSz = Int_BufSz + 1 ! nDOFI_Rb - Int_BufSz = Int_BufSz + 1 ! nDOFI_F - Int_BufSz = Int_BufSz + 1 ! nDOFL_L - Int_BufSz = Int_BufSz + 1 ! nDOFC__ - Int_BufSz = Int_BufSz + 1 ! nDOFC_Rb - Int_BufSz = Int_BufSz + 1 ! nDOFC_L - Int_BufSz = Int_BufSz + 1 ! nDOFC_F - Int_BufSz = Int_BufSz + 1 ! nDOFR__ - Int_BufSz = Int_BufSz + 1 ! nDOF__Rb - Int_BufSz = Int_BufSz + 1 ! nDOF__L - Int_BufSz = Int_BufSz + 1 ! nDOF__F - Int_BufSz = Int_BufSz + 1 ! IDI__ allocated yes/no - IF ( ALLOCATED(InData%IDI__) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IDI__ upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IDI__) ! IDI__ - END IF - Int_BufSz = Int_BufSz + 1 ! IDI_Rb allocated yes/no - IF ( ALLOCATED(InData%IDI_Rb) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IDI_Rb upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IDI_Rb) ! IDI_Rb - END IF - Int_BufSz = Int_BufSz + 1 ! IDI_F allocated yes/no - IF ( ALLOCATED(InData%IDI_F) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IDI_F upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IDI_F) ! IDI_F - END IF - Int_BufSz = Int_BufSz + 1 ! IDL_L allocated yes/no - IF ( ALLOCATED(InData%IDL_L) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IDL_L upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IDL_L) ! IDL_L - END IF - Int_BufSz = Int_BufSz + 1 ! IDC__ allocated yes/no - IF ( ALLOCATED(InData%IDC__) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IDC__ upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IDC__) ! IDC__ - END IF - Int_BufSz = Int_BufSz + 1 ! IDC_Rb allocated yes/no - IF ( ALLOCATED(InData%IDC_Rb) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IDC_Rb upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IDC_Rb) ! IDC_Rb - END IF - Int_BufSz = Int_BufSz + 1 ! IDC_L allocated yes/no - IF ( ALLOCATED(InData%IDC_L) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IDC_L upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IDC_L) ! IDC_L - END IF - Int_BufSz = Int_BufSz + 1 ! IDC_F allocated yes/no - IF ( ALLOCATED(InData%IDC_F) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IDC_F upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IDC_F) ! IDC_F - END IF - Int_BufSz = Int_BufSz + 1 ! IDR__ allocated yes/no - IF ( ALLOCATED(InData%IDR__) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IDR__ upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IDR__) ! IDR__ - END IF - Int_BufSz = Int_BufSz + 1 ! ID__Rb allocated yes/no - IF ( ALLOCATED(InData%ID__Rb) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ID__Rb upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ID__Rb) ! ID__Rb - END IF - Int_BufSz = Int_BufSz + 1 ! ID__L allocated yes/no - IF ( ALLOCATED(InData%ID__L) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ID__L upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ID__L) ! ID__L - END IF - Int_BufSz = Int_BufSz + 1 ! ID__F allocated yes/no - IF ( ALLOCATED(InData%ID__F) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ID__F upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ID__F) ! ID__F - END IF - Int_BufSz = Int_BufSz + 1 ! NMOutputs - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! OutSwtch - Int_BufSz = Int_BufSz + 1 ! UnJckF - Int_BufSz = Int_BufSz + 1*LEN(InData%Delim) ! Delim - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt - Int_BufSz = Int_BufSz + 1*LEN(InData%OutSFmt) ! OutSFmt - Int_BufSz = Int_BufSz + 1 ! MoutLst allocated yes/no - IF ( ALLOCATED(InData%MoutLst) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MoutLst upper/lower bounds for each dimension - DO i1 = LBOUND(InData%MoutLst,1), UBOUND(InData%MoutLst,1) - Int_BufSz = Int_BufSz + 3 ! MoutLst: size of buffers for each call to pack subtype - CALL SD_PackMeshAuxDataType( Re_Buf, Db_Buf, Int_Buf, InData%MoutLst(i1), ErrStat2, ErrMsg2, .TRUE. ) ! MoutLst - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! MoutLst - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! MoutLst - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! MoutLst - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! MoutLst2 allocated yes/no - IF ( ALLOCATED(InData%MoutLst2) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MoutLst2 upper/lower bounds for each dimension - DO i1 = LBOUND(InData%MoutLst2,1), UBOUND(InData%MoutLst2,1) - Int_BufSz = Int_BufSz + 3 ! MoutLst2: size of buffers for each call to pack subtype - CALL SD_PackMeshAuxDataType( Re_Buf, Db_Buf, Int_Buf, InData%MoutLst2(i1), ErrStat2, ErrMsg2, .TRUE. ) ! MoutLst2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! MoutLst2 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! MoutLst2 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! MoutLst2 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! MoutLst3 allocated yes/no - IF ( ALLOCATED(InData%MoutLst3) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MoutLst3 upper/lower bounds for each dimension - DO i1 = LBOUND(InData%MoutLst3,1), UBOUND(InData%MoutLst3,1) - Int_BufSz = Int_BufSz + 3 ! MoutLst3: size of buffers for each call to pack subtype - CALL SD_PackMeshAuxDataType( Re_Buf, Db_Buf, Int_Buf, InData%MoutLst3(i1), ErrStat2, ErrMsg2, .TRUE. ) ! MoutLst3 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! MoutLst3 - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! MoutLst3 - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! MoutLst3 - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OutParam allocated yes/no - IF ( ALLOCATED(InData%OutParam) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutParam upper/lower bounds for each dimension - DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - Int_BufSz = Int_BufSz + 3 ! OutParam: size of buffers for each call to pack subtype - CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutParam - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutParam - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutParam - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OutAll - Int_BufSz = Int_BufSz + 1 ! OutCBModes - Int_BufSz = Int_BufSz + 1 ! OutFEMModes - Int_BufSz = Int_BufSz + 1 ! OutReact - Int_BufSz = Int_BufSz + 1 ! OutAllInt - Int_BufSz = Int_BufSz + 1 ! OutAllDims - Int_BufSz = Int_BufSz + 1 ! OutDec - Int_BufSz = Int_BufSz + 1 ! Jac_u_indx allocated yes/no - IF ( ALLOCATED(InData%Jac_u_indx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_u_indx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_u_indx) ! Jac_u_indx - END IF - Int_BufSz = Int_BufSz + 1 ! du allocated yes/no - IF ( ALLOCATED(InData%du) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! du upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%du) ! du - END IF - Db_BufSz = Db_BufSz + SIZE(InData%dx) ! dx - Int_BufSz = Int_BufSz + 1 ! Jac_ny - Int_BufSz = Int_BufSz + 1 ! Jac_nx - Int_BufSz = Int_BufSz + 1 ! RotStates - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%SDDeltaT - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%IntMethod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOF - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOF_red - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Nmembers - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Elems) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Elems,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Elems,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Elems,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Elems,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Elems,2), UBOUND(InData%Elems,2) - DO i1 = LBOUND(InData%Elems,1), UBOUND(InData%Elems,1) - IntKiBuf(Int_Xferred) = InData%Elems(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ElemProps) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ElemProps,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElemProps,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ElemProps,1), UBOUND(InData%ElemProps,1) - CALL SD_PackElemPropType( Re_Buf, Db_Buf, Int_Buf, InData%ElemProps(i1), ErrStat2, ErrMsg2, OnlySize ) ! ElemProps - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FG) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FG,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FG,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FG,1), UBOUND(InData%FG,1) - DbKiBuf(Db_Xferred) = InData%FG(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DP0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DP0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DP0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DP0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DP0,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%DP0,2), UBOUND(InData%DP0,2) - DO i1 = LBOUND(InData%DP0,1), UBOUND(InData%DP0,1) - ReKiBuf(Re_Xferred) = InData%DP0(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NodeID2JointID) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NodeID2JointID,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodeID2JointID,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NodeID2JointID,1), UBOUND(InData%NodeID2JointID,1) - IntKiBuf(Int_Xferred) = InData%NodeID2JointID(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%reduced, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%T_red) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%T_red,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%T_red,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%T_red,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%T_red,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%T_red,2), UBOUND(InData%T_red,2) - DO i1 = LBOUND(InData%T_red,1), UBOUND(InData%T_red,1) - DbKiBuf(Db_Xferred) = InData%T_red(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%T_red_T) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%T_red_T,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%T_red_T,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%T_red_T,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%T_red_T,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%T_red_T,2), UBOUND(InData%T_red_T,2) - DO i1 = LBOUND(InData%T_red_T,1), UBOUND(InData%T_red_T,1) - DbKiBuf(Db_Xferred) = InData%T_red_T(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NodesDOF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NodesDOF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodesDOF,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NodesDOF,1), UBOUND(InData%NodesDOF,1) - CALL SD_PackIList( Re_Buf, Db_Buf, Int_Buf, InData%NodesDOF(i1), ErrStat2, ErrMsg2, OnlySize ) ! NodesDOF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%NodesDOFred) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%NodesDOFred,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodesDOFred,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%NodesDOFred,1), UBOUND(InData%NodesDOFred,1) - CALL SD_PackIList( Re_Buf, Db_Buf, Int_Buf, InData%NodesDOFred(i1), ErrStat2, ErrMsg2, OnlySize ) ! NodesDOFred - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ElemsDOF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ElemsDOF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElemsDOF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ElemsDOF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElemsDOF,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%ElemsDOF,2), UBOUND(InData%ElemsDOF,2) - DO i1 = LBOUND(InData%ElemsDOF,1), UBOUND(InData%ElemsDOF,1) - IntKiBuf(Int_Xferred) = InData%ElemsDOF(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DOFred2Nodes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DOFred2Nodes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DOFred2Nodes,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DOFred2Nodes,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DOFred2Nodes,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%DOFred2Nodes,2), UBOUND(InData%DOFred2Nodes,2) - DO i1 = LBOUND(InData%DOFred2Nodes,1), UBOUND(InData%DOFred2Nodes,1) - IntKiBuf(Int_Xferred) = InData%DOFred2Nodes(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CtrlElem2Channel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CtrlElem2Channel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CtrlElem2Channel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CtrlElem2Channel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CtrlElem2Channel,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CtrlElem2Channel,2), UBOUND(InData%CtrlElem2Channel,2) - DO i1 = LBOUND(InData%CtrlElem2Channel,1), UBOUND(InData%CtrlElem2Channel,1) - IntKiBuf(Int_Xferred) = InData%CtrlElem2Channel(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%nDOFM - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%SttcSolve - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%GuyanLoadCorrection, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Floating, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%KMMDiag) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%KMMDiag,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KMMDiag,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%KMMDiag,1), UBOUND(InData%KMMDiag,1) - ReKiBuf(Re_Xferred) = InData%KMMDiag(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CMMDiag) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CMMDiag,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CMMDiag,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CMMDiag,1), UBOUND(InData%CMMDiag,1) - ReKiBuf(Re_Xferred) = InData%CMMDiag(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MMB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MMB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MMB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MMB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MMB,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MMB,2), UBOUND(InData%MMB,2) - DO i1 = LBOUND(InData%MMB,1), UBOUND(InData%MMB,1) - ReKiBuf(Re_Xferred) = InData%MMB(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MBmmB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MBmmB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBmmB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MBmmB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBmmB,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MBmmB,2), UBOUND(InData%MBmmB,2) - DO i1 = LBOUND(InData%MBmmB,1), UBOUND(InData%MBmmB,1) - ReKiBuf(Re_Xferred) = InData%MBmmB(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%C1_11) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C1_11,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C1_11,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C1_11,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C1_11,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%C1_11,2), UBOUND(InData%C1_11,2) - DO i1 = LBOUND(InData%C1_11,1), UBOUND(InData%C1_11,1) - ReKiBuf(Re_Xferred) = InData%C1_11(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%C1_12) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C1_12,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C1_12,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C1_12,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C1_12,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%C1_12,2), UBOUND(InData%C1_12,2) - DO i1 = LBOUND(InData%C1_12,1), UBOUND(InData%C1_12,1) - ReKiBuf(Re_Xferred) = InData%C1_12(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%D1_141) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%D1_141,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D1_141,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%D1_141,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D1_141,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%D1_141,2), UBOUND(InData%D1_141,2) - DO i1 = LBOUND(InData%D1_141,1), UBOUND(InData%D1_141,1) - ReKiBuf(Re_Xferred) = InData%D1_141(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%D1_142) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%D1_142,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D1_142,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%D1_142,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D1_142,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%D1_142,2), UBOUND(InData%D1_142,2) - DO i1 = LBOUND(InData%D1_142,1), UBOUND(InData%D1_142,1) - ReKiBuf(Re_Xferred) = InData%D1_142(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PhiM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiM,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PhiM,2), UBOUND(InData%PhiM,2) - DO i1 = LBOUND(InData%PhiM,1), UBOUND(InData%PhiM,1) - ReKiBuf(Re_Xferred) = InData%PhiM(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%C2_61) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C2_61,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C2_61,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C2_61,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C2_61,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%C2_61,2), UBOUND(InData%C2_61,2) - DO i1 = LBOUND(InData%C2_61,1), UBOUND(InData%C2_61,1) - ReKiBuf(Re_Xferred) = InData%C2_61(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%C2_62) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C2_62,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C2_62,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C2_62,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C2_62,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%C2_62,2), UBOUND(InData%C2_62,2) - DO i1 = LBOUND(InData%C2_62,1), UBOUND(InData%C2_62,1) - ReKiBuf(Re_Xferred) = InData%C2_62(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PhiRb_TI) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiRb_TI,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiRb_TI,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiRb_TI,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiRb_TI,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PhiRb_TI,2), UBOUND(InData%PhiRb_TI,2) - DO i1 = LBOUND(InData%PhiRb_TI,1), UBOUND(InData%PhiRb_TI,1) - ReKiBuf(Re_Xferred) = InData%PhiRb_TI(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%D2_63) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%D2_63,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D2_63,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%D2_63,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D2_63,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%D2_63,2), UBOUND(InData%D2_63,2) - DO i1 = LBOUND(InData%D2_63,1), UBOUND(InData%D2_63,1) - ReKiBuf(Re_Xferred) = InData%D2_63(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%D2_64) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%D2_64,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D2_64,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%D2_64,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D2_64,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%D2_64,2), UBOUND(InData%D2_64,2) - DO i1 = LBOUND(InData%D2_64,1), UBOUND(InData%D2_64,1) - ReKiBuf(Re_Xferred) = InData%D2_64(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MBB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MBB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MBB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBB,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MBB,2), UBOUND(InData%MBB,2) - DO i1 = LBOUND(InData%MBB,1), UBOUND(InData%MBB,1) - ReKiBuf(Re_Xferred) = InData%MBB(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%KBB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%KBB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%KBB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBB,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%KBB,2), UBOUND(InData%KBB,2) - DO i1 = LBOUND(InData%KBB,1), UBOUND(InData%KBB,1) - ReKiBuf(Re_Xferred) = InData%KBB(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CBB) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CBB,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CBB,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CBB,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CBB,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CBB,2), UBOUND(InData%CBB,2) - DO i1 = LBOUND(InData%CBB,1), UBOUND(InData%CBB,1) - ReKiBuf(Re_Xferred) = InData%CBB(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CMM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CMM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CMM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CMM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CMM,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%CMM,2), UBOUND(InData%CMM,2) - DO i1 = LBOUND(InData%CMM,1), UBOUND(InData%CMM,1) - ReKiBuf(Re_Xferred) = InData%CMM(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MBM) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MBM,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBM,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MBM,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBM,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%MBM,2), UBOUND(InData%MBM,2) - DO i1 = LBOUND(InData%MBM,1), UBOUND(InData%MBM,1) - ReKiBuf(Re_Xferred) = InData%MBM(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PhiL_T) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiL_T,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiL_T,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiL_T,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiL_T,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PhiL_T,2), UBOUND(InData%PhiL_T,2) - DO i1 = LBOUND(InData%PhiL_T,1), UBOUND(InData%PhiL_T,1) - ReKiBuf(Re_Xferred) = InData%PhiL_T(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PhiLInvOmgL2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiLInvOmgL2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiLInvOmgL2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PhiLInvOmgL2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiLInvOmgL2,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PhiLInvOmgL2,2), UBOUND(InData%PhiLInvOmgL2,2) - DO i1 = LBOUND(InData%PhiLInvOmgL2,1), UBOUND(InData%PhiLInvOmgL2,1) - ReKiBuf(Re_Xferred) = InData%PhiLInvOmgL2(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%KLLm1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%KLLm1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KLLm1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%KLLm1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KLLm1,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%KLLm1,2), UBOUND(InData%KLLm1,2) - DO i1 = LBOUND(InData%KLLm1,1), UBOUND(InData%KLLm1,1) - ReKiBuf(Re_Xferred) = InData%KLLm1(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AM2Jac) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AM2Jac,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AM2Jac,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AM2Jac,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AM2Jac,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%AM2Jac,2), UBOUND(InData%AM2Jac,2) - DO i1 = LBOUND(InData%AM2Jac,1), UBOUND(InData%AM2Jac,1) - ReKiBuf(Re_Xferred) = InData%AM2Jac(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AM2JacPiv) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AM2JacPiv,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AM2JacPiv,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AM2JacPiv,1), UBOUND(InData%AM2JacPiv,1) - IntKiBuf(Int_Xferred) = InData%AM2JacPiv(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TI) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TI,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TI,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TI,2), UBOUND(InData%TI,2) - DO i1 = LBOUND(InData%TI,1), UBOUND(InData%TI,1) - ReKiBuf(Re_Xferred) = InData%TI(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TIreact) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TIreact,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TIreact,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TIreact,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TIreact,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%TIreact,2), UBOUND(InData%TIreact,2) - DO i1 = LBOUND(InData%TIreact,1), UBOUND(InData%TIreact,1) - ReKiBuf(Re_Xferred) = InData%TIreact(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%nNodes - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nNodes_I - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nNodes_L - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nNodes_C - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Nodes_I) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Nodes_I,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nodes_I,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Nodes_I,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nodes_I,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Nodes_I,2), UBOUND(InData%Nodes_I,2) - DO i1 = LBOUND(InData%Nodes_I,1), UBOUND(InData%Nodes_I,1) - IntKiBuf(Int_Xferred) = InData%Nodes_I(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Nodes_L) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Nodes_L,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nodes_L,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Nodes_L,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nodes_L,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Nodes_L,2), UBOUND(InData%Nodes_L,2) - DO i1 = LBOUND(InData%Nodes_L,1), UBOUND(InData%Nodes_L,1) - IntKiBuf(Int_Xferred) = InData%Nodes_L(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Nodes_C) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Nodes_C,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nodes_C,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Nodes_C,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nodes_C,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Nodes_C,2), UBOUND(InData%Nodes_C,2) - DO i1 = LBOUND(InData%Nodes_C,1), UBOUND(InData%Nodes_C,1) - IntKiBuf(Int_Xferred) = InData%Nodes_C(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%nDOFI__ - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOFI_Rb - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOFI_F - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOFL_L - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOFC__ - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOFC_Rb - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOFC_L - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOFC_F - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOFR__ - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOF__Rb - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOF__L - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nDOF__F - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%IDI__) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IDI__,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDI__,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IDI__,1), UBOUND(InData%IDI__,1) - IntKiBuf(Int_Xferred) = InData%IDI__(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IDI_Rb) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IDI_Rb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDI_Rb,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IDI_Rb,1), UBOUND(InData%IDI_Rb,1) - IntKiBuf(Int_Xferred) = InData%IDI_Rb(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IDI_F) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IDI_F,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDI_F,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IDI_F,1), UBOUND(InData%IDI_F,1) - IntKiBuf(Int_Xferred) = InData%IDI_F(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IDL_L) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IDL_L,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDL_L,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IDL_L,1), UBOUND(InData%IDL_L,1) - IntKiBuf(Int_Xferred) = InData%IDL_L(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IDC__) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IDC__,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDC__,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IDC__,1), UBOUND(InData%IDC__,1) - IntKiBuf(Int_Xferred) = InData%IDC__(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IDC_Rb) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IDC_Rb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDC_Rb,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IDC_Rb,1), UBOUND(InData%IDC_Rb,1) - IntKiBuf(Int_Xferred) = InData%IDC_Rb(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IDC_L) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IDC_L,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDC_L,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IDC_L,1), UBOUND(InData%IDC_L,1) - IntKiBuf(Int_Xferred) = InData%IDC_L(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IDC_F) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IDC_F,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDC_F,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IDC_F,1), UBOUND(InData%IDC_F,1) - IntKiBuf(Int_Xferred) = InData%IDC_F(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%IDR__) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IDR__,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDR__,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IDR__,1), UBOUND(InData%IDR__,1) - IntKiBuf(Int_Xferred) = InData%IDR__(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ID__Rb) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ID__Rb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ID__Rb,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ID__Rb,1), UBOUND(InData%ID__Rb,1) - IntKiBuf(Int_Xferred) = InData%ID__Rb(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ID__L) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ID__L,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ID__L,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ID__L,1), UBOUND(InData%ID__L,1) - IntKiBuf(Int_Xferred) = InData%ID__L(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ID__F) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ID__F,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ID__F,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ID__F,1), UBOUND(InData%ID__F,1) - IntKiBuf(Int_Xferred) = InData%ID__F(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NMOutputs - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%OutSwtch - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UnJckF - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutSFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%MoutLst) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MoutLst,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MoutLst,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MoutLst,1), UBOUND(InData%MoutLst,1) - CALL SD_PackMeshAuxDataType( Re_Buf, Db_Buf, Int_Buf, InData%MoutLst(i1), ErrStat2, ErrMsg2, OnlySize ) ! MoutLst - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MoutLst2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MoutLst2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MoutLst2,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MoutLst2,1), UBOUND(InData%MoutLst2,1) - CALL SD_PackMeshAuxDataType( Re_Buf, Db_Buf, Int_Buf, InData%MoutLst2(i1), ErrStat2, ErrMsg2, OnlySize ) ! MoutLst2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%MoutLst3) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MoutLst3,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MoutLst3,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MoutLst3,1), UBOUND(InData%MoutLst3,1) - CALL SD_PackMeshAuxDataType( Re_Buf, Db_Buf, Int_Buf, InData%MoutLst3(i1), ErrStat2, ErrMsg2, OnlySize ) ! MoutLst3 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutParam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParam,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%OutAll, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%OutCBModes - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%OutFEMModes - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%OutReact, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%OutAllInt - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%OutAllDims - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%OutDec - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Jac_u_indx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_u_indx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_u_indx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Jac_u_indx,2), UBOUND(InData%Jac_u_indx,2) - DO i1 = LBOUND(InData%Jac_u_indx,1), UBOUND(InData%Jac_u_indx,1) - IntKiBuf(Int_Xferred) = InData%Jac_u_indx(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%du) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%du,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%du,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%du,1), UBOUND(InData%du,1) - DbKiBuf(Db_Xferred) = InData%du(i1) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - DO i1 = LBOUND(InData%dx,1), UBOUND(InData%dx,1) - DbKiBuf(Db_Xferred) = InData%dx(i1) - Db_Xferred = Db_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%Jac_ny - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Jac_nx - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%RotStates, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SD_PackParam - - SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SD_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%SDDeltaT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%IntMethod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOF = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOF_red = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Nmembers = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Elems not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Elems)) DEALLOCATE(OutData%Elems) - ALLOCATE(OutData%Elems(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Elems.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Elems,2), UBOUND(OutData%Elems,2) - DO i1 = LBOUND(OutData%Elems,1), UBOUND(OutData%Elems,1) - OutData%Elems(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElemProps not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ElemProps)) DEALLOCATE(OutData%ElemProps) - ALLOCATE(OutData%ElemProps(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElemProps.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ElemProps,1), UBOUND(OutData%ElemProps,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_UnpackElemPropType( Re_Buf, Db_Buf, Int_Buf, OutData%ElemProps(i1), ErrStat2, ErrMsg2 ) ! ElemProps - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FG not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FG)) DEALLOCATE(OutData%FG) - ALLOCATE(OutData%FG(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FG,1), UBOUND(OutData%FG,1) - OutData%FG(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DP0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DP0)) DEALLOCATE(OutData%DP0) - ALLOCATE(OutData%DP0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DP0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%DP0,2), UBOUND(OutData%DP0,2) - DO i1 = LBOUND(OutData%DP0,1), UBOUND(OutData%DP0,1) - OutData%DP0(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodeID2JointID not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NodeID2JointID)) DEALLOCATE(OutData%NodeID2JointID) - ALLOCATE(OutData%NodeID2JointID(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeID2JointID.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NodeID2JointID,1), UBOUND(OutData%NodeID2JointID,1) - OutData%NodeID2JointID(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%reduced = TRANSFER(IntKiBuf(Int_Xferred), OutData%reduced) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! T_red not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%T_red)) DEALLOCATE(OutData%T_red) - ALLOCATE(OutData%T_red(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%T_red.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%T_red,2), UBOUND(OutData%T_red,2) - DO i1 = LBOUND(OutData%T_red,1), UBOUND(OutData%T_red,1) - OutData%T_red(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! T_red_T not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%T_red_T)) DEALLOCATE(OutData%T_red_T) - ALLOCATE(OutData%T_red_T(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%T_red_T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%T_red_T,2), UBOUND(OutData%T_red_T,2) - DO i1 = LBOUND(OutData%T_red_T,1), UBOUND(OutData%T_red_T,1) - OutData%T_red_T(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodesDOF not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NodesDOF)) DEALLOCATE(OutData%NodesDOF) - ALLOCATE(OutData%NodesDOF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodesDOF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NodesDOF,1), UBOUND(OutData%NodesDOF,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_UnpackIList( Re_Buf, Db_Buf, Int_Buf, OutData%NodesDOF(i1), ErrStat2, ErrMsg2 ) ! NodesDOF - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodesDOFred not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%NodesDOFred)) DEALLOCATE(OutData%NodesDOFred) - ALLOCATE(OutData%NodesDOFred(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodesDOFred.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%NodesDOFred,1), UBOUND(OutData%NodesDOFred,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_UnpackIList( Re_Buf, Db_Buf, Int_Buf, OutData%NodesDOFred(i1), ErrStat2, ErrMsg2 ) ! NodesDOFred - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElemsDOF not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ElemsDOF)) DEALLOCATE(OutData%ElemsDOF) - ALLOCATE(OutData%ElemsDOF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElemsDOF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%ElemsDOF,2), UBOUND(OutData%ElemsDOF,2) - DO i1 = LBOUND(OutData%ElemsDOF,1), UBOUND(OutData%ElemsDOF,1) - OutData%ElemsDOF(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DOFred2Nodes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DOFred2Nodes)) DEALLOCATE(OutData%DOFred2Nodes) - ALLOCATE(OutData%DOFred2Nodes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DOFred2Nodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%DOFred2Nodes,2), UBOUND(OutData%DOFred2Nodes,2) - DO i1 = LBOUND(OutData%DOFred2Nodes,1), UBOUND(OutData%DOFred2Nodes,1) - OutData%DOFred2Nodes(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CtrlElem2Channel not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CtrlElem2Channel)) DEALLOCATE(OutData%CtrlElem2Channel) - ALLOCATE(OutData%CtrlElem2Channel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CtrlElem2Channel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CtrlElem2Channel,2), UBOUND(OutData%CtrlElem2Channel,2) - DO i1 = LBOUND(OutData%CtrlElem2Channel,1), UBOUND(OutData%CtrlElem2Channel,1) - OutData%CtrlElem2Channel(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - OutData%nDOFM = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%SttcSolve = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%GuyanLoadCorrection = TRANSFER(IntKiBuf(Int_Xferred), OutData%GuyanLoadCorrection) - Int_Xferred = Int_Xferred + 1 - OutData%Floating = TRANSFER(IntKiBuf(Int_Xferred), OutData%Floating) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! KMMDiag not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%KMMDiag)) DEALLOCATE(OutData%KMMDiag) - ALLOCATE(OutData%KMMDiag(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%KMMDiag.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%KMMDiag,1), UBOUND(OutData%KMMDiag,1) - OutData%KMMDiag(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CMMDiag not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CMMDiag)) DEALLOCATE(OutData%CMMDiag) - ALLOCATE(OutData%CMMDiag(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CMMDiag.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CMMDiag,1), UBOUND(OutData%CMMDiag,1) - OutData%CMMDiag(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MMB not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MMB)) DEALLOCATE(OutData%MMB) - ALLOCATE(OutData%MMB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MMB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MMB,2), UBOUND(OutData%MMB,2) - DO i1 = LBOUND(OutData%MMB,1), UBOUND(OutData%MMB,1) - OutData%MMB(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MBmmB not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MBmmB)) DEALLOCATE(OutData%MBmmB) - ALLOCATE(OutData%MBmmB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBmmB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MBmmB,2), UBOUND(OutData%MBmmB,2) - DO i1 = LBOUND(OutData%MBmmB,1), UBOUND(OutData%MBmmB,1) - OutData%MBmmB(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C1_11 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%C1_11)) DEALLOCATE(OutData%C1_11) - ALLOCATE(OutData%C1_11(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C1_11.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%C1_11,2), UBOUND(OutData%C1_11,2) - DO i1 = LBOUND(OutData%C1_11,1), UBOUND(OutData%C1_11,1) - OutData%C1_11(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C1_12 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%C1_12)) DEALLOCATE(OutData%C1_12) - ALLOCATE(OutData%C1_12(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C1_12.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%C1_12,2), UBOUND(OutData%C1_12,2) - DO i1 = LBOUND(OutData%C1_12,1), UBOUND(OutData%C1_12,1) - OutData%C1_12(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D1_141 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%D1_141)) DEALLOCATE(OutData%D1_141) - ALLOCATE(OutData%D1_141(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D1_141.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%D1_141,2), UBOUND(OutData%D1_141,2) - DO i1 = LBOUND(OutData%D1_141,1), UBOUND(OutData%D1_141,1) - OutData%D1_141(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D1_142 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%D1_142)) DEALLOCATE(OutData%D1_142) - ALLOCATE(OutData%D1_142(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D1_142.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%D1_142,2), UBOUND(OutData%D1_142,2) - DO i1 = LBOUND(OutData%D1_142,1), UBOUND(OutData%D1_142,1) - OutData%D1_142(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiM not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PhiM)) DEALLOCATE(OutData%PhiM) - ALLOCATE(OutData%PhiM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PhiM,2), UBOUND(OutData%PhiM,2) - DO i1 = LBOUND(OutData%PhiM,1), UBOUND(OutData%PhiM,1) - OutData%PhiM(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C2_61 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%C2_61)) DEALLOCATE(OutData%C2_61) - ALLOCATE(OutData%C2_61(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C2_61.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%C2_61,2), UBOUND(OutData%C2_61,2) - DO i1 = LBOUND(OutData%C2_61,1), UBOUND(OutData%C2_61,1) - OutData%C2_61(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C2_62 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%C2_62)) DEALLOCATE(OutData%C2_62) - ALLOCATE(OutData%C2_62(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C2_62.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%C2_62,2), UBOUND(OutData%C2_62,2) - DO i1 = LBOUND(OutData%C2_62,1), UBOUND(OutData%C2_62,1) - OutData%C2_62(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiRb_TI not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PhiRb_TI)) DEALLOCATE(OutData%PhiRb_TI) - ALLOCATE(OutData%PhiRb_TI(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiRb_TI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PhiRb_TI,2), UBOUND(OutData%PhiRb_TI,2) - DO i1 = LBOUND(OutData%PhiRb_TI,1), UBOUND(OutData%PhiRb_TI,1) - OutData%PhiRb_TI(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D2_63 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%D2_63)) DEALLOCATE(OutData%D2_63) - ALLOCATE(OutData%D2_63(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D2_63.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%D2_63,2), UBOUND(OutData%D2_63,2) - DO i1 = LBOUND(OutData%D2_63,1), UBOUND(OutData%D2_63,1) - OutData%D2_63(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D2_64 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%D2_64)) DEALLOCATE(OutData%D2_64) - ALLOCATE(OutData%D2_64(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D2_64.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%D2_64,2), UBOUND(OutData%D2_64,2) - DO i1 = LBOUND(OutData%D2_64,1), UBOUND(OutData%D2_64,1) - OutData%D2_64(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MBB not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MBB)) DEALLOCATE(OutData%MBB) - ALLOCATE(OutData%MBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MBB,2), UBOUND(OutData%MBB,2) - DO i1 = LBOUND(OutData%MBB,1), UBOUND(OutData%MBB,1) - OutData%MBB(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! KBB not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%KBB)) DEALLOCATE(OutData%KBB) - ALLOCATE(OutData%KBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%KBB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%KBB,2), UBOUND(OutData%KBB,2) - DO i1 = LBOUND(OutData%KBB,1), UBOUND(OutData%KBB,1) - OutData%KBB(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CBB not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CBB)) DEALLOCATE(OutData%CBB) - ALLOCATE(OutData%CBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CBB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CBB,2), UBOUND(OutData%CBB,2) - DO i1 = LBOUND(OutData%CBB,1), UBOUND(OutData%CBB,1) - OutData%CBB(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CMM not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CMM)) DEALLOCATE(OutData%CMM) - ALLOCATE(OutData%CMM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CMM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%CMM,2), UBOUND(OutData%CMM,2) - DO i1 = LBOUND(OutData%CMM,1), UBOUND(OutData%CMM,1) - OutData%CMM(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MBM not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MBM)) DEALLOCATE(OutData%MBM) - ALLOCATE(OutData%MBM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%MBM,2), UBOUND(OutData%MBM,2) - DO i1 = LBOUND(OutData%MBM,1), UBOUND(OutData%MBM,1) - OutData%MBM(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiL_T not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PhiL_T)) DEALLOCATE(OutData%PhiL_T) - ALLOCATE(OutData%PhiL_T(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiL_T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PhiL_T,2), UBOUND(OutData%PhiL_T,2) - DO i1 = LBOUND(OutData%PhiL_T,1), UBOUND(OutData%PhiL_T,1) - OutData%PhiL_T(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiLInvOmgL2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PhiLInvOmgL2)) DEALLOCATE(OutData%PhiLInvOmgL2) - ALLOCATE(OutData%PhiLInvOmgL2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiLInvOmgL2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PhiLInvOmgL2,2), UBOUND(OutData%PhiLInvOmgL2,2) - DO i1 = LBOUND(OutData%PhiLInvOmgL2,1), UBOUND(OutData%PhiLInvOmgL2,1) - OutData%PhiLInvOmgL2(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! KLLm1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%KLLm1)) DEALLOCATE(OutData%KLLm1) - ALLOCATE(OutData%KLLm1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%KLLm1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%KLLm1,2), UBOUND(OutData%KLLm1,2) - DO i1 = LBOUND(OutData%KLLm1,1), UBOUND(OutData%KLLm1,1) - OutData%KLLm1(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AM2Jac not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AM2Jac)) DEALLOCATE(OutData%AM2Jac) - ALLOCATE(OutData%AM2Jac(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AM2Jac.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%AM2Jac,2), UBOUND(OutData%AM2Jac,2) - DO i1 = LBOUND(OutData%AM2Jac,1), UBOUND(OutData%AM2Jac,1) - OutData%AM2Jac(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AM2JacPiv not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AM2JacPiv)) DEALLOCATE(OutData%AM2JacPiv) - ALLOCATE(OutData%AM2JacPiv(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AM2JacPiv.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AM2JacPiv,1), UBOUND(OutData%AM2JacPiv,1) - OutData%AM2JacPiv(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TI not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TI)) DEALLOCATE(OutData%TI) - ALLOCATE(OutData%TI(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TI,2), UBOUND(OutData%TI,2) - DO i1 = LBOUND(OutData%TI,1), UBOUND(OutData%TI,1) - OutData%TI(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TIreact not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TIreact)) DEALLOCATE(OutData%TIreact) - ALLOCATE(OutData%TIreact(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TIreact.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%TIreact,2), UBOUND(OutData%TIreact,2) - DO i1 = LBOUND(OutData%TIreact,1), UBOUND(OutData%TIreact,1) - OutData%TIreact(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%nNodes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nNodes_I = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nNodes_L = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nNodes_C = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Nodes_I not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Nodes_I)) DEALLOCATE(OutData%Nodes_I) - ALLOCATE(OutData%Nodes_I(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nodes_I.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Nodes_I,2), UBOUND(OutData%Nodes_I,2) - DO i1 = LBOUND(OutData%Nodes_I,1), UBOUND(OutData%Nodes_I,1) - OutData%Nodes_I(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Nodes_L not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Nodes_L)) DEALLOCATE(OutData%Nodes_L) - ALLOCATE(OutData%Nodes_L(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nodes_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Nodes_L,2), UBOUND(OutData%Nodes_L,2) - DO i1 = LBOUND(OutData%Nodes_L,1), UBOUND(OutData%Nodes_L,1) - OutData%Nodes_L(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Nodes_C not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Nodes_C)) DEALLOCATE(OutData%Nodes_C) - ALLOCATE(OutData%Nodes_C(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nodes_C.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Nodes_C,2), UBOUND(OutData%Nodes_C,2) - DO i1 = LBOUND(OutData%Nodes_C,1), UBOUND(OutData%Nodes_C,1) - OutData%Nodes_C(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - OutData%nDOFI__ = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOFI_Rb = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOFI_F = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOFL_L = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOFC__ = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOFC_Rb = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOFC_L = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOFC_F = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOFR__ = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOF__Rb = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOF__L = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nDOF__F = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDI__ not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IDI__)) DEALLOCATE(OutData%IDI__) - ALLOCATE(OutData%IDI__(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDI__.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IDI__,1), UBOUND(OutData%IDI__,1) - OutData%IDI__(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDI_Rb not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IDI_Rb)) DEALLOCATE(OutData%IDI_Rb) - ALLOCATE(OutData%IDI_Rb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDI_Rb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IDI_Rb,1), UBOUND(OutData%IDI_Rb,1) - OutData%IDI_Rb(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDI_F not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IDI_F)) DEALLOCATE(OutData%IDI_F) - ALLOCATE(OutData%IDI_F(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDI_F.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IDI_F,1), UBOUND(OutData%IDI_F,1) - OutData%IDI_F(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDL_L not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IDL_L)) DEALLOCATE(OutData%IDL_L) - ALLOCATE(OutData%IDL_L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDL_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IDL_L,1), UBOUND(OutData%IDL_L,1) - OutData%IDL_L(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDC__ not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IDC__)) DEALLOCATE(OutData%IDC__) - ALLOCATE(OutData%IDC__(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDC__.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IDC__,1), UBOUND(OutData%IDC__,1) - OutData%IDC__(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDC_Rb not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IDC_Rb)) DEALLOCATE(OutData%IDC_Rb) - ALLOCATE(OutData%IDC_Rb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDC_Rb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IDC_Rb,1), UBOUND(OutData%IDC_Rb,1) - OutData%IDC_Rb(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDC_L not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IDC_L)) DEALLOCATE(OutData%IDC_L) - ALLOCATE(OutData%IDC_L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDC_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IDC_L,1), UBOUND(OutData%IDC_L,1) - OutData%IDC_L(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDC_F not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IDC_F)) DEALLOCATE(OutData%IDC_F) - ALLOCATE(OutData%IDC_F(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDC_F.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IDC_F,1), UBOUND(OutData%IDC_F,1) - OutData%IDC_F(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDR__ not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IDR__)) DEALLOCATE(OutData%IDR__) - ALLOCATE(OutData%IDR__(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDR__.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IDR__,1), UBOUND(OutData%IDR__,1) - OutData%IDR__(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ID__Rb not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ID__Rb)) DEALLOCATE(OutData%ID__Rb) - ALLOCATE(OutData%ID__Rb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ID__Rb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ID__Rb,1), UBOUND(OutData%ID__Rb,1) - OutData%ID__Rb(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ID__L not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ID__L)) DEALLOCATE(OutData%ID__L) - ALLOCATE(OutData%ID__L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ID__L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ID__L,1), UBOUND(OutData%ID__L,1) - OutData%ID__L(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ID__F not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ID__F)) DEALLOCATE(OutData%ID__F) - ALLOCATE(OutData%ID__F(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ID__F.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ID__F,1), UBOUND(OutData%ID__F,1) - OutData%ID__F(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - OutData%NMOutputs = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%OutSwtch = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%UnJckF = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutSFmt) - OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MoutLst not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MoutLst)) DEALLOCATE(OutData%MoutLst) - ALLOCATE(OutData%MoutLst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MoutLst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MoutLst,1), UBOUND(OutData%MoutLst,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_UnpackMeshAuxDataType( Re_Buf, Db_Buf, Int_Buf, OutData%MoutLst(i1), ErrStat2, ErrMsg2 ) ! MoutLst - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MoutLst2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MoutLst2)) DEALLOCATE(OutData%MoutLst2) - ALLOCATE(OutData%MoutLst2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MoutLst2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MoutLst2,1), UBOUND(OutData%MoutLst2,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_UnpackMeshAuxDataType( Re_Buf, Db_Buf, Int_Buf, OutData%MoutLst2(i1), ErrStat2, ErrMsg2 ) ! MoutLst2 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MoutLst3 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MoutLst3)) DEALLOCATE(OutData%MoutLst3) - ALLOCATE(OutData%MoutLst3(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MoutLst3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%MoutLst3,1), UBOUND(OutData%MoutLst3,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_UnpackMeshAuxDataType( Re_Buf, Db_Buf, Int_Buf, OutData%MoutLst3(i1), ErrStat2, ErrMsg2 ) ! MoutLst3 - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutParam)) DEALLOCATE(OutData%OutParam) - ALLOCATE(OutData%OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutParam,1), UBOUND(OutData%OutParam,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackOutParmType( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - OutData%OutAll = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutAll) - Int_Xferred = Int_Xferred + 1 - OutData%OutCBModes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%OutFEMModes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%OutReact = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutReact) - Int_Xferred = Int_Xferred + 1 - OutData%OutAllInt = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%OutAllDims = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%OutDec = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_u_indx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Jac_u_indx)) DEALLOCATE(OutData%Jac_u_indx) - ALLOCATE(OutData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Jac_u_indx,2), UBOUND(OutData%Jac_u_indx,2) - DO i1 = LBOUND(OutData%Jac_u_indx,1), UBOUND(OutData%Jac_u_indx,1) - OutData%Jac_u_indx(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! du not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%du)) DEALLOCATE(OutData%du) - ALLOCATE(OutData%du(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%du,1), UBOUND(OutData%du,1) - OutData%du(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - END IF - i1_l = LBOUND(OutData%dx,1) - i1_u = UBOUND(OutData%dx,1) - DO i1 = LBOUND(OutData%dx,1), UBOUND(OutData%dx,1) - OutData%dx(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) - Db_Xferred = Db_Xferred + 1 - END DO - OutData%Jac_ny = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Jac_nx = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%RotStates = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotStates) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SD_UnPackParam +subroutine SD_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SD_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackParam' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + ! SDDeltaT + call RegPack(Buf, InData%SDDeltaT) + if (RegCheckErr(Buf, RoutineName)) return + ! IntMethod + call RegPack(Buf, InData%IntMethod) + if (RegCheckErr(Buf, RoutineName)) return + ! nDOF + call RegPack(Buf, InData%nDOF) + if (RegCheckErr(Buf, RoutineName)) return + ! nDOF_red + call RegPack(Buf, InData%nDOF_red) + if (RegCheckErr(Buf, RoutineName)) return + ! Nmembers + call RegPack(Buf, InData%Nmembers) + if (RegCheckErr(Buf, RoutineName)) return + ! Elems + call RegPack(Buf, allocated(InData%Elems)) + if (allocated(InData%Elems)) then + call RegPackBounds(Buf, 2, lbound(InData%Elems), ubound(InData%Elems)) + call RegPack(Buf, InData%Elems) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ElemProps + call RegPack(Buf, allocated(InData%ElemProps)) + if (allocated(InData%ElemProps)) then + call RegPackBounds(Buf, 1, lbound(InData%ElemProps), ubound(InData%ElemProps)) + LB(1:1) = lbound(InData%ElemProps) + UB(1:1) = ubound(InData%ElemProps) + do i1 = LB(1), UB(1) + call SD_PackElemPropType(Buf, InData%ElemProps(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! FG + call RegPack(Buf, allocated(InData%FG)) + if (allocated(InData%FG)) then + call RegPackBounds(Buf, 1, lbound(InData%FG), ubound(InData%FG)) + call RegPack(Buf, InData%FG) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DP0 + call RegPack(Buf, allocated(InData%DP0)) + if (allocated(InData%DP0)) then + call RegPackBounds(Buf, 2, lbound(InData%DP0), ubound(InData%DP0)) + call RegPack(Buf, InData%DP0) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NodeID2JointID + call RegPack(Buf, allocated(InData%NodeID2JointID)) + if (allocated(InData%NodeID2JointID)) then + call RegPackBounds(Buf, 1, lbound(InData%NodeID2JointID), ubound(InData%NodeID2JointID)) + call RegPack(Buf, InData%NodeID2JointID) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! reduced + call RegPack(Buf, InData%reduced) + if (RegCheckErr(Buf, RoutineName)) return + ! T_red + call RegPack(Buf, allocated(InData%T_red)) + if (allocated(InData%T_red)) then + call RegPackBounds(Buf, 2, lbound(InData%T_red), ubound(InData%T_red)) + call RegPack(Buf, InData%T_red) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! T_red_T + call RegPack(Buf, allocated(InData%T_red_T)) + if (allocated(InData%T_red_T)) then + call RegPackBounds(Buf, 2, lbound(InData%T_red_T), ubound(InData%T_red_T)) + call RegPack(Buf, InData%T_red_T) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NodesDOF + call RegPack(Buf, allocated(InData%NodesDOF)) + if (allocated(InData%NodesDOF)) then + call RegPackBounds(Buf, 1, lbound(InData%NodesDOF), ubound(InData%NodesDOF)) + LB(1:1) = lbound(InData%NodesDOF) + UB(1:1) = ubound(InData%NodesDOF) + do i1 = LB(1), UB(1) + call SD_PackIList(Buf, InData%NodesDOF(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NodesDOFred + call RegPack(Buf, allocated(InData%NodesDOFred)) + if (allocated(InData%NodesDOFred)) then + call RegPackBounds(Buf, 1, lbound(InData%NodesDOFred), ubound(InData%NodesDOFred)) + LB(1:1) = lbound(InData%NodesDOFred) + UB(1:1) = ubound(InData%NodesDOFred) + do i1 = LB(1), UB(1) + call SD_PackIList(Buf, InData%NodesDOFred(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ElemsDOF + call RegPack(Buf, allocated(InData%ElemsDOF)) + if (allocated(InData%ElemsDOF)) then + call RegPackBounds(Buf, 2, lbound(InData%ElemsDOF), ubound(InData%ElemsDOF)) + call RegPack(Buf, InData%ElemsDOF) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DOFred2Nodes + call RegPack(Buf, allocated(InData%DOFred2Nodes)) + if (allocated(InData%DOFred2Nodes)) then + call RegPackBounds(Buf, 2, lbound(InData%DOFred2Nodes), ubound(InData%DOFred2Nodes)) + call RegPack(Buf, InData%DOFred2Nodes) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CtrlElem2Channel + call RegPack(Buf, allocated(InData%CtrlElem2Channel)) + if (allocated(InData%CtrlElem2Channel)) then + call RegPackBounds(Buf, 2, lbound(InData%CtrlElem2Channel), ubound(InData%CtrlElem2Channel)) + call RegPack(Buf, InData%CtrlElem2Channel) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! nDOFM + call RegPack(Buf, InData%nDOFM) + if (RegCheckErr(Buf, RoutineName)) return + ! SttcSolve + call RegPack(Buf, InData%SttcSolve) + if (RegCheckErr(Buf, RoutineName)) return + ! GuyanLoadCorrection + call RegPack(Buf, InData%GuyanLoadCorrection) + if (RegCheckErr(Buf, RoutineName)) return + ! Floating + call RegPack(Buf, InData%Floating) + if (RegCheckErr(Buf, RoutineName)) return + ! KMMDiag + call RegPack(Buf, allocated(InData%KMMDiag)) + if (allocated(InData%KMMDiag)) then + call RegPackBounds(Buf, 1, lbound(InData%KMMDiag), ubound(InData%KMMDiag)) + call RegPack(Buf, InData%KMMDiag) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CMMDiag + call RegPack(Buf, allocated(InData%CMMDiag)) + if (allocated(InData%CMMDiag)) then + call RegPackBounds(Buf, 1, lbound(InData%CMMDiag), ubound(InData%CMMDiag)) + call RegPack(Buf, InData%CMMDiag) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MMB + call RegPack(Buf, allocated(InData%MMB)) + if (allocated(InData%MMB)) then + call RegPackBounds(Buf, 2, lbound(InData%MMB), ubound(InData%MMB)) + call RegPack(Buf, InData%MMB) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MBmmB + call RegPack(Buf, allocated(InData%MBmmB)) + if (allocated(InData%MBmmB)) then + call RegPackBounds(Buf, 2, lbound(InData%MBmmB), ubound(InData%MBmmB)) + call RegPack(Buf, InData%MBmmB) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! C1_11 + call RegPack(Buf, allocated(InData%C1_11)) + if (allocated(InData%C1_11)) then + call RegPackBounds(Buf, 2, lbound(InData%C1_11), ubound(InData%C1_11)) + call RegPack(Buf, InData%C1_11) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! C1_12 + call RegPack(Buf, allocated(InData%C1_12)) + if (allocated(InData%C1_12)) then + call RegPackBounds(Buf, 2, lbound(InData%C1_12), ubound(InData%C1_12)) + call RegPack(Buf, InData%C1_12) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! D1_141 + call RegPack(Buf, allocated(InData%D1_141)) + if (allocated(InData%D1_141)) then + call RegPackBounds(Buf, 2, lbound(InData%D1_141), ubound(InData%D1_141)) + call RegPack(Buf, InData%D1_141) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! D1_142 + call RegPack(Buf, allocated(InData%D1_142)) + if (allocated(InData%D1_142)) then + call RegPackBounds(Buf, 2, lbound(InData%D1_142), ubound(InData%D1_142)) + call RegPack(Buf, InData%D1_142) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PhiM + call RegPack(Buf, allocated(InData%PhiM)) + if (allocated(InData%PhiM)) then + call RegPackBounds(Buf, 2, lbound(InData%PhiM), ubound(InData%PhiM)) + call RegPack(Buf, InData%PhiM) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! C2_61 + call RegPack(Buf, allocated(InData%C2_61)) + if (allocated(InData%C2_61)) then + call RegPackBounds(Buf, 2, lbound(InData%C2_61), ubound(InData%C2_61)) + call RegPack(Buf, InData%C2_61) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! C2_62 + call RegPack(Buf, allocated(InData%C2_62)) + if (allocated(InData%C2_62)) then + call RegPackBounds(Buf, 2, lbound(InData%C2_62), ubound(InData%C2_62)) + call RegPack(Buf, InData%C2_62) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PhiRb_TI + call RegPack(Buf, allocated(InData%PhiRb_TI)) + if (allocated(InData%PhiRb_TI)) then + call RegPackBounds(Buf, 2, lbound(InData%PhiRb_TI), ubound(InData%PhiRb_TI)) + call RegPack(Buf, InData%PhiRb_TI) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! D2_63 + call RegPack(Buf, allocated(InData%D2_63)) + if (allocated(InData%D2_63)) then + call RegPackBounds(Buf, 2, lbound(InData%D2_63), ubound(InData%D2_63)) + call RegPack(Buf, InData%D2_63) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! D2_64 + call RegPack(Buf, allocated(InData%D2_64)) + if (allocated(InData%D2_64)) then + call RegPackBounds(Buf, 2, lbound(InData%D2_64), ubound(InData%D2_64)) + call RegPack(Buf, InData%D2_64) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MBB + call RegPack(Buf, allocated(InData%MBB)) + if (allocated(InData%MBB)) then + call RegPackBounds(Buf, 2, lbound(InData%MBB), ubound(InData%MBB)) + call RegPack(Buf, InData%MBB) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! KBB + call RegPack(Buf, allocated(InData%KBB)) + if (allocated(InData%KBB)) then + call RegPackBounds(Buf, 2, lbound(InData%KBB), ubound(InData%KBB)) + call RegPack(Buf, InData%KBB) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CBB + call RegPack(Buf, allocated(InData%CBB)) + if (allocated(InData%CBB)) then + call RegPackBounds(Buf, 2, lbound(InData%CBB), ubound(InData%CBB)) + call RegPack(Buf, InData%CBB) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! CMM + call RegPack(Buf, allocated(InData%CMM)) + if (allocated(InData%CMM)) then + call RegPackBounds(Buf, 2, lbound(InData%CMM), ubound(InData%CMM)) + call RegPack(Buf, InData%CMM) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MBM + call RegPack(Buf, allocated(InData%MBM)) + if (allocated(InData%MBM)) then + call RegPackBounds(Buf, 2, lbound(InData%MBM), ubound(InData%MBM)) + call RegPack(Buf, InData%MBM) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PhiL_T + call RegPack(Buf, allocated(InData%PhiL_T)) + if (allocated(InData%PhiL_T)) then + call RegPackBounds(Buf, 2, lbound(InData%PhiL_T), ubound(InData%PhiL_T)) + call RegPack(Buf, InData%PhiL_T) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! PhiLInvOmgL2 + call RegPack(Buf, allocated(InData%PhiLInvOmgL2)) + if (allocated(InData%PhiLInvOmgL2)) then + call RegPackBounds(Buf, 2, lbound(InData%PhiLInvOmgL2), ubound(InData%PhiLInvOmgL2)) + call RegPack(Buf, InData%PhiLInvOmgL2) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! KLLm1 + call RegPack(Buf, allocated(InData%KLLm1)) + if (allocated(InData%KLLm1)) then + call RegPackBounds(Buf, 2, lbound(InData%KLLm1), ubound(InData%KLLm1)) + call RegPack(Buf, InData%KLLm1) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AM2Jac + call RegPack(Buf, allocated(InData%AM2Jac)) + if (allocated(InData%AM2Jac)) then + call RegPackBounds(Buf, 2, lbound(InData%AM2Jac), ubound(InData%AM2Jac)) + call RegPack(Buf, InData%AM2Jac) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! AM2JacPiv + call RegPack(Buf, allocated(InData%AM2JacPiv)) + if (allocated(InData%AM2JacPiv)) then + call RegPackBounds(Buf, 1, lbound(InData%AM2JacPiv), ubound(InData%AM2JacPiv)) + call RegPack(Buf, InData%AM2JacPiv) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TI + call RegPack(Buf, allocated(InData%TI)) + if (allocated(InData%TI)) then + call RegPackBounds(Buf, 2, lbound(InData%TI), ubound(InData%TI)) + call RegPack(Buf, InData%TI) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TIreact + call RegPack(Buf, allocated(InData%TIreact)) + if (allocated(InData%TIreact)) then + call RegPackBounds(Buf, 2, lbound(InData%TIreact), ubound(InData%TIreact)) + call RegPack(Buf, InData%TIreact) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! nNodes + call RegPack(Buf, InData%nNodes) + if (RegCheckErr(Buf, RoutineName)) return + ! nNodes_I + call RegPack(Buf, InData%nNodes_I) + if (RegCheckErr(Buf, RoutineName)) return + ! nNodes_L + call RegPack(Buf, InData%nNodes_L) + if (RegCheckErr(Buf, RoutineName)) return + ! nNodes_C + call RegPack(Buf, InData%nNodes_C) + if (RegCheckErr(Buf, RoutineName)) return + ! Nodes_I + call RegPack(Buf, allocated(InData%Nodes_I)) + if (allocated(InData%Nodes_I)) then + call RegPackBounds(Buf, 2, lbound(InData%Nodes_I), ubound(InData%Nodes_I)) + call RegPack(Buf, InData%Nodes_I) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Nodes_L + call RegPack(Buf, allocated(InData%Nodes_L)) + if (allocated(InData%Nodes_L)) then + call RegPackBounds(Buf, 2, lbound(InData%Nodes_L), ubound(InData%Nodes_L)) + call RegPack(Buf, InData%Nodes_L) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Nodes_C + call RegPack(Buf, allocated(InData%Nodes_C)) + if (allocated(InData%Nodes_C)) then + call RegPackBounds(Buf, 2, lbound(InData%Nodes_C), ubound(InData%Nodes_C)) + call RegPack(Buf, InData%Nodes_C) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! nDOFI__ + call RegPack(Buf, InData%nDOFI__) + if (RegCheckErr(Buf, RoutineName)) return + ! nDOFI_Rb + call RegPack(Buf, InData%nDOFI_Rb) + if (RegCheckErr(Buf, RoutineName)) return + ! nDOFI_F + call RegPack(Buf, InData%nDOFI_F) + if (RegCheckErr(Buf, RoutineName)) return + ! nDOFL_L + call RegPack(Buf, InData%nDOFL_L) + if (RegCheckErr(Buf, RoutineName)) return + ! nDOFC__ + call RegPack(Buf, InData%nDOFC__) + if (RegCheckErr(Buf, RoutineName)) return + ! nDOFC_Rb + call RegPack(Buf, InData%nDOFC_Rb) + if (RegCheckErr(Buf, RoutineName)) return + ! nDOFC_L + call RegPack(Buf, InData%nDOFC_L) + if (RegCheckErr(Buf, RoutineName)) return + ! nDOFC_F + call RegPack(Buf, InData%nDOFC_F) + if (RegCheckErr(Buf, RoutineName)) return + ! nDOFR__ + call RegPack(Buf, InData%nDOFR__) + if (RegCheckErr(Buf, RoutineName)) return + ! nDOF__Rb + call RegPack(Buf, InData%nDOF__Rb) + if (RegCheckErr(Buf, RoutineName)) return + ! nDOF__L + call RegPack(Buf, InData%nDOF__L) + if (RegCheckErr(Buf, RoutineName)) return + ! nDOF__F + call RegPack(Buf, InData%nDOF__F) + if (RegCheckErr(Buf, RoutineName)) return + ! IDI__ + call RegPack(Buf, allocated(InData%IDI__)) + if (allocated(InData%IDI__)) then + call RegPackBounds(Buf, 1, lbound(InData%IDI__), ubound(InData%IDI__)) + call RegPack(Buf, InData%IDI__) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! IDI_Rb + call RegPack(Buf, allocated(InData%IDI_Rb)) + if (allocated(InData%IDI_Rb)) then + call RegPackBounds(Buf, 1, lbound(InData%IDI_Rb), ubound(InData%IDI_Rb)) + call RegPack(Buf, InData%IDI_Rb) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! IDI_F + call RegPack(Buf, allocated(InData%IDI_F)) + if (allocated(InData%IDI_F)) then + call RegPackBounds(Buf, 1, lbound(InData%IDI_F), ubound(InData%IDI_F)) + call RegPack(Buf, InData%IDI_F) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! IDL_L + call RegPack(Buf, allocated(InData%IDL_L)) + if (allocated(InData%IDL_L)) then + call RegPackBounds(Buf, 1, lbound(InData%IDL_L), ubound(InData%IDL_L)) + call RegPack(Buf, InData%IDL_L) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! IDC__ + call RegPack(Buf, allocated(InData%IDC__)) + if (allocated(InData%IDC__)) then + call RegPackBounds(Buf, 1, lbound(InData%IDC__), ubound(InData%IDC__)) + call RegPack(Buf, InData%IDC__) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! IDC_Rb + call RegPack(Buf, allocated(InData%IDC_Rb)) + if (allocated(InData%IDC_Rb)) then + call RegPackBounds(Buf, 1, lbound(InData%IDC_Rb), ubound(InData%IDC_Rb)) + call RegPack(Buf, InData%IDC_Rb) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! IDC_L + call RegPack(Buf, allocated(InData%IDC_L)) + if (allocated(InData%IDC_L)) then + call RegPackBounds(Buf, 1, lbound(InData%IDC_L), ubound(InData%IDC_L)) + call RegPack(Buf, InData%IDC_L) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! IDC_F + call RegPack(Buf, allocated(InData%IDC_F)) + if (allocated(InData%IDC_F)) then + call RegPackBounds(Buf, 1, lbound(InData%IDC_F), ubound(InData%IDC_F)) + call RegPack(Buf, InData%IDC_F) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! IDR__ + call RegPack(Buf, allocated(InData%IDR__)) + if (allocated(InData%IDR__)) then + call RegPackBounds(Buf, 1, lbound(InData%IDR__), ubound(InData%IDR__)) + call RegPack(Buf, InData%IDR__) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ID__Rb + call RegPack(Buf, allocated(InData%ID__Rb)) + if (allocated(InData%ID__Rb)) then + call RegPackBounds(Buf, 1, lbound(InData%ID__Rb), ubound(InData%ID__Rb)) + call RegPack(Buf, InData%ID__Rb) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ID__L + call RegPack(Buf, allocated(InData%ID__L)) + if (allocated(InData%ID__L)) then + call RegPackBounds(Buf, 1, lbound(InData%ID__L), ubound(InData%ID__L)) + call RegPack(Buf, InData%ID__L) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ID__F + call RegPack(Buf, allocated(InData%ID__F)) + if (allocated(InData%ID__F)) then + call RegPackBounds(Buf, 1, lbound(InData%ID__F), ubound(InData%ID__F)) + call RegPack(Buf, InData%ID__F) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! NMOutputs + call RegPack(Buf, InData%NMOutputs) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegPack(Buf, InData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! OutSwtch + call RegPack(Buf, InData%OutSwtch) + if (RegCheckErr(Buf, RoutineName)) return + ! UnJckF + call RegPack(Buf, InData%UnJckF) + if (RegCheckErr(Buf, RoutineName)) return + ! Delim + call RegPack(Buf, InData%Delim) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFmt + call RegPack(Buf, InData%OutFmt) + if (RegCheckErr(Buf, RoutineName)) return + ! OutSFmt + call RegPack(Buf, InData%OutSFmt) + if (RegCheckErr(Buf, RoutineName)) return + ! MoutLst + call RegPack(Buf, allocated(InData%MoutLst)) + if (allocated(InData%MoutLst)) then + call RegPackBounds(Buf, 1, lbound(InData%MoutLst), ubound(InData%MoutLst)) + LB(1:1) = lbound(InData%MoutLst) + UB(1:1) = ubound(InData%MoutLst) + do i1 = LB(1), UB(1) + call SD_PackMeshAuxDataType(Buf, InData%MoutLst(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MoutLst2 + call RegPack(Buf, allocated(InData%MoutLst2)) + if (allocated(InData%MoutLst2)) then + call RegPackBounds(Buf, 1, lbound(InData%MoutLst2), ubound(InData%MoutLst2)) + LB(1:1) = lbound(InData%MoutLst2) + UB(1:1) = ubound(InData%MoutLst2) + do i1 = LB(1), UB(1) + call SD_PackMeshAuxDataType(Buf, InData%MoutLst2(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! MoutLst3 + call RegPack(Buf, allocated(InData%MoutLst3)) + if (allocated(InData%MoutLst3)) then + call RegPackBounds(Buf, 1, lbound(InData%MoutLst3), ubound(InData%MoutLst3)) + LB(1:1) = lbound(InData%MoutLst3) + UB(1:1) = ubound(InData%MoutLst3) + do i1 = LB(1), UB(1) + call SD_PackMeshAuxDataType(Buf, InData%MoutLst3(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OutParam + call RegPack(Buf, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + ! OutAll + call RegPack(Buf, InData%OutAll) + if (RegCheckErr(Buf, RoutineName)) return + ! OutCBModes + call RegPack(Buf, InData%OutCBModes) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFEMModes + call RegPack(Buf, InData%OutFEMModes) + if (RegCheckErr(Buf, RoutineName)) return + ! OutReact + call RegPack(Buf, InData%OutReact) + if (RegCheckErr(Buf, RoutineName)) return + ! OutAllInt + call RegPack(Buf, InData%OutAllInt) + if (RegCheckErr(Buf, RoutineName)) return + ! OutAllDims + call RegPack(Buf, InData%OutAllDims) + if (RegCheckErr(Buf, RoutineName)) return + ! OutDec + call RegPack(Buf, InData%OutDec) + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_u_indx + call RegPack(Buf, allocated(InData%Jac_u_indx)) + if (allocated(InData%Jac_u_indx)) then + call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx), ubound(InData%Jac_u_indx)) + call RegPack(Buf, InData%Jac_u_indx) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! du + call RegPack(Buf, allocated(InData%du)) + if (allocated(InData%du)) then + call RegPackBounds(Buf, 1, lbound(InData%du), ubound(InData%du)) + call RegPack(Buf, InData%du) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! dx + call RegPack(Buf, InData%dx) + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_ny + call RegPack(Buf, InData%Jac_ny) + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_nx + call RegPack(Buf, InData%Jac_nx) + if (RegCheckErr(Buf, RoutineName)) return + ! RotStates + call RegPack(Buf, InData%RotStates) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SD_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SD_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackParam' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! SDDeltaT + call RegUnpack(Buf, OutData%SDDeltaT) + if (RegCheckErr(Buf, RoutineName)) return + ! IntMethod + call RegUnpack(Buf, OutData%IntMethod) + if (RegCheckErr(Buf, RoutineName)) return + ! nDOF + call RegUnpack(Buf, OutData%nDOF) + if (RegCheckErr(Buf, RoutineName)) return + ! nDOF_red + call RegUnpack(Buf, OutData%nDOF_red) + if (RegCheckErr(Buf, RoutineName)) return + ! Nmembers + call RegUnpack(Buf, OutData%Nmembers) + if (RegCheckErr(Buf, RoutineName)) return + ! Elems + if (allocated(OutData%Elems)) deallocate(OutData%Elems) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Elems(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Elems.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Elems) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ElemProps + if (allocated(OutData%ElemProps)) deallocate(OutData%ElemProps) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ElemProps(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElemProps.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackElemPropType(Buf, OutData%ElemProps(i1)) ! ElemProps + end do + end if + ! FG + if (allocated(OutData%FG)) deallocate(OutData%FG) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%FG(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FG.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%FG) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! DP0 + if (allocated(OutData%DP0)) deallocate(OutData%DP0) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DP0(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DP0.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DP0) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NodeID2JointID + if (allocated(OutData%NodeID2JointID)) deallocate(OutData%NodeID2JointID) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NodeID2JointID(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeID2JointID.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%NodeID2JointID) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! reduced + call RegUnpack(Buf, OutData%reduced) + if (RegCheckErr(Buf, RoutineName)) return + ! T_red + if (allocated(OutData%T_red)) deallocate(OutData%T_red) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%T_red(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%T_red.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%T_red) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! T_red_T + if (allocated(OutData%T_red_T)) deallocate(OutData%T_red_T) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%T_red_T(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%T_red_T.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%T_red_T) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NodesDOF + if (allocated(OutData%NodesDOF)) deallocate(OutData%NodesDOF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NodesDOF(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodesDOF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackIList(Buf, OutData%NodesDOF(i1)) ! NodesDOF + end do + end if + ! NodesDOFred + if (allocated(OutData%NodesDOFred)) deallocate(OutData%NodesDOFred) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%NodesDOFred(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodesDOFred.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackIList(Buf, OutData%NodesDOFred(i1)) ! NodesDOFred + end do + end if + ! ElemsDOF + if (allocated(OutData%ElemsDOF)) deallocate(OutData%ElemsDOF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ElemsDOF(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElemsDOF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ElemsDOF) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! DOFred2Nodes + if (allocated(OutData%DOFred2Nodes)) deallocate(OutData%DOFred2Nodes) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DOFred2Nodes(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DOFred2Nodes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DOFred2Nodes) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CtrlElem2Channel + if (allocated(OutData%CtrlElem2Channel)) deallocate(OutData%CtrlElem2Channel) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CtrlElem2Channel(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CtrlElem2Channel.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CtrlElem2Channel) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! nDOFM + call RegUnpack(Buf, OutData%nDOFM) + if (RegCheckErr(Buf, RoutineName)) return + ! SttcSolve + call RegUnpack(Buf, OutData%SttcSolve) + if (RegCheckErr(Buf, RoutineName)) return + ! GuyanLoadCorrection + call RegUnpack(Buf, OutData%GuyanLoadCorrection) + if (RegCheckErr(Buf, RoutineName)) return + ! Floating + call RegUnpack(Buf, OutData%Floating) + if (RegCheckErr(Buf, RoutineName)) return + ! KMMDiag + if (allocated(OutData%KMMDiag)) deallocate(OutData%KMMDiag) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%KMMDiag(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%KMMDiag.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%KMMDiag) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CMMDiag + if (allocated(OutData%CMMDiag)) deallocate(OutData%CMMDiag) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CMMDiag(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CMMDiag.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CMMDiag) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! MMB + if (allocated(OutData%MMB)) deallocate(OutData%MMB) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MMB(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MMB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MMB) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! MBmmB + if (allocated(OutData%MBmmB)) deallocate(OutData%MBmmB) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MBmmB(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBmmB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MBmmB) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! C1_11 + if (allocated(OutData%C1_11)) deallocate(OutData%C1_11) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%C1_11(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%C1_11.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%C1_11) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! C1_12 + if (allocated(OutData%C1_12)) deallocate(OutData%C1_12) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%C1_12(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%C1_12.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%C1_12) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! D1_141 + if (allocated(OutData%D1_141)) deallocate(OutData%D1_141) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%D1_141(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%D1_141.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%D1_141) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! D1_142 + if (allocated(OutData%D1_142)) deallocate(OutData%D1_142) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%D1_142(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%D1_142.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%D1_142) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PhiM + if (allocated(OutData%PhiM)) deallocate(OutData%PhiM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PhiM(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PhiM) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! C2_61 + if (allocated(OutData%C2_61)) deallocate(OutData%C2_61) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%C2_61(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%C2_61.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%C2_61) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! C2_62 + if (allocated(OutData%C2_62)) deallocate(OutData%C2_62) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%C2_62(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%C2_62.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%C2_62) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PhiRb_TI + if (allocated(OutData%PhiRb_TI)) deallocate(OutData%PhiRb_TI) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PhiRb_TI(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiRb_TI.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PhiRb_TI) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! D2_63 + if (allocated(OutData%D2_63)) deallocate(OutData%D2_63) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%D2_63(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%D2_63.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%D2_63) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! D2_64 + if (allocated(OutData%D2_64)) deallocate(OutData%D2_64) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%D2_64(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%D2_64.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%D2_64) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! MBB + if (allocated(OutData%MBB)) deallocate(OutData%MBB) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MBB(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MBB) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! KBB + if (allocated(OutData%KBB)) deallocate(OutData%KBB) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%KBB(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%KBB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%KBB) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CBB + if (allocated(OutData%CBB)) deallocate(OutData%CBB) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CBB(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CBB.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CBB) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! CMM + if (allocated(OutData%CMM)) deallocate(OutData%CMM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CMM(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CMM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CMM) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! MBM + if (allocated(OutData%MBM)) deallocate(OutData%MBM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MBM(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%MBM) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PhiL_T + if (allocated(OutData%PhiL_T)) deallocate(OutData%PhiL_T) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PhiL_T(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiL_T.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PhiL_T) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! PhiLInvOmgL2 + if (allocated(OutData%PhiLInvOmgL2)) deallocate(OutData%PhiLInvOmgL2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%PhiLInvOmgL2(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiLInvOmgL2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%PhiLInvOmgL2) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! KLLm1 + if (allocated(OutData%KLLm1)) deallocate(OutData%KLLm1) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%KLLm1(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%KLLm1.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%KLLm1) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AM2Jac + if (allocated(OutData%AM2Jac)) deallocate(OutData%AM2Jac) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AM2Jac(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AM2Jac.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AM2Jac) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! AM2JacPiv + if (allocated(OutData%AM2JacPiv)) deallocate(OutData%AM2JacPiv) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%AM2JacPiv(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AM2JacPiv.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%AM2JacPiv) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TI + if (allocated(OutData%TI)) deallocate(OutData%TI) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TI(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TI) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TIreact + if (allocated(OutData%TIreact)) deallocate(OutData%TIreact) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TIreact(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TIreact.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TIreact) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! nNodes + call RegUnpack(Buf, OutData%nNodes) + if (RegCheckErr(Buf, RoutineName)) return + ! nNodes_I + call RegUnpack(Buf, OutData%nNodes_I) + if (RegCheckErr(Buf, RoutineName)) return + ! nNodes_L + call RegUnpack(Buf, OutData%nNodes_L) + if (RegCheckErr(Buf, RoutineName)) return + ! nNodes_C + call RegUnpack(Buf, OutData%nNodes_C) + if (RegCheckErr(Buf, RoutineName)) return + ! Nodes_I + if (allocated(OutData%Nodes_I)) deallocate(OutData%Nodes_I) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Nodes_I(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nodes_I.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Nodes_I) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Nodes_L + if (allocated(OutData%Nodes_L)) deallocate(OutData%Nodes_L) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Nodes_L(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nodes_L.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Nodes_L) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Nodes_C + if (allocated(OutData%Nodes_C)) deallocate(OutData%Nodes_C) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Nodes_C(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nodes_C.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Nodes_C) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! nDOFI__ + call RegUnpack(Buf, OutData%nDOFI__) + if (RegCheckErr(Buf, RoutineName)) return + ! nDOFI_Rb + call RegUnpack(Buf, OutData%nDOFI_Rb) + if (RegCheckErr(Buf, RoutineName)) return + ! nDOFI_F + call RegUnpack(Buf, OutData%nDOFI_F) + if (RegCheckErr(Buf, RoutineName)) return + ! nDOFL_L + call RegUnpack(Buf, OutData%nDOFL_L) + if (RegCheckErr(Buf, RoutineName)) return + ! nDOFC__ + call RegUnpack(Buf, OutData%nDOFC__) + if (RegCheckErr(Buf, RoutineName)) return + ! nDOFC_Rb + call RegUnpack(Buf, OutData%nDOFC_Rb) + if (RegCheckErr(Buf, RoutineName)) return + ! nDOFC_L + call RegUnpack(Buf, OutData%nDOFC_L) + if (RegCheckErr(Buf, RoutineName)) return + ! nDOFC_F + call RegUnpack(Buf, OutData%nDOFC_F) + if (RegCheckErr(Buf, RoutineName)) return + ! nDOFR__ + call RegUnpack(Buf, OutData%nDOFR__) + if (RegCheckErr(Buf, RoutineName)) return + ! nDOF__Rb + call RegUnpack(Buf, OutData%nDOF__Rb) + if (RegCheckErr(Buf, RoutineName)) return + ! nDOF__L + call RegUnpack(Buf, OutData%nDOF__L) + if (RegCheckErr(Buf, RoutineName)) return + ! nDOF__F + call RegUnpack(Buf, OutData%nDOF__F) + if (RegCheckErr(Buf, RoutineName)) return + ! IDI__ + if (allocated(OutData%IDI__)) deallocate(OutData%IDI__) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IDI__(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDI__.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IDI__) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! IDI_Rb + if (allocated(OutData%IDI_Rb)) deallocate(OutData%IDI_Rb) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IDI_Rb(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDI_Rb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IDI_Rb) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! IDI_F + if (allocated(OutData%IDI_F)) deallocate(OutData%IDI_F) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IDI_F(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDI_F.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IDI_F) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! IDL_L + if (allocated(OutData%IDL_L)) deallocate(OutData%IDL_L) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IDL_L(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDL_L.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IDL_L) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! IDC__ + if (allocated(OutData%IDC__)) deallocate(OutData%IDC__) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IDC__(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDC__.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IDC__) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! IDC_Rb + if (allocated(OutData%IDC_Rb)) deallocate(OutData%IDC_Rb) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IDC_Rb(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDC_Rb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IDC_Rb) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! IDC_L + if (allocated(OutData%IDC_L)) deallocate(OutData%IDC_L) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IDC_L(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDC_L.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IDC_L) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! IDC_F + if (allocated(OutData%IDC_F)) deallocate(OutData%IDC_F) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IDC_F(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDC_F.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IDC_F) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! IDR__ + if (allocated(OutData%IDR__)) deallocate(OutData%IDR__) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IDR__(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDR__.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IDR__) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ID__Rb + if (allocated(OutData%ID__Rb)) deallocate(OutData%ID__Rb) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ID__Rb(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ID__Rb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ID__Rb) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ID__L + if (allocated(OutData%ID__L)) deallocate(OutData%ID__L) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ID__L(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ID__L.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ID__L) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! ID__F + if (allocated(OutData%ID__F)) deallocate(OutData%ID__F) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%ID__F(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ID__F.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%ID__F) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! NMOutputs + call RegUnpack(Buf, OutData%NMOutputs) + if (RegCheckErr(Buf, RoutineName)) return + ! NumOuts + call RegUnpack(Buf, OutData%NumOuts) + if (RegCheckErr(Buf, RoutineName)) return + ! OutSwtch + call RegUnpack(Buf, OutData%OutSwtch) + if (RegCheckErr(Buf, RoutineName)) return + ! UnJckF + call RegUnpack(Buf, OutData%UnJckF) + if (RegCheckErr(Buf, RoutineName)) return + ! Delim + call RegUnpack(Buf, OutData%Delim) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFmt + call RegUnpack(Buf, OutData%OutFmt) + if (RegCheckErr(Buf, RoutineName)) return + ! OutSFmt + call RegUnpack(Buf, OutData%OutSFmt) + if (RegCheckErr(Buf, RoutineName)) return + ! MoutLst + if (allocated(OutData%MoutLst)) deallocate(OutData%MoutLst) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MoutLst(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MoutLst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackMeshAuxDataType(Buf, OutData%MoutLst(i1)) ! MoutLst + end do + end if + ! MoutLst2 + if (allocated(OutData%MoutLst2)) deallocate(OutData%MoutLst2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MoutLst2(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MoutLst2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackMeshAuxDataType(Buf, OutData%MoutLst2(i1)) ! MoutLst2 + end do + end if + ! MoutLst3 + if (allocated(OutData%MoutLst3)) deallocate(OutData%MoutLst3) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%MoutLst3(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%MoutLst3.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackMeshAuxDataType(Buf, OutData%MoutLst3(i1)) ! MoutLst3 + end do + end if + ! OutParam + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam + end do + end if + ! OutAll + call RegUnpack(Buf, OutData%OutAll) + if (RegCheckErr(Buf, RoutineName)) return + ! OutCBModes + call RegUnpack(Buf, OutData%OutCBModes) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFEMModes + call RegUnpack(Buf, OutData%OutFEMModes) + if (RegCheckErr(Buf, RoutineName)) return + ! OutReact + call RegUnpack(Buf, OutData%OutReact) + if (RegCheckErr(Buf, RoutineName)) return + ! OutAllInt + call RegUnpack(Buf, OutData%OutAllInt) + if (RegCheckErr(Buf, RoutineName)) return + ! OutAllDims + call RegUnpack(Buf, OutData%OutAllDims) + if (RegCheckErr(Buf, RoutineName)) return + ! OutDec + call RegUnpack(Buf, OutData%OutDec) + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_u_indx + if (allocated(OutData%Jac_u_indx)) deallocate(OutData%Jac_u_indx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Jac_u_indx) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! du + if (allocated(OutData%du)) deallocate(OutData%du) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%du(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%du) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! dx + call RegUnpack(Buf, OutData%dx) + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_ny + call RegUnpack(Buf, OutData%Jac_ny) + if (RegCheckErr(Buf, RoutineName)) return + ! Jac_nx + call RegUnpack(Buf, OutData%Jac_nx) + if (RegCheckErr(Buf, RoutineName)) return + ! RotStates + call RegUnpack(Buf, OutData%RotStates) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE SD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(SD_InputType), INTENT(INOUT) :: SrcInputData TYPE(SD_InputType), INTENT(INOUT) :: DstInputData @@ -11876,308 +7126,55 @@ SUBROUTINE SD_DestroyInput( InputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE SD_DestroyInput - SUBROUTINE SD_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SD_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! TPMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%TPMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! TPMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! TPMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! TPMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! TPMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! LMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%LMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! LMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! LMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! LMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! LMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! CableDeltaL allocated yes/no - IF ( ALLOCATED(InData%CableDeltaL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CableDeltaL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CableDeltaL) ! CableDeltaL - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL MeshPack( InData%TPMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! TPMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MeshPack( InData%LMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! LMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%CableDeltaL) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CableDeltaL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CableDeltaL,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CableDeltaL,1), UBOUND(InData%CableDeltaL,1) - ReKiBuf(Re_Xferred) = InData%CableDeltaL(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_PackInput - - SUBROUTINE SD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SD_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%TPMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! TPMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%LMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! LMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CableDeltaL not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CableDeltaL)) DEALLOCATE(OutData%CableDeltaL) - ALLOCATE(OutData%CableDeltaL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableDeltaL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CableDeltaL,1), UBOUND(OutData%CableDeltaL,1) - OutData%CableDeltaL(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_UnPackInput +subroutine SD_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SD_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + ! TPMesh + call MeshPack(Buf, InData%TPMesh) + if (RegCheckErr(Buf, RoutineName)) return + ! LMesh + call MeshPack(Buf, InData%LMesh) + if (RegCheckErr(Buf, RoutineName)) return + ! CableDeltaL + call RegPack(Buf, allocated(InData%CableDeltaL)) + if (allocated(InData%CableDeltaL)) then + call RegPackBounds(Buf, 1, lbound(InData%CableDeltaL), ubound(InData%CableDeltaL)) + call RegPack(Buf, InData%CableDeltaL) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SD_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SD_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackInput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! TPMesh + call MeshUnpack(Buf, OutData%TPMesh) ! TPMesh + ! LMesh + call MeshUnpack(Buf, OutData%LMesh) ! LMesh + ! CableDeltaL + if (allocated(OutData%CableDeltaL)) deallocate(OutData%CableDeltaL) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%CableDeltaL(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableDeltaL.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%CableDeltaL) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE SD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(SD_OutputType), INTENT(INOUT) :: SrcOutputData TYPE(SD_OutputType), INTENT(INOUT) :: DstOutputData @@ -12240,393 +7237,60 @@ SUBROUTINE SD_DestroyOutput( OutputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE SD_DestroyOutput - SUBROUTINE SD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SD_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Y1Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%Y1Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! Y1Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Y1Mesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Y1Mesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Y1Mesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Y2Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%Y2Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! Y2Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Y2Mesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Y2Mesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Y2Mesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! Y3Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%Y3Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! Y3Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Y3Mesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Y3Mesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Y3Mesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutput allocated yes/no - IF ( ALLOCATED(InData%WriteOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutput upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WriteOutput) ! WriteOutput - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL MeshPack( InData%Y1Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! Y1Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MeshPack( InData%Y2Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! Y2Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL MeshPack( InData%Y3Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! Y3Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) - ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_PackOutput - - SUBROUTINE SD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SD_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%Y1Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! Y1Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%Y2Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! Y2Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MeshUnpack( OutData%Y3Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! Y3Mesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutput)) DEALLOCATE(OutData%WriteOutput) - ALLOCATE(OutData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) - OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SD_UnPackOutput +subroutine SD_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SD_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SD_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! Y1Mesh + call MeshPack(Buf, InData%Y1Mesh) + if (RegCheckErr(Buf, RoutineName)) return + ! Y2Mesh + call MeshPack(Buf, InData%Y2Mesh) + if (RegCheckErr(Buf, RoutineName)) return + ! Y3Mesh + call MeshPack(Buf, InData%Y3Mesh) + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutput + call RegPack(Buf, allocated(InData%WriteOutput)) + if (allocated(InData%WriteOutput)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) + call RegPack(Buf, InData%WriteOutput) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SD_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SD_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! Y1Mesh + call MeshUnpack(Buf, OutData%Y1Mesh) ! Y1Mesh + ! Y2Mesh + call MeshUnpack(Buf, OutData%Y2Mesh) ! Y2Mesh + ! Y3Mesh + call MeshUnpack(Buf, OutData%Y3Mesh) ! Y3Mesh + ! WriteOutput + if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutput(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutput) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE SD_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) ! diff --git a/modules/supercontroller/src/SCDataEx_Types.f90 b/modules/supercontroller/src/SCDataEx_Types.f90 index 399be0303f..4e899722f8 100644 --- a/modules/supercontroller/src/SCDataEx_Types.f90 +++ b/modules/supercontroller/src/SCDataEx_Types.f90 @@ -129,118 +129,45 @@ SUBROUTINE SC_DX_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) END SUBROUTINE SC_DX_DestroyInitInput - SUBROUTINE SC_DX_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SC_DX_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! NumSC2Ctrl - Int_BufSz = Int_BufSz + 1 ! NumSC2CtrlGlob - Int_BufSz = Int_BufSz + 1 ! NumCtrl2SC - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%NumSC2Ctrl - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumSC2CtrlGlob - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumCtrl2SC - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SC_DX_PackInitInput - - SUBROUTINE SC_DX_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SC_DX_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%NumSC2Ctrl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumSC2Ctrl = OutData%NumSC2Ctrl - OutData%NumSC2CtrlGlob = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumSC2CtrlGlob = OutData%NumSC2CtrlGlob - OutData%NumCtrl2SC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumCtrl2SC = OutData%NumCtrl2SC - END SUBROUTINE SC_DX_UnPackInitInput +subroutine SC_DX_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SC_DX_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SC_DX_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + ! NumSC2Ctrl + call RegPack(Buf, InData%NumSC2Ctrl) + if (RegCheckErr(Buf, RoutineName)) return + ! NumSC2CtrlGlob + call RegPack(Buf, InData%NumSC2CtrlGlob) + if (RegCheckErr(Buf, RoutineName)) return + ! NumCtrl2SC + call RegPack(Buf, InData%NumCtrl2SC) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SC_DX_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SC_DX_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SC_DX_UnPackInitInput' + if (Buf%ErrStat /= ErrID_None) return + ! NumSC2Ctrl + call RegUnpack(Buf, OutData%NumSC2Ctrl) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%NumSC2Ctrl = OutData%NumSC2Ctrl + ! NumSC2CtrlGlob + call RegUnpack(Buf, OutData%NumSC2CtrlGlob) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%NumSC2CtrlGlob = OutData%NumSC2CtrlGlob + ! NumCtrl2SC + call RegUnpack(Buf, OutData%NumCtrl2SC) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%NumCtrl2SC = OutData%NumCtrl2SC +end subroutine SUBROUTINE SC_DX_C2Fary_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) TYPE(SC_DX_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat @@ -317,186 +244,29 @@ SUBROUTINE SC_DX_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE SC_DX_DestroyInitOutput - SUBROUTINE SC_DX_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SC_DX_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE SC_DX_PackInitOutput - - SUBROUTINE SC_DX_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SC_DX_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE SC_DX_UnPackInitOutput +subroutine SC_DX_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SC_DX_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SC_DX_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + ! Ver + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SC_DX_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SC_DX_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SC_DX_UnPackInitOutput' + if (Buf%ErrStat /= ErrID_None) return + ! Ver + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver +end subroutine SUBROUTINE SC_DX_C2Fary_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) TYPE(SC_DX_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat @@ -564,106 +334,31 @@ SUBROUTINE SC_DX_DestroyParam( ParamData, ErrStat, ErrMsg ) END SUBROUTINE SC_DX_DestroyParam - SUBROUTINE SC_DX_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SC_DX_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! useSC - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = TRANSFER(InData%useSC, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SC_DX_PackParam - - SUBROUTINE SC_DX_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SC_DX_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%useSC = TRANSFER(IntKiBuf(Int_Xferred), OutData%useSC) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%useSC = OutData%useSC - END SUBROUTINE SC_DX_UnPackParam +subroutine SC_DX_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SC_DX_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SC_DX_PackParam' + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + ! useSC + call RegPack(Buf, InData%useSC) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SC_DX_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SC_DX_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SC_DX_UnPackParam' + if (Buf%ErrStat /= ErrID_None) return + ! useSC + call RegUnpack(Buf, OutData%useSC) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%useSC = OutData%useSC +end subroutine SUBROUTINE SC_DX_C2Fary_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) TYPE(SC_DX_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat @@ -753,142 +448,67 @@ SUBROUTINE SC_DX_DestroyInput( InputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE SC_DX_DestroyInput - SUBROUTINE SC_DX_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SC_DX_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! toSC allocated yes/no - IF ( ASSOCIATED(InData%toSC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! toSC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%toSC) ! toSC - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ASSOCIATED(InData%toSC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%toSC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%toSC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%toSC,1), UBOUND(InData%toSC,1) - ReKiBuf(Re_Xferred) = InData%toSC(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SC_DX_PackInput - - SUBROUTINE SC_DX_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SC_DX_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! toSC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%toSC)) DEALLOCATE(OutData%toSC) - ALLOCATE(OutData%toSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%toSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%toSC_Len = SIZE(OutData%toSC) - IF (OutData%C_obj%toSC_Len > 0) & - OutData%C_obj%toSC = C_LOC( OutData%toSC( i1_l ) ) - DO i1 = LBOUND(OutData%toSC,1), UBOUND(OutData%toSC,1) - OutData%toSC(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SC_DX_UnPackInput +subroutine SC_DX_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SC_DX_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SC_DX_PackInput' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + ! toSC + call RegPack(Buf, associated(InData%toSC)) + if (associated(InData%toSC)) then + call RegPackBounds(Buf, 1, lbound(InData%toSC), ubound(InData%toSC)) + call RegPackPointer(Buf, c_loc(InData%toSC), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%toSC) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SC_DX_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SC_DX_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SC_DX_UnPackInput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + ! toSC + if (associated(OutData%toSC)) deallocate(OutData%toSC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%toSC, UB(1:1)-LB(1:1)) + OutData%toSC(LB(1):) => OutData%toSC + else + allocate(OutData%toSC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%toSC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%toSC) + OutData%C_obj%toSC_Len = size(OutData%toSC) + if (OutData%C_obj%toSC_Len > 0) OutData%C_obj%toSC = c_loc(OutData%toSC(LB(1))) + call RegUnpack(Buf, OutData%toSC) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%toSC => null() + end if +end subroutine SUBROUTINE SC_DX_C2Fary_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) TYPE(SC_DX_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat @@ -1018,183 +638,104 @@ SUBROUTINE SC_DX_DestroyOutput( OutputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE SC_DX_DestroyOutput - SUBROUTINE SC_DX_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SC_DX_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! fromSC allocated yes/no - IF ( ASSOCIATED(InData%fromSC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! fromSC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fromSC) ! fromSC - END IF - Int_BufSz = Int_BufSz + 1 ! fromSCglob allocated yes/no - IF ( ASSOCIATED(InData%fromSCglob) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! fromSCglob upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fromSCglob) ! fromSCglob - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ASSOCIATED(InData%fromSC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fromSC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fromSC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%fromSC,1), UBOUND(InData%fromSC,1) - ReKiBuf(Re_Xferred) = InData%fromSC(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%fromSCglob) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fromSCglob,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fromSCglob,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%fromSCglob,1), UBOUND(InData%fromSCglob,1) - ReKiBuf(Re_Xferred) = InData%fromSCglob(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SC_DX_PackOutput - - SUBROUTINE SC_DX_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SC_DX_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fromSC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%fromSC)) DEALLOCATE(OutData%fromSC) - ALLOCATE(OutData%fromSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%fromSC_Len = SIZE(OutData%fromSC) - IF (OutData%C_obj%fromSC_Len > 0) & - OutData%C_obj%fromSC = C_LOC( OutData%fromSC( i1_l ) ) - DO i1 = LBOUND(OutData%fromSC,1), UBOUND(OutData%fromSC,1) - OutData%fromSC(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fromSCglob not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%fromSCglob)) DEALLOCATE(OutData%fromSCglob) - ALLOCATE(OutData%fromSCglob(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSCglob.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%fromSCglob_Len = SIZE(OutData%fromSCglob) - IF (OutData%C_obj%fromSCglob_Len > 0) & - OutData%C_obj%fromSCglob = C_LOC( OutData%fromSCglob( i1_l ) ) - DO i1 = LBOUND(OutData%fromSCglob,1), UBOUND(OutData%fromSCglob,1) - OutData%fromSCglob(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SC_DX_UnPackOutput +subroutine SC_DX_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SC_DX_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SC_DX_PackOutput' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + ! fromSC + call RegPack(Buf, associated(InData%fromSC)) + if (associated(InData%fromSC)) then + call RegPackBounds(Buf, 1, lbound(InData%fromSC), ubound(InData%fromSC)) + call RegPackPointer(Buf, c_loc(InData%fromSC), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%fromSC) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! fromSCglob + call RegPack(Buf, associated(InData%fromSCglob)) + if (associated(InData%fromSCglob)) then + call RegPackBounds(Buf, 1, lbound(InData%fromSCglob), ubound(InData%fromSCglob)) + call RegPackPointer(Buf, c_loc(InData%fromSCglob), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%fromSCglob) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SC_DX_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SC_DX_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SC_DX_UnPackOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + ! fromSC + if (associated(OutData%fromSC)) deallocate(OutData%fromSC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%fromSC, UB(1:1)-LB(1:1)) + OutData%fromSC(LB(1):) => OutData%fromSC + else + allocate(OutData%fromSC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%fromSC) + OutData%C_obj%fromSC_Len = size(OutData%fromSC) + if (OutData%C_obj%fromSC_Len > 0) OutData%C_obj%fromSC = c_loc(OutData%fromSC(LB(1))) + call RegUnpack(Buf, OutData%fromSC) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%fromSC => null() + end if + ! fromSCglob + if (associated(OutData%fromSCglob)) deallocate(OutData%fromSCglob) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%fromSCglob, UB(1:1)-LB(1:1)) + OutData%fromSCglob(LB(1):) => OutData%fromSCglob + else + allocate(OutData%fromSCglob(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSCglob.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%fromSCglob) + OutData%C_obj%fromSCglob_Len = size(OutData%fromSCglob) + if (OutData%C_obj%fromSCglob_Len > 0) OutData%C_obj%fromSCglob = c_loc(OutData%fromSCglob(LB(1))) + call RegUnpack(Buf, OutData%fromSCglob) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%fromSCglob => null() + end if +end subroutine SUBROUTINE SC_DX_C2Fary_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) TYPE(SC_DX_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat diff --git a/modules/supercontroller/src/SuperController_Types.f90 b/modules/supercontroller/src/SuperController_Types.f90 index 531045da1b..1b7ea329ce 100644 --- a/modules/supercontroller/src/SuperController_Types.f90 +++ b/modules/supercontroller/src/SuperController_Types.f90 @@ -215,116 +215,38 @@ SUBROUTINE SC_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) END SUBROUTINE SC_DestroyInitInput - SUBROUTINE SC_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SC_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! nTurbines - Int_BufSz = Int_BufSz + 1*LEN(InData%DLL_FileName) ! DLL_FileName - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%nTurbines - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%DLL_FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE SC_PackInitInput - - SUBROUTINE SC_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SC_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%nTurbines = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%nTurbines = OutData%nTurbines - DO I = 1, LEN(OutData%DLL_FileName) - OutData%DLL_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%C_obj%DLL_FileName = TRANSFER(OutData%DLL_FileName, OutData%C_obj%DLL_FileName ) - END SUBROUTINE SC_UnPackInitInput +subroutine SC_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SC_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SC_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + ! nTurbines + call RegPack(Buf, InData%nTurbines) + if (RegCheckErr(Buf, RoutineName)) return + ! DLL_FileName + call RegPack(Buf, InData%DLL_FileName) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SC_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SC_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SC_UnPackInitInput' + if (Buf%ErrStat /= ErrID_None) return + ! nTurbines + call RegUnpack(Buf, OutData%nTurbines) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%nTurbines = OutData%nTurbines + ! DLL_FileName + call RegUnpack(Buf, OutData%DLL_FileName) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%DLL_FileName = transfer(OutData%DLL_FileName, OutData%C_obj%DLL_FileName ) +end subroutine SUBROUTINE SC_C2Fary_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) TYPE(SC_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat @@ -407,210 +329,57 @@ SUBROUTINE SC_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE SC_DestroyInitOutput - SUBROUTINE SC_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SC_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! NumCtrl2SC - Int_BufSz = Int_BufSz + 1 ! nInpGlobal - Int_BufSz = Int_BufSz + 1 ! NumSC2Ctrl - Int_BufSz = Int_BufSz + 1 ! NumSC2CtrlGlob - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-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%NumCtrl2SC - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nInpGlobal - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumSC2Ctrl - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumSC2CtrlGlob - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SC_PackInitOutput - - SUBROUTINE SC_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SC_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%NumCtrl2SC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumCtrl2SC = OutData%NumCtrl2SC - OutData%nInpGlobal = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%nInpGlobal = OutData%nInpGlobal - OutData%NumSC2Ctrl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumSC2Ctrl = OutData%NumSC2Ctrl - OutData%NumSC2CtrlGlob = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumSC2CtrlGlob = OutData%NumSC2CtrlGlob - END SUBROUTINE SC_UnPackInitOutput +subroutine SC_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SC_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SC_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + ! Ver + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + if (RegCheckErr(Buf, RoutineName)) return + ! NumCtrl2SC + call RegPack(Buf, InData%NumCtrl2SC) + if (RegCheckErr(Buf, RoutineName)) return + ! nInpGlobal + call RegPack(Buf, InData%nInpGlobal) + if (RegCheckErr(Buf, RoutineName)) return + ! NumSC2Ctrl + call RegPack(Buf, InData%NumSC2Ctrl) + if (RegCheckErr(Buf, RoutineName)) return + ! NumSC2CtrlGlob + call RegPack(Buf, InData%NumSC2CtrlGlob) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SC_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SC_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SC_UnPackInitOutput' + if (Buf%ErrStat /= ErrID_None) return + ! Ver + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver + ! NumCtrl2SC + call RegUnpack(Buf, OutData%NumCtrl2SC) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%NumCtrl2SC = OutData%NumCtrl2SC + ! nInpGlobal + call RegUnpack(Buf, OutData%nInpGlobal) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%nInpGlobal = OutData%nInpGlobal + ! NumSC2Ctrl + call RegUnpack(Buf, OutData%NumSC2Ctrl) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%NumSC2Ctrl = OutData%NumSC2Ctrl + ! NumSC2CtrlGlob + call RegUnpack(Buf, OutData%NumSC2CtrlGlob) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%NumSC2CtrlGlob = OutData%NumSC2CtrlGlob +end subroutine SUBROUTINE SC_C2Fary_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) TYPE(SC_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat @@ -750,329 +519,179 @@ SUBROUTINE SC_DestroyParam( ParamData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE SC_DestroyParam - SUBROUTINE SC_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SC_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! DT - Int_BufSz = Int_BufSz + 1 ! nTurbines - Int_BufSz = Int_BufSz + 1 ! NumCtrl2SC - Int_BufSz = Int_BufSz + 1 ! nInpGlobal - Int_BufSz = Int_BufSz + 1 ! NumSC2Ctrl - Int_BufSz = Int_BufSz + 1 ! NumSC2CtrlGlob - Int_BufSz = Int_BufSz + 1 ! NumStatesGlobal - Int_BufSz = Int_BufSz + 1 ! NumStatesTurbine - Int_BufSz = Int_BufSz + 1 ! NumParamGlobal - Int_BufSz = Int_BufSz + 1 ! NumParamTurbine - Int_BufSz = Int_BufSz + 1 ! ParamGlobal allocated yes/no - IF ( ASSOCIATED(InData%ParamGlobal) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ParamGlobal upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ParamGlobal) ! ParamGlobal - END IF - Int_BufSz = Int_BufSz + 1 ! ParamTurbine allocated yes/no - IF ( ASSOCIATED(InData%ParamTurbine) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ParamTurbine upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ParamTurbine) ! ParamTurbine - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! DLL_Trgt: size of buffers for each call to pack subtype - CALL DLLTypePack( InData%DLL_Trgt, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! DLL_Trgt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! DLL_Trgt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! DLL_Trgt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! DLL_Trgt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nTurbines - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumCtrl2SC - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nInpGlobal - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumSC2Ctrl - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumSC2CtrlGlob - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumStatesGlobal - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumStatesTurbine - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumParamGlobal - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumParamTurbine - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ASSOCIATED(InData%ParamGlobal) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ParamGlobal,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ParamGlobal,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ParamGlobal,1), UBOUND(InData%ParamGlobal,1) - ReKiBuf(Re_Xferred) = InData%ParamGlobal(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%ParamTurbine) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ParamTurbine,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ParamTurbine,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ParamTurbine,1), UBOUND(InData%ParamTurbine,1) - ReKiBuf(Re_Xferred) = InData%ParamTurbine(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - CALL DLLTypePack( InData%DLL_Trgt, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! DLL_Trgt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE SC_PackParam - - SUBROUTINE SC_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SC_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%C_obj%DT = OutData%DT - OutData%nTurbines = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%nTurbines = OutData%nTurbines - OutData%NumCtrl2SC = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumCtrl2SC = OutData%NumCtrl2SC - OutData%nInpGlobal = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%nInpGlobal = OutData%nInpGlobal - OutData%NumSC2Ctrl = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumSC2Ctrl = OutData%NumSC2Ctrl - OutData%NumSC2CtrlGlob = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumSC2CtrlGlob = OutData%NumSC2CtrlGlob - OutData%NumStatesGlobal = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumStatesGlobal = OutData%NumStatesGlobal - OutData%NumStatesTurbine = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumStatesTurbine = OutData%NumStatesTurbine - OutData%NumParamGlobal = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumParamGlobal = OutData%NumParamGlobal - OutData%NumParamTurbine = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%NumParamTurbine = OutData%NumParamTurbine - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ParamGlobal not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%ParamGlobal)) DEALLOCATE(OutData%ParamGlobal) - ALLOCATE(OutData%ParamGlobal(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ParamGlobal.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%ParamGlobal_Len = SIZE(OutData%ParamGlobal) - IF (OutData%C_obj%ParamGlobal_Len > 0) & - OutData%C_obj%ParamGlobal = C_LOC( OutData%ParamGlobal( i1_l ) ) - DO i1 = LBOUND(OutData%ParamGlobal,1), UBOUND(OutData%ParamGlobal,1) - OutData%ParamGlobal(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ParamTurbine not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%ParamTurbine)) DEALLOCATE(OutData%ParamTurbine) - ALLOCATE(OutData%ParamTurbine(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ParamTurbine.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%ParamTurbine_Len = SIZE(OutData%ParamTurbine) - IF (OutData%C_obj%ParamTurbine_Len > 0) & - OutData%C_obj%ParamTurbine = C_LOC( OutData%ParamTurbine( i1_l ) ) - DO i1 = LBOUND(OutData%ParamTurbine,1), UBOUND(OutData%ParamTurbine,1) - OutData%ParamTurbine(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL DLLTypeUnpack( OutData%DLL_Trgt, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! DLL_Trgt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE SC_UnPackParam +subroutine SC_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SC_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SC_PackParam' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + ! DT + call RegPack(Buf, InData%DT) + if (RegCheckErr(Buf, RoutineName)) return + ! nTurbines + call RegPack(Buf, InData%nTurbines) + if (RegCheckErr(Buf, RoutineName)) return + ! NumCtrl2SC + call RegPack(Buf, InData%NumCtrl2SC) + if (RegCheckErr(Buf, RoutineName)) return + ! nInpGlobal + call RegPack(Buf, InData%nInpGlobal) + if (RegCheckErr(Buf, RoutineName)) return + ! NumSC2Ctrl + call RegPack(Buf, InData%NumSC2Ctrl) + if (RegCheckErr(Buf, RoutineName)) return + ! NumSC2CtrlGlob + call RegPack(Buf, InData%NumSC2CtrlGlob) + if (RegCheckErr(Buf, RoutineName)) return + ! NumStatesGlobal + call RegPack(Buf, InData%NumStatesGlobal) + if (RegCheckErr(Buf, RoutineName)) return + ! NumStatesTurbine + call RegPack(Buf, InData%NumStatesTurbine) + if (RegCheckErr(Buf, RoutineName)) return + ! NumParamGlobal + call RegPack(Buf, InData%NumParamGlobal) + if (RegCheckErr(Buf, RoutineName)) return + ! NumParamTurbine + call RegPack(Buf, InData%NumParamTurbine) + if (RegCheckErr(Buf, RoutineName)) return + ! ParamGlobal + call RegPack(Buf, associated(InData%ParamGlobal)) + if (associated(InData%ParamGlobal)) then + call RegPackBounds(Buf, 1, lbound(InData%ParamGlobal), ubound(InData%ParamGlobal)) + call RegPackPointer(Buf, c_loc(InData%ParamGlobal), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%ParamGlobal) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! ParamTurbine + call RegPack(Buf, associated(InData%ParamTurbine)) + if (associated(InData%ParamTurbine)) then + call RegPackBounds(Buf, 1, lbound(InData%ParamTurbine), ubound(InData%ParamTurbine)) + call RegPackPointer(Buf, c_loc(InData%ParamTurbine), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%ParamTurbine) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! DLL_Trgt + call DLLTypePack(Buf, InData%DLL_Trgt) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SC_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SC_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SC_UnPackParam' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + ! DT + call RegUnpack(Buf, OutData%DT) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%DT = OutData%DT + ! nTurbines + call RegUnpack(Buf, OutData%nTurbines) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%nTurbines = OutData%nTurbines + ! NumCtrl2SC + call RegUnpack(Buf, OutData%NumCtrl2SC) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%NumCtrl2SC = OutData%NumCtrl2SC + ! nInpGlobal + call RegUnpack(Buf, OutData%nInpGlobal) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%nInpGlobal = OutData%nInpGlobal + ! NumSC2Ctrl + call RegUnpack(Buf, OutData%NumSC2Ctrl) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%NumSC2Ctrl = OutData%NumSC2Ctrl + ! NumSC2CtrlGlob + call RegUnpack(Buf, OutData%NumSC2CtrlGlob) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%NumSC2CtrlGlob = OutData%NumSC2CtrlGlob + ! NumStatesGlobal + call RegUnpack(Buf, OutData%NumStatesGlobal) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%NumStatesGlobal = OutData%NumStatesGlobal + ! NumStatesTurbine + call RegUnpack(Buf, OutData%NumStatesTurbine) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%NumStatesTurbine = OutData%NumStatesTurbine + ! NumParamGlobal + call RegUnpack(Buf, OutData%NumParamGlobal) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%NumParamGlobal = OutData%NumParamGlobal + ! NumParamTurbine + call RegUnpack(Buf, OutData%NumParamTurbine) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%NumParamTurbine = OutData%NumParamTurbine + ! ParamGlobal + if (associated(OutData%ParamGlobal)) deallocate(OutData%ParamGlobal) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%ParamGlobal, UB(1:1)-LB(1:1)) + OutData%ParamGlobal(LB(1):) => OutData%ParamGlobal + else + allocate(OutData%ParamGlobal(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ParamGlobal.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%ParamGlobal) + OutData%C_obj%ParamGlobal_Len = size(OutData%ParamGlobal) + if (OutData%C_obj%ParamGlobal_Len > 0) OutData%C_obj%ParamGlobal = c_loc(OutData%ParamGlobal(LB(1))) + call RegUnpack(Buf, OutData%ParamGlobal) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%ParamGlobal => null() + end if + ! ParamTurbine + if (associated(OutData%ParamTurbine)) deallocate(OutData%ParamTurbine) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%ParamTurbine, UB(1:1)-LB(1:1)) + OutData%ParamTurbine(LB(1):) => OutData%ParamTurbine + else + allocate(OutData%ParamTurbine(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ParamTurbine.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%ParamTurbine) + OutData%C_obj%ParamTurbine_Len = size(OutData%ParamTurbine) + if (OutData%C_obj%ParamTurbine_Len > 0) OutData%C_obj%ParamTurbine = c_loc(OutData%ParamTurbine(LB(1))) + call RegUnpack(Buf, OutData%ParamTurbine) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%ParamTurbine => null() + end if + ! DLL_Trgt + call DLLTypeUnpack(Buf, OutData%DLL_Trgt) ! DLL_Trgt +end subroutine SUBROUTINE SC_C2Fary_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) TYPE(SC_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat @@ -1243,183 +862,104 @@ SUBROUTINE SC_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE SC_DestroyDiscState - SUBROUTINE SC_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SC_DiscreteStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_PackDiscState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! Global allocated yes/no - IF ( ASSOCIATED(InData%Global) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Global upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Global) ! Global - END IF - Int_BufSz = Int_BufSz + 1 ! Turbine allocated yes/no - IF ( ASSOCIATED(InData%Turbine) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Turbine upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Turbine) ! Turbine - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ASSOCIATED(InData%Global) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Global,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Global,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Global,1), UBOUND(InData%Global,1) - ReKiBuf(Re_Xferred) = InData%Global(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%Turbine) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Turbine,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Turbine,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Turbine,1), UBOUND(InData%Turbine,1) - ReKiBuf(Re_Xferred) = InData%Turbine(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SC_PackDiscState - - SUBROUTINE SC_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SC_DiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_UnPackDiscState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Global not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%Global)) DEALLOCATE(OutData%Global) - ALLOCATE(OutData%Global(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Global.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%Global_Len = SIZE(OutData%Global) - IF (OutData%C_obj%Global_Len > 0) & - OutData%C_obj%Global = C_LOC( OutData%Global( i1_l ) ) - DO i1 = LBOUND(OutData%Global,1), UBOUND(OutData%Global,1) - OutData%Global(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Turbine not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%Turbine)) DEALLOCATE(OutData%Turbine) - ALLOCATE(OutData%Turbine(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Turbine.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%Turbine_Len = SIZE(OutData%Turbine) - IF (OutData%C_obj%Turbine_Len > 0) & - OutData%C_obj%Turbine = C_LOC( OutData%Turbine( i1_l ) ) - DO i1 = LBOUND(OutData%Turbine,1), UBOUND(OutData%Turbine,1) - OutData%Turbine(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SC_UnPackDiscState +subroutine SC_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SC_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SC_PackDiscState' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + ! Global + call RegPack(Buf, associated(InData%Global)) + if (associated(InData%Global)) then + call RegPackBounds(Buf, 1, lbound(InData%Global), ubound(InData%Global)) + call RegPackPointer(Buf, c_loc(InData%Global), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%Global) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Turbine + call RegPack(Buf, associated(InData%Turbine)) + if (associated(InData%Turbine)) then + call RegPackBounds(Buf, 1, lbound(InData%Turbine), ubound(InData%Turbine)) + call RegPackPointer(Buf, c_loc(InData%Turbine), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%Turbine) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SC_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SC_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SC_UnPackDiscState' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + ! Global + if (associated(OutData%Global)) deallocate(OutData%Global) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Global, UB(1:1)-LB(1:1)) + OutData%Global(LB(1):) => OutData%Global + else + allocate(OutData%Global(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Global.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Global) + OutData%C_obj%Global_Len = size(OutData%Global) + if (OutData%C_obj%Global_Len > 0) OutData%C_obj%Global = c_loc(OutData%Global(LB(1))) + call RegUnpack(Buf, OutData%Global) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%Global => null() + end if + ! Turbine + if (associated(OutData%Turbine)) deallocate(OutData%Turbine) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%Turbine, UB(1:1)-LB(1:1)) + OutData%Turbine(LB(1):) => OutData%Turbine + else + allocate(OutData%Turbine(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Turbine.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%Turbine) + OutData%C_obj%Turbine_Len = size(OutData%Turbine) + if (OutData%C_obj%Turbine_Len > 0) OutData%C_obj%Turbine = c_loc(OutData%Turbine(LB(1))) + call RegUnpack(Buf, OutData%Turbine) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%Turbine => null() + end if +end subroutine SUBROUTINE SC_C2Fary_CopyDiscState( DiscStateData, ErrStat, ErrMsg, SkipPointers ) TYPE(SC_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat @@ -1529,106 +1069,31 @@ SUBROUTINE SC_DestroyContState( ContStateData, ErrStat, ErrMsg ) END SUBROUTINE SC_DestroyContState - SUBROUTINE SC_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SC_ContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_PackContState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! Dummy - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%Dummy - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SC_PackContState - - SUBROUTINE SC_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SC_ContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_UnPackContState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%Dummy = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%C_obj%Dummy = OutData%Dummy - END SUBROUTINE SC_UnPackContState +subroutine SC_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SC_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SC_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + ! Dummy + call RegPack(Buf, InData%Dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SC_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SC_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SC_UnPackContState' + if (Buf%ErrStat /= ErrID_None) return + ! Dummy + call RegUnpack(Buf, OutData%Dummy) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%Dummy = OutData%Dummy +end subroutine SUBROUTINE SC_C2Fary_CopyContState( ContStateData, ErrStat, ErrMsg, SkipPointers ) TYPE(SC_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat @@ -1698,106 +1163,31 @@ SUBROUTINE SC_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) END SUBROUTINE SC_DestroyConstrState - SUBROUTINE SC_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SC_ConstraintStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_PackConstrState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! Dummy - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%Dummy - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SC_PackConstrState - - SUBROUTINE SC_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SC_ConstraintStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_UnPackConstrState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%Dummy = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%C_obj%Dummy = OutData%Dummy - END SUBROUTINE SC_UnPackConstrState +subroutine SC_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SC_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SC_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + ! Dummy + call RegPack(Buf, InData%Dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SC_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SC_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SC_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + ! Dummy + call RegUnpack(Buf, OutData%Dummy) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%Dummy = OutData%Dummy +end subroutine SUBROUTINE SC_C2Fary_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointers ) TYPE(SC_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat @@ -1867,106 +1257,31 @@ SUBROUTINE SC_DestroyMisc( MiscData, ErrStat, ErrMsg ) END SUBROUTINE SC_DestroyMisc - SUBROUTINE SC_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SC_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! Dummy - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%Dummy - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE SC_PackMisc - - SUBROUTINE SC_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SC_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%Dummy = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%C_obj%Dummy = OutData%Dummy - END SUBROUTINE SC_UnPackMisc +subroutine SC_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SC_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SC_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + ! Dummy + call RegPack(Buf, InData%Dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SC_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SC_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SC_UnPackMisc' + if (Buf%ErrStat /= ErrID_None) return + ! Dummy + call RegUnpack(Buf, OutData%Dummy) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%Dummy = OutData%Dummy +end subroutine SUBROUTINE SC_C2Fary_CopyMisc( MiscData, ErrStat, ErrMsg, SkipPointers ) TYPE(SC_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat @@ -2036,106 +1351,31 @@ SUBROUTINE SC_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) END SUBROUTINE SC_DestroyOtherState - SUBROUTINE SC_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SC_OtherStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_PackOtherState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! Dummy - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%Dummy - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE SC_PackOtherState - - SUBROUTINE SC_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SC_OtherStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_UnPackOtherState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%Dummy = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_obj%Dummy = OutData%Dummy - END SUBROUTINE SC_UnPackOtherState +subroutine SC_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SC_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SC_PackOtherState' + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + ! Dummy + call RegPack(Buf, InData%Dummy) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SC_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SC_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SC_UnPackOtherState' + if (Buf%ErrStat /= ErrID_None) return + ! Dummy + call RegUnpack(Buf, OutData%Dummy) + if (RegCheckErr(Buf, RoutineName)) return + OutData%C_obj%Dummy = OutData%Dummy +end subroutine SUBROUTINE SC_C2Fary_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ) TYPE(SC_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat @@ -2246,183 +1486,104 @@ SUBROUTINE SC_DestroyInput( InputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE SC_DestroyInput - SUBROUTINE SC_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SC_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! toSCglob allocated yes/no - IF ( ASSOCIATED(InData%toSCglob) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! toSCglob upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%toSCglob) ! toSCglob - END IF - Int_BufSz = Int_BufSz + 1 ! toSC allocated yes/no - IF ( ASSOCIATED(InData%toSC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! toSC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%toSC) ! toSC - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ASSOCIATED(InData%toSCglob) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%toSCglob,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%toSCglob,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%toSCglob,1), UBOUND(InData%toSCglob,1) - ReKiBuf(Re_Xferred) = InData%toSCglob(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%toSC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%toSC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%toSC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%toSC,1), UBOUND(InData%toSC,1) - ReKiBuf(Re_Xferred) = InData%toSC(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SC_PackInput - - SUBROUTINE SC_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SC_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! toSCglob not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%toSCglob)) DEALLOCATE(OutData%toSCglob) - ALLOCATE(OutData%toSCglob(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%toSCglob.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%toSCglob_Len = SIZE(OutData%toSCglob) - IF (OutData%C_obj%toSCglob_Len > 0) & - OutData%C_obj%toSCglob = C_LOC( OutData%toSCglob( i1_l ) ) - DO i1 = LBOUND(OutData%toSCglob,1), UBOUND(OutData%toSCglob,1) - OutData%toSCglob(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! toSC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%toSC)) DEALLOCATE(OutData%toSC) - ALLOCATE(OutData%toSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%toSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%toSC_Len = SIZE(OutData%toSC) - IF (OutData%C_obj%toSC_Len > 0) & - OutData%C_obj%toSC = C_LOC( OutData%toSC( i1_l ) ) - DO i1 = LBOUND(OutData%toSC,1), UBOUND(OutData%toSC,1) - OutData%toSC(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SC_UnPackInput +subroutine SC_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SC_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SC_PackInput' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + ! toSCglob + call RegPack(Buf, associated(InData%toSCglob)) + if (associated(InData%toSCglob)) then + call RegPackBounds(Buf, 1, lbound(InData%toSCglob), ubound(InData%toSCglob)) + call RegPackPointer(Buf, c_loc(InData%toSCglob), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%toSCglob) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! toSC + call RegPack(Buf, associated(InData%toSC)) + if (associated(InData%toSC)) then + call RegPackBounds(Buf, 1, lbound(InData%toSC), ubound(InData%toSC)) + call RegPackPointer(Buf, c_loc(InData%toSC), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%toSC) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SC_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SC_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SC_UnPackInput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + ! toSCglob + if (associated(OutData%toSCglob)) deallocate(OutData%toSCglob) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%toSCglob, UB(1:1)-LB(1:1)) + OutData%toSCglob(LB(1):) => OutData%toSCglob + else + allocate(OutData%toSCglob(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%toSCglob.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%toSCglob) + OutData%C_obj%toSCglob_Len = size(OutData%toSCglob) + if (OutData%C_obj%toSCglob_Len > 0) OutData%C_obj%toSCglob = c_loc(OutData%toSCglob(LB(1))) + call RegUnpack(Buf, OutData%toSCglob) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%toSCglob => null() + end if + ! toSC + if (associated(OutData%toSC)) deallocate(OutData%toSC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%toSC, UB(1:1)-LB(1:1)) + OutData%toSC(LB(1):) => OutData%toSC + else + allocate(OutData%toSC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%toSC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%toSC) + OutData%C_obj%toSC_Len = size(OutData%toSC) + if (OutData%C_obj%toSC_Len > 0) OutData%C_obj%toSC = c_loc(OutData%toSC(LB(1))) + call RegUnpack(Buf, OutData%toSC) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%toSC => null() + end if +end subroutine SUBROUTINE SC_C2Fary_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) TYPE(SC_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat @@ -2573,183 +1734,104 @@ SUBROUTINE SC_DestroyOutput( OutputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE SC_DestroyOutput - SUBROUTINE SC_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SC_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! fromSCglob allocated yes/no - IF ( ASSOCIATED(InData%fromSCglob) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! fromSCglob upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fromSCglob) ! fromSCglob - END IF - Int_BufSz = Int_BufSz + 1 ! fromSC allocated yes/no - IF ( ASSOCIATED(InData%fromSC) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! fromSC upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%fromSC) ! fromSC - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - IF (C_ASSOCIATED(InData%C_obj%object)) CALL SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.',ErrStat,ErrMsg,RoutineName) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ASSOCIATED(InData%fromSCglob) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fromSCglob,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fromSCglob,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%fromSCglob,1), UBOUND(InData%fromSCglob,1) - ReKiBuf(Re_Xferred) = InData%fromSCglob(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ASSOCIATED(InData%fromSC) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%fromSC,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fromSC,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%fromSC,1), UBOUND(InData%fromSC,1) - ReKiBuf(Re_Xferred) = InData%fromSC(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SC_PackOutput - - SUBROUTINE SC_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SC_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fromSCglob not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%fromSCglob)) DEALLOCATE(OutData%fromSCglob) - ALLOCATE(OutData%fromSCglob(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSCglob.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%fromSCglob_Len = SIZE(OutData%fromSCglob) - IF (OutData%C_obj%fromSCglob_Len > 0) & - OutData%C_obj%fromSCglob = C_LOC( OutData%fromSCglob( i1_l ) ) - DO i1 = LBOUND(OutData%fromSCglob,1), UBOUND(OutData%fromSCglob,1) - OutData%fromSCglob(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fromSC not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ASSOCIATED(OutData%fromSC)) DEALLOCATE(OutData%fromSC) - ALLOCATE(OutData%fromSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - OutData%C_obj%fromSC_Len = SIZE(OutData%fromSC) - IF (OutData%C_obj%fromSC_Len > 0) & - OutData%C_obj%fromSC = C_LOC( OutData%fromSC( i1_l ) ) - DO i1 = LBOUND(OutData%fromSC,1), UBOUND(OutData%fromSC,1) - OutData%fromSC(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE SC_UnPackOutput +subroutine SC_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SC_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SC_PackOutput' + logical :: PtrInIndex + if (Buf%ErrStat >= AbortErrLev) return + if (c_associated(InData%C_obj%object)) then + call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + ! fromSCglob + call RegPack(Buf, associated(InData%fromSCglob)) + if (associated(InData%fromSCglob)) then + call RegPackBounds(Buf, 1, lbound(InData%fromSCglob), ubound(InData%fromSCglob)) + call RegPackPointer(Buf, c_loc(InData%fromSCglob), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%fromSCglob) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return + ! fromSC + call RegPack(Buf, associated(InData%fromSC)) + if (associated(InData%fromSC)) then + call RegPackBounds(Buf, 1, lbound(InData%fromSC), ubound(InData%fromSC)) + call RegPackPointer(Buf, c_loc(InData%fromSC), PtrInIndex) + if (.not. PtrInIndex) then + call RegPack(Buf, InData%fromSC) + end if + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine SC_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SC_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SC_UnPackOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + integer(IntKi) :: PtrIdx + type(c_ptr) :: Ptr + if (Buf%ErrStat /= ErrID_None) return + ! fromSCglob + if (associated(OutData%fromSCglob)) deallocate(OutData%fromSCglob) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%fromSCglob, UB(1:1)-LB(1:1)) + OutData%fromSCglob(LB(1):) => OutData%fromSCglob + else + allocate(OutData%fromSCglob(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSCglob.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%fromSCglob) + OutData%C_obj%fromSCglob_Len = size(OutData%fromSCglob) + if (OutData%C_obj%fromSCglob_Len > 0) OutData%C_obj%fromSCglob = c_loc(OutData%fromSCglob(LB(1))) + call RegUnpack(Buf, OutData%fromSCglob) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%fromSCglob => null() + end if + ! fromSC + if (associated(OutData%fromSC)) deallocate(OutData%fromSC) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpackPointer(Buf, Ptr, PtrIdx) + if (RegCheckErr(Buf, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%fromSC, UB(1:1)-LB(1:1)) + OutData%fromSC(LB(1):) => OutData%fromSC + else + allocate(OutData%fromSC(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%fromSC.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + Buf%Pointers(PtrIdx) = c_loc(OutData%fromSC) + OutData%C_obj%fromSC_Len = size(OutData%fromSC) + if (OutData%C_obj%fromSC_Len > 0) OutData%C_obj%fromSC = c_loc(OutData%fromSC(LB(1))) + call RegUnpack(Buf, OutData%fromSC) + if (RegCheckErr(Buf, RoutineName)) return + end if + else + OutData%fromSC => null() + end if +end subroutine SUBROUTINE SC_C2Fary_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) TYPE(SC_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat diff --git a/modules/wakedynamics/src/WakeDynamics_Types.f90 b/modules/wakedynamics/src/WakeDynamics_Types.f90 index a637d846de..81ae0a415b 100644 --- a/modules/wakedynamics/src/WakeDynamics_Types.f90 +++ b/modules/wakedynamics/src/WakeDynamics_Types.f90 @@ -292,258 +292,212 @@ SUBROUTINE WD_DestroyInputFileType( InputFileTypeData, ErrStat, ErrMsg ) END SUBROUTINE WD_DestroyInputFileType - SUBROUTINE WD_PackInputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(WD_InputFileType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_PackInputFileType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! dr - Int_BufSz = Int_BufSz + 1 ! NumRadii - Int_BufSz = Int_BufSz + 1 ! NumPlanes - Int_BufSz = Int_BufSz + 1 ! Mod_Wake - Re_BufSz = Re_BufSz + 1 ! f_c - Re_BufSz = Re_BufSz + 1 ! C_HWkDfl_O - Re_BufSz = Re_BufSz + 1 ! C_HWkDfl_OY - Re_BufSz = Re_BufSz + 1 ! C_HWkDfl_x - Re_BufSz = Re_BufSz + 1 ! C_HWkDfl_xY - Re_BufSz = Re_BufSz + 1 ! C_NearWake - Re_BufSz = Re_BufSz + 1 ! k_vAmb - Re_BufSz = Re_BufSz + 1 ! k_vShr - Re_BufSz = Re_BufSz + 1 ! C_vAmb_DMin - Re_BufSz = Re_BufSz + 1 ! C_vAmb_DMax - Re_BufSz = Re_BufSz + 1 ! C_vAmb_FMin - Re_BufSz = Re_BufSz + 1 ! C_vAmb_Exp - Re_BufSz = Re_BufSz + 1 ! C_vShr_DMin - Re_BufSz = Re_BufSz + 1 ! C_vShr_DMax - Re_BufSz = Re_BufSz + 1 ! C_vShr_FMin - Re_BufSz = Re_BufSz + 1 ! C_vShr_Exp - Int_BufSz = Int_BufSz + 1 ! Mod_WakeDiam - Re_BufSz = Re_BufSz + 1 ! C_WakeDiam - Int_BufSz = Int_BufSz + 1 ! Swirl - Re_BufSz = Re_BufSz + 1 ! k_VortexDecay - Re_BufSz = Re_BufSz + 1 ! sigma_D - Int_BufSz = Int_BufSz + 1 ! NumVortices - Int_BufSz = Int_BufSz + 1 ! FilterInit - Re_BufSz = Re_BufSz + 1 ! k_vCurl - Int_BufSz = Int_BufSz + 1 ! OutAllPlanes - Int_BufSz = Int_BufSz + 1 ! WAT - Re_BufSz = Re_BufSz + 1 ! WAT_k_Def - Re_BufSz = Re_BufSz + 1 ! WAT_k_Grad - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%dr - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumRadii - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumPlanes - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Mod_Wake - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%f_c - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_HWkDfl_O - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_HWkDfl_OY - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_HWkDfl_x - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_HWkDfl_xY - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_NearWake - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k_vAmb - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k_vShr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vAmb_DMin - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vAmb_DMax - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vAmb_FMin - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vAmb_Exp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vShr_DMin - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vShr_DMax - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vShr_FMin - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vShr_Exp - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Mod_WakeDiam - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_WakeDiam - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Swirl, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k_VortexDecay - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%sigma_D - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumVortices - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%FilterInit - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k_vCurl - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%OutAllPlanes, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WAT, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WAT_k_Def - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WAT_k_Grad - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE WD_PackInputFileType - - SUBROUTINE WD_UnPackInputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(WD_InputFileType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_UnPackInputFileType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%dr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NumRadii = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumPlanes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Mod_Wake = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%f_c = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_HWkDfl_O = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_HWkDfl_OY = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_HWkDfl_x = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_HWkDfl_xY = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_NearWake = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k_vAmb = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k_vShr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vAmb_DMin = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vAmb_DMax = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vAmb_FMin = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vAmb_Exp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vShr_DMin = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vShr_DMax = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vShr_FMin = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vShr_Exp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Mod_WakeDiam = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_WakeDiam = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Swirl = TRANSFER(IntKiBuf(Int_Xferred), OutData%Swirl) - Int_Xferred = Int_Xferred + 1 - OutData%k_VortexDecay = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%sigma_D = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NumVortices = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FilterInit = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%k_vCurl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%OutAllPlanes = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutAllPlanes) - Int_Xferred = Int_Xferred + 1 - OutData%WAT = TRANSFER(IntKiBuf(Int_Xferred), OutData%WAT) - Int_Xferred = Int_Xferred + 1 - OutData%WAT_k_Def = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WAT_k_Grad = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE WD_UnPackInputFileType +subroutine WD_PackInputFileType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WD_InputFileType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WD_PackInputFileType' + if (Buf%ErrStat >= AbortErrLev) return + ! dr + call RegPack(Buf, InData%dr) + if (RegCheckErr(Buf, RoutineName)) return + ! NumRadii + call RegPack(Buf, InData%NumRadii) + if (RegCheckErr(Buf, RoutineName)) return + ! NumPlanes + call RegPack(Buf, InData%NumPlanes) + if (RegCheckErr(Buf, RoutineName)) return + ! Mod_Wake + call RegPack(Buf, InData%Mod_Wake) + if (RegCheckErr(Buf, RoutineName)) return + ! f_c + call RegPack(Buf, InData%f_c) + if (RegCheckErr(Buf, RoutineName)) return + ! C_HWkDfl_O + call RegPack(Buf, InData%C_HWkDfl_O) + if (RegCheckErr(Buf, RoutineName)) return + ! C_HWkDfl_OY + call RegPack(Buf, InData%C_HWkDfl_OY) + if (RegCheckErr(Buf, RoutineName)) return + ! C_HWkDfl_x + call RegPack(Buf, InData%C_HWkDfl_x) + if (RegCheckErr(Buf, RoutineName)) return + ! C_HWkDfl_xY + call RegPack(Buf, InData%C_HWkDfl_xY) + if (RegCheckErr(Buf, RoutineName)) return + ! C_NearWake + call RegPack(Buf, InData%C_NearWake) + if (RegCheckErr(Buf, RoutineName)) return + ! k_vAmb + call RegPack(Buf, InData%k_vAmb) + if (RegCheckErr(Buf, RoutineName)) return + ! k_vShr + call RegPack(Buf, InData%k_vShr) + if (RegCheckErr(Buf, RoutineName)) return + ! C_vAmb_DMin + call RegPack(Buf, InData%C_vAmb_DMin) + if (RegCheckErr(Buf, RoutineName)) return + ! C_vAmb_DMax + call RegPack(Buf, InData%C_vAmb_DMax) + if (RegCheckErr(Buf, RoutineName)) return + ! C_vAmb_FMin + call RegPack(Buf, InData%C_vAmb_FMin) + if (RegCheckErr(Buf, RoutineName)) return + ! C_vAmb_Exp + call RegPack(Buf, InData%C_vAmb_Exp) + if (RegCheckErr(Buf, RoutineName)) return + ! C_vShr_DMin + call RegPack(Buf, InData%C_vShr_DMin) + if (RegCheckErr(Buf, RoutineName)) return + ! C_vShr_DMax + call RegPack(Buf, InData%C_vShr_DMax) + if (RegCheckErr(Buf, RoutineName)) return + ! C_vShr_FMin + call RegPack(Buf, InData%C_vShr_FMin) + if (RegCheckErr(Buf, RoutineName)) return + ! C_vShr_Exp + call RegPack(Buf, InData%C_vShr_Exp) + if (RegCheckErr(Buf, RoutineName)) return + ! Mod_WakeDiam + call RegPack(Buf, InData%Mod_WakeDiam) + if (RegCheckErr(Buf, RoutineName)) return + ! C_WakeDiam + call RegPack(Buf, InData%C_WakeDiam) + if (RegCheckErr(Buf, RoutineName)) return + ! Swirl + call RegPack(Buf, InData%Swirl) + if (RegCheckErr(Buf, RoutineName)) return + ! k_VortexDecay + call RegPack(Buf, InData%k_VortexDecay) + if (RegCheckErr(Buf, RoutineName)) return + ! sigma_D + call RegPack(Buf, InData%sigma_D) + if (RegCheckErr(Buf, RoutineName)) return + ! NumVortices + call RegPack(Buf, InData%NumVortices) + if (RegCheckErr(Buf, RoutineName)) return + ! FilterInit + call RegPack(Buf, InData%FilterInit) + if (RegCheckErr(Buf, RoutineName)) return + ! k_vCurl + call RegPack(Buf, InData%k_vCurl) + if (RegCheckErr(Buf, RoutineName)) return + ! OutAllPlanes + call RegPack(Buf, InData%OutAllPlanes) + if (RegCheckErr(Buf, RoutineName)) return + ! WAT + call RegPack(Buf, InData%WAT) + if (RegCheckErr(Buf, RoutineName)) return + ! WAT_k_Def + call RegPack(Buf, InData%WAT_k_Def) + if (RegCheckErr(Buf, RoutineName)) return + ! WAT_k_Grad + call RegPack(Buf, InData%WAT_k_Grad) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WD_UnPackInputFileType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WD_InputFileType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WD_UnPackInputFileType' + if (Buf%ErrStat /= ErrID_None) return + ! dr + call RegUnpack(Buf, OutData%dr) + if (RegCheckErr(Buf, RoutineName)) return + ! NumRadii + call RegUnpack(Buf, OutData%NumRadii) + if (RegCheckErr(Buf, RoutineName)) return + ! NumPlanes + call RegUnpack(Buf, OutData%NumPlanes) + if (RegCheckErr(Buf, RoutineName)) return + ! Mod_Wake + call RegUnpack(Buf, OutData%Mod_Wake) + if (RegCheckErr(Buf, RoutineName)) return + ! f_c + call RegUnpack(Buf, OutData%f_c) + if (RegCheckErr(Buf, RoutineName)) return + ! C_HWkDfl_O + call RegUnpack(Buf, OutData%C_HWkDfl_O) + if (RegCheckErr(Buf, RoutineName)) return + ! C_HWkDfl_OY + call RegUnpack(Buf, OutData%C_HWkDfl_OY) + if (RegCheckErr(Buf, RoutineName)) return + ! C_HWkDfl_x + call RegUnpack(Buf, OutData%C_HWkDfl_x) + if (RegCheckErr(Buf, RoutineName)) return + ! C_HWkDfl_xY + call RegUnpack(Buf, OutData%C_HWkDfl_xY) + if (RegCheckErr(Buf, RoutineName)) return + ! C_NearWake + call RegUnpack(Buf, OutData%C_NearWake) + if (RegCheckErr(Buf, RoutineName)) return + ! k_vAmb + call RegUnpack(Buf, OutData%k_vAmb) + if (RegCheckErr(Buf, RoutineName)) return + ! k_vShr + call RegUnpack(Buf, OutData%k_vShr) + if (RegCheckErr(Buf, RoutineName)) return + ! C_vAmb_DMin + call RegUnpack(Buf, OutData%C_vAmb_DMin) + if (RegCheckErr(Buf, RoutineName)) return + ! C_vAmb_DMax + call RegUnpack(Buf, OutData%C_vAmb_DMax) + if (RegCheckErr(Buf, RoutineName)) return + ! C_vAmb_FMin + call RegUnpack(Buf, OutData%C_vAmb_FMin) + if (RegCheckErr(Buf, RoutineName)) return + ! C_vAmb_Exp + call RegUnpack(Buf, OutData%C_vAmb_Exp) + if (RegCheckErr(Buf, RoutineName)) return + ! C_vShr_DMin + call RegUnpack(Buf, OutData%C_vShr_DMin) + if (RegCheckErr(Buf, RoutineName)) return + ! C_vShr_DMax + call RegUnpack(Buf, OutData%C_vShr_DMax) + if (RegCheckErr(Buf, RoutineName)) return + ! C_vShr_FMin + call RegUnpack(Buf, OutData%C_vShr_FMin) + if (RegCheckErr(Buf, RoutineName)) return + ! C_vShr_Exp + call RegUnpack(Buf, OutData%C_vShr_Exp) + if (RegCheckErr(Buf, RoutineName)) return + ! Mod_WakeDiam + call RegUnpack(Buf, OutData%Mod_WakeDiam) + if (RegCheckErr(Buf, RoutineName)) return + ! C_WakeDiam + call RegUnpack(Buf, OutData%C_WakeDiam) + if (RegCheckErr(Buf, RoutineName)) return + ! Swirl + call RegUnpack(Buf, OutData%Swirl) + if (RegCheckErr(Buf, RoutineName)) return + ! k_VortexDecay + call RegUnpack(Buf, OutData%k_VortexDecay) + if (RegCheckErr(Buf, RoutineName)) return + ! sigma_D + call RegUnpack(Buf, OutData%sigma_D) + if (RegCheckErr(Buf, RoutineName)) return + ! NumVortices + call RegUnpack(Buf, OutData%NumVortices) + if (RegCheckErr(Buf, RoutineName)) return + ! FilterInit + call RegUnpack(Buf, OutData%FilterInit) + if (RegCheckErr(Buf, RoutineName)) return + ! k_vCurl + call RegUnpack(Buf, OutData%k_vCurl) + if (RegCheckErr(Buf, RoutineName)) return + ! OutAllPlanes + call RegUnpack(Buf, OutData%OutAllPlanes) + if (RegCheckErr(Buf, RoutineName)) return + ! WAT + call RegUnpack(Buf, OutData%WAT) + if (RegCheckErr(Buf, RoutineName)) return + ! WAT_k_Def + call RegUnpack(Buf, OutData%WAT_k_Def) + if (RegCheckErr(Buf, RoutineName)) return + ! WAT_k_Grad + call RegUnpack(Buf, OutData%WAT_k_Grad) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE WD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(WD_InitInputType), INTENT(IN) :: SrcInitInputData TYPE(WD_InitInputType), INTENT(INOUT) :: DstInitInputData @@ -582,198 +536,37 @@ SUBROUTINE WD_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE WD_DestroyInitInput - SUBROUTINE WD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(WD_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! InputFileData: size of buffers for each call to pack subtype - CALL WD_PackInputFileType( Re_Buf, Db_Buf, Int_Buf, InData%InputFileData, ErrStat2, ErrMsg2, .TRUE. ) ! InputFileData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! InputFileData - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! InputFileData - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! InputFileData - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! TurbNum - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFileRoot) ! OutFileRoot - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - CALL WD_PackInputFileType( Re_Buf, Db_Buf, Int_Buf, InData%InputFileData, ErrStat2, ErrMsg2, OnlySize ) ! InputFileData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf(Int_Xferred) = InData%TurbNum - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFileRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFileRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE WD_PackInitInput - - SUBROUTINE WD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(WD_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL WD_UnpackInputFileType( Re_Buf, Db_Buf, Int_Buf, OutData%InputFileData, ErrStat2, ErrMsg2 ) ! InputFileData - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%TurbNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFileRoot) - OutData%OutFileRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END SUBROUTINE WD_UnPackInitInput +subroutine WD_PackInitInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WD_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WD_PackInitInput' + if (Buf%ErrStat >= AbortErrLev) return + ! InputFileData + call WD_PackInputFileType(Buf, InData%InputFileData) + if (RegCheckErr(Buf, RoutineName)) return + ! TurbNum + call RegPack(Buf, InData%TurbNum) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFileRoot + call RegPack(Buf, InData%OutFileRoot) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WD_UnPackInitInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WD_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WD_UnPackInitInput' + if (Buf%ErrStat /= ErrID_None) return + ! InputFileData + call WD_UnpackInputFileType(Buf, OutData%InputFileData) ! InputFileData + ! TurbNum + call RegUnpack(Buf, OutData%TurbNum) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFileRoot + call RegUnpack(Buf, OutData%OutFileRoot) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE WD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(WD_InitOutputType), INTENT(IN) :: SrcInitOutputData TYPE(WD_InitOutputType), INTENT(INOUT) :: DstInitOutputData @@ -841,269 +634,72 @@ SUBROUTINE WD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END SUBROUTINE WD_DestroyInitOutput - SUBROUTINE WD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(WD_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! WriteOutputHdr allocated yes/no - IF ( ALLOCATED(InData%WriteOutputHdr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdr upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdr)*LEN(InData%WriteOutputHdr) ! WriteOutputHdr - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputUnt allocated yes/no - IF ( ALLOCATED(InData%WriteOutputUnt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUnt upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUnt)*LEN(InData%WriteOutputUnt) ! WriteOutputUnt - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%WriteOutputHdr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) - DO I = 1, LEN(InData%WriteOutputHdr) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputUnt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) - DO I = 1, LEN(InData%WriteOutputUnt) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - CALL NWTC_Library_PackProgDesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE WD_PackInitOutput - - SUBROUTINE WD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(WD_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputHdr)) DEALLOCATE(OutData%WriteOutputHdr) - ALLOCATE(OutData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) - DO I = 1, LEN(OutData%WriteOutputHdr) - OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputUnt)) DEALLOCATE(OutData%WriteOutputUnt) - ALLOCATE(OutData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) - DO I = 1, LEN(OutData%WriteOutputUnt) - OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackProgDesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE WD_UnPackInitOutput +subroutine WD_PackInitOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WD_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WD_PackInitOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! WriteOutputHdr + call RegPack(Buf, allocated(InData%WriteOutputHdr)) + if (allocated(InData%WriteOutputHdr)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) + call RegPack(Buf, InData%WriteOutputHdr) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WriteOutputUnt + call RegPack(Buf, allocated(InData%WriteOutputUnt)) + if (allocated(InData%WriteOutputUnt)) then + call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) + call RegPack(Buf, InData%WriteOutputUnt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Ver + call NWTC_Library_PackProgDesc(Buf, InData%Ver) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WD_UnPackInitOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WD_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WD_UnPackInitOutput' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! WriteOutputHdr + if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputHdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputHdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WriteOutputUnt + if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WriteOutputUnt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WriteOutputUnt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Ver + call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver +end subroutine SUBROUTINE WD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(WD_ContinuousStateType), INTENT(IN) :: SrcContStateData TYPE(WD_ContinuousStateType), INTENT(INOUT) :: DstContStateData @@ -1136,103 +732,26 @@ SUBROUTINE WD_DestroyContState( ContStateData, ErrStat, ErrMsg ) END SUBROUTINE WD_DestroyContState - SUBROUTINE WD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(WD_ContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_PackContState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyContState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE WD_PackContState - - SUBROUTINE WD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(WD_ContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_UnPackContState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyContState = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE WD_UnPackContState +subroutine WD_PackContState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WD_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WD_PackContState' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyContState + call RegPack(Buf, InData%DummyContState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WD_UnPackContState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WD_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WD_UnPackContState' + if (Buf%ErrStat /= ErrID_None) return + ! DummyContState + call RegUnpack(Buf, OutData%DummyContState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE WD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(WD_DiscreteStateType), INTENT(IN) :: SrcDiscStateData TYPE(WD_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData @@ -1517,796 +1036,371 @@ SUBROUTINE WD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE WD_DestroyDiscState - SUBROUTINE WD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(WD_DiscreteStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_PackDiscState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! xhat_plane allocated yes/no - IF ( ALLOCATED(InData%xhat_plane) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! xhat_plane upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%xhat_plane) ! xhat_plane - END IF - Int_BufSz = Int_BufSz + 1 ! YawErr_filt allocated yes/no - IF ( ALLOCATED(InData%YawErr_filt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! YawErr_filt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%YawErr_filt) ! YawErr_filt - END IF - Re_BufSz = Re_BufSz + 1 ! psi_skew_filt - Re_BufSz = Re_BufSz + 1 ! chi_skew_filt - Int_BufSz = Int_BufSz + 1 ! V_plane_filt allocated yes/no - IF ( ALLOCATED(InData%V_plane_filt) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! V_plane_filt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%V_plane_filt) ! V_plane_filt - END IF - Int_BufSz = Int_BufSz + 1 ! p_plane allocated yes/no - IF ( ALLOCATED(InData%p_plane) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! p_plane upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%p_plane) ! p_plane - END IF - Int_BufSz = Int_BufSz + 1 ! x_plane allocated yes/no - IF ( ALLOCATED(InData%x_plane) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x_plane upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%x_plane) ! x_plane - END IF - Int_BufSz = Int_BufSz + 1 ! Vx_wake allocated yes/no - IF ( ALLOCATED(InData%Vx_wake) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vx_wake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vx_wake) ! Vx_wake - END IF - Int_BufSz = Int_BufSz + 1 ! Vr_wake allocated yes/no - IF ( ALLOCATED(InData%Vr_wake) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vr_wake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vr_wake) ! Vr_wake - END IF - Int_BufSz = Int_BufSz + 1 ! Vx_wake2 allocated yes/no - IF ( ALLOCATED(InData%Vx_wake2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Vx_wake2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vx_wake2) ! Vx_wake2 - END IF - Int_BufSz = Int_BufSz + 1 ! Vy_wake2 allocated yes/no - IF ( ALLOCATED(InData%Vy_wake2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Vy_wake2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vy_wake2) ! Vy_wake2 - END IF - Int_BufSz = Int_BufSz + 1 ! Vz_wake2 allocated yes/no - IF ( ALLOCATED(InData%Vz_wake2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Vz_wake2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vz_wake2) ! Vz_wake2 - END IF - Int_BufSz = Int_BufSz + 1 ! Vx_wind_disk_filt allocated yes/no - IF ( ALLOCATED(InData%Vx_wind_disk_filt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Vx_wind_disk_filt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vx_wind_disk_filt) ! Vx_wind_disk_filt - END IF - Int_BufSz = Int_BufSz + 1 ! TI_amb_filt allocated yes/no - IF ( ALLOCATED(InData%TI_amb_filt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TI_amb_filt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TI_amb_filt) ! TI_amb_filt - END IF - Int_BufSz = Int_BufSz + 1 ! D_rotor_filt allocated yes/no - IF ( ALLOCATED(InData%D_rotor_filt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! D_rotor_filt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%D_rotor_filt) ! D_rotor_filt - END IF - Re_BufSz = Re_BufSz + 1 ! Vx_rel_disk_filt - Int_BufSz = Int_BufSz + 1 ! Ct_azavg_filt allocated yes/no - IF ( ALLOCATED(InData%Ct_azavg_filt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Ct_azavg_filt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Ct_azavg_filt) ! Ct_azavg_filt - END IF - Int_BufSz = Int_BufSz + 1 ! Cq_azavg_filt allocated yes/no - IF ( ALLOCATED(InData%Cq_azavg_filt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Cq_azavg_filt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cq_azavg_filt) ! Cq_azavg_filt - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%xhat_plane) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xhat_plane,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xhat_plane,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xhat_plane,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xhat_plane,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%xhat_plane,2), UBOUND(InData%xhat_plane,2) - DO i1 = LBOUND(InData%xhat_plane,1), UBOUND(InData%xhat_plane,1) - ReKiBuf(Re_Xferred) = InData%xhat_plane(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%YawErr_filt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%YawErr_filt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%YawErr_filt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%YawErr_filt,1), UBOUND(InData%YawErr_filt,1) - ReKiBuf(Re_Xferred) = InData%YawErr_filt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%psi_skew_filt - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%chi_skew_filt - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%V_plane_filt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%V_plane_filt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V_plane_filt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%V_plane_filt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V_plane_filt,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%V_plane_filt,2), UBOUND(InData%V_plane_filt,2) - DO i1 = LBOUND(InData%V_plane_filt,1), UBOUND(InData%V_plane_filt,1) - ReKiBuf(Re_Xferred) = InData%V_plane_filt(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%p_plane) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%p_plane,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%p_plane,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%p_plane,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%p_plane,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%p_plane,2), UBOUND(InData%p_plane,2) - DO i1 = LBOUND(InData%p_plane,1), UBOUND(InData%p_plane,1) - ReKiBuf(Re_Xferred) = InData%p_plane(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%x_plane) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x_plane,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_plane,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x_plane,1), UBOUND(InData%x_plane,1) - ReKiBuf(Re_Xferred) = InData%x_plane(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vx_wake) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vx_wake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_wake,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vx_wake,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_wake,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vx_wake,2), UBOUND(InData%Vx_wake,2) - DO i1 = LBOUND(InData%Vx_wake,1), UBOUND(InData%Vx_wake,1) - ReKiBuf(Re_Xferred) = InData%Vx_wake(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vr_wake) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vr_wake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vr_wake,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vr_wake,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vr_wake,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vr_wake,2), UBOUND(InData%Vr_wake,2) - DO i1 = LBOUND(InData%Vr_wake,1), UBOUND(InData%Vr_wake,1) - ReKiBuf(Re_Xferred) = InData%Vr_wake(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vx_wake2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vx_wake2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_wake2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vx_wake2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_wake2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vx_wake2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_wake2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Vx_wake2,3), UBOUND(InData%Vx_wake2,3) - DO i2 = LBOUND(InData%Vx_wake2,2), UBOUND(InData%Vx_wake2,2) - DO i1 = LBOUND(InData%Vx_wake2,1), UBOUND(InData%Vx_wake2,1) - ReKiBuf(Re_Xferred) = InData%Vx_wake2(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vy_wake2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vy_wake2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vy_wake2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vy_wake2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vy_wake2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vy_wake2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vy_wake2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Vy_wake2,3), UBOUND(InData%Vy_wake2,3) - DO i2 = LBOUND(InData%Vy_wake2,2), UBOUND(InData%Vy_wake2,2) - DO i1 = LBOUND(InData%Vy_wake2,1), UBOUND(InData%Vy_wake2,1) - ReKiBuf(Re_Xferred) = InData%Vy_wake2(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vz_wake2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vz_wake2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vz_wake2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vz_wake2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vz_wake2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vz_wake2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vz_wake2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Vz_wake2,3), UBOUND(InData%Vz_wake2,3) - DO i2 = LBOUND(InData%Vz_wake2,2), UBOUND(InData%Vz_wake2,2) - DO i1 = LBOUND(InData%Vz_wake2,1), UBOUND(InData%Vz_wake2,1) - ReKiBuf(Re_Xferred) = InData%Vz_wake2(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vx_wind_disk_filt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vx_wind_disk_filt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_wind_disk_filt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Vx_wind_disk_filt,1), UBOUND(InData%Vx_wind_disk_filt,1) - ReKiBuf(Re_Xferred) = InData%Vx_wind_disk_filt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TI_amb_filt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TI_amb_filt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI_amb_filt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TI_amb_filt,1), UBOUND(InData%TI_amb_filt,1) - ReKiBuf(Re_Xferred) = InData%TI_amb_filt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%D_rotor_filt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%D_rotor_filt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_rotor_filt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%D_rotor_filt,1), UBOUND(InData%D_rotor_filt,1) - ReKiBuf(Re_Xferred) = InData%D_rotor_filt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%Vx_rel_disk_filt - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Ct_azavg_filt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ct_azavg_filt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ct_azavg_filt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Ct_azavg_filt,1), UBOUND(InData%Ct_azavg_filt,1) - ReKiBuf(Re_Xferred) = InData%Ct_azavg_filt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cq_azavg_filt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cq_azavg_filt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cq_azavg_filt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Cq_azavg_filt,1), UBOUND(InData%Cq_azavg_filt,1) - ReKiBuf(Re_Xferred) = InData%Cq_azavg_filt(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE WD_PackDiscState - - SUBROUTINE WD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(WD_DiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_UnPackDiscState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xhat_plane not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%xhat_plane)) DEALLOCATE(OutData%xhat_plane) - ALLOCATE(OutData%xhat_plane(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xhat_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%xhat_plane,2), UBOUND(OutData%xhat_plane,2) - DO i1 = LBOUND(OutData%xhat_plane,1), UBOUND(OutData%xhat_plane,1) - OutData%xhat_plane(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! YawErr_filt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%YawErr_filt)) DEALLOCATE(OutData%YawErr_filt) - ALLOCATE(OutData%YawErr_filt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%YawErr_filt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%YawErr_filt,1), UBOUND(OutData%YawErr_filt,1) - OutData%YawErr_filt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%psi_skew_filt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%chi_skew_filt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! V_plane_filt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%V_plane_filt)) DEALLOCATE(OutData%V_plane_filt) - ALLOCATE(OutData%V_plane_filt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%V_plane_filt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%V_plane_filt,2), UBOUND(OutData%V_plane_filt,2) - DO i1 = LBOUND(OutData%V_plane_filt,1), UBOUND(OutData%V_plane_filt,1) - OutData%V_plane_filt(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! p_plane not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%p_plane)) DEALLOCATE(OutData%p_plane) - ALLOCATE(OutData%p_plane(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%p_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%p_plane,2), UBOUND(OutData%p_plane,2) - DO i1 = LBOUND(OutData%p_plane,1), UBOUND(OutData%p_plane,1) - OutData%p_plane(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_plane not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%x_plane)) DEALLOCATE(OutData%x_plane) - ALLOCATE(OutData%x_plane(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%x_plane,1), UBOUND(OutData%x_plane,1) - OutData%x_plane(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vx_wake not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vx_wake)) DEALLOCATE(OutData%Vx_wake) - ALLOCATE(OutData%Vx_wake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vx_wake,2), UBOUND(OutData%Vx_wake,2) - DO i1 = LBOUND(OutData%Vx_wake,1), UBOUND(OutData%Vx_wake,1) - OutData%Vx_wake(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vr_wake not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vr_wake)) DEALLOCATE(OutData%Vr_wake) - ALLOCATE(OutData%Vr_wake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vr_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vr_wake,2), UBOUND(OutData%Vr_wake,2) - DO i1 = LBOUND(OutData%Vr_wake,1), UBOUND(OutData%Vr_wake,1) - OutData%Vr_wake(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vx_wake2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vx_wake2)) DEALLOCATE(OutData%Vx_wake2) - ALLOCATE(OutData%Vx_wake2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_wake2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Vx_wake2,3), UBOUND(OutData%Vx_wake2,3) - DO i2 = LBOUND(OutData%Vx_wake2,2), UBOUND(OutData%Vx_wake2,2) - DO i1 = LBOUND(OutData%Vx_wake2,1), UBOUND(OutData%Vx_wake2,1) - OutData%Vx_wake2(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vy_wake2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vy_wake2)) DEALLOCATE(OutData%Vy_wake2) - ALLOCATE(OutData%Vy_wake2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vy_wake2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Vy_wake2,3), UBOUND(OutData%Vy_wake2,3) - DO i2 = LBOUND(OutData%Vy_wake2,2), UBOUND(OutData%Vy_wake2,2) - DO i1 = LBOUND(OutData%Vy_wake2,1), UBOUND(OutData%Vy_wake2,1) - OutData%Vy_wake2(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vz_wake2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vz_wake2)) DEALLOCATE(OutData%Vz_wake2) - ALLOCATE(OutData%Vz_wake2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vz_wake2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Vz_wake2,3), UBOUND(OutData%Vz_wake2,3) - DO i2 = LBOUND(OutData%Vz_wake2,2), UBOUND(OutData%Vz_wake2,2) - DO i1 = LBOUND(OutData%Vz_wake2,1), UBOUND(OutData%Vz_wake2,1) - OutData%Vz_wake2(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vx_wind_disk_filt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vx_wind_disk_filt)) DEALLOCATE(OutData%Vx_wind_disk_filt) - ALLOCATE(OutData%Vx_wind_disk_filt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_wind_disk_filt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Vx_wind_disk_filt,1), UBOUND(OutData%Vx_wind_disk_filt,1) - OutData%Vx_wind_disk_filt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TI_amb_filt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TI_amb_filt)) DEALLOCATE(OutData%TI_amb_filt) - ALLOCATE(OutData%TI_amb_filt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI_amb_filt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TI_amb_filt,1), UBOUND(OutData%TI_amb_filt,1) - OutData%TI_amb_filt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_rotor_filt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%D_rotor_filt)) DEALLOCATE(OutData%D_rotor_filt) - ALLOCATE(OutData%D_rotor_filt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_rotor_filt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%D_rotor_filt,1), UBOUND(OutData%D_rotor_filt,1) - OutData%D_rotor_filt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Vx_rel_disk_filt = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ct_azavg_filt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Ct_azavg_filt)) DEALLOCATE(OutData%Ct_azavg_filt) - ALLOCATE(OutData%Ct_azavg_filt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ct_azavg_filt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Ct_azavg_filt,1), UBOUND(OutData%Ct_azavg_filt,1) - OutData%Ct_azavg_filt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cq_azavg_filt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Cq_azavg_filt)) DEALLOCATE(OutData%Cq_azavg_filt) - ALLOCATE(OutData%Cq_azavg_filt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cq_azavg_filt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Cq_azavg_filt,1), UBOUND(OutData%Cq_azavg_filt,1) - OutData%Cq_azavg_filt(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE WD_UnPackDiscState +subroutine WD_PackDiscState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WD_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WD_PackDiscState' + if (Buf%ErrStat >= AbortErrLev) return + ! xhat_plane + call RegPack(Buf, allocated(InData%xhat_plane)) + if (allocated(InData%xhat_plane)) then + call RegPackBounds(Buf, 2, lbound(InData%xhat_plane), ubound(InData%xhat_plane)) + call RegPack(Buf, InData%xhat_plane) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! YawErr_filt + call RegPack(Buf, allocated(InData%YawErr_filt)) + if (allocated(InData%YawErr_filt)) then + call RegPackBounds(Buf, 1, lbound(InData%YawErr_filt), ubound(InData%YawErr_filt)) + call RegPack(Buf, InData%YawErr_filt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! psi_skew_filt + call RegPack(Buf, InData%psi_skew_filt) + if (RegCheckErr(Buf, RoutineName)) return + ! chi_skew_filt + call RegPack(Buf, InData%chi_skew_filt) + if (RegCheckErr(Buf, RoutineName)) return + ! V_plane_filt + call RegPack(Buf, allocated(InData%V_plane_filt)) + if (allocated(InData%V_plane_filt)) then + call RegPackBounds(Buf, 2, lbound(InData%V_plane_filt), ubound(InData%V_plane_filt)) + call RegPack(Buf, InData%V_plane_filt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! p_plane + call RegPack(Buf, allocated(InData%p_plane)) + if (allocated(InData%p_plane)) then + call RegPackBounds(Buf, 2, lbound(InData%p_plane), ubound(InData%p_plane)) + call RegPack(Buf, InData%p_plane) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! x_plane + call RegPack(Buf, allocated(InData%x_plane)) + if (allocated(InData%x_plane)) then + call RegPackBounds(Buf, 1, lbound(InData%x_plane), ubound(InData%x_plane)) + call RegPack(Buf, InData%x_plane) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Vx_wake + call RegPack(Buf, allocated(InData%Vx_wake)) + if (allocated(InData%Vx_wake)) then + call RegPackBounds(Buf, 2, lbound(InData%Vx_wake), ubound(InData%Vx_wake)) + call RegPack(Buf, InData%Vx_wake) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Vr_wake + call RegPack(Buf, allocated(InData%Vr_wake)) + if (allocated(InData%Vr_wake)) then + call RegPackBounds(Buf, 2, lbound(InData%Vr_wake), ubound(InData%Vr_wake)) + call RegPack(Buf, InData%Vr_wake) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Vx_wake2 + call RegPack(Buf, allocated(InData%Vx_wake2)) + if (allocated(InData%Vx_wake2)) then + call RegPackBounds(Buf, 3, lbound(InData%Vx_wake2), ubound(InData%Vx_wake2)) + call RegPack(Buf, InData%Vx_wake2) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Vy_wake2 + call RegPack(Buf, allocated(InData%Vy_wake2)) + if (allocated(InData%Vy_wake2)) then + call RegPackBounds(Buf, 3, lbound(InData%Vy_wake2), ubound(InData%Vy_wake2)) + call RegPack(Buf, InData%Vy_wake2) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Vz_wake2 + call RegPack(Buf, allocated(InData%Vz_wake2)) + if (allocated(InData%Vz_wake2)) then + call RegPackBounds(Buf, 3, lbound(InData%Vz_wake2), ubound(InData%Vz_wake2)) + call RegPack(Buf, InData%Vz_wake2) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Vx_wind_disk_filt + call RegPack(Buf, allocated(InData%Vx_wind_disk_filt)) + if (allocated(InData%Vx_wind_disk_filt)) then + call RegPackBounds(Buf, 1, lbound(InData%Vx_wind_disk_filt), ubound(InData%Vx_wind_disk_filt)) + call RegPack(Buf, InData%Vx_wind_disk_filt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! TI_amb_filt + call RegPack(Buf, allocated(InData%TI_amb_filt)) + if (allocated(InData%TI_amb_filt)) then + call RegPackBounds(Buf, 1, lbound(InData%TI_amb_filt), ubound(InData%TI_amb_filt)) + call RegPack(Buf, InData%TI_amb_filt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! D_rotor_filt + call RegPack(Buf, allocated(InData%D_rotor_filt)) + if (allocated(InData%D_rotor_filt)) then + call RegPackBounds(Buf, 1, lbound(InData%D_rotor_filt), ubound(InData%D_rotor_filt)) + call RegPack(Buf, InData%D_rotor_filt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Vx_rel_disk_filt + call RegPack(Buf, InData%Vx_rel_disk_filt) + if (RegCheckErr(Buf, RoutineName)) return + ! Ct_azavg_filt + call RegPack(Buf, allocated(InData%Ct_azavg_filt)) + if (allocated(InData%Ct_azavg_filt)) then + call RegPackBounds(Buf, 1, lbound(InData%Ct_azavg_filt), ubound(InData%Ct_azavg_filt)) + call RegPack(Buf, InData%Ct_azavg_filt) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Cq_azavg_filt + call RegPack(Buf, allocated(InData%Cq_azavg_filt)) + if (allocated(InData%Cq_azavg_filt)) then + call RegPackBounds(Buf, 1, lbound(InData%Cq_azavg_filt), ubound(InData%Cq_azavg_filt)) + call RegPack(Buf, InData%Cq_azavg_filt) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WD_UnPackDiscState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WD_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WD_UnPackDiscState' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! xhat_plane + if (allocated(OutData%xhat_plane)) deallocate(OutData%xhat_plane) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xhat_plane(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xhat_plane.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%xhat_plane) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! YawErr_filt + if (allocated(OutData%YawErr_filt)) deallocate(OutData%YawErr_filt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%YawErr_filt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%YawErr_filt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%YawErr_filt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! psi_skew_filt + call RegUnpack(Buf, OutData%psi_skew_filt) + if (RegCheckErr(Buf, RoutineName)) return + ! chi_skew_filt + call RegUnpack(Buf, OutData%chi_skew_filt) + if (RegCheckErr(Buf, RoutineName)) return + ! V_plane_filt + if (allocated(OutData%V_plane_filt)) deallocate(OutData%V_plane_filt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%V_plane_filt(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%V_plane_filt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%V_plane_filt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! p_plane + if (allocated(OutData%p_plane)) deallocate(OutData%p_plane) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%p_plane(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%p_plane.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%p_plane) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! x_plane + if (allocated(OutData%x_plane)) deallocate(OutData%x_plane) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_plane(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_plane.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%x_plane) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Vx_wake + if (allocated(OutData%Vx_wake)) deallocate(OutData%Vx_wake) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vx_wake(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_wake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vx_wake) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Vr_wake + if (allocated(OutData%Vr_wake)) deallocate(OutData%Vr_wake) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vr_wake(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vr_wake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vr_wake) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Vx_wake2 + if (allocated(OutData%Vx_wake2)) deallocate(OutData%Vx_wake2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vx_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_wake2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vx_wake2) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Vy_wake2 + if (allocated(OutData%Vy_wake2)) deallocate(OutData%Vy_wake2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vy_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vy_wake2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vy_wake2) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Vz_wake2 + if (allocated(OutData%Vz_wake2)) deallocate(OutData%Vz_wake2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vz_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vz_wake2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vz_wake2) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Vx_wind_disk_filt + if (allocated(OutData%Vx_wind_disk_filt)) deallocate(OutData%Vx_wind_disk_filt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vx_wind_disk_filt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_wind_disk_filt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vx_wind_disk_filt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! TI_amb_filt + if (allocated(OutData%TI_amb_filt)) deallocate(OutData%TI_amb_filt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%TI_amb_filt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI_amb_filt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%TI_amb_filt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! D_rotor_filt + if (allocated(OutData%D_rotor_filt)) deallocate(OutData%D_rotor_filt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%D_rotor_filt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_rotor_filt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%D_rotor_filt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Vx_rel_disk_filt + call RegUnpack(Buf, OutData%Vx_rel_disk_filt) + if (RegCheckErr(Buf, RoutineName)) return + ! Ct_azavg_filt + if (allocated(OutData%Ct_azavg_filt)) deallocate(OutData%Ct_azavg_filt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Ct_azavg_filt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ct_azavg_filt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Ct_azavg_filt) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Cq_azavg_filt + if (allocated(OutData%Cq_azavg_filt)) deallocate(OutData%Cq_azavg_filt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Cq_azavg_filt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cq_azavg_filt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Cq_azavg_filt) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE WD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(WD_ConstraintStateType), INTENT(IN) :: SrcConstrStateData TYPE(WD_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData @@ -2339,103 +1433,26 @@ SUBROUTINE WD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) END SUBROUTINE WD_DestroyConstrState - SUBROUTINE WD_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(WD_ConstraintStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_PackConstrState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyConstrState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE WD_PackConstrState - - SUBROUTINE WD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(WD_ConstraintStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_UnPackConstrState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyConstrState = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE WD_UnPackConstrState +subroutine WD_PackConstrState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WD_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WD_PackConstrState' + if (Buf%ErrStat >= AbortErrLev) return + ! DummyConstrState + call RegPack(Buf, InData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WD_UnPackConstrState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WD_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WD_UnPackConstrState' + if (Buf%ErrStat /= ErrID_None) return + ! DummyConstrState + call RegUnpack(Buf, OutData%DummyConstrState) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE WD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(WD_OtherStateType), INTENT(IN) :: SrcOtherStateData TYPE(WD_OtherStateType), INTENT(INOUT) :: DstOtherStateData @@ -2468,103 +1485,26 @@ SUBROUTINE WD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) END SUBROUTINE WD_DestroyOtherState - SUBROUTINE WD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(WD_OtherStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_PackOtherState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! firstPass - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = TRANSFER(InData%firstPass, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE WD_PackOtherState - - SUBROUTINE WD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(WD_OtherStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_UnPackOtherState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%firstPass = TRANSFER(IntKiBuf(Int_Xferred), OutData%firstPass) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE WD_UnPackOtherState +subroutine WD_PackOtherState(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WD_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WD_PackOtherState' + if (Buf%ErrStat >= AbortErrLev) return + ! firstPass + call RegPack(Buf, InData%firstPass) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WD_UnPackOtherState(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WD_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WD_UnPackOtherState' + if (Buf%ErrStat /= ErrID_None) return + ! firstPass + call RegUnpack(Buf, OutData%firstPass) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE WD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) TYPE(WD_MiscVarType), INTENT(IN) :: SrcMiscData TYPE(WD_MiscVarType), INTENT(INOUT) :: DstMiscData @@ -2950,1079 +1890,497 @@ SUBROUTINE WD_DestroyMisc( MiscData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE WD_DestroyMisc - SUBROUTINE WD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(WD_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! dvtdr allocated yes/no - IF ( ALLOCATED(InData%dvtdr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! dvtdr upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dvtdr) ! dvtdr - END IF - Int_BufSz = Int_BufSz + 1 ! vt_tot allocated yes/no - IF ( ALLOCATED(InData%vt_tot) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! vt_tot upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%vt_tot) ! vt_tot - END IF - Int_BufSz = Int_BufSz + 1 ! vt_amb allocated yes/no - IF ( ALLOCATED(InData%vt_amb) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! vt_amb upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%vt_amb) ! vt_amb - END IF - Int_BufSz = Int_BufSz + 1 ! vt_shr allocated yes/no - IF ( ALLOCATED(InData%vt_shr) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! vt_shr upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%vt_shr) ! vt_shr - END IF - Int_BufSz = Int_BufSz + 1 ! vt_tot2 allocated yes/no - IF ( ALLOCATED(InData%vt_tot2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! vt_tot2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%vt_tot2) ! vt_tot2 - END IF - Int_BufSz = Int_BufSz + 1 ! vt_amb2 allocated yes/no - IF ( ALLOCATED(InData%vt_amb2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! vt_amb2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%vt_amb2) ! vt_amb2 - END IF - Int_BufSz = Int_BufSz + 1 ! vt_shr2 allocated yes/no - IF ( ALLOCATED(InData%vt_shr2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! vt_shr2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%vt_shr2) ! vt_shr2 - END IF - Int_BufSz = Int_BufSz + 1 ! dvx_dy allocated yes/no - IF ( ALLOCATED(InData%dvx_dy) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! dvx_dy upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dvx_dy) ! dvx_dy - END IF - Int_BufSz = Int_BufSz + 1 ! dvx_dz allocated yes/no - IF ( ALLOCATED(InData%dvx_dz) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! dvx_dz upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dvx_dz) ! dvx_dz - END IF - Int_BufSz = Int_BufSz + 1 ! nu_dvx_dy allocated yes/no - IF ( ALLOCATED(InData%nu_dvx_dy) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! nu_dvx_dy upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%nu_dvx_dy) ! nu_dvx_dy - END IF - Int_BufSz = Int_BufSz + 1 ! nu_dvx_dz allocated yes/no - IF ( ALLOCATED(InData%nu_dvx_dz) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! nu_dvx_dz upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%nu_dvx_dz) ! nu_dvx_dz - END IF - Int_BufSz = Int_BufSz + 1 ! dnuvx_dy allocated yes/no - IF ( ALLOCATED(InData%dnuvx_dy) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! dnuvx_dy upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dnuvx_dy) ! dnuvx_dy - END IF - Int_BufSz = Int_BufSz + 1 ! dnuvx_dz allocated yes/no - IF ( ALLOCATED(InData%dnuvx_dz) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! dnuvx_dz upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dnuvx_dz) ! dnuvx_dz - END IF - Int_BufSz = Int_BufSz + 1 ! a allocated yes/no - IF ( ALLOCATED(InData%a) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! a upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%a) ! a - END IF - Int_BufSz = Int_BufSz + 1 ! b allocated yes/no - IF ( ALLOCATED(InData%b) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! b upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%b) ! b - END IF - Int_BufSz = Int_BufSz + 1 ! c allocated yes/no - IF ( ALLOCATED(InData%c) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! c upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%c) ! c - END IF - Int_BufSz = Int_BufSz + 1 ! d allocated yes/no - IF ( ALLOCATED(InData%d) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! d upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%d) ! d - END IF - Int_BufSz = Int_BufSz + 1 ! r_wake allocated yes/no - IF ( ALLOCATED(InData%r_wake) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! r_wake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%r_wake) ! r_wake - END IF - Int_BufSz = Int_BufSz + 1 ! Vx_high allocated yes/no - IF ( ALLOCATED(InData%Vx_high) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Vx_high upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vx_high) ! Vx_high - END IF - Int_BufSz = Int_BufSz + 1 ! Vx_polar allocated yes/no - IF ( ALLOCATED(InData%Vx_polar) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Vx_polar upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vx_polar) ! Vx_polar - END IF - Int_BufSz = Int_BufSz + 1 ! Vt_wake allocated yes/no - IF ( ALLOCATED(InData%Vt_wake) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Vt_wake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vt_wake) ! Vt_wake - END IF - Re_BufSz = Re_BufSz + 1 ! GammaCurl - Re_BufSz = Re_BufSz + 1 ! Ct_avg - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%dvtdr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dvtdr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dvtdr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%dvtdr,1), UBOUND(InData%dvtdr,1) - ReKiBuf(Re_Xferred) = InData%dvtdr(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%vt_tot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vt_tot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vt_tot,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vt_tot,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vt_tot,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%vt_tot,2), UBOUND(InData%vt_tot,2) - DO i1 = LBOUND(InData%vt_tot,1), UBOUND(InData%vt_tot,1) - ReKiBuf(Re_Xferred) = InData%vt_tot(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%vt_amb) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vt_amb,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vt_amb,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vt_amb,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vt_amb,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%vt_amb,2), UBOUND(InData%vt_amb,2) - DO i1 = LBOUND(InData%vt_amb,1), UBOUND(InData%vt_amb,1) - ReKiBuf(Re_Xferred) = InData%vt_amb(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%vt_shr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vt_shr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vt_shr,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vt_shr,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vt_shr,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%vt_shr,2), UBOUND(InData%vt_shr,2) - DO i1 = LBOUND(InData%vt_shr,1), UBOUND(InData%vt_shr,1) - ReKiBuf(Re_Xferred) = InData%vt_shr(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%vt_tot2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vt_tot2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vt_tot2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vt_tot2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vt_tot2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vt_tot2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vt_tot2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%vt_tot2,3), UBOUND(InData%vt_tot2,3) - DO i2 = LBOUND(InData%vt_tot2,2), UBOUND(InData%vt_tot2,2) - DO i1 = LBOUND(InData%vt_tot2,1), UBOUND(InData%vt_tot2,1) - ReKiBuf(Re_Xferred) = InData%vt_tot2(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%vt_amb2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vt_amb2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vt_amb2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vt_amb2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vt_amb2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vt_amb2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vt_amb2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%vt_amb2,3), UBOUND(InData%vt_amb2,3) - DO i2 = LBOUND(InData%vt_amb2,2), UBOUND(InData%vt_amb2,2) - DO i1 = LBOUND(InData%vt_amb2,1), UBOUND(InData%vt_amb2,1) - ReKiBuf(Re_Xferred) = InData%vt_amb2(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%vt_shr2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vt_shr2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vt_shr2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vt_shr2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vt_shr2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vt_shr2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vt_shr2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%vt_shr2,3), UBOUND(InData%vt_shr2,3) - DO i2 = LBOUND(InData%vt_shr2,2), UBOUND(InData%vt_shr2,2) - DO i1 = LBOUND(InData%vt_shr2,1), UBOUND(InData%vt_shr2,1) - ReKiBuf(Re_Xferred) = InData%vt_shr2(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dvx_dy) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dvx_dy,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dvx_dy,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dvx_dy,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dvx_dy,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dvx_dy,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dvx_dy,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%dvx_dy,3), UBOUND(InData%dvx_dy,3) - DO i2 = LBOUND(InData%dvx_dy,2), UBOUND(InData%dvx_dy,2) - DO i1 = LBOUND(InData%dvx_dy,1), UBOUND(InData%dvx_dy,1) - ReKiBuf(Re_Xferred) = InData%dvx_dy(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dvx_dz) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dvx_dz,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dvx_dz,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dvx_dz,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dvx_dz,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dvx_dz,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dvx_dz,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%dvx_dz,3), UBOUND(InData%dvx_dz,3) - DO i2 = LBOUND(InData%dvx_dz,2), UBOUND(InData%dvx_dz,2) - DO i1 = LBOUND(InData%dvx_dz,1), UBOUND(InData%dvx_dz,1) - ReKiBuf(Re_Xferred) = InData%dvx_dz(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%nu_dvx_dy) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%nu_dvx_dy,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nu_dvx_dy,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%nu_dvx_dy,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nu_dvx_dy,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%nu_dvx_dy,2), UBOUND(InData%nu_dvx_dy,2) - DO i1 = LBOUND(InData%nu_dvx_dy,1), UBOUND(InData%nu_dvx_dy,1) - ReKiBuf(Re_Xferred) = InData%nu_dvx_dy(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%nu_dvx_dz) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%nu_dvx_dz,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nu_dvx_dz,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%nu_dvx_dz,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nu_dvx_dz,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%nu_dvx_dz,2), UBOUND(InData%nu_dvx_dz,2) - DO i1 = LBOUND(InData%nu_dvx_dz,1), UBOUND(InData%nu_dvx_dz,1) - ReKiBuf(Re_Xferred) = InData%nu_dvx_dz(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dnuvx_dy) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dnuvx_dy,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dnuvx_dy,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dnuvx_dy,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dnuvx_dy,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%dnuvx_dy,2), UBOUND(InData%dnuvx_dy,2) - DO i1 = LBOUND(InData%dnuvx_dy,1), UBOUND(InData%dnuvx_dy,1) - ReKiBuf(Re_Xferred) = InData%dnuvx_dy(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%dnuvx_dz) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dnuvx_dz,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dnuvx_dz,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dnuvx_dz,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dnuvx_dz,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%dnuvx_dz,2), UBOUND(InData%dnuvx_dz,2) - DO i1 = LBOUND(InData%dnuvx_dz,1), UBOUND(InData%dnuvx_dz,1) - ReKiBuf(Re_Xferred) = InData%dnuvx_dz(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%a) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%a,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%a,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%a,1), UBOUND(InData%a,1) - ReKiBuf(Re_Xferred) = InData%a(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%b) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%b,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%b,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%b,1), UBOUND(InData%b,1) - ReKiBuf(Re_Xferred) = InData%b(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%c) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%c,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%c,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%c,1), UBOUND(InData%c,1) - ReKiBuf(Re_Xferred) = InData%c(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%d) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%d,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%d,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%d,1), UBOUND(InData%d,1) - ReKiBuf(Re_Xferred) = InData%d(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%r_wake) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r_wake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_wake,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%r_wake,1), UBOUND(InData%r_wake,1) - ReKiBuf(Re_Xferred) = InData%r_wake(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vx_high) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vx_high,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_high,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Vx_high,1), UBOUND(InData%Vx_high,1) - ReKiBuf(Re_Xferred) = InData%Vx_high(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vx_polar) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vx_polar,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_polar,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Vx_polar,1), UBOUND(InData%Vx_polar,1) - ReKiBuf(Re_Xferred) = InData%Vx_polar(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vt_wake) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vt_wake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vt_wake,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Vt_wake,1), UBOUND(InData%Vt_wake,1) - ReKiBuf(Re_Xferred) = InData%Vt_wake(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%GammaCurl - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Ct_avg - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE WD_PackMisc - - SUBROUTINE WD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(WD_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dvtdr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%dvtdr)) DEALLOCATE(OutData%dvtdr) - ALLOCATE(OutData%dvtdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dvtdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%dvtdr,1), UBOUND(OutData%dvtdr,1) - OutData%dvtdr(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! vt_tot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%vt_tot)) DEALLOCATE(OutData%vt_tot) - ALLOCATE(OutData%vt_tot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%vt_tot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%vt_tot,2), UBOUND(OutData%vt_tot,2) - DO i1 = LBOUND(OutData%vt_tot,1), UBOUND(OutData%vt_tot,1) - OutData%vt_tot(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! vt_amb not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%vt_amb)) DEALLOCATE(OutData%vt_amb) - ALLOCATE(OutData%vt_amb(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%vt_amb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%vt_amb,2), UBOUND(OutData%vt_amb,2) - DO i1 = LBOUND(OutData%vt_amb,1), UBOUND(OutData%vt_amb,1) - OutData%vt_amb(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! vt_shr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%vt_shr)) DEALLOCATE(OutData%vt_shr) - ALLOCATE(OutData%vt_shr(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%vt_shr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%vt_shr,2), UBOUND(OutData%vt_shr,2) - DO i1 = LBOUND(OutData%vt_shr,1), UBOUND(OutData%vt_shr,1) - OutData%vt_shr(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! vt_tot2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%vt_tot2)) DEALLOCATE(OutData%vt_tot2) - ALLOCATE(OutData%vt_tot2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%vt_tot2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%vt_tot2,3), UBOUND(OutData%vt_tot2,3) - DO i2 = LBOUND(OutData%vt_tot2,2), UBOUND(OutData%vt_tot2,2) - DO i1 = LBOUND(OutData%vt_tot2,1), UBOUND(OutData%vt_tot2,1) - OutData%vt_tot2(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! vt_amb2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%vt_amb2)) DEALLOCATE(OutData%vt_amb2) - ALLOCATE(OutData%vt_amb2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%vt_amb2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%vt_amb2,3), UBOUND(OutData%vt_amb2,3) - DO i2 = LBOUND(OutData%vt_amb2,2), UBOUND(OutData%vt_amb2,2) - DO i1 = LBOUND(OutData%vt_amb2,1), UBOUND(OutData%vt_amb2,1) - OutData%vt_amb2(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! vt_shr2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%vt_shr2)) DEALLOCATE(OutData%vt_shr2) - ALLOCATE(OutData%vt_shr2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%vt_shr2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%vt_shr2,3), UBOUND(OutData%vt_shr2,3) - DO i2 = LBOUND(OutData%vt_shr2,2), UBOUND(OutData%vt_shr2,2) - DO i1 = LBOUND(OutData%vt_shr2,1), UBOUND(OutData%vt_shr2,1) - OutData%vt_shr2(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dvx_dy not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%dvx_dy)) DEALLOCATE(OutData%dvx_dy) - ALLOCATE(OutData%dvx_dy(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dvx_dy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%dvx_dy,3), UBOUND(OutData%dvx_dy,3) - DO i2 = LBOUND(OutData%dvx_dy,2), UBOUND(OutData%dvx_dy,2) - DO i1 = LBOUND(OutData%dvx_dy,1), UBOUND(OutData%dvx_dy,1) - OutData%dvx_dy(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dvx_dz not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%dvx_dz)) DEALLOCATE(OutData%dvx_dz) - ALLOCATE(OutData%dvx_dz(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dvx_dz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%dvx_dz,3), UBOUND(OutData%dvx_dz,3) - DO i2 = LBOUND(OutData%dvx_dz,2), UBOUND(OutData%dvx_dz,2) - DO i1 = LBOUND(OutData%dvx_dz,1), UBOUND(OutData%dvx_dz,1) - OutData%dvx_dz(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nu_dvx_dy not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%nu_dvx_dy)) DEALLOCATE(OutData%nu_dvx_dy) - ALLOCATE(OutData%nu_dvx_dy(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nu_dvx_dy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%nu_dvx_dy,2), UBOUND(OutData%nu_dvx_dy,2) - DO i1 = LBOUND(OutData%nu_dvx_dy,1), UBOUND(OutData%nu_dvx_dy,1) - OutData%nu_dvx_dy(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nu_dvx_dz not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%nu_dvx_dz)) DEALLOCATE(OutData%nu_dvx_dz) - ALLOCATE(OutData%nu_dvx_dz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nu_dvx_dz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%nu_dvx_dz,2), UBOUND(OutData%nu_dvx_dz,2) - DO i1 = LBOUND(OutData%nu_dvx_dz,1), UBOUND(OutData%nu_dvx_dz,1) - OutData%nu_dvx_dz(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dnuvx_dy not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%dnuvx_dy)) DEALLOCATE(OutData%dnuvx_dy) - ALLOCATE(OutData%dnuvx_dy(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dnuvx_dy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%dnuvx_dy,2), UBOUND(OutData%dnuvx_dy,2) - DO i1 = LBOUND(OutData%dnuvx_dy,1), UBOUND(OutData%dnuvx_dy,1) - OutData%dnuvx_dy(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dnuvx_dz not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%dnuvx_dz)) DEALLOCATE(OutData%dnuvx_dz) - ALLOCATE(OutData%dnuvx_dz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dnuvx_dz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%dnuvx_dz,2), UBOUND(OutData%dnuvx_dz,2) - DO i1 = LBOUND(OutData%dnuvx_dz,1), UBOUND(OutData%dnuvx_dz,1) - OutData%dnuvx_dz(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! a not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%a)) DEALLOCATE(OutData%a) - ALLOCATE(OutData%a(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%a.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%a,1), UBOUND(OutData%a,1) - OutData%a(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! b not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%b)) DEALLOCATE(OutData%b) - ALLOCATE(OutData%b(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%b.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%b,1), UBOUND(OutData%b,1) - OutData%b(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! c not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%c)) DEALLOCATE(OutData%c) - ALLOCATE(OutData%c(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%c.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%c,1), UBOUND(OutData%c,1) - OutData%c(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! d not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%d)) DEALLOCATE(OutData%d) - ALLOCATE(OutData%d(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%d.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%d,1), UBOUND(OutData%d,1) - OutData%d(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r_wake not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%r_wake)) DEALLOCATE(OutData%r_wake) - ALLOCATE(OutData%r_wake(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%r_wake,1), UBOUND(OutData%r_wake,1) - OutData%r_wake(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vx_high not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vx_high)) DEALLOCATE(OutData%Vx_high) - ALLOCATE(OutData%Vx_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Vx_high,1), UBOUND(OutData%Vx_high,1) - OutData%Vx_high(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vx_polar not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vx_polar)) DEALLOCATE(OutData%Vx_polar) - ALLOCATE(OutData%Vx_polar(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_polar.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Vx_polar,1), UBOUND(OutData%Vx_polar,1) - OutData%Vx_polar(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vt_wake not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vt_wake)) DEALLOCATE(OutData%Vt_wake) - ALLOCATE(OutData%Vt_wake(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vt_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Vt_wake,1), UBOUND(OutData%Vt_wake,1) - OutData%Vt_wake(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%GammaCurl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Ct_avg = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE WD_UnPackMisc +subroutine WD_PackMisc(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WD_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WD_PackMisc' + if (Buf%ErrStat >= AbortErrLev) return + ! dvtdr + call RegPack(Buf, allocated(InData%dvtdr)) + if (allocated(InData%dvtdr)) then + call RegPackBounds(Buf, 1, lbound(InData%dvtdr), ubound(InData%dvtdr)) + call RegPack(Buf, InData%dvtdr) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! vt_tot + call RegPack(Buf, allocated(InData%vt_tot)) + if (allocated(InData%vt_tot)) then + call RegPackBounds(Buf, 2, lbound(InData%vt_tot), ubound(InData%vt_tot)) + call RegPack(Buf, InData%vt_tot) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! vt_amb + call RegPack(Buf, allocated(InData%vt_amb)) + if (allocated(InData%vt_amb)) then + call RegPackBounds(Buf, 2, lbound(InData%vt_amb), ubound(InData%vt_amb)) + call RegPack(Buf, InData%vt_amb) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! vt_shr + call RegPack(Buf, allocated(InData%vt_shr)) + if (allocated(InData%vt_shr)) then + call RegPackBounds(Buf, 2, lbound(InData%vt_shr), ubound(InData%vt_shr)) + call RegPack(Buf, InData%vt_shr) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! vt_tot2 + call RegPack(Buf, allocated(InData%vt_tot2)) + if (allocated(InData%vt_tot2)) then + call RegPackBounds(Buf, 3, lbound(InData%vt_tot2), ubound(InData%vt_tot2)) + call RegPack(Buf, InData%vt_tot2) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! vt_amb2 + call RegPack(Buf, allocated(InData%vt_amb2)) + if (allocated(InData%vt_amb2)) then + call RegPackBounds(Buf, 3, lbound(InData%vt_amb2), ubound(InData%vt_amb2)) + call RegPack(Buf, InData%vt_amb2) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! vt_shr2 + call RegPack(Buf, allocated(InData%vt_shr2)) + if (allocated(InData%vt_shr2)) then + call RegPackBounds(Buf, 3, lbound(InData%vt_shr2), ubound(InData%vt_shr2)) + call RegPack(Buf, InData%vt_shr2) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! dvx_dy + call RegPack(Buf, allocated(InData%dvx_dy)) + if (allocated(InData%dvx_dy)) then + call RegPackBounds(Buf, 3, lbound(InData%dvx_dy), ubound(InData%dvx_dy)) + call RegPack(Buf, InData%dvx_dy) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! dvx_dz + call RegPack(Buf, allocated(InData%dvx_dz)) + if (allocated(InData%dvx_dz)) then + call RegPackBounds(Buf, 3, lbound(InData%dvx_dz), ubound(InData%dvx_dz)) + call RegPack(Buf, InData%dvx_dz) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! nu_dvx_dy + call RegPack(Buf, allocated(InData%nu_dvx_dy)) + if (allocated(InData%nu_dvx_dy)) then + call RegPackBounds(Buf, 2, lbound(InData%nu_dvx_dy), ubound(InData%nu_dvx_dy)) + call RegPack(Buf, InData%nu_dvx_dy) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! nu_dvx_dz + call RegPack(Buf, allocated(InData%nu_dvx_dz)) + if (allocated(InData%nu_dvx_dz)) then + call RegPackBounds(Buf, 2, lbound(InData%nu_dvx_dz), ubound(InData%nu_dvx_dz)) + call RegPack(Buf, InData%nu_dvx_dz) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! dnuvx_dy + call RegPack(Buf, allocated(InData%dnuvx_dy)) + if (allocated(InData%dnuvx_dy)) then + call RegPackBounds(Buf, 2, lbound(InData%dnuvx_dy), ubound(InData%dnuvx_dy)) + call RegPack(Buf, InData%dnuvx_dy) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! dnuvx_dz + call RegPack(Buf, allocated(InData%dnuvx_dz)) + if (allocated(InData%dnuvx_dz)) then + call RegPackBounds(Buf, 2, lbound(InData%dnuvx_dz), ubound(InData%dnuvx_dz)) + call RegPack(Buf, InData%dnuvx_dz) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! a + call RegPack(Buf, allocated(InData%a)) + if (allocated(InData%a)) then + call RegPackBounds(Buf, 1, lbound(InData%a), ubound(InData%a)) + call RegPack(Buf, InData%a) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! b + call RegPack(Buf, allocated(InData%b)) + if (allocated(InData%b)) then + call RegPackBounds(Buf, 1, lbound(InData%b), ubound(InData%b)) + call RegPack(Buf, InData%b) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! c + call RegPack(Buf, allocated(InData%c)) + if (allocated(InData%c)) then + call RegPackBounds(Buf, 1, lbound(InData%c), ubound(InData%c)) + call RegPack(Buf, InData%c) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! d + call RegPack(Buf, allocated(InData%d)) + if (allocated(InData%d)) then + call RegPackBounds(Buf, 1, lbound(InData%d), ubound(InData%d)) + call RegPack(Buf, InData%d) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! r_wake + call RegPack(Buf, allocated(InData%r_wake)) + if (allocated(InData%r_wake)) then + call RegPackBounds(Buf, 1, lbound(InData%r_wake), ubound(InData%r_wake)) + call RegPack(Buf, InData%r_wake) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Vx_high + call RegPack(Buf, allocated(InData%Vx_high)) + if (allocated(InData%Vx_high)) then + call RegPackBounds(Buf, 1, lbound(InData%Vx_high), ubound(InData%Vx_high)) + call RegPack(Buf, InData%Vx_high) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Vx_polar + call RegPack(Buf, allocated(InData%Vx_polar)) + if (allocated(InData%Vx_polar)) then + call RegPackBounds(Buf, 1, lbound(InData%Vx_polar), ubound(InData%Vx_polar)) + call RegPack(Buf, InData%Vx_polar) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Vt_wake + call RegPack(Buf, allocated(InData%Vt_wake)) + if (allocated(InData%Vt_wake)) then + call RegPackBounds(Buf, 1, lbound(InData%Vt_wake), ubound(InData%Vt_wake)) + call RegPack(Buf, InData%Vt_wake) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! GammaCurl + call RegPack(Buf, InData%GammaCurl) + if (RegCheckErr(Buf, RoutineName)) return + ! Ct_avg + call RegPack(Buf, InData%Ct_avg) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WD_UnPackMisc(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WD_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WD_UnPackMisc' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! dvtdr + if (allocated(OutData%dvtdr)) deallocate(OutData%dvtdr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dvtdr(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dvtdr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dvtdr) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! vt_tot + if (allocated(OutData%vt_tot)) deallocate(OutData%vt_tot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%vt_tot(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%vt_tot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%vt_tot) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! vt_amb + if (allocated(OutData%vt_amb)) deallocate(OutData%vt_amb) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%vt_amb(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%vt_amb.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%vt_amb) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! vt_shr + if (allocated(OutData%vt_shr)) deallocate(OutData%vt_shr) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%vt_shr(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%vt_shr.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%vt_shr) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! vt_tot2 + if (allocated(OutData%vt_tot2)) deallocate(OutData%vt_tot2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%vt_tot2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%vt_tot2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%vt_tot2) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! vt_amb2 + if (allocated(OutData%vt_amb2)) deallocate(OutData%vt_amb2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%vt_amb2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%vt_amb2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%vt_amb2) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! vt_shr2 + if (allocated(OutData%vt_shr2)) deallocate(OutData%vt_shr2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%vt_shr2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%vt_shr2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%vt_shr2) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! dvx_dy + if (allocated(OutData%dvx_dy)) deallocate(OutData%dvx_dy) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dvx_dy(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dvx_dy.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dvx_dy) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! dvx_dz + if (allocated(OutData%dvx_dz)) deallocate(OutData%dvx_dz) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dvx_dz(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dvx_dz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dvx_dz) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! nu_dvx_dy + if (allocated(OutData%nu_dvx_dy)) deallocate(OutData%nu_dvx_dy) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%nu_dvx_dy(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%nu_dvx_dy.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%nu_dvx_dy) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! nu_dvx_dz + if (allocated(OutData%nu_dvx_dz)) deallocate(OutData%nu_dvx_dz) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%nu_dvx_dz(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%nu_dvx_dz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%nu_dvx_dz) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! dnuvx_dy + if (allocated(OutData%dnuvx_dy)) deallocate(OutData%dnuvx_dy) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dnuvx_dy(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dnuvx_dy.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dnuvx_dy) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! dnuvx_dz + if (allocated(OutData%dnuvx_dz)) deallocate(OutData%dnuvx_dz) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%dnuvx_dz(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dnuvx_dz.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%dnuvx_dz) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! a + if (allocated(OutData%a)) deallocate(OutData%a) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%a(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%a.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%a) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! b + if (allocated(OutData%b)) deallocate(OutData%b) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%b(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%b.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%b) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! c + if (allocated(OutData%c)) deallocate(OutData%c) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%c(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%c.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%c) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! d + if (allocated(OutData%d)) deallocate(OutData%d) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%d(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%d.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%d) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! r_wake + if (allocated(OutData%r_wake)) deallocate(OutData%r_wake) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%r_wake(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_wake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%r_wake) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Vx_high + if (allocated(OutData%Vx_high)) deallocate(OutData%Vx_high) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vx_high(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_high.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vx_high) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Vx_polar + if (allocated(OutData%Vx_polar)) deallocate(OutData%Vx_polar) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vx_polar(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_polar.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vx_polar) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Vt_wake + if (allocated(OutData%Vt_wake)) deallocate(OutData%Vt_wake) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vt_wake(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vt_wake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vt_wake) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! GammaCurl + call RegUnpack(Buf, OutData%GammaCurl) + if (RegCheckErr(Buf, RoutineName)) return + ! Ct_avg + call RegUnpack(Buf, OutData%Ct_avg) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE WD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(WD_ParameterType), INTENT(IN) :: SrcParamData TYPE(WD_ParameterType), INTENT(INOUT) :: DstParamData @@ -4137,406 +2495,311 @@ SUBROUTINE WD_DestroyParam( ParamData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE WD_DestroyParam - SUBROUTINE WD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(WD_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! dt_low - Int_BufSz = Int_BufSz + 1 ! NumPlanes - Int_BufSz = Int_BufSz + 1 ! NumRadii - Re_BufSz = Re_BufSz + 1 ! dr - Int_BufSz = Int_BufSz + 1 ! r allocated yes/no - IF ( ALLOCATED(InData%r) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! r upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%r) ! r - END IF - Int_BufSz = Int_BufSz + 1 ! y allocated yes/no - IF ( ALLOCATED(InData%y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%y) ! y - END IF - Int_BufSz = Int_BufSz + 1 ! z allocated yes/no - IF ( ALLOCATED(InData%z) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! z upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%z) ! z - END IF - Int_BufSz = Int_BufSz + 1 ! Mod_Wake - Int_BufSz = Int_BufSz + 1 ! Swirl - Re_BufSz = Re_BufSz + 1 ! k_VortexDecay - Re_BufSz = Re_BufSz + 1 ! sigma_D - Int_BufSz = Int_BufSz + 1 ! NumVortices - Re_BufSz = Re_BufSz + 1 ! filtParam - Re_BufSz = Re_BufSz + 1 ! oneMinusFiltParam - Re_BufSz = Re_BufSz + 1 ! C_HWkDfl_O - Re_BufSz = Re_BufSz + 1 ! C_HWkDfl_OY - Re_BufSz = Re_BufSz + 1 ! C_HWkDfl_x - Re_BufSz = Re_BufSz + 1 ! C_HWkDfl_xY - Re_BufSz = Re_BufSz + 1 ! C_NearWake - Re_BufSz = Re_BufSz + 1 ! C_vAmb_DMin - Re_BufSz = Re_BufSz + 1 ! C_vAmb_DMax - Re_BufSz = Re_BufSz + 1 ! C_vAmb_FMin - Re_BufSz = Re_BufSz + 1 ! C_vAmb_Exp - Re_BufSz = Re_BufSz + 1 ! C_vShr_DMin - Re_BufSz = Re_BufSz + 1 ! C_vShr_DMax - Re_BufSz = Re_BufSz + 1 ! C_vShr_FMin - Re_BufSz = Re_BufSz + 1 ! C_vShr_Exp - Re_BufSz = Re_BufSz + 1 ! k_vAmb - Re_BufSz = Re_BufSz + 1 ! k_vShr - Int_BufSz = Int_BufSz + 1 ! Mod_WakeDiam - Re_BufSz = Re_BufSz + 1 ! C_WakeDiam - Int_BufSz = Int_BufSz + 1 ! FilterInit - Re_BufSz = Re_BufSz + 1 ! k_vCurl - Int_BufSz = Int_BufSz + 1 ! OutAllPlanes - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFileRoot) ! OutFileRoot - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFileVTKDir) ! OutFileVTKDir - Int_BufSz = Int_BufSz + 1 ! TurbNum - Int_BufSz = Int_BufSz + 1 ! WAT - Re_BufSz = Re_BufSz + 1 ! WAT_k_Def - Re_BufSz = Re_BufSz + 1 ! WAT_k_Grad - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%dt_low - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumPlanes - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumRadii - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dr - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%r) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%r,1), UBOUND(InData%r,1) - ReKiBuf(Re_Xferred) = InData%r(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) - ReKiBuf(Re_Xferred) = InData%y(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%z) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - ReKiBuf(Re_Xferred) = InData%z(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%Mod_Wake - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%Swirl, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k_VortexDecay - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%sigma_D - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumVortices - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%filtParam - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%oneMinusFiltParam - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_HWkDfl_O - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_HWkDfl_OY - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_HWkDfl_x - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_HWkDfl_xY - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_NearWake - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vAmb_DMin - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vAmb_DMax - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vAmb_FMin - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vAmb_Exp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vShr_DMin - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vShr_DMax - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vShr_FMin - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_vShr_Exp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k_vAmb - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k_vShr - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%Mod_WakeDiam - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%C_WakeDiam - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%FilterInit - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%k_vCurl - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%OutAllPlanes, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFileRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFileRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutFileVTKDir) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFileVTKDir(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%TurbNum - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WAT, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WAT_k_Def - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WAT_k_Grad - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE WD_PackParam - - SUBROUTINE WD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(WD_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%dt_low = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%NumPlanes = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumRadii = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%dr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%r)) DEALLOCATE(OutData%r) - ALLOCATE(OutData%r(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%r.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%r,1), UBOUND(OutData%r,1) - OutData%r(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%y)) DEALLOCATE(OutData%y) - ALLOCATE(OutData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) - OutData%y(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%z)) DEALLOCATE(OutData%z) - ALLOCATE(OutData%z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) - OutData%z(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%Mod_Wake = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Swirl = TRANSFER(IntKiBuf(Int_Xferred), OutData%Swirl) - Int_Xferred = Int_Xferred + 1 - OutData%k_VortexDecay = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%sigma_D = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NumVortices = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%filtParam = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%oneMinusFiltParam = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_HWkDfl_O = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_HWkDfl_OY = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_HWkDfl_x = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_HWkDfl_xY = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_NearWake = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vAmb_DMin = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vAmb_DMax = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vAmb_FMin = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vAmb_Exp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vShr_DMin = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vShr_DMax = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vShr_FMin = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%C_vShr_Exp = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k_vAmb = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%k_vShr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Mod_WakeDiam = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%C_WakeDiam = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%FilterInit = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%k_vCurl = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%OutAllPlanes = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutAllPlanes) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFileRoot) - OutData%OutFileRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutFileVTKDir) - OutData%OutFileVTKDir(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%TurbNum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WAT = TRANSFER(IntKiBuf(Int_Xferred), OutData%WAT) - Int_Xferred = Int_Xferred + 1 - OutData%WAT_k_Def = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WAT_k_Grad = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE WD_UnPackParam +subroutine WD_PackParam(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WD_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WD_PackParam' + if (Buf%ErrStat >= AbortErrLev) return + ! dt_low + call RegPack(Buf, InData%dt_low) + if (RegCheckErr(Buf, RoutineName)) return + ! NumPlanes + call RegPack(Buf, InData%NumPlanes) + if (RegCheckErr(Buf, RoutineName)) return + ! NumRadii + call RegPack(Buf, InData%NumRadii) + if (RegCheckErr(Buf, RoutineName)) return + ! dr + call RegPack(Buf, InData%dr) + if (RegCheckErr(Buf, RoutineName)) return + ! r + call RegPack(Buf, allocated(InData%r)) + if (allocated(InData%r)) then + call RegPackBounds(Buf, 1, lbound(InData%r), ubound(InData%r)) + call RegPack(Buf, InData%r) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! y + call RegPack(Buf, allocated(InData%y)) + if (allocated(InData%y)) then + call RegPackBounds(Buf, 1, lbound(InData%y), ubound(InData%y)) + call RegPack(Buf, InData%y) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! z + call RegPack(Buf, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(Buf, 1, lbound(InData%z), ubound(InData%z)) + call RegPack(Buf, InData%z) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Mod_Wake + call RegPack(Buf, InData%Mod_Wake) + if (RegCheckErr(Buf, RoutineName)) return + ! Swirl + call RegPack(Buf, InData%Swirl) + if (RegCheckErr(Buf, RoutineName)) return + ! k_VortexDecay + call RegPack(Buf, InData%k_VortexDecay) + if (RegCheckErr(Buf, RoutineName)) return + ! sigma_D + call RegPack(Buf, InData%sigma_D) + if (RegCheckErr(Buf, RoutineName)) return + ! NumVortices + call RegPack(Buf, InData%NumVortices) + if (RegCheckErr(Buf, RoutineName)) return + ! filtParam + call RegPack(Buf, InData%filtParam) + if (RegCheckErr(Buf, RoutineName)) return + ! oneMinusFiltParam + call RegPack(Buf, InData%oneMinusFiltParam) + if (RegCheckErr(Buf, RoutineName)) return + ! C_HWkDfl_O + call RegPack(Buf, InData%C_HWkDfl_O) + if (RegCheckErr(Buf, RoutineName)) return + ! C_HWkDfl_OY + call RegPack(Buf, InData%C_HWkDfl_OY) + if (RegCheckErr(Buf, RoutineName)) return + ! C_HWkDfl_x + call RegPack(Buf, InData%C_HWkDfl_x) + if (RegCheckErr(Buf, RoutineName)) return + ! C_HWkDfl_xY + call RegPack(Buf, InData%C_HWkDfl_xY) + if (RegCheckErr(Buf, RoutineName)) return + ! C_NearWake + call RegPack(Buf, InData%C_NearWake) + if (RegCheckErr(Buf, RoutineName)) return + ! C_vAmb_DMin + call RegPack(Buf, InData%C_vAmb_DMin) + if (RegCheckErr(Buf, RoutineName)) return + ! C_vAmb_DMax + call RegPack(Buf, InData%C_vAmb_DMax) + if (RegCheckErr(Buf, RoutineName)) return + ! C_vAmb_FMin + call RegPack(Buf, InData%C_vAmb_FMin) + if (RegCheckErr(Buf, RoutineName)) return + ! C_vAmb_Exp + call RegPack(Buf, InData%C_vAmb_Exp) + if (RegCheckErr(Buf, RoutineName)) return + ! C_vShr_DMin + call RegPack(Buf, InData%C_vShr_DMin) + if (RegCheckErr(Buf, RoutineName)) return + ! C_vShr_DMax + call RegPack(Buf, InData%C_vShr_DMax) + if (RegCheckErr(Buf, RoutineName)) return + ! C_vShr_FMin + call RegPack(Buf, InData%C_vShr_FMin) + if (RegCheckErr(Buf, RoutineName)) return + ! C_vShr_Exp + call RegPack(Buf, InData%C_vShr_Exp) + if (RegCheckErr(Buf, RoutineName)) return + ! k_vAmb + call RegPack(Buf, InData%k_vAmb) + if (RegCheckErr(Buf, RoutineName)) return + ! k_vShr + call RegPack(Buf, InData%k_vShr) + if (RegCheckErr(Buf, RoutineName)) return + ! Mod_WakeDiam + call RegPack(Buf, InData%Mod_WakeDiam) + if (RegCheckErr(Buf, RoutineName)) return + ! C_WakeDiam + call RegPack(Buf, InData%C_WakeDiam) + if (RegCheckErr(Buf, RoutineName)) return + ! FilterInit + call RegPack(Buf, InData%FilterInit) + if (RegCheckErr(Buf, RoutineName)) return + ! k_vCurl + call RegPack(Buf, InData%k_vCurl) + if (RegCheckErr(Buf, RoutineName)) return + ! OutAllPlanes + call RegPack(Buf, InData%OutAllPlanes) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFileRoot + call RegPack(Buf, InData%OutFileRoot) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFileVTKDir + call RegPack(Buf, InData%OutFileVTKDir) + if (RegCheckErr(Buf, RoutineName)) return + ! TurbNum + call RegPack(Buf, InData%TurbNum) + if (RegCheckErr(Buf, RoutineName)) return + ! WAT + call RegPack(Buf, InData%WAT) + if (RegCheckErr(Buf, RoutineName)) return + ! WAT_k_Def + call RegPack(Buf, InData%WAT_k_Def) + if (RegCheckErr(Buf, RoutineName)) return + ! WAT_k_Grad + call RegPack(Buf, InData%WAT_k_Grad) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WD_UnPackParam(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WD_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WD_UnPackParam' + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! dt_low + call RegUnpack(Buf, OutData%dt_low) + if (RegCheckErr(Buf, RoutineName)) return + ! NumPlanes + call RegUnpack(Buf, OutData%NumPlanes) + if (RegCheckErr(Buf, RoutineName)) return + ! NumRadii + call RegUnpack(Buf, OutData%NumRadii) + if (RegCheckErr(Buf, RoutineName)) return + ! dr + call RegUnpack(Buf, OutData%dr) + if (RegCheckErr(Buf, RoutineName)) return + ! r + if (allocated(OutData%r)) deallocate(OutData%r) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%r(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%r.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%r) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! y + if (allocated(OutData%y)) deallocate(OutData%y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%y) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! z + if (allocated(OutData%z)) deallocate(OutData%z) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%z) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Mod_Wake + call RegUnpack(Buf, OutData%Mod_Wake) + if (RegCheckErr(Buf, RoutineName)) return + ! Swirl + call RegUnpack(Buf, OutData%Swirl) + if (RegCheckErr(Buf, RoutineName)) return + ! k_VortexDecay + call RegUnpack(Buf, OutData%k_VortexDecay) + if (RegCheckErr(Buf, RoutineName)) return + ! sigma_D + call RegUnpack(Buf, OutData%sigma_D) + if (RegCheckErr(Buf, RoutineName)) return + ! NumVortices + call RegUnpack(Buf, OutData%NumVortices) + if (RegCheckErr(Buf, RoutineName)) return + ! filtParam + call RegUnpack(Buf, OutData%filtParam) + if (RegCheckErr(Buf, RoutineName)) return + ! oneMinusFiltParam + call RegUnpack(Buf, OutData%oneMinusFiltParam) + if (RegCheckErr(Buf, RoutineName)) return + ! C_HWkDfl_O + call RegUnpack(Buf, OutData%C_HWkDfl_O) + if (RegCheckErr(Buf, RoutineName)) return + ! C_HWkDfl_OY + call RegUnpack(Buf, OutData%C_HWkDfl_OY) + if (RegCheckErr(Buf, RoutineName)) return + ! C_HWkDfl_x + call RegUnpack(Buf, OutData%C_HWkDfl_x) + if (RegCheckErr(Buf, RoutineName)) return + ! C_HWkDfl_xY + call RegUnpack(Buf, OutData%C_HWkDfl_xY) + if (RegCheckErr(Buf, RoutineName)) return + ! C_NearWake + call RegUnpack(Buf, OutData%C_NearWake) + if (RegCheckErr(Buf, RoutineName)) return + ! C_vAmb_DMin + call RegUnpack(Buf, OutData%C_vAmb_DMin) + if (RegCheckErr(Buf, RoutineName)) return + ! C_vAmb_DMax + call RegUnpack(Buf, OutData%C_vAmb_DMax) + if (RegCheckErr(Buf, RoutineName)) return + ! C_vAmb_FMin + call RegUnpack(Buf, OutData%C_vAmb_FMin) + if (RegCheckErr(Buf, RoutineName)) return + ! C_vAmb_Exp + call RegUnpack(Buf, OutData%C_vAmb_Exp) + if (RegCheckErr(Buf, RoutineName)) return + ! C_vShr_DMin + call RegUnpack(Buf, OutData%C_vShr_DMin) + if (RegCheckErr(Buf, RoutineName)) return + ! C_vShr_DMax + call RegUnpack(Buf, OutData%C_vShr_DMax) + if (RegCheckErr(Buf, RoutineName)) return + ! C_vShr_FMin + call RegUnpack(Buf, OutData%C_vShr_FMin) + if (RegCheckErr(Buf, RoutineName)) return + ! C_vShr_Exp + call RegUnpack(Buf, OutData%C_vShr_Exp) + if (RegCheckErr(Buf, RoutineName)) return + ! k_vAmb + call RegUnpack(Buf, OutData%k_vAmb) + if (RegCheckErr(Buf, RoutineName)) return + ! k_vShr + call RegUnpack(Buf, OutData%k_vShr) + if (RegCheckErr(Buf, RoutineName)) return + ! Mod_WakeDiam + call RegUnpack(Buf, OutData%Mod_WakeDiam) + if (RegCheckErr(Buf, RoutineName)) return + ! C_WakeDiam + call RegUnpack(Buf, OutData%C_WakeDiam) + if (RegCheckErr(Buf, RoutineName)) return + ! FilterInit + call RegUnpack(Buf, OutData%FilterInit) + if (RegCheckErr(Buf, RoutineName)) return + ! k_vCurl + call RegUnpack(Buf, OutData%k_vCurl) + if (RegCheckErr(Buf, RoutineName)) return + ! OutAllPlanes + call RegUnpack(Buf, OutData%OutAllPlanes) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFileRoot + call RegUnpack(Buf, OutData%OutFileRoot) + if (RegCheckErr(Buf, RoutineName)) return + ! OutFileVTKDir + call RegUnpack(Buf, OutData%OutFileVTKDir) + if (RegCheckErr(Buf, RoutineName)) return + ! TurbNum + call RegUnpack(Buf, OutData%TurbNum) + if (RegCheckErr(Buf, RoutineName)) return + ! WAT + call RegUnpack(Buf, OutData%WAT) + if (RegCheckErr(Buf, RoutineName)) return + ! WAT_k_Def + call RegUnpack(Buf, OutData%WAT_k_Def) + if (RegCheckErr(Buf, RoutineName)) return + ! WAT_k_Grad + call RegUnpack(Buf, OutData%WAT_k_Grad) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine SUBROUTINE WD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(WD_InputType), INTENT(IN) :: SrcInputData TYPE(WD_InputType), INTENT(INOUT) :: DstInputData @@ -4626,281 +2889,143 @@ SUBROUTINE WD_DestroyInput( InputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE WD_DestroyInput - SUBROUTINE WD_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(WD_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + SIZE(InData%xhat_disk) ! xhat_disk - Re_BufSz = Re_BufSz + 1 ! YawErr - Re_BufSz = Re_BufSz + 1 ! psi_skew - Re_BufSz = Re_BufSz + 1 ! chi_skew - Re_BufSz = Re_BufSz + SIZE(InData%p_hub) ! p_hub - Int_BufSz = Int_BufSz + 1 ! V_plane allocated yes/no - IF ( ALLOCATED(InData%V_plane) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! V_plane upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%V_plane) ! V_plane - END IF - Re_BufSz = Re_BufSz + 1 ! Vx_wind_disk - Re_BufSz = Re_BufSz + 1 ! TI_amb - Re_BufSz = Re_BufSz + 1 ! D_rotor - Re_BufSz = Re_BufSz + 1 ! Vx_rel_disk - Int_BufSz = Int_BufSz + 1 ! Ct_azavg allocated yes/no - IF ( ALLOCATED(InData%Ct_azavg) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Ct_azavg upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Ct_azavg) ! Ct_azavg - END IF - Int_BufSz = Int_BufSz + 1 ! Cq_azavg allocated yes/no - IF ( ALLOCATED(InData%Cq_azavg) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Cq_azavg upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cq_azavg) ! Cq_azavg - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i1 = LBOUND(InData%xhat_disk,1), UBOUND(InData%xhat_disk,1) - ReKiBuf(Re_Xferred) = InData%xhat_disk(i1) - Re_Xferred = Re_Xferred + 1 - END DO - ReKiBuf(Re_Xferred) = InData%YawErr - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%psi_skew - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%chi_skew - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%p_hub,1), UBOUND(InData%p_hub,1) - ReKiBuf(Re_Xferred) = InData%p_hub(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%V_plane) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%V_plane,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V_plane,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%V_plane,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V_plane,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%V_plane,2), UBOUND(InData%V_plane,2) - DO i1 = LBOUND(InData%V_plane,1), UBOUND(InData%V_plane,1) - ReKiBuf(Re_Xferred) = InData%V_plane(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%Vx_wind_disk - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TI_amb - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%D_rotor - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Vx_rel_disk - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Ct_azavg) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Ct_azavg,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ct_azavg,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Ct_azavg,1), UBOUND(InData%Ct_azavg,1) - ReKiBuf(Re_Xferred) = InData%Ct_azavg(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cq_azavg) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cq_azavg,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cq_azavg,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Cq_azavg,1), UBOUND(InData%Cq_azavg,1) - ReKiBuf(Re_Xferred) = InData%Cq_azavg(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE WD_PackInput - - SUBROUTINE WD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(WD_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%xhat_disk,1) - i1_u = UBOUND(OutData%xhat_disk,1) - DO i1 = LBOUND(OutData%xhat_disk,1), UBOUND(OutData%xhat_disk,1) - OutData%xhat_disk(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - OutData%YawErr = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%psi_skew = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%chi_skew = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%p_hub,1) - i1_u = UBOUND(OutData%p_hub,1) - DO i1 = LBOUND(OutData%p_hub,1), UBOUND(OutData%p_hub,1) - OutData%p_hub(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! V_plane not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%V_plane)) DEALLOCATE(OutData%V_plane) - ALLOCATE(OutData%V_plane(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%V_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%V_plane,2), UBOUND(OutData%V_plane,2) - DO i1 = LBOUND(OutData%V_plane,1), UBOUND(OutData%V_plane,1) - OutData%V_plane(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%Vx_wind_disk = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TI_amb = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%D_rotor = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%Vx_rel_disk = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ct_azavg not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Ct_azavg)) DEALLOCATE(OutData%Ct_azavg) - ALLOCATE(OutData%Ct_azavg(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ct_azavg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Ct_azavg,1), UBOUND(OutData%Ct_azavg,1) - OutData%Ct_azavg(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cq_azavg not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Cq_azavg)) DEALLOCATE(OutData%Cq_azavg) - ALLOCATE(OutData%Cq_azavg(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cq_azavg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Cq_azavg,1), UBOUND(OutData%Cq_azavg,1) - OutData%Cq_azavg(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE WD_UnPackInput +subroutine WD_PackInput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WD_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WD_PackInput' + if (Buf%ErrStat >= AbortErrLev) return + ! xhat_disk + call RegPack(Buf, InData%xhat_disk) + if (RegCheckErr(Buf, RoutineName)) return + ! YawErr + call RegPack(Buf, InData%YawErr) + if (RegCheckErr(Buf, RoutineName)) return + ! psi_skew + call RegPack(Buf, InData%psi_skew) + if (RegCheckErr(Buf, RoutineName)) return + ! chi_skew + call RegPack(Buf, InData%chi_skew) + if (RegCheckErr(Buf, RoutineName)) return + ! p_hub + call RegPack(Buf, InData%p_hub) + if (RegCheckErr(Buf, RoutineName)) return + ! V_plane + call RegPack(Buf, allocated(InData%V_plane)) + if (allocated(InData%V_plane)) then + call RegPackBounds(Buf, 2, lbound(InData%V_plane), ubound(InData%V_plane)) + call RegPack(Buf, InData%V_plane) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Vx_wind_disk + call RegPack(Buf, InData%Vx_wind_disk) + if (RegCheckErr(Buf, RoutineName)) return + ! TI_amb + call RegPack(Buf, InData%TI_amb) + if (RegCheckErr(Buf, RoutineName)) return + ! D_rotor + call RegPack(Buf, InData%D_rotor) + if (RegCheckErr(Buf, RoutineName)) return + ! Vx_rel_disk + call RegPack(Buf, InData%Vx_rel_disk) + if (RegCheckErr(Buf, RoutineName)) return + ! Ct_azavg + call RegPack(Buf, allocated(InData%Ct_azavg)) + if (allocated(InData%Ct_azavg)) then + call RegPackBounds(Buf, 1, lbound(InData%Ct_azavg), ubound(InData%Ct_azavg)) + call RegPack(Buf, InData%Ct_azavg) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Cq_azavg + call RegPack(Buf, allocated(InData%Cq_azavg)) + if (allocated(InData%Cq_azavg)) then + call RegPackBounds(Buf, 1, lbound(InData%Cq_azavg), ubound(InData%Cq_azavg)) + call RegPack(Buf, InData%Cq_azavg) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WD_UnPackInput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WD_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WD_UnPackInput' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! xhat_disk + call RegUnpack(Buf, OutData%xhat_disk) + if (RegCheckErr(Buf, RoutineName)) return + ! YawErr + call RegUnpack(Buf, OutData%YawErr) + if (RegCheckErr(Buf, RoutineName)) return + ! psi_skew + call RegUnpack(Buf, OutData%psi_skew) + if (RegCheckErr(Buf, RoutineName)) return + ! chi_skew + call RegUnpack(Buf, OutData%chi_skew) + if (RegCheckErr(Buf, RoutineName)) return + ! p_hub + call RegUnpack(Buf, OutData%p_hub) + if (RegCheckErr(Buf, RoutineName)) return + ! V_plane + if (allocated(OutData%V_plane)) deallocate(OutData%V_plane) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%V_plane(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%V_plane.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%V_plane) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Vx_wind_disk + call RegUnpack(Buf, OutData%Vx_wind_disk) + if (RegCheckErr(Buf, RoutineName)) return + ! TI_amb + call RegUnpack(Buf, OutData%TI_amb) + if (RegCheckErr(Buf, RoutineName)) return + ! D_rotor + call RegUnpack(Buf, OutData%D_rotor) + if (RegCheckErr(Buf, RoutineName)) return + ! Vx_rel_disk + call RegUnpack(Buf, OutData%Vx_rel_disk) + if (RegCheckErr(Buf, RoutineName)) return + ! Ct_azavg + if (allocated(OutData%Ct_azavg)) deallocate(OutData%Ct_azavg) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Ct_azavg(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ct_azavg.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Ct_azavg) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Cq_azavg + if (allocated(OutData%Cq_azavg)) deallocate(OutData%Cq_azavg) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Cq_azavg(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cq_azavg.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Cq_azavg) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine SUBROUTINE WD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(WD_OutputType), INTENT(IN) :: SrcOutputData TYPE(WD_OutputType), INTENT(INOUT) :: DstOutputData @@ -5109,600 +3234,242 @@ SUBROUTINE WD_DestroyOutput( OutputData, ErrStat, ErrMsg ) ENDIF END SUBROUTINE WD_DestroyOutput - SUBROUTINE WD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(WD_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! xhat_plane allocated yes/no - IF ( ALLOCATED(InData%xhat_plane) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! xhat_plane upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%xhat_plane) ! xhat_plane - END IF - Int_BufSz = Int_BufSz + 1 ! p_plane allocated yes/no - IF ( ALLOCATED(InData%p_plane) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! p_plane upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%p_plane) ! p_plane - END IF - Int_BufSz = Int_BufSz + 1 ! Vx_wake allocated yes/no - IF ( ALLOCATED(InData%Vx_wake) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vx_wake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vx_wake) ! Vx_wake - END IF - Int_BufSz = Int_BufSz + 1 ! Vr_wake allocated yes/no - IF ( ALLOCATED(InData%Vr_wake) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vr_wake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vr_wake) ! Vr_wake - END IF - Int_BufSz = Int_BufSz + 1 ! Vx_wake2 allocated yes/no - IF ( ALLOCATED(InData%Vx_wake2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Vx_wake2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vx_wake2) ! Vx_wake2 - END IF - Int_BufSz = Int_BufSz + 1 ! Vy_wake2 allocated yes/no - IF ( ALLOCATED(InData%Vy_wake2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Vy_wake2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vy_wake2) ! Vy_wake2 - END IF - Int_BufSz = Int_BufSz + 1 ! Vz_wake2 allocated yes/no - IF ( ALLOCATED(InData%Vz_wake2) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Vz_wake2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vz_wake2) ! Vz_wake2 - END IF - Int_BufSz = Int_BufSz + 1 ! D_wake allocated yes/no - IF ( ALLOCATED(InData%D_wake) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! D_wake upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%D_wake) ! D_wake - END IF - Int_BufSz = Int_BufSz + 1 ! x_plane allocated yes/no - IF ( ALLOCATED(InData%x_plane) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! x_plane upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%x_plane) ! x_plane - END IF - Int_BufSz = Int_BufSz + 1 ! WAT_k_mt allocated yes/no - IF ( ALLOCATED(InData%WAT_k_mt) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WAT_k_mt upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WAT_k_mt) ! WAT_k_mt - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%xhat_plane) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xhat_plane,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xhat_plane,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xhat_plane,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xhat_plane,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%xhat_plane,2), UBOUND(InData%xhat_plane,2) - DO i1 = LBOUND(InData%xhat_plane,1), UBOUND(InData%xhat_plane,1) - ReKiBuf(Re_Xferred) = InData%xhat_plane(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%p_plane) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%p_plane,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%p_plane,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%p_plane,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%p_plane,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%p_plane,2), UBOUND(InData%p_plane,2) - DO i1 = LBOUND(InData%p_plane,1), UBOUND(InData%p_plane,1) - ReKiBuf(Re_Xferred) = InData%p_plane(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vx_wake) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vx_wake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_wake,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vx_wake,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_wake,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vx_wake,2), UBOUND(InData%Vx_wake,2) - DO i1 = LBOUND(InData%Vx_wake,1), UBOUND(InData%Vx_wake,1) - ReKiBuf(Re_Xferred) = InData%Vx_wake(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vr_wake) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vr_wake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vr_wake,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vr_wake,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vr_wake,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Vr_wake,2), UBOUND(InData%Vr_wake,2) - DO i1 = LBOUND(InData%Vr_wake,1), UBOUND(InData%Vr_wake,1) - ReKiBuf(Re_Xferred) = InData%Vr_wake(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vx_wake2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vx_wake2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_wake2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vx_wake2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_wake2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vx_wake2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx_wake2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Vx_wake2,3), UBOUND(InData%Vx_wake2,3) - DO i2 = LBOUND(InData%Vx_wake2,2), UBOUND(InData%Vx_wake2,2) - DO i1 = LBOUND(InData%Vx_wake2,1), UBOUND(InData%Vx_wake2,1) - ReKiBuf(Re_Xferred) = InData%Vx_wake2(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vy_wake2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vy_wake2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vy_wake2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vy_wake2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vy_wake2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vy_wake2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vy_wake2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Vy_wake2,3), UBOUND(InData%Vy_wake2,3) - DO i2 = LBOUND(InData%Vy_wake2,2), UBOUND(InData%Vy_wake2,2) - DO i1 = LBOUND(InData%Vy_wake2,1), UBOUND(InData%Vy_wake2,1) - ReKiBuf(Re_Xferred) = InData%Vy_wake2(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vz_wake2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vz_wake2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vz_wake2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vz_wake2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vz_wake2,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vz_wake2,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vz_wake2,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Vz_wake2,3), UBOUND(InData%Vz_wake2,3) - DO i2 = LBOUND(InData%Vz_wake2,2), UBOUND(InData%Vz_wake2,2) - DO i1 = LBOUND(InData%Vz_wake2,1), UBOUND(InData%Vz_wake2,1) - ReKiBuf(Re_Xferred) = InData%Vz_wake2(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%D_wake) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%D_wake,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_wake,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%D_wake,1), UBOUND(InData%D_wake,1) - ReKiBuf(Re_Xferred) = InData%D_wake(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%x_plane) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x_plane,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_plane,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%x_plane,1), UBOUND(InData%x_plane,1) - ReKiBuf(Re_Xferred) = InData%x_plane(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WAT_k_mt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WAT_k_mt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAT_k_mt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WAT_k_mt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAT_k_mt,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WAT_k_mt,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WAT_k_mt,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WAT_k_mt,3), UBOUND(InData%WAT_k_mt,3) - DO i2 = LBOUND(InData%WAT_k_mt,2), UBOUND(InData%WAT_k_mt,2) - DO i1 = LBOUND(InData%WAT_k_mt,1), UBOUND(InData%WAT_k_mt,1) - ReKiBuf(Re_Xferred) = InData%WAT_k_mt(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE WD_PackOutput - - SUBROUTINE WD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(WD_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xhat_plane not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%xhat_plane)) DEALLOCATE(OutData%xhat_plane) - ALLOCATE(OutData%xhat_plane(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xhat_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%xhat_plane,2), UBOUND(OutData%xhat_plane,2) - DO i1 = LBOUND(OutData%xhat_plane,1), UBOUND(OutData%xhat_plane,1) - OutData%xhat_plane(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! p_plane not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%p_plane)) DEALLOCATE(OutData%p_plane) - ALLOCATE(OutData%p_plane(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%p_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%p_plane,2), UBOUND(OutData%p_plane,2) - DO i1 = LBOUND(OutData%p_plane,1), UBOUND(OutData%p_plane,1) - OutData%p_plane(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vx_wake not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vx_wake)) DEALLOCATE(OutData%Vx_wake) - ALLOCATE(OutData%Vx_wake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vx_wake,2), UBOUND(OutData%Vx_wake,2) - DO i1 = LBOUND(OutData%Vx_wake,1), UBOUND(OutData%Vx_wake,1) - OutData%Vx_wake(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vr_wake not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vr_wake)) DEALLOCATE(OutData%Vr_wake) - ALLOCATE(OutData%Vr_wake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vr_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Vr_wake,2), UBOUND(OutData%Vr_wake,2) - DO i1 = LBOUND(OutData%Vr_wake,1), UBOUND(OutData%Vr_wake,1) - OutData%Vr_wake(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vx_wake2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vx_wake2)) DEALLOCATE(OutData%Vx_wake2) - ALLOCATE(OutData%Vx_wake2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_wake2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Vx_wake2,3), UBOUND(OutData%Vx_wake2,3) - DO i2 = LBOUND(OutData%Vx_wake2,2), UBOUND(OutData%Vx_wake2,2) - DO i1 = LBOUND(OutData%Vx_wake2,1), UBOUND(OutData%Vx_wake2,1) - OutData%Vx_wake2(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vy_wake2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vy_wake2)) DEALLOCATE(OutData%Vy_wake2) - ALLOCATE(OutData%Vy_wake2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vy_wake2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Vy_wake2,3), UBOUND(OutData%Vy_wake2,3) - DO i2 = LBOUND(OutData%Vy_wake2,2), UBOUND(OutData%Vy_wake2,2) - DO i1 = LBOUND(OutData%Vy_wake2,1), UBOUND(OutData%Vy_wake2,1) - OutData%Vy_wake2(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vz_wake2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vz_wake2)) DEALLOCATE(OutData%Vz_wake2) - ALLOCATE(OutData%Vz_wake2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vz_wake2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Vz_wake2,3), UBOUND(OutData%Vz_wake2,3) - DO i2 = LBOUND(OutData%Vz_wake2,2), UBOUND(OutData%Vz_wake2,2) - DO i1 = LBOUND(OutData%Vz_wake2,1), UBOUND(OutData%Vz_wake2,1) - OutData%Vz_wake2(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_wake not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%D_wake)) DEALLOCATE(OutData%D_wake) - ALLOCATE(OutData%D_wake(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%D_wake,1), UBOUND(OutData%D_wake,1) - OutData%D_wake(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_plane not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%x_plane)) DEALLOCATE(OutData%x_plane) - ALLOCATE(OutData%x_plane(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%x_plane,1), UBOUND(OutData%x_plane,1) - OutData%x_plane(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WAT_k_mt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WAT_k_mt)) DEALLOCATE(OutData%WAT_k_mt) - ALLOCATE(OutData%WAT_k_mt(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAT_k_mt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WAT_k_mt,3), UBOUND(OutData%WAT_k_mt,3) - DO i2 = LBOUND(OutData%WAT_k_mt,2), UBOUND(OutData%WAT_k_mt,2) - DO i1 = LBOUND(OutData%WAT_k_mt,1), UBOUND(OutData%WAT_k_mt,1) - OutData%WAT_k_mt(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE WD_UnPackOutput +subroutine WD_PackOutput(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(WD_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'WD_PackOutput' + if (Buf%ErrStat >= AbortErrLev) return + ! xhat_plane + call RegPack(Buf, allocated(InData%xhat_plane)) + if (allocated(InData%xhat_plane)) then + call RegPackBounds(Buf, 2, lbound(InData%xhat_plane), ubound(InData%xhat_plane)) + call RegPack(Buf, InData%xhat_plane) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! p_plane + call RegPack(Buf, allocated(InData%p_plane)) + if (allocated(InData%p_plane)) then + call RegPackBounds(Buf, 2, lbound(InData%p_plane), ubound(InData%p_plane)) + call RegPack(Buf, InData%p_plane) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Vx_wake + call RegPack(Buf, allocated(InData%Vx_wake)) + if (allocated(InData%Vx_wake)) then + call RegPackBounds(Buf, 2, lbound(InData%Vx_wake), ubound(InData%Vx_wake)) + call RegPack(Buf, InData%Vx_wake) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Vr_wake + call RegPack(Buf, allocated(InData%Vr_wake)) + if (allocated(InData%Vr_wake)) then + call RegPackBounds(Buf, 2, lbound(InData%Vr_wake), ubound(InData%Vr_wake)) + call RegPack(Buf, InData%Vr_wake) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Vx_wake2 + call RegPack(Buf, allocated(InData%Vx_wake2)) + if (allocated(InData%Vx_wake2)) then + call RegPackBounds(Buf, 3, lbound(InData%Vx_wake2), ubound(InData%Vx_wake2)) + call RegPack(Buf, InData%Vx_wake2) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Vy_wake2 + call RegPack(Buf, allocated(InData%Vy_wake2)) + if (allocated(InData%Vy_wake2)) then + call RegPackBounds(Buf, 3, lbound(InData%Vy_wake2), ubound(InData%Vy_wake2)) + call RegPack(Buf, InData%Vy_wake2) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! Vz_wake2 + call RegPack(Buf, allocated(InData%Vz_wake2)) + if (allocated(InData%Vz_wake2)) then + call RegPackBounds(Buf, 3, lbound(InData%Vz_wake2), ubound(InData%Vz_wake2)) + call RegPack(Buf, InData%Vz_wake2) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! D_wake + call RegPack(Buf, allocated(InData%D_wake)) + if (allocated(InData%D_wake)) then + call RegPackBounds(Buf, 1, lbound(InData%D_wake), ubound(InData%D_wake)) + call RegPack(Buf, InData%D_wake) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! x_plane + call RegPack(Buf, allocated(InData%x_plane)) + if (allocated(InData%x_plane)) then + call RegPackBounds(Buf, 1, lbound(InData%x_plane), ubound(InData%x_plane)) + call RegPack(Buf, InData%x_plane) + end if + if (RegCheckErr(Buf, RoutineName)) return + ! WAT_k_mt + call RegPack(Buf, allocated(InData%WAT_k_mt)) + if (allocated(InData%WAT_k_mt)) then + call RegPackBounds(Buf, 3, lbound(InData%WAT_k_mt), ubound(InData%WAT_k_mt)) + call RegPack(Buf, InData%WAT_k_mt) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine WD_UnPackOutput(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(WD_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'WD_UnPackOutput' + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + ! xhat_plane + if (allocated(OutData%xhat_plane)) deallocate(OutData%xhat_plane) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xhat_plane(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xhat_plane.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%xhat_plane) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! p_plane + if (allocated(OutData%p_plane)) deallocate(OutData%p_plane) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%p_plane(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%p_plane.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%p_plane) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Vx_wake + if (allocated(OutData%Vx_wake)) deallocate(OutData%Vx_wake) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vx_wake(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_wake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vx_wake) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Vr_wake + if (allocated(OutData%Vr_wake)) deallocate(OutData%Vr_wake) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vr_wake(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vr_wake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vr_wake) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Vx_wake2 + if (allocated(OutData%Vx_wake2)) deallocate(OutData%Vx_wake2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vx_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx_wake2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vx_wake2) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Vy_wake2 + if (allocated(OutData%Vy_wake2)) deallocate(OutData%Vy_wake2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vy_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vy_wake2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vy_wake2) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! Vz_wake2 + if (allocated(OutData%Vz_wake2)) deallocate(OutData%Vz_wake2) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Vz_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vz_wake2.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Vz_wake2) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! D_wake + if (allocated(OutData%D_wake)) deallocate(OutData%D_wake) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%D_wake(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_wake.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%D_wake) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! x_plane + if (allocated(OutData%x_plane)) deallocate(OutData%x_plane) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_plane(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_plane.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%x_plane) + if (RegCheckErr(Buf, RoutineName)) return + end if + ! WAT_k_mt + if (allocated(OutData%WAT_k_mt)) deallocate(OutData%WAT_k_mt) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 3, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%WAT_k_mt(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%WAT_k_mt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%WAT_k_mt) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine END MODULE WakeDynamics_Types !ENDOFREGISTRYGENERATEDFILE From 1519db05be983a03866cd1de8b6793d83660048b Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 15 Jun 2023 01:22:20 +0000 Subject: [PATCH 03/15] Increase Python version to 3.10 in Github Actions --- .github/workflows/automated-dev-tests.yml | 36 +++++++++++------------ 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/.github/workflows/automated-dev-tests.yml b/.github/workflows/automated-dev-tests.yml index f8e2b398c0..36b2419769 100644 --- a/.github/workflows/automated-dev-tests.yml +++ b/.github/workflows/automated-dev-tests.yml @@ -41,7 +41,7 @@ jobs: - name: Setup Python uses: actions/setup-python@v3 with: - python-version: '3.9' + python-version: '3.10' cache: 'pip' - name: Install dependencies run: | @@ -117,7 +117,7 @@ jobs: - name: Setup Python uses: actions/setup-python@v3 with: - python-version: '3.9' + python-version: '3.10' cache: 'pip' - name: Install dependencies run: | @@ -159,7 +159,7 @@ jobs: - name: Setup Python uses: actions/setup-python@v3 with: - python-version: '3.9' + python-version: '3.10' cache: 'pip' - name: Install dependencies run: | @@ -209,7 +209,7 @@ jobs: - name: Setup Python uses: actions/setup-python@v3 with: - python-version: '3.9' + python-version: '3.10' cache: 'pip' - name: Install dependencies run: | @@ -240,7 +240,7 @@ jobs: - name: Setup Python uses: actions/setup-python@v3 with: - python-version: '3.9' + python-version: '3.10' cache: 'pip' - name: Install dependencies run: | @@ -271,7 +271,7 @@ jobs: - name: Setup Python uses: actions/setup-python@v3 with: - python-version: '3.9' + python-version: '3.10' cache: 'pip' - name: Install dependencies run: | @@ -304,7 +304,7 @@ jobs: - name: Setup Python uses: actions/setup-python@v3 with: - python-version: '3.9' + python-version: '3.10' cache: 'pip' - name: Install dependencies run: | @@ -363,7 +363,7 @@ jobs: - name: Setup Python uses: actions/setup-python@v3 with: - python-version: '3.9' + python-version: '3.10' cache: 'pip' - name: Install dependencies run: | @@ -412,7 +412,7 @@ jobs: - name: Setup Python uses: actions/setup-python@v3 with: - python-version: '3.9' + python-version: '3.10' cache: 'pip' - name: Install dependencies run: | @@ -471,7 +471,7 @@ jobs: - name: Setup Python uses: actions/setup-python@v3 with: - python-version: '3.9' + python-version: '3.10' cache: 'pip' - name: Install dependencies run: | @@ -510,7 +510,7 @@ jobs: - name: Setup Python uses: actions/setup-python@v3 with: - python-version: '3.9' + python-version: '3.10' cache: 'pip' - name: Install dependencies run: | @@ -557,7 +557,7 @@ jobs: - name: Setup Python uses: actions/setup-python@v3 with: - python-version: '3.9' + python-version: '3.10' cache: 'pip' - name: Install dependencies run: | @@ -601,7 +601,7 @@ jobs: - name: Setup Python uses: actions/setup-python@v3 with: - python-version: '3.9' + python-version: '3.10' cache: 'pip' - name: Install dependencies run: | @@ -645,7 +645,7 @@ jobs: - name: Setup Python uses: actions/setup-python@v3 with: - python-version: '3.9' + python-version: '3.10' cache: 'pip' - name: Install dependencies run: | @@ -689,7 +689,7 @@ jobs: - name: Setup Python uses: actions/setup-python@v3 with: - python-version: '3.9' + python-version: '3.10' cache: 'pip' - name: Install dependencies run: | @@ -733,7 +733,7 @@ jobs: - name: Setup Python uses: actions/setup-python@v3 with: - python-version: '3.9' + python-version: '3.10' cache: 'pip' - name: Install dependencies run: | @@ -777,7 +777,7 @@ jobs: - name: Setup Python uses: actions/setup-python@v3 with: - python-version: '3.9' + python-version: '3.10' cache: 'pip' - name: Install dependencies run: | @@ -821,7 +821,7 @@ jobs: - name: Setup Python uses: actions/setup-python@v3 with: - python-version: '3.9' + python-version: '3.10' cache: 'pip' - name: Install dependencies run: | From e4302320b6e104e42084c2c062d8735dee37d7ca Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 15 Jun 2023 02:37:14 +0000 Subject: [PATCH 04/15] Updated the Registry Copy/Destroy subs --- .../fast-farm/src/FASTWrapper_Types.f90 | 1150 +- glue-codes/fast-farm/src/FAST_Farm_Types.f90 | 1787 +- modules/aerodyn/src/AeroAcoustics_Types.f90 | 4920 ++-- modules/aerodyn/src/AeroDyn_Driver_Types.f90 | 1694 +- modules/aerodyn/src/AeroDyn_Inflow_Types.f90 | 2020 +- modules/aerodyn/src/AeroDyn_Types.f90 | 7222 +++--- modules/aerodyn/src/AirfoilInfo_Types.f90 | 1163 +- modules/aerodyn/src/BEMT_Types.f90 | 3029 +-- modules/aerodyn/src/DBEMT_Types.f90 | 1037 +- modules/aerodyn/src/FVW_Types.f90 | 5098 ++-- modules/aerodyn/src/UnsteadyAero_Types.f90 | 3245 ++- modules/aerodyn14/src/AeroDyn14_Types.f90 | 6657 +++-- modules/aerodyn14/src/DWM_Types.f90 | 3791 ++- modules/awae/src/AWAE_Types.f90 | 3566 ++- modules/beamdyn/src/BeamDyn_Types.f90 | 5601 ++--- modules/elastodyn/src/ElastoDyn_Types.f90 | 10844 ++++---- modules/extptfm/src/ExtPtfm_MCKF_Types.f90 | 2311 +- modules/feamooring/src/FEAMooring_Types.f90 | 3267 ++- modules/hydrodyn/src/Conv_Radiation_Types.f90 | 814 +- modules/hydrodyn/src/HydroDyn_Types.f90 | 2956 +-- modules/hydrodyn/src/Morison_Types.f90 | 5952 ++--- modules/hydrodyn/src/SS_Excitation_Types.f90 | 1034 +- modules/hydrodyn/src/SS_Radiation_Types.f90 | 964 +- modules/hydrodyn/src/WAMIT2_Types.f90 | 633 +- modules/hydrodyn/src/WAMIT_Types.f90 | 1530 +- modules/icedyn/src/IceDyn_Types.f90 | 1772 +- modules/icefloe/src/icefloe/IceFloe_Types.f90 | 860 +- .../inflowwind/src/IfW_FlowField_Types.f90 | 1529 +- .../inflowwind/src/InflowWind_IO_Types.f90 | 797 +- modules/inflowwind/src/InflowWind_Types.f90 | 1940 +- modules/inflowwind/src/Lidar_Types.f90 | 934 +- modules/map/src/MAP_Fortran_Types.f90 | 298 +- modules/map/src/MAP_Types.f90 | 2028 +- modules/moordyn/src/MoorDyn_Types.f90 | 6226 +++-- .../nwtc-library/src/NWTC_Library_Types.f90 | 643 +- modules/openfast-library/src/FAST_Types.f90 | 20383 +++++++--------- .../src/registry_gen_fortran.cpp | 324 +- modules/openfoam/src/OpenFOAM_Types.f90 | 1835 +- .../src/OrcaFlexInterface_Types.f90 | 850 +- modules/seastate/src/Current_Types.f90 | 258 +- .../seastate/src/SeaSt_WaveField_Types.f90 | 655 +- .../seastate/src/SeaState_Interp_Types.f90 | 257 +- modules/seastate/src/SeaState_Types.f90 | 1790 +- modules/seastate/src/Waves2_Types.f90 | 602 +- modules/seastate/src/Waves_Types.f90 | 623 +- modules/servodyn/src/ServoDyn_Types.f90 | 8349 +++---- modules/servodyn/src/StrucCtrl_Types.f90 | 2734 +-- modules/subdyn/src/SubDyn_Types.f90 | 6302 +++-- .../supercontroller/src/SCDataEx_Types.f90 | 417 +- .../src/SuperController_Types.f90 | 993 +- .../wakedynamics/src/WakeDynamics_Types.f90 | 2839 +-- 51 files changed, 65235 insertions(+), 83288 deletions(-) diff --git a/glue-codes/fast-farm/src/FASTWrapper_Types.f90 b/glue-codes/fast-farm/src/FASTWrapper_Types.f90 index 198dd81f82..e81c7c5212 100644 --- a/glue-codes/fast-farm/src/FASTWrapper_Types.f90 +++ b/glue-codes/fast-farm/src/FASTWrapper_Types.f90 @@ -126,95 +126,85 @@ MODULE FASTWrapper_Types END TYPE FWrap_OutputType ! ======================= CONTAINS - SUBROUTINE FWrap_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FWrap_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(FWrap_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%nr = SrcInitInputData%nr - DstInitInputData%FASTInFile = SrcInitInputData%FASTInFile - DstInitInputData%dr = SrcInitInputData%dr - DstInitInputData%tmax = SrcInitInputData%tmax - DstInitInputData%p_ref_Turbine = SrcInitInputData%p_ref_Turbine - DstInitInputData%WaveFieldMod = SrcInitInputData%WaveFieldMod - DstInitInputData%n_high_low = SrcInitInputData%n_high_low - DstInitInputData%dt_high = SrcInitInputData%dt_high - DstInitInputData%p_ref_high = SrcInitInputData%p_ref_high - DstInitInputData%nX_high = SrcInitInputData%nX_high - DstInitInputData%nY_high = SrcInitInputData%nY_high - DstInitInputData%nZ_high = SrcInitInputData%nZ_high - DstInitInputData%dX_high = SrcInitInputData%dX_high - DstInitInputData%dY_high = SrcInitInputData%dY_high - DstInitInputData%dZ_high = SrcInitInputData%dZ_high - DstInitInputData%TurbNum = SrcInitInputData%TurbNum - DstInitInputData%RootName = SrcInitInputData%RootName - DstInitInputData%NumSC2Ctrl = SrcInitInputData%NumSC2Ctrl - DstInitInputData%NumSC2CtrlGlob = SrcInitInputData%NumSC2CtrlGlob - DstInitInputData%NumCtrl2SC = SrcInitInputData%NumCtrl2SC - DstInitInputData%UseSC = SrcInitInputData%UseSC -IF (ALLOCATED(SrcInitInputData%fromSCGlob)) THEN - i1_l = LBOUND(SrcInitInputData%fromSCGlob,1) - i1_u = UBOUND(SrcInitInputData%fromSCGlob,1) - IF (.NOT. ALLOCATED(DstInitInputData%fromSCGlob)) THEN - ALLOCATE(DstInitInputData%fromSCGlob(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%fromSCGlob.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%fromSCGlob = SrcInitInputData%fromSCGlob -ENDIF -IF (ALLOCATED(SrcInitInputData%fromSC)) THEN - i1_l = LBOUND(SrcInitInputData%fromSC,1) - i1_u = UBOUND(SrcInitInputData%fromSC,1) - IF (.NOT. ALLOCATED(DstInitInputData%fromSC)) THEN - ALLOCATE(DstInitInputData%fromSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%fromSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%fromSC = SrcInitInputData%fromSC -ENDIF - DstInitInputData%Vdist_High => SrcInitInputData%Vdist_High - END SUBROUTINE FWrap_CopyInitInput - - SUBROUTINE FWrap_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(FWrap_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(InitInputData%fromSCGlob)) THEN - DEALLOCATE(InitInputData%fromSCGlob) -ENDIF -IF (ALLOCATED(InitInputData%fromSC)) THEN - DEALLOCATE(InitInputData%fromSC) -ENDIF -NULLIFY(InitInputData%Vdist_High) - END SUBROUTINE FWrap_DestroyInitInput +subroutine FWrap_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(FWrap_InitInputType), intent(in) :: SrcInitInputData + type(FWrap_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FWrap_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitInputData%nr = SrcInitInputData%nr + DstInitInputData%FASTInFile = SrcInitInputData%FASTInFile + DstInitInputData%dr = SrcInitInputData%dr + DstInitInputData%tmax = SrcInitInputData%tmax + DstInitInputData%p_ref_Turbine = SrcInitInputData%p_ref_Turbine + DstInitInputData%WaveFieldMod = SrcInitInputData%WaveFieldMod + DstInitInputData%n_high_low = SrcInitInputData%n_high_low + DstInitInputData%dt_high = SrcInitInputData%dt_high + DstInitInputData%p_ref_high = SrcInitInputData%p_ref_high + DstInitInputData%nX_high = SrcInitInputData%nX_high + DstInitInputData%nY_high = SrcInitInputData%nY_high + DstInitInputData%nZ_high = SrcInitInputData%nZ_high + DstInitInputData%dX_high = SrcInitInputData%dX_high + DstInitInputData%dY_high = SrcInitInputData%dY_high + DstInitInputData%dZ_high = SrcInitInputData%dZ_high + DstInitInputData%TurbNum = SrcInitInputData%TurbNum + DstInitInputData%RootName = SrcInitInputData%RootName + DstInitInputData%NumSC2Ctrl = SrcInitInputData%NumSC2Ctrl + DstInitInputData%NumSC2CtrlGlob = SrcInitInputData%NumSC2CtrlGlob + DstInitInputData%NumCtrl2SC = SrcInitInputData%NumCtrl2SC + DstInitInputData%UseSC = SrcInitInputData%UseSC + if (allocated(SrcInitInputData%fromSCGlob)) then + LB(1:1) = lbound(SrcInitInputData%fromSCGlob) + UB(1:1) = ubound(SrcInitInputData%fromSCGlob) + if (.not. allocated(DstInitInputData%fromSCGlob)) then + allocate(DstInitInputData%fromSCGlob(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%fromSCGlob.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%fromSCGlob = SrcInitInputData%fromSCGlob + else if (allocated(DstInitInputData%fromSCGlob)) then + deallocate(DstInitInputData%fromSCGlob) + end if + if (allocated(SrcInitInputData%fromSC)) then + LB(1:1) = lbound(SrcInitInputData%fromSC) + UB(1:1) = ubound(SrcInitInputData%fromSC) + if (.not. allocated(DstInitInputData%fromSC)) then + allocate(DstInitInputData%fromSC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%fromSC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%fromSC = SrcInitInputData%fromSC + else if (allocated(DstInitInputData%fromSC)) then + deallocate(DstInitInputData%fromSC) + end if + DstInitInputData%Vdist_High => SrcInitInputData%Vdist_High +end subroutine +subroutine FWrap_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(FWrap_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FWrap_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitInputData%fromSCGlob)) then + deallocate(InitInputData%fromSCGlob) + end if + if (allocated(InitInputData%fromSC)) then + deallocate(InitInputData%fromSC) + end if + nullify(InitInputData%Vdist_High) +end subroutine subroutine FWrap_PackInitInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -222,84 +212,60 @@ subroutine FWrap_PackInitInput(Buf, Indata) character(*), parameter :: RoutineName = 'FWrap_PackInitInput' logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return - ! nr call RegPack(Buf, InData%nr) if (RegCheckErr(Buf, RoutineName)) return - ! FASTInFile call RegPack(Buf, InData%FASTInFile) if (RegCheckErr(Buf, RoutineName)) return - ! dr call RegPack(Buf, InData%dr) if (RegCheckErr(Buf, RoutineName)) return - ! tmax call RegPack(Buf, InData%tmax) if (RegCheckErr(Buf, RoutineName)) return - ! p_ref_Turbine call RegPack(Buf, InData%p_ref_Turbine) if (RegCheckErr(Buf, RoutineName)) return - ! WaveFieldMod call RegPack(Buf, InData%WaveFieldMod) if (RegCheckErr(Buf, RoutineName)) return - ! n_high_low call RegPack(Buf, InData%n_high_low) if (RegCheckErr(Buf, RoutineName)) return - ! dt_high call RegPack(Buf, InData%dt_high) if (RegCheckErr(Buf, RoutineName)) return - ! p_ref_high call RegPack(Buf, InData%p_ref_high) if (RegCheckErr(Buf, RoutineName)) return - ! nX_high call RegPack(Buf, InData%nX_high) if (RegCheckErr(Buf, RoutineName)) return - ! nY_high call RegPack(Buf, InData%nY_high) if (RegCheckErr(Buf, RoutineName)) return - ! nZ_high call RegPack(Buf, InData%nZ_high) if (RegCheckErr(Buf, RoutineName)) return - ! dX_high call RegPack(Buf, InData%dX_high) if (RegCheckErr(Buf, RoutineName)) return - ! dY_high call RegPack(Buf, InData%dY_high) if (RegCheckErr(Buf, RoutineName)) return - ! dZ_high call RegPack(Buf, InData%dZ_high) if (RegCheckErr(Buf, RoutineName)) return - ! TurbNum call RegPack(Buf, InData%TurbNum) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegPack(Buf, InData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! NumSC2Ctrl call RegPack(Buf, InData%NumSC2Ctrl) if (RegCheckErr(Buf, RoutineName)) return - ! NumSC2CtrlGlob call RegPack(Buf, InData%NumSC2CtrlGlob) if (RegCheckErr(Buf, RoutineName)) return - ! NumCtrl2SC call RegPack(Buf, InData%NumCtrl2SC) if (RegCheckErr(Buf, RoutineName)) return - ! UseSC call RegPack(Buf, InData%UseSC) if (RegCheckErr(Buf, RoutineName)) return - ! fromSCGlob call RegPack(Buf, allocated(InData%fromSCGlob)) if (allocated(InData%fromSCGlob)) then call RegPackBounds(Buf, 1, lbound(InData%fromSCGlob), ubound(InData%fromSCGlob)) call RegPack(Buf, InData%fromSCGlob) end if if (RegCheckErr(Buf, RoutineName)) return - ! fromSC call RegPack(Buf, allocated(InData%fromSC)) if (allocated(InData%fromSC)) then call RegPackBounds(Buf, 1, lbound(InData%fromSC), ubound(InData%fromSC)) call RegPack(Buf, InData%fromSC) end if if (RegCheckErr(Buf, RoutineName)) return - ! Vdist_High call RegPack(Buf, associated(InData%Vdist_High)) if (associated(InData%Vdist_High)) then call RegPackBounds(Buf, 5, lbound(InData%Vdist_High), ubound(InData%Vdist_High)) @@ -321,70 +287,48 @@ subroutine FWrap_UnPackInitInput(Buf, OutData) integer(IntKi) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return - ! nr call RegUnpack(Buf, OutData%nr) if (RegCheckErr(Buf, RoutineName)) return - ! FASTInFile call RegUnpack(Buf, OutData%FASTInFile) if (RegCheckErr(Buf, RoutineName)) return - ! dr call RegUnpack(Buf, OutData%dr) if (RegCheckErr(Buf, RoutineName)) return - ! tmax call RegUnpack(Buf, OutData%tmax) if (RegCheckErr(Buf, RoutineName)) return - ! p_ref_Turbine call RegUnpack(Buf, OutData%p_ref_Turbine) if (RegCheckErr(Buf, RoutineName)) return - ! WaveFieldMod call RegUnpack(Buf, OutData%WaveFieldMod) if (RegCheckErr(Buf, RoutineName)) return - ! n_high_low call RegUnpack(Buf, OutData%n_high_low) if (RegCheckErr(Buf, RoutineName)) return - ! dt_high call RegUnpack(Buf, OutData%dt_high) if (RegCheckErr(Buf, RoutineName)) return - ! p_ref_high call RegUnpack(Buf, OutData%p_ref_high) if (RegCheckErr(Buf, RoutineName)) return - ! nX_high call RegUnpack(Buf, OutData%nX_high) if (RegCheckErr(Buf, RoutineName)) return - ! nY_high call RegUnpack(Buf, OutData%nY_high) if (RegCheckErr(Buf, RoutineName)) return - ! nZ_high call RegUnpack(Buf, OutData%nZ_high) if (RegCheckErr(Buf, RoutineName)) return - ! dX_high call RegUnpack(Buf, OutData%dX_high) if (RegCheckErr(Buf, RoutineName)) return - ! dY_high call RegUnpack(Buf, OutData%dY_high) if (RegCheckErr(Buf, RoutineName)) return - ! dZ_high call RegUnpack(Buf, OutData%dZ_high) if (RegCheckErr(Buf, RoutineName)) return - ! TurbNum call RegUnpack(Buf, OutData%TurbNum) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegUnpack(Buf, OutData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! NumSC2Ctrl call RegUnpack(Buf, OutData%NumSC2Ctrl) if (RegCheckErr(Buf, RoutineName)) return - ! NumSC2CtrlGlob call RegUnpack(Buf, OutData%NumSC2CtrlGlob) if (RegCheckErr(Buf, RoutineName)) return - ! NumCtrl2SC call RegUnpack(Buf, OutData%NumCtrl2SC) if (RegCheckErr(Buf, RoutineName)) return - ! UseSC call RegUnpack(Buf, OutData%UseSC) if (RegCheckErr(Buf, RoutineName)) return - ! fromSCGlob if (allocated(OutData%fromSCGlob)) deallocate(OutData%fromSCGlob) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -399,7 +343,6 @@ subroutine FWrap_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%fromSCGlob) if (RegCheckErr(Buf, RoutineName)) return end if - ! fromSC if (allocated(OutData%fromSC)) deallocate(OutData%fromSC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -414,7 +357,6 @@ subroutine FWrap_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%fromSC) if (RegCheckErr(Buf, RoutineName)) return end if - ! Vdist_High if (associated(OutData%Vdist_High)) deallocate(OutData%Vdist_High) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -440,54 +382,42 @@ subroutine FWrap_UnPackInitInput(Buf, OutData) OutData%Vdist_High => null() end if end subroutine - SUBROUTINE FWrap_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FWrap_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(FWrap_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_CopyInitOutput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitOutputData%PtfmInit = SrcInitOutputData%PtfmInit - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE FWrap_CopyInitOutput - - SUBROUTINE FWrap_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(FWrap_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_DestroyInitOutput' - ErrStat = ErrID_None - ErrMsg = "" - - CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE FWrap_DestroyInitOutput +subroutine FWrap_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(FWrap_InitOutputType), intent(in) :: SrcInitOutputData + type(FWrap_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FWrap_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitOutputData%PtfmInit = SrcInitOutputData%PtfmInit + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine FWrap_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(FWrap_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FWrap_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine FWrap_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FWrap_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'FWrap_PackInitOutput' if (Buf%ErrStat >= AbortErrLev) return - ! PtfmInit call RegPack(Buf, InData%PtfmInit) if (RegCheckErr(Buf, RoutineName)) return - ! Ver call NWTC_Library_PackProgDesc(Buf, InData%Ver) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -497,51 +427,37 @@ subroutine FWrap_UnPackInitOutput(Buf, OutData) type(FWrap_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FWrap_UnPackInitOutput' if (Buf%ErrStat /= ErrID_None) return - ! PtfmInit call RegUnpack(Buf, OutData%PtfmInit) if (RegCheckErr(Buf, RoutineName)) return - ! Ver call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver end subroutine - SUBROUTINE FWrap_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FWrap_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(FWrap_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%dummy = SrcContStateData%dummy - END SUBROUTINE FWrap_CopyContState - - SUBROUTINE FWrap_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(FWrap_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE FWrap_DestroyContState +subroutine FWrap_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(FWrap_ContinuousStateType), intent(in) :: SrcContStateData + type(FWrap_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FWrap_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + DstContStateData%dummy = SrcContStateData%dummy +end subroutine +subroutine FWrap_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(FWrap_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FWrap_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine FWrap_PackContState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FWrap_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'FWrap_PackContState' if (Buf%ErrStat >= AbortErrLev) return - ! dummy call RegPack(Buf, InData%dummy) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -551,49 +467,36 @@ subroutine FWrap_UnPackContState(Buf, OutData) type(FWrap_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FWrap_UnPackContState' if (Buf%ErrStat /= ErrID_None) return - ! dummy call RegUnpack(Buf, OutData%dummy) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE FWrap_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FWrap_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(FWrap_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%dummy = SrcDiscStateData%dummy - END SUBROUTINE FWrap_CopyDiscState - - SUBROUTINE FWrap_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(FWrap_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE FWrap_DestroyDiscState +subroutine FWrap_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(FWrap_DiscreteStateType), intent(in) :: SrcDiscStateData + type(FWrap_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FWrap_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + DstDiscStateData%dummy = SrcDiscStateData%dummy +end subroutine +subroutine FWrap_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(FWrap_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FWrap_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine FWrap_PackDiscState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FWrap_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'FWrap_PackDiscState' if (Buf%ErrStat >= AbortErrLev) return - ! dummy call RegPack(Buf, InData%dummy) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -603,49 +506,36 @@ subroutine FWrap_UnPackDiscState(Buf, OutData) type(FWrap_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FWrap_UnPackDiscState' if (Buf%ErrStat /= ErrID_None) return - ! dummy call RegUnpack(Buf, OutData%dummy) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE FWrap_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FWrap_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(FWrap_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%dummy = SrcConstrStateData%dummy - END SUBROUTINE FWrap_CopyConstrState - - SUBROUTINE FWrap_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(FWrap_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE FWrap_DestroyConstrState +subroutine FWrap_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(FWrap_ConstraintStateType), intent(in) :: SrcConstrStateData + type(FWrap_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FWrap_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%dummy = SrcConstrStateData%dummy +end subroutine +subroutine FWrap_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(FWrap_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FWrap_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine FWrap_PackConstrState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FWrap_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'FWrap_PackConstrState' if (Buf%ErrStat >= AbortErrLev) return - ! dummy call RegPack(Buf, InData%dummy) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -655,49 +545,36 @@ subroutine FWrap_UnPackConstrState(Buf, OutData) type(FWrap_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FWrap_UnPackConstrState' if (Buf%ErrStat /= ErrID_None) return - ! dummy call RegUnpack(Buf, OutData%dummy) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE FWrap_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FWrap_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(FWrap_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%dummy = SrcOtherStateData%dummy - END SUBROUTINE FWrap_CopyOtherState - - SUBROUTINE FWrap_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(FWrap_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE FWrap_DestroyOtherState +subroutine FWrap_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(FWrap_OtherStateType), intent(in) :: SrcOtherStateData + type(FWrap_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FWrap_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%dummy = SrcOtherStateData%dummy +end subroutine +subroutine FWrap_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(FWrap_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FWrap_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine FWrap_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FWrap_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'FWrap_PackOtherState' if (Buf%ErrStat >= AbortErrLev) return - ! dummy call RegPack(Buf, InData%dummy) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -707,139 +584,148 @@ subroutine FWrap_UnPackOtherState(Buf, OutData) type(FWrap_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FWrap_UnPackOtherState' if (Buf%ErrStat /= ErrID_None) return - ! dummy call RegUnpack(Buf, OutData%dummy) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE FWrap_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FWrap_MiscVarType), INTENT(INOUT) :: SrcMiscData - TYPE(FWrap_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL FAST_Copyturbinetype( SrcMiscData%Turbine, DstMiscData%Turbine, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMiscData%TempDisp)) THEN - i1_l = LBOUND(SrcMiscData%TempDisp,1) - i1_u = UBOUND(SrcMiscData%TempDisp,1) - IF (.NOT. ALLOCATED(DstMiscData%TempDisp)) THEN - ALLOCATE(DstMiscData%TempDisp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TempDisp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%TempDisp,1), UBOUND(SrcMiscData%TempDisp,1) - CALL MeshCopy( SrcMiscData%TempDisp(i1), DstMiscData%TempDisp(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%TempLoads)) THEN - i1_l = LBOUND(SrcMiscData%TempLoads,1) - i1_u = UBOUND(SrcMiscData%TempLoads,1) - IF (.NOT. ALLOCATED(DstMiscData%TempLoads)) THEN - ALLOCATE(DstMiscData%TempLoads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TempLoads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%TempLoads,1), UBOUND(SrcMiscData%TempLoads,1) - CALL MeshCopy( SrcMiscData%TempLoads(i1), DstMiscData%TempLoads(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%ADRotorDisk)) THEN - i1_l = LBOUND(SrcMiscData%ADRotorDisk,1) - i1_u = UBOUND(SrcMiscData%ADRotorDisk,1) - IF (.NOT. ALLOCATED(DstMiscData%ADRotorDisk)) THEN - ALLOCATE(DstMiscData%ADRotorDisk(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ADRotorDisk.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%ADRotorDisk,1), UBOUND(SrcMiscData%ADRotorDisk,1) - CALL MeshCopy( SrcMiscData%ADRotorDisk(i1), DstMiscData%ADRotorDisk(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%AD_L2L)) THEN - i1_l = LBOUND(SrcMiscData%AD_L2L,1) - i1_u = UBOUND(SrcMiscData%AD_L2L,1) - IF (.NOT. ALLOCATED(DstMiscData%AD_L2L)) THEN - ALLOCATE(DstMiscData%AD_L2L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AD_L2L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%AD_L2L,1), UBOUND(SrcMiscData%AD_L2L,1) - CALL NWTC_Library_Copymeshmaptype( SrcMiscData%AD_L2L(i1), DstMiscData%AD_L2L(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE FWrap_CopyMisc - SUBROUTINE FWrap_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(FWrap_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL FAST_DestroyTurbineType( MiscData%Turbine, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MiscData%TempDisp)) THEN -DO i1 = LBOUND(MiscData%TempDisp,1), UBOUND(MiscData%TempDisp,1) - CALL MeshDestroy( MiscData%TempDisp(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%TempDisp) -ENDIF -IF (ALLOCATED(MiscData%TempLoads)) THEN -DO i1 = LBOUND(MiscData%TempLoads,1), UBOUND(MiscData%TempLoads,1) - CALL MeshDestroy( MiscData%TempLoads(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%TempLoads) -ENDIF -IF (ALLOCATED(MiscData%ADRotorDisk)) THEN -DO i1 = LBOUND(MiscData%ADRotorDisk,1), UBOUND(MiscData%ADRotorDisk,1) - CALL MeshDestroy( MiscData%ADRotorDisk(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%ADRotorDisk) -ENDIF -IF (ALLOCATED(MiscData%AD_L2L)) THEN -DO i1 = LBOUND(MiscData%AD_L2L,1), UBOUND(MiscData%AD_L2L,1) - CALL NWTC_Library_DestroyMeshMapType( MiscData%AD_L2L(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%AD_L2L) -ENDIF - END SUBROUTINE FWrap_DestroyMisc +subroutine FWrap_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(FWrap_MiscVarType), intent(inout) :: SrcMiscData + type(FWrap_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FWrap_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call FAST_CopyTurbineType(SrcMiscData%Turbine, DstMiscData%Turbine, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMiscData%TempDisp)) then + LB(1:1) = lbound(SrcMiscData%TempDisp) + UB(1:1) = ubound(SrcMiscData%TempDisp) + if (.not. allocated(DstMiscData%TempDisp)) then + allocate(DstMiscData%TempDisp(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TempDisp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcMiscData%TempDisp(i1), DstMiscData%TempDisp(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstMiscData%TempDisp)) then + deallocate(DstMiscData%TempDisp) + end if + if (allocated(SrcMiscData%TempLoads)) then + LB(1:1) = lbound(SrcMiscData%TempLoads) + UB(1:1) = ubound(SrcMiscData%TempLoads) + if (.not. allocated(DstMiscData%TempLoads)) then + allocate(DstMiscData%TempLoads(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TempLoads.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcMiscData%TempLoads(i1), DstMiscData%TempLoads(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstMiscData%TempLoads)) then + deallocate(DstMiscData%TempLoads) + end if + if (allocated(SrcMiscData%ADRotorDisk)) then + LB(1:1) = lbound(SrcMiscData%ADRotorDisk) + UB(1:1) = ubound(SrcMiscData%ADRotorDisk) + if (.not. allocated(DstMiscData%ADRotorDisk)) then + allocate(DstMiscData%ADRotorDisk(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ADRotorDisk.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcMiscData%ADRotorDisk(i1), DstMiscData%ADRotorDisk(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstMiscData%ADRotorDisk)) then + deallocate(DstMiscData%ADRotorDisk) + end if + if (allocated(SrcMiscData%AD_L2L)) then + LB(1:1) = lbound(SrcMiscData%AD_L2L) + UB(1:1) = ubound(SrcMiscData%AD_L2L) + if (.not. allocated(DstMiscData%AD_L2L)) then + allocate(DstMiscData%AD_L2L(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AD_L2L.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcMiscData%AD_L2L(i1), DstMiscData%AD_L2L(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstMiscData%AD_L2L)) then + deallocate(DstMiscData%AD_L2L) + end if +end subroutine +subroutine FWrap_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(FWrap_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FWrap_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%TempDisp)) then + LB(1:1) = lbound(MiscData%TempDisp) + UB(1:1) = ubound(MiscData%TempDisp) + do i1 = LB(1), UB(1) + call MeshDestroy( MiscData%TempDisp(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%TempDisp) + end if + if (allocated(MiscData%TempLoads)) then + LB(1:1) = lbound(MiscData%TempLoads) + UB(1:1) = ubound(MiscData%TempLoads) + do i1 = LB(1), UB(1) + call MeshDestroy( MiscData%TempLoads(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%TempLoads) + end if + if (allocated(MiscData%ADRotorDisk)) then + LB(1:1) = lbound(MiscData%ADRotorDisk) + UB(1:1) = ubound(MiscData%ADRotorDisk) + do i1 = LB(1), UB(1) + call MeshDestroy( MiscData%ADRotorDisk(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%ADRotorDisk) + end if + if (allocated(MiscData%AD_L2L)) then + LB(1:1) = lbound(MiscData%AD_L2L) + UB(1:1) = ubound(MiscData%AD_L2L) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(MiscData%AD_L2L(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%AD_L2L) + end if +end subroutine subroutine FWrap_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -848,10 +734,8 @@ subroutine FWrap_PackMisc(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! Turbine call FAST_PackTurbineType(Buf, InData%Turbine) if (RegCheckErr(Buf, RoutineName)) return - ! TempDisp call RegPack(Buf, allocated(InData%TempDisp)) if (allocated(InData%TempDisp)) then call RegPackBounds(Buf, 1, lbound(InData%TempDisp), ubound(InData%TempDisp)) @@ -862,7 +746,6 @@ subroutine FWrap_PackMisc(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! TempLoads call RegPack(Buf, allocated(InData%TempLoads)) if (allocated(InData%TempLoads)) then call RegPackBounds(Buf, 1, lbound(InData%TempLoads), ubound(InData%TempLoads)) @@ -873,7 +756,6 @@ subroutine FWrap_PackMisc(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! ADRotorDisk call RegPack(Buf, allocated(InData%ADRotorDisk)) if (allocated(InData%ADRotorDisk)) then call RegPackBounds(Buf, 1, lbound(InData%ADRotorDisk), ubound(InData%ADRotorDisk)) @@ -884,7 +766,6 @@ subroutine FWrap_PackMisc(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! AD_L2L call RegPack(Buf, allocated(InData%AD_L2L)) if (allocated(InData%AD_L2L)) then call RegPackBounds(Buf, 1, lbound(InData%AD_L2L), ubound(InData%AD_L2L)) @@ -906,9 +787,7 @@ subroutine FWrap_UnPackMisc(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! Turbine call FAST_UnpackTurbineType(Buf, OutData%Turbine) ! Turbine - ! TempDisp if (allocated(OutData%TempDisp)) deallocate(OutData%TempDisp) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -924,7 +803,6 @@ subroutine FWrap_UnPackMisc(Buf, OutData) call MeshUnpack(Buf, OutData%TempDisp(i1)) ! TempDisp end do end if - ! TempLoads if (allocated(OutData%TempLoads)) deallocate(OutData%TempLoads) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -940,7 +818,6 @@ subroutine FWrap_UnPackMisc(Buf, OutData) call MeshUnpack(Buf, OutData%TempLoads(i1)) ! TempLoads end do end if - ! ADRotorDisk if (allocated(OutData%ADRotorDisk)) deallocate(OutData%ADRotorDisk) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -956,7 +833,6 @@ subroutine FWrap_UnPackMisc(Buf, OutData) call MeshUnpack(Buf, OutData%ADRotorDisk(i1)) ! ADRotorDisk end do end if - ! AD_L2L if (allocated(OutData%AD_L2L)) deallocate(OutData%AD_L2L) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -973,76 +849,64 @@ subroutine FWrap_UnPackMisc(Buf, OutData) end do end if end subroutine - SUBROUTINE FWrap_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FWrap_ParameterType), INTENT(IN) :: SrcParamData - TYPE(FWrap_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%nr = SrcParamData%nr -IF (ALLOCATED(SrcParamData%r)) THEN - i1_l = LBOUND(SrcParamData%r,1) - i1_u = UBOUND(SrcParamData%r,1) - IF (.NOT. ALLOCATED(DstParamData%r)) THEN - ALLOCATE(DstParamData%r(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%r.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%r = SrcParamData%r -ENDIF - DstParamData%n_FAST_low = SrcParamData%n_FAST_low - DstParamData%p_ref_Turbine = SrcParamData%p_ref_Turbine - END SUBROUTINE FWrap_CopyParam - SUBROUTINE FWrap_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(FWrap_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%r)) THEN - DEALLOCATE(ParamData%r) -ENDIF - END SUBROUTINE FWrap_DestroyParam +subroutine FWrap_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(FWrap_ParameterType), intent(in) :: SrcParamData + type(FWrap_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FWrap_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%nr = SrcParamData%nr + if (allocated(SrcParamData%r)) then + LB(1:1) = lbound(SrcParamData%r) + UB(1:1) = ubound(SrcParamData%r) + if (.not. allocated(DstParamData%r)) then + allocate(DstParamData%r(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%r.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%r = SrcParamData%r + else if (allocated(DstParamData%r)) then + deallocate(DstParamData%r) + end if + DstParamData%n_FAST_low = SrcParamData%n_FAST_low + DstParamData%p_ref_Turbine = SrcParamData%p_ref_Turbine +end subroutine +subroutine FWrap_DestroyParam(ParamData, ErrStat, ErrMsg) + type(FWrap_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FWrap_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%r)) then + deallocate(ParamData%r) + end if +end subroutine subroutine FWrap_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FWrap_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'FWrap_PackParam' if (Buf%ErrStat >= AbortErrLev) return - ! nr call RegPack(Buf, InData%nr) if (RegCheckErr(Buf, RoutineName)) return - ! r call RegPack(Buf, allocated(InData%r)) if (allocated(InData%r)) then call RegPackBounds(Buf, 1, lbound(InData%r), ubound(InData%r)) call RegPack(Buf, InData%r) end if if (RegCheckErr(Buf, RoutineName)) return - ! n_FAST_low call RegPack(Buf, InData%n_FAST_low) if (RegCheckErr(Buf, RoutineName)) return - ! p_ref_Turbine call RegPack(Buf, InData%p_ref_Turbine) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1055,10 +919,8 @@ subroutine FWrap_UnPackParam(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! nr call RegUnpack(Buf, OutData%nr) if (RegCheckErr(Buf, RoutineName)) return - ! r if (allocated(OutData%r)) deallocate(OutData%r) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1073,89 +935,79 @@ subroutine FWrap_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%r) if (RegCheckErr(Buf, RoutineName)) return end if - ! n_FAST_low call RegUnpack(Buf, OutData%n_FAST_low) if (RegCheckErr(Buf, RoutineName)) return - ! p_ref_Turbine call RegUnpack(Buf, OutData%p_ref_Turbine) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE FWrap_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FWrap_InputType), INTENT(IN) :: SrcInputData - TYPE(FWrap_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_CopyInput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInputData%fromSCglob)) THEN - i1_l = LBOUND(SrcInputData%fromSCglob,1) - i1_u = UBOUND(SrcInputData%fromSCglob,1) - IF (.NOT. ALLOCATED(DstInputData%fromSCglob)) THEN - ALLOCATE(DstInputData%fromSCglob(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%fromSCglob.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%fromSCglob = SrcInputData%fromSCglob -ENDIF -IF (ALLOCATED(SrcInputData%fromSC)) THEN - i1_l = LBOUND(SrcInputData%fromSC,1) - i1_u = UBOUND(SrcInputData%fromSC,1) - IF (.NOT. ALLOCATED(DstInputData%fromSC)) THEN - ALLOCATE(DstInputData%fromSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%fromSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%fromSC = SrcInputData%fromSC -ENDIF - END SUBROUTINE FWrap_CopyInput - - SUBROUTINE FWrap_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(FWrap_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_DestroyInput' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputData%fromSCglob)) THEN - DEALLOCATE(InputData%fromSCglob) -ENDIF -IF (ALLOCATED(InputData%fromSC)) THEN - DEALLOCATE(InputData%fromSC) -ENDIF - END SUBROUTINE FWrap_DestroyInput +subroutine FWrap_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(FWrap_InputType), intent(in) :: SrcInputData + type(FWrap_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FWrap_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInputData%fromSCglob)) then + LB(1:1) = lbound(SrcInputData%fromSCglob) + UB(1:1) = ubound(SrcInputData%fromSCglob) + if (.not. allocated(DstInputData%fromSCglob)) then + allocate(DstInputData%fromSCglob(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%fromSCglob.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%fromSCglob = SrcInputData%fromSCglob + else if (allocated(DstInputData%fromSCglob)) then + deallocate(DstInputData%fromSCglob) + end if + if (allocated(SrcInputData%fromSC)) then + LB(1:1) = lbound(SrcInputData%fromSC) + UB(1:1) = ubound(SrcInputData%fromSC) + if (.not. allocated(DstInputData%fromSC)) then + allocate(DstInputData%fromSC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%fromSC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%fromSC = SrcInputData%fromSC + else if (allocated(DstInputData%fromSC)) then + deallocate(DstInputData%fromSC) + end if +end subroutine +subroutine FWrap_DestroyInput(InputData, ErrStat, ErrMsg) + type(FWrap_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FWrap_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%fromSCglob)) then + deallocate(InputData%fromSCglob) + end if + if (allocated(InputData%fromSC)) then + deallocate(InputData%fromSC) + end if +end subroutine subroutine FWrap_PackInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FWrap_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'FWrap_PackInput' if (Buf%ErrStat >= AbortErrLev) return - ! fromSCglob call RegPack(Buf, allocated(InData%fromSCglob)) if (allocated(InData%fromSCglob)) then call RegPackBounds(Buf, 1, lbound(InData%fromSCglob), ubound(InData%fromSCglob)) call RegPack(Buf, InData%fromSCglob) end if if (RegCheckErr(Buf, RoutineName)) return - ! fromSC call RegPack(Buf, allocated(InData%fromSC)) if (allocated(InData%fromSC)) then call RegPackBounds(Buf, 1, lbound(InData%fromSC), ubound(InData%fromSC)) @@ -1172,7 +1024,6 @@ subroutine FWrap_UnPackInput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! fromSCglob if (allocated(OutData%fromSCglob)) deallocate(OutData%fromSCglob) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1187,7 +1038,6 @@ subroutine FWrap_UnPackInput(Buf, OutData) call RegUnpack(Buf, OutData%fromSCglob) if (RegCheckErr(Buf, RoutineName)) return end if - ! fromSC if (allocated(OutData%fromSC)) deallocate(OutData%fromSC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1203,132 +1053,118 @@ subroutine FWrap_UnPackInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE FWrap_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FWrap_OutputType), INTENT(IN) :: SrcOutputData - TYPE(FWrap_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_CopyOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%toSC)) THEN - i1_l = LBOUND(SrcOutputData%toSC,1) - i1_u = UBOUND(SrcOutputData%toSC,1) - IF (.NOT. ALLOCATED(DstOutputData%toSC)) THEN - ALLOCATE(DstOutputData%toSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%toSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%toSC = SrcOutputData%toSC -ENDIF - DstOutputData%xHat_Disk = SrcOutputData%xHat_Disk - DstOutputData%YawErr = SrcOutputData%YawErr - DstOutputData%psi_skew = SrcOutputData%psi_skew - DstOutputData%chi_skew = SrcOutputData%chi_skew - DstOutputData%p_hub = SrcOutputData%p_hub - DstOutputData%D_rotor = SrcOutputData%D_rotor - DstOutputData%DiskAvg_Vx_Rel = SrcOutputData%DiskAvg_Vx_Rel -IF (ALLOCATED(SrcOutputData%AzimAvg_Ct)) THEN - i1_l = LBOUND(SrcOutputData%AzimAvg_Ct,1) - i1_u = UBOUND(SrcOutputData%AzimAvg_Ct,1) - IF (.NOT. ALLOCATED(DstOutputData%AzimAvg_Ct)) THEN - ALLOCATE(DstOutputData%AzimAvg_Ct(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%AzimAvg_Ct.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%AzimAvg_Ct = SrcOutputData%AzimAvg_Ct -ENDIF -IF (ALLOCATED(SrcOutputData%AzimAvg_Cq)) THEN - i1_l = LBOUND(SrcOutputData%AzimAvg_Cq,1) - i1_u = UBOUND(SrcOutputData%AzimAvg_Cq,1) - IF (.NOT. ALLOCATED(DstOutputData%AzimAvg_Cq)) THEN - ALLOCATE(DstOutputData%AzimAvg_Cq(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%AzimAvg_Cq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%AzimAvg_Cq = SrcOutputData%AzimAvg_Cq -ENDIF - END SUBROUTINE FWrap_CopyOutput - - SUBROUTINE FWrap_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(FWrap_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_DestroyOutput' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OutputData%toSC)) THEN - DEALLOCATE(OutputData%toSC) -ENDIF -IF (ALLOCATED(OutputData%AzimAvg_Ct)) THEN - DEALLOCATE(OutputData%AzimAvg_Ct) -ENDIF -IF (ALLOCATED(OutputData%AzimAvg_Cq)) THEN - DEALLOCATE(OutputData%AzimAvg_Cq) -ENDIF - END SUBROUTINE FWrap_DestroyOutput +subroutine FWrap_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(FWrap_OutputType), intent(in) :: SrcOutputData + type(FWrap_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FWrap_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%toSC)) then + LB(1:1) = lbound(SrcOutputData%toSC) + UB(1:1) = ubound(SrcOutputData%toSC) + if (.not. allocated(DstOutputData%toSC)) then + allocate(DstOutputData%toSC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%toSC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%toSC = SrcOutputData%toSC + else if (allocated(DstOutputData%toSC)) then + deallocate(DstOutputData%toSC) + end if + DstOutputData%xHat_Disk = SrcOutputData%xHat_Disk + DstOutputData%YawErr = SrcOutputData%YawErr + DstOutputData%psi_skew = SrcOutputData%psi_skew + DstOutputData%chi_skew = SrcOutputData%chi_skew + DstOutputData%p_hub = SrcOutputData%p_hub + DstOutputData%D_rotor = SrcOutputData%D_rotor + DstOutputData%DiskAvg_Vx_Rel = SrcOutputData%DiskAvg_Vx_Rel + if (allocated(SrcOutputData%AzimAvg_Ct)) then + LB(1:1) = lbound(SrcOutputData%AzimAvg_Ct) + UB(1:1) = ubound(SrcOutputData%AzimAvg_Ct) + if (.not. allocated(DstOutputData%AzimAvg_Ct)) then + allocate(DstOutputData%AzimAvg_Ct(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%AzimAvg_Ct.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%AzimAvg_Ct = SrcOutputData%AzimAvg_Ct + else if (allocated(DstOutputData%AzimAvg_Ct)) then + deallocate(DstOutputData%AzimAvg_Ct) + end if + if (allocated(SrcOutputData%AzimAvg_Cq)) then + LB(1:1) = lbound(SrcOutputData%AzimAvg_Cq) + UB(1:1) = ubound(SrcOutputData%AzimAvg_Cq) + if (.not. allocated(DstOutputData%AzimAvg_Cq)) then + allocate(DstOutputData%AzimAvg_Cq(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%AzimAvg_Cq.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%AzimAvg_Cq = SrcOutputData%AzimAvg_Cq + else if (allocated(DstOutputData%AzimAvg_Cq)) then + deallocate(DstOutputData%AzimAvg_Cq) + end if +end subroutine +subroutine FWrap_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(FWrap_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FWrap_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%toSC)) then + deallocate(OutputData%toSC) + end if + if (allocated(OutputData%AzimAvg_Ct)) then + deallocate(OutputData%AzimAvg_Ct) + end if + if (allocated(OutputData%AzimAvg_Cq)) then + deallocate(OutputData%AzimAvg_Cq) + end if +end subroutine subroutine FWrap_PackOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FWrap_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'FWrap_PackOutput' if (Buf%ErrStat >= AbortErrLev) return - ! toSC call RegPack(Buf, allocated(InData%toSC)) if (allocated(InData%toSC)) then call RegPackBounds(Buf, 1, lbound(InData%toSC), ubound(InData%toSC)) call RegPack(Buf, InData%toSC) end if if (RegCheckErr(Buf, RoutineName)) return - ! xHat_Disk call RegPack(Buf, InData%xHat_Disk) if (RegCheckErr(Buf, RoutineName)) return - ! YawErr call RegPack(Buf, InData%YawErr) if (RegCheckErr(Buf, RoutineName)) return - ! psi_skew call RegPack(Buf, InData%psi_skew) if (RegCheckErr(Buf, RoutineName)) return - ! chi_skew call RegPack(Buf, InData%chi_skew) if (RegCheckErr(Buf, RoutineName)) return - ! p_hub call RegPack(Buf, InData%p_hub) if (RegCheckErr(Buf, RoutineName)) return - ! D_rotor call RegPack(Buf, InData%D_rotor) if (RegCheckErr(Buf, RoutineName)) return - ! DiskAvg_Vx_Rel call RegPack(Buf, InData%DiskAvg_Vx_Rel) if (RegCheckErr(Buf, RoutineName)) return - ! AzimAvg_Ct call RegPack(Buf, allocated(InData%AzimAvg_Ct)) if (allocated(InData%AzimAvg_Ct)) then call RegPackBounds(Buf, 1, lbound(InData%AzimAvg_Ct), ubound(InData%AzimAvg_Ct)) call RegPack(Buf, InData%AzimAvg_Ct) end if if (RegCheckErr(Buf, RoutineName)) return - ! AzimAvg_Cq call RegPack(Buf, allocated(InData%AzimAvg_Cq)) if (allocated(InData%AzimAvg_Cq)) then call RegPackBounds(Buf, 1, lbound(InData%AzimAvg_Cq), ubound(InData%AzimAvg_Cq)) @@ -1345,7 +1181,6 @@ subroutine FWrap_UnPackOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! toSC if (allocated(OutData%toSC)) deallocate(OutData%toSC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1360,28 +1195,20 @@ subroutine FWrap_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%toSC) if (RegCheckErr(Buf, RoutineName)) return end if - ! xHat_Disk call RegUnpack(Buf, OutData%xHat_Disk) if (RegCheckErr(Buf, RoutineName)) return - ! YawErr call RegUnpack(Buf, OutData%YawErr) if (RegCheckErr(Buf, RoutineName)) return - ! psi_skew call RegUnpack(Buf, OutData%psi_skew) if (RegCheckErr(Buf, RoutineName)) return - ! chi_skew call RegUnpack(Buf, OutData%chi_skew) if (RegCheckErr(Buf, RoutineName)) return - ! p_hub call RegUnpack(Buf, OutData%p_hub) if (RegCheckErr(Buf, RoutineName)) return - ! D_rotor call RegUnpack(Buf, OutData%D_rotor) if (RegCheckErr(Buf, RoutineName)) return - ! DiskAvg_Vx_Rel call RegUnpack(Buf, OutData%DiskAvg_Vx_Rel) if (RegCheckErr(Buf, RoutineName)) return - ! AzimAvg_Ct if (allocated(OutData%AzimAvg_Ct)) deallocate(OutData%AzimAvg_Ct) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1396,7 +1223,6 @@ subroutine FWrap_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%AzimAvg_Ct) if (RegCheckErr(Buf, RoutineName)) return end if - ! AzimAvg_Cq if (allocated(OutData%AzimAvg_Cq)) deallocate(OutData%AzimAvg_Cq) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/glue-codes/fast-farm/src/FAST_Farm_Types.f90 b/glue-codes/fast-farm/src/FAST_Farm_Types.f90 index 4bbe757f1e..c074c8c900 100644 --- a/glue-codes/fast-farm/src/FAST_Farm_Types.f90 +++ b/glue-codes/fast-farm/src/FAST_Farm_Types.f90 @@ -190,221 +190,228 @@ MODULE FAST_Farm_Types END TYPE All_FastFarm_Data ! ======================= CONTAINS - SUBROUTINE Farm_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Farm_ParameterType), INTENT(IN) :: SrcParamData - TYPE(Farm_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Farm_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT_low = SrcParamData%DT_low - DstParamData%DT_high = SrcParamData%DT_high - DstParamData%TMax = SrcParamData%TMax - DstParamData%n_high_low = SrcParamData%n_high_low - DstParamData%NumTurbines = SrcParamData%NumTurbines - DstParamData%WindFilePath = SrcParamData%WindFilePath - DstParamData%SC_FileName = SrcParamData%SC_FileName - DstParamData%UseSC = SrcParamData%UseSC -IF (ALLOCATED(SrcParamData%WT_Position)) THEN - i1_l = LBOUND(SrcParamData%WT_Position,1) - i1_u = UBOUND(SrcParamData%WT_Position,1) - i2_l = LBOUND(SrcParamData%WT_Position,2) - i2_u = UBOUND(SrcParamData%WT_Position,2) - IF (.NOT. ALLOCATED(DstParamData%WT_Position)) THEN - ALLOCATE(DstParamData%WT_Position(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WT_Position.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WT_Position = SrcParamData%WT_Position -ENDIF - DstParamData%WaveFieldMod = SrcParamData%WaveFieldMod - DstParamData%MooringMod = SrcParamData%MooringMod - DstParamData%MD_FileName = SrcParamData%MD_FileName - DstParamData%DT_mooring = SrcParamData%DT_mooring - DstParamData%n_mooring = SrcParamData%n_mooring -IF (ALLOCATED(SrcParamData%WT_FASTInFile)) THEN - i1_l = LBOUND(SrcParamData%WT_FASTInFile,1) - i1_u = UBOUND(SrcParamData%WT_FASTInFile,1) - IF (.NOT. ALLOCATED(DstParamData%WT_FASTInFile)) THEN - ALLOCATE(DstParamData%WT_FASTInFile(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WT_FASTInFile.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WT_FASTInFile = SrcParamData%WT_FASTInFile -ENDIF - DstParamData%FTitle = SrcParamData%FTitle - DstParamData%OutFileRoot = SrcParamData%OutFileRoot - DstParamData%n_ChkptTime = SrcParamData%n_ChkptTime - DstParamData%TStart = SrcParamData%TStart - DstParamData%n_TMax = SrcParamData%n_TMax - DstParamData%SumPrint = SrcParamData%SumPrint - DstParamData%WrBinOutFile = SrcParamData%WrBinOutFile - DstParamData%WrTxtOutFile = SrcParamData%WrTxtOutFile - DstParamData%Delim = SrcParamData%Delim - DstParamData%OutFmt = SrcParamData%OutFmt - DstParamData%OutFmt_t = SrcParamData%OutFmt_t - DstParamData%FmtWidth = SrcParamData%FmtWidth - DstParamData%TChanLen = SrcParamData%TChanLen - DstParamData%NOutTurb = SrcParamData%NOutTurb - DstParamData%NOutRadii = SrcParamData%NOutRadii -IF (ALLOCATED(SrcParamData%OutRadii)) THEN - i1_l = LBOUND(SrcParamData%OutRadii,1) - i1_u = UBOUND(SrcParamData%OutRadii,1) - IF (.NOT. ALLOCATED(DstParamData%OutRadii)) THEN - ALLOCATE(DstParamData%OutRadii(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutRadii.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%OutRadii = SrcParamData%OutRadii -ENDIF - DstParamData%NOutDist = SrcParamData%NOutDist -IF (ALLOCATED(SrcParamData%OutDist)) THEN - i1_l = LBOUND(SrcParamData%OutDist,1) - i1_u = UBOUND(SrcParamData%OutDist,1) - IF (.NOT. ALLOCATED(DstParamData%OutDist)) THEN - ALLOCATE(DstParamData%OutDist(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutDist.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%OutDist = SrcParamData%OutDist -ENDIF - DstParamData%NWindVel = SrcParamData%NWindVel -IF (ALLOCATED(SrcParamData%WindVelX)) THEN - i1_l = LBOUND(SrcParamData%WindVelX,1) - i1_u = UBOUND(SrcParamData%WindVelX,1) - IF (.NOT. ALLOCATED(DstParamData%WindVelX)) THEN - ALLOCATE(DstParamData%WindVelX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WindVelX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WindVelX = SrcParamData%WindVelX -ENDIF -IF (ALLOCATED(SrcParamData%WindVelY)) THEN - i1_l = LBOUND(SrcParamData%WindVelY,1) - i1_u = UBOUND(SrcParamData%WindVelY,1) - IF (.NOT. ALLOCATED(DstParamData%WindVelY)) THEN - ALLOCATE(DstParamData%WindVelY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WindVelY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WindVelY = SrcParamData%WindVelY -ENDIF -IF (ALLOCATED(SrcParamData%WindVelZ)) THEN - i1_l = LBOUND(SrcParamData%WindVelZ,1) - i1_u = UBOUND(SrcParamData%WindVelZ,1) - IF (.NOT. ALLOCATED(DstParamData%WindVelZ)) THEN - ALLOCATE(DstParamData%WindVelZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WindVelZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WindVelZ = SrcParamData%WindVelZ -ENDIF -IF (ALLOCATED(SrcParamData%OutParam)) THEN - i1_l = LBOUND(SrcParamData%OutParam,1) - i1_u = UBOUND(SrcParamData%OutParam,1) - IF (.NOT. ALLOCATED(DstParamData%OutParam)) THEN - ALLOCATE(DstParamData%OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%OutParam,1), UBOUND(SrcParamData%OutParam,1) - CALL NWTC_Library_Copyoutparmtype( SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%NOutSteps = SrcParamData%NOutSteps - DstParamData%FileDescLines = SrcParamData%FileDescLines - DO i1 = LBOUND(SrcParamData%Module_Ver,1), UBOUND(SrcParamData%Module_Ver,1) - CALL NWTC_Library_Copyprogdesc( SrcParamData%Module_Ver(i1), DstParamData%Module_Ver(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DstParamData%UnOu = SrcParamData%UnOu - DstParamData%dX_low = SrcParamData%dX_low - DstParamData%dY_low = SrcParamData%dY_low - DstParamData%dZ_low = SrcParamData%dZ_low - DstParamData%nX_low = SrcParamData%nX_low - DstParamData%nY_low = SrcParamData%nY_low - DstParamData%nZ_low = SrcParamData%nZ_low - DstParamData%X0_low = SrcParamData%X0_low - DstParamData%Y0_low = SrcParamData%Y0_low - DstParamData%Z0_low = SrcParamData%Z0_low - END SUBROUTINE Farm_CopyParam - - SUBROUTINE Farm_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(Farm_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Farm_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(ParamData%WT_Position)) THEN - DEALLOCATE(ParamData%WT_Position) -ENDIF -IF (ALLOCATED(ParamData%WT_FASTInFile)) THEN - DEALLOCATE(ParamData%WT_FASTInFile) -ENDIF -IF (ALLOCATED(ParamData%OutRadii)) THEN - DEALLOCATE(ParamData%OutRadii) -ENDIF -IF (ALLOCATED(ParamData%OutDist)) THEN - DEALLOCATE(ParamData%OutDist) -ENDIF -IF (ALLOCATED(ParamData%WindVelX)) THEN - DEALLOCATE(ParamData%WindVelX) -ENDIF -IF (ALLOCATED(ParamData%WindVelY)) THEN - DEALLOCATE(ParamData%WindVelY) -ENDIF -IF (ALLOCATED(ParamData%WindVelZ)) THEN - DEALLOCATE(ParamData%WindVelZ) -ENDIF -IF (ALLOCATED(ParamData%OutParam)) THEN -DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_DestroyOutParmType( ParamData%OutParam(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%OutParam) -ENDIF -DO i1 = LBOUND(ParamData%Module_Ver,1), UBOUND(ParamData%Module_Ver,1) - CALL NWTC_Library_DestroyProgDesc( ParamData%Module_Ver(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - END SUBROUTINE Farm_DestroyParam +subroutine Farm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(Farm_ParameterType), intent(in) :: SrcParamData + type(Farm_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%DT_low = SrcParamData%DT_low + DstParamData%DT_high = SrcParamData%DT_high + DstParamData%TMax = SrcParamData%TMax + DstParamData%n_high_low = SrcParamData%n_high_low + DstParamData%NumTurbines = SrcParamData%NumTurbines + DstParamData%WindFilePath = SrcParamData%WindFilePath + DstParamData%SC_FileName = SrcParamData%SC_FileName + DstParamData%UseSC = SrcParamData%UseSC + if (allocated(SrcParamData%WT_Position)) then + LB(1:2) = lbound(SrcParamData%WT_Position) + UB(1:2) = ubound(SrcParamData%WT_Position) + if (.not. allocated(DstParamData%WT_Position)) then + allocate(DstParamData%WT_Position(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WT_Position.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WT_Position = SrcParamData%WT_Position + else if (allocated(DstParamData%WT_Position)) then + deallocate(DstParamData%WT_Position) + end if + DstParamData%WaveFieldMod = SrcParamData%WaveFieldMod + DstParamData%MooringMod = SrcParamData%MooringMod + DstParamData%MD_FileName = SrcParamData%MD_FileName + DstParamData%DT_mooring = SrcParamData%DT_mooring + DstParamData%n_mooring = SrcParamData%n_mooring + if (allocated(SrcParamData%WT_FASTInFile)) then + LB(1:1) = lbound(SrcParamData%WT_FASTInFile) + UB(1:1) = ubound(SrcParamData%WT_FASTInFile) + if (.not. allocated(DstParamData%WT_FASTInFile)) then + allocate(DstParamData%WT_FASTInFile(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WT_FASTInFile.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WT_FASTInFile = SrcParamData%WT_FASTInFile + else if (allocated(DstParamData%WT_FASTInFile)) then + deallocate(DstParamData%WT_FASTInFile) + end if + DstParamData%FTitle = SrcParamData%FTitle + DstParamData%OutFileRoot = SrcParamData%OutFileRoot + DstParamData%n_ChkptTime = SrcParamData%n_ChkptTime + DstParamData%TStart = SrcParamData%TStart + DstParamData%n_TMax = SrcParamData%n_TMax + DstParamData%SumPrint = SrcParamData%SumPrint + DstParamData%WrBinOutFile = SrcParamData%WrBinOutFile + DstParamData%WrTxtOutFile = SrcParamData%WrTxtOutFile + DstParamData%Delim = SrcParamData%Delim + DstParamData%OutFmt = SrcParamData%OutFmt + DstParamData%OutFmt_t = SrcParamData%OutFmt_t + DstParamData%FmtWidth = SrcParamData%FmtWidth + DstParamData%TChanLen = SrcParamData%TChanLen + DstParamData%NOutTurb = SrcParamData%NOutTurb + DstParamData%NOutRadii = SrcParamData%NOutRadii + if (allocated(SrcParamData%OutRadii)) then + LB(1:1) = lbound(SrcParamData%OutRadii) + UB(1:1) = ubound(SrcParamData%OutRadii) + if (.not. allocated(DstParamData%OutRadii)) then + allocate(DstParamData%OutRadii(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutRadii.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%OutRadii = SrcParamData%OutRadii + else if (allocated(DstParamData%OutRadii)) then + deallocate(DstParamData%OutRadii) + end if + DstParamData%NOutDist = SrcParamData%NOutDist + if (allocated(SrcParamData%OutDist)) then + LB(1:1) = lbound(SrcParamData%OutDist) + UB(1:1) = ubound(SrcParamData%OutDist) + if (.not. allocated(DstParamData%OutDist)) then + allocate(DstParamData%OutDist(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutDist.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%OutDist = SrcParamData%OutDist + else if (allocated(DstParamData%OutDist)) then + deallocate(DstParamData%OutDist) + end if + DstParamData%NWindVel = SrcParamData%NWindVel + if (allocated(SrcParamData%WindVelX)) then + LB(1:1) = lbound(SrcParamData%WindVelX) + UB(1:1) = ubound(SrcParamData%WindVelX) + if (.not. allocated(DstParamData%WindVelX)) then + allocate(DstParamData%WindVelX(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WindVelX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WindVelX = SrcParamData%WindVelX + else if (allocated(DstParamData%WindVelX)) then + deallocate(DstParamData%WindVelX) + end if + if (allocated(SrcParamData%WindVelY)) then + LB(1:1) = lbound(SrcParamData%WindVelY) + UB(1:1) = ubound(SrcParamData%WindVelY) + if (.not. allocated(DstParamData%WindVelY)) then + allocate(DstParamData%WindVelY(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WindVelY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WindVelY = SrcParamData%WindVelY + else if (allocated(DstParamData%WindVelY)) then + deallocate(DstParamData%WindVelY) + end if + if (allocated(SrcParamData%WindVelZ)) then + LB(1:1) = lbound(SrcParamData%WindVelZ) + UB(1:1) = ubound(SrcParamData%WindVelZ) + if (.not. allocated(DstParamData%WindVelZ)) then + allocate(DstParamData%WindVelZ(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WindVelZ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WindVelZ = SrcParamData%WindVelZ + else if (allocated(DstParamData%WindVelZ)) then + deallocate(DstParamData%WindVelZ) + end if + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstParamData%OutParam)) then + deallocate(DstParamData%OutParam) + end if + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%NOutSteps = SrcParamData%NOutSteps + DstParamData%FileDescLines = SrcParamData%FileDescLines + do i1 = LB(1), UB(1) + call NWTC_Library_CopyProgDesc(SrcParamData%Module_Ver(i1), DstParamData%Module_Ver(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + DstParamData%UnOu = SrcParamData%UnOu + DstParamData%dX_low = SrcParamData%dX_low + DstParamData%dY_low = SrcParamData%dY_low + DstParamData%dZ_low = SrcParamData%dZ_low + DstParamData%nX_low = SrcParamData%nX_low + DstParamData%nY_low = SrcParamData%nY_low + DstParamData%nZ_low = SrcParamData%nZ_low + DstParamData%X0_low = SrcParamData%X0_low + DstParamData%Y0_low = SrcParamData%Y0_low + DstParamData%Z0_low = SrcParamData%Z0_low +end subroutine +subroutine Farm_DestroyParam(ParamData, ErrStat, ErrMsg) + type(Farm_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%WT_Position)) then + deallocate(ParamData%WT_Position) + end if + if (allocated(ParamData%WT_FASTInFile)) then + deallocate(ParamData%WT_FASTInFile) + end if + if (allocated(ParamData%OutRadii)) then + deallocate(ParamData%OutRadii) + end if + if (allocated(ParamData%OutDist)) then + deallocate(ParamData%OutDist) + end if + if (allocated(ParamData%WindVelX)) then + deallocate(ParamData%WindVelX) + end if + if (allocated(ParamData%WindVelY)) then + deallocate(ParamData%WindVelY) + end if + if (allocated(ParamData%WindVelZ)) then + deallocate(ParamData%WindVelZ) + end if + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%OutParam) + end if +end subroutine subroutine Farm_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -413,146 +420,108 @@ subroutine Farm_PackParam(Buf, Indata) integer(IntKi) :: i1, i2 integer(IntKi) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return - ! DT_low call RegPack(Buf, InData%DT_low) if (RegCheckErr(Buf, RoutineName)) return - ! DT_high call RegPack(Buf, InData%DT_high) if (RegCheckErr(Buf, RoutineName)) return - ! TMax call RegPack(Buf, InData%TMax) if (RegCheckErr(Buf, RoutineName)) return - ! n_high_low call RegPack(Buf, InData%n_high_low) if (RegCheckErr(Buf, RoutineName)) return - ! NumTurbines call RegPack(Buf, InData%NumTurbines) if (RegCheckErr(Buf, RoutineName)) return - ! WindFilePath call RegPack(Buf, InData%WindFilePath) if (RegCheckErr(Buf, RoutineName)) return - ! SC_FileName call RegPack(Buf, InData%SC_FileName) if (RegCheckErr(Buf, RoutineName)) return - ! UseSC call RegPack(Buf, InData%UseSC) if (RegCheckErr(Buf, RoutineName)) return - ! WT_Position call RegPack(Buf, allocated(InData%WT_Position)) if (allocated(InData%WT_Position)) then call RegPackBounds(Buf, 2, lbound(InData%WT_Position), ubound(InData%WT_Position)) call RegPack(Buf, InData%WT_Position) end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveFieldMod call RegPack(Buf, InData%WaveFieldMod) if (RegCheckErr(Buf, RoutineName)) return - ! MooringMod call RegPack(Buf, InData%MooringMod) if (RegCheckErr(Buf, RoutineName)) return - ! MD_FileName call RegPack(Buf, InData%MD_FileName) if (RegCheckErr(Buf, RoutineName)) return - ! DT_mooring call RegPack(Buf, InData%DT_mooring) if (RegCheckErr(Buf, RoutineName)) return - ! n_mooring call RegPack(Buf, InData%n_mooring) if (RegCheckErr(Buf, RoutineName)) return - ! WT_FASTInFile call RegPack(Buf, allocated(InData%WT_FASTInFile)) if (allocated(InData%WT_FASTInFile)) then call RegPackBounds(Buf, 1, lbound(InData%WT_FASTInFile), ubound(InData%WT_FASTInFile)) call RegPack(Buf, InData%WT_FASTInFile) end if if (RegCheckErr(Buf, RoutineName)) return - ! FTitle call RegPack(Buf, InData%FTitle) if (RegCheckErr(Buf, RoutineName)) return - ! OutFileRoot call RegPack(Buf, InData%OutFileRoot) if (RegCheckErr(Buf, RoutineName)) return - ! n_ChkptTime call RegPack(Buf, InData%n_ChkptTime) if (RegCheckErr(Buf, RoutineName)) return - ! TStart call RegPack(Buf, InData%TStart) if (RegCheckErr(Buf, RoutineName)) return - ! n_TMax call RegPack(Buf, InData%n_TMax) if (RegCheckErr(Buf, RoutineName)) return - ! SumPrint call RegPack(Buf, InData%SumPrint) if (RegCheckErr(Buf, RoutineName)) return - ! WrBinOutFile call RegPack(Buf, InData%WrBinOutFile) if (RegCheckErr(Buf, RoutineName)) return - ! WrTxtOutFile call RegPack(Buf, InData%WrTxtOutFile) if (RegCheckErr(Buf, RoutineName)) return - ! Delim call RegPack(Buf, InData%Delim) if (RegCheckErr(Buf, RoutineName)) return - ! OutFmt call RegPack(Buf, InData%OutFmt) if (RegCheckErr(Buf, RoutineName)) return - ! OutFmt_t call RegPack(Buf, InData%OutFmt_t) if (RegCheckErr(Buf, RoutineName)) return - ! FmtWidth call RegPack(Buf, InData%FmtWidth) if (RegCheckErr(Buf, RoutineName)) return - ! TChanLen call RegPack(Buf, InData%TChanLen) if (RegCheckErr(Buf, RoutineName)) return - ! NOutTurb call RegPack(Buf, InData%NOutTurb) if (RegCheckErr(Buf, RoutineName)) return - ! NOutRadii call RegPack(Buf, InData%NOutRadii) if (RegCheckErr(Buf, RoutineName)) return - ! OutRadii call RegPack(Buf, allocated(InData%OutRadii)) if (allocated(InData%OutRadii)) then call RegPackBounds(Buf, 1, lbound(InData%OutRadii), ubound(InData%OutRadii)) call RegPack(Buf, InData%OutRadii) end if if (RegCheckErr(Buf, RoutineName)) return - ! NOutDist call RegPack(Buf, InData%NOutDist) if (RegCheckErr(Buf, RoutineName)) return - ! OutDist call RegPack(Buf, allocated(InData%OutDist)) if (allocated(InData%OutDist)) then call RegPackBounds(Buf, 1, lbound(InData%OutDist), ubound(InData%OutDist)) call RegPack(Buf, InData%OutDist) end if if (RegCheckErr(Buf, RoutineName)) return - ! NWindVel call RegPack(Buf, InData%NWindVel) if (RegCheckErr(Buf, RoutineName)) return - ! WindVelX call RegPack(Buf, allocated(InData%WindVelX)) if (allocated(InData%WindVelX)) then call RegPackBounds(Buf, 1, lbound(InData%WindVelX), ubound(InData%WindVelX)) call RegPack(Buf, InData%WindVelX) end if if (RegCheckErr(Buf, RoutineName)) return - ! WindVelY call RegPack(Buf, allocated(InData%WindVelY)) if (allocated(InData%WindVelY)) then call RegPackBounds(Buf, 1, lbound(InData%WindVelY), ubound(InData%WindVelY)) call RegPack(Buf, InData%WindVelY) end if if (RegCheckErr(Buf, RoutineName)) return - ! WindVelZ call RegPack(Buf, allocated(InData%WindVelZ)) if (allocated(InData%WindVelZ)) then call RegPackBounds(Buf, 1, lbound(InData%WindVelZ), ubound(InData%WindVelZ)) call RegPack(Buf, InData%WindVelZ) end if if (RegCheckErr(Buf, RoutineName)) return - ! OutParam call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) @@ -563,50 +532,36 @@ subroutine Farm_PackParam(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegPack(Buf, InData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! NOutSteps call RegPack(Buf, InData%NOutSteps) if (RegCheckErr(Buf, RoutineName)) return - ! FileDescLines call RegPack(Buf, InData%FileDescLines) if (RegCheckErr(Buf, RoutineName)) return - ! Module_Ver LB(1:1) = lbound(InData%Module_Ver) UB(1:1) = ubound(InData%Module_Ver) do i1 = LB(1), UB(1) call NWTC_Library_PackProgDesc(Buf, InData%Module_Ver(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! UnOu call RegPack(Buf, InData%UnOu) if (RegCheckErr(Buf, RoutineName)) return - ! dX_low call RegPack(Buf, InData%dX_low) if (RegCheckErr(Buf, RoutineName)) return - ! dY_low call RegPack(Buf, InData%dY_low) if (RegCheckErr(Buf, RoutineName)) return - ! dZ_low call RegPack(Buf, InData%dZ_low) if (RegCheckErr(Buf, RoutineName)) return - ! nX_low call RegPack(Buf, InData%nX_low) if (RegCheckErr(Buf, RoutineName)) return - ! nY_low call RegPack(Buf, InData%nY_low) if (RegCheckErr(Buf, RoutineName)) return - ! nZ_low call RegPack(Buf, InData%nZ_low) if (RegCheckErr(Buf, RoutineName)) return - ! X0_low call RegPack(Buf, InData%X0_low) if (RegCheckErr(Buf, RoutineName)) return - ! Y0_low call RegPack(Buf, InData%Y0_low) if (RegCheckErr(Buf, RoutineName)) return - ! Z0_low call RegPack(Buf, InData%Z0_low) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -620,31 +575,22 @@ subroutine Farm_UnPackParam(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! DT_low call RegUnpack(Buf, OutData%DT_low) if (RegCheckErr(Buf, RoutineName)) return - ! DT_high call RegUnpack(Buf, OutData%DT_high) if (RegCheckErr(Buf, RoutineName)) return - ! TMax call RegUnpack(Buf, OutData%TMax) if (RegCheckErr(Buf, RoutineName)) return - ! n_high_low call RegUnpack(Buf, OutData%n_high_low) if (RegCheckErr(Buf, RoutineName)) return - ! NumTurbines call RegUnpack(Buf, OutData%NumTurbines) if (RegCheckErr(Buf, RoutineName)) return - ! WindFilePath call RegUnpack(Buf, OutData%WindFilePath) if (RegCheckErr(Buf, RoutineName)) return - ! SC_FileName call RegUnpack(Buf, OutData%SC_FileName) if (RegCheckErr(Buf, RoutineName)) return - ! UseSC call RegUnpack(Buf, OutData%UseSC) if (RegCheckErr(Buf, RoutineName)) return - ! WT_Position if (allocated(OutData%WT_Position)) deallocate(OutData%WT_Position) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -659,22 +605,16 @@ subroutine Farm_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%WT_Position) if (RegCheckErr(Buf, RoutineName)) return end if - ! WaveFieldMod call RegUnpack(Buf, OutData%WaveFieldMod) if (RegCheckErr(Buf, RoutineName)) return - ! MooringMod call RegUnpack(Buf, OutData%MooringMod) if (RegCheckErr(Buf, RoutineName)) return - ! MD_FileName call RegUnpack(Buf, OutData%MD_FileName) if (RegCheckErr(Buf, RoutineName)) return - ! DT_mooring call RegUnpack(Buf, OutData%DT_mooring) if (RegCheckErr(Buf, RoutineName)) return - ! n_mooring call RegUnpack(Buf, OutData%n_mooring) if (RegCheckErr(Buf, RoutineName)) return - ! WT_FASTInFile if (allocated(OutData%WT_FASTInFile)) deallocate(OutData%WT_FASTInFile) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -689,52 +629,36 @@ subroutine Farm_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%WT_FASTInFile) if (RegCheckErr(Buf, RoutineName)) return end if - ! FTitle call RegUnpack(Buf, OutData%FTitle) if (RegCheckErr(Buf, RoutineName)) return - ! OutFileRoot call RegUnpack(Buf, OutData%OutFileRoot) if (RegCheckErr(Buf, RoutineName)) return - ! n_ChkptTime call RegUnpack(Buf, OutData%n_ChkptTime) if (RegCheckErr(Buf, RoutineName)) return - ! TStart call RegUnpack(Buf, OutData%TStart) if (RegCheckErr(Buf, RoutineName)) return - ! n_TMax call RegUnpack(Buf, OutData%n_TMax) if (RegCheckErr(Buf, RoutineName)) return - ! SumPrint call RegUnpack(Buf, OutData%SumPrint) if (RegCheckErr(Buf, RoutineName)) return - ! WrBinOutFile call RegUnpack(Buf, OutData%WrBinOutFile) if (RegCheckErr(Buf, RoutineName)) return - ! WrTxtOutFile call RegUnpack(Buf, OutData%WrTxtOutFile) if (RegCheckErr(Buf, RoutineName)) return - ! Delim call RegUnpack(Buf, OutData%Delim) if (RegCheckErr(Buf, RoutineName)) return - ! OutFmt call RegUnpack(Buf, OutData%OutFmt) if (RegCheckErr(Buf, RoutineName)) return - ! OutFmt_t call RegUnpack(Buf, OutData%OutFmt_t) if (RegCheckErr(Buf, RoutineName)) return - ! FmtWidth call RegUnpack(Buf, OutData%FmtWidth) if (RegCheckErr(Buf, RoutineName)) return - ! TChanLen call RegUnpack(Buf, OutData%TChanLen) if (RegCheckErr(Buf, RoutineName)) return - ! NOutTurb call RegUnpack(Buf, OutData%NOutTurb) if (RegCheckErr(Buf, RoutineName)) return - ! NOutRadii call RegUnpack(Buf, OutData%NOutRadii) if (RegCheckErr(Buf, RoutineName)) return - ! OutRadii if (allocated(OutData%OutRadii)) deallocate(OutData%OutRadii) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -749,10 +673,8 @@ subroutine Farm_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%OutRadii) if (RegCheckErr(Buf, RoutineName)) return end if - ! NOutDist call RegUnpack(Buf, OutData%NOutDist) if (RegCheckErr(Buf, RoutineName)) return - ! OutDist if (allocated(OutData%OutDist)) deallocate(OutData%OutDist) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -767,10 +689,8 @@ subroutine Farm_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%OutDist) if (RegCheckErr(Buf, RoutineName)) return end if - ! NWindVel call RegUnpack(Buf, OutData%NWindVel) if (RegCheckErr(Buf, RoutineName)) return - ! WindVelX if (allocated(OutData%WindVelX)) deallocate(OutData%WindVelX) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -785,7 +705,6 @@ subroutine Farm_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%WindVelX) if (RegCheckErr(Buf, RoutineName)) return end if - ! WindVelY if (allocated(OutData%WindVelY)) deallocate(OutData%WindVelY) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -800,7 +719,6 @@ subroutine Farm_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%WindVelY) if (RegCheckErr(Buf, RoutineName)) return end if - ! WindVelZ if (allocated(OutData%WindVelZ)) deallocate(OutData%WindVelZ) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -815,7 +733,6 @@ subroutine Farm_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%WindVelZ) if (RegCheckErr(Buf, RoutineName)) return end if - ! OutParam if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -831,179 +748,172 @@ subroutine Farm_UnPackParam(Buf, OutData) call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam end do end if - ! NumOuts call RegUnpack(Buf, OutData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! NOutSteps call RegUnpack(Buf, OutData%NOutSteps) if (RegCheckErr(Buf, RoutineName)) return - ! FileDescLines call RegUnpack(Buf, OutData%FileDescLines) if (RegCheckErr(Buf, RoutineName)) return - ! Module_Ver LB(1:1) = lbound(OutData%Module_Ver) UB(1:1) = ubound(OutData%Module_Ver) do i1 = LB(1), UB(1) call NWTC_Library_UnpackProgDesc(Buf, OutData%Module_Ver(i1)) ! Module_Ver end do - ! UnOu call RegUnpack(Buf, OutData%UnOu) if (RegCheckErr(Buf, RoutineName)) return - ! dX_low call RegUnpack(Buf, OutData%dX_low) if (RegCheckErr(Buf, RoutineName)) return - ! dY_low call RegUnpack(Buf, OutData%dY_low) if (RegCheckErr(Buf, RoutineName)) return - ! dZ_low call RegUnpack(Buf, OutData%dZ_low) if (RegCheckErr(Buf, RoutineName)) return - ! nX_low call RegUnpack(Buf, OutData%nX_low) if (RegCheckErr(Buf, RoutineName)) return - ! nY_low call RegUnpack(Buf, OutData%nY_low) if (RegCheckErr(Buf, RoutineName)) return - ! nZ_low call RegUnpack(Buf, OutData%nZ_low) if (RegCheckErr(Buf, RoutineName)) return - ! X0_low call RegUnpack(Buf, OutData%X0_low) if (RegCheckErr(Buf, RoutineName)) return - ! Y0_low call RegUnpack(Buf, OutData%Y0_low) if (RegCheckErr(Buf, RoutineName)) return - ! Z0_low call RegUnpack(Buf, OutData%Z0_low) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Farm_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Farm_MiscVarType), INTENT(INOUT) :: SrcMiscData - TYPE(Farm_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Farm_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscData%AllOuts)) THEN - i1_l = LBOUND(SrcMiscData%AllOuts,1) - i1_u = UBOUND(SrcMiscData%AllOuts,1) - IF (.NOT. ALLOCATED(DstMiscData%AllOuts)) THEN - ALLOCATE(DstMiscData%AllOuts(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%AllOuts = SrcMiscData%AllOuts -ENDIF -IF (ALLOCATED(SrcMiscData%TimeData)) THEN - i1_l = LBOUND(SrcMiscData%TimeData,1) - i1_u = UBOUND(SrcMiscData%TimeData,1) - IF (.NOT. ALLOCATED(DstMiscData%TimeData)) THEN - ALLOCATE(DstMiscData%TimeData(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TimeData.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%TimeData = SrcMiscData%TimeData -ENDIF -IF (ALLOCATED(SrcMiscData%AllOutData)) THEN - i1_l = LBOUND(SrcMiscData%AllOutData,1) - i1_u = UBOUND(SrcMiscData%AllOutData,1) - i2_l = LBOUND(SrcMiscData%AllOutData,2) - i2_u = UBOUND(SrcMiscData%AllOutData,2) - IF (.NOT. ALLOCATED(DstMiscData%AllOutData)) THEN - ALLOCATE(DstMiscData%AllOutData(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOutData.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%AllOutData = SrcMiscData%AllOutData -ENDIF - DstMiscData%n_Out = SrcMiscData%n_Out -IF (ALLOCATED(SrcMiscData%FWrap_2_MD)) THEN - i1_l = LBOUND(SrcMiscData%FWrap_2_MD,1) - i1_u = UBOUND(SrcMiscData%FWrap_2_MD,1) - IF (.NOT. ALLOCATED(DstMiscData%FWrap_2_MD)) THEN - ALLOCATE(DstMiscData%FWrap_2_MD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FWrap_2_MD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%FWrap_2_MD,1), UBOUND(SrcMiscData%FWrap_2_MD,1) - CALL NWTC_Library_Copymeshmaptype( SrcMiscData%FWrap_2_MD(i1), DstMiscData%FWrap_2_MD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%MD_2_FWrap)) THEN - i1_l = LBOUND(SrcMiscData%MD_2_FWrap,1) - i1_u = UBOUND(SrcMiscData%MD_2_FWrap,1) - IF (.NOT. ALLOCATED(DstMiscData%MD_2_FWrap)) THEN - ALLOCATE(DstMiscData%MD_2_FWrap(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%MD_2_FWrap.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%MD_2_FWrap,1), UBOUND(SrcMiscData%MD_2_FWrap,1) - CALL NWTC_Library_Copymeshmaptype( SrcMiscData%MD_2_FWrap(i1), DstMiscData%MD_2_FWrap(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE Farm_CopyMisc - - SUBROUTINE Farm_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(Farm_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Farm_DestroyMisc' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MiscData%AllOuts)) THEN - DEALLOCATE(MiscData%AllOuts) -ENDIF -IF (ALLOCATED(MiscData%TimeData)) THEN - DEALLOCATE(MiscData%TimeData) -ENDIF -IF (ALLOCATED(MiscData%AllOutData)) THEN - DEALLOCATE(MiscData%AllOutData) -ENDIF -IF (ALLOCATED(MiscData%FWrap_2_MD)) THEN -DO i1 = LBOUND(MiscData%FWrap_2_MD,1), UBOUND(MiscData%FWrap_2_MD,1) - CALL NWTC_Library_DestroyMeshMapType( MiscData%FWrap_2_MD(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%FWrap_2_MD) -ENDIF -IF (ALLOCATED(MiscData%MD_2_FWrap)) THEN -DO i1 = LBOUND(MiscData%MD_2_FWrap,1), UBOUND(MiscData%MD_2_FWrap,1) - CALL NWTC_Library_DestroyMeshMapType( MiscData%MD_2_FWrap(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%MD_2_FWrap) -ENDIF - END SUBROUTINE Farm_DestroyMisc +subroutine Farm_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(Farm_MiscVarType), intent(inout) :: SrcMiscData + type(Farm_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMiscData%AllOuts)) then + LB(1:1) = lbound(SrcMiscData%AllOuts) + UB(1:1) = ubound(SrcMiscData%AllOuts) + if (.not. allocated(DstMiscData%AllOuts)) then + allocate(DstMiscData%AllOuts(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%AllOuts = SrcMiscData%AllOuts + else if (allocated(DstMiscData%AllOuts)) then + deallocate(DstMiscData%AllOuts) + end if + if (allocated(SrcMiscData%TimeData)) then + LB(1:1) = lbound(SrcMiscData%TimeData) + UB(1:1) = ubound(SrcMiscData%TimeData) + if (.not. allocated(DstMiscData%TimeData)) then + allocate(DstMiscData%TimeData(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TimeData.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%TimeData = SrcMiscData%TimeData + else if (allocated(DstMiscData%TimeData)) then + deallocate(DstMiscData%TimeData) + end if + if (allocated(SrcMiscData%AllOutData)) then + LB(1:2) = lbound(SrcMiscData%AllOutData) + UB(1:2) = ubound(SrcMiscData%AllOutData) + if (.not. allocated(DstMiscData%AllOutData)) then + allocate(DstMiscData%AllOutData(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOutData.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%AllOutData = SrcMiscData%AllOutData + else if (allocated(DstMiscData%AllOutData)) then + deallocate(DstMiscData%AllOutData) + end if + DstMiscData%n_Out = SrcMiscData%n_Out + if (allocated(SrcMiscData%FWrap_2_MD)) then + LB(1:1) = lbound(SrcMiscData%FWrap_2_MD) + UB(1:1) = ubound(SrcMiscData%FWrap_2_MD) + if (.not. allocated(DstMiscData%FWrap_2_MD)) then + allocate(DstMiscData%FWrap_2_MD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FWrap_2_MD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcMiscData%FWrap_2_MD(i1), DstMiscData%FWrap_2_MD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstMiscData%FWrap_2_MD)) then + deallocate(DstMiscData%FWrap_2_MD) + end if + if (allocated(SrcMiscData%MD_2_FWrap)) then + LB(1:1) = lbound(SrcMiscData%MD_2_FWrap) + UB(1:1) = ubound(SrcMiscData%MD_2_FWrap) + if (.not. allocated(DstMiscData%MD_2_FWrap)) then + allocate(DstMiscData%MD_2_FWrap(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%MD_2_FWrap.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcMiscData%MD_2_FWrap(i1), DstMiscData%MD_2_FWrap(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstMiscData%MD_2_FWrap)) then + deallocate(DstMiscData%MD_2_FWrap) + end if +end subroutine +subroutine Farm_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(Farm_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%AllOuts)) then + deallocate(MiscData%AllOuts) + end if + if (allocated(MiscData%TimeData)) then + deallocate(MiscData%TimeData) + end if + if (allocated(MiscData%AllOutData)) then + deallocate(MiscData%AllOutData) + end if + if (allocated(MiscData%FWrap_2_MD)) then + LB(1:1) = lbound(MiscData%FWrap_2_MD) + UB(1:1) = ubound(MiscData%FWrap_2_MD) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(MiscData%FWrap_2_MD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%FWrap_2_MD) + end if + if (allocated(MiscData%MD_2_FWrap)) then + LB(1:1) = lbound(MiscData%MD_2_FWrap) + UB(1:1) = ubound(MiscData%MD_2_FWrap) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(MiscData%MD_2_FWrap(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%MD_2_FWrap) + end if +end subroutine subroutine Farm_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -1012,31 +922,26 @@ subroutine Farm_PackMisc(Buf, Indata) integer(IntKi) :: i1, i2 integer(IntKi) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return - ! AllOuts call RegPack(Buf, allocated(InData%AllOuts)) if (allocated(InData%AllOuts)) then call RegPackBounds(Buf, 1, lbound(InData%AllOuts), ubound(InData%AllOuts)) call RegPack(Buf, InData%AllOuts) end if if (RegCheckErr(Buf, RoutineName)) return - ! TimeData call RegPack(Buf, allocated(InData%TimeData)) if (allocated(InData%TimeData)) then call RegPackBounds(Buf, 1, lbound(InData%TimeData), ubound(InData%TimeData)) call RegPack(Buf, InData%TimeData) end if if (RegCheckErr(Buf, RoutineName)) return - ! AllOutData call RegPack(Buf, allocated(InData%AllOutData)) if (allocated(InData%AllOutData)) then call RegPackBounds(Buf, 2, lbound(InData%AllOutData), ubound(InData%AllOutData)) call RegPack(Buf, InData%AllOutData) end if if (RegCheckErr(Buf, RoutineName)) return - ! n_Out call RegPack(Buf, InData%n_Out) if (RegCheckErr(Buf, RoutineName)) return - ! FWrap_2_MD call RegPack(Buf, allocated(InData%FWrap_2_MD)) if (allocated(InData%FWrap_2_MD)) then call RegPackBounds(Buf, 1, lbound(InData%FWrap_2_MD), ubound(InData%FWrap_2_MD)) @@ -1047,7 +952,6 @@ subroutine Farm_PackMisc(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! MD_2_FWrap call RegPack(Buf, allocated(InData%MD_2_FWrap)) if (allocated(InData%MD_2_FWrap)) then call RegPackBounds(Buf, 1, lbound(InData%MD_2_FWrap), ubound(InData%MD_2_FWrap)) @@ -1069,7 +973,6 @@ subroutine Farm_UnPackMisc(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! AllOuts if (allocated(OutData%AllOuts)) deallocate(OutData%AllOuts) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1084,7 +987,6 @@ subroutine Farm_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%AllOuts) if (RegCheckErr(Buf, RoutineName)) return end if - ! TimeData if (allocated(OutData%TimeData)) deallocate(OutData%TimeData) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1099,7 +1001,6 @@ subroutine Farm_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%TimeData) if (RegCheckErr(Buf, RoutineName)) return end if - ! AllOutData if (allocated(OutData%AllOutData)) deallocate(OutData%AllOutData) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1114,10 +1015,8 @@ subroutine Farm_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%AllOutData) if (RegCheckErr(Buf, RoutineName)) return end if - ! n_Out call RegUnpack(Buf, OutData%n_Out) if (RegCheckErr(Buf, RoutineName)) return - ! FWrap_2_MD if (allocated(OutData%FWrap_2_MD)) deallocate(OutData%FWrap_2_MD) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1133,7 +1032,6 @@ subroutine Farm_UnPackMisc(Buf, OutData) call NWTC_Library_UnpackMeshMapType(Buf, OutData%FWrap_2_MD(i1)) ! FWrap_2_MD end do end if - ! MD_2_FWrap if (allocated(OutData%MD_2_FWrap)) deallocate(OutData%MD_2_FWrap) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1150,109 +1048,77 @@ subroutine Farm_UnPackMisc(Buf, OutData) end do end if end subroutine - SUBROUTINE Farm_CopyFASTWrapper_Data( SrcFASTWrapper_DataData, DstFASTWrapper_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FASTWrapper_Data), INTENT(INOUT) :: SrcFASTWrapper_DataData - TYPE(FASTWrapper_Data), INTENT(INOUT) :: DstFASTWrapper_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Farm_CopyFASTWrapper_Data' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL FWrap_CopyContState( SrcFASTWrapper_DataData%x, DstFASTWrapper_DataData%x, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FWrap_CopyDiscState( SrcFASTWrapper_DataData%xd, DstFASTWrapper_DataData%xd, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FWrap_CopyConstrState( SrcFASTWrapper_DataData%z, DstFASTWrapper_DataData%z, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FWrap_CopyOtherState( SrcFASTWrapper_DataData%OtherSt, DstFASTWrapper_DataData%OtherSt, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FWrap_CopyParam( SrcFASTWrapper_DataData%p, DstFASTWrapper_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FWrap_CopyInput( SrcFASTWrapper_DataData%u, DstFASTWrapper_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FWrap_CopyOutput( SrcFASTWrapper_DataData%y, DstFASTWrapper_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FWrap_CopyMisc( SrcFASTWrapper_DataData%m, DstFASTWrapper_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstFASTWrapper_DataData%IsInitialized = SrcFASTWrapper_DataData%IsInitialized - END SUBROUTINE Farm_CopyFASTWrapper_Data - - SUBROUTINE Farm_DestroyFASTWrapper_Data( FASTWrapper_DataData, ErrStat, ErrMsg ) - TYPE(FASTWrapper_Data), INTENT(INOUT) :: FASTWrapper_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Farm_DestroyFASTWrapper_Data' - - ErrStat = ErrID_None - ErrMsg = "" - CALL FWrap_DestroyContState( FASTWrapper_DataData%x, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FWrap_DestroyDiscState( FASTWrapper_DataData%xd, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FWrap_DestroyConstrState( FASTWrapper_DataData%z, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FWrap_DestroyOtherState( FASTWrapper_DataData%OtherSt, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FWrap_DestroyParam( FASTWrapper_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FWrap_DestroyInput( FASTWrapper_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FWrap_DestroyOutput( FASTWrapper_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FWrap_DestroyMisc( FASTWrapper_DataData%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE Farm_DestroyFASTWrapper_Data +subroutine Farm_CopyFASTWrapper_Data(SrcFASTWrapper_DataData, DstFASTWrapper_DataData, CtrlCode, ErrStat, ErrMsg) + type(FASTWrapper_Data), intent(inout) :: SrcFASTWrapper_DataData + type(FASTWrapper_Data), intent(inout) :: DstFASTWrapper_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_CopyFASTWrapper_Data' + ErrStat = ErrID_None + ErrMsg = '' + call FWrap_CopyContState(SrcFASTWrapper_DataData%x, DstFASTWrapper_DataData%x, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FWrap_CopyDiscState(SrcFASTWrapper_DataData%xd, DstFASTWrapper_DataData%xd, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FWrap_CopyConstrState(SrcFASTWrapper_DataData%z, DstFASTWrapper_DataData%z, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FWrap_CopyOtherState(SrcFASTWrapper_DataData%OtherSt, DstFASTWrapper_DataData%OtherSt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FWrap_CopyParam(SrcFASTWrapper_DataData%p, DstFASTWrapper_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FWrap_CopyInput(SrcFASTWrapper_DataData%u, DstFASTWrapper_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FWrap_CopyOutput(SrcFASTWrapper_DataData%y, DstFASTWrapper_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FWrap_CopyMisc(SrcFASTWrapper_DataData%m, DstFASTWrapper_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstFASTWrapper_DataData%IsInitialized = SrcFASTWrapper_DataData%IsInitialized +end subroutine +subroutine Farm_DestroyFASTWrapper_Data(FASTWrapper_DataData, ErrStat, ErrMsg) + type(FASTWrapper_Data), intent(inout) :: FASTWrapper_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_DestroyFASTWrapper_Data' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine Farm_PackFASTWrapper_Data(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FASTWrapper_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'Farm_PackFASTWrapper_Data' if (Buf%ErrStat >= AbortErrLev) return - ! x call FWrap_PackContState(Buf, InData%x) if (RegCheckErr(Buf, RoutineName)) return - ! xd call FWrap_PackDiscState(Buf, InData%xd) if (RegCheckErr(Buf, RoutineName)) return - ! z call FWrap_PackConstrState(Buf, InData%z) if (RegCheckErr(Buf, RoutineName)) return - ! OtherSt call FWrap_PackOtherState(Buf, InData%OtherSt) if (RegCheckErr(Buf, RoutineName)) return - ! p call FWrap_PackParam(Buf, InData%p) if (RegCheckErr(Buf, RoutineName)) return - ! u call FWrap_PackInput(Buf, InData%u) if (RegCheckErr(Buf, RoutineName)) return - ! y call FWrap_PackOutput(Buf, InData%y) if (RegCheckErr(Buf, RoutineName)) return - ! m call FWrap_PackMisc(Buf, InData%m) if (RegCheckErr(Buf, RoutineName)) return - ! IsInitialized call RegPack(Buf, InData%IsInitialized) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1262,129 +1128,88 @@ subroutine Farm_UnPackFASTWrapper_Data(Buf, OutData) type(FASTWrapper_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Farm_UnPackFASTWrapper_Data' if (Buf%ErrStat /= ErrID_None) return - ! x call FWrap_UnpackContState(Buf, OutData%x) ! x - ! xd call FWrap_UnpackDiscState(Buf, OutData%xd) ! xd - ! z call FWrap_UnpackConstrState(Buf, OutData%z) ! z - ! OtherSt call FWrap_UnpackOtherState(Buf, OutData%OtherSt) ! OtherSt - ! p call FWrap_UnpackParam(Buf, OutData%p) ! p - ! u call FWrap_UnpackInput(Buf, OutData%u) ! u - ! y call FWrap_UnpackOutput(Buf, OutData%y) ! y - ! m call FWrap_UnpackMisc(Buf, OutData%m) ! m - ! IsInitialized call RegUnpack(Buf, OutData%IsInitialized) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Farm_CopyWakeDynamics_Data( SrcWakeDynamics_DataData, DstWakeDynamics_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WakeDynamics_Data), INTENT(IN) :: SrcWakeDynamics_DataData - TYPE(WakeDynamics_Data), INTENT(INOUT) :: DstWakeDynamics_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Farm_CopyWakeDynamics_Data' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL WD_CopyContState( SrcWakeDynamics_DataData%x, DstWakeDynamics_DataData%x, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL WD_CopyDiscState( SrcWakeDynamics_DataData%xd, DstWakeDynamics_DataData%xd, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL WD_CopyConstrState( SrcWakeDynamics_DataData%z, DstWakeDynamics_DataData%z, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL WD_CopyOtherState( SrcWakeDynamics_DataData%OtherSt, DstWakeDynamics_DataData%OtherSt, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL WD_CopyParam( SrcWakeDynamics_DataData%p, DstWakeDynamics_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL WD_CopyInput( SrcWakeDynamics_DataData%u, DstWakeDynamics_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL WD_CopyOutput( SrcWakeDynamics_DataData%y, DstWakeDynamics_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL WD_CopyMisc( SrcWakeDynamics_DataData%m, DstWakeDynamics_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstWakeDynamics_DataData%IsInitialized = SrcWakeDynamics_DataData%IsInitialized - END SUBROUTINE Farm_CopyWakeDynamics_Data - - SUBROUTINE Farm_DestroyWakeDynamics_Data( WakeDynamics_DataData, ErrStat, ErrMsg ) - TYPE(WakeDynamics_Data), INTENT(INOUT) :: WakeDynamics_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Farm_DestroyWakeDynamics_Data' - ErrStat = ErrID_None - ErrMsg = "" - - CALL WD_DestroyContState( WakeDynamics_DataData%x, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL WD_DestroyDiscState( WakeDynamics_DataData%xd, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL WD_DestroyConstrState( WakeDynamics_DataData%z, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL WD_DestroyOtherState( WakeDynamics_DataData%OtherSt, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL WD_DestroyParam( WakeDynamics_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL WD_DestroyInput( WakeDynamics_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL WD_DestroyOutput( WakeDynamics_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL WD_DestroyMisc( WakeDynamics_DataData%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE Farm_DestroyWakeDynamics_Data +subroutine Farm_CopyWakeDynamics_Data(SrcWakeDynamics_DataData, DstWakeDynamics_DataData, CtrlCode, ErrStat, ErrMsg) + type(WakeDynamics_Data), intent(in) :: SrcWakeDynamics_DataData + type(WakeDynamics_Data), intent(inout) :: DstWakeDynamics_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_CopyWakeDynamics_Data' + ErrStat = ErrID_None + ErrMsg = '' + call WD_CopyContState(SrcWakeDynamics_DataData%x, DstWakeDynamics_DataData%x, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call WD_CopyDiscState(SrcWakeDynamics_DataData%xd, DstWakeDynamics_DataData%xd, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call WD_CopyConstrState(SrcWakeDynamics_DataData%z, DstWakeDynamics_DataData%z, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call WD_CopyOtherState(SrcWakeDynamics_DataData%OtherSt, DstWakeDynamics_DataData%OtherSt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call WD_CopyParam(SrcWakeDynamics_DataData%p, DstWakeDynamics_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call WD_CopyInput(SrcWakeDynamics_DataData%u, DstWakeDynamics_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call WD_CopyOutput(SrcWakeDynamics_DataData%y, DstWakeDynamics_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call WD_CopyMisc(SrcWakeDynamics_DataData%m, DstWakeDynamics_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstWakeDynamics_DataData%IsInitialized = SrcWakeDynamics_DataData%IsInitialized +end subroutine +subroutine Farm_DestroyWakeDynamics_Data(WakeDynamics_DataData, ErrStat, ErrMsg) + type(WakeDynamics_Data), intent(inout) :: WakeDynamics_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_DestroyWakeDynamics_Data' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine Farm_PackWakeDynamics_Data(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(WakeDynamics_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'Farm_PackWakeDynamics_Data' if (Buf%ErrStat >= AbortErrLev) return - ! x call WD_PackContState(Buf, InData%x) if (RegCheckErr(Buf, RoutineName)) return - ! xd call WD_PackDiscState(Buf, InData%xd) if (RegCheckErr(Buf, RoutineName)) return - ! z call WD_PackConstrState(Buf, InData%z) if (RegCheckErr(Buf, RoutineName)) return - ! OtherSt call WD_PackOtherState(Buf, InData%OtherSt) if (RegCheckErr(Buf, RoutineName)) return - ! p call WD_PackParam(Buf, InData%p) if (RegCheckErr(Buf, RoutineName)) return - ! u call WD_PackInput(Buf, InData%u) if (RegCheckErr(Buf, RoutineName)) return - ! y call WD_PackOutput(Buf, InData%y) if (RegCheckErr(Buf, RoutineName)) return - ! m call WD_PackMisc(Buf, InData%m) if (RegCheckErr(Buf, RoutineName)) return - ! IsInitialized call RegPack(Buf, InData%IsInitialized) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1394,129 +1219,88 @@ subroutine Farm_UnPackWakeDynamics_Data(Buf, OutData) type(WakeDynamics_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Farm_UnPackWakeDynamics_Data' if (Buf%ErrStat /= ErrID_None) return - ! x call WD_UnpackContState(Buf, OutData%x) ! x - ! xd call WD_UnpackDiscState(Buf, OutData%xd) ! xd - ! z call WD_UnpackConstrState(Buf, OutData%z) ! z - ! OtherSt call WD_UnpackOtherState(Buf, OutData%OtherSt) ! OtherSt - ! p call WD_UnpackParam(Buf, OutData%p) ! p - ! u call WD_UnpackInput(Buf, OutData%u) ! u - ! y call WD_UnpackOutput(Buf, OutData%y) ! y - ! m call WD_UnpackMisc(Buf, OutData%m) ! m - ! IsInitialized call RegUnpack(Buf, OutData%IsInitialized) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Farm_CopyAWAE_Data( SrcAWAE_DataData, DstAWAE_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AWAE_Data), INTENT(IN) :: SrcAWAE_DataData - TYPE(AWAE_Data), INTENT(INOUT) :: DstAWAE_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Farm_CopyAWAE_Data' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL AWAE_CopyContState( SrcAWAE_DataData%x, DstAWAE_DataData%x, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AWAE_CopyDiscState( SrcAWAE_DataData%xd, DstAWAE_DataData%xd, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AWAE_CopyConstrState( SrcAWAE_DataData%z, DstAWAE_DataData%z, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AWAE_CopyOtherState( SrcAWAE_DataData%OtherSt, DstAWAE_DataData%OtherSt, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AWAE_CopyParam( SrcAWAE_DataData%p, DstAWAE_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AWAE_CopyInput( SrcAWAE_DataData%u, DstAWAE_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AWAE_CopyOutput( SrcAWAE_DataData%y, DstAWAE_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AWAE_CopyMisc( SrcAWAE_DataData%m, DstAWAE_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstAWAE_DataData%IsInitialized = SrcAWAE_DataData%IsInitialized - END SUBROUTINE Farm_CopyAWAE_Data - - SUBROUTINE Farm_DestroyAWAE_Data( AWAE_DataData, ErrStat, ErrMsg ) - TYPE(AWAE_Data), INTENT(INOUT) :: AWAE_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Farm_DestroyAWAE_Data' - ErrStat = ErrID_None - ErrMsg = "" - - CALL AWAE_DestroyContState( AWAE_DataData%x, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AWAE_DestroyDiscState( AWAE_DataData%xd, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AWAE_DestroyConstrState( AWAE_DataData%z, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AWAE_DestroyOtherState( AWAE_DataData%OtherSt, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AWAE_DestroyParam( AWAE_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AWAE_DestroyInput( AWAE_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AWAE_DestroyOutput( AWAE_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AWAE_DestroyMisc( AWAE_DataData%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE Farm_DestroyAWAE_Data +subroutine Farm_CopyAWAE_Data(SrcAWAE_DataData, DstAWAE_DataData, CtrlCode, ErrStat, ErrMsg) + type(AWAE_Data), intent(in) :: SrcAWAE_DataData + type(AWAE_Data), intent(inout) :: DstAWAE_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_CopyAWAE_Data' + ErrStat = ErrID_None + ErrMsg = '' + call AWAE_CopyContState(SrcAWAE_DataData%x, DstAWAE_DataData%x, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AWAE_CopyDiscState(SrcAWAE_DataData%xd, DstAWAE_DataData%xd, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AWAE_CopyConstrState(SrcAWAE_DataData%z, DstAWAE_DataData%z, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AWAE_CopyOtherState(SrcAWAE_DataData%OtherSt, DstAWAE_DataData%OtherSt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AWAE_CopyParam(SrcAWAE_DataData%p, DstAWAE_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AWAE_CopyInput(SrcAWAE_DataData%u, DstAWAE_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AWAE_CopyOutput(SrcAWAE_DataData%y, DstAWAE_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AWAE_CopyMisc(SrcAWAE_DataData%m, DstAWAE_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstAWAE_DataData%IsInitialized = SrcAWAE_DataData%IsInitialized +end subroutine +subroutine Farm_DestroyAWAE_Data(AWAE_DataData, ErrStat, ErrMsg) + type(AWAE_Data), intent(inout) :: AWAE_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_DestroyAWAE_Data' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine Farm_PackAWAE_Data(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AWAE_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'Farm_PackAWAE_Data' if (Buf%ErrStat >= AbortErrLev) return - ! x call AWAE_PackContState(Buf, InData%x) if (RegCheckErr(Buf, RoutineName)) return - ! xd call AWAE_PackDiscState(Buf, InData%xd) if (RegCheckErr(Buf, RoutineName)) return - ! z call AWAE_PackConstrState(Buf, InData%z) if (RegCheckErr(Buf, RoutineName)) return - ! OtherSt call AWAE_PackOtherState(Buf, InData%OtherSt) if (RegCheckErr(Buf, RoutineName)) return - ! p call AWAE_PackParam(Buf, InData%p) if (RegCheckErr(Buf, RoutineName)) return - ! u call AWAE_PackInput(Buf, InData%u) if (RegCheckErr(Buf, RoutineName)) return - ! y call AWAE_PackOutput(Buf, InData%y) if (RegCheckErr(Buf, RoutineName)) return - ! m call AWAE_PackMisc(Buf, InData%m) if (RegCheckErr(Buf, RoutineName)) return - ! IsInitialized call RegPack(Buf, InData%IsInitialized) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1526,134 +1310,91 @@ subroutine Farm_UnPackAWAE_Data(Buf, OutData) type(AWAE_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Farm_UnPackAWAE_Data' if (Buf%ErrStat /= ErrID_None) return - ! x call AWAE_UnpackContState(Buf, OutData%x) ! x - ! xd call AWAE_UnpackDiscState(Buf, OutData%xd) ! xd - ! z call AWAE_UnpackConstrState(Buf, OutData%z) ! z - ! OtherSt call AWAE_UnpackOtherState(Buf, OutData%OtherSt) ! OtherSt - ! p call AWAE_UnpackParam(Buf, OutData%p) ! p - ! u call AWAE_UnpackInput(Buf, OutData%u) ! u - ! y call AWAE_UnpackOutput(Buf, OutData%y) ! y - ! m call AWAE_UnpackMisc(Buf, OutData%m) ! m - ! IsInitialized call RegUnpack(Buf, OutData%IsInitialized) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Farm_CopySC_Data( SrcSC_DataData, DstSC_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_Data), INTENT(IN) :: SrcSC_DataData - TYPE(SC_Data), INTENT(INOUT) :: DstSC_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Farm_CopySC_Data' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL SC_CopyContState( SrcSC_DataData%x, DstSC_DataData%x, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SC_CopyDiscState( SrcSC_DataData%xd, DstSC_DataData%xd, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SC_CopyConstrState( SrcSC_DataData%z, DstSC_DataData%z, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SC_CopyOtherState( SrcSC_DataData%OtherState, DstSC_DataData%OtherState, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SC_CopyParam( SrcSC_DataData%p, DstSC_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SC_CopyInput( SrcSC_DataData%uInputs, DstSC_DataData%uInputs, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstSC_DataData%utimes = SrcSC_DataData%utimes - CALL SC_CopyOutput( SrcSC_DataData%y, DstSC_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SC_CopyMisc( SrcSC_DataData%m, DstSC_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstSC_DataData%IsInitialized = SrcSC_DataData%IsInitialized - END SUBROUTINE Farm_CopySC_Data - - SUBROUTINE Farm_DestroySC_Data( SC_DataData, ErrStat, ErrMsg ) - TYPE(SC_Data), INTENT(INOUT) :: SC_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Farm_DestroySC_Data' - ErrStat = ErrID_None - ErrMsg = "" - - CALL SC_DestroyContState( SC_DataData%x, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SC_DestroyDiscState( SC_DataData%xd, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SC_DestroyConstrState( SC_DataData%z, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SC_DestroyOtherState( SC_DataData%OtherState, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SC_DestroyParam( SC_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SC_DestroyInput( SC_DataData%uInputs, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SC_DestroyOutput( SC_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SC_DestroyMisc( SC_DataData%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE Farm_DestroySC_Data +subroutine Farm_CopySC_Data(SrcSC_DataData, DstSC_DataData, CtrlCode, ErrStat, ErrMsg) + type(SC_Data), intent(in) :: SrcSC_DataData + type(SC_Data), intent(inout) :: DstSC_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_CopySC_Data' + ErrStat = ErrID_None + ErrMsg = '' + call SC_CopyContState(SrcSC_DataData%x, DstSC_DataData%x, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SC_CopyDiscState(SrcSC_DataData%xd, DstSC_DataData%xd, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SC_CopyConstrState(SrcSC_DataData%z, DstSC_DataData%z, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SC_CopyOtherState(SrcSC_DataData%OtherState, DstSC_DataData%OtherState, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SC_CopyParam(SrcSC_DataData%p, DstSC_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SC_CopyInput(SrcSC_DataData%uInputs, DstSC_DataData%uInputs, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstSC_DataData%utimes = SrcSC_DataData%utimes + call SC_CopyOutput(SrcSC_DataData%y, DstSC_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SC_CopyMisc(SrcSC_DataData%m, DstSC_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstSC_DataData%IsInitialized = SrcSC_DataData%IsInitialized +end subroutine +subroutine Farm_DestroySC_Data(SC_DataData, ErrStat, ErrMsg) + type(SC_Data), intent(inout) :: SC_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_DestroySC_Data' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine Farm_PackSC_Data(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SC_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'Farm_PackSC_Data' if (Buf%ErrStat >= AbortErrLev) return - ! x call SC_PackContState(Buf, InData%x) if (RegCheckErr(Buf, RoutineName)) return - ! xd call SC_PackDiscState(Buf, InData%xd) if (RegCheckErr(Buf, RoutineName)) return - ! z call SC_PackConstrState(Buf, InData%z) if (RegCheckErr(Buf, RoutineName)) return - ! OtherState call SC_PackOtherState(Buf, InData%OtherState) if (RegCheckErr(Buf, RoutineName)) return - ! p call SC_PackParam(Buf, InData%p) if (RegCheckErr(Buf, RoutineName)) return - ! uInputs call SC_PackInput(Buf, InData%uInputs) if (RegCheckErr(Buf, RoutineName)) return - ! utimes call RegPack(Buf, InData%utimes) if (RegCheckErr(Buf, RoutineName)) return - ! y call SC_PackOutput(Buf, InData%y) if (RegCheckErr(Buf, RoutineName)) return - ! m call SC_PackMisc(Buf, InData%m) if (RegCheckErr(Buf, RoutineName)) return - ! IsInitialized call RegPack(Buf, InData%IsInitialized) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1663,140 +1404,116 @@ subroutine Farm_UnPackSC_Data(Buf, OutData) type(SC_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Farm_UnPackSC_Data' if (Buf%ErrStat /= ErrID_None) return - ! x call SC_UnpackContState(Buf, OutData%x) ! x - ! xd call SC_UnpackDiscState(Buf, OutData%xd) ! xd - ! z call SC_UnpackConstrState(Buf, OutData%z) ! z - ! OtherState call SC_UnpackOtherState(Buf, OutData%OtherState) ! OtherState - ! p call SC_UnpackParam(Buf, OutData%p) ! p - ! uInputs call SC_UnpackInput(Buf, OutData%uInputs) ! uInputs - ! utimes call RegUnpack(Buf, OutData%utimes) if (RegCheckErr(Buf, RoutineName)) return - ! y call SC_UnpackOutput(Buf, OutData%y) ! y - ! m call SC_UnpackMisc(Buf, OutData%m) ! m - ! IsInitialized call RegUnpack(Buf, OutData%IsInitialized) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Farm_CopyMD_Data( SrcMD_DataData, DstMD_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_Data), INTENT(INOUT) :: SrcMD_DataData - TYPE(MD_Data), INTENT(INOUT) :: DstMD_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Farm_CopyMD_Data' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL MD_CopyContState( SrcMD_DataData%x, DstMD_DataData%x, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MD_CopyDiscState( SrcMD_DataData%xd, DstMD_DataData%xd, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MD_CopyConstrState( SrcMD_DataData%z, DstMD_DataData%z, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MD_CopyOtherState( SrcMD_DataData%OtherSt, DstMD_DataData%OtherSt, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MD_CopyParam( SrcMD_DataData%p, DstMD_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MD_CopyInput( SrcMD_DataData%u, DstMD_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMD_DataData%Input)) THEN - i1_l = LBOUND(SrcMD_DataData%Input,1) - i1_u = UBOUND(SrcMD_DataData%Input,1) - IF (.NOT. ALLOCATED(DstMD_DataData%Input)) THEN - ALLOCATE(DstMD_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMD_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMD_DataData%Input,1), UBOUND(SrcMD_DataData%Input,1) - CALL MD_CopyInput( SrcMD_DataData%Input(i1), DstMD_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMD_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcMD_DataData%InputTimes,1) - i1_u = UBOUND(SrcMD_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstMD_DataData%InputTimes)) THEN - ALLOCATE(DstMD_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMD_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMD_DataData%InputTimes = SrcMD_DataData%InputTimes -ENDIF - CALL MD_CopyOutput( SrcMD_DataData%y, DstMD_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MD_CopyMisc( SrcMD_DataData%m, DstMD_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstMD_DataData%IsInitialized = SrcMD_DataData%IsInitialized - END SUBROUTINE Farm_CopyMD_Data - - SUBROUTINE Farm_DestroyMD_Data( MD_DataData, ErrStat, ErrMsg ) - TYPE(MD_Data), INTENT(INOUT) :: MD_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Farm_DestroyMD_Data' - ErrStat = ErrID_None - ErrMsg = "" - - CALL MD_DestroyContState( MD_DataData%x, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyDiscState( MD_DataData%xd, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyConstrState( MD_DataData%z, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyOtherState( MD_DataData%OtherSt, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyParam( MD_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyInput( MD_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MD_DataData%Input)) THEN -DO i1 = LBOUND(MD_DataData%Input,1), UBOUND(MD_DataData%Input,1) - CALL MD_DestroyInput( MD_DataData%Input(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MD_DataData%Input) -ENDIF -IF (ALLOCATED(MD_DataData%InputTimes)) THEN - DEALLOCATE(MD_DataData%InputTimes) -ENDIF - CALL MD_DestroyOutput( MD_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyMisc( MD_DataData%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE Farm_DestroyMD_Data +subroutine Farm_CopyMD_Data(SrcMD_DataData, DstMD_DataData, CtrlCode, ErrStat, ErrMsg) + type(MD_Data), intent(inout) :: SrcMD_DataData + type(MD_Data), intent(inout) :: DstMD_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_CopyMD_Data' + ErrStat = ErrID_None + ErrMsg = '' + call MD_CopyContState(SrcMD_DataData%x, DstMD_DataData%x, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MD_CopyDiscState(SrcMD_DataData%xd, DstMD_DataData%xd, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MD_CopyConstrState(SrcMD_DataData%z, DstMD_DataData%z, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MD_CopyOtherState(SrcMD_DataData%OtherSt, DstMD_DataData%OtherSt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MD_CopyParam(SrcMD_DataData%p, DstMD_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MD_CopyInput(SrcMD_DataData%u, DstMD_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMD_DataData%Input)) then + LB(1:1) = lbound(SrcMD_DataData%Input) + UB(1:1) = ubound(SrcMD_DataData%Input) + if (.not. allocated(DstMD_DataData%Input)) then + allocate(DstMD_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMD_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyInput(SrcMD_DataData%Input(i1), DstMD_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstMD_DataData%Input)) then + deallocate(DstMD_DataData%Input) + end if + if (allocated(SrcMD_DataData%InputTimes)) then + LB(1:1) = lbound(SrcMD_DataData%InputTimes) + UB(1:1) = ubound(SrcMD_DataData%InputTimes) + if (.not. allocated(DstMD_DataData%InputTimes)) then + allocate(DstMD_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMD_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMD_DataData%InputTimes = SrcMD_DataData%InputTimes + else if (allocated(DstMD_DataData%InputTimes)) then + deallocate(DstMD_DataData%InputTimes) + end if + call MD_CopyOutput(SrcMD_DataData%y, DstMD_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MD_CopyMisc(SrcMD_DataData%m, DstMD_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstMD_DataData%IsInitialized = SrcMD_DataData%IsInitialized +end subroutine +subroutine Farm_DestroyMD_Data(MD_DataData, ErrStat, ErrMsg) + type(MD_Data), intent(inout) :: MD_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_DestroyMD_Data' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MD_DataData%Input)) then + LB(1:1) = lbound(MD_DataData%Input) + UB(1:1) = ubound(MD_DataData%Input) + do i1 = LB(1), UB(1) + call MD_DestroyInput(MD_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MD_DataData%Input) + end if + if (allocated(MD_DataData%InputTimes)) then + deallocate(MD_DataData%InputTimes) + end if +end subroutine subroutine Farm_PackMD_Data(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -1805,25 +1522,18 @@ subroutine Farm_PackMD_Data(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! x call MD_PackContState(Buf, InData%x) if (RegCheckErr(Buf, RoutineName)) return - ! xd call MD_PackDiscState(Buf, InData%xd) if (RegCheckErr(Buf, RoutineName)) return - ! z call MD_PackConstrState(Buf, InData%z) if (RegCheckErr(Buf, RoutineName)) return - ! OtherSt call MD_PackOtherState(Buf, InData%OtherSt) if (RegCheckErr(Buf, RoutineName)) return - ! p call MD_PackParam(Buf, InData%p) if (RegCheckErr(Buf, RoutineName)) return - ! u call MD_PackInput(Buf, InData%u) if (RegCheckErr(Buf, RoutineName)) return - ! Input call RegPack(Buf, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) @@ -1834,20 +1544,16 @@ subroutine Farm_PackMD_Data(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! InputTimes call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) call RegPack(Buf, InData%InputTimes) end if if (RegCheckErr(Buf, RoutineName)) return - ! y call MD_PackOutput(Buf, InData%y) if (RegCheckErr(Buf, RoutineName)) return - ! m call MD_PackMisc(Buf, InData%m) if (RegCheckErr(Buf, RoutineName)) return - ! IsInitialized call RegPack(Buf, InData%IsInitialized) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1861,19 +1567,12 @@ subroutine Farm_UnPackMD_Data(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! x call MD_UnpackContState(Buf, OutData%x) ! x - ! xd call MD_UnpackDiscState(Buf, OutData%xd) ! xd - ! z call MD_UnpackConstrState(Buf, OutData%z) ! z - ! OtherSt call MD_UnpackOtherState(Buf, OutData%OtherSt) ! OtherSt - ! p call MD_UnpackParam(Buf, OutData%p) ! p - ! u call MD_UnpackInput(Buf, OutData%u) ! u - ! Input if (allocated(OutData%Input)) deallocate(OutData%Input) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1889,7 +1588,6 @@ subroutine Farm_UnPackMD_Data(Buf, OutData) call MD_UnpackInput(Buf, OutData%Input(i1)) ! Input end do end if - ! InputTimes if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1904,117 +1602,108 @@ subroutine Farm_UnPackMD_Data(Buf, OutData) call RegUnpack(Buf, OutData%InputTimes) if (RegCheckErr(Buf, RoutineName)) return end if - ! y call MD_UnpackOutput(Buf, OutData%y) ! y - ! m call MD_UnpackMisc(Buf, OutData%m) ! m - ! IsInitialized call RegUnpack(Buf, OutData%IsInitialized) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Farm_CopyAll_FastFarm_Data( SrcAll_FastFarm_DataData, DstAll_FastFarm_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(All_FastFarm_Data), INTENT(INOUT) :: SrcAll_FastFarm_DataData - TYPE(All_FastFarm_Data), INTENT(INOUT) :: DstAll_FastFarm_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Farm_CopyAll_FastFarm_Data' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL Farm_CopyParam( SrcAll_FastFarm_DataData%p, DstAll_FastFarm_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Farm_CopyMisc( SrcAll_FastFarm_DataData%m, DstAll_FastFarm_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcAll_FastFarm_DataData%FWrap)) THEN - i1_l = LBOUND(SrcAll_FastFarm_DataData%FWrap,1) - i1_u = UBOUND(SrcAll_FastFarm_DataData%FWrap,1) - IF (.NOT. ALLOCATED(DstAll_FastFarm_DataData%FWrap)) THEN - ALLOCATE(DstAll_FastFarm_DataData%FWrap(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAll_FastFarm_DataData%FWrap.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcAll_FastFarm_DataData%FWrap,1), UBOUND(SrcAll_FastFarm_DataData%FWrap,1) - CALL Farm_Copyfastwrapper_data( SrcAll_FastFarm_DataData%FWrap(i1), DstAll_FastFarm_DataData%FWrap(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcAll_FastFarm_DataData%WD)) THEN - i1_l = LBOUND(SrcAll_FastFarm_DataData%WD,1) - i1_u = UBOUND(SrcAll_FastFarm_DataData%WD,1) - IF (.NOT. ALLOCATED(DstAll_FastFarm_DataData%WD)) THEN - ALLOCATE(DstAll_FastFarm_DataData%WD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAll_FastFarm_DataData%WD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcAll_FastFarm_DataData%WD,1), UBOUND(SrcAll_FastFarm_DataData%WD,1) - CALL Farm_Copywakedynamics_data( SrcAll_FastFarm_DataData%WD(i1), DstAll_FastFarm_DataData%WD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL Farm_Copyawae_data( SrcAll_FastFarm_DataData%AWAE, DstAll_FastFarm_DataData%AWAE, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Farm_Copysc_data( SrcAll_FastFarm_DataData%SC, DstAll_FastFarm_DataData%SC, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Farm_Copymd_data( SrcAll_FastFarm_DataData%MD, DstAll_FastFarm_DataData%MD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE Farm_CopyAll_FastFarm_Data - - SUBROUTINE Farm_DestroyAll_FastFarm_Data( All_FastFarm_DataData, ErrStat, ErrMsg ) - TYPE(All_FastFarm_Data), INTENT(INOUT) :: All_FastFarm_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Farm_DestroyAll_FastFarm_Data' - ErrStat = ErrID_None - ErrMsg = "" - - CALL Farm_DestroyParam( All_FastFarm_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Farm_DestroyMisc( All_FastFarm_DataData%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(All_FastFarm_DataData%FWrap)) THEN -DO i1 = LBOUND(All_FastFarm_DataData%FWrap,1), UBOUND(All_FastFarm_DataData%FWrap,1) - CALL Farm_DestroyFASTWrapper_Data( All_FastFarm_DataData%FWrap(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(All_FastFarm_DataData%FWrap) -ENDIF -IF (ALLOCATED(All_FastFarm_DataData%WD)) THEN -DO i1 = LBOUND(All_FastFarm_DataData%WD,1), UBOUND(All_FastFarm_DataData%WD,1) - CALL Farm_DestroyWakeDynamics_Data( All_FastFarm_DataData%WD(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(All_FastFarm_DataData%WD) -ENDIF - CALL Farm_DestroyAWAE_Data( All_FastFarm_DataData%AWAE, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Farm_DestroySC_Data( All_FastFarm_DataData%SC, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Farm_DestroyMD_Data( All_FastFarm_DataData%MD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE Farm_DestroyAll_FastFarm_Data +subroutine Farm_CopyAll_FastFarm_Data(SrcAll_FastFarm_DataData, DstAll_FastFarm_DataData, CtrlCode, ErrStat, ErrMsg) + type(All_FastFarm_Data), intent(inout) :: SrcAll_FastFarm_DataData + type(All_FastFarm_Data), intent(inout) :: DstAll_FastFarm_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_CopyAll_FastFarm_Data' + ErrStat = ErrID_None + ErrMsg = '' + call Farm_CopyParam(SrcAll_FastFarm_DataData%p, DstAll_FastFarm_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Farm_CopyMisc(SrcAll_FastFarm_DataData%m, DstAll_FastFarm_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcAll_FastFarm_DataData%FWrap)) then + LB(1:1) = lbound(SrcAll_FastFarm_DataData%FWrap) + UB(1:1) = ubound(SrcAll_FastFarm_DataData%FWrap) + if (.not. allocated(DstAll_FastFarm_DataData%FWrap)) then + allocate(DstAll_FastFarm_DataData%FWrap(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAll_FastFarm_DataData%FWrap.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Farm_CopyFASTWrapper_Data(SrcAll_FastFarm_DataData%FWrap(i1), DstAll_FastFarm_DataData%FWrap(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstAll_FastFarm_DataData%FWrap)) then + deallocate(DstAll_FastFarm_DataData%FWrap) + end if + if (allocated(SrcAll_FastFarm_DataData%WD)) then + LB(1:1) = lbound(SrcAll_FastFarm_DataData%WD) + UB(1:1) = ubound(SrcAll_FastFarm_DataData%WD) + if (.not. allocated(DstAll_FastFarm_DataData%WD)) then + allocate(DstAll_FastFarm_DataData%WD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAll_FastFarm_DataData%WD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Farm_CopyWakeDynamics_Data(SrcAll_FastFarm_DataData%WD(i1), DstAll_FastFarm_DataData%WD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstAll_FastFarm_DataData%WD)) then + deallocate(DstAll_FastFarm_DataData%WD) + end if + call Farm_CopyAWAE_Data(SrcAll_FastFarm_DataData%AWAE, DstAll_FastFarm_DataData%AWAE, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Farm_CopySC_Data(SrcAll_FastFarm_DataData%SC, DstAll_FastFarm_DataData%SC, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Farm_CopyMD_Data(SrcAll_FastFarm_DataData%MD, DstAll_FastFarm_DataData%MD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine Farm_DestroyAll_FastFarm_Data(All_FastFarm_DataData, ErrStat, ErrMsg) + type(All_FastFarm_Data), intent(inout) :: All_FastFarm_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Farm_DestroyAll_FastFarm_Data' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(All_FastFarm_DataData%FWrap)) then + LB(1:1) = lbound(All_FastFarm_DataData%FWrap) + UB(1:1) = ubound(All_FastFarm_DataData%FWrap) + do i1 = LB(1), UB(1) + call Farm_DestroyFASTWrapper_Data(All_FastFarm_DataData%FWrap(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(All_FastFarm_DataData%FWrap) + end if + if (allocated(All_FastFarm_DataData%WD)) then + LB(1:1) = lbound(All_FastFarm_DataData%WD) + UB(1:1) = ubound(All_FastFarm_DataData%WD) + do i1 = LB(1), UB(1) + call Farm_DestroyWakeDynamics_Data(All_FastFarm_DataData%WD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(All_FastFarm_DataData%WD) + end if +end subroutine subroutine Farm_PackAll_FastFarm_Data(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -2023,13 +1712,10 @@ subroutine Farm_PackAll_FastFarm_Data(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! p call Farm_PackParam(Buf, InData%p) if (RegCheckErr(Buf, RoutineName)) return - ! m call Farm_PackMisc(Buf, InData%m) if (RegCheckErr(Buf, RoutineName)) return - ! FWrap call RegPack(Buf, allocated(InData%FWrap)) if (allocated(InData%FWrap)) then call RegPackBounds(Buf, 1, lbound(InData%FWrap), ubound(InData%FWrap)) @@ -2040,7 +1726,6 @@ subroutine Farm_PackAll_FastFarm_Data(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! WD call RegPack(Buf, allocated(InData%WD)) if (allocated(InData%WD)) then call RegPackBounds(Buf, 1, lbound(InData%WD), ubound(InData%WD)) @@ -2051,13 +1736,10 @@ subroutine Farm_PackAll_FastFarm_Data(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! AWAE call Farm_PackAWAE_Data(Buf, InData%AWAE) if (RegCheckErr(Buf, RoutineName)) return - ! SC call Farm_PackSC_Data(Buf, InData%SC) if (RegCheckErr(Buf, RoutineName)) return - ! MD call Farm_PackMD_Data(Buf, InData%MD) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2071,11 +1753,8 @@ subroutine Farm_UnPackAll_FastFarm_Data(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! p call Farm_UnpackParam(Buf, OutData%p) ! p - ! m call Farm_UnpackMisc(Buf, OutData%m) ! m - ! FWrap if (allocated(OutData%FWrap)) deallocate(OutData%FWrap) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2091,7 +1770,6 @@ subroutine Farm_UnPackAll_FastFarm_Data(Buf, OutData) call Farm_UnpackFASTWrapper_Data(Buf, OutData%FWrap(i1)) ! FWrap end do end if - ! WD if (allocated(OutData%WD)) deallocate(OutData%WD) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2107,11 +1785,8 @@ subroutine Farm_UnPackAll_FastFarm_Data(Buf, OutData) call Farm_UnpackWakeDynamics_Data(Buf, OutData%WD(i1)) ! WD end do end if - ! AWAE call Farm_UnpackAWAE_Data(Buf, OutData%AWAE) ! AWAE - ! SC call Farm_UnpackSC_Data(Buf, OutData%SC) ! SC - ! MD call Farm_UnpackMD_Data(Buf, OutData%MD) ! MD end subroutine END MODULE FAST_Farm_Types diff --git a/modules/aerodyn/src/AeroAcoustics_Types.f90 b/modules/aerodyn/src/AeroAcoustics_Types.f90 index 2e09eca4ea..df2487955b 100644 --- a/modules/aerodyn/src/AeroAcoustics_Types.f90 +++ b/modules/aerodyn/src/AeroAcoustics_Types.f90 @@ -278,49 +278,36 @@ MODULE AeroAcoustics_Types END TYPE AA_OutputType ! ======================= CONTAINS - SUBROUTINE AA_CopyBladePropsType( SrcBladePropsTypeData, DstBladePropsTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_BladePropsType), INTENT(IN) :: SrcBladePropsTypeData - TYPE(AA_BladePropsType), INTENT(INOUT) :: DstBladePropsTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_CopyBladePropsType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstBladePropsTypeData%TEThick = SrcBladePropsTypeData%TEThick - DstBladePropsTypeData%TEAngle = SrcBladePropsTypeData%TEAngle - END SUBROUTINE AA_CopyBladePropsType - - SUBROUTINE AA_DestroyBladePropsType( BladePropsTypeData, ErrStat, ErrMsg ) - TYPE(AA_BladePropsType), INTENT(INOUT) :: BladePropsTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyBladePropsType' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE AA_DestroyBladePropsType +subroutine AA_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, CtrlCode, ErrStat, ErrMsg) + type(AA_BladePropsType), intent(in) :: SrcBladePropsTypeData + type(AA_BladePropsType), intent(inout) :: DstBladePropsTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AA_CopyBladePropsType' + ErrStat = ErrID_None + ErrMsg = '' + DstBladePropsTypeData%TEThick = SrcBladePropsTypeData%TEThick + DstBladePropsTypeData%TEAngle = SrcBladePropsTypeData%TEAngle +end subroutine +subroutine AA_DestroyBladePropsType(BladePropsTypeData, ErrStat, ErrMsg) + type(AA_BladePropsType), intent(inout) :: BladePropsTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AA_DestroyBladePropsType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine AA_PackBladePropsType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AA_BladePropsType), intent(in) :: InData character(*), parameter :: RoutineName = 'AA_PackBladePropsType' if (Buf%ErrStat >= AbortErrLev) return - ! TEThick call RegPack(Buf, InData%TEThick) if (RegCheckErr(Buf, RoutineName)) return - ! TEAngle call RegPack(Buf, InData%TEAngle) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -330,128 +317,125 @@ subroutine AA_UnPackBladePropsType(Buf, OutData) type(AA_BladePropsType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AA_UnPackBladePropsType' if (Buf%ErrStat /= ErrID_None) return - ! TEThick call RegUnpack(Buf, OutData%TEThick) if (RegCheckErr(Buf, RoutineName)) return - ! TEAngle call RegUnpack(Buf, OutData%TEAngle) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE AA_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(AA_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFile = SrcInitInputData%InputFile - DstInitInputData%NumBlades = SrcInitInputData%NumBlades - DstInitInputData%NumBlNds = SrcInitInputData%NumBlNds - DstInitInputData%RootName = SrcInitInputData%RootName -IF (ALLOCATED(SrcInitInputData%BlSpn)) THEN - i1_l = LBOUND(SrcInitInputData%BlSpn,1) - i1_u = UBOUND(SrcInitInputData%BlSpn,1) - i2_l = LBOUND(SrcInitInputData%BlSpn,2) - i2_u = UBOUND(SrcInitInputData%BlSpn,2) - IF (.NOT. ALLOCATED(DstInitInputData%BlSpn)) THEN - ALLOCATE(DstInitInputData%BlSpn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BlSpn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%BlSpn = SrcInitInputData%BlSpn -ENDIF -IF (ALLOCATED(SrcInitInputData%BlChord)) THEN - i1_l = LBOUND(SrcInitInputData%BlChord,1) - i1_u = UBOUND(SrcInitInputData%BlChord,1) - i2_l = LBOUND(SrcInitInputData%BlChord,2) - i2_u = UBOUND(SrcInitInputData%BlChord,2) - IF (.NOT. ALLOCATED(DstInitInputData%BlChord)) THEN - ALLOCATE(DstInitInputData%BlChord(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BlChord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%BlChord = SrcInitInputData%BlChord -ENDIF - DstInitInputData%AirDens = SrcInitInputData%AirDens - DstInitInputData%KinVisc = SrcInitInputData%KinVisc - DstInitInputData%SpdSound = SrcInitInputData%SpdSound - DstInitInputData%HubHeight = SrcInitInputData%HubHeight -IF (ALLOCATED(SrcInitInputData%BlAFID)) THEN - i1_l = LBOUND(SrcInitInputData%BlAFID,1) - i1_u = UBOUND(SrcInitInputData%BlAFID,1) - i2_l = LBOUND(SrcInitInputData%BlAFID,2) - i2_u = UBOUND(SrcInitInputData%BlAFID,2) - IF (.NOT. ALLOCATED(DstInitInputData%BlAFID)) THEN - ALLOCATE(DstInitInputData%BlAFID(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BlAFID.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%BlAFID = SrcInitInputData%BlAFID -ENDIF -IF (ALLOCATED(SrcInitInputData%AFInfo)) THEN - i1_l = LBOUND(SrcInitInputData%AFInfo,1) - i1_u = UBOUND(SrcInitInputData%AFInfo,1) - IF (.NOT. ALLOCATED(DstInitInputData%AFInfo)) THEN - ALLOCATE(DstInitInputData%AFInfo(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%AFInfo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitInputData%AFInfo,1), UBOUND(SrcInitInputData%AFInfo,1) - CALL AFI_CopyParam( SrcInitInputData%AFInfo(i1), DstInitInputData%AFInfo(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE AA_CopyInitInput - - SUBROUTINE AA_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(AA_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyInitInput' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitInputData%BlSpn)) THEN - DEALLOCATE(InitInputData%BlSpn) -ENDIF -IF (ALLOCATED(InitInputData%BlChord)) THEN - DEALLOCATE(InitInputData%BlChord) -ENDIF -IF (ALLOCATED(InitInputData%BlAFID)) THEN - DEALLOCATE(InitInputData%BlAFID) -ENDIF -IF (ALLOCATED(InitInputData%AFInfo)) THEN -DO i1 = LBOUND(InitInputData%AFInfo,1), UBOUND(InitInputData%AFInfo,1) - CALL AFI_DestroyParam( InitInputData%AFInfo(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InitInputData%AFInfo) -ENDIF - END SUBROUTINE AA_DestroyInitInput +subroutine AA_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(AA_InitInputType), intent(in) :: SrcInitInputData + type(AA_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AA_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%NumBlades = SrcInitInputData%NumBlades + DstInitInputData%NumBlNds = SrcInitInputData%NumBlNds + DstInitInputData%RootName = SrcInitInputData%RootName + if (allocated(SrcInitInputData%BlSpn)) then + LB(1:2) = lbound(SrcInitInputData%BlSpn) + UB(1:2) = ubound(SrcInitInputData%BlSpn) + if (.not. allocated(DstInitInputData%BlSpn)) then + allocate(DstInitInputData%BlSpn(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BlSpn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%BlSpn = SrcInitInputData%BlSpn + else if (allocated(DstInitInputData%BlSpn)) then + deallocate(DstInitInputData%BlSpn) + end if + if (allocated(SrcInitInputData%BlChord)) then + LB(1:2) = lbound(SrcInitInputData%BlChord) + UB(1:2) = ubound(SrcInitInputData%BlChord) + if (.not. allocated(DstInitInputData%BlChord)) then + allocate(DstInitInputData%BlChord(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BlChord.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%BlChord = SrcInitInputData%BlChord + else if (allocated(DstInitInputData%BlChord)) then + deallocate(DstInitInputData%BlChord) + end if + DstInitInputData%AirDens = SrcInitInputData%AirDens + DstInitInputData%KinVisc = SrcInitInputData%KinVisc + DstInitInputData%SpdSound = SrcInitInputData%SpdSound + DstInitInputData%HubHeight = SrcInitInputData%HubHeight + if (allocated(SrcInitInputData%BlAFID)) then + LB(1:2) = lbound(SrcInitInputData%BlAFID) + UB(1:2) = ubound(SrcInitInputData%BlAFID) + if (.not. allocated(DstInitInputData%BlAFID)) then + allocate(DstInitInputData%BlAFID(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BlAFID.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%BlAFID = SrcInitInputData%BlAFID + else if (allocated(DstInitInputData%BlAFID)) then + deallocate(DstInitInputData%BlAFID) + end if + if (allocated(SrcInitInputData%AFInfo)) then + LB(1:1) = lbound(SrcInitInputData%AFInfo) + UB(1:1) = ubound(SrcInitInputData%AFInfo) + if (.not. allocated(DstInitInputData%AFInfo)) then + allocate(DstInitInputData%AFInfo(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%AFInfo.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AFI_CopyParam(SrcInitInputData%AFInfo(i1), DstInitInputData%AFInfo(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstInitInputData%AFInfo)) then + deallocate(DstInitInputData%AFInfo) + end if +end subroutine +subroutine AA_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(AA_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AA_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitInputData%BlSpn)) then + deallocate(InitInputData%BlSpn) + end if + if (allocated(InitInputData%BlChord)) then + deallocate(InitInputData%BlChord) + end if + if (allocated(InitInputData%BlAFID)) then + deallocate(InitInputData%BlAFID) + end if + if (allocated(InitInputData%AFInfo)) then + LB(1:1) = lbound(InitInputData%AFInfo) + UB(1:1) = ubound(InitInputData%AFInfo) + do i1 = LB(1), UB(1) + call AFI_DestroyParam(InitInputData%AFInfo(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitInputData%AFInfo) + end if +end subroutine subroutine AA_PackInitInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -460,52 +444,40 @@ subroutine AA_PackInitInput(Buf, Indata) integer(IntKi) :: i1, i2 integer(IntKi) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return - ! InputFile call RegPack(Buf, InData%InputFile) if (RegCheckErr(Buf, RoutineName)) return - ! NumBlades call RegPack(Buf, InData%NumBlades) if (RegCheckErr(Buf, RoutineName)) return - ! NumBlNds call RegPack(Buf, InData%NumBlNds) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegPack(Buf, InData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! BlSpn call RegPack(Buf, allocated(InData%BlSpn)) if (allocated(InData%BlSpn)) then call RegPackBounds(Buf, 2, lbound(InData%BlSpn), ubound(InData%BlSpn)) call RegPack(Buf, InData%BlSpn) end if if (RegCheckErr(Buf, RoutineName)) return - ! BlChord call RegPack(Buf, allocated(InData%BlChord)) if (allocated(InData%BlChord)) then call RegPackBounds(Buf, 2, lbound(InData%BlChord), ubound(InData%BlChord)) call RegPack(Buf, InData%BlChord) end if if (RegCheckErr(Buf, RoutineName)) return - ! AirDens call RegPack(Buf, InData%AirDens) if (RegCheckErr(Buf, RoutineName)) return - ! KinVisc call RegPack(Buf, InData%KinVisc) if (RegCheckErr(Buf, RoutineName)) return - ! SpdSound call RegPack(Buf, InData%SpdSound) if (RegCheckErr(Buf, RoutineName)) return - ! HubHeight call RegPack(Buf, InData%HubHeight) if (RegCheckErr(Buf, RoutineName)) return - ! BlAFID call RegPack(Buf, allocated(InData%BlAFID)) if (allocated(InData%BlAFID)) then call RegPackBounds(Buf, 2, lbound(InData%BlAFID), ubound(InData%BlAFID)) call RegPack(Buf, InData%BlAFID) end if if (RegCheckErr(Buf, RoutineName)) return - ! AFInfo call RegPack(Buf, allocated(InData%AFInfo)) if (allocated(InData%AFInfo)) then call RegPackBounds(Buf, 1, lbound(InData%AFInfo), ubound(InData%AFInfo)) @@ -527,19 +499,14 @@ subroutine AA_UnPackInitInput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! InputFile call RegUnpack(Buf, OutData%InputFile) if (RegCheckErr(Buf, RoutineName)) return - ! NumBlades call RegUnpack(Buf, OutData%NumBlades) if (RegCheckErr(Buf, RoutineName)) return - ! NumBlNds call RegUnpack(Buf, OutData%NumBlNds) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegUnpack(Buf, OutData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! BlSpn if (allocated(OutData%BlSpn)) deallocate(OutData%BlSpn) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -554,7 +521,6 @@ subroutine AA_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%BlSpn) if (RegCheckErr(Buf, RoutineName)) return end if - ! BlChord if (allocated(OutData%BlChord)) deallocate(OutData%BlChord) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -569,19 +535,14 @@ subroutine AA_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%BlChord) if (RegCheckErr(Buf, RoutineName)) return end if - ! AirDens call RegUnpack(Buf, OutData%AirDens) if (RegCheckErr(Buf, RoutineName)) return - ! KinVisc call RegUnpack(Buf, OutData%KinVisc) if (RegCheckErr(Buf, RoutineName)) return - ! SpdSound call RegUnpack(Buf, OutData%SpdSound) if (RegCheckErr(Buf, RoutineName)) return - ! HubHeight call RegUnpack(Buf, OutData%HubHeight) if (RegCheckErr(Buf, RoutineName)) return - ! BlAFID if (allocated(OutData%BlAFID)) deallocate(OutData%BlAFID) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -596,7 +557,6 @@ subroutine AA_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%BlAFID) if (RegCheckErr(Buf, RoutineName)) return end if - ! AFInfo if (allocated(OutData%AFInfo)) deallocate(OutData%AFInfo) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -613,234 +573,230 @@ subroutine AA_UnPackInitInput(Buf, OutData) end do end if end subroutine - SUBROUTINE AA_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(AA_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_CopyInitOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInitOutputData%WriteOutputHdr)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputHdr,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputHdr,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputHdr)) THEN - ALLOCATE(DstInitOutputData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr -ENDIF -IF (ALLOCATED(SrcInitOutputData%WriteOutputUnt)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputUnt,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputUnt,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputUnt)) THEN - ALLOCATE(DstInitOutputData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt -ENDIF -IF (ALLOCATED(SrcInitOutputData%WriteOutputHdrforPE)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputHdrforPE,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputHdrforPE,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputHdrforPE)) THEN - ALLOCATE(DstInitOutputData%WriteOutputHdrforPE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdrforPE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputHdrforPE = SrcInitOutputData%WriteOutputHdrforPE -ENDIF -IF (ALLOCATED(SrcInitOutputData%WriteOutputUntforPE)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputUntforPE,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputUntforPE,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputUntforPE)) THEN - ALLOCATE(DstInitOutputData%WriteOutputUntforPE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUntforPE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputUntforPE = SrcInitOutputData%WriteOutputUntforPE -ENDIF -IF (ALLOCATED(SrcInitOutputData%WriteOutputHdrSep)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputHdrSep,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputHdrSep,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputHdrSep)) THEN - ALLOCATE(DstInitOutputData%WriteOutputHdrSep(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdrSep.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputHdrSep = SrcInitOutputData%WriteOutputHdrSep -ENDIF -IF (ALLOCATED(SrcInitOutputData%WriteOutputUntSep)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputUntSep,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputUntSep,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputUntSep)) THEN - ALLOCATE(DstInitOutputData%WriteOutputUntSep(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUntSep.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputUntSep = SrcInitOutputData%WriteOutputUntSep -ENDIF -IF (ALLOCATED(SrcInitOutputData%WriteOutputHdrNodes)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputHdrNodes,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputHdrNodes,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputHdrNodes)) THEN - ALLOCATE(DstInitOutputData%WriteOutputHdrNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdrNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputHdrNodes = SrcInitOutputData%WriteOutputHdrNodes -ENDIF -IF (ALLOCATED(SrcInitOutputData%WriteOutputUntNodes)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputUntNodes,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputUntNodes,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputUntNodes)) THEN - ALLOCATE(DstInitOutputData%WriteOutputUntNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUntNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputUntNodes = SrcInitOutputData%WriteOutputUntNodes -ENDIF - DstInitOutputData%delim = SrcInitOutputData%delim - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitOutputData%AirDens = SrcInitOutputData%AirDens - END SUBROUTINE AA_CopyInitOutput - - SUBROUTINE AA_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(AA_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyInitOutput' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputHdrforPE)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdrforPE) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUntforPE)) THEN - DEALLOCATE(InitOutputData%WriteOutputUntforPE) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputHdrSep)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdrSep) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUntSep)) THEN - DEALLOCATE(InitOutputData%WriteOutputUntSep) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputHdrNodes)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdrNodes) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUntNodes)) THEN - DEALLOCATE(InitOutputData%WriteOutputUntNodes) -ENDIF - CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AA_DestroyInitOutput +subroutine AA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(AA_InitOutputType), intent(in) :: SrcInitOutputData + type(AA_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AA_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr + else if (allocated(DstInitOutputData%WriteOutputHdr)) then + deallocate(DstInitOutputData%WriteOutputHdr) + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt + else if (allocated(DstInitOutputData%WriteOutputUnt)) then + deallocate(DstInitOutputData%WriteOutputUnt) + end if + if (allocated(SrcInitOutputData%WriteOutputHdrforPE)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdrforPE) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdrforPE) + if (.not. allocated(DstInitOutputData%WriteOutputHdrforPE)) then + allocate(DstInitOutputData%WriteOutputHdrforPE(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdrforPE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputHdrforPE = SrcInitOutputData%WriteOutputHdrforPE + else if (allocated(DstInitOutputData%WriteOutputHdrforPE)) then + deallocate(DstInitOutputData%WriteOutputHdrforPE) + end if + if (allocated(SrcInitOutputData%WriteOutputUntforPE)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUntforPE) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUntforPE) + if (.not. allocated(DstInitOutputData%WriteOutputUntforPE)) then + allocate(DstInitOutputData%WriteOutputUntforPE(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUntforPE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputUntforPE = SrcInitOutputData%WriteOutputUntforPE + else if (allocated(DstInitOutputData%WriteOutputUntforPE)) then + deallocate(DstInitOutputData%WriteOutputUntforPE) + end if + if (allocated(SrcInitOutputData%WriteOutputHdrSep)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdrSep) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdrSep) + if (.not. allocated(DstInitOutputData%WriteOutputHdrSep)) then + allocate(DstInitOutputData%WriteOutputHdrSep(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdrSep.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputHdrSep = SrcInitOutputData%WriteOutputHdrSep + else if (allocated(DstInitOutputData%WriteOutputHdrSep)) then + deallocate(DstInitOutputData%WriteOutputHdrSep) + end if + if (allocated(SrcInitOutputData%WriteOutputUntSep)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUntSep) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUntSep) + if (.not. allocated(DstInitOutputData%WriteOutputUntSep)) then + allocate(DstInitOutputData%WriteOutputUntSep(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUntSep.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputUntSep = SrcInitOutputData%WriteOutputUntSep + else if (allocated(DstInitOutputData%WriteOutputUntSep)) then + deallocate(DstInitOutputData%WriteOutputUntSep) + end if + if (allocated(SrcInitOutputData%WriteOutputHdrNodes)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdrNodes) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdrNodes) + if (.not. allocated(DstInitOutputData%WriteOutputHdrNodes)) then + allocate(DstInitOutputData%WriteOutputHdrNodes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdrNodes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputHdrNodes = SrcInitOutputData%WriteOutputHdrNodes + else if (allocated(DstInitOutputData%WriteOutputHdrNodes)) then + deallocate(DstInitOutputData%WriteOutputHdrNodes) + end if + if (allocated(SrcInitOutputData%WriteOutputUntNodes)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUntNodes) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUntNodes) + if (.not. allocated(DstInitOutputData%WriteOutputUntNodes)) then + allocate(DstInitOutputData%WriteOutputUntNodes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUntNodes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputUntNodes = SrcInitOutputData%WriteOutputUntNodes + else if (allocated(DstInitOutputData%WriteOutputUntNodes)) then + deallocate(DstInitOutputData%WriteOutputUntNodes) + end if + DstInitOutputData%delim = SrcInitOutputData%delim + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitOutputData%AirDens = SrcInitOutputData%AirDens +end subroutine +subroutine AA_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(AA_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AA_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if + if (allocated(InitOutputData%WriteOutputHdrforPE)) then + deallocate(InitOutputData%WriteOutputHdrforPE) + end if + if (allocated(InitOutputData%WriteOutputUntforPE)) then + deallocate(InitOutputData%WriteOutputUntforPE) + end if + if (allocated(InitOutputData%WriteOutputHdrSep)) then + deallocate(InitOutputData%WriteOutputHdrSep) + end if + if (allocated(InitOutputData%WriteOutputUntSep)) then + deallocate(InitOutputData%WriteOutputUntSep) + end if + if (allocated(InitOutputData%WriteOutputHdrNodes)) then + deallocate(InitOutputData%WriteOutputHdrNodes) + end if + if (allocated(InitOutputData%WriteOutputUntNodes)) then + deallocate(InitOutputData%WriteOutputUntNodes) + end if +end subroutine subroutine AA_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AA_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AA_PackInitOutput' if (Buf%ErrStat >= AbortErrLev) return - ! WriteOutputHdr call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) call RegPack(Buf, InData%WriteOutputHdr) end if if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutputUnt call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) call RegPack(Buf, InData%WriteOutputUnt) end if if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutputHdrforPE call RegPack(Buf, allocated(InData%WriteOutputHdrforPE)) if (allocated(InData%WriteOutputHdrforPE)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdrforPE), ubound(InData%WriteOutputHdrforPE)) call RegPack(Buf, InData%WriteOutputHdrforPE) end if if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutputUntforPE call RegPack(Buf, allocated(InData%WriteOutputUntforPE)) if (allocated(InData%WriteOutputUntforPE)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUntforPE), ubound(InData%WriteOutputUntforPE)) call RegPack(Buf, InData%WriteOutputUntforPE) end if if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutputHdrSep call RegPack(Buf, allocated(InData%WriteOutputHdrSep)) if (allocated(InData%WriteOutputHdrSep)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdrSep), ubound(InData%WriteOutputHdrSep)) call RegPack(Buf, InData%WriteOutputHdrSep) end if if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutputUntSep call RegPack(Buf, allocated(InData%WriteOutputUntSep)) if (allocated(InData%WriteOutputUntSep)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUntSep), ubound(InData%WriteOutputUntSep)) call RegPack(Buf, InData%WriteOutputUntSep) end if if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutputHdrNodes call RegPack(Buf, allocated(InData%WriteOutputHdrNodes)) if (allocated(InData%WriteOutputHdrNodes)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdrNodes), ubound(InData%WriteOutputHdrNodes)) call RegPack(Buf, InData%WriteOutputHdrNodes) end if if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutputUntNodes call RegPack(Buf, allocated(InData%WriteOutputUntNodes)) if (allocated(InData%WriteOutputUntNodes)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUntNodes), ubound(InData%WriteOutputUntNodes)) call RegPack(Buf, InData%WriteOutputUntNodes) end if if (RegCheckErr(Buf, RoutineName)) return - ! delim call RegPack(Buf, InData%delim) if (RegCheckErr(Buf, RoutineName)) return - ! Ver call NWTC_Library_PackProgDesc(Buf, InData%Ver) if (RegCheckErr(Buf, RoutineName)) return - ! AirDens call RegPack(Buf, InData%AirDens) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -853,7 +809,6 @@ subroutine AA_UnPackInitOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! WriteOutputHdr if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -868,7 +823,6 @@ subroutine AA_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutputHdr) if (RegCheckErr(Buf, RoutineName)) return end if - ! WriteOutputUnt if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -883,7 +837,6 @@ subroutine AA_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutputUnt) if (RegCheckErr(Buf, RoutineName)) return end if - ! WriteOutputHdrforPE if (allocated(OutData%WriteOutputHdrforPE)) deallocate(OutData%WriteOutputHdrforPE) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -898,7 +851,6 @@ subroutine AA_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutputHdrforPE) if (RegCheckErr(Buf, RoutineName)) return end if - ! WriteOutputUntforPE if (allocated(OutData%WriteOutputUntforPE)) deallocate(OutData%WriteOutputUntforPE) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -913,7 +865,6 @@ subroutine AA_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutputUntforPE) if (RegCheckErr(Buf, RoutineName)) return end if - ! WriteOutputHdrSep if (allocated(OutData%WriteOutputHdrSep)) deallocate(OutData%WriteOutputHdrSep) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -928,7 +879,6 @@ subroutine AA_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutputHdrSep) if (RegCheckErr(Buf, RoutineName)) return end if - ! WriteOutputUntSep if (allocated(OutData%WriteOutputUntSep)) deallocate(OutData%WriteOutputUntSep) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -943,7 +893,6 @@ subroutine AA_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutputUntSep) if (RegCheckErr(Buf, RoutineName)) return end if - ! WriteOutputHdrNodes if (allocated(OutData%WriteOutputHdrNodes)) deallocate(OutData%WriteOutputHdrNodes) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -958,7 +907,6 @@ subroutine AA_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutputHdrNodes) if (RegCheckErr(Buf, RoutineName)) return end if - ! WriteOutputUntNodes if (allocated(OutData%WriteOutputUntNodes)) deallocate(OutData%WriteOutputUntNodes) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -973,354 +921,345 @@ subroutine AA_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutputUntNodes) if (RegCheckErr(Buf, RoutineName)) return end if - ! delim call RegUnpack(Buf, OutData%delim) if (RegCheckErr(Buf, RoutineName)) return - ! Ver call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver - ! AirDens call RegUnpack(Buf, OutData%AirDens) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE AA_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_InputFile), INTENT(IN) :: SrcInputFileData - TYPE(AA_InputFile), INTENT(INOUT) :: DstInputFileData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_CopyInputFile' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInputFileData%DT_AA = SrcInputFileData%DT_AA - DstInputFileData%IBLUNT = SrcInputFileData%IBLUNT - DstInputFileData%ILAM = SrcInputFileData%ILAM - DstInputFileData%ITIP = SrcInputFileData%ITIP - DstInputFileData%ITRIP = SrcInputFileData%ITRIP - DstInputFileData%ITURB = SrcInputFileData%ITURB - DstInputFileData%IInflow = SrcInputFileData%IInflow - DstInputFileData%X_BLMethod = SrcInputFileData%X_BLMethod - DstInputFileData%TICalcMeth = SrcInputFileData%TICalcMeth - DstInputFileData%NReListBL = SrcInputFileData%NReListBL - DstInputFileData%aweightflag = SrcInputFileData%aweightflag - DstInputFileData%ROUND = SrcInputFileData%ROUND - DstInputFileData%ALPRAT = SrcInputFileData%ALPRAT - DstInputFileData%AA_Bl_Prcntge = SrcInputFileData%AA_Bl_Prcntge - DstInputFileData%NrObsLoc = SrcInputFileData%NrObsLoc -IF (ALLOCATED(SrcInputFileData%ObsX)) THEN - i1_l = LBOUND(SrcInputFileData%ObsX,1) - i1_u = UBOUND(SrcInputFileData%ObsX,1) - IF (.NOT. ALLOCATED(DstInputFileData%ObsX)) THEN - ALLOCATE(DstInputFileData%ObsX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ObsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%ObsX = SrcInputFileData%ObsX -ENDIF -IF (ALLOCATED(SrcInputFileData%ObsY)) THEN - i1_l = LBOUND(SrcInputFileData%ObsY,1) - i1_u = UBOUND(SrcInputFileData%ObsY,1) - IF (.NOT. ALLOCATED(DstInputFileData%ObsY)) THEN - ALLOCATE(DstInputFileData%ObsY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ObsY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%ObsY = SrcInputFileData%ObsY -ENDIF -IF (ALLOCATED(SrcInputFileData%ObsZ)) THEN - i1_l = LBOUND(SrcInputFileData%ObsZ,1) - i1_u = UBOUND(SrcInputFileData%ObsZ,1) - IF (.NOT. ALLOCATED(DstInputFileData%ObsZ)) THEN - ALLOCATE(DstInputFileData%ObsZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ObsZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%ObsZ = SrcInputFileData%ObsZ -ENDIF -IF (ALLOCATED(SrcInputFileData%BladeProps)) THEN - i1_l = LBOUND(SrcInputFileData%BladeProps,1) - i1_u = UBOUND(SrcInputFileData%BladeProps,1) - IF (.NOT. ALLOCATED(DstInputFileData%BladeProps)) THEN - ALLOCATE(DstInputFileData%BladeProps(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BladeProps.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputFileData%BladeProps,1), UBOUND(SrcInputFileData%BladeProps,1) - CALL AA_Copybladepropstype( SrcInputFileData%BladeProps(i1), DstInputFileData%BladeProps(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstInputFileData%NrOutFile = SrcInputFileData%NrOutFile -IF (ALLOCATED(SrcInputFileData%AAoutfile)) THEN - i1_l = LBOUND(SrcInputFileData%AAoutfile,1) - i1_u = UBOUND(SrcInputFileData%AAoutfile,1) - IF (.NOT. ALLOCATED(DstInputFileData%AAoutfile)) THEN - ALLOCATE(DstInputFileData%AAoutfile(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%AAoutfile.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%AAoutfile = SrcInputFileData%AAoutfile -ENDIF - DstInputFileData%TICalcTabFile = SrcInputFileData%TICalcTabFile - DstInputFileData%FTitle = SrcInputFileData%FTitle - DstInputFileData%AAStart = SrcInputFileData%AAStart - DstInputFileData%Lturb = SrcInputFileData%Lturb - DstInputFileData%AvgV = SrcInputFileData%AvgV -IF (ALLOCATED(SrcInputFileData%ReListBL)) THEN - i1_l = LBOUND(SrcInputFileData%ReListBL,1) - i1_u = UBOUND(SrcInputFileData%ReListBL,1) - IF (.NOT. ALLOCATED(DstInputFileData%ReListBL)) THEN - ALLOCATE(DstInputFileData%ReListBL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ReListBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%ReListBL = SrcInputFileData%ReListBL -ENDIF -IF (ALLOCATED(SrcInputFileData%AoAListBL)) THEN - i1_l = LBOUND(SrcInputFileData%AoAListBL,1) - i1_u = UBOUND(SrcInputFileData%AoAListBL,1) - IF (.NOT. ALLOCATED(DstInputFileData%AoAListBL)) THEN - ALLOCATE(DstInputFileData%AoAListBL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%AoAListBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%AoAListBL = SrcInputFileData%AoAListBL -ENDIF -IF (ALLOCATED(SrcInputFileData%Pres_DispThick)) THEN - i1_l = LBOUND(SrcInputFileData%Pres_DispThick,1) - i1_u = UBOUND(SrcInputFileData%Pres_DispThick,1) - i2_l = LBOUND(SrcInputFileData%Pres_DispThick,2) - i2_u = UBOUND(SrcInputFileData%Pres_DispThick,2) - i3_l = LBOUND(SrcInputFileData%Pres_DispThick,3) - i3_u = UBOUND(SrcInputFileData%Pres_DispThick,3) - IF (.NOT. ALLOCATED(DstInputFileData%Pres_DispThick)) THEN - ALLOCATE(DstInputFileData%Pres_DispThick(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Pres_DispThick.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%Pres_DispThick = SrcInputFileData%Pres_DispThick -ENDIF -IF (ALLOCATED(SrcInputFileData%Suct_DispThick)) THEN - i1_l = LBOUND(SrcInputFileData%Suct_DispThick,1) - i1_u = UBOUND(SrcInputFileData%Suct_DispThick,1) - i2_l = LBOUND(SrcInputFileData%Suct_DispThick,2) - i2_u = UBOUND(SrcInputFileData%Suct_DispThick,2) - i3_l = LBOUND(SrcInputFileData%Suct_DispThick,3) - i3_u = UBOUND(SrcInputFileData%Suct_DispThick,3) - IF (.NOT. ALLOCATED(DstInputFileData%Suct_DispThick)) THEN - ALLOCATE(DstInputFileData%Suct_DispThick(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Suct_DispThick.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%Suct_DispThick = SrcInputFileData%Suct_DispThick -ENDIF -IF (ALLOCATED(SrcInputFileData%Pres_BLThick)) THEN - i1_l = LBOUND(SrcInputFileData%Pres_BLThick,1) - i1_u = UBOUND(SrcInputFileData%Pres_BLThick,1) - i2_l = LBOUND(SrcInputFileData%Pres_BLThick,2) - i2_u = UBOUND(SrcInputFileData%Pres_BLThick,2) - i3_l = LBOUND(SrcInputFileData%Pres_BLThick,3) - i3_u = UBOUND(SrcInputFileData%Pres_BLThick,3) - IF (.NOT. ALLOCATED(DstInputFileData%Pres_BLThick)) THEN - ALLOCATE(DstInputFileData%Pres_BLThick(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Pres_BLThick.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%Pres_BLThick = SrcInputFileData%Pres_BLThick -ENDIF -IF (ALLOCATED(SrcInputFileData%Suct_BLThick)) THEN - i1_l = LBOUND(SrcInputFileData%Suct_BLThick,1) - i1_u = UBOUND(SrcInputFileData%Suct_BLThick,1) - i2_l = LBOUND(SrcInputFileData%Suct_BLThick,2) - i2_u = UBOUND(SrcInputFileData%Suct_BLThick,2) - i3_l = LBOUND(SrcInputFileData%Suct_BLThick,3) - i3_u = UBOUND(SrcInputFileData%Suct_BLThick,3) - IF (.NOT. ALLOCATED(DstInputFileData%Suct_BLThick)) THEN - ALLOCATE(DstInputFileData%Suct_BLThick(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Suct_BLThick.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%Suct_BLThick = SrcInputFileData%Suct_BLThick -ENDIF -IF (ALLOCATED(SrcInputFileData%Pres_Cf)) THEN - i1_l = LBOUND(SrcInputFileData%Pres_Cf,1) - i1_u = UBOUND(SrcInputFileData%Pres_Cf,1) - i2_l = LBOUND(SrcInputFileData%Pres_Cf,2) - i2_u = UBOUND(SrcInputFileData%Pres_Cf,2) - i3_l = LBOUND(SrcInputFileData%Pres_Cf,3) - i3_u = UBOUND(SrcInputFileData%Pres_Cf,3) - IF (.NOT. ALLOCATED(DstInputFileData%Pres_Cf)) THEN - ALLOCATE(DstInputFileData%Pres_Cf(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Pres_Cf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%Pres_Cf = SrcInputFileData%Pres_Cf -ENDIF -IF (ALLOCATED(SrcInputFileData%Suct_Cf)) THEN - i1_l = LBOUND(SrcInputFileData%Suct_Cf,1) - i1_u = UBOUND(SrcInputFileData%Suct_Cf,1) - i2_l = LBOUND(SrcInputFileData%Suct_Cf,2) - i2_u = UBOUND(SrcInputFileData%Suct_Cf,2) - i3_l = LBOUND(SrcInputFileData%Suct_Cf,3) - i3_u = UBOUND(SrcInputFileData%Suct_Cf,3) - IF (.NOT. ALLOCATED(DstInputFileData%Suct_Cf)) THEN - ALLOCATE(DstInputFileData%Suct_Cf(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Suct_Cf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%Suct_Cf = SrcInputFileData%Suct_Cf -ENDIF -IF (ALLOCATED(SrcInputFileData%Pres_EdgeVelRat)) THEN - i1_l = LBOUND(SrcInputFileData%Pres_EdgeVelRat,1) - i1_u = UBOUND(SrcInputFileData%Pres_EdgeVelRat,1) - i2_l = LBOUND(SrcInputFileData%Pres_EdgeVelRat,2) - i2_u = UBOUND(SrcInputFileData%Pres_EdgeVelRat,2) - i3_l = LBOUND(SrcInputFileData%Pres_EdgeVelRat,3) - i3_u = UBOUND(SrcInputFileData%Pres_EdgeVelRat,3) - IF (.NOT. ALLOCATED(DstInputFileData%Pres_EdgeVelRat)) THEN - ALLOCATE(DstInputFileData%Pres_EdgeVelRat(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Pres_EdgeVelRat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%Pres_EdgeVelRat = SrcInputFileData%Pres_EdgeVelRat -ENDIF -IF (ALLOCATED(SrcInputFileData%Suct_EdgeVelRat)) THEN - i1_l = LBOUND(SrcInputFileData%Suct_EdgeVelRat,1) - i1_u = UBOUND(SrcInputFileData%Suct_EdgeVelRat,1) - i2_l = LBOUND(SrcInputFileData%Suct_EdgeVelRat,2) - i2_u = UBOUND(SrcInputFileData%Suct_EdgeVelRat,2) - i3_l = LBOUND(SrcInputFileData%Suct_EdgeVelRat,3) - i3_u = UBOUND(SrcInputFileData%Suct_EdgeVelRat,3) - IF (.NOT. ALLOCATED(DstInputFileData%Suct_EdgeVelRat)) THEN - ALLOCATE(DstInputFileData%Suct_EdgeVelRat(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Suct_EdgeVelRat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%Suct_EdgeVelRat = SrcInputFileData%Suct_EdgeVelRat -ENDIF -IF (ALLOCATED(SrcInputFileData%TI_Grid_In)) THEN - i1_l = LBOUND(SrcInputFileData%TI_Grid_In,1) - i1_u = UBOUND(SrcInputFileData%TI_Grid_In,1) - i2_l = LBOUND(SrcInputFileData%TI_Grid_In,2) - i2_u = UBOUND(SrcInputFileData%TI_Grid_In,2) - IF (.NOT. ALLOCATED(DstInputFileData%TI_Grid_In)) THEN - ALLOCATE(DstInputFileData%TI_Grid_In(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TI_Grid_In.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%TI_Grid_In = SrcInputFileData%TI_Grid_In -ENDIF - DstInputFileData%dz_turb_in = SrcInputFileData%dz_turb_in - DstInputFileData%dy_turb_in = SrcInputFileData%dy_turb_in - END SUBROUTINE AA_CopyInputFile - - SUBROUTINE AA_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) - TYPE(AA_InputFile), INTENT(INOUT) :: InputFileData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyInputFile' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(InputFileData%ObsX)) THEN - DEALLOCATE(InputFileData%ObsX) -ENDIF -IF (ALLOCATED(InputFileData%ObsY)) THEN - DEALLOCATE(InputFileData%ObsY) -ENDIF -IF (ALLOCATED(InputFileData%ObsZ)) THEN - DEALLOCATE(InputFileData%ObsZ) -ENDIF -IF (ALLOCATED(InputFileData%BladeProps)) THEN -DO i1 = LBOUND(InputFileData%BladeProps,1), UBOUND(InputFileData%BladeProps,1) - CALL AA_DestroyBladePropsType( InputFileData%BladeProps(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InputFileData%BladeProps) -ENDIF -IF (ALLOCATED(InputFileData%AAoutfile)) THEN - DEALLOCATE(InputFileData%AAoutfile) -ENDIF -IF (ALLOCATED(InputFileData%ReListBL)) THEN - DEALLOCATE(InputFileData%ReListBL) -ENDIF -IF (ALLOCATED(InputFileData%AoAListBL)) THEN - DEALLOCATE(InputFileData%AoAListBL) -ENDIF -IF (ALLOCATED(InputFileData%Pres_DispThick)) THEN - DEALLOCATE(InputFileData%Pres_DispThick) -ENDIF -IF (ALLOCATED(InputFileData%Suct_DispThick)) THEN - DEALLOCATE(InputFileData%Suct_DispThick) -ENDIF -IF (ALLOCATED(InputFileData%Pres_BLThick)) THEN - DEALLOCATE(InputFileData%Pres_BLThick) -ENDIF -IF (ALLOCATED(InputFileData%Suct_BLThick)) THEN - DEALLOCATE(InputFileData%Suct_BLThick) -ENDIF -IF (ALLOCATED(InputFileData%Pres_Cf)) THEN - DEALLOCATE(InputFileData%Pres_Cf) -ENDIF -IF (ALLOCATED(InputFileData%Suct_Cf)) THEN - DEALLOCATE(InputFileData%Suct_Cf) -ENDIF -IF (ALLOCATED(InputFileData%Pres_EdgeVelRat)) THEN - DEALLOCATE(InputFileData%Pres_EdgeVelRat) -ENDIF -IF (ALLOCATED(InputFileData%Suct_EdgeVelRat)) THEN - DEALLOCATE(InputFileData%Suct_EdgeVelRat) -ENDIF -IF (ALLOCATED(InputFileData%TI_Grid_In)) THEN - DEALLOCATE(InputFileData%TI_Grid_In) -ENDIF - END SUBROUTINE AA_DestroyInputFile +subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) + type(AA_InputFile), intent(in) :: SrcInputFileData + type(AA_InputFile), intent(inout) :: DstInputFileData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AA_CopyInputFile' + ErrStat = ErrID_None + ErrMsg = '' + DstInputFileData%DT_AA = SrcInputFileData%DT_AA + DstInputFileData%IBLUNT = SrcInputFileData%IBLUNT + DstInputFileData%ILAM = SrcInputFileData%ILAM + DstInputFileData%ITIP = SrcInputFileData%ITIP + DstInputFileData%ITRIP = SrcInputFileData%ITRIP + DstInputFileData%ITURB = SrcInputFileData%ITURB + DstInputFileData%IInflow = SrcInputFileData%IInflow + DstInputFileData%X_BLMethod = SrcInputFileData%X_BLMethod + DstInputFileData%TICalcMeth = SrcInputFileData%TICalcMeth + DstInputFileData%NReListBL = SrcInputFileData%NReListBL + DstInputFileData%aweightflag = SrcInputFileData%aweightflag + DstInputFileData%ROUND = SrcInputFileData%ROUND + DstInputFileData%ALPRAT = SrcInputFileData%ALPRAT + DstInputFileData%AA_Bl_Prcntge = SrcInputFileData%AA_Bl_Prcntge + DstInputFileData%NrObsLoc = SrcInputFileData%NrObsLoc + if (allocated(SrcInputFileData%ObsX)) then + LB(1:1) = lbound(SrcInputFileData%ObsX) + UB(1:1) = ubound(SrcInputFileData%ObsX) + if (.not. allocated(DstInputFileData%ObsX)) then + allocate(DstInputFileData%ObsX(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ObsX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%ObsX = SrcInputFileData%ObsX + else if (allocated(DstInputFileData%ObsX)) then + deallocate(DstInputFileData%ObsX) + end if + if (allocated(SrcInputFileData%ObsY)) then + LB(1:1) = lbound(SrcInputFileData%ObsY) + UB(1:1) = ubound(SrcInputFileData%ObsY) + if (.not. allocated(DstInputFileData%ObsY)) then + allocate(DstInputFileData%ObsY(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ObsY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%ObsY = SrcInputFileData%ObsY + else if (allocated(DstInputFileData%ObsY)) then + deallocate(DstInputFileData%ObsY) + end if + if (allocated(SrcInputFileData%ObsZ)) then + LB(1:1) = lbound(SrcInputFileData%ObsZ) + UB(1:1) = ubound(SrcInputFileData%ObsZ) + if (.not. allocated(DstInputFileData%ObsZ)) then + allocate(DstInputFileData%ObsZ(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ObsZ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%ObsZ = SrcInputFileData%ObsZ + else if (allocated(DstInputFileData%ObsZ)) then + deallocate(DstInputFileData%ObsZ) + end if + if (allocated(SrcInputFileData%BladeProps)) then + LB(1:1) = lbound(SrcInputFileData%BladeProps) + UB(1:1) = ubound(SrcInputFileData%BladeProps) + if (.not. allocated(DstInputFileData%BladeProps)) then + allocate(DstInputFileData%BladeProps(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BladeProps.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AA_CopyBladePropsType(SrcInputFileData%BladeProps(i1), DstInputFileData%BladeProps(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstInputFileData%BladeProps)) then + deallocate(DstInputFileData%BladeProps) + end if + DstInputFileData%NrOutFile = SrcInputFileData%NrOutFile + if (allocated(SrcInputFileData%AAoutfile)) then + LB(1:1) = lbound(SrcInputFileData%AAoutfile) + UB(1:1) = ubound(SrcInputFileData%AAoutfile) + if (.not. allocated(DstInputFileData%AAoutfile)) then + allocate(DstInputFileData%AAoutfile(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%AAoutfile.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%AAoutfile = SrcInputFileData%AAoutfile + else if (allocated(DstInputFileData%AAoutfile)) then + deallocate(DstInputFileData%AAoutfile) + end if + DstInputFileData%TICalcTabFile = SrcInputFileData%TICalcTabFile + DstInputFileData%FTitle = SrcInputFileData%FTitle + DstInputFileData%AAStart = SrcInputFileData%AAStart + DstInputFileData%Lturb = SrcInputFileData%Lturb + DstInputFileData%AvgV = SrcInputFileData%AvgV + if (allocated(SrcInputFileData%ReListBL)) then + LB(1:1) = lbound(SrcInputFileData%ReListBL) + UB(1:1) = ubound(SrcInputFileData%ReListBL) + if (.not. allocated(DstInputFileData%ReListBL)) then + allocate(DstInputFileData%ReListBL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ReListBL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%ReListBL = SrcInputFileData%ReListBL + else if (allocated(DstInputFileData%ReListBL)) then + deallocate(DstInputFileData%ReListBL) + end if + if (allocated(SrcInputFileData%AoAListBL)) then + LB(1:1) = lbound(SrcInputFileData%AoAListBL) + UB(1:1) = ubound(SrcInputFileData%AoAListBL) + if (.not. allocated(DstInputFileData%AoAListBL)) then + allocate(DstInputFileData%AoAListBL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%AoAListBL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%AoAListBL = SrcInputFileData%AoAListBL + else if (allocated(DstInputFileData%AoAListBL)) then + deallocate(DstInputFileData%AoAListBL) + end if + if (allocated(SrcInputFileData%Pres_DispThick)) then + LB(1:3) = lbound(SrcInputFileData%Pres_DispThick) + UB(1:3) = ubound(SrcInputFileData%Pres_DispThick) + if (.not. allocated(DstInputFileData%Pres_DispThick)) then + allocate(DstInputFileData%Pres_DispThick(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Pres_DispThick.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%Pres_DispThick = SrcInputFileData%Pres_DispThick + else if (allocated(DstInputFileData%Pres_DispThick)) then + deallocate(DstInputFileData%Pres_DispThick) + end if + if (allocated(SrcInputFileData%Suct_DispThick)) then + LB(1:3) = lbound(SrcInputFileData%Suct_DispThick) + UB(1:3) = ubound(SrcInputFileData%Suct_DispThick) + if (.not. allocated(DstInputFileData%Suct_DispThick)) then + allocate(DstInputFileData%Suct_DispThick(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Suct_DispThick.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%Suct_DispThick = SrcInputFileData%Suct_DispThick + else if (allocated(DstInputFileData%Suct_DispThick)) then + deallocate(DstInputFileData%Suct_DispThick) + end if + if (allocated(SrcInputFileData%Pres_BLThick)) then + LB(1:3) = lbound(SrcInputFileData%Pres_BLThick) + UB(1:3) = ubound(SrcInputFileData%Pres_BLThick) + if (.not. allocated(DstInputFileData%Pres_BLThick)) then + allocate(DstInputFileData%Pres_BLThick(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Pres_BLThick.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%Pres_BLThick = SrcInputFileData%Pres_BLThick + else if (allocated(DstInputFileData%Pres_BLThick)) then + deallocate(DstInputFileData%Pres_BLThick) + end if + if (allocated(SrcInputFileData%Suct_BLThick)) then + LB(1:3) = lbound(SrcInputFileData%Suct_BLThick) + UB(1:3) = ubound(SrcInputFileData%Suct_BLThick) + if (.not. allocated(DstInputFileData%Suct_BLThick)) then + allocate(DstInputFileData%Suct_BLThick(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Suct_BLThick.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%Suct_BLThick = SrcInputFileData%Suct_BLThick + else if (allocated(DstInputFileData%Suct_BLThick)) then + deallocate(DstInputFileData%Suct_BLThick) + end if + if (allocated(SrcInputFileData%Pres_Cf)) then + LB(1:3) = lbound(SrcInputFileData%Pres_Cf) + UB(1:3) = ubound(SrcInputFileData%Pres_Cf) + if (.not. allocated(DstInputFileData%Pres_Cf)) then + allocate(DstInputFileData%Pres_Cf(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Pres_Cf.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%Pres_Cf = SrcInputFileData%Pres_Cf + else if (allocated(DstInputFileData%Pres_Cf)) then + deallocate(DstInputFileData%Pres_Cf) + end if + if (allocated(SrcInputFileData%Suct_Cf)) then + LB(1:3) = lbound(SrcInputFileData%Suct_Cf) + UB(1:3) = ubound(SrcInputFileData%Suct_Cf) + if (.not. allocated(DstInputFileData%Suct_Cf)) then + allocate(DstInputFileData%Suct_Cf(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Suct_Cf.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%Suct_Cf = SrcInputFileData%Suct_Cf + else if (allocated(DstInputFileData%Suct_Cf)) then + deallocate(DstInputFileData%Suct_Cf) + end if + if (allocated(SrcInputFileData%Pres_EdgeVelRat)) then + LB(1:3) = lbound(SrcInputFileData%Pres_EdgeVelRat) + UB(1:3) = ubound(SrcInputFileData%Pres_EdgeVelRat) + if (.not. allocated(DstInputFileData%Pres_EdgeVelRat)) then + allocate(DstInputFileData%Pres_EdgeVelRat(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Pres_EdgeVelRat.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%Pres_EdgeVelRat = SrcInputFileData%Pres_EdgeVelRat + else if (allocated(DstInputFileData%Pres_EdgeVelRat)) then + deallocate(DstInputFileData%Pres_EdgeVelRat) + end if + if (allocated(SrcInputFileData%Suct_EdgeVelRat)) then + LB(1:3) = lbound(SrcInputFileData%Suct_EdgeVelRat) + UB(1:3) = ubound(SrcInputFileData%Suct_EdgeVelRat) + if (.not. allocated(DstInputFileData%Suct_EdgeVelRat)) then + allocate(DstInputFileData%Suct_EdgeVelRat(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Suct_EdgeVelRat.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%Suct_EdgeVelRat = SrcInputFileData%Suct_EdgeVelRat + else if (allocated(DstInputFileData%Suct_EdgeVelRat)) then + deallocate(DstInputFileData%Suct_EdgeVelRat) + end if + if (allocated(SrcInputFileData%TI_Grid_In)) then + LB(1:2) = lbound(SrcInputFileData%TI_Grid_In) + UB(1:2) = ubound(SrcInputFileData%TI_Grid_In) + if (.not. allocated(DstInputFileData%TI_Grid_In)) then + allocate(DstInputFileData%TI_Grid_In(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TI_Grid_In.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%TI_Grid_In = SrcInputFileData%TI_Grid_In + else if (allocated(DstInputFileData%TI_Grid_In)) then + deallocate(DstInputFileData%TI_Grid_In) + end if + DstInputFileData%dz_turb_in = SrcInputFileData%dz_turb_in + DstInputFileData%dy_turb_in = SrcInputFileData%dy_turb_in +end subroutine +subroutine AA_DestroyInputFile(InputFileData, ErrStat, ErrMsg) + type(AA_InputFile), intent(inout) :: InputFileData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AA_DestroyInputFile' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputFileData%ObsX)) then + deallocate(InputFileData%ObsX) + end if + if (allocated(InputFileData%ObsY)) then + deallocate(InputFileData%ObsY) + end if + if (allocated(InputFileData%ObsZ)) then + deallocate(InputFileData%ObsZ) + end if + if (allocated(InputFileData%BladeProps)) then + LB(1:1) = lbound(InputFileData%BladeProps) + UB(1:1) = ubound(InputFileData%BladeProps) + do i1 = LB(1), UB(1) + call AA_DestroyBladePropsType(InputFileData%BladeProps(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputFileData%BladeProps) + end if + if (allocated(InputFileData%AAoutfile)) then + deallocate(InputFileData%AAoutfile) + end if + if (allocated(InputFileData%ReListBL)) then + deallocate(InputFileData%ReListBL) + end if + if (allocated(InputFileData%AoAListBL)) then + deallocate(InputFileData%AoAListBL) + end if + if (allocated(InputFileData%Pres_DispThick)) then + deallocate(InputFileData%Pres_DispThick) + end if + if (allocated(InputFileData%Suct_DispThick)) then + deallocate(InputFileData%Suct_DispThick) + end if + if (allocated(InputFileData%Pres_BLThick)) then + deallocate(InputFileData%Pres_BLThick) + end if + if (allocated(InputFileData%Suct_BLThick)) then + deallocate(InputFileData%Suct_BLThick) + end if + if (allocated(InputFileData%Pres_Cf)) then + deallocate(InputFileData%Pres_Cf) + end if + if (allocated(InputFileData%Suct_Cf)) then + deallocate(InputFileData%Suct_Cf) + end if + if (allocated(InputFileData%Pres_EdgeVelRat)) then + deallocate(InputFileData%Pres_EdgeVelRat) + end if + if (allocated(InputFileData%Suct_EdgeVelRat)) then + deallocate(InputFileData%Suct_EdgeVelRat) + end if + if (allocated(InputFileData%TI_Grid_In)) then + deallocate(InputFileData%TI_Grid_In) + end if +end subroutine subroutine AA_PackInputFile(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -1329,73 +1268,54 @@ subroutine AA_PackInputFile(Buf, Indata) integer(IntKi) :: i1, i2, i3 integer(IntKi) :: LB(3), UB(3) if (Buf%ErrStat >= AbortErrLev) return - ! DT_AA call RegPack(Buf, InData%DT_AA) if (RegCheckErr(Buf, RoutineName)) return - ! IBLUNT call RegPack(Buf, InData%IBLUNT) if (RegCheckErr(Buf, RoutineName)) return - ! ILAM call RegPack(Buf, InData%ILAM) if (RegCheckErr(Buf, RoutineName)) return - ! ITIP call RegPack(Buf, InData%ITIP) if (RegCheckErr(Buf, RoutineName)) return - ! ITRIP call RegPack(Buf, InData%ITRIP) if (RegCheckErr(Buf, RoutineName)) return - ! ITURB call RegPack(Buf, InData%ITURB) if (RegCheckErr(Buf, RoutineName)) return - ! IInflow call RegPack(Buf, InData%IInflow) if (RegCheckErr(Buf, RoutineName)) return - ! X_BLMethod call RegPack(Buf, InData%X_BLMethod) if (RegCheckErr(Buf, RoutineName)) return - ! TICalcMeth call RegPack(Buf, InData%TICalcMeth) if (RegCheckErr(Buf, RoutineName)) return - ! NReListBL call RegPack(Buf, InData%NReListBL) if (RegCheckErr(Buf, RoutineName)) return - ! aweightflag call RegPack(Buf, InData%aweightflag) if (RegCheckErr(Buf, RoutineName)) return - ! ROUND call RegPack(Buf, InData%ROUND) if (RegCheckErr(Buf, RoutineName)) return - ! ALPRAT call RegPack(Buf, InData%ALPRAT) if (RegCheckErr(Buf, RoutineName)) return - ! AA_Bl_Prcntge call RegPack(Buf, InData%AA_Bl_Prcntge) if (RegCheckErr(Buf, RoutineName)) return - ! NrObsLoc call RegPack(Buf, InData%NrObsLoc) if (RegCheckErr(Buf, RoutineName)) return - ! ObsX call RegPack(Buf, allocated(InData%ObsX)) if (allocated(InData%ObsX)) then call RegPackBounds(Buf, 1, lbound(InData%ObsX), ubound(InData%ObsX)) call RegPack(Buf, InData%ObsX) end if if (RegCheckErr(Buf, RoutineName)) return - ! ObsY call RegPack(Buf, allocated(InData%ObsY)) if (allocated(InData%ObsY)) then call RegPackBounds(Buf, 1, lbound(InData%ObsY), ubound(InData%ObsY)) call RegPack(Buf, InData%ObsY) end if if (RegCheckErr(Buf, RoutineName)) return - ! ObsZ call RegPack(Buf, allocated(InData%ObsZ)) if (allocated(InData%ObsZ)) then call RegPackBounds(Buf, 1, lbound(InData%ObsZ), ubound(InData%ObsZ)) call RegPack(Buf, InData%ObsZ) end if if (RegCheckErr(Buf, RoutineName)) return - ! BladeProps call RegPack(Buf, allocated(InData%BladeProps)) if (allocated(InData%BladeProps)) then call RegPackBounds(Buf, 1, lbound(InData%BladeProps), ubound(InData%BladeProps)) @@ -1406,112 +1326,92 @@ subroutine AA_PackInputFile(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! NrOutFile call RegPack(Buf, InData%NrOutFile) if (RegCheckErr(Buf, RoutineName)) return - ! AAoutfile call RegPack(Buf, allocated(InData%AAoutfile)) if (allocated(InData%AAoutfile)) then call RegPackBounds(Buf, 1, lbound(InData%AAoutfile), ubound(InData%AAoutfile)) call RegPack(Buf, InData%AAoutfile) end if if (RegCheckErr(Buf, RoutineName)) return - ! TICalcTabFile call RegPack(Buf, InData%TICalcTabFile) if (RegCheckErr(Buf, RoutineName)) return - ! FTitle call RegPack(Buf, InData%FTitle) if (RegCheckErr(Buf, RoutineName)) return - ! AAStart call RegPack(Buf, InData%AAStart) if (RegCheckErr(Buf, RoutineName)) return - ! Lturb call RegPack(Buf, InData%Lturb) if (RegCheckErr(Buf, RoutineName)) return - ! AvgV call RegPack(Buf, InData%AvgV) if (RegCheckErr(Buf, RoutineName)) return - ! ReListBL call RegPack(Buf, allocated(InData%ReListBL)) if (allocated(InData%ReListBL)) then call RegPackBounds(Buf, 1, lbound(InData%ReListBL), ubound(InData%ReListBL)) call RegPack(Buf, InData%ReListBL) end if if (RegCheckErr(Buf, RoutineName)) return - ! AoAListBL call RegPack(Buf, allocated(InData%AoAListBL)) if (allocated(InData%AoAListBL)) then call RegPackBounds(Buf, 1, lbound(InData%AoAListBL), ubound(InData%AoAListBL)) call RegPack(Buf, InData%AoAListBL) end if if (RegCheckErr(Buf, RoutineName)) return - ! Pres_DispThick call RegPack(Buf, allocated(InData%Pres_DispThick)) if (allocated(InData%Pres_DispThick)) then call RegPackBounds(Buf, 3, lbound(InData%Pres_DispThick), ubound(InData%Pres_DispThick)) call RegPack(Buf, InData%Pres_DispThick) end if if (RegCheckErr(Buf, RoutineName)) return - ! Suct_DispThick call RegPack(Buf, allocated(InData%Suct_DispThick)) if (allocated(InData%Suct_DispThick)) then call RegPackBounds(Buf, 3, lbound(InData%Suct_DispThick), ubound(InData%Suct_DispThick)) call RegPack(Buf, InData%Suct_DispThick) end if if (RegCheckErr(Buf, RoutineName)) return - ! Pres_BLThick call RegPack(Buf, allocated(InData%Pres_BLThick)) if (allocated(InData%Pres_BLThick)) then call RegPackBounds(Buf, 3, lbound(InData%Pres_BLThick), ubound(InData%Pres_BLThick)) call RegPack(Buf, InData%Pres_BLThick) end if if (RegCheckErr(Buf, RoutineName)) return - ! Suct_BLThick call RegPack(Buf, allocated(InData%Suct_BLThick)) if (allocated(InData%Suct_BLThick)) then call RegPackBounds(Buf, 3, lbound(InData%Suct_BLThick), ubound(InData%Suct_BLThick)) call RegPack(Buf, InData%Suct_BLThick) end if if (RegCheckErr(Buf, RoutineName)) return - ! Pres_Cf call RegPack(Buf, allocated(InData%Pres_Cf)) if (allocated(InData%Pres_Cf)) then call RegPackBounds(Buf, 3, lbound(InData%Pres_Cf), ubound(InData%Pres_Cf)) call RegPack(Buf, InData%Pres_Cf) end if if (RegCheckErr(Buf, RoutineName)) return - ! Suct_Cf call RegPack(Buf, allocated(InData%Suct_Cf)) if (allocated(InData%Suct_Cf)) then call RegPackBounds(Buf, 3, lbound(InData%Suct_Cf), ubound(InData%Suct_Cf)) call RegPack(Buf, InData%Suct_Cf) end if if (RegCheckErr(Buf, RoutineName)) return - ! Pres_EdgeVelRat call RegPack(Buf, allocated(InData%Pres_EdgeVelRat)) if (allocated(InData%Pres_EdgeVelRat)) then call RegPackBounds(Buf, 3, lbound(InData%Pres_EdgeVelRat), ubound(InData%Pres_EdgeVelRat)) call RegPack(Buf, InData%Pres_EdgeVelRat) end if if (RegCheckErr(Buf, RoutineName)) return - ! Suct_EdgeVelRat call RegPack(Buf, allocated(InData%Suct_EdgeVelRat)) if (allocated(InData%Suct_EdgeVelRat)) then call RegPackBounds(Buf, 3, lbound(InData%Suct_EdgeVelRat), ubound(InData%Suct_EdgeVelRat)) call RegPack(Buf, InData%Suct_EdgeVelRat) end if if (RegCheckErr(Buf, RoutineName)) return - ! TI_Grid_In call RegPack(Buf, allocated(InData%TI_Grid_In)) if (allocated(InData%TI_Grid_In)) then call RegPackBounds(Buf, 2, lbound(InData%TI_Grid_In), ubound(InData%TI_Grid_In)) call RegPack(Buf, InData%TI_Grid_In) end if if (RegCheckErr(Buf, RoutineName)) return - ! dz_turb_in call RegPack(Buf, InData%dz_turb_in) if (RegCheckErr(Buf, RoutineName)) return - ! dy_turb_in call RegPack(Buf, InData%dy_turb_in) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1525,52 +1425,36 @@ subroutine AA_UnPackInputFile(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! DT_AA call RegUnpack(Buf, OutData%DT_AA) if (RegCheckErr(Buf, RoutineName)) return - ! IBLUNT call RegUnpack(Buf, OutData%IBLUNT) if (RegCheckErr(Buf, RoutineName)) return - ! ILAM call RegUnpack(Buf, OutData%ILAM) if (RegCheckErr(Buf, RoutineName)) return - ! ITIP call RegUnpack(Buf, OutData%ITIP) if (RegCheckErr(Buf, RoutineName)) return - ! ITRIP call RegUnpack(Buf, OutData%ITRIP) if (RegCheckErr(Buf, RoutineName)) return - ! ITURB call RegUnpack(Buf, OutData%ITURB) if (RegCheckErr(Buf, RoutineName)) return - ! IInflow call RegUnpack(Buf, OutData%IInflow) if (RegCheckErr(Buf, RoutineName)) return - ! X_BLMethod call RegUnpack(Buf, OutData%X_BLMethod) if (RegCheckErr(Buf, RoutineName)) return - ! TICalcMeth call RegUnpack(Buf, OutData%TICalcMeth) if (RegCheckErr(Buf, RoutineName)) return - ! NReListBL call RegUnpack(Buf, OutData%NReListBL) if (RegCheckErr(Buf, RoutineName)) return - ! aweightflag call RegUnpack(Buf, OutData%aweightflag) if (RegCheckErr(Buf, RoutineName)) return - ! ROUND call RegUnpack(Buf, OutData%ROUND) if (RegCheckErr(Buf, RoutineName)) return - ! ALPRAT call RegUnpack(Buf, OutData%ALPRAT) if (RegCheckErr(Buf, RoutineName)) return - ! AA_Bl_Prcntge call RegUnpack(Buf, OutData%AA_Bl_Prcntge) if (RegCheckErr(Buf, RoutineName)) return - ! NrObsLoc call RegUnpack(Buf, OutData%NrObsLoc) if (RegCheckErr(Buf, RoutineName)) return - ! ObsX if (allocated(OutData%ObsX)) deallocate(OutData%ObsX) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1585,7 +1469,6 @@ subroutine AA_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%ObsX) if (RegCheckErr(Buf, RoutineName)) return end if - ! ObsY if (allocated(OutData%ObsY)) deallocate(OutData%ObsY) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1600,7 +1483,6 @@ subroutine AA_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%ObsY) if (RegCheckErr(Buf, RoutineName)) return end if - ! ObsZ if (allocated(OutData%ObsZ)) deallocate(OutData%ObsZ) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1615,7 +1497,6 @@ subroutine AA_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%ObsZ) if (RegCheckErr(Buf, RoutineName)) return end if - ! BladeProps if (allocated(OutData%BladeProps)) deallocate(OutData%BladeProps) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1631,10 +1512,8 @@ subroutine AA_UnPackInputFile(Buf, OutData) call AA_UnpackBladePropsType(Buf, OutData%BladeProps(i1)) ! BladeProps end do end if - ! NrOutFile call RegUnpack(Buf, OutData%NrOutFile) if (RegCheckErr(Buf, RoutineName)) return - ! AAoutfile if (allocated(OutData%AAoutfile)) deallocate(OutData%AAoutfile) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1649,22 +1528,16 @@ subroutine AA_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%AAoutfile) if (RegCheckErr(Buf, RoutineName)) return end if - ! TICalcTabFile call RegUnpack(Buf, OutData%TICalcTabFile) if (RegCheckErr(Buf, RoutineName)) return - ! FTitle call RegUnpack(Buf, OutData%FTitle) if (RegCheckErr(Buf, RoutineName)) return - ! AAStart call RegUnpack(Buf, OutData%AAStart) if (RegCheckErr(Buf, RoutineName)) return - ! Lturb call RegUnpack(Buf, OutData%Lturb) if (RegCheckErr(Buf, RoutineName)) return - ! AvgV call RegUnpack(Buf, OutData%AvgV) if (RegCheckErr(Buf, RoutineName)) return - ! ReListBL if (allocated(OutData%ReListBL)) deallocate(OutData%ReListBL) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1679,7 +1552,6 @@ subroutine AA_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%ReListBL) if (RegCheckErr(Buf, RoutineName)) return end if - ! AoAListBL if (allocated(OutData%AoAListBL)) deallocate(OutData%AoAListBL) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1694,7 +1566,6 @@ subroutine AA_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%AoAListBL) if (RegCheckErr(Buf, RoutineName)) return end if - ! Pres_DispThick if (allocated(OutData%Pres_DispThick)) deallocate(OutData%Pres_DispThick) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1709,7 +1580,6 @@ subroutine AA_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%Pres_DispThick) if (RegCheckErr(Buf, RoutineName)) return end if - ! Suct_DispThick if (allocated(OutData%Suct_DispThick)) deallocate(OutData%Suct_DispThick) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1724,7 +1594,6 @@ subroutine AA_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%Suct_DispThick) if (RegCheckErr(Buf, RoutineName)) return end if - ! Pres_BLThick if (allocated(OutData%Pres_BLThick)) deallocate(OutData%Pres_BLThick) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1739,7 +1608,6 @@ subroutine AA_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%Pres_BLThick) if (RegCheckErr(Buf, RoutineName)) return end if - ! Suct_BLThick if (allocated(OutData%Suct_BLThick)) deallocate(OutData%Suct_BLThick) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1754,7 +1622,6 @@ subroutine AA_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%Suct_BLThick) if (RegCheckErr(Buf, RoutineName)) return end if - ! Pres_Cf if (allocated(OutData%Pres_Cf)) deallocate(OutData%Pres_Cf) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1769,7 +1636,6 @@ subroutine AA_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%Pres_Cf) if (RegCheckErr(Buf, RoutineName)) return end if - ! Suct_Cf if (allocated(OutData%Suct_Cf)) deallocate(OutData%Suct_Cf) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1784,7 +1650,6 @@ subroutine AA_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%Suct_Cf) if (RegCheckErr(Buf, RoutineName)) return end if - ! Pres_EdgeVelRat if (allocated(OutData%Pres_EdgeVelRat)) deallocate(OutData%Pres_EdgeVelRat) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1799,7 +1664,6 @@ subroutine AA_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%Pres_EdgeVelRat) if (RegCheckErr(Buf, RoutineName)) return end if - ! Suct_EdgeVelRat if (allocated(OutData%Suct_EdgeVelRat)) deallocate(OutData%Suct_EdgeVelRat) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1814,7 +1678,6 @@ subroutine AA_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%Suct_EdgeVelRat) if (RegCheckErr(Buf, RoutineName)) return end if - ! TI_Grid_In if (allocated(OutData%TI_Grid_In)) deallocate(OutData%TI_Grid_In) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1829,52 +1692,38 @@ subroutine AA_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%TI_Grid_In) if (RegCheckErr(Buf, RoutineName)) return end if - ! dz_turb_in call RegUnpack(Buf, OutData%dz_turb_in) if (RegCheckErr(Buf, RoutineName)) return - ! dy_turb_in call RegUnpack(Buf, OutData%dy_turb_in) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE AA_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(AA_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%DummyContState = SrcContStateData%DummyContState - END SUBROUTINE AA_CopyContState - - SUBROUTINE AA_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(AA_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyContState' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE AA_DestroyContState +subroutine AA_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(AA_ContinuousStateType), intent(in) :: SrcContStateData + type(AA_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AA_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + DstContStateData%DummyContState = SrcContStateData%DummyContState +end subroutine +subroutine AA_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(AA_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AA_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine AA_PackContState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AA_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AA_PackContState' if (Buf%ErrStat >= AbortErrLev) return - ! DummyContState call RegPack(Buf, InData%DummyContState) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1884,312 +1733,284 @@ subroutine AA_UnPackContState(Buf, OutData) type(AA_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AA_UnPackContState' if (Buf%ErrStat /= ErrID_None) return - ! DummyContState call RegUnpack(Buf, OutData%DummyContState) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE AA_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(AA_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcDiscStateData%MeanVrel)) THEN - i1_l = LBOUND(SrcDiscStateData%MeanVrel,1) - i1_u = UBOUND(SrcDiscStateData%MeanVrel,1) - i2_l = LBOUND(SrcDiscStateData%MeanVrel,2) - i2_u = UBOUND(SrcDiscStateData%MeanVrel,2) - IF (.NOT. ALLOCATED(DstDiscStateData%MeanVrel)) THEN - ALLOCATE(DstDiscStateData%MeanVrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%MeanVrel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%MeanVrel = SrcDiscStateData%MeanVrel -ENDIF -IF (ALLOCATED(SrcDiscStateData%VrelSq)) THEN - i1_l = LBOUND(SrcDiscStateData%VrelSq,1) - i1_u = UBOUND(SrcDiscStateData%VrelSq,1) - i2_l = LBOUND(SrcDiscStateData%VrelSq,2) - i2_u = UBOUND(SrcDiscStateData%VrelSq,2) - IF (.NOT. ALLOCATED(DstDiscStateData%VrelSq)) THEN - ALLOCATE(DstDiscStateData%VrelSq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%VrelSq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%VrelSq = SrcDiscStateData%VrelSq -ENDIF -IF (ALLOCATED(SrcDiscStateData%TIVrel)) THEN - i1_l = LBOUND(SrcDiscStateData%TIVrel,1) - i1_u = UBOUND(SrcDiscStateData%TIVrel,1) - i2_l = LBOUND(SrcDiscStateData%TIVrel,2) - i2_u = UBOUND(SrcDiscStateData%TIVrel,2) - IF (.NOT. ALLOCATED(DstDiscStateData%TIVrel)) THEN - ALLOCATE(DstDiscStateData%TIVrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%TIVrel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%TIVrel = SrcDiscStateData%TIVrel -ENDIF -IF (ALLOCATED(SrcDiscStateData%VrelStore)) THEN - i1_l = LBOUND(SrcDiscStateData%VrelStore,1) - i1_u = UBOUND(SrcDiscStateData%VrelStore,1) - i2_l = LBOUND(SrcDiscStateData%VrelStore,2) - i2_u = UBOUND(SrcDiscStateData%VrelStore,2) - i3_l = LBOUND(SrcDiscStateData%VrelStore,3) - i3_u = UBOUND(SrcDiscStateData%VrelStore,3) - IF (.NOT. ALLOCATED(DstDiscStateData%VrelStore)) THEN - ALLOCATE(DstDiscStateData%VrelStore(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%VrelStore.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%VrelStore = SrcDiscStateData%VrelStore -ENDIF -IF (ALLOCATED(SrcDiscStateData%TIVx)) THEN - i1_l = LBOUND(SrcDiscStateData%TIVx,1) - i1_u = UBOUND(SrcDiscStateData%TIVx,1) - i2_l = LBOUND(SrcDiscStateData%TIVx,2) - i2_u = UBOUND(SrcDiscStateData%TIVx,2) - IF (.NOT. ALLOCATED(DstDiscStateData%TIVx)) THEN - ALLOCATE(DstDiscStateData%TIVx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%TIVx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%TIVx = SrcDiscStateData%TIVx -ENDIF -IF (ALLOCATED(SrcDiscStateData%MeanVxVyVz)) THEN - i1_l = LBOUND(SrcDiscStateData%MeanVxVyVz,1) - i1_u = UBOUND(SrcDiscStateData%MeanVxVyVz,1) - i2_l = LBOUND(SrcDiscStateData%MeanVxVyVz,2) - i2_u = UBOUND(SrcDiscStateData%MeanVxVyVz,2) - IF (.NOT. ALLOCATED(DstDiscStateData%MeanVxVyVz)) THEN - ALLOCATE(DstDiscStateData%MeanVxVyVz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%MeanVxVyVz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%MeanVxVyVz = SrcDiscStateData%MeanVxVyVz -ENDIF -IF (ALLOCATED(SrcDiscStateData%VxSq)) THEN - i1_l = LBOUND(SrcDiscStateData%VxSq,1) - i1_u = UBOUND(SrcDiscStateData%VxSq,1) - i2_l = LBOUND(SrcDiscStateData%VxSq,2) - i2_u = UBOUND(SrcDiscStateData%VxSq,2) - IF (.NOT. ALLOCATED(DstDiscStateData%VxSq)) THEN - ALLOCATE(DstDiscStateData%VxSq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%VxSq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%VxSq = SrcDiscStateData%VxSq -ENDIF -IF (ALLOCATED(SrcDiscStateData%allregcounter)) THEN - i1_l = LBOUND(SrcDiscStateData%allregcounter,1) - i1_u = UBOUND(SrcDiscStateData%allregcounter,1) - i2_l = LBOUND(SrcDiscStateData%allregcounter,2) - i2_u = UBOUND(SrcDiscStateData%allregcounter,2) - IF (.NOT. ALLOCATED(DstDiscStateData%allregcounter)) THEN - ALLOCATE(DstDiscStateData%allregcounter(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%allregcounter.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%allregcounter = SrcDiscStateData%allregcounter -ENDIF -IF (ALLOCATED(SrcDiscStateData%VxSqRegion)) THEN - i1_l = LBOUND(SrcDiscStateData%VxSqRegion,1) - i1_u = UBOUND(SrcDiscStateData%VxSqRegion,1) - i2_l = LBOUND(SrcDiscStateData%VxSqRegion,2) - i2_u = UBOUND(SrcDiscStateData%VxSqRegion,2) - IF (.NOT. ALLOCATED(DstDiscStateData%VxSqRegion)) THEN - ALLOCATE(DstDiscStateData%VxSqRegion(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%VxSqRegion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%VxSqRegion = SrcDiscStateData%VxSqRegion -ENDIF -IF (ALLOCATED(SrcDiscStateData%RegVxStor)) THEN - i1_l = LBOUND(SrcDiscStateData%RegVxStor,1) - i1_u = UBOUND(SrcDiscStateData%RegVxStor,1) - i2_l = LBOUND(SrcDiscStateData%RegVxStor,2) - i2_u = UBOUND(SrcDiscStateData%RegVxStor,2) - i3_l = LBOUND(SrcDiscStateData%RegVxStor,3) - i3_u = UBOUND(SrcDiscStateData%RegVxStor,3) - IF (.NOT. ALLOCATED(DstDiscStateData%RegVxStor)) THEN - ALLOCATE(DstDiscStateData%RegVxStor(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%RegVxStor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%RegVxStor = SrcDiscStateData%RegVxStor -ENDIF -IF (ALLOCATED(SrcDiscStateData%RegionTIDelete)) THEN - i1_l = LBOUND(SrcDiscStateData%RegionTIDelete,1) - i1_u = UBOUND(SrcDiscStateData%RegionTIDelete,1) - i2_l = LBOUND(SrcDiscStateData%RegionTIDelete,2) - i2_u = UBOUND(SrcDiscStateData%RegionTIDelete,2) - IF (.NOT. ALLOCATED(DstDiscStateData%RegionTIDelete)) THEN - ALLOCATE(DstDiscStateData%RegionTIDelete(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%RegionTIDelete.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%RegionTIDelete = SrcDiscStateData%RegionTIDelete -ENDIF - END SUBROUTINE AA_CopyDiscState - - SUBROUTINE AA_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(AA_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(DiscStateData%MeanVrel)) THEN - DEALLOCATE(DiscStateData%MeanVrel) -ENDIF -IF (ALLOCATED(DiscStateData%VrelSq)) THEN - DEALLOCATE(DiscStateData%VrelSq) -ENDIF -IF (ALLOCATED(DiscStateData%TIVrel)) THEN - DEALLOCATE(DiscStateData%TIVrel) -ENDIF -IF (ALLOCATED(DiscStateData%VrelStore)) THEN - DEALLOCATE(DiscStateData%VrelStore) -ENDIF -IF (ALLOCATED(DiscStateData%TIVx)) THEN - DEALLOCATE(DiscStateData%TIVx) -ENDIF -IF (ALLOCATED(DiscStateData%MeanVxVyVz)) THEN - DEALLOCATE(DiscStateData%MeanVxVyVz) -ENDIF -IF (ALLOCATED(DiscStateData%VxSq)) THEN - DEALLOCATE(DiscStateData%VxSq) -ENDIF -IF (ALLOCATED(DiscStateData%allregcounter)) THEN - DEALLOCATE(DiscStateData%allregcounter) -ENDIF -IF (ALLOCATED(DiscStateData%VxSqRegion)) THEN - DEALLOCATE(DiscStateData%VxSqRegion) -ENDIF -IF (ALLOCATED(DiscStateData%RegVxStor)) THEN - DEALLOCATE(DiscStateData%RegVxStor) -ENDIF -IF (ALLOCATED(DiscStateData%RegionTIDelete)) THEN - DEALLOCATE(DiscStateData%RegionTIDelete) -ENDIF - END SUBROUTINE AA_DestroyDiscState +subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(AA_DiscreteStateType), intent(in) :: SrcDiscStateData + type(AA_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AA_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcDiscStateData%MeanVrel)) then + LB(1:2) = lbound(SrcDiscStateData%MeanVrel) + UB(1:2) = ubound(SrcDiscStateData%MeanVrel) + if (.not. allocated(DstDiscStateData%MeanVrel)) then + allocate(DstDiscStateData%MeanVrel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%MeanVrel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%MeanVrel = SrcDiscStateData%MeanVrel + else if (allocated(DstDiscStateData%MeanVrel)) then + deallocate(DstDiscStateData%MeanVrel) + end if + if (allocated(SrcDiscStateData%VrelSq)) then + LB(1:2) = lbound(SrcDiscStateData%VrelSq) + UB(1:2) = ubound(SrcDiscStateData%VrelSq) + if (.not. allocated(DstDiscStateData%VrelSq)) then + allocate(DstDiscStateData%VrelSq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%VrelSq.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%VrelSq = SrcDiscStateData%VrelSq + else if (allocated(DstDiscStateData%VrelSq)) then + deallocate(DstDiscStateData%VrelSq) + end if + if (allocated(SrcDiscStateData%TIVrel)) then + LB(1:2) = lbound(SrcDiscStateData%TIVrel) + UB(1:2) = ubound(SrcDiscStateData%TIVrel) + if (.not. allocated(DstDiscStateData%TIVrel)) then + allocate(DstDiscStateData%TIVrel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%TIVrel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%TIVrel = SrcDiscStateData%TIVrel + else if (allocated(DstDiscStateData%TIVrel)) then + deallocate(DstDiscStateData%TIVrel) + end if + if (allocated(SrcDiscStateData%VrelStore)) then + LB(1:3) = lbound(SrcDiscStateData%VrelStore) + UB(1:3) = ubound(SrcDiscStateData%VrelStore) + if (.not. allocated(DstDiscStateData%VrelStore)) then + allocate(DstDiscStateData%VrelStore(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%VrelStore.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%VrelStore = SrcDiscStateData%VrelStore + else if (allocated(DstDiscStateData%VrelStore)) then + deallocate(DstDiscStateData%VrelStore) + end if + if (allocated(SrcDiscStateData%TIVx)) then + LB(1:2) = lbound(SrcDiscStateData%TIVx) + UB(1:2) = ubound(SrcDiscStateData%TIVx) + if (.not. allocated(DstDiscStateData%TIVx)) then + allocate(DstDiscStateData%TIVx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%TIVx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%TIVx = SrcDiscStateData%TIVx + else if (allocated(DstDiscStateData%TIVx)) then + deallocate(DstDiscStateData%TIVx) + end if + if (allocated(SrcDiscStateData%MeanVxVyVz)) then + LB(1:2) = lbound(SrcDiscStateData%MeanVxVyVz) + UB(1:2) = ubound(SrcDiscStateData%MeanVxVyVz) + if (.not. allocated(DstDiscStateData%MeanVxVyVz)) then + allocate(DstDiscStateData%MeanVxVyVz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%MeanVxVyVz.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%MeanVxVyVz = SrcDiscStateData%MeanVxVyVz + else if (allocated(DstDiscStateData%MeanVxVyVz)) then + deallocate(DstDiscStateData%MeanVxVyVz) + end if + if (allocated(SrcDiscStateData%VxSq)) then + LB(1:2) = lbound(SrcDiscStateData%VxSq) + UB(1:2) = ubound(SrcDiscStateData%VxSq) + if (.not. allocated(DstDiscStateData%VxSq)) then + allocate(DstDiscStateData%VxSq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%VxSq.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%VxSq = SrcDiscStateData%VxSq + else if (allocated(DstDiscStateData%VxSq)) then + deallocate(DstDiscStateData%VxSq) + end if + if (allocated(SrcDiscStateData%allregcounter)) then + LB(1:2) = lbound(SrcDiscStateData%allregcounter) + UB(1:2) = ubound(SrcDiscStateData%allregcounter) + if (.not. allocated(DstDiscStateData%allregcounter)) then + allocate(DstDiscStateData%allregcounter(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%allregcounter.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%allregcounter = SrcDiscStateData%allregcounter + else if (allocated(DstDiscStateData%allregcounter)) then + deallocate(DstDiscStateData%allregcounter) + end if + if (allocated(SrcDiscStateData%VxSqRegion)) then + LB(1:2) = lbound(SrcDiscStateData%VxSqRegion) + UB(1:2) = ubound(SrcDiscStateData%VxSqRegion) + if (.not. allocated(DstDiscStateData%VxSqRegion)) then + allocate(DstDiscStateData%VxSqRegion(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%VxSqRegion.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%VxSqRegion = SrcDiscStateData%VxSqRegion + else if (allocated(DstDiscStateData%VxSqRegion)) then + deallocate(DstDiscStateData%VxSqRegion) + end if + if (allocated(SrcDiscStateData%RegVxStor)) then + LB(1:3) = lbound(SrcDiscStateData%RegVxStor) + UB(1:3) = ubound(SrcDiscStateData%RegVxStor) + if (.not. allocated(DstDiscStateData%RegVxStor)) then + allocate(DstDiscStateData%RegVxStor(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%RegVxStor.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%RegVxStor = SrcDiscStateData%RegVxStor + else if (allocated(DstDiscStateData%RegVxStor)) then + deallocate(DstDiscStateData%RegVxStor) + end if + if (allocated(SrcDiscStateData%RegionTIDelete)) then + LB(1:2) = lbound(SrcDiscStateData%RegionTIDelete) + UB(1:2) = ubound(SrcDiscStateData%RegionTIDelete) + if (.not. allocated(DstDiscStateData%RegionTIDelete)) then + allocate(DstDiscStateData%RegionTIDelete(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%RegionTIDelete.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%RegionTIDelete = SrcDiscStateData%RegionTIDelete + else if (allocated(DstDiscStateData%RegionTIDelete)) then + deallocate(DstDiscStateData%RegionTIDelete) + end if +end subroutine +subroutine AA_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(AA_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AA_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(DiscStateData%MeanVrel)) then + deallocate(DiscStateData%MeanVrel) + end if + if (allocated(DiscStateData%VrelSq)) then + deallocate(DiscStateData%VrelSq) + end if + if (allocated(DiscStateData%TIVrel)) then + deallocate(DiscStateData%TIVrel) + end if + if (allocated(DiscStateData%VrelStore)) then + deallocate(DiscStateData%VrelStore) + end if + if (allocated(DiscStateData%TIVx)) then + deallocate(DiscStateData%TIVx) + end if + if (allocated(DiscStateData%MeanVxVyVz)) then + deallocate(DiscStateData%MeanVxVyVz) + end if + if (allocated(DiscStateData%VxSq)) then + deallocate(DiscStateData%VxSq) + end if + if (allocated(DiscStateData%allregcounter)) then + deallocate(DiscStateData%allregcounter) + end if + if (allocated(DiscStateData%VxSqRegion)) then + deallocate(DiscStateData%VxSqRegion) + end if + if (allocated(DiscStateData%RegVxStor)) then + deallocate(DiscStateData%RegVxStor) + end if + if (allocated(DiscStateData%RegionTIDelete)) then + deallocate(DiscStateData%RegionTIDelete) + end if +end subroutine subroutine AA_PackDiscState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AA_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AA_PackDiscState' if (Buf%ErrStat >= AbortErrLev) return - ! MeanVrel call RegPack(Buf, allocated(InData%MeanVrel)) if (allocated(InData%MeanVrel)) then call RegPackBounds(Buf, 2, lbound(InData%MeanVrel), ubound(InData%MeanVrel)) call RegPack(Buf, InData%MeanVrel) end if if (RegCheckErr(Buf, RoutineName)) return - ! VrelSq call RegPack(Buf, allocated(InData%VrelSq)) if (allocated(InData%VrelSq)) then call RegPackBounds(Buf, 2, lbound(InData%VrelSq), ubound(InData%VrelSq)) call RegPack(Buf, InData%VrelSq) end if if (RegCheckErr(Buf, RoutineName)) return - ! TIVrel call RegPack(Buf, allocated(InData%TIVrel)) if (allocated(InData%TIVrel)) then call RegPackBounds(Buf, 2, lbound(InData%TIVrel), ubound(InData%TIVrel)) call RegPack(Buf, InData%TIVrel) end if if (RegCheckErr(Buf, RoutineName)) return - ! VrelStore call RegPack(Buf, allocated(InData%VrelStore)) if (allocated(InData%VrelStore)) then call RegPackBounds(Buf, 3, lbound(InData%VrelStore), ubound(InData%VrelStore)) call RegPack(Buf, InData%VrelStore) end if if (RegCheckErr(Buf, RoutineName)) return - ! TIVx call RegPack(Buf, allocated(InData%TIVx)) if (allocated(InData%TIVx)) then call RegPackBounds(Buf, 2, lbound(InData%TIVx), ubound(InData%TIVx)) call RegPack(Buf, InData%TIVx) end if if (RegCheckErr(Buf, RoutineName)) return - ! MeanVxVyVz call RegPack(Buf, allocated(InData%MeanVxVyVz)) if (allocated(InData%MeanVxVyVz)) then call RegPackBounds(Buf, 2, lbound(InData%MeanVxVyVz), ubound(InData%MeanVxVyVz)) call RegPack(Buf, InData%MeanVxVyVz) end if if (RegCheckErr(Buf, RoutineName)) return - ! VxSq call RegPack(Buf, allocated(InData%VxSq)) if (allocated(InData%VxSq)) then call RegPackBounds(Buf, 2, lbound(InData%VxSq), ubound(InData%VxSq)) call RegPack(Buf, InData%VxSq) end if if (RegCheckErr(Buf, RoutineName)) return - ! allregcounter call RegPack(Buf, allocated(InData%allregcounter)) if (allocated(InData%allregcounter)) then call RegPackBounds(Buf, 2, lbound(InData%allregcounter), ubound(InData%allregcounter)) call RegPack(Buf, InData%allregcounter) end if if (RegCheckErr(Buf, RoutineName)) return - ! VxSqRegion call RegPack(Buf, allocated(InData%VxSqRegion)) if (allocated(InData%VxSqRegion)) then call RegPackBounds(Buf, 2, lbound(InData%VxSqRegion), ubound(InData%VxSqRegion)) call RegPack(Buf, InData%VxSqRegion) end if if (RegCheckErr(Buf, RoutineName)) return - ! RegVxStor call RegPack(Buf, allocated(InData%RegVxStor)) if (allocated(InData%RegVxStor)) then call RegPackBounds(Buf, 3, lbound(InData%RegVxStor), ubound(InData%RegVxStor)) call RegPack(Buf, InData%RegVxStor) end if if (RegCheckErr(Buf, RoutineName)) return - ! RegionTIDelete call RegPack(Buf, allocated(InData%RegionTIDelete)) if (allocated(InData%RegionTIDelete)) then call RegPackBounds(Buf, 2, lbound(InData%RegionTIDelete), ubound(InData%RegionTIDelete)) @@ -2206,7 +2027,6 @@ subroutine AA_UnPackDiscState(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! MeanVrel if (allocated(OutData%MeanVrel)) deallocate(OutData%MeanVrel) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2221,7 +2041,6 @@ subroutine AA_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%MeanVrel) if (RegCheckErr(Buf, RoutineName)) return end if - ! VrelSq if (allocated(OutData%VrelSq)) deallocate(OutData%VrelSq) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2236,7 +2055,6 @@ subroutine AA_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%VrelSq) if (RegCheckErr(Buf, RoutineName)) return end if - ! TIVrel if (allocated(OutData%TIVrel)) deallocate(OutData%TIVrel) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2251,7 +2069,6 @@ subroutine AA_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%TIVrel) if (RegCheckErr(Buf, RoutineName)) return end if - ! VrelStore if (allocated(OutData%VrelStore)) deallocate(OutData%VrelStore) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2266,7 +2083,6 @@ subroutine AA_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%VrelStore) if (RegCheckErr(Buf, RoutineName)) return end if - ! TIVx if (allocated(OutData%TIVx)) deallocate(OutData%TIVx) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2281,7 +2097,6 @@ subroutine AA_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%TIVx) if (RegCheckErr(Buf, RoutineName)) return end if - ! MeanVxVyVz if (allocated(OutData%MeanVxVyVz)) deallocate(OutData%MeanVxVyVz) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2296,7 +2111,6 @@ subroutine AA_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%MeanVxVyVz) if (RegCheckErr(Buf, RoutineName)) return end if - ! VxSq if (allocated(OutData%VxSq)) deallocate(OutData%VxSq) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2311,7 +2125,6 @@ subroutine AA_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%VxSq) if (RegCheckErr(Buf, RoutineName)) return end if - ! allregcounter if (allocated(OutData%allregcounter)) deallocate(OutData%allregcounter) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2326,7 +2139,6 @@ subroutine AA_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%allregcounter) if (RegCheckErr(Buf, RoutineName)) return end if - ! VxSqRegion if (allocated(OutData%VxSqRegion)) deallocate(OutData%VxSqRegion) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2341,7 +2153,6 @@ subroutine AA_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%VxSqRegion) if (RegCheckErr(Buf, RoutineName)) return end if - ! RegVxStor if (allocated(OutData%RegVxStor)) deallocate(OutData%RegVxStor) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2356,7 +2167,6 @@ subroutine AA_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%RegVxStor) if (RegCheckErr(Buf, RoutineName)) return end if - ! RegionTIDelete if (allocated(OutData%RegionTIDelete)) deallocate(OutData%RegionTIDelete) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2372,45 +2182,33 @@ subroutine AA_UnPackDiscState(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE AA_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(AA_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE AA_CopyConstrState - - SUBROUTINE AA_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(AA_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyConstrState' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE AA_DestroyConstrState +subroutine AA_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(AA_ConstraintStateType), intent(in) :: SrcConstrStateData + type(AA_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AA_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine +subroutine AA_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(AA_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AA_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine AA_PackConstrState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AA_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AA_PackConstrState' if (Buf%ErrStat >= AbortErrLev) return - ! DummyConstrState call RegPack(Buf, InData%DummyConstrState) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2420,49 +2218,36 @@ subroutine AA_UnPackConstrState(Buf, OutData) type(AA_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AA_UnPackConstrState' if (Buf%ErrStat /= ErrID_None) return - ! DummyConstrState call RegUnpack(Buf, OutData%DummyConstrState) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE AA_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(AA_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState - END SUBROUTINE AA_CopyOtherState - - SUBROUTINE AA_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(AA_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyOtherState' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE AA_DestroyOtherState +subroutine AA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(AA_OtherStateType), intent(in) :: SrcOtherStateData + type(AA_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AA_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState +end subroutine +subroutine AA_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(AA_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AA_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine AA_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AA_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AA_PackOtherState' if (Buf%ErrStat >= AbortErrLev) return - ! DummyOtherState call RegPack(Buf, InData%DummyOtherState) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2472,550 +2257,527 @@ subroutine AA_UnPackOtherState(Buf, OutData) type(AA_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AA_UnPackOtherState' if (Buf%ErrStat /= ErrID_None) return - ! DummyOtherState call RegUnpack(Buf, OutData%DummyOtherState) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE AA_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(AA_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscData%AllOuts)) THEN - i1_l = LBOUND(SrcMiscData%AllOuts,1) - i1_u = UBOUND(SrcMiscData%AllOuts,1) - IF (.NOT. ALLOCATED(DstMiscData%AllOuts)) THEN - ALLOCATE(DstMiscData%AllOuts(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%AllOuts = SrcMiscData%AllOuts -ENDIF -IF (ALLOCATED(SrcMiscData%ChordAngleTE)) THEN - i1_l = LBOUND(SrcMiscData%ChordAngleTE,1) - i1_u = UBOUND(SrcMiscData%ChordAngleTE,1) - i2_l = LBOUND(SrcMiscData%ChordAngleTE,2) - i2_u = UBOUND(SrcMiscData%ChordAngleTE,2) - i3_l = LBOUND(SrcMiscData%ChordAngleTE,3) - i3_u = UBOUND(SrcMiscData%ChordAngleTE,3) - IF (.NOT. ALLOCATED(DstMiscData%ChordAngleTE)) THEN - ALLOCATE(DstMiscData%ChordAngleTE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ChordAngleTE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%ChordAngleTE = SrcMiscData%ChordAngleTE -ENDIF -IF (ALLOCATED(SrcMiscData%SpanAngleTE)) THEN - i1_l = LBOUND(SrcMiscData%SpanAngleTE,1) - i1_u = UBOUND(SrcMiscData%SpanAngleTE,1) - i2_l = LBOUND(SrcMiscData%SpanAngleTE,2) - i2_u = UBOUND(SrcMiscData%SpanAngleTE,2) - i3_l = LBOUND(SrcMiscData%SpanAngleTE,3) - i3_u = UBOUND(SrcMiscData%SpanAngleTE,3) - IF (.NOT. ALLOCATED(DstMiscData%SpanAngleTE)) THEN - ALLOCATE(DstMiscData%SpanAngleTE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SpanAngleTE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SpanAngleTE = SrcMiscData%SpanAngleTE -ENDIF -IF (ALLOCATED(SrcMiscData%ChordAngleLE)) THEN - i1_l = LBOUND(SrcMiscData%ChordAngleLE,1) - i1_u = UBOUND(SrcMiscData%ChordAngleLE,1) - i2_l = LBOUND(SrcMiscData%ChordAngleLE,2) - i2_u = UBOUND(SrcMiscData%ChordAngleLE,2) - i3_l = LBOUND(SrcMiscData%ChordAngleLE,3) - i3_u = UBOUND(SrcMiscData%ChordAngleLE,3) - IF (.NOT. ALLOCATED(DstMiscData%ChordAngleLE)) THEN - ALLOCATE(DstMiscData%ChordAngleLE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ChordAngleLE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%ChordAngleLE = SrcMiscData%ChordAngleLE -ENDIF -IF (ALLOCATED(SrcMiscData%SpanAngleLE)) THEN - i1_l = LBOUND(SrcMiscData%SpanAngleLE,1) - i1_u = UBOUND(SrcMiscData%SpanAngleLE,1) - i2_l = LBOUND(SrcMiscData%SpanAngleLE,2) - i2_u = UBOUND(SrcMiscData%SpanAngleLE,2) - i3_l = LBOUND(SrcMiscData%SpanAngleLE,3) - i3_u = UBOUND(SrcMiscData%SpanAngleLE,3) - IF (.NOT. ALLOCATED(DstMiscData%SpanAngleLE)) THEN - ALLOCATE(DstMiscData%SpanAngleLE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SpanAngleLE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SpanAngleLE = SrcMiscData%SpanAngleLE -ENDIF -IF (ALLOCATED(SrcMiscData%rTEtoObserve)) THEN - i1_l = LBOUND(SrcMiscData%rTEtoObserve,1) - i1_u = UBOUND(SrcMiscData%rTEtoObserve,1) - i2_l = LBOUND(SrcMiscData%rTEtoObserve,2) - i2_u = UBOUND(SrcMiscData%rTEtoObserve,2) - i3_l = LBOUND(SrcMiscData%rTEtoObserve,3) - i3_u = UBOUND(SrcMiscData%rTEtoObserve,3) - IF (.NOT. ALLOCATED(DstMiscData%rTEtoObserve)) THEN - ALLOCATE(DstMiscData%rTEtoObserve(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rTEtoObserve.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%rTEtoObserve = SrcMiscData%rTEtoObserve -ENDIF -IF (ALLOCATED(SrcMiscData%rLEtoObserve)) THEN - i1_l = LBOUND(SrcMiscData%rLEtoObserve,1) - i1_u = UBOUND(SrcMiscData%rLEtoObserve,1) - i2_l = LBOUND(SrcMiscData%rLEtoObserve,2) - i2_u = UBOUND(SrcMiscData%rLEtoObserve,2) - i3_l = LBOUND(SrcMiscData%rLEtoObserve,3) - i3_u = UBOUND(SrcMiscData%rLEtoObserve,3) - IF (.NOT. ALLOCATED(DstMiscData%rLEtoObserve)) THEN - ALLOCATE(DstMiscData%rLEtoObserve(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rLEtoObserve.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%rLEtoObserve = SrcMiscData%rLEtoObserve -ENDIF -IF (ALLOCATED(SrcMiscData%LE_Location)) THEN - i1_l = LBOUND(SrcMiscData%LE_Location,1) - i1_u = UBOUND(SrcMiscData%LE_Location,1) - i2_l = LBOUND(SrcMiscData%LE_Location,2) - i2_u = UBOUND(SrcMiscData%LE_Location,2) - i3_l = LBOUND(SrcMiscData%LE_Location,3) - i3_u = UBOUND(SrcMiscData%LE_Location,3) - IF (.NOT. ALLOCATED(DstMiscData%LE_Location)) THEN - ALLOCATE(DstMiscData%LE_Location(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LE_Location.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%LE_Location = SrcMiscData%LE_Location -ENDIF - DstMiscData%RotSpeedAoA = SrcMiscData%RotSpeedAoA -IF (ALLOCATED(SrcMiscData%SPLLBL)) THEN - i1_l = LBOUND(SrcMiscData%SPLLBL,1) - i1_u = UBOUND(SrcMiscData%SPLLBL,1) - IF (.NOT. ALLOCATED(DstMiscData%SPLLBL)) THEN - ALLOCATE(DstMiscData%SPLLBL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLLBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SPLLBL = SrcMiscData%SPLLBL -ENDIF -IF (ALLOCATED(SrcMiscData%SPLP)) THEN - i1_l = LBOUND(SrcMiscData%SPLP,1) - i1_u = UBOUND(SrcMiscData%SPLP,1) - IF (.NOT. ALLOCATED(DstMiscData%SPLP)) THEN - ALLOCATE(DstMiscData%SPLP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SPLP = SrcMiscData%SPLP -ENDIF -IF (ALLOCATED(SrcMiscData%SPLS)) THEN - i1_l = LBOUND(SrcMiscData%SPLS,1) - i1_u = UBOUND(SrcMiscData%SPLS,1) - IF (.NOT. ALLOCATED(DstMiscData%SPLS)) THEN - ALLOCATE(DstMiscData%SPLS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SPLS = SrcMiscData%SPLS -ENDIF -IF (ALLOCATED(SrcMiscData%SPLALPH)) THEN - i1_l = LBOUND(SrcMiscData%SPLALPH,1) - i1_u = UBOUND(SrcMiscData%SPLALPH,1) - IF (.NOT. ALLOCATED(DstMiscData%SPLALPH)) THEN - ALLOCATE(DstMiscData%SPLALPH(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLALPH.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SPLALPH = SrcMiscData%SPLALPH -ENDIF -IF (ALLOCATED(SrcMiscData%SPLTBL)) THEN - i1_l = LBOUND(SrcMiscData%SPLTBL,1) - i1_u = UBOUND(SrcMiscData%SPLTBL,1) - IF (.NOT. ALLOCATED(DstMiscData%SPLTBL)) THEN - ALLOCATE(DstMiscData%SPLTBL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLTBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SPLTBL = SrcMiscData%SPLTBL -ENDIF -IF (ALLOCATED(SrcMiscData%SPLTIP)) THEN - i1_l = LBOUND(SrcMiscData%SPLTIP,1) - i1_u = UBOUND(SrcMiscData%SPLTIP,1) - IF (.NOT. ALLOCATED(DstMiscData%SPLTIP)) THEN - ALLOCATE(DstMiscData%SPLTIP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLTIP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SPLTIP = SrcMiscData%SPLTIP -ENDIF -IF (ALLOCATED(SrcMiscData%SPLTI)) THEN - i1_l = LBOUND(SrcMiscData%SPLTI,1) - i1_u = UBOUND(SrcMiscData%SPLTI,1) - IF (.NOT. ALLOCATED(DstMiscData%SPLTI)) THEN - ALLOCATE(DstMiscData%SPLTI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLTI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SPLTI = SrcMiscData%SPLTI -ENDIF -IF (ALLOCATED(SrcMiscData%SPLTIGui)) THEN - i1_l = LBOUND(SrcMiscData%SPLTIGui,1) - i1_u = UBOUND(SrcMiscData%SPLTIGui,1) - IF (.NOT. ALLOCATED(DstMiscData%SPLTIGui)) THEN - ALLOCATE(DstMiscData%SPLTIGui(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLTIGui.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SPLTIGui = SrcMiscData%SPLTIGui -ENDIF -IF (ALLOCATED(SrcMiscData%SPLBLUNT)) THEN - i1_l = LBOUND(SrcMiscData%SPLBLUNT,1) - i1_u = UBOUND(SrcMiscData%SPLBLUNT,1) - IF (.NOT. ALLOCATED(DstMiscData%SPLBLUNT)) THEN - ALLOCATE(DstMiscData%SPLBLUNT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLBLUNT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SPLBLUNT = SrcMiscData%SPLBLUNT -ENDIF -IF (ALLOCATED(SrcMiscData%CfVar)) THEN - i1_l = LBOUND(SrcMiscData%CfVar,1) - i1_u = UBOUND(SrcMiscData%CfVar,1) - IF (.NOT. ALLOCATED(DstMiscData%CfVar)) THEN - ALLOCATE(DstMiscData%CfVar(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CfVar.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%CfVar = SrcMiscData%CfVar -ENDIF -IF (ALLOCATED(SrcMiscData%d99Var)) THEN - i1_l = LBOUND(SrcMiscData%d99Var,1) - i1_u = UBOUND(SrcMiscData%d99Var,1) - IF (.NOT. ALLOCATED(DstMiscData%d99Var)) THEN - ALLOCATE(DstMiscData%d99Var(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%d99Var.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%d99Var = SrcMiscData%d99Var -ENDIF -IF (ALLOCATED(SrcMiscData%dStarVar)) THEN - i1_l = LBOUND(SrcMiscData%dStarVar,1) - i1_u = UBOUND(SrcMiscData%dStarVar,1) - IF (.NOT. ALLOCATED(DstMiscData%dStarVar)) THEN - ALLOCATE(DstMiscData%dStarVar(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dStarVar.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%dStarVar = SrcMiscData%dStarVar -ENDIF -IF (ALLOCATED(SrcMiscData%EdgeVelVar)) THEN - i1_l = LBOUND(SrcMiscData%EdgeVelVar,1) - i1_u = UBOUND(SrcMiscData%EdgeVelVar,1) - IF (.NOT. ALLOCATED(DstMiscData%EdgeVelVar)) THEN - ALLOCATE(DstMiscData%EdgeVelVar(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%EdgeVelVar.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%EdgeVelVar = SrcMiscData%EdgeVelVar -ENDIF - DstMiscData%speccou = SrcMiscData%speccou - DstMiscData%filesopen = SrcMiscData%filesopen - END SUBROUTINE AA_CopyMisc - - SUBROUTINE AA_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(AA_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(MiscData%AllOuts)) THEN - DEALLOCATE(MiscData%AllOuts) -ENDIF -IF (ALLOCATED(MiscData%ChordAngleTE)) THEN - DEALLOCATE(MiscData%ChordAngleTE) -ENDIF -IF (ALLOCATED(MiscData%SpanAngleTE)) THEN - DEALLOCATE(MiscData%SpanAngleTE) -ENDIF -IF (ALLOCATED(MiscData%ChordAngleLE)) THEN - DEALLOCATE(MiscData%ChordAngleLE) -ENDIF -IF (ALLOCATED(MiscData%SpanAngleLE)) THEN - DEALLOCATE(MiscData%SpanAngleLE) -ENDIF -IF (ALLOCATED(MiscData%rTEtoObserve)) THEN - DEALLOCATE(MiscData%rTEtoObserve) -ENDIF -IF (ALLOCATED(MiscData%rLEtoObserve)) THEN - DEALLOCATE(MiscData%rLEtoObserve) -ENDIF -IF (ALLOCATED(MiscData%LE_Location)) THEN - DEALLOCATE(MiscData%LE_Location) -ENDIF -IF (ALLOCATED(MiscData%SPLLBL)) THEN - DEALLOCATE(MiscData%SPLLBL) -ENDIF -IF (ALLOCATED(MiscData%SPLP)) THEN - DEALLOCATE(MiscData%SPLP) -ENDIF -IF (ALLOCATED(MiscData%SPLS)) THEN - DEALLOCATE(MiscData%SPLS) -ENDIF -IF (ALLOCATED(MiscData%SPLALPH)) THEN - DEALLOCATE(MiscData%SPLALPH) -ENDIF -IF (ALLOCATED(MiscData%SPLTBL)) THEN - DEALLOCATE(MiscData%SPLTBL) -ENDIF -IF (ALLOCATED(MiscData%SPLTIP)) THEN - DEALLOCATE(MiscData%SPLTIP) -ENDIF -IF (ALLOCATED(MiscData%SPLTI)) THEN - DEALLOCATE(MiscData%SPLTI) -ENDIF -IF (ALLOCATED(MiscData%SPLTIGui)) THEN - DEALLOCATE(MiscData%SPLTIGui) -ENDIF -IF (ALLOCATED(MiscData%SPLBLUNT)) THEN - DEALLOCATE(MiscData%SPLBLUNT) -ENDIF -IF (ALLOCATED(MiscData%CfVar)) THEN - DEALLOCATE(MiscData%CfVar) -ENDIF -IF (ALLOCATED(MiscData%d99Var)) THEN - DEALLOCATE(MiscData%d99Var) -ENDIF -IF (ALLOCATED(MiscData%dStarVar)) THEN - DEALLOCATE(MiscData%dStarVar) -ENDIF -IF (ALLOCATED(MiscData%EdgeVelVar)) THEN - DEALLOCATE(MiscData%EdgeVelVar) -ENDIF - END SUBROUTINE AA_DestroyMisc +subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(AA_MiscVarType), intent(in) :: SrcMiscData + type(AA_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AA_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMiscData%AllOuts)) then + LB(1:1) = lbound(SrcMiscData%AllOuts) + UB(1:1) = ubound(SrcMiscData%AllOuts) + if (.not. allocated(DstMiscData%AllOuts)) then + allocate(DstMiscData%AllOuts(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%AllOuts = SrcMiscData%AllOuts + else if (allocated(DstMiscData%AllOuts)) then + deallocate(DstMiscData%AllOuts) + end if + if (allocated(SrcMiscData%ChordAngleTE)) then + LB(1:3) = lbound(SrcMiscData%ChordAngleTE) + UB(1:3) = ubound(SrcMiscData%ChordAngleTE) + if (.not. allocated(DstMiscData%ChordAngleTE)) then + allocate(DstMiscData%ChordAngleTE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ChordAngleTE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%ChordAngleTE = SrcMiscData%ChordAngleTE + else if (allocated(DstMiscData%ChordAngleTE)) then + deallocate(DstMiscData%ChordAngleTE) + end if + if (allocated(SrcMiscData%SpanAngleTE)) then + LB(1:3) = lbound(SrcMiscData%SpanAngleTE) + UB(1:3) = ubound(SrcMiscData%SpanAngleTE) + if (.not. allocated(DstMiscData%SpanAngleTE)) then + allocate(DstMiscData%SpanAngleTE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SpanAngleTE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%SpanAngleTE = SrcMiscData%SpanAngleTE + else if (allocated(DstMiscData%SpanAngleTE)) then + deallocate(DstMiscData%SpanAngleTE) + end if + if (allocated(SrcMiscData%ChordAngleLE)) then + LB(1:3) = lbound(SrcMiscData%ChordAngleLE) + UB(1:3) = ubound(SrcMiscData%ChordAngleLE) + if (.not. allocated(DstMiscData%ChordAngleLE)) then + allocate(DstMiscData%ChordAngleLE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ChordAngleLE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%ChordAngleLE = SrcMiscData%ChordAngleLE + else if (allocated(DstMiscData%ChordAngleLE)) then + deallocate(DstMiscData%ChordAngleLE) + end if + if (allocated(SrcMiscData%SpanAngleLE)) then + LB(1:3) = lbound(SrcMiscData%SpanAngleLE) + UB(1:3) = ubound(SrcMiscData%SpanAngleLE) + if (.not. allocated(DstMiscData%SpanAngleLE)) then + allocate(DstMiscData%SpanAngleLE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SpanAngleLE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%SpanAngleLE = SrcMiscData%SpanAngleLE + else if (allocated(DstMiscData%SpanAngleLE)) then + deallocate(DstMiscData%SpanAngleLE) + end if + if (allocated(SrcMiscData%rTEtoObserve)) then + LB(1:3) = lbound(SrcMiscData%rTEtoObserve) + UB(1:3) = ubound(SrcMiscData%rTEtoObserve) + if (.not. allocated(DstMiscData%rTEtoObserve)) then + allocate(DstMiscData%rTEtoObserve(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rTEtoObserve.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%rTEtoObserve = SrcMiscData%rTEtoObserve + else if (allocated(DstMiscData%rTEtoObserve)) then + deallocate(DstMiscData%rTEtoObserve) + end if + if (allocated(SrcMiscData%rLEtoObserve)) then + LB(1:3) = lbound(SrcMiscData%rLEtoObserve) + UB(1:3) = ubound(SrcMiscData%rLEtoObserve) + if (.not. allocated(DstMiscData%rLEtoObserve)) then + allocate(DstMiscData%rLEtoObserve(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rLEtoObserve.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%rLEtoObserve = SrcMiscData%rLEtoObserve + else if (allocated(DstMiscData%rLEtoObserve)) then + deallocate(DstMiscData%rLEtoObserve) + end if + if (allocated(SrcMiscData%LE_Location)) then + LB(1:3) = lbound(SrcMiscData%LE_Location) + UB(1:3) = ubound(SrcMiscData%LE_Location) + if (.not. allocated(DstMiscData%LE_Location)) then + allocate(DstMiscData%LE_Location(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LE_Location.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%LE_Location = SrcMiscData%LE_Location + else if (allocated(DstMiscData%LE_Location)) then + deallocate(DstMiscData%LE_Location) + end if + DstMiscData%RotSpeedAoA = SrcMiscData%RotSpeedAoA + if (allocated(SrcMiscData%SPLLBL)) then + LB(1:1) = lbound(SrcMiscData%SPLLBL) + UB(1:1) = ubound(SrcMiscData%SPLLBL) + if (.not. allocated(DstMiscData%SPLLBL)) then + allocate(DstMiscData%SPLLBL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLLBL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%SPLLBL = SrcMiscData%SPLLBL + else if (allocated(DstMiscData%SPLLBL)) then + deallocate(DstMiscData%SPLLBL) + end if + if (allocated(SrcMiscData%SPLP)) then + LB(1:1) = lbound(SrcMiscData%SPLP) + UB(1:1) = ubound(SrcMiscData%SPLP) + if (.not. allocated(DstMiscData%SPLP)) then + allocate(DstMiscData%SPLP(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%SPLP = SrcMiscData%SPLP + else if (allocated(DstMiscData%SPLP)) then + deallocate(DstMiscData%SPLP) + end if + if (allocated(SrcMiscData%SPLS)) then + LB(1:1) = lbound(SrcMiscData%SPLS) + UB(1:1) = ubound(SrcMiscData%SPLS) + if (.not. allocated(DstMiscData%SPLS)) then + allocate(DstMiscData%SPLS(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%SPLS = SrcMiscData%SPLS + else if (allocated(DstMiscData%SPLS)) then + deallocate(DstMiscData%SPLS) + end if + if (allocated(SrcMiscData%SPLALPH)) then + LB(1:1) = lbound(SrcMiscData%SPLALPH) + UB(1:1) = ubound(SrcMiscData%SPLALPH) + if (.not. allocated(DstMiscData%SPLALPH)) then + allocate(DstMiscData%SPLALPH(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLALPH.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%SPLALPH = SrcMiscData%SPLALPH + else if (allocated(DstMiscData%SPLALPH)) then + deallocate(DstMiscData%SPLALPH) + end if + if (allocated(SrcMiscData%SPLTBL)) then + LB(1:1) = lbound(SrcMiscData%SPLTBL) + UB(1:1) = ubound(SrcMiscData%SPLTBL) + if (.not. allocated(DstMiscData%SPLTBL)) then + allocate(DstMiscData%SPLTBL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLTBL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%SPLTBL = SrcMiscData%SPLTBL + else if (allocated(DstMiscData%SPLTBL)) then + deallocate(DstMiscData%SPLTBL) + end if + if (allocated(SrcMiscData%SPLTIP)) then + LB(1:1) = lbound(SrcMiscData%SPLTIP) + UB(1:1) = ubound(SrcMiscData%SPLTIP) + if (.not. allocated(DstMiscData%SPLTIP)) then + allocate(DstMiscData%SPLTIP(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLTIP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%SPLTIP = SrcMiscData%SPLTIP + else if (allocated(DstMiscData%SPLTIP)) then + deallocate(DstMiscData%SPLTIP) + end if + if (allocated(SrcMiscData%SPLTI)) then + LB(1:1) = lbound(SrcMiscData%SPLTI) + UB(1:1) = ubound(SrcMiscData%SPLTI) + if (.not. allocated(DstMiscData%SPLTI)) then + allocate(DstMiscData%SPLTI(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLTI.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%SPLTI = SrcMiscData%SPLTI + else if (allocated(DstMiscData%SPLTI)) then + deallocate(DstMiscData%SPLTI) + end if + if (allocated(SrcMiscData%SPLTIGui)) then + LB(1:1) = lbound(SrcMiscData%SPLTIGui) + UB(1:1) = ubound(SrcMiscData%SPLTIGui) + if (.not. allocated(DstMiscData%SPLTIGui)) then + allocate(DstMiscData%SPLTIGui(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLTIGui.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%SPLTIGui = SrcMiscData%SPLTIGui + else if (allocated(DstMiscData%SPLTIGui)) then + deallocate(DstMiscData%SPLTIGui) + end if + if (allocated(SrcMiscData%SPLBLUNT)) then + LB(1:1) = lbound(SrcMiscData%SPLBLUNT) + UB(1:1) = ubound(SrcMiscData%SPLBLUNT) + if (.not. allocated(DstMiscData%SPLBLUNT)) then + allocate(DstMiscData%SPLBLUNT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLBLUNT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%SPLBLUNT = SrcMiscData%SPLBLUNT + else if (allocated(DstMiscData%SPLBLUNT)) then + deallocate(DstMiscData%SPLBLUNT) + end if + if (allocated(SrcMiscData%CfVar)) then + LB(1:1) = lbound(SrcMiscData%CfVar) + UB(1:1) = ubound(SrcMiscData%CfVar) + if (.not. allocated(DstMiscData%CfVar)) then + allocate(DstMiscData%CfVar(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CfVar.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%CfVar = SrcMiscData%CfVar + else if (allocated(DstMiscData%CfVar)) then + deallocate(DstMiscData%CfVar) + end if + if (allocated(SrcMiscData%d99Var)) then + LB(1:1) = lbound(SrcMiscData%d99Var) + UB(1:1) = ubound(SrcMiscData%d99Var) + if (.not. allocated(DstMiscData%d99Var)) then + allocate(DstMiscData%d99Var(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%d99Var.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%d99Var = SrcMiscData%d99Var + else if (allocated(DstMiscData%d99Var)) then + deallocate(DstMiscData%d99Var) + end if + if (allocated(SrcMiscData%dStarVar)) then + LB(1:1) = lbound(SrcMiscData%dStarVar) + UB(1:1) = ubound(SrcMiscData%dStarVar) + if (.not. allocated(DstMiscData%dStarVar)) then + allocate(DstMiscData%dStarVar(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dStarVar.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%dStarVar = SrcMiscData%dStarVar + else if (allocated(DstMiscData%dStarVar)) then + deallocate(DstMiscData%dStarVar) + end if + if (allocated(SrcMiscData%EdgeVelVar)) then + LB(1:1) = lbound(SrcMiscData%EdgeVelVar) + UB(1:1) = ubound(SrcMiscData%EdgeVelVar) + if (.not. allocated(DstMiscData%EdgeVelVar)) then + allocate(DstMiscData%EdgeVelVar(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%EdgeVelVar.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%EdgeVelVar = SrcMiscData%EdgeVelVar + else if (allocated(DstMiscData%EdgeVelVar)) then + deallocate(DstMiscData%EdgeVelVar) + end if + DstMiscData%speccou = SrcMiscData%speccou + DstMiscData%filesopen = SrcMiscData%filesopen +end subroutine +subroutine AA_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(AA_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AA_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%AllOuts)) then + deallocate(MiscData%AllOuts) + end if + if (allocated(MiscData%ChordAngleTE)) then + deallocate(MiscData%ChordAngleTE) + end if + if (allocated(MiscData%SpanAngleTE)) then + deallocate(MiscData%SpanAngleTE) + end if + if (allocated(MiscData%ChordAngleLE)) then + deallocate(MiscData%ChordAngleLE) + end if + if (allocated(MiscData%SpanAngleLE)) then + deallocate(MiscData%SpanAngleLE) + end if + if (allocated(MiscData%rTEtoObserve)) then + deallocate(MiscData%rTEtoObserve) + end if + if (allocated(MiscData%rLEtoObserve)) then + deallocate(MiscData%rLEtoObserve) + end if + if (allocated(MiscData%LE_Location)) then + deallocate(MiscData%LE_Location) + end if + if (allocated(MiscData%SPLLBL)) then + deallocate(MiscData%SPLLBL) + end if + if (allocated(MiscData%SPLP)) then + deallocate(MiscData%SPLP) + end if + if (allocated(MiscData%SPLS)) then + deallocate(MiscData%SPLS) + end if + if (allocated(MiscData%SPLALPH)) then + deallocate(MiscData%SPLALPH) + end if + if (allocated(MiscData%SPLTBL)) then + deallocate(MiscData%SPLTBL) + end if + if (allocated(MiscData%SPLTIP)) then + deallocate(MiscData%SPLTIP) + end if + if (allocated(MiscData%SPLTI)) then + deallocate(MiscData%SPLTI) + end if + if (allocated(MiscData%SPLTIGui)) then + deallocate(MiscData%SPLTIGui) + end if + if (allocated(MiscData%SPLBLUNT)) then + deallocate(MiscData%SPLBLUNT) + end if + if (allocated(MiscData%CfVar)) then + deallocate(MiscData%CfVar) + end if + if (allocated(MiscData%d99Var)) then + deallocate(MiscData%d99Var) + end if + if (allocated(MiscData%dStarVar)) then + deallocate(MiscData%dStarVar) + end if + if (allocated(MiscData%EdgeVelVar)) then + deallocate(MiscData%EdgeVelVar) + end if +end subroutine subroutine AA_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AA_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'AA_PackMisc' if (Buf%ErrStat >= AbortErrLev) return - ! AllOuts call RegPack(Buf, allocated(InData%AllOuts)) if (allocated(InData%AllOuts)) then call RegPackBounds(Buf, 1, lbound(InData%AllOuts), ubound(InData%AllOuts)) call RegPack(Buf, InData%AllOuts) end if if (RegCheckErr(Buf, RoutineName)) return - ! ChordAngleTE call RegPack(Buf, allocated(InData%ChordAngleTE)) if (allocated(InData%ChordAngleTE)) then call RegPackBounds(Buf, 3, lbound(InData%ChordAngleTE), ubound(InData%ChordAngleTE)) call RegPack(Buf, InData%ChordAngleTE) end if if (RegCheckErr(Buf, RoutineName)) return - ! SpanAngleTE call RegPack(Buf, allocated(InData%SpanAngleTE)) if (allocated(InData%SpanAngleTE)) then call RegPackBounds(Buf, 3, lbound(InData%SpanAngleTE), ubound(InData%SpanAngleTE)) call RegPack(Buf, InData%SpanAngleTE) end if if (RegCheckErr(Buf, RoutineName)) return - ! ChordAngleLE call RegPack(Buf, allocated(InData%ChordAngleLE)) if (allocated(InData%ChordAngleLE)) then call RegPackBounds(Buf, 3, lbound(InData%ChordAngleLE), ubound(InData%ChordAngleLE)) call RegPack(Buf, InData%ChordAngleLE) end if if (RegCheckErr(Buf, RoutineName)) return - ! SpanAngleLE call RegPack(Buf, allocated(InData%SpanAngleLE)) if (allocated(InData%SpanAngleLE)) then call RegPackBounds(Buf, 3, lbound(InData%SpanAngleLE), ubound(InData%SpanAngleLE)) call RegPack(Buf, InData%SpanAngleLE) end if if (RegCheckErr(Buf, RoutineName)) return - ! rTEtoObserve call RegPack(Buf, allocated(InData%rTEtoObserve)) if (allocated(InData%rTEtoObserve)) then call RegPackBounds(Buf, 3, lbound(InData%rTEtoObserve), ubound(InData%rTEtoObserve)) call RegPack(Buf, InData%rTEtoObserve) end if if (RegCheckErr(Buf, RoutineName)) return - ! rLEtoObserve call RegPack(Buf, allocated(InData%rLEtoObserve)) if (allocated(InData%rLEtoObserve)) then call RegPackBounds(Buf, 3, lbound(InData%rLEtoObserve), ubound(InData%rLEtoObserve)) call RegPack(Buf, InData%rLEtoObserve) end if if (RegCheckErr(Buf, RoutineName)) return - ! LE_Location call RegPack(Buf, allocated(InData%LE_Location)) if (allocated(InData%LE_Location)) then call RegPackBounds(Buf, 3, lbound(InData%LE_Location), ubound(InData%LE_Location)) call RegPack(Buf, InData%LE_Location) end if if (RegCheckErr(Buf, RoutineName)) return - ! RotSpeedAoA call RegPack(Buf, InData%RotSpeedAoA) if (RegCheckErr(Buf, RoutineName)) return - ! SPLLBL call RegPack(Buf, allocated(InData%SPLLBL)) if (allocated(InData%SPLLBL)) then call RegPackBounds(Buf, 1, lbound(InData%SPLLBL), ubound(InData%SPLLBL)) call RegPack(Buf, InData%SPLLBL) end if if (RegCheckErr(Buf, RoutineName)) return - ! SPLP call RegPack(Buf, allocated(InData%SPLP)) if (allocated(InData%SPLP)) then call RegPackBounds(Buf, 1, lbound(InData%SPLP), ubound(InData%SPLP)) call RegPack(Buf, InData%SPLP) end if if (RegCheckErr(Buf, RoutineName)) return - ! SPLS call RegPack(Buf, allocated(InData%SPLS)) if (allocated(InData%SPLS)) then call RegPackBounds(Buf, 1, lbound(InData%SPLS), ubound(InData%SPLS)) call RegPack(Buf, InData%SPLS) end if if (RegCheckErr(Buf, RoutineName)) return - ! SPLALPH call RegPack(Buf, allocated(InData%SPLALPH)) if (allocated(InData%SPLALPH)) then call RegPackBounds(Buf, 1, lbound(InData%SPLALPH), ubound(InData%SPLALPH)) call RegPack(Buf, InData%SPLALPH) end if if (RegCheckErr(Buf, RoutineName)) return - ! SPLTBL call RegPack(Buf, allocated(InData%SPLTBL)) if (allocated(InData%SPLTBL)) then call RegPackBounds(Buf, 1, lbound(InData%SPLTBL), ubound(InData%SPLTBL)) call RegPack(Buf, InData%SPLTBL) end if if (RegCheckErr(Buf, RoutineName)) return - ! SPLTIP call RegPack(Buf, allocated(InData%SPLTIP)) if (allocated(InData%SPLTIP)) then call RegPackBounds(Buf, 1, lbound(InData%SPLTIP), ubound(InData%SPLTIP)) call RegPack(Buf, InData%SPLTIP) end if if (RegCheckErr(Buf, RoutineName)) return - ! SPLTI call RegPack(Buf, allocated(InData%SPLTI)) if (allocated(InData%SPLTI)) then call RegPackBounds(Buf, 1, lbound(InData%SPLTI), ubound(InData%SPLTI)) call RegPack(Buf, InData%SPLTI) end if if (RegCheckErr(Buf, RoutineName)) return - ! SPLTIGui call RegPack(Buf, allocated(InData%SPLTIGui)) if (allocated(InData%SPLTIGui)) then call RegPackBounds(Buf, 1, lbound(InData%SPLTIGui), ubound(InData%SPLTIGui)) call RegPack(Buf, InData%SPLTIGui) end if if (RegCheckErr(Buf, RoutineName)) return - ! SPLBLUNT call RegPack(Buf, allocated(InData%SPLBLUNT)) if (allocated(InData%SPLBLUNT)) then call RegPackBounds(Buf, 1, lbound(InData%SPLBLUNT), ubound(InData%SPLBLUNT)) call RegPack(Buf, InData%SPLBLUNT) end if if (RegCheckErr(Buf, RoutineName)) return - ! CfVar call RegPack(Buf, allocated(InData%CfVar)) if (allocated(InData%CfVar)) then call RegPackBounds(Buf, 1, lbound(InData%CfVar), ubound(InData%CfVar)) call RegPack(Buf, InData%CfVar) end if if (RegCheckErr(Buf, RoutineName)) return - ! d99Var call RegPack(Buf, allocated(InData%d99Var)) if (allocated(InData%d99Var)) then call RegPackBounds(Buf, 1, lbound(InData%d99Var), ubound(InData%d99Var)) call RegPack(Buf, InData%d99Var) end if if (RegCheckErr(Buf, RoutineName)) return - ! dStarVar call RegPack(Buf, allocated(InData%dStarVar)) if (allocated(InData%dStarVar)) then call RegPackBounds(Buf, 1, lbound(InData%dStarVar), ubound(InData%dStarVar)) call RegPack(Buf, InData%dStarVar) end if if (RegCheckErr(Buf, RoutineName)) return - ! EdgeVelVar call RegPack(Buf, allocated(InData%EdgeVelVar)) if (allocated(InData%EdgeVelVar)) then call RegPackBounds(Buf, 1, lbound(InData%EdgeVelVar), ubound(InData%EdgeVelVar)) call RegPack(Buf, InData%EdgeVelVar) end if if (RegCheckErr(Buf, RoutineName)) return - ! speccou call RegPack(Buf, InData%speccou) if (RegCheckErr(Buf, RoutineName)) return - ! filesopen call RegPack(Buf, InData%filesopen) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3028,7 +2790,6 @@ subroutine AA_UnPackMisc(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! AllOuts if (allocated(OutData%AllOuts)) deallocate(OutData%AllOuts) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3043,7 +2804,6 @@ subroutine AA_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%AllOuts) if (RegCheckErr(Buf, RoutineName)) return end if - ! ChordAngleTE if (allocated(OutData%ChordAngleTE)) deallocate(OutData%ChordAngleTE) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3058,7 +2818,6 @@ subroutine AA_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%ChordAngleTE) if (RegCheckErr(Buf, RoutineName)) return end if - ! SpanAngleTE if (allocated(OutData%SpanAngleTE)) deallocate(OutData%SpanAngleTE) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3073,7 +2832,6 @@ subroutine AA_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%SpanAngleTE) if (RegCheckErr(Buf, RoutineName)) return end if - ! ChordAngleLE if (allocated(OutData%ChordAngleLE)) deallocate(OutData%ChordAngleLE) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3088,7 +2846,6 @@ subroutine AA_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%ChordAngleLE) if (RegCheckErr(Buf, RoutineName)) return end if - ! SpanAngleLE if (allocated(OutData%SpanAngleLE)) deallocate(OutData%SpanAngleLE) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3103,7 +2860,6 @@ subroutine AA_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%SpanAngleLE) if (RegCheckErr(Buf, RoutineName)) return end if - ! rTEtoObserve if (allocated(OutData%rTEtoObserve)) deallocate(OutData%rTEtoObserve) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3118,7 +2874,6 @@ subroutine AA_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%rTEtoObserve) if (RegCheckErr(Buf, RoutineName)) return end if - ! rLEtoObserve if (allocated(OutData%rLEtoObserve)) deallocate(OutData%rLEtoObserve) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3133,7 +2888,6 @@ subroutine AA_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%rLEtoObserve) if (RegCheckErr(Buf, RoutineName)) return end if - ! LE_Location if (allocated(OutData%LE_Location)) deallocate(OutData%LE_Location) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3148,10 +2902,8 @@ subroutine AA_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%LE_Location) if (RegCheckErr(Buf, RoutineName)) return end if - ! RotSpeedAoA call RegUnpack(Buf, OutData%RotSpeedAoA) if (RegCheckErr(Buf, RoutineName)) return - ! SPLLBL if (allocated(OutData%SPLLBL)) deallocate(OutData%SPLLBL) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3166,7 +2918,6 @@ subroutine AA_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%SPLLBL) if (RegCheckErr(Buf, RoutineName)) return end if - ! SPLP if (allocated(OutData%SPLP)) deallocate(OutData%SPLP) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3181,7 +2932,6 @@ subroutine AA_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%SPLP) if (RegCheckErr(Buf, RoutineName)) return end if - ! SPLS if (allocated(OutData%SPLS)) deallocate(OutData%SPLS) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3196,7 +2946,6 @@ subroutine AA_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%SPLS) if (RegCheckErr(Buf, RoutineName)) return end if - ! SPLALPH if (allocated(OutData%SPLALPH)) deallocate(OutData%SPLALPH) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3211,7 +2960,6 @@ subroutine AA_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%SPLALPH) if (RegCheckErr(Buf, RoutineName)) return end if - ! SPLTBL if (allocated(OutData%SPLTBL)) deallocate(OutData%SPLTBL) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3226,7 +2974,6 @@ subroutine AA_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%SPLTBL) if (RegCheckErr(Buf, RoutineName)) return end if - ! SPLTIP if (allocated(OutData%SPLTIP)) deallocate(OutData%SPLTIP) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3241,7 +2988,6 @@ subroutine AA_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%SPLTIP) if (RegCheckErr(Buf, RoutineName)) return end if - ! SPLTI if (allocated(OutData%SPLTI)) deallocate(OutData%SPLTI) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3256,7 +3002,6 @@ subroutine AA_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%SPLTI) if (RegCheckErr(Buf, RoutineName)) return end if - ! SPLTIGui if (allocated(OutData%SPLTIGui)) deallocate(OutData%SPLTIGui) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3271,7 +3016,6 @@ subroutine AA_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%SPLTIGui) if (RegCheckErr(Buf, RoutineName)) return end if - ! SPLBLUNT if (allocated(OutData%SPLBLUNT)) deallocate(OutData%SPLBLUNT) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3286,7 +3030,6 @@ subroutine AA_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%SPLBLUNT) if (RegCheckErr(Buf, RoutineName)) return end if - ! CfVar if (allocated(OutData%CfVar)) deallocate(OutData%CfVar) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3301,7 +3044,6 @@ subroutine AA_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%CfVar) if (RegCheckErr(Buf, RoutineName)) return end if - ! d99Var if (allocated(OutData%d99Var)) deallocate(OutData%d99Var) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3316,7 +3058,6 @@ subroutine AA_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%d99Var) if (RegCheckErr(Buf, RoutineName)) return end if - ! dStarVar if (allocated(OutData%dStarVar)) deallocate(OutData%dStarVar) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3331,7 +3072,6 @@ subroutine AA_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%dStarVar) if (RegCheckErr(Buf, RoutineName)) return end if - ! EdgeVelVar if (allocated(OutData%EdgeVelVar)) deallocate(OutData%EdgeVelVar) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3346,648 +3086,648 @@ subroutine AA_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%EdgeVelVar) if (RegCheckErr(Buf, RoutineName)) return end if - ! speccou call RegUnpack(Buf, OutData%speccou) if (RegCheckErr(Buf, RoutineName)) return - ! filesopen call RegUnpack(Buf, OutData%filesopen) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE AA_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_ParameterType), INTENT(IN) :: SrcParamData - TYPE(AA_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT - DstParamData%IBLUNT = SrcParamData%IBLUNT - DstParamData%ILAM = SrcParamData%ILAM - DstParamData%ITIP = SrcParamData%ITIP - DstParamData%ITRIP = SrcParamData%ITRIP - DstParamData%ITURB = SrcParamData%ITURB - DstParamData%IInflow = SrcParamData%IInflow - DstParamData%X_BLMethod = SrcParamData%X_BLMethod - DstParamData%TICalcMeth = SrcParamData%TICalcMeth - DstParamData%ROUND = SrcParamData%ROUND - DstParamData%ALPRAT = SrcParamData%ALPRAT - DstParamData%NumBlades = SrcParamData%NumBlades - DstParamData%NumBlNds = SrcParamData%NumBlNds - DstParamData%AirDens = SrcParamData%AirDens - DstParamData%KinVisc = SrcParamData%KinVisc - DstParamData%SpdSound = SrcParamData%SpdSound - DstParamData%HubHeight = SrcParamData%HubHeight - DstParamData%toptip = SrcParamData%toptip - DstParamData%bottip = SrcParamData%bottip -IF (ALLOCATED(SrcParamData%rotorregionlimitsVert)) THEN - i1_l = LBOUND(SrcParamData%rotorregionlimitsVert,1) - i1_u = UBOUND(SrcParamData%rotorregionlimitsVert,1) - IF (.NOT. ALLOCATED(DstParamData%rotorregionlimitsVert)) THEN - ALLOCATE(DstParamData%rotorregionlimitsVert(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsVert.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%rotorregionlimitsVert = SrcParamData%rotorregionlimitsVert -ENDIF -IF (ALLOCATED(SrcParamData%rotorregionlimitsHorz)) THEN - i1_l = LBOUND(SrcParamData%rotorregionlimitsHorz,1) - i1_u = UBOUND(SrcParamData%rotorregionlimitsHorz,1) - IF (.NOT. ALLOCATED(DstParamData%rotorregionlimitsHorz)) THEN - ALLOCATE(DstParamData%rotorregionlimitsHorz(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsHorz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%rotorregionlimitsHorz = SrcParamData%rotorregionlimitsHorz -ENDIF -IF (ALLOCATED(SrcParamData%rotorregionlimitsalph)) THEN - i1_l = LBOUND(SrcParamData%rotorregionlimitsalph,1) - i1_u = UBOUND(SrcParamData%rotorregionlimitsalph,1) - IF (.NOT. ALLOCATED(DstParamData%rotorregionlimitsalph)) THEN - ALLOCATE(DstParamData%rotorregionlimitsalph(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsalph.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%rotorregionlimitsalph = SrcParamData%rotorregionlimitsalph -ENDIF -IF (ALLOCATED(SrcParamData%rotorregionlimitsrad)) THEN - i1_l = LBOUND(SrcParamData%rotorregionlimitsrad,1) - i1_u = UBOUND(SrcParamData%rotorregionlimitsrad,1) - IF (.NOT. ALLOCATED(DstParamData%rotorregionlimitsrad)) THEN - ALLOCATE(DstParamData%rotorregionlimitsrad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsrad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%rotorregionlimitsrad = SrcParamData%rotorregionlimitsrad -ENDIF - DstParamData%NrObsLoc = SrcParamData%NrObsLoc - DstParamData%aweightflag = SrcParamData%aweightflag - DstParamData%TxtFileOutput = SrcParamData%TxtFileOutput - DstParamData%AAStart = SrcParamData%AAStart -IF (ALLOCATED(SrcParamData%ObsX)) THEN - i1_l = LBOUND(SrcParamData%ObsX,1) - i1_u = UBOUND(SrcParamData%ObsX,1) - IF (.NOT. ALLOCATED(DstParamData%ObsX)) THEN - ALLOCATE(DstParamData%ObsX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ObsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ObsX = SrcParamData%ObsX -ENDIF -IF (ALLOCATED(SrcParamData%ObsY)) THEN - i1_l = LBOUND(SrcParamData%ObsY,1) - i1_u = UBOUND(SrcParamData%ObsY,1) - IF (.NOT. ALLOCATED(DstParamData%ObsY)) THEN - ALLOCATE(DstParamData%ObsY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ObsY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ObsY = SrcParamData%ObsY -ENDIF -IF (ALLOCATED(SrcParamData%ObsZ)) THEN - i1_l = LBOUND(SrcParamData%ObsZ,1) - i1_u = UBOUND(SrcParamData%ObsZ,1) - IF (.NOT. ALLOCATED(DstParamData%ObsZ)) THEN - ALLOCATE(DstParamData%ObsZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ObsZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ObsZ = SrcParamData%ObsZ -ENDIF -IF (ALLOCATED(SrcParamData%FreqList)) THEN - i1_l = LBOUND(SrcParamData%FreqList,1) - i1_u = UBOUND(SrcParamData%FreqList,1) - IF (.NOT. ALLOCATED(DstParamData%FreqList)) THEN - ALLOCATE(DstParamData%FreqList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FreqList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FreqList = SrcParamData%FreqList -ENDIF -IF (ALLOCATED(SrcParamData%Aweight)) THEN - i1_l = LBOUND(SrcParamData%Aweight,1) - i1_u = UBOUND(SrcParamData%Aweight,1) - IF (.NOT. ALLOCATED(DstParamData%Aweight)) THEN - ALLOCATE(DstParamData%Aweight(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Aweight.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Aweight = SrcParamData%Aweight -ENDIF - DstParamData%Fsample = SrcParamData%Fsample - DstParamData%total_sample = SrcParamData%total_sample - DstParamData%total_sampleTI = SrcParamData%total_sampleTI - DstParamData%AA_Bl_Prcntge = SrcParamData%AA_Bl_Prcntge - DstParamData%startnode = SrcParamData%startnode - DstParamData%Lturb = SrcParamData%Lturb - DstParamData%AvgV = SrcParamData%AvgV - DstParamData%dz_turb_in = SrcParamData%dz_turb_in - DstParamData%dy_turb_in = SrcParamData%dy_turb_in -IF (ALLOCATED(SrcParamData%TI_Grid_In)) THEN - i1_l = LBOUND(SrcParamData%TI_Grid_In,1) - i1_u = UBOUND(SrcParamData%TI_Grid_In,1) - i2_l = LBOUND(SrcParamData%TI_Grid_In,2) - i2_u = UBOUND(SrcParamData%TI_Grid_In,2) - IF (.NOT. ALLOCATED(DstParamData%TI_Grid_In)) THEN - ALLOCATE(DstParamData%TI_Grid_In(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TI_Grid_In.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TI_Grid_In = SrcParamData%TI_Grid_In -ENDIF - DstParamData%FTitle = SrcParamData%FTitle - DstParamData%outFmt = SrcParamData%outFmt - DstParamData%NrOutFile = SrcParamData%NrOutFile - DstParamData%delim = SrcParamData%delim - DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%NumOutsForPE = SrcParamData%NumOutsForPE - DstParamData%NumOutsForSep = SrcParamData%NumOutsForSep - DstParamData%NumOutsForNodes = SrcParamData%NumOutsForNodes - DstParamData%unOutFile = SrcParamData%unOutFile - DstParamData%unOutFile2 = SrcParamData%unOutFile2 - DstParamData%unOutFile3 = SrcParamData%unOutFile3 - DstParamData%unOutFile4 = SrcParamData%unOutFile4 - DstParamData%RootName = SrcParamData%RootName -IF (ALLOCATED(SrcParamData%OutParam)) THEN - i1_l = LBOUND(SrcParamData%OutParam,1) - i1_u = UBOUND(SrcParamData%OutParam,1) - IF (.NOT. ALLOCATED(DstParamData%OutParam)) THEN - ALLOCATE(DstParamData%OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%OutParam,1), UBOUND(SrcParamData%OutParam,1) - CALL NWTC_Library_Copyoutparmtype( SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%StallStart)) THEN - i1_l = LBOUND(SrcParamData%StallStart,1) - i1_u = UBOUND(SrcParamData%StallStart,1) - i2_l = LBOUND(SrcParamData%StallStart,2) - i2_u = UBOUND(SrcParamData%StallStart,2) - IF (.NOT. ALLOCATED(DstParamData%StallStart)) THEN - ALLOCATE(DstParamData%StallStart(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StallStart.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%StallStart = SrcParamData%StallStart -ENDIF -IF (ALLOCATED(SrcParamData%TEThick)) THEN - i1_l = LBOUND(SrcParamData%TEThick,1) - i1_u = UBOUND(SrcParamData%TEThick,1) - i2_l = LBOUND(SrcParamData%TEThick,2) - i2_u = UBOUND(SrcParamData%TEThick,2) - IF (.NOT. ALLOCATED(DstParamData%TEThick)) THEN - ALLOCATE(DstParamData%TEThick(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TEThick.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TEThick = SrcParamData%TEThick -ENDIF -IF (ALLOCATED(SrcParamData%TEAngle)) THEN - i1_l = LBOUND(SrcParamData%TEAngle,1) - i1_u = UBOUND(SrcParamData%TEAngle,1) - i2_l = LBOUND(SrcParamData%TEAngle,2) - i2_u = UBOUND(SrcParamData%TEAngle,2) - IF (.NOT. ALLOCATED(DstParamData%TEAngle)) THEN - ALLOCATE(DstParamData%TEAngle(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TEAngle.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TEAngle = SrcParamData%TEAngle -ENDIF -IF (ALLOCATED(SrcParamData%AerCent)) THEN - i1_l = LBOUND(SrcParamData%AerCent,1) - i1_u = UBOUND(SrcParamData%AerCent,1) - i2_l = LBOUND(SrcParamData%AerCent,2) - i2_u = UBOUND(SrcParamData%AerCent,2) - i3_l = LBOUND(SrcParamData%AerCent,3) - i3_u = UBOUND(SrcParamData%AerCent,3) - IF (.NOT. ALLOCATED(DstParamData%AerCent)) THEN - ALLOCATE(DstParamData%AerCent(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AerCent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AerCent = SrcParamData%AerCent -ENDIF -IF (ALLOCATED(SrcParamData%BlAFID)) THEN - i1_l = LBOUND(SrcParamData%BlAFID,1) - i1_u = UBOUND(SrcParamData%BlAFID,1) - i2_l = LBOUND(SrcParamData%BlAFID,2) - i2_u = UBOUND(SrcParamData%BlAFID,2) - IF (.NOT. ALLOCATED(DstParamData%BlAFID)) THEN - ALLOCATE(DstParamData%BlAFID(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlAFID.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BlAFID = SrcParamData%BlAFID -ENDIF -IF (ALLOCATED(SrcParamData%AFInfo)) THEN - i1_l = LBOUND(SrcParamData%AFInfo,1) - i1_u = UBOUND(SrcParamData%AFInfo,1) - IF (.NOT. ALLOCATED(DstParamData%AFInfo)) THEN - ALLOCATE(DstParamData%AFInfo(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFInfo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%AFInfo,1), UBOUND(SrcParamData%AFInfo,1) - CALL AFI_CopyParam( SrcParamData%AFInfo(i1), DstParamData%AFInfo(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%AFLECo)) THEN - i1_l = LBOUND(SrcParamData%AFLECo,1) - i1_u = UBOUND(SrcParamData%AFLECo,1) - i2_l = LBOUND(SrcParamData%AFLECo,2) - i2_u = UBOUND(SrcParamData%AFLECo,2) - i3_l = LBOUND(SrcParamData%AFLECo,3) - i3_u = UBOUND(SrcParamData%AFLECo,3) - IF (.NOT. ALLOCATED(DstParamData%AFLECo)) THEN - ALLOCATE(DstParamData%AFLECo(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFLECo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AFLECo = SrcParamData%AFLECo -ENDIF -IF (ALLOCATED(SrcParamData%AFTECo)) THEN - i1_l = LBOUND(SrcParamData%AFTECo,1) - i1_u = UBOUND(SrcParamData%AFTECo,1) - i2_l = LBOUND(SrcParamData%AFTECo,2) - i2_u = UBOUND(SrcParamData%AFTECo,2) - i3_l = LBOUND(SrcParamData%AFTECo,3) - i3_u = UBOUND(SrcParamData%AFTECo,3) - IF (.NOT. ALLOCATED(DstParamData%AFTECo)) THEN - ALLOCATE(DstParamData%AFTECo(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFTECo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AFTECo = SrcParamData%AFTECo -ENDIF -IF (ALLOCATED(SrcParamData%BlSpn)) THEN - i1_l = LBOUND(SrcParamData%BlSpn,1) - i1_u = UBOUND(SrcParamData%BlSpn,1) - i2_l = LBOUND(SrcParamData%BlSpn,2) - i2_u = UBOUND(SrcParamData%BlSpn,2) - IF (.NOT. ALLOCATED(DstParamData%BlSpn)) THEN - ALLOCATE(DstParamData%BlSpn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlSpn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BlSpn = SrcParamData%BlSpn -ENDIF -IF (ALLOCATED(SrcParamData%BlChord)) THEN - i1_l = LBOUND(SrcParamData%BlChord,1) - i1_u = UBOUND(SrcParamData%BlChord,1) - i2_l = LBOUND(SrcParamData%BlChord,2) - i2_u = UBOUND(SrcParamData%BlChord,2) - IF (.NOT. ALLOCATED(DstParamData%BlChord)) THEN - ALLOCATE(DstParamData%BlChord(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlChord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BlChord = SrcParamData%BlChord -ENDIF -IF (ALLOCATED(SrcParamData%ReListBL)) THEN - i1_l = LBOUND(SrcParamData%ReListBL,1) - i1_u = UBOUND(SrcParamData%ReListBL,1) - IF (.NOT. ALLOCATED(DstParamData%ReListBL)) THEN - ALLOCATE(DstParamData%ReListBL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ReListBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ReListBL = SrcParamData%ReListBL -ENDIF -IF (ALLOCATED(SrcParamData%AOAListBL)) THEN - i1_l = LBOUND(SrcParamData%AOAListBL,1) - i1_u = UBOUND(SrcParamData%AOAListBL,1) - IF (.NOT. ALLOCATED(DstParamData%AOAListBL)) THEN - ALLOCATE(DstParamData%AOAListBL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AOAListBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AOAListBL = SrcParamData%AOAListBL -ENDIF -IF (ALLOCATED(SrcParamData%dStarAll1)) THEN - i1_l = LBOUND(SrcParamData%dStarAll1,1) - i1_u = UBOUND(SrcParamData%dStarAll1,1) - i2_l = LBOUND(SrcParamData%dStarAll1,2) - i2_u = UBOUND(SrcParamData%dStarAll1,2) - i3_l = LBOUND(SrcParamData%dStarAll1,3) - i3_u = UBOUND(SrcParamData%dStarAll1,3) - IF (.NOT. ALLOCATED(DstParamData%dStarAll1)) THEN - ALLOCATE(DstParamData%dStarAll1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dStarAll1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%dStarAll1 = SrcParamData%dStarAll1 -ENDIF -IF (ALLOCATED(SrcParamData%dStarAll2)) THEN - i1_l = LBOUND(SrcParamData%dStarAll2,1) - i1_u = UBOUND(SrcParamData%dStarAll2,1) - i2_l = LBOUND(SrcParamData%dStarAll2,2) - i2_u = UBOUND(SrcParamData%dStarAll2,2) - i3_l = LBOUND(SrcParamData%dStarAll2,3) - i3_u = UBOUND(SrcParamData%dStarAll2,3) - IF (.NOT. ALLOCATED(DstParamData%dStarAll2)) THEN - ALLOCATE(DstParamData%dStarAll2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dStarAll2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%dStarAll2 = SrcParamData%dStarAll2 -ENDIF -IF (ALLOCATED(SrcParamData%d99All1)) THEN - i1_l = LBOUND(SrcParamData%d99All1,1) - i1_u = UBOUND(SrcParamData%d99All1,1) - i2_l = LBOUND(SrcParamData%d99All1,2) - i2_u = UBOUND(SrcParamData%d99All1,2) - i3_l = LBOUND(SrcParamData%d99All1,3) - i3_u = UBOUND(SrcParamData%d99All1,3) - IF (.NOT. ALLOCATED(DstParamData%d99All1)) THEN - ALLOCATE(DstParamData%d99All1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%d99All1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%d99All1 = SrcParamData%d99All1 -ENDIF -IF (ALLOCATED(SrcParamData%d99All2)) THEN - i1_l = LBOUND(SrcParamData%d99All2,1) - i1_u = UBOUND(SrcParamData%d99All2,1) - i2_l = LBOUND(SrcParamData%d99All2,2) - i2_u = UBOUND(SrcParamData%d99All2,2) - i3_l = LBOUND(SrcParamData%d99All2,3) - i3_u = UBOUND(SrcParamData%d99All2,3) - IF (.NOT. ALLOCATED(DstParamData%d99All2)) THEN - ALLOCATE(DstParamData%d99All2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%d99All2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%d99All2 = SrcParamData%d99All2 -ENDIF -IF (ALLOCATED(SrcParamData%CfAll1)) THEN - i1_l = LBOUND(SrcParamData%CfAll1,1) - i1_u = UBOUND(SrcParamData%CfAll1,1) - i2_l = LBOUND(SrcParamData%CfAll1,2) - i2_u = UBOUND(SrcParamData%CfAll1,2) - i3_l = LBOUND(SrcParamData%CfAll1,3) - i3_u = UBOUND(SrcParamData%CfAll1,3) - IF (.NOT. ALLOCATED(DstParamData%CfAll1)) THEN - ALLOCATE(DstParamData%CfAll1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CfAll1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CfAll1 = SrcParamData%CfAll1 -ENDIF -IF (ALLOCATED(SrcParamData%CfAll2)) THEN - i1_l = LBOUND(SrcParamData%CfAll2,1) - i1_u = UBOUND(SrcParamData%CfAll2,1) - i2_l = LBOUND(SrcParamData%CfAll2,2) - i2_u = UBOUND(SrcParamData%CfAll2,2) - i3_l = LBOUND(SrcParamData%CfAll2,3) - i3_u = UBOUND(SrcParamData%CfAll2,3) - IF (.NOT. ALLOCATED(DstParamData%CfAll2)) THEN - ALLOCATE(DstParamData%CfAll2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CfAll2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CfAll2 = SrcParamData%CfAll2 -ENDIF -IF (ALLOCATED(SrcParamData%EdgeVelRat1)) THEN - i1_l = LBOUND(SrcParamData%EdgeVelRat1,1) - i1_u = UBOUND(SrcParamData%EdgeVelRat1,1) - i2_l = LBOUND(SrcParamData%EdgeVelRat1,2) - i2_u = UBOUND(SrcParamData%EdgeVelRat1,2) - i3_l = LBOUND(SrcParamData%EdgeVelRat1,3) - i3_u = UBOUND(SrcParamData%EdgeVelRat1,3) - IF (.NOT. ALLOCATED(DstParamData%EdgeVelRat1)) THEN - ALLOCATE(DstParamData%EdgeVelRat1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%EdgeVelRat1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%EdgeVelRat1 = SrcParamData%EdgeVelRat1 -ENDIF -IF (ALLOCATED(SrcParamData%EdgeVelRat2)) THEN - i1_l = LBOUND(SrcParamData%EdgeVelRat2,1) - i1_u = UBOUND(SrcParamData%EdgeVelRat2,1) - i2_l = LBOUND(SrcParamData%EdgeVelRat2,2) - i2_u = UBOUND(SrcParamData%EdgeVelRat2,2) - i3_l = LBOUND(SrcParamData%EdgeVelRat2,3) - i3_u = UBOUND(SrcParamData%EdgeVelRat2,3) - IF (.NOT. ALLOCATED(DstParamData%EdgeVelRat2)) THEN - ALLOCATE(DstParamData%EdgeVelRat2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%EdgeVelRat2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%EdgeVelRat2 = SrcParamData%EdgeVelRat2 -ENDIF -IF (ALLOCATED(SrcParamData%AFThickGuida)) THEN - i1_l = LBOUND(SrcParamData%AFThickGuida,1) - i1_u = UBOUND(SrcParamData%AFThickGuida,1) - i2_l = LBOUND(SrcParamData%AFThickGuida,2) - i2_u = UBOUND(SrcParamData%AFThickGuida,2) - IF (.NOT. ALLOCATED(DstParamData%AFThickGuida)) THEN - ALLOCATE(DstParamData%AFThickGuida(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFThickGuida.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AFThickGuida = SrcParamData%AFThickGuida -ENDIF - END SUBROUTINE AA_CopyParam - - SUBROUTINE AA_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(AA_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyParam' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%rotorregionlimitsVert)) THEN - DEALLOCATE(ParamData%rotorregionlimitsVert) -ENDIF -IF (ALLOCATED(ParamData%rotorregionlimitsHorz)) THEN - DEALLOCATE(ParamData%rotorregionlimitsHorz) -ENDIF -IF (ALLOCATED(ParamData%rotorregionlimitsalph)) THEN - DEALLOCATE(ParamData%rotorregionlimitsalph) -ENDIF -IF (ALLOCATED(ParamData%rotorregionlimitsrad)) THEN - DEALLOCATE(ParamData%rotorregionlimitsrad) -ENDIF -IF (ALLOCATED(ParamData%ObsX)) THEN - DEALLOCATE(ParamData%ObsX) -ENDIF -IF (ALLOCATED(ParamData%ObsY)) THEN - DEALLOCATE(ParamData%ObsY) -ENDIF -IF (ALLOCATED(ParamData%ObsZ)) THEN - DEALLOCATE(ParamData%ObsZ) -ENDIF -IF (ALLOCATED(ParamData%FreqList)) THEN - DEALLOCATE(ParamData%FreqList) -ENDIF -IF (ALLOCATED(ParamData%Aweight)) THEN - DEALLOCATE(ParamData%Aweight) -ENDIF -IF (ALLOCATED(ParamData%TI_Grid_In)) THEN - DEALLOCATE(ParamData%TI_Grid_In) -ENDIF -IF (ALLOCATED(ParamData%OutParam)) THEN -DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_DestroyOutParmType( ParamData%OutParam(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%OutParam) -ENDIF -IF (ALLOCATED(ParamData%StallStart)) THEN - DEALLOCATE(ParamData%StallStart) -ENDIF -IF (ALLOCATED(ParamData%TEThick)) THEN - DEALLOCATE(ParamData%TEThick) -ENDIF -IF (ALLOCATED(ParamData%TEAngle)) THEN - DEALLOCATE(ParamData%TEAngle) -ENDIF -IF (ALLOCATED(ParamData%AerCent)) THEN - DEALLOCATE(ParamData%AerCent) -ENDIF -IF (ALLOCATED(ParamData%BlAFID)) THEN - DEALLOCATE(ParamData%BlAFID) -ENDIF -IF (ALLOCATED(ParamData%AFInfo)) THEN -DO i1 = LBOUND(ParamData%AFInfo,1), UBOUND(ParamData%AFInfo,1) - CALL AFI_DestroyParam( ParamData%AFInfo(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%AFInfo) -ENDIF -IF (ALLOCATED(ParamData%AFLECo)) THEN - DEALLOCATE(ParamData%AFLECo) -ENDIF -IF (ALLOCATED(ParamData%AFTECo)) THEN - DEALLOCATE(ParamData%AFTECo) -ENDIF -IF (ALLOCATED(ParamData%BlSpn)) THEN - DEALLOCATE(ParamData%BlSpn) -ENDIF -IF (ALLOCATED(ParamData%BlChord)) THEN - DEALLOCATE(ParamData%BlChord) -ENDIF -IF (ALLOCATED(ParamData%ReListBL)) THEN - DEALLOCATE(ParamData%ReListBL) -ENDIF -IF (ALLOCATED(ParamData%AOAListBL)) THEN - DEALLOCATE(ParamData%AOAListBL) -ENDIF -IF (ALLOCATED(ParamData%dStarAll1)) THEN - DEALLOCATE(ParamData%dStarAll1) -ENDIF -IF (ALLOCATED(ParamData%dStarAll2)) THEN - DEALLOCATE(ParamData%dStarAll2) -ENDIF -IF (ALLOCATED(ParamData%d99All1)) THEN - DEALLOCATE(ParamData%d99All1) -ENDIF -IF (ALLOCATED(ParamData%d99All2)) THEN - DEALLOCATE(ParamData%d99All2) -ENDIF -IF (ALLOCATED(ParamData%CfAll1)) THEN - DEALLOCATE(ParamData%CfAll1) -ENDIF -IF (ALLOCATED(ParamData%CfAll2)) THEN - DEALLOCATE(ParamData%CfAll2) -ENDIF -IF (ALLOCATED(ParamData%EdgeVelRat1)) THEN - DEALLOCATE(ParamData%EdgeVelRat1) -ENDIF -IF (ALLOCATED(ParamData%EdgeVelRat2)) THEN - DEALLOCATE(ParamData%EdgeVelRat2) -ENDIF -IF (ALLOCATED(ParamData%AFThickGuida)) THEN - DEALLOCATE(ParamData%AFThickGuida) -ENDIF - END SUBROUTINE AA_DestroyParam +subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(AA_ParameterType), intent(in) :: SrcParamData + type(AA_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AA_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%DT = SrcParamData%DT + DstParamData%IBLUNT = SrcParamData%IBLUNT + DstParamData%ILAM = SrcParamData%ILAM + DstParamData%ITIP = SrcParamData%ITIP + DstParamData%ITRIP = SrcParamData%ITRIP + DstParamData%ITURB = SrcParamData%ITURB + DstParamData%IInflow = SrcParamData%IInflow + DstParamData%X_BLMethod = SrcParamData%X_BLMethod + DstParamData%TICalcMeth = SrcParamData%TICalcMeth + DstParamData%ROUND = SrcParamData%ROUND + DstParamData%ALPRAT = SrcParamData%ALPRAT + DstParamData%NumBlades = SrcParamData%NumBlades + DstParamData%NumBlNds = SrcParamData%NumBlNds + DstParamData%AirDens = SrcParamData%AirDens + DstParamData%KinVisc = SrcParamData%KinVisc + DstParamData%SpdSound = SrcParamData%SpdSound + DstParamData%HubHeight = SrcParamData%HubHeight + DstParamData%toptip = SrcParamData%toptip + DstParamData%bottip = SrcParamData%bottip + if (allocated(SrcParamData%rotorregionlimitsVert)) then + LB(1:1) = lbound(SrcParamData%rotorregionlimitsVert) + UB(1:1) = ubound(SrcParamData%rotorregionlimitsVert) + if (.not. allocated(DstParamData%rotorregionlimitsVert)) then + allocate(DstParamData%rotorregionlimitsVert(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsVert.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%rotorregionlimitsVert = SrcParamData%rotorregionlimitsVert + else if (allocated(DstParamData%rotorregionlimitsVert)) then + deallocate(DstParamData%rotorregionlimitsVert) + end if + if (allocated(SrcParamData%rotorregionlimitsHorz)) then + LB(1:1) = lbound(SrcParamData%rotorregionlimitsHorz) + UB(1:1) = ubound(SrcParamData%rotorregionlimitsHorz) + if (.not. allocated(DstParamData%rotorregionlimitsHorz)) then + allocate(DstParamData%rotorregionlimitsHorz(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsHorz.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%rotorregionlimitsHorz = SrcParamData%rotorregionlimitsHorz + else if (allocated(DstParamData%rotorregionlimitsHorz)) then + deallocate(DstParamData%rotorregionlimitsHorz) + end if + if (allocated(SrcParamData%rotorregionlimitsalph)) then + LB(1:1) = lbound(SrcParamData%rotorregionlimitsalph) + UB(1:1) = ubound(SrcParamData%rotorregionlimitsalph) + if (.not. allocated(DstParamData%rotorregionlimitsalph)) then + allocate(DstParamData%rotorregionlimitsalph(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsalph.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%rotorregionlimitsalph = SrcParamData%rotorregionlimitsalph + else if (allocated(DstParamData%rotorregionlimitsalph)) then + deallocate(DstParamData%rotorregionlimitsalph) + end if + if (allocated(SrcParamData%rotorregionlimitsrad)) then + LB(1:1) = lbound(SrcParamData%rotorregionlimitsrad) + UB(1:1) = ubound(SrcParamData%rotorregionlimitsrad) + if (.not. allocated(DstParamData%rotorregionlimitsrad)) then + allocate(DstParamData%rotorregionlimitsrad(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsrad.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%rotorregionlimitsrad = SrcParamData%rotorregionlimitsrad + else if (allocated(DstParamData%rotorregionlimitsrad)) then + deallocate(DstParamData%rotorregionlimitsrad) + end if + DstParamData%NrObsLoc = SrcParamData%NrObsLoc + DstParamData%aweightflag = SrcParamData%aweightflag + DstParamData%TxtFileOutput = SrcParamData%TxtFileOutput + DstParamData%AAStart = SrcParamData%AAStart + if (allocated(SrcParamData%ObsX)) then + LB(1:1) = lbound(SrcParamData%ObsX) + UB(1:1) = ubound(SrcParamData%ObsX) + if (.not. allocated(DstParamData%ObsX)) then + allocate(DstParamData%ObsX(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ObsX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%ObsX = SrcParamData%ObsX + else if (allocated(DstParamData%ObsX)) then + deallocate(DstParamData%ObsX) + end if + if (allocated(SrcParamData%ObsY)) then + LB(1:1) = lbound(SrcParamData%ObsY) + UB(1:1) = ubound(SrcParamData%ObsY) + if (.not. allocated(DstParamData%ObsY)) then + allocate(DstParamData%ObsY(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ObsY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%ObsY = SrcParamData%ObsY + else if (allocated(DstParamData%ObsY)) then + deallocate(DstParamData%ObsY) + end if + if (allocated(SrcParamData%ObsZ)) then + LB(1:1) = lbound(SrcParamData%ObsZ) + UB(1:1) = ubound(SrcParamData%ObsZ) + if (.not. allocated(DstParamData%ObsZ)) then + allocate(DstParamData%ObsZ(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ObsZ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%ObsZ = SrcParamData%ObsZ + else if (allocated(DstParamData%ObsZ)) then + deallocate(DstParamData%ObsZ) + end if + if (allocated(SrcParamData%FreqList)) then + LB(1:1) = lbound(SrcParamData%FreqList) + UB(1:1) = ubound(SrcParamData%FreqList) + if (.not. allocated(DstParamData%FreqList)) then + allocate(DstParamData%FreqList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FreqList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%FreqList = SrcParamData%FreqList + else if (allocated(DstParamData%FreqList)) then + deallocate(DstParamData%FreqList) + end if + if (allocated(SrcParamData%Aweight)) then + LB(1:1) = lbound(SrcParamData%Aweight) + UB(1:1) = ubound(SrcParamData%Aweight) + if (.not. allocated(DstParamData%Aweight)) then + allocate(DstParamData%Aweight(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Aweight.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Aweight = SrcParamData%Aweight + else if (allocated(DstParamData%Aweight)) then + deallocate(DstParamData%Aweight) + end if + DstParamData%Fsample = SrcParamData%Fsample + DstParamData%total_sample = SrcParamData%total_sample + DstParamData%total_sampleTI = SrcParamData%total_sampleTI + DstParamData%AA_Bl_Prcntge = SrcParamData%AA_Bl_Prcntge + DstParamData%startnode = SrcParamData%startnode + DstParamData%Lturb = SrcParamData%Lturb + DstParamData%AvgV = SrcParamData%AvgV + DstParamData%dz_turb_in = SrcParamData%dz_turb_in + DstParamData%dy_turb_in = SrcParamData%dy_turb_in + if (allocated(SrcParamData%TI_Grid_In)) then + LB(1:2) = lbound(SrcParamData%TI_Grid_In) + UB(1:2) = ubound(SrcParamData%TI_Grid_In) + if (.not. allocated(DstParamData%TI_Grid_In)) then + allocate(DstParamData%TI_Grid_In(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TI_Grid_In.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%TI_Grid_In = SrcParamData%TI_Grid_In + else if (allocated(DstParamData%TI_Grid_In)) then + deallocate(DstParamData%TI_Grid_In) + end if + DstParamData%FTitle = SrcParamData%FTitle + DstParamData%outFmt = SrcParamData%outFmt + DstParamData%NrOutFile = SrcParamData%NrOutFile + DstParamData%delim = SrcParamData%delim + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%NumOutsForPE = SrcParamData%NumOutsForPE + DstParamData%NumOutsForSep = SrcParamData%NumOutsForSep + DstParamData%NumOutsForNodes = SrcParamData%NumOutsForNodes + DstParamData%unOutFile = SrcParamData%unOutFile + DstParamData%unOutFile2 = SrcParamData%unOutFile2 + DstParamData%unOutFile3 = SrcParamData%unOutFile3 + DstParamData%unOutFile4 = SrcParamData%unOutFile4 + DstParamData%RootName = SrcParamData%RootName + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstParamData%OutParam)) then + deallocate(DstParamData%OutParam) + end if + if (allocated(SrcParamData%StallStart)) then + LB(1:2) = lbound(SrcParamData%StallStart) + UB(1:2) = ubound(SrcParamData%StallStart) + if (.not. allocated(DstParamData%StallStart)) then + allocate(DstParamData%StallStart(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StallStart.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%StallStart = SrcParamData%StallStart + else if (allocated(DstParamData%StallStart)) then + deallocate(DstParamData%StallStart) + end if + if (allocated(SrcParamData%TEThick)) then + LB(1:2) = lbound(SrcParamData%TEThick) + UB(1:2) = ubound(SrcParamData%TEThick) + if (.not. allocated(DstParamData%TEThick)) then + allocate(DstParamData%TEThick(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TEThick.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%TEThick = SrcParamData%TEThick + else if (allocated(DstParamData%TEThick)) then + deallocate(DstParamData%TEThick) + end if + if (allocated(SrcParamData%TEAngle)) then + LB(1:2) = lbound(SrcParamData%TEAngle) + UB(1:2) = ubound(SrcParamData%TEAngle) + if (.not. allocated(DstParamData%TEAngle)) then + allocate(DstParamData%TEAngle(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TEAngle.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%TEAngle = SrcParamData%TEAngle + else if (allocated(DstParamData%TEAngle)) then + deallocate(DstParamData%TEAngle) + end if + if (allocated(SrcParamData%AerCent)) then + LB(1:3) = lbound(SrcParamData%AerCent) + UB(1:3) = ubound(SrcParamData%AerCent) + if (.not. allocated(DstParamData%AerCent)) then + allocate(DstParamData%AerCent(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AerCent.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AerCent = SrcParamData%AerCent + else if (allocated(DstParamData%AerCent)) then + deallocate(DstParamData%AerCent) + end if + if (allocated(SrcParamData%BlAFID)) then + LB(1:2) = lbound(SrcParamData%BlAFID) + UB(1:2) = ubound(SrcParamData%BlAFID) + if (.not. allocated(DstParamData%BlAFID)) then + allocate(DstParamData%BlAFID(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlAFID.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BlAFID = SrcParamData%BlAFID + else if (allocated(DstParamData%BlAFID)) then + deallocate(DstParamData%BlAFID) + end if + if (allocated(SrcParamData%AFInfo)) then + LB(1:1) = lbound(SrcParamData%AFInfo) + UB(1:1) = ubound(SrcParamData%AFInfo) + if (.not. allocated(DstParamData%AFInfo)) then + allocate(DstParamData%AFInfo(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFInfo.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AFI_CopyParam(SrcParamData%AFInfo(i1), DstParamData%AFInfo(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstParamData%AFInfo)) then + deallocate(DstParamData%AFInfo) + end if + if (allocated(SrcParamData%AFLECo)) then + LB(1:3) = lbound(SrcParamData%AFLECo) + UB(1:3) = ubound(SrcParamData%AFLECo) + if (.not. allocated(DstParamData%AFLECo)) then + allocate(DstParamData%AFLECo(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFLECo.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AFLECo = SrcParamData%AFLECo + else if (allocated(DstParamData%AFLECo)) then + deallocate(DstParamData%AFLECo) + end if + if (allocated(SrcParamData%AFTECo)) then + LB(1:3) = lbound(SrcParamData%AFTECo) + UB(1:3) = ubound(SrcParamData%AFTECo) + if (.not. allocated(DstParamData%AFTECo)) then + allocate(DstParamData%AFTECo(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFTECo.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AFTECo = SrcParamData%AFTECo + else if (allocated(DstParamData%AFTECo)) then + deallocate(DstParamData%AFTECo) + end if + if (allocated(SrcParamData%BlSpn)) then + LB(1:2) = lbound(SrcParamData%BlSpn) + UB(1:2) = ubound(SrcParamData%BlSpn) + if (.not. allocated(DstParamData%BlSpn)) then + allocate(DstParamData%BlSpn(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlSpn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BlSpn = SrcParamData%BlSpn + else if (allocated(DstParamData%BlSpn)) then + deallocate(DstParamData%BlSpn) + end if + if (allocated(SrcParamData%BlChord)) then + LB(1:2) = lbound(SrcParamData%BlChord) + UB(1:2) = ubound(SrcParamData%BlChord) + if (.not. allocated(DstParamData%BlChord)) then + allocate(DstParamData%BlChord(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlChord.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BlChord = SrcParamData%BlChord + else if (allocated(DstParamData%BlChord)) then + deallocate(DstParamData%BlChord) + end if + if (allocated(SrcParamData%ReListBL)) then + LB(1:1) = lbound(SrcParamData%ReListBL) + UB(1:1) = ubound(SrcParamData%ReListBL) + if (.not. allocated(DstParamData%ReListBL)) then + allocate(DstParamData%ReListBL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ReListBL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%ReListBL = SrcParamData%ReListBL + else if (allocated(DstParamData%ReListBL)) then + deallocate(DstParamData%ReListBL) + end if + if (allocated(SrcParamData%AOAListBL)) then + LB(1:1) = lbound(SrcParamData%AOAListBL) + UB(1:1) = ubound(SrcParamData%AOAListBL) + if (.not. allocated(DstParamData%AOAListBL)) then + allocate(DstParamData%AOAListBL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AOAListBL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AOAListBL = SrcParamData%AOAListBL + else if (allocated(DstParamData%AOAListBL)) then + deallocate(DstParamData%AOAListBL) + end if + if (allocated(SrcParamData%dStarAll1)) then + LB(1:3) = lbound(SrcParamData%dStarAll1) + UB(1:3) = ubound(SrcParamData%dStarAll1) + if (.not. allocated(DstParamData%dStarAll1)) then + allocate(DstParamData%dStarAll1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dStarAll1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%dStarAll1 = SrcParamData%dStarAll1 + else if (allocated(DstParamData%dStarAll1)) then + deallocate(DstParamData%dStarAll1) + end if + if (allocated(SrcParamData%dStarAll2)) then + LB(1:3) = lbound(SrcParamData%dStarAll2) + UB(1:3) = ubound(SrcParamData%dStarAll2) + if (.not. allocated(DstParamData%dStarAll2)) then + allocate(DstParamData%dStarAll2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dStarAll2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%dStarAll2 = SrcParamData%dStarAll2 + else if (allocated(DstParamData%dStarAll2)) then + deallocate(DstParamData%dStarAll2) + end if + if (allocated(SrcParamData%d99All1)) then + LB(1:3) = lbound(SrcParamData%d99All1) + UB(1:3) = ubound(SrcParamData%d99All1) + if (.not. allocated(DstParamData%d99All1)) then + allocate(DstParamData%d99All1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%d99All1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%d99All1 = SrcParamData%d99All1 + else if (allocated(DstParamData%d99All1)) then + deallocate(DstParamData%d99All1) + end if + if (allocated(SrcParamData%d99All2)) then + LB(1:3) = lbound(SrcParamData%d99All2) + UB(1:3) = ubound(SrcParamData%d99All2) + if (.not. allocated(DstParamData%d99All2)) then + allocate(DstParamData%d99All2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%d99All2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%d99All2 = SrcParamData%d99All2 + else if (allocated(DstParamData%d99All2)) then + deallocate(DstParamData%d99All2) + end if + if (allocated(SrcParamData%CfAll1)) then + LB(1:3) = lbound(SrcParamData%CfAll1) + UB(1:3) = ubound(SrcParamData%CfAll1) + if (.not. allocated(DstParamData%CfAll1)) then + allocate(DstParamData%CfAll1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CfAll1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%CfAll1 = SrcParamData%CfAll1 + else if (allocated(DstParamData%CfAll1)) then + deallocate(DstParamData%CfAll1) + end if + if (allocated(SrcParamData%CfAll2)) then + LB(1:3) = lbound(SrcParamData%CfAll2) + UB(1:3) = ubound(SrcParamData%CfAll2) + if (.not. allocated(DstParamData%CfAll2)) then + allocate(DstParamData%CfAll2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CfAll2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%CfAll2 = SrcParamData%CfAll2 + else if (allocated(DstParamData%CfAll2)) then + deallocate(DstParamData%CfAll2) + end if + if (allocated(SrcParamData%EdgeVelRat1)) then + LB(1:3) = lbound(SrcParamData%EdgeVelRat1) + UB(1:3) = ubound(SrcParamData%EdgeVelRat1) + if (.not. allocated(DstParamData%EdgeVelRat1)) then + allocate(DstParamData%EdgeVelRat1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%EdgeVelRat1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%EdgeVelRat1 = SrcParamData%EdgeVelRat1 + else if (allocated(DstParamData%EdgeVelRat1)) then + deallocate(DstParamData%EdgeVelRat1) + end if + if (allocated(SrcParamData%EdgeVelRat2)) then + LB(1:3) = lbound(SrcParamData%EdgeVelRat2) + UB(1:3) = ubound(SrcParamData%EdgeVelRat2) + if (.not. allocated(DstParamData%EdgeVelRat2)) then + allocate(DstParamData%EdgeVelRat2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%EdgeVelRat2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%EdgeVelRat2 = SrcParamData%EdgeVelRat2 + else if (allocated(DstParamData%EdgeVelRat2)) then + deallocate(DstParamData%EdgeVelRat2) + end if + if (allocated(SrcParamData%AFThickGuida)) then + LB(1:2) = lbound(SrcParamData%AFThickGuida) + UB(1:2) = ubound(SrcParamData%AFThickGuida) + if (.not. allocated(DstParamData%AFThickGuida)) then + allocate(DstParamData%AFThickGuida(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFThickGuida.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AFThickGuida = SrcParamData%AFThickGuida + else if (allocated(DstParamData%AFThickGuida)) then + deallocate(DstParamData%AFThickGuida) + end if +end subroutine +subroutine AA_DestroyParam(ParamData, ErrStat, ErrMsg) + type(AA_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AA_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%rotorregionlimitsVert)) then + deallocate(ParamData%rotorregionlimitsVert) + end if + if (allocated(ParamData%rotorregionlimitsHorz)) then + deallocate(ParamData%rotorregionlimitsHorz) + end if + if (allocated(ParamData%rotorregionlimitsalph)) then + deallocate(ParamData%rotorregionlimitsalph) + end if + if (allocated(ParamData%rotorregionlimitsrad)) then + deallocate(ParamData%rotorregionlimitsrad) + end if + if (allocated(ParamData%ObsX)) then + deallocate(ParamData%ObsX) + end if + if (allocated(ParamData%ObsY)) then + deallocate(ParamData%ObsY) + end if + if (allocated(ParamData%ObsZ)) then + deallocate(ParamData%ObsZ) + end if + if (allocated(ParamData%FreqList)) then + deallocate(ParamData%FreqList) + end if + if (allocated(ParamData%Aweight)) then + deallocate(ParamData%Aweight) + end if + if (allocated(ParamData%TI_Grid_In)) then + deallocate(ParamData%TI_Grid_In) + end if + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%OutParam) + end if + if (allocated(ParamData%StallStart)) then + deallocate(ParamData%StallStart) + end if + if (allocated(ParamData%TEThick)) then + deallocate(ParamData%TEThick) + end if + if (allocated(ParamData%TEAngle)) then + deallocate(ParamData%TEAngle) + end if + if (allocated(ParamData%AerCent)) then + deallocate(ParamData%AerCent) + end if + if (allocated(ParamData%BlAFID)) then + deallocate(ParamData%BlAFID) + end if + if (allocated(ParamData%AFInfo)) then + LB(1:1) = lbound(ParamData%AFInfo) + UB(1:1) = ubound(ParamData%AFInfo) + do i1 = LB(1), UB(1) + call AFI_DestroyParam(ParamData%AFInfo(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%AFInfo) + end if + if (allocated(ParamData%AFLECo)) then + deallocate(ParamData%AFLECo) + end if + if (allocated(ParamData%AFTECo)) then + deallocate(ParamData%AFTECo) + end if + if (allocated(ParamData%BlSpn)) then + deallocate(ParamData%BlSpn) + end if + if (allocated(ParamData%BlChord)) then + deallocate(ParamData%BlChord) + end if + if (allocated(ParamData%ReListBL)) then + deallocate(ParamData%ReListBL) + end if + if (allocated(ParamData%AOAListBL)) then + deallocate(ParamData%AOAListBL) + end if + if (allocated(ParamData%dStarAll1)) then + deallocate(ParamData%dStarAll1) + end if + if (allocated(ParamData%dStarAll2)) then + deallocate(ParamData%dStarAll2) + end if + if (allocated(ParamData%d99All1)) then + deallocate(ParamData%d99All1) + end if + if (allocated(ParamData%d99All2)) then + deallocate(ParamData%d99All2) + end if + if (allocated(ParamData%CfAll1)) then + deallocate(ParamData%CfAll1) + end if + if (allocated(ParamData%CfAll2)) then + deallocate(ParamData%CfAll2) + end if + if (allocated(ParamData%EdgeVelRat1)) then + deallocate(ParamData%EdgeVelRat1) + end if + if (allocated(ParamData%EdgeVelRat2)) then + deallocate(ParamData%EdgeVelRat2) + end if + if (allocated(ParamData%AFThickGuida)) then + deallocate(ParamData%AFThickGuida) + end if +end subroutine subroutine AA_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -3996,212 +3736,156 @@ subroutine AA_PackParam(Buf, Indata) integer(IntKi) :: i1, i2, i3 integer(IntKi) :: LB(3), UB(3) if (Buf%ErrStat >= AbortErrLev) return - ! DT call RegPack(Buf, InData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! IBLUNT call RegPack(Buf, InData%IBLUNT) if (RegCheckErr(Buf, RoutineName)) return - ! ILAM call RegPack(Buf, InData%ILAM) if (RegCheckErr(Buf, RoutineName)) return - ! ITIP call RegPack(Buf, InData%ITIP) if (RegCheckErr(Buf, RoutineName)) return - ! ITRIP call RegPack(Buf, InData%ITRIP) if (RegCheckErr(Buf, RoutineName)) return - ! ITURB call RegPack(Buf, InData%ITURB) if (RegCheckErr(Buf, RoutineName)) return - ! IInflow call RegPack(Buf, InData%IInflow) if (RegCheckErr(Buf, RoutineName)) return - ! X_BLMethod call RegPack(Buf, InData%X_BLMethod) if (RegCheckErr(Buf, RoutineName)) return - ! TICalcMeth call RegPack(Buf, InData%TICalcMeth) if (RegCheckErr(Buf, RoutineName)) return - ! ROUND call RegPack(Buf, InData%ROUND) if (RegCheckErr(Buf, RoutineName)) return - ! ALPRAT call RegPack(Buf, InData%ALPRAT) if (RegCheckErr(Buf, RoutineName)) return - ! NumBlades call RegPack(Buf, InData%NumBlades) if (RegCheckErr(Buf, RoutineName)) return - ! NumBlNds call RegPack(Buf, InData%NumBlNds) if (RegCheckErr(Buf, RoutineName)) return - ! AirDens call RegPack(Buf, InData%AirDens) if (RegCheckErr(Buf, RoutineName)) return - ! KinVisc call RegPack(Buf, InData%KinVisc) if (RegCheckErr(Buf, RoutineName)) return - ! SpdSound call RegPack(Buf, InData%SpdSound) if (RegCheckErr(Buf, RoutineName)) return - ! HubHeight call RegPack(Buf, InData%HubHeight) if (RegCheckErr(Buf, RoutineName)) return - ! toptip call RegPack(Buf, InData%toptip) if (RegCheckErr(Buf, RoutineName)) return - ! bottip call RegPack(Buf, InData%bottip) if (RegCheckErr(Buf, RoutineName)) return - ! rotorregionlimitsVert call RegPack(Buf, allocated(InData%rotorregionlimitsVert)) if (allocated(InData%rotorregionlimitsVert)) then call RegPackBounds(Buf, 1, lbound(InData%rotorregionlimitsVert), ubound(InData%rotorregionlimitsVert)) call RegPack(Buf, InData%rotorregionlimitsVert) end if if (RegCheckErr(Buf, RoutineName)) return - ! rotorregionlimitsHorz call RegPack(Buf, allocated(InData%rotorregionlimitsHorz)) if (allocated(InData%rotorregionlimitsHorz)) then call RegPackBounds(Buf, 1, lbound(InData%rotorregionlimitsHorz), ubound(InData%rotorregionlimitsHorz)) call RegPack(Buf, InData%rotorregionlimitsHorz) end if if (RegCheckErr(Buf, RoutineName)) return - ! rotorregionlimitsalph call RegPack(Buf, allocated(InData%rotorregionlimitsalph)) if (allocated(InData%rotorregionlimitsalph)) then call RegPackBounds(Buf, 1, lbound(InData%rotorregionlimitsalph), ubound(InData%rotorregionlimitsalph)) call RegPack(Buf, InData%rotorregionlimitsalph) end if if (RegCheckErr(Buf, RoutineName)) return - ! rotorregionlimitsrad call RegPack(Buf, allocated(InData%rotorregionlimitsrad)) if (allocated(InData%rotorregionlimitsrad)) then call RegPackBounds(Buf, 1, lbound(InData%rotorregionlimitsrad), ubound(InData%rotorregionlimitsrad)) call RegPack(Buf, InData%rotorregionlimitsrad) end if if (RegCheckErr(Buf, RoutineName)) return - ! NrObsLoc call RegPack(Buf, InData%NrObsLoc) if (RegCheckErr(Buf, RoutineName)) return - ! aweightflag call RegPack(Buf, InData%aweightflag) if (RegCheckErr(Buf, RoutineName)) return - ! TxtFileOutput call RegPack(Buf, InData%TxtFileOutput) if (RegCheckErr(Buf, RoutineName)) return - ! AAStart call RegPack(Buf, InData%AAStart) if (RegCheckErr(Buf, RoutineName)) return - ! ObsX call RegPack(Buf, allocated(InData%ObsX)) if (allocated(InData%ObsX)) then call RegPackBounds(Buf, 1, lbound(InData%ObsX), ubound(InData%ObsX)) call RegPack(Buf, InData%ObsX) end if if (RegCheckErr(Buf, RoutineName)) return - ! ObsY call RegPack(Buf, allocated(InData%ObsY)) if (allocated(InData%ObsY)) then call RegPackBounds(Buf, 1, lbound(InData%ObsY), ubound(InData%ObsY)) call RegPack(Buf, InData%ObsY) end if if (RegCheckErr(Buf, RoutineName)) return - ! ObsZ call RegPack(Buf, allocated(InData%ObsZ)) if (allocated(InData%ObsZ)) then call RegPackBounds(Buf, 1, lbound(InData%ObsZ), ubound(InData%ObsZ)) call RegPack(Buf, InData%ObsZ) end if if (RegCheckErr(Buf, RoutineName)) return - ! FreqList call RegPack(Buf, allocated(InData%FreqList)) if (allocated(InData%FreqList)) then call RegPackBounds(Buf, 1, lbound(InData%FreqList), ubound(InData%FreqList)) call RegPack(Buf, InData%FreqList) end if if (RegCheckErr(Buf, RoutineName)) return - ! Aweight call RegPack(Buf, allocated(InData%Aweight)) if (allocated(InData%Aweight)) then call RegPackBounds(Buf, 1, lbound(InData%Aweight), ubound(InData%Aweight)) call RegPack(Buf, InData%Aweight) end if if (RegCheckErr(Buf, RoutineName)) return - ! Fsample call RegPack(Buf, InData%Fsample) if (RegCheckErr(Buf, RoutineName)) return - ! total_sample call RegPack(Buf, InData%total_sample) if (RegCheckErr(Buf, RoutineName)) return - ! total_sampleTI call RegPack(Buf, InData%total_sampleTI) if (RegCheckErr(Buf, RoutineName)) return - ! AA_Bl_Prcntge call RegPack(Buf, InData%AA_Bl_Prcntge) if (RegCheckErr(Buf, RoutineName)) return - ! startnode call RegPack(Buf, InData%startnode) if (RegCheckErr(Buf, RoutineName)) return - ! Lturb call RegPack(Buf, InData%Lturb) if (RegCheckErr(Buf, RoutineName)) return - ! AvgV call RegPack(Buf, InData%AvgV) if (RegCheckErr(Buf, RoutineName)) return - ! dz_turb_in call RegPack(Buf, InData%dz_turb_in) if (RegCheckErr(Buf, RoutineName)) return - ! dy_turb_in call RegPack(Buf, InData%dy_turb_in) if (RegCheckErr(Buf, RoutineName)) return - ! TI_Grid_In call RegPack(Buf, allocated(InData%TI_Grid_In)) if (allocated(InData%TI_Grid_In)) then call RegPackBounds(Buf, 2, lbound(InData%TI_Grid_In), ubound(InData%TI_Grid_In)) call RegPack(Buf, InData%TI_Grid_In) end if if (RegCheckErr(Buf, RoutineName)) return - ! FTitle call RegPack(Buf, InData%FTitle) if (RegCheckErr(Buf, RoutineName)) return - ! outFmt call RegPack(Buf, InData%outFmt) if (RegCheckErr(Buf, RoutineName)) return - ! NrOutFile call RegPack(Buf, InData%NrOutFile) if (RegCheckErr(Buf, RoutineName)) return - ! delim call RegPack(Buf, InData%delim) if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegPack(Buf, InData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! NumOutsForPE call RegPack(Buf, InData%NumOutsForPE) if (RegCheckErr(Buf, RoutineName)) return - ! NumOutsForSep call RegPack(Buf, InData%NumOutsForSep) if (RegCheckErr(Buf, RoutineName)) return - ! NumOutsForNodes call RegPack(Buf, InData%NumOutsForNodes) if (RegCheckErr(Buf, RoutineName)) return - ! unOutFile call RegPack(Buf, InData%unOutFile) if (RegCheckErr(Buf, RoutineName)) return - ! unOutFile2 call RegPack(Buf, InData%unOutFile2) if (RegCheckErr(Buf, RoutineName)) return - ! unOutFile3 call RegPack(Buf, InData%unOutFile3) if (RegCheckErr(Buf, RoutineName)) return - ! unOutFile4 call RegPack(Buf, InData%unOutFile4) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegPack(Buf, InData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! OutParam call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) @@ -4212,42 +3896,36 @@ subroutine AA_PackParam(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! StallStart call RegPack(Buf, allocated(InData%StallStart)) if (allocated(InData%StallStart)) then call RegPackBounds(Buf, 2, lbound(InData%StallStart), ubound(InData%StallStart)) call RegPack(Buf, InData%StallStart) end if if (RegCheckErr(Buf, RoutineName)) return - ! TEThick call RegPack(Buf, allocated(InData%TEThick)) if (allocated(InData%TEThick)) then call RegPackBounds(Buf, 2, lbound(InData%TEThick), ubound(InData%TEThick)) call RegPack(Buf, InData%TEThick) end if if (RegCheckErr(Buf, RoutineName)) return - ! TEAngle call RegPack(Buf, allocated(InData%TEAngle)) if (allocated(InData%TEAngle)) then call RegPackBounds(Buf, 2, lbound(InData%TEAngle), ubound(InData%TEAngle)) call RegPack(Buf, InData%TEAngle) end if if (RegCheckErr(Buf, RoutineName)) return - ! AerCent call RegPack(Buf, allocated(InData%AerCent)) if (allocated(InData%AerCent)) then call RegPackBounds(Buf, 3, lbound(InData%AerCent), ubound(InData%AerCent)) call RegPack(Buf, InData%AerCent) end if if (RegCheckErr(Buf, RoutineName)) return - ! BlAFID call RegPack(Buf, allocated(InData%BlAFID)) if (allocated(InData%BlAFID)) then call RegPackBounds(Buf, 2, lbound(InData%BlAFID), ubound(InData%BlAFID)) call RegPack(Buf, InData%BlAFID) end if if (RegCheckErr(Buf, RoutineName)) return - ! AFInfo call RegPack(Buf, allocated(InData%AFInfo)) if (allocated(InData%AFInfo)) then call RegPackBounds(Buf, 1, lbound(InData%AFInfo), ubound(InData%AFInfo)) @@ -4258,105 +3936,90 @@ subroutine AA_PackParam(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! AFLECo call RegPack(Buf, allocated(InData%AFLECo)) if (allocated(InData%AFLECo)) then call RegPackBounds(Buf, 3, lbound(InData%AFLECo), ubound(InData%AFLECo)) call RegPack(Buf, InData%AFLECo) end if if (RegCheckErr(Buf, RoutineName)) return - ! AFTECo call RegPack(Buf, allocated(InData%AFTECo)) if (allocated(InData%AFTECo)) then call RegPackBounds(Buf, 3, lbound(InData%AFTECo), ubound(InData%AFTECo)) call RegPack(Buf, InData%AFTECo) end if if (RegCheckErr(Buf, RoutineName)) return - ! BlSpn call RegPack(Buf, allocated(InData%BlSpn)) if (allocated(InData%BlSpn)) then call RegPackBounds(Buf, 2, lbound(InData%BlSpn), ubound(InData%BlSpn)) call RegPack(Buf, InData%BlSpn) end if if (RegCheckErr(Buf, RoutineName)) return - ! BlChord call RegPack(Buf, allocated(InData%BlChord)) if (allocated(InData%BlChord)) then call RegPackBounds(Buf, 2, lbound(InData%BlChord), ubound(InData%BlChord)) call RegPack(Buf, InData%BlChord) end if if (RegCheckErr(Buf, RoutineName)) return - ! ReListBL call RegPack(Buf, allocated(InData%ReListBL)) if (allocated(InData%ReListBL)) then call RegPackBounds(Buf, 1, lbound(InData%ReListBL), ubound(InData%ReListBL)) call RegPack(Buf, InData%ReListBL) end if if (RegCheckErr(Buf, RoutineName)) return - ! AOAListBL call RegPack(Buf, allocated(InData%AOAListBL)) if (allocated(InData%AOAListBL)) then call RegPackBounds(Buf, 1, lbound(InData%AOAListBL), ubound(InData%AOAListBL)) call RegPack(Buf, InData%AOAListBL) end if if (RegCheckErr(Buf, RoutineName)) return - ! dStarAll1 call RegPack(Buf, allocated(InData%dStarAll1)) if (allocated(InData%dStarAll1)) then call RegPackBounds(Buf, 3, lbound(InData%dStarAll1), ubound(InData%dStarAll1)) call RegPack(Buf, InData%dStarAll1) end if if (RegCheckErr(Buf, RoutineName)) return - ! dStarAll2 call RegPack(Buf, allocated(InData%dStarAll2)) if (allocated(InData%dStarAll2)) then call RegPackBounds(Buf, 3, lbound(InData%dStarAll2), ubound(InData%dStarAll2)) call RegPack(Buf, InData%dStarAll2) end if if (RegCheckErr(Buf, RoutineName)) return - ! d99All1 call RegPack(Buf, allocated(InData%d99All1)) if (allocated(InData%d99All1)) then call RegPackBounds(Buf, 3, lbound(InData%d99All1), ubound(InData%d99All1)) call RegPack(Buf, InData%d99All1) end if if (RegCheckErr(Buf, RoutineName)) return - ! d99All2 call RegPack(Buf, allocated(InData%d99All2)) if (allocated(InData%d99All2)) then call RegPackBounds(Buf, 3, lbound(InData%d99All2), ubound(InData%d99All2)) call RegPack(Buf, InData%d99All2) end if if (RegCheckErr(Buf, RoutineName)) return - ! CfAll1 call RegPack(Buf, allocated(InData%CfAll1)) if (allocated(InData%CfAll1)) then call RegPackBounds(Buf, 3, lbound(InData%CfAll1), ubound(InData%CfAll1)) call RegPack(Buf, InData%CfAll1) end if if (RegCheckErr(Buf, RoutineName)) return - ! CfAll2 call RegPack(Buf, allocated(InData%CfAll2)) if (allocated(InData%CfAll2)) then call RegPackBounds(Buf, 3, lbound(InData%CfAll2), ubound(InData%CfAll2)) call RegPack(Buf, InData%CfAll2) end if if (RegCheckErr(Buf, RoutineName)) return - ! EdgeVelRat1 call RegPack(Buf, allocated(InData%EdgeVelRat1)) if (allocated(InData%EdgeVelRat1)) then call RegPackBounds(Buf, 3, lbound(InData%EdgeVelRat1), ubound(InData%EdgeVelRat1)) call RegPack(Buf, InData%EdgeVelRat1) end if if (RegCheckErr(Buf, RoutineName)) return - ! EdgeVelRat2 call RegPack(Buf, allocated(InData%EdgeVelRat2)) if (allocated(InData%EdgeVelRat2)) then call RegPackBounds(Buf, 3, lbound(InData%EdgeVelRat2), ubound(InData%EdgeVelRat2)) call RegPack(Buf, InData%EdgeVelRat2) end if if (RegCheckErr(Buf, RoutineName)) return - ! AFThickGuida call RegPack(Buf, allocated(InData%AFThickGuida)) if (allocated(InData%AFThickGuida)) then call RegPackBounds(Buf, 2, lbound(InData%AFThickGuida), ubound(InData%AFThickGuida)) @@ -4374,64 +4037,44 @@ subroutine AA_UnPackParam(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! DT call RegUnpack(Buf, OutData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! IBLUNT call RegUnpack(Buf, OutData%IBLUNT) if (RegCheckErr(Buf, RoutineName)) return - ! ILAM call RegUnpack(Buf, OutData%ILAM) if (RegCheckErr(Buf, RoutineName)) return - ! ITIP call RegUnpack(Buf, OutData%ITIP) if (RegCheckErr(Buf, RoutineName)) return - ! ITRIP call RegUnpack(Buf, OutData%ITRIP) if (RegCheckErr(Buf, RoutineName)) return - ! ITURB call RegUnpack(Buf, OutData%ITURB) if (RegCheckErr(Buf, RoutineName)) return - ! IInflow call RegUnpack(Buf, OutData%IInflow) if (RegCheckErr(Buf, RoutineName)) return - ! X_BLMethod call RegUnpack(Buf, OutData%X_BLMethod) if (RegCheckErr(Buf, RoutineName)) return - ! TICalcMeth call RegUnpack(Buf, OutData%TICalcMeth) if (RegCheckErr(Buf, RoutineName)) return - ! ROUND call RegUnpack(Buf, OutData%ROUND) if (RegCheckErr(Buf, RoutineName)) return - ! ALPRAT call RegUnpack(Buf, OutData%ALPRAT) if (RegCheckErr(Buf, RoutineName)) return - ! NumBlades call RegUnpack(Buf, OutData%NumBlades) if (RegCheckErr(Buf, RoutineName)) return - ! NumBlNds call RegUnpack(Buf, OutData%NumBlNds) if (RegCheckErr(Buf, RoutineName)) return - ! AirDens call RegUnpack(Buf, OutData%AirDens) if (RegCheckErr(Buf, RoutineName)) return - ! KinVisc call RegUnpack(Buf, OutData%KinVisc) if (RegCheckErr(Buf, RoutineName)) return - ! SpdSound call RegUnpack(Buf, OutData%SpdSound) if (RegCheckErr(Buf, RoutineName)) return - ! HubHeight call RegUnpack(Buf, OutData%HubHeight) if (RegCheckErr(Buf, RoutineName)) return - ! toptip call RegUnpack(Buf, OutData%toptip) if (RegCheckErr(Buf, RoutineName)) return - ! bottip call RegUnpack(Buf, OutData%bottip) if (RegCheckErr(Buf, RoutineName)) return - ! rotorregionlimitsVert if (allocated(OutData%rotorregionlimitsVert)) deallocate(OutData%rotorregionlimitsVert) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4446,7 +4089,6 @@ subroutine AA_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%rotorregionlimitsVert) if (RegCheckErr(Buf, RoutineName)) return end if - ! rotorregionlimitsHorz if (allocated(OutData%rotorregionlimitsHorz)) deallocate(OutData%rotorregionlimitsHorz) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4461,7 +4103,6 @@ subroutine AA_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%rotorregionlimitsHorz) if (RegCheckErr(Buf, RoutineName)) return end if - ! rotorregionlimitsalph if (allocated(OutData%rotorregionlimitsalph)) deallocate(OutData%rotorregionlimitsalph) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4476,7 +4117,6 @@ subroutine AA_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%rotorregionlimitsalph) if (RegCheckErr(Buf, RoutineName)) return end if - ! rotorregionlimitsrad if (allocated(OutData%rotorregionlimitsrad)) deallocate(OutData%rotorregionlimitsrad) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4491,19 +4131,14 @@ subroutine AA_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%rotorregionlimitsrad) if (RegCheckErr(Buf, RoutineName)) return end if - ! NrObsLoc call RegUnpack(Buf, OutData%NrObsLoc) if (RegCheckErr(Buf, RoutineName)) return - ! aweightflag call RegUnpack(Buf, OutData%aweightflag) if (RegCheckErr(Buf, RoutineName)) return - ! TxtFileOutput call RegUnpack(Buf, OutData%TxtFileOutput) if (RegCheckErr(Buf, RoutineName)) return - ! AAStart call RegUnpack(Buf, OutData%AAStart) if (RegCheckErr(Buf, RoutineName)) return - ! ObsX if (allocated(OutData%ObsX)) deallocate(OutData%ObsX) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4518,7 +4153,6 @@ subroutine AA_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%ObsX) if (RegCheckErr(Buf, RoutineName)) return end if - ! ObsY if (allocated(OutData%ObsY)) deallocate(OutData%ObsY) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4533,7 +4167,6 @@ subroutine AA_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%ObsY) if (RegCheckErr(Buf, RoutineName)) return end if - ! ObsZ if (allocated(OutData%ObsZ)) deallocate(OutData%ObsZ) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4548,7 +4181,6 @@ subroutine AA_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%ObsZ) if (RegCheckErr(Buf, RoutineName)) return end if - ! FreqList if (allocated(OutData%FreqList)) deallocate(OutData%FreqList) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4563,7 +4195,6 @@ subroutine AA_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%FreqList) if (RegCheckErr(Buf, RoutineName)) return end if - ! Aweight if (allocated(OutData%Aweight)) deallocate(OutData%Aweight) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4578,34 +4209,24 @@ subroutine AA_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%Aweight) if (RegCheckErr(Buf, RoutineName)) return end if - ! Fsample call RegUnpack(Buf, OutData%Fsample) if (RegCheckErr(Buf, RoutineName)) return - ! total_sample call RegUnpack(Buf, OutData%total_sample) if (RegCheckErr(Buf, RoutineName)) return - ! total_sampleTI call RegUnpack(Buf, OutData%total_sampleTI) if (RegCheckErr(Buf, RoutineName)) return - ! AA_Bl_Prcntge call RegUnpack(Buf, OutData%AA_Bl_Prcntge) if (RegCheckErr(Buf, RoutineName)) return - ! startnode call RegUnpack(Buf, OutData%startnode) if (RegCheckErr(Buf, RoutineName)) return - ! Lturb call RegUnpack(Buf, OutData%Lturb) if (RegCheckErr(Buf, RoutineName)) return - ! AvgV call RegUnpack(Buf, OutData%AvgV) if (RegCheckErr(Buf, RoutineName)) return - ! dz_turb_in call RegUnpack(Buf, OutData%dz_turb_in) if (RegCheckErr(Buf, RoutineName)) return - ! dy_turb_in call RegUnpack(Buf, OutData%dy_turb_in) if (RegCheckErr(Buf, RoutineName)) return - ! TI_Grid_In if (allocated(OutData%TI_Grid_In)) deallocate(OutData%TI_Grid_In) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4620,46 +4241,32 @@ subroutine AA_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%TI_Grid_In) if (RegCheckErr(Buf, RoutineName)) return end if - ! FTitle call RegUnpack(Buf, OutData%FTitle) if (RegCheckErr(Buf, RoutineName)) return - ! outFmt call RegUnpack(Buf, OutData%outFmt) if (RegCheckErr(Buf, RoutineName)) return - ! NrOutFile call RegUnpack(Buf, OutData%NrOutFile) if (RegCheckErr(Buf, RoutineName)) return - ! delim call RegUnpack(Buf, OutData%delim) if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegUnpack(Buf, OutData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! NumOutsForPE call RegUnpack(Buf, OutData%NumOutsForPE) if (RegCheckErr(Buf, RoutineName)) return - ! NumOutsForSep call RegUnpack(Buf, OutData%NumOutsForSep) if (RegCheckErr(Buf, RoutineName)) return - ! NumOutsForNodes call RegUnpack(Buf, OutData%NumOutsForNodes) if (RegCheckErr(Buf, RoutineName)) return - ! unOutFile call RegUnpack(Buf, OutData%unOutFile) if (RegCheckErr(Buf, RoutineName)) return - ! unOutFile2 call RegUnpack(Buf, OutData%unOutFile2) if (RegCheckErr(Buf, RoutineName)) return - ! unOutFile3 call RegUnpack(Buf, OutData%unOutFile3) if (RegCheckErr(Buf, RoutineName)) return - ! unOutFile4 call RegUnpack(Buf, OutData%unOutFile4) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegUnpack(Buf, OutData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! OutParam if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4675,7 +4282,6 @@ subroutine AA_UnPackParam(Buf, OutData) call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam end do end if - ! StallStart if (allocated(OutData%StallStart)) deallocate(OutData%StallStart) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4690,7 +4296,6 @@ subroutine AA_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%StallStart) if (RegCheckErr(Buf, RoutineName)) return end if - ! TEThick if (allocated(OutData%TEThick)) deallocate(OutData%TEThick) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4705,7 +4310,6 @@ subroutine AA_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%TEThick) if (RegCheckErr(Buf, RoutineName)) return end if - ! TEAngle if (allocated(OutData%TEAngle)) deallocate(OutData%TEAngle) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4720,7 +4324,6 @@ subroutine AA_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%TEAngle) if (RegCheckErr(Buf, RoutineName)) return end if - ! AerCent if (allocated(OutData%AerCent)) deallocate(OutData%AerCent) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4735,7 +4338,6 @@ subroutine AA_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%AerCent) if (RegCheckErr(Buf, RoutineName)) return end if - ! BlAFID if (allocated(OutData%BlAFID)) deallocate(OutData%BlAFID) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4750,7 +4352,6 @@ subroutine AA_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%BlAFID) if (RegCheckErr(Buf, RoutineName)) return end if - ! AFInfo if (allocated(OutData%AFInfo)) deallocate(OutData%AFInfo) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4766,7 +4367,6 @@ subroutine AA_UnPackParam(Buf, OutData) call AFI_UnpackParam(Buf, OutData%AFInfo(i1)) ! AFInfo end do end if - ! AFLECo if (allocated(OutData%AFLECo)) deallocate(OutData%AFLECo) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4781,7 +4381,6 @@ subroutine AA_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%AFLECo) if (RegCheckErr(Buf, RoutineName)) return end if - ! AFTECo if (allocated(OutData%AFTECo)) deallocate(OutData%AFTECo) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4796,7 +4395,6 @@ subroutine AA_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%AFTECo) if (RegCheckErr(Buf, RoutineName)) return end if - ! BlSpn if (allocated(OutData%BlSpn)) deallocate(OutData%BlSpn) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4811,7 +4409,6 @@ subroutine AA_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%BlSpn) if (RegCheckErr(Buf, RoutineName)) return end if - ! BlChord if (allocated(OutData%BlChord)) deallocate(OutData%BlChord) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4826,7 +4423,6 @@ subroutine AA_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%BlChord) if (RegCheckErr(Buf, RoutineName)) return end if - ! ReListBL if (allocated(OutData%ReListBL)) deallocate(OutData%ReListBL) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4841,7 +4437,6 @@ subroutine AA_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%ReListBL) if (RegCheckErr(Buf, RoutineName)) return end if - ! AOAListBL if (allocated(OutData%AOAListBL)) deallocate(OutData%AOAListBL) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4856,7 +4451,6 @@ subroutine AA_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%AOAListBL) if (RegCheckErr(Buf, RoutineName)) return end if - ! dStarAll1 if (allocated(OutData%dStarAll1)) deallocate(OutData%dStarAll1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4871,7 +4465,6 @@ subroutine AA_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%dStarAll1) if (RegCheckErr(Buf, RoutineName)) return end if - ! dStarAll2 if (allocated(OutData%dStarAll2)) deallocate(OutData%dStarAll2) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4886,7 +4479,6 @@ subroutine AA_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%dStarAll2) if (RegCheckErr(Buf, RoutineName)) return end if - ! d99All1 if (allocated(OutData%d99All1)) deallocate(OutData%d99All1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4901,7 +4493,6 @@ subroutine AA_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%d99All1) if (RegCheckErr(Buf, RoutineName)) return end if - ! d99All2 if (allocated(OutData%d99All2)) deallocate(OutData%d99All2) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4916,7 +4507,6 @@ subroutine AA_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%d99All2) if (RegCheckErr(Buf, RoutineName)) return end if - ! CfAll1 if (allocated(OutData%CfAll1)) deallocate(OutData%CfAll1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4931,7 +4521,6 @@ subroutine AA_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%CfAll1) if (RegCheckErr(Buf, RoutineName)) return end if - ! CfAll2 if (allocated(OutData%CfAll2)) deallocate(OutData%CfAll2) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4946,7 +4535,6 @@ subroutine AA_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%CfAll2) if (RegCheckErr(Buf, RoutineName)) return end if - ! EdgeVelRat1 if (allocated(OutData%EdgeVelRat1)) deallocate(OutData%EdgeVelRat1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4961,7 +4549,6 @@ subroutine AA_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%EdgeVelRat1) if (RegCheckErr(Buf, RoutineName)) return end if - ! EdgeVelRat2 if (allocated(OutData%EdgeVelRat2)) deallocate(OutData%EdgeVelRat2) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4976,7 +4563,6 @@ subroutine AA_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%EdgeVelRat2) if (RegCheckErr(Buf, RoutineName)) return end if - ! AFThickGuida if (allocated(OutData%AFThickGuida)) deallocate(OutData%AFThickGuida) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4992,169 +4578,143 @@ subroutine AA_UnPackParam(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE AA_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_InputType), INTENT(IN) :: SrcInputData - TYPE(AA_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_CopyInput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInputData%RotGtoL)) THEN - i1_l = LBOUND(SrcInputData%RotGtoL,1) - i1_u = UBOUND(SrcInputData%RotGtoL,1) - i2_l = LBOUND(SrcInputData%RotGtoL,2) - i2_u = UBOUND(SrcInputData%RotGtoL,2) - i3_l = LBOUND(SrcInputData%RotGtoL,3) - i3_u = UBOUND(SrcInputData%RotGtoL,3) - i4_l = LBOUND(SrcInputData%RotGtoL,4) - i4_u = UBOUND(SrcInputData%RotGtoL,4) - IF (.NOT. ALLOCATED(DstInputData%RotGtoL)) THEN - ALLOCATE(DstInputData%RotGtoL(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%RotGtoL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%RotGtoL = SrcInputData%RotGtoL -ENDIF -IF (ALLOCATED(SrcInputData%AeroCent_G)) THEN - i1_l = LBOUND(SrcInputData%AeroCent_G,1) - i1_u = UBOUND(SrcInputData%AeroCent_G,1) - i2_l = LBOUND(SrcInputData%AeroCent_G,2) - i2_u = UBOUND(SrcInputData%AeroCent_G,2) - i3_l = LBOUND(SrcInputData%AeroCent_G,3) - i3_u = UBOUND(SrcInputData%AeroCent_G,3) - IF (.NOT. ALLOCATED(DstInputData%AeroCent_G)) THEN - ALLOCATE(DstInputData%AeroCent_G(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%AeroCent_G.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%AeroCent_G = SrcInputData%AeroCent_G -ENDIF -IF (ALLOCATED(SrcInputData%Vrel)) THEN - i1_l = LBOUND(SrcInputData%Vrel,1) - i1_u = UBOUND(SrcInputData%Vrel,1) - i2_l = LBOUND(SrcInputData%Vrel,2) - i2_u = UBOUND(SrcInputData%Vrel,2) - IF (.NOT. ALLOCATED(DstInputData%Vrel)) THEN - ALLOCATE(DstInputData%Vrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Vrel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%Vrel = SrcInputData%Vrel -ENDIF -IF (ALLOCATED(SrcInputData%AoANoise)) THEN - i1_l = LBOUND(SrcInputData%AoANoise,1) - i1_u = UBOUND(SrcInputData%AoANoise,1) - i2_l = LBOUND(SrcInputData%AoANoise,2) - i2_u = UBOUND(SrcInputData%AoANoise,2) - IF (.NOT. ALLOCATED(DstInputData%AoANoise)) THEN - ALLOCATE(DstInputData%AoANoise(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%AoANoise.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%AoANoise = SrcInputData%AoANoise -ENDIF -IF (ALLOCATED(SrcInputData%Inflow)) THEN - i1_l = LBOUND(SrcInputData%Inflow,1) - i1_u = UBOUND(SrcInputData%Inflow,1) - i2_l = LBOUND(SrcInputData%Inflow,2) - i2_u = UBOUND(SrcInputData%Inflow,2) - i3_l = LBOUND(SrcInputData%Inflow,3) - i3_u = UBOUND(SrcInputData%Inflow,3) - IF (.NOT. ALLOCATED(DstInputData%Inflow)) THEN - ALLOCATE(DstInputData%Inflow(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Inflow.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%Inflow = SrcInputData%Inflow -ENDIF - END SUBROUTINE AA_CopyInput - - SUBROUTINE AA_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(AA_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyInput' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputData%RotGtoL)) THEN - DEALLOCATE(InputData%RotGtoL) -ENDIF -IF (ALLOCATED(InputData%AeroCent_G)) THEN - DEALLOCATE(InputData%AeroCent_G) -ENDIF -IF (ALLOCATED(InputData%Vrel)) THEN - DEALLOCATE(InputData%Vrel) -ENDIF -IF (ALLOCATED(InputData%AoANoise)) THEN - DEALLOCATE(InputData%AoANoise) -ENDIF -IF (ALLOCATED(InputData%Inflow)) THEN - DEALLOCATE(InputData%Inflow) -ENDIF - END SUBROUTINE AA_DestroyInput +subroutine AA_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(AA_InputType), intent(in) :: SrcInputData + type(AA_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AA_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInputData%RotGtoL)) then + LB(1:4) = lbound(SrcInputData%RotGtoL) + UB(1:4) = ubound(SrcInputData%RotGtoL) + if (.not. allocated(DstInputData%RotGtoL)) then + allocate(DstInputData%RotGtoL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%RotGtoL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%RotGtoL = SrcInputData%RotGtoL + else if (allocated(DstInputData%RotGtoL)) then + deallocate(DstInputData%RotGtoL) + end if + if (allocated(SrcInputData%AeroCent_G)) then + LB(1:3) = lbound(SrcInputData%AeroCent_G) + UB(1:3) = ubound(SrcInputData%AeroCent_G) + if (.not. allocated(DstInputData%AeroCent_G)) then + allocate(DstInputData%AeroCent_G(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%AeroCent_G.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%AeroCent_G = SrcInputData%AeroCent_G + else if (allocated(DstInputData%AeroCent_G)) then + deallocate(DstInputData%AeroCent_G) + end if + if (allocated(SrcInputData%Vrel)) then + LB(1:2) = lbound(SrcInputData%Vrel) + UB(1:2) = ubound(SrcInputData%Vrel) + if (.not. allocated(DstInputData%Vrel)) then + allocate(DstInputData%Vrel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Vrel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%Vrel = SrcInputData%Vrel + else if (allocated(DstInputData%Vrel)) then + deallocate(DstInputData%Vrel) + end if + if (allocated(SrcInputData%AoANoise)) then + LB(1:2) = lbound(SrcInputData%AoANoise) + UB(1:2) = ubound(SrcInputData%AoANoise) + if (.not. allocated(DstInputData%AoANoise)) then + allocate(DstInputData%AoANoise(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%AoANoise.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%AoANoise = SrcInputData%AoANoise + else if (allocated(DstInputData%AoANoise)) then + deallocate(DstInputData%AoANoise) + end if + if (allocated(SrcInputData%Inflow)) then + LB(1:3) = lbound(SrcInputData%Inflow) + UB(1:3) = ubound(SrcInputData%Inflow) + if (.not. allocated(DstInputData%Inflow)) then + allocate(DstInputData%Inflow(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Inflow.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%Inflow = SrcInputData%Inflow + else if (allocated(DstInputData%Inflow)) then + deallocate(DstInputData%Inflow) + end if +end subroutine +subroutine AA_DestroyInput(InputData, ErrStat, ErrMsg) + type(AA_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AA_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%RotGtoL)) then + deallocate(InputData%RotGtoL) + end if + if (allocated(InputData%AeroCent_G)) then + deallocate(InputData%AeroCent_G) + end if + if (allocated(InputData%Vrel)) then + deallocate(InputData%Vrel) + end if + if (allocated(InputData%AoANoise)) then + deallocate(InputData%AoANoise) + end if + if (allocated(InputData%Inflow)) then + deallocate(InputData%Inflow) + end if +end subroutine subroutine AA_PackInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AA_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AA_PackInput' if (Buf%ErrStat >= AbortErrLev) return - ! RotGtoL call RegPack(Buf, allocated(InData%RotGtoL)) if (allocated(InData%RotGtoL)) then call RegPackBounds(Buf, 4, lbound(InData%RotGtoL), ubound(InData%RotGtoL)) call RegPack(Buf, InData%RotGtoL) end if if (RegCheckErr(Buf, RoutineName)) return - ! AeroCent_G call RegPack(Buf, allocated(InData%AeroCent_G)) if (allocated(InData%AeroCent_G)) then call RegPackBounds(Buf, 3, lbound(InData%AeroCent_G), ubound(InData%AeroCent_G)) call RegPack(Buf, InData%AeroCent_G) end if if (RegCheckErr(Buf, RoutineName)) return - ! Vrel call RegPack(Buf, allocated(InData%Vrel)) if (allocated(InData%Vrel)) then call RegPackBounds(Buf, 2, lbound(InData%Vrel), ubound(InData%Vrel)) call RegPack(Buf, InData%Vrel) end if if (RegCheckErr(Buf, RoutineName)) return - ! AoANoise call RegPack(Buf, allocated(InData%AoANoise)) if (allocated(InData%AoANoise)) then call RegPackBounds(Buf, 2, lbound(InData%AoANoise), ubound(InData%AoANoise)) call RegPack(Buf, InData%AoANoise) end if if (RegCheckErr(Buf, RoutineName)) return - ! Inflow call RegPack(Buf, allocated(InData%Inflow)) if (allocated(InData%Inflow)) then call RegPackBounds(Buf, 3, lbound(InData%Inflow), ubound(InData%Inflow)) @@ -5171,7 +4731,6 @@ subroutine AA_UnPackInput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! RotGtoL if (allocated(OutData%RotGtoL)) deallocate(OutData%RotGtoL) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5186,7 +4745,6 @@ subroutine AA_UnPackInput(Buf, OutData) call RegUnpack(Buf, OutData%RotGtoL) if (RegCheckErr(Buf, RoutineName)) return end if - ! AeroCent_G if (allocated(OutData%AeroCent_G)) deallocate(OutData%AeroCent_G) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5201,7 +4759,6 @@ subroutine AA_UnPackInput(Buf, OutData) call RegUnpack(Buf, OutData%AeroCent_G) if (RegCheckErr(Buf, RoutineName)) return end if - ! Vrel if (allocated(OutData%Vrel)) deallocate(OutData%Vrel) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5216,7 +4773,6 @@ subroutine AA_UnPackInput(Buf, OutData) call RegUnpack(Buf, OutData%Vrel) if (RegCheckErr(Buf, RoutineName)) return end if - ! AoANoise if (allocated(OutData%AoANoise)) deallocate(OutData%AoANoise) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5231,7 +4787,6 @@ subroutine AA_UnPackInput(Buf, OutData) call RegUnpack(Buf, OutData%AoANoise) if (RegCheckErr(Buf, RoutineName)) return end if - ! Inflow if (allocated(OutData%Inflow)) deallocate(OutData%Inflow) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5247,309 +4802,281 @@ subroutine AA_UnPackInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE AA_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_OutputType), INTENT(IN) :: SrcOutputData - TYPE(AA_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_CopyOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%SumSpecNoise)) THEN - i1_l = LBOUND(SrcOutputData%SumSpecNoise,1) - i1_u = UBOUND(SrcOutputData%SumSpecNoise,1) - i2_l = LBOUND(SrcOutputData%SumSpecNoise,2) - i2_u = UBOUND(SrcOutputData%SumSpecNoise,2) - i3_l = LBOUND(SrcOutputData%SumSpecNoise,3) - i3_u = UBOUND(SrcOutputData%SumSpecNoise,3) - IF (.NOT. ALLOCATED(DstOutputData%SumSpecNoise)) THEN - ALLOCATE(DstOutputData%SumSpecNoise(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%SumSpecNoise.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%SumSpecNoise = SrcOutputData%SumSpecNoise -ENDIF -IF (ALLOCATED(SrcOutputData%SumSpecNoiseSep)) THEN - i1_l = LBOUND(SrcOutputData%SumSpecNoiseSep,1) - i1_u = UBOUND(SrcOutputData%SumSpecNoiseSep,1) - i2_l = LBOUND(SrcOutputData%SumSpecNoiseSep,2) - i2_u = UBOUND(SrcOutputData%SumSpecNoiseSep,2) - i3_l = LBOUND(SrcOutputData%SumSpecNoiseSep,3) - i3_u = UBOUND(SrcOutputData%SumSpecNoiseSep,3) - IF (.NOT. ALLOCATED(DstOutputData%SumSpecNoiseSep)) THEN - ALLOCATE(DstOutputData%SumSpecNoiseSep(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%SumSpecNoiseSep.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%SumSpecNoiseSep = SrcOutputData%SumSpecNoiseSep -ENDIF -IF (ALLOCATED(SrcOutputData%OASPL)) THEN - i1_l = LBOUND(SrcOutputData%OASPL,1) - i1_u = UBOUND(SrcOutputData%OASPL,1) - i2_l = LBOUND(SrcOutputData%OASPL,2) - i2_u = UBOUND(SrcOutputData%OASPL,2) - i3_l = LBOUND(SrcOutputData%OASPL,3) - i3_u = UBOUND(SrcOutputData%OASPL,3) - IF (.NOT. ALLOCATED(DstOutputData%OASPL)) THEN - ALLOCATE(DstOutputData%OASPL(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%OASPL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%OASPL = SrcOutputData%OASPL -ENDIF -IF (ALLOCATED(SrcOutputData%OASPL_Mech)) THEN - i1_l = LBOUND(SrcOutputData%OASPL_Mech,1) - i1_u = UBOUND(SrcOutputData%OASPL_Mech,1) - i2_l = LBOUND(SrcOutputData%OASPL_Mech,2) - i2_u = UBOUND(SrcOutputData%OASPL_Mech,2) - i3_l = LBOUND(SrcOutputData%OASPL_Mech,3) - i3_u = UBOUND(SrcOutputData%OASPL_Mech,3) - i4_l = LBOUND(SrcOutputData%OASPL_Mech,4) - i4_u = UBOUND(SrcOutputData%OASPL_Mech,4) - IF (.NOT. ALLOCATED(DstOutputData%OASPL_Mech)) THEN - ALLOCATE(DstOutputData%OASPL_Mech(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%OASPL_Mech.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%OASPL_Mech = SrcOutputData%OASPL_Mech -ENDIF -IF (ALLOCATED(SrcOutputData%DirectiviOutput)) THEN - i1_l = LBOUND(SrcOutputData%DirectiviOutput,1) - i1_u = UBOUND(SrcOutputData%DirectiviOutput,1) - IF (.NOT. ALLOCATED(DstOutputData%DirectiviOutput)) THEN - ALLOCATE(DstOutputData%DirectiviOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%DirectiviOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%DirectiviOutput = SrcOutputData%DirectiviOutput -ENDIF -IF (ALLOCATED(SrcOutputData%OutLECoords)) THEN - i1_l = LBOUND(SrcOutputData%OutLECoords,1) - i1_u = UBOUND(SrcOutputData%OutLECoords,1) - i2_l = LBOUND(SrcOutputData%OutLECoords,2) - i2_u = UBOUND(SrcOutputData%OutLECoords,2) - i3_l = LBOUND(SrcOutputData%OutLECoords,3) - i3_u = UBOUND(SrcOutputData%OutLECoords,3) - i4_l = LBOUND(SrcOutputData%OutLECoords,4) - i4_u = UBOUND(SrcOutputData%OutLECoords,4) - IF (.NOT. ALLOCATED(DstOutputData%OutLECoords)) THEN - ALLOCATE(DstOutputData%OutLECoords(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%OutLECoords.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%OutLECoords = SrcOutputData%OutLECoords -ENDIF -IF (ALLOCATED(SrcOutputData%PtotalFreq)) THEN - i1_l = LBOUND(SrcOutputData%PtotalFreq,1) - i1_u = UBOUND(SrcOutputData%PtotalFreq,1) - i2_l = LBOUND(SrcOutputData%PtotalFreq,2) - i2_u = UBOUND(SrcOutputData%PtotalFreq,2) - IF (.NOT. ALLOCATED(DstOutputData%PtotalFreq)) THEN - ALLOCATE(DstOutputData%PtotalFreq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%PtotalFreq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%PtotalFreq = SrcOutputData%PtotalFreq -ENDIF -IF (ALLOCATED(SrcOutputData%WriteOutputForPE)) THEN - i1_l = LBOUND(SrcOutputData%WriteOutputForPE,1) - i1_u = UBOUND(SrcOutputData%WriteOutputForPE,1) - IF (.NOT. ALLOCATED(DstOutputData%WriteOutputForPE)) THEN - ALLOCATE(DstOutputData%WriteOutputForPE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutputForPE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%WriteOutputForPE = SrcOutputData%WriteOutputForPE -ENDIF -IF (ALLOCATED(SrcOutputData%WriteOutput)) THEN - i1_l = LBOUND(SrcOutputData%WriteOutput,1) - i1_u = UBOUND(SrcOutputData%WriteOutput,1) - IF (.NOT. ALLOCATED(DstOutputData%WriteOutput)) THEN - ALLOCATE(DstOutputData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%WriteOutput = SrcOutputData%WriteOutput -ENDIF -IF (ALLOCATED(SrcOutputData%WriteOutputSep)) THEN - i1_l = LBOUND(SrcOutputData%WriteOutputSep,1) - i1_u = UBOUND(SrcOutputData%WriteOutputSep,1) - IF (.NOT. ALLOCATED(DstOutputData%WriteOutputSep)) THEN - ALLOCATE(DstOutputData%WriteOutputSep(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutputSep.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%WriteOutputSep = SrcOutputData%WriteOutputSep -ENDIF -IF (ALLOCATED(SrcOutputData%WriteOutputNode)) THEN - i1_l = LBOUND(SrcOutputData%WriteOutputNode,1) - i1_u = UBOUND(SrcOutputData%WriteOutputNode,1) - IF (.NOT. ALLOCATED(DstOutputData%WriteOutputNode)) THEN - ALLOCATE(DstOutputData%WriteOutputNode(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutputNode.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%WriteOutputNode = SrcOutputData%WriteOutputNode -ENDIF - END SUBROUTINE AA_CopyOutput - - SUBROUTINE AA_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(AA_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(OutputData%SumSpecNoise)) THEN - DEALLOCATE(OutputData%SumSpecNoise) -ENDIF -IF (ALLOCATED(OutputData%SumSpecNoiseSep)) THEN - DEALLOCATE(OutputData%SumSpecNoiseSep) -ENDIF -IF (ALLOCATED(OutputData%OASPL)) THEN - DEALLOCATE(OutputData%OASPL) -ENDIF -IF (ALLOCATED(OutputData%OASPL_Mech)) THEN - DEALLOCATE(OutputData%OASPL_Mech) -ENDIF -IF (ALLOCATED(OutputData%DirectiviOutput)) THEN - DEALLOCATE(OutputData%DirectiviOutput) -ENDIF -IF (ALLOCATED(OutputData%OutLECoords)) THEN - DEALLOCATE(OutputData%OutLECoords) -ENDIF -IF (ALLOCATED(OutputData%PtotalFreq)) THEN - DEALLOCATE(OutputData%PtotalFreq) -ENDIF -IF (ALLOCATED(OutputData%WriteOutputForPE)) THEN - DEALLOCATE(OutputData%WriteOutputForPE) -ENDIF -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF -IF (ALLOCATED(OutputData%WriteOutputSep)) THEN - DEALLOCATE(OutputData%WriteOutputSep) -ENDIF -IF (ALLOCATED(OutputData%WriteOutputNode)) THEN - DEALLOCATE(OutputData%WriteOutputNode) -ENDIF - END SUBROUTINE AA_DestroyOutput +subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(AA_OutputType), intent(in) :: SrcOutputData + type(AA_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AA_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%SumSpecNoise)) then + LB(1:3) = lbound(SrcOutputData%SumSpecNoise) + UB(1:3) = ubound(SrcOutputData%SumSpecNoise) + if (.not. allocated(DstOutputData%SumSpecNoise)) then + allocate(DstOutputData%SumSpecNoise(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%SumSpecNoise.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%SumSpecNoise = SrcOutputData%SumSpecNoise + else if (allocated(DstOutputData%SumSpecNoise)) then + deallocate(DstOutputData%SumSpecNoise) + end if + if (allocated(SrcOutputData%SumSpecNoiseSep)) then + LB(1:3) = lbound(SrcOutputData%SumSpecNoiseSep) + UB(1:3) = ubound(SrcOutputData%SumSpecNoiseSep) + if (.not. allocated(DstOutputData%SumSpecNoiseSep)) then + allocate(DstOutputData%SumSpecNoiseSep(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%SumSpecNoiseSep.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%SumSpecNoiseSep = SrcOutputData%SumSpecNoiseSep + else if (allocated(DstOutputData%SumSpecNoiseSep)) then + deallocate(DstOutputData%SumSpecNoiseSep) + end if + if (allocated(SrcOutputData%OASPL)) then + LB(1:3) = lbound(SrcOutputData%OASPL) + UB(1:3) = ubound(SrcOutputData%OASPL) + if (.not. allocated(DstOutputData%OASPL)) then + allocate(DstOutputData%OASPL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%OASPL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%OASPL = SrcOutputData%OASPL + else if (allocated(DstOutputData%OASPL)) then + deallocate(DstOutputData%OASPL) + end if + if (allocated(SrcOutputData%OASPL_Mech)) then + LB(1:4) = lbound(SrcOutputData%OASPL_Mech) + UB(1:4) = ubound(SrcOutputData%OASPL_Mech) + if (.not. allocated(DstOutputData%OASPL_Mech)) then + allocate(DstOutputData%OASPL_Mech(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%OASPL_Mech.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%OASPL_Mech = SrcOutputData%OASPL_Mech + else if (allocated(DstOutputData%OASPL_Mech)) then + deallocate(DstOutputData%OASPL_Mech) + end if + if (allocated(SrcOutputData%DirectiviOutput)) then + LB(1:1) = lbound(SrcOutputData%DirectiviOutput) + UB(1:1) = ubound(SrcOutputData%DirectiviOutput) + if (.not. allocated(DstOutputData%DirectiviOutput)) then + allocate(DstOutputData%DirectiviOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%DirectiviOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%DirectiviOutput = SrcOutputData%DirectiviOutput + else if (allocated(DstOutputData%DirectiviOutput)) then + deallocate(DstOutputData%DirectiviOutput) + end if + if (allocated(SrcOutputData%OutLECoords)) then + LB(1:4) = lbound(SrcOutputData%OutLECoords) + UB(1:4) = ubound(SrcOutputData%OutLECoords) + if (.not. allocated(DstOutputData%OutLECoords)) then + allocate(DstOutputData%OutLECoords(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%OutLECoords.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%OutLECoords = SrcOutputData%OutLECoords + else if (allocated(DstOutputData%OutLECoords)) then + deallocate(DstOutputData%OutLECoords) + end if + if (allocated(SrcOutputData%PtotalFreq)) then + LB(1:2) = lbound(SrcOutputData%PtotalFreq) + UB(1:2) = ubound(SrcOutputData%PtotalFreq) + if (.not. allocated(DstOutputData%PtotalFreq)) then + allocate(DstOutputData%PtotalFreq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%PtotalFreq.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%PtotalFreq = SrcOutputData%PtotalFreq + else if (allocated(DstOutputData%PtotalFreq)) then + deallocate(DstOutputData%PtotalFreq) + end if + if (allocated(SrcOutputData%WriteOutputForPE)) then + LB(1:1) = lbound(SrcOutputData%WriteOutputForPE) + UB(1:1) = ubound(SrcOutputData%WriteOutputForPE) + if (.not. allocated(DstOutputData%WriteOutputForPE)) then + allocate(DstOutputData%WriteOutputForPE(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutputForPE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%WriteOutputForPE = SrcOutputData%WriteOutputForPE + else if (allocated(DstOutputData%WriteOutputForPE)) then + deallocate(DstOutputData%WriteOutputForPE) + end if + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%WriteOutput = SrcOutputData%WriteOutput + else if (allocated(DstOutputData%WriteOutput)) then + deallocate(DstOutputData%WriteOutput) + end if + if (allocated(SrcOutputData%WriteOutputSep)) then + LB(1:1) = lbound(SrcOutputData%WriteOutputSep) + UB(1:1) = ubound(SrcOutputData%WriteOutputSep) + if (.not. allocated(DstOutputData%WriteOutputSep)) then + allocate(DstOutputData%WriteOutputSep(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutputSep.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%WriteOutputSep = SrcOutputData%WriteOutputSep + else if (allocated(DstOutputData%WriteOutputSep)) then + deallocate(DstOutputData%WriteOutputSep) + end if + if (allocated(SrcOutputData%WriteOutputNode)) then + LB(1:1) = lbound(SrcOutputData%WriteOutputNode) + UB(1:1) = ubound(SrcOutputData%WriteOutputNode) + if (.not. allocated(DstOutputData%WriteOutputNode)) then + allocate(DstOutputData%WriteOutputNode(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutputNode.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%WriteOutputNode = SrcOutputData%WriteOutputNode + else if (allocated(DstOutputData%WriteOutputNode)) then + deallocate(DstOutputData%WriteOutputNode) + end if +end subroutine +subroutine AA_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(AA_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AA_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%SumSpecNoise)) then + deallocate(OutputData%SumSpecNoise) + end if + if (allocated(OutputData%SumSpecNoiseSep)) then + deallocate(OutputData%SumSpecNoiseSep) + end if + if (allocated(OutputData%OASPL)) then + deallocate(OutputData%OASPL) + end if + if (allocated(OutputData%OASPL_Mech)) then + deallocate(OutputData%OASPL_Mech) + end if + if (allocated(OutputData%DirectiviOutput)) then + deallocate(OutputData%DirectiviOutput) + end if + if (allocated(OutputData%OutLECoords)) then + deallocate(OutputData%OutLECoords) + end if + if (allocated(OutputData%PtotalFreq)) then + deallocate(OutputData%PtotalFreq) + end if + if (allocated(OutputData%WriteOutputForPE)) then + deallocate(OutputData%WriteOutputForPE) + end if + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if + if (allocated(OutputData%WriteOutputSep)) then + deallocate(OutputData%WriteOutputSep) + end if + if (allocated(OutputData%WriteOutputNode)) then + deallocate(OutputData%WriteOutputNode) + end if +end subroutine subroutine AA_PackOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AA_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AA_PackOutput' if (Buf%ErrStat >= AbortErrLev) return - ! SumSpecNoise call RegPack(Buf, allocated(InData%SumSpecNoise)) if (allocated(InData%SumSpecNoise)) then call RegPackBounds(Buf, 3, lbound(InData%SumSpecNoise), ubound(InData%SumSpecNoise)) call RegPack(Buf, InData%SumSpecNoise) end if if (RegCheckErr(Buf, RoutineName)) return - ! SumSpecNoiseSep call RegPack(Buf, allocated(InData%SumSpecNoiseSep)) if (allocated(InData%SumSpecNoiseSep)) then call RegPackBounds(Buf, 3, lbound(InData%SumSpecNoiseSep), ubound(InData%SumSpecNoiseSep)) call RegPack(Buf, InData%SumSpecNoiseSep) end if if (RegCheckErr(Buf, RoutineName)) return - ! OASPL call RegPack(Buf, allocated(InData%OASPL)) if (allocated(InData%OASPL)) then call RegPackBounds(Buf, 3, lbound(InData%OASPL), ubound(InData%OASPL)) call RegPack(Buf, InData%OASPL) end if if (RegCheckErr(Buf, RoutineName)) return - ! OASPL_Mech call RegPack(Buf, allocated(InData%OASPL_Mech)) if (allocated(InData%OASPL_Mech)) then call RegPackBounds(Buf, 4, lbound(InData%OASPL_Mech), ubound(InData%OASPL_Mech)) call RegPack(Buf, InData%OASPL_Mech) end if if (RegCheckErr(Buf, RoutineName)) return - ! DirectiviOutput call RegPack(Buf, allocated(InData%DirectiviOutput)) if (allocated(InData%DirectiviOutput)) then call RegPackBounds(Buf, 1, lbound(InData%DirectiviOutput), ubound(InData%DirectiviOutput)) call RegPack(Buf, InData%DirectiviOutput) end if if (RegCheckErr(Buf, RoutineName)) return - ! OutLECoords call RegPack(Buf, allocated(InData%OutLECoords)) if (allocated(InData%OutLECoords)) then call RegPackBounds(Buf, 4, lbound(InData%OutLECoords), ubound(InData%OutLECoords)) call RegPack(Buf, InData%OutLECoords) end if if (RegCheckErr(Buf, RoutineName)) return - ! PtotalFreq call RegPack(Buf, allocated(InData%PtotalFreq)) if (allocated(InData%PtotalFreq)) then call RegPackBounds(Buf, 2, lbound(InData%PtotalFreq), ubound(InData%PtotalFreq)) call RegPack(Buf, InData%PtotalFreq) end if if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutputForPE call RegPack(Buf, allocated(InData%WriteOutputForPE)) if (allocated(InData%WriteOutputForPE)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputForPE), ubound(InData%WriteOutputForPE)) call RegPack(Buf, InData%WriteOutputForPE) end if if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutput call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) call RegPack(Buf, InData%WriteOutput) end if if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutputSep call RegPack(Buf, allocated(InData%WriteOutputSep)) if (allocated(InData%WriteOutputSep)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputSep), ubound(InData%WriteOutputSep)) call RegPack(Buf, InData%WriteOutputSep) end if if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutputNode call RegPack(Buf, allocated(InData%WriteOutputNode)) if (allocated(InData%WriteOutputNode)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputNode), ubound(InData%WriteOutputNode)) @@ -5566,7 +5093,6 @@ subroutine AA_UnPackOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! SumSpecNoise if (allocated(OutData%SumSpecNoise)) deallocate(OutData%SumSpecNoise) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5581,7 +5107,6 @@ subroutine AA_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%SumSpecNoise) if (RegCheckErr(Buf, RoutineName)) return end if - ! SumSpecNoiseSep if (allocated(OutData%SumSpecNoiseSep)) deallocate(OutData%SumSpecNoiseSep) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5596,7 +5121,6 @@ subroutine AA_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%SumSpecNoiseSep) if (RegCheckErr(Buf, RoutineName)) return end if - ! OASPL if (allocated(OutData%OASPL)) deallocate(OutData%OASPL) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5611,7 +5135,6 @@ subroutine AA_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%OASPL) if (RegCheckErr(Buf, RoutineName)) return end if - ! OASPL_Mech if (allocated(OutData%OASPL_Mech)) deallocate(OutData%OASPL_Mech) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5626,7 +5149,6 @@ subroutine AA_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%OASPL_Mech) if (RegCheckErr(Buf, RoutineName)) return end if - ! DirectiviOutput if (allocated(OutData%DirectiviOutput)) deallocate(OutData%DirectiviOutput) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5641,7 +5163,6 @@ subroutine AA_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%DirectiviOutput) if (RegCheckErr(Buf, RoutineName)) return end if - ! OutLECoords if (allocated(OutData%OutLECoords)) deallocate(OutData%OutLECoords) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5656,7 +5177,6 @@ subroutine AA_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%OutLECoords) if (RegCheckErr(Buf, RoutineName)) return end if - ! PtotalFreq if (allocated(OutData%PtotalFreq)) deallocate(OutData%PtotalFreq) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5671,7 +5191,6 @@ subroutine AA_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%PtotalFreq) if (RegCheckErr(Buf, RoutineName)) return end if - ! WriteOutputForPE if (allocated(OutData%WriteOutputForPE)) deallocate(OutData%WriteOutputForPE) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5686,7 +5205,6 @@ subroutine AA_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutputForPE) if (RegCheckErr(Buf, RoutineName)) return end if - ! WriteOutput if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5701,7 +5219,6 @@ subroutine AA_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutput) if (RegCheckErr(Buf, RoutineName)) return end if - ! WriteOutputSep if (allocated(OutData%WriteOutputSep)) deallocate(OutData%WriteOutputSep) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5716,7 +5233,6 @@ subroutine AA_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutputSep) if (RegCheckErr(Buf, RoutineName)) return end if - ! WriteOutputNode if (allocated(OutData%WriteOutputNode)) deallocate(OutData%WriteOutputNode) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 index 22aa1a1a30..61f9bce0c7 100644 --- a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 @@ -198,85 +198,63 @@ MODULE AeroDyn_Driver_Types 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) :: 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 ) - TYPE(Dvr_Case), INTENT(INOUT) :: Dvr_CaseData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyDvr_Case' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE AD_Dvr_DestroyDvr_Case +subroutine AD_Dvr_CopyDvr_Case(SrcDvr_CaseData, DstDvr_CaseData, CtrlCode, ErrStat, ErrMsg) + type(Dvr_Case), intent(in) :: SrcDvr_CaseData + type(Dvr_Case), intent(inout) :: DstDvr_CaseData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_Dvr_CopyDvr_Case' + ErrStat = ErrID_None + ErrMsg = '' + DstDvr_CaseData%HWindSpeed = SrcDvr_CaseData%HWindSpeed + DstDvr_CaseData%PLExp = SrcDvr_CaseData%PLExp + DstDvr_CaseData%rotSpeed = SrcDvr_CaseData%rotSpeed + DstDvr_CaseData%bldPitch = SrcDvr_CaseData%bldPitch + DstDvr_CaseData%nacYaw = SrcDvr_CaseData%nacYaw + DstDvr_CaseData%tMax = SrcDvr_CaseData%tMax + DstDvr_CaseData%dT = SrcDvr_CaseData%dT + DstDvr_CaseData%numSteps = SrcDvr_CaseData%numSteps + DstDvr_CaseData%DOF = SrcDvr_CaseData%DOF + DstDvr_CaseData%amplitude = SrcDvr_CaseData%amplitude + DstDvr_CaseData%frequency = SrcDvr_CaseData%frequency +end subroutine +subroutine AD_Dvr_DestroyDvr_Case(Dvr_CaseData, ErrStat, ErrMsg) + type(Dvr_Case), intent(inout) :: Dvr_CaseData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_Dvr_DestroyDvr_Case' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine AD_Dvr_PackDvr_Case(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Dvr_Case), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_Dvr_PackDvr_Case' if (Buf%ErrStat >= AbortErrLev) return - ! HWindSpeed call RegPack(Buf, InData%HWindSpeed) if (RegCheckErr(Buf, RoutineName)) return - ! PLExp call RegPack(Buf, InData%PLExp) if (RegCheckErr(Buf, RoutineName)) return - ! rotSpeed call RegPack(Buf, InData%rotSpeed) if (RegCheckErr(Buf, RoutineName)) return - ! bldPitch call RegPack(Buf, InData%bldPitch) if (RegCheckErr(Buf, RoutineName)) return - ! nacYaw call RegPack(Buf, InData%nacYaw) if (RegCheckErr(Buf, RoutineName)) return - ! tMax call RegPack(Buf, InData%tMax) if (RegCheckErr(Buf, RoutineName)) return - ! dT call RegPack(Buf, InData%dT) if (RegCheckErr(Buf, RoutineName)) return - ! numSteps call RegPack(Buf, InData%numSteps) if (RegCheckErr(Buf, RoutineName)) return - ! DOF call RegPack(Buf, InData%DOF) if (RegCheckErr(Buf, RoutineName)) return - ! amplitude call RegPack(Buf, InData%amplitude) if (RegCheckErr(Buf, RoutineName)) return - ! frequency call RegPack(Buf, InData%frequency) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -286,89 +264,62 @@ subroutine AD_Dvr_UnPackDvr_Case(Buf, OutData) type(Dvr_Case), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_Dvr_UnPackDvr_Case' if (Buf%ErrStat /= ErrID_None) return - ! HWindSpeed call RegUnpack(Buf, OutData%HWindSpeed) if (RegCheckErr(Buf, RoutineName)) return - ! PLExp call RegUnpack(Buf, OutData%PLExp) if (RegCheckErr(Buf, RoutineName)) return - ! rotSpeed call RegUnpack(Buf, OutData%rotSpeed) if (RegCheckErr(Buf, RoutineName)) return - ! bldPitch call RegUnpack(Buf, OutData%bldPitch) if (RegCheckErr(Buf, RoutineName)) return - ! nacYaw call RegUnpack(Buf, OutData%nacYaw) if (RegCheckErr(Buf, RoutineName)) return - ! tMax call RegUnpack(Buf, OutData%tMax) if (RegCheckErr(Buf, RoutineName)) return - ! dT call RegUnpack(Buf, OutData%dT) if (RegCheckErr(Buf, RoutineName)) return - ! numSteps call RegUnpack(Buf, OutData%numSteps) if (RegCheckErr(Buf, RoutineName)) return - ! DOF call RegUnpack(Buf, OutData%DOF) if (RegCheckErr(Buf, RoutineName)) return - ! amplitude call RegUnpack(Buf, OutData%amplitude) if (RegCheckErr(Buf, RoutineName)) return - ! frequency call RegUnpack(Buf, OutData%frequency) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE AD_Dvr_CopyDvrVTK_SurfaceType( SrcDvrVTK_SurfaceTypeData, DstDvrVTK_SurfaceTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DvrVTK_SurfaceType), INTENT(IN) :: SrcDvrVTK_SurfaceTypeData - TYPE(DvrVTK_SurfaceType), INTENT(INOUT) :: DstDvrVTK_SurfaceTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - 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 ) - TYPE(DvrVTK_SurfaceType), INTENT(INOUT) :: DvrVTK_SurfaceTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyDvrVTK_SurfaceType' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE AD_Dvr_DestroyDvrVTK_SurfaceType +subroutine AD_Dvr_CopyDvrVTK_SurfaceType(SrcDvrVTK_SurfaceTypeData, DstDvrVTK_SurfaceTypeData, CtrlCode, ErrStat, ErrMsg) + type(DvrVTK_SurfaceType), intent(in) :: SrcDvrVTK_SurfaceTypeData + type(DvrVTK_SurfaceType), intent(inout) :: DstDvrVTK_SurfaceTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_Dvr_CopyDvrVTK_SurfaceType' + ErrStat = ErrID_None + ErrMsg = '' + DstDvrVTK_SurfaceTypeData%NumSectors = SrcDvrVTK_SurfaceTypeData%NumSectors + DstDvrVTK_SurfaceTypeData%NacelleBox = SrcDvrVTK_SurfaceTypeData%NacelleBox + DstDvrVTK_SurfaceTypeData%BaseBox = SrcDvrVTK_SurfaceTypeData%BaseBox +end subroutine +subroutine AD_Dvr_DestroyDvrVTK_SurfaceType(DvrVTK_SurfaceTypeData, ErrStat, ErrMsg) + type(DvrVTK_SurfaceType), intent(inout) :: DvrVTK_SurfaceTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_Dvr_DestroyDvrVTK_SurfaceType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine AD_Dvr_PackDvrVTK_SurfaceType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(DvrVTK_SurfaceType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_Dvr_PackDvrVTK_SurfaceType' if (Buf%ErrStat >= AbortErrLev) return - ! NumSectors call RegPack(Buf, InData%NumSectors) if (RegCheckErr(Buf, RoutineName)) return - ! NacelleBox call RegPack(Buf, InData%NacelleBox) if (RegCheckErr(Buf, RoutineName)) return - ! BaseBox call RegPack(Buf, InData%BaseBox) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -378,175 +329,174 @@ subroutine AD_Dvr_UnPackDvrVTK_SurfaceType(Buf, OutData) type(DvrVTK_SurfaceType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_Dvr_UnPackDvrVTK_SurfaceType' if (Buf%ErrStat /= ErrID_None) return - ! NumSectors call RegUnpack(Buf, OutData%NumSectors) if (RegCheckErr(Buf, RoutineName)) return - ! NacelleBox call RegUnpack(Buf, OutData%NacelleBox) if (RegCheckErr(Buf, RoutineName)) return - ! BaseBox call RegUnpack(Buf, OutData%BaseBox) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE AD_Dvr_CopyDvr_Outputs( SrcDvr_OutputsData, DstDvr_OutputsData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Dvr_Outputs), INTENT(IN) :: SrcDvr_OutputsData - TYPE(Dvr_Outputs), INTENT(INOUT) :: DstDvr_OutputsData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (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 - DstDvr_OutputsData%DT_Outs = SrcDvr_OutputsData%DT_Outs - DstDvr_OutputsData%n_DT_Out = SrcDvr_OutputsData%n_DT_Out - END SUBROUTINE AD_Dvr_CopyDvr_Outputs - SUBROUTINE AD_Dvr_DestroyDvr_Outputs( Dvr_OutputsData, ErrStat, ErrMsg ) - TYPE(Dvr_Outputs), INTENT(INOUT) :: Dvr_OutputsData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyDvr_Outputs' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL NWTC_Library_DestroyProgDesc( Dvr_OutputsData%AD_ver, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(Dvr_OutputsData%unOutFile)) THEN - DEALLOCATE(Dvr_OutputsData%unOutFile) -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(Dvr_OutputsData%VTK_surface) -ENDIF - END SUBROUTINE AD_Dvr_DestroyDvr_Outputs +subroutine AD_Dvr_CopyDvr_Outputs(SrcDvr_OutputsData, DstDvr_OutputsData, CtrlCode, ErrStat, ErrMsg) + type(Dvr_Outputs), intent(in) :: SrcDvr_OutputsData + type(Dvr_Outputs), intent(inout) :: DstDvr_OutputsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(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 + LB(1:1) = lbound(SrcDvr_OutputsData%unOutFile) + UB(1:1) = ubound(SrcDvr_OutputsData%unOutFile) + if (.not. allocated(DstDvr_OutputsData%unOutFile)) then + allocate(DstDvr_OutputsData%unOutFile(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_OutputsData%unOutFile.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDvr_OutputsData%unOutFile = SrcDvr_OutputsData%unOutFile + else if (allocated(DstDvr_OutputsData%unOutFile)) then + deallocate(DstDvr_OutputsData%unOutFile) + end if + DstDvr_OutputsData%ActualChanLen = SrcDvr_OutputsData%ActualChanLen + DstDvr_OutputsData%nDvrOutputs = SrcDvr_OutputsData%nDvrOutputs + DstDvr_OutputsData%Fmt_t = SrcDvr_OutputsData%Fmt_t + DstDvr_OutputsData%Fmt_a = SrcDvr_OutputsData%Fmt_a + DstDvr_OutputsData%delim = SrcDvr_OutputsData%delim + DstDvr_OutputsData%outFmt = SrcDvr_OutputsData%outFmt + DstDvr_OutputsData%fileFmt = SrcDvr_OutputsData%fileFmt + DstDvr_OutputsData%wrVTK = SrcDvr_OutputsData%wrVTK + DstDvr_OutputsData%WrVTK_Type = SrcDvr_OutputsData%WrVTK_Type + DstDvr_OutputsData%Root = SrcDvr_OutputsData%Root + DstDvr_OutputsData%VTK_OutFileRoot = SrcDvr_OutputsData%VTK_OutFileRoot + if (allocated(SrcDvr_OutputsData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcDvr_OutputsData%WriteOutputHdr) + UB(1:1) = ubound(SrcDvr_OutputsData%WriteOutputHdr) + if (.not. allocated(DstDvr_OutputsData%WriteOutputHdr)) then + allocate(DstDvr_OutputsData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_OutputsData%WriteOutputHdr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDvr_OutputsData%WriteOutputHdr = SrcDvr_OutputsData%WriteOutputHdr + else if (allocated(DstDvr_OutputsData%WriteOutputHdr)) then + deallocate(DstDvr_OutputsData%WriteOutputHdr) + end if + if (allocated(SrcDvr_OutputsData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcDvr_OutputsData%WriteOutputUnt) + UB(1:1) = ubound(SrcDvr_OutputsData%WriteOutputUnt) + if (.not. allocated(DstDvr_OutputsData%WriteOutputUnt)) then + allocate(DstDvr_OutputsData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_OutputsData%WriteOutputUnt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDvr_OutputsData%WriteOutputUnt = SrcDvr_OutputsData%WriteOutputUnt + else if (allocated(DstDvr_OutputsData%WriteOutputUnt)) then + deallocate(DstDvr_OutputsData%WriteOutputUnt) + end if + if (allocated(SrcDvr_OutputsData%storage)) then + LB(1:3) = lbound(SrcDvr_OutputsData%storage) + UB(1:3) = ubound(SrcDvr_OutputsData%storage) + if (.not. allocated(DstDvr_OutputsData%storage)) then + allocate(DstDvr_OutputsData%storage(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_OutputsData%storage.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDvr_OutputsData%storage = SrcDvr_OutputsData%storage + else if (allocated(DstDvr_OutputsData%storage)) then + deallocate(DstDvr_OutputsData%storage) + end if + if (allocated(SrcDvr_OutputsData%outLine)) then + LB(1:1) = lbound(SrcDvr_OutputsData%outLine) + UB(1:1) = ubound(SrcDvr_OutputsData%outLine) + if (.not. allocated(DstDvr_OutputsData%outLine)) then + allocate(DstDvr_OutputsData%outLine(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_OutputsData%outLine.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDvr_OutputsData%outLine = SrcDvr_OutputsData%outLine + else if (allocated(DstDvr_OutputsData%outLine)) then + deallocate(DstDvr_OutputsData%outLine) + end if + if (allocated(SrcDvr_OutputsData%VTK_surface)) then + LB(1:1) = lbound(SrcDvr_OutputsData%VTK_surface) + UB(1:1) = ubound(SrcDvr_OutputsData%VTK_surface) + if (.not. allocated(DstDvr_OutputsData%VTK_surface)) then + allocate(DstDvr_OutputsData%VTK_surface(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_OutputsData%VTK_surface.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_Dvr_CopyDvrVTK_SurfaceType(SrcDvr_OutputsData%VTK_surface(i1), DstDvr_OutputsData%VTK_surface(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstDvr_OutputsData%VTK_surface)) then + deallocate(DstDvr_OutputsData%VTK_surface) + end if + DstDvr_OutputsData%VTK_tWidth = SrcDvr_OutputsData%VTK_tWidth + DstDvr_OutputsData%n_VTKTime = SrcDvr_OutputsData%n_VTKTime + DstDvr_OutputsData%VTKHubRad = SrcDvr_OutputsData%VTKHubRad + DstDvr_OutputsData%VTKNacDim = SrcDvr_OutputsData%VTKNacDim + DstDvr_OutputsData%VTKRefPoint = SrcDvr_OutputsData%VTKRefPoint + DstDvr_OutputsData%DT_Outs = SrcDvr_OutputsData%DT_Outs + DstDvr_OutputsData%n_DT_Out = SrcDvr_OutputsData%n_DT_Out +end subroutine +subroutine AD_Dvr_DestroyDvr_Outputs(Dvr_OutputsData, ErrStat, ErrMsg) + type(Dvr_Outputs), intent(inout) :: Dvr_OutputsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_Dvr_DestroyDvr_Outputs' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(Dvr_OutputsData%unOutFile)) then + deallocate(Dvr_OutputsData%unOutFile) + end if + if (allocated(Dvr_OutputsData%WriteOutputHdr)) then + deallocate(Dvr_OutputsData%WriteOutputHdr) + end if + if (allocated(Dvr_OutputsData%WriteOutputUnt)) then + deallocate(Dvr_OutputsData%WriteOutputUnt) + end if + if (allocated(Dvr_OutputsData%storage)) then + deallocate(Dvr_OutputsData%storage) + end if + if (allocated(Dvr_OutputsData%outLine)) then + deallocate(Dvr_OutputsData%outLine) + end if + if (allocated(Dvr_OutputsData%VTK_surface)) then + LB(1:1) = lbound(Dvr_OutputsData%VTK_surface) + UB(1:1) = ubound(Dvr_OutputsData%VTK_surface) + do i1 = LB(1), UB(1) + call AD_Dvr_DestroyDvrVTK_SurfaceType(Dvr_OutputsData%VTK_surface(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(Dvr_OutputsData%VTK_surface) + end if +end subroutine subroutine AD_Dvr_PackDvr_Outputs(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -555,78 +505,60 @@ subroutine AD_Dvr_PackDvr_Outputs(Buf, Indata) integer(IntKi) :: i1, i2, i3 integer(IntKi) :: LB(3), UB(3) if (Buf%ErrStat >= AbortErrLev) return - ! AD_ver call NWTC_Library_PackProgDesc(Buf, InData%AD_ver) if (RegCheckErr(Buf, RoutineName)) return - ! unOutFile call RegPack(Buf, allocated(InData%unOutFile)) if (allocated(InData%unOutFile)) then call RegPackBounds(Buf, 1, lbound(InData%unOutFile), ubound(InData%unOutFile)) call RegPack(Buf, InData%unOutFile) end if if (RegCheckErr(Buf, RoutineName)) return - ! ActualChanLen call RegPack(Buf, InData%ActualChanLen) if (RegCheckErr(Buf, RoutineName)) return - ! nDvrOutputs call RegPack(Buf, InData%nDvrOutputs) if (RegCheckErr(Buf, RoutineName)) return - ! Fmt_t call RegPack(Buf, InData%Fmt_t) if (RegCheckErr(Buf, RoutineName)) return - ! Fmt_a call RegPack(Buf, InData%Fmt_a) if (RegCheckErr(Buf, RoutineName)) return - ! delim call RegPack(Buf, InData%delim) if (RegCheckErr(Buf, RoutineName)) return - ! outFmt call RegPack(Buf, InData%outFmt) if (RegCheckErr(Buf, RoutineName)) return - ! fileFmt call RegPack(Buf, InData%fileFmt) if (RegCheckErr(Buf, RoutineName)) return - ! wrVTK call RegPack(Buf, InData%wrVTK) if (RegCheckErr(Buf, RoutineName)) return - ! WrVTK_Type call RegPack(Buf, InData%WrVTK_Type) if (RegCheckErr(Buf, RoutineName)) return - ! Root call RegPack(Buf, InData%Root) if (RegCheckErr(Buf, RoutineName)) return - ! VTK_OutFileRoot call RegPack(Buf, InData%VTK_OutFileRoot) if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutputHdr call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) call RegPack(Buf, InData%WriteOutputHdr) end if if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutputUnt call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) call RegPack(Buf, InData%WriteOutputUnt) end if if (RegCheckErr(Buf, RoutineName)) return - ! storage call RegPack(Buf, allocated(InData%storage)) if (allocated(InData%storage)) then call RegPackBounds(Buf, 3, lbound(InData%storage), ubound(InData%storage)) call RegPack(Buf, InData%storage) end if if (RegCheckErr(Buf, RoutineName)) return - ! outLine call RegPack(Buf, allocated(InData%outLine)) if (allocated(InData%outLine)) then call RegPackBounds(Buf, 1, lbound(InData%outLine), ubound(InData%outLine)) call RegPack(Buf, InData%outLine) end if if (RegCheckErr(Buf, RoutineName)) return - ! VTK_surface call RegPack(Buf, allocated(InData%VTK_surface)) if (allocated(InData%VTK_surface)) then call RegPackBounds(Buf, 1, lbound(InData%VTK_surface), ubound(InData%VTK_surface)) @@ -637,25 +569,18 @@ subroutine AD_Dvr_PackDvr_Outputs(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! VTK_tWidth call RegPack(Buf, InData%VTK_tWidth) if (RegCheckErr(Buf, RoutineName)) return - ! n_VTKTime call RegPack(Buf, InData%n_VTKTime) if (RegCheckErr(Buf, RoutineName)) return - ! VTKHubRad call RegPack(Buf, InData%VTKHubRad) if (RegCheckErr(Buf, RoutineName)) return - ! VTKNacDim call RegPack(Buf, InData%VTKNacDim) if (RegCheckErr(Buf, RoutineName)) return - ! VTKRefPoint call RegPack(Buf, InData%VTKRefPoint) if (RegCheckErr(Buf, RoutineName)) return - ! DT_Outs call RegPack(Buf, InData%DT_Outs) if (RegCheckErr(Buf, RoutineName)) return - ! n_DT_Out call RegPack(Buf, InData%n_DT_Out) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -669,9 +594,7 @@ subroutine AD_Dvr_UnPackDvr_Outputs(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! AD_ver call NWTC_Library_UnpackProgDesc(Buf, OutData%AD_ver) ! AD_ver - ! unOutFile if (allocated(OutData%unOutFile)) deallocate(OutData%unOutFile) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -686,40 +609,28 @@ subroutine AD_Dvr_UnPackDvr_Outputs(Buf, OutData) call RegUnpack(Buf, OutData%unOutFile) if (RegCheckErr(Buf, RoutineName)) return end if - ! ActualChanLen call RegUnpack(Buf, OutData%ActualChanLen) if (RegCheckErr(Buf, RoutineName)) return - ! nDvrOutputs call RegUnpack(Buf, OutData%nDvrOutputs) if (RegCheckErr(Buf, RoutineName)) return - ! Fmt_t call RegUnpack(Buf, OutData%Fmt_t) if (RegCheckErr(Buf, RoutineName)) return - ! Fmt_a call RegUnpack(Buf, OutData%Fmt_a) if (RegCheckErr(Buf, RoutineName)) return - ! delim call RegUnpack(Buf, OutData%delim) if (RegCheckErr(Buf, RoutineName)) return - ! outFmt call RegUnpack(Buf, OutData%outFmt) if (RegCheckErr(Buf, RoutineName)) return - ! fileFmt call RegUnpack(Buf, OutData%fileFmt) if (RegCheckErr(Buf, RoutineName)) return - ! wrVTK call RegUnpack(Buf, OutData%wrVTK) if (RegCheckErr(Buf, RoutineName)) return - ! WrVTK_Type call RegUnpack(Buf, OutData%WrVTK_Type) if (RegCheckErr(Buf, RoutineName)) return - ! Root call RegUnpack(Buf, OutData%Root) if (RegCheckErr(Buf, RoutineName)) return - ! VTK_OutFileRoot call RegUnpack(Buf, OutData%VTK_OutFileRoot) if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutputHdr if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -734,7 +645,6 @@ subroutine AD_Dvr_UnPackDvr_Outputs(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutputHdr) if (RegCheckErr(Buf, RoutineName)) return end if - ! WriteOutputUnt if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -749,7 +659,6 @@ subroutine AD_Dvr_UnPackDvr_Outputs(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutputUnt) if (RegCheckErr(Buf, RoutineName)) return end if - ! storage if (allocated(OutData%storage)) deallocate(OutData%storage) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -764,7 +673,6 @@ subroutine AD_Dvr_UnPackDvr_Outputs(Buf, OutData) call RegUnpack(Buf, OutData%storage) if (RegCheckErr(Buf, RoutineName)) return end if - ! outLine if (allocated(OutData%outLine)) deallocate(OutData%outLine) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -779,7 +687,6 @@ subroutine AD_Dvr_UnPackDvr_Outputs(Buf, OutData) call RegUnpack(Buf, OutData%outLine) if (RegCheckErr(Buf, RoutineName)) return end if - ! VTK_surface if (allocated(OutData%VTK_surface)) deallocate(OutData%VTK_surface) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -795,129 +702,100 @@ subroutine AD_Dvr_UnPackDvr_Outputs(Buf, OutData) call AD_Dvr_UnpackDvrVTK_SurfaceType(Buf, OutData%VTK_surface(i1)) ! VTK_surface end do end if - ! VTK_tWidth call RegUnpack(Buf, OutData%VTK_tWidth) if (RegCheckErr(Buf, RoutineName)) return - ! n_VTKTime call RegUnpack(Buf, OutData%n_VTKTime) if (RegCheckErr(Buf, RoutineName)) return - ! VTKHubRad call RegUnpack(Buf, OutData%VTKHubRad) if (RegCheckErr(Buf, RoutineName)) return - ! VTKNacDim call RegUnpack(Buf, OutData%VTKNacDim) if (RegCheckErr(Buf, RoutineName)) return - ! VTKRefPoint call RegUnpack(Buf, OutData%VTKRefPoint) if (RegCheckErr(Buf, RoutineName)) return - ! DT_Outs call RegUnpack(Buf, OutData%DT_Outs) if (RegCheckErr(Buf, RoutineName)) return - ! n_DT_Out call RegUnpack(Buf, OutData%n_DT_Out) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE AD_Dvr_CopyBladeData( SrcBladeDataData, DstBladeDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BladeData), INTENT(IN) :: SrcBladeDataData - TYPE(BladeData), INTENT(INOUT) :: DstBladeDataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - 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 ) - TYPE(BladeData), INTENT(INOUT) :: BladeDataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyBladeData' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(BladeDataData%motion)) THEN - DEALLOCATE(BladeDataData%motion) -ENDIF - END SUBROUTINE AD_Dvr_DestroyBladeData +subroutine AD_Dvr_CopyBladeData(SrcBladeDataData, DstBladeDataData, CtrlCode, ErrStat, ErrMsg) + type(BladeData), intent(in) :: SrcBladeDataData + type(BladeData), intent(inout) :: DstBladeDataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + 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 + LB(1:2) = lbound(SrcBladeDataData%motion) + UB(1:2) = ubound(SrcBladeDataData%motion) + if (.not. allocated(DstBladeDataData%motion)) then + allocate(DstBladeDataData%motion(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeDataData%motion.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeDataData%motion = SrcBladeDataData%motion + else if (allocated(DstBladeDataData%motion)) then + deallocate(DstBladeDataData%motion) + end if + DstBladeDataData%motionFileName = SrcBladeDataData%motionFileName +end subroutine +subroutine AD_Dvr_DestroyBladeData(BladeDataData, ErrStat, ErrMsg) + type(BladeData), intent(inout) :: BladeDataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_Dvr_DestroyBladeData' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(BladeDataData%motion)) then + deallocate(BladeDataData%motion) + end if +end subroutine subroutine AD_Dvr_PackBladeData(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(BladeData), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_Dvr_PackBladeData' if (Buf%ErrStat >= AbortErrLev) return - ! pitch call RegPack(Buf, InData%pitch) if (RegCheckErr(Buf, RoutineName)) return - ! pitchSpeed call RegPack(Buf, InData%pitchSpeed) if (RegCheckErr(Buf, RoutineName)) return - ! pitchAcc call RegPack(Buf, InData%pitchAcc) if (RegCheckErr(Buf, RoutineName)) return - ! origin_h call RegPack(Buf, InData%origin_h) if (RegCheckErr(Buf, RoutineName)) return - ! orientation_h call RegPack(Buf, InData%orientation_h) if (RegCheckErr(Buf, RoutineName)) return - ! hubRad_bl call RegPack(Buf, InData%hubRad_bl) if (RegCheckErr(Buf, RoutineName)) return - ! Rh2bl0 call RegPack(Buf, InData%Rh2bl0) if (RegCheckErr(Buf, RoutineName)) return - ! motionType call RegPack(Buf, InData%motionType) if (RegCheckErr(Buf, RoutineName)) return - ! iMotion call RegPack(Buf, InData%iMotion) if (RegCheckErr(Buf, RoutineName)) return - ! motion call RegPack(Buf, allocated(InData%motion)) if (allocated(InData%motion)) then call RegPackBounds(Buf, 2, lbound(InData%motion), ubound(InData%motion)) call RegPack(Buf, InData%motion) end if if (RegCheckErr(Buf, RoutineName)) return - ! motionFileName call RegPack(Buf, InData%motionFileName) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -930,34 +808,24 @@ subroutine AD_Dvr_UnPackBladeData(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! pitch call RegUnpack(Buf, OutData%pitch) if (RegCheckErr(Buf, RoutineName)) return - ! pitchSpeed call RegUnpack(Buf, OutData%pitchSpeed) if (RegCheckErr(Buf, RoutineName)) return - ! pitchAcc call RegUnpack(Buf, OutData%pitchAcc) if (RegCheckErr(Buf, RoutineName)) return - ! origin_h call RegUnpack(Buf, OutData%origin_h) if (RegCheckErr(Buf, RoutineName)) return - ! orientation_h call RegUnpack(Buf, OutData%orientation_h) if (RegCheckErr(Buf, RoutineName)) return - ! hubRad_bl call RegUnpack(Buf, OutData%hubRad_bl) if (RegCheckErr(Buf, RoutineName)) return - ! Rh2bl0 call RegUnpack(Buf, OutData%Rh2bl0) if (RegCheckErr(Buf, RoutineName)) return - ! motionType call RegUnpack(Buf, OutData%motionType) if (RegCheckErr(Buf, RoutineName)) return - ! iMotion call RegUnpack(Buf, OutData%iMotion) if (RegCheckErr(Buf, RoutineName)) return - ! motion if (allocated(OutData%motion)) deallocate(OutData%motion) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -972,99 +840,78 @@ subroutine AD_Dvr_UnPackBladeData(Buf, OutData) call RegUnpack(Buf, OutData%motion) if (RegCheckErr(Buf, RoutineName)) return end if - ! motionFileName call RegUnpack(Buf, OutData%motionFileName) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE AD_Dvr_CopyHubData( SrcHubDataData, DstHubDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HubData), INTENT(IN) :: SrcHubDataData - TYPE(HubData), INTENT(INOUT) :: DstHubDataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - 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 ) - TYPE(HubData), INTENT(INOUT) :: HubDataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyHubData' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(HubDataData%motion)) THEN - DEALLOCATE(HubDataData%motion) -ENDIF - END SUBROUTINE AD_Dvr_DestroyHubData +subroutine AD_Dvr_CopyHubData(SrcHubDataData, DstHubDataData, CtrlCode, ErrStat, ErrMsg) + type(HubData), intent(in) :: SrcHubDataData + type(HubData), intent(inout) :: DstHubDataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + 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 + LB(1:2) = lbound(SrcHubDataData%motion) + UB(1:2) = ubound(SrcHubDataData%motion) + if (.not. allocated(DstHubDataData%motion)) then + allocate(DstHubDataData%motion(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstHubDataData%motion.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstHubDataData%motion = SrcHubDataData%motion + else if (allocated(DstHubDataData%motion)) then + deallocate(DstHubDataData%motion) + end if +end subroutine +subroutine AD_Dvr_DestroyHubData(HubDataData, ErrStat, ErrMsg) + type(HubData), intent(inout) :: HubDataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_Dvr_DestroyHubData' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(HubDataData%motion)) then + deallocate(HubDataData%motion) + end if +end subroutine subroutine AD_Dvr_PackHubData(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(HubData), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_Dvr_PackHubData' if (Buf%ErrStat >= AbortErrLev) return - ! origin_n call RegPack(Buf, InData%origin_n) if (RegCheckErr(Buf, RoutineName)) return - ! orientation_n call RegPack(Buf, InData%orientation_n) if (RegCheckErr(Buf, RoutineName)) return - ! motionType call RegPack(Buf, InData%motionType) if (RegCheckErr(Buf, RoutineName)) return - ! iMotion call RegPack(Buf, InData%iMotion) if (RegCheckErr(Buf, RoutineName)) return - ! azimuth call RegPack(Buf, InData%azimuth) if (RegCheckErr(Buf, RoutineName)) return - ! rotSpeed call RegPack(Buf, InData%rotSpeed) if (RegCheckErr(Buf, RoutineName)) return - ! rotAcc call RegPack(Buf, InData%rotAcc) if (RegCheckErr(Buf, RoutineName)) return - ! motionFileName call RegPack(Buf, InData%motionFileName) if (RegCheckErr(Buf, RoutineName)) return - ! motion call RegPack(Buf, allocated(InData%motion)) if (allocated(InData%motion)) then call RegPackBounds(Buf, 2, lbound(InData%motion), ubound(InData%motion)) @@ -1081,31 +928,22 @@ subroutine AD_Dvr_UnPackHubData(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! origin_n call RegUnpack(Buf, OutData%origin_n) if (RegCheckErr(Buf, RoutineName)) return - ! orientation_n call RegUnpack(Buf, OutData%orientation_n) if (RegCheckErr(Buf, RoutineName)) return - ! motionType call RegUnpack(Buf, OutData%motionType) if (RegCheckErr(Buf, RoutineName)) return - ! iMotion call RegUnpack(Buf, OutData%iMotion) if (RegCheckErr(Buf, RoutineName)) return - ! azimuth call RegUnpack(Buf, OutData%azimuth) if (RegCheckErr(Buf, RoutineName)) return - ! rotSpeed call RegUnpack(Buf, OutData%rotSpeed) if (RegCheckErr(Buf, RoutineName)) return - ! rotAcc call RegUnpack(Buf, OutData%rotAcc) if (RegCheckErr(Buf, RoutineName)) return - ! motionFileName call RegUnpack(Buf, OutData%motionFileName) if (RegCheckErr(Buf, RoutineName)) return - ! motion if (allocated(OutData%motion)) deallocate(OutData%motion) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1121,91 +959,72 @@ subroutine AD_Dvr_UnPackHubData(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE AD_Dvr_CopyNacData( SrcNacDataData, DstNacDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(NacData), INTENT(IN) :: SrcNacDataData - TYPE(NacData), INTENT(INOUT) :: DstNacDataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - 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 ) - TYPE(NacData), INTENT(INOUT) :: NacDataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyNacData' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(NacDataData%motion)) THEN - DEALLOCATE(NacDataData%motion) -ENDIF - END SUBROUTINE AD_Dvr_DestroyNacData +subroutine AD_Dvr_CopyNacData(SrcNacDataData, DstNacDataData, CtrlCode, ErrStat, ErrMsg) + type(NacData), intent(in) :: SrcNacDataData + type(NacData), intent(inout) :: DstNacDataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AD_Dvr_CopyNacData' + ErrStat = ErrID_None + ErrMsg = '' + DstNacDataData%origin_t = SrcNacDataData%origin_t + DstNacDataData%motionType = SrcNacDataData%motionType + DstNacDataData%iMotion = SrcNacDataData%iMotion + DstNacDataData%yaw = SrcNacDataData%yaw + DstNacDataData%yawSpeed = SrcNacDataData%yawSpeed + DstNacDataData%yawAcc = SrcNacDataData%yawAcc + DstNacDataData%motionFileName = SrcNacDataData%motionFileName + if (allocated(SrcNacDataData%motion)) then + LB(1:2) = lbound(SrcNacDataData%motion) + UB(1:2) = ubound(SrcNacDataData%motion) + if (.not. allocated(DstNacDataData%motion)) then + allocate(DstNacDataData%motion(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstNacDataData%motion.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstNacDataData%motion = SrcNacDataData%motion + else if (allocated(DstNacDataData%motion)) then + deallocate(DstNacDataData%motion) + end if +end subroutine +subroutine AD_Dvr_DestroyNacData(NacDataData, ErrStat, ErrMsg) + type(NacData), intent(inout) :: NacDataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_Dvr_DestroyNacData' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(NacDataData%motion)) then + deallocate(NacDataData%motion) + end if +end subroutine subroutine AD_Dvr_PackNacData(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(NacData), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_Dvr_PackNacData' if (Buf%ErrStat >= AbortErrLev) return - ! origin_t call RegPack(Buf, InData%origin_t) if (RegCheckErr(Buf, RoutineName)) return - ! motionType call RegPack(Buf, InData%motionType) if (RegCheckErr(Buf, RoutineName)) return - ! iMotion call RegPack(Buf, InData%iMotion) if (RegCheckErr(Buf, RoutineName)) return - ! yaw call RegPack(Buf, InData%yaw) if (RegCheckErr(Buf, RoutineName)) return - ! yawSpeed call RegPack(Buf, InData%yawSpeed) if (RegCheckErr(Buf, RoutineName)) return - ! yawAcc call RegPack(Buf, InData%yawAcc) if (RegCheckErr(Buf, RoutineName)) return - ! motionFileName call RegPack(Buf, InData%motionFileName) if (RegCheckErr(Buf, RoutineName)) return - ! motion call RegPack(Buf, allocated(InData%motion)) if (allocated(InData%motion)) then call RegPackBounds(Buf, 2, lbound(InData%motion), ubound(InData%motion)) @@ -1222,28 +1041,20 @@ subroutine AD_Dvr_UnPackNacData(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! origin_t call RegUnpack(Buf, OutData%origin_t) if (RegCheckErr(Buf, RoutineName)) return - ! motionType call RegUnpack(Buf, OutData%motionType) if (RegCheckErr(Buf, RoutineName)) return - ! iMotion call RegUnpack(Buf, OutData%iMotion) if (RegCheckErr(Buf, RoutineName)) return - ! yaw call RegUnpack(Buf, OutData%yaw) if (RegCheckErr(Buf, RoutineName)) return - ! yawSpeed call RegUnpack(Buf, OutData%yawSpeed) if (RegCheckErr(Buf, RoutineName)) return - ! yawAcc call RegUnpack(Buf, OutData%yawAcc) if (RegCheckErr(Buf, RoutineName)) return - ! motionFileName call RegUnpack(Buf, OutData%motionFileName) if (RegCheckErr(Buf, RoutineName)) return - ! motion if (allocated(OutData%motion)) deallocate(OutData%motion) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1259,46 +1070,33 @@ subroutine AD_Dvr_UnPackNacData(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE AD_Dvr_CopyTwrData( SrcTwrDataData, DstTwrDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(TwrData), INTENT(IN) :: SrcTwrDataData - TYPE(TwrData), INTENT(INOUT) :: DstTwrDataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - 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 ) - TYPE(TwrData), INTENT(INOUT) :: TwrDataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyTwrData' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE AD_Dvr_DestroyTwrData +subroutine AD_Dvr_CopyTwrData(SrcTwrDataData, DstTwrDataData, CtrlCode, ErrStat, ErrMsg) + type(TwrData), intent(in) :: SrcTwrDataData + type(TwrData), intent(inout) :: DstTwrDataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_Dvr_CopyTwrData' + ErrStat = ErrID_None + ErrMsg = '' + DstTwrDataData%origin_t = SrcTwrDataData%origin_t +end subroutine +subroutine AD_Dvr_DestroyTwrData(TwrDataData, ErrStat, ErrMsg) + type(TwrData), intent(inout) :: TwrDataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_Dvr_DestroyTwrData' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine AD_Dvr_PackTwrData(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(TwrData), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_Dvr_PackTwrData' if (Buf%ErrStat >= AbortErrLev) return - ! origin_t call RegPack(Buf, InData%origin_t) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1308,180 +1106,174 @@ subroutine AD_Dvr_UnPackTwrData(Buf, OutData) type(TwrData), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_Dvr_UnPackTwrData' if (Buf%ErrStat /= ErrID_None) return - ! origin_t call RegUnpack(Buf, OutData%origin_t) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE AD_Dvr_CopyWTData( SrcWTDataData, DstWTDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WTData), INTENT(INOUT) :: SrcWTDataData - TYPE(WTData), INTENT(INOUT) :: DstWTDataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - 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%BEM_Mod = SrcWTDataData%BEM_Mod - DstWTDataData%HAWTprojection = SrcWTDataData%HAWTprojection - DstWTDataData%motionType = SrcWTDataData%motionType -IF (ALLOCATED(SrcWTDataData%motion)) THEN - i1_l = LBOUND(SrcWTDataData%motion,1) - i1_u = UBOUND(SrcWTDataData%motion,1) - i2_l = LBOUND(SrcWTDataData%motion,2) - i2_u = UBOUND(SrcWTDataData%motion,2) - IF (.NOT. ALLOCATED(DstWTDataData%motion)) THEN - ALLOCATE(DstWTDataData%motion(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWTDataData%motion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWTDataData%motion = SrcWTDataData%motion -ENDIF - DstWTDataData%iMotion = SrcWTDataData%iMotion - DstWTDataData%degreeOfFreedom = SrcWTDataData%degreeOfFreedom - DstWTDataData%amplitude = SrcWTDataData%amplitude - DstWTDataData%frequency = SrcWTDataData%frequency - DstWTDataData%motionFileName = SrcWTDataData%motionFileName -IF (ALLOCATED(SrcWTDataData%WriteOutput)) THEN - i1_l = LBOUND(SrcWTDataData%WriteOutput,1) - i1_u = UBOUND(SrcWTDataData%WriteOutput,1) - IF (.NOT. ALLOCATED(DstWTDataData%WriteOutput)) THEN - ALLOCATE(DstWTDataData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWTDataData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWTDataData%WriteOutput = SrcWTDataData%WriteOutput -ENDIF -IF (ALLOCATED(SrcWTDataData%userSwapArray)) THEN - i1_l = LBOUND(SrcWTDataData%userSwapArray,1) - i1_u = UBOUND(SrcWTDataData%userSwapArray,1) - IF (.NOT. ALLOCATED(DstWTDataData%userSwapArray)) THEN - ALLOCATE(DstWTDataData%userSwapArray(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWTDataData%userSwapArray.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWTDataData%userSwapArray = SrcWTDataData%userSwapArray -ENDIF - END SUBROUTINE AD_Dvr_CopyWTData - - SUBROUTINE AD_Dvr_DestroyWTData( WTDataData, ErrStat, ErrMsg ) - TYPE(WTData), INTENT(INOUT) :: WTDataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyWTData' - ErrStat = ErrID_None - ErrMsg = "" - - CALL NWTC_Library_DestroyMeshMapType( WTDataData%map2twrPt, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyMeshMapType( WTDataData%map2nacPt, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyMeshMapType( WTDataData%map2hubPt, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(WTDataData%map2BldPt)) THEN -DO i1 = LBOUND(WTDataData%map2BldPt,1), UBOUND(WTDataData%map2BldPt,1) - CALL NWTC_Library_DestroyMeshMapType( WTDataData%map2BldPt(i1), ErrStat2, ErrMsg2 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(WTDataData%bld) -ENDIF - CALL AD_Dvr_DestroyHubData( WTDataData%hub, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD_Dvr_DestroyNacData( WTDataData%nac, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD_Dvr_DestroyTwrData( WTDataData%twr, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(WTDataData%motion)) THEN - DEALLOCATE(WTDataData%motion) -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_CopyWTData(SrcWTDataData, DstWTDataData, CtrlCode, ErrStat, ErrMsg) + type(WTData), intent(inout) :: SrcWTDataData + type(WTData), intent(inout) :: DstWTDataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_Dvr_CopyWTData' + ErrStat = ErrID_None + ErrMsg = '' + DstWTDataData%originInit = SrcWTDataData%originInit + DstWTDataData%orientationInit = SrcWTDataData%orientationInit + call NWTC_Library_CopyMeshMapType(SrcWTDataData%map2twrPt, DstWTDataData%map2twrPt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcWTDataData%map2nacPt, DstWTDataData%map2nacPt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcWTDataData%map2hubPt, DstWTDataData%map2hubPt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcWTDataData%map2BldPt)) then + LB(1:1) = lbound(SrcWTDataData%map2BldPt) + UB(1:1) = ubound(SrcWTDataData%map2BldPt) + if (.not. allocated(DstWTDataData%map2BldPt)) then + allocate(DstWTDataData%map2BldPt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWTDataData%map2BldPt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcWTDataData%map2BldPt(i1), DstWTDataData%map2BldPt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstWTDataData%map2BldPt)) then + deallocate(DstWTDataData%map2BldPt) + end if + if (allocated(SrcWTDataData%bld)) then + LB(1:1) = lbound(SrcWTDataData%bld) + UB(1:1) = ubound(SrcWTDataData%bld) + if (.not. allocated(DstWTDataData%bld)) then + allocate(DstWTDataData%bld(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWTDataData%bld.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_Dvr_CopyBladeData(SrcWTDataData%bld(i1), DstWTDataData%bld(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstWTDataData%bld)) then + deallocate(DstWTDataData%bld) + end if + call AD_Dvr_CopyHubData(SrcWTDataData%hub, DstWTDataData%hub, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD_Dvr_CopyNacData(SrcWTDataData%nac, DstWTDataData%nac, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD_Dvr_CopyTwrData(SrcWTDataData%twr, DstWTDataData%twr, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstWTDataData%numBlades = SrcWTDataData%numBlades + DstWTDataData%basicHAWTFormat = SrcWTDataData%basicHAWTFormat + DstWTDataData%hasTower = SrcWTDataData%hasTower + DstWTDataData%projMod = SrcWTDataData%projMod + DstWTDataData%BEM_Mod = SrcWTDataData%BEM_Mod + DstWTDataData%HAWTprojection = SrcWTDataData%HAWTprojection + DstWTDataData%motionType = SrcWTDataData%motionType + if (allocated(SrcWTDataData%motion)) then + LB(1:2) = lbound(SrcWTDataData%motion) + UB(1:2) = ubound(SrcWTDataData%motion) + if (.not. allocated(DstWTDataData%motion)) then + allocate(DstWTDataData%motion(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWTDataData%motion.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWTDataData%motion = SrcWTDataData%motion + else if (allocated(DstWTDataData%motion)) then + deallocate(DstWTDataData%motion) + end if + DstWTDataData%iMotion = SrcWTDataData%iMotion + DstWTDataData%degreeOfFreedom = SrcWTDataData%degreeOfFreedom + DstWTDataData%amplitude = SrcWTDataData%amplitude + DstWTDataData%frequency = SrcWTDataData%frequency + DstWTDataData%motionFileName = SrcWTDataData%motionFileName + if (allocated(SrcWTDataData%WriteOutput)) then + LB(1:1) = lbound(SrcWTDataData%WriteOutput) + UB(1:1) = ubound(SrcWTDataData%WriteOutput) + if (.not. allocated(DstWTDataData%WriteOutput)) then + allocate(DstWTDataData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWTDataData%WriteOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWTDataData%WriteOutput = SrcWTDataData%WriteOutput + else if (allocated(DstWTDataData%WriteOutput)) then + deallocate(DstWTDataData%WriteOutput) + end if + if (allocated(SrcWTDataData%userSwapArray)) then + LB(1:1) = lbound(SrcWTDataData%userSwapArray) + UB(1:1) = ubound(SrcWTDataData%userSwapArray) + if (.not. allocated(DstWTDataData%userSwapArray)) then + allocate(DstWTDataData%userSwapArray(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWTDataData%userSwapArray.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWTDataData%userSwapArray = SrcWTDataData%userSwapArray + else if (allocated(DstWTDataData%userSwapArray)) then + deallocate(DstWTDataData%userSwapArray) + end if +end subroutine +subroutine AD_Dvr_DestroyWTData(WTDataData, ErrStat, ErrMsg) + type(WTData), intent(inout) :: WTDataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_Dvr_DestroyWTData' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(WTDataData%map2BldPt)) then + LB(1:1) = lbound(WTDataData%map2BldPt) + UB(1:1) = ubound(WTDataData%map2BldPt) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(WTDataData%map2BldPt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(WTDataData%map2BldPt) + end if + if (allocated(WTDataData%bld)) then + LB(1:1) = lbound(WTDataData%bld) + UB(1:1) = ubound(WTDataData%bld) + do i1 = LB(1), UB(1) + call AD_Dvr_DestroyBladeData(WTDataData%bld(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(WTDataData%bld) + end if + if (allocated(WTDataData%motion)) then + deallocate(WTDataData%motion) + end if + if (allocated(WTDataData%WriteOutput)) then + deallocate(WTDataData%WriteOutput) + end if + if (allocated(WTDataData%userSwapArray)) then + deallocate(WTDataData%userSwapArray) + end if +end subroutine subroutine AD_Dvr_PackWTData(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -1490,22 +1282,16 @@ subroutine AD_Dvr_PackWTData(Buf, Indata) integer(IntKi) :: i1, i2 integer(IntKi) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return - ! originInit call RegPack(Buf, InData%originInit) if (RegCheckErr(Buf, RoutineName)) return - ! orientationInit call RegPack(Buf, InData%orientationInit) if (RegCheckErr(Buf, RoutineName)) return - ! map2twrPt call NWTC_Library_PackMeshMapType(Buf, InData%map2twrPt) if (RegCheckErr(Buf, RoutineName)) return - ! map2nacPt call NWTC_Library_PackMeshMapType(Buf, InData%map2nacPt) if (RegCheckErr(Buf, RoutineName)) return - ! map2hubPt call NWTC_Library_PackMeshMapType(Buf, InData%map2hubPt) if (RegCheckErr(Buf, RoutineName)) return - ! map2BldPt call RegPack(Buf, allocated(InData%map2BldPt)) if (allocated(InData%map2BldPt)) then call RegPackBounds(Buf, 1, lbound(InData%map2BldPt), ubound(InData%map2BldPt)) @@ -1516,7 +1302,6 @@ subroutine AD_Dvr_PackWTData(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! bld call RegPack(Buf, allocated(InData%bld)) if (allocated(InData%bld)) then call RegPackBounds(Buf, 1, lbound(InData%bld), ubound(InData%bld)) @@ -1527,66 +1312,48 @@ subroutine AD_Dvr_PackWTData(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! hub call AD_Dvr_PackHubData(Buf, InData%hub) if (RegCheckErr(Buf, RoutineName)) return - ! nac call AD_Dvr_PackNacData(Buf, InData%nac) if (RegCheckErr(Buf, RoutineName)) return - ! twr call AD_Dvr_PackTwrData(Buf, InData%twr) if (RegCheckErr(Buf, RoutineName)) return - ! numBlades call RegPack(Buf, InData%numBlades) if (RegCheckErr(Buf, RoutineName)) return - ! basicHAWTFormat call RegPack(Buf, InData%basicHAWTFormat) if (RegCheckErr(Buf, RoutineName)) return - ! hasTower call RegPack(Buf, InData%hasTower) if (RegCheckErr(Buf, RoutineName)) return - ! projMod call RegPack(Buf, InData%projMod) if (RegCheckErr(Buf, RoutineName)) return - ! BEM_Mod call RegPack(Buf, InData%BEM_Mod) if (RegCheckErr(Buf, RoutineName)) return - ! HAWTprojection call RegPack(Buf, InData%HAWTprojection) if (RegCheckErr(Buf, RoutineName)) return - ! motionType call RegPack(Buf, InData%motionType) if (RegCheckErr(Buf, RoutineName)) return - ! motion call RegPack(Buf, allocated(InData%motion)) if (allocated(InData%motion)) then call RegPackBounds(Buf, 2, lbound(InData%motion), ubound(InData%motion)) call RegPack(Buf, InData%motion) end if if (RegCheckErr(Buf, RoutineName)) return - ! iMotion call RegPack(Buf, InData%iMotion) if (RegCheckErr(Buf, RoutineName)) return - ! degreeOfFreedom call RegPack(Buf, InData%degreeOfFreedom) if (RegCheckErr(Buf, RoutineName)) return - ! amplitude call RegPack(Buf, InData%amplitude) if (RegCheckErr(Buf, RoutineName)) return - ! frequency call RegPack(Buf, InData%frequency) if (RegCheckErr(Buf, RoutineName)) return - ! motionFileName call RegPack(Buf, InData%motionFileName) if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutput call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) call RegPack(Buf, InData%WriteOutput) end if if (RegCheckErr(Buf, RoutineName)) return - ! userSwapArray call RegPack(Buf, allocated(InData%userSwapArray)) if (allocated(InData%userSwapArray)) then call RegPackBounds(Buf, 1, lbound(InData%userSwapArray), ubound(InData%userSwapArray)) @@ -1604,19 +1371,13 @@ subroutine AD_Dvr_UnPackWTData(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! originInit call RegUnpack(Buf, OutData%originInit) if (RegCheckErr(Buf, RoutineName)) return - ! orientationInit call RegUnpack(Buf, OutData%orientationInit) if (RegCheckErr(Buf, RoutineName)) return - ! map2twrPt call NWTC_Library_UnpackMeshMapType(Buf, OutData%map2twrPt) ! map2twrPt - ! map2nacPt call NWTC_Library_UnpackMeshMapType(Buf, OutData%map2nacPt) ! map2nacPt - ! map2hubPt call NWTC_Library_UnpackMeshMapType(Buf, OutData%map2hubPt) ! map2hubPt - ! map2BldPt if (allocated(OutData%map2BldPt)) deallocate(OutData%map2BldPt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1632,7 +1393,6 @@ subroutine AD_Dvr_UnPackWTData(Buf, OutData) call NWTC_Library_UnpackMeshMapType(Buf, OutData%map2BldPt(i1)) ! map2BldPt end do end if - ! bld if (allocated(OutData%bld)) deallocate(OutData%bld) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1648,34 +1408,23 @@ subroutine AD_Dvr_UnPackWTData(Buf, OutData) call AD_Dvr_UnpackBladeData(Buf, OutData%bld(i1)) ! bld end do end if - ! hub call AD_Dvr_UnpackHubData(Buf, OutData%hub) ! hub - ! nac call AD_Dvr_UnpackNacData(Buf, OutData%nac) ! nac - ! twr call AD_Dvr_UnpackTwrData(Buf, OutData%twr) ! twr - ! numBlades call RegUnpack(Buf, OutData%numBlades) if (RegCheckErr(Buf, RoutineName)) return - ! basicHAWTFormat call RegUnpack(Buf, OutData%basicHAWTFormat) if (RegCheckErr(Buf, RoutineName)) return - ! hasTower call RegUnpack(Buf, OutData%hasTower) if (RegCheckErr(Buf, RoutineName)) return - ! projMod call RegUnpack(Buf, OutData%projMod) if (RegCheckErr(Buf, RoutineName)) return - ! BEM_Mod call RegUnpack(Buf, OutData%BEM_Mod) if (RegCheckErr(Buf, RoutineName)) return - ! HAWTprojection call RegUnpack(Buf, OutData%HAWTprojection) if (RegCheckErr(Buf, RoutineName)) return - ! motionType call RegUnpack(Buf, OutData%motionType) if (RegCheckErr(Buf, RoutineName)) return - ! motion if (allocated(OutData%motion)) deallocate(OutData%motion) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1690,22 +1439,16 @@ subroutine AD_Dvr_UnPackWTData(Buf, OutData) call RegUnpack(Buf, OutData%motion) if (RegCheckErr(Buf, RoutineName)) return end if - ! iMotion call RegUnpack(Buf, OutData%iMotion) if (RegCheckErr(Buf, RoutineName)) return - ! degreeOfFreedom call RegUnpack(Buf, OutData%degreeOfFreedom) if (RegCheckErr(Buf, RoutineName)) return - ! amplitude call RegUnpack(Buf, OutData%amplitude) if (RegCheckErr(Buf, RoutineName)) return - ! frequency call RegUnpack(Buf, OutData%frequency) if (RegCheckErr(Buf, RoutineName)) return - ! motionFileName call RegUnpack(Buf, OutData%motionFileName) if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutput if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1720,7 +1463,6 @@ subroutine AD_Dvr_UnPackWTData(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutput) if (RegCheckErr(Buf, RoutineName)) return end if - ! userSwapArray if (allocated(OutData%userSwapArray)) deallocate(OutData%userSwapArray) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1736,130 +1478,129 @@ subroutine AD_Dvr_UnPackWTData(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE AD_Dvr_CopyDvr_SimData( SrcDvr_SimDataData, DstDvr_SimDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Dvr_SimData), INTENT(INOUT) :: SrcDvr_SimDataData - TYPE(Dvr_SimData), INTENT(INOUT) :: DstDvr_SimDataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - 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 ) - TYPE(Dvr_SimData), INTENT(INOUT) :: Dvr_SimDataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyDvr_SimData' - ErrStat = ErrID_None - ErrMsg = "" - -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 ) - 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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ADI_DestroyIW_InputData( Dvr_SimDataData%IW_InitInp, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_Dvr_DestroyDvr_SimData +subroutine AD_Dvr_CopyDvr_SimData(SrcDvr_SimDataData, DstDvr_SimDataData, CtrlCode, ErrStat, ErrMsg) + type(Dvr_SimData), intent(inout) :: SrcDvr_SimDataData + type(Dvr_SimData), intent(inout) :: DstDvr_SimDataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_Dvr_CopyDvr_SimData' + ErrStat = ErrID_None + ErrMsg = '' + DstDvr_SimDataData%AD_InputFile = SrcDvr_SimDataData%AD_InputFile + DstDvr_SimDataData%MHK = SrcDvr_SimDataData%MHK + DstDvr_SimDataData%AnalysisType = SrcDvr_SimDataData%AnalysisType + DstDvr_SimDataData%FldDens = SrcDvr_SimDataData%FldDens + DstDvr_SimDataData%KinVisc = SrcDvr_SimDataData%KinVisc + DstDvr_SimDataData%SpdSound = SrcDvr_SimDataData%SpdSound + DstDvr_SimDataData%Patm = SrcDvr_SimDataData%Patm + DstDvr_SimDataData%Pvap = SrcDvr_SimDataData%Pvap + DstDvr_SimDataData%WtrDpth = SrcDvr_SimDataData%WtrDpth + DstDvr_SimDataData%MSL2SWL = SrcDvr_SimDataData%MSL2SWL + DstDvr_SimDataData%numTurbines = SrcDvr_SimDataData%numTurbines + if (allocated(SrcDvr_SimDataData%WT)) then + LB(1:1) = lbound(SrcDvr_SimDataData%WT) + UB(1:1) = ubound(SrcDvr_SimDataData%WT) + if (.not. allocated(DstDvr_SimDataData%WT)) then + allocate(DstDvr_SimDataData%WT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_SimDataData%WT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_Dvr_CopyWTData(SrcDvr_SimDataData%WT(i1), DstDvr_SimDataData%WT(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstDvr_SimDataData%WT)) then + deallocate(DstDvr_SimDataData%WT) + end if + DstDvr_SimDataData%dT = SrcDvr_SimDataData%dT + DstDvr_SimDataData%tMax = SrcDvr_SimDataData%tMax + DstDvr_SimDataData%numSteps = SrcDvr_SimDataData%numSteps + DstDvr_SimDataData%numCases = SrcDvr_SimDataData%numCases + if (allocated(SrcDvr_SimDataData%Cases)) then + LB(1:1) = lbound(SrcDvr_SimDataData%Cases) + UB(1:1) = ubound(SrcDvr_SimDataData%Cases) + if (.not. allocated(DstDvr_SimDataData%Cases)) then + allocate(DstDvr_SimDataData%Cases(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_SimDataData%Cases.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_Dvr_CopyDvr_Case(SrcDvr_SimDataData%Cases(i1), DstDvr_SimDataData%Cases(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstDvr_SimDataData%Cases)) then + deallocate(DstDvr_SimDataData%Cases) + end if + DstDvr_SimDataData%iCase = SrcDvr_SimDataData%iCase + if (allocated(SrcDvr_SimDataData%timeSeries)) then + LB(1:2) = lbound(SrcDvr_SimDataData%timeSeries) + UB(1:2) = ubound(SrcDvr_SimDataData%timeSeries) + if (.not. allocated(DstDvr_SimDataData%timeSeries)) then + allocate(DstDvr_SimDataData%timeSeries(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDvr_SimDataData%timeSeries.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDvr_SimDataData%timeSeries = SrcDvr_SimDataData%timeSeries + else if (allocated(DstDvr_SimDataData%timeSeries)) then + deallocate(DstDvr_SimDataData%timeSeries) + end if + DstDvr_SimDataData%iTimeSeries = SrcDvr_SimDataData%iTimeSeries + DstDvr_SimDataData%root = SrcDvr_SimDataData%root + call AD_Dvr_CopyDvr_Outputs(SrcDvr_SimDataData%out, DstDvr_SimDataData%out, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ADI_CopyIW_InputData(SrcDvr_SimDataData%IW_InitInp, DstDvr_SimDataData%IW_InitInp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine AD_Dvr_DestroyDvr_SimData(Dvr_SimDataData, ErrStat, ErrMsg) + type(Dvr_SimData), intent(inout) :: Dvr_SimDataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_Dvr_DestroyDvr_SimData' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(Dvr_SimDataData%WT)) then + LB(1:1) = lbound(Dvr_SimDataData%WT) + UB(1:1) = ubound(Dvr_SimDataData%WT) + do i1 = LB(1), UB(1) + call AD_Dvr_DestroyWTData(Dvr_SimDataData%WT(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(Dvr_SimDataData%WT) + end if + if (allocated(Dvr_SimDataData%Cases)) then + LB(1:1) = lbound(Dvr_SimDataData%Cases) + UB(1:1) = ubound(Dvr_SimDataData%Cases) + do i1 = LB(1), UB(1) + call AD_Dvr_DestroyDvr_Case(Dvr_SimDataData%Cases(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(Dvr_SimDataData%Cases) + end if + if (allocated(Dvr_SimDataData%timeSeries)) then + deallocate(Dvr_SimDataData%timeSeries) + end if +end subroutine subroutine AD_Dvr_PackDvr_SimData(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -1868,40 +1609,28 @@ subroutine AD_Dvr_PackDvr_SimData(Buf, Indata) integer(IntKi) :: i1, i2 integer(IntKi) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return - ! AD_InputFile call RegPack(Buf, InData%AD_InputFile) if (RegCheckErr(Buf, RoutineName)) return - ! MHK call RegPack(Buf, InData%MHK) if (RegCheckErr(Buf, RoutineName)) return - ! AnalysisType call RegPack(Buf, InData%AnalysisType) if (RegCheckErr(Buf, RoutineName)) return - ! FldDens call RegPack(Buf, InData%FldDens) if (RegCheckErr(Buf, RoutineName)) return - ! KinVisc call RegPack(Buf, InData%KinVisc) if (RegCheckErr(Buf, RoutineName)) return - ! SpdSound call RegPack(Buf, InData%SpdSound) if (RegCheckErr(Buf, RoutineName)) return - ! Patm call RegPack(Buf, InData%Patm) if (RegCheckErr(Buf, RoutineName)) return - ! Pvap call RegPack(Buf, InData%Pvap) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDpth call RegPack(Buf, InData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - ! MSL2SWL call RegPack(Buf, InData%MSL2SWL) if (RegCheckErr(Buf, RoutineName)) return - ! numTurbines call RegPack(Buf, InData%numTurbines) if (RegCheckErr(Buf, RoutineName)) return - ! WT call RegPack(Buf, allocated(InData%WT)) if (allocated(InData%WT)) then call RegPackBounds(Buf, 1, lbound(InData%WT), ubound(InData%WT)) @@ -1912,19 +1641,14 @@ subroutine AD_Dvr_PackDvr_SimData(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! dT call RegPack(Buf, InData%dT) if (RegCheckErr(Buf, RoutineName)) return - ! tMax call RegPack(Buf, InData%tMax) if (RegCheckErr(Buf, RoutineName)) return - ! numSteps call RegPack(Buf, InData%numSteps) if (RegCheckErr(Buf, RoutineName)) return - ! numCases call RegPack(Buf, InData%numCases) if (RegCheckErr(Buf, RoutineName)) return - ! Cases call RegPack(Buf, allocated(InData%Cases)) if (allocated(InData%Cases)) then call RegPackBounds(Buf, 1, lbound(InData%Cases), ubound(InData%Cases)) @@ -1935,26 +1659,20 @@ subroutine AD_Dvr_PackDvr_SimData(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! iCase call RegPack(Buf, InData%iCase) if (RegCheckErr(Buf, RoutineName)) return - ! timeSeries call RegPack(Buf, allocated(InData%timeSeries)) if (allocated(InData%timeSeries)) then call RegPackBounds(Buf, 2, lbound(InData%timeSeries), ubound(InData%timeSeries)) call RegPack(Buf, InData%timeSeries) end if if (RegCheckErr(Buf, RoutineName)) return - ! iTimeSeries call RegPack(Buf, InData%iTimeSeries) if (RegCheckErr(Buf, RoutineName)) return - ! root call RegPack(Buf, InData%root) if (RegCheckErr(Buf, RoutineName)) return - ! out call AD_Dvr_PackDvr_Outputs(Buf, InData%out) if (RegCheckErr(Buf, RoutineName)) return - ! IW_InitInp call ADI_PackIW_InputData(Buf, InData%IW_InitInp) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1968,40 +1686,28 @@ subroutine AD_Dvr_UnPackDvr_SimData(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! AD_InputFile call RegUnpack(Buf, OutData%AD_InputFile) if (RegCheckErr(Buf, RoutineName)) return - ! MHK call RegUnpack(Buf, OutData%MHK) if (RegCheckErr(Buf, RoutineName)) return - ! AnalysisType call RegUnpack(Buf, OutData%AnalysisType) if (RegCheckErr(Buf, RoutineName)) return - ! FldDens call RegUnpack(Buf, OutData%FldDens) if (RegCheckErr(Buf, RoutineName)) return - ! KinVisc call RegUnpack(Buf, OutData%KinVisc) if (RegCheckErr(Buf, RoutineName)) return - ! SpdSound call RegUnpack(Buf, OutData%SpdSound) if (RegCheckErr(Buf, RoutineName)) return - ! Patm call RegUnpack(Buf, OutData%Patm) if (RegCheckErr(Buf, RoutineName)) return - ! Pvap call RegUnpack(Buf, OutData%Pvap) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDpth call RegUnpack(Buf, OutData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - ! MSL2SWL call RegUnpack(Buf, OutData%MSL2SWL) if (RegCheckErr(Buf, RoutineName)) return - ! numTurbines call RegUnpack(Buf, OutData%numTurbines) if (RegCheckErr(Buf, RoutineName)) return - ! WT if (allocated(OutData%WT)) deallocate(OutData%WT) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2017,19 +1723,14 @@ subroutine AD_Dvr_UnPackDvr_SimData(Buf, OutData) call AD_Dvr_UnpackWTData(Buf, OutData%WT(i1)) ! WT end do end if - ! dT call RegUnpack(Buf, OutData%dT) if (RegCheckErr(Buf, RoutineName)) return - ! tMax call RegUnpack(Buf, OutData%tMax) if (RegCheckErr(Buf, RoutineName)) return - ! numSteps call RegUnpack(Buf, OutData%numSteps) if (RegCheckErr(Buf, RoutineName)) return - ! numCases call RegUnpack(Buf, OutData%numCases) if (RegCheckErr(Buf, RoutineName)) return - ! Cases if (allocated(OutData%Cases)) deallocate(OutData%Cases) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2045,10 +1746,8 @@ subroutine AD_Dvr_UnPackDvr_SimData(Buf, OutData) call AD_Dvr_UnpackDvr_Case(Buf, OutData%Cases(i1)) ! Cases end do end if - ! iCase call RegUnpack(Buf, OutData%iCase) if (RegCheckErr(Buf, RoutineName)) return - ! timeSeries if (allocated(OutData%timeSeries)) deallocate(OutData%timeSeries) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2063,88 +1762,65 @@ subroutine AD_Dvr_UnPackDvr_SimData(Buf, OutData) call RegUnpack(Buf, OutData%timeSeries) if (RegCheckErr(Buf, RoutineName)) return end if - ! iTimeSeries call RegUnpack(Buf, OutData%iTimeSeries) if (RegCheckErr(Buf, RoutineName)) return - ! root call RegUnpack(Buf, OutData%root) if (RegCheckErr(Buf, RoutineName)) return - ! out call AD_Dvr_UnpackDvr_Outputs(Buf, OutData%out) ! out - ! IW_InitInp call ADI_UnpackIW_InputData(Buf, OutData%IW_InitInp) ! IW_InitInp end subroutine - SUBROUTINE AD_Dvr_CopyAllData( SrcAllDataData, DstAllDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AllData), INTENT(INOUT) :: SrcAllDataData - TYPE(AllData), INTENT(INOUT) :: DstAllDataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! 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 ) - TYPE(AllData), INTENT(INOUT) :: AllDataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Dvr_DestroyAllData' - - ErrStat = ErrID_None - ErrMsg = "" - CALL AD_Dvr_DestroyDvr_SimData( AllDataData%dvr, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ADI_DestroyData( AllDataData%ADI, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ADI_DestroyFED_Data( AllDataData%FED, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_Dvr_DestroyAllData +subroutine AD_Dvr_CopyAllData(SrcAllDataData, DstAllDataData, CtrlCode, ErrStat, ErrMsg) + type(AllData), intent(inout) :: SrcAllDataData + type(AllData), intent(inout) :: DstAllDataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_Dvr_CopyAllData' + ErrStat = ErrID_None + ErrMsg = '' + call AD_Dvr_CopyDvr_SimData(SrcAllDataData%dvr, DstAllDataData%dvr, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ADI_CopyData(SrcAllDataData%ADI, DstAllDataData%ADI, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ADI_CopyFED_Data(SrcAllDataData%FED, DstAllDataData%FED, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstAllDataData%errStat = SrcAllDataData%errStat + DstAllDataData%errMsg = SrcAllDataData%errMsg + DstAllDataData%initialized = SrcAllDataData%initialized +end subroutine +subroutine AD_Dvr_DestroyAllData(AllDataData, ErrStat, ErrMsg) + type(AllData), intent(inout) :: AllDataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_Dvr_DestroyAllData' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine AD_Dvr_PackAllData(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AllData), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_Dvr_PackAllData' if (Buf%ErrStat >= AbortErrLev) return - ! dvr call AD_Dvr_PackDvr_SimData(Buf, InData%dvr) if (RegCheckErr(Buf, RoutineName)) return - ! ADI call ADI_PackData(Buf, InData%ADI) if (RegCheckErr(Buf, RoutineName)) return - ! FED call ADI_PackFED_Data(Buf, InData%FED) if (RegCheckErr(Buf, RoutineName)) return - ! errStat call RegPack(Buf, InData%errStat) if (RegCheckErr(Buf, RoutineName)) return - ! errMsg call RegPack(Buf, InData%errMsg) if (RegCheckErr(Buf, RoutineName)) return - ! initialized call RegPack(Buf, InData%initialized) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2154,19 +1830,13 @@ subroutine AD_Dvr_UnPackAllData(Buf, OutData) type(AllData), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_Dvr_UnPackAllData' if (Buf%ErrStat /= ErrID_None) return - ! dvr call AD_Dvr_UnpackDvr_SimData(Buf, OutData%dvr) ! dvr - ! ADI call ADI_UnpackData(Buf, OutData%ADI) ! ADI - ! FED call ADI_UnpackFED_Data(Buf, OutData%FED) ! FED - ! errStat call RegUnpack(Buf, OutData%errStat) if (RegCheckErr(Buf, RoutineName)) return - ! errMsg call RegUnpack(Buf, OutData%errMsg) if (RegCheckErr(Buf, RoutineName)) return - ! initialized call RegUnpack(Buf, OutData%initialized) if (RegCheckErr(Buf, RoutineName)) return end subroutine diff --git a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 index fa424639b8..88c1621b50 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 @@ -175,121 +175,86 @@ MODULE AeroDyn_Inflow_Types END TYPE FED_Data ! ======================= CONTAINS - SUBROUTINE ADI_CopyInflowWindData( SrcInflowWindDataData, DstInflowWindDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ADI_InflowWindData), INTENT(IN) :: SrcInflowWindDataData - TYPE(ADI_InflowWindData), INTENT(INOUT) :: DstInflowWindDataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: 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 ) - TYPE(ADI_InflowWindData), INTENT(INOUT) :: InflowWindDataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyInflowWindData' - ErrStat = ErrID_None - ErrMsg = "" - - CALL InflowWind_DestroyContState( InflowWindDataData%x, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyDiscState( InflowWindDataData%xd, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyConstrState( InflowWindDataData%z, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyOtherState( InflowWindDataData%OtherSt, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyParam( InflowWindDataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyMisc( InflowWindDataData%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyInput( InflowWindDataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyOutput( InflowWindDataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE ADI_DestroyInflowWindData +subroutine ADI_CopyInflowWindData(SrcInflowWindDataData, DstInflowWindDataData, CtrlCode, ErrStat, ErrMsg) + type(ADI_InflowWindData), intent(in) :: SrcInflowWindDataData + type(ADI_InflowWindData), intent(inout) :: DstInflowWindDataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_CopyInflowWindData' + ErrStat = ErrID_None + ErrMsg = '' + call InflowWind_CopyContState(SrcInflowWindDataData%x, DstInflowWindDataData%x, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyDiscState(SrcInflowWindDataData%xd, DstInflowWindDataData%xd, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyConstrState(SrcInflowWindDataData%z, DstInflowWindDataData%z, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyOtherState(SrcInflowWindDataData%OtherSt, DstInflowWindDataData%OtherSt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyParam(SrcInflowWindDataData%p, DstInflowWindDataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyMisc(SrcInflowWindDataData%m, DstInflowWindDataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyInput(SrcInflowWindDataData%u, DstInflowWindDataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyOutput(SrcInflowWindDataData%y, DstInflowWindDataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInflowWindDataData%CompInflow = SrcInflowWindDataData%CompInflow + DstInflowWindDataData%HWindSpeed = SrcInflowWindDataData%HWindSpeed + DstInflowWindDataData%RefHt = SrcInflowWindDataData%RefHt + DstInflowWindDataData%PLExp = SrcInflowWindDataData%PLExp +end subroutine +subroutine ADI_DestroyInflowWindData(InflowWindDataData, ErrStat, ErrMsg) + type(ADI_InflowWindData), intent(inout) :: InflowWindDataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_DestroyInflowWindData' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine ADI_PackInflowWindData(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ADI_InflowWindData), intent(in) :: InData character(*), parameter :: RoutineName = 'ADI_PackInflowWindData' if (Buf%ErrStat >= AbortErrLev) return - ! x call InflowWind_PackContState(Buf, InData%x) if (RegCheckErr(Buf, RoutineName)) return - ! xd call InflowWind_PackDiscState(Buf, InData%xd) if (RegCheckErr(Buf, RoutineName)) return - ! z call InflowWind_PackConstrState(Buf, InData%z) if (RegCheckErr(Buf, RoutineName)) return - ! OtherSt call InflowWind_PackOtherState(Buf, InData%OtherSt) if (RegCheckErr(Buf, RoutineName)) return - ! p call InflowWind_PackParam(Buf, InData%p) if (RegCheckErr(Buf, RoutineName)) return - ! m call InflowWind_PackMisc(Buf, InData%m) if (RegCheckErr(Buf, RoutineName)) return - ! u call InflowWind_PackInput(Buf, InData%u) if (RegCheckErr(Buf, RoutineName)) return - ! y call InflowWind_PackOutput(Buf, InData%y) if (RegCheckErr(Buf, RoutineName)) return - ! CompInflow call RegPack(Buf, InData%CompInflow) if (RegCheckErr(Buf, RoutineName)) return - ! HWindSpeed call RegPack(Buf, InData%HWindSpeed) if (RegCheckErr(Buf, RoutineName)) return - ! RefHt call RegPack(Buf, InData%RefHt) if (RegCheckErr(Buf, RoutineName)) return - ! PLExp call RegPack(Buf, InData%PLExp) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -299,110 +264,80 @@ subroutine ADI_UnPackInflowWindData(Buf, OutData) type(ADI_InflowWindData), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADI_UnPackInflowWindData' if (Buf%ErrStat /= ErrID_None) return - ! x call InflowWind_UnpackContState(Buf, OutData%x) ! x - ! xd call InflowWind_UnpackDiscState(Buf, OutData%xd) ! xd - ! z call InflowWind_UnpackConstrState(Buf, OutData%z) ! z - ! OtherSt call InflowWind_UnpackOtherState(Buf, OutData%OtherSt) ! OtherSt - ! p call InflowWind_UnpackParam(Buf, OutData%p) ! p - ! m call InflowWind_UnpackMisc(Buf, OutData%m) ! m - ! u call InflowWind_UnpackInput(Buf, OutData%u) ! u - ! y call InflowWind_UnpackOutput(Buf, OutData%y) ! y - ! CompInflow call RegUnpack(Buf, OutData%CompInflow) if (RegCheckErr(Buf, RoutineName)) return - ! HWindSpeed call RegUnpack(Buf, OutData%HWindSpeed) if (RegCheckErr(Buf, RoutineName)) return - ! RefHt call RegUnpack(Buf, OutData%RefHt) if (RegCheckErr(Buf, RoutineName)) return - ! PLExp call RegUnpack(Buf, OutData%PLExp) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE ADI_CopyIW_InputData( SrcIW_InputDataData, DstIW_InputDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ADI_IW_InputData), INTENT(IN) :: SrcIW_InputDataData - TYPE(ADI_IW_InputData), INTENT(INOUT) :: DstIW_InputDataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! 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%MHK = SrcIW_InputDataData%MHK - DstIW_InputDataData%UseInputFile = SrcIW_InputDataData%UseInputFile - CALL NWTC_Library_Copyfileinfotype( SrcIW_InputDataData%PassedFileData, DstIW_InputDataData%PassedFileData, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstIW_InputDataData%Linearize = SrcIW_InputDataData%Linearize - END SUBROUTINE ADI_CopyIW_InputData - - SUBROUTINE ADI_DestroyIW_InputData( IW_InputDataData, ErrStat, ErrMsg ) - TYPE(ADI_IW_InputData), INTENT(INOUT) :: IW_InputDataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyIW_InputData' - ErrStat = ErrID_None - ErrMsg = "" - - CALL NWTC_Library_DestroyFileInfoType( IW_InputDataData%PassedFileData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE ADI_DestroyIW_InputData +subroutine ADI_CopyIW_InputData(SrcIW_InputDataData, DstIW_InputDataData, CtrlCode, ErrStat, ErrMsg) + type(ADI_IW_InputData), intent(in) :: SrcIW_InputDataData + type(ADI_IW_InputData), intent(inout) :: DstIW_InputDataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_CopyIW_InputData' + ErrStat = ErrID_None + ErrMsg = '' + DstIW_InputDataData%InputFile = SrcIW_InputDataData%InputFile + DstIW_InputDataData%CompInflow = SrcIW_InputDataData%CompInflow + DstIW_InputDataData%HWindSpeed = SrcIW_InputDataData%HWindSpeed + DstIW_InputDataData%RefHt = SrcIW_InputDataData%RefHt + DstIW_InputDataData%PLExp = SrcIW_InputDataData%PLExp + DstIW_InputDataData%MHK = SrcIW_InputDataData%MHK + DstIW_InputDataData%UseInputFile = SrcIW_InputDataData%UseInputFile + call NWTC_Library_CopyFileInfoType(SrcIW_InputDataData%PassedFileData, DstIW_InputDataData%PassedFileData, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstIW_InputDataData%Linearize = SrcIW_InputDataData%Linearize +end subroutine +subroutine ADI_DestroyIW_InputData(IW_InputDataData, ErrStat, ErrMsg) + type(ADI_IW_InputData), intent(inout) :: IW_InputDataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_DestroyIW_InputData' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine ADI_PackIW_InputData(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ADI_IW_InputData), intent(in) :: InData character(*), parameter :: RoutineName = 'ADI_PackIW_InputData' if (Buf%ErrStat >= AbortErrLev) return - ! InputFile call RegPack(Buf, InData%InputFile) if (RegCheckErr(Buf, RoutineName)) return - ! CompInflow call RegPack(Buf, InData%CompInflow) if (RegCheckErr(Buf, RoutineName)) return - ! HWindSpeed call RegPack(Buf, InData%HWindSpeed) if (RegCheckErr(Buf, RoutineName)) return - ! RefHt call RegPack(Buf, InData%RefHt) if (RegCheckErr(Buf, RoutineName)) return - ! PLExp call RegPack(Buf, InData%PLExp) if (RegCheckErr(Buf, RoutineName)) return - ! MHK call RegPack(Buf, InData%MHK) if (RegCheckErr(Buf, RoutineName)) return - ! UseInputFile call RegPack(Buf, InData%UseInputFile) if (RegCheckErr(Buf, RoutineName)) return - ! PassedFileData call NWTC_Library_PackFileInfoType(Buf, InData%PassedFileData) if (RegCheckErr(Buf, RoutineName)) return - ! Linearize call RegPack(Buf, InData%Linearize) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -412,104 +347,77 @@ subroutine ADI_UnPackIW_InputData(Buf, OutData) type(ADI_IW_InputData), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADI_UnPackIW_InputData' if (Buf%ErrStat /= ErrID_None) return - ! InputFile call RegUnpack(Buf, OutData%InputFile) if (RegCheckErr(Buf, RoutineName)) return - ! CompInflow call RegUnpack(Buf, OutData%CompInflow) if (RegCheckErr(Buf, RoutineName)) return - ! HWindSpeed call RegUnpack(Buf, OutData%HWindSpeed) if (RegCheckErr(Buf, RoutineName)) return - ! RefHt call RegUnpack(Buf, OutData%RefHt) if (RegCheckErr(Buf, RoutineName)) return - ! PLExp call RegUnpack(Buf, OutData%PLExp) if (RegCheckErr(Buf, RoutineName)) return - ! MHK call RegUnpack(Buf, OutData%MHK) if (RegCheckErr(Buf, RoutineName)) return - ! UseInputFile call RegUnpack(Buf, OutData%UseInputFile) if (RegCheckErr(Buf, RoutineName)) return - ! PassedFileData call NWTC_Library_UnpackFileInfoType(Buf, OutData%PassedFileData) ! PassedFileData - ! Linearize call RegUnpack(Buf, OutData%Linearize) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE ADI_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ADI_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(ADI_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! 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 - DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth - END SUBROUTINE ADI_CopyInitInput - - SUBROUTINE ADI_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(ADI_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyInitInput' - ErrStat = ErrID_None - ErrMsg = "" - - CALL AD_DestroyInitInput( InitInputData%AD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ADI_DestroyIW_InputData( InitInputData%IW_InitInp, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE ADI_DestroyInitInput +subroutine ADI_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(ADI_InitInputType), intent(in) :: SrcInitInputData + type(ADI_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + call AD_CopyInitInput(SrcInitInputData%AD, DstInitInputData%AD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ADI_CopyIW_InputData(SrcInitInputData%IW_InitInp, DstInitInputData%IW_InitInp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitInputData%RootName = SrcInitInputData%RootName + DstInitInputData%storeHHVel = SrcInitInputData%storeHHVel + DstInitInputData%WrVTK = SrcInitInputData%WrVTK + DstInitInputData%WrVTK_Type = SrcInitInputData%WrVTK_Type + DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth +end subroutine +subroutine ADI_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(ADI_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine ADI_PackInitInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ADI_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'ADI_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return - ! AD call AD_PackInitInput(Buf, InData%AD) if (RegCheckErr(Buf, RoutineName)) return - ! IW_InitInp call ADI_PackIW_InputData(Buf, InData%IW_InitInp) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegPack(Buf, InData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! storeHHVel call RegPack(Buf, InData%storeHHVel) if (RegCheckErr(Buf, RoutineName)) return - ! WrVTK call RegPack(Buf, InData%WrVTK) if (RegCheckErr(Buf, RoutineName)) return - ! WrVTK_Type call RegPack(Buf, InData%WrVTK_Type) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDpth call RegPack(Buf, InData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -519,110 +427,95 @@ subroutine ADI_UnPackInitInput(Buf, OutData) type(ADI_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADI_UnPackInitInput' if (Buf%ErrStat /= ErrID_None) return - ! AD call AD_UnpackInitInput(Buf, OutData%AD) ! AD - ! IW_InitInp call ADI_UnpackIW_InputData(Buf, OutData%IW_InitInp) ! IW_InitInp - ! RootName call RegUnpack(Buf, OutData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! storeHHVel call RegUnpack(Buf, OutData%storeHHVel) if (RegCheckErr(Buf, RoutineName)) return - ! WrVTK call RegUnpack(Buf, OutData%WrVTK) if (RegCheckErr(Buf, RoutineName)) return - ! WrVTK_Type call RegUnpack(Buf, OutData%WrVTK_Type) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDpth call RegUnpack(Buf, OutData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE ADI_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ADI_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(ADI_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - 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 ) - TYPE(ADI_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF - END SUBROUTINE ADI_DestroyInitOutput +subroutine ADI_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(ADI_InitOutputType), intent(in) :: SrcInitOutputData + type(ADI_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(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 + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr + else if (allocated(DstInitOutputData%WriteOutputHdr)) then + deallocate(DstInitOutputData%WriteOutputHdr) + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt + else if (allocated(DstInitOutputData%WriteOutputUnt)) then + deallocate(DstInitOutputData%WriteOutputUnt) + end if +end subroutine +subroutine ADI_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(ADI_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if +end subroutine subroutine ADI_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ADI_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'ADI_PackInitOutput' if (Buf%ErrStat >= AbortErrLev) return - ! Ver call NWTC_Library_PackProgDesc(Buf, InData%Ver) if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutputHdr call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) call RegPack(Buf, InData%WriteOutputHdr) end if if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutputUnt call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) @@ -639,9 +532,7 @@ subroutine ADI_UnPackInitOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! Ver call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver - ! WriteOutputHdr if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -656,7 +547,6 @@ subroutine ADI_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutputHdr) if (RegCheckErr(Buf, RoutineName)) return end if - ! WriteOutputUnt if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -672,49 +562,39 @@ subroutine ADI_UnPackInitOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE ADI_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ADI_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(ADI_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! 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 ) - TYPE(ADI_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - CALL AD_DestroyContState( ContStateData%AD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE ADI_DestroyContState +subroutine ADI_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(ADI_ContinuousStateType), intent(in) :: SrcContStateData + type(ADI_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + call AD_CopyContState(SrcContStateData%AD, DstContStateData%AD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine ADI_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(ADI_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine ADI_PackContState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ADI_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'ADI_PackContState' if (Buf%ErrStat >= AbortErrLev) return - ! AD call AD_PackContState(Buf, InData%AD) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -724,52 +604,41 @@ subroutine ADI_UnPackContState(Buf, OutData) type(ADI_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADI_UnPackContState' if (Buf%ErrStat /= ErrID_None) return - ! AD call AD_UnpackContState(Buf, OutData%AD) ! AD end subroutine - SUBROUTINE ADI_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ADI_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(ADI_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! 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 ) - TYPE(ADI_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - CALL AD_DestroyDiscState( DiscStateData%AD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE ADI_DestroyDiscState +subroutine ADI_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(ADI_DiscreteStateType), intent(in) :: SrcDiscStateData + type(ADI_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + call AD_CopyDiscState(SrcDiscStateData%AD, DstDiscStateData%AD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine ADI_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(ADI_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine ADI_PackDiscState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ADI_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'ADI_PackDiscState' if (Buf%ErrStat >= AbortErrLev) return - ! AD call AD_PackDiscState(Buf, InData%AD) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -779,52 +648,41 @@ subroutine ADI_UnPackDiscState(Buf, OutData) type(ADI_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADI_UnPackDiscState' if (Buf%ErrStat /= ErrID_None) return - ! AD call AD_UnpackDiscState(Buf, OutData%AD) ! AD end subroutine - SUBROUTINE ADI_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ADI_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(ADI_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! 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 ) - TYPE(ADI_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyConstrState' - ErrStat = ErrID_None - ErrMsg = "" - - CALL AD_DestroyConstrState( ConstrStateData%AD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE ADI_DestroyConstrState +subroutine ADI_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(ADI_ConstraintStateType), intent(in) :: SrcConstrStateData + type(ADI_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + call AD_CopyConstrState(SrcConstrStateData%AD, DstConstrStateData%AD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine ADI_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(ADI_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine ADI_PackConstrState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ADI_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'ADI_PackConstrState' if (Buf%ErrStat >= AbortErrLev) return - ! AD call AD_PackConstrState(Buf, InData%AD) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -834,52 +692,41 @@ subroutine ADI_UnPackConstrState(Buf, OutData) type(ADI_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADI_UnPackConstrState' if (Buf%ErrStat /= ErrID_None) return - ! AD call AD_UnpackConstrState(Buf, OutData%AD) ! AD end subroutine - SUBROUTINE ADI_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ADI_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(ADI_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! 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 ) - TYPE(ADI_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyOtherState' - ErrStat = ErrID_None - ErrMsg = "" - - CALL AD_DestroyOtherState( OtherStateData%AD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE ADI_DestroyOtherState +subroutine ADI_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(ADI_OtherStateType), intent(in) :: SrcOtherStateData + type(ADI_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + call AD_CopyOtherState(SrcOtherStateData%AD, DstOtherStateData%AD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine ADI_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(ADI_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine ADI_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ADI_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'ADI_PackOtherState' if (Buf%ErrStat >= AbortErrLev) return - ! AD call AD_PackOtherState(Buf, InData%AD) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -889,74 +736,69 @@ subroutine ADI_UnPackOtherState(Buf, OutData) type(ADI_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADI_UnPackOtherState' if (Buf%ErrStat /= ErrID_None) return - ! AD call AD_UnpackOtherState(Buf, OutData%AD) ! AD end subroutine - SUBROUTINE ADI_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ADI_MiscVarType), INTENT(INOUT) :: SrcMiscData - TYPE(ADI_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - 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 ) - TYPE(ADI_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyMisc' - ErrStat = ErrID_None - ErrMsg = "" - - CALL AD_DestroyMisc( MiscData%AD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ADI_DestroyInflowWindData( MiscData%IW, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MiscData%VTK_surfaces)) THEN -DO i1 = LBOUND(MiscData%VTK_surfaces,1), UBOUND(MiscData%VTK_surfaces,1) - CALL AD_DestroyVTK_RotSurfaceType( MiscData%VTK_surfaces(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%VTK_surfaces) -ENDIF - END SUBROUTINE ADI_DestroyMisc +subroutine ADI_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(ADI_MiscVarType), intent(inout) :: SrcMiscData + type(ADI_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call AD_CopyMisc(SrcMiscData%AD, DstMiscData%AD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ADI_CopyInflowWindData(SrcMiscData%IW, DstMiscData%IW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMiscData%VTK_surfaces)) then + LB(1:1) = lbound(SrcMiscData%VTK_surfaces) + UB(1:1) = ubound(SrcMiscData%VTK_surfaces) + if (.not. allocated(DstMiscData%VTK_surfaces)) then + allocate(DstMiscData%VTK_surfaces(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%VTK_surfaces.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyVTK_RotSurfaceType(SrcMiscData%VTK_surfaces(i1), DstMiscData%VTK_surfaces(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstMiscData%VTK_surfaces)) then + deallocate(DstMiscData%VTK_surfaces) + end if +end subroutine +subroutine ADI_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(ADI_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%VTK_surfaces)) then + LB(1:1) = lbound(MiscData%VTK_surfaces) + UB(1:1) = ubound(MiscData%VTK_surfaces) + do i1 = LB(1), UB(1) + call AD_DestroyVTK_RotSurfaceType(MiscData%VTK_surfaces(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%VTK_surfaces) + end if +end subroutine subroutine ADI_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -965,13 +807,10 @@ subroutine ADI_PackMisc(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! AD call AD_PackMisc(Buf, InData%AD) if (RegCheckErr(Buf, RoutineName)) return - ! IW call ADI_PackInflowWindData(Buf, InData%IW) if (RegCheckErr(Buf, RoutineName)) return - ! VTK_surfaces call RegPack(Buf, allocated(InData%VTK_surfaces)) if (allocated(InData%VTK_surfaces)) then call RegPackBounds(Buf, 1, lbound(InData%VTK_surfaces), ubound(InData%VTK_surfaces)) @@ -993,11 +832,8 @@ subroutine ADI_UnPackMisc(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! AD call AD_UnpackMisc(Buf, OutData%AD) ! AD - ! IW call ADI_UnpackInflowWindData(Buf, OutData%IW) ! IW - ! VTK_surfaces if (allocated(OutData%VTK_surfaces)) deallocate(OutData%VTK_surfaces) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1014,77 +850,60 @@ subroutine ADI_UnPackMisc(Buf, OutData) end do end if end subroutine - SUBROUTINE ADI_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ADI_ParameterType), INTENT(IN) :: SrcParamData - TYPE(ADI_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! 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 - DstParamData%MHK = SrcParamData%MHK - DstParamData%WtrDpth = SrcParamData%WtrDpth - END SUBROUTINE ADI_CopyParam - SUBROUTINE ADI_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(ADI_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL AD_DestroyParam( ParamData%AD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE ADI_DestroyParam +subroutine ADI_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(ADI_ParameterType), intent(in) :: SrcParamData + type(ADI_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + call AD_CopyParam(SrcParamData%AD, DstParamData%AD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstParamData%dt = SrcParamData%dt + DstParamData%storeHHVel = SrcParamData%storeHHVel + DstParamData%wrVTK = SrcParamData%wrVTK + DstParamData%WrVTK_Type = SrcParamData%WrVTK_Type + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%MHK = SrcParamData%MHK + DstParamData%WtrDpth = SrcParamData%WtrDpth +end subroutine +subroutine ADI_DestroyParam(ParamData, ErrStat, ErrMsg) + type(ADI_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine ADI_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ADI_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'ADI_PackParam' if (Buf%ErrStat >= AbortErrLev) return - ! AD call AD_PackParam(Buf, InData%AD) if (RegCheckErr(Buf, RoutineName)) return - ! dt call RegPack(Buf, InData%dt) if (RegCheckErr(Buf, RoutineName)) return - ! storeHHVel call RegPack(Buf, InData%storeHHVel) if (RegCheckErr(Buf, RoutineName)) return - ! wrVTK call RegPack(Buf, InData%wrVTK) if (RegCheckErr(Buf, RoutineName)) return - ! WrVTK_Type call RegPack(Buf, InData%WrVTK_Type) if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegPack(Buf, InData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! MHK call RegPack(Buf, InData%MHK) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDpth call RegPack(Buf, InData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1094,73 +913,55 @@ subroutine ADI_UnPackParam(Buf, OutData) type(ADI_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADI_UnPackParam' if (Buf%ErrStat /= ErrID_None) return - ! AD call AD_UnpackParam(Buf, OutData%AD) ! AD - ! dt call RegUnpack(Buf, OutData%dt) if (RegCheckErr(Buf, RoutineName)) return - ! storeHHVel call RegUnpack(Buf, OutData%storeHHVel) if (RegCheckErr(Buf, RoutineName)) return - ! wrVTK call RegUnpack(Buf, OutData%wrVTK) if (RegCheckErr(Buf, RoutineName)) return - ! WrVTK_Type call RegUnpack(Buf, OutData%WrVTK_Type) if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegUnpack(Buf, OutData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! MHK call RegUnpack(Buf, OutData%MHK) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDpth call RegUnpack(Buf, OutData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE ADI_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ADI_InputType), INTENT(INOUT) :: SrcInputData - TYPE(ADI_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! 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 ) - TYPE(ADI_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL AD_DestroyInput( InputData%AD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE ADI_DestroyInput +subroutine ADI_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(ADI_InputType), intent(inout) :: SrcInputData + type(ADI_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + call AD_CopyInput(SrcInputData%AD, DstInputData%AD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine ADI_DestroyInput(InputData, ErrStat, ErrMsg) + type(ADI_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine ADI_PackInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ADI_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'ADI_PackInput' if (Buf%ErrStat >= AbortErrLev) return - ! AD call AD_PackInput(Buf, InData%AD) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1170,122 +971,110 @@ subroutine ADI_UnPackInput(Buf, OutData) type(ADI_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADI_UnPackInput' if (Buf%ErrStat /= ErrID_None) return - ! AD call AD_UnpackInput(Buf, OutData%AD) ! AD end subroutine - SUBROUTINE ADI_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ADI_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(ADI_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - 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 ) - TYPE(ADI_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyOutput' - ErrStat = ErrID_None - ErrMsg = "" - - CALL AD_DestroyOutput( OutputData%AD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(OutputData%HHVel)) THEN - DEALLOCATE(OutputData%HHVel) -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_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(ADI_OutputType), intent(inout) :: SrcOutputData + type(ADI_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call AD_CopyOutput(SrcOutputData%AD, DstOutputData%AD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcOutputData%HHVel)) then + LB(1:2) = lbound(SrcOutputData%HHVel) + UB(1:2) = ubound(SrcOutputData%HHVel) + if (.not. allocated(DstOutputData%HHVel)) then + allocate(DstOutputData%HHVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%HHVel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%HHVel = SrcOutputData%HHVel + else if (allocated(DstOutputData%HHVel)) then + deallocate(DstOutputData%HHVel) + end if + DstOutputData%PLExp = SrcOutputData%PLExp + if (allocated(SrcOutputData%IW_WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%IW_WriteOutput) + UB(1:1) = ubound(SrcOutputData%IW_WriteOutput) + if (.not. allocated(DstOutputData%IW_WriteOutput)) then + allocate(DstOutputData%IW_WriteOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%IW_WriteOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%IW_WriteOutput = SrcOutputData%IW_WriteOutput + else if (allocated(DstOutputData%IW_WriteOutput)) then + deallocate(DstOutputData%IW_WriteOutput) + end if + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%WriteOutput = SrcOutputData%WriteOutput + else if (allocated(DstOutputData%WriteOutput)) then + deallocate(DstOutputData%WriteOutput) + end if +end subroutine +subroutine ADI_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(ADI_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%HHVel)) then + deallocate(OutputData%HHVel) + end if + if (allocated(OutputData%IW_WriteOutput)) then + deallocate(OutputData%IW_WriteOutput) + end if + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine subroutine ADI_PackOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ADI_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'ADI_PackOutput' if (Buf%ErrStat >= AbortErrLev) return - ! AD call AD_PackOutput(Buf, InData%AD) if (RegCheckErr(Buf, RoutineName)) return - ! HHVel call RegPack(Buf, allocated(InData%HHVel)) if (allocated(InData%HHVel)) then call RegPackBounds(Buf, 2, lbound(InData%HHVel), ubound(InData%HHVel)) call RegPack(Buf, InData%HHVel) end if if (RegCheckErr(Buf, RoutineName)) return - ! PLExp call RegPack(Buf, InData%PLExp) if (RegCheckErr(Buf, RoutineName)) return - ! IW_WriteOutput call RegPack(Buf, allocated(InData%IW_WriteOutput)) if (allocated(InData%IW_WriteOutput)) then call RegPackBounds(Buf, 1, lbound(InData%IW_WriteOutput), ubound(InData%IW_WriteOutput)) call RegPack(Buf, InData%IW_WriteOutput) end if if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutput call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) @@ -1302,9 +1091,7 @@ subroutine ADI_UnPackOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! AD call AD_UnpackOutput(Buf, OutData%AD) ! AD - ! HHVel if (allocated(OutData%HHVel)) deallocate(OutData%HHVel) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1319,10 +1106,8 @@ subroutine ADI_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%HHVel) if (RegCheckErr(Buf, RoutineName)) return end if - ! PLExp call RegUnpack(Buf, OutData%PLExp) if (RegCheckErr(Buf, RoutineName)) return - ! IW_WriteOutput if (allocated(OutData%IW_WriteOutput)) deallocate(OutData%IW_WriteOutput) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1337,7 +1122,6 @@ subroutine ADI_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%IW_WriteOutput) if (RegCheckErr(Buf, RoutineName)) return end if - ! WriteOutput if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1353,183 +1137,195 @@ subroutine ADI_UnPackOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE ADI_CopyData( SrcDataData, DstDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ADI_Data), INTENT(INOUT) :: SrcDataData - TYPE(ADI_Data), INTENT(INOUT) :: DstDataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - 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 = "" -IF (ALLOCATED(SrcDataData%x)) THEN - i1_l = LBOUND(SrcDataData%x,1) - i1_u = UBOUND(SrcDataData%x,1) - IF (.NOT. ALLOCATED(DstDataData%x)) THEN - ALLOCATE(DstDataData%x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDataData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDataData%x,1), UBOUND(SrcDataData%x,1) - CALL ADI_CopyContState( SrcDataData%x(i1), DstDataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcDataData%xd)) THEN - i1_l = LBOUND(SrcDataData%xd,1) - i1_u = UBOUND(SrcDataData%xd,1) - IF (.NOT. ALLOCATED(DstDataData%xd)) THEN - ALLOCATE(DstDataData%xd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDataData%xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDataData%xd,1), UBOUND(SrcDataData%xd,1) - CALL ADI_CopyDiscState( SrcDataData%xd(i1), DstDataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcDataData%z)) THEN - i1_l = LBOUND(SrcDataData%z,1) - i1_u = UBOUND(SrcDataData%z,1) - IF (.NOT. ALLOCATED(DstDataData%z)) THEN - ALLOCATE(DstDataData%z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDataData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDataData%z,1), UBOUND(SrcDataData%z,1) - CALL ADI_CopyConstrState( SrcDataData%z(i1), DstDataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcDataData%OtherState)) THEN - i1_l = LBOUND(SrcDataData%OtherState,1) - i1_u = UBOUND(SrcDataData%OtherState,1) - IF (.NOT. ALLOCATED(DstDataData%OtherState)) THEN - ALLOCATE(DstDataData%OtherState(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDataData%OtherState.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDataData%OtherState,1), UBOUND(SrcDataData%OtherState,1) - CALL ADI_CopyOtherState( SrcDataData%OtherState(i1), DstDataData%OtherState(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL ADI_CopyParam( SrcDataData%p, DstDataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ADI_CopyMisc( SrcDataData%m, DstDataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcDataData%u)) THEN - i1_l = LBOUND(SrcDataData%u,1) - i1_u = UBOUND(SrcDataData%u,1) - IF (.NOT. ALLOCATED(DstDataData%u)) THEN - ALLOCATE(DstDataData%u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDataData%u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDataData%u,1), UBOUND(SrcDataData%u,1) - CALL ADI_CopyInput( SrcDataData%u(i1), DstDataData%u(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL ADI_CopyOutput( SrcDataData%y, DstDataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcDataData%inputTimes)) THEN - i1_l = LBOUND(SrcDataData%inputTimes,1) - i1_u = UBOUND(SrcDataData%inputTimes,1) - IF (.NOT. ALLOCATED(DstDataData%inputTimes)) THEN - ALLOCATE(DstDataData%inputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDataData%inputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDataData%inputTimes = SrcDataData%inputTimes -ENDIF - END SUBROUTINE ADI_CopyData - SUBROUTINE ADI_DestroyData( DataData, ErrStat, ErrMsg ) - TYPE(ADI_Data), INTENT(INOUT) :: DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyData' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(DataData%x)) THEN -DO i1 = LBOUND(DataData%x,1), UBOUND(DataData%x,1) - CALL ADI_DestroyContState( DataData%x(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(DataData%x) -ENDIF -IF (ALLOCATED(DataData%xd)) THEN -DO i1 = LBOUND(DataData%xd,1), UBOUND(DataData%xd,1) - CALL ADI_DestroyDiscState( DataData%xd(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(DataData%xd) -ENDIF -IF (ALLOCATED(DataData%z)) THEN -DO i1 = LBOUND(DataData%z,1), UBOUND(DataData%z,1) - CALL ADI_DestroyConstrState( DataData%z(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(DataData%z) -ENDIF -IF (ALLOCATED(DataData%OtherState)) THEN -DO i1 = LBOUND(DataData%OtherState,1), UBOUND(DataData%OtherState,1) - CALL ADI_DestroyOtherState( DataData%OtherState(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(DataData%OtherState) -ENDIF - CALL ADI_DestroyParam( DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ADI_DestroyMisc( DataData%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(DataData%u)) THEN -DO i1 = LBOUND(DataData%u,1), UBOUND(DataData%u,1) - CALL ADI_DestroyInput( DataData%u(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(DataData%u) -ENDIF - CALL ADI_DestroyOutput( DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(DataData%inputTimes)) THEN - DEALLOCATE(DataData%inputTimes) -ENDIF - END SUBROUTINE ADI_DestroyData +subroutine ADI_CopyData(SrcDataData, DstDataData, CtrlCode, ErrStat, ErrMsg) + type(ADI_Data), intent(inout) :: SrcDataData + type(ADI_Data), intent(inout) :: DstDataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_CopyData' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcDataData%x)) then + LB(1:1) = lbound(SrcDataData%x) + UB(1:1) = ubound(SrcDataData%x) + if (.not. allocated(DstDataData%x)) then + allocate(DstDataData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDataData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ADI_CopyContState(SrcDataData%x(i1), DstDataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstDataData%x)) then + deallocate(DstDataData%x) + end if + if (allocated(SrcDataData%xd)) then + LB(1:1) = lbound(SrcDataData%xd) + UB(1:1) = ubound(SrcDataData%xd) + if (.not. allocated(DstDataData%xd)) then + allocate(DstDataData%xd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDataData%xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ADI_CopyDiscState(SrcDataData%xd(i1), DstDataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstDataData%xd)) then + deallocate(DstDataData%xd) + end if + if (allocated(SrcDataData%z)) then + LB(1:1) = lbound(SrcDataData%z) + UB(1:1) = ubound(SrcDataData%z) + if (.not. allocated(DstDataData%z)) then + allocate(DstDataData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDataData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ADI_CopyConstrState(SrcDataData%z(i1), DstDataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstDataData%z)) then + deallocate(DstDataData%z) + end if + if (allocated(SrcDataData%OtherState)) then + LB(1:1) = lbound(SrcDataData%OtherState) + UB(1:1) = ubound(SrcDataData%OtherState) + if (.not. allocated(DstDataData%OtherState)) then + allocate(DstDataData%OtherState(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDataData%OtherState.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ADI_CopyOtherState(SrcDataData%OtherState(i1), DstDataData%OtherState(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstDataData%OtherState)) then + deallocate(DstDataData%OtherState) + end if + call ADI_CopyParam(SrcDataData%p, DstDataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ADI_CopyMisc(SrcDataData%m, DstDataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcDataData%u)) then + LB(1:1) = lbound(SrcDataData%u) + UB(1:1) = ubound(SrcDataData%u) + if (.not. allocated(DstDataData%u)) then + allocate(DstDataData%u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDataData%u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ADI_CopyInput(SrcDataData%u(i1), DstDataData%u(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstDataData%u)) then + deallocate(DstDataData%u) + end if + call ADI_CopyOutput(SrcDataData%y, DstDataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcDataData%inputTimes)) then + LB(1:1) = lbound(SrcDataData%inputTimes) + UB(1:1) = ubound(SrcDataData%inputTimes) + if (.not. allocated(DstDataData%inputTimes)) then + allocate(DstDataData%inputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDataData%inputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDataData%inputTimes = SrcDataData%inputTimes + else if (allocated(DstDataData%inputTimes)) then + deallocate(DstDataData%inputTimes) + end if +end subroutine +subroutine ADI_DestroyData(DataData, ErrStat, ErrMsg) + type(ADI_Data), intent(inout) :: DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_DestroyData' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(DataData%x)) then + LB(1:1) = lbound(DataData%x) + UB(1:1) = ubound(DataData%x) + do i1 = LB(1), UB(1) + call ADI_DestroyContState(DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(DataData%x) + end if + if (allocated(DataData%xd)) then + LB(1:1) = lbound(DataData%xd) + UB(1:1) = ubound(DataData%xd) + do i1 = LB(1), UB(1) + call ADI_DestroyDiscState(DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(DataData%xd) + end if + if (allocated(DataData%z)) then + LB(1:1) = lbound(DataData%z) + UB(1:1) = ubound(DataData%z) + do i1 = LB(1), UB(1) + call ADI_DestroyConstrState(DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(DataData%z) + end if + if (allocated(DataData%OtherState)) then + LB(1:1) = lbound(DataData%OtherState) + UB(1:1) = ubound(DataData%OtherState) + do i1 = LB(1), UB(1) + call ADI_DestroyOtherState(DataData%OtherState(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(DataData%OtherState) + end if + if (allocated(DataData%u)) then + LB(1:1) = lbound(DataData%u) + UB(1:1) = ubound(DataData%u) + do i1 = LB(1), UB(1) + call ADI_DestroyInput(DataData%u(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(DataData%u) + end if + if (allocated(DataData%inputTimes)) then + deallocate(DataData%inputTimes) + end if +end subroutine subroutine ADI_PackData(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -1538,7 +1334,6 @@ subroutine ADI_PackData(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! x call RegPack(Buf, allocated(InData%x)) if (allocated(InData%x)) then call RegPackBounds(Buf, 1, lbound(InData%x), ubound(InData%x)) @@ -1549,7 +1344,6 @@ subroutine ADI_PackData(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! xd call RegPack(Buf, allocated(InData%xd)) if (allocated(InData%xd)) then call RegPackBounds(Buf, 1, lbound(InData%xd), ubound(InData%xd)) @@ -1560,7 +1354,6 @@ subroutine ADI_PackData(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! z call RegPack(Buf, allocated(InData%z)) if (allocated(InData%z)) then call RegPackBounds(Buf, 1, lbound(InData%z), ubound(InData%z)) @@ -1571,7 +1364,6 @@ subroutine ADI_PackData(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! OtherState call RegPack(Buf, allocated(InData%OtherState)) if (allocated(InData%OtherState)) then call RegPackBounds(Buf, 1, lbound(InData%OtherState), ubound(InData%OtherState)) @@ -1582,13 +1374,10 @@ subroutine ADI_PackData(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! p call ADI_PackParam(Buf, InData%p) if (RegCheckErr(Buf, RoutineName)) return - ! m call ADI_PackMisc(Buf, InData%m) if (RegCheckErr(Buf, RoutineName)) return - ! u call RegPack(Buf, allocated(InData%u)) if (allocated(InData%u)) then call RegPackBounds(Buf, 1, lbound(InData%u), ubound(InData%u)) @@ -1599,10 +1388,8 @@ subroutine ADI_PackData(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! y call ADI_PackOutput(Buf, InData%y) if (RegCheckErr(Buf, RoutineName)) return - ! inputTimes call RegPack(Buf, allocated(InData%inputTimes)) if (allocated(InData%inputTimes)) then call RegPackBounds(Buf, 1, lbound(InData%inputTimes), ubound(InData%inputTimes)) @@ -1620,7 +1407,6 @@ subroutine ADI_UnPackData(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! x if (allocated(OutData%x)) deallocate(OutData%x) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1636,7 +1422,6 @@ subroutine ADI_UnPackData(Buf, OutData) call ADI_UnpackContState(Buf, OutData%x(i1)) ! x end do end if - ! xd if (allocated(OutData%xd)) deallocate(OutData%xd) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1652,7 +1437,6 @@ subroutine ADI_UnPackData(Buf, OutData) call ADI_UnpackDiscState(Buf, OutData%xd(i1)) ! xd end do end if - ! z if (allocated(OutData%z)) deallocate(OutData%z) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1668,7 +1452,6 @@ subroutine ADI_UnPackData(Buf, OutData) call ADI_UnpackConstrState(Buf, OutData%z(i1)) ! z end do end if - ! OtherState if (allocated(OutData%OtherState)) deallocate(OutData%OtherState) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1684,11 +1467,8 @@ subroutine ADI_UnPackData(Buf, OutData) call ADI_UnpackOtherState(Buf, OutData%OtherState(i1)) ! OtherState end do end if - ! p call ADI_UnpackParam(Buf, OutData%p) ! p - ! m call ADI_UnpackMisc(Buf, OutData%m) ! m - ! u if (allocated(OutData%u)) deallocate(OutData%u) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1704,9 +1484,7 @@ subroutine ADI_UnPackData(Buf, OutData) call ADI_UnpackInput(Buf, OutData%u(i1)) ! u end do end if - ! y call ADI_UnpackOutput(Buf, OutData%y) ! y - ! inputTimes if (allocated(OutData%inputTimes)) deallocate(OutData%inputTimes) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1722,183 +1500,175 @@ subroutine ADI_UnPackData(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE ADI_CopyRotFED( SrcRotFEDData, DstRotFEDData, CtrlCode, ErrStat, ErrMsg ) - TYPE(RotFED), INTENT(INOUT) :: SrcRotFEDData - TYPE(RotFED), INTENT(INOUT) :: DstRotFEDData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - 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 ) - TYPE(RotFED), INTENT(INOUT) :: RotFEDData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyRotFED' - ErrStat = ErrID_None - ErrMsg = "" - - CALL MeshDestroy( RotFEDData%PlatformPtMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( RotFEDData%TwrPtMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( RotFEDData%TwrPtMeshAD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( RotFEDData%NacelleMotion, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( RotFEDData%HubPtMotion, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(RotFEDData%BladeRootMotion)) THEN -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyMeshMapType( RotFEDData%AD_P_2_AD_L_T, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(RotFEDData%AD_P_2_AD_L_B)) THEN -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 ) - 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 ) - 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 ) - 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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyMeshMapType( RotFEDData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE ADI_DestroyRotFED +subroutine ADI_CopyRotFED(SrcRotFEDData, DstRotFEDData, CtrlCode, ErrStat, ErrMsg) + type(RotFED), intent(inout) :: SrcRotFEDData + type(RotFED), intent(inout) :: DstRotFEDData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_CopyRotFED' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcRotFEDData%PlatformPtMesh, DstRotFEDData%PlatformPtMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcRotFEDData%TwrPtMesh, DstRotFEDData%TwrPtMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcRotFEDData%TwrPtMeshAD, DstRotFEDData%TwrPtMeshAD, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcRotFEDData%NacelleMotion, DstRotFEDData%NacelleMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcRotFEDData%HubPtMotion, DstRotFEDData%HubPtMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcRotFEDData%BladeRootMotion)) then + LB(1:1) = lbound(SrcRotFEDData%BladeRootMotion) + UB(1:1) = ubound(SrcRotFEDData%BladeRootMotion) + if (.not. allocated(DstRotFEDData%BladeRootMotion)) then + allocate(DstRotFEDData%BladeRootMotion(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotFEDData%BladeRootMotion.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcRotFEDData%BladeRootMotion(i1), DstRotFEDData%BladeRootMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstRotFEDData%BladeRootMotion)) then + deallocate(DstRotFEDData%BladeRootMotion) + end if + if (allocated(SrcRotFEDData%BladeLn2Mesh)) then + LB(1:1) = lbound(SrcRotFEDData%BladeLn2Mesh) + UB(1:1) = ubound(SrcRotFEDData%BladeLn2Mesh) + if (.not. allocated(DstRotFEDData%BladeLn2Mesh)) then + allocate(DstRotFEDData%BladeLn2Mesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotFEDData%BladeLn2Mesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcRotFEDData%BladeLn2Mesh(i1), DstRotFEDData%BladeLn2Mesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstRotFEDData%BladeLn2Mesh)) then + deallocate(DstRotFEDData%BladeLn2Mesh) + end if + DstRotFEDData%hasTower = SrcRotFEDData%hasTower + DstRotFEDData%rigidBlades = SrcRotFEDData%rigidBlades + DstRotFEDData%numBlades = SrcRotFEDData%numBlades + call NWTC_Library_CopyMeshMapType(SrcRotFEDData%ED_P_2_AD_P_T, DstRotFEDData%ED_P_2_AD_P_T, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcRotFEDData%AD_P_2_AD_L_T, DstRotFEDData%AD_P_2_AD_L_T, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcRotFEDData%AD_P_2_AD_L_B)) then + LB(1:1) = lbound(SrcRotFEDData%AD_P_2_AD_L_B) + UB(1:1) = ubound(SrcRotFEDData%AD_P_2_AD_L_B) + if (.not. allocated(DstRotFEDData%AD_P_2_AD_L_B)) then + allocate(DstRotFEDData%AD_P_2_AD_L_B(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotFEDData%AD_P_2_AD_L_B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcRotFEDData%AD_P_2_AD_L_B(i1), DstRotFEDData%AD_P_2_AD_L_B(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstRotFEDData%AD_P_2_AD_L_B)) then + deallocate(DstRotFEDData%AD_P_2_AD_L_B) + end if + call NWTC_Library_CopyMeshMapType(SrcRotFEDData%ED_P_2_AD_P_TF, DstRotFEDData%ED_P_2_AD_P_TF, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcRotFEDData%ED_P_2_AD_P_R)) then + LB(1:1) = lbound(SrcRotFEDData%ED_P_2_AD_P_R) + UB(1:1) = ubound(SrcRotFEDData%ED_P_2_AD_P_R) + if (.not. allocated(DstRotFEDData%ED_P_2_AD_P_R)) then + allocate(DstRotFEDData%ED_P_2_AD_P_R(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotFEDData%ED_P_2_AD_P_R.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcRotFEDData%ED_P_2_AD_P_R(i1), DstRotFEDData%ED_P_2_AD_P_R(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstRotFEDData%ED_P_2_AD_P_R)) then + deallocate(DstRotFEDData%ED_P_2_AD_P_R) + end if + call NWTC_Library_CopyMeshMapType(SrcRotFEDData%ED_P_2_AD_P_H, DstRotFEDData%ED_P_2_AD_P_H, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcRotFEDData%ED_P_2_AD_P_N, DstRotFEDData%ED_P_2_AD_P_N, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine ADI_DestroyRotFED(RotFEDData, ErrStat, ErrMsg) + type(RotFED), intent(inout) :: RotFEDData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_DestroyRotFED' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(RotFEDData%BladeRootMotion)) then + LB(1:1) = lbound(RotFEDData%BladeRootMotion) + UB(1:1) = ubound(RotFEDData%BladeRootMotion) + do i1 = LB(1), UB(1) + call MeshDestroy( RotFEDData%BladeRootMotion(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotFEDData%BladeRootMotion) + end if + if (allocated(RotFEDData%BladeLn2Mesh)) then + LB(1:1) = lbound(RotFEDData%BladeLn2Mesh) + UB(1:1) = ubound(RotFEDData%BladeLn2Mesh) + do i1 = LB(1), UB(1) + call MeshDestroy( RotFEDData%BladeLn2Mesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotFEDData%BladeLn2Mesh) + end if + if (allocated(RotFEDData%AD_P_2_AD_L_B)) then + LB(1:1) = lbound(RotFEDData%AD_P_2_AD_L_B) + UB(1:1) = ubound(RotFEDData%AD_P_2_AD_L_B) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(RotFEDData%AD_P_2_AD_L_B(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotFEDData%AD_P_2_AD_L_B) + end if + if (allocated(RotFEDData%ED_P_2_AD_P_R)) then + LB(1:1) = lbound(RotFEDData%ED_P_2_AD_P_R) + UB(1:1) = ubound(RotFEDData%ED_P_2_AD_P_R) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(RotFEDData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotFEDData%ED_P_2_AD_P_R) + end if +end subroutine subroutine ADI_PackRotFED(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -1907,22 +1677,16 @@ subroutine ADI_PackRotFED(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! PlatformPtMesh call MeshPack(Buf, InData%PlatformPtMesh) if (RegCheckErr(Buf, RoutineName)) return - ! TwrPtMesh call MeshPack(Buf, InData%TwrPtMesh) if (RegCheckErr(Buf, RoutineName)) return - ! TwrPtMeshAD call MeshPack(Buf, InData%TwrPtMeshAD) if (RegCheckErr(Buf, RoutineName)) return - ! NacelleMotion call MeshPack(Buf, InData%NacelleMotion) if (RegCheckErr(Buf, RoutineName)) return - ! HubPtMotion call MeshPack(Buf, InData%HubPtMotion) if (RegCheckErr(Buf, RoutineName)) return - ! BladeRootMotion call RegPack(Buf, allocated(InData%BladeRootMotion)) if (allocated(InData%BladeRootMotion)) then call RegPackBounds(Buf, 1, lbound(InData%BladeRootMotion), ubound(InData%BladeRootMotion)) @@ -1933,7 +1697,6 @@ subroutine ADI_PackRotFED(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! BladeLn2Mesh call RegPack(Buf, allocated(InData%BladeLn2Mesh)) if (allocated(InData%BladeLn2Mesh)) then call RegPackBounds(Buf, 1, lbound(InData%BladeLn2Mesh), ubound(InData%BladeLn2Mesh)) @@ -1944,22 +1707,16 @@ subroutine ADI_PackRotFED(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! hasTower call RegPack(Buf, InData%hasTower) if (RegCheckErr(Buf, RoutineName)) return - ! rigidBlades call RegPack(Buf, InData%rigidBlades) if (RegCheckErr(Buf, RoutineName)) return - ! numBlades call RegPack(Buf, InData%numBlades) if (RegCheckErr(Buf, RoutineName)) return - ! ED_P_2_AD_P_T call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_AD_P_T) if (RegCheckErr(Buf, RoutineName)) return - ! AD_P_2_AD_L_T call NWTC_Library_PackMeshMapType(Buf, InData%AD_P_2_AD_L_T) if (RegCheckErr(Buf, RoutineName)) return - ! AD_P_2_AD_L_B call RegPack(Buf, allocated(InData%AD_P_2_AD_L_B)) if (allocated(InData%AD_P_2_AD_L_B)) then call RegPackBounds(Buf, 1, lbound(InData%AD_P_2_AD_L_B), ubound(InData%AD_P_2_AD_L_B)) @@ -1970,10 +1727,8 @@ subroutine ADI_PackRotFED(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! ED_P_2_AD_P_TF call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_AD_P_TF) if (RegCheckErr(Buf, RoutineName)) return - ! ED_P_2_AD_P_R call RegPack(Buf, allocated(InData%ED_P_2_AD_P_R)) if (allocated(InData%ED_P_2_AD_P_R)) then call RegPackBounds(Buf, 1, lbound(InData%ED_P_2_AD_P_R), ubound(InData%ED_P_2_AD_P_R)) @@ -1984,10 +1739,8 @@ subroutine ADI_PackRotFED(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! ED_P_2_AD_P_H call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_AD_P_H) if (RegCheckErr(Buf, RoutineName)) return - ! ED_P_2_AD_P_N call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_AD_P_N) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2001,17 +1754,11 @@ subroutine ADI_UnPackRotFED(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! PlatformPtMesh call MeshUnpack(Buf, OutData%PlatformPtMesh) ! PlatformPtMesh - ! TwrPtMesh call MeshUnpack(Buf, OutData%TwrPtMesh) ! TwrPtMesh - ! TwrPtMeshAD call MeshUnpack(Buf, OutData%TwrPtMeshAD) ! TwrPtMeshAD - ! NacelleMotion call MeshUnpack(Buf, OutData%NacelleMotion) ! NacelleMotion - ! HubPtMotion call MeshUnpack(Buf, OutData%HubPtMotion) ! HubPtMotion - ! BladeRootMotion if (allocated(OutData%BladeRootMotion)) deallocate(OutData%BladeRootMotion) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2027,7 +1774,6 @@ subroutine ADI_UnPackRotFED(Buf, OutData) call MeshUnpack(Buf, OutData%BladeRootMotion(i1)) ! BladeRootMotion end do end if - ! BladeLn2Mesh if (allocated(OutData%BladeLn2Mesh)) deallocate(OutData%BladeLn2Mesh) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2043,20 +1789,14 @@ subroutine ADI_UnPackRotFED(Buf, OutData) call MeshUnpack(Buf, OutData%BladeLn2Mesh(i1)) ! BladeLn2Mesh end do end if - ! hasTower call RegUnpack(Buf, OutData%hasTower) if (RegCheckErr(Buf, RoutineName)) return - ! rigidBlades call RegUnpack(Buf, OutData%rigidBlades) if (RegCheckErr(Buf, RoutineName)) return - ! numBlades call RegUnpack(Buf, OutData%numBlades) if (RegCheckErr(Buf, RoutineName)) return - ! ED_P_2_AD_P_T call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_AD_P_T) ! ED_P_2_AD_P_T - ! AD_P_2_AD_L_T call NWTC_Library_UnpackMeshMapType(Buf, OutData%AD_P_2_AD_L_T) ! AD_P_2_AD_L_T - ! AD_P_2_AD_L_B if (allocated(OutData%AD_P_2_AD_L_B)) deallocate(OutData%AD_P_2_AD_L_B) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2072,9 +1812,7 @@ subroutine ADI_UnPackRotFED(Buf, OutData) call NWTC_Library_UnpackMeshMapType(Buf, OutData%AD_P_2_AD_L_B(i1)) ! AD_P_2_AD_L_B end do end if - ! ED_P_2_AD_P_TF call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_AD_P_TF) ! ED_P_2_AD_P_TF - ! ED_P_2_AD_P_R if (allocated(OutData%ED_P_2_AD_P_R)) deallocate(OutData%ED_P_2_AD_P_R) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2090,66 +1828,64 @@ subroutine ADI_UnPackRotFED(Buf, OutData) call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_AD_P_R(i1)) ! ED_P_2_AD_P_R end do end if - ! ED_P_2_AD_P_H call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_AD_P_H) ! ED_P_2_AD_P_H - ! ED_P_2_AD_P_N call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_AD_P_N) ! ED_P_2_AD_P_N end subroutine - SUBROUTINE ADI_CopyFED_Data( SrcFED_DataData, DstFED_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FED_Data), INTENT(INOUT) :: SrcFED_DataData - TYPE(FED_Data), INTENT(INOUT) :: DstFED_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - 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 ) - TYPE(FED_Data), INTENT(INOUT) :: FED_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ADI_DestroyFED_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -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 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(FED_DataData%WT) -ENDIF - END SUBROUTINE ADI_DestroyFED_Data +subroutine ADI_CopyFED_Data(SrcFED_DataData, DstFED_DataData, CtrlCode, ErrStat, ErrMsg) + type(FED_Data), intent(inout) :: SrcFED_DataData + type(FED_Data), intent(inout) :: DstFED_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_CopyFED_Data' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcFED_DataData%WT)) then + LB(1:1) = lbound(SrcFED_DataData%WT) + UB(1:1) = ubound(SrcFED_DataData%WT) + if (.not. allocated(DstFED_DataData%WT)) then + allocate(DstFED_DataData%WT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstFED_DataData%WT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ADI_CopyRotFED(SrcFED_DataData%WT(i1), DstFED_DataData%WT(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstFED_DataData%WT)) then + deallocate(DstFED_DataData%WT) + end if +end subroutine +subroutine ADI_DestroyFED_Data(FED_DataData, ErrStat, ErrMsg) + type(FED_Data), intent(inout) :: FED_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ADI_DestroyFED_Data' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(FED_DataData%WT)) then + LB(1:1) = lbound(FED_DataData%WT) + UB(1:1) = ubound(FED_DataData%WT) + do i1 = LB(1), UB(1) + call ADI_DestroyRotFED(FED_DataData%WT(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(FED_DataData%WT) + end if +end subroutine subroutine ADI_PackFED_Data(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -2158,7 +1894,6 @@ subroutine ADI_PackFED_Data(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! WT call RegPack(Buf, allocated(InData%WT)) if (allocated(InData%WT)) then call RegPackBounds(Buf, 1, lbound(InData%WT), ubound(InData%WT)) @@ -2180,7 +1915,6 @@ subroutine ADI_UnPackFED_Data(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! WT if (allocated(OutData%WT)) deallocate(OutData%WT) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index e59b4a8e5f..fc2f0272c6 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -487,61 +487,45 @@ MODULE AeroDyn_Types END TYPE AD_OutputType ! ======================= CONTAINS - SUBROUTINE AD_CopyTFinParameterType( SrcTFinParameterTypeData, DstTFinParameterTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(TFinParameterType), INTENT(IN) :: SrcTFinParameterTypeData - TYPE(TFinParameterType), INTENT(INOUT) :: DstTFinParameterTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_CopyTFinParameterType' -! + +subroutine AD_CopyTFinParameterType(SrcTFinParameterTypeData, DstTFinParameterTypeData, CtrlCode, ErrStat, ErrMsg) + type(TFinParameterType), intent(in) :: SrcTFinParameterTypeData + type(TFinParameterType), intent(inout) :: DstTFinParameterTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_CopyTFinParameterType' ErrStat = ErrID_None - ErrMsg = "" - DstTFinParameterTypeData%TFinMod = SrcTFinParameterTypeData%TFinMod - DstTFinParameterTypeData%TFinChord = SrcTFinParameterTypeData%TFinChord - DstTFinParameterTypeData%TFinArea = SrcTFinParameterTypeData%TFinArea - DstTFinParameterTypeData%TFinIndMod = SrcTFinParameterTypeData%TFinIndMod - DstTFinParameterTypeData%TFinAFID = SrcTFinParameterTypeData%TFinAFID - END SUBROUTINE AD_CopyTFinParameterType - - SUBROUTINE AD_DestroyTFinParameterType( TFinParameterTypeData, ErrStat, ErrMsg ) - TYPE(TFinParameterType), INTENT(INOUT) :: TFinParameterTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyTFinParameterType' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE AD_DestroyTFinParameterType + ErrMsg = '' + DstTFinParameterTypeData%TFinMod = SrcTFinParameterTypeData%TFinMod + DstTFinParameterTypeData%TFinChord = SrcTFinParameterTypeData%TFinChord + DstTFinParameterTypeData%TFinArea = SrcTFinParameterTypeData%TFinArea + DstTFinParameterTypeData%TFinIndMod = SrcTFinParameterTypeData%TFinIndMod + DstTFinParameterTypeData%TFinAFID = SrcTFinParameterTypeData%TFinAFID +end subroutine +subroutine AD_DestroyTFinParameterType(TFinParameterTypeData, ErrStat, ErrMsg) + type(TFinParameterType), intent(inout) :: TFinParameterTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_DestroyTFinParameterType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine AD_PackTFinParameterType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(TFinParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackTFinParameterType' if (Buf%ErrStat >= AbortErrLev) return - ! TFinMod call RegPack(Buf, InData%TFinMod) if (RegCheckErr(Buf, RoutineName)) return - ! TFinChord call RegPack(Buf, InData%TFinChord) if (RegCheckErr(Buf, RoutineName)) return - ! TFinArea call RegPack(Buf, InData%TFinArea) if (RegCheckErr(Buf, RoutineName)) return - ! TFinIndMod call RegPack(Buf, InData%TFinIndMod) if (RegCheckErr(Buf, RoutineName)) return - ! TFinAFID call RegPack(Buf, InData%TFinAFID) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -551,86 +535,62 @@ subroutine AD_UnPackTFinParameterType(Buf, OutData) type(TFinParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackTFinParameterType' if (Buf%ErrStat /= ErrID_None) return - ! TFinMod call RegUnpack(Buf, OutData%TFinMod) if (RegCheckErr(Buf, RoutineName)) return - ! TFinChord call RegUnpack(Buf, OutData%TFinChord) if (RegCheckErr(Buf, RoutineName)) return - ! TFinArea call RegUnpack(Buf, OutData%TFinArea) if (RegCheckErr(Buf, RoutineName)) return - ! TFinIndMod call RegUnpack(Buf, OutData%TFinIndMod) if (RegCheckErr(Buf, RoutineName)) return - ! TFinAFID call RegUnpack(Buf, OutData%TFinAFID) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE AD_CopyTFinInputFileType( SrcTFinInputFileTypeData, DstTFinInputFileTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(TFinInputFileType), INTENT(IN) :: SrcTFinInputFileTypeData - TYPE(TFinInputFileType), INTENT(INOUT) :: DstTFinInputFileTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_CopyTFinInputFileType' -! + +subroutine AD_CopyTFinInputFileType(SrcTFinInputFileTypeData, DstTFinInputFileTypeData, CtrlCode, ErrStat, ErrMsg) + type(TFinInputFileType), intent(in) :: SrcTFinInputFileTypeData + type(TFinInputFileType), intent(inout) :: DstTFinInputFileTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_CopyTFinInputFileType' ErrStat = ErrID_None - ErrMsg = "" - DstTFinInputFileTypeData%TFinMod = SrcTFinInputFileTypeData%TFinMod - DstTFinInputFileTypeData%TFinChord = SrcTFinInputFileTypeData%TFinChord - DstTFinInputFileTypeData%TFinArea = SrcTFinInputFileTypeData%TFinArea - DstTFinInputFileTypeData%TFinRefP_n = SrcTFinInputFileTypeData%TFinRefP_n - DstTFinInputFileTypeData%TFinAngles = SrcTFinInputFileTypeData%TFinAngles - DstTFinInputFileTypeData%TFinIndMod = SrcTFinInputFileTypeData%TFinIndMod - DstTFinInputFileTypeData%TFinAFID = SrcTFinInputFileTypeData%TFinAFID - END SUBROUTINE AD_CopyTFinInputFileType - - SUBROUTINE AD_DestroyTFinInputFileType( TFinInputFileTypeData, ErrStat, ErrMsg ) - TYPE(TFinInputFileType), INTENT(INOUT) :: TFinInputFileTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyTFinInputFileType' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE AD_DestroyTFinInputFileType + ErrMsg = '' + DstTFinInputFileTypeData%TFinMod = SrcTFinInputFileTypeData%TFinMod + DstTFinInputFileTypeData%TFinChord = SrcTFinInputFileTypeData%TFinChord + DstTFinInputFileTypeData%TFinArea = SrcTFinInputFileTypeData%TFinArea + DstTFinInputFileTypeData%TFinRefP_n = SrcTFinInputFileTypeData%TFinRefP_n + DstTFinInputFileTypeData%TFinAngles = SrcTFinInputFileTypeData%TFinAngles + DstTFinInputFileTypeData%TFinIndMod = SrcTFinInputFileTypeData%TFinIndMod + DstTFinInputFileTypeData%TFinAFID = SrcTFinInputFileTypeData%TFinAFID +end subroutine +subroutine AD_DestroyTFinInputFileType(TFinInputFileTypeData, ErrStat, ErrMsg) + type(TFinInputFileType), intent(inout) :: TFinInputFileTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_DestroyTFinInputFileType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine AD_PackTFinInputFileType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(TFinInputFileType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackTFinInputFileType' if (Buf%ErrStat >= AbortErrLev) return - ! TFinMod call RegPack(Buf, InData%TFinMod) if (RegCheckErr(Buf, RoutineName)) return - ! TFinChord call RegPack(Buf, InData%TFinChord) if (RegCheckErr(Buf, RoutineName)) return - ! TFinArea call RegPack(Buf, InData%TFinArea) if (RegCheckErr(Buf, RoutineName)) return - ! TFinRefP_n call RegPack(Buf, InData%TFinRefP_n) if (RegCheckErr(Buf, RoutineName)) return - ! TFinAngles call RegPack(Buf, InData%TFinAngles) if (RegCheckErr(Buf, RoutineName)) return - ! TFinIndMod call RegPack(Buf, InData%TFinIndMod) if (RegCheckErr(Buf, RoutineName)) return - ! TFinAFID call RegPack(Buf, InData%TFinAFID) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -640,88 +600,66 @@ subroutine AD_UnPackTFinInputFileType(Buf, OutData) type(TFinInputFileType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackTFinInputFileType' if (Buf%ErrStat /= ErrID_None) return - ! TFinMod call RegUnpack(Buf, OutData%TFinMod) if (RegCheckErr(Buf, RoutineName)) return - ! TFinChord call RegUnpack(Buf, OutData%TFinChord) if (RegCheckErr(Buf, RoutineName)) return - ! TFinArea call RegUnpack(Buf, OutData%TFinArea) if (RegCheckErr(Buf, RoutineName)) return - ! TFinRefP_n call RegUnpack(Buf, OutData%TFinRefP_n) if (RegCheckErr(Buf, RoutineName)) return - ! TFinAngles call RegUnpack(Buf, OutData%TFinAngles) if (RegCheckErr(Buf, RoutineName)) return - ! TFinIndMod call RegUnpack(Buf, OutData%TFinIndMod) if (RegCheckErr(Buf, RoutineName)) return - ! TFinAFID call RegUnpack(Buf, OutData%TFinAFID) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE AD_CopyVTK_BLSurfaceType( SrcVTK_BLSurfaceTypeData, DstVTK_BLSurfaceTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD_VTK_BLSurfaceType), INTENT(IN) :: SrcVTK_BLSurfaceTypeData - TYPE(AD_VTK_BLSurfaceType), INTENT(INOUT) :: DstVTK_BLSurfaceTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (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' -! + +subroutine AD_CopyVTK_BLSurfaceType(SrcVTK_BLSurfaceTypeData, DstVTK_BLSurfaceTypeData, CtrlCode, ErrStat, ErrMsg) + type(AD_VTK_BLSurfaceType), intent(in) :: SrcVTK_BLSurfaceTypeData + type(AD_VTK_BLSurfaceType), intent(inout) :: DstVTK_BLSurfaceTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + 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 ) - TYPE(AD_VTK_BLSurfaceType), INTENT(INOUT) :: VTK_BLSurfaceTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyVTK_BLSurfaceType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(VTK_BLSurfaceTypeData%AirfoilCoords)) THEN - DEALLOCATE(VTK_BLSurfaceTypeData%AirfoilCoords) -ENDIF - END SUBROUTINE AD_DestroyVTK_BLSurfaceType + ErrMsg = '' + if (allocated(SrcVTK_BLSurfaceTypeData%AirfoilCoords)) then + LB(1:3) = lbound(SrcVTK_BLSurfaceTypeData%AirfoilCoords) + UB(1:3) = ubound(SrcVTK_BLSurfaceTypeData%AirfoilCoords) + if (.not. allocated(DstVTK_BLSurfaceTypeData%AirfoilCoords)) then + allocate(DstVTK_BLSurfaceTypeData%AirfoilCoords(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_BLSurfaceTypeData%AirfoilCoords.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVTK_BLSurfaceTypeData%AirfoilCoords = SrcVTK_BLSurfaceTypeData%AirfoilCoords + else if (allocated(DstVTK_BLSurfaceTypeData%AirfoilCoords)) then + deallocate(DstVTK_BLSurfaceTypeData%AirfoilCoords) + end if +end subroutine +subroutine AD_DestroyVTK_BLSurfaceType(VTK_BLSurfaceTypeData, ErrStat, ErrMsg) + type(AD_VTK_BLSurfaceType), intent(inout) :: VTK_BLSurfaceTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_DestroyVTK_BLSurfaceType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(VTK_BLSurfaceTypeData%AirfoilCoords)) then + deallocate(VTK_BLSurfaceTypeData%AirfoilCoords) + end if +end subroutine subroutine AD_PackVTK_BLSurfaceType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AD_VTK_BLSurfaceType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackVTK_BLSurfaceType' if (Buf%ErrStat >= AbortErrLev) return - ! AirfoilCoords call RegPack(Buf, allocated(InData%AirfoilCoords)) if (allocated(InData%AirfoilCoords)) then call RegPackBounds(Buf, 3, lbound(InData%AirfoilCoords), ubound(InData%AirfoilCoords)) @@ -738,7 +676,6 @@ subroutine AD_UnPackVTK_BLSurfaceType(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! AirfoilCoords if (allocated(OutData%AirfoilCoords)) deallocate(OutData%AirfoilCoords) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -754,76 +691,78 @@ subroutine AD_UnPackVTK_BLSurfaceType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE AD_CopyVTK_RotSurfaceType( SrcVTK_RotSurfaceTypeData, DstVTK_RotSurfaceTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD_VTK_RotSurfaceType), INTENT(IN) :: SrcVTK_RotSurfaceTypeData - TYPE(AD_VTK_RotSurfaceType), INTENT(INOUT) :: DstVTK_RotSurfaceTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - 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' -! + +subroutine AD_CopyVTK_RotSurfaceType(SrcVTK_RotSurfaceTypeData, DstVTK_RotSurfaceTypeData, CtrlCode, ErrStat, ErrMsg) + type(AD_VTK_RotSurfaceType), intent(in) :: SrcVTK_RotSurfaceTypeData + type(AD_VTK_RotSurfaceType), intent(inout) :: DstVTK_RotSurfaceTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyVTK_RotSurfaceType' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcVTK_RotSurfaceTypeData%BladeShape)) THEN - 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 ) - TYPE(AD_VTK_RotSurfaceType), INTENT(INOUT) :: VTK_RotSurfaceTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyVTK_RotSurfaceType' - - ErrStat = ErrID_None - ErrMsg = "" - -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 ) - 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 + ErrMsg = '' + if (allocated(SrcVTK_RotSurfaceTypeData%BladeShape)) then + LB(1:1) = lbound(SrcVTK_RotSurfaceTypeData%BladeShape) + UB(1:1) = ubound(SrcVTK_RotSurfaceTypeData%BladeShape) + if (.not. allocated(DstVTK_RotSurfaceTypeData%BladeShape)) then + allocate(DstVTK_RotSurfaceTypeData%BladeShape(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_RotSurfaceTypeData%BladeShape.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyVTK_BLSurfaceType(SrcVTK_RotSurfaceTypeData%BladeShape(i1), DstVTK_RotSurfaceTypeData%BladeShape(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstVTK_RotSurfaceTypeData%BladeShape)) then + deallocate(DstVTK_RotSurfaceTypeData%BladeShape) + end if + if (allocated(SrcVTK_RotSurfaceTypeData%TowerRad)) then + LB(1:1) = lbound(SrcVTK_RotSurfaceTypeData%TowerRad) + UB(1:1) = ubound(SrcVTK_RotSurfaceTypeData%TowerRad) + if (.not. allocated(DstVTK_RotSurfaceTypeData%TowerRad)) then + allocate(DstVTK_RotSurfaceTypeData%TowerRad(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_RotSurfaceTypeData%TowerRad.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVTK_RotSurfaceTypeData%TowerRad = SrcVTK_RotSurfaceTypeData%TowerRad + else if (allocated(DstVTK_RotSurfaceTypeData%TowerRad)) then + deallocate(DstVTK_RotSurfaceTypeData%TowerRad) + end if +end subroutine +subroutine AD_DestroyVTK_RotSurfaceType(VTK_RotSurfaceTypeData, ErrStat, ErrMsg) + type(AD_VTK_RotSurfaceType), intent(inout) :: VTK_RotSurfaceTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyVTK_RotSurfaceType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(VTK_RotSurfaceTypeData%BladeShape)) then + LB(1:1) = lbound(VTK_RotSurfaceTypeData%BladeShape) + UB(1:1) = ubound(VTK_RotSurfaceTypeData%BladeShape) + do i1 = LB(1), UB(1) + call AD_DestroyVTK_BLSurfaceType(VTK_RotSurfaceTypeData%BladeShape(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(VTK_RotSurfaceTypeData%BladeShape) + end if + if (allocated(VTK_RotSurfaceTypeData%TowerRad)) then + deallocate(VTK_RotSurfaceTypeData%TowerRad) + end if +end subroutine subroutine AD_PackVTK_RotSurfaceType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -832,7 +771,6 @@ subroutine AD_PackVTK_RotSurfaceType(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! BladeShape call RegPack(Buf, allocated(InData%BladeShape)) if (allocated(InData%BladeShape)) then call RegPackBounds(Buf, 1, lbound(InData%BladeShape), ubound(InData%BladeShape)) @@ -843,7 +781,6 @@ subroutine AD_PackVTK_RotSurfaceType(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! TowerRad call RegPack(Buf, allocated(InData%TowerRad)) if (allocated(InData%TowerRad)) then call RegPackBounds(Buf, 1, lbound(InData%TowerRad), ubound(InData%TowerRad)) @@ -861,7 +798,6 @@ subroutine AD_UnPackVTK_RotSurfaceType(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! BladeShape if (allocated(OutData%BladeShape)) deallocate(OutData%BladeShape) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -877,7 +813,6 @@ subroutine AD_UnPackVTK_RotSurfaceType(Buf, OutData) call AD_UnpackVTK_BLSurfaceType(Buf, OutData%BladeShape(i1)) ! BladeShape end do end if - ! TowerRad if (allocated(OutData%TowerRad)) deallocate(OutData%TowerRad) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -893,122 +828,99 @@ subroutine AD_UnPackVTK_RotSurfaceType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE AD_CopyRotInitInputType( SrcRotInitInputTypeData, DstRotInitInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(RotInitInputType), INTENT(IN) :: SrcRotInitInputTypeData - TYPE(RotInitInputType), INTENT(INOUT) :: DstRotInitInputTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_CopyRotInitInputType' -! + +subroutine AD_CopyRotInitInputType(SrcRotInitInputTypeData, DstRotInitInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(RotInitInputType), intent(in) :: SrcRotInitInputTypeData + type(RotInitInputType), intent(inout) :: DstRotInitInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AD_CopyRotInitInputType' ErrStat = ErrID_None - ErrMsg = "" - DstRotInitInputTypeData%NumBlades = SrcRotInitInputTypeData%NumBlades - DstRotInitInputTypeData%HubPosition = SrcRotInitInputTypeData%HubPosition - DstRotInitInputTypeData%HubOrientation = SrcRotInitInputTypeData%HubOrientation -IF (ALLOCATED(SrcRotInitInputTypeData%BladeRootPosition)) THEN - i1_l = LBOUND(SrcRotInitInputTypeData%BladeRootPosition,1) - i1_u = UBOUND(SrcRotInitInputTypeData%BladeRootPosition,1) - i2_l = LBOUND(SrcRotInitInputTypeData%BladeRootPosition,2) - i2_u = UBOUND(SrcRotInitInputTypeData%BladeRootPosition,2) - IF (.NOT. ALLOCATED(DstRotInitInputTypeData%BladeRootPosition)) THEN - ALLOCATE(DstRotInitInputTypeData%BladeRootPosition(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitInputTypeData%BladeRootPosition.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInitInputTypeData%BladeRootPosition = SrcRotInitInputTypeData%BladeRootPosition -ENDIF -IF (ALLOCATED(SrcRotInitInputTypeData%BladeRootOrientation)) THEN - i1_l = LBOUND(SrcRotInitInputTypeData%BladeRootOrientation,1) - i1_u = UBOUND(SrcRotInitInputTypeData%BladeRootOrientation,1) - i2_l = LBOUND(SrcRotInitInputTypeData%BladeRootOrientation,2) - i2_u = UBOUND(SrcRotInitInputTypeData%BladeRootOrientation,2) - i3_l = LBOUND(SrcRotInitInputTypeData%BladeRootOrientation,3) - i3_u = UBOUND(SrcRotInitInputTypeData%BladeRootOrientation,3) - IF (.NOT. ALLOCATED(DstRotInitInputTypeData%BladeRootOrientation)) THEN - ALLOCATE(DstRotInitInputTypeData%BladeRootOrientation(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitInputTypeData%BladeRootOrientation.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInitInputTypeData%BladeRootOrientation = SrcRotInitInputTypeData%BladeRootOrientation -ENDIF - DstRotInitInputTypeData%NacellePosition = SrcRotInitInputTypeData%NacellePosition - DstRotInitInputTypeData%NacelleOrientation = SrcRotInitInputTypeData%NacelleOrientation - DstRotInitInputTypeData%AeroProjMod = SrcRotInitInputTypeData%AeroProjMod - DstRotInitInputTypeData%AeroBEM_Mod = SrcRotInitInputTypeData%AeroBEM_Mod - END SUBROUTINE AD_CopyRotInitInputType - - SUBROUTINE AD_DestroyRotInitInputType( RotInitInputTypeData, ErrStat, ErrMsg ) - TYPE(RotInitInputType), INTENT(INOUT) :: RotInitInputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyRotInitInputType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(RotInitInputTypeData%BladeRootPosition)) THEN - DEALLOCATE(RotInitInputTypeData%BladeRootPosition) -ENDIF -IF (ALLOCATED(RotInitInputTypeData%BladeRootOrientation)) THEN - DEALLOCATE(RotInitInputTypeData%BladeRootOrientation) -ENDIF - END SUBROUTINE AD_DestroyRotInitInputType + ErrMsg = '' + DstRotInitInputTypeData%NumBlades = SrcRotInitInputTypeData%NumBlades + DstRotInitInputTypeData%HubPosition = SrcRotInitInputTypeData%HubPosition + DstRotInitInputTypeData%HubOrientation = SrcRotInitInputTypeData%HubOrientation + if (allocated(SrcRotInitInputTypeData%BladeRootPosition)) then + LB(1:2) = lbound(SrcRotInitInputTypeData%BladeRootPosition) + UB(1:2) = ubound(SrcRotInitInputTypeData%BladeRootPosition) + if (.not. allocated(DstRotInitInputTypeData%BladeRootPosition)) then + allocate(DstRotInitInputTypeData%BladeRootPosition(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitInputTypeData%BladeRootPosition.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInitInputTypeData%BladeRootPosition = SrcRotInitInputTypeData%BladeRootPosition + else if (allocated(DstRotInitInputTypeData%BladeRootPosition)) then + deallocate(DstRotInitInputTypeData%BladeRootPosition) + end if + if (allocated(SrcRotInitInputTypeData%BladeRootOrientation)) then + LB(1:3) = lbound(SrcRotInitInputTypeData%BladeRootOrientation) + UB(1:3) = ubound(SrcRotInitInputTypeData%BladeRootOrientation) + if (.not. allocated(DstRotInitInputTypeData%BladeRootOrientation)) then + allocate(DstRotInitInputTypeData%BladeRootOrientation(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitInputTypeData%BladeRootOrientation.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInitInputTypeData%BladeRootOrientation = SrcRotInitInputTypeData%BladeRootOrientation + else if (allocated(DstRotInitInputTypeData%BladeRootOrientation)) then + deallocate(DstRotInitInputTypeData%BladeRootOrientation) + end if + DstRotInitInputTypeData%NacellePosition = SrcRotInitInputTypeData%NacellePosition + DstRotInitInputTypeData%NacelleOrientation = SrcRotInitInputTypeData%NacelleOrientation + DstRotInitInputTypeData%AeroProjMod = SrcRotInitInputTypeData%AeroProjMod + DstRotInitInputTypeData%AeroBEM_Mod = SrcRotInitInputTypeData%AeroBEM_Mod +end subroutine +subroutine AD_DestroyRotInitInputType(RotInitInputTypeData, ErrStat, ErrMsg) + type(RotInitInputType), intent(inout) :: RotInitInputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_DestroyRotInitInputType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(RotInitInputTypeData%BladeRootPosition)) then + deallocate(RotInitInputTypeData%BladeRootPosition) + end if + if (allocated(RotInitInputTypeData%BladeRootOrientation)) then + deallocate(RotInitInputTypeData%BladeRootOrientation) + end if +end subroutine subroutine AD_PackRotInitInputType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(RotInitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackRotInitInputType' if (Buf%ErrStat >= AbortErrLev) return - ! NumBlades call RegPack(Buf, InData%NumBlades) if (RegCheckErr(Buf, RoutineName)) return - ! HubPosition call RegPack(Buf, InData%HubPosition) if (RegCheckErr(Buf, RoutineName)) return - ! HubOrientation call RegPack(Buf, InData%HubOrientation) if (RegCheckErr(Buf, RoutineName)) return - ! BladeRootPosition call RegPack(Buf, allocated(InData%BladeRootPosition)) if (allocated(InData%BladeRootPosition)) then call RegPackBounds(Buf, 2, lbound(InData%BladeRootPosition), ubound(InData%BladeRootPosition)) call RegPack(Buf, InData%BladeRootPosition) end if if (RegCheckErr(Buf, RoutineName)) return - ! BladeRootOrientation call RegPack(Buf, allocated(InData%BladeRootOrientation)) if (allocated(InData%BladeRootOrientation)) then call RegPackBounds(Buf, 3, lbound(InData%BladeRootOrientation), ubound(InData%BladeRootOrientation)) call RegPack(Buf, InData%BladeRootOrientation) end if if (RegCheckErr(Buf, RoutineName)) return - ! NacellePosition call RegPack(Buf, InData%NacellePosition) if (RegCheckErr(Buf, RoutineName)) return - ! NacelleOrientation call RegPack(Buf, InData%NacelleOrientation) if (RegCheckErr(Buf, RoutineName)) return - ! AeroProjMod call RegPack(Buf, InData%AeroProjMod) if (RegCheckErr(Buf, RoutineName)) return - ! AeroBEM_Mod call RegPack(Buf, InData%AeroBEM_Mod) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1021,16 +933,12 @@ subroutine AD_UnPackRotInitInputType(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! NumBlades call RegUnpack(Buf, OutData%NumBlades) if (RegCheckErr(Buf, RoutineName)) return - ! HubPosition call RegUnpack(Buf, OutData%HubPosition) if (RegCheckErr(Buf, RoutineName)) return - ! HubOrientation call RegUnpack(Buf, OutData%HubOrientation) if (RegCheckErr(Buf, RoutineName)) return - ! BladeRootPosition if (allocated(OutData%BladeRootPosition)) deallocate(OutData%BladeRootPosition) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1045,7 +953,6 @@ subroutine AD_UnPackRotInitInputType(Buf, OutData) call RegUnpack(Buf, OutData%BladeRootPosition) if (RegCheckErr(Buf, RoutineName)) return end if - ! BladeRootOrientation if (allocated(OutData%BladeRootOrientation)) deallocate(OutData%BladeRootOrientation) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1060,92 +967,86 @@ subroutine AD_UnPackRotInitInputType(Buf, OutData) call RegUnpack(Buf, OutData%BladeRootOrientation) if (RegCheckErr(Buf, RoutineName)) return end if - ! NacellePosition call RegUnpack(Buf, OutData%NacellePosition) if (RegCheckErr(Buf, RoutineName)) return - ! NacelleOrientation call RegUnpack(Buf, OutData%NacelleOrientation) if (RegCheckErr(Buf, RoutineName)) return - ! AeroProjMod call RegUnpack(Buf, OutData%AeroProjMod) if (RegCheckErr(Buf, RoutineName)) return - ! AeroBEM_Mod call RegUnpack(Buf, OutData%AeroBEM_Mod) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE AD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(AD_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_CopyInitInput' -! + +subroutine AD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(AD_InitInputType), intent(in) :: SrcInitInputData + type(AD_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInitInputData%rotors)) THEN - i1_l = LBOUND(SrcInitInputData%rotors,1) - i1_u = UBOUND(SrcInitInputData%rotors,1) - IF (.NOT. ALLOCATED(DstInitInputData%rotors)) THEN - ALLOCATE(DstInitInputData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitInputData%rotors,1), UBOUND(SrcInitInputData%rotors,1) - CALL AD_Copyrotinitinputtype( SrcInitInputData%rotors(i1), DstInitInputData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstInitInputData%InputFile = SrcInitInputData%InputFile - DstInitInputData%RootName = SrcInitInputData%RootName - DstInitInputData%UsePrimaryInputFile = SrcInitInputData%UsePrimaryInputFile - CALL NWTC_Library_Copyfileinfotype( SrcInitInputData%PassedPrimaryInputData, DstInitInputData%PassedPrimaryInputData, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitInputData%Linearize = SrcInitInputData%Linearize - DstInitInputData%Gravity = SrcInitInputData%Gravity - DstInitInputData%MHK = SrcInitInputData%MHK - DstInitInputData%defFldDens = SrcInitInputData%defFldDens - DstInitInputData%defKinVisc = SrcInitInputData%defKinVisc - DstInitInputData%defSpdSound = SrcInitInputData%defSpdSound - DstInitInputData%defPatm = SrcInitInputData%defPatm - DstInitInputData%defPvap = SrcInitInputData%defPvap - DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth - DstInitInputData%MSL2SWL = SrcInitInputData%MSL2SWL - END SUBROUTINE AD_CopyInitInput - - SUBROUTINE AD_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(AD_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitInputData%rotors)) THEN -DO i1 = LBOUND(InitInputData%rotors,1), UBOUND(InitInputData%rotors,1) - CALL AD_DestroyRotInitInputType( InitInputData%rotors(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InitInputData%rotors) -ENDIF - CALL NWTC_Library_DestroyFileInfoType( InitInputData%PassedPrimaryInputData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_DestroyInitInput + ErrMsg = '' + if (allocated(SrcInitInputData%rotors)) then + LB(1:1) = lbound(SrcInitInputData%rotors) + UB(1:1) = ubound(SrcInitInputData%rotors) + if (.not. allocated(DstInitInputData%rotors)) then + allocate(DstInitInputData%rotors(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%rotors.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyRotInitInputType(SrcInitInputData%rotors(i1), DstInitInputData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstInitInputData%rotors)) then + deallocate(DstInitInputData%rotors) + end if + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%RootName = SrcInitInputData%RootName + DstInitInputData%UsePrimaryInputFile = SrcInitInputData%UsePrimaryInputFile + call NWTC_Library_CopyFileInfoType(SrcInitInputData%PassedPrimaryInputData, DstInitInputData%PassedPrimaryInputData, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitInputData%Linearize = SrcInitInputData%Linearize + DstInitInputData%Gravity = SrcInitInputData%Gravity + DstInitInputData%MHK = SrcInitInputData%MHK + DstInitInputData%defFldDens = SrcInitInputData%defFldDens + DstInitInputData%defKinVisc = SrcInitInputData%defKinVisc + DstInitInputData%defSpdSound = SrcInitInputData%defSpdSound + DstInitInputData%defPatm = SrcInitInputData%defPatm + DstInitInputData%defPvap = SrcInitInputData%defPvap + DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth + DstInitInputData%MSL2SWL = SrcInitInputData%MSL2SWL +end subroutine +subroutine AD_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(AD_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitInputData%rotors)) then + LB(1:1) = lbound(InitInputData%rotors) + UB(1:1) = ubound(InitInputData%rotors) + do i1 = LB(1), UB(1) + call AD_DestroyRotInitInputType(InitInputData%rotors(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitInputData%rotors) + end if +end subroutine subroutine AD_PackInitInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -1154,7 +1055,6 @@ subroutine AD_PackInitInput(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! rotors call RegPack(Buf, allocated(InData%rotors)) if (allocated(InData%rotors)) then call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) @@ -1165,46 +1065,32 @@ subroutine AD_PackInitInput(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! InputFile call RegPack(Buf, InData%InputFile) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegPack(Buf, InData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! UsePrimaryInputFile call RegPack(Buf, InData%UsePrimaryInputFile) if (RegCheckErr(Buf, RoutineName)) return - ! PassedPrimaryInputData call NWTC_Library_PackFileInfoType(Buf, InData%PassedPrimaryInputData) if (RegCheckErr(Buf, RoutineName)) return - ! Linearize call RegPack(Buf, InData%Linearize) if (RegCheckErr(Buf, RoutineName)) return - ! Gravity call RegPack(Buf, InData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - ! MHK call RegPack(Buf, InData%MHK) if (RegCheckErr(Buf, RoutineName)) return - ! defFldDens call RegPack(Buf, InData%defFldDens) if (RegCheckErr(Buf, RoutineName)) return - ! defKinVisc call RegPack(Buf, InData%defKinVisc) if (RegCheckErr(Buf, RoutineName)) return - ! defSpdSound call RegPack(Buf, InData%defSpdSound) if (RegCheckErr(Buf, RoutineName)) return - ! defPatm call RegPack(Buf, InData%defPatm) if (RegCheckErr(Buf, RoutineName)) return - ! defPvap call RegPack(Buf, InData%defPvap) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDpth call RegPack(Buf, InData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - ! MSL2SWL call RegPack(Buf, InData%MSL2SWL) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1218,7 +1104,6 @@ subroutine AD_UnPackInitInput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! rotors if (allocated(OutData%rotors)) deallocate(OutData%rotors) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1234,304 +1119,289 @@ subroutine AD_UnPackInitInput(Buf, OutData) call AD_UnpackRotInitInputType(Buf, OutData%rotors(i1)) ! rotors end do end if - ! InputFile call RegUnpack(Buf, OutData%InputFile) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegUnpack(Buf, OutData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! UsePrimaryInputFile call RegUnpack(Buf, OutData%UsePrimaryInputFile) if (RegCheckErr(Buf, RoutineName)) return - ! PassedPrimaryInputData call NWTC_Library_UnpackFileInfoType(Buf, OutData%PassedPrimaryInputData) ! PassedPrimaryInputData - ! Linearize call RegUnpack(Buf, OutData%Linearize) if (RegCheckErr(Buf, RoutineName)) return - ! Gravity call RegUnpack(Buf, OutData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - ! MHK call RegUnpack(Buf, OutData%MHK) if (RegCheckErr(Buf, RoutineName)) return - ! defFldDens call RegUnpack(Buf, OutData%defFldDens) if (RegCheckErr(Buf, RoutineName)) return - ! defKinVisc call RegUnpack(Buf, OutData%defKinVisc) if (RegCheckErr(Buf, RoutineName)) return - ! defSpdSound call RegUnpack(Buf, OutData%defSpdSound) if (RegCheckErr(Buf, RoutineName)) return - ! defPatm call RegUnpack(Buf, OutData%defPatm) if (RegCheckErr(Buf, RoutineName)) return - ! defPvap call RegUnpack(Buf, OutData%defPvap) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDpth call RegUnpack(Buf, OutData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - ! MSL2SWL call RegUnpack(Buf, OutData%MSL2SWL) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE AD_CopyBladePropsType( SrcBladePropsTypeData, DstBladePropsTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD_BladePropsType), INTENT(IN) :: SrcBladePropsTypeData - TYPE(AD_BladePropsType), INTENT(INOUT) :: DstBladePropsTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_CopyBladePropsType' -! + +subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, CtrlCode, ErrStat, ErrMsg) + type(AD_BladePropsType), intent(in) :: SrcBladePropsTypeData + type(AD_BladePropsType), intent(inout) :: DstBladePropsTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AD_CopyBladePropsType' ErrStat = ErrID_None - ErrMsg = "" - DstBladePropsTypeData%NumBlNds = SrcBladePropsTypeData%NumBlNds -IF (ALLOCATED(SrcBladePropsTypeData%BlSpn)) THEN - i1_l = LBOUND(SrcBladePropsTypeData%BlSpn,1) - i1_u = UBOUND(SrcBladePropsTypeData%BlSpn,1) - IF (.NOT. ALLOCATED(DstBladePropsTypeData%BlSpn)) THEN - ALLOCATE(DstBladePropsTypeData%BlSpn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlSpn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladePropsTypeData%BlSpn = SrcBladePropsTypeData%BlSpn -ENDIF -IF (ALLOCATED(SrcBladePropsTypeData%BlCrvAC)) THEN - i1_l = LBOUND(SrcBladePropsTypeData%BlCrvAC,1) - i1_u = UBOUND(SrcBladePropsTypeData%BlCrvAC,1) - IF (.NOT. ALLOCATED(DstBladePropsTypeData%BlCrvAC)) THEN - ALLOCATE(DstBladePropsTypeData%BlCrvAC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCrvAC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladePropsTypeData%BlCrvAC = SrcBladePropsTypeData%BlCrvAC -ENDIF -IF (ALLOCATED(SrcBladePropsTypeData%BlSwpAC)) THEN - i1_l = LBOUND(SrcBladePropsTypeData%BlSwpAC,1) - i1_u = UBOUND(SrcBladePropsTypeData%BlSwpAC,1) - IF (.NOT. ALLOCATED(DstBladePropsTypeData%BlSwpAC)) THEN - ALLOCATE(DstBladePropsTypeData%BlSwpAC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlSwpAC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladePropsTypeData%BlSwpAC = SrcBladePropsTypeData%BlSwpAC -ENDIF -IF (ALLOCATED(SrcBladePropsTypeData%BlCrvAng)) THEN - i1_l = LBOUND(SrcBladePropsTypeData%BlCrvAng,1) - i1_u = UBOUND(SrcBladePropsTypeData%BlCrvAng,1) - IF (.NOT. ALLOCATED(DstBladePropsTypeData%BlCrvAng)) THEN - ALLOCATE(DstBladePropsTypeData%BlCrvAng(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCrvAng.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladePropsTypeData%BlCrvAng = SrcBladePropsTypeData%BlCrvAng -ENDIF -IF (ALLOCATED(SrcBladePropsTypeData%BlTwist)) THEN - i1_l = LBOUND(SrcBladePropsTypeData%BlTwist,1) - i1_u = UBOUND(SrcBladePropsTypeData%BlTwist,1) - IF (.NOT. ALLOCATED(DstBladePropsTypeData%BlTwist)) THEN - ALLOCATE(DstBladePropsTypeData%BlTwist(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlTwist.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladePropsTypeData%BlTwist = SrcBladePropsTypeData%BlTwist -ENDIF -IF (ALLOCATED(SrcBladePropsTypeData%BlChord)) THEN - i1_l = LBOUND(SrcBladePropsTypeData%BlChord,1) - i1_u = UBOUND(SrcBladePropsTypeData%BlChord,1) - IF (.NOT. ALLOCATED(DstBladePropsTypeData%BlChord)) THEN - ALLOCATE(DstBladePropsTypeData%BlChord(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlChord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladePropsTypeData%BlChord = SrcBladePropsTypeData%BlChord -ENDIF -IF (ALLOCATED(SrcBladePropsTypeData%BlAFID)) THEN - i1_l = LBOUND(SrcBladePropsTypeData%BlAFID,1) - i1_u = UBOUND(SrcBladePropsTypeData%BlAFID,1) - IF (.NOT. ALLOCATED(DstBladePropsTypeData%BlAFID)) THEN - ALLOCATE(DstBladePropsTypeData%BlAFID(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlAFID.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladePropsTypeData%BlAFID = SrcBladePropsTypeData%BlAFID -ENDIF -IF (ALLOCATED(SrcBladePropsTypeData%BlCb)) THEN - i1_l = LBOUND(SrcBladePropsTypeData%BlCb,1) - i1_u = UBOUND(SrcBladePropsTypeData%BlCb,1) - IF (.NOT. ALLOCATED(DstBladePropsTypeData%BlCb)) THEN - ALLOCATE(DstBladePropsTypeData%BlCb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladePropsTypeData%BlCb = SrcBladePropsTypeData%BlCb -ENDIF -IF (ALLOCATED(SrcBladePropsTypeData%BlCenBn)) THEN - i1_l = LBOUND(SrcBladePropsTypeData%BlCenBn,1) - i1_u = UBOUND(SrcBladePropsTypeData%BlCenBn,1) - IF (.NOT. ALLOCATED(DstBladePropsTypeData%BlCenBn)) THEN - ALLOCATE(DstBladePropsTypeData%BlCenBn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCenBn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladePropsTypeData%BlCenBn = SrcBladePropsTypeData%BlCenBn -ENDIF -IF (ALLOCATED(SrcBladePropsTypeData%BlCenBt)) THEN - i1_l = LBOUND(SrcBladePropsTypeData%BlCenBt,1) - i1_u = UBOUND(SrcBladePropsTypeData%BlCenBt,1) - IF (.NOT. ALLOCATED(DstBladePropsTypeData%BlCenBt)) THEN - ALLOCATE(DstBladePropsTypeData%BlCenBt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCenBt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladePropsTypeData%BlCenBt = SrcBladePropsTypeData%BlCenBt -ENDIF - END SUBROUTINE AD_CopyBladePropsType - - SUBROUTINE AD_DestroyBladePropsType( BladePropsTypeData, ErrStat, ErrMsg ) - TYPE(AD_BladePropsType), INTENT(INOUT) :: BladePropsTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyBladePropsType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(BladePropsTypeData%BlSpn)) THEN - DEALLOCATE(BladePropsTypeData%BlSpn) -ENDIF -IF (ALLOCATED(BladePropsTypeData%BlCrvAC)) THEN - DEALLOCATE(BladePropsTypeData%BlCrvAC) -ENDIF -IF (ALLOCATED(BladePropsTypeData%BlSwpAC)) THEN - DEALLOCATE(BladePropsTypeData%BlSwpAC) -ENDIF -IF (ALLOCATED(BladePropsTypeData%BlCrvAng)) THEN - DEALLOCATE(BladePropsTypeData%BlCrvAng) -ENDIF -IF (ALLOCATED(BladePropsTypeData%BlTwist)) THEN - DEALLOCATE(BladePropsTypeData%BlTwist) -ENDIF -IF (ALLOCATED(BladePropsTypeData%BlChord)) THEN - DEALLOCATE(BladePropsTypeData%BlChord) -ENDIF -IF (ALLOCATED(BladePropsTypeData%BlAFID)) THEN - DEALLOCATE(BladePropsTypeData%BlAFID) -ENDIF -IF (ALLOCATED(BladePropsTypeData%BlCb)) THEN - DEALLOCATE(BladePropsTypeData%BlCb) -ENDIF -IF (ALLOCATED(BladePropsTypeData%BlCenBn)) THEN - DEALLOCATE(BladePropsTypeData%BlCenBn) -ENDIF -IF (ALLOCATED(BladePropsTypeData%BlCenBt)) THEN - DEALLOCATE(BladePropsTypeData%BlCenBt) -ENDIF - END SUBROUTINE AD_DestroyBladePropsType + ErrMsg = '' + DstBladePropsTypeData%NumBlNds = SrcBladePropsTypeData%NumBlNds + if (allocated(SrcBladePropsTypeData%BlSpn)) then + LB(1:1) = lbound(SrcBladePropsTypeData%BlSpn) + UB(1:1) = ubound(SrcBladePropsTypeData%BlSpn) + if (.not. allocated(DstBladePropsTypeData%BlSpn)) then + allocate(DstBladePropsTypeData%BlSpn(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlSpn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladePropsTypeData%BlSpn = SrcBladePropsTypeData%BlSpn + else if (allocated(DstBladePropsTypeData%BlSpn)) then + deallocate(DstBladePropsTypeData%BlSpn) + end if + if (allocated(SrcBladePropsTypeData%BlCrvAC)) then + LB(1:1) = lbound(SrcBladePropsTypeData%BlCrvAC) + UB(1:1) = ubound(SrcBladePropsTypeData%BlCrvAC) + if (.not. allocated(DstBladePropsTypeData%BlCrvAC)) then + allocate(DstBladePropsTypeData%BlCrvAC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCrvAC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladePropsTypeData%BlCrvAC = SrcBladePropsTypeData%BlCrvAC + else if (allocated(DstBladePropsTypeData%BlCrvAC)) then + deallocate(DstBladePropsTypeData%BlCrvAC) + end if + if (allocated(SrcBladePropsTypeData%BlSwpAC)) then + LB(1:1) = lbound(SrcBladePropsTypeData%BlSwpAC) + UB(1:1) = ubound(SrcBladePropsTypeData%BlSwpAC) + if (.not. allocated(DstBladePropsTypeData%BlSwpAC)) then + allocate(DstBladePropsTypeData%BlSwpAC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlSwpAC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladePropsTypeData%BlSwpAC = SrcBladePropsTypeData%BlSwpAC + else if (allocated(DstBladePropsTypeData%BlSwpAC)) then + deallocate(DstBladePropsTypeData%BlSwpAC) + end if + if (allocated(SrcBladePropsTypeData%BlCrvAng)) then + LB(1:1) = lbound(SrcBladePropsTypeData%BlCrvAng) + UB(1:1) = ubound(SrcBladePropsTypeData%BlCrvAng) + if (.not. allocated(DstBladePropsTypeData%BlCrvAng)) then + allocate(DstBladePropsTypeData%BlCrvAng(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCrvAng.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladePropsTypeData%BlCrvAng = SrcBladePropsTypeData%BlCrvAng + else if (allocated(DstBladePropsTypeData%BlCrvAng)) then + deallocate(DstBladePropsTypeData%BlCrvAng) + end if + if (allocated(SrcBladePropsTypeData%BlTwist)) then + LB(1:1) = lbound(SrcBladePropsTypeData%BlTwist) + UB(1:1) = ubound(SrcBladePropsTypeData%BlTwist) + if (.not. allocated(DstBladePropsTypeData%BlTwist)) then + allocate(DstBladePropsTypeData%BlTwist(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlTwist.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladePropsTypeData%BlTwist = SrcBladePropsTypeData%BlTwist + else if (allocated(DstBladePropsTypeData%BlTwist)) then + deallocate(DstBladePropsTypeData%BlTwist) + end if + if (allocated(SrcBladePropsTypeData%BlChord)) then + LB(1:1) = lbound(SrcBladePropsTypeData%BlChord) + UB(1:1) = ubound(SrcBladePropsTypeData%BlChord) + if (.not. allocated(DstBladePropsTypeData%BlChord)) then + allocate(DstBladePropsTypeData%BlChord(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlChord.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladePropsTypeData%BlChord = SrcBladePropsTypeData%BlChord + else if (allocated(DstBladePropsTypeData%BlChord)) then + deallocate(DstBladePropsTypeData%BlChord) + end if + if (allocated(SrcBladePropsTypeData%BlAFID)) then + LB(1:1) = lbound(SrcBladePropsTypeData%BlAFID) + UB(1:1) = ubound(SrcBladePropsTypeData%BlAFID) + if (.not. allocated(DstBladePropsTypeData%BlAFID)) then + allocate(DstBladePropsTypeData%BlAFID(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlAFID.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladePropsTypeData%BlAFID = SrcBladePropsTypeData%BlAFID + else if (allocated(DstBladePropsTypeData%BlAFID)) then + deallocate(DstBladePropsTypeData%BlAFID) + end if + if (allocated(SrcBladePropsTypeData%BlCb)) then + LB(1:1) = lbound(SrcBladePropsTypeData%BlCb) + UB(1:1) = ubound(SrcBladePropsTypeData%BlCb) + if (.not. allocated(DstBladePropsTypeData%BlCb)) then + allocate(DstBladePropsTypeData%BlCb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladePropsTypeData%BlCb = SrcBladePropsTypeData%BlCb + else if (allocated(DstBladePropsTypeData%BlCb)) then + deallocate(DstBladePropsTypeData%BlCb) + end if + if (allocated(SrcBladePropsTypeData%BlCenBn)) then + LB(1:1) = lbound(SrcBladePropsTypeData%BlCenBn) + UB(1:1) = ubound(SrcBladePropsTypeData%BlCenBn) + if (.not. allocated(DstBladePropsTypeData%BlCenBn)) then + allocate(DstBladePropsTypeData%BlCenBn(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCenBn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladePropsTypeData%BlCenBn = SrcBladePropsTypeData%BlCenBn + else if (allocated(DstBladePropsTypeData%BlCenBn)) then + deallocate(DstBladePropsTypeData%BlCenBn) + end if + if (allocated(SrcBladePropsTypeData%BlCenBt)) then + LB(1:1) = lbound(SrcBladePropsTypeData%BlCenBt) + UB(1:1) = ubound(SrcBladePropsTypeData%BlCenBt) + if (.not. allocated(DstBladePropsTypeData%BlCenBt)) then + allocate(DstBladePropsTypeData%BlCenBt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%BlCenBt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladePropsTypeData%BlCenBt = SrcBladePropsTypeData%BlCenBt + else if (allocated(DstBladePropsTypeData%BlCenBt)) then + deallocate(DstBladePropsTypeData%BlCenBt) + end if +end subroutine +subroutine AD_DestroyBladePropsType(BladePropsTypeData, ErrStat, ErrMsg) + type(AD_BladePropsType), intent(inout) :: BladePropsTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_DestroyBladePropsType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(BladePropsTypeData%BlSpn)) then + deallocate(BladePropsTypeData%BlSpn) + end if + if (allocated(BladePropsTypeData%BlCrvAC)) then + deallocate(BladePropsTypeData%BlCrvAC) + end if + if (allocated(BladePropsTypeData%BlSwpAC)) then + deallocate(BladePropsTypeData%BlSwpAC) + end if + if (allocated(BladePropsTypeData%BlCrvAng)) then + deallocate(BladePropsTypeData%BlCrvAng) + end if + if (allocated(BladePropsTypeData%BlTwist)) then + deallocate(BladePropsTypeData%BlTwist) + end if + if (allocated(BladePropsTypeData%BlChord)) then + deallocate(BladePropsTypeData%BlChord) + end if + if (allocated(BladePropsTypeData%BlAFID)) then + deallocate(BladePropsTypeData%BlAFID) + end if + if (allocated(BladePropsTypeData%BlCb)) then + deallocate(BladePropsTypeData%BlCb) + end if + if (allocated(BladePropsTypeData%BlCenBn)) then + deallocate(BladePropsTypeData%BlCenBn) + end if + if (allocated(BladePropsTypeData%BlCenBt)) then + deallocate(BladePropsTypeData%BlCenBt) + end if +end subroutine subroutine AD_PackBladePropsType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AD_BladePropsType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackBladePropsType' if (Buf%ErrStat >= AbortErrLev) return - ! NumBlNds call RegPack(Buf, InData%NumBlNds) if (RegCheckErr(Buf, RoutineName)) return - ! BlSpn call RegPack(Buf, allocated(InData%BlSpn)) if (allocated(InData%BlSpn)) then call RegPackBounds(Buf, 1, lbound(InData%BlSpn), ubound(InData%BlSpn)) call RegPack(Buf, InData%BlSpn) end if if (RegCheckErr(Buf, RoutineName)) return - ! BlCrvAC call RegPack(Buf, allocated(InData%BlCrvAC)) if (allocated(InData%BlCrvAC)) then call RegPackBounds(Buf, 1, lbound(InData%BlCrvAC), ubound(InData%BlCrvAC)) call RegPack(Buf, InData%BlCrvAC) end if if (RegCheckErr(Buf, RoutineName)) return - ! BlSwpAC call RegPack(Buf, allocated(InData%BlSwpAC)) if (allocated(InData%BlSwpAC)) then call RegPackBounds(Buf, 1, lbound(InData%BlSwpAC), ubound(InData%BlSwpAC)) call RegPack(Buf, InData%BlSwpAC) end if if (RegCheckErr(Buf, RoutineName)) return - ! BlCrvAng call RegPack(Buf, allocated(InData%BlCrvAng)) if (allocated(InData%BlCrvAng)) then call RegPackBounds(Buf, 1, lbound(InData%BlCrvAng), ubound(InData%BlCrvAng)) call RegPack(Buf, InData%BlCrvAng) end if if (RegCheckErr(Buf, RoutineName)) return - ! BlTwist call RegPack(Buf, allocated(InData%BlTwist)) if (allocated(InData%BlTwist)) then call RegPackBounds(Buf, 1, lbound(InData%BlTwist), ubound(InData%BlTwist)) call RegPack(Buf, InData%BlTwist) end if if (RegCheckErr(Buf, RoutineName)) return - ! BlChord call RegPack(Buf, allocated(InData%BlChord)) if (allocated(InData%BlChord)) then call RegPackBounds(Buf, 1, lbound(InData%BlChord), ubound(InData%BlChord)) call RegPack(Buf, InData%BlChord) end if if (RegCheckErr(Buf, RoutineName)) return - ! BlAFID call RegPack(Buf, allocated(InData%BlAFID)) if (allocated(InData%BlAFID)) then call RegPackBounds(Buf, 1, lbound(InData%BlAFID), ubound(InData%BlAFID)) call RegPack(Buf, InData%BlAFID) end if if (RegCheckErr(Buf, RoutineName)) return - ! BlCb call RegPack(Buf, allocated(InData%BlCb)) if (allocated(InData%BlCb)) then call RegPackBounds(Buf, 1, lbound(InData%BlCb), ubound(InData%BlCb)) call RegPack(Buf, InData%BlCb) end if if (RegCheckErr(Buf, RoutineName)) return - ! BlCenBn call RegPack(Buf, allocated(InData%BlCenBn)) if (allocated(InData%BlCenBn)) then call RegPackBounds(Buf, 1, lbound(InData%BlCenBn), ubound(InData%BlCenBn)) call RegPack(Buf, InData%BlCenBn) end if if (RegCheckErr(Buf, RoutineName)) return - ! BlCenBt call RegPack(Buf, allocated(InData%BlCenBt)) if (allocated(InData%BlCenBt)) then call RegPackBounds(Buf, 1, lbound(InData%BlCenBt), ubound(InData%BlCenBt)) @@ -1548,10 +1418,8 @@ subroutine AD_UnPackBladePropsType(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! NumBlNds call RegUnpack(Buf, OutData%NumBlNds) if (RegCheckErr(Buf, RoutineName)) return - ! BlSpn if (allocated(OutData%BlSpn)) deallocate(OutData%BlSpn) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1566,7 +1434,6 @@ subroutine AD_UnPackBladePropsType(Buf, OutData) call RegUnpack(Buf, OutData%BlSpn) if (RegCheckErr(Buf, RoutineName)) return end if - ! BlCrvAC if (allocated(OutData%BlCrvAC)) deallocate(OutData%BlCrvAC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1581,7 +1448,6 @@ subroutine AD_UnPackBladePropsType(Buf, OutData) call RegUnpack(Buf, OutData%BlCrvAC) if (RegCheckErr(Buf, RoutineName)) return end if - ! BlSwpAC if (allocated(OutData%BlSwpAC)) deallocate(OutData%BlSwpAC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1596,7 +1462,6 @@ subroutine AD_UnPackBladePropsType(Buf, OutData) call RegUnpack(Buf, OutData%BlSwpAC) if (RegCheckErr(Buf, RoutineName)) return end if - ! BlCrvAng if (allocated(OutData%BlCrvAng)) deallocate(OutData%BlCrvAng) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1611,7 +1476,6 @@ subroutine AD_UnPackBladePropsType(Buf, OutData) call RegUnpack(Buf, OutData%BlCrvAng) if (RegCheckErr(Buf, RoutineName)) return end if - ! BlTwist if (allocated(OutData%BlTwist)) deallocate(OutData%BlTwist) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1626,7 +1490,6 @@ subroutine AD_UnPackBladePropsType(Buf, OutData) call RegUnpack(Buf, OutData%BlTwist) if (RegCheckErr(Buf, RoutineName)) return end if - ! BlChord if (allocated(OutData%BlChord)) deallocate(OutData%BlChord) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1641,7 +1504,6 @@ subroutine AD_UnPackBladePropsType(Buf, OutData) call RegUnpack(Buf, OutData%BlChord) if (RegCheckErr(Buf, RoutineName)) return end if - ! BlAFID if (allocated(OutData%BlAFID)) deallocate(OutData%BlAFID) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1656,7 +1518,6 @@ subroutine AD_UnPackBladePropsType(Buf, OutData) call RegUnpack(Buf, OutData%BlAFID) if (RegCheckErr(Buf, RoutineName)) return end if - ! BlCb if (allocated(OutData%BlCb)) deallocate(OutData%BlCb) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1671,7 +1532,6 @@ subroutine AD_UnPackBladePropsType(Buf, OutData) call RegUnpack(Buf, OutData%BlCb) if (RegCheckErr(Buf, RoutineName)) return end if - ! BlCenBn if (allocated(OutData%BlCenBn)) deallocate(OutData%BlCenBn) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1686,7 +1546,6 @@ subroutine AD_UnPackBladePropsType(Buf, OutData) call RegUnpack(Buf, OutData%BlCenBn) if (RegCheckErr(Buf, RoutineName)) return end if - ! BlCenBt if (allocated(OutData%BlCenBt)) deallocate(OutData%BlCenBt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1702,66 +1561,51 @@ subroutine AD_UnPackBladePropsType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE AD_CopyBladeShape( SrcBladeShapeData, DstBladeShapeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD_BladeShape), INTENT(IN) :: SrcBladeShapeData - TYPE(AD_BladeShape), INTENT(INOUT) :: DstBladeShapeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_CopyBladeShape' -! + +subroutine AD_CopyBladeShape(SrcBladeShapeData, DstBladeShapeData, CtrlCode, ErrStat, ErrMsg) + type(AD_BladeShape), intent(in) :: SrcBladeShapeData + type(AD_BladeShape), intent(inout) :: DstBladeShapeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AD_CopyBladeShape' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcBladeShapeData%AirfoilCoords)) THEN - i1_l = LBOUND(SrcBladeShapeData%AirfoilCoords,1) - i1_u = UBOUND(SrcBladeShapeData%AirfoilCoords,1) - i2_l = LBOUND(SrcBladeShapeData%AirfoilCoords,2) - i2_u = UBOUND(SrcBladeShapeData%AirfoilCoords,2) - i3_l = LBOUND(SrcBladeShapeData%AirfoilCoords,3) - i3_u = UBOUND(SrcBladeShapeData%AirfoilCoords,3) - IF (.NOT. ALLOCATED(DstBladeShapeData%AirfoilCoords)) THEN - ALLOCATE(DstBladeShapeData%AirfoilCoords(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeShapeData%AirfoilCoords.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeShapeData%AirfoilCoords = SrcBladeShapeData%AirfoilCoords -ENDIF - END SUBROUTINE AD_CopyBladeShape - - SUBROUTINE AD_DestroyBladeShape( BladeShapeData, ErrStat, ErrMsg ) - TYPE(AD_BladeShape), INTENT(INOUT) :: BladeShapeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyBladeShape' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(BladeShapeData%AirfoilCoords)) THEN - DEALLOCATE(BladeShapeData%AirfoilCoords) -ENDIF - END SUBROUTINE AD_DestroyBladeShape + ErrMsg = '' + if (allocated(SrcBladeShapeData%AirfoilCoords)) then + LB(1:3) = lbound(SrcBladeShapeData%AirfoilCoords) + UB(1:3) = ubound(SrcBladeShapeData%AirfoilCoords) + if (.not. allocated(DstBladeShapeData%AirfoilCoords)) then + allocate(DstBladeShapeData%AirfoilCoords(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeShapeData%AirfoilCoords.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeShapeData%AirfoilCoords = SrcBladeShapeData%AirfoilCoords + else if (allocated(DstBladeShapeData%AirfoilCoords)) then + deallocate(DstBladeShapeData%AirfoilCoords) + end if +end subroutine +subroutine AD_DestroyBladeShape(BladeShapeData, ErrStat, ErrMsg) + type(AD_BladeShape), intent(inout) :: BladeShapeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_DestroyBladeShape' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(BladeShapeData%AirfoilCoords)) then + deallocate(BladeShapeData%AirfoilCoords) + end if +end subroutine subroutine AD_PackBladeShape(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AD_BladeShape), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackBladeShape' if (Buf%ErrStat >= AbortErrLev) return - ! AirfoilCoords call RegPack(Buf, allocated(InData%AirfoilCoords)) if (allocated(InData%AirfoilCoords)) then call RegPackBounds(Buf, 3, lbound(InData%AirfoilCoords), ubound(InData%AirfoilCoords)) @@ -1778,7 +1622,6 @@ subroutine AD_UnPackBladeShape(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! AirfoilCoords if (allocated(OutData%AirfoilCoords)) deallocate(OutData%AirfoilCoords) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1794,265 +1637,293 @@ subroutine AD_UnPackBladeShape(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE AD_CopyRotInitOutputType( SrcRotInitOutputTypeData, DstRotInitOutputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(RotInitOutputType), INTENT(IN) :: SrcRotInitOutputTypeData - TYPE(RotInitOutputType), INTENT(INOUT) :: DstRotInitOutputTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_CopyRotInitOutputType' -! + +subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTypeData, CtrlCode, ErrStat, ErrMsg) + type(RotInitOutputType), intent(in) :: SrcRotInitOutputTypeData + type(RotInitOutputType), intent(inout) :: DstRotInitOutputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyRotInitOutputType' ErrStat = ErrID_None - ErrMsg = "" - DstRotInitOutputTypeData%AirDens = SrcRotInitOutputTypeData%AirDens -IF (ALLOCATED(SrcRotInitOutputTypeData%WriteOutputHdr)) THEN - i1_l = LBOUND(SrcRotInitOutputTypeData%WriteOutputHdr,1) - i1_u = UBOUND(SrcRotInitOutputTypeData%WriteOutputHdr,1) - IF (.NOT. ALLOCATED(DstRotInitOutputTypeData%WriteOutputHdr)) THEN - ALLOCATE(DstRotInitOutputTypeData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInitOutputTypeData%WriteOutputHdr = SrcRotInitOutputTypeData%WriteOutputHdr -ENDIF -IF (ALLOCATED(SrcRotInitOutputTypeData%WriteOutputUnt)) THEN - i1_l = LBOUND(SrcRotInitOutputTypeData%WriteOutputUnt,1) - i1_u = UBOUND(SrcRotInitOutputTypeData%WriteOutputUnt,1) - IF (.NOT. ALLOCATED(DstRotInitOutputTypeData%WriteOutputUnt)) THEN - ALLOCATE(DstRotInitOutputTypeData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInitOutputTypeData%WriteOutputUnt = SrcRotInitOutputTypeData%WriteOutputUnt -ENDIF -IF (ALLOCATED(SrcRotInitOutputTypeData%BladeShape)) THEN - i1_l = LBOUND(SrcRotInitOutputTypeData%BladeShape,1) - i1_u = UBOUND(SrcRotInitOutputTypeData%BladeShape,1) - IF (.NOT. ALLOCATED(DstRotInitOutputTypeData%BladeShape)) THEN - ALLOCATE(DstRotInitOutputTypeData%BladeShape(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%BladeShape.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotInitOutputTypeData%BladeShape,1), UBOUND(SrcRotInitOutputTypeData%BladeShape,1) - CALL AD_Copybladeshape( SrcRotInitOutputTypeData%BladeShape(i1), DstRotInitOutputTypeData%BladeShape(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcRotInitOutputTypeData%LinNames_y)) THEN - i1_l = LBOUND(SrcRotInitOutputTypeData%LinNames_y,1) - i1_u = UBOUND(SrcRotInitOutputTypeData%LinNames_y,1) - IF (.NOT. ALLOCATED(DstRotInitOutputTypeData%LinNames_y)) THEN - ALLOCATE(DstRotInitOutputTypeData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInitOutputTypeData%LinNames_y = SrcRotInitOutputTypeData%LinNames_y -ENDIF -IF (ALLOCATED(SrcRotInitOutputTypeData%LinNames_x)) THEN - i1_l = LBOUND(SrcRotInitOutputTypeData%LinNames_x,1) - i1_u = UBOUND(SrcRotInitOutputTypeData%LinNames_x,1) - IF (.NOT. ALLOCATED(DstRotInitOutputTypeData%LinNames_x)) THEN - ALLOCATE(DstRotInitOutputTypeData%LinNames_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%LinNames_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInitOutputTypeData%LinNames_x = SrcRotInitOutputTypeData%LinNames_x -ENDIF -IF (ALLOCATED(SrcRotInitOutputTypeData%LinNames_u)) THEN - i1_l = LBOUND(SrcRotInitOutputTypeData%LinNames_u,1) - i1_u = UBOUND(SrcRotInitOutputTypeData%LinNames_u,1) - IF (.NOT. ALLOCATED(DstRotInitOutputTypeData%LinNames_u)) THEN - ALLOCATE(DstRotInitOutputTypeData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInitOutputTypeData%LinNames_u = SrcRotInitOutputTypeData%LinNames_u -ENDIF -IF (ALLOCATED(SrcRotInitOutputTypeData%RotFrame_y)) THEN - i1_l = LBOUND(SrcRotInitOutputTypeData%RotFrame_y,1) - i1_u = UBOUND(SrcRotInitOutputTypeData%RotFrame_y,1) - IF (.NOT. ALLOCATED(DstRotInitOutputTypeData%RotFrame_y)) THEN - ALLOCATE(DstRotInitOutputTypeData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInitOutputTypeData%RotFrame_y = SrcRotInitOutputTypeData%RotFrame_y -ENDIF -IF (ALLOCATED(SrcRotInitOutputTypeData%RotFrame_x)) THEN - i1_l = LBOUND(SrcRotInitOutputTypeData%RotFrame_x,1) - i1_u = UBOUND(SrcRotInitOutputTypeData%RotFrame_x,1) - IF (.NOT. ALLOCATED(DstRotInitOutputTypeData%RotFrame_x)) THEN - ALLOCATE(DstRotInitOutputTypeData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInitOutputTypeData%RotFrame_x = SrcRotInitOutputTypeData%RotFrame_x -ENDIF -IF (ALLOCATED(SrcRotInitOutputTypeData%RotFrame_u)) THEN - i1_l = LBOUND(SrcRotInitOutputTypeData%RotFrame_u,1) - i1_u = UBOUND(SrcRotInitOutputTypeData%RotFrame_u,1) - IF (.NOT. ALLOCATED(DstRotInitOutputTypeData%RotFrame_u)) THEN - ALLOCATE(DstRotInitOutputTypeData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInitOutputTypeData%RotFrame_u = SrcRotInitOutputTypeData%RotFrame_u -ENDIF -IF (ALLOCATED(SrcRotInitOutputTypeData%IsLoad_u)) THEN - i1_l = LBOUND(SrcRotInitOutputTypeData%IsLoad_u,1) - i1_u = UBOUND(SrcRotInitOutputTypeData%IsLoad_u,1) - IF (.NOT. ALLOCATED(DstRotInitOutputTypeData%IsLoad_u)) THEN - ALLOCATE(DstRotInitOutputTypeData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInitOutputTypeData%IsLoad_u = SrcRotInitOutputTypeData%IsLoad_u -ENDIF -IF (ALLOCATED(SrcRotInitOutputTypeData%BladeProps)) THEN - i1_l = LBOUND(SrcRotInitOutputTypeData%BladeProps,1) - i1_u = UBOUND(SrcRotInitOutputTypeData%BladeProps,1) - IF (.NOT. ALLOCATED(DstRotInitOutputTypeData%BladeProps)) THEN - ALLOCATE(DstRotInitOutputTypeData%BladeProps(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%BladeProps.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotInitOutputTypeData%BladeProps,1), UBOUND(SrcRotInitOutputTypeData%BladeProps,1) - CALL AD_Copybladepropstype( SrcRotInitOutputTypeData%BladeProps(i1), DstRotInitOutputTypeData%BladeProps(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcRotInitOutputTypeData%DerivOrder_x)) THEN - i1_l = LBOUND(SrcRotInitOutputTypeData%DerivOrder_x,1) - i1_u = UBOUND(SrcRotInitOutputTypeData%DerivOrder_x,1) - IF (.NOT. ALLOCATED(DstRotInitOutputTypeData%DerivOrder_x)) THEN - ALLOCATE(DstRotInitOutputTypeData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInitOutputTypeData%DerivOrder_x = SrcRotInitOutputTypeData%DerivOrder_x -ENDIF -IF (ALLOCATED(SrcRotInitOutputTypeData%TwrElev)) THEN - i1_l = LBOUND(SrcRotInitOutputTypeData%TwrElev,1) - i1_u = UBOUND(SrcRotInitOutputTypeData%TwrElev,1) - IF (.NOT. ALLOCATED(DstRotInitOutputTypeData%TwrElev)) THEN - ALLOCATE(DstRotInitOutputTypeData%TwrElev(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%TwrElev.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInitOutputTypeData%TwrElev = SrcRotInitOutputTypeData%TwrElev -ENDIF -IF (ALLOCATED(SrcRotInitOutputTypeData%TwrDiam)) THEN - i1_l = LBOUND(SrcRotInitOutputTypeData%TwrDiam,1) - i1_u = UBOUND(SrcRotInitOutputTypeData%TwrDiam,1) - IF (.NOT. ALLOCATED(DstRotInitOutputTypeData%TwrDiam)) THEN - ALLOCATE(DstRotInitOutputTypeData%TwrDiam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%TwrDiam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInitOutputTypeData%TwrDiam = SrcRotInitOutputTypeData%TwrDiam -ENDIF - END SUBROUTINE AD_CopyRotInitOutputType - - SUBROUTINE AD_DestroyRotInitOutputType( RotInitOutputTypeData, ErrStat, ErrMsg ) - TYPE(RotInitOutputType), INTENT(INOUT) :: RotInitOutputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyRotInitOutputType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(RotInitOutputTypeData%WriteOutputHdr)) THEN - DEALLOCATE(RotInitOutputTypeData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(RotInitOutputTypeData%WriteOutputUnt)) THEN - DEALLOCATE(RotInitOutputTypeData%WriteOutputUnt) -ENDIF -IF (ALLOCATED(RotInitOutputTypeData%BladeShape)) THEN -DO i1 = LBOUND(RotInitOutputTypeData%BladeShape,1), UBOUND(RotInitOutputTypeData%BladeShape,1) - CALL AD_DestroyBladeShape( RotInitOutputTypeData%BladeShape(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotInitOutputTypeData%BladeShape) -ENDIF -IF (ALLOCATED(RotInitOutputTypeData%LinNames_y)) THEN - DEALLOCATE(RotInitOutputTypeData%LinNames_y) -ENDIF -IF (ALLOCATED(RotInitOutputTypeData%LinNames_x)) THEN - DEALLOCATE(RotInitOutputTypeData%LinNames_x) -ENDIF -IF (ALLOCATED(RotInitOutputTypeData%LinNames_u)) THEN - DEALLOCATE(RotInitOutputTypeData%LinNames_u) -ENDIF -IF (ALLOCATED(RotInitOutputTypeData%RotFrame_y)) THEN - DEALLOCATE(RotInitOutputTypeData%RotFrame_y) -ENDIF -IF (ALLOCATED(RotInitOutputTypeData%RotFrame_x)) THEN - DEALLOCATE(RotInitOutputTypeData%RotFrame_x) -ENDIF -IF (ALLOCATED(RotInitOutputTypeData%RotFrame_u)) THEN - DEALLOCATE(RotInitOutputTypeData%RotFrame_u) -ENDIF -IF (ALLOCATED(RotInitOutputTypeData%IsLoad_u)) THEN - DEALLOCATE(RotInitOutputTypeData%IsLoad_u) -ENDIF -IF (ALLOCATED(RotInitOutputTypeData%BladeProps)) THEN -DO i1 = LBOUND(RotInitOutputTypeData%BladeProps,1), UBOUND(RotInitOutputTypeData%BladeProps,1) - CALL AD_DestroyBladePropsType( RotInitOutputTypeData%BladeProps(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotInitOutputTypeData%BladeProps) -ENDIF -IF (ALLOCATED(RotInitOutputTypeData%DerivOrder_x)) THEN - DEALLOCATE(RotInitOutputTypeData%DerivOrder_x) -ENDIF -IF (ALLOCATED(RotInitOutputTypeData%TwrElev)) THEN - DEALLOCATE(RotInitOutputTypeData%TwrElev) -ENDIF -IF (ALLOCATED(RotInitOutputTypeData%TwrDiam)) THEN - DEALLOCATE(RotInitOutputTypeData%TwrDiam) -ENDIF - END SUBROUTINE AD_DestroyRotInitOutputType + ErrMsg = '' + DstRotInitOutputTypeData%AirDens = SrcRotInitOutputTypeData%AirDens + if (allocated(SrcRotInitOutputTypeData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcRotInitOutputTypeData%WriteOutputHdr) + UB(1:1) = ubound(SrcRotInitOutputTypeData%WriteOutputHdr) + if (.not. allocated(DstRotInitOutputTypeData%WriteOutputHdr)) then + allocate(DstRotInitOutputTypeData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%WriteOutputHdr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInitOutputTypeData%WriteOutputHdr = SrcRotInitOutputTypeData%WriteOutputHdr + else if (allocated(DstRotInitOutputTypeData%WriteOutputHdr)) then + deallocate(DstRotInitOutputTypeData%WriteOutputHdr) + end if + if (allocated(SrcRotInitOutputTypeData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcRotInitOutputTypeData%WriteOutputUnt) + UB(1:1) = ubound(SrcRotInitOutputTypeData%WriteOutputUnt) + if (.not. allocated(DstRotInitOutputTypeData%WriteOutputUnt)) then + allocate(DstRotInitOutputTypeData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%WriteOutputUnt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInitOutputTypeData%WriteOutputUnt = SrcRotInitOutputTypeData%WriteOutputUnt + else if (allocated(DstRotInitOutputTypeData%WriteOutputUnt)) then + deallocate(DstRotInitOutputTypeData%WriteOutputUnt) + end if + if (allocated(SrcRotInitOutputTypeData%BladeShape)) then + LB(1:1) = lbound(SrcRotInitOutputTypeData%BladeShape) + UB(1:1) = ubound(SrcRotInitOutputTypeData%BladeShape) + if (.not. allocated(DstRotInitOutputTypeData%BladeShape)) then + allocate(DstRotInitOutputTypeData%BladeShape(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%BladeShape.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyBladeShape(SrcRotInitOutputTypeData%BladeShape(i1), DstRotInitOutputTypeData%BladeShape(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstRotInitOutputTypeData%BladeShape)) then + deallocate(DstRotInitOutputTypeData%BladeShape) + end if + if (allocated(SrcRotInitOutputTypeData%LinNames_y)) then + LB(1:1) = lbound(SrcRotInitOutputTypeData%LinNames_y) + UB(1:1) = ubound(SrcRotInitOutputTypeData%LinNames_y) + if (.not. allocated(DstRotInitOutputTypeData%LinNames_y)) then + allocate(DstRotInitOutputTypeData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%LinNames_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInitOutputTypeData%LinNames_y = SrcRotInitOutputTypeData%LinNames_y + else if (allocated(DstRotInitOutputTypeData%LinNames_y)) then + deallocate(DstRotInitOutputTypeData%LinNames_y) + end if + if (allocated(SrcRotInitOutputTypeData%LinNames_x)) then + LB(1:1) = lbound(SrcRotInitOutputTypeData%LinNames_x) + UB(1:1) = ubound(SrcRotInitOutputTypeData%LinNames_x) + if (.not. allocated(DstRotInitOutputTypeData%LinNames_x)) then + allocate(DstRotInitOutputTypeData%LinNames_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%LinNames_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInitOutputTypeData%LinNames_x = SrcRotInitOutputTypeData%LinNames_x + else if (allocated(DstRotInitOutputTypeData%LinNames_x)) then + deallocate(DstRotInitOutputTypeData%LinNames_x) + end if + if (allocated(SrcRotInitOutputTypeData%LinNames_u)) then + LB(1:1) = lbound(SrcRotInitOutputTypeData%LinNames_u) + UB(1:1) = ubound(SrcRotInitOutputTypeData%LinNames_u) + if (.not. allocated(DstRotInitOutputTypeData%LinNames_u)) then + allocate(DstRotInitOutputTypeData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%LinNames_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInitOutputTypeData%LinNames_u = SrcRotInitOutputTypeData%LinNames_u + else if (allocated(DstRotInitOutputTypeData%LinNames_u)) then + deallocate(DstRotInitOutputTypeData%LinNames_u) + end if + if (allocated(SrcRotInitOutputTypeData%RotFrame_y)) then + LB(1:1) = lbound(SrcRotInitOutputTypeData%RotFrame_y) + UB(1:1) = ubound(SrcRotInitOutputTypeData%RotFrame_y) + if (.not. allocated(DstRotInitOutputTypeData%RotFrame_y)) then + allocate(DstRotInitOutputTypeData%RotFrame_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%RotFrame_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInitOutputTypeData%RotFrame_y = SrcRotInitOutputTypeData%RotFrame_y + else if (allocated(DstRotInitOutputTypeData%RotFrame_y)) then + deallocate(DstRotInitOutputTypeData%RotFrame_y) + end if + if (allocated(SrcRotInitOutputTypeData%RotFrame_x)) then + LB(1:1) = lbound(SrcRotInitOutputTypeData%RotFrame_x) + UB(1:1) = ubound(SrcRotInitOutputTypeData%RotFrame_x) + if (.not. allocated(DstRotInitOutputTypeData%RotFrame_x)) then + allocate(DstRotInitOutputTypeData%RotFrame_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%RotFrame_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInitOutputTypeData%RotFrame_x = SrcRotInitOutputTypeData%RotFrame_x + else if (allocated(DstRotInitOutputTypeData%RotFrame_x)) then + deallocate(DstRotInitOutputTypeData%RotFrame_x) + end if + if (allocated(SrcRotInitOutputTypeData%RotFrame_u)) then + LB(1:1) = lbound(SrcRotInitOutputTypeData%RotFrame_u) + UB(1:1) = ubound(SrcRotInitOutputTypeData%RotFrame_u) + if (.not. allocated(DstRotInitOutputTypeData%RotFrame_u)) then + allocate(DstRotInitOutputTypeData%RotFrame_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%RotFrame_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInitOutputTypeData%RotFrame_u = SrcRotInitOutputTypeData%RotFrame_u + else if (allocated(DstRotInitOutputTypeData%RotFrame_u)) then + deallocate(DstRotInitOutputTypeData%RotFrame_u) + end if + if (allocated(SrcRotInitOutputTypeData%IsLoad_u)) then + LB(1:1) = lbound(SrcRotInitOutputTypeData%IsLoad_u) + UB(1:1) = ubound(SrcRotInitOutputTypeData%IsLoad_u) + if (.not. allocated(DstRotInitOutputTypeData%IsLoad_u)) then + allocate(DstRotInitOutputTypeData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%IsLoad_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInitOutputTypeData%IsLoad_u = SrcRotInitOutputTypeData%IsLoad_u + else if (allocated(DstRotInitOutputTypeData%IsLoad_u)) then + deallocate(DstRotInitOutputTypeData%IsLoad_u) + end if + if (allocated(SrcRotInitOutputTypeData%BladeProps)) then + LB(1:1) = lbound(SrcRotInitOutputTypeData%BladeProps) + UB(1:1) = ubound(SrcRotInitOutputTypeData%BladeProps) + if (.not. allocated(DstRotInitOutputTypeData%BladeProps)) then + allocate(DstRotInitOutputTypeData%BladeProps(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%BladeProps.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyBladePropsType(SrcRotInitOutputTypeData%BladeProps(i1), DstRotInitOutputTypeData%BladeProps(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstRotInitOutputTypeData%BladeProps)) then + deallocate(DstRotInitOutputTypeData%BladeProps) + end if + if (allocated(SrcRotInitOutputTypeData%DerivOrder_x)) then + LB(1:1) = lbound(SrcRotInitOutputTypeData%DerivOrder_x) + UB(1:1) = ubound(SrcRotInitOutputTypeData%DerivOrder_x) + if (.not. allocated(DstRotInitOutputTypeData%DerivOrder_x)) then + allocate(DstRotInitOutputTypeData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%DerivOrder_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInitOutputTypeData%DerivOrder_x = SrcRotInitOutputTypeData%DerivOrder_x + else if (allocated(DstRotInitOutputTypeData%DerivOrder_x)) then + deallocate(DstRotInitOutputTypeData%DerivOrder_x) + end if + if (allocated(SrcRotInitOutputTypeData%TwrElev)) then + LB(1:1) = lbound(SrcRotInitOutputTypeData%TwrElev) + UB(1:1) = ubound(SrcRotInitOutputTypeData%TwrElev) + if (.not. allocated(DstRotInitOutputTypeData%TwrElev)) then + allocate(DstRotInitOutputTypeData%TwrElev(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%TwrElev.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInitOutputTypeData%TwrElev = SrcRotInitOutputTypeData%TwrElev + else if (allocated(DstRotInitOutputTypeData%TwrElev)) then + deallocate(DstRotInitOutputTypeData%TwrElev) + end if + if (allocated(SrcRotInitOutputTypeData%TwrDiam)) then + LB(1:1) = lbound(SrcRotInitOutputTypeData%TwrDiam) + UB(1:1) = ubound(SrcRotInitOutputTypeData%TwrDiam) + if (.not. allocated(DstRotInitOutputTypeData%TwrDiam)) then + allocate(DstRotInitOutputTypeData%TwrDiam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInitOutputTypeData%TwrDiam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInitOutputTypeData%TwrDiam = SrcRotInitOutputTypeData%TwrDiam + else if (allocated(DstRotInitOutputTypeData%TwrDiam)) then + deallocate(DstRotInitOutputTypeData%TwrDiam) + end if +end subroutine +subroutine AD_DestroyRotInitOutputType(RotInitOutputTypeData, ErrStat, ErrMsg) + type(RotInitOutputType), intent(inout) :: RotInitOutputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyRotInitOutputType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(RotInitOutputTypeData%WriteOutputHdr)) then + deallocate(RotInitOutputTypeData%WriteOutputHdr) + end if + if (allocated(RotInitOutputTypeData%WriteOutputUnt)) then + deallocate(RotInitOutputTypeData%WriteOutputUnt) + end if + if (allocated(RotInitOutputTypeData%BladeShape)) then + LB(1:1) = lbound(RotInitOutputTypeData%BladeShape) + UB(1:1) = ubound(RotInitOutputTypeData%BladeShape) + do i1 = LB(1), UB(1) + call AD_DestroyBladeShape(RotInitOutputTypeData%BladeShape(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotInitOutputTypeData%BladeShape) + end if + if (allocated(RotInitOutputTypeData%LinNames_y)) then + deallocate(RotInitOutputTypeData%LinNames_y) + end if + if (allocated(RotInitOutputTypeData%LinNames_x)) then + deallocate(RotInitOutputTypeData%LinNames_x) + end if + if (allocated(RotInitOutputTypeData%LinNames_u)) then + deallocate(RotInitOutputTypeData%LinNames_u) + end if + if (allocated(RotInitOutputTypeData%RotFrame_y)) then + deallocate(RotInitOutputTypeData%RotFrame_y) + end if + if (allocated(RotInitOutputTypeData%RotFrame_x)) then + deallocate(RotInitOutputTypeData%RotFrame_x) + end if + if (allocated(RotInitOutputTypeData%RotFrame_u)) then + deallocate(RotInitOutputTypeData%RotFrame_u) + end if + if (allocated(RotInitOutputTypeData%IsLoad_u)) then + deallocate(RotInitOutputTypeData%IsLoad_u) + end if + if (allocated(RotInitOutputTypeData%BladeProps)) then + LB(1:1) = lbound(RotInitOutputTypeData%BladeProps) + UB(1:1) = ubound(RotInitOutputTypeData%BladeProps) + do i1 = LB(1), UB(1) + call AD_DestroyBladePropsType(RotInitOutputTypeData%BladeProps(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotInitOutputTypeData%BladeProps) + end if + if (allocated(RotInitOutputTypeData%DerivOrder_x)) then + deallocate(RotInitOutputTypeData%DerivOrder_x) + end if + if (allocated(RotInitOutputTypeData%TwrElev)) then + deallocate(RotInitOutputTypeData%TwrElev) + end if + if (allocated(RotInitOutputTypeData%TwrDiam)) then + deallocate(RotInitOutputTypeData%TwrDiam) + end if +end subroutine subroutine AD_PackRotInitOutputType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -2061,24 +1932,20 @@ subroutine AD_PackRotInitOutputType(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! AirDens call RegPack(Buf, InData%AirDens) if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutputHdr call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) call RegPack(Buf, InData%WriteOutputHdr) end if if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutputUnt call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) call RegPack(Buf, InData%WriteOutputUnt) end if if (RegCheckErr(Buf, RoutineName)) return - ! BladeShape call RegPack(Buf, allocated(InData%BladeShape)) if (allocated(InData%BladeShape)) then call RegPackBounds(Buf, 1, lbound(InData%BladeShape), ubound(InData%BladeShape)) @@ -2089,56 +1956,48 @@ subroutine AD_PackRotInitOutputType(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! LinNames_y call RegPack(Buf, allocated(InData%LinNames_y)) if (allocated(InData%LinNames_y)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) call RegPack(Buf, InData%LinNames_y) end if if (RegCheckErr(Buf, RoutineName)) return - ! LinNames_x call RegPack(Buf, allocated(InData%LinNames_x)) if (allocated(InData%LinNames_x)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_x), ubound(InData%LinNames_x)) call RegPack(Buf, InData%LinNames_x) end if if (RegCheckErr(Buf, RoutineName)) return - ! LinNames_u call RegPack(Buf, allocated(InData%LinNames_u)) if (allocated(InData%LinNames_u)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) call RegPack(Buf, InData%LinNames_u) end if if (RegCheckErr(Buf, RoutineName)) return - ! RotFrame_y call RegPack(Buf, allocated(InData%RotFrame_y)) if (allocated(InData%RotFrame_y)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y), ubound(InData%RotFrame_y)) call RegPack(Buf, InData%RotFrame_y) end if if (RegCheckErr(Buf, RoutineName)) return - ! RotFrame_x call RegPack(Buf, allocated(InData%RotFrame_x)) if (allocated(InData%RotFrame_x)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x), ubound(InData%RotFrame_x)) call RegPack(Buf, InData%RotFrame_x) end if if (RegCheckErr(Buf, RoutineName)) return - ! RotFrame_u call RegPack(Buf, allocated(InData%RotFrame_u)) if (allocated(InData%RotFrame_u)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u), ubound(InData%RotFrame_u)) call RegPack(Buf, InData%RotFrame_u) end if if (RegCheckErr(Buf, RoutineName)) return - ! IsLoad_u call RegPack(Buf, allocated(InData%IsLoad_u)) if (allocated(InData%IsLoad_u)) then call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) call RegPack(Buf, InData%IsLoad_u) end if if (RegCheckErr(Buf, RoutineName)) return - ! BladeProps call RegPack(Buf, allocated(InData%BladeProps)) if (allocated(InData%BladeProps)) then call RegPackBounds(Buf, 1, lbound(InData%BladeProps), ubound(InData%BladeProps)) @@ -2149,21 +2008,18 @@ subroutine AD_PackRotInitOutputType(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! DerivOrder_x call RegPack(Buf, allocated(InData%DerivOrder_x)) if (allocated(InData%DerivOrder_x)) then call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x), ubound(InData%DerivOrder_x)) call RegPack(Buf, InData%DerivOrder_x) end if if (RegCheckErr(Buf, RoutineName)) return - ! TwrElev call RegPack(Buf, allocated(InData%TwrElev)) if (allocated(InData%TwrElev)) then call RegPackBounds(Buf, 1, lbound(InData%TwrElev), ubound(InData%TwrElev)) call RegPack(Buf, InData%TwrElev) end if if (RegCheckErr(Buf, RoutineName)) return - ! TwrDiam call RegPack(Buf, allocated(InData%TwrDiam)) if (allocated(InData%TwrDiam)) then call RegPackBounds(Buf, 1, lbound(InData%TwrDiam), ubound(InData%TwrDiam)) @@ -2181,10 +2037,8 @@ subroutine AD_UnPackRotInitOutputType(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! AirDens call RegUnpack(Buf, OutData%AirDens) if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutputHdr if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2199,7 +2053,6 @@ subroutine AD_UnPackRotInitOutputType(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutputHdr) if (RegCheckErr(Buf, RoutineName)) return end if - ! WriteOutputUnt if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2214,7 +2067,6 @@ subroutine AD_UnPackRotInitOutputType(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutputUnt) if (RegCheckErr(Buf, RoutineName)) return end if - ! BladeShape if (allocated(OutData%BladeShape)) deallocate(OutData%BladeShape) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2230,7 +2082,6 @@ subroutine AD_UnPackRotInitOutputType(Buf, OutData) call AD_UnpackBladeShape(Buf, OutData%BladeShape(i1)) ! BladeShape end do end if - ! LinNames_y if (allocated(OutData%LinNames_y)) deallocate(OutData%LinNames_y) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2245,7 +2096,6 @@ subroutine AD_UnPackRotInitOutputType(Buf, OutData) call RegUnpack(Buf, OutData%LinNames_y) if (RegCheckErr(Buf, RoutineName)) return end if - ! LinNames_x if (allocated(OutData%LinNames_x)) deallocate(OutData%LinNames_x) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2260,7 +2110,6 @@ subroutine AD_UnPackRotInitOutputType(Buf, OutData) call RegUnpack(Buf, OutData%LinNames_x) if (RegCheckErr(Buf, RoutineName)) return end if - ! LinNames_u if (allocated(OutData%LinNames_u)) deallocate(OutData%LinNames_u) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2275,7 +2124,6 @@ subroutine AD_UnPackRotInitOutputType(Buf, OutData) call RegUnpack(Buf, OutData%LinNames_u) if (RegCheckErr(Buf, RoutineName)) return end if - ! RotFrame_y if (allocated(OutData%RotFrame_y)) deallocate(OutData%RotFrame_y) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2290,7 +2138,6 @@ subroutine AD_UnPackRotInitOutputType(Buf, OutData) call RegUnpack(Buf, OutData%RotFrame_y) if (RegCheckErr(Buf, RoutineName)) return end if - ! RotFrame_x if (allocated(OutData%RotFrame_x)) deallocate(OutData%RotFrame_x) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2305,7 +2152,6 @@ subroutine AD_UnPackRotInitOutputType(Buf, OutData) call RegUnpack(Buf, OutData%RotFrame_x) if (RegCheckErr(Buf, RoutineName)) return end if - ! RotFrame_u if (allocated(OutData%RotFrame_u)) deallocate(OutData%RotFrame_u) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2320,7 +2166,6 @@ subroutine AD_UnPackRotInitOutputType(Buf, OutData) call RegUnpack(Buf, OutData%RotFrame_u) if (RegCheckErr(Buf, RoutineName)) return end if - ! IsLoad_u if (allocated(OutData%IsLoad_u)) deallocate(OutData%IsLoad_u) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2335,7 +2180,6 @@ subroutine AD_UnPackRotInitOutputType(Buf, OutData) call RegUnpack(Buf, OutData%IsLoad_u) if (RegCheckErr(Buf, RoutineName)) return end if - ! BladeProps if (allocated(OutData%BladeProps)) deallocate(OutData%BladeProps) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2351,7 +2195,6 @@ subroutine AD_UnPackRotInitOutputType(Buf, OutData) call AD_UnpackBladePropsType(Buf, OutData%BladeProps(i1)) ! BladeProps end do end if - ! DerivOrder_x if (allocated(OutData%DerivOrder_x)) deallocate(OutData%DerivOrder_x) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2366,7 +2209,6 @@ subroutine AD_UnPackRotInitOutputType(Buf, OutData) call RegUnpack(Buf, OutData%DerivOrder_x) if (RegCheckErr(Buf, RoutineName)) return end if - ! TwrElev if (allocated(OutData%TwrElev)) deallocate(OutData%TwrElev) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2381,7 +2223,6 @@ subroutine AD_UnPackRotInitOutputType(Buf, OutData) call RegUnpack(Buf, OutData%TwrElev) if (RegCheckErr(Buf, RoutineName)) return end if - ! TwrDiam if (allocated(OutData%TwrDiam)) deallocate(OutData%TwrDiam) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2397,66 +2238,64 @@ subroutine AD_UnPackRotInitOutputType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE AD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(AD_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_CopyInitOutput' -! + +subroutine AD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(AD_InitOutputType), intent(in) :: SrcInitOutputData + type(AD_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInitOutputData%rotors)) THEN - i1_l = LBOUND(SrcInitOutputData%rotors,1) - i1_u = UBOUND(SrcInitOutputData%rotors,1) - IF (.NOT. ALLOCATED(DstInitOutputData%rotors)) THEN - ALLOCATE(DstInitOutputData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitOutputData%rotors,1), UBOUND(SrcInitOutputData%rotors,1) - CALL AD_Copyrotinitoutputtype( SrcInitOutputData%rotors(i1), DstInitOutputData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD_CopyInitOutput - - SUBROUTINE AD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(AD_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitOutputData%rotors)) THEN -DO i1 = LBOUND(InitOutputData%rotors,1), UBOUND(InitOutputData%rotors,1) - CALL AD_DestroyRotInitOutputType( InitOutputData%rotors(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InitOutputData%rotors) -ENDIF - CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_DestroyInitOutput + ErrMsg = '' + if (allocated(SrcInitOutputData%rotors)) then + LB(1:1) = lbound(SrcInitOutputData%rotors) + UB(1:1) = ubound(SrcInitOutputData%rotors) + if (.not. allocated(DstInitOutputData%rotors)) then + allocate(DstInitOutputData%rotors(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%rotors.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyRotInitOutputType(SrcInitOutputData%rotors(i1), DstInitOutputData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstInitOutputData%rotors)) then + deallocate(DstInitOutputData%rotors) + end if + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine AD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(AD_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%rotors)) then + LB(1:1) = lbound(InitOutputData%rotors) + UB(1:1) = ubound(InitOutputData%rotors) + do i1 = LB(1), UB(1) + call AD_DestroyRotInitOutputType(InitOutputData%rotors(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitOutputData%rotors) + end if +end subroutine subroutine AD_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -2465,7 +2304,6 @@ subroutine AD_PackInitOutput(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! rotors call RegPack(Buf, allocated(InData%rotors)) if (allocated(InData%rotors)) then call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) @@ -2476,7 +2314,6 @@ subroutine AD_PackInitOutput(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! Ver call NWTC_Library_PackProgDesc(Buf, InData%Ver) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2490,7 +2327,6 @@ subroutine AD_UnPackInitOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! rotors if (allocated(OutData%rotors)) deallocate(OutData%rotors) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2506,151 +2342,158 @@ subroutine AD_UnPackInitOutput(Buf, OutData) call AD_UnpackRotInitOutputType(Buf, OutData%rotors(i1)) ! rotors end do end if - ! Ver call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver end subroutine - SUBROUTINE AD_CopyRotInputFile( SrcRotInputFileData, DstRotInputFileData, CtrlCode, ErrStat, ErrMsg ) - TYPE(RotInputFile), INTENT(IN) :: SrcRotInputFileData - TYPE(RotInputFile), INTENT(INOUT) :: DstRotInputFileData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_CopyRotInputFile' -! + +subroutine AD_CopyRotInputFile(SrcRotInputFileData, DstRotInputFileData, CtrlCode, ErrStat, ErrMsg) + type(RotInputFile), intent(in) :: SrcRotInputFileData + type(RotInputFile), intent(inout) :: DstRotInputFileData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyRotInputFile' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcRotInputFileData%BladeProps)) THEN - i1_l = LBOUND(SrcRotInputFileData%BladeProps,1) - i1_u = UBOUND(SrcRotInputFileData%BladeProps,1) - IF (.NOT. ALLOCATED(DstRotInputFileData%BladeProps)) THEN - ALLOCATE(DstRotInputFileData%BladeProps(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%BladeProps.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotInputFileData%BladeProps,1), UBOUND(SrcRotInputFileData%BladeProps,1) - CALL AD_Copybladepropstype( SrcRotInputFileData%BladeProps(i1), DstRotInputFileData%BladeProps(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstRotInputFileData%NumTwrNds = SrcRotInputFileData%NumTwrNds -IF (ALLOCATED(SrcRotInputFileData%TwrElev)) THEN - i1_l = LBOUND(SrcRotInputFileData%TwrElev,1) - i1_u = UBOUND(SrcRotInputFileData%TwrElev,1) - IF (.NOT. ALLOCATED(DstRotInputFileData%TwrElev)) THEN - ALLOCATE(DstRotInputFileData%TwrElev(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%TwrElev.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInputFileData%TwrElev = SrcRotInputFileData%TwrElev -ENDIF -IF (ALLOCATED(SrcRotInputFileData%TwrDiam)) THEN - i1_l = LBOUND(SrcRotInputFileData%TwrDiam,1) - i1_u = UBOUND(SrcRotInputFileData%TwrDiam,1) - IF (.NOT. ALLOCATED(DstRotInputFileData%TwrDiam)) THEN - ALLOCATE(DstRotInputFileData%TwrDiam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%TwrDiam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInputFileData%TwrDiam = SrcRotInputFileData%TwrDiam -ENDIF -IF (ALLOCATED(SrcRotInputFileData%TwrCd)) THEN - i1_l = LBOUND(SrcRotInputFileData%TwrCd,1) - i1_u = UBOUND(SrcRotInputFileData%TwrCd,1) - IF (.NOT. ALLOCATED(DstRotInputFileData%TwrCd)) THEN - ALLOCATE(DstRotInputFileData%TwrCd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%TwrCd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInputFileData%TwrCd = SrcRotInputFileData%TwrCd -ENDIF -IF (ALLOCATED(SrcRotInputFileData%TwrTI)) THEN - i1_l = LBOUND(SrcRotInputFileData%TwrTI,1) - i1_u = UBOUND(SrcRotInputFileData%TwrTI,1) - IF (.NOT. ALLOCATED(DstRotInputFileData%TwrTI)) THEN - ALLOCATE(DstRotInputFileData%TwrTI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%TwrTI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInputFileData%TwrTI = SrcRotInputFileData%TwrTI -ENDIF -IF (ALLOCATED(SrcRotInputFileData%TwrCb)) THEN - i1_l = LBOUND(SrcRotInputFileData%TwrCb,1) - i1_u = UBOUND(SrcRotInputFileData%TwrCb,1) - IF (.NOT. ALLOCATED(DstRotInputFileData%TwrCb)) THEN - ALLOCATE(DstRotInputFileData%TwrCb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%TwrCb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInputFileData%TwrCb = SrcRotInputFileData%TwrCb -ENDIF - DstRotInputFileData%VolHub = SrcRotInputFileData%VolHub - DstRotInputFileData%HubCenBx = SrcRotInputFileData%HubCenBx - DstRotInputFileData%VolNac = SrcRotInputFileData%VolNac - DstRotInputFileData%NacCenB = SrcRotInputFileData%NacCenB - DstRotInputFileData%TFinAero = SrcRotInputFileData%TFinAero - DstRotInputFileData%TFinFile = SrcRotInputFileData%TFinFile - CALL AD_Copytfininputfiletype( SrcRotInputFileData%TFin, DstRotInputFileData%TFin, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD_CopyRotInputFile - - SUBROUTINE AD_DestroyRotInputFile( RotInputFileData, ErrStat, ErrMsg ) - TYPE(RotInputFile), INTENT(INOUT) :: RotInputFileData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyRotInputFile' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(RotInputFileData%BladeProps)) THEN -DO i1 = LBOUND(RotInputFileData%BladeProps,1), UBOUND(RotInputFileData%BladeProps,1) - CALL AD_DestroyBladePropsType( RotInputFileData%BladeProps(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotInputFileData%BladeProps) -ENDIF -IF (ALLOCATED(RotInputFileData%TwrElev)) THEN - DEALLOCATE(RotInputFileData%TwrElev) -ENDIF -IF (ALLOCATED(RotInputFileData%TwrDiam)) THEN - DEALLOCATE(RotInputFileData%TwrDiam) -ENDIF -IF (ALLOCATED(RotInputFileData%TwrCd)) THEN - DEALLOCATE(RotInputFileData%TwrCd) -ENDIF -IF (ALLOCATED(RotInputFileData%TwrTI)) THEN - DEALLOCATE(RotInputFileData%TwrTI) -ENDIF -IF (ALLOCATED(RotInputFileData%TwrCb)) THEN - DEALLOCATE(RotInputFileData%TwrCb) -ENDIF - CALL AD_DestroyTFinInputFileType( RotInputFileData%TFin, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_DestroyRotInputFile + ErrMsg = '' + if (allocated(SrcRotInputFileData%BladeProps)) then + LB(1:1) = lbound(SrcRotInputFileData%BladeProps) + UB(1:1) = ubound(SrcRotInputFileData%BladeProps) + if (.not. allocated(DstRotInputFileData%BladeProps)) then + allocate(DstRotInputFileData%BladeProps(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%BladeProps.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyBladePropsType(SrcRotInputFileData%BladeProps(i1), DstRotInputFileData%BladeProps(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstRotInputFileData%BladeProps)) then + deallocate(DstRotInputFileData%BladeProps) + end if + DstRotInputFileData%NumTwrNds = SrcRotInputFileData%NumTwrNds + if (allocated(SrcRotInputFileData%TwrElev)) then + LB(1:1) = lbound(SrcRotInputFileData%TwrElev) + UB(1:1) = ubound(SrcRotInputFileData%TwrElev) + if (.not. allocated(DstRotInputFileData%TwrElev)) then + allocate(DstRotInputFileData%TwrElev(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%TwrElev.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInputFileData%TwrElev = SrcRotInputFileData%TwrElev + else if (allocated(DstRotInputFileData%TwrElev)) then + deallocate(DstRotInputFileData%TwrElev) + end if + if (allocated(SrcRotInputFileData%TwrDiam)) then + LB(1:1) = lbound(SrcRotInputFileData%TwrDiam) + UB(1:1) = ubound(SrcRotInputFileData%TwrDiam) + if (.not. allocated(DstRotInputFileData%TwrDiam)) then + allocate(DstRotInputFileData%TwrDiam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%TwrDiam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInputFileData%TwrDiam = SrcRotInputFileData%TwrDiam + else if (allocated(DstRotInputFileData%TwrDiam)) then + deallocate(DstRotInputFileData%TwrDiam) + end if + if (allocated(SrcRotInputFileData%TwrCd)) then + LB(1:1) = lbound(SrcRotInputFileData%TwrCd) + UB(1:1) = ubound(SrcRotInputFileData%TwrCd) + if (.not. allocated(DstRotInputFileData%TwrCd)) then + allocate(DstRotInputFileData%TwrCd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%TwrCd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInputFileData%TwrCd = SrcRotInputFileData%TwrCd + else if (allocated(DstRotInputFileData%TwrCd)) then + deallocate(DstRotInputFileData%TwrCd) + end if + if (allocated(SrcRotInputFileData%TwrTI)) then + LB(1:1) = lbound(SrcRotInputFileData%TwrTI) + UB(1:1) = ubound(SrcRotInputFileData%TwrTI) + if (.not. allocated(DstRotInputFileData%TwrTI)) then + allocate(DstRotInputFileData%TwrTI(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%TwrTI.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInputFileData%TwrTI = SrcRotInputFileData%TwrTI + else if (allocated(DstRotInputFileData%TwrTI)) then + deallocate(DstRotInputFileData%TwrTI) + end if + if (allocated(SrcRotInputFileData%TwrCb)) then + LB(1:1) = lbound(SrcRotInputFileData%TwrCb) + UB(1:1) = ubound(SrcRotInputFileData%TwrCb) + if (.not. allocated(DstRotInputFileData%TwrCb)) then + allocate(DstRotInputFileData%TwrCb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputFileData%TwrCb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInputFileData%TwrCb = SrcRotInputFileData%TwrCb + else if (allocated(DstRotInputFileData%TwrCb)) then + deallocate(DstRotInputFileData%TwrCb) + end if + DstRotInputFileData%VolHub = SrcRotInputFileData%VolHub + DstRotInputFileData%HubCenBx = SrcRotInputFileData%HubCenBx + DstRotInputFileData%VolNac = SrcRotInputFileData%VolNac + DstRotInputFileData%NacCenB = SrcRotInputFileData%NacCenB + DstRotInputFileData%TFinAero = SrcRotInputFileData%TFinAero + DstRotInputFileData%TFinFile = SrcRotInputFileData%TFinFile + call AD_CopyTFinInputFileType(SrcRotInputFileData%TFin, DstRotInputFileData%TFin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine AD_DestroyRotInputFile(RotInputFileData, ErrStat, ErrMsg) + type(RotInputFile), intent(inout) :: RotInputFileData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyRotInputFile' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(RotInputFileData%BladeProps)) then + LB(1:1) = lbound(RotInputFileData%BladeProps) + UB(1:1) = ubound(RotInputFileData%BladeProps) + do i1 = LB(1), UB(1) + call AD_DestroyBladePropsType(RotInputFileData%BladeProps(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotInputFileData%BladeProps) + end if + if (allocated(RotInputFileData%TwrElev)) then + deallocate(RotInputFileData%TwrElev) + end if + if (allocated(RotInputFileData%TwrDiam)) then + deallocate(RotInputFileData%TwrDiam) + end if + if (allocated(RotInputFileData%TwrCd)) then + deallocate(RotInputFileData%TwrCd) + end if + if (allocated(RotInputFileData%TwrTI)) then + deallocate(RotInputFileData%TwrTI) + end if + if (allocated(RotInputFileData%TwrCb)) then + deallocate(RotInputFileData%TwrCb) + end if +end subroutine subroutine AD_PackRotInputFile(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -2659,7 +2502,6 @@ subroutine AD_PackRotInputFile(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! BladeProps call RegPack(Buf, allocated(InData%BladeProps)) if (allocated(InData%BladeProps)) then call RegPackBounds(Buf, 1, lbound(InData%BladeProps), ubound(InData%BladeProps)) @@ -2670,63 +2512,50 @@ subroutine AD_PackRotInputFile(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! NumTwrNds call RegPack(Buf, InData%NumTwrNds) if (RegCheckErr(Buf, RoutineName)) return - ! TwrElev call RegPack(Buf, allocated(InData%TwrElev)) if (allocated(InData%TwrElev)) then call RegPackBounds(Buf, 1, lbound(InData%TwrElev), ubound(InData%TwrElev)) call RegPack(Buf, InData%TwrElev) end if if (RegCheckErr(Buf, RoutineName)) return - ! TwrDiam call RegPack(Buf, allocated(InData%TwrDiam)) if (allocated(InData%TwrDiam)) then call RegPackBounds(Buf, 1, lbound(InData%TwrDiam), ubound(InData%TwrDiam)) call RegPack(Buf, InData%TwrDiam) end if if (RegCheckErr(Buf, RoutineName)) return - ! TwrCd call RegPack(Buf, allocated(InData%TwrCd)) if (allocated(InData%TwrCd)) then call RegPackBounds(Buf, 1, lbound(InData%TwrCd), ubound(InData%TwrCd)) call RegPack(Buf, InData%TwrCd) end if if (RegCheckErr(Buf, RoutineName)) return - ! TwrTI call RegPack(Buf, allocated(InData%TwrTI)) if (allocated(InData%TwrTI)) then call RegPackBounds(Buf, 1, lbound(InData%TwrTI), ubound(InData%TwrTI)) call RegPack(Buf, InData%TwrTI) end if if (RegCheckErr(Buf, RoutineName)) return - ! TwrCb call RegPack(Buf, allocated(InData%TwrCb)) if (allocated(InData%TwrCb)) then call RegPackBounds(Buf, 1, lbound(InData%TwrCb), ubound(InData%TwrCb)) call RegPack(Buf, InData%TwrCb) end if if (RegCheckErr(Buf, RoutineName)) return - ! VolHub call RegPack(Buf, InData%VolHub) if (RegCheckErr(Buf, RoutineName)) return - ! HubCenBx call RegPack(Buf, InData%HubCenBx) if (RegCheckErr(Buf, RoutineName)) return - ! VolNac call RegPack(Buf, InData%VolNac) if (RegCheckErr(Buf, RoutineName)) return - ! NacCenB call RegPack(Buf, InData%NacCenB) if (RegCheckErr(Buf, RoutineName)) return - ! TFinAero call RegPack(Buf, InData%TFinAero) if (RegCheckErr(Buf, RoutineName)) return - ! TFinFile call RegPack(Buf, InData%TFinFile) if (RegCheckErr(Buf, RoutineName)) return - ! TFin call AD_PackTFinInputFileType(Buf, InData%TFin) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2740,7 +2569,6 @@ subroutine AD_UnPackRotInputFile(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! BladeProps if (allocated(OutData%BladeProps)) deallocate(OutData%BladeProps) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2756,10 +2584,8 @@ subroutine AD_UnPackRotInputFile(Buf, OutData) call AD_UnpackBladePropsType(Buf, OutData%BladeProps(i1)) ! BladeProps end do end if - ! NumTwrNds call RegUnpack(Buf, OutData%NumTwrNds) if (RegCheckErr(Buf, RoutineName)) return - ! TwrElev if (allocated(OutData%TwrElev)) deallocate(OutData%TwrElev) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2774,7 +2600,6 @@ subroutine AD_UnPackRotInputFile(Buf, OutData) call RegUnpack(Buf, OutData%TwrElev) if (RegCheckErr(Buf, RoutineName)) return end if - ! TwrDiam if (allocated(OutData%TwrDiam)) deallocate(OutData%TwrDiam) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2789,7 +2614,6 @@ subroutine AD_UnPackRotInputFile(Buf, OutData) call RegUnpack(Buf, OutData%TwrDiam) if (RegCheckErr(Buf, RoutineName)) return end if - ! TwrCd if (allocated(OutData%TwrCd)) deallocate(OutData%TwrCd) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2804,7 +2628,6 @@ subroutine AD_UnPackRotInputFile(Buf, OutData) call RegUnpack(Buf, OutData%TwrCd) if (RegCheckErr(Buf, RoutineName)) return end if - ! TwrTI if (allocated(OutData%TwrTI)) deallocate(OutData%TwrTI) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2819,7 +2642,6 @@ subroutine AD_UnPackRotInputFile(Buf, OutData) call RegUnpack(Buf, OutData%TwrTI) if (RegCheckErr(Buf, RoutineName)) return end if - ! TwrCb if (allocated(OutData%TwrCb)) deallocate(OutData%TwrCb) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2834,379 +2656,325 @@ subroutine AD_UnPackRotInputFile(Buf, OutData) call RegUnpack(Buf, OutData%TwrCb) if (RegCheckErr(Buf, RoutineName)) return end if - ! VolHub call RegUnpack(Buf, OutData%VolHub) if (RegCheckErr(Buf, RoutineName)) return - ! HubCenBx call RegUnpack(Buf, OutData%HubCenBx) if (RegCheckErr(Buf, RoutineName)) return - ! VolNac call RegUnpack(Buf, OutData%VolNac) if (RegCheckErr(Buf, RoutineName)) return - ! NacCenB call RegUnpack(Buf, OutData%NacCenB) if (RegCheckErr(Buf, RoutineName)) return - ! TFinAero call RegUnpack(Buf, OutData%TFinAero) if (RegCheckErr(Buf, RoutineName)) return - ! TFinFile call RegUnpack(Buf, OutData%TFinFile) if (RegCheckErr(Buf, RoutineName)) return - ! TFin call AD_UnpackTFinInputFileType(Buf, OutData%TFin) ! TFin end subroutine - SUBROUTINE AD_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD_InputFile), INTENT(IN) :: SrcInputFileData - TYPE(AD_InputFile), INTENT(INOUT) :: DstInputFileData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_CopyInputFile' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInputFileData%Echo = SrcInputFileData%Echo - DstInputFileData%DTAero = SrcInputFileData%DTAero - DstInputFileData%WakeMod = SrcInputFileData%WakeMod - DstInputFileData%AFAeroMod = SrcInputFileData%AFAeroMod - DstInputFileData%TwrPotent = SrcInputFileData%TwrPotent - DstInputFileData%TwrShadow = SrcInputFileData%TwrShadow - DstInputFileData%TwrAero = SrcInputFileData%TwrAero - DstInputFileData%FrozenWake = SrcInputFileData%FrozenWake - DstInputFileData%CavitCheck = SrcInputFileData%CavitCheck - DstInputFileData%Buoyancy = SrcInputFileData%Buoyancy - DstInputFileData%CompAA = SrcInputFileData%CompAA - DstInputFileData%AA_InputFile = SrcInputFileData%AA_InputFile -IF (ALLOCATED(SrcInputFileData%ADBlFile)) THEN - i1_l = LBOUND(SrcInputFileData%ADBlFile,1) - i1_u = UBOUND(SrcInputFileData%ADBlFile,1) - IF (.NOT. ALLOCATED(DstInputFileData%ADBlFile)) THEN - ALLOCATE(DstInputFileData%ADBlFile(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ADBlFile.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%ADBlFile = SrcInputFileData%ADBlFile -ENDIF - DstInputFileData%AirDens = SrcInputFileData%AirDens - DstInputFileData%KinVisc = SrcInputFileData%KinVisc - DstInputFileData%Patm = SrcInputFileData%Patm - DstInputFileData%Pvap = SrcInputFileData%Pvap - DstInputFileData%SpdSound = SrcInputFileData%SpdSound - DstInputFileData%SkewMod = SrcInputFileData%SkewMod - DstInputFileData%SkewModFactor = SrcInputFileData%SkewModFactor - DstInputFileData%TipLoss = SrcInputFileData%TipLoss - DstInputFileData%HubLoss = SrcInputFileData%HubLoss - DstInputFileData%TanInd = SrcInputFileData%TanInd - DstInputFileData%AIDrag = SrcInputFileData%AIDrag - DstInputFileData%TIDrag = SrcInputFileData%TIDrag - DstInputFileData%IndToler = SrcInputFileData%IndToler - DstInputFileData%MaxIter = SrcInputFileData%MaxIter - DstInputFileData%UAMod = SrcInputFileData%UAMod - DstInputFileData%FLookup = SrcInputFileData%FLookup - DstInputFileData%InCol_Alfa = SrcInputFileData%InCol_Alfa - DstInputFileData%InCol_Cl = SrcInputFileData%InCol_Cl - DstInputFileData%InCol_Cd = SrcInputFileData%InCol_Cd - DstInputFileData%InCol_Cm = SrcInputFileData%InCol_Cm - DstInputFileData%InCol_Cpmin = SrcInputFileData%InCol_Cpmin - DstInputFileData%AFTabMod = SrcInputFileData%AFTabMod - DstInputFileData%NumAFfiles = SrcInputFileData%NumAFfiles - DstInputFileData%FVWFileName = SrcInputFileData%FVWFileName -IF (ALLOCATED(SrcInputFileData%AFNames)) THEN - i1_l = LBOUND(SrcInputFileData%AFNames,1) - i1_u = UBOUND(SrcInputFileData%AFNames,1) - IF (.NOT. ALLOCATED(DstInputFileData%AFNames)) THEN - ALLOCATE(DstInputFileData%AFNames(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%AFNames.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%AFNames = SrcInputFileData%AFNames -ENDIF - DstInputFileData%UseBlCm = SrcInputFileData%UseBlCm - DstInputFileData%SumPrint = SrcInputFileData%SumPrint - DstInputFileData%NBlOuts = SrcInputFileData%NBlOuts - DstInputFileData%BlOutNd = SrcInputFileData%BlOutNd - DstInputFileData%NTwOuts = SrcInputFileData%NTwOuts - DstInputFileData%TwOutNd = SrcInputFileData%TwOutNd - DstInputFileData%NumOuts = SrcInputFileData%NumOuts -IF (ALLOCATED(SrcInputFileData%OutList)) THEN - i1_l = LBOUND(SrcInputFileData%OutList,1) - i1_u = UBOUND(SrcInputFileData%OutList,1) - IF (.NOT. ALLOCATED(DstInputFileData%OutList)) THEN - ALLOCATE(DstInputFileData%OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%OutList = SrcInputFileData%OutList -ENDIF - DstInputFileData%tau1_const = SrcInputFileData%tau1_const - DstInputFileData%DBEMT_Mod = SrcInputFileData%DBEMT_Mod - DstInputFileData%BldNd_NumOuts = SrcInputFileData%BldNd_NumOuts -IF (ALLOCATED(SrcInputFileData%BldNd_OutList)) THEN - i1_l = LBOUND(SrcInputFileData%BldNd_OutList,1) - i1_u = UBOUND(SrcInputFileData%BldNd_OutList,1) - IF (.NOT. ALLOCATED(DstInputFileData%BldNd_OutList)) THEN - ALLOCATE(DstInputFileData%BldNd_OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BldNd_OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%BldNd_OutList = SrcInputFileData%BldNd_OutList -ENDIF - DstInputFileData%BldNd_BlOutNd_Str = SrcInputFileData%BldNd_BlOutNd_Str - DstInputFileData%BldNd_BladesOut = SrcInputFileData%BldNd_BladesOut - DstInputFileData%UAStartRad = SrcInputFileData%UAStartRad - DstInputFileData%UAEndRad = SrcInputFileData%UAEndRad -IF (ALLOCATED(SrcInputFileData%rotors)) THEN - i1_l = LBOUND(SrcInputFileData%rotors,1) - i1_u = UBOUND(SrcInputFileData%rotors,1) - IF (.NOT. ALLOCATED(DstInputFileData%rotors)) THEN - ALLOCATE(DstInputFileData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputFileData%rotors,1), UBOUND(SrcInputFileData%rotors,1) - CALL AD_Copyrotinputfile( SrcInputFileData%rotors(i1), DstInputFileData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE AD_CopyInputFile - - SUBROUTINE AD_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) - TYPE(AD_InputFile), INTENT(INOUT) :: InputFileData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyInputFile' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputFileData%ADBlFile)) THEN - DEALLOCATE(InputFileData%ADBlFile) -ENDIF -IF (ALLOCATED(InputFileData%AFNames)) THEN - DEALLOCATE(InputFileData%AFNames) -ENDIF -IF (ALLOCATED(InputFileData%OutList)) THEN - DEALLOCATE(InputFileData%OutList) -ENDIF -IF (ALLOCATED(InputFileData%BldNd_OutList)) THEN - DEALLOCATE(InputFileData%BldNd_OutList) -ENDIF -IF (ALLOCATED(InputFileData%rotors)) THEN -DO i1 = LBOUND(InputFileData%rotors,1), UBOUND(InputFileData%rotors,1) - CALL AD_DestroyRotInputFile( InputFileData%rotors(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InputFileData%rotors) -ENDIF - END SUBROUTINE AD_DestroyInputFile - -subroutine AD_PackInputFile(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf - type(AD_InputFile), intent(in) :: InData - character(*), parameter :: RoutineName = 'AD_PackInputFile' +subroutine AD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) + type(AD_InputFile), intent(in) :: SrcInputFileData + type(AD_InputFile), intent(inout) :: DstInputFileData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - ! Echo - call RegPack(Buf, InData%Echo) - if (RegCheckErr(Buf, RoutineName)) return - ! DTAero - call RegPack(Buf, InData%DTAero) - if (RegCheckErr(Buf, RoutineName)) return - ! WakeMod - call RegPack(Buf, InData%WakeMod) - if (RegCheckErr(Buf, RoutineName)) return - ! AFAeroMod - call RegPack(Buf, InData%AFAeroMod) + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyInputFile' + ErrStat = ErrID_None + ErrMsg = '' + DstInputFileData%Echo = SrcInputFileData%Echo + DstInputFileData%DTAero = SrcInputFileData%DTAero + DstInputFileData%WakeMod = SrcInputFileData%WakeMod + DstInputFileData%AFAeroMod = SrcInputFileData%AFAeroMod + DstInputFileData%TwrPotent = SrcInputFileData%TwrPotent + DstInputFileData%TwrShadow = SrcInputFileData%TwrShadow + DstInputFileData%TwrAero = SrcInputFileData%TwrAero + DstInputFileData%FrozenWake = SrcInputFileData%FrozenWake + DstInputFileData%CavitCheck = SrcInputFileData%CavitCheck + DstInputFileData%Buoyancy = SrcInputFileData%Buoyancy + DstInputFileData%CompAA = SrcInputFileData%CompAA + DstInputFileData%AA_InputFile = SrcInputFileData%AA_InputFile + if (allocated(SrcInputFileData%ADBlFile)) then + LB(1:1) = lbound(SrcInputFileData%ADBlFile) + UB(1:1) = ubound(SrcInputFileData%ADBlFile) + if (.not. allocated(DstInputFileData%ADBlFile)) then + allocate(DstInputFileData%ADBlFile(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ADBlFile.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%ADBlFile = SrcInputFileData%ADBlFile + else if (allocated(DstInputFileData%ADBlFile)) then + deallocate(DstInputFileData%ADBlFile) + end if + DstInputFileData%AirDens = SrcInputFileData%AirDens + DstInputFileData%KinVisc = SrcInputFileData%KinVisc + DstInputFileData%Patm = SrcInputFileData%Patm + DstInputFileData%Pvap = SrcInputFileData%Pvap + DstInputFileData%SpdSound = SrcInputFileData%SpdSound + DstInputFileData%SkewMod = SrcInputFileData%SkewMod + DstInputFileData%SkewModFactor = SrcInputFileData%SkewModFactor + DstInputFileData%TipLoss = SrcInputFileData%TipLoss + DstInputFileData%HubLoss = SrcInputFileData%HubLoss + DstInputFileData%TanInd = SrcInputFileData%TanInd + DstInputFileData%AIDrag = SrcInputFileData%AIDrag + DstInputFileData%TIDrag = SrcInputFileData%TIDrag + DstInputFileData%IndToler = SrcInputFileData%IndToler + DstInputFileData%MaxIter = SrcInputFileData%MaxIter + DstInputFileData%UAMod = SrcInputFileData%UAMod + DstInputFileData%FLookup = SrcInputFileData%FLookup + DstInputFileData%InCol_Alfa = SrcInputFileData%InCol_Alfa + DstInputFileData%InCol_Cl = SrcInputFileData%InCol_Cl + DstInputFileData%InCol_Cd = SrcInputFileData%InCol_Cd + DstInputFileData%InCol_Cm = SrcInputFileData%InCol_Cm + DstInputFileData%InCol_Cpmin = SrcInputFileData%InCol_Cpmin + DstInputFileData%AFTabMod = SrcInputFileData%AFTabMod + DstInputFileData%NumAFfiles = SrcInputFileData%NumAFfiles + DstInputFileData%FVWFileName = SrcInputFileData%FVWFileName + if (allocated(SrcInputFileData%AFNames)) then + LB(1:1) = lbound(SrcInputFileData%AFNames) + UB(1:1) = ubound(SrcInputFileData%AFNames) + if (.not. allocated(DstInputFileData%AFNames)) then + allocate(DstInputFileData%AFNames(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%AFNames.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%AFNames = SrcInputFileData%AFNames + else if (allocated(DstInputFileData%AFNames)) then + deallocate(DstInputFileData%AFNames) + end if + DstInputFileData%UseBlCm = SrcInputFileData%UseBlCm + DstInputFileData%SumPrint = SrcInputFileData%SumPrint + DstInputFileData%NBlOuts = SrcInputFileData%NBlOuts + DstInputFileData%BlOutNd = SrcInputFileData%BlOutNd + DstInputFileData%NTwOuts = SrcInputFileData%NTwOuts + DstInputFileData%TwOutNd = SrcInputFileData%TwOutNd + DstInputFileData%NumOuts = SrcInputFileData%NumOuts + if (allocated(SrcInputFileData%OutList)) then + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) + if (.not. allocated(DstInputFileData%OutList)) then + allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%OutList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%OutList = SrcInputFileData%OutList + else if (allocated(DstInputFileData%OutList)) then + deallocate(DstInputFileData%OutList) + end if + DstInputFileData%tau1_const = SrcInputFileData%tau1_const + DstInputFileData%DBEMT_Mod = SrcInputFileData%DBEMT_Mod + DstInputFileData%BldNd_NumOuts = SrcInputFileData%BldNd_NumOuts + if (allocated(SrcInputFileData%BldNd_OutList)) then + LB(1:1) = lbound(SrcInputFileData%BldNd_OutList) + UB(1:1) = ubound(SrcInputFileData%BldNd_OutList) + if (.not. allocated(DstInputFileData%BldNd_OutList)) then + allocate(DstInputFileData%BldNd_OutList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BldNd_OutList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%BldNd_OutList = SrcInputFileData%BldNd_OutList + else if (allocated(DstInputFileData%BldNd_OutList)) then + deallocate(DstInputFileData%BldNd_OutList) + end if + DstInputFileData%BldNd_BlOutNd_Str = SrcInputFileData%BldNd_BlOutNd_Str + DstInputFileData%BldNd_BladesOut = SrcInputFileData%BldNd_BladesOut + DstInputFileData%UAStartRad = SrcInputFileData%UAStartRad + DstInputFileData%UAEndRad = SrcInputFileData%UAEndRad + if (allocated(SrcInputFileData%rotors)) then + LB(1:1) = lbound(SrcInputFileData%rotors) + UB(1:1) = ubound(SrcInputFileData%rotors) + if (.not. allocated(DstInputFileData%rotors)) then + allocate(DstInputFileData%rotors(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%rotors.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyRotInputFile(SrcInputFileData%rotors(i1), DstInputFileData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstInputFileData%rotors)) then + deallocate(DstInputFileData%rotors) + end if +end subroutine + +subroutine AD_DestroyInputFile(InputFileData, ErrStat, ErrMsg) + type(AD_InputFile), intent(inout) :: InputFileData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyInputFile' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputFileData%ADBlFile)) then + deallocate(InputFileData%ADBlFile) + end if + if (allocated(InputFileData%AFNames)) then + deallocate(InputFileData%AFNames) + end if + if (allocated(InputFileData%OutList)) then + deallocate(InputFileData%OutList) + end if + if (allocated(InputFileData%BldNd_OutList)) then + deallocate(InputFileData%BldNd_OutList) + end if + if (allocated(InputFileData%rotors)) then + LB(1:1) = lbound(InputFileData%rotors) + UB(1:1) = ubound(InputFileData%rotors) + do i1 = LB(1), UB(1) + call AD_DestroyRotInputFile(InputFileData%rotors(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputFileData%rotors) + end if +end subroutine + +subroutine AD_PackInputFile(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(AD_InputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackInputFile' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, InData%Echo) + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, InData%DTAero) + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, InData%WakeMod) + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, InData%AFAeroMod) if (RegCheckErr(Buf, RoutineName)) return - ! TwrPotent call RegPack(Buf, InData%TwrPotent) if (RegCheckErr(Buf, RoutineName)) return - ! TwrShadow call RegPack(Buf, InData%TwrShadow) if (RegCheckErr(Buf, RoutineName)) return - ! TwrAero call RegPack(Buf, InData%TwrAero) if (RegCheckErr(Buf, RoutineName)) return - ! FrozenWake call RegPack(Buf, InData%FrozenWake) if (RegCheckErr(Buf, RoutineName)) return - ! CavitCheck call RegPack(Buf, InData%CavitCheck) if (RegCheckErr(Buf, RoutineName)) return - ! Buoyancy call RegPack(Buf, InData%Buoyancy) if (RegCheckErr(Buf, RoutineName)) return - ! CompAA call RegPack(Buf, InData%CompAA) if (RegCheckErr(Buf, RoutineName)) return - ! AA_InputFile call RegPack(Buf, InData%AA_InputFile) if (RegCheckErr(Buf, RoutineName)) return - ! ADBlFile call RegPack(Buf, allocated(InData%ADBlFile)) if (allocated(InData%ADBlFile)) then call RegPackBounds(Buf, 1, lbound(InData%ADBlFile), ubound(InData%ADBlFile)) call RegPack(Buf, InData%ADBlFile) end if if (RegCheckErr(Buf, RoutineName)) return - ! AirDens call RegPack(Buf, InData%AirDens) if (RegCheckErr(Buf, RoutineName)) return - ! KinVisc call RegPack(Buf, InData%KinVisc) if (RegCheckErr(Buf, RoutineName)) return - ! Patm call RegPack(Buf, InData%Patm) if (RegCheckErr(Buf, RoutineName)) return - ! Pvap call RegPack(Buf, InData%Pvap) if (RegCheckErr(Buf, RoutineName)) return - ! SpdSound call RegPack(Buf, InData%SpdSound) if (RegCheckErr(Buf, RoutineName)) return - ! SkewMod call RegPack(Buf, InData%SkewMod) if (RegCheckErr(Buf, RoutineName)) return - ! SkewModFactor call RegPack(Buf, InData%SkewModFactor) if (RegCheckErr(Buf, RoutineName)) return - ! TipLoss call RegPack(Buf, InData%TipLoss) if (RegCheckErr(Buf, RoutineName)) return - ! HubLoss call RegPack(Buf, InData%HubLoss) if (RegCheckErr(Buf, RoutineName)) return - ! TanInd call RegPack(Buf, InData%TanInd) if (RegCheckErr(Buf, RoutineName)) return - ! AIDrag call RegPack(Buf, InData%AIDrag) if (RegCheckErr(Buf, RoutineName)) return - ! TIDrag call RegPack(Buf, InData%TIDrag) if (RegCheckErr(Buf, RoutineName)) return - ! IndToler call RegPack(Buf, InData%IndToler) if (RegCheckErr(Buf, RoutineName)) return - ! MaxIter call RegPack(Buf, InData%MaxIter) if (RegCheckErr(Buf, RoutineName)) return - ! UAMod call RegPack(Buf, InData%UAMod) if (RegCheckErr(Buf, RoutineName)) return - ! FLookup call RegPack(Buf, InData%FLookup) if (RegCheckErr(Buf, RoutineName)) return - ! InCol_Alfa call RegPack(Buf, InData%InCol_Alfa) if (RegCheckErr(Buf, RoutineName)) return - ! InCol_Cl call RegPack(Buf, InData%InCol_Cl) if (RegCheckErr(Buf, RoutineName)) return - ! InCol_Cd call RegPack(Buf, InData%InCol_Cd) if (RegCheckErr(Buf, RoutineName)) return - ! InCol_Cm call RegPack(Buf, InData%InCol_Cm) if (RegCheckErr(Buf, RoutineName)) return - ! InCol_Cpmin call RegPack(Buf, InData%InCol_Cpmin) if (RegCheckErr(Buf, RoutineName)) return - ! AFTabMod call RegPack(Buf, InData%AFTabMod) if (RegCheckErr(Buf, RoutineName)) return - ! NumAFfiles call RegPack(Buf, InData%NumAFfiles) if (RegCheckErr(Buf, RoutineName)) return - ! FVWFileName call RegPack(Buf, InData%FVWFileName) if (RegCheckErr(Buf, RoutineName)) return - ! AFNames call RegPack(Buf, allocated(InData%AFNames)) if (allocated(InData%AFNames)) then call RegPackBounds(Buf, 1, lbound(InData%AFNames), ubound(InData%AFNames)) call RegPack(Buf, InData%AFNames) end if if (RegCheckErr(Buf, RoutineName)) return - ! UseBlCm call RegPack(Buf, InData%UseBlCm) if (RegCheckErr(Buf, RoutineName)) return - ! SumPrint call RegPack(Buf, InData%SumPrint) if (RegCheckErr(Buf, RoutineName)) return - ! NBlOuts call RegPack(Buf, InData%NBlOuts) if (RegCheckErr(Buf, RoutineName)) return - ! BlOutNd call RegPack(Buf, InData%BlOutNd) if (RegCheckErr(Buf, RoutineName)) return - ! NTwOuts call RegPack(Buf, InData%NTwOuts) if (RegCheckErr(Buf, RoutineName)) return - ! TwOutNd call RegPack(Buf, InData%TwOutNd) if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegPack(Buf, InData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! OutList call RegPack(Buf, allocated(InData%OutList)) if (allocated(InData%OutList)) then call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) call RegPack(Buf, InData%OutList) end if if (RegCheckErr(Buf, RoutineName)) return - ! tau1_const call RegPack(Buf, InData%tau1_const) if (RegCheckErr(Buf, RoutineName)) return - ! DBEMT_Mod call RegPack(Buf, InData%DBEMT_Mod) if (RegCheckErr(Buf, RoutineName)) return - ! BldNd_NumOuts call RegPack(Buf, InData%BldNd_NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! BldNd_OutList call RegPack(Buf, allocated(InData%BldNd_OutList)) if (allocated(InData%BldNd_OutList)) then call RegPackBounds(Buf, 1, lbound(InData%BldNd_OutList), ubound(InData%BldNd_OutList)) call RegPack(Buf, InData%BldNd_OutList) end if if (RegCheckErr(Buf, RoutineName)) return - ! BldNd_BlOutNd_Str call RegPack(Buf, InData%BldNd_BlOutNd_Str) if (RegCheckErr(Buf, RoutineName)) return - ! BldNd_BladesOut call RegPack(Buf, InData%BldNd_BladesOut) if (RegCheckErr(Buf, RoutineName)) return - ! UAStartRad call RegPack(Buf, InData%UAStartRad) if (RegCheckErr(Buf, RoutineName)) return - ! UAEndRad call RegPack(Buf, InData%UAEndRad) if (RegCheckErr(Buf, RoutineName)) return - ! rotors call RegPack(Buf, allocated(InData%rotors)) if (allocated(InData%rotors)) then call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) @@ -3228,43 +2996,30 @@ subroutine AD_UnPackInputFile(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! Echo call RegUnpack(Buf, OutData%Echo) if (RegCheckErr(Buf, RoutineName)) return - ! DTAero call RegUnpack(Buf, OutData%DTAero) if (RegCheckErr(Buf, RoutineName)) return - ! WakeMod call RegUnpack(Buf, OutData%WakeMod) if (RegCheckErr(Buf, RoutineName)) return - ! AFAeroMod call RegUnpack(Buf, OutData%AFAeroMod) if (RegCheckErr(Buf, RoutineName)) return - ! TwrPotent call RegUnpack(Buf, OutData%TwrPotent) if (RegCheckErr(Buf, RoutineName)) return - ! TwrShadow call RegUnpack(Buf, OutData%TwrShadow) if (RegCheckErr(Buf, RoutineName)) return - ! TwrAero call RegUnpack(Buf, OutData%TwrAero) if (RegCheckErr(Buf, RoutineName)) return - ! FrozenWake call RegUnpack(Buf, OutData%FrozenWake) if (RegCheckErr(Buf, RoutineName)) return - ! CavitCheck call RegUnpack(Buf, OutData%CavitCheck) if (RegCheckErr(Buf, RoutineName)) return - ! Buoyancy call RegUnpack(Buf, OutData%Buoyancy) if (RegCheckErr(Buf, RoutineName)) return - ! CompAA call RegUnpack(Buf, OutData%CompAA) if (RegCheckErr(Buf, RoutineName)) return - ! AA_InputFile call RegUnpack(Buf, OutData%AA_InputFile) if (RegCheckErr(Buf, RoutineName)) return - ! ADBlFile if (allocated(OutData%ADBlFile)) deallocate(OutData%ADBlFile) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3279,79 +3034,54 @@ subroutine AD_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%ADBlFile) if (RegCheckErr(Buf, RoutineName)) return end if - ! AirDens call RegUnpack(Buf, OutData%AirDens) if (RegCheckErr(Buf, RoutineName)) return - ! KinVisc call RegUnpack(Buf, OutData%KinVisc) if (RegCheckErr(Buf, RoutineName)) return - ! Patm call RegUnpack(Buf, OutData%Patm) if (RegCheckErr(Buf, RoutineName)) return - ! Pvap call RegUnpack(Buf, OutData%Pvap) if (RegCheckErr(Buf, RoutineName)) return - ! SpdSound call RegUnpack(Buf, OutData%SpdSound) if (RegCheckErr(Buf, RoutineName)) return - ! SkewMod call RegUnpack(Buf, OutData%SkewMod) if (RegCheckErr(Buf, RoutineName)) return - ! SkewModFactor call RegUnpack(Buf, OutData%SkewModFactor) if (RegCheckErr(Buf, RoutineName)) return - ! TipLoss call RegUnpack(Buf, OutData%TipLoss) if (RegCheckErr(Buf, RoutineName)) return - ! HubLoss call RegUnpack(Buf, OutData%HubLoss) if (RegCheckErr(Buf, RoutineName)) return - ! TanInd call RegUnpack(Buf, OutData%TanInd) if (RegCheckErr(Buf, RoutineName)) return - ! AIDrag call RegUnpack(Buf, OutData%AIDrag) if (RegCheckErr(Buf, RoutineName)) return - ! TIDrag call RegUnpack(Buf, OutData%TIDrag) if (RegCheckErr(Buf, RoutineName)) return - ! IndToler call RegUnpack(Buf, OutData%IndToler) if (RegCheckErr(Buf, RoutineName)) return - ! MaxIter call RegUnpack(Buf, OutData%MaxIter) if (RegCheckErr(Buf, RoutineName)) return - ! UAMod call RegUnpack(Buf, OutData%UAMod) if (RegCheckErr(Buf, RoutineName)) return - ! FLookup call RegUnpack(Buf, OutData%FLookup) if (RegCheckErr(Buf, RoutineName)) return - ! InCol_Alfa call RegUnpack(Buf, OutData%InCol_Alfa) if (RegCheckErr(Buf, RoutineName)) return - ! InCol_Cl call RegUnpack(Buf, OutData%InCol_Cl) if (RegCheckErr(Buf, RoutineName)) return - ! InCol_Cd call RegUnpack(Buf, OutData%InCol_Cd) if (RegCheckErr(Buf, RoutineName)) return - ! InCol_Cm call RegUnpack(Buf, OutData%InCol_Cm) if (RegCheckErr(Buf, RoutineName)) return - ! InCol_Cpmin call RegUnpack(Buf, OutData%InCol_Cpmin) if (RegCheckErr(Buf, RoutineName)) return - ! AFTabMod call RegUnpack(Buf, OutData%AFTabMod) if (RegCheckErr(Buf, RoutineName)) return - ! NumAFfiles call RegUnpack(Buf, OutData%NumAFfiles) if (RegCheckErr(Buf, RoutineName)) return - ! FVWFileName call RegUnpack(Buf, OutData%FVWFileName) if (RegCheckErr(Buf, RoutineName)) return - ! AFNames if (allocated(OutData%AFNames)) deallocate(OutData%AFNames) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3366,28 +3096,20 @@ subroutine AD_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%AFNames) if (RegCheckErr(Buf, RoutineName)) return end if - ! UseBlCm call RegUnpack(Buf, OutData%UseBlCm) if (RegCheckErr(Buf, RoutineName)) return - ! SumPrint call RegUnpack(Buf, OutData%SumPrint) if (RegCheckErr(Buf, RoutineName)) return - ! NBlOuts call RegUnpack(Buf, OutData%NBlOuts) if (RegCheckErr(Buf, RoutineName)) return - ! BlOutNd call RegUnpack(Buf, OutData%BlOutNd) if (RegCheckErr(Buf, RoutineName)) return - ! NTwOuts call RegUnpack(Buf, OutData%NTwOuts) if (RegCheckErr(Buf, RoutineName)) return - ! TwOutNd call RegUnpack(Buf, OutData%TwOutNd) if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegUnpack(Buf, OutData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! OutList if (allocated(OutData%OutList)) deallocate(OutData%OutList) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3402,16 +3124,12 @@ subroutine AD_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%OutList) if (RegCheckErr(Buf, RoutineName)) return end if - ! tau1_const call RegUnpack(Buf, OutData%tau1_const) if (RegCheckErr(Buf, RoutineName)) return - ! DBEMT_Mod call RegUnpack(Buf, OutData%DBEMT_Mod) if (RegCheckErr(Buf, RoutineName)) return - ! BldNd_NumOuts call RegUnpack(Buf, OutData%BldNd_NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! BldNd_OutList if (allocated(OutData%BldNd_OutList)) deallocate(OutData%BldNd_OutList) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3426,19 +3144,14 @@ subroutine AD_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%BldNd_OutList) if (RegCheckErr(Buf, RoutineName)) return end if - ! BldNd_BlOutNd_Str call RegUnpack(Buf, OutData%BldNd_BlOutNd_Str) if (RegCheckErr(Buf, RoutineName)) return - ! BldNd_BladesOut call RegUnpack(Buf, OutData%BldNd_BladesOut) if (RegCheckErr(Buf, RoutineName)) return - ! UAStartRad call RegUnpack(Buf, OutData%UAStartRad) if (RegCheckErr(Buf, RoutineName)) return - ! UAEndRad call RegUnpack(Buf, OutData%UAEndRad) if (RegCheckErr(Buf, RoutineName)) return - ! rotors if (allocated(OutData%rotors)) deallocate(OutData%rotors) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3455,57 +3168,44 @@ subroutine AD_UnPackInputFile(Buf, OutData) end do end if end subroutine - SUBROUTINE AD_CopyRotContinuousStateType( SrcRotContinuousStateTypeData, DstRotContinuousStateTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(RotContinuousStateType), INTENT(IN) :: SrcRotContinuousStateTypeData - TYPE(RotContinuousStateType), INTENT(INOUT) :: DstRotContinuousStateTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_CopyRotContinuousStateType' -! + +subroutine AD_CopyRotContinuousStateType(SrcRotContinuousStateTypeData, DstRotContinuousStateTypeData, CtrlCode, ErrStat, ErrMsg) + type(RotContinuousStateType), intent(in) :: SrcRotContinuousStateTypeData + type(RotContinuousStateType), intent(inout) :: DstRotContinuousStateTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyRotContinuousStateType' ErrStat = ErrID_None - ErrMsg = "" - CALL BEMT_CopyContState( SrcRotContinuousStateTypeData%BEMT, DstRotContinuousStateTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AA_CopyContState( SrcRotContinuousStateTypeData%AA, DstRotContinuousStateTypeData%AA, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD_CopyRotContinuousStateType - - SUBROUTINE AD_DestroyRotContinuousStateType( RotContinuousStateTypeData, ErrStat, ErrMsg ) - TYPE(RotContinuousStateType), INTENT(INOUT) :: RotContinuousStateTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyRotContinuousStateType' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL BEMT_DestroyContState( RotContinuousStateTypeData%BEMT, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AA_DestroyContState( RotContinuousStateTypeData%AA, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_DestroyRotContinuousStateType + ErrMsg = '' + call BEMT_CopyContState(SrcRotContinuousStateTypeData%BEMT, DstRotContinuousStateTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AA_CopyContState(SrcRotContinuousStateTypeData%AA, DstRotContinuousStateTypeData%AA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine AD_DestroyRotContinuousStateType(RotContinuousStateTypeData, ErrStat, ErrMsg) + type(RotContinuousStateType), intent(inout) :: RotContinuousStateTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyRotContinuousStateType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine AD_PackRotContinuousStateType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(RotContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackRotContinuousStateType' if (Buf%ErrStat >= AbortErrLev) return - ! BEMT call BEMT_PackContState(Buf, InData%BEMT) if (RegCheckErr(Buf, RoutineName)) return - ! AA call AA_PackContState(Buf, InData%AA) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3515,71 +3215,67 @@ subroutine AD_UnPackRotContinuousStateType(Buf, OutData) type(RotContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackRotContinuousStateType' if (Buf%ErrStat /= ErrID_None) return - ! BEMT call BEMT_UnpackContState(Buf, OutData%BEMT) ! BEMT - ! AA call AA_UnpackContState(Buf, OutData%AA) ! AA end subroutine - SUBROUTINE AD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(AD_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_CopyContState' -! + +subroutine AD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(AD_ContinuousStateType), intent(in) :: SrcContStateData + type(AD_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyContState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcContStateData%rotors)) THEN - i1_l = LBOUND(SrcContStateData%rotors,1) - i1_u = UBOUND(SrcContStateData%rotors,1) - IF (.NOT. ALLOCATED(DstContStateData%rotors)) THEN - ALLOCATE(DstContStateData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcContStateData%rotors,1), UBOUND(SrcContStateData%rotors,1) - CALL AD_Copyrotcontinuousstatetype( SrcContStateData%rotors(i1), DstContStateData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL FVW_CopyContState( SrcContStateData%FVW, DstContStateData%FVW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD_CopyContState - - SUBROUTINE AD_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(AD_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ContStateData%rotors)) THEN -DO i1 = LBOUND(ContStateData%rotors,1), UBOUND(ContStateData%rotors,1) - CALL AD_DestroyRotContinuousStateType( ContStateData%rotors(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ContStateData%rotors) -ENDIF - CALL FVW_DestroyContState( ContStateData%FVW, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_DestroyContState + ErrMsg = '' + if (allocated(SrcContStateData%rotors)) then + LB(1:1) = lbound(SrcContStateData%rotors) + UB(1:1) = ubound(SrcContStateData%rotors) + if (.not. allocated(DstContStateData%rotors)) then + allocate(DstContStateData%rotors(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%rotors.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyRotContinuousStateType(SrcContStateData%rotors(i1), DstContStateData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstContStateData%rotors)) then + deallocate(DstContStateData%rotors) + end if + call FVW_CopyContState(SrcContStateData%FVW, DstContStateData%FVW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine AD_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(AD_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ContStateData%rotors)) then + LB(1:1) = lbound(ContStateData%rotors) + UB(1:1) = ubound(ContStateData%rotors) + do i1 = LB(1), UB(1) + call AD_DestroyRotContinuousStateType(ContStateData%rotors(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ContStateData%rotors) + end if +end subroutine subroutine AD_PackContState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -3588,7 +3284,6 @@ subroutine AD_PackContState(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! rotors call RegPack(Buf, allocated(InData%rotors)) if (allocated(InData%rotors)) then call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) @@ -3599,7 +3294,6 @@ subroutine AD_PackContState(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! FVW call FVW_PackContState(Buf, InData%FVW) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3613,7 +3307,6 @@ subroutine AD_UnPackContState(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! rotors if (allocated(OutData%rotors)) deallocate(OutData%rotors) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3629,60 +3322,46 @@ subroutine AD_UnPackContState(Buf, OutData) call AD_UnpackRotContinuousStateType(Buf, OutData%rotors(i1)) ! rotors end do end if - ! FVW call FVW_UnpackContState(Buf, OutData%FVW) ! FVW end subroutine - SUBROUTINE AD_CopyRotDiscreteStateType( SrcRotDiscreteStateTypeData, DstRotDiscreteStateTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(RotDiscreteStateType), INTENT(IN) :: SrcRotDiscreteStateTypeData - TYPE(RotDiscreteStateType), INTENT(INOUT) :: DstRotDiscreteStateTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_CopyRotDiscreteStateType' -! + +subroutine AD_CopyRotDiscreteStateType(SrcRotDiscreteStateTypeData, DstRotDiscreteStateTypeData, CtrlCode, ErrStat, ErrMsg) + type(RotDiscreteStateType), intent(in) :: SrcRotDiscreteStateTypeData + type(RotDiscreteStateType), intent(inout) :: DstRotDiscreteStateTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyRotDiscreteStateType' ErrStat = ErrID_None - ErrMsg = "" - CALL BEMT_CopyDiscState( SrcRotDiscreteStateTypeData%BEMT, DstRotDiscreteStateTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AA_CopyDiscState( SrcRotDiscreteStateTypeData%AA, DstRotDiscreteStateTypeData%AA, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD_CopyRotDiscreteStateType - - SUBROUTINE AD_DestroyRotDiscreteStateType( RotDiscreteStateTypeData, ErrStat, ErrMsg ) - TYPE(RotDiscreteStateType), INTENT(INOUT) :: RotDiscreteStateTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyRotDiscreteStateType' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL BEMT_DestroyDiscState( RotDiscreteStateTypeData%BEMT, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AA_DestroyDiscState( RotDiscreteStateTypeData%AA, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_DestroyRotDiscreteStateType + ErrMsg = '' + call BEMT_CopyDiscState(SrcRotDiscreteStateTypeData%BEMT, DstRotDiscreteStateTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AA_CopyDiscState(SrcRotDiscreteStateTypeData%AA, DstRotDiscreteStateTypeData%AA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine AD_DestroyRotDiscreteStateType(RotDiscreteStateTypeData, ErrStat, ErrMsg) + type(RotDiscreteStateType), intent(inout) :: RotDiscreteStateTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyRotDiscreteStateType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine AD_PackRotDiscreteStateType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(RotDiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackRotDiscreteStateType' if (Buf%ErrStat >= AbortErrLev) return - ! BEMT call BEMT_PackDiscState(Buf, InData%BEMT) if (RegCheckErr(Buf, RoutineName)) return - ! AA call AA_PackDiscState(Buf, InData%AA) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3692,71 +3371,67 @@ subroutine AD_UnPackRotDiscreteStateType(Buf, OutData) type(RotDiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackRotDiscreteStateType' if (Buf%ErrStat /= ErrID_None) return - ! BEMT call BEMT_UnpackDiscState(Buf, OutData%BEMT) ! BEMT - ! AA call AA_UnpackDiscState(Buf, OutData%AA) ! AA end subroutine - SUBROUTINE AD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(AD_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_CopyDiscState' -! + +subroutine AD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(AD_DiscreteStateType), intent(in) :: SrcDiscStateData + type(AD_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyDiscState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcDiscStateData%rotors)) THEN - i1_l = LBOUND(SrcDiscStateData%rotors,1) - i1_u = UBOUND(SrcDiscStateData%rotors,1) - IF (.NOT. ALLOCATED(DstDiscStateData%rotors)) THEN - ALLOCATE(DstDiscStateData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDiscStateData%rotors,1), UBOUND(SrcDiscStateData%rotors,1) - CALL AD_Copyrotdiscretestatetype( SrcDiscStateData%rotors(i1), DstDiscStateData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL FVW_CopyDiscState( SrcDiscStateData%FVW, DstDiscStateData%FVW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD_CopyDiscState - - SUBROUTINE AD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(AD_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(DiscStateData%rotors)) THEN -DO i1 = LBOUND(DiscStateData%rotors,1), UBOUND(DiscStateData%rotors,1) - CALL AD_DestroyRotDiscreteStateType( DiscStateData%rotors(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(DiscStateData%rotors) -ENDIF - CALL FVW_DestroyDiscState( DiscStateData%FVW, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_DestroyDiscState + ErrMsg = '' + if (allocated(SrcDiscStateData%rotors)) then + LB(1:1) = lbound(SrcDiscStateData%rotors) + UB(1:1) = ubound(SrcDiscStateData%rotors) + if (.not. allocated(DstDiscStateData%rotors)) then + allocate(DstDiscStateData%rotors(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%rotors.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyRotDiscreteStateType(SrcDiscStateData%rotors(i1), DstDiscStateData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstDiscStateData%rotors)) then + deallocate(DstDiscStateData%rotors) + end if + call FVW_CopyDiscState(SrcDiscStateData%FVW, DstDiscStateData%FVW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine AD_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(AD_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(DiscStateData%rotors)) then + LB(1:1) = lbound(DiscStateData%rotors) + UB(1:1) = ubound(DiscStateData%rotors) + do i1 = LB(1), UB(1) + call AD_DestroyRotDiscreteStateType(DiscStateData%rotors(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(DiscStateData%rotors) + end if +end subroutine subroutine AD_PackDiscState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -3765,7 +3440,6 @@ subroutine AD_PackDiscState(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! rotors call RegPack(Buf, allocated(InData%rotors)) if (allocated(InData%rotors)) then call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) @@ -3776,7 +3450,6 @@ subroutine AD_PackDiscState(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! FVW call FVW_PackDiscState(Buf, InData%FVW) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3790,7 +3463,6 @@ subroutine AD_UnPackDiscState(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! rotors if (allocated(OutData%rotors)) deallocate(OutData%rotors) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3806,60 +3478,46 @@ subroutine AD_UnPackDiscState(Buf, OutData) call AD_UnpackRotDiscreteStateType(Buf, OutData%rotors(i1)) ! rotors end do end if - ! FVW call FVW_UnpackDiscState(Buf, OutData%FVW) ! FVW end subroutine - SUBROUTINE AD_CopyRotConstraintStateType( SrcRotConstraintStateTypeData, DstRotConstraintStateTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(RotConstraintStateType), INTENT(IN) :: SrcRotConstraintStateTypeData - TYPE(RotConstraintStateType), INTENT(INOUT) :: DstRotConstraintStateTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_CopyRotConstraintStateType' -! + +subroutine AD_CopyRotConstraintStateType(SrcRotConstraintStateTypeData, DstRotConstraintStateTypeData, CtrlCode, ErrStat, ErrMsg) + type(RotConstraintStateType), intent(in) :: SrcRotConstraintStateTypeData + type(RotConstraintStateType), intent(inout) :: DstRotConstraintStateTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyRotConstraintStateType' ErrStat = ErrID_None - ErrMsg = "" - CALL BEMT_CopyConstrState( SrcRotConstraintStateTypeData%BEMT, DstRotConstraintStateTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AA_CopyConstrState( SrcRotConstraintStateTypeData%AA, DstRotConstraintStateTypeData%AA, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD_CopyRotConstraintStateType - - SUBROUTINE AD_DestroyRotConstraintStateType( RotConstraintStateTypeData, ErrStat, ErrMsg ) - TYPE(RotConstraintStateType), INTENT(INOUT) :: RotConstraintStateTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyRotConstraintStateType' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL BEMT_DestroyConstrState( RotConstraintStateTypeData%BEMT, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AA_DestroyConstrState( RotConstraintStateTypeData%AA, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_DestroyRotConstraintStateType + ErrMsg = '' + call BEMT_CopyConstrState(SrcRotConstraintStateTypeData%BEMT, DstRotConstraintStateTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AA_CopyConstrState(SrcRotConstraintStateTypeData%AA, DstRotConstraintStateTypeData%AA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine AD_DestroyRotConstraintStateType(RotConstraintStateTypeData, ErrStat, ErrMsg) + type(RotConstraintStateType), intent(inout) :: RotConstraintStateTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyRotConstraintStateType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine AD_PackRotConstraintStateType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(RotConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackRotConstraintStateType' if (Buf%ErrStat >= AbortErrLev) return - ! BEMT call BEMT_PackConstrState(Buf, InData%BEMT) if (RegCheckErr(Buf, RoutineName)) return - ! AA call AA_PackConstrState(Buf, InData%AA) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3869,71 +3527,67 @@ subroutine AD_UnPackRotConstraintStateType(Buf, OutData) type(RotConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackRotConstraintStateType' if (Buf%ErrStat /= ErrID_None) return - ! BEMT call BEMT_UnpackConstrState(Buf, OutData%BEMT) ! BEMT - ! AA call AA_UnpackConstrState(Buf, OutData%AA) ! AA end subroutine - SUBROUTINE AD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(AD_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_CopyConstrState' -! + +subroutine AD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(AD_ConstraintStateType), intent(in) :: SrcConstrStateData + type(AD_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyConstrState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcConstrStateData%rotors)) THEN - i1_l = LBOUND(SrcConstrStateData%rotors,1) - i1_u = UBOUND(SrcConstrStateData%rotors,1) - IF (.NOT. ALLOCATED(DstConstrStateData%rotors)) THEN - ALLOCATE(DstConstrStateData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcConstrStateData%rotors,1), UBOUND(SrcConstrStateData%rotors,1) - CALL AD_Copyrotconstraintstatetype( SrcConstrStateData%rotors(i1), DstConstrStateData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL FVW_CopyConstrState( SrcConstrStateData%FVW, DstConstrStateData%FVW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD_CopyConstrState - - SUBROUTINE AD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(AD_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ConstrStateData%rotors)) THEN -DO i1 = LBOUND(ConstrStateData%rotors,1), UBOUND(ConstrStateData%rotors,1) - CALL AD_DestroyRotConstraintStateType( ConstrStateData%rotors(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ConstrStateData%rotors) -ENDIF - CALL FVW_DestroyConstrState( ConstrStateData%FVW, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_DestroyConstrState + ErrMsg = '' + if (allocated(SrcConstrStateData%rotors)) then + LB(1:1) = lbound(SrcConstrStateData%rotors) + UB(1:1) = ubound(SrcConstrStateData%rotors) + if (.not. allocated(DstConstrStateData%rotors)) then + allocate(DstConstrStateData%rotors(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%rotors.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyRotConstraintStateType(SrcConstrStateData%rotors(i1), DstConstrStateData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstConstrStateData%rotors)) then + deallocate(DstConstrStateData%rotors) + end if + call FVW_CopyConstrState(SrcConstrStateData%FVW, DstConstrStateData%FVW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine AD_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(AD_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ConstrStateData%rotors)) then + LB(1:1) = lbound(ConstrStateData%rotors) + UB(1:1) = ubound(ConstrStateData%rotors) + do i1 = LB(1), UB(1) + call AD_DestroyRotConstraintStateType(ConstrStateData%rotors(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ConstrStateData%rotors) + end if +end subroutine subroutine AD_PackConstrState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -3942,7 +3596,6 @@ subroutine AD_PackConstrState(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! rotors call RegPack(Buf, allocated(InData%rotors)) if (allocated(InData%rotors)) then call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) @@ -3953,7 +3606,6 @@ subroutine AD_PackConstrState(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! FVW call FVW_PackConstrState(Buf, InData%FVW) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3967,7 +3619,6 @@ subroutine AD_UnPackConstrState(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! rotors if (allocated(OutData%rotors)) deallocate(OutData%rotors) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3983,60 +3634,46 @@ subroutine AD_UnPackConstrState(Buf, OutData) call AD_UnpackRotConstraintStateType(Buf, OutData%rotors(i1)) ! rotors end do end if - ! FVW call FVW_UnpackConstrState(Buf, OutData%FVW) ! FVW end subroutine - SUBROUTINE AD_CopyRotOtherStateType( SrcRotOtherStateTypeData, DstRotOtherStateTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(RotOtherStateType), INTENT(IN) :: SrcRotOtherStateTypeData - TYPE(RotOtherStateType), INTENT(INOUT) :: DstRotOtherStateTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_CopyRotOtherStateType' -! + +subroutine AD_CopyRotOtherStateType(SrcRotOtherStateTypeData, DstRotOtherStateTypeData, CtrlCode, ErrStat, ErrMsg) + type(RotOtherStateType), intent(in) :: SrcRotOtherStateTypeData + type(RotOtherStateType), intent(inout) :: DstRotOtherStateTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyRotOtherStateType' ErrStat = ErrID_None - ErrMsg = "" - CALL BEMT_CopyOtherState( SrcRotOtherStateTypeData%BEMT, DstRotOtherStateTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AA_CopyOtherState( SrcRotOtherStateTypeData%AA, DstRotOtherStateTypeData%AA, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD_CopyRotOtherStateType - - SUBROUTINE AD_DestroyRotOtherStateType( RotOtherStateTypeData, ErrStat, ErrMsg ) - TYPE(RotOtherStateType), INTENT(INOUT) :: RotOtherStateTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyRotOtherStateType' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL BEMT_DestroyOtherState( RotOtherStateTypeData%BEMT, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AA_DestroyOtherState( RotOtherStateTypeData%AA, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_DestroyRotOtherStateType + ErrMsg = '' + call BEMT_CopyOtherState(SrcRotOtherStateTypeData%BEMT, DstRotOtherStateTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AA_CopyOtherState(SrcRotOtherStateTypeData%AA, DstRotOtherStateTypeData%AA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine AD_DestroyRotOtherStateType(RotOtherStateTypeData, ErrStat, ErrMsg) + type(RotOtherStateType), intent(inout) :: RotOtherStateTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyRotOtherStateType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine AD_PackRotOtherStateType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(RotOtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackRotOtherStateType' if (Buf%ErrStat >= AbortErrLev) return - ! BEMT call BEMT_PackOtherState(Buf, InData%BEMT) if (RegCheckErr(Buf, RoutineName)) return - ! AA call AA_PackOtherState(Buf, InData%AA) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -4046,89 +3683,84 @@ subroutine AD_UnPackRotOtherStateType(Buf, OutData) type(RotOtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackRotOtherStateType' if (Buf%ErrStat /= ErrID_None) return - ! BEMT call BEMT_UnpackOtherState(Buf, OutData%BEMT) ! BEMT - ! AA call AA_UnpackOtherState(Buf, OutData%AA) ! AA end subroutine - SUBROUTINE AD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(AD_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_CopyOtherState' -! + +subroutine AD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(AD_OtherStateType), intent(in) :: SrcOtherStateData + type(AD_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyOtherState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOtherStateData%rotors)) THEN - i1_l = LBOUND(SrcOtherStateData%rotors,1) - i1_u = UBOUND(SrcOtherStateData%rotors,1) - IF (.NOT. ALLOCATED(DstOtherStateData%rotors)) THEN - ALLOCATE(DstOtherStateData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOtherStateData%rotors,1), UBOUND(SrcOtherStateData%rotors,1) - CALL AD_Copyrototherstatetype( SrcOtherStateData%rotors(i1), DstOtherStateData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL FVW_CopyOtherState( SrcOtherStateData%FVW, DstOtherStateData%FVW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcOtherStateData%WakeLocationPoints)) THEN - i1_l = LBOUND(SrcOtherStateData%WakeLocationPoints,1) - i1_u = UBOUND(SrcOtherStateData%WakeLocationPoints,1) - i2_l = LBOUND(SrcOtherStateData%WakeLocationPoints,2) - i2_u = UBOUND(SrcOtherStateData%WakeLocationPoints,2) - IF (.NOT. ALLOCATED(DstOtherStateData%WakeLocationPoints)) THEN - ALLOCATE(DstOtherStateData%WakeLocationPoints(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%WakeLocationPoints.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%WakeLocationPoints = SrcOtherStateData%WakeLocationPoints -ENDIF - END SUBROUTINE AD_CopyOtherState - - SUBROUTINE AD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(AD_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OtherStateData%rotors)) THEN -DO i1 = LBOUND(OtherStateData%rotors,1), UBOUND(OtherStateData%rotors,1) - CALL AD_DestroyRotOtherStateType( OtherStateData%rotors(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OtherStateData%rotors) -ENDIF - CALL FVW_DestroyOtherState( OtherStateData%FVW, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(OtherStateData%WakeLocationPoints)) THEN - DEALLOCATE(OtherStateData%WakeLocationPoints) -ENDIF - END SUBROUTINE AD_DestroyOtherState + ErrMsg = '' + if (allocated(SrcOtherStateData%rotors)) then + LB(1:1) = lbound(SrcOtherStateData%rotors) + UB(1:1) = ubound(SrcOtherStateData%rotors) + if (.not. allocated(DstOtherStateData%rotors)) then + allocate(DstOtherStateData%rotors(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%rotors.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyRotOtherStateType(SrcOtherStateData%rotors(i1), DstOtherStateData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstOtherStateData%rotors)) then + deallocate(DstOtherStateData%rotors) + end if + call FVW_CopyOtherState(SrcOtherStateData%FVW, DstOtherStateData%FVW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcOtherStateData%WakeLocationPoints)) then + LB(1:2) = lbound(SrcOtherStateData%WakeLocationPoints) + UB(1:2) = ubound(SrcOtherStateData%WakeLocationPoints) + if (.not. allocated(DstOtherStateData%WakeLocationPoints)) then + allocate(DstOtherStateData%WakeLocationPoints(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%WakeLocationPoints.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%WakeLocationPoints = SrcOtherStateData%WakeLocationPoints + else if (allocated(DstOtherStateData%WakeLocationPoints)) then + deallocate(DstOtherStateData%WakeLocationPoints) + end if +end subroutine +subroutine AD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(AD_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OtherStateData%rotors)) then + LB(1:1) = lbound(OtherStateData%rotors) + UB(1:1) = ubound(OtherStateData%rotors) + do i1 = LB(1), UB(1) + call AD_DestroyRotOtherStateType(OtherStateData%rotors(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OtherStateData%rotors) + end if + if (allocated(OtherStateData%WakeLocationPoints)) then + deallocate(OtherStateData%WakeLocationPoints) + end if +end subroutine subroutine AD_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -4137,7 +3769,6 @@ subroutine AD_PackOtherState(Buf, Indata) integer(IntKi) :: i1, i2 integer(IntKi) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return - ! rotors call RegPack(Buf, allocated(InData%rotors)) if (allocated(InData%rotors)) then call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) @@ -4148,10 +3779,8 @@ subroutine AD_PackOtherState(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! FVW call FVW_PackOtherState(Buf, InData%FVW) if (RegCheckErr(Buf, RoutineName)) return - ! WakeLocationPoints call RegPack(Buf, allocated(InData%WakeLocationPoints)) if (allocated(InData%WakeLocationPoints)) then call RegPackBounds(Buf, 2, lbound(InData%WakeLocationPoints), ubound(InData%WakeLocationPoints)) @@ -4169,7 +3798,6 @@ subroutine AD_UnPackOtherState(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! rotors if (allocated(OutData%rotors)) deallocate(OutData%rotors) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4185,9 +3813,7 @@ subroutine AD_UnPackOtherState(Buf, OutData) call AD_UnpackRotOtherStateType(Buf, OutData%rotors(i1)) ! rotors end do end if - ! FVW call FVW_UnpackOtherState(Buf, OutData%FVW) ! FVW - ! WakeLocationPoints if (allocated(OutData%WakeLocationPoints)) deallocate(OutData%WakeLocationPoints) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4203,700 +3829,703 @@ subroutine AD_UnPackOtherState(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE AD_CopyRotMiscVarType( SrcRotMiscVarTypeData, DstRotMiscVarTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(RotMiscVarType), INTENT(INOUT) :: SrcRotMiscVarTypeData - TYPE(RotMiscVarType), INTENT(INOUT) :: DstRotMiscVarTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_CopyRotMiscVarType' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL BEMT_CopyMisc( SrcRotMiscVarTypeData%BEMT, DstRotMiscVarTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL BEMT_CopyOutput( SrcRotMiscVarTypeData%BEMT_y, DstRotMiscVarTypeData%BEMT_y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DO i1 = LBOUND(SrcRotMiscVarTypeData%BEMT_u,1), UBOUND(SrcRotMiscVarTypeData%BEMT_u,1) - CALL BEMT_CopyInput( SrcRotMiscVarTypeData%BEMT_u(i1), DstRotMiscVarTypeData%BEMT_u(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL AA_CopyMisc( SrcRotMiscVarTypeData%AA, DstRotMiscVarTypeData%AA, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AA_CopyOutput( SrcRotMiscVarTypeData%AA_y, DstRotMiscVarTypeData%AA_y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AA_CopyInput( SrcRotMiscVarTypeData%AA_u, DstRotMiscVarTypeData%AA_u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcRotMiscVarTypeData%DisturbedInflow)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%DisturbedInflow,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%DisturbedInflow,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%DisturbedInflow,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%DisturbedInflow,2) - i3_l = LBOUND(SrcRotMiscVarTypeData%DisturbedInflow,3) - i3_u = UBOUND(SrcRotMiscVarTypeData%DisturbedInflow,3) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%DisturbedInflow)) THEN - ALLOCATE(DstRotMiscVarTypeData%DisturbedInflow(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%DisturbedInflow.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%DisturbedInflow = SrcRotMiscVarTypeData%DisturbedInflow -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%orientationAnnulus)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%orientationAnnulus,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%orientationAnnulus,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%orientationAnnulus,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%orientationAnnulus,2) - i3_l = LBOUND(SrcRotMiscVarTypeData%orientationAnnulus,3) - i3_u = UBOUND(SrcRotMiscVarTypeData%orientationAnnulus,3) - i4_l = LBOUND(SrcRotMiscVarTypeData%orientationAnnulus,4) - i4_u = UBOUND(SrcRotMiscVarTypeData%orientationAnnulus,4) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%orientationAnnulus)) THEN - ALLOCATE(DstRotMiscVarTypeData%orientationAnnulus(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%orientationAnnulus.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%orientationAnnulus = SrcRotMiscVarTypeData%orientationAnnulus -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%AllOuts)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%AllOuts,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%AllOuts,1) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%AllOuts)) THEN - ALLOCATE(DstRotMiscVarTypeData%AllOuts(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%AllOuts.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%AllOuts = SrcRotMiscVarTypeData%AllOuts -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%W_Twr)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%W_Twr,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%W_Twr,1) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%W_Twr)) THEN - ALLOCATE(DstRotMiscVarTypeData%W_Twr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%W_Twr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%W_Twr = SrcRotMiscVarTypeData%W_Twr -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%X_Twr)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%X_Twr,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%X_Twr,1) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%X_Twr)) THEN - ALLOCATE(DstRotMiscVarTypeData%X_Twr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%X_Twr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%X_Twr = SrcRotMiscVarTypeData%X_Twr -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%Y_Twr)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%Y_Twr,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%Y_Twr,1) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%Y_Twr)) THEN - ALLOCATE(DstRotMiscVarTypeData%Y_Twr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Y_Twr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%Y_Twr = SrcRotMiscVarTypeData%Y_Twr -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%Curve)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%Curve,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%Curve,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%Curve,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%Curve,2) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%Curve)) THEN - ALLOCATE(DstRotMiscVarTypeData%Curve(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Curve.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%Curve = SrcRotMiscVarTypeData%Curve -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%TwrClrnc)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%TwrClrnc,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%TwrClrnc,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%TwrClrnc,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%TwrClrnc,2) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%TwrClrnc)) THEN - ALLOCATE(DstRotMiscVarTypeData%TwrClrnc(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%TwrClrnc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%TwrClrnc = SrcRotMiscVarTypeData%TwrClrnc -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%X)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%X,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%X,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%X,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%X,2) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%X)) THEN - ALLOCATE(DstRotMiscVarTypeData%X(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%X.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%X = SrcRotMiscVarTypeData%X -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%Y)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%Y,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%Y,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%Y,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%Y,2) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%Y)) THEN - ALLOCATE(DstRotMiscVarTypeData%Y(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%Y = SrcRotMiscVarTypeData%Y -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%Z)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%Z,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%Z,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%Z,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%Z,2) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%Z)) THEN - ALLOCATE(DstRotMiscVarTypeData%Z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%Z = SrcRotMiscVarTypeData%Z -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%M)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%M,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%M,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%M,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%M,2) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%M)) THEN - ALLOCATE(DstRotMiscVarTypeData%M(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%M.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%M = SrcRotMiscVarTypeData%M -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%Mx)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%Mx,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%Mx,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%Mx,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%Mx,2) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%Mx)) THEN - ALLOCATE(DstRotMiscVarTypeData%Mx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Mx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%Mx = SrcRotMiscVarTypeData%Mx -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%My)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%My,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%My,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%My,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%My,2) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%My)) THEN - ALLOCATE(DstRotMiscVarTypeData%My(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%My.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%My = SrcRotMiscVarTypeData%My -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%Mz)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%Mz,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%Mz,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%Mz,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%Mz,2) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%Mz)) THEN - ALLOCATE(DstRotMiscVarTypeData%Mz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Mz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%Mz = SrcRotMiscVarTypeData%Mz -ENDIF - DstRotMiscVarTypeData%V_DiskAvg = SrcRotMiscVarTypeData%V_DiskAvg - DstRotMiscVarTypeData%yaw = SrcRotMiscVarTypeData%yaw - DstRotMiscVarTypeData%tilt = SrcRotMiscVarTypeData%tilt -IF (ALLOCATED(SrcRotMiscVarTypeData%hub_theta_x_root)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%hub_theta_x_root,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%hub_theta_x_root,1) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%hub_theta_x_root)) THEN - ALLOCATE(DstRotMiscVarTypeData%hub_theta_x_root(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%hub_theta_x_root.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%hub_theta_x_root = SrcRotMiscVarTypeData%hub_theta_x_root -ENDIF - DstRotMiscVarTypeData%V_dot_x = SrcRotMiscVarTypeData%V_dot_x - CALL MeshCopy( SrcRotMiscVarTypeData%HubLoad, DstRotMiscVarTypeData%HubLoad, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcRotMiscVarTypeData%B_L_2_H_P)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%B_L_2_H_P,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%B_L_2_H_P,1) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%B_L_2_H_P)) THEN - ALLOCATE(DstRotMiscVarTypeData%B_L_2_H_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%B_L_2_H_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotMiscVarTypeData%B_L_2_H_P,1), UBOUND(SrcRotMiscVarTypeData%B_L_2_H_P,1) - CALL NWTC_Library_Copymeshmaptype( SrcRotMiscVarTypeData%B_L_2_H_P(i1), DstRotMiscVarTypeData%B_L_2_H_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%SigmaCavitCrit)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%SigmaCavitCrit,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%SigmaCavitCrit,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%SigmaCavitCrit,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%SigmaCavitCrit,2) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%SigmaCavitCrit)) THEN - ALLOCATE(DstRotMiscVarTypeData%SigmaCavitCrit(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%SigmaCavitCrit.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%SigmaCavitCrit = SrcRotMiscVarTypeData%SigmaCavitCrit -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%SigmaCavit)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%SigmaCavit,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%SigmaCavit,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%SigmaCavit,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%SigmaCavit,2) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%SigmaCavit)) THEN - ALLOCATE(DstRotMiscVarTypeData%SigmaCavit(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%SigmaCavit.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%SigmaCavit = SrcRotMiscVarTypeData%SigmaCavit -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%CavitWarnSet)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%CavitWarnSet,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%CavitWarnSet,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%CavitWarnSet,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%CavitWarnSet,2) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%CavitWarnSet)) THEN - ALLOCATE(DstRotMiscVarTypeData%CavitWarnSet(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%CavitWarnSet.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%CavitWarnSet = SrcRotMiscVarTypeData%CavitWarnSet -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%BlFB)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%BlFB,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%BlFB,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%BlFB,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%BlFB,2) - i3_l = LBOUND(SrcRotMiscVarTypeData%BlFB,3) - i3_u = UBOUND(SrcRotMiscVarTypeData%BlFB,3) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%BlFB)) THEN - ALLOCATE(DstRotMiscVarTypeData%BlFB(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BlFB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%BlFB = SrcRotMiscVarTypeData%BlFB -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%BlMB)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%BlMB,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%BlMB,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%BlMB,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%BlMB,2) - i3_l = LBOUND(SrcRotMiscVarTypeData%BlMB,3) - i3_u = UBOUND(SrcRotMiscVarTypeData%BlMB,3) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%BlMB)) THEN - ALLOCATE(DstRotMiscVarTypeData%BlMB(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BlMB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%BlMB = SrcRotMiscVarTypeData%BlMB -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%TwrFB)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%TwrFB,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%TwrFB,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%TwrFB,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%TwrFB,2) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%TwrFB)) THEN - ALLOCATE(DstRotMiscVarTypeData%TwrFB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%TwrFB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%TwrFB = SrcRotMiscVarTypeData%TwrFB -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%TwrMB)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%TwrMB,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%TwrMB,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%TwrMB,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%TwrMB,2) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%TwrMB)) THEN - ALLOCATE(DstRotMiscVarTypeData%TwrMB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%TwrMB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%TwrMB = SrcRotMiscVarTypeData%TwrMB -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%HubFB)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%HubFB,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%HubFB,1) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%HubFB)) THEN - ALLOCATE(DstRotMiscVarTypeData%HubFB(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%HubFB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%HubFB = SrcRotMiscVarTypeData%HubFB -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%HubMB)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%HubMB,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%HubMB,1) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%HubMB)) THEN - ALLOCATE(DstRotMiscVarTypeData%HubMB(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%HubMB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%HubMB = SrcRotMiscVarTypeData%HubMB -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%NacFB)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%NacFB,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%NacFB,1) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%NacFB)) THEN - ALLOCATE(DstRotMiscVarTypeData%NacFB(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%NacFB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%NacFB = SrcRotMiscVarTypeData%NacFB -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%NacMB)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%NacMB,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%NacMB,1) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%NacMB)) THEN - ALLOCATE(DstRotMiscVarTypeData%NacMB(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%NacMB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotMiscVarTypeData%NacMB = SrcRotMiscVarTypeData%NacMB -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%BladeRootLoad)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%BladeRootLoad,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%BladeRootLoad,1) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%BladeRootLoad)) THEN - ALLOCATE(DstRotMiscVarTypeData%BladeRootLoad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BladeRootLoad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotMiscVarTypeData%BladeRootLoad,1), UBOUND(SrcRotMiscVarTypeData%BladeRootLoad,1) - CALL MeshCopy( SrcRotMiscVarTypeData%BladeRootLoad(i1), DstRotMiscVarTypeData%BladeRootLoad(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%B_L_2_R_P)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%B_L_2_R_P,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%B_L_2_R_P,1) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%B_L_2_R_P)) THEN - ALLOCATE(DstRotMiscVarTypeData%B_L_2_R_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%B_L_2_R_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotMiscVarTypeData%B_L_2_R_P,1), UBOUND(SrcRotMiscVarTypeData%B_L_2_R_P,1) - CALL NWTC_Library_Copymeshmaptype( SrcRotMiscVarTypeData%B_L_2_R_P(i1), DstRotMiscVarTypeData%B_L_2_R_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%BladeBuoyLoadPoint)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%BladeBuoyLoadPoint,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%BladeBuoyLoadPoint,1) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%BladeBuoyLoadPoint)) THEN - ALLOCATE(DstRotMiscVarTypeData%BladeBuoyLoadPoint(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BladeBuoyLoadPoint.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotMiscVarTypeData%BladeBuoyLoadPoint,1), UBOUND(SrcRotMiscVarTypeData%BladeBuoyLoadPoint,1) - CALL MeshCopy( SrcRotMiscVarTypeData%BladeBuoyLoadPoint(i1), DstRotMiscVarTypeData%BladeBuoyLoadPoint(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%BladeBuoyLoad)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%BladeBuoyLoad,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%BladeBuoyLoad,1) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%BladeBuoyLoad)) THEN - ALLOCATE(DstRotMiscVarTypeData%BladeBuoyLoad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BladeBuoyLoad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotMiscVarTypeData%BladeBuoyLoad,1), UBOUND(SrcRotMiscVarTypeData%BladeBuoyLoad,1) - CALL MeshCopy( SrcRotMiscVarTypeData%BladeBuoyLoad(i1), DstRotMiscVarTypeData%BladeBuoyLoad(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%B_P_2_B_L)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%B_P_2_B_L,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%B_P_2_B_L,1) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%B_P_2_B_L)) THEN - ALLOCATE(DstRotMiscVarTypeData%B_P_2_B_L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%B_P_2_B_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotMiscVarTypeData%B_P_2_B_L,1), UBOUND(SrcRotMiscVarTypeData%B_P_2_B_L,1) - CALL NWTC_Library_Copymeshmaptype( SrcRotMiscVarTypeData%B_P_2_B_L(i1), DstRotMiscVarTypeData%B_P_2_B_L(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL MeshCopy( SrcRotMiscVarTypeData%TwrBuoyLoadPoint, DstRotMiscVarTypeData%TwrBuoyLoadPoint, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcRotMiscVarTypeData%TwrBuoyLoad, DstRotMiscVarTypeData%TwrBuoyLoad, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcRotMiscVarTypeData%T_P_2_T_L, DstRotMiscVarTypeData%T_P_2_T_L, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstRotMiscVarTypeData%FirstWarn_TowerStrike = SrcRotMiscVarTypeData%FirstWarn_TowerStrike - DstRotMiscVarTypeData%AvgDiskVel = SrcRotMiscVarTypeData%AvgDiskVel - DstRotMiscVarTypeData%AvgDiskVelDist = SrcRotMiscVarTypeData%AvgDiskVelDist - DstRotMiscVarTypeData%TFinAlpha = SrcRotMiscVarTypeData%TFinAlpha - DstRotMiscVarTypeData%TFinRe = SrcRotMiscVarTypeData%TFinRe - DstRotMiscVarTypeData%TFinVrel = SrcRotMiscVarTypeData%TFinVrel - DstRotMiscVarTypeData%TFinVund_i = SrcRotMiscVarTypeData%TFinVund_i - DstRotMiscVarTypeData%TFinVind_i = SrcRotMiscVarTypeData%TFinVind_i - DstRotMiscVarTypeData%TFinVrel_i = SrcRotMiscVarTypeData%TFinVrel_i - DstRotMiscVarTypeData%TFinSTV_i = SrcRotMiscVarTypeData%TFinSTV_i - DstRotMiscVarTypeData%TFinF_i = SrcRotMiscVarTypeData%TFinF_i - DstRotMiscVarTypeData%TFinM_i = SrcRotMiscVarTypeData%TFinM_i - END SUBROUTINE AD_CopyRotMiscVarType - - SUBROUTINE AD_DestroyRotMiscVarType( RotMiscVarTypeData, ErrStat, ErrMsg ) - TYPE(RotMiscVarType), INTENT(INOUT) :: RotMiscVarTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyRotMiscVarType' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL BEMT_DestroyMisc( RotMiscVarTypeData%BEMT, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL BEMT_DestroyOutput( RotMiscVarTypeData%BEMT_y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -DO i1 = LBOUND(RotMiscVarTypeData%BEMT_u,1), UBOUND(RotMiscVarTypeData%BEMT_u,1) - CALL BEMT_DestroyInput( RotMiscVarTypeData%BEMT_u(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL AA_DestroyMisc( RotMiscVarTypeData%AA, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AA_DestroyOutput( RotMiscVarTypeData%AA_y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AA_DestroyInput( RotMiscVarTypeData%AA_u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(RotMiscVarTypeData%DisturbedInflow)) THEN - DEALLOCATE(RotMiscVarTypeData%DisturbedInflow) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%orientationAnnulus)) THEN - DEALLOCATE(RotMiscVarTypeData%orientationAnnulus) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%AllOuts)) THEN - DEALLOCATE(RotMiscVarTypeData%AllOuts) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%W_Twr)) THEN - DEALLOCATE(RotMiscVarTypeData%W_Twr) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%X_Twr)) THEN - DEALLOCATE(RotMiscVarTypeData%X_Twr) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%Y_Twr)) THEN - DEALLOCATE(RotMiscVarTypeData%Y_Twr) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%Curve)) THEN - DEALLOCATE(RotMiscVarTypeData%Curve) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%TwrClrnc)) THEN - DEALLOCATE(RotMiscVarTypeData%TwrClrnc) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%X)) THEN - DEALLOCATE(RotMiscVarTypeData%X) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%Y)) THEN - DEALLOCATE(RotMiscVarTypeData%Y) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%Z)) THEN - DEALLOCATE(RotMiscVarTypeData%Z) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%M)) THEN - DEALLOCATE(RotMiscVarTypeData%M) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%Mx)) THEN - DEALLOCATE(RotMiscVarTypeData%Mx) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%My)) THEN - DEALLOCATE(RotMiscVarTypeData%My) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%Mz)) THEN - DEALLOCATE(RotMiscVarTypeData%Mz) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%hub_theta_x_root)) THEN - DEALLOCATE(RotMiscVarTypeData%hub_theta_x_root) -ENDIF - CALL MeshDestroy( RotMiscVarTypeData%HubLoad, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(RotMiscVarTypeData%B_L_2_H_P)) THEN -DO i1 = LBOUND(RotMiscVarTypeData%B_L_2_H_P,1), UBOUND(RotMiscVarTypeData%B_L_2_H_P,1) - CALL NWTC_Library_DestroyMeshMapType( RotMiscVarTypeData%B_L_2_H_P(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotMiscVarTypeData%B_L_2_H_P) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%SigmaCavitCrit)) THEN - DEALLOCATE(RotMiscVarTypeData%SigmaCavitCrit) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%SigmaCavit)) THEN - DEALLOCATE(RotMiscVarTypeData%SigmaCavit) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%CavitWarnSet)) THEN - DEALLOCATE(RotMiscVarTypeData%CavitWarnSet) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%BlFB)) THEN - DEALLOCATE(RotMiscVarTypeData%BlFB) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%BlMB)) THEN - DEALLOCATE(RotMiscVarTypeData%BlMB) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%TwrFB)) THEN - DEALLOCATE(RotMiscVarTypeData%TwrFB) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%TwrMB)) THEN - DEALLOCATE(RotMiscVarTypeData%TwrMB) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%HubFB)) THEN - DEALLOCATE(RotMiscVarTypeData%HubFB) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%HubMB)) THEN - DEALLOCATE(RotMiscVarTypeData%HubMB) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%NacFB)) THEN - DEALLOCATE(RotMiscVarTypeData%NacFB) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%NacMB)) THEN - DEALLOCATE(RotMiscVarTypeData%NacMB) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%BladeRootLoad)) THEN -DO i1 = LBOUND(RotMiscVarTypeData%BladeRootLoad,1), UBOUND(RotMiscVarTypeData%BladeRootLoad,1) - CALL MeshDestroy( RotMiscVarTypeData%BladeRootLoad(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotMiscVarTypeData%BladeRootLoad) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%B_L_2_R_P)) THEN -DO i1 = LBOUND(RotMiscVarTypeData%B_L_2_R_P,1), UBOUND(RotMiscVarTypeData%B_L_2_R_P,1) - CALL NWTC_Library_DestroyMeshMapType( RotMiscVarTypeData%B_L_2_R_P(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotMiscVarTypeData%B_L_2_R_P) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%BladeBuoyLoadPoint)) THEN -DO i1 = LBOUND(RotMiscVarTypeData%BladeBuoyLoadPoint,1), UBOUND(RotMiscVarTypeData%BladeBuoyLoadPoint,1) - CALL MeshDestroy( RotMiscVarTypeData%BladeBuoyLoadPoint(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotMiscVarTypeData%BladeBuoyLoadPoint) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%BladeBuoyLoad)) THEN -DO i1 = LBOUND(RotMiscVarTypeData%BladeBuoyLoad,1), UBOUND(RotMiscVarTypeData%BladeBuoyLoad,1) - CALL MeshDestroy( RotMiscVarTypeData%BladeBuoyLoad(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotMiscVarTypeData%BladeBuoyLoad) -ENDIF -IF (ALLOCATED(RotMiscVarTypeData%B_P_2_B_L)) THEN -DO i1 = LBOUND(RotMiscVarTypeData%B_P_2_B_L,1), UBOUND(RotMiscVarTypeData%B_P_2_B_L,1) - CALL NWTC_Library_DestroyMeshMapType( RotMiscVarTypeData%B_P_2_B_L(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotMiscVarTypeData%B_P_2_B_L) -ENDIF - CALL MeshDestroy( RotMiscVarTypeData%TwrBuoyLoadPoint, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( RotMiscVarTypeData%TwrBuoyLoad, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyMeshMapType( RotMiscVarTypeData%T_P_2_T_L, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_DestroyRotMiscVarType - + +subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, CtrlCode, ErrStat, ErrMsg) + type(RotMiscVarType), intent(inout) :: SrcRotMiscVarTypeData + type(RotMiscVarType), intent(inout) :: DstRotMiscVarTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3, i4 + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyRotMiscVarType' + ErrStat = ErrID_None + ErrMsg = '' + call BEMT_CopyMisc(SrcRotMiscVarTypeData%BEMT, DstRotMiscVarTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call BEMT_CopyOutput(SrcRotMiscVarTypeData%BEMT_y, DstRotMiscVarTypeData%BEMT_y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + do i1 = LB(1), UB(1) + call BEMT_CopyInput(SrcRotMiscVarTypeData%BEMT_u(i1), DstRotMiscVarTypeData%BEMT_u(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call AA_CopyMisc(SrcRotMiscVarTypeData%AA, DstRotMiscVarTypeData%AA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AA_CopyOutput(SrcRotMiscVarTypeData%AA_y, DstRotMiscVarTypeData%AA_y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AA_CopyInput(SrcRotMiscVarTypeData%AA_u, DstRotMiscVarTypeData%AA_u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcRotMiscVarTypeData%DisturbedInflow)) then + LB(1:3) = lbound(SrcRotMiscVarTypeData%DisturbedInflow) + UB(1:3) = ubound(SrcRotMiscVarTypeData%DisturbedInflow) + if (.not. allocated(DstRotMiscVarTypeData%DisturbedInflow)) then + allocate(DstRotMiscVarTypeData%DisturbedInflow(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%DisturbedInflow.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%DisturbedInflow = SrcRotMiscVarTypeData%DisturbedInflow + else if (allocated(DstRotMiscVarTypeData%DisturbedInflow)) then + deallocate(DstRotMiscVarTypeData%DisturbedInflow) + end if + if (allocated(SrcRotMiscVarTypeData%orientationAnnulus)) then + LB(1:4) = lbound(SrcRotMiscVarTypeData%orientationAnnulus) + UB(1:4) = ubound(SrcRotMiscVarTypeData%orientationAnnulus) + if (.not. allocated(DstRotMiscVarTypeData%orientationAnnulus)) then + allocate(DstRotMiscVarTypeData%orientationAnnulus(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%orientationAnnulus.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%orientationAnnulus = SrcRotMiscVarTypeData%orientationAnnulus + else if (allocated(DstRotMiscVarTypeData%orientationAnnulus)) then + deallocate(DstRotMiscVarTypeData%orientationAnnulus) + end if + if (allocated(SrcRotMiscVarTypeData%AllOuts)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%AllOuts) + UB(1:1) = ubound(SrcRotMiscVarTypeData%AllOuts) + if (.not. allocated(DstRotMiscVarTypeData%AllOuts)) then + allocate(DstRotMiscVarTypeData%AllOuts(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%AllOuts.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%AllOuts = SrcRotMiscVarTypeData%AllOuts + else if (allocated(DstRotMiscVarTypeData%AllOuts)) then + deallocate(DstRotMiscVarTypeData%AllOuts) + end if + if (allocated(SrcRotMiscVarTypeData%W_Twr)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%W_Twr) + UB(1:1) = ubound(SrcRotMiscVarTypeData%W_Twr) + if (.not. allocated(DstRotMiscVarTypeData%W_Twr)) then + allocate(DstRotMiscVarTypeData%W_Twr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%W_Twr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%W_Twr = SrcRotMiscVarTypeData%W_Twr + else if (allocated(DstRotMiscVarTypeData%W_Twr)) then + deallocate(DstRotMiscVarTypeData%W_Twr) + end if + if (allocated(SrcRotMiscVarTypeData%X_Twr)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%X_Twr) + UB(1:1) = ubound(SrcRotMiscVarTypeData%X_Twr) + if (.not. allocated(DstRotMiscVarTypeData%X_Twr)) then + allocate(DstRotMiscVarTypeData%X_Twr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%X_Twr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%X_Twr = SrcRotMiscVarTypeData%X_Twr + else if (allocated(DstRotMiscVarTypeData%X_Twr)) then + deallocate(DstRotMiscVarTypeData%X_Twr) + end if + if (allocated(SrcRotMiscVarTypeData%Y_Twr)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%Y_Twr) + UB(1:1) = ubound(SrcRotMiscVarTypeData%Y_Twr) + if (.not. allocated(DstRotMiscVarTypeData%Y_Twr)) then + allocate(DstRotMiscVarTypeData%Y_Twr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Y_Twr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%Y_Twr = SrcRotMiscVarTypeData%Y_Twr + else if (allocated(DstRotMiscVarTypeData%Y_Twr)) then + deallocate(DstRotMiscVarTypeData%Y_Twr) + end if + if (allocated(SrcRotMiscVarTypeData%Curve)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%Curve) + UB(1:2) = ubound(SrcRotMiscVarTypeData%Curve) + if (.not. allocated(DstRotMiscVarTypeData%Curve)) then + allocate(DstRotMiscVarTypeData%Curve(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Curve.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%Curve = SrcRotMiscVarTypeData%Curve + else if (allocated(DstRotMiscVarTypeData%Curve)) then + deallocate(DstRotMiscVarTypeData%Curve) + end if + if (allocated(SrcRotMiscVarTypeData%TwrClrnc)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%TwrClrnc) + UB(1:2) = ubound(SrcRotMiscVarTypeData%TwrClrnc) + if (.not. allocated(DstRotMiscVarTypeData%TwrClrnc)) then + allocate(DstRotMiscVarTypeData%TwrClrnc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%TwrClrnc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%TwrClrnc = SrcRotMiscVarTypeData%TwrClrnc + else if (allocated(DstRotMiscVarTypeData%TwrClrnc)) then + deallocate(DstRotMiscVarTypeData%TwrClrnc) + end if + if (allocated(SrcRotMiscVarTypeData%X)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%X) + UB(1:2) = ubound(SrcRotMiscVarTypeData%X) + if (.not. allocated(DstRotMiscVarTypeData%X)) then + allocate(DstRotMiscVarTypeData%X(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%X.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%X = SrcRotMiscVarTypeData%X + else if (allocated(DstRotMiscVarTypeData%X)) then + deallocate(DstRotMiscVarTypeData%X) + end if + if (allocated(SrcRotMiscVarTypeData%Y)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%Y) + UB(1:2) = ubound(SrcRotMiscVarTypeData%Y) + if (.not. allocated(DstRotMiscVarTypeData%Y)) then + allocate(DstRotMiscVarTypeData%Y(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%Y = SrcRotMiscVarTypeData%Y + else if (allocated(DstRotMiscVarTypeData%Y)) then + deallocate(DstRotMiscVarTypeData%Y) + end if + if (allocated(SrcRotMiscVarTypeData%Z)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%Z) + UB(1:2) = ubound(SrcRotMiscVarTypeData%Z) + if (.not. allocated(DstRotMiscVarTypeData%Z)) then + allocate(DstRotMiscVarTypeData%Z(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%Z = SrcRotMiscVarTypeData%Z + else if (allocated(DstRotMiscVarTypeData%Z)) then + deallocate(DstRotMiscVarTypeData%Z) + end if + if (allocated(SrcRotMiscVarTypeData%M)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%M) + UB(1:2) = ubound(SrcRotMiscVarTypeData%M) + if (.not. allocated(DstRotMiscVarTypeData%M)) then + allocate(DstRotMiscVarTypeData%M(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%M.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%M = SrcRotMiscVarTypeData%M + else if (allocated(DstRotMiscVarTypeData%M)) then + deallocate(DstRotMiscVarTypeData%M) + end if + if (allocated(SrcRotMiscVarTypeData%Mx)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%Mx) + UB(1:2) = ubound(SrcRotMiscVarTypeData%Mx) + if (.not. allocated(DstRotMiscVarTypeData%Mx)) then + allocate(DstRotMiscVarTypeData%Mx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Mx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%Mx = SrcRotMiscVarTypeData%Mx + else if (allocated(DstRotMiscVarTypeData%Mx)) then + deallocate(DstRotMiscVarTypeData%Mx) + end if + if (allocated(SrcRotMiscVarTypeData%My)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%My) + UB(1:2) = ubound(SrcRotMiscVarTypeData%My) + if (.not. allocated(DstRotMiscVarTypeData%My)) then + allocate(DstRotMiscVarTypeData%My(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%My.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%My = SrcRotMiscVarTypeData%My + else if (allocated(DstRotMiscVarTypeData%My)) then + deallocate(DstRotMiscVarTypeData%My) + end if + if (allocated(SrcRotMiscVarTypeData%Mz)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%Mz) + UB(1:2) = ubound(SrcRotMiscVarTypeData%Mz) + if (.not. allocated(DstRotMiscVarTypeData%Mz)) then + allocate(DstRotMiscVarTypeData%Mz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Mz.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%Mz = SrcRotMiscVarTypeData%Mz + else if (allocated(DstRotMiscVarTypeData%Mz)) then + deallocate(DstRotMiscVarTypeData%Mz) + end if + DstRotMiscVarTypeData%V_DiskAvg = SrcRotMiscVarTypeData%V_DiskAvg + DstRotMiscVarTypeData%yaw = SrcRotMiscVarTypeData%yaw + DstRotMiscVarTypeData%tilt = SrcRotMiscVarTypeData%tilt + if (allocated(SrcRotMiscVarTypeData%hub_theta_x_root)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%hub_theta_x_root) + UB(1:1) = ubound(SrcRotMiscVarTypeData%hub_theta_x_root) + if (.not. allocated(DstRotMiscVarTypeData%hub_theta_x_root)) then + allocate(DstRotMiscVarTypeData%hub_theta_x_root(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%hub_theta_x_root.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%hub_theta_x_root = SrcRotMiscVarTypeData%hub_theta_x_root + else if (allocated(DstRotMiscVarTypeData%hub_theta_x_root)) then + deallocate(DstRotMiscVarTypeData%hub_theta_x_root) + end if + DstRotMiscVarTypeData%V_dot_x = SrcRotMiscVarTypeData%V_dot_x + call MeshCopy(SrcRotMiscVarTypeData%HubLoad, DstRotMiscVarTypeData%HubLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcRotMiscVarTypeData%B_L_2_H_P)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%B_L_2_H_P) + UB(1:1) = ubound(SrcRotMiscVarTypeData%B_L_2_H_P) + if (.not. allocated(DstRotMiscVarTypeData%B_L_2_H_P)) then + allocate(DstRotMiscVarTypeData%B_L_2_H_P(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%B_L_2_H_P.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcRotMiscVarTypeData%B_L_2_H_P(i1), DstRotMiscVarTypeData%B_L_2_H_P(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstRotMiscVarTypeData%B_L_2_H_P)) then + deallocate(DstRotMiscVarTypeData%B_L_2_H_P) + end if + if (allocated(SrcRotMiscVarTypeData%SigmaCavitCrit)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%SigmaCavitCrit) + UB(1:2) = ubound(SrcRotMiscVarTypeData%SigmaCavitCrit) + if (.not. allocated(DstRotMiscVarTypeData%SigmaCavitCrit)) then + allocate(DstRotMiscVarTypeData%SigmaCavitCrit(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%SigmaCavitCrit.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%SigmaCavitCrit = SrcRotMiscVarTypeData%SigmaCavitCrit + else if (allocated(DstRotMiscVarTypeData%SigmaCavitCrit)) then + deallocate(DstRotMiscVarTypeData%SigmaCavitCrit) + end if + if (allocated(SrcRotMiscVarTypeData%SigmaCavit)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%SigmaCavit) + UB(1:2) = ubound(SrcRotMiscVarTypeData%SigmaCavit) + if (.not. allocated(DstRotMiscVarTypeData%SigmaCavit)) then + allocate(DstRotMiscVarTypeData%SigmaCavit(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%SigmaCavit.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%SigmaCavit = SrcRotMiscVarTypeData%SigmaCavit + else if (allocated(DstRotMiscVarTypeData%SigmaCavit)) then + deallocate(DstRotMiscVarTypeData%SigmaCavit) + end if + if (allocated(SrcRotMiscVarTypeData%CavitWarnSet)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%CavitWarnSet) + UB(1:2) = ubound(SrcRotMiscVarTypeData%CavitWarnSet) + if (.not. allocated(DstRotMiscVarTypeData%CavitWarnSet)) then + allocate(DstRotMiscVarTypeData%CavitWarnSet(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%CavitWarnSet.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%CavitWarnSet = SrcRotMiscVarTypeData%CavitWarnSet + else if (allocated(DstRotMiscVarTypeData%CavitWarnSet)) then + deallocate(DstRotMiscVarTypeData%CavitWarnSet) + end if + if (allocated(SrcRotMiscVarTypeData%BlFB)) then + LB(1:3) = lbound(SrcRotMiscVarTypeData%BlFB) + UB(1:3) = ubound(SrcRotMiscVarTypeData%BlFB) + if (.not. allocated(DstRotMiscVarTypeData%BlFB)) then + allocate(DstRotMiscVarTypeData%BlFB(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BlFB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%BlFB = SrcRotMiscVarTypeData%BlFB + else if (allocated(DstRotMiscVarTypeData%BlFB)) then + deallocate(DstRotMiscVarTypeData%BlFB) + end if + if (allocated(SrcRotMiscVarTypeData%BlMB)) then + LB(1:3) = lbound(SrcRotMiscVarTypeData%BlMB) + UB(1:3) = ubound(SrcRotMiscVarTypeData%BlMB) + if (.not. allocated(DstRotMiscVarTypeData%BlMB)) then + allocate(DstRotMiscVarTypeData%BlMB(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BlMB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%BlMB = SrcRotMiscVarTypeData%BlMB + else if (allocated(DstRotMiscVarTypeData%BlMB)) then + deallocate(DstRotMiscVarTypeData%BlMB) + end if + if (allocated(SrcRotMiscVarTypeData%TwrFB)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%TwrFB) + UB(1:2) = ubound(SrcRotMiscVarTypeData%TwrFB) + if (.not. allocated(DstRotMiscVarTypeData%TwrFB)) then + allocate(DstRotMiscVarTypeData%TwrFB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%TwrFB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%TwrFB = SrcRotMiscVarTypeData%TwrFB + else if (allocated(DstRotMiscVarTypeData%TwrFB)) then + deallocate(DstRotMiscVarTypeData%TwrFB) + end if + if (allocated(SrcRotMiscVarTypeData%TwrMB)) then + LB(1:2) = lbound(SrcRotMiscVarTypeData%TwrMB) + UB(1:2) = ubound(SrcRotMiscVarTypeData%TwrMB) + if (.not. allocated(DstRotMiscVarTypeData%TwrMB)) then + allocate(DstRotMiscVarTypeData%TwrMB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%TwrMB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%TwrMB = SrcRotMiscVarTypeData%TwrMB + else if (allocated(DstRotMiscVarTypeData%TwrMB)) then + deallocate(DstRotMiscVarTypeData%TwrMB) + end if + if (allocated(SrcRotMiscVarTypeData%HubFB)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%HubFB) + UB(1:1) = ubound(SrcRotMiscVarTypeData%HubFB) + if (.not. allocated(DstRotMiscVarTypeData%HubFB)) then + allocate(DstRotMiscVarTypeData%HubFB(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%HubFB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%HubFB = SrcRotMiscVarTypeData%HubFB + else if (allocated(DstRotMiscVarTypeData%HubFB)) then + deallocate(DstRotMiscVarTypeData%HubFB) + end if + if (allocated(SrcRotMiscVarTypeData%HubMB)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%HubMB) + UB(1:1) = ubound(SrcRotMiscVarTypeData%HubMB) + if (.not. allocated(DstRotMiscVarTypeData%HubMB)) then + allocate(DstRotMiscVarTypeData%HubMB(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%HubMB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%HubMB = SrcRotMiscVarTypeData%HubMB + else if (allocated(DstRotMiscVarTypeData%HubMB)) then + deallocate(DstRotMiscVarTypeData%HubMB) + end if + if (allocated(SrcRotMiscVarTypeData%NacFB)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%NacFB) + UB(1:1) = ubound(SrcRotMiscVarTypeData%NacFB) + if (.not. allocated(DstRotMiscVarTypeData%NacFB)) then + allocate(DstRotMiscVarTypeData%NacFB(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%NacFB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%NacFB = SrcRotMiscVarTypeData%NacFB + else if (allocated(DstRotMiscVarTypeData%NacFB)) then + deallocate(DstRotMiscVarTypeData%NacFB) + end if + if (allocated(SrcRotMiscVarTypeData%NacMB)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%NacMB) + UB(1:1) = ubound(SrcRotMiscVarTypeData%NacMB) + if (.not. allocated(DstRotMiscVarTypeData%NacMB)) then + allocate(DstRotMiscVarTypeData%NacMB(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%NacMB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%NacMB = SrcRotMiscVarTypeData%NacMB + else if (allocated(DstRotMiscVarTypeData%NacMB)) then + deallocate(DstRotMiscVarTypeData%NacMB) + end if + if (allocated(SrcRotMiscVarTypeData%BladeRootLoad)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%BladeRootLoad) + UB(1:1) = ubound(SrcRotMiscVarTypeData%BladeRootLoad) + if (.not. allocated(DstRotMiscVarTypeData%BladeRootLoad)) then + allocate(DstRotMiscVarTypeData%BladeRootLoad(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BladeRootLoad.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcRotMiscVarTypeData%BladeRootLoad(i1), DstRotMiscVarTypeData%BladeRootLoad(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstRotMiscVarTypeData%BladeRootLoad)) then + deallocate(DstRotMiscVarTypeData%BladeRootLoad) + end if + if (allocated(SrcRotMiscVarTypeData%B_L_2_R_P)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%B_L_2_R_P) + UB(1:1) = ubound(SrcRotMiscVarTypeData%B_L_2_R_P) + if (.not. allocated(DstRotMiscVarTypeData%B_L_2_R_P)) then + allocate(DstRotMiscVarTypeData%B_L_2_R_P(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%B_L_2_R_P.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcRotMiscVarTypeData%B_L_2_R_P(i1), DstRotMiscVarTypeData%B_L_2_R_P(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstRotMiscVarTypeData%B_L_2_R_P)) then + deallocate(DstRotMiscVarTypeData%B_L_2_R_P) + end if + if (allocated(SrcRotMiscVarTypeData%BladeBuoyLoadPoint)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%BladeBuoyLoadPoint) + UB(1:1) = ubound(SrcRotMiscVarTypeData%BladeBuoyLoadPoint) + if (.not. allocated(DstRotMiscVarTypeData%BladeBuoyLoadPoint)) then + allocate(DstRotMiscVarTypeData%BladeBuoyLoadPoint(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BladeBuoyLoadPoint.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcRotMiscVarTypeData%BladeBuoyLoadPoint(i1), DstRotMiscVarTypeData%BladeBuoyLoadPoint(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstRotMiscVarTypeData%BladeBuoyLoadPoint)) then + deallocate(DstRotMiscVarTypeData%BladeBuoyLoadPoint) + end if + if (allocated(SrcRotMiscVarTypeData%BladeBuoyLoad)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%BladeBuoyLoad) + UB(1:1) = ubound(SrcRotMiscVarTypeData%BladeBuoyLoad) + if (.not. allocated(DstRotMiscVarTypeData%BladeBuoyLoad)) then + allocate(DstRotMiscVarTypeData%BladeBuoyLoad(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BladeBuoyLoad.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcRotMiscVarTypeData%BladeBuoyLoad(i1), DstRotMiscVarTypeData%BladeBuoyLoad(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstRotMiscVarTypeData%BladeBuoyLoad)) then + deallocate(DstRotMiscVarTypeData%BladeBuoyLoad) + end if + if (allocated(SrcRotMiscVarTypeData%B_P_2_B_L)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%B_P_2_B_L) + UB(1:1) = ubound(SrcRotMiscVarTypeData%B_P_2_B_L) + if (.not. allocated(DstRotMiscVarTypeData%B_P_2_B_L)) then + allocate(DstRotMiscVarTypeData%B_P_2_B_L(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%B_P_2_B_L.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcRotMiscVarTypeData%B_P_2_B_L(i1), DstRotMiscVarTypeData%B_P_2_B_L(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstRotMiscVarTypeData%B_P_2_B_L)) then + deallocate(DstRotMiscVarTypeData%B_P_2_B_L) + end if + call MeshCopy(SrcRotMiscVarTypeData%TwrBuoyLoadPoint, DstRotMiscVarTypeData%TwrBuoyLoadPoint, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcRotMiscVarTypeData%TwrBuoyLoad, DstRotMiscVarTypeData%TwrBuoyLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcRotMiscVarTypeData%T_P_2_T_L, DstRotMiscVarTypeData%T_P_2_T_L, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstRotMiscVarTypeData%FirstWarn_TowerStrike = SrcRotMiscVarTypeData%FirstWarn_TowerStrike + DstRotMiscVarTypeData%AvgDiskVel = SrcRotMiscVarTypeData%AvgDiskVel + DstRotMiscVarTypeData%AvgDiskVelDist = SrcRotMiscVarTypeData%AvgDiskVelDist + DstRotMiscVarTypeData%TFinAlpha = SrcRotMiscVarTypeData%TFinAlpha + DstRotMiscVarTypeData%TFinRe = SrcRotMiscVarTypeData%TFinRe + DstRotMiscVarTypeData%TFinVrel = SrcRotMiscVarTypeData%TFinVrel + DstRotMiscVarTypeData%TFinVund_i = SrcRotMiscVarTypeData%TFinVund_i + DstRotMiscVarTypeData%TFinVind_i = SrcRotMiscVarTypeData%TFinVind_i + DstRotMiscVarTypeData%TFinVrel_i = SrcRotMiscVarTypeData%TFinVrel_i + DstRotMiscVarTypeData%TFinSTV_i = SrcRotMiscVarTypeData%TFinSTV_i + DstRotMiscVarTypeData%TFinF_i = SrcRotMiscVarTypeData%TFinF_i + DstRotMiscVarTypeData%TFinM_i = SrcRotMiscVarTypeData%TFinM_i +end subroutine + +subroutine AD_DestroyRotMiscVarType(RotMiscVarTypeData, ErrStat, ErrMsg) + type(RotMiscVarType), intent(inout) :: RotMiscVarTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3, i4 + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyRotMiscVarType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(RotMiscVarTypeData%DisturbedInflow)) then + deallocate(RotMiscVarTypeData%DisturbedInflow) + end if + if (allocated(RotMiscVarTypeData%orientationAnnulus)) then + deallocate(RotMiscVarTypeData%orientationAnnulus) + end if + if (allocated(RotMiscVarTypeData%AllOuts)) then + deallocate(RotMiscVarTypeData%AllOuts) + end if + if (allocated(RotMiscVarTypeData%W_Twr)) then + deallocate(RotMiscVarTypeData%W_Twr) + end if + if (allocated(RotMiscVarTypeData%X_Twr)) then + deallocate(RotMiscVarTypeData%X_Twr) + end if + if (allocated(RotMiscVarTypeData%Y_Twr)) then + deallocate(RotMiscVarTypeData%Y_Twr) + end if + if (allocated(RotMiscVarTypeData%Curve)) then + deallocate(RotMiscVarTypeData%Curve) + end if + if (allocated(RotMiscVarTypeData%TwrClrnc)) then + deallocate(RotMiscVarTypeData%TwrClrnc) + end if + if (allocated(RotMiscVarTypeData%X)) then + deallocate(RotMiscVarTypeData%X) + end if + if (allocated(RotMiscVarTypeData%Y)) then + deallocate(RotMiscVarTypeData%Y) + end if + if (allocated(RotMiscVarTypeData%Z)) then + deallocate(RotMiscVarTypeData%Z) + end if + if (allocated(RotMiscVarTypeData%M)) then + deallocate(RotMiscVarTypeData%M) + end if + if (allocated(RotMiscVarTypeData%Mx)) then + deallocate(RotMiscVarTypeData%Mx) + end if + if (allocated(RotMiscVarTypeData%My)) then + deallocate(RotMiscVarTypeData%My) + end if + if (allocated(RotMiscVarTypeData%Mz)) then + deallocate(RotMiscVarTypeData%Mz) + end if + if (allocated(RotMiscVarTypeData%hub_theta_x_root)) then + deallocate(RotMiscVarTypeData%hub_theta_x_root) + end if + if (allocated(RotMiscVarTypeData%B_L_2_H_P)) then + LB(1:1) = lbound(RotMiscVarTypeData%B_L_2_H_P) + UB(1:1) = ubound(RotMiscVarTypeData%B_L_2_H_P) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(RotMiscVarTypeData%B_L_2_H_P(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotMiscVarTypeData%B_L_2_H_P) + end if + if (allocated(RotMiscVarTypeData%SigmaCavitCrit)) then + deallocate(RotMiscVarTypeData%SigmaCavitCrit) + end if + if (allocated(RotMiscVarTypeData%SigmaCavit)) then + deallocate(RotMiscVarTypeData%SigmaCavit) + end if + if (allocated(RotMiscVarTypeData%CavitWarnSet)) then + deallocate(RotMiscVarTypeData%CavitWarnSet) + end if + if (allocated(RotMiscVarTypeData%BlFB)) then + deallocate(RotMiscVarTypeData%BlFB) + end if + if (allocated(RotMiscVarTypeData%BlMB)) then + deallocate(RotMiscVarTypeData%BlMB) + end if + if (allocated(RotMiscVarTypeData%TwrFB)) then + deallocate(RotMiscVarTypeData%TwrFB) + end if + if (allocated(RotMiscVarTypeData%TwrMB)) then + deallocate(RotMiscVarTypeData%TwrMB) + end if + if (allocated(RotMiscVarTypeData%HubFB)) then + deallocate(RotMiscVarTypeData%HubFB) + end if + if (allocated(RotMiscVarTypeData%HubMB)) then + deallocate(RotMiscVarTypeData%HubMB) + end if + if (allocated(RotMiscVarTypeData%NacFB)) then + deallocate(RotMiscVarTypeData%NacFB) + end if + if (allocated(RotMiscVarTypeData%NacMB)) then + deallocate(RotMiscVarTypeData%NacMB) + end if + if (allocated(RotMiscVarTypeData%BladeRootLoad)) then + LB(1:1) = lbound(RotMiscVarTypeData%BladeRootLoad) + UB(1:1) = ubound(RotMiscVarTypeData%BladeRootLoad) + do i1 = LB(1), UB(1) + call MeshDestroy( RotMiscVarTypeData%BladeRootLoad(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotMiscVarTypeData%BladeRootLoad) + end if + if (allocated(RotMiscVarTypeData%B_L_2_R_P)) then + LB(1:1) = lbound(RotMiscVarTypeData%B_L_2_R_P) + UB(1:1) = ubound(RotMiscVarTypeData%B_L_2_R_P) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(RotMiscVarTypeData%B_L_2_R_P(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotMiscVarTypeData%B_L_2_R_P) + end if + if (allocated(RotMiscVarTypeData%BladeBuoyLoadPoint)) then + LB(1:1) = lbound(RotMiscVarTypeData%BladeBuoyLoadPoint) + UB(1:1) = ubound(RotMiscVarTypeData%BladeBuoyLoadPoint) + do i1 = LB(1), UB(1) + call MeshDestroy( RotMiscVarTypeData%BladeBuoyLoadPoint(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotMiscVarTypeData%BladeBuoyLoadPoint) + end if + if (allocated(RotMiscVarTypeData%BladeBuoyLoad)) then + LB(1:1) = lbound(RotMiscVarTypeData%BladeBuoyLoad) + UB(1:1) = ubound(RotMiscVarTypeData%BladeBuoyLoad) + do i1 = LB(1), UB(1) + call MeshDestroy( RotMiscVarTypeData%BladeBuoyLoad(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotMiscVarTypeData%BladeBuoyLoad) + end if + if (allocated(RotMiscVarTypeData%B_P_2_B_L)) then + LB(1:1) = lbound(RotMiscVarTypeData%B_P_2_B_L) + UB(1:1) = ubound(RotMiscVarTypeData%B_P_2_B_L) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(RotMiscVarTypeData%B_P_2_B_L(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotMiscVarTypeData%B_P_2_B_L) + end if +end subroutine subroutine AD_PackRotMiscVarType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -4905,156 +4534,128 @@ subroutine AD_PackRotMiscVarType(Buf, Indata) integer(IntKi) :: i1, i2, i3, i4 integer(IntKi) :: LB(4), UB(4) if (Buf%ErrStat >= AbortErrLev) return - ! BEMT call BEMT_PackMisc(Buf, InData%BEMT) if (RegCheckErr(Buf, RoutineName)) return - ! BEMT_y call BEMT_PackOutput(Buf, InData%BEMT_y) if (RegCheckErr(Buf, RoutineName)) return - ! BEMT_u LB(1:1) = lbound(InData%BEMT_u) UB(1:1) = ubound(InData%BEMT_u) do i1 = LB(1), UB(1) call BEMT_PackInput(Buf, InData%BEMT_u(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! AA call AA_PackMisc(Buf, InData%AA) if (RegCheckErr(Buf, RoutineName)) return - ! AA_y call AA_PackOutput(Buf, InData%AA_y) if (RegCheckErr(Buf, RoutineName)) return - ! AA_u call AA_PackInput(Buf, InData%AA_u) if (RegCheckErr(Buf, RoutineName)) return - ! DisturbedInflow call RegPack(Buf, allocated(InData%DisturbedInflow)) if (allocated(InData%DisturbedInflow)) then call RegPackBounds(Buf, 3, lbound(InData%DisturbedInflow), ubound(InData%DisturbedInflow)) call RegPack(Buf, InData%DisturbedInflow) end if if (RegCheckErr(Buf, RoutineName)) return - ! orientationAnnulus call RegPack(Buf, allocated(InData%orientationAnnulus)) if (allocated(InData%orientationAnnulus)) then call RegPackBounds(Buf, 4, lbound(InData%orientationAnnulus), ubound(InData%orientationAnnulus)) call RegPack(Buf, InData%orientationAnnulus) end if if (RegCheckErr(Buf, RoutineName)) return - ! AllOuts call RegPack(Buf, allocated(InData%AllOuts)) if (allocated(InData%AllOuts)) then call RegPackBounds(Buf, 1, lbound(InData%AllOuts), ubound(InData%AllOuts)) call RegPack(Buf, InData%AllOuts) end if if (RegCheckErr(Buf, RoutineName)) return - ! W_Twr call RegPack(Buf, allocated(InData%W_Twr)) if (allocated(InData%W_Twr)) then call RegPackBounds(Buf, 1, lbound(InData%W_Twr), ubound(InData%W_Twr)) call RegPack(Buf, InData%W_Twr) end if if (RegCheckErr(Buf, RoutineName)) return - ! X_Twr call RegPack(Buf, allocated(InData%X_Twr)) if (allocated(InData%X_Twr)) then call RegPackBounds(Buf, 1, lbound(InData%X_Twr), ubound(InData%X_Twr)) call RegPack(Buf, InData%X_Twr) end if if (RegCheckErr(Buf, RoutineName)) return - ! Y_Twr call RegPack(Buf, allocated(InData%Y_Twr)) if (allocated(InData%Y_Twr)) then call RegPackBounds(Buf, 1, lbound(InData%Y_Twr), ubound(InData%Y_Twr)) call RegPack(Buf, InData%Y_Twr) end if if (RegCheckErr(Buf, RoutineName)) return - ! Curve call RegPack(Buf, allocated(InData%Curve)) if (allocated(InData%Curve)) then call RegPackBounds(Buf, 2, lbound(InData%Curve), ubound(InData%Curve)) call RegPack(Buf, InData%Curve) end if if (RegCheckErr(Buf, RoutineName)) return - ! TwrClrnc call RegPack(Buf, allocated(InData%TwrClrnc)) if (allocated(InData%TwrClrnc)) then call RegPackBounds(Buf, 2, lbound(InData%TwrClrnc), ubound(InData%TwrClrnc)) call RegPack(Buf, InData%TwrClrnc) end if if (RegCheckErr(Buf, RoutineName)) return - ! X call RegPack(Buf, allocated(InData%X)) if (allocated(InData%X)) then call RegPackBounds(Buf, 2, lbound(InData%X), ubound(InData%X)) call RegPack(Buf, InData%X) end if if (RegCheckErr(Buf, RoutineName)) return - ! Y call RegPack(Buf, allocated(InData%Y)) if (allocated(InData%Y)) then call RegPackBounds(Buf, 2, lbound(InData%Y), ubound(InData%Y)) call RegPack(Buf, InData%Y) end if if (RegCheckErr(Buf, RoutineName)) return - ! Z call RegPack(Buf, allocated(InData%Z)) if (allocated(InData%Z)) then call RegPackBounds(Buf, 2, lbound(InData%Z), ubound(InData%Z)) call RegPack(Buf, InData%Z) end if if (RegCheckErr(Buf, RoutineName)) return - ! M call RegPack(Buf, allocated(InData%M)) if (allocated(InData%M)) then call RegPackBounds(Buf, 2, lbound(InData%M), ubound(InData%M)) call RegPack(Buf, InData%M) end if if (RegCheckErr(Buf, RoutineName)) return - ! Mx call RegPack(Buf, allocated(InData%Mx)) if (allocated(InData%Mx)) then call RegPackBounds(Buf, 2, lbound(InData%Mx), ubound(InData%Mx)) call RegPack(Buf, InData%Mx) end if if (RegCheckErr(Buf, RoutineName)) return - ! My call RegPack(Buf, allocated(InData%My)) if (allocated(InData%My)) then call RegPackBounds(Buf, 2, lbound(InData%My), ubound(InData%My)) call RegPack(Buf, InData%My) end if if (RegCheckErr(Buf, RoutineName)) return - ! Mz call RegPack(Buf, allocated(InData%Mz)) if (allocated(InData%Mz)) then call RegPackBounds(Buf, 2, lbound(InData%Mz), ubound(InData%Mz)) call RegPack(Buf, InData%Mz) end if if (RegCheckErr(Buf, RoutineName)) return - ! V_DiskAvg call RegPack(Buf, InData%V_DiskAvg) if (RegCheckErr(Buf, RoutineName)) return - ! yaw call RegPack(Buf, InData%yaw) if (RegCheckErr(Buf, RoutineName)) return - ! tilt call RegPack(Buf, InData%tilt) if (RegCheckErr(Buf, RoutineName)) return - ! hub_theta_x_root call RegPack(Buf, allocated(InData%hub_theta_x_root)) if (allocated(InData%hub_theta_x_root)) then call RegPackBounds(Buf, 1, lbound(InData%hub_theta_x_root), ubound(InData%hub_theta_x_root)) call RegPack(Buf, InData%hub_theta_x_root) end if if (RegCheckErr(Buf, RoutineName)) return - ! V_dot_x call RegPack(Buf, InData%V_dot_x) if (RegCheckErr(Buf, RoutineName)) return - ! HubLoad call MeshPack(Buf, InData%HubLoad) if (RegCheckErr(Buf, RoutineName)) return - ! B_L_2_H_P call RegPack(Buf, allocated(InData%B_L_2_H_P)) if (allocated(InData%B_L_2_H_P)) then call RegPackBounds(Buf, 1, lbound(InData%B_L_2_H_P), ubound(InData%B_L_2_H_P)) @@ -5065,84 +4666,72 @@ subroutine AD_PackRotMiscVarType(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! SigmaCavitCrit call RegPack(Buf, allocated(InData%SigmaCavitCrit)) if (allocated(InData%SigmaCavitCrit)) then call RegPackBounds(Buf, 2, lbound(InData%SigmaCavitCrit), ubound(InData%SigmaCavitCrit)) call RegPack(Buf, InData%SigmaCavitCrit) end if if (RegCheckErr(Buf, RoutineName)) return - ! SigmaCavit call RegPack(Buf, allocated(InData%SigmaCavit)) if (allocated(InData%SigmaCavit)) then call RegPackBounds(Buf, 2, lbound(InData%SigmaCavit), ubound(InData%SigmaCavit)) call RegPack(Buf, InData%SigmaCavit) end if if (RegCheckErr(Buf, RoutineName)) return - ! CavitWarnSet call RegPack(Buf, allocated(InData%CavitWarnSet)) if (allocated(InData%CavitWarnSet)) then call RegPackBounds(Buf, 2, lbound(InData%CavitWarnSet), ubound(InData%CavitWarnSet)) call RegPack(Buf, InData%CavitWarnSet) end if if (RegCheckErr(Buf, RoutineName)) return - ! BlFB call RegPack(Buf, allocated(InData%BlFB)) if (allocated(InData%BlFB)) then call RegPackBounds(Buf, 3, lbound(InData%BlFB), ubound(InData%BlFB)) call RegPack(Buf, InData%BlFB) end if if (RegCheckErr(Buf, RoutineName)) return - ! BlMB call RegPack(Buf, allocated(InData%BlMB)) if (allocated(InData%BlMB)) then call RegPackBounds(Buf, 3, lbound(InData%BlMB), ubound(InData%BlMB)) call RegPack(Buf, InData%BlMB) end if if (RegCheckErr(Buf, RoutineName)) return - ! TwrFB call RegPack(Buf, allocated(InData%TwrFB)) if (allocated(InData%TwrFB)) then call RegPackBounds(Buf, 2, lbound(InData%TwrFB), ubound(InData%TwrFB)) call RegPack(Buf, InData%TwrFB) end if if (RegCheckErr(Buf, RoutineName)) return - ! TwrMB call RegPack(Buf, allocated(InData%TwrMB)) if (allocated(InData%TwrMB)) then call RegPackBounds(Buf, 2, lbound(InData%TwrMB), ubound(InData%TwrMB)) call RegPack(Buf, InData%TwrMB) end if if (RegCheckErr(Buf, RoutineName)) return - ! HubFB call RegPack(Buf, allocated(InData%HubFB)) if (allocated(InData%HubFB)) then call RegPackBounds(Buf, 1, lbound(InData%HubFB), ubound(InData%HubFB)) call RegPack(Buf, InData%HubFB) end if if (RegCheckErr(Buf, RoutineName)) return - ! HubMB call RegPack(Buf, allocated(InData%HubMB)) if (allocated(InData%HubMB)) then call RegPackBounds(Buf, 1, lbound(InData%HubMB), ubound(InData%HubMB)) call RegPack(Buf, InData%HubMB) end if if (RegCheckErr(Buf, RoutineName)) return - ! NacFB call RegPack(Buf, allocated(InData%NacFB)) if (allocated(InData%NacFB)) then call RegPackBounds(Buf, 1, lbound(InData%NacFB), ubound(InData%NacFB)) call RegPack(Buf, InData%NacFB) end if if (RegCheckErr(Buf, RoutineName)) return - ! NacMB call RegPack(Buf, allocated(InData%NacMB)) if (allocated(InData%NacMB)) then call RegPackBounds(Buf, 1, lbound(InData%NacMB), ubound(InData%NacMB)) call RegPack(Buf, InData%NacMB) end if if (RegCheckErr(Buf, RoutineName)) return - ! BladeRootLoad call RegPack(Buf, allocated(InData%BladeRootLoad)) if (allocated(InData%BladeRootLoad)) then call RegPackBounds(Buf, 1, lbound(InData%BladeRootLoad), ubound(InData%BladeRootLoad)) @@ -5153,7 +4742,6 @@ subroutine AD_PackRotMiscVarType(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! B_L_2_R_P call RegPack(Buf, allocated(InData%B_L_2_R_P)) if (allocated(InData%B_L_2_R_P)) then call RegPackBounds(Buf, 1, lbound(InData%B_L_2_R_P), ubound(InData%B_L_2_R_P)) @@ -5164,7 +4752,6 @@ subroutine AD_PackRotMiscVarType(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! BladeBuoyLoadPoint call RegPack(Buf, allocated(InData%BladeBuoyLoadPoint)) if (allocated(InData%BladeBuoyLoadPoint)) then call RegPackBounds(Buf, 1, lbound(InData%BladeBuoyLoadPoint), ubound(InData%BladeBuoyLoadPoint)) @@ -5175,7 +4762,6 @@ subroutine AD_PackRotMiscVarType(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! BladeBuoyLoad call RegPack(Buf, allocated(InData%BladeBuoyLoad)) if (allocated(InData%BladeBuoyLoad)) then call RegPackBounds(Buf, 1, lbound(InData%BladeBuoyLoad), ubound(InData%BladeBuoyLoad)) @@ -5186,7 +4772,6 @@ subroutine AD_PackRotMiscVarType(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! B_P_2_B_L call RegPack(Buf, allocated(InData%B_P_2_B_L)) if (allocated(InData%B_P_2_B_L)) then call RegPackBounds(Buf, 1, lbound(InData%B_P_2_B_L), ubound(InData%B_P_2_B_L)) @@ -5197,49 +4782,34 @@ subroutine AD_PackRotMiscVarType(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! TwrBuoyLoadPoint call MeshPack(Buf, InData%TwrBuoyLoadPoint) if (RegCheckErr(Buf, RoutineName)) return - ! TwrBuoyLoad call MeshPack(Buf, InData%TwrBuoyLoad) if (RegCheckErr(Buf, RoutineName)) return - ! T_P_2_T_L call NWTC_Library_PackMeshMapType(Buf, InData%T_P_2_T_L) if (RegCheckErr(Buf, RoutineName)) return - ! FirstWarn_TowerStrike call RegPack(Buf, InData%FirstWarn_TowerStrike) if (RegCheckErr(Buf, RoutineName)) return - ! AvgDiskVel call RegPack(Buf, InData%AvgDiskVel) if (RegCheckErr(Buf, RoutineName)) return - ! AvgDiskVelDist call RegPack(Buf, InData%AvgDiskVelDist) if (RegCheckErr(Buf, RoutineName)) return - ! TFinAlpha call RegPack(Buf, InData%TFinAlpha) if (RegCheckErr(Buf, RoutineName)) return - ! TFinRe call RegPack(Buf, InData%TFinRe) if (RegCheckErr(Buf, RoutineName)) return - ! TFinVrel call RegPack(Buf, InData%TFinVrel) if (RegCheckErr(Buf, RoutineName)) return - ! TFinVund_i call RegPack(Buf, InData%TFinVund_i) if (RegCheckErr(Buf, RoutineName)) return - ! TFinVind_i call RegPack(Buf, InData%TFinVind_i) if (RegCheckErr(Buf, RoutineName)) return - ! TFinVrel_i call RegPack(Buf, InData%TFinVrel_i) if (RegCheckErr(Buf, RoutineName)) return - ! TFinSTV_i call RegPack(Buf, InData%TFinSTV_i) if (RegCheckErr(Buf, RoutineName)) return - ! TFinF_i call RegPack(Buf, InData%TFinF_i) if (RegCheckErr(Buf, RoutineName)) return - ! TFinM_i call RegPack(Buf, InData%TFinM_i) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -5253,23 +4823,16 @@ subroutine AD_UnPackRotMiscVarType(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! BEMT call BEMT_UnpackMisc(Buf, OutData%BEMT) ! BEMT - ! BEMT_y call BEMT_UnpackOutput(Buf, OutData%BEMT_y) ! BEMT_y - ! BEMT_u LB(1:1) = lbound(OutData%BEMT_u) UB(1:1) = ubound(OutData%BEMT_u) do i1 = LB(1), UB(1) call BEMT_UnpackInput(Buf, OutData%BEMT_u(i1)) ! BEMT_u end do - ! AA call AA_UnpackMisc(Buf, OutData%AA) ! AA - ! AA_y call AA_UnpackOutput(Buf, OutData%AA_y) ! AA_y - ! AA_u call AA_UnpackInput(Buf, OutData%AA_u) ! AA_u - ! DisturbedInflow if (allocated(OutData%DisturbedInflow)) deallocate(OutData%DisturbedInflow) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5284,7 +4847,6 @@ subroutine AD_UnPackRotMiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%DisturbedInflow) if (RegCheckErr(Buf, RoutineName)) return end if - ! orientationAnnulus if (allocated(OutData%orientationAnnulus)) deallocate(OutData%orientationAnnulus) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5299,7 +4861,6 @@ subroutine AD_UnPackRotMiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%orientationAnnulus) if (RegCheckErr(Buf, RoutineName)) return end if - ! AllOuts if (allocated(OutData%AllOuts)) deallocate(OutData%AllOuts) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5314,7 +4875,6 @@ subroutine AD_UnPackRotMiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%AllOuts) if (RegCheckErr(Buf, RoutineName)) return end if - ! W_Twr if (allocated(OutData%W_Twr)) deallocate(OutData%W_Twr) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5329,7 +4889,6 @@ subroutine AD_UnPackRotMiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%W_Twr) if (RegCheckErr(Buf, RoutineName)) return end if - ! X_Twr if (allocated(OutData%X_Twr)) deallocate(OutData%X_Twr) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5344,7 +4903,6 @@ subroutine AD_UnPackRotMiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%X_Twr) if (RegCheckErr(Buf, RoutineName)) return end if - ! Y_Twr if (allocated(OutData%Y_Twr)) deallocate(OutData%Y_Twr) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5359,7 +4917,6 @@ subroutine AD_UnPackRotMiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%Y_Twr) if (RegCheckErr(Buf, RoutineName)) return end if - ! Curve if (allocated(OutData%Curve)) deallocate(OutData%Curve) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5374,7 +4931,6 @@ subroutine AD_UnPackRotMiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%Curve) if (RegCheckErr(Buf, RoutineName)) return end if - ! TwrClrnc if (allocated(OutData%TwrClrnc)) deallocate(OutData%TwrClrnc) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5389,7 +4945,6 @@ subroutine AD_UnPackRotMiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%TwrClrnc) if (RegCheckErr(Buf, RoutineName)) return end if - ! X if (allocated(OutData%X)) deallocate(OutData%X) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5404,7 +4959,6 @@ subroutine AD_UnPackRotMiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%X) if (RegCheckErr(Buf, RoutineName)) return end if - ! Y if (allocated(OutData%Y)) deallocate(OutData%Y) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5419,7 +4973,6 @@ subroutine AD_UnPackRotMiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%Y) if (RegCheckErr(Buf, RoutineName)) return end if - ! Z if (allocated(OutData%Z)) deallocate(OutData%Z) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5434,7 +4987,6 @@ subroutine AD_UnPackRotMiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%Z) if (RegCheckErr(Buf, RoutineName)) return end if - ! M if (allocated(OutData%M)) deallocate(OutData%M) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5449,7 +5001,6 @@ subroutine AD_UnPackRotMiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%M) if (RegCheckErr(Buf, RoutineName)) return end if - ! Mx if (allocated(OutData%Mx)) deallocate(OutData%Mx) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5464,7 +5015,6 @@ subroutine AD_UnPackRotMiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%Mx) if (RegCheckErr(Buf, RoutineName)) return end if - ! My if (allocated(OutData%My)) deallocate(OutData%My) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5479,7 +5029,6 @@ subroutine AD_UnPackRotMiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%My) if (RegCheckErr(Buf, RoutineName)) return end if - ! Mz if (allocated(OutData%Mz)) deallocate(OutData%Mz) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5494,16 +5043,12 @@ subroutine AD_UnPackRotMiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%Mz) if (RegCheckErr(Buf, RoutineName)) return end if - ! V_DiskAvg call RegUnpack(Buf, OutData%V_DiskAvg) if (RegCheckErr(Buf, RoutineName)) return - ! yaw call RegUnpack(Buf, OutData%yaw) if (RegCheckErr(Buf, RoutineName)) return - ! tilt call RegUnpack(Buf, OutData%tilt) if (RegCheckErr(Buf, RoutineName)) return - ! hub_theta_x_root if (allocated(OutData%hub_theta_x_root)) deallocate(OutData%hub_theta_x_root) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5518,12 +5063,9 @@ subroutine AD_UnPackRotMiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%hub_theta_x_root) if (RegCheckErr(Buf, RoutineName)) return end if - ! V_dot_x call RegUnpack(Buf, OutData%V_dot_x) if (RegCheckErr(Buf, RoutineName)) return - ! HubLoad call MeshUnpack(Buf, OutData%HubLoad) ! HubLoad - ! B_L_2_H_P if (allocated(OutData%B_L_2_H_P)) deallocate(OutData%B_L_2_H_P) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5539,7 +5081,6 @@ subroutine AD_UnPackRotMiscVarType(Buf, OutData) call NWTC_Library_UnpackMeshMapType(Buf, OutData%B_L_2_H_P(i1)) ! B_L_2_H_P end do end if - ! SigmaCavitCrit if (allocated(OutData%SigmaCavitCrit)) deallocate(OutData%SigmaCavitCrit) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5554,7 +5095,6 @@ subroutine AD_UnPackRotMiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%SigmaCavitCrit) if (RegCheckErr(Buf, RoutineName)) return end if - ! SigmaCavit if (allocated(OutData%SigmaCavit)) deallocate(OutData%SigmaCavit) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5569,7 +5109,6 @@ subroutine AD_UnPackRotMiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%SigmaCavit) if (RegCheckErr(Buf, RoutineName)) return end if - ! CavitWarnSet if (allocated(OutData%CavitWarnSet)) deallocate(OutData%CavitWarnSet) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5584,7 +5123,6 @@ subroutine AD_UnPackRotMiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%CavitWarnSet) if (RegCheckErr(Buf, RoutineName)) return end if - ! BlFB if (allocated(OutData%BlFB)) deallocate(OutData%BlFB) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5599,7 +5137,6 @@ subroutine AD_UnPackRotMiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%BlFB) if (RegCheckErr(Buf, RoutineName)) return end if - ! BlMB if (allocated(OutData%BlMB)) deallocate(OutData%BlMB) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5614,7 +5151,6 @@ subroutine AD_UnPackRotMiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%BlMB) if (RegCheckErr(Buf, RoutineName)) return end if - ! TwrFB if (allocated(OutData%TwrFB)) deallocate(OutData%TwrFB) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5629,7 +5165,6 @@ subroutine AD_UnPackRotMiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%TwrFB) if (RegCheckErr(Buf, RoutineName)) return end if - ! TwrMB if (allocated(OutData%TwrMB)) deallocate(OutData%TwrMB) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5644,7 +5179,6 @@ subroutine AD_UnPackRotMiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%TwrMB) if (RegCheckErr(Buf, RoutineName)) return end if - ! HubFB if (allocated(OutData%HubFB)) deallocate(OutData%HubFB) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5659,7 +5193,6 @@ subroutine AD_UnPackRotMiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%HubFB) if (RegCheckErr(Buf, RoutineName)) return end if - ! HubMB if (allocated(OutData%HubMB)) deallocate(OutData%HubMB) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5674,7 +5207,6 @@ subroutine AD_UnPackRotMiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%HubMB) if (RegCheckErr(Buf, RoutineName)) return end if - ! NacFB if (allocated(OutData%NacFB)) deallocate(OutData%NacFB) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5689,7 +5221,6 @@ subroutine AD_UnPackRotMiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%NacFB) if (RegCheckErr(Buf, RoutineName)) return end if - ! NacMB if (allocated(OutData%NacMB)) deallocate(OutData%NacMB) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5704,7 +5235,6 @@ subroutine AD_UnPackRotMiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%NacMB) if (RegCheckErr(Buf, RoutineName)) return end if - ! BladeRootLoad if (allocated(OutData%BladeRootLoad)) deallocate(OutData%BladeRootLoad) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5720,7 +5250,6 @@ subroutine AD_UnPackRotMiscVarType(Buf, OutData) call MeshUnpack(Buf, OutData%BladeRootLoad(i1)) ! BladeRootLoad end do end if - ! B_L_2_R_P if (allocated(OutData%B_L_2_R_P)) deallocate(OutData%B_L_2_R_P) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5736,7 +5265,6 @@ subroutine AD_UnPackRotMiscVarType(Buf, OutData) call NWTC_Library_UnpackMeshMapType(Buf, OutData%B_L_2_R_P(i1)) ! B_L_2_R_P end do end if - ! BladeBuoyLoadPoint if (allocated(OutData%BladeBuoyLoadPoint)) deallocate(OutData%BladeBuoyLoadPoint) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5752,7 +5280,6 @@ subroutine AD_UnPackRotMiscVarType(Buf, OutData) call MeshUnpack(Buf, OutData%BladeBuoyLoadPoint(i1)) ! BladeBuoyLoadPoint end do end if - ! BladeBuoyLoad if (allocated(OutData%BladeBuoyLoad)) deallocate(OutData%BladeBuoyLoad) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5768,7 +5295,6 @@ subroutine AD_UnPackRotMiscVarType(Buf, OutData) call MeshUnpack(Buf, OutData%BladeBuoyLoad(i1)) ! BladeBuoyLoad end do end if - ! B_P_2_B_L if (allocated(OutData%B_P_2_B_L)) deallocate(OutData%B_P_2_B_L) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5784,189 +5310,173 @@ subroutine AD_UnPackRotMiscVarType(Buf, OutData) call NWTC_Library_UnpackMeshMapType(Buf, OutData%B_P_2_B_L(i1)) ! B_P_2_B_L end do end if - ! TwrBuoyLoadPoint call MeshUnpack(Buf, OutData%TwrBuoyLoadPoint) ! TwrBuoyLoadPoint - ! TwrBuoyLoad call MeshUnpack(Buf, OutData%TwrBuoyLoad) ! TwrBuoyLoad - ! T_P_2_T_L call NWTC_Library_UnpackMeshMapType(Buf, OutData%T_P_2_T_L) ! T_P_2_T_L - ! FirstWarn_TowerStrike call RegUnpack(Buf, OutData%FirstWarn_TowerStrike) if (RegCheckErr(Buf, RoutineName)) return - ! AvgDiskVel call RegUnpack(Buf, OutData%AvgDiskVel) if (RegCheckErr(Buf, RoutineName)) return - ! AvgDiskVelDist call RegUnpack(Buf, OutData%AvgDiskVelDist) if (RegCheckErr(Buf, RoutineName)) return - ! TFinAlpha call RegUnpack(Buf, OutData%TFinAlpha) if (RegCheckErr(Buf, RoutineName)) return - ! TFinRe call RegUnpack(Buf, OutData%TFinRe) if (RegCheckErr(Buf, RoutineName)) return - ! TFinVrel call RegUnpack(Buf, OutData%TFinVrel) if (RegCheckErr(Buf, RoutineName)) return - ! TFinVund_i call RegUnpack(Buf, OutData%TFinVund_i) if (RegCheckErr(Buf, RoutineName)) return - ! TFinVind_i call RegUnpack(Buf, OutData%TFinVind_i) if (RegCheckErr(Buf, RoutineName)) return - ! TFinVrel_i call RegUnpack(Buf, OutData%TFinVrel_i) if (RegCheckErr(Buf, RoutineName)) return - ! TFinSTV_i call RegUnpack(Buf, OutData%TFinSTV_i) if (RegCheckErr(Buf, RoutineName)) return - ! TFinF_i call RegUnpack(Buf, OutData%TFinF_i) if (RegCheckErr(Buf, RoutineName)) return - ! TFinM_i call RegUnpack(Buf, OutData%TFinM_i) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE AD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD_MiscVarType), INTENT(INOUT) :: SrcMiscData - TYPE(AD_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - 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_CopyMisc' -! + +subroutine AD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(AD_MiscVarType), intent(inout) :: SrcMiscData + type(AD_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyMisc' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscData%rotors)) THEN - i1_l = LBOUND(SrcMiscData%rotors,1) - i1_u = UBOUND(SrcMiscData%rotors,1) - IF (.NOT. ALLOCATED(DstMiscData%rotors)) THEN - ALLOCATE(DstMiscData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%rotors,1), UBOUND(SrcMiscData%rotors,1) - CALL AD_Copyrotmiscvartype( SrcMiscData%rotors(i1), DstMiscData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%FVW_u)) THEN - i1_l = LBOUND(SrcMiscData%FVW_u,1) - i1_u = UBOUND(SrcMiscData%FVW_u,1) - IF (.NOT. ALLOCATED(DstMiscData%FVW_u)) THEN - ALLOCATE(DstMiscData%FVW_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FVW_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%FVW_u,1), UBOUND(SrcMiscData%FVW_u,1) - CALL FVW_CopyInput( SrcMiscData%FVW_u(i1), DstMiscData%FVW_u(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL FVW_CopyOutput( SrcMiscData%FVW_y, DstMiscData%FVW_y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FVW_CopyMisc( SrcMiscData%FVW, DstMiscData%FVW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMiscData%WindPos)) THEN - i1_l = LBOUND(SrcMiscData%WindPos,1) - i1_u = UBOUND(SrcMiscData%WindPos,1) - i2_l = LBOUND(SrcMiscData%WindPos,2) - i2_u = UBOUND(SrcMiscData%WindPos,2) - IF (.NOT. ALLOCATED(DstMiscData%WindPos)) THEN - ALLOCATE(DstMiscData%WindPos(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindPos.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%WindPos = SrcMiscData%WindPos -ENDIF -IF (ALLOCATED(SrcMiscData%WindVel)) THEN - i1_l = LBOUND(SrcMiscData%WindVel,1) - i1_u = UBOUND(SrcMiscData%WindVel,1) - i2_l = LBOUND(SrcMiscData%WindVel,2) - i2_u = UBOUND(SrcMiscData%WindVel,2) - IF (.NOT. ALLOCATED(DstMiscData%WindVel)) THEN - ALLOCATE(DstMiscData%WindVel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%WindVel = SrcMiscData%WindVel -ENDIF -IF (ALLOCATED(SrcMiscData%WindAcc)) THEN - i1_l = LBOUND(SrcMiscData%WindAcc,1) - i1_u = UBOUND(SrcMiscData%WindAcc,1) - i2_l = LBOUND(SrcMiscData%WindAcc,2) - i2_u = UBOUND(SrcMiscData%WindAcc,2) - IF (.NOT. ALLOCATED(DstMiscData%WindAcc)) THEN - ALLOCATE(DstMiscData%WindAcc(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindAcc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%WindAcc = SrcMiscData%WindAcc -ENDIF - END SUBROUTINE AD_CopyMisc - - SUBROUTINE AD_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(AD_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MiscData%rotors)) THEN -DO i1 = LBOUND(MiscData%rotors,1), UBOUND(MiscData%rotors,1) - CALL AD_DestroyRotMiscVarType( MiscData%rotors(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%rotors) -ENDIF -IF (ALLOCATED(MiscData%FVW_u)) THEN -DO i1 = LBOUND(MiscData%FVW_u,1), UBOUND(MiscData%FVW_u,1) - CALL FVW_DestroyInput( MiscData%FVW_u(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%FVW_u) -ENDIF - CALL FVW_DestroyOutput( MiscData%FVW_y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FVW_DestroyMisc( MiscData%FVW, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MiscData%WindPos)) THEN - DEALLOCATE(MiscData%WindPos) -ENDIF -IF (ALLOCATED(MiscData%WindVel)) THEN - DEALLOCATE(MiscData%WindVel) -ENDIF -IF (ALLOCATED(MiscData%WindAcc)) THEN - DEALLOCATE(MiscData%WindAcc) -ENDIF - END SUBROUTINE AD_DestroyMisc + ErrMsg = '' + if (allocated(SrcMiscData%rotors)) then + LB(1:1) = lbound(SrcMiscData%rotors) + UB(1:1) = ubound(SrcMiscData%rotors) + if (.not. allocated(DstMiscData%rotors)) then + allocate(DstMiscData%rotors(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rotors.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyRotMiscVarType(SrcMiscData%rotors(i1), DstMiscData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstMiscData%rotors)) then + deallocate(DstMiscData%rotors) + end if + if (allocated(SrcMiscData%FVW_u)) then + LB(1:1) = lbound(SrcMiscData%FVW_u) + UB(1:1) = ubound(SrcMiscData%FVW_u) + if (.not. allocated(DstMiscData%FVW_u)) then + allocate(DstMiscData%FVW_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FVW_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FVW_CopyInput(SrcMiscData%FVW_u(i1), DstMiscData%FVW_u(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstMiscData%FVW_u)) then + deallocate(DstMiscData%FVW_u) + end if + call FVW_CopyOutput(SrcMiscData%FVW_y, DstMiscData%FVW_y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FVW_CopyMisc(SrcMiscData%FVW, DstMiscData%FVW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMiscData%WindPos)) then + LB(1:2) = lbound(SrcMiscData%WindPos) + UB(1:2) = ubound(SrcMiscData%WindPos) + if (.not. allocated(DstMiscData%WindPos)) then + allocate(DstMiscData%WindPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindPos.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%WindPos = SrcMiscData%WindPos + else if (allocated(DstMiscData%WindPos)) then + deallocate(DstMiscData%WindPos) + end if + if (allocated(SrcMiscData%WindVel)) then + LB(1:2) = lbound(SrcMiscData%WindVel) + UB(1:2) = ubound(SrcMiscData%WindVel) + if (.not. allocated(DstMiscData%WindVel)) then + allocate(DstMiscData%WindVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindVel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%WindVel = SrcMiscData%WindVel + else if (allocated(DstMiscData%WindVel)) then + deallocate(DstMiscData%WindVel) + end if + if (allocated(SrcMiscData%WindAcc)) then + LB(1:2) = lbound(SrcMiscData%WindAcc) + UB(1:2) = ubound(SrcMiscData%WindAcc) + if (.not. allocated(DstMiscData%WindAcc)) then + allocate(DstMiscData%WindAcc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindAcc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%WindAcc = SrcMiscData%WindAcc + else if (allocated(DstMiscData%WindAcc)) then + deallocate(DstMiscData%WindAcc) + end if +end subroutine +subroutine AD_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(AD_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%rotors)) then + LB(1:1) = lbound(MiscData%rotors) + UB(1:1) = ubound(MiscData%rotors) + do i1 = LB(1), UB(1) + call AD_DestroyRotMiscVarType(MiscData%rotors(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%rotors) + end if + if (allocated(MiscData%FVW_u)) then + LB(1:1) = lbound(MiscData%FVW_u) + UB(1:1) = ubound(MiscData%FVW_u) + do i1 = LB(1), UB(1) + call FVW_DestroyInput(MiscData%FVW_u(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%FVW_u) + end if + if (allocated(MiscData%WindPos)) then + deallocate(MiscData%WindPos) + end if + if (allocated(MiscData%WindVel)) then + deallocate(MiscData%WindVel) + end if + if (allocated(MiscData%WindAcc)) then + deallocate(MiscData%WindAcc) + end if +end subroutine subroutine AD_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -5975,7 +5485,6 @@ subroutine AD_PackMisc(Buf, Indata) integer(IntKi) :: i1, i2 integer(IntKi) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return - ! rotors call RegPack(Buf, allocated(InData%rotors)) if (allocated(InData%rotors)) then call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) @@ -5986,7 +5495,6 @@ subroutine AD_PackMisc(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! FVW_u call RegPack(Buf, allocated(InData%FVW_u)) if (allocated(InData%FVW_u)) then call RegPackBounds(Buf, 1, lbound(InData%FVW_u), ubound(InData%FVW_u)) @@ -5997,27 +5505,22 @@ subroutine AD_PackMisc(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! FVW_y call FVW_PackOutput(Buf, InData%FVW_y) if (RegCheckErr(Buf, RoutineName)) return - ! FVW call FVW_PackMisc(Buf, InData%FVW) if (RegCheckErr(Buf, RoutineName)) return - ! WindPos call RegPack(Buf, allocated(InData%WindPos)) if (allocated(InData%WindPos)) then call RegPackBounds(Buf, 2, lbound(InData%WindPos), ubound(InData%WindPos)) call RegPack(Buf, InData%WindPos) end if if (RegCheckErr(Buf, RoutineName)) return - ! WindVel call RegPack(Buf, allocated(InData%WindVel)) if (allocated(InData%WindVel)) then call RegPackBounds(Buf, 2, lbound(InData%WindVel), ubound(InData%WindVel)) call RegPack(Buf, InData%WindVel) end if if (RegCheckErr(Buf, RoutineName)) return - ! WindAcc call RegPack(Buf, allocated(InData%WindAcc)) if (allocated(InData%WindAcc)) then call RegPackBounds(Buf, 2, lbound(InData%WindAcc), ubound(InData%WindAcc)) @@ -6035,7 +5538,6 @@ subroutine AD_UnPackMisc(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! rotors if (allocated(OutData%rotors)) deallocate(OutData%rotors) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6051,7 +5553,6 @@ subroutine AD_UnPackMisc(Buf, OutData) call AD_UnpackRotMiscVarType(Buf, OutData%rotors(i1)) ! rotors end do end if - ! FVW_u if (allocated(OutData%FVW_u)) deallocate(OutData%FVW_u) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6067,11 +5568,8 @@ subroutine AD_UnPackMisc(Buf, OutData) call FVW_UnpackInput(Buf, OutData%FVW_u(i1)) ! FVW_u end do end if - ! FVW_y call FVW_UnpackOutput(Buf, OutData%FVW_y) ! FVW_y - ! FVW call FVW_UnpackMisc(Buf, OutData%FVW) ! FVW - ! WindPos if (allocated(OutData%WindPos)) deallocate(OutData%WindPos) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6086,7 +5584,6 @@ subroutine AD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%WindPos) if (RegCheckErr(Buf, RoutineName)) return end if - ! WindVel if (allocated(OutData%WindVel)) deallocate(OutData%WindVel) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6101,7 +5598,6 @@ subroutine AD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%WindVel) if (RegCheckErr(Buf, RoutineName)) return end if - ! WindAcc if (allocated(OutData%WindAcc)) deallocate(OutData%WindAcc) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6117,440 +5613,459 @@ subroutine AD_UnPackMisc(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE AD_CopyRotParameterType( SrcRotParameterTypeData, DstRotParameterTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(RotParameterType), INTENT(IN) :: SrcRotParameterTypeData - TYPE(RotParameterType), INTENT(INOUT) :: DstRotParameterTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_CopyRotParameterType' -! + +subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeData, CtrlCode, ErrStat, ErrMsg) + type(RotParameterType), intent(in) :: SrcRotParameterTypeData + type(RotParameterType), intent(inout) :: DstRotParameterTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyRotParameterType' ErrStat = ErrID_None - ErrMsg = "" - DstRotParameterTypeData%NumBlades = SrcRotParameterTypeData%NumBlades - DstRotParameterTypeData%NumBlNds = SrcRotParameterTypeData%NumBlNds - DstRotParameterTypeData%NumTwrNds = SrcRotParameterTypeData%NumTwrNds -IF (ALLOCATED(SrcRotParameterTypeData%TwrDiam)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%TwrDiam,1) - i1_u = UBOUND(SrcRotParameterTypeData%TwrDiam,1) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%TwrDiam)) THEN - ALLOCATE(DstRotParameterTypeData%TwrDiam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrDiam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%TwrDiam = SrcRotParameterTypeData%TwrDiam -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%TwrCd)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%TwrCd,1) - i1_u = UBOUND(SrcRotParameterTypeData%TwrCd,1) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%TwrCd)) THEN - ALLOCATE(DstRotParameterTypeData%TwrCd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrCd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%TwrCd = SrcRotParameterTypeData%TwrCd -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%TwrTI)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%TwrTI,1) - i1_u = UBOUND(SrcRotParameterTypeData%TwrTI,1) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%TwrTI)) THEN - ALLOCATE(DstRotParameterTypeData%TwrTI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrTI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%TwrTI = SrcRotParameterTypeData%TwrTI -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%BlTwist)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%BlTwist,1) - i1_u = UBOUND(SrcRotParameterTypeData%BlTwist,1) - i2_l = LBOUND(SrcRotParameterTypeData%BlTwist,2) - i2_u = UBOUND(SrcRotParameterTypeData%BlTwist,2) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%BlTwist)) THEN - ALLOCATE(DstRotParameterTypeData%BlTwist(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlTwist.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%BlTwist = SrcRotParameterTypeData%BlTwist -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%TwrCb)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%TwrCb,1) - i1_u = UBOUND(SrcRotParameterTypeData%TwrCb,1) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%TwrCb)) THEN - ALLOCATE(DstRotParameterTypeData%TwrCb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrCb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%TwrCb = SrcRotParameterTypeData%TwrCb -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%BlCenBn)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%BlCenBn,1) - i1_u = UBOUND(SrcRotParameterTypeData%BlCenBn,1) - i2_l = LBOUND(SrcRotParameterTypeData%BlCenBn,2) - i2_u = UBOUND(SrcRotParameterTypeData%BlCenBn,2) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%BlCenBn)) THEN - ALLOCATE(DstRotParameterTypeData%BlCenBn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlCenBn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%BlCenBn = SrcRotParameterTypeData%BlCenBn -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%BlCenBt)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%BlCenBt,1) - i1_u = UBOUND(SrcRotParameterTypeData%BlCenBt,1) - i2_l = LBOUND(SrcRotParameterTypeData%BlCenBt,2) - i2_u = UBOUND(SrcRotParameterTypeData%BlCenBt,2) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%BlCenBt)) THEN - ALLOCATE(DstRotParameterTypeData%BlCenBt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlCenBt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%BlCenBt = SrcRotParameterTypeData%BlCenBt -ENDIF - DstRotParameterTypeData%VolHub = SrcRotParameterTypeData%VolHub - DstRotParameterTypeData%HubCenBx = SrcRotParameterTypeData%HubCenBx - DstRotParameterTypeData%VolNac = SrcRotParameterTypeData%VolNac - DstRotParameterTypeData%NacCenB = SrcRotParameterTypeData%NacCenB - DstRotParameterTypeData%VolBl = SrcRotParameterTypeData%VolBl - DstRotParameterTypeData%VolTwr = SrcRotParameterTypeData%VolTwr -IF (ALLOCATED(SrcRotParameterTypeData%BlRad)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%BlRad,1) - i1_u = UBOUND(SrcRotParameterTypeData%BlRad,1) - i2_l = LBOUND(SrcRotParameterTypeData%BlRad,2) - i2_u = UBOUND(SrcRotParameterTypeData%BlRad,2) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%BlRad)) THEN - ALLOCATE(DstRotParameterTypeData%BlRad(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlRad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%BlRad = SrcRotParameterTypeData%BlRad -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%BlDL)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%BlDL,1) - i1_u = UBOUND(SrcRotParameterTypeData%BlDL,1) - i2_l = LBOUND(SrcRotParameterTypeData%BlDL,2) - i2_u = UBOUND(SrcRotParameterTypeData%BlDL,2) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%BlDL)) THEN - ALLOCATE(DstRotParameterTypeData%BlDL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlDL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%BlDL = SrcRotParameterTypeData%BlDL -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%BlTaper)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%BlTaper,1) - i1_u = UBOUND(SrcRotParameterTypeData%BlTaper,1) - i2_l = LBOUND(SrcRotParameterTypeData%BlTaper,2) - i2_u = UBOUND(SrcRotParameterTypeData%BlTaper,2) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%BlTaper)) THEN - ALLOCATE(DstRotParameterTypeData%BlTaper(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlTaper.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%BlTaper = SrcRotParameterTypeData%BlTaper -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%BlAxCent)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%BlAxCent,1) - i1_u = UBOUND(SrcRotParameterTypeData%BlAxCent,1) - i2_l = LBOUND(SrcRotParameterTypeData%BlAxCent,2) - i2_u = UBOUND(SrcRotParameterTypeData%BlAxCent,2) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%BlAxCent)) THEN - ALLOCATE(DstRotParameterTypeData%BlAxCent(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlAxCent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%BlAxCent = SrcRotParameterTypeData%BlAxCent -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%TwrRad)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%TwrRad,1) - i1_u = UBOUND(SrcRotParameterTypeData%TwrRad,1) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%TwrRad)) THEN - ALLOCATE(DstRotParameterTypeData%TwrRad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrRad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%TwrRad = SrcRotParameterTypeData%TwrRad -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%TwrDL)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%TwrDL,1) - i1_u = UBOUND(SrcRotParameterTypeData%TwrDL,1) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%TwrDL)) THEN - ALLOCATE(DstRotParameterTypeData%TwrDL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrDL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%TwrDL = SrcRotParameterTypeData%TwrDL -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%TwrTaper)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%TwrTaper,1) - i1_u = UBOUND(SrcRotParameterTypeData%TwrTaper,1) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%TwrTaper)) THEN - ALLOCATE(DstRotParameterTypeData%TwrTaper(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrTaper.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%TwrTaper = SrcRotParameterTypeData%TwrTaper -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%TwrAxCent)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%TwrAxCent,1) - i1_u = UBOUND(SrcRotParameterTypeData%TwrAxCent,1) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%TwrAxCent)) THEN - ALLOCATE(DstRotParameterTypeData%TwrAxCent(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrAxCent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%TwrAxCent = SrcRotParameterTypeData%TwrAxCent -ENDIF - CALL BEMT_CopyParam( SrcRotParameterTypeData%BEMT, DstRotParameterTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AA_CopyParam( SrcRotParameterTypeData%AA, DstRotParameterTypeData%AA, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcRotParameterTypeData%Jac_u_indx)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%Jac_u_indx,1) - i1_u = UBOUND(SrcRotParameterTypeData%Jac_u_indx,1) - i2_l = LBOUND(SrcRotParameterTypeData%Jac_u_indx,2) - i2_u = UBOUND(SrcRotParameterTypeData%Jac_u_indx,2) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%Jac_u_indx)) THEN - ALLOCATE(DstRotParameterTypeData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%Jac_u_indx = SrcRotParameterTypeData%Jac_u_indx -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%du)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%du,1) - i1_u = UBOUND(SrcRotParameterTypeData%du,1) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%du)) THEN - ALLOCATE(DstRotParameterTypeData%du(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%du.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%du = SrcRotParameterTypeData%du -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%dx)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%dx,1) - i1_u = UBOUND(SrcRotParameterTypeData%dx,1) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%dx)) THEN - ALLOCATE(DstRotParameterTypeData%dx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%dx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%dx = SrcRotParameterTypeData%dx -ENDIF - DstRotParameterTypeData%Jac_ny = SrcRotParameterTypeData%Jac_ny - DstRotParameterTypeData%NumBl_Lin = SrcRotParameterTypeData%NumBl_Lin - DstRotParameterTypeData%TwrPotent = SrcRotParameterTypeData%TwrPotent - DstRotParameterTypeData%TwrShadow = SrcRotParameterTypeData%TwrShadow - DstRotParameterTypeData%TwrAero = SrcRotParameterTypeData%TwrAero - DstRotParameterTypeData%FrozenWake = SrcRotParameterTypeData%FrozenWake - DstRotParameterTypeData%CavitCheck = SrcRotParameterTypeData%CavitCheck - DstRotParameterTypeData%Buoyancy = SrcRotParameterTypeData%Buoyancy - DstRotParameterTypeData%MHK = SrcRotParameterTypeData%MHK - DstRotParameterTypeData%CompAA = SrcRotParameterTypeData%CompAA - DstRotParameterTypeData%AirDens = SrcRotParameterTypeData%AirDens - DstRotParameterTypeData%KinVisc = SrcRotParameterTypeData%KinVisc - DstRotParameterTypeData%SpdSound = SrcRotParameterTypeData%SpdSound - DstRotParameterTypeData%Gravity = SrcRotParameterTypeData%Gravity - DstRotParameterTypeData%Patm = SrcRotParameterTypeData%Patm - DstRotParameterTypeData%Pvap = SrcRotParameterTypeData%Pvap - DstRotParameterTypeData%WtrDpth = SrcRotParameterTypeData%WtrDpth - DstRotParameterTypeData%MSL2SWL = SrcRotParameterTypeData%MSL2SWL - DstRotParameterTypeData%AeroProjMod = SrcRotParameterTypeData%AeroProjMod - DstRotParameterTypeData%AeroBEM_Mod = SrcRotParameterTypeData%AeroBEM_Mod - DstRotParameterTypeData%NumOuts = SrcRotParameterTypeData%NumOuts - DstRotParameterTypeData%RootName = SrcRotParameterTypeData%RootName -IF (ALLOCATED(SrcRotParameterTypeData%OutParam)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%OutParam,1) - i1_u = UBOUND(SrcRotParameterTypeData%OutParam,1) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%OutParam)) THEN - ALLOCATE(DstRotParameterTypeData%OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotParameterTypeData%OutParam,1), UBOUND(SrcRotParameterTypeData%OutParam,1) - CALL NWTC_Library_Copyoutparmtype( SrcRotParameterTypeData%OutParam(i1), DstRotParameterTypeData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstRotParameterTypeData%NBlOuts = SrcRotParameterTypeData%NBlOuts - DstRotParameterTypeData%BlOutNd = SrcRotParameterTypeData%BlOutNd - DstRotParameterTypeData%NTwOuts = SrcRotParameterTypeData%NTwOuts - DstRotParameterTypeData%TwOutNd = SrcRotParameterTypeData%TwOutNd - DstRotParameterTypeData%BldNd_NumOuts = SrcRotParameterTypeData%BldNd_NumOuts - DstRotParameterTypeData%BldNd_TotNumOuts = SrcRotParameterTypeData%BldNd_TotNumOuts -IF (ALLOCATED(SrcRotParameterTypeData%BldNd_OutParam)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%BldNd_OutParam,1) - i1_u = UBOUND(SrcRotParameterTypeData%BldNd_OutParam,1) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%BldNd_OutParam)) THEN - ALLOCATE(DstRotParameterTypeData%BldNd_OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BldNd_OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotParameterTypeData%BldNd_OutParam,1), UBOUND(SrcRotParameterTypeData%BldNd_OutParam,1) - CALL NWTC_Library_Copyoutparmtype( SrcRotParameterTypeData%BldNd_OutParam(i1), DstRotParameterTypeData%BldNd_OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcRotParameterTypeData%BldNd_BlOutNd)) THEN - i1_l = LBOUND(SrcRotParameterTypeData%BldNd_BlOutNd,1) - i1_u = UBOUND(SrcRotParameterTypeData%BldNd_BlOutNd,1) - IF (.NOT. ALLOCATED(DstRotParameterTypeData%BldNd_BlOutNd)) THEN - ALLOCATE(DstRotParameterTypeData%BldNd_BlOutNd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BldNd_BlOutNd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotParameterTypeData%BldNd_BlOutNd = SrcRotParameterTypeData%BldNd_BlOutNd -ENDIF - DstRotParameterTypeData%BldNd_BladesOut = SrcRotParameterTypeData%BldNd_BladesOut - DstRotParameterTypeData%TFinAero = SrcRotParameterTypeData%TFinAero - CALL AD_Copytfinparametertype( SrcRotParameterTypeData%TFin, DstRotParameterTypeData%TFin, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD_CopyRotParameterType - - SUBROUTINE AD_DestroyRotParameterType( RotParameterTypeData, ErrStat, ErrMsg ) - TYPE(RotParameterType), INTENT(INOUT) :: RotParameterTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyRotParameterType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(RotParameterTypeData%TwrDiam)) THEN - DEALLOCATE(RotParameterTypeData%TwrDiam) -ENDIF -IF (ALLOCATED(RotParameterTypeData%TwrCd)) THEN - DEALLOCATE(RotParameterTypeData%TwrCd) -ENDIF -IF (ALLOCATED(RotParameterTypeData%TwrTI)) THEN - DEALLOCATE(RotParameterTypeData%TwrTI) -ENDIF -IF (ALLOCATED(RotParameterTypeData%BlTwist)) THEN - DEALLOCATE(RotParameterTypeData%BlTwist) -ENDIF -IF (ALLOCATED(RotParameterTypeData%TwrCb)) THEN - DEALLOCATE(RotParameterTypeData%TwrCb) -ENDIF -IF (ALLOCATED(RotParameterTypeData%BlCenBn)) THEN - DEALLOCATE(RotParameterTypeData%BlCenBn) -ENDIF -IF (ALLOCATED(RotParameterTypeData%BlCenBt)) THEN - DEALLOCATE(RotParameterTypeData%BlCenBt) -ENDIF -IF (ALLOCATED(RotParameterTypeData%BlRad)) THEN - DEALLOCATE(RotParameterTypeData%BlRad) -ENDIF -IF (ALLOCATED(RotParameterTypeData%BlDL)) THEN - DEALLOCATE(RotParameterTypeData%BlDL) -ENDIF -IF (ALLOCATED(RotParameterTypeData%BlTaper)) THEN - DEALLOCATE(RotParameterTypeData%BlTaper) -ENDIF -IF (ALLOCATED(RotParameterTypeData%BlAxCent)) THEN - DEALLOCATE(RotParameterTypeData%BlAxCent) -ENDIF -IF (ALLOCATED(RotParameterTypeData%TwrRad)) THEN - DEALLOCATE(RotParameterTypeData%TwrRad) -ENDIF -IF (ALLOCATED(RotParameterTypeData%TwrDL)) THEN - DEALLOCATE(RotParameterTypeData%TwrDL) -ENDIF -IF (ALLOCATED(RotParameterTypeData%TwrTaper)) THEN - DEALLOCATE(RotParameterTypeData%TwrTaper) -ENDIF -IF (ALLOCATED(RotParameterTypeData%TwrAxCent)) THEN - DEALLOCATE(RotParameterTypeData%TwrAxCent) -ENDIF - CALL BEMT_DestroyParam( RotParameterTypeData%BEMT, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AA_DestroyParam( RotParameterTypeData%AA, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(RotParameterTypeData%Jac_u_indx)) THEN - DEALLOCATE(RotParameterTypeData%Jac_u_indx) -ENDIF -IF (ALLOCATED(RotParameterTypeData%du)) THEN - DEALLOCATE(RotParameterTypeData%du) -ENDIF -IF (ALLOCATED(RotParameterTypeData%dx)) THEN - DEALLOCATE(RotParameterTypeData%dx) -ENDIF -IF (ALLOCATED(RotParameterTypeData%OutParam)) THEN -DO i1 = LBOUND(RotParameterTypeData%OutParam,1), UBOUND(RotParameterTypeData%OutParam,1) - CALL NWTC_Library_DestroyOutParmType( RotParameterTypeData%OutParam(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotParameterTypeData%OutParam) -ENDIF -IF (ALLOCATED(RotParameterTypeData%BldNd_OutParam)) THEN -DO i1 = LBOUND(RotParameterTypeData%BldNd_OutParam,1), UBOUND(RotParameterTypeData%BldNd_OutParam,1) - CALL NWTC_Library_DestroyOutParmType( RotParameterTypeData%BldNd_OutParam(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotParameterTypeData%BldNd_OutParam) -ENDIF -IF (ALLOCATED(RotParameterTypeData%BldNd_BlOutNd)) THEN - DEALLOCATE(RotParameterTypeData%BldNd_BlOutNd) -ENDIF - CALL AD_DestroyTFinParameterType( RotParameterTypeData%TFin, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD_DestroyRotParameterType + ErrMsg = '' + DstRotParameterTypeData%NumBlades = SrcRotParameterTypeData%NumBlades + DstRotParameterTypeData%NumBlNds = SrcRotParameterTypeData%NumBlNds + DstRotParameterTypeData%NumTwrNds = SrcRotParameterTypeData%NumTwrNds + if (allocated(SrcRotParameterTypeData%TwrDiam)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrDiam) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrDiam) + if (.not. allocated(DstRotParameterTypeData%TwrDiam)) then + allocate(DstRotParameterTypeData%TwrDiam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrDiam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%TwrDiam = SrcRotParameterTypeData%TwrDiam + else if (allocated(DstRotParameterTypeData%TwrDiam)) then + deallocate(DstRotParameterTypeData%TwrDiam) + end if + if (allocated(SrcRotParameterTypeData%TwrCd)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrCd) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrCd) + if (.not. allocated(DstRotParameterTypeData%TwrCd)) then + allocate(DstRotParameterTypeData%TwrCd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrCd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%TwrCd = SrcRotParameterTypeData%TwrCd + else if (allocated(DstRotParameterTypeData%TwrCd)) then + deallocate(DstRotParameterTypeData%TwrCd) + end if + if (allocated(SrcRotParameterTypeData%TwrTI)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrTI) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrTI) + if (.not. allocated(DstRotParameterTypeData%TwrTI)) then + allocate(DstRotParameterTypeData%TwrTI(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrTI.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%TwrTI = SrcRotParameterTypeData%TwrTI + else if (allocated(DstRotParameterTypeData%TwrTI)) then + deallocate(DstRotParameterTypeData%TwrTI) + end if + if (allocated(SrcRotParameterTypeData%BlTwist)) then + LB(1:2) = lbound(SrcRotParameterTypeData%BlTwist) + UB(1:2) = ubound(SrcRotParameterTypeData%BlTwist) + if (.not. allocated(DstRotParameterTypeData%BlTwist)) then + allocate(DstRotParameterTypeData%BlTwist(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlTwist.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%BlTwist = SrcRotParameterTypeData%BlTwist + else if (allocated(DstRotParameterTypeData%BlTwist)) then + deallocate(DstRotParameterTypeData%BlTwist) + end if + if (allocated(SrcRotParameterTypeData%TwrCb)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrCb) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrCb) + if (.not. allocated(DstRotParameterTypeData%TwrCb)) then + allocate(DstRotParameterTypeData%TwrCb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrCb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%TwrCb = SrcRotParameterTypeData%TwrCb + else if (allocated(DstRotParameterTypeData%TwrCb)) then + deallocate(DstRotParameterTypeData%TwrCb) + end if + if (allocated(SrcRotParameterTypeData%BlCenBn)) then + LB(1:2) = lbound(SrcRotParameterTypeData%BlCenBn) + UB(1:2) = ubound(SrcRotParameterTypeData%BlCenBn) + if (.not. allocated(DstRotParameterTypeData%BlCenBn)) then + allocate(DstRotParameterTypeData%BlCenBn(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlCenBn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%BlCenBn = SrcRotParameterTypeData%BlCenBn + else if (allocated(DstRotParameterTypeData%BlCenBn)) then + deallocate(DstRotParameterTypeData%BlCenBn) + end if + if (allocated(SrcRotParameterTypeData%BlCenBt)) then + LB(1:2) = lbound(SrcRotParameterTypeData%BlCenBt) + UB(1:2) = ubound(SrcRotParameterTypeData%BlCenBt) + if (.not. allocated(DstRotParameterTypeData%BlCenBt)) then + allocate(DstRotParameterTypeData%BlCenBt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlCenBt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%BlCenBt = SrcRotParameterTypeData%BlCenBt + else if (allocated(DstRotParameterTypeData%BlCenBt)) then + deallocate(DstRotParameterTypeData%BlCenBt) + end if + DstRotParameterTypeData%VolHub = SrcRotParameterTypeData%VolHub + DstRotParameterTypeData%HubCenBx = SrcRotParameterTypeData%HubCenBx + DstRotParameterTypeData%VolNac = SrcRotParameterTypeData%VolNac + DstRotParameterTypeData%NacCenB = SrcRotParameterTypeData%NacCenB + DstRotParameterTypeData%VolBl = SrcRotParameterTypeData%VolBl + DstRotParameterTypeData%VolTwr = SrcRotParameterTypeData%VolTwr + if (allocated(SrcRotParameterTypeData%BlRad)) then + LB(1:2) = lbound(SrcRotParameterTypeData%BlRad) + UB(1:2) = ubound(SrcRotParameterTypeData%BlRad) + if (.not. allocated(DstRotParameterTypeData%BlRad)) then + allocate(DstRotParameterTypeData%BlRad(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlRad.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%BlRad = SrcRotParameterTypeData%BlRad + else if (allocated(DstRotParameterTypeData%BlRad)) then + deallocate(DstRotParameterTypeData%BlRad) + end if + if (allocated(SrcRotParameterTypeData%BlDL)) then + LB(1:2) = lbound(SrcRotParameterTypeData%BlDL) + UB(1:2) = ubound(SrcRotParameterTypeData%BlDL) + if (.not. allocated(DstRotParameterTypeData%BlDL)) then + allocate(DstRotParameterTypeData%BlDL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlDL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%BlDL = SrcRotParameterTypeData%BlDL + else if (allocated(DstRotParameterTypeData%BlDL)) then + deallocate(DstRotParameterTypeData%BlDL) + end if + if (allocated(SrcRotParameterTypeData%BlTaper)) then + LB(1:2) = lbound(SrcRotParameterTypeData%BlTaper) + UB(1:2) = ubound(SrcRotParameterTypeData%BlTaper) + if (.not. allocated(DstRotParameterTypeData%BlTaper)) then + allocate(DstRotParameterTypeData%BlTaper(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlTaper.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%BlTaper = SrcRotParameterTypeData%BlTaper + else if (allocated(DstRotParameterTypeData%BlTaper)) then + deallocate(DstRotParameterTypeData%BlTaper) + end if + if (allocated(SrcRotParameterTypeData%BlAxCent)) then + LB(1:2) = lbound(SrcRotParameterTypeData%BlAxCent) + UB(1:2) = ubound(SrcRotParameterTypeData%BlAxCent) + if (.not. allocated(DstRotParameterTypeData%BlAxCent)) then + allocate(DstRotParameterTypeData%BlAxCent(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlAxCent.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%BlAxCent = SrcRotParameterTypeData%BlAxCent + else if (allocated(DstRotParameterTypeData%BlAxCent)) then + deallocate(DstRotParameterTypeData%BlAxCent) + end if + if (allocated(SrcRotParameterTypeData%TwrRad)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrRad) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrRad) + if (.not. allocated(DstRotParameterTypeData%TwrRad)) then + allocate(DstRotParameterTypeData%TwrRad(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrRad.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%TwrRad = SrcRotParameterTypeData%TwrRad + else if (allocated(DstRotParameterTypeData%TwrRad)) then + deallocate(DstRotParameterTypeData%TwrRad) + end if + if (allocated(SrcRotParameterTypeData%TwrDL)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrDL) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrDL) + if (.not. allocated(DstRotParameterTypeData%TwrDL)) then + allocate(DstRotParameterTypeData%TwrDL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrDL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%TwrDL = SrcRotParameterTypeData%TwrDL + else if (allocated(DstRotParameterTypeData%TwrDL)) then + deallocate(DstRotParameterTypeData%TwrDL) + end if + if (allocated(SrcRotParameterTypeData%TwrTaper)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrTaper) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrTaper) + if (.not. allocated(DstRotParameterTypeData%TwrTaper)) then + allocate(DstRotParameterTypeData%TwrTaper(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrTaper.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%TwrTaper = SrcRotParameterTypeData%TwrTaper + else if (allocated(DstRotParameterTypeData%TwrTaper)) then + deallocate(DstRotParameterTypeData%TwrTaper) + end if + if (allocated(SrcRotParameterTypeData%TwrAxCent)) then + LB(1:1) = lbound(SrcRotParameterTypeData%TwrAxCent) + UB(1:1) = ubound(SrcRotParameterTypeData%TwrAxCent) + if (.not. allocated(DstRotParameterTypeData%TwrAxCent)) then + allocate(DstRotParameterTypeData%TwrAxCent(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrAxCent.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%TwrAxCent = SrcRotParameterTypeData%TwrAxCent + else if (allocated(DstRotParameterTypeData%TwrAxCent)) then + deallocate(DstRotParameterTypeData%TwrAxCent) + end if + call BEMT_CopyParam(SrcRotParameterTypeData%BEMT, DstRotParameterTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AA_CopyParam(SrcRotParameterTypeData%AA, DstRotParameterTypeData%AA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcRotParameterTypeData%Jac_u_indx)) then + LB(1:2) = lbound(SrcRotParameterTypeData%Jac_u_indx) + UB(1:2) = ubound(SrcRotParameterTypeData%Jac_u_indx) + if (.not. allocated(DstRotParameterTypeData%Jac_u_indx)) then + allocate(DstRotParameterTypeData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%Jac_u_indx = SrcRotParameterTypeData%Jac_u_indx + else if (allocated(DstRotParameterTypeData%Jac_u_indx)) then + deallocate(DstRotParameterTypeData%Jac_u_indx) + end if + if (allocated(SrcRotParameterTypeData%du)) then + LB(1:1) = lbound(SrcRotParameterTypeData%du) + UB(1:1) = ubound(SrcRotParameterTypeData%du) + if (.not. allocated(DstRotParameterTypeData%du)) then + allocate(DstRotParameterTypeData%du(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%du.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%du = SrcRotParameterTypeData%du + else if (allocated(DstRotParameterTypeData%du)) then + deallocate(DstRotParameterTypeData%du) + end if + if (allocated(SrcRotParameterTypeData%dx)) then + LB(1:1) = lbound(SrcRotParameterTypeData%dx) + UB(1:1) = ubound(SrcRotParameterTypeData%dx) + if (.not. allocated(DstRotParameterTypeData%dx)) then + allocate(DstRotParameterTypeData%dx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%dx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%dx = SrcRotParameterTypeData%dx + else if (allocated(DstRotParameterTypeData%dx)) then + deallocate(DstRotParameterTypeData%dx) + end if + DstRotParameterTypeData%Jac_ny = SrcRotParameterTypeData%Jac_ny + DstRotParameterTypeData%NumBl_Lin = SrcRotParameterTypeData%NumBl_Lin + DstRotParameterTypeData%TwrPotent = SrcRotParameterTypeData%TwrPotent + DstRotParameterTypeData%TwrShadow = SrcRotParameterTypeData%TwrShadow + DstRotParameterTypeData%TwrAero = SrcRotParameterTypeData%TwrAero + DstRotParameterTypeData%FrozenWake = SrcRotParameterTypeData%FrozenWake + DstRotParameterTypeData%CavitCheck = SrcRotParameterTypeData%CavitCheck + DstRotParameterTypeData%Buoyancy = SrcRotParameterTypeData%Buoyancy + DstRotParameterTypeData%MHK = SrcRotParameterTypeData%MHK + DstRotParameterTypeData%CompAA = SrcRotParameterTypeData%CompAA + DstRotParameterTypeData%AirDens = SrcRotParameterTypeData%AirDens + DstRotParameterTypeData%KinVisc = SrcRotParameterTypeData%KinVisc + DstRotParameterTypeData%SpdSound = SrcRotParameterTypeData%SpdSound + DstRotParameterTypeData%Gravity = SrcRotParameterTypeData%Gravity + DstRotParameterTypeData%Patm = SrcRotParameterTypeData%Patm + DstRotParameterTypeData%Pvap = SrcRotParameterTypeData%Pvap + DstRotParameterTypeData%WtrDpth = SrcRotParameterTypeData%WtrDpth + DstRotParameterTypeData%MSL2SWL = SrcRotParameterTypeData%MSL2SWL + DstRotParameterTypeData%AeroProjMod = SrcRotParameterTypeData%AeroProjMod + DstRotParameterTypeData%AeroBEM_Mod = SrcRotParameterTypeData%AeroBEM_Mod + DstRotParameterTypeData%NumOuts = SrcRotParameterTypeData%NumOuts + DstRotParameterTypeData%RootName = SrcRotParameterTypeData%RootName + if (allocated(SrcRotParameterTypeData%OutParam)) then + LB(1:1) = lbound(SrcRotParameterTypeData%OutParam) + UB(1:1) = ubound(SrcRotParameterTypeData%OutParam) + if (.not. allocated(DstRotParameterTypeData%OutParam)) then + allocate(DstRotParameterTypeData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcRotParameterTypeData%OutParam(i1), DstRotParameterTypeData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstRotParameterTypeData%OutParam)) then + deallocate(DstRotParameterTypeData%OutParam) + end if + DstRotParameterTypeData%NBlOuts = SrcRotParameterTypeData%NBlOuts + DstRotParameterTypeData%BlOutNd = SrcRotParameterTypeData%BlOutNd + DstRotParameterTypeData%NTwOuts = SrcRotParameterTypeData%NTwOuts + DstRotParameterTypeData%TwOutNd = SrcRotParameterTypeData%TwOutNd + DstRotParameterTypeData%BldNd_NumOuts = SrcRotParameterTypeData%BldNd_NumOuts + DstRotParameterTypeData%BldNd_TotNumOuts = SrcRotParameterTypeData%BldNd_TotNumOuts + if (allocated(SrcRotParameterTypeData%BldNd_OutParam)) then + LB(1:1) = lbound(SrcRotParameterTypeData%BldNd_OutParam) + UB(1:1) = ubound(SrcRotParameterTypeData%BldNd_OutParam) + if (.not. allocated(DstRotParameterTypeData%BldNd_OutParam)) then + allocate(DstRotParameterTypeData%BldNd_OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BldNd_OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcRotParameterTypeData%BldNd_OutParam(i1), DstRotParameterTypeData%BldNd_OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstRotParameterTypeData%BldNd_OutParam)) then + deallocate(DstRotParameterTypeData%BldNd_OutParam) + end if + if (allocated(SrcRotParameterTypeData%BldNd_BlOutNd)) then + LB(1:1) = lbound(SrcRotParameterTypeData%BldNd_BlOutNd) + UB(1:1) = ubound(SrcRotParameterTypeData%BldNd_BlOutNd) + if (.not. allocated(DstRotParameterTypeData%BldNd_BlOutNd)) then + allocate(DstRotParameterTypeData%BldNd_BlOutNd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BldNd_BlOutNd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotParameterTypeData%BldNd_BlOutNd = SrcRotParameterTypeData%BldNd_BlOutNd + else if (allocated(DstRotParameterTypeData%BldNd_BlOutNd)) then + deallocate(DstRotParameterTypeData%BldNd_BlOutNd) + end if + DstRotParameterTypeData%BldNd_BladesOut = SrcRotParameterTypeData%BldNd_BladesOut + DstRotParameterTypeData%TFinAero = SrcRotParameterTypeData%TFinAero + call AD_CopyTFinParameterType(SrcRotParameterTypeData%TFin, DstRotParameterTypeData%TFin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine AD_DestroyRotParameterType(RotParameterTypeData, ErrStat, ErrMsg) + type(RotParameterType), intent(inout) :: RotParameterTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyRotParameterType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(RotParameterTypeData%TwrDiam)) then + deallocate(RotParameterTypeData%TwrDiam) + end if + if (allocated(RotParameterTypeData%TwrCd)) then + deallocate(RotParameterTypeData%TwrCd) + end if + if (allocated(RotParameterTypeData%TwrTI)) then + deallocate(RotParameterTypeData%TwrTI) + end if + if (allocated(RotParameterTypeData%BlTwist)) then + deallocate(RotParameterTypeData%BlTwist) + end if + if (allocated(RotParameterTypeData%TwrCb)) then + deallocate(RotParameterTypeData%TwrCb) + end if + if (allocated(RotParameterTypeData%BlCenBn)) then + deallocate(RotParameterTypeData%BlCenBn) + end if + if (allocated(RotParameterTypeData%BlCenBt)) then + deallocate(RotParameterTypeData%BlCenBt) + end if + if (allocated(RotParameterTypeData%BlRad)) then + deallocate(RotParameterTypeData%BlRad) + end if + if (allocated(RotParameterTypeData%BlDL)) then + deallocate(RotParameterTypeData%BlDL) + end if + if (allocated(RotParameterTypeData%BlTaper)) then + deallocate(RotParameterTypeData%BlTaper) + end if + if (allocated(RotParameterTypeData%BlAxCent)) then + deallocate(RotParameterTypeData%BlAxCent) + end if + if (allocated(RotParameterTypeData%TwrRad)) then + deallocate(RotParameterTypeData%TwrRad) + end if + if (allocated(RotParameterTypeData%TwrDL)) then + deallocate(RotParameterTypeData%TwrDL) + end if + if (allocated(RotParameterTypeData%TwrTaper)) then + deallocate(RotParameterTypeData%TwrTaper) + end if + if (allocated(RotParameterTypeData%TwrAxCent)) then + deallocate(RotParameterTypeData%TwrAxCent) + end if + if (allocated(RotParameterTypeData%Jac_u_indx)) then + deallocate(RotParameterTypeData%Jac_u_indx) + end if + if (allocated(RotParameterTypeData%du)) then + deallocate(RotParameterTypeData%du) + end if + if (allocated(RotParameterTypeData%dx)) then + deallocate(RotParameterTypeData%dx) + end if + if (allocated(RotParameterTypeData%OutParam)) then + LB(1:1) = lbound(RotParameterTypeData%OutParam) + UB(1:1) = ubound(RotParameterTypeData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(RotParameterTypeData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotParameterTypeData%OutParam) + end if + if (allocated(RotParameterTypeData%BldNd_OutParam)) then + LB(1:1) = lbound(RotParameterTypeData%BldNd_OutParam) + UB(1:1) = ubound(RotParameterTypeData%BldNd_OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(RotParameterTypeData%BldNd_OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotParameterTypeData%BldNd_OutParam) + end if + if (allocated(RotParameterTypeData%BldNd_BlOutNd)) then + deallocate(RotParameterTypeData%BldNd_BlOutNd) + end if +end subroutine subroutine AD_PackRotParameterType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -6559,232 +6074,180 @@ subroutine AD_PackRotParameterType(Buf, Indata) integer(IntKi) :: i1, i2 integer(IntKi) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return - ! NumBlades call RegPack(Buf, InData%NumBlades) if (RegCheckErr(Buf, RoutineName)) return - ! NumBlNds call RegPack(Buf, InData%NumBlNds) if (RegCheckErr(Buf, RoutineName)) return - ! NumTwrNds call RegPack(Buf, InData%NumTwrNds) if (RegCheckErr(Buf, RoutineName)) return - ! TwrDiam call RegPack(Buf, allocated(InData%TwrDiam)) if (allocated(InData%TwrDiam)) then call RegPackBounds(Buf, 1, lbound(InData%TwrDiam), ubound(InData%TwrDiam)) call RegPack(Buf, InData%TwrDiam) end if if (RegCheckErr(Buf, RoutineName)) return - ! TwrCd call RegPack(Buf, allocated(InData%TwrCd)) if (allocated(InData%TwrCd)) then call RegPackBounds(Buf, 1, lbound(InData%TwrCd), ubound(InData%TwrCd)) call RegPack(Buf, InData%TwrCd) end if if (RegCheckErr(Buf, RoutineName)) return - ! TwrTI call RegPack(Buf, allocated(InData%TwrTI)) if (allocated(InData%TwrTI)) then call RegPackBounds(Buf, 1, lbound(InData%TwrTI), ubound(InData%TwrTI)) call RegPack(Buf, InData%TwrTI) end if if (RegCheckErr(Buf, RoutineName)) return - ! BlTwist call RegPack(Buf, allocated(InData%BlTwist)) if (allocated(InData%BlTwist)) then call RegPackBounds(Buf, 2, lbound(InData%BlTwist), ubound(InData%BlTwist)) call RegPack(Buf, InData%BlTwist) end if if (RegCheckErr(Buf, RoutineName)) return - ! TwrCb call RegPack(Buf, allocated(InData%TwrCb)) if (allocated(InData%TwrCb)) then call RegPackBounds(Buf, 1, lbound(InData%TwrCb), ubound(InData%TwrCb)) call RegPack(Buf, InData%TwrCb) end if if (RegCheckErr(Buf, RoutineName)) return - ! BlCenBn call RegPack(Buf, allocated(InData%BlCenBn)) if (allocated(InData%BlCenBn)) then call RegPackBounds(Buf, 2, lbound(InData%BlCenBn), ubound(InData%BlCenBn)) call RegPack(Buf, InData%BlCenBn) end if if (RegCheckErr(Buf, RoutineName)) return - ! BlCenBt call RegPack(Buf, allocated(InData%BlCenBt)) if (allocated(InData%BlCenBt)) then call RegPackBounds(Buf, 2, lbound(InData%BlCenBt), ubound(InData%BlCenBt)) call RegPack(Buf, InData%BlCenBt) end if if (RegCheckErr(Buf, RoutineName)) return - ! VolHub call RegPack(Buf, InData%VolHub) if (RegCheckErr(Buf, RoutineName)) return - ! HubCenBx call RegPack(Buf, InData%HubCenBx) if (RegCheckErr(Buf, RoutineName)) return - ! VolNac call RegPack(Buf, InData%VolNac) if (RegCheckErr(Buf, RoutineName)) return - ! NacCenB call RegPack(Buf, InData%NacCenB) if (RegCheckErr(Buf, RoutineName)) return - ! VolBl call RegPack(Buf, InData%VolBl) if (RegCheckErr(Buf, RoutineName)) return - ! VolTwr call RegPack(Buf, InData%VolTwr) if (RegCheckErr(Buf, RoutineName)) return - ! BlRad call RegPack(Buf, allocated(InData%BlRad)) if (allocated(InData%BlRad)) then call RegPackBounds(Buf, 2, lbound(InData%BlRad), ubound(InData%BlRad)) call RegPack(Buf, InData%BlRad) end if if (RegCheckErr(Buf, RoutineName)) return - ! BlDL call RegPack(Buf, allocated(InData%BlDL)) if (allocated(InData%BlDL)) then call RegPackBounds(Buf, 2, lbound(InData%BlDL), ubound(InData%BlDL)) call RegPack(Buf, InData%BlDL) end if if (RegCheckErr(Buf, RoutineName)) return - ! BlTaper call RegPack(Buf, allocated(InData%BlTaper)) if (allocated(InData%BlTaper)) then call RegPackBounds(Buf, 2, lbound(InData%BlTaper), ubound(InData%BlTaper)) call RegPack(Buf, InData%BlTaper) end if if (RegCheckErr(Buf, RoutineName)) return - ! BlAxCent call RegPack(Buf, allocated(InData%BlAxCent)) if (allocated(InData%BlAxCent)) then call RegPackBounds(Buf, 2, lbound(InData%BlAxCent), ubound(InData%BlAxCent)) call RegPack(Buf, InData%BlAxCent) end if if (RegCheckErr(Buf, RoutineName)) return - ! TwrRad call RegPack(Buf, allocated(InData%TwrRad)) if (allocated(InData%TwrRad)) then call RegPackBounds(Buf, 1, lbound(InData%TwrRad), ubound(InData%TwrRad)) call RegPack(Buf, InData%TwrRad) end if if (RegCheckErr(Buf, RoutineName)) return - ! TwrDL call RegPack(Buf, allocated(InData%TwrDL)) if (allocated(InData%TwrDL)) then call RegPackBounds(Buf, 1, lbound(InData%TwrDL), ubound(InData%TwrDL)) call RegPack(Buf, InData%TwrDL) end if if (RegCheckErr(Buf, RoutineName)) return - ! TwrTaper call RegPack(Buf, allocated(InData%TwrTaper)) if (allocated(InData%TwrTaper)) then call RegPackBounds(Buf, 1, lbound(InData%TwrTaper), ubound(InData%TwrTaper)) call RegPack(Buf, InData%TwrTaper) end if if (RegCheckErr(Buf, RoutineName)) return - ! TwrAxCent call RegPack(Buf, allocated(InData%TwrAxCent)) if (allocated(InData%TwrAxCent)) then call RegPackBounds(Buf, 1, lbound(InData%TwrAxCent), ubound(InData%TwrAxCent)) call RegPack(Buf, InData%TwrAxCent) end if if (RegCheckErr(Buf, RoutineName)) return - ! BEMT call BEMT_PackParam(Buf, InData%BEMT) if (RegCheckErr(Buf, RoutineName)) return - ! AA call AA_PackParam(Buf, InData%AA) if (RegCheckErr(Buf, RoutineName)) return - ! Jac_u_indx call RegPack(Buf, allocated(InData%Jac_u_indx)) if (allocated(InData%Jac_u_indx)) then call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx), ubound(InData%Jac_u_indx)) call RegPack(Buf, InData%Jac_u_indx) end if if (RegCheckErr(Buf, RoutineName)) return - ! du call RegPack(Buf, allocated(InData%du)) if (allocated(InData%du)) then call RegPackBounds(Buf, 1, lbound(InData%du), ubound(InData%du)) call RegPack(Buf, InData%du) end if if (RegCheckErr(Buf, RoutineName)) return - ! dx call RegPack(Buf, allocated(InData%dx)) if (allocated(InData%dx)) then call RegPackBounds(Buf, 1, lbound(InData%dx), ubound(InData%dx)) call RegPack(Buf, InData%dx) end if if (RegCheckErr(Buf, RoutineName)) return - ! Jac_ny call RegPack(Buf, InData%Jac_ny) if (RegCheckErr(Buf, RoutineName)) return - ! NumBl_Lin call RegPack(Buf, InData%NumBl_Lin) if (RegCheckErr(Buf, RoutineName)) return - ! TwrPotent call RegPack(Buf, InData%TwrPotent) if (RegCheckErr(Buf, RoutineName)) return - ! TwrShadow call RegPack(Buf, InData%TwrShadow) if (RegCheckErr(Buf, RoutineName)) return - ! TwrAero call RegPack(Buf, InData%TwrAero) if (RegCheckErr(Buf, RoutineName)) return - ! FrozenWake call RegPack(Buf, InData%FrozenWake) if (RegCheckErr(Buf, RoutineName)) return - ! CavitCheck call RegPack(Buf, InData%CavitCheck) if (RegCheckErr(Buf, RoutineName)) return - ! Buoyancy call RegPack(Buf, InData%Buoyancy) if (RegCheckErr(Buf, RoutineName)) return - ! MHK call RegPack(Buf, InData%MHK) if (RegCheckErr(Buf, RoutineName)) return - ! CompAA call RegPack(Buf, InData%CompAA) if (RegCheckErr(Buf, RoutineName)) return - ! AirDens call RegPack(Buf, InData%AirDens) if (RegCheckErr(Buf, RoutineName)) return - ! KinVisc call RegPack(Buf, InData%KinVisc) if (RegCheckErr(Buf, RoutineName)) return - ! SpdSound call RegPack(Buf, InData%SpdSound) if (RegCheckErr(Buf, RoutineName)) return - ! Gravity call RegPack(Buf, InData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - ! Patm call RegPack(Buf, InData%Patm) if (RegCheckErr(Buf, RoutineName)) return - ! Pvap call RegPack(Buf, InData%Pvap) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDpth call RegPack(Buf, InData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - ! MSL2SWL call RegPack(Buf, InData%MSL2SWL) if (RegCheckErr(Buf, RoutineName)) return - ! AeroProjMod call RegPack(Buf, InData%AeroProjMod) if (RegCheckErr(Buf, RoutineName)) return - ! AeroBEM_Mod call RegPack(Buf, InData%AeroBEM_Mod) if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegPack(Buf, InData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegPack(Buf, InData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! OutParam call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) @@ -6795,25 +6258,18 @@ subroutine AD_PackRotParameterType(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! NBlOuts call RegPack(Buf, InData%NBlOuts) if (RegCheckErr(Buf, RoutineName)) return - ! BlOutNd call RegPack(Buf, InData%BlOutNd) if (RegCheckErr(Buf, RoutineName)) return - ! NTwOuts call RegPack(Buf, InData%NTwOuts) if (RegCheckErr(Buf, RoutineName)) return - ! TwOutNd call RegPack(Buf, InData%TwOutNd) if (RegCheckErr(Buf, RoutineName)) return - ! BldNd_NumOuts call RegPack(Buf, InData%BldNd_NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! BldNd_TotNumOuts call RegPack(Buf, InData%BldNd_TotNumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! BldNd_OutParam call RegPack(Buf, allocated(InData%BldNd_OutParam)) if (allocated(InData%BldNd_OutParam)) then call RegPackBounds(Buf, 1, lbound(InData%BldNd_OutParam), ubound(InData%BldNd_OutParam)) @@ -6824,20 +6280,16 @@ subroutine AD_PackRotParameterType(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! BldNd_BlOutNd call RegPack(Buf, allocated(InData%BldNd_BlOutNd)) if (allocated(InData%BldNd_BlOutNd)) then call RegPackBounds(Buf, 1, lbound(InData%BldNd_BlOutNd), ubound(InData%BldNd_BlOutNd)) call RegPack(Buf, InData%BldNd_BlOutNd) end if if (RegCheckErr(Buf, RoutineName)) return - ! BldNd_BladesOut call RegPack(Buf, InData%BldNd_BladesOut) if (RegCheckErr(Buf, RoutineName)) return - ! TFinAero call RegPack(Buf, InData%TFinAero) if (RegCheckErr(Buf, RoutineName)) return - ! TFin call AD_PackTFinParameterType(Buf, InData%TFin) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -6851,16 +6303,12 @@ subroutine AD_UnPackRotParameterType(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! NumBlades call RegUnpack(Buf, OutData%NumBlades) if (RegCheckErr(Buf, RoutineName)) return - ! NumBlNds call RegUnpack(Buf, OutData%NumBlNds) if (RegCheckErr(Buf, RoutineName)) return - ! NumTwrNds call RegUnpack(Buf, OutData%NumTwrNds) if (RegCheckErr(Buf, RoutineName)) return - ! TwrDiam if (allocated(OutData%TwrDiam)) deallocate(OutData%TwrDiam) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6875,7 +6323,6 @@ subroutine AD_UnPackRotParameterType(Buf, OutData) call RegUnpack(Buf, OutData%TwrDiam) if (RegCheckErr(Buf, RoutineName)) return end if - ! TwrCd if (allocated(OutData%TwrCd)) deallocate(OutData%TwrCd) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6890,7 +6337,6 @@ subroutine AD_UnPackRotParameterType(Buf, OutData) call RegUnpack(Buf, OutData%TwrCd) if (RegCheckErr(Buf, RoutineName)) return end if - ! TwrTI if (allocated(OutData%TwrTI)) deallocate(OutData%TwrTI) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6905,7 +6351,6 @@ subroutine AD_UnPackRotParameterType(Buf, OutData) call RegUnpack(Buf, OutData%TwrTI) if (RegCheckErr(Buf, RoutineName)) return end if - ! BlTwist if (allocated(OutData%BlTwist)) deallocate(OutData%BlTwist) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6920,7 +6365,6 @@ subroutine AD_UnPackRotParameterType(Buf, OutData) call RegUnpack(Buf, OutData%BlTwist) if (RegCheckErr(Buf, RoutineName)) return end if - ! TwrCb if (allocated(OutData%TwrCb)) deallocate(OutData%TwrCb) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6935,7 +6379,6 @@ subroutine AD_UnPackRotParameterType(Buf, OutData) call RegUnpack(Buf, OutData%TwrCb) if (RegCheckErr(Buf, RoutineName)) return end if - ! BlCenBn if (allocated(OutData%BlCenBn)) deallocate(OutData%BlCenBn) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6950,7 +6393,6 @@ subroutine AD_UnPackRotParameterType(Buf, OutData) call RegUnpack(Buf, OutData%BlCenBn) if (RegCheckErr(Buf, RoutineName)) return end if - ! BlCenBt if (allocated(OutData%BlCenBt)) deallocate(OutData%BlCenBt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6965,25 +6407,18 @@ subroutine AD_UnPackRotParameterType(Buf, OutData) call RegUnpack(Buf, OutData%BlCenBt) if (RegCheckErr(Buf, RoutineName)) return end if - ! VolHub call RegUnpack(Buf, OutData%VolHub) if (RegCheckErr(Buf, RoutineName)) return - ! HubCenBx call RegUnpack(Buf, OutData%HubCenBx) if (RegCheckErr(Buf, RoutineName)) return - ! VolNac call RegUnpack(Buf, OutData%VolNac) if (RegCheckErr(Buf, RoutineName)) return - ! NacCenB call RegUnpack(Buf, OutData%NacCenB) if (RegCheckErr(Buf, RoutineName)) return - ! VolBl call RegUnpack(Buf, OutData%VolBl) if (RegCheckErr(Buf, RoutineName)) return - ! VolTwr call RegUnpack(Buf, OutData%VolTwr) if (RegCheckErr(Buf, RoutineName)) return - ! BlRad if (allocated(OutData%BlRad)) deallocate(OutData%BlRad) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6998,7 +6433,6 @@ subroutine AD_UnPackRotParameterType(Buf, OutData) call RegUnpack(Buf, OutData%BlRad) if (RegCheckErr(Buf, RoutineName)) return end if - ! BlDL if (allocated(OutData%BlDL)) deallocate(OutData%BlDL) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7013,7 +6447,6 @@ subroutine AD_UnPackRotParameterType(Buf, OutData) call RegUnpack(Buf, OutData%BlDL) if (RegCheckErr(Buf, RoutineName)) return end if - ! BlTaper if (allocated(OutData%BlTaper)) deallocate(OutData%BlTaper) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7028,7 +6461,6 @@ subroutine AD_UnPackRotParameterType(Buf, OutData) call RegUnpack(Buf, OutData%BlTaper) if (RegCheckErr(Buf, RoutineName)) return end if - ! BlAxCent if (allocated(OutData%BlAxCent)) deallocate(OutData%BlAxCent) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7043,7 +6475,6 @@ subroutine AD_UnPackRotParameterType(Buf, OutData) call RegUnpack(Buf, OutData%BlAxCent) if (RegCheckErr(Buf, RoutineName)) return end if - ! TwrRad if (allocated(OutData%TwrRad)) deallocate(OutData%TwrRad) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7058,7 +6489,6 @@ subroutine AD_UnPackRotParameterType(Buf, OutData) call RegUnpack(Buf, OutData%TwrRad) if (RegCheckErr(Buf, RoutineName)) return end if - ! TwrDL if (allocated(OutData%TwrDL)) deallocate(OutData%TwrDL) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7073,7 +6503,6 @@ subroutine AD_UnPackRotParameterType(Buf, OutData) call RegUnpack(Buf, OutData%TwrDL) if (RegCheckErr(Buf, RoutineName)) return end if - ! TwrTaper if (allocated(OutData%TwrTaper)) deallocate(OutData%TwrTaper) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7088,7 +6517,6 @@ subroutine AD_UnPackRotParameterType(Buf, OutData) call RegUnpack(Buf, OutData%TwrTaper) if (RegCheckErr(Buf, RoutineName)) return end if - ! TwrAxCent if (allocated(OutData%TwrAxCent)) deallocate(OutData%TwrAxCent) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7103,11 +6531,8 @@ subroutine AD_UnPackRotParameterType(Buf, OutData) call RegUnpack(Buf, OutData%TwrAxCent) if (RegCheckErr(Buf, RoutineName)) return end if - ! BEMT call BEMT_UnpackParam(Buf, OutData%BEMT) ! BEMT - ! AA call AA_UnpackParam(Buf, OutData%AA) ! AA - ! Jac_u_indx if (allocated(OutData%Jac_u_indx)) deallocate(OutData%Jac_u_indx) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7122,7 +6547,6 @@ subroutine AD_UnPackRotParameterType(Buf, OutData) call RegUnpack(Buf, OutData%Jac_u_indx) if (RegCheckErr(Buf, RoutineName)) return end if - ! du if (allocated(OutData%du)) deallocate(OutData%du) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7137,7 +6561,6 @@ subroutine AD_UnPackRotParameterType(Buf, OutData) call RegUnpack(Buf, OutData%du) if (RegCheckErr(Buf, RoutineName)) return end if - ! dx if (allocated(OutData%dx)) deallocate(OutData%dx) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7152,73 +6575,50 @@ subroutine AD_UnPackRotParameterType(Buf, OutData) call RegUnpack(Buf, OutData%dx) if (RegCheckErr(Buf, RoutineName)) return end if - ! Jac_ny call RegUnpack(Buf, OutData%Jac_ny) if (RegCheckErr(Buf, RoutineName)) return - ! NumBl_Lin call RegUnpack(Buf, OutData%NumBl_Lin) if (RegCheckErr(Buf, RoutineName)) return - ! TwrPotent call RegUnpack(Buf, OutData%TwrPotent) if (RegCheckErr(Buf, RoutineName)) return - ! TwrShadow call RegUnpack(Buf, OutData%TwrShadow) if (RegCheckErr(Buf, RoutineName)) return - ! TwrAero call RegUnpack(Buf, OutData%TwrAero) if (RegCheckErr(Buf, RoutineName)) return - ! FrozenWake call RegUnpack(Buf, OutData%FrozenWake) if (RegCheckErr(Buf, RoutineName)) return - ! CavitCheck call RegUnpack(Buf, OutData%CavitCheck) if (RegCheckErr(Buf, RoutineName)) return - ! Buoyancy call RegUnpack(Buf, OutData%Buoyancy) if (RegCheckErr(Buf, RoutineName)) return - ! MHK call RegUnpack(Buf, OutData%MHK) if (RegCheckErr(Buf, RoutineName)) return - ! CompAA call RegUnpack(Buf, OutData%CompAA) if (RegCheckErr(Buf, RoutineName)) return - ! AirDens call RegUnpack(Buf, OutData%AirDens) if (RegCheckErr(Buf, RoutineName)) return - ! KinVisc call RegUnpack(Buf, OutData%KinVisc) if (RegCheckErr(Buf, RoutineName)) return - ! SpdSound call RegUnpack(Buf, OutData%SpdSound) if (RegCheckErr(Buf, RoutineName)) return - ! Gravity call RegUnpack(Buf, OutData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - ! Patm call RegUnpack(Buf, OutData%Patm) if (RegCheckErr(Buf, RoutineName)) return - ! Pvap call RegUnpack(Buf, OutData%Pvap) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDpth call RegUnpack(Buf, OutData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - ! MSL2SWL call RegUnpack(Buf, OutData%MSL2SWL) if (RegCheckErr(Buf, RoutineName)) return - ! AeroProjMod call RegUnpack(Buf, OutData%AeroProjMod) if (RegCheckErr(Buf, RoutineName)) return - ! AeroBEM_Mod call RegUnpack(Buf, OutData%AeroBEM_Mod) if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegUnpack(Buf, OutData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegUnpack(Buf, OutData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! OutParam if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7234,25 +6634,18 @@ subroutine AD_UnPackRotParameterType(Buf, OutData) call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam end do end if - ! NBlOuts call RegUnpack(Buf, OutData%NBlOuts) if (RegCheckErr(Buf, RoutineName)) return - ! BlOutNd call RegUnpack(Buf, OutData%BlOutNd) if (RegCheckErr(Buf, RoutineName)) return - ! NTwOuts call RegUnpack(Buf, OutData%NTwOuts) if (RegCheckErr(Buf, RoutineName)) return - ! TwOutNd call RegUnpack(Buf, OutData%TwOutNd) if (RegCheckErr(Buf, RoutineName)) return - ! BldNd_NumOuts call RegUnpack(Buf, OutData%BldNd_NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! BldNd_TotNumOuts call RegUnpack(Buf, OutData%BldNd_TotNumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! BldNd_OutParam if (allocated(OutData%BldNd_OutParam)) deallocate(OutData%BldNd_OutParam) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7268,7 +6661,6 @@ subroutine AD_UnPackRotParameterType(Buf, OutData) call NWTC_Library_UnpackOutParmType(Buf, OutData%BldNd_OutParam(i1)) ! BldNd_OutParam end do end if - ! BldNd_BlOutNd if (allocated(OutData%BldNd_BlOutNd)) deallocate(OutData%BldNd_BlOutNd) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7283,106 +6675,105 @@ subroutine AD_UnPackRotParameterType(Buf, OutData) call RegUnpack(Buf, OutData%BldNd_BlOutNd) if (RegCheckErr(Buf, RoutineName)) return end if - ! BldNd_BladesOut call RegUnpack(Buf, OutData%BldNd_BladesOut) if (RegCheckErr(Buf, RoutineName)) return - ! TFinAero call RegUnpack(Buf, OutData%TFinAero) if (RegCheckErr(Buf, RoutineName)) return - ! TFin call AD_UnpackTFinParameterType(Buf, OutData%TFin) ! TFin end subroutine - SUBROUTINE AD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD_ParameterType), INTENT(IN) :: SrcParamData - TYPE(AD_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_CopyParam' -! + +subroutine AD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(AD_ParameterType), intent(in) :: SrcParamData + type(AD_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyParam' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcParamData%rotors)) THEN - i1_l = LBOUND(SrcParamData%rotors,1) - i1_u = UBOUND(SrcParamData%rotors,1) - IF (.NOT. ALLOCATED(DstParamData%rotors)) THEN - ALLOCATE(DstParamData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%rotors,1), UBOUND(SrcParamData%rotors,1) - CALL AD_Copyrotparametertype( SrcParamData%rotors(i1), DstParamData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstParamData%DT = SrcParamData%DT - DstParamData%RootName = SrcParamData%RootName -IF (ALLOCATED(SrcParamData%AFI)) THEN - i1_l = LBOUND(SrcParamData%AFI,1) - i1_u = UBOUND(SrcParamData%AFI,1) - IF (.NOT. ALLOCATED(DstParamData%AFI)) THEN - ALLOCATE(DstParamData%AFI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%AFI,1), UBOUND(SrcParamData%AFI,1) - CALL AFI_CopyParam( SrcParamData%AFI(i1), DstParamData%AFI(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstParamData%SkewMod = SrcParamData%SkewMod - DstParamData%WakeMod = SrcParamData%WakeMod - CALL FVW_CopyParam( SrcParamData%FVW, DstParamData%FVW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstParamData%CompAeroMaps = SrcParamData%CompAeroMaps - DstParamData%UA_Flag = SrcParamData%UA_Flag - DstParamData%FlowField => SrcParamData%FlowField - END SUBROUTINE AD_CopyParam - - SUBROUTINE AD_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(AD_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%rotors)) THEN -DO i1 = LBOUND(ParamData%rotors,1), UBOUND(ParamData%rotors,1) - CALL AD_DestroyRotParameterType( ParamData%rotors(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%rotors) -ENDIF -IF (ALLOCATED(ParamData%AFI)) THEN -DO i1 = LBOUND(ParamData%AFI,1), UBOUND(ParamData%AFI,1) - CALL AFI_DestroyParam( ParamData%AFI(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%AFI) -ENDIF - CALL FVW_DestroyParam( ParamData%FVW, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -NULLIFY(ParamData%FlowField) - END SUBROUTINE AD_DestroyParam + ErrMsg = '' + if (allocated(SrcParamData%rotors)) then + LB(1:1) = lbound(SrcParamData%rotors) + UB(1:1) = ubound(SrcParamData%rotors) + if (.not. allocated(DstParamData%rotors)) then + allocate(DstParamData%rotors(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotors.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyRotParameterType(SrcParamData%rotors(i1), DstParamData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstParamData%rotors)) then + deallocate(DstParamData%rotors) + end if + DstParamData%DT = SrcParamData%DT + DstParamData%RootName = SrcParamData%RootName + if (allocated(SrcParamData%AFI)) then + LB(1:1) = lbound(SrcParamData%AFI) + UB(1:1) = ubound(SrcParamData%AFI) + if (.not. allocated(DstParamData%AFI)) then + allocate(DstParamData%AFI(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFI.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AFI_CopyParam(SrcParamData%AFI(i1), DstParamData%AFI(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstParamData%AFI)) then + deallocate(DstParamData%AFI) + end if + DstParamData%SkewMod = SrcParamData%SkewMod + DstParamData%WakeMod = SrcParamData%WakeMod + call FVW_CopyParam(SrcParamData%FVW, DstParamData%FVW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstParamData%CompAeroMaps = SrcParamData%CompAeroMaps + DstParamData%UA_Flag = SrcParamData%UA_Flag + DstParamData%FlowField => SrcParamData%FlowField +end subroutine +subroutine AD_DestroyParam(ParamData, ErrStat, ErrMsg) + type(AD_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%rotors)) then + LB(1:1) = lbound(ParamData%rotors) + UB(1:1) = ubound(ParamData%rotors) + do i1 = LB(1), UB(1) + call AD_DestroyRotParameterType(ParamData%rotors(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%rotors) + end if + if (allocated(ParamData%AFI)) then + LB(1:1) = lbound(ParamData%AFI) + UB(1:1) = ubound(ParamData%AFI) + do i1 = LB(1), UB(1) + call AFI_DestroyParam(ParamData%AFI(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%AFI) + end if + nullify(ParamData%FlowField) +end subroutine subroutine AD_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -7392,7 +6783,6 @@ subroutine AD_PackParam(Buf, Indata) integer(IntKi) :: LB(1), UB(1) logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return - ! rotors call RegPack(Buf, allocated(InData%rotors)) if (allocated(InData%rotors)) then call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) @@ -7403,13 +6793,10 @@ subroutine AD_PackParam(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! DT call RegPack(Buf, InData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegPack(Buf, InData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! AFI call RegPack(Buf, allocated(InData%AFI)) if (allocated(InData%AFI)) then call RegPackBounds(Buf, 1, lbound(InData%AFI), ubound(InData%AFI)) @@ -7420,22 +6807,16 @@ subroutine AD_PackParam(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! SkewMod call RegPack(Buf, InData%SkewMod) if (RegCheckErr(Buf, RoutineName)) return - ! WakeMod call RegPack(Buf, InData%WakeMod) if (RegCheckErr(Buf, RoutineName)) return - ! FVW call FVW_PackParam(Buf, InData%FVW) if (RegCheckErr(Buf, RoutineName)) return - ! CompAeroMaps call RegPack(Buf, InData%CompAeroMaps) if (RegCheckErr(Buf, RoutineName)) return - ! UA_Flag call RegPack(Buf, InData%UA_Flag) if (RegCheckErr(Buf, RoutineName)) return - ! FlowField call RegPack(Buf, associated(InData%FlowField)) if (associated(InData%FlowField)) then call RegPackPointer(Buf, c_loc(InData%FlowField), PtrInIndex) @@ -7457,7 +6838,6 @@ subroutine AD_UnPackParam(Buf, OutData) integer(IntKi) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return - ! rotors if (allocated(OutData%rotors)) deallocate(OutData%rotors) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7473,13 +6853,10 @@ subroutine AD_UnPackParam(Buf, OutData) call AD_UnpackRotParameterType(Buf, OutData%rotors(i1)) ! rotors end do end if - ! DT call RegUnpack(Buf, OutData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegUnpack(Buf, OutData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! AFI if (allocated(OutData%AFI)) deallocate(OutData%AFI) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7495,21 +6872,15 @@ subroutine AD_UnPackParam(Buf, OutData) call AFI_UnpackParam(Buf, OutData%AFI(i1)) ! AFI end do end if - ! SkewMod call RegUnpack(Buf, OutData%SkewMod) if (RegCheckErr(Buf, RoutineName)) return - ! WakeMod call RegUnpack(Buf, OutData%WakeMod) if (RegCheckErr(Buf, RoutineName)) return - ! FVW call FVW_UnpackParam(Buf, OutData%FVW) ! FVW - ! CompAeroMaps call RegUnpack(Buf, OutData%CompAeroMaps) if (RegCheckErr(Buf, RoutineName)) return - ! UA_Flag call RegUnpack(Buf, OutData%UA_Flag) if (RegCheckErr(Buf, RoutineName)) return - ! FlowField if (associated(OutData%FlowField)) deallocate(OutData%FlowField) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7531,162 +6902,154 @@ subroutine AD_UnPackParam(Buf, OutData) OutData%FlowField => null() end if end subroutine - SUBROUTINE AD_CopyRotInputType( SrcRotInputTypeData, DstRotInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(RotInputType), INTENT(INOUT) :: SrcRotInputTypeData - TYPE(RotInputType), INTENT(INOUT) :: DstRotInputTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_CopyRotInputType' -! + +subroutine AD_CopyRotInputType(SrcRotInputTypeData, DstRotInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(RotInputType), intent(inout) :: SrcRotInputTypeData + type(RotInputType), intent(inout) :: DstRotInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyRotInputType' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcRotInputTypeData%NacelleMotion, DstRotInputTypeData%NacelleMotion, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcRotInputTypeData%TowerMotion, DstRotInputTypeData%TowerMotion, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcRotInputTypeData%HubMotion, DstRotInputTypeData%HubMotion, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcRotInputTypeData%BladeRootMotion)) THEN - i1_l = LBOUND(SrcRotInputTypeData%BladeRootMotion,1) - i1_u = UBOUND(SrcRotInputTypeData%BladeRootMotion,1) - IF (.NOT. ALLOCATED(DstRotInputTypeData%BladeRootMotion)) THEN - ALLOCATE(DstRotInputTypeData%BladeRootMotion(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%BladeRootMotion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotInputTypeData%BladeRootMotion,1), UBOUND(SrcRotInputTypeData%BladeRootMotion,1) - CALL MeshCopy( SrcRotInputTypeData%BladeRootMotion(i1), DstRotInputTypeData%BladeRootMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcRotInputTypeData%BladeMotion)) THEN - i1_l = LBOUND(SrcRotInputTypeData%BladeMotion,1) - i1_u = UBOUND(SrcRotInputTypeData%BladeMotion,1) - IF (.NOT. ALLOCATED(DstRotInputTypeData%BladeMotion)) THEN - ALLOCATE(DstRotInputTypeData%BladeMotion(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%BladeMotion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotInputTypeData%BladeMotion,1), UBOUND(SrcRotInputTypeData%BladeMotion,1) - CALL MeshCopy( SrcRotInputTypeData%BladeMotion(i1), DstRotInputTypeData%BladeMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL MeshCopy( SrcRotInputTypeData%TFinMotion, DstRotInputTypeData%TFinMotion, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcRotInputTypeData%InflowOnBlade)) THEN - i1_l = LBOUND(SrcRotInputTypeData%InflowOnBlade,1) - i1_u = UBOUND(SrcRotInputTypeData%InflowOnBlade,1) - i2_l = LBOUND(SrcRotInputTypeData%InflowOnBlade,2) - i2_u = UBOUND(SrcRotInputTypeData%InflowOnBlade,2) - i3_l = LBOUND(SrcRotInputTypeData%InflowOnBlade,3) - i3_u = UBOUND(SrcRotInputTypeData%InflowOnBlade,3) - IF (.NOT. ALLOCATED(DstRotInputTypeData%InflowOnBlade)) THEN - ALLOCATE(DstRotInputTypeData%InflowOnBlade(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%InflowOnBlade.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInputTypeData%InflowOnBlade = SrcRotInputTypeData%InflowOnBlade -ENDIF -IF (ALLOCATED(SrcRotInputTypeData%InflowOnTower)) THEN - i1_l = LBOUND(SrcRotInputTypeData%InflowOnTower,1) - i1_u = UBOUND(SrcRotInputTypeData%InflowOnTower,1) - i2_l = LBOUND(SrcRotInputTypeData%InflowOnTower,2) - i2_u = UBOUND(SrcRotInputTypeData%InflowOnTower,2) - IF (.NOT. ALLOCATED(DstRotInputTypeData%InflowOnTower)) THEN - ALLOCATE(DstRotInputTypeData%InflowOnTower(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%InflowOnTower.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInputTypeData%InflowOnTower = SrcRotInputTypeData%InflowOnTower -ENDIF - DstRotInputTypeData%InflowOnHub = SrcRotInputTypeData%InflowOnHub - DstRotInputTypeData%InflowOnNacelle = SrcRotInputTypeData%InflowOnNacelle - DstRotInputTypeData%InflowOnTailFin = SrcRotInputTypeData%InflowOnTailFin -IF (ALLOCATED(SrcRotInputTypeData%UserProp)) THEN - i1_l = LBOUND(SrcRotInputTypeData%UserProp,1) - i1_u = UBOUND(SrcRotInputTypeData%UserProp,1) - i2_l = LBOUND(SrcRotInputTypeData%UserProp,2) - i2_u = UBOUND(SrcRotInputTypeData%UserProp,2) - IF (.NOT. ALLOCATED(DstRotInputTypeData%UserProp)) THEN - ALLOCATE(DstRotInputTypeData%UserProp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%UserProp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotInputTypeData%UserProp = SrcRotInputTypeData%UserProp -ENDIF - END SUBROUTINE AD_CopyRotInputType - - SUBROUTINE AD_DestroyRotInputType( RotInputTypeData, ErrStat, ErrMsg ) - TYPE(RotInputType), INTENT(INOUT) :: RotInputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyRotInputType' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL MeshDestroy( RotInputTypeData%NacelleMotion, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( RotInputTypeData%TowerMotion, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( RotInputTypeData%HubMotion, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(RotInputTypeData%BladeRootMotion)) THEN -DO i1 = LBOUND(RotInputTypeData%BladeRootMotion,1), UBOUND(RotInputTypeData%BladeRootMotion,1) - CALL MeshDestroy( RotInputTypeData%BladeRootMotion(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotInputTypeData%BladeRootMotion) -ENDIF -IF (ALLOCATED(RotInputTypeData%BladeMotion)) THEN -DO i1 = LBOUND(RotInputTypeData%BladeMotion,1), UBOUND(RotInputTypeData%BladeMotion,1) - CALL MeshDestroy( RotInputTypeData%BladeMotion(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotInputTypeData%BladeMotion) -ENDIF - CALL MeshDestroy( RotInputTypeData%TFinMotion, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(RotInputTypeData%InflowOnBlade)) THEN - DEALLOCATE(RotInputTypeData%InflowOnBlade) -ENDIF -IF (ALLOCATED(RotInputTypeData%InflowOnTower)) THEN - DEALLOCATE(RotInputTypeData%InflowOnTower) -ENDIF -IF (ALLOCATED(RotInputTypeData%UserProp)) THEN - DEALLOCATE(RotInputTypeData%UserProp) -ENDIF - END SUBROUTINE AD_DestroyRotInputType + ErrMsg = '' + call MeshCopy(SrcRotInputTypeData%NacelleMotion, DstRotInputTypeData%NacelleMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcRotInputTypeData%TowerMotion, DstRotInputTypeData%TowerMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcRotInputTypeData%HubMotion, DstRotInputTypeData%HubMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcRotInputTypeData%BladeRootMotion)) then + LB(1:1) = lbound(SrcRotInputTypeData%BladeRootMotion) + UB(1:1) = ubound(SrcRotInputTypeData%BladeRootMotion) + if (.not. allocated(DstRotInputTypeData%BladeRootMotion)) then + allocate(DstRotInputTypeData%BladeRootMotion(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%BladeRootMotion.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcRotInputTypeData%BladeRootMotion(i1), DstRotInputTypeData%BladeRootMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstRotInputTypeData%BladeRootMotion)) then + deallocate(DstRotInputTypeData%BladeRootMotion) + end if + if (allocated(SrcRotInputTypeData%BladeMotion)) then + LB(1:1) = lbound(SrcRotInputTypeData%BladeMotion) + UB(1:1) = ubound(SrcRotInputTypeData%BladeMotion) + if (.not. allocated(DstRotInputTypeData%BladeMotion)) then + allocate(DstRotInputTypeData%BladeMotion(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%BladeMotion.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcRotInputTypeData%BladeMotion(i1), DstRotInputTypeData%BladeMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstRotInputTypeData%BladeMotion)) then + deallocate(DstRotInputTypeData%BladeMotion) + end if + call MeshCopy(SrcRotInputTypeData%TFinMotion, DstRotInputTypeData%TFinMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcRotInputTypeData%InflowOnBlade)) then + LB(1:3) = lbound(SrcRotInputTypeData%InflowOnBlade) + UB(1:3) = ubound(SrcRotInputTypeData%InflowOnBlade) + if (.not. allocated(DstRotInputTypeData%InflowOnBlade)) then + allocate(DstRotInputTypeData%InflowOnBlade(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%InflowOnBlade.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInputTypeData%InflowOnBlade = SrcRotInputTypeData%InflowOnBlade + else if (allocated(DstRotInputTypeData%InflowOnBlade)) then + deallocate(DstRotInputTypeData%InflowOnBlade) + end if + if (allocated(SrcRotInputTypeData%InflowOnTower)) then + LB(1:2) = lbound(SrcRotInputTypeData%InflowOnTower) + UB(1:2) = ubound(SrcRotInputTypeData%InflowOnTower) + if (.not. allocated(DstRotInputTypeData%InflowOnTower)) then + allocate(DstRotInputTypeData%InflowOnTower(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%InflowOnTower.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInputTypeData%InflowOnTower = SrcRotInputTypeData%InflowOnTower + else if (allocated(DstRotInputTypeData%InflowOnTower)) then + deallocate(DstRotInputTypeData%InflowOnTower) + end if + DstRotInputTypeData%InflowOnHub = SrcRotInputTypeData%InflowOnHub + DstRotInputTypeData%InflowOnNacelle = SrcRotInputTypeData%InflowOnNacelle + DstRotInputTypeData%InflowOnTailFin = SrcRotInputTypeData%InflowOnTailFin + if (allocated(SrcRotInputTypeData%UserProp)) then + LB(1:2) = lbound(SrcRotInputTypeData%UserProp) + UB(1:2) = ubound(SrcRotInputTypeData%UserProp) + if (.not. allocated(DstRotInputTypeData%UserProp)) then + allocate(DstRotInputTypeData%UserProp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%UserProp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotInputTypeData%UserProp = SrcRotInputTypeData%UserProp + else if (allocated(DstRotInputTypeData%UserProp)) then + deallocate(DstRotInputTypeData%UserProp) + end if +end subroutine +subroutine AD_DestroyRotInputType(RotInputTypeData, ErrStat, ErrMsg) + type(RotInputType), intent(inout) :: RotInputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyRotInputType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(RotInputTypeData%BladeRootMotion)) then + LB(1:1) = lbound(RotInputTypeData%BladeRootMotion) + UB(1:1) = ubound(RotInputTypeData%BladeRootMotion) + do i1 = LB(1), UB(1) + call MeshDestroy( RotInputTypeData%BladeRootMotion(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotInputTypeData%BladeRootMotion) + end if + if (allocated(RotInputTypeData%BladeMotion)) then + LB(1:1) = lbound(RotInputTypeData%BladeMotion) + UB(1:1) = ubound(RotInputTypeData%BladeMotion) + do i1 = LB(1), UB(1) + call MeshDestroy( RotInputTypeData%BladeMotion(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotInputTypeData%BladeMotion) + end if + if (allocated(RotInputTypeData%InflowOnBlade)) then + deallocate(RotInputTypeData%InflowOnBlade) + end if + if (allocated(RotInputTypeData%InflowOnTower)) then + deallocate(RotInputTypeData%InflowOnTower) + end if + if (allocated(RotInputTypeData%UserProp)) then + deallocate(RotInputTypeData%UserProp) + end if +end subroutine subroutine AD_PackRotInputType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -7695,16 +7058,12 @@ subroutine AD_PackRotInputType(Buf, Indata) integer(IntKi) :: i1, i2, i3 integer(IntKi) :: LB(3), UB(3) if (Buf%ErrStat >= AbortErrLev) return - ! NacelleMotion call MeshPack(Buf, InData%NacelleMotion) if (RegCheckErr(Buf, RoutineName)) return - ! TowerMotion call MeshPack(Buf, InData%TowerMotion) if (RegCheckErr(Buf, RoutineName)) return - ! HubMotion call MeshPack(Buf, InData%HubMotion) if (RegCheckErr(Buf, RoutineName)) return - ! BladeRootMotion call RegPack(Buf, allocated(InData%BladeRootMotion)) if (allocated(InData%BladeRootMotion)) then call RegPackBounds(Buf, 1, lbound(InData%BladeRootMotion), ubound(InData%BladeRootMotion)) @@ -7715,7 +7074,6 @@ subroutine AD_PackRotInputType(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! BladeMotion call RegPack(Buf, allocated(InData%BladeMotion)) if (allocated(InData%BladeMotion)) then call RegPackBounds(Buf, 1, lbound(InData%BladeMotion), ubound(InData%BladeMotion)) @@ -7726,33 +7084,26 @@ subroutine AD_PackRotInputType(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! TFinMotion call MeshPack(Buf, InData%TFinMotion) if (RegCheckErr(Buf, RoutineName)) return - ! InflowOnBlade call RegPack(Buf, allocated(InData%InflowOnBlade)) if (allocated(InData%InflowOnBlade)) then call RegPackBounds(Buf, 3, lbound(InData%InflowOnBlade), ubound(InData%InflowOnBlade)) call RegPack(Buf, InData%InflowOnBlade) end if if (RegCheckErr(Buf, RoutineName)) return - ! InflowOnTower call RegPack(Buf, allocated(InData%InflowOnTower)) if (allocated(InData%InflowOnTower)) then call RegPackBounds(Buf, 2, lbound(InData%InflowOnTower), ubound(InData%InflowOnTower)) call RegPack(Buf, InData%InflowOnTower) end if if (RegCheckErr(Buf, RoutineName)) return - ! InflowOnHub call RegPack(Buf, InData%InflowOnHub) if (RegCheckErr(Buf, RoutineName)) return - ! InflowOnNacelle call RegPack(Buf, InData%InflowOnNacelle) if (RegCheckErr(Buf, RoutineName)) return - ! InflowOnTailFin call RegPack(Buf, InData%InflowOnTailFin) if (RegCheckErr(Buf, RoutineName)) return - ! UserProp call RegPack(Buf, allocated(InData%UserProp)) if (allocated(InData%UserProp)) then call RegPackBounds(Buf, 2, lbound(InData%UserProp), ubound(InData%UserProp)) @@ -7770,13 +7121,9 @@ subroutine AD_UnPackRotInputType(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! NacelleMotion call MeshUnpack(Buf, OutData%NacelleMotion) ! NacelleMotion - ! TowerMotion call MeshUnpack(Buf, OutData%TowerMotion) ! TowerMotion - ! HubMotion call MeshUnpack(Buf, OutData%HubMotion) ! HubMotion - ! BladeRootMotion if (allocated(OutData%BladeRootMotion)) deallocate(OutData%BladeRootMotion) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7792,7 +7139,6 @@ subroutine AD_UnPackRotInputType(Buf, OutData) call MeshUnpack(Buf, OutData%BladeRootMotion(i1)) ! BladeRootMotion end do end if - ! BladeMotion if (allocated(OutData%BladeMotion)) deallocate(OutData%BladeMotion) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7808,9 +7154,7 @@ subroutine AD_UnPackRotInputType(Buf, OutData) call MeshUnpack(Buf, OutData%BladeMotion(i1)) ! BladeMotion end do end if - ! TFinMotion call MeshUnpack(Buf, OutData%TFinMotion) ! TFinMotion - ! InflowOnBlade if (allocated(OutData%InflowOnBlade)) deallocate(OutData%InflowOnBlade) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7825,7 +7169,6 @@ subroutine AD_UnPackRotInputType(Buf, OutData) call RegUnpack(Buf, OutData%InflowOnBlade) if (RegCheckErr(Buf, RoutineName)) return end if - ! InflowOnTower if (allocated(OutData%InflowOnTower)) deallocate(OutData%InflowOnTower) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7840,16 +7183,12 @@ subroutine AD_UnPackRotInputType(Buf, OutData) call RegUnpack(Buf, OutData%InflowOnTower) if (RegCheckErr(Buf, RoutineName)) return end if - ! InflowOnHub call RegUnpack(Buf, OutData%InflowOnHub) if (RegCheckErr(Buf, RoutineName)) return - ! InflowOnNacelle call RegUnpack(Buf, OutData%InflowOnNacelle) if (RegCheckErr(Buf, RoutineName)) return - ! InflowOnTailFin call RegUnpack(Buf, OutData%InflowOnTailFin) if (RegCheckErr(Buf, RoutineName)) return - ! UserProp if (allocated(OutData%UserProp)) deallocate(OutData%UserProp) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7865,79 +7204,78 @@ subroutine AD_UnPackRotInputType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE AD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD_InputType), INTENT(INOUT) :: SrcInputData - TYPE(AD_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_CopyInput' -! + +subroutine AD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(AD_InputType), intent(inout) :: SrcInputData + type(AD_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyInput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInputData%rotors)) THEN - i1_l = LBOUND(SrcInputData%rotors,1) - i1_u = UBOUND(SrcInputData%rotors,1) - IF (.NOT. ALLOCATED(DstInputData%rotors)) THEN - ALLOCATE(DstInputData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputData%rotors,1), UBOUND(SrcInputData%rotors,1) - CALL AD_Copyrotinputtype( SrcInputData%rotors(i1), DstInputData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInputData%InflowWakeVel)) THEN - i1_l = LBOUND(SrcInputData%InflowWakeVel,1) - i1_u = UBOUND(SrcInputData%InflowWakeVel,1) - i2_l = LBOUND(SrcInputData%InflowWakeVel,2) - i2_u = UBOUND(SrcInputData%InflowWakeVel,2) - IF (.NOT. ALLOCATED(DstInputData%InflowWakeVel)) THEN - ALLOCATE(DstInputData%InflowWakeVel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%InflowWakeVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%InflowWakeVel = SrcInputData%InflowWakeVel -ENDIF - END SUBROUTINE AD_CopyInput - - SUBROUTINE AD_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(AD_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputData%rotors)) THEN -DO i1 = LBOUND(InputData%rotors,1), UBOUND(InputData%rotors,1) - CALL AD_DestroyRotInputType( InputData%rotors(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InputData%rotors) -ENDIF -IF (ALLOCATED(InputData%InflowWakeVel)) THEN - DEALLOCATE(InputData%InflowWakeVel) -ENDIF - END SUBROUTINE AD_DestroyInput + ErrMsg = '' + if (allocated(SrcInputData%rotors)) then + LB(1:1) = lbound(SrcInputData%rotors) + UB(1:1) = ubound(SrcInputData%rotors) + if (.not. allocated(DstInputData%rotors)) then + allocate(DstInputData%rotors(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%rotors.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyRotInputType(SrcInputData%rotors(i1), DstInputData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstInputData%rotors)) then + deallocate(DstInputData%rotors) + end if + if (allocated(SrcInputData%InflowWakeVel)) then + LB(1:2) = lbound(SrcInputData%InflowWakeVel) + UB(1:2) = ubound(SrcInputData%InflowWakeVel) + if (.not. allocated(DstInputData%InflowWakeVel)) then + allocate(DstInputData%InflowWakeVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%InflowWakeVel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%InflowWakeVel = SrcInputData%InflowWakeVel + else if (allocated(DstInputData%InflowWakeVel)) then + deallocate(DstInputData%InflowWakeVel) + end if +end subroutine +subroutine AD_DestroyInput(InputData, ErrStat, ErrMsg) + type(AD_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%rotors)) then + LB(1:1) = lbound(InputData%rotors) + UB(1:1) = ubound(InputData%rotors) + do i1 = LB(1), UB(1) + call AD_DestroyRotInputType(InputData%rotors(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputData%rotors) + end if + if (allocated(InputData%InflowWakeVel)) then + deallocate(InputData%InflowWakeVel) + end if +end subroutine subroutine AD_PackInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -7946,7 +7284,6 @@ subroutine AD_PackInput(Buf, Indata) integer(IntKi) :: i1, i2 integer(IntKi) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return - ! rotors call RegPack(Buf, allocated(InData%rotors)) if (allocated(InData%rotors)) then call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) @@ -7957,7 +7294,6 @@ subroutine AD_PackInput(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! InflowWakeVel call RegPack(Buf, allocated(InData%InflowWakeVel)) if (allocated(InData%InflowWakeVel)) then call RegPackBounds(Buf, 2, lbound(InData%InflowWakeVel), ubound(InData%InflowWakeVel)) @@ -7975,7 +7311,6 @@ subroutine AD_UnPackInput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! rotors if (allocated(OutData%rotors)) deallocate(OutData%rotors) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7991,7 +7326,6 @@ subroutine AD_UnPackInput(Buf, OutData) call AD_UnpackRotInputType(Buf, OutData%rotors(i1)) ! rotors end do end if - ! InflowWakeVel if (allocated(OutData%InflowWakeVel)) deallocate(OutData%InflowWakeVel) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8007,96 +7341,90 @@ subroutine AD_UnPackInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE AD_CopyRotOutputType( SrcRotOutputTypeData, DstRotOutputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(RotOutputType), INTENT(INOUT) :: SrcRotOutputTypeData - TYPE(RotOutputType), INTENT(INOUT) :: DstRotOutputTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_CopyRotOutputType' -! + +subroutine AD_CopyRotOutputType(SrcRotOutputTypeData, DstRotOutputTypeData, CtrlCode, ErrStat, ErrMsg) + type(RotOutputType), intent(inout) :: SrcRotOutputTypeData + type(RotOutputType), intent(inout) :: DstRotOutputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyRotOutputType' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcRotOutputTypeData%NacelleLoad, DstRotOutputTypeData%NacelleLoad, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcRotOutputTypeData%HubLoad, DstRotOutputTypeData%HubLoad, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcRotOutputTypeData%TowerLoad, DstRotOutputTypeData%TowerLoad, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcRotOutputTypeData%BladeLoad)) THEN - i1_l = LBOUND(SrcRotOutputTypeData%BladeLoad,1) - i1_u = UBOUND(SrcRotOutputTypeData%BladeLoad,1) - IF (.NOT. ALLOCATED(DstRotOutputTypeData%BladeLoad)) THEN - ALLOCATE(DstRotOutputTypeData%BladeLoad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotOutputTypeData%BladeLoad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcRotOutputTypeData%BladeLoad,1), UBOUND(SrcRotOutputTypeData%BladeLoad,1) - CALL MeshCopy( SrcRotOutputTypeData%BladeLoad(i1), DstRotOutputTypeData%BladeLoad(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL MeshCopy( SrcRotOutputTypeData%TFinLoad, DstRotOutputTypeData%TFinLoad, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcRotOutputTypeData%WriteOutput)) THEN - i1_l = LBOUND(SrcRotOutputTypeData%WriteOutput,1) - i1_u = UBOUND(SrcRotOutputTypeData%WriteOutput,1) - IF (.NOT. ALLOCATED(DstRotOutputTypeData%WriteOutput)) THEN - ALLOCATE(DstRotOutputTypeData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotOutputTypeData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRotOutputTypeData%WriteOutput = SrcRotOutputTypeData%WriteOutput -ENDIF - END SUBROUTINE AD_CopyRotOutputType - - SUBROUTINE AD_DestroyRotOutputType( RotOutputTypeData, ErrStat, ErrMsg ) - TYPE(RotOutputType), INTENT(INOUT) :: RotOutputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyRotOutputType' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL MeshDestroy( RotOutputTypeData%NacelleLoad, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( RotOutputTypeData%HubLoad, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( RotOutputTypeData%TowerLoad, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(RotOutputTypeData%BladeLoad)) THEN -DO i1 = LBOUND(RotOutputTypeData%BladeLoad,1), UBOUND(RotOutputTypeData%BladeLoad,1) - CALL MeshDestroy( RotOutputTypeData%BladeLoad(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(RotOutputTypeData%BladeLoad) -ENDIF - CALL MeshDestroy( RotOutputTypeData%TFinLoad, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(RotOutputTypeData%WriteOutput)) THEN - DEALLOCATE(RotOutputTypeData%WriteOutput) -ENDIF - END SUBROUTINE AD_DestroyRotOutputType + ErrMsg = '' + call MeshCopy(SrcRotOutputTypeData%NacelleLoad, DstRotOutputTypeData%NacelleLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcRotOutputTypeData%HubLoad, DstRotOutputTypeData%HubLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcRotOutputTypeData%TowerLoad, DstRotOutputTypeData%TowerLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcRotOutputTypeData%BladeLoad)) then + LB(1:1) = lbound(SrcRotOutputTypeData%BladeLoad) + UB(1:1) = ubound(SrcRotOutputTypeData%BladeLoad) + if (.not. allocated(DstRotOutputTypeData%BladeLoad)) then + allocate(DstRotOutputTypeData%BladeLoad(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotOutputTypeData%BladeLoad.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcRotOutputTypeData%BladeLoad(i1), DstRotOutputTypeData%BladeLoad(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstRotOutputTypeData%BladeLoad)) then + deallocate(DstRotOutputTypeData%BladeLoad) + end if + call MeshCopy(SrcRotOutputTypeData%TFinLoad, DstRotOutputTypeData%TFinLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcRotOutputTypeData%WriteOutput)) then + LB(1:1) = lbound(SrcRotOutputTypeData%WriteOutput) + UB(1:1) = ubound(SrcRotOutputTypeData%WriteOutput) + if (.not. allocated(DstRotOutputTypeData%WriteOutput)) then + allocate(DstRotOutputTypeData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotOutputTypeData%WriteOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotOutputTypeData%WriteOutput = SrcRotOutputTypeData%WriteOutput + else if (allocated(DstRotOutputTypeData%WriteOutput)) then + deallocate(DstRotOutputTypeData%WriteOutput) + end if +end subroutine +subroutine AD_DestroyRotOutputType(RotOutputTypeData, ErrStat, ErrMsg) + type(RotOutputType), intent(inout) :: RotOutputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyRotOutputType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(RotOutputTypeData%BladeLoad)) then + LB(1:1) = lbound(RotOutputTypeData%BladeLoad) + UB(1:1) = ubound(RotOutputTypeData%BladeLoad) + do i1 = LB(1), UB(1) + call MeshDestroy( RotOutputTypeData%BladeLoad(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotOutputTypeData%BladeLoad) + end if + if (allocated(RotOutputTypeData%WriteOutput)) then + deallocate(RotOutputTypeData%WriteOutput) + end if +end subroutine subroutine AD_PackRotOutputType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -8105,16 +7433,12 @@ subroutine AD_PackRotOutputType(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! NacelleLoad call MeshPack(Buf, InData%NacelleLoad) if (RegCheckErr(Buf, RoutineName)) return - ! HubLoad call MeshPack(Buf, InData%HubLoad) if (RegCheckErr(Buf, RoutineName)) return - ! TowerLoad call MeshPack(Buf, InData%TowerLoad) if (RegCheckErr(Buf, RoutineName)) return - ! BladeLoad call RegPack(Buf, allocated(InData%BladeLoad)) if (allocated(InData%BladeLoad)) then call RegPackBounds(Buf, 1, lbound(InData%BladeLoad), ubound(InData%BladeLoad)) @@ -8125,10 +7449,8 @@ subroutine AD_PackRotOutputType(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! TFinLoad call MeshPack(Buf, InData%TFinLoad) if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutput call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) @@ -8146,13 +7468,9 @@ subroutine AD_UnPackRotOutputType(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! NacelleLoad call MeshUnpack(Buf, OutData%NacelleLoad) ! NacelleLoad - ! HubLoad call MeshUnpack(Buf, OutData%HubLoad) ! HubLoad - ! TowerLoad call MeshUnpack(Buf, OutData%TowerLoad) ! TowerLoad - ! BladeLoad if (allocated(OutData%BladeLoad)) deallocate(OutData%BladeLoad) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8168,9 +7486,7 @@ subroutine AD_UnPackRotOutputType(Buf, OutData) call MeshUnpack(Buf, OutData%BladeLoad(i1)) ! BladeLoad end do end if - ! TFinLoad call MeshUnpack(Buf, OutData%TFinLoad) ! TFinLoad - ! WriteOutput if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8186,61 +7502,61 @@ subroutine AD_UnPackRotOutputType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE AD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(AD_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_CopyOutput' -! + +subroutine AD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(AD_OutputType), intent(inout) :: SrcOutputData + type(AD_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyOutput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%rotors)) THEN - i1_l = LBOUND(SrcOutputData%rotors,1) - i1_u = UBOUND(SrcOutputData%rotors,1) - IF (.NOT. ALLOCATED(DstOutputData%rotors)) THEN - ALLOCATE(DstOutputData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOutputData%rotors,1), UBOUND(SrcOutputData%rotors,1) - CALL AD_Copyrotoutputtype( SrcOutputData%rotors(i1), DstOutputData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE AD_CopyOutput - - SUBROUTINE AD_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(AD_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OutputData%rotors)) THEN -DO i1 = LBOUND(OutputData%rotors,1), UBOUND(OutputData%rotors,1) - CALL AD_DestroyRotOutputType( OutputData%rotors(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OutputData%rotors) -ENDIF - END SUBROUTINE AD_DestroyOutput + ErrMsg = '' + if (allocated(SrcOutputData%rotors)) then + LB(1:1) = lbound(SrcOutputData%rotors) + UB(1:1) = ubound(SrcOutputData%rotors) + if (.not. allocated(DstOutputData%rotors)) then + allocate(DstOutputData%rotors(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%rotors.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyRotOutputType(SrcOutputData%rotors(i1), DstOutputData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstOutputData%rotors)) then + deallocate(DstOutputData%rotors) + end if +end subroutine +subroutine AD_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(AD_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%rotors)) then + LB(1:1) = lbound(OutputData%rotors) + UB(1:1) = ubound(OutputData%rotors) + do i1 = LB(1), UB(1) + call AD_DestroyRotOutputType(OutputData%rotors(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%rotors) + end if +end subroutine subroutine AD_PackOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -8249,7 +7565,6 @@ subroutine AD_PackOutput(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! rotors call RegPack(Buf, allocated(InData%rotors)) if (allocated(InData%rotors)) then call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) @@ -8271,7 +7586,6 @@ subroutine AD_UnPackOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! rotors if (allocated(OutData%rotors)) deallocate(OutData%rotors) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/aerodyn/src/AirfoilInfo_Types.f90 b/modules/aerodyn/src/AirfoilInfo_Types.f90 index 3f7ff3df35..5754a34613 100644 --- a/modules/aerodyn/src/AirfoilInfo_Types.f90 +++ b/modules/aerodyn/src/AirfoilInfo_Types.f90 @@ -199,229 +199,171 @@ MODULE AirfoilInfo_Types END TYPE AFI_OutputType ! ======================= CONTAINS - SUBROUTINE AFI_CopyUA_BL_Type( SrcUA_BL_TypeData, DstUA_BL_TypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AFI_UA_BL_Type), INTENT(IN) :: SrcUA_BL_TypeData - TYPE(AFI_UA_BL_Type), INTENT(INOUT) :: DstUA_BL_TypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_CopyUA_BL_Type' -! - ErrStat = ErrID_None - ErrMsg = "" - DstUA_BL_TypeData%alpha0 = SrcUA_BL_TypeData%alpha0 - DstUA_BL_TypeData%alpha1 = SrcUA_BL_TypeData%alpha1 - DstUA_BL_TypeData%alpha2 = SrcUA_BL_TypeData%alpha2 - DstUA_BL_TypeData%eta_e = SrcUA_BL_TypeData%eta_e - DstUA_BL_TypeData%C_nalpha = SrcUA_BL_TypeData%C_nalpha - DstUA_BL_TypeData%C_lalpha = SrcUA_BL_TypeData%C_lalpha - DstUA_BL_TypeData%T_f0 = SrcUA_BL_TypeData%T_f0 - DstUA_BL_TypeData%T_V0 = SrcUA_BL_TypeData%T_V0 - DstUA_BL_TypeData%T_p = SrcUA_BL_TypeData%T_p - DstUA_BL_TypeData%T_VL = SrcUA_BL_TypeData%T_VL - DstUA_BL_TypeData%b1 = SrcUA_BL_TypeData%b1 - DstUA_BL_TypeData%b2 = SrcUA_BL_TypeData%b2 - DstUA_BL_TypeData%b5 = SrcUA_BL_TypeData%b5 - DstUA_BL_TypeData%A1 = SrcUA_BL_TypeData%A1 - DstUA_BL_TypeData%A2 = SrcUA_BL_TypeData%A2 - DstUA_BL_TypeData%A5 = SrcUA_BL_TypeData%A5 - DstUA_BL_TypeData%S1 = SrcUA_BL_TypeData%S1 - DstUA_BL_TypeData%S2 = SrcUA_BL_TypeData%S2 - DstUA_BL_TypeData%S3 = SrcUA_BL_TypeData%S3 - DstUA_BL_TypeData%S4 = SrcUA_BL_TypeData%S4 - DstUA_BL_TypeData%Cn1 = SrcUA_BL_TypeData%Cn1 - DstUA_BL_TypeData%Cn2 = SrcUA_BL_TypeData%Cn2 - DstUA_BL_TypeData%St_sh = SrcUA_BL_TypeData%St_sh - DstUA_BL_TypeData%Cd0 = SrcUA_BL_TypeData%Cd0 - DstUA_BL_TypeData%Cm0 = SrcUA_BL_TypeData%Cm0 - DstUA_BL_TypeData%k0 = SrcUA_BL_TypeData%k0 - DstUA_BL_TypeData%k1 = SrcUA_BL_TypeData%k1 - DstUA_BL_TypeData%k2 = SrcUA_BL_TypeData%k2 - DstUA_BL_TypeData%k3 = SrcUA_BL_TypeData%k3 - DstUA_BL_TypeData%k1_hat = SrcUA_BL_TypeData%k1_hat - DstUA_BL_TypeData%x_cp_bar = SrcUA_BL_TypeData%x_cp_bar - DstUA_BL_TypeData%UACutout = SrcUA_BL_TypeData%UACutout - DstUA_BL_TypeData%UACutout_delta = SrcUA_BL_TypeData%UACutout_delta - DstUA_BL_TypeData%UACutout_blend = SrcUA_BL_TypeData%UACutout_blend - DstUA_BL_TypeData%filtCutOff = SrcUA_BL_TypeData%filtCutOff - DstUA_BL_TypeData%alphaUpper = SrcUA_BL_TypeData%alphaUpper - DstUA_BL_TypeData%alphaLower = SrcUA_BL_TypeData%alphaLower - DstUA_BL_TypeData%c_Rate = SrcUA_BL_TypeData%c_Rate - DstUA_BL_TypeData%c_RateUpper = SrcUA_BL_TypeData%c_RateUpper - DstUA_BL_TypeData%c_RateLower = SrcUA_BL_TypeData%c_RateLower - DstUA_BL_TypeData%c_alphaLower = SrcUA_BL_TypeData%c_alphaLower - DstUA_BL_TypeData%c_alphaUpper = SrcUA_BL_TypeData%c_alphaUpper - DstUA_BL_TypeData%alphaUpperWrap = SrcUA_BL_TypeData%alphaUpperWrap - DstUA_BL_TypeData%alphaLowerWrap = SrcUA_BL_TypeData%alphaLowerWrap - DstUA_BL_TypeData%c_RateWrap = SrcUA_BL_TypeData%c_RateWrap - DstUA_BL_TypeData%c_alphaLowerWrap = SrcUA_BL_TypeData%c_alphaLowerWrap - DstUA_BL_TypeData%c_alphaUpperWrap = SrcUA_BL_TypeData%c_alphaUpperWrap - END SUBROUTINE AFI_CopyUA_BL_Type - - SUBROUTINE AFI_DestroyUA_BL_Type( UA_BL_TypeData, ErrStat, ErrMsg ) - TYPE(AFI_UA_BL_Type), INTENT(INOUT) :: UA_BL_TypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_DestroyUA_BL_Type' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE AFI_DestroyUA_BL_Type +subroutine AFI_CopyUA_BL_Type(SrcUA_BL_TypeData, DstUA_BL_TypeData, CtrlCode, ErrStat, ErrMsg) + type(AFI_UA_BL_Type), intent(in) :: SrcUA_BL_TypeData + type(AFI_UA_BL_Type), intent(inout) :: DstUA_BL_TypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AFI_CopyUA_BL_Type' + ErrStat = ErrID_None + ErrMsg = '' + DstUA_BL_TypeData%alpha0 = SrcUA_BL_TypeData%alpha0 + DstUA_BL_TypeData%alpha1 = SrcUA_BL_TypeData%alpha1 + DstUA_BL_TypeData%alpha2 = SrcUA_BL_TypeData%alpha2 + DstUA_BL_TypeData%eta_e = SrcUA_BL_TypeData%eta_e + DstUA_BL_TypeData%C_nalpha = SrcUA_BL_TypeData%C_nalpha + DstUA_BL_TypeData%C_lalpha = SrcUA_BL_TypeData%C_lalpha + DstUA_BL_TypeData%T_f0 = SrcUA_BL_TypeData%T_f0 + DstUA_BL_TypeData%T_V0 = SrcUA_BL_TypeData%T_V0 + DstUA_BL_TypeData%T_p = SrcUA_BL_TypeData%T_p + DstUA_BL_TypeData%T_VL = SrcUA_BL_TypeData%T_VL + DstUA_BL_TypeData%b1 = SrcUA_BL_TypeData%b1 + DstUA_BL_TypeData%b2 = SrcUA_BL_TypeData%b2 + DstUA_BL_TypeData%b5 = SrcUA_BL_TypeData%b5 + DstUA_BL_TypeData%A1 = SrcUA_BL_TypeData%A1 + DstUA_BL_TypeData%A2 = SrcUA_BL_TypeData%A2 + DstUA_BL_TypeData%A5 = SrcUA_BL_TypeData%A5 + DstUA_BL_TypeData%S1 = SrcUA_BL_TypeData%S1 + DstUA_BL_TypeData%S2 = SrcUA_BL_TypeData%S2 + DstUA_BL_TypeData%S3 = SrcUA_BL_TypeData%S3 + DstUA_BL_TypeData%S4 = SrcUA_BL_TypeData%S4 + DstUA_BL_TypeData%Cn1 = SrcUA_BL_TypeData%Cn1 + DstUA_BL_TypeData%Cn2 = SrcUA_BL_TypeData%Cn2 + DstUA_BL_TypeData%St_sh = SrcUA_BL_TypeData%St_sh + DstUA_BL_TypeData%Cd0 = SrcUA_BL_TypeData%Cd0 + DstUA_BL_TypeData%Cm0 = SrcUA_BL_TypeData%Cm0 + DstUA_BL_TypeData%k0 = SrcUA_BL_TypeData%k0 + DstUA_BL_TypeData%k1 = SrcUA_BL_TypeData%k1 + DstUA_BL_TypeData%k2 = SrcUA_BL_TypeData%k2 + DstUA_BL_TypeData%k3 = SrcUA_BL_TypeData%k3 + DstUA_BL_TypeData%k1_hat = SrcUA_BL_TypeData%k1_hat + DstUA_BL_TypeData%x_cp_bar = SrcUA_BL_TypeData%x_cp_bar + DstUA_BL_TypeData%UACutout = SrcUA_BL_TypeData%UACutout + DstUA_BL_TypeData%UACutout_delta = SrcUA_BL_TypeData%UACutout_delta + DstUA_BL_TypeData%UACutout_blend = SrcUA_BL_TypeData%UACutout_blend + DstUA_BL_TypeData%filtCutOff = SrcUA_BL_TypeData%filtCutOff + DstUA_BL_TypeData%alphaUpper = SrcUA_BL_TypeData%alphaUpper + DstUA_BL_TypeData%alphaLower = SrcUA_BL_TypeData%alphaLower + DstUA_BL_TypeData%c_Rate = SrcUA_BL_TypeData%c_Rate + DstUA_BL_TypeData%c_RateUpper = SrcUA_BL_TypeData%c_RateUpper + DstUA_BL_TypeData%c_RateLower = SrcUA_BL_TypeData%c_RateLower + DstUA_BL_TypeData%c_alphaLower = SrcUA_BL_TypeData%c_alphaLower + DstUA_BL_TypeData%c_alphaUpper = SrcUA_BL_TypeData%c_alphaUpper + DstUA_BL_TypeData%alphaUpperWrap = SrcUA_BL_TypeData%alphaUpperWrap + DstUA_BL_TypeData%alphaLowerWrap = SrcUA_BL_TypeData%alphaLowerWrap + DstUA_BL_TypeData%c_RateWrap = SrcUA_BL_TypeData%c_RateWrap + DstUA_BL_TypeData%c_alphaLowerWrap = SrcUA_BL_TypeData%c_alphaLowerWrap + DstUA_BL_TypeData%c_alphaUpperWrap = SrcUA_BL_TypeData%c_alphaUpperWrap +end subroutine +subroutine AFI_DestroyUA_BL_Type(UA_BL_TypeData, ErrStat, ErrMsg) + type(AFI_UA_BL_Type), intent(inout) :: UA_BL_TypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AFI_DestroyUA_BL_Type' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine AFI_PackUA_BL_Type(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AFI_UA_BL_Type), intent(in) :: InData character(*), parameter :: RoutineName = 'AFI_PackUA_BL_Type' if (Buf%ErrStat >= AbortErrLev) return - ! alpha0 call RegPack(Buf, InData%alpha0) if (RegCheckErr(Buf, RoutineName)) return - ! alpha1 call RegPack(Buf, InData%alpha1) if (RegCheckErr(Buf, RoutineName)) return - ! alpha2 call RegPack(Buf, InData%alpha2) if (RegCheckErr(Buf, RoutineName)) return - ! eta_e call RegPack(Buf, InData%eta_e) if (RegCheckErr(Buf, RoutineName)) return - ! C_nalpha call RegPack(Buf, InData%C_nalpha) if (RegCheckErr(Buf, RoutineName)) return - ! C_lalpha call RegPack(Buf, InData%C_lalpha) if (RegCheckErr(Buf, RoutineName)) return - ! T_f0 call RegPack(Buf, InData%T_f0) if (RegCheckErr(Buf, RoutineName)) return - ! T_V0 call RegPack(Buf, InData%T_V0) if (RegCheckErr(Buf, RoutineName)) return - ! T_p call RegPack(Buf, InData%T_p) if (RegCheckErr(Buf, RoutineName)) return - ! T_VL call RegPack(Buf, InData%T_VL) if (RegCheckErr(Buf, RoutineName)) return - ! b1 call RegPack(Buf, InData%b1) if (RegCheckErr(Buf, RoutineName)) return - ! b2 call RegPack(Buf, InData%b2) if (RegCheckErr(Buf, RoutineName)) return - ! b5 call RegPack(Buf, InData%b5) if (RegCheckErr(Buf, RoutineName)) return - ! A1 call RegPack(Buf, InData%A1) if (RegCheckErr(Buf, RoutineName)) return - ! A2 call RegPack(Buf, InData%A2) if (RegCheckErr(Buf, RoutineName)) return - ! A5 call RegPack(Buf, InData%A5) if (RegCheckErr(Buf, RoutineName)) return - ! S1 call RegPack(Buf, InData%S1) if (RegCheckErr(Buf, RoutineName)) return - ! S2 call RegPack(Buf, InData%S2) if (RegCheckErr(Buf, RoutineName)) return - ! S3 call RegPack(Buf, InData%S3) if (RegCheckErr(Buf, RoutineName)) return - ! S4 call RegPack(Buf, InData%S4) if (RegCheckErr(Buf, RoutineName)) return - ! Cn1 call RegPack(Buf, InData%Cn1) if (RegCheckErr(Buf, RoutineName)) return - ! Cn2 call RegPack(Buf, InData%Cn2) if (RegCheckErr(Buf, RoutineName)) return - ! St_sh call RegPack(Buf, InData%St_sh) if (RegCheckErr(Buf, RoutineName)) return - ! Cd0 call RegPack(Buf, InData%Cd0) if (RegCheckErr(Buf, RoutineName)) return - ! Cm0 call RegPack(Buf, InData%Cm0) if (RegCheckErr(Buf, RoutineName)) return - ! k0 call RegPack(Buf, InData%k0) if (RegCheckErr(Buf, RoutineName)) return - ! k1 call RegPack(Buf, InData%k1) if (RegCheckErr(Buf, RoutineName)) return - ! k2 call RegPack(Buf, InData%k2) if (RegCheckErr(Buf, RoutineName)) return - ! k3 call RegPack(Buf, InData%k3) if (RegCheckErr(Buf, RoutineName)) return - ! k1_hat call RegPack(Buf, InData%k1_hat) if (RegCheckErr(Buf, RoutineName)) return - ! x_cp_bar call RegPack(Buf, InData%x_cp_bar) if (RegCheckErr(Buf, RoutineName)) return - ! UACutout call RegPack(Buf, InData%UACutout) if (RegCheckErr(Buf, RoutineName)) return - ! UACutout_delta call RegPack(Buf, InData%UACutout_delta) if (RegCheckErr(Buf, RoutineName)) return - ! UACutout_blend call RegPack(Buf, InData%UACutout_blend) if (RegCheckErr(Buf, RoutineName)) return - ! filtCutOff call RegPack(Buf, InData%filtCutOff) if (RegCheckErr(Buf, RoutineName)) return - ! alphaUpper call RegPack(Buf, InData%alphaUpper) if (RegCheckErr(Buf, RoutineName)) return - ! alphaLower call RegPack(Buf, InData%alphaLower) if (RegCheckErr(Buf, RoutineName)) return - ! c_Rate call RegPack(Buf, InData%c_Rate) if (RegCheckErr(Buf, RoutineName)) return - ! c_RateUpper call RegPack(Buf, InData%c_RateUpper) if (RegCheckErr(Buf, RoutineName)) return - ! c_RateLower call RegPack(Buf, InData%c_RateLower) if (RegCheckErr(Buf, RoutineName)) return - ! c_alphaLower call RegPack(Buf, InData%c_alphaLower) if (RegCheckErr(Buf, RoutineName)) return - ! c_alphaUpper call RegPack(Buf, InData%c_alphaUpper) if (RegCheckErr(Buf, RoutineName)) return - ! alphaUpperWrap call RegPack(Buf, InData%alphaUpperWrap) if (RegCheckErr(Buf, RoutineName)) return - ! alphaLowerWrap call RegPack(Buf, InData%alphaLowerWrap) if (RegCheckErr(Buf, RoutineName)) return - ! c_RateWrap call RegPack(Buf, InData%c_RateWrap) if (RegCheckErr(Buf, RoutineName)) return - ! c_alphaLowerWrap call RegPack(Buf, InData%c_alphaLowerWrap) if (RegCheckErr(Buf, RoutineName)) return - ! c_alphaUpperWrap call RegPack(Buf, InData%c_alphaUpperWrap) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -431,327 +373,233 @@ subroutine AFI_UnPackUA_BL_Type(Buf, OutData) type(AFI_UA_BL_Type), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AFI_UnPackUA_BL_Type' if (Buf%ErrStat /= ErrID_None) return - ! alpha0 call RegUnpack(Buf, OutData%alpha0) if (RegCheckErr(Buf, RoutineName)) return - ! alpha1 call RegUnpack(Buf, OutData%alpha1) if (RegCheckErr(Buf, RoutineName)) return - ! alpha2 call RegUnpack(Buf, OutData%alpha2) if (RegCheckErr(Buf, RoutineName)) return - ! eta_e call RegUnpack(Buf, OutData%eta_e) if (RegCheckErr(Buf, RoutineName)) return - ! C_nalpha call RegUnpack(Buf, OutData%C_nalpha) if (RegCheckErr(Buf, RoutineName)) return - ! C_lalpha call RegUnpack(Buf, OutData%C_lalpha) if (RegCheckErr(Buf, RoutineName)) return - ! T_f0 call RegUnpack(Buf, OutData%T_f0) if (RegCheckErr(Buf, RoutineName)) return - ! T_V0 call RegUnpack(Buf, OutData%T_V0) if (RegCheckErr(Buf, RoutineName)) return - ! T_p call RegUnpack(Buf, OutData%T_p) if (RegCheckErr(Buf, RoutineName)) return - ! T_VL call RegUnpack(Buf, OutData%T_VL) if (RegCheckErr(Buf, RoutineName)) return - ! b1 call RegUnpack(Buf, OutData%b1) if (RegCheckErr(Buf, RoutineName)) return - ! b2 call RegUnpack(Buf, OutData%b2) if (RegCheckErr(Buf, RoutineName)) return - ! b5 call RegUnpack(Buf, OutData%b5) if (RegCheckErr(Buf, RoutineName)) return - ! A1 call RegUnpack(Buf, OutData%A1) if (RegCheckErr(Buf, RoutineName)) return - ! A2 call RegUnpack(Buf, OutData%A2) if (RegCheckErr(Buf, RoutineName)) return - ! A5 call RegUnpack(Buf, OutData%A5) if (RegCheckErr(Buf, RoutineName)) return - ! S1 call RegUnpack(Buf, OutData%S1) if (RegCheckErr(Buf, RoutineName)) return - ! S2 call RegUnpack(Buf, OutData%S2) if (RegCheckErr(Buf, RoutineName)) return - ! S3 call RegUnpack(Buf, OutData%S3) if (RegCheckErr(Buf, RoutineName)) return - ! S4 call RegUnpack(Buf, OutData%S4) if (RegCheckErr(Buf, RoutineName)) return - ! Cn1 call RegUnpack(Buf, OutData%Cn1) if (RegCheckErr(Buf, RoutineName)) return - ! Cn2 call RegUnpack(Buf, OutData%Cn2) if (RegCheckErr(Buf, RoutineName)) return - ! St_sh call RegUnpack(Buf, OutData%St_sh) if (RegCheckErr(Buf, RoutineName)) return - ! Cd0 call RegUnpack(Buf, OutData%Cd0) if (RegCheckErr(Buf, RoutineName)) return - ! Cm0 call RegUnpack(Buf, OutData%Cm0) if (RegCheckErr(Buf, RoutineName)) return - ! k0 call RegUnpack(Buf, OutData%k0) if (RegCheckErr(Buf, RoutineName)) return - ! k1 call RegUnpack(Buf, OutData%k1) if (RegCheckErr(Buf, RoutineName)) return - ! k2 call RegUnpack(Buf, OutData%k2) if (RegCheckErr(Buf, RoutineName)) return - ! k3 call RegUnpack(Buf, OutData%k3) if (RegCheckErr(Buf, RoutineName)) return - ! k1_hat call RegUnpack(Buf, OutData%k1_hat) if (RegCheckErr(Buf, RoutineName)) return - ! x_cp_bar call RegUnpack(Buf, OutData%x_cp_bar) if (RegCheckErr(Buf, RoutineName)) return - ! UACutout call RegUnpack(Buf, OutData%UACutout) if (RegCheckErr(Buf, RoutineName)) return - ! UACutout_delta call RegUnpack(Buf, OutData%UACutout_delta) if (RegCheckErr(Buf, RoutineName)) return - ! UACutout_blend call RegUnpack(Buf, OutData%UACutout_blend) if (RegCheckErr(Buf, RoutineName)) return - ! filtCutOff call RegUnpack(Buf, OutData%filtCutOff) if (RegCheckErr(Buf, RoutineName)) return - ! alphaUpper call RegUnpack(Buf, OutData%alphaUpper) if (RegCheckErr(Buf, RoutineName)) return - ! alphaLower call RegUnpack(Buf, OutData%alphaLower) if (RegCheckErr(Buf, RoutineName)) return - ! c_Rate call RegUnpack(Buf, OutData%c_Rate) if (RegCheckErr(Buf, RoutineName)) return - ! c_RateUpper call RegUnpack(Buf, OutData%c_RateUpper) if (RegCheckErr(Buf, RoutineName)) return - ! c_RateLower call RegUnpack(Buf, OutData%c_RateLower) if (RegCheckErr(Buf, RoutineName)) return - ! c_alphaLower call RegUnpack(Buf, OutData%c_alphaLower) if (RegCheckErr(Buf, RoutineName)) return - ! c_alphaUpper call RegUnpack(Buf, OutData%c_alphaUpper) if (RegCheckErr(Buf, RoutineName)) return - ! alphaUpperWrap call RegUnpack(Buf, OutData%alphaUpperWrap) if (RegCheckErr(Buf, RoutineName)) return - ! alphaLowerWrap call RegUnpack(Buf, OutData%alphaLowerWrap) if (RegCheckErr(Buf, RoutineName)) return - ! c_RateWrap call RegUnpack(Buf, OutData%c_RateWrap) if (RegCheckErr(Buf, RoutineName)) return - ! c_alphaLowerWrap call RegUnpack(Buf, OutData%c_alphaLowerWrap) if (RegCheckErr(Buf, RoutineName)) return - ! c_alphaUpperWrap call RegUnpack(Buf, OutData%c_alphaUpperWrap) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE AFI_CopyUA_BL_Default_Type( SrcUA_BL_Default_TypeData, DstUA_BL_Default_TypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AFI_UA_BL_Default_Type), INTENT(IN) :: SrcUA_BL_Default_TypeData - TYPE(AFI_UA_BL_Default_Type), INTENT(INOUT) :: DstUA_BL_Default_TypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_CopyUA_BL_Default_Type' -! - ErrStat = ErrID_None - ErrMsg = "" - DstUA_BL_Default_TypeData%alpha0 = SrcUA_BL_Default_TypeData%alpha0 - DstUA_BL_Default_TypeData%alpha1 = SrcUA_BL_Default_TypeData%alpha1 - DstUA_BL_Default_TypeData%alpha2 = SrcUA_BL_Default_TypeData%alpha2 - DstUA_BL_Default_TypeData%eta_e = SrcUA_BL_Default_TypeData%eta_e - DstUA_BL_Default_TypeData%C_nalpha = SrcUA_BL_Default_TypeData%C_nalpha - DstUA_BL_Default_TypeData%C_lalpha = SrcUA_BL_Default_TypeData%C_lalpha - DstUA_BL_Default_TypeData%T_f0 = SrcUA_BL_Default_TypeData%T_f0 - DstUA_BL_Default_TypeData%T_V0 = SrcUA_BL_Default_TypeData%T_V0 - DstUA_BL_Default_TypeData%T_p = SrcUA_BL_Default_TypeData%T_p - DstUA_BL_Default_TypeData%T_VL = SrcUA_BL_Default_TypeData%T_VL - DstUA_BL_Default_TypeData%b1 = SrcUA_BL_Default_TypeData%b1 - DstUA_BL_Default_TypeData%b2 = SrcUA_BL_Default_TypeData%b2 - DstUA_BL_Default_TypeData%b5 = SrcUA_BL_Default_TypeData%b5 - DstUA_BL_Default_TypeData%A1 = SrcUA_BL_Default_TypeData%A1 - DstUA_BL_Default_TypeData%A2 = SrcUA_BL_Default_TypeData%A2 - DstUA_BL_Default_TypeData%A5 = SrcUA_BL_Default_TypeData%A5 - DstUA_BL_Default_TypeData%S1 = SrcUA_BL_Default_TypeData%S1 - DstUA_BL_Default_TypeData%S2 = SrcUA_BL_Default_TypeData%S2 - DstUA_BL_Default_TypeData%S3 = SrcUA_BL_Default_TypeData%S3 - DstUA_BL_Default_TypeData%S4 = SrcUA_BL_Default_TypeData%S4 - DstUA_BL_Default_TypeData%Cn1 = SrcUA_BL_Default_TypeData%Cn1 - DstUA_BL_Default_TypeData%Cn2 = SrcUA_BL_Default_TypeData%Cn2 - DstUA_BL_Default_TypeData%St_sh = SrcUA_BL_Default_TypeData%St_sh - DstUA_BL_Default_TypeData%Cd0 = SrcUA_BL_Default_TypeData%Cd0 - DstUA_BL_Default_TypeData%Cm0 = SrcUA_BL_Default_TypeData%Cm0 - DstUA_BL_Default_TypeData%k0 = SrcUA_BL_Default_TypeData%k0 - DstUA_BL_Default_TypeData%k1 = SrcUA_BL_Default_TypeData%k1 - DstUA_BL_Default_TypeData%k2 = SrcUA_BL_Default_TypeData%k2 - DstUA_BL_Default_TypeData%k3 = SrcUA_BL_Default_TypeData%k3 - DstUA_BL_Default_TypeData%k1_hat = SrcUA_BL_Default_TypeData%k1_hat - DstUA_BL_Default_TypeData%x_cp_bar = SrcUA_BL_Default_TypeData%x_cp_bar - DstUA_BL_Default_TypeData%UACutout = SrcUA_BL_Default_TypeData%UACutout - DstUA_BL_Default_TypeData%UACutout_delta = SrcUA_BL_Default_TypeData%UACutout_delta - DstUA_BL_Default_TypeData%filtCutOff = SrcUA_BL_Default_TypeData%filtCutOff - DstUA_BL_Default_TypeData%alphaUpper = SrcUA_BL_Default_TypeData%alphaUpper - DstUA_BL_Default_TypeData%alphaLower = SrcUA_BL_Default_TypeData%alphaLower - END SUBROUTINE AFI_CopyUA_BL_Default_Type - - SUBROUTINE AFI_DestroyUA_BL_Default_Type( UA_BL_Default_TypeData, ErrStat, ErrMsg ) - TYPE(AFI_UA_BL_Default_Type), INTENT(INOUT) :: UA_BL_Default_TypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_DestroyUA_BL_Default_Type' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE AFI_DestroyUA_BL_Default_Type +subroutine AFI_CopyUA_BL_Default_Type(SrcUA_BL_Default_TypeData, DstUA_BL_Default_TypeData, CtrlCode, ErrStat, ErrMsg) + type(AFI_UA_BL_Default_Type), intent(in) :: SrcUA_BL_Default_TypeData + type(AFI_UA_BL_Default_Type), intent(inout) :: DstUA_BL_Default_TypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AFI_CopyUA_BL_Default_Type' + ErrStat = ErrID_None + ErrMsg = '' + DstUA_BL_Default_TypeData%alpha0 = SrcUA_BL_Default_TypeData%alpha0 + DstUA_BL_Default_TypeData%alpha1 = SrcUA_BL_Default_TypeData%alpha1 + DstUA_BL_Default_TypeData%alpha2 = SrcUA_BL_Default_TypeData%alpha2 + DstUA_BL_Default_TypeData%eta_e = SrcUA_BL_Default_TypeData%eta_e + DstUA_BL_Default_TypeData%C_nalpha = SrcUA_BL_Default_TypeData%C_nalpha + DstUA_BL_Default_TypeData%C_lalpha = SrcUA_BL_Default_TypeData%C_lalpha + DstUA_BL_Default_TypeData%T_f0 = SrcUA_BL_Default_TypeData%T_f0 + DstUA_BL_Default_TypeData%T_V0 = SrcUA_BL_Default_TypeData%T_V0 + DstUA_BL_Default_TypeData%T_p = SrcUA_BL_Default_TypeData%T_p + DstUA_BL_Default_TypeData%T_VL = SrcUA_BL_Default_TypeData%T_VL + DstUA_BL_Default_TypeData%b1 = SrcUA_BL_Default_TypeData%b1 + DstUA_BL_Default_TypeData%b2 = SrcUA_BL_Default_TypeData%b2 + DstUA_BL_Default_TypeData%b5 = SrcUA_BL_Default_TypeData%b5 + DstUA_BL_Default_TypeData%A1 = SrcUA_BL_Default_TypeData%A1 + DstUA_BL_Default_TypeData%A2 = SrcUA_BL_Default_TypeData%A2 + DstUA_BL_Default_TypeData%A5 = SrcUA_BL_Default_TypeData%A5 + DstUA_BL_Default_TypeData%S1 = SrcUA_BL_Default_TypeData%S1 + DstUA_BL_Default_TypeData%S2 = SrcUA_BL_Default_TypeData%S2 + DstUA_BL_Default_TypeData%S3 = SrcUA_BL_Default_TypeData%S3 + DstUA_BL_Default_TypeData%S4 = SrcUA_BL_Default_TypeData%S4 + DstUA_BL_Default_TypeData%Cn1 = SrcUA_BL_Default_TypeData%Cn1 + DstUA_BL_Default_TypeData%Cn2 = SrcUA_BL_Default_TypeData%Cn2 + DstUA_BL_Default_TypeData%St_sh = SrcUA_BL_Default_TypeData%St_sh + DstUA_BL_Default_TypeData%Cd0 = SrcUA_BL_Default_TypeData%Cd0 + DstUA_BL_Default_TypeData%Cm0 = SrcUA_BL_Default_TypeData%Cm0 + DstUA_BL_Default_TypeData%k0 = SrcUA_BL_Default_TypeData%k0 + DstUA_BL_Default_TypeData%k1 = SrcUA_BL_Default_TypeData%k1 + DstUA_BL_Default_TypeData%k2 = SrcUA_BL_Default_TypeData%k2 + DstUA_BL_Default_TypeData%k3 = SrcUA_BL_Default_TypeData%k3 + DstUA_BL_Default_TypeData%k1_hat = SrcUA_BL_Default_TypeData%k1_hat + DstUA_BL_Default_TypeData%x_cp_bar = SrcUA_BL_Default_TypeData%x_cp_bar + DstUA_BL_Default_TypeData%UACutout = SrcUA_BL_Default_TypeData%UACutout + DstUA_BL_Default_TypeData%UACutout_delta = SrcUA_BL_Default_TypeData%UACutout_delta + DstUA_BL_Default_TypeData%filtCutOff = SrcUA_BL_Default_TypeData%filtCutOff + DstUA_BL_Default_TypeData%alphaUpper = SrcUA_BL_Default_TypeData%alphaUpper + DstUA_BL_Default_TypeData%alphaLower = SrcUA_BL_Default_TypeData%alphaLower +end subroutine +subroutine AFI_DestroyUA_BL_Default_Type(UA_BL_Default_TypeData, ErrStat, ErrMsg) + type(AFI_UA_BL_Default_Type), intent(inout) :: UA_BL_Default_TypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AFI_DestroyUA_BL_Default_Type' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine AFI_PackUA_BL_Default_Type(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AFI_UA_BL_Default_Type), intent(in) :: InData character(*), parameter :: RoutineName = 'AFI_PackUA_BL_Default_Type' if (Buf%ErrStat >= AbortErrLev) return - ! alpha0 call RegPack(Buf, InData%alpha0) if (RegCheckErr(Buf, RoutineName)) return - ! alpha1 call RegPack(Buf, InData%alpha1) if (RegCheckErr(Buf, RoutineName)) return - ! alpha2 call RegPack(Buf, InData%alpha2) if (RegCheckErr(Buf, RoutineName)) return - ! eta_e call RegPack(Buf, InData%eta_e) if (RegCheckErr(Buf, RoutineName)) return - ! C_nalpha call RegPack(Buf, InData%C_nalpha) if (RegCheckErr(Buf, RoutineName)) return - ! C_lalpha call RegPack(Buf, InData%C_lalpha) if (RegCheckErr(Buf, RoutineName)) return - ! T_f0 call RegPack(Buf, InData%T_f0) if (RegCheckErr(Buf, RoutineName)) return - ! T_V0 call RegPack(Buf, InData%T_V0) if (RegCheckErr(Buf, RoutineName)) return - ! T_p call RegPack(Buf, InData%T_p) if (RegCheckErr(Buf, RoutineName)) return - ! T_VL call RegPack(Buf, InData%T_VL) if (RegCheckErr(Buf, RoutineName)) return - ! b1 call RegPack(Buf, InData%b1) if (RegCheckErr(Buf, RoutineName)) return - ! b2 call RegPack(Buf, InData%b2) if (RegCheckErr(Buf, RoutineName)) return - ! b5 call RegPack(Buf, InData%b5) if (RegCheckErr(Buf, RoutineName)) return - ! A1 call RegPack(Buf, InData%A1) if (RegCheckErr(Buf, RoutineName)) return - ! A2 call RegPack(Buf, InData%A2) if (RegCheckErr(Buf, RoutineName)) return - ! A5 call RegPack(Buf, InData%A5) if (RegCheckErr(Buf, RoutineName)) return - ! S1 call RegPack(Buf, InData%S1) if (RegCheckErr(Buf, RoutineName)) return - ! S2 call RegPack(Buf, InData%S2) if (RegCheckErr(Buf, RoutineName)) return - ! S3 call RegPack(Buf, InData%S3) if (RegCheckErr(Buf, RoutineName)) return - ! S4 call RegPack(Buf, InData%S4) if (RegCheckErr(Buf, RoutineName)) return - ! Cn1 call RegPack(Buf, InData%Cn1) if (RegCheckErr(Buf, RoutineName)) return - ! Cn2 call RegPack(Buf, InData%Cn2) if (RegCheckErr(Buf, RoutineName)) return - ! St_sh call RegPack(Buf, InData%St_sh) if (RegCheckErr(Buf, RoutineName)) return - ! Cd0 call RegPack(Buf, InData%Cd0) if (RegCheckErr(Buf, RoutineName)) return - ! Cm0 call RegPack(Buf, InData%Cm0) if (RegCheckErr(Buf, RoutineName)) return - ! k0 call RegPack(Buf, InData%k0) if (RegCheckErr(Buf, RoutineName)) return - ! k1 call RegPack(Buf, InData%k1) if (RegCheckErr(Buf, RoutineName)) return - ! k2 call RegPack(Buf, InData%k2) if (RegCheckErr(Buf, RoutineName)) return - ! k3 call RegPack(Buf, InData%k3) if (RegCheckErr(Buf, RoutineName)) return - ! k1_hat call RegPack(Buf, InData%k1_hat) if (RegCheckErr(Buf, RoutineName)) return - ! x_cp_bar call RegPack(Buf, InData%x_cp_bar) if (RegCheckErr(Buf, RoutineName)) return - ! UACutout call RegPack(Buf, InData%UACutout) if (RegCheckErr(Buf, RoutineName)) return - ! UACutout_delta call RegPack(Buf, InData%UACutout_delta) if (RegCheckErr(Buf, RoutineName)) return - ! filtCutOff call RegPack(Buf, InData%filtCutOff) if (RegCheckErr(Buf, RoutineName)) return - ! alphaUpper call RegPack(Buf, InData%alphaUpper) if (RegCheckErr(Buf, RoutineName)) return - ! alphaLower call RegPack(Buf, InData%alphaLower) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -761,253 +609,197 @@ subroutine AFI_UnPackUA_BL_Default_Type(Buf, OutData) type(AFI_UA_BL_Default_Type), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AFI_UnPackUA_BL_Default_Type' if (Buf%ErrStat /= ErrID_None) return - ! alpha0 call RegUnpack(Buf, OutData%alpha0) if (RegCheckErr(Buf, RoutineName)) return - ! alpha1 call RegUnpack(Buf, OutData%alpha1) if (RegCheckErr(Buf, RoutineName)) return - ! alpha2 call RegUnpack(Buf, OutData%alpha2) if (RegCheckErr(Buf, RoutineName)) return - ! eta_e call RegUnpack(Buf, OutData%eta_e) if (RegCheckErr(Buf, RoutineName)) return - ! C_nalpha call RegUnpack(Buf, OutData%C_nalpha) if (RegCheckErr(Buf, RoutineName)) return - ! C_lalpha call RegUnpack(Buf, OutData%C_lalpha) if (RegCheckErr(Buf, RoutineName)) return - ! T_f0 call RegUnpack(Buf, OutData%T_f0) if (RegCheckErr(Buf, RoutineName)) return - ! T_V0 call RegUnpack(Buf, OutData%T_V0) if (RegCheckErr(Buf, RoutineName)) return - ! T_p call RegUnpack(Buf, OutData%T_p) if (RegCheckErr(Buf, RoutineName)) return - ! T_VL call RegUnpack(Buf, OutData%T_VL) if (RegCheckErr(Buf, RoutineName)) return - ! b1 call RegUnpack(Buf, OutData%b1) if (RegCheckErr(Buf, RoutineName)) return - ! b2 call RegUnpack(Buf, OutData%b2) if (RegCheckErr(Buf, RoutineName)) return - ! b5 call RegUnpack(Buf, OutData%b5) if (RegCheckErr(Buf, RoutineName)) return - ! A1 call RegUnpack(Buf, OutData%A1) if (RegCheckErr(Buf, RoutineName)) return - ! A2 call RegUnpack(Buf, OutData%A2) if (RegCheckErr(Buf, RoutineName)) return - ! A5 call RegUnpack(Buf, OutData%A5) if (RegCheckErr(Buf, RoutineName)) return - ! S1 call RegUnpack(Buf, OutData%S1) if (RegCheckErr(Buf, RoutineName)) return - ! S2 call RegUnpack(Buf, OutData%S2) if (RegCheckErr(Buf, RoutineName)) return - ! S3 call RegUnpack(Buf, OutData%S3) if (RegCheckErr(Buf, RoutineName)) return - ! S4 call RegUnpack(Buf, OutData%S4) if (RegCheckErr(Buf, RoutineName)) return - ! Cn1 call RegUnpack(Buf, OutData%Cn1) if (RegCheckErr(Buf, RoutineName)) return - ! Cn2 call RegUnpack(Buf, OutData%Cn2) if (RegCheckErr(Buf, RoutineName)) return - ! St_sh call RegUnpack(Buf, OutData%St_sh) if (RegCheckErr(Buf, RoutineName)) return - ! Cd0 call RegUnpack(Buf, OutData%Cd0) if (RegCheckErr(Buf, RoutineName)) return - ! Cm0 call RegUnpack(Buf, OutData%Cm0) if (RegCheckErr(Buf, RoutineName)) return - ! k0 call RegUnpack(Buf, OutData%k0) if (RegCheckErr(Buf, RoutineName)) return - ! k1 call RegUnpack(Buf, OutData%k1) if (RegCheckErr(Buf, RoutineName)) return - ! k2 call RegUnpack(Buf, OutData%k2) if (RegCheckErr(Buf, RoutineName)) return - ! k3 call RegUnpack(Buf, OutData%k3) if (RegCheckErr(Buf, RoutineName)) return - ! k1_hat call RegUnpack(Buf, OutData%k1_hat) if (RegCheckErr(Buf, RoutineName)) return - ! x_cp_bar call RegUnpack(Buf, OutData%x_cp_bar) if (RegCheckErr(Buf, RoutineName)) return - ! UACutout call RegUnpack(Buf, OutData%UACutout) if (RegCheckErr(Buf, RoutineName)) return - ! UACutout_delta call RegUnpack(Buf, OutData%UACutout_delta) if (RegCheckErr(Buf, RoutineName)) return - ! filtCutOff call RegUnpack(Buf, OutData%filtCutOff) if (RegCheckErr(Buf, RoutineName)) return - ! alphaUpper call RegUnpack(Buf, OutData%alphaUpper) if (RegCheckErr(Buf, RoutineName)) return - ! alphaLower call RegUnpack(Buf, OutData%alphaLower) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE AFI_CopyTable_Type( SrcTable_TypeData, DstTable_TypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AFI_Table_Type), INTENT(IN) :: SrcTable_TypeData - TYPE(AFI_Table_Type), INTENT(INOUT) :: DstTable_TypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_CopyTable_Type' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcTable_TypeData%Alpha)) THEN - i1_l = LBOUND(SrcTable_TypeData%Alpha,1) - i1_u = UBOUND(SrcTable_TypeData%Alpha,1) - IF (.NOT. ALLOCATED(DstTable_TypeData%Alpha)) THEN - ALLOCATE(DstTable_TypeData%Alpha(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstTable_TypeData%Alpha.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstTable_TypeData%Alpha = SrcTable_TypeData%Alpha -ENDIF -IF (ALLOCATED(SrcTable_TypeData%Coefs)) THEN - i1_l = LBOUND(SrcTable_TypeData%Coefs,1) - i1_u = UBOUND(SrcTable_TypeData%Coefs,1) - i2_l = LBOUND(SrcTable_TypeData%Coefs,2) - i2_u = UBOUND(SrcTable_TypeData%Coefs,2) - IF (.NOT. ALLOCATED(DstTable_TypeData%Coefs)) THEN - ALLOCATE(DstTable_TypeData%Coefs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstTable_TypeData%Coefs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstTable_TypeData%Coefs = SrcTable_TypeData%Coefs -ENDIF -IF (ALLOCATED(SrcTable_TypeData%SplineCoefs)) THEN - i1_l = LBOUND(SrcTable_TypeData%SplineCoefs,1) - i1_u = UBOUND(SrcTable_TypeData%SplineCoefs,1) - i2_l = LBOUND(SrcTable_TypeData%SplineCoefs,2) - i2_u = UBOUND(SrcTable_TypeData%SplineCoefs,2) - i3_l = LBOUND(SrcTable_TypeData%SplineCoefs,3) - i3_u = UBOUND(SrcTable_TypeData%SplineCoefs,3) - IF (.NOT. ALLOCATED(DstTable_TypeData%SplineCoefs)) THEN - ALLOCATE(DstTable_TypeData%SplineCoefs(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstTable_TypeData%SplineCoefs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstTable_TypeData%SplineCoefs = SrcTable_TypeData%SplineCoefs -ENDIF - DstTable_TypeData%UserProp = SrcTable_TypeData%UserProp - DstTable_TypeData%Re = SrcTable_TypeData%Re - DstTable_TypeData%NumAlf = SrcTable_TypeData%NumAlf - DstTable_TypeData%ConstData = SrcTable_TypeData%ConstData - DstTable_TypeData%InclUAdata = SrcTable_TypeData%InclUAdata - CALL AFI_Copyua_bl_type( SrcTable_TypeData%UA_BL, DstTable_TypeData%UA_BL, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AFI_CopyTable_Type - - SUBROUTINE AFI_DestroyTable_Type( Table_TypeData, ErrStat, ErrMsg ) - TYPE(AFI_Table_Type), INTENT(INOUT) :: Table_TypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_DestroyTable_Type' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(Table_TypeData%Alpha)) THEN - DEALLOCATE(Table_TypeData%Alpha) -ENDIF -IF (ALLOCATED(Table_TypeData%Coefs)) THEN - DEALLOCATE(Table_TypeData%Coefs) -ENDIF -IF (ALLOCATED(Table_TypeData%SplineCoefs)) THEN - DEALLOCATE(Table_TypeData%SplineCoefs) -ENDIF - CALL AFI_DestroyUA_BL_Type( Table_TypeData%UA_BL, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AFI_DestroyTable_Type +subroutine AFI_CopyTable_Type(SrcTable_TypeData, DstTable_TypeData, CtrlCode, ErrStat, ErrMsg) + type(AFI_Table_Type), intent(in) :: SrcTable_TypeData + type(AFI_Table_Type), intent(inout) :: DstTable_TypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AFI_CopyTable_Type' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcTable_TypeData%Alpha)) then + LB(1:1) = lbound(SrcTable_TypeData%Alpha) + UB(1:1) = ubound(SrcTable_TypeData%Alpha) + if (.not. allocated(DstTable_TypeData%Alpha)) then + allocate(DstTable_TypeData%Alpha(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTable_TypeData%Alpha.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTable_TypeData%Alpha = SrcTable_TypeData%Alpha + else if (allocated(DstTable_TypeData%Alpha)) then + deallocate(DstTable_TypeData%Alpha) + end if + if (allocated(SrcTable_TypeData%Coefs)) then + LB(1:2) = lbound(SrcTable_TypeData%Coefs) + UB(1:2) = ubound(SrcTable_TypeData%Coefs) + if (.not. allocated(DstTable_TypeData%Coefs)) then + allocate(DstTable_TypeData%Coefs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTable_TypeData%Coefs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTable_TypeData%Coefs = SrcTable_TypeData%Coefs + else if (allocated(DstTable_TypeData%Coefs)) then + deallocate(DstTable_TypeData%Coefs) + end if + if (allocated(SrcTable_TypeData%SplineCoefs)) then + LB(1:3) = lbound(SrcTable_TypeData%SplineCoefs) + UB(1:3) = ubound(SrcTable_TypeData%SplineCoefs) + if (.not. allocated(DstTable_TypeData%SplineCoefs)) then + allocate(DstTable_TypeData%SplineCoefs(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTable_TypeData%SplineCoefs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTable_TypeData%SplineCoefs = SrcTable_TypeData%SplineCoefs + else if (allocated(DstTable_TypeData%SplineCoefs)) then + deallocate(DstTable_TypeData%SplineCoefs) + end if + DstTable_TypeData%UserProp = SrcTable_TypeData%UserProp + DstTable_TypeData%Re = SrcTable_TypeData%Re + DstTable_TypeData%NumAlf = SrcTable_TypeData%NumAlf + DstTable_TypeData%ConstData = SrcTable_TypeData%ConstData + DstTable_TypeData%InclUAdata = SrcTable_TypeData%InclUAdata + call AFI_CopyUA_BL_Type(SrcTable_TypeData%UA_BL, DstTable_TypeData%UA_BL, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine AFI_DestroyTable_Type(Table_TypeData, ErrStat, ErrMsg) + type(AFI_Table_Type), intent(inout) :: Table_TypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AFI_DestroyTable_Type' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(Table_TypeData%Alpha)) then + deallocate(Table_TypeData%Alpha) + end if + if (allocated(Table_TypeData%Coefs)) then + deallocate(Table_TypeData%Coefs) + end if + if (allocated(Table_TypeData%SplineCoefs)) then + deallocate(Table_TypeData%SplineCoefs) + end if +end subroutine subroutine AFI_PackTable_Type(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AFI_Table_Type), intent(in) :: InData character(*), parameter :: RoutineName = 'AFI_PackTable_Type' if (Buf%ErrStat >= AbortErrLev) return - ! Alpha call RegPack(Buf, allocated(InData%Alpha)) if (allocated(InData%Alpha)) then call RegPackBounds(Buf, 1, lbound(InData%Alpha), ubound(InData%Alpha)) call RegPack(Buf, InData%Alpha) end if if (RegCheckErr(Buf, RoutineName)) return - ! Coefs call RegPack(Buf, allocated(InData%Coefs)) if (allocated(InData%Coefs)) then call RegPackBounds(Buf, 2, lbound(InData%Coefs), ubound(InData%Coefs)) call RegPack(Buf, InData%Coefs) end if if (RegCheckErr(Buf, RoutineName)) return - ! SplineCoefs call RegPack(Buf, allocated(InData%SplineCoefs)) if (allocated(InData%SplineCoefs)) then call RegPackBounds(Buf, 3, lbound(InData%SplineCoefs), ubound(InData%SplineCoefs)) call RegPack(Buf, InData%SplineCoefs) end if if (RegCheckErr(Buf, RoutineName)) return - ! UserProp call RegPack(Buf, InData%UserProp) if (RegCheckErr(Buf, RoutineName)) return - ! Re call RegPack(Buf, InData%Re) if (RegCheckErr(Buf, RoutineName)) return - ! NumAlf call RegPack(Buf, InData%NumAlf) if (RegCheckErr(Buf, RoutineName)) return - ! ConstData call RegPack(Buf, InData%ConstData) if (RegCheckErr(Buf, RoutineName)) return - ! InclUAdata call RegPack(Buf, InData%InclUAdata) if (RegCheckErr(Buf, RoutineName)) return - ! UA_BL call AFI_PackUA_BL_Type(Buf, InData%UA_BL) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1020,7 +812,6 @@ subroutine AFI_UnPackTable_Type(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! Alpha if (allocated(OutData%Alpha)) deallocate(OutData%Alpha) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1035,7 +826,6 @@ subroutine AFI_UnPackTable_Type(Buf, OutData) call RegUnpack(Buf, OutData%Alpha) if (RegCheckErr(Buf, RoutineName)) return end if - ! Coefs if (allocated(OutData%Coefs)) deallocate(OutData%Coefs) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1050,7 +840,6 @@ subroutine AFI_UnPackTable_Type(Buf, OutData) call RegUnpack(Buf, OutData%Coefs) if (RegCheckErr(Buf, RoutineName)) return end if - ! SplineCoefs if (allocated(OutData%SplineCoefs)) deallocate(OutData%SplineCoefs) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1065,91 +854,66 @@ subroutine AFI_UnPackTable_Type(Buf, OutData) call RegUnpack(Buf, OutData%SplineCoefs) if (RegCheckErr(Buf, RoutineName)) return end if - ! UserProp call RegUnpack(Buf, OutData%UserProp) if (RegCheckErr(Buf, RoutineName)) return - ! Re call RegUnpack(Buf, OutData%Re) if (RegCheckErr(Buf, RoutineName)) return - ! NumAlf call RegUnpack(Buf, OutData%NumAlf) if (RegCheckErr(Buf, RoutineName)) return - ! ConstData call RegUnpack(Buf, OutData%ConstData) if (RegCheckErr(Buf, RoutineName)) return - ! InclUAdata call RegUnpack(Buf, OutData%InclUAdata) if (RegCheckErr(Buf, RoutineName)) return - ! UA_BL call AFI_UnpackUA_BL_Type(Buf, OutData%UA_BL) ! UA_BL end subroutine - SUBROUTINE AFI_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AFI_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(AFI_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%FileName = SrcInitInputData%FileName - DstInitInputData%AFTabMod = SrcInitInputData%AFTabMod - DstInitInputData%InCol_Alfa = SrcInitInputData%InCol_Alfa - DstInitInputData%InCol_Cl = SrcInitInputData%InCol_Cl - DstInitInputData%InCol_Cd = SrcInitInputData%InCol_Cd - DstInitInputData%InCol_Cm = SrcInitInputData%InCol_Cm - DstInitInputData%InCol_Cpmin = SrcInitInputData%InCol_Cpmin - DstInitInputData%UA_f_cn = SrcInitInputData%UA_f_cn - END SUBROUTINE AFI_CopyInitInput - - SUBROUTINE AFI_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(AFI_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_DestroyInitInput' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE AFI_DestroyInitInput +subroutine AFI_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(AFI_InitInputType), intent(in) :: SrcInitInputData + type(AFI_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AFI_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitInputData%FileName = SrcInitInputData%FileName + DstInitInputData%AFTabMod = SrcInitInputData%AFTabMod + DstInitInputData%InCol_Alfa = SrcInitInputData%InCol_Alfa + DstInitInputData%InCol_Cl = SrcInitInputData%InCol_Cl + DstInitInputData%InCol_Cd = SrcInitInputData%InCol_Cd + DstInitInputData%InCol_Cm = SrcInitInputData%InCol_Cm + DstInitInputData%InCol_Cpmin = SrcInitInputData%InCol_Cpmin + DstInitInputData%UA_f_cn = SrcInitInputData%UA_f_cn +end subroutine +subroutine AFI_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(AFI_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AFI_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine AFI_PackInitInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AFI_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AFI_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return - ! FileName call RegPack(Buf, InData%FileName) if (RegCheckErr(Buf, RoutineName)) return - ! AFTabMod call RegPack(Buf, InData%AFTabMod) if (RegCheckErr(Buf, RoutineName)) return - ! InCol_Alfa call RegPack(Buf, InData%InCol_Alfa) if (RegCheckErr(Buf, RoutineName)) return - ! InCol_Cl call RegPack(Buf, InData%InCol_Cl) if (RegCheckErr(Buf, RoutineName)) return - ! InCol_Cd call RegPack(Buf, InData%InCol_Cd) if (RegCheckErr(Buf, RoutineName)) return - ! InCol_Cm call RegPack(Buf, InData%InCol_Cm) if (RegCheckErr(Buf, RoutineName)) return - ! InCol_Cpmin call RegPack(Buf, InData%InCol_Cpmin) if (RegCheckErr(Buf, RoutineName)) return - ! UA_f_cn call RegPack(Buf, InData%UA_f_cn) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1159,74 +923,56 @@ subroutine AFI_UnPackInitInput(Buf, OutData) type(AFI_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AFI_UnPackInitInput' if (Buf%ErrStat /= ErrID_None) return - ! FileName call RegUnpack(Buf, OutData%FileName) if (RegCheckErr(Buf, RoutineName)) return - ! AFTabMod call RegUnpack(Buf, OutData%AFTabMod) if (RegCheckErr(Buf, RoutineName)) return - ! InCol_Alfa call RegUnpack(Buf, OutData%InCol_Alfa) if (RegCheckErr(Buf, RoutineName)) return - ! InCol_Cl call RegUnpack(Buf, OutData%InCol_Cl) if (RegCheckErr(Buf, RoutineName)) return - ! InCol_Cd call RegUnpack(Buf, OutData%InCol_Cd) if (RegCheckErr(Buf, RoutineName)) return - ! InCol_Cm call RegUnpack(Buf, OutData%InCol_Cm) if (RegCheckErr(Buf, RoutineName)) return - ! InCol_Cpmin call RegUnpack(Buf, OutData%InCol_Cpmin) if (RegCheckErr(Buf, RoutineName)) return - ! UA_f_cn call RegUnpack(Buf, OutData%UA_f_cn) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE AFI_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AFI_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(AFI_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_CopyInitOutput' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AFI_CopyInitOutput - - SUBROUTINE AFI_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(AFI_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AFI_DestroyInitOutput +subroutine AFI_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(AFI_InitOutputType), intent(in) :: SrcInitOutputData + type(AFI_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AFI_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine AFI_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(AFI_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AFI_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine AFI_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AFI_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AFI_PackInitOutput' if (Buf%ErrStat >= AbortErrLev) return - ! Ver call NWTC_Library_PackProgDesc(Buf, InData%Ver) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1236,122 +982,127 @@ subroutine AFI_UnPackInitOutput(Buf, OutData) type(AFI_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AFI_UnPackInitOutput' if (Buf%ErrStat /= ErrID_None) return - ! Ver call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver end subroutine - SUBROUTINE AFI_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AFI_ParameterType), INTENT(IN) :: SrcParamData - TYPE(AFI_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%ColCd = SrcParamData%ColCd - DstParamData%ColCl = SrcParamData%ColCl - DstParamData%ColCm = SrcParamData%ColCm - DstParamData%ColCpmin = SrcParamData%ColCpmin - DstParamData%ColUAf = SrcParamData%ColUAf - DstParamData%AFTabMod = SrcParamData%AFTabMod -IF (ALLOCATED(SrcParamData%secondVals)) THEN - i1_l = LBOUND(SrcParamData%secondVals,1) - i1_u = UBOUND(SrcParamData%secondVals,1) - IF (.NOT. ALLOCATED(DstParamData%secondVals)) THEN - ALLOCATE(DstParamData%secondVals(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%secondVals.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%secondVals = SrcParamData%secondVals -ENDIF - DstParamData%InterpOrd = SrcParamData%InterpOrd - DstParamData%RelThickness = SrcParamData%RelThickness - DstParamData%NonDimArea = SrcParamData%NonDimArea - DstParamData%NumCoords = SrcParamData%NumCoords -IF (ALLOCATED(SrcParamData%X_Coord)) THEN - i1_l = LBOUND(SrcParamData%X_Coord,1) - i1_u = UBOUND(SrcParamData%X_Coord,1) - IF (.NOT. ALLOCATED(DstParamData%X_Coord)) THEN - ALLOCATE(DstParamData%X_Coord(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%X_Coord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%X_Coord = SrcParamData%X_Coord -ENDIF -IF (ALLOCATED(SrcParamData%Y_Coord)) THEN - i1_l = LBOUND(SrcParamData%Y_Coord,1) - i1_u = UBOUND(SrcParamData%Y_Coord,1) - IF (.NOT. ALLOCATED(DstParamData%Y_Coord)) THEN - ALLOCATE(DstParamData%Y_Coord(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Y_Coord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Y_Coord = SrcParamData%Y_Coord -ENDIF - DstParamData%NumTabs = SrcParamData%NumTabs -IF (ALLOCATED(SrcParamData%Table)) THEN - i1_l = LBOUND(SrcParamData%Table,1) - i1_u = UBOUND(SrcParamData%Table,1) - IF (.NOT. ALLOCATED(DstParamData%Table)) THEN - ALLOCATE(DstParamData%Table(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Table.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%Table,1), UBOUND(SrcParamData%Table,1) - CALL AFI_Copytable_type( SrcParamData%Table(i1), DstParamData%Table(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstParamData%BL_file = SrcParamData%BL_file - DstParamData%FileName = SrcParamData%FileName - END SUBROUTINE AFI_CopyParam - SUBROUTINE AFI_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(AFI_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%secondVals)) THEN - DEALLOCATE(ParamData%secondVals) -ENDIF -IF (ALLOCATED(ParamData%X_Coord)) THEN - DEALLOCATE(ParamData%X_Coord) -ENDIF -IF (ALLOCATED(ParamData%Y_Coord)) THEN - DEALLOCATE(ParamData%Y_Coord) -ENDIF -IF (ALLOCATED(ParamData%Table)) THEN -DO i1 = LBOUND(ParamData%Table,1), UBOUND(ParamData%Table,1) - CALL AFI_DestroyTable_Type( ParamData%Table(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%Table) -ENDIF - END SUBROUTINE AFI_DestroyParam +subroutine AFI_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(AFI_ParameterType), intent(in) :: SrcParamData + type(AFI_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AFI_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%ColCd = SrcParamData%ColCd + DstParamData%ColCl = SrcParamData%ColCl + DstParamData%ColCm = SrcParamData%ColCm + DstParamData%ColCpmin = SrcParamData%ColCpmin + DstParamData%ColUAf = SrcParamData%ColUAf + DstParamData%AFTabMod = SrcParamData%AFTabMod + if (allocated(SrcParamData%secondVals)) then + LB(1:1) = lbound(SrcParamData%secondVals) + UB(1:1) = ubound(SrcParamData%secondVals) + if (.not. allocated(DstParamData%secondVals)) then + allocate(DstParamData%secondVals(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%secondVals.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%secondVals = SrcParamData%secondVals + else if (allocated(DstParamData%secondVals)) then + deallocate(DstParamData%secondVals) + end if + DstParamData%InterpOrd = SrcParamData%InterpOrd + DstParamData%RelThickness = SrcParamData%RelThickness + DstParamData%NonDimArea = SrcParamData%NonDimArea + DstParamData%NumCoords = SrcParamData%NumCoords + if (allocated(SrcParamData%X_Coord)) then + LB(1:1) = lbound(SrcParamData%X_Coord) + UB(1:1) = ubound(SrcParamData%X_Coord) + if (.not. allocated(DstParamData%X_Coord)) then + allocate(DstParamData%X_Coord(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%X_Coord.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%X_Coord = SrcParamData%X_Coord + else if (allocated(DstParamData%X_Coord)) then + deallocate(DstParamData%X_Coord) + end if + if (allocated(SrcParamData%Y_Coord)) then + LB(1:1) = lbound(SrcParamData%Y_Coord) + UB(1:1) = ubound(SrcParamData%Y_Coord) + if (.not. allocated(DstParamData%Y_Coord)) then + allocate(DstParamData%Y_Coord(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Y_Coord.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Y_Coord = SrcParamData%Y_Coord + else if (allocated(DstParamData%Y_Coord)) then + deallocate(DstParamData%Y_Coord) + end if + DstParamData%NumTabs = SrcParamData%NumTabs + if (allocated(SrcParamData%Table)) then + LB(1:1) = lbound(SrcParamData%Table) + UB(1:1) = ubound(SrcParamData%Table) + if (.not. allocated(DstParamData%Table)) then + allocate(DstParamData%Table(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Table.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AFI_CopyTable_Type(SrcParamData%Table(i1), DstParamData%Table(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstParamData%Table)) then + deallocate(DstParamData%Table) + end if + DstParamData%BL_file = SrcParamData%BL_file + DstParamData%FileName = SrcParamData%FileName +end subroutine +subroutine AFI_DestroyParam(ParamData, ErrStat, ErrMsg) + type(AFI_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AFI_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%secondVals)) then + deallocate(ParamData%secondVals) + end if + if (allocated(ParamData%X_Coord)) then + deallocate(ParamData%X_Coord) + end if + if (allocated(ParamData%Y_Coord)) then + deallocate(ParamData%Y_Coord) + end if + if (allocated(ParamData%Table)) then + LB(1:1) = lbound(ParamData%Table) + UB(1:1) = ubound(ParamData%Table) + do i1 = LB(1), UB(1) + call AFI_DestroyTable_Type(ParamData%Table(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%Table) + end if +end subroutine subroutine AFI_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -1360,61 +1111,46 @@ subroutine AFI_PackParam(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! ColCd call RegPack(Buf, InData%ColCd) if (RegCheckErr(Buf, RoutineName)) return - ! ColCl call RegPack(Buf, InData%ColCl) if (RegCheckErr(Buf, RoutineName)) return - ! ColCm call RegPack(Buf, InData%ColCm) if (RegCheckErr(Buf, RoutineName)) return - ! ColCpmin call RegPack(Buf, InData%ColCpmin) if (RegCheckErr(Buf, RoutineName)) return - ! ColUAf call RegPack(Buf, InData%ColUAf) if (RegCheckErr(Buf, RoutineName)) return - ! AFTabMod call RegPack(Buf, InData%AFTabMod) if (RegCheckErr(Buf, RoutineName)) return - ! secondVals call RegPack(Buf, allocated(InData%secondVals)) if (allocated(InData%secondVals)) then call RegPackBounds(Buf, 1, lbound(InData%secondVals), ubound(InData%secondVals)) call RegPack(Buf, InData%secondVals) end if if (RegCheckErr(Buf, RoutineName)) return - ! InterpOrd call RegPack(Buf, InData%InterpOrd) if (RegCheckErr(Buf, RoutineName)) return - ! RelThickness call RegPack(Buf, InData%RelThickness) if (RegCheckErr(Buf, RoutineName)) return - ! NonDimArea call RegPack(Buf, InData%NonDimArea) if (RegCheckErr(Buf, RoutineName)) return - ! NumCoords call RegPack(Buf, InData%NumCoords) if (RegCheckErr(Buf, RoutineName)) return - ! X_Coord call RegPack(Buf, allocated(InData%X_Coord)) if (allocated(InData%X_Coord)) then call RegPackBounds(Buf, 1, lbound(InData%X_Coord), ubound(InData%X_Coord)) call RegPack(Buf, InData%X_Coord) end if if (RegCheckErr(Buf, RoutineName)) return - ! Y_Coord call RegPack(Buf, allocated(InData%Y_Coord)) if (allocated(InData%Y_Coord)) then call RegPackBounds(Buf, 1, lbound(InData%Y_Coord), ubound(InData%Y_Coord)) call RegPack(Buf, InData%Y_Coord) end if if (RegCheckErr(Buf, RoutineName)) return - ! NumTabs call RegPack(Buf, InData%NumTabs) if (RegCheckErr(Buf, RoutineName)) return - ! Table call RegPack(Buf, allocated(InData%Table)) if (allocated(InData%Table)) then call RegPackBounds(Buf, 1, lbound(InData%Table), ubound(InData%Table)) @@ -1425,10 +1161,8 @@ subroutine AFI_PackParam(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! BL_file call RegPack(Buf, InData%BL_file) if (RegCheckErr(Buf, RoutineName)) return - ! FileName call RegPack(Buf, InData%FileName) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1442,25 +1176,18 @@ subroutine AFI_UnPackParam(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! ColCd call RegUnpack(Buf, OutData%ColCd) if (RegCheckErr(Buf, RoutineName)) return - ! ColCl call RegUnpack(Buf, OutData%ColCl) if (RegCheckErr(Buf, RoutineName)) return - ! ColCm call RegUnpack(Buf, OutData%ColCm) if (RegCheckErr(Buf, RoutineName)) return - ! ColCpmin call RegUnpack(Buf, OutData%ColCpmin) if (RegCheckErr(Buf, RoutineName)) return - ! ColUAf call RegUnpack(Buf, OutData%ColUAf) if (RegCheckErr(Buf, RoutineName)) return - ! AFTabMod call RegUnpack(Buf, OutData%AFTabMod) if (RegCheckErr(Buf, RoutineName)) return - ! secondVals if (allocated(OutData%secondVals)) deallocate(OutData%secondVals) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1475,19 +1202,14 @@ subroutine AFI_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%secondVals) if (RegCheckErr(Buf, RoutineName)) return end if - ! InterpOrd call RegUnpack(Buf, OutData%InterpOrd) if (RegCheckErr(Buf, RoutineName)) return - ! RelThickness call RegUnpack(Buf, OutData%RelThickness) if (RegCheckErr(Buf, RoutineName)) return - ! NonDimArea call RegUnpack(Buf, OutData%NonDimArea) if (RegCheckErr(Buf, RoutineName)) return - ! NumCoords call RegUnpack(Buf, OutData%NumCoords) if (RegCheckErr(Buf, RoutineName)) return - ! X_Coord if (allocated(OutData%X_Coord)) deallocate(OutData%X_Coord) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1502,7 +1224,6 @@ subroutine AFI_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%X_Coord) if (RegCheckErr(Buf, RoutineName)) return end if - ! Y_Coord if (allocated(OutData%Y_Coord)) deallocate(OutData%Y_Coord) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1517,10 +1238,8 @@ subroutine AFI_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%Y_Coord) if (RegCheckErr(Buf, RoutineName)) return end if - ! NumTabs call RegUnpack(Buf, OutData%NumTabs) if (RegCheckErr(Buf, RoutineName)) return - ! Table if (allocated(OutData%Table)) deallocate(OutData%Table) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1536,60 +1255,44 @@ subroutine AFI_UnPackParam(Buf, OutData) call AFI_UnpackTable_Type(Buf, OutData%Table(i1)) ! Table end do end if - ! BL_file call RegUnpack(Buf, OutData%BL_file) if (RegCheckErr(Buf, RoutineName)) return - ! FileName call RegUnpack(Buf, OutData%FileName) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE AFI_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AFI_InputType), INTENT(IN) :: SrcInputData - TYPE(AFI_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_CopyInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInputData%AoA = SrcInputData%AoA - DstInputData%UserProp = SrcInputData%UserProp - DstInputData%Re = SrcInputData%Re - END SUBROUTINE AFI_CopyInput - - SUBROUTINE AFI_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(AFI_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_DestroyInput' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE AFI_DestroyInput +subroutine AFI_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(AFI_InputType), intent(in) :: SrcInputData + type(AFI_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AFI_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInputData%AoA = SrcInputData%AoA + DstInputData%UserProp = SrcInputData%UserProp + DstInputData%Re = SrcInputData%Re +end subroutine +subroutine AFI_DestroyInput(InputData, ErrStat, ErrMsg) + type(AFI_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AFI_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine AFI_PackInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AFI_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AFI_PackInput' if (Buf%ErrStat >= AbortErrLev) return - ! AoA call RegPack(Buf, InData%AoA) if (RegCheckErr(Buf, RoutineName)) return - ! UserProp call RegPack(Buf, InData%UserProp) if (RegCheckErr(Buf, RoutineName)) return - ! Re call RegPack(Buf, InData%Re) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1599,87 +1302,64 @@ subroutine AFI_UnPackInput(Buf, OutData) type(AFI_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AFI_UnPackInput' if (Buf%ErrStat /= ErrID_None) return - ! AoA call RegUnpack(Buf, OutData%AoA) if (RegCheckErr(Buf, RoutineName)) return - ! UserProp call RegUnpack(Buf, OutData%UserProp) if (RegCheckErr(Buf, RoutineName)) return - ! Re call RegUnpack(Buf, OutData%Re) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE AFI_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AFI_OutputType), INTENT(IN) :: SrcOutputData - TYPE(AFI_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_CopyOutput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOutputData%Cl = SrcOutputData%Cl - DstOutputData%Cd = SrcOutputData%Cd - DstOutputData%Cm = SrcOutputData%Cm - DstOutputData%Cpmin = SrcOutputData%Cpmin - DstOutputData%Cd0 = SrcOutputData%Cd0 - DstOutputData%Cm0 = SrcOutputData%Cm0 - DstOutputData%f_st = SrcOutputData%f_st - DstOutputData%FullySeparate = SrcOutputData%FullySeparate - DstOutputData%FullyAttached = SrcOutputData%FullyAttached - END SUBROUTINE AFI_CopyOutput - - SUBROUTINE AFI_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(AFI_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_DestroyOutput' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE AFI_DestroyOutput +subroutine AFI_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(AFI_OutputType), intent(in) :: SrcOutputData + type(AFI_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AFI_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + DstOutputData%Cl = SrcOutputData%Cl + DstOutputData%Cd = SrcOutputData%Cd + DstOutputData%Cm = SrcOutputData%Cm + DstOutputData%Cpmin = SrcOutputData%Cpmin + DstOutputData%Cd0 = SrcOutputData%Cd0 + DstOutputData%Cm0 = SrcOutputData%Cm0 + DstOutputData%f_st = SrcOutputData%f_st + DstOutputData%FullySeparate = SrcOutputData%FullySeparate + DstOutputData%FullyAttached = SrcOutputData%FullyAttached +end subroutine +subroutine AFI_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(AFI_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AFI_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine AFI_PackOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AFI_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AFI_PackOutput' if (Buf%ErrStat >= AbortErrLev) return - ! Cl call RegPack(Buf, InData%Cl) if (RegCheckErr(Buf, RoutineName)) return - ! Cd call RegPack(Buf, InData%Cd) if (RegCheckErr(Buf, RoutineName)) return - ! Cm call RegPack(Buf, InData%Cm) if (RegCheckErr(Buf, RoutineName)) return - ! Cpmin call RegPack(Buf, InData%Cpmin) if (RegCheckErr(Buf, RoutineName)) return - ! Cd0 call RegPack(Buf, InData%Cd0) if (RegCheckErr(Buf, RoutineName)) return - ! Cm0 call RegPack(Buf, InData%Cm0) if (RegCheckErr(Buf, RoutineName)) return - ! f_st call RegPack(Buf, InData%f_st) if (RegCheckErr(Buf, RoutineName)) return - ! FullySeparate call RegPack(Buf, InData%FullySeparate) if (RegCheckErr(Buf, RoutineName)) return - ! FullyAttached call RegPack(Buf, InData%FullyAttached) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1689,31 +1369,22 @@ subroutine AFI_UnPackOutput(Buf, OutData) type(AFI_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AFI_UnPackOutput' if (Buf%ErrStat /= ErrID_None) return - ! Cl call RegUnpack(Buf, OutData%Cl) if (RegCheckErr(Buf, RoutineName)) return - ! Cd call RegUnpack(Buf, OutData%Cd) if (RegCheckErr(Buf, RoutineName)) return - ! Cm call RegUnpack(Buf, OutData%Cm) if (RegCheckErr(Buf, RoutineName)) return - ! Cpmin call RegUnpack(Buf, OutData%Cpmin) if (RegCheckErr(Buf, RoutineName)) return - ! Cd0 call RegUnpack(Buf, OutData%Cd0) if (RegCheckErr(Buf, RoutineName)) return - ! Cm0 call RegUnpack(Buf, OutData%Cm0) if (RegCheckErr(Buf, RoutineName)) return - ! f_st call RegUnpack(Buf, OutData%f_st) if (RegCheckErr(Buf, RoutineName)) return - ! FullySeparate call RegUnpack(Buf, OutData%FullySeparate) if (RegCheckErr(Buf, RoutineName)) return - ! FullyAttached call RegUnpack(Buf, OutData%FullyAttached) if (RegCheckErr(Buf, RoutineName)) return end subroutine diff --git a/modules/aerodyn/src/BEMT_Types.f90 b/modules/aerodyn/src/BEMT_Types.f90 index 026c9167cb..79eeb10ecc 100644 --- a/modules/aerodyn/src/BEMT_Types.f90 +++ b/modules/aerodyn/src/BEMT_Types.f90 @@ -223,349 +223,314 @@ MODULE BEMT_Types END TYPE BEMT_OutputType ! ======================= CONTAINS - SUBROUTINE BEMT_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BEMT_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(BEMT_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInitInputData%chord)) THEN - i1_l = LBOUND(SrcInitInputData%chord,1) - i1_u = UBOUND(SrcInitInputData%chord,1) - i2_l = LBOUND(SrcInitInputData%chord,2) - i2_u = UBOUND(SrcInitInputData%chord,2) - IF (.NOT. ALLOCATED(DstInitInputData%chord)) THEN - ALLOCATE(DstInitInputData%chord(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%chord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%chord = SrcInitInputData%chord -ENDIF - DstInitInputData%numBlades = SrcInitInputData%numBlades - DstInitInputData%airDens = SrcInitInputData%airDens - DstInitInputData%kinVisc = SrcInitInputData%kinVisc - DstInitInputData%skewWakeMod = SrcInitInputData%skewWakeMod - DstInitInputData%aTol = SrcInitInputData%aTol - DstInitInputData%useTipLoss = SrcInitInputData%useTipLoss - DstInitInputData%useHubLoss = SrcInitInputData%useHubLoss - DstInitInputData%useInduction = SrcInitInputData%useInduction - DstInitInputData%useTanInd = SrcInitInputData%useTanInd - DstInitInputData%useAIDrag = SrcInitInputData%useAIDrag - DstInitInputData%useTIDrag = SrcInitInputData%useTIDrag - DstInitInputData%MomentumCorr = SrcInitInputData%MomentumCorr - DstInitInputData%numBladeNodes = SrcInitInputData%numBladeNodes - DstInitInputData%numReIterations = SrcInitInputData%numReIterations - DstInitInputData%maxIndIterations = SrcInitInputData%maxIndIterations -IF (ALLOCATED(SrcInitInputData%AFindx)) THEN - i1_l = LBOUND(SrcInitInputData%AFindx,1) - i1_u = UBOUND(SrcInitInputData%AFindx,1) - i2_l = LBOUND(SrcInitInputData%AFindx,2) - i2_u = UBOUND(SrcInitInputData%AFindx,2) - IF (.NOT. ALLOCATED(DstInitInputData%AFindx)) THEN - ALLOCATE(DstInitInputData%AFindx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%AFindx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%AFindx = SrcInitInputData%AFindx -ENDIF -IF (ALLOCATED(SrcInitInputData%zHub)) THEN - i1_l = LBOUND(SrcInitInputData%zHub,1) - i1_u = UBOUND(SrcInitInputData%zHub,1) - IF (.NOT. ALLOCATED(DstInitInputData%zHub)) THEN - ALLOCATE(DstInitInputData%zHub(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%zHub.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%zHub = SrcInitInputData%zHub -ENDIF -IF (ALLOCATED(SrcInitInputData%zLocal)) THEN - i1_l = LBOUND(SrcInitInputData%zLocal,1) - i1_u = UBOUND(SrcInitInputData%zLocal,1) - i2_l = LBOUND(SrcInitInputData%zLocal,2) - i2_u = UBOUND(SrcInitInputData%zLocal,2) - IF (.NOT. ALLOCATED(DstInitInputData%zLocal)) THEN - ALLOCATE(DstInitInputData%zLocal(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%zLocal.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%zLocal = SrcInitInputData%zLocal -ENDIF -IF (ALLOCATED(SrcInitInputData%zTip)) THEN - i1_l = LBOUND(SrcInitInputData%zTip,1) - i1_u = UBOUND(SrcInitInputData%zTip,1) - IF (.NOT. ALLOCATED(DstInitInputData%zTip)) THEN - ALLOCATE(DstInitInputData%zTip(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%zTip.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%zTip = SrcInitInputData%zTip -ENDIF -IF (ALLOCATED(SrcInitInputData%rLocal)) THEN - i1_l = LBOUND(SrcInitInputData%rLocal,1) - i1_u = UBOUND(SrcInitInputData%rLocal,1) - i2_l = LBOUND(SrcInitInputData%rLocal,2) - i2_u = UBOUND(SrcInitInputData%rLocal,2) - IF (.NOT. ALLOCATED(DstInitInputData%rLocal)) THEN - ALLOCATE(DstInitInputData%rLocal(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%rLocal.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%rLocal = SrcInitInputData%rLocal -ENDIF -IF (ALLOCATED(SrcInitInputData%rTipFix)) THEN - i1_l = LBOUND(SrcInitInputData%rTipFix,1) - i1_u = UBOUND(SrcInitInputData%rTipFix,1) - IF (.NOT. ALLOCATED(DstInitInputData%rTipFix)) THEN - ALLOCATE(DstInitInputData%rTipFix(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%rTipFix.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%rTipFix = SrcInitInputData%rTipFix -ENDIF - DstInitInputData%UAMod = SrcInitInputData%UAMod - DstInitInputData%UA_Flag = SrcInitInputData%UA_Flag - DstInitInputData%Flookup = SrcInitInputData%Flookup - DstInitInputData%a_s = SrcInitInputData%a_s - DstInitInputData%DBEMT_Mod = SrcInitInputData%DBEMT_Mod - DstInitInputData%tau1_const = SrcInitInputData%tau1_const - DstInitInputData%yawCorrFactor = SrcInitInputData%yawCorrFactor -IF (ALLOCATED(SrcInitInputData%UAOff_innerNode)) THEN - i1_l = LBOUND(SrcInitInputData%UAOff_innerNode,1) - i1_u = UBOUND(SrcInitInputData%UAOff_innerNode,1) - IF (.NOT. ALLOCATED(DstInitInputData%UAOff_innerNode)) THEN - ALLOCATE(DstInitInputData%UAOff_innerNode(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%UAOff_innerNode.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%UAOff_innerNode = SrcInitInputData%UAOff_innerNode -ENDIF -IF (ALLOCATED(SrcInitInputData%UAOff_outerNode)) THEN - i1_l = LBOUND(SrcInitInputData%UAOff_outerNode,1) - i1_u = UBOUND(SrcInitInputData%UAOff_outerNode,1) - IF (.NOT. ALLOCATED(DstInitInputData%UAOff_outerNode)) THEN - ALLOCATE(DstInitInputData%UAOff_outerNode(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%UAOff_outerNode.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%UAOff_outerNode = SrcInitInputData%UAOff_outerNode -ENDIF - DstInitInputData%RootName = SrcInitInputData%RootName - DstInitInputData%SumPrint = SrcInitInputData%SumPrint - DstInitInputData%BEM_Mod = SrcInitInputData%BEM_Mod - END SUBROUTINE BEMT_CopyInitInput - - SUBROUTINE BEMT_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(BEMT_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_DestroyInitInput' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitInputData%chord)) THEN - DEALLOCATE(InitInputData%chord) -ENDIF -IF (ALLOCATED(InitInputData%AFindx)) THEN - DEALLOCATE(InitInputData%AFindx) -ENDIF -IF (ALLOCATED(InitInputData%zHub)) THEN - DEALLOCATE(InitInputData%zHub) -ENDIF -IF (ALLOCATED(InitInputData%zLocal)) THEN - DEALLOCATE(InitInputData%zLocal) -ENDIF -IF (ALLOCATED(InitInputData%zTip)) THEN - DEALLOCATE(InitInputData%zTip) -ENDIF -IF (ALLOCATED(InitInputData%rLocal)) THEN - DEALLOCATE(InitInputData%rLocal) -ENDIF -IF (ALLOCATED(InitInputData%rTipFix)) THEN - DEALLOCATE(InitInputData%rTipFix) -ENDIF -IF (ALLOCATED(InitInputData%UAOff_innerNode)) THEN - DEALLOCATE(InitInputData%UAOff_innerNode) -ENDIF -IF (ALLOCATED(InitInputData%UAOff_outerNode)) THEN - DEALLOCATE(InitInputData%UAOff_outerNode) -ENDIF - END SUBROUTINE BEMT_DestroyInitInput +subroutine BEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(BEMT_InitInputType), intent(in) :: SrcInitInputData + type(BEMT_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'BEMT_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInitInputData%chord)) then + LB(1:2) = lbound(SrcInitInputData%chord) + UB(1:2) = ubound(SrcInitInputData%chord) + if (.not. allocated(DstInitInputData%chord)) then + allocate(DstInitInputData%chord(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%chord.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%chord = SrcInitInputData%chord + else if (allocated(DstInitInputData%chord)) then + deallocate(DstInitInputData%chord) + end if + DstInitInputData%numBlades = SrcInitInputData%numBlades + DstInitInputData%airDens = SrcInitInputData%airDens + DstInitInputData%kinVisc = SrcInitInputData%kinVisc + DstInitInputData%skewWakeMod = SrcInitInputData%skewWakeMod + DstInitInputData%aTol = SrcInitInputData%aTol + DstInitInputData%useTipLoss = SrcInitInputData%useTipLoss + DstInitInputData%useHubLoss = SrcInitInputData%useHubLoss + DstInitInputData%useInduction = SrcInitInputData%useInduction + DstInitInputData%useTanInd = SrcInitInputData%useTanInd + DstInitInputData%useAIDrag = SrcInitInputData%useAIDrag + DstInitInputData%useTIDrag = SrcInitInputData%useTIDrag + DstInitInputData%MomentumCorr = SrcInitInputData%MomentumCorr + DstInitInputData%numBladeNodes = SrcInitInputData%numBladeNodes + DstInitInputData%numReIterations = SrcInitInputData%numReIterations + DstInitInputData%maxIndIterations = SrcInitInputData%maxIndIterations + if (allocated(SrcInitInputData%AFindx)) then + LB(1:2) = lbound(SrcInitInputData%AFindx) + UB(1:2) = ubound(SrcInitInputData%AFindx) + if (.not. allocated(DstInitInputData%AFindx)) then + allocate(DstInitInputData%AFindx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%AFindx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%AFindx = SrcInitInputData%AFindx + else if (allocated(DstInitInputData%AFindx)) then + deallocate(DstInitInputData%AFindx) + end if + if (allocated(SrcInitInputData%zHub)) then + LB(1:1) = lbound(SrcInitInputData%zHub) + UB(1:1) = ubound(SrcInitInputData%zHub) + if (.not. allocated(DstInitInputData%zHub)) then + allocate(DstInitInputData%zHub(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%zHub.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%zHub = SrcInitInputData%zHub + else if (allocated(DstInitInputData%zHub)) then + deallocate(DstInitInputData%zHub) + end if + if (allocated(SrcInitInputData%zLocal)) then + LB(1:2) = lbound(SrcInitInputData%zLocal) + UB(1:2) = ubound(SrcInitInputData%zLocal) + if (.not. allocated(DstInitInputData%zLocal)) then + allocate(DstInitInputData%zLocal(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%zLocal.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%zLocal = SrcInitInputData%zLocal + else if (allocated(DstInitInputData%zLocal)) then + deallocate(DstInitInputData%zLocal) + end if + if (allocated(SrcInitInputData%zTip)) then + LB(1:1) = lbound(SrcInitInputData%zTip) + UB(1:1) = ubound(SrcInitInputData%zTip) + if (.not. allocated(DstInitInputData%zTip)) then + allocate(DstInitInputData%zTip(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%zTip.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%zTip = SrcInitInputData%zTip + else if (allocated(DstInitInputData%zTip)) then + deallocate(DstInitInputData%zTip) + end if + if (allocated(SrcInitInputData%rLocal)) then + LB(1:2) = lbound(SrcInitInputData%rLocal) + UB(1:2) = ubound(SrcInitInputData%rLocal) + if (.not. allocated(DstInitInputData%rLocal)) then + allocate(DstInitInputData%rLocal(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%rLocal.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%rLocal = SrcInitInputData%rLocal + else if (allocated(DstInitInputData%rLocal)) then + deallocate(DstInitInputData%rLocal) + end if + if (allocated(SrcInitInputData%rTipFix)) then + LB(1:1) = lbound(SrcInitInputData%rTipFix) + UB(1:1) = ubound(SrcInitInputData%rTipFix) + if (.not. allocated(DstInitInputData%rTipFix)) then + allocate(DstInitInputData%rTipFix(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%rTipFix.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%rTipFix = SrcInitInputData%rTipFix + else if (allocated(DstInitInputData%rTipFix)) then + deallocate(DstInitInputData%rTipFix) + end if + DstInitInputData%UAMod = SrcInitInputData%UAMod + DstInitInputData%UA_Flag = SrcInitInputData%UA_Flag + DstInitInputData%Flookup = SrcInitInputData%Flookup + DstInitInputData%a_s = SrcInitInputData%a_s + DstInitInputData%DBEMT_Mod = SrcInitInputData%DBEMT_Mod + DstInitInputData%tau1_const = SrcInitInputData%tau1_const + DstInitInputData%yawCorrFactor = SrcInitInputData%yawCorrFactor + if (allocated(SrcInitInputData%UAOff_innerNode)) then + LB(1:1) = lbound(SrcInitInputData%UAOff_innerNode) + UB(1:1) = ubound(SrcInitInputData%UAOff_innerNode) + if (.not. allocated(DstInitInputData%UAOff_innerNode)) then + allocate(DstInitInputData%UAOff_innerNode(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%UAOff_innerNode.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%UAOff_innerNode = SrcInitInputData%UAOff_innerNode + else if (allocated(DstInitInputData%UAOff_innerNode)) then + deallocate(DstInitInputData%UAOff_innerNode) + end if + if (allocated(SrcInitInputData%UAOff_outerNode)) then + LB(1:1) = lbound(SrcInitInputData%UAOff_outerNode) + UB(1:1) = ubound(SrcInitInputData%UAOff_outerNode) + if (.not. allocated(DstInitInputData%UAOff_outerNode)) then + allocate(DstInitInputData%UAOff_outerNode(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%UAOff_outerNode.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%UAOff_outerNode = SrcInitInputData%UAOff_outerNode + else if (allocated(DstInitInputData%UAOff_outerNode)) then + deallocate(DstInitInputData%UAOff_outerNode) + end if + DstInitInputData%RootName = SrcInitInputData%RootName + DstInitInputData%SumPrint = SrcInitInputData%SumPrint + DstInitInputData%BEM_Mod = SrcInitInputData%BEM_Mod +end subroutine +subroutine BEMT_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(BEMT_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BEMT_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitInputData%chord)) then + deallocate(InitInputData%chord) + end if + if (allocated(InitInputData%AFindx)) then + deallocate(InitInputData%AFindx) + end if + if (allocated(InitInputData%zHub)) then + deallocate(InitInputData%zHub) + end if + if (allocated(InitInputData%zLocal)) then + deallocate(InitInputData%zLocal) + end if + if (allocated(InitInputData%zTip)) then + deallocate(InitInputData%zTip) + end if + if (allocated(InitInputData%rLocal)) then + deallocate(InitInputData%rLocal) + end if + if (allocated(InitInputData%rTipFix)) then + deallocate(InitInputData%rTipFix) + end if + if (allocated(InitInputData%UAOff_innerNode)) then + deallocate(InitInputData%UAOff_innerNode) + end if + if (allocated(InitInputData%UAOff_outerNode)) then + deallocate(InitInputData%UAOff_outerNode) + end if +end subroutine subroutine BEMT_PackInitInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(BEMT_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'BEMT_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return - ! chord call RegPack(Buf, allocated(InData%chord)) if (allocated(InData%chord)) then call RegPackBounds(Buf, 2, lbound(InData%chord), ubound(InData%chord)) call RegPack(Buf, InData%chord) end if if (RegCheckErr(Buf, RoutineName)) return - ! numBlades call RegPack(Buf, InData%numBlades) if (RegCheckErr(Buf, RoutineName)) return - ! airDens call RegPack(Buf, InData%airDens) if (RegCheckErr(Buf, RoutineName)) return - ! kinVisc call RegPack(Buf, InData%kinVisc) if (RegCheckErr(Buf, RoutineName)) return - ! skewWakeMod call RegPack(Buf, InData%skewWakeMod) if (RegCheckErr(Buf, RoutineName)) return - ! aTol call RegPack(Buf, InData%aTol) if (RegCheckErr(Buf, RoutineName)) return - ! useTipLoss call RegPack(Buf, InData%useTipLoss) if (RegCheckErr(Buf, RoutineName)) return - ! useHubLoss call RegPack(Buf, InData%useHubLoss) if (RegCheckErr(Buf, RoutineName)) return - ! useInduction call RegPack(Buf, InData%useInduction) if (RegCheckErr(Buf, RoutineName)) return - ! useTanInd call RegPack(Buf, InData%useTanInd) if (RegCheckErr(Buf, RoutineName)) return - ! useAIDrag call RegPack(Buf, InData%useAIDrag) if (RegCheckErr(Buf, RoutineName)) return - ! useTIDrag call RegPack(Buf, InData%useTIDrag) if (RegCheckErr(Buf, RoutineName)) return - ! MomentumCorr call RegPack(Buf, InData%MomentumCorr) if (RegCheckErr(Buf, RoutineName)) return - ! numBladeNodes call RegPack(Buf, InData%numBladeNodes) if (RegCheckErr(Buf, RoutineName)) return - ! numReIterations call RegPack(Buf, InData%numReIterations) if (RegCheckErr(Buf, RoutineName)) return - ! maxIndIterations call RegPack(Buf, InData%maxIndIterations) if (RegCheckErr(Buf, RoutineName)) return - ! AFindx call RegPack(Buf, allocated(InData%AFindx)) if (allocated(InData%AFindx)) then call RegPackBounds(Buf, 2, lbound(InData%AFindx), ubound(InData%AFindx)) call RegPack(Buf, InData%AFindx) end if if (RegCheckErr(Buf, RoutineName)) return - ! zHub call RegPack(Buf, allocated(InData%zHub)) if (allocated(InData%zHub)) then call RegPackBounds(Buf, 1, lbound(InData%zHub), ubound(InData%zHub)) call RegPack(Buf, InData%zHub) end if if (RegCheckErr(Buf, RoutineName)) return - ! zLocal call RegPack(Buf, allocated(InData%zLocal)) if (allocated(InData%zLocal)) then call RegPackBounds(Buf, 2, lbound(InData%zLocal), ubound(InData%zLocal)) call RegPack(Buf, InData%zLocal) end if if (RegCheckErr(Buf, RoutineName)) return - ! zTip call RegPack(Buf, allocated(InData%zTip)) if (allocated(InData%zTip)) then call RegPackBounds(Buf, 1, lbound(InData%zTip), ubound(InData%zTip)) call RegPack(Buf, InData%zTip) end if if (RegCheckErr(Buf, RoutineName)) return - ! rLocal call RegPack(Buf, allocated(InData%rLocal)) if (allocated(InData%rLocal)) then call RegPackBounds(Buf, 2, lbound(InData%rLocal), ubound(InData%rLocal)) call RegPack(Buf, InData%rLocal) end if if (RegCheckErr(Buf, RoutineName)) return - ! rTipFix call RegPack(Buf, allocated(InData%rTipFix)) if (allocated(InData%rTipFix)) then call RegPackBounds(Buf, 1, lbound(InData%rTipFix), ubound(InData%rTipFix)) call RegPack(Buf, InData%rTipFix) end if if (RegCheckErr(Buf, RoutineName)) return - ! UAMod call RegPack(Buf, InData%UAMod) if (RegCheckErr(Buf, RoutineName)) return - ! UA_Flag call RegPack(Buf, InData%UA_Flag) if (RegCheckErr(Buf, RoutineName)) return - ! Flookup call RegPack(Buf, InData%Flookup) if (RegCheckErr(Buf, RoutineName)) return - ! a_s call RegPack(Buf, InData%a_s) if (RegCheckErr(Buf, RoutineName)) return - ! DBEMT_Mod call RegPack(Buf, InData%DBEMT_Mod) if (RegCheckErr(Buf, RoutineName)) return - ! tau1_const call RegPack(Buf, InData%tau1_const) if (RegCheckErr(Buf, RoutineName)) return - ! yawCorrFactor call RegPack(Buf, InData%yawCorrFactor) if (RegCheckErr(Buf, RoutineName)) return - ! UAOff_innerNode call RegPack(Buf, allocated(InData%UAOff_innerNode)) if (allocated(InData%UAOff_innerNode)) then call RegPackBounds(Buf, 1, lbound(InData%UAOff_innerNode), ubound(InData%UAOff_innerNode)) call RegPack(Buf, InData%UAOff_innerNode) end if if (RegCheckErr(Buf, RoutineName)) return - ! UAOff_outerNode call RegPack(Buf, allocated(InData%UAOff_outerNode)) if (allocated(InData%UAOff_outerNode)) then call RegPackBounds(Buf, 1, lbound(InData%UAOff_outerNode), ubound(InData%UAOff_outerNode)) call RegPack(Buf, InData%UAOff_outerNode) end if if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegPack(Buf, InData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! SumPrint call RegPack(Buf, InData%SumPrint) if (RegCheckErr(Buf, RoutineName)) return - ! BEM_Mod call RegPack(Buf, InData%BEM_Mod) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -578,7 +543,6 @@ subroutine BEMT_UnPackInitInput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! chord if (allocated(OutData%chord)) deallocate(OutData%chord) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -593,52 +557,36 @@ subroutine BEMT_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%chord) if (RegCheckErr(Buf, RoutineName)) return end if - ! numBlades call RegUnpack(Buf, OutData%numBlades) if (RegCheckErr(Buf, RoutineName)) return - ! airDens call RegUnpack(Buf, OutData%airDens) if (RegCheckErr(Buf, RoutineName)) return - ! kinVisc call RegUnpack(Buf, OutData%kinVisc) if (RegCheckErr(Buf, RoutineName)) return - ! skewWakeMod call RegUnpack(Buf, OutData%skewWakeMod) if (RegCheckErr(Buf, RoutineName)) return - ! aTol call RegUnpack(Buf, OutData%aTol) if (RegCheckErr(Buf, RoutineName)) return - ! useTipLoss call RegUnpack(Buf, OutData%useTipLoss) if (RegCheckErr(Buf, RoutineName)) return - ! useHubLoss call RegUnpack(Buf, OutData%useHubLoss) if (RegCheckErr(Buf, RoutineName)) return - ! useInduction call RegUnpack(Buf, OutData%useInduction) if (RegCheckErr(Buf, RoutineName)) return - ! useTanInd call RegUnpack(Buf, OutData%useTanInd) if (RegCheckErr(Buf, RoutineName)) return - ! useAIDrag call RegUnpack(Buf, OutData%useAIDrag) if (RegCheckErr(Buf, RoutineName)) return - ! useTIDrag call RegUnpack(Buf, OutData%useTIDrag) if (RegCheckErr(Buf, RoutineName)) return - ! MomentumCorr call RegUnpack(Buf, OutData%MomentumCorr) if (RegCheckErr(Buf, RoutineName)) return - ! numBladeNodes call RegUnpack(Buf, OutData%numBladeNodes) if (RegCheckErr(Buf, RoutineName)) return - ! numReIterations call RegUnpack(Buf, OutData%numReIterations) if (RegCheckErr(Buf, RoutineName)) return - ! maxIndIterations call RegUnpack(Buf, OutData%maxIndIterations) if (RegCheckErr(Buf, RoutineName)) return - ! AFindx if (allocated(OutData%AFindx)) deallocate(OutData%AFindx) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -653,7 +601,6 @@ subroutine BEMT_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%AFindx) if (RegCheckErr(Buf, RoutineName)) return end if - ! zHub if (allocated(OutData%zHub)) deallocate(OutData%zHub) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -668,7 +615,6 @@ subroutine BEMT_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%zHub) if (RegCheckErr(Buf, RoutineName)) return end if - ! zLocal if (allocated(OutData%zLocal)) deallocate(OutData%zLocal) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -683,7 +629,6 @@ subroutine BEMT_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%zLocal) if (RegCheckErr(Buf, RoutineName)) return end if - ! zTip if (allocated(OutData%zTip)) deallocate(OutData%zTip) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -698,7 +643,6 @@ subroutine BEMT_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%zTip) if (RegCheckErr(Buf, RoutineName)) return end if - ! rLocal if (allocated(OutData%rLocal)) deallocate(OutData%rLocal) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -713,7 +657,6 @@ subroutine BEMT_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%rLocal) if (RegCheckErr(Buf, RoutineName)) return end if - ! rTipFix if (allocated(OutData%rTipFix)) deallocate(OutData%rTipFix) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -728,28 +671,20 @@ subroutine BEMT_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%rTipFix) if (RegCheckErr(Buf, RoutineName)) return end if - ! UAMod call RegUnpack(Buf, OutData%UAMod) if (RegCheckErr(Buf, RoutineName)) return - ! UA_Flag call RegUnpack(Buf, OutData%UA_Flag) if (RegCheckErr(Buf, RoutineName)) return - ! Flookup call RegUnpack(Buf, OutData%Flookup) if (RegCheckErr(Buf, RoutineName)) return - ! a_s call RegUnpack(Buf, OutData%a_s) if (RegCheckErr(Buf, RoutineName)) return - ! DBEMT_Mod call RegUnpack(Buf, OutData%DBEMT_Mod) if (RegCheckErr(Buf, RoutineName)) return - ! tau1_const call RegUnpack(Buf, OutData%tau1_const) if (RegCheckErr(Buf, RoutineName)) return - ! yawCorrFactor call RegUnpack(Buf, OutData%yawCorrFactor) if (RegCheckErr(Buf, RoutineName)) return - ! UAOff_innerNode if (allocated(OutData%UAOff_innerNode)) deallocate(OutData%UAOff_innerNode) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -764,7 +699,6 @@ subroutine BEMT_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%UAOff_innerNode) if (RegCheckErr(Buf, RoutineName)) return end if - ! UAOff_outerNode if (allocated(OutData%UAOff_outerNode)) deallocate(OutData%UAOff_outerNode) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -779,59 +713,46 @@ subroutine BEMT_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%UAOff_outerNode) if (RegCheckErr(Buf, RoutineName)) return end if - ! RootName call RegUnpack(Buf, OutData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! SumPrint call RegUnpack(Buf, OutData%SumPrint) if (RegCheckErr(Buf, RoutineName)) return - ! BEM_Mod call RegUnpack(Buf, OutData%BEM_Mod) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE BEMT_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BEMT_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(BEMT_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_CopyInitOutput' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Version, DstInitOutputData%Version, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE BEMT_CopyInitOutput - - SUBROUTINE BEMT_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(BEMT_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_DestroyInitOutput' - ErrStat = ErrID_None - ErrMsg = "" - - CALL NWTC_Library_DestroyProgDesc( InitOutputData%Version, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE BEMT_DestroyInitOutput +subroutine BEMT_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(BEMT_InitOutputType), intent(in) :: SrcInitOutputData + type(BEMT_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BEMT_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Version, DstInitOutputData%Version, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine BEMT_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(BEMT_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BEMT_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine BEMT_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(BEMT_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'BEMT_PackInitOutput' if (Buf%ErrStat >= AbortErrLev) return - ! Version call NWTC_Library_PackProgDesc(Buf, InData%Version) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -841,57 +762,41 @@ subroutine BEMT_UnPackInitOutput(Buf, OutData) type(BEMT_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BEMT_UnPackInitOutput' if (Buf%ErrStat /= ErrID_None) return - ! Version call NWTC_Library_UnpackProgDesc(Buf, OutData%Version) ! Version end subroutine - SUBROUTINE BEMT_CopySkewWake_InputType( SrcSkewWake_InputTypeData, DstSkewWake_InputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BEMT_SkewWake_InputType), INTENT(IN) :: SrcSkewWake_InputTypeData - TYPE(BEMT_SkewWake_InputType), INTENT(INOUT) :: DstSkewWake_InputTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_CopySkewWake_InputType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstSkewWake_InputTypeData%v_qsw = SrcSkewWake_InputTypeData%v_qsw - DstSkewWake_InputTypeData%V0 = SrcSkewWake_InputTypeData%V0 - DstSkewWake_InputTypeData%R = SrcSkewWake_InputTypeData%R - END SUBROUTINE BEMT_CopySkewWake_InputType - - SUBROUTINE BEMT_DestroySkewWake_InputType( SkewWake_InputTypeData, ErrStat, ErrMsg ) - TYPE(BEMT_SkewWake_InputType), INTENT(INOUT) :: SkewWake_InputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_DestroySkewWake_InputType' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE BEMT_DestroySkewWake_InputType +subroutine BEMT_CopySkewWake_InputType(SrcSkewWake_InputTypeData, DstSkewWake_InputTypeData, CtrlCode, ErrStat, ErrMsg) + type(BEMT_SkewWake_InputType), intent(in) :: SrcSkewWake_InputTypeData + type(BEMT_SkewWake_InputType), intent(inout) :: DstSkewWake_InputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BEMT_CopySkewWake_InputType' + ErrStat = ErrID_None + ErrMsg = '' + DstSkewWake_InputTypeData%v_qsw = SrcSkewWake_InputTypeData%v_qsw + DstSkewWake_InputTypeData%V0 = SrcSkewWake_InputTypeData%V0 + DstSkewWake_InputTypeData%R = SrcSkewWake_InputTypeData%R +end subroutine +subroutine BEMT_DestroySkewWake_InputType(SkewWake_InputTypeData, ErrStat, ErrMsg) + type(BEMT_SkewWake_InputType), intent(inout) :: SkewWake_InputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BEMT_DestroySkewWake_InputType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine BEMT_PackSkewWake_InputType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(BEMT_SkewWake_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'BEMT_PackSkewWake_InputType' if (Buf%ErrStat >= AbortErrLev) return - ! v_qsw call RegPack(Buf, InData%v_qsw) if (RegCheckErr(Buf, RoutineName)) return - ! V0 call RegPack(Buf, InData%V0) if (RegCheckErr(Buf, RoutineName)) return - ! R call RegPack(Buf, InData%R) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -901,72 +806,54 @@ subroutine BEMT_UnPackSkewWake_InputType(Buf, OutData) type(BEMT_SkewWake_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BEMT_UnPackSkewWake_InputType' if (Buf%ErrStat /= ErrID_None) return - ! v_qsw call RegUnpack(Buf, OutData%v_qsw) if (RegCheckErr(Buf, RoutineName)) return - ! V0 call RegUnpack(Buf, OutData%V0) if (RegCheckErr(Buf, RoutineName)) return - ! R call RegUnpack(Buf, OutData%R) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE BEMT_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BEMT_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(BEMT_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL UA_CopyContState( SrcContStateData%UA, DstContStateData%UA, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DBEMT_CopyContState( SrcContStateData%DBEMT, DstContStateData%DBEMT, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstContStateData%V_w = SrcContStateData%V_w - END SUBROUTINE BEMT_CopyContState - - SUBROUTINE BEMT_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(BEMT_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_DestroyContState' - ErrStat = ErrID_None - ErrMsg = "" - - CALL UA_DestroyContState( ContStateData%UA, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DBEMT_DestroyContState( ContStateData%DBEMT, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE BEMT_DestroyContState +subroutine BEMT_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(BEMT_ContinuousStateType), intent(in) :: SrcContStateData + type(BEMT_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BEMT_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + call UA_CopyContState(SrcContStateData%UA, DstContStateData%UA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call DBEMT_CopyContState(SrcContStateData%DBEMT, DstContStateData%DBEMT, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstContStateData%V_w = SrcContStateData%V_w +end subroutine +subroutine BEMT_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(BEMT_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BEMT_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine BEMT_PackContState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(BEMT_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'BEMT_PackContState' if (Buf%ErrStat >= AbortErrLev) return - ! UA call UA_PackContState(Buf, InData%UA) if (RegCheckErr(Buf, RoutineName)) return - ! DBEMT call DBEMT_PackContState(Buf, InData%DBEMT) if (RegCheckErr(Buf, RoutineName)) return - ! V_w call RegPack(Buf, InData%V_w) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -976,57 +863,44 @@ subroutine BEMT_UnPackContState(Buf, OutData) type(BEMT_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BEMT_UnPackContState' if (Buf%ErrStat /= ErrID_None) return - ! UA call UA_UnpackContState(Buf, OutData%UA) ! UA - ! DBEMT call DBEMT_UnpackContState(Buf, OutData%DBEMT) ! DBEMT - ! V_w call RegUnpack(Buf, OutData%V_w) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE BEMT_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BEMT_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(BEMT_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL UA_CopyDiscState( SrcDiscStateData%UA, DstDiscStateData%UA, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE BEMT_CopyDiscState - - SUBROUTINE BEMT_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(BEMT_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_DestroyDiscState' - ErrStat = ErrID_None - ErrMsg = "" - - CALL UA_DestroyDiscState( DiscStateData%UA, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE BEMT_DestroyDiscState +subroutine BEMT_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(BEMT_DiscreteStateType), intent(in) :: SrcDiscStateData + type(BEMT_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BEMT_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + call UA_CopyDiscState(SrcDiscStateData%UA, DstDiscStateData%UA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine BEMT_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(BEMT_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BEMT_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine BEMT_PackDiscState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(BEMT_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'BEMT_PackDiscState' if (Buf%ErrStat >= AbortErrLev) return - ! UA call UA_PackDiscState(Buf, InData%UA) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1036,66 +910,53 @@ subroutine BEMT_UnPackDiscState(Buf, OutData) type(BEMT_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BEMT_UnPackDiscState' if (Buf%ErrStat /= ErrID_None) return - ! UA call UA_UnpackDiscState(Buf, OutData%UA) ! UA end subroutine - SUBROUTINE BEMT_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BEMT_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(BEMT_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcConstrStateData%phi)) THEN - i1_l = LBOUND(SrcConstrStateData%phi,1) - i1_u = UBOUND(SrcConstrStateData%phi,1) - i2_l = LBOUND(SrcConstrStateData%phi,2) - i2_u = UBOUND(SrcConstrStateData%phi,2) - IF (.NOT. ALLOCATED(DstConstrStateData%phi)) THEN - ALLOCATE(DstConstrStateData%phi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%phi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstConstrStateData%phi = SrcConstrStateData%phi -ENDIF - END SUBROUTINE BEMT_CopyConstrState - - SUBROUTINE BEMT_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(BEMT_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_DestroyConstrState' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ConstrStateData%phi)) THEN - DEALLOCATE(ConstrStateData%phi) -ENDIF - END SUBROUTINE BEMT_DestroyConstrState +subroutine BEMT_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(BEMT_ConstraintStateType), intent(in) :: SrcConstrStateData + type(BEMT_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'BEMT_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcConstrStateData%phi)) then + LB(1:2) = lbound(SrcConstrStateData%phi) + UB(1:2) = ubound(SrcConstrStateData%phi) + if (.not. allocated(DstConstrStateData%phi)) then + allocate(DstConstrStateData%phi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%phi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstConstrStateData%phi = SrcConstrStateData%phi + else if (allocated(DstConstrStateData%phi)) then + deallocate(DstConstrStateData%phi) + end if +end subroutine +subroutine BEMT_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(BEMT_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BEMT_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ConstrStateData%phi)) then + deallocate(ConstrStateData%phi) + end if +end subroutine subroutine BEMT_PackConstrState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(BEMT_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'BEMT_PackConstrState' if (Buf%ErrStat >= AbortErrLev) return - ! phi call RegPack(Buf, allocated(InData%phi)) if (allocated(InData%phi)) then call RegPackBounds(Buf, 2, lbound(InData%phi), ubound(InData%phi)) @@ -1112,7 +973,6 @@ subroutine BEMT_UnPackConstrState(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! phi if (allocated(OutData%phi)) deallocate(OutData%phi) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1128,77 +988,64 @@ subroutine BEMT_UnPackConstrState(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE BEMT_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BEMT_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(BEMT_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL UA_CopyOtherState( SrcOtherStateData%UA, DstOtherStateData%UA, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DBEMT_CopyOtherState( SrcOtherStateData%DBEMT, DstOtherStateData%DBEMT, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcOtherStateData%ValidPhi)) THEN - i1_l = LBOUND(SrcOtherStateData%ValidPhi,1) - i1_u = UBOUND(SrcOtherStateData%ValidPhi,1) - i2_l = LBOUND(SrcOtherStateData%ValidPhi,2) - i2_u = UBOUND(SrcOtherStateData%ValidPhi,2) - IF (.NOT. ALLOCATED(DstOtherStateData%ValidPhi)) THEN - ALLOCATE(DstOtherStateData%ValidPhi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%ValidPhi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%ValidPhi = SrcOtherStateData%ValidPhi -ENDIF - DstOtherStateData%nodesInitialized = SrcOtherStateData%nodesInitialized - DO i1 = LBOUND(SrcOtherStateData%xdot,1), UBOUND(SrcOtherStateData%xdot,1) - CALL BEMT_CopyContState( SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DstOtherStateData%n = SrcOtherStateData%n - END SUBROUTINE BEMT_CopyOtherState - - SUBROUTINE BEMT_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(BEMT_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - CALL UA_DestroyOtherState( OtherStateData%UA, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DBEMT_DestroyOtherState( OtherStateData%DBEMT, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(OtherStateData%ValidPhi)) THEN - DEALLOCATE(OtherStateData%ValidPhi) -ENDIF -DO i1 = LBOUND(OtherStateData%xdot,1), UBOUND(OtherStateData%xdot,1) - CALL BEMT_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - END SUBROUTINE BEMT_DestroyOtherState +subroutine BEMT_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(BEMT_OtherStateType), intent(in) :: SrcOtherStateData + type(BEMT_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BEMT_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + call UA_CopyOtherState(SrcOtherStateData%UA, DstOtherStateData%UA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call DBEMT_CopyOtherState(SrcOtherStateData%DBEMT, DstOtherStateData%DBEMT, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcOtherStateData%ValidPhi)) then + LB(1:2) = lbound(SrcOtherStateData%ValidPhi) + UB(1:2) = ubound(SrcOtherStateData%ValidPhi) + if (.not. allocated(DstOtherStateData%ValidPhi)) then + allocate(DstOtherStateData%ValidPhi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%ValidPhi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%ValidPhi = SrcOtherStateData%ValidPhi + else if (allocated(DstOtherStateData%ValidPhi)) then + deallocate(DstOtherStateData%ValidPhi) + end if + DstOtherStateData%nodesInitialized = SrcOtherStateData%nodesInitialized + do i1 = LB(1), UB(1) + call BEMT_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + DstOtherStateData%n = SrcOtherStateData%n +end subroutine +subroutine BEMT_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(BEMT_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BEMT_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OtherStateData%ValidPhi)) then + deallocate(OtherStateData%ValidPhi) + end if +end subroutine subroutine BEMT_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -1207,30 +1054,24 @@ subroutine BEMT_PackOtherState(Buf, Indata) integer(IntKi) :: i1, i2 integer(IntKi) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return - ! UA call UA_PackOtherState(Buf, InData%UA) if (RegCheckErr(Buf, RoutineName)) return - ! DBEMT call DBEMT_PackOtherState(Buf, InData%DBEMT) if (RegCheckErr(Buf, RoutineName)) return - ! ValidPhi call RegPack(Buf, allocated(InData%ValidPhi)) if (allocated(InData%ValidPhi)) then call RegPackBounds(Buf, 2, lbound(InData%ValidPhi), ubound(InData%ValidPhi)) call RegPack(Buf, InData%ValidPhi) end if if (RegCheckErr(Buf, RoutineName)) return - ! nodesInitialized call RegPack(Buf, InData%nodesInitialized) if (RegCheckErr(Buf, RoutineName)) return - ! xdot LB(1:1) = lbound(InData%xdot) UB(1:1) = ubound(InData%xdot) do i1 = LB(1), UB(1) call BEMT_PackContState(Buf, InData%xdot(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! n call RegPack(Buf, InData%n) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1244,11 +1085,8 @@ subroutine BEMT_UnPackOtherState(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! UA call UA_UnpackOtherState(Buf, OutData%UA) ! UA - ! DBEMT call DBEMT_UnpackOtherState(Buf, OutData%DBEMT) ! DBEMT - ! ValidPhi if (allocated(OutData%ValidPhi)) deallocate(OutData%ValidPhi) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1263,260 +1101,239 @@ subroutine BEMT_UnPackOtherState(Buf, OutData) call RegUnpack(Buf, OutData%ValidPhi) if (RegCheckErr(Buf, RoutineName)) return end if - ! nodesInitialized call RegUnpack(Buf, OutData%nodesInitialized) if (RegCheckErr(Buf, RoutineName)) return - ! xdot LB(1:1) = lbound(OutData%xdot) UB(1:1) = ubound(OutData%xdot) do i1 = LB(1), UB(1) call BEMT_UnpackContState(Buf, OutData%xdot(i1)) ! xdot end do - ! n call RegUnpack(Buf, OutData%n) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE BEMT_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BEMT_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(BEMT_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%FirstWarn_Skew = SrcMiscData%FirstWarn_Skew - DstMiscData%FirstWarn_Phi = SrcMiscData%FirstWarn_Phi - DstMiscData%FirstWarn_BEMoff = SrcMiscData%FirstWarn_BEMoff - CALL UA_CopyMisc( SrcMiscData%UA, DstMiscData%UA, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DBEMT_CopyMisc( SrcMiscData%DBEMT, DstMiscData%DBEMT, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL UA_CopyOutput( SrcMiscData%y_UA, DstMiscData%y_UA, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMiscData%u_UA)) THEN - i1_l = LBOUND(SrcMiscData%u_UA,1) - i1_u = UBOUND(SrcMiscData%u_UA,1) - i2_l = LBOUND(SrcMiscData%u_UA,2) - i2_u = UBOUND(SrcMiscData%u_UA,2) - i3_l = LBOUND(SrcMiscData%u_UA,3) - i3_u = UBOUND(SrcMiscData%u_UA,3) - IF (.NOT. ALLOCATED(DstMiscData%u_UA)) THEN - ALLOCATE(DstMiscData%u_UA(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_UA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i3 = LBOUND(SrcMiscData%u_UA,3), UBOUND(SrcMiscData%u_UA,3) - DO i2 = LBOUND(SrcMiscData%u_UA,2), UBOUND(SrcMiscData%u_UA,2) - DO i1 = LBOUND(SrcMiscData%u_UA,1), UBOUND(SrcMiscData%u_UA,1) - CALL UA_CopyInput( SrcMiscData%u_UA(i1,i2,i3), DstMiscData%u_UA(i1,i2,i3), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO - ENDDO -ENDIF - DO i1 = LBOUND(SrcMiscData%u_DBEMT,1), UBOUND(SrcMiscData%u_DBEMT,1) - CALL DBEMT_CopyInput( SrcMiscData%u_DBEMT(i1), DstMiscData%u_DBEMT(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcMiscData%u_SkewWake,1), UBOUND(SrcMiscData%u_SkewWake,1) - CALL BEMT_Copyskewwake_inputtype( SrcMiscData%u_SkewWake(i1), DstMiscData%u_SkewWake(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -IF (ALLOCATED(SrcMiscData%TnInd_op)) THEN - i1_l = LBOUND(SrcMiscData%TnInd_op,1) - i1_u = UBOUND(SrcMiscData%TnInd_op,1) - i2_l = LBOUND(SrcMiscData%TnInd_op,2) - i2_u = UBOUND(SrcMiscData%TnInd_op,2) - IF (.NOT. ALLOCATED(DstMiscData%TnInd_op)) THEN - ALLOCATE(DstMiscData%TnInd_op(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TnInd_op.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%TnInd_op = SrcMiscData%TnInd_op -ENDIF -IF (ALLOCATED(SrcMiscData%AxInd_op)) THEN - i1_l = LBOUND(SrcMiscData%AxInd_op,1) - i1_u = UBOUND(SrcMiscData%AxInd_op,1) - i2_l = LBOUND(SrcMiscData%AxInd_op,2) - i2_u = UBOUND(SrcMiscData%AxInd_op,2) - IF (.NOT. ALLOCATED(DstMiscData%AxInd_op)) THEN - ALLOCATE(DstMiscData%AxInd_op(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AxInd_op.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%AxInd_op = SrcMiscData%AxInd_op -ENDIF -IF (ALLOCATED(SrcMiscData%AxInduction)) THEN - i1_l = LBOUND(SrcMiscData%AxInduction,1) - i1_u = UBOUND(SrcMiscData%AxInduction,1) - i2_l = LBOUND(SrcMiscData%AxInduction,2) - i2_u = UBOUND(SrcMiscData%AxInduction,2) - IF (.NOT. ALLOCATED(DstMiscData%AxInduction)) THEN - ALLOCATE(DstMiscData%AxInduction(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AxInduction.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%AxInduction = SrcMiscData%AxInduction -ENDIF -IF (ALLOCATED(SrcMiscData%TanInduction)) THEN - i1_l = LBOUND(SrcMiscData%TanInduction,1) - i1_u = UBOUND(SrcMiscData%TanInduction,1) - i2_l = LBOUND(SrcMiscData%TanInduction,2) - i2_u = UBOUND(SrcMiscData%TanInduction,2) - IF (.NOT. ALLOCATED(DstMiscData%TanInduction)) THEN - ALLOCATE(DstMiscData%TanInduction(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TanInduction.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%TanInduction = SrcMiscData%TanInduction -ENDIF - DstMiscData%UseFrozenWake = SrcMiscData%UseFrozenWake -IF (ALLOCATED(SrcMiscData%Rtip)) THEN - i1_l = LBOUND(SrcMiscData%Rtip,1) - i1_u = UBOUND(SrcMiscData%Rtip,1) - IF (.NOT. ALLOCATED(DstMiscData%Rtip)) THEN - ALLOCATE(DstMiscData%Rtip(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Rtip.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Rtip = SrcMiscData%Rtip -ENDIF -IF (ALLOCATED(SrcMiscData%phi)) THEN - i1_l = LBOUND(SrcMiscData%phi,1) - i1_u = UBOUND(SrcMiscData%phi,1) - i2_l = LBOUND(SrcMiscData%phi,2) - i2_u = UBOUND(SrcMiscData%phi,2) - IF (.NOT. ALLOCATED(DstMiscData%phi)) THEN - ALLOCATE(DstMiscData%phi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%phi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%phi = SrcMiscData%phi -ENDIF -IF (ALLOCATED(SrcMiscData%chi)) THEN - i1_l = LBOUND(SrcMiscData%chi,1) - i1_u = UBOUND(SrcMiscData%chi,1) - i2_l = LBOUND(SrcMiscData%chi,2) - i2_u = UBOUND(SrcMiscData%chi,2) - IF (.NOT. ALLOCATED(DstMiscData%chi)) THEN - ALLOCATE(DstMiscData%chi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%chi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%chi = SrcMiscData%chi -ENDIF -IF (ALLOCATED(SrcMiscData%ValidPhi)) THEN - i1_l = LBOUND(SrcMiscData%ValidPhi,1) - i1_u = UBOUND(SrcMiscData%ValidPhi,1) - i2_l = LBOUND(SrcMiscData%ValidPhi,2) - i2_u = UBOUND(SrcMiscData%ValidPhi,2) - IF (.NOT. ALLOCATED(DstMiscData%ValidPhi)) THEN - ALLOCATE(DstMiscData%ValidPhi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ValidPhi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%ValidPhi = SrcMiscData%ValidPhi -ENDIF - DstMiscData%BEM_weight = SrcMiscData%BEM_weight - END SUBROUTINE BEMT_CopyMisc - - SUBROUTINE BEMT_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(BEMT_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_DestroyMisc' - ErrStat = ErrID_None - ErrMsg = "" - - CALL UA_DestroyMisc( MiscData%UA, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DBEMT_DestroyMisc( MiscData%DBEMT, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL UA_DestroyOutput( MiscData%y_UA, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MiscData%u_UA)) THEN -DO i3 = LBOUND(MiscData%u_UA,3), UBOUND(MiscData%u_UA,3) -DO i2 = LBOUND(MiscData%u_UA,2), UBOUND(MiscData%u_UA,2) -DO i1 = LBOUND(MiscData%u_UA,1), UBOUND(MiscData%u_UA,1) - CALL UA_DestroyInput( MiscData%u_UA(i1,i2,i3), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO -ENDDO - DEALLOCATE(MiscData%u_UA) -ENDIF -DO i1 = LBOUND(MiscData%u_DBEMT,1), UBOUND(MiscData%u_DBEMT,1) - CALL DBEMT_DestroyInput( MiscData%u_DBEMT(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(MiscData%u_SkewWake,1), UBOUND(MiscData%u_SkewWake,1) - CALL BEMT_DestroySkewWake_InputType( MiscData%u_SkewWake(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -IF (ALLOCATED(MiscData%TnInd_op)) THEN - DEALLOCATE(MiscData%TnInd_op) -ENDIF -IF (ALLOCATED(MiscData%AxInd_op)) THEN - DEALLOCATE(MiscData%AxInd_op) -ENDIF -IF (ALLOCATED(MiscData%AxInduction)) THEN - DEALLOCATE(MiscData%AxInduction) -ENDIF -IF (ALLOCATED(MiscData%TanInduction)) THEN - DEALLOCATE(MiscData%TanInduction) -ENDIF -IF (ALLOCATED(MiscData%Rtip)) THEN - DEALLOCATE(MiscData%Rtip) -ENDIF -IF (ALLOCATED(MiscData%phi)) THEN - DEALLOCATE(MiscData%phi) -ENDIF -IF (ALLOCATED(MiscData%chi)) THEN - DEALLOCATE(MiscData%chi) -ENDIF -IF (ALLOCATED(MiscData%ValidPhi)) THEN - DEALLOCATE(MiscData%ValidPhi) -ENDIF - END SUBROUTINE BEMT_DestroyMisc +subroutine BEMT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(BEMT_MiscVarType), intent(in) :: SrcMiscData + type(BEMT_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BEMT_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%FirstWarn_Skew = SrcMiscData%FirstWarn_Skew + DstMiscData%FirstWarn_Phi = SrcMiscData%FirstWarn_Phi + DstMiscData%FirstWarn_BEMoff = SrcMiscData%FirstWarn_BEMoff + call UA_CopyMisc(SrcMiscData%UA, DstMiscData%UA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call DBEMT_CopyMisc(SrcMiscData%DBEMT, DstMiscData%DBEMT, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call UA_CopyOutput(SrcMiscData%y_UA, DstMiscData%y_UA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMiscData%u_UA)) then + LB(1:3) = lbound(SrcMiscData%u_UA) + UB(1:3) = ubound(SrcMiscData%u_UA) + if (.not. allocated(DstMiscData%u_UA)) then + allocate(DstMiscData%u_UA(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_UA.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i3 = LB(3), UB(3) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call UA_CopyInput(SrcMiscData%u_UA(i1,i2,i3), DstMiscData%u_UA(i1,i2,i3), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end do + else if (allocated(DstMiscData%u_UA)) then + deallocate(DstMiscData%u_UA) + end if + do i1 = LB(1), UB(1) + call DBEMT_CopyInput(SrcMiscData%u_DBEMT(i1), DstMiscData%u_DBEMT(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + do i1 = LB(1), UB(1) + call BEMT_CopySkewWake_InputType(SrcMiscData%u_SkewWake(i1), DstMiscData%u_SkewWake(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + if (allocated(SrcMiscData%TnInd_op)) then + LB(1:2) = lbound(SrcMiscData%TnInd_op) + UB(1:2) = ubound(SrcMiscData%TnInd_op) + if (.not. allocated(DstMiscData%TnInd_op)) then + allocate(DstMiscData%TnInd_op(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TnInd_op.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%TnInd_op = SrcMiscData%TnInd_op + else if (allocated(DstMiscData%TnInd_op)) then + deallocate(DstMiscData%TnInd_op) + end if + if (allocated(SrcMiscData%AxInd_op)) then + LB(1:2) = lbound(SrcMiscData%AxInd_op) + UB(1:2) = ubound(SrcMiscData%AxInd_op) + if (.not. allocated(DstMiscData%AxInd_op)) then + allocate(DstMiscData%AxInd_op(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AxInd_op.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%AxInd_op = SrcMiscData%AxInd_op + else if (allocated(DstMiscData%AxInd_op)) then + deallocate(DstMiscData%AxInd_op) + end if + if (allocated(SrcMiscData%AxInduction)) then + LB(1:2) = lbound(SrcMiscData%AxInduction) + UB(1:2) = ubound(SrcMiscData%AxInduction) + if (.not. allocated(DstMiscData%AxInduction)) then + allocate(DstMiscData%AxInduction(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AxInduction.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%AxInduction = SrcMiscData%AxInduction + else if (allocated(DstMiscData%AxInduction)) then + deallocate(DstMiscData%AxInduction) + end if + if (allocated(SrcMiscData%TanInduction)) then + LB(1:2) = lbound(SrcMiscData%TanInduction) + UB(1:2) = ubound(SrcMiscData%TanInduction) + if (.not. allocated(DstMiscData%TanInduction)) then + allocate(DstMiscData%TanInduction(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TanInduction.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%TanInduction = SrcMiscData%TanInduction + else if (allocated(DstMiscData%TanInduction)) then + deallocate(DstMiscData%TanInduction) + end if + DstMiscData%UseFrozenWake = SrcMiscData%UseFrozenWake + if (allocated(SrcMiscData%Rtip)) then + LB(1:1) = lbound(SrcMiscData%Rtip) + UB(1:1) = ubound(SrcMiscData%Rtip) + if (.not. allocated(DstMiscData%Rtip)) then + allocate(DstMiscData%Rtip(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Rtip.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Rtip = SrcMiscData%Rtip + else if (allocated(DstMiscData%Rtip)) then + deallocate(DstMiscData%Rtip) + end if + if (allocated(SrcMiscData%phi)) then + LB(1:2) = lbound(SrcMiscData%phi) + UB(1:2) = ubound(SrcMiscData%phi) + if (.not. allocated(DstMiscData%phi)) then + allocate(DstMiscData%phi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%phi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%phi = SrcMiscData%phi + else if (allocated(DstMiscData%phi)) then + deallocate(DstMiscData%phi) + end if + if (allocated(SrcMiscData%chi)) then + LB(1:2) = lbound(SrcMiscData%chi) + UB(1:2) = ubound(SrcMiscData%chi) + if (.not. allocated(DstMiscData%chi)) then + allocate(DstMiscData%chi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%chi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%chi = SrcMiscData%chi + else if (allocated(DstMiscData%chi)) then + deallocate(DstMiscData%chi) + end if + if (allocated(SrcMiscData%ValidPhi)) then + LB(1:2) = lbound(SrcMiscData%ValidPhi) + UB(1:2) = ubound(SrcMiscData%ValidPhi) + if (.not. allocated(DstMiscData%ValidPhi)) then + allocate(DstMiscData%ValidPhi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ValidPhi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%ValidPhi = SrcMiscData%ValidPhi + else if (allocated(DstMiscData%ValidPhi)) then + deallocate(DstMiscData%ValidPhi) + end if + DstMiscData%BEM_weight = SrcMiscData%BEM_weight +end subroutine +subroutine BEMT_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(BEMT_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BEMT_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%u_UA)) then + LB(1:3) = lbound(MiscData%u_UA) + UB(1:3) = ubound(MiscData%u_UA) + do i3 = LB(3), UB(3) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call UA_DestroyInput(MiscData%u_UA(i1,i2,i3), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + end do + deallocate(MiscData%u_UA) + end if + if (allocated(MiscData%TnInd_op)) then + deallocate(MiscData%TnInd_op) + end if + if (allocated(MiscData%AxInd_op)) then + deallocate(MiscData%AxInd_op) + end if + if (allocated(MiscData%AxInduction)) then + deallocate(MiscData%AxInduction) + end if + if (allocated(MiscData%TanInduction)) then + deallocate(MiscData%TanInduction) + end if + if (allocated(MiscData%Rtip)) then + deallocate(MiscData%Rtip) + end if + if (allocated(MiscData%phi)) then + deallocate(MiscData%phi) + end if + if (allocated(MiscData%chi)) then + deallocate(MiscData%chi) + end if + if (allocated(MiscData%ValidPhi)) then + deallocate(MiscData%ValidPhi) + end if +end subroutine subroutine BEMT_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -1525,25 +1342,18 @@ subroutine BEMT_PackMisc(Buf, Indata) integer(IntKi) :: i1, i2, i3 integer(IntKi) :: LB(3), UB(3) if (Buf%ErrStat >= AbortErrLev) return - ! FirstWarn_Skew call RegPack(Buf, InData%FirstWarn_Skew) if (RegCheckErr(Buf, RoutineName)) return - ! FirstWarn_Phi call RegPack(Buf, InData%FirstWarn_Phi) if (RegCheckErr(Buf, RoutineName)) return - ! FirstWarn_BEMoff call RegPack(Buf, InData%FirstWarn_BEMoff) if (RegCheckErr(Buf, RoutineName)) return - ! UA call UA_PackMisc(Buf, InData%UA) if (RegCheckErr(Buf, RoutineName)) return - ! DBEMT call DBEMT_PackMisc(Buf, InData%DBEMT) if (RegCheckErr(Buf, RoutineName)) return - ! y_UA call UA_PackOutput(Buf, InData%y_UA) if (RegCheckErr(Buf, RoutineName)) return - ! u_UA call RegPack(Buf, allocated(InData%u_UA)) if (allocated(InData%u_UA)) then call RegPackBounds(Buf, 3, lbound(InData%u_UA), ubound(InData%u_UA)) @@ -1558,80 +1368,68 @@ subroutine BEMT_PackMisc(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! u_DBEMT LB(1:1) = lbound(InData%u_DBEMT) UB(1:1) = ubound(InData%u_DBEMT) do i1 = LB(1), UB(1) call DBEMT_PackInput(Buf, InData%u_DBEMT(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! u_SkewWake LB(1:1) = lbound(InData%u_SkewWake) UB(1:1) = ubound(InData%u_SkewWake) do i1 = LB(1), UB(1) call BEMT_PackSkewWake_InputType(Buf, InData%u_SkewWake(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! TnInd_op call RegPack(Buf, allocated(InData%TnInd_op)) if (allocated(InData%TnInd_op)) then call RegPackBounds(Buf, 2, lbound(InData%TnInd_op), ubound(InData%TnInd_op)) call RegPack(Buf, InData%TnInd_op) end if if (RegCheckErr(Buf, RoutineName)) return - ! AxInd_op call RegPack(Buf, allocated(InData%AxInd_op)) if (allocated(InData%AxInd_op)) then call RegPackBounds(Buf, 2, lbound(InData%AxInd_op), ubound(InData%AxInd_op)) call RegPack(Buf, InData%AxInd_op) end if if (RegCheckErr(Buf, RoutineName)) return - ! AxInduction call RegPack(Buf, allocated(InData%AxInduction)) if (allocated(InData%AxInduction)) then call RegPackBounds(Buf, 2, lbound(InData%AxInduction), ubound(InData%AxInduction)) call RegPack(Buf, InData%AxInduction) end if if (RegCheckErr(Buf, RoutineName)) return - ! TanInduction call RegPack(Buf, allocated(InData%TanInduction)) if (allocated(InData%TanInduction)) then call RegPackBounds(Buf, 2, lbound(InData%TanInduction), ubound(InData%TanInduction)) call RegPack(Buf, InData%TanInduction) end if if (RegCheckErr(Buf, RoutineName)) return - ! UseFrozenWake call RegPack(Buf, InData%UseFrozenWake) if (RegCheckErr(Buf, RoutineName)) return - ! Rtip call RegPack(Buf, allocated(InData%Rtip)) if (allocated(InData%Rtip)) then call RegPackBounds(Buf, 1, lbound(InData%Rtip), ubound(InData%Rtip)) call RegPack(Buf, InData%Rtip) end if if (RegCheckErr(Buf, RoutineName)) return - ! phi call RegPack(Buf, allocated(InData%phi)) if (allocated(InData%phi)) then call RegPackBounds(Buf, 2, lbound(InData%phi), ubound(InData%phi)) call RegPack(Buf, InData%phi) end if if (RegCheckErr(Buf, RoutineName)) return - ! chi call RegPack(Buf, allocated(InData%chi)) if (allocated(InData%chi)) then call RegPackBounds(Buf, 2, lbound(InData%chi), ubound(InData%chi)) call RegPack(Buf, InData%chi) end if if (RegCheckErr(Buf, RoutineName)) return - ! ValidPhi call RegPack(Buf, allocated(InData%ValidPhi)) if (allocated(InData%ValidPhi)) then call RegPackBounds(Buf, 2, lbound(InData%ValidPhi), ubound(InData%ValidPhi)) call RegPack(Buf, InData%ValidPhi) end if if (RegCheckErr(Buf, RoutineName)) return - ! BEM_weight call RegPack(Buf, InData%BEM_weight) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1645,22 +1443,15 @@ subroutine BEMT_UnPackMisc(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! FirstWarn_Skew call RegUnpack(Buf, OutData%FirstWarn_Skew) if (RegCheckErr(Buf, RoutineName)) return - ! FirstWarn_Phi call RegUnpack(Buf, OutData%FirstWarn_Phi) if (RegCheckErr(Buf, RoutineName)) return - ! FirstWarn_BEMoff call RegUnpack(Buf, OutData%FirstWarn_BEMoff) if (RegCheckErr(Buf, RoutineName)) return - ! UA call UA_UnpackMisc(Buf, OutData%UA) ! UA - ! DBEMT call DBEMT_UnpackMisc(Buf, OutData%DBEMT) ! DBEMT - ! y_UA call UA_UnpackOutput(Buf, OutData%y_UA) ! y_UA - ! u_UA if (allocated(OutData%u_UA)) deallocate(OutData%u_UA) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1680,19 +1471,16 @@ subroutine BEMT_UnPackMisc(Buf, OutData) end do end do end if - ! u_DBEMT LB(1:1) = lbound(OutData%u_DBEMT) UB(1:1) = ubound(OutData%u_DBEMT) do i1 = LB(1), UB(1) call DBEMT_UnpackInput(Buf, OutData%u_DBEMT(i1)) ! u_DBEMT end do - ! u_SkewWake LB(1:1) = lbound(OutData%u_SkewWake) UB(1:1) = ubound(OutData%u_SkewWake) do i1 = LB(1), UB(1) call BEMT_UnpackSkewWake_InputType(Buf, OutData%u_SkewWake(i1)) ! u_SkewWake end do - ! TnInd_op if (allocated(OutData%TnInd_op)) deallocate(OutData%TnInd_op) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1707,7 +1495,6 @@ subroutine BEMT_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%TnInd_op) if (RegCheckErr(Buf, RoutineName)) return end if - ! AxInd_op if (allocated(OutData%AxInd_op)) deallocate(OutData%AxInd_op) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1722,7 +1509,6 @@ subroutine BEMT_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%AxInd_op) if (RegCheckErr(Buf, RoutineName)) return end if - ! AxInduction if (allocated(OutData%AxInduction)) deallocate(OutData%AxInduction) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1737,7 +1523,6 @@ subroutine BEMT_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%AxInduction) if (RegCheckErr(Buf, RoutineName)) return end if - ! TanInduction if (allocated(OutData%TanInduction)) deallocate(OutData%TanInduction) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1752,10 +1537,8 @@ subroutine BEMT_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%TanInduction) if (RegCheckErr(Buf, RoutineName)) return end if - ! UseFrozenWake call RegUnpack(Buf, OutData%UseFrozenWake) if (RegCheckErr(Buf, RoutineName)) return - ! Rtip if (allocated(OutData%Rtip)) deallocate(OutData%Rtip) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1770,7 +1553,6 @@ subroutine BEMT_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%Rtip) if (RegCheckErr(Buf, RoutineName)) return end if - ! phi if (allocated(OutData%phi)) deallocate(OutData%phi) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1785,7 +1567,6 @@ subroutine BEMT_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%phi) if (RegCheckErr(Buf, RoutineName)) return end if - ! chi if (allocated(OutData%chi)) deallocate(OutData%chi) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1800,7 +1581,6 @@ subroutine BEMT_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%chi) if (RegCheckErr(Buf, RoutineName)) return end if - ! ValidPhi if (allocated(OutData%ValidPhi)) deallocate(OutData%ValidPhi) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1815,317 +1595,275 @@ subroutine BEMT_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%ValidPhi) if (RegCheckErr(Buf, RoutineName)) return end if - ! BEM_weight call RegUnpack(Buf, OutData%BEM_weight) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE BEMT_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BEMT_ParameterType), INTENT(IN) :: SrcParamData - TYPE(BEMT_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT -IF (ALLOCATED(SrcParamData%chord)) THEN - i1_l = LBOUND(SrcParamData%chord,1) - i1_u = UBOUND(SrcParamData%chord,1) - i2_l = LBOUND(SrcParamData%chord,2) - i2_u = UBOUND(SrcParamData%chord,2) - IF (.NOT. ALLOCATED(DstParamData%chord)) THEN - ALLOCATE(DstParamData%chord(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%chord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%chord = SrcParamData%chord -ENDIF - DstParamData%numBlades = SrcParamData%numBlades - DstParamData%airDens = SrcParamData%airDens - DstParamData%kinVisc = SrcParamData%kinVisc - DstParamData%skewWakeMod = SrcParamData%skewWakeMod - DstParamData%aTol = SrcParamData%aTol - DstParamData%useTipLoss = SrcParamData%useTipLoss - DstParamData%useHubLoss = SrcParamData%useHubLoss - DstParamData%useInduction = SrcParamData%useInduction - DstParamData%useTanInd = SrcParamData%useTanInd - DstParamData%useAIDrag = SrcParamData%useAIDrag - DstParamData%useTIDrag = SrcParamData%useTIDrag - DstParamData%numBladeNodes = SrcParamData%numBladeNodes - DstParamData%numReIterations = SrcParamData%numReIterations - DstParamData%maxIndIterations = SrcParamData%maxIndIterations -IF (ALLOCATED(SrcParamData%AFindx)) THEN - i1_l = LBOUND(SrcParamData%AFindx,1) - i1_u = UBOUND(SrcParamData%AFindx,1) - i2_l = LBOUND(SrcParamData%AFindx,2) - i2_u = UBOUND(SrcParamData%AFindx,2) - IF (.NOT. ALLOCATED(DstParamData%AFindx)) THEN - ALLOCATE(DstParamData%AFindx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFindx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AFindx = SrcParamData%AFindx -ENDIF -IF (ALLOCATED(SrcParamData%tipLossConst)) THEN - i1_l = LBOUND(SrcParamData%tipLossConst,1) - i1_u = UBOUND(SrcParamData%tipLossConst,1) - i2_l = LBOUND(SrcParamData%tipLossConst,2) - i2_u = UBOUND(SrcParamData%tipLossConst,2) - IF (.NOT. ALLOCATED(DstParamData%tipLossConst)) THEN - ALLOCATE(DstParamData%tipLossConst(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%tipLossConst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%tipLossConst = SrcParamData%tipLossConst -ENDIF -IF (ALLOCATED(SrcParamData%hubLossConst)) THEN - i1_l = LBOUND(SrcParamData%hubLossConst,1) - i1_u = UBOUND(SrcParamData%hubLossConst,1) - i2_l = LBOUND(SrcParamData%hubLossConst,2) - i2_u = UBOUND(SrcParamData%hubLossConst,2) - IF (.NOT. ALLOCATED(DstParamData%hubLossConst)) THEN - ALLOCATE(DstParamData%hubLossConst(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%hubLossConst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%hubLossConst = SrcParamData%hubLossConst -ENDIF -IF (ALLOCATED(SrcParamData%zHub)) THEN - i1_l = LBOUND(SrcParamData%zHub,1) - i1_u = UBOUND(SrcParamData%zHub,1) - IF (.NOT. ALLOCATED(DstParamData%zHub)) THEN - ALLOCATE(DstParamData%zHub(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%zHub.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%zHub = SrcParamData%zHub -ENDIF - CALL UA_CopyParam( SrcParamData%UA, DstParamData%UA, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DBEMT_CopyParam( SrcParamData%DBEMT, DstParamData%DBEMT, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstParamData%UA_Flag = SrcParamData%UA_Flag - DstParamData%DBEMT_Mod = SrcParamData%DBEMT_Mod - DstParamData%yawCorrFactor = SrcParamData%yawCorrFactor -IF (ALLOCATED(SrcParamData%FixedInductions)) THEN - i1_l = LBOUND(SrcParamData%FixedInductions,1) - i1_u = UBOUND(SrcParamData%FixedInductions,1) - i2_l = LBOUND(SrcParamData%FixedInductions,2) - i2_u = UBOUND(SrcParamData%FixedInductions,2) - IF (.NOT. ALLOCATED(DstParamData%FixedInductions)) THEN - ALLOCATE(DstParamData%FixedInductions(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FixedInductions.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FixedInductions = SrcParamData%FixedInductions -ENDIF - DstParamData%MomentumCorr = SrcParamData%MomentumCorr - DstParamData%rTipFixMax = SrcParamData%rTipFixMax -IF (ALLOCATED(SrcParamData%IntegrateWeight)) THEN - i1_l = LBOUND(SrcParamData%IntegrateWeight,1) - i1_u = UBOUND(SrcParamData%IntegrateWeight,1) - i2_l = LBOUND(SrcParamData%IntegrateWeight,2) - i2_u = UBOUND(SrcParamData%IntegrateWeight,2) - IF (.NOT. ALLOCATED(DstParamData%IntegrateWeight)) THEN - ALLOCATE(DstParamData%IntegrateWeight(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IntegrateWeight.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%IntegrateWeight = SrcParamData%IntegrateWeight -ENDIF - DstParamData%lin_nx = SrcParamData%lin_nx - DstParamData%BEM_Mod = SrcParamData%BEM_Mod - END SUBROUTINE BEMT_CopyParam - - SUBROUTINE BEMT_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(BEMT_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_DestroyParam' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%chord)) THEN - DEALLOCATE(ParamData%chord) -ENDIF -IF (ALLOCATED(ParamData%AFindx)) THEN - DEALLOCATE(ParamData%AFindx) -ENDIF -IF (ALLOCATED(ParamData%tipLossConst)) THEN - DEALLOCATE(ParamData%tipLossConst) -ENDIF -IF (ALLOCATED(ParamData%hubLossConst)) THEN - DEALLOCATE(ParamData%hubLossConst) -ENDIF -IF (ALLOCATED(ParamData%zHub)) THEN - DEALLOCATE(ParamData%zHub) -ENDIF - CALL UA_DestroyParam( ParamData%UA, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DBEMT_DestroyParam( ParamData%DBEMT, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ParamData%FixedInductions)) THEN - DEALLOCATE(ParamData%FixedInductions) -ENDIF -IF (ALLOCATED(ParamData%IntegrateWeight)) THEN - DEALLOCATE(ParamData%IntegrateWeight) -ENDIF - END SUBROUTINE BEMT_DestroyParam +subroutine BEMT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(BEMT_ParameterType), intent(in) :: SrcParamData + type(BEMT_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BEMT_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%DT = SrcParamData%DT + if (allocated(SrcParamData%chord)) then + LB(1:2) = lbound(SrcParamData%chord) + UB(1:2) = ubound(SrcParamData%chord) + if (.not. allocated(DstParamData%chord)) then + allocate(DstParamData%chord(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%chord.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%chord = SrcParamData%chord + else if (allocated(DstParamData%chord)) then + deallocate(DstParamData%chord) + end if + DstParamData%numBlades = SrcParamData%numBlades + DstParamData%airDens = SrcParamData%airDens + DstParamData%kinVisc = SrcParamData%kinVisc + DstParamData%skewWakeMod = SrcParamData%skewWakeMod + DstParamData%aTol = SrcParamData%aTol + DstParamData%useTipLoss = SrcParamData%useTipLoss + DstParamData%useHubLoss = SrcParamData%useHubLoss + DstParamData%useInduction = SrcParamData%useInduction + DstParamData%useTanInd = SrcParamData%useTanInd + DstParamData%useAIDrag = SrcParamData%useAIDrag + DstParamData%useTIDrag = SrcParamData%useTIDrag + DstParamData%numBladeNodes = SrcParamData%numBladeNodes + DstParamData%numReIterations = SrcParamData%numReIterations + DstParamData%maxIndIterations = SrcParamData%maxIndIterations + if (allocated(SrcParamData%AFindx)) then + LB(1:2) = lbound(SrcParamData%AFindx) + UB(1:2) = ubound(SrcParamData%AFindx) + if (.not. allocated(DstParamData%AFindx)) then + allocate(DstParamData%AFindx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFindx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AFindx = SrcParamData%AFindx + else if (allocated(DstParamData%AFindx)) then + deallocate(DstParamData%AFindx) + end if + if (allocated(SrcParamData%tipLossConst)) then + LB(1:2) = lbound(SrcParamData%tipLossConst) + UB(1:2) = ubound(SrcParamData%tipLossConst) + if (.not. allocated(DstParamData%tipLossConst)) then + allocate(DstParamData%tipLossConst(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%tipLossConst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%tipLossConst = SrcParamData%tipLossConst + else if (allocated(DstParamData%tipLossConst)) then + deallocate(DstParamData%tipLossConst) + end if + if (allocated(SrcParamData%hubLossConst)) then + LB(1:2) = lbound(SrcParamData%hubLossConst) + UB(1:2) = ubound(SrcParamData%hubLossConst) + if (.not. allocated(DstParamData%hubLossConst)) then + allocate(DstParamData%hubLossConst(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%hubLossConst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%hubLossConst = SrcParamData%hubLossConst + else if (allocated(DstParamData%hubLossConst)) then + deallocate(DstParamData%hubLossConst) + end if + if (allocated(SrcParamData%zHub)) then + LB(1:1) = lbound(SrcParamData%zHub) + UB(1:1) = ubound(SrcParamData%zHub) + if (.not. allocated(DstParamData%zHub)) then + allocate(DstParamData%zHub(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%zHub.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%zHub = SrcParamData%zHub + else if (allocated(DstParamData%zHub)) then + deallocate(DstParamData%zHub) + end if + call UA_CopyParam(SrcParamData%UA, DstParamData%UA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call DBEMT_CopyParam(SrcParamData%DBEMT, DstParamData%DBEMT, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstParamData%UA_Flag = SrcParamData%UA_Flag + DstParamData%DBEMT_Mod = SrcParamData%DBEMT_Mod + DstParamData%yawCorrFactor = SrcParamData%yawCorrFactor + if (allocated(SrcParamData%FixedInductions)) then + LB(1:2) = lbound(SrcParamData%FixedInductions) + UB(1:2) = ubound(SrcParamData%FixedInductions) + if (.not. allocated(DstParamData%FixedInductions)) then + allocate(DstParamData%FixedInductions(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FixedInductions.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%FixedInductions = SrcParamData%FixedInductions + else if (allocated(DstParamData%FixedInductions)) then + deallocate(DstParamData%FixedInductions) + end if + DstParamData%MomentumCorr = SrcParamData%MomentumCorr + DstParamData%rTipFixMax = SrcParamData%rTipFixMax + if (allocated(SrcParamData%IntegrateWeight)) then + LB(1:2) = lbound(SrcParamData%IntegrateWeight) + UB(1:2) = ubound(SrcParamData%IntegrateWeight) + if (.not. allocated(DstParamData%IntegrateWeight)) then + allocate(DstParamData%IntegrateWeight(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IntegrateWeight.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%IntegrateWeight = SrcParamData%IntegrateWeight + else if (allocated(DstParamData%IntegrateWeight)) then + deallocate(DstParamData%IntegrateWeight) + end if + DstParamData%lin_nx = SrcParamData%lin_nx + DstParamData%BEM_Mod = SrcParamData%BEM_Mod +end subroutine +subroutine BEMT_DestroyParam(ParamData, ErrStat, ErrMsg) + type(BEMT_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BEMT_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%chord)) then + deallocate(ParamData%chord) + end if + if (allocated(ParamData%AFindx)) then + deallocate(ParamData%AFindx) + end if + if (allocated(ParamData%tipLossConst)) then + deallocate(ParamData%tipLossConst) + end if + if (allocated(ParamData%hubLossConst)) then + deallocate(ParamData%hubLossConst) + end if + if (allocated(ParamData%zHub)) then + deallocate(ParamData%zHub) + end if + if (allocated(ParamData%FixedInductions)) then + deallocate(ParamData%FixedInductions) + end if + if (allocated(ParamData%IntegrateWeight)) then + deallocate(ParamData%IntegrateWeight) + end if +end subroutine subroutine BEMT_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(BEMT_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'BEMT_PackParam' if (Buf%ErrStat >= AbortErrLev) return - ! DT call RegPack(Buf, InData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! chord call RegPack(Buf, allocated(InData%chord)) if (allocated(InData%chord)) then call RegPackBounds(Buf, 2, lbound(InData%chord), ubound(InData%chord)) call RegPack(Buf, InData%chord) end if if (RegCheckErr(Buf, RoutineName)) return - ! numBlades call RegPack(Buf, InData%numBlades) if (RegCheckErr(Buf, RoutineName)) return - ! airDens call RegPack(Buf, InData%airDens) if (RegCheckErr(Buf, RoutineName)) return - ! kinVisc call RegPack(Buf, InData%kinVisc) if (RegCheckErr(Buf, RoutineName)) return - ! skewWakeMod call RegPack(Buf, InData%skewWakeMod) if (RegCheckErr(Buf, RoutineName)) return - ! aTol call RegPack(Buf, InData%aTol) if (RegCheckErr(Buf, RoutineName)) return - ! useTipLoss call RegPack(Buf, InData%useTipLoss) if (RegCheckErr(Buf, RoutineName)) return - ! useHubLoss call RegPack(Buf, InData%useHubLoss) if (RegCheckErr(Buf, RoutineName)) return - ! useInduction call RegPack(Buf, InData%useInduction) if (RegCheckErr(Buf, RoutineName)) return - ! useTanInd call RegPack(Buf, InData%useTanInd) if (RegCheckErr(Buf, RoutineName)) return - ! useAIDrag call RegPack(Buf, InData%useAIDrag) if (RegCheckErr(Buf, RoutineName)) return - ! useTIDrag call RegPack(Buf, InData%useTIDrag) if (RegCheckErr(Buf, RoutineName)) return - ! numBladeNodes call RegPack(Buf, InData%numBladeNodes) if (RegCheckErr(Buf, RoutineName)) return - ! numReIterations call RegPack(Buf, InData%numReIterations) if (RegCheckErr(Buf, RoutineName)) return - ! maxIndIterations call RegPack(Buf, InData%maxIndIterations) if (RegCheckErr(Buf, RoutineName)) return - ! AFindx call RegPack(Buf, allocated(InData%AFindx)) if (allocated(InData%AFindx)) then call RegPackBounds(Buf, 2, lbound(InData%AFindx), ubound(InData%AFindx)) call RegPack(Buf, InData%AFindx) end if if (RegCheckErr(Buf, RoutineName)) return - ! tipLossConst call RegPack(Buf, allocated(InData%tipLossConst)) if (allocated(InData%tipLossConst)) then call RegPackBounds(Buf, 2, lbound(InData%tipLossConst), ubound(InData%tipLossConst)) call RegPack(Buf, InData%tipLossConst) end if if (RegCheckErr(Buf, RoutineName)) return - ! hubLossConst call RegPack(Buf, allocated(InData%hubLossConst)) if (allocated(InData%hubLossConst)) then call RegPackBounds(Buf, 2, lbound(InData%hubLossConst), ubound(InData%hubLossConst)) call RegPack(Buf, InData%hubLossConst) end if if (RegCheckErr(Buf, RoutineName)) return - ! zHub call RegPack(Buf, allocated(InData%zHub)) if (allocated(InData%zHub)) then call RegPackBounds(Buf, 1, lbound(InData%zHub), ubound(InData%zHub)) call RegPack(Buf, InData%zHub) end if if (RegCheckErr(Buf, RoutineName)) return - ! UA call UA_PackParam(Buf, InData%UA) if (RegCheckErr(Buf, RoutineName)) return - ! DBEMT call DBEMT_PackParam(Buf, InData%DBEMT) if (RegCheckErr(Buf, RoutineName)) return - ! UA_Flag call RegPack(Buf, InData%UA_Flag) if (RegCheckErr(Buf, RoutineName)) return - ! DBEMT_Mod call RegPack(Buf, InData%DBEMT_Mod) if (RegCheckErr(Buf, RoutineName)) return - ! yawCorrFactor call RegPack(Buf, InData%yawCorrFactor) if (RegCheckErr(Buf, RoutineName)) return - ! FixedInductions call RegPack(Buf, allocated(InData%FixedInductions)) if (allocated(InData%FixedInductions)) then call RegPackBounds(Buf, 2, lbound(InData%FixedInductions), ubound(InData%FixedInductions)) call RegPack(Buf, InData%FixedInductions) end if if (RegCheckErr(Buf, RoutineName)) return - ! MomentumCorr call RegPack(Buf, InData%MomentumCorr) if (RegCheckErr(Buf, RoutineName)) return - ! rTipFixMax call RegPack(Buf, InData%rTipFixMax) if (RegCheckErr(Buf, RoutineName)) return - ! IntegrateWeight call RegPack(Buf, allocated(InData%IntegrateWeight)) if (allocated(InData%IntegrateWeight)) then call RegPackBounds(Buf, 2, lbound(InData%IntegrateWeight), ubound(InData%IntegrateWeight)) call RegPack(Buf, InData%IntegrateWeight) end if if (RegCheckErr(Buf, RoutineName)) return - ! lin_nx call RegPack(Buf, InData%lin_nx) if (RegCheckErr(Buf, RoutineName)) return - ! BEM_Mod call RegPack(Buf, InData%BEM_Mod) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2138,10 +1876,8 @@ subroutine BEMT_UnPackParam(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! DT call RegUnpack(Buf, OutData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! chord if (allocated(OutData%chord)) deallocate(OutData%chord) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2156,49 +1892,34 @@ subroutine BEMT_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%chord) if (RegCheckErr(Buf, RoutineName)) return end if - ! numBlades call RegUnpack(Buf, OutData%numBlades) if (RegCheckErr(Buf, RoutineName)) return - ! airDens call RegUnpack(Buf, OutData%airDens) if (RegCheckErr(Buf, RoutineName)) return - ! kinVisc call RegUnpack(Buf, OutData%kinVisc) if (RegCheckErr(Buf, RoutineName)) return - ! skewWakeMod call RegUnpack(Buf, OutData%skewWakeMod) if (RegCheckErr(Buf, RoutineName)) return - ! aTol call RegUnpack(Buf, OutData%aTol) if (RegCheckErr(Buf, RoutineName)) return - ! useTipLoss call RegUnpack(Buf, OutData%useTipLoss) if (RegCheckErr(Buf, RoutineName)) return - ! useHubLoss call RegUnpack(Buf, OutData%useHubLoss) if (RegCheckErr(Buf, RoutineName)) return - ! useInduction call RegUnpack(Buf, OutData%useInduction) if (RegCheckErr(Buf, RoutineName)) return - ! useTanInd call RegUnpack(Buf, OutData%useTanInd) if (RegCheckErr(Buf, RoutineName)) return - ! useAIDrag call RegUnpack(Buf, OutData%useAIDrag) if (RegCheckErr(Buf, RoutineName)) return - ! useTIDrag call RegUnpack(Buf, OutData%useTIDrag) if (RegCheckErr(Buf, RoutineName)) return - ! numBladeNodes call RegUnpack(Buf, OutData%numBladeNodes) if (RegCheckErr(Buf, RoutineName)) return - ! numReIterations call RegUnpack(Buf, OutData%numReIterations) if (RegCheckErr(Buf, RoutineName)) return - ! maxIndIterations call RegUnpack(Buf, OutData%maxIndIterations) if (RegCheckErr(Buf, RoutineName)) return - ! AFindx if (allocated(OutData%AFindx)) deallocate(OutData%AFindx) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2213,7 +1934,6 @@ subroutine BEMT_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%AFindx) if (RegCheckErr(Buf, RoutineName)) return end if - ! tipLossConst if (allocated(OutData%tipLossConst)) deallocate(OutData%tipLossConst) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2228,7 +1948,6 @@ subroutine BEMT_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%tipLossConst) if (RegCheckErr(Buf, RoutineName)) return end if - ! hubLossConst if (allocated(OutData%hubLossConst)) deallocate(OutData%hubLossConst) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2243,7 +1962,6 @@ subroutine BEMT_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%hubLossConst) if (RegCheckErr(Buf, RoutineName)) return end if - ! zHub if (allocated(OutData%zHub)) deallocate(OutData%zHub) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2258,20 +1976,14 @@ subroutine BEMT_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%zHub) if (RegCheckErr(Buf, RoutineName)) return end if - ! UA call UA_UnpackParam(Buf, OutData%UA) ! UA - ! DBEMT call DBEMT_UnpackParam(Buf, OutData%DBEMT) ! DBEMT - ! UA_Flag call RegUnpack(Buf, OutData%UA_Flag) if (RegCheckErr(Buf, RoutineName)) return - ! DBEMT_Mod call RegUnpack(Buf, OutData%DBEMT_Mod) if (RegCheckErr(Buf, RoutineName)) return - ! yawCorrFactor call RegUnpack(Buf, OutData%yawCorrFactor) if (RegCheckErr(Buf, RoutineName)) return - ! FixedInductions if (allocated(OutData%FixedInductions)) deallocate(OutData%FixedInductions) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2286,13 +1998,10 @@ subroutine BEMT_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%FixedInductions) if (RegCheckErr(Buf, RoutineName)) return end if - ! MomentumCorr call RegUnpack(Buf, OutData%MomentumCorr) if (RegCheckErr(Buf, RoutineName)) return - ! rTipFixMax call RegUnpack(Buf, OutData%rTipFixMax) if (RegCheckErr(Buf, RoutineName)) return - ! IntegrateWeight if (allocated(OutData%IntegrateWeight)) deallocate(OutData%IntegrateWeight) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2307,360 +2016,330 @@ subroutine BEMT_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%IntegrateWeight) if (RegCheckErr(Buf, RoutineName)) return end if - ! lin_nx call RegUnpack(Buf, OutData%lin_nx) if (RegCheckErr(Buf, RoutineName)) return - ! BEM_Mod call RegUnpack(Buf, OutData%BEM_Mod) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE BEMT_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BEMT_InputType), INTENT(IN) :: SrcInputData - TYPE(BEMT_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_CopyInput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInputData%theta)) THEN - i1_l = LBOUND(SrcInputData%theta,1) - i1_u = UBOUND(SrcInputData%theta,1) - i2_l = LBOUND(SrcInputData%theta,2) - i2_u = UBOUND(SrcInputData%theta,2) - IF (.NOT. ALLOCATED(DstInputData%theta)) THEN - ALLOCATE(DstInputData%theta(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%theta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%theta = SrcInputData%theta -ENDIF - DstInputData%chi0 = SrcInputData%chi0 - DstInputData%psiSkewOffset = SrcInputData%psiSkewOffset -IF (ALLOCATED(SrcInputData%psi)) THEN - i1_l = LBOUND(SrcInputData%psi,1) - i1_u = UBOUND(SrcInputData%psi,1) - IF (.NOT. ALLOCATED(DstInputData%psi)) THEN - ALLOCATE(DstInputData%psi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%psi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%psi = SrcInputData%psi -ENDIF - DstInputData%omega = SrcInputData%omega - DstInputData%TSR = SrcInputData%TSR -IF (ALLOCATED(SrcInputData%Vx)) THEN - i1_l = LBOUND(SrcInputData%Vx,1) - i1_u = UBOUND(SrcInputData%Vx,1) - i2_l = LBOUND(SrcInputData%Vx,2) - i2_u = UBOUND(SrcInputData%Vx,2) - IF (.NOT. ALLOCATED(DstInputData%Vx)) THEN - ALLOCATE(DstInputData%Vx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Vx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%Vx = SrcInputData%Vx -ENDIF -IF (ALLOCATED(SrcInputData%Vy)) THEN - i1_l = LBOUND(SrcInputData%Vy,1) - i1_u = UBOUND(SrcInputData%Vy,1) - i2_l = LBOUND(SrcInputData%Vy,2) - i2_u = UBOUND(SrcInputData%Vy,2) - IF (.NOT. ALLOCATED(DstInputData%Vy)) THEN - ALLOCATE(DstInputData%Vy(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Vy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%Vy = SrcInputData%Vy -ENDIF -IF (ALLOCATED(SrcInputData%Vz)) THEN - i1_l = LBOUND(SrcInputData%Vz,1) - i1_u = UBOUND(SrcInputData%Vz,1) - i2_l = LBOUND(SrcInputData%Vz,2) - i2_u = UBOUND(SrcInputData%Vz,2) - IF (.NOT. ALLOCATED(DstInputData%Vz)) THEN - ALLOCATE(DstInputData%Vz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Vz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%Vz = SrcInputData%Vz -ENDIF -IF (ALLOCATED(SrcInputData%omega_z)) THEN - i1_l = LBOUND(SrcInputData%omega_z,1) - i1_u = UBOUND(SrcInputData%omega_z,1) - i2_l = LBOUND(SrcInputData%omega_z,2) - i2_u = UBOUND(SrcInputData%omega_z,2) - IF (.NOT. ALLOCATED(DstInputData%omega_z)) THEN - ALLOCATE(DstInputData%omega_z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%omega_z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%omega_z = SrcInputData%omega_z -ENDIF -IF (ALLOCATED(SrcInputData%xVelCorr)) THEN - i1_l = LBOUND(SrcInputData%xVelCorr,1) - i1_u = UBOUND(SrcInputData%xVelCorr,1) - i2_l = LBOUND(SrcInputData%xVelCorr,2) - i2_u = UBOUND(SrcInputData%xVelCorr,2) - IF (.NOT. ALLOCATED(DstInputData%xVelCorr)) THEN - ALLOCATE(DstInputData%xVelCorr(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%xVelCorr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%xVelCorr = SrcInputData%xVelCorr -ENDIF -IF (ALLOCATED(SrcInputData%rLocal)) THEN - i1_l = LBOUND(SrcInputData%rLocal,1) - i1_u = UBOUND(SrcInputData%rLocal,1) - i2_l = LBOUND(SrcInputData%rLocal,2) - i2_u = UBOUND(SrcInputData%rLocal,2) - IF (.NOT. ALLOCATED(DstInputData%rLocal)) THEN - ALLOCATE(DstInputData%rLocal(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%rLocal.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%rLocal = SrcInputData%rLocal -ENDIF - DstInputData%Un_disk = SrcInputData%Un_disk - DstInputData%V0 = SrcInputData%V0 - DstInputData%x_hat_disk = SrcInputData%x_hat_disk -IF (ALLOCATED(SrcInputData%UserProp)) THEN - i1_l = LBOUND(SrcInputData%UserProp,1) - i1_u = UBOUND(SrcInputData%UserProp,1) - i2_l = LBOUND(SrcInputData%UserProp,2) - i2_u = UBOUND(SrcInputData%UserProp,2) - IF (.NOT. ALLOCATED(DstInputData%UserProp)) THEN - ALLOCATE(DstInputData%UserProp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%UserProp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%UserProp = SrcInputData%UserProp -ENDIF -IF (ALLOCATED(SrcInputData%CantAngle)) THEN - i1_l = LBOUND(SrcInputData%CantAngle,1) - i1_u = UBOUND(SrcInputData%CantAngle,1) - i2_l = LBOUND(SrcInputData%CantAngle,2) - i2_u = UBOUND(SrcInputData%CantAngle,2) - IF (.NOT. ALLOCATED(DstInputData%CantAngle)) THEN - ALLOCATE(DstInputData%CantAngle(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CantAngle.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%CantAngle = SrcInputData%CantAngle -ENDIF -IF (ALLOCATED(SrcInputData%drdz)) THEN - i1_l = LBOUND(SrcInputData%drdz,1) - i1_u = UBOUND(SrcInputData%drdz,1) - i2_l = LBOUND(SrcInputData%drdz,2) - i2_u = UBOUND(SrcInputData%drdz,2) - IF (.NOT. ALLOCATED(DstInputData%drdz)) THEN - ALLOCATE(DstInputData%drdz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%drdz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%drdz = SrcInputData%drdz -ENDIF -IF (ALLOCATED(SrcInputData%toeAngle)) THEN - i1_l = LBOUND(SrcInputData%toeAngle,1) - i1_u = UBOUND(SrcInputData%toeAngle,1) - i2_l = LBOUND(SrcInputData%toeAngle,2) - i2_u = UBOUND(SrcInputData%toeAngle,2) - IF (.NOT. ALLOCATED(DstInputData%toeAngle)) THEN - ALLOCATE(DstInputData%toeAngle(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%toeAngle.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%toeAngle = SrcInputData%toeAngle -ENDIF - END SUBROUTINE BEMT_CopyInput - - SUBROUTINE BEMT_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(BEMT_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(InputData%theta)) THEN - DEALLOCATE(InputData%theta) -ENDIF -IF (ALLOCATED(InputData%psi)) THEN - DEALLOCATE(InputData%psi) -ENDIF -IF (ALLOCATED(InputData%Vx)) THEN - DEALLOCATE(InputData%Vx) -ENDIF -IF (ALLOCATED(InputData%Vy)) THEN - DEALLOCATE(InputData%Vy) -ENDIF -IF (ALLOCATED(InputData%Vz)) THEN - DEALLOCATE(InputData%Vz) -ENDIF -IF (ALLOCATED(InputData%omega_z)) THEN - DEALLOCATE(InputData%omega_z) -ENDIF -IF (ALLOCATED(InputData%xVelCorr)) THEN - DEALLOCATE(InputData%xVelCorr) -ENDIF -IF (ALLOCATED(InputData%rLocal)) THEN - DEALLOCATE(InputData%rLocal) -ENDIF -IF (ALLOCATED(InputData%UserProp)) THEN - DEALLOCATE(InputData%UserProp) -ENDIF -IF (ALLOCATED(InputData%CantAngle)) THEN - DEALLOCATE(InputData%CantAngle) -ENDIF -IF (ALLOCATED(InputData%drdz)) THEN - DEALLOCATE(InputData%drdz) -ENDIF -IF (ALLOCATED(InputData%toeAngle)) THEN - DEALLOCATE(InputData%toeAngle) -ENDIF - END SUBROUTINE BEMT_DestroyInput +subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(BEMT_InputType), intent(in) :: SrcInputData + type(BEMT_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'BEMT_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInputData%theta)) then + LB(1:2) = lbound(SrcInputData%theta) + UB(1:2) = ubound(SrcInputData%theta) + if (.not. allocated(DstInputData%theta)) then + allocate(DstInputData%theta(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%theta.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%theta = SrcInputData%theta + else if (allocated(DstInputData%theta)) then + deallocate(DstInputData%theta) + end if + DstInputData%chi0 = SrcInputData%chi0 + DstInputData%psiSkewOffset = SrcInputData%psiSkewOffset + if (allocated(SrcInputData%psi)) then + LB(1:1) = lbound(SrcInputData%psi) + UB(1:1) = ubound(SrcInputData%psi) + if (.not. allocated(DstInputData%psi)) then + allocate(DstInputData%psi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%psi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%psi = SrcInputData%psi + else if (allocated(DstInputData%psi)) then + deallocate(DstInputData%psi) + end if + DstInputData%omega = SrcInputData%omega + DstInputData%TSR = SrcInputData%TSR + if (allocated(SrcInputData%Vx)) then + LB(1:2) = lbound(SrcInputData%Vx) + UB(1:2) = ubound(SrcInputData%Vx) + if (.not. allocated(DstInputData%Vx)) then + allocate(DstInputData%Vx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Vx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%Vx = SrcInputData%Vx + else if (allocated(DstInputData%Vx)) then + deallocate(DstInputData%Vx) + end if + if (allocated(SrcInputData%Vy)) then + LB(1:2) = lbound(SrcInputData%Vy) + UB(1:2) = ubound(SrcInputData%Vy) + if (.not. allocated(DstInputData%Vy)) then + allocate(DstInputData%Vy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Vy.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%Vy = SrcInputData%Vy + else if (allocated(DstInputData%Vy)) then + deallocate(DstInputData%Vy) + end if + if (allocated(SrcInputData%Vz)) then + LB(1:2) = lbound(SrcInputData%Vz) + UB(1:2) = ubound(SrcInputData%Vz) + if (.not. allocated(DstInputData%Vz)) then + allocate(DstInputData%Vz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Vz.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%Vz = SrcInputData%Vz + else if (allocated(DstInputData%Vz)) then + deallocate(DstInputData%Vz) + end if + if (allocated(SrcInputData%omega_z)) then + LB(1:2) = lbound(SrcInputData%omega_z) + UB(1:2) = ubound(SrcInputData%omega_z) + if (.not. allocated(DstInputData%omega_z)) then + allocate(DstInputData%omega_z(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%omega_z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%omega_z = SrcInputData%omega_z + else if (allocated(DstInputData%omega_z)) then + deallocate(DstInputData%omega_z) + end if + if (allocated(SrcInputData%xVelCorr)) then + LB(1:2) = lbound(SrcInputData%xVelCorr) + UB(1:2) = ubound(SrcInputData%xVelCorr) + if (.not. allocated(DstInputData%xVelCorr)) then + allocate(DstInputData%xVelCorr(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%xVelCorr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%xVelCorr = SrcInputData%xVelCorr + else if (allocated(DstInputData%xVelCorr)) then + deallocate(DstInputData%xVelCorr) + end if + if (allocated(SrcInputData%rLocal)) then + LB(1:2) = lbound(SrcInputData%rLocal) + UB(1:2) = ubound(SrcInputData%rLocal) + if (.not. allocated(DstInputData%rLocal)) then + allocate(DstInputData%rLocal(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%rLocal.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%rLocal = SrcInputData%rLocal + else if (allocated(DstInputData%rLocal)) then + deallocate(DstInputData%rLocal) + end if + DstInputData%Un_disk = SrcInputData%Un_disk + DstInputData%V0 = SrcInputData%V0 + DstInputData%x_hat_disk = SrcInputData%x_hat_disk + if (allocated(SrcInputData%UserProp)) then + LB(1:2) = lbound(SrcInputData%UserProp) + UB(1:2) = ubound(SrcInputData%UserProp) + if (.not. allocated(DstInputData%UserProp)) then + allocate(DstInputData%UserProp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%UserProp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%UserProp = SrcInputData%UserProp + else if (allocated(DstInputData%UserProp)) then + deallocate(DstInputData%UserProp) + end if + if (allocated(SrcInputData%CantAngle)) then + LB(1:2) = lbound(SrcInputData%CantAngle) + UB(1:2) = ubound(SrcInputData%CantAngle) + if (.not. allocated(DstInputData%CantAngle)) then + allocate(DstInputData%CantAngle(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CantAngle.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%CantAngle = SrcInputData%CantAngle + else if (allocated(DstInputData%CantAngle)) then + deallocate(DstInputData%CantAngle) + end if + if (allocated(SrcInputData%drdz)) then + LB(1:2) = lbound(SrcInputData%drdz) + UB(1:2) = ubound(SrcInputData%drdz) + if (.not. allocated(DstInputData%drdz)) then + allocate(DstInputData%drdz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%drdz.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%drdz = SrcInputData%drdz + else if (allocated(DstInputData%drdz)) then + deallocate(DstInputData%drdz) + end if + if (allocated(SrcInputData%toeAngle)) then + LB(1:2) = lbound(SrcInputData%toeAngle) + UB(1:2) = ubound(SrcInputData%toeAngle) + if (.not. allocated(DstInputData%toeAngle)) then + allocate(DstInputData%toeAngle(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%toeAngle.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%toeAngle = SrcInputData%toeAngle + else if (allocated(DstInputData%toeAngle)) then + deallocate(DstInputData%toeAngle) + end if +end subroutine +subroutine BEMT_DestroyInput(InputData, ErrStat, ErrMsg) + type(BEMT_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BEMT_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%theta)) then + deallocate(InputData%theta) + end if + if (allocated(InputData%psi)) then + deallocate(InputData%psi) + end if + if (allocated(InputData%Vx)) then + deallocate(InputData%Vx) + end if + if (allocated(InputData%Vy)) then + deallocate(InputData%Vy) + end if + if (allocated(InputData%Vz)) then + deallocate(InputData%Vz) + end if + if (allocated(InputData%omega_z)) then + deallocate(InputData%omega_z) + end if + if (allocated(InputData%xVelCorr)) then + deallocate(InputData%xVelCorr) + end if + if (allocated(InputData%rLocal)) then + deallocate(InputData%rLocal) + end if + if (allocated(InputData%UserProp)) then + deallocate(InputData%UserProp) + end if + if (allocated(InputData%CantAngle)) then + deallocate(InputData%CantAngle) + end if + if (allocated(InputData%drdz)) then + deallocate(InputData%drdz) + end if + if (allocated(InputData%toeAngle)) then + deallocate(InputData%toeAngle) + end if +end subroutine subroutine BEMT_PackInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(BEMT_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'BEMT_PackInput' if (Buf%ErrStat >= AbortErrLev) return - ! theta call RegPack(Buf, allocated(InData%theta)) if (allocated(InData%theta)) then call RegPackBounds(Buf, 2, lbound(InData%theta), ubound(InData%theta)) call RegPack(Buf, InData%theta) end if if (RegCheckErr(Buf, RoutineName)) return - ! chi0 call RegPack(Buf, InData%chi0) if (RegCheckErr(Buf, RoutineName)) return - ! psiSkewOffset call RegPack(Buf, InData%psiSkewOffset) if (RegCheckErr(Buf, RoutineName)) return - ! psi call RegPack(Buf, allocated(InData%psi)) if (allocated(InData%psi)) then call RegPackBounds(Buf, 1, lbound(InData%psi), ubound(InData%psi)) call RegPack(Buf, InData%psi) end if if (RegCheckErr(Buf, RoutineName)) return - ! omega call RegPack(Buf, InData%omega) if (RegCheckErr(Buf, RoutineName)) return - ! TSR call RegPack(Buf, InData%TSR) if (RegCheckErr(Buf, RoutineName)) return - ! Vx call RegPack(Buf, allocated(InData%Vx)) if (allocated(InData%Vx)) then call RegPackBounds(Buf, 2, lbound(InData%Vx), ubound(InData%Vx)) call RegPack(Buf, InData%Vx) end if if (RegCheckErr(Buf, RoutineName)) return - ! Vy call RegPack(Buf, allocated(InData%Vy)) if (allocated(InData%Vy)) then call RegPackBounds(Buf, 2, lbound(InData%Vy), ubound(InData%Vy)) call RegPack(Buf, InData%Vy) end if if (RegCheckErr(Buf, RoutineName)) return - ! Vz call RegPack(Buf, allocated(InData%Vz)) if (allocated(InData%Vz)) then call RegPackBounds(Buf, 2, lbound(InData%Vz), ubound(InData%Vz)) call RegPack(Buf, InData%Vz) end if if (RegCheckErr(Buf, RoutineName)) return - ! omega_z call RegPack(Buf, allocated(InData%omega_z)) if (allocated(InData%omega_z)) then call RegPackBounds(Buf, 2, lbound(InData%omega_z), ubound(InData%omega_z)) call RegPack(Buf, InData%omega_z) end if if (RegCheckErr(Buf, RoutineName)) return - ! xVelCorr call RegPack(Buf, allocated(InData%xVelCorr)) if (allocated(InData%xVelCorr)) then call RegPackBounds(Buf, 2, lbound(InData%xVelCorr), ubound(InData%xVelCorr)) call RegPack(Buf, InData%xVelCorr) end if if (RegCheckErr(Buf, RoutineName)) return - ! rLocal call RegPack(Buf, allocated(InData%rLocal)) if (allocated(InData%rLocal)) then call RegPackBounds(Buf, 2, lbound(InData%rLocal), ubound(InData%rLocal)) call RegPack(Buf, InData%rLocal) end if if (RegCheckErr(Buf, RoutineName)) return - ! Un_disk call RegPack(Buf, InData%Un_disk) if (RegCheckErr(Buf, RoutineName)) return - ! V0 call RegPack(Buf, InData%V0) if (RegCheckErr(Buf, RoutineName)) return - ! x_hat_disk call RegPack(Buf, InData%x_hat_disk) if (RegCheckErr(Buf, RoutineName)) return - ! UserProp call RegPack(Buf, allocated(InData%UserProp)) if (allocated(InData%UserProp)) then call RegPackBounds(Buf, 2, lbound(InData%UserProp), ubound(InData%UserProp)) call RegPack(Buf, InData%UserProp) end if if (RegCheckErr(Buf, RoutineName)) return - ! CantAngle call RegPack(Buf, allocated(InData%CantAngle)) if (allocated(InData%CantAngle)) then call RegPackBounds(Buf, 2, lbound(InData%CantAngle), ubound(InData%CantAngle)) call RegPack(Buf, InData%CantAngle) end if if (RegCheckErr(Buf, RoutineName)) return - ! drdz call RegPack(Buf, allocated(InData%drdz)) if (allocated(InData%drdz)) then call RegPackBounds(Buf, 2, lbound(InData%drdz), ubound(InData%drdz)) call RegPack(Buf, InData%drdz) end if if (RegCheckErr(Buf, RoutineName)) return - ! toeAngle call RegPack(Buf, allocated(InData%toeAngle)) if (allocated(InData%toeAngle)) then call RegPackBounds(Buf, 2, lbound(InData%toeAngle), ubound(InData%toeAngle)) @@ -2677,7 +2356,6 @@ subroutine BEMT_UnPackInput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! theta if (allocated(OutData%theta)) deallocate(OutData%theta) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2692,13 +2370,10 @@ subroutine BEMT_UnPackInput(Buf, OutData) call RegUnpack(Buf, OutData%theta) if (RegCheckErr(Buf, RoutineName)) return end if - ! chi0 call RegUnpack(Buf, OutData%chi0) if (RegCheckErr(Buf, RoutineName)) return - ! psiSkewOffset call RegUnpack(Buf, OutData%psiSkewOffset) if (RegCheckErr(Buf, RoutineName)) return - ! psi if (allocated(OutData%psi)) deallocate(OutData%psi) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2713,13 +2388,10 @@ subroutine BEMT_UnPackInput(Buf, OutData) call RegUnpack(Buf, OutData%psi) if (RegCheckErr(Buf, RoutineName)) return end if - ! omega call RegUnpack(Buf, OutData%omega) if (RegCheckErr(Buf, RoutineName)) return - ! TSR call RegUnpack(Buf, OutData%TSR) if (RegCheckErr(Buf, RoutineName)) return - ! Vx if (allocated(OutData%Vx)) deallocate(OutData%Vx) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2734,7 +2406,6 @@ subroutine BEMT_UnPackInput(Buf, OutData) call RegUnpack(Buf, OutData%Vx) if (RegCheckErr(Buf, RoutineName)) return end if - ! Vy if (allocated(OutData%Vy)) deallocate(OutData%Vy) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2749,7 +2420,6 @@ subroutine BEMT_UnPackInput(Buf, OutData) call RegUnpack(Buf, OutData%Vy) if (RegCheckErr(Buf, RoutineName)) return end if - ! Vz if (allocated(OutData%Vz)) deallocate(OutData%Vz) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2764,7 +2434,6 @@ subroutine BEMT_UnPackInput(Buf, OutData) call RegUnpack(Buf, OutData%Vz) if (RegCheckErr(Buf, RoutineName)) return end if - ! omega_z if (allocated(OutData%omega_z)) deallocate(OutData%omega_z) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2779,7 +2448,6 @@ subroutine BEMT_UnPackInput(Buf, OutData) call RegUnpack(Buf, OutData%omega_z) if (RegCheckErr(Buf, RoutineName)) return end if - ! xVelCorr if (allocated(OutData%xVelCorr)) deallocate(OutData%xVelCorr) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2794,7 +2462,6 @@ subroutine BEMT_UnPackInput(Buf, OutData) call RegUnpack(Buf, OutData%xVelCorr) if (RegCheckErr(Buf, RoutineName)) return end if - ! rLocal if (allocated(OutData%rLocal)) deallocate(OutData%rLocal) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2809,16 +2476,12 @@ subroutine BEMT_UnPackInput(Buf, OutData) call RegUnpack(Buf, OutData%rLocal) if (RegCheckErr(Buf, RoutineName)) return end if - ! Un_disk call RegUnpack(Buf, OutData%Un_disk) if (RegCheckErr(Buf, RoutineName)) return - ! V0 call RegUnpack(Buf, OutData%V0) if (RegCheckErr(Buf, RoutineName)) return - ! x_hat_disk call RegUnpack(Buf, OutData%x_hat_disk) if (RegCheckErr(Buf, RoutineName)) return - ! UserProp if (allocated(OutData%UserProp)) deallocate(OutData%UserProp) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2833,7 +2496,6 @@ subroutine BEMT_UnPackInput(Buf, OutData) call RegUnpack(Buf, OutData%UserProp) if (RegCheckErr(Buf, RoutineName)) return end if - ! CantAngle if (allocated(OutData%CantAngle)) deallocate(OutData%CantAngle) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2848,7 +2510,6 @@ subroutine BEMT_UnPackInput(Buf, OutData) call RegUnpack(Buf, OutData%CantAngle) if (RegCheckErr(Buf, RoutineName)) return end if - ! drdz if (allocated(OutData%drdz)) deallocate(OutData%drdz) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2863,7 +2524,6 @@ subroutine BEMT_UnPackInput(Buf, OutData) call RegUnpack(Buf, OutData%drdz) if (RegCheckErr(Buf, RoutineName)) return end if - ! toeAngle if (allocated(OutData%toeAngle)) deallocate(OutData%toeAngle) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2879,447 +2539,419 @@ subroutine BEMT_UnPackInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE BEMT_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BEMT_OutputType), INTENT(IN) :: SrcOutputData - TYPE(BEMT_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_CopyOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%Vrel)) THEN - i1_l = LBOUND(SrcOutputData%Vrel,1) - i1_u = UBOUND(SrcOutputData%Vrel,1) - i2_l = LBOUND(SrcOutputData%Vrel,2) - i2_u = UBOUND(SrcOutputData%Vrel,2) - IF (.NOT. ALLOCATED(DstOutputData%Vrel)) THEN - ALLOCATE(DstOutputData%Vrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vrel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Vrel = SrcOutputData%Vrel -ENDIF -IF (ALLOCATED(SrcOutputData%phi)) THEN - i1_l = LBOUND(SrcOutputData%phi,1) - i1_u = UBOUND(SrcOutputData%phi,1) - i2_l = LBOUND(SrcOutputData%phi,2) - i2_u = UBOUND(SrcOutputData%phi,2) - IF (.NOT. ALLOCATED(DstOutputData%phi)) THEN - ALLOCATE(DstOutputData%phi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%phi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%phi = SrcOutputData%phi -ENDIF -IF (ALLOCATED(SrcOutputData%axInduction)) THEN - i1_l = LBOUND(SrcOutputData%axInduction,1) - i1_u = UBOUND(SrcOutputData%axInduction,1) - i2_l = LBOUND(SrcOutputData%axInduction,2) - i2_u = UBOUND(SrcOutputData%axInduction,2) - IF (.NOT. ALLOCATED(DstOutputData%axInduction)) THEN - ALLOCATE(DstOutputData%axInduction(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%axInduction.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%axInduction = SrcOutputData%axInduction -ENDIF -IF (ALLOCATED(SrcOutputData%tanInduction)) THEN - i1_l = LBOUND(SrcOutputData%tanInduction,1) - i1_u = UBOUND(SrcOutputData%tanInduction,1) - i2_l = LBOUND(SrcOutputData%tanInduction,2) - i2_u = UBOUND(SrcOutputData%tanInduction,2) - IF (.NOT. ALLOCATED(DstOutputData%tanInduction)) THEN - ALLOCATE(DstOutputData%tanInduction(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%tanInduction.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%tanInduction = SrcOutputData%tanInduction -ENDIF -IF (ALLOCATED(SrcOutputData%Re)) THEN - i1_l = LBOUND(SrcOutputData%Re,1) - i1_u = UBOUND(SrcOutputData%Re,1) - i2_l = LBOUND(SrcOutputData%Re,2) - i2_u = UBOUND(SrcOutputData%Re,2) - IF (.NOT. ALLOCATED(DstOutputData%Re)) THEN - ALLOCATE(DstOutputData%Re(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Re.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Re = SrcOutputData%Re -ENDIF -IF (ALLOCATED(SrcOutputData%AOA)) THEN - i1_l = LBOUND(SrcOutputData%AOA,1) - i1_u = UBOUND(SrcOutputData%AOA,1) - i2_l = LBOUND(SrcOutputData%AOA,2) - i2_u = UBOUND(SrcOutputData%AOA,2) - IF (.NOT. ALLOCATED(DstOutputData%AOA)) THEN - ALLOCATE(DstOutputData%AOA(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%AOA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%AOA = SrcOutputData%AOA -ENDIF -IF (ALLOCATED(SrcOutputData%Cx)) THEN - i1_l = LBOUND(SrcOutputData%Cx,1) - i1_u = UBOUND(SrcOutputData%Cx,1) - i2_l = LBOUND(SrcOutputData%Cx,2) - i2_u = UBOUND(SrcOutputData%Cx,2) - IF (.NOT. ALLOCATED(DstOutputData%Cx)) THEN - ALLOCATE(DstOutputData%Cx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Cx = SrcOutputData%Cx -ENDIF -IF (ALLOCATED(SrcOutputData%Cy)) THEN - i1_l = LBOUND(SrcOutputData%Cy,1) - i1_u = UBOUND(SrcOutputData%Cy,1) - i2_l = LBOUND(SrcOutputData%Cy,2) - i2_u = UBOUND(SrcOutputData%Cy,2) - IF (.NOT. ALLOCATED(DstOutputData%Cy)) THEN - ALLOCATE(DstOutputData%Cy(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Cy = SrcOutputData%Cy -ENDIF -IF (ALLOCATED(SrcOutputData%Cz)) THEN - i1_l = LBOUND(SrcOutputData%Cz,1) - i1_u = UBOUND(SrcOutputData%Cz,1) - i2_l = LBOUND(SrcOutputData%Cz,2) - i2_u = UBOUND(SrcOutputData%Cz,2) - IF (.NOT. ALLOCATED(DstOutputData%Cz)) THEN - ALLOCATE(DstOutputData%Cz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Cz = SrcOutputData%Cz -ENDIF -IF (ALLOCATED(SrcOutputData%Cmx)) THEN - i1_l = LBOUND(SrcOutputData%Cmx,1) - i1_u = UBOUND(SrcOutputData%Cmx,1) - i2_l = LBOUND(SrcOutputData%Cmx,2) - i2_u = UBOUND(SrcOutputData%Cmx,2) - IF (.NOT. ALLOCATED(DstOutputData%Cmx)) THEN - ALLOCATE(DstOutputData%Cmx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cmx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Cmx = SrcOutputData%Cmx -ENDIF -IF (ALLOCATED(SrcOutputData%Cmy)) THEN - i1_l = LBOUND(SrcOutputData%Cmy,1) - i1_u = UBOUND(SrcOutputData%Cmy,1) - i2_l = LBOUND(SrcOutputData%Cmy,2) - i2_u = UBOUND(SrcOutputData%Cmy,2) - IF (.NOT. ALLOCATED(DstOutputData%Cmy)) THEN - ALLOCATE(DstOutputData%Cmy(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cmy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Cmy = SrcOutputData%Cmy -ENDIF -IF (ALLOCATED(SrcOutputData%Cmz)) THEN - i1_l = LBOUND(SrcOutputData%Cmz,1) - i1_u = UBOUND(SrcOutputData%Cmz,1) - i2_l = LBOUND(SrcOutputData%Cmz,2) - i2_u = UBOUND(SrcOutputData%Cmz,2) - IF (.NOT. ALLOCATED(DstOutputData%Cmz)) THEN - ALLOCATE(DstOutputData%Cmz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cmz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Cmz = SrcOutputData%Cmz -ENDIF -IF (ALLOCATED(SrcOutputData%Cm)) THEN - i1_l = LBOUND(SrcOutputData%Cm,1) - i1_u = UBOUND(SrcOutputData%Cm,1) - i2_l = LBOUND(SrcOutputData%Cm,2) - i2_u = UBOUND(SrcOutputData%Cm,2) - IF (.NOT. ALLOCATED(DstOutputData%Cm)) THEN - ALLOCATE(DstOutputData%Cm(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Cm = SrcOutputData%Cm -ENDIF -IF (ALLOCATED(SrcOutputData%Cl)) THEN - i1_l = LBOUND(SrcOutputData%Cl,1) - i1_u = UBOUND(SrcOutputData%Cl,1) - i2_l = LBOUND(SrcOutputData%Cl,2) - i2_u = UBOUND(SrcOutputData%Cl,2) - IF (.NOT. ALLOCATED(DstOutputData%Cl)) THEN - ALLOCATE(DstOutputData%Cl(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Cl = SrcOutputData%Cl -ENDIF -IF (ALLOCATED(SrcOutputData%Cd)) THEN - i1_l = LBOUND(SrcOutputData%Cd,1) - i1_u = UBOUND(SrcOutputData%Cd,1) - i2_l = LBOUND(SrcOutputData%Cd,2) - i2_u = UBOUND(SrcOutputData%Cd,2) - IF (.NOT. ALLOCATED(DstOutputData%Cd)) THEN - ALLOCATE(DstOutputData%Cd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Cd = SrcOutputData%Cd -ENDIF -IF (ALLOCATED(SrcOutputData%chi)) THEN - i1_l = LBOUND(SrcOutputData%chi,1) - i1_u = UBOUND(SrcOutputData%chi,1) - i2_l = LBOUND(SrcOutputData%chi,2) - i2_u = UBOUND(SrcOutputData%chi,2) - IF (.NOT. ALLOCATED(DstOutputData%chi)) THEN - ALLOCATE(DstOutputData%chi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%chi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%chi = SrcOutputData%chi -ENDIF -IF (ALLOCATED(SrcOutputData%Cpmin)) THEN - i1_l = LBOUND(SrcOutputData%Cpmin,1) - i1_u = UBOUND(SrcOutputData%Cpmin,1) - i2_l = LBOUND(SrcOutputData%Cpmin,2) - i2_u = UBOUND(SrcOutputData%Cpmin,2) - IF (.NOT. ALLOCATED(DstOutputData%Cpmin)) THEN - ALLOCATE(DstOutputData%Cpmin(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cpmin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Cpmin = SrcOutputData%Cpmin -ENDIF - END SUBROUTINE BEMT_CopyOutput - SUBROUTINE BEMT_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(BEMT_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OutputData%Vrel)) THEN - DEALLOCATE(OutputData%Vrel) -ENDIF -IF (ALLOCATED(OutputData%phi)) THEN - DEALLOCATE(OutputData%phi) -ENDIF -IF (ALLOCATED(OutputData%axInduction)) THEN - DEALLOCATE(OutputData%axInduction) -ENDIF -IF (ALLOCATED(OutputData%tanInduction)) THEN - DEALLOCATE(OutputData%tanInduction) -ENDIF -IF (ALLOCATED(OutputData%Re)) THEN - DEALLOCATE(OutputData%Re) -ENDIF -IF (ALLOCATED(OutputData%AOA)) THEN - DEALLOCATE(OutputData%AOA) -ENDIF -IF (ALLOCATED(OutputData%Cx)) THEN - DEALLOCATE(OutputData%Cx) -ENDIF -IF (ALLOCATED(OutputData%Cy)) THEN - DEALLOCATE(OutputData%Cy) -ENDIF -IF (ALLOCATED(OutputData%Cz)) THEN - DEALLOCATE(OutputData%Cz) -ENDIF -IF (ALLOCATED(OutputData%Cmx)) THEN - DEALLOCATE(OutputData%Cmx) -ENDIF -IF (ALLOCATED(OutputData%Cmy)) THEN - DEALLOCATE(OutputData%Cmy) -ENDIF -IF (ALLOCATED(OutputData%Cmz)) THEN - DEALLOCATE(OutputData%Cmz) -ENDIF -IF (ALLOCATED(OutputData%Cm)) THEN - DEALLOCATE(OutputData%Cm) -ENDIF -IF (ALLOCATED(OutputData%Cl)) THEN - DEALLOCATE(OutputData%Cl) -ENDIF -IF (ALLOCATED(OutputData%Cd)) THEN - DEALLOCATE(OutputData%Cd) -ENDIF -IF (ALLOCATED(OutputData%chi)) THEN - DEALLOCATE(OutputData%chi) -ENDIF -IF (ALLOCATED(OutputData%Cpmin)) THEN - DEALLOCATE(OutputData%Cpmin) -ENDIF - END SUBROUTINE BEMT_DestroyOutput +subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(BEMT_OutputType), intent(in) :: SrcOutputData + type(BEMT_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'BEMT_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%Vrel)) then + LB(1:2) = lbound(SrcOutputData%Vrel) + UB(1:2) = ubound(SrcOutputData%Vrel) + if (.not. allocated(DstOutputData%Vrel)) then + allocate(DstOutputData%Vrel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vrel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Vrel = SrcOutputData%Vrel + else if (allocated(DstOutputData%Vrel)) then + deallocate(DstOutputData%Vrel) + end if + if (allocated(SrcOutputData%phi)) then + LB(1:2) = lbound(SrcOutputData%phi) + UB(1:2) = ubound(SrcOutputData%phi) + if (.not. allocated(DstOutputData%phi)) then + allocate(DstOutputData%phi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%phi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%phi = SrcOutputData%phi + else if (allocated(DstOutputData%phi)) then + deallocate(DstOutputData%phi) + end if + if (allocated(SrcOutputData%axInduction)) then + LB(1:2) = lbound(SrcOutputData%axInduction) + UB(1:2) = ubound(SrcOutputData%axInduction) + if (.not. allocated(DstOutputData%axInduction)) then + allocate(DstOutputData%axInduction(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%axInduction.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%axInduction = SrcOutputData%axInduction + else if (allocated(DstOutputData%axInduction)) then + deallocate(DstOutputData%axInduction) + end if + if (allocated(SrcOutputData%tanInduction)) then + LB(1:2) = lbound(SrcOutputData%tanInduction) + UB(1:2) = ubound(SrcOutputData%tanInduction) + if (.not. allocated(DstOutputData%tanInduction)) then + allocate(DstOutputData%tanInduction(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%tanInduction.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%tanInduction = SrcOutputData%tanInduction + else if (allocated(DstOutputData%tanInduction)) then + deallocate(DstOutputData%tanInduction) + end if + if (allocated(SrcOutputData%Re)) then + LB(1:2) = lbound(SrcOutputData%Re) + UB(1:2) = ubound(SrcOutputData%Re) + if (.not. allocated(DstOutputData%Re)) then + allocate(DstOutputData%Re(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Re.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Re = SrcOutputData%Re + else if (allocated(DstOutputData%Re)) then + deallocate(DstOutputData%Re) + end if + if (allocated(SrcOutputData%AOA)) then + LB(1:2) = lbound(SrcOutputData%AOA) + UB(1:2) = ubound(SrcOutputData%AOA) + if (.not. allocated(DstOutputData%AOA)) then + allocate(DstOutputData%AOA(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%AOA.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%AOA = SrcOutputData%AOA + else if (allocated(DstOutputData%AOA)) then + deallocate(DstOutputData%AOA) + end if + if (allocated(SrcOutputData%Cx)) then + LB(1:2) = lbound(SrcOutputData%Cx) + UB(1:2) = ubound(SrcOutputData%Cx) + if (.not. allocated(DstOutputData%Cx)) then + allocate(DstOutputData%Cx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Cx = SrcOutputData%Cx + else if (allocated(DstOutputData%Cx)) then + deallocate(DstOutputData%Cx) + end if + if (allocated(SrcOutputData%Cy)) then + LB(1:2) = lbound(SrcOutputData%Cy) + UB(1:2) = ubound(SrcOutputData%Cy) + if (.not. allocated(DstOutputData%Cy)) then + allocate(DstOutputData%Cy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cy.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Cy = SrcOutputData%Cy + else if (allocated(DstOutputData%Cy)) then + deallocate(DstOutputData%Cy) + end if + if (allocated(SrcOutputData%Cz)) then + LB(1:2) = lbound(SrcOutputData%Cz) + UB(1:2) = ubound(SrcOutputData%Cz) + if (.not. allocated(DstOutputData%Cz)) then + allocate(DstOutputData%Cz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cz.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Cz = SrcOutputData%Cz + else if (allocated(DstOutputData%Cz)) then + deallocate(DstOutputData%Cz) + end if + if (allocated(SrcOutputData%Cmx)) then + LB(1:2) = lbound(SrcOutputData%Cmx) + UB(1:2) = ubound(SrcOutputData%Cmx) + if (.not. allocated(DstOutputData%Cmx)) then + allocate(DstOutputData%Cmx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cmx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Cmx = SrcOutputData%Cmx + else if (allocated(DstOutputData%Cmx)) then + deallocate(DstOutputData%Cmx) + end if + if (allocated(SrcOutputData%Cmy)) then + LB(1:2) = lbound(SrcOutputData%Cmy) + UB(1:2) = ubound(SrcOutputData%Cmy) + if (.not. allocated(DstOutputData%Cmy)) then + allocate(DstOutputData%Cmy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cmy.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Cmy = SrcOutputData%Cmy + else if (allocated(DstOutputData%Cmy)) then + deallocate(DstOutputData%Cmy) + end if + if (allocated(SrcOutputData%Cmz)) then + LB(1:2) = lbound(SrcOutputData%Cmz) + UB(1:2) = ubound(SrcOutputData%Cmz) + if (.not. allocated(DstOutputData%Cmz)) then + allocate(DstOutputData%Cmz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cmz.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Cmz = SrcOutputData%Cmz + else if (allocated(DstOutputData%Cmz)) then + deallocate(DstOutputData%Cmz) + end if + if (allocated(SrcOutputData%Cm)) then + LB(1:2) = lbound(SrcOutputData%Cm) + UB(1:2) = ubound(SrcOutputData%Cm) + if (.not. allocated(DstOutputData%Cm)) then + allocate(DstOutputData%Cm(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Cm = SrcOutputData%Cm + else if (allocated(DstOutputData%Cm)) then + deallocate(DstOutputData%Cm) + end if + if (allocated(SrcOutputData%Cl)) then + LB(1:2) = lbound(SrcOutputData%Cl) + UB(1:2) = ubound(SrcOutputData%Cl) + if (.not. allocated(DstOutputData%Cl)) then + allocate(DstOutputData%Cl(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cl.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Cl = SrcOutputData%Cl + else if (allocated(DstOutputData%Cl)) then + deallocate(DstOutputData%Cl) + end if + if (allocated(SrcOutputData%Cd)) then + LB(1:2) = lbound(SrcOutputData%Cd) + UB(1:2) = ubound(SrcOutputData%Cd) + if (.not. allocated(DstOutputData%Cd)) then + allocate(DstOutputData%Cd(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Cd = SrcOutputData%Cd + else if (allocated(DstOutputData%Cd)) then + deallocate(DstOutputData%Cd) + end if + if (allocated(SrcOutputData%chi)) then + LB(1:2) = lbound(SrcOutputData%chi) + UB(1:2) = ubound(SrcOutputData%chi) + if (.not. allocated(DstOutputData%chi)) then + allocate(DstOutputData%chi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%chi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%chi = SrcOutputData%chi + else if (allocated(DstOutputData%chi)) then + deallocate(DstOutputData%chi) + end if + if (allocated(SrcOutputData%Cpmin)) then + LB(1:2) = lbound(SrcOutputData%Cpmin) + UB(1:2) = ubound(SrcOutputData%Cpmin) + if (.not. allocated(DstOutputData%Cpmin)) then + allocate(DstOutputData%Cpmin(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cpmin.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Cpmin = SrcOutputData%Cpmin + else if (allocated(DstOutputData%Cpmin)) then + deallocate(DstOutputData%Cpmin) + end if +end subroutine +subroutine BEMT_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(BEMT_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BEMT_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%Vrel)) then + deallocate(OutputData%Vrel) + end if + if (allocated(OutputData%phi)) then + deallocate(OutputData%phi) + end if + if (allocated(OutputData%axInduction)) then + deallocate(OutputData%axInduction) + end if + if (allocated(OutputData%tanInduction)) then + deallocate(OutputData%tanInduction) + end if + if (allocated(OutputData%Re)) then + deallocate(OutputData%Re) + end if + if (allocated(OutputData%AOA)) then + deallocate(OutputData%AOA) + end if + if (allocated(OutputData%Cx)) then + deallocate(OutputData%Cx) + end if + if (allocated(OutputData%Cy)) then + deallocate(OutputData%Cy) + end if + if (allocated(OutputData%Cz)) then + deallocate(OutputData%Cz) + end if + if (allocated(OutputData%Cmx)) then + deallocate(OutputData%Cmx) + end if + if (allocated(OutputData%Cmy)) then + deallocate(OutputData%Cmy) + end if + if (allocated(OutputData%Cmz)) then + deallocate(OutputData%Cmz) + end if + if (allocated(OutputData%Cm)) then + deallocate(OutputData%Cm) + end if + if (allocated(OutputData%Cl)) then + deallocate(OutputData%Cl) + end if + if (allocated(OutputData%Cd)) then + deallocate(OutputData%Cd) + end if + if (allocated(OutputData%chi)) then + deallocate(OutputData%chi) + end if + if (allocated(OutputData%Cpmin)) then + deallocate(OutputData%Cpmin) + end if +end subroutine subroutine BEMT_PackOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(BEMT_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'BEMT_PackOutput' if (Buf%ErrStat >= AbortErrLev) return - ! Vrel call RegPack(Buf, allocated(InData%Vrel)) if (allocated(InData%Vrel)) then call RegPackBounds(Buf, 2, lbound(InData%Vrel), ubound(InData%Vrel)) call RegPack(Buf, InData%Vrel) end if if (RegCheckErr(Buf, RoutineName)) return - ! phi call RegPack(Buf, allocated(InData%phi)) if (allocated(InData%phi)) then call RegPackBounds(Buf, 2, lbound(InData%phi), ubound(InData%phi)) call RegPack(Buf, InData%phi) end if if (RegCheckErr(Buf, RoutineName)) return - ! axInduction call RegPack(Buf, allocated(InData%axInduction)) if (allocated(InData%axInduction)) then call RegPackBounds(Buf, 2, lbound(InData%axInduction), ubound(InData%axInduction)) call RegPack(Buf, InData%axInduction) end if if (RegCheckErr(Buf, RoutineName)) return - ! tanInduction call RegPack(Buf, allocated(InData%tanInduction)) if (allocated(InData%tanInduction)) then call RegPackBounds(Buf, 2, lbound(InData%tanInduction), ubound(InData%tanInduction)) call RegPack(Buf, InData%tanInduction) end if if (RegCheckErr(Buf, RoutineName)) return - ! Re call RegPack(Buf, allocated(InData%Re)) if (allocated(InData%Re)) then call RegPackBounds(Buf, 2, lbound(InData%Re), ubound(InData%Re)) call RegPack(Buf, InData%Re) end if if (RegCheckErr(Buf, RoutineName)) return - ! AOA call RegPack(Buf, allocated(InData%AOA)) if (allocated(InData%AOA)) then call RegPackBounds(Buf, 2, lbound(InData%AOA), ubound(InData%AOA)) call RegPack(Buf, InData%AOA) end if if (RegCheckErr(Buf, RoutineName)) return - ! Cx call RegPack(Buf, allocated(InData%Cx)) if (allocated(InData%Cx)) then call RegPackBounds(Buf, 2, lbound(InData%Cx), ubound(InData%Cx)) call RegPack(Buf, InData%Cx) end if if (RegCheckErr(Buf, RoutineName)) return - ! Cy call RegPack(Buf, allocated(InData%Cy)) if (allocated(InData%Cy)) then call RegPackBounds(Buf, 2, lbound(InData%Cy), ubound(InData%Cy)) call RegPack(Buf, InData%Cy) end if if (RegCheckErr(Buf, RoutineName)) return - ! Cz call RegPack(Buf, allocated(InData%Cz)) if (allocated(InData%Cz)) then call RegPackBounds(Buf, 2, lbound(InData%Cz), ubound(InData%Cz)) call RegPack(Buf, InData%Cz) end if if (RegCheckErr(Buf, RoutineName)) return - ! Cmx call RegPack(Buf, allocated(InData%Cmx)) if (allocated(InData%Cmx)) then call RegPackBounds(Buf, 2, lbound(InData%Cmx), ubound(InData%Cmx)) call RegPack(Buf, InData%Cmx) end if if (RegCheckErr(Buf, RoutineName)) return - ! Cmy call RegPack(Buf, allocated(InData%Cmy)) if (allocated(InData%Cmy)) then call RegPackBounds(Buf, 2, lbound(InData%Cmy), ubound(InData%Cmy)) call RegPack(Buf, InData%Cmy) end if if (RegCheckErr(Buf, RoutineName)) return - ! Cmz call RegPack(Buf, allocated(InData%Cmz)) if (allocated(InData%Cmz)) then call RegPackBounds(Buf, 2, lbound(InData%Cmz), ubound(InData%Cmz)) call RegPack(Buf, InData%Cmz) end if if (RegCheckErr(Buf, RoutineName)) return - ! Cm call RegPack(Buf, allocated(InData%Cm)) if (allocated(InData%Cm)) then call RegPackBounds(Buf, 2, lbound(InData%Cm), ubound(InData%Cm)) call RegPack(Buf, InData%Cm) end if if (RegCheckErr(Buf, RoutineName)) return - ! Cl call RegPack(Buf, allocated(InData%Cl)) if (allocated(InData%Cl)) then call RegPackBounds(Buf, 2, lbound(InData%Cl), ubound(InData%Cl)) call RegPack(Buf, InData%Cl) end if if (RegCheckErr(Buf, RoutineName)) return - ! Cd call RegPack(Buf, allocated(InData%Cd)) if (allocated(InData%Cd)) then call RegPackBounds(Buf, 2, lbound(InData%Cd), ubound(InData%Cd)) call RegPack(Buf, InData%Cd) end if if (RegCheckErr(Buf, RoutineName)) return - ! chi call RegPack(Buf, allocated(InData%chi)) if (allocated(InData%chi)) then call RegPackBounds(Buf, 2, lbound(InData%chi), ubound(InData%chi)) call RegPack(Buf, InData%chi) end if if (RegCheckErr(Buf, RoutineName)) return - ! Cpmin call RegPack(Buf, allocated(InData%Cpmin)) if (allocated(InData%Cpmin)) then call RegPackBounds(Buf, 2, lbound(InData%Cpmin), ubound(InData%Cpmin)) @@ -3336,7 +2968,6 @@ subroutine BEMT_UnPackOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! Vrel if (allocated(OutData%Vrel)) deallocate(OutData%Vrel) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3351,7 +2982,6 @@ subroutine BEMT_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%Vrel) if (RegCheckErr(Buf, RoutineName)) return end if - ! phi if (allocated(OutData%phi)) deallocate(OutData%phi) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3366,7 +2996,6 @@ subroutine BEMT_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%phi) if (RegCheckErr(Buf, RoutineName)) return end if - ! axInduction if (allocated(OutData%axInduction)) deallocate(OutData%axInduction) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3381,7 +3010,6 @@ subroutine BEMT_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%axInduction) if (RegCheckErr(Buf, RoutineName)) return end if - ! tanInduction if (allocated(OutData%tanInduction)) deallocate(OutData%tanInduction) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3396,7 +3024,6 @@ subroutine BEMT_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%tanInduction) if (RegCheckErr(Buf, RoutineName)) return end if - ! Re if (allocated(OutData%Re)) deallocate(OutData%Re) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3411,7 +3038,6 @@ subroutine BEMT_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%Re) if (RegCheckErr(Buf, RoutineName)) return end if - ! AOA if (allocated(OutData%AOA)) deallocate(OutData%AOA) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3426,7 +3052,6 @@ subroutine BEMT_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%AOA) if (RegCheckErr(Buf, RoutineName)) return end if - ! Cx if (allocated(OutData%Cx)) deallocate(OutData%Cx) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3441,7 +3066,6 @@ subroutine BEMT_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%Cx) if (RegCheckErr(Buf, RoutineName)) return end if - ! Cy if (allocated(OutData%Cy)) deallocate(OutData%Cy) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3456,7 +3080,6 @@ subroutine BEMT_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%Cy) if (RegCheckErr(Buf, RoutineName)) return end if - ! Cz if (allocated(OutData%Cz)) deallocate(OutData%Cz) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3471,7 +3094,6 @@ subroutine BEMT_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%Cz) if (RegCheckErr(Buf, RoutineName)) return end if - ! Cmx if (allocated(OutData%Cmx)) deallocate(OutData%Cmx) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3486,7 +3108,6 @@ subroutine BEMT_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%Cmx) if (RegCheckErr(Buf, RoutineName)) return end if - ! Cmy if (allocated(OutData%Cmy)) deallocate(OutData%Cmy) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3501,7 +3122,6 @@ subroutine BEMT_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%Cmy) if (RegCheckErr(Buf, RoutineName)) return end if - ! Cmz if (allocated(OutData%Cmz)) deallocate(OutData%Cmz) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3516,7 +3136,6 @@ subroutine BEMT_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%Cmz) if (RegCheckErr(Buf, RoutineName)) return end if - ! Cm if (allocated(OutData%Cm)) deallocate(OutData%Cm) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3531,7 +3150,6 @@ subroutine BEMT_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%Cm) if (RegCheckErr(Buf, RoutineName)) return end if - ! Cl if (allocated(OutData%Cl)) deallocate(OutData%Cl) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3546,7 +3164,6 @@ subroutine BEMT_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%Cl) if (RegCheckErr(Buf, RoutineName)) return end if - ! Cd if (allocated(OutData%Cd)) deallocate(OutData%Cd) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3561,7 +3178,6 @@ subroutine BEMT_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%Cd) if (RegCheckErr(Buf, RoutineName)) return end if - ! chi if (allocated(OutData%chi)) deallocate(OutData%chi) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3576,7 +3192,6 @@ subroutine BEMT_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%chi) if (RegCheckErr(Buf, RoutineName)) return end if - ! Cpmin if (allocated(OutData%Cpmin)) deallocate(OutData%Cpmin) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/aerodyn/src/DBEMT_Types.f90 b/modules/aerodyn/src/DBEMT_Types.f90 index 550511414c..9d80c412e8 100644 --- a/modules/aerodyn/src/DBEMT_Types.f90 +++ b/modules/aerodyn/src/DBEMT_Types.f90 @@ -118,79 +118,63 @@ MODULE DBEMT_Types END TYPE DBEMT_OutputType ! ======================= CONTAINS - SUBROUTINE DBEMT_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DBEMT_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(DBEMT_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_CopyInitInput' -! + +subroutine DBEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(DBEMT_InitInputType), intent(in) :: SrcInitInputData + type(DBEMT_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'DBEMT_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%NumBlades = SrcInitInputData%NumBlades - DstInitInputData%NumNodes = SrcInitInputData%NumNodes - DstInitInputData%tau1_const = SrcInitInputData%tau1_const - DstInitInputData%DBEMT_Mod = SrcInitInputData%DBEMT_Mod -IF (ALLOCATED(SrcInitInputData%rLocal)) THEN - i1_l = LBOUND(SrcInitInputData%rLocal,1) - i1_u = UBOUND(SrcInitInputData%rLocal,1) - i2_l = LBOUND(SrcInitInputData%rLocal,2) - i2_u = UBOUND(SrcInitInputData%rLocal,2) - IF (.NOT. ALLOCATED(DstInitInputData%rLocal)) THEN - ALLOCATE(DstInitInputData%rLocal(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%rLocal.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%rLocal = SrcInitInputData%rLocal -ENDIF - END SUBROUTINE DBEMT_CopyInitInput - - SUBROUTINE DBEMT_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(DBEMT_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitInputData%rLocal)) THEN - DEALLOCATE(InitInputData%rLocal) -ENDIF - END SUBROUTINE DBEMT_DestroyInitInput + ErrMsg = '' + DstInitInputData%NumBlades = SrcInitInputData%NumBlades + DstInitInputData%NumNodes = SrcInitInputData%NumNodes + DstInitInputData%tau1_const = SrcInitInputData%tau1_const + DstInitInputData%DBEMT_Mod = SrcInitInputData%DBEMT_Mod + if (allocated(SrcInitInputData%rLocal)) then + LB(1:2) = lbound(SrcInitInputData%rLocal) + UB(1:2) = ubound(SrcInitInputData%rLocal) + if (.not. allocated(DstInitInputData%rLocal)) then + allocate(DstInitInputData%rLocal(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%rLocal.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%rLocal = SrcInitInputData%rLocal + else if (allocated(DstInitInputData%rLocal)) then + deallocate(DstInitInputData%rLocal) + end if +end subroutine +subroutine DBEMT_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(DBEMT_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DBEMT_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitInputData%rLocal)) then + deallocate(InitInputData%rLocal) + end if +end subroutine subroutine DBEMT_PackInitInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(DBEMT_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'DBEMT_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return - ! NumBlades call RegPack(Buf, InData%NumBlades) if (RegCheckErr(Buf, RoutineName)) return - ! NumNodes call RegPack(Buf, InData%NumNodes) if (RegCheckErr(Buf, RoutineName)) return - ! tau1_const call RegPack(Buf, InData%tau1_const) if (RegCheckErr(Buf, RoutineName)) return - ! DBEMT_Mod call RegPack(Buf, InData%DBEMT_Mod) if (RegCheckErr(Buf, RoutineName)) return - ! rLocal call RegPack(Buf, allocated(InData%rLocal)) if (allocated(InData%rLocal)) then call RegPackBounds(Buf, 2, lbound(InData%rLocal), ubound(InData%rLocal)) @@ -207,19 +191,14 @@ subroutine DBEMT_UnPackInitInput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! NumBlades call RegUnpack(Buf, OutData%NumBlades) if (RegCheckErr(Buf, RoutineName)) return - ! NumNodes call RegUnpack(Buf, OutData%NumNodes) if (RegCheckErr(Buf, RoutineName)) return - ! tau1_const call RegUnpack(Buf, OutData%tau1_const) if (RegCheckErr(Buf, RoutineName)) return - ! DBEMT_Mod call RegUnpack(Buf, OutData%DBEMT_Mod) if (RegCheckErr(Buf, RoutineName)) return - ! rLocal if (allocated(OutData%rLocal)) deallocate(OutData%rLocal) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -235,49 +214,39 @@ subroutine DBEMT_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE DBEMT_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DBEMT_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(DBEMT_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_CopyInitOutput' -! + +subroutine DBEMT_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(DBEMT_InitOutputType), intent(in) :: SrcInitOutputData + type(DBEMT_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DBEMT_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE DBEMT_CopyInitOutput - - SUBROUTINE DBEMT_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(DBEMT_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE DBEMT_DestroyInitOutput + ErrMsg = '' + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine DBEMT_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(DBEMT_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DBEMT_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine DBEMT_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(DBEMT_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'DBEMT_PackInitOutput' if (Buf%ErrStat >= AbortErrLev) return - ! Ver call NWTC_Library_PackProgDesc(Buf, InData%Ver) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -287,53 +256,38 @@ subroutine DBEMT_UnPackInitOutput(Buf, OutData) type(DBEMT_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DBEMT_UnPackInitOutput' if (Buf%ErrStat /= ErrID_None) return - ! Ver call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver end subroutine - SUBROUTINE DBEMT_CopyElementContinuousStateType( SrcElementContinuousStateTypeData, DstElementContinuousStateTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DBEMT_ElementContinuousStateType), INTENT(IN) :: SrcElementContinuousStateTypeData - TYPE(DBEMT_ElementContinuousStateType), INTENT(INOUT) :: DstElementContinuousStateTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_CopyElementContinuousStateType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstElementContinuousStateTypeData%vind = SrcElementContinuousStateTypeData%vind - DstElementContinuousStateTypeData%vind_1 = SrcElementContinuousStateTypeData%vind_1 - END SUBROUTINE DBEMT_CopyElementContinuousStateType - - SUBROUTINE DBEMT_DestroyElementContinuousStateType( ElementContinuousStateTypeData, ErrStat, ErrMsg ) - TYPE(DBEMT_ElementContinuousStateType), INTENT(INOUT) :: ElementContinuousStateTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyElementContinuousStateType' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE DBEMT_DestroyElementContinuousStateType +subroutine DBEMT_CopyElementContinuousStateType(SrcElementContinuousStateTypeData, DstElementContinuousStateTypeData, CtrlCode, ErrStat, ErrMsg) + type(DBEMT_ElementContinuousStateType), intent(in) :: SrcElementContinuousStateTypeData + type(DBEMT_ElementContinuousStateType), intent(inout) :: DstElementContinuousStateTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DBEMT_CopyElementContinuousStateType' + ErrStat = ErrID_None + ErrMsg = '' + DstElementContinuousStateTypeData%vind = SrcElementContinuousStateTypeData%vind + DstElementContinuousStateTypeData%vind_1 = SrcElementContinuousStateTypeData%vind_1 +end subroutine +subroutine DBEMT_DestroyElementContinuousStateType(ElementContinuousStateTypeData, ErrStat, ErrMsg) + type(DBEMT_ElementContinuousStateType), intent(inout) :: ElementContinuousStateTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DBEMT_DestroyElementContinuousStateType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine DBEMT_PackElementContinuousStateType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(DBEMT_ElementContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'DBEMT_PackElementContinuousStateType' if (Buf%ErrStat >= AbortErrLev) return - ! vind call RegPack(Buf, InData%vind) if (RegCheckErr(Buf, RoutineName)) return - ! vind_1 call RegPack(Buf, InData%vind_1) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -343,75 +297,70 @@ subroutine DBEMT_UnPackElementContinuousStateType(Buf, OutData) type(DBEMT_ElementContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DBEMT_UnPackElementContinuousStateType' if (Buf%ErrStat /= ErrID_None) return - ! vind call RegUnpack(Buf, OutData%vind) if (RegCheckErr(Buf, RoutineName)) return - ! vind_1 call RegUnpack(Buf, OutData%vind_1) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE DBEMT_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DBEMT_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(DBEMT_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_CopyContState' -! + +subroutine DBEMT_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(DBEMT_ContinuousStateType), intent(in) :: SrcContStateData + type(DBEMT_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DBEMT_CopyContState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcContStateData%element)) THEN - i1_l = LBOUND(SrcContStateData%element,1) - i1_u = UBOUND(SrcContStateData%element,1) - i2_l = LBOUND(SrcContStateData%element,2) - i2_u = UBOUND(SrcContStateData%element,2) - IF (.NOT. ALLOCATED(DstContStateData%element)) THEN - ALLOCATE(DstContStateData%element(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%element.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcContStateData%element,2), UBOUND(SrcContStateData%element,2) - DO i1 = LBOUND(SrcContStateData%element,1), UBOUND(SrcContStateData%element,1) - CALL DBEMT_Copyelementcontinuousstatetype( SrcContStateData%element(i1,i2), DstContStateData%element(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF - END SUBROUTINE DBEMT_CopyContState - - SUBROUTINE DBEMT_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(DBEMT_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ContStateData%element)) THEN -DO i2 = LBOUND(ContStateData%element,2), UBOUND(ContStateData%element,2) -DO i1 = LBOUND(ContStateData%element,1), UBOUND(ContStateData%element,1) - CALL DBEMT_DestroyElementContinuousStateType( ContStateData%element(i1,i2), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(ContStateData%element) -ENDIF - END SUBROUTINE DBEMT_DestroyContState + ErrMsg = '' + if (allocated(SrcContStateData%element)) then + LB(1:2) = lbound(SrcContStateData%element) + UB(1:2) = ubound(SrcContStateData%element) + if (.not. allocated(DstContStateData%element)) then + allocate(DstContStateData%element(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%element.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call DBEMT_CopyElementContinuousStateType(SrcContStateData%element(i1,i2), DstContStateData%element(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + else if (allocated(DstContStateData%element)) then + deallocate(DstContStateData%element) + end if +end subroutine +subroutine DBEMT_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(DBEMT_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DBEMT_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ContStateData%element)) then + LB(1:2) = lbound(ContStateData%element) + UB(1:2) = ubound(ContStateData%element) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call DBEMT_DestroyElementContinuousStateType(ContStateData%element(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(ContStateData%element) + end if +end subroutine subroutine DBEMT_PackContState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -420,7 +369,6 @@ subroutine DBEMT_PackContState(Buf, Indata) integer(IntKi) :: i1, i2 integer(IntKi) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return - ! element call RegPack(Buf, allocated(InData%element)) if (allocated(InData%element)) then call RegPackBounds(Buf, 2, lbound(InData%element), ubound(InData%element)) @@ -444,7 +392,6 @@ subroutine DBEMT_UnPackContState(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! element if (allocated(OutData%element)) deallocate(OutData%element) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -463,45 +410,33 @@ subroutine DBEMT_UnPackContState(Buf, OutData) end do end if end subroutine - SUBROUTINE DBEMT_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DBEMT_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(DBEMT_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyState = SrcDiscStateData%DummyState - END SUBROUTINE DBEMT_CopyDiscState - - SUBROUTINE DBEMT_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(DBEMT_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE DBEMT_DestroyDiscState +subroutine DBEMT_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(DBEMT_DiscreteStateType), intent(in) :: SrcDiscStateData + type(DBEMT_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DBEMT_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + DstDiscStateData%DummyState = SrcDiscStateData%DummyState +end subroutine +subroutine DBEMT_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(DBEMT_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DBEMT_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine DBEMT_PackDiscState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(DBEMT_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'DBEMT_PackDiscState' if (Buf%ErrStat >= AbortErrLev) return - ! DummyState call RegPack(Buf, InData%DummyState) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -511,49 +446,36 @@ subroutine DBEMT_UnPackDiscState(Buf, OutData) type(DBEMT_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DBEMT_UnPackDiscState' if (Buf%ErrStat /= ErrID_None) return - ! DummyState call RegUnpack(Buf, OutData%DummyState) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE DBEMT_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DBEMT_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(DBEMT_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyState = SrcConstrStateData%DummyState - END SUBROUTINE DBEMT_CopyConstrState - - SUBROUTINE DBEMT_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(DBEMT_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE DBEMT_DestroyConstrState +subroutine DBEMT_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(DBEMT_ConstraintStateType), intent(in) :: SrcConstrStateData + type(DBEMT_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DBEMT_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%DummyState = SrcConstrStateData%DummyState +end subroutine +subroutine DBEMT_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(DBEMT_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DBEMT_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine DBEMT_PackConstrState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(DBEMT_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'DBEMT_PackConstrState' if (Buf%ErrStat >= AbortErrLev) return - ! DummyState call RegPack(Buf, InData%DummyState) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -563,88 +485,78 @@ subroutine DBEMT_UnPackConstrState(Buf, OutData) type(DBEMT_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DBEMT_UnPackConstrState' if (Buf%ErrStat /= ErrID_None) return - ! DummyState call RegUnpack(Buf, OutData%DummyState) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE DBEMT_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DBEMT_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(DBEMT_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_CopyOtherState' -! + +subroutine DBEMT_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(DBEMT_OtherStateType), intent(in) :: SrcOtherStateData + type(DBEMT_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DBEMT_CopyOtherState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOtherStateData%areStatesInitialized)) THEN - i1_l = LBOUND(SrcOtherStateData%areStatesInitialized,1) - i1_u = UBOUND(SrcOtherStateData%areStatesInitialized,1) - i2_l = LBOUND(SrcOtherStateData%areStatesInitialized,2) - i2_u = UBOUND(SrcOtherStateData%areStatesInitialized,2) - IF (.NOT. ALLOCATED(DstOtherStateData%areStatesInitialized)) THEN - ALLOCATE(DstOtherStateData%areStatesInitialized(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%areStatesInitialized.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%areStatesInitialized = SrcOtherStateData%areStatesInitialized -ENDIF - DstOtherStateData%tau1 = SrcOtherStateData%tau1 - DstOtherStateData%tau2 = SrcOtherStateData%tau2 -IF (ALLOCATED(SrcOtherStateData%n)) THEN - i1_l = LBOUND(SrcOtherStateData%n,1) - i1_u = UBOUND(SrcOtherStateData%n,1) - i2_l = LBOUND(SrcOtherStateData%n,2) - i2_u = UBOUND(SrcOtherStateData%n,2) - IF (.NOT. ALLOCATED(DstOtherStateData%n)) THEN - ALLOCATE(DstOtherStateData%n(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%n.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%n = SrcOtherStateData%n -ENDIF - DO i1 = LBOUND(SrcOtherStateData%xdot,1), UBOUND(SrcOtherStateData%xdot,1) - CALL DBEMT_CopyContState( SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - END SUBROUTINE DBEMT_CopyOtherState - - SUBROUTINE DBEMT_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(DBEMT_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OtherStateData%areStatesInitialized)) THEN - DEALLOCATE(OtherStateData%areStatesInitialized) -ENDIF -IF (ALLOCATED(OtherStateData%n)) THEN - DEALLOCATE(OtherStateData%n) -ENDIF -DO i1 = LBOUND(OtherStateData%xdot,1), UBOUND(OtherStateData%xdot,1) - CALL DBEMT_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - END SUBROUTINE DBEMT_DestroyOtherState + ErrMsg = '' + if (allocated(SrcOtherStateData%areStatesInitialized)) then + LB(1:2) = lbound(SrcOtherStateData%areStatesInitialized) + UB(1:2) = ubound(SrcOtherStateData%areStatesInitialized) + if (.not. allocated(DstOtherStateData%areStatesInitialized)) then + allocate(DstOtherStateData%areStatesInitialized(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%areStatesInitialized.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%areStatesInitialized = SrcOtherStateData%areStatesInitialized + else if (allocated(DstOtherStateData%areStatesInitialized)) then + deallocate(DstOtherStateData%areStatesInitialized) + end if + DstOtherStateData%tau1 = SrcOtherStateData%tau1 + DstOtherStateData%tau2 = SrcOtherStateData%tau2 + if (allocated(SrcOtherStateData%n)) then + LB(1:2) = lbound(SrcOtherStateData%n) + UB(1:2) = ubound(SrcOtherStateData%n) + if (.not. allocated(DstOtherStateData%n)) then + allocate(DstOtherStateData%n(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%n.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%n = SrcOtherStateData%n + else if (allocated(DstOtherStateData%n)) then + deallocate(DstOtherStateData%n) + end if + do i1 = LB(1), UB(1) + call DBEMT_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do +end subroutine +subroutine DBEMT_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(DBEMT_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DBEMT_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OtherStateData%areStatesInitialized)) then + deallocate(OtherStateData%areStatesInitialized) + end if + if (allocated(OtherStateData%n)) then + deallocate(OtherStateData%n) + end if +end subroutine subroutine DBEMT_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -653,27 +565,22 @@ subroutine DBEMT_PackOtherState(Buf, Indata) integer(IntKi) :: i1, i2 integer(IntKi) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return - ! areStatesInitialized call RegPack(Buf, allocated(InData%areStatesInitialized)) if (allocated(InData%areStatesInitialized)) then call RegPackBounds(Buf, 2, lbound(InData%areStatesInitialized), ubound(InData%areStatesInitialized)) call RegPack(Buf, InData%areStatesInitialized) end if if (RegCheckErr(Buf, RoutineName)) return - ! tau1 call RegPack(Buf, InData%tau1) if (RegCheckErr(Buf, RoutineName)) return - ! tau2 call RegPack(Buf, InData%tau2) if (RegCheckErr(Buf, RoutineName)) return - ! n call RegPack(Buf, allocated(InData%n)) if (allocated(InData%n)) then call RegPackBounds(Buf, 2, lbound(InData%n), ubound(InData%n)) call RegPack(Buf, InData%n) end if if (RegCheckErr(Buf, RoutineName)) return - ! xdot LB(1:1) = lbound(InData%xdot) UB(1:1) = ubound(InData%xdot) do i1 = LB(1), UB(1) @@ -691,7 +598,6 @@ subroutine DBEMT_UnPackOtherState(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! areStatesInitialized if (allocated(OutData%areStatesInitialized)) deallocate(OutData%areStatesInitialized) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -706,13 +612,10 @@ subroutine DBEMT_UnPackOtherState(Buf, OutData) call RegUnpack(Buf, OutData%areStatesInitialized) if (RegCheckErr(Buf, RoutineName)) return end if - ! tau1 call RegUnpack(Buf, OutData%tau1) if (RegCheckErr(Buf, RoutineName)) return - ! tau2 call RegUnpack(Buf, OutData%tau2) if (RegCheckErr(Buf, RoutineName)) return - ! n if (allocated(OutData%n)) deallocate(OutData%n) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -727,52 +630,39 @@ subroutine DBEMT_UnPackOtherState(Buf, OutData) call RegUnpack(Buf, OutData%n) if (RegCheckErr(Buf, RoutineName)) return end if - ! xdot LB(1:1) = lbound(OutData%xdot) UB(1:1) = ubound(OutData%xdot) do i1 = LB(1), UB(1) call DBEMT_UnpackContState(Buf, OutData%xdot(i1)) ! xdot end do end subroutine - SUBROUTINE DBEMT_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DBEMT_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(DBEMT_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%FirstWarn_tau1 = SrcMiscData%FirstWarn_tau1 - END SUBROUTINE DBEMT_CopyMisc - - SUBROUTINE DBEMT_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(DBEMT_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyMisc' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE DBEMT_DestroyMisc +subroutine DBEMT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(DBEMT_MiscVarType), intent(in) :: SrcMiscData + type(DBEMT_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DBEMT_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%FirstWarn_tau1 = SrcMiscData%FirstWarn_tau1 +end subroutine +subroutine DBEMT_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(DBEMT_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DBEMT_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine DBEMT_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(DBEMT_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'DBEMT_PackMisc' if (Buf%ErrStat >= AbortErrLev) return - ! FirstWarn_tau1 call RegPack(Buf, InData%FirstWarn_tau1) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -782,99 +672,79 @@ subroutine DBEMT_UnPackMisc(Buf, OutData) type(DBEMT_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DBEMT_UnPackMisc' if (Buf%ErrStat /= ErrID_None) return - ! FirstWarn_tau1 call RegUnpack(Buf, OutData%FirstWarn_tau1) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE DBEMT_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DBEMT_ParameterType), INTENT(IN) :: SrcParamData - TYPE(DBEMT_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_CopyParam' -! + +subroutine DBEMT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(DBEMT_ParameterType), intent(in) :: SrcParamData + type(DBEMT_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'DBEMT_CopyParam' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT - DstParamData%lin_nx = SrcParamData%lin_nx - DstParamData%NumBlades = SrcParamData%NumBlades - DstParamData%NumNodes = SrcParamData%NumNodes - DstParamData%k_0ye = SrcParamData%k_0ye - DstParamData%tau1_const = SrcParamData%tau1_const -IF (ALLOCATED(SrcParamData%spanRatio)) THEN - i1_l = LBOUND(SrcParamData%spanRatio,1) - i1_u = UBOUND(SrcParamData%spanRatio,1) - i2_l = LBOUND(SrcParamData%spanRatio,2) - i2_u = UBOUND(SrcParamData%spanRatio,2) - IF (.NOT. ALLOCATED(DstParamData%spanRatio)) THEN - ALLOCATE(DstParamData%spanRatio(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%spanRatio.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%spanRatio = SrcParamData%spanRatio -ENDIF - DstParamData%DBEMT_Mod = SrcParamData%DBEMT_Mod - END SUBROUTINE DBEMT_CopyParam - - SUBROUTINE DBEMT_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(DBEMT_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%spanRatio)) THEN - DEALLOCATE(ParamData%spanRatio) -ENDIF - END SUBROUTINE DBEMT_DestroyParam + ErrMsg = '' + DstParamData%DT = SrcParamData%DT + DstParamData%lin_nx = SrcParamData%lin_nx + DstParamData%NumBlades = SrcParamData%NumBlades + DstParamData%NumNodes = SrcParamData%NumNodes + DstParamData%k_0ye = SrcParamData%k_0ye + DstParamData%tau1_const = SrcParamData%tau1_const + if (allocated(SrcParamData%spanRatio)) then + LB(1:2) = lbound(SrcParamData%spanRatio) + UB(1:2) = ubound(SrcParamData%spanRatio) + if (.not. allocated(DstParamData%spanRatio)) then + allocate(DstParamData%spanRatio(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%spanRatio.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%spanRatio = SrcParamData%spanRatio + else if (allocated(DstParamData%spanRatio)) then + deallocate(DstParamData%spanRatio) + end if + DstParamData%DBEMT_Mod = SrcParamData%DBEMT_Mod +end subroutine +subroutine DBEMT_DestroyParam(ParamData, ErrStat, ErrMsg) + type(DBEMT_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DBEMT_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%spanRatio)) then + deallocate(ParamData%spanRatio) + end if +end subroutine subroutine DBEMT_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(DBEMT_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'DBEMT_PackParam' if (Buf%ErrStat >= AbortErrLev) return - ! DT call RegPack(Buf, InData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! lin_nx call RegPack(Buf, InData%lin_nx) if (RegCheckErr(Buf, RoutineName)) return - ! NumBlades call RegPack(Buf, InData%NumBlades) if (RegCheckErr(Buf, RoutineName)) return - ! NumNodes call RegPack(Buf, InData%NumNodes) if (RegCheckErr(Buf, RoutineName)) return - ! k_0ye call RegPack(Buf, InData%k_0ye) if (RegCheckErr(Buf, RoutineName)) return - ! tau1_const call RegPack(Buf, InData%tau1_const) if (RegCheckErr(Buf, RoutineName)) return - ! spanRatio call RegPack(Buf, allocated(InData%spanRatio)) if (allocated(InData%spanRatio)) then call RegPackBounds(Buf, 2, lbound(InData%spanRatio), ubound(InData%spanRatio)) call RegPack(Buf, InData%spanRatio) end if if (RegCheckErr(Buf, RoutineName)) return - ! DBEMT_Mod call RegPack(Buf, InData%DBEMT_Mod) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -887,25 +757,18 @@ subroutine DBEMT_UnPackParam(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! DT call RegUnpack(Buf, OutData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! lin_nx call RegUnpack(Buf, OutData%lin_nx) if (RegCheckErr(Buf, RoutineName)) return - ! NumBlades call RegUnpack(Buf, OutData%NumBlades) if (RegCheckErr(Buf, RoutineName)) return - ! NumNodes call RegUnpack(Buf, OutData%NumNodes) if (RegCheckErr(Buf, RoutineName)) return - ! k_0ye call RegUnpack(Buf, OutData%k_0ye) if (RegCheckErr(Buf, RoutineName)) return - ! tau1_const call RegUnpack(Buf, OutData%tau1_const) if (RegCheckErr(Buf, RoutineName)) return - ! spanRatio if (allocated(OutData%spanRatio)) deallocate(OutData%spanRatio) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -920,54 +783,39 @@ subroutine DBEMT_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%spanRatio) if (RegCheckErr(Buf, RoutineName)) return end if - ! DBEMT_Mod call RegUnpack(Buf, OutData%DBEMT_Mod) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE DBEMT_CopyElementInputType( SrcElementInputTypeData, DstElementInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DBEMT_ElementInputType), INTENT(IN) :: SrcElementInputTypeData - TYPE(DBEMT_ElementInputType), INTENT(INOUT) :: DstElementInputTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_CopyElementInputType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstElementInputTypeData%vind_s = SrcElementInputTypeData%vind_s - DstElementInputTypeData%spanRatio = SrcElementInputTypeData%spanRatio - END SUBROUTINE DBEMT_CopyElementInputType - - SUBROUTINE DBEMT_DestroyElementInputType( ElementInputTypeData, ErrStat, ErrMsg ) - TYPE(DBEMT_ElementInputType), INTENT(INOUT) :: ElementInputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyElementInputType' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE DBEMT_DestroyElementInputType +subroutine DBEMT_CopyElementInputType(SrcElementInputTypeData, DstElementInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(DBEMT_ElementInputType), intent(in) :: SrcElementInputTypeData + type(DBEMT_ElementInputType), intent(inout) :: DstElementInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DBEMT_CopyElementInputType' + ErrStat = ErrID_None + ErrMsg = '' + DstElementInputTypeData%vind_s = SrcElementInputTypeData%vind_s + DstElementInputTypeData%spanRatio = SrcElementInputTypeData%spanRatio +end subroutine +subroutine DBEMT_DestroyElementInputType(ElementInputTypeData, ErrStat, ErrMsg) + type(DBEMT_ElementInputType), intent(inout) :: ElementInputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DBEMT_DestroyElementInputType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine DBEMT_PackElementInputType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(DBEMT_ElementInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'DBEMT_PackElementInputType' if (Buf%ErrStat >= AbortErrLev) return - ! vind_s call RegPack(Buf, InData%vind_s) if (RegCheckErr(Buf, RoutineName)) return - ! spanRatio call RegPack(Buf, InData%spanRatio) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -977,78 +825,73 @@ subroutine DBEMT_UnPackElementInputType(Buf, OutData) type(DBEMT_ElementInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DBEMT_UnPackElementInputType' if (Buf%ErrStat /= ErrID_None) return - ! vind_s call RegUnpack(Buf, OutData%vind_s) if (RegCheckErr(Buf, RoutineName)) return - ! spanRatio call RegUnpack(Buf, OutData%spanRatio) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE DBEMT_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DBEMT_InputType), INTENT(IN) :: SrcInputData - TYPE(DBEMT_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_CopyInput' -! + +subroutine DBEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(DBEMT_InputType), intent(in) :: SrcInputData + type(DBEMT_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DBEMT_CopyInput' ErrStat = ErrID_None - ErrMsg = "" - DstInputData%AxInd_disk = SrcInputData%AxInd_disk - DstInputData%Un_disk = SrcInputData%Un_disk - DstInputData%R_disk = SrcInputData%R_disk -IF (ALLOCATED(SrcInputData%element)) THEN - i1_l = LBOUND(SrcInputData%element,1) - i1_u = UBOUND(SrcInputData%element,1) - i2_l = LBOUND(SrcInputData%element,2) - i2_u = UBOUND(SrcInputData%element,2) - IF (.NOT. ALLOCATED(DstInputData%element)) THEN - ALLOCATE(DstInputData%element(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%element.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcInputData%element,2), UBOUND(SrcInputData%element,2) - DO i1 = LBOUND(SrcInputData%element,1), UBOUND(SrcInputData%element,1) - CALL DBEMT_Copyelementinputtype( SrcInputData%element(i1,i2), DstInputData%element(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF - END SUBROUTINE DBEMT_CopyInput - - SUBROUTINE DBEMT_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(DBEMT_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputData%element)) THEN -DO i2 = LBOUND(InputData%element,2), UBOUND(InputData%element,2) -DO i1 = LBOUND(InputData%element,1), UBOUND(InputData%element,1) - CALL DBEMT_DestroyElementInputType( InputData%element(i1,i2), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(InputData%element) -ENDIF - END SUBROUTINE DBEMT_DestroyInput + ErrMsg = '' + DstInputData%AxInd_disk = SrcInputData%AxInd_disk + DstInputData%Un_disk = SrcInputData%Un_disk + DstInputData%R_disk = SrcInputData%R_disk + if (allocated(SrcInputData%element)) then + LB(1:2) = lbound(SrcInputData%element) + UB(1:2) = ubound(SrcInputData%element) + if (.not. allocated(DstInputData%element)) then + allocate(DstInputData%element(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%element.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call DBEMT_CopyElementInputType(SrcInputData%element(i1,i2), DstInputData%element(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + else if (allocated(DstInputData%element)) then + deallocate(DstInputData%element) + end if +end subroutine +subroutine DBEMT_DestroyInput(InputData, ErrStat, ErrMsg) + type(DBEMT_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DBEMT_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%element)) then + LB(1:2) = lbound(InputData%element) + UB(1:2) = ubound(InputData%element) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call DBEMT_DestroyElementInputType(InputData%element(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(InputData%element) + end if +end subroutine subroutine DBEMT_PackInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -1057,16 +900,12 @@ subroutine DBEMT_PackInput(Buf, Indata) integer(IntKi) :: i1, i2 integer(IntKi) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return - ! AxInd_disk call RegPack(Buf, InData%AxInd_disk) if (RegCheckErr(Buf, RoutineName)) return - ! Un_disk call RegPack(Buf, InData%Un_disk) if (RegCheckErr(Buf, RoutineName)) return - ! R_disk call RegPack(Buf, InData%R_disk) if (RegCheckErr(Buf, RoutineName)) return - ! element call RegPack(Buf, allocated(InData%element)) if (allocated(InData%element)) then call RegPackBounds(Buf, 2, lbound(InData%element), ubound(InData%element)) @@ -1090,16 +929,12 @@ subroutine DBEMT_UnPackInput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! AxInd_disk call RegUnpack(Buf, OutData%AxInd_disk) if (RegCheckErr(Buf, RoutineName)) return - ! Un_disk call RegUnpack(Buf, OutData%Un_disk) if (RegCheckErr(Buf, RoutineName)) return - ! R_disk call RegUnpack(Buf, OutData%R_disk) if (RegCheckErr(Buf, RoutineName)) return - ! element if (allocated(OutData%element)) deallocate(OutData%element) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1118,66 +953,51 @@ subroutine DBEMT_UnPackInput(Buf, OutData) end do end if end subroutine - SUBROUTINE DBEMT_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DBEMT_OutputType), INTENT(IN) :: SrcOutputData - TYPE(DBEMT_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_CopyOutput' -! + +subroutine DBEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(DBEMT_OutputType), intent(in) :: SrcOutputData + type(DBEMT_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'DBEMT_CopyOutput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%vind)) THEN - i1_l = LBOUND(SrcOutputData%vind,1) - i1_u = UBOUND(SrcOutputData%vind,1) - i2_l = LBOUND(SrcOutputData%vind,2) - i2_u = UBOUND(SrcOutputData%vind,2) - i3_l = LBOUND(SrcOutputData%vind,3) - i3_u = UBOUND(SrcOutputData%vind,3) - IF (.NOT. ALLOCATED(DstOutputData%vind)) THEN - ALLOCATE(DstOutputData%vind(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%vind.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%vind = SrcOutputData%vind -ENDIF - END SUBROUTINE DBEMT_CopyOutput - - SUBROUTINE DBEMT_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(DBEMT_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OutputData%vind)) THEN - DEALLOCATE(OutputData%vind) -ENDIF - END SUBROUTINE DBEMT_DestroyOutput + ErrMsg = '' + if (allocated(SrcOutputData%vind)) then + LB(1:3) = lbound(SrcOutputData%vind) + UB(1:3) = ubound(SrcOutputData%vind) + if (.not. allocated(DstOutputData%vind)) then + allocate(DstOutputData%vind(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%vind.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%vind = SrcOutputData%vind + else if (allocated(DstOutputData%vind)) then + deallocate(DstOutputData%vind) + end if +end subroutine +subroutine DBEMT_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(DBEMT_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DBEMT_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%vind)) then + deallocate(OutputData%vind) + end if +end subroutine subroutine DBEMT_PackOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(DBEMT_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'DBEMT_PackOutput' if (Buf%ErrStat >= AbortErrLev) return - ! vind call RegPack(Buf, allocated(InData%vind)) if (allocated(InData%vind)) then call RegPackBounds(Buf, 3, lbound(InData%vind), ubound(InData%vind)) @@ -1194,7 +1014,6 @@ subroutine DBEMT_UnPackOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! vind if (allocated(OutData%vind)) deallocate(OutData%vind) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/aerodyn/src/FVW_Types.f90 b/modules/aerodyn/src/FVW_Types.f90 index e4a045646f..a9780657b5 100644 --- a/modules/aerodyn/src/FVW_Types.f90 +++ b/modules/aerodyn/src/FVW_Types.f90 @@ -355,161 +355,123 @@ MODULE FVW_Types END TYPE FVW_InitOutputType ! ======================= CONTAINS - SUBROUTINE FVW_CopyGridOutType( SrcGridOutTypeData, DstGridOutTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(GridOutType), INTENT(IN) :: SrcGridOutTypeData - TYPE(GridOutType), INTENT(INOUT) :: DstGridOutTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_CopyGridOutType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstGridOutTypeData%name = SrcGridOutTypeData%name - DstGridOutTypeData%type = SrcGridOutTypeData%type - DstGridOutTypeData%tStart = SrcGridOutTypeData%tStart - DstGridOutTypeData%tEnd = SrcGridOutTypeData%tEnd - DstGridOutTypeData%DTout = SrcGridOutTypeData%DTout - DstGridOutTypeData%xStart = SrcGridOutTypeData%xStart - DstGridOutTypeData%yStart = SrcGridOutTypeData%yStart - DstGridOutTypeData%zStart = SrcGridOutTypeData%zStart - DstGridOutTypeData%xEnd = SrcGridOutTypeData%xEnd - DstGridOutTypeData%yEnd = SrcGridOutTypeData%yEnd - DstGridOutTypeData%zEnd = SrcGridOutTypeData%zEnd - DstGridOutTypeData%nx = SrcGridOutTypeData%nx - DstGridOutTypeData%ny = SrcGridOutTypeData%ny - DstGridOutTypeData%nz = SrcGridOutTypeData%nz -IF (ALLOCATED(SrcGridOutTypeData%uGrid)) THEN - i1_l = LBOUND(SrcGridOutTypeData%uGrid,1) - i1_u = UBOUND(SrcGridOutTypeData%uGrid,1) - i2_l = LBOUND(SrcGridOutTypeData%uGrid,2) - i2_u = UBOUND(SrcGridOutTypeData%uGrid,2) - i3_l = LBOUND(SrcGridOutTypeData%uGrid,3) - i3_u = UBOUND(SrcGridOutTypeData%uGrid,3) - i4_l = LBOUND(SrcGridOutTypeData%uGrid,4) - i4_u = UBOUND(SrcGridOutTypeData%uGrid,4) - IF (.NOT. ALLOCATED(DstGridOutTypeData%uGrid)) THEN - ALLOCATE(DstGridOutTypeData%uGrid(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstGridOutTypeData%uGrid.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstGridOutTypeData%uGrid = SrcGridOutTypeData%uGrid -ENDIF -IF (ALLOCATED(SrcGridOutTypeData%omGrid)) THEN - i1_l = LBOUND(SrcGridOutTypeData%omGrid,1) - i1_u = UBOUND(SrcGridOutTypeData%omGrid,1) - i2_l = LBOUND(SrcGridOutTypeData%omGrid,2) - i2_u = UBOUND(SrcGridOutTypeData%omGrid,2) - i3_l = LBOUND(SrcGridOutTypeData%omGrid,3) - i3_u = UBOUND(SrcGridOutTypeData%omGrid,3) - i4_l = LBOUND(SrcGridOutTypeData%omGrid,4) - i4_u = UBOUND(SrcGridOutTypeData%omGrid,4) - IF (.NOT. ALLOCATED(DstGridOutTypeData%omGrid)) THEN - ALLOCATE(DstGridOutTypeData%omGrid(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstGridOutTypeData%omGrid.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstGridOutTypeData%omGrid = SrcGridOutTypeData%omGrid -ENDIF - DstGridOutTypeData%tLastOutput = SrcGridOutTypeData%tLastOutput - END SUBROUTINE FVW_CopyGridOutType - - SUBROUTINE FVW_DestroyGridOutType( GridOutTypeData, ErrStat, ErrMsg ) - TYPE(GridOutType), INTENT(INOUT) :: GridOutTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyGridOutType' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(GridOutTypeData%uGrid)) THEN - DEALLOCATE(GridOutTypeData%uGrid) -ENDIF -IF (ALLOCATED(GridOutTypeData%omGrid)) THEN - DEALLOCATE(GridOutTypeData%omGrid) -ENDIF - END SUBROUTINE FVW_DestroyGridOutType +subroutine FVW_CopyGridOutType(SrcGridOutTypeData, DstGridOutTypeData, CtrlCode, ErrStat, ErrMsg) + type(GridOutType), intent(in) :: SrcGridOutTypeData + type(GridOutType), intent(inout) :: DstGridOutTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FVW_CopyGridOutType' + ErrStat = ErrID_None + ErrMsg = '' + DstGridOutTypeData%name = SrcGridOutTypeData%name + DstGridOutTypeData%type = SrcGridOutTypeData%type + DstGridOutTypeData%tStart = SrcGridOutTypeData%tStart + DstGridOutTypeData%tEnd = SrcGridOutTypeData%tEnd + DstGridOutTypeData%DTout = SrcGridOutTypeData%DTout + DstGridOutTypeData%xStart = SrcGridOutTypeData%xStart + DstGridOutTypeData%yStart = SrcGridOutTypeData%yStart + DstGridOutTypeData%zStart = SrcGridOutTypeData%zStart + DstGridOutTypeData%xEnd = SrcGridOutTypeData%xEnd + DstGridOutTypeData%yEnd = SrcGridOutTypeData%yEnd + DstGridOutTypeData%zEnd = SrcGridOutTypeData%zEnd + DstGridOutTypeData%nx = SrcGridOutTypeData%nx + DstGridOutTypeData%ny = SrcGridOutTypeData%ny + DstGridOutTypeData%nz = SrcGridOutTypeData%nz + if (allocated(SrcGridOutTypeData%uGrid)) then + LB(1:4) = lbound(SrcGridOutTypeData%uGrid) + UB(1:4) = ubound(SrcGridOutTypeData%uGrid) + if (.not. allocated(DstGridOutTypeData%uGrid)) then + allocate(DstGridOutTypeData%uGrid(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstGridOutTypeData%uGrid.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstGridOutTypeData%uGrid = SrcGridOutTypeData%uGrid + else if (allocated(DstGridOutTypeData%uGrid)) then + deallocate(DstGridOutTypeData%uGrid) + end if + if (allocated(SrcGridOutTypeData%omGrid)) then + LB(1:4) = lbound(SrcGridOutTypeData%omGrid) + UB(1:4) = ubound(SrcGridOutTypeData%omGrid) + if (.not. allocated(DstGridOutTypeData%omGrid)) then + allocate(DstGridOutTypeData%omGrid(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstGridOutTypeData%omGrid.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstGridOutTypeData%omGrid = SrcGridOutTypeData%omGrid + else if (allocated(DstGridOutTypeData%omGrid)) then + deallocate(DstGridOutTypeData%omGrid) + end if + DstGridOutTypeData%tLastOutput = SrcGridOutTypeData%tLastOutput +end subroutine +subroutine FVW_DestroyGridOutType(GridOutTypeData, ErrStat, ErrMsg) + type(GridOutType), intent(inout) :: GridOutTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FVW_DestroyGridOutType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(GridOutTypeData%uGrid)) then + deallocate(GridOutTypeData%uGrid) + end if + if (allocated(GridOutTypeData%omGrid)) then + deallocate(GridOutTypeData%omGrid) + end if +end subroutine subroutine FVW_PackGridOutType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(GridOutType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackGridOutType' if (Buf%ErrStat >= AbortErrLev) return - ! name call RegPack(Buf, InData%name) if (RegCheckErr(Buf, RoutineName)) return - ! type call RegPack(Buf, InData%type) if (RegCheckErr(Buf, RoutineName)) return - ! tStart call RegPack(Buf, InData%tStart) if (RegCheckErr(Buf, RoutineName)) return - ! tEnd call RegPack(Buf, InData%tEnd) if (RegCheckErr(Buf, RoutineName)) return - ! DTout call RegPack(Buf, InData%DTout) if (RegCheckErr(Buf, RoutineName)) return - ! xStart call RegPack(Buf, InData%xStart) if (RegCheckErr(Buf, RoutineName)) return - ! yStart call RegPack(Buf, InData%yStart) if (RegCheckErr(Buf, RoutineName)) return - ! zStart call RegPack(Buf, InData%zStart) if (RegCheckErr(Buf, RoutineName)) return - ! xEnd call RegPack(Buf, InData%xEnd) if (RegCheckErr(Buf, RoutineName)) return - ! yEnd call RegPack(Buf, InData%yEnd) if (RegCheckErr(Buf, RoutineName)) return - ! zEnd call RegPack(Buf, InData%zEnd) if (RegCheckErr(Buf, RoutineName)) return - ! nx call RegPack(Buf, InData%nx) if (RegCheckErr(Buf, RoutineName)) return - ! ny call RegPack(Buf, InData%ny) if (RegCheckErr(Buf, RoutineName)) return - ! nz call RegPack(Buf, InData%nz) if (RegCheckErr(Buf, RoutineName)) return - ! uGrid call RegPack(Buf, allocated(InData%uGrid)) if (allocated(InData%uGrid)) then call RegPackBounds(Buf, 4, lbound(InData%uGrid), ubound(InData%uGrid)) call RegPack(Buf, InData%uGrid) end if if (RegCheckErr(Buf, RoutineName)) return - ! omGrid call RegPack(Buf, allocated(InData%omGrid)) if (allocated(InData%omGrid)) then call RegPackBounds(Buf, 4, lbound(InData%omGrid), ubound(InData%omGrid)) call RegPack(Buf, InData%omGrid) end if if (RegCheckErr(Buf, RoutineName)) return - ! tLastOutput call RegPack(Buf, InData%tLastOutput) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -522,49 +484,34 @@ subroutine FVW_UnPackGridOutType(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! name call RegUnpack(Buf, OutData%name) if (RegCheckErr(Buf, RoutineName)) return - ! type call RegUnpack(Buf, OutData%type) if (RegCheckErr(Buf, RoutineName)) return - ! tStart call RegUnpack(Buf, OutData%tStart) if (RegCheckErr(Buf, RoutineName)) return - ! tEnd call RegUnpack(Buf, OutData%tEnd) if (RegCheckErr(Buf, RoutineName)) return - ! DTout call RegUnpack(Buf, OutData%DTout) if (RegCheckErr(Buf, RoutineName)) return - ! xStart call RegUnpack(Buf, OutData%xStart) if (RegCheckErr(Buf, RoutineName)) return - ! yStart call RegUnpack(Buf, OutData%yStart) if (RegCheckErr(Buf, RoutineName)) return - ! zStart call RegUnpack(Buf, OutData%zStart) if (RegCheckErr(Buf, RoutineName)) return - ! xEnd call RegUnpack(Buf, OutData%xEnd) if (RegCheckErr(Buf, RoutineName)) return - ! yEnd call RegUnpack(Buf, OutData%yEnd) if (RegCheckErr(Buf, RoutineName)) return - ! zEnd call RegUnpack(Buf, OutData%zEnd) if (RegCheckErr(Buf, RoutineName)) return - ! nx call RegUnpack(Buf, OutData%nx) if (RegCheckErr(Buf, RoutineName)) return - ! ny call RegUnpack(Buf, OutData%ny) if (RegCheckErr(Buf, RoutineName)) return - ! nz call RegUnpack(Buf, OutData%nz) if (RegCheckErr(Buf, RoutineName)) return - ! uGrid if (allocated(OutData%uGrid)) deallocate(OutData%uGrid) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -579,7 +526,6 @@ subroutine FVW_UnPackGridOutType(Buf, OutData) call RegUnpack(Buf, OutData%uGrid) if (RegCheckErr(Buf, RoutineName)) return end if - ! omGrid if (allocated(OutData%omGrid)) deallocate(OutData%omGrid) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -594,151 +540,136 @@ subroutine FVW_UnPackGridOutType(Buf, OutData) call RegUnpack(Buf, OutData%omGrid) if (RegCheckErr(Buf, RoutineName)) return end if - ! tLastOutput call RegUnpack(Buf, OutData%tLastOutput) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE FVW_CopyT_Sgmt( SrcT_SgmtData, DstT_SgmtData, CtrlCode, ErrStat, ErrMsg ) - TYPE(T_Sgmt), INTENT(IN) :: SrcT_SgmtData - TYPE(T_Sgmt), INTENT(INOUT) :: DstT_SgmtData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_CopyT_Sgmt' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcT_SgmtData%Points)) THEN - i1_l = LBOUND(SrcT_SgmtData%Points,1) - i1_u = UBOUND(SrcT_SgmtData%Points,1) - i2_l = LBOUND(SrcT_SgmtData%Points,2) - i2_u = UBOUND(SrcT_SgmtData%Points,2) - IF (.NOT. ALLOCATED(DstT_SgmtData%Points)) THEN - ALLOCATE(DstT_SgmtData%Points(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstT_SgmtData%Points.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstT_SgmtData%Points = SrcT_SgmtData%Points -ENDIF -IF (ALLOCATED(SrcT_SgmtData%Connct)) THEN - i1_l = LBOUND(SrcT_SgmtData%Connct,1) - i1_u = UBOUND(SrcT_SgmtData%Connct,1) - i2_l = LBOUND(SrcT_SgmtData%Connct,2) - i2_u = UBOUND(SrcT_SgmtData%Connct,2) - IF (.NOT. ALLOCATED(DstT_SgmtData%Connct)) THEN - ALLOCATE(DstT_SgmtData%Connct(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstT_SgmtData%Connct.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstT_SgmtData%Connct = SrcT_SgmtData%Connct -ENDIF -IF (ALLOCATED(SrcT_SgmtData%Gamma)) THEN - i1_l = LBOUND(SrcT_SgmtData%Gamma,1) - i1_u = UBOUND(SrcT_SgmtData%Gamma,1) - IF (.NOT. ALLOCATED(DstT_SgmtData%Gamma)) THEN - ALLOCATE(DstT_SgmtData%Gamma(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstT_SgmtData%Gamma.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstT_SgmtData%Gamma = SrcT_SgmtData%Gamma -ENDIF -IF (ALLOCATED(SrcT_SgmtData%Epsilon)) THEN - i1_l = LBOUND(SrcT_SgmtData%Epsilon,1) - i1_u = UBOUND(SrcT_SgmtData%Epsilon,1) - IF (.NOT. ALLOCATED(DstT_SgmtData%Epsilon)) THEN - ALLOCATE(DstT_SgmtData%Epsilon(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstT_SgmtData%Epsilon.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstT_SgmtData%Epsilon = SrcT_SgmtData%Epsilon -ENDIF - DstT_SgmtData%RegFunction = SrcT_SgmtData%RegFunction - DstT_SgmtData%nAct = SrcT_SgmtData%nAct - DstT_SgmtData%nActP = SrcT_SgmtData%nActP - END SUBROUTINE FVW_CopyT_Sgmt - - SUBROUTINE FVW_DestroyT_Sgmt( T_SgmtData, ErrStat, ErrMsg ) - TYPE(T_Sgmt), INTENT(INOUT) :: T_SgmtData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyT_Sgmt' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(T_SgmtData%Points)) THEN - DEALLOCATE(T_SgmtData%Points) -ENDIF -IF (ALLOCATED(T_SgmtData%Connct)) THEN - DEALLOCATE(T_SgmtData%Connct) -ENDIF -IF (ALLOCATED(T_SgmtData%Gamma)) THEN - DEALLOCATE(T_SgmtData%Gamma) -ENDIF -IF (ALLOCATED(T_SgmtData%Epsilon)) THEN - DEALLOCATE(T_SgmtData%Epsilon) -ENDIF - END SUBROUTINE FVW_DestroyT_Sgmt +subroutine FVW_CopyT_Sgmt(SrcT_SgmtData, DstT_SgmtData, CtrlCode, ErrStat, ErrMsg) + type(T_Sgmt), intent(in) :: SrcT_SgmtData + type(T_Sgmt), intent(inout) :: DstT_SgmtData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FVW_CopyT_Sgmt' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcT_SgmtData%Points)) then + LB(1:2) = lbound(SrcT_SgmtData%Points) + UB(1:2) = ubound(SrcT_SgmtData%Points) + if (.not. allocated(DstT_SgmtData%Points)) then + allocate(DstT_SgmtData%Points(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstT_SgmtData%Points.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstT_SgmtData%Points = SrcT_SgmtData%Points + else if (allocated(DstT_SgmtData%Points)) then + deallocate(DstT_SgmtData%Points) + end if + if (allocated(SrcT_SgmtData%Connct)) then + LB(1:2) = lbound(SrcT_SgmtData%Connct) + UB(1:2) = ubound(SrcT_SgmtData%Connct) + if (.not. allocated(DstT_SgmtData%Connct)) then + allocate(DstT_SgmtData%Connct(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstT_SgmtData%Connct.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstT_SgmtData%Connct = SrcT_SgmtData%Connct + else if (allocated(DstT_SgmtData%Connct)) then + deallocate(DstT_SgmtData%Connct) + end if + if (allocated(SrcT_SgmtData%Gamma)) then + LB(1:1) = lbound(SrcT_SgmtData%Gamma) + UB(1:1) = ubound(SrcT_SgmtData%Gamma) + if (.not. allocated(DstT_SgmtData%Gamma)) then + allocate(DstT_SgmtData%Gamma(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstT_SgmtData%Gamma.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstT_SgmtData%Gamma = SrcT_SgmtData%Gamma + else if (allocated(DstT_SgmtData%Gamma)) then + deallocate(DstT_SgmtData%Gamma) + end if + if (allocated(SrcT_SgmtData%Epsilon)) then + LB(1:1) = lbound(SrcT_SgmtData%Epsilon) + UB(1:1) = ubound(SrcT_SgmtData%Epsilon) + if (.not. allocated(DstT_SgmtData%Epsilon)) then + allocate(DstT_SgmtData%Epsilon(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstT_SgmtData%Epsilon.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstT_SgmtData%Epsilon = SrcT_SgmtData%Epsilon + else if (allocated(DstT_SgmtData%Epsilon)) then + deallocate(DstT_SgmtData%Epsilon) + end if + DstT_SgmtData%RegFunction = SrcT_SgmtData%RegFunction + DstT_SgmtData%nAct = SrcT_SgmtData%nAct + DstT_SgmtData%nActP = SrcT_SgmtData%nActP +end subroutine +subroutine FVW_DestroyT_Sgmt(T_SgmtData, ErrStat, ErrMsg) + type(T_Sgmt), intent(inout) :: T_SgmtData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FVW_DestroyT_Sgmt' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(T_SgmtData%Points)) then + deallocate(T_SgmtData%Points) + end if + if (allocated(T_SgmtData%Connct)) then + deallocate(T_SgmtData%Connct) + end if + if (allocated(T_SgmtData%Gamma)) then + deallocate(T_SgmtData%Gamma) + end if + if (allocated(T_SgmtData%Epsilon)) then + deallocate(T_SgmtData%Epsilon) + end if +end subroutine subroutine FVW_PackT_Sgmt(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(T_Sgmt), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackT_Sgmt' if (Buf%ErrStat >= AbortErrLev) return - ! Points call RegPack(Buf, allocated(InData%Points)) if (allocated(InData%Points)) then call RegPackBounds(Buf, 2, lbound(InData%Points), ubound(InData%Points)) call RegPack(Buf, InData%Points) end if if (RegCheckErr(Buf, RoutineName)) return - ! Connct call RegPack(Buf, allocated(InData%Connct)) if (allocated(InData%Connct)) then call RegPackBounds(Buf, 2, lbound(InData%Connct), ubound(InData%Connct)) call RegPack(Buf, InData%Connct) end if if (RegCheckErr(Buf, RoutineName)) return - ! Gamma call RegPack(Buf, allocated(InData%Gamma)) if (allocated(InData%Gamma)) then call RegPackBounds(Buf, 1, lbound(InData%Gamma), ubound(InData%Gamma)) call RegPack(Buf, InData%Gamma) end if if (RegCheckErr(Buf, RoutineName)) return - ! Epsilon call RegPack(Buf, allocated(InData%Epsilon)) if (allocated(InData%Epsilon)) then call RegPackBounds(Buf, 1, lbound(InData%Epsilon), ubound(InData%Epsilon)) call RegPack(Buf, InData%Epsilon) end if if (RegCheckErr(Buf, RoutineName)) return - ! RegFunction call RegPack(Buf, InData%RegFunction) if (RegCheckErr(Buf, RoutineName)) return - ! nAct call RegPack(Buf, InData%nAct) if (RegCheckErr(Buf, RoutineName)) return - ! nActP call RegPack(Buf, InData%nActP) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -751,7 +682,6 @@ subroutine FVW_UnPackT_Sgmt(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! Points if (allocated(OutData%Points)) deallocate(OutData%Points) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -766,7 +696,6 @@ subroutine FVW_UnPackT_Sgmt(Buf, OutData) call RegUnpack(Buf, OutData%Points) if (RegCheckErr(Buf, RoutineName)) return end if - ! Connct if (allocated(OutData%Connct)) deallocate(OutData%Connct) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -781,7 +710,6 @@ subroutine FVW_UnPackT_Sgmt(Buf, OutData) call RegUnpack(Buf, OutData%Connct) if (RegCheckErr(Buf, RoutineName)) return end if - ! Gamma if (allocated(OutData%Gamma)) deallocate(OutData%Gamma) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -796,7 +724,6 @@ subroutine FVW_UnPackT_Sgmt(Buf, OutData) call RegUnpack(Buf, OutData%Gamma) if (RegCheckErr(Buf, RoutineName)) return end if - ! Epsilon if (allocated(OutData%Epsilon)) deallocate(OutData%Epsilon) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -811,131 +738,114 @@ subroutine FVW_UnPackT_Sgmt(Buf, OutData) call RegUnpack(Buf, OutData%Epsilon) if (RegCheckErr(Buf, RoutineName)) return end if - ! RegFunction call RegUnpack(Buf, OutData%RegFunction) if (RegCheckErr(Buf, RoutineName)) return - ! nAct call RegUnpack(Buf, OutData%nAct) if (RegCheckErr(Buf, RoutineName)) return - ! nActP call RegUnpack(Buf, OutData%nActP) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE FVW_CopyT_Part( SrcT_PartData, DstT_PartData, CtrlCode, ErrStat, ErrMsg ) - TYPE(T_Part), INTENT(IN) :: SrcT_PartData - TYPE(T_Part), INTENT(INOUT) :: DstT_PartData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_CopyT_Part' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcT_PartData%P)) THEN - i1_l = LBOUND(SrcT_PartData%P,1) - i1_u = UBOUND(SrcT_PartData%P,1) - i2_l = LBOUND(SrcT_PartData%P,2) - i2_u = UBOUND(SrcT_PartData%P,2) - IF (.NOT. ALLOCATED(DstT_PartData%P)) THEN - ALLOCATE(DstT_PartData%P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstT_PartData%P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstT_PartData%P = SrcT_PartData%P -ENDIF -IF (ALLOCATED(SrcT_PartData%Alpha)) THEN - i1_l = LBOUND(SrcT_PartData%Alpha,1) - i1_u = UBOUND(SrcT_PartData%Alpha,1) - i2_l = LBOUND(SrcT_PartData%Alpha,2) - i2_u = UBOUND(SrcT_PartData%Alpha,2) - IF (.NOT. ALLOCATED(DstT_PartData%Alpha)) THEN - ALLOCATE(DstT_PartData%Alpha(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstT_PartData%Alpha.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstT_PartData%Alpha = SrcT_PartData%Alpha -ENDIF -IF (ALLOCATED(SrcT_PartData%RegParam)) THEN - i1_l = LBOUND(SrcT_PartData%RegParam,1) - i1_u = UBOUND(SrcT_PartData%RegParam,1) - IF (.NOT. ALLOCATED(DstT_PartData%RegParam)) THEN - ALLOCATE(DstT_PartData%RegParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstT_PartData%RegParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstT_PartData%RegParam = SrcT_PartData%RegParam -ENDIF - DstT_PartData%RegFunction = SrcT_PartData%RegFunction - DstT_PartData%nAct = SrcT_PartData%nAct - END SUBROUTINE FVW_CopyT_Part - - SUBROUTINE FVW_DestroyT_Part( T_PartData, ErrStat, ErrMsg ) - TYPE(T_Part), INTENT(INOUT) :: T_PartData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyT_Part' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(T_PartData%P)) THEN - DEALLOCATE(T_PartData%P) -ENDIF -IF (ALLOCATED(T_PartData%Alpha)) THEN - DEALLOCATE(T_PartData%Alpha) -ENDIF -IF (ALLOCATED(T_PartData%RegParam)) THEN - DEALLOCATE(T_PartData%RegParam) -ENDIF - END SUBROUTINE FVW_DestroyT_Part +subroutine FVW_CopyT_Part(SrcT_PartData, DstT_PartData, CtrlCode, ErrStat, ErrMsg) + type(T_Part), intent(in) :: SrcT_PartData + type(T_Part), intent(inout) :: DstT_PartData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FVW_CopyT_Part' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcT_PartData%P)) then + LB(1:2) = lbound(SrcT_PartData%P) + UB(1:2) = ubound(SrcT_PartData%P) + if (.not. allocated(DstT_PartData%P)) then + allocate(DstT_PartData%P(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstT_PartData%P.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstT_PartData%P = SrcT_PartData%P + else if (allocated(DstT_PartData%P)) then + deallocate(DstT_PartData%P) + end if + if (allocated(SrcT_PartData%Alpha)) then + LB(1:2) = lbound(SrcT_PartData%Alpha) + UB(1:2) = ubound(SrcT_PartData%Alpha) + if (.not. allocated(DstT_PartData%Alpha)) then + allocate(DstT_PartData%Alpha(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstT_PartData%Alpha.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstT_PartData%Alpha = SrcT_PartData%Alpha + else if (allocated(DstT_PartData%Alpha)) then + deallocate(DstT_PartData%Alpha) + end if + if (allocated(SrcT_PartData%RegParam)) then + LB(1:1) = lbound(SrcT_PartData%RegParam) + UB(1:1) = ubound(SrcT_PartData%RegParam) + if (.not. allocated(DstT_PartData%RegParam)) then + allocate(DstT_PartData%RegParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstT_PartData%RegParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstT_PartData%RegParam = SrcT_PartData%RegParam + else if (allocated(DstT_PartData%RegParam)) then + deallocate(DstT_PartData%RegParam) + end if + DstT_PartData%RegFunction = SrcT_PartData%RegFunction + DstT_PartData%nAct = SrcT_PartData%nAct +end subroutine +subroutine FVW_DestroyT_Part(T_PartData, ErrStat, ErrMsg) + type(T_Part), intent(inout) :: T_PartData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FVW_DestroyT_Part' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(T_PartData%P)) then + deallocate(T_PartData%P) + end if + if (allocated(T_PartData%Alpha)) then + deallocate(T_PartData%Alpha) + end if + if (allocated(T_PartData%RegParam)) then + deallocate(T_PartData%RegParam) + end if +end subroutine subroutine FVW_PackT_Part(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(T_Part), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackT_Part' if (Buf%ErrStat >= AbortErrLev) return - ! P call RegPack(Buf, allocated(InData%P)) if (allocated(InData%P)) then call RegPackBounds(Buf, 2, lbound(InData%P), ubound(InData%P)) call RegPack(Buf, InData%P) end if if (RegCheckErr(Buf, RoutineName)) return - ! Alpha call RegPack(Buf, allocated(InData%Alpha)) if (allocated(InData%Alpha)) then call RegPackBounds(Buf, 2, lbound(InData%Alpha), ubound(InData%Alpha)) call RegPack(Buf, InData%Alpha) end if if (RegCheckErr(Buf, RoutineName)) return - ! RegParam call RegPack(Buf, allocated(InData%RegParam)) if (allocated(InData%RegParam)) then call RegPackBounds(Buf, 1, lbound(InData%RegParam), ubound(InData%RegParam)) call RegPack(Buf, InData%RegParam) end if if (RegCheckErr(Buf, RoutineName)) return - ! RegFunction call RegPack(Buf, InData%RegFunction) if (RegCheckErr(Buf, RoutineName)) return - ! nAct call RegPack(Buf, InData%nAct) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -948,7 +858,6 @@ subroutine FVW_UnPackT_Part(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! P if (allocated(OutData%P)) deallocate(OutData%P) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -963,7 +872,6 @@ subroutine FVW_UnPackT_Part(Buf, OutData) call RegUnpack(Buf, OutData%P) if (RegCheckErr(Buf, RoutineName)) return end if - ! Alpha if (allocated(OutData%Alpha)) deallocate(OutData%Alpha) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -978,7 +886,6 @@ subroutine FVW_UnPackT_Part(Buf, OutData) call RegUnpack(Buf, OutData%Alpha) if (RegCheckErr(Buf, RoutineName)) return end if - ! RegParam if (allocated(OutData%RegParam)) deallocate(OutData%RegParam) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -993,188 +900,177 @@ subroutine FVW_UnPackT_Part(Buf, OutData) call RegUnpack(Buf, OutData%RegParam) if (RegCheckErr(Buf, RoutineName)) return end if - ! RegFunction call RegUnpack(Buf, OutData%RegFunction) if (RegCheckErr(Buf, RoutineName)) return - ! nAct call RegUnpack(Buf, OutData%nAct) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE FVW_CopyWng_ParameterType( SrcWng_ParameterTypeData, DstWng_ParameterTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Wng_ParameterType), INTENT(IN) :: SrcWng_ParameterTypeData - TYPE(Wng_ParameterType), INTENT(INOUT) :: DstWng_ParameterTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_CopyWng_ParameterType' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcWng_ParameterTypeData%chord_LL)) THEN - i1_l = LBOUND(SrcWng_ParameterTypeData%chord_LL,1) - i1_u = UBOUND(SrcWng_ParameterTypeData%chord_LL,1) - IF (.NOT. ALLOCATED(DstWng_ParameterTypeData%chord_LL)) THEN - ALLOCATE(DstWng_ParameterTypeData%chord_LL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ParameterTypeData%chord_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_ParameterTypeData%chord_LL = SrcWng_ParameterTypeData%chord_LL -ENDIF -IF (ALLOCATED(SrcWng_ParameterTypeData%chord_CP)) THEN - i1_l = LBOUND(SrcWng_ParameterTypeData%chord_CP,1) - i1_u = UBOUND(SrcWng_ParameterTypeData%chord_CP,1) - IF (.NOT. ALLOCATED(DstWng_ParameterTypeData%chord_CP)) THEN - ALLOCATE(DstWng_ParameterTypeData%chord_CP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ParameterTypeData%chord_CP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_ParameterTypeData%chord_CP = SrcWng_ParameterTypeData%chord_CP -ENDIF -IF (ALLOCATED(SrcWng_ParameterTypeData%s_LL)) THEN - i1_l = LBOUND(SrcWng_ParameterTypeData%s_LL,1) - i1_u = UBOUND(SrcWng_ParameterTypeData%s_LL,1) - IF (.NOT. ALLOCATED(DstWng_ParameterTypeData%s_LL)) THEN - ALLOCATE(DstWng_ParameterTypeData%s_LL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ParameterTypeData%s_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_ParameterTypeData%s_LL = SrcWng_ParameterTypeData%s_LL -ENDIF -IF (ALLOCATED(SrcWng_ParameterTypeData%s_CP)) THEN - i1_l = LBOUND(SrcWng_ParameterTypeData%s_CP,1) - i1_u = UBOUND(SrcWng_ParameterTypeData%s_CP,1) - IF (.NOT. ALLOCATED(DstWng_ParameterTypeData%s_CP)) THEN - ALLOCATE(DstWng_ParameterTypeData%s_CP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ParameterTypeData%s_CP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_ParameterTypeData%s_CP = SrcWng_ParameterTypeData%s_CP -ENDIF - DstWng_ParameterTypeData%iRotor = SrcWng_ParameterTypeData%iRotor -IF (ALLOCATED(SrcWng_ParameterTypeData%AFindx)) THEN - i1_l = LBOUND(SrcWng_ParameterTypeData%AFindx,1) - i1_u = UBOUND(SrcWng_ParameterTypeData%AFindx,1) - i2_l = LBOUND(SrcWng_ParameterTypeData%AFindx,2) - i2_u = UBOUND(SrcWng_ParameterTypeData%AFindx,2) - IF (.NOT. ALLOCATED(DstWng_ParameterTypeData%AFindx)) THEN - ALLOCATE(DstWng_ParameterTypeData%AFindx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ParameterTypeData%AFindx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_ParameterTypeData%AFindx = SrcWng_ParameterTypeData%AFindx -ENDIF - DstWng_ParameterTypeData%nSpan = SrcWng_ParameterTypeData%nSpan -IF (ALLOCATED(SrcWng_ParameterTypeData%PrescribedCirculation)) THEN - i1_l = LBOUND(SrcWng_ParameterTypeData%PrescribedCirculation,1) - i1_u = UBOUND(SrcWng_ParameterTypeData%PrescribedCirculation,1) - IF (.NOT. ALLOCATED(DstWng_ParameterTypeData%PrescribedCirculation)) THEN - ALLOCATE(DstWng_ParameterTypeData%PrescribedCirculation(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ParameterTypeData%PrescribedCirculation.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_ParameterTypeData%PrescribedCirculation = SrcWng_ParameterTypeData%PrescribedCirculation -ENDIF - END SUBROUTINE FVW_CopyWng_ParameterType - - SUBROUTINE FVW_DestroyWng_ParameterType( Wng_ParameterTypeData, ErrStat, ErrMsg ) - TYPE(Wng_ParameterType), INTENT(INOUT) :: Wng_ParameterTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyWng_ParameterType' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(Wng_ParameterTypeData%chord_LL)) THEN - DEALLOCATE(Wng_ParameterTypeData%chord_LL) -ENDIF -IF (ALLOCATED(Wng_ParameterTypeData%chord_CP)) THEN - DEALLOCATE(Wng_ParameterTypeData%chord_CP) -ENDIF -IF (ALLOCATED(Wng_ParameterTypeData%s_LL)) THEN - DEALLOCATE(Wng_ParameterTypeData%s_LL) -ENDIF -IF (ALLOCATED(Wng_ParameterTypeData%s_CP)) THEN - DEALLOCATE(Wng_ParameterTypeData%s_CP) -ENDIF -IF (ALLOCATED(Wng_ParameterTypeData%AFindx)) THEN - DEALLOCATE(Wng_ParameterTypeData%AFindx) -ENDIF -IF (ALLOCATED(Wng_ParameterTypeData%PrescribedCirculation)) THEN - DEALLOCATE(Wng_ParameterTypeData%PrescribedCirculation) -ENDIF - END SUBROUTINE FVW_DestroyWng_ParameterType +subroutine FVW_CopyWng_ParameterType(SrcWng_ParameterTypeData, DstWng_ParameterTypeData, CtrlCode, ErrStat, ErrMsg) + type(Wng_ParameterType), intent(in) :: SrcWng_ParameterTypeData + type(Wng_ParameterType), intent(inout) :: DstWng_ParameterTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FVW_CopyWng_ParameterType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcWng_ParameterTypeData%chord_LL)) then + LB(1:1) = lbound(SrcWng_ParameterTypeData%chord_LL) + UB(1:1) = ubound(SrcWng_ParameterTypeData%chord_LL) + if (.not. allocated(DstWng_ParameterTypeData%chord_LL)) then + allocate(DstWng_ParameterTypeData%chord_LL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ParameterTypeData%chord_LL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_ParameterTypeData%chord_LL = SrcWng_ParameterTypeData%chord_LL + else if (allocated(DstWng_ParameterTypeData%chord_LL)) then + deallocate(DstWng_ParameterTypeData%chord_LL) + end if + if (allocated(SrcWng_ParameterTypeData%chord_CP)) then + LB(1:1) = lbound(SrcWng_ParameterTypeData%chord_CP) + UB(1:1) = ubound(SrcWng_ParameterTypeData%chord_CP) + if (.not. allocated(DstWng_ParameterTypeData%chord_CP)) then + allocate(DstWng_ParameterTypeData%chord_CP(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ParameterTypeData%chord_CP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_ParameterTypeData%chord_CP = SrcWng_ParameterTypeData%chord_CP + else if (allocated(DstWng_ParameterTypeData%chord_CP)) then + deallocate(DstWng_ParameterTypeData%chord_CP) + end if + if (allocated(SrcWng_ParameterTypeData%s_LL)) then + LB(1:1) = lbound(SrcWng_ParameterTypeData%s_LL) + UB(1:1) = ubound(SrcWng_ParameterTypeData%s_LL) + if (.not. allocated(DstWng_ParameterTypeData%s_LL)) then + allocate(DstWng_ParameterTypeData%s_LL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ParameterTypeData%s_LL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_ParameterTypeData%s_LL = SrcWng_ParameterTypeData%s_LL + else if (allocated(DstWng_ParameterTypeData%s_LL)) then + deallocate(DstWng_ParameterTypeData%s_LL) + end if + if (allocated(SrcWng_ParameterTypeData%s_CP)) then + LB(1:1) = lbound(SrcWng_ParameterTypeData%s_CP) + UB(1:1) = ubound(SrcWng_ParameterTypeData%s_CP) + if (.not. allocated(DstWng_ParameterTypeData%s_CP)) then + allocate(DstWng_ParameterTypeData%s_CP(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ParameterTypeData%s_CP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_ParameterTypeData%s_CP = SrcWng_ParameterTypeData%s_CP + else if (allocated(DstWng_ParameterTypeData%s_CP)) then + deallocate(DstWng_ParameterTypeData%s_CP) + end if + DstWng_ParameterTypeData%iRotor = SrcWng_ParameterTypeData%iRotor + if (allocated(SrcWng_ParameterTypeData%AFindx)) then + LB(1:2) = lbound(SrcWng_ParameterTypeData%AFindx) + UB(1:2) = ubound(SrcWng_ParameterTypeData%AFindx) + if (.not. allocated(DstWng_ParameterTypeData%AFindx)) then + allocate(DstWng_ParameterTypeData%AFindx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ParameterTypeData%AFindx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_ParameterTypeData%AFindx = SrcWng_ParameterTypeData%AFindx + else if (allocated(DstWng_ParameterTypeData%AFindx)) then + deallocate(DstWng_ParameterTypeData%AFindx) + end if + DstWng_ParameterTypeData%nSpan = SrcWng_ParameterTypeData%nSpan + if (allocated(SrcWng_ParameterTypeData%PrescribedCirculation)) then + LB(1:1) = lbound(SrcWng_ParameterTypeData%PrescribedCirculation) + UB(1:1) = ubound(SrcWng_ParameterTypeData%PrescribedCirculation) + if (.not. allocated(DstWng_ParameterTypeData%PrescribedCirculation)) then + allocate(DstWng_ParameterTypeData%PrescribedCirculation(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ParameterTypeData%PrescribedCirculation.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_ParameterTypeData%PrescribedCirculation = SrcWng_ParameterTypeData%PrescribedCirculation + else if (allocated(DstWng_ParameterTypeData%PrescribedCirculation)) then + deallocate(DstWng_ParameterTypeData%PrescribedCirculation) + end if +end subroutine +subroutine FVW_DestroyWng_ParameterType(Wng_ParameterTypeData, ErrStat, ErrMsg) + type(Wng_ParameterType), intent(inout) :: Wng_ParameterTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FVW_DestroyWng_ParameterType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(Wng_ParameterTypeData%chord_LL)) then + deallocate(Wng_ParameterTypeData%chord_LL) + end if + if (allocated(Wng_ParameterTypeData%chord_CP)) then + deallocate(Wng_ParameterTypeData%chord_CP) + end if + if (allocated(Wng_ParameterTypeData%s_LL)) then + deallocate(Wng_ParameterTypeData%s_LL) + end if + if (allocated(Wng_ParameterTypeData%s_CP)) then + deallocate(Wng_ParameterTypeData%s_CP) + end if + if (allocated(Wng_ParameterTypeData%AFindx)) then + deallocate(Wng_ParameterTypeData%AFindx) + end if + if (allocated(Wng_ParameterTypeData%PrescribedCirculation)) then + deallocate(Wng_ParameterTypeData%PrescribedCirculation) + end if +end subroutine subroutine FVW_PackWng_ParameterType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Wng_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackWng_ParameterType' if (Buf%ErrStat >= AbortErrLev) return - ! chord_LL call RegPack(Buf, allocated(InData%chord_LL)) if (allocated(InData%chord_LL)) then call RegPackBounds(Buf, 1, lbound(InData%chord_LL), ubound(InData%chord_LL)) call RegPack(Buf, InData%chord_LL) end if if (RegCheckErr(Buf, RoutineName)) return - ! chord_CP call RegPack(Buf, allocated(InData%chord_CP)) if (allocated(InData%chord_CP)) then call RegPackBounds(Buf, 1, lbound(InData%chord_CP), ubound(InData%chord_CP)) call RegPack(Buf, InData%chord_CP) end if if (RegCheckErr(Buf, RoutineName)) return - ! s_LL call RegPack(Buf, allocated(InData%s_LL)) if (allocated(InData%s_LL)) then call RegPackBounds(Buf, 1, lbound(InData%s_LL), ubound(InData%s_LL)) call RegPack(Buf, InData%s_LL) end if if (RegCheckErr(Buf, RoutineName)) return - ! s_CP call RegPack(Buf, allocated(InData%s_CP)) if (allocated(InData%s_CP)) then call RegPackBounds(Buf, 1, lbound(InData%s_CP), ubound(InData%s_CP)) call RegPack(Buf, InData%s_CP) end if if (RegCheckErr(Buf, RoutineName)) return - ! iRotor call RegPack(Buf, InData%iRotor) if (RegCheckErr(Buf, RoutineName)) return - ! AFindx call RegPack(Buf, allocated(InData%AFindx)) if (allocated(InData%AFindx)) then call RegPackBounds(Buf, 2, lbound(InData%AFindx), ubound(InData%AFindx)) call RegPack(Buf, InData%AFindx) end if if (RegCheckErr(Buf, RoutineName)) return - ! nSpan call RegPack(Buf, InData%nSpan) if (RegCheckErr(Buf, RoutineName)) return - ! PrescribedCirculation call RegPack(Buf, allocated(InData%PrescribedCirculation)) if (allocated(InData%PrescribedCirculation)) then call RegPackBounds(Buf, 1, lbound(InData%PrescribedCirculation), ubound(InData%PrescribedCirculation)) @@ -1191,7 +1087,6 @@ subroutine FVW_UnPackWng_ParameterType(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! chord_LL if (allocated(OutData%chord_LL)) deallocate(OutData%chord_LL) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1206,7 +1101,6 @@ subroutine FVW_UnPackWng_ParameterType(Buf, OutData) call RegUnpack(Buf, OutData%chord_LL) if (RegCheckErr(Buf, RoutineName)) return end if - ! chord_CP if (allocated(OutData%chord_CP)) deallocate(OutData%chord_CP) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1221,7 +1115,6 @@ subroutine FVW_UnPackWng_ParameterType(Buf, OutData) call RegUnpack(Buf, OutData%chord_CP) if (RegCheckErr(Buf, RoutineName)) return end if - ! s_LL if (allocated(OutData%s_LL)) deallocate(OutData%s_LL) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1236,7 +1129,6 @@ subroutine FVW_UnPackWng_ParameterType(Buf, OutData) call RegUnpack(Buf, OutData%s_LL) if (RegCheckErr(Buf, RoutineName)) return end if - ! s_CP if (allocated(OutData%s_CP)) deallocate(OutData%s_CP) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1251,10 +1143,8 @@ subroutine FVW_UnPackWng_ParameterType(Buf, OutData) call RegUnpack(Buf, OutData%s_CP) if (RegCheckErr(Buf, RoutineName)) return end if - ! iRotor call RegUnpack(Buf, OutData%iRotor) if (RegCheckErr(Buf, RoutineName)) return - ! AFindx if (allocated(OutData%AFindx)) deallocate(OutData%AFindx) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1269,10 +1159,8 @@ subroutine FVW_UnPackWng_ParameterType(Buf, OutData) call RegUnpack(Buf, OutData%AFindx) if (RegCheckErr(Buf, RoutineName)) return end if - ! nSpan call RegUnpack(Buf, OutData%nSpan) if (RegCheckErr(Buf, RoutineName)) return - ! PrescribedCirculation if (allocated(OutData%PrescribedCirculation)) deallocate(OutData%PrescribedCirculation) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1288,126 +1176,125 @@ subroutine FVW_UnPackWng_ParameterType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE FVW_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FVW_ParameterType), INTENT(IN) :: SrcParamData - TYPE(FVW_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%nRotors = SrcParamData%nRotors - DstParamData%nWings = SrcParamData%nWings -IF (ALLOCATED(SrcParamData%W)) THEN - i1_l = LBOUND(SrcParamData%W,1) - i1_u = UBOUND(SrcParamData%W,1) - IF (.NOT. ALLOCATED(DstParamData%W)) THEN - ALLOCATE(DstParamData%W(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%W.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%W,1), UBOUND(SrcParamData%W,1) - CALL FVW_Copywng_parametertype( SrcParamData%W(i1), DstParamData%W(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%Bld2Wings)) THEN - i1_l = LBOUND(SrcParamData%Bld2Wings,1) - i1_u = UBOUND(SrcParamData%Bld2Wings,1) - i2_l = LBOUND(SrcParamData%Bld2Wings,2) - i2_u = UBOUND(SrcParamData%Bld2Wings,2) - IF (.NOT. ALLOCATED(DstParamData%Bld2Wings)) THEN - ALLOCATE(DstParamData%Bld2Wings(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Bld2Wings.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Bld2Wings = SrcParamData%Bld2Wings -ENDIF - DstParamData%iNWStart = SrcParamData%iNWStart - DstParamData%nNWMax = SrcParamData%nNWMax - DstParamData%nNWFree = SrcParamData%nNWFree - DstParamData%nFWMax = SrcParamData%nFWMax - DstParamData%nFWFree = SrcParamData%nFWFree - DstParamData%FWShedVorticity = SrcParamData%FWShedVorticity - DstParamData%IntMethod = SrcParamData%IntMethod - DstParamData%FreeWakeStart = SrcParamData%FreeWakeStart - DstParamData%FullCircStart = SrcParamData%FullCircStart - DstParamData%CircSolvMethod = SrcParamData%CircSolvMethod - DstParamData%CircSolvMaxIter = SrcParamData%CircSolvMaxIter - DstParamData%CircSolvConvCrit = SrcParamData%CircSolvConvCrit - DstParamData%CircSolvRelaxation = SrcParamData%CircSolvRelaxation - DstParamData%CircSolvPolar = SrcParamData%CircSolvPolar - DstParamData%DiffusionMethod = SrcParamData%DiffusionMethod - DstParamData%CoreSpreadEddyVisc = SrcParamData%CoreSpreadEddyVisc - DstParamData%RegDeterMethod = SrcParamData%RegDeterMethod - DstParamData%RegFunction = SrcParamData%RegFunction - DstParamData%WakeRegMethod = SrcParamData%WakeRegMethod - DstParamData%WakeRegParam = SrcParamData%WakeRegParam - DstParamData%WingRegParam = SrcParamData%WingRegParam - DstParamData%ShearModel = SrcParamData%ShearModel - DstParamData%TwrShadowOnWake = SrcParamData%TwrShadowOnWake - DstParamData%VelocityMethod = SrcParamData%VelocityMethod - DstParamData%TreeBranchFactor = SrcParamData%TreeBranchFactor - DstParamData%PartPerSegment = SrcParamData%PartPerSegment - DstParamData%DTaero = SrcParamData%DTaero - DstParamData%DTfvw = SrcParamData%DTfvw - DstParamData%KinVisc = SrcParamData%KinVisc - DstParamData%MHK = SrcParamData%MHK - DstParamData%WtrDpth = SrcParamData%WtrDpth - DstParamData%WrVTK = SrcParamData%WrVTK - DstParamData%VTKBlades = SrcParamData%VTKBlades - DstParamData%DTvtk = SrcParamData%DTvtk - DstParamData%VTKCoord = SrcParamData%VTKCoord - DstParamData%RootName = SrcParamData%RootName - DstParamData%VTK_OutFileRoot = SrcParamData%VTK_OutFileRoot - DstParamData%VTK_OutFileBase = SrcParamData%VTK_OutFileBase - DstParamData%nGridOut = SrcParamData%nGridOut - DstParamData%InductionAtCP = SrcParamData%InductionAtCP - DstParamData%WakeAtTE = SrcParamData%WakeAtTE - DstParamData%DStallOnWake = SrcParamData%DStallOnWake - DstParamData%Induction = SrcParamData%Induction - DstParamData%kFrozenNWStart = SrcParamData%kFrozenNWStart - DstParamData%kFrozenNWEnd = SrcParamData%kFrozenNWEnd - END SUBROUTINE FVW_CopyParam - - SUBROUTINE FVW_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(FVW_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyParam' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%W)) THEN -DO i1 = LBOUND(ParamData%W,1), UBOUND(ParamData%W,1) - CALL FVW_DestroyWng_ParameterType( ParamData%W(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%W) -ENDIF -IF (ALLOCATED(ParamData%Bld2Wings)) THEN - DEALLOCATE(ParamData%Bld2Wings) -ENDIF - END SUBROUTINE FVW_DestroyParam +subroutine FVW_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(FVW_ParameterType), intent(in) :: SrcParamData + type(FVW_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%nRotors = SrcParamData%nRotors + DstParamData%nWings = SrcParamData%nWings + if (allocated(SrcParamData%W)) then + LB(1:1) = lbound(SrcParamData%W) + UB(1:1) = ubound(SrcParamData%W) + if (.not. allocated(DstParamData%W)) then + allocate(DstParamData%W(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%W.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FVW_CopyWng_ParameterType(SrcParamData%W(i1), DstParamData%W(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstParamData%W)) then + deallocate(DstParamData%W) + end if + if (allocated(SrcParamData%Bld2Wings)) then + LB(1:2) = lbound(SrcParamData%Bld2Wings) + UB(1:2) = ubound(SrcParamData%Bld2Wings) + if (.not. allocated(DstParamData%Bld2Wings)) then + allocate(DstParamData%Bld2Wings(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Bld2Wings.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Bld2Wings = SrcParamData%Bld2Wings + else if (allocated(DstParamData%Bld2Wings)) then + deallocate(DstParamData%Bld2Wings) + end if + DstParamData%iNWStart = SrcParamData%iNWStart + DstParamData%nNWMax = SrcParamData%nNWMax + DstParamData%nNWFree = SrcParamData%nNWFree + DstParamData%nFWMax = SrcParamData%nFWMax + DstParamData%nFWFree = SrcParamData%nFWFree + DstParamData%FWShedVorticity = SrcParamData%FWShedVorticity + DstParamData%IntMethod = SrcParamData%IntMethod + DstParamData%FreeWakeStart = SrcParamData%FreeWakeStart + DstParamData%FullCircStart = SrcParamData%FullCircStart + DstParamData%CircSolvMethod = SrcParamData%CircSolvMethod + DstParamData%CircSolvMaxIter = SrcParamData%CircSolvMaxIter + DstParamData%CircSolvConvCrit = SrcParamData%CircSolvConvCrit + DstParamData%CircSolvRelaxation = SrcParamData%CircSolvRelaxation + DstParamData%CircSolvPolar = SrcParamData%CircSolvPolar + DstParamData%DiffusionMethod = SrcParamData%DiffusionMethod + DstParamData%CoreSpreadEddyVisc = SrcParamData%CoreSpreadEddyVisc + DstParamData%RegDeterMethod = SrcParamData%RegDeterMethod + DstParamData%RegFunction = SrcParamData%RegFunction + DstParamData%WakeRegMethod = SrcParamData%WakeRegMethod + DstParamData%WakeRegParam = SrcParamData%WakeRegParam + DstParamData%WingRegParam = SrcParamData%WingRegParam + DstParamData%ShearModel = SrcParamData%ShearModel + DstParamData%TwrShadowOnWake = SrcParamData%TwrShadowOnWake + DstParamData%VelocityMethod = SrcParamData%VelocityMethod + DstParamData%TreeBranchFactor = SrcParamData%TreeBranchFactor + DstParamData%PartPerSegment = SrcParamData%PartPerSegment + DstParamData%DTaero = SrcParamData%DTaero + DstParamData%DTfvw = SrcParamData%DTfvw + DstParamData%KinVisc = SrcParamData%KinVisc + DstParamData%MHK = SrcParamData%MHK + DstParamData%WtrDpth = SrcParamData%WtrDpth + DstParamData%WrVTK = SrcParamData%WrVTK + DstParamData%VTKBlades = SrcParamData%VTKBlades + DstParamData%DTvtk = SrcParamData%DTvtk + DstParamData%VTKCoord = SrcParamData%VTKCoord + DstParamData%RootName = SrcParamData%RootName + DstParamData%VTK_OutFileRoot = SrcParamData%VTK_OutFileRoot + DstParamData%VTK_OutFileBase = SrcParamData%VTK_OutFileBase + DstParamData%nGridOut = SrcParamData%nGridOut + DstParamData%InductionAtCP = SrcParamData%InductionAtCP + DstParamData%WakeAtTE = SrcParamData%WakeAtTE + DstParamData%DStallOnWake = SrcParamData%DStallOnWake + DstParamData%Induction = SrcParamData%Induction + DstParamData%kFrozenNWStart = SrcParamData%kFrozenNWStart + DstParamData%kFrozenNWEnd = SrcParamData%kFrozenNWEnd +end subroutine +subroutine FVW_DestroyParam(ParamData, ErrStat, ErrMsg) + type(FVW_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%W)) then + LB(1:1) = lbound(ParamData%W) + UB(1:1) = ubound(ParamData%W) + do i1 = LB(1), UB(1) + call FVW_DestroyWng_ParameterType(ParamData%W(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%W) + end if + if (allocated(ParamData%Bld2Wings)) then + deallocate(ParamData%Bld2Wings) + end if +end subroutine subroutine FVW_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -1416,13 +1303,10 @@ subroutine FVW_PackParam(Buf, Indata) integer(IntKi) :: i1, i2 integer(IntKi) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return - ! nRotors call RegPack(Buf, InData%nRotors) if (RegCheckErr(Buf, RoutineName)) return - ! nWings call RegPack(Buf, InData%nWings) if (RegCheckErr(Buf, RoutineName)) return - ! W call RegPack(Buf, allocated(InData%W)) if (allocated(InData%W)) then call RegPackBounds(Buf, 1, lbound(InData%W), ubound(InData%W)) @@ -1433,146 +1317,100 @@ subroutine FVW_PackParam(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! Bld2Wings call RegPack(Buf, allocated(InData%Bld2Wings)) if (allocated(InData%Bld2Wings)) then call RegPackBounds(Buf, 2, lbound(InData%Bld2Wings), ubound(InData%Bld2Wings)) call RegPack(Buf, InData%Bld2Wings) end if if (RegCheckErr(Buf, RoutineName)) return - ! iNWStart call RegPack(Buf, InData%iNWStart) if (RegCheckErr(Buf, RoutineName)) return - ! nNWMax call RegPack(Buf, InData%nNWMax) if (RegCheckErr(Buf, RoutineName)) return - ! nNWFree call RegPack(Buf, InData%nNWFree) if (RegCheckErr(Buf, RoutineName)) return - ! nFWMax call RegPack(Buf, InData%nFWMax) if (RegCheckErr(Buf, RoutineName)) return - ! nFWFree call RegPack(Buf, InData%nFWFree) if (RegCheckErr(Buf, RoutineName)) return - ! FWShedVorticity call RegPack(Buf, InData%FWShedVorticity) if (RegCheckErr(Buf, RoutineName)) return - ! IntMethod call RegPack(Buf, InData%IntMethod) if (RegCheckErr(Buf, RoutineName)) return - ! FreeWakeStart call RegPack(Buf, InData%FreeWakeStart) if (RegCheckErr(Buf, RoutineName)) return - ! FullCircStart call RegPack(Buf, InData%FullCircStart) if (RegCheckErr(Buf, RoutineName)) return - ! CircSolvMethod call RegPack(Buf, InData%CircSolvMethod) if (RegCheckErr(Buf, RoutineName)) return - ! CircSolvMaxIter call RegPack(Buf, InData%CircSolvMaxIter) if (RegCheckErr(Buf, RoutineName)) return - ! CircSolvConvCrit call RegPack(Buf, InData%CircSolvConvCrit) if (RegCheckErr(Buf, RoutineName)) return - ! CircSolvRelaxation call RegPack(Buf, InData%CircSolvRelaxation) if (RegCheckErr(Buf, RoutineName)) return - ! CircSolvPolar call RegPack(Buf, InData%CircSolvPolar) if (RegCheckErr(Buf, RoutineName)) return - ! DiffusionMethod call RegPack(Buf, InData%DiffusionMethod) if (RegCheckErr(Buf, RoutineName)) return - ! CoreSpreadEddyVisc call RegPack(Buf, InData%CoreSpreadEddyVisc) if (RegCheckErr(Buf, RoutineName)) return - ! RegDeterMethod call RegPack(Buf, InData%RegDeterMethod) if (RegCheckErr(Buf, RoutineName)) return - ! RegFunction call RegPack(Buf, InData%RegFunction) if (RegCheckErr(Buf, RoutineName)) return - ! WakeRegMethod call RegPack(Buf, InData%WakeRegMethod) if (RegCheckErr(Buf, RoutineName)) return - ! WakeRegParam call RegPack(Buf, InData%WakeRegParam) if (RegCheckErr(Buf, RoutineName)) return - ! WingRegParam call RegPack(Buf, InData%WingRegParam) if (RegCheckErr(Buf, RoutineName)) return - ! ShearModel call RegPack(Buf, InData%ShearModel) if (RegCheckErr(Buf, RoutineName)) return - ! TwrShadowOnWake call RegPack(Buf, InData%TwrShadowOnWake) if (RegCheckErr(Buf, RoutineName)) return - ! VelocityMethod call RegPack(Buf, InData%VelocityMethod) if (RegCheckErr(Buf, RoutineName)) return - ! TreeBranchFactor call RegPack(Buf, InData%TreeBranchFactor) if (RegCheckErr(Buf, RoutineName)) return - ! PartPerSegment call RegPack(Buf, InData%PartPerSegment) if (RegCheckErr(Buf, RoutineName)) return - ! DTaero call RegPack(Buf, InData%DTaero) if (RegCheckErr(Buf, RoutineName)) return - ! DTfvw call RegPack(Buf, InData%DTfvw) if (RegCheckErr(Buf, RoutineName)) return - ! KinVisc call RegPack(Buf, InData%KinVisc) if (RegCheckErr(Buf, RoutineName)) return - ! MHK call RegPack(Buf, InData%MHK) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDpth call RegPack(Buf, InData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - ! WrVTK call RegPack(Buf, InData%WrVTK) if (RegCheckErr(Buf, RoutineName)) return - ! VTKBlades call RegPack(Buf, InData%VTKBlades) if (RegCheckErr(Buf, RoutineName)) return - ! DTvtk call RegPack(Buf, InData%DTvtk) if (RegCheckErr(Buf, RoutineName)) return - ! VTKCoord call RegPack(Buf, InData%VTKCoord) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegPack(Buf, InData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! VTK_OutFileRoot call RegPack(Buf, InData%VTK_OutFileRoot) if (RegCheckErr(Buf, RoutineName)) return - ! VTK_OutFileBase call RegPack(Buf, InData%VTK_OutFileBase) if (RegCheckErr(Buf, RoutineName)) return - ! nGridOut call RegPack(Buf, InData%nGridOut) if (RegCheckErr(Buf, RoutineName)) return - ! InductionAtCP call RegPack(Buf, InData%InductionAtCP) if (RegCheckErr(Buf, RoutineName)) return - ! WakeAtTE call RegPack(Buf, InData%WakeAtTE) if (RegCheckErr(Buf, RoutineName)) return - ! DStallOnWake call RegPack(Buf, InData%DStallOnWake) if (RegCheckErr(Buf, RoutineName)) return - ! Induction call RegPack(Buf, InData%Induction) if (RegCheckErr(Buf, RoutineName)) return - ! kFrozenNWStart call RegPack(Buf, InData%kFrozenNWStart) if (RegCheckErr(Buf, RoutineName)) return - ! kFrozenNWEnd call RegPack(Buf, InData%kFrozenNWEnd) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1586,13 +1424,10 @@ subroutine FVW_UnPackParam(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! nRotors call RegUnpack(Buf, OutData%nRotors) if (RegCheckErr(Buf, RoutineName)) return - ! nWings call RegUnpack(Buf, OutData%nWings) if (RegCheckErr(Buf, RoutineName)) return - ! W if (allocated(OutData%W)) deallocate(OutData%W) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1608,7 +1443,6 @@ subroutine FVW_UnPackParam(Buf, OutData) call FVW_UnpackWng_ParameterType(Buf, OutData%W(i1)) ! W end do end if - ! Bld2Wings if (allocated(OutData%Bld2Wings)) deallocate(OutData%Bld2Wings) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1623,328 +1457,257 @@ subroutine FVW_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%Bld2Wings) if (RegCheckErr(Buf, RoutineName)) return end if - ! iNWStart call RegUnpack(Buf, OutData%iNWStart) if (RegCheckErr(Buf, RoutineName)) return - ! nNWMax call RegUnpack(Buf, OutData%nNWMax) if (RegCheckErr(Buf, RoutineName)) return - ! nNWFree call RegUnpack(Buf, OutData%nNWFree) if (RegCheckErr(Buf, RoutineName)) return - ! nFWMax call RegUnpack(Buf, OutData%nFWMax) if (RegCheckErr(Buf, RoutineName)) return - ! nFWFree call RegUnpack(Buf, OutData%nFWFree) if (RegCheckErr(Buf, RoutineName)) return - ! FWShedVorticity call RegUnpack(Buf, OutData%FWShedVorticity) if (RegCheckErr(Buf, RoutineName)) return - ! IntMethod call RegUnpack(Buf, OutData%IntMethod) if (RegCheckErr(Buf, RoutineName)) return - ! FreeWakeStart call RegUnpack(Buf, OutData%FreeWakeStart) if (RegCheckErr(Buf, RoutineName)) return - ! FullCircStart call RegUnpack(Buf, OutData%FullCircStart) if (RegCheckErr(Buf, RoutineName)) return - ! CircSolvMethod call RegUnpack(Buf, OutData%CircSolvMethod) if (RegCheckErr(Buf, RoutineName)) return - ! CircSolvMaxIter call RegUnpack(Buf, OutData%CircSolvMaxIter) if (RegCheckErr(Buf, RoutineName)) return - ! CircSolvConvCrit call RegUnpack(Buf, OutData%CircSolvConvCrit) if (RegCheckErr(Buf, RoutineName)) return - ! CircSolvRelaxation call RegUnpack(Buf, OutData%CircSolvRelaxation) if (RegCheckErr(Buf, RoutineName)) return - ! CircSolvPolar call RegUnpack(Buf, OutData%CircSolvPolar) if (RegCheckErr(Buf, RoutineName)) return - ! DiffusionMethod call RegUnpack(Buf, OutData%DiffusionMethod) if (RegCheckErr(Buf, RoutineName)) return - ! CoreSpreadEddyVisc call RegUnpack(Buf, OutData%CoreSpreadEddyVisc) if (RegCheckErr(Buf, RoutineName)) return - ! RegDeterMethod call RegUnpack(Buf, OutData%RegDeterMethod) if (RegCheckErr(Buf, RoutineName)) return - ! RegFunction call RegUnpack(Buf, OutData%RegFunction) if (RegCheckErr(Buf, RoutineName)) return - ! WakeRegMethod call RegUnpack(Buf, OutData%WakeRegMethod) if (RegCheckErr(Buf, RoutineName)) return - ! WakeRegParam call RegUnpack(Buf, OutData%WakeRegParam) if (RegCheckErr(Buf, RoutineName)) return - ! WingRegParam call RegUnpack(Buf, OutData%WingRegParam) if (RegCheckErr(Buf, RoutineName)) return - ! ShearModel call RegUnpack(Buf, OutData%ShearModel) if (RegCheckErr(Buf, RoutineName)) return - ! TwrShadowOnWake call RegUnpack(Buf, OutData%TwrShadowOnWake) if (RegCheckErr(Buf, RoutineName)) return - ! VelocityMethod call RegUnpack(Buf, OutData%VelocityMethod) if (RegCheckErr(Buf, RoutineName)) return - ! TreeBranchFactor call RegUnpack(Buf, OutData%TreeBranchFactor) if (RegCheckErr(Buf, RoutineName)) return - ! PartPerSegment call RegUnpack(Buf, OutData%PartPerSegment) if (RegCheckErr(Buf, RoutineName)) return - ! DTaero call RegUnpack(Buf, OutData%DTaero) if (RegCheckErr(Buf, RoutineName)) return - ! DTfvw call RegUnpack(Buf, OutData%DTfvw) if (RegCheckErr(Buf, RoutineName)) return - ! KinVisc call RegUnpack(Buf, OutData%KinVisc) if (RegCheckErr(Buf, RoutineName)) return - ! MHK call RegUnpack(Buf, OutData%MHK) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDpth call RegUnpack(Buf, OutData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - ! WrVTK call RegUnpack(Buf, OutData%WrVTK) if (RegCheckErr(Buf, RoutineName)) return - ! VTKBlades call RegUnpack(Buf, OutData%VTKBlades) if (RegCheckErr(Buf, RoutineName)) return - ! DTvtk call RegUnpack(Buf, OutData%DTvtk) if (RegCheckErr(Buf, RoutineName)) return - ! VTKCoord call RegUnpack(Buf, OutData%VTKCoord) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegUnpack(Buf, OutData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! VTK_OutFileRoot call RegUnpack(Buf, OutData%VTK_OutFileRoot) if (RegCheckErr(Buf, RoutineName)) return - ! VTK_OutFileBase call RegUnpack(Buf, OutData%VTK_OutFileBase) if (RegCheckErr(Buf, RoutineName)) return - ! nGridOut call RegUnpack(Buf, OutData%nGridOut) if (RegCheckErr(Buf, RoutineName)) return - ! InductionAtCP call RegUnpack(Buf, OutData%InductionAtCP) if (RegCheckErr(Buf, RoutineName)) return - ! WakeAtTE call RegUnpack(Buf, OutData%WakeAtTE) if (RegCheckErr(Buf, RoutineName)) return - ! DStallOnWake call RegUnpack(Buf, OutData%DStallOnWake) if (RegCheckErr(Buf, RoutineName)) return - ! Induction call RegUnpack(Buf, OutData%Induction) if (RegCheckErr(Buf, RoutineName)) return - ! kFrozenNWStart call RegUnpack(Buf, OutData%kFrozenNWStart) if (RegCheckErr(Buf, RoutineName)) return - ! kFrozenNWEnd call RegUnpack(Buf, OutData%kFrozenNWEnd) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE FVW_CopyWng_ContinuousStateType( SrcWng_ContinuousStateTypeData, DstWng_ContinuousStateTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Wng_ContinuousStateType), INTENT(IN) :: SrcWng_ContinuousStateTypeData - TYPE(Wng_ContinuousStateType), INTENT(INOUT) :: DstWng_ContinuousStateTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_CopyWng_ContinuousStateType' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcWng_ContinuousStateTypeData%Gamma_NW)) THEN - i1_l = LBOUND(SrcWng_ContinuousStateTypeData%Gamma_NW,1) - i1_u = UBOUND(SrcWng_ContinuousStateTypeData%Gamma_NW,1) - i2_l = LBOUND(SrcWng_ContinuousStateTypeData%Gamma_NW,2) - i2_u = UBOUND(SrcWng_ContinuousStateTypeData%Gamma_NW,2) - IF (.NOT. ALLOCATED(DstWng_ContinuousStateTypeData%Gamma_NW)) THEN - ALLOCATE(DstWng_ContinuousStateTypeData%Gamma_NW(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ContinuousStateTypeData%Gamma_NW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_ContinuousStateTypeData%Gamma_NW = SrcWng_ContinuousStateTypeData%Gamma_NW -ENDIF -IF (ALLOCATED(SrcWng_ContinuousStateTypeData%Gamma_FW)) THEN - i1_l = LBOUND(SrcWng_ContinuousStateTypeData%Gamma_FW,1) - i1_u = UBOUND(SrcWng_ContinuousStateTypeData%Gamma_FW,1) - i2_l = LBOUND(SrcWng_ContinuousStateTypeData%Gamma_FW,2) - i2_u = UBOUND(SrcWng_ContinuousStateTypeData%Gamma_FW,2) - IF (.NOT. ALLOCATED(DstWng_ContinuousStateTypeData%Gamma_FW)) THEN - ALLOCATE(DstWng_ContinuousStateTypeData%Gamma_FW(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ContinuousStateTypeData%Gamma_FW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_ContinuousStateTypeData%Gamma_FW = SrcWng_ContinuousStateTypeData%Gamma_FW -ENDIF -IF (ALLOCATED(SrcWng_ContinuousStateTypeData%Eps_NW)) THEN - i1_l = LBOUND(SrcWng_ContinuousStateTypeData%Eps_NW,1) - i1_u = UBOUND(SrcWng_ContinuousStateTypeData%Eps_NW,1) - i2_l = LBOUND(SrcWng_ContinuousStateTypeData%Eps_NW,2) - i2_u = UBOUND(SrcWng_ContinuousStateTypeData%Eps_NW,2) - i3_l = LBOUND(SrcWng_ContinuousStateTypeData%Eps_NW,3) - i3_u = UBOUND(SrcWng_ContinuousStateTypeData%Eps_NW,3) - IF (.NOT. ALLOCATED(DstWng_ContinuousStateTypeData%Eps_NW)) THEN - ALLOCATE(DstWng_ContinuousStateTypeData%Eps_NW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ContinuousStateTypeData%Eps_NW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_ContinuousStateTypeData%Eps_NW = SrcWng_ContinuousStateTypeData%Eps_NW -ENDIF -IF (ALLOCATED(SrcWng_ContinuousStateTypeData%Eps_FW)) THEN - i1_l = LBOUND(SrcWng_ContinuousStateTypeData%Eps_FW,1) - i1_u = UBOUND(SrcWng_ContinuousStateTypeData%Eps_FW,1) - i2_l = LBOUND(SrcWng_ContinuousStateTypeData%Eps_FW,2) - i2_u = UBOUND(SrcWng_ContinuousStateTypeData%Eps_FW,2) - i3_l = LBOUND(SrcWng_ContinuousStateTypeData%Eps_FW,3) - i3_u = UBOUND(SrcWng_ContinuousStateTypeData%Eps_FW,3) - IF (.NOT. ALLOCATED(DstWng_ContinuousStateTypeData%Eps_FW)) THEN - ALLOCATE(DstWng_ContinuousStateTypeData%Eps_FW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ContinuousStateTypeData%Eps_FW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_ContinuousStateTypeData%Eps_FW = SrcWng_ContinuousStateTypeData%Eps_FW -ENDIF -IF (ALLOCATED(SrcWng_ContinuousStateTypeData%r_NW)) THEN - i1_l = LBOUND(SrcWng_ContinuousStateTypeData%r_NW,1) - i1_u = UBOUND(SrcWng_ContinuousStateTypeData%r_NW,1) - i2_l = LBOUND(SrcWng_ContinuousStateTypeData%r_NW,2) - i2_u = UBOUND(SrcWng_ContinuousStateTypeData%r_NW,2) - i3_l = LBOUND(SrcWng_ContinuousStateTypeData%r_NW,3) - i3_u = UBOUND(SrcWng_ContinuousStateTypeData%r_NW,3) - IF (.NOT. ALLOCATED(DstWng_ContinuousStateTypeData%r_NW)) THEN - ALLOCATE(DstWng_ContinuousStateTypeData%r_NW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ContinuousStateTypeData%r_NW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_ContinuousStateTypeData%r_NW = SrcWng_ContinuousStateTypeData%r_NW -ENDIF -IF (ALLOCATED(SrcWng_ContinuousStateTypeData%r_FW)) THEN - i1_l = LBOUND(SrcWng_ContinuousStateTypeData%r_FW,1) - i1_u = UBOUND(SrcWng_ContinuousStateTypeData%r_FW,1) - i2_l = LBOUND(SrcWng_ContinuousStateTypeData%r_FW,2) - i2_u = UBOUND(SrcWng_ContinuousStateTypeData%r_FW,2) - i3_l = LBOUND(SrcWng_ContinuousStateTypeData%r_FW,3) - i3_u = UBOUND(SrcWng_ContinuousStateTypeData%r_FW,3) - IF (.NOT. ALLOCATED(DstWng_ContinuousStateTypeData%r_FW)) THEN - ALLOCATE(DstWng_ContinuousStateTypeData%r_FW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ContinuousStateTypeData%r_FW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_ContinuousStateTypeData%r_FW = SrcWng_ContinuousStateTypeData%r_FW -ENDIF - END SUBROUTINE FVW_CopyWng_ContinuousStateType - - SUBROUTINE FVW_DestroyWng_ContinuousStateType( Wng_ContinuousStateTypeData, ErrStat, ErrMsg ) - TYPE(Wng_ContinuousStateType), INTENT(INOUT) :: Wng_ContinuousStateTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyWng_ContinuousStateType' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(Wng_ContinuousStateTypeData%Gamma_NW)) THEN - DEALLOCATE(Wng_ContinuousStateTypeData%Gamma_NW) -ENDIF -IF (ALLOCATED(Wng_ContinuousStateTypeData%Gamma_FW)) THEN - DEALLOCATE(Wng_ContinuousStateTypeData%Gamma_FW) -ENDIF -IF (ALLOCATED(Wng_ContinuousStateTypeData%Eps_NW)) THEN - DEALLOCATE(Wng_ContinuousStateTypeData%Eps_NW) -ENDIF -IF (ALLOCATED(Wng_ContinuousStateTypeData%Eps_FW)) THEN - DEALLOCATE(Wng_ContinuousStateTypeData%Eps_FW) -ENDIF -IF (ALLOCATED(Wng_ContinuousStateTypeData%r_NW)) THEN - DEALLOCATE(Wng_ContinuousStateTypeData%r_NW) -ENDIF -IF (ALLOCATED(Wng_ContinuousStateTypeData%r_FW)) THEN - DEALLOCATE(Wng_ContinuousStateTypeData%r_FW) -ENDIF - END SUBROUTINE FVW_DestroyWng_ContinuousStateType +subroutine FVW_CopyWng_ContinuousStateType(SrcWng_ContinuousStateTypeData, DstWng_ContinuousStateTypeData, CtrlCode, ErrStat, ErrMsg) + type(Wng_ContinuousStateType), intent(in) :: SrcWng_ContinuousStateTypeData + type(Wng_ContinuousStateType), intent(inout) :: DstWng_ContinuousStateTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FVW_CopyWng_ContinuousStateType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcWng_ContinuousStateTypeData%Gamma_NW)) then + LB(1:2) = lbound(SrcWng_ContinuousStateTypeData%Gamma_NW) + UB(1:2) = ubound(SrcWng_ContinuousStateTypeData%Gamma_NW) + if (.not. allocated(DstWng_ContinuousStateTypeData%Gamma_NW)) then + allocate(DstWng_ContinuousStateTypeData%Gamma_NW(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ContinuousStateTypeData%Gamma_NW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_ContinuousStateTypeData%Gamma_NW = SrcWng_ContinuousStateTypeData%Gamma_NW + else if (allocated(DstWng_ContinuousStateTypeData%Gamma_NW)) then + deallocate(DstWng_ContinuousStateTypeData%Gamma_NW) + end if + if (allocated(SrcWng_ContinuousStateTypeData%Gamma_FW)) then + LB(1:2) = lbound(SrcWng_ContinuousStateTypeData%Gamma_FW) + UB(1:2) = ubound(SrcWng_ContinuousStateTypeData%Gamma_FW) + if (.not. allocated(DstWng_ContinuousStateTypeData%Gamma_FW)) then + allocate(DstWng_ContinuousStateTypeData%Gamma_FW(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ContinuousStateTypeData%Gamma_FW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_ContinuousStateTypeData%Gamma_FW = SrcWng_ContinuousStateTypeData%Gamma_FW + else if (allocated(DstWng_ContinuousStateTypeData%Gamma_FW)) then + deallocate(DstWng_ContinuousStateTypeData%Gamma_FW) + end if + if (allocated(SrcWng_ContinuousStateTypeData%Eps_NW)) then + LB(1:3) = lbound(SrcWng_ContinuousStateTypeData%Eps_NW) + UB(1:3) = ubound(SrcWng_ContinuousStateTypeData%Eps_NW) + if (.not. allocated(DstWng_ContinuousStateTypeData%Eps_NW)) then + allocate(DstWng_ContinuousStateTypeData%Eps_NW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ContinuousStateTypeData%Eps_NW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_ContinuousStateTypeData%Eps_NW = SrcWng_ContinuousStateTypeData%Eps_NW + else if (allocated(DstWng_ContinuousStateTypeData%Eps_NW)) then + deallocate(DstWng_ContinuousStateTypeData%Eps_NW) + end if + if (allocated(SrcWng_ContinuousStateTypeData%Eps_FW)) then + LB(1:3) = lbound(SrcWng_ContinuousStateTypeData%Eps_FW) + UB(1:3) = ubound(SrcWng_ContinuousStateTypeData%Eps_FW) + if (.not. allocated(DstWng_ContinuousStateTypeData%Eps_FW)) then + allocate(DstWng_ContinuousStateTypeData%Eps_FW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ContinuousStateTypeData%Eps_FW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_ContinuousStateTypeData%Eps_FW = SrcWng_ContinuousStateTypeData%Eps_FW + else if (allocated(DstWng_ContinuousStateTypeData%Eps_FW)) then + deallocate(DstWng_ContinuousStateTypeData%Eps_FW) + end if + if (allocated(SrcWng_ContinuousStateTypeData%r_NW)) then + LB(1:3) = lbound(SrcWng_ContinuousStateTypeData%r_NW) + UB(1:3) = ubound(SrcWng_ContinuousStateTypeData%r_NW) + if (.not. allocated(DstWng_ContinuousStateTypeData%r_NW)) then + allocate(DstWng_ContinuousStateTypeData%r_NW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ContinuousStateTypeData%r_NW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_ContinuousStateTypeData%r_NW = SrcWng_ContinuousStateTypeData%r_NW + else if (allocated(DstWng_ContinuousStateTypeData%r_NW)) then + deallocate(DstWng_ContinuousStateTypeData%r_NW) + end if + if (allocated(SrcWng_ContinuousStateTypeData%r_FW)) then + LB(1:3) = lbound(SrcWng_ContinuousStateTypeData%r_FW) + UB(1:3) = ubound(SrcWng_ContinuousStateTypeData%r_FW) + if (.not. allocated(DstWng_ContinuousStateTypeData%r_FW)) then + allocate(DstWng_ContinuousStateTypeData%r_FW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ContinuousStateTypeData%r_FW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_ContinuousStateTypeData%r_FW = SrcWng_ContinuousStateTypeData%r_FW + else if (allocated(DstWng_ContinuousStateTypeData%r_FW)) then + deallocate(DstWng_ContinuousStateTypeData%r_FW) + end if +end subroutine +subroutine FVW_DestroyWng_ContinuousStateType(Wng_ContinuousStateTypeData, ErrStat, ErrMsg) + type(Wng_ContinuousStateType), intent(inout) :: Wng_ContinuousStateTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FVW_DestroyWng_ContinuousStateType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(Wng_ContinuousStateTypeData%Gamma_NW)) then + deallocate(Wng_ContinuousStateTypeData%Gamma_NW) + end if + if (allocated(Wng_ContinuousStateTypeData%Gamma_FW)) then + deallocate(Wng_ContinuousStateTypeData%Gamma_FW) + end if + if (allocated(Wng_ContinuousStateTypeData%Eps_NW)) then + deallocate(Wng_ContinuousStateTypeData%Eps_NW) + end if + if (allocated(Wng_ContinuousStateTypeData%Eps_FW)) then + deallocate(Wng_ContinuousStateTypeData%Eps_FW) + end if + if (allocated(Wng_ContinuousStateTypeData%r_NW)) then + deallocate(Wng_ContinuousStateTypeData%r_NW) + end if + if (allocated(Wng_ContinuousStateTypeData%r_FW)) then + deallocate(Wng_ContinuousStateTypeData%r_FW) + end if +end subroutine subroutine FVW_PackWng_ContinuousStateType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Wng_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackWng_ContinuousStateType' if (Buf%ErrStat >= AbortErrLev) return - ! Gamma_NW call RegPack(Buf, allocated(InData%Gamma_NW)) if (allocated(InData%Gamma_NW)) then call RegPackBounds(Buf, 2, lbound(InData%Gamma_NW), ubound(InData%Gamma_NW)) call RegPack(Buf, InData%Gamma_NW) end if if (RegCheckErr(Buf, RoutineName)) return - ! Gamma_FW call RegPack(Buf, allocated(InData%Gamma_FW)) if (allocated(InData%Gamma_FW)) then call RegPackBounds(Buf, 2, lbound(InData%Gamma_FW), ubound(InData%Gamma_FW)) call RegPack(Buf, InData%Gamma_FW) end if if (RegCheckErr(Buf, RoutineName)) return - ! Eps_NW call RegPack(Buf, allocated(InData%Eps_NW)) if (allocated(InData%Eps_NW)) then call RegPackBounds(Buf, 3, lbound(InData%Eps_NW), ubound(InData%Eps_NW)) call RegPack(Buf, InData%Eps_NW) end if if (RegCheckErr(Buf, RoutineName)) return - ! Eps_FW call RegPack(Buf, allocated(InData%Eps_FW)) if (allocated(InData%Eps_FW)) then call RegPackBounds(Buf, 3, lbound(InData%Eps_FW), ubound(InData%Eps_FW)) call RegPack(Buf, InData%Eps_FW) end if if (RegCheckErr(Buf, RoutineName)) return - ! r_NW call RegPack(Buf, allocated(InData%r_NW)) if (allocated(InData%r_NW)) then call RegPackBounds(Buf, 3, lbound(InData%r_NW), ubound(InData%r_NW)) call RegPack(Buf, InData%r_NW) end if if (RegCheckErr(Buf, RoutineName)) return - ! r_FW call RegPack(Buf, allocated(InData%r_FW)) if (allocated(InData%r_FW)) then call RegPackBounds(Buf, 3, lbound(InData%r_FW), ubound(InData%r_FW)) @@ -1961,7 +1724,6 @@ subroutine FVW_UnPackWng_ContinuousStateType(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! Gamma_NW if (allocated(OutData%Gamma_NW)) deallocate(OutData%Gamma_NW) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1976,7 +1738,6 @@ subroutine FVW_UnPackWng_ContinuousStateType(Buf, OutData) call RegUnpack(Buf, OutData%Gamma_NW) if (RegCheckErr(Buf, RoutineName)) return end if - ! Gamma_FW if (allocated(OutData%Gamma_FW)) deallocate(OutData%Gamma_FW) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1991,7 +1752,6 @@ subroutine FVW_UnPackWng_ContinuousStateType(Buf, OutData) call RegUnpack(Buf, OutData%Gamma_FW) if (RegCheckErr(Buf, RoutineName)) return end if - ! Eps_NW if (allocated(OutData%Eps_NW)) deallocate(OutData%Eps_NW) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2006,7 +1766,6 @@ subroutine FVW_UnPackWng_ContinuousStateType(Buf, OutData) call RegUnpack(Buf, OutData%Eps_NW) if (RegCheckErr(Buf, RoutineName)) return end if - ! Eps_FW if (allocated(OutData%Eps_FW)) deallocate(OutData%Eps_FW) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2021,7 +1780,6 @@ subroutine FVW_UnPackWng_ContinuousStateType(Buf, OutData) call RegUnpack(Buf, OutData%Eps_FW) if (RegCheckErr(Buf, RoutineName)) return end if - ! r_NW if (allocated(OutData%r_NW)) deallocate(OutData%r_NW) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2036,7 +1794,6 @@ subroutine FVW_UnPackWng_ContinuousStateType(Buf, OutData) call RegUnpack(Buf, OutData%r_NW) if (RegCheckErr(Buf, RoutineName)) return end if - ! r_FW if (allocated(OutData%r_FW)) deallocate(OutData%r_FW) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2052,84 +1809,88 @@ subroutine FVW_UnPackWng_ContinuousStateType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE FVW_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FVW_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(FVW_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcContStateData%W)) THEN - i1_l = LBOUND(SrcContStateData%W,1) - i1_u = UBOUND(SrcContStateData%W,1) - IF (.NOT. ALLOCATED(DstContStateData%W)) THEN - ALLOCATE(DstContStateData%W(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%W.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcContStateData%W,1), UBOUND(SrcContStateData%W,1) - CALL FVW_Copywng_continuousstatetype( SrcContStateData%W(i1), DstContStateData%W(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcContStateData%UA)) THEN - i1_l = LBOUND(SrcContStateData%UA,1) - i1_u = UBOUND(SrcContStateData%UA,1) - IF (.NOT. ALLOCATED(DstContStateData%UA)) THEN - ALLOCATE(DstContStateData%UA(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%UA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcContStateData%UA,1), UBOUND(SrcContStateData%UA,1) - CALL UA_CopyContState( SrcContStateData%UA(i1), DstContStateData%UA(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE FVW_CopyContState - SUBROUTINE FVW_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(FVW_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ContStateData%W)) THEN -DO i1 = LBOUND(ContStateData%W,1), UBOUND(ContStateData%W,1) - CALL FVW_DestroyWng_ContinuousStateType( ContStateData%W(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ContStateData%W) -ENDIF -IF (ALLOCATED(ContStateData%UA)) THEN -DO i1 = LBOUND(ContStateData%UA,1), UBOUND(ContStateData%UA,1) - CALL UA_DestroyContState( ContStateData%UA(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ContStateData%UA) -ENDIF - END SUBROUTINE FVW_DestroyContState +subroutine FVW_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(FVW_ContinuousStateType), intent(in) :: SrcContStateData + type(FVW_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcContStateData%W)) then + LB(1:1) = lbound(SrcContStateData%W) + UB(1:1) = ubound(SrcContStateData%W) + if (.not. allocated(DstContStateData%W)) then + allocate(DstContStateData%W(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%W.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FVW_CopyWng_ContinuousStateType(SrcContStateData%W(i1), DstContStateData%W(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstContStateData%W)) then + deallocate(DstContStateData%W) + end if + if (allocated(SrcContStateData%UA)) then + LB(1:1) = lbound(SrcContStateData%UA) + UB(1:1) = ubound(SrcContStateData%UA) + if (.not. allocated(DstContStateData%UA)) then + allocate(DstContStateData%UA(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%UA.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call UA_CopyContState(SrcContStateData%UA(i1), DstContStateData%UA(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstContStateData%UA)) then + deallocate(DstContStateData%UA) + end if +end subroutine +subroutine FVW_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(FVW_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ContStateData%W)) then + LB(1:1) = lbound(ContStateData%W) + UB(1:1) = ubound(ContStateData%W) + do i1 = LB(1), UB(1) + call FVW_DestroyWng_ContinuousStateType(ContStateData%W(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ContStateData%W) + end if + if (allocated(ContStateData%UA)) then + LB(1:1) = lbound(ContStateData%UA) + UB(1:1) = ubound(ContStateData%UA) + do i1 = LB(1), UB(1) + call UA_DestroyContState(ContStateData%UA(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ContStateData%UA) + end if +end subroutine subroutine FVW_PackContState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -2138,7 +1899,6 @@ subroutine FVW_PackContState(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! W call RegPack(Buf, allocated(InData%W)) if (allocated(InData%W)) then call RegPackBounds(Buf, 1, lbound(InData%W), ubound(InData%W)) @@ -2149,7 +1909,6 @@ subroutine FVW_PackContState(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! UA call RegPack(Buf, allocated(InData%UA)) if (allocated(InData%UA)) then call RegPackBounds(Buf, 1, lbound(InData%UA), ubound(InData%UA)) @@ -2171,7 +1930,6 @@ subroutine FVW_UnPackContState(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! W if (allocated(OutData%W)) deallocate(OutData%W) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2187,7 +1945,6 @@ subroutine FVW_UnPackContState(Buf, OutData) call FVW_UnpackWng_ContinuousStateType(Buf, OutData%W(i1)) ! W end do end if - ! UA if (allocated(OutData%UA)) deallocate(OutData%UA) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2204,63 +1961,51 @@ subroutine FVW_UnPackContState(Buf, OutData) end do end if end subroutine - SUBROUTINE FVW_CopyWng_OutputType( SrcWng_OutputTypeData, DstWng_OutputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Wng_OutputType), INTENT(IN) :: SrcWng_OutputTypeData - TYPE(Wng_OutputType), INTENT(INOUT) :: DstWng_OutputTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_CopyWng_OutputType' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcWng_OutputTypeData%Vind)) THEN - i1_l = LBOUND(SrcWng_OutputTypeData%Vind,1) - i1_u = UBOUND(SrcWng_OutputTypeData%Vind,1) - i2_l = LBOUND(SrcWng_OutputTypeData%Vind,2) - i2_u = UBOUND(SrcWng_OutputTypeData%Vind,2) - IF (.NOT. ALLOCATED(DstWng_OutputTypeData%Vind)) THEN - ALLOCATE(DstWng_OutputTypeData%Vind(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_OutputTypeData%Vind.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_OutputTypeData%Vind = SrcWng_OutputTypeData%Vind -ENDIF - END SUBROUTINE FVW_CopyWng_OutputType - SUBROUTINE FVW_DestroyWng_OutputType( Wng_OutputTypeData, ErrStat, ErrMsg ) - TYPE(Wng_OutputType), INTENT(INOUT) :: Wng_OutputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyWng_OutputType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(Wng_OutputTypeData%Vind)) THEN - DEALLOCATE(Wng_OutputTypeData%Vind) -ENDIF - END SUBROUTINE FVW_DestroyWng_OutputType +subroutine FVW_CopyWng_OutputType(SrcWng_OutputTypeData, DstWng_OutputTypeData, CtrlCode, ErrStat, ErrMsg) + type(Wng_OutputType), intent(in) :: SrcWng_OutputTypeData + type(Wng_OutputType), intent(inout) :: DstWng_OutputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FVW_CopyWng_OutputType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcWng_OutputTypeData%Vind)) then + LB(1:2) = lbound(SrcWng_OutputTypeData%Vind) + UB(1:2) = ubound(SrcWng_OutputTypeData%Vind) + if (.not. allocated(DstWng_OutputTypeData%Vind)) then + allocate(DstWng_OutputTypeData%Vind(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_OutputTypeData%Vind.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_OutputTypeData%Vind = SrcWng_OutputTypeData%Vind + else if (allocated(DstWng_OutputTypeData%Vind)) then + deallocate(DstWng_OutputTypeData%Vind) + end if +end subroutine +subroutine FVW_DestroyWng_OutputType(Wng_OutputTypeData, ErrStat, ErrMsg) + type(Wng_OutputType), intent(inout) :: Wng_OutputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FVW_DestroyWng_OutputType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(Wng_OutputTypeData%Vind)) then + deallocate(Wng_OutputTypeData%Vind) + end if +end subroutine subroutine FVW_PackWng_OutputType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Wng_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackWng_OutputType' if (Buf%ErrStat >= AbortErrLev) return - ! Vind call RegPack(Buf, allocated(InData%Vind)) if (allocated(InData%Vind)) then call RegPackBounds(Buf, 2, lbound(InData%Vind), ubound(InData%Vind)) @@ -2277,7 +2022,6 @@ subroutine FVW_UnPackWng_OutputType(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! Vind if (allocated(OutData%Vind)) deallocate(OutData%Vind) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2293,61 +2037,61 @@ subroutine FVW_UnPackWng_OutputType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE FVW_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FVW_OutputType), INTENT(IN) :: SrcOutputData - TYPE(FVW_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_CopyOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%W)) THEN - i1_l = LBOUND(SrcOutputData%W,1) - i1_u = UBOUND(SrcOutputData%W,1) - IF (.NOT. ALLOCATED(DstOutputData%W)) THEN - ALLOCATE(DstOutputData%W(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%W.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOutputData%W,1), UBOUND(SrcOutputData%W,1) - CALL FVW_Copywng_outputtype( SrcOutputData%W(i1), DstOutputData%W(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE FVW_CopyOutput - - SUBROUTINE FVW_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(FVW_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyOutput' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OutputData%W)) THEN -DO i1 = LBOUND(OutputData%W,1), UBOUND(OutputData%W,1) - CALL FVW_DestroyWng_OutputType( OutputData%W(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OutputData%W) -ENDIF - END SUBROUTINE FVW_DestroyOutput +subroutine FVW_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(FVW_OutputType), intent(in) :: SrcOutputData + type(FVW_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%W)) then + LB(1:1) = lbound(SrcOutputData%W) + UB(1:1) = ubound(SrcOutputData%W) + if (.not. allocated(DstOutputData%W)) then + allocate(DstOutputData%W(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%W.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FVW_CopyWng_OutputType(SrcOutputData%W(i1), DstOutputData%W(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstOutputData%W)) then + deallocate(DstOutputData%W) + end if +end subroutine +subroutine FVW_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(FVW_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%W)) then + LB(1:1) = lbound(OutputData%W) + UB(1:1) = ubound(OutputData%W) + do i1 = LB(1), UB(1) + call FVW_DestroyWng_OutputType(OutputData%W(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%W) + end if +end subroutine subroutine FVW_PackOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -2356,7 +2100,6 @@ subroutine FVW_PackOutput(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! W call RegPack(Buf, allocated(InData%W)) if (allocated(InData%W)) then call RegPackBounds(Buf, 1, lbound(InData%W), ubound(InData%W)) @@ -2378,7 +2121,6 @@ subroutine FVW_UnPackOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! W if (allocated(OutData%W)) deallocate(OutData%W) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2395,702 +2137,722 @@ subroutine FVW_UnPackOutput(Buf, OutData) end do end if end subroutine - SUBROUTINE FVW_CopyWng_MiscVarType( SrcWng_MiscVarTypeData, DstWng_MiscVarTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Wng_MiscVarType), INTENT(IN) :: SrcWng_MiscVarTypeData - TYPE(Wng_MiscVarType), INTENT(INOUT) :: DstWng_MiscVarTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_CopyWng_MiscVarType' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcWng_MiscVarTypeData%LE)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%LE,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%LE,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%LE,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%LE,2) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%LE)) THEN - ALLOCATE(DstWng_MiscVarTypeData%LE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%LE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%LE = SrcWng_MiscVarTypeData%LE -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%TE)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%TE,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%TE,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%TE,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%TE,2) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%TE)) THEN - ALLOCATE(DstWng_MiscVarTypeData%TE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%TE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%TE = SrcWng_MiscVarTypeData%TE -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%r_LL)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%r_LL,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%r_LL,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%r_LL,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%r_LL,2) - i3_l = LBOUND(SrcWng_MiscVarTypeData%r_LL,3) - i3_u = UBOUND(SrcWng_MiscVarTypeData%r_LL,3) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%r_LL)) THEN - ALLOCATE(DstWng_MiscVarTypeData%r_LL(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%r_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%r_LL = SrcWng_MiscVarTypeData%r_LL -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%CP)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%CP,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%CP,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%CP,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%CP,2) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%CP)) THEN - ALLOCATE(DstWng_MiscVarTypeData%CP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%CP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%CP = SrcWng_MiscVarTypeData%CP -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%Tang)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%Tang,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%Tang,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%Tang,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%Tang,2) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%Tang)) THEN - ALLOCATE(DstWng_MiscVarTypeData%Tang(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Tang.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%Tang = SrcWng_MiscVarTypeData%Tang -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%Norm)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%Norm,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%Norm,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%Norm,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%Norm,2) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%Norm)) THEN - ALLOCATE(DstWng_MiscVarTypeData%Norm(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Norm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%Norm = SrcWng_MiscVarTypeData%Norm -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%Orth)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%Orth,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%Orth,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%Orth,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%Orth,2) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%Orth)) THEN - ALLOCATE(DstWng_MiscVarTypeData%Orth(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Orth.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%Orth = SrcWng_MiscVarTypeData%Orth -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%dl)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%dl,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%dl,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%dl,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%dl,2) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%dl)) THEN - ALLOCATE(DstWng_MiscVarTypeData%dl(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%dl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%dl = SrcWng_MiscVarTypeData%dl -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%Area)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%Area,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%Area,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%Area)) THEN - ALLOCATE(DstWng_MiscVarTypeData%Area(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Area.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%Area = SrcWng_MiscVarTypeData%Area -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%diag_LL)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%diag_LL,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%diag_LL,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%diag_LL)) THEN - ALLOCATE(DstWng_MiscVarTypeData%diag_LL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%diag_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%diag_LL = SrcWng_MiscVarTypeData%diag_LL -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%Vind_CP)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%Vind_CP,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%Vind_CP,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%Vind_CP,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%Vind_CP,2) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%Vind_CP)) THEN - ALLOCATE(DstWng_MiscVarTypeData%Vind_CP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vind_CP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%Vind_CP = SrcWng_MiscVarTypeData%Vind_CP -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%Vtot_CP)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%Vtot_CP,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%Vtot_CP,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%Vtot_CP,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%Vtot_CP,2) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%Vtot_CP)) THEN - ALLOCATE(DstWng_MiscVarTypeData%Vtot_CP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vtot_CP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%Vtot_CP = SrcWng_MiscVarTypeData%Vtot_CP -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%Vstr_CP)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%Vstr_CP,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%Vstr_CP,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%Vstr_CP,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%Vstr_CP,2) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%Vstr_CP)) THEN - ALLOCATE(DstWng_MiscVarTypeData%Vstr_CP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vstr_CP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%Vstr_CP = SrcWng_MiscVarTypeData%Vstr_CP -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%Vwnd_CP)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%Vwnd_CP,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%Vwnd_CP,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%Vwnd_CP,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%Vwnd_CP,2) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%Vwnd_CP)) THEN - ALLOCATE(DstWng_MiscVarTypeData%Vwnd_CP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vwnd_CP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%Vwnd_CP = SrcWng_MiscVarTypeData%Vwnd_CP -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%Vwnd_NW)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%Vwnd_NW,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%Vwnd_NW,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%Vwnd_NW,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%Vwnd_NW,2) - i3_l = LBOUND(SrcWng_MiscVarTypeData%Vwnd_NW,3) - i3_u = UBOUND(SrcWng_MiscVarTypeData%Vwnd_NW,3) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%Vwnd_NW)) THEN - ALLOCATE(DstWng_MiscVarTypeData%Vwnd_NW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vwnd_NW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%Vwnd_NW = SrcWng_MiscVarTypeData%Vwnd_NW -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%Vwnd_FW)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%Vwnd_FW,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%Vwnd_FW,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%Vwnd_FW,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%Vwnd_FW,2) - i3_l = LBOUND(SrcWng_MiscVarTypeData%Vwnd_FW,3) - i3_u = UBOUND(SrcWng_MiscVarTypeData%Vwnd_FW,3) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%Vwnd_FW)) THEN - ALLOCATE(DstWng_MiscVarTypeData%Vwnd_FW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vwnd_FW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%Vwnd_FW = SrcWng_MiscVarTypeData%Vwnd_FW -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%Vind_NW)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%Vind_NW,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%Vind_NW,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%Vind_NW,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%Vind_NW,2) - i3_l = LBOUND(SrcWng_MiscVarTypeData%Vind_NW,3) - i3_u = UBOUND(SrcWng_MiscVarTypeData%Vind_NW,3) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%Vind_NW)) THEN - ALLOCATE(DstWng_MiscVarTypeData%Vind_NW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vind_NW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%Vind_NW = SrcWng_MiscVarTypeData%Vind_NW -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%Vind_FW)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%Vind_FW,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%Vind_FW,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%Vind_FW,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%Vind_FW,2) - i3_l = LBOUND(SrcWng_MiscVarTypeData%Vind_FW,3) - i3_u = UBOUND(SrcWng_MiscVarTypeData%Vind_FW,3) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%Vind_FW)) THEN - ALLOCATE(DstWng_MiscVarTypeData%Vind_FW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vind_FW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%Vind_FW = SrcWng_MiscVarTypeData%Vind_FW -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%PitchAndTwist)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%PitchAndTwist,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%PitchAndTwist,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%PitchAndTwist)) THEN - ALLOCATE(DstWng_MiscVarTypeData%PitchAndTwist(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%PitchAndTwist.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%PitchAndTwist = SrcWng_MiscVarTypeData%PitchAndTwist -ENDIF - DstWng_MiscVarTypeData%iTip = SrcWng_MiscVarTypeData%iTip - DstWng_MiscVarTypeData%iRoot = SrcWng_MiscVarTypeData%iRoot -IF (ALLOCATED(SrcWng_MiscVarTypeData%alpha_LL)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%alpha_LL,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%alpha_LL,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%alpha_LL)) THEN - ALLOCATE(DstWng_MiscVarTypeData%alpha_LL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%alpha_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%alpha_LL = SrcWng_MiscVarTypeData%alpha_LL -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%Vreln_LL)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%Vreln_LL,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%Vreln_LL,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%Vreln_LL)) THEN - ALLOCATE(DstWng_MiscVarTypeData%Vreln_LL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vreln_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%Vreln_LL = SrcWng_MiscVarTypeData%Vreln_LL -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%u_UA)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%u_UA,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%u_UA,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%u_UA,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%u_UA,2) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%u_UA)) THEN - ALLOCATE(DstWng_MiscVarTypeData%u_UA(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%u_UA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcWng_MiscVarTypeData%u_UA,2), UBOUND(SrcWng_MiscVarTypeData%u_UA,2) - DO i1 = LBOUND(SrcWng_MiscVarTypeData%u_UA,1), UBOUND(SrcWng_MiscVarTypeData%u_UA,1) - CALL UA_CopyInput( SrcWng_MiscVarTypeData%u_UA(i1,i2), DstWng_MiscVarTypeData%u_UA(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF - CALL UA_CopyMisc( SrcWng_MiscVarTypeData%m_UA, DstWng_MiscVarTypeData%m_UA, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL UA_CopyOutput( SrcWng_MiscVarTypeData%y_UA, DstWng_MiscVarTypeData%y_UA, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL UA_CopyParam( SrcWng_MiscVarTypeData%p_UA, DstWng_MiscVarTypeData%p_UA, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcWng_MiscVarTypeData%Vind_LL)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%Vind_LL,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%Vind_LL,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%Vind_LL,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%Vind_LL,2) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%Vind_LL)) THEN - ALLOCATE(DstWng_MiscVarTypeData%Vind_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vind_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%Vind_LL = SrcWng_MiscVarTypeData%Vind_LL -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_AxInd)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_AxInd,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_AxInd,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_AxInd)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_AxInd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_AxInd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_AxInd = SrcWng_MiscVarTypeData%BN_AxInd -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_TanInd)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_TanInd,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_TanInd,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_TanInd)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_TanInd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_TanInd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_TanInd = SrcWng_MiscVarTypeData%BN_TanInd -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_Vrel)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_Vrel,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_Vrel,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_Vrel)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_Vrel(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Vrel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_Vrel = SrcWng_MiscVarTypeData%BN_Vrel -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_alpha)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_alpha,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_alpha,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_alpha)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_alpha(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_alpha.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_alpha = SrcWng_MiscVarTypeData%BN_alpha -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_phi)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_phi,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_phi,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_phi)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_phi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_phi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_phi = SrcWng_MiscVarTypeData%BN_phi -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_Re)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_Re,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_Re,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_Re)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_Re(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Re.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_Re = SrcWng_MiscVarTypeData%BN_Re -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_URelWind_s)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_URelWind_s,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_URelWind_s,1) - i2_l = LBOUND(SrcWng_MiscVarTypeData%BN_URelWind_s,2) - i2_u = UBOUND(SrcWng_MiscVarTypeData%BN_URelWind_s,2) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_URelWind_s)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_URelWind_s(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_URelWind_s.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_URelWind_s = SrcWng_MiscVarTypeData%BN_URelWind_s -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_Cl_Static)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_Cl_Static,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_Cl_Static,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_Cl_Static)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_Cl_Static(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cl_Static.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_Cl_Static = SrcWng_MiscVarTypeData%BN_Cl_Static -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_Cd_Static)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_Cd_Static,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_Cd_Static,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_Cd_Static)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_Cd_Static(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cd_Static.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_Cd_Static = SrcWng_MiscVarTypeData%BN_Cd_Static -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_Cm_Static)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_Cm_Static,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_Cm_Static,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_Cm_Static)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_Cm_Static(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cm_Static.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_Cm_Static = SrcWng_MiscVarTypeData%BN_Cm_Static -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_Cpmin)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_Cpmin,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_Cpmin,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_Cpmin)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_Cpmin(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cpmin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_Cpmin = SrcWng_MiscVarTypeData%BN_Cpmin -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_Cl)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_Cl,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_Cl,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_Cl)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_Cl(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_Cl = SrcWng_MiscVarTypeData%BN_Cl -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_Cd)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_Cd,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_Cd,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_Cd)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_Cd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_Cd = SrcWng_MiscVarTypeData%BN_Cd -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_Cm)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_Cm,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_Cm,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_Cm)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_Cm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_Cm = SrcWng_MiscVarTypeData%BN_Cm -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_Cx)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_Cx,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_Cx,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_Cx)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_Cx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_Cx = SrcWng_MiscVarTypeData%BN_Cx -ENDIF -IF (ALLOCATED(SrcWng_MiscVarTypeData%BN_Cy)) THEN - i1_l = LBOUND(SrcWng_MiscVarTypeData%BN_Cy,1) - i1_u = UBOUND(SrcWng_MiscVarTypeData%BN_Cy,1) - IF (.NOT. ALLOCATED(DstWng_MiscVarTypeData%BN_Cy)) THEN - ALLOCATE(DstWng_MiscVarTypeData%BN_Cy(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_MiscVarTypeData%BN_Cy = SrcWng_MiscVarTypeData%BN_Cy -ENDIF - END SUBROUTINE FVW_CopyWng_MiscVarType - - SUBROUTINE FVW_DestroyWng_MiscVarType( Wng_MiscVarTypeData, ErrStat, ErrMsg ) - TYPE(Wng_MiscVarType), INTENT(INOUT) :: Wng_MiscVarTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyWng_MiscVarType' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(Wng_MiscVarTypeData%LE)) THEN - DEALLOCATE(Wng_MiscVarTypeData%LE) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%TE)) THEN - DEALLOCATE(Wng_MiscVarTypeData%TE) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%r_LL)) THEN - DEALLOCATE(Wng_MiscVarTypeData%r_LL) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%CP)) THEN - DEALLOCATE(Wng_MiscVarTypeData%CP) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%Tang)) THEN - DEALLOCATE(Wng_MiscVarTypeData%Tang) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%Norm)) THEN - DEALLOCATE(Wng_MiscVarTypeData%Norm) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%Orth)) THEN - DEALLOCATE(Wng_MiscVarTypeData%Orth) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%dl)) THEN - DEALLOCATE(Wng_MiscVarTypeData%dl) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%Area)) THEN - DEALLOCATE(Wng_MiscVarTypeData%Area) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%diag_LL)) THEN - DEALLOCATE(Wng_MiscVarTypeData%diag_LL) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%Vind_CP)) THEN - DEALLOCATE(Wng_MiscVarTypeData%Vind_CP) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%Vtot_CP)) THEN - DEALLOCATE(Wng_MiscVarTypeData%Vtot_CP) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%Vstr_CP)) THEN - DEALLOCATE(Wng_MiscVarTypeData%Vstr_CP) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%Vwnd_CP)) THEN - DEALLOCATE(Wng_MiscVarTypeData%Vwnd_CP) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%Vwnd_NW)) THEN - DEALLOCATE(Wng_MiscVarTypeData%Vwnd_NW) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%Vwnd_FW)) THEN - DEALLOCATE(Wng_MiscVarTypeData%Vwnd_FW) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%Vind_NW)) THEN - DEALLOCATE(Wng_MiscVarTypeData%Vind_NW) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%Vind_FW)) THEN - DEALLOCATE(Wng_MiscVarTypeData%Vind_FW) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%PitchAndTwist)) THEN - DEALLOCATE(Wng_MiscVarTypeData%PitchAndTwist) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%alpha_LL)) THEN - DEALLOCATE(Wng_MiscVarTypeData%alpha_LL) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%Vreln_LL)) THEN - DEALLOCATE(Wng_MiscVarTypeData%Vreln_LL) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%u_UA)) THEN -DO i2 = LBOUND(Wng_MiscVarTypeData%u_UA,2), UBOUND(Wng_MiscVarTypeData%u_UA,2) -DO i1 = LBOUND(Wng_MiscVarTypeData%u_UA,1), UBOUND(Wng_MiscVarTypeData%u_UA,1) - CALL UA_DestroyInput( Wng_MiscVarTypeData%u_UA(i1,i2), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(Wng_MiscVarTypeData%u_UA) -ENDIF - CALL UA_DestroyMisc( Wng_MiscVarTypeData%m_UA, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL UA_DestroyOutput( Wng_MiscVarTypeData%y_UA, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL UA_DestroyParam( Wng_MiscVarTypeData%p_UA, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(Wng_MiscVarTypeData%Vind_LL)) THEN - DEALLOCATE(Wng_MiscVarTypeData%Vind_LL) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_AxInd)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_AxInd) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_TanInd)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_TanInd) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_Vrel)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_Vrel) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_alpha)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_alpha) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_phi)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_phi) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_Re)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_Re) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_URelWind_s)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_URelWind_s) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_Cl_Static)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_Cl_Static) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_Cd_Static)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_Cd_Static) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_Cm_Static)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_Cm_Static) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_Cpmin)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_Cpmin) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_Cl)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_Cl) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_Cd)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_Cd) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_Cm)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_Cm) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_Cx)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_Cx) -ENDIF -IF (ALLOCATED(Wng_MiscVarTypeData%BN_Cy)) THEN - DEALLOCATE(Wng_MiscVarTypeData%BN_Cy) -ENDIF - END SUBROUTINE FVW_DestroyWng_MiscVarType +subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeData, CtrlCode, ErrStat, ErrMsg) + type(Wng_MiscVarType), intent(in) :: SrcWng_MiscVarTypeData + type(Wng_MiscVarType), intent(inout) :: DstWng_MiscVarTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_CopyWng_MiscVarType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcWng_MiscVarTypeData%LE)) then + LB(1:2) = lbound(SrcWng_MiscVarTypeData%LE) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%LE) + if (.not. allocated(DstWng_MiscVarTypeData%LE)) then + allocate(DstWng_MiscVarTypeData%LE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%LE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%LE = SrcWng_MiscVarTypeData%LE + else if (allocated(DstWng_MiscVarTypeData%LE)) then + deallocate(DstWng_MiscVarTypeData%LE) + end if + if (allocated(SrcWng_MiscVarTypeData%TE)) then + LB(1:2) = lbound(SrcWng_MiscVarTypeData%TE) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%TE) + if (.not. allocated(DstWng_MiscVarTypeData%TE)) then + allocate(DstWng_MiscVarTypeData%TE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%TE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%TE = SrcWng_MiscVarTypeData%TE + else if (allocated(DstWng_MiscVarTypeData%TE)) then + deallocate(DstWng_MiscVarTypeData%TE) + end if + if (allocated(SrcWng_MiscVarTypeData%r_LL)) then + LB(1:3) = lbound(SrcWng_MiscVarTypeData%r_LL) + UB(1:3) = ubound(SrcWng_MiscVarTypeData%r_LL) + if (.not. allocated(DstWng_MiscVarTypeData%r_LL)) then + allocate(DstWng_MiscVarTypeData%r_LL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%r_LL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%r_LL = SrcWng_MiscVarTypeData%r_LL + else if (allocated(DstWng_MiscVarTypeData%r_LL)) then + deallocate(DstWng_MiscVarTypeData%r_LL) + end if + if (allocated(SrcWng_MiscVarTypeData%CP)) then + LB(1:2) = lbound(SrcWng_MiscVarTypeData%CP) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%CP) + if (.not. allocated(DstWng_MiscVarTypeData%CP)) then + allocate(DstWng_MiscVarTypeData%CP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%CP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%CP = SrcWng_MiscVarTypeData%CP + else if (allocated(DstWng_MiscVarTypeData%CP)) then + deallocate(DstWng_MiscVarTypeData%CP) + end if + if (allocated(SrcWng_MiscVarTypeData%Tang)) then + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Tang) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Tang) + if (.not. allocated(DstWng_MiscVarTypeData%Tang)) then + allocate(DstWng_MiscVarTypeData%Tang(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Tang.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%Tang = SrcWng_MiscVarTypeData%Tang + else if (allocated(DstWng_MiscVarTypeData%Tang)) then + deallocate(DstWng_MiscVarTypeData%Tang) + end if + if (allocated(SrcWng_MiscVarTypeData%Norm)) then + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Norm) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Norm) + if (.not. allocated(DstWng_MiscVarTypeData%Norm)) then + allocate(DstWng_MiscVarTypeData%Norm(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Norm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%Norm = SrcWng_MiscVarTypeData%Norm + else if (allocated(DstWng_MiscVarTypeData%Norm)) then + deallocate(DstWng_MiscVarTypeData%Norm) + end if + if (allocated(SrcWng_MiscVarTypeData%Orth)) then + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Orth) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Orth) + if (.not. allocated(DstWng_MiscVarTypeData%Orth)) then + allocate(DstWng_MiscVarTypeData%Orth(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Orth.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%Orth = SrcWng_MiscVarTypeData%Orth + else if (allocated(DstWng_MiscVarTypeData%Orth)) then + deallocate(DstWng_MiscVarTypeData%Orth) + end if + if (allocated(SrcWng_MiscVarTypeData%dl)) then + LB(1:2) = lbound(SrcWng_MiscVarTypeData%dl) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%dl) + if (.not. allocated(DstWng_MiscVarTypeData%dl)) then + allocate(DstWng_MiscVarTypeData%dl(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%dl.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%dl = SrcWng_MiscVarTypeData%dl + else if (allocated(DstWng_MiscVarTypeData%dl)) then + deallocate(DstWng_MiscVarTypeData%dl) + end if + if (allocated(SrcWng_MiscVarTypeData%Area)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%Area) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%Area) + if (.not. allocated(DstWng_MiscVarTypeData%Area)) then + allocate(DstWng_MiscVarTypeData%Area(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Area.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%Area = SrcWng_MiscVarTypeData%Area + else if (allocated(DstWng_MiscVarTypeData%Area)) then + deallocate(DstWng_MiscVarTypeData%Area) + end if + if (allocated(SrcWng_MiscVarTypeData%diag_LL)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%diag_LL) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%diag_LL) + if (.not. allocated(DstWng_MiscVarTypeData%diag_LL)) then + allocate(DstWng_MiscVarTypeData%diag_LL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%diag_LL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%diag_LL = SrcWng_MiscVarTypeData%diag_LL + else if (allocated(DstWng_MiscVarTypeData%diag_LL)) then + deallocate(DstWng_MiscVarTypeData%diag_LL) + end if + if (allocated(SrcWng_MiscVarTypeData%Vind_CP)) then + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vind_CP) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Vind_CP) + if (.not. allocated(DstWng_MiscVarTypeData%Vind_CP)) then + allocate(DstWng_MiscVarTypeData%Vind_CP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vind_CP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%Vind_CP = SrcWng_MiscVarTypeData%Vind_CP + else if (allocated(DstWng_MiscVarTypeData%Vind_CP)) then + deallocate(DstWng_MiscVarTypeData%Vind_CP) + end if + if (allocated(SrcWng_MiscVarTypeData%Vtot_CP)) then + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vtot_CP) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Vtot_CP) + if (.not. allocated(DstWng_MiscVarTypeData%Vtot_CP)) then + allocate(DstWng_MiscVarTypeData%Vtot_CP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vtot_CP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%Vtot_CP = SrcWng_MiscVarTypeData%Vtot_CP + else if (allocated(DstWng_MiscVarTypeData%Vtot_CP)) then + deallocate(DstWng_MiscVarTypeData%Vtot_CP) + end if + if (allocated(SrcWng_MiscVarTypeData%Vstr_CP)) then + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vstr_CP) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Vstr_CP) + if (.not. allocated(DstWng_MiscVarTypeData%Vstr_CP)) then + allocate(DstWng_MiscVarTypeData%Vstr_CP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vstr_CP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%Vstr_CP = SrcWng_MiscVarTypeData%Vstr_CP + else if (allocated(DstWng_MiscVarTypeData%Vstr_CP)) then + deallocate(DstWng_MiscVarTypeData%Vstr_CP) + end if + if (allocated(SrcWng_MiscVarTypeData%Vwnd_CP)) then + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vwnd_CP) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Vwnd_CP) + if (.not. allocated(DstWng_MiscVarTypeData%Vwnd_CP)) then + allocate(DstWng_MiscVarTypeData%Vwnd_CP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vwnd_CP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%Vwnd_CP = SrcWng_MiscVarTypeData%Vwnd_CP + else if (allocated(DstWng_MiscVarTypeData%Vwnd_CP)) then + deallocate(DstWng_MiscVarTypeData%Vwnd_CP) + end if + if (allocated(SrcWng_MiscVarTypeData%Vwnd_NW)) then + LB(1:3) = lbound(SrcWng_MiscVarTypeData%Vwnd_NW) + UB(1:3) = ubound(SrcWng_MiscVarTypeData%Vwnd_NW) + if (.not. allocated(DstWng_MiscVarTypeData%Vwnd_NW)) then + allocate(DstWng_MiscVarTypeData%Vwnd_NW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vwnd_NW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%Vwnd_NW = SrcWng_MiscVarTypeData%Vwnd_NW + else if (allocated(DstWng_MiscVarTypeData%Vwnd_NW)) then + deallocate(DstWng_MiscVarTypeData%Vwnd_NW) + end if + if (allocated(SrcWng_MiscVarTypeData%Vwnd_FW)) then + LB(1:3) = lbound(SrcWng_MiscVarTypeData%Vwnd_FW) + UB(1:3) = ubound(SrcWng_MiscVarTypeData%Vwnd_FW) + if (.not. allocated(DstWng_MiscVarTypeData%Vwnd_FW)) then + allocate(DstWng_MiscVarTypeData%Vwnd_FW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vwnd_FW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%Vwnd_FW = SrcWng_MiscVarTypeData%Vwnd_FW + else if (allocated(DstWng_MiscVarTypeData%Vwnd_FW)) then + deallocate(DstWng_MiscVarTypeData%Vwnd_FW) + end if + if (allocated(SrcWng_MiscVarTypeData%Vind_NW)) then + LB(1:3) = lbound(SrcWng_MiscVarTypeData%Vind_NW) + UB(1:3) = ubound(SrcWng_MiscVarTypeData%Vind_NW) + if (.not. allocated(DstWng_MiscVarTypeData%Vind_NW)) then + allocate(DstWng_MiscVarTypeData%Vind_NW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vind_NW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%Vind_NW = SrcWng_MiscVarTypeData%Vind_NW + else if (allocated(DstWng_MiscVarTypeData%Vind_NW)) then + deallocate(DstWng_MiscVarTypeData%Vind_NW) + end if + if (allocated(SrcWng_MiscVarTypeData%Vind_FW)) then + LB(1:3) = lbound(SrcWng_MiscVarTypeData%Vind_FW) + UB(1:3) = ubound(SrcWng_MiscVarTypeData%Vind_FW) + if (.not. allocated(DstWng_MiscVarTypeData%Vind_FW)) then + allocate(DstWng_MiscVarTypeData%Vind_FW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vind_FW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%Vind_FW = SrcWng_MiscVarTypeData%Vind_FW + else if (allocated(DstWng_MiscVarTypeData%Vind_FW)) then + deallocate(DstWng_MiscVarTypeData%Vind_FW) + end if + if (allocated(SrcWng_MiscVarTypeData%PitchAndTwist)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%PitchAndTwist) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%PitchAndTwist) + if (.not. allocated(DstWng_MiscVarTypeData%PitchAndTwist)) then + allocate(DstWng_MiscVarTypeData%PitchAndTwist(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%PitchAndTwist.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%PitchAndTwist = SrcWng_MiscVarTypeData%PitchAndTwist + else if (allocated(DstWng_MiscVarTypeData%PitchAndTwist)) then + deallocate(DstWng_MiscVarTypeData%PitchAndTwist) + end if + DstWng_MiscVarTypeData%iTip = SrcWng_MiscVarTypeData%iTip + DstWng_MiscVarTypeData%iRoot = SrcWng_MiscVarTypeData%iRoot + if (allocated(SrcWng_MiscVarTypeData%alpha_LL)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%alpha_LL) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%alpha_LL) + if (.not. allocated(DstWng_MiscVarTypeData%alpha_LL)) then + allocate(DstWng_MiscVarTypeData%alpha_LL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%alpha_LL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%alpha_LL = SrcWng_MiscVarTypeData%alpha_LL + else if (allocated(DstWng_MiscVarTypeData%alpha_LL)) then + deallocate(DstWng_MiscVarTypeData%alpha_LL) + end if + if (allocated(SrcWng_MiscVarTypeData%Vreln_LL)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%Vreln_LL) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%Vreln_LL) + if (.not. allocated(DstWng_MiscVarTypeData%Vreln_LL)) then + allocate(DstWng_MiscVarTypeData%Vreln_LL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vreln_LL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%Vreln_LL = SrcWng_MiscVarTypeData%Vreln_LL + else if (allocated(DstWng_MiscVarTypeData%Vreln_LL)) then + deallocate(DstWng_MiscVarTypeData%Vreln_LL) + end if + if (allocated(SrcWng_MiscVarTypeData%u_UA)) then + LB(1:2) = lbound(SrcWng_MiscVarTypeData%u_UA) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%u_UA) + if (.not. allocated(DstWng_MiscVarTypeData%u_UA)) then + allocate(DstWng_MiscVarTypeData%u_UA(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%u_UA.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call UA_CopyInput(SrcWng_MiscVarTypeData%u_UA(i1,i2), DstWng_MiscVarTypeData%u_UA(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + else if (allocated(DstWng_MiscVarTypeData%u_UA)) then + deallocate(DstWng_MiscVarTypeData%u_UA) + end if + call UA_CopyMisc(SrcWng_MiscVarTypeData%m_UA, DstWng_MiscVarTypeData%m_UA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call UA_CopyOutput(SrcWng_MiscVarTypeData%y_UA, DstWng_MiscVarTypeData%y_UA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call UA_CopyParam(SrcWng_MiscVarTypeData%p_UA, DstWng_MiscVarTypeData%p_UA, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcWng_MiscVarTypeData%Vind_LL)) then + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vind_LL) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Vind_LL) + if (.not. allocated(DstWng_MiscVarTypeData%Vind_LL)) then + allocate(DstWng_MiscVarTypeData%Vind_LL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%Vind_LL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%Vind_LL = SrcWng_MiscVarTypeData%Vind_LL + else if (allocated(DstWng_MiscVarTypeData%Vind_LL)) then + deallocate(DstWng_MiscVarTypeData%Vind_LL) + end if + if (allocated(SrcWng_MiscVarTypeData%BN_AxInd)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_AxInd) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_AxInd) + if (.not. allocated(DstWng_MiscVarTypeData%BN_AxInd)) then + allocate(DstWng_MiscVarTypeData%BN_AxInd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_AxInd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_AxInd = SrcWng_MiscVarTypeData%BN_AxInd + else if (allocated(DstWng_MiscVarTypeData%BN_AxInd)) then + deallocate(DstWng_MiscVarTypeData%BN_AxInd) + end if + if (allocated(SrcWng_MiscVarTypeData%BN_TanInd)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_TanInd) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_TanInd) + if (.not. allocated(DstWng_MiscVarTypeData%BN_TanInd)) then + allocate(DstWng_MiscVarTypeData%BN_TanInd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_TanInd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_TanInd = SrcWng_MiscVarTypeData%BN_TanInd + else if (allocated(DstWng_MiscVarTypeData%BN_TanInd)) then + deallocate(DstWng_MiscVarTypeData%BN_TanInd) + end if + if (allocated(SrcWng_MiscVarTypeData%BN_Vrel)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Vrel) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Vrel) + if (.not. allocated(DstWng_MiscVarTypeData%BN_Vrel)) then + allocate(DstWng_MiscVarTypeData%BN_Vrel(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Vrel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_Vrel = SrcWng_MiscVarTypeData%BN_Vrel + else if (allocated(DstWng_MiscVarTypeData%BN_Vrel)) then + deallocate(DstWng_MiscVarTypeData%BN_Vrel) + end if + if (allocated(SrcWng_MiscVarTypeData%BN_alpha)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_alpha) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_alpha) + if (.not. allocated(DstWng_MiscVarTypeData%BN_alpha)) then + allocate(DstWng_MiscVarTypeData%BN_alpha(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_alpha.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_alpha = SrcWng_MiscVarTypeData%BN_alpha + else if (allocated(DstWng_MiscVarTypeData%BN_alpha)) then + deallocate(DstWng_MiscVarTypeData%BN_alpha) + end if + if (allocated(SrcWng_MiscVarTypeData%BN_phi)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_phi) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_phi) + if (.not. allocated(DstWng_MiscVarTypeData%BN_phi)) then + allocate(DstWng_MiscVarTypeData%BN_phi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_phi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_phi = SrcWng_MiscVarTypeData%BN_phi + else if (allocated(DstWng_MiscVarTypeData%BN_phi)) then + deallocate(DstWng_MiscVarTypeData%BN_phi) + end if + if (allocated(SrcWng_MiscVarTypeData%BN_Re)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Re) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Re) + if (.not. allocated(DstWng_MiscVarTypeData%BN_Re)) then + allocate(DstWng_MiscVarTypeData%BN_Re(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Re.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_Re = SrcWng_MiscVarTypeData%BN_Re + else if (allocated(DstWng_MiscVarTypeData%BN_Re)) then + deallocate(DstWng_MiscVarTypeData%BN_Re) + end if + if (allocated(SrcWng_MiscVarTypeData%BN_URelWind_s)) then + LB(1:2) = lbound(SrcWng_MiscVarTypeData%BN_URelWind_s) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%BN_URelWind_s) + if (.not. allocated(DstWng_MiscVarTypeData%BN_URelWind_s)) then + allocate(DstWng_MiscVarTypeData%BN_URelWind_s(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_URelWind_s.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_URelWind_s = SrcWng_MiscVarTypeData%BN_URelWind_s + else if (allocated(DstWng_MiscVarTypeData%BN_URelWind_s)) then + deallocate(DstWng_MiscVarTypeData%BN_URelWind_s) + end if + if (allocated(SrcWng_MiscVarTypeData%BN_Cl_Static)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cl_Static) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cl_Static) + if (.not. allocated(DstWng_MiscVarTypeData%BN_Cl_Static)) then + allocate(DstWng_MiscVarTypeData%BN_Cl_Static(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cl_Static.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_Cl_Static = SrcWng_MiscVarTypeData%BN_Cl_Static + else if (allocated(DstWng_MiscVarTypeData%BN_Cl_Static)) then + deallocate(DstWng_MiscVarTypeData%BN_Cl_Static) + end if + if (allocated(SrcWng_MiscVarTypeData%BN_Cd_Static)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cd_Static) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cd_Static) + if (.not. allocated(DstWng_MiscVarTypeData%BN_Cd_Static)) then + allocate(DstWng_MiscVarTypeData%BN_Cd_Static(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cd_Static.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_Cd_Static = SrcWng_MiscVarTypeData%BN_Cd_Static + else if (allocated(DstWng_MiscVarTypeData%BN_Cd_Static)) then + deallocate(DstWng_MiscVarTypeData%BN_Cd_Static) + end if + if (allocated(SrcWng_MiscVarTypeData%BN_Cm_Static)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cm_Static) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cm_Static) + if (.not. allocated(DstWng_MiscVarTypeData%BN_Cm_Static)) then + allocate(DstWng_MiscVarTypeData%BN_Cm_Static(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cm_Static.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_Cm_Static = SrcWng_MiscVarTypeData%BN_Cm_Static + else if (allocated(DstWng_MiscVarTypeData%BN_Cm_Static)) then + deallocate(DstWng_MiscVarTypeData%BN_Cm_Static) + end if + if (allocated(SrcWng_MiscVarTypeData%BN_Cpmin)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cpmin) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cpmin) + if (.not. allocated(DstWng_MiscVarTypeData%BN_Cpmin)) then + allocate(DstWng_MiscVarTypeData%BN_Cpmin(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cpmin.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_Cpmin = SrcWng_MiscVarTypeData%BN_Cpmin + else if (allocated(DstWng_MiscVarTypeData%BN_Cpmin)) then + deallocate(DstWng_MiscVarTypeData%BN_Cpmin) + end if + if (allocated(SrcWng_MiscVarTypeData%BN_Cl)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cl) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cl) + if (.not. allocated(DstWng_MiscVarTypeData%BN_Cl)) then + allocate(DstWng_MiscVarTypeData%BN_Cl(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cl.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_Cl = SrcWng_MiscVarTypeData%BN_Cl + else if (allocated(DstWng_MiscVarTypeData%BN_Cl)) then + deallocate(DstWng_MiscVarTypeData%BN_Cl) + end if + if (allocated(SrcWng_MiscVarTypeData%BN_Cd)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cd) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cd) + if (.not. allocated(DstWng_MiscVarTypeData%BN_Cd)) then + allocate(DstWng_MiscVarTypeData%BN_Cd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_Cd = SrcWng_MiscVarTypeData%BN_Cd + else if (allocated(DstWng_MiscVarTypeData%BN_Cd)) then + deallocate(DstWng_MiscVarTypeData%BN_Cd) + end if + if (allocated(SrcWng_MiscVarTypeData%BN_Cm)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cm) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cm) + if (.not. allocated(DstWng_MiscVarTypeData%BN_Cm)) then + allocate(DstWng_MiscVarTypeData%BN_Cm(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_Cm = SrcWng_MiscVarTypeData%BN_Cm + else if (allocated(DstWng_MiscVarTypeData%BN_Cm)) then + deallocate(DstWng_MiscVarTypeData%BN_Cm) + end if + if (allocated(SrcWng_MiscVarTypeData%BN_Cx)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cx) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cx) + if (.not. allocated(DstWng_MiscVarTypeData%BN_Cx)) then + allocate(DstWng_MiscVarTypeData%BN_Cx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_Cx = SrcWng_MiscVarTypeData%BN_Cx + else if (allocated(DstWng_MiscVarTypeData%BN_Cx)) then + deallocate(DstWng_MiscVarTypeData%BN_Cx) + end if + if (allocated(SrcWng_MiscVarTypeData%BN_Cy)) then + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cy) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cy) + if (.not. allocated(DstWng_MiscVarTypeData%BN_Cy)) then + allocate(DstWng_MiscVarTypeData%BN_Cy(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_MiscVarTypeData%BN_Cy.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_MiscVarTypeData%BN_Cy = SrcWng_MiscVarTypeData%BN_Cy + else if (allocated(DstWng_MiscVarTypeData%BN_Cy)) then + deallocate(DstWng_MiscVarTypeData%BN_Cy) + end if +end subroutine +subroutine FVW_DestroyWng_MiscVarType(Wng_MiscVarTypeData, ErrStat, ErrMsg) + type(Wng_MiscVarType), intent(inout) :: Wng_MiscVarTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_DestroyWng_MiscVarType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(Wng_MiscVarTypeData%LE)) then + deallocate(Wng_MiscVarTypeData%LE) + end if + if (allocated(Wng_MiscVarTypeData%TE)) then + deallocate(Wng_MiscVarTypeData%TE) + end if + if (allocated(Wng_MiscVarTypeData%r_LL)) then + deallocate(Wng_MiscVarTypeData%r_LL) + end if + if (allocated(Wng_MiscVarTypeData%CP)) then + deallocate(Wng_MiscVarTypeData%CP) + end if + if (allocated(Wng_MiscVarTypeData%Tang)) then + deallocate(Wng_MiscVarTypeData%Tang) + end if + if (allocated(Wng_MiscVarTypeData%Norm)) then + deallocate(Wng_MiscVarTypeData%Norm) + end if + if (allocated(Wng_MiscVarTypeData%Orth)) then + deallocate(Wng_MiscVarTypeData%Orth) + end if + if (allocated(Wng_MiscVarTypeData%dl)) then + deallocate(Wng_MiscVarTypeData%dl) + end if + if (allocated(Wng_MiscVarTypeData%Area)) then + deallocate(Wng_MiscVarTypeData%Area) + end if + if (allocated(Wng_MiscVarTypeData%diag_LL)) then + deallocate(Wng_MiscVarTypeData%diag_LL) + end if + if (allocated(Wng_MiscVarTypeData%Vind_CP)) then + deallocate(Wng_MiscVarTypeData%Vind_CP) + end if + if (allocated(Wng_MiscVarTypeData%Vtot_CP)) then + deallocate(Wng_MiscVarTypeData%Vtot_CP) + end if + if (allocated(Wng_MiscVarTypeData%Vstr_CP)) then + deallocate(Wng_MiscVarTypeData%Vstr_CP) + end if + if (allocated(Wng_MiscVarTypeData%Vwnd_CP)) then + deallocate(Wng_MiscVarTypeData%Vwnd_CP) + end if + if (allocated(Wng_MiscVarTypeData%Vwnd_NW)) then + deallocate(Wng_MiscVarTypeData%Vwnd_NW) + end if + if (allocated(Wng_MiscVarTypeData%Vwnd_FW)) then + deallocate(Wng_MiscVarTypeData%Vwnd_FW) + end if + if (allocated(Wng_MiscVarTypeData%Vind_NW)) then + deallocate(Wng_MiscVarTypeData%Vind_NW) + end if + if (allocated(Wng_MiscVarTypeData%Vind_FW)) then + deallocate(Wng_MiscVarTypeData%Vind_FW) + end if + if (allocated(Wng_MiscVarTypeData%PitchAndTwist)) then + deallocate(Wng_MiscVarTypeData%PitchAndTwist) + end if + if (allocated(Wng_MiscVarTypeData%alpha_LL)) then + deallocate(Wng_MiscVarTypeData%alpha_LL) + end if + if (allocated(Wng_MiscVarTypeData%Vreln_LL)) then + deallocate(Wng_MiscVarTypeData%Vreln_LL) + end if + if (allocated(Wng_MiscVarTypeData%u_UA)) then + LB(1:2) = lbound(Wng_MiscVarTypeData%u_UA) + UB(1:2) = ubound(Wng_MiscVarTypeData%u_UA) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call UA_DestroyInput(Wng_MiscVarTypeData%u_UA(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(Wng_MiscVarTypeData%u_UA) + end if + if (allocated(Wng_MiscVarTypeData%Vind_LL)) then + deallocate(Wng_MiscVarTypeData%Vind_LL) + end if + if (allocated(Wng_MiscVarTypeData%BN_AxInd)) then + deallocate(Wng_MiscVarTypeData%BN_AxInd) + end if + if (allocated(Wng_MiscVarTypeData%BN_TanInd)) then + deallocate(Wng_MiscVarTypeData%BN_TanInd) + end if + if (allocated(Wng_MiscVarTypeData%BN_Vrel)) then + deallocate(Wng_MiscVarTypeData%BN_Vrel) + end if + if (allocated(Wng_MiscVarTypeData%BN_alpha)) then + deallocate(Wng_MiscVarTypeData%BN_alpha) + end if + if (allocated(Wng_MiscVarTypeData%BN_phi)) then + deallocate(Wng_MiscVarTypeData%BN_phi) + end if + if (allocated(Wng_MiscVarTypeData%BN_Re)) then + deallocate(Wng_MiscVarTypeData%BN_Re) + end if + if (allocated(Wng_MiscVarTypeData%BN_URelWind_s)) then + deallocate(Wng_MiscVarTypeData%BN_URelWind_s) + end if + if (allocated(Wng_MiscVarTypeData%BN_Cl_Static)) then + deallocate(Wng_MiscVarTypeData%BN_Cl_Static) + end if + if (allocated(Wng_MiscVarTypeData%BN_Cd_Static)) then + deallocate(Wng_MiscVarTypeData%BN_Cd_Static) + end if + if (allocated(Wng_MiscVarTypeData%BN_Cm_Static)) then + deallocate(Wng_MiscVarTypeData%BN_Cm_Static) + end if + if (allocated(Wng_MiscVarTypeData%BN_Cpmin)) then + deallocate(Wng_MiscVarTypeData%BN_Cpmin) + end if + if (allocated(Wng_MiscVarTypeData%BN_Cl)) then + deallocate(Wng_MiscVarTypeData%BN_Cl) + end if + if (allocated(Wng_MiscVarTypeData%BN_Cd)) then + deallocate(Wng_MiscVarTypeData%BN_Cd) + end if + if (allocated(Wng_MiscVarTypeData%BN_Cm)) then + deallocate(Wng_MiscVarTypeData%BN_Cm) + end if + if (allocated(Wng_MiscVarTypeData%BN_Cx)) then + deallocate(Wng_MiscVarTypeData%BN_Cx) + end if + if (allocated(Wng_MiscVarTypeData%BN_Cy)) then + deallocate(Wng_MiscVarTypeData%BN_Cy) + end if +end subroutine subroutine FVW_PackWng_MiscVarType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -3099,160 +2861,136 @@ subroutine FVW_PackWng_MiscVarType(Buf, Indata) integer(IntKi) :: i1, i2, i3 integer(IntKi) :: LB(3), UB(3) if (Buf%ErrStat >= AbortErrLev) return - ! LE call RegPack(Buf, allocated(InData%LE)) if (allocated(InData%LE)) then call RegPackBounds(Buf, 2, lbound(InData%LE), ubound(InData%LE)) call RegPack(Buf, InData%LE) end if if (RegCheckErr(Buf, RoutineName)) return - ! TE call RegPack(Buf, allocated(InData%TE)) if (allocated(InData%TE)) then call RegPackBounds(Buf, 2, lbound(InData%TE), ubound(InData%TE)) call RegPack(Buf, InData%TE) end if if (RegCheckErr(Buf, RoutineName)) return - ! r_LL call RegPack(Buf, allocated(InData%r_LL)) if (allocated(InData%r_LL)) then call RegPackBounds(Buf, 3, lbound(InData%r_LL), ubound(InData%r_LL)) call RegPack(Buf, InData%r_LL) end if if (RegCheckErr(Buf, RoutineName)) return - ! CP call RegPack(Buf, allocated(InData%CP)) if (allocated(InData%CP)) then call RegPackBounds(Buf, 2, lbound(InData%CP), ubound(InData%CP)) call RegPack(Buf, InData%CP) end if if (RegCheckErr(Buf, RoutineName)) return - ! Tang call RegPack(Buf, allocated(InData%Tang)) if (allocated(InData%Tang)) then call RegPackBounds(Buf, 2, lbound(InData%Tang), ubound(InData%Tang)) call RegPack(Buf, InData%Tang) end if if (RegCheckErr(Buf, RoutineName)) return - ! Norm call RegPack(Buf, allocated(InData%Norm)) if (allocated(InData%Norm)) then call RegPackBounds(Buf, 2, lbound(InData%Norm), ubound(InData%Norm)) call RegPack(Buf, InData%Norm) end if if (RegCheckErr(Buf, RoutineName)) return - ! Orth call RegPack(Buf, allocated(InData%Orth)) if (allocated(InData%Orth)) then call RegPackBounds(Buf, 2, lbound(InData%Orth), ubound(InData%Orth)) call RegPack(Buf, InData%Orth) end if if (RegCheckErr(Buf, RoutineName)) return - ! dl call RegPack(Buf, allocated(InData%dl)) if (allocated(InData%dl)) then call RegPackBounds(Buf, 2, lbound(InData%dl), ubound(InData%dl)) call RegPack(Buf, InData%dl) end if if (RegCheckErr(Buf, RoutineName)) return - ! Area call RegPack(Buf, allocated(InData%Area)) if (allocated(InData%Area)) then call RegPackBounds(Buf, 1, lbound(InData%Area), ubound(InData%Area)) call RegPack(Buf, InData%Area) end if if (RegCheckErr(Buf, RoutineName)) return - ! diag_LL call RegPack(Buf, allocated(InData%diag_LL)) if (allocated(InData%diag_LL)) then call RegPackBounds(Buf, 1, lbound(InData%diag_LL), ubound(InData%diag_LL)) call RegPack(Buf, InData%diag_LL) end if if (RegCheckErr(Buf, RoutineName)) return - ! Vind_CP call RegPack(Buf, allocated(InData%Vind_CP)) if (allocated(InData%Vind_CP)) then call RegPackBounds(Buf, 2, lbound(InData%Vind_CP), ubound(InData%Vind_CP)) call RegPack(Buf, InData%Vind_CP) end if if (RegCheckErr(Buf, RoutineName)) return - ! Vtot_CP call RegPack(Buf, allocated(InData%Vtot_CP)) if (allocated(InData%Vtot_CP)) then call RegPackBounds(Buf, 2, lbound(InData%Vtot_CP), ubound(InData%Vtot_CP)) call RegPack(Buf, InData%Vtot_CP) end if if (RegCheckErr(Buf, RoutineName)) return - ! Vstr_CP call RegPack(Buf, allocated(InData%Vstr_CP)) if (allocated(InData%Vstr_CP)) then call RegPackBounds(Buf, 2, lbound(InData%Vstr_CP), ubound(InData%Vstr_CP)) call RegPack(Buf, InData%Vstr_CP) end if if (RegCheckErr(Buf, RoutineName)) return - ! Vwnd_CP call RegPack(Buf, allocated(InData%Vwnd_CP)) if (allocated(InData%Vwnd_CP)) then call RegPackBounds(Buf, 2, lbound(InData%Vwnd_CP), ubound(InData%Vwnd_CP)) call RegPack(Buf, InData%Vwnd_CP) end if if (RegCheckErr(Buf, RoutineName)) return - ! Vwnd_NW call RegPack(Buf, allocated(InData%Vwnd_NW)) if (allocated(InData%Vwnd_NW)) then call RegPackBounds(Buf, 3, lbound(InData%Vwnd_NW), ubound(InData%Vwnd_NW)) call RegPack(Buf, InData%Vwnd_NW) end if if (RegCheckErr(Buf, RoutineName)) return - ! Vwnd_FW call RegPack(Buf, allocated(InData%Vwnd_FW)) if (allocated(InData%Vwnd_FW)) then call RegPackBounds(Buf, 3, lbound(InData%Vwnd_FW), ubound(InData%Vwnd_FW)) call RegPack(Buf, InData%Vwnd_FW) end if if (RegCheckErr(Buf, RoutineName)) return - ! Vind_NW call RegPack(Buf, allocated(InData%Vind_NW)) if (allocated(InData%Vind_NW)) then call RegPackBounds(Buf, 3, lbound(InData%Vind_NW), ubound(InData%Vind_NW)) call RegPack(Buf, InData%Vind_NW) end if if (RegCheckErr(Buf, RoutineName)) return - ! Vind_FW call RegPack(Buf, allocated(InData%Vind_FW)) if (allocated(InData%Vind_FW)) then call RegPackBounds(Buf, 3, lbound(InData%Vind_FW), ubound(InData%Vind_FW)) call RegPack(Buf, InData%Vind_FW) end if if (RegCheckErr(Buf, RoutineName)) return - ! PitchAndTwist call RegPack(Buf, allocated(InData%PitchAndTwist)) if (allocated(InData%PitchAndTwist)) then call RegPackBounds(Buf, 1, lbound(InData%PitchAndTwist), ubound(InData%PitchAndTwist)) call RegPack(Buf, InData%PitchAndTwist) end if if (RegCheckErr(Buf, RoutineName)) return - ! iTip call RegPack(Buf, InData%iTip) if (RegCheckErr(Buf, RoutineName)) return - ! iRoot call RegPack(Buf, InData%iRoot) if (RegCheckErr(Buf, RoutineName)) return - ! alpha_LL call RegPack(Buf, allocated(InData%alpha_LL)) if (allocated(InData%alpha_LL)) then call RegPackBounds(Buf, 1, lbound(InData%alpha_LL), ubound(InData%alpha_LL)) call RegPack(Buf, InData%alpha_LL) end if if (RegCheckErr(Buf, RoutineName)) return - ! Vreln_LL call RegPack(Buf, allocated(InData%Vreln_LL)) if (allocated(InData%Vreln_LL)) then call RegPackBounds(Buf, 1, lbound(InData%Vreln_LL), ubound(InData%Vreln_LL)) call RegPack(Buf, InData%Vreln_LL) end if if (RegCheckErr(Buf, RoutineName)) return - ! u_UA call RegPack(Buf, allocated(InData%u_UA)) if (allocated(InData%u_UA)) then call RegPackBounds(Buf, 2, lbound(InData%u_UA), ubound(InData%u_UA)) @@ -3265,128 +3003,108 @@ subroutine FVW_PackWng_MiscVarType(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! m_UA call UA_PackMisc(Buf, InData%m_UA) if (RegCheckErr(Buf, RoutineName)) return - ! y_UA call UA_PackOutput(Buf, InData%y_UA) if (RegCheckErr(Buf, RoutineName)) return - ! p_UA call UA_PackParam(Buf, InData%p_UA) if (RegCheckErr(Buf, RoutineName)) return - ! Vind_LL call RegPack(Buf, allocated(InData%Vind_LL)) if (allocated(InData%Vind_LL)) then call RegPackBounds(Buf, 2, lbound(InData%Vind_LL), ubound(InData%Vind_LL)) call RegPack(Buf, InData%Vind_LL) end if if (RegCheckErr(Buf, RoutineName)) return - ! BN_AxInd call RegPack(Buf, allocated(InData%BN_AxInd)) if (allocated(InData%BN_AxInd)) then call RegPackBounds(Buf, 1, lbound(InData%BN_AxInd), ubound(InData%BN_AxInd)) call RegPack(Buf, InData%BN_AxInd) end if if (RegCheckErr(Buf, RoutineName)) return - ! BN_TanInd call RegPack(Buf, allocated(InData%BN_TanInd)) if (allocated(InData%BN_TanInd)) then call RegPackBounds(Buf, 1, lbound(InData%BN_TanInd), ubound(InData%BN_TanInd)) call RegPack(Buf, InData%BN_TanInd) end if if (RegCheckErr(Buf, RoutineName)) return - ! BN_Vrel call RegPack(Buf, allocated(InData%BN_Vrel)) if (allocated(InData%BN_Vrel)) then call RegPackBounds(Buf, 1, lbound(InData%BN_Vrel), ubound(InData%BN_Vrel)) call RegPack(Buf, InData%BN_Vrel) end if if (RegCheckErr(Buf, RoutineName)) return - ! BN_alpha call RegPack(Buf, allocated(InData%BN_alpha)) if (allocated(InData%BN_alpha)) then call RegPackBounds(Buf, 1, lbound(InData%BN_alpha), ubound(InData%BN_alpha)) call RegPack(Buf, InData%BN_alpha) end if if (RegCheckErr(Buf, RoutineName)) return - ! BN_phi call RegPack(Buf, allocated(InData%BN_phi)) if (allocated(InData%BN_phi)) then call RegPackBounds(Buf, 1, lbound(InData%BN_phi), ubound(InData%BN_phi)) call RegPack(Buf, InData%BN_phi) end if if (RegCheckErr(Buf, RoutineName)) return - ! BN_Re call RegPack(Buf, allocated(InData%BN_Re)) if (allocated(InData%BN_Re)) then call RegPackBounds(Buf, 1, lbound(InData%BN_Re), ubound(InData%BN_Re)) call RegPack(Buf, InData%BN_Re) end if if (RegCheckErr(Buf, RoutineName)) return - ! BN_URelWind_s call RegPack(Buf, allocated(InData%BN_URelWind_s)) if (allocated(InData%BN_URelWind_s)) then call RegPackBounds(Buf, 2, lbound(InData%BN_URelWind_s), ubound(InData%BN_URelWind_s)) call RegPack(Buf, InData%BN_URelWind_s) end if if (RegCheckErr(Buf, RoutineName)) return - ! BN_Cl_Static call RegPack(Buf, allocated(InData%BN_Cl_Static)) if (allocated(InData%BN_Cl_Static)) then call RegPackBounds(Buf, 1, lbound(InData%BN_Cl_Static), ubound(InData%BN_Cl_Static)) call RegPack(Buf, InData%BN_Cl_Static) end if if (RegCheckErr(Buf, RoutineName)) return - ! BN_Cd_Static call RegPack(Buf, allocated(InData%BN_Cd_Static)) if (allocated(InData%BN_Cd_Static)) then call RegPackBounds(Buf, 1, lbound(InData%BN_Cd_Static), ubound(InData%BN_Cd_Static)) call RegPack(Buf, InData%BN_Cd_Static) end if if (RegCheckErr(Buf, RoutineName)) return - ! BN_Cm_Static call RegPack(Buf, allocated(InData%BN_Cm_Static)) if (allocated(InData%BN_Cm_Static)) then call RegPackBounds(Buf, 1, lbound(InData%BN_Cm_Static), ubound(InData%BN_Cm_Static)) call RegPack(Buf, InData%BN_Cm_Static) end if if (RegCheckErr(Buf, RoutineName)) return - ! BN_Cpmin call RegPack(Buf, allocated(InData%BN_Cpmin)) if (allocated(InData%BN_Cpmin)) then call RegPackBounds(Buf, 1, lbound(InData%BN_Cpmin), ubound(InData%BN_Cpmin)) call RegPack(Buf, InData%BN_Cpmin) end if if (RegCheckErr(Buf, RoutineName)) return - ! BN_Cl call RegPack(Buf, allocated(InData%BN_Cl)) if (allocated(InData%BN_Cl)) then call RegPackBounds(Buf, 1, lbound(InData%BN_Cl), ubound(InData%BN_Cl)) call RegPack(Buf, InData%BN_Cl) end if if (RegCheckErr(Buf, RoutineName)) return - ! BN_Cd call RegPack(Buf, allocated(InData%BN_Cd)) if (allocated(InData%BN_Cd)) then call RegPackBounds(Buf, 1, lbound(InData%BN_Cd), ubound(InData%BN_Cd)) call RegPack(Buf, InData%BN_Cd) end if if (RegCheckErr(Buf, RoutineName)) return - ! BN_Cm call RegPack(Buf, allocated(InData%BN_Cm)) if (allocated(InData%BN_Cm)) then call RegPackBounds(Buf, 1, lbound(InData%BN_Cm), ubound(InData%BN_Cm)) call RegPack(Buf, InData%BN_Cm) end if if (RegCheckErr(Buf, RoutineName)) return - ! BN_Cx call RegPack(Buf, allocated(InData%BN_Cx)) if (allocated(InData%BN_Cx)) then call RegPackBounds(Buf, 1, lbound(InData%BN_Cx), ubound(InData%BN_Cx)) call RegPack(Buf, InData%BN_Cx) end if if (RegCheckErr(Buf, RoutineName)) return - ! BN_Cy call RegPack(Buf, allocated(InData%BN_Cy)) if (allocated(InData%BN_Cy)) then call RegPackBounds(Buf, 1, lbound(InData%BN_Cy), ubound(InData%BN_Cy)) @@ -3404,7 +3122,6 @@ subroutine FVW_UnPackWng_MiscVarType(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! LE if (allocated(OutData%LE)) deallocate(OutData%LE) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3419,7 +3136,6 @@ subroutine FVW_UnPackWng_MiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%LE) if (RegCheckErr(Buf, RoutineName)) return end if - ! TE if (allocated(OutData%TE)) deallocate(OutData%TE) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3434,7 +3150,6 @@ subroutine FVW_UnPackWng_MiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%TE) if (RegCheckErr(Buf, RoutineName)) return end if - ! r_LL if (allocated(OutData%r_LL)) deallocate(OutData%r_LL) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3449,7 +3164,6 @@ subroutine FVW_UnPackWng_MiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%r_LL) if (RegCheckErr(Buf, RoutineName)) return end if - ! CP if (allocated(OutData%CP)) deallocate(OutData%CP) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3464,7 +3178,6 @@ subroutine FVW_UnPackWng_MiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%CP) if (RegCheckErr(Buf, RoutineName)) return end if - ! Tang if (allocated(OutData%Tang)) deallocate(OutData%Tang) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3479,7 +3192,6 @@ subroutine FVW_UnPackWng_MiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%Tang) if (RegCheckErr(Buf, RoutineName)) return end if - ! Norm if (allocated(OutData%Norm)) deallocate(OutData%Norm) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3494,7 +3206,6 @@ subroutine FVW_UnPackWng_MiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%Norm) if (RegCheckErr(Buf, RoutineName)) return end if - ! Orth if (allocated(OutData%Orth)) deallocate(OutData%Orth) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3509,7 +3220,6 @@ subroutine FVW_UnPackWng_MiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%Orth) if (RegCheckErr(Buf, RoutineName)) return end if - ! dl if (allocated(OutData%dl)) deallocate(OutData%dl) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3524,7 +3234,6 @@ subroutine FVW_UnPackWng_MiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%dl) if (RegCheckErr(Buf, RoutineName)) return end if - ! Area if (allocated(OutData%Area)) deallocate(OutData%Area) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3539,7 +3248,6 @@ subroutine FVW_UnPackWng_MiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%Area) if (RegCheckErr(Buf, RoutineName)) return end if - ! diag_LL if (allocated(OutData%diag_LL)) deallocate(OutData%diag_LL) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3554,7 +3262,6 @@ subroutine FVW_UnPackWng_MiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%diag_LL) if (RegCheckErr(Buf, RoutineName)) return end if - ! Vind_CP if (allocated(OutData%Vind_CP)) deallocate(OutData%Vind_CP) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3569,7 +3276,6 @@ subroutine FVW_UnPackWng_MiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%Vind_CP) if (RegCheckErr(Buf, RoutineName)) return end if - ! Vtot_CP if (allocated(OutData%Vtot_CP)) deallocate(OutData%Vtot_CP) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3584,7 +3290,6 @@ subroutine FVW_UnPackWng_MiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%Vtot_CP) if (RegCheckErr(Buf, RoutineName)) return end if - ! Vstr_CP if (allocated(OutData%Vstr_CP)) deallocate(OutData%Vstr_CP) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3599,7 +3304,6 @@ subroutine FVW_UnPackWng_MiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%Vstr_CP) if (RegCheckErr(Buf, RoutineName)) return end if - ! Vwnd_CP if (allocated(OutData%Vwnd_CP)) deallocate(OutData%Vwnd_CP) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3614,7 +3318,6 @@ subroutine FVW_UnPackWng_MiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%Vwnd_CP) if (RegCheckErr(Buf, RoutineName)) return end if - ! Vwnd_NW if (allocated(OutData%Vwnd_NW)) deallocate(OutData%Vwnd_NW) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3629,7 +3332,6 @@ subroutine FVW_UnPackWng_MiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%Vwnd_NW) if (RegCheckErr(Buf, RoutineName)) return end if - ! Vwnd_FW if (allocated(OutData%Vwnd_FW)) deallocate(OutData%Vwnd_FW) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3644,7 +3346,6 @@ subroutine FVW_UnPackWng_MiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%Vwnd_FW) if (RegCheckErr(Buf, RoutineName)) return end if - ! Vind_NW if (allocated(OutData%Vind_NW)) deallocate(OutData%Vind_NW) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3659,7 +3360,6 @@ subroutine FVW_UnPackWng_MiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%Vind_NW) if (RegCheckErr(Buf, RoutineName)) return end if - ! Vind_FW if (allocated(OutData%Vind_FW)) deallocate(OutData%Vind_FW) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3674,7 +3374,6 @@ subroutine FVW_UnPackWng_MiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%Vind_FW) if (RegCheckErr(Buf, RoutineName)) return end if - ! PitchAndTwist if (allocated(OutData%PitchAndTwist)) deallocate(OutData%PitchAndTwist) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3689,13 +3388,10 @@ subroutine FVW_UnPackWng_MiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%PitchAndTwist) if (RegCheckErr(Buf, RoutineName)) return end if - ! iTip call RegUnpack(Buf, OutData%iTip) if (RegCheckErr(Buf, RoutineName)) return - ! iRoot call RegUnpack(Buf, OutData%iRoot) if (RegCheckErr(Buf, RoutineName)) return - ! alpha_LL if (allocated(OutData%alpha_LL)) deallocate(OutData%alpha_LL) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3710,7 +3406,6 @@ subroutine FVW_UnPackWng_MiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%alpha_LL) if (RegCheckErr(Buf, RoutineName)) return end if - ! Vreln_LL if (allocated(OutData%Vreln_LL)) deallocate(OutData%Vreln_LL) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3725,7 +3420,6 @@ subroutine FVW_UnPackWng_MiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%Vreln_LL) if (RegCheckErr(Buf, RoutineName)) return end if - ! u_UA if (allocated(OutData%u_UA)) deallocate(OutData%u_UA) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3743,13 +3437,9 @@ subroutine FVW_UnPackWng_MiscVarType(Buf, OutData) end do end do end if - ! m_UA call UA_UnpackMisc(Buf, OutData%m_UA) ! m_UA - ! y_UA call UA_UnpackOutput(Buf, OutData%y_UA) ! y_UA - ! p_UA call UA_UnpackParam(Buf, OutData%p_UA) ! p_UA - ! Vind_LL if (allocated(OutData%Vind_LL)) deallocate(OutData%Vind_LL) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3764,7 +3454,6 @@ subroutine FVW_UnPackWng_MiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%Vind_LL) if (RegCheckErr(Buf, RoutineName)) return end if - ! BN_AxInd if (allocated(OutData%BN_AxInd)) deallocate(OutData%BN_AxInd) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3779,7 +3468,6 @@ subroutine FVW_UnPackWng_MiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%BN_AxInd) if (RegCheckErr(Buf, RoutineName)) return end if - ! BN_TanInd if (allocated(OutData%BN_TanInd)) deallocate(OutData%BN_TanInd) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3794,7 +3482,6 @@ subroutine FVW_UnPackWng_MiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%BN_TanInd) if (RegCheckErr(Buf, RoutineName)) return end if - ! BN_Vrel if (allocated(OutData%BN_Vrel)) deallocate(OutData%BN_Vrel) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3809,7 +3496,6 @@ subroutine FVW_UnPackWng_MiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%BN_Vrel) if (RegCheckErr(Buf, RoutineName)) return end if - ! BN_alpha if (allocated(OutData%BN_alpha)) deallocate(OutData%BN_alpha) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3824,7 +3510,6 @@ subroutine FVW_UnPackWng_MiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%BN_alpha) if (RegCheckErr(Buf, RoutineName)) return end if - ! BN_phi if (allocated(OutData%BN_phi)) deallocate(OutData%BN_phi) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3839,7 +3524,6 @@ subroutine FVW_UnPackWng_MiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%BN_phi) if (RegCheckErr(Buf, RoutineName)) return end if - ! BN_Re if (allocated(OutData%BN_Re)) deallocate(OutData%BN_Re) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3854,7 +3538,6 @@ subroutine FVW_UnPackWng_MiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%BN_Re) if (RegCheckErr(Buf, RoutineName)) return end if - ! BN_URelWind_s if (allocated(OutData%BN_URelWind_s)) deallocate(OutData%BN_URelWind_s) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3869,7 +3552,6 @@ subroutine FVW_UnPackWng_MiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%BN_URelWind_s) if (RegCheckErr(Buf, RoutineName)) return end if - ! BN_Cl_Static if (allocated(OutData%BN_Cl_Static)) deallocate(OutData%BN_Cl_Static) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3884,7 +3566,6 @@ subroutine FVW_UnPackWng_MiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%BN_Cl_Static) if (RegCheckErr(Buf, RoutineName)) return end if - ! BN_Cd_Static if (allocated(OutData%BN_Cd_Static)) deallocate(OutData%BN_Cd_Static) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3899,7 +3580,6 @@ subroutine FVW_UnPackWng_MiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%BN_Cd_Static) if (RegCheckErr(Buf, RoutineName)) return end if - ! BN_Cm_Static if (allocated(OutData%BN_Cm_Static)) deallocate(OutData%BN_Cm_Static) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3914,7 +3594,6 @@ subroutine FVW_UnPackWng_MiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%BN_Cm_Static) if (RegCheckErr(Buf, RoutineName)) return end if - ! BN_Cpmin if (allocated(OutData%BN_Cpmin)) deallocate(OutData%BN_Cpmin) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3929,7 +3608,6 @@ subroutine FVW_UnPackWng_MiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%BN_Cpmin) if (RegCheckErr(Buf, RoutineName)) return end if - ! BN_Cl if (allocated(OutData%BN_Cl)) deallocate(OutData%BN_Cl) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3944,7 +3622,6 @@ subroutine FVW_UnPackWng_MiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%BN_Cl) if (RegCheckErr(Buf, RoutineName)) return end if - ! BN_Cd if (allocated(OutData%BN_Cd)) deallocate(OutData%BN_Cd) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3959,7 +3636,6 @@ subroutine FVW_UnPackWng_MiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%BN_Cd) if (RegCheckErr(Buf, RoutineName)) return end if - ! BN_Cm if (allocated(OutData%BN_Cm)) deallocate(OutData%BN_Cm) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3974,7 +3650,6 @@ subroutine FVW_UnPackWng_MiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%BN_Cm) if (RegCheckErr(Buf, RoutineName)) return end if - ! BN_Cx if (allocated(OutData%BN_Cx)) deallocate(OutData%BN_Cx) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3989,7 +3664,6 @@ subroutine FVW_UnPackWng_MiscVarType(Buf, OutData) call RegUnpack(Buf, OutData%BN_Cx) if (RegCheckErr(Buf, RoutineName)) return end if - ! BN_Cy if (allocated(OutData%BN_Cy)) deallocate(OutData%BN_Cy) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4005,172 +3679,165 @@ subroutine FVW_UnPackWng_MiscVarType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE FVW_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FVW_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(FVW_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscData%W)) THEN - i1_l = LBOUND(SrcMiscData%W,1) - i1_u = UBOUND(SrcMiscData%W,1) - IF (.NOT. ALLOCATED(DstMiscData%W)) THEN - ALLOCATE(DstMiscData%W(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%W.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%W,1), UBOUND(SrcMiscData%W,1) - CALL FVW_Copywng_miscvartype( SrcMiscData%W(i1), DstMiscData%W(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstMiscData%FirstCall = SrcMiscData%FirstCall - DstMiscData%nNW = SrcMiscData%nNW - DstMiscData%nFW = SrcMiscData%nFW - DstMiscData%iStep = SrcMiscData%iStep - DstMiscData%VTKstep = SrcMiscData%VTKstep - DstMiscData%VTKlastTime = SrcMiscData%VTKlastTime -IF (ALLOCATED(SrcMiscData%r_wind)) THEN - i1_l = LBOUND(SrcMiscData%r_wind,1) - i1_u = UBOUND(SrcMiscData%r_wind,1) - i2_l = LBOUND(SrcMiscData%r_wind,2) - i2_u = UBOUND(SrcMiscData%r_wind,2) - IF (.NOT. ALLOCATED(DstMiscData%r_wind)) THEN - ALLOCATE(DstMiscData%r_wind(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%r_wind.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%r_wind = SrcMiscData%r_wind -ENDIF - DstMiscData%ComputeWakeInduced = SrcMiscData%ComputeWakeInduced - DstMiscData%OldWakeTime = SrcMiscData%OldWakeTime - CALL FVW_CopyContState( SrcMiscData%dxdt, DstMiscData%dxdt, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FVW_CopyContState( SrcMiscData%x1, DstMiscData%x1, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FVW_CopyContState( SrcMiscData%x2, DstMiscData%x2, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstMiscData%t1 = SrcMiscData%t1 - DstMiscData%t2 = SrcMiscData%t2 - DstMiscData%UA_Flag = SrcMiscData%UA_Flag - CALL FVW_Copyt_sgmt( SrcMiscData%Sgmt, DstMiscData%Sgmt, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FVW_Copyt_part( SrcMiscData%Part, DstMiscData%Part, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMiscData%CPs)) THEN - i1_l = LBOUND(SrcMiscData%CPs,1) - i1_u = UBOUND(SrcMiscData%CPs,1) - i2_l = LBOUND(SrcMiscData%CPs,2) - i2_u = UBOUND(SrcMiscData%CPs,2) - IF (.NOT. ALLOCATED(DstMiscData%CPs)) THEN - ALLOCATE(DstMiscData%CPs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CPs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%CPs = SrcMiscData%CPs -ENDIF -IF (ALLOCATED(SrcMiscData%Uind)) THEN - i1_l = LBOUND(SrcMiscData%Uind,1) - i1_u = UBOUND(SrcMiscData%Uind,1) - i2_l = LBOUND(SrcMiscData%Uind,2) - i2_u = UBOUND(SrcMiscData%Uind,2) - IF (.NOT. ALLOCATED(DstMiscData%Uind)) THEN - ALLOCATE(DstMiscData%Uind(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Uind.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Uind = SrcMiscData%Uind -ENDIF -IF (ALLOCATED(SrcMiscData%GridOutputs)) THEN - i1_l = LBOUND(SrcMiscData%GridOutputs,1) - i1_u = UBOUND(SrcMiscData%GridOutputs,1) - IF (.NOT. ALLOCATED(DstMiscData%GridOutputs)) THEN - ALLOCATE(DstMiscData%GridOutputs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%GridOutputs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%GridOutputs,1), UBOUND(SrcMiscData%GridOutputs,1) - CALL FVW_Copygridouttype( SrcMiscData%GridOutputs(i1), DstMiscData%GridOutputs(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE FVW_CopyMisc - - SUBROUTINE FVW_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(FVW_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyMisc' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MiscData%W)) THEN -DO i1 = LBOUND(MiscData%W,1), UBOUND(MiscData%W,1) - CALL FVW_DestroyWng_MiscVarType( MiscData%W(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%W) -ENDIF -IF (ALLOCATED(MiscData%r_wind)) THEN - DEALLOCATE(MiscData%r_wind) -ENDIF - CALL FVW_DestroyContState( MiscData%dxdt, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FVW_DestroyContState( MiscData%x1, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FVW_DestroyContState( MiscData%x2, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FVW_DestroyT_Sgmt( MiscData%Sgmt, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FVW_DestroyT_Part( MiscData%Part, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MiscData%CPs)) THEN - DEALLOCATE(MiscData%CPs) -ENDIF -IF (ALLOCATED(MiscData%Uind)) THEN - DEALLOCATE(MiscData%Uind) -ENDIF -IF (ALLOCATED(MiscData%GridOutputs)) THEN -DO i1 = LBOUND(MiscData%GridOutputs,1), UBOUND(MiscData%GridOutputs,1) - CALL FVW_DestroyGridOutType( MiscData%GridOutputs(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%GridOutputs) -ENDIF - END SUBROUTINE FVW_DestroyMisc +subroutine FVW_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(FVW_MiscVarType), intent(in) :: SrcMiscData + type(FVW_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMiscData%W)) then + LB(1:1) = lbound(SrcMiscData%W) + UB(1:1) = ubound(SrcMiscData%W) + if (.not. allocated(DstMiscData%W)) then + allocate(DstMiscData%W(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%W.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FVW_CopyWng_MiscVarType(SrcMiscData%W(i1), DstMiscData%W(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstMiscData%W)) then + deallocate(DstMiscData%W) + end if + DstMiscData%FirstCall = SrcMiscData%FirstCall + DstMiscData%nNW = SrcMiscData%nNW + DstMiscData%nFW = SrcMiscData%nFW + DstMiscData%iStep = SrcMiscData%iStep + DstMiscData%VTKstep = SrcMiscData%VTKstep + DstMiscData%VTKlastTime = SrcMiscData%VTKlastTime + if (allocated(SrcMiscData%r_wind)) then + LB(1:2) = lbound(SrcMiscData%r_wind) + UB(1:2) = ubound(SrcMiscData%r_wind) + if (.not. allocated(DstMiscData%r_wind)) then + allocate(DstMiscData%r_wind(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%r_wind.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%r_wind = SrcMiscData%r_wind + else if (allocated(DstMiscData%r_wind)) then + deallocate(DstMiscData%r_wind) + end if + DstMiscData%ComputeWakeInduced = SrcMiscData%ComputeWakeInduced + DstMiscData%OldWakeTime = SrcMiscData%OldWakeTime + call FVW_CopyContState(SrcMiscData%dxdt, DstMiscData%dxdt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FVW_CopyContState(SrcMiscData%x1, DstMiscData%x1, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FVW_CopyContState(SrcMiscData%x2, DstMiscData%x2, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstMiscData%t1 = SrcMiscData%t1 + DstMiscData%t2 = SrcMiscData%t2 + DstMiscData%UA_Flag = SrcMiscData%UA_Flag + call FVW_CopyT_Sgmt(SrcMiscData%Sgmt, DstMiscData%Sgmt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FVW_CopyT_Part(SrcMiscData%Part, DstMiscData%Part, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMiscData%CPs)) then + LB(1:2) = lbound(SrcMiscData%CPs) + UB(1:2) = ubound(SrcMiscData%CPs) + if (.not. allocated(DstMiscData%CPs)) then + allocate(DstMiscData%CPs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CPs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%CPs = SrcMiscData%CPs + else if (allocated(DstMiscData%CPs)) then + deallocate(DstMiscData%CPs) + end if + if (allocated(SrcMiscData%Uind)) then + LB(1:2) = lbound(SrcMiscData%Uind) + UB(1:2) = ubound(SrcMiscData%Uind) + if (.not. allocated(DstMiscData%Uind)) then + allocate(DstMiscData%Uind(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Uind.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Uind = SrcMiscData%Uind + else if (allocated(DstMiscData%Uind)) then + deallocate(DstMiscData%Uind) + end if + if (allocated(SrcMiscData%GridOutputs)) then + LB(1:1) = lbound(SrcMiscData%GridOutputs) + UB(1:1) = ubound(SrcMiscData%GridOutputs) + if (.not. allocated(DstMiscData%GridOutputs)) then + allocate(DstMiscData%GridOutputs(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%GridOutputs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FVW_CopyGridOutType(SrcMiscData%GridOutputs(i1), DstMiscData%GridOutputs(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstMiscData%GridOutputs)) then + deallocate(DstMiscData%GridOutputs) + end if +end subroutine +subroutine FVW_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(FVW_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%W)) then + LB(1:1) = lbound(MiscData%W) + UB(1:1) = ubound(MiscData%W) + do i1 = LB(1), UB(1) + call FVW_DestroyWng_MiscVarType(MiscData%W(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%W) + end if + if (allocated(MiscData%r_wind)) then + deallocate(MiscData%r_wind) + end if + if (allocated(MiscData%CPs)) then + deallocate(MiscData%CPs) + end if + if (allocated(MiscData%Uind)) then + deallocate(MiscData%Uind) + end if + if (allocated(MiscData%GridOutputs)) then + LB(1:1) = lbound(MiscData%GridOutputs) + UB(1:1) = ubound(MiscData%GridOutputs) + do i1 = LB(1), UB(1) + call FVW_DestroyGridOutType(MiscData%GridOutputs(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%GridOutputs) + end if +end subroutine subroutine FVW_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -4179,7 +3846,6 @@ subroutine FVW_PackMisc(Buf, Indata) integer(IntKi) :: i1, i2 integer(IntKi) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return - ! W call RegPack(Buf, allocated(InData%W)) if (allocated(InData%W)) then call RegPackBounds(Buf, 1, lbound(InData%W), ubound(InData%W)) @@ -4190,76 +3856,56 @@ subroutine FVW_PackMisc(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! FirstCall call RegPack(Buf, InData%FirstCall) if (RegCheckErr(Buf, RoutineName)) return - ! nNW call RegPack(Buf, InData%nNW) if (RegCheckErr(Buf, RoutineName)) return - ! nFW call RegPack(Buf, InData%nFW) if (RegCheckErr(Buf, RoutineName)) return - ! iStep call RegPack(Buf, InData%iStep) if (RegCheckErr(Buf, RoutineName)) return - ! VTKstep call RegPack(Buf, InData%VTKstep) if (RegCheckErr(Buf, RoutineName)) return - ! VTKlastTime call RegPack(Buf, InData%VTKlastTime) if (RegCheckErr(Buf, RoutineName)) return - ! r_wind call RegPack(Buf, allocated(InData%r_wind)) if (allocated(InData%r_wind)) then call RegPackBounds(Buf, 2, lbound(InData%r_wind), ubound(InData%r_wind)) call RegPack(Buf, InData%r_wind) end if if (RegCheckErr(Buf, RoutineName)) return - ! ComputeWakeInduced call RegPack(Buf, InData%ComputeWakeInduced) if (RegCheckErr(Buf, RoutineName)) return - ! OldWakeTime call RegPack(Buf, InData%OldWakeTime) if (RegCheckErr(Buf, RoutineName)) return - ! dxdt call FVW_PackContState(Buf, InData%dxdt) if (RegCheckErr(Buf, RoutineName)) return - ! x1 call FVW_PackContState(Buf, InData%x1) if (RegCheckErr(Buf, RoutineName)) return - ! x2 call FVW_PackContState(Buf, InData%x2) if (RegCheckErr(Buf, RoutineName)) return - ! t1 call RegPack(Buf, InData%t1) if (RegCheckErr(Buf, RoutineName)) return - ! t2 call RegPack(Buf, InData%t2) if (RegCheckErr(Buf, RoutineName)) return - ! UA_Flag call RegPack(Buf, InData%UA_Flag) if (RegCheckErr(Buf, RoutineName)) return - ! Sgmt call FVW_PackT_Sgmt(Buf, InData%Sgmt) if (RegCheckErr(Buf, RoutineName)) return - ! Part call FVW_PackT_Part(Buf, InData%Part) if (RegCheckErr(Buf, RoutineName)) return - ! CPs call RegPack(Buf, allocated(InData%CPs)) if (allocated(InData%CPs)) then call RegPackBounds(Buf, 2, lbound(InData%CPs), ubound(InData%CPs)) call RegPack(Buf, InData%CPs) end if if (RegCheckErr(Buf, RoutineName)) return - ! Uind call RegPack(Buf, allocated(InData%Uind)) if (allocated(InData%Uind)) then call RegPackBounds(Buf, 2, lbound(InData%Uind), ubound(InData%Uind)) call RegPack(Buf, InData%Uind) end if if (RegCheckErr(Buf, RoutineName)) return - ! GridOutputs call RegPack(Buf, allocated(InData%GridOutputs)) if (allocated(InData%GridOutputs)) then call RegPackBounds(Buf, 1, lbound(InData%GridOutputs), ubound(InData%GridOutputs)) @@ -4281,7 +3927,6 @@ subroutine FVW_UnPackMisc(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! W if (allocated(OutData%W)) deallocate(OutData%W) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4297,25 +3942,18 @@ subroutine FVW_UnPackMisc(Buf, OutData) call FVW_UnpackWng_MiscVarType(Buf, OutData%W(i1)) ! W end do end if - ! FirstCall call RegUnpack(Buf, OutData%FirstCall) if (RegCheckErr(Buf, RoutineName)) return - ! nNW call RegUnpack(Buf, OutData%nNW) if (RegCheckErr(Buf, RoutineName)) return - ! nFW call RegUnpack(Buf, OutData%nFW) if (RegCheckErr(Buf, RoutineName)) return - ! iStep call RegUnpack(Buf, OutData%iStep) if (RegCheckErr(Buf, RoutineName)) return - ! VTKstep call RegUnpack(Buf, OutData%VTKstep) if (RegCheckErr(Buf, RoutineName)) return - ! VTKlastTime call RegUnpack(Buf, OutData%VTKlastTime) if (RegCheckErr(Buf, RoutineName)) return - ! r_wind if (allocated(OutData%r_wind)) deallocate(OutData%r_wind) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4330,32 +3968,21 @@ subroutine FVW_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%r_wind) if (RegCheckErr(Buf, RoutineName)) return end if - ! ComputeWakeInduced call RegUnpack(Buf, OutData%ComputeWakeInduced) if (RegCheckErr(Buf, RoutineName)) return - ! OldWakeTime call RegUnpack(Buf, OutData%OldWakeTime) if (RegCheckErr(Buf, RoutineName)) return - ! dxdt call FVW_UnpackContState(Buf, OutData%dxdt) ! dxdt - ! x1 call FVW_UnpackContState(Buf, OutData%x1) ! x1 - ! x2 call FVW_UnpackContState(Buf, OutData%x2) ! x2 - ! t1 call RegUnpack(Buf, OutData%t1) if (RegCheckErr(Buf, RoutineName)) return - ! t2 call RegUnpack(Buf, OutData%t2) if (RegCheckErr(Buf, RoutineName)) return - ! UA_Flag call RegUnpack(Buf, OutData%UA_Flag) if (RegCheckErr(Buf, RoutineName)) return - ! Sgmt call FVW_UnpackT_Sgmt(Buf, OutData%Sgmt) ! Sgmt - ! Part call FVW_UnpackT_Part(Buf, OutData%Part) ! Part - ! CPs if (allocated(OutData%CPs)) deallocate(OutData%CPs) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4370,7 +3997,6 @@ subroutine FVW_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%CPs) if (RegCheckErr(Buf, RoutineName)) return end if - ! Uind if (allocated(OutData%Uind)) deallocate(OutData%Uind) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4385,7 +4011,6 @@ subroutine FVW_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%Uind) if (RegCheckErr(Buf, RoutineName)) return end if - ! GridOutputs if (allocated(OutData%GridOutputs)) deallocate(OutData%GridOutputs) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4402,51 +4027,36 @@ subroutine FVW_UnPackMisc(Buf, OutData) end do end if end subroutine - SUBROUTINE FVW_CopyRot_InputType( SrcRot_InputTypeData, DstRot_InputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Rot_InputType), INTENT(IN) :: SrcRot_InputTypeData - TYPE(Rot_InputType), INTENT(INOUT) :: DstRot_InputTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_CopyRot_InputType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstRot_InputTypeData%HubOrientation = SrcRot_InputTypeData%HubOrientation - DstRot_InputTypeData%HubPosition = SrcRot_InputTypeData%HubPosition - END SUBROUTINE FVW_CopyRot_InputType - - SUBROUTINE FVW_DestroyRot_InputType( Rot_InputTypeData, ErrStat, ErrMsg ) - TYPE(Rot_InputType), INTENT(INOUT) :: Rot_InputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyRot_InputType' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE FVW_DestroyRot_InputType +subroutine FVW_CopyRot_InputType(SrcRot_InputTypeData, DstRot_InputTypeData, CtrlCode, ErrStat, ErrMsg) + type(Rot_InputType), intent(in) :: SrcRot_InputTypeData + type(Rot_InputType), intent(inout) :: DstRot_InputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FVW_CopyRot_InputType' + ErrStat = ErrID_None + ErrMsg = '' + DstRot_InputTypeData%HubOrientation = SrcRot_InputTypeData%HubOrientation + DstRot_InputTypeData%HubPosition = SrcRot_InputTypeData%HubPosition +end subroutine +subroutine FVW_DestroyRot_InputType(Rot_InputTypeData, ErrStat, ErrMsg) + type(Rot_InputType), intent(inout) :: Rot_InputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FVW_DestroyRot_InputType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine FVW_PackRot_InputType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Rot_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackRot_InputType' if (Buf%ErrStat >= AbortErrLev) return - ! HubOrientation call RegPack(Buf, InData%HubOrientation) if (RegCheckErr(Buf, RoutineName)) return - ! HubPosition call RegPack(Buf, InData%HubPosition) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -4456,92 +4066,79 @@ subroutine FVW_UnPackRot_InputType(Buf, OutData) type(Rot_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackRot_InputType' if (Buf%ErrStat /= ErrID_None) return - ! HubOrientation call RegUnpack(Buf, OutData%HubOrientation) if (RegCheckErr(Buf, RoutineName)) return - ! HubPosition call RegUnpack(Buf, OutData%HubPosition) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE FVW_CopyWng_InputType( SrcWng_InputTypeData, DstWng_InputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Wng_InputType), INTENT(IN) :: SrcWng_InputTypeData - TYPE(Wng_InputType), INTENT(INOUT) :: DstWng_InputTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_CopyWng_InputType' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcWng_InputTypeData%Vwnd_LL)) THEN - i1_l = LBOUND(SrcWng_InputTypeData%Vwnd_LL,1) - i1_u = UBOUND(SrcWng_InputTypeData%Vwnd_LL,1) - i2_l = LBOUND(SrcWng_InputTypeData%Vwnd_LL,2) - i2_u = UBOUND(SrcWng_InputTypeData%Vwnd_LL,2) - IF (.NOT. ALLOCATED(DstWng_InputTypeData%Vwnd_LL)) THEN - ALLOCATE(DstWng_InputTypeData%Vwnd_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_InputTypeData%Vwnd_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_InputTypeData%Vwnd_LL = SrcWng_InputTypeData%Vwnd_LL -ENDIF -IF (ALLOCATED(SrcWng_InputTypeData%omega_z)) THEN - i1_l = LBOUND(SrcWng_InputTypeData%omega_z,1) - i1_u = UBOUND(SrcWng_InputTypeData%omega_z,1) - IF (.NOT. ALLOCATED(DstWng_InputTypeData%omega_z)) THEN - ALLOCATE(DstWng_InputTypeData%omega_z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_InputTypeData%omega_z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_InputTypeData%omega_z = SrcWng_InputTypeData%omega_z -ENDIF - END SUBROUTINE FVW_CopyWng_InputType - - SUBROUTINE FVW_DestroyWng_InputType( Wng_InputTypeData, ErrStat, ErrMsg ) - TYPE(Wng_InputType), INTENT(INOUT) :: Wng_InputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyWng_InputType' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(Wng_InputTypeData%Vwnd_LL)) THEN - DEALLOCATE(Wng_InputTypeData%Vwnd_LL) -ENDIF -IF (ALLOCATED(Wng_InputTypeData%omega_z)) THEN - DEALLOCATE(Wng_InputTypeData%omega_z) -ENDIF - END SUBROUTINE FVW_DestroyWng_InputType +subroutine FVW_CopyWng_InputType(SrcWng_InputTypeData, DstWng_InputTypeData, CtrlCode, ErrStat, ErrMsg) + type(Wng_InputType), intent(in) :: SrcWng_InputTypeData + type(Wng_InputType), intent(inout) :: DstWng_InputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FVW_CopyWng_InputType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcWng_InputTypeData%Vwnd_LL)) then + LB(1:2) = lbound(SrcWng_InputTypeData%Vwnd_LL) + UB(1:2) = ubound(SrcWng_InputTypeData%Vwnd_LL) + if (.not. allocated(DstWng_InputTypeData%Vwnd_LL)) then + allocate(DstWng_InputTypeData%Vwnd_LL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_InputTypeData%Vwnd_LL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_InputTypeData%Vwnd_LL = SrcWng_InputTypeData%Vwnd_LL + else if (allocated(DstWng_InputTypeData%Vwnd_LL)) then + deallocate(DstWng_InputTypeData%Vwnd_LL) + end if + if (allocated(SrcWng_InputTypeData%omega_z)) then + LB(1:1) = lbound(SrcWng_InputTypeData%omega_z) + UB(1:1) = ubound(SrcWng_InputTypeData%omega_z) + if (.not. allocated(DstWng_InputTypeData%omega_z)) then + allocate(DstWng_InputTypeData%omega_z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_InputTypeData%omega_z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_InputTypeData%omega_z = SrcWng_InputTypeData%omega_z + else if (allocated(DstWng_InputTypeData%omega_z)) then + deallocate(DstWng_InputTypeData%omega_z) + end if +end subroutine +subroutine FVW_DestroyWng_InputType(Wng_InputTypeData, ErrStat, ErrMsg) + type(Wng_InputType), intent(inout) :: Wng_InputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FVW_DestroyWng_InputType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(Wng_InputTypeData%Vwnd_LL)) then + deallocate(Wng_InputTypeData%Vwnd_LL) + end if + if (allocated(Wng_InputTypeData%omega_z)) then + deallocate(Wng_InputTypeData%omega_z) + end if +end subroutine subroutine FVW_PackWng_InputType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Wng_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackWng_InputType' if (Buf%ErrStat >= AbortErrLev) return - ! Vwnd_LL call RegPack(Buf, allocated(InData%Vwnd_LL)) if (allocated(InData%Vwnd_LL)) then call RegPackBounds(Buf, 2, lbound(InData%Vwnd_LL), ubound(InData%Vwnd_LL)) call RegPack(Buf, InData%Vwnd_LL) end if if (RegCheckErr(Buf, RoutineName)) return - ! omega_z call RegPack(Buf, allocated(InData%omega_z)) if (allocated(InData%omega_z)) then call RegPackBounds(Buf, 1, lbound(InData%omega_z), ubound(InData%omega_z)) @@ -4558,7 +4155,6 @@ subroutine FVW_UnPackWng_InputType(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! Vwnd_LL if (allocated(OutData%Vwnd_LL)) deallocate(OutData%Vwnd_LL) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4573,7 +4169,6 @@ subroutine FVW_UnPackWng_InputType(Buf, OutData) call RegUnpack(Buf, OutData%Vwnd_LL) if (RegCheckErr(Buf, RoutineName)) return end if - ! omega_z if (allocated(OutData%omega_z)) deallocate(OutData%omega_z) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4589,125 +4184,132 @@ subroutine FVW_UnPackWng_InputType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE FVW_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FVW_InputType), INTENT(INOUT) :: SrcInputData - TYPE(FVW_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_CopyInput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInputData%rotors)) THEN - i1_l = LBOUND(SrcInputData%rotors,1) - i1_u = UBOUND(SrcInputData%rotors,1) - IF (.NOT. ALLOCATED(DstInputData%rotors)) THEN - ALLOCATE(DstInputData%rotors(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%rotors.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputData%rotors,1), UBOUND(SrcInputData%rotors,1) - CALL FVW_Copyrot_inputtype( SrcInputData%rotors(i1), DstInputData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInputData%W)) THEN - i1_l = LBOUND(SrcInputData%W,1) - i1_u = UBOUND(SrcInputData%W,1) - IF (.NOT. ALLOCATED(DstInputData%W)) THEN - ALLOCATE(DstInputData%W(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%W.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputData%W,1), UBOUND(SrcInputData%W,1) - CALL FVW_Copywng_inputtype( SrcInputData%W(i1), DstInputData%W(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInputData%WingsMesh)) THEN - i1_l = LBOUND(SrcInputData%WingsMesh,1) - i1_u = UBOUND(SrcInputData%WingsMesh,1) - IF (.NOT. ALLOCATED(DstInputData%WingsMesh)) THEN - ALLOCATE(DstInputData%WingsMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%WingsMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputData%WingsMesh,1), UBOUND(SrcInputData%WingsMesh,1) - CALL MeshCopy( SrcInputData%WingsMesh(i1), DstInputData%WingsMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInputData%V_wind)) THEN - i1_l = LBOUND(SrcInputData%V_wind,1) - i1_u = UBOUND(SrcInputData%V_wind,1) - i2_l = LBOUND(SrcInputData%V_wind,2) - i2_u = UBOUND(SrcInputData%V_wind,2) - IF (.NOT. ALLOCATED(DstInputData%V_wind)) THEN - ALLOCATE(DstInputData%V_wind(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%V_wind.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%V_wind = SrcInputData%V_wind -ENDIF - END SUBROUTINE FVW_CopyInput - - SUBROUTINE FVW_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(FVW_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(InputData%rotors)) THEN -DO i1 = LBOUND(InputData%rotors,1), UBOUND(InputData%rotors,1) - CALL FVW_DestroyRot_InputType( InputData%rotors(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InputData%rotors) -ENDIF -IF (ALLOCATED(InputData%W)) THEN -DO i1 = LBOUND(InputData%W,1), UBOUND(InputData%W,1) - CALL FVW_DestroyWng_InputType( InputData%W(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InputData%W) -ENDIF -IF (ALLOCATED(InputData%WingsMesh)) THEN -DO i1 = LBOUND(InputData%WingsMesh,1), UBOUND(InputData%WingsMesh,1) - CALL MeshDestroy( InputData%WingsMesh(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InputData%WingsMesh) -ENDIF -IF (ALLOCATED(InputData%V_wind)) THEN - DEALLOCATE(InputData%V_wind) -ENDIF - END SUBROUTINE FVW_DestroyInput +subroutine FVW_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(FVW_InputType), intent(inout) :: SrcInputData + type(FVW_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInputData%rotors)) then + LB(1:1) = lbound(SrcInputData%rotors) + UB(1:1) = ubound(SrcInputData%rotors) + if (.not. allocated(DstInputData%rotors)) then + allocate(DstInputData%rotors(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%rotors.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FVW_CopyRot_InputType(SrcInputData%rotors(i1), DstInputData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstInputData%rotors)) then + deallocate(DstInputData%rotors) + end if + if (allocated(SrcInputData%W)) then + LB(1:1) = lbound(SrcInputData%W) + UB(1:1) = ubound(SrcInputData%W) + if (.not. allocated(DstInputData%W)) then + allocate(DstInputData%W(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%W.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FVW_CopyWng_InputType(SrcInputData%W(i1), DstInputData%W(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstInputData%W)) then + deallocate(DstInputData%W) + end if + if (allocated(SrcInputData%WingsMesh)) then + LB(1:1) = lbound(SrcInputData%WingsMesh) + UB(1:1) = ubound(SrcInputData%WingsMesh) + if (.not. allocated(DstInputData%WingsMesh)) then + allocate(DstInputData%WingsMesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%WingsMesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcInputData%WingsMesh(i1), DstInputData%WingsMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstInputData%WingsMesh)) then + deallocate(DstInputData%WingsMesh) + end if + if (allocated(SrcInputData%V_wind)) then + LB(1:2) = lbound(SrcInputData%V_wind) + UB(1:2) = ubound(SrcInputData%V_wind) + if (.not. allocated(DstInputData%V_wind)) then + allocate(DstInputData%V_wind(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%V_wind.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%V_wind = SrcInputData%V_wind + else if (allocated(DstInputData%V_wind)) then + deallocate(DstInputData%V_wind) + end if +end subroutine +subroutine FVW_DestroyInput(InputData, ErrStat, ErrMsg) + type(FVW_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%rotors)) then + LB(1:1) = lbound(InputData%rotors) + UB(1:1) = ubound(InputData%rotors) + do i1 = LB(1), UB(1) + call FVW_DestroyRot_InputType(InputData%rotors(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputData%rotors) + end if + if (allocated(InputData%W)) then + LB(1:1) = lbound(InputData%W) + UB(1:1) = ubound(InputData%W) + do i1 = LB(1), UB(1) + call FVW_DestroyWng_InputType(InputData%W(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputData%W) + end if + if (allocated(InputData%WingsMesh)) then + LB(1:1) = lbound(InputData%WingsMesh) + UB(1:1) = ubound(InputData%WingsMesh) + do i1 = LB(1), UB(1) + call MeshDestroy( InputData%WingsMesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputData%WingsMesh) + end if + if (allocated(InputData%V_wind)) then + deallocate(InputData%V_wind) + end if +end subroutine subroutine FVW_PackInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -4716,7 +4318,6 @@ subroutine FVW_PackInput(Buf, Indata) integer(IntKi) :: i1, i2 integer(IntKi) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return - ! rotors call RegPack(Buf, allocated(InData%rotors)) if (allocated(InData%rotors)) then call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) @@ -4727,7 +4328,6 @@ subroutine FVW_PackInput(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! W call RegPack(Buf, allocated(InData%W)) if (allocated(InData%W)) then call RegPackBounds(Buf, 1, lbound(InData%W), ubound(InData%W)) @@ -4738,7 +4338,6 @@ subroutine FVW_PackInput(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! WingsMesh call RegPack(Buf, allocated(InData%WingsMesh)) if (allocated(InData%WingsMesh)) then call RegPackBounds(Buf, 1, lbound(InData%WingsMesh), ubound(InData%WingsMesh)) @@ -4749,7 +4348,6 @@ subroutine FVW_PackInput(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! V_wind call RegPack(Buf, allocated(InData%V_wind)) if (allocated(InData%V_wind)) then call RegPackBounds(Buf, 2, lbound(InData%V_wind), ubound(InData%V_wind)) @@ -4767,7 +4365,6 @@ subroutine FVW_UnPackInput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! rotors if (allocated(OutData%rotors)) deallocate(OutData%rotors) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4783,7 +4380,6 @@ subroutine FVW_UnPackInput(Buf, OutData) call FVW_UnpackRot_InputType(Buf, OutData%rotors(i1)) ! rotors end do end if - ! W if (allocated(OutData%W)) deallocate(OutData%W) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4799,7 +4395,6 @@ subroutine FVW_UnPackInput(Buf, OutData) call FVW_UnpackWng_InputType(Buf, OutData%W(i1)) ! W end do end if - ! WingsMesh if (allocated(OutData%WingsMesh)) deallocate(OutData%WingsMesh) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4815,7 +4410,6 @@ subroutine FVW_UnPackInput(Buf, OutData) call MeshUnpack(Buf, OutData%WingsMesh(i1)) ! WingsMesh end do end if - ! V_wind if (allocated(OutData%V_wind)) deallocate(OutData%V_wind) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4831,62 +4425,62 @@ subroutine FVW_UnPackInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE FVW_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FVW_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(FVW_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%Dummy = SrcDiscStateData%Dummy -IF (ALLOCATED(SrcDiscStateData%UA)) THEN - i1_l = LBOUND(SrcDiscStateData%UA,1) - i1_u = UBOUND(SrcDiscStateData%UA,1) - IF (.NOT. ALLOCATED(DstDiscStateData%UA)) THEN - ALLOCATE(DstDiscStateData%UA(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%UA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDiscStateData%UA,1), UBOUND(SrcDiscStateData%UA,1) - CALL UA_CopyDiscState( SrcDiscStateData%UA(i1), DstDiscStateData%UA(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE FVW_CopyDiscState - - SUBROUTINE FVW_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(FVW_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyDiscState' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(DiscStateData%UA)) THEN -DO i1 = LBOUND(DiscStateData%UA,1), UBOUND(DiscStateData%UA,1) - CALL UA_DestroyDiscState( DiscStateData%UA(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(DiscStateData%UA) -ENDIF - END SUBROUTINE FVW_DestroyDiscState +subroutine FVW_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(FVW_DiscreteStateType), intent(in) :: SrcDiscStateData + type(FVW_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + DstDiscStateData%Dummy = SrcDiscStateData%Dummy + if (allocated(SrcDiscStateData%UA)) then + LB(1:1) = lbound(SrcDiscStateData%UA) + UB(1:1) = ubound(SrcDiscStateData%UA) + if (.not. allocated(DstDiscStateData%UA)) then + allocate(DstDiscStateData%UA(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%UA.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call UA_CopyDiscState(SrcDiscStateData%UA(i1), DstDiscStateData%UA(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstDiscStateData%UA)) then + deallocate(DstDiscStateData%UA) + end if +end subroutine +subroutine FVW_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(FVW_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(DiscStateData%UA)) then + LB(1:1) = lbound(DiscStateData%UA) + UB(1:1) = ubound(DiscStateData%UA) + do i1 = LB(1), UB(1) + call UA_DestroyDiscState(DiscStateData%UA(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(DiscStateData%UA) + end if +end subroutine subroutine FVW_PackDiscState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -4895,10 +4489,8 @@ subroutine FVW_PackDiscState(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! Dummy call RegPack(Buf, InData%Dummy) if (RegCheckErr(Buf, RoutineName)) return - ! UA call RegPack(Buf, allocated(InData%UA)) if (allocated(InData%UA)) then call RegPackBounds(Buf, 1, lbound(InData%UA), ubound(InData%UA)) @@ -4920,10 +4512,8 @@ subroutine FVW_UnPackDiscState(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! Dummy call RegUnpack(Buf, OutData%Dummy) if (RegCheckErr(Buf, RoutineName)) return - ! UA if (allocated(OutData%UA)) deallocate(OutData%UA) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4940,60 +4530,51 @@ subroutine FVW_UnPackDiscState(Buf, OutData) end do end if end subroutine - SUBROUTINE FVW_CopyWng_ConstraintStateType( SrcWng_ConstraintStateTypeData, DstWng_ConstraintStateTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Wng_ConstraintStateType), INTENT(IN) :: SrcWng_ConstraintStateTypeData - TYPE(Wng_ConstraintStateType), INTENT(INOUT) :: DstWng_ConstraintStateTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_CopyWng_ConstraintStateType' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcWng_ConstraintStateTypeData%Gamma_LL)) THEN - i1_l = LBOUND(SrcWng_ConstraintStateTypeData%Gamma_LL,1) - i1_u = UBOUND(SrcWng_ConstraintStateTypeData%Gamma_LL,1) - IF (.NOT. ALLOCATED(DstWng_ConstraintStateTypeData%Gamma_LL)) THEN - ALLOCATE(DstWng_ConstraintStateTypeData%Gamma_LL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ConstraintStateTypeData%Gamma_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_ConstraintStateTypeData%Gamma_LL = SrcWng_ConstraintStateTypeData%Gamma_LL -ENDIF - END SUBROUTINE FVW_CopyWng_ConstraintStateType - - SUBROUTINE FVW_DestroyWng_ConstraintStateType( Wng_ConstraintStateTypeData, ErrStat, ErrMsg ) - TYPE(Wng_ConstraintStateType), INTENT(INOUT) :: Wng_ConstraintStateTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyWng_ConstraintStateType' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(Wng_ConstraintStateTypeData%Gamma_LL)) THEN - DEALLOCATE(Wng_ConstraintStateTypeData%Gamma_LL) -ENDIF - END SUBROUTINE FVW_DestroyWng_ConstraintStateType +subroutine FVW_CopyWng_ConstraintStateType(SrcWng_ConstraintStateTypeData, DstWng_ConstraintStateTypeData, CtrlCode, ErrStat, ErrMsg) + type(Wng_ConstraintStateType), intent(in) :: SrcWng_ConstraintStateTypeData + type(Wng_ConstraintStateType), intent(inout) :: DstWng_ConstraintStateTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FVW_CopyWng_ConstraintStateType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcWng_ConstraintStateTypeData%Gamma_LL)) then + LB(1:1) = lbound(SrcWng_ConstraintStateTypeData%Gamma_LL) + UB(1:1) = ubound(SrcWng_ConstraintStateTypeData%Gamma_LL) + if (.not. allocated(DstWng_ConstraintStateTypeData%Gamma_LL)) then + allocate(DstWng_ConstraintStateTypeData%Gamma_LL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_ConstraintStateTypeData%Gamma_LL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_ConstraintStateTypeData%Gamma_LL = SrcWng_ConstraintStateTypeData%Gamma_LL + else if (allocated(DstWng_ConstraintStateTypeData%Gamma_LL)) then + deallocate(DstWng_ConstraintStateTypeData%Gamma_LL) + end if +end subroutine +subroutine FVW_DestroyWng_ConstraintStateType(Wng_ConstraintStateTypeData, ErrStat, ErrMsg) + type(Wng_ConstraintStateType), intent(inout) :: Wng_ConstraintStateTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FVW_DestroyWng_ConstraintStateType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(Wng_ConstraintStateTypeData%Gamma_LL)) then + deallocate(Wng_ConstraintStateTypeData%Gamma_LL) + end if +end subroutine subroutine FVW_PackWng_ConstraintStateType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Wng_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackWng_ConstraintStateType' if (Buf%ErrStat >= AbortErrLev) return - ! Gamma_LL call RegPack(Buf, allocated(InData%Gamma_LL)) if (allocated(InData%Gamma_LL)) then call RegPackBounds(Buf, 1, lbound(InData%Gamma_LL), ubound(InData%Gamma_LL)) @@ -5010,7 +4591,6 @@ subroutine FVW_UnPackWng_ConstraintStateType(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! Gamma_LL if (allocated(OutData%Gamma_LL)) deallocate(OutData%Gamma_LL) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5026,62 +4606,62 @@ subroutine FVW_UnPackWng_ConstraintStateType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE FVW_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FVW_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(FVW_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcConstrStateData%W)) THEN - i1_l = LBOUND(SrcConstrStateData%W,1) - i1_u = UBOUND(SrcConstrStateData%W,1) - IF (.NOT. ALLOCATED(DstConstrStateData%W)) THEN - ALLOCATE(DstConstrStateData%W(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%W.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcConstrStateData%W,1), UBOUND(SrcConstrStateData%W,1) - CALL FVW_Copywng_constraintstatetype( SrcConstrStateData%W(i1), DstConstrStateData%W(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstConstrStateData%residual = SrcConstrStateData%residual - END SUBROUTINE FVW_CopyConstrState - - SUBROUTINE FVW_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(FVW_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(ConstrStateData%W)) THEN -DO i1 = LBOUND(ConstrStateData%W,1), UBOUND(ConstrStateData%W,1) - CALL FVW_DestroyWng_ConstraintStateType( ConstrStateData%W(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ConstrStateData%W) -ENDIF - END SUBROUTINE FVW_DestroyConstrState +subroutine FVW_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(FVW_ConstraintStateType), intent(in) :: SrcConstrStateData + type(FVW_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcConstrStateData%W)) then + LB(1:1) = lbound(SrcConstrStateData%W) + UB(1:1) = ubound(SrcConstrStateData%W) + if (.not. allocated(DstConstrStateData%W)) then + allocate(DstConstrStateData%W(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%W.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FVW_CopyWng_ConstraintStateType(SrcConstrStateData%W(i1), DstConstrStateData%W(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstConstrStateData%W)) then + deallocate(DstConstrStateData%W) + end if + DstConstrStateData%residual = SrcConstrStateData%residual +end subroutine +subroutine FVW_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(FVW_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ConstrStateData%W)) then + LB(1:1) = lbound(ConstrStateData%W) + UB(1:1) = ubound(ConstrStateData%W) + do i1 = LB(1), UB(1) + call FVW_DestroyWng_ConstraintStateType(ConstrStateData%W(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ConstrStateData%W) + end if +end subroutine subroutine FVW_PackConstrState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -5090,7 +4670,6 @@ subroutine FVW_PackConstrState(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! W call RegPack(Buf, allocated(InData%W)) if (allocated(InData%W)) then call RegPackBounds(Buf, 1, lbound(InData%W), ubound(InData%W)) @@ -5101,7 +4680,6 @@ subroutine FVW_PackConstrState(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! residual call RegPack(Buf, InData%residual) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -5115,7 +4693,6 @@ subroutine FVW_UnPackConstrState(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! W if (allocated(OutData%W)) deallocate(OutData%W) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5131,66 +4708,65 @@ subroutine FVW_UnPackConstrState(Buf, OutData) call FVW_UnpackWng_ConstraintStateType(Buf, OutData%W(i1)) ! W end do end if - ! residual call RegUnpack(Buf, OutData%residual) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE FVW_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FVW_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(FVW_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%Dummy = SrcOtherStateData%Dummy -IF (ALLOCATED(SrcOtherStateData%UA)) THEN - i1_l = LBOUND(SrcOtherStateData%UA,1) - i1_u = UBOUND(SrcOtherStateData%UA,1) - IF (.NOT. ALLOCATED(DstOtherStateData%UA)) THEN - ALLOCATE(DstOtherStateData%UA(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%UA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOtherStateData%UA,1), UBOUND(SrcOtherStateData%UA,1) - CALL UA_CopyOtherState( SrcOtherStateData%UA(i1), DstOtherStateData%UA(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE FVW_CopyOtherState - - SUBROUTINE FVW_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(FVW_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyOtherState' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OtherStateData%UA)) THEN -DO i1 = LBOUND(OtherStateData%UA,1), UBOUND(OtherStateData%UA,1) - CALL UA_DestroyOtherState( OtherStateData%UA(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OtherStateData%UA) -ENDIF - END SUBROUTINE FVW_DestroyOtherState +subroutine FVW_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(FVW_OtherStateType), intent(in) :: SrcOtherStateData + type(FVW_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%Dummy = SrcOtherStateData%Dummy + if (allocated(SrcOtherStateData%UA)) then + LB(1:1) = lbound(SrcOtherStateData%UA) + UB(1:1) = ubound(SrcOtherStateData%UA) + if (.not. allocated(DstOtherStateData%UA)) then + allocate(DstOtherStateData%UA(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%UA.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call UA_CopyOtherState(SrcOtherStateData%UA(i1), DstOtherStateData%UA(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstOtherStateData%UA)) then + deallocate(DstOtherStateData%UA) + end if +end subroutine +subroutine FVW_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(FVW_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OtherStateData%UA)) then + LB(1:1) = lbound(OtherStateData%UA) + UB(1:1) = ubound(OtherStateData%UA) + do i1 = LB(1), UB(1) + call UA_DestroyOtherState(OtherStateData%UA(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OtherStateData%UA) + end if +end subroutine subroutine FVW_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -5199,10 +4775,8 @@ subroutine FVW_PackOtherState(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! Dummy call RegPack(Buf, InData%Dummy) if (RegCheckErr(Buf, RoutineName)) return - ! UA call RegPack(Buf, allocated(InData%UA)) if (allocated(InData%UA)) then call RegPackBounds(Buf, 1, lbound(InData%UA), ubound(InData%UA)) @@ -5224,10 +4798,8 @@ subroutine FVW_UnPackOtherState(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! Dummy call RegUnpack(Buf, OutData%Dummy) if (RegCheckErr(Buf, RoutineName)) return - ! UA if (allocated(OutData%UA)) deallocate(OutData%UA) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5244,123 +4816,110 @@ subroutine FVW_UnPackOtherState(Buf, OutData) end do end if end subroutine - SUBROUTINE FVW_CopyWng_InitInputType( SrcWng_InitInputTypeData, DstWng_InitInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Wng_InitInputType), INTENT(IN) :: SrcWng_InitInputTypeData - TYPE(Wng_InitInputType), INTENT(INOUT) :: DstWng_InitInputTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_CopyWng_InitInputType' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcWng_InitInputTypeData%AFindx)) THEN - i1_l = LBOUND(SrcWng_InitInputTypeData%AFindx,1) - i1_u = UBOUND(SrcWng_InitInputTypeData%AFindx,1) - i2_l = LBOUND(SrcWng_InitInputTypeData%AFindx,2) - i2_u = UBOUND(SrcWng_InitInputTypeData%AFindx,2) - IF (.NOT. ALLOCATED(DstWng_InitInputTypeData%AFindx)) THEN - ALLOCATE(DstWng_InitInputTypeData%AFindx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_InitInputTypeData%AFindx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_InitInputTypeData%AFindx = SrcWng_InitInputTypeData%AFindx -ENDIF -IF (ALLOCATED(SrcWng_InitInputTypeData%chord)) THEN - i1_l = LBOUND(SrcWng_InitInputTypeData%chord,1) - i1_u = UBOUND(SrcWng_InitInputTypeData%chord,1) - IF (.NOT. ALLOCATED(DstWng_InitInputTypeData%chord)) THEN - ALLOCATE(DstWng_InitInputTypeData%chord(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_InitInputTypeData%chord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_InitInputTypeData%chord = SrcWng_InitInputTypeData%chord -ENDIF -IF (ALLOCATED(SrcWng_InitInputTypeData%RElm)) THEN - i1_l = LBOUND(SrcWng_InitInputTypeData%RElm,1) - i1_u = UBOUND(SrcWng_InitInputTypeData%RElm,1) - IF (.NOT. ALLOCATED(DstWng_InitInputTypeData%RElm)) THEN - ALLOCATE(DstWng_InitInputTypeData%RElm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWng_InitInputTypeData%RElm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWng_InitInputTypeData%RElm = SrcWng_InitInputTypeData%RElm -ENDIF - DstWng_InitInputTypeData%iRotor = SrcWng_InitInputTypeData%iRotor - DstWng_InitInputTypeData%UAOff_innerNode = SrcWng_InitInputTypeData%UAOff_innerNode - DstWng_InitInputTypeData%UAOff_outerNode = SrcWng_InitInputTypeData%UAOff_outerNode - END SUBROUTINE FVW_CopyWng_InitInputType - - SUBROUTINE FVW_DestroyWng_InitInputType( Wng_InitInputTypeData, ErrStat, ErrMsg ) - TYPE(Wng_InitInputType), INTENT(INOUT) :: Wng_InitInputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyWng_InitInputType' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(Wng_InitInputTypeData%AFindx)) THEN - DEALLOCATE(Wng_InitInputTypeData%AFindx) -ENDIF -IF (ALLOCATED(Wng_InitInputTypeData%chord)) THEN - DEALLOCATE(Wng_InitInputTypeData%chord) -ENDIF -IF (ALLOCATED(Wng_InitInputTypeData%RElm)) THEN - DEALLOCATE(Wng_InitInputTypeData%RElm) -ENDIF - END SUBROUTINE FVW_DestroyWng_InitInputType +subroutine FVW_CopyWng_InitInputType(SrcWng_InitInputTypeData, DstWng_InitInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(Wng_InitInputType), intent(in) :: SrcWng_InitInputTypeData + type(Wng_InitInputType), intent(inout) :: DstWng_InitInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FVW_CopyWng_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcWng_InitInputTypeData%AFindx)) then + LB(1:2) = lbound(SrcWng_InitInputTypeData%AFindx) + UB(1:2) = ubound(SrcWng_InitInputTypeData%AFindx) + if (.not. allocated(DstWng_InitInputTypeData%AFindx)) then + allocate(DstWng_InitInputTypeData%AFindx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_InitInputTypeData%AFindx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_InitInputTypeData%AFindx = SrcWng_InitInputTypeData%AFindx + else if (allocated(DstWng_InitInputTypeData%AFindx)) then + deallocate(DstWng_InitInputTypeData%AFindx) + end if + if (allocated(SrcWng_InitInputTypeData%chord)) then + LB(1:1) = lbound(SrcWng_InitInputTypeData%chord) + UB(1:1) = ubound(SrcWng_InitInputTypeData%chord) + if (.not. allocated(DstWng_InitInputTypeData%chord)) then + allocate(DstWng_InitInputTypeData%chord(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_InitInputTypeData%chord.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_InitInputTypeData%chord = SrcWng_InitInputTypeData%chord + else if (allocated(DstWng_InitInputTypeData%chord)) then + deallocate(DstWng_InitInputTypeData%chord) + end if + if (allocated(SrcWng_InitInputTypeData%RElm)) then + LB(1:1) = lbound(SrcWng_InitInputTypeData%RElm) + UB(1:1) = ubound(SrcWng_InitInputTypeData%RElm) + if (.not. allocated(DstWng_InitInputTypeData%RElm)) then + allocate(DstWng_InitInputTypeData%RElm(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWng_InitInputTypeData%RElm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWng_InitInputTypeData%RElm = SrcWng_InitInputTypeData%RElm + else if (allocated(DstWng_InitInputTypeData%RElm)) then + deallocate(DstWng_InitInputTypeData%RElm) + end if + DstWng_InitInputTypeData%iRotor = SrcWng_InitInputTypeData%iRotor + DstWng_InitInputTypeData%UAOff_innerNode = SrcWng_InitInputTypeData%UAOff_innerNode + DstWng_InitInputTypeData%UAOff_outerNode = SrcWng_InitInputTypeData%UAOff_outerNode +end subroutine +subroutine FVW_DestroyWng_InitInputType(Wng_InitInputTypeData, ErrStat, ErrMsg) + type(Wng_InitInputType), intent(inout) :: Wng_InitInputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FVW_DestroyWng_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(Wng_InitInputTypeData%AFindx)) then + deallocate(Wng_InitInputTypeData%AFindx) + end if + if (allocated(Wng_InitInputTypeData%chord)) then + deallocate(Wng_InitInputTypeData%chord) + end if + if (allocated(Wng_InitInputTypeData%RElm)) then + deallocate(Wng_InitInputTypeData%RElm) + end if +end subroutine subroutine FVW_PackWng_InitInputType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Wng_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackWng_InitInputType' if (Buf%ErrStat >= AbortErrLev) return - ! AFindx call RegPack(Buf, allocated(InData%AFindx)) if (allocated(InData%AFindx)) then call RegPackBounds(Buf, 2, lbound(InData%AFindx), ubound(InData%AFindx)) call RegPack(Buf, InData%AFindx) end if if (RegCheckErr(Buf, RoutineName)) return - ! chord call RegPack(Buf, allocated(InData%chord)) if (allocated(InData%chord)) then call RegPackBounds(Buf, 1, lbound(InData%chord), ubound(InData%chord)) call RegPack(Buf, InData%chord) end if if (RegCheckErr(Buf, RoutineName)) return - ! RElm call RegPack(Buf, allocated(InData%RElm)) if (allocated(InData%RElm)) then call RegPackBounds(Buf, 1, lbound(InData%RElm), ubound(InData%RElm)) call RegPack(Buf, InData%RElm) end if if (RegCheckErr(Buf, RoutineName)) return - ! iRotor call RegPack(Buf, InData%iRotor) if (RegCheckErr(Buf, RoutineName)) return - ! UAOff_innerNode call RegPack(Buf, InData%UAOff_innerNode) if (RegCheckErr(Buf, RoutineName)) return - ! UAOff_outerNode call RegPack(Buf, InData%UAOff_outerNode) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -5373,7 +4932,6 @@ subroutine FVW_UnPackWng_InitInputType(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! AFindx if (allocated(OutData%AFindx)) deallocate(OutData%AFindx) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5388,7 +4946,6 @@ subroutine FVW_UnPackWng_InitInputType(Buf, OutData) call RegUnpack(Buf, OutData%AFindx) if (RegCheckErr(Buf, RoutineName)) return end if - ! chord if (allocated(OutData%chord)) deallocate(OutData%chord) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5403,7 +4960,6 @@ subroutine FVW_UnPackWng_InitInputType(Buf, OutData) call RegUnpack(Buf, OutData%chord) if (RegCheckErr(Buf, RoutineName)) return end if - ! RElm if (allocated(OutData%RElm)) deallocate(OutData%RElm) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5418,106 +4974,107 @@ subroutine FVW_UnPackWng_InitInputType(Buf, OutData) call RegUnpack(Buf, OutData%RElm) if (RegCheckErr(Buf, RoutineName)) return end if - ! iRotor call RegUnpack(Buf, OutData%iRotor) if (RegCheckErr(Buf, RoutineName)) return - ! UAOff_innerNode call RegUnpack(Buf, OutData%UAOff_innerNode) if (RegCheckErr(Buf, RoutineName)) return - ! UAOff_outerNode call RegUnpack(Buf, OutData%UAOff_outerNode) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE FVW_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FVW_InitInputType), INTENT(INOUT) :: SrcInitInputData - TYPE(FVW_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%FVWFileName = SrcInitInputData%FVWFileName - DstInitInputData%RootName = SrcInitInputData%RootName -IF (ALLOCATED(SrcInitInputData%W)) THEN - i1_l = LBOUND(SrcInitInputData%W,1) - i1_u = UBOUND(SrcInitInputData%W,1) - IF (.NOT. ALLOCATED(DstInitInputData%W)) THEN - ALLOCATE(DstInitInputData%W(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%W.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitInputData%W,1), UBOUND(SrcInitInputData%W,1) - CALL FVW_Copywng_initinputtype( SrcInitInputData%W(i1), DstInitInputData%W(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInitInputData%WingsMesh)) THEN - i1_l = LBOUND(SrcInitInputData%WingsMesh,1) - i1_u = UBOUND(SrcInitInputData%WingsMesh,1) - IF (.NOT. ALLOCATED(DstInitInputData%WingsMesh)) THEN - ALLOCATE(DstInitInputData%WingsMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WingsMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitInputData%WingsMesh,1), UBOUND(SrcInitInputData%WingsMesh,1) - CALL MeshCopy( SrcInitInputData%WingsMesh(i1), DstInitInputData%WingsMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstInitInputData%numBladeNodes = SrcInitInputData%numBladeNodes - DstInitInputData%DTaero = SrcInitInputData%DTaero - DstInitInputData%KinVisc = SrcInitInputData%KinVisc - DstInitInputData%MHK = SrcInitInputData%MHK - DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth - DstInitInputData%UAMod = SrcInitInputData%UAMod - DstInitInputData%UA_Flag = SrcInitInputData%UA_Flag - DstInitInputData%Flookup = SrcInitInputData%Flookup - DstInitInputData%a_s = SrcInitInputData%a_s - DstInitInputData%SumPrint = SrcInitInputData%SumPrint - END SUBROUTINE FVW_CopyInitInput - - SUBROUTINE FVW_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(FVW_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(InitInputData%W)) THEN -DO i1 = LBOUND(InitInputData%W,1), UBOUND(InitInputData%W,1) - CALL FVW_DestroyWng_InitInputType( InitInputData%W(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InitInputData%W) -ENDIF -IF (ALLOCATED(InitInputData%WingsMesh)) THEN -DO i1 = LBOUND(InitInputData%WingsMesh,1), UBOUND(InitInputData%WingsMesh,1) - CALL MeshDestroy( InitInputData%WingsMesh(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InitInputData%WingsMesh) -ENDIF - END SUBROUTINE FVW_DestroyInitInput +subroutine FVW_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(FVW_InitInputType), intent(inout) :: SrcInitInputData + type(FVW_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitInputData%FVWFileName = SrcInitInputData%FVWFileName + DstInitInputData%RootName = SrcInitInputData%RootName + if (allocated(SrcInitInputData%W)) then + LB(1:1) = lbound(SrcInitInputData%W) + UB(1:1) = ubound(SrcInitInputData%W) + if (.not. allocated(DstInitInputData%W)) then + allocate(DstInitInputData%W(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%W.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FVW_CopyWng_InitInputType(SrcInitInputData%W(i1), DstInitInputData%W(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstInitInputData%W)) then + deallocate(DstInitInputData%W) + end if + if (allocated(SrcInitInputData%WingsMesh)) then + LB(1:1) = lbound(SrcInitInputData%WingsMesh) + UB(1:1) = ubound(SrcInitInputData%WingsMesh) + if (.not. allocated(DstInitInputData%WingsMesh)) then + allocate(DstInitInputData%WingsMesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WingsMesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcInitInputData%WingsMesh(i1), DstInitInputData%WingsMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstInitInputData%WingsMesh)) then + deallocate(DstInitInputData%WingsMesh) + end if + DstInitInputData%numBladeNodes = SrcInitInputData%numBladeNodes + DstInitInputData%DTaero = SrcInitInputData%DTaero + DstInitInputData%KinVisc = SrcInitInputData%KinVisc + DstInitInputData%MHK = SrcInitInputData%MHK + DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth + DstInitInputData%UAMod = SrcInitInputData%UAMod + DstInitInputData%UA_Flag = SrcInitInputData%UA_Flag + DstInitInputData%Flookup = SrcInitInputData%Flookup + DstInitInputData%a_s = SrcInitInputData%a_s + DstInitInputData%SumPrint = SrcInitInputData%SumPrint +end subroutine +subroutine FVW_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(FVW_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitInputData%W)) then + LB(1:1) = lbound(InitInputData%W) + UB(1:1) = ubound(InitInputData%W) + do i1 = LB(1), UB(1) + call FVW_DestroyWng_InitInputType(InitInputData%W(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitInputData%W) + end if + if (allocated(InitInputData%WingsMesh)) then + LB(1:1) = lbound(InitInputData%WingsMesh) + UB(1:1) = ubound(InitInputData%WingsMesh) + do i1 = LB(1), UB(1) + call MeshDestroy( InitInputData%WingsMesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitInputData%WingsMesh) + end if +end subroutine subroutine FVW_PackInitInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -5526,13 +5083,10 @@ subroutine FVW_PackInitInput(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! FVWFileName call RegPack(Buf, InData%FVWFileName) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegPack(Buf, InData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! W call RegPack(Buf, allocated(InData%W)) if (allocated(InData%W)) then call RegPackBounds(Buf, 1, lbound(InData%W), ubound(InData%W)) @@ -5543,7 +5097,6 @@ subroutine FVW_PackInitInput(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! WingsMesh call RegPack(Buf, allocated(InData%WingsMesh)) if (allocated(InData%WingsMesh)) then call RegPackBounds(Buf, 1, lbound(InData%WingsMesh), ubound(InData%WingsMesh)) @@ -5554,34 +5107,24 @@ subroutine FVW_PackInitInput(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! numBladeNodes call RegPack(Buf, InData%numBladeNodes) if (RegCheckErr(Buf, RoutineName)) return - ! DTaero call RegPack(Buf, InData%DTaero) if (RegCheckErr(Buf, RoutineName)) return - ! KinVisc call RegPack(Buf, InData%KinVisc) if (RegCheckErr(Buf, RoutineName)) return - ! MHK call RegPack(Buf, InData%MHK) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDpth call RegPack(Buf, InData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - ! UAMod call RegPack(Buf, InData%UAMod) if (RegCheckErr(Buf, RoutineName)) return - ! UA_Flag call RegPack(Buf, InData%UA_Flag) if (RegCheckErr(Buf, RoutineName)) return - ! Flookup call RegPack(Buf, InData%Flookup) if (RegCheckErr(Buf, RoutineName)) return - ! a_s call RegPack(Buf, InData%a_s) if (RegCheckErr(Buf, RoutineName)) return - ! SumPrint call RegPack(Buf, InData%SumPrint) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -5595,13 +5138,10 @@ subroutine FVW_UnPackInitInput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! FVWFileName call RegUnpack(Buf, OutData%FVWFileName) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegUnpack(Buf, OutData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! W if (allocated(OutData%W)) deallocate(OutData%W) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5617,7 +5157,6 @@ subroutine FVW_UnPackInitInput(Buf, OutData) call FVW_UnpackWng_InitInputType(Buf, OutData%W(i1)) ! W end do end if - ! WingsMesh if (allocated(OutData%WingsMesh)) deallocate(OutData%WingsMesh) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5633,201 +5172,147 @@ subroutine FVW_UnPackInitInput(Buf, OutData) call MeshUnpack(Buf, OutData%WingsMesh(i1)) ! WingsMesh end do end if - ! numBladeNodes call RegUnpack(Buf, OutData%numBladeNodes) if (RegCheckErr(Buf, RoutineName)) return - ! DTaero call RegUnpack(Buf, OutData%DTaero) if (RegCheckErr(Buf, RoutineName)) return - ! KinVisc call RegUnpack(Buf, OutData%KinVisc) if (RegCheckErr(Buf, RoutineName)) return - ! MHK call RegUnpack(Buf, OutData%MHK) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDpth call RegUnpack(Buf, OutData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - ! UAMod call RegUnpack(Buf, OutData%UAMod) if (RegCheckErr(Buf, RoutineName)) return - ! UA_Flag call RegUnpack(Buf, OutData%UA_Flag) if (RegCheckErr(Buf, RoutineName)) return - ! Flookup call RegUnpack(Buf, OutData%Flookup) if (RegCheckErr(Buf, RoutineName)) return - ! a_s call RegUnpack(Buf, OutData%a_s) if (RegCheckErr(Buf, RoutineName)) return - ! SumPrint call RegUnpack(Buf, OutData%SumPrint) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE FVW_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FVW_InputFile), INTENT(IN) :: SrcInputFileData - TYPE(FVW_InputFile), INTENT(INOUT) :: DstInputFileData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_CopyInputFile' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInputFileData%CircSolvMethod = SrcInputFileData%CircSolvMethod - DstInputFileData%CirculationFile = SrcInputFileData%CirculationFile - DstInputFileData%CircSolvMaxIter = SrcInputFileData%CircSolvMaxIter - DstInputFileData%CircSolvConvCrit = SrcInputFileData%CircSolvConvCrit - DstInputFileData%CircSolvRelaxation = SrcInputFileData%CircSolvRelaxation - DstInputFileData%IntMethod = SrcInputFileData%IntMethod - DstInputFileData%FreeWake = SrcInputFileData%FreeWake - DstInputFileData%FreeWakeStart = SrcInputFileData%FreeWakeStart - DstInputFileData%FullCircStart = SrcInputFileData%FullCircStart - DstInputFileData%DTfvw = SrcInputFileData%DTfvw - DstInputFileData%CircSolvPolar = SrcInputFileData%CircSolvPolar - DstInputFileData%nNWPanels = SrcInputFileData%nNWPanels - DstInputFileData%nNWPanelsFree = SrcInputFileData%nNWPanelsFree - DstInputFileData%nFWPanels = SrcInputFileData%nFWPanels - DstInputFileData%nFWPanelsFree = SrcInputFileData%nFWPanelsFree - DstInputFileData%FWShedVorticity = SrcInputFileData%FWShedVorticity - DstInputFileData%DiffusionMethod = SrcInputFileData%DiffusionMethod - DstInputFileData%CoreSpreadEddyVisc = SrcInputFileData%CoreSpreadEddyVisc - DstInputFileData%RegDeterMethod = SrcInputFileData%RegDeterMethod - DstInputFileData%RegFunction = SrcInputFileData%RegFunction - DstInputFileData%WakeRegMethod = SrcInputFileData%WakeRegMethod - DstInputFileData%WakeRegParam = SrcInputFileData%WakeRegParam - DstInputFileData%WingRegParam = SrcInputFileData%WingRegParam - DstInputFileData%ShearModel = SrcInputFileData%ShearModel - DstInputFileData%TwrShadowOnWake = SrcInputFileData%TwrShadowOnWake - DstInputFileData%VelocityMethod = SrcInputFileData%VelocityMethod - DstInputFileData%TreeBranchFactor = SrcInputFileData%TreeBranchFactor - DstInputFileData%PartPerSegment = SrcInputFileData%PartPerSegment - DstInputFileData%WrVTK = SrcInputFileData%WrVTK - DstInputFileData%VTKBlades = SrcInputFileData%VTKBlades - DstInputFileData%DTvtk = SrcInputFileData%DTvtk - DstInputFileData%VTKCoord = SrcInputFileData%VTKCoord - END SUBROUTINE FVW_CopyInputFile - SUBROUTINE FVW_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) - TYPE(FVW_InputFile), INTENT(INOUT) :: InputFileData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyInputFile' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE FVW_DestroyInputFile +subroutine FVW_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) + type(FVW_InputFile), intent(in) :: SrcInputFileData + type(FVW_InputFile), intent(inout) :: DstInputFileData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FVW_CopyInputFile' + ErrStat = ErrID_None + ErrMsg = '' + DstInputFileData%CircSolvMethod = SrcInputFileData%CircSolvMethod + DstInputFileData%CirculationFile = SrcInputFileData%CirculationFile + DstInputFileData%CircSolvMaxIter = SrcInputFileData%CircSolvMaxIter + DstInputFileData%CircSolvConvCrit = SrcInputFileData%CircSolvConvCrit + DstInputFileData%CircSolvRelaxation = SrcInputFileData%CircSolvRelaxation + DstInputFileData%IntMethod = SrcInputFileData%IntMethod + DstInputFileData%FreeWake = SrcInputFileData%FreeWake + DstInputFileData%FreeWakeStart = SrcInputFileData%FreeWakeStart + DstInputFileData%FullCircStart = SrcInputFileData%FullCircStart + DstInputFileData%DTfvw = SrcInputFileData%DTfvw + DstInputFileData%CircSolvPolar = SrcInputFileData%CircSolvPolar + DstInputFileData%nNWPanels = SrcInputFileData%nNWPanels + DstInputFileData%nNWPanelsFree = SrcInputFileData%nNWPanelsFree + DstInputFileData%nFWPanels = SrcInputFileData%nFWPanels + DstInputFileData%nFWPanelsFree = SrcInputFileData%nFWPanelsFree + DstInputFileData%FWShedVorticity = SrcInputFileData%FWShedVorticity + DstInputFileData%DiffusionMethod = SrcInputFileData%DiffusionMethod + DstInputFileData%CoreSpreadEddyVisc = SrcInputFileData%CoreSpreadEddyVisc + DstInputFileData%RegDeterMethod = SrcInputFileData%RegDeterMethod + DstInputFileData%RegFunction = SrcInputFileData%RegFunction + DstInputFileData%WakeRegMethod = SrcInputFileData%WakeRegMethod + DstInputFileData%WakeRegParam = SrcInputFileData%WakeRegParam + DstInputFileData%WingRegParam = SrcInputFileData%WingRegParam + DstInputFileData%ShearModel = SrcInputFileData%ShearModel + DstInputFileData%TwrShadowOnWake = SrcInputFileData%TwrShadowOnWake + DstInputFileData%VelocityMethod = SrcInputFileData%VelocityMethod + DstInputFileData%TreeBranchFactor = SrcInputFileData%TreeBranchFactor + DstInputFileData%PartPerSegment = SrcInputFileData%PartPerSegment + DstInputFileData%WrVTK = SrcInputFileData%WrVTK + DstInputFileData%VTKBlades = SrcInputFileData%VTKBlades + DstInputFileData%DTvtk = SrcInputFileData%DTvtk + DstInputFileData%VTKCoord = SrcInputFileData%VTKCoord +end subroutine +subroutine FVW_DestroyInputFile(InputFileData, ErrStat, ErrMsg) + type(FVW_InputFile), intent(inout) :: InputFileData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FVW_DestroyInputFile' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine FVW_PackInputFile(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FVW_InputFile), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackInputFile' if (Buf%ErrStat >= AbortErrLev) return - ! CircSolvMethod call RegPack(Buf, InData%CircSolvMethod) if (RegCheckErr(Buf, RoutineName)) return - ! CirculationFile call RegPack(Buf, InData%CirculationFile) if (RegCheckErr(Buf, RoutineName)) return - ! CircSolvMaxIter call RegPack(Buf, InData%CircSolvMaxIter) if (RegCheckErr(Buf, RoutineName)) return - ! CircSolvConvCrit call RegPack(Buf, InData%CircSolvConvCrit) if (RegCheckErr(Buf, RoutineName)) return - ! CircSolvRelaxation call RegPack(Buf, InData%CircSolvRelaxation) if (RegCheckErr(Buf, RoutineName)) return - ! IntMethod call RegPack(Buf, InData%IntMethod) if (RegCheckErr(Buf, RoutineName)) return - ! FreeWake call RegPack(Buf, InData%FreeWake) if (RegCheckErr(Buf, RoutineName)) return - ! FreeWakeStart call RegPack(Buf, InData%FreeWakeStart) if (RegCheckErr(Buf, RoutineName)) return - ! FullCircStart call RegPack(Buf, InData%FullCircStart) if (RegCheckErr(Buf, RoutineName)) return - ! DTfvw call RegPack(Buf, InData%DTfvw) if (RegCheckErr(Buf, RoutineName)) return - ! CircSolvPolar call RegPack(Buf, InData%CircSolvPolar) if (RegCheckErr(Buf, RoutineName)) return - ! nNWPanels call RegPack(Buf, InData%nNWPanels) if (RegCheckErr(Buf, RoutineName)) return - ! nNWPanelsFree call RegPack(Buf, InData%nNWPanelsFree) if (RegCheckErr(Buf, RoutineName)) return - ! nFWPanels call RegPack(Buf, InData%nFWPanels) if (RegCheckErr(Buf, RoutineName)) return - ! nFWPanelsFree call RegPack(Buf, InData%nFWPanelsFree) if (RegCheckErr(Buf, RoutineName)) return - ! FWShedVorticity call RegPack(Buf, InData%FWShedVorticity) if (RegCheckErr(Buf, RoutineName)) return - ! DiffusionMethod call RegPack(Buf, InData%DiffusionMethod) if (RegCheckErr(Buf, RoutineName)) return - ! CoreSpreadEddyVisc call RegPack(Buf, InData%CoreSpreadEddyVisc) if (RegCheckErr(Buf, RoutineName)) return - ! RegDeterMethod call RegPack(Buf, InData%RegDeterMethod) if (RegCheckErr(Buf, RoutineName)) return - ! RegFunction call RegPack(Buf, InData%RegFunction) if (RegCheckErr(Buf, RoutineName)) return - ! WakeRegMethod call RegPack(Buf, InData%WakeRegMethod) if (RegCheckErr(Buf, RoutineName)) return - ! WakeRegParam call RegPack(Buf, InData%WakeRegParam) if (RegCheckErr(Buf, RoutineName)) return - ! WingRegParam call RegPack(Buf, InData%WingRegParam) if (RegCheckErr(Buf, RoutineName)) return - ! ShearModel call RegPack(Buf, InData%ShearModel) if (RegCheckErr(Buf, RoutineName)) return - ! TwrShadowOnWake call RegPack(Buf, InData%TwrShadowOnWake) if (RegCheckErr(Buf, RoutineName)) return - ! VelocityMethod call RegPack(Buf, InData%VelocityMethod) if (RegCheckErr(Buf, RoutineName)) return - ! TreeBranchFactor call RegPack(Buf, InData%TreeBranchFactor) if (RegCheckErr(Buf, RoutineName)) return - ! PartPerSegment call RegPack(Buf, InData%PartPerSegment) if (RegCheckErr(Buf, RoutineName)) return - ! WrVTK call RegPack(Buf, InData%WrVTK) if (RegCheckErr(Buf, RoutineName)) return - ! VTKBlades call RegPack(Buf, InData%VTKBlades) if (RegCheckErr(Buf, RoutineName)) return - ! DTvtk call RegPack(Buf, InData%DTvtk) if (RegCheckErr(Buf, RoutineName)) return - ! VTKCoord call RegPack(Buf, InData%VTKCoord) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -5837,142 +5322,98 @@ subroutine FVW_UnPackInputFile(Buf, OutData) type(FVW_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackInputFile' if (Buf%ErrStat /= ErrID_None) return - ! CircSolvMethod call RegUnpack(Buf, OutData%CircSolvMethod) if (RegCheckErr(Buf, RoutineName)) return - ! CirculationFile call RegUnpack(Buf, OutData%CirculationFile) if (RegCheckErr(Buf, RoutineName)) return - ! CircSolvMaxIter call RegUnpack(Buf, OutData%CircSolvMaxIter) if (RegCheckErr(Buf, RoutineName)) return - ! CircSolvConvCrit call RegUnpack(Buf, OutData%CircSolvConvCrit) if (RegCheckErr(Buf, RoutineName)) return - ! CircSolvRelaxation call RegUnpack(Buf, OutData%CircSolvRelaxation) if (RegCheckErr(Buf, RoutineName)) return - ! IntMethod call RegUnpack(Buf, OutData%IntMethod) if (RegCheckErr(Buf, RoutineName)) return - ! FreeWake call RegUnpack(Buf, OutData%FreeWake) if (RegCheckErr(Buf, RoutineName)) return - ! FreeWakeStart call RegUnpack(Buf, OutData%FreeWakeStart) if (RegCheckErr(Buf, RoutineName)) return - ! FullCircStart call RegUnpack(Buf, OutData%FullCircStart) if (RegCheckErr(Buf, RoutineName)) return - ! DTfvw call RegUnpack(Buf, OutData%DTfvw) if (RegCheckErr(Buf, RoutineName)) return - ! CircSolvPolar call RegUnpack(Buf, OutData%CircSolvPolar) if (RegCheckErr(Buf, RoutineName)) return - ! nNWPanels call RegUnpack(Buf, OutData%nNWPanels) if (RegCheckErr(Buf, RoutineName)) return - ! nNWPanelsFree call RegUnpack(Buf, OutData%nNWPanelsFree) if (RegCheckErr(Buf, RoutineName)) return - ! nFWPanels call RegUnpack(Buf, OutData%nFWPanels) if (RegCheckErr(Buf, RoutineName)) return - ! nFWPanelsFree call RegUnpack(Buf, OutData%nFWPanelsFree) if (RegCheckErr(Buf, RoutineName)) return - ! FWShedVorticity call RegUnpack(Buf, OutData%FWShedVorticity) if (RegCheckErr(Buf, RoutineName)) return - ! DiffusionMethod call RegUnpack(Buf, OutData%DiffusionMethod) if (RegCheckErr(Buf, RoutineName)) return - ! CoreSpreadEddyVisc call RegUnpack(Buf, OutData%CoreSpreadEddyVisc) if (RegCheckErr(Buf, RoutineName)) return - ! RegDeterMethod call RegUnpack(Buf, OutData%RegDeterMethod) if (RegCheckErr(Buf, RoutineName)) return - ! RegFunction call RegUnpack(Buf, OutData%RegFunction) if (RegCheckErr(Buf, RoutineName)) return - ! WakeRegMethod call RegUnpack(Buf, OutData%WakeRegMethod) if (RegCheckErr(Buf, RoutineName)) return - ! WakeRegParam call RegUnpack(Buf, OutData%WakeRegParam) if (RegCheckErr(Buf, RoutineName)) return - ! WingRegParam call RegUnpack(Buf, OutData%WingRegParam) if (RegCheckErr(Buf, RoutineName)) return - ! ShearModel call RegUnpack(Buf, OutData%ShearModel) if (RegCheckErr(Buf, RoutineName)) return - ! TwrShadowOnWake call RegUnpack(Buf, OutData%TwrShadowOnWake) if (RegCheckErr(Buf, RoutineName)) return - ! VelocityMethod call RegUnpack(Buf, OutData%VelocityMethod) if (RegCheckErr(Buf, RoutineName)) return - ! TreeBranchFactor call RegUnpack(Buf, OutData%TreeBranchFactor) if (RegCheckErr(Buf, RoutineName)) return - ! PartPerSegment call RegUnpack(Buf, OutData%PartPerSegment) if (RegCheckErr(Buf, RoutineName)) return - ! WrVTK call RegUnpack(Buf, OutData%WrVTK) if (RegCheckErr(Buf, RoutineName)) return - ! VTKBlades call RegUnpack(Buf, OutData%VTKBlades) if (RegCheckErr(Buf, RoutineName)) return - ! DTvtk call RegUnpack(Buf, OutData%DTvtk) if (RegCheckErr(Buf, RoutineName)) return - ! VTKCoord call RegUnpack(Buf, OutData%VTKCoord) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE FVW_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FVW_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(FVW_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_CopyInitOutput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitOutputData%Dummy = SrcInitOutputData%Dummy - END SUBROUTINE FVW_CopyInitOutput - SUBROUTINE FVW_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(FVW_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE FVW_DestroyInitOutput +subroutine FVW_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(FVW_InitOutputType), intent(in) :: SrcInitOutputData + type(FVW_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FVW_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitOutputData%Dummy = SrcInitOutputData%Dummy +end subroutine +subroutine FVW_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(FVW_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FVW_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine FVW_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FVW_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackInitOutput' if (Buf%ErrStat >= AbortErrLev) return - ! Dummy call RegPack(Buf, InData%Dummy) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -5982,7 +5423,6 @@ subroutine FVW_UnPackInitOutput(Buf, OutData) type(FVW_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackInitOutput' if (Buf%ErrStat /= ErrID_None) return - ! Dummy call RegUnpack(Buf, OutData%Dummy) if (RegCheckErr(Buf, RoutineName)) return end subroutine diff --git a/modules/aerodyn/src/UnsteadyAero_Types.f90 b/modules/aerodyn/src/UnsteadyAero_Types.f90 index 6b8ecfa31a..0ab310951d 100644 --- a/modules/aerodyn/src/UnsteadyAero_Types.f90 +++ b/modules/aerodyn/src/UnsteadyAero_Types.f90 @@ -244,143 +244,124 @@ MODULE UnsteadyAero_Types END TYPE UA_OutputType ! ======================= CONTAINS - SUBROUTINE UA_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(UA_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(UA_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%dt = SrcInitInputData%dt - DstInitInputData%OutRootName = SrcInitInputData%OutRootName -IF (ALLOCATED(SrcInitInputData%c)) THEN - i1_l = LBOUND(SrcInitInputData%c,1) - i1_u = UBOUND(SrcInitInputData%c,1) - i2_l = LBOUND(SrcInitInputData%c,2) - i2_u = UBOUND(SrcInitInputData%c,2) - IF (.NOT. ALLOCATED(DstInitInputData%c)) THEN - ALLOCATE(DstInitInputData%c(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%c.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%c = SrcInitInputData%c -ENDIF - DstInitInputData%numBlades = SrcInitInputData%numBlades - DstInitInputData%nNodesPerBlade = SrcInitInputData%nNodesPerBlade - DstInitInputData%UAMod = SrcInitInputData%UAMod - DstInitInputData%a_s = SrcInitInputData%a_s - DstInitInputData%Flookup = SrcInitInputData%Flookup - DstInitInputData%ShedEffect = SrcInitInputData%ShedEffect - DstInitInputData%WrSum = SrcInitInputData%WrSum -IF (ALLOCATED(SrcInitInputData%UAOff_innerNode)) THEN - i1_l = LBOUND(SrcInitInputData%UAOff_innerNode,1) - i1_u = UBOUND(SrcInitInputData%UAOff_innerNode,1) - IF (.NOT. ALLOCATED(DstInitInputData%UAOff_innerNode)) THEN - ALLOCATE(DstInitInputData%UAOff_innerNode(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%UAOff_innerNode.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%UAOff_innerNode = SrcInitInputData%UAOff_innerNode -ENDIF -IF (ALLOCATED(SrcInitInputData%UAOff_outerNode)) THEN - i1_l = LBOUND(SrcInitInputData%UAOff_outerNode,1) - i1_u = UBOUND(SrcInitInputData%UAOff_outerNode,1) - IF (.NOT. ALLOCATED(DstInitInputData%UAOff_outerNode)) THEN - ALLOCATE(DstInitInputData%UAOff_outerNode(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%UAOff_outerNode.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%UAOff_outerNode = SrcInitInputData%UAOff_outerNode -ENDIF - END SUBROUTINE UA_CopyInitInput - - SUBROUTINE UA_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(UA_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyInitInput' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitInputData%c)) THEN - DEALLOCATE(InitInputData%c) -ENDIF -IF (ALLOCATED(InitInputData%UAOff_innerNode)) THEN - DEALLOCATE(InitInputData%UAOff_innerNode) -ENDIF -IF (ALLOCATED(InitInputData%UAOff_outerNode)) THEN - DEALLOCATE(InitInputData%UAOff_outerNode) -ENDIF - END SUBROUTINE UA_DestroyInitInput +subroutine UA_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(UA_InitInputType), intent(in) :: SrcInitInputData + type(UA_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'UA_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitInputData%dt = SrcInitInputData%dt + DstInitInputData%OutRootName = SrcInitInputData%OutRootName + if (allocated(SrcInitInputData%c)) then + LB(1:2) = lbound(SrcInitInputData%c) + UB(1:2) = ubound(SrcInitInputData%c) + if (.not. allocated(DstInitInputData%c)) then + allocate(DstInitInputData%c(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%c.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%c = SrcInitInputData%c + else if (allocated(DstInitInputData%c)) then + deallocate(DstInitInputData%c) + end if + DstInitInputData%numBlades = SrcInitInputData%numBlades + DstInitInputData%nNodesPerBlade = SrcInitInputData%nNodesPerBlade + DstInitInputData%UAMod = SrcInitInputData%UAMod + DstInitInputData%a_s = SrcInitInputData%a_s + DstInitInputData%Flookup = SrcInitInputData%Flookup + DstInitInputData%ShedEffect = SrcInitInputData%ShedEffect + DstInitInputData%WrSum = SrcInitInputData%WrSum + if (allocated(SrcInitInputData%UAOff_innerNode)) then + LB(1:1) = lbound(SrcInitInputData%UAOff_innerNode) + UB(1:1) = ubound(SrcInitInputData%UAOff_innerNode) + if (.not. allocated(DstInitInputData%UAOff_innerNode)) then + allocate(DstInitInputData%UAOff_innerNode(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%UAOff_innerNode.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%UAOff_innerNode = SrcInitInputData%UAOff_innerNode + else if (allocated(DstInitInputData%UAOff_innerNode)) then + deallocate(DstInitInputData%UAOff_innerNode) + end if + if (allocated(SrcInitInputData%UAOff_outerNode)) then + LB(1:1) = lbound(SrcInitInputData%UAOff_outerNode) + UB(1:1) = ubound(SrcInitInputData%UAOff_outerNode) + if (.not. allocated(DstInitInputData%UAOff_outerNode)) then + allocate(DstInitInputData%UAOff_outerNode(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%UAOff_outerNode.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%UAOff_outerNode = SrcInitInputData%UAOff_outerNode + else if (allocated(DstInitInputData%UAOff_outerNode)) then + deallocate(DstInitInputData%UAOff_outerNode) + end if +end subroutine +subroutine UA_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(UA_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'UA_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitInputData%c)) then + deallocate(InitInputData%c) + end if + if (allocated(InitInputData%UAOff_innerNode)) then + deallocate(InitInputData%UAOff_innerNode) + end if + if (allocated(InitInputData%UAOff_outerNode)) then + deallocate(InitInputData%UAOff_outerNode) + end if +end subroutine subroutine UA_PackInitInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(UA_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'UA_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return - ! dt call RegPack(Buf, InData%dt) if (RegCheckErr(Buf, RoutineName)) return - ! OutRootName call RegPack(Buf, InData%OutRootName) if (RegCheckErr(Buf, RoutineName)) return - ! c call RegPack(Buf, allocated(InData%c)) if (allocated(InData%c)) then call RegPackBounds(Buf, 2, lbound(InData%c), ubound(InData%c)) call RegPack(Buf, InData%c) end if if (RegCheckErr(Buf, RoutineName)) return - ! numBlades call RegPack(Buf, InData%numBlades) if (RegCheckErr(Buf, RoutineName)) return - ! nNodesPerBlade call RegPack(Buf, InData%nNodesPerBlade) if (RegCheckErr(Buf, RoutineName)) return - ! UAMod call RegPack(Buf, InData%UAMod) if (RegCheckErr(Buf, RoutineName)) return - ! a_s call RegPack(Buf, InData%a_s) if (RegCheckErr(Buf, RoutineName)) return - ! Flookup call RegPack(Buf, InData%Flookup) if (RegCheckErr(Buf, RoutineName)) return - ! ShedEffect call RegPack(Buf, InData%ShedEffect) if (RegCheckErr(Buf, RoutineName)) return - ! WrSum call RegPack(Buf, InData%WrSum) if (RegCheckErr(Buf, RoutineName)) return - ! UAOff_innerNode call RegPack(Buf, allocated(InData%UAOff_innerNode)) if (allocated(InData%UAOff_innerNode)) then call RegPackBounds(Buf, 1, lbound(InData%UAOff_innerNode), ubound(InData%UAOff_innerNode)) call RegPack(Buf, InData%UAOff_innerNode) end if if (RegCheckErr(Buf, RoutineName)) return - ! UAOff_outerNode call RegPack(Buf, allocated(InData%UAOff_outerNode)) if (allocated(InData%UAOff_outerNode)) then call RegPackBounds(Buf, 1, lbound(InData%UAOff_outerNode), ubound(InData%UAOff_outerNode)) @@ -397,13 +378,10 @@ subroutine UA_UnPackInitInput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! dt call RegUnpack(Buf, OutData%dt) if (RegCheckErr(Buf, RoutineName)) return - ! OutRootName call RegUnpack(Buf, OutData%OutRootName) if (RegCheckErr(Buf, RoutineName)) return - ! c if (allocated(OutData%c)) deallocate(OutData%c) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -418,28 +396,20 @@ subroutine UA_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%c) if (RegCheckErr(Buf, RoutineName)) return end if - ! numBlades call RegUnpack(Buf, OutData%numBlades) if (RegCheckErr(Buf, RoutineName)) return - ! nNodesPerBlade call RegUnpack(Buf, OutData%nNodesPerBlade) if (RegCheckErr(Buf, RoutineName)) return - ! UAMod call RegUnpack(Buf, OutData%UAMod) if (RegCheckErr(Buf, RoutineName)) return - ! a_s call RegUnpack(Buf, OutData%a_s) if (RegCheckErr(Buf, RoutineName)) return - ! Flookup call RegUnpack(Buf, OutData%Flookup) if (RegCheckErr(Buf, RoutineName)) return - ! ShedEffect call RegUnpack(Buf, OutData%ShedEffect) if (RegCheckErr(Buf, RoutineName)) return - ! WrSum call RegUnpack(Buf, OutData%WrSum) if (RegCheckErr(Buf, RoutineName)) return - ! UAOff_innerNode if (allocated(OutData%UAOff_innerNode)) deallocate(OutData%UAOff_innerNode) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -454,7 +424,6 @@ subroutine UA_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%UAOff_innerNode) if (RegCheckErr(Buf, RoutineName)) return end if - ! UAOff_outerNode if (allocated(OutData%UAOff_outerNode)) deallocate(OutData%UAOff_outerNode) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -470,90 +439,82 @@ subroutine UA_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE UA_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(UA_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(UA_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_CopyInitOutput' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Version, DstInitOutputData%Version, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInitOutputData%WriteOutputHdr)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputHdr,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputHdr,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputHdr)) THEN - ALLOCATE(DstInitOutputData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr -ENDIF -IF (ALLOCATED(SrcInitOutputData%WriteOutputUnt)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputUnt,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputUnt,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputUnt)) THEN - ALLOCATE(DstInitOutputData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt -ENDIF - END SUBROUTINE UA_CopyInitOutput - SUBROUTINE UA_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(UA_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL NWTC_Library_DestroyProgDesc( InitOutputData%Version, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF - END SUBROUTINE UA_DestroyInitOutput +subroutine UA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(UA_InitOutputType), intent(in) :: SrcInitOutputData + type(UA_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'UA_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Version, DstInitOutputData%Version, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr + else if (allocated(DstInitOutputData%WriteOutputHdr)) then + deallocate(DstInitOutputData%WriteOutputHdr) + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt + else if (allocated(DstInitOutputData%WriteOutputUnt)) then + deallocate(DstInitOutputData%WriteOutputUnt) + end if +end subroutine +subroutine UA_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(UA_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'UA_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if +end subroutine subroutine UA_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(UA_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'UA_PackInitOutput' if (Buf%ErrStat >= AbortErrLev) return - ! Version call NWTC_Library_PackProgDesc(Buf, InData%Version) if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutputHdr call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) call RegPack(Buf, InData%WriteOutputHdr) end if if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutputUnt call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) @@ -570,9 +531,7 @@ subroutine UA_UnPackInitOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! Version call NWTC_Library_UnpackProgDesc(Buf, OutData%Version) ! Version - ! WriteOutputHdr if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -587,7 +546,6 @@ subroutine UA_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutputHdr) if (RegCheckErr(Buf, RoutineName)) return end if - ! WriteOutputUnt if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -603,245 +561,183 @@ subroutine UA_UnPackInitOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE UA_CopyKelvinChainType( SrcKelvinChainTypeData, DstKelvinChainTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(UA_KelvinChainType), INTENT(IN) :: SrcKelvinChainTypeData - TYPE(UA_KelvinChainType), INTENT(INOUT) :: DstKelvinChainTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_CopyKelvinChainType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstKelvinChainTypeData%Cn_prime = SrcKelvinChainTypeData%Cn_prime - DstKelvinChainTypeData%C_nalpha_circ = SrcKelvinChainTypeData%C_nalpha_circ - DstKelvinChainTypeData%Kalpha_f = SrcKelvinChainTypeData%Kalpha_f - DstKelvinChainTypeData%Kq_f = SrcKelvinChainTypeData%Kq_f - DstKelvinChainTypeData%alpha_filt_cur = SrcKelvinChainTypeData%alpha_filt_cur - DstKelvinChainTypeData%alpha_e = SrcKelvinChainTypeData%alpha_e - DstKelvinChainTypeData%dalpha0 = SrcKelvinChainTypeData%dalpha0 - DstKelvinChainTypeData%alpha_f = SrcKelvinChainTypeData%alpha_f - DstKelvinChainTypeData%Kq = SrcKelvinChainTypeData%Kq - DstKelvinChainTypeData%q_cur = SrcKelvinChainTypeData%q_cur - DstKelvinChainTypeData%q_f_cur = SrcKelvinChainTypeData%q_f_cur - DstKelvinChainTypeData%X1 = SrcKelvinChainTypeData%X1 - DstKelvinChainTypeData%X2 = SrcKelvinChainTypeData%X2 - DstKelvinChainTypeData%X3 = SrcKelvinChainTypeData%X3 - DstKelvinChainTypeData%X4 = SrcKelvinChainTypeData%X4 - DstKelvinChainTypeData%Kprime_alpha = SrcKelvinChainTypeData%Kprime_alpha - DstKelvinChainTypeData%Kprime_q = SrcKelvinChainTypeData%Kprime_q - DstKelvinChainTypeData%K3prime_q = SrcKelvinChainTypeData%K3prime_q - DstKelvinChainTypeData%Kprimeprime_q = SrcKelvinChainTypeData%Kprimeprime_q - DstKelvinChainTypeData%Dp = SrcKelvinChainTypeData%Dp - DstKelvinChainTypeData%Cn_pot = SrcKelvinChainTypeData%Cn_pot - DstKelvinChainTypeData%Cc_pot = SrcKelvinChainTypeData%Cc_pot - DstKelvinChainTypeData%Cn_alpha_q_circ = SrcKelvinChainTypeData%Cn_alpha_q_circ - DstKelvinChainTypeData%Cn_alpha_q_nc = SrcKelvinChainTypeData%Cn_alpha_q_nc - DstKelvinChainTypeData%Cm_q_circ = SrcKelvinChainTypeData%Cm_q_circ - DstKelvinChainTypeData%Cn_alpha_nc = SrcKelvinChainTypeData%Cn_alpha_nc - DstKelvinChainTypeData%Cn_q_circ = SrcKelvinChainTypeData%Cn_q_circ - DstKelvinChainTypeData%Cn_q_nc = SrcKelvinChainTypeData%Cn_q_nc - DstKelvinChainTypeData%Cm_q_nc = SrcKelvinChainTypeData%Cm_q_nc - DstKelvinChainTypeData%fprimeprime = SrcKelvinChainTypeData%fprimeprime - DstKelvinChainTypeData%Df = SrcKelvinChainTypeData%Df - DstKelvinChainTypeData%Df_c = SrcKelvinChainTypeData%Df_c - DstKelvinChainTypeData%Df_m = SrcKelvinChainTypeData%Df_m - DstKelvinChainTypeData%Dalphaf = SrcKelvinChainTypeData%Dalphaf - DstKelvinChainTypeData%fprime = SrcKelvinChainTypeData%fprime - DstKelvinChainTypeData%fprime_c = SrcKelvinChainTypeData%fprime_c - DstKelvinChainTypeData%fprimeprime_c = SrcKelvinChainTypeData%fprimeprime_c - DstKelvinChainTypeData%fprime_m = SrcKelvinChainTypeData%fprime_m - DstKelvinChainTypeData%fprimeprime_m = SrcKelvinChainTypeData%fprimeprime_m - DstKelvinChainTypeData%Cn_v = SrcKelvinChainTypeData%Cn_v - DstKelvinChainTypeData%C_V = SrcKelvinChainTypeData%C_V - DstKelvinChainTypeData%Cn_FS = SrcKelvinChainTypeData%Cn_FS - DstKelvinChainTypeData%T_f = SrcKelvinChainTypeData%T_f - DstKelvinChainTypeData%T_fc = SrcKelvinChainTypeData%T_fc - DstKelvinChainTypeData%T_fm = SrcKelvinChainTypeData%T_fm - DstKelvinChainTypeData%T_V = SrcKelvinChainTypeData%T_V - DstKelvinChainTypeData%k_alpha = SrcKelvinChainTypeData%k_alpha - DstKelvinChainTypeData%k_q = SrcKelvinChainTypeData%k_q - DstKelvinChainTypeData%T_alpha = SrcKelvinChainTypeData%T_alpha - DstKelvinChainTypeData%T_q = SrcKelvinChainTypeData%T_q - DstKelvinChainTypeData%ds = SrcKelvinChainTypeData%ds - END SUBROUTINE UA_CopyKelvinChainType - SUBROUTINE UA_DestroyKelvinChainType( KelvinChainTypeData, ErrStat, ErrMsg ) - TYPE(UA_KelvinChainType), INTENT(INOUT) :: KelvinChainTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyKelvinChainType' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE UA_DestroyKelvinChainType +subroutine UA_CopyKelvinChainType(SrcKelvinChainTypeData, DstKelvinChainTypeData, CtrlCode, ErrStat, ErrMsg) + type(UA_KelvinChainType), intent(in) :: SrcKelvinChainTypeData + type(UA_KelvinChainType), intent(inout) :: DstKelvinChainTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'UA_CopyKelvinChainType' + ErrStat = ErrID_None + ErrMsg = '' + DstKelvinChainTypeData%Cn_prime = SrcKelvinChainTypeData%Cn_prime + DstKelvinChainTypeData%C_nalpha_circ = SrcKelvinChainTypeData%C_nalpha_circ + DstKelvinChainTypeData%Kalpha_f = SrcKelvinChainTypeData%Kalpha_f + DstKelvinChainTypeData%Kq_f = SrcKelvinChainTypeData%Kq_f + DstKelvinChainTypeData%alpha_filt_cur = SrcKelvinChainTypeData%alpha_filt_cur + DstKelvinChainTypeData%alpha_e = SrcKelvinChainTypeData%alpha_e + DstKelvinChainTypeData%dalpha0 = SrcKelvinChainTypeData%dalpha0 + DstKelvinChainTypeData%alpha_f = SrcKelvinChainTypeData%alpha_f + DstKelvinChainTypeData%Kq = SrcKelvinChainTypeData%Kq + DstKelvinChainTypeData%q_cur = SrcKelvinChainTypeData%q_cur + DstKelvinChainTypeData%q_f_cur = SrcKelvinChainTypeData%q_f_cur + DstKelvinChainTypeData%X1 = SrcKelvinChainTypeData%X1 + DstKelvinChainTypeData%X2 = SrcKelvinChainTypeData%X2 + DstKelvinChainTypeData%X3 = SrcKelvinChainTypeData%X3 + DstKelvinChainTypeData%X4 = SrcKelvinChainTypeData%X4 + DstKelvinChainTypeData%Kprime_alpha = SrcKelvinChainTypeData%Kprime_alpha + DstKelvinChainTypeData%Kprime_q = SrcKelvinChainTypeData%Kprime_q + DstKelvinChainTypeData%K3prime_q = SrcKelvinChainTypeData%K3prime_q + DstKelvinChainTypeData%Kprimeprime_q = SrcKelvinChainTypeData%Kprimeprime_q + DstKelvinChainTypeData%Dp = SrcKelvinChainTypeData%Dp + DstKelvinChainTypeData%Cn_pot = SrcKelvinChainTypeData%Cn_pot + DstKelvinChainTypeData%Cc_pot = SrcKelvinChainTypeData%Cc_pot + DstKelvinChainTypeData%Cn_alpha_q_circ = SrcKelvinChainTypeData%Cn_alpha_q_circ + DstKelvinChainTypeData%Cn_alpha_q_nc = SrcKelvinChainTypeData%Cn_alpha_q_nc + DstKelvinChainTypeData%Cm_q_circ = SrcKelvinChainTypeData%Cm_q_circ + DstKelvinChainTypeData%Cn_alpha_nc = SrcKelvinChainTypeData%Cn_alpha_nc + DstKelvinChainTypeData%Cn_q_circ = SrcKelvinChainTypeData%Cn_q_circ + DstKelvinChainTypeData%Cn_q_nc = SrcKelvinChainTypeData%Cn_q_nc + DstKelvinChainTypeData%Cm_q_nc = SrcKelvinChainTypeData%Cm_q_nc + DstKelvinChainTypeData%fprimeprime = SrcKelvinChainTypeData%fprimeprime + DstKelvinChainTypeData%Df = SrcKelvinChainTypeData%Df + DstKelvinChainTypeData%Df_c = SrcKelvinChainTypeData%Df_c + DstKelvinChainTypeData%Df_m = SrcKelvinChainTypeData%Df_m + DstKelvinChainTypeData%Dalphaf = SrcKelvinChainTypeData%Dalphaf + DstKelvinChainTypeData%fprime = SrcKelvinChainTypeData%fprime + DstKelvinChainTypeData%fprime_c = SrcKelvinChainTypeData%fprime_c + DstKelvinChainTypeData%fprimeprime_c = SrcKelvinChainTypeData%fprimeprime_c + DstKelvinChainTypeData%fprime_m = SrcKelvinChainTypeData%fprime_m + DstKelvinChainTypeData%fprimeprime_m = SrcKelvinChainTypeData%fprimeprime_m + DstKelvinChainTypeData%Cn_v = SrcKelvinChainTypeData%Cn_v + DstKelvinChainTypeData%C_V = SrcKelvinChainTypeData%C_V + DstKelvinChainTypeData%Cn_FS = SrcKelvinChainTypeData%Cn_FS + DstKelvinChainTypeData%T_f = SrcKelvinChainTypeData%T_f + DstKelvinChainTypeData%T_fc = SrcKelvinChainTypeData%T_fc + DstKelvinChainTypeData%T_fm = SrcKelvinChainTypeData%T_fm + DstKelvinChainTypeData%T_V = SrcKelvinChainTypeData%T_V + DstKelvinChainTypeData%k_alpha = SrcKelvinChainTypeData%k_alpha + DstKelvinChainTypeData%k_q = SrcKelvinChainTypeData%k_q + DstKelvinChainTypeData%T_alpha = SrcKelvinChainTypeData%T_alpha + DstKelvinChainTypeData%T_q = SrcKelvinChainTypeData%T_q + DstKelvinChainTypeData%ds = SrcKelvinChainTypeData%ds +end subroutine +subroutine UA_DestroyKelvinChainType(KelvinChainTypeData, ErrStat, ErrMsg) + type(UA_KelvinChainType), intent(inout) :: KelvinChainTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'UA_DestroyKelvinChainType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine UA_PackKelvinChainType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(UA_KelvinChainType), intent(in) :: InData character(*), parameter :: RoutineName = 'UA_PackKelvinChainType' if (Buf%ErrStat >= AbortErrLev) return - ! Cn_prime call RegPack(Buf, InData%Cn_prime) if (RegCheckErr(Buf, RoutineName)) return - ! C_nalpha_circ call RegPack(Buf, InData%C_nalpha_circ) if (RegCheckErr(Buf, RoutineName)) return - ! Kalpha_f call RegPack(Buf, InData%Kalpha_f) if (RegCheckErr(Buf, RoutineName)) return - ! Kq_f call RegPack(Buf, InData%Kq_f) if (RegCheckErr(Buf, RoutineName)) return - ! alpha_filt_cur call RegPack(Buf, InData%alpha_filt_cur) if (RegCheckErr(Buf, RoutineName)) return - ! alpha_e call RegPack(Buf, InData%alpha_e) if (RegCheckErr(Buf, RoutineName)) return - ! dalpha0 call RegPack(Buf, InData%dalpha0) if (RegCheckErr(Buf, RoutineName)) return - ! alpha_f call RegPack(Buf, InData%alpha_f) if (RegCheckErr(Buf, RoutineName)) return - ! Kq call RegPack(Buf, InData%Kq) if (RegCheckErr(Buf, RoutineName)) return - ! q_cur call RegPack(Buf, InData%q_cur) if (RegCheckErr(Buf, RoutineName)) return - ! q_f_cur call RegPack(Buf, InData%q_f_cur) if (RegCheckErr(Buf, RoutineName)) return - ! X1 call RegPack(Buf, InData%X1) if (RegCheckErr(Buf, RoutineName)) return - ! X2 call RegPack(Buf, InData%X2) if (RegCheckErr(Buf, RoutineName)) return - ! X3 call RegPack(Buf, InData%X3) if (RegCheckErr(Buf, RoutineName)) return - ! X4 call RegPack(Buf, InData%X4) if (RegCheckErr(Buf, RoutineName)) return - ! Kprime_alpha call RegPack(Buf, InData%Kprime_alpha) if (RegCheckErr(Buf, RoutineName)) return - ! Kprime_q call RegPack(Buf, InData%Kprime_q) if (RegCheckErr(Buf, RoutineName)) return - ! K3prime_q call RegPack(Buf, InData%K3prime_q) if (RegCheckErr(Buf, RoutineName)) return - ! Kprimeprime_q call RegPack(Buf, InData%Kprimeprime_q) if (RegCheckErr(Buf, RoutineName)) return - ! Dp call RegPack(Buf, InData%Dp) if (RegCheckErr(Buf, RoutineName)) return - ! Cn_pot call RegPack(Buf, InData%Cn_pot) if (RegCheckErr(Buf, RoutineName)) return - ! Cc_pot call RegPack(Buf, InData%Cc_pot) if (RegCheckErr(Buf, RoutineName)) return - ! Cn_alpha_q_circ call RegPack(Buf, InData%Cn_alpha_q_circ) if (RegCheckErr(Buf, RoutineName)) return - ! Cn_alpha_q_nc call RegPack(Buf, InData%Cn_alpha_q_nc) if (RegCheckErr(Buf, RoutineName)) return - ! Cm_q_circ call RegPack(Buf, InData%Cm_q_circ) if (RegCheckErr(Buf, RoutineName)) return - ! Cn_alpha_nc call RegPack(Buf, InData%Cn_alpha_nc) if (RegCheckErr(Buf, RoutineName)) return - ! Cn_q_circ call RegPack(Buf, InData%Cn_q_circ) if (RegCheckErr(Buf, RoutineName)) return - ! Cn_q_nc call RegPack(Buf, InData%Cn_q_nc) if (RegCheckErr(Buf, RoutineName)) return - ! Cm_q_nc call RegPack(Buf, InData%Cm_q_nc) if (RegCheckErr(Buf, RoutineName)) return - ! fprimeprime call RegPack(Buf, InData%fprimeprime) if (RegCheckErr(Buf, RoutineName)) return - ! Df call RegPack(Buf, InData%Df) if (RegCheckErr(Buf, RoutineName)) return - ! Df_c call RegPack(Buf, InData%Df_c) if (RegCheckErr(Buf, RoutineName)) return - ! Df_m call RegPack(Buf, InData%Df_m) if (RegCheckErr(Buf, RoutineName)) return - ! Dalphaf call RegPack(Buf, InData%Dalphaf) if (RegCheckErr(Buf, RoutineName)) return - ! fprime call RegPack(Buf, InData%fprime) if (RegCheckErr(Buf, RoutineName)) return - ! fprime_c call RegPack(Buf, InData%fprime_c) if (RegCheckErr(Buf, RoutineName)) return - ! fprimeprime_c call RegPack(Buf, InData%fprimeprime_c) if (RegCheckErr(Buf, RoutineName)) return - ! fprime_m call RegPack(Buf, InData%fprime_m) if (RegCheckErr(Buf, RoutineName)) return - ! fprimeprime_m call RegPack(Buf, InData%fprimeprime_m) if (RegCheckErr(Buf, RoutineName)) return - ! Cn_v call RegPack(Buf, InData%Cn_v) if (RegCheckErr(Buf, RoutineName)) return - ! C_V call RegPack(Buf, InData%C_V) if (RegCheckErr(Buf, RoutineName)) return - ! Cn_FS call RegPack(Buf, InData%Cn_FS) if (RegCheckErr(Buf, RoutineName)) return - ! T_f call RegPack(Buf, InData%T_f) if (RegCheckErr(Buf, RoutineName)) return - ! T_fc call RegPack(Buf, InData%T_fc) if (RegCheckErr(Buf, RoutineName)) return - ! T_fm call RegPack(Buf, InData%T_fm) if (RegCheckErr(Buf, RoutineName)) return - ! T_V call RegPack(Buf, InData%T_V) if (RegCheckErr(Buf, RoutineName)) return - ! k_alpha call RegPack(Buf, InData%k_alpha) if (RegCheckErr(Buf, RoutineName)) return - ! k_q call RegPack(Buf, InData%k_q) if (RegCheckErr(Buf, RoutineName)) return - ! T_alpha call RegPack(Buf, InData%T_alpha) if (RegCheckErr(Buf, RoutineName)) return - ! T_q call RegPack(Buf, InData%T_q) if (RegCheckErr(Buf, RoutineName)) return - ! ds call RegPack(Buf, InData%ds) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -851,200 +747,136 @@ subroutine UA_UnPackKelvinChainType(Buf, OutData) type(UA_KelvinChainType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'UA_UnPackKelvinChainType' if (Buf%ErrStat /= ErrID_None) return - ! Cn_prime call RegUnpack(Buf, OutData%Cn_prime) if (RegCheckErr(Buf, RoutineName)) return - ! C_nalpha_circ call RegUnpack(Buf, OutData%C_nalpha_circ) if (RegCheckErr(Buf, RoutineName)) return - ! Kalpha_f call RegUnpack(Buf, OutData%Kalpha_f) if (RegCheckErr(Buf, RoutineName)) return - ! Kq_f call RegUnpack(Buf, OutData%Kq_f) if (RegCheckErr(Buf, RoutineName)) return - ! alpha_filt_cur call RegUnpack(Buf, OutData%alpha_filt_cur) if (RegCheckErr(Buf, RoutineName)) return - ! alpha_e call RegUnpack(Buf, OutData%alpha_e) if (RegCheckErr(Buf, RoutineName)) return - ! dalpha0 call RegUnpack(Buf, OutData%dalpha0) if (RegCheckErr(Buf, RoutineName)) return - ! alpha_f call RegUnpack(Buf, OutData%alpha_f) if (RegCheckErr(Buf, RoutineName)) return - ! Kq call RegUnpack(Buf, OutData%Kq) if (RegCheckErr(Buf, RoutineName)) return - ! q_cur call RegUnpack(Buf, OutData%q_cur) if (RegCheckErr(Buf, RoutineName)) return - ! q_f_cur call RegUnpack(Buf, OutData%q_f_cur) if (RegCheckErr(Buf, RoutineName)) return - ! X1 call RegUnpack(Buf, OutData%X1) if (RegCheckErr(Buf, RoutineName)) return - ! X2 call RegUnpack(Buf, OutData%X2) if (RegCheckErr(Buf, RoutineName)) return - ! X3 call RegUnpack(Buf, OutData%X3) if (RegCheckErr(Buf, RoutineName)) return - ! X4 call RegUnpack(Buf, OutData%X4) if (RegCheckErr(Buf, RoutineName)) return - ! Kprime_alpha call RegUnpack(Buf, OutData%Kprime_alpha) if (RegCheckErr(Buf, RoutineName)) return - ! Kprime_q call RegUnpack(Buf, OutData%Kprime_q) if (RegCheckErr(Buf, RoutineName)) return - ! K3prime_q call RegUnpack(Buf, OutData%K3prime_q) if (RegCheckErr(Buf, RoutineName)) return - ! Kprimeprime_q call RegUnpack(Buf, OutData%Kprimeprime_q) if (RegCheckErr(Buf, RoutineName)) return - ! Dp call RegUnpack(Buf, OutData%Dp) if (RegCheckErr(Buf, RoutineName)) return - ! Cn_pot call RegUnpack(Buf, OutData%Cn_pot) if (RegCheckErr(Buf, RoutineName)) return - ! Cc_pot call RegUnpack(Buf, OutData%Cc_pot) if (RegCheckErr(Buf, RoutineName)) return - ! Cn_alpha_q_circ call RegUnpack(Buf, OutData%Cn_alpha_q_circ) if (RegCheckErr(Buf, RoutineName)) return - ! Cn_alpha_q_nc call RegUnpack(Buf, OutData%Cn_alpha_q_nc) if (RegCheckErr(Buf, RoutineName)) return - ! Cm_q_circ call RegUnpack(Buf, OutData%Cm_q_circ) if (RegCheckErr(Buf, RoutineName)) return - ! Cn_alpha_nc call RegUnpack(Buf, OutData%Cn_alpha_nc) if (RegCheckErr(Buf, RoutineName)) return - ! Cn_q_circ call RegUnpack(Buf, OutData%Cn_q_circ) if (RegCheckErr(Buf, RoutineName)) return - ! Cn_q_nc call RegUnpack(Buf, OutData%Cn_q_nc) if (RegCheckErr(Buf, RoutineName)) return - ! Cm_q_nc call RegUnpack(Buf, OutData%Cm_q_nc) if (RegCheckErr(Buf, RoutineName)) return - ! fprimeprime call RegUnpack(Buf, OutData%fprimeprime) if (RegCheckErr(Buf, RoutineName)) return - ! Df call RegUnpack(Buf, OutData%Df) if (RegCheckErr(Buf, RoutineName)) return - ! Df_c call RegUnpack(Buf, OutData%Df_c) if (RegCheckErr(Buf, RoutineName)) return - ! Df_m call RegUnpack(Buf, OutData%Df_m) if (RegCheckErr(Buf, RoutineName)) return - ! Dalphaf call RegUnpack(Buf, OutData%Dalphaf) if (RegCheckErr(Buf, RoutineName)) return - ! fprime call RegUnpack(Buf, OutData%fprime) if (RegCheckErr(Buf, RoutineName)) return - ! fprime_c call RegUnpack(Buf, OutData%fprime_c) if (RegCheckErr(Buf, RoutineName)) return - ! fprimeprime_c call RegUnpack(Buf, OutData%fprimeprime_c) if (RegCheckErr(Buf, RoutineName)) return - ! fprime_m call RegUnpack(Buf, OutData%fprime_m) if (RegCheckErr(Buf, RoutineName)) return - ! fprimeprime_m call RegUnpack(Buf, OutData%fprimeprime_m) if (RegCheckErr(Buf, RoutineName)) return - ! Cn_v call RegUnpack(Buf, OutData%Cn_v) if (RegCheckErr(Buf, RoutineName)) return - ! C_V call RegUnpack(Buf, OutData%C_V) if (RegCheckErr(Buf, RoutineName)) return - ! Cn_FS call RegUnpack(Buf, OutData%Cn_FS) if (RegCheckErr(Buf, RoutineName)) return - ! T_f call RegUnpack(Buf, OutData%T_f) if (RegCheckErr(Buf, RoutineName)) return - ! T_fc call RegUnpack(Buf, OutData%T_fc) if (RegCheckErr(Buf, RoutineName)) return - ! T_fm call RegUnpack(Buf, OutData%T_fm) if (RegCheckErr(Buf, RoutineName)) return - ! T_V call RegUnpack(Buf, OutData%T_V) if (RegCheckErr(Buf, RoutineName)) return - ! k_alpha call RegUnpack(Buf, OutData%k_alpha) if (RegCheckErr(Buf, RoutineName)) return - ! k_q call RegUnpack(Buf, OutData%k_q) if (RegCheckErr(Buf, RoutineName)) return - ! T_alpha call RegUnpack(Buf, OutData%T_alpha) if (RegCheckErr(Buf, RoutineName)) return - ! T_q call RegUnpack(Buf, OutData%T_q) if (RegCheckErr(Buf, RoutineName)) return - ! ds call RegUnpack(Buf, OutData%ds) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE UA_CopyElementContinuousStateType( SrcElementContinuousStateTypeData, DstElementContinuousStateTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(UA_ElementContinuousStateType), INTENT(IN) :: SrcElementContinuousStateTypeData - TYPE(UA_ElementContinuousStateType), INTENT(INOUT) :: DstElementContinuousStateTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_CopyElementContinuousStateType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstElementContinuousStateTypeData%x = SrcElementContinuousStateTypeData%x - END SUBROUTINE UA_CopyElementContinuousStateType - SUBROUTINE UA_DestroyElementContinuousStateType( ElementContinuousStateTypeData, ErrStat, ErrMsg ) - TYPE(UA_ElementContinuousStateType), INTENT(INOUT) :: ElementContinuousStateTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyElementContinuousStateType' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE UA_DestroyElementContinuousStateType +subroutine UA_CopyElementContinuousStateType(SrcElementContinuousStateTypeData, DstElementContinuousStateTypeData, CtrlCode, ErrStat, ErrMsg) + type(UA_ElementContinuousStateType), intent(in) :: SrcElementContinuousStateTypeData + type(UA_ElementContinuousStateType), intent(inout) :: DstElementContinuousStateTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'UA_CopyElementContinuousStateType' + ErrStat = ErrID_None + ErrMsg = '' + DstElementContinuousStateTypeData%x = SrcElementContinuousStateTypeData%x +end subroutine +subroutine UA_DestroyElementContinuousStateType(ElementContinuousStateTypeData, ErrStat, ErrMsg) + type(UA_ElementContinuousStateType), intent(inout) :: ElementContinuousStateTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'UA_DestroyElementContinuousStateType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine UA_PackElementContinuousStateType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(UA_ElementContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'UA_PackElementContinuousStateType' if (Buf%ErrStat >= AbortErrLev) return - ! x call RegPack(Buf, InData%x) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1054,72 +886,68 @@ subroutine UA_UnPackElementContinuousStateType(Buf, OutData) type(UA_ElementContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'UA_UnPackElementContinuousStateType' if (Buf%ErrStat /= ErrID_None) return - ! x call RegUnpack(Buf, OutData%x) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE UA_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(UA_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(UA_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcContStateData%element)) THEN - i1_l = LBOUND(SrcContStateData%element,1) - i1_u = UBOUND(SrcContStateData%element,1) - i2_l = LBOUND(SrcContStateData%element,2) - i2_u = UBOUND(SrcContStateData%element,2) - IF (.NOT. ALLOCATED(DstContStateData%element)) THEN - ALLOCATE(DstContStateData%element(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%element.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcContStateData%element,2), UBOUND(SrcContStateData%element,2) - DO i1 = LBOUND(SrcContStateData%element,1), UBOUND(SrcContStateData%element,1) - CALL UA_Copyelementcontinuousstatetype( SrcContStateData%element(i1,i2), DstContStateData%element(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF - END SUBROUTINE UA_CopyContState - - SUBROUTINE UA_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(UA_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyContState' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ContStateData%element)) THEN -DO i2 = LBOUND(ContStateData%element,2), UBOUND(ContStateData%element,2) -DO i1 = LBOUND(ContStateData%element,1), UBOUND(ContStateData%element,1) - CALL UA_DestroyElementContinuousStateType( ContStateData%element(i1,i2), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(ContStateData%element) -ENDIF - END SUBROUTINE UA_DestroyContState +subroutine UA_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(UA_ContinuousStateType), intent(in) :: SrcContStateData + type(UA_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'UA_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcContStateData%element)) then + LB(1:2) = lbound(SrcContStateData%element) + UB(1:2) = ubound(SrcContStateData%element) + if (.not. allocated(DstContStateData%element)) then + allocate(DstContStateData%element(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%element.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call UA_CopyElementContinuousStateType(SrcContStateData%element(i1,i2), DstContStateData%element(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + else if (allocated(DstContStateData%element)) then + deallocate(DstContStateData%element) + end if +end subroutine +subroutine UA_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(UA_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'UA_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ContStateData%element)) then + LB(1:2) = lbound(ContStateData%element) + UB(1:2) = ubound(ContStateData%element) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call UA_DestroyElementContinuousStateType(ContStateData%element(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(ContStateData%element) + end if +end subroutine subroutine UA_PackContState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -1128,7 +956,6 @@ subroutine UA_PackContState(Buf, Indata) integer(IntKi) :: i1, i2 integer(IntKi) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return - ! element call RegPack(Buf, allocated(InData%element)) if (allocated(InData%element)) then call RegPackBounds(Buf, 2, lbound(InData%element), ubound(InData%element)) @@ -1152,7 +979,6 @@ subroutine UA_UnPackContState(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! element if (allocated(OutData%element)) deallocate(OutData%element) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1171,855 +997,810 @@ subroutine UA_UnPackContState(Buf, OutData) end do end if end subroutine - SUBROUTINE UA_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(UA_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(UA_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcDiscStateData%alpha_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%alpha_minus1,1) - i1_u = UBOUND(SrcDiscStateData%alpha_minus1,1) - i2_l = LBOUND(SrcDiscStateData%alpha_minus1,2) - i2_u = UBOUND(SrcDiscStateData%alpha_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%alpha_minus1)) THEN - ALLOCATE(DstDiscStateData%alpha_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%alpha_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%alpha_minus1 = SrcDiscStateData%alpha_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%alpha_filt_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%alpha_filt_minus1,1) - i1_u = UBOUND(SrcDiscStateData%alpha_filt_minus1,1) - i2_l = LBOUND(SrcDiscStateData%alpha_filt_minus1,2) - i2_u = UBOUND(SrcDiscStateData%alpha_filt_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%alpha_filt_minus1)) THEN - ALLOCATE(DstDiscStateData%alpha_filt_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%alpha_filt_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%alpha_filt_minus1 = SrcDiscStateData%alpha_filt_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%alpha_dot)) THEN - i1_l = LBOUND(SrcDiscStateData%alpha_dot,1) - i1_u = UBOUND(SrcDiscStateData%alpha_dot,1) - i2_l = LBOUND(SrcDiscStateData%alpha_dot,2) - i2_u = UBOUND(SrcDiscStateData%alpha_dot,2) - IF (.NOT. ALLOCATED(DstDiscStateData%alpha_dot)) THEN - ALLOCATE(DstDiscStateData%alpha_dot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%alpha_dot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%alpha_dot = SrcDiscStateData%alpha_dot -ENDIF -IF (ALLOCATED(SrcDiscStateData%alpha_dot_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%alpha_dot_minus1,1) - i1_u = UBOUND(SrcDiscStateData%alpha_dot_minus1,1) - i2_l = LBOUND(SrcDiscStateData%alpha_dot_minus1,2) - i2_u = UBOUND(SrcDiscStateData%alpha_dot_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%alpha_dot_minus1)) THEN - ALLOCATE(DstDiscStateData%alpha_dot_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%alpha_dot_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%alpha_dot_minus1 = SrcDiscStateData%alpha_dot_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%q_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%q_minus1,1) - i1_u = UBOUND(SrcDiscStateData%q_minus1,1) - i2_l = LBOUND(SrcDiscStateData%q_minus1,2) - i2_u = UBOUND(SrcDiscStateData%q_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%q_minus1)) THEN - ALLOCATE(DstDiscStateData%q_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%q_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%q_minus1 = SrcDiscStateData%q_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%Kalpha_f_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%Kalpha_f_minus1,1) - i1_u = UBOUND(SrcDiscStateData%Kalpha_f_minus1,1) - i2_l = LBOUND(SrcDiscStateData%Kalpha_f_minus1,2) - i2_u = UBOUND(SrcDiscStateData%Kalpha_f_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%Kalpha_f_minus1)) THEN - ALLOCATE(DstDiscStateData%Kalpha_f_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Kalpha_f_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Kalpha_f_minus1 = SrcDiscStateData%Kalpha_f_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%Kq_f_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%Kq_f_minus1,1) - i1_u = UBOUND(SrcDiscStateData%Kq_f_minus1,1) - i2_l = LBOUND(SrcDiscStateData%Kq_f_minus1,2) - i2_u = UBOUND(SrcDiscStateData%Kq_f_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%Kq_f_minus1)) THEN - ALLOCATE(DstDiscStateData%Kq_f_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Kq_f_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Kq_f_minus1 = SrcDiscStateData%Kq_f_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%q_f_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%q_f_minus1,1) - i1_u = UBOUND(SrcDiscStateData%q_f_minus1,1) - i2_l = LBOUND(SrcDiscStateData%q_f_minus1,2) - i2_u = UBOUND(SrcDiscStateData%q_f_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%q_f_minus1)) THEN - ALLOCATE(DstDiscStateData%q_f_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%q_f_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%q_f_minus1 = SrcDiscStateData%q_f_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%X1_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%X1_minus1,1) - i1_u = UBOUND(SrcDiscStateData%X1_minus1,1) - i2_l = LBOUND(SrcDiscStateData%X1_minus1,2) - i2_u = UBOUND(SrcDiscStateData%X1_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%X1_minus1)) THEN - ALLOCATE(DstDiscStateData%X1_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%X1_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%X1_minus1 = SrcDiscStateData%X1_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%X2_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%X2_minus1,1) - i1_u = UBOUND(SrcDiscStateData%X2_minus1,1) - i2_l = LBOUND(SrcDiscStateData%X2_minus1,2) - i2_u = UBOUND(SrcDiscStateData%X2_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%X2_minus1)) THEN - ALLOCATE(DstDiscStateData%X2_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%X2_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%X2_minus1 = SrcDiscStateData%X2_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%X3_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%X3_minus1,1) - i1_u = UBOUND(SrcDiscStateData%X3_minus1,1) - i2_l = LBOUND(SrcDiscStateData%X3_minus1,2) - i2_u = UBOUND(SrcDiscStateData%X3_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%X3_minus1)) THEN - ALLOCATE(DstDiscStateData%X3_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%X3_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%X3_minus1 = SrcDiscStateData%X3_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%X4_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%X4_minus1,1) - i1_u = UBOUND(SrcDiscStateData%X4_minus1,1) - i2_l = LBOUND(SrcDiscStateData%X4_minus1,2) - i2_u = UBOUND(SrcDiscStateData%X4_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%X4_minus1)) THEN - ALLOCATE(DstDiscStateData%X4_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%X4_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%X4_minus1 = SrcDiscStateData%X4_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%Kprime_alpha_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%Kprime_alpha_minus1,1) - i1_u = UBOUND(SrcDiscStateData%Kprime_alpha_minus1,1) - i2_l = LBOUND(SrcDiscStateData%Kprime_alpha_minus1,2) - i2_u = UBOUND(SrcDiscStateData%Kprime_alpha_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%Kprime_alpha_minus1)) THEN - ALLOCATE(DstDiscStateData%Kprime_alpha_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Kprime_alpha_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Kprime_alpha_minus1 = SrcDiscStateData%Kprime_alpha_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%Kprime_q_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%Kprime_q_minus1,1) - i1_u = UBOUND(SrcDiscStateData%Kprime_q_minus1,1) - i2_l = LBOUND(SrcDiscStateData%Kprime_q_minus1,2) - i2_u = UBOUND(SrcDiscStateData%Kprime_q_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%Kprime_q_minus1)) THEN - ALLOCATE(DstDiscStateData%Kprime_q_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Kprime_q_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Kprime_q_minus1 = SrcDiscStateData%Kprime_q_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%Kprimeprime_q_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%Kprimeprime_q_minus1,1) - i1_u = UBOUND(SrcDiscStateData%Kprimeprime_q_minus1,1) - i2_l = LBOUND(SrcDiscStateData%Kprimeprime_q_minus1,2) - i2_u = UBOUND(SrcDiscStateData%Kprimeprime_q_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%Kprimeprime_q_minus1)) THEN - ALLOCATE(DstDiscStateData%Kprimeprime_q_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Kprimeprime_q_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Kprimeprime_q_minus1 = SrcDiscStateData%Kprimeprime_q_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%K3prime_q_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%K3prime_q_minus1,1) - i1_u = UBOUND(SrcDiscStateData%K3prime_q_minus1,1) - i2_l = LBOUND(SrcDiscStateData%K3prime_q_minus1,2) - i2_u = UBOUND(SrcDiscStateData%K3prime_q_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%K3prime_q_minus1)) THEN - ALLOCATE(DstDiscStateData%K3prime_q_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%K3prime_q_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%K3prime_q_minus1 = SrcDiscStateData%K3prime_q_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%Dp_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%Dp_minus1,1) - i1_u = UBOUND(SrcDiscStateData%Dp_minus1,1) - i2_l = LBOUND(SrcDiscStateData%Dp_minus1,2) - i2_u = UBOUND(SrcDiscStateData%Dp_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%Dp_minus1)) THEN - ALLOCATE(DstDiscStateData%Dp_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Dp_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Dp_minus1 = SrcDiscStateData%Dp_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%Cn_pot_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%Cn_pot_minus1,1) - i1_u = UBOUND(SrcDiscStateData%Cn_pot_minus1,1) - i2_l = LBOUND(SrcDiscStateData%Cn_pot_minus1,2) - i2_u = UBOUND(SrcDiscStateData%Cn_pot_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%Cn_pot_minus1)) THEN - ALLOCATE(DstDiscStateData%Cn_pot_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Cn_pot_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Cn_pot_minus1 = SrcDiscStateData%Cn_pot_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%fprimeprime_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%fprimeprime_minus1,1) - i1_u = UBOUND(SrcDiscStateData%fprimeprime_minus1,1) - i2_l = LBOUND(SrcDiscStateData%fprimeprime_minus1,2) - i2_u = UBOUND(SrcDiscStateData%fprimeprime_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%fprimeprime_minus1)) THEN - ALLOCATE(DstDiscStateData%fprimeprime_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%fprimeprime_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%fprimeprime_minus1 = SrcDiscStateData%fprimeprime_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%fprimeprime_c_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%fprimeprime_c_minus1,1) - i1_u = UBOUND(SrcDiscStateData%fprimeprime_c_minus1,1) - i2_l = LBOUND(SrcDiscStateData%fprimeprime_c_minus1,2) - i2_u = UBOUND(SrcDiscStateData%fprimeprime_c_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%fprimeprime_c_minus1)) THEN - ALLOCATE(DstDiscStateData%fprimeprime_c_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%fprimeprime_c_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%fprimeprime_c_minus1 = SrcDiscStateData%fprimeprime_c_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%fprimeprime_m_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%fprimeprime_m_minus1,1) - i1_u = UBOUND(SrcDiscStateData%fprimeprime_m_minus1,1) - i2_l = LBOUND(SrcDiscStateData%fprimeprime_m_minus1,2) - i2_u = UBOUND(SrcDiscStateData%fprimeprime_m_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%fprimeprime_m_minus1)) THEN - ALLOCATE(DstDiscStateData%fprimeprime_m_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%fprimeprime_m_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%fprimeprime_m_minus1 = SrcDiscStateData%fprimeprime_m_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%Df_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%Df_minus1,1) - i1_u = UBOUND(SrcDiscStateData%Df_minus1,1) - i2_l = LBOUND(SrcDiscStateData%Df_minus1,2) - i2_u = UBOUND(SrcDiscStateData%Df_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%Df_minus1)) THEN - ALLOCATE(DstDiscStateData%Df_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Df_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Df_minus1 = SrcDiscStateData%Df_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%Df_c_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%Df_c_minus1,1) - i1_u = UBOUND(SrcDiscStateData%Df_c_minus1,1) - i2_l = LBOUND(SrcDiscStateData%Df_c_minus1,2) - i2_u = UBOUND(SrcDiscStateData%Df_c_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%Df_c_minus1)) THEN - ALLOCATE(DstDiscStateData%Df_c_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Df_c_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Df_c_minus1 = SrcDiscStateData%Df_c_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%Df_m_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%Df_m_minus1,1) - i1_u = UBOUND(SrcDiscStateData%Df_m_minus1,1) - i2_l = LBOUND(SrcDiscStateData%Df_m_minus1,2) - i2_u = UBOUND(SrcDiscStateData%Df_m_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%Df_m_minus1)) THEN - ALLOCATE(DstDiscStateData%Df_m_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Df_m_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Df_m_minus1 = SrcDiscStateData%Df_m_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%Dalphaf_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%Dalphaf_minus1,1) - i1_u = UBOUND(SrcDiscStateData%Dalphaf_minus1,1) - i2_l = LBOUND(SrcDiscStateData%Dalphaf_minus1,2) - i2_u = UBOUND(SrcDiscStateData%Dalphaf_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%Dalphaf_minus1)) THEN - ALLOCATE(DstDiscStateData%Dalphaf_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Dalphaf_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Dalphaf_minus1 = SrcDiscStateData%Dalphaf_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%alphaf_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%alphaf_minus1,1) - i1_u = UBOUND(SrcDiscStateData%alphaf_minus1,1) - i2_l = LBOUND(SrcDiscStateData%alphaf_minus1,2) - i2_u = UBOUND(SrcDiscStateData%alphaf_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%alphaf_minus1)) THEN - ALLOCATE(DstDiscStateData%alphaf_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%alphaf_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%alphaf_minus1 = SrcDiscStateData%alphaf_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%fprime_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%fprime_minus1,1) - i1_u = UBOUND(SrcDiscStateData%fprime_minus1,1) - i2_l = LBOUND(SrcDiscStateData%fprime_minus1,2) - i2_u = UBOUND(SrcDiscStateData%fprime_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%fprime_minus1)) THEN - ALLOCATE(DstDiscStateData%fprime_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%fprime_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%fprime_minus1 = SrcDiscStateData%fprime_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%fprime_c_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%fprime_c_minus1,1) - i1_u = UBOUND(SrcDiscStateData%fprime_c_minus1,1) - i2_l = LBOUND(SrcDiscStateData%fprime_c_minus1,2) - i2_u = UBOUND(SrcDiscStateData%fprime_c_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%fprime_c_minus1)) THEN - ALLOCATE(DstDiscStateData%fprime_c_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%fprime_c_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%fprime_c_minus1 = SrcDiscStateData%fprime_c_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%fprime_m_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%fprime_m_minus1,1) - i1_u = UBOUND(SrcDiscStateData%fprime_m_minus1,1) - i2_l = LBOUND(SrcDiscStateData%fprime_m_minus1,2) - i2_u = UBOUND(SrcDiscStateData%fprime_m_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%fprime_m_minus1)) THEN - ALLOCATE(DstDiscStateData%fprime_m_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%fprime_m_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%fprime_m_minus1 = SrcDiscStateData%fprime_m_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%tau_V)) THEN - i1_l = LBOUND(SrcDiscStateData%tau_V,1) - i1_u = UBOUND(SrcDiscStateData%tau_V,1) - i2_l = LBOUND(SrcDiscStateData%tau_V,2) - i2_u = UBOUND(SrcDiscStateData%tau_V,2) - IF (.NOT. ALLOCATED(DstDiscStateData%tau_V)) THEN - ALLOCATE(DstDiscStateData%tau_V(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%tau_V.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%tau_V = SrcDiscStateData%tau_V -ENDIF -IF (ALLOCATED(SrcDiscStateData%tau_V_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%tau_V_minus1,1) - i1_u = UBOUND(SrcDiscStateData%tau_V_minus1,1) - i2_l = LBOUND(SrcDiscStateData%tau_V_minus1,2) - i2_u = UBOUND(SrcDiscStateData%tau_V_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%tau_V_minus1)) THEN - ALLOCATE(DstDiscStateData%tau_V_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%tau_V_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%tau_V_minus1 = SrcDiscStateData%tau_V_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%Cn_v_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%Cn_v_minus1,1) - i1_u = UBOUND(SrcDiscStateData%Cn_v_minus1,1) - i2_l = LBOUND(SrcDiscStateData%Cn_v_minus1,2) - i2_u = UBOUND(SrcDiscStateData%Cn_v_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%Cn_v_minus1)) THEN - ALLOCATE(DstDiscStateData%Cn_v_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Cn_v_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Cn_v_minus1 = SrcDiscStateData%Cn_v_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%C_V_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%C_V_minus1,1) - i1_u = UBOUND(SrcDiscStateData%C_V_minus1,1) - i2_l = LBOUND(SrcDiscStateData%C_V_minus1,2) - i2_u = UBOUND(SrcDiscStateData%C_V_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%C_V_minus1)) THEN - ALLOCATE(DstDiscStateData%C_V_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%C_V_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%C_V_minus1 = SrcDiscStateData%C_V_minus1 -ENDIF -IF (ALLOCATED(SrcDiscStateData%Cn_prime_minus1)) THEN - i1_l = LBOUND(SrcDiscStateData%Cn_prime_minus1,1) - i1_u = UBOUND(SrcDiscStateData%Cn_prime_minus1,1) - i2_l = LBOUND(SrcDiscStateData%Cn_prime_minus1,2) - i2_u = UBOUND(SrcDiscStateData%Cn_prime_minus1,2) - IF (.NOT. ALLOCATED(DstDiscStateData%Cn_prime_minus1)) THEN - ALLOCATE(DstDiscStateData%Cn_prime_minus1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Cn_prime_minus1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Cn_prime_minus1 = SrcDiscStateData%Cn_prime_minus1 -ENDIF - END SUBROUTINE UA_CopyDiscState - - SUBROUTINE UA_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(UA_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyDiscState' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(DiscStateData%alpha_minus1)) THEN - DEALLOCATE(DiscStateData%alpha_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%alpha_filt_minus1)) THEN - DEALLOCATE(DiscStateData%alpha_filt_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%alpha_dot)) THEN - DEALLOCATE(DiscStateData%alpha_dot) -ENDIF -IF (ALLOCATED(DiscStateData%alpha_dot_minus1)) THEN - DEALLOCATE(DiscStateData%alpha_dot_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%q_minus1)) THEN - DEALLOCATE(DiscStateData%q_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%Kalpha_f_minus1)) THEN - DEALLOCATE(DiscStateData%Kalpha_f_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%Kq_f_minus1)) THEN - DEALLOCATE(DiscStateData%Kq_f_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%q_f_minus1)) THEN - DEALLOCATE(DiscStateData%q_f_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%X1_minus1)) THEN - DEALLOCATE(DiscStateData%X1_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%X2_minus1)) THEN - DEALLOCATE(DiscStateData%X2_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%X3_minus1)) THEN - DEALLOCATE(DiscStateData%X3_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%X4_minus1)) THEN - DEALLOCATE(DiscStateData%X4_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%Kprime_alpha_minus1)) THEN - DEALLOCATE(DiscStateData%Kprime_alpha_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%Kprime_q_minus1)) THEN - DEALLOCATE(DiscStateData%Kprime_q_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%Kprimeprime_q_minus1)) THEN - DEALLOCATE(DiscStateData%Kprimeprime_q_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%K3prime_q_minus1)) THEN - DEALLOCATE(DiscStateData%K3prime_q_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%Dp_minus1)) THEN - DEALLOCATE(DiscStateData%Dp_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%Cn_pot_minus1)) THEN - DEALLOCATE(DiscStateData%Cn_pot_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%fprimeprime_minus1)) THEN - DEALLOCATE(DiscStateData%fprimeprime_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%fprimeprime_c_minus1)) THEN - DEALLOCATE(DiscStateData%fprimeprime_c_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%fprimeprime_m_minus1)) THEN - DEALLOCATE(DiscStateData%fprimeprime_m_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%Df_minus1)) THEN - DEALLOCATE(DiscStateData%Df_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%Df_c_minus1)) THEN - DEALLOCATE(DiscStateData%Df_c_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%Df_m_minus1)) THEN - DEALLOCATE(DiscStateData%Df_m_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%Dalphaf_minus1)) THEN - DEALLOCATE(DiscStateData%Dalphaf_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%alphaf_minus1)) THEN - DEALLOCATE(DiscStateData%alphaf_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%fprime_minus1)) THEN - DEALLOCATE(DiscStateData%fprime_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%fprime_c_minus1)) THEN - DEALLOCATE(DiscStateData%fprime_c_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%fprime_m_minus1)) THEN - DEALLOCATE(DiscStateData%fprime_m_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%tau_V)) THEN - DEALLOCATE(DiscStateData%tau_V) -ENDIF -IF (ALLOCATED(DiscStateData%tau_V_minus1)) THEN - DEALLOCATE(DiscStateData%tau_V_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%Cn_v_minus1)) THEN - DEALLOCATE(DiscStateData%Cn_v_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%C_V_minus1)) THEN - DEALLOCATE(DiscStateData%C_V_minus1) -ENDIF -IF (ALLOCATED(DiscStateData%Cn_prime_minus1)) THEN - DEALLOCATE(DiscStateData%Cn_prime_minus1) -ENDIF - END SUBROUTINE UA_DestroyDiscState +subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(UA_DiscreteStateType), intent(in) :: SrcDiscStateData + type(UA_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'UA_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcDiscStateData%alpha_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%alpha_minus1) + UB(1:2) = ubound(SrcDiscStateData%alpha_minus1) + if (.not. allocated(DstDiscStateData%alpha_minus1)) then + allocate(DstDiscStateData%alpha_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%alpha_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%alpha_minus1 = SrcDiscStateData%alpha_minus1 + else if (allocated(DstDiscStateData%alpha_minus1)) then + deallocate(DstDiscStateData%alpha_minus1) + end if + if (allocated(SrcDiscStateData%alpha_filt_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%alpha_filt_minus1) + UB(1:2) = ubound(SrcDiscStateData%alpha_filt_minus1) + if (.not. allocated(DstDiscStateData%alpha_filt_minus1)) then + allocate(DstDiscStateData%alpha_filt_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%alpha_filt_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%alpha_filt_minus1 = SrcDiscStateData%alpha_filt_minus1 + else if (allocated(DstDiscStateData%alpha_filt_minus1)) then + deallocate(DstDiscStateData%alpha_filt_minus1) + end if + if (allocated(SrcDiscStateData%alpha_dot)) then + LB(1:2) = lbound(SrcDiscStateData%alpha_dot) + UB(1:2) = ubound(SrcDiscStateData%alpha_dot) + if (.not. allocated(DstDiscStateData%alpha_dot)) then + allocate(DstDiscStateData%alpha_dot(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%alpha_dot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%alpha_dot = SrcDiscStateData%alpha_dot + else if (allocated(DstDiscStateData%alpha_dot)) then + deallocate(DstDiscStateData%alpha_dot) + end if + if (allocated(SrcDiscStateData%alpha_dot_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%alpha_dot_minus1) + UB(1:2) = ubound(SrcDiscStateData%alpha_dot_minus1) + if (.not. allocated(DstDiscStateData%alpha_dot_minus1)) then + allocate(DstDiscStateData%alpha_dot_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%alpha_dot_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%alpha_dot_minus1 = SrcDiscStateData%alpha_dot_minus1 + else if (allocated(DstDiscStateData%alpha_dot_minus1)) then + deallocate(DstDiscStateData%alpha_dot_minus1) + end if + if (allocated(SrcDiscStateData%q_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%q_minus1) + UB(1:2) = ubound(SrcDiscStateData%q_minus1) + if (.not. allocated(DstDiscStateData%q_minus1)) then + allocate(DstDiscStateData%q_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%q_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%q_minus1 = SrcDiscStateData%q_minus1 + else if (allocated(DstDiscStateData%q_minus1)) then + deallocate(DstDiscStateData%q_minus1) + end if + if (allocated(SrcDiscStateData%Kalpha_f_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%Kalpha_f_minus1) + UB(1:2) = ubound(SrcDiscStateData%Kalpha_f_minus1) + if (.not. allocated(DstDiscStateData%Kalpha_f_minus1)) then + allocate(DstDiscStateData%Kalpha_f_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Kalpha_f_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Kalpha_f_minus1 = SrcDiscStateData%Kalpha_f_minus1 + else if (allocated(DstDiscStateData%Kalpha_f_minus1)) then + deallocate(DstDiscStateData%Kalpha_f_minus1) + end if + if (allocated(SrcDiscStateData%Kq_f_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%Kq_f_minus1) + UB(1:2) = ubound(SrcDiscStateData%Kq_f_minus1) + if (.not. allocated(DstDiscStateData%Kq_f_minus1)) then + allocate(DstDiscStateData%Kq_f_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Kq_f_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Kq_f_minus1 = SrcDiscStateData%Kq_f_minus1 + else if (allocated(DstDiscStateData%Kq_f_minus1)) then + deallocate(DstDiscStateData%Kq_f_minus1) + end if + if (allocated(SrcDiscStateData%q_f_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%q_f_minus1) + UB(1:2) = ubound(SrcDiscStateData%q_f_minus1) + if (.not. allocated(DstDiscStateData%q_f_minus1)) then + allocate(DstDiscStateData%q_f_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%q_f_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%q_f_minus1 = SrcDiscStateData%q_f_minus1 + else if (allocated(DstDiscStateData%q_f_minus1)) then + deallocate(DstDiscStateData%q_f_minus1) + end if + if (allocated(SrcDiscStateData%X1_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%X1_minus1) + UB(1:2) = ubound(SrcDiscStateData%X1_minus1) + if (.not. allocated(DstDiscStateData%X1_minus1)) then + allocate(DstDiscStateData%X1_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%X1_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%X1_minus1 = SrcDiscStateData%X1_minus1 + else if (allocated(DstDiscStateData%X1_minus1)) then + deallocate(DstDiscStateData%X1_minus1) + end if + if (allocated(SrcDiscStateData%X2_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%X2_minus1) + UB(1:2) = ubound(SrcDiscStateData%X2_minus1) + if (.not. allocated(DstDiscStateData%X2_minus1)) then + allocate(DstDiscStateData%X2_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%X2_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%X2_minus1 = SrcDiscStateData%X2_minus1 + else if (allocated(DstDiscStateData%X2_minus1)) then + deallocate(DstDiscStateData%X2_minus1) + end if + if (allocated(SrcDiscStateData%X3_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%X3_minus1) + UB(1:2) = ubound(SrcDiscStateData%X3_minus1) + if (.not. allocated(DstDiscStateData%X3_minus1)) then + allocate(DstDiscStateData%X3_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%X3_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%X3_minus1 = SrcDiscStateData%X3_minus1 + else if (allocated(DstDiscStateData%X3_minus1)) then + deallocate(DstDiscStateData%X3_minus1) + end if + if (allocated(SrcDiscStateData%X4_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%X4_minus1) + UB(1:2) = ubound(SrcDiscStateData%X4_minus1) + if (.not. allocated(DstDiscStateData%X4_minus1)) then + allocate(DstDiscStateData%X4_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%X4_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%X4_minus1 = SrcDiscStateData%X4_minus1 + else if (allocated(DstDiscStateData%X4_minus1)) then + deallocate(DstDiscStateData%X4_minus1) + end if + if (allocated(SrcDiscStateData%Kprime_alpha_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%Kprime_alpha_minus1) + UB(1:2) = ubound(SrcDiscStateData%Kprime_alpha_minus1) + if (.not. allocated(DstDiscStateData%Kprime_alpha_minus1)) then + allocate(DstDiscStateData%Kprime_alpha_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Kprime_alpha_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Kprime_alpha_minus1 = SrcDiscStateData%Kprime_alpha_minus1 + else if (allocated(DstDiscStateData%Kprime_alpha_minus1)) then + deallocate(DstDiscStateData%Kprime_alpha_minus1) + end if + if (allocated(SrcDiscStateData%Kprime_q_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%Kprime_q_minus1) + UB(1:2) = ubound(SrcDiscStateData%Kprime_q_minus1) + if (.not. allocated(DstDiscStateData%Kprime_q_minus1)) then + allocate(DstDiscStateData%Kprime_q_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Kprime_q_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Kprime_q_minus1 = SrcDiscStateData%Kprime_q_minus1 + else if (allocated(DstDiscStateData%Kprime_q_minus1)) then + deallocate(DstDiscStateData%Kprime_q_minus1) + end if + if (allocated(SrcDiscStateData%Kprimeprime_q_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%Kprimeprime_q_minus1) + UB(1:2) = ubound(SrcDiscStateData%Kprimeprime_q_minus1) + if (.not. allocated(DstDiscStateData%Kprimeprime_q_minus1)) then + allocate(DstDiscStateData%Kprimeprime_q_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Kprimeprime_q_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Kprimeprime_q_minus1 = SrcDiscStateData%Kprimeprime_q_minus1 + else if (allocated(DstDiscStateData%Kprimeprime_q_minus1)) then + deallocate(DstDiscStateData%Kprimeprime_q_minus1) + end if + if (allocated(SrcDiscStateData%K3prime_q_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%K3prime_q_minus1) + UB(1:2) = ubound(SrcDiscStateData%K3prime_q_minus1) + if (.not. allocated(DstDiscStateData%K3prime_q_minus1)) then + allocate(DstDiscStateData%K3prime_q_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%K3prime_q_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%K3prime_q_minus1 = SrcDiscStateData%K3prime_q_minus1 + else if (allocated(DstDiscStateData%K3prime_q_minus1)) then + deallocate(DstDiscStateData%K3prime_q_minus1) + end if + if (allocated(SrcDiscStateData%Dp_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%Dp_minus1) + UB(1:2) = ubound(SrcDiscStateData%Dp_minus1) + if (.not. allocated(DstDiscStateData%Dp_minus1)) then + allocate(DstDiscStateData%Dp_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Dp_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Dp_minus1 = SrcDiscStateData%Dp_minus1 + else if (allocated(DstDiscStateData%Dp_minus1)) then + deallocate(DstDiscStateData%Dp_minus1) + end if + if (allocated(SrcDiscStateData%Cn_pot_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%Cn_pot_minus1) + UB(1:2) = ubound(SrcDiscStateData%Cn_pot_minus1) + if (.not. allocated(DstDiscStateData%Cn_pot_minus1)) then + allocate(DstDiscStateData%Cn_pot_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Cn_pot_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Cn_pot_minus1 = SrcDiscStateData%Cn_pot_minus1 + else if (allocated(DstDiscStateData%Cn_pot_minus1)) then + deallocate(DstDiscStateData%Cn_pot_minus1) + end if + if (allocated(SrcDiscStateData%fprimeprime_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%fprimeprime_minus1) + UB(1:2) = ubound(SrcDiscStateData%fprimeprime_minus1) + if (.not. allocated(DstDiscStateData%fprimeprime_minus1)) then + allocate(DstDiscStateData%fprimeprime_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%fprimeprime_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%fprimeprime_minus1 = SrcDiscStateData%fprimeprime_minus1 + else if (allocated(DstDiscStateData%fprimeprime_minus1)) then + deallocate(DstDiscStateData%fprimeprime_minus1) + end if + if (allocated(SrcDiscStateData%fprimeprime_c_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%fprimeprime_c_minus1) + UB(1:2) = ubound(SrcDiscStateData%fprimeprime_c_minus1) + if (.not. allocated(DstDiscStateData%fprimeprime_c_minus1)) then + allocate(DstDiscStateData%fprimeprime_c_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%fprimeprime_c_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%fprimeprime_c_minus1 = SrcDiscStateData%fprimeprime_c_minus1 + else if (allocated(DstDiscStateData%fprimeprime_c_minus1)) then + deallocate(DstDiscStateData%fprimeprime_c_minus1) + end if + if (allocated(SrcDiscStateData%fprimeprime_m_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%fprimeprime_m_minus1) + UB(1:2) = ubound(SrcDiscStateData%fprimeprime_m_minus1) + if (.not. allocated(DstDiscStateData%fprimeprime_m_minus1)) then + allocate(DstDiscStateData%fprimeprime_m_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%fprimeprime_m_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%fprimeprime_m_minus1 = SrcDiscStateData%fprimeprime_m_minus1 + else if (allocated(DstDiscStateData%fprimeprime_m_minus1)) then + deallocate(DstDiscStateData%fprimeprime_m_minus1) + end if + if (allocated(SrcDiscStateData%Df_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%Df_minus1) + UB(1:2) = ubound(SrcDiscStateData%Df_minus1) + if (.not. allocated(DstDiscStateData%Df_minus1)) then + allocate(DstDiscStateData%Df_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Df_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Df_minus1 = SrcDiscStateData%Df_minus1 + else if (allocated(DstDiscStateData%Df_minus1)) then + deallocate(DstDiscStateData%Df_minus1) + end if + if (allocated(SrcDiscStateData%Df_c_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%Df_c_minus1) + UB(1:2) = ubound(SrcDiscStateData%Df_c_minus1) + if (.not. allocated(DstDiscStateData%Df_c_minus1)) then + allocate(DstDiscStateData%Df_c_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Df_c_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Df_c_minus1 = SrcDiscStateData%Df_c_minus1 + else if (allocated(DstDiscStateData%Df_c_minus1)) then + deallocate(DstDiscStateData%Df_c_minus1) + end if + if (allocated(SrcDiscStateData%Df_m_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%Df_m_minus1) + UB(1:2) = ubound(SrcDiscStateData%Df_m_minus1) + if (.not. allocated(DstDiscStateData%Df_m_minus1)) then + allocate(DstDiscStateData%Df_m_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Df_m_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Df_m_minus1 = SrcDiscStateData%Df_m_minus1 + else if (allocated(DstDiscStateData%Df_m_minus1)) then + deallocate(DstDiscStateData%Df_m_minus1) + end if + if (allocated(SrcDiscStateData%Dalphaf_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%Dalphaf_minus1) + UB(1:2) = ubound(SrcDiscStateData%Dalphaf_minus1) + if (.not. allocated(DstDiscStateData%Dalphaf_minus1)) then + allocate(DstDiscStateData%Dalphaf_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Dalphaf_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Dalphaf_minus1 = SrcDiscStateData%Dalphaf_minus1 + else if (allocated(DstDiscStateData%Dalphaf_minus1)) then + deallocate(DstDiscStateData%Dalphaf_minus1) + end if + if (allocated(SrcDiscStateData%alphaf_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%alphaf_minus1) + UB(1:2) = ubound(SrcDiscStateData%alphaf_minus1) + if (.not. allocated(DstDiscStateData%alphaf_minus1)) then + allocate(DstDiscStateData%alphaf_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%alphaf_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%alphaf_minus1 = SrcDiscStateData%alphaf_minus1 + else if (allocated(DstDiscStateData%alphaf_minus1)) then + deallocate(DstDiscStateData%alphaf_minus1) + end if + if (allocated(SrcDiscStateData%fprime_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%fprime_minus1) + UB(1:2) = ubound(SrcDiscStateData%fprime_minus1) + if (.not. allocated(DstDiscStateData%fprime_minus1)) then + allocate(DstDiscStateData%fprime_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%fprime_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%fprime_minus1 = SrcDiscStateData%fprime_minus1 + else if (allocated(DstDiscStateData%fprime_minus1)) then + deallocate(DstDiscStateData%fprime_minus1) + end if + if (allocated(SrcDiscStateData%fprime_c_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%fprime_c_minus1) + UB(1:2) = ubound(SrcDiscStateData%fprime_c_minus1) + if (.not. allocated(DstDiscStateData%fprime_c_minus1)) then + allocate(DstDiscStateData%fprime_c_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%fprime_c_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%fprime_c_minus1 = SrcDiscStateData%fprime_c_minus1 + else if (allocated(DstDiscStateData%fprime_c_minus1)) then + deallocate(DstDiscStateData%fprime_c_minus1) + end if + if (allocated(SrcDiscStateData%fprime_m_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%fprime_m_minus1) + UB(1:2) = ubound(SrcDiscStateData%fprime_m_minus1) + if (.not. allocated(DstDiscStateData%fprime_m_minus1)) then + allocate(DstDiscStateData%fprime_m_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%fprime_m_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%fprime_m_minus1 = SrcDiscStateData%fprime_m_minus1 + else if (allocated(DstDiscStateData%fprime_m_minus1)) then + deallocate(DstDiscStateData%fprime_m_minus1) + end if + if (allocated(SrcDiscStateData%tau_V)) then + LB(1:2) = lbound(SrcDiscStateData%tau_V) + UB(1:2) = ubound(SrcDiscStateData%tau_V) + if (.not. allocated(DstDiscStateData%tau_V)) then + allocate(DstDiscStateData%tau_V(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%tau_V.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%tau_V = SrcDiscStateData%tau_V + else if (allocated(DstDiscStateData%tau_V)) then + deallocate(DstDiscStateData%tau_V) + end if + if (allocated(SrcDiscStateData%tau_V_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%tau_V_minus1) + UB(1:2) = ubound(SrcDiscStateData%tau_V_minus1) + if (.not. allocated(DstDiscStateData%tau_V_minus1)) then + allocate(DstDiscStateData%tau_V_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%tau_V_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%tau_V_minus1 = SrcDiscStateData%tau_V_minus1 + else if (allocated(DstDiscStateData%tau_V_minus1)) then + deallocate(DstDiscStateData%tau_V_minus1) + end if + if (allocated(SrcDiscStateData%Cn_v_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%Cn_v_minus1) + UB(1:2) = ubound(SrcDiscStateData%Cn_v_minus1) + if (.not. allocated(DstDiscStateData%Cn_v_minus1)) then + allocate(DstDiscStateData%Cn_v_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Cn_v_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Cn_v_minus1 = SrcDiscStateData%Cn_v_minus1 + else if (allocated(DstDiscStateData%Cn_v_minus1)) then + deallocate(DstDiscStateData%Cn_v_minus1) + end if + if (allocated(SrcDiscStateData%C_V_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%C_V_minus1) + UB(1:2) = ubound(SrcDiscStateData%C_V_minus1) + if (.not. allocated(DstDiscStateData%C_V_minus1)) then + allocate(DstDiscStateData%C_V_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%C_V_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%C_V_minus1 = SrcDiscStateData%C_V_minus1 + else if (allocated(DstDiscStateData%C_V_minus1)) then + deallocate(DstDiscStateData%C_V_minus1) + end if + if (allocated(SrcDiscStateData%Cn_prime_minus1)) then + LB(1:2) = lbound(SrcDiscStateData%Cn_prime_minus1) + UB(1:2) = ubound(SrcDiscStateData%Cn_prime_minus1) + if (.not. allocated(DstDiscStateData%Cn_prime_minus1)) then + allocate(DstDiscStateData%Cn_prime_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Cn_prime_minus1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Cn_prime_minus1 = SrcDiscStateData%Cn_prime_minus1 + else if (allocated(DstDiscStateData%Cn_prime_minus1)) then + deallocate(DstDiscStateData%Cn_prime_minus1) + end if +end subroutine +subroutine UA_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(UA_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'UA_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(DiscStateData%alpha_minus1)) then + deallocate(DiscStateData%alpha_minus1) + end if + if (allocated(DiscStateData%alpha_filt_minus1)) then + deallocate(DiscStateData%alpha_filt_minus1) + end if + if (allocated(DiscStateData%alpha_dot)) then + deallocate(DiscStateData%alpha_dot) + end if + if (allocated(DiscStateData%alpha_dot_minus1)) then + deallocate(DiscStateData%alpha_dot_minus1) + end if + if (allocated(DiscStateData%q_minus1)) then + deallocate(DiscStateData%q_minus1) + end if + if (allocated(DiscStateData%Kalpha_f_minus1)) then + deallocate(DiscStateData%Kalpha_f_minus1) + end if + if (allocated(DiscStateData%Kq_f_minus1)) then + deallocate(DiscStateData%Kq_f_minus1) + end if + if (allocated(DiscStateData%q_f_minus1)) then + deallocate(DiscStateData%q_f_minus1) + end if + if (allocated(DiscStateData%X1_minus1)) then + deallocate(DiscStateData%X1_minus1) + end if + if (allocated(DiscStateData%X2_minus1)) then + deallocate(DiscStateData%X2_minus1) + end if + if (allocated(DiscStateData%X3_minus1)) then + deallocate(DiscStateData%X3_minus1) + end if + if (allocated(DiscStateData%X4_minus1)) then + deallocate(DiscStateData%X4_minus1) + end if + if (allocated(DiscStateData%Kprime_alpha_minus1)) then + deallocate(DiscStateData%Kprime_alpha_minus1) + end if + if (allocated(DiscStateData%Kprime_q_minus1)) then + deallocate(DiscStateData%Kprime_q_minus1) + end if + if (allocated(DiscStateData%Kprimeprime_q_minus1)) then + deallocate(DiscStateData%Kprimeprime_q_minus1) + end if + if (allocated(DiscStateData%K3prime_q_minus1)) then + deallocate(DiscStateData%K3prime_q_minus1) + end if + if (allocated(DiscStateData%Dp_minus1)) then + deallocate(DiscStateData%Dp_minus1) + end if + if (allocated(DiscStateData%Cn_pot_minus1)) then + deallocate(DiscStateData%Cn_pot_minus1) + end if + if (allocated(DiscStateData%fprimeprime_minus1)) then + deallocate(DiscStateData%fprimeprime_minus1) + end if + if (allocated(DiscStateData%fprimeprime_c_minus1)) then + deallocate(DiscStateData%fprimeprime_c_minus1) + end if + if (allocated(DiscStateData%fprimeprime_m_minus1)) then + deallocate(DiscStateData%fprimeprime_m_minus1) + end if + if (allocated(DiscStateData%Df_minus1)) then + deallocate(DiscStateData%Df_minus1) + end if + if (allocated(DiscStateData%Df_c_minus1)) then + deallocate(DiscStateData%Df_c_minus1) + end if + if (allocated(DiscStateData%Df_m_minus1)) then + deallocate(DiscStateData%Df_m_minus1) + end if + if (allocated(DiscStateData%Dalphaf_minus1)) then + deallocate(DiscStateData%Dalphaf_minus1) + end if + if (allocated(DiscStateData%alphaf_minus1)) then + deallocate(DiscStateData%alphaf_minus1) + end if + if (allocated(DiscStateData%fprime_minus1)) then + deallocate(DiscStateData%fprime_minus1) + end if + if (allocated(DiscStateData%fprime_c_minus1)) then + deallocate(DiscStateData%fprime_c_minus1) + end if + if (allocated(DiscStateData%fprime_m_minus1)) then + deallocate(DiscStateData%fprime_m_minus1) + end if + if (allocated(DiscStateData%tau_V)) then + deallocate(DiscStateData%tau_V) + end if + if (allocated(DiscStateData%tau_V_minus1)) then + deallocate(DiscStateData%tau_V_minus1) + end if + if (allocated(DiscStateData%Cn_v_minus1)) then + deallocate(DiscStateData%Cn_v_minus1) + end if + if (allocated(DiscStateData%C_V_minus1)) then + deallocate(DiscStateData%C_V_minus1) + end if + if (allocated(DiscStateData%Cn_prime_minus1)) then + deallocate(DiscStateData%Cn_prime_minus1) + end if +end subroutine subroutine UA_PackDiscState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(UA_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'UA_PackDiscState' if (Buf%ErrStat >= AbortErrLev) return - ! alpha_minus1 call RegPack(Buf, allocated(InData%alpha_minus1)) if (allocated(InData%alpha_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%alpha_minus1), ubound(InData%alpha_minus1)) call RegPack(Buf, InData%alpha_minus1) end if if (RegCheckErr(Buf, RoutineName)) return - ! alpha_filt_minus1 call RegPack(Buf, allocated(InData%alpha_filt_minus1)) if (allocated(InData%alpha_filt_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%alpha_filt_minus1), ubound(InData%alpha_filt_minus1)) call RegPack(Buf, InData%alpha_filt_minus1) end if if (RegCheckErr(Buf, RoutineName)) return - ! alpha_dot call RegPack(Buf, allocated(InData%alpha_dot)) if (allocated(InData%alpha_dot)) then call RegPackBounds(Buf, 2, lbound(InData%alpha_dot), ubound(InData%alpha_dot)) call RegPack(Buf, InData%alpha_dot) end if if (RegCheckErr(Buf, RoutineName)) return - ! alpha_dot_minus1 call RegPack(Buf, allocated(InData%alpha_dot_minus1)) if (allocated(InData%alpha_dot_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%alpha_dot_minus1), ubound(InData%alpha_dot_minus1)) call RegPack(Buf, InData%alpha_dot_minus1) end if if (RegCheckErr(Buf, RoutineName)) return - ! q_minus1 call RegPack(Buf, allocated(InData%q_minus1)) if (allocated(InData%q_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%q_minus1), ubound(InData%q_minus1)) call RegPack(Buf, InData%q_minus1) end if if (RegCheckErr(Buf, RoutineName)) return - ! Kalpha_f_minus1 call RegPack(Buf, allocated(InData%Kalpha_f_minus1)) if (allocated(InData%Kalpha_f_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%Kalpha_f_minus1), ubound(InData%Kalpha_f_minus1)) call RegPack(Buf, InData%Kalpha_f_minus1) end if if (RegCheckErr(Buf, RoutineName)) return - ! Kq_f_minus1 call RegPack(Buf, allocated(InData%Kq_f_minus1)) if (allocated(InData%Kq_f_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%Kq_f_minus1), ubound(InData%Kq_f_minus1)) call RegPack(Buf, InData%Kq_f_minus1) end if if (RegCheckErr(Buf, RoutineName)) return - ! q_f_minus1 call RegPack(Buf, allocated(InData%q_f_minus1)) if (allocated(InData%q_f_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%q_f_minus1), ubound(InData%q_f_minus1)) call RegPack(Buf, InData%q_f_minus1) end if if (RegCheckErr(Buf, RoutineName)) return - ! X1_minus1 call RegPack(Buf, allocated(InData%X1_minus1)) if (allocated(InData%X1_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%X1_minus1), ubound(InData%X1_minus1)) call RegPack(Buf, InData%X1_minus1) end if if (RegCheckErr(Buf, RoutineName)) return - ! X2_minus1 call RegPack(Buf, allocated(InData%X2_minus1)) if (allocated(InData%X2_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%X2_minus1), ubound(InData%X2_minus1)) call RegPack(Buf, InData%X2_minus1) end if if (RegCheckErr(Buf, RoutineName)) return - ! X3_minus1 call RegPack(Buf, allocated(InData%X3_minus1)) if (allocated(InData%X3_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%X3_minus1), ubound(InData%X3_minus1)) call RegPack(Buf, InData%X3_minus1) end if if (RegCheckErr(Buf, RoutineName)) return - ! X4_minus1 call RegPack(Buf, allocated(InData%X4_minus1)) if (allocated(InData%X4_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%X4_minus1), ubound(InData%X4_minus1)) call RegPack(Buf, InData%X4_minus1) end if if (RegCheckErr(Buf, RoutineName)) return - ! Kprime_alpha_minus1 call RegPack(Buf, allocated(InData%Kprime_alpha_minus1)) if (allocated(InData%Kprime_alpha_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%Kprime_alpha_minus1), ubound(InData%Kprime_alpha_minus1)) call RegPack(Buf, InData%Kprime_alpha_minus1) end if if (RegCheckErr(Buf, RoutineName)) return - ! Kprime_q_minus1 call RegPack(Buf, allocated(InData%Kprime_q_minus1)) if (allocated(InData%Kprime_q_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%Kprime_q_minus1), ubound(InData%Kprime_q_minus1)) call RegPack(Buf, InData%Kprime_q_minus1) end if if (RegCheckErr(Buf, RoutineName)) return - ! Kprimeprime_q_minus1 call RegPack(Buf, allocated(InData%Kprimeprime_q_minus1)) if (allocated(InData%Kprimeprime_q_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%Kprimeprime_q_minus1), ubound(InData%Kprimeprime_q_minus1)) call RegPack(Buf, InData%Kprimeprime_q_minus1) end if if (RegCheckErr(Buf, RoutineName)) return - ! K3prime_q_minus1 call RegPack(Buf, allocated(InData%K3prime_q_minus1)) if (allocated(InData%K3prime_q_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%K3prime_q_minus1), ubound(InData%K3prime_q_minus1)) call RegPack(Buf, InData%K3prime_q_minus1) end if if (RegCheckErr(Buf, RoutineName)) return - ! Dp_minus1 call RegPack(Buf, allocated(InData%Dp_minus1)) if (allocated(InData%Dp_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%Dp_minus1), ubound(InData%Dp_minus1)) call RegPack(Buf, InData%Dp_minus1) end if if (RegCheckErr(Buf, RoutineName)) return - ! Cn_pot_minus1 call RegPack(Buf, allocated(InData%Cn_pot_minus1)) if (allocated(InData%Cn_pot_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%Cn_pot_minus1), ubound(InData%Cn_pot_minus1)) call RegPack(Buf, InData%Cn_pot_minus1) end if if (RegCheckErr(Buf, RoutineName)) return - ! fprimeprime_minus1 call RegPack(Buf, allocated(InData%fprimeprime_minus1)) if (allocated(InData%fprimeprime_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%fprimeprime_minus1), ubound(InData%fprimeprime_minus1)) call RegPack(Buf, InData%fprimeprime_minus1) end if if (RegCheckErr(Buf, RoutineName)) return - ! fprimeprime_c_minus1 call RegPack(Buf, allocated(InData%fprimeprime_c_minus1)) if (allocated(InData%fprimeprime_c_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%fprimeprime_c_minus1), ubound(InData%fprimeprime_c_minus1)) call RegPack(Buf, InData%fprimeprime_c_minus1) end if if (RegCheckErr(Buf, RoutineName)) return - ! fprimeprime_m_minus1 call RegPack(Buf, allocated(InData%fprimeprime_m_minus1)) if (allocated(InData%fprimeprime_m_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%fprimeprime_m_minus1), ubound(InData%fprimeprime_m_minus1)) call RegPack(Buf, InData%fprimeprime_m_minus1) end if if (RegCheckErr(Buf, RoutineName)) return - ! Df_minus1 call RegPack(Buf, allocated(InData%Df_minus1)) if (allocated(InData%Df_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%Df_minus1), ubound(InData%Df_minus1)) call RegPack(Buf, InData%Df_minus1) end if if (RegCheckErr(Buf, RoutineName)) return - ! Df_c_minus1 call RegPack(Buf, allocated(InData%Df_c_minus1)) if (allocated(InData%Df_c_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%Df_c_minus1), ubound(InData%Df_c_minus1)) call RegPack(Buf, InData%Df_c_minus1) end if if (RegCheckErr(Buf, RoutineName)) return - ! Df_m_minus1 call RegPack(Buf, allocated(InData%Df_m_minus1)) if (allocated(InData%Df_m_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%Df_m_minus1), ubound(InData%Df_m_minus1)) call RegPack(Buf, InData%Df_m_minus1) end if if (RegCheckErr(Buf, RoutineName)) return - ! Dalphaf_minus1 call RegPack(Buf, allocated(InData%Dalphaf_minus1)) if (allocated(InData%Dalphaf_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%Dalphaf_minus1), ubound(InData%Dalphaf_minus1)) call RegPack(Buf, InData%Dalphaf_minus1) end if if (RegCheckErr(Buf, RoutineName)) return - ! alphaf_minus1 call RegPack(Buf, allocated(InData%alphaf_minus1)) if (allocated(InData%alphaf_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%alphaf_minus1), ubound(InData%alphaf_minus1)) call RegPack(Buf, InData%alphaf_minus1) end if if (RegCheckErr(Buf, RoutineName)) return - ! fprime_minus1 call RegPack(Buf, allocated(InData%fprime_minus1)) if (allocated(InData%fprime_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%fprime_minus1), ubound(InData%fprime_minus1)) call RegPack(Buf, InData%fprime_minus1) end if if (RegCheckErr(Buf, RoutineName)) return - ! fprime_c_minus1 call RegPack(Buf, allocated(InData%fprime_c_minus1)) if (allocated(InData%fprime_c_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%fprime_c_minus1), ubound(InData%fprime_c_minus1)) call RegPack(Buf, InData%fprime_c_minus1) end if if (RegCheckErr(Buf, RoutineName)) return - ! fprime_m_minus1 call RegPack(Buf, allocated(InData%fprime_m_minus1)) if (allocated(InData%fprime_m_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%fprime_m_minus1), ubound(InData%fprime_m_minus1)) call RegPack(Buf, InData%fprime_m_minus1) end if if (RegCheckErr(Buf, RoutineName)) return - ! tau_V call RegPack(Buf, allocated(InData%tau_V)) if (allocated(InData%tau_V)) then call RegPackBounds(Buf, 2, lbound(InData%tau_V), ubound(InData%tau_V)) call RegPack(Buf, InData%tau_V) end if if (RegCheckErr(Buf, RoutineName)) return - ! tau_V_minus1 call RegPack(Buf, allocated(InData%tau_V_minus1)) if (allocated(InData%tau_V_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%tau_V_minus1), ubound(InData%tau_V_minus1)) call RegPack(Buf, InData%tau_V_minus1) end if if (RegCheckErr(Buf, RoutineName)) return - ! Cn_v_minus1 call RegPack(Buf, allocated(InData%Cn_v_minus1)) if (allocated(InData%Cn_v_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%Cn_v_minus1), ubound(InData%Cn_v_minus1)) call RegPack(Buf, InData%Cn_v_minus1) end if if (RegCheckErr(Buf, RoutineName)) return - ! C_V_minus1 call RegPack(Buf, allocated(InData%C_V_minus1)) if (allocated(InData%C_V_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%C_V_minus1), ubound(InData%C_V_minus1)) call RegPack(Buf, InData%C_V_minus1) end if if (RegCheckErr(Buf, RoutineName)) return - ! Cn_prime_minus1 call RegPack(Buf, allocated(InData%Cn_prime_minus1)) if (allocated(InData%Cn_prime_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%Cn_prime_minus1), ubound(InData%Cn_prime_minus1)) @@ -2036,7 +1817,6 @@ subroutine UA_UnPackDiscState(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! alpha_minus1 if (allocated(OutData%alpha_minus1)) deallocate(OutData%alpha_minus1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2051,7 +1831,6 @@ subroutine UA_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%alpha_minus1) if (RegCheckErr(Buf, RoutineName)) return end if - ! alpha_filt_minus1 if (allocated(OutData%alpha_filt_minus1)) deallocate(OutData%alpha_filt_minus1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2066,7 +1845,6 @@ subroutine UA_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%alpha_filt_minus1) if (RegCheckErr(Buf, RoutineName)) return end if - ! alpha_dot if (allocated(OutData%alpha_dot)) deallocate(OutData%alpha_dot) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2081,7 +1859,6 @@ subroutine UA_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%alpha_dot) if (RegCheckErr(Buf, RoutineName)) return end if - ! alpha_dot_minus1 if (allocated(OutData%alpha_dot_minus1)) deallocate(OutData%alpha_dot_minus1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2096,7 +1873,6 @@ subroutine UA_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%alpha_dot_minus1) if (RegCheckErr(Buf, RoutineName)) return end if - ! q_minus1 if (allocated(OutData%q_minus1)) deallocate(OutData%q_minus1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2111,7 +1887,6 @@ subroutine UA_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%q_minus1) if (RegCheckErr(Buf, RoutineName)) return end if - ! Kalpha_f_minus1 if (allocated(OutData%Kalpha_f_minus1)) deallocate(OutData%Kalpha_f_minus1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2126,7 +1901,6 @@ subroutine UA_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%Kalpha_f_minus1) if (RegCheckErr(Buf, RoutineName)) return end if - ! Kq_f_minus1 if (allocated(OutData%Kq_f_minus1)) deallocate(OutData%Kq_f_minus1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2141,7 +1915,6 @@ subroutine UA_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%Kq_f_minus1) if (RegCheckErr(Buf, RoutineName)) return end if - ! q_f_minus1 if (allocated(OutData%q_f_minus1)) deallocate(OutData%q_f_minus1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2156,7 +1929,6 @@ subroutine UA_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%q_f_minus1) if (RegCheckErr(Buf, RoutineName)) return end if - ! X1_minus1 if (allocated(OutData%X1_minus1)) deallocate(OutData%X1_minus1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2171,7 +1943,6 @@ subroutine UA_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%X1_minus1) if (RegCheckErr(Buf, RoutineName)) return end if - ! X2_minus1 if (allocated(OutData%X2_minus1)) deallocate(OutData%X2_minus1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2186,7 +1957,6 @@ subroutine UA_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%X2_minus1) if (RegCheckErr(Buf, RoutineName)) return end if - ! X3_minus1 if (allocated(OutData%X3_minus1)) deallocate(OutData%X3_minus1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2201,7 +1971,6 @@ subroutine UA_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%X3_minus1) if (RegCheckErr(Buf, RoutineName)) return end if - ! X4_minus1 if (allocated(OutData%X4_minus1)) deallocate(OutData%X4_minus1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2216,7 +1985,6 @@ subroutine UA_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%X4_minus1) if (RegCheckErr(Buf, RoutineName)) return end if - ! Kprime_alpha_minus1 if (allocated(OutData%Kprime_alpha_minus1)) deallocate(OutData%Kprime_alpha_minus1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2231,7 +1999,6 @@ subroutine UA_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%Kprime_alpha_minus1) if (RegCheckErr(Buf, RoutineName)) return end if - ! Kprime_q_minus1 if (allocated(OutData%Kprime_q_minus1)) deallocate(OutData%Kprime_q_minus1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2246,7 +2013,6 @@ subroutine UA_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%Kprime_q_minus1) if (RegCheckErr(Buf, RoutineName)) return end if - ! Kprimeprime_q_minus1 if (allocated(OutData%Kprimeprime_q_minus1)) deallocate(OutData%Kprimeprime_q_minus1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2261,7 +2027,6 @@ subroutine UA_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%Kprimeprime_q_minus1) if (RegCheckErr(Buf, RoutineName)) return end if - ! K3prime_q_minus1 if (allocated(OutData%K3prime_q_minus1)) deallocate(OutData%K3prime_q_minus1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2276,7 +2041,6 @@ subroutine UA_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%K3prime_q_minus1) if (RegCheckErr(Buf, RoutineName)) return end if - ! Dp_minus1 if (allocated(OutData%Dp_minus1)) deallocate(OutData%Dp_minus1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2291,7 +2055,6 @@ subroutine UA_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%Dp_minus1) if (RegCheckErr(Buf, RoutineName)) return end if - ! Cn_pot_minus1 if (allocated(OutData%Cn_pot_minus1)) deallocate(OutData%Cn_pot_minus1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2306,7 +2069,6 @@ subroutine UA_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%Cn_pot_minus1) if (RegCheckErr(Buf, RoutineName)) return end if - ! fprimeprime_minus1 if (allocated(OutData%fprimeprime_minus1)) deallocate(OutData%fprimeprime_minus1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2321,7 +2083,6 @@ subroutine UA_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%fprimeprime_minus1) if (RegCheckErr(Buf, RoutineName)) return end if - ! fprimeprime_c_minus1 if (allocated(OutData%fprimeprime_c_minus1)) deallocate(OutData%fprimeprime_c_minus1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2336,7 +2097,6 @@ subroutine UA_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%fprimeprime_c_minus1) if (RegCheckErr(Buf, RoutineName)) return end if - ! fprimeprime_m_minus1 if (allocated(OutData%fprimeprime_m_minus1)) deallocate(OutData%fprimeprime_m_minus1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2351,7 +2111,6 @@ subroutine UA_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%fprimeprime_m_minus1) if (RegCheckErr(Buf, RoutineName)) return end if - ! Df_minus1 if (allocated(OutData%Df_minus1)) deallocate(OutData%Df_minus1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2366,7 +2125,6 @@ subroutine UA_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%Df_minus1) if (RegCheckErr(Buf, RoutineName)) return end if - ! Df_c_minus1 if (allocated(OutData%Df_c_minus1)) deallocate(OutData%Df_c_minus1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2381,7 +2139,6 @@ subroutine UA_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%Df_c_minus1) if (RegCheckErr(Buf, RoutineName)) return end if - ! Df_m_minus1 if (allocated(OutData%Df_m_minus1)) deallocate(OutData%Df_m_minus1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2396,7 +2153,6 @@ subroutine UA_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%Df_m_minus1) if (RegCheckErr(Buf, RoutineName)) return end if - ! Dalphaf_minus1 if (allocated(OutData%Dalphaf_minus1)) deallocate(OutData%Dalphaf_minus1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2411,7 +2167,6 @@ subroutine UA_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%Dalphaf_minus1) if (RegCheckErr(Buf, RoutineName)) return end if - ! alphaf_minus1 if (allocated(OutData%alphaf_minus1)) deallocate(OutData%alphaf_minus1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2426,7 +2181,6 @@ subroutine UA_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%alphaf_minus1) if (RegCheckErr(Buf, RoutineName)) return end if - ! fprime_minus1 if (allocated(OutData%fprime_minus1)) deallocate(OutData%fprime_minus1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2441,7 +2195,6 @@ subroutine UA_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%fprime_minus1) if (RegCheckErr(Buf, RoutineName)) return end if - ! fprime_c_minus1 if (allocated(OutData%fprime_c_minus1)) deallocate(OutData%fprime_c_minus1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2456,7 +2209,6 @@ subroutine UA_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%fprime_c_minus1) if (RegCheckErr(Buf, RoutineName)) return end if - ! fprime_m_minus1 if (allocated(OutData%fprime_m_minus1)) deallocate(OutData%fprime_m_minus1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2471,7 +2223,6 @@ subroutine UA_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%fprime_m_minus1) if (RegCheckErr(Buf, RoutineName)) return end if - ! tau_V if (allocated(OutData%tau_V)) deallocate(OutData%tau_V) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2486,7 +2237,6 @@ subroutine UA_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%tau_V) if (RegCheckErr(Buf, RoutineName)) return end if - ! tau_V_minus1 if (allocated(OutData%tau_V_minus1)) deallocate(OutData%tau_V_minus1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2501,7 +2251,6 @@ subroutine UA_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%tau_V_minus1) if (RegCheckErr(Buf, RoutineName)) return end if - ! Cn_v_minus1 if (allocated(OutData%Cn_v_minus1)) deallocate(OutData%Cn_v_minus1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2516,7 +2265,6 @@ subroutine UA_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%Cn_v_minus1) if (RegCheckErr(Buf, RoutineName)) return end if - ! C_V_minus1 if (allocated(OutData%C_V_minus1)) deallocate(OutData%C_V_minus1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2531,7 +2279,6 @@ subroutine UA_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%C_V_minus1) if (RegCheckErr(Buf, RoutineName)) return end if - ! Cn_prime_minus1 if (allocated(OutData%Cn_prime_minus1)) deallocate(OutData%Cn_prime_minus1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2547,45 +2294,33 @@ subroutine UA_UnPackDiscState(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE UA_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(UA_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(UA_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstraintState = SrcConstrStateData%DummyConstraintState - END SUBROUTINE UA_CopyConstrState - - SUBROUTINE UA_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(UA_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyConstrState' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE UA_DestroyConstrState +subroutine UA_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(UA_ConstraintStateType), intent(in) :: SrcConstrStateData + type(UA_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'UA_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%DummyConstraintState = SrcConstrStateData%DummyConstraintState +end subroutine +subroutine UA_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(UA_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'UA_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine UA_PackConstrState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(UA_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'UA_PackConstrState' if (Buf%ErrStat >= AbortErrLev) return - ! DummyConstraintState call RegPack(Buf, InData%DummyConstraintState) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2595,273 +2330,263 @@ subroutine UA_UnPackConstrState(Buf, OutData) type(UA_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'UA_UnPackConstrState' if (Buf%ErrStat /= ErrID_None) return - ! DummyConstraintState call RegUnpack(Buf, OutData%DummyConstraintState) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE UA_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(UA_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(UA_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOtherStateData%FirstPass)) THEN - i1_l = LBOUND(SrcOtherStateData%FirstPass,1) - i1_u = UBOUND(SrcOtherStateData%FirstPass,1) - i2_l = LBOUND(SrcOtherStateData%FirstPass,2) - i2_u = UBOUND(SrcOtherStateData%FirstPass,2) - IF (.NOT. ALLOCATED(DstOtherStateData%FirstPass)) THEN - ALLOCATE(DstOtherStateData%FirstPass(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%FirstPass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%FirstPass = SrcOtherStateData%FirstPass -ENDIF -IF (ALLOCATED(SrcOtherStateData%sigma1)) THEN - i1_l = LBOUND(SrcOtherStateData%sigma1,1) - i1_u = UBOUND(SrcOtherStateData%sigma1,1) - i2_l = LBOUND(SrcOtherStateData%sigma1,2) - i2_u = UBOUND(SrcOtherStateData%sigma1,2) - IF (.NOT. ALLOCATED(DstOtherStateData%sigma1)) THEN - ALLOCATE(DstOtherStateData%sigma1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%sigma1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%sigma1 = SrcOtherStateData%sigma1 -ENDIF -IF (ALLOCATED(SrcOtherStateData%sigma1c)) THEN - i1_l = LBOUND(SrcOtherStateData%sigma1c,1) - i1_u = UBOUND(SrcOtherStateData%sigma1c,1) - i2_l = LBOUND(SrcOtherStateData%sigma1c,2) - i2_u = UBOUND(SrcOtherStateData%sigma1c,2) - IF (.NOT. ALLOCATED(DstOtherStateData%sigma1c)) THEN - ALLOCATE(DstOtherStateData%sigma1c(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%sigma1c.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%sigma1c = SrcOtherStateData%sigma1c -ENDIF -IF (ALLOCATED(SrcOtherStateData%sigma1m)) THEN - i1_l = LBOUND(SrcOtherStateData%sigma1m,1) - i1_u = UBOUND(SrcOtherStateData%sigma1m,1) - i2_l = LBOUND(SrcOtherStateData%sigma1m,2) - i2_u = UBOUND(SrcOtherStateData%sigma1m,2) - IF (.NOT. ALLOCATED(DstOtherStateData%sigma1m)) THEN - ALLOCATE(DstOtherStateData%sigma1m(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%sigma1m.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%sigma1m = SrcOtherStateData%sigma1m -ENDIF -IF (ALLOCATED(SrcOtherStateData%sigma3)) THEN - i1_l = LBOUND(SrcOtherStateData%sigma3,1) - i1_u = UBOUND(SrcOtherStateData%sigma3,1) - i2_l = LBOUND(SrcOtherStateData%sigma3,2) - i2_u = UBOUND(SrcOtherStateData%sigma3,2) - IF (.NOT. ALLOCATED(DstOtherStateData%sigma3)) THEN - ALLOCATE(DstOtherStateData%sigma3(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%sigma3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%sigma3 = SrcOtherStateData%sigma3 -ENDIF -IF (ALLOCATED(SrcOtherStateData%n)) THEN - i1_l = LBOUND(SrcOtherStateData%n,1) - i1_u = UBOUND(SrcOtherStateData%n,1) - i2_l = LBOUND(SrcOtherStateData%n,2) - i2_u = UBOUND(SrcOtherStateData%n,2) - IF (.NOT. ALLOCATED(DstOtherStateData%n)) THEN - ALLOCATE(DstOtherStateData%n(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%n.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%n = SrcOtherStateData%n -ENDIF - DO i1 = LBOUND(SrcOtherStateData%xdot,1), UBOUND(SrcOtherStateData%xdot,1) - CALL UA_CopyContState( SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -IF (ALLOCATED(SrcOtherStateData%t_vortexBegin)) THEN - i1_l = LBOUND(SrcOtherStateData%t_vortexBegin,1) - i1_u = UBOUND(SrcOtherStateData%t_vortexBegin,1) - i2_l = LBOUND(SrcOtherStateData%t_vortexBegin,2) - i2_u = UBOUND(SrcOtherStateData%t_vortexBegin,2) - IF (.NOT. ALLOCATED(DstOtherStateData%t_vortexBegin)) THEN - ALLOCATE(DstOtherStateData%t_vortexBegin(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%t_vortexBegin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%t_vortexBegin = SrcOtherStateData%t_vortexBegin -ENDIF -IF (ALLOCATED(SrcOtherStateData%SignOfOmega)) THEN - i1_l = LBOUND(SrcOtherStateData%SignOfOmega,1) - i1_u = UBOUND(SrcOtherStateData%SignOfOmega,1) - i2_l = LBOUND(SrcOtherStateData%SignOfOmega,2) - i2_u = UBOUND(SrcOtherStateData%SignOfOmega,2) - IF (.NOT. ALLOCATED(DstOtherStateData%SignOfOmega)) THEN - ALLOCATE(DstOtherStateData%SignOfOmega(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%SignOfOmega.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%SignOfOmega = SrcOtherStateData%SignOfOmega -ENDIF -IF (ALLOCATED(SrcOtherStateData%PositivePressure)) THEN - i1_l = LBOUND(SrcOtherStateData%PositivePressure,1) - i1_u = UBOUND(SrcOtherStateData%PositivePressure,1) - i2_l = LBOUND(SrcOtherStateData%PositivePressure,2) - i2_u = UBOUND(SrcOtherStateData%PositivePressure,2) - IF (.NOT. ALLOCATED(DstOtherStateData%PositivePressure)) THEN - ALLOCATE(DstOtherStateData%PositivePressure(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%PositivePressure.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%PositivePressure = SrcOtherStateData%PositivePressure -ENDIF -IF (ALLOCATED(SrcOtherStateData%vortexOn)) THEN - i1_l = LBOUND(SrcOtherStateData%vortexOn,1) - i1_u = UBOUND(SrcOtherStateData%vortexOn,1) - i2_l = LBOUND(SrcOtherStateData%vortexOn,2) - i2_u = UBOUND(SrcOtherStateData%vortexOn,2) - IF (.NOT. ALLOCATED(DstOtherStateData%vortexOn)) THEN - ALLOCATE(DstOtherStateData%vortexOn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%vortexOn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%vortexOn = SrcOtherStateData%vortexOn -ENDIF -IF (ALLOCATED(SrcOtherStateData%BelowThreshold)) THEN - i1_l = LBOUND(SrcOtherStateData%BelowThreshold,1) - i1_u = UBOUND(SrcOtherStateData%BelowThreshold,1) - i2_l = LBOUND(SrcOtherStateData%BelowThreshold,2) - i2_u = UBOUND(SrcOtherStateData%BelowThreshold,2) - IF (.NOT. ALLOCATED(DstOtherStateData%BelowThreshold)) THEN - ALLOCATE(DstOtherStateData%BelowThreshold(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%BelowThreshold.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%BelowThreshold = SrcOtherStateData%BelowThreshold -ENDIF -IF (ALLOCATED(SrcOtherStateData%activeL)) THEN - i1_l = LBOUND(SrcOtherStateData%activeL,1) - i1_u = UBOUND(SrcOtherStateData%activeL,1) - i2_l = LBOUND(SrcOtherStateData%activeL,2) - i2_u = UBOUND(SrcOtherStateData%activeL,2) - IF (.NOT. ALLOCATED(DstOtherStateData%activeL)) THEN - ALLOCATE(DstOtherStateData%activeL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%activeL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%activeL = SrcOtherStateData%activeL -ENDIF -IF (ALLOCATED(SrcOtherStateData%activeD)) THEN - i1_l = LBOUND(SrcOtherStateData%activeD,1) - i1_u = UBOUND(SrcOtherStateData%activeD,1) - i2_l = LBOUND(SrcOtherStateData%activeD,2) - i2_u = UBOUND(SrcOtherStateData%activeD,2) - IF (.NOT. ALLOCATED(DstOtherStateData%activeD)) THEN - ALLOCATE(DstOtherStateData%activeD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%activeD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%activeD = SrcOtherStateData%activeD -ENDIF - END SUBROUTINE UA_CopyOtherState - - SUBROUTINE UA_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(UA_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyOtherState' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OtherStateData%FirstPass)) THEN - DEALLOCATE(OtherStateData%FirstPass) -ENDIF -IF (ALLOCATED(OtherStateData%sigma1)) THEN - DEALLOCATE(OtherStateData%sigma1) -ENDIF -IF (ALLOCATED(OtherStateData%sigma1c)) THEN - DEALLOCATE(OtherStateData%sigma1c) -ENDIF -IF (ALLOCATED(OtherStateData%sigma1m)) THEN - DEALLOCATE(OtherStateData%sigma1m) -ENDIF -IF (ALLOCATED(OtherStateData%sigma3)) THEN - DEALLOCATE(OtherStateData%sigma3) -ENDIF -IF (ALLOCATED(OtherStateData%n)) THEN - DEALLOCATE(OtherStateData%n) -ENDIF -DO i1 = LBOUND(OtherStateData%xdot,1), UBOUND(OtherStateData%xdot,1) - CALL UA_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -IF (ALLOCATED(OtherStateData%t_vortexBegin)) THEN - DEALLOCATE(OtherStateData%t_vortexBegin) -ENDIF -IF (ALLOCATED(OtherStateData%SignOfOmega)) THEN - DEALLOCATE(OtherStateData%SignOfOmega) -ENDIF -IF (ALLOCATED(OtherStateData%PositivePressure)) THEN - DEALLOCATE(OtherStateData%PositivePressure) -ENDIF -IF (ALLOCATED(OtherStateData%vortexOn)) THEN - DEALLOCATE(OtherStateData%vortexOn) -ENDIF -IF (ALLOCATED(OtherStateData%BelowThreshold)) THEN - DEALLOCATE(OtherStateData%BelowThreshold) -ENDIF -IF (ALLOCATED(OtherStateData%activeL)) THEN - DEALLOCATE(OtherStateData%activeL) -ENDIF -IF (ALLOCATED(OtherStateData%activeD)) THEN - DEALLOCATE(OtherStateData%activeD) -ENDIF - END SUBROUTINE UA_DestroyOtherState +subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(UA_OtherStateType), intent(in) :: SrcOtherStateData + type(UA_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'UA_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOtherStateData%FirstPass)) then + LB(1:2) = lbound(SrcOtherStateData%FirstPass) + UB(1:2) = ubound(SrcOtherStateData%FirstPass) + if (.not. allocated(DstOtherStateData%FirstPass)) then + allocate(DstOtherStateData%FirstPass(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%FirstPass.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%FirstPass = SrcOtherStateData%FirstPass + else if (allocated(DstOtherStateData%FirstPass)) then + deallocate(DstOtherStateData%FirstPass) + end if + if (allocated(SrcOtherStateData%sigma1)) then + LB(1:2) = lbound(SrcOtherStateData%sigma1) + UB(1:2) = ubound(SrcOtherStateData%sigma1) + if (.not. allocated(DstOtherStateData%sigma1)) then + allocate(DstOtherStateData%sigma1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%sigma1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%sigma1 = SrcOtherStateData%sigma1 + else if (allocated(DstOtherStateData%sigma1)) then + deallocate(DstOtherStateData%sigma1) + end if + if (allocated(SrcOtherStateData%sigma1c)) then + LB(1:2) = lbound(SrcOtherStateData%sigma1c) + UB(1:2) = ubound(SrcOtherStateData%sigma1c) + if (.not. allocated(DstOtherStateData%sigma1c)) then + allocate(DstOtherStateData%sigma1c(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%sigma1c.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%sigma1c = SrcOtherStateData%sigma1c + else if (allocated(DstOtherStateData%sigma1c)) then + deallocate(DstOtherStateData%sigma1c) + end if + if (allocated(SrcOtherStateData%sigma1m)) then + LB(1:2) = lbound(SrcOtherStateData%sigma1m) + UB(1:2) = ubound(SrcOtherStateData%sigma1m) + if (.not. allocated(DstOtherStateData%sigma1m)) then + allocate(DstOtherStateData%sigma1m(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%sigma1m.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%sigma1m = SrcOtherStateData%sigma1m + else if (allocated(DstOtherStateData%sigma1m)) then + deallocate(DstOtherStateData%sigma1m) + end if + if (allocated(SrcOtherStateData%sigma3)) then + LB(1:2) = lbound(SrcOtherStateData%sigma3) + UB(1:2) = ubound(SrcOtherStateData%sigma3) + if (.not. allocated(DstOtherStateData%sigma3)) then + allocate(DstOtherStateData%sigma3(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%sigma3.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%sigma3 = SrcOtherStateData%sigma3 + else if (allocated(DstOtherStateData%sigma3)) then + deallocate(DstOtherStateData%sigma3) + end if + if (allocated(SrcOtherStateData%n)) then + LB(1:2) = lbound(SrcOtherStateData%n) + UB(1:2) = ubound(SrcOtherStateData%n) + if (.not. allocated(DstOtherStateData%n)) then + allocate(DstOtherStateData%n(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%n.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%n = SrcOtherStateData%n + else if (allocated(DstOtherStateData%n)) then + deallocate(DstOtherStateData%n) + end if + do i1 = LB(1), UB(1) + call UA_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + if (allocated(SrcOtherStateData%t_vortexBegin)) then + LB(1:2) = lbound(SrcOtherStateData%t_vortexBegin) + UB(1:2) = ubound(SrcOtherStateData%t_vortexBegin) + if (.not. allocated(DstOtherStateData%t_vortexBegin)) then + allocate(DstOtherStateData%t_vortexBegin(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%t_vortexBegin.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%t_vortexBegin = SrcOtherStateData%t_vortexBegin + else if (allocated(DstOtherStateData%t_vortexBegin)) then + deallocate(DstOtherStateData%t_vortexBegin) + end if + if (allocated(SrcOtherStateData%SignOfOmega)) then + LB(1:2) = lbound(SrcOtherStateData%SignOfOmega) + UB(1:2) = ubound(SrcOtherStateData%SignOfOmega) + if (.not. allocated(DstOtherStateData%SignOfOmega)) then + allocate(DstOtherStateData%SignOfOmega(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%SignOfOmega.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%SignOfOmega = SrcOtherStateData%SignOfOmega + else if (allocated(DstOtherStateData%SignOfOmega)) then + deallocate(DstOtherStateData%SignOfOmega) + end if + if (allocated(SrcOtherStateData%PositivePressure)) then + LB(1:2) = lbound(SrcOtherStateData%PositivePressure) + UB(1:2) = ubound(SrcOtherStateData%PositivePressure) + if (.not. allocated(DstOtherStateData%PositivePressure)) then + allocate(DstOtherStateData%PositivePressure(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%PositivePressure.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%PositivePressure = SrcOtherStateData%PositivePressure + else if (allocated(DstOtherStateData%PositivePressure)) then + deallocate(DstOtherStateData%PositivePressure) + end if + if (allocated(SrcOtherStateData%vortexOn)) then + LB(1:2) = lbound(SrcOtherStateData%vortexOn) + UB(1:2) = ubound(SrcOtherStateData%vortexOn) + if (.not. allocated(DstOtherStateData%vortexOn)) then + allocate(DstOtherStateData%vortexOn(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%vortexOn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%vortexOn = SrcOtherStateData%vortexOn + else if (allocated(DstOtherStateData%vortexOn)) then + deallocate(DstOtherStateData%vortexOn) + end if + if (allocated(SrcOtherStateData%BelowThreshold)) then + LB(1:2) = lbound(SrcOtherStateData%BelowThreshold) + UB(1:2) = ubound(SrcOtherStateData%BelowThreshold) + if (.not. allocated(DstOtherStateData%BelowThreshold)) then + allocate(DstOtherStateData%BelowThreshold(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%BelowThreshold.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%BelowThreshold = SrcOtherStateData%BelowThreshold + else if (allocated(DstOtherStateData%BelowThreshold)) then + deallocate(DstOtherStateData%BelowThreshold) + end if + if (allocated(SrcOtherStateData%activeL)) then + LB(1:2) = lbound(SrcOtherStateData%activeL) + UB(1:2) = ubound(SrcOtherStateData%activeL) + if (.not. allocated(DstOtherStateData%activeL)) then + allocate(DstOtherStateData%activeL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%activeL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%activeL = SrcOtherStateData%activeL + else if (allocated(DstOtherStateData%activeL)) then + deallocate(DstOtherStateData%activeL) + end if + if (allocated(SrcOtherStateData%activeD)) then + LB(1:2) = lbound(SrcOtherStateData%activeD) + UB(1:2) = ubound(SrcOtherStateData%activeD) + if (.not. allocated(DstOtherStateData%activeD)) then + allocate(DstOtherStateData%activeD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%activeD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%activeD = SrcOtherStateData%activeD + else if (allocated(DstOtherStateData%activeD)) then + deallocate(DstOtherStateData%activeD) + end if +end subroutine +subroutine UA_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(UA_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'UA_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OtherStateData%FirstPass)) then + deallocate(OtherStateData%FirstPass) + end if + if (allocated(OtherStateData%sigma1)) then + deallocate(OtherStateData%sigma1) + end if + if (allocated(OtherStateData%sigma1c)) then + deallocate(OtherStateData%sigma1c) + end if + if (allocated(OtherStateData%sigma1m)) then + deallocate(OtherStateData%sigma1m) + end if + if (allocated(OtherStateData%sigma3)) then + deallocate(OtherStateData%sigma3) + end if + if (allocated(OtherStateData%n)) then + deallocate(OtherStateData%n) + end if + if (allocated(OtherStateData%t_vortexBegin)) then + deallocate(OtherStateData%t_vortexBegin) + end if + if (allocated(OtherStateData%SignOfOmega)) then + deallocate(OtherStateData%SignOfOmega) + end if + if (allocated(OtherStateData%PositivePressure)) then + deallocate(OtherStateData%PositivePressure) + end if + if (allocated(OtherStateData%vortexOn)) then + deallocate(OtherStateData%vortexOn) + end if + if (allocated(OtherStateData%BelowThreshold)) then + deallocate(OtherStateData%BelowThreshold) + end if + if (allocated(OtherStateData%activeL)) then + deallocate(OtherStateData%activeL) + end if + if (allocated(OtherStateData%activeD)) then + deallocate(OtherStateData%activeD) + end if +end subroutine subroutine UA_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -2870,98 +2595,84 @@ subroutine UA_PackOtherState(Buf, Indata) integer(IntKi) :: i1, i2 integer(IntKi) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return - ! FirstPass call RegPack(Buf, allocated(InData%FirstPass)) if (allocated(InData%FirstPass)) then call RegPackBounds(Buf, 2, lbound(InData%FirstPass), ubound(InData%FirstPass)) call RegPack(Buf, InData%FirstPass) end if if (RegCheckErr(Buf, RoutineName)) return - ! sigma1 call RegPack(Buf, allocated(InData%sigma1)) if (allocated(InData%sigma1)) then call RegPackBounds(Buf, 2, lbound(InData%sigma1), ubound(InData%sigma1)) call RegPack(Buf, InData%sigma1) end if if (RegCheckErr(Buf, RoutineName)) return - ! sigma1c call RegPack(Buf, allocated(InData%sigma1c)) if (allocated(InData%sigma1c)) then call RegPackBounds(Buf, 2, lbound(InData%sigma1c), ubound(InData%sigma1c)) call RegPack(Buf, InData%sigma1c) end if if (RegCheckErr(Buf, RoutineName)) return - ! sigma1m call RegPack(Buf, allocated(InData%sigma1m)) if (allocated(InData%sigma1m)) then call RegPackBounds(Buf, 2, lbound(InData%sigma1m), ubound(InData%sigma1m)) call RegPack(Buf, InData%sigma1m) end if if (RegCheckErr(Buf, RoutineName)) return - ! sigma3 call RegPack(Buf, allocated(InData%sigma3)) if (allocated(InData%sigma3)) then call RegPackBounds(Buf, 2, lbound(InData%sigma3), ubound(InData%sigma3)) call RegPack(Buf, InData%sigma3) end if if (RegCheckErr(Buf, RoutineName)) return - ! n call RegPack(Buf, allocated(InData%n)) if (allocated(InData%n)) then call RegPackBounds(Buf, 2, lbound(InData%n), ubound(InData%n)) call RegPack(Buf, InData%n) end if if (RegCheckErr(Buf, RoutineName)) return - ! xdot LB(1:1) = lbound(InData%xdot) UB(1:1) = ubound(InData%xdot) do i1 = LB(1), UB(1) call UA_PackContState(Buf, InData%xdot(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! t_vortexBegin call RegPack(Buf, allocated(InData%t_vortexBegin)) if (allocated(InData%t_vortexBegin)) then call RegPackBounds(Buf, 2, lbound(InData%t_vortexBegin), ubound(InData%t_vortexBegin)) call RegPack(Buf, InData%t_vortexBegin) end if if (RegCheckErr(Buf, RoutineName)) return - ! SignOfOmega call RegPack(Buf, allocated(InData%SignOfOmega)) if (allocated(InData%SignOfOmega)) then call RegPackBounds(Buf, 2, lbound(InData%SignOfOmega), ubound(InData%SignOfOmega)) call RegPack(Buf, InData%SignOfOmega) end if if (RegCheckErr(Buf, RoutineName)) return - ! PositivePressure call RegPack(Buf, allocated(InData%PositivePressure)) if (allocated(InData%PositivePressure)) then call RegPackBounds(Buf, 2, lbound(InData%PositivePressure), ubound(InData%PositivePressure)) call RegPack(Buf, InData%PositivePressure) end if if (RegCheckErr(Buf, RoutineName)) return - ! vortexOn call RegPack(Buf, allocated(InData%vortexOn)) if (allocated(InData%vortexOn)) then call RegPackBounds(Buf, 2, lbound(InData%vortexOn), ubound(InData%vortexOn)) call RegPack(Buf, InData%vortexOn) end if if (RegCheckErr(Buf, RoutineName)) return - ! BelowThreshold call RegPack(Buf, allocated(InData%BelowThreshold)) if (allocated(InData%BelowThreshold)) then call RegPackBounds(Buf, 2, lbound(InData%BelowThreshold), ubound(InData%BelowThreshold)) call RegPack(Buf, InData%BelowThreshold) end if if (RegCheckErr(Buf, RoutineName)) return - ! activeL call RegPack(Buf, allocated(InData%activeL)) if (allocated(InData%activeL)) then call RegPackBounds(Buf, 2, lbound(InData%activeL), ubound(InData%activeL)) call RegPack(Buf, InData%activeL) end if if (RegCheckErr(Buf, RoutineName)) return - ! activeD call RegPack(Buf, allocated(InData%activeD)) if (allocated(InData%activeD)) then call RegPackBounds(Buf, 2, lbound(InData%activeD), ubound(InData%activeD)) @@ -2979,7 +2690,6 @@ subroutine UA_UnPackOtherState(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! FirstPass if (allocated(OutData%FirstPass)) deallocate(OutData%FirstPass) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2994,7 +2704,6 @@ subroutine UA_UnPackOtherState(Buf, OutData) call RegUnpack(Buf, OutData%FirstPass) if (RegCheckErr(Buf, RoutineName)) return end if - ! sigma1 if (allocated(OutData%sigma1)) deallocate(OutData%sigma1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3009,7 +2718,6 @@ subroutine UA_UnPackOtherState(Buf, OutData) call RegUnpack(Buf, OutData%sigma1) if (RegCheckErr(Buf, RoutineName)) return end if - ! sigma1c if (allocated(OutData%sigma1c)) deallocate(OutData%sigma1c) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3024,7 +2732,6 @@ subroutine UA_UnPackOtherState(Buf, OutData) call RegUnpack(Buf, OutData%sigma1c) if (RegCheckErr(Buf, RoutineName)) return end if - ! sigma1m if (allocated(OutData%sigma1m)) deallocate(OutData%sigma1m) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3039,7 +2746,6 @@ subroutine UA_UnPackOtherState(Buf, OutData) call RegUnpack(Buf, OutData%sigma1m) if (RegCheckErr(Buf, RoutineName)) return end if - ! sigma3 if (allocated(OutData%sigma3)) deallocate(OutData%sigma3) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3054,7 +2760,6 @@ subroutine UA_UnPackOtherState(Buf, OutData) call RegUnpack(Buf, OutData%sigma3) if (RegCheckErr(Buf, RoutineName)) return end if - ! n if (allocated(OutData%n)) deallocate(OutData%n) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3069,13 +2774,11 @@ subroutine UA_UnPackOtherState(Buf, OutData) call RegUnpack(Buf, OutData%n) if (RegCheckErr(Buf, RoutineName)) return end if - ! xdot LB(1:1) = lbound(OutData%xdot) UB(1:1) = ubound(OutData%xdot) do i1 = LB(1), UB(1) call UA_UnpackContState(Buf, OutData%xdot(i1)) ! xdot end do - ! t_vortexBegin if (allocated(OutData%t_vortexBegin)) deallocate(OutData%t_vortexBegin) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3090,7 +2793,6 @@ subroutine UA_UnPackOtherState(Buf, OutData) call RegUnpack(Buf, OutData%t_vortexBegin) if (RegCheckErr(Buf, RoutineName)) return end if - ! SignOfOmega if (allocated(OutData%SignOfOmega)) deallocate(OutData%SignOfOmega) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3105,7 +2807,6 @@ subroutine UA_UnPackOtherState(Buf, OutData) call RegUnpack(Buf, OutData%SignOfOmega) if (RegCheckErr(Buf, RoutineName)) return end if - ! PositivePressure if (allocated(OutData%PositivePressure)) deallocate(OutData%PositivePressure) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3120,7 +2821,6 @@ subroutine UA_UnPackOtherState(Buf, OutData) call RegUnpack(Buf, OutData%PositivePressure) if (RegCheckErr(Buf, RoutineName)) return end if - ! vortexOn if (allocated(OutData%vortexOn)) deallocate(OutData%vortexOn) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3135,7 +2835,6 @@ subroutine UA_UnPackOtherState(Buf, OutData) call RegUnpack(Buf, OutData%vortexOn) if (RegCheckErr(Buf, RoutineName)) return end if - ! BelowThreshold if (allocated(OutData%BelowThreshold)) deallocate(OutData%BelowThreshold) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3150,7 +2849,6 @@ subroutine UA_UnPackOtherState(Buf, OutData) call RegUnpack(Buf, OutData%BelowThreshold) if (RegCheckErr(Buf, RoutineName)) return end if - ! activeL if (allocated(OutData%activeL)) deallocate(OutData%activeL) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3165,7 +2863,6 @@ subroutine UA_UnPackOtherState(Buf, OutData) call RegUnpack(Buf, OutData%activeL) if (RegCheckErr(Buf, RoutineName)) return end if - ! activeD if (allocated(OutData%activeD)) deallocate(OutData%activeD) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3181,195 +2878,175 @@ subroutine UA_UnPackOtherState(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE UA_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(UA_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(UA_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%FirstWarn_M = SrcMiscData%FirstWarn_M - DstMiscData%FirstWarn_UA = SrcMiscData%FirstWarn_UA - DstMiscData%FirstWarn_UA_off = SrcMiscData%FirstWarn_UA_off -IF (ALLOCATED(SrcMiscData%TESF)) THEN - i1_l = LBOUND(SrcMiscData%TESF,1) - i1_u = UBOUND(SrcMiscData%TESF,1) - i2_l = LBOUND(SrcMiscData%TESF,2) - i2_u = UBOUND(SrcMiscData%TESF,2) - IF (.NOT. ALLOCATED(DstMiscData%TESF)) THEN - ALLOCATE(DstMiscData%TESF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TESF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%TESF = SrcMiscData%TESF -ENDIF -IF (ALLOCATED(SrcMiscData%LESF)) THEN - i1_l = LBOUND(SrcMiscData%LESF,1) - i1_u = UBOUND(SrcMiscData%LESF,1) - i2_l = LBOUND(SrcMiscData%LESF,2) - i2_u = UBOUND(SrcMiscData%LESF,2) - IF (.NOT. ALLOCATED(DstMiscData%LESF)) THEN - ALLOCATE(DstMiscData%LESF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LESF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%LESF = SrcMiscData%LESF -ENDIF -IF (ALLOCATED(SrcMiscData%VRTX)) THEN - i1_l = LBOUND(SrcMiscData%VRTX,1) - i1_u = UBOUND(SrcMiscData%VRTX,1) - i2_l = LBOUND(SrcMiscData%VRTX,2) - i2_u = UBOUND(SrcMiscData%VRTX,2) - IF (.NOT. ALLOCATED(DstMiscData%VRTX)) THEN - ALLOCATE(DstMiscData%VRTX(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%VRTX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%VRTX = SrcMiscData%VRTX -ENDIF -IF (ALLOCATED(SrcMiscData%T_Sh)) THEN - i1_l = LBOUND(SrcMiscData%T_Sh,1) - i1_u = UBOUND(SrcMiscData%T_Sh,1) - i2_l = LBOUND(SrcMiscData%T_Sh,2) - i2_u = UBOUND(SrcMiscData%T_Sh,2) - IF (.NOT. ALLOCATED(DstMiscData%T_Sh)) THEN - ALLOCATE(DstMiscData%T_Sh(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%T_Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%T_Sh = SrcMiscData%T_Sh -ENDIF -IF (ALLOCATED(SrcMiscData%BEDSEP)) THEN - i1_l = LBOUND(SrcMiscData%BEDSEP,1) - i1_u = UBOUND(SrcMiscData%BEDSEP,1) - i2_l = LBOUND(SrcMiscData%BEDSEP,2) - i2_u = UBOUND(SrcMiscData%BEDSEP,2) - IF (.NOT. ALLOCATED(DstMiscData%BEDSEP)) THEN - ALLOCATE(DstMiscData%BEDSEP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BEDSEP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%BEDSEP = SrcMiscData%BEDSEP -ENDIF -IF (ALLOCATED(SrcMiscData%weight)) THEN - i1_l = LBOUND(SrcMiscData%weight,1) - i1_u = UBOUND(SrcMiscData%weight,1) - i2_l = LBOUND(SrcMiscData%weight,2) - i2_u = UBOUND(SrcMiscData%weight,2) - IF (.NOT. ALLOCATED(DstMiscData%weight)) THEN - ALLOCATE(DstMiscData%weight(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%weight.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%weight = SrcMiscData%weight -ENDIF - END SUBROUTINE UA_CopyMisc - - SUBROUTINE UA_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(UA_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(MiscData%TESF)) THEN - DEALLOCATE(MiscData%TESF) -ENDIF -IF (ALLOCATED(MiscData%LESF)) THEN - DEALLOCATE(MiscData%LESF) -ENDIF -IF (ALLOCATED(MiscData%VRTX)) THEN - DEALLOCATE(MiscData%VRTX) -ENDIF -IF (ALLOCATED(MiscData%T_Sh)) THEN - DEALLOCATE(MiscData%T_Sh) -ENDIF -IF (ALLOCATED(MiscData%BEDSEP)) THEN - DEALLOCATE(MiscData%BEDSEP) -ENDIF -IF (ALLOCATED(MiscData%weight)) THEN - DEALLOCATE(MiscData%weight) -ENDIF - END SUBROUTINE UA_DestroyMisc +subroutine UA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(UA_MiscVarType), intent(in) :: SrcMiscData + type(UA_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'UA_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%FirstWarn_M = SrcMiscData%FirstWarn_M + DstMiscData%FirstWarn_UA = SrcMiscData%FirstWarn_UA + DstMiscData%FirstWarn_UA_off = SrcMiscData%FirstWarn_UA_off + if (allocated(SrcMiscData%TESF)) then + LB(1:2) = lbound(SrcMiscData%TESF) + UB(1:2) = ubound(SrcMiscData%TESF) + if (.not. allocated(DstMiscData%TESF)) then + allocate(DstMiscData%TESF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TESF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%TESF = SrcMiscData%TESF + else if (allocated(DstMiscData%TESF)) then + deallocate(DstMiscData%TESF) + end if + if (allocated(SrcMiscData%LESF)) then + LB(1:2) = lbound(SrcMiscData%LESF) + UB(1:2) = ubound(SrcMiscData%LESF) + if (.not. allocated(DstMiscData%LESF)) then + allocate(DstMiscData%LESF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LESF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%LESF = SrcMiscData%LESF + else if (allocated(DstMiscData%LESF)) then + deallocate(DstMiscData%LESF) + end if + if (allocated(SrcMiscData%VRTX)) then + LB(1:2) = lbound(SrcMiscData%VRTX) + UB(1:2) = ubound(SrcMiscData%VRTX) + if (.not. allocated(DstMiscData%VRTX)) then + allocate(DstMiscData%VRTX(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%VRTX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%VRTX = SrcMiscData%VRTX + else if (allocated(DstMiscData%VRTX)) then + deallocate(DstMiscData%VRTX) + end if + if (allocated(SrcMiscData%T_Sh)) then + LB(1:2) = lbound(SrcMiscData%T_Sh) + UB(1:2) = ubound(SrcMiscData%T_Sh) + if (.not. allocated(DstMiscData%T_Sh)) then + allocate(DstMiscData%T_Sh(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%T_Sh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%T_Sh = SrcMiscData%T_Sh + else if (allocated(DstMiscData%T_Sh)) then + deallocate(DstMiscData%T_Sh) + end if + if (allocated(SrcMiscData%BEDSEP)) then + LB(1:2) = lbound(SrcMiscData%BEDSEP) + UB(1:2) = ubound(SrcMiscData%BEDSEP) + if (.not. allocated(DstMiscData%BEDSEP)) then + allocate(DstMiscData%BEDSEP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BEDSEP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%BEDSEP = SrcMiscData%BEDSEP + else if (allocated(DstMiscData%BEDSEP)) then + deallocate(DstMiscData%BEDSEP) + end if + if (allocated(SrcMiscData%weight)) then + LB(1:2) = lbound(SrcMiscData%weight) + UB(1:2) = ubound(SrcMiscData%weight) + if (.not. allocated(DstMiscData%weight)) then + allocate(DstMiscData%weight(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%weight.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%weight = SrcMiscData%weight + else if (allocated(DstMiscData%weight)) then + deallocate(DstMiscData%weight) + end if +end subroutine +subroutine UA_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(UA_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'UA_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%TESF)) then + deallocate(MiscData%TESF) + end if + if (allocated(MiscData%LESF)) then + deallocate(MiscData%LESF) + end if + if (allocated(MiscData%VRTX)) then + deallocate(MiscData%VRTX) + end if + if (allocated(MiscData%T_Sh)) then + deallocate(MiscData%T_Sh) + end if + if (allocated(MiscData%BEDSEP)) then + deallocate(MiscData%BEDSEP) + end if + if (allocated(MiscData%weight)) then + deallocate(MiscData%weight) + end if +end subroutine subroutine UA_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(UA_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'UA_PackMisc' if (Buf%ErrStat >= AbortErrLev) return - ! FirstWarn_M call RegPack(Buf, InData%FirstWarn_M) if (RegCheckErr(Buf, RoutineName)) return - ! FirstWarn_UA call RegPack(Buf, InData%FirstWarn_UA) if (RegCheckErr(Buf, RoutineName)) return - ! FirstWarn_UA_off call RegPack(Buf, InData%FirstWarn_UA_off) if (RegCheckErr(Buf, RoutineName)) return - ! TESF call RegPack(Buf, allocated(InData%TESF)) if (allocated(InData%TESF)) then call RegPackBounds(Buf, 2, lbound(InData%TESF), ubound(InData%TESF)) call RegPack(Buf, InData%TESF) end if if (RegCheckErr(Buf, RoutineName)) return - ! LESF call RegPack(Buf, allocated(InData%LESF)) if (allocated(InData%LESF)) then call RegPackBounds(Buf, 2, lbound(InData%LESF), ubound(InData%LESF)) call RegPack(Buf, InData%LESF) end if if (RegCheckErr(Buf, RoutineName)) return - ! VRTX call RegPack(Buf, allocated(InData%VRTX)) if (allocated(InData%VRTX)) then call RegPackBounds(Buf, 2, lbound(InData%VRTX), ubound(InData%VRTX)) call RegPack(Buf, InData%VRTX) end if if (RegCheckErr(Buf, RoutineName)) return - ! T_Sh call RegPack(Buf, allocated(InData%T_Sh)) if (allocated(InData%T_Sh)) then call RegPackBounds(Buf, 2, lbound(InData%T_Sh), ubound(InData%T_Sh)) call RegPack(Buf, InData%T_Sh) end if if (RegCheckErr(Buf, RoutineName)) return - ! BEDSEP call RegPack(Buf, allocated(InData%BEDSEP)) if (allocated(InData%BEDSEP)) then call RegPackBounds(Buf, 2, lbound(InData%BEDSEP), ubound(InData%BEDSEP)) call RegPack(Buf, InData%BEDSEP) end if if (RegCheckErr(Buf, RoutineName)) return - ! weight call RegPack(Buf, allocated(InData%weight)) if (allocated(InData%weight)) then call RegPackBounds(Buf, 2, lbound(InData%weight), ubound(InData%weight)) @@ -3386,16 +3063,12 @@ subroutine UA_UnPackMisc(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! FirstWarn_M call RegUnpack(Buf, OutData%FirstWarn_M) if (RegCheckErr(Buf, RoutineName)) return - ! FirstWarn_UA call RegUnpack(Buf, OutData%FirstWarn_UA) if (RegCheckErr(Buf, RoutineName)) return - ! FirstWarn_UA_off call RegUnpack(Buf, OutData%FirstWarn_UA_off) if (RegCheckErr(Buf, RoutineName)) return - ! TESF if (allocated(OutData%TESF)) deallocate(OutData%TESF) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3410,7 +3083,6 @@ subroutine UA_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%TESF) if (RegCheckErr(Buf, RoutineName)) return end if - ! LESF if (allocated(OutData%LESF)) deallocate(OutData%LESF) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3425,7 +3097,6 @@ subroutine UA_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%LESF) if (RegCheckErr(Buf, RoutineName)) return end if - ! VRTX if (allocated(OutData%VRTX)) deallocate(OutData%VRTX) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3440,7 +3111,6 @@ subroutine UA_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%VRTX) if (RegCheckErr(Buf, RoutineName)) return end if - ! T_Sh if (allocated(OutData%T_Sh)) deallocate(OutData%T_Sh) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3455,7 +3125,6 @@ subroutine UA_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%T_Sh) if (RegCheckErr(Buf, RoutineName)) return end if - ! BEDSEP if (allocated(OutData%BEDSEP)) deallocate(OutData%BEDSEP) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3470,7 +3139,6 @@ subroutine UA_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%BEDSEP) if (RegCheckErr(Buf, RoutineName)) return end if - ! weight if (allocated(OutData%weight)) deallocate(OutData%weight) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3486,143 +3154,116 @@ subroutine UA_UnPackMisc(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE UA_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(UA_ParameterType), INTENT(IN) :: SrcParamData - TYPE(UA_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%dt = SrcParamData%dt -IF (ALLOCATED(SrcParamData%c)) THEN - i1_l = LBOUND(SrcParamData%c,1) - i1_u = UBOUND(SrcParamData%c,1) - i2_l = LBOUND(SrcParamData%c,2) - i2_u = UBOUND(SrcParamData%c,2) - IF (.NOT. ALLOCATED(DstParamData%c)) THEN - ALLOCATE(DstParamData%c(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%c.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%c = SrcParamData%c -ENDIF - DstParamData%numBlades = SrcParamData%numBlades - DstParamData%nNodesPerBlade = SrcParamData%nNodesPerBlade - DstParamData%UAMod = SrcParamData%UAMod - DstParamData%Flookup = SrcParamData%Flookup - DstParamData%a_s = SrcParamData%a_s - DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%OutSwtch = SrcParamData%OutSwtch - DstParamData%OutFmt = SrcParamData%OutFmt - DstParamData%OutSFmt = SrcParamData%OutSFmt - DstParamData%Delim = SrcParamData%Delim - DstParamData%UnOutFile = SrcParamData%UnOutFile - DstParamData%ShedEffect = SrcParamData%ShedEffect - DstParamData%lin_nx = SrcParamData%lin_nx -IF (ALLOCATED(SrcParamData%UA_off_forGood)) THEN - i1_l = LBOUND(SrcParamData%UA_off_forGood,1) - i1_u = UBOUND(SrcParamData%UA_off_forGood,1) - i2_l = LBOUND(SrcParamData%UA_off_forGood,2) - i2_u = UBOUND(SrcParamData%UA_off_forGood,2) - IF (.NOT. ALLOCATED(DstParamData%UA_off_forGood)) THEN - ALLOCATE(DstParamData%UA_off_forGood(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%UA_off_forGood.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%UA_off_forGood = SrcParamData%UA_off_forGood -ENDIF - END SUBROUTINE UA_CopyParam - - SUBROUTINE UA_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(UA_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyParam' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%c)) THEN - DEALLOCATE(ParamData%c) -ENDIF -IF (ALLOCATED(ParamData%UA_off_forGood)) THEN - DEALLOCATE(ParamData%UA_off_forGood) -ENDIF - END SUBROUTINE UA_DestroyParam +subroutine UA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(UA_ParameterType), intent(in) :: SrcParamData + type(UA_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'UA_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%dt = SrcParamData%dt + if (allocated(SrcParamData%c)) then + LB(1:2) = lbound(SrcParamData%c) + UB(1:2) = ubound(SrcParamData%c) + if (.not. allocated(DstParamData%c)) then + allocate(DstParamData%c(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%c.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%c = SrcParamData%c + else if (allocated(DstParamData%c)) then + deallocate(DstParamData%c) + end if + DstParamData%numBlades = SrcParamData%numBlades + DstParamData%nNodesPerBlade = SrcParamData%nNodesPerBlade + DstParamData%UAMod = SrcParamData%UAMod + DstParamData%Flookup = SrcParamData%Flookup + DstParamData%a_s = SrcParamData%a_s + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%OutSwtch = SrcParamData%OutSwtch + DstParamData%OutFmt = SrcParamData%OutFmt + DstParamData%OutSFmt = SrcParamData%OutSFmt + DstParamData%Delim = SrcParamData%Delim + DstParamData%UnOutFile = SrcParamData%UnOutFile + DstParamData%ShedEffect = SrcParamData%ShedEffect + DstParamData%lin_nx = SrcParamData%lin_nx + if (allocated(SrcParamData%UA_off_forGood)) then + LB(1:2) = lbound(SrcParamData%UA_off_forGood) + UB(1:2) = ubound(SrcParamData%UA_off_forGood) + if (.not. allocated(DstParamData%UA_off_forGood)) then + allocate(DstParamData%UA_off_forGood(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%UA_off_forGood.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%UA_off_forGood = SrcParamData%UA_off_forGood + else if (allocated(DstParamData%UA_off_forGood)) then + deallocate(DstParamData%UA_off_forGood) + end if +end subroutine +subroutine UA_DestroyParam(ParamData, ErrStat, ErrMsg) + type(UA_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'UA_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%c)) then + deallocate(ParamData%c) + end if + if (allocated(ParamData%UA_off_forGood)) then + deallocate(ParamData%UA_off_forGood) + end if +end subroutine subroutine UA_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(UA_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'UA_PackParam' if (Buf%ErrStat >= AbortErrLev) return - ! dt call RegPack(Buf, InData%dt) if (RegCheckErr(Buf, RoutineName)) return - ! c call RegPack(Buf, allocated(InData%c)) if (allocated(InData%c)) then call RegPackBounds(Buf, 2, lbound(InData%c), ubound(InData%c)) call RegPack(Buf, InData%c) end if if (RegCheckErr(Buf, RoutineName)) return - ! numBlades call RegPack(Buf, InData%numBlades) if (RegCheckErr(Buf, RoutineName)) return - ! nNodesPerBlade call RegPack(Buf, InData%nNodesPerBlade) if (RegCheckErr(Buf, RoutineName)) return - ! UAMod call RegPack(Buf, InData%UAMod) if (RegCheckErr(Buf, RoutineName)) return - ! Flookup call RegPack(Buf, InData%Flookup) if (RegCheckErr(Buf, RoutineName)) return - ! a_s call RegPack(Buf, InData%a_s) if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegPack(Buf, InData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! OutSwtch call RegPack(Buf, InData%OutSwtch) if (RegCheckErr(Buf, RoutineName)) return - ! OutFmt call RegPack(Buf, InData%OutFmt) if (RegCheckErr(Buf, RoutineName)) return - ! OutSFmt call RegPack(Buf, InData%OutSFmt) if (RegCheckErr(Buf, RoutineName)) return - ! Delim call RegPack(Buf, InData%Delim) if (RegCheckErr(Buf, RoutineName)) return - ! UnOutFile call RegPack(Buf, InData%UnOutFile) if (RegCheckErr(Buf, RoutineName)) return - ! ShedEffect call RegPack(Buf, InData%ShedEffect) if (RegCheckErr(Buf, RoutineName)) return - ! lin_nx call RegPack(Buf, InData%lin_nx) if (RegCheckErr(Buf, RoutineName)) return - ! UA_off_forGood call RegPack(Buf, allocated(InData%UA_off_forGood)) if (allocated(InData%UA_off_forGood)) then call RegPackBounds(Buf, 2, lbound(InData%UA_off_forGood), ubound(InData%UA_off_forGood)) @@ -3639,10 +3280,8 @@ subroutine UA_UnPackParam(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! dt call RegUnpack(Buf, OutData%dt) if (RegCheckErr(Buf, RoutineName)) return - ! c if (allocated(OutData%c)) deallocate(OutData%c) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3657,46 +3296,32 @@ subroutine UA_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%c) if (RegCheckErr(Buf, RoutineName)) return end if - ! numBlades call RegUnpack(Buf, OutData%numBlades) if (RegCheckErr(Buf, RoutineName)) return - ! nNodesPerBlade call RegUnpack(Buf, OutData%nNodesPerBlade) if (RegCheckErr(Buf, RoutineName)) return - ! UAMod call RegUnpack(Buf, OutData%UAMod) if (RegCheckErr(Buf, RoutineName)) return - ! Flookup call RegUnpack(Buf, OutData%Flookup) if (RegCheckErr(Buf, RoutineName)) return - ! a_s call RegUnpack(Buf, OutData%a_s) if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegUnpack(Buf, OutData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! OutSwtch call RegUnpack(Buf, OutData%OutSwtch) if (RegCheckErr(Buf, RoutineName)) return - ! OutFmt call RegUnpack(Buf, OutData%OutFmt) if (RegCheckErr(Buf, RoutineName)) return - ! OutSFmt call RegUnpack(Buf, OutData%OutSFmt) if (RegCheckErr(Buf, RoutineName)) return - ! Delim call RegUnpack(Buf, OutData%Delim) if (RegCheckErr(Buf, RoutineName)) return - ! UnOutFile call RegUnpack(Buf, OutData%UnOutFile) if (RegCheckErr(Buf, RoutineName)) return - ! ShedEffect call RegUnpack(Buf, OutData%ShedEffect) if (RegCheckErr(Buf, RoutineName)) return - ! lin_nx call RegUnpack(Buf, OutData%lin_nx) if (RegCheckErr(Buf, RoutineName)) return - ! UA_off_forGood if (allocated(OutData%UA_off_forGood)) deallocate(OutData%UA_off_forGood) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3712,66 +3337,48 @@ subroutine UA_UnPackParam(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE UA_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(UA_InputType), INTENT(IN) :: SrcInputData - TYPE(UA_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_CopyInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInputData%U = SrcInputData%U - DstInputData%alpha = SrcInputData%alpha - DstInputData%Re = SrcInputData%Re - DstInputData%UserProp = SrcInputData%UserProp - DstInputData%v_ac = SrcInputData%v_ac - DstInputData%omega = SrcInputData%omega - END SUBROUTINE UA_CopyInput - - SUBROUTINE UA_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(UA_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE UA_DestroyInput +subroutine UA_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(UA_InputType), intent(in) :: SrcInputData + type(UA_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'UA_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInputData%U = SrcInputData%U + DstInputData%alpha = SrcInputData%alpha + DstInputData%Re = SrcInputData%Re + DstInputData%UserProp = SrcInputData%UserProp + DstInputData%v_ac = SrcInputData%v_ac + DstInputData%omega = SrcInputData%omega +end subroutine +subroutine UA_DestroyInput(InputData, ErrStat, ErrMsg) + type(UA_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'UA_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine UA_PackInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(UA_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'UA_PackInput' if (Buf%ErrStat >= AbortErrLev) return - ! U call RegPack(Buf, InData%U) if (RegCheckErr(Buf, RoutineName)) return - ! alpha call RegPack(Buf, InData%alpha) if (RegCheckErr(Buf, RoutineName)) return - ! Re call RegPack(Buf, InData%Re) if (RegCheckErr(Buf, RoutineName)) return - ! UserProp call RegPack(Buf, InData%UserProp) if (RegCheckErr(Buf, RoutineName)) return - ! v_ac call RegPack(Buf, InData%v_ac) if (RegCheckErr(Buf, RoutineName)) return - ! omega call RegPack(Buf, InData%omega) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3781,99 +3388,79 @@ subroutine UA_UnPackInput(Buf, OutData) type(UA_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'UA_UnPackInput' if (Buf%ErrStat /= ErrID_None) return - ! U call RegUnpack(Buf, OutData%U) if (RegCheckErr(Buf, RoutineName)) return - ! alpha call RegUnpack(Buf, OutData%alpha) if (RegCheckErr(Buf, RoutineName)) return - ! Re call RegUnpack(Buf, OutData%Re) if (RegCheckErr(Buf, RoutineName)) return - ! UserProp call RegUnpack(Buf, OutData%UserProp) if (RegCheckErr(Buf, RoutineName)) return - ! v_ac call RegUnpack(Buf, OutData%v_ac) if (RegCheckErr(Buf, RoutineName)) return - ! omega call RegUnpack(Buf, OutData%omega) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE UA_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(UA_OutputType), INTENT(IN) :: SrcOutputData - TYPE(UA_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_CopyOutput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOutputData%Cn = SrcOutputData%Cn - DstOutputData%Cc = SrcOutputData%Cc - DstOutputData%Cm = SrcOutputData%Cm - DstOutputData%Cl = SrcOutputData%Cl - DstOutputData%Cd = SrcOutputData%Cd -IF (ALLOCATED(SrcOutputData%WriteOutput)) THEN - i1_l = LBOUND(SrcOutputData%WriteOutput,1) - i1_u = UBOUND(SrcOutputData%WriteOutput,1) - IF (.NOT. ALLOCATED(DstOutputData%WriteOutput)) THEN - ALLOCATE(DstOutputData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%WriteOutput = SrcOutputData%WriteOutput -ENDIF - END SUBROUTINE UA_CopyOutput - - SUBROUTINE UA_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(UA_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'UA_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - END SUBROUTINE UA_DestroyOutput +subroutine UA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(UA_OutputType), intent(in) :: SrcOutputData + type(UA_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'UA_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + DstOutputData%Cn = SrcOutputData%Cn + DstOutputData%Cc = SrcOutputData%Cc + DstOutputData%Cm = SrcOutputData%Cm + DstOutputData%Cl = SrcOutputData%Cl + DstOutputData%Cd = SrcOutputData%Cd + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%WriteOutput = SrcOutputData%WriteOutput + else if (allocated(DstOutputData%WriteOutput)) then + deallocate(DstOutputData%WriteOutput) + end if +end subroutine +subroutine UA_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(UA_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'UA_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine subroutine UA_PackOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(UA_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'UA_PackOutput' if (Buf%ErrStat >= AbortErrLev) return - ! Cn call RegPack(Buf, InData%Cn) if (RegCheckErr(Buf, RoutineName)) return - ! Cc call RegPack(Buf, InData%Cc) if (RegCheckErr(Buf, RoutineName)) return - ! Cm call RegPack(Buf, InData%Cm) if (RegCheckErr(Buf, RoutineName)) return - ! Cl call RegPack(Buf, InData%Cl) if (RegCheckErr(Buf, RoutineName)) return - ! Cd call RegPack(Buf, InData%Cd) if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutput call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) @@ -3890,22 +3477,16 @@ subroutine UA_UnPackOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! Cn call RegUnpack(Buf, OutData%Cn) if (RegCheckErr(Buf, RoutineName)) return - ! Cc call RegUnpack(Buf, OutData%Cc) if (RegCheckErr(Buf, RoutineName)) return - ! Cm call RegUnpack(Buf, OutData%Cm) if (RegCheckErr(Buf, RoutineName)) return - ! Cl call RegUnpack(Buf, OutData%Cl) if (RegCheckErr(Buf, RoutineName)) return - ! Cd call RegUnpack(Buf, OutData%Cd) if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutput if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/aerodyn14/src/AeroDyn14_Types.f90 b/modules/aerodyn14/src/AeroDyn14_Types.f90 index 2a56e15b49..8fad99c412 100644 --- a/modules/aerodyn14/src/AeroDyn14_Types.f90 +++ b/modules/aerodyn14/src/AeroDyn14_Types.f90 @@ -470,59 +470,42 @@ MODULE AeroDyn14_Types END TYPE AD14_OutputType ! ======================= CONTAINS - SUBROUTINE AD14_CopyMarker( SrcMarkerData, DstMarkerData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Marker), INTENT(IN) :: SrcMarkerData - TYPE(Marker), INTENT(INOUT) :: DstMarkerData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_CopyMarker' -! - ErrStat = ErrID_None - ErrMsg = "" - DstMarkerData%Position = SrcMarkerData%Position - DstMarkerData%Orientation = SrcMarkerData%Orientation - DstMarkerData%TranslationVel = SrcMarkerData%TranslationVel - DstMarkerData%RotationVel = SrcMarkerData%RotationVel - END SUBROUTINE AD14_CopyMarker - - SUBROUTINE AD14_DestroyMarker( MarkerData, ErrStat, ErrMsg ) - TYPE(Marker), INTENT(INOUT) :: MarkerData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyMarker' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE AD14_DestroyMarker +subroutine AD14_CopyMarker(SrcMarkerData, DstMarkerData, CtrlCode, ErrStat, ErrMsg) + type(Marker), intent(in) :: SrcMarkerData + type(Marker), intent(inout) :: DstMarkerData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_CopyMarker' + ErrStat = ErrID_None + ErrMsg = '' + DstMarkerData%Position = SrcMarkerData%Position + DstMarkerData%Orientation = SrcMarkerData%Orientation + DstMarkerData%TranslationVel = SrcMarkerData%TranslationVel + DstMarkerData%RotationVel = SrcMarkerData%RotationVel +end subroutine +subroutine AD14_DestroyMarker(MarkerData, ErrStat, ErrMsg) + type(Marker), intent(inout) :: MarkerData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_DestroyMarker' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine AD14_PackMarker(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Marker), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackMarker' if (Buf%ErrStat >= AbortErrLev) return - ! Position call RegPack(Buf, InData%Position) if (RegCheckErr(Buf, RoutineName)) return - ! Orientation call RegPack(Buf, InData%Orientation) if (RegCheckErr(Buf, RoutineName)) return - ! TranslationVel call RegPack(Buf, InData%TranslationVel) if (RegCheckErr(Buf, RoutineName)) return - ! RotationVel call RegPack(Buf, InData%RotationVel) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -532,110 +515,92 @@ subroutine AD14_UnPackMarker(Buf, OutData) type(Marker), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackMarker' if (Buf%ErrStat /= ErrID_None) return - ! Position call RegUnpack(Buf, OutData%Position) if (RegCheckErr(Buf, RoutineName)) return - ! Orientation call RegUnpack(Buf, OutData%Orientation) if (RegCheckErr(Buf, RoutineName)) return - ! TranslationVel call RegUnpack(Buf, OutData%TranslationVel) if (RegCheckErr(Buf, RoutineName)) return - ! RotationVel call RegUnpack(Buf, OutData%RotationVel) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE AD14_CopyAeroConfig( SrcAeroConfigData, DstAeroConfigData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AeroConfig), INTENT(IN) :: SrcAeroConfigData - TYPE(AeroConfig), INTENT(INOUT) :: DstAeroConfigData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_CopyAeroConfig' -! + +subroutine AD14_CopyAeroConfig(SrcAeroConfigData, DstAeroConfigData, CtrlCode, ErrStat, ErrMsg) + type(AeroConfig), intent(in) :: SrcAeroConfigData + type(AeroConfig), intent(inout) :: DstAeroConfigData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD14_CopyAeroConfig' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcAeroConfigData%Blade)) THEN - i1_l = LBOUND(SrcAeroConfigData%Blade,1) - i1_u = UBOUND(SrcAeroConfigData%Blade,1) - IF (.NOT. ALLOCATED(DstAeroConfigData%Blade)) THEN - ALLOCATE(DstAeroConfigData%Blade(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroConfigData%Blade.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcAeroConfigData%Blade,1), UBOUND(SrcAeroConfigData%Blade,1) - CALL AD14_Copymarker( SrcAeroConfigData%Blade(i1), DstAeroConfigData%Blade(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL AD14_Copymarker( SrcAeroConfigData%Hub, DstAeroConfigData%Hub, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copymarker( SrcAeroConfigData%RotorFurl, DstAeroConfigData%RotorFurl, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copymarker( SrcAeroConfigData%Nacelle, DstAeroConfigData%Nacelle, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copymarker( SrcAeroConfigData%TailFin, DstAeroConfigData%TailFin, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copymarker( SrcAeroConfigData%Tower, DstAeroConfigData%Tower, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copymarker( SrcAeroConfigData%SubStructure, DstAeroConfigData%SubStructure, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copymarker( SrcAeroConfigData%Foundation, DstAeroConfigData%Foundation, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstAeroConfigData%BladeLength = SrcAeroConfigData%BladeLength - END SUBROUTINE AD14_CopyAeroConfig - - SUBROUTINE AD14_DestroyAeroConfig( AeroConfigData, ErrStat, ErrMsg ) - TYPE(AeroConfig), INTENT(INOUT) :: AeroConfigData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyAeroConfig' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(AeroConfigData%Blade)) THEN -DO i1 = LBOUND(AeroConfigData%Blade,1), UBOUND(AeroConfigData%Blade,1) - CALL AD14_DestroyMarker( AeroConfigData%Blade(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(AeroConfigData%Blade) -ENDIF - CALL AD14_DestroyMarker( AeroConfigData%Hub, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyMarker( AeroConfigData%RotorFurl, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyMarker( AeroConfigData%Nacelle, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyMarker( AeroConfigData%TailFin, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyMarker( AeroConfigData%Tower, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyMarker( AeroConfigData%SubStructure, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyMarker( AeroConfigData%Foundation, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD14_DestroyAeroConfig + ErrMsg = '' + if (allocated(SrcAeroConfigData%Blade)) then + LB(1:1) = lbound(SrcAeroConfigData%Blade) + UB(1:1) = ubound(SrcAeroConfigData%Blade) + if (.not. allocated(DstAeroConfigData%Blade)) then + allocate(DstAeroConfigData%Blade(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroConfigData%Blade.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD14_CopyMarker(SrcAeroConfigData%Blade(i1), DstAeroConfigData%Blade(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstAeroConfigData%Blade)) then + deallocate(DstAeroConfigData%Blade) + end if + call AD14_CopyMarker(SrcAeroConfigData%Hub, DstAeroConfigData%Hub, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyMarker(SrcAeroConfigData%RotorFurl, DstAeroConfigData%RotorFurl, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyMarker(SrcAeroConfigData%Nacelle, DstAeroConfigData%Nacelle, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyMarker(SrcAeroConfigData%TailFin, DstAeroConfigData%TailFin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyMarker(SrcAeroConfigData%Tower, DstAeroConfigData%Tower, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyMarker(SrcAeroConfigData%SubStructure, DstAeroConfigData%SubStructure, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyMarker(SrcAeroConfigData%Foundation, DstAeroConfigData%Foundation, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstAeroConfigData%BladeLength = SrcAeroConfigData%BladeLength +end subroutine +subroutine AD14_DestroyAeroConfig(AeroConfigData, ErrStat, ErrMsg) + type(AeroConfig), intent(inout) :: AeroConfigData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD14_DestroyAeroConfig' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(AeroConfigData%Blade)) then + LB(1:1) = lbound(AeroConfigData%Blade) + UB(1:1) = ubound(AeroConfigData%Blade) + do i1 = LB(1), UB(1) + call AD14_DestroyMarker(AeroConfigData%Blade(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(AeroConfigData%Blade) + end if +end subroutine subroutine AD14_PackAeroConfig(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -644,7 +609,6 @@ subroutine AD14_PackAeroConfig(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! Blade call RegPack(Buf, allocated(InData%Blade)) if (allocated(InData%Blade)) then call RegPackBounds(Buf, 1, lbound(InData%Blade), ubound(InData%Blade)) @@ -655,28 +619,20 @@ subroutine AD14_PackAeroConfig(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! Hub call AD14_PackMarker(Buf, InData%Hub) if (RegCheckErr(Buf, RoutineName)) return - ! RotorFurl call AD14_PackMarker(Buf, InData%RotorFurl) if (RegCheckErr(Buf, RoutineName)) return - ! Nacelle call AD14_PackMarker(Buf, InData%Nacelle) if (RegCheckErr(Buf, RoutineName)) return - ! TailFin call AD14_PackMarker(Buf, InData%TailFin) if (RegCheckErr(Buf, RoutineName)) return - ! Tower call AD14_PackMarker(Buf, InData%Tower) if (RegCheckErr(Buf, RoutineName)) return - ! SubStructure call AD14_PackMarker(Buf, InData%SubStructure) if (RegCheckErr(Buf, RoutineName)) return - ! Foundation call AD14_PackMarker(Buf, InData%Foundation) if (RegCheckErr(Buf, RoutineName)) return - ! BladeLength call RegPack(Buf, InData%BladeLength) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -690,7 +646,6 @@ subroutine AD14_UnPackAeroConfig(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! Blade if (allocated(OutData%Blade)) deallocate(OutData%Blade) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -706,172 +661,140 @@ subroutine AD14_UnPackAeroConfig(Buf, OutData) call AD14_UnpackMarker(Buf, OutData%Blade(i1)) ! Blade end do end if - ! Hub call AD14_UnpackMarker(Buf, OutData%Hub) ! Hub - ! RotorFurl call AD14_UnpackMarker(Buf, OutData%RotorFurl) ! RotorFurl - ! Nacelle call AD14_UnpackMarker(Buf, OutData%Nacelle) ! Nacelle - ! TailFin call AD14_UnpackMarker(Buf, OutData%TailFin) ! TailFin - ! Tower call AD14_UnpackMarker(Buf, OutData%Tower) ! Tower - ! SubStructure call AD14_UnpackMarker(Buf, OutData%SubStructure) ! SubStructure - ! Foundation call AD14_UnpackMarker(Buf, OutData%Foundation) ! Foundation - ! BladeLength call RegUnpack(Buf, OutData%BladeLength) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE AD14_CopyAirFoil( SrcAirFoilData, DstAirFoilData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AirFoil), INTENT(IN) :: SrcAirFoilData - TYPE(AirFoil), INTENT(INOUT) :: DstAirFoilData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_CopyAirFoil' -! + +subroutine AD14_CopyAirFoil(SrcAirFoilData, DstAirFoilData, CtrlCode, ErrStat, ErrMsg) + type(AirFoil), intent(in) :: SrcAirFoilData + type(AirFoil), intent(inout) :: DstAirFoilData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AD14_CopyAirFoil' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcAirFoilData%AL)) THEN - i1_l = LBOUND(SrcAirFoilData%AL,1) - i1_u = UBOUND(SrcAirFoilData%AL,1) - i2_l = LBOUND(SrcAirFoilData%AL,2) - i2_u = UBOUND(SrcAirFoilData%AL,2) - IF (.NOT. ALLOCATED(DstAirFoilData%AL)) THEN - ALLOCATE(DstAirFoilData%AL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAirFoilData%AL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstAirFoilData%AL = SrcAirFoilData%AL -ENDIF -IF (ALLOCATED(SrcAirFoilData%CD)) THEN - i1_l = LBOUND(SrcAirFoilData%CD,1) - i1_u = UBOUND(SrcAirFoilData%CD,1) - i2_l = LBOUND(SrcAirFoilData%CD,2) - i2_u = UBOUND(SrcAirFoilData%CD,2) - i3_l = LBOUND(SrcAirFoilData%CD,3) - i3_u = UBOUND(SrcAirFoilData%CD,3) - IF (.NOT. ALLOCATED(DstAirFoilData%CD)) THEN - ALLOCATE(DstAirFoilData%CD(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAirFoilData%CD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstAirFoilData%CD = SrcAirFoilData%CD -ENDIF -IF (ALLOCATED(SrcAirFoilData%CL)) THEN - i1_l = LBOUND(SrcAirFoilData%CL,1) - i1_u = UBOUND(SrcAirFoilData%CL,1) - i2_l = LBOUND(SrcAirFoilData%CL,2) - i2_u = UBOUND(SrcAirFoilData%CL,2) - i3_l = LBOUND(SrcAirFoilData%CL,3) - i3_u = UBOUND(SrcAirFoilData%CL,3) - IF (.NOT. ALLOCATED(DstAirFoilData%CL)) THEN - ALLOCATE(DstAirFoilData%CL(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAirFoilData%CL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstAirFoilData%CL = SrcAirFoilData%CL -ENDIF -IF (ALLOCATED(SrcAirFoilData%CM)) THEN - i1_l = LBOUND(SrcAirFoilData%CM,1) - i1_u = UBOUND(SrcAirFoilData%CM,1) - i2_l = LBOUND(SrcAirFoilData%CM,2) - i2_u = UBOUND(SrcAirFoilData%CM,2) - i3_l = LBOUND(SrcAirFoilData%CM,3) - i3_u = UBOUND(SrcAirFoilData%CM,3) - IF (.NOT. ALLOCATED(DstAirFoilData%CM)) THEN - ALLOCATE(DstAirFoilData%CM(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAirFoilData%CM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstAirFoilData%CM = SrcAirFoilData%CM -ENDIF - DstAirFoilData%PMC = SrcAirFoilData%PMC - DstAirFoilData%MulTabLoc = SrcAirFoilData%MulTabLoc - END SUBROUTINE AD14_CopyAirFoil - - SUBROUTINE AD14_DestroyAirFoil( AirFoilData, ErrStat, ErrMsg ) - TYPE(AirFoil), INTENT(INOUT) :: AirFoilData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyAirFoil' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(AirFoilData%AL)) THEN - DEALLOCATE(AirFoilData%AL) -ENDIF -IF (ALLOCATED(AirFoilData%CD)) THEN - DEALLOCATE(AirFoilData%CD) -ENDIF -IF (ALLOCATED(AirFoilData%CL)) THEN - DEALLOCATE(AirFoilData%CL) -ENDIF -IF (ALLOCATED(AirFoilData%CM)) THEN - DEALLOCATE(AirFoilData%CM) -ENDIF - END SUBROUTINE AD14_DestroyAirFoil + ErrMsg = '' + if (allocated(SrcAirFoilData%AL)) then + LB(1:2) = lbound(SrcAirFoilData%AL) + UB(1:2) = ubound(SrcAirFoilData%AL) + if (.not. allocated(DstAirFoilData%AL)) then + allocate(DstAirFoilData%AL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAirFoilData%AL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAirFoilData%AL = SrcAirFoilData%AL + else if (allocated(DstAirFoilData%AL)) then + deallocate(DstAirFoilData%AL) + end if + if (allocated(SrcAirFoilData%CD)) then + LB(1:3) = lbound(SrcAirFoilData%CD) + UB(1:3) = ubound(SrcAirFoilData%CD) + if (.not. allocated(DstAirFoilData%CD)) then + allocate(DstAirFoilData%CD(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAirFoilData%CD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAirFoilData%CD = SrcAirFoilData%CD + else if (allocated(DstAirFoilData%CD)) then + deallocate(DstAirFoilData%CD) + end if + if (allocated(SrcAirFoilData%CL)) then + LB(1:3) = lbound(SrcAirFoilData%CL) + UB(1:3) = ubound(SrcAirFoilData%CL) + if (.not. allocated(DstAirFoilData%CL)) then + allocate(DstAirFoilData%CL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAirFoilData%CL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAirFoilData%CL = SrcAirFoilData%CL + else if (allocated(DstAirFoilData%CL)) then + deallocate(DstAirFoilData%CL) + end if + if (allocated(SrcAirFoilData%CM)) then + LB(1:3) = lbound(SrcAirFoilData%CM) + UB(1:3) = ubound(SrcAirFoilData%CM) + if (.not. allocated(DstAirFoilData%CM)) then + allocate(DstAirFoilData%CM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAirFoilData%CM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAirFoilData%CM = SrcAirFoilData%CM + else if (allocated(DstAirFoilData%CM)) then + deallocate(DstAirFoilData%CM) + end if + DstAirFoilData%PMC = SrcAirFoilData%PMC + DstAirFoilData%MulTabLoc = SrcAirFoilData%MulTabLoc +end subroutine +subroutine AD14_DestroyAirFoil(AirFoilData, ErrStat, ErrMsg) + type(AirFoil), intent(inout) :: AirFoilData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_DestroyAirFoil' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(AirFoilData%AL)) then + deallocate(AirFoilData%AL) + end if + if (allocated(AirFoilData%CD)) then + deallocate(AirFoilData%CD) + end if + if (allocated(AirFoilData%CL)) then + deallocate(AirFoilData%CL) + end if + if (allocated(AirFoilData%CM)) then + deallocate(AirFoilData%CM) + end if +end subroutine subroutine AD14_PackAirFoil(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AirFoil), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackAirFoil' if (Buf%ErrStat >= AbortErrLev) return - ! AL call RegPack(Buf, allocated(InData%AL)) if (allocated(InData%AL)) then call RegPackBounds(Buf, 2, lbound(InData%AL), ubound(InData%AL)) call RegPack(Buf, InData%AL) end if if (RegCheckErr(Buf, RoutineName)) return - ! CD call RegPack(Buf, allocated(InData%CD)) if (allocated(InData%CD)) then call RegPackBounds(Buf, 3, lbound(InData%CD), ubound(InData%CD)) call RegPack(Buf, InData%CD) end if if (RegCheckErr(Buf, RoutineName)) return - ! CL call RegPack(Buf, allocated(InData%CL)) if (allocated(InData%CL)) then call RegPackBounds(Buf, 3, lbound(InData%CL), ubound(InData%CL)) call RegPack(Buf, InData%CL) end if if (RegCheckErr(Buf, RoutineName)) return - ! CM call RegPack(Buf, allocated(InData%CM)) if (allocated(InData%CM)) then call RegPackBounds(Buf, 3, lbound(InData%CM), ubound(InData%CM)) call RegPack(Buf, InData%CM) end if if (RegCheckErr(Buf, RoutineName)) return - ! PMC call RegPack(Buf, InData%PMC) if (RegCheckErr(Buf, RoutineName)) return - ! MulTabLoc call RegPack(Buf, InData%MulTabLoc) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -884,7 +807,6 @@ subroutine AD14_UnPackAirFoil(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! AL if (allocated(OutData%AL)) deallocate(OutData%AL) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -899,7 +821,6 @@ subroutine AD14_UnPackAirFoil(Buf, OutData) call RegUnpack(Buf, OutData%AL) if (RegCheckErr(Buf, RoutineName)) return end if - ! CD if (allocated(OutData%CD)) deallocate(OutData%CD) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -914,7 +835,6 @@ subroutine AD14_UnPackAirFoil(Buf, OutData) call RegUnpack(Buf, OutData%CD) if (RegCheckErr(Buf, RoutineName)) return end if - ! CL if (allocated(OutData%CL)) deallocate(OutData%CL) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -929,7 +849,6 @@ subroutine AD14_UnPackAirFoil(Buf, OutData) call RegUnpack(Buf, OutData%CL) if (RegCheckErr(Buf, RoutineName)) return end if - ! CM if (allocated(OutData%CM)) deallocate(OutData%CM) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -944,170 +863,157 @@ subroutine AD14_UnPackAirFoil(Buf, OutData) call RegUnpack(Buf, OutData%CM) if (RegCheckErr(Buf, RoutineName)) return end if - ! PMC call RegUnpack(Buf, OutData%PMC) if (RegCheckErr(Buf, RoutineName)) return - ! MulTabLoc call RegUnpack(Buf, OutData%MulTabLoc) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE AD14_CopyAirFoilParms( SrcAirFoilParmsData, DstAirFoilParmsData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AirFoilParms), INTENT(IN) :: SrcAirFoilParmsData - TYPE(AirFoilParms), INTENT(INOUT) :: DstAirFoilParmsData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_CopyAirFoilParms' -! + +subroutine AD14_CopyAirFoilParms(SrcAirFoilParmsData, DstAirFoilParmsData, CtrlCode, ErrStat, ErrMsg) + type(AirFoilParms), intent(in) :: SrcAirFoilParmsData + type(AirFoilParms), intent(inout) :: DstAirFoilParmsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AD14_CopyAirFoilParms' ErrStat = ErrID_None - ErrMsg = "" - DstAirFoilParmsData%MaxTable = SrcAirFoilParmsData%MaxTable -IF (ALLOCATED(SrcAirFoilParmsData%NTables)) THEN - i1_l = LBOUND(SrcAirFoilParmsData%NTables,1) - i1_u = UBOUND(SrcAirFoilParmsData%NTables,1) - IF (.NOT. ALLOCATED(DstAirFoilParmsData%NTables)) THEN - ALLOCATE(DstAirFoilParmsData%NTables(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAirFoilParmsData%NTables.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstAirFoilParmsData%NTables = SrcAirFoilParmsData%NTables -ENDIF -IF (ALLOCATED(SrcAirFoilParmsData%NLift)) THEN - i1_l = LBOUND(SrcAirFoilParmsData%NLift,1) - i1_u = UBOUND(SrcAirFoilParmsData%NLift,1) - IF (.NOT. ALLOCATED(DstAirFoilParmsData%NLift)) THEN - ALLOCATE(DstAirFoilParmsData%NLift(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAirFoilParmsData%NLift.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstAirFoilParmsData%NLift = SrcAirFoilParmsData%NLift -ENDIF - DstAirFoilParmsData%NumCL = SrcAirFoilParmsData%NumCL - DstAirFoilParmsData%NumFoil = SrcAirFoilParmsData%NumFoil -IF (ALLOCATED(SrcAirFoilParmsData%NFoil)) THEN - i1_l = LBOUND(SrcAirFoilParmsData%NFoil,1) - i1_u = UBOUND(SrcAirFoilParmsData%NFoil,1) - IF (.NOT. ALLOCATED(DstAirFoilParmsData%NFoil)) THEN - ALLOCATE(DstAirFoilParmsData%NFoil(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAirFoilParmsData%NFoil.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstAirFoilParmsData%NFoil = SrcAirFoilParmsData%NFoil -ENDIF -IF (ALLOCATED(SrcAirFoilParmsData%MulTabMet)) THEN - i1_l = LBOUND(SrcAirFoilParmsData%MulTabMet,1) - i1_u = UBOUND(SrcAirFoilParmsData%MulTabMet,1) - i2_l = LBOUND(SrcAirFoilParmsData%MulTabMet,2) - i2_u = UBOUND(SrcAirFoilParmsData%MulTabMet,2) - IF (.NOT. ALLOCATED(DstAirFoilParmsData%MulTabMet)) THEN - ALLOCATE(DstAirFoilParmsData%MulTabMet(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAirFoilParmsData%MulTabMet.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstAirFoilParmsData%MulTabMet = SrcAirFoilParmsData%MulTabMet -ENDIF -IF (ALLOCATED(SrcAirFoilParmsData%FoilNm)) THEN - i1_l = LBOUND(SrcAirFoilParmsData%FoilNm,1) - i1_u = UBOUND(SrcAirFoilParmsData%FoilNm,1) - IF (.NOT. ALLOCATED(DstAirFoilParmsData%FoilNm)) THEN - ALLOCATE(DstAirFoilParmsData%FoilNm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAirFoilParmsData%FoilNm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstAirFoilParmsData%FoilNm = SrcAirFoilParmsData%FoilNm -ENDIF - END SUBROUTINE AD14_CopyAirFoilParms - - SUBROUTINE AD14_DestroyAirFoilParms( AirFoilParmsData, ErrStat, ErrMsg ) - TYPE(AirFoilParms), INTENT(INOUT) :: AirFoilParmsData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyAirFoilParms' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(AirFoilParmsData%NTables)) THEN - DEALLOCATE(AirFoilParmsData%NTables) -ENDIF -IF (ALLOCATED(AirFoilParmsData%NLift)) THEN - DEALLOCATE(AirFoilParmsData%NLift) -ENDIF -IF (ALLOCATED(AirFoilParmsData%NFoil)) THEN - DEALLOCATE(AirFoilParmsData%NFoil) -ENDIF -IF (ALLOCATED(AirFoilParmsData%MulTabMet)) THEN - DEALLOCATE(AirFoilParmsData%MulTabMet) -ENDIF -IF (ALLOCATED(AirFoilParmsData%FoilNm)) THEN - DEALLOCATE(AirFoilParmsData%FoilNm) -ENDIF - END SUBROUTINE AD14_DestroyAirFoilParms + ErrMsg = '' + DstAirFoilParmsData%MaxTable = SrcAirFoilParmsData%MaxTable + if (allocated(SrcAirFoilParmsData%NTables)) then + LB(1:1) = lbound(SrcAirFoilParmsData%NTables) + UB(1:1) = ubound(SrcAirFoilParmsData%NTables) + if (.not. allocated(DstAirFoilParmsData%NTables)) then + allocate(DstAirFoilParmsData%NTables(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAirFoilParmsData%NTables.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAirFoilParmsData%NTables = SrcAirFoilParmsData%NTables + else if (allocated(DstAirFoilParmsData%NTables)) then + deallocate(DstAirFoilParmsData%NTables) + end if + if (allocated(SrcAirFoilParmsData%NLift)) then + LB(1:1) = lbound(SrcAirFoilParmsData%NLift) + UB(1:1) = ubound(SrcAirFoilParmsData%NLift) + if (.not. allocated(DstAirFoilParmsData%NLift)) then + allocate(DstAirFoilParmsData%NLift(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAirFoilParmsData%NLift.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAirFoilParmsData%NLift = SrcAirFoilParmsData%NLift + else if (allocated(DstAirFoilParmsData%NLift)) then + deallocate(DstAirFoilParmsData%NLift) + end if + DstAirFoilParmsData%NumCL = SrcAirFoilParmsData%NumCL + DstAirFoilParmsData%NumFoil = SrcAirFoilParmsData%NumFoil + if (allocated(SrcAirFoilParmsData%NFoil)) then + LB(1:1) = lbound(SrcAirFoilParmsData%NFoil) + UB(1:1) = ubound(SrcAirFoilParmsData%NFoil) + if (.not. allocated(DstAirFoilParmsData%NFoil)) then + allocate(DstAirFoilParmsData%NFoil(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAirFoilParmsData%NFoil.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAirFoilParmsData%NFoil = SrcAirFoilParmsData%NFoil + else if (allocated(DstAirFoilParmsData%NFoil)) then + deallocate(DstAirFoilParmsData%NFoil) + end if + if (allocated(SrcAirFoilParmsData%MulTabMet)) then + LB(1:2) = lbound(SrcAirFoilParmsData%MulTabMet) + UB(1:2) = ubound(SrcAirFoilParmsData%MulTabMet) + if (.not. allocated(DstAirFoilParmsData%MulTabMet)) then + allocate(DstAirFoilParmsData%MulTabMet(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAirFoilParmsData%MulTabMet.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAirFoilParmsData%MulTabMet = SrcAirFoilParmsData%MulTabMet + else if (allocated(DstAirFoilParmsData%MulTabMet)) then + deallocate(DstAirFoilParmsData%MulTabMet) + end if + if (allocated(SrcAirFoilParmsData%FoilNm)) then + LB(1:1) = lbound(SrcAirFoilParmsData%FoilNm) + UB(1:1) = ubound(SrcAirFoilParmsData%FoilNm) + if (.not. allocated(DstAirFoilParmsData%FoilNm)) then + allocate(DstAirFoilParmsData%FoilNm(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAirFoilParmsData%FoilNm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAirFoilParmsData%FoilNm = SrcAirFoilParmsData%FoilNm + else if (allocated(DstAirFoilParmsData%FoilNm)) then + deallocate(DstAirFoilParmsData%FoilNm) + end if +end subroutine +subroutine AD14_DestroyAirFoilParms(AirFoilParmsData, ErrStat, ErrMsg) + type(AirFoilParms), intent(inout) :: AirFoilParmsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_DestroyAirFoilParms' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(AirFoilParmsData%NTables)) then + deallocate(AirFoilParmsData%NTables) + end if + if (allocated(AirFoilParmsData%NLift)) then + deallocate(AirFoilParmsData%NLift) + end if + if (allocated(AirFoilParmsData%NFoil)) then + deallocate(AirFoilParmsData%NFoil) + end if + if (allocated(AirFoilParmsData%MulTabMet)) then + deallocate(AirFoilParmsData%MulTabMet) + end if + if (allocated(AirFoilParmsData%FoilNm)) then + deallocate(AirFoilParmsData%FoilNm) + end if +end subroutine subroutine AD14_PackAirFoilParms(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AirFoilParms), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackAirFoilParms' if (Buf%ErrStat >= AbortErrLev) return - ! MaxTable call RegPack(Buf, InData%MaxTable) if (RegCheckErr(Buf, RoutineName)) return - ! NTables call RegPack(Buf, allocated(InData%NTables)) if (allocated(InData%NTables)) then call RegPackBounds(Buf, 1, lbound(InData%NTables), ubound(InData%NTables)) call RegPack(Buf, InData%NTables) end if if (RegCheckErr(Buf, RoutineName)) return - ! NLift call RegPack(Buf, allocated(InData%NLift)) if (allocated(InData%NLift)) then call RegPackBounds(Buf, 1, lbound(InData%NLift), ubound(InData%NLift)) call RegPack(Buf, InData%NLift) end if if (RegCheckErr(Buf, RoutineName)) return - ! NumCL call RegPack(Buf, InData%NumCL) if (RegCheckErr(Buf, RoutineName)) return - ! NumFoil call RegPack(Buf, InData%NumFoil) if (RegCheckErr(Buf, RoutineName)) return - ! NFoil call RegPack(Buf, allocated(InData%NFoil)) if (allocated(InData%NFoil)) then call RegPackBounds(Buf, 1, lbound(InData%NFoil), ubound(InData%NFoil)) call RegPack(Buf, InData%NFoil) end if if (RegCheckErr(Buf, RoutineName)) return - ! MulTabMet call RegPack(Buf, allocated(InData%MulTabMet)) if (allocated(InData%MulTabMet)) then call RegPackBounds(Buf, 2, lbound(InData%MulTabMet), ubound(InData%MulTabMet)) call RegPack(Buf, InData%MulTabMet) end if if (RegCheckErr(Buf, RoutineName)) return - ! FoilNm call RegPack(Buf, allocated(InData%FoilNm)) if (allocated(InData%FoilNm)) then call RegPackBounds(Buf, 1, lbound(InData%FoilNm), ubound(InData%FoilNm)) @@ -1124,10 +1030,8 @@ subroutine AD14_UnPackAirFoilParms(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! MaxTable call RegUnpack(Buf, OutData%MaxTable) if (RegCheckErr(Buf, RoutineName)) return - ! NTables if (allocated(OutData%NTables)) deallocate(OutData%NTables) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1142,7 +1046,6 @@ subroutine AD14_UnPackAirFoilParms(Buf, OutData) call RegUnpack(Buf, OutData%NTables) if (RegCheckErr(Buf, RoutineName)) return end if - ! NLift if (allocated(OutData%NLift)) deallocate(OutData%NLift) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1157,13 +1060,10 @@ subroutine AD14_UnPackAirFoilParms(Buf, OutData) call RegUnpack(Buf, OutData%NLift) if (RegCheckErr(Buf, RoutineName)) return end if - ! NumCL call RegUnpack(Buf, OutData%NumCL) if (RegCheckErr(Buf, RoutineName)) return - ! NumFoil call RegUnpack(Buf, OutData%NumFoil) if (RegCheckErr(Buf, RoutineName)) return - ! NFoil if (allocated(OutData%NFoil)) deallocate(OutData%NFoil) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1178,7 +1078,6 @@ subroutine AD14_UnPackAirFoilParms(Buf, OutData) call RegUnpack(Buf, OutData%NFoil) if (RegCheckErr(Buf, RoutineName)) return end if - ! MulTabMet if (allocated(OutData%MulTabMet)) deallocate(OutData%MulTabMet) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1193,7 +1092,6 @@ subroutine AD14_UnPackAirFoilParms(Buf, OutData) call RegUnpack(Buf, OutData%MulTabMet) if (RegCheckErr(Buf, RoutineName)) return end if - ! FoilNm if (allocated(OutData%FoilNm)) deallocate(OutData%FoilNm) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1209,1348 +1107,1267 @@ subroutine AD14_UnPackAirFoilParms(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE AD14_CopyBeddoes( SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Beddoes), INTENT(IN) :: SrcBeddoesData - TYPE(Beddoes), INTENT(INOUT) :: DstBeddoesData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_CopyBeddoes' -! + +subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, ErrMsg) + type(Beddoes), intent(in) :: SrcBeddoesData + type(Beddoes), intent(inout) :: DstBeddoesData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AD14_CopyBeddoes' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcBeddoesData%ADOT)) THEN - i1_l = LBOUND(SrcBeddoesData%ADOT,1) - i1_u = UBOUND(SrcBeddoesData%ADOT,1) - i2_l = LBOUND(SrcBeddoesData%ADOT,2) - i2_u = UBOUND(SrcBeddoesData%ADOT,2) - IF (.NOT. ALLOCATED(DstBeddoesData%ADOT)) THEN - ALLOCATE(DstBeddoesData%ADOT(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%ADOT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%ADOT = SrcBeddoesData%ADOT -ENDIF -IF (ALLOCATED(SrcBeddoesData%ADOT1)) THEN - i1_l = LBOUND(SrcBeddoesData%ADOT1,1) - i1_u = UBOUND(SrcBeddoesData%ADOT1,1) - i2_l = LBOUND(SrcBeddoesData%ADOT1,2) - i2_u = UBOUND(SrcBeddoesData%ADOT1,2) - IF (.NOT. ALLOCATED(DstBeddoesData%ADOT1)) THEN - ALLOCATE(DstBeddoesData%ADOT1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%ADOT1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%ADOT1 = SrcBeddoesData%ADOT1 -ENDIF -IF (ALLOCATED(SrcBeddoesData%AFE)) THEN - i1_l = LBOUND(SrcBeddoesData%AFE,1) - i1_u = UBOUND(SrcBeddoesData%AFE,1) - i2_l = LBOUND(SrcBeddoesData%AFE,2) - i2_u = UBOUND(SrcBeddoesData%AFE,2) - IF (.NOT. ALLOCATED(DstBeddoesData%AFE)) THEN - ALLOCATE(DstBeddoesData%AFE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%AFE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%AFE = SrcBeddoesData%AFE -ENDIF -IF (ALLOCATED(SrcBeddoesData%AFE1)) THEN - i1_l = LBOUND(SrcBeddoesData%AFE1,1) - i1_u = UBOUND(SrcBeddoesData%AFE1,1) - i2_l = LBOUND(SrcBeddoesData%AFE1,2) - i2_u = UBOUND(SrcBeddoesData%AFE1,2) - IF (.NOT. ALLOCATED(DstBeddoesData%AFE1)) THEN - ALLOCATE(DstBeddoesData%AFE1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%AFE1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%AFE1 = SrcBeddoesData%AFE1 -ENDIF - DstBeddoesData%AN = SrcBeddoesData%AN -IF (ALLOCATED(SrcBeddoesData%ANE)) THEN - i1_l = LBOUND(SrcBeddoesData%ANE,1) - i1_u = UBOUND(SrcBeddoesData%ANE,1) - i2_l = LBOUND(SrcBeddoesData%ANE,2) - i2_u = UBOUND(SrcBeddoesData%ANE,2) - IF (.NOT. ALLOCATED(DstBeddoesData%ANE)) THEN - ALLOCATE(DstBeddoesData%ANE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%ANE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%ANE = SrcBeddoesData%ANE -ENDIF -IF (ALLOCATED(SrcBeddoesData%ANE1)) THEN - i1_l = LBOUND(SrcBeddoesData%ANE1,1) - i1_u = UBOUND(SrcBeddoesData%ANE1,1) - i2_l = LBOUND(SrcBeddoesData%ANE1,2) - i2_u = UBOUND(SrcBeddoesData%ANE1,2) - IF (.NOT. ALLOCATED(DstBeddoesData%ANE1)) THEN - ALLOCATE(DstBeddoesData%ANE1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%ANE1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%ANE1 = SrcBeddoesData%ANE1 -ENDIF -IF (ALLOCATED(SrcBeddoesData%AOD)) THEN - i1_l = LBOUND(SrcBeddoesData%AOD,1) - i1_u = UBOUND(SrcBeddoesData%AOD,1) - i2_l = LBOUND(SrcBeddoesData%AOD,2) - i2_u = UBOUND(SrcBeddoesData%AOD,2) - IF (.NOT. ALLOCATED(DstBeddoesData%AOD)) THEN - ALLOCATE(DstBeddoesData%AOD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%AOD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%AOD = SrcBeddoesData%AOD -ENDIF -IF (ALLOCATED(SrcBeddoesData%AOL)) THEN - i1_l = LBOUND(SrcBeddoesData%AOL,1) - i1_u = UBOUND(SrcBeddoesData%AOL,1) - i2_l = LBOUND(SrcBeddoesData%AOL,2) - i2_u = UBOUND(SrcBeddoesData%AOL,2) - IF (.NOT. ALLOCATED(DstBeddoesData%AOL)) THEN - ALLOCATE(DstBeddoesData%AOL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%AOL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%AOL = SrcBeddoesData%AOL -ENDIF -IF (ALLOCATED(SrcBeddoesData%BEDSEP)) THEN - i1_l = LBOUND(SrcBeddoesData%BEDSEP,1) - i1_u = UBOUND(SrcBeddoesData%BEDSEP,1) - i2_l = LBOUND(SrcBeddoesData%BEDSEP,2) - i2_u = UBOUND(SrcBeddoesData%BEDSEP,2) - IF (.NOT. ALLOCATED(DstBeddoesData%BEDSEP)) THEN - ALLOCATE(DstBeddoesData%BEDSEP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%BEDSEP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%BEDSEP = SrcBeddoesData%BEDSEP -ENDIF -IF (ALLOCATED(SrcBeddoesData%OLDSEP)) THEN - i1_l = LBOUND(SrcBeddoesData%OLDSEP,1) - i1_u = UBOUND(SrcBeddoesData%OLDSEP,1) - i2_l = LBOUND(SrcBeddoesData%OLDSEP,2) - i2_u = UBOUND(SrcBeddoesData%OLDSEP,2) - IF (.NOT. ALLOCATED(DstBeddoesData%OLDSEP)) THEN - ALLOCATE(DstBeddoesData%OLDSEP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDSEP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%OLDSEP = SrcBeddoesData%OLDSEP -ENDIF - DstBeddoesData%CC = SrcBeddoesData%CC -IF (ALLOCATED(SrcBeddoesData%CDO)) THEN - i1_l = LBOUND(SrcBeddoesData%CDO,1) - i1_u = UBOUND(SrcBeddoesData%CDO,1) - i2_l = LBOUND(SrcBeddoesData%CDO,2) - i2_u = UBOUND(SrcBeddoesData%CDO,2) - IF (.NOT. ALLOCATED(DstBeddoesData%CDO)) THEN - ALLOCATE(DstBeddoesData%CDO(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CDO.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%CDO = SrcBeddoesData%CDO -ENDIF - DstBeddoesData%CMI = SrcBeddoesData%CMI - DstBeddoesData%CMQ = SrcBeddoesData%CMQ - DstBeddoesData%CN = SrcBeddoesData%CN -IF (ALLOCATED(SrcBeddoesData%CNA)) THEN - i1_l = LBOUND(SrcBeddoesData%CNA,1) - i1_u = UBOUND(SrcBeddoesData%CNA,1) - i2_l = LBOUND(SrcBeddoesData%CNA,2) - i2_u = UBOUND(SrcBeddoesData%CNA,2) - IF (.NOT. ALLOCATED(DstBeddoesData%CNA)) THEN - ALLOCATE(DstBeddoesData%CNA(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%CNA = SrcBeddoesData%CNA -ENDIF - DstBeddoesData%CNCP = SrcBeddoesData%CNCP - DstBeddoesData%CNIQ = SrcBeddoesData%CNIQ -IF (ALLOCATED(SrcBeddoesData%CNP)) THEN - i1_l = LBOUND(SrcBeddoesData%CNP,1) - i1_u = UBOUND(SrcBeddoesData%CNP,1) - i2_l = LBOUND(SrcBeddoesData%CNP,2) - i2_u = UBOUND(SrcBeddoesData%CNP,2) - IF (.NOT. ALLOCATED(DstBeddoesData%CNP)) THEN - ALLOCATE(DstBeddoesData%CNP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%CNP = SrcBeddoesData%CNP -ENDIF -IF (ALLOCATED(SrcBeddoesData%CNP1)) THEN - i1_l = LBOUND(SrcBeddoesData%CNP1,1) - i1_u = UBOUND(SrcBeddoesData%CNP1,1) - i2_l = LBOUND(SrcBeddoesData%CNP1,2) - i2_u = UBOUND(SrcBeddoesData%CNP1,2) - IF (.NOT. ALLOCATED(DstBeddoesData%CNP1)) THEN - ALLOCATE(DstBeddoesData%CNP1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNP1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%CNP1 = SrcBeddoesData%CNP1 -ENDIF -IF (ALLOCATED(SrcBeddoesData%CNPD)) THEN - i1_l = LBOUND(SrcBeddoesData%CNPD,1) - i1_u = UBOUND(SrcBeddoesData%CNPD,1) - i2_l = LBOUND(SrcBeddoesData%CNPD,2) - i2_u = UBOUND(SrcBeddoesData%CNPD,2) - IF (.NOT. ALLOCATED(DstBeddoesData%CNPD)) THEN - ALLOCATE(DstBeddoesData%CNPD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNPD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%CNPD = SrcBeddoesData%CNPD -ENDIF -IF (ALLOCATED(SrcBeddoesData%CNPD1)) THEN - i1_l = LBOUND(SrcBeddoesData%CNPD1,1) - i1_u = UBOUND(SrcBeddoesData%CNPD1,1) - i2_l = LBOUND(SrcBeddoesData%CNPD1,2) - i2_u = UBOUND(SrcBeddoesData%CNPD1,2) - IF (.NOT. ALLOCATED(DstBeddoesData%CNPD1)) THEN - ALLOCATE(DstBeddoesData%CNPD1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNPD1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%CNPD1 = SrcBeddoesData%CNPD1 -ENDIF -IF (ALLOCATED(SrcBeddoesData%CNPOT)) THEN - i1_l = LBOUND(SrcBeddoesData%CNPOT,1) - i1_u = UBOUND(SrcBeddoesData%CNPOT,1) - i2_l = LBOUND(SrcBeddoesData%CNPOT,2) - i2_u = UBOUND(SrcBeddoesData%CNPOT,2) - IF (.NOT. ALLOCATED(DstBeddoesData%CNPOT)) THEN - ALLOCATE(DstBeddoesData%CNPOT(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNPOT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%CNPOT = SrcBeddoesData%CNPOT -ENDIF -IF (ALLOCATED(SrcBeddoesData%CNPOT1)) THEN - i1_l = LBOUND(SrcBeddoesData%CNPOT1,1) - i1_u = UBOUND(SrcBeddoesData%CNPOT1,1) - i2_l = LBOUND(SrcBeddoesData%CNPOT1,2) - i2_u = UBOUND(SrcBeddoesData%CNPOT1,2) - IF (.NOT. ALLOCATED(DstBeddoesData%CNPOT1)) THEN - ALLOCATE(DstBeddoesData%CNPOT1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNPOT1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%CNPOT1 = SrcBeddoesData%CNPOT1 -ENDIF -IF (ALLOCATED(SrcBeddoesData%CNS)) THEN - i1_l = LBOUND(SrcBeddoesData%CNS,1) - i1_u = UBOUND(SrcBeddoesData%CNS,1) - i2_l = LBOUND(SrcBeddoesData%CNS,2) - i2_u = UBOUND(SrcBeddoesData%CNS,2) - IF (.NOT. ALLOCATED(DstBeddoesData%CNS)) THEN - ALLOCATE(DstBeddoesData%CNS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%CNS = SrcBeddoesData%CNS -ENDIF -IF (ALLOCATED(SrcBeddoesData%CNSL)) THEN - i1_l = LBOUND(SrcBeddoesData%CNSL,1) - i1_u = UBOUND(SrcBeddoesData%CNSL,1) - i2_l = LBOUND(SrcBeddoesData%CNSL,2) - i2_u = UBOUND(SrcBeddoesData%CNSL,2) - IF (.NOT. ALLOCATED(DstBeddoesData%CNSL)) THEN - ALLOCATE(DstBeddoesData%CNSL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNSL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%CNSL = SrcBeddoesData%CNSL -ENDIF -IF (ALLOCATED(SrcBeddoesData%CNV)) THEN - i1_l = LBOUND(SrcBeddoesData%CNV,1) - i1_u = UBOUND(SrcBeddoesData%CNV,1) - i2_l = LBOUND(SrcBeddoesData%CNV,2) - i2_u = UBOUND(SrcBeddoesData%CNV,2) - IF (.NOT. ALLOCATED(DstBeddoesData%CNV)) THEN - ALLOCATE(DstBeddoesData%CNV(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%CNV = SrcBeddoesData%CNV -ENDIF -IF (ALLOCATED(SrcBeddoesData%CVN)) THEN - i1_l = LBOUND(SrcBeddoesData%CVN,1) - i1_u = UBOUND(SrcBeddoesData%CVN,1) - i2_l = LBOUND(SrcBeddoesData%CVN,2) - i2_u = UBOUND(SrcBeddoesData%CVN,2) - IF (.NOT. ALLOCATED(DstBeddoesData%CVN)) THEN - ALLOCATE(DstBeddoesData%CVN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CVN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%CVN = SrcBeddoesData%CVN -ENDIF -IF (ALLOCATED(SrcBeddoesData%CVN1)) THEN - i1_l = LBOUND(SrcBeddoesData%CVN1,1) - i1_u = UBOUND(SrcBeddoesData%CVN1,1) - i2_l = LBOUND(SrcBeddoesData%CVN1,2) - i2_u = UBOUND(SrcBeddoesData%CVN1,2) - IF (.NOT. ALLOCATED(DstBeddoesData%CVN1)) THEN - ALLOCATE(DstBeddoesData%CVN1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CVN1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%CVN1 = SrcBeddoesData%CVN1 -ENDIF -IF (ALLOCATED(SrcBeddoesData%DF)) THEN - i1_l = LBOUND(SrcBeddoesData%DF,1) - i1_u = UBOUND(SrcBeddoesData%DF,1) - i2_l = LBOUND(SrcBeddoesData%DF,2) - i2_u = UBOUND(SrcBeddoesData%DF,2) - IF (.NOT. ALLOCATED(DstBeddoesData%DF)) THEN - ALLOCATE(DstBeddoesData%DF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%DF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%DF = SrcBeddoesData%DF -ENDIF -IF (ALLOCATED(SrcBeddoesData%DFAFE)) THEN - i1_l = LBOUND(SrcBeddoesData%DFAFE,1) - i1_u = UBOUND(SrcBeddoesData%DFAFE,1) - i2_l = LBOUND(SrcBeddoesData%DFAFE,2) - i2_u = UBOUND(SrcBeddoesData%DFAFE,2) - IF (.NOT. ALLOCATED(DstBeddoesData%DFAFE)) THEN - ALLOCATE(DstBeddoesData%DFAFE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%DFAFE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%DFAFE = SrcBeddoesData%DFAFE -ENDIF -IF (ALLOCATED(SrcBeddoesData%DFAFE1)) THEN - i1_l = LBOUND(SrcBeddoesData%DFAFE1,1) - i1_u = UBOUND(SrcBeddoesData%DFAFE1,1) - i2_l = LBOUND(SrcBeddoesData%DFAFE1,2) - i2_u = UBOUND(SrcBeddoesData%DFAFE1,2) - IF (.NOT. ALLOCATED(DstBeddoesData%DFAFE1)) THEN - ALLOCATE(DstBeddoesData%DFAFE1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%DFAFE1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%DFAFE1 = SrcBeddoesData%DFAFE1 -ENDIF -IF (ALLOCATED(SrcBeddoesData%DFC)) THEN - i1_l = LBOUND(SrcBeddoesData%DFC,1) - i1_u = UBOUND(SrcBeddoesData%DFC,1) - i2_l = LBOUND(SrcBeddoesData%DFC,2) - i2_u = UBOUND(SrcBeddoesData%DFC,2) - IF (.NOT. ALLOCATED(DstBeddoesData%DFC)) THEN - ALLOCATE(DstBeddoesData%DFC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%DFC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%DFC = SrcBeddoesData%DFC -ENDIF -IF (ALLOCATED(SrcBeddoesData%DN)) THEN - i1_l = LBOUND(SrcBeddoesData%DN,1) - i1_u = UBOUND(SrcBeddoesData%DN,1) - i2_l = LBOUND(SrcBeddoesData%DN,2) - i2_u = UBOUND(SrcBeddoesData%DN,2) - IF (.NOT. ALLOCATED(DstBeddoesData%DN)) THEN - ALLOCATE(DstBeddoesData%DN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%DN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%DN = SrcBeddoesData%DN -ENDIF -IF (ALLOCATED(SrcBeddoesData%DPP)) THEN - i1_l = LBOUND(SrcBeddoesData%DPP,1) - i1_u = UBOUND(SrcBeddoesData%DPP,1) - i2_l = LBOUND(SrcBeddoesData%DPP,2) - i2_u = UBOUND(SrcBeddoesData%DPP,2) - IF (.NOT. ALLOCATED(DstBeddoesData%DPP)) THEN - ALLOCATE(DstBeddoesData%DPP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%DPP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%DPP = SrcBeddoesData%DPP -ENDIF -IF (ALLOCATED(SrcBeddoesData%DQ)) THEN - i1_l = LBOUND(SrcBeddoesData%DQ,1) - i1_u = UBOUND(SrcBeddoesData%DQ,1) - i2_l = LBOUND(SrcBeddoesData%DQ,2) - i2_u = UBOUND(SrcBeddoesData%DQ,2) - IF (.NOT. ALLOCATED(DstBeddoesData%DQ)) THEN - ALLOCATE(DstBeddoesData%DQ(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%DQ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%DQ = SrcBeddoesData%DQ -ENDIF -IF (ALLOCATED(SrcBeddoesData%DQP)) THEN - i1_l = LBOUND(SrcBeddoesData%DQP,1) - i1_u = UBOUND(SrcBeddoesData%DQP,1) - i2_l = LBOUND(SrcBeddoesData%DQP,2) - i2_u = UBOUND(SrcBeddoesData%DQP,2) - IF (.NOT. ALLOCATED(DstBeddoesData%DQP)) THEN - ALLOCATE(DstBeddoesData%DQP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%DQP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%DQP = SrcBeddoesData%DQP -ENDIF -IF (ALLOCATED(SrcBeddoesData%DQP1)) THEN - i1_l = LBOUND(SrcBeddoesData%DQP1,1) - i1_u = UBOUND(SrcBeddoesData%DQP1,1) - i2_l = LBOUND(SrcBeddoesData%DQP1,2) - i2_u = UBOUND(SrcBeddoesData%DQP1,2) - IF (.NOT. ALLOCATED(DstBeddoesData%DQP1)) THEN - ALLOCATE(DstBeddoesData%DQP1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%DQP1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%DQP1 = SrcBeddoesData%DQP1 -ENDIF - DstBeddoesData%DS = SrcBeddoesData%DS - DstBeddoesData%FK = SrcBeddoesData%FK - DstBeddoesData%FP = SrcBeddoesData%FP - DstBeddoesData%FPC = SrcBeddoesData%FPC -IF (ALLOCATED(SrcBeddoesData%FSP)) THEN - i1_l = LBOUND(SrcBeddoesData%FSP,1) - i1_u = UBOUND(SrcBeddoesData%FSP,1) - i2_l = LBOUND(SrcBeddoesData%FSP,2) - i2_u = UBOUND(SrcBeddoesData%FSP,2) - IF (.NOT. ALLOCATED(DstBeddoesData%FSP)) THEN - ALLOCATE(DstBeddoesData%FSP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%FSP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%FSP = SrcBeddoesData%FSP -ENDIF -IF (ALLOCATED(SrcBeddoesData%FSP1)) THEN - i1_l = LBOUND(SrcBeddoesData%FSP1,1) - i1_u = UBOUND(SrcBeddoesData%FSP1,1) - i2_l = LBOUND(SrcBeddoesData%FSP1,2) - i2_u = UBOUND(SrcBeddoesData%FSP1,2) - IF (.NOT. ALLOCATED(DstBeddoesData%FSP1)) THEN - ALLOCATE(DstBeddoesData%FSP1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%FSP1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%FSP1 = SrcBeddoesData%FSP1 -ENDIF -IF (ALLOCATED(SrcBeddoesData%FSPC)) THEN - i1_l = LBOUND(SrcBeddoesData%FSPC,1) - i1_u = UBOUND(SrcBeddoesData%FSPC,1) - i2_l = LBOUND(SrcBeddoesData%FSPC,2) - i2_u = UBOUND(SrcBeddoesData%FSPC,2) - IF (.NOT. ALLOCATED(DstBeddoesData%FSPC)) THEN - ALLOCATE(DstBeddoesData%FSPC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%FSPC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%FSPC = SrcBeddoesData%FSPC -ENDIF -IF (ALLOCATED(SrcBeddoesData%FSPC1)) THEN - i1_l = LBOUND(SrcBeddoesData%FSPC1,1) - i1_u = UBOUND(SrcBeddoesData%FSPC1,1) - i2_l = LBOUND(SrcBeddoesData%FSPC1,2) - i2_u = UBOUND(SrcBeddoesData%FSPC1,2) - IF (.NOT. ALLOCATED(DstBeddoesData%FSPC1)) THEN - ALLOCATE(DstBeddoesData%FSPC1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%FSPC1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%FSPC1 = SrcBeddoesData%FSPC1 -ENDIF -IF (ALLOCATED(SrcBeddoesData%FTB)) THEN - i1_l = LBOUND(SrcBeddoesData%FTB,1) - i1_u = UBOUND(SrcBeddoesData%FTB,1) - i2_l = LBOUND(SrcBeddoesData%FTB,2) - i2_u = UBOUND(SrcBeddoesData%FTB,2) - i3_l = LBOUND(SrcBeddoesData%FTB,3) - i3_u = UBOUND(SrcBeddoesData%FTB,3) - IF (.NOT. ALLOCATED(DstBeddoesData%FTB)) THEN - ALLOCATE(DstBeddoesData%FTB(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%FTB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%FTB = SrcBeddoesData%FTB -ENDIF -IF (ALLOCATED(SrcBeddoesData%FTBC)) THEN - i1_l = LBOUND(SrcBeddoesData%FTBC,1) - i1_u = UBOUND(SrcBeddoesData%FTBC,1) - i2_l = LBOUND(SrcBeddoesData%FTBC,2) - i2_u = UBOUND(SrcBeddoesData%FTBC,2) - i3_l = LBOUND(SrcBeddoesData%FTBC,3) - i3_u = UBOUND(SrcBeddoesData%FTBC,3) - IF (.NOT. ALLOCATED(DstBeddoesData%FTBC)) THEN - ALLOCATE(DstBeddoesData%FTBC(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%FTBC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%FTBC = SrcBeddoesData%FTBC -ENDIF -IF (ALLOCATED(SrcBeddoesData%OLDCNV)) THEN - i1_l = LBOUND(SrcBeddoesData%OLDCNV,1) - i1_u = UBOUND(SrcBeddoesData%OLDCNV,1) - i2_l = LBOUND(SrcBeddoesData%OLDCNV,2) - i2_u = UBOUND(SrcBeddoesData%OLDCNV,2) - IF (.NOT. ALLOCATED(DstBeddoesData%OLDCNV)) THEN - ALLOCATE(DstBeddoesData%OLDCNV(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDCNV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%OLDCNV = SrcBeddoesData%OLDCNV -ENDIF -IF (ALLOCATED(SrcBeddoesData%OLDDF)) THEN - i1_l = LBOUND(SrcBeddoesData%OLDDF,1) - i1_u = UBOUND(SrcBeddoesData%OLDDF,1) - i2_l = LBOUND(SrcBeddoesData%OLDDF,2) - i2_u = UBOUND(SrcBeddoesData%OLDDF,2) - IF (.NOT. ALLOCATED(DstBeddoesData%OLDDF)) THEN - ALLOCATE(DstBeddoesData%OLDDF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDDF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%OLDDF = SrcBeddoesData%OLDDF -ENDIF -IF (ALLOCATED(SrcBeddoesData%OLDDFC)) THEN - i1_l = LBOUND(SrcBeddoesData%OLDDFC,1) - i1_u = UBOUND(SrcBeddoesData%OLDDFC,1) - i2_l = LBOUND(SrcBeddoesData%OLDDFC,2) - i2_u = UBOUND(SrcBeddoesData%OLDDFC,2) - IF (.NOT. ALLOCATED(DstBeddoesData%OLDDFC)) THEN - ALLOCATE(DstBeddoesData%OLDDFC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDDFC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%OLDDFC = SrcBeddoesData%OLDDFC -ENDIF -IF (ALLOCATED(SrcBeddoesData%OLDDN)) THEN - i1_l = LBOUND(SrcBeddoesData%OLDDN,1) - i1_u = UBOUND(SrcBeddoesData%OLDDN,1) - i2_l = LBOUND(SrcBeddoesData%OLDDN,2) - i2_u = UBOUND(SrcBeddoesData%OLDDN,2) - IF (.NOT. ALLOCATED(DstBeddoesData%OLDDN)) THEN - ALLOCATE(DstBeddoesData%OLDDN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDDN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%OLDDN = SrcBeddoesData%OLDDN -ENDIF -IF (ALLOCATED(SrcBeddoesData%OLDDPP)) THEN - i1_l = LBOUND(SrcBeddoesData%OLDDPP,1) - i1_u = UBOUND(SrcBeddoesData%OLDDPP,1) - i2_l = LBOUND(SrcBeddoesData%OLDDPP,2) - i2_u = UBOUND(SrcBeddoesData%OLDDPP,2) - IF (.NOT. ALLOCATED(DstBeddoesData%OLDDPP)) THEN - ALLOCATE(DstBeddoesData%OLDDPP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDDPP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%OLDDPP = SrcBeddoesData%OLDDPP -ENDIF -IF (ALLOCATED(SrcBeddoesData%OLDDQ)) THEN - i1_l = LBOUND(SrcBeddoesData%OLDDQ,1) - i1_u = UBOUND(SrcBeddoesData%OLDDQ,1) - i2_l = LBOUND(SrcBeddoesData%OLDDQ,2) - i2_u = UBOUND(SrcBeddoesData%OLDDQ,2) - IF (.NOT. ALLOCATED(DstBeddoesData%OLDDQ)) THEN - ALLOCATE(DstBeddoesData%OLDDQ(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDDQ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%OLDDQ = SrcBeddoesData%OLDDQ -ENDIF -IF (ALLOCATED(SrcBeddoesData%OLDTAU)) THEN - i1_l = LBOUND(SrcBeddoesData%OLDTAU,1) - i1_u = UBOUND(SrcBeddoesData%OLDTAU,1) - i2_l = LBOUND(SrcBeddoesData%OLDTAU,2) - i2_u = UBOUND(SrcBeddoesData%OLDTAU,2) - IF (.NOT. ALLOCATED(DstBeddoesData%OLDTAU)) THEN - ALLOCATE(DstBeddoesData%OLDTAU(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDTAU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%OLDTAU = SrcBeddoesData%OLDTAU -ENDIF -IF (ALLOCATED(SrcBeddoesData%OLDXN)) THEN - i1_l = LBOUND(SrcBeddoesData%OLDXN,1) - i1_u = UBOUND(SrcBeddoesData%OLDXN,1) - i2_l = LBOUND(SrcBeddoesData%OLDXN,2) - i2_u = UBOUND(SrcBeddoesData%OLDXN,2) - IF (.NOT. ALLOCATED(DstBeddoesData%OLDXN)) THEN - ALLOCATE(DstBeddoesData%OLDXN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDXN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%OLDXN = SrcBeddoesData%OLDXN -ENDIF -IF (ALLOCATED(SrcBeddoesData%OLDYN)) THEN - i1_l = LBOUND(SrcBeddoesData%OLDYN,1) - i1_u = UBOUND(SrcBeddoesData%OLDYN,1) - i2_l = LBOUND(SrcBeddoesData%OLDYN,2) - i2_u = UBOUND(SrcBeddoesData%OLDYN,2) - IF (.NOT. ALLOCATED(DstBeddoesData%OLDYN)) THEN - ALLOCATE(DstBeddoesData%OLDYN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDYN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%OLDYN = SrcBeddoesData%OLDYN -ENDIF -IF (ALLOCATED(SrcBeddoesData%QX)) THEN - i1_l = LBOUND(SrcBeddoesData%QX,1) - i1_u = UBOUND(SrcBeddoesData%QX,1) - i2_l = LBOUND(SrcBeddoesData%QX,2) - i2_u = UBOUND(SrcBeddoesData%QX,2) - IF (.NOT. ALLOCATED(DstBeddoesData%QX)) THEN - ALLOCATE(DstBeddoesData%QX(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%QX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%QX = SrcBeddoesData%QX -ENDIF -IF (ALLOCATED(SrcBeddoesData%QX1)) THEN - i1_l = LBOUND(SrcBeddoesData%QX1,1) - i1_u = UBOUND(SrcBeddoesData%QX1,1) - i2_l = LBOUND(SrcBeddoesData%QX1,2) - i2_u = UBOUND(SrcBeddoesData%QX1,2) - IF (.NOT. ALLOCATED(DstBeddoesData%QX1)) THEN - ALLOCATE(DstBeddoesData%QX1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%QX1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%QX1 = SrcBeddoesData%QX1 -ENDIF -IF (ALLOCATED(SrcBeddoesData%TAU)) THEN - i1_l = LBOUND(SrcBeddoesData%TAU,1) - i1_u = UBOUND(SrcBeddoesData%TAU,1) - i2_l = LBOUND(SrcBeddoesData%TAU,2) - i2_u = UBOUND(SrcBeddoesData%TAU,2) - IF (.NOT. ALLOCATED(DstBeddoesData%TAU)) THEN - ALLOCATE(DstBeddoesData%TAU(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%TAU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%TAU = SrcBeddoesData%TAU -ENDIF -IF (ALLOCATED(SrcBeddoesData%XN)) THEN - i1_l = LBOUND(SrcBeddoesData%XN,1) - i1_u = UBOUND(SrcBeddoesData%XN,1) - i2_l = LBOUND(SrcBeddoesData%XN,2) - i2_u = UBOUND(SrcBeddoesData%XN,2) - IF (.NOT. ALLOCATED(DstBeddoesData%XN)) THEN - ALLOCATE(DstBeddoesData%XN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%XN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%XN = SrcBeddoesData%XN -ENDIF -IF (ALLOCATED(SrcBeddoesData%YN)) THEN - i1_l = LBOUND(SrcBeddoesData%YN,1) - i1_u = UBOUND(SrcBeddoesData%YN,1) - i2_l = LBOUND(SrcBeddoesData%YN,2) - i2_u = UBOUND(SrcBeddoesData%YN,2) - IF (.NOT. ALLOCATED(DstBeddoesData%YN)) THEN - ALLOCATE(DstBeddoesData%YN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%YN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeddoesData%YN = SrcBeddoesData%YN -ENDIF - DstBeddoesData%SHIFT = SrcBeddoesData%SHIFT - DstBeddoesData%VOR = SrcBeddoesData%VOR - END SUBROUTINE AD14_CopyBeddoes - - SUBROUTINE AD14_DestroyBeddoes( BeddoesData, ErrStat, ErrMsg ) - TYPE(Beddoes), INTENT(INOUT) :: BeddoesData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyBeddoes' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(BeddoesData%ADOT)) THEN - DEALLOCATE(BeddoesData%ADOT) -ENDIF -IF (ALLOCATED(BeddoesData%ADOT1)) THEN - DEALLOCATE(BeddoesData%ADOT1) -ENDIF -IF (ALLOCATED(BeddoesData%AFE)) THEN - DEALLOCATE(BeddoesData%AFE) -ENDIF -IF (ALLOCATED(BeddoesData%AFE1)) THEN - DEALLOCATE(BeddoesData%AFE1) -ENDIF -IF (ALLOCATED(BeddoesData%ANE)) THEN - DEALLOCATE(BeddoesData%ANE) -ENDIF -IF (ALLOCATED(BeddoesData%ANE1)) THEN - DEALLOCATE(BeddoesData%ANE1) -ENDIF -IF (ALLOCATED(BeddoesData%AOD)) THEN - DEALLOCATE(BeddoesData%AOD) -ENDIF -IF (ALLOCATED(BeddoesData%AOL)) THEN - DEALLOCATE(BeddoesData%AOL) -ENDIF -IF (ALLOCATED(BeddoesData%BEDSEP)) THEN - DEALLOCATE(BeddoesData%BEDSEP) -ENDIF -IF (ALLOCATED(BeddoesData%OLDSEP)) THEN - DEALLOCATE(BeddoesData%OLDSEP) -ENDIF -IF (ALLOCATED(BeddoesData%CDO)) THEN - DEALLOCATE(BeddoesData%CDO) -ENDIF -IF (ALLOCATED(BeddoesData%CNA)) THEN - DEALLOCATE(BeddoesData%CNA) -ENDIF -IF (ALLOCATED(BeddoesData%CNP)) THEN - DEALLOCATE(BeddoesData%CNP) -ENDIF -IF (ALLOCATED(BeddoesData%CNP1)) THEN - DEALLOCATE(BeddoesData%CNP1) -ENDIF -IF (ALLOCATED(BeddoesData%CNPD)) THEN - DEALLOCATE(BeddoesData%CNPD) -ENDIF -IF (ALLOCATED(BeddoesData%CNPD1)) THEN - DEALLOCATE(BeddoesData%CNPD1) -ENDIF -IF (ALLOCATED(BeddoesData%CNPOT)) THEN - DEALLOCATE(BeddoesData%CNPOT) -ENDIF -IF (ALLOCATED(BeddoesData%CNPOT1)) THEN - DEALLOCATE(BeddoesData%CNPOT1) -ENDIF -IF (ALLOCATED(BeddoesData%CNS)) THEN - DEALLOCATE(BeddoesData%CNS) -ENDIF -IF (ALLOCATED(BeddoesData%CNSL)) THEN - DEALLOCATE(BeddoesData%CNSL) -ENDIF -IF (ALLOCATED(BeddoesData%CNV)) THEN - DEALLOCATE(BeddoesData%CNV) -ENDIF -IF (ALLOCATED(BeddoesData%CVN)) THEN - DEALLOCATE(BeddoesData%CVN) -ENDIF -IF (ALLOCATED(BeddoesData%CVN1)) THEN - DEALLOCATE(BeddoesData%CVN1) -ENDIF -IF (ALLOCATED(BeddoesData%DF)) THEN - DEALLOCATE(BeddoesData%DF) -ENDIF -IF (ALLOCATED(BeddoesData%DFAFE)) THEN - DEALLOCATE(BeddoesData%DFAFE) -ENDIF -IF (ALLOCATED(BeddoesData%DFAFE1)) THEN - DEALLOCATE(BeddoesData%DFAFE1) -ENDIF -IF (ALLOCATED(BeddoesData%DFC)) THEN - DEALLOCATE(BeddoesData%DFC) -ENDIF -IF (ALLOCATED(BeddoesData%DN)) THEN - DEALLOCATE(BeddoesData%DN) -ENDIF -IF (ALLOCATED(BeddoesData%DPP)) THEN - DEALLOCATE(BeddoesData%DPP) -ENDIF -IF (ALLOCATED(BeddoesData%DQ)) THEN - DEALLOCATE(BeddoesData%DQ) -ENDIF -IF (ALLOCATED(BeddoesData%DQP)) THEN - DEALLOCATE(BeddoesData%DQP) -ENDIF -IF (ALLOCATED(BeddoesData%DQP1)) THEN - DEALLOCATE(BeddoesData%DQP1) -ENDIF -IF (ALLOCATED(BeddoesData%FSP)) THEN - DEALLOCATE(BeddoesData%FSP) -ENDIF -IF (ALLOCATED(BeddoesData%FSP1)) THEN - DEALLOCATE(BeddoesData%FSP1) -ENDIF -IF (ALLOCATED(BeddoesData%FSPC)) THEN - DEALLOCATE(BeddoesData%FSPC) -ENDIF -IF (ALLOCATED(BeddoesData%FSPC1)) THEN - DEALLOCATE(BeddoesData%FSPC1) -ENDIF -IF (ALLOCATED(BeddoesData%FTB)) THEN - DEALLOCATE(BeddoesData%FTB) -ENDIF -IF (ALLOCATED(BeddoesData%FTBC)) THEN - DEALLOCATE(BeddoesData%FTBC) -ENDIF -IF (ALLOCATED(BeddoesData%OLDCNV)) THEN - DEALLOCATE(BeddoesData%OLDCNV) -ENDIF -IF (ALLOCATED(BeddoesData%OLDDF)) THEN - DEALLOCATE(BeddoesData%OLDDF) -ENDIF -IF (ALLOCATED(BeddoesData%OLDDFC)) THEN - DEALLOCATE(BeddoesData%OLDDFC) -ENDIF -IF (ALLOCATED(BeddoesData%OLDDN)) THEN - DEALLOCATE(BeddoesData%OLDDN) -ENDIF -IF (ALLOCATED(BeddoesData%OLDDPP)) THEN - DEALLOCATE(BeddoesData%OLDDPP) -ENDIF -IF (ALLOCATED(BeddoesData%OLDDQ)) THEN - DEALLOCATE(BeddoesData%OLDDQ) -ENDIF -IF (ALLOCATED(BeddoesData%OLDTAU)) THEN - DEALLOCATE(BeddoesData%OLDTAU) -ENDIF -IF (ALLOCATED(BeddoesData%OLDXN)) THEN - DEALLOCATE(BeddoesData%OLDXN) -ENDIF -IF (ALLOCATED(BeddoesData%OLDYN)) THEN - DEALLOCATE(BeddoesData%OLDYN) -ENDIF -IF (ALLOCATED(BeddoesData%QX)) THEN - DEALLOCATE(BeddoesData%QX) -ENDIF -IF (ALLOCATED(BeddoesData%QX1)) THEN - DEALLOCATE(BeddoesData%QX1) -ENDIF -IF (ALLOCATED(BeddoesData%TAU)) THEN - DEALLOCATE(BeddoesData%TAU) -ENDIF -IF (ALLOCATED(BeddoesData%XN)) THEN - DEALLOCATE(BeddoesData%XN) -ENDIF -IF (ALLOCATED(BeddoesData%YN)) THEN - DEALLOCATE(BeddoesData%YN) -ENDIF - END SUBROUTINE AD14_DestroyBeddoes + ErrMsg = '' + if (allocated(SrcBeddoesData%ADOT)) then + LB(1:2) = lbound(SrcBeddoesData%ADOT) + UB(1:2) = ubound(SrcBeddoesData%ADOT) + if (.not. allocated(DstBeddoesData%ADOT)) then + allocate(DstBeddoesData%ADOT(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%ADOT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%ADOT = SrcBeddoesData%ADOT + else if (allocated(DstBeddoesData%ADOT)) then + deallocate(DstBeddoesData%ADOT) + end if + if (allocated(SrcBeddoesData%ADOT1)) then + LB(1:2) = lbound(SrcBeddoesData%ADOT1) + UB(1:2) = ubound(SrcBeddoesData%ADOT1) + if (.not. allocated(DstBeddoesData%ADOT1)) then + allocate(DstBeddoesData%ADOT1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%ADOT1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%ADOT1 = SrcBeddoesData%ADOT1 + else if (allocated(DstBeddoesData%ADOT1)) then + deallocate(DstBeddoesData%ADOT1) + end if + if (allocated(SrcBeddoesData%AFE)) then + LB(1:2) = lbound(SrcBeddoesData%AFE) + UB(1:2) = ubound(SrcBeddoesData%AFE) + if (.not. allocated(DstBeddoesData%AFE)) then + allocate(DstBeddoesData%AFE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%AFE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%AFE = SrcBeddoesData%AFE + else if (allocated(DstBeddoesData%AFE)) then + deallocate(DstBeddoesData%AFE) + end if + if (allocated(SrcBeddoesData%AFE1)) then + LB(1:2) = lbound(SrcBeddoesData%AFE1) + UB(1:2) = ubound(SrcBeddoesData%AFE1) + if (.not. allocated(DstBeddoesData%AFE1)) then + allocate(DstBeddoesData%AFE1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%AFE1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%AFE1 = SrcBeddoesData%AFE1 + else if (allocated(DstBeddoesData%AFE1)) then + deallocate(DstBeddoesData%AFE1) + end if + DstBeddoesData%AN = SrcBeddoesData%AN + if (allocated(SrcBeddoesData%ANE)) then + LB(1:2) = lbound(SrcBeddoesData%ANE) + UB(1:2) = ubound(SrcBeddoesData%ANE) + if (.not. allocated(DstBeddoesData%ANE)) then + allocate(DstBeddoesData%ANE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%ANE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%ANE = SrcBeddoesData%ANE + else if (allocated(DstBeddoesData%ANE)) then + deallocate(DstBeddoesData%ANE) + end if + if (allocated(SrcBeddoesData%ANE1)) then + LB(1:2) = lbound(SrcBeddoesData%ANE1) + UB(1:2) = ubound(SrcBeddoesData%ANE1) + if (.not. allocated(DstBeddoesData%ANE1)) then + allocate(DstBeddoesData%ANE1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%ANE1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%ANE1 = SrcBeddoesData%ANE1 + else if (allocated(DstBeddoesData%ANE1)) then + deallocate(DstBeddoesData%ANE1) + end if + if (allocated(SrcBeddoesData%AOD)) then + LB(1:2) = lbound(SrcBeddoesData%AOD) + UB(1:2) = ubound(SrcBeddoesData%AOD) + if (.not. allocated(DstBeddoesData%AOD)) then + allocate(DstBeddoesData%AOD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%AOD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%AOD = SrcBeddoesData%AOD + else if (allocated(DstBeddoesData%AOD)) then + deallocate(DstBeddoesData%AOD) + end if + if (allocated(SrcBeddoesData%AOL)) then + LB(1:2) = lbound(SrcBeddoesData%AOL) + UB(1:2) = ubound(SrcBeddoesData%AOL) + if (.not. allocated(DstBeddoesData%AOL)) then + allocate(DstBeddoesData%AOL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%AOL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%AOL = SrcBeddoesData%AOL + else if (allocated(DstBeddoesData%AOL)) then + deallocate(DstBeddoesData%AOL) + end if + if (allocated(SrcBeddoesData%BEDSEP)) then + LB(1:2) = lbound(SrcBeddoesData%BEDSEP) + UB(1:2) = ubound(SrcBeddoesData%BEDSEP) + if (.not. allocated(DstBeddoesData%BEDSEP)) then + allocate(DstBeddoesData%BEDSEP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%BEDSEP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%BEDSEP = SrcBeddoesData%BEDSEP + else if (allocated(DstBeddoesData%BEDSEP)) then + deallocate(DstBeddoesData%BEDSEP) + end if + if (allocated(SrcBeddoesData%OLDSEP)) then + LB(1:2) = lbound(SrcBeddoesData%OLDSEP) + UB(1:2) = ubound(SrcBeddoesData%OLDSEP) + if (.not. allocated(DstBeddoesData%OLDSEP)) then + allocate(DstBeddoesData%OLDSEP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDSEP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%OLDSEP = SrcBeddoesData%OLDSEP + else if (allocated(DstBeddoesData%OLDSEP)) then + deallocate(DstBeddoesData%OLDSEP) + end if + DstBeddoesData%CC = SrcBeddoesData%CC + if (allocated(SrcBeddoesData%CDO)) then + LB(1:2) = lbound(SrcBeddoesData%CDO) + UB(1:2) = ubound(SrcBeddoesData%CDO) + if (.not. allocated(DstBeddoesData%CDO)) then + allocate(DstBeddoesData%CDO(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CDO.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%CDO = SrcBeddoesData%CDO + else if (allocated(DstBeddoesData%CDO)) then + deallocate(DstBeddoesData%CDO) + end if + DstBeddoesData%CMI = SrcBeddoesData%CMI + DstBeddoesData%CMQ = SrcBeddoesData%CMQ + DstBeddoesData%CN = SrcBeddoesData%CN + if (allocated(SrcBeddoesData%CNA)) then + LB(1:2) = lbound(SrcBeddoesData%CNA) + UB(1:2) = ubound(SrcBeddoesData%CNA) + if (.not. allocated(DstBeddoesData%CNA)) then + allocate(DstBeddoesData%CNA(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNA.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%CNA = SrcBeddoesData%CNA + else if (allocated(DstBeddoesData%CNA)) then + deallocate(DstBeddoesData%CNA) + end if + DstBeddoesData%CNCP = SrcBeddoesData%CNCP + DstBeddoesData%CNIQ = SrcBeddoesData%CNIQ + if (allocated(SrcBeddoesData%CNP)) then + LB(1:2) = lbound(SrcBeddoesData%CNP) + UB(1:2) = ubound(SrcBeddoesData%CNP) + if (.not. allocated(DstBeddoesData%CNP)) then + allocate(DstBeddoesData%CNP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%CNP = SrcBeddoesData%CNP + else if (allocated(DstBeddoesData%CNP)) then + deallocate(DstBeddoesData%CNP) + end if + if (allocated(SrcBeddoesData%CNP1)) then + LB(1:2) = lbound(SrcBeddoesData%CNP1) + UB(1:2) = ubound(SrcBeddoesData%CNP1) + if (.not. allocated(DstBeddoesData%CNP1)) then + allocate(DstBeddoesData%CNP1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNP1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%CNP1 = SrcBeddoesData%CNP1 + else if (allocated(DstBeddoesData%CNP1)) then + deallocate(DstBeddoesData%CNP1) + end if + if (allocated(SrcBeddoesData%CNPD)) then + LB(1:2) = lbound(SrcBeddoesData%CNPD) + UB(1:2) = ubound(SrcBeddoesData%CNPD) + if (.not. allocated(DstBeddoesData%CNPD)) then + allocate(DstBeddoesData%CNPD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNPD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%CNPD = SrcBeddoesData%CNPD + else if (allocated(DstBeddoesData%CNPD)) then + deallocate(DstBeddoesData%CNPD) + end if + if (allocated(SrcBeddoesData%CNPD1)) then + LB(1:2) = lbound(SrcBeddoesData%CNPD1) + UB(1:2) = ubound(SrcBeddoesData%CNPD1) + if (.not. allocated(DstBeddoesData%CNPD1)) then + allocate(DstBeddoesData%CNPD1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNPD1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%CNPD1 = SrcBeddoesData%CNPD1 + else if (allocated(DstBeddoesData%CNPD1)) then + deallocate(DstBeddoesData%CNPD1) + end if + if (allocated(SrcBeddoesData%CNPOT)) then + LB(1:2) = lbound(SrcBeddoesData%CNPOT) + UB(1:2) = ubound(SrcBeddoesData%CNPOT) + if (.not. allocated(DstBeddoesData%CNPOT)) then + allocate(DstBeddoesData%CNPOT(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNPOT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%CNPOT = SrcBeddoesData%CNPOT + else if (allocated(DstBeddoesData%CNPOT)) then + deallocate(DstBeddoesData%CNPOT) + end if + if (allocated(SrcBeddoesData%CNPOT1)) then + LB(1:2) = lbound(SrcBeddoesData%CNPOT1) + UB(1:2) = ubound(SrcBeddoesData%CNPOT1) + if (.not. allocated(DstBeddoesData%CNPOT1)) then + allocate(DstBeddoesData%CNPOT1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNPOT1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%CNPOT1 = SrcBeddoesData%CNPOT1 + else if (allocated(DstBeddoesData%CNPOT1)) then + deallocate(DstBeddoesData%CNPOT1) + end if + if (allocated(SrcBeddoesData%CNS)) then + LB(1:2) = lbound(SrcBeddoesData%CNS) + UB(1:2) = ubound(SrcBeddoesData%CNS) + if (.not. allocated(DstBeddoesData%CNS)) then + allocate(DstBeddoesData%CNS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%CNS = SrcBeddoesData%CNS + else if (allocated(DstBeddoesData%CNS)) then + deallocate(DstBeddoesData%CNS) + end if + if (allocated(SrcBeddoesData%CNSL)) then + LB(1:2) = lbound(SrcBeddoesData%CNSL) + UB(1:2) = ubound(SrcBeddoesData%CNSL) + if (.not. allocated(DstBeddoesData%CNSL)) then + allocate(DstBeddoesData%CNSL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNSL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%CNSL = SrcBeddoesData%CNSL + else if (allocated(DstBeddoesData%CNSL)) then + deallocate(DstBeddoesData%CNSL) + end if + if (allocated(SrcBeddoesData%CNV)) then + LB(1:2) = lbound(SrcBeddoesData%CNV) + UB(1:2) = ubound(SrcBeddoesData%CNV) + if (.not. allocated(DstBeddoesData%CNV)) then + allocate(DstBeddoesData%CNV(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CNV.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%CNV = SrcBeddoesData%CNV + else if (allocated(DstBeddoesData%CNV)) then + deallocate(DstBeddoesData%CNV) + end if + if (allocated(SrcBeddoesData%CVN)) then + LB(1:2) = lbound(SrcBeddoesData%CVN) + UB(1:2) = ubound(SrcBeddoesData%CVN) + if (.not. allocated(DstBeddoesData%CVN)) then + allocate(DstBeddoesData%CVN(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CVN.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%CVN = SrcBeddoesData%CVN + else if (allocated(DstBeddoesData%CVN)) then + deallocate(DstBeddoesData%CVN) + end if + if (allocated(SrcBeddoesData%CVN1)) then + LB(1:2) = lbound(SrcBeddoesData%CVN1) + UB(1:2) = ubound(SrcBeddoesData%CVN1) + if (.not. allocated(DstBeddoesData%CVN1)) then + allocate(DstBeddoesData%CVN1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%CVN1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%CVN1 = SrcBeddoesData%CVN1 + else if (allocated(DstBeddoesData%CVN1)) then + deallocate(DstBeddoesData%CVN1) + end if + if (allocated(SrcBeddoesData%DF)) then + LB(1:2) = lbound(SrcBeddoesData%DF) + UB(1:2) = ubound(SrcBeddoesData%DF) + if (.not. allocated(DstBeddoesData%DF)) then + allocate(DstBeddoesData%DF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%DF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%DF = SrcBeddoesData%DF + else if (allocated(DstBeddoesData%DF)) then + deallocate(DstBeddoesData%DF) + end if + if (allocated(SrcBeddoesData%DFAFE)) then + LB(1:2) = lbound(SrcBeddoesData%DFAFE) + UB(1:2) = ubound(SrcBeddoesData%DFAFE) + if (.not. allocated(DstBeddoesData%DFAFE)) then + allocate(DstBeddoesData%DFAFE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%DFAFE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%DFAFE = SrcBeddoesData%DFAFE + else if (allocated(DstBeddoesData%DFAFE)) then + deallocate(DstBeddoesData%DFAFE) + end if + if (allocated(SrcBeddoesData%DFAFE1)) then + LB(1:2) = lbound(SrcBeddoesData%DFAFE1) + UB(1:2) = ubound(SrcBeddoesData%DFAFE1) + if (.not. allocated(DstBeddoesData%DFAFE1)) then + allocate(DstBeddoesData%DFAFE1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%DFAFE1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%DFAFE1 = SrcBeddoesData%DFAFE1 + else if (allocated(DstBeddoesData%DFAFE1)) then + deallocate(DstBeddoesData%DFAFE1) + end if + if (allocated(SrcBeddoesData%DFC)) then + LB(1:2) = lbound(SrcBeddoesData%DFC) + UB(1:2) = ubound(SrcBeddoesData%DFC) + if (.not. allocated(DstBeddoesData%DFC)) then + allocate(DstBeddoesData%DFC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%DFC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%DFC = SrcBeddoesData%DFC + else if (allocated(DstBeddoesData%DFC)) then + deallocate(DstBeddoesData%DFC) + end if + if (allocated(SrcBeddoesData%DN)) then + LB(1:2) = lbound(SrcBeddoesData%DN) + UB(1:2) = ubound(SrcBeddoesData%DN) + if (.not. allocated(DstBeddoesData%DN)) then + allocate(DstBeddoesData%DN(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%DN.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%DN = SrcBeddoesData%DN + else if (allocated(DstBeddoesData%DN)) then + deallocate(DstBeddoesData%DN) + end if + if (allocated(SrcBeddoesData%DPP)) then + LB(1:2) = lbound(SrcBeddoesData%DPP) + UB(1:2) = ubound(SrcBeddoesData%DPP) + if (.not. allocated(DstBeddoesData%DPP)) then + allocate(DstBeddoesData%DPP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%DPP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%DPP = SrcBeddoesData%DPP + else if (allocated(DstBeddoesData%DPP)) then + deallocate(DstBeddoesData%DPP) + end if + if (allocated(SrcBeddoesData%DQ)) then + LB(1:2) = lbound(SrcBeddoesData%DQ) + UB(1:2) = ubound(SrcBeddoesData%DQ) + if (.not. allocated(DstBeddoesData%DQ)) then + allocate(DstBeddoesData%DQ(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%DQ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%DQ = SrcBeddoesData%DQ + else if (allocated(DstBeddoesData%DQ)) then + deallocate(DstBeddoesData%DQ) + end if + if (allocated(SrcBeddoesData%DQP)) then + LB(1:2) = lbound(SrcBeddoesData%DQP) + UB(1:2) = ubound(SrcBeddoesData%DQP) + if (.not. allocated(DstBeddoesData%DQP)) then + allocate(DstBeddoesData%DQP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%DQP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%DQP = SrcBeddoesData%DQP + else if (allocated(DstBeddoesData%DQP)) then + deallocate(DstBeddoesData%DQP) + end if + if (allocated(SrcBeddoesData%DQP1)) then + LB(1:2) = lbound(SrcBeddoesData%DQP1) + UB(1:2) = ubound(SrcBeddoesData%DQP1) + if (.not. allocated(DstBeddoesData%DQP1)) then + allocate(DstBeddoesData%DQP1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%DQP1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%DQP1 = SrcBeddoesData%DQP1 + else if (allocated(DstBeddoesData%DQP1)) then + deallocate(DstBeddoesData%DQP1) + end if + DstBeddoesData%DS = SrcBeddoesData%DS + DstBeddoesData%FK = SrcBeddoesData%FK + DstBeddoesData%FP = SrcBeddoesData%FP + DstBeddoesData%FPC = SrcBeddoesData%FPC + if (allocated(SrcBeddoesData%FSP)) then + LB(1:2) = lbound(SrcBeddoesData%FSP) + UB(1:2) = ubound(SrcBeddoesData%FSP) + if (.not. allocated(DstBeddoesData%FSP)) then + allocate(DstBeddoesData%FSP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%FSP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%FSP = SrcBeddoesData%FSP + else if (allocated(DstBeddoesData%FSP)) then + deallocate(DstBeddoesData%FSP) + end if + if (allocated(SrcBeddoesData%FSP1)) then + LB(1:2) = lbound(SrcBeddoesData%FSP1) + UB(1:2) = ubound(SrcBeddoesData%FSP1) + if (.not. allocated(DstBeddoesData%FSP1)) then + allocate(DstBeddoesData%FSP1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%FSP1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%FSP1 = SrcBeddoesData%FSP1 + else if (allocated(DstBeddoesData%FSP1)) then + deallocate(DstBeddoesData%FSP1) + end if + if (allocated(SrcBeddoesData%FSPC)) then + LB(1:2) = lbound(SrcBeddoesData%FSPC) + UB(1:2) = ubound(SrcBeddoesData%FSPC) + if (.not. allocated(DstBeddoesData%FSPC)) then + allocate(DstBeddoesData%FSPC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%FSPC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%FSPC = SrcBeddoesData%FSPC + else if (allocated(DstBeddoesData%FSPC)) then + deallocate(DstBeddoesData%FSPC) + end if + if (allocated(SrcBeddoesData%FSPC1)) then + LB(1:2) = lbound(SrcBeddoesData%FSPC1) + UB(1:2) = ubound(SrcBeddoesData%FSPC1) + if (.not. allocated(DstBeddoesData%FSPC1)) then + allocate(DstBeddoesData%FSPC1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%FSPC1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%FSPC1 = SrcBeddoesData%FSPC1 + else if (allocated(DstBeddoesData%FSPC1)) then + deallocate(DstBeddoesData%FSPC1) + end if + if (allocated(SrcBeddoesData%FTB)) then + LB(1:3) = lbound(SrcBeddoesData%FTB) + UB(1:3) = ubound(SrcBeddoesData%FTB) + if (.not. allocated(DstBeddoesData%FTB)) then + allocate(DstBeddoesData%FTB(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%FTB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%FTB = SrcBeddoesData%FTB + else if (allocated(DstBeddoesData%FTB)) then + deallocate(DstBeddoesData%FTB) + end if + if (allocated(SrcBeddoesData%FTBC)) then + LB(1:3) = lbound(SrcBeddoesData%FTBC) + UB(1:3) = ubound(SrcBeddoesData%FTBC) + if (.not. allocated(DstBeddoesData%FTBC)) then + allocate(DstBeddoesData%FTBC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%FTBC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%FTBC = SrcBeddoesData%FTBC + else if (allocated(DstBeddoesData%FTBC)) then + deallocate(DstBeddoesData%FTBC) + end if + if (allocated(SrcBeddoesData%OLDCNV)) then + LB(1:2) = lbound(SrcBeddoesData%OLDCNV) + UB(1:2) = ubound(SrcBeddoesData%OLDCNV) + if (.not. allocated(DstBeddoesData%OLDCNV)) then + allocate(DstBeddoesData%OLDCNV(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDCNV.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%OLDCNV = SrcBeddoesData%OLDCNV + else if (allocated(DstBeddoesData%OLDCNV)) then + deallocate(DstBeddoesData%OLDCNV) + end if + if (allocated(SrcBeddoesData%OLDDF)) then + LB(1:2) = lbound(SrcBeddoesData%OLDDF) + UB(1:2) = ubound(SrcBeddoesData%OLDDF) + if (.not. allocated(DstBeddoesData%OLDDF)) then + allocate(DstBeddoesData%OLDDF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDDF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%OLDDF = SrcBeddoesData%OLDDF + else if (allocated(DstBeddoesData%OLDDF)) then + deallocate(DstBeddoesData%OLDDF) + end if + if (allocated(SrcBeddoesData%OLDDFC)) then + LB(1:2) = lbound(SrcBeddoesData%OLDDFC) + UB(1:2) = ubound(SrcBeddoesData%OLDDFC) + if (.not. allocated(DstBeddoesData%OLDDFC)) then + allocate(DstBeddoesData%OLDDFC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDDFC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%OLDDFC = SrcBeddoesData%OLDDFC + else if (allocated(DstBeddoesData%OLDDFC)) then + deallocate(DstBeddoesData%OLDDFC) + end if + if (allocated(SrcBeddoesData%OLDDN)) then + LB(1:2) = lbound(SrcBeddoesData%OLDDN) + UB(1:2) = ubound(SrcBeddoesData%OLDDN) + if (.not. allocated(DstBeddoesData%OLDDN)) then + allocate(DstBeddoesData%OLDDN(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDDN.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%OLDDN = SrcBeddoesData%OLDDN + else if (allocated(DstBeddoesData%OLDDN)) then + deallocate(DstBeddoesData%OLDDN) + end if + if (allocated(SrcBeddoesData%OLDDPP)) then + LB(1:2) = lbound(SrcBeddoesData%OLDDPP) + UB(1:2) = ubound(SrcBeddoesData%OLDDPP) + if (.not. allocated(DstBeddoesData%OLDDPP)) then + allocate(DstBeddoesData%OLDDPP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDDPP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%OLDDPP = SrcBeddoesData%OLDDPP + else if (allocated(DstBeddoesData%OLDDPP)) then + deallocate(DstBeddoesData%OLDDPP) + end if + if (allocated(SrcBeddoesData%OLDDQ)) then + LB(1:2) = lbound(SrcBeddoesData%OLDDQ) + UB(1:2) = ubound(SrcBeddoesData%OLDDQ) + if (.not. allocated(DstBeddoesData%OLDDQ)) then + allocate(DstBeddoesData%OLDDQ(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDDQ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%OLDDQ = SrcBeddoesData%OLDDQ + else if (allocated(DstBeddoesData%OLDDQ)) then + deallocate(DstBeddoesData%OLDDQ) + end if + if (allocated(SrcBeddoesData%OLDTAU)) then + LB(1:2) = lbound(SrcBeddoesData%OLDTAU) + UB(1:2) = ubound(SrcBeddoesData%OLDTAU) + if (.not. allocated(DstBeddoesData%OLDTAU)) then + allocate(DstBeddoesData%OLDTAU(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDTAU.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%OLDTAU = SrcBeddoesData%OLDTAU + else if (allocated(DstBeddoesData%OLDTAU)) then + deallocate(DstBeddoesData%OLDTAU) + end if + if (allocated(SrcBeddoesData%OLDXN)) then + LB(1:2) = lbound(SrcBeddoesData%OLDXN) + UB(1:2) = ubound(SrcBeddoesData%OLDXN) + if (.not. allocated(DstBeddoesData%OLDXN)) then + allocate(DstBeddoesData%OLDXN(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDXN.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%OLDXN = SrcBeddoesData%OLDXN + else if (allocated(DstBeddoesData%OLDXN)) then + deallocate(DstBeddoesData%OLDXN) + end if + if (allocated(SrcBeddoesData%OLDYN)) then + LB(1:2) = lbound(SrcBeddoesData%OLDYN) + UB(1:2) = ubound(SrcBeddoesData%OLDYN) + if (.not. allocated(DstBeddoesData%OLDYN)) then + allocate(DstBeddoesData%OLDYN(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%OLDYN.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%OLDYN = SrcBeddoesData%OLDYN + else if (allocated(DstBeddoesData%OLDYN)) then + deallocate(DstBeddoesData%OLDYN) + end if + if (allocated(SrcBeddoesData%QX)) then + LB(1:2) = lbound(SrcBeddoesData%QX) + UB(1:2) = ubound(SrcBeddoesData%QX) + if (.not. allocated(DstBeddoesData%QX)) then + allocate(DstBeddoesData%QX(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%QX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%QX = SrcBeddoesData%QX + else if (allocated(DstBeddoesData%QX)) then + deallocate(DstBeddoesData%QX) + end if + if (allocated(SrcBeddoesData%QX1)) then + LB(1:2) = lbound(SrcBeddoesData%QX1) + UB(1:2) = ubound(SrcBeddoesData%QX1) + if (.not. allocated(DstBeddoesData%QX1)) then + allocate(DstBeddoesData%QX1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%QX1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%QX1 = SrcBeddoesData%QX1 + else if (allocated(DstBeddoesData%QX1)) then + deallocate(DstBeddoesData%QX1) + end if + if (allocated(SrcBeddoesData%TAU)) then + LB(1:2) = lbound(SrcBeddoesData%TAU) + UB(1:2) = ubound(SrcBeddoesData%TAU) + if (.not. allocated(DstBeddoesData%TAU)) then + allocate(DstBeddoesData%TAU(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%TAU.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%TAU = SrcBeddoesData%TAU + else if (allocated(DstBeddoesData%TAU)) then + deallocate(DstBeddoesData%TAU) + end if + if (allocated(SrcBeddoesData%XN)) then + LB(1:2) = lbound(SrcBeddoesData%XN) + UB(1:2) = ubound(SrcBeddoesData%XN) + if (.not. allocated(DstBeddoesData%XN)) then + allocate(DstBeddoesData%XN(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%XN.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%XN = SrcBeddoesData%XN + else if (allocated(DstBeddoesData%XN)) then + deallocate(DstBeddoesData%XN) + end if + if (allocated(SrcBeddoesData%YN)) then + LB(1:2) = lbound(SrcBeddoesData%YN) + UB(1:2) = ubound(SrcBeddoesData%YN) + if (.not. allocated(DstBeddoesData%YN)) then + allocate(DstBeddoesData%YN(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeddoesData%YN.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeddoesData%YN = SrcBeddoesData%YN + else if (allocated(DstBeddoesData%YN)) then + deallocate(DstBeddoesData%YN) + end if + DstBeddoesData%SHIFT = SrcBeddoesData%SHIFT + DstBeddoesData%VOR = SrcBeddoesData%VOR +end subroutine +subroutine AD14_DestroyBeddoes(BeddoesData, ErrStat, ErrMsg) + type(Beddoes), intent(inout) :: BeddoesData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_DestroyBeddoes' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(BeddoesData%ADOT)) then + deallocate(BeddoesData%ADOT) + end if + if (allocated(BeddoesData%ADOT1)) then + deallocate(BeddoesData%ADOT1) + end if + if (allocated(BeddoesData%AFE)) then + deallocate(BeddoesData%AFE) + end if + if (allocated(BeddoesData%AFE1)) then + deallocate(BeddoesData%AFE1) + end if + if (allocated(BeddoesData%ANE)) then + deallocate(BeddoesData%ANE) + end if + if (allocated(BeddoesData%ANE1)) then + deallocate(BeddoesData%ANE1) + end if + if (allocated(BeddoesData%AOD)) then + deallocate(BeddoesData%AOD) + end if + if (allocated(BeddoesData%AOL)) then + deallocate(BeddoesData%AOL) + end if + if (allocated(BeddoesData%BEDSEP)) then + deallocate(BeddoesData%BEDSEP) + end if + if (allocated(BeddoesData%OLDSEP)) then + deallocate(BeddoesData%OLDSEP) + end if + if (allocated(BeddoesData%CDO)) then + deallocate(BeddoesData%CDO) + end if + if (allocated(BeddoesData%CNA)) then + deallocate(BeddoesData%CNA) + end if + if (allocated(BeddoesData%CNP)) then + deallocate(BeddoesData%CNP) + end if + if (allocated(BeddoesData%CNP1)) then + deallocate(BeddoesData%CNP1) + end if + if (allocated(BeddoesData%CNPD)) then + deallocate(BeddoesData%CNPD) + end if + if (allocated(BeddoesData%CNPD1)) then + deallocate(BeddoesData%CNPD1) + end if + if (allocated(BeddoesData%CNPOT)) then + deallocate(BeddoesData%CNPOT) + end if + if (allocated(BeddoesData%CNPOT1)) then + deallocate(BeddoesData%CNPOT1) + end if + if (allocated(BeddoesData%CNS)) then + deallocate(BeddoesData%CNS) + end if + if (allocated(BeddoesData%CNSL)) then + deallocate(BeddoesData%CNSL) + end if + if (allocated(BeddoesData%CNV)) then + deallocate(BeddoesData%CNV) + end if + if (allocated(BeddoesData%CVN)) then + deallocate(BeddoesData%CVN) + end if + if (allocated(BeddoesData%CVN1)) then + deallocate(BeddoesData%CVN1) + end if + if (allocated(BeddoesData%DF)) then + deallocate(BeddoesData%DF) + end if + if (allocated(BeddoesData%DFAFE)) then + deallocate(BeddoesData%DFAFE) + end if + if (allocated(BeddoesData%DFAFE1)) then + deallocate(BeddoesData%DFAFE1) + end if + if (allocated(BeddoesData%DFC)) then + deallocate(BeddoesData%DFC) + end if + if (allocated(BeddoesData%DN)) then + deallocate(BeddoesData%DN) + end if + if (allocated(BeddoesData%DPP)) then + deallocate(BeddoesData%DPP) + end if + if (allocated(BeddoesData%DQ)) then + deallocate(BeddoesData%DQ) + end if + if (allocated(BeddoesData%DQP)) then + deallocate(BeddoesData%DQP) + end if + if (allocated(BeddoesData%DQP1)) then + deallocate(BeddoesData%DQP1) + end if + if (allocated(BeddoesData%FSP)) then + deallocate(BeddoesData%FSP) + end if + if (allocated(BeddoesData%FSP1)) then + deallocate(BeddoesData%FSP1) + end if + if (allocated(BeddoesData%FSPC)) then + deallocate(BeddoesData%FSPC) + end if + if (allocated(BeddoesData%FSPC1)) then + deallocate(BeddoesData%FSPC1) + end if + if (allocated(BeddoesData%FTB)) then + deallocate(BeddoesData%FTB) + end if + if (allocated(BeddoesData%FTBC)) then + deallocate(BeddoesData%FTBC) + end if + if (allocated(BeddoesData%OLDCNV)) then + deallocate(BeddoesData%OLDCNV) + end if + if (allocated(BeddoesData%OLDDF)) then + deallocate(BeddoesData%OLDDF) + end if + if (allocated(BeddoesData%OLDDFC)) then + deallocate(BeddoesData%OLDDFC) + end if + if (allocated(BeddoesData%OLDDN)) then + deallocate(BeddoesData%OLDDN) + end if + if (allocated(BeddoesData%OLDDPP)) then + deallocate(BeddoesData%OLDDPP) + end if + if (allocated(BeddoesData%OLDDQ)) then + deallocate(BeddoesData%OLDDQ) + end if + if (allocated(BeddoesData%OLDTAU)) then + deallocate(BeddoesData%OLDTAU) + end if + if (allocated(BeddoesData%OLDXN)) then + deallocate(BeddoesData%OLDXN) + end if + if (allocated(BeddoesData%OLDYN)) then + deallocate(BeddoesData%OLDYN) + end if + if (allocated(BeddoesData%QX)) then + deallocate(BeddoesData%QX) + end if + if (allocated(BeddoesData%QX1)) then + deallocate(BeddoesData%QX1) + end if + if (allocated(BeddoesData%TAU)) then + deallocate(BeddoesData%TAU) + end if + if (allocated(BeddoesData%XN)) then + deallocate(BeddoesData%XN) + end if + if (allocated(BeddoesData%YN)) then + deallocate(BeddoesData%YN) + end if +end subroutine subroutine AD14_PackBeddoes(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Beddoes), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackBeddoes' if (Buf%ErrStat >= AbortErrLev) return - ! ADOT call RegPack(Buf, allocated(InData%ADOT)) if (allocated(InData%ADOT)) then call RegPackBounds(Buf, 2, lbound(InData%ADOT), ubound(InData%ADOT)) call RegPack(Buf, InData%ADOT) end if if (RegCheckErr(Buf, RoutineName)) return - ! ADOT1 call RegPack(Buf, allocated(InData%ADOT1)) if (allocated(InData%ADOT1)) then call RegPackBounds(Buf, 2, lbound(InData%ADOT1), ubound(InData%ADOT1)) call RegPack(Buf, InData%ADOT1) end if if (RegCheckErr(Buf, RoutineName)) return - ! AFE call RegPack(Buf, allocated(InData%AFE)) if (allocated(InData%AFE)) then call RegPackBounds(Buf, 2, lbound(InData%AFE), ubound(InData%AFE)) call RegPack(Buf, InData%AFE) end if if (RegCheckErr(Buf, RoutineName)) return - ! AFE1 call RegPack(Buf, allocated(InData%AFE1)) if (allocated(InData%AFE1)) then call RegPackBounds(Buf, 2, lbound(InData%AFE1), ubound(InData%AFE1)) call RegPack(Buf, InData%AFE1) end if if (RegCheckErr(Buf, RoutineName)) return - ! AN call RegPack(Buf, InData%AN) if (RegCheckErr(Buf, RoutineName)) return - ! ANE call RegPack(Buf, allocated(InData%ANE)) if (allocated(InData%ANE)) then call RegPackBounds(Buf, 2, lbound(InData%ANE), ubound(InData%ANE)) call RegPack(Buf, InData%ANE) end if if (RegCheckErr(Buf, RoutineName)) return - ! ANE1 call RegPack(Buf, allocated(InData%ANE1)) if (allocated(InData%ANE1)) then call RegPackBounds(Buf, 2, lbound(InData%ANE1), ubound(InData%ANE1)) call RegPack(Buf, InData%ANE1) end if if (RegCheckErr(Buf, RoutineName)) return - ! AOD call RegPack(Buf, allocated(InData%AOD)) if (allocated(InData%AOD)) then call RegPackBounds(Buf, 2, lbound(InData%AOD), ubound(InData%AOD)) call RegPack(Buf, InData%AOD) end if if (RegCheckErr(Buf, RoutineName)) return - ! AOL call RegPack(Buf, allocated(InData%AOL)) if (allocated(InData%AOL)) then call RegPackBounds(Buf, 2, lbound(InData%AOL), ubound(InData%AOL)) call RegPack(Buf, InData%AOL) end if if (RegCheckErr(Buf, RoutineName)) return - ! BEDSEP call RegPack(Buf, allocated(InData%BEDSEP)) if (allocated(InData%BEDSEP)) then call RegPackBounds(Buf, 2, lbound(InData%BEDSEP), ubound(InData%BEDSEP)) call RegPack(Buf, InData%BEDSEP) end if if (RegCheckErr(Buf, RoutineName)) return - ! OLDSEP call RegPack(Buf, allocated(InData%OLDSEP)) if (allocated(InData%OLDSEP)) then call RegPackBounds(Buf, 2, lbound(InData%OLDSEP), ubound(InData%OLDSEP)) call RegPack(Buf, InData%OLDSEP) end if if (RegCheckErr(Buf, RoutineName)) return - ! CC call RegPack(Buf, InData%CC) if (RegCheckErr(Buf, RoutineName)) return - ! CDO call RegPack(Buf, allocated(InData%CDO)) if (allocated(InData%CDO)) then call RegPackBounds(Buf, 2, lbound(InData%CDO), ubound(InData%CDO)) call RegPack(Buf, InData%CDO) end if if (RegCheckErr(Buf, RoutineName)) return - ! CMI call RegPack(Buf, InData%CMI) if (RegCheckErr(Buf, RoutineName)) return - ! CMQ call RegPack(Buf, InData%CMQ) if (RegCheckErr(Buf, RoutineName)) return - ! CN call RegPack(Buf, InData%CN) if (RegCheckErr(Buf, RoutineName)) return - ! CNA call RegPack(Buf, allocated(InData%CNA)) if (allocated(InData%CNA)) then call RegPackBounds(Buf, 2, lbound(InData%CNA), ubound(InData%CNA)) call RegPack(Buf, InData%CNA) end if if (RegCheckErr(Buf, RoutineName)) return - ! CNCP call RegPack(Buf, InData%CNCP) if (RegCheckErr(Buf, RoutineName)) return - ! CNIQ call RegPack(Buf, InData%CNIQ) if (RegCheckErr(Buf, RoutineName)) return - ! CNP call RegPack(Buf, allocated(InData%CNP)) if (allocated(InData%CNP)) then call RegPackBounds(Buf, 2, lbound(InData%CNP), ubound(InData%CNP)) call RegPack(Buf, InData%CNP) end if if (RegCheckErr(Buf, RoutineName)) return - ! CNP1 call RegPack(Buf, allocated(InData%CNP1)) if (allocated(InData%CNP1)) then call RegPackBounds(Buf, 2, lbound(InData%CNP1), ubound(InData%CNP1)) call RegPack(Buf, InData%CNP1) end if if (RegCheckErr(Buf, RoutineName)) return - ! CNPD call RegPack(Buf, allocated(InData%CNPD)) if (allocated(InData%CNPD)) then call RegPackBounds(Buf, 2, lbound(InData%CNPD), ubound(InData%CNPD)) call RegPack(Buf, InData%CNPD) end if if (RegCheckErr(Buf, RoutineName)) return - ! CNPD1 call RegPack(Buf, allocated(InData%CNPD1)) if (allocated(InData%CNPD1)) then call RegPackBounds(Buf, 2, lbound(InData%CNPD1), ubound(InData%CNPD1)) call RegPack(Buf, InData%CNPD1) end if if (RegCheckErr(Buf, RoutineName)) return - ! CNPOT call RegPack(Buf, allocated(InData%CNPOT)) if (allocated(InData%CNPOT)) then call RegPackBounds(Buf, 2, lbound(InData%CNPOT), ubound(InData%CNPOT)) call RegPack(Buf, InData%CNPOT) end if if (RegCheckErr(Buf, RoutineName)) return - ! CNPOT1 call RegPack(Buf, allocated(InData%CNPOT1)) if (allocated(InData%CNPOT1)) then call RegPackBounds(Buf, 2, lbound(InData%CNPOT1), ubound(InData%CNPOT1)) call RegPack(Buf, InData%CNPOT1) end if if (RegCheckErr(Buf, RoutineName)) return - ! CNS call RegPack(Buf, allocated(InData%CNS)) if (allocated(InData%CNS)) then call RegPackBounds(Buf, 2, lbound(InData%CNS), ubound(InData%CNS)) call RegPack(Buf, InData%CNS) end if if (RegCheckErr(Buf, RoutineName)) return - ! CNSL call RegPack(Buf, allocated(InData%CNSL)) if (allocated(InData%CNSL)) then call RegPackBounds(Buf, 2, lbound(InData%CNSL), ubound(InData%CNSL)) call RegPack(Buf, InData%CNSL) end if if (RegCheckErr(Buf, RoutineName)) return - ! CNV call RegPack(Buf, allocated(InData%CNV)) if (allocated(InData%CNV)) then call RegPackBounds(Buf, 2, lbound(InData%CNV), ubound(InData%CNV)) call RegPack(Buf, InData%CNV) end if if (RegCheckErr(Buf, RoutineName)) return - ! CVN call RegPack(Buf, allocated(InData%CVN)) if (allocated(InData%CVN)) then call RegPackBounds(Buf, 2, lbound(InData%CVN), ubound(InData%CVN)) call RegPack(Buf, InData%CVN) end if if (RegCheckErr(Buf, RoutineName)) return - ! CVN1 call RegPack(Buf, allocated(InData%CVN1)) if (allocated(InData%CVN1)) then call RegPackBounds(Buf, 2, lbound(InData%CVN1), ubound(InData%CVN1)) call RegPack(Buf, InData%CVN1) end if if (RegCheckErr(Buf, RoutineName)) return - ! DF call RegPack(Buf, allocated(InData%DF)) if (allocated(InData%DF)) then call RegPackBounds(Buf, 2, lbound(InData%DF), ubound(InData%DF)) call RegPack(Buf, InData%DF) end if if (RegCheckErr(Buf, RoutineName)) return - ! DFAFE call RegPack(Buf, allocated(InData%DFAFE)) if (allocated(InData%DFAFE)) then call RegPackBounds(Buf, 2, lbound(InData%DFAFE), ubound(InData%DFAFE)) call RegPack(Buf, InData%DFAFE) end if if (RegCheckErr(Buf, RoutineName)) return - ! DFAFE1 call RegPack(Buf, allocated(InData%DFAFE1)) if (allocated(InData%DFAFE1)) then call RegPackBounds(Buf, 2, lbound(InData%DFAFE1), ubound(InData%DFAFE1)) call RegPack(Buf, InData%DFAFE1) end if if (RegCheckErr(Buf, RoutineName)) return - ! DFC call RegPack(Buf, allocated(InData%DFC)) if (allocated(InData%DFC)) then call RegPackBounds(Buf, 2, lbound(InData%DFC), ubound(InData%DFC)) call RegPack(Buf, InData%DFC) end if if (RegCheckErr(Buf, RoutineName)) return - ! DN call RegPack(Buf, allocated(InData%DN)) if (allocated(InData%DN)) then call RegPackBounds(Buf, 2, lbound(InData%DN), ubound(InData%DN)) call RegPack(Buf, InData%DN) end if if (RegCheckErr(Buf, RoutineName)) return - ! DPP call RegPack(Buf, allocated(InData%DPP)) if (allocated(InData%DPP)) then call RegPackBounds(Buf, 2, lbound(InData%DPP), ubound(InData%DPP)) call RegPack(Buf, InData%DPP) end if if (RegCheckErr(Buf, RoutineName)) return - ! DQ call RegPack(Buf, allocated(InData%DQ)) if (allocated(InData%DQ)) then call RegPackBounds(Buf, 2, lbound(InData%DQ), ubound(InData%DQ)) call RegPack(Buf, InData%DQ) end if if (RegCheckErr(Buf, RoutineName)) return - ! DQP call RegPack(Buf, allocated(InData%DQP)) if (allocated(InData%DQP)) then call RegPackBounds(Buf, 2, lbound(InData%DQP), ubound(InData%DQP)) call RegPack(Buf, InData%DQP) end if if (RegCheckErr(Buf, RoutineName)) return - ! DQP1 call RegPack(Buf, allocated(InData%DQP1)) if (allocated(InData%DQP1)) then call RegPackBounds(Buf, 2, lbound(InData%DQP1), ubound(InData%DQP1)) call RegPack(Buf, InData%DQP1) end if if (RegCheckErr(Buf, RoutineName)) return - ! DS call RegPack(Buf, InData%DS) if (RegCheckErr(Buf, RoutineName)) return - ! FK call RegPack(Buf, InData%FK) if (RegCheckErr(Buf, RoutineName)) return - ! FP call RegPack(Buf, InData%FP) if (RegCheckErr(Buf, RoutineName)) return - ! FPC call RegPack(Buf, InData%FPC) if (RegCheckErr(Buf, RoutineName)) return - ! FSP call RegPack(Buf, allocated(InData%FSP)) if (allocated(InData%FSP)) then call RegPackBounds(Buf, 2, lbound(InData%FSP), ubound(InData%FSP)) call RegPack(Buf, InData%FSP) end if if (RegCheckErr(Buf, RoutineName)) return - ! FSP1 call RegPack(Buf, allocated(InData%FSP1)) if (allocated(InData%FSP1)) then call RegPackBounds(Buf, 2, lbound(InData%FSP1), ubound(InData%FSP1)) call RegPack(Buf, InData%FSP1) end if if (RegCheckErr(Buf, RoutineName)) return - ! FSPC call RegPack(Buf, allocated(InData%FSPC)) if (allocated(InData%FSPC)) then call RegPackBounds(Buf, 2, lbound(InData%FSPC), ubound(InData%FSPC)) call RegPack(Buf, InData%FSPC) end if if (RegCheckErr(Buf, RoutineName)) return - ! FSPC1 call RegPack(Buf, allocated(InData%FSPC1)) if (allocated(InData%FSPC1)) then call RegPackBounds(Buf, 2, lbound(InData%FSPC1), ubound(InData%FSPC1)) call RegPack(Buf, InData%FSPC1) end if if (RegCheckErr(Buf, RoutineName)) return - ! FTB call RegPack(Buf, allocated(InData%FTB)) if (allocated(InData%FTB)) then call RegPackBounds(Buf, 3, lbound(InData%FTB), ubound(InData%FTB)) call RegPack(Buf, InData%FTB) end if if (RegCheckErr(Buf, RoutineName)) return - ! FTBC call RegPack(Buf, allocated(InData%FTBC)) if (allocated(InData%FTBC)) then call RegPackBounds(Buf, 3, lbound(InData%FTBC), ubound(InData%FTBC)) call RegPack(Buf, InData%FTBC) end if if (RegCheckErr(Buf, RoutineName)) return - ! OLDCNV call RegPack(Buf, allocated(InData%OLDCNV)) if (allocated(InData%OLDCNV)) then call RegPackBounds(Buf, 2, lbound(InData%OLDCNV), ubound(InData%OLDCNV)) call RegPack(Buf, InData%OLDCNV) end if if (RegCheckErr(Buf, RoutineName)) return - ! OLDDF call RegPack(Buf, allocated(InData%OLDDF)) if (allocated(InData%OLDDF)) then call RegPackBounds(Buf, 2, lbound(InData%OLDDF), ubound(InData%OLDDF)) call RegPack(Buf, InData%OLDDF) end if if (RegCheckErr(Buf, RoutineName)) return - ! OLDDFC call RegPack(Buf, allocated(InData%OLDDFC)) if (allocated(InData%OLDDFC)) then call RegPackBounds(Buf, 2, lbound(InData%OLDDFC), ubound(InData%OLDDFC)) call RegPack(Buf, InData%OLDDFC) end if if (RegCheckErr(Buf, RoutineName)) return - ! OLDDN call RegPack(Buf, allocated(InData%OLDDN)) if (allocated(InData%OLDDN)) then call RegPackBounds(Buf, 2, lbound(InData%OLDDN), ubound(InData%OLDDN)) call RegPack(Buf, InData%OLDDN) end if if (RegCheckErr(Buf, RoutineName)) return - ! OLDDPP call RegPack(Buf, allocated(InData%OLDDPP)) if (allocated(InData%OLDDPP)) then call RegPackBounds(Buf, 2, lbound(InData%OLDDPP), ubound(InData%OLDDPP)) call RegPack(Buf, InData%OLDDPP) end if if (RegCheckErr(Buf, RoutineName)) return - ! OLDDQ call RegPack(Buf, allocated(InData%OLDDQ)) if (allocated(InData%OLDDQ)) then call RegPackBounds(Buf, 2, lbound(InData%OLDDQ), ubound(InData%OLDDQ)) call RegPack(Buf, InData%OLDDQ) end if if (RegCheckErr(Buf, RoutineName)) return - ! OLDTAU call RegPack(Buf, allocated(InData%OLDTAU)) if (allocated(InData%OLDTAU)) then call RegPackBounds(Buf, 2, lbound(InData%OLDTAU), ubound(InData%OLDTAU)) call RegPack(Buf, InData%OLDTAU) end if if (RegCheckErr(Buf, RoutineName)) return - ! OLDXN call RegPack(Buf, allocated(InData%OLDXN)) if (allocated(InData%OLDXN)) then call RegPackBounds(Buf, 2, lbound(InData%OLDXN), ubound(InData%OLDXN)) call RegPack(Buf, InData%OLDXN) end if if (RegCheckErr(Buf, RoutineName)) return - ! OLDYN call RegPack(Buf, allocated(InData%OLDYN)) if (allocated(InData%OLDYN)) then call RegPackBounds(Buf, 2, lbound(InData%OLDYN), ubound(InData%OLDYN)) call RegPack(Buf, InData%OLDYN) end if if (RegCheckErr(Buf, RoutineName)) return - ! QX call RegPack(Buf, allocated(InData%QX)) if (allocated(InData%QX)) then call RegPackBounds(Buf, 2, lbound(InData%QX), ubound(InData%QX)) call RegPack(Buf, InData%QX) end if if (RegCheckErr(Buf, RoutineName)) return - ! QX1 call RegPack(Buf, allocated(InData%QX1)) if (allocated(InData%QX1)) then call RegPackBounds(Buf, 2, lbound(InData%QX1), ubound(InData%QX1)) call RegPack(Buf, InData%QX1) end if if (RegCheckErr(Buf, RoutineName)) return - ! TAU call RegPack(Buf, allocated(InData%TAU)) if (allocated(InData%TAU)) then call RegPackBounds(Buf, 2, lbound(InData%TAU), ubound(InData%TAU)) call RegPack(Buf, InData%TAU) end if if (RegCheckErr(Buf, RoutineName)) return - ! XN call RegPack(Buf, allocated(InData%XN)) if (allocated(InData%XN)) then call RegPackBounds(Buf, 2, lbound(InData%XN), ubound(InData%XN)) call RegPack(Buf, InData%XN) end if if (RegCheckErr(Buf, RoutineName)) return - ! YN call RegPack(Buf, allocated(InData%YN)) if (allocated(InData%YN)) then call RegPackBounds(Buf, 2, lbound(InData%YN), ubound(InData%YN)) call RegPack(Buf, InData%YN) end if if (RegCheckErr(Buf, RoutineName)) return - ! SHIFT call RegPack(Buf, InData%SHIFT) if (RegCheckErr(Buf, RoutineName)) return - ! VOR call RegPack(Buf, InData%VOR) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2563,7 +2380,6 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! ADOT if (allocated(OutData%ADOT)) deallocate(OutData%ADOT) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2578,7 +2394,6 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%ADOT) if (RegCheckErr(Buf, RoutineName)) return end if - ! ADOT1 if (allocated(OutData%ADOT1)) deallocate(OutData%ADOT1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2593,7 +2408,6 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%ADOT1) if (RegCheckErr(Buf, RoutineName)) return end if - ! AFE if (allocated(OutData%AFE)) deallocate(OutData%AFE) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2608,7 +2422,6 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%AFE) if (RegCheckErr(Buf, RoutineName)) return end if - ! AFE1 if (allocated(OutData%AFE1)) deallocate(OutData%AFE1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2623,10 +2436,8 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%AFE1) if (RegCheckErr(Buf, RoutineName)) return end if - ! AN call RegUnpack(Buf, OutData%AN) if (RegCheckErr(Buf, RoutineName)) return - ! ANE if (allocated(OutData%ANE)) deallocate(OutData%ANE) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2641,7 +2452,6 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%ANE) if (RegCheckErr(Buf, RoutineName)) return end if - ! ANE1 if (allocated(OutData%ANE1)) deallocate(OutData%ANE1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2656,7 +2466,6 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%ANE1) if (RegCheckErr(Buf, RoutineName)) return end if - ! AOD if (allocated(OutData%AOD)) deallocate(OutData%AOD) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2671,7 +2480,6 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%AOD) if (RegCheckErr(Buf, RoutineName)) return end if - ! AOL if (allocated(OutData%AOL)) deallocate(OutData%AOL) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2686,7 +2494,6 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%AOL) if (RegCheckErr(Buf, RoutineName)) return end if - ! BEDSEP if (allocated(OutData%BEDSEP)) deallocate(OutData%BEDSEP) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2701,7 +2508,6 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%BEDSEP) if (RegCheckErr(Buf, RoutineName)) return end if - ! OLDSEP if (allocated(OutData%OLDSEP)) deallocate(OutData%OLDSEP) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2716,10 +2522,8 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%OLDSEP) if (RegCheckErr(Buf, RoutineName)) return end if - ! CC call RegUnpack(Buf, OutData%CC) if (RegCheckErr(Buf, RoutineName)) return - ! CDO if (allocated(OutData%CDO)) deallocate(OutData%CDO) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2734,16 +2538,12 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%CDO) if (RegCheckErr(Buf, RoutineName)) return end if - ! CMI call RegUnpack(Buf, OutData%CMI) if (RegCheckErr(Buf, RoutineName)) return - ! CMQ call RegUnpack(Buf, OutData%CMQ) if (RegCheckErr(Buf, RoutineName)) return - ! CN call RegUnpack(Buf, OutData%CN) if (RegCheckErr(Buf, RoutineName)) return - ! CNA if (allocated(OutData%CNA)) deallocate(OutData%CNA) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2758,13 +2558,10 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%CNA) if (RegCheckErr(Buf, RoutineName)) return end if - ! CNCP call RegUnpack(Buf, OutData%CNCP) if (RegCheckErr(Buf, RoutineName)) return - ! CNIQ call RegUnpack(Buf, OutData%CNIQ) if (RegCheckErr(Buf, RoutineName)) return - ! CNP if (allocated(OutData%CNP)) deallocate(OutData%CNP) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2779,7 +2576,6 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%CNP) if (RegCheckErr(Buf, RoutineName)) return end if - ! CNP1 if (allocated(OutData%CNP1)) deallocate(OutData%CNP1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2794,7 +2590,6 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%CNP1) if (RegCheckErr(Buf, RoutineName)) return end if - ! CNPD if (allocated(OutData%CNPD)) deallocate(OutData%CNPD) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2809,7 +2604,6 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%CNPD) if (RegCheckErr(Buf, RoutineName)) return end if - ! CNPD1 if (allocated(OutData%CNPD1)) deallocate(OutData%CNPD1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2824,7 +2618,6 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%CNPD1) if (RegCheckErr(Buf, RoutineName)) return end if - ! CNPOT if (allocated(OutData%CNPOT)) deallocate(OutData%CNPOT) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2839,7 +2632,6 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%CNPOT) if (RegCheckErr(Buf, RoutineName)) return end if - ! CNPOT1 if (allocated(OutData%CNPOT1)) deallocate(OutData%CNPOT1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2854,7 +2646,6 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%CNPOT1) if (RegCheckErr(Buf, RoutineName)) return end if - ! CNS if (allocated(OutData%CNS)) deallocate(OutData%CNS) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2869,7 +2660,6 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%CNS) if (RegCheckErr(Buf, RoutineName)) return end if - ! CNSL if (allocated(OutData%CNSL)) deallocate(OutData%CNSL) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2884,7 +2674,6 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%CNSL) if (RegCheckErr(Buf, RoutineName)) return end if - ! CNV if (allocated(OutData%CNV)) deallocate(OutData%CNV) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2899,7 +2688,6 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%CNV) if (RegCheckErr(Buf, RoutineName)) return end if - ! CVN if (allocated(OutData%CVN)) deallocate(OutData%CVN) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2914,7 +2702,6 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%CVN) if (RegCheckErr(Buf, RoutineName)) return end if - ! CVN1 if (allocated(OutData%CVN1)) deallocate(OutData%CVN1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2929,7 +2716,6 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%CVN1) if (RegCheckErr(Buf, RoutineName)) return end if - ! DF if (allocated(OutData%DF)) deallocate(OutData%DF) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2944,7 +2730,6 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%DF) if (RegCheckErr(Buf, RoutineName)) return end if - ! DFAFE if (allocated(OutData%DFAFE)) deallocate(OutData%DFAFE) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2959,7 +2744,6 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%DFAFE) if (RegCheckErr(Buf, RoutineName)) return end if - ! DFAFE1 if (allocated(OutData%DFAFE1)) deallocate(OutData%DFAFE1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2974,7 +2758,6 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%DFAFE1) if (RegCheckErr(Buf, RoutineName)) return end if - ! DFC if (allocated(OutData%DFC)) deallocate(OutData%DFC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2989,7 +2772,6 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%DFC) if (RegCheckErr(Buf, RoutineName)) return end if - ! DN if (allocated(OutData%DN)) deallocate(OutData%DN) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3004,7 +2786,6 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%DN) if (RegCheckErr(Buf, RoutineName)) return end if - ! DPP if (allocated(OutData%DPP)) deallocate(OutData%DPP) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3019,7 +2800,6 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%DPP) if (RegCheckErr(Buf, RoutineName)) return end if - ! DQ if (allocated(OutData%DQ)) deallocate(OutData%DQ) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3034,7 +2814,6 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%DQ) if (RegCheckErr(Buf, RoutineName)) return end if - ! DQP if (allocated(OutData%DQP)) deallocate(OutData%DQP) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3049,7 +2828,6 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%DQP) if (RegCheckErr(Buf, RoutineName)) return end if - ! DQP1 if (allocated(OutData%DQP1)) deallocate(OutData%DQP1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3064,19 +2842,14 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%DQP1) if (RegCheckErr(Buf, RoutineName)) return end if - ! DS call RegUnpack(Buf, OutData%DS) if (RegCheckErr(Buf, RoutineName)) return - ! FK call RegUnpack(Buf, OutData%FK) if (RegCheckErr(Buf, RoutineName)) return - ! FP call RegUnpack(Buf, OutData%FP) if (RegCheckErr(Buf, RoutineName)) return - ! FPC call RegUnpack(Buf, OutData%FPC) if (RegCheckErr(Buf, RoutineName)) return - ! FSP if (allocated(OutData%FSP)) deallocate(OutData%FSP) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3091,7 +2864,6 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%FSP) if (RegCheckErr(Buf, RoutineName)) return end if - ! FSP1 if (allocated(OutData%FSP1)) deallocate(OutData%FSP1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3106,7 +2878,6 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%FSP1) if (RegCheckErr(Buf, RoutineName)) return end if - ! FSPC if (allocated(OutData%FSPC)) deallocate(OutData%FSPC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3121,7 +2892,6 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%FSPC) if (RegCheckErr(Buf, RoutineName)) return end if - ! FSPC1 if (allocated(OutData%FSPC1)) deallocate(OutData%FSPC1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3136,7 +2906,6 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%FSPC1) if (RegCheckErr(Buf, RoutineName)) return end if - ! FTB if (allocated(OutData%FTB)) deallocate(OutData%FTB) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3151,7 +2920,6 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%FTB) if (RegCheckErr(Buf, RoutineName)) return end if - ! FTBC if (allocated(OutData%FTBC)) deallocate(OutData%FTBC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3166,7 +2934,6 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%FTBC) if (RegCheckErr(Buf, RoutineName)) return end if - ! OLDCNV if (allocated(OutData%OLDCNV)) deallocate(OutData%OLDCNV) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3181,7 +2948,6 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%OLDCNV) if (RegCheckErr(Buf, RoutineName)) return end if - ! OLDDF if (allocated(OutData%OLDDF)) deallocate(OutData%OLDDF) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3196,7 +2962,6 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%OLDDF) if (RegCheckErr(Buf, RoutineName)) return end if - ! OLDDFC if (allocated(OutData%OLDDFC)) deallocate(OutData%OLDDFC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3211,7 +2976,6 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%OLDDFC) if (RegCheckErr(Buf, RoutineName)) return end if - ! OLDDN if (allocated(OutData%OLDDN)) deallocate(OutData%OLDDN) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3226,7 +2990,6 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%OLDDN) if (RegCheckErr(Buf, RoutineName)) return end if - ! OLDDPP if (allocated(OutData%OLDDPP)) deallocate(OutData%OLDDPP) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3241,7 +3004,6 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%OLDDPP) if (RegCheckErr(Buf, RoutineName)) return end if - ! OLDDQ if (allocated(OutData%OLDDQ)) deallocate(OutData%OLDDQ) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3256,7 +3018,6 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%OLDDQ) if (RegCheckErr(Buf, RoutineName)) return end if - ! OLDTAU if (allocated(OutData%OLDTAU)) deallocate(OutData%OLDTAU) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3271,7 +3032,6 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%OLDTAU) if (RegCheckErr(Buf, RoutineName)) return end if - ! OLDXN if (allocated(OutData%OLDXN)) deallocate(OutData%OLDXN) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3286,7 +3046,6 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%OLDXN) if (RegCheckErr(Buf, RoutineName)) return end if - ! OLDYN if (allocated(OutData%OLDYN)) deallocate(OutData%OLDYN) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3301,7 +3060,6 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%OLDYN) if (RegCheckErr(Buf, RoutineName)) return end if - ! QX if (allocated(OutData%QX)) deallocate(OutData%QX) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3316,7 +3074,6 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%QX) if (RegCheckErr(Buf, RoutineName)) return end if - ! QX1 if (allocated(OutData%QX1)) deallocate(OutData%QX1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3331,7 +3088,6 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%QX1) if (RegCheckErr(Buf, RoutineName)) return end if - ! TAU if (allocated(OutData%TAU)) deallocate(OutData%TAU) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3346,7 +3102,6 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%TAU) if (RegCheckErr(Buf, RoutineName)) return end if - ! XN if (allocated(OutData%XN)) deallocate(OutData%XN) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3361,7 +3116,6 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%XN) if (RegCheckErr(Buf, RoutineName)) return end if - ! YN if (allocated(OutData%YN)) deallocate(OutData%YN) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3376,68 +3130,50 @@ subroutine AD14_UnPackBeddoes(Buf, OutData) call RegUnpack(Buf, OutData%YN) if (RegCheckErr(Buf, RoutineName)) return end if - ! SHIFT call RegUnpack(Buf, OutData%SHIFT) if (RegCheckErr(Buf, RoutineName)) return - ! VOR call RegUnpack(Buf, OutData%VOR) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE AD14_CopyBeddoesParms( SrcBeddoesParmsData, DstBeddoesParmsData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BeddoesParms), INTENT(IN) :: SrcBeddoesParmsData - TYPE(BeddoesParms), INTENT(INOUT) :: DstBeddoesParmsData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_CopyBeddoesParms' -! + +subroutine AD14_CopyBeddoesParms(SrcBeddoesParmsData, DstBeddoesParmsData, CtrlCode, ErrStat, ErrMsg) + type(BeddoesParms), intent(in) :: SrcBeddoesParmsData + type(BeddoesParms), intent(inout) :: DstBeddoesParmsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_CopyBeddoesParms' ErrStat = ErrID_None - ErrMsg = "" - DstBeddoesParmsData%AS = SrcBeddoesParmsData%AS - DstBeddoesParmsData%TF = SrcBeddoesParmsData%TF - DstBeddoesParmsData%TP = SrcBeddoesParmsData%TP - DstBeddoesParmsData%TV = SrcBeddoesParmsData%TV - DstBeddoesParmsData%TVL = SrcBeddoesParmsData%TVL - END SUBROUTINE AD14_CopyBeddoesParms - - SUBROUTINE AD14_DestroyBeddoesParms( BeddoesParmsData, ErrStat, ErrMsg ) - TYPE(BeddoesParms), INTENT(INOUT) :: BeddoesParmsData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyBeddoesParms' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE AD14_DestroyBeddoesParms + ErrMsg = '' + DstBeddoesParmsData%AS = SrcBeddoesParmsData%AS + DstBeddoesParmsData%TF = SrcBeddoesParmsData%TF + DstBeddoesParmsData%TP = SrcBeddoesParmsData%TP + DstBeddoesParmsData%TV = SrcBeddoesParmsData%TV + DstBeddoesParmsData%TVL = SrcBeddoesParmsData%TVL +end subroutine +subroutine AD14_DestroyBeddoesParms(BeddoesParmsData, ErrStat, ErrMsg) + type(BeddoesParms), intent(inout) :: BeddoesParmsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_DestroyBeddoesParms' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine AD14_PackBeddoesParms(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(BeddoesParms), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackBeddoesParms' if (Buf%ErrStat >= AbortErrLev) return - ! AS call RegPack(Buf, InData%AS) if (RegCheckErr(Buf, RoutineName)) return - ! TF call RegPack(Buf, InData%TF) if (RegCheckErr(Buf, RoutineName)) return - ! TP call RegPack(Buf, InData%TP) if (RegCheckErr(Buf, RoutineName)) return - ! TV call RegPack(Buf, InData%TV) if (RegCheckErr(Buf, RoutineName)) return - ! TVL call RegPack(Buf, InData%TVL) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3447,110 +3183,95 @@ subroutine AD14_UnPackBeddoesParms(Buf, OutData) type(BeddoesParms), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackBeddoesParms' if (Buf%ErrStat /= ErrID_None) return - ! AS call RegUnpack(Buf, OutData%AS) if (RegCheckErr(Buf, RoutineName)) return - ! TF call RegUnpack(Buf, OutData%TF) if (RegCheckErr(Buf, RoutineName)) return - ! TP call RegUnpack(Buf, OutData%TP) if (RegCheckErr(Buf, RoutineName)) return - ! TV call RegUnpack(Buf, OutData%TV) if (RegCheckErr(Buf, RoutineName)) return - ! TVL call RegUnpack(Buf, OutData%TVL) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE AD14_CopyBladeParms( SrcBladeParmsData, DstBladeParmsData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BladeParms), INTENT(IN) :: SrcBladeParmsData - TYPE(BladeParms), INTENT(INOUT) :: DstBladeParmsData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_CopyBladeParms' -! + +subroutine AD14_CopyBladeParms(SrcBladeParmsData, DstBladeParmsData, CtrlCode, ErrStat, ErrMsg) + type(BladeParms), intent(in) :: SrcBladeParmsData + type(BladeParms), intent(inout) :: DstBladeParmsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AD14_CopyBladeParms' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcBladeParmsData%C)) THEN - i1_l = LBOUND(SrcBladeParmsData%C,1) - i1_u = UBOUND(SrcBladeParmsData%C,1) - IF (.NOT. ALLOCATED(DstBladeParmsData%C)) THEN - ALLOCATE(DstBladeParmsData%C(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeParmsData%C.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeParmsData%C = SrcBladeParmsData%C -ENDIF -IF (ALLOCATED(SrcBladeParmsData%DR)) THEN - i1_l = LBOUND(SrcBladeParmsData%DR,1) - i1_u = UBOUND(SrcBladeParmsData%DR,1) - IF (.NOT. ALLOCATED(DstBladeParmsData%DR)) THEN - ALLOCATE(DstBladeParmsData%DR(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeParmsData%DR.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeParmsData%DR = SrcBladeParmsData%DR -ENDIF - DstBladeParmsData%R = SrcBladeParmsData%R - DstBladeParmsData%BladeLength = SrcBladeParmsData%BladeLength - END SUBROUTINE AD14_CopyBladeParms - - SUBROUTINE AD14_DestroyBladeParms( BladeParmsData, ErrStat, ErrMsg ) - TYPE(BladeParms), INTENT(INOUT) :: BladeParmsData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyBladeParms' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(BladeParmsData%C)) THEN - DEALLOCATE(BladeParmsData%C) -ENDIF -IF (ALLOCATED(BladeParmsData%DR)) THEN - DEALLOCATE(BladeParmsData%DR) -ENDIF - END SUBROUTINE AD14_DestroyBladeParms + ErrMsg = '' + if (allocated(SrcBladeParmsData%C)) then + LB(1:1) = lbound(SrcBladeParmsData%C) + UB(1:1) = ubound(SrcBladeParmsData%C) + if (.not. allocated(DstBladeParmsData%C)) then + allocate(DstBladeParmsData%C(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeParmsData%C.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeParmsData%C = SrcBladeParmsData%C + else if (allocated(DstBladeParmsData%C)) then + deallocate(DstBladeParmsData%C) + end if + if (allocated(SrcBladeParmsData%DR)) then + LB(1:1) = lbound(SrcBladeParmsData%DR) + UB(1:1) = ubound(SrcBladeParmsData%DR) + if (.not. allocated(DstBladeParmsData%DR)) then + allocate(DstBladeParmsData%DR(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeParmsData%DR.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeParmsData%DR = SrcBladeParmsData%DR + else if (allocated(DstBladeParmsData%DR)) then + deallocate(DstBladeParmsData%DR) + end if + DstBladeParmsData%R = SrcBladeParmsData%R + DstBladeParmsData%BladeLength = SrcBladeParmsData%BladeLength +end subroutine +subroutine AD14_DestroyBladeParms(BladeParmsData, ErrStat, ErrMsg) + type(BladeParms), intent(inout) :: BladeParmsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_DestroyBladeParms' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(BladeParmsData%C)) then + deallocate(BladeParmsData%C) + end if + if (allocated(BladeParmsData%DR)) then + deallocate(BladeParmsData%DR) + end if +end subroutine subroutine AD14_PackBladeParms(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(BladeParms), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackBladeParms' if (Buf%ErrStat >= AbortErrLev) return - ! C call RegPack(Buf, allocated(InData%C)) if (allocated(InData%C)) then call RegPackBounds(Buf, 1, lbound(InData%C), ubound(InData%C)) call RegPack(Buf, InData%C) end if if (RegCheckErr(Buf, RoutineName)) return - ! DR call RegPack(Buf, allocated(InData%DR)) if (allocated(InData%DR)) then call RegPackBounds(Buf, 1, lbound(InData%DR), ubound(InData%DR)) call RegPack(Buf, InData%DR) end if if (RegCheckErr(Buf, RoutineName)) return - ! R call RegPack(Buf, InData%R) if (RegCheckErr(Buf, RoutineName)) return - ! BladeLength call RegPack(Buf, InData%BladeLength) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3563,7 +3284,6 @@ subroutine AD14_UnPackBladeParms(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! C if (allocated(OutData%C)) deallocate(OutData%C) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3578,7 +3298,6 @@ subroutine AD14_UnPackBladeParms(Buf, OutData) call RegUnpack(Buf, OutData%C) if (RegCheckErr(Buf, RoutineName)) return end if - ! DR if (allocated(OutData%DR)) deallocate(OutData%DR) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3593,199 +3312,155 @@ subroutine AD14_UnPackBladeParms(Buf, OutData) call RegUnpack(Buf, OutData%DR) if (RegCheckErr(Buf, RoutineName)) return end if - ! R call RegUnpack(Buf, OutData%R) if (RegCheckErr(Buf, RoutineName)) return - ! BladeLength call RegUnpack(Buf, OutData%BladeLength) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE AD14_CopyDynInflow( SrcDynInflowData, DstDynInflowData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DynInflow), INTENT(IN) :: SrcDynInflowData - TYPE(DynInflow), INTENT(INOUT) :: DstDynInflowData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_CopyDynInflow' -! + +subroutine AD14_CopyDynInflow(SrcDynInflowData, DstDynInflowData, CtrlCode, ErrStat, ErrMsg) + type(DynInflow), intent(in) :: SrcDynInflowData + type(DynInflow), intent(inout) :: DstDynInflowData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AD14_CopyDynInflow' ErrStat = ErrID_None - ErrMsg = "" - DstDynInflowData%dAlph_dt = SrcDynInflowData%dAlph_dt - DstDynInflowData%dBeta_dt = SrcDynInflowData%dBeta_dt - DstDynInflowData%DTO = SrcDynInflowData%DTO - DstDynInflowData%old_Alph = SrcDynInflowData%old_Alph - DstDynInflowData%old_Beta = SrcDynInflowData%old_Beta - DstDynInflowData%old_LmdM = SrcDynInflowData%old_LmdM - DstDynInflowData%oldKai = SrcDynInflowData%oldKai - DstDynInflowData%PhiLqC = SrcDynInflowData%PhiLqC - DstDynInflowData%PhiLqS = SrcDynInflowData%PhiLqS - DstDynInflowData%Pzero = SrcDynInflowData%Pzero -IF (ALLOCATED(SrcDynInflowData%RMC_SAVE)) THEN - i1_l = LBOUND(SrcDynInflowData%RMC_SAVE,1) - i1_u = UBOUND(SrcDynInflowData%RMC_SAVE,1) - i2_l = LBOUND(SrcDynInflowData%RMC_SAVE,2) - i2_u = UBOUND(SrcDynInflowData%RMC_SAVE,2) - i3_l = LBOUND(SrcDynInflowData%RMC_SAVE,3) - i3_u = UBOUND(SrcDynInflowData%RMC_SAVE,3) - IF (.NOT. ALLOCATED(DstDynInflowData%RMC_SAVE)) THEN - ALLOCATE(DstDynInflowData%RMC_SAVE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDynInflowData%RMC_SAVE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDynInflowData%RMC_SAVE = SrcDynInflowData%RMC_SAVE -ENDIF -IF (ALLOCATED(SrcDynInflowData%RMS_SAVE)) THEN - i1_l = LBOUND(SrcDynInflowData%RMS_SAVE,1) - i1_u = UBOUND(SrcDynInflowData%RMS_SAVE,1) - i2_l = LBOUND(SrcDynInflowData%RMS_SAVE,2) - i2_u = UBOUND(SrcDynInflowData%RMS_SAVE,2) - i3_l = LBOUND(SrcDynInflowData%RMS_SAVE,3) - i3_u = UBOUND(SrcDynInflowData%RMS_SAVE,3) - IF (.NOT. ALLOCATED(DstDynInflowData%RMS_SAVE)) THEN - ALLOCATE(DstDynInflowData%RMS_SAVE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDynInflowData%RMS_SAVE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDynInflowData%RMS_SAVE = SrcDynInflowData%RMS_SAVE -ENDIF - DstDynInflowData%TipSpeed = SrcDynInflowData%TipSpeed - DstDynInflowData%totalInf = SrcDynInflowData%totalInf - DstDynInflowData%Vparam = SrcDynInflowData%Vparam - DstDynInflowData%Vtotal = SrcDynInflowData%Vtotal - DstDynInflowData%xAlpha = SrcDynInflowData%xAlpha - DstDynInflowData%xBeta = SrcDynInflowData%xBeta - DstDynInflowData%xKai = SrcDynInflowData%xKai - DstDynInflowData%XLAMBDA_M = SrcDynInflowData%XLAMBDA_M - DstDynInflowData%xLcos = SrcDynInflowData%xLcos - DstDynInflowData%xLsin = SrcDynInflowData%xLsin - DstDynInflowData%MminR = SrcDynInflowData%MminR - DstDynInflowData%MminusR = SrcDynInflowData%MminusR - DstDynInflowData%MplusR = SrcDynInflowData%MplusR - DstDynInflowData%GAMMA = SrcDynInflowData%GAMMA - END SUBROUTINE AD14_CopyDynInflow - - SUBROUTINE AD14_DestroyDynInflow( DynInflowData, ErrStat, ErrMsg ) - TYPE(DynInflow), INTENT(INOUT) :: DynInflowData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyDynInflow' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(DynInflowData%RMC_SAVE)) THEN - DEALLOCATE(DynInflowData%RMC_SAVE) -ENDIF -IF (ALLOCATED(DynInflowData%RMS_SAVE)) THEN - DEALLOCATE(DynInflowData%RMS_SAVE) -ENDIF - END SUBROUTINE AD14_DestroyDynInflow + ErrMsg = '' + DstDynInflowData%dAlph_dt = SrcDynInflowData%dAlph_dt + DstDynInflowData%dBeta_dt = SrcDynInflowData%dBeta_dt + DstDynInflowData%DTO = SrcDynInflowData%DTO + DstDynInflowData%old_Alph = SrcDynInflowData%old_Alph + DstDynInflowData%old_Beta = SrcDynInflowData%old_Beta + DstDynInflowData%old_LmdM = SrcDynInflowData%old_LmdM + DstDynInflowData%oldKai = SrcDynInflowData%oldKai + DstDynInflowData%PhiLqC = SrcDynInflowData%PhiLqC + DstDynInflowData%PhiLqS = SrcDynInflowData%PhiLqS + DstDynInflowData%Pzero = SrcDynInflowData%Pzero + if (allocated(SrcDynInflowData%RMC_SAVE)) then + LB(1:3) = lbound(SrcDynInflowData%RMC_SAVE) + UB(1:3) = ubound(SrcDynInflowData%RMC_SAVE) + if (.not. allocated(DstDynInflowData%RMC_SAVE)) then + allocate(DstDynInflowData%RMC_SAVE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDynInflowData%RMC_SAVE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDynInflowData%RMC_SAVE = SrcDynInflowData%RMC_SAVE + else if (allocated(DstDynInflowData%RMC_SAVE)) then + deallocate(DstDynInflowData%RMC_SAVE) + end if + if (allocated(SrcDynInflowData%RMS_SAVE)) then + LB(1:3) = lbound(SrcDynInflowData%RMS_SAVE) + UB(1:3) = ubound(SrcDynInflowData%RMS_SAVE) + if (.not. allocated(DstDynInflowData%RMS_SAVE)) then + allocate(DstDynInflowData%RMS_SAVE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDynInflowData%RMS_SAVE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDynInflowData%RMS_SAVE = SrcDynInflowData%RMS_SAVE + else if (allocated(DstDynInflowData%RMS_SAVE)) then + deallocate(DstDynInflowData%RMS_SAVE) + end if + DstDynInflowData%TipSpeed = SrcDynInflowData%TipSpeed + DstDynInflowData%totalInf = SrcDynInflowData%totalInf + DstDynInflowData%Vparam = SrcDynInflowData%Vparam + DstDynInflowData%Vtotal = SrcDynInflowData%Vtotal + DstDynInflowData%xAlpha = SrcDynInflowData%xAlpha + DstDynInflowData%xBeta = SrcDynInflowData%xBeta + DstDynInflowData%xKai = SrcDynInflowData%xKai + DstDynInflowData%XLAMBDA_M = SrcDynInflowData%XLAMBDA_M + DstDynInflowData%xLcos = SrcDynInflowData%xLcos + DstDynInflowData%xLsin = SrcDynInflowData%xLsin + DstDynInflowData%MminR = SrcDynInflowData%MminR + DstDynInflowData%MminusR = SrcDynInflowData%MminusR + DstDynInflowData%MplusR = SrcDynInflowData%MplusR + DstDynInflowData%GAMMA = SrcDynInflowData%GAMMA +end subroutine +subroutine AD14_DestroyDynInflow(DynInflowData, ErrStat, ErrMsg) + type(DynInflow), intent(inout) :: DynInflowData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_DestroyDynInflow' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(DynInflowData%RMC_SAVE)) then + deallocate(DynInflowData%RMC_SAVE) + end if + if (allocated(DynInflowData%RMS_SAVE)) then + deallocate(DynInflowData%RMS_SAVE) + end if +end subroutine subroutine AD14_PackDynInflow(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(DynInflow), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackDynInflow' if (Buf%ErrStat >= AbortErrLev) return - ! dAlph_dt call RegPack(Buf, InData%dAlph_dt) if (RegCheckErr(Buf, RoutineName)) return - ! dBeta_dt call RegPack(Buf, InData%dBeta_dt) if (RegCheckErr(Buf, RoutineName)) return - ! DTO call RegPack(Buf, InData%DTO) if (RegCheckErr(Buf, RoutineName)) return - ! old_Alph call RegPack(Buf, InData%old_Alph) if (RegCheckErr(Buf, RoutineName)) return - ! old_Beta call RegPack(Buf, InData%old_Beta) if (RegCheckErr(Buf, RoutineName)) return - ! old_LmdM call RegPack(Buf, InData%old_LmdM) if (RegCheckErr(Buf, RoutineName)) return - ! oldKai call RegPack(Buf, InData%oldKai) if (RegCheckErr(Buf, RoutineName)) return - ! PhiLqC call RegPack(Buf, InData%PhiLqC) if (RegCheckErr(Buf, RoutineName)) return - ! PhiLqS call RegPack(Buf, InData%PhiLqS) if (RegCheckErr(Buf, RoutineName)) return - ! Pzero call RegPack(Buf, InData%Pzero) if (RegCheckErr(Buf, RoutineName)) return - ! RMC_SAVE call RegPack(Buf, allocated(InData%RMC_SAVE)) if (allocated(InData%RMC_SAVE)) then call RegPackBounds(Buf, 3, lbound(InData%RMC_SAVE), ubound(InData%RMC_SAVE)) call RegPack(Buf, InData%RMC_SAVE) end if if (RegCheckErr(Buf, RoutineName)) return - ! RMS_SAVE call RegPack(Buf, allocated(InData%RMS_SAVE)) if (allocated(InData%RMS_SAVE)) then call RegPackBounds(Buf, 3, lbound(InData%RMS_SAVE), ubound(InData%RMS_SAVE)) call RegPack(Buf, InData%RMS_SAVE) end if if (RegCheckErr(Buf, RoutineName)) return - ! TipSpeed call RegPack(Buf, InData%TipSpeed) if (RegCheckErr(Buf, RoutineName)) return - ! totalInf call RegPack(Buf, InData%totalInf) if (RegCheckErr(Buf, RoutineName)) return - ! Vparam call RegPack(Buf, InData%Vparam) if (RegCheckErr(Buf, RoutineName)) return - ! Vtotal call RegPack(Buf, InData%Vtotal) if (RegCheckErr(Buf, RoutineName)) return - ! xAlpha call RegPack(Buf, InData%xAlpha) if (RegCheckErr(Buf, RoutineName)) return - ! xBeta call RegPack(Buf, InData%xBeta) if (RegCheckErr(Buf, RoutineName)) return - ! xKai call RegPack(Buf, InData%xKai) if (RegCheckErr(Buf, RoutineName)) return - ! XLAMBDA_M call RegPack(Buf, InData%XLAMBDA_M) if (RegCheckErr(Buf, RoutineName)) return - ! xLcos call RegPack(Buf, InData%xLcos) if (RegCheckErr(Buf, RoutineName)) return - ! xLsin call RegPack(Buf, InData%xLsin) if (RegCheckErr(Buf, RoutineName)) return - ! MminR call RegPack(Buf, InData%MminR) if (RegCheckErr(Buf, RoutineName)) return - ! MminusR call RegPack(Buf, InData%MminusR) if (RegCheckErr(Buf, RoutineName)) return - ! MplusR call RegPack(Buf, InData%MplusR) if (RegCheckErr(Buf, RoutineName)) return - ! GAMMA call RegPack(Buf, InData%GAMMA) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3798,37 +3473,26 @@ subroutine AD14_UnPackDynInflow(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! dAlph_dt call RegUnpack(Buf, OutData%dAlph_dt) if (RegCheckErr(Buf, RoutineName)) return - ! dBeta_dt call RegUnpack(Buf, OutData%dBeta_dt) if (RegCheckErr(Buf, RoutineName)) return - ! DTO call RegUnpack(Buf, OutData%DTO) if (RegCheckErr(Buf, RoutineName)) return - ! old_Alph call RegUnpack(Buf, OutData%old_Alph) if (RegCheckErr(Buf, RoutineName)) return - ! old_Beta call RegUnpack(Buf, OutData%old_Beta) if (RegCheckErr(Buf, RoutineName)) return - ! old_LmdM call RegUnpack(Buf, OutData%old_LmdM) if (RegCheckErr(Buf, RoutineName)) return - ! oldKai call RegUnpack(Buf, OutData%oldKai) if (RegCheckErr(Buf, RoutineName)) return - ! PhiLqC call RegUnpack(Buf, OutData%PhiLqC) if (RegCheckErr(Buf, RoutineName)) return - ! PhiLqS call RegUnpack(Buf, OutData%PhiLqS) if (RegCheckErr(Buf, RoutineName)) return - ! Pzero call RegUnpack(Buf, OutData%Pzero) if (RegCheckErr(Buf, RoutineName)) return - ! RMC_SAVE if (allocated(OutData%RMC_SAVE)) deallocate(OutData%RMC_SAVE) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3843,7 +3507,6 @@ subroutine AD14_UnPackDynInflow(Buf, OutData) call RegUnpack(Buf, OutData%RMC_SAVE) if (RegCheckErr(Buf, RoutineName)) return end if - ! RMS_SAVE if (allocated(OutData%RMS_SAVE)) deallocate(OutData%RMS_SAVE) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3858,93 +3521,65 @@ subroutine AD14_UnPackDynInflow(Buf, OutData) call RegUnpack(Buf, OutData%RMS_SAVE) if (RegCheckErr(Buf, RoutineName)) return end if - ! TipSpeed call RegUnpack(Buf, OutData%TipSpeed) if (RegCheckErr(Buf, RoutineName)) return - ! totalInf call RegUnpack(Buf, OutData%totalInf) if (RegCheckErr(Buf, RoutineName)) return - ! Vparam call RegUnpack(Buf, OutData%Vparam) if (RegCheckErr(Buf, RoutineName)) return - ! Vtotal call RegUnpack(Buf, OutData%Vtotal) if (RegCheckErr(Buf, RoutineName)) return - ! xAlpha call RegUnpack(Buf, OutData%xAlpha) if (RegCheckErr(Buf, RoutineName)) return - ! xBeta call RegUnpack(Buf, OutData%xBeta) if (RegCheckErr(Buf, RoutineName)) return - ! xKai call RegUnpack(Buf, OutData%xKai) if (RegCheckErr(Buf, RoutineName)) return - ! XLAMBDA_M call RegUnpack(Buf, OutData%XLAMBDA_M) if (RegCheckErr(Buf, RoutineName)) return - ! xLcos call RegUnpack(Buf, OutData%xLcos) if (RegCheckErr(Buf, RoutineName)) return - ! xLsin call RegUnpack(Buf, OutData%xLsin) if (RegCheckErr(Buf, RoutineName)) return - ! MminR call RegUnpack(Buf, OutData%MminR) if (RegCheckErr(Buf, RoutineName)) return - ! MminusR call RegUnpack(Buf, OutData%MminusR) if (RegCheckErr(Buf, RoutineName)) return - ! MplusR call RegUnpack(Buf, OutData%MplusR) if (RegCheckErr(Buf, RoutineName)) return - ! GAMMA call RegUnpack(Buf, OutData%GAMMA) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE AD14_CopyDynInflowParms( SrcDynInflowParmsData, DstDynInflowParmsData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DynInflowParms), INTENT(IN) :: SrcDynInflowParmsData - TYPE(DynInflowParms), INTENT(INOUT) :: DstDynInflowParmsData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_CopyDynInflowParms' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDynInflowParmsData%MAXINFLO = SrcDynInflowParmsData%MAXINFLO - DstDynInflowParmsData%xMinv = SrcDynInflowParmsData%xMinv - END SUBROUTINE AD14_CopyDynInflowParms - - SUBROUTINE AD14_DestroyDynInflowParms( DynInflowParmsData, ErrStat, ErrMsg ) - TYPE(DynInflowParms), INTENT(INOUT) :: DynInflowParmsData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyDynInflowParms' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE AD14_DestroyDynInflowParms +subroutine AD14_CopyDynInflowParms(SrcDynInflowParmsData, DstDynInflowParmsData, CtrlCode, ErrStat, ErrMsg) + type(DynInflowParms), intent(in) :: SrcDynInflowParmsData + type(DynInflowParms), intent(inout) :: DstDynInflowParmsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_CopyDynInflowParms' + ErrStat = ErrID_None + ErrMsg = '' + DstDynInflowParmsData%MAXINFLO = SrcDynInflowParmsData%MAXINFLO + DstDynInflowParmsData%xMinv = SrcDynInflowParmsData%xMinv +end subroutine +subroutine AD14_DestroyDynInflowParms(DynInflowParmsData, ErrStat, ErrMsg) + type(DynInflowParms), intent(inout) :: DynInflowParmsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_DestroyDynInflowParms' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine AD14_PackDynInflowParms(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(DynInflowParms), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackDynInflowParms' if (Buf%ErrStat >= AbortErrLev) return - ! MAXINFLO call RegPack(Buf, InData%MAXINFLO) if (RegCheckErr(Buf, RoutineName)) return - ! xMinv call RegPack(Buf, InData%xMinv) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3954,214 +3589,194 @@ subroutine AD14_UnPackDynInflowParms(Buf, OutData) type(DynInflowParms), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackDynInflowParms' if (Buf%ErrStat /= ErrID_None) return - ! MAXINFLO call RegUnpack(Buf, OutData%MAXINFLO) if (RegCheckErr(Buf, RoutineName)) return - ! xMinv call RegUnpack(Buf, OutData%xMinv) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE AD14_CopyElement( SrcElementData, DstElementData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Element), INTENT(IN) :: SrcElementData - TYPE(Element), INTENT(INOUT) :: DstElementData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_CopyElement' -! + +subroutine AD14_CopyElement(SrcElementData, DstElementData, CtrlCode, ErrStat, ErrMsg) + type(Element), intent(in) :: SrcElementData + type(Element), intent(inout) :: DstElementData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AD14_CopyElement' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcElementData%A)) THEN - i1_l = LBOUND(SrcElementData%A,1) - i1_u = UBOUND(SrcElementData%A,1) - i2_l = LBOUND(SrcElementData%A,2) - i2_u = UBOUND(SrcElementData%A,2) - IF (.NOT. ALLOCATED(DstElementData%A)) THEN - ALLOCATE(DstElementData%A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElementData%A.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElementData%A = SrcElementData%A -ENDIF -IF (ALLOCATED(SrcElementData%AP)) THEN - i1_l = LBOUND(SrcElementData%AP,1) - i1_u = UBOUND(SrcElementData%AP,1) - i2_l = LBOUND(SrcElementData%AP,2) - i2_u = UBOUND(SrcElementData%AP,2) - IF (.NOT. ALLOCATED(DstElementData%AP)) THEN - ALLOCATE(DstElementData%AP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElementData%AP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElementData%AP = SrcElementData%AP -ENDIF -IF (ALLOCATED(SrcElementData%ALPHA)) THEN - i1_l = LBOUND(SrcElementData%ALPHA,1) - i1_u = UBOUND(SrcElementData%ALPHA,1) - i2_l = LBOUND(SrcElementData%ALPHA,2) - i2_u = UBOUND(SrcElementData%ALPHA,2) - IF (.NOT. ALLOCATED(DstElementData%ALPHA)) THEN - ALLOCATE(DstElementData%ALPHA(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElementData%ALPHA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElementData%ALPHA = SrcElementData%ALPHA -ENDIF -IF (ALLOCATED(SrcElementData%W2)) THEN - i1_l = LBOUND(SrcElementData%W2,1) - i1_u = UBOUND(SrcElementData%W2,1) - i2_l = LBOUND(SrcElementData%W2,2) - i2_u = UBOUND(SrcElementData%W2,2) - IF (.NOT. ALLOCATED(DstElementData%W2)) THEN - ALLOCATE(DstElementData%W2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElementData%W2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElementData%W2 = SrcElementData%W2 -ENDIF -IF (ALLOCATED(SrcElementData%OLD_A_NS)) THEN - i1_l = LBOUND(SrcElementData%OLD_A_NS,1) - i1_u = UBOUND(SrcElementData%OLD_A_NS,1) - i2_l = LBOUND(SrcElementData%OLD_A_NS,2) - i2_u = UBOUND(SrcElementData%OLD_A_NS,2) - IF (.NOT. ALLOCATED(DstElementData%OLD_A_NS)) THEN - ALLOCATE(DstElementData%OLD_A_NS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElementData%OLD_A_NS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElementData%OLD_A_NS = SrcElementData%OLD_A_NS -ENDIF -IF (ALLOCATED(SrcElementData%OLD_AP_NS)) THEN - i1_l = LBOUND(SrcElementData%OLD_AP_NS,1) - i1_u = UBOUND(SrcElementData%OLD_AP_NS,1) - i2_l = LBOUND(SrcElementData%OLD_AP_NS,2) - i2_u = UBOUND(SrcElementData%OLD_AP_NS,2) - IF (.NOT. ALLOCATED(DstElementData%OLD_AP_NS)) THEN - ALLOCATE(DstElementData%OLD_AP_NS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElementData%OLD_AP_NS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElementData%OLD_AP_NS = SrcElementData%OLD_AP_NS -ENDIF -IF (ALLOCATED(SrcElementData%PITNOW)) THEN - i1_l = LBOUND(SrcElementData%PITNOW,1) - i1_u = UBOUND(SrcElementData%PITNOW,1) - i2_l = LBOUND(SrcElementData%PITNOW,2) - i2_u = UBOUND(SrcElementData%PITNOW,2) - IF (.NOT. ALLOCATED(DstElementData%PITNOW)) THEN - ALLOCATE(DstElementData%PITNOW(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElementData%PITNOW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElementData%PITNOW = SrcElementData%PITNOW -ENDIF - END SUBROUTINE AD14_CopyElement - - SUBROUTINE AD14_DestroyElement( ElementData, ErrStat, ErrMsg ) - TYPE(Element), INTENT(INOUT) :: ElementData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyElement' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ElementData%A)) THEN - DEALLOCATE(ElementData%A) -ENDIF -IF (ALLOCATED(ElementData%AP)) THEN - DEALLOCATE(ElementData%AP) -ENDIF -IF (ALLOCATED(ElementData%ALPHA)) THEN - DEALLOCATE(ElementData%ALPHA) -ENDIF -IF (ALLOCATED(ElementData%W2)) THEN - DEALLOCATE(ElementData%W2) -ENDIF -IF (ALLOCATED(ElementData%OLD_A_NS)) THEN - DEALLOCATE(ElementData%OLD_A_NS) -ENDIF -IF (ALLOCATED(ElementData%OLD_AP_NS)) THEN - DEALLOCATE(ElementData%OLD_AP_NS) -ENDIF -IF (ALLOCATED(ElementData%PITNOW)) THEN - DEALLOCATE(ElementData%PITNOW) -ENDIF - END SUBROUTINE AD14_DestroyElement + ErrMsg = '' + if (allocated(SrcElementData%A)) then + LB(1:2) = lbound(SrcElementData%A) + UB(1:2) = ubound(SrcElementData%A) + if (.not. allocated(DstElementData%A)) then + allocate(DstElementData%A(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElementData%A.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElementData%A = SrcElementData%A + else if (allocated(DstElementData%A)) then + deallocate(DstElementData%A) + end if + if (allocated(SrcElementData%AP)) then + LB(1:2) = lbound(SrcElementData%AP) + UB(1:2) = ubound(SrcElementData%AP) + if (.not. allocated(DstElementData%AP)) then + allocate(DstElementData%AP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElementData%AP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElementData%AP = SrcElementData%AP + else if (allocated(DstElementData%AP)) then + deallocate(DstElementData%AP) + end if + if (allocated(SrcElementData%ALPHA)) then + LB(1:2) = lbound(SrcElementData%ALPHA) + UB(1:2) = ubound(SrcElementData%ALPHA) + if (.not. allocated(DstElementData%ALPHA)) then + allocate(DstElementData%ALPHA(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElementData%ALPHA.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElementData%ALPHA = SrcElementData%ALPHA + else if (allocated(DstElementData%ALPHA)) then + deallocate(DstElementData%ALPHA) + end if + if (allocated(SrcElementData%W2)) then + LB(1:2) = lbound(SrcElementData%W2) + UB(1:2) = ubound(SrcElementData%W2) + if (.not. allocated(DstElementData%W2)) then + allocate(DstElementData%W2(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElementData%W2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElementData%W2 = SrcElementData%W2 + else if (allocated(DstElementData%W2)) then + deallocate(DstElementData%W2) + end if + if (allocated(SrcElementData%OLD_A_NS)) then + LB(1:2) = lbound(SrcElementData%OLD_A_NS) + UB(1:2) = ubound(SrcElementData%OLD_A_NS) + if (.not. allocated(DstElementData%OLD_A_NS)) then + allocate(DstElementData%OLD_A_NS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElementData%OLD_A_NS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElementData%OLD_A_NS = SrcElementData%OLD_A_NS + else if (allocated(DstElementData%OLD_A_NS)) then + deallocate(DstElementData%OLD_A_NS) + end if + if (allocated(SrcElementData%OLD_AP_NS)) then + LB(1:2) = lbound(SrcElementData%OLD_AP_NS) + UB(1:2) = ubound(SrcElementData%OLD_AP_NS) + if (.not. allocated(DstElementData%OLD_AP_NS)) then + allocate(DstElementData%OLD_AP_NS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElementData%OLD_AP_NS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElementData%OLD_AP_NS = SrcElementData%OLD_AP_NS + else if (allocated(DstElementData%OLD_AP_NS)) then + deallocate(DstElementData%OLD_AP_NS) + end if + if (allocated(SrcElementData%PITNOW)) then + LB(1:2) = lbound(SrcElementData%PITNOW) + UB(1:2) = ubound(SrcElementData%PITNOW) + if (.not. allocated(DstElementData%PITNOW)) then + allocate(DstElementData%PITNOW(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElementData%PITNOW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElementData%PITNOW = SrcElementData%PITNOW + else if (allocated(DstElementData%PITNOW)) then + deallocate(DstElementData%PITNOW) + end if +end subroutine +subroutine AD14_DestroyElement(ElementData, ErrStat, ErrMsg) + type(Element), intent(inout) :: ElementData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_DestroyElement' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ElementData%A)) then + deallocate(ElementData%A) + end if + if (allocated(ElementData%AP)) then + deallocate(ElementData%AP) + end if + if (allocated(ElementData%ALPHA)) then + deallocate(ElementData%ALPHA) + end if + if (allocated(ElementData%W2)) then + deallocate(ElementData%W2) + end if + if (allocated(ElementData%OLD_A_NS)) then + deallocate(ElementData%OLD_A_NS) + end if + if (allocated(ElementData%OLD_AP_NS)) then + deallocate(ElementData%OLD_AP_NS) + end if + if (allocated(ElementData%PITNOW)) then + deallocate(ElementData%PITNOW) + end if +end subroutine subroutine AD14_PackElement(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Element), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackElement' if (Buf%ErrStat >= AbortErrLev) return - ! A call RegPack(Buf, allocated(InData%A)) if (allocated(InData%A)) then call RegPackBounds(Buf, 2, lbound(InData%A), ubound(InData%A)) call RegPack(Buf, InData%A) end if if (RegCheckErr(Buf, RoutineName)) return - ! AP call RegPack(Buf, allocated(InData%AP)) if (allocated(InData%AP)) then call RegPackBounds(Buf, 2, lbound(InData%AP), ubound(InData%AP)) call RegPack(Buf, InData%AP) end if if (RegCheckErr(Buf, RoutineName)) return - ! ALPHA call RegPack(Buf, allocated(InData%ALPHA)) if (allocated(InData%ALPHA)) then call RegPackBounds(Buf, 2, lbound(InData%ALPHA), ubound(InData%ALPHA)) call RegPack(Buf, InData%ALPHA) end if if (RegCheckErr(Buf, RoutineName)) return - ! W2 call RegPack(Buf, allocated(InData%W2)) if (allocated(InData%W2)) then call RegPackBounds(Buf, 2, lbound(InData%W2), ubound(InData%W2)) call RegPack(Buf, InData%W2) end if if (RegCheckErr(Buf, RoutineName)) return - ! OLD_A_NS call RegPack(Buf, allocated(InData%OLD_A_NS)) if (allocated(InData%OLD_A_NS)) then call RegPackBounds(Buf, 2, lbound(InData%OLD_A_NS), ubound(InData%OLD_A_NS)) call RegPack(Buf, InData%OLD_A_NS) end if if (RegCheckErr(Buf, RoutineName)) return - ! OLD_AP_NS call RegPack(Buf, allocated(InData%OLD_AP_NS)) if (allocated(InData%OLD_AP_NS)) then call RegPackBounds(Buf, 2, lbound(InData%OLD_AP_NS), ubound(InData%OLD_AP_NS)) call RegPack(Buf, InData%OLD_AP_NS) end if if (RegCheckErr(Buf, RoutineName)) return - ! PITNOW call RegPack(Buf, allocated(InData%PITNOW)) if (allocated(InData%PITNOW)) then call RegPackBounds(Buf, 2, lbound(InData%PITNOW), ubound(InData%PITNOW)) @@ -4178,7 +3793,6 @@ subroutine AD14_UnPackElement(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! A if (allocated(OutData%A)) deallocate(OutData%A) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4193,7 +3807,6 @@ subroutine AD14_UnPackElement(Buf, OutData) call RegUnpack(Buf, OutData%A) if (RegCheckErr(Buf, RoutineName)) return end if - ! AP if (allocated(OutData%AP)) deallocate(OutData%AP) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4208,7 +3821,6 @@ subroutine AD14_UnPackElement(Buf, OutData) call RegUnpack(Buf, OutData%AP) if (RegCheckErr(Buf, RoutineName)) return end if - ! ALPHA if (allocated(OutData%ALPHA)) deallocate(OutData%ALPHA) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4223,7 +3835,6 @@ subroutine AD14_UnPackElement(Buf, OutData) call RegUnpack(Buf, OutData%ALPHA) if (RegCheckErr(Buf, RoutineName)) return end if - ! W2 if (allocated(OutData%W2)) deallocate(OutData%W2) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4238,7 +3849,6 @@ subroutine AD14_UnPackElement(Buf, OutData) call RegUnpack(Buf, OutData%W2) if (RegCheckErr(Buf, RoutineName)) return end if - ! OLD_A_NS if (allocated(OutData%OLD_A_NS)) deallocate(OutData%OLD_A_NS) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4253,7 +3863,6 @@ subroutine AD14_UnPackElement(Buf, OutData) call RegUnpack(Buf, OutData%OLD_A_NS) if (RegCheckErr(Buf, RoutineName)) return end if - ! OLD_AP_NS if (allocated(OutData%OLD_AP_NS)) deallocate(OutData%OLD_AP_NS) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4268,7 +3877,6 @@ subroutine AD14_UnPackElement(Buf, OutData) call RegUnpack(Buf, OutData%OLD_AP_NS) if (RegCheckErr(Buf, RoutineName)) return end if - ! PITNOW if (allocated(OutData%PITNOW)) deallocate(OutData%PITNOW) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4284,130 +3892,123 @@ subroutine AD14_UnPackElement(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE AD14_CopyElementParms( SrcElementParmsData, DstElementParmsData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ElementParms), INTENT(IN) :: SrcElementParmsData - TYPE(ElementParms), INTENT(INOUT) :: DstElementParmsData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_CopyElementParms' -! + +subroutine AD14_CopyElementParms(SrcElementParmsData, DstElementParmsData, CtrlCode, ErrStat, ErrMsg) + type(ElementParms), intent(in) :: SrcElementParmsData + type(ElementParms), intent(inout) :: DstElementParmsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AD14_CopyElementParms' ErrStat = ErrID_None - ErrMsg = "" - DstElementParmsData%NELM = SrcElementParmsData%NELM -IF (ALLOCATED(SrcElementParmsData%TWIST)) THEN - i1_l = LBOUND(SrcElementParmsData%TWIST,1) - i1_u = UBOUND(SrcElementParmsData%TWIST,1) - IF (.NOT. ALLOCATED(DstElementParmsData%TWIST)) THEN - ALLOCATE(DstElementParmsData%TWIST(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElementParmsData%TWIST.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElementParmsData%TWIST = SrcElementParmsData%TWIST -ENDIF -IF (ALLOCATED(SrcElementParmsData%RELM)) THEN - i1_l = LBOUND(SrcElementParmsData%RELM,1) - i1_u = UBOUND(SrcElementParmsData%RELM,1) - IF (.NOT. ALLOCATED(DstElementParmsData%RELM)) THEN - ALLOCATE(DstElementParmsData%RELM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElementParmsData%RELM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElementParmsData%RELM = SrcElementParmsData%RELM -ENDIF -IF (ALLOCATED(SrcElementParmsData%HLCNST)) THEN - i1_l = LBOUND(SrcElementParmsData%HLCNST,1) - i1_u = UBOUND(SrcElementParmsData%HLCNST,1) - IF (.NOT. ALLOCATED(DstElementParmsData%HLCNST)) THEN - ALLOCATE(DstElementParmsData%HLCNST(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElementParmsData%HLCNST.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElementParmsData%HLCNST = SrcElementParmsData%HLCNST -ENDIF -IF (ALLOCATED(SrcElementParmsData%TLCNST)) THEN - i1_l = LBOUND(SrcElementParmsData%TLCNST,1) - i1_u = UBOUND(SrcElementParmsData%TLCNST,1) - IF (.NOT. ALLOCATED(DstElementParmsData%TLCNST)) THEN - ALLOCATE(DstElementParmsData%TLCNST(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElementParmsData%TLCNST.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElementParmsData%TLCNST = SrcElementParmsData%TLCNST -ENDIF - END SUBROUTINE AD14_CopyElementParms - - SUBROUTINE AD14_DestroyElementParms( ElementParmsData, ErrStat, ErrMsg ) - TYPE(ElementParms), INTENT(INOUT) :: ElementParmsData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyElementParms' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ElementParmsData%TWIST)) THEN - DEALLOCATE(ElementParmsData%TWIST) -ENDIF -IF (ALLOCATED(ElementParmsData%RELM)) THEN - DEALLOCATE(ElementParmsData%RELM) -ENDIF -IF (ALLOCATED(ElementParmsData%HLCNST)) THEN - DEALLOCATE(ElementParmsData%HLCNST) -ENDIF -IF (ALLOCATED(ElementParmsData%TLCNST)) THEN - DEALLOCATE(ElementParmsData%TLCNST) -ENDIF - END SUBROUTINE AD14_DestroyElementParms + ErrMsg = '' + DstElementParmsData%NELM = SrcElementParmsData%NELM + if (allocated(SrcElementParmsData%TWIST)) then + LB(1:1) = lbound(SrcElementParmsData%TWIST) + UB(1:1) = ubound(SrcElementParmsData%TWIST) + if (.not. allocated(DstElementParmsData%TWIST)) then + allocate(DstElementParmsData%TWIST(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElementParmsData%TWIST.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElementParmsData%TWIST = SrcElementParmsData%TWIST + else if (allocated(DstElementParmsData%TWIST)) then + deallocate(DstElementParmsData%TWIST) + end if + if (allocated(SrcElementParmsData%RELM)) then + LB(1:1) = lbound(SrcElementParmsData%RELM) + UB(1:1) = ubound(SrcElementParmsData%RELM) + if (.not. allocated(DstElementParmsData%RELM)) then + allocate(DstElementParmsData%RELM(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElementParmsData%RELM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElementParmsData%RELM = SrcElementParmsData%RELM + else if (allocated(DstElementParmsData%RELM)) then + deallocate(DstElementParmsData%RELM) + end if + if (allocated(SrcElementParmsData%HLCNST)) then + LB(1:1) = lbound(SrcElementParmsData%HLCNST) + UB(1:1) = ubound(SrcElementParmsData%HLCNST) + if (.not. allocated(DstElementParmsData%HLCNST)) then + allocate(DstElementParmsData%HLCNST(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElementParmsData%HLCNST.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElementParmsData%HLCNST = SrcElementParmsData%HLCNST + else if (allocated(DstElementParmsData%HLCNST)) then + deallocate(DstElementParmsData%HLCNST) + end if + if (allocated(SrcElementParmsData%TLCNST)) then + LB(1:1) = lbound(SrcElementParmsData%TLCNST) + UB(1:1) = ubound(SrcElementParmsData%TLCNST) + if (.not. allocated(DstElementParmsData%TLCNST)) then + allocate(DstElementParmsData%TLCNST(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElementParmsData%TLCNST.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElementParmsData%TLCNST = SrcElementParmsData%TLCNST + else if (allocated(DstElementParmsData%TLCNST)) then + deallocate(DstElementParmsData%TLCNST) + end if +end subroutine +subroutine AD14_DestroyElementParms(ElementParmsData, ErrStat, ErrMsg) + type(ElementParms), intent(inout) :: ElementParmsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_DestroyElementParms' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ElementParmsData%TWIST)) then + deallocate(ElementParmsData%TWIST) + end if + if (allocated(ElementParmsData%RELM)) then + deallocate(ElementParmsData%RELM) + end if + if (allocated(ElementParmsData%HLCNST)) then + deallocate(ElementParmsData%HLCNST) + end if + if (allocated(ElementParmsData%TLCNST)) then + deallocate(ElementParmsData%TLCNST) + end if +end subroutine subroutine AD14_PackElementParms(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ElementParms), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackElementParms' if (Buf%ErrStat >= AbortErrLev) return - ! NELM call RegPack(Buf, InData%NELM) if (RegCheckErr(Buf, RoutineName)) return - ! TWIST call RegPack(Buf, allocated(InData%TWIST)) if (allocated(InData%TWIST)) then call RegPackBounds(Buf, 1, lbound(InData%TWIST), ubound(InData%TWIST)) call RegPack(Buf, InData%TWIST) end if if (RegCheckErr(Buf, RoutineName)) return - ! RELM call RegPack(Buf, allocated(InData%RELM)) if (allocated(InData%RELM)) then call RegPackBounds(Buf, 1, lbound(InData%RELM), ubound(InData%RELM)) call RegPack(Buf, InData%RELM) end if if (RegCheckErr(Buf, RoutineName)) return - ! HLCNST call RegPack(Buf, allocated(InData%HLCNST)) if (allocated(InData%HLCNST)) then call RegPackBounds(Buf, 1, lbound(InData%HLCNST), ubound(InData%HLCNST)) call RegPack(Buf, InData%HLCNST) end if if (RegCheckErr(Buf, RoutineName)) return - ! TLCNST call RegPack(Buf, allocated(InData%TLCNST)) if (allocated(InData%TLCNST)) then call RegPackBounds(Buf, 1, lbound(InData%TLCNST), ubound(InData%TLCNST)) @@ -4424,10 +4025,8 @@ subroutine AD14_UnPackElementParms(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! NELM call RegUnpack(Buf, OutData%NELM) if (RegCheckErr(Buf, RoutineName)) return - ! TWIST if (allocated(OutData%TWIST)) deallocate(OutData%TWIST) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4442,7 +4041,6 @@ subroutine AD14_UnPackElementParms(Buf, OutData) call RegUnpack(Buf, OutData%TWIST) if (RegCheckErr(Buf, RoutineName)) return end if - ! RELM if (allocated(OutData%RELM)) deallocate(OutData%RELM) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4457,7 +4055,6 @@ subroutine AD14_UnPackElementParms(Buf, OutData) call RegUnpack(Buf, OutData%RELM) if (RegCheckErr(Buf, RoutineName)) return end if - ! HLCNST if (allocated(OutData%HLCNST)) deallocate(OutData%HLCNST) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4472,7 +4069,6 @@ subroutine AD14_UnPackElementParms(Buf, OutData) call RegUnpack(Buf, OutData%HLCNST) if (RegCheckErr(Buf, RoutineName)) return end if - ! TLCNST if (allocated(OutData%TLCNST)) deallocate(OutData%TLCNST) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4488,553 +4084,553 @@ subroutine AD14_UnPackElementParms(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE AD14_CopyElOutParms( SrcElOutParmsData, DstElOutParmsData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ElOutParms), INTENT(IN) :: SrcElOutParmsData - TYPE(ElOutParms), INTENT(INOUT) :: DstElOutParmsData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_CopyElOutParms' -! + +subroutine AD14_CopyElOutParms(SrcElOutParmsData, DstElOutParmsData, CtrlCode, ErrStat, ErrMsg) + type(ElOutParms), intent(in) :: SrcElOutParmsData + type(ElOutParms), intent(inout) :: DstElOutParmsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AD14_CopyElOutParms' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcElOutParmsData%AAA)) THEN - i1_l = LBOUND(SrcElOutParmsData%AAA,1) - i1_u = UBOUND(SrcElOutParmsData%AAA,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%AAA)) THEN - ALLOCATE(DstElOutParmsData%AAA(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%AAA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%AAA = SrcElOutParmsData%AAA -ENDIF -IF (ALLOCATED(SrcElOutParmsData%AAP)) THEN - i1_l = LBOUND(SrcElOutParmsData%AAP,1) - i1_u = UBOUND(SrcElOutParmsData%AAP,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%AAP)) THEN - ALLOCATE(DstElOutParmsData%AAP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%AAP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%AAP = SrcElOutParmsData%AAP -ENDIF -IF (ALLOCATED(SrcElOutParmsData%ALF)) THEN - i1_l = LBOUND(SrcElOutParmsData%ALF,1) - i1_u = UBOUND(SrcElOutParmsData%ALF,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%ALF)) THEN - ALLOCATE(DstElOutParmsData%ALF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%ALF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%ALF = SrcElOutParmsData%ALF -ENDIF -IF (ALLOCATED(SrcElOutParmsData%CDD)) THEN - i1_l = LBOUND(SrcElOutParmsData%CDD,1) - i1_u = UBOUND(SrcElOutParmsData%CDD,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%CDD)) THEN - ALLOCATE(DstElOutParmsData%CDD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%CDD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%CDD = SrcElOutParmsData%CDD -ENDIF -IF (ALLOCATED(SrcElOutParmsData%CLL)) THEN - i1_l = LBOUND(SrcElOutParmsData%CLL,1) - i1_u = UBOUND(SrcElOutParmsData%CLL,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%CLL)) THEN - ALLOCATE(DstElOutParmsData%CLL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%CLL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%CLL = SrcElOutParmsData%CLL -ENDIF -IF (ALLOCATED(SrcElOutParmsData%CMM)) THEN - i1_l = LBOUND(SrcElOutParmsData%CMM,1) - i1_u = UBOUND(SrcElOutParmsData%CMM,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%CMM)) THEN - ALLOCATE(DstElOutParmsData%CMM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%CMM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%CMM = SrcElOutParmsData%CMM -ENDIF -IF (ALLOCATED(SrcElOutParmsData%CNN)) THEN - i1_l = LBOUND(SrcElOutParmsData%CNN,1) - i1_u = UBOUND(SrcElOutParmsData%CNN,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%CNN)) THEN - ALLOCATE(DstElOutParmsData%CNN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%CNN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%CNN = SrcElOutParmsData%CNN -ENDIF -IF (ALLOCATED(SrcElOutParmsData%CTT)) THEN - i1_l = LBOUND(SrcElOutParmsData%CTT,1) - i1_u = UBOUND(SrcElOutParmsData%CTT,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%CTT)) THEN - ALLOCATE(DstElOutParmsData%CTT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%CTT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%CTT = SrcElOutParmsData%CTT -ENDIF -IF (ALLOCATED(SrcElOutParmsData%DFNSAV)) THEN - i1_l = LBOUND(SrcElOutParmsData%DFNSAV,1) - i1_u = UBOUND(SrcElOutParmsData%DFNSAV,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%DFNSAV)) THEN - ALLOCATE(DstElOutParmsData%DFNSAV(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%DFNSAV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%DFNSAV = SrcElOutParmsData%DFNSAV -ENDIF -IF (ALLOCATED(SrcElOutParmsData%DFTSAV)) THEN - i1_l = LBOUND(SrcElOutParmsData%DFTSAV,1) - i1_u = UBOUND(SrcElOutParmsData%DFTSAV,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%DFTSAV)) THEN - ALLOCATE(DstElOutParmsData%DFTSAV(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%DFTSAV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%DFTSAV = SrcElOutParmsData%DFTSAV -ENDIF -IF (ALLOCATED(SrcElOutParmsData%DynPres)) THEN - i1_l = LBOUND(SrcElOutParmsData%DynPres,1) - i1_u = UBOUND(SrcElOutParmsData%DynPres,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%DynPres)) THEN - ALLOCATE(DstElOutParmsData%DynPres(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%DynPres.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%DynPres = SrcElOutParmsData%DynPres -ENDIF -IF (ALLOCATED(SrcElOutParmsData%PMM)) THEN - i1_l = LBOUND(SrcElOutParmsData%PMM,1) - i1_u = UBOUND(SrcElOutParmsData%PMM,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%PMM)) THEN - ALLOCATE(DstElOutParmsData%PMM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%PMM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%PMM = SrcElOutParmsData%PMM -ENDIF -IF (ALLOCATED(SrcElOutParmsData%PITSAV)) THEN - i1_l = LBOUND(SrcElOutParmsData%PITSAV,1) - i1_u = UBOUND(SrcElOutParmsData%PITSAV,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%PITSAV)) THEN - ALLOCATE(DstElOutParmsData%PITSAV(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%PITSAV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%PITSAV = SrcElOutParmsData%PITSAV -ENDIF -IF (ALLOCATED(SrcElOutParmsData%ReyNum)) THEN - i1_l = LBOUND(SrcElOutParmsData%ReyNum,1) - i1_u = UBOUND(SrcElOutParmsData%ReyNum,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%ReyNum)) THEN - ALLOCATE(DstElOutParmsData%ReyNum(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%ReyNum.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%ReyNum = SrcElOutParmsData%ReyNum -ENDIF -IF (ALLOCATED(SrcElOutParmsData%Gamma)) THEN - i1_l = LBOUND(SrcElOutParmsData%Gamma,1) - i1_u = UBOUND(SrcElOutParmsData%Gamma,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%Gamma)) THEN - ALLOCATE(DstElOutParmsData%Gamma(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%Gamma.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%Gamma = SrcElOutParmsData%Gamma -ENDIF -IF (ALLOCATED(SrcElOutParmsData%SaveVX)) THEN - i1_l = LBOUND(SrcElOutParmsData%SaveVX,1) - i1_u = UBOUND(SrcElOutParmsData%SaveVX,1) - i2_l = LBOUND(SrcElOutParmsData%SaveVX,2) - i2_u = UBOUND(SrcElOutParmsData%SaveVX,2) - IF (.NOT. ALLOCATED(DstElOutParmsData%SaveVX)) THEN - ALLOCATE(DstElOutParmsData%SaveVX(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%SaveVX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%SaveVX = SrcElOutParmsData%SaveVX -ENDIF -IF (ALLOCATED(SrcElOutParmsData%SaveVY)) THEN - i1_l = LBOUND(SrcElOutParmsData%SaveVY,1) - i1_u = UBOUND(SrcElOutParmsData%SaveVY,1) - i2_l = LBOUND(SrcElOutParmsData%SaveVY,2) - i2_u = UBOUND(SrcElOutParmsData%SaveVY,2) - IF (.NOT. ALLOCATED(DstElOutParmsData%SaveVY)) THEN - ALLOCATE(DstElOutParmsData%SaveVY(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%SaveVY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%SaveVY = SrcElOutParmsData%SaveVY -ENDIF -IF (ALLOCATED(SrcElOutParmsData%SaveVZ)) THEN - i1_l = LBOUND(SrcElOutParmsData%SaveVZ,1) - i1_u = UBOUND(SrcElOutParmsData%SaveVZ,1) - i2_l = LBOUND(SrcElOutParmsData%SaveVZ,2) - i2_u = UBOUND(SrcElOutParmsData%SaveVZ,2) - IF (.NOT. ALLOCATED(DstElOutParmsData%SaveVZ)) THEN - ALLOCATE(DstElOutParmsData%SaveVZ(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%SaveVZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%SaveVZ = SrcElOutParmsData%SaveVZ -ENDIF - DstElOutParmsData%VXSAV = SrcElOutParmsData%VXSAV - DstElOutParmsData%VYSAV = SrcElOutParmsData%VYSAV - DstElOutParmsData%VZSAV = SrcElOutParmsData%VZSAV - DstElOutParmsData%NumWndElOut = SrcElOutParmsData%NumWndElOut -IF (ALLOCATED(SrcElOutParmsData%WndElPrList)) THEN - i1_l = LBOUND(SrcElOutParmsData%WndElPrList,1) - i1_u = UBOUND(SrcElOutParmsData%WndElPrList,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%WndElPrList)) THEN - ALLOCATE(DstElOutParmsData%WndElPrList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%WndElPrList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%WndElPrList = SrcElOutParmsData%WndElPrList -ENDIF -IF (ALLOCATED(SrcElOutParmsData%WndElPrNum)) THEN - i1_l = LBOUND(SrcElOutParmsData%WndElPrNum,1) - i1_u = UBOUND(SrcElOutParmsData%WndElPrNum,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%WndElPrNum)) THEN - ALLOCATE(DstElOutParmsData%WndElPrNum(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%WndElPrNum.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%WndElPrNum = SrcElOutParmsData%WndElPrNum -ENDIF -IF (ALLOCATED(SrcElOutParmsData%ElPrList)) THEN - i1_l = LBOUND(SrcElOutParmsData%ElPrList,1) - i1_u = UBOUND(SrcElOutParmsData%ElPrList,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%ElPrList)) THEN - ALLOCATE(DstElOutParmsData%ElPrList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%ElPrList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%ElPrList = SrcElOutParmsData%ElPrList -ENDIF -IF (ALLOCATED(SrcElOutParmsData%ElPrNum)) THEN - i1_l = LBOUND(SrcElOutParmsData%ElPrNum,1) - i1_u = UBOUND(SrcElOutParmsData%ElPrNum,1) - IF (.NOT. ALLOCATED(DstElOutParmsData%ElPrNum)) THEN - ALLOCATE(DstElOutParmsData%ElPrNum(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%ElPrNum.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElOutParmsData%ElPrNum = SrcElOutParmsData%ElPrNum -ENDIF - DstElOutParmsData%NumElOut = SrcElOutParmsData%NumElOut - END SUBROUTINE AD14_CopyElOutParms - - SUBROUTINE AD14_DestroyElOutParms( ElOutParmsData, ErrStat, ErrMsg ) - TYPE(ElOutParms), INTENT(INOUT) :: ElOutParmsData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyElOutParms' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ElOutParmsData%AAA)) THEN - DEALLOCATE(ElOutParmsData%AAA) -ENDIF -IF (ALLOCATED(ElOutParmsData%AAP)) THEN - DEALLOCATE(ElOutParmsData%AAP) -ENDIF -IF (ALLOCATED(ElOutParmsData%ALF)) THEN - DEALLOCATE(ElOutParmsData%ALF) -ENDIF -IF (ALLOCATED(ElOutParmsData%CDD)) THEN - DEALLOCATE(ElOutParmsData%CDD) -ENDIF -IF (ALLOCATED(ElOutParmsData%CLL)) THEN - DEALLOCATE(ElOutParmsData%CLL) -ENDIF -IF (ALLOCATED(ElOutParmsData%CMM)) THEN - DEALLOCATE(ElOutParmsData%CMM) -ENDIF -IF (ALLOCATED(ElOutParmsData%CNN)) THEN - DEALLOCATE(ElOutParmsData%CNN) -ENDIF -IF (ALLOCATED(ElOutParmsData%CTT)) THEN - DEALLOCATE(ElOutParmsData%CTT) -ENDIF -IF (ALLOCATED(ElOutParmsData%DFNSAV)) THEN - DEALLOCATE(ElOutParmsData%DFNSAV) -ENDIF -IF (ALLOCATED(ElOutParmsData%DFTSAV)) THEN - DEALLOCATE(ElOutParmsData%DFTSAV) -ENDIF -IF (ALLOCATED(ElOutParmsData%DynPres)) THEN - DEALLOCATE(ElOutParmsData%DynPres) -ENDIF -IF (ALLOCATED(ElOutParmsData%PMM)) THEN - DEALLOCATE(ElOutParmsData%PMM) -ENDIF -IF (ALLOCATED(ElOutParmsData%PITSAV)) THEN - DEALLOCATE(ElOutParmsData%PITSAV) -ENDIF -IF (ALLOCATED(ElOutParmsData%ReyNum)) THEN - DEALLOCATE(ElOutParmsData%ReyNum) -ENDIF -IF (ALLOCATED(ElOutParmsData%Gamma)) THEN - DEALLOCATE(ElOutParmsData%Gamma) -ENDIF -IF (ALLOCATED(ElOutParmsData%SaveVX)) THEN - DEALLOCATE(ElOutParmsData%SaveVX) -ENDIF -IF (ALLOCATED(ElOutParmsData%SaveVY)) THEN - DEALLOCATE(ElOutParmsData%SaveVY) -ENDIF -IF (ALLOCATED(ElOutParmsData%SaveVZ)) THEN - DEALLOCATE(ElOutParmsData%SaveVZ) -ENDIF -IF (ALLOCATED(ElOutParmsData%WndElPrList)) THEN - DEALLOCATE(ElOutParmsData%WndElPrList) -ENDIF -IF (ALLOCATED(ElOutParmsData%WndElPrNum)) THEN - DEALLOCATE(ElOutParmsData%WndElPrNum) -ENDIF -IF (ALLOCATED(ElOutParmsData%ElPrList)) THEN - DEALLOCATE(ElOutParmsData%ElPrList) -ENDIF -IF (ALLOCATED(ElOutParmsData%ElPrNum)) THEN - DEALLOCATE(ElOutParmsData%ElPrNum) -ENDIF - END SUBROUTINE AD14_DestroyElOutParms + ErrMsg = '' + if (allocated(SrcElOutParmsData%AAA)) then + LB(1:1) = lbound(SrcElOutParmsData%AAA) + UB(1:1) = ubound(SrcElOutParmsData%AAA) + if (.not. allocated(DstElOutParmsData%AAA)) then + allocate(DstElOutParmsData%AAA(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%AAA.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElOutParmsData%AAA = SrcElOutParmsData%AAA + else if (allocated(DstElOutParmsData%AAA)) then + deallocate(DstElOutParmsData%AAA) + end if + if (allocated(SrcElOutParmsData%AAP)) then + LB(1:1) = lbound(SrcElOutParmsData%AAP) + UB(1:1) = ubound(SrcElOutParmsData%AAP) + if (.not. allocated(DstElOutParmsData%AAP)) then + allocate(DstElOutParmsData%AAP(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%AAP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElOutParmsData%AAP = SrcElOutParmsData%AAP + else if (allocated(DstElOutParmsData%AAP)) then + deallocate(DstElOutParmsData%AAP) + end if + if (allocated(SrcElOutParmsData%ALF)) then + LB(1:1) = lbound(SrcElOutParmsData%ALF) + UB(1:1) = ubound(SrcElOutParmsData%ALF) + if (.not. allocated(DstElOutParmsData%ALF)) then + allocate(DstElOutParmsData%ALF(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%ALF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElOutParmsData%ALF = SrcElOutParmsData%ALF + else if (allocated(DstElOutParmsData%ALF)) then + deallocate(DstElOutParmsData%ALF) + end if + if (allocated(SrcElOutParmsData%CDD)) then + LB(1:1) = lbound(SrcElOutParmsData%CDD) + UB(1:1) = ubound(SrcElOutParmsData%CDD) + if (.not. allocated(DstElOutParmsData%CDD)) then + allocate(DstElOutParmsData%CDD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%CDD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElOutParmsData%CDD = SrcElOutParmsData%CDD + else if (allocated(DstElOutParmsData%CDD)) then + deallocate(DstElOutParmsData%CDD) + end if + if (allocated(SrcElOutParmsData%CLL)) then + LB(1:1) = lbound(SrcElOutParmsData%CLL) + UB(1:1) = ubound(SrcElOutParmsData%CLL) + if (.not. allocated(DstElOutParmsData%CLL)) then + allocate(DstElOutParmsData%CLL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%CLL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElOutParmsData%CLL = SrcElOutParmsData%CLL + else if (allocated(DstElOutParmsData%CLL)) then + deallocate(DstElOutParmsData%CLL) + end if + if (allocated(SrcElOutParmsData%CMM)) then + LB(1:1) = lbound(SrcElOutParmsData%CMM) + UB(1:1) = ubound(SrcElOutParmsData%CMM) + if (.not. allocated(DstElOutParmsData%CMM)) then + allocate(DstElOutParmsData%CMM(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%CMM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElOutParmsData%CMM = SrcElOutParmsData%CMM + else if (allocated(DstElOutParmsData%CMM)) then + deallocate(DstElOutParmsData%CMM) + end if + if (allocated(SrcElOutParmsData%CNN)) then + LB(1:1) = lbound(SrcElOutParmsData%CNN) + UB(1:1) = ubound(SrcElOutParmsData%CNN) + if (.not. allocated(DstElOutParmsData%CNN)) then + allocate(DstElOutParmsData%CNN(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%CNN.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElOutParmsData%CNN = SrcElOutParmsData%CNN + else if (allocated(DstElOutParmsData%CNN)) then + deallocate(DstElOutParmsData%CNN) + end if + if (allocated(SrcElOutParmsData%CTT)) then + LB(1:1) = lbound(SrcElOutParmsData%CTT) + UB(1:1) = ubound(SrcElOutParmsData%CTT) + if (.not. allocated(DstElOutParmsData%CTT)) then + allocate(DstElOutParmsData%CTT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%CTT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElOutParmsData%CTT = SrcElOutParmsData%CTT + else if (allocated(DstElOutParmsData%CTT)) then + deallocate(DstElOutParmsData%CTT) + end if + if (allocated(SrcElOutParmsData%DFNSAV)) then + LB(1:1) = lbound(SrcElOutParmsData%DFNSAV) + UB(1:1) = ubound(SrcElOutParmsData%DFNSAV) + if (.not. allocated(DstElOutParmsData%DFNSAV)) then + allocate(DstElOutParmsData%DFNSAV(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%DFNSAV.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElOutParmsData%DFNSAV = SrcElOutParmsData%DFNSAV + else if (allocated(DstElOutParmsData%DFNSAV)) then + deallocate(DstElOutParmsData%DFNSAV) + end if + if (allocated(SrcElOutParmsData%DFTSAV)) then + LB(1:1) = lbound(SrcElOutParmsData%DFTSAV) + UB(1:1) = ubound(SrcElOutParmsData%DFTSAV) + if (.not. allocated(DstElOutParmsData%DFTSAV)) then + allocate(DstElOutParmsData%DFTSAV(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%DFTSAV.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElOutParmsData%DFTSAV = SrcElOutParmsData%DFTSAV + else if (allocated(DstElOutParmsData%DFTSAV)) then + deallocate(DstElOutParmsData%DFTSAV) + end if + if (allocated(SrcElOutParmsData%DynPres)) then + LB(1:1) = lbound(SrcElOutParmsData%DynPres) + UB(1:1) = ubound(SrcElOutParmsData%DynPres) + if (.not. allocated(DstElOutParmsData%DynPres)) then + allocate(DstElOutParmsData%DynPres(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%DynPres.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElOutParmsData%DynPres = SrcElOutParmsData%DynPres + else if (allocated(DstElOutParmsData%DynPres)) then + deallocate(DstElOutParmsData%DynPres) + end if + if (allocated(SrcElOutParmsData%PMM)) then + LB(1:1) = lbound(SrcElOutParmsData%PMM) + UB(1:1) = ubound(SrcElOutParmsData%PMM) + if (.not. allocated(DstElOutParmsData%PMM)) then + allocate(DstElOutParmsData%PMM(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%PMM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElOutParmsData%PMM = SrcElOutParmsData%PMM + else if (allocated(DstElOutParmsData%PMM)) then + deallocate(DstElOutParmsData%PMM) + end if + if (allocated(SrcElOutParmsData%PITSAV)) then + LB(1:1) = lbound(SrcElOutParmsData%PITSAV) + UB(1:1) = ubound(SrcElOutParmsData%PITSAV) + if (.not. allocated(DstElOutParmsData%PITSAV)) then + allocate(DstElOutParmsData%PITSAV(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%PITSAV.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElOutParmsData%PITSAV = SrcElOutParmsData%PITSAV + else if (allocated(DstElOutParmsData%PITSAV)) then + deallocate(DstElOutParmsData%PITSAV) + end if + if (allocated(SrcElOutParmsData%ReyNum)) then + LB(1:1) = lbound(SrcElOutParmsData%ReyNum) + UB(1:1) = ubound(SrcElOutParmsData%ReyNum) + if (.not. allocated(DstElOutParmsData%ReyNum)) then + allocate(DstElOutParmsData%ReyNum(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%ReyNum.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElOutParmsData%ReyNum = SrcElOutParmsData%ReyNum + else if (allocated(DstElOutParmsData%ReyNum)) then + deallocate(DstElOutParmsData%ReyNum) + end if + if (allocated(SrcElOutParmsData%Gamma)) then + LB(1:1) = lbound(SrcElOutParmsData%Gamma) + UB(1:1) = ubound(SrcElOutParmsData%Gamma) + if (.not. allocated(DstElOutParmsData%Gamma)) then + allocate(DstElOutParmsData%Gamma(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%Gamma.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElOutParmsData%Gamma = SrcElOutParmsData%Gamma + else if (allocated(DstElOutParmsData%Gamma)) then + deallocate(DstElOutParmsData%Gamma) + end if + if (allocated(SrcElOutParmsData%SaveVX)) then + LB(1:2) = lbound(SrcElOutParmsData%SaveVX) + UB(1:2) = ubound(SrcElOutParmsData%SaveVX) + if (.not. allocated(DstElOutParmsData%SaveVX)) then + allocate(DstElOutParmsData%SaveVX(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%SaveVX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElOutParmsData%SaveVX = SrcElOutParmsData%SaveVX + else if (allocated(DstElOutParmsData%SaveVX)) then + deallocate(DstElOutParmsData%SaveVX) + end if + if (allocated(SrcElOutParmsData%SaveVY)) then + LB(1:2) = lbound(SrcElOutParmsData%SaveVY) + UB(1:2) = ubound(SrcElOutParmsData%SaveVY) + if (.not. allocated(DstElOutParmsData%SaveVY)) then + allocate(DstElOutParmsData%SaveVY(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%SaveVY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElOutParmsData%SaveVY = SrcElOutParmsData%SaveVY + else if (allocated(DstElOutParmsData%SaveVY)) then + deallocate(DstElOutParmsData%SaveVY) + end if + if (allocated(SrcElOutParmsData%SaveVZ)) then + LB(1:2) = lbound(SrcElOutParmsData%SaveVZ) + UB(1:2) = ubound(SrcElOutParmsData%SaveVZ) + if (.not. allocated(DstElOutParmsData%SaveVZ)) then + allocate(DstElOutParmsData%SaveVZ(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%SaveVZ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElOutParmsData%SaveVZ = SrcElOutParmsData%SaveVZ + else if (allocated(DstElOutParmsData%SaveVZ)) then + deallocate(DstElOutParmsData%SaveVZ) + end if + DstElOutParmsData%VXSAV = SrcElOutParmsData%VXSAV + DstElOutParmsData%VYSAV = SrcElOutParmsData%VYSAV + DstElOutParmsData%VZSAV = SrcElOutParmsData%VZSAV + DstElOutParmsData%NumWndElOut = SrcElOutParmsData%NumWndElOut + if (allocated(SrcElOutParmsData%WndElPrList)) then + LB(1:1) = lbound(SrcElOutParmsData%WndElPrList) + UB(1:1) = ubound(SrcElOutParmsData%WndElPrList) + if (.not. allocated(DstElOutParmsData%WndElPrList)) then + allocate(DstElOutParmsData%WndElPrList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%WndElPrList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElOutParmsData%WndElPrList = SrcElOutParmsData%WndElPrList + else if (allocated(DstElOutParmsData%WndElPrList)) then + deallocate(DstElOutParmsData%WndElPrList) + end if + if (allocated(SrcElOutParmsData%WndElPrNum)) then + LB(1:1) = lbound(SrcElOutParmsData%WndElPrNum) + UB(1:1) = ubound(SrcElOutParmsData%WndElPrNum) + if (.not. allocated(DstElOutParmsData%WndElPrNum)) then + allocate(DstElOutParmsData%WndElPrNum(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%WndElPrNum.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElOutParmsData%WndElPrNum = SrcElOutParmsData%WndElPrNum + else if (allocated(DstElOutParmsData%WndElPrNum)) then + deallocate(DstElOutParmsData%WndElPrNum) + end if + if (allocated(SrcElOutParmsData%ElPrList)) then + LB(1:1) = lbound(SrcElOutParmsData%ElPrList) + UB(1:1) = ubound(SrcElOutParmsData%ElPrList) + if (.not. allocated(DstElOutParmsData%ElPrList)) then + allocate(DstElOutParmsData%ElPrList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%ElPrList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElOutParmsData%ElPrList = SrcElOutParmsData%ElPrList + else if (allocated(DstElOutParmsData%ElPrList)) then + deallocate(DstElOutParmsData%ElPrList) + end if + if (allocated(SrcElOutParmsData%ElPrNum)) then + LB(1:1) = lbound(SrcElOutParmsData%ElPrNum) + UB(1:1) = ubound(SrcElOutParmsData%ElPrNum) + if (.not. allocated(DstElOutParmsData%ElPrNum)) then + allocate(DstElOutParmsData%ElPrNum(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElOutParmsData%ElPrNum.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElOutParmsData%ElPrNum = SrcElOutParmsData%ElPrNum + else if (allocated(DstElOutParmsData%ElPrNum)) then + deallocate(DstElOutParmsData%ElPrNum) + end if + DstElOutParmsData%NumElOut = SrcElOutParmsData%NumElOut +end subroutine +subroutine AD14_DestroyElOutParms(ElOutParmsData, ErrStat, ErrMsg) + type(ElOutParms), intent(inout) :: ElOutParmsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_DestroyElOutParms' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ElOutParmsData%AAA)) then + deallocate(ElOutParmsData%AAA) + end if + if (allocated(ElOutParmsData%AAP)) then + deallocate(ElOutParmsData%AAP) + end if + if (allocated(ElOutParmsData%ALF)) then + deallocate(ElOutParmsData%ALF) + end if + if (allocated(ElOutParmsData%CDD)) then + deallocate(ElOutParmsData%CDD) + end if + if (allocated(ElOutParmsData%CLL)) then + deallocate(ElOutParmsData%CLL) + end if + if (allocated(ElOutParmsData%CMM)) then + deallocate(ElOutParmsData%CMM) + end if + if (allocated(ElOutParmsData%CNN)) then + deallocate(ElOutParmsData%CNN) + end if + if (allocated(ElOutParmsData%CTT)) then + deallocate(ElOutParmsData%CTT) + end if + if (allocated(ElOutParmsData%DFNSAV)) then + deallocate(ElOutParmsData%DFNSAV) + end if + if (allocated(ElOutParmsData%DFTSAV)) then + deallocate(ElOutParmsData%DFTSAV) + end if + if (allocated(ElOutParmsData%DynPres)) then + deallocate(ElOutParmsData%DynPres) + end if + if (allocated(ElOutParmsData%PMM)) then + deallocate(ElOutParmsData%PMM) + end if + if (allocated(ElOutParmsData%PITSAV)) then + deallocate(ElOutParmsData%PITSAV) + end if + if (allocated(ElOutParmsData%ReyNum)) then + deallocate(ElOutParmsData%ReyNum) + end if + if (allocated(ElOutParmsData%Gamma)) then + deallocate(ElOutParmsData%Gamma) + end if + if (allocated(ElOutParmsData%SaveVX)) then + deallocate(ElOutParmsData%SaveVX) + end if + if (allocated(ElOutParmsData%SaveVY)) then + deallocate(ElOutParmsData%SaveVY) + end if + if (allocated(ElOutParmsData%SaveVZ)) then + deallocate(ElOutParmsData%SaveVZ) + end if + if (allocated(ElOutParmsData%WndElPrList)) then + deallocate(ElOutParmsData%WndElPrList) + end if + if (allocated(ElOutParmsData%WndElPrNum)) then + deallocate(ElOutParmsData%WndElPrNum) + end if + if (allocated(ElOutParmsData%ElPrList)) then + deallocate(ElOutParmsData%ElPrList) + end if + if (allocated(ElOutParmsData%ElPrNum)) then + deallocate(ElOutParmsData%ElPrNum) + end if +end subroutine subroutine AD14_PackElOutParms(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ElOutParms), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackElOutParms' if (Buf%ErrStat >= AbortErrLev) return - ! AAA call RegPack(Buf, allocated(InData%AAA)) if (allocated(InData%AAA)) then call RegPackBounds(Buf, 1, lbound(InData%AAA), ubound(InData%AAA)) call RegPack(Buf, InData%AAA) end if if (RegCheckErr(Buf, RoutineName)) return - ! AAP call RegPack(Buf, allocated(InData%AAP)) if (allocated(InData%AAP)) then call RegPackBounds(Buf, 1, lbound(InData%AAP), ubound(InData%AAP)) call RegPack(Buf, InData%AAP) end if if (RegCheckErr(Buf, RoutineName)) return - ! ALF call RegPack(Buf, allocated(InData%ALF)) if (allocated(InData%ALF)) then call RegPackBounds(Buf, 1, lbound(InData%ALF), ubound(InData%ALF)) call RegPack(Buf, InData%ALF) end if if (RegCheckErr(Buf, RoutineName)) return - ! CDD call RegPack(Buf, allocated(InData%CDD)) if (allocated(InData%CDD)) then call RegPackBounds(Buf, 1, lbound(InData%CDD), ubound(InData%CDD)) call RegPack(Buf, InData%CDD) end if if (RegCheckErr(Buf, RoutineName)) return - ! CLL call RegPack(Buf, allocated(InData%CLL)) if (allocated(InData%CLL)) then call RegPackBounds(Buf, 1, lbound(InData%CLL), ubound(InData%CLL)) call RegPack(Buf, InData%CLL) end if if (RegCheckErr(Buf, RoutineName)) return - ! CMM call RegPack(Buf, allocated(InData%CMM)) if (allocated(InData%CMM)) then call RegPackBounds(Buf, 1, lbound(InData%CMM), ubound(InData%CMM)) call RegPack(Buf, InData%CMM) end if if (RegCheckErr(Buf, RoutineName)) return - ! CNN call RegPack(Buf, allocated(InData%CNN)) if (allocated(InData%CNN)) then call RegPackBounds(Buf, 1, lbound(InData%CNN), ubound(InData%CNN)) call RegPack(Buf, InData%CNN) end if if (RegCheckErr(Buf, RoutineName)) return - ! CTT call RegPack(Buf, allocated(InData%CTT)) if (allocated(InData%CTT)) then call RegPackBounds(Buf, 1, lbound(InData%CTT), ubound(InData%CTT)) call RegPack(Buf, InData%CTT) end if if (RegCheckErr(Buf, RoutineName)) return - ! DFNSAV call RegPack(Buf, allocated(InData%DFNSAV)) if (allocated(InData%DFNSAV)) then call RegPackBounds(Buf, 1, lbound(InData%DFNSAV), ubound(InData%DFNSAV)) call RegPack(Buf, InData%DFNSAV) end if if (RegCheckErr(Buf, RoutineName)) return - ! DFTSAV call RegPack(Buf, allocated(InData%DFTSAV)) if (allocated(InData%DFTSAV)) then call RegPackBounds(Buf, 1, lbound(InData%DFTSAV), ubound(InData%DFTSAV)) call RegPack(Buf, InData%DFTSAV) end if if (RegCheckErr(Buf, RoutineName)) return - ! DynPres call RegPack(Buf, allocated(InData%DynPres)) if (allocated(InData%DynPres)) then call RegPackBounds(Buf, 1, lbound(InData%DynPres), ubound(InData%DynPres)) call RegPack(Buf, InData%DynPres) end if if (RegCheckErr(Buf, RoutineName)) return - ! PMM call RegPack(Buf, allocated(InData%PMM)) if (allocated(InData%PMM)) then call RegPackBounds(Buf, 1, lbound(InData%PMM), ubound(InData%PMM)) call RegPack(Buf, InData%PMM) end if if (RegCheckErr(Buf, RoutineName)) return - ! PITSAV call RegPack(Buf, allocated(InData%PITSAV)) if (allocated(InData%PITSAV)) then call RegPackBounds(Buf, 1, lbound(InData%PITSAV), ubound(InData%PITSAV)) call RegPack(Buf, InData%PITSAV) end if if (RegCheckErr(Buf, RoutineName)) return - ! ReyNum call RegPack(Buf, allocated(InData%ReyNum)) if (allocated(InData%ReyNum)) then call RegPackBounds(Buf, 1, lbound(InData%ReyNum), ubound(InData%ReyNum)) call RegPack(Buf, InData%ReyNum) end if if (RegCheckErr(Buf, RoutineName)) return - ! Gamma call RegPack(Buf, allocated(InData%Gamma)) if (allocated(InData%Gamma)) then call RegPackBounds(Buf, 1, lbound(InData%Gamma), ubound(InData%Gamma)) call RegPack(Buf, InData%Gamma) end if if (RegCheckErr(Buf, RoutineName)) return - ! SaveVX call RegPack(Buf, allocated(InData%SaveVX)) if (allocated(InData%SaveVX)) then call RegPackBounds(Buf, 2, lbound(InData%SaveVX), ubound(InData%SaveVX)) call RegPack(Buf, InData%SaveVX) end if if (RegCheckErr(Buf, RoutineName)) return - ! SaveVY call RegPack(Buf, allocated(InData%SaveVY)) if (allocated(InData%SaveVY)) then call RegPackBounds(Buf, 2, lbound(InData%SaveVY), ubound(InData%SaveVY)) call RegPack(Buf, InData%SaveVY) end if if (RegCheckErr(Buf, RoutineName)) return - ! SaveVZ call RegPack(Buf, allocated(InData%SaveVZ)) if (allocated(InData%SaveVZ)) then call RegPackBounds(Buf, 2, lbound(InData%SaveVZ), ubound(InData%SaveVZ)) call RegPack(Buf, InData%SaveVZ) end if if (RegCheckErr(Buf, RoutineName)) return - ! VXSAV call RegPack(Buf, InData%VXSAV) if (RegCheckErr(Buf, RoutineName)) return - ! VYSAV call RegPack(Buf, InData%VYSAV) if (RegCheckErr(Buf, RoutineName)) return - ! VZSAV call RegPack(Buf, InData%VZSAV) if (RegCheckErr(Buf, RoutineName)) return - ! NumWndElOut call RegPack(Buf, InData%NumWndElOut) if (RegCheckErr(Buf, RoutineName)) return - ! WndElPrList call RegPack(Buf, allocated(InData%WndElPrList)) if (allocated(InData%WndElPrList)) then call RegPackBounds(Buf, 1, lbound(InData%WndElPrList), ubound(InData%WndElPrList)) call RegPack(Buf, InData%WndElPrList) end if if (RegCheckErr(Buf, RoutineName)) return - ! WndElPrNum call RegPack(Buf, allocated(InData%WndElPrNum)) if (allocated(InData%WndElPrNum)) then call RegPackBounds(Buf, 1, lbound(InData%WndElPrNum), ubound(InData%WndElPrNum)) call RegPack(Buf, InData%WndElPrNum) end if if (RegCheckErr(Buf, RoutineName)) return - ! ElPrList call RegPack(Buf, allocated(InData%ElPrList)) if (allocated(InData%ElPrList)) then call RegPackBounds(Buf, 1, lbound(InData%ElPrList), ubound(InData%ElPrList)) call RegPack(Buf, InData%ElPrList) end if if (RegCheckErr(Buf, RoutineName)) return - ! ElPrNum call RegPack(Buf, allocated(InData%ElPrNum)) if (allocated(InData%ElPrNum)) then call RegPackBounds(Buf, 1, lbound(InData%ElPrNum), ubound(InData%ElPrNum)) call RegPack(Buf, InData%ElPrNum) end if if (RegCheckErr(Buf, RoutineName)) return - ! NumElOut call RegPack(Buf, InData%NumElOut) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -5047,7 +4643,6 @@ subroutine AD14_UnPackElOutParms(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! AAA if (allocated(OutData%AAA)) deallocate(OutData%AAA) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5062,7 +4657,6 @@ subroutine AD14_UnPackElOutParms(Buf, OutData) call RegUnpack(Buf, OutData%AAA) if (RegCheckErr(Buf, RoutineName)) return end if - ! AAP if (allocated(OutData%AAP)) deallocate(OutData%AAP) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5077,7 +4671,6 @@ subroutine AD14_UnPackElOutParms(Buf, OutData) call RegUnpack(Buf, OutData%AAP) if (RegCheckErr(Buf, RoutineName)) return end if - ! ALF if (allocated(OutData%ALF)) deallocate(OutData%ALF) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5092,7 +4685,6 @@ subroutine AD14_UnPackElOutParms(Buf, OutData) call RegUnpack(Buf, OutData%ALF) if (RegCheckErr(Buf, RoutineName)) return end if - ! CDD if (allocated(OutData%CDD)) deallocate(OutData%CDD) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5107,7 +4699,6 @@ subroutine AD14_UnPackElOutParms(Buf, OutData) call RegUnpack(Buf, OutData%CDD) if (RegCheckErr(Buf, RoutineName)) return end if - ! CLL if (allocated(OutData%CLL)) deallocate(OutData%CLL) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5122,7 +4713,6 @@ subroutine AD14_UnPackElOutParms(Buf, OutData) call RegUnpack(Buf, OutData%CLL) if (RegCheckErr(Buf, RoutineName)) return end if - ! CMM if (allocated(OutData%CMM)) deallocate(OutData%CMM) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5137,7 +4727,6 @@ subroutine AD14_UnPackElOutParms(Buf, OutData) call RegUnpack(Buf, OutData%CMM) if (RegCheckErr(Buf, RoutineName)) return end if - ! CNN if (allocated(OutData%CNN)) deallocate(OutData%CNN) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5152,7 +4741,6 @@ subroutine AD14_UnPackElOutParms(Buf, OutData) call RegUnpack(Buf, OutData%CNN) if (RegCheckErr(Buf, RoutineName)) return end if - ! CTT if (allocated(OutData%CTT)) deallocate(OutData%CTT) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5167,7 +4755,6 @@ subroutine AD14_UnPackElOutParms(Buf, OutData) call RegUnpack(Buf, OutData%CTT) if (RegCheckErr(Buf, RoutineName)) return end if - ! DFNSAV if (allocated(OutData%DFNSAV)) deallocate(OutData%DFNSAV) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5182,7 +4769,6 @@ subroutine AD14_UnPackElOutParms(Buf, OutData) call RegUnpack(Buf, OutData%DFNSAV) if (RegCheckErr(Buf, RoutineName)) return end if - ! DFTSAV if (allocated(OutData%DFTSAV)) deallocate(OutData%DFTSAV) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5197,7 +4783,6 @@ subroutine AD14_UnPackElOutParms(Buf, OutData) call RegUnpack(Buf, OutData%DFTSAV) if (RegCheckErr(Buf, RoutineName)) return end if - ! DynPres if (allocated(OutData%DynPres)) deallocate(OutData%DynPres) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5212,7 +4797,6 @@ subroutine AD14_UnPackElOutParms(Buf, OutData) call RegUnpack(Buf, OutData%DynPres) if (RegCheckErr(Buf, RoutineName)) return end if - ! PMM if (allocated(OutData%PMM)) deallocate(OutData%PMM) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5227,7 +4811,6 @@ subroutine AD14_UnPackElOutParms(Buf, OutData) call RegUnpack(Buf, OutData%PMM) if (RegCheckErr(Buf, RoutineName)) return end if - ! PITSAV if (allocated(OutData%PITSAV)) deallocate(OutData%PITSAV) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5242,7 +4825,6 @@ subroutine AD14_UnPackElOutParms(Buf, OutData) call RegUnpack(Buf, OutData%PITSAV) if (RegCheckErr(Buf, RoutineName)) return end if - ! ReyNum if (allocated(OutData%ReyNum)) deallocate(OutData%ReyNum) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5257,7 +4839,6 @@ subroutine AD14_UnPackElOutParms(Buf, OutData) call RegUnpack(Buf, OutData%ReyNum) if (RegCheckErr(Buf, RoutineName)) return end if - ! Gamma if (allocated(OutData%Gamma)) deallocate(OutData%Gamma) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5272,7 +4853,6 @@ subroutine AD14_UnPackElOutParms(Buf, OutData) call RegUnpack(Buf, OutData%Gamma) if (RegCheckErr(Buf, RoutineName)) return end if - ! SaveVX if (allocated(OutData%SaveVX)) deallocate(OutData%SaveVX) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5287,7 +4867,6 @@ subroutine AD14_UnPackElOutParms(Buf, OutData) call RegUnpack(Buf, OutData%SaveVX) if (RegCheckErr(Buf, RoutineName)) return end if - ! SaveVY if (allocated(OutData%SaveVY)) deallocate(OutData%SaveVY) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5302,7 +4881,6 @@ subroutine AD14_UnPackElOutParms(Buf, OutData) call RegUnpack(Buf, OutData%SaveVY) if (RegCheckErr(Buf, RoutineName)) return end if - ! SaveVZ if (allocated(OutData%SaveVZ)) deallocate(OutData%SaveVZ) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5317,19 +4895,14 @@ subroutine AD14_UnPackElOutParms(Buf, OutData) call RegUnpack(Buf, OutData%SaveVZ) if (RegCheckErr(Buf, RoutineName)) return end if - ! VXSAV call RegUnpack(Buf, OutData%VXSAV) if (RegCheckErr(Buf, RoutineName)) return - ! VYSAV call RegUnpack(Buf, OutData%VYSAV) if (RegCheckErr(Buf, RoutineName)) return - ! VZSAV call RegUnpack(Buf, OutData%VZSAV) if (RegCheckErr(Buf, RoutineName)) return - ! NumWndElOut call RegUnpack(Buf, OutData%NumWndElOut) if (RegCheckErr(Buf, RoutineName)) return - ! WndElPrList if (allocated(OutData%WndElPrList)) deallocate(OutData%WndElPrList) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5344,7 +4917,6 @@ subroutine AD14_UnPackElOutParms(Buf, OutData) call RegUnpack(Buf, OutData%WndElPrList) if (RegCheckErr(Buf, RoutineName)) return end if - ! WndElPrNum if (allocated(OutData%WndElPrNum)) deallocate(OutData%WndElPrNum) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5359,7 +4931,6 @@ subroutine AD14_UnPackElOutParms(Buf, OutData) call RegUnpack(Buf, OutData%WndElPrNum) if (RegCheckErr(Buf, RoutineName)) return end if - ! ElPrList if (allocated(OutData%ElPrList)) deallocate(OutData%ElPrList) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5374,7 +4945,6 @@ subroutine AD14_UnPackElOutParms(Buf, OutData) call RegUnpack(Buf, OutData%ElPrList) if (RegCheckErr(Buf, RoutineName)) return end if - ! ElPrNum if (allocated(OutData%ElPrNum)) deallocate(OutData%ElPrNum) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5389,49 +4959,36 @@ subroutine AD14_UnPackElOutParms(Buf, OutData) call RegUnpack(Buf, OutData%ElPrNum) if (RegCheckErr(Buf, RoutineName)) return end if - ! NumElOut call RegUnpack(Buf, OutData%NumElOut) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE AD14_CopyInducedVel( SrcInducedVelData, DstInducedVelData, CtrlCode, ErrStat, ErrMsg ) - TYPE(InducedVel), INTENT(IN) :: SrcInducedVelData - TYPE(InducedVel), INTENT(INOUT) :: DstInducedVelData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_CopyInducedVel' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInducedVelData%SumInFl = SrcInducedVelData%SumInFl - END SUBROUTINE AD14_CopyInducedVel - - SUBROUTINE AD14_DestroyInducedVel( InducedVelData, ErrStat, ErrMsg ) - TYPE(InducedVel), INTENT(INOUT) :: InducedVelData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyInducedVel' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE AD14_DestroyInducedVel +subroutine AD14_CopyInducedVel(SrcInducedVelData, DstInducedVelData, CtrlCode, ErrStat, ErrMsg) + type(InducedVel), intent(in) :: SrcInducedVelData + type(InducedVel), intent(inout) :: DstInducedVelData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_CopyInducedVel' + ErrStat = ErrID_None + ErrMsg = '' + DstInducedVelData%SumInFl = SrcInducedVelData%SumInFl +end subroutine +subroutine AD14_DestroyInducedVel(InducedVelData, ErrStat, ErrMsg) + type(InducedVel), intent(inout) :: InducedVelData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_DestroyInducedVel' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine AD14_PackInducedVel(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(InducedVel), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackInducedVel' if (Buf%ErrStat >= AbortErrLev) return - ! SumInFl call RegPack(Buf, InData%SumInFl) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -5441,73 +4998,54 @@ subroutine AD14_UnPackInducedVel(Buf, OutData) type(InducedVel), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackInducedVel' if (Buf%ErrStat /= ErrID_None) return - ! SumInFl call RegUnpack(Buf, OutData%SumInFl) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE AD14_CopyInducedVelParms( SrcInducedVelParmsData, DstInducedVelParmsData, CtrlCode, ErrStat, ErrMsg ) - TYPE(InducedVelParms), INTENT(IN) :: SrcInducedVelParmsData - TYPE(InducedVelParms), INTENT(INOUT) :: DstInducedVelParmsData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_CopyInducedVelParms' -! + +subroutine AD14_CopyInducedVelParms(SrcInducedVelParmsData, DstInducedVelParmsData, CtrlCode, ErrStat, ErrMsg) + type(InducedVelParms), intent(in) :: SrcInducedVelParmsData + type(InducedVelParms), intent(inout) :: DstInducedVelParmsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_CopyInducedVelParms' ErrStat = ErrID_None - ErrMsg = "" - DstInducedVelParmsData%AToler = SrcInducedVelParmsData%AToler - DstInducedVelParmsData%EqAIDmult = SrcInducedVelParmsData%EqAIDmult - DstInducedVelParmsData%EquilDA = SrcInducedVelParmsData%EquilDA - DstInducedVelParmsData%EquilDT = SrcInducedVelParmsData%EquilDT - DstInducedVelParmsData%TLoss = SrcInducedVelParmsData%TLoss - DstInducedVelParmsData%GTech = SrcInducedVelParmsData%GTech - DstInducedVelParmsData%HLoss = SrcInducedVelParmsData%HLoss - END SUBROUTINE AD14_CopyInducedVelParms - - SUBROUTINE AD14_DestroyInducedVelParms( InducedVelParmsData, ErrStat, ErrMsg ) - TYPE(InducedVelParms), INTENT(INOUT) :: InducedVelParmsData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyInducedVelParms' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE AD14_DestroyInducedVelParms + ErrMsg = '' + DstInducedVelParmsData%AToler = SrcInducedVelParmsData%AToler + DstInducedVelParmsData%EqAIDmult = SrcInducedVelParmsData%EqAIDmult + DstInducedVelParmsData%EquilDA = SrcInducedVelParmsData%EquilDA + DstInducedVelParmsData%EquilDT = SrcInducedVelParmsData%EquilDT + DstInducedVelParmsData%TLoss = SrcInducedVelParmsData%TLoss + DstInducedVelParmsData%GTech = SrcInducedVelParmsData%GTech + DstInducedVelParmsData%HLoss = SrcInducedVelParmsData%HLoss +end subroutine +subroutine AD14_DestroyInducedVelParms(InducedVelParmsData, ErrStat, ErrMsg) + type(InducedVelParms), intent(inout) :: InducedVelParmsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_DestroyInducedVelParms' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine AD14_PackInducedVelParms(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(InducedVelParms), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackInducedVelParms' if (Buf%ErrStat >= AbortErrLev) return - ! AToler call RegPack(Buf, InData%AToler) if (RegCheckErr(Buf, RoutineName)) return - ! EqAIDmult call RegPack(Buf, InData%EqAIDmult) if (RegCheckErr(Buf, RoutineName)) return - ! EquilDA call RegPack(Buf, InData%EquilDA) if (RegCheckErr(Buf, RoutineName)) return - ! EquilDT call RegPack(Buf, InData%EquilDT) if (RegCheckErr(Buf, RoutineName)) return - ! TLoss call RegPack(Buf, InData%TLoss) if (RegCheckErr(Buf, RoutineName)) return - ! GTech call RegPack(Buf, InData%GTech) if (RegCheckErr(Buf, RoutineName)) return - ! HLoss call RegPack(Buf, InData%HLoss) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -5517,99 +5055,72 @@ subroutine AD14_UnPackInducedVelParms(Buf, OutData) type(InducedVelParms), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackInducedVelParms' if (Buf%ErrStat /= ErrID_None) return - ! AToler call RegUnpack(Buf, OutData%AToler) if (RegCheckErr(Buf, RoutineName)) return - ! EqAIDmult call RegUnpack(Buf, OutData%EqAIDmult) if (RegCheckErr(Buf, RoutineName)) return - ! EquilDA call RegUnpack(Buf, OutData%EquilDA) if (RegCheckErr(Buf, RoutineName)) return - ! EquilDT call RegUnpack(Buf, OutData%EquilDT) if (RegCheckErr(Buf, RoutineName)) return - ! TLoss call RegUnpack(Buf, OutData%TLoss) if (RegCheckErr(Buf, RoutineName)) return - ! GTech call RegUnpack(Buf, OutData%GTech) if (RegCheckErr(Buf, RoutineName)) return - ! HLoss call RegUnpack(Buf, OutData%HLoss) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE AD14_CopyRotor( SrcRotorData, DstRotorData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Rotor), INTENT(IN) :: SrcRotorData - TYPE(Rotor), INTENT(INOUT) :: DstRotorData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_CopyRotor' -! + +subroutine AD14_CopyRotor(SrcRotorData, DstRotorData, CtrlCode, ErrStat, ErrMsg) + type(Rotor), intent(in) :: SrcRotorData + type(Rotor), intent(inout) :: DstRotorData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_CopyRotor' ErrStat = ErrID_None - ErrMsg = "" - DstRotorData%AVGINFL = SrcRotorData%AVGINFL - DstRotorData%CTILT = SrcRotorData%CTILT - DstRotorData%CYaw = SrcRotorData%CYaw - DstRotorData%REVS = SrcRotorData%REVS - DstRotorData%STILT = SrcRotorData%STILT - DstRotorData%SYaw = SrcRotorData%SYaw - DstRotorData%TILT = SrcRotorData%TILT - DstRotorData%YawAng = SrcRotorData%YawAng - DstRotorData%YawVEL = SrcRotorData%YawVEL - END SUBROUTINE AD14_CopyRotor - - SUBROUTINE AD14_DestroyRotor( RotorData, ErrStat, ErrMsg ) - TYPE(Rotor), INTENT(INOUT) :: RotorData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyRotor' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE AD14_DestroyRotor + ErrMsg = '' + DstRotorData%AVGINFL = SrcRotorData%AVGINFL + DstRotorData%CTILT = SrcRotorData%CTILT + DstRotorData%CYaw = SrcRotorData%CYaw + DstRotorData%REVS = SrcRotorData%REVS + DstRotorData%STILT = SrcRotorData%STILT + DstRotorData%SYaw = SrcRotorData%SYaw + DstRotorData%TILT = SrcRotorData%TILT + DstRotorData%YawAng = SrcRotorData%YawAng + DstRotorData%YawVEL = SrcRotorData%YawVEL +end subroutine +subroutine AD14_DestroyRotor(RotorData, ErrStat, ErrMsg) + type(Rotor), intent(inout) :: RotorData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_DestroyRotor' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine AD14_PackRotor(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Rotor), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackRotor' if (Buf%ErrStat >= AbortErrLev) return - ! AVGINFL call RegPack(Buf, InData%AVGINFL) if (RegCheckErr(Buf, RoutineName)) return - ! CTILT call RegPack(Buf, InData%CTILT) if (RegCheckErr(Buf, RoutineName)) return - ! CYaw call RegPack(Buf, InData%CYaw) if (RegCheckErr(Buf, RoutineName)) return - ! REVS call RegPack(Buf, InData%REVS) if (RegCheckErr(Buf, RoutineName)) return - ! STILT call RegPack(Buf, InData%STILT) if (RegCheckErr(Buf, RoutineName)) return - ! SYaw call RegPack(Buf, InData%SYaw) if (RegCheckErr(Buf, RoutineName)) return - ! TILT call RegPack(Buf, InData%TILT) if (RegCheckErr(Buf, RoutineName)) return - ! YawAng call RegPack(Buf, InData%YawAng) if (RegCheckErr(Buf, RoutineName)) return - ! YawVEL call RegPack(Buf, InData%YawVEL) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -5619,73 +5130,52 @@ subroutine AD14_UnPackRotor(Buf, OutData) type(Rotor), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackRotor' if (Buf%ErrStat /= ErrID_None) return - ! AVGINFL call RegUnpack(Buf, OutData%AVGINFL) if (RegCheckErr(Buf, RoutineName)) return - ! CTILT call RegUnpack(Buf, OutData%CTILT) if (RegCheckErr(Buf, RoutineName)) return - ! CYaw call RegUnpack(Buf, OutData%CYaw) if (RegCheckErr(Buf, RoutineName)) return - ! REVS call RegUnpack(Buf, OutData%REVS) if (RegCheckErr(Buf, RoutineName)) return - ! STILT call RegUnpack(Buf, OutData%STILT) if (RegCheckErr(Buf, RoutineName)) return - ! SYaw call RegUnpack(Buf, OutData%SYaw) if (RegCheckErr(Buf, RoutineName)) return - ! TILT call RegUnpack(Buf, OutData%TILT) if (RegCheckErr(Buf, RoutineName)) return - ! YawAng call RegUnpack(Buf, OutData%YawAng) if (RegCheckErr(Buf, RoutineName)) return - ! YawVEL call RegUnpack(Buf, OutData%YawVEL) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE AD14_CopyRotorParms( SrcRotorParmsData, DstRotorParmsData, CtrlCode, ErrStat, ErrMsg ) - TYPE(RotorParms), INTENT(IN) :: SrcRotorParmsData - TYPE(RotorParms), INTENT(INOUT) :: DstRotorParmsData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_CopyRotorParms' -! - ErrStat = ErrID_None - ErrMsg = "" - DstRotorParmsData%HH = SrcRotorParmsData%HH - END SUBROUTINE AD14_CopyRotorParms - SUBROUTINE AD14_DestroyRotorParms( RotorParmsData, ErrStat, ErrMsg ) - TYPE(RotorParms), INTENT(INOUT) :: RotorParmsData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyRotorParms' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE AD14_DestroyRotorParms +subroutine AD14_CopyRotorParms(SrcRotorParmsData, DstRotorParmsData, CtrlCode, ErrStat, ErrMsg) + type(RotorParms), intent(in) :: SrcRotorParmsData + type(RotorParms), intent(inout) :: DstRotorParmsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_CopyRotorParms' + ErrStat = ErrID_None + ErrMsg = '' + DstRotorParmsData%HH = SrcRotorParmsData%HH +end subroutine +subroutine AD14_DestroyRotorParms(RotorParmsData, ErrStat, ErrMsg) + type(RotorParms), intent(inout) :: RotorParmsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_DestroyRotorParms' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine AD14_PackRotorParms(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(RotorParms), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackRotorParms' if (Buf%ErrStat >= AbortErrLev) return - ! HH call RegPack(Buf, InData%HH) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -5695,241 +5185,217 @@ subroutine AD14_UnPackRotorParms(Buf, OutData) type(RotorParms), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackRotorParms' if (Buf%ErrStat /= ErrID_None) return - ! HH call RegUnpack(Buf, OutData%HH) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE AD14_CopyTwrPropsParms( SrcTwrPropsParmsData, DstTwrPropsParmsData, CtrlCode, ErrStat, ErrMsg ) - TYPE(TwrPropsParms), INTENT(IN) :: SrcTwrPropsParmsData - TYPE(TwrPropsParms), INTENT(INOUT) :: DstTwrPropsParmsData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_CopyTwrPropsParms' -! + +subroutine AD14_CopyTwrPropsParms(SrcTwrPropsParmsData, DstTwrPropsParmsData, CtrlCode, ErrStat, ErrMsg) + type(TwrPropsParms), intent(in) :: SrcTwrPropsParmsData + type(TwrPropsParms), intent(inout) :: DstTwrPropsParmsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AD14_CopyTwrPropsParms' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcTwrPropsParmsData%TwrHtFr)) THEN - i1_l = LBOUND(SrcTwrPropsParmsData%TwrHtFr,1) - i1_u = UBOUND(SrcTwrPropsParmsData%TwrHtFr,1) - IF (.NOT. ALLOCATED(DstTwrPropsParmsData%TwrHtFr)) THEN - ALLOCATE(DstTwrPropsParmsData%TwrHtFr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstTwrPropsParmsData%TwrHtFr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstTwrPropsParmsData%TwrHtFr = SrcTwrPropsParmsData%TwrHtFr -ENDIF -IF (ALLOCATED(SrcTwrPropsParmsData%TwrWid)) THEN - i1_l = LBOUND(SrcTwrPropsParmsData%TwrWid,1) - i1_u = UBOUND(SrcTwrPropsParmsData%TwrWid,1) - IF (.NOT. ALLOCATED(DstTwrPropsParmsData%TwrWid)) THEN - ALLOCATE(DstTwrPropsParmsData%TwrWid(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstTwrPropsParmsData%TwrWid.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstTwrPropsParmsData%TwrWid = SrcTwrPropsParmsData%TwrWid -ENDIF -IF (ALLOCATED(SrcTwrPropsParmsData%TwrCD)) THEN - i1_l = LBOUND(SrcTwrPropsParmsData%TwrCD,1) - i1_u = UBOUND(SrcTwrPropsParmsData%TwrCD,1) - i2_l = LBOUND(SrcTwrPropsParmsData%TwrCD,2) - i2_u = UBOUND(SrcTwrPropsParmsData%TwrCD,2) - IF (.NOT. ALLOCATED(DstTwrPropsParmsData%TwrCD)) THEN - ALLOCATE(DstTwrPropsParmsData%TwrCD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstTwrPropsParmsData%TwrCD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstTwrPropsParmsData%TwrCD = SrcTwrPropsParmsData%TwrCD -ENDIF -IF (ALLOCATED(SrcTwrPropsParmsData%TwrRe)) THEN - i1_l = LBOUND(SrcTwrPropsParmsData%TwrRe,1) - i1_u = UBOUND(SrcTwrPropsParmsData%TwrRe,1) - IF (.NOT. ALLOCATED(DstTwrPropsParmsData%TwrRe)) THEN - ALLOCATE(DstTwrPropsParmsData%TwrRe(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstTwrPropsParmsData%TwrRe.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstTwrPropsParmsData%TwrRe = SrcTwrPropsParmsData%TwrRe -ENDIF - DstTwrPropsParmsData%VTwr = SrcTwrPropsParmsData%VTwr - DstTwrPropsParmsData%Tower_Wake_Constant = SrcTwrPropsParmsData%Tower_Wake_Constant -IF (ALLOCATED(SrcTwrPropsParmsData%NTwrCDCol)) THEN - i1_l = LBOUND(SrcTwrPropsParmsData%NTwrCDCol,1) - i1_u = UBOUND(SrcTwrPropsParmsData%NTwrCDCol,1) - IF (.NOT. ALLOCATED(DstTwrPropsParmsData%NTwrCDCol)) THEN - ALLOCATE(DstTwrPropsParmsData%NTwrCDCol(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstTwrPropsParmsData%NTwrCDCol.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstTwrPropsParmsData%NTwrCDCol = SrcTwrPropsParmsData%NTwrCDCol -ENDIF - DstTwrPropsParmsData%NTwrHT = SrcTwrPropsParmsData%NTwrHT - DstTwrPropsParmsData%NTwrRe = SrcTwrPropsParmsData%NTwrRe - DstTwrPropsParmsData%NTwrCD = SrcTwrPropsParmsData%NTwrCD - DstTwrPropsParmsData%TwrPotent = SrcTwrPropsParmsData%TwrPotent - DstTwrPropsParmsData%TwrShadow = SrcTwrPropsParmsData%TwrShadow - DstTwrPropsParmsData%ShadHWid = SrcTwrPropsParmsData%ShadHWid - DstTwrPropsParmsData%TShadC1 = SrcTwrPropsParmsData%TShadC1 - DstTwrPropsParmsData%TShadC2 = SrcTwrPropsParmsData%TShadC2 - DstTwrPropsParmsData%TwrShad = SrcTwrPropsParmsData%TwrShad - DstTwrPropsParmsData%PJM_Version = SrcTwrPropsParmsData%PJM_Version - DstTwrPropsParmsData%TwrFile = SrcTwrPropsParmsData%TwrFile - DstTwrPropsParmsData%T_Shad_Refpt = SrcTwrPropsParmsData%T_Shad_Refpt - DstTwrPropsParmsData%CalcTwrAero = SrcTwrPropsParmsData%CalcTwrAero - DstTwrPropsParmsData%NumTwrNodes = SrcTwrPropsParmsData%NumTwrNodes -IF (ALLOCATED(SrcTwrPropsParmsData%TwrNodeWidth)) THEN - i1_l = LBOUND(SrcTwrPropsParmsData%TwrNodeWidth,1) - i1_u = UBOUND(SrcTwrPropsParmsData%TwrNodeWidth,1) - IF (.NOT. ALLOCATED(DstTwrPropsParmsData%TwrNodeWidth)) THEN - ALLOCATE(DstTwrPropsParmsData%TwrNodeWidth(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstTwrPropsParmsData%TwrNodeWidth.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstTwrPropsParmsData%TwrNodeWidth = SrcTwrPropsParmsData%TwrNodeWidth -ENDIF - END SUBROUTINE AD14_CopyTwrPropsParms - - SUBROUTINE AD14_DestroyTwrPropsParms( TwrPropsParmsData, ErrStat, ErrMsg ) - TYPE(TwrPropsParms), INTENT(INOUT) :: TwrPropsParmsData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyTwrPropsParms' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(TwrPropsParmsData%TwrHtFr)) THEN - DEALLOCATE(TwrPropsParmsData%TwrHtFr) -ENDIF -IF (ALLOCATED(TwrPropsParmsData%TwrWid)) THEN - DEALLOCATE(TwrPropsParmsData%TwrWid) -ENDIF -IF (ALLOCATED(TwrPropsParmsData%TwrCD)) THEN - DEALLOCATE(TwrPropsParmsData%TwrCD) -ENDIF -IF (ALLOCATED(TwrPropsParmsData%TwrRe)) THEN - DEALLOCATE(TwrPropsParmsData%TwrRe) -ENDIF -IF (ALLOCATED(TwrPropsParmsData%NTwrCDCol)) THEN - DEALLOCATE(TwrPropsParmsData%NTwrCDCol) -ENDIF -IF (ALLOCATED(TwrPropsParmsData%TwrNodeWidth)) THEN - DEALLOCATE(TwrPropsParmsData%TwrNodeWidth) -ENDIF - END SUBROUTINE AD14_DestroyTwrPropsParms + ErrMsg = '' + if (allocated(SrcTwrPropsParmsData%TwrHtFr)) then + LB(1:1) = lbound(SrcTwrPropsParmsData%TwrHtFr) + UB(1:1) = ubound(SrcTwrPropsParmsData%TwrHtFr) + if (.not. allocated(DstTwrPropsParmsData%TwrHtFr)) then + allocate(DstTwrPropsParmsData%TwrHtFr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTwrPropsParmsData%TwrHtFr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTwrPropsParmsData%TwrHtFr = SrcTwrPropsParmsData%TwrHtFr + else if (allocated(DstTwrPropsParmsData%TwrHtFr)) then + deallocate(DstTwrPropsParmsData%TwrHtFr) + end if + if (allocated(SrcTwrPropsParmsData%TwrWid)) then + LB(1:1) = lbound(SrcTwrPropsParmsData%TwrWid) + UB(1:1) = ubound(SrcTwrPropsParmsData%TwrWid) + if (.not. allocated(DstTwrPropsParmsData%TwrWid)) then + allocate(DstTwrPropsParmsData%TwrWid(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTwrPropsParmsData%TwrWid.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTwrPropsParmsData%TwrWid = SrcTwrPropsParmsData%TwrWid + else if (allocated(DstTwrPropsParmsData%TwrWid)) then + deallocate(DstTwrPropsParmsData%TwrWid) + end if + if (allocated(SrcTwrPropsParmsData%TwrCD)) then + LB(1:2) = lbound(SrcTwrPropsParmsData%TwrCD) + UB(1:2) = ubound(SrcTwrPropsParmsData%TwrCD) + if (.not. allocated(DstTwrPropsParmsData%TwrCD)) then + allocate(DstTwrPropsParmsData%TwrCD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTwrPropsParmsData%TwrCD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTwrPropsParmsData%TwrCD = SrcTwrPropsParmsData%TwrCD + else if (allocated(DstTwrPropsParmsData%TwrCD)) then + deallocate(DstTwrPropsParmsData%TwrCD) + end if + if (allocated(SrcTwrPropsParmsData%TwrRe)) then + LB(1:1) = lbound(SrcTwrPropsParmsData%TwrRe) + UB(1:1) = ubound(SrcTwrPropsParmsData%TwrRe) + if (.not. allocated(DstTwrPropsParmsData%TwrRe)) then + allocate(DstTwrPropsParmsData%TwrRe(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTwrPropsParmsData%TwrRe.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTwrPropsParmsData%TwrRe = SrcTwrPropsParmsData%TwrRe + else if (allocated(DstTwrPropsParmsData%TwrRe)) then + deallocate(DstTwrPropsParmsData%TwrRe) + end if + DstTwrPropsParmsData%VTwr = SrcTwrPropsParmsData%VTwr + DstTwrPropsParmsData%Tower_Wake_Constant = SrcTwrPropsParmsData%Tower_Wake_Constant + if (allocated(SrcTwrPropsParmsData%NTwrCDCol)) then + LB(1:1) = lbound(SrcTwrPropsParmsData%NTwrCDCol) + UB(1:1) = ubound(SrcTwrPropsParmsData%NTwrCDCol) + if (.not. allocated(DstTwrPropsParmsData%NTwrCDCol)) then + allocate(DstTwrPropsParmsData%NTwrCDCol(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTwrPropsParmsData%NTwrCDCol.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTwrPropsParmsData%NTwrCDCol = SrcTwrPropsParmsData%NTwrCDCol + else if (allocated(DstTwrPropsParmsData%NTwrCDCol)) then + deallocate(DstTwrPropsParmsData%NTwrCDCol) + end if + DstTwrPropsParmsData%NTwrHT = SrcTwrPropsParmsData%NTwrHT + DstTwrPropsParmsData%NTwrRe = SrcTwrPropsParmsData%NTwrRe + DstTwrPropsParmsData%NTwrCD = SrcTwrPropsParmsData%NTwrCD + DstTwrPropsParmsData%TwrPotent = SrcTwrPropsParmsData%TwrPotent + DstTwrPropsParmsData%TwrShadow = SrcTwrPropsParmsData%TwrShadow + DstTwrPropsParmsData%ShadHWid = SrcTwrPropsParmsData%ShadHWid + DstTwrPropsParmsData%TShadC1 = SrcTwrPropsParmsData%TShadC1 + DstTwrPropsParmsData%TShadC2 = SrcTwrPropsParmsData%TShadC2 + DstTwrPropsParmsData%TwrShad = SrcTwrPropsParmsData%TwrShad + DstTwrPropsParmsData%PJM_Version = SrcTwrPropsParmsData%PJM_Version + DstTwrPropsParmsData%TwrFile = SrcTwrPropsParmsData%TwrFile + DstTwrPropsParmsData%T_Shad_Refpt = SrcTwrPropsParmsData%T_Shad_Refpt + DstTwrPropsParmsData%CalcTwrAero = SrcTwrPropsParmsData%CalcTwrAero + DstTwrPropsParmsData%NumTwrNodes = SrcTwrPropsParmsData%NumTwrNodes + if (allocated(SrcTwrPropsParmsData%TwrNodeWidth)) then + LB(1:1) = lbound(SrcTwrPropsParmsData%TwrNodeWidth) + UB(1:1) = ubound(SrcTwrPropsParmsData%TwrNodeWidth) + if (.not. allocated(DstTwrPropsParmsData%TwrNodeWidth)) then + allocate(DstTwrPropsParmsData%TwrNodeWidth(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTwrPropsParmsData%TwrNodeWidth.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTwrPropsParmsData%TwrNodeWidth = SrcTwrPropsParmsData%TwrNodeWidth + else if (allocated(DstTwrPropsParmsData%TwrNodeWidth)) then + deallocate(DstTwrPropsParmsData%TwrNodeWidth) + end if +end subroutine +subroutine AD14_DestroyTwrPropsParms(TwrPropsParmsData, ErrStat, ErrMsg) + type(TwrPropsParms), intent(inout) :: TwrPropsParmsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_DestroyTwrPropsParms' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(TwrPropsParmsData%TwrHtFr)) then + deallocate(TwrPropsParmsData%TwrHtFr) + end if + if (allocated(TwrPropsParmsData%TwrWid)) then + deallocate(TwrPropsParmsData%TwrWid) + end if + if (allocated(TwrPropsParmsData%TwrCD)) then + deallocate(TwrPropsParmsData%TwrCD) + end if + if (allocated(TwrPropsParmsData%TwrRe)) then + deallocate(TwrPropsParmsData%TwrRe) + end if + if (allocated(TwrPropsParmsData%NTwrCDCol)) then + deallocate(TwrPropsParmsData%NTwrCDCol) + end if + if (allocated(TwrPropsParmsData%TwrNodeWidth)) then + deallocate(TwrPropsParmsData%TwrNodeWidth) + end if +end subroutine subroutine AD14_PackTwrPropsParms(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(TwrPropsParms), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackTwrPropsParms' if (Buf%ErrStat >= AbortErrLev) return - ! TwrHtFr call RegPack(Buf, allocated(InData%TwrHtFr)) if (allocated(InData%TwrHtFr)) then call RegPackBounds(Buf, 1, lbound(InData%TwrHtFr), ubound(InData%TwrHtFr)) call RegPack(Buf, InData%TwrHtFr) end if if (RegCheckErr(Buf, RoutineName)) return - ! TwrWid call RegPack(Buf, allocated(InData%TwrWid)) if (allocated(InData%TwrWid)) then call RegPackBounds(Buf, 1, lbound(InData%TwrWid), ubound(InData%TwrWid)) call RegPack(Buf, InData%TwrWid) end if if (RegCheckErr(Buf, RoutineName)) return - ! TwrCD call RegPack(Buf, allocated(InData%TwrCD)) if (allocated(InData%TwrCD)) then call RegPackBounds(Buf, 2, lbound(InData%TwrCD), ubound(InData%TwrCD)) call RegPack(Buf, InData%TwrCD) end if if (RegCheckErr(Buf, RoutineName)) return - ! TwrRe call RegPack(Buf, allocated(InData%TwrRe)) if (allocated(InData%TwrRe)) then call RegPackBounds(Buf, 1, lbound(InData%TwrRe), ubound(InData%TwrRe)) call RegPack(Buf, InData%TwrRe) end if if (RegCheckErr(Buf, RoutineName)) return - ! VTwr call RegPack(Buf, InData%VTwr) if (RegCheckErr(Buf, RoutineName)) return - ! Tower_Wake_Constant call RegPack(Buf, InData%Tower_Wake_Constant) if (RegCheckErr(Buf, RoutineName)) return - ! NTwrCDCol call RegPack(Buf, allocated(InData%NTwrCDCol)) if (allocated(InData%NTwrCDCol)) then call RegPackBounds(Buf, 1, lbound(InData%NTwrCDCol), ubound(InData%NTwrCDCol)) call RegPack(Buf, InData%NTwrCDCol) end if if (RegCheckErr(Buf, RoutineName)) return - ! NTwrHT call RegPack(Buf, InData%NTwrHT) if (RegCheckErr(Buf, RoutineName)) return - ! NTwrRe call RegPack(Buf, InData%NTwrRe) if (RegCheckErr(Buf, RoutineName)) return - ! NTwrCD call RegPack(Buf, InData%NTwrCD) if (RegCheckErr(Buf, RoutineName)) return - ! TwrPotent call RegPack(Buf, InData%TwrPotent) if (RegCheckErr(Buf, RoutineName)) return - ! TwrShadow call RegPack(Buf, InData%TwrShadow) if (RegCheckErr(Buf, RoutineName)) return - ! ShadHWid call RegPack(Buf, InData%ShadHWid) if (RegCheckErr(Buf, RoutineName)) return - ! TShadC1 call RegPack(Buf, InData%TShadC1) if (RegCheckErr(Buf, RoutineName)) return - ! TShadC2 call RegPack(Buf, InData%TShadC2) if (RegCheckErr(Buf, RoutineName)) return - ! TwrShad call RegPack(Buf, InData%TwrShad) if (RegCheckErr(Buf, RoutineName)) return - ! PJM_Version call RegPack(Buf, InData%PJM_Version) if (RegCheckErr(Buf, RoutineName)) return - ! TwrFile call RegPack(Buf, InData%TwrFile) if (RegCheckErr(Buf, RoutineName)) return - ! T_Shad_Refpt call RegPack(Buf, InData%T_Shad_Refpt) if (RegCheckErr(Buf, RoutineName)) return - ! CalcTwrAero call RegPack(Buf, InData%CalcTwrAero) if (RegCheckErr(Buf, RoutineName)) return - ! NumTwrNodes call RegPack(Buf, InData%NumTwrNodes) if (RegCheckErr(Buf, RoutineName)) return - ! TwrNodeWidth call RegPack(Buf, allocated(InData%TwrNodeWidth)) if (allocated(InData%TwrNodeWidth)) then call RegPackBounds(Buf, 1, lbound(InData%TwrNodeWidth), ubound(InData%TwrNodeWidth)) @@ -5946,7 +5412,6 @@ subroutine AD14_UnPackTwrPropsParms(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! TwrHtFr if (allocated(OutData%TwrHtFr)) deallocate(OutData%TwrHtFr) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5961,7 +5426,6 @@ subroutine AD14_UnPackTwrPropsParms(Buf, OutData) call RegUnpack(Buf, OutData%TwrHtFr) if (RegCheckErr(Buf, RoutineName)) return end if - ! TwrWid if (allocated(OutData%TwrWid)) deallocate(OutData%TwrWid) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5976,7 +5440,6 @@ subroutine AD14_UnPackTwrPropsParms(Buf, OutData) call RegUnpack(Buf, OutData%TwrWid) if (RegCheckErr(Buf, RoutineName)) return end if - ! TwrCD if (allocated(OutData%TwrCD)) deallocate(OutData%TwrCD) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5991,7 +5454,6 @@ subroutine AD14_UnPackTwrPropsParms(Buf, OutData) call RegUnpack(Buf, OutData%TwrCD) if (RegCheckErr(Buf, RoutineName)) return end if - ! TwrRe if (allocated(OutData%TwrRe)) deallocate(OutData%TwrRe) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6006,13 +5468,10 @@ subroutine AD14_UnPackTwrPropsParms(Buf, OutData) call RegUnpack(Buf, OutData%TwrRe) if (RegCheckErr(Buf, RoutineName)) return end if - ! VTwr call RegUnpack(Buf, OutData%VTwr) if (RegCheckErr(Buf, RoutineName)) return - ! Tower_Wake_Constant call RegUnpack(Buf, OutData%Tower_Wake_Constant) if (RegCheckErr(Buf, RoutineName)) return - ! NTwrCDCol if (allocated(OutData%NTwrCDCol)) deallocate(OutData%NTwrCDCol) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6027,49 +5486,34 @@ subroutine AD14_UnPackTwrPropsParms(Buf, OutData) call RegUnpack(Buf, OutData%NTwrCDCol) if (RegCheckErr(Buf, RoutineName)) return end if - ! NTwrHT call RegUnpack(Buf, OutData%NTwrHT) if (RegCheckErr(Buf, RoutineName)) return - ! NTwrRe call RegUnpack(Buf, OutData%NTwrRe) if (RegCheckErr(Buf, RoutineName)) return - ! NTwrCD call RegUnpack(Buf, OutData%NTwrCD) if (RegCheckErr(Buf, RoutineName)) return - ! TwrPotent call RegUnpack(Buf, OutData%TwrPotent) if (RegCheckErr(Buf, RoutineName)) return - ! TwrShadow call RegUnpack(Buf, OutData%TwrShadow) if (RegCheckErr(Buf, RoutineName)) return - ! ShadHWid call RegUnpack(Buf, OutData%ShadHWid) if (RegCheckErr(Buf, RoutineName)) return - ! TShadC1 call RegUnpack(Buf, OutData%TShadC1) if (RegCheckErr(Buf, RoutineName)) return - ! TShadC2 call RegUnpack(Buf, OutData%TShadC2) if (RegCheckErr(Buf, RoutineName)) return - ! TwrShad call RegUnpack(Buf, OutData%TwrShad) if (RegCheckErr(Buf, RoutineName)) return - ! PJM_Version call RegUnpack(Buf, OutData%PJM_Version) if (RegCheckErr(Buf, RoutineName)) return - ! TwrFile call RegUnpack(Buf, OutData%TwrFile) if (RegCheckErr(Buf, RoutineName)) return - ! T_Shad_Refpt call RegUnpack(Buf, OutData%T_Shad_Refpt) if (RegCheckErr(Buf, RoutineName)) return - ! CalcTwrAero call RegUnpack(Buf, OutData%CalcTwrAero) if (RegCheckErr(Buf, RoutineName)) return - ! NumTwrNodes call RegUnpack(Buf, OutData%NumTwrNodes) if (RegCheckErr(Buf, RoutineName)) return - ! TwrNodeWidth if (allocated(OutData%TwrNodeWidth)) deallocate(OutData%TwrNodeWidth) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6085,65 +5529,48 @@ subroutine AD14_UnPackTwrPropsParms(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE AD14_CopyWind( SrcWindData, DstWindData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Wind), INTENT(IN) :: SrcWindData - TYPE(Wind), INTENT(INOUT) :: DstWindData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_CopyWind' -! + +subroutine AD14_CopyWind(SrcWindData, DstWindData, CtrlCode, ErrStat, ErrMsg) + type(Wind), intent(in) :: SrcWindData + type(Wind), intent(inout) :: DstWindData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_CopyWind' ErrStat = ErrID_None - ErrMsg = "" - DstWindData%ANGFLW = SrcWindData%ANGFLW - DstWindData%CDEL = SrcWindData%CDEL - DstWindData%VROTORX = SrcWindData%VROTORX - DstWindData%VROTORY = SrcWindData%VROTORY - DstWindData%VROTORZ = SrcWindData%VROTORZ - DstWindData%SDEL = SrcWindData%SDEL - END SUBROUTINE AD14_CopyWind - - SUBROUTINE AD14_DestroyWind( WindData, ErrStat, ErrMsg ) - TYPE(Wind), INTENT(INOUT) :: WindData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyWind' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE AD14_DestroyWind + ErrMsg = '' + DstWindData%ANGFLW = SrcWindData%ANGFLW + DstWindData%CDEL = SrcWindData%CDEL + DstWindData%VROTORX = SrcWindData%VROTORX + DstWindData%VROTORY = SrcWindData%VROTORY + DstWindData%VROTORZ = SrcWindData%VROTORZ + DstWindData%SDEL = SrcWindData%SDEL +end subroutine +subroutine AD14_DestroyWind(WindData, ErrStat, ErrMsg) + type(Wind), intent(inout) :: WindData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_DestroyWind' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine AD14_PackWind(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Wind), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackWind' if (Buf%ErrStat >= AbortErrLev) return - ! ANGFLW call RegPack(Buf, InData%ANGFLW) if (RegCheckErr(Buf, RoutineName)) return - ! CDEL call RegPack(Buf, InData%CDEL) if (RegCheckErr(Buf, RoutineName)) return - ! VROTORX call RegPack(Buf, InData%VROTORX) if (RegCheckErr(Buf, RoutineName)) return - ! VROTORY call RegPack(Buf, InData%VROTORY) if (RegCheckErr(Buf, RoutineName)) return - ! VROTORZ call RegPack(Buf, InData%VROTORZ) if (RegCheckErr(Buf, RoutineName)) return - ! SDEL call RegPack(Buf, InData%SDEL) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -6153,68 +5580,49 @@ subroutine AD14_UnPackWind(Buf, OutData) type(Wind), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackWind' if (Buf%ErrStat /= ErrID_None) return - ! ANGFLW call RegUnpack(Buf, OutData%ANGFLW) if (RegCheckErr(Buf, RoutineName)) return - ! CDEL call RegUnpack(Buf, OutData%CDEL) if (RegCheckErr(Buf, RoutineName)) return - ! VROTORX call RegUnpack(Buf, OutData%VROTORX) if (RegCheckErr(Buf, RoutineName)) return - ! VROTORY call RegUnpack(Buf, OutData%VROTORY) if (RegCheckErr(Buf, RoutineName)) return - ! VROTORZ call RegUnpack(Buf, OutData%VROTORZ) if (RegCheckErr(Buf, RoutineName)) return - ! SDEL call RegUnpack(Buf, OutData%SDEL) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE AD14_CopyWindParms( SrcWindParmsData, DstWindParmsData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WindParms), INTENT(IN) :: SrcWindParmsData - TYPE(WindParms), INTENT(INOUT) :: DstWindParmsData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_CopyWindParms' -! - ErrStat = ErrID_None - ErrMsg = "" - DstWindParmsData%Rho = SrcWindParmsData%Rho - DstWindParmsData%KinVisc = SrcWindParmsData%KinVisc - END SUBROUTINE AD14_CopyWindParms - SUBROUTINE AD14_DestroyWindParms( WindParmsData, ErrStat, ErrMsg ) - TYPE(WindParms), INTENT(INOUT) :: WindParmsData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyWindParms' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE AD14_DestroyWindParms +subroutine AD14_CopyWindParms(SrcWindParmsData, DstWindParmsData, CtrlCode, ErrStat, ErrMsg) + type(WindParms), intent(in) :: SrcWindParmsData + type(WindParms), intent(inout) :: DstWindParmsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_CopyWindParms' + ErrStat = ErrID_None + ErrMsg = '' + DstWindParmsData%Rho = SrcWindParmsData%Rho + DstWindParmsData%KinVisc = SrcWindParmsData%KinVisc +end subroutine +subroutine AD14_DestroyWindParms(WindParmsData, ErrStat, ErrMsg) + type(WindParms), intent(inout) :: WindParmsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_DestroyWindParms' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine AD14_PackWindParms(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(WindParms), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackWindParms' if (Buf%ErrStat >= AbortErrLev) return - ! Rho call RegPack(Buf, InData%Rho) if (RegCheckErr(Buf, RoutineName)) return - ! KinVisc call RegPack(Buf, InData%KinVisc) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -6224,53 +5632,38 @@ subroutine AD14_UnPackWindParms(Buf, OutData) type(WindParms), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackWindParms' if (Buf%ErrStat /= ErrID_None) return - ! Rho call RegUnpack(Buf, OutData%Rho) if (RegCheckErr(Buf, RoutineName)) return - ! KinVisc call RegUnpack(Buf, OutData%KinVisc) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE AD14_CopyPositionType( SrcPositionTypeData, DstPositionTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(PositionType), INTENT(IN) :: SrcPositionTypeData - TYPE(PositionType), INTENT(INOUT) :: DstPositionTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_CopyPositionType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstPositionTypeData%Pos = SrcPositionTypeData%Pos - END SUBROUTINE AD14_CopyPositionType - - SUBROUTINE AD14_DestroyPositionType( PositionTypeData, ErrStat, ErrMsg ) - TYPE(PositionType), INTENT(INOUT) :: PositionTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyPositionType' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE AD14_DestroyPositionType +subroutine AD14_CopyPositionType(SrcPositionTypeData, DstPositionTypeData, CtrlCode, ErrStat, ErrMsg) + type(PositionType), intent(in) :: SrcPositionTypeData + type(PositionType), intent(inout) :: DstPositionTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_CopyPositionType' + ErrStat = ErrID_None + ErrMsg = '' + DstPositionTypeData%Pos = SrcPositionTypeData%Pos +end subroutine +subroutine AD14_DestroyPositionType(PositionTypeData, ErrStat, ErrMsg) + type(PositionType), intent(inout) :: PositionTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_DestroyPositionType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine AD14_PackPositionType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(PositionType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackPositionType' if (Buf%ErrStat >= AbortErrLev) return - ! Pos call RegPack(Buf, InData%Pos) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -6280,51 +5673,36 @@ subroutine AD14_UnPackPositionType(Buf, OutData) type(PositionType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackPositionType' if (Buf%ErrStat /= ErrID_None) return - ! Pos call RegUnpack(Buf, OutData%Pos) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE AD14_CopyOrientationType( SrcOrientationTypeData, DstOrientationTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(OrientationType), INTENT(IN) :: SrcOrientationTypeData - TYPE(OrientationType), INTENT(INOUT) :: DstOrientationTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_CopyOrientationType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOrientationTypeData%Orient = SrcOrientationTypeData%Orient - END SUBROUTINE AD14_CopyOrientationType - - SUBROUTINE AD14_DestroyOrientationType( OrientationTypeData, ErrStat, ErrMsg ) - TYPE(OrientationType), INTENT(INOUT) :: OrientationTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyOrientationType' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE AD14_DestroyOrientationType +subroutine AD14_CopyOrientationType(SrcOrientationTypeData, DstOrientationTypeData, CtrlCode, ErrStat, ErrMsg) + type(OrientationType), intent(in) :: SrcOrientationTypeData + type(OrientationType), intent(inout) :: DstOrientationTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_CopyOrientationType' + ErrStat = ErrID_None + ErrMsg = '' + DstOrientationTypeData%Orient = SrcOrientationTypeData%Orient +end subroutine +subroutine AD14_DestroyOrientationType(OrientationTypeData, ErrStat, ErrMsg) + type(OrientationType), intent(inout) :: OrientationTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD14_DestroyOrientationType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine AD14_PackOrientationType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(OrientationType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackOrientationType' if (Buf%ErrStat >= AbortErrLev) return - ! Orient call RegPack(Buf, InData%Orient) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -6334,127 +5712,101 @@ subroutine AD14_UnPackOrientationType(Buf, OutData) type(OrientationType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackOrientationType' if (Buf%ErrStat /= ErrID_None) return - ! Orient call RegUnpack(Buf, OutData%Orient) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE AD14_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD14_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(AD14_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_CopyInitInput' -! + +subroutine AD14_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(AD14_InitInputType), intent(in) :: SrcInitInputData + type(AD14_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD14_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%Title = SrcInitInputData%Title - DstInitInputData%OutRootName = SrcInitInputData%OutRootName - DstInitInputData%ADFileName = SrcInitInputData%ADFileName - DstInitInputData%WrSumFile = SrcInitInputData%WrSumFile - DstInitInputData%NumBl = SrcInitInputData%NumBl - DstInitInputData%BladeLength = SrcInitInputData%BladeLength - DstInitInputData%LinearizeFlag = SrcInitInputData%LinearizeFlag - DstInitInputData%UseDWM = SrcInitInputData%UseDWM - CALL AD14_Copyaeroconfig( SrcInitInputData%TurbineComponents, DstInitInputData%TurbineComponents, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitInputData%NumTwrNodes = SrcInitInputData%NumTwrNodes -IF (ALLOCATED(SrcInitInputData%TwrNodeLocs)) THEN - i1_l = LBOUND(SrcInitInputData%TwrNodeLocs,1) - i1_u = UBOUND(SrcInitInputData%TwrNodeLocs,1) - i2_l = LBOUND(SrcInitInputData%TwrNodeLocs,2) - i2_u = UBOUND(SrcInitInputData%TwrNodeLocs,2) - IF (.NOT. ALLOCATED(DstInitInputData%TwrNodeLocs)) THEN - ALLOCATE(DstInitInputData%TwrNodeLocs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%TwrNodeLocs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%TwrNodeLocs = SrcInitInputData%TwrNodeLocs -ENDIF - DstInitInputData%HubHt = SrcInitInputData%HubHt - CALL DWM_CopyInitInput( SrcInitInputData%DWM, DstInitInputData%DWM, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD14_CopyInitInput - - SUBROUTINE AD14_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(AD14_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL AD14_DestroyAeroConfig( InitInputData%TurbineComponents, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitInputData%TwrNodeLocs)) THEN - DEALLOCATE(InitInputData%TwrNodeLocs) -ENDIF - CALL DWM_DestroyInitInput( InitInputData%DWM, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD14_DestroyInitInput + ErrMsg = '' + DstInitInputData%Title = SrcInitInputData%Title + DstInitInputData%OutRootName = SrcInitInputData%OutRootName + DstInitInputData%ADFileName = SrcInitInputData%ADFileName + DstInitInputData%WrSumFile = SrcInitInputData%WrSumFile + DstInitInputData%NumBl = SrcInitInputData%NumBl + DstInitInputData%BladeLength = SrcInitInputData%BladeLength + DstInitInputData%LinearizeFlag = SrcInitInputData%LinearizeFlag + DstInitInputData%UseDWM = SrcInitInputData%UseDWM + call AD14_CopyAeroConfig(SrcInitInputData%TurbineComponents, DstInitInputData%TurbineComponents, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitInputData%NumTwrNodes = SrcInitInputData%NumTwrNodes + if (allocated(SrcInitInputData%TwrNodeLocs)) then + LB(1:2) = lbound(SrcInitInputData%TwrNodeLocs) + UB(1:2) = ubound(SrcInitInputData%TwrNodeLocs) + if (.not. allocated(DstInitInputData%TwrNodeLocs)) then + allocate(DstInitInputData%TwrNodeLocs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%TwrNodeLocs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%TwrNodeLocs = SrcInitInputData%TwrNodeLocs + else if (allocated(DstInitInputData%TwrNodeLocs)) then + deallocate(DstInitInputData%TwrNodeLocs) + end if + DstInitInputData%HubHt = SrcInitInputData%HubHt + call DWM_CopyInitInput(SrcInitInputData%DWM, DstInitInputData%DWM, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine AD14_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(AD14_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD14_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitInputData%TwrNodeLocs)) then + deallocate(InitInputData%TwrNodeLocs) + end if +end subroutine subroutine AD14_PackInitInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AD14_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return - ! Title call RegPack(Buf, InData%Title) if (RegCheckErr(Buf, RoutineName)) return - ! OutRootName call RegPack(Buf, InData%OutRootName) if (RegCheckErr(Buf, RoutineName)) return - ! ADFileName call RegPack(Buf, InData%ADFileName) if (RegCheckErr(Buf, RoutineName)) return - ! WrSumFile call RegPack(Buf, InData%WrSumFile) if (RegCheckErr(Buf, RoutineName)) return - ! NumBl call RegPack(Buf, InData%NumBl) if (RegCheckErr(Buf, RoutineName)) return - ! BladeLength call RegPack(Buf, InData%BladeLength) if (RegCheckErr(Buf, RoutineName)) return - ! LinearizeFlag call RegPack(Buf, InData%LinearizeFlag) if (RegCheckErr(Buf, RoutineName)) return - ! UseDWM call RegPack(Buf, InData%UseDWM) if (RegCheckErr(Buf, RoutineName)) return - ! TurbineComponents call AD14_PackAeroConfig(Buf, InData%TurbineComponents) if (RegCheckErr(Buf, RoutineName)) return - ! NumTwrNodes call RegPack(Buf, InData%NumTwrNodes) if (RegCheckErr(Buf, RoutineName)) return - ! TwrNodeLocs call RegPack(Buf, allocated(InData%TwrNodeLocs)) if (allocated(InData%TwrNodeLocs)) then call RegPackBounds(Buf, 2, lbound(InData%TwrNodeLocs), ubound(InData%TwrNodeLocs)) call RegPack(Buf, InData%TwrNodeLocs) end if if (RegCheckErr(Buf, RoutineName)) return - ! HubHt call RegPack(Buf, InData%HubHt) if (RegCheckErr(Buf, RoutineName)) return - ! DWM call DWM_PackInitInput(Buf, InData%DWM) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -6467,36 +5819,25 @@ subroutine AD14_UnPackInitInput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! Title call RegUnpack(Buf, OutData%Title) if (RegCheckErr(Buf, RoutineName)) return - ! OutRootName call RegUnpack(Buf, OutData%OutRootName) if (RegCheckErr(Buf, RoutineName)) return - ! ADFileName call RegUnpack(Buf, OutData%ADFileName) if (RegCheckErr(Buf, RoutineName)) return - ! WrSumFile call RegUnpack(Buf, OutData%WrSumFile) if (RegCheckErr(Buf, RoutineName)) return - ! NumBl call RegUnpack(Buf, OutData%NumBl) if (RegCheckErr(Buf, RoutineName)) return - ! BladeLength call RegUnpack(Buf, OutData%BladeLength) if (RegCheckErr(Buf, RoutineName)) return - ! LinearizeFlag call RegUnpack(Buf, OutData%LinearizeFlag) if (RegCheckErr(Buf, RoutineName)) return - ! UseDWM call RegUnpack(Buf, OutData%UseDWM) if (RegCheckErr(Buf, RoutineName)) return - ! TurbineComponents call AD14_UnpackAeroConfig(Buf, OutData%TurbineComponents) ! TurbineComponents - ! NumTwrNodes call RegUnpack(Buf, OutData%NumTwrNodes) if (RegCheckErr(Buf, RoutineName)) return - ! TwrNodeLocs if (allocated(OutData%TwrNodeLocs)) deallocate(OutData%TwrNodeLocs) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6511,67 +5852,51 @@ subroutine AD14_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%TwrNodeLocs) if (RegCheckErr(Buf, RoutineName)) return end if - ! HubHt call RegUnpack(Buf, OutData%HubHt) if (RegCheckErr(Buf, RoutineName)) return - ! DWM call DWM_UnpackInitInput(Buf, OutData%DWM) ! DWM end subroutine - SUBROUTINE AD14_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD14_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(AD14_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_CopyInitOutput' -! + +subroutine AD14_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(AD14_InitOutputType), intent(in) :: SrcInitOutputData + type(AD14_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD14_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DWM_CopyInitOutput( SrcInitOutputData%DWM, DstInitOutputData%DWM, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitOutputData%AirDens = SrcInitOutputData%AirDens - END SUBROUTINE AD14_CopyInitOutput - - SUBROUTINE AD14_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(AD14_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_DestroyInitOutput( InitOutputData%DWM, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD14_DestroyInitOutput + ErrMsg = '' + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call DWM_CopyInitOutput(SrcInitOutputData%DWM, DstInitOutputData%DWM, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitOutputData%AirDens = SrcInitOutputData%AirDens +end subroutine +subroutine AD14_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(AD14_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD14_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine AD14_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AD14_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackInitOutput' if (Buf%ErrStat >= AbortErrLev) return - ! Ver call NWTC_Library_PackProgDesc(Buf, InData%Ver) if (RegCheckErr(Buf, RoutineName)) return - ! DWM call DWM_PackInitOutput(Buf, InData%DWM) if (RegCheckErr(Buf, RoutineName)) return - ! AirDens call RegPack(Buf, InData%AirDens) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -6581,57 +5906,44 @@ subroutine AD14_UnPackInitOutput(Buf, OutData) type(AD14_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackInitOutput' if (Buf%ErrStat /= ErrID_None) return - ! Ver call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver - ! DWM call DWM_UnpackInitOutput(Buf, OutData%DWM) ! DWM - ! AirDens call RegUnpack(Buf, OutData%AirDens) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE AD14_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD14_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(AD14_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_CopyContState' -! + +subroutine AD14_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(AD14_ContinuousStateType), intent(in) :: SrcContStateData + type(AD14_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD14_CopyContState' ErrStat = ErrID_None - ErrMsg = "" - CALL DWM_CopyContState( SrcContStateData%DWM, DstContStateData%DWM, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD14_CopyContState - - SUBROUTINE AD14_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(AD14_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL DWM_DestroyContState( ContStateData%DWM, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD14_DestroyContState + ErrMsg = '' + call DWM_CopyContState(SrcContStateData%DWM, DstContStateData%DWM, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine AD14_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(AD14_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD14_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine AD14_PackContState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AD14_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackContState' if (Buf%ErrStat >= AbortErrLev) return - ! DWM call DWM_PackContState(Buf, InData%DWM) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -6641,52 +5953,41 @@ subroutine AD14_UnPackContState(Buf, OutData) type(AD14_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackContState' if (Buf%ErrStat /= ErrID_None) return - ! DWM call DWM_UnpackContState(Buf, OutData%DWM) ! DWM end subroutine - SUBROUTINE AD14_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD14_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(AD14_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_CopyDiscState' -! + +subroutine AD14_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(AD14_DiscreteStateType), intent(in) :: SrcDiscStateData + type(AD14_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD14_CopyDiscState' ErrStat = ErrID_None - ErrMsg = "" - CALL DWM_CopyDiscState( SrcDiscStateData%DWM, DstDiscStateData%DWM, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD14_CopyDiscState - - SUBROUTINE AD14_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(AD14_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL DWM_DestroyDiscState( DiscStateData%DWM, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD14_DestroyDiscState + ErrMsg = '' + call DWM_CopyDiscState(SrcDiscStateData%DWM, DstDiscStateData%DWM, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine AD14_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(AD14_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD14_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine AD14_PackDiscState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AD14_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackDiscState' if (Buf%ErrStat >= AbortErrLev) return - ! DWM call DWM_PackDiscState(Buf, InData%DWM) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -6696,52 +5997,41 @@ subroutine AD14_UnPackDiscState(Buf, OutData) type(AD14_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackDiscState' if (Buf%ErrStat /= ErrID_None) return - ! DWM call DWM_UnpackDiscState(Buf, OutData%DWM) ! DWM end subroutine - SUBROUTINE AD14_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD14_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(AD14_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_CopyConstrState' -! + +subroutine AD14_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(AD14_ConstraintStateType), intent(in) :: SrcConstrStateData + type(AD14_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD14_CopyConstrState' ErrStat = ErrID_None - ErrMsg = "" - CALL DWM_CopyConstrState( SrcConstrStateData%DWM, DstConstrStateData%DWM, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD14_CopyConstrState - - SUBROUTINE AD14_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(AD14_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL DWM_DestroyConstrState( ConstrStateData%DWM, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD14_DestroyConstrState + ErrMsg = '' + call DWM_CopyConstrState(SrcConstrStateData%DWM, DstConstrStateData%DWM, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine AD14_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(AD14_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD14_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine AD14_PackConstrState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AD14_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackConstrState' if (Buf%ErrStat >= AbortErrLev) return - ! DWM call DWM_PackConstrState(Buf, InData%DWM) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -6751,52 +6041,41 @@ subroutine AD14_UnPackConstrState(Buf, OutData) type(AD14_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackConstrState' if (Buf%ErrStat /= ErrID_None) return - ! DWM call DWM_UnpackConstrState(Buf, OutData%DWM) ! DWM end subroutine - SUBROUTINE AD14_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD14_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(AD14_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_CopyOtherState' -! + +subroutine AD14_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(AD14_OtherStateType), intent(in) :: SrcOtherStateData + type(AD14_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD14_CopyOtherState' ErrStat = ErrID_None - ErrMsg = "" - CALL DWM_CopyOtherState( SrcOtherStateData%DWM, DstOtherStateData%DWM, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD14_CopyOtherState - - SUBROUTINE AD14_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(AD14_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL DWM_DestroyOtherState( OtherStateData%DWM, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD14_DestroyOtherState + ErrMsg = '' + call DWM_CopyOtherState(SrcOtherStateData%DWM, DstOtherStateData%DWM, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine AD14_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(AD14_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD14_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine AD14_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AD14_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackOtherState' if (Buf%ErrStat >= AbortErrLev) return - ! DWM call DWM_PackOtherState(Buf, InData%DWM) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -6806,269 +6085,205 @@ subroutine AD14_UnPackOtherState(Buf, OutData) type(AD14_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackOtherState' if (Buf%ErrStat /= ErrID_None) return - ! DWM call DWM_UnpackOtherState(Buf, OutData%DWM) ! DWM end subroutine - SUBROUTINE AD14_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD14_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(AD14_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_CopyMisc' -! + +subroutine AD14_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(AD14_MiscVarType), intent(in) :: SrcMiscData + type(AD14_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD14_CopyMisc' ErrStat = ErrID_None - ErrMsg = "" - CALL DWM_CopyMisc( SrcMiscData%DWM, DstMiscData%DWM, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DWM_CopyInput( SrcMiscData%DWM_Inputs, DstMiscData%DWM_Inputs, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DWM_CopyOutput( SrcMiscData%DWM_Outputs, DstMiscData%DWM_Outputs, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstMiscData%DT = SrcMiscData%DT -IF (ALLOCATED(SrcMiscData%ElPrNum)) THEN - i1_l = LBOUND(SrcMiscData%ElPrNum,1) - i1_u = UBOUND(SrcMiscData%ElPrNum,1) - IF (.NOT. ALLOCATED(DstMiscData%ElPrNum)) THEN - ALLOCATE(DstMiscData%ElPrNum(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ElPrNum.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%ElPrNum = SrcMiscData%ElPrNum -ENDIF - DstMiscData%OldTime = SrcMiscData%OldTime - DstMiscData%HubLoss = SrcMiscData%HubLoss - DstMiscData%Loss = SrcMiscData%Loss - DstMiscData%TipLoss = SrcMiscData%TipLoss - DstMiscData%TLpt7 = SrcMiscData%TLpt7 - DstMiscData%FirstPassGTL = SrcMiscData%FirstPassGTL - DstMiscData%SuperSonic = SrcMiscData%SuperSonic - DstMiscData%AFLAGVinderr = SrcMiscData%AFLAGVinderr - DstMiscData%AFLAGTwrInflu = SrcMiscData%AFLAGTwrInflu - DstMiscData%OnePassDynDbg = SrcMiscData%OnePassDynDbg - DstMiscData%NoLoadsCalculated = SrcMiscData%NoLoadsCalculated - DstMiscData%NERRORS = SrcMiscData%NERRORS - CALL AD14_Copyairfoil( SrcMiscData%AirFoil, DstMiscData%AirFoil, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copybeddoes( SrcMiscData%Beddoes, DstMiscData%Beddoes, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copydyninflow( SrcMiscData%DynInflow, DstMiscData%DynInflow, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copyelement( SrcMiscData%Element, DstMiscData%Element, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copyrotor( SrcMiscData%Rotor, DstMiscData%Rotor, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copywind( SrcMiscData%Wind, DstMiscData%Wind, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copyinducedvel( SrcMiscData%InducedVel, DstMiscData%InducedVel, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copyeloutparms( SrcMiscData%ElOut, DstMiscData%ElOut, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstMiscData%Skew = SrcMiscData%Skew - DstMiscData%DynInit = SrcMiscData%DynInit - DstMiscData%FirstWarn = SrcMiscData%FirstWarn -IF (ALLOCATED(SrcMiscData%StoredForces)) THEN - i1_l = LBOUND(SrcMiscData%StoredForces,1) - i1_u = UBOUND(SrcMiscData%StoredForces,1) - i2_l = LBOUND(SrcMiscData%StoredForces,2) - i2_u = UBOUND(SrcMiscData%StoredForces,2) - i3_l = LBOUND(SrcMiscData%StoredForces,3) - i3_u = UBOUND(SrcMiscData%StoredForces,3) - IF (.NOT. ALLOCATED(DstMiscData%StoredForces)) THEN - ALLOCATE(DstMiscData%StoredForces(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%StoredForces.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%StoredForces = SrcMiscData%StoredForces -ENDIF -IF (ALLOCATED(SrcMiscData%StoredMoments)) THEN - i1_l = LBOUND(SrcMiscData%StoredMoments,1) - i1_u = UBOUND(SrcMiscData%StoredMoments,1) - i2_l = LBOUND(SrcMiscData%StoredMoments,2) - i2_u = UBOUND(SrcMiscData%StoredMoments,2) - i3_l = LBOUND(SrcMiscData%StoredMoments,3) - i3_u = UBOUND(SrcMiscData%StoredMoments,3) - IF (.NOT. ALLOCATED(DstMiscData%StoredMoments)) THEN - ALLOCATE(DstMiscData%StoredMoments(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%StoredMoments.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%StoredMoments = SrcMiscData%StoredMoments -ENDIF - END SUBROUTINE AD14_CopyMisc - - SUBROUTINE AD14_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(AD14_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL DWM_DestroyMisc( MiscData%DWM, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_DestroyInput( MiscData%DWM_Inputs, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_DestroyOutput( MiscData%DWM_Outputs, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MiscData%ElPrNum)) THEN - DEALLOCATE(MiscData%ElPrNum) -ENDIF - CALL AD14_DestroyAirFoil( MiscData%AirFoil, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyBeddoes( MiscData%Beddoes, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyDynInflow( MiscData%DynInflow, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyElement( MiscData%Element, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyRotor( MiscData%Rotor, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyWind( MiscData%Wind, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyInducedVel( MiscData%InducedVel, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyElOutParms( MiscData%ElOut, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MiscData%StoredForces)) THEN - DEALLOCATE(MiscData%StoredForces) -ENDIF -IF (ALLOCATED(MiscData%StoredMoments)) THEN - DEALLOCATE(MiscData%StoredMoments) -ENDIF - END SUBROUTINE AD14_DestroyMisc + ErrMsg = '' + call DWM_CopyMisc(SrcMiscData%DWM, DstMiscData%DWM, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call DWM_CopyInput(SrcMiscData%DWM_Inputs, DstMiscData%DWM_Inputs, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call DWM_CopyOutput(SrcMiscData%DWM_Outputs, DstMiscData%DWM_Outputs, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstMiscData%DT = SrcMiscData%DT + if (allocated(SrcMiscData%ElPrNum)) then + LB(1:1) = lbound(SrcMiscData%ElPrNum) + UB(1:1) = ubound(SrcMiscData%ElPrNum) + if (.not. allocated(DstMiscData%ElPrNum)) then + allocate(DstMiscData%ElPrNum(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ElPrNum.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%ElPrNum = SrcMiscData%ElPrNum + else if (allocated(DstMiscData%ElPrNum)) then + deallocate(DstMiscData%ElPrNum) + end if + DstMiscData%OldTime = SrcMiscData%OldTime + DstMiscData%HubLoss = SrcMiscData%HubLoss + DstMiscData%Loss = SrcMiscData%Loss + DstMiscData%TipLoss = SrcMiscData%TipLoss + DstMiscData%TLpt7 = SrcMiscData%TLpt7 + DstMiscData%FirstPassGTL = SrcMiscData%FirstPassGTL + DstMiscData%SuperSonic = SrcMiscData%SuperSonic + DstMiscData%AFLAGVinderr = SrcMiscData%AFLAGVinderr + DstMiscData%AFLAGTwrInflu = SrcMiscData%AFLAGTwrInflu + DstMiscData%OnePassDynDbg = SrcMiscData%OnePassDynDbg + DstMiscData%NoLoadsCalculated = SrcMiscData%NoLoadsCalculated + DstMiscData%NERRORS = SrcMiscData%NERRORS + call AD14_CopyAirFoil(SrcMiscData%AirFoil, DstMiscData%AirFoil, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyBeddoes(SrcMiscData%Beddoes, DstMiscData%Beddoes, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyDynInflow(SrcMiscData%DynInflow, DstMiscData%DynInflow, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyElement(SrcMiscData%Element, DstMiscData%Element, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyRotor(SrcMiscData%Rotor, DstMiscData%Rotor, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyWind(SrcMiscData%Wind, DstMiscData%Wind, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyInducedVel(SrcMiscData%InducedVel, DstMiscData%InducedVel, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyElOutParms(SrcMiscData%ElOut, DstMiscData%ElOut, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstMiscData%Skew = SrcMiscData%Skew + DstMiscData%DynInit = SrcMiscData%DynInit + DstMiscData%FirstWarn = SrcMiscData%FirstWarn + if (allocated(SrcMiscData%StoredForces)) then + LB(1:3) = lbound(SrcMiscData%StoredForces) + UB(1:3) = ubound(SrcMiscData%StoredForces) + if (.not. allocated(DstMiscData%StoredForces)) then + allocate(DstMiscData%StoredForces(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%StoredForces.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%StoredForces = SrcMiscData%StoredForces + else if (allocated(DstMiscData%StoredForces)) then + deallocate(DstMiscData%StoredForces) + end if + if (allocated(SrcMiscData%StoredMoments)) then + LB(1:3) = lbound(SrcMiscData%StoredMoments) + UB(1:3) = ubound(SrcMiscData%StoredMoments) + if (.not. allocated(DstMiscData%StoredMoments)) then + allocate(DstMiscData%StoredMoments(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%StoredMoments.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%StoredMoments = SrcMiscData%StoredMoments + else if (allocated(DstMiscData%StoredMoments)) then + deallocate(DstMiscData%StoredMoments) + end if +end subroutine +subroutine AD14_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(AD14_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD14_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%ElPrNum)) then + deallocate(MiscData%ElPrNum) + end if + if (allocated(MiscData%StoredForces)) then + deallocate(MiscData%StoredForces) + end if + if (allocated(MiscData%StoredMoments)) then + deallocate(MiscData%StoredMoments) + end if +end subroutine subroutine AD14_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AD14_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackMisc' if (Buf%ErrStat >= AbortErrLev) return - ! DWM call DWM_PackMisc(Buf, InData%DWM) if (RegCheckErr(Buf, RoutineName)) return - ! DWM_Inputs call DWM_PackInput(Buf, InData%DWM_Inputs) if (RegCheckErr(Buf, RoutineName)) return - ! DWM_Outputs call DWM_PackOutput(Buf, InData%DWM_Outputs) if (RegCheckErr(Buf, RoutineName)) return - ! DT call RegPack(Buf, InData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! ElPrNum call RegPack(Buf, allocated(InData%ElPrNum)) if (allocated(InData%ElPrNum)) then call RegPackBounds(Buf, 1, lbound(InData%ElPrNum), ubound(InData%ElPrNum)) call RegPack(Buf, InData%ElPrNum) end if if (RegCheckErr(Buf, RoutineName)) return - ! OldTime call RegPack(Buf, InData%OldTime) if (RegCheckErr(Buf, RoutineName)) return - ! HubLoss call RegPack(Buf, InData%HubLoss) if (RegCheckErr(Buf, RoutineName)) return - ! Loss call RegPack(Buf, InData%Loss) if (RegCheckErr(Buf, RoutineName)) return - ! TipLoss call RegPack(Buf, InData%TipLoss) if (RegCheckErr(Buf, RoutineName)) return - ! TLpt7 call RegPack(Buf, InData%TLpt7) if (RegCheckErr(Buf, RoutineName)) return - ! FirstPassGTL call RegPack(Buf, InData%FirstPassGTL) if (RegCheckErr(Buf, RoutineName)) return - ! SuperSonic call RegPack(Buf, InData%SuperSonic) if (RegCheckErr(Buf, RoutineName)) return - ! AFLAGVinderr call RegPack(Buf, InData%AFLAGVinderr) if (RegCheckErr(Buf, RoutineName)) return - ! AFLAGTwrInflu call RegPack(Buf, InData%AFLAGTwrInflu) if (RegCheckErr(Buf, RoutineName)) return - ! OnePassDynDbg call RegPack(Buf, InData%OnePassDynDbg) if (RegCheckErr(Buf, RoutineName)) return - ! NoLoadsCalculated call RegPack(Buf, InData%NoLoadsCalculated) if (RegCheckErr(Buf, RoutineName)) return - ! NERRORS call RegPack(Buf, InData%NERRORS) if (RegCheckErr(Buf, RoutineName)) return - ! AirFoil call AD14_PackAirFoil(Buf, InData%AirFoil) if (RegCheckErr(Buf, RoutineName)) return - ! Beddoes call AD14_PackBeddoes(Buf, InData%Beddoes) if (RegCheckErr(Buf, RoutineName)) return - ! DynInflow call AD14_PackDynInflow(Buf, InData%DynInflow) if (RegCheckErr(Buf, RoutineName)) return - ! Element call AD14_PackElement(Buf, InData%Element) if (RegCheckErr(Buf, RoutineName)) return - ! Rotor call AD14_PackRotor(Buf, InData%Rotor) if (RegCheckErr(Buf, RoutineName)) return - ! Wind call AD14_PackWind(Buf, InData%Wind) if (RegCheckErr(Buf, RoutineName)) return - ! InducedVel call AD14_PackInducedVel(Buf, InData%InducedVel) if (RegCheckErr(Buf, RoutineName)) return - ! ElOut call AD14_PackElOutParms(Buf, InData%ElOut) if (RegCheckErr(Buf, RoutineName)) return - ! Skew call RegPack(Buf, InData%Skew) if (RegCheckErr(Buf, RoutineName)) return - ! DynInit call RegPack(Buf, InData%DynInit) if (RegCheckErr(Buf, RoutineName)) return - ! FirstWarn call RegPack(Buf, InData%FirstWarn) if (RegCheckErr(Buf, RoutineName)) return - ! StoredForces call RegPack(Buf, allocated(InData%StoredForces)) if (allocated(InData%StoredForces)) then call RegPackBounds(Buf, 3, lbound(InData%StoredForces), ubound(InData%StoredForces)) call RegPack(Buf, InData%StoredForces) end if if (RegCheckErr(Buf, RoutineName)) return - ! StoredMoments call RegPack(Buf, allocated(InData%StoredMoments)) if (allocated(InData%StoredMoments)) then call RegPackBounds(Buf, 3, lbound(InData%StoredMoments), ubound(InData%StoredMoments)) @@ -7085,16 +6300,11 @@ subroutine AD14_UnPackMisc(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! DWM call DWM_UnpackMisc(Buf, OutData%DWM) ! DWM - ! DWM_Inputs call DWM_UnpackInput(Buf, OutData%DWM_Inputs) ! DWM_Inputs - ! DWM_Outputs call DWM_UnpackOutput(Buf, OutData%DWM_Outputs) ! DWM_Outputs - ! DT call RegUnpack(Buf, OutData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! ElPrNum if (allocated(OutData%ElPrNum)) deallocate(OutData%ElPrNum) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7109,68 +6319,44 @@ subroutine AD14_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%ElPrNum) if (RegCheckErr(Buf, RoutineName)) return end if - ! OldTime call RegUnpack(Buf, OutData%OldTime) if (RegCheckErr(Buf, RoutineName)) return - ! HubLoss call RegUnpack(Buf, OutData%HubLoss) if (RegCheckErr(Buf, RoutineName)) return - ! Loss call RegUnpack(Buf, OutData%Loss) if (RegCheckErr(Buf, RoutineName)) return - ! TipLoss call RegUnpack(Buf, OutData%TipLoss) if (RegCheckErr(Buf, RoutineName)) return - ! TLpt7 call RegUnpack(Buf, OutData%TLpt7) if (RegCheckErr(Buf, RoutineName)) return - ! FirstPassGTL call RegUnpack(Buf, OutData%FirstPassGTL) if (RegCheckErr(Buf, RoutineName)) return - ! SuperSonic call RegUnpack(Buf, OutData%SuperSonic) if (RegCheckErr(Buf, RoutineName)) return - ! AFLAGVinderr call RegUnpack(Buf, OutData%AFLAGVinderr) if (RegCheckErr(Buf, RoutineName)) return - ! AFLAGTwrInflu call RegUnpack(Buf, OutData%AFLAGTwrInflu) if (RegCheckErr(Buf, RoutineName)) return - ! OnePassDynDbg call RegUnpack(Buf, OutData%OnePassDynDbg) if (RegCheckErr(Buf, RoutineName)) return - ! NoLoadsCalculated call RegUnpack(Buf, OutData%NoLoadsCalculated) if (RegCheckErr(Buf, RoutineName)) return - ! NERRORS call RegUnpack(Buf, OutData%NERRORS) if (RegCheckErr(Buf, RoutineName)) return - ! AirFoil call AD14_UnpackAirFoil(Buf, OutData%AirFoil) ! AirFoil - ! Beddoes call AD14_UnpackBeddoes(Buf, OutData%Beddoes) ! Beddoes - ! DynInflow call AD14_UnpackDynInflow(Buf, OutData%DynInflow) ! DynInflow - ! Element call AD14_UnpackElement(Buf, OutData%Element) ! Element - ! Rotor call AD14_UnpackRotor(Buf, OutData%Rotor) ! Rotor - ! Wind call AD14_UnpackWind(Buf, OutData%Wind) ! Wind - ! InducedVel call AD14_UnpackInducedVel(Buf, OutData%InducedVel) ! InducedVel - ! ElOut call AD14_UnpackElOutParms(Buf, OutData%ElOut) ! ElOut - ! Skew call RegUnpack(Buf, OutData%Skew) if (RegCheckErr(Buf, RoutineName)) return - ! DynInit call RegUnpack(Buf, OutData%DynInit) if (RegCheckErr(Buf, RoutineName)) return - ! FirstWarn call RegUnpack(Buf, OutData%FirstWarn) if (RegCheckErr(Buf, RoutineName)) return - ! StoredForces if (allocated(OutData%StoredForces)) deallocate(OutData%StoredForces) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7185,7 +6371,6 @@ subroutine AD14_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%StoredForces) if (RegCheckErr(Buf, RoutineName)) return end if - ! StoredMoments if (allocated(OutData%StoredMoments)) deallocate(OutData%StoredMoments) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7201,221 +6386,159 @@ subroutine AD14_UnPackMisc(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE AD14_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD14_ParameterType), INTENT(IN) :: SrcParamData - TYPE(AD14_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_CopyParam' -! + +subroutine AD14_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(AD14_ParameterType), intent(in) :: SrcParamData + type(AD14_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD14_CopyParam' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%Title = SrcParamData%Title - DstParamData%SIUnit = SrcParamData%SIUnit - DstParamData%Echo = SrcParamData%Echo - DstParamData%MultiTab = SrcParamData%MultiTab - DstParamData%LinearizeFlag = SrcParamData%LinearizeFlag - DstParamData%OutputPlottingInfo = SrcParamData%OutputPlottingInfo - DstParamData%UseDWM = SrcParamData%UseDWM - DstParamData%TwoPiNB = SrcParamData%TwoPiNB - DstParamData%NumBl = SrcParamData%NumBl - DstParamData%NBlInpSt = SrcParamData%NBlInpSt - DstParamData%ElemPrn = SrcParamData%ElemPrn - DstParamData%DStall = SrcParamData%DStall - DstParamData%PMoment = SrcParamData%PMoment - DstParamData%Reynolds = SrcParamData%Reynolds - DstParamData%DynInfl = SrcParamData%DynInfl - DstParamData%Wake = SrcParamData%Wake - DstParamData%Swirl = SrcParamData%Swirl - DstParamData%DtAero = SrcParamData%DtAero - DstParamData%HubRad = SrcParamData%HubRad - DstParamData%UnEc = SrcParamData%UnEc - DstParamData%UnElem = SrcParamData%UnElem - DstParamData%UnWndOut = SrcParamData%UnWndOut - DstParamData%MAXICOUNT = SrcParamData%MAXICOUNT - DstParamData%WrOptFile = SrcParamData%WrOptFile - DstParamData%DEFAULT_Wind = SrcParamData%DEFAULT_Wind - CALL AD14_Copyairfoilparms( SrcParamData%AirFoil, DstParamData%AirFoil, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copybladeparms( SrcParamData%Blade, DstParamData%Blade, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copybeddoesparms( SrcParamData%Beddoes, DstParamData%Beddoes, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copydyninflowparms( SrcParamData%DynInflow, DstParamData%DynInflow, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copyelementparms( SrcParamData%Element, DstParamData%Element, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copytwrpropsparms( SrcParamData%TwrProps, DstParamData%TwrProps, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copyinducedvelparms( SrcParamData%InducedVel, DstParamData%InducedVel, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copywindparms( SrcParamData%Wind, DstParamData%Wind, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copyrotorparms( SrcParamData%Rotor, DstParamData%Rotor, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DWM_CopyParam( SrcParamData%DWM, DstParamData%DWM, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD14_CopyParam - - SUBROUTINE AD14_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(AD14_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL AD14_DestroyAirFoilParms( ParamData%AirFoil, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyBladeParms( ParamData%Blade, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyBeddoesParms( ParamData%Beddoes, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyDynInflowParms( ParamData%DynInflow, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyElementParms( ParamData%Element, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyTwrPropsParms( ParamData%TwrProps, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyInducedVelParms( ParamData%InducedVel, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyWindParms( ParamData%Wind, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyRotorParms( ParamData%Rotor, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_DestroyParam( ParamData%DWM, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD14_DestroyParam + ErrMsg = '' + DstParamData%Title = SrcParamData%Title + DstParamData%SIUnit = SrcParamData%SIUnit + DstParamData%Echo = SrcParamData%Echo + DstParamData%MultiTab = SrcParamData%MultiTab + DstParamData%LinearizeFlag = SrcParamData%LinearizeFlag + DstParamData%OutputPlottingInfo = SrcParamData%OutputPlottingInfo + DstParamData%UseDWM = SrcParamData%UseDWM + DstParamData%TwoPiNB = SrcParamData%TwoPiNB + DstParamData%NumBl = SrcParamData%NumBl + DstParamData%NBlInpSt = SrcParamData%NBlInpSt + DstParamData%ElemPrn = SrcParamData%ElemPrn + DstParamData%DStall = SrcParamData%DStall + DstParamData%PMoment = SrcParamData%PMoment + DstParamData%Reynolds = SrcParamData%Reynolds + DstParamData%DynInfl = SrcParamData%DynInfl + DstParamData%Wake = SrcParamData%Wake + DstParamData%Swirl = SrcParamData%Swirl + DstParamData%DtAero = SrcParamData%DtAero + DstParamData%HubRad = SrcParamData%HubRad + DstParamData%UnEc = SrcParamData%UnEc + DstParamData%UnElem = SrcParamData%UnElem + DstParamData%UnWndOut = SrcParamData%UnWndOut + DstParamData%MAXICOUNT = SrcParamData%MAXICOUNT + DstParamData%WrOptFile = SrcParamData%WrOptFile + DstParamData%DEFAULT_Wind = SrcParamData%DEFAULT_Wind + call AD14_CopyAirFoilParms(SrcParamData%AirFoil, DstParamData%AirFoil, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyBladeParms(SrcParamData%Blade, DstParamData%Blade, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyBeddoesParms(SrcParamData%Beddoes, DstParamData%Beddoes, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyDynInflowParms(SrcParamData%DynInflow, DstParamData%DynInflow, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyElementParms(SrcParamData%Element, DstParamData%Element, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyTwrPropsParms(SrcParamData%TwrProps, DstParamData%TwrProps, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyInducedVelParms(SrcParamData%InducedVel, DstParamData%InducedVel, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyWindParms(SrcParamData%Wind, DstParamData%Wind, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyRotorParms(SrcParamData%Rotor, DstParamData%Rotor, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call DWM_CopyParam(SrcParamData%DWM, DstParamData%DWM, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine AD14_DestroyParam(ParamData, ErrStat, ErrMsg) + type(AD14_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD14_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine AD14_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AD14_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD14_PackParam' if (Buf%ErrStat >= AbortErrLev) return - ! Title call RegPack(Buf, InData%Title) if (RegCheckErr(Buf, RoutineName)) return - ! SIUnit call RegPack(Buf, InData%SIUnit) if (RegCheckErr(Buf, RoutineName)) return - ! Echo call RegPack(Buf, InData%Echo) if (RegCheckErr(Buf, RoutineName)) return - ! MultiTab call RegPack(Buf, InData%MultiTab) if (RegCheckErr(Buf, RoutineName)) return - ! LinearizeFlag call RegPack(Buf, InData%LinearizeFlag) if (RegCheckErr(Buf, RoutineName)) return - ! OutputPlottingInfo call RegPack(Buf, InData%OutputPlottingInfo) if (RegCheckErr(Buf, RoutineName)) return - ! UseDWM call RegPack(Buf, InData%UseDWM) if (RegCheckErr(Buf, RoutineName)) return - ! TwoPiNB call RegPack(Buf, InData%TwoPiNB) if (RegCheckErr(Buf, RoutineName)) return - ! NumBl call RegPack(Buf, InData%NumBl) if (RegCheckErr(Buf, RoutineName)) return - ! NBlInpSt call RegPack(Buf, InData%NBlInpSt) if (RegCheckErr(Buf, RoutineName)) return - ! ElemPrn call RegPack(Buf, InData%ElemPrn) if (RegCheckErr(Buf, RoutineName)) return - ! DStall call RegPack(Buf, InData%DStall) if (RegCheckErr(Buf, RoutineName)) return - ! PMoment call RegPack(Buf, InData%PMoment) if (RegCheckErr(Buf, RoutineName)) return - ! Reynolds call RegPack(Buf, InData%Reynolds) if (RegCheckErr(Buf, RoutineName)) return - ! DynInfl call RegPack(Buf, InData%DynInfl) if (RegCheckErr(Buf, RoutineName)) return - ! Wake call RegPack(Buf, InData%Wake) if (RegCheckErr(Buf, RoutineName)) return - ! Swirl call RegPack(Buf, InData%Swirl) if (RegCheckErr(Buf, RoutineName)) return - ! DtAero call RegPack(Buf, InData%DtAero) if (RegCheckErr(Buf, RoutineName)) return - ! HubRad call RegPack(Buf, InData%HubRad) if (RegCheckErr(Buf, RoutineName)) return - ! UnEc call RegPack(Buf, InData%UnEc) if (RegCheckErr(Buf, RoutineName)) return - ! UnElem call RegPack(Buf, InData%UnElem) if (RegCheckErr(Buf, RoutineName)) return - ! UnWndOut call RegPack(Buf, InData%UnWndOut) if (RegCheckErr(Buf, RoutineName)) return - ! MAXICOUNT call RegPack(Buf, InData%MAXICOUNT) if (RegCheckErr(Buf, RoutineName)) return - ! WrOptFile call RegPack(Buf, InData%WrOptFile) if (RegCheckErr(Buf, RoutineName)) return - ! DEFAULT_Wind call RegPack(Buf, InData%DEFAULT_Wind) if (RegCheckErr(Buf, RoutineName)) return - ! AirFoil call AD14_PackAirFoilParms(Buf, InData%AirFoil) if (RegCheckErr(Buf, RoutineName)) return - ! Blade call AD14_PackBladeParms(Buf, InData%Blade) if (RegCheckErr(Buf, RoutineName)) return - ! Beddoes call AD14_PackBeddoesParms(Buf, InData%Beddoes) if (RegCheckErr(Buf, RoutineName)) return - ! DynInflow call AD14_PackDynInflowParms(Buf, InData%DynInflow) if (RegCheckErr(Buf, RoutineName)) return - ! Element call AD14_PackElementParms(Buf, InData%Element) if (RegCheckErr(Buf, RoutineName)) return - ! TwrProps call AD14_PackTwrPropsParms(Buf, InData%TwrProps) if (RegCheckErr(Buf, RoutineName)) return - ! InducedVel call AD14_PackInducedVelParms(Buf, InData%InducedVel) if (RegCheckErr(Buf, RoutineName)) return - ! Wind call AD14_PackWindParms(Buf, InData%Wind) if (RegCheckErr(Buf, RoutineName)) return - ! Rotor call AD14_PackRotorParms(Buf, InData%Rotor) if (RegCheckErr(Buf, RoutineName)) return - ! DWM call DWM_PackParam(Buf, InData%DWM) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -7425,203 +6548,163 @@ subroutine AD14_UnPackParam(Buf, OutData) type(AD14_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD14_UnPackParam' if (Buf%ErrStat /= ErrID_None) return - ! Title call RegUnpack(Buf, OutData%Title) if (RegCheckErr(Buf, RoutineName)) return - ! SIUnit call RegUnpack(Buf, OutData%SIUnit) if (RegCheckErr(Buf, RoutineName)) return - ! Echo call RegUnpack(Buf, OutData%Echo) if (RegCheckErr(Buf, RoutineName)) return - ! MultiTab call RegUnpack(Buf, OutData%MultiTab) if (RegCheckErr(Buf, RoutineName)) return - ! LinearizeFlag call RegUnpack(Buf, OutData%LinearizeFlag) if (RegCheckErr(Buf, RoutineName)) return - ! OutputPlottingInfo call RegUnpack(Buf, OutData%OutputPlottingInfo) if (RegCheckErr(Buf, RoutineName)) return - ! UseDWM call RegUnpack(Buf, OutData%UseDWM) if (RegCheckErr(Buf, RoutineName)) return - ! TwoPiNB call RegUnpack(Buf, OutData%TwoPiNB) if (RegCheckErr(Buf, RoutineName)) return - ! NumBl call RegUnpack(Buf, OutData%NumBl) if (RegCheckErr(Buf, RoutineName)) return - ! NBlInpSt call RegUnpack(Buf, OutData%NBlInpSt) if (RegCheckErr(Buf, RoutineName)) return - ! ElemPrn call RegUnpack(Buf, OutData%ElemPrn) if (RegCheckErr(Buf, RoutineName)) return - ! DStall call RegUnpack(Buf, OutData%DStall) if (RegCheckErr(Buf, RoutineName)) return - ! PMoment call RegUnpack(Buf, OutData%PMoment) if (RegCheckErr(Buf, RoutineName)) return - ! Reynolds call RegUnpack(Buf, OutData%Reynolds) if (RegCheckErr(Buf, RoutineName)) return - ! DynInfl call RegUnpack(Buf, OutData%DynInfl) if (RegCheckErr(Buf, RoutineName)) return - ! Wake call RegUnpack(Buf, OutData%Wake) if (RegCheckErr(Buf, RoutineName)) return - ! Swirl call RegUnpack(Buf, OutData%Swirl) if (RegCheckErr(Buf, RoutineName)) return - ! DtAero call RegUnpack(Buf, OutData%DtAero) if (RegCheckErr(Buf, RoutineName)) return - ! HubRad call RegUnpack(Buf, OutData%HubRad) if (RegCheckErr(Buf, RoutineName)) return - ! UnEc call RegUnpack(Buf, OutData%UnEc) if (RegCheckErr(Buf, RoutineName)) return - ! UnElem call RegUnpack(Buf, OutData%UnElem) if (RegCheckErr(Buf, RoutineName)) return - ! UnWndOut call RegUnpack(Buf, OutData%UnWndOut) if (RegCheckErr(Buf, RoutineName)) return - ! MAXICOUNT call RegUnpack(Buf, OutData%MAXICOUNT) if (RegCheckErr(Buf, RoutineName)) return - ! WrOptFile call RegUnpack(Buf, OutData%WrOptFile) if (RegCheckErr(Buf, RoutineName)) return - ! DEFAULT_Wind call RegUnpack(Buf, OutData%DEFAULT_Wind) if (RegCheckErr(Buf, RoutineName)) return - ! AirFoil call AD14_UnpackAirFoilParms(Buf, OutData%AirFoil) ! AirFoil - ! Blade call AD14_UnpackBladeParms(Buf, OutData%Blade) ! Blade - ! Beddoes call AD14_UnpackBeddoesParms(Buf, OutData%Beddoes) ! Beddoes - ! DynInflow call AD14_UnpackDynInflowParms(Buf, OutData%DynInflow) ! DynInflow - ! Element call AD14_UnpackElementParms(Buf, OutData%Element) ! Element - ! TwrProps call AD14_UnpackTwrPropsParms(Buf, OutData%TwrProps) ! TwrProps - ! InducedVel call AD14_UnpackInducedVelParms(Buf, OutData%InducedVel) ! InducedVel - ! Wind call AD14_UnpackWindParms(Buf, OutData%Wind) ! Wind - ! Rotor call AD14_UnpackRotorParms(Buf, OutData%Rotor) ! Rotor - ! DWM call DWM_UnpackParam(Buf, OutData%DWM) ! DWM end subroutine - SUBROUTINE AD14_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD14_InputType), INTENT(INOUT) :: SrcInputData - TYPE(AD14_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_CopyInput' -! + +subroutine AD14_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(AD14_InputType), intent(inout) :: SrcInputData + type(AD14_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD14_CopyInput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInputData%InputMarkers)) THEN - i1_l = LBOUND(SrcInputData%InputMarkers,1) - i1_u = UBOUND(SrcInputData%InputMarkers,1) - IF (.NOT. ALLOCATED(DstInputData%InputMarkers)) THEN - ALLOCATE(DstInputData%InputMarkers(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%InputMarkers.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputData%InputMarkers,1), UBOUND(SrcInputData%InputMarkers,1) - CALL MeshCopy( SrcInputData%InputMarkers(i1), DstInputData%InputMarkers(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL MeshCopy( SrcInputData%Twr_InputMarkers, DstInputData%Twr_InputMarkers, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_Copyaeroconfig( SrcInputData%TurbineComponents, DstInputData%TurbineComponents, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInputData%MulTabLoc)) THEN - i1_l = LBOUND(SrcInputData%MulTabLoc,1) - i1_u = UBOUND(SrcInputData%MulTabLoc,1) - i2_l = LBOUND(SrcInputData%MulTabLoc,2) - i2_u = UBOUND(SrcInputData%MulTabLoc,2) - IF (.NOT. ALLOCATED(DstInputData%MulTabLoc)) THEN - ALLOCATE(DstInputData%MulTabLoc(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%MulTabLoc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%MulTabLoc = SrcInputData%MulTabLoc -ENDIF -IF (ALLOCATED(SrcInputData%InflowVelocity)) THEN - i1_l = LBOUND(SrcInputData%InflowVelocity,1) - i1_u = UBOUND(SrcInputData%InflowVelocity,1) - i2_l = LBOUND(SrcInputData%InflowVelocity,2) - i2_u = UBOUND(SrcInputData%InflowVelocity,2) - IF (.NOT. ALLOCATED(DstInputData%InflowVelocity)) THEN - ALLOCATE(DstInputData%InflowVelocity(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%InflowVelocity.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%InflowVelocity = SrcInputData%InflowVelocity -ENDIF - DstInputData%AvgInfVel = SrcInputData%AvgInfVel - END SUBROUTINE AD14_CopyInput - - SUBROUTINE AD14_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(AD14_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputData%InputMarkers)) THEN -DO i1 = LBOUND(InputData%InputMarkers,1), UBOUND(InputData%InputMarkers,1) - CALL MeshDestroy( InputData%InputMarkers(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InputData%InputMarkers) -ENDIF - CALL MeshDestroy( InputData%Twr_InputMarkers, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyAeroConfig( InputData%TurbineComponents, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InputData%MulTabLoc)) THEN - DEALLOCATE(InputData%MulTabLoc) -ENDIF -IF (ALLOCATED(InputData%InflowVelocity)) THEN - DEALLOCATE(InputData%InflowVelocity) -ENDIF - END SUBROUTINE AD14_DestroyInput + ErrMsg = '' + if (allocated(SrcInputData%InputMarkers)) then + LB(1:1) = lbound(SrcInputData%InputMarkers) + UB(1:1) = ubound(SrcInputData%InputMarkers) + if (.not. allocated(DstInputData%InputMarkers)) then + allocate(DstInputData%InputMarkers(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%InputMarkers.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcInputData%InputMarkers(i1), DstInputData%InputMarkers(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstInputData%InputMarkers)) then + deallocate(DstInputData%InputMarkers) + end if + call MeshCopy(SrcInputData%Twr_InputMarkers, DstInputData%Twr_InputMarkers, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyAeroConfig(SrcInputData%TurbineComponents, DstInputData%TurbineComponents, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInputData%MulTabLoc)) then + LB(1:2) = lbound(SrcInputData%MulTabLoc) + UB(1:2) = ubound(SrcInputData%MulTabLoc) + if (.not. allocated(DstInputData%MulTabLoc)) then + allocate(DstInputData%MulTabLoc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%MulTabLoc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%MulTabLoc = SrcInputData%MulTabLoc + else if (allocated(DstInputData%MulTabLoc)) then + deallocate(DstInputData%MulTabLoc) + end if + if (allocated(SrcInputData%InflowVelocity)) then + LB(1:2) = lbound(SrcInputData%InflowVelocity) + UB(1:2) = ubound(SrcInputData%InflowVelocity) + if (.not. allocated(DstInputData%InflowVelocity)) then + allocate(DstInputData%InflowVelocity(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%InflowVelocity.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%InflowVelocity = SrcInputData%InflowVelocity + else if (allocated(DstInputData%InflowVelocity)) then + deallocate(DstInputData%InflowVelocity) + end if + DstInputData%AvgInfVel = SrcInputData%AvgInfVel +end subroutine +subroutine AD14_DestroyInput(InputData, ErrStat, ErrMsg) + type(AD14_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD14_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%InputMarkers)) then + LB(1:1) = lbound(InputData%InputMarkers) + UB(1:1) = ubound(InputData%InputMarkers) + do i1 = LB(1), UB(1) + call MeshDestroy( InputData%InputMarkers(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputData%InputMarkers) + end if + if (allocated(InputData%MulTabLoc)) then + deallocate(InputData%MulTabLoc) + end if + if (allocated(InputData%InflowVelocity)) then + deallocate(InputData%InflowVelocity) + end if +end subroutine subroutine AD14_PackInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -7630,7 +6713,6 @@ subroutine AD14_PackInput(Buf, Indata) integer(IntKi) :: i1, i2 integer(IntKi) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return - ! InputMarkers call RegPack(Buf, allocated(InData%InputMarkers)) if (allocated(InData%InputMarkers)) then call RegPackBounds(Buf, 1, lbound(InData%InputMarkers), ubound(InData%InputMarkers)) @@ -7641,27 +6723,22 @@ subroutine AD14_PackInput(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! Twr_InputMarkers call MeshPack(Buf, InData%Twr_InputMarkers) if (RegCheckErr(Buf, RoutineName)) return - ! TurbineComponents call AD14_PackAeroConfig(Buf, InData%TurbineComponents) if (RegCheckErr(Buf, RoutineName)) return - ! MulTabLoc call RegPack(Buf, allocated(InData%MulTabLoc)) if (allocated(InData%MulTabLoc)) then call RegPackBounds(Buf, 2, lbound(InData%MulTabLoc), ubound(InData%MulTabLoc)) call RegPack(Buf, InData%MulTabLoc) end if if (RegCheckErr(Buf, RoutineName)) return - ! InflowVelocity call RegPack(Buf, allocated(InData%InflowVelocity)) if (allocated(InData%InflowVelocity)) then call RegPackBounds(Buf, 2, lbound(InData%InflowVelocity), ubound(InData%InflowVelocity)) call RegPack(Buf, InData%InflowVelocity) end if if (RegCheckErr(Buf, RoutineName)) return - ! AvgInfVel call RegPack(Buf, InData%AvgInfVel) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -7675,7 +6752,6 @@ subroutine AD14_UnPackInput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! InputMarkers if (allocated(OutData%InputMarkers)) deallocate(OutData%InputMarkers) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7691,11 +6767,8 @@ subroutine AD14_UnPackInput(Buf, OutData) call MeshUnpack(Buf, OutData%InputMarkers(i1)) ! InputMarkers end do end if - ! Twr_InputMarkers call MeshUnpack(Buf, OutData%Twr_InputMarkers) ! Twr_InputMarkers - ! TurbineComponents call AD14_UnpackAeroConfig(Buf, OutData%TurbineComponents) ! TurbineComponents - ! MulTabLoc if (allocated(OutData%MulTabLoc)) deallocate(OutData%MulTabLoc) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7710,7 +6783,6 @@ subroutine AD14_UnPackInput(Buf, OutData) call RegUnpack(Buf, OutData%MulTabLoc) if (RegCheckErr(Buf, RoutineName)) return end if - ! InflowVelocity if (allocated(OutData%InflowVelocity)) deallocate(OutData%InflowVelocity) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7725,70 +6797,67 @@ subroutine AD14_UnPackInput(Buf, OutData) call RegUnpack(Buf, OutData%InflowVelocity) if (RegCheckErr(Buf, RoutineName)) return end if - ! AvgInfVel call RegUnpack(Buf, OutData%AvgInfVel) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE AD14_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AD14_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(AD14_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_CopyOutput' -! + +subroutine AD14_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(AD14_OutputType), intent(inout) :: SrcOutputData + type(AD14_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD14_CopyOutput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%OutputLoads)) THEN - i1_l = LBOUND(SrcOutputData%OutputLoads,1) - i1_u = UBOUND(SrcOutputData%OutputLoads,1) - IF (.NOT. ALLOCATED(DstOutputData%OutputLoads)) THEN - ALLOCATE(DstOutputData%OutputLoads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%OutputLoads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOutputData%OutputLoads,1), UBOUND(SrcOutputData%OutputLoads,1) - CALL MeshCopy( SrcOutputData%OutputLoads(i1), DstOutputData%OutputLoads(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL MeshCopy( SrcOutputData%Twr_OutputLoads, DstOutputData%Twr_OutputLoads, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AD14_CopyOutput - - SUBROUTINE AD14_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(AD14_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OutputData%OutputLoads)) THEN -DO i1 = LBOUND(OutputData%OutputLoads,1), UBOUND(OutputData%OutputLoads,1) - CALL MeshDestroy( OutputData%OutputLoads(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OutputData%OutputLoads) -ENDIF - CALL MeshDestroy( OutputData%Twr_OutputLoads, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AD14_DestroyOutput + ErrMsg = '' + if (allocated(SrcOutputData%OutputLoads)) then + LB(1:1) = lbound(SrcOutputData%OutputLoads) + UB(1:1) = ubound(SrcOutputData%OutputLoads) + if (.not. allocated(DstOutputData%OutputLoads)) then + allocate(DstOutputData%OutputLoads(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%OutputLoads.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcOutputData%OutputLoads(i1), DstOutputData%OutputLoads(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstOutputData%OutputLoads)) then + deallocate(DstOutputData%OutputLoads) + end if + call MeshCopy(SrcOutputData%Twr_OutputLoads, DstOutputData%Twr_OutputLoads, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine AD14_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(AD14_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD14_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%OutputLoads)) then + LB(1:1) = lbound(OutputData%OutputLoads) + UB(1:1) = ubound(OutputData%OutputLoads) + do i1 = LB(1), UB(1) + call MeshDestroy( OutputData%OutputLoads(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%OutputLoads) + end if +end subroutine subroutine AD14_PackOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -7797,7 +6866,6 @@ subroutine AD14_PackOutput(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! OutputLoads call RegPack(Buf, allocated(InData%OutputLoads)) if (allocated(InData%OutputLoads)) then call RegPackBounds(Buf, 1, lbound(InData%OutputLoads), ubound(InData%OutputLoads)) @@ -7808,7 +6876,6 @@ subroutine AD14_PackOutput(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! Twr_OutputLoads call MeshPack(Buf, InData%Twr_OutputLoads) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -7822,7 +6889,6 @@ subroutine AD14_UnPackOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! OutputLoads if (allocated(OutData%OutputLoads)) deallocate(OutData%OutputLoads) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7838,7 +6904,6 @@ subroutine AD14_UnPackOutput(Buf, OutData) call MeshUnpack(Buf, OutData%OutputLoads(i1)) ! OutputLoads end do end if - ! Twr_OutputLoads call MeshUnpack(Buf, OutData%Twr_OutputLoads) ! Twr_OutputLoads end subroutine diff --git a/modules/aerodyn14/src/DWM_Types.f90 b/modules/aerodyn14/src/DWM_Types.f90 index 03c0e18cc5..68e5f0cd53 100644 --- a/modules/aerodyn14/src/DWM_Types.f90 +++ b/modules/aerodyn14/src/DWM_Types.f90 @@ -326,53 +326,39 @@ MODULE DWM_Types END TYPE DWM_InitOutputType ! ======================= CONTAINS - SUBROUTINE DWM_CopyCVSD( SrcCVSDData, DstCVSDData, CtrlCode, ErrStat, ErrMsg ) - TYPE(CVSD), INTENT(IN) :: SrcCVSDData - TYPE(CVSD), INTENT(INOUT) :: DstCVSDData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_CopyCVSD' -! - ErrStat = ErrID_None - ErrMsg = "" - DstCVSDData%counter = SrcCVSDData%counter - DstCVSDData%Denominator = SrcCVSDData%Denominator - DstCVSDData%Numerator = SrcCVSDData%Numerator - END SUBROUTINE DWM_CopyCVSD - - SUBROUTINE DWM_DestroyCVSD( CVSDData, ErrStat, ErrMsg ) - TYPE(CVSD), INTENT(INOUT) :: CVSDData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyCVSD' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE DWM_DestroyCVSD +subroutine DWM_CopyCVSD(SrcCVSDData, DstCVSDData, CtrlCode, ErrStat, ErrMsg) + type(CVSD), intent(in) :: SrcCVSDData + type(CVSD), intent(inout) :: DstCVSDData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DWM_CopyCVSD' + ErrStat = ErrID_None + ErrMsg = '' + DstCVSDData%counter = SrcCVSDData%counter + DstCVSDData%Denominator = SrcCVSDData%Denominator + DstCVSDData%Numerator = SrcCVSDData%Numerator +end subroutine +subroutine DWM_DestroyCVSD(CVSDData, ErrStat, ErrMsg) + type(CVSD), intent(inout) :: CVSDData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DWM_DestroyCVSD' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine DWM_PackCVSD(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(CVSD), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_PackCVSD' if (Buf%ErrStat >= AbortErrLev) return - ! counter call RegPack(Buf, InData%counter) if (RegCheckErr(Buf, RoutineName)) return - ! Denominator call RegPack(Buf, InData%Denominator) if (RegCheckErr(Buf, RoutineName)) return - ! Numerator call RegPack(Buf, InData%Numerator) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -382,152 +368,140 @@ subroutine DWM_UnPackCVSD(Buf, OutData) type(CVSD), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPackCVSD' if (Buf%ErrStat /= ErrID_None) return - ! counter call RegUnpack(Buf, OutData%counter) if (RegCheckErr(Buf, RoutineName)) return - ! Denominator call RegUnpack(Buf, OutData%Denominator) if (RegCheckErr(Buf, RoutineName)) return - ! Numerator call RegUnpack(Buf, OutData%Numerator) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE DWM_Copyturbine_average_velocity_data( Srcturbine_average_velocity_dataData, Dstturbine_average_velocity_dataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(turbine_average_velocity_data), INTENT(IN) :: Srcturbine_average_velocity_dataData - TYPE(turbine_average_velocity_data), INTENT(INOUT) :: Dstturbine_average_velocity_dataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Copyturbine_average_velocity_data' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(Srcturbine_average_velocity_dataData%average_velocity_array_temp)) THEN - i1_l = LBOUND(Srcturbine_average_velocity_dataData%average_velocity_array_temp,1) - i1_u = UBOUND(Srcturbine_average_velocity_dataData%average_velocity_array_temp,1) - IF (.NOT. ALLOCATED(Dstturbine_average_velocity_dataData%average_velocity_array_temp)) THEN - ALLOCATE(Dstturbine_average_velocity_dataData%average_velocity_array_temp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstturbine_average_velocity_dataData%average_velocity_array_temp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstturbine_average_velocity_dataData%average_velocity_array_temp = Srcturbine_average_velocity_dataData%average_velocity_array_temp -ENDIF -IF (ALLOCATED(Srcturbine_average_velocity_dataData%average_velocity_array)) THEN - i1_l = LBOUND(Srcturbine_average_velocity_dataData%average_velocity_array,1) - i1_u = UBOUND(Srcturbine_average_velocity_dataData%average_velocity_array,1) - IF (.NOT. ALLOCATED(Dstturbine_average_velocity_dataData%average_velocity_array)) THEN - ALLOCATE(Dstturbine_average_velocity_dataData%average_velocity_array(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstturbine_average_velocity_dataData%average_velocity_array.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstturbine_average_velocity_dataData%average_velocity_array = Srcturbine_average_velocity_dataData%average_velocity_array -ENDIF -IF (ALLOCATED(Srcturbine_average_velocity_dataData%swept_area)) THEN - i1_l = LBOUND(Srcturbine_average_velocity_dataData%swept_area,1) - i1_u = UBOUND(Srcturbine_average_velocity_dataData%swept_area,1) - IF (.NOT. ALLOCATED(Dstturbine_average_velocity_dataData%swept_area)) THEN - ALLOCATE(Dstturbine_average_velocity_dataData%swept_area(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstturbine_average_velocity_dataData%swept_area.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstturbine_average_velocity_dataData%swept_area = Srcturbine_average_velocity_dataData%swept_area -ENDIF - Dstturbine_average_velocity_dataData%time_step_velocity = Srcturbine_average_velocity_dataData%time_step_velocity -IF (ALLOCATED(Srcturbine_average_velocity_dataData%time_step_velocity_array)) THEN - i1_l = LBOUND(Srcturbine_average_velocity_dataData%time_step_velocity_array,1) - i1_u = UBOUND(Srcturbine_average_velocity_dataData%time_step_velocity_array,1) - IF (.NOT. ALLOCATED(Dstturbine_average_velocity_dataData%time_step_velocity_array)) THEN - ALLOCATE(Dstturbine_average_velocity_dataData%time_step_velocity_array(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstturbine_average_velocity_dataData%time_step_velocity_array.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstturbine_average_velocity_dataData%time_step_velocity_array = Srcturbine_average_velocity_dataData%time_step_velocity_array -ENDIF - Dstturbine_average_velocity_dataData%time_step_pass_velocity = Srcturbine_average_velocity_dataData%time_step_pass_velocity - Dstturbine_average_velocity_dataData%time_step_force = Srcturbine_average_velocity_dataData%time_step_force - END SUBROUTINE DWM_Copyturbine_average_velocity_data - - SUBROUTINE DWM_Destroyturbine_average_velocity_data( turbine_average_velocity_dataData, ErrStat, ErrMsg ) - TYPE(turbine_average_velocity_data), INTENT(INOUT) :: turbine_average_velocity_dataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Destroyturbine_average_velocity_data' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(turbine_average_velocity_dataData%average_velocity_array_temp)) THEN - DEALLOCATE(turbine_average_velocity_dataData%average_velocity_array_temp) -ENDIF -IF (ALLOCATED(turbine_average_velocity_dataData%average_velocity_array)) THEN - DEALLOCATE(turbine_average_velocity_dataData%average_velocity_array) -ENDIF -IF (ALLOCATED(turbine_average_velocity_dataData%swept_area)) THEN - DEALLOCATE(turbine_average_velocity_dataData%swept_area) -ENDIF -IF (ALLOCATED(turbine_average_velocity_dataData%time_step_velocity_array)) THEN - DEALLOCATE(turbine_average_velocity_dataData%time_step_velocity_array) -ENDIF - END SUBROUTINE DWM_Destroyturbine_average_velocity_data +subroutine DWM_Copyturbine_average_velocity_data(Srcturbine_average_velocity_dataData, Dstturbine_average_velocity_dataData, CtrlCode, ErrStat, ErrMsg) + type(turbine_average_velocity_data), intent(in) :: Srcturbine_average_velocity_dataData + type(turbine_average_velocity_data), intent(inout) :: Dstturbine_average_velocity_dataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'DWM_Copyturbine_average_velocity_data' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(Srcturbine_average_velocity_dataData%average_velocity_array_temp)) then + LB(1:1) = lbound(Srcturbine_average_velocity_dataData%average_velocity_array_temp) + UB(1:1) = ubound(Srcturbine_average_velocity_dataData%average_velocity_array_temp) + if (.not. allocated(Dstturbine_average_velocity_dataData%average_velocity_array_temp)) then + allocate(Dstturbine_average_velocity_dataData%average_velocity_array_temp(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstturbine_average_velocity_dataData%average_velocity_array_temp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstturbine_average_velocity_dataData%average_velocity_array_temp = Srcturbine_average_velocity_dataData%average_velocity_array_temp + else if (allocated(Dstturbine_average_velocity_dataData%average_velocity_array_temp)) then + deallocate(Dstturbine_average_velocity_dataData%average_velocity_array_temp) + end if + if (allocated(Srcturbine_average_velocity_dataData%average_velocity_array)) then + LB(1:1) = lbound(Srcturbine_average_velocity_dataData%average_velocity_array) + UB(1:1) = ubound(Srcturbine_average_velocity_dataData%average_velocity_array) + if (.not. allocated(Dstturbine_average_velocity_dataData%average_velocity_array)) then + allocate(Dstturbine_average_velocity_dataData%average_velocity_array(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstturbine_average_velocity_dataData%average_velocity_array.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstturbine_average_velocity_dataData%average_velocity_array = Srcturbine_average_velocity_dataData%average_velocity_array + else if (allocated(Dstturbine_average_velocity_dataData%average_velocity_array)) then + deallocate(Dstturbine_average_velocity_dataData%average_velocity_array) + end if + if (allocated(Srcturbine_average_velocity_dataData%swept_area)) then + LB(1:1) = lbound(Srcturbine_average_velocity_dataData%swept_area) + UB(1:1) = ubound(Srcturbine_average_velocity_dataData%swept_area) + if (.not. allocated(Dstturbine_average_velocity_dataData%swept_area)) then + allocate(Dstturbine_average_velocity_dataData%swept_area(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstturbine_average_velocity_dataData%swept_area.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstturbine_average_velocity_dataData%swept_area = Srcturbine_average_velocity_dataData%swept_area + else if (allocated(Dstturbine_average_velocity_dataData%swept_area)) then + deallocate(Dstturbine_average_velocity_dataData%swept_area) + end if + Dstturbine_average_velocity_dataData%time_step_velocity = Srcturbine_average_velocity_dataData%time_step_velocity + if (allocated(Srcturbine_average_velocity_dataData%time_step_velocity_array)) then + LB(1:1) = lbound(Srcturbine_average_velocity_dataData%time_step_velocity_array) + UB(1:1) = ubound(Srcturbine_average_velocity_dataData%time_step_velocity_array) + if (.not. allocated(Dstturbine_average_velocity_dataData%time_step_velocity_array)) then + allocate(Dstturbine_average_velocity_dataData%time_step_velocity_array(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstturbine_average_velocity_dataData%time_step_velocity_array.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstturbine_average_velocity_dataData%time_step_velocity_array = Srcturbine_average_velocity_dataData%time_step_velocity_array + else if (allocated(Dstturbine_average_velocity_dataData%time_step_velocity_array)) then + deallocate(Dstturbine_average_velocity_dataData%time_step_velocity_array) + end if + Dstturbine_average_velocity_dataData%time_step_pass_velocity = Srcturbine_average_velocity_dataData%time_step_pass_velocity + Dstturbine_average_velocity_dataData%time_step_force = Srcturbine_average_velocity_dataData%time_step_force +end subroutine +subroutine DWM_Destroyturbine_average_velocity_data(turbine_average_velocity_dataData, ErrStat, ErrMsg) + type(turbine_average_velocity_data), intent(inout) :: turbine_average_velocity_dataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DWM_Destroyturbine_average_velocity_data' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(turbine_average_velocity_dataData%average_velocity_array_temp)) then + deallocate(turbine_average_velocity_dataData%average_velocity_array_temp) + end if + if (allocated(turbine_average_velocity_dataData%average_velocity_array)) then + deallocate(turbine_average_velocity_dataData%average_velocity_array) + end if + if (allocated(turbine_average_velocity_dataData%swept_area)) then + deallocate(turbine_average_velocity_dataData%swept_area) + end if + if (allocated(turbine_average_velocity_dataData%time_step_velocity_array)) then + deallocate(turbine_average_velocity_dataData%time_step_velocity_array) + end if +end subroutine subroutine DWM_Packturbine_average_velocity_data(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(turbine_average_velocity_data), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_Packturbine_average_velocity_data' if (Buf%ErrStat >= AbortErrLev) return - ! average_velocity_array_temp call RegPack(Buf, allocated(InData%average_velocity_array_temp)) if (allocated(InData%average_velocity_array_temp)) then call RegPackBounds(Buf, 1, lbound(InData%average_velocity_array_temp), ubound(InData%average_velocity_array_temp)) call RegPack(Buf, InData%average_velocity_array_temp) end if if (RegCheckErr(Buf, RoutineName)) return - ! average_velocity_array call RegPack(Buf, allocated(InData%average_velocity_array)) if (allocated(InData%average_velocity_array)) then call RegPackBounds(Buf, 1, lbound(InData%average_velocity_array), ubound(InData%average_velocity_array)) call RegPack(Buf, InData%average_velocity_array) end if if (RegCheckErr(Buf, RoutineName)) return - ! swept_area call RegPack(Buf, allocated(InData%swept_area)) if (allocated(InData%swept_area)) then call RegPackBounds(Buf, 1, lbound(InData%swept_area), ubound(InData%swept_area)) call RegPack(Buf, InData%swept_area) end if if (RegCheckErr(Buf, RoutineName)) return - ! time_step_velocity call RegPack(Buf, InData%time_step_velocity) if (RegCheckErr(Buf, RoutineName)) return - ! time_step_velocity_array call RegPack(Buf, allocated(InData%time_step_velocity_array)) if (allocated(InData%time_step_velocity_array)) then call RegPackBounds(Buf, 1, lbound(InData%time_step_velocity_array), ubound(InData%time_step_velocity_array)) call RegPack(Buf, InData%time_step_velocity_array) end if if (RegCheckErr(Buf, RoutineName)) return - ! time_step_pass_velocity call RegPack(Buf, InData%time_step_pass_velocity) if (RegCheckErr(Buf, RoutineName)) return - ! time_step_force call RegPack(Buf, InData%time_step_force) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -540,7 +514,6 @@ subroutine DWM_UnPackturbine_average_velocity_data(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! average_velocity_array_temp if (allocated(OutData%average_velocity_array_temp)) deallocate(OutData%average_velocity_array_temp) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -555,7 +528,6 @@ subroutine DWM_UnPackturbine_average_velocity_data(Buf, OutData) call RegUnpack(Buf, OutData%average_velocity_array_temp) if (RegCheckErr(Buf, RoutineName)) return end if - ! average_velocity_array if (allocated(OutData%average_velocity_array)) deallocate(OutData%average_velocity_array) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -570,7 +542,6 @@ subroutine DWM_UnPackturbine_average_velocity_data(Buf, OutData) call RegUnpack(Buf, OutData%average_velocity_array) if (RegCheckErr(Buf, RoutineName)) return end if - ! swept_area if (allocated(OutData%swept_area)) deallocate(OutData%swept_area) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -585,10 +556,8 @@ subroutine DWM_UnPackturbine_average_velocity_data(Buf, OutData) call RegUnpack(Buf, OutData%swept_area) if (RegCheckErr(Buf, RoutineName)) return end if - ! time_step_velocity call RegUnpack(Buf, OutData%time_step_velocity) if (RegCheckErr(Buf, RoutineName)) return - ! time_step_velocity_array if (allocated(OutData%time_step_velocity_array)) deallocate(OutData%time_step_velocity_array) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -603,94 +572,75 @@ subroutine DWM_UnPackturbine_average_velocity_data(Buf, OutData) call RegUnpack(Buf, OutData%time_step_velocity_array) if (RegCheckErr(Buf, RoutineName)) return end if - ! time_step_pass_velocity call RegUnpack(Buf, OutData%time_step_pass_velocity) if (RegCheckErr(Buf, RoutineName)) return - ! time_step_force call RegUnpack(Buf, OutData%time_step_force) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE DWM_CopyWake_Deficit_Data( SrcWake_Deficit_DataData, DstWake_Deficit_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DWM_Wake_Deficit_Data), INTENT(IN) :: SrcWake_Deficit_DataData - TYPE(DWM_Wake_Deficit_Data), INTENT(INOUT) :: DstWake_Deficit_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_CopyWake_Deficit_Data' -! - ErrStat = ErrID_None - ErrMsg = "" - DstWake_Deficit_DataData%np_x = SrcWake_Deficit_DataData%np_x - DstWake_Deficit_DataData%X_length = SrcWake_Deficit_DataData%X_length -IF (ALLOCATED(SrcWake_Deficit_DataData%Turb_Stress_DWM)) THEN - i1_l = LBOUND(SrcWake_Deficit_DataData%Turb_Stress_DWM,1) - i1_u = UBOUND(SrcWake_Deficit_DataData%Turb_Stress_DWM,1) - i2_l = LBOUND(SrcWake_Deficit_DataData%Turb_Stress_DWM,2) - i2_u = UBOUND(SrcWake_Deficit_DataData%Turb_Stress_DWM,2) - IF (.NOT. ALLOCATED(DstWake_Deficit_DataData%Turb_Stress_DWM)) THEN - ALLOCATE(DstWake_Deficit_DataData%Turb_Stress_DWM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWake_Deficit_DataData%Turb_Stress_DWM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWake_Deficit_DataData%Turb_Stress_DWM = SrcWake_Deficit_DataData%Turb_Stress_DWM -ENDIF - DstWake_Deficit_DataData%n_x_vector = SrcWake_Deficit_DataData%n_x_vector - DstWake_Deficit_DataData%n_r_vector = SrcWake_Deficit_DataData%n_r_vector - DstWake_Deficit_DataData%ppR = SrcWake_Deficit_DataData%ppR - END SUBROUTINE DWM_CopyWake_Deficit_Data - SUBROUTINE DWM_DestroyWake_Deficit_Data( Wake_Deficit_DataData, ErrStat, ErrMsg ) - TYPE(DWM_Wake_Deficit_Data), INTENT(INOUT) :: Wake_Deficit_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyWake_Deficit_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(Wake_Deficit_DataData%Turb_Stress_DWM)) THEN - DEALLOCATE(Wake_Deficit_DataData%Turb_Stress_DWM) -ENDIF - END SUBROUTINE DWM_DestroyWake_Deficit_Data +subroutine DWM_CopyWake_Deficit_Data(SrcWake_Deficit_DataData, DstWake_Deficit_DataData, CtrlCode, ErrStat, ErrMsg) + type(DWM_Wake_Deficit_Data), intent(in) :: SrcWake_Deficit_DataData + type(DWM_Wake_Deficit_Data), intent(inout) :: DstWake_Deficit_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'DWM_CopyWake_Deficit_Data' + ErrStat = ErrID_None + ErrMsg = '' + DstWake_Deficit_DataData%np_x = SrcWake_Deficit_DataData%np_x + DstWake_Deficit_DataData%X_length = SrcWake_Deficit_DataData%X_length + if (allocated(SrcWake_Deficit_DataData%Turb_Stress_DWM)) then + LB(1:2) = lbound(SrcWake_Deficit_DataData%Turb_Stress_DWM) + UB(1:2) = ubound(SrcWake_Deficit_DataData%Turb_Stress_DWM) + if (.not. allocated(DstWake_Deficit_DataData%Turb_Stress_DWM)) then + allocate(DstWake_Deficit_DataData%Turb_Stress_DWM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWake_Deficit_DataData%Turb_Stress_DWM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWake_Deficit_DataData%Turb_Stress_DWM = SrcWake_Deficit_DataData%Turb_Stress_DWM + else if (allocated(DstWake_Deficit_DataData%Turb_Stress_DWM)) then + deallocate(DstWake_Deficit_DataData%Turb_Stress_DWM) + end if + DstWake_Deficit_DataData%n_x_vector = SrcWake_Deficit_DataData%n_x_vector + DstWake_Deficit_DataData%n_r_vector = SrcWake_Deficit_DataData%n_r_vector + DstWake_Deficit_DataData%ppR = SrcWake_Deficit_DataData%ppR +end subroutine +subroutine DWM_DestroyWake_Deficit_Data(Wake_Deficit_DataData, ErrStat, ErrMsg) + type(DWM_Wake_Deficit_Data), intent(inout) :: Wake_Deficit_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DWM_DestroyWake_Deficit_Data' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(Wake_Deficit_DataData%Turb_Stress_DWM)) then + deallocate(Wake_Deficit_DataData%Turb_Stress_DWM) + end if +end subroutine subroutine DWM_PackWake_Deficit_Data(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(DWM_Wake_Deficit_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_PackWake_Deficit_Data' if (Buf%ErrStat >= AbortErrLev) return - ! np_x call RegPack(Buf, InData%np_x) if (RegCheckErr(Buf, RoutineName)) return - ! X_length call RegPack(Buf, InData%X_length) if (RegCheckErr(Buf, RoutineName)) return - ! Turb_Stress_DWM call RegPack(Buf, allocated(InData%Turb_Stress_DWM)) if (allocated(InData%Turb_Stress_DWM)) then call RegPackBounds(Buf, 2, lbound(InData%Turb_Stress_DWM), ubound(InData%Turb_Stress_DWM)) call RegPack(Buf, InData%Turb_Stress_DWM) end if if (RegCheckErr(Buf, RoutineName)) return - ! n_x_vector call RegPack(Buf, InData%n_x_vector) if (RegCheckErr(Buf, RoutineName)) return - ! n_r_vector call RegPack(Buf, InData%n_r_vector) if (RegCheckErr(Buf, RoutineName)) return - ! ppR call RegPack(Buf, InData%ppR) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -703,13 +653,10 @@ subroutine DWM_UnPackWake_Deficit_Data(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! np_x call RegUnpack(Buf, OutData%np_x) if (RegCheckErr(Buf, RoutineName)) return - ! X_length call RegUnpack(Buf, OutData%X_length) if (RegCheckErr(Buf, RoutineName)) return - ! Turb_Stress_DWM if (allocated(OutData%Turb_Stress_DWM)) deallocate(OutData%Turb_Stress_DWM) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -724,59 +671,43 @@ subroutine DWM_UnPackWake_Deficit_Data(Buf, OutData) call RegUnpack(Buf, OutData%Turb_Stress_DWM) if (RegCheckErr(Buf, RoutineName)) return end if - ! n_x_vector call RegUnpack(Buf, OutData%n_x_vector) if (RegCheckErr(Buf, RoutineName)) return - ! n_r_vector call RegUnpack(Buf, OutData%n_r_vector) if (RegCheckErr(Buf, RoutineName)) return - ! ppR call RegUnpack(Buf, OutData%ppR) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE DWM_CopyMeanderData( SrcMeanderDataData, DstMeanderDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MeanderData), INTENT(IN) :: SrcMeanderDataData - TYPE(MeanderData), INTENT(INOUT) :: DstMeanderDataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_CopyMeanderData' -! - ErrStat = ErrID_None - ErrMsg = "" - DstMeanderDataData%scale_factor = SrcMeanderDataData%scale_factor - DstMeanderDataData%moving_time = SrcMeanderDataData%moving_time - END SUBROUTINE DWM_CopyMeanderData - SUBROUTINE DWM_DestroyMeanderData( MeanderDataData, ErrStat, ErrMsg ) - TYPE(MeanderData), INTENT(INOUT) :: MeanderDataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyMeanderData' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE DWM_DestroyMeanderData +subroutine DWM_CopyMeanderData(SrcMeanderDataData, DstMeanderDataData, CtrlCode, ErrStat, ErrMsg) + type(MeanderData), intent(in) :: SrcMeanderDataData + type(MeanderData), intent(inout) :: DstMeanderDataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DWM_CopyMeanderData' + ErrStat = ErrID_None + ErrMsg = '' + DstMeanderDataData%scale_factor = SrcMeanderDataData%scale_factor + DstMeanderDataData%moving_time = SrcMeanderDataData%moving_time +end subroutine +subroutine DWM_DestroyMeanderData(MeanderDataData, ErrStat, ErrMsg) + type(MeanderData), intent(inout) :: MeanderDataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DWM_DestroyMeanderData' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine DWM_PackMeanderData(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(MeanderData), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_PackMeanderData' if (Buf%ErrStat >= AbortErrLev) return - ! scale_factor call RegPack(Buf, InData%scale_factor) if (RegCheckErr(Buf, RoutineName)) return - ! moving_time call RegPack(Buf, InData%moving_time) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -786,418 +717,413 @@ subroutine DWM_UnPackMeanderData(Buf, OutData) type(MeanderData), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPackMeanderData' if (Buf%ErrStat /= ErrID_None) return - ! scale_factor call RegUnpack(Buf, OutData%scale_factor) if (RegCheckErr(Buf, RoutineName)) return - ! moving_time call RegUnpack(Buf, OutData%moving_time) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE DWM_Copyread_turbine_position_data( Srcread_turbine_position_dataData, Dstread_turbine_position_dataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(read_turbine_position_data), INTENT(IN) :: Srcread_turbine_position_dataData - TYPE(read_turbine_position_data), INTENT(INOUT) :: Dstread_turbine_position_dataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Copyread_turbine_position_data' -! - ErrStat = ErrID_None - ErrMsg = "" - Dstread_turbine_position_dataData%SimulationOrder_index = Srcread_turbine_position_dataData%SimulationOrder_index -IF (ALLOCATED(Srcread_turbine_position_dataData%Turbine_sort_order)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%Turbine_sort_order,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%Turbine_sort_order,1) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%Turbine_sort_order)) THEN - ALLOCATE(Dstread_turbine_position_dataData%Turbine_sort_order(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%Turbine_sort_order.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%Turbine_sort_order = Srcread_turbine_position_dataData%Turbine_sort_order -ENDIF - Dstread_turbine_position_dataData%WT_index = Srcread_turbine_position_dataData%WT_index -IF (ALLOCATED(Srcread_turbine_position_dataData%TurbineInfluenceData)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%TurbineInfluenceData,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%TurbineInfluenceData,1) - i2_l = LBOUND(Srcread_turbine_position_dataData%TurbineInfluenceData,2) - i2_u = UBOUND(Srcread_turbine_position_dataData%TurbineInfluenceData,2) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%TurbineInfluenceData)) THEN - ALLOCATE(Dstread_turbine_position_dataData%TurbineInfluenceData(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%TurbineInfluenceData.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%TurbineInfluenceData = Srcread_turbine_position_dataData%TurbineInfluenceData -ENDIF -IF (ALLOCATED(Srcread_turbine_position_dataData%upwind_turbine_index)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%upwind_turbine_index,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%upwind_turbine_index,1) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%upwind_turbine_index)) THEN - ALLOCATE(Dstread_turbine_position_dataData%upwind_turbine_index(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%upwind_turbine_index.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%upwind_turbine_index = Srcread_turbine_position_dataData%upwind_turbine_index -ENDIF -IF (ALLOCATED(Srcread_turbine_position_dataData%downwind_turbine_index)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%downwind_turbine_index,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%downwind_turbine_index,1) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%downwind_turbine_index)) THEN - ALLOCATE(Dstread_turbine_position_dataData%downwind_turbine_index(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%downwind_turbine_index.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%downwind_turbine_index = Srcread_turbine_position_dataData%downwind_turbine_index -ENDIF - Dstread_turbine_position_dataData%upwindturbine_number = Srcread_turbine_position_dataData%upwindturbine_number - Dstread_turbine_position_dataData%downwindturbine_number = Srcread_turbine_position_dataData%downwindturbine_number -IF (ALLOCATED(Srcread_turbine_position_dataData%turbine_windorigin_length)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%turbine_windorigin_length,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%turbine_windorigin_length,1) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%turbine_windorigin_length)) THEN - ALLOCATE(Dstread_turbine_position_dataData%turbine_windorigin_length(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%turbine_windorigin_length.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%turbine_windorigin_length = Srcread_turbine_position_dataData%turbine_windorigin_length -ENDIF -IF (ALLOCATED(Srcread_turbine_position_dataData%upwind_turbine_projected_distance)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%upwind_turbine_projected_distance,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%upwind_turbine_projected_distance,1) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%upwind_turbine_projected_distance)) THEN - ALLOCATE(Dstread_turbine_position_dataData%upwind_turbine_projected_distance(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%upwind_turbine_projected_distance.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%upwind_turbine_projected_distance = Srcread_turbine_position_dataData%upwind_turbine_projected_distance -ENDIF -IF (ALLOCATED(Srcread_turbine_position_dataData%downwind_turbine_projected_distance)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%downwind_turbine_projected_distance,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%downwind_turbine_projected_distance,1) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%downwind_turbine_projected_distance)) THEN - ALLOCATE(Dstread_turbine_position_dataData%downwind_turbine_projected_distance(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%downwind_turbine_projected_distance.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%downwind_turbine_projected_distance = Srcread_turbine_position_dataData%downwind_turbine_projected_distance -ENDIF -IF (ALLOCATED(Srcread_turbine_position_dataData%turbine_angle)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%turbine_angle,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%turbine_angle,1) - i2_l = LBOUND(Srcread_turbine_position_dataData%turbine_angle,2) - i2_u = UBOUND(Srcread_turbine_position_dataData%turbine_angle,2) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%turbine_angle)) THEN - ALLOCATE(Dstread_turbine_position_dataData%turbine_angle(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%turbine_angle.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%turbine_angle = Srcread_turbine_position_dataData%turbine_angle -ENDIF -IF (ALLOCATED(Srcread_turbine_position_dataData%upwind_align_angle)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%upwind_align_angle,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%upwind_align_angle,1) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%upwind_align_angle)) THEN - ALLOCATE(Dstread_turbine_position_dataData%upwind_align_angle(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%upwind_align_angle.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%upwind_align_angle = Srcread_turbine_position_dataData%upwind_align_angle -ENDIF -IF (ALLOCATED(Srcread_turbine_position_dataData%downwind_align_angle)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%downwind_align_angle,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%downwind_align_angle,1) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%downwind_align_angle)) THEN - ALLOCATE(Dstread_turbine_position_dataData%downwind_align_angle(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%downwind_align_angle.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%downwind_align_angle = Srcread_turbine_position_dataData%downwind_align_angle -ENDIF -IF (ALLOCATED(Srcread_turbine_position_dataData%upwind_turbine_Xcoor)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%upwind_turbine_Xcoor,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%upwind_turbine_Xcoor,1) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%upwind_turbine_Xcoor)) THEN - ALLOCATE(Dstread_turbine_position_dataData%upwind_turbine_Xcoor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%upwind_turbine_Xcoor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%upwind_turbine_Xcoor = Srcread_turbine_position_dataData%upwind_turbine_Xcoor -ENDIF -IF (ALLOCATED(Srcread_turbine_position_dataData%upwind_turbine_Ycoor)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%upwind_turbine_Ycoor,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%upwind_turbine_Ycoor,1) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%upwind_turbine_Ycoor)) THEN - ALLOCATE(Dstread_turbine_position_dataData%upwind_turbine_Ycoor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%upwind_turbine_Ycoor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%upwind_turbine_Ycoor = Srcread_turbine_position_dataData%upwind_turbine_Ycoor -ENDIF -IF (ALLOCATED(Srcread_turbine_position_dataData%wind_farm_Xcoor)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%wind_farm_Xcoor,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%wind_farm_Xcoor,1) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%wind_farm_Xcoor)) THEN - ALLOCATE(Dstread_turbine_position_dataData%wind_farm_Xcoor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%wind_farm_Xcoor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%wind_farm_Xcoor = Srcread_turbine_position_dataData%wind_farm_Xcoor -ENDIF -IF (ALLOCATED(Srcread_turbine_position_dataData%wind_farm_Ycoor)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%wind_farm_Ycoor,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%wind_farm_Ycoor,1) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%wind_farm_Ycoor)) THEN - ALLOCATE(Dstread_turbine_position_dataData%wind_farm_Ycoor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%wind_farm_Ycoor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%wind_farm_Ycoor = Srcread_turbine_position_dataData%wind_farm_Ycoor -ENDIF -IF (ALLOCATED(Srcread_turbine_position_dataData%downwind_turbine_Xcoor)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%downwind_turbine_Xcoor,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%downwind_turbine_Xcoor,1) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%downwind_turbine_Xcoor)) THEN - ALLOCATE(Dstread_turbine_position_dataData%downwind_turbine_Xcoor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%downwind_turbine_Xcoor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%downwind_turbine_Xcoor = Srcread_turbine_position_dataData%downwind_turbine_Xcoor -ENDIF -IF (ALLOCATED(Srcread_turbine_position_dataData%downwind_turbine_Ycoor)) THEN - i1_l = LBOUND(Srcread_turbine_position_dataData%downwind_turbine_Ycoor,1) - i1_u = UBOUND(Srcread_turbine_position_dataData%downwind_turbine_Ycoor,1) - IF (.NOT. ALLOCATED(Dstread_turbine_position_dataData%downwind_turbine_Ycoor)) THEN - ALLOCATE(Dstread_turbine_position_dataData%downwind_turbine_Ycoor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%downwind_turbine_Ycoor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_turbine_position_dataData%downwind_turbine_Ycoor = Srcread_turbine_position_dataData%downwind_turbine_Ycoor -ENDIF - END SUBROUTINE DWM_Copyread_turbine_position_data - - SUBROUTINE DWM_Destroyread_turbine_position_data( read_turbine_position_dataData, ErrStat, ErrMsg ) - TYPE(read_turbine_position_data), INTENT(INOUT) :: read_turbine_position_dataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Destroyread_turbine_position_data' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(read_turbine_position_dataData%Turbine_sort_order)) THEN - DEALLOCATE(read_turbine_position_dataData%Turbine_sort_order) -ENDIF -IF (ALLOCATED(read_turbine_position_dataData%TurbineInfluenceData)) THEN - DEALLOCATE(read_turbine_position_dataData%TurbineInfluenceData) -ENDIF -IF (ALLOCATED(read_turbine_position_dataData%upwind_turbine_index)) THEN - DEALLOCATE(read_turbine_position_dataData%upwind_turbine_index) -ENDIF -IF (ALLOCATED(read_turbine_position_dataData%downwind_turbine_index)) THEN - DEALLOCATE(read_turbine_position_dataData%downwind_turbine_index) -ENDIF -IF (ALLOCATED(read_turbine_position_dataData%turbine_windorigin_length)) THEN - DEALLOCATE(read_turbine_position_dataData%turbine_windorigin_length) -ENDIF -IF (ALLOCATED(read_turbine_position_dataData%upwind_turbine_projected_distance)) THEN - DEALLOCATE(read_turbine_position_dataData%upwind_turbine_projected_distance) -ENDIF -IF (ALLOCATED(read_turbine_position_dataData%downwind_turbine_projected_distance)) THEN - DEALLOCATE(read_turbine_position_dataData%downwind_turbine_projected_distance) -ENDIF -IF (ALLOCATED(read_turbine_position_dataData%turbine_angle)) THEN - DEALLOCATE(read_turbine_position_dataData%turbine_angle) -ENDIF -IF (ALLOCATED(read_turbine_position_dataData%upwind_align_angle)) THEN - DEALLOCATE(read_turbine_position_dataData%upwind_align_angle) -ENDIF -IF (ALLOCATED(read_turbine_position_dataData%downwind_align_angle)) THEN - DEALLOCATE(read_turbine_position_dataData%downwind_align_angle) -ENDIF -IF (ALLOCATED(read_turbine_position_dataData%upwind_turbine_Xcoor)) THEN - DEALLOCATE(read_turbine_position_dataData%upwind_turbine_Xcoor) -ENDIF -IF (ALLOCATED(read_turbine_position_dataData%upwind_turbine_Ycoor)) THEN - DEALLOCATE(read_turbine_position_dataData%upwind_turbine_Ycoor) -ENDIF -IF (ALLOCATED(read_turbine_position_dataData%wind_farm_Xcoor)) THEN - DEALLOCATE(read_turbine_position_dataData%wind_farm_Xcoor) -ENDIF -IF (ALLOCATED(read_turbine_position_dataData%wind_farm_Ycoor)) THEN - DEALLOCATE(read_turbine_position_dataData%wind_farm_Ycoor) -ENDIF -IF (ALLOCATED(read_turbine_position_dataData%downwind_turbine_Xcoor)) THEN - DEALLOCATE(read_turbine_position_dataData%downwind_turbine_Xcoor) -ENDIF -IF (ALLOCATED(read_turbine_position_dataData%downwind_turbine_Ycoor)) THEN - DEALLOCATE(read_turbine_position_dataData%downwind_turbine_Ycoor) -ENDIF - END SUBROUTINE DWM_Destroyread_turbine_position_data +subroutine DWM_Copyread_turbine_position_data(Srcread_turbine_position_dataData, Dstread_turbine_position_dataData, CtrlCode, ErrStat, ErrMsg) + type(read_turbine_position_data), intent(in) :: Srcread_turbine_position_dataData + type(read_turbine_position_data), intent(inout) :: Dstread_turbine_position_dataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'DWM_Copyread_turbine_position_data' + ErrStat = ErrID_None + ErrMsg = '' + Dstread_turbine_position_dataData%SimulationOrder_index = Srcread_turbine_position_dataData%SimulationOrder_index + if (allocated(Srcread_turbine_position_dataData%Turbine_sort_order)) then + LB(1:1) = lbound(Srcread_turbine_position_dataData%Turbine_sort_order) + UB(1:1) = ubound(Srcread_turbine_position_dataData%Turbine_sort_order) + if (.not. allocated(Dstread_turbine_position_dataData%Turbine_sort_order)) then + allocate(Dstread_turbine_position_dataData%Turbine_sort_order(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%Turbine_sort_order.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_turbine_position_dataData%Turbine_sort_order = Srcread_turbine_position_dataData%Turbine_sort_order + else if (allocated(Dstread_turbine_position_dataData%Turbine_sort_order)) then + deallocate(Dstread_turbine_position_dataData%Turbine_sort_order) + end if + Dstread_turbine_position_dataData%WT_index = Srcread_turbine_position_dataData%WT_index + if (allocated(Srcread_turbine_position_dataData%TurbineInfluenceData)) then + LB(1:2) = lbound(Srcread_turbine_position_dataData%TurbineInfluenceData) + UB(1:2) = ubound(Srcread_turbine_position_dataData%TurbineInfluenceData) + if (.not. allocated(Dstread_turbine_position_dataData%TurbineInfluenceData)) then + allocate(Dstread_turbine_position_dataData%TurbineInfluenceData(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%TurbineInfluenceData.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_turbine_position_dataData%TurbineInfluenceData = Srcread_turbine_position_dataData%TurbineInfluenceData + else if (allocated(Dstread_turbine_position_dataData%TurbineInfluenceData)) then + deallocate(Dstread_turbine_position_dataData%TurbineInfluenceData) + end if + if (allocated(Srcread_turbine_position_dataData%upwind_turbine_index)) then + LB(1:1) = lbound(Srcread_turbine_position_dataData%upwind_turbine_index) + UB(1:1) = ubound(Srcread_turbine_position_dataData%upwind_turbine_index) + if (.not. allocated(Dstread_turbine_position_dataData%upwind_turbine_index)) then + allocate(Dstread_turbine_position_dataData%upwind_turbine_index(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%upwind_turbine_index.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_turbine_position_dataData%upwind_turbine_index = Srcread_turbine_position_dataData%upwind_turbine_index + else if (allocated(Dstread_turbine_position_dataData%upwind_turbine_index)) then + deallocate(Dstread_turbine_position_dataData%upwind_turbine_index) + end if + if (allocated(Srcread_turbine_position_dataData%downwind_turbine_index)) then + LB(1:1) = lbound(Srcread_turbine_position_dataData%downwind_turbine_index) + UB(1:1) = ubound(Srcread_turbine_position_dataData%downwind_turbine_index) + if (.not. allocated(Dstread_turbine_position_dataData%downwind_turbine_index)) then + allocate(Dstread_turbine_position_dataData%downwind_turbine_index(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%downwind_turbine_index.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_turbine_position_dataData%downwind_turbine_index = Srcread_turbine_position_dataData%downwind_turbine_index + else if (allocated(Dstread_turbine_position_dataData%downwind_turbine_index)) then + deallocate(Dstread_turbine_position_dataData%downwind_turbine_index) + end if + Dstread_turbine_position_dataData%upwindturbine_number = Srcread_turbine_position_dataData%upwindturbine_number + Dstread_turbine_position_dataData%downwindturbine_number = Srcread_turbine_position_dataData%downwindturbine_number + if (allocated(Srcread_turbine_position_dataData%turbine_windorigin_length)) then + LB(1:1) = lbound(Srcread_turbine_position_dataData%turbine_windorigin_length) + UB(1:1) = ubound(Srcread_turbine_position_dataData%turbine_windorigin_length) + if (.not. allocated(Dstread_turbine_position_dataData%turbine_windorigin_length)) then + allocate(Dstread_turbine_position_dataData%turbine_windorigin_length(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%turbine_windorigin_length.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_turbine_position_dataData%turbine_windorigin_length = Srcread_turbine_position_dataData%turbine_windorigin_length + else if (allocated(Dstread_turbine_position_dataData%turbine_windorigin_length)) then + deallocate(Dstread_turbine_position_dataData%turbine_windorigin_length) + end if + if (allocated(Srcread_turbine_position_dataData%upwind_turbine_projected_distance)) then + LB(1:1) = lbound(Srcread_turbine_position_dataData%upwind_turbine_projected_distance) + UB(1:1) = ubound(Srcread_turbine_position_dataData%upwind_turbine_projected_distance) + if (.not. allocated(Dstread_turbine_position_dataData%upwind_turbine_projected_distance)) then + allocate(Dstread_turbine_position_dataData%upwind_turbine_projected_distance(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%upwind_turbine_projected_distance.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_turbine_position_dataData%upwind_turbine_projected_distance = Srcread_turbine_position_dataData%upwind_turbine_projected_distance + else if (allocated(Dstread_turbine_position_dataData%upwind_turbine_projected_distance)) then + deallocate(Dstread_turbine_position_dataData%upwind_turbine_projected_distance) + end if + if (allocated(Srcread_turbine_position_dataData%downwind_turbine_projected_distance)) then + LB(1:1) = lbound(Srcread_turbine_position_dataData%downwind_turbine_projected_distance) + UB(1:1) = ubound(Srcread_turbine_position_dataData%downwind_turbine_projected_distance) + if (.not. allocated(Dstread_turbine_position_dataData%downwind_turbine_projected_distance)) then + allocate(Dstread_turbine_position_dataData%downwind_turbine_projected_distance(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%downwind_turbine_projected_distance.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_turbine_position_dataData%downwind_turbine_projected_distance = Srcread_turbine_position_dataData%downwind_turbine_projected_distance + else if (allocated(Dstread_turbine_position_dataData%downwind_turbine_projected_distance)) then + deallocate(Dstread_turbine_position_dataData%downwind_turbine_projected_distance) + end if + if (allocated(Srcread_turbine_position_dataData%turbine_angle)) then + LB(1:2) = lbound(Srcread_turbine_position_dataData%turbine_angle) + UB(1:2) = ubound(Srcread_turbine_position_dataData%turbine_angle) + if (.not. allocated(Dstread_turbine_position_dataData%turbine_angle)) then + allocate(Dstread_turbine_position_dataData%turbine_angle(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%turbine_angle.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_turbine_position_dataData%turbine_angle = Srcread_turbine_position_dataData%turbine_angle + else if (allocated(Dstread_turbine_position_dataData%turbine_angle)) then + deallocate(Dstread_turbine_position_dataData%turbine_angle) + end if + if (allocated(Srcread_turbine_position_dataData%upwind_align_angle)) then + LB(1:1) = lbound(Srcread_turbine_position_dataData%upwind_align_angle) + UB(1:1) = ubound(Srcread_turbine_position_dataData%upwind_align_angle) + if (.not. allocated(Dstread_turbine_position_dataData%upwind_align_angle)) then + allocate(Dstread_turbine_position_dataData%upwind_align_angle(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%upwind_align_angle.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_turbine_position_dataData%upwind_align_angle = Srcread_turbine_position_dataData%upwind_align_angle + else if (allocated(Dstread_turbine_position_dataData%upwind_align_angle)) then + deallocate(Dstread_turbine_position_dataData%upwind_align_angle) + end if + if (allocated(Srcread_turbine_position_dataData%downwind_align_angle)) then + LB(1:1) = lbound(Srcread_turbine_position_dataData%downwind_align_angle) + UB(1:1) = ubound(Srcread_turbine_position_dataData%downwind_align_angle) + if (.not. allocated(Dstread_turbine_position_dataData%downwind_align_angle)) then + allocate(Dstread_turbine_position_dataData%downwind_align_angle(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%downwind_align_angle.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_turbine_position_dataData%downwind_align_angle = Srcread_turbine_position_dataData%downwind_align_angle + else if (allocated(Dstread_turbine_position_dataData%downwind_align_angle)) then + deallocate(Dstread_turbine_position_dataData%downwind_align_angle) + end if + if (allocated(Srcread_turbine_position_dataData%upwind_turbine_Xcoor)) then + LB(1:1) = lbound(Srcread_turbine_position_dataData%upwind_turbine_Xcoor) + UB(1:1) = ubound(Srcread_turbine_position_dataData%upwind_turbine_Xcoor) + if (.not. allocated(Dstread_turbine_position_dataData%upwind_turbine_Xcoor)) then + allocate(Dstread_turbine_position_dataData%upwind_turbine_Xcoor(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%upwind_turbine_Xcoor.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_turbine_position_dataData%upwind_turbine_Xcoor = Srcread_turbine_position_dataData%upwind_turbine_Xcoor + else if (allocated(Dstread_turbine_position_dataData%upwind_turbine_Xcoor)) then + deallocate(Dstread_turbine_position_dataData%upwind_turbine_Xcoor) + end if + if (allocated(Srcread_turbine_position_dataData%upwind_turbine_Ycoor)) then + LB(1:1) = lbound(Srcread_turbine_position_dataData%upwind_turbine_Ycoor) + UB(1:1) = ubound(Srcread_turbine_position_dataData%upwind_turbine_Ycoor) + if (.not. allocated(Dstread_turbine_position_dataData%upwind_turbine_Ycoor)) then + allocate(Dstread_turbine_position_dataData%upwind_turbine_Ycoor(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%upwind_turbine_Ycoor.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_turbine_position_dataData%upwind_turbine_Ycoor = Srcread_turbine_position_dataData%upwind_turbine_Ycoor + else if (allocated(Dstread_turbine_position_dataData%upwind_turbine_Ycoor)) then + deallocate(Dstread_turbine_position_dataData%upwind_turbine_Ycoor) + end if + if (allocated(Srcread_turbine_position_dataData%wind_farm_Xcoor)) then + LB(1:1) = lbound(Srcread_turbine_position_dataData%wind_farm_Xcoor) + UB(1:1) = ubound(Srcread_turbine_position_dataData%wind_farm_Xcoor) + if (.not. allocated(Dstread_turbine_position_dataData%wind_farm_Xcoor)) then + allocate(Dstread_turbine_position_dataData%wind_farm_Xcoor(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%wind_farm_Xcoor.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_turbine_position_dataData%wind_farm_Xcoor = Srcread_turbine_position_dataData%wind_farm_Xcoor + else if (allocated(Dstread_turbine_position_dataData%wind_farm_Xcoor)) then + deallocate(Dstread_turbine_position_dataData%wind_farm_Xcoor) + end if + if (allocated(Srcread_turbine_position_dataData%wind_farm_Ycoor)) then + LB(1:1) = lbound(Srcread_turbine_position_dataData%wind_farm_Ycoor) + UB(1:1) = ubound(Srcread_turbine_position_dataData%wind_farm_Ycoor) + if (.not. allocated(Dstread_turbine_position_dataData%wind_farm_Ycoor)) then + allocate(Dstread_turbine_position_dataData%wind_farm_Ycoor(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%wind_farm_Ycoor.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_turbine_position_dataData%wind_farm_Ycoor = Srcread_turbine_position_dataData%wind_farm_Ycoor + else if (allocated(Dstread_turbine_position_dataData%wind_farm_Ycoor)) then + deallocate(Dstread_turbine_position_dataData%wind_farm_Ycoor) + end if + if (allocated(Srcread_turbine_position_dataData%downwind_turbine_Xcoor)) then + LB(1:1) = lbound(Srcread_turbine_position_dataData%downwind_turbine_Xcoor) + UB(1:1) = ubound(Srcread_turbine_position_dataData%downwind_turbine_Xcoor) + if (.not. allocated(Dstread_turbine_position_dataData%downwind_turbine_Xcoor)) then + allocate(Dstread_turbine_position_dataData%downwind_turbine_Xcoor(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%downwind_turbine_Xcoor.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_turbine_position_dataData%downwind_turbine_Xcoor = Srcread_turbine_position_dataData%downwind_turbine_Xcoor + else if (allocated(Dstread_turbine_position_dataData%downwind_turbine_Xcoor)) then + deallocate(Dstread_turbine_position_dataData%downwind_turbine_Xcoor) + end if + if (allocated(Srcread_turbine_position_dataData%downwind_turbine_Ycoor)) then + LB(1:1) = lbound(Srcread_turbine_position_dataData%downwind_turbine_Ycoor) + UB(1:1) = ubound(Srcread_turbine_position_dataData%downwind_turbine_Ycoor) + if (.not. allocated(Dstread_turbine_position_dataData%downwind_turbine_Ycoor)) then + allocate(Dstread_turbine_position_dataData%downwind_turbine_Ycoor(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_turbine_position_dataData%downwind_turbine_Ycoor.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_turbine_position_dataData%downwind_turbine_Ycoor = Srcread_turbine_position_dataData%downwind_turbine_Ycoor + else if (allocated(Dstread_turbine_position_dataData%downwind_turbine_Ycoor)) then + deallocate(Dstread_turbine_position_dataData%downwind_turbine_Ycoor) + end if +end subroutine +subroutine DWM_Destroyread_turbine_position_data(read_turbine_position_dataData, ErrStat, ErrMsg) + type(read_turbine_position_data), intent(inout) :: read_turbine_position_dataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DWM_Destroyread_turbine_position_data' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(read_turbine_position_dataData%Turbine_sort_order)) then + deallocate(read_turbine_position_dataData%Turbine_sort_order) + end if + if (allocated(read_turbine_position_dataData%TurbineInfluenceData)) then + deallocate(read_turbine_position_dataData%TurbineInfluenceData) + end if + if (allocated(read_turbine_position_dataData%upwind_turbine_index)) then + deallocate(read_turbine_position_dataData%upwind_turbine_index) + end if + if (allocated(read_turbine_position_dataData%downwind_turbine_index)) then + deallocate(read_turbine_position_dataData%downwind_turbine_index) + end if + if (allocated(read_turbine_position_dataData%turbine_windorigin_length)) then + deallocate(read_turbine_position_dataData%turbine_windorigin_length) + end if + if (allocated(read_turbine_position_dataData%upwind_turbine_projected_distance)) then + deallocate(read_turbine_position_dataData%upwind_turbine_projected_distance) + end if + if (allocated(read_turbine_position_dataData%downwind_turbine_projected_distance)) then + deallocate(read_turbine_position_dataData%downwind_turbine_projected_distance) + end if + if (allocated(read_turbine_position_dataData%turbine_angle)) then + deallocate(read_turbine_position_dataData%turbine_angle) + end if + if (allocated(read_turbine_position_dataData%upwind_align_angle)) then + deallocate(read_turbine_position_dataData%upwind_align_angle) + end if + if (allocated(read_turbine_position_dataData%downwind_align_angle)) then + deallocate(read_turbine_position_dataData%downwind_align_angle) + end if + if (allocated(read_turbine_position_dataData%upwind_turbine_Xcoor)) then + deallocate(read_turbine_position_dataData%upwind_turbine_Xcoor) + end if + if (allocated(read_turbine_position_dataData%upwind_turbine_Ycoor)) then + deallocate(read_turbine_position_dataData%upwind_turbine_Ycoor) + end if + if (allocated(read_turbine_position_dataData%wind_farm_Xcoor)) then + deallocate(read_turbine_position_dataData%wind_farm_Xcoor) + end if + if (allocated(read_turbine_position_dataData%wind_farm_Ycoor)) then + deallocate(read_turbine_position_dataData%wind_farm_Ycoor) + end if + if (allocated(read_turbine_position_dataData%downwind_turbine_Xcoor)) then + deallocate(read_turbine_position_dataData%downwind_turbine_Xcoor) + end if + if (allocated(read_turbine_position_dataData%downwind_turbine_Ycoor)) then + deallocate(read_turbine_position_dataData%downwind_turbine_Ycoor) + end if +end subroutine subroutine DWM_Packread_turbine_position_data(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(read_turbine_position_data), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_Packread_turbine_position_data' if (Buf%ErrStat >= AbortErrLev) return - ! SimulationOrder_index call RegPack(Buf, InData%SimulationOrder_index) if (RegCheckErr(Buf, RoutineName)) return - ! Turbine_sort_order call RegPack(Buf, allocated(InData%Turbine_sort_order)) if (allocated(InData%Turbine_sort_order)) then call RegPackBounds(Buf, 1, lbound(InData%Turbine_sort_order), ubound(InData%Turbine_sort_order)) call RegPack(Buf, InData%Turbine_sort_order) end if if (RegCheckErr(Buf, RoutineName)) return - ! WT_index call RegPack(Buf, InData%WT_index) if (RegCheckErr(Buf, RoutineName)) return - ! TurbineInfluenceData call RegPack(Buf, allocated(InData%TurbineInfluenceData)) if (allocated(InData%TurbineInfluenceData)) then call RegPackBounds(Buf, 2, lbound(InData%TurbineInfluenceData), ubound(InData%TurbineInfluenceData)) call RegPack(Buf, InData%TurbineInfluenceData) end if if (RegCheckErr(Buf, RoutineName)) return - ! upwind_turbine_index call RegPack(Buf, allocated(InData%upwind_turbine_index)) if (allocated(InData%upwind_turbine_index)) then call RegPackBounds(Buf, 1, lbound(InData%upwind_turbine_index), ubound(InData%upwind_turbine_index)) call RegPack(Buf, InData%upwind_turbine_index) end if if (RegCheckErr(Buf, RoutineName)) return - ! downwind_turbine_index call RegPack(Buf, allocated(InData%downwind_turbine_index)) if (allocated(InData%downwind_turbine_index)) then call RegPackBounds(Buf, 1, lbound(InData%downwind_turbine_index), ubound(InData%downwind_turbine_index)) call RegPack(Buf, InData%downwind_turbine_index) end if if (RegCheckErr(Buf, RoutineName)) return - ! upwindturbine_number call RegPack(Buf, InData%upwindturbine_number) if (RegCheckErr(Buf, RoutineName)) return - ! downwindturbine_number call RegPack(Buf, InData%downwindturbine_number) if (RegCheckErr(Buf, RoutineName)) return - ! turbine_windorigin_length call RegPack(Buf, allocated(InData%turbine_windorigin_length)) if (allocated(InData%turbine_windorigin_length)) then call RegPackBounds(Buf, 1, lbound(InData%turbine_windorigin_length), ubound(InData%turbine_windorigin_length)) call RegPack(Buf, InData%turbine_windorigin_length) end if if (RegCheckErr(Buf, RoutineName)) return - ! upwind_turbine_projected_distance call RegPack(Buf, allocated(InData%upwind_turbine_projected_distance)) if (allocated(InData%upwind_turbine_projected_distance)) then call RegPackBounds(Buf, 1, lbound(InData%upwind_turbine_projected_distance), ubound(InData%upwind_turbine_projected_distance)) call RegPack(Buf, InData%upwind_turbine_projected_distance) end if if (RegCheckErr(Buf, RoutineName)) return - ! downwind_turbine_projected_distance call RegPack(Buf, allocated(InData%downwind_turbine_projected_distance)) if (allocated(InData%downwind_turbine_projected_distance)) then call RegPackBounds(Buf, 1, lbound(InData%downwind_turbine_projected_distance), ubound(InData%downwind_turbine_projected_distance)) call RegPack(Buf, InData%downwind_turbine_projected_distance) end if if (RegCheckErr(Buf, RoutineName)) return - ! turbine_angle call RegPack(Buf, allocated(InData%turbine_angle)) if (allocated(InData%turbine_angle)) then call RegPackBounds(Buf, 2, lbound(InData%turbine_angle), ubound(InData%turbine_angle)) call RegPack(Buf, InData%turbine_angle) end if if (RegCheckErr(Buf, RoutineName)) return - ! upwind_align_angle call RegPack(Buf, allocated(InData%upwind_align_angle)) if (allocated(InData%upwind_align_angle)) then call RegPackBounds(Buf, 1, lbound(InData%upwind_align_angle), ubound(InData%upwind_align_angle)) call RegPack(Buf, InData%upwind_align_angle) end if if (RegCheckErr(Buf, RoutineName)) return - ! downwind_align_angle call RegPack(Buf, allocated(InData%downwind_align_angle)) if (allocated(InData%downwind_align_angle)) then call RegPackBounds(Buf, 1, lbound(InData%downwind_align_angle), ubound(InData%downwind_align_angle)) call RegPack(Buf, InData%downwind_align_angle) end if if (RegCheckErr(Buf, RoutineName)) return - ! upwind_turbine_Xcoor call RegPack(Buf, allocated(InData%upwind_turbine_Xcoor)) if (allocated(InData%upwind_turbine_Xcoor)) then call RegPackBounds(Buf, 1, lbound(InData%upwind_turbine_Xcoor), ubound(InData%upwind_turbine_Xcoor)) call RegPack(Buf, InData%upwind_turbine_Xcoor) end if if (RegCheckErr(Buf, RoutineName)) return - ! upwind_turbine_Ycoor call RegPack(Buf, allocated(InData%upwind_turbine_Ycoor)) if (allocated(InData%upwind_turbine_Ycoor)) then call RegPackBounds(Buf, 1, lbound(InData%upwind_turbine_Ycoor), ubound(InData%upwind_turbine_Ycoor)) call RegPack(Buf, InData%upwind_turbine_Ycoor) end if if (RegCheckErr(Buf, RoutineName)) return - ! wind_farm_Xcoor call RegPack(Buf, allocated(InData%wind_farm_Xcoor)) if (allocated(InData%wind_farm_Xcoor)) then call RegPackBounds(Buf, 1, lbound(InData%wind_farm_Xcoor), ubound(InData%wind_farm_Xcoor)) call RegPack(Buf, InData%wind_farm_Xcoor) end if if (RegCheckErr(Buf, RoutineName)) return - ! wind_farm_Ycoor call RegPack(Buf, allocated(InData%wind_farm_Ycoor)) if (allocated(InData%wind_farm_Ycoor)) then call RegPackBounds(Buf, 1, lbound(InData%wind_farm_Ycoor), ubound(InData%wind_farm_Ycoor)) call RegPack(Buf, InData%wind_farm_Ycoor) end if if (RegCheckErr(Buf, RoutineName)) return - ! downwind_turbine_Xcoor call RegPack(Buf, allocated(InData%downwind_turbine_Xcoor)) if (allocated(InData%downwind_turbine_Xcoor)) then call RegPackBounds(Buf, 1, lbound(InData%downwind_turbine_Xcoor), ubound(InData%downwind_turbine_Xcoor)) call RegPack(Buf, InData%downwind_turbine_Xcoor) end if if (RegCheckErr(Buf, RoutineName)) return - ! downwind_turbine_Ycoor call RegPack(Buf, allocated(InData%downwind_turbine_Ycoor)) if (allocated(InData%downwind_turbine_Ycoor)) then call RegPackBounds(Buf, 1, lbound(InData%downwind_turbine_Ycoor), ubound(InData%downwind_turbine_Ycoor)) @@ -1214,10 +1140,8 @@ subroutine DWM_UnPackread_turbine_position_data(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! SimulationOrder_index call RegUnpack(Buf, OutData%SimulationOrder_index) if (RegCheckErr(Buf, RoutineName)) return - ! Turbine_sort_order if (allocated(OutData%Turbine_sort_order)) deallocate(OutData%Turbine_sort_order) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1232,10 +1156,8 @@ subroutine DWM_UnPackread_turbine_position_data(Buf, OutData) call RegUnpack(Buf, OutData%Turbine_sort_order) if (RegCheckErr(Buf, RoutineName)) return end if - ! WT_index call RegUnpack(Buf, OutData%WT_index) if (RegCheckErr(Buf, RoutineName)) return - ! TurbineInfluenceData if (allocated(OutData%TurbineInfluenceData)) deallocate(OutData%TurbineInfluenceData) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1250,7 +1172,6 @@ subroutine DWM_UnPackread_turbine_position_data(Buf, OutData) call RegUnpack(Buf, OutData%TurbineInfluenceData) if (RegCheckErr(Buf, RoutineName)) return end if - ! upwind_turbine_index if (allocated(OutData%upwind_turbine_index)) deallocate(OutData%upwind_turbine_index) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1265,7 +1186,6 @@ subroutine DWM_UnPackread_turbine_position_data(Buf, OutData) call RegUnpack(Buf, OutData%upwind_turbine_index) if (RegCheckErr(Buf, RoutineName)) return end if - ! downwind_turbine_index if (allocated(OutData%downwind_turbine_index)) deallocate(OutData%downwind_turbine_index) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1280,13 +1200,10 @@ subroutine DWM_UnPackread_turbine_position_data(Buf, OutData) call RegUnpack(Buf, OutData%downwind_turbine_index) if (RegCheckErr(Buf, RoutineName)) return end if - ! upwindturbine_number call RegUnpack(Buf, OutData%upwindturbine_number) if (RegCheckErr(Buf, RoutineName)) return - ! downwindturbine_number call RegUnpack(Buf, OutData%downwindturbine_number) if (RegCheckErr(Buf, RoutineName)) return - ! turbine_windorigin_length if (allocated(OutData%turbine_windorigin_length)) deallocate(OutData%turbine_windorigin_length) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1301,7 +1218,6 @@ subroutine DWM_UnPackread_turbine_position_data(Buf, OutData) call RegUnpack(Buf, OutData%turbine_windorigin_length) if (RegCheckErr(Buf, RoutineName)) return end if - ! upwind_turbine_projected_distance if (allocated(OutData%upwind_turbine_projected_distance)) deallocate(OutData%upwind_turbine_projected_distance) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1316,7 +1232,6 @@ subroutine DWM_UnPackread_turbine_position_data(Buf, OutData) call RegUnpack(Buf, OutData%upwind_turbine_projected_distance) if (RegCheckErr(Buf, RoutineName)) return end if - ! downwind_turbine_projected_distance if (allocated(OutData%downwind_turbine_projected_distance)) deallocate(OutData%downwind_turbine_projected_distance) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1331,7 +1246,6 @@ subroutine DWM_UnPackread_turbine_position_data(Buf, OutData) call RegUnpack(Buf, OutData%downwind_turbine_projected_distance) if (RegCheckErr(Buf, RoutineName)) return end if - ! turbine_angle if (allocated(OutData%turbine_angle)) deallocate(OutData%turbine_angle) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1346,7 +1260,6 @@ subroutine DWM_UnPackread_turbine_position_data(Buf, OutData) call RegUnpack(Buf, OutData%turbine_angle) if (RegCheckErr(Buf, RoutineName)) return end if - ! upwind_align_angle if (allocated(OutData%upwind_align_angle)) deallocate(OutData%upwind_align_angle) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1361,7 +1274,6 @@ subroutine DWM_UnPackread_turbine_position_data(Buf, OutData) call RegUnpack(Buf, OutData%upwind_align_angle) if (RegCheckErr(Buf, RoutineName)) return end if - ! downwind_align_angle if (allocated(OutData%downwind_align_angle)) deallocate(OutData%downwind_align_angle) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1376,7 +1288,6 @@ subroutine DWM_UnPackread_turbine_position_data(Buf, OutData) call RegUnpack(Buf, OutData%downwind_align_angle) if (RegCheckErr(Buf, RoutineName)) return end if - ! upwind_turbine_Xcoor if (allocated(OutData%upwind_turbine_Xcoor)) deallocate(OutData%upwind_turbine_Xcoor) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1391,7 +1302,6 @@ subroutine DWM_UnPackread_turbine_position_data(Buf, OutData) call RegUnpack(Buf, OutData%upwind_turbine_Xcoor) if (RegCheckErr(Buf, RoutineName)) return end if - ! upwind_turbine_Ycoor if (allocated(OutData%upwind_turbine_Ycoor)) deallocate(OutData%upwind_turbine_Ycoor) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1406,7 +1316,6 @@ subroutine DWM_UnPackread_turbine_position_data(Buf, OutData) call RegUnpack(Buf, OutData%upwind_turbine_Ycoor) if (RegCheckErr(Buf, RoutineName)) return end if - ! wind_farm_Xcoor if (allocated(OutData%wind_farm_Xcoor)) deallocate(OutData%wind_farm_Xcoor) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1421,7 +1330,6 @@ subroutine DWM_UnPackread_turbine_position_data(Buf, OutData) call RegUnpack(Buf, OutData%wind_farm_Xcoor) if (RegCheckErr(Buf, RoutineName)) return end if - ! wind_farm_Ycoor if (allocated(OutData%wind_farm_Ycoor)) deallocate(OutData%wind_farm_Ycoor) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1436,7 +1344,6 @@ subroutine DWM_UnPackread_turbine_position_data(Buf, OutData) call RegUnpack(Buf, OutData%wind_farm_Ycoor) if (RegCheckErr(Buf, RoutineName)) return end if - ! downwind_turbine_Xcoor if (allocated(OutData%downwind_turbine_Xcoor)) deallocate(OutData%downwind_turbine_Xcoor) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1451,7 +1358,6 @@ subroutine DWM_UnPackread_turbine_position_data(Buf, OutData) call RegUnpack(Buf, OutData%downwind_turbine_Xcoor) if (RegCheckErr(Buf, RoutineName)) return end if - ! downwind_turbine_Ycoor if (allocated(OutData%downwind_turbine_Ycoor)) deallocate(OutData%downwind_turbine_Ycoor) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1467,68 +1373,58 @@ subroutine DWM_UnPackread_turbine_position_data(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE DWM_CopyWeiMethod( SrcWeiMethodData, DstWeiMethodData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WeiMethod), INTENT(IN) :: SrcWeiMethodData - TYPE(WeiMethod), INTENT(INOUT) :: DstWeiMethodData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_CopyWeiMethod' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcWeiMethodData%sweptarea)) THEN - i1_l = LBOUND(SrcWeiMethodData%sweptarea,1) - i1_u = UBOUND(SrcWeiMethodData%sweptarea,1) - IF (.NOT. ALLOCATED(DstWeiMethodData%sweptarea)) THEN - ALLOCATE(DstWeiMethodData%sweptarea(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstWeiMethodData%sweptarea.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstWeiMethodData%sweptarea = SrcWeiMethodData%sweptarea -ENDIF - DstWeiMethodData%weighting_denominator = SrcWeiMethodData%weighting_denominator - END SUBROUTINE DWM_CopyWeiMethod - SUBROUTINE DWM_DestroyWeiMethod( WeiMethodData, ErrStat, ErrMsg ) - TYPE(WeiMethod), INTENT(INOUT) :: WeiMethodData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyWeiMethod' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(WeiMethodData%sweptarea)) THEN - DEALLOCATE(WeiMethodData%sweptarea) -ENDIF - END SUBROUTINE DWM_DestroyWeiMethod +subroutine DWM_CopyWeiMethod(SrcWeiMethodData, DstWeiMethodData, CtrlCode, ErrStat, ErrMsg) + type(WeiMethod), intent(in) :: SrcWeiMethodData + type(WeiMethod), intent(inout) :: DstWeiMethodData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'DWM_CopyWeiMethod' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcWeiMethodData%sweptarea)) then + LB(1:1) = lbound(SrcWeiMethodData%sweptarea) + UB(1:1) = ubound(SrcWeiMethodData%sweptarea) + if (.not. allocated(DstWeiMethodData%sweptarea)) then + allocate(DstWeiMethodData%sweptarea(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstWeiMethodData%sweptarea.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstWeiMethodData%sweptarea = SrcWeiMethodData%sweptarea + else if (allocated(DstWeiMethodData%sweptarea)) then + deallocate(DstWeiMethodData%sweptarea) + end if + DstWeiMethodData%weighting_denominator = SrcWeiMethodData%weighting_denominator +end subroutine +subroutine DWM_DestroyWeiMethod(WeiMethodData, ErrStat, ErrMsg) + type(WeiMethod), intent(inout) :: WeiMethodData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DWM_DestroyWeiMethod' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(WeiMethodData%sweptarea)) then + deallocate(WeiMethodData%sweptarea) + end if +end subroutine subroutine DWM_PackWeiMethod(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(WeiMethod), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_PackWeiMethod' if (Buf%ErrStat >= AbortErrLev) return - ! sweptarea call RegPack(Buf, allocated(InData%sweptarea)) if (allocated(InData%sweptarea)) then call RegPackBounds(Buf, 1, lbound(InData%sweptarea), ubound(InData%sweptarea)) call RegPack(Buf, InData%sweptarea) end if if (RegCheckErr(Buf, RoutineName)) return - ! weighting_denominator call RegPack(Buf, InData%weighting_denominator) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1541,7 +1437,6 @@ subroutine DWM_UnPackWeiMethod(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! sweptarea if (allocated(OutData%sweptarea)) deallocate(OutData%sweptarea) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1556,187 +1451,145 @@ subroutine DWM_UnPackWeiMethod(Buf, OutData) call RegUnpack(Buf, OutData%sweptarea) if (RegCheckErr(Buf, RoutineName)) return end if - ! weighting_denominator call RegUnpack(Buf, OutData%weighting_denominator) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE DWM_CopyTIDownstream( SrcTIDownstreamData, DstTIDownstreamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(TIDownstream), INTENT(IN) :: SrcTIDownstreamData - TYPE(TIDownstream), INTENT(INOUT) :: DstTIDownstreamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_CopyTIDownstream' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcTIDownstreamData%TI_downstream_matrix)) THEN - i1_l = LBOUND(SrcTIDownstreamData%TI_downstream_matrix,1) - i1_u = UBOUND(SrcTIDownstreamData%TI_downstream_matrix,1) - i2_l = LBOUND(SrcTIDownstreamData%TI_downstream_matrix,2) - i2_u = UBOUND(SrcTIDownstreamData%TI_downstream_matrix,2) - IF (.NOT. ALLOCATED(DstTIDownstreamData%TI_downstream_matrix)) THEN - ALLOCATE(DstTIDownstreamData%TI_downstream_matrix(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstTIDownstreamData%TI_downstream_matrix.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstTIDownstreamData%TI_downstream_matrix = SrcTIDownstreamData%TI_downstream_matrix -ENDIF - DstTIDownstreamData%i = SrcTIDownstreamData%i - DstTIDownstreamData%j = SrcTIDownstreamData%j - DstTIDownstreamData%k = SrcTIDownstreamData%k - DstTIDownstreamData%cross_plane_position_ds = SrcTIDownstreamData%cross_plane_position_ds - DstTIDownstreamData%cross_plane_position_TI = SrcTIDownstreamData%cross_plane_position_TI - DstTIDownstreamData%distance_index = SrcTIDownstreamData%distance_index - DstTIDownstreamData%counter1 = SrcTIDownstreamData%counter1 - DstTIDownstreamData%counter2 = SrcTIDownstreamData%counter2 - DstTIDownstreamData%initial_timestep = SrcTIDownstreamData%initial_timestep - DstTIDownstreamData%y_axis_turbine = SrcTIDownstreamData%y_axis_turbine - DstTIDownstreamData%z_axis_turbine = SrcTIDownstreamData%z_axis_turbine - DstTIDownstreamData%distance = SrcTIDownstreamData%distance - DstTIDownstreamData%TI_downstream_node = SrcTIDownstreamData%TI_downstream_node - DstTIDownstreamData%TI_node_temp = SrcTIDownstreamData%TI_node_temp - DstTIDownstreamData%TI_node = SrcTIDownstreamData%TI_node - DstTIDownstreamData%TI_accumulation = SrcTIDownstreamData%TI_accumulation - DstTIDownstreamData%TI_apprant_accumulation = SrcTIDownstreamData%TI_apprant_accumulation - DstTIDownstreamData%TI_average = SrcTIDownstreamData%TI_average - DstTIDownstreamData%TI_apprant = SrcTIDownstreamData%TI_apprant - DstTIDownstreamData%HubHt = SrcTIDownstreamData%HubHt - DstTIDownstreamData%wake_center_y = SrcTIDownstreamData%wake_center_y - DstTIDownstreamData%wake_center_z = SrcTIDownstreamData%wake_center_z - DstTIDownstreamData%Rscale = SrcTIDownstreamData%Rscale - DstTIDownstreamData%y = SrcTIDownstreamData%y - DstTIDownstreamData%z = SrcTIDownstreamData%z - DstTIDownstreamData%zero_spacing = SrcTIDownstreamData%zero_spacing - DstTIDownstreamData%temp1 = SrcTIDownstreamData%temp1 - DstTIDownstreamData%temp2 = SrcTIDownstreamData%temp2 - DstTIDownstreamData%temp3 = SrcTIDownstreamData%temp3 - END SUBROUTINE DWM_CopyTIDownstream - SUBROUTINE DWM_DestroyTIDownstream( TIDownstreamData, ErrStat, ErrMsg ) - TYPE(TIDownstream), INTENT(INOUT) :: TIDownstreamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyTIDownstream' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(TIDownstreamData%TI_downstream_matrix)) THEN - DEALLOCATE(TIDownstreamData%TI_downstream_matrix) -ENDIF - END SUBROUTINE DWM_DestroyTIDownstream +subroutine DWM_CopyTIDownstream(SrcTIDownstreamData, DstTIDownstreamData, CtrlCode, ErrStat, ErrMsg) + type(TIDownstream), intent(in) :: SrcTIDownstreamData + type(TIDownstream), intent(inout) :: DstTIDownstreamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'DWM_CopyTIDownstream' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcTIDownstreamData%TI_downstream_matrix)) then + LB(1:2) = lbound(SrcTIDownstreamData%TI_downstream_matrix) + UB(1:2) = ubound(SrcTIDownstreamData%TI_downstream_matrix) + if (.not. allocated(DstTIDownstreamData%TI_downstream_matrix)) then + allocate(DstTIDownstreamData%TI_downstream_matrix(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstTIDownstreamData%TI_downstream_matrix.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstTIDownstreamData%TI_downstream_matrix = SrcTIDownstreamData%TI_downstream_matrix + else if (allocated(DstTIDownstreamData%TI_downstream_matrix)) then + deallocate(DstTIDownstreamData%TI_downstream_matrix) + end if + DstTIDownstreamData%i = SrcTIDownstreamData%i + DstTIDownstreamData%j = SrcTIDownstreamData%j + DstTIDownstreamData%k = SrcTIDownstreamData%k + DstTIDownstreamData%cross_plane_position_ds = SrcTIDownstreamData%cross_plane_position_ds + DstTIDownstreamData%cross_plane_position_TI = SrcTIDownstreamData%cross_plane_position_TI + DstTIDownstreamData%distance_index = SrcTIDownstreamData%distance_index + DstTIDownstreamData%counter1 = SrcTIDownstreamData%counter1 + DstTIDownstreamData%counter2 = SrcTIDownstreamData%counter2 + DstTIDownstreamData%initial_timestep = SrcTIDownstreamData%initial_timestep + DstTIDownstreamData%y_axis_turbine = SrcTIDownstreamData%y_axis_turbine + DstTIDownstreamData%z_axis_turbine = SrcTIDownstreamData%z_axis_turbine + DstTIDownstreamData%distance = SrcTIDownstreamData%distance + DstTIDownstreamData%TI_downstream_node = SrcTIDownstreamData%TI_downstream_node + DstTIDownstreamData%TI_node_temp = SrcTIDownstreamData%TI_node_temp + DstTIDownstreamData%TI_node = SrcTIDownstreamData%TI_node + DstTIDownstreamData%TI_accumulation = SrcTIDownstreamData%TI_accumulation + DstTIDownstreamData%TI_apprant_accumulation = SrcTIDownstreamData%TI_apprant_accumulation + DstTIDownstreamData%TI_average = SrcTIDownstreamData%TI_average + DstTIDownstreamData%TI_apprant = SrcTIDownstreamData%TI_apprant + DstTIDownstreamData%HubHt = SrcTIDownstreamData%HubHt + DstTIDownstreamData%wake_center_y = SrcTIDownstreamData%wake_center_y + DstTIDownstreamData%wake_center_z = SrcTIDownstreamData%wake_center_z + DstTIDownstreamData%Rscale = SrcTIDownstreamData%Rscale + DstTIDownstreamData%y = SrcTIDownstreamData%y + DstTIDownstreamData%z = SrcTIDownstreamData%z + DstTIDownstreamData%zero_spacing = SrcTIDownstreamData%zero_spacing + DstTIDownstreamData%temp1 = SrcTIDownstreamData%temp1 + DstTIDownstreamData%temp2 = SrcTIDownstreamData%temp2 + DstTIDownstreamData%temp3 = SrcTIDownstreamData%temp3 +end subroutine +subroutine DWM_DestroyTIDownstream(TIDownstreamData, ErrStat, ErrMsg) + type(TIDownstream), intent(inout) :: TIDownstreamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DWM_DestroyTIDownstream' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(TIDownstreamData%TI_downstream_matrix)) then + deallocate(TIDownstreamData%TI_downstream_matrix) + end if +end subroutine subroutine DWM_PackTIDownstream(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(TIDownstream), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_PackTIDownstream' if (Buf%ErrStat >= AbortErrLev) return - ! TI_downstream_matrix call RegPack(Buf, allocated(InData%TI_downstream_matrix)) if (allocated(InData%TI_downstream_matrix)) then call RegPackBounds(Buf, 2, lbound(InData%TI_downstream_matrix), ubound(InData%TI_downstream_matrix)) call RegPack(Buf, InData%TI_downstream_matrix) end if if (RegCheckErr(Buf, RoutineName)) return - ! i call RegPack(Buf, InData%i) if (RegCheckErr(Buf, RoutineName)) return - ! j call RegPack(Buf, InData%j) if (RegCheckErr(Buf, RoutineName)) return - ! k call RegPack(Buf, InData%k) if (RegCheckErr(Buf, RoutineName)) return - ! cross_plane_position_ds call RegPack(Buf, InData%cross_plane_position_ds) if (RegCheckErr(Buf, RoutineName)) return - ! cross_plane_position_TI call RegPack(Buf, InData%cross_plane_position_TI) if (RegCheckErr(Buf, RoutineName)) return - ! distance_index call RegPack(Buf, InData%distance_index) if (RegCheckErr(Buf, RoutineName)) return - ! counter1 call RegPack(Buf, InData%counter1) if (RegCheckErr(Buf, RoutineName)) return - ! counter2 call RegPack(Buf, InData%counter2) if (RegCheckErr(Buf, RoutineName)) return - ! initial_timestep call RegPack(Buf, InData%initial_timestep) if (RegCheckErr(Buf, RoutineName)) return - ! y_axis_turbine call RegPack(Buf, InData%y_axis_turbine) if (RegCheckErr(Buf, RoutineName)) return - ! z_axis_turbine call RegPack(Buf, InData%z_axis_turbine) if (RegCheckErr(Buf, RoutineName)) return - ! distance call RegPack(Buf, InData%distance) if (RegCheckErr(Buf, RoutineName)) return - ! TI_downstream_node call RegPack(Buf, InData%TI_downstream_node) if (RegCheckErr(Buf, RoutineName)) return - ! TI_node_temp call RegPack(Buf, InData%TI_node_temp) if (RegCheckErr(Buf, RoutineName)) return - ! TI_node call RegPack(Buf, InData%TI_node) if (RegCheckErr(Buf, RoutineName)) return - ! TI_accumulation call RegPack(Buf, InData%TI_accumulation) if (RegCheckErr(Buf, RoutineName)) return - ! TI_apprant_accumulation call RegPack(Buf, InData%TI_apprant_accumulation) if (RegCheckErr(Buf, RoutineName)) return - ! TI_average call RegPack(Buf, InData%TI_average) if (RegCheckErr(Buf, RoutineName)) return - ! TI_apprant call RegPack(Buf, InData%TI_apprant) if (RegCheckErr(Buf, RoutineName)) return - ! HubHt call RegPack(Buf, InData%HubHt) if (RegCheckErr(Buf, RoutineName)) return - ! wake_center_y call RegPack(Buf, InData%wake_center_y) if (RegCheckErr(Buf, RoutineName)) return - ! wake_center_z call RegPack(Buf, InData%wake_center_z) if (RegCheckErr(Buf, RoutineName)) return - ! Rscale call RegPack(Buf, InData%Rscale) if (RegCheckErr(Buf, RoutineName)) return - ! y call RegPack(Buf, InData%y) if (RegCheckErr(Buf, RoutineName)) return - ! z call RegPack(Buf, InData%z) if (RegCheckErr(Buf, RoutineName)) return - ! zero_spacing call RegPack(Buf, InData%zero_spacing) if (RegCheckErr(Buf, RoutineName)) return - ! temp1 call RegPack(Buf, InData%temp1) if (RegCheckErr(Buf, RoutineName)) return - ! temp2 call RegPack(Buf, InData%temp2) if (RegCheckErr(Buf, RoutineName)) return - ! temp3 call RegPack(Buf, InData%temp3) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1749,7 +1602,6 @@ subroutine DWM_UnPackTIDownstream(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! TI_downstream_matrix if (allocated(OutData%TI_downstream_matrix)) deallocate(OutData%TI_downstream_matrix) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1764,157 +1616,110 @@ subroutine DWM_UnPackTIDownstream(Buf, OutData) call RegUnpack(Buf, OutData%TI_downstream_matrix) if (RegCheckErr(Buf, RoutineName)) return end if - ! i call RegUnpack(Buf, OutData%i) if (RegCheckErr(Buf, RoutineName)) return - ! j call RegUnpack(Buf, OutData%j) if (RegCheckErr(Buf, RoutineName)) return - ! k call RegUnpack(Buf, OutData%k) if (RegCheckErr(Buf, RoutineName)) return - ! cross_plane_position_ds call RegUnpack(Buf, OutData%cross_plane_position_ds) if (RegCheckErr(Buf, RoutineName)) return - ! cross_plane_position_TI call RegUnpack(Buf, OutData%cross_plane_position_TI) if (RegCheckErr(Buf, RoutineName)) return - ! distance_index call RegUnpack(Buf, OutData%distance_index) if (RegCheckErr(Buf, RoutineName)) return - ! counter1 call RegUnpack(Buf, OutData%counter1) if (RegCheckErr(Buf, RoutineName)) return - ! counter2 call RegUnpack(Buf, OutData%counter2) if (RegCheckErr(Buf, RoutineName)) return - ! initial_timestep call RegUnpack(Buf, OutData%initial_timestep) if (RegCheckErr(Buf, RoutineName)) return - ! y_axis_turbine call RegUnpack(Buf, OutData%y_axis_turbine) if (RegCheckErr(Buf, RoutineName)) return - ! z_axis_turbine call RegUnpack(Buf, OutData%z_axis_turbine) if (RegCheckErr(Buf, RoutineName)) return - ! distance call RegUnpack(Buf, OutData%distance) if (RegCheckErr(Buf, RoutineName)) return - ! TI_downstream_node call RegUnpack(Buf, OutData%TI_downstream_node) if (RegCheckErr(Buf, RoutineName)) return - ! TI_node_temp call RegUnpack(Buf, OutData%TI_node_temp) if (RegCheckErr(Buf, RoutineName)) return - ! TI_node call RegUnpack(Buf, OutData%TI_node) if (RegCheckErr(Buf, RoutineName)) return - ! TI_accumulation call RegUnpack(Buf, OutData%TI_accumulation) if (RegCheckErr(Buf, RoutineName)) return - ! TI_apprant_accumulation call RegUnpack(Buf, OutData%TI_apprant_accumulation) if (RegCheckErr(Buf, RoutineName)) return - ! TI_average call RegUnpack(Buf, OutData%TI_average) if (RegCheckErr(Buf, RoutineName)) return - ! TI_apprant call RegUnpack(Buf, OutData%TI_apprant) if (RegCheckErr(Buf, RoutineName)) return - ! HubHt call RegUnpack(Buf, OutData%HubHt) if (RegCheckErr(Buf, RoutineName)) return - ! wake_center_y call RegUnpack(Buf, OutData%wake_center_y) if (RegCheckErr(Buf, RoutineName)) return - ! wake_center_z call RegUnpack(Buf, OutData%wake_center_z) if (RegCheckErr(Buf, RoutineName)) return - ! Rscale call RegUnpack(Buf, OutData%Rscale) if (RegCheckErr(Buf, RoutineName)) return - ! y call RegUnpack(Buf, OutData%y) if (RegCheckErr(Buf, RoutineName)) return - ! z call RegUnpack(Buf, OutData%z) if (RegCheckErr(Buf, RoutineName)) return - ! zero_spacing call RegUnpack(Buf, OutData%zero_spacing) if (RegCheckErr(Buf, RoutineName)) return - ! temp1 call RegUnpack(Buf, OutData%temp1) if (RegCheckErr(Buf, RoutineName)) return - ! temp2 call RegUnpack(Buf, OutData%temp2) if (RegCheckErr(Buf, RoutineName)) return - ! temp3 call RegUnpack(Buf, OutData%temp3) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE DWM_CopyTurbKaimal( SrcTurbKaimalData, DstTurbKaimalData, CtrlCode, ErrStat, ErrMsg ) - TYPE(TurbKaimal), INTENT(IN) :: SrcTurbKaimalData - TYPE(TurbKaimal), INTENT(INOUT) :: DstTurbKaimalData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_CopyTurbKaimal' -! - ErrStat = ErrID_None - ErrMsg = "" - DstTurbKaimalData%fs = SrcTurbKaimalData%fs - DstTurbKaimalData%temp_n = SrcTurbKaimalData%temp_n - DstTurbKaimalData%i = SrcTurbKaimalData%i - DstTurbKaimalData%low_f = SrcTurbKaimalData%low_f - DstTurbKaimalData%high_f = SrcTurbKaimalData%high_f - DstTurbKaimalData%lk_facor = SrcTurbKaimalData%lk_facor - DstTurbKaimalData%STD = SrcTurbKaimalData%STD - END SUBROUTINE DWM_CopyTurbKaimal - SUBROUTINE DWM_DestroyTurbKaimal( TurbKaimalData, ErrStat, ErrMsg ) - TYPE(TurbKaimal), INTENT(INOUT) :: TurbKaimalData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyTurbKaimal' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE DWM_DestroyTurbKaimal +subroutine DWM_CopyTurbKaimal(SrcTurbKaimalData, DstTurbKaimalData, CtrlCode, ErrStat, ErrMsg) + type(TurbKaimal), intent(in) :: SrcTurbKaimalData + type(TurbKaimal), intent(inout) :: DstTurbKaimalData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DWM_CopyTurbKaimal' + ErrStat = ErrID_None + ErrMsg = '' + DstTurbKaimalData%fs = SrcTurbKaimalData%fs + DstTurbKaimalData%temp_n = SrcTurbKaimalData%temp_n + DstTurbKaimalData%i = SrcTurbKaimalData%i + DstTurbKaimalData%low_f = SrcTurbKaimalData%low_f + DstTurbKaimalData%high_f = SrcTurbKaimalData%high_f + DstTurbKaimalData%lk_facor = SrcTurbKaimalData%lk_facor + DstTurbKaimalData%STD = SrcTurbKaimalData%STD +end subroutine +subroutine DWM_DestroyTurbKaimal(TurbKaimalData, ErrStat, ErrMsg) + type(TurbKaimal), intent(inout) :: TurbKaimalData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DWM_DestroyTurbKaimal' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine DWM_PackTurbKaimal(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(TurbKaimal), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_PackTurbKaimal' if (Buf%ErrStat >= AbortErrLev) return - ! fs call RegPack(Buf, InData%fs) if (RegCheckErr(Buf, RoutineName)) return - ! temp_n call RegPack(Buf, InData%temp_n) if (RegCheckErr(Buf, RoutineName)) return - ! i call RegPack(Buf, InData%i) if (RegCheckErr(Buf, RoutineName)) return - ! low_f call RegPack(Buf, InData%low_f) if (RegCheckErr(Buf, RoutineName)) return - ! high_f call RegPack(Buf, InData%high_f) if (RegCheckErr(Buf, RoutineName)) return - ! lk_facor call RegPack(Buf, InData%lk_facor) if (RegCheckErr(Buf, RoutineName)) return - ! STD call RegPack(Buf, InData%STD) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1924,206 +1729,186 @@ subroutine DWM_UnPackTurbKaimal(Buf, OutData) type(TurbKaimal), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPackTurbKaimal' if (Buf%ErrStat /= ErrID_None) return - ! fs call RegUnpack(Buf, OutData%fs) if (RegCheckErr(Buf, RoutineName)) return - ! temp_n call RegUnpack(Buf, OutData%temp_n) if (RegCheckErr(Buf, RoutineName)) return - ! i call RegUnpack(Buf, OutData%i) if (RegCheckErr(Buf, RoutineName)) return - ! low_f call RegUnpack(Buf, OutData%low_f) if (RegCheckErr(Buf, RoutineName)) return - ! high_f call RegUnpack(Buf, OutData%high_f) if (RegCheckErr(Buf, RoutineName)) return - ! lk_facor call RegUnpack(Buf, OutData%lk_facor) if (RegCheckErr(Buf, RoutineName)) return - ! STD call RegUnpack(Buf, OutData%STD) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE DWM_CopyShinozuka( SrcShinozukaData, DstShinozukaData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Shinozuka), INTENT(IN) :: SrcShinozukaData - TYPE(Shinozuka), INTENT(INOUT) :: DstShinozukaData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_CopyShinozuka' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcShinozukaData%f_syn)) THEN - i1_l = LBOUND(SrcShinozukaData%f_syn,1) - i1_u = UBOUND(SrcShinozukaData%f_syn,1) - IF (.NOT. ALLOCATED(DstShinozukaData%f_syn)) THEN - ALLOCATE(DstShinozukaData%f_syn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstShinozukaData%f_syn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstShinozukaData%f_syn = SrcShinozukaData%f_syn -ENDIF -IF (ALLOCATED(SrcShinozukaData%t_syn)) THEN - i1_l = LBOUND(SrcShinozukaData%t_syn,1) - i1_u = UBOUND(SrcShinozukaData%t_syn,1) - IF (.NOT. ALLOCATED(DstShinozukaData%t_syn)) THEN - ALLOCATE(DstShinozukaData%t_syn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstShinozukaData%t_syn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstShinozukaData%t_syn = SrcShinozukaData%t_syn -ENDIF -IF (ALLOCATED(SrcShinozukaData%phi)) THEN - i1_l = LBOUND(SrcShinozukaData%phi,1) - i1_u = UBOUND(SrcShinozukaData%phi,1) - IF (.NOT. ALLOCATED(DstShinozukaData%phi)) THEN - ALLOCATE(DstShinozukaData%phi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstShinozukaData%phi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstShinozukaData%phi = SrcShinozukaData%phi -ENDIF -IF (ALLOCATED(SrcShinozukaData%p_k)) THEN - i1_l = LBOUND(SrcShinozukaData%p_k,1) - i1_u = UBOUND(SrcShinozukaData%p_k,1) - IF (.NOT. ALLOCATED(DstShinozukaData%p_k)) THEN - ALLOCATE(DstShinozukaData%p_k(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstShinozukaData%p_k.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstShinozukaData%p_k = SrcShinozukaData%p_k -ENDIF -IF (ALLOCATED(SrcShinozukaData%a_k)) THEN - i1_l = LBOUND(SrcShinozukaData%a_k,1) - i1_u = UBOUND(SrcShinozukaData%a_k,1) - IF (.NOT. ALLOCATED(DstShinozukaData%a_k)) THEN - ALLOCATE(DstShinozukaData%a_k(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstShinozukaData%a_k.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstShinozukaData%a_k = SrcShinozukaData%a_k -ENDIF - DstShinozukaData%num_points = SrcShinozukaData%num_points - DstShinozukaData%ILo = SrcShinozukaData%ILo - DstShinozukaData%i = SrcShinozukaData%i - DstShinozukaData%j = SrcShinozukaData%j - DstShinozukaData%dt = SrcShinozukaData%dt - DstShinozukaData%t_min = SrcShinozukaData%t_min - DstShinozukaData%t_max = SrcShinozukaData%t_max - DstShinozukaData%df = SrcShinozukaData%df - END SUBROUTINE DWM_CopyShinozuka - - SUBROUTINE DWM_DestroyShinozuka( ShinozukaData, ErrStat, ErrMsg ) - TYPE(Shinozuka), INTENT(INOUT) :: ShinozukaData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyShinozuka' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ShinozukaData%f_syn)) THEN - DEALLOCATE(ShinozukaData%f_syn) -ENDIF -IF (ALLOCATED(ShinozukaData%t_syn)) THEN - DEALLOCATE(ShinozukaData%t_syn) -ENDIF -IF (ALLOCATED(ShinozukaData%phi)) THEN - DEALLOCATE(ShinozukaData%phi) -ENDIF -IF (ALLOCATED(ShinozukaData%p_k)) THEN - DEALLOCATE(ShinozukaData%p_k) -ENDIF -IF (ALLOCATED(ShinozukaData%a_k)) THEN - DEALLOCATE(ShinozukaData%a_k) -ENDIF - END SUBROUTINE DWM_DestroyShinozuka +subroutine DWM_CopyShinozuka(SrcShinozukaData, DstShinozukaData, CtrlCode, ErrStat, ErrMsg) + type(Shinozuka), intent(in) :: SrcShinozukaData + type(Shinozuka), intent(inout) :: DstShinozukaData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'DWM_CopyShinozuka' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcShinozukaData%f_syn)) then + LB(1:1) = lbound(SrcShinozukaData%f_syn) + UB(1:1) = ubound(SrcShinozukaData%f_syn) + if (.not. allocated(DstShinozukaData%f_syn)) then + allocate(DstShinozukaData%f_syn(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstShinozukaData%f_syn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstShinozukaData%f_syn = SrcShinozukaData%f_syn + else if (allocated(DstShinozukaData%f_syn)) then + deallocate(DstShinozukaData%f_syn) + end if + if (allocated(SrcShinozukaData%t_syn)) then + LB(1:1) = lbound(SrcShinozukaData%t_syn) + UB(1:1) = ubound(SrcShinozukaData%t_syn) + if (.not. allocated(DstShinozukaData%t_syn)) then + allocate(DstShinozukaData%t_syn(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstShinozukaData%t_syn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstShinozukaData%t_syn = SrcShinozukaData%t_syn + else if (allocated(DstShinozukaData%t_syn)) then + deallocate(DstShinozukaData%t_syn) + end if + if (allocated(SrcShinozukaData%phi)) then + LB(1:1) = lbound(SrcShinozukaData%phi) + UB(1:1) = ubound(SrcShinozukaData%phi) + if (.not. allocated(DstShinozukaData%phi)) then + allocate(DstShinozukaData%phi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstShinozukaData%phi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstShinozukaData%phi = SrcShinozukaData%phi + else if (allocated(DstShinozukaData%phi)) then + deallocate(DstShinozukaData%phi) + end if + if (allocated(SrcShinozukaData%p_k)) then + LB(1:1) = lbound(SrcShinozukaData%p_k) + UB(1:1) = ubound(SrcShinozukaData%p_k) + if (.not. allocated(DstShinozukaData%p_k)) then + allocate(DstShinozukaData%p_k(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstShinozukaData%p_k.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstShinozukaData%p_k = SrcShinozukaData%p_k + else if (allocated(DstShinozukaData%p_k)) then + deallocate(DstShinozukaData%p_k) + end if + if (allocated(SrcShinozukaData%a_k)) then + LB(1:1) = lbound(SrcShinozukaData%a_k) + UB(1:1) = ubound(SrcShinozukaData%a_k) + if (.not. allocated(DstShinozukaData%a_k)) then + allocate(DstShinozukaData%a_k(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstShinozukaData%a_k.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstShinozukaData%a_k = SrcShinozukaData%a_k + else if (allocated(DstShinozukaData%a_k)) then + deallocate(DstShinozukaData%a_k) + end if + DstShinozukaData%num_points = SrcShinozukaData%num_points + DstShinozukaData%ILo = SrcShinozukaData%ILo + DstShinozukaData%i = SrcShinozukaData%i + DstShinozukaData%j = SrcShinozukaData%j + DstShinozukaData%dt = SrcShinozukaData%dt + DstShinozukaData%t_min = SrcShinozukaData%t_min + DstShinozukaData%t_max = SrcShinozukaData%t_max + DstShinozukaData%df = SrcShinozukaData%df +end subroutine +subroutine DWM_DestroyShinozuka(ShinozukaData, ErrStat, ErrMsg) + type(Shinozuka), intent(inout) :: ShinozukaData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DWM_DestroyShinozuka' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ShinozukaData%f_syn)) then + deallocate(ShinozukaData%f_syn) + end if + if (allocated(ShinozukaData%t_syn)) then + deallocate(ShinozukaData%t_syn) + end if + if (allocated(ShinozukaData%phi)) then + deallocate(ShinozukaData%phi) + end if + if (allocated(ShinozukaData%p_k)) then + deallocate(ShinozukaData%p_k) + end if + if (allocated(ShinozukaData%a_k)) then + deallocate(ShinozukaData%a_k) + end if +end subroutine subroutine DWM_PackShinozuka(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Shinozuka), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_PackShinozuka' if (Buf%ErrStat >= AbortErrLev) return - ! f_syn call RegPack(Buf, allocated(InData%f_syn)) if (allocated(InData%f_syn)) then call RegPackBounds(Buf, 1, lbound(InData%f_syn), ubound(InData%f_syn)) call RegPack(Buf, InData%f_syn) end if if (RegCheckErr(Buf, RoutineName)) return - ! t_syn call RegPack(Buf, allocated(InData%t_syn)) if (allocated(InData%t_syn)) then call RegPackBounds(Buf, 1, lbound(InData%t_syn), ubound(InData%t_syn)) call RegPack(Buf, InData%t_syn) end if if (RegCheckErr(Buf, RoutineName)) return - ! phi call RegPack(Buf, allocated(InData%phi)) if (allocated(InData%phi)) then call RegPackBounds(Buf, 1, lbound(InData%phi), ubound(InData%phi)) call RegPack(Buf, InData%phi) end if if (RegCheckErr(Buf, RoutineName)) return - ! p_k call RegPack(Buf, allocated(InData%p_k)) if (allocated(InData%p_k)) then call RegPackBounds(Buf, 1, lbound(InData%p_k), ubound(InData%p_k)) call RegPack(Buf, InData%p_k) end if if (RegCheckErr(Buf, RoutineName)) return - ! a_k call RegPack(Buf, allocated(InData%a_k)) if (allocated(InData%a_k)) then call RegPackBounds(Buf, 1, lbound(InData%a_k), ubound(InData%a_k)) call RegPack(Buf, InData%a_k) end if if (RegCheckErr(Buf, RoutineName)) return - ! num_points call RegPack(Buf, InData%num_points) if (RegCheckErr(Buf, RoutineName)) return - ! ILo call RegPack(Buf, InData%ILo) if (RegCheckErr(Buf, RoutineName)) return - ! i call RegPack(Buf, InData%i) if (RegCheckErr(Buf, RoutineName)) return - ! j call RegPack(Buf, InData%j) if (RegCheckErr(Buf, RoutineName)) return - ! dt call RegPack(Buf, InData%dt) if (RegCheckErr(Buf, RoutineName)) return - ! t_min call RegPack(Buf, InData%t_min) if (RegCheckErr(Buf, RoutineName)) return - ! t_max call RegPack(Buf, InData%t_max) if (RegCheckErr(Buf, RoutineName)) return - ! df call RegPack(Buf, InData%df) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2136,7 +1921,6 @@ subroutine DWM_UnPackShinozuka(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! f_syn if (allocated(OutData%f_syn)) deallocate(OutData%f_syn) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2151,7 +1935,6 @@ subroutine DWM_UnPackShinozuka(Buf, OutData) call RegUnpack(Buf, OutData%f_syn) if (RegCheckErr(Buf, RoutineName)) return end if - ! t_syn if (allocated(OutData%t_syn)) deallocate(OutData%t_syn) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2166,7 +1949,6 @@ subroutine DWM_UnPackShinozuka(Buf, OutData) call RegUnpack(Buf, OutData%t_syn) if (RegCheckErr(Buf, RoutineName)) return end if - ! phi if (allocated(OutData%phi)) deallocate(OutData%phi) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2181,7 +1963,6 @@ subroutine DWM_UnPackShinozuka(Buf, OutData) call RegUnpack(Buf, OutData%phi) if (RegCheckErr(Buf, RoutineName)) return end if - ! p_k if (allocated(OutData%p_k)) deallocate(OutData%p_k) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2196,7 +1977,6 @@ subroutine DWM_UnPackShinozuka(Buf, OutData) call RegUnpack(Buf, OutData%p_k) if (RegCheckErr(Buf, RoutineName)) return end if - ! a_k if (allocated(OutData%a_k)) deallocate(OutData%a_k) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2211,70 +1991,50 @@ subroutine DWM_UnPackShinozuka(Buf, OutData) call RegUnpack(Buf, OutData%a_k) if (RegCheckErr(Buf, RoutineName)) return end if - ! num_points call RegUnpack(Buf, OutData%num_points) if (RegCheckErr(Buf, RoutineName)) return - ! ILo call RegUnpack(Buf, OutData%ILo) if (RegCheckErr(Buf, RoutineName)) return - ! i call RegUnpack(Buf, OutData%i) if (RegCheckErr(Buf, RoutineName)) return - ! j call RegUnpack(Buf, OutData%j) if (RegCheckErr(Buf, RoutineName)) return - ! dt call RegUnpack(Buf, OutData%dt) if (RegCheckErr(Buf, RoutineName)) return - ! t_min call RegUnpack(Buf, OutData%t_min) if (RegCheckErr(Buf, RoutineName)) return - ! t_max call RegUnpack(Buf, OutData%t_max) if (RegCheckErr(Buf, RoutineName)) return - ! df call RegUnpack(Buf, OutData%df) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE DWM_Copysmooth_out_wake_data( Srcsmooth_out_wake_dataData, Dstsmooth_out_wake_dataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(smooth_out_wake_data), INTENT(IN) :: Srcsmooth_out_wake_dataData - TYPE(smooth_out_wake_data), INTENT(INOUT) :: Dstsmooth_out_wake_dataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Copysmooth_out_wake_data' -! - ErrStat = ErrID_None - ErrMsg = "" - Dstsmooth_out_wake_dataData%length_velocity_array = Srcsmooth_out_wake_dataData%length_velocity_array - END SUBROUTINE DWM_Copysmooth_out_wake_data - - SUBROUTINE DWM_Destroysmooth_out_wake_data( smooth_out_wake_dataData, ErrStat, ErrMsg ) - TYPE(smooth_out_wake_data), INTENT(INOUT) :: smooth_out_wake_dataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Destroysmooth_out_wake_data' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE DWM_Destroysmooth_out_wake_data +subroutine DWM_Copysmooth_out_wake_data(Srcsmooth_out_wake_dataData, Dstsmooth_out_wake_dataData, CtrlCode, ErrStat, ErrMsg) + type(smooth_out_wake_data), intent(in) :: Srcsmooth_out_wake_dataData + type(smooth_out_wake_data), intent(inout) :: Dstsmooth_out_wake_dataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DWM_Copysmooth_out_wake_data' + ErrStat = ErrID_None + ErrMsg = '' + Dstsmooth_out_wake_dataData%length_velocity_array = Srcsmooth_out_wake_dataData%length_velocity_array +end subroutine +subroutine DWM_Destroysmooth_out_wake_data(smooth_out_wake_dataData, ErrStat, ErrMsg) + type(smooth_out_wake_data), intent(inout) :: smooth_out_wake_dataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DWM_Destroysmooth_out_wake_data' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine DWM_Packsmooth_out_wake_data(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(smooth_out_wake_data), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_Packsmooth_out_wake_data' if (Buf%ErrStat >= AbortErrLev) return - ! length_velocity_array call RegPack(Buf, InData%length_velocity_array) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2284,69 +2044,51 @@ subroutine DWM_UnPacksmooth_out_wake_data(Buf, OutData) type(smooth_out_wake_data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPacksmooth_out_wake_data' if (Buf%ErrStat /= ErrID_None) return - ! length_velocity_array call RegUnpack(Buf, OutData%length_velocity_array) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE DWM_CopySWSV( SrcSWSVData, DstSWSVData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SWSV), INTENT(IN) :: SrcSWSVData - TYPE(SWSV), INTENT(INOUT) :: DstSWSVData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_CopySWSV' -! - ErrStat = ErrID_None - ErrMsg = "" - DstSWSVData%p1 = SrcSWSVData%p1 - DstSWSVData%p2 = SrcSWSVData%p2 - DstSWSVData%distance = SrcSWSVData%distance - DstSWSVData%y0 = SrcSWSVData%y0 - DstSWSVData%z0 = SrcSWSVData%z0 - DstSWSVData%unit = SrcSWSVData%unit - END SUBROUTINE DWM_CopySWSV - SUBROUTINE DWM_DestroySWSV( SWSVData, ErrStat, ErrMsg ) - TYPE(SWSV), INTENT(INOUT) :: SWSVData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroySWSV' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE DWM_DestroySWSV +subroutine DWM_CopySWSV(SrcSWSVData, DstSWSVData, CtrlCode, ErrStat, ErrMsg) + type(SWSV), intent(in) :: SrcSWSVData + type(SWSV), intent(inout) :: DstSWSVData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DWM_CopySWSV' + ErrStat = ErrID_None + ErrMsg = '' + DstSWSVData%p1 = SrcSWSVData%p1 + DstSWSVData%p2 = SrcSWSVData%p2 + DstSWSVData%distance = SrcSWSVData%distance + DstSWSVData%y0 = SrcSWSVData%y0 + DstSWSVData%z0 = SrcSWSVData%z0 + DstSWSVData%unit = SrcSWSVData%unit +end subroutine +subroutine DWM_DestroySWSV(SWSVData, ErrStat, ErrMsg) + type(SWSV), intent(inout) :: SWSVData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DWM_DestroySWSV' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine DWM_PackSWSV(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SWSV), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_PackSWSV' if (Buf%ErrStat >= AbortErrLev) return - ! p1 call RegPack(Buf, InData%p1) if (RegCheckErr(Buf, RoutineName)) return - ! p2 call RegPack(Buf, InData%p2) if (RegCheckErr(Buf, RoutineName)) return - ! distance call RegPack(Buf, InData%distance) if (RegCheckErr(Buf, RoutineName)) return - ! y0 call RegPack(Buf, InData%y0) if (RegCheckErr(Buf, RoutineName)) return - ! z0 call RegPack(Buf, InData%z0) if (RegCheckErr(Buf, RoutineName)) return - ! unit call RegPack(Buf, InData%unit) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2356,318 +2098,294 @@ subroutine DWM_UnPackSWSV(Buf, OutData) type(SWSV), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPackSWSV' if (Buf%ErrStat /= ErrID_None) return - ! p1 call RegUnpack(Buf, OutData%p1) if (RegCheckErr(Buf, RoutineName)) return - ! p2 call RegUnpack(Buf, OutData%p2) if (RegCheckErr(Buf, RoutineName)) return - ! distance call RegUnpack(Buf, OutData%distance) if (RegCheckErr(Buf, RoutineName)) return - ! y0 call RegUnpack(Buf, OutData%y0) if (RegCheckErr(Buf, RoutineName)) return - ! z0 call RegUnpack(Buf, OutData%z0) if (RegCheckErr(Buf, RoutineName)) return - ! unit call RegUnpack(Buf, OutData%unit) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE DWM_Copyread_upwind_result( Srcread_upwind_resultData, Dstread_upwind_resultData, CtrlCode, ErrStat, ErrMsg ) - TYPE(read_upwind_result), INTENT(IN) :: Srcread_upwind_resultData - TYPE(read_upwind_result), INTENT(INOUT) :: Dstread_upwind_resultData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Copyread_upwind_result' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(Srcread_upwind_resultData%upwind_U)) THEN - i1_l = LBOUND(Srcread_upwind_resultData%upwind_U,1) - i1_u = UBOUND(Srcread_upwind_resultData%upwind_U,1) - i2_l = LBOUND(Srcread_upwind_resultData%upwind_U,2) - i2_u = UBOUND(Srcread_upwind_resultData%upwind_U,2) - IF (.NOT. ALLOCATED(Dstread_upwind_resultData%upwind_U)) THEN - ALLOCATE(Dstread_upwind_resultData%upwind_U(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%upwind_U.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_upwind_resultData%upwind_U = Srcread_upwind_resultData%upwind_U -ENDIF -IF (ALLOCATED(Srcread_upwind_resultData%upwind_wakecenter)) THEN - i1_l = LBOUND(Srcread_upwind_resultData%upwind_wakecenter,1) - i1_u = UBOUND(Srcread_upwind_resultData%upwind_wakecenter,1) - i2_l = LBOUND(Srcread_upwind_resultData%upwind_wakecenter,2) - i2_u = UBOUND(Srcread_upwind_resultData%upwind_wakecenter,2) - i3_l = LBOUND(Srcread_upwind_resultData%upwind_wakecenter,3) - i3_u = UBOUND(Srcread_upwind_resultData%upwind_wakecenter,3) - i4_l = LBOUND(Srcread_upwind_resultData%upwind_wakecenter,4) - i4_u = UBOUND(Srcread_upwind_resultData%upwind_wakecenter,4) - IF (.NOT. ALLOCATED(Dstread_upwind_resultData%upwind_wakecenter)) THEN - ALLOCATE(Dstread_upwind_resultData%upwind_wakecenter(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%upwind_wakecenter.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_upwind_resultData%upwind_wakecenter = Srcread_upwind_resultData%upwind_wakecenter -ENDIF -IF (ALLOCATED(Srcread_upwind_resultData%upwind_meanU)) THEN - i1_l = LBOUND(Srcread_upwind_resultData%upwind_meanU,1) - i1_u = UBOUND(Srcread_upwind_resultData%upwind_meanU,1) - IF (.NOT. ALLOCATED(Dstread_upwind_resultData%upwind_meanU)) THEN - ALLOCATE(Dstread_upwind_resultData%upwind_meanU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%upwind_meanU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_upwind_resultData%upwind_meanU = Srcread_upwind_resultData%upwind_meanU -ENDIF -IF (ALLOCATED(Srcread_upwind_resultData%upwind_TI)) THEN - i1_l = LBOUND(Srcread_upwind_resultData%upwind_TI,1) - i1_u = UBOUND(Srcread_upwind_resultData%upwind_TI,1) - IF (.NOT. ALLOCATED(Dstread_upwind_resultData%upwind_TI)) THEN - ALLOCATE(Dstread_upwind_resultData%upwind_TI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%upwind_TI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_upwind_resultData%upwind_TI = Srcread_upwind_resultData%upwind_TI -ENDIF -IF (ALLOCATED(Srcread_upwind_resultData%upwind_small_TI)) THEN - i1_l = LBOUND(Srcread_upwind_resultData%upwind_small_TI,1) - i1_u = UBOUND(Srcread_upwind_resultData%upwind_small_TI,1) - IF (.NOT. ALLOCATED(Dstread_upwind_resultData%upwind_small_TI)) THEN - ALLOCATE(Dstread_upwind_resultData%upwind_small_TI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%upwind_small_TI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_upwind_resultData%upwind_small_TI = Srcread_upwind_resultData%upwind_small_TI -ENDIF -IF (ALLOCATED(Srcread_upwind_resultData%upwind_smoothWake)) THEN - i1_l = LBOUND(Srcread_upwind_resultData%upwind_smoothWake,1) - i1_u = UBOUND(Srcread_upwind_resultData%upwind_smoothWake,1) - i2_l = LBOUND(Srcread_upwind_resultData%upwind_smoothWake,2) - i2_u = UBOUND(Srcread_upwind_resultData%upwind_smoothWake,2) - IF (.NOT. ALLOCATED(Dstread_upwind_resultData%upwind_smoothWake)) THEN - ALLOCATE(Dstread_upwind_resultData%upwind_smoothWake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%upwind_smoothWake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_upwind_resultData%upwind_smoothWake = Srcread_upwind_resultData%upwind_smoothWake -ENDIF -IF (ALLOCATED(Srcread_upwind_resultData%velocity_aerodyn)) THEN - i1_l = LBOUND(Srcread_upwind_resultData%velocity_aerodyn,1) - i1_u = UBOUND(Srcread_upwind_resultData%velocity_aerodyn,1) - IF (.NOT. ALLOCATED(Dstread_upwind_resultData%velocity_aerodyn)) THEN - ALLOCATE(Dstread_upwind_resultData%velocity_aerodyn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%velocity_aerodyn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_upwind_resultData%velocity_aerodyn = Srcread_upwind_resultData%velocity_aerodyn -ENDIF -IF (ALLOCATED(Srcread_upwind_resultData%TI_downstream)) THEN - i1_l = LBOUND(Srcread_upwind_resultData%TI_downstream,1) - i1_u = UBOUND(Srcread_upwind_resultData%TI_downstream,1) - IF (.NOT. ALLOCATED(Dstread_upwind_resultData%TI_downstream)) THEN - ALLOCATE(Dstread_upwind_resultData%TI_downstream(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%TI_downstream.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_upwind_resultData%TI_downstream = Srcread_upwind_resultData%TI_downstream -ENDIF -IF (ALLOCATED(Srcread_upwind_resultData%small_scale_TI_downstream)) THEN - i1_l = LBOUND(Srcread_upwind_resultData%small_scale_TI_downstream,1) - i1_u = UBOUND(Srcread_upwind_resultData%small_scale_TI_downstream,1) - IF (.NOT. ALLOCATED(Dstread_upwind_resultData%small_scale_TI_downstream)) THEN - ALLOCATE(Dstread_upwind_resultData%small_scale_TI_downstream(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%small_scale_TI_downstream.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_upwind_resultData%small_scale_TI_downstream = Srcread_upwind_resultData%small_scale_TI_downstream -ENDIF -IF (ALLOCATED(Srcread_upwind_resultData%smoothed_velocity_array)) THEN - i1_l = LBOUND(Srcread_upwind_resultData%smoothed_velocity_array,1) - i1_u = UBOUND(Srcread_upwind_resultData%smoothed_velocity_array,1) - i2_l = LBOUND(Srcread_upwind_resultData%smoothed_velocity_array,2) - i2_u = UBOUND(Srcread_upwind_resultData%smoothed_velocity_array,2) - IF (.NOT. ALLOCATED(Dstread_upwind_resultData%smoothed_velocity_array)) THEN - ALLOCATE(Dstread_upwind_resultData%smoothed_velocity_array(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%smoothed_velocity_array.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_upwind_resultData%smoothed_velocity_array = Srcread_upwind_resultData%smoothed_velocity_array -ENDIF -IF (ALLOCATED(Srcread_upwind_resultData%vel_matrix)) THEN - i1_l = LBOUND(Srcread_upwind_resultData%vel_matrix,1) - i1_u = UBOUND(Srcread_upwind_resultData%vel_matrix,1) - i2_l = LBOUND(Srcread_upwind_resultData%vel_matrix,2) - i2_u = UBOUND(Srcread_upwind_resultData%vel_matrix,2) - i3_l = LBOUND(Srcread_upwind_resultData%vel_matrix,3) - i3_u = UBOUND(Srcread_upwind_resultData%vel_matrix,3) - IF (.NOT. ALLOCATED(Dstread_upwind_resultData%vel_matrix)) THEN - ALLOCATE(Dstread_upwind_resultData%vel_matrix(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%vel_matrix.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstread_upwind_resultData%vel_matrix = Srcread_upwind_resultData%vel_matrix -ENDIF - END SUBROUTINE DWM_Copyread_upwind_result - - SUBROUTINE DWM_Destroyread_upwind_result( read_upwind_resultData, ErrStat, ErrMsg ) - TYPE(read_upwind_result), INTENT(INOUT) :: read_upwind_resultData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Destroyread_upwind_result' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(read_upwind_resultData%upwind_U)) THEN - DEALLOCATE(read_upwind_resultData%upwind_U) -ENDIF -IF (ALLOCATED(read_upwind_resultData%upwind_wakecenter)) THEN - DEALLOCATE(read_upwind_resultData%upwind_wakecenter) -ENDIF -IF (ALLOCATED(read_upwind_resultData%upwind_meanU)) THEN - DEALLOCATE(read_upwind_resultData%upwind_meanU) -ENDIF -IF (ALLOCATED(read_upwind_resultData%upwind_TI)) THEN - DEALLOCATE(read_upwind_resultData%upwind_TI) -ENDIF -IF (ALLOCATED(read_upwind_resultData%upwind_small_TI)) THEN - DEALLOCATE(read_upwind_resultData%upwind_small_TI) -ENDIF -IF (ALLOCATED(read_upwind_resultData%upwind_smoothWake)) THEN - DEALLOCATE(read_upwind_resultData%upwind_smoothWake) -ENDIF -IF (ALLOCATED(read_upwind_resultData%velocity_aerodyn)) THEN - DEALLOCATE(read_upwind_resultData%velocity_aerodyn) -ENDIF -IF (ALLOCATED(read_upwind_resultData%TI_downstream)) THEN - DEALLOCATE(read_upwind_resultData%TI_downstream) -ENDIF -IF (ALLOCATED(read_upwind_resultData%small_scale_TI_downstream)) THEN - DEALLOCATE(read_upwind_resultData%small_scale_TI_downstream) -ENDIF -IF (ALLOCATED(read_upwind_resultData%smoothed_velocity_array)) THEN - DEALLOCATE(read_upwind_resultData%smoothed_velocity_array) -ENDIF -IF (ALLOCATED(read_upwind_resultData%vel_matrix)) THEN - DEALLOCATE(read_upwind_resultData%vel_matrix) -ENDIF - END SUBROUTINE DWM_Destroyread_upwind_result +subroutine DWM_Copyread_upwind_result(Srcread_upwind_resultData, Dstread_upwind_resultData, CtrlCode, ErrStat, ErrMsg) + type(read_upwind_result), intent(in) :: Srcread_upwind_resultData + type(read_upwind_result), intent(inout) :: Dstread_upwind_resultData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'DWM_Copyread_upwind_result' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(Srcread_upwind_resultData%upwind_U)) then + LB(1:2) = lbound(Srcread_upwind_resultData%upwind_U) + UB(1:2) = ubound(Srcread_upwind_resultData%upwind_U) + if (.not. allocated(Dstread_upwind_resultData%upwind_U)) then + allocate(Dstread_upwind_resultData%upwind_U(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%upwind_U.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_upwind_resultData%upwind_U = Srcread_upwind_resultData%upwind_U + else if (allocated(Dstread_upwind_resultData%upwind_U)) then + deallocate(Dstread_upwind_resultData%upwind_U) + end if + if (allocated(Srcread_upwind_resultData%upwind_wakecenter)) then + LB(1:4) = lbound(Srcread_upwind_resultData%upwind_wakecenter) + UB(1:4) = ubound(Srcread_upwind_resultData%upwind_wakecenter) + if (.not. allocated(Dstread_upwind_resultData%upwind_wakecenter)) then + allocate(Dstread_upwind_resultData%upwind_wakecenter(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%upwind_wakecenter.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_upwind_resultData%upwind_wakecenter = Srcread_upwind_resultData%upwind_wakecenter + else if (allocated(Dstread_upwind_resultData%upwind_wakecenter)) then + deallocate(Dstread_upwind_resultData%upwind_wakecenter) + end if + if (allocated(Srcread_upwind_resultData%upwind_meanU)) then + LB(1:1) = lbound(Srcread_upwind_resultData%upwind_meanU) + UB(1:1) = ubound(Srcread_upwind_resultData%upwind_meanU) + if (.not. allocated(Dstread_upwind_resultData%upwind_meanU)) then + allocate(Dstread_upwind_resultData%upwind_meanU(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%upwind_meanU.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_upwind_resultData%upwind_meanU = Srcread_upwind_resultData%upwind_meanU + else if (allocated(Dstread_upwind_resultData%upwind_meanU)) then + deallocate(Dstread_upwind_resultData%upwind_meanU) + end if + if (allocated(Srcread_upwind_resultData%upwind_TI)) then + LB(1:1) = lbound(Srcread_upwind_resultData%upwind_TI) + UB(1:1) = ubound(Srcread_upwind_resultData%upwind_TI) + if (.not. allocated(Dstread_upwind_resultData%upwind_TI)) then + allocate(Dstread_upwind_resultData%upwind_TI(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%upwind_TI.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_upwind_resultData%upwind_TI = Srcread_upwind_resultData%upwind_TI + else if (allocated(Dstread_upwind_resultData%upwind_TI)) then + deallocate(Dstread_upwind_resultData%upwind_TI) + end if + if (allocated(Srcread_upwind_resultData%upwind_small_TI)) then + LB(1:1) = lbound(Srcread_upwind_resultData%upwind_small_TI) + UB(1:1) = ubound(Srcread_upwind_resultData%upwind_small_TI) + if (.not. allocated(Dstread_upwind_resultData%upwind_small_TI)) then + allocate(Dstread_upwind_resultData%upwind_small_TI(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%upwind_small_TI.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_upwind_resultData%upwind_small_TI = Srcread_upwind_resultData%upwind_small_TI + else if (allocated(Dstread_upwind_resultData%upwind_small_TI)) then + deallocate(Dstread_upwind_resultData%upwind_small_TI) + end if + if (allocated(Srcread_upwind_resultData%upwind_smoothWake)) then + LB(1:2) = lbound(Srcread_upwind_resultData%upwind_smoothWake) + UB(1:2) = ubound(Srcread_upwind_resultData%upwind_smoothWake) + if (.not. allocated(Dstread_upwind_resultData%upwind_smoothWake)) then + allocate(Dstread_upwind_resultData%upwind_smoothWake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%upwind_smoothWake.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_upwind_resultData%upwind_smoothWake = Srcread_upwind_resultData%upwind_smoothWake + else if (allocated(Dstread_upwind_resultData%upwind_smoothWake)) then + deallocate(Dstread_upwind_resultData%upwind_smoothWake) + end if + if (allocated(Srcread_upwind_resultData%velocity_aerodyn)) then + LB(1:1) = lbound(Srcread_upwind_resultData%velocity_aerodyn) + UB(1:1) = ubound(Srcread_upwind_resultData%velocity_aerodyn) + if (.not. allocated(Dstread_upwind_resultData%velocity_aerodyn)) then + allocate(Dstread_upwind_resultData%velocity_aerodyn(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%velocity_aerodyn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_upwind_resultData%velocity_aerodyn = Srcread_upwind_resultData%velocity_aerodyn + else if (allocated(Dstread_upwind_resultData%velocity_aerodyn)) then + deallocate(Dstread_upwind_resultData%velocity_aerodyn) + end if + if (allocated(Srcread_upwind_resultData%TI_downstream)) then + LB(1:1) = lbound(Srcread_upwind_resultData%TI_downstream) + UB(1:1) = ubound(Srcread_upwind_resultData%TI_downstream) + if (.not. allocated(Dstread_upwind_resultData%TI_downstream)) then + allocate(Dstread_upwind_resultData%TI_downstream(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%TI_downstream.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_upwind_resultData%TI_downstream = Srcread_upwind_resultData%TI_downstream + else if (allocated(Dstread_upwind_resultData%TI_downstream)) then + deallocate(Dstread_upwind_resultData%TI_downstream) + end if + if (allocated(Srcread_upwind_resultData%small_scale_TI_downstream)) then + LB(1:1) = lbound(Srcread_upwind_resultData%small_scale_TI_downstream) + UB(1:1) = ubound(Srcread_upwind_resultData%small_scale_TI_downstream) + if (.not. allocated(Dstread_upwind_resultData%small_scale_TI_downstream)) then + allocate(Dstread_upwind_resultData%small_scale_TI_downstream(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%small_scale_TI_downstream.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_upwind_resultData%small_scale_TI_downstream = Srcread_upwind_resultData%small_scale_TI_downstream + else if (allocated(Dstread_upwind_resultData%small_scale_TI_downstream)) then + deallocate(Dstread_upwind_resultData%small_scale_TI_downstream) + end if + if (allocated(Srcread_upwind_resultData%smoothed_velocity_array)) then + LB(1:2) = lbound(Srcread_upwind_resultData%smoothed_velocity_array) + UB(1:2) = ubound(Srcread_upwind_resultData%smoothed_velocity_array) + if (.not. allocated(Dstread_upwind_resultData%smoothed_velocity_array)) then + allocate(Dstread_upwind_resultData%smoothed_velocity_array(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%smoothed_velocity_array.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_upwind_resultData%smoothed_velocity_array = Srcread_upwind_resultData%smoothed_velocity_array + else if (allocated(Dstread_upwind_resultData%smoothed_velocity_array)) then + deallocate(Dstread_upwind_resultData%smoothed_velocity_array) + end if + if (allocated(Srcread_upwind_resultData%vel_matrix)) then + LB(1:3) = lbound(Srcread_upwind_resultData%vel_matrix) + UB(1:3) = ubound(Srcread_upwind_resultData%vel_matrix) + if (.not. allocated(Dstread_upwind_resultData%vel_matrix)) then + allocate(Dstread_upwind_resultData%vel_matrix(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstread_upwind_resultData%vel_matrix.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstread_upwind_resultData%vel_matrix = Srcread_upwind_resultData%vel_matrix + else if (allocated(Dstread_upwind_resultData%vel_matrix)) then + deallocate(Dstread_upwind_resultData%vel_matrix) + end if +end subroutine +subroutine DWM_Destroyread_upwind_result(read_upwind_resultData, ErrStat, ErrMsg) + type(read_upwind_result), intent(inout) :: read_upwind_resultData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DWM_Destroyread_upwind_result' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(read_upwind_resultData%upwind_U)) then + deallocate(read_upwind_resultData%upwind_U) + end if + if (allocated(read_upwind_resultData%upwind_wakecenter)) then + deallocate(read_upwind_resultData%upwind_wakecenter) + end if + if (allocated(read_upwind_resultData%upwind_meanU)) then + deallocate(read_upwind_resultData%upwind_meanU) + end if + if (allocated(read_upwind_resultData%upwind_TI)) then + deallocate(read_upwind_resultData%upwind_TI) + end if + if (allocated(read_upwind_resultData%upwind_small_TI)) then + deallocate(read_upwind_resultData%upwind_small_TI) + end if + if (allocated(read_upwind_resultData%upwind_smoothWake)) then + deallocate(read_upwind_resultData%upwind_smoothWake) + end if + if (allocated(read_upwind_resultData%velocity_aerodyn)) then + deallocate(read_upwind_resultData%velocity_aerodyn) + end if + if (allocated(read_upwind_resultData%TI_downstream)) then + deallocate(read_upwind_resultData%TI_downstream) + end if + if (allocated(read_upwind_resultData%small_scale_TI_downstream)) then + deallocate(read_upwind_resultData%small_scale_TI_downstream) + end if + if (allocated(read_upwind_resultData%smoothed_velocity_array)) then + deallocate(read_upwind_resultData%smoothed_velocity_array) + end if + if (allocated(read_upwind_resultData%vel_matrix)) then + deallocate(read_upwind_resultData%vel_matrix) + end if +end subroutine subroutine DWM_Packread_upwind_result(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(read_upwind_result), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_Packread_upwind_result' if (Buf%ErrStat >= AbortErrLev) return - ! upwind_U call RegPack(Buf, allocated(InData%upwind_U)) if (allocated(InData%upwind_U)) then call RegPackBounds(Buf, 2, lbound(InData%upwind_U), ubound(InData%upwind_U)) call RegPack(Buf, InData%upwind_U) end if if (RegCheckErr(Buf, RoutineName)) return - ! upwind_wakecenter call RegPack(Buf, allocated(InData%upwind_wakecenter)) if (allocated(InData%upwind_wakecenter)) then call RegPackBounds(Buf, 4, lbound(InData%upwind_wakecenter), ubound(InData%upwind_wakecenter)) call RegPack(Buf, InData%upwind_wakecenter) end if if (RegCheckErr(Buf, RoutineName)) return - ! upwind_meanU call RegPack(Buf, allocated(InData%upwind_meanU)) if (allocated(InData%upwind_meanU)) then call RegPackBounds(Buf, 1, lbound(InData%upwind_meanU), ubound(InData%upwind_meanU)) call RegPack(Buf, InData%upwind_meanU) end if if (RegCheckErr(Buf, RoutineName)) return - ! upwind_TI call RegPack(Buf, allocated(InData%upwind_TI)) if (allocated(InData%upwind_TI)) then call RegPackBounds(Buf, 1, lbound(InData%upwind_TI), ubound(InData%upwind_TI)) call RegPack(Buf, InData%upwind_TI) end if if (RegCheckErr(Buf, RoutineName)) return - ! upwind_small_TI call RegPack(Buf, allocated(InData%upwind_small_TI)) if (allocated(InData%upwind_small_TI)) then call RegPackBounds(Buf, 1, lbound(InData%upwind_small_TI), ubound(InData%upwind_small_TI)) call RegPack(Buf, InData%upwind_small_TI) end if if (RegCheckErr(Buf, RoutineName)) return - ! upwind_smoothWake call RegPack(Buf, allocated(InData%upwind_smoothWake)) if (allocated(InData%upwind_smoothWake)) then call RegPackBounds(Buf, 2, lbound(InData%upwind_smoothWake), ubound(InData%upwind_smoothWake)) call RegPack(Buf, InData%upwind_smoothWake) end if if (RegCheckErr(Buf, RoutineName)) return - ! velocity_aerodyn call RegPack(Buf, allocated(InData%velocity_aerodyn)) if (allocated(InData%velocity_aerodyn)) then call RegPackBounds(Buf, 1, lbound(InData%velocity_aerodyn), ubound(InData%velocity_aerodyn)) call RegPack(Buf, InData%velocity_aerodyn) end if if (RegCheckErr(Buf, RoutineName)) return - ! TI_downstream call RegPack(Buf, allocated(InData%TI_downstream)) if (allocated(InData%TI_downstream)) then call RegPackBounds(Buf, 1, lbound(InData%TI_downstream), ubound(InData%TI_downstream)) call RegPack(Buf, InData%TI_downstream) end if if (RegCheckErr(Buf, RoutineName)) return - ! small_scale_TI_downstream call RegPack(Buf, allocated(InData%small_scale_TI_downstream)) if (allocated(InData%small_scale_TI_downstream)) then call RegPackBounds(Buf, 1, lbound(InData%small_scale_TI_downstream), ubound(InData%small_scale_TI_downstream)) call RegPack(Buf, InData%small_scale_TI_downstream) end if if (RegCheckErr(Buf, RoutineName)) return - ! smoothed_velocity_array call RegPack(Buf, allocated(InData%smoothed_velocity_array)) if (allocated(InData%smoothed_velocity_array)) then call RegPackBounds(Buf, 2, lbound(InData%smoothed_velocity_array), ubound(InData%smoothed_velocity_array)) call RegPack(Buf, InData%smoothed_velocity_array) end if if (RegCheckErr(Buf, RoutineName)) return - ! vel_matrix call RegPack(Buf, allocated(InData%vel_matrix)) if (allocated(InData%vel_matrix)) then call RegPackBounds(Buf, 3, lbound(InData%vel_matrix), ubound(InData%vel_matrix)) @@ -2684,7 +2402,6 @@ subroutine DWM_UnPackread_upwind_result(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! upwind_U if (allocated(OutData%upwind_U)) deallocate(OutData%upwind_U) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2699,7 +2416,6 @@ subroutine DWM_UnPackread_upwind_result(Buf, OutData) call RegUnpack(Buf, OutData%upwind_U) if (RegCheckErr(Buf, RoutineName)) return end if - ! upwind_wakecenter if (allocated(OutData%upwind_wakecenter)) deallocate(OutData%upwind_wakecenter) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2714,7 +2430,6 @@ subroutine DWM_UnPackread_upwind_result(Buf, OutData) call RegUnpack(Buf, OutData%upwind_wakecenter) if (RegCheckErr(Buf, RoutineName)) return end if - ! upwind_meanU if (allocated(OutData%upwind_meanU)) deallocate(OutData%upwind_meanU) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2729,7 +2444,6 @@ subroutine DWM_UnPackread_upwind_result(Buf, OutData) call RegUnpack(Buf, OutData%upwind_meanU) if (RegCheckErr(Buf, RoutineName)) return end if - ! upwind_TI if (allocated(OutData%upwind_TI)) deallocate(OutData%upwind_TI) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2744,7 +2458,6 @@ subroutine DWM_UnPackread_upwind_result(Buf, OutData) call RegUnpack(Buf, OutData%upwind_TI) if (RegCheckErr(Buf, RoutineName)) return end if - ! upwind_small_TI if (allocated(OutData%upwind_small_TI)) deallocate(OutData%upwind_small_TI) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2759,7 +2472,6 @@ subroutine DWM_UnPackread_upwind_result(Buf, OutData) call RegUnpack(Buf, OutData%upwind_small_TI) if (RegCheckErr(Buf, RoutineName)) return end if - ! upwind_smoothWake if (allocated(OutData%upwind_smoothWake)) deallocate(OutData%upwind_smoothWake) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2774,7 +2486,6 @@ subroutine DWM_UnPackread_upwind_result(Buf, OutData) call RegUnpack(Buf, OutData%upwind_smoothWake) if (RegCheckErr(Buf, RoutineName)) return end if - ! velocity_aerodyn if (allocated(OutData%velocity_aerodyn)) deallocate(OutData%velocity_aerodyn) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2789,7 +2500,6 @@ subroutine DWM_UnPackread_upwind_result(Buf, OutData) call RegUnpack(Buf, OutData%velocity_aerodyn) if (RegCheckErr(Buf, RoutineName)) return end if - ! TI_downstream if (allocated(OutData%TI_downstream)) deallocate(OutData%TI_downstream) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2804,7 +2514,6 @@ subroutine DWM_UnPackread_upwind_result(Buf, OutData) call RegUnpack(Buf, OutData%TI_downstream) if (RegCheckErr(Buf, RoutineName)) return end if - ! small_scale_TI_downstream if (allocated(OutData%small_scale_TI_downstream)) deallocate(OutData%small_scale_TI_downstream) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2819,7 +2528,6 @@ subroutine DWM_UnPackread_upwind_result(Buf, OutData) call RegUnpack(Buf, OutData%small_scale_TI_downstream) if (RegCheckErr(Buf, RoutineName)) return end if - ! smoothed_velocity_array if (allocated(OutData%smoothed_velocity_array)) deallocate(OutData%smoothed_velocity_array) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2834,7 +2542,6 @@ subroutine DWM_UnPackread_upwind_result(Buf, OutData) call RegUnpack(Buf, OutData%smoothed_velocity_array) if (RegCheckErr(Buf, RoutineName)) return end if - ! vel_matrix if (allocated(OutData%vel_matrix)) deallocate(OutData%vel_matrix) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2850,60 +2557,51 @@ subroutine DWM_UnPackread_upwind_result(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE DWM_Copywake_meandered_center( Srcwake_meandered_centerData, Dstwake_meandered_centerData, CtrlCode, ErrStat, ErrMsg ) - TYPE(wake_meandered_center), INTENT(IN) :: Srcwake_meandered_centerData - TYPE(wake_meandered_center), INTENT(INOUT) :: Dstwake_meandered_centerData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Copywake_meandered_center' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(Srcwake_meandered_centerData%wake_width)) THEN - i1_l = LBOUND(Srcwake_meandered_centerData%wake_width,1) - i1_u = UBOUND(Srcwake_meandered_centerData%wake_width,1) - IF (.NOT. ALLOCATED(Dstwake_meandered_centerData%wake_width)) THEN - ALLOCATE(Dstwake_meandered_centerData%wake_width(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Dstwake_meandered_centerData%wake_width.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - Dstwake_meandered_centerData%wake_width = Srcwake_meandered_centerData%wake_width -ENDIF - END SUBROUTINE DWM_Copywake_meandered_center - SUBROUTINE DWM_Destroywake_meandered_center( wake_meandered_centerData, ErrStat, ErrMsg ) - TYPE(wake_meandered_center), INTENT(INOUT) :: wake_meandered_centerData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Destroywake_meandered_center' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(wake_meandered_centerData%wake_width)) THEN - DEALLOCATE(wake_meandered_centerData%wake_width) -ENDIF - END SUBROUTINE DWM_Destroywake_meandered_center +subroutine DWM_Copywake_meandered_center(Srcwake_meandered_centerData, Dstwake_meandered_centerData, CtrlCode, ErrStat, ErrMsg) + type(wake_meandered_center), intent(in) :: Srcwake_meandered_centerData + type(wake_meandered_center), intent(inout) :: Dstwake_meandered_centerData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'DWM_Copywake_meandered_center' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(Srcwake_meandered_centerData%wake_width)) then + LB(1:1) = lbound(Srcwake_meandered_centerData%wake_width) + UB(1:1) = ubound(Srcwake_meandered_centerData%wake_width) + if (.not. allocated(Dstwake_meandered_centerData%wake_width)) then + allocate(Dstwake_meandered_centerData%wake_width(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating Dstwake_meandered_centerData%wake_width.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + Dstwake_meandered_centerData%wake_width = Srcwake_meandered_centerData%wake_width + else if (allocated(Dstwake_meandered_centerData%wake_width)) then + deallocate(Dstwake_meandered_centerData%wake_width) + end if +end subroutine +subroutine DWM_Destroywake_meandered_center(wake_meandered_centerData, ErrStat, ErrMsg) + type(wake_meandered_center), intent(inout) :: wake_meandered_centerData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DWM_Destroywake_meandered_center' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(wake_meandered_centerData%wake_width)) then + deallocate(wake_meandered_centerData%wake_width) + end if +end subroutine subroutine DWM_Packwake_meandered_center(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(wake_meandered_center), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_Packwake_meandered_center' if (Buf%ErrStat >= AbortErrLev) return - ! wake_width call RegPack(Buf, allocated(InData%wake_width)) if (allocated(InData%wake_width)) then call RegPackBounds(Buf, 1, lbound(InData%wake_width), ubound(InData%wake_width)) @@ -2920,7 +2618,6 @@ subroutine DWM_UnPackwake_meandered_center(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! wake_width if (allocated(OutData%wake_width)) deallocate(OutData%wake_width) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2936,53 +2633,39 @@ subroutine DWM_UnPackwake_meandered_center(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE DWM_Copyturbine_blade( Srcturbine_bladeData, Dstturbine_bladeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DWM_turbine_blade), INTENT(IN) :: Srcturbine_bladeData - TYPE(DWM_turbine_blade), INTENT(INOUT) :: Dstturbine_bladeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Copyturbine_blade' -! - ErrStat = ErrID_None - ErrMsg = "" - Dstturbine_bladeData%Aerodyn_turbine_num = Srcturbine_bladeData%Aerodyn_turbine_num - Dstturbine_bladeData%Blade_index = Srcturbine_bladeData%Blade_index - Dstturbine_bladeData%Element_index = Srcturbine_bladeData%Element_index - END SUBROUTINE DWM_Copyturbine_blade - - SUBROUTINE DWM_Destroyturbine_blade( turbine_bladeData, ErrStat, ErrMsg ) - TYPE(DWM_turbine_blade), INTENT(INOUT) :: turbine_bladeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Destroyturbine_blade' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE DWM_Destroyturbine_blade +subroutine DWM_Copyturbine_blade(Srcturbine_bladeData, Dstturbine_bladeData, CtrlCode, ErrStat, ErrMsg) + type(DWM_turbine_blade), intent(in) :: Srcturbine_bladeData + type(DWM_turbine_blade), intent(inout) :: Dstturbine_bladeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DWM_Copyturbine_blade' + ErrStat = ErrID_None + ErrMsg = '' + Dstturbine_bladeData%Aerodyn_turbine_num = Srcturbine_bladeData%Aerodyn_turbine_num + Dstturbine_bladeData%Blade_index = Srcturbine_bladeData%Blade_index + Dstturbine_bladeData%Element_index = Srcturbine_bladeData%Element_index +end subroutine +subroutine DWM_Destroyturbine_blade(turbine_bladeData, ErrStat, ErrMsg) + type(DWM_turbine_blade), intent(inout) :: turbine_bladeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'DWM_Destroyturbine_blade' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine DWM_Packturbine_blade(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(DWM_turbine_blade), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_Packturbine_blade' if (Buf%ErrStat >= AbortErrLev) return - ! Aerodyn_turbine_num call RegPack(Buf, InData%Aerodyn_turbine_num) if (RegCheckErr(Buf, RoutineName)) return - ! Blade_index call RegPack(Buf, InData%Blade_index) if (RegCheckErr(Buf, RoutineName)) return - ! Element_index call RegPack(Buf, InData%Element_index) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2992,246 +2675,207 @@ subroutine DWM_UnPackturbine_blade(Buf, OutData) type(DWM_turbine_blade), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPackturbine_blade' if (Buf%ErrStat /= ErrID_None) return - ! Aerodyn_turbine_num call RegUnpack(Buf, OutData%Aerodyn_turbine_num) if (RegCheckErr(Buf, RoutineName)) return - ! Blade_index call RegUnpack(Buf, OutData%Blade_index) if (RegCheckErr(Buf, RoutineName)) return - ! Element_index call RegUnpack(Buf, OutData%Element_index) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE DWM_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DWM_ParameterType), INTENT(IN) :: SrcParamData - TYPE(DWM_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcParamData%velocityU)) THEN - i1_l = LBOUND(SrcParamData%velocityU,1) - i1_u = UBOUND(SrcParamData%velocityU,1) - IF (.NOT. ALLOCATED(DstParamData%velocityU)) THEN - ALLOCATE(DstParamData%velocityU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%velocityU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%velocityU = SrcParamData%velocityU -ENDIF -IF (ALLOCATED(SrcParamData%smoothed_wake)) THEN - i1_l = LBOUND(SrcParamData%smoothed_wake,1) - i1_u = UBOUND(SrcParamData%smoothed_wake,1) - IF (.NOT. ALLOCATED(DstParamData%smoothed_wake)) THEN - ALLOCATE(DstParamData%smoothed_wake(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%smoothed_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%smoothed_wake = SrcParamData%smoothed_wake -ENDIF -IF (ALLOCATED(SrcParamData%WakePosition)) THEN - i1_l = LBOUND(SrcParamData%WakePosition,1) - i1_u = UBOUND(SrcParamData%WakePosition,1) - i2_l = LBOUND(SrcParamData%WakePosition,2) - i2_u = UBOUND(SrcParamData%WakePosition,2) - i3_l = LBOUND(SrcParamData%WakePosition,3) - i3_u = UBOUND(SrcParamData%WakePosition,3) - IF (.NOT. ALLOCATED(DstParamData%WakePosition)) THEN - ALLOCATE(DstParamData%WakePosition(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WakePosition.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WakePosition = SrcParamData%WakePosition -ENDIF - DstParamData%WakePosition_1 = SrcParamData%WakePosition_1 - DstParamData%WakePosition_2 = SrcParamData%WakePosition_2 - DstParamData%smooth_flag = SrcParamData%smooth_flag - DstParamData%p_p_r = SrcParamData%p_p_r - DstParamData%NumWT = SrcParamData%NumWT - DstParamData%Tinfluencer = SrcParamData%Tinfluencer - DstParamData%RotorR = SrcParamData%RotorR - DstParamData%r_domain = SrcParamData%r_domain - DstParamData%x_domain = SrcParamData%x_domain - DstParamData%Uambient = SrcParamData%Uambient - DstParamData%TI_amb = SrcParamData%TI_amb - DstParamData%TI_wake = SrcParamData%TI_wake - DstParamData%hub_height = SrcParamData%hub_height - DstParamData%length_velocityU = SrcParamData%length_velocityU - DstParamData%WFLowerBd = SrcParamData%WFLowerBd - DstParamData%Wind_file_Mean_u = SrcParamData%Wind_file_Mean_u - DstParamData%Winddir = SrcParamData%Winddir - DstParamData%air_density = SrcParamData%air_density - DstParamData%RR = SrcParamData%RR -IF (ALLOCATED(SrcParamData%ElementRad)) THEN - i1_l = LBOUND(SrcParamData%ElementRad,1) - i1_u = UBOUND(SrcParamData%ElementRad,1) - IF (.NOT. ALLOCATED(DstParamData%ElementRad)) THEN - ALLOCATE(DstParamData%ElementRad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ElementRad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ElementRad = SrcParamData%ElementRad -ENDIF - DstParamData%Bnum = SrcParamData%Bnum - DstParamData%ElementNum = SrcParamData%ElementNum - CALL DWM_Copyread_turbine_position_data( SrcParamData%RTPD, DstParamData%RTPD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyParam( SrcParamData%IfW, DstParamData%IfW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE DWM_CopyParam - - SUBROUTINE DWM_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(DWM_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(ParamData%velocityU)) THEN - DEALLOCATE(ParamData%velocityU) -ENDIF -IF (ALLOCATED(ParamData%smoothed_wake)) THEN - DEALLOCATE(ParamData%smoothed_wake) -ENDIF -IF (ALLOCATED(ParamData%WakePosition)) THEN - DEALLOCATE(ParamData%WakePosition) -ENDIF -IF (ALLOCATED(ParamData%ElementRad)) THEN - DEALLOCATE(ParamData%ElementRad) -ENDIF - CALL DWM_Destroyread_turbine_position_data( ParamData%RTPD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyParam( ParamData%IfW, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE DWM_DestroyParam +subroutine DWM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(DWM_ParameterType), intent(in) :: SrcParamData + type(DWM_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DWM_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcParamData%velocityU)) then + LB(1:1) = lbound(SrcParamData%velocityU) + UB(1:1) = ubound(SrcParamData%velocityU) + if (.not. allocated(DstParamData%velocityU)) then + allocate(DstParamData%velocityU(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%velocityU.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%velocityU = SrcParamData%velocityU + else if (allocated(DstParamData%velocityU)) then + deallocate(DstParamData%velocityU) + end if + if (allocated(SrcParamData%smoothed_wake)) then + LB(1:1) = lbound(SrcParamData%smoothed_wake) + UB(1:1) = ubound(SrcParamData%smoothed_wake) + if (.not. allocated(DstParamData%smoothed_wake)) then + allocate(DstParamData%smoothed_wake(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%smoothed_wake.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%smoothed_wake = SrcParamData%smoothed_wake + else if (allocated(DstParamData%smoothed_wake)) then + deallocate(DstParamData%smoothed_wake) + end if + if (allocated(SrcParamData%WakePosition)) then + LB(1:3) = lbound(SrcParamData%WakePosition) + UB(1:3) = ubound(SrcParamData%WakePosition) + if (.not. allocated(DstParamData%WakePosition)) then + allocate(DstParamData%WakePosition(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WakePosition.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WakePosition = SrcParamData%WakePosition + else if (allocated(DstParamData%WakePosition)) then + deallocate(DstParamData%WakePosition) + end if + DstParamData%WakePosition_1 = SrcParamData%WakePosition_1 + DstParamData%WakePosition_2 = SrcParamData%WakePosition_2 + DstParamData%smooth_flag = SrcParamData%smooth_flag + DstParamData%p_p_r = SrcParamData%p_p_r + DstParamData%NumWT = SrcParamData%NumWT + DstParamData%Tinfluencer = SrcParamData%Tinfluencer + DstParamData%RotorR = SrcParamData%RotorR + DstParamData%r_domain = SrcParamData%r_domain + DstParamData%x_domain = SrcParamData%x_domain + DstParamData%Uambient = SrcParamData%Uambient + DstParamData%TI_amb = SrcParamData%TI_amb + DstParamData%TI_wake = SrcParamData%TI_wake + DstParamData%hub_height = SrcParamData%hub_height + DstParamData%length_velocityU = SrcParamData%length_velocityU + DstParamData%WFLowerBd = SrcParamData%WFLowerBd + DstParamData%Wind_file_Mean_u = SrcParamData%Wind_file_Mean_u + DstParamData%Winddir = SrcParamData%Winddir + DstParamData%air_density = SrcParamData%air_density + DstParamData%RR = SrcParamData%RR + if (allocated(SrcParamData%ElementRad)) then + LB(1:1) = lbound(SrcParamData%ElementRad) + UB(1:1) = ubound(SrcParamData%ElementRad) + if (.not. allocated(DstParamData%ElementRad)) then + allocate(DstParamData%ElementRad(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ElementRad.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%ElementRad = SrcParamData%ElementRad + else if (allocated(DstParamData%ElementRad)) then + deallocate(DstParamData%ElementRad) + end if + DstParamData%Bnum = SrcParamData%Bnum + DstParamData%ElementNum = SrcParamData%ElementNum + call DWM_Copyread_turbine_position_data(SrcParamData%RTPD, DstParamData%RTPD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyParam(SrcParamData%IfW, DstParamData%IfW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine DWM_DestroyParam(ParamData, ErrStat, ErrMsg) + type(DWM_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DWM_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%velocityU)) then + deallocate(ParamData%velocityU) + end if + if (allocated(ParamData%smoothed_wake)) then + deallocate(ParamData%smoothed_wake) + end if + if (allocated(ParamData%WakePosition)) then + deallocate(ParamData%WakePosition) + end if + if (allocated(ParamData%ElementRad)) then + deallocate(ParamData%ElementRad) + end if +end subroutine subroutine DWM_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(DWM_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_PackParam' if (Buf%ErrStat >= AbortErrLev) return - ! velocityU call RegPack(Buf, allocated(InData%velocityU)) if (allocated(InData%velocityU)) then call RegPackBounds(Buf, 1, lbound(InData%velocityU), ubound(InData%velocityU)) call RegPack(Buf, InData%velocityU) end if if (RegCheckErr(Buf, RoutineName)) return - ! smoothed_wake call RegPack(Buf, allocated(InData%smoothed_wake)) if (allocated(InData%smoothed_wake)) then call RegPackBounds(Buf, 1, lbound(InData%smoothed_wake), ubound(InData%smoothed_wake)) call RegPack(Buf, InData%smoothed_wake) end if if (RegCheckErr(Buf, RoutineName)) return - ! WakePosition call RegPack(Buf, allocated(InData%WakePosition)) if (allocated(InData%WakePosition)) then call RegPackBounds(Buf, 3, lbound(InData%WakePosition), ubound(InData%WakePosition)) call RegPack(Buf, InData%WakePosition) end if if (RegCheckErr(Buf, RoutineName)) return - ! WakePosition_1 call RegPack(Buf, InData%WakePosition_1) if (RegCheckErr(Buf, RoutineName)) return - ! WakePosition_2 call RegPack(Buf, InData%WakePosition_2) if (RegCheckErr(Buf, RoutineName)) return - ! smooth_flag call RegPack(Buf, InData%smooth_flag) if (RegCheckErr(Buf, RoutineName)) return - ! p_p_r call RegPack(Buf, InData%p_p_r) if (RegCheckErr(Buf, RoutineName)) return - ! NumWT call RegPack(Buf, InData%NumWT) if (RegCheckErr(Buf, RoutineName)) return - ! Tinfluencer call RegPack(Buf, InData%Tinfluencer) if (RegCheckErr(Buf, RoutineName)) return - ! RotorR call RegPack(Buf, InData%RotorR) if (RegCheckErr(Buf, RoutineName)) return - ! r_domain call RegPack(Buf, InData%r_domain) if (RegCheckErr(Buf, RoutineName)) return - ! x_domain call RegPack(Buf, InData%x_domain) if (RegCheckErr(Buf, RoutineName)) return - ! Uambient call RegPack(Buf, InData%Uambient) if (RegCheckErr(Buf, RoutineName)) return - ! TI_amb call RegPack(Buf, InData%TI_amb) if (RegCheckErr(Buf, RoutineName)) return - ! TI_wake call RegPack(Buf, InData%TI_wake) if (RegCheckErr(Buf, RoutineName)) return - ! hub_height call RegPack(Buf, InData%hub_height) if (RegCheckErr(Buf, RoutineName)) return - ! length_velocityU call RegPack(Buf, InData%length_velocityU) if (RegCheckErr(Buf, RoutineName)) return - ! WFLowerBd call RegPack(Buf, InData%WFLowerBd) if (RegCheckErr(Buf, RoutineName)) return - ! Wind_file_Mean_u call RegPack(Buf, InData%Wind_file_Mean_u) if (RegCheckErr(Buf, RoutineName)) return - ! Winddir call RegPack(Buf, InData%Winddir) if (RegCheckErr(Buf, RoutineName)) return - ! air_density call RegPack(Buf, InData%air_density) if (RegCheckErr(Buf, RoutineName)) return - ! RR call RegPack(Buf, InData%RR) if (RegCheckErr(Buf, RoutineName)) return - ! ElementRad call RegPack(Buf, allocated(InData%ElementRad)) if (allocated(InData%ElementRad)) then call RegPackBounds(Buf, 1, lbound(InData%ElementRad), ubound(InData%ElementRad)) call RegPack(Buf, InData%ElementRad) end if if (RegCheckErr(Buf, RoutineName)) return - ! Bnum call RegPack(Buf, InData%Bnum) if (RegCheckErr(Buf, RoutineName)) return - ! ElementNum call RegPack(Buf, InData%ElementNum) if (RegCheckErr(Buf, RoutineName)) return - ! RTPD call DWM_Packread_turbine_position_data(Buf, InData%RTPD) if (RegCheckErr(Buf, RoutineName)) return - ! IfW call InflowWind_PackParam(Buf, InData%IfW) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3244,7 +2888,6 @@ subroutine DWM_UnPackParam(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! velocityU if (allocated(OutData%velocityU)) deallocate(OutData%velocityU) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3259,7 +2902,6 @@ subroutine DWM_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%velocityU) if (RegCheckErr(Buf, RoutineName)) return end if - ! smoothed_wake if (allocated(OutData%smoothed_wake)) deallocate(OutData%smoothed_wake) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3274,7 +2916,6 @@ subroutine DWM_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%smoothed_wake) if (RegCheckErr(Buf, RoutineName)) return end if - ! WakePosition if (allocated(OutData%WakePosition)) deallocate(OutData%WakePosition) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3289,64 +2930,44 @@ subroutine DWM_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%WakePosition) if (RegCheckErr(Buf, RoutineName)) return end if - ! WakePosition_1 call RegUnpack(Buf, OutData%WakePosition_1) if (RegCheckErr(Buf, RoutineName)) return - ! WakePosition_2 call RegUnpack(Buf, OutData%WakePosition_2) if (RegCheckErr(Buf, RoutineName)) return - ! smooth_flag call RegUnpack(Buf, OutData%smooth_flag) if (RegCheckErr(Buf, RoutineName)) return - ! p_p_r call RegUnpack(Buf, OutData%p_p_r) if (RegCheckErr(Buf, RoutineName)) return - ! NumWT call RegUnpack(Buf, OutData%NumWT) if (RegCheckErr(Buf, RoutineName)) return - ! Tinfluencer call RegUnpack(Buf, OutData%Tinfluencer) if (RegCheckErr(Buf, RoutineName)) return - ! RotorR call RegUnpack(Buf, OutData%RotorR) if (RegCheckErr(Buf, RoutineName)) return - ! r_domain call RegUnpack(Buf, OutData%r_domain) if (RegCheckErr(Buf, RoutineName)) return - ! x_domain call RegUnpack(Buf, OutData%x_domain) if (RegCheckErr(Buf, RoutineName)) return - ! Uambient call RegUnpack(Buf, OutData%Uambient) if (RegCheckErr(Buf, RoutineName)) return - ! TI_amb call RegUnpack(Buf, OutData%TI_amb) if (RegCheckErr(Buf, RoutineName)) return - ! TI_wake call RegUnpack(Buf, OutData%TI_wake) if (RegCheckErr(Buf, RoutineName)) return - ! hub_height call RegUnpack(Buf, OutData%hub_height) if (RegCheckErr(Buf, RoutineName)) return - ! length_velocityU call RegUnpack(Buf, OutData%length_velocityU) if (RegCheckErr(Buf, RoutineName)) return - ! WFLowerBd call RegUnpack(Buf, OutData%WFLowerBd) if (RegCheckErr(Buf, RoutineName)) return - ! Wind_file_Mean_u call RegUnpack(Buf, OutData%Wind_file_Mean_u) if (RegCheckErr(Buf, RoutineName)) return - ! Winddir call RegUnpack(Buf, OutData%Winddir) if (RegCheckErr(Buf, RoutineName)) return - ! air_density call RegUnpack(Buf, OutData%air_density) if (RegCheckErr(Buf, RoutineName)) return - ! RR call RegUnpack(Buf, OutData%RR) if (RegCheckErr(Buf, RoutineName)) return - ! ElementRad if (allocated(OutData%ElementRad)) deallocate(OutData%ElementRad) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3361,60 +2982,46 @@ subroutine DWM_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%ElementRad) if (RegCheckErr(Buf, RoutineName)) return end if - ! Bnum call RegUnpack(Buf, OutData%Bnum) if (RegCheckErr(Buf, RoutineName)) return - ! ElementNum call RegUnpack(Buf, OutData%ElementNum) if (RegCheckErr(Buf, RoutineName)) return - ! RTPD call DWM_Unpackread_turbine_position_data(Buf, OutData%RTPD) ! RTPD - ! IfW call InflowWind_UnpackParam(Buf, OutData%IfW) ! IfW end subroutine - SUBROUTINE DWM_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DWM_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(DWM_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL InflowWind_CopyOtherState( SrcOtherStateData%IfW, DstOtherStateData%IfW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE DWM_CopyOtherState - SUBROUTINE DWM_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(DWM_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL InflowWind_DestroyOtherState( OtherStateData%IfW, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE DWM_DestroyOtherState +subroutine DWM_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(DWM_OtherStateType), intent(in) :: SrcOtherStateData + type(DWM_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DWM_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + call InflowWind_CopyOtherState(SrcOtherStateData%IfW, DstOtherStateData%IfW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine DWM_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(DWM_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DWM_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine DWM_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(DWM_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_PackOtherState' if (Buf%ErrStat >= AbortErrLev) return - ! IfW call InflowWind_PackOtherState(Buf, InData%IfW) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3424,240 +3031,181 @@ subroutine DWM_UnPackOtherState(Buf, OutData) type(DWM_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPackOtherState' if (Buf%ErrStat /= ErrID_None) return - ! IfW call InflowWind_UnpackOtherState(Buf, OutData%IfW) ! IfW end subroutine - SUBROUTINE DWM_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DWM_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(DWM_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL InflowWind_CopyMisc( SrcMiscData%IfW, DstMiscData%IfW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstMiscData%position_y = SrcMiscData%position_y - DstMiscData%position_z = SrcMiscData%position_z - DstMiscData%velocity_wake_mean = SrcMiscData%velocity_wake_mean - DstMiscData%shifted_velocity_Aerodyn = SrcMiscData%shifted_velocity_Aerodyn - DstMiscData%U_velocity = SrcMiscData%U_velocity - DstMiscData%V_velocity = SrcMiscData%V_velocity -IF (ALLOCATED(SrcMiscData%Nforce)) THEN - i1_l = LBOUND(SrcMiscData%Nforce,1) - i1_u = UBOUND(SrcMiscData%Nforce,1) - i2_l = LBOUND(SrcMiscData%Nforce,2) - i2_u = UBOUND(SrcMiscData%Nforce,2) - IF (.NOT. ALLOCATED(DstMiscData%Nforce)) THEN - ALLOCATE(DstMiscData%Nforce(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Nforce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Nforce = SrcMiscData%Nforce -ENDIF -IF (ALLOCATED(SrcMiscData%blade_dr)) THEN - i1_l = LBOUND(SrcMiscData%blade_dr,1) - i1_u = UBOUND(SrcMiscData%blade_dr,1) - IF (.NOT. ALLOCATED(DstMiscData%blade_dr)) THEN - ALLOCATE(DstMiscData%blade_dr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%blade_dr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%blade_dr = SrcMiscData%blade_dr -ENDIF - DstMiscData%NacYaw = SrcMiscData%NacYaw - DstMiscData%TI_original = SrcMiscData%TI_original - CALL DWM_Copyturbine_average_velocity_data( SrcMiscData%TAVD, DstMiscData%TAVD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DWM_Copycvsd( SrcMiscData%CalVelScale_data, DstMiscData%CalVelScale_data, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DWM_Copymeanderdata( SrcMiscData%meandering_data, DstMiscData%meandering_data, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DWM_Copyweimethod( SrcMiscData%weighting_method, DstMiscData%weighting_method, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DWM_Copytidownstream( SrcMiscData%TI_downstream_data, DstMiscData%TI_downstream_data, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DWM_Copyturbkaimal( SrcMiscData%Turbulence_KS, DstMiscData%Turbulence_KS, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DWM_Copyshinozuka( SrcMiscData%shinozuka_data, DstMiscData%shinozuka_data, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DWM_Copysmooth_out_wake_data( SrcMiscData%SmoothOut, DstMiscData%SmoothOut, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DWM_Copyswsv( SrcMiscData%smooth_wake_shifted_velocity_data, DstMiscData%smooth_wake_shifted_velocity_data, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DWM_Copywake_deficit_data( SrcMiscData%DWDD, DstMiscData%DWDD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstMiscData%ct_tilde = SrcMiscData%ct_tilde - DstMiscData%FAST_Time = SrcMiscData%FAST_Time - DstMiscData%SDtimestep = SrcMiscData%SDtimestep - CALL DWM_Copyturbine_blade( SrcMiscData%DWM_tb, DstMiscData%DWM_tb, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL DWM_Copywake_meandered_center( SrcMiscData%WMC, DstMiscData%WMC, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE DWM_CopyMisc - - SUBROUTINE DWM_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(DWM_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyMisc' - ErrStat = ErrID_None - ErrMsg = "" - - CALL InflowWind_DestroyMisc( MiscData%IfW, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MiscData%Nforce)) THEN - DEALLOCATE(MiscData%Nforce) -ENDIF -IF (ALLOCATED(MiscData%blade_dr)) THEN - DEALLOCATE(MiscData%blade_dr) -ENDIF - CALL DWM_Destroyturbine_average_velocity_data( MiscData%TAVD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_DestroyCVSD( MiscData%CalVelScale_data, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_DestroyMeanderData( MiscData%meandering_data, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_DestroyWeiMethod( MiscData%weighting_method, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_DestroyTIDownstream( MiscData%TI_downstream_data, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_DestroyTurbKaimal( MiscData%Turbulence_KS, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_DestroyShinozuka( MiscData%shinozuka_data, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_Destroysmooth_out_wake_data( MiscData%SmoothOut, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_DestroySWSV( MiscData%smooth_wake_shifted_velocity_data, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_DestroyWake_Deficit_Data( MiscData%DWDD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_Destroyturbine_blade( MiscData%DWM_tb, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL DWM_Destroywake_meandered_center( MiscData%WMC, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE DWM_DestroyMisc +subroutine DWM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(DWM_MiscVarType), intent(in) :: SrcMiscData + type(DWM_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DWM_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call InflowWind_CopyMisc(SrcMiscData%IfW, DstMiscData%IfW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstMiscData%position_y = SrcMiscData%position_y + DstMiscData%position_z = SrcMiscData%position_z + DstMiscData%velocity_wake_mean = SrcMiscData%velocity_wake_mean + DstMiscData%shifted_velocity_Aerodyn = SrcMiscData%shifted_velocity_Aerodyn + DstMiscData%U_velocity = SrcMiscData%U_velocity + DstMiscData%V_velocity = SrcMiscData%V_velocity + if (allocated(SrcMiscData%Nforce)) then + LB(1:2) = lbound(SrcMiscData%Nforce) + UB(1:2) = ubound(SrcMiscData%Nforce) + if (.not. allocated(DstMiscData%Nforce)) then + allocate(DstMiscData%Nforce(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Nforce.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Nforce = SrcMiscData%Nforce + else if (allocated(DstMiscData%Nforce)) then + deallocate(DstMiscData%Nforce) + end if + if (allocated(SrcMiscData%blade_dr)) then + LB(1:1) = lbound(SrcMiscData%blade_dr) + UB(1:1) = ubound(SrcMiscData%blade_dr) + if (.not. allocated(DstMiscData%blade_dr)) then + allocate(DstMiscData%blade_dr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%blade_dr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%blade_dr = SrcMiscData%blade_dr + else if (allocated(DstMiscData%blade_dr)) then + deallocate(DstMiscData%blade_dr) + end if + DstMiscData%NacYaw = SrcMiscData%NacYaw + DstMiscData%TI_original = SrcMiscData%TI_original + call DWM_Copyturbine_average_velocity_data(SrcMiscData%TAVD, DstMiscData%TAVD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call DWM_CopyCVSD(SrcMiscData%CalVelScale_data, DstMiscData%CalVelScale_data, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call DWM_CopyMeanderData(SrcMiscData%meandering_data, DstMiscData%meandering_data, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call DWM_CopyWeiMethod(SrcMiscData%weighting_method, DstMiscData%weighting_method, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call DWM_CopyTIDownstream(SrcMiscData%TI_downstream_data, DstMiscData%TI_downstream_data, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call DWM_CopyTurbKaimal(SrcMiscData%Turbulence_KS, DstMiscData%Turbulence_KS, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call DWM_CopyShinozuka(SrcMiscData%shinozuka_data, DstMiscData%shinozuka_data, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call DWM_Copysmooth_out_wake_data(SrcMiscData%SmoothOut, DstMiscData%SmoothOut, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call DWM_CopySWSV(SrcMiscData%smooth_wake_shifted_velocity_data, DstMiscData%smooth_wake_shifted_velocity_data, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call DWM_CopyWake_Deficit_Data(SrcMiscData%DWDD, DstMiscData%DWDD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstMiscData%ct_tilde = SrcMiscData%ct_tilde + DstMiscData%FAST_Time = SrcMiscData%FAST_Time + DstMiscData%SDtimestep = SrcMiscData%SDtimestep + call DWM_Copyturbine_blade(SrcMiscData%DWM_tb, DstMiscData%DWM_tb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call DWM_Copywake_meandered_center(SrcMiscData%WMC, DstMiscData%WMC, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine DWM_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(DWM_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DWM_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%Nforce)) then + deallocate(MiscData%Nforce) + end if + if (allocated(MiscData%blade_dr)) then + deallocate(MiscData%blade_dr) + end if +end subroutine subroutine DWM_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(DWM_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_PackMisc' if (Buf%ErrStat >= AbortErrLev) return - ! IfW call InflowWind_PackMisc(Buf, InData%IfW) if (RegCheckErr(Buf, RoutineName)) return - ! position_y call RegPack(Buf, InData%position_y) if (RegCheckErr(Buf, RoutineName)) return - ! position_z call RegPack(Buf, InData%position_z) if (RegCheckErr(Buf, RoutineName)) return - ! velocity_wake_mean call RegPack(Buf, InData%velocity_wake_mean) if (RegCheckErr(Buf, RoutineName)) return - ! shifted_velocity_Aerodyn call RegPack(Buf, InData%shifted_velocity_Aerodyn) if (RegCheckErr(Buf, RoutineName)) return - ! U_velocity call RegPack(Buf, InData%U_velocity) if (RegCheckErr(Buf, RoutineName)) return - ! V_velocity call RegPack(Buf, InData%V_velocity) if (RegCheckErr(Buf, RoutineName)) return - ! Nforce call RegPack(Buf, allocated(InData%Nforce)) if (allocated(InData%Nforce)) then call RegPackBounds(Buf, 2, lbound(InData%Nforce), ubound(InData%Nforce)) call RegPack(Buf, InData%Nforce) end if if (RegCheckErr(Buf, RoutineName)) return - ! blade_dr call RegPack(Buf, allocated(InData%blade_dr)) if (allocated(InData%blade_dr)) then call RegPackBounds(Buf, 1, lbound(InData%blade_dr), ubound(InData%blade_dr)) call RegPack(Buf, InData%blade_dr) end if if (RegCheckErr(Buf, RoutineName)) return - ! NacYaw call RegPack(Buf, InData%NacYaw) if (RegCheckErr(Buf, RoutineName)) return - ! TI_original call RegPack(Buf, InData%TI_original) if (RegCheckErr(Buf, RoutineName)) return - ! TAVD call DWM_Packturbine_average_velocity_data(Buf, InData%TAVD) if (RegCheckErr(Buf, RoutineName)) return - ! CalVelScale_data call DWM_PackCVSD(Buf, InData%CalVelScale_data) if (RegCheckErr(Buf, RoutineName)) return - ! meandering_data call DWM_PackMeanderData(Buf, InData%meandering_data) if (RegCheckErr(Buf, RoutineName)) return - ! weighting_method call DWM_PackWeiMethod(Buf, InData%weighting_method) if (RegCheckErr(Buf, RoutineName)) return - ! TI_downstream_data call DWM_PackTIDownstream(Buf, InData%TI_downstream_data) if (RegCheckErr(Buf, RoutineName)) return - ! Turbulence_KS call DWM_PackTurbKaimal(Buf, InData%Turbulence_KS) if (RegCheckErr(Buf, RoutineName)) return - ! shinozuka_data call DWM_PackShinozuka(Buf, InData%shinozuka_data) if (RegCheckErr(Buf, RoutineName)) return - ! SmoothOut call DWM_Packsmooth_out_wake_data(Buf, InData%SmoothOut) if (RegCheckErr(Buf, RoutineName)) return - ! smooth_wake_shifted_velocity_data call DWM_PackSWSV(Buf, InData%smooth_wake_shifted_velocity_data) if (RegCheckErr(Buf, RoutineName)) return - ! DWDD call DWM_PackWake_Deficit_Data(Buf, InData%DWDD) if (RegCheckErr(Buf, RoutineName)) return - ! ct_tilde call RegPack(Buf, InData%ct_tilde) if (RegCheckErr(Buf, RoutineName)) return - ! FAST_Time call RegPack(Buf, InData%FAST_Time) if (RegCheckErr(Buf, RoutineName)) return - ! SDtimestep call RegPack(Buf, InData%SDtimestep) if (RegCheckErr(Buf, RoutineName)) return - ! DWM_tb call DWM_Packturbine_blade(Buf, InData%DWM_tb) if (RegCheckErr(Buf, RoutineName)) return - ! WMC call DWM_Packwake_meandered_center(Buf, InData%WMC) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3670,27 +3218,19 @@ subroutine DWM_UnPackMisc(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! IfW call InflowWind_UnpackMisc(Buf, OutData%IfW) ! IfW - ! position_y call RegUnpack(Buf, OutData%position_y) if (RegCheckErr(Buf, RoutineName)) return - ! position_z call RegUnpack(Buf, OutData%position_z) if (RegCheckErr(Buf, RoutineName)) return - ! velocity_wake_mean call RegUnpack(Buf, OutData%velocity_wake_mean) if (RegCheckErr(Buf, RoutineName)) return - ! shifted_velocity_Aerodyn call RegUnpack(Buf, OutData%shifted_velocity_Aerodyn) if (RegCheckErr(Buf, RoutineName)) return - ! U_velocity call RegUnpack(Buf, OutData%U_velocity) if (RegCheckErr(Buf, RoutineName)) return - ! V_velocity call RegUnpack(Buf, OutData%V_velocity) if (RegCheckErr(Buf, RoutineName)) return - ! Nforce if (allocated(OutData%Nforce)) deallocate(OutData%Nforce) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3705,7 +3245,6 @@ subroutine DWM_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%Nforce) if (RegCheckErr(Buf, RoutineName)) return end if - ! blade_dr if (allocated(OutData%blade_dr)) deallocate(OutData%blade_dr) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3720,97 +3259,67 @@ subroutine DWM_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%blade_dr) if (RegCheckErr(Buf, RoutineName)) return end if - ! NacYaw call RegUnpack(Buf, OutData%NacYaw) if (RegCheckErr(Buf, RoutineName)) return - ! TI_original call RegUnpack(Buf, OutData%TI_original) if (RegCheckErr(Buf, RoutineName)) return - ! TAVD call DWM_Unpackturbine_average_velocity_data(Buf, OutData%TAVD) ! TAVD - ! CalVelScale_data call DWM_UnpackCVSD(Buf, OutData%CalVelScale_data) ! CalVelScale_data - ! meandering_data call DWM_UnpackMeanderData(Buf, OutData%meandering_data) ! meandering_data - ! weighting_method call DWM_UnpackWeiMethod(Buf, OutData%weighting_method) ! weighting_method - ! TI_downstream_data call DWM_UnpackTIDownstream(Buf, OutData%TI_downstream_data) ! TI_downstream_data - ! Turbulence_KS call DWM_UnpackTurbKaimal(Buf, OutData%Turbulence_KS) ! Turbulence_KS - ! shinozuka_data call DWM_UnpackShinozuka(Buf, OutData%shinozuka_data) ! shinozuka_data - ! SmoothOut call DWM_Unpacksmooth_out_wake_data(Buf, OutData%SmoothOut) ! SmoothOut - ! smooth_wake_shifted_velocity_data call DWM_UnpackSWSV(Buf, OutData%smooth_wake_shifted_velocity_data) ! smooth_wake_shifted_velocity_data - ! DWDD call DWM_UnpackWake_Deficit_Data(Buf, OutData%DWDD) ! DWDD - ! ct_tilde call RegUnpack(Buf, OutData%ct_tilde) if (RegCheckErr(Buf, RoutineName)) return - ! FAST_Time call RegUnpack(Buf, OutData%FAST_Time) if (RegCheckErr(Buf, RoutineName)) return - ! SDtimestep call RegUnpack(Buf, OutData%SDtimestep) if (RegCheckErr(Buf, RoutineName)) return - ! DWM_tb call DWM_Unpackturbine_blade(Buf, OutData%DWM_tb) ! DWM_tb - ! WMC call DWM_Unpackwake_meandered_center(Buf, OutData%WMC) ! WMC end subroutine - SUBROUTINE DWM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DWM_InputType), INTENT(IN) :: SrcInputData - TYPE(DWM_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_CopyInput' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL DWM_Copyread_upwind_result( SrcInputData%Upwind_result, DstInputData%Upwind_result, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyInput( SrcInputData%IfW, DstInputData%IfW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE DWM_CopyInput - - SUBROUTINE DWM_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(DWM_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyInput' - ErrStat = ErrID_None - ErrMsg = "" - - CALL DWM_Destroyread_upwind_result( InputData%Upwind_result, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyInput( InputData%IfW, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE DWM_DestroyInput +subroutine DWM_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(DWM_InputType), intent(in) :: SrcInputData + type(DWM_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DWM_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + call DWM_Copyread_upwind_result(SrcInputData%Upwind_result, DstInputData%Upwind_result, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyInput(SrcInputData%IfW, DstInputData%IfW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine DWM_DestroyInput(InputData, ErrStat, ErrMsg) + type(DWM_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DWM_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine DWM_PackInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(DWM_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_PackInput' if (Buf%ErrStat >= AbortErrLev) return - ! Upwind_result call DWM_Packread_upwind_result(Buf, InData%Upwind_result) if (RegCheckErr(Buf, RoutineName)) return - ! IfW call InflowWind_PackInput(Buf, InData%IfW) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3820,273 +3329,251 @@ subroutine DWM_UnPackInput(Buf, OutData) type(DWM_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPackInput' if (Buf%ErrStat /= ErrID_None) return - ! Upwind_result call DWM_Unpackread_upwind_result(Buf, OutData%Upwind_result) ! Upwind_result - ! IfW call InflowWind_UnpackInput(Buf, OutData%IfW) ! IfW end subroutine - SUBROUTINE DWM_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DWM_OutputType), INTENT(IN) :: SrcOutputData - TYPE(DWM_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_CopyOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%turbine_thrust_force)) THEN - i1_l = LBOUND(SrcOutputData%turbine_thrust_force,1) - i1_u = UBOUND(SrcOutputData%turbine_thrust_force,1) - IF (.NOT. ALLOCATED(DstOutputData%turbine_thrust_force)) THEN - ALLOCATE(DstOutputData%turbine_thrust_force(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%turbine_thrust_force.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%turbine_thrust_force = SrcOutputData%turbine_thrust_force -ENDIF -IF (ALLOCATED(SrcOutputData%induction_factor)) THEN - i1_l = LBOUND(SrcOutputData%induction_factor,1) - i1_u = UBOUND(SrcOutputData%induction_factor,1) - IF (.NOT. ALLOCATED(DstOutputData%induction_factor)) THEN - ALLOCATE(DstOutputData%induction_factor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%induction_factor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%induction_factor = SrcOutputData%induction_factor -ENDIF -IF (ALLOCATED(SrcOutputData%r_initial)) THEN - i1_l = LBOUND(SrcOutputData%r_initial,1) - i1_u = UBOUND(SrcOutputData%r_initial,1) - IF (.NOT. ALLOCATED(DstOutputData%r_initial)) THEN - ALLOCATE(DstOutputData%r_initial(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%r_initial.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%r_initial = SrcOutputData%r_initial -ENDIF -IF (ALLOCATED(SrcOutputData%U_initial)) THEN - i1_l = LBOUND(SrcOutputData%U_initial,1) - i1_u = UBOUND(SrcOutputData%U_initial,1) - IF (.NOT. ALLOCATED(DstOutputData%U_initial)) THEN - ALLOCATE(DstOutputData%U_initial(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%U_initial.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%U_initial = SrcOutputData%U_initial -ENDIF -IF (ALLOCATED(SrcOutputData%Mean_FFWS_array)) THEN - i1_l = LBOUND(SrcOutputData%Mean_FFWS_array,1) - i1_u = UBOUND(SrcOutputData%Mean_FFWS_array,1) - IF (.NOT. ALLOCATED(DstOutputData%Mean_FFWS_array)) THEN - ALLOCATE(DstOutputData%Mean_FFWS_array(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Mean_FFWS_array.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Mean_FFWS_array = SrcOutputData%Mean_FFWS_array -ENDIF - DstOutputData%Mean_FFWS = SrcOutputData%Mean_FFWS - DstOutputData%TI = SrcOutputData%TI - DstOutputData%TI_downstream = SrcOutputData%TI_downstream -IF (ALLOCATED(SrcOutputData%wake_u)) THEN - i1_l = LBOUND(SrcOutputData%wake_u,1) - i1_u = UBOUND(SrcOutputData%wake_u,1) - i2_l = LBOUND(SrcOutputData%wake_u,2) - i2_u = UBOUND(SrcOutputData%wake_u,2) - IF (.NOT. ALLOCATED(DstOutputData%wake_u)) THEN - ALLOCATE(DstOutputData%wake_u(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%wake_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%wake_u = SrcOutputData%wake_u -ENDIF -IF (ALLOCATED(SrcOutputData%wake_position)) THEN - i1_l = LBOUND(SrcOutputData%wake_position,1) - i1_u = UBOUND(SrcOutputData%wake_position,1) - i2_l = LBOUND(SrcOutputData%wake_position,2) - i2_u = UBOUND(SrcOutputData%wake_position,2) - i3_l = LBOUND(SrcOutputData%wake_position,3) - i3_u = UBOUND(SrcOutputData%wake_position,3) - IF (.NOT. ALLOCATED(DstOutputData%wake_position)) THEN - ALLOCATE(DstOutputData%wake_position(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%wake_position.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%wake_position = SrcOutputData%wake_position -ENDIF -IF (ALLOCATED(SrcOutputData%smoothed_velocity_array)) THEN - i1_l = LBOUND(SrcOutputData%smoothed_velocity_array,1) - i1_u = UBOUND(SrcOutputData%smoothed_velocity_array,1) - i2_l = LBOUND(SrcOutputData%smoothed_velocity_array,2) - i2_u = UBOUND(SrcOutputData%smoothed_velocity_array,2) - IF (.NOT. ALLOCATED(DstOutputData%smoothed_velocity_array)) THEN - ALLOCATE(DstOutputData%smoothed_velocity_array(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%smoothed_velocity_array.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%smoothed_velocity_array = SrcOutputData%smoothed_velocity_array -ENDIF - DstOutputData%AtmUscale = SrcOutputData%AtmUscale - DstOutputData%du_dz_ABL = SrcOutputData%du_dz_ABL - DstOutputData%total_SDgenpwr = SrcOutputData%total_SDgenpwr - DstOutputData%mean_SDgenpwr = SrcOutputData%mean_SDgenpwr - DstOutputData%avg_ct = SrcOutputData%avg_ct - CALL InflowWind_CopyOutput( SrcOutputData%IfW, DstOutputData%IfW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE DWM_CopyOutput - - SUBROUTINE DWM_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(DWM_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(OutputData%turbine_thrust_force)) THEN - DEALLOCATE(OutputData%turbine_thrust_force) -ENDIF -IF (ALLOCATED(OutputData%induction_factor)) THEN - DEALLOCATE(OutputData%induction_factor) -ENDIF -IF (ALLOCATED(OutputData%r_initial)) THEN - DEALLOCATE(OutputData%r_initial) -ENDIF -IF (ALLOCATED(OutputData%U_initial)) THEN - DEALLOCATE(OutputData%U_initial) -ENDIF -IF (ALLOCATED(OutputData%Mean_FFWS_array)) THEN - DEALLOCATE(OutputData%Mean_FFWS_array) -ENDIF -IF (ALLOCATED(OutputData%wake_u)) THEN - DEALLOCATE(OutputData%wake_u) -ENDIF -IF (ALLOCATED(OutputData%wake_position)) THEN - DEALLOCATE(OutputData%wake_position) -ENDIF -IF (ALLOCATED(OutputData%smoothed_velocity_array)) THEN - DEALLOCATE(OutputData%smoothed_velocity_array) -ENDIF - CALL InflowWind_DestroyOutput( OutputData%IfW, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE DWM_DestroyOutput +subroutine DWM_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(DWM_OutputType), intent(in) :: SrcOutputData + type(DWM_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DWM_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%turbine_thrust_force)) then + LB(1:1) = lbound(SrcOutputData%turbine_thrust_force) + UB(1:1) = ubound(SrcOutputData%turbine_thrust_force) + if (.not. allocated(DstOutputData%turbine_thrust_force)) then + allocate(DstOutputData%turbine_thrust_force(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%turbine_thrust_force.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%turbine_thrust_force = SrcOutputData%turbine_thrust_force + else if (allocated(DstOutputData%turbine_thrust_force)) then + deallocate(DstOutputData%turbine_thrust_force) + end if + if (allocated(SrcOutputData%induction_factor)) then + LB(1:1) = lbound(SrcOutputData%induction_factor) + UB(1:1) = ubound(SrcOutputData%induction_factor) + if (.not. allocated(DstOutputData%induction_factor)) then + allocate(DstOutputData%induction_factor(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%induction_factor.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%induction_factor = SrcOutputData%induction_factor + else if (allocated(DstOutputData%induction_factor)) then + deallocate(DstOutputData%induction_factor) + end if + if (allocated(SrcOutputData%r_initial)) then + LB(1:1) = lbound(SrcOutputData%r_initial) + UB(1:1) = ubound(SrcOutputData%r_initial) + if (.not. allocated(DstOutputData%r_initial)) then + allocate(DstOutputData%r_initial(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%r_initial.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%r_initial = SrcOutputData%r_initial + else if (allocated(DstOutputData%r_initial)) then + deallocate(DstOutputData%r_initial) + end if + if (allocated(SrcOutputData%U_initial)) then + LB(1:1) = lbound(SrcOutputData%U_initial) + UB(1:1) = ubound(SrcOutputData%U_initial) + if (.not. allocated(DstOutputData%U_initial)) then + allocate(DstOutputData%U_initial(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%U_initial.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%U_initial = SrcOutputData%U_initial + else if (allocated(DstOutputData%U_initial)) then + deallocate(DstOutputData%U_initial) + end if + if (allocated(SrcOutputData%Mean_FFWS_array)) then + LB(1:1) = lbound(SrcOutputData%Mean_FFWS_array) + UB(1:1) = ubound(SrcOutputData%Mean_FFWS_array) + if (.not. allocated(DstOutputData%Mean_FFWS_array)) then + allocate(DstOutputData%Mean_FFWS_array(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Mean_FFWS_array.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Mean_FFWS_array = SrcOutputData%Mean_FFWS_array + else if (allocated(DstOutputData%Mean_FFWS_array)) then + deallocate(DstOutputData%Mean_FFWS_array) + end if + DstOutputData%Mean_FFWS = SrcOutputData%Mean_FFWS + DstOutputData%TI = SrcOutputData%TI + DstOutputData%TI_downstream = SrcOutputData%TI_downstream + if (allocated(SrcOutputData%wake_u)) then + LB(1:2) = lbound(SrcOutputData%wake_u) + UB(1:2) = ubound(SrcOutputData%wake_u) + if (.not. allocated(DstOutputData%wake_u)) then + allocate(DstOutputData%wake_u(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%wake_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%wake_u = SrcOutputData%wake_u + else if (allocated(DstOutputData%wake_u)) then + deallocate(DstOutputData%wake_u) + end if + if (allocated(SrcOutputData%wake_position)) then + LB(1:3) = lbound(SrcOutputData%wake_position) + UB(1:3) = ubound(SrcOutputData%wake_position) + if (.not. allocated(DstOutputData%wake_position)) then + allocate(DstOutputData%wake_position(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%wake_position.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%wake_position = SrcOutputData%wake_position + else if (allocated(DstOutputData%wake_position)) then + deallocate(DstOutputData%wake_position) + end if + if (allocated(SrcOutputData%smoothed_velocity_array)) then + LB(1:2) = lbound(SrcOutputData%smoothed_velocity_array) + UB(1:2) = ubound(SrcOutputData%smoothed_velocity_array) + if (.not. allocated(DstOutputData%smoothed_velocity_array)) then + allocate(DstOutputData%smoothed_velocity_array(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%smoothed_velocity_array.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%smoothed_velocity_array = SrcOutputData%smoothed_velocity_array + else if (allocated(DstOutputData%smoothed_velocity_array)) then + deallocate(DstOutputData%smoothed_velocity_array) + end if + DstOutputData%AtmUscale = SrcOutputData%AtmUscale + DstOutputData%du_dz_ABL = SrcOutputData%du_dz_ABL + DstOutputData%total_SDgenpwr = SrcOutputData%total_SDgenpwr + DstOutputData%mean_SDgenpwr = SrcOutputData%mean_SDgenpwr + DstOutputData%avg_ct = SrcOutputData%avg_ct + call InflowWind_CopyOutput(SrcOutputData%IfW, DstOutputData%IfW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine DWM_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(DWM_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DWM_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%turbine_thrust_force)) then + deallocate(OutputData%turbine_thrust_force) + end if + if (allocated(OutputData%induction_factor)) then + deallocate(OutputData%induction_factor) + end if + if (allocated(OutputData%r_initial)) then + deallocate(OutputData%r_initial) + end if + if (allocated(OutputData%U_initial)) then + deallocate(OutputData%U_initial) + end if + if (allocated(OutputData%Mean_FFWS_array)) then + deallocate(OutputData%Mean_FFWS_array) + end if + if (allocated(OutputData%wake_u)) then + deallocate(OutputData%wake_u) + end if + if (allocated(OutputData%wake_position)) then + deallocate(OutputData%wake_position) + end if + if (allocated(OutputData%smoothed_velocity_array)) then + deallocate(OutputData%smoothed_velocity_array) + end if +end subroutine subroutine DWM_PackOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(DWM_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_PackOutput' if (Buf%ErrStat >= AbortErrLev) return - ! turbine_thrust_force call RegPack(Buf, allocated(InData%turbine_thrust_force)) if (allocated(InData%turbine_thrust_force)) then call RegPackBounds(Buf, 1, lbound(InData%turbine_thrust_force), ubound(InData%turbine_thrust_force)) call RegPack(Buf, InData%turbine_thrust_force) end if if (RegCheckErr(Buf, RoutineName)) return - ! induction_factor call RegPack(Buf, allocated(InData%induction_factor)) if (allocated(InData%induction_factor)) then call RegPackBounds(Buf, 1, lbound(InData%induction_factor), ubound(InData%induction_factor)) call RegPack(Buf, InData%induction_factor) end if if (RegCheckErr(Buf, RoutineName)) return - ! r_initial call RegPack(Buf, allocated(InData%r_initial)) if (allocated(InData%r_initial)) then call RegPackBounds(Buf, 1, lbound(InData%r_initial), ubound(InData%r_initial)) call RegPack(Buf, InData%r_initial) end if if (RegCheckErr(Buf, RoutineName)) return - ! U_initial call RegPack(Buf, allocated(InData%U_initial)) if (allocated(InData%U_initial)) then call RegPackBounds(Buf, 1, lbound(InData%U_initial), ubound(InData%U_initial)) call RegPack(Buf, InData%U_initial) end if if (RegCheckErr(Buf, RoutineName)) return - ! Mean_FFWS_array call RegPack(Buf, allocated(InData%Mean_FFWS_array)) if (allocated(InData%Mean_FFWS_array)) then call RegPackBounds(Buf, 1, lbound(InData%Mean_FFWS_array), ubound(InData%Mean_FFWS_array)) call RegPack(Buf, InData%Mean_FFWS_array) end if if (RegCheckErr(Buf, RoutineName)) return - ! Mean_FFWS call RegPack(Buf, InData%Mean_FFWS) if (RegCheckErr(Buf, RoutineName)) return - ! TI call RegPack(Buf, InData%TI) if (RegCheckErr(Buf, RoutineName)) return - ! TI_downstream call RegPack(Buf, InData%TI_downstream) if (RegCheckErr(Buf, RoutineName)) return - ! wake_u call RegPack(Buf, allocated(InData%wake_u)) if (allocated(InData%wake_u)) then call RegPackBounds(Buf, 2, lbound(InData%wake_u), ubound(InData%wake_u)) call RegPack(Buf, InData%wake_u) end if if (RegCheckErr(Buf, RoutineName)) return - ! wake_position call RegPack(Buf, allocated(InData%wake_position)) if (allocated(InData%wake_position)) then call RegPackBounds(Buf, 3, lbound(InData%wake_position), ubound(InData%wake_position)) call RegPack(Buf, InData%wake_position) end if if (RegCheckErr(Buf, RoutineName)) return - ! smoothed_velocity_array call RegPack(Buf, allocated(InData%smoothed_velocity_array)) if (allocated(InData%smoothed_velocity_array)) then call RegPackBounds(Buf, 2, lbound(InData%smoothed_velocity_array), ubound(InData%smoothed_velocity_array)) call RegPack(Buf, InData%smoothed_velocity_array) end if if (RegCheckErr(Buf, RoutineName)) return - ! AtmUscale call RegPack(Buf, InData%AtmUscale) if (RegCheckErr(Buf, RoutineName)) return - ! du_dz_ABL call RegPack(Buf, InData%du_dz_ABL) if (RegCheckErr(Buf, RoutineName)) return - ! total_SDgenpwr call RegPack(Buf, InData%total_SDgenpwr) if (RegCheckErr(Buf, RoutineName)) return - ! mean_SDgenpwr call RegPack(Buf, InData%mean_SDgenpwr) if (RegCheckErr(Buf, RoutineName)) return - ! avg_ct call RegPack(Buf, InData%avg_ct) if (RegCheckErr(Buf, RoutineName)) return - ! IfW call InflowWind_PackOutput(Buf, InData%IfW) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -4099,7 +3586,6 @@ subroutine DWM_UnPackOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! turbine_thrust_force if (allocated(OutData%turbine_thrust_force)) deallocate(OutData%turbine_thrust_force) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4114,7 +3600,6 @@ subroutine DWM_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%turbine_thrust_force) if (RegCheckErr(Buf, RoutineName)) return end if - ! induction_factor if (allocated(OutData%induction_factor)) deallocate(OutData%induction_factor) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4129,7 +3614,6 @@ subroutine DWM_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%induction_factor) if (RegCheckErr(Buf, RoutineName)) return end if - ! r_initial if (allocated(OutData%r_initial)) deallocate(OutData%r_initial) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4144,7 +3628,6 @@ subroutine DWM_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%r_initial) if (RegCheckErr(Buf, RoutineName)) return end if - ! U_initial if (allocated(OutData%U_initial)) deallocate(OutData%U_initial) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4159,7 +3642,6 @@ subroutine DWM_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%U_initial) if (RegCheckErr(Buf, RoutineName)) return end if - ! Mean_FFWS_array if (allocated(OutData%Mean_FFWS_array)) deallocate(OutData%Mean_FFWS_array) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4174,16 +3656,12 @@ subroutine DWM_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%Mean_FFWS_array) if (RegCheckErr(Buf, RoutineName)) return end if - ! Mean_FFWS call RegUnpack(Buf, OutData%Mean_FFWS) if (RegCheckErr(Buf, RoutineName)) return - ! TI call RegUnpack(Buf, OutData%TI) if (RegCheckErr(Buf, RoutineName)) return - ! TI_downstream call RegUnpack(Buf, OutData%TI_downstream) if (RegCheckErr(Buf, RoutineName)) return - ! wake_u if (allocated(OutData%wake_u)) deallocate(OutData%wake_u) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4198,7 +3676,6 @@ subroutine DWM_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%wake_u) if (RegCheckErr(Buf, RoutineName)) return end if - ! wake_position if (allocated(OutData%wake_position)) deallocate(OutData%wake_position) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4213,7 +3690,6 @@ subroutine DWM_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%wake_position) if (RegCheckErr(Buf, RoutineName)) return end if - ! smoothed_velocity_array if (allocated(OutData%smoothed_velocity_array)) deallocate(OutData%smoothed_velocity_array) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4228,71 +3704,54 @@ subroutine DWM_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%smoothed_velocity_array) if (RegCheckErr(Buf, RoutineName)) return end if - ! AtmUscale call RegUnpack(Buf, OutData%AtmUscale) if (RegCheckErr(Buf, RoutineName)) return - ! du_dz_ABL call RegUnpack(Buf, OutData%du_dz_ABL) if (RegCheckErr(Buf, RoutineName)) return - ! total_SDgenpwr call RegUnpack(Buf, OutData%total_SDgenpwr) if (RegCheckErr(Buf, RoutineName)) return - ! mean_SDgenpwr call RegUnpack(Buf, OutData%mean_SDgenpwr) if (RegCheckErr(Buf, RoutineName)) return - ! avg_ct call RegUnpack(Buf, OutData%avg_ct) if (RegCheckErr(Buf, RoutineName)) return - ! IfW call InflowWind_UnpackOutput(Buf, OutData%IfW) ! IfW end subroutine - SUBROUTINE DWM_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DWM_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(DWM_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%dummy = SrcContStateData%dummy - CALL InflowWind_CopyContState( SrcContStateData%IfW, DstContStateData%IfW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE DWM_CopyContState - - SUBROUTINE DWM_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(DWM_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - CALL InflowWind_DestroyContState( ContStateData%IfW, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE DWM_DestroyContState +subroutine DWM_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(DWM_ContinuousStateType), intent(in) :: SrcContStateData + type(DWM_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DWM_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + DstContStateData%dummy = SrcContStateData%dummy + call InflowWind_CopyContState(SrcContStateData%IfW, DstContStateData%IfW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine DWM_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(DWM_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DWM_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine DWM_PackContState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(DWM_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_PackContState' if (Buf%ErrStat >= AbortErrLev) return - ! dummy call RegPack(Buf, InData%dummy) if (RegCheckErr(Buf, RoutineName)) return - ! IfW call InflowWind_PackContState(Buf, InData%IfW) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -4302,59 +3761,46 @@ subroutine DWM_UnPackContState(Buf, OutData) type(DWM_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPackContState' if (Buf%ErrStat /= ErrID_None) return - ! dummy call RegUnpack(Buf, OutData%dummy) if (RegCheckErr(Buf, RoutineName)) return - ! IfW call InflowWind_UnpackContState(Buf, OutData%IfW) ! IfW end subroutine - SUBROUTINE DWM_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DWM_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(DWM_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%dummy = SrcDiscStateData%dummy - CALL InflowWind_CopyDiscState( SrcDiscStateData%IfW, DstDiscStateData%IfW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE DWM_CopyDiscState - - SUBROUTINE DWM_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(DWM_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - CALL InflowWind_DestroyDiscState( DiscStateData%IfW, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE DWM_DestroyDiscState +subroutine DWM_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(DWM_DiscreteStateType), intent(in) :: SrcDiscStateData + type(DWM_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DWM_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + DstDiscStateData%dummy = SrcDiscStateData%dummy + call InflowWind_CopyDiscState(SrcDiscStateData%IfW, DstDiscStateData%IfW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine DWM_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(DWM_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DWM_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine DWM_PackDiscState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(DWM_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_PackDiscState' if (Buf%ErrStat >= AbortErrLev) return - ! dummy call RegPack(Buf, InData%dummy) if (RegCheckErr(Buf, RoutineName)) return - ! IfW call InflowWind_PackDiscState(Buf, InData%IfW) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -4364,59 +3810,46 @@ subroutine DWM_UnPackDiscState(Buf, OutData) type(DWM_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPackDiscState' if (Buf%ErrStat /= ErrID_None) return - ! dummy call RegUnpack(Buf, OutData%dummy) if (RegCheckErr(Buf, RoutineName)) return - ! IfW call InflowWind_UnpackDiscState(Buf, OutData%IfW) ! IfW end subroutine - SUBROUTINE DWM_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DWM_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(DWM_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%dummy = SrcConstrStateData%dummy - CALL InflowWind_CopyConstrState( SrcConstrStateData%IfW, DstConstrStateData%IfW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE DWM_CopyConstrState - SUBROUTINE DWM_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(DWM_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL InflowWind_DestroyConstrState( ConstrStateData%IfW, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE DWM_DestroyConstrState +subroutine DWM_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(DWM_ConstraintStateType), intent(in) :: SrcConstrStateData + type(DWM_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DWM_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%dummy = SrcConstrStateData%dummy + call InflowWind_CopyConstrState(SrcConstrStateData%IfW, DstConstrStateData%IfW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine DWM_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(DWM_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DWM_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine DWM_PackConstrState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(DWM_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_PackConstrState' if (Buf%ErrStat >= AbortErrLev) return - ! dummy call RegPack(Buf, InData%dummy) if (RegCheckErr(Buf, RoutineName)) return - ! IfW call InflowWind_PackConstrState(Buf, InData%IfW) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -4426,59 +3859,46 @@ subroutine DWM_UnPackConstrState(Buf, OutData) type(DWM_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPackConstrState' if (Buf%ErrStat /= ErrID_None) return - ! dummy call RegUnpack(Buf, OutData%dummy) if (RegCheckErr(Buf, RoutineName)) return - ! IfW call InflowWind_UnpackConstrState(Buf, OutData%IfW) ! IfW end subroutine - SUBROUTINE DWM_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DWM_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(DWM_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%dummy = SrcInitInputData%dummy - CALL InflowWind_CopyInitInput( SrcInitInputData%IfW, DstInitInputData%IfW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE DWM_CopyInitInput - - SUBROUTINE DWM_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(DWM_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyInitInput' - ErrStat = ErrID_None - ErrMsg = "" - - CALL InflowWind_DestroyInitInput( InitInputData%IfW, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE DWM_DestroyInitInput +subroutine DWM_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(DWM_InitInputType), intent(in) :: SrcInitInputData + type(DWM_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DWM_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitInputData%dummy = SrcInitInputData%dummy + call InflowWind_CopyInitInput(SrcInitInputData%IfW, DstInitInputData%IfW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine DWM_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(DWM_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DWM_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine DWM_PackInitInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(DWM_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return - ! dummy call RegPack(Buf, InData%dummy) if (RegCheckErr(Buf, RoutineName)) return - ! IfW call InflowWind_PackInitInput(Buf, InData%IfW) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -4488,59 +3908,46 @@ subroutine DWM_UnPackInitInput(Buf, OutData) type(DWM_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPackInitInput' if (Buf%ErrStat /= ErrID_None) return - ! dummy call RegUnpack(Buf, OutData%dummy) if (RegCheckErr(Buf, RoutineName)) return - ! IfW call InflowWind_UnpackInitInput(Buf, OutData%IfW) ! IfW end subroutine - SUBROUTINE DWM_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(DWM_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(DWM_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_CopyInitOutput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitOutputData%dummy = SrcInitOutputData%dummy - CALL InflowWind_CopyInitOutput( SrcInitOutputData%IfW, DstInitOutputData%IfW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE DWM_CopyInitOutput - - SUBROUTINE DWM_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(DWM_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_DestroyInitOutput' - ErrStat = ErrID_None - ErrMsg = "" - - CALL InflowWind_DestroyInitOutput( InitOutputData%IfW, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE DWM_DestroyInitOutput +subroutine DWM_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(DWM_InitOutputType), intent(in) :: SrcInitOutputData + type(DWM_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DWM_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitOutputData%dummy = SrcInitOutputData%dummy + call InflowWind_CopyInitOutput(SrcInitOutputData%IfW, DstInitOutputData%IfW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine DWM_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(DWM_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'DWM_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine DWM_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(DWM_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'DWM_PackInitOutput' if (Buf%ErrStat >= AbortErrLev) return - ! dummy call RegPack(Buf, InData%dummy) if (RegCheckErr(Buf, RoutineName)) return - ! IfW call InflowWind_PackInitOutput(Buf, InData%IfW) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -4550,10 +3957,8 @@ subroutine DWM_UnPackInitOutput(Buf, OutData) type(DWM_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DWM_UnPackInitOutput' if (Buf%ErrStat /= ErrID_None) return - ! dummy call RegUnpack(Buf, OutData%dummy) if (RegCheckErr(Buf, RoutineName)) return - ! IfW call InflowWind_UnpackInitOutput(Buf, OutData%IfW) ! IfW end subroutine diff --git a/modules/awae/src/AWAE_Types.f90 b/modules/awae/src/AWAE_Types.f90 index 6e1eaf9ebb..ecb1ab0b60 100644 --- a/modules/awae/src/AWAE_Types.f90 +++ b/modules/awae/src/AWAE_Types.f90 @@ -246,66 +246,46 @@ MODULE AWAE_Types END TYPE AWAE_InputType ! ======================= CONTAINS - SUBROUTINE AWAE_CopyHighWindGrid( SrcHighWindGridData, DstHighWindGridData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AWAE_HighWindGrid), INTENT(IN) :: SrcHighWindGridData - TYPE(AWAE_HighWindGrid), INTENT(INOUT) :: DstHighWindGridData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_CopyHighWindGrid' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ASSOCIATED(SrcHighWindGridData%data)) THEN - i1_l = LBOUND(SrcHighWindGridData%data,1) - i1_u = UBOUND(SrcHighWindGridData%data,1) - i2_l = LBOUND(SrcHighWindGridData%data,2) - i2_u = UBOUND(SrcHighWindGridData%data,2) - i3_l = LBOUND(SrcHighWindGridData%data,3) - i3_u = UBOUND(SrcHighWindGridData%data,3) - i4_l = LBOUND(SrcHighWindGridData%data,4) - i4_u = UBOUND(SrcHighWindGridData%data,4) - i5_l = LBOUND(SrcHighWindGridData%data,5) - i5_u = UBOUND(SrcHighWindGridData%data,5) - IF (.NOT. ASSOCIATED(DstHighWindGridData%data)) THEN - ALLOCATE(DstHighWindGridData%data(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstHighWindGridData%data.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstHighWindGridData%data = SrcHighWindGridData%data -ENDIF - END SUBROUTINE AWAE_CopyHighWindGrid - - SUBROUTINE AWAE_DestroyHighWindGrid( HighWindGridData, ErrStat, ErrMsg ) - TYPE(AWAE_HighWindGrid), INTENT(INOUT) :: HighWindGridData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyHighWindGrid' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ASSOCIATED(HighWindGridData%data)) THEN - DEALLOCATE(HighWindGridData%data) - HighWindGridData%data => NULL() -ENDIF - END SUBROUTINE AWAE_DestroyHighWindGrid +subroutine AWAE_CopyHighWindGrid(SrcHighWindGridData, DstHighWindGridData, CtrlCode, ErrStat, ErrMsg) + type(AWAE_HighWindGrid), intent(in) :: SrcHighWindGridData + type(AWAE_HighWindGrid), intent(inout) :: DstHighWindGridData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AWAE_CopyHighWindGrid' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(SrcHighWindGridData%data)) then + LB(1:5) = lbound(SrcHighWindGridData%data) + UB(1:5) = ubound(SrcHighWindGridData%data) + if (.not. associated(DstHighWindGridData%data)) then + allocate(DstHighWindGridData%data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstHighWindGridData%data.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstHighWindGridData%data = SrcHighWindGridData%data + else if (associated(DstHighWindGridData%data)) then + deallocate(DstHighWindGridData%data) + end if +end subroutine +subroutine AWAE_DestroyHighWindGrid(HighWindGridData, ErrStat, ErrMsg) + type(AWAE_HighWindGrid), intent(inout) :: HighWindGridData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AWAE_DestroyHighWindGrid' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(HighWindGridData%data)) then + deallocate(HighWindGridData%data) + HighWindGridData%data => null() + end if +end subroutine subroutine AWAE_PackHighWindGrid(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -313,7 +293,6 @@ subroutine AWAE_PackHighWindGrid(Buf, Indata) character(*), parameter :: RoutineName = 'AWAE_PackHighWindGrid' logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return - ! data call RegPack(Buf, associated(InData%data)) if (associated(InData%data)) then call RegPackBounds(Buf, 5, lbound(InData%data), ubound(InData%data)) @@ -335,7 +314,6 @@ subroutine AWAE_UnPackHighWindGrid(Buf, OutData) integer(IntKi) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return - ! data if (associated(OutData%data)) deallocate(OutData%data) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -361,44 +339,30 @@ subroutine AWAE_UnPackHighWindGrid(Buf, OutData) OutData%data => null() end if end subroutine - SUBROUTINE AWAE_CopyHighWindGridPtr( SrcHighWindGridPtrData, DstHighWindGridPtrData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AWAE_HighWindGridPtr), INTENT(IN) :: SrcHighWindGridPtrData - TYPE(AWAE_HighWindGridPtr), INTENT(INOUT) :: DstHighWindGridPtrData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_CopyHighWindGridPtr' -! - ErrStat = ErrID_None - ErrMsg = "" - DstHighWindGridPtrData%data => SrcHighWindGridPtrData%data - END SUBROUTINE AWAE_CopyHighWindGridPtr - - SUBROUTINE AWAE_DestroyHighWindGridPtr( HighWindGridPtrData, ErrStat, ErrMsg ) - TYPE(AWAE_HighWindGridPtr), INTENT(INOUT) :: HighWindGridPtrData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyHighWindGridPtr' - ErrStat = ErrID_None - ErrMsg = "" - -NULLIFY(HighWindGridPtrData%data) - END SUBROUTINE AWAE_DestroyHighWindGridPtr +subroutine AWAE_CopyHighWindGridPtr(SrcHighWindGridPtrData, DstHighWindGridPtrData, CtrlCode, ErrStat, ErrMsg) + type(AWAE_HighWindGridPtr), intent(in) :: SrcHighWindGridPtrData + type(AWAE_HighWindGridPtr), intent(inout) :: DstHighWindGridPtrData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AWAE_CopyHighWindGridPtr' + ErrStat = ErrID_None + ErrMsg = '' + DstHighWindGridPtrData%data => SrcHighWindGridPtrData%data +end subroutine +subroutine AWAE_DestroyHighWindGridPtr(HighWindGridPtrData, ErrStat, ErrMsg) + type(AWAE_HighWindGridPtr), intent(inout) :: HighWindGridPtrData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AWAE_DestroyHighWindGridPtr' + ErrStat = ErrID_None + ErrMsg = '' + nullify(HighWindGridPtrData%data) +end subroutine subroutine AWAE_PackHighWindGridPtr(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -406,7 +370,6 @@ subroutine AWAE_PackHighWindGridPtr(Buf, Indata) character(*), parameter :: RoutineName = 'AWAE_PackHighWindGridPtr' logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return - ! data call RegPack(Buf, associated(InData%data)) if (associated(InData%data)) then call RegPackBounds(Buf, 5, lbound(InData%data), ubound(InData%data)) @@ -428,7 +391,6 @@ subroutine AWAE_UnPackHighWindGridPtr(Buf, OutData) integer(IntKi) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return - ! data if (associated(OutData%data)) deallocate(OutData%data) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -454,385 +416,352 @@ subroutine AWAE_UnPackHighWindGridPtr(Buf, OutData) OutData%data => null() end if end subroutine - SUBROUTINE AWAE_CopyInputFileType( SrcInputFileTypeData, DstInputFileTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AWAE_InputFileType), INTENT(IN) :: SrcInputFileTypeData - TYPE(AWAE_InputFileType), INTENT(INOUT) :: DstInputFileTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_CopyInputFileType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInputFileTypeData%dr = SrcInputFileTypeData%dr - DstInputFileTypeData%dt_low = SrcInputFileTypeData%dt_low - DstInputFileTypeData%NumTurbines = SrcInputFileTypeData%NumTurbines - DstInputFileTypeData%NumRadii = SrcInputFileTypeData%NumRadii - DstInputFileTypeData%NumPlanes = SrcInputFileTypeData%NumPlanes - DstInputFileTypeData%WindFilePath = SrcInputFileTypeData%WindFilePath - DstInputFileTypeData%WrDisWind = SrcInputFileTypeData%WrDisWind - DstInputFileTypeData%NOutDisWindXY = SrcInputFileTypeData%NOutDisWindXY -IF (ALLOCATED(SrcInputFileTypeData%OutDisWindZ)) THEN - i1_l = LBOUND(SrcInputFileTypeData%OutDisWindZ,1) - i1_u = UBOUND(SrcInputFileTypeData%OutDisWindZ,1) - IF (.NOT. ALLOCATED(DstInputFileTypeData%OutDisWindZ)) THEN - ALLOCATE(DstInputFileTypeData%OutDisWindZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%OutDisWindZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileTypeData%OutDisWindZ = SrcInputFileTypeData%OutDisWindZ -ENDIF - DstInputFileTypeData%NOutDisWindYZ = SrcInputFileTypeData%NOutDisWindYZ -IF (ALLOCATED(SrcInputFileTypeData%OutDisWindX)) THEN - i1_l = LBOUND(SrcInputFileTypeData%OutDisWindX,1) - i1_u = UBOUND(SrcInputFileTypeData%OutDisWindX,1) - IF (.NOT. ALLOCATED(DstInputFileTypeData%OutDisWindX)) THEN - ALLOCATE(DstInputFileTypeData%OutDisWindX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%OutDisWindX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileTypeData%OutDisWindX = SrcInputFileTypeData%OutDisWindX -ENDIF - DstInputFileTypeData%NOutDisWindXZ = SrcInputFileTypeData%NOutDisWindXZ -IF (ALLOCATED(SrcInputFileTypeData%OutDisWindY)) THEN - i1_l = LBOUND(SrcInputFileTypeData%OutDisWindY,1) - i1_u = UBOUND(SrcInputFileTypeData%OutDisWindY,1) - IF (.NOT. ALLOCATED(DstInputFileTypeData%OutDisWindY)) THEN - ALLOCATE(DstInputFileTypeData%OutDisWindY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%OutDisWindY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileTypeData%OutDisWindY = SrcInputFileTypeData%OutDisWindY -ENDIF - DstInputFileTypeData%WrDisDT = SrcInputFileTypeData%WrDisDT - DstInputFileTypeData%ChkWndFiles = SrcInputFileTypeData%ChkWndFiles - DstInputFileTypeData%Mod_Meander = SrcInputFileTypeData%Mod_Meander - DstInputFileTypeData%C_Meander = SrcInputFileTypeData%C_Meander - DstInputFileTypeData%Mod_AmbWind = SrcInputFileTypeData%Mod_AmbWind - DstInputFileTypeData%InflowFile = SrcInputFileTypeData%InflowFile - DstInputFileTypeData%dt_high = SrcInputFileTypeData%dt_high -IF (ALLOCATED(SrcInputFileTypeData%X0_high)) THEN - i1_l = LBOUND(SrcInputFileTypeData%X0_high,1) - i1_u = UBOUND(SrcInputFileTypeData%X0_high,1) - IF (.NOT. ALLOCATED(DstInputFileTypeData%X0_high)) THEN - ALLOCATE(DstInputFileTypeData%X0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%X0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileTypeData%X0_high = SrcInputFileTypeData%X0_high -ENDIF -IF (ALLOCATED(SrcInputFileTypeData%Y0_high)) THEN - i1_l = LBOUND(SrcInputFileTypeData%Y0_high,1) - i1_u = UBOUND(SrcInputFileTypeData%Y0_high,1) - IF (.NOT. ALLOCATED(DstInputFileTypeData%Y0_high)) THEN - ALLOCATE(DstInputFileTypeData%Y0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%Y0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileTypeData%Y0_high = SrcInputFileTypeData%Y0_high -ENDIF -IF (ALLOCATED(SrcInputFileTypeData%Z0_high)) THEN - i1_l = LBOUND(SrcInputFileTypeData%Z0_high,1) - i1_u = UBOUND(SrcInputFileTypeData%Z0_high,1) - IF (.NOT. ALLOCATED(DstInputFileTypeData%Z0_high)) THEN - ALLOCATE(DstInputFileTypeData%Z0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%Z0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileTypeData%Z0_high = SrcInputFileTypeData%Z0_high -ENDIF -IF (ALLOCATED(SrcInputFileTypeData%dX_high)) THEN - i1_l = LBOUND(SrcInputFileTypeData%dX_high,1) - i1_u = UBOUND(SrcInputFileTypeData%dX_high,1) - IF (.NOT. ALLOCATED(DstInputFileTypeData%dX_high)) THEN - ALLOCATE(DstInputFileTypeData%dX_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%dX_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileTypeData%dX_high = SrcInputFileTypeData%dX_high -ENDIF -IF (ALLOCATED(SrcInputFileTypeData%dY_high)) THEN - i1_l = LBOUND(SrcInputFileTypeData%dY_high,1) - i1_u = UBOUND(SrcInputFileTypeData%dY_high,1) - IF (.NOT. ALLOCATED(DstInputFileTypeData%dY_high)) THEN - ALLOCATE(DstInputFileTypeData%dY_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%dY_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileTypeData%dY_high = SrcInputFileTypeData%dY_high -ENDIF -IF (ALLOCATED(SrcInputFileTypeData%dZ_high)) THEN - i1_l = LBOUND(SrcInputFileTypeData%dZ_high,1) - i1_u = UBOUND(SrcInputFileTypeData%dZ_high,1) - IF (.NOT. ALLOCATED(DstInputFileTypeData%dZ_high)) THEN - ALLOCATE(DstInputFileTypeData%dZ_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%dZ_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileTypeData%dZ_high = SrcInputFileTypeData%dZ_high -ENDIF - DstInputFileTypeData%nX_high = SrcInputFileTypeData%nX_high - DstInputFileTypeData%nY_high = SrcInputFileTypeData%nY_high - DstInputFileTypeData%nZ_high = SrcInputFileTypeData%nZ_high - DstInputFileTypeData%dX_low = SrcInputFileTypeData%dX_low - DstInputFileTypeData%dY_low = SrcInputFileTypeData%dY_low - DstInputFileTypeData%dZ_low = SrcInputFileTypeData%dZ_low - DstInputFileTypeData%nX_low = SrcInputFileTypeData%nX_low - DstInputFileTypeData%nY_low = SrcInputFileTypeData%nY_low - DstInputFileTypeData%nZ_low = SrcInputFileTypeData%nZ_low - DstInputFileTypeData%X0_low = SrcInputFileTypeData%X0_low - DstInputFileTypeData%Y0_low = SrcInputFileTypeData%Y0_low - DstInputFileTypeData%Z0_low = SrcInputFileTypeData%Z0_low -IF (ALLOCATED(SrcInputFileTypeData%WT_Position)) THEN - i1_l = LBOUND(SrcInputFileTypeData%WT_Position,1) - i1_u = UBOUND(SrcInputFileTypeData%WT_Position,1) - i2_l = LBOUND(SrcInputFileTypeData%WT_Position,2) - i2_u = UBOUND(SrcInputFileTypeData%WT_Position,2) - IF (.NOT. ALLOCATED(DstInputFileTypeData%WT_Position)) THEN - ALLOCATE(DstInputFileTypeData%WT_Position(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%WT_Position.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileTypeData%WT_Position = SrcInputFileTypeData%WT_Position -ENDIF - DstInputFileTypeData%Mod_Projection = SrcInputFileTypeData%Mod_Projection - END SUBROUTINE AWAE_CopyInputFileType - - SUBROUTINE AWAE_DestroyInputFileType( InputFileTypeData, ErrStat, ErrMsg ) - TYPE(AWAE_InputFileType), INTENT(INOUT) :: InputFileTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyInputFileType' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputFileTypeData%OutDisWindZ)) THEN - DEALLOCATE(InputFileTypeData%OutDisWindZ) -ENDIF -IF (ALLOCATED(InputFileTypeData%OutDisWindX)) THEN - DEALLOCATE(InputFileTypeData%OutDisWindX) -ENDIF -IF (ALLOCATED(InputFileTypeData%OutDisWindY)) THEN - DEALLOCATE(InputFileTypeData%OutDisWindY) -ENDIF -IF (ALLOCATED(InputFileTypeData%X0_high)) THEN - DEALLOCATE(InputFileTypeData%X0_high) -ENDIF -IF (ALLOCATED(InputFileTypeData%Y0_high)) THEN - DEALLOCATE(InputFileTypeData%Y0_high) -ENDIF -IF (ALLOCATED(InputFileTypeData%Z0_high)) THEN - DEALLOCATE(InputFileTypeData%Z0_high) -ENDIF -IF (ALLOCATED(InputFileTypeData%dX_high)) THEN - DEALLOCATE(InputFileTypeData%dX_high) -ENDIF -IF (ALLOCATED(InputFileTypeData%dY_high)) THEN - DEALLOCATE(InputFileTypeData%dY_high) -ENDIF -IF (ALLOCATED(InputFileTypeData%dZ_high)) THEN - DEALLOCATE(InputFileTypeData%dZ_high) -ENDIF -IF (ALLOCATED(InputFileTypeData%WT_Position)) THEN - DEALLOCATE(InputFileTypeData%WT_Position) -ENDIF - END SUBROUTINE AWAE_DestroyInputFileType +subroutine AWAE_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, CtrlCode, ErrStat, ErrMsg) + type(AWAE_InputFileType), intent(in) :: SrcInputFileTypeData + type(AWAE_InputFileType), intent(inout) :: DstInputFileTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AWAE_CopyInputFileType' + ErrStat = ErrID_None + ErrMsg = '' + DstInputFileTypeData%dr = SrcInputFileTypeData%dr + DstInputFileTypeData%dt_low = SrcInputFileTypeData%dt_low + DstInputFileTypeData%NumTurbines = SrcInputFileTypeData%NumTurbines + DstInputFileTypeData%NumRadii = SrcInputFileTypeData%NumRadii + DstInputFileTypeData%NumPlanes = SrcInputFileTypeData%NumPlanes + DstInputFileTypeData%WindFilePath = SrcInputFileTypeData%WindFilePath + DstInputFileTypeData%WrDisWind = SrcInputFileTypeData%WrDisWind + DstInputFileTypeData%NOutDisWindXY = SrcInputFileTypeData%NOutDisWindXY + if (allocated(SrcInputFileTypeData%OutDisWindZ)) then + LB(1:1) = lbound(SrcInputFileTypeData%OutDisWindZ) + UB(1:1) = ubound(SrcInputFileTypeData%OutDisWindZ) + if (.not. allocated(DstInputFileTypeData%OutDisWindZ)) then + allocate(DstInputFileTypeData%OutDisWindZ(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%OutDisWindZ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileTypeData%OutDisWindZ = SrcInputFileTypeData%OutDisWindZ + else if (allocated(DstInputFileTypeData%OutDisWindZ)) then + deallocate(DstInputFileTypeData%OutDisWindZ) + end if + DstInputFileTypeData%NOutDisWindYZ = SrcInputFileTypeData%NOutDisWindYZ + if (allocated(SrcInputFileTypeData%OutDisWindX)) then + LB(1:1) = lbound(SrcInputFileTypeData%OutDisWindX) + UB(1:1) = ubound(SrcInputFileTypeData%OutDisWindX) + if (.not. allocated(DstInputFileTypeData%OutDisWindX)) then + allocate(DstInputFileTypeData%OutDisWindX(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%OutDisWindX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileTypeData%OutDisWindX = SrcInputFileTypeData%OutDisWindX + else if (allocated(DstInputFileTypeData%OutDisWindX)) then + deallocate(DstInputFileTypeData%OutDisWindX) + end if + DstInputFileTypeData%NOutDisWindXZ = SrcInputFileTypeData%NOutDisWindXZ + if (allocated(SrcInputFileTypeData%OutDisWindY)) then + LB(1:1) = lbound(SrcInputFileTypeData%OutDisWindY) + UB(1:1) = ubound(SrcInputFileTypeData%OutDisWindY) + if (.not. allocated(DstInputFileTypeData%OutDisWindY)) then + allocate(DstInputFileTypeData%OutDisWindY(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%OutDisWindY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileTypeData%OutDisWindY = SrcInputFileTypeData%OutDisWindY + else if (allocated(DstInputFileTypeData%OutDisWindY)) then + deallocate(DstInputFileTypeData%OutDisWindY) + end if + DstInputFileTypeData%WrDisDT = SrcInputFileTypeData%WrDisDT + DstInputFileTypeData%ChkWndFiles = SrcInputFileTypeData%ChkWndFiles + DstInputFileTypeData%Mod_Meander = SrcInputFileTypeData%Mod_Meander + DstInputFileTypeData%C_Meander = SrcInputFileTypeData%C_Meander + DstInputFileTypeData%Mod_AmbWind = SrcInputFileTypeData%Mod_AmbWind + DstInputFileTypeData%InflowFile = SrcInputFileTypeData%InflowFile + DstInputFileTypeData%dt_high = SrcInputFileTypeData%dt_high + if (allocated(SrcInputFileTypeData%X0_high)) then + LB(1:1) = lbound(SrcInputFileTypeData%X0_high) + UB(1:1) = ubound(SrcInputFileTypeData%X0_high) + if (.not. allocated(DstInputFileTypeData%X0_high)) then + allocate(DstInputFileTypeData%X0_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%X0_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileTypeData%X0_high = SrcInputFileTypeData%X0_high + else if (allocated(DstInputFileTypeData%X0_high)) then + deallocate(DstInputFileTypeData%X0_high) + end if + if (allocated(SrcInputFileTypeData%Y0_high)) then + LB(1:1) = lbound(SrcInputFileTypeData%Y0_high) + UB(1:1) = ubound(SrcInputFileTypeData%Y0_high) + if (.not. allocated(DstInputFileTypeData%Y0_high)) then + allocate(DstInputFileTypeData%Y0_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%Y0_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileTypeData%Y0_high = SrcInputFileTypeData%Y0_high + else if (allocated(DstInputFileTypeData%Y0_high)) then + deallocate(DstInputFileTypeData%Y0_high) + end if + if (allocated(SrcInputFileTypeData%Z0_high)) then + LB(1:1) = lbound(SrcInputFileTypeData%Z0_high) + UB(1:1) = ubound(SrcInputFileTypeData%Z0_high) + if (.not. allocated(DstInputFileTypeData%Z0_high)) then + allocate(DstInputFileTypeData%Z0_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%Z0_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileTypeData%Z0_high = SrcInputFileTypeData%Z0_high + else if (allocated(DstInputFileTypeData%Z0_high)) then + deallocate(DstInputFileTypeData%Z0_high) + end if + if (allocated(SrcInputFileTypeData%dX_high)) then + LB(1:1) = lbound(SrcInputFileTypeData%dX_high) + UB(1:1) = ubound(SrcInputFileTypeData%dX_high) + if (.not. allocated(DstInputFileTypeData%dX_high)) then + allocate(DstInputFileTypeData%dX_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%dX_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileTypeData%dX_high = SrcInputFileTypeData%dX_high + else if (allocated(DstInputFileTypeData%dX_high)) then + deallocate(DstInputFileTypeData%dX_high) + end if + if (allocated(SrcInputFileTypeData%dY_high)) then + LB(1:1) = lbound(SrcInputFileTypeData%dY_high) + UB(1:1) = ubound(SrcInputFileTypeData%dY_high) + if (.not. allocated(DstInputFileTypeData%dY_high)) then + allocate(DstInputFileTypeData%dY_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%dY_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileTypeData%dY_high = SrcInputFileTypeData%dY_high + else if (allocated(DstInputFileTypeData%dY_high)) then + deallocate(DstInputFileTypeData%dY_high) + end if + if (allocated(SrcInputFileTypeData%dZ_high)) then + LB(1:1) = lbound(SrcInputFileTypeData%dZ_high) + UB(1:1) = ubound(SrcInputFileTypeData%dZ_high) + if (.not. allocated(DstInputFileTypeData%dZ_high)) then + allocate(DstInputFileTypeData%dZ_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%dZ_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileTypeData%dZ_high = SrcInputFileTypeData%dZ_high + else if (allocated(DstInputFileTypeData%dZ_high)) then + deallocate(DstInputFileTypeData%dZ_high) + end if + DstInputFileTypeData%nX_high = SrcInputFileTypeData%nX_high + DstInputFileTypeData%nY_high = SrcInputFileTypeData%nY_high + DstInputFileTypeData%nZ_high = SrcInputFileTypeData%nZ_high + DstInputFileTypeData%dX_low = SrcInputFileTypeData%dX_low + DstInputFileTypeData%dY_low = SrcInputFileTypeData%dY_low + DstInputFileTypeData%dZ_low = SrcInputFileTypeData%dZ_low + DstInputFileTypeData%nX_low = SrcInputFileTypeData%nX_low + DstInputFileTypeData%nY_low = SrcInputFileTypeData%nY_low + DstInputFileTypeData%nZ_low = SrcInputFileTypeData%nZ_low + DstInputFileTypeData%X0_low = SrcInputFileTypeData%X0_low + DstInputFileTypeData%Y0_low = SrcInputFileTypeData%Y0_low + DstInputFileTypeData%Z0_low = SrcInputFileTypeData%Z0_low + if (allocated(SrcInputFileTypeData%WT_Position)) then + LB(1:2) = lbound(SrcInputFileTypeData%WT_Position) + UB(1:2) = ubound(SrcInputFileTypeData%WT_Position) + if (.not. allocated(DstInputFileTypeData%WT_Position)) then + allocate(DstInputFileTypeData%WT_Position(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileTypeData%WT_Position.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileTypeData%WT_Position = SrcInputFileTypeData%WT_Position + else if (allocated(DstInputFileTypeData%WT_Position)) then + deallocate(DstInputFileTypeData%WT_Position) + end if + DstInputFileTypeData%Mod_Projection = SrcInputFileTypeData%Mod_Projection +end subroutine +subroutine AWAE_DestroyInputFileType(InputFileTypeData, ErrStat, ErrMsg) + type(AWAE_InputFileType), intent(inout) :: InputFileTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AWAE_DestroyInputFileType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputFileTypeData%OutDisWindZ)) then + deallocate(InputFileTypeData%OutDisWindZ) + end if + if (allocated(InputFileTypeData%OutDisWindX)) then + deallocate(InputFileTypeData%OutDisWindX) + end if + if (allocated(InputFileTypeData%OutDisWindY)) then + deallocate(InputFileTypeData%OutDisWindY) + end if + if (allocated(InputFileTypeData%X0_high)) then + deallocate(InputFileTypeData%X0_high) + end if + if (allocated(InputFileTypeData%Y0_high)) then + deallocate(InputFileTypeData%Y0_high) + end if + if (allocated(InputFileTypeData%Z0_high)) then + deallocate(InputFileTypeData%Z0_high) + end if + if (allocated(InputFileTypeData%dX_high)) then + deallocate(InputFileTypeData%dX_high) + end if + if (allocated(InputFileTypeData%dY_high)) then + deallocate(InputFileTypeData%dY_high) + end if + if (allocated(InputFileTypeData%dZ_high)) then + deallocate(InputFileTypeData%dZ_high) + end if + if (allocated(InputFileTypeData%WT_Position)) then + deallocate(InputFileTypeData%WT_Position) + end if +end subroutine subroutine AWAE_PackInputFileType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AWAE_InputFileType), intent(in) :: InData character(*), parameter :: RoutineName = 'AWAE_PackInputFileType' if (Buf%ErrStat >= AbortErrLev) return - ! dr call RegPack(Buf, InData%dr) if (RegCheckErr(Buf, RoutineName)) return - ! dt_low call RegPack(Buf, InData%dt_low) if (RegCheckErr(Buf, RoutineName)) return - ! NumTurbines call RegPack(Buf, InData%NumTurbines) if (RegCheckErr(Buf, RoutineName)) return - ! NumRadii call RegPack(Buf, InData%NumRadii) if (RegCheckErr(Buf, RoutineName)) return - ! NumPlanes call RegPack(Buf, InData%NumPlanes) if (RegCheckErr(Buf, RoutineName)) return - ! WindFilePath call RegPack(Buf, InData%WindFilePath) if (RegCheckErr(Buf, RoutineName)) return - ! WrDisWind call RegPack(Buf, InData%WrDisWind) if (RegCheckErr(Buf, RoutineName)) return - ! NOutDisWindXY call RegPack(Buf, InData%NOutDisWindXY) if (RegCheckErr(Buf, RoutineName)) return - ! OutDisWindZ call RegPack(Buf, allocated(InData%OutDisWindZ)) if (allocated(InData%OutDisWindZ)) then call RegPackBounds(Buf, 1, lbound(InData%OutDisWindZ), ubound(InData%OutDisWindZ)) call RegPack(Buf, InData%OutDisWindZ) end if if (RegCheckErr(Buf, RoutineName)) return - ! NOutDisWindYZ call RegPack(Buf, InData%NOutDisWindYZ) if (RegCheckErr(Buf, RoutineName)) return - ! OutDisWindX call RegPack(Buf, allocated(InData%OutDisWindX)) if (allocated(InData%OutDisWindX)) then call RegPackBounds(Buf, 1, lbound(InData%OutDisWindX), ubound(InData%OutDisWindX)) call RegPack(Buf, InData%OutDisWindX) end if if (RegCheckErr(Buf, RoutineName)) return - ! NOutDisWindXZ call RegPack(Buf, InData%NOutDisWindXZ) if (RegCheckErr(Buf, RoutineName)) return - ! OutDisWindY call RegPack(Buf, allocated(InData%OutDisWindY)) if (allocated(InData%OutDisWindY)) then call RegPackBounds(Buf, 1, lbound(InData%OutDisWindY), ubound(InData%OutDisWindY)) call RegPack(Buf, InData%OutDisWindY) end if if (RegCheckErr(Buf, RoutineName)) return - ! WrDisDT call RegPack(Buf, InData%WrDisDT) if (RegCheckErr(Buf, RoutineName)) return - ! ChkWndFiles call RegPack(Buf, InData%ChkWndFiles) if (RegCheckErr(Buf, RoutineName)) return - ! Mod_Meander call RegPack(Buf, InData%Mod_Meander) if (RegCheckErr(Buf, RoutineName)) return - ! C_Meander call RegPack(Buf, InData%C_Meander) if (RegCheckErr(Buf, RoutineName)) return - ! Mod_AmbWind call RegPack(Buf, InData%Mod_AmbWind) if (RegCheckErr(Buf, RoutineName)) return - ! InflowFile call RegPack(Buf, InData%InflowFile) if (RegCheckErr(Buf, RoutineName)) return - ! dt_high call RegPack(Buf, InData%dt_high) if (RegCheckErr(Buf, RoutineName)) return - ! X0_high call RegPack(Buf, allocated(InData%X0_high)) if (allocated(InData%X0_high)) then call RegPackBounds(Buf, 1, lbound(InData%X0_high), ubound(InData%X0_high)) call RegPack(Buf, InData%X0_high) end if if (RegCheckErr(Buf, RoutineName)) return - ! Y0_high call RegPack(Buf, allocated(InData%Y0_high)) if (allocated(InData%Y0_high)) then call RegPackBounds(Buf, 1, lbound(InData%Y0_high), ubound(InData%Y0_high)) call RegPack(Buf, InData%Y0_high) end if if (RegCheckErr(Buf, RoutineName)) return - ! Z0_high call RegPack(Buf, allocated(InData%Z0_high)) if (allocated(InData%Z0_high)) then call RegPackBounds(Buf, 1, lbound(InData%Z0_high), ubound(InData%Z0_high)) call RegPack(Buf, InData%Z0_high) end if if (RegCheckErr(Buf, RoutineName)) return - ! dX_high call RegPack(Buf, allocated(InData%dX_high)) if (allocated(InData%dX_high)) then call RegPackBounds(Buf, 1, lbound(InData%dX_high), ubound(InData%dX_high)) call RegPack(Buf, InData%dX_high) end if if (RegCheckErr(Buf, RoutineName)) return - ! dY_high call RegPack(Buf, allocated(InData%dY_high)) if (allocated(InData%dY_high)) then call RegPackBounds(Buf, 1, lbound(InData%dY_high), ubound(InData%dY_high)) call RegPack(Buf, InData%dY_high) end if if (RegCheckErr(Buf, RoutineName)) return - ! dZ_high call RegPack(Buf, allocated(InData%dZ_high)) if (allocated(InData%dZ_high)) then call RegPackBounds(Buf, 1, lbound(InData%dZ_high), ubound(InData%dZ_high)) call RegPack(Buf, InData%dZ_high) end if if (RegCheckErr(Buf, RoutineName)) return - ! nX_high call RegPack(Buf, InData%nX_high) if (RegCheckErr(Buf, RoutineName)) return - ! nY_high call RegPack(Buf, InData%nY_high) if (RegCheckErr(Buf, RoutineName)) return - ! nZ_high call RegPack(Buf, InData%nZ_high) if (RegCheckErr(Buf, RoutineName)) return - ! dX_low call RegPack(Buf, InData%dX_low) if (RegCheckErr(Buf, RoutineName)) return - ! dY_low call RegPack(Buf, InData%dY_low) if (RegCheckErr(Buf, RoutineName)) return - ! dZ_low call RegPack(Buf, InData%dZ_low) if (RegCheckErr(Buf, RoutineName)) return - ! nX_low call RegPack(Buf, InData%nX_low) if (RegCheckErr(Buf, RoutineName)) return - ! nY_low call RegPack(Buf, InData%nY_low) if (RegCheckErr(Buf, RoutineName)) return - ! nZ_low call RegPack(Buf, InData%nZ_low) if (RegCheckErr(Buf, RoutineName)) return - ! X0_low call RegPack(Buf, InData%X0_low) if (RegCheckErr(Buf, RoutineName)) return - ! Y0_low call RegPack(Buf, InData%Y0_low) if (RegCheckErr(Buf, RoutineName)) return - ! Z0_low call RegPack(Buf, InData%Z0_low) if (RegCheckErr(Buf, RoutineName)) return - ! WT_Position call RegPack(Buf, allocated(InData%WT_Position)) if (allocated(InData%WT_Position)) then call RegPackBounds(Buf, 2, lbound(InData%WT_Position), ubound(InData%WT_Position)) call RegPack(Buf, InData%WT_Position) end if if (RegCheckErr(Buf, RoutineName)) return - ! Mod_Projection call RegPack(Buf, InData%Mod_Projection) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -845,31 +774,22 @@ subroutine AWAE_UnPackInputFileType(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! dr call RegUnpack(Buf, OutData%dr) if (RegCheckErr(Buf, RoutineName)) return - ! dt_low call RegUnpack(Buf, OutData%dt_low) if (RegCheckErr(Buf, RoutineName)) return - ! NumTurbines call RegUnpack(Buf, OutData%NumTurbines) if (RegCheckErr(Buf, RoutineName)) return - ! NumRadii call RegUnpack(Buf, OutData%NumRadii) if (RegCheckErr(Buf, RoutineName)) return - ! NumPlanes call RegUnpack(Buf, OutData%NumPlanes) if (RegCheckErr(Buf, RoutineName)) return - ! WindFilePath call RegUnpack(Buf, OutData%WindFilePath) if (RegCheckErr(Buf, RoutineName)) return - ! WrDisWind call RegUnpack(Buf, OutData%WrDisWind) if (RegCheckErr(Buf, RoutineName)) return - ! NOutDisWindXY call RegUnpack(Buf, OutData%NOutDisWindXY) if (RegCheckErr(Buf, RoutineName)) return - ! OutDisWindZ if (allocated(OutData%OutDisWindZ)) deallocate(OutData%OutDisWindZ) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -884,10 +804,8 @@ subroutine AWAE_UnPackInputFileType(Buf, OutData) call RegUnpack(Buf, OutData%OutDisWindZ) if (RegCheckErr(Buf, RoutineName)) return end if - ! NOutDisWindYZ call RegUnpack(Buf, OutData%NOutDisWindYZ) if (RegCheckErr(Buf, RoutineName)) return - ! OutDisWindX if (allocated(OutData%OutDisWindX)) deallocate(OutData%OutDisWindX) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -902,10 +820,8 @@ subroutine AWAE_UnPackInputFileType(Buf, OutData) call RegUnpack(Buf, OutData%OutDisWindX) if (RegCheckErr(Buf, RoutineName)) return end if - ! NOutDisWindXZ call RegUnpack(Buf, OutData%NOutDisWindXZ) if (RegCheckErr(Buf, RoutineName)) return - ! OutDisWindY if (allocated(OutData%OutDisWindY)) deallocate(OutData%OutDisWindY) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -920,28 +836,20 @@ subroutine AWAE_UnPackInputFileType(Buf, OutData) call RegUnpack(Buf, OutData%OutDisWindY) if (RegCheckErr(Buf, RoutineName)) return end if - ! WrDisDT call RegUnpack(Buf, OutData%WrDisDT) if (RegCheckErr(Buf, RoutineName)) return - ! ChkWndFiles call RegUnpack(Buf, OutData%ChkWndFiles) if (RegCheckErr(Buf, RoutineName)) return - ! Mod_Meander call RegUnpack(Buf, OutData%Mod_Meander) if (RegCheckErr(Buf, RoutineName)) return - ! C_Meander call RegUnpack(Buf, OutData%C_Meander) if (RegCheckErr(Buf, RoutineName)) return - ! Mod_AmbWind call RegUnpack(Buf, OutData%Mod_AmbWind) if (RegCheckErr(Buf, RoutineName)) return - ! InflowFile call RegUnpack(Buf, OutData%InflowFile) if (RegCheckErr(Buf, RoutineName)) return - ! dt_high call RegUnpack(Buf, OutData%dt_high) if (RegCheckErr(Buf, RoutineName)) return - ! X0_high if (allocated(OutData%X0_high)) deallocate(OutData%X0_high) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -956,7 +864,6 @@ subroutine AWAE_UnPackInputFileType(Buf, OutData) call RegUnpack(Buf, OutData%X0_high) if (RegCheckErr(Buf, RoutineName)) return end if - ! Y0_high if (allocated(OutData%Y0_high)) deallocate(OutData%Y0_high) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -971,7 +878,6 @@ subroutine AWAE_UnPackInputFileType(Buf, OutData) call RegUnpack(Buf, OutData%Y0_high) if (RegCheckErr(Buf, RoutineName)) return end if - ! Z0_high if (allocated(OutData%Z0_high)) deallocate(OutData%Z0_high) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -986,7 +892,6 @@ subroutine AWAE_UnPackInputFileType(Buf, OutData) call RegUnpack(Buf, OutData%Z0_high) if (RegCheckErr(Buf, RoutineName)) return end if - ! dX_high if (allocated(OutData%dX_high)) deallocate(OutData%dX_high) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1001,7 +906,6 @@ subroutine AWAE_UnPackInputFileType(Buf, OutData) call RegUnpack(Buf, OutData%dX_high) if (RegCheckErr(Buf, RoutineName)) return end if - ! dY_high if (allocated(OutData%dY_high)) deallocate(OutData%dY_high) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1016,7 +920,6 @@ subroutine AWAE_UnPackInputFileType(Buf, OutData) call RegUnpack(Buf, OutData%dY_high) if (RegCheckErr(Buf, RoutineName)) return end if - ! dZ_high if (allocated(OutData%dZ_high)) deallocate(OutData%dZ_high) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1031,43 +934,30 @@ subroutine AWAE_UnPackInputFileType(Buf, OutData) call RegUnpack(Buf, OutData%dZ_high) if (RegCheckErr(Buf, RoutineName)) return end if - ! nX_high call RegUnpack(Buf, OutData%nX_high) if (RegCheckErr(Buf, RoutineName)) return - ! nY_high call RegUnpack(Buf, OutData%nY_high) if (RegCheckErr(Buf, RoutineName)) return - ! nZ_high call RegUnpack(Buf, OutData%nZ_high) if (RegCheckErr(Buf, RoutineName)) return - ! dX_low call RegUnpack(Buf, OutData%dX_low) if (RegCheckErr(Buf, RoutineName)) return - ! dY_low call RegUnpack(Buf, OutData%dY_low) if (RegCheckErr(Buf, RoutineName)) return - ! dZ_low call RegUnpack(Buf, OutData%dZ_low) if (RegCheckErr(Buf, RoutineName)) return - ! nX_low call RegUnpack(Buf, OutData%nX_low) if (RegCheckErr(Buf, RoutineName)) return - ! nY_low call RegUnpack(Buf, OutData%nY_low) if (RegCheckErr(Buf, RoutineName)) return - ! nZ_low call RegUnpack(Buf, OutData%nZ_low) if (RegCheckErr(Buf, RoutineName)) return - ! X0_low call RegUnpack(Buf, OutData%X0_low) if (RegCheckErr(Buf, RoutineName)) return - ! Y0_low call RegUnpack(Buf, OutData%Y0_low) if (RegCheckErr(Buf, RoutineName)) return - ! Z0_low call RegUnpack(Buf, OutData%Z0_low) if (RegCheckErr(Buf, RoutineName)) return - ! WT_Position if (allocated(OutData%WT_Position)) deallocate(OutData%WT_Position) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1082,65 +972,51 @@ subroutine AWAE_UnPackInputFileType(Buf, OutData) call RegUnpack(Buf, OutData%WT_Position) if (RegCheckErr(Buf, RoutineName)) return end if - ! Mod_Projection call RegUnpack(Buf, OutData%Mod_Projection) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE AWAE_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AWAE_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(AWAE_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL AWAE_Copyinputfiletype( SrcInitInputData%InputFileData, DstInitInputData%InputFileData, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitInputData%n_high_low = SrcInitInputData%n_high_low - DstInitInputData%NumDT = SrcInitInputData%NumDT - DstInitInputData%OutFileRoot = SrcInitInputData%OutFileRoot - END SUBROUTINE AWAE_CopyInitInput - - SUBROUTINE AWAE_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(AWAE_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - CALL AWAE_DestroyInputFileType( InitInputData%InputFileData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AWAE_DestroyInitInput +subroutine AWAE_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(AWAE_InitInputType), intent(in) :: SrcInitInputData + type(AWAE_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + call AWAE_CopyInputFileType(SrcInitInputData%InputFileData, DstInitInputData%InputFileData, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitInputData%n_high_low = SrcInitInputData%n_high_low + DstInitInputData%NumDT = SrcInitInputData%NumDT + DstInitInputData%OutFileRoot = SrcInitInputData%OutFileRoot +end subroutine +subroutine AWAE_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(AWAE_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine AWAE_PackInitInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AWAE_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AWAE_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return - ! InputFileData call AWAE_PackInputFileType(Buf, InData%InputFileData) if (RegCheckErr(Buf, RoutineName)) return - ! n_high_low call RegPack(Buf, InData%n_high_low) if (RegCheckErr(Buf, RoutineName)) return - ! NumDT call RegPack(Buf, InData%NumDT) if (RegCheckErr(Buf, RoutineName)) return - ! OutFileRoot call RegPack(Buf, InData%OutFileRoot) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1150,180 +1026,186 @@ subroutine AWAE_UnPackInitInput(Buf, OutData) type(AWAE_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackInitInput' if (Buf%ErrStat /= ErrID_None) return - ! InputFileData call AWAE_UnpackInputFileType(Buf, OutData%InputFileData) ! InputFileData - ! n_high_low call RegUnpack(Buf, OutData%n_high_low) if (RegCheckErr(Buf, RoutineName)) return - ! NumDT call RegUnpack(Buf, OutData%NumDT) if (RegCheckErr(Buf, RoutineName)) return - ! OutFileRoot call RegUnpack(Buf, OutData%OutFileRoot) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE AWAE_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AWAE_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(AWAE_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_CopyInitOutput' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInitOutputData%X0_high)) THEN - i1_l = LBOUND(SrcInitOutputData%X0_high,1) - i1_u = UBOUND(SrcInitOutputData%X0_high,1) - IF (.NOT. ALLOCATED(DstInitOutputData%X0_high)) THEN - ALLOCATE(DstInitOutputData%X0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%X0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%X0_high = SrcInitOutputData%X0_high -ENDIF -IF (ALLOCATED(SrcInitOutputData%Y0_high)) THEN - i1_l = LBOUND(SrcInitOutputData%Y0_high,1) - i1_u = UBOUND(SrcInitOutputData%Y0_high,1) - IF (.NOT. ALLOCATED(DstInitOutputData%Y0_high)) THEN - ALLOCATE(DstInitOutputData%Y0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%Y0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%Y0_high = SrcInitOutputData%Y0_high -ENDIF -IF (ALLOCATED(SrcInitOutputData%Z0_high)) THEN - i1_l = LBOUND(SrcInitOutputData%Z0_high,1) - i1_u = UBOUND(SrcInitOutputData%Z0_high,1) - IF (.NOT. ALLOCATED(DstInitOutputData%Z0_high)) THEN - ALLOCATE(DstInitOutputData%Z0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%Z0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%Z0_high = SrcInitOutputData%Z0_high -ENDIF -IF (ALLOCATED(SrcInitOutputData%dX_high)) THEN - i1_l = LBOUND(SrcInitOutputData%dX_high,1) - i1_u = UBOUND(SrcInitOutputData%dX_high,1) - IF (.NOT. ALLOCATED(DstInitOutputData%dX_high)) THEN - ALLOCATE(DstInitOutputData%dX_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%dX_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%dX_high = SrcInitOutputData%dX_high -ENDIF -IF (ALLOCATED(SrcInitOutputData%dY_high)) THEN - i1_l = LBOUND(SrcInitOutputData%dY_high,1) - i1_u = UBOUND(SrcInitOutputData%dY_high,1) - IF (.NOT. ALLOCATED(DstInitOutputData%dY_high)) THEN - ALLOCATE(DstInitOutputData%dY_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%dY_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%dY_high = SrcInitOutputData%dY_high -ENDIF -IF (ALLOCATED(SrcInitOutputData%dZ_high)) THEN - i1_l = LBOUND(SrcInitOutputData%dZ_high,1) - i1_u = UBOUND(SrcInitOutputData%dZ_high,1) - IF (.NOT. ALLOCATED(DstInitOutputData%dZ_high)) THEN - ALLOCATE(DstInitOutputData%dZ_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%dZ_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%dZ_high = SrcInitOutputData%dZ_high -ENDIF - DstInitOutputData%nX_high = SrcInitOutputData%nX_high - DstInitOutputData%nY_high = SrcInitOutputData%nY_high - DstInitOutputData%nZ_high = SrcInitOutputData%nZ_high - DstInitOutputData%dX_low = SrcInitOutputData%dX_low - DstInitOutputData%dY_low = SrcInitOutputData%dY_low - DstInitOutputData%dZ_low = SrcInitOutputData%dZ_low - DstInitOutputData%nX_low = SrcInitOutputData%nX_low - DstInitOutputData%nY_low = SrcInitOutputData%nY_low - DstInitOutputData%nZ_low = SrcInitOutputData%nZ_low - DstInitOutputData%X0_low = SrcInitOutputData%X0_low - DstInitOutputData%Y0_low = SrcInitOutputData%Y0_low - DstInitOutputData%Z0_low = SrcInitOutputData%Z0_low -IF (ALLOCATED(SrcInitOutputData%Vdist_High)) THEN - i1_l = LBOUND(SrcInitOutputData%Vdist_High,1) - i1_u = UBOUND(SrcInitOutputData%Vdist_High,1) - IF (.NOT. ALLOCATED(DstInitOutputData%Vdist_High)) THEN - ALLOCATE(DstInitOutputData%Vdist_High(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%Vdist_High.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitOutputData%Vdist_High,1), UBOUND(SrcInitOutputData%Vdist_High,1) - CALL AWAE_Copyhighwindgridptr( SrcInitOutputData%Vdist_High(i1), DstInitOutputData%Vdist_High(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE AWAE_CopyInitOutput - - SUBROUTINE AWAE_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(AWAE_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyInitOutput' - ErrStat = ErrID_None - ErrMsg = "" - - CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitOutputData%X0_high)) THEN - DEALLOCATE(InitOutputData%X0_high) -ENDIF -IF (ALLOCATED(InitOutputData%Y0_high)) THEN - DEALLOCATE(InitOutputData%Y0_high) -ENDIF -IF (ALLOCATED(InitOutputData%Z0_high)) THEN - DEALLOCATE(InitOutputData%Z0_high) -ENDIF -IF (ALLOCATED(InitOutputData%dX_high)) THEN - DEALLOCATE(InitOutputData%dX_high) -ENDIF -IF (ALLOCATED(InitOutputData%dY_high)) THEN - DEALLOCATE(InitOutputData%dY_high) -ENDIF -IF (ALLOCATED(InitOutputData%dZ_high)) THEN - DEALLOCATE(InitOutputData%dZ_high) -ENDIF -IF (ALLOCATED(InitOutputData%Vdist_High)) THEN -DO i1 = LBOUND(InitOutputData%Vdist_High,1), UBOUND(InitOutputData%Vdist_High,1) - CALL AWAE_DestroyHighWindGridPtr( InitOutputData%Vdist_High(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InitOutputData%Vdist_High) -ENDIF - END SUBROUTINE AWAE_DestroyInitOutput +subroutine AWAE_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(AWAE_InitOutputType), intent(in) :: SrcInitOutputData + type(AWAE_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_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%X0_high)) then + LB(1:1) = lbound(SrcInitOutputData%X0_high) + UB(1:1) = ubound(SrcInitOutputData%X0_high) + if (.not. allocated(DstInitOutputData%X0_high)) then + allocate(DstInitOutputData%X0_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%X0_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%X0_high = SrcInitOutputData%X0_high + else if (allocated(DstInitOutputData%X0_high)) then + deallocate(DstInitOutputData%X0_high) + end if + if (allocated(SrcInitOutputData%Y0_high)) then + LB(1:1) = lbound(SrcInitOutputData%Y0_high) + UB(1:1) = ubound(SrcInitOutputData%Y0_high) + if (.not. allocated(DstInitOutputData%Y0_high)) then + allocate(DstInitOutputData%Y0_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%Y0_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%Y0_high = SrcInitOutputData%Y0_high + else if (allocated(DstInitOutputData%Y0_high)) then + deallocate(DstInitOutputData%Y0_high) + end if + if (allocated(SrcInitOutputData%Z0_high)) then + LB(1:1) = lbound(SrcInitOutputData%Z0_high) + UB(1:1) = ubound(SrcInitOutputData%Z0_high) + if (.not. allocated(DstInitOutputData%Z0_high)) then + allocate(DstInitOutputData%Z0_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%Z0_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%Z0_high = SrcInitOutputData%Z0_high + else if (allocated(DstInitOutputData%Z0_high)) then + deallocate(DstInitOutputData%Z0_high) + end if + if (allocated(SrcInitOutputData%dX_high)) then + LB(1:1) = lbound(SrcInitOutputData%dX_high) + UB(1:1) = ubound(SrcInitOutputData%dX_high) + if (.not. allocated(DstInitOutputData%dX_high)) then + allocate(DstInitOutputData%dX_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%dX_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%dX_high = SrcInitOutputData%dX_high + else if (allocated(DstInitOutputData%dX_high)) then + deallocate(DstInitOutputData%dX_high) + end if + if (allocated(SrcInitOutputData%dY_high)) then + LB(1:1) = lbound(SrcInitOutputData%dY_high) + UB(1:1) = ubound(SrcInitOutputData%dY_high) + if (.not. allocated(DstInitOutputData%dY_high)) then + allocate(DstInitOutputData%dY_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%dY_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%dY_high = SrcInitOutputData%dY_high + else if (allocated(DstInitOutputData%dY_high)) then + deallocate(DstInitOutputData%dY_high) + end if + if (allocated(SrcInitOutputData%dZ_high)) then + LB(1:1) = lbound(SrcInitOutputData%dZ_high) + UB(1:1) = ubound(SrcInitOutputData%dZ_high) + if (.not. allocated(DstInitOutputData%dZ_high)) then + allocate(DstInitOutputData%dZ_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%dZ_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%dZ_high = SrcInitOutputData%dZ_high + else if (allocated(DstInitOutputData%dZ_high)) then + deallocate(DstInitOutputData%dZ_high) + end if + DstInitOutputData%nX_high = SrcInitOutputData%nX_high + DstInitOutputData%nY_high = SrcInitOutputData%nY_high + DstInitOutputData%nZ_high = SrcInitOutputData%nZ_high + DstInitOutputData%dX_low = SrcInitOutputData%dX_low + DstInitOutputData%dY_low = SrcInitOutputData%dY_low + DstInitOutputData%dZ_low = SrcInitOutputData%dZ_low + DstInitOutputData%nX_low = SrcInitOutputData%nX_low + DstInitOutputData%nY_low = SrcInitOutputData%nY_low + DstInitOutputData%nZ_low = SrcInitOutputData%nZ_low + DstInitOutputData%X0_low = SrcInitOutputData%X0_low + DstInitOutputData%Y0_low = SrcInitOutputData%Y0_low + DstInitOutputData%Z0_low = SrcInitOutputData%Z0_low + if (allocated(SrcInitOutputData%Vdist_High)) then + LB(1:1) = lbound(SrcInitOutputData%Vdist_High) + UB(1:1) = ubound(SrcInitOutputData%Vdist_High) + if (.not. allocated(DstInitOutputData%Vdist_High)) then + allocate(DstInitOutputData%Vdist_High(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%Vdist_High.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AWAE_CopyHighWindGridPtr(SrcInitOutputData%Vdist_High(i1), DstInitOutputData%Vdist_High(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstInitOutputData%Vdist_High)) then + deallocate(DstInitOutputData%Vdist_High) + end if +end subroutine +subroutine AWAE_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(AWAE_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%X0_high)) then + deallocate(InitOutputData%X0_high) + end if + if (allocated(InitOutputData%Y0_high)) then + deallocate(InitOutputData%Y0_high) + end if + if (allocated(InitOutputData%Z0_high)) then + deallocate(InitOutputData%Z0_high) + end if + if (allocated(InitOutputData%dX_high)) then + deallocate(InitOutputData%dX_high) + end if + if (allocated(InitOutputData%dY_high)) then + deallocate(InitOutputData%dY_high) + end if + if (allocated(InitOutputData%dZ_high)) then + deallocate(InitOutputData%dZ_high) + end if + if (allocated(InitOutputData%Vdist_High)) then + LB(1:1) = lbound(InitOutputData%Vdist_High) + UB(1:1) = ubound(InitOutputData%Vdist_High) + do i1 = LB(1), UB(1) + call AWAE_DestroyHighWindGridPtr(InitOutputData%Vdist_High(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitOutputData%Vdist_High) + end if +end subroutine subroutine AWAE_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -1332,88 +1214,68 @@ subroutine AWAE_PackInitOutput(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! Ver call NWTC_Library_PackProgDesc(Buf, InData%Ver) if (RegCheckErr(Buf, RoutineName)) return - ! X0_high call RegPack(Buf, allocated(InData%X0_high)) if (allocated(InData%X0_high)) then call RegPackBounds(Buf, 1, lbound(InData%X0_high), ubound(InData%X0_high)) call RegPack(Buf, InData%X0_high) end if if (RegCheckErr(Buf, RoutineName)) return - ! Y0_high call RegPack(Buf, allocated(InData%Y0_high)) if (allocated(InData%Y0_high)) then call RegPackBounds(Buf, 1, lbound(InData%Y0_high), ubound(InData%Y0_high)) call RegPack(Buf, InData%Y0_high) end if if (RegCheckErr(Buf, RoutineName)) return - ! Z0_high call RegPack(Buf, allocated(InData%Z0_high)) if (allocated(InData%Z0_high)) then call RegPackBounds(Buf, 1, lbound(InData%Z0_high), ubound(InData%Z0_high)) call RegPack(Buf, InData%Z0_high) end if if (RegCheckErr(Buf, RoutineName)) return - ! dX_high call RegPack(Buf, allocated(InData%dX_high)) if (allocated(InData%dX_high)) then call RegPackBounds(Buf, 1, lbound(InData%dX_high), ubound(InData%dX_high)) call RegPack(Buf, InData%dX_high) end if if (RegCheckErr(Buf, RoutineName)) return - ! dY_high call RegPack(Buf, allocated(InData%dY_high)) if (allocated(InData%dY_high)) then call RegPackBounds(Buf, 1, lbound(InData%dY_high), ubound(InData%dY_high)) call RegPack(Buf, InData%dY_high) end if if (RegCheckErr(Buf, RoutineName)) return - ! dZ_high call RegPack(Buf, allocated(InData%dZ_high)) if (allocated(InData%dZ_high)) then call RegPackBounds(Buf, 1, lbound(InData%dZ_high), ubound(InData%dZ_high)) call RegPack(Buf, InData%dZ_high) end if if (RegCheckErr(Buf, RoutineName)) return - ! nX_high call RegPack(Buf, InData%nX_high) if (RegCheckErr(Buf, RoutineName)) return - ! nY_high call RegPack(Buf, InData%nY_high) if (RegCheckErr(Buf, RoutineName)) return - ! nZ_high call RegPack(Buf, InData%nZ_high) if (RegCheckErr(Buf, RoutineName)) return - ! dX_low call RegPack(Buf, InData%dX_low) if (RegCheckErr(Buf, RoutineName)) return - ! dY_low call RegPack(Buf, InData%dY_low) if (RegCheckErr(Buf, RoutineName)) return - ! dZ_low call RegPack(Buf, InData%dZ_low) if (RegCheckErr(Buf, RoutineName)) return - ! nX_low call RegPack(Buf, InData%nX_low) if (RegCheckErr(Buf, RoutineName)) return - ! nY_low call RegPack(Buf, InData%nY_low) if (RegCheckErr(Buf, RoutineName)) return - ! nZ_low call RegPack(Buf, InData%nZ_low) if (RegCheckErr(Buf, RoutineName)) return - ! X0_low call RegPack(Buf, InData%X0_low) if (RegCheckErr(Buf, RoutineName)) return - ! Y0_low call RegPack(Buf, InData%Y0_low) if (RegCheckErr(Buf, RoutineName)) return - ! Z0_low call RegPack(Buf, InData%Z0_low) if (RegCheckErr(Buf, RoutineName)) return - ! Vdist_High call RegPack(Buf, allocated(InData%Vdist_High)) if (allocated(InData%Vdist_High)) then call RegPackBounds(Buf, 1, lbound(InData%Vdist_High), ubound(InData%Vdist_High)) @@ -1435,9 +1297,7 @@ subroutine AWAE_UnPackInitOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! Ver call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver - ! X0_high if (allocated(OutData%X0_high)) deallocate(OutData%X0_high) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1452,7 +1312,6 @@ subroutine AWAE_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%X0_high) if (RegCheckErr(Buf, RoutineName)) return end if - ! Y0_high if (allocated(OutData%Y0_high)) deallocate(OutData%Y0_high) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1467,7 +1326,6 @@ subroutine AWAE_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%Y0_high) if (RegCheckErr(Buf, RoutineName)) return end if - ! Z0_high if (allocated(OutData%Z0_high)) deallocate(OutData%Z0_high) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1482,7 +1340,6 @@ subroutine AWAE_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%Z0_high) if (RegCheckErr(Buf, RoutineName)) return end if - ! dX_high if (allocated(OutData%dX_high)) deallocate(OutData%dX_high) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1497,7 +1354,6 @@ subroutine AWAE_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%dX_high) if (RegCheckErr(Buf, RoutineName)) return end if - ! dY_high if (allocated(OutData%dY_high)) deallocate(OutData%dY_high) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1512,7 +1368,6 @@ subroutine AWAE_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%dY_high) if (RegCheckErr(Buf, RoutineName)) return end if - ! dZ_high if (allocated(OutData%dZ_high)) deallocate(OutData%dZ_high) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1527,43 +1382,30 @@ subroutine AWAE_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%dZ_high) if (RegCheckErr(Buf, RoutineName)) return end if - ! nX_high call RegUnpack(Buf, OutData%nX_high) if (RegCheckErr(Buf, RoutineName)) return - ! nY_high call RegUnpack(Buf, OutData%nY_high) if (RegCheckErr(Buf, RoutineName)) return - ! nZ_high call RegUnpack(Buf, OutData%nZ_high) if (RegCheckErr(Buf, RoutineName)) return - ! dX_low call RegUnpack(Buf, OutData%dX_low) if (RegCheckErr(Buf, RoutineName)) return - ! dY_low call RegUnpack(Buf, OutData%dY_low) if (RegCheckErr(Buf, RoutineName)) return - ! dZ_low call RegUnpack(Buf, OutData%dZ_low) if (RegCheckErr(Buf, RoutineName)) return - ! nX_low call RegUnpack(Buf, OutData%nX_low) if (RegCheckErr(Buf, RoutineName)) return - ! nY_low call RegUnpack(Buf, OutData%nY_low) if (RegCheckErr(Buf, RoutineName)) return - ! nZ_low call RegUnpack(Buf, OutData%nZ_low) if (RegCheckErr(Buf, RoutineName)) return - ! X0_low call RegUnpack(Buf, OutData%X0_low) if (RegCheckErr(Buf, RoutineName)) return - ! Y0_low call RegUnpack(Buf, OutData%Y0_low) if (RegCheckErr(Buf, RoutineName)) return - ! Z0_low call RegUnpack(Buf, OutData%Z0_low) if (RegCheckErr(Buf, RoutineName)) return - ! Vdist_High if (allocated(OutData%Vdist_High)) deallocate(OutData%Vdist_High) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1580,61 +1422,61 @@ subroutine AWAE_UnPackInitOutput(Buf, OutData) end do end if end subroutine - SUBROUTINE AWAE_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AWAE_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(AWAE_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcContStateData%IfW)) THEN - i1_l = LBOUND(SrcContStateData%IfW,1) - i1_u = UBOUND(SrcContStateData%IfW,1) - IF (.NOT. ALLOCATED(DstContStateData%IfW)) THEN - ALLOCATE(DstContStateData%IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcContStateData%IfW,1), UBOUND(SrcContStateData%IfW,1) - CALL InflowWind_CopyContState( SrcContStateData%IfW(i1), DstContStateData%IfW(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE AWAE_CopyContState - SUBROUTINE AWAE_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(AWAE_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ContStateData%IfW)) THEN -DO i1 = LBOUND(ContStateData%IfW,1), UBOUND(ContStateData%IfW,1) - CALL InflowWind_DestroyContState( ContStateData%IfW(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ContStateData%IfW) -ENDIF - END SUBROUTINE AWAE_DestroyContState +subroutine AWAE_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(AWAE_ContinuousStateType), intent(in) :: SrcContStateData + type(AWAE_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcContStateData%IfW)) then + LB(1:1) = lbound(SrcContStateData%IfW) + UB(1:1) = ubound(SrcContStateData%IfW) + if (.not. allocated(DstContStateData%IfW)) then + allocate(DstContStateData%IfW(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%IfW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call InflowWind_CopyContState(SrcContStateData%IfW(i1), DstContStateData%IfW(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstContStateData%IfW)) then + deallocate(DstContStateData%IfW) + end if +end subroutine +subroutine AWAE_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(AWAE_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ContStateData%IfW)) then + LB(1:1) = lbound(ContStateData%IfW) + UB(1:1) = ubound(ContStateData%IfW) + do i1 = LB(1), UB(1) + call InflowWind_DestroyContState(ContStateData%IfW(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ContStateData%IfW) + end if +end subroutine subroutine AWAE_PackContState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -1643,7 +1485,6 @@ subroutine AWAE_PackContState(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! IfW call RegPack(Buf, allocated(InData%IfW)) if (allocated(InData%IfW)) then call RegPackBounds(Buf, 1, lbound(InData%IfW), ubound(InData%IfW)) @@ -1665,7 +1506,6 @@ subroutine AWAE_UnPackContState(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! IfW if (allocated(OutData%IfW)) deallocate(OutData%IfW) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1682,61 +1522,61 @@ subroutine AWAE_UnPackContState(Buf, OutData) end do end if end subroutine - SUBROUTINE AWAE_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AWAE_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(AWAE_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcDiscStateData%IfW)) THEN - i1_l = LBOUND(SrcDiscStateData%IfW,1) - i1_u = UBOUND(SrcDiscStateData%IfW,1) - IF (.NOT. ALLOCATED(DstDiscStateData%IfW)) THEN - ALLOCATE(DstDiscStateData%IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDiscStateData%IfW,1), UBOUND(SrcDiscStateData%IfW,1) - CALL InflowWind_CopyDiscState( SrcDiscStateData%IfW(i1), DstDiscStateData%IfW(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE AWAE_CopyDiscState - - SUBROUTINE AWAE_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(AWAE_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyDiscState' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(DiscStateData%IfW)) THEN -DO i1 = LBOUND(DiscStateData%IfW,1), UBOUND(DiscStateData%IfW,1) - CALL InflowWind_DestroyDiscState( DiscStateData%IfW(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(DiscStateData%IfW) -ENDIF - END SUBROUTINE AWAE_DestroyDiscState +subroutine AWAE_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(AWAE_DiscreteStateType), intent(in) :: SrcDiscStateData + type(AWAE_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcDiscStateData%IfW)) then + LB(1:1) = lbound(SrcDiscStateData%IfW) + UB(1:1) = ubound(SrcDiscStateData%IfW) + if (.not. allocated(DstDiscStateData%IfW)) then + allocate(DstDiscStateData%IfW(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%IfW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call InflowWind_CopyDiscState(SrcDiscStateData%IfW(i1), DstDiscStateData%IfW(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstDiscStateData%IfW)) then + deallocate(DstDiscStateData%IfW) + end if +end subroutine +subroutine AWAE_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(AWAE_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(DiscStateData%IfW)) then + LB(1:1) = lbound(DiscStateData%IfW) + UB(1:1) = ubound(DiscStateData%IfW) + do i1 = LB(1), UB(1) + call InflowWind_DestroyDiscState(DiscStateData%IfW(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(DiscStateData%IfW) + end if +end subroutine subroutine AWAE_PackDiscState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -1745,7 +1585,6 @@ subroutine AWAE_PackDiscState(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! IfW call RegPack(Buf, allocated(InData%IfW)) if (allocated(InData%IfW)) then call RegPackBounds(Buf, 1, lbound(InData%IfW), ubound(InData%IfW)) @@ -1767,7 +1606,6 @@ subroutine AWAE_UnPackDiscState(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! IfW if (allocated(OutData%IfW)) deallocate(OutData%IfW) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1784,61 +1622,61 @@ subroutine AWAE_UnPackDiscState(Buf, OutData) end do end if end subroutine - SUBROUTINE AWAE_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AWAE_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(AWAE_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcConstrStateData%IfW)) THEN - i1_l = LBOUND(SrcConstrStateData%IfW,1) - i1_u = UBOUND(SrcConstrStateData%IfW,1) - IF (.NOT. ALLOCATED(DstConstrStateData%IfW)) THEN - ALLOCATE(DstConstrStateData%IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcConstrStateData%IfW,1), UBOUND(SrcConstrStateData%IfW,1) - CALL InflowWind_CopyConstrState( SrcConstrStateData%IfW(i1), DstConstrStateData%IfW(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE AWAE_CopyConstrState - - SUBROUTINE AWAE_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(AWAE_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyConstrState' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ConstrStateData%IfW)) THEN -DO i1 = LBOUND(ConstrStateData%IfW,1), UBOUND(ConstrStateData%IfW,1) - CALL InflowWind_DestroyConstrState( ConstrStateData%IfW(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ConstrStateData%IfW) -ENDIF - END SUBROUTINE AWAE_DestroyConstrState +subroutine AWAE_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(AWAE_ConstraintStateType), intent(in) :: SrcConstrStateData + type(AWAE_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcConstrStateData%IfW)) then + LB(1:1) = lbound(SrcConstrStateData%IfW) + UB(1:1) = ubound(SrcConstrStateData%IfW) + if (.not. allocated(DstConstrStateData%IfW)) then + allocate(DstConstrStateData%IfW(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%IfW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call InflowWind_CopyConstrState(SrcConstrStateData%IfW(i1), DstConstrStateData%IfW(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstConstrStateData%IfW)) then + deallocate(DstConstrStateData%IfW) + end if +end subroutine +subroutine AWAE_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(AWAE_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ConstrStateData%IfW)) then + LB(1:1) = lbound(ConstrStateData%IfW) + UB(1:1) = ubound(ConstrStateData%IfW) + do i1 = LB(1), UB(1) + call InflowWind_DestroyConstrState(ConstrStateData%IfW(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ConstrStateData%IfW) + end if +end subroutine subroutine AWAE_PackConstrState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -1847,7 +1685,6 @@ subroutine AWAE_PackConstrState(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! IfW call RegPack(Buf, allocated(InData%IfW)) if (allocated(InData%IfW)) then call RegPackBounds(Buf, 1, lbound(InData%IfW), ubound(InData%IfW)) @@ -1869,7 +1706,6 @@ subroutine AWAE_UnPackConstrState(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! IfW if (allocated(OutData%IfW)) deallocate(OutData%IfW) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1886,61 +1722,61 @@ subroutine AWAE_UnPackConstrState(Buf, OutData) end do end if end subroutine - SUBROUTINE AWAE_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AWAE_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(AWAE_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOtherStateData%IfW)) THEN - i1_l = LBOUND(SrcOtherStateData%IfW,1) - i1_u = UBOUND(SrcOtherStateData%IfW,1) - IF (.NOT. ALLOCATED(DstOtherStateData%IfW)) THEN - ALLOCATE(DstOtherStateData%IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOtherStateData%IfW,1), UBOUND(SrcOtherStateData%IfW,1) - CALL InflowWind_CopyOtherState( SrcOtherStateData%IfW(i1), DstOtherStateData%IfW(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE AWAE_CopyOtherState - - SUBROUTINE AWAE_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(AWAE_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(OtherStateData%IfW)) THEN -DO i1 = LBOUND(OtherStateData%IfW,1), UBOUND(OtherStateData%IfW,1) - CALL InflowWind_DestroyOtherState( OtherStateData%IfW(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OtherStateData%IfW) -ENDIF - END SUBROUTINE AWAE_DestroyOtherState +subroutine AWAE_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(AWAE_OtherStateType), intent(in) :: SrcOtherStateData + type(AWAE_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOtherStateData%IfW)) then + LB(1:1) = lbound(SrcOtherStateData%IfW) + UB(1:1) = ubound(SrcOtherStateData%IfW) + if (.not. allocated(DstOtherStateData%IfW)) then + allocate(DstOtherStateData%IfW(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%IfW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call InflowWind_CopyOtherState(SrcOtherStateData%IfW(i1), DstOtherStateData%IfW(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstOtherStateData%IfW)) then + deallocate(DstOtherStateData%IfW) + end if +end subroutine +subroutine AWAE_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(AWAE_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OtherStateData%IfW)) then + LB(1:1) = lbound(OtherStateData%IfW) + UB(1:1) = ubound(OtherStateData%IfW) + do i1 = LB(1), UB(1) + call InflowWind_DestroyOtherState(OtherStateData%IfW(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OtherStateData%IfW) + end if +end subroutine subroutine AWAE_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -1949,7 +1785,6 @@ subroutine AWAE_PackOtherState(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! IfW call RegPack(Buf, allocated(InData%IfW)) if (allocated(InData%IfW)) then call RegPackBounds(Buf, 1, lbound(InData%IfW), ubound(InData%IfW)) @@ -1971,7 +1806,6 @@ subroutine AWAE_UnPackOtherState(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! IfW if (allocated(OutData%IfW)) deallocate(OutData%IfW) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1988,377 +1822,338 @@ subroutine AWAE_UnPackOtherState(Buf, OutData) end do end if end subroutine - SUBROUTINE AWAE_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AWAE_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(AWAE_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscData%Vamb_low)) THEN - i1_l = LBOUND(SrcMiscData%Vamb_low,1) - i1_u = UBOUND(SrcMiscData%Vamb_low,1) - i2_l = LBOUND(SrcMiscData%Vamb_low,2) - i2_u = UBOUND(SrcMiscData%Vamb_low,2) - i3_l = LBOUND(SrcMiscData%Vamb_low,3) - i3_u = UBOUND(SrcMiscData%Vamb_low,3) - i4_l = LBOUND(SrcMiscData%Vamb_low,4) - i4_u = UBOUND(SrcMiscData%Vamb_low,4) - IF (.NOT. ALLOCATED(DstMiscData%Vamb_low)) THEN - ALLOCATE(DstMiscData%Vamb_low(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vamb_low.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Vamb_low = SrcMiscData%Vamb_low -ENDIF -IF (ALLOCATED(SrcMiscData%Vamb_lowpol)) THEN - i1_l = LBOUND(SrcMiscData%Vamb_lowpol,1) - i1_u = UBOUND(SrcMiscData%Vamb_lowpol,1) - i2_l = LBOUND(SrcMiscData%Vamb_lowpol,2) - i2_u = UBOUND(SrcMiscData%Vamb_lowpol,2) - IF (.NOT. ALLOCATED(DstMiscData%Vamb_lowpol)) THEN - ALLOCATE(DstMiscData%Vamb_lowpol(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vamb_lowpol.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Vamb_lowpol = SrcMiscData%Vamb_lowpol -ENDIF -IF (ALLOCATED(SrcMiscData%Vdist_low)) THEN - i1_l = LBOUND(SrcMiscData%Vdist_low,1) - i1_u = UBOUND(SrcMiscData%Vdist_low,1) - i2_l = LBOUND(SrcMiscData%Vdist_low,2) - i2_u = UBOUND(SrcMiscData%Vdist_low,2) - i3_l = LBOUND(SrcMiscData%Vdist_low,3) - i3_u = UBOUND(SrcMiscData%Vdist_low,3) - i4_l = LBOUND(SrcMiscData%Vdist_low,4) - i4_u = UBOUND(SrcMiscData%Vdist_low,4) - IF (.NOT. ALLOCATED(DstMiscData%Vdist_low)) THEN - ALLOCATE(DstMiscData%Vdist_low(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vdist_low.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Vdist_low = SrcMiscData%Vdist_low -ENDIF -IF (ALLOCATED(SrcMiscData%Vdist_low_full)) THEN - i1_l = LBOUND(SrcMiscData%Vdist_low_full,1) - i1_u = UBOUND(SrcMiscData%Vdist_low_full,1) - i2_l = LBOUND(SrcMiscData%Vdist_low_full,2) - i2_u = UBOUND(SrcMiscData%Vdist_low_full,2) - i3_l = LBOUND(SrcMiscData%Vdist_low_full,3) - i3_u = UBOUND(SrcMiscData%Vdist_low_full,3) - i4_l = LBOUND(SrcMiscData%Vdist_low_full,4) - i4_u = UBOUND(SrcMiscData%Vdist_low_full,4) - IF (.NOT. ALLOCATED(DstMiscData%Vdist_low_full)) THEN - ALLOCATE(DstMiscData%Vdist_low_full(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vdist_low_full.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Vdist_low_full = SrcMiscData%Vdist_low_full -ENDIF -IF (ALLOCATED(SrcMiscData%Vamb_High)) THEN - i1_l = LBOUND(SrcMiscData%Vamb_High,1) - i1_u = UBOUND(SrcMiscData%Vamb_High,1) - IF (.NOT. ALLOCATED(DstMiscData%Vamb_High)) THEN - ALLOCATE(DstMiscData%Vamb_High(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vamb_High.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%Vamb_High,1), UBOUND(SrcMiscData%Vamb_High,1) - CALL AWAE_Copyhighwindgrid( SrcMiscData%Vamb_High(i1), DstMiscData%Vamb_High(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%parallelFlag)) THEN - i1_l = LBOUND(SrcMiscData%parallelFlag,1) - i1_u = UBOUND(SrcMiscData%parallelFlag,1) - i2_l = LBOUND(SrcMiscData%parallelFlag,2) - i2_u = UBOUND(SrcMiscData%parallelFlag,2) - IF (.NOT. ALLOCATED(DstMiscData%parallelFlag)) THEN - ALLOCATE(DstMiscData%parallelFlag(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%parallelFlag.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%parallelFlag = SrcMiscData%parallelFlag -ENDIF -IF (ALLOCATED(SrcMiscData%r_s)) THEN - i1_l = LBOUND(SrcMiscData%r_s,1) - i1_u = UBOUND(SrcMiscData%r_s,1) - i2_l = LBOUND(SrcMiscData%r_s,2) - i2_u = UBOUND(SrcMiscData%r_s,2) - IF (.NOT. ALLOCATED(DstMiscData%r_s)) THEN - ALLOCATE(DstMiscData%r_s(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%r_s.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%r_s = SrcMiscData%r_s -ENDIF -IF (ALLOCATED(SrcMiscData%r_e)) THEN - i1_l = LBOUND(SrcMiscData%r_e,1) - i1_u = UBOUND(SrcMiscData%r_e,1) - i2_l = LBOUND(SrcMiscData%r_e,2) - i2_u = UBOUND(SrcMiscData%r_e,2) - IF (.NOT. ALLOCATED(DstMiscData%r_e)) THEN - ALLOCATE(DstMiscData%r_e(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%r_e.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%r_e = SrcMiscData%r_e -ENDIF -IF (ALLOCATED(SrcMiscData%rhat_s)) THEN - i1_l = LBOUND(SrcMiscData%rhat_s,1) - i1_u = UBOUND(SrcMiscData%rhat_s,1) - i2_l = LBOUND(SrcMiscData%rhat_s,2) - i2_u = UBOUND(SrcMiscData%rhat_s,2) - i3_l = LBOUND(SrcMiscData%rhat_s,3) - i3_u = UBOUND(SrcMiscData%rhat_s,3) - IF (.NOT. ALLOCATED(DstMiscData%rhat_s)) THEN - ALLOCATE(DstMiscData%rhat_s(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rhat_s.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%rhat_s = SrcMiscData%rhat_s -ENDIF -IF (ALLOCATED(SrcMiscData%rhat_e)) THEN - i1_l = LBOUND(SrcMiscData%rhat_e,1) - i1_u = UBOUND(SrcMiscData%rhat_e,1) - i2_l = LBOUND(SrcMiscData%rhat_e,2) - i2_u = UBOUND(SrcMiscData%rhat_e,2) - i3_l = LBOUND(SrcMiscData%rhat_e,3) - i3_u = UBOUND(SrcMiscData%rhat_e,3) - IF (.NOT. ALLOCATED(DstMiscData%rhat_e)) THEN - ALLOCATE(DstMiscData%rhat_e(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rhat_e.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%rhat_e = SrcMiscData%rhat_e -ENDIF -IF (ALLOCATED(SrcMiscData%pvec_cs)) THEN - i1_l = LBOUND(SrcMiscData%pvec_cs,1) - i1_u = UBOUND(SrcMiscData%pvec_cs,1) - i2_l = LBOUND(SrcMiscData%pvec_cs,2) - i2_u = UBOUND(SrcMiscData%pvec_cs,2) - i3_l = LBOUND(SrcMiscData%pvec_cs,3) - i3_u = UBOUND(SrcMiscData%pvec_cs,3) - IF (.NOT. ALLOCATED(DstMiscData%pvec_cs)) THEN - ALLOCATE(DstMiscData%pvec_cs(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%pvec_cs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%pvec_cs = SrcMiscData%pvec_cs -ENDIF -IF (ALLOCATED(SrcMiscData%pvec_ce)) THEN - i1_l = LBOUND(SrcMiscData%pvec_ce,1) - i1_u = UBOUND(SrcMiscData%pvec_ce,1) - i2_l = LBOUND(SrcMiscData%pvec_ce,2) - i2_u = UBOUND(SrcMiscData%pvec_ce,2) - i3_l = LBOUND(SrcMiscData%pvec_ce,3) - i3_u = UBOUND(SrcMiscData%pvec_ce,3) - IF (.NOT. ALLOCATED(DstMiscData%pvec_ce)) THEN - ALLOCATE(DstMiscData%pvec_ce(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%pvec_ce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%pvec_ce = SrcMiscData%pvec_ce -ENDIF -IF (ALLOCATED(SrcMiscData%outVizXYPlane)) THEN - i1_l = LBOUND(SrcMiscData%outVizXYPlane,1) - i1_u = UBOUND(SrcMiscData%outVizXYPlane,1) - i2_l = LBOUND(SrcMiscData%outVizXYPlane,2) - i2_u = UBOUND(SrcMiscData%outVizXYPlane,2) - i3_l = LBOUND(SrcMiscData%outVizXYPlane,3) - i3_u = UBOUND(SrcMiscData%outVizXYPlane,3) - i4_l = LBOUND(SrcMiscData%outVizXYPlane,4) - i4_u = UBOUND(SrcMiscData%outVizXYPlane,4) - IF (.NOT. ALLOCATED(DstMiscData%outVizXYPlane)) THEN - ALLOCATE(DstMiscData%outVizXYPlane(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%outVizXYPlane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%outVizXYPlane = SrcMiscData%outVizXYPlane -ENDIF -IF (ALLOCATED(SrcMiscData%outVizYZPlane)) THEN - i1_l = LBOUND(SrcMiscData%outVizYZPlane,1) - i1_u = UBOUND(SrcMiscData%outVizYZPlane,1) - i2_l = LBOUND(SrcMiscData%outVizYZPlane,2) - i2_u = UBOUND(SrcMiscData%outVizYZPlane,2) - i3_l = LBOUND(SrcMiscData%outVizYZPlane,3) - i3_u = UBOUND(SrcMiscData%outVizYZPlane,3) - i4_l = LBOUND(SrcMiscData%outVizYZPlane,4) - i4_u = UBOUND(SrcMiscData%outVizYZPlane,4) - IF (.NOT. ALLOCATED(DstMiscData%outVizYZPlane)) THEN - ALLOCATE(DstMiscData%outVizYZPlane(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%outVizYZPlane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%outVizYZPlane = SrcMiscData%outVizYZPlane -ENDIF -IF (ALLOCATED(SrcMiscData%outVizXZPlane)) THEN - i1_l = LBOUND(SrcMiscData%outVizXZPlane,1) - i1_u = UBOUND(SrcMiscData%outVizXZPlane,1) - i2_l = LBOUND(SrcMiscData%outVizXZPlane,2) - i2_u = UBOUND(SrcMiscData%outVizXZPlane,2) - i3_l = LBOUND(SrcMiscData%outVizXZPlane,3) - i3_u = UBOUND(SrcMiscData%outVizXZPlane,3) - i4_l = LBOUND(SrcMiscData%outVizXZPlane,4) - i4_u = UBOUND(SrcMiscData%outVizXZPlane,4) - IF (.NOT. ALLOCATED(DstMiscData%outVizXZPlane)) THEN - ALLOCATE(DstMiscData%outVizXZPlane(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%outVizXZPlane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%outVizXZPlane = SrcMiscData%outVizXZPlane -ENDIF -IF (ALLOCATED(SrcMiscData%IfW)) THEN - i1_l = LBOUND(SrcMiscData%IfW,1) - i1_u = UBOUND(SrcMiscData%IfW,1) - IF (.NOT. ALLOCATED(DstMiscData%IfW)) THEN - ALLOCATE(DstMiscData%IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%IfW,1), UBOUND(SrcMiscData%IfW,1) - CALL InflowWind_CopyMisc( SrcMiscData%IfW(i1), DstMiscData%IfW(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL InflowWind_CopyInput( SrcMiscData%u_IfW_Low, DstMiscData%u_IfW_Low, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyInput( SrcMiscData%u_IfW_High, DstMiscData%u_IfW_High, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyOutput( SrcMiscData%y_IfW_Low, DstMiscData%y_IfW_Low, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyOutput( SrcMiscData%y_IfW_High, DstMiscData%y_IfW_High, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE AWAE_CopyMisc - - SUBROUTINE AWAE_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(AWAE_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(MiscData%Vamb_low)) THEN - DEALLOCATE(MiscData%Vamb_low) -ENDIF -IF (ALLOCATED(MiscData%Vamb_lowpol)) THEN - DEALLOCATE(MiscData%Vamb_lowpol) -ENDIF -IF (ALLOCATED(MiscData%Vdist_low)) THEN - DEALLOCATE(MiscData%Vdist_low) -ENDIF -IF (ALLOCATED(MiscData%Vdist_low_full)) THEN - DEALLOCATE(MiscData%Vdist_low_full) -ENDIF -IF (ALLOCATED(MiscData%Vamb_High)) THEN -DO i1 = LBOUND(MiscData%Vamb_High,1), UBOUND(MiscData%Vamb_High,1) - CALL AWAE_DestroyHighWindGrid( MiscData%Vamb_High(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%Vamb_High) -ENDIF -IF (ALLOCATED(MiscData%parallelFlag)) THEN - DEALLOCATE(MiscData%parallelFlag) -ENDIF -IF (ALLOCATED(MiscData%r_s)) THEN - DEALLOCATE(MiscData%r_s) -ENDIF -IF (ALLOCATED(MiscData%r_e)) THEN - DEALLOCATE(MiscData%r_e) -ENDIF -IF (ALLOCATED(MiscData%rhat_s)) THEN - DEALLOCATE(MiscData%rhat_s) -ENDIF -IF (ALLOCATED(MiscData%rhat_e)) THEN - DEALLOCATE(MiscData%rhat_e) -ENDIF -IF (ALLOCATED(MiscData%pvec_cs)) THEN - DEALLOCATE(MiscData%pvec_cs) -ENDIF -IF (ALLOCATED(MiscData%pvec_ce)) THEN - DEALLOCATE(MiscData%pvec_ce) -ENDIF -IF (ALLOCATED(MiscData%outVizXYPlane)) THEN - DEALLOCATE(MiscData%outVizXYPlane) -ENDIF -IF (ALLOCATED(MiscData%outVizYZPlane)) THEN - DEALLOCATE(MiscData%outVizYZPlane) -ENDIF -IF (ALLOCATED(MiscData%outVizXZPlane)) THEN - DEALLOCATE(MiscData%outVizXZPlane) -ENDIF -IF (ALLOCATED(MiscData%IfW)) THEN -DO i1 = LBOUND(MiscData%IfW,1), UBOUND(MiscData%IfW,1) - CALL InflowWind_DestroyMisc( MiscData%IfW(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%IfW) -ENDIF - CALL InflowWind_DestroyInput( MiscData%u_IfW_Low, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyInput( MiscData%u_IfW_High, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyOutput( MiscData%y_IfW_Low, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyOutput( MiscData%y_IfW_High, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE AWAE_DestroyMisc +subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(AWAE_MiscVarType), intent(in) :: SrcMiscData + type(AWAE_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3, i4 + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMiscData%Vamb_low)) then + LB(1:4) = lbound(SrcMiscData%Vamb_low) + UB(1:4) = ubound(SrcMiscData%Vamb_low) + if (.not. allocated(DstMiscData%Vamb_low)) then + allocate(DstMiscData%Vamb_low(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vamb_low.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Vamb_low = SrcMiscData%Vamb_low + else if (allocated(DstMiscData%Vamb_low)) then + deallocate(DstMiscData%Vamb_low) + end if + if (allocated(SrcMiscData%Vamb_lowpol)) then + LB(1:2) = lbound(SrcMiscData%Vamb_lowpol) + UB(1:2) = ubound(SrcMiscData%Vamb_lowpol) + if (.not. allocated(DstMiscData%Vamb_lowpol)) then + allocate(DstMiscData%Vamb_lowpol(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vamb_lowpol.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Vamb_lowpol = SrcMiscData%Vamb_lowpol + else if (allocated(DstMiscData%Vamb_lowpol)) then + deallocate(DstMiscData%Vamb_lowpol) + end if + if (allocated(SrcMiscData%Vdist_low)) then + LB(1:4) = lbound(SrcMiscData%Vdist_low) + UB(1:4) = ubound(SrcMiscData%Vdist_low) + if (.not. allocated(DstMiscData%Vdist_low)) then + allocate(DstMiscData%Vdist_low(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vdist_low.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Vdist_low = SrcMiscData%Vdist_low + else if (allocated(DstMiscData%Vdist_low)) then + deallocate(DstMiscData%Vdist_low) + end if + if (allocated(SrcMiscData%Vdist_low_full)) then + LB(1:4) = lbound(SrcMiscData%Vdist_low_full) + UB(1:4) = ubound(SrcMiscData%Vdist_low_full) + if (.not. allocated(DstMiscData%Vdist_low_full)) then + allocate(DstMiscData%Vdist_low_full(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vdist_low_full.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Vdist_low_full = SrcMiscData%Vdist_low_full + else if (allocated(DstMiscData%Vdist_low_full)) then + deallocate(DstMiscData%Vdist_low_full) + end if + if (allocated(SrcMiscData%Vamb_High)) then + LB(1:1) = lbound(SrcMiscData%Vamb_High) + UB(1:1) = ubound(SrcMiscData%Vamb_High) + if (.not. allocated(DstMiscData%Vamb_High)) then + allocate(DstMiscData%Vamb_High(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vamb_High.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AWAE_CopyHighWindGrid(SrcMiscData%Vamb_High(i1), DstMiscData%Vamb_High(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstMiscData%Vamb_High)) then + deallocate(DstMiscData%Vamb_High) + end if + if (allocated(SrcMiscData%parallelFlag)) then + LB(1:2) = lbound(SrcMiscData%parallelFlag) + UB(1:2) = ubound(SrcMiscData%parallelFlag) + if (.not. allocated(DstMiscData%parallelFlag)) then + allocate(DstMiscData%parallelFlag(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%parallelFlag.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%parallelFlag = SrcMiscData%parallelFlag + else if (allocated(DstMiscData%parallelFlag)) then + deallocate(DstMiscData%parallelFlag) + end if + if (allocated(SrcMiscData%r_s)) then + LB(1:2) = lbound(SrcMiscData%r_s) + UB(1:2) = ubound(SrcMiscData%r_s) + if (.not. allocated(DstMiscData%r_s)) then + allocate(DstMiscData%r_s(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%r_s.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%r_s = SrcMiscData%r_s + else if (allocated(DstMiscData%r_s)) then + deallocate(DstMiscData%r_s) + end if + if (allocated(SrcMiscData%r_e)) then + LB(1:2) = lbound(SrcMiscData%r_e) + UB(1:2) = ubound(SrcMiscData%r_e) + if (.not. allocated(DstMiscData%r_e)) then + allocate(DstMiscData%r_e(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%r_e.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%r_e = SrcMiscData%r_e + else if (allocated(DstMiscData%r_e)) then + deallocate(DstMiscData%r_e) + end if + if (allocated(SrcMiscData%rhat_s)) then + LB(1:3) = lbound(SrcMiscData%rhat_s) + UB(1:3) = ubound(SrcMiscData%rhat_s) + if (.not. allocated(DstMiscData%rhat_s)) then + allocate(DstMiscData%rhat_s(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rhat_s.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%rhat_s = SrcMiscData%rhat_s + else if (allocated(DstMiscData%rhat_s)) then + deallocate(DstMiscData%rhat_s) + end if + if (allocated(SrcMiscData%rhat_e)) then + LB(1:3) = lbound(SrcMiscData%rhat_e) + UB(1:3) = ubound(SrcMiscData%rhat_e) + if (.not. allocated(DstMiscData%rhat_e)) then + allocate(DstMiscData%rhat_e(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rhat_e.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%rhat_e = SrcMiscData%rhat_e + else if (allocated(DstMiscData%rhat_e)) then + deallocate(DstMiscData%rhat_e) + end if + if (allocated(SrcMiscData%pvec_cs)) then + LB(1:3) = lbound(SrcMiscData%pvec_cs) + UB(1:3) = ubound(SrcMiscData%pvec_cs) + if (.not. allocated(DstMiscData%pvec_cs)) then + allocate(DstMiscData%pvec_cs(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%pvec_cs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%pvec_cs = SrcMiscData%pvec_cs + else if (allocated(DstMiscData%pvec_cs)) then + deallocate(DstMiscData%pvec_cs) + end if + if (allocated(SrcMiscData%pvec_ce)) then + LB(1:3) = lbound(SrcMiscData%pvec_ce) + UB(1:3) = ubound(SrcMiscData%pvec_ce) + if (.not. allocated(DstMiscData%pvec_ce)) then + allocate(DstMiscData%pvec_ce(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%pvec_ce.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%pvec_ce = SrcMiscData%pvec_ce + else if (allocated(DstMiscData%pvec_ce)) then + deallocate(DstMiscData%pvec_ce) + end if + if (allocated(SrcMiscData%outVizXYPlane)) then + LB(1:4) = lbound(SrcMiscData%outVizXYPlane) + UB(1:4) = ubound(SrcMiscData%outVizXYPlane) + if (.not. allocated(DstMiscData%outVizXYPlane)) then + allocate(DstMiscData%outVizXYPlane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%outVizXYPlane.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%outVizXYPlane = SrcMiscData%outVizXYPlane + else if (allocated(DstMiscData%outVizXYPlane)) then + deallocate(DstMiscData%outVizXYPlane) + end if + if (allocated(SrcMiscData%outVizYZPlane)) then + LB(1:4) = lbound(SrcMiscData%outVizYZPlane) + UB(1:4) = ubound(SrcMiscData%outVizYZPlane) + if (.not. allocated(DstMiscData%outVizYZPlane)) then + allocate(DstMiscData%outVizYZPlane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%outVizYZPlane.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%outVizYZPlane = SrcMiscData%outVizYZPlane + else if (allocated(DstMiscData%outVizYZPlane)) then + deallocate(DstMiscData%outVizYZPlane) + end if + if (allocated(SrcMiscData%outVizXZPlane)) then + LB(1:4) = lbound(SrcMiscData%outVizXZPlane) + UB(1:4) = ubound(SrcMiscData%outVizXZPlane) + if (.not. allocated(DstMiscData%outVizXZPlane)) then + allocate(DstMiscData%outVizXZPlane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%outVizXZPlane.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%outVizXZPlane = SrcMiscData%outVizXZPlane + else if (allocated(DstMiscData%outVizXZPlane)) then + deallocate(DstMiscData%outVizXZPlane) + end if + if (allocated(SrcMiscData%IfW)) then + LB(1:1) = lbound(SrcMiscData%IfW) + UB(1:1) = ubound(SrcMiscData%IfW) + if (.not. allocated(DstMiscData%IfW)) then + allocate(DstMiscData%IfW(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%IfW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call InflowWind_CopyMisc(SrcMiscData%IfW(i1), DstMiscData%IfW(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstMiscData%IfW)) then + deallocate(DstMiscData%IfW) + end if + call InflowWind_CopyInput(SrcMiscData%u_IfW_Low, DstMiscData%u_IfW_Low, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyInput(SrcMiscData%u_IfW_High, DstMiscData%u_IfW_High, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyOutput(SrcMiscData%y_IfW_Low, DstMiscData%y_IfW_Low, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyOutput(SrcMiscData%y_IfW_High, DstMiscData%y_IfW_High, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine AWAE_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(AWAE_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3, i4 + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%Vamb_low)) then + deallocate(MiscData%Vamb_low) + end if + if (allocated(MiscData%Vamb_lowpol)) then + deallocate(MiscData%Vamb_lowpol) + end if + if (allocated(MiscData%Vdist_low)) then + deallocate(MiscData%Vdist_low) + end if + if (allocated(MiscData%Vdist_low_full)) then + deallocate(MiscData%Vdist_low_full) + end if + if (allocated(MiscData%Vamb_High)) then + LB(1:1) = lbound(MiscData%Vamb_High) + UB(1:1) = ubound(MiscData%Vamb_High) + do i1 = LB(1), UB(1) + call AWAE_DestroyHighWindGrid(MiscData%Vamb_High(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%Vamb_High) + end if + if (allocated(MiscData%parallelFlag)) then + deallocate(MiscData%parallelFlag) + end if + if (allocated(MiscData%r_s)) then + deallocate(MiscData%r_s) + end if + if (allocated(MiscData%r_e)) then + deallocate(MiscData%r_e) + end if + if (allocated(MiscData%rhat_s)) then + deallocate(MiscData%rhat_s) + end if + if (allocated(MiscData%rhat_e)) then + deallocate(MiscData%rhat_e) + end if + if (allocated(MiscData%pvec_cs)) then + deallocate(MiscData%pvec_cs) + end if + if (allocated(MiscData%pvec_ce)) then + deallocate(MiscData%pvec_ce) + end if + if (allocated(MiscData%outVizXYPlane)) then + deallocate(MiscData%outVizXYPlane) + end if + if (allocated(MiscData%outVizYZPlane)) then + deallocate(MiscData%outVizYZPlane) + end if + if (allocated(MiscData%outVizXZPlane)) then + deallocate(MiscData%outVizXZPlane) + end if + if (allocated(MiscData%IfW)) then + LB(1:1) = lbound(MiscData%IfW) + UB(1:1) = ubound(MiscData%IfW) + do i1 = LB(1), UB(1) + call InflowWind_DestroyMisc(MiscData%IfW(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%IfW) + end if +end subroutine subroutine AWAE_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -2367,35 +2162,30 @@ subroutine AWAE_PackMisc(Buf, Indata) integer(IntKi) :: i1, i2, i3, i4 integer(IntKi) :: LB(4), UB(4) if (Buf%ErrStat >= AbortErrLev) return - ! Vamb_low call RegPack(Buf, allocated(InData%Vamb_low)) if (allocated(InData%Vamb_low)) then call RegPackBounds(Buf, 4, lbound(InData%Vamb_low), ubound(InData%Vamb_low)) call RegPack(Buf, InData%Vamb_low) end if if (RegCheckErr(Buf, RoutineName)) return - ! Vamb_lowpol call RegPack(Buf, allocated(InData%Vamb_lowpol)) if (allocated(InData%Vamb_lowpol)) then call RegPackBounds(Buf, 2, lbound(InData%Vamb_lowpol), ubound(InData%Vamb_lowpol)) call RegPack(Buf, InData%Vamb_lowpol) end if if (RegCheckErr(Buf, RoutineName)) return - ! Vdist_low call RegPack(Buf, allocated(InData%Vdist_low)) if (allocated(InData%Vdist_low)) then call RegPackBounds(Buf, 4, lbound(InData%Vdist_low), ubound(InData%Vdist_low)) call RegPack(Buf, InData%Vdist_low) end if if (RegCheckErr(Buf, RoutineName)) return - ! Vdist_low_full call RegPack(Buf, allocated(InData%Vdist_low_full)) if (allocated(InData%Vdist_low_full)) then call RegPackBounds(Buf, 4, lbound(InData%Vdist_low_full), ubound(InData%Vdist_low_full)) call RegPack(Buf, InData%Vdist_low_full) end if if (RegCheckErr(Buf, RoutineName)) return - ! Vamb_High call RegPack(Buf, allocated(InData%Vamb_High)) if (allocated(InData%Vamb_High)) then call RegPackBounds(Buf, 1, lbound(InData%Vamb_High), ubound(InData%Vamb_High)) @@ -2406,77 +2196,66 @@ subroutine AWAE_PackMisc(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! parallelFlag call RegPack(Buf, allocated(InData%parallelFlag)) if (allocated(InData%parallelFlag)) then call RegPackBounds(Buf, 2, lbound(InData%parallelFlag), ubound(InData%parallelFlag)) call RegPack(Buf, InData%parallelFlag) end if if (RegCheckErr(Buf, RoutineName)) return - ! r_s call RegPack(Buf, allocated(InData%r_s)) if (allocated(InData%r_s)) then call RegPackBounds(Buf, 2, lbound(InData%r_s), ubound(InData%r_s)) call RegPack(Buf, InData%r_s) end if if (RegCheckErr(Buf, RoutineName)) return - ! r_e call RegPack(Buf, allocated(InData%r_e)) if (allocated(InData%r_e)) then call RegPackBounds(Buf, 2, lbound(InData%r_e), ubound(InData%r_e)) call RegPack(Buf, InData%r_e) end if if (RegCheckErr(Buf, RoutineName)) return - ! rhat_s call RegPack(Buf, allocated(InData%rhat_s)) if (allocated(InData%rhat_s)) then call RegPackBounds(Buf, 3, lbound(InData%rhat_s), ubound(InData%rhat_s)) call RegPack(Buf, InData%rhat_s) end if if (RegCheckErr(Buf, RoutineName)) return - ! rhat_e call RegPack(Buf, allocated(InData%rhat_e)) if (allocated(InData%rhat_e)) then call RegPackBounds(Buf, 3, lbound(InData%rhat_e), ubound(InData%rhat_e)) call RegPack(Buf, InData%rhat_e) end if if (RegCheckErr(Buf, RoutineName)) return - ! pvec_cs call RegPack(Buf, allocated(InData%pvec_cs)) if (allocated(InData%pvec_cs)) then call RegPackBounds(Buf, 3, lbound(InData%pvec_cs), ubound(InData%pvec_cs)) call RegPack(Buf, InData%pvec_cs) end if if (RegCheckErr(Buf, RoutineName)) return - ! pvec_ce call RegPack(Buf, allocated(InData%pvec_ce)) if (allocated(InData%pvec_ce)) then call RegPackBounds(Buf, 3, lbound(InData%pvec_ce), ubound(InData%pvec_ce)) call RegPack(Buf, InData%pvec_ce) end if if (RegCheckErr(Buf, RoutineName)) return - ! outVizXYPlane call RegPack(Buf, allocated(InData%outVizXYPlane)) if (allocated(InData%outVizXYPlane)) then call RegPackBounds(Buf, 4, lbound(InData%outVizXYPlane), ubound(InData%outVizXYPlane)) call RegPack(Buf, InData%outVizXYPlane) end if if (RegCheckErr(Buf, RoutineName)) return - ! outVizYZPlane call RegPack(Buf, allocated(InData%outVizYZPlane)) if (allocated(InData%outVizYZPlane)) then call RegPackBounds(Buf, 4, lbound(InData%outVizYZPlane), ubound(InData%outVizYZPlane)) call RegPack(Buf, InData%outVizYZPlane) end if if (RegCheckErr(Buf, RoutineName)) return - ! outVizXZPlane call RegPack(Buf, allocated(InData%outVizXZPlane)) if (allocated(InData%outVizXZPlane)) then call RegPackBounds(Buf, 4, lbound(InData%outVizXZPlane), ubound(InData%outVizXZPlane)) call RegPack(Buf, InData%outVizXZPlane) end if if (RegCheckErr(Buf, RoutineName)) return - ! IfW call RegPack(Buf, allocated(InData%IfW)) if (allocated(InData%IfW)) then call RegPackBounds(Buf, 1, lbound(InData%IfW), ubound(InData%IfW)) @@ -2487,16 +2266,12 @@ subroutine AWAE_PackMisc(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! u_IfW_Low call InflowWind_PackInput(Buf, InData%u_IfW_Low) if (RegCheckErr(Buf, RoutineName)) return - ! u_IfW_High call InflowWind_PackInput(Buf, InData%u_IfW_High) if (RegCheckErr(Buf, RoutineName)) return - ! y_IfW_Low call InflowWind_PackOutput(Buf, InData%y_IfW_Low) if (RegCheckErr(Buf, RoutineName)) return - ! y_IfW_High call InflowWind_PackOutput(Buf, InData%y_IfW_High) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2510,7 +2285,6 @@ subroutine AWAE_UnPackMisc(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! Vamb_low if (allocated(OutData%Vamb_low)) deallocate(OutData%Vamb_low) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2525,7 +2299,6 @@ subroutine AWAE_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%Vamb_low) if (RegCheckErr(Buf, RoutineName)) return end if - ! Vamb_lowpol if (allocated(OutData%Vamb_lowpol)) deallocate(OutData%Vamb_lowpol) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2540,7 +2313,6 @@ subroutine AWAE_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%Vamb_lowpol) if (RegCheckErr(Buf, RoutineName)) return end if - ! Vdist_low if (allocated(OutData%Vdist_low)) deallocate(OutData%Vdist_low) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2555,7 +2327,6 @@ subroutine AWAE_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%Vdist_low) if (RegCheckErr(Buf, RoutineName)) return end if - ! Vdist_low_full if (allocated(OutData%Vdist_low_full)) deallocate(OutData%Vdist_low_full) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2570,7 +2341,6 @@ subroutine AWAE_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%Vdist_low_full) if (RegCheckErr(Buf, RoutineName)) return end if - ! Vamb_High if (allocated(OutData%Vamb_High)) deallocate(OutData%Vamb_High) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2586,7 +2356,6 @@ subroutine AWAE_UnPackMisc(Buf, OutData) call AWAE_UnpackHighWindGrid(Buf, OutData%Vamb_High(i1)) ! Vamb_High end do end if - ! parallelFlag if (allocated(OutData%parallelFlag)) deallocate(OutData%parallelFlag) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2601,7 +2370,6 @@ subroutine AWAE_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%parallelFlag) if (RegCheckErr(Buf, RoutineName)) return end if - ! r_s if (allocated(OutData%r_s)) deallocate(OutData%r_s) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2616,7 +2384,6 @@ subroutine AWAE_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%r_s) if (RegCheckErr(Buf, RoutineName)) return end if - ! r_e if (allocated(OutData%r_e)) deallocate(OutData%r_e) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2631,7 +2398,6 @@ subroutine AWAE_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%r_e) if (RegCheckErr(Buf, RoutineName)) return end if - ! rhat_s if (allocated(OutData%rhat_s)) deallocate(OutData%rhat_s) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2646,7 +2412,6 @@ subroutine AWAE_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%rhat_s) if (RegCheckErr(Buf, RoutineName)) return end if - ! rhat_e if (allocated(OutData%rhat_e)) deallocate(OutData%rhat_e) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2661,7 +2426,6 @@ subroutine AWAE_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%rhat_e) if (RegCheckErr(Buf, RoutineName)) return end if - ! pvec_cs if (allocated(OutData%pvec_cs)) deallocate(OutData%pvec_cs) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2676,7 +2440,6 @@ subroutine AWAE_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%pvec_cs) if (RegCheckErr(Buf, RoutineName)) return end if - ! pvec_ce if (allocated(OutData%pvec_ce)) deallocate(OutData%pvec_ce) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2691,7 +2454,6 @@ subroutine AWAE_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%pvec_ce) if (RegCheckErr(Buf, RoutineName)) return end if - ! outVizXYPlane if (allocated(OutData%outVizXYPlane)) deallocate(OutData%outVizXYPlane) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2706,7 +2468,6 @@ subroutine AWAE_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%outVizXYPlane) if (RegCheckErr(Buf, RoutineName)) return end if - ! outVizYZPlane if (allocated(OutData%outVizYZPlane)) deallocate(OutData%outVizYZPlane) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2721,7 +2482,6 @@ subroutine AWAE_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%outVizYZPlane) if (RegCheckErr(Buf, RoutineName)) return end if - ! outVizXZPlane if (allocated(OutData%outVizXZPlane)) deallocate(OutData%outVizXZPlane) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2736,7 +2496,6 @@ subroutine AWAE_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%outVizXZPlane) if (RegCheckErr(Buf, RoutineName)) return end if - ! IfW if (allocated(OutData%IfW)) deallocate(OutData%IfW) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2752,327 +2511,341 @@ subroutine AWAE_UnPackMisc(Buf, OutData) call InflowWind_UnpackMisc(Buf, OutData%IfW(i1)) ! IfW end do end if - ! u_IfW_Low call InflowWind_UnpackInput(Buf, OutData%u_IfW_Low) ! u_IfW_Low - ! u_IfW_High call InflowWind_UnpackInput(Buf, OutData%u_IfW_High) ! u_IfW_High - ! y_IfW_Low call InflowWind_UnpackOutput(Buf, OutData%y_IfW_Low) ! y_IfW_Low - ! y_IfW_High call InflowWind_UnpackOutput(Buf, OutData%y_IfW_High) ! y_IfW_High end subroutine - SUBROUTINE AWAE_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AWAE_ParameterType), INTENT(IN) :: SrcParamData - TYPE(AWAE_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%WindFilePath = SrcParamData%WindFilePath - DstParamData%NumTurbines = SrcParamData%NumTurbines - DstParamData%NumRadii = SrcParamData%NumRadii - DstParamData%NumPlanes = SrcParamData%NumPlanes -IF (ALLOCATED(SrcParamData%y)) THEN - i1_l = LBOUND(SrcParamData%y,1) - i1_u = UBOUND(SrcParamData%y,1) - IF (.NOT. ALLOCATED(DstParamData%y)) THEN - ALLOCATE(DstParamData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%y = SrcParamData%y -ENDIF -IF (ALLOCATED(SrcParamData%z)) THEN - i1_l = LBOUND(SrcParamData%z,1) - i1_u = UBOUND(SrcParamData%z,1) - IF (.NOT. ALLOCATED(DstParamData%z)) THEN - ALLOCATE(DstParamData%z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%z = SrcParamData%z -ENDIF - DstParamData%Mod_AmbWind = SrcParamData%Mod_AmbWind - DstParamData%nX_low = SrcParamData%nX_low - DstParamData%nY_low = SrcParamData%nY_low - DstParamData%nZ_low = SrcParamData%nZ_low - DstParamData%NumGrid_low = SrcParamData%NumGrid_low - DstParamData%n_rp_max = SrcParamData%n_rp_max - DstParamData%dpol = SrcParamData%dpol - DstParamData%dXYZ_low = SrcParamData%dXYZ_low - DstParamData%dX_low = SrcParamData%dX_low - DstParamData%dY_low = SrcParamData%dY_low - DstParamData%dZ_low = SrcParamData%dZ_low - DstParamData%X0_low = SrcParamData%X0_low - DstParamData%Y0_low = SrcParamData%Y0_low - DstParamData%Z0_low = SrcParamData%Z0_low -IF (ALLOCATED(SrcParamData%X0_high)) THEN - i1_l = LBOUND(SrcParamData%X0_high,1) - i1_u = UBOUND(SrcParamData%X0_high,1) - IF (.NOT. ALLOCATED(DstParamData%X0_high)) THEN - ALLOCATE(DstParamData%X0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%X0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%X0_high = SrcParamData%X0_high -ENDIF -IF (ALLOCATED(SrcParamData%Y0_high)) THEN - i1_l = LBOUND(SrcParamData%Y0_high,1) - i1_u = UBOUND(SrcParamData%Y0_high,1) - IF (.NOT. ALLOCATED(DstParamData%Y0_high)) THEN - ALLOCATE(DstParamData%Y0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Y0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Y0_high = SrcParamData%Y0_high -ENDIF -IF (ALLOCATED(SrcParamData%Z0_high)) THEN - i1_l = LBOUND(SrcParamData%Z0_high,1) - i1_u = UBOUND(SrcParamData%Z0_high,1) - IF (.NOT. ALLOCATED(DstParamData%Z0_high)) THEN - ALLOCATE(DstParamData%Z0_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Z0_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Z0_high = SrcParamData%Z0_high -ENDIF -IF (ALLOCATED(SrcParamData%dX_high)) THEN - i1_l = LBOUND(SrcParamData%dX_high,1) - i1_u = UBOUND(SrcParamData%dX_high,1) - IF (.NOT. ALLOCATED(DstParamData%dX_high)) THEN - ALLOCATE(DstParamData%dX_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dX_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%dX_high = SrcParamData%dX_high -ENDIF -IF (ALLOCATED(SrcParamData%dY_high)) THEN - i1_l = LBOUND(SrcParamData%dY_high,1) - i1_u = UBOUND(SrcParamData%dY_high,1) - IF (.NOT. ALLOCATED(DstParamData%dY_high)) THEN - ALLOCATE(DstParamData%dY_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dY_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%dY_high = SrcParamData%dY_high -ENDIF -IF (ALLOCATED(SrcParamData%dZ_high)) THEN - i1_l = LBOUND(SrcParamData%dZ_high,1) - i1_u = UBOUND(SrcParamData%dZ_high,1) - IF (.NOT. ALLOCATED(DstParamData%dZ_high)) THEN - ALLOCATE(DstParamData%dZ_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dZ_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%dZ_high = SrcParamData%dZ_high -ENDIF - DstParamData%nX_high = SrcParamData%nX_high - DstParamData%nY_high = SrcParamData%nY_high - DstParamData%nZ_high = SrcParamData%nZ_high -IF (ALLOCATED(SrcParamData%Grid_low)) THEN - i1_l = LBOUND(SrcParamData%Grid_low,1) - i1_u = UBOUND(SrcParamData%Grid_low,1) - i2_l = LBOUND(SrcParamData%Grid_low,2) - i2_u = UBOUND(SrcParamData%Grid_low,2) - IF (.NOT. ALLOCATED(DstParamData%Grid_low)) THEN - ALLOCATE(DstParamData%Grid_low(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Grid_low.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Grid_low = SrcParamData%Grid_low -ENDIF -IF (ALLOCATED(SrcParamData%Grid_high)) THEN - i1_l = LBOUND(SrcParamData%Grid_high,1) - i1_u = UBOUND(SrcParamData%Grid_high,1) - i2_l = LBOUND(SrcParamData%Grid_high,2) - i2_u = UBOUND(SrcParamData%Grid_high,2) - i3_l = LBOUND(SrcParamData%Grid_high,3) - i3_u = UBOUND(SrcParamData%Grid_high,3) - IF (.NOT. ALLOCATED(DstParamData%Grid_high)) THEN - ALLOCATE(DstParamData%Grid_high(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Grid_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Grid_high = SrcParamData%Grid_high -ENDIF -IF (ALLOCATED(SrcParamData%WT_Position)) THEN - i1_l = LBOUND(SrcParamData%WT_Position,1) - i1_u = UBOUND(SrcParamData%WT_Position,1) - i2_l = LBOUND(SrcParamData%WT_Position,2) - i2_u = UBOUND(SrcParamData%WT_Position,2) - IF (.NOT. ALLOCATED(DstParamData%WT_Position)) THEN - ALLOCATE(DstParamData%WT_Position(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WT_Position.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WT_Position = SrcParamData%WT_Position -ENDIF - DstParamData%n_high_low = SrcParamData%n_high_low - DstParamData%dt_low = SrcParamData%dt_low - DstParamData%dt_high = SrcParamData%dt_high - DstParamData%NumDT = SrcParamData%NumDT - DstParamData%Mod_Meander = SrcParamData%Mod_Meander - DstParamData%C_Meander = SrcParamData%C_Meander - DstParamData%C_ScaleDiam = SrcParamData%C_ScaleDiam - DstParamData%Mod_Projection = SrcParamData%Mod_Projection -IF (ALLOCATED(SrcParamData%IfW)) THEN - i1_l = LBOUND(SrcParamData%IfW,1) - i1_u = UBOUND(SrcParamData%IfW,1) - IF (.NOT. ALLOCATED(DstParamData%IfW)) THEN - ALLOCATE(DstParamData%IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%IfW,1), UBOUND(SrcParamData%IfW,1) - CALL InflowWind_CopyParam( SrcParamData%IfW(i1), DstParamData%IfW(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstParamData%WrDisSkp1 = SrcParamData%WrDisSkp1 - DstParamData%WrDisWind = SrcParamData%WrDisWind - DstParamData%NOutDisWindXY = SrcParamData%NOutDisWindXY -IF (ALLOCATED(SrcParamData%OutDisWindZ)) THEN - i1_l = LBOUND(SrcParamData%OutDisWindZ,1) - i1_u = UBOUND(SrcParamData%OutDisWindZ,1) - IF (.NOT. ALLOCATED(DstParamData%OutDisWindZ)) THEN - ALLOCATE(DstParamData%OutDisWindZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutDisWindZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%OutDisWindZ = SrcParamData%OutDisWindZ -ENDIF - DstParamData%NOutDisWindYZ = SrcParamData%NOutDisWindYZ -IF (ALLOCATED(SrcParamData%OutDisWindX)) THEN - i1_l = LBOUND(SrcParamData%OutDisWindX,1) - i1_u = UBOUND(SrcParamData%OutDisWindX,1) - IF (.NOT. ALLOCATED(DstParamData%OutDisWindX)) THEN - ALLOCATE(DstParamData%OutDisWindX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutDisWindX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%OutDisWindX = SrcParamData%OutDisWindX -ENDIF - DstParamData%NOutDisWindXZ = SrcParamData%NOutDisWindXZ -IF (ALLOCATED(SrcParamData%OutDisWindY)) THEN - i1_l = LBOUND(SrcParamData%OutDisWindY,1) - i1_u = UBOUND(SrcParamData%OutDisWindY,1) - IF (.NOT. ALLOCATED(DstParamData%OutDisWindY)) THEN - ALLOCATE(DstParamData%OutDisWindY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutDisWindY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%OutDisWindY = SrcParamData%OutDisWindY -ENDIF - DstParamData%OutFileRoot = SrcParamData%OutFileRoot - DstParamData%OutFileVTKRoot = SrcParamData%OutFileVTKRoot - DstParamData%VTK_tWidth = SrcParamData%VTK_tWidth - END SUBROUTINE AWAE_CopyParam - - SUBROUTINE AWAE_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(AWAE_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(ParamData%y)) THEN - DEALLOCATE(ParamData%y) -ENDIF -IF (ALLOCATED(ParamData%z)) THEN - DEALLOCATE(ParamData%z) -ENDIF -IF (ALLOCATED(ParamData%X0_high)) THEN - DEALLOCATE(ParamData%X0_high) -ENDIF -IF (ALLOCATED(ParamData%Y0_high)) THEN - DEALLOCATE(ParamData%Y0_high) -ENDIF -IF (ALLOCATED(ParamData%Z0_high)) THEN - DEALLOCATE(ParamData%Z0_high) -ENDIF -IF (ALLOCATED(ParamData%dX_high)) THEN - DEALLOCATE(ParamData%dX_high) -ENDIF -IF (ALLOCATED(ParamData%dY_high)) THEN - DEALLOCATE(ParamData%dY_high) -ENDIF -IF (ALLOCATED(ParamData%dZ_high)) THEN - DEALLOCATE(ParamData%dZ_high) -ENDIF -IF (ALLOCATED(ParamData%Grid_low)) THEN - DEALLOCATE(ParamData%Grid_low) -ENDIF -IF (ALLOCATED(ParamData%Grid_high)) THEN - DEALLOCATE(ParamData%Grid_high) -ENDIF -IF (ALLOCATED(ParamData%WT_Position)) THEN - DEALLOCATE(ParamData%WT_Position) -ENDIF -IF (ALLOCATED(ParamData%IfW)) THEN -DO i1 = LBOUND(ParamData%IfW,1), UBOUND(ParamData%IfW,1) - CALL InflowWind_DestroyParam( ParamData%IfW(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%IfW) -ENDIF -IF (ALLOCATED(ParamData%OutDisWindZ)) THEN - DEALLOCATE(ParamData%OutDisWindZ) -ENDIF -IF (ALLOCATED(ParamData%OutDisWindX)) THEN - DEALLOCATE(ParamData%OutDisWindX) -ENDIF -IF (ALLOCATED(ParamData%OutDisWindY)) THEN - DEALLOCATE(ParamData%OutDisWindY) -ENDIF - END SUBROUTINE AWAE_DestroyParam +subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(AWAE_ParameterType), intent(in) :: SrcParamData + type(AWAE_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%WindFilePath = SrcParamData%WindFilePath + DstParamData%NumTurbines = SrcParamData%NumTurbines + DstParamData%NumRadii = SrcParamData%NumRadii + DstParamData%NumPlanes = SrcParamData%NumPlanes + if (allocated(SrcParamData%y)) then + LB(1:1) = lbound(SrcParamData%y) + UB(1:1) = ubound(SrcParamData%y) + if (.not. allocated(DstParamData%y)) then + allocate(DstParamData%y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%y = SrcParamData%y + else if (allocated(DstParamData%y)) then + deallocate(DstParamData%y) + end if + if (allocated(SrcParamData%z)) then + LB(1:1) = lbound(SrcParamData%z) + UB(1:1) = ubound(SrcParamData%z) + if (.not. allocated(DstParamData%z)) then + allocate(DstParamData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%z = SrcParamData%z + else if (allocated(DstParamData%z)) then + deallocate(DstParamData%z) + end if + DstParamData%Mod_AmbWind = SrcParamData%Mod_AmbWind + DstParamData%nX_low = SrcParamData%nX_low + DstParamData%nY_low = SrcParamData%nY_low + DstParamData%nZ_low = SrcParamData%nZ_low + DstParamData%NumGrid_low = SrcParamData%NumGrid_low + DstParamData%n_rp_max = SrcParamData%n_rp_max + DstParamData%dpol = SrcParamData%dpol + DstParamData%dXYZ_low = SrcParamData%dXYZ_low + DstParamData%dX_low = SrcParamData%dX_low + DstParamData%dY_low = SrcParamData%dY_low + DstParamData%dZ_low = SrcParamData%dZ_low + DstParamData%X0_low = SrcParamData%X0_low + DstParamData%Y0_low = SrcParamData%Y0_low + DstParamData%Z0_low = SrcParamData%Z0_low + if (allocated(SrcParamData%X0_high)) then + LB(1:1) = lbound(SrcParamData%X0_high) + UB(1:1) = ubound(SrcParamData%X0_high) + if (.not. allocated(DstParamData%X0_high)) then + allocate(DstParamData%X0_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%X0_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%X0_high = SrcParamData%X0_high + else if (allocated(DstParamData%X0_high)) then + deallocate(DstParamData%X0_high) + end if + if (allocated(SrcParamData%Y0_high)) then + LB(1:1) = lbound(SrcParamData%Y0_high) + UB(1:1) = ubound(SrcParamData%Y0_high) + if (.not. allocated(DstParamData%Y0_high)) then + allocate(DstParamData%Y0_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Y0_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Y0_high = SrcParamData%Y0_high + else if (allocated(DstParamData%Y0_high)) then + deallocate(DstParamData%Y0_high) + end if + if (allocated(SrcParamData%Z0_high)) then + LB(1:1) = lbound(SrcParamData%Z0_high) + UB(1:1) = ubound(SrcParamData%Z0_high) + if (.not. allocated(DstParamData%Z0_high)) then + allocate(DstParamData%Z0_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Z0_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Z0_high = SrcParamData%Z0_high + else if (allocated(DstParamData%Z0_high)) then + deallocate(DstParamData%Z0_high) + end if + if (allocated(SrcParamData%dX_high)) then + LB(1:1) = lbound(SrcParamData%dX_high) + UB(1:1) = ubound(SrcParamData%dX_high) + if (.not. allocated(DstParamData%dX_high)) then + allocate(DstParamData%dX_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dX_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%dX_high = SrcParamData%dX_high + else if (allocated(DstParamData%dX_high)) then + deallocate(DstParamData%dX_high) + end if + if (allocated(SrcParamData%dY_high)) then + LB(1:1) = lbound(SrcParamData%dY_high) + UB(1:1) = ubound(SrcParamData%dY_high) + if (.not. allocated(DstParamData%dY_high)) then + allocate(DstParamData%dY_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dY_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%dY_high = SrcParamData%dY_high + else if (allocated(DstParamData%dY_high)) then + deallocate(DstParamData%dY_high) + end if + if (allocated(SrcParamData%dZ_high)) then + LB(1:1) = lbound(SrcParamData%dZ_high) + UB(1:1) = ubound(SrcParamData%dZ_high) + if (.not. allocated(DstParamData%dZ_high)) then + allocate(DstParamData%dZ_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dZ_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%dZ_high = SrcParamData%dZ_high + else if (allocated(DstParamData%dZ_high)) then + deallocate(DstParamData%dZ_high) + end if + DstParamData%nX_high = SrcParamData%nX_high + DstParamData%nY_high = SrcParamData%nY_high + DstParamData%nZ_high = SrcParamData%nZ_high + if (allocated(SrcParamData%Grid_low)) then + LB(1:2) = lbound(SrcParamData%Grid_low) + UB(1:2) = ubound(SrcParamData%Grid_low) + if (.not. allocated(DstParamData%Grid_low)) then + allocate(DstParamData%Grid_low(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Grid_low.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Grid_low = SrcParamData%Grid_low + else if (allocated(DstParamData%Grid_low)) then + deallocate(DstParamData%Grid_low) + end if + if (allocated(SrcParamData%Grid_high)) then + LB(1:3) = lbound(SrcParamData%Grid_high) + UB(1:3) = ubound(SrcParamData%Grid_high) + if (.not. allocated(DstParamData%Grid_high)) then + allocate(DstParamData%Grid_high(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Grid_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Grid_high = SrcParamData%Grid_high + else if (allocated(DstParamData%Grid_high)) then + deallocate(DstParamData%Grid_high) + end if + if (allocated(SrcParamData%WT_Position)) then + LB(1:2) = lbound(SrcParamData%WT_Position) + UB(1:2) = ubound(SrcParamData%WT_Position) + if (.not. allocated(DstParamData%WT_Position)) then + allocate(DstParamData%WT_Position(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WT_Position.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WT_Position = SrcParamData%WT_Position + else if (allocated(DstParamData%WT_Position)) then + deallocate(DstParamData%WT_Position) + end if + DstParamData%n_high_low = SrcParamData%n_high_low + DstParamData%dt_low = SrcParamData%dt_low + DstParamData%dt_high = SrcParamData%dt_high + DstParamData%NumDT = SrcParamData%NumDT + DstParamData%Mod_Meander = SrcParamData%Mod_Meander + DstParamData%C_Meander = SrcParamData%C_Meander + DstParamData%C_ScaleDiam = SrcParamData%C_ScaleDiam + DstParamData%Mod_Projection = SrcParamData%Mod_Projection + if (allocated(SrcParamData%IfW)) then + LB(1:1) = lbound(SrcParamData%IfW) + UB(1:1) = ubound(SrcParamData%IfW) + if (.not. allocated(DstParamData%IfW)) then + allocate(DstParamData%IfW(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IfW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call InflowWind_CopyParam(SrcParamData%IfW(i1), DstParamData%IfW(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstParamData%IfW)) then + deallocate(DstParamData%IfW) + end if + DstParamData%WrDisSkp1 = SrcParamData%WrDisSkp1 + DstParamData%WrDisWind = SrcParamData%WrDisWind + DstParamData%NOutDisWindXY = SrcParamData%NOutDisWindXY + if (allocated(SrcParamData%OutDisWindZ)) then + LB(1:1) = lbound(SrcParamData%OutDisWindZ) + UB(1:1) = ubound(SrcParamData%OutDisWindZ) + if (.not. allocated(DstParamData%OutDisWindZ)) then + allocate(DstParamData%OutDisWindZ(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutDisWindZ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%OutDisWindZ = SrcParamData%OutDisWindZ + else if (allocated(DstParamData%OutDisWindZ)) then + deallocate(DstParamData%OutDisWindZ) + end if + DstParamData%NOutDisWindYZ = SrcParamData%NOutDisWindYZ + if (allocated(SrcParamData%OutDisWindX)) then + LB(1:1) = lbound(SrcParamData%OutDisWindX) + UB(1:1) = ubound(SrcParamData%OutDisWindX) + if (.not. allocated(DstParamData%OutDisWindX)) then + allocate(DstParamData%OutDisWindX(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutDisWindX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%OutDisWindX = SrcParamData%OutDisWindX + else if (allocated(DstParamData%OutDisWindX)) then + deallocate(DstParamData%OutDisWindX) + end if + DstParamData%NOutDisWindXZ = SrcParamData%NOutDisWindXZ + if (allocated(SrcParamData%OutDisWindY)) then + LB(1:1) = lbound(SrcParamData%OutDisWindY) + UB(1:1) = ubound(SrcParamData%OutDisWindY) + if (.not. allocated(DstParamData%OutDisWindY)) then + allocate(DstParamData%OutDisWindY(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutDisWindY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%OutDisWindY = SrcParamData%OutDisWindY + else if (allocated(DstParamData%OutDisWindY)) then + deallocate(DstParamData%OutDisWindY) + end if + DstParamData%OutFileRoot = SrcParamData%OutFileRoot + DstParamData%OutFileVTKRoot = SrcParamData%OutFileVTKRoot + DstParamData%VTK_tWidth = SrcParamData%VTK_tWidth +end subroutine +subroutine AWAE_DestroyParam(ParamData, ErrStat, ErrMsg) + type(AWAE_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%y)) then + deallocate(ParamData%y) + end if + if (allocated(ParamData%z)) then + deallocate(ParamData%z) + end if + if (allocated(ParamData%X0_high)) then + deallocate(ParamData%X0_high) + end if + if (allocated(ParamData%Y0_high)) then + deallocate(ParamData%Y0_high) + end if + if (allocated(ParamData%Z0_high)) then + deallocate(ParamData%Z0_high) + end if + if (allocated(ParamData%dX_high)) then + deallocate(ParamData%dX_high) + end if + if (allocated(ParamData%dY_high)) then + deallocate(ParamData%dY_high) + end if + if (allocated(ParamData%dZ_high)) then + deallocate(ParamData%dZ_high) + end if + if (allocated(ParamData%Grid_low)) then + deallocate(ParamData%Grid_low) + end if + if (allocated(ParamData%Grid_high)) then + deallocate(ParamData%Grid_high) + end if + if (allocated(ParamData%WT_Position)) then + deallocate(ParamData%WT_Position) + end if + if (allocated(ParamData%IfW)) then + LB(1:1) = lbound(ParamData%IfW) + UB(1:1) = ubound(ParamData%IfW) + do i1 = LB(1), UB(1) + call InflowWind_DestroyParam(ParamData%IfW(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%IfW) + end if + if (allocated(ParamData%OutDisWindZ)) then + deallocate(ParamData%OutDisWindZ) + end if + if (allocated(ParamData%OutDisWindX)) then + deallocate(ParamData%OutDisWindX) + end if + if (allocated(ParamData%OutDisWindY)) then + deallocate(ParamData%OutDisWindY) + end if +end subroutine subroutine AWAE_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -3081,171 +2854,130 @@ subroutine AWAE_PackParam(Buf, Indata) integer(IntKi) :: i1, i2, i3 integer(IntKi) :: LB(3), UB(3) if (Buf%ErrStat >= AbortErrLev) return - ! WindFilePath call RegPack(Buf, InData%WindFilePath) if (RegCheckErr(Buf, RoutineName)) return - ! NumTurbines call RegPack(Buf, InData%NumTurbines) if (RegCheckErr(Buf, RoutineName)) return - ! NumRadii call RegPack(Buf, InData%NumRadii) if (RegCheckErr(Buf, RoutineName)) return - ! NumPlanes call RegPack(Buf, InData%NumPlanes) if (RegCheckErr(Buf, RoutineName)) return - ! y call RegPack(Buf, allocated(InData%y)) if (allocated(InData%y)) then call RegPackBounds(Buf, 1, lbound(InData%y), ubound(InData%y)) call RegPack(Buf, InData%y) end if if (RegCheckErr(Buf, RoutineName)) return - ! z call RegPack(Buf, allocated(InData%z)) if (allocated(InData%z)) then call RegPackBounds(Buf, 1, lbound(InData%z), ubound(InData%z)) call RegPack(Buf, InData%z) end if if (RegCheckErr(Buf, RoutineName)) return - ! Mod_AmbWind call RegPack(Buf, InData%Mod_AmbWind) if (RegCheckErr(Buf, RoutineName)) return - ! nX_low call RegPack(Buf, InData%nX_low) if (RegCheckErr(Buf, RoutineName)) return - ! nY_low call RegPack(Buf, InData%nY_low) if (RegCheckErr(Buf, RoutineName)) return - ! nZ_low call RegPack(Buf, InData%nZ_low) if (RegCheckErr(Buf, RoutineName)) return - ! NumGrid_low call RegPack(Buf, InData%NumGrid_low) if (RegCheckErr(Buf, RoutineName)) return - ! n_rp_max call RegPack(Buf, InData%n_rp_max) if (RegCheckErr(Buf, RoutineName)) return - ! dpol call RegPack(Buf, InData%dpol) if (RegCheckErr(Buf, RoutineName)) return - ! dXYZ_low call RegPack(Buf, InData%dXYZ_low) if (RegCheckErr(Buf, RoutineName)) return - ! dX_low call RegPack(Buf, InData%dX_low) if (RegCheckErr(Buf, RoutineName)) return - ! dY_low call RegPack(Buf, InData%dY_low) if (RegCheckErr(Buf, RoutineName)) return - ! dZ_low call RegPack(Buf, InData%dZ_low) if (RegCheckErr(Buf, RoutineName)) return - ! X0_low call RegPack(Buf, InData%X0_low) if (RegCheckErr(Buf, RoutineName)) return - ! Y0_low call RegPack(Buf, InData%Y0_low) if (RegCheckErr(Buf, RoutineName)) return - ! Z0_low call RegPack(Buf, InData%Z0_low) if (RegCheckErr(Buf, RoutineName)) return - ! X0_high call RegPack(Buf, allocated(InData%X0_high)) if (allocated(InData%X0_high)) then call RegPackBounds(Buf, 1, lbound(InData%X0_high), ubound(InData%X0_high)) call RegPack(Buf, InData%X0_high) end if if (RegCheckErr(Buf, RoutineName)) return - ! Y0_high call RegPack(Buf, allocated(InData%Y0_high)) if (allocated(InData%Y0_high)) then call RegPackBounds(Buf, 1, lbound(InData%Y0_high), ubound(InData%Y0_high)) call RegPack(Buf, InData%Y0_high) end if if (RegCheckErr(Buf, RoutineName)) return - ! Z0_high call RegPack(Buf, allocated(InData%Z0_high)) if (allocated(InData%Z0_high)) then call RegPackBounds(Buf, 1, lbound(InData%Z0_high), ubound(InData%Z0_high)) call RegPack(Buf, InData%Z0_high) end if if (RegCheckErr(Buf, RoutineName)) return - ! dX_high call RegPack(Buf, allocated(InData%dX_high)) if (allocated(InData%dX_high)) then call RegPackBounds(Buf, 1, lbound(InData%dX_high), ubound(InData%dX_high)) call RegPack(Buf, InData%dX_high) end if if (RegCheckErr(Buf, RoutineName)) return - ! dY_high call RegPack(Buf, allocated(InData%dY_high)) if (allocated(InData%dY_high)) then call RegPackBounds(Buf, 1, lbound(InData%dY_high), ubound(InData%dY_high)) call RegPack(Buf, InData%dY_high) end if if (RegCheckErr(Buf, RoutineName)) return - ! dZ_high call RegPack(Buf, allocated(InData%dZ_high)) if (allocated(InData%dZ_high)) then call RegPackBounds(Buf, 1, lbound(InData%dZ_high), ubound(InData%dZ_high)) call RegPack(Buf, InData%dZ_high) end if if (RegCheckErr(Buf, RoutineName)) return - ! nX_high call RegPack(Buf, InData%nX_high) if (RegCheckErr(Buf, RoutineName)) return - ! nY_high call RegPack(Buf, InData%nY_high) if (RegCheckErr(Buf, RoutineName)) return - ! nZ_high call RegPack(Buf, InData%nZ_high) if (RegCheckErr(Buf, RoutineName)) return - ! Grid_low call RegPack(Buf, allocated(InData%Grid_low)) if (allocated(InData%Grid_low)) then call RegPackBounds(Buf, 2, lbound(InData%Grid_low), ubound(InData%Grid_low)) call RegPack(Buf, InData%Grid_low) end if if (RegCheckErr(Buf, RoutineName)) return - ! Grid_high call RegPack(Buf, allocated(InData%Grid_high)) if (allocated(InData%Grid_high)) then call RegPackBounds(Buf, 3, lbound(InData%Grid_high), ubound(InData%Grid_high)) call RegPack(Buf, InData%Grid_high) end if if (RegCheckErr(Buf, RoutineName)) return - ! WT_Position call RegPack(Buf, allocated(InData%WT_Position)) if (allocated(InData%WT_Position)) then call RegPackBounds(Buf, 2, lbound(InData%WT_Position), ubound(InData%WT_Position)) call RegPack(Buf, InData%WT_Position) end if if (RegCheckErr(Buf, RoutineName)) return - ! n_high_low call RegPack(Buf, InData%n_high_low) if (RegCheckErr(Buf, RoutineName)) return - ! dt_low call RegPack(Buf, InData%dt_low) if (RegCheckErr(Buf, RoutineName)) return - ! dt_high call RegPack(Buf, InData%dt_high) if (RegCheckErr(Buf, RoutineName)) return - ! NumDT call RegPack(Buf, InData%NumDT) if (RegCheckErr(Buf, RoutineName)) return - ! Mod_Meander call RegPack(Buf, InData%Mod_Meander) if (RegCheckErr(Buf, RoutineName)) return - ! C_Meander call RegPack(Buf, InData%C_Meander) if (RegCheckErr(Buf, RoutineName)) return - ! C_ScaleDiam call RegPack(Buf, InData%C_ScaleDiam) if (RegCheckErr(Buf, RoutineName)) return - ! Mod_Projection call RegPack(Buf, InData%Mod_Projection) if (RegCheckErr(Buf, RoutineName)) return - ! IfW call RegPack(Buf, allocated(InData%IfW)) if (allocated(InData%IfW)) then call RegPackBounds(Buf, 1, lbound(InData%IfW), ubound(InData%IfW)) @@ -3256,49 +2988,38 @@ subroutine AWAE_PackParam(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! WrDisSkp1 call RegPack(Buf, InData%WrDisSkp1) if (RegCheckErr(Buf, RoutineName)) return - ! WrDisWind call RegPack(Buf, InData%WrDisWind) if (RegCheckErr(Buf, RoutineName)) return - ! NOutDisWindXY call RegPack(Buf, InData%NOutDisWindXY) if (RegCheckErr(Buf, RoutineName)) return - ! OutDisWindZ call RegPack(Buf, allocated(InData%OutDisWindZ)) if (allocated(InData%OutDisWindZ)) then call RegPackBounds(Buf, 1, lbound(InData%OutDisWindZ), ubound(InData%OutDisWindZ)) call RegPack(Buf, InData%OutDisWindZ) end if if (RegCheckErr(Buf, RoutineName)) return - ! NOutDisWindYZ call RegPack(Buf, InData%NOutDisWindYZ) if (RegCheckErr(Buf, RoutineName)) return - ! OutDisWindX call RegPack(Buf, allocated(InData%OutDisWindX)) if (allocated(InData%OutDisWindX)) then call RegPackBounds(Buf, 1, lbound(InData%OutDisWindX), ubound(InData%OutDisWindX)) call RegPack(Buf, InData%OutDisWindX) end if if (RegCheckErr(Buf, RoutineName)) return - ! NOutDisWindXZ call RegPack(Buf, InData%NOutDisWindXZ) if (RegCheckErr(Buf, RoutineName)) return - ! OutDisWindY call RegPack(Buf, allocated(InData%OutDisWindY)) if (allocated(InData%OutDisWindY)) then call RegPackBounds(Buf, 1, lbound(InData%OutDisWindY), ubound(InData%OutDisWindY)) call RegPack(Buf, InData%OutDisWindY) end if if (RegCheckErr(Buf, RoutineName)) return - ! OutFileRoot call RegPack(Buf, InData%OutFileRoot) if (RegCheckErr(Buf, RoutineName)) return - ! OutFileVTKRoot call RegPack(Buf, InData%OutFileVTKRoot) if (RegCheckErr(Buf, RoutineName)) return - ! VTK_tWidth call RegPack(Buf, InData%VTK_tWidth) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3312,19 +3033,14 @@ subroutine AWAE_UnPackParam(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! WindFilePath call RegUnpack(Buf, OutData%WindFilePath) if (RegCheckErr(Buf, RoutineName)) return - ! NumTurbines call RegUnpack(Buf, OutData%NumTurbines) if (RegCheckErr(Buf, RoutineName)) return - ! NumRadii call RegUnpack(Buf, OutData%NumRadii) if (RegCheckErr(Buf, RoutineName)) return - ! NumPlanes call RegUnpack(Buf, OutData%NumPlanes) if (RegCheckErr(Buf, RoutineName)) return - ! y if (allocated(OutData%y)) deallocate(OutData%y) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3339,7 +3055,6 @@ subroutine AWAE_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%y) if (RegCheckErr(Buf, RoutineName)) return end if - ! z if (allocated(OutData%z)) deallocate(OutData%z) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3354,49 +3069,34 @@ subroutine AWAE_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%z) if (RegCheckErr(Buf, RoutineName)) return end if - ! Mod_AmbWind call RegUnpack(Buf, OutData%Mod_AmbWind) if (RegCheckErr(Buf, RoutineName)) return - ! nX_low call RegUnpack(Buf, OutData%nX_low) if (RegCheckErr(Buf, RoutineName)) return - ! nY_low call RegUnpack(Buf, OutData%nY_low) if (RegCheckErr(Buf, RoutineName)) return - ! nZ_low call RegUnpack(Buf, OutData%nZ_low) if (RegCheckErr(Buf, RoutineName)) return - ! NumGrid_low call RegUnpack(Buf, OutData%NumGrid_low) if (RegCheckErr(Buf, RoutineName)) return - ! n_rp_max call RegUnpack(Buf, OutData%n_rp_max) if (RegCheckErr(Buf, RoutineName)) return - ! dpol call RegUnpack(Buf, OutData%dpol) if (RegCheckErr(Buf, RoutineName)) return - ! dXYZ_low call RegUnpack(Buf, OutData%dXYZ_low) if (RegCheckErr(Buf, RoutineName)) return - ! dX_low call RegUnpack(Buf, OutData%dX_low) if (RegCheckErr(Buf, RoutineName)) return - ! dY_low call RegUnpack(Buf, OutData%dY_low) if (RegCheckErr(Buf, RoutineName)) return - ! dZ_low call RegUnpack(Buf, OutData%dZ_low) if (RegCheckErr(Buf, RoutineName)) return - ! X0_low call RegUnpack(Buf, OutData%X0_low) if (RegCheckErr(Buf, RoutineName)) return - ! Y0_low call RegUnpack(Buf, OutData%Y0_low) if (RegCheckErr(Buf, RoutineName)) return - ! Z0_low call RegUnpack(Buf, OutData%Z0_low) if (RegCheckErr(Buf, RoutineName)) return - ! X0_high if (allocated(OutData%X0_high)) deallocate(OutData%X0_high) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3411,7 +3111,6 @@ subroutine AWAE_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%X0_high) if (RegCheckErr(Buf, RoutineName)) return end if - ! Y0_high if (allocated(OutData%Y0_high)) deallocate(OutData%Y0_high) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3426,7 +3125,6 @@ subroutine AWAE_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%Y0_high) if (RegCheckErr(Buf, RoutineName)) return end if - ! Z0_high if (allocated(OutData%Z0_high)) deallocate(OutData%Z0_high) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3441,7 +3139,6 @@ subroutine AWAE_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%Z0_high) if (RegCheckErr(Buf, RoutineName)) return end if - ! dX_high if (allocated(OutData%dX_high)) deallocate(OutData%dX_high) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3456,7 +3153,6 @@ subroutine AWAE_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%dX_high) if (RegCheckErr(Buf, RoutineName)) return end if - ! dY_high if (allocated(OutData%dY_high)) deallocate(OutData%dY_high) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3471,7 +3167,6 @@ subroutine AWAE_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%dY_high) if (RegCheckErr(Buf, RoutineName)) return end if - ! dZ_high if (allocated(OutData%dZ_high)) deallocate(OutData%dZ_high) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3486,16 +3181,12 @@ subroutine AWAE_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%dZ_high) if (RegCheckErr(Buf, RoutineName)) return end if - ! nX_high call RegUnpack(Buf, OutData%nX_high) if (RegCheckErr(Buf, RoutineName)) return - ! nY_high call RegUnpack(Buf, OutData%nY_high) if (RegCheckErr(Buf, RoutineName)) return - ! nZ_high call RegUnpack(Buf, OutData%nZ_high) if (RegCheckErr(Buf, RoutineName)) return - ! Grid_low if (allocated(OutData%Grid_low)) deallocate(OutData%Grid_low) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3510,7 +3201,6 @@ subroutine AWAE_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%Grid_low) if (RegCheckErr(Buf, RoutineName)) return end if - ! Grid_high if (allocated(OutData%Grid_high)) deallocate(OutData%Grid_high) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3525,7 +3215,6 @@ subroutine AWAE_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%Grid_high) if (RegCheckErr(Buf, RoutineName)) return end if - ! WT_Position if (allocated(OutData%WT_Position)) deallocate(OutData%WT_Position) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3540,31 +3229,22 @@ subroutine AWAE_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%WT_Position) if (RegCheckErr(Buf, RoutineName)) return end if - ! n_high_low call RegUnpack(Buf, OutData%n_high_low) if (RegCheckErr(Buf, RoutineName)) return - ! dt_low call RegUnpack(Buf, OutData%dt_low) if (RegCheckErr(Buf, RoutineName)) return - ! dt_high call RegUnpack(Buf, OutData%dt_high) if (RegCheckErr(Buf, RoutineName)) return - ! NumDT call RegUnpack(Buf, OutData%NumDT) if (RegCheckErr(Buf, RoutineName)) return - ! Mod_Meander call RegUnpack(Buf, OutData%Mod_Meander) if (RegCheckErr(Buf, RoutineName)) return - ! C_Meander call RegUnpack(Buf, OutData%C_Meander) if (RegCheckErr(Buf, RoutineName)) return - ! C_ScaleDiam call RegUnpack(Buf, OutData%C_ScaleDiam) if (RegCheckErr(Buf, RoutineName)) return - ! Mod_Projection call RegUnpack(Buf, OutData%Mod_Projection) if (RegCheckErr(Buf, RoutineName)) return - ! IfW if (allocated(OutData%IfW)) deallocate(OutData%IfW) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3580,16 +3260,12 @@ subroutine AWAE_UnPackParam(Buf, OutData) call InflowWind_UnpackParam(Buf, OutData%IfW(i1)) ! IfW end do end if - ! WrDisSkp1 call RegUnpack(Buf, OutData%WrDisSkp1) if (RegCheckErr(Buf, RoutineName)) return - ! WrDisWind call RegUnpack(Buf, OutData%WrDisWind) if (RegCheckErr(Buf, RoutineName)) return - ! NOutDisWindXY call RegUnpack(Buf, OutData%NOutDisWindXY) if (RegCheckErr(Buf, RoutineName)) return - ! OutDisWindZ if (allocated(OutData%OutDisWindZ)) deallocate(OutData%OutDisWindZ) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3604,10 +3280,8 @@ subroutine AWAE_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%OutDisWindZ) if (RegCheckErr(Buf, RoutineName)) return end if - ! NOutDisWindYZ call RegUnpack(Buf, OutData%NOutDisWindYZ) if (RegCheckErr(Buf, RoutineName)) return - ! OutDisWindX if (allocated(OutData%OutDisWindX)) deallocate(OutData%OutDisWindX) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3622,10 +3296,8 @@ subroutine AWAE_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%OutDisWindX) if (RegCheckErr(Buf, RoutineName)) return end if - ! NOutDisWindXZ call RegUnpack(Buf, OutData%NOutDisWindXZ) if (RegCheckErr(Buf, RoutineName)) return - ! OutDisWindY if (allocated(OutData%OutDisWindY)) deallocate(OutData%OutDisWindY) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3640,122 +3312,119 @@ subroutine AWAE_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%OutDisWindY) if (RegCheckErr(Buf, RoutineName)) return end if - ! OutFileRoot call RegUnpack(Buf, OutData%OutFileRoot) if (RegCheckErr(Buf, RoutineName)) return - ! OutFileVTKRoot call RegUnpack(Buf, OutData%OutFileVTKRoot) if (RegCheckErr(Buf, RoutineName)) return - ! VTK_tWidth call RegUnpack(Buf, OutData%VTK_tWidth) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE AWAE_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AWAE_OutputType), INTENT(IN) :: SrcOutputData - TYPE(AWAE_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_CopyOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%Vdist_High)) THEN - i1_l = LBOUND(SrcOutputData%Vdist_High,1) - i1_u = UBOUND(SrcOutputData%Vdist_High,1) - IF (.NOT. ALLOCATED(DstOutputData%Vdist_High)) THEN - ALLOCATE(DstOutputData%Vdist_High(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vdist_High.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOutputData%Vdist_High,1), UBOUND(SrcOutputData%Vdist_High,1) - CALL AWAE_Copyhighwindgrid( SrcOutputData%Vdist_High(i1), DstOutputData%Vdist_High(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcOutputData%V_plane)) THEN - i1_l = LBOUND(SrcOutputData%V_plane,1) - i1_u = UBOUND(SrcOutputData%V_plane,1) - i2_l = LBOUND(SrcOutputData%V_plane,2) - i2_u = UBOUND(SrcOutputData%V_plane,2) - i3_l = LBOUND(SrcOutputData%V_plane,3) - i3_u = UBOUND(SrcOutputData%V_plane,3) - IF (.NOT. ALLOCATED(DstOutputData%V_plane)) THEN - ALLOCATE(DstOutputData%V_plane(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%V_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%V_plane = SrcOutputData%V_plane -ENDIF -IF (ALLOCATED(SrcOutputData%TI_amb)) THEN - i1_l = LBOUND(SrcOutputData%TI_amb,1) - i1_u = UBOUND(SrcOutputData%TI_amb,1) - IF (.NOT. ALLOCATED(DstOutputData%TI_amb)) THEN - ALLOCATE(DstOutputData%TI_amb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%TI_amb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%TI_amb = SrcOutputData%TI_amb -ENDIF -IF (ALLOCATED(SrcOutputData%Vx_wind_disk)) THEN - i1_l = LBOUND(SrcOutputData%Vx_wind_disk,1) - i1_u = UBOUND(SrcOutputData%Vx_wind_disk,1) - IF (.NOT. ALLOCATED(DstOutputData%Vx_wind_disk)) THEN - ALLOCATE(DstOutputData%Vx_wind_disk(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vx_wind_disk.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Vx_wind_disk = SrcOutputData%Vx_wind_disk -ENDIF - END SUBROUTINE AWAE_CopyOutput - - SUBROUTINE AWAE_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(AWAE_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyOutput' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OutputData%Vdist_High)) THEN -DO i1 = LBOUND(OutputData%Vdist_High,1), UBOUND(OutputData%Vdist_High,1) - CALL AWAE_DestroyHighWindGrid( OutputData%Vdist_High(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OutputData%Vdist_High) -ENDIF -IF (ALLOCATED(OutputData%V_plane)) THEN - DEALLOCATE(OutputData%V_plane) -ENDIF -IF (ALLOCATED(OutputData%TI_amb)) THEN - DEALLOCATE(OutputData%TI_amb) -ENDIF -IF (ALLOCATED(OutputData%Vx_wind_disk)) THEN - DEALLOCATE(OutputData%Vx_wind_disk) -ENDIF - END SUBROUTINE AWAE_DestroyOutput +subroutine AWAE_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(AWAE_OutputType), intent(in) :: SrcOutputData + type(AWAE_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%Vdist_High)) then + LB(1:1) = lbound(SrcOutputData%Vdist_High) + UB(1:1) = ubound(SrcOutputData%Vdist_High) + if (.not. allocated(DstOutputData%Vdist_High)) then + allocate(DstOutputData%Vdist_High(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vdist_High.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AWAE_CopyHighWindGrid(SrcOutputData%Vdist_High(i1), DstOutputData%Vdist_High(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstOutputData%Vdist_High)) then + deallocate(DstOutputData%Vdist_High) + end if + if (allocated(SrcOutputData%V_plane)) then + LB(1:3) = lbound(SrcOutputData%V_plane) + UB(1:3) = ubound(SrcOutputData%V_plane) + if (.not. allocated(DstOutputData%V_plane)) then + allocate(DstOutputData%V_plane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%V_plane.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%V_plane = SrcOutputData%V_plane + else if (allocated(DstOutputData%V_plane)) then + deallocate(DstOutputData%V_plane) + end if + if (allocated(SrcOutputData%TI_amb)) then + LB(1:1) = lbound(SrcOutputData%TI_amb) + UB(1:1) = ubound(SrcOutputData%TI_amb) + if (.not. allocated(DstOutputData%TI_amb)) then + allocate(DstOutputData%TI_amb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%TI_amb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%TI_amb = SrcOutputData%TI_amb + else if (allocated(DstOutputData%TI_amb)) then + deallocate(DstOutputData%TI_amb) + end if + if (allocated(SrcOutputData%Vx_wind_disk)) then + LB(1:1) = lbound(SrcOutputData%Vx_wind_disk) + UB(1:1) = ubound(SrcOutputData%Vx_wind_disk) + if (.not. allocated(DstOutputData%Vx_wind_disk)) then + allocate(DstOutputData%Vx_wind_disk(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vx_wind_disk.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Vx_wind_disk = SrcOutputData%Vx_wind_disk + else if (allocated(DstOutputData%Vx_wind_disk)) then + deallocate(DstOutputData%Vx_wind_disk) + end if +end subroutine +subroutine AWAE_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(AWAE_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AWAE_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%Vdist_High)) then + LB(1:1) = lbound(OutputData%Vdist_High) + UB(1:1) = ubound(OutputData%Vdist_High) + do i1 = LB(1), UB(1) + call AWAE_DestroyHighWindGrid(OutputData%Vdist_High(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%Vdist_High) + end if + if (allocated(OutputData%V_plane)) then + deallocate(OutputData%V_plane) + end if + if (allocated(OutputData%TI_amb)) then + deallocate(OutputData%TI_amb) + end if + if (allocated(OutputData%Vx_wind_disk)) then + deallocate(OutputData%Vx_wind_disk) + end if +end subroutine subroutine AWAE_PackOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -3764,7 +3433,6 @@ subroutine AWAE_PackOutput(Buf, Indata) integer(IntKi) :: i1, i2, i3 integer(IntKi) :: LB(3), UB(3) if (Buf%ErrStat >= AbortErrLev) return - ! Vdist_High call RegPack(Buf, allocated(InData%Vdist_High)) if (allocated(InData%Vdist_High)) then call RegPackBounds(Buf, 1, lbound(InData%Vdist_High), ubound(InData%Vdist_High)) @@ -3775,21 +3443,18 @@ subroutine AWAE_PackOutput(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! V_plane call RegPack(Buf, allocated(InData%V_plane)) if (allocated(InData%V_plane)) then call RegPackBounds(Buf, 3, lbound(InData%V_plane), ubound(InData%V_plane)) call RegPack(Buf, InData%V_plane) end if if (RegCheckErr(Buf, RoutineName)) return - ! TI_amb call RegPack(Buf, allocated(InData%TI_amb)) if (allocated(InData%TI_amb)) then call RegPackBounds(Buf, 1, lbound(InData%TI_amb), ubound(InData%TI_amb)) call RegPack(Buf, InData%TI_amb) end if if (RegCheckErr(Buf, RoutineName)) return - ! Vx_wind_disk call RegPack(Buf, allocated(InData%Vx_wind_disk)) if (allocated(InData%Vx_wind_disk)) then call RegPackBounds(Buf, 1, lbound(InData%Vx_wind_disk), ubound(InData%Vx_wind_disk)) @@ -3807,7 +3472,6 @@ subroutine AWAE_UnPackOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! Vdist_High if (allocated(OutData%Vdist_High)) deallocate(OutData%Vdist_High) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3823,7 +3487,6 @@ subroutine AWAE_UnPackOutput(Buf, OutData) call AWAE_UnpackHighWindGrid(Buf, OutData%Vdist_High(i1)) ! Vdist_High end do end if - ! V_plane if (allocated(OutData%V_plane)) deallocate(OutData%V_plane) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3838,7 +3501,6 @@ subroutine AWAE_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%V_plane) if (RegCheckErr(Buf, RoutineName)) return end if - ! TI_amb if (allocated(OutData%TI_amb)) deallocate(OutData%TI_amb) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3853,7 +3515,6 @@ subroutine AWAE_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%TI_amb) if (RegCheckErr(Buf, RoutineName)) return end if - ! Vx_wind_disk if (allocated(OutData%Vx_wind_disk)) deallocate(OutData%Vx_wind_disk) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3869,227 +3530,189 @@ subroutine AWAE_UnPackOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE AWAE_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AWAE_InputType), INTENT(IN) :: SrcInputData - TYPE(AWAE_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_CopyInput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInputData%xhat_plane)) THEN - i1_l = LBOUND(SrcInputData%xhat_plane,1) - i1_u = UBOUND(SrcInputData%xhat_plane,1) - i2_l = LBOUND(SrcInputData%xhat_plane,2) - i2_u = UBOUND(SrcInputData%xhat_plane,2) - i3_l = LBOUND(SrcInputData%xhat_plane,3) - i3_u = UBOUND(SrcInputData%xhat_plane,3) - IF (.NOT. ALLOCATED(DstInputData%xhat_plane)) THEN - ALLOCATE(DstInputData%xhat_plane(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%xhat_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%xhat_plane = SrcInputData%xhat_plane -ENDIF -IF (ALLOCATED(SrcInputData%p_plane)) THEN - i1_l = LBOUND(SrcInputData%p_plane,1) - i1_u = UBOUND(SrcInputData%p_plane,1) - i2_l = LBOUND(SrcInputData%p_plane,2) - i2_u = UBOUND(SrcInputData%p_plane,2) - i3_l = LBOUND(SrcInputData%p_plane,3) - i3_u = UBOUND(SrcInputData%p_plane,3) - IF (.NOT. ALLOCATED(DstInputData%p_plane)) THEN - ALLOCATE(DstInputData%p_plane(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%p_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%p_plane = SrcInputData%p_plane -ENDIF -IF (ALLOCATED(SrcInputData%Vx_wake)) THEN - i1_l = LBOUND(SrcInputData%Vx_wake,1) - i1_u = UBOUND(SrcInputData%Vx_wake,1) - i2_l = LBOUND(SrcInputData%Vx_wake,2) - i2_u = UBOUND(SrcInputData%Vx_wake,2) - i3_l = LBOUND(SrcInputData%Vx_wake,3) - i3_u = UBOUND(SrcInputData%Vx_wake,3) - i4_l = LBOUND(SrcInputData%Vx_wake,4) - i4_u = UBOUND(SrcInputData%Vx_wake,4) - IF (.NOT. ALLOCATED(DstInputData%Vx_wake)) THEN - ALLOCATE(DstInputData%Vx_wake(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Vx_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%Vx_wake = SrcInputData%Vx_wake -ENDIF -IF (ALLOCATED(SrcInputData%Vy_wake)) THEN - i1_l = LBOUND(SrcInputData%Vy_wake,1) - i1_u = UBOUND(SrcInputData%Vy_wake,1) - i2_l = LBOUND(SrcInputData%Vy_wake,2) - i2_u = UBOUND(SrcInputData%Vy_wake,2) - i3_l = LBOUND(SrcInputData%Vy_wake,3) - i3_u = UBOUND(SrcInputData%Vy_wake,3) - i4_l = LBOUND(SrcInputData%Vy_wake,4) - i4_u = UBOUND(SrcInputData%Vy_wake,4) - IF (.NOT. ALLOCATED(DstInputData%Vy_wake)) THEN - ALLOCATE(DstInputData%Vy_wake(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Vy_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%Vy_wake = SrcInputData%Vy_wake -ENDIF -IF (ALLOCATED(SrcInputData%Vz_wake)) THEN - i1_l = LBOUND(SrcInputData%Vz_wake,1) - i1_u = UBOUND(SrcInputData%Vz_wake,1) - i2_l = LBOUND(SrcInputData%Vz_wake,2) - i2_u = UBOUND(SrcInputData%Vz_wake,2) - i3_l = LBOUND(SrcInputData%Vz_wake,3) - i3_u = UBOUND(SrcInputData%Vz_wake,3) - i4_l = LBOUND(SrcInputData%Vz_wake,4) - i4_u = UBOUND(SrcInputData%Vz_wake,4) - IF (.NOT. ALLOCATED(DstInputData%Vz_wake)) THEN - ALLOCATE(DstInputData%Vz_wake(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Vz_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%Vz_wake = SrcInputData%Vz_wake -ENDIF -IF (ALLOCATED(SrcInputData%D_wake)) THEN - i1_l = LBOUND(SrcInputData%D_wake,1) - i1_u = UBOUND(SrcInputData%D_wake,1) - i2_l = LBOUND(SrcInputData%D_wake,2) - i2_u = UBOUND(SrcInputData%D_wake,2) - IF (.NOT. ALLOCATED(DstInputData%D_wake)) THEN - ALLOCATE(DstInputData%D_wake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%D_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%D_wake = SrcInputData%D_wake -ENDIF -IF (ALLOCATED(SrcInputData%WAT_k_mt)) THEN - i1_l = LBOUND(SrcInputData%WAT_k_mt,1) - i1_u = UBOUND(SrcInputData%WAT_k_mt,1) - i2_l = LBOUND(SrcInputData%WAT_k_mt,2) - i2_u = UBOUND(SrcInputData%WAT_k_mt,2) - i3_l = LBOUND(SrcInputData%WAT_k_mt,3) - i3_u = UBOUND(SrcInputData%WAT_k_mt,3) - IF (.NOT. ALLOCATED(DstInputData%WAT_k_mt)) THEN - ALLOCATE(DstInputData%WAT_k_mt(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%WAT_k_mt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%WAT_k_mt = SrcInputData%WAT_k_mt -ENDIF - END SUBROUTINE AWAE_CopyInput - SUBROUTINE AWAE_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(AWAE_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputData%xhat_plane)) THEN - DEALLOCATE(InputData%xhat_plane) -ENDIF -IF (ALLOCATED(InputData%p_plane)) THEN - DEALLOCATE(InputData%p_plane) -ENDIF -IF (ALLOCATED(InputData%Vx_wake)) THEN - DEALLOCATE(InputData%Vx_wake) -ENDIF -IF (ALLOCATED(InputData%Vy_wake)) THEN - DEALLOCATE(InputData%Vy_wake) -ENDIF -IF (ALLOCATED(InputData%Vz_wake)) THEN - DEALLOCATE(InputData%Vz_wake) -ENDIF -IF (ALLOCATED(InputData%D_wake)) THEN - DEALLOCATE(InputData%D_wake) -ENDIF -IF (ALLOCATED(InputData%WAT_k_mt)) THEN - DEALLOCATE(InputData%WAT_k_mt) -ENDIF - END SUBROUTINE AWAE_DestroyInput +subroutine AWAE_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(AWAE_InputType), intent(in) :: SrcInputData + type(AWAE_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'AWAE_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInputData%xhat_plane)) then + LB(1:3) = lbound(SrcInputData%xhat_plane) + UB(1:3) = ubound(SrcInputData%xhat_plane) + if (.not. allocated(DstInputData%xhat_plane)) then + allocate(DstInputData%xhat_plane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%xhat_plane.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%xhat_plane = SrcInputData%xhat_plane + else if (allocated(DstInputData%xhat_plane)) then + deallocate(DstInputData%xhat_plane) + end if + if (allocated(SrcInputData%p_plane)) then + LB(1:3) = lbound(SrcInputData%p_plane) + UB(1:3) = ubound(SrcInputData%p_plane) + if (.not. allocated(DstInputData%p_plane)) then + allocate(DstInputData%p_plane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%p_plane.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%p_plane = SrcInputData%p_plane + else if (allocated(DstInputData%p_plane)) then + deallocate(DstInputData%p_plane) + end if + if (allocated(SrcInputData%Vx_wake)) then + LB(1:4) = lbound(SrcInputData%Vx_wake) + UB(1:4) = ubound(SrcInputData%Vx_wake) + if (.not. allocated(DstInputData%Vx_wake)) then + allocate(DstInputData%Vx_wake(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Vx_wake.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%Vx_wake = SrcInputData%Vx_wake + else if (allocated(DstInputData%Vx_wake)) then + deallocate(DstInputData%Vx_wake) + end if + if (allocated(SrcInputData%Vy_wake)) then + LB(1:4) = lbound(SrcInputData%Vy_wake) + UB(1:4) = ubound(SrcInputData%Vy_wake) + if (.not. allocated(DstInputData%Vy_wake)) then + allocate(DstInputData%Vy_wake(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Vy_wake.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%Vy_wake = SrcInputData%Vy_wake + else if (allocated(DstInputData%Vy_wake)) then + deallocate(DstInputData%Vy_wake) + end if + if (allocated(SrcInputData%Vz_wake)) then + LB(1:4) = lbound(SrcInputData%Vz_wake) + UB(1:4) = ubound(SrcInputData%Vz_wake) + if (.not. allocated(DstInputData%Vz_wake)) then + allocate(DstInputData%Vz_wake(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Vz_wake.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%Vz_wake = SrcInputData%Vz_wake + else if (allocated(DstInputData%Vz_wake)) then + deallocate(DstInputData%Vz_wake) + end if + if (allocated(SrcInputData%D_wake)) then + LB(1:2) = lbound(SrcInputData%D_wake) + UB(1:2) = ubound(SrcInputData%D_wake) + if (.not. allocated(DstInputData%D_wake)) then + allocate(DstInputData%D_wake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%D_wake.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%D_wake = SrcInputData%D_wake + else if (allocated(DstInputData%D_wake)) then + deallocate(DstInputData%D_wake) + end if + if (allocated(SrcInputData%WAT_k_mt)) then + LB(1:3) = lbound(SrcInputData%WAT_k_mt) + UB(1:3) = ubound(SrcInputData%WAT_k_mt) + if (.not. allocated(DstInputData%WAT_k_mt)) then + allocate(DstInputData%WAT_k_mt(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%WAT_k_mt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%WAT_k_mt = SrcInputData%WAT_k_mt + else if (allocated(DstInputData%WAT_k_mt)) then + deallocate(DstInputData%WAT_k_mt) + end if +end subroutine +subroutine AWAE_DestroyInput(InputData, ErrStat, ErrMsg) + type(AWAE_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AWAE_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%xhat_plane)) then + deallocate(InputData%xhat_plane) + end if + if (allocated(InputData%p_plane)) then + deallocate(InputData%p_plane) + end if + if (allocated(InputData%Vx_wake)) then + deallocate(InputData%Vx_wake) + end if + if (allocated(InputData%Vy_wake)) then + deallocate(InputData%Vy_wake) + end if + if (allocated(InputData%Vz_wake)) then + deallocate(InputData%Vz_wake) + end if + if (allocated(InputData%D_wake)) then + deallocate(InputData%D_wake) + end if + if (allocated(InputData%WAT_k_mt)) then + deallocate(InputData%WAT_k_mt) + end if +end subroutine subroutine AWAE_PackInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(AWAE_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AWAE_PackInput' if (Buf%ErrStat >= AbortErrLev) return - ! xhat_plane call RegPack(Buf, allocated(InData%xhat_plane)) if (allocated(InData%xhat_plane)) then call RegPackBounds(Buf, 3, lbound(InData%xhat_plane), ubound(InData%xhat_plane)) call RegPack(Buf, InData%xhat_plane) end if if (RegCheckErr(Buf, RoutineName)) return - ! p_plane call RegPack(Buf, allocated(InData%p_plane)) if (allocated(InData%p_plane)) then call RegPackBounds(Buf, 3, lbound(InData%p_plane), ubound(InData%p_plane)) call RegPack(Buf, InData%p_plane) end if if (RegCheckErr(Buf, RoutineName)) return - ! Vx_wake call RegPack(Buf, allocated(InData%Vx_wake)) if (allocated(InData%Vx_wake)) then call RegPackBounds(Buf, 4, lbound(InData%Vx_wake), ubound(InData%Vx_wake)) call RegPack(Buf, InData%Vx_wake) end if if (RegCheckErr(Buf, RoutineName)) return - ! Vy_wake call RegPack(Buf, allocated(InData%Vy_wake)) if (allocated(InData%Vy_wake)) then call RegPackBounds(Buf, 4, lbound(InData%Vy_wake), ubound(InData%Vy_wake)) call RegPack(Buf, InData%Vy_wake) end if if (RegCheckErr(Buf, RoutineName)) return - ! Vz_wake call RegPack(Buf, allocated(InData%Vz_wake)) if (allocated(InData%Vz_wake)) then call RegPackBounds(Buf, 4, lbound(InData%Vz_wake), ubound(InData%Vz_wake)) call RegPack(Buf, InData%Vz_wake) end if if (RegCheckErr(Buf, RoutineName)) return - ! D_wake call RegPack(Buf, allocated(InData%D_wake)) if (allocated(InData%D_wake)) then call RegPackBounds(Buf, 2, lbound(InData%D_wake), ubound(InData%D_wake)) call RegPack(Buf, InData%D_wake) end if if (RegCheckErr(Buf, RoutineName)) return - ! WAT_k_mt call RegPack(Buf, allocated(InData%WAT_k_mt)) if (allocated(InData%WAT_k_mt)) then call RegPackBounds(Buf, 3, lbound(InData%WAT_k_mt), ubound(InData%WAT_k_mt)) @@ -4106,7 +3729,6 @@ subroutine AWAE_UnPackInput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! xhat_plane if (allocated(OutData%xhat_plane)) deallocate(OutData%xhat_plane) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4121,7 +3743,6 @@ subroutine AWAE_UnPackInput(Buf, OutData) call RegUnpack(Buf, OutData%xhat_plane) if (RegCheckErr(Buf, RoutineName)) return end if - ! p_plane if (allocated(OutData%p_plane)) deallocate(OutData%p_plane) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4136,7 +3757,6 @@ subroutine AWAE_UnPackInput(Buf, OutData) call RegUnpack(Buf, OutData%p_plane) if (RegCheckErr(Buf, RoutineName)) return end if - ! Vx_wake if (allocated(OutData%Vx_wake)) deallocate(OutData%Vx_wake) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4151,7 +3771,6 @@ subroutine AWAE_UnPackInput(Buf, OutData) call RegUnpack(Buf, OutData%Vx_wake) if (RegCheckErr(Buf, RoutineName)) return end if - ! Vy_wake if (allocated(OutData%Vy_wake)) deallocate(OutData%Vy_wake) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4166,7 +3785,6 @@ subroutine AWAE_UnPackInput(Buf, OutData) call RegUnpack(Buf, OutData%Vy_wake) if (RegCheckErr(Buf, RoutineName)) return end if - ! Vz_wake if (allocated(OutData%Vz_wake)) deallocate(OutData%Vz_wake) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4181,7 +3799,6 @@ subroutine AWAE_UnPackInput(Buf, OutData) call RegUnpack(Buf, OutData%Vz_wake) if (RegCheckErr(Buf, RoutineName)) return end if - ! D_wake if (allocated(OutData%D_wake)) deallocate(OutData%D_wake) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4196,7 +3813,6 @@ subroutine AWAE_UnPackInput(Buf, OutData) call RegUnpack(Buf, OutData%D_wake) if (RegCheckErr(Buf, RoutineName)) return end if - ! WAT_k_mt if (allocated(OutData%WAT_k_mt)) deallocate(OutData%WAT_k_mt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/beamdyn/src/BeamDyn_Types.f90 b/modules/beamdyn/src/BeamDyn_Types.f90 index a7b2bf1219..075a1ea414 100644 --- a/modules/beamdyn/src/BeamDyn_Types.f90 +++ b/modules/beamdyn/src/BeamDyn_Types.f90 @@ -334,91 +334,66 @@ MODULE BeamDyn_Types END TYPE BD_MiscVarType ! ======================= CONTAINS - SUBROUTINE BD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BD_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(BD_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFile = SrcInitInputData%InputFile - DstInitInputData%RootName = SrcInitInputData%RootName - DstInitInputData%gravity = SrcInitInputData%gravity - DstInitInputData%GlbPos = SrcInitInputData%GlbPos - DstInitInputData%GlbRot = SrcInitInputData%GlbRot - DstInitInputData%RootDisp = SrcInitInputData%RootDisp - DstInitInputData%RootOri = SrcInitInputData%RootOri - DstInitInputData%RootVel = SrcInitInputData%RootVel - DstInitInputData%HubPos = SrcInitInputData%HubPos - DstInitInputData%HubRot = SrcInitInputData%HubRot - DstInitInputData%Linearize = SrcInitInputData%Linearize - DstInitInputData%DynamicSolve = SrcInitInputData%DynamicSolve - END SUBROUTINE BD_CopyInitInput - - SUBROUTINE BD_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(BD_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE BD_DestroyInitInput +subroutine BD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(BD_InitInputType), intent(in) :: SrcInitInputData + type(BD_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BD_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%RootName = SrcInitInputData%RootName + DstInitInputData%gravity = SrcInitInputData%gravity + DstInitInputData%GlbPos = SrcInitInputData%GlbPos + DstInitInputData%GlbRot = SrcInitInputData%GlbRot + DstInitInputData%RootDisp = SrcInitInputData%RootDisp + DstInitInputData%RootOri = SrcInitInputData%RootOri + DstInitInputData%RootVel = SrcInitInputData%RootVel + DstInitInputData%HubPos = SrcInitInputData%HubPos + DstInitInputData%HubRot = SrcInitInputData%HubRot + DstInitInputData%Linearize = SrcInitInputData%Linearize + DstInitInputData%DynamicSolve = SrcInitInputData%DynamicSolve +end subroutine +subroutine BD_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(BD_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BD_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine BD_PackInitInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(BD_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'BD_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return - ! InputFile call RegPack(Buf, InData%InputFile) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegPack(Buf, InData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! gravity call RegPack(Buf, InData%gravity) if (RegCheckErr(Buf, RoutineName)) return - ! GlbPos call RegPack(Buf, InData%GlbPos) if (RegCheckErr(Buf, RoutineName)) return - ! GlbRot call RegPack(Buf, InData%GlbRot) if (RegCheckErr(Buf, RoutineName)) return - ! RootDisp call RegPack(Buf, InData%RootDisp) if (RegCheckErr(Buf, RoutineName)) return - ! RootOri call RegPack(Buf, InData%RootOri) if (RegCheckErr(Buf, RoutineName)) return - ! RootVel call RegPack(Buf, InData%RootVel) if (RegCheckErr(Buf, RoutineName)) return - ! HubPos call RegPack(Buf, InData%HubPos) if (RegCheckErr(Buf, RoutineName)) return - ! HubRot call RegPack(Buf, InData%HubRot) if (RegCheckErr(Buf, RoutineName)) return - ! Linearize call RegPack(Buf, InData%Linearize) if (RegCheckErr(Buf, RoutineName)) return - ! DynamicSolve call RegPack(Buf, InData%DynamicSolve) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -428,332 +403,317 @@ subroutine BD_UnPackInitInput(Buf, OutData) type(BD_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackInitInput' if (Buf%ErrStat /= ErrID_None) return - ! InputFile call RegUnpack(Buf, OutData%InputFile) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegUnpack(Buf, OutData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! gravity call RegUnpack(Buf, OutData%gravity) if (RegCheckErr(Buf, RoutineName)) return - ! GlbPos call RegUnpack(Buf, OutData%GlbPos) if (RegCheckErr(Buf, RoutineName)) return - ! GlbRot call RegUnpack(Buf, OutData%GlbRot) if (RegCheckErr(Buf, RoutineName)) return - ! RootDisp call RegUnpack(Buf, OutData%RootDisp) if (RegCheckErr(Buf, RoutineName)) return - ! RootOri call RegUnpack(Buf, OutData%RootOri) if (RegCheckErr(Buf, RoutineName)) return - ! RootVel call RegUnpack(Buf, OutData%RootVel) if (RegCheckErr(Buf, RoutineName)) return - ! HubPos call RegUnpack(Buf, OutData%HubPos) if (RegCheckErr(Buf, RoutineName)) return - ! HubRot call RegUnpack(Buf, OutData%HubRot) if (RegCheckErr(Buf, RoutineName)) return - ! Linearize call RegUnpack(Buf, OutData%Linearize) if (RegCheckErr(Buf, RoutineName)) return - ! DynamicSolve call RegUnpack(Buf, OutData%DynamicSolve) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE BD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BD_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(BD_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_CopyInitOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInitOutputData%WriteOutputHdr)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputHdr,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputHdr,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputHdr)) THEN - ALLOCATE(DstInitOutputData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr -ENDIF -IF (ALLOCATED(SrcInitOutputData%WriteOutputUnt)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputUnt,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputUnt,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputUnt)) THEN - ALLOCATE(DstInitOutputData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt -ENDIF - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInitOutputData%kp_coordinate)) THEN - i1_l = LBOUND(SrcInitOutputData%kp_coordinate,1) - i1_u = UBOUND(SrcInitOutputData%kp_coordinate,1) - i2_l = LBOUND(SrcInitOutputData%kp_coordinate,2) - i2_u = UBOUND(SrcInitOutputData%kp_coordinate,2) - IF (.NOT. ALLOCATED(DstInitOutputData%kp_coordinate)) THEN - ALLOCATE(DstInitOutputData%kp_coordinate(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%kp_coordinate.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%kp_coordinate = SrcInitOutputData%kp_coordinate -ENDIF - DstInitOutputData%kp_total = SrcInitOutputData%kp_total -IF (ALLOCATED(SrcInitOutputData%LinNames_y)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_y,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_y,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_y)) THEN - ALLOCATE(DstInitOutputData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y -ENDIF -IF (ALLOCATED(SrcInitOutputData%LinNames_x)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_x,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_x,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_x)) THEN - ALLOCATE(DstInitOutputData%LinNames_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x -ENDIF -IF (ALLOCATED(SrcInitOutputData%LinNames_u)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_u,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_u)) THEN - ALLOCATE(DstInitOutputData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_y)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_y,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_y,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_y)) THEN - ALLOCATE(DstInitOutputData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_x)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_x,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_x,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_x)) THEN - ALLOCATE(DstInitOutputData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_u)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_u,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_u)) THEN - ALLOCATE(DstInitOutputData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%IsLoad_u)) THEN - i1_l = LBOUND(SrcInitOutputData%IsLoad_u,1) - i1_u = UBOUND(SrcInitOutputData%IsLoad_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%IsLoad_u)) THEN - ALLOCATE(DstInitOutputData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%DerivOrder_x)) THEN - i1_l = LBOUND(SrcInitOutputData%DerivOrder_x,1) - i1_u = UBOUND(SrcInitOutputData%DerivOrder_x,1) - IF (.NOT. ALLOCATED(DstInitOutputData%DerivOrder_x)) THEN - ALLOCATE(DstInitOutputData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x -ENDIF - END SUBROUTINE BD_CopyInitOutput - - SUBROUTINE BD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(BD_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyInitOutput' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF - CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitOutputData%kp_coordinate)) THEN - DEALLOCATE(InitOutputData%kp_coordinate) -ENDIF -IF (ALLOCATED(InitOutputData%LinNames_y)) THEN - DEALLOCATE(InitOutputData%LinNames_y) -ENDIF -IF (ALLOCATED(InitOutputData%LinNames_x)) THEN - DEALLOCATE(InitOutputData%LinNames_x) -ENDIF -IF (ALLOCATED(InitOutputData%LinNames_u)) THEN - DEALLOCATE(InitOutputData%LinNames_u) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_y)) THEN - DEALLOCATE(InitOutputData%RotFrame_y) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_x)) THEN - DEALLOCATE(InitOutputData%RotFrame_x) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_u)) THEN - DEALLOCATE(InitOutputData%RotFrame_u) -ENDIF -IF (ALLOCATED(InitOutputData%IsLoad_u)) THEN - DEALLOCATE(InitOutputData%IsLoad_u) -ENDIF -IF (ALLOCATED(InitOutputData%DerivOrder_x)) THEN - DEALLOCATE(InitOutputData%DerivOrder_x) -ENDIF - END SUBROUTINE BD_DestroyInitOutput +subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(BD_InitOutputType), intent(in) :: SrcInitOutputData + type(BD_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BD_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr + else if (allocated(DstInitOutputData%WriteOutputHdr)) then + deallocate(DstInitOutputData%WriteOutputHdr) + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt + else if (allocated(DstInitOutputData%WriteOutputUnt)) then + deallocate(DstInitOutputData%WriteOutputUnt) + end if + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInitOutputData%kp_coordinate)) then + LB(1:2) = lbound(SrcInitOutputData%kp_coordinate) + UB(1:2) = ubound(SrcInitOutputData%kp_coordinate) + if (.not. allocated(DstInitOutputData%kp_coordinate)) then + allocate(DstInitOutputData%kp_coordinate(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%kp_coordinate.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%kp_coordinate = SrcInitOutputData%kp_coordinate + else if (allocated(DstInitOutputData%kp_coordinate)) then + deallocate(DstInitOutputData%kp_coordinate) + end if + DstInitOutputData%kp_total = SrcInitOutputData%kp_total + if (allocated(SrcInitOutputData%LinNames_y)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_y) + UB(1:1) = ubound(SrcInitOutputData%LinNames_y) + if (.not. allocated(DstInitOutputData%LinNames_y)) then + allocate(DstInitOutputData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y + else if (allocated(DstInitOutputData%LinNames_y)) then + deallocate(DstInitOutputData%LinNames_y) + end if + if (allocated(SrcInitOutputData%LinNames_x)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_x) + UB(1:1) = ubound(SrcInitOutputData%LinNames_x) + if (.not. allocated(DstInitOutputData%LinNames_x)) then + allocate(DstInitOutputData%LinNames_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x + else if (allocated(DstInitOutputData%LinNames_x)) then + deallocate(DstInitOutputData%LinNames_x) + end if + if (allocated(SrcInitOutputData%LinNames_u)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_u) + UB(1:1) = ubound(SrcInitOutputData%LinNames_u) + if (.not. allocated(DstInitOutputData%LinNames_u)) then + allocate(DstInitOutputData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u + else if (allocated(DstInitOutputData%LinNames_u)) then + deallocate(DstInitOutputData%LinNames_u) + end if + if (allocated(SrcInitOutputData%RotFrame_y)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_y) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_y) + if (.not. allocated(DstInitOutputData%RotFrame_y)) then + allocate(DstInitOutputData%RotFrame_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y + else if (allocated(DstInitOutputData%RotFrame_y)) then + deallocate(DstInitOutputData%RotFrame_y) + end if + if (allocated(SrcInitOutputData%RotFrame_x)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_x) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_x) + if (.not. allocated(DstInitOutputData%RotFrame_x)) then + allocate(DstInitOutputData%RotFrame_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x + else if (allocated(DstInitOutputData%RotFrame_x)) then + deallocate(DstInitOutputData%RotFrame_x) + end if + if (allocated(SrcInitOutputData%RotFrame_u)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_u) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_u) + if (.not. allocated(DstInitOutputData%RotFrame_u)) then + allocate(DstInitOutputData%RotFrame_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u + else if (allocated(DstInitOutputData%RotFrame_u)) then + deallocate(DstInitOutputData%RotFrame_u) + end if + if (allocated(SrcInitOutputData%IsLoad_u)) then + LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) + UB(1:1) = ubound(SrcInitOutputData%IsLoad_u) + if (.not. allocated(DstInitOutputData%IsLoad_u)) then + allocate(DstInitOutputData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%IsLoad_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u + else if (allocated(DstInitOutputData%IsLoad_u)) then + deallocate(DstInitOutputData%IsLoad_u) + end if + if (allocated(SrcInitOutputData%DerivOrder_x)) then + LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) + UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x) + if (.not. allocated(DstInitOutputData%DerivOrder_x)) then + allocate(DstInitOutputData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%DerivOrder_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x + else if (allocated(DstInitOutputData%DerivOrder_x)) then + deallocate(DstInitOutputData%DerivOrder_x) + end if +end subroutine +subroutine BD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(BD_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BD_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if + if (allocated(InitOutputData%kp_coordinate)) then + deallocate(InitOutputData%kp_coordinate) + end if + if (allocated(InitOutputData%LinNames_y)) then + deallocate(InitOutputData%LinNames_y) + end if + if (allocated(InitOutputData%LinNames_x)) then + deallocate(InitOutputData%LinNames_x) + end if + if (allocated(InitOutputData%LinNames_u)) then + deallocate(InitOutputData%LinNames_u) + end if + if (allocated(InitOutputData%RotFrame_y)) then + deallocate(InitOutputData%RotFrame_y) + end if + if (allocated(InitOutputData%RotFrame_x)) then + deallocate(InitOutputData%RotFrame_x) + end if + if (allocated(InitOutputData%RotFrame_u)) then + deallocate(InitOutputData%RotFrame_u) + end if + if (allocated(InitOutputData%IsLoad_u)) then + deallocate(InitOutputData%IsLoad_u) + end if + if (allocated(InitOutputData%DerivOrder_x)) then + deallocate(InitOutputData%DerivOrder_x) + end if +end subroutine subroutine BD_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(BD_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'BD_PackInitOutput' if (Buf%ErrStat >= AbortErrLev) return - ! WriteOutputHdr call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) call RegPack(Buf, InData%WriteOutputHdr) end if if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutputUnt call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) call RegPack(Buf, InData%WriteOutputUnt) end if if (RegCheckErr(Buf, RoutineName)) return - ! Ver call NWTC_Library_PackProgDesc(Buf, InData%Ver) if (RegCheckErr(Buf, RoutineName)) return - ! kp_coordinate call RegPack(Buf, allocated(InData%kp_coordinate)) if (allocated(InData%kp_coordinate)) then call RegPackBounds(Buf, 2, lbound(InData%kp_coordinate), ubound(InData%kp_coordinate)) call RegPack(Buf, InData%kp_coordinate) end if if (RegCheckErr(Buf, RoutineName)) return - ! kp_total call RegPack(Buf, InData%kp_total) if (RegCheckErr(Buf, RoutineName)) return - ! LinNames_y call RegPack(Buf, allocated(InData%LinNames_y)) if (allocated(InData%LinNames_y)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) call RegPack(Buf, InData%LinNames_y) end if if (RegCheckErr(Buf, RoutineName)) return - ! LinNames_x call RegPack(Buf, allocated(InData%LinNames_x)) if (allocated(InData%LinNames_x)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_x), ubound(InData%LinNames_x)) call RegPack(Buf, InData%LinNames_x) end if if (RegCheckErr(Buf, RoutineName)) return - ! LinNames_u call RegPack(Buf, allocated(InData%LinNames_u)) if (allocated(InData%LinNames_u)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) call RegPack(Buf, InData%LinNames_u) end if if (RegCheckErr(Buf, RoutineName)) return - ! RotFrame_y call RegPack(Buf, allocated(InData%RotFrame_y)) if (allocated(InData%RotFrame_y)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y), ubound(InData%RotFrame_y)) call RegPack(Buf, InData%RotFrame_y) end if if (RegCheckErr(Buf, RoutineName)) return - ! RotFrame_x call RegPack(Buf, allocated(InData%RotFrame_x)) if (allocated(InData%RotFrame_x)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x), ubound(InData%RotFrame_x)) call RegPack(Buf, InData%RotFrame_x) end if if (RegCheckErr(Buf, RoutineName)) return - ! RotFrame_u call RegPack(Buf, allocated(InData%RotFrame_u)) if (allocated(InData%RotFrame_u)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u), ubound(InData%RotFrame_u)) call RegPack(Buf, InData%RotFrame_u) end if if (RegCheckErr(Buf, RoutineName)) return - ! IsLoad_u call RegPack(Buf, allocated(InData%IsLoad_u)) if (allocated(InData%IsLoad_u)) then call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) call RegPack(Buf, InData%IsLoad_u) end if if (RegCheckErr(Buf, RoutineName)) return - ! DerivOrder_x call RegPack(Buf, allocated(InData%DerivOrder_x)) if (allocated(InData%DerivOrder_x)) then call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x), ubound(InData%DerivOrder_x)) @@ -770,7 +730,6 @@ subroutine BD_UnPackInitOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! WriteOutputHdr if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -785,7 +744,6 @@ subroutine BD_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutputHdr) if (RegCheckErr(Buf, RoutineName)) return end if - ! WriteOutputUnt if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -800,9 +758,7 @@ subroutine BD_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutputUnt) if (RegCheckErr(Buf, RoutineName)) return end if - ! Ver call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver - ! kp_coordinate if (allocated(OutData%kp_coordinate)) deallocate(OutData%kp_coordinate) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -817,10 +773,8 @@ subroutine BD_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%kp_coordinate) if (RegCheckErr(Buf, RoutineName)) return end if - ! kp_total call RegUnpack(Buf, OutData%kp_total) if (RegCheckErr(Buf, RoutineName)) return - ! LinNames_y if (allocated(OutData%LinNames_y)) deallocate(OutData%LinNames_y) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -835,7 +789,6 @@ subroutine BD_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%LinNames_y) if (RegCheckErr(Buf, RoutineName)) return end if - ! LinNames_x if (allocated(OutData%LinNames_x)) deallocate(OutData%LinNames_x) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -850,7 +803,6 @@ subroutine BD_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%LinNames_x) if (RegCheckErr(Buf, RoutineName)) return end if - ! LinNames_u if (allocated(OutData%LinNames_u)) deallocate(OutData%LinNames_u) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -865,7 +817,6 @@ subroutine BD_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%LinNames_u) if (RegCheckErr(Buf, RoutineName)) return end if - ! RotFrame_y if (allocated(OutData%RotFrame_y)) deallocate(OutData%RotFrame_y) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -880,7 +831,6 @@ subroutine BD_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%RotFrame_y) if (RegCheckErr(Buf, RoutineName)) return end if - ! RotFrame_x if (allocated(OutData%RotFrame_x)) deallocate(OutData%RotFrame_x) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -895,7 +845,6 @@ subroutine BD_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%RotFrame_x) if (RegCheckErr(Buf, RoutineName)) return end if - ! RotFrame_u if (allocated(OutData%RotFrame_u)) deallocate(OutData%RotFrame_u) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -910,7 +859,6 @@ subroutine BD_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%RotFrame_u) if (RegCheckErr(Buf, RoutineName)) return end if - ! IsLoad_u if (allocated(OutData%IsLoad_u)) deallocate(OutData%IsLoad_u) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -925,7 +873,6 @@ subroutine BD_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%IsLoad_u) if (RegCheckErr(Buf, RoutineName)) return end if - ! DerivOrder_x if (allocated(OutData%DerivOrder_x)) deallocate(OutData%DerivOrder_x) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -941,134 +888,113 @@ subroutine BD_UnPackInitOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE BD_CopyBladeInputData( SrcBladeInputDataData, DstBladeInputDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BladeInputData), INTENT(IN) :: SrcBladeInputDataData - TYPE(BladeInputData), INTENT(INOUT) :: DstBladeInputDataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_CopyBladeInputData' -! - ErrStat = ErrID_None - ErrMsg = "" - DstBladeInputDataData%station_total = SrcBladeInputDataData%station_total - DstBladeInputDataData%format_index = SrcBladeInputDataData%format_index -IF (ALLOCATED(SrcBladeInputDataData%station_eta)) THEN - i1_l = LBOUND(SrcBladeInputDataData%station_eta,1) - i1_u = UBOUND(SrcBladeInputDataData%station_eta,1) - IF (.NOT. ALLOCATED(DstBladeInputDataData%station_eta)) THEN - ALLOCATE(DstBladeInputDataData%station_eta(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%station_eta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeInputDataData%station_eta = SrcBladeInputDataData%station_eta -ENDIF -IF (ALLOCATED(SrcBladeInputDataData%stiff0)) THEN - i1_l = LBOUND(SrcBladeInputDataData%stiff0,1) - i1_u = UBOUND(SrcBladeInputDataData%stiff0,1) - i2_l = LBOUND(SrcBladeInputDataData%stiff0,2) - i2_u = UBOUND(SrcBladeInputDataData%stiff0,2) - i3_l = LBOUND(SrcBladeInputDataData%stiff0,3) - i3_u = UBOUND(SrcBladeInputDataData%stiff0,3) - IF (.NOT. ALLOCATED(DstBladeInputDataData%stiff0)) THEN - ALLOCATE(DstBladeInputDataData%stiff0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%stiff0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeInputDataData%stiff0 = SrcBladeInputDataData%stiff0 -ENDIF -IF (ALLOCATED(SrcBladeInputDataData%mass0)) THEN - i1_l = LBOUND(SrcBladeInputDataData%mass0,1) - i1_u = UBOUND(SrcBladeInputDataData%mass0,1) - i2_l = LBOUND(SrcBladeInputDataData%mass0,2) - i2_u = UBOUND(SrcBladeInputDataData%mass0,2) - i3_l = LBOUND(SrcBladeInputDataData%mass0,3) - i3_u = UBOUND(SrcBladeInputDataData%mass0,3) - IF (.NOT. ALLOCATED(DstBladeInputDataData%mass0)) THEN - ALLOCATE(DstBladeInputDataData%mass0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%mass0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeInputDataData%mass0 = SrcBladeInputDataData%mass0 -ENDIF - DstBladeInputDataData%beta = SrcBladeInputDataData%beta - DstBladeInputDataData%damp_flag = SrcBladeInputDataData%damp_flag - END SUBROUTINE BD_CopyBladeInputData - - SUBROUTINE BD_DestroyBladeInputData( BladeInputDataData, ErrStat, ErrMsg ) - TYPE(BladeInputData), INTENT(INOUT) :: BladeInputDataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyBladeInputData' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(BladeInputDataData%station_eta)) THEN - DEALLOCATE(BladeInputDataData%station_eta) -ENDIF -IF (ALLOCATED(BladeInputDataData%stiff0)) THEN - DEALLOCATE(BladeInputDataData%stiff0) -ENDIF -IF (ALLOCATED(BladeInputDataData%mass0)) THEN - DEALLOCATE(BladeInputDataData%mass0) -ENDIF - END SUBROUTINE BD_DestroyBladeInputData +subroutine BD_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, CtrlCode, ErrStat, ErrMsg) + type(BladeInputData), intent(in) :: SrcBladeInputDataData + type(BladeInputData), intent(inout) :: DstBladeInputDataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'BD_CopyBladeInputData' + ErrStat = ErrID_None + ErrMsg = '' + DstBladeInputDataData%station_total = SrcBladeInputDataData%station_total + DstBladeInputDataData%format_index = SrcBladeInputDataData%format_index + if (allocated(SrcBladeInputDataData%station_eta)) then + LB(1:1) = lbound(SrcBladeInputDataData%station_eta) + UB(1:1) = ubound(SrcBladeInputDataData%station_eta) + if (.not. allocated(DstBladeInputDataData%station_eta)) then + allocate(DstBladeInputDataData%station_eta(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%station_eta.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeInputDataData%station_eta = SrcBladeInputDataData%station_eta + else if (allocated(DstBladeInputDataData%station_eta)) then + deallocate(DstBladeInputDataData%station_eta) + end if + if (allocated(SrcBladeInputDataData%stiff0)) then + LB(1:3) = lbound(SrcBladeInputDataData%stiff0) + UB(1:3) = ubound(SrcBladeInputDataData%stiff0) + if (.not. allocated(DstBladeInputDataData%stiff0)) then + allocate(DstBladeInputDataData%stiff0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%stiff0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeInputDataData%stiff0 = SrcBladeInputDataData%stiff0 + else if (allocated(DstBladeInputDataData%stiff0)) then + deallocate(DstBladeInputDataData%stiff0) + end if + if (allocated(SrcBladeInputDataData%mass0)) then + LB(1:3) = lbound(SrcBladeInputDataData%mass0) + UB(1:3) = ubound(SrcBladeInputDataData%mass0) + if (.not. allocated(DstBladeInputDataData%mass0)) then + allocate(DstBladeInputDataData%mass0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%mass0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeInputDataData%mass0 = SrcBladeInputDataData%mass0 + else if (allocated(DstBladeInputDataData%mass0)) then + deallocate(DstBladeInputDataData%mass0) + end if + DstBladeInputDataData%beta = SrcBladeInputDataData%beta + DstBladeInputDataData%damp_flag = SrcBladeInputDataData%damp_flag +end subroutine +subroutine BD_DestroyBladeInputData(BladeInputDataData, ErrStat, ErrMsg) + type(BladeInputData), intent(inout) :: BladeInputDataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BD_DestroyBladeInputData' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(BladeInputDataData%station_eta)) then + deallocate(BladeInputDataData%station_eta) + end if + if (allocated(BladeInputDataData%stiff0)) then + deallocate(BladeInputDataData%stiff0) + end if + if (allocated(BladeInputDataData%mass0)) then + deallocate(BladeInputDataData%mass0) + end if +end subroutine subroutine BD_PackBladeInputData(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(BladeInputData), intent(in) :: InData character(*), parameter :: RoutineName = 'BD_PackBladeInputData' if (Buf%ErrStat >= AbortErrLev) return - ! station_total call RegPack(Buf, InData%station_total) if (RegCheckErr(Buf, RoutineName)) return - ! format_index call RegPack(Buf, InData%format_index) if (RegCheckErr(Buf, RoutineName)) return - ! station_eta call RegPack(Buf, allocated(InData%station_eta)) if (allocated(InData%station_eta)) then call RegPackBounds(Buf, 1, lbound(InData%station_eta), ubound(InData%station_eta)) call RegPack(Buf, InData%station_eta) end if if (RegCheckErr(Buf, RoutineName)) return - ! stiff0 call RegPack(Buf, allocated(InData%stiff0)) if (allocated(InData%stiff0)) then call RegPackBounds(Buf, 3, lbound(InData%stiff0), ubound(InData%stiff0)) call RegPack(Buf, InData%stiff0) end if if (RegCheckErr(Buf, RoutineName)) return - ! mass0 call RegPack(Buf, allocated(InData%mass0)) if (allocated(InData%mass0)) then call RegPackBounds(Buf, 3, lbound(InData%mass0), ubound(InData%mass0)) call RegPack(Buf, InData%mass0) end if if (RegCheckErr(Buf, RoutineName)) return - ! beta call RegPack(Buf, InData%beta) if (RegCheckErr(Buf, RoutineName)) return - ! damp_flag call RegPack(Buf, InData%damp_flag) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1081,13 +1007,10 @@ subroutine BD_UnPackBladeInputData(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! station_total call RegUnpack(Buf, OutData%station_total) if (RegCheckErr(Buf, RoutineName)) return - ! format_index call RegUnpack(Buf, OutData%format_index) if (RegCheckErr(Buf, RoutineName)) return - ! station_eta if (allocated(OutData%station_eta)) deallocate(OutData%station_eta) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1102,7 +1025,6 @@ subroutine BD_UnPackBladeInputData(Buf, OutData) call RegUnpack(Buf, OutData%station_eta) if (RegCheckErr(Buf, RoutineName)) return end if - ! stiff0 if (allocated(OutData%stiff0)) deallocate(OutData%stiff0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1117,7 +1039,6 @@ subroutine BD_UnPackBladeInputData(Buf, OutData) call RegUnpack(Buf, OutData%stiff0) if (RegCheckErr(Buf, RoutineName)) return end if - ! mass0 if (allocated(OutData%mass0)) deallocate(OutData%mass0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1132,294 +1053,253 @@ subroutine BD_UnPackBladeInputData(Buf, OutData) call RegUnpack(Buf, OutData%mass0) if (RegCheckErr(Buf, RoutineName)) return end if - ! beta call RegUnpack(Buf, OutData%beta) if (RegCheckErr(Buf, RoutineName)) return - ! damp_flag call RegUnpack(Buf, OutData%damp_flag) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE BD_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BD_InputFile), INTENT(IN) :: SrcInputFileData - TYPE(BD_InputFile), INTENT(INOUT) :: DstInputFileData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_CopyInputFile' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInputFileData%member_total = SrcInputFileData%member_total - DstInputFileData%kp_total = SrcInputFileData%kp_total -IF (ALLOCATED(SrcInputFileData%kp_member)) THEN - i1_l = LBOUND(SrcInputFileData%kp_member,1) - i1_u = UBOUND(SrcInputFileData%kp_member,1) - IF (.NOT. ALLOCATED(DstInputFileData%kp_member)) THEN - ALLOCATE(DstInputFileData%kp_member(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%kp_member.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%kp_member = SrcInputFileData%kp_member -ENDIF - DstInputFileData%order_elem = SrcInputFileData%order_elem - DstInputFileData%load_retries = SrcInputFileData%load_retries - DstInputFileData%NRMax = SrcInputFileData%NRMax - DstInputFileData%quadrature = SrcInputFileData%quadrature - DstInputFileData%n_fact = SrcInputFileData%n_fact - DstInputFileData%refine = SrcInputFileData%refine - DstInputFileData%rhoinf = SrcInputFileData%rhoinf - DstInputFileData%DTBeam = SrcInputFileData%DTBeam - CALL BD_Copybladeinputdata( SrcInputFileData%InpBl, DstInputFileData%InpBl, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInputFileData%BldFile = SrcInputFileData%BldFile - DstInputFileData%UsePitchAct = SrcInputFileData%UsePitchAct - DstInputFileData%QuasiStaticInit = SrcInputFileData%QuasiStaticInit - DstInputFileData%stop_tol = SrcInputFileData%stop_tol - DstInputFileData%tngt_stf_pert = SrcInputFileData%tngt_stf_pert - DstInputFileData%tngt_stf_difftol = SrcInputFileData%tngt_stf_difftol -IF (ALLOCATED(SrcInputFileData%kp_coordinate)) THEN - i1_l = LBOUND(SrcInputFileData%kp_coordinate,1) - i1_u = UBOUND(SrcInputFileData%kp_coordinate,1) - i2_l = LBOUND(SrcInputFileData%kp_coordinate,2) - i2_u = UBOUND(SrcInputFileData%kp_coordinate,2) - IF (.NOT. ALLOCATED(DstInputFileData%kp_coordinate)) THEN - ALLOCATE(DstInputFileData%kp_coordinate(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%kp_coordinate.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%kp_coordinate = SrcInputFileData%kp_coordinate -ENDIF - DstInputFileData%pitchJ = SrcInputFileData%pitchJ - DstInputFileData%pitchK = SrcInputFileData%pitchK - DstInputFileData%pitchC = SrcInputFileData%pitchC - DstInputFileData%Echo = SrcInputFileData%Echo - DstInputFileData%RotStates = SrcInputFileData%RotStates - DstInputFileData%RelStates = SrcInputFileData%RelStates - DstInputFileData%tngt_stf_fd = SrcInputFileData%tngt_stf_fd - DstInputFileData%tngt_stf_comp = SrcInputFileData%tngt_stf_comp - DstInputFileData%NNodeOuts = SrcInputFileData%NNodeOuts - DstInputFileData%OutNd = SrcInputFileData%OutNd - DstInputFileData%NumOuts = SrcInputFileData%NumOuts -IF (ALLOCATED(SrcInputFileData%OutList)) THEN - i1_l = LBOUND(SrcInputFileData%OutList,1) - i1_u = UBOUND(SrcInputFileData%OutList,1) - IF (.NOT. ALLOCATED(DstInputFileData%OutList)) THEN - ALLOCATE(DstInputFileData%OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%OutList = SrcInputFileData%OutList -ENDIF - DstInputFileData%SumPrint = SrcInputFileData%SumPrint - DstInputFileData%OutFmt = SrcInputFileData%OutFmt - DstInputFileData%BldNd_NumOuts = SrcInputFileData%BldNd_NumOuts -IF (ALLOCATED(SrcInputFileData%BldNd_OutList)) THEN - i1_l = LBOUND(SrcInputFileData%BldNd_OutList,1) - i1_u = UBOUND(SrcInputFileData%BldNd_OutList,1) - IF (.NOT. ALLOCATED(DstInputFileData%BldNd_OutList)) THEN - ALLOCATE(DstInputFileData%BldNd_OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BldNd_OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%BldNd_OutList = SrcInputFileData%BldNd_OutList -ENDIF -IF (ALLOCATED(SrcInputFileData%BldNd_BlOutNd)) THEN - i1_l = LBOUND(SrcInputFileData%BldNd_BlOutNd,1) - i1_u = UBOUND(SrcInputFileData%BldNd_BlOutNd,1) - IF (.NOT. ALLOCATED(DstInputFileData%BldNd_BlOutNd)) THEN - ALLOCATE(DstInputFileData%BldNd_BlOutNd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BldNd_BlOutNd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%BldNd_BlOutNd = SrcInputFileData%BldNd_BlOutNd -ENDIF - DstInputFileData%BldNd_BlOutNd_Str = SrcInputFileData%BldNd_BlOutNd_Str - END SUBROUTINE BD_CopyInputFile - - SUBROUTINE BD_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) - TYPE(BD_InputFile), INTENT(INOUT) :: InputFileData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyInputFile' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputFileData%kp_member)) THEN - DEALLOCATE(InputFileData%kp_member) -ENDIF - CALL BD_DestroyBladeInputData( InputFileData%InpBl, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InputFileData%kp_coordinate)) THEN - DEALLOCATE(InputFileData%kp_coordinate) -ENDIF -IF (ALLOCATED(InputFileData%OutList)) THEN - DEALLOCATE(InputFileData%OutList) -ENDIF -IF (ALLOCATED(InputFileData%BldNd_OutList)) THEN - DEALLOCATE(InputFileData%BldNd_OutList) -ENDIF -IF (ALLOCATED(InputFileData%BldNd_BlOutNd)) THEN - DEALLOCATE(InputFileData%BldNd_BlOutNd) -ENDIF - END SUBROUTINE BD_DestroyInputFile +subroutine BD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) + type(BD_InputFile), intent(in) :: SrcInputFileData + type(BD_InputFile), intent(inout) :: DstInputFileData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BD_CopyInputFile' + ErrStat = ErrID_None + ErrMsg = '' + DstInputFileData%member_total = SrcInputFileData%member_total + DstInputFileData%kp_total = SrcInputFileData%kp_total + if (allocated(SrcInputFileData%kp_member)) then + LB(1:1) = lbound(SrcInputFileData%kp_member) + UB(1:1) = ubound(SrcInputFileData%kp_member) + if (.not. allocated(DstInputFileData%kp_member)) then + allocate(DstInputFileData%kp_member(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%kp_member.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%kp_member = SrcInputFileData%kp_member + else if (allocated(DstInputFileData%kp_member)) then + deallocate(DstInputFileData%kp_member) + end if + DstInputFileData%order_elem = SrcInputFileData%order_elem + DstInputFileData%load_retries = SrcInputFileData%load_retries + DstInputFileData%NRMax = SrcInputFileData%NRMax + DstInputFileData%quadrature = SrcInputFileData%quadrature + DstInputFileData%n_fact = SrcInputFileData%n_fact + DstInputFileData%refine = SrcInputFileData%refine + DstInputFileData%rhoinf = SrcInputFileData%rhoinf + DstInputFileData%DTBeam = SrcInputFileData%DTBeam + call BD_CopyBladeInputData(SrcInputFileData%InpBl, DstInputFileData%InpBl, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInputFileData%BldFile = SrcInputFileData%BldFile + DstInputFileData%UsePitchAct = SrcInputFileData%UsePitchAct + DstInputFileData%QuasiStaticInit = SrcInputFileData%QuasiStaticInit + DstInputFileData%stop_tol = SrcInputFileData%stop_tol + DstInputFileData%tngt_stf_pert = SrcInputFileData%tngt_stf_pert + DstInputFileData%tngt_stf_difftol = SrcInputFileData%tngt_stf_difftol + if (allocated(SrcInputFileData%kp_coordinate)) then + LB(1:2) = lbound(SrcInputFileData%kp_coordinate) + UB(1:2) = ubound(SrcInputFileData%kp_coordinate) + if (.not. allocated(DstInputFileData%kp_coordinate)) then + allocate(DstInputFileData%kp_coordinate(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%kp_coordinate.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%kp_coordinate = SrcInputFileData%kp_coordinate + else if (allocated(DstInputFileData%kp_coordinate)) then + deallocate(DstInputFileData%kp_coordinate) + end if + DstInputFileData%pitchJ = SrcInputFileData%pitchJ + DstInputFileData%pitchK = SrcInputFileData%pitchK + DstInputFileData%pitchC = SrcInputFileData%pitchC + DstInputFileData%Echo = SrcInputFileData%Echo + DstInputFileData%RotStates = SrcInputFileData%RotStates + DstInputFileData%RelStates = SrcInputFileData%RelStates + DstInputFileData%tngt_stf_fd = SrcInputFileData%tngt_stf_fd + DstInputFileData%tngt_stf_comp = SrcInputFileData%tngt_stf_comp + DstInputFileData%NNodeOuts = SrcInputFileData%NNodeOuts + DstInputFileData%OutNd = SrcInputFileData%OutNd + DstInputFileData%NumOuts = SrcInputFileData%NumOuts + if (allocated(SrcInputFileData%OutList)) then + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) + if (.not. allocated(DstInputFileData%OutList)) then + allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%OutList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%OutList = SrcInputFileData%OutList + else if (allocated(DstInputFileData%OutList)) then + deallocate(DstInputFileData%OutList) + end if + DstInputFileData%SumPrint = SrcInputFileData%SumPrint + DstInputFileData%OutFmt = SrcInputFileData%OutFmt + DstInputFileData%BldNd_NumOuts = SrcInputFileData%BldNd_NumOuts + if (allocated(SrcInputFileData%BldNd_OutList)) then + LB(1:1) = lbound(SrcInputFileData%BldNd_OutList) + UB(1:1) = ubound(SrcInputFileData%BldNd_OutList) + if (.not. allocated(DstInputFileData%BldNd_OutList)) then + allocate(DstInputFileData%BldNd_OutList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BldNd_OutList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%BldNd_OutList = SrcInputFileData%BldNd_OutList + else if (allocated(DstInputFileData%BldNd_OutList)) then + deallocate(DstInputFileData%BldNd_OutList) + end if + if (allocated(SrcInputFileData%BldNd_BlOutNd)) then + LB(1:1) = lbound(SrcInputFileData%BldNd_BlOutNd) + UB(1:1) = ubound(SrcInputFileData%BldNd_BlOutNd) + if (.not. allocated(DstInputFileData%BldNd_BlOutNd)) then + allocate(DstInputFileData%BldNd_BlOutNd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BldNd_BlOutNd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%BldNd_BlOutNd = SrcInputFileData%BldNd_BlOutNd + else if (allocated(DstInputFileData%BldNd_BlOutNd)) then + deallocate(DstInputFileData%BldNd_BlOutNd) + end if + DstInputFileData%BldNd_BlOutNd_Str = SrcInputFileData%BldNd_BlOutNd_Str +end subroutine +subroutine BD_DestroyInputFile(InputFileData, ErrStat, ErrMsg) + type(BD_InputFile), intent(inout) :: InputFileData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BD_DestroyInputFile' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputFileData%kp_member)) then + deallocate(InputFileData%kp_member) + end if + if (allocated(InputFileData%kp_coordinate)) then + deallocate(InputFileData%kp_coordinate) + end if + if (allocated(InputFileData%OutList)) then + deallocate(InputFileData%OutList) + end if + if (allocated(InputFileData%BldNd_OutList)) then + deallocate(InputFileData%BldNd_OutList) + end if + if (allocated(InputFileData%BldNd_BlOutNd)) then + deallocate(InputFileData%BldNd_BlOutNd) + end if +end subroutine subroutine BD_PackInputFile(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(BD_InputFile), intent(in) :: InData character(*), parameter :: RoutineName = 'BD_PackInputFile' if (Buf%ErrStat >= AbortErrLev) return - ! member_total call RegPack(Buf, InData%member_total) if (RegCheckErr(Buf, RoutineName)) return - ! kp_total call RegPack(Buf, InData%kp_total) if (RegCheckErr(Buf, RoutineName)) return - ! kp_member call RegPack(Buf, allocated(InData%kp_member)) if (allocated(InData%kp_member)) then call RegPackBounds(Buf, 1, lbound(InData%kp_member), ubound(InData%kp_member)) call RegPack(Buf, InData%kp_member) end if if (RegCheckErr(Buf, RoutineName)) return - ! order_elem call RegPack(Buf, InData%order_elem) if (RegCheckErr(Buf, RoutineName)) return - ! load_retries call RegPack(Buf, InData%load_retries) if (RegCheckErr(Buf, RoutineName)) return - ! NRMax call RegPack(Buf, InData%NRMax) if (RegCheckErr(Buf, RoutineName)) return - ! quadrature call RegPack(Buf, InData%quadrature) if (RegCheckErr(Buf, RoutineName)) return - ! n_fact call RegPack(Buf, InData%n_fact) if (RegCheckErr(Buf, RoutineName)) return - ! refine call RegPack(Buf, InData%refine) if (RegCheckErr(Buf, RoutineName)) return - ! rhoinf call RegPack(Buf, InData%rhoinf) if (RegCheckErr(Buf, RoutineName)) return - ! DTBeam call RegPack(Buf, InData%DTBeam) if (RegCheckErr(Buf, RoutineName)) return - ! InpBl call BD_PackBladeInputData(Buf, InData%InpBl) if (RegCheckErr(Buf, RoutineName)) return - ! BldFile call RegPack(Buf, InData%BldFile) if (RegCheckErr(Buf, RoutineName)) return - ! UsePitchAct call RegPack(Buf, InData%UsePitchAct) if (RegCheckErr(Buf, RoutineName)) return - ! QuasiStaticInit call RegPack(Buf, InData%QuasiStaticInit) if (RegCheckErr(Buf, RoutineName)) return - ! stop_tol call RegPack(Buf, InData%stop_tol) if (RegCheckErr(Buf, RoutineName)) return - ! tngt_stf_pert call RegPack(Buf, InData%tngt_stf_pert) if (RegCheckErr(Buf, RoutineName)) return - ! tngt_stf_difftol call RegPack(Buf, InData%tngt_stf_difftol) if (RegCheckErr(Buf, RoutineName)) return - ! kp_coordinate call RegPack(Buf, allocated(InData%kp_coordinate)) if (allocated(InData%kp_coordinate)) then call RegPackBounds(Buf, 2, lbound(InData%kp_coordinate), ubound(InData%kp_coordinate)) call RegPack(Buf, InData%kp_coordinate) end if if (RegCheckErr(Buf, RoutineName)) return - ! pitchJ call RegPack(Buf, InData%pitchJ) if (RegCheckErr(Buf, RoutineName)) return - ! pitchK call RegPack(Buf, InData%pitchK) if (RegCheckErr(Buf, RoutineName)) return - ! pitchC call RegPack(Buf, InData%pitchC) if (RegCheckErr(Buf, RoutineName)) return - ! Echo call RegPack(Buf, InData%Echo) if (RegCheckErr(Buf, RoutineName)) return - ! RotStates call RegPack(Buf, InData%RotStates) if (RegCheckErr(Buf, RoutineName)) return - ! RelStates call RegPack(Buf, InData%RelStates) if (RegCheckErr(Buf, RoutineName)) return - ! tngt_stf_fd call RegPack(Buf, InData%tngt_stf_fd) if (RegCheckErr(Buf, RoutineName)) return - ! tngt_stf_comp call RegPack(Buf, InData%tngt_stf_comp) if (RegCheckErr(Buf, RoutineName)) return - ! NNodeOuts call RegPack(Buf, InData%NNodeOuts) if (RegCheckErr(Buf, RoutineName)) return - ! OutNd call RegPack(Buf, InData%OutNd) if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegPack(Buf, InData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! OutList call RegPack(Buf, allocated(InData%OutList)) if (allocated(InData%OutList)) then call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) call RegPack(Buf, InData%OutList) end if if (RegCheckErr(Buf, RoutineName)) return - ! SumPrint call RegPack(Buf, InData%SumPrint) if (RegCheckErr(Buf, RoutineName)) return - ! OutFmt call RegPack(Buf, InData%OutFmt) if (RegCheckErr(Buf, RoutineName)) return - ! BldNd_NumOuts call RegPack(Buf, InData%BldNd_NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! BldNd_OutList call RegPack(Buf, allocated(InData%BldNd_OutList)) if (allocated(InData%BldNd_OutList)) then call RegPackBounds(Buf, 1, lbound(InData%BldNd_OutList), ubound(InData%BldNd_OutList)) call RegPack(Buf, InData%BldNd_OutList) end if if (RegCheckErr(Buf, RoutineName)) return - ! BldNd_BlOutNd call RegPack(Buf, allocated(InData%BldNd_BlOutNd)) if (allocated(InData%BldNd_BlOutNd)) then call RegPackBounds(Buf, 1, lbound(InData%BldNd_BlOutNd), ubound(InData%BldNd_BlOutNd)) call RegPack(Buf, InData%BldNd_BlOutNd) end if if (RegCheckErr(Buf, RoutineName)) return - ! BldNd_BlOutNd_Str call RegPack(Buf, InData%BldNd_BlOutNd_Str) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1432,13 +1312,10 @@ subroutine BD_UnPackInputFile(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! member_total call RegUnpack(Buf, OutData%member_total) if (RegCheckErr(Buf, RoutineName)) return - ! kp_total call RegUnpack(Buf, OutData%kp_total) if (RegCheckErr(Buf, RoutineName)) return - ! kp_member if (allocated(OutData%kp_member)) deallocate(OutData%kp_member) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1453,51 +1330,35 @@ subroutine BD_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%kp_member) if (RegCheckErr(Buf, RoutineName)) return end if - ! order_elem call RegUnpack(Buf, OutData%order_elem) if (RegCheckErr(Buf, RoutineName)) return - ! load_retries call RegUnpack(Buf, OutData%load_retries) if (RegCheckErr(Buf, RoutineName)) return - ! NRMax call RegUnpack(Buf, OutData%NRMax) if (RegCheckErr(Buf, RoutineName)) return - ! quadrature call RegUnpack(Buf, OutData%quadrature) if (RegCheckErr(Buf, RoutineName)) return - ! n_fact call RegUnpack(Buf, OutData%n_fact) if (RegCheckErr(Buf, RoutineName)) return - ! refine call RegUnpack(Buf, OutData%refine) if (RegCheckErr(Buf, RoutineName)) return - ! rhoinf call RegUnpack(Buf, OutData%rhoinf) if (RegCheckErr(Buf, RoutineName)) return - ! DTBeam call RegUnpack(Buf, OutData%DTBeam) if (RegCheckErr(Buf, RoutineName)) return - ! InpBl call BD_UnpackBladeInputData(Buf, OutData%InpBl) ! InpBl - ! BldFile call RegUnpack(Buf, OutData%BldFile) if (RegCheckErr(Buf, RoutineName)) return - ! UsePitchAct call RegUnpack(Buf, OutData%UsePitchAct) if (RegCheckErr(Buf, RoutineName)) return - ! QuasiStaticInit call RegUnpack(Buf, OutData%QuasiStaticInit) if (RegCheckErr(Buf, RoutineName)) return - ! stop_tol call RegUnpack(Buf, OutData%stop_tol) if (RegCheckErr(Buf, RoutineName)) return - ! tngt_stf_pert call RegUnpack(Buf, OutData%tngt_stf_pert) if (RegCheckErr(Buf, RoutineName)) return - ! tngt_stf_difftol call RegUnpack(Buf, OutData%tngt_stf_difftol) if (RegCheckErr(Buf, RoutineName)) return - ! kp_coordinate if (allocated(OutData%kp_coordinate)) deallocate(OutData%kp_coordinate) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1512,40 +1373,28 @@ subroutine BD_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%kp_coordinate) if (RegCheckErr(Buf, RoutineName)) return end if - ! pitchJ call RegUnpack(Buf, OutData%pitchJ) if (RegCheckErr(Buf, RoutineName)) return - ! pitchK call RegUnpack(Buf, OutData%pitchK) if (RegCheckErr(Buf, RoutineName)) return - ! pitchC call RegUnpack(Buf, OutData%pitchC) if (RegCheckErr(Buf, RoutineName)) return - ! Echo call RegUnpack(Buf, OutData%Echo) if (RegCheckErr(Buf, RoutineName)) return - ! RotStates call RegUnpack(Buf, OutData%RotStates) if (RegCheckErr(Buf, RoutineName)) return - ! RelStates call RegUnpack(Buf, OutData%RelStates) if (RegCheckErr(Buf, RoutineName)) return - ! tngt_stf_fd call RegUnpack(Buf, OutData%tngt_stf_fd) if (RegCheckErr(Buf, RoutineName)) return - ! tngt_stf_comp call RegUnpack(Buf, OutData%tngt_stf_comp) if (RegCheckErr(Buf, RoutineName)) return - ! NNodeOuts call RegUnpack(Buf, OutData%NNodeOuts) if (RegCheckErr(Buf, RoutineName)) return - ! OutNd call RegUnpack(Buf, OutData%OutNd) if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegUnpack(Buf, OutData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! OutList if (allocated(OutData%OutList)) deallocate(OutData%OutList) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1560,16 +1409,12 @@ subroutine BD_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%OutList) if (RegCheckErr(Buf, RoutineName)) return end if - ! SumPrint call RegUnpack(Buf, OutData%SumPrint) if (RegCheckErr(Buf, RoutineName)) return - ! OutFmt call RegUnpack(Buf, OutData%OutFmt) if (RegCheckErr(Buf, RoutineName)) return - ! BldNd_NumOuts call RegUnpack(Buf, OutData%BldNd_NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! BldNd_OutList if (allocated(OutData%BldNd_OutList)) deallocate(OutData%BldNd_OutList) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1584,7 +1429,6 @@ subroutine BD_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%BldNd_OutList) if (RegCheckErr(Buf, RoutineName)) return end if - ! BldNd_BlOutNd if (allocated(OutData%BldNd_BlOutNd)) deallocate(OutData%BldNd_BlOutNd) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1599,91 +1443,77 @@ subroutine BD_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%BldNd_BlOutNd) if (RegCheckErr(Buf, RoutineName)) return end if - ! BldNd_BlOutNd_Str call RegUnpack(Buf, OutData%BldNd_BlOutNd_Str) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE BD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BD_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(BD_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcContStateData%q)) THEN - i1_l = LBOUND(SrcContStateData%q,1) - i1_u = UBOUND(SrcContStateData%q,1) - i2_l = LBOUND(SrcContStateData%q,2) - i2_u = UBOUND(SrcContStateData%q,2) - IF (.NOT. ALLOCATED(DstContStateData%q)) THEN - ALLOCATE(DstContStateData%q(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%q.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstContStateData%q = SrcContStateData%q -ENDIF -IF (ALLOCATED(SrcContStateData%dqdt)) THEN - i1_l = LBOUND(SrcContStateData%dqdt,1) - i1_u = UBOUND(SrcContStateData%dqdt,1) - i2_l = LBOUND(SrcContStateData%dqdt,2) - i2_u = UBOUND(SrcContStateData%dqdt,2) - IF (.NOT. ALLOCATED(DstContStateData%dqdt)) THEN - ALLOCATE(DstContStateData%dqdt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%dqdt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstContStateData%dqdt = SrcContStateData%dqdt -ENDIF - END SUBROUTINE BD_CopyContState - - SUBROUTINE BD_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(BD_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(ContStateData%q)) THEN - DEALLOCATE(ContStateData%q) -ENDIF -IF (ALLOCATED(ContStateData%dqdt)) THEN - DEALLOCATE(ContStateData%dqdt) -ENDIF - END SUBROUTINE BD_DestroyContState +subroutine BD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(BD_ContinuousStateType), intent(in) :: SrcContStateData + type(BD_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'BD_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcContStateData%q)) then + LB(1:2) = lbound(SrcContStateData%q) + UB(1:2) = ubound(SrcContStateData%q) + if (.not. allocated(DstContStateData%q)) then + allocate(DstContStateData%q(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%q.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstContStateData%q = SrcContStateData%q + else if (allocated(DstContStateData%q)) then + deallocate(DstContStateData%q) + end if + if (allocated(SrcContStateData%dqdt)) then + LB(1:2) = lbound(SrcContStateData%dqdt) + UB(1:2) = ubound(SrcContStateData%dqdt) + if (.not. allocated(DstContStateData%dqdt)) then + allocate(DstContStateData%dqdt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%dqdt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstContStateData%dqdt = SrcContStateData%dqdt + else if (allocated(DstContStateData%dqdt)) then + deallocate(DstContStateData%dqdt) + end if +end subroutine +subroutine BD_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(BD_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BD_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ContStateData%q)) then + deallocate(ContStateData%q) + end if + if (allocated(ContStateData%dqdt)) then + deallocate(ContStateData%dqdt) + end if +end subroutine subroutine BD_PackContState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(BD_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'BD_PackContState' if (Buf%ErrStat >= AbortErrLev) return - ! q call RegPack(Buf, allocated(InData%q)) if (allocated(InData%q)) then call RegPackBounds(Buf, 2, lbound(InData%q), ubound(InData%q)) call RegPack(Buf, InData%q) end if if (RegCheckErr(Buf, RoutineName)) return - ! dqdt call RegPack(Buf, allocated(InData%dqdt)) if (allocated(InData%dqdt)) then call RegPackBounds(Buf, 2, lbound(InData%dqdt), ubound(InData%dqdt)) @@ -1700,7 +1530,6 @@ subroutine BD_UnPackContState(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! q if (allocated(OutData%q)) deallocate(OutData%q) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1715,7 +1544,6 @@ subroutine BD_UnPackContState(Buf, OutData) call RegUnpack(Buf, OutData%q) if (RegCheckErr(Buf, RoutineName)) return end if - ! dqdt if (allocated(OutData%dqdt)) deallocate(OutData%dqdt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1731,49 +1559,36 @@ subroutine BD_UnPackContState(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE BD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BD_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(BD_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%thetaP = SrcDiscStateData%thetaP - DstDiscStateData%thetaPD = SrcDiscStateData%thetaPD - END SUBROUTINE BD_CopyDiscState - SUBROUTINE BD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(BD_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE BD_DestroyDiscState +subroutine BD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(BD_DiscreteStateType), intent(in) :: SrcDiscStateData + type(BD_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BD_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + DstDiscStateData%thetaP = SrcDiscStateData%thetaP + DstDiscStateData%thetaPD = SrcDiscStateData%thetaPD +end subroutine +subroutine BD_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(BD_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BD_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine BD_PackDiscState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(BD_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'BD_PackDiscState' if (Buf%ErrStat >= AbortErrLev) return - ! thetaP call RegPack(Buf, InData%thetaP) if (RegCheckErr(Buf, RoutineName)) return - ! thetaPD call RegPack(Buf, InData%thetaPD) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1783,52 +1598,38 @@ subroutine BD_UnPackDiscState(Buf, OutData) type(BD_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackDiscState' if (Buf%ErrStat /= ErrID_None) return - ! thetaP call RegUnpack(Buf, OutData%thetaP) if (RegCheckErr(Buf, RoutineName)) return - ! thetaPD call RegUnpack(Buf, OutData%thetaPD) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE BD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BD_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(BD_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE BD_CopyConstrState - - SUBROUTINE BD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(BD_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyConstrState' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE BD_DestroyConstrState +subroutine BD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(BD_ConstraintStateType), intent(in) :: SrcConstrStateData + type(BD_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BD_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine +subroutine BD_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(BD_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BD_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine BD_PackConstrState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(BD_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'BD_PackConstrState' if (Buf%ErrStat >= AbortErrLev) return - ! DummyConstrState call RegPack(Buf, InData%DummyConstrState) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1838,103 +1639,87 @@ subroutine BD_UnPackConstrState(Buf, OutData) type(BD_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackConstrState' if (Buf%ErrStat /= ErrID_None) return - ! DummyConstrState call RegUnpack(Buf, OutData%DummyConstrState) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE BD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BD_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(BD_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOtherStateData%acc)) THEN - i1_l = LBOUND(SrcOtherStateData%acc,1) - i1_u = UBOUND(SrcOtherStateData%acc,1) - i2_l = LBOUND(SrcOtherStateData%acc,2) - i2_u = UBOUND(SrcOtherStateData%acc,2) - IF (.NOT. ALLOCATED(DstOtherStateData%acc)) THEN - ALLOCATE(DstOtherStateData%acc(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%acc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%acc = SrcOtherStateData%acc -ENDIF -IF (ALLOCATED(SrcOtherStateData%xcc)) THEN - i1_l = LBOUND(SrcOtherStateData%xcc,1) - i1_u = UBOUND(SrcOtherStateData%xcc,1) - i2_l = LBOUND(SrcOtherStateData%xcc,2) - i2_u = UBOUND(SrcOtherStateData%xcc,2) - IF (.NOT. ALLOCATED(DstOtherStateData%xcc)) THEN - ALLOCATE(DstOtherStateData%xcc(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%xcc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%xcc = SrcOtherStateData%xcc -ENDIF - DstOtherStateData%InitAcc = SrcOtherStateData%InitAcc - DstOtherStateData%RunQuasiStaticInit = SrcOtherStateData%RunQuasiStaticInit - END SUBROUTINE BD_CopyOtherState - - SUBROUTINE BD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(BD_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(OtherStateData%acc)) THEN - DEALLOCATE(OtherStateData%acc) -ENDIF -IF (ALLOCATED(OtherStateData%xcc)) THEN - DEALLOCATE(OtherStateData%xcc) -ENDIF - END SUBROUTINE BD_DestroyOtherState +subroutine BD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(BD_OtherStateType), intent(in) :: SrcOtherStateData + type(BD_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'BD_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOtherStateData%acc)) then + LB(1:2) = lbound(SrcOtherStateData%acc) + UB(1:2) = ubound(SrcOtherStateData%acc) + if (.not. allocated(DstOtherStateData%acc)) then + allocate(DstOtherStateData%acc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%acc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%acc = SrcOtherStateData%acc + else if (allocated(DstOtherStateData%acc)) then + deallocate(DstOtherStateData%acc) + end if + if (allocated(SrcOtherStateData%xcc)) then + LB(1:2) = lbound(SrcOtherStateData%xcc) + UB(1:2) = ubound(SrcOtherStateData%xcc) + if (.not. allocated(DstOtherStateData%xcc)) then + allocate(DstOtherStateData%xcc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%xcc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%xcc = SrcOtherStateData%xcc + else if (allocated(DstOtherStateData%xcc)) then + deallocate(DstOtherStateData%xcc) + end if + DstOtherStateData%InitAcc = SrcOtherStateData%InitAcc + DstOtherStateData%RunQuasiStaticInit = SrcOtherStateData%RunQuasiStaticInit +end subroutine +subroutine BD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(BD_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BD_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OtherStateData%acc)) then + deallocate(OtherStateData%acc) + end if + if (allocated(OtherStateData%xcc)) then + deallocate(OtherStateData%xcc) + end if +end subroutine subroutine BD_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(BD_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'BD_PackOtherState' if (Buf%ErrStat >= AbortErrLev) return - ! acc call RegPack(Buf, allocated(InData%acc)) if (allocated(InData%acc)) then call RegPackBounds(Buf, 2, lbound(InData%acc), ubound(InData%acc)) call RegPack(Buf, InData%acc) end if if (RegCheckErr(Buf, RoutineName)) return - ! xcc call RegPack(Buf, allocated(InData%xcc)) if (allocated(InData%xcc)) then call RegPackBounds(Buf, 2, lbound(InData%xcc), ubound(InData%xcc)) call RegPack(Buf, InData%xcc) end if if (RegCheckErr(Buf, RoutineName)) return - ! InitAcc call RegPack(Buf, InData%InitAcc) if (RegCheckErr(Buf, RoutineName)) return - ! RunQuasiStaticInit call RegPack(Buf, InData%RunQuasiStaticInit) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1947,7 +1732,6 @@ subroutine BD_UnPackOtherState(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! acc if (allocated(OutData%acc)) deallocate(OutData%acc) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1962,7 +1746,6 @@ subroutine BD_UnPackOtherState(Buf, OutData) call RegUnpack(Buf, OutData%acc) if (RegCheckErr(Buf, RoutineName)) return end if - ! xcc if (allocated(OutData%xcc)) deallocate(OutData%xcc) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1977,97 +1760,79 @@ subroutine BD_UnPackOtherState(Buf, OutData) call RegUnpack(Buf, OutData%xcc) if (RegCheckErr(Buf, RoutineName)) return end if - ! InitAcc call RegUnpack(Buf, OutData%InitAcc) if (RegCheckErr(Buf, RoutineName)) return - ! RunQuasiStaticInit call RegUnpack(Buf, OutData%RunQuasiStaticInit) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE BD_CopyqpParam( SrcqpParamData, DstqpParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(qpParam), INTENT(IN) :: SrcqpParamData - TYPE(qpParam), INTENT(INOUT) :: DstqpParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_CopyqpParam' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcqpParamData%mmm)) THEN - i1_l = LBOUND(SrcqpParamData%mmm,1) - i1_u = UBOUND(SrcqpParamData%mmm,1) - i2_l = LBOUND(SrcqpParamData%mmm,2) - i2_u = UBOUND(SrcqpParamData%mmm,2) - IF (.NOT. ALLOCATED(DstqpParamData%mmm)) THEN - ALLOCATE(DstqpParamData%mmm(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstqpParamData%mmm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstqpParamData%mmm = SrcqpParamData%mmm -ENDIF -IF (ALLOCATED(SrcqpParamData%mEta)) THEN - i1_l = LBOUND(SrcqpParamData%mEta,1) - i1_u = UBOUND(SrcqpParamData%mEta,1) - i2_l = LBOUND(SrcqpParamData%mEta,2) - i2_u = UBOUND(SrcqpParamData%mEta,2) - i3_l = LBOUND(SrcqpParamData%mEta,3) - i3_u = UBOUND(SrcqpParamData%mEta,3) - IF (.NOT. ALLOCATED(DstqpParamData%mEta)) THEN - ALLOCATE(DstqpParamData%mEta(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstqpParamData%mEta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstqpParamData%mEta = SrcqpParamData%mEta -ENDIF - END SUBROUTINE BD_CopyqpParam - - SUBROUTINE BD_DestroyqpParam( qpParamData, ErrStat, ErrMsg ) - TYPE(qpParam), INTENT(INOUT) :: qpParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyqpParam' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(qpParamData%mmm)) THEN - DEALLOCATE(qpParamData%mmm) -ENDIF -IF (ALLOCATED(qpParamData%mEta)) THEN - DEALLOCATE(qpParamData%mEta) -ENDIF - END SUBROUTINE BD_DestroyqpParam +subroutine BD_CopyqpParam(SrcqpParamData, DstqpParamData, CtrlCode, ErrStat, ErrMsg) + type(qpParam), intent(in) :: SrcqpParamData + type(qpParam), intent(inout) :: DstqpParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'BD_CopyqpParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcqpParamData%mmm)) then + LB(1:2) = lbound(SrcqpParamData%mmm) + UB(1:2) = ubound(SrcqpParamData%mmm) + if (.not. allocated(DstqpParamData%mmm)) then + allocate(DstqpParamData%mmm(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstqpParamData%mmm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstqpParamData%mmm = SrcqpParamData%mmm + else if (allocated(DstqpParamData%mmm)) then + deallocate(DstqpParamData%mmm) + end if + if (allocated(SrcqpParamData%mEta)) then + LB(1:3) = lbound(SrcqpParamData%mEta) + UB(1:3) = ubound(SrcqpParamData%mEta) + if (.not. allocated(DstqpParamData%mEta)) then + allocate(DstqpParamData%mEta(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstqpParamData%mEta.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstqpParamData%mEta = SrcqpParamData%mEta + else if (allocated(DstqpParamData%mEta)) then + deallocate(DstqpParamData%mEta) + end if +end subroutine +subroutine BD_DestroyqpParam(qpParamData, ErrStat, ErrMsg) + type(qpParam), intent(inout) :: qpParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BD_DestroyqpParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(qpParamData%mmm)) then + deallocate(qpParamData%mmm) + end if + if (allocated(qpParamData%mEta)) then + deallocate(qpParamData%mEta) + end if +end subroutine subroutine BD_PackqpParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(qpParam), intent(in) :: InData character(*), parameter :: RoutineName = 'BD_PackqpParam' if (Buf%ErrStat >= AbortErrLev) return - ! mmm call RegPack(Buf, allocated(InData%mmm)) if (allocated(InData%mmm)) then call RegPackBounds(Buf, 2, lbound(InData%mmm), ubound(InData%mmm)) call RegPack(Buf, InData%mmm) end if if (RegCheckErr(Buf, RoutineName)) return - ! mEta call RegPack(Buf, allocated(InData%mEta)) if (allocated(InData%mEta)) then call RegPackBounds(Buf, 3, lbound(InData%mEta), ubound(InData%mEta)) @@ -2084,7 +1849,6 @@ subroutine BD_UnPackqpParam(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! mmm if (allocated(OutData%mmm)) deallocate(OutData%mmm) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2099,7 +1863,6 @@ subroutine BD_UnPackqpParam(Buf, OutData) call RegUnpack(Buf, OutData%mmm) if (RegCheckErr(Buf, RoutineName)) return end if - ! mEta if (allocated(OutData%mEta)) deallocate(OutData%mEta) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2115,593 +1878,584 @@ subroutine BD_UnPackqpParam(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE BD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BD_ParameterType), INTENT(IN) :: SrcParamData - TYPE(BD_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%dt = SrcParamData%dt - DstParamData%coef = SrcParamData%coef - DstParamData%rhoinf = SrcParamData%rhoinf -IF (ALLOCATED(SrcParamData%uuN0)) THEN - i1_l = LBOUND(SrcParamData%uuN0,1) - i1_u = UBOUND(SrcParamData%uuN0,1) - i2_l = LBOUND(SrcParamData%uuN0,2) - i2_u = UBOUND(SrcParamData%uuN0,2) - i3_l = LBOUND(SrcParamData%uuN0,3) - i3_u = UBOUND(SrcParamData%uuN0,3) - IF (.NOT. ALLOCATED(DstParamData%uuN0)) THEN - ALLOCATE(DstParamData%uuN0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uuN0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%uuN0 = SrcParamData%uuN0 -ENDIF -IF (ALLOCATED(SrcParamData%Stif0_QP)) THEN - i1_l = LBOUND(SrcParamData%Stif0_QP,1) - i1_u = UBOUND(SrcParamData%Stif0_QP,1) - i2_l = LBOUND(SrcParamData%Stif0_QP,2) - i2_u = UBOUND(SrcParamData%Stif0_QP,2) - i3_l = LBOUND(SrcParamData%Stif0_QP,3) - i3_u = UBOUND(SrcParamData%Stif0_QP,3) - IF (.NOT. ALLOCATED(DstParamData%Stif0_QP)) THEN - ALLOCATE(DstParamData%Stif0_QP(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Stif0_QP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Stif0_QP = SrcParamData%Stif0_QP -ENDIF -IF (ALLOCATED(SrcParamData%Mass0_QP)) THEN - i1_l = LBOUND(SrcParamData%Mass0_QP,1) - i1_u = UBOUND(SrcParamData%Mass0_QP,1) - i2_l = LBOUND(SrcParamData%Mass0_QP,2) - i2_u = UBOUND(SrcParamData%Mass0_QP,2) - i3_l = LBOUND(SrcParamData%Mass0_QP,3) - i3_u = UBOUND(SrcParamData%Mass0_QP,3) - IF (.NOT. ALLOCATED(DstParamData%Mass0_QP)) THEN - ALLOCATE(DstParamData%Mass0_QP(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Mass0_QP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Mass0_QP = SrcParamData%Mass0_QP -ENDIF - DstParamData%gravity = SrcParamData%gravity -IF (ALLOCATED(SrcParamData%segment_eta)) THEN - i1_l = LBOUND(SrcParamData%segment_eta,1) - i1_u = UBOUND(SrcParamData%segment_eta,1) - IF (.NOT. ALLOCATED(DstParamData%segment_eta)) THEN - ALLOCATE(DstParamData%segment_eta(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%segment_eta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%segment_eta = SrcParamData%segment_eta -ENDIF -IF (ALLOCATED(SrcParamData%member_eta)) THEN - i1_l = LBOUND(SrcParamData%member_eta,1) - i1_u = UBOUND(SrcParamData%member_eta,1) - IF (.NOT. ALLOCATED(DstParamData%member_eta)) THEN - ALLOCATE(DstParamData%member_eta(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%member_eta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%member_eta = SrcParamData%member_eta -ENDIF - DstParamData%blade_length = SrcParamData%blade_length - DstParamData%blade_mass = SrcParamData%blade_mass - DstParamData%blade_CG = SrcParamData%blade_CG - DstParamData%blade_IN = SrcParamData%blade_IN - DstParamData%beta = SrcParamData%beta - DstParamData%tol = SrcParamData%tol - DstParamData%GlbPos = SrcParamData%GlbPos - DstParamData%GlbRot = SrcParamData%GlbRot - DstParamData%Glb_crv = SrcParamData%Glb_crv -IF (ALLOCATED(SrcParamData%QPtN)) THEN - i1_l = LBOUND(SrcParamData%QPtN,1) - i1_u = UBOUND(SrcParamData%QPtN,1) - IF (.NOT. ALLOCATED(DstParamData%QPtN)) THEN - ALLOCATE(DstParamData%QPtN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%QPtN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%QPtN = SrcParamData%QPtN -ENDIF -IF (ALLOCATED(SrcParamData%QPtWeight)) THEN - i1_l = LBOUND(SrcParamData%QPtWeight,1) - i1_u = UBOUND(SrcParamData%QPtWeight,1) - IF (.NOT. ALLOCATED(DstParamData%QPtWeight)) THEN - ALLOCATE(DstParamData%QPtWeight(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%QPtWeight.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%QPtWeight = SrcParamData%QPtWeight -ENDIF -IF (ALLOCATED(SrcParamData%Shp)) THEN - i1_l = LBOUND(SrcParamData%Shp,1) - i1_u = UBOUND(SrcParamData%Shp,1) - i2_l = LBOUND(SrcParamData%Shp,2) - i2_u = UBOUND(SrcParamData%Shp,2) - IF (.NOT. ALLOCATED(DstParamData%Shp)) THEN - ALLOCATE(DstParamData%Shp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Shp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Shp = SrcParamData%Shp -ENDIF -IF (ALLOCATED(SrcParamData%ShpDer)) THEN - i1_l = LBOUND(SrcParamData%ShpDer,1) - i1_u = UBOUND(SrcParamData%ShpDer,1) - i2_l = LBOUND(SrcParamData%ShpDer,2) - i2_u = UBOUND(SrcParamData%ShpDer,2) - IF (.NOT. ALLOCATED(DstParamData%ShpDer)) THEN - ALLOCATE(DstParamData%ShpDer(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ShpDer.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ShpDer = SrcParamData%ShpDer -ENDIF -IF (ALLOCATED(SrcParamData%Jacobian)) THEN - i1_l = LBOUND(SrcParamData%Jacobian,1) - i1_u = UBOUND(SrcParamData%Jacobian,1) - i2_l = LBOUND(SrcParamData%Jacobian,2) - i2_u = UBOUND(SrcParamData%Jacobian,2) - IF (.NOT. ALLOCATED(DstParamData%Jacobian)) THEN - ALLOCATE(DstParamData%Jacobian(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jacobian.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jacobian = SrcParamData%Jacobian -ENDIF -IF (ALLOCATED(SrcParamData%uu0)) THEN - i1_l = LBOUND(SrcParamData%uu0,1) - i1_u = UBOUND(SrcParamData%uu0,1) - i2_l = LBOUND(SrcParamData%uu0,2) - i2_u = UBOUND(SrcParamData%uu0,2) - i3_l = LBOUND(SrcParamData%uu0,3) - i3_u = UBOUND(SrcParamData%uu0,3) - IF (.NOT. ALLOCATED(DstParamData%uu0)) THEN - ALLOCATE(DstParamData%uu0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uu0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%uu0 = SrcParamData%uu0 -ENDIF -IF (ALLOCATED(SrcParamData%rrN0)) THEN - i1_l = LBOUND(SrcParamData%rrN0,1) - i1_u = UBOUND(SrcParamData%rrN0,1) - i2_l = LBOUND(SrcParamData%rrN0,2) - i2_u = UBOUND(SrcParamData%rrN0,2) - i3_l = LBOUND(SrcParamData%rrN0,3) - i3_u = UBOUND(SrcParamData%rrN0,3) - IF (.NOT. ALLOCATED(DstParamData%rrN0)) THEN - ALLOCATE(DstParamData%rrN0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rrN0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%rrN0 = SrcParamData%rrN0 -ENDIF -IF (ALLOCATED(SrcParamData%E10)) THEN - i1_l = LBOUND(SrcParamData%E10,1) - i1_u = UBOUND(SrcParamData%E10,1) - i2_l = LBOUND(SrcParamData%E10,2) - i2_u = UBOUND(SrcParamData%E10,2) - i3_l = LBOUND(SrcParamData%E10,3) - i3_u = UBOUND(SrcParamData%E10,3) - IF (.NOT. ALLOCATED(DstParamData%E10)) THEN - ALLOCATE(DstParamData%E10(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%E10.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%E10 = SrcParamData%E10 -ENDIF - DstParamData%nodes_per_elem = SrcParamData%nodes_per_elem -IF (ALLOCATED(SrcParamData%node_elem_idx)) THEN - i1_l = LBOUND(SrcParamData%node_elem_idx,1) - i1_u = UBOUND(SrcParamData%node_elem_idx,1) - i2_l = LBOUND(SrcParamData%node_elem_idx,2) - i2_u = UBOUND(SrcParamData%node_elem_idx,2) - IF (.NOT. ALLOCATED(DstParamData%node_elem_idx)) THEN - ALLOCATE(DstParamData%node_elem_idx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%node_elem_idx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%node_elem_idx = SrcParamData%node_elem_idx -ENDIF - DstParamData%refine = SrcParamData%refine - DstParamData%dof_node = SrcParamData%dof_node - DstParamData%dof_elem = SrcParamData%dof_elem - DstParamData%rot_elem = SrcParamData%rot_elem - DstParamData%elem_total = SrcParamData%elem_total - DstParamData%node_total = SrcParamData%node_total - DstParamData%dof_total = SrcParamData%dof_total - DstParamData%nqp = SrcParamData%nqp - DstParamData%analysis_type = SrcParamData%analysis_type - DstParamData%damp_flag = SrcParamData%damp_flag - DstParamData%ld_retries = SrcParamData%ld_retries - DstParamData%niter = SrcParamData%niter - DstParamData%quadrature = SrcParamData%quadrature - DstParamData%n_fact = SrcParamData%n_fact - DstParamData%OutInputs = SrcParamData%OutInputs - DstParamData%NumOuts = SrcParamData%NumOuts -IF (ALLOCATED(SrcParamData%OutParam)) THEN - i1_l = LBOUND(SrcParamData%OutParam,1) - i1_u = UBOUND(SrcParamData%OutParam,1) - IF (.NOT. ALLOCATED(DstParamData%OutParam)) THEN - ALLOCATE(DstParamData%OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%OutParam,1), UBOUND(SrcParamData%OutParam,1) - CALL NWTC_Library_Copyoutparmtype( SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstParamData%NNodeOuts = SrcParamData%NNodeOuts - DstParamData%OutNd = SrcParamData%OutNd -IF (ALLOCATED(SrcParamData%NdIndx)) THEN - i1_l = LBOUND(SrcParamData%NdIndx,1) - i1_u = UBOUND(SrcParamData%NdIndx,1) - IF (.NOT. ALLOCATED(DstParamData%NdIndx)) THEN - ALLOCATE(DstParamData%NdIndx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NdIndx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%NdIndx = SrcParamData%NdIndx -ENDIF -IF (ALLOCATED(SrcParamData%NdIndxInverse)) THEN - i1_l = LBOUND(SrcParamData%NdIndxInverse,1) - i1_u = UBOUND(SrcParamData%NdIndxInverse,1) - IF (.NOT. ALLOCATED(DstParamData%NdIndxInverse)) THEN - ALLOCATE(DstParamData%NdIndxInverse(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NdIndxInverse.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%NdIndxInverse = SrcParamData%NdIndxInverse -ENDIF -IF (ALLOCATED(SrcParamData%OutNd2NdElem)) THEN - i1_l = LBOUND(SrcParamData%OutNd2NdElem,1) - i1_u = UBOUND(SrcParamData%OutNd2NdElem,1) - i2_l = LBOUND(SrcParamData%OutNd2NdElem,2) - i2_u = UBOUND(SrcParamData%OutNd2NdElem,2) - IF (.NOT. ALLOCATED(DstParamData%OutNd2NdElem)) THEN - ALLOCATE(DstParamData%OutNd2NdElem(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutNd2NdElem.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%OutNd2NdElem = SrcParamData%OutNd2NdElem -ENDIF - DstParamData%OutFmt = SrcParamData%OutFmt - DstParamData%UsePitchAct = SrcParamData%UsePitchAct - DstParamData%pitchJ = SrcParamData%pitchJ - DstParamData%pitchK = SrcParamData%pitchK - DstParamData%pitchC = SrcParamData%pitchC - DstParamData%torqM = SrcParamData%torqM - CALL BD_Copyqpparam( SrcParamData%qp, DstParamData%qp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstParamData%qp_indx_offset = SrcParamData%qp_indx_offset - DstParamData%BldMotionNodeLoc = SrcParamData%BldMotionNodeLoc - DstParamData%tngt_stf_fd = SrcParamData%tngt_stf_fd - DstParamData%tngt_stf_comp = SrcParamData%tngt_stf_comp - DstParamData%tngt_stf_pert = SrcParamData%tngt_stf_pert - DstParamData%tngt_stf_difftol = SrcParamData%tngt_stf_difftol - DstParamData%BldNd_NumOuts = SrcParamData%BldNd_NumOuts - DstParamData%BldNd_TotNumOuts = SrcParamData%BldNd_TotNumOuts -IF (ALLOCATED(SrcParamData%BldNd_OutParam)) THEN - i1_l = LBOUND(SrcParamData%BldNd_OutParam,1) - i1_u = UBOUND(SrcParamData%BldNd_OutParam,1) - IF (.NOT. ALLOCATED(DstParamData%BldNd_OutParam)) THEN - ALLOCATE(DstParamData%BldNd_OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldNd_OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%BldNd_OutParam,1), UBOUND(SrcParamData%BldNd_OutParam,1) - CALL NWTC_Library_Copyoutparmtype( SrcParamData%BldNd_OutParam(i1), DstParamData%BldNd_OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%BldNd_BlOutNd)) THEN - i1_l = LBOUND(SrcParamData%BldNd_BlOutNd,1) - i1_u = UBOUND(SrcParamData%BldNd_BlOutNd,1) - IF (.NOT. ALLOCATED(DstParamData%BldNd_BlOutNd)) THEN - ALLOCATE(DstParamData%BldNd_BlOutNd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldNd_BlOutNd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BldNd_BlOutNd = SrcParamData%BldNd_BlOutNd -ENDIF -IF (ALLOCATED(SrcParamData%QPtw_Shp_Shp_Jac)) THEN - i1_l = LBOUND(SrcParamData%QPtw_Shp_Shp_Jac,1) - i1_u = UBOUND(SrcParamData%QPtw_Shp_Shp_Jac,1) - i2_l = LBOUND(SrcParamData%QPtw_Shp_Shp_Jac,2) - i2_u = UBOUND(SrcParamData%QPtw_Shp_Shp_Jac,2) - i3_l = LBOUND(SrcParamData%QPtw_Shp_Shp_Jac,3) - i3_u = UBOUND(SrcParamData%QPtw_Shp_Shp_Jac,3) - i4_l = LBOUND(SrcParamData%QPtw_Shp_Shp_Jac,4) - i4_u = UBOUND(SrcParamData%QPtw_Shp_Shp_Jac,4) - IF (.NOT. ALLOCATED(DstParamData%QPtw_Shp_Shp_Jac)) THEN - ALLOCATE(DstParamData%QPtw_Shp_Shp_Jac(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%QPtw_Shp_Shp_Jac.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%QPtw_Shp_Shp_Jac = SrcParamData%QPtw_Shp_Shp_Jac -ENDIF -IF (ALLOCATED(SrcParamData%QPtw_Shp_ShpDer)) THEN - i1_l = LBOUND(SrcParamData%QPtw_Shp_ShpDer,1) - i1_u = UBOUND(SrcParamData%QPtw_Shp_ShpDer,1) - i2_l = LBOUND(SrcParamData%QPtw_Shp_ShpDer,2) - i2_u = UBOUND(SrcParamData%QPtw_Shp_ShpDer,2) - i3_l = LBOUND(SrcParamData%QPtw_Shp_ShpDer,3) - i3_u = UBOUND(SrcParamData%QPtw_Shp_ShpDer,3) - IF (.NOT. ALLOCATED(DstParamData%QPtw_Shp_ShpDer)) THEN - ALLOCATE(DstParamData%QPtw_Shp_ShpDer(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%QPtw_Shp_ShpDer.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%QPtw_Shp_ShpDer = SrcParamData%QPtw_Shp_ShpDer -ENDIF -IF (ALLOCATED(SrcParamData%QPtw_ShpDer_ShpDer_Jac)) THEN - i1_l = LBOUND(SrcParamData%QPtw_ShpDer_ShpDer_Jac,1) - i1_u = UBOUND(SrcParamData%QPtw_ShpDer_ShpDer_Jac,1) - i2_l = LBOUND(SrcParamData%QPtw_ShpDer_ShpDer_Jac,2) - i2_u = UBOUND(SrcParamData%QPtw_ShpDer_ShpDer_Jac,2) - i3_l = LBOUND(SrcParamData%QPtw_ShpDer_ShpDer_Jac,3) - i3_u = UBOUND(SrcParamData%QPtw_ShpDer_ShpDer_Jac,3) - i4_l = LBOUND(SrcParamData%QPtw_ShpDer_ShpDer_Jac,4) - i4_u = UBOUND(SrcParamData%QPtw_ShpDer_ShpDer_Jac,4) - IF (.NOT. ALLOCATED(DstParamData%QPtw_ShpDer_ShpDer_Jac)) THEN - ALLOCATE(DstParamData%QPtw_ShpDer_ShpDer_Jac(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%QPtw_ShpDer_ShpDer_Jac.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%QPtw_ShpDer_ShpDer_Jac = SrcParamData%QPtw_ShpDer_ShpDer_Jac -ENDIF -IF (ALLOCATED(SrcParamData%QPtw_Shp_Jac)) THEN - i1_l = LBOUND(SrcParamData%QPtw_Shp_Jac,1) - i1_u = UBOUND(SrcParamData%QPtw_Shp_Jac,1) - i2_l = LBOUND(SrcParamData%QPtw_Shp_Jac,2) - i2_u = UBOUND(SrcParamData%QPtw_Shp_Jac,2) - i3_l = LBOUND(SrcParamData%QPtw_Shp_Jac,3) - i3_u = UBOUND(SrcParamData%QPtw_Shp_Jac,3) - IF (.NOT. ALLOCATED(DstParamData%QPtw_Shp_Jac)) THEN - ALLOCATE(DstParamData%QPtw_Shp_Jac(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%QPtw_Shp_Jac.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%QPtw_Shp_Jac = SrcParamData%QPtw_Shp_Jac -ENDIF -IF (ALLOCATED(SrcParamData%QPtw_ShpDer)) THEN - i1_l = LBOUND(SrcParamData%QPtw_ShpDer,1) - i1_u = UBOUND(SrcParamData%QPtw_ShpDer,1) - i2_l = LBOUND(SrcParamData%QPtw_ShpDer,2) - i2_u = UBOUND(SrcParamData%QPtw_ShpDer,2) - IF (.NOT. ALLOCATED(DstParamData%QPtw_ShpDer)) THEN - ALLOCATE(DstParamData%QPtw_ShpDer(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%QPtw_ShpDer.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%QPtw_ShpDer = SrcParamData%QPtw_ShpDer -ENDIF -IF (ALLOCATED(SrcParamData%FEweight)) THEN - i1_l = LBOUND(SrcParamData%FEweight,1) - i1_u = UBOUND(SrcParamData%FEweight,1) - i2_l = LBOUND(SrcParamData%FEweight,2) - i2_u = UBOUND(SrcParamData%FEweight,2) - IF (.NOT. ALLOCATED(DstParamData%FEweight)) THEN - ALLOCATE(DstParamData%FEweight(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FEweight.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FEweight = SrcParamData%FEweight -ENDIF -IF (ALLOCATED(SrcParamData%Jac_u_indx)) THEN - i1_l = LBOUND(SrcParamData%Jac_u_indx,1) - i1_u = UBOUND(SrcParamData%Jac_u_indx,1) - i2_l = LBOUND(SrcParamData%Jac_u_indx,2) - i2_u = UBOUND(SrcParamData%Jac_u_indx,2) - IF (.NOT. ALLOCATED(DstParamData%Jac_u_indx)) THEN - ALLOCATE(DstParamData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx -ENDIF -IF (ALLOCATED(SrcParamData%du)) THEN - i1_l = LBOUND(SrcParamData%du,1) - i1_u = UBOUND(SrcParamData%du,1) - IF (.NOT. ALLOCATED(DstParamData%du)) THEN - ALLOCATE(DstParamData%du(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%du = SrcParamData%du -ENDIF - DstParamData%dx = SrcParamData%dx - DstParamData%Jac_ny = SrcParamData%Jac_ny - DstParamData%Jac_nx = SrcParamData%Jac_nx - DstParamData%RotStates = SrcParamData%RotStates - DstParamData%RelStates = SrcParamData%RelStates - END SUBROUTINE BD_CopyParam - SUBROUTINE BD_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(BD_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%uuN0)) THEN - DEALLOCATE(ParamData%uuN0) -ENDIF -IF (ALLOCATED(ParamData%Stif0_QP)) THEN - DEALLOCATE(ParamData%Stif0_QP) -ENDIF -IF (ALLOCATED(ParamData%Mass0_QP)) THEN - DEALLOCATE(ParamData%Mass0_QP) -ENDIF -IF (ALLOCATED(ParamData%segment_eta)) THEN - DEALLOCATE(ParamData%segment_eta) -ENDIF -IF (ALLOCATED(ParamData%member_eta)) THEN - DEALLOCATE(ParamData%member_eta) -ENDIF -IF (ALLOCATED(ParamData%QPtN)) THEN - DEALLOCATE(ParamData%QPtN) -ENDIF -IF (ALLOCATED(ParamData%QPtWeight)) THEN - DEALLOCATE(ParamData%QPtWeight) -ENDIF -IF (ALLOCATED(ParamData%Shp)) THEN - DEALLOCATE(ParamData%Shp) -ENDIF -IF (ALLOCATED(ParamData%ShpDer)) THEN - DEALLOCATE(ParamData%ShpDer) -ENDIF -IF (ALLOCATED(ParamData%Jacobian)) THEN - DEALLOCATE(ParamData%Jacobian) -ENDIF -IF (ALLOCATED(ParamData%uu0)) THEN - DEALLOCATE(ParamData%uu0) -ENDIF -IF (ALLOCATED(ParamData%rrN0)) THEN - DEALLOCATE(ParamData%rrN0) -ENDIF -IF (ALLOCATED(ParamData%E10)) THEN - DEALLOCATE(ParamData%E10) -ENDIF -IF (ALLOCATED(ParamData%node_elem_idx)) THEN - DEALLOCATE(ParamData%node_elem_idx) -ENDIF -IF (ALLOCATED(ParamData%OutParam)) THEN -DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_DestroyOutParmType( ParamData%OutParam(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%OutParam) -ENDIF -IF (ALLOCATED(ParamData%NdIndx)) THEN - DEALLOCATE(ParamData%NdIndx) -ENDIF -IF (ALLOCATED(ParamData%NdIndxInverse)) THEN - DEALLOCATE(ParamData%NdIndxInverse) -ENDIF -IF (ALLOCATED(ParamData%OutNd2NdElem)) THEN - DEALLOCATE(ParamData%OutNd2NdElem) -ENDIF - CALL BD_DestroyqpParam( ParamData%qp, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ParamData%BldNd_OutParam)) THEN -DO i1 = LBOUND(ParamData%BldNd_OutParam,1), UBOUND(ParamData%BldNd_OutParam,1) - CALL NWTC_Library_DestroyOutParmType( ParamData%BldNd_OutParam(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%BldNd_OutParam) -ENDIF -IF (ALLOCATED(ParamData%BldNd_BlOutNd)) THEN - DEALLOCATE(ParamData%BldNd_BlOutNd) -ENDIF -IF (ALLOCATED(ParamData%QPtw_Shp_Shp_Jac)) THEN - DEALLOCATE(ParamData%QPtw_Shp_Shp_Jac) -ENDIF -IF (ALLOCATED(ParamData%QPtw_Shp_ShpDer)) THEN - DEALLOCATE(ParamData%QPtw_Shp_ShpDer) -ENDIF -IF (ALLOCATED(ParamData%QPtw_ShpDer_ShpDer_Jac)) THEN - DEALLOCATE(ParamData%QPtw_ShpDer_ShpDer_Jac) -ENDIF -IF (ALLOCATED(ParamData%QPtw_Shp_Jac)) THEN - DEALLOCATE(ParamData%QPtw_Shp_Jac) -ENDIF -IF (ALLOCATED(ParamData%QPtw_ShpDer)) THEN - DEALLOCATE(ParamData%QPtw_ShpDer) -ENDIF -IF (ALLOCATED(ParamData%FEweight)) THEN - DEALLOCATE(ParamData%FEweight) -ENDIF -IF (ALLOCATED(ParamData%Jac_u_indx)) THEN - DEALLOCATE(ParamData%Jac_u_indx) -ENDIF -IF (ALLOCATED(ParamData%du)) THEN - DEALLOCATE(ParamData%du) -ENDIF - END SUBROUTINE BD_DestroyParam +subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(BD_ParameterType), intent(in) :: SrcParamData + type(BD_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3, i4 + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BD_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%dt = SrcParamData%dt + DstParamData%coef = SrcParamData%coef + DstParamData%rhoinf = SrcParamData%rhoinf + if (allocated(SrcParamData%uuN0)) then + LB(1:3) = lbound(SrcParamData%uuN0) + UB(1:3) = ubound(SrcParamData%uuN0) + if (.not. allocated(DstParamData%uuN0)) then + allocate(DstParamData%uuN0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uuN0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%uuN0 = SrcParamData%uuN0 + else if (allocated(DstParamData%uuN0)) then + deallocate(DstParamData%uuN0) + end if + if (allocated(SrcParamData%Stif0_QP)) then + LB(1:3) = lbound(SrcParamData%Stif0_QP) + UB(1:3) = ubound(SrcParamData%Stif0_QP) + if (.not. allocated(DstParamData%Stif0_QP)) then + allocate(DstParamData%Stif0_QP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Stif0_QP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Stif0_QP = SrcParamData%Stif0_QP + else if (allocated(DstParamData%Stif0_QP)) then + deallocate(DstParamData%Stif0_QP) + end if + if (allocated(SrcParamData%Mass0_QP)) then + LB(1:3) = lbound(SrcParamData%Mass0_QP) + UB(1:3) = ubound(SrcParamData%Mass0_QP) + if (.not. allocated(DstParamData%Mass0_QP)) then + allocate(DstParamData%Mass0_QP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Mass0_QP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Mass0_QP = SrcParamData%Mass0_QP + else if (allocated(DstParamData%Mass0_QP)) then + deallocate(DstParamData%Mass0_QP) + end if + DstParamData%gravity = SrcParamData%gravity + if (allocated(SrcParamData%segment_eta)) then + LB(1:1) = lbound(SrcParamData%segment_eta) + UB(1:1) = ubound(SrcParamData%segment_eta) + if (.not. allocated(DstParamData%segment_eta)) then + allocate(DstParamData%segment_eta(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%segment_eta.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%segment_eta = SrcParamData%segment_eta + else if (allocated(DstParamData%segment_eta)) then + deallocate(DstParamData%segment_eta) + end if + if (allocated(SrcParamData%member_eta)) then + LB(1:1) = lbound(SrcParamData%member_eta) + UB(1:1) = ubound(SrcParamData%member_eta) + if (.not. allocated(DstParamData%member_eta)) then + allocate(DstParamData%member_eta(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%member_eta.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%member_eta = SrcParamData%member_eta + else if (allocated(DstParamData%member_eta)) then + deallocate(DstParamData%member_eta) + end if + DstParamData%blade_length = SrcParamData%blade_length + DstParamData%blade_mass = SrcParamData%blade_mass + DstParamData%blade_CG = SrcParamData%blade_CG + DstParamData%blade_IN = SrcParamData%blade_IN + DstParamData%beta = SrcParamData%beta + DstParamData%tol = SrcParamData%tol + DstParamData%GlbPos = SrcParamData%GlbPos + DstParamData%GlbRot = SrcParamData%GlbRot + DstParamData%Glb_crv = SrcParamData%Glb_crv + if (allocated(SrcParamData%QPtN)) then + LB(1:1) = lbound(SrcParamData%QPtN) + UB(1:1) = ubound(SrcParamData%QPtN) + if (.not. allocated(DstParamData%QPtN)) then + allocate(DstParamData%QPtN(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%QPtN.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%QPtN = SrcParamData%QPtN + else if (allocated(DstParamData%QPtN)) then + deallocate(DstParamData%QPtN) + end if + if (allocated(SrcParamData%QPtWeight)) then + LB(1:1) = lbound(SrcParamData%QPtWeight) + UB(1:1) = ubound(SrcParamData%QPtWeight) + if (.not. allocated(DstParamData%QPtWeight)) then + allocate(DstParamData%QPtWeight(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%QPtWeight.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%QPtWeight = SrcParamData%QPtWeight + else if (allocated(DstParamData%QPtWeight)) then + deallocate(DstParamData%QPtWeight) + end if + if (allocated(SrcParamData%Shp)) then + LB(1:2) = lbound(SrcParamData%Shp) + UB(1:2) = ubound(SrcParamData%Shp) + if (.not. allocated(DstParamData%Shp)) then + allocate(DstParamData%Shp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Shp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Shp = SrcParamData%Shp + else if (allocated(DstParamData%Shp)) then + deallocate(DstParamData%Shp) + end if + if (allocated(SrcParamData%ShpDer)) then + LB(1:2) = lbound(SrcParamData%ShpDer) + UB(1:2) = ubound(SrcParamData%ShpDer) + if (.not. allocated(DstParamData%ShpDer)) then + allocate(DstParamData%ShpDer(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ShpDer.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%ShpDer = SrcParamData%ShpDer + else if (allocated(DstParamData%ShpDer)) then + deallocate(DstParamData%ShpDer) + end if + if (allocated(SrcParamData%Jacobian)) then + LB(1:2) = lbound(SrcParamData%Jacobian) + UB(1:2) = ubound(SrcParamData%Jacobian) + if (.not. allocated(DstParamData%Jacobian)) then + allocate(DstParamData%Jacobian(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jacobian.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jacobian = SrcParamData%Jacobian + else if (allocated(DstParamData%Jacobian)) then + deallocate(DstParamData%Jacobian) + end if + if (allocated(SrcParamData%uu0)) then + LB(1:3) = lbound(SrcParamData%uu0) + UB(1:3) = ubound(SrcParamData%uu0) + if (.not. allocated(DstParamData%uu0)) then + allocate(DstParamData%uu0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uu0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%uu0 = SrcParamData%uu0 + else if (allocated(DstParamData%uu0)) then + deallocate(DstParamData%uu0) + end if + if (allocated(SrcParamData%rrN0)) then + LB(1:3) = lbound(SrcParamData%rrN0) + UB(1:3) = ubound(SrcParamData%rrN0) + if (.not. allocated(DstParamData%rrN0)) then + allocate(DstParamData%rrN0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rrN0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%rrN0 = SrcParamData%rrN0 + else if (allocated(DstParamData%rrN0)) then + deallocate(DstParamData%rrN0) + end if + if (allocated(SrcParamData%E10)) then + LB(1:3) = lbound(SrcParamData%E10) + UB(1:3) = ubound(SrcParamData%E10) + if (.not. allocated(DstParamData%E10)) then + allocate(DstParamData%E10(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%E10.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%E10 = SrcParamData%E10 + else if (allocated(DstParamData%E10)) then + deallocate(DstParamData%E10) + end if + DstParamData%nodes_per_elem = SrcParamData%nodes_per_elem + if (allocated(SrcParamData%node_elem_idx)) then + LB(1:2) = lbound(SrcParamData%node_elem_idx) + UB(1:2) = ubound(SrcParamData%node_elem_idx) + if (.not. allocated(DstParamData%node_elem_idx)) then + allocate(DstParamData%node_elem_idx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%node_elem_idx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%node_elem_idx = SrcParamData%node_elem_idx + else if (allocated(DstParamData%node_elem_idx)) then + deallocate(DstParamData%node_elem_idx) + end if + DstParamData%refine = SrcParamData%refine + DstParamData%dof_node = SrcParamData%dof_node + DstParamData%dof_elem = SrcParamData%dof_elem + DstParamData%rot_elem = SrcParamData%rot_elem + DstParamData%elem_total = SrcParamData%elem_total + DstParamData%node_total = SrcParamData%node_total + DstParamData%dof_total = SrcParamData%dof_total + DstParamData%nqp = SrcParamData%nqp + DstParamData%analysis_type = SrcParamData%analysis_type + DstParamData%damp_flag = SrcParamData%damp_flag + DstParamData%ld_retries = SrcParamData%ld_retries + DstParamData%niter = SrcParamData%niter + DstParamData%quadrature = SrcParamData%quadrature + DstParamData%n_fact = SrcParamData%n_fact + DstParamData%OutInputs = SrcParamData%OutInputs + DstParamData%NumOuts = SrcParamData%NumOuts + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstParamData%OutParam)) then + deallocate(DstParamData%OutParam) + end if + DstParamData%NNodeOuts = SrcParamData%NNodeOuts + DstParamData%OutNd = SrcParamData%OutNd + if (allocated(SrcParamData%NdIndx)) then + LB(1:1) = lbound(SrcParamData%NdIndx) + UB(1:1) = ubound(SrcParamData%NdIndx) + if (.not. allocated(DstParamData%NdIndx)) then + allocate(DstParamData%NdIndx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NdIndx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%NdIndx = SrcParamData%NdIndx + else if (allocated(DstParamData%NdIndx)) then + deallocate(DstParamData%NdIndx) + end if + if (allocated(SrcParamData%NdIndxInverse)) then + LB(1:1) = lbound(SrcParamData%NdIndxInverse) + UB(1:1) = ubound(SrcParamData%NdIndxInverse) + if (.not. allocated(DstParamData%NdIndxInverse)) then + allocate(DstParamData%NdIndxInverse(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NdIndxInverse.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%NdIndxInverse = SrcParamData%NdIndxInverse + else if (allocated(DstParamData%NdIndxInverse)) then + deallocate(DstParamData%NdIndxInverse) + end if + if (allocated(SrcParamData%OutNd2NdElem)) then + LB(1:2) = lbound(SrcParamData%OutNd2NdElem) + UB(1:2) = ubound(SrcParamData%OutNd2NdElem) + if (.not. allocated(DstParamData%OutNd2NdElem)) then + allocate(DstParamData%OutNd2NdElem(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutNd2NdElem.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%OutNd2NdElem = SrcParamData%OutNd2NdElem + else if (allocated(DstParamData%OutNd2NdElem)) then + deallocate(DstParamData%OutNd2NdElem) + end if + DstParamData%OutFmt = SrcParamData%OutFmt + DstParamData%UsePitchAct = SrcParamData%UsePitchAct + DstParamData%pitchJ = SrcParamData%pitchJ + DstParamData%pitchK = SrcParamData%pitchK + DstParamData%pitchC = SrcParamData%pitchC + DstParamData%torqM = SrcParamData%torqM + call BD_CopyqpParam(SrcParamData%qp, DstParamData%qp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstParamData%qp_indx_offset = SrcParamData%qp_indx_offset + DstParamData%BldMotionNodeLoc = SrcParamData%BldMotionNodeLoc + DstParamData%tngt_stf_fd = SrcParamData%tngt_stf_fd + DstParamData%tngt_stf_comp = SrcParamData%tngt_stf_comp + DstParamData%tngt_stf_pert = SrcParamData%tngt_stf_pert + DstParamData%tngt_stf_difftol = SrcParamData%tngt_stf_difftol + DstParamData%BldNd_NumOuts = SrcParamData%BldNd_NumOuts + DstParamData%BldNd_TotNumOuts = SrcParamData%BldNd_TotNumOuts + if (allocated(SrcParamData%BldNd_OutParam)) then + LB(1:1) = lbound(SrcParamData%BldNd_OutParam) + UB(1:1) = ubound(SrcParamData%BldNd_OutParam) + if (.not. allocated(DstParamData%BldNd_OutParam)) then + allocate(DstParamData%BldNd_OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldNd_OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcParamData%BldNd_OutParam(i1), DstParamData%BldNd_OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstParamData%BldNd_OutParam)) then + deallocate(DstParamData%BldNd_OutParam) + end if + if (allocated(SrcParamData%BldNd_BlOutNd)) then + LB(1:1) = lbound(SrcParamData%BldNd_BlOutNd) + UB(1:1) = ubound(SrcParamData%BldNd_BlOutNd) + if (.not. allocated(DstParamData%BldNd_BlOutNd)) then + allocate(DstParamData%BldNd_BlOutNd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldNd_BlOutNd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BldNd_BlOutNd = SrcParamData%BldNd_BlOutNd + else if (allocated(DstParamData%BldNd_BlOutNd)) then + deallocate(DstParamData%BldNd_BlOutNd) + end if + if (allocated(SrcParamData%QPtw_Shp_Shp_Jac)) then + LB(1:4) = lbound(SrcParamData%QPtw_Shp_Shp_Jac) + UB(1:4) = ubound(SrcParamData%QPtw_Shp_Shp_Jac) + if (.not. allocated(DstParamData%QPtw_Shp_Shp_Jac)) then + allocate(DstParamData%QPtw_Shp_Shp_Jac(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%QPtw_Shp_Shp_Jac.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%QPtw_Shp_Shp_Jac = SrcParamData%QPtw_Shp_Shp_Jac + else if (allocated(DstParamData%QPtw_Shp_Shp_Jac)) then + deallocate(DstParamData%QPtw_Shp_Shp_Jac) + end if + if (allocated(SrcParamData%QPtw_Shp_ShpDer)) then + LB(1:3) = lbound(SrcParamData%QPtw_Shp_ShpDer) + UB(1:3) = ubound(SrcParamData%QPtw_Shp_ShpDer) + if (.not. allocated(DstParamData%QPtw_Shp_ShpDer)) then + allocate(DstParamData%QPtw_Shp_ShpDer(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%QPtw_Shp_ShpDer.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%QPtw_Shp_ShpDer = SrcParamData%QPtw_Shp_ShpDer + else if (allocated(DstParamData%QPtw_Shp_ShpDer)) then + deallocate(DstParamData%QPtw_Shp_ShpDer) + end if + if (allocated(SrcParamData%QPtw_ShpDer_ShpDer_Jac)) then + LB(1:4) = lbound(SrcParamData%QPtw_ShpDer_ShpDer_Jac) + UB(1:4) = ubound(SrcParamData%QPtw_ShpDer_ShpDer_Jac) + if (.not. allocated(DstParamData%QPtw_ShpDer_ShpDer_Jac)) then + allocate(DstParamData%QPtw_ShpDer_ShpDer_Jac(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%QPtw_ShpDer_ShpDer_Jac.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%QPtw_ShpDer_ShpDer_Jac = SrcParamData%QPtw_ShpDer_ShpDer_Jac + else if (allocated(DstParamData%QPtw_ShpDer_ShpDer_Jac)) then + deallocate(DstParamData%QPtw_ShpDer_ShpDer_Jac) + end if + if (allocated(SrcParamData%QPtw_Shp_Jac)) then + LB(1:3) = lbound(SrcParamData%QPtw_Shp_Jac) + UB(1:3) = ubound(SrcParamData%QPtw_Shp_Jac) + if (.not. allocated(DstParamData%QPtw_Shp_Jac)) then + allocate(DstParamData%QPtw_Shp_Jac(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%QPtw_Shp_Jac.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%QPtw_Shp_Jac = SrcParamData%QPtw_Shp_Jac + else if (allocated(DstParamData%QPtw_Shp_Jac)) then + deallocate(DstParamData%QPtw_Shp_Jac) + end if + if (allocated(SrcParamData%QPtw_ShpDer)) then + LB(1:2) = lbound(SrcParamData%QPtw_ShpDer) + UB(1:2) = ubound(SrcParamData%QPtw_ShpDer) + if (.not. allocated(DstParamData%QPtw_ShpDer)) then + allocate(DstParamData%QPtw_ShpDer(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%QPtw_ShpDer.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%QPtw_ShpDer = SrcParamData%QPtw_ShpDer + else if (allocated(DstParamData%QPtw_ShpDer)) then + deallocate(DstParamData%QPtw_ShpDer) + end if + if (allocated(SrcParamData%FEweight)) then + LB(1:2) = lbound(SrcParamData%FEweight) + UB(1:2) = ubound(SrcParamData%FEweight) + if (.not. allocated(DstParamData%FEweight)) then + allocate(DstParamData%FEweight(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FEweight.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%FEweight = SrcParamData%FEweight + else if (allocated(DstParamData%FEweight)) then + deallocate(DstParamData%FEweight) + end if + if (allocated(SrcParamData%Jac_u_indx)) then + LB(1:2) = lbound(SrcParamData%Jac_u_indx) + UB(1:2) = ubound(SrcParamData%Jac_u_indx) + if (.not. allocated(DstParamData%Jac_u_indx)) then + allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx + else if (allocated(DstParamData%Jac_u_indx)) then + deallocate(DstParamData%Jac_u_indx) + end if + if (allocated(SrcParamData%du)) then + LB(1:1) = lbound(SrcParamData%du) + UB(1:1) = ubound(SrcParamData%du) + if (.not. allocated(DstParamData%du)) then + allocate(DstParamData%du(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%du = SrcParamData%du + else if (allocated(DstParamData%du)) then + deallocate(DstParamData%du) + end if + DstParamData%dx = SrcParamData%dx + DstParamData%Jac_ny = SrcParamData%Jac_ny + DstParamData%Jac_nx = SrcParamData%Jac_nx + DstParamData%RotStates = SrcParamData%RotStates + DstParamData%RelStates = SrcParamData%RelStates +end subroutine +subroutine BD_DestroyParam(ParamData, ErrStat, ErrMsg) + type(BD_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3, i4 + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BD_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%uuN0)) then + deallocate(ParamData%uuN0) + end if + if (allocated(ParamData%Stif0_QP)) then + deallocate(ParamData%Stif0_QP) + end if + if (allocated(ParamData%Mass0_QP)) then + deallocate(ParamData%Mass0_QP) + end if + if (allocated(ParamData%segment_eta)) then + deallocate(ParamData%segment_eta) + end if + if (allocated(ParamData%member_eta)) then + deallocate(ParamData%member_eta) + end if + if (allocated(ParamData%QPtN)) then + deallocate(ParamData%QPtN) + end if + if (allocated(ParamData%QPtWeight)) then + deallocate(ParamData%QPtWeight) + end if + if (allocated(ParamData%Shp)) then + deallocate(ParamData%Shp) + end if + if (allocated(ParamData%ShpDer)) then + deallocate(ParamData%ShpDer) + end if + if (allocated(ParamData%Jacobian)) then + deallocate(ParamData%Jacobian) + end if + if (allocated(ParamData%uu0)) then + deallocate(ParamData%uu0) + end if + if (allocated(ParamData%rrN0)) then + deallocate(ParamData%rrN0) + end if + if (allocated(ParamData%E10)) then + deallocate(ParamData%E10) + end if + if (allocated(ParamData%node_elem_idx)) then + deallocate(ParamData%node_elem_idx) + end if + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%OutParam) + end if + if (allocated(ParamData%NdIndx)) then + deallocate(ParamData%NdIndx) + end if + if (allocated(ParamData%NdIndxInverse)) then + deallocate(ParamData%NdIndxInverse) + end if + if (allocated(ParamData%OutNd2NdElem)) then + deallocate(ParamData%OutNd2NdElem) + end if + if (allocated(ParamData%BldNd_OutParam)) then + LB(1:1) = lbound(ParamData%BldNd_OutParam) + UB(1:1) = ubound(ParamData%BldNd_OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%BldNd_OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%BldNd_OutParam) + end if + if (allocated(ParamData%BldNd_BlOutNd)) then + deallocate(ParamData%BldNd_BlOutNd) + end if + if (allocated(ParamData%QPtw_Shp_Shp_Jac)) then + deallocate(ParamData%QPtw_Shp_Shp_Jac) + end if + if (allocated(ParamData%QPtw_Shp_ShpDer)) then + deallocate(ParamData%QPtw_Shp_ShpDer) + end if + if (allocated(ParamData%QPtw_ShpDer_ShpDer_Jac)) then + deallocate(ParamData%QPtw_ShpDer_ShpDer_Jac) + end if + if (allocated(ParamData%QPtw_Shp_Jac)) then + deallocate(ParamData%QPtw_Shp_Jac) + end if + if (allocated(ParamData%QPtw_ShpDer)) then + deallocate(ParamData%QPtw_ShpDer) + end if + if (allocated(ParamData%FEweight)) then + deallocate(ParamData%FEweight) + end if + if (allocated(ParamData%Jac_u_indx)) then + deallocate(ParamData%Jac_u_indx) + end if + if (allocated(ParamData%du)) then + deallocate(ParamData%du) + end if +end subroutine subroutine BD_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -2710,195 +2464,150 @@ subroutine BD_PackParam(Buf, Indata) integer(IntKi) :: i1, i2, i3, i4 integer(IntKi) :: LB(4), UB(4) if (Buf%ErrStat >= AbortErrLev) return - ! dt call RegPack(Buf, InData%dt) if (RegCheckErr(Buf, RoutineName)) return - ! coef call RegPack(Buf, InData%coef) if (RegCheckErr(Buf, RoutineName)) return - ! rhoinf call RegPack(Buf, InData%rhoinf) if (RegCheckErr(Buf, RoutineName)) return - ! uuN0 call RegPack(Buf, allocated(InData%uuN0)) if (allocated(InData%uuN0)) then call RegPackBounds(Buf, 3, lbound(InData%uuN0), ubound(InData%uuN0)) call RegPack(Buf, InData%uuN0) end if if (RegCheckErr(Buf, RoutineName)) return - ! Stif0_QP call RegPack(Buf, allocated(InData%Stif0_QP)) if (allocated(InData%Stif0_QP)) then call RegPackBounds(Buf, 3, lbound(InData%Stif0_QP), ubound(InData%Stif0_QP)) call RegPack(Buf, InData%Stif0_QP) end if if (RegCheckErr(Buf, RoutineName)) return - ! Mass0_QP call RegPack(Buf, allocated(InData%Mass0_QP)) if (allocated(InData%Mass0_QP)) then call RegPackBounds(Buf, 3, lbound(InData%Mass0_QP), ubound(InData%Mass0_QP)) call RegPack(Buf, InData%Mass0_QP) end if if (RegCheckErr(Buf, RoutineName)) return - ! gravity call RegPack(Buf, InData%gravity) if (RegCheckErr(Buf, RoutineName)) return - ! segment_eta call RegPack(Buf, allocated(InData%segment_eta)) if (allocated(InData%segment_eta)) then call RegPackBounds(Buf, 1, lbound(InData%segment_eta), ubound(InData%segment_eta)) call RegPack(Buf, InData%segment_eta) end if if (RegCheckErr(Buf, RoutineName)) return - ! member_eta call RegPack(Buf, allocated(InData%member_eta)) if (allocated(InData%member_eta)) then call RegPackBounds(Buf, 1, lbound(InData%member_eta), ubound(InData%member_eta)) call RegPack(Buf, InData%member_eta) end if if (RegCheckErr(Buf, RoutineName)) return - ! blade_length call RegPack(Buf, InData%blade_length) if (RegCheckErr(Buf, RoutineName)) return - ! blade_mass call RegPack(Buf, InData%blade_mass) if (RegCheckErr(Buf, RoutineName)) return - ! blade_CG call RegPack(Buf, InData%blade_CG) if (RegCheckErr(Buf, RoutineName)) return - ! blade_IN call RegPack(Buf, InData%blade_IN) if (RegCheckErr(Buf, RoutineName)) return - ! beta call RegPack(Buf, InData%beta) if (RegCheckErr(Buf, RoutineName)) return - ! tol call RegPack(Buf, InData%tol) if (RegCheckErr(Buf, RoutineName)) return - ! GlbPos call RegPack(Buf, InData%GlbPos) if (RegCheckErr(Buf, RoutineName)) return - ! GlbRot call RegPack(Buf, InData%GlbRot) if (RegCheckErr(Buf, RoutineName)) return - ! Glb_crv call RegPack(Buf, InData%Glb_crv) if (RegCheckErr(Buf, RoutineName)) return - ! QPtN call RegPack(Buf, allocated(InData%QPtN)) if (allocated(InData%QPtN)) then call RegPackBounds(Buf, 1, lbound(InData%QPtN), ubound(InData%QPtN)) call RegPack(Buf, InData%QPtN) end if if (RegCheckErr(Buf, RoutineName)) return - ! QPtWeight call RegPack(Buf, allocated(InData%QPtWeight)) if (allocated(InData%QPtWeight)) then call RegPackBounds(Buf, 1, lbound(InData%QPtWeight), ubound(InData%QPtWeight)) call RegPack(Buf, InData%QPtWeight) end if if (RegCheckErr(Buf, RoutineName)) return - ! Shp call RegPack(Buf, allocated(InData%Shp)) if (allocated(InData%Shp)) then call RegPackBounds(Buf, 2, lbound(InData%Shp), ubound(InData%Shp)) call RegPack(Buf, InData%Shp) end if if (RegCheckErr(Buf, RoutineName)) return - ! ShpDer call RegPack(Buf, allocated(InData%ShpDer)) if (allocated(InData%ShpDer)) then call RegPackBounds(Buf, 2, lbound(InData%ShpDer), ubound(InData%ShpDer)) call RegPack(Buf, InData%ShpDer) end if if (RegCheckErr(Buf, RoutineName)) return - ! Jacobian call RegPack(Buf, allocated(InData%Jacobian)) if (allocated(InData%Jacobian)) then call RegPackBounds(Buf, 2, lbound(InData%Jacobian), ubound(InData%Jacobian)) call RegPack(Buf, InData%Jacobian) end if if (RegCheckErr(Buf, RoutineName)) return - ! uu0 call RegPack(Buf, allocated(InData%uu0)) if (allocated(InData%uu0)) then call RegPackBounds(Buf, 3, lbound(InData%uu0), ubound(InData%uu0)) call RegPack(Buf, InData%uu0) end if if (RegCheckErr(Buf, RoutineName)) return - ! rrN0 call RegPack(Buf, allocated(InData%rrN0)) if (allocated(InData%rrN0)) then call RegPackBounds(Buf, 3, lbound(InData%rrN0), ubound(InData%rrN0)) call RegPack(Buf, InData%rrN0) end if if (RegCheckErr(Buf, RoutineName)) return - ! E10 call RegPack(Buf, allocated(InData%E10)) if (allocated(InData%E10)) then call RegPackBounds(Buf, 3, lbound(InData%E10), ubound(InData%E10)) call RegPack(Buf, InData%E10) end if if (RegCheckErr(Buf, RoutineName)) return - ! nodes_per_elem call RegPack(Buf, InData%nodes_per_elem) if (RegCheckErr(Buf, RoutineName)) return - ! node_elem_idx call RegPack(Buf, allocated(InData%node_elem_idx)) if (allocated(InData%node_elem_idx)) then call RegPackBounds(Buf, 2, lbound(InData%node_elem_idx), ubound(InData%node_elem_idx)) call RegPack(Buf, InData%node_elem_idx) end if if (RegCheckErr(Buf, RoutineName)) return - ! refine call RegPack(Buf, InData%refine) if (RegCheckErr(Buf, RoutineName)) return - ! dof_node call RegPack(Buf, InData%dof_node) if (RegCheckErr(Buf, RoutineName)) return - ! dof_elem call RegPack(Buf, InData%dof_elem) if (RegCheckErr(Buf, RoutineName)) return - ! rot_elem call RegPack(Buf, InData%rot_elem) if (RegCheckErr(Buf, RoutineName)) return - ! elem_total call RegPack(Buf, InData%elem_total) if (RegCheckErr(Buf, RoutineName)) return - ! node_total call RegPack(Buf, InData%node_total) if (RegCheckErr(Buf, RoutineName)) return - ! dof_total call RegPack(Buf, InData%dof_total) if (RegCheckErr(Buf, RoutineName)) return - ! nqp call RegPack(Buf, InData%nqp) if (RegCheckErr(Buf, RoutineName)) return - ! analysis_type call RegPack(Buf, InData%analysis_type) if (RegCheckErr(Buf, RoutineName)) return - ! damp_flag call RegPack(Buf, InData%damp_flag) if (RegCheckErr(Buf, RoutineName)) return - ! ld_retries call RegPack(Buf, InData%ld_retries) if (RegCheckErr(Buf, RoutineName)) return - ! niter call RegPack(Buf, InData%niter) if (RegCheckErr(Buf, RoutineName)) return - ! quadrature call RegPack(Buf, InData%quadrature) if (RegCheckErr(Buf, RoutineName)) return - ! n_fact call RegPack(Buf, InData%n_fact) if (RegCheckErr(Buf, RoutineName)) return - ! OutInputs call RegPack(Buf, InData%OutInputs) if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegPack(Buf, InData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! OutParam call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) @@ -2909,79 +2618,58 @@ subroutine BD_PackParam(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! NNodeOuts call RegPack(Buf, InData%NNodeOuts) if (RegCheckErr(Buf, RoutineName)) return - ! OutNd call RegPack(Buf, InData%OutNd) if (RegCheckErr(Buf, RoutineName)) return - ! NdIndx call RegPack(Buf, allocated(InData%NdIndx)) if (allocated(InData%NdIndx)) then call RegPackBounds(Buf, 1, lbound(InData%NdIndx), ubound(InData%NdIndx)) call RegPack(Buf, InData%NdIndx) end if if (RegCheckErr(Buf, RoutineName)) return - ! NdIndxInverse call RegPack(Buf, allocated(InData%NdIndxInverse)) if (allocated(InData%NdIndxInverse)) then call RegPackBounds(Buf, 1, lbound(InData%NdIndxInverse), ubound(InData%NdIndxInverse)) call RegPack(Buf, InData%NdIndxInverse) end if if (RegCheckErr(Buf, RoutineName)) return - ! OutNd2NdElem call RegPack(Buf, allocated(InData%OutNd2NdElem)) if (allocated(InData%OutNd2NdElem)) then call RegPackBounds(Buf, 2, lbound(InData%OutNd2NdElem), ubound(InData%OutNd2NdElem)) call RegPack(Buf, InData%OutNd2NdElem) end if if (RegCheckErr(Buf, RoutineName)) return - ! OutFmt call RegPack(Buf, InData%OutFmt) if (RegCheckErr(Buf, RoutineName)) return - ! UsePitchAct call RegPack(Buf, InData%UsePitchAct) if (RegCheckErr(Buf, RoutineName)) return - ! pitchJ call RegPack(Buf, InData%pitchJ) if (RegCheckErr(Buf, RoutineName)) return - ! pitchK call RegPack(Buf, InData%pitchK) if (RegCheckErr(Buf, RoutineName)) return - ! pitchC call RegPack(Buf, InData%pitchC) if (RegCheckErr(Buf, RoutineName)) return - ! torqM call RegPack(Buf, InData%torqM) if (RegCheckErr(Buf, RoutineName)) return - ! qp call BD_PackqpParam(Buf, InData%qp) if (RegCheckErr(Buf, RoutineName)) return - ! qp_indx_offset call RegPack(Buf, InData%qp_indx_offset) if (RegCheckErr(Buf, RoutineName)) return - ! BldMotionNodeLoc call RegPack(Buf, InData%BldMotionNodeLoc) if (RegCheckErr(Buf, RoutineName)) return - ! tngt_stf_fd call RegPack(Buf, InData%tngt_stf_fd) if (RegCheckErr(Buf, RoutineName)) return - ! tngt_stf_comp call RegPack(Buf, InData%tngt_stf_comp) if (RegCheckErr(Buf, RoutineName)) return - ! tngt_stf_pert call RegPack(Buf, InData%tngt_stf_pert) if (RegCheckErr(Buf, RoutineName)) return - ! tngt_stf_difftol call RegPack(Buf, InData%tngt_stf_difftol) if (RegCheckErr(Buf, RoutineName)) return - ! BldNd_NumOuts call RegPack(Buf, InData%BldNd_NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! BldNd_TotNumOuts call RegPack(Buf, InData%BldNd_TotNumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! BldNd_OutParam call RegPack(Buf, allocated(InData%BldNd_OutParam)) if (allocated(InData%BldNd_OutParam)) then call RegPackBounds(Buf, 1, lbound(InData%BldNd_OutParam), ubound(InData%BldNd_OutParam)) @@ -2992,82 +2680,68 @@ subroutine BD_PackParam(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! BldNd_BlOutNd call RegPack(Buf, allocated(InData%BldNd_BlOutNd)) if (allocated(InData%BldNd_BlOutNd)) then call RegPackBounds(Buf, 1, lbound(InData%BldNd_BlOutNd), ubound(InData%BldNd_BlOutNd)) call RegPack(Buf, InData%BldNd_BlOutNd) end if if (RegCheckErr(Buf, RoutineName)) return - ! QPtw_Shp_Shp_Jac call RegPack(Buf, allocated(InData%QPtw_Shp_Shp_Jac)) if (allocated(InData%QPtw_Shp_Shp_Jac)) then call RegPackBounds(Buf, 4, lbound(InData%QPtw_Shp_Shp_Jac), ubound(InData%QPtw_Shp_Shp_Jac)) call RegPack(Buf, InData%QPtw_Shp_Shp_Jac) end if if (RegCheckErr(Buf, RoutineName)) return - ! QPtw_Shp_ShpDer call RegPack(Buf, allocated(InData%QPtw_Shp_ShpDer)) if (allocated(InData%QPtw_Shp_ShpDer)) then call RegPackBounds(Buf, 3, lbound(InData%QPtw_Shp_ShpDer), ubound(InData%QPtw_Shp_ShpDer)) call RegPack(Buf, InData%QPtw_Shp_ShpDer) end if if (RegCheckErr(Buf, RoutineName)) return - ! QPtw_ShpDer_ShpDer_Jac call RegPack(Buf, allocated(InData%QPtw_ShpDer_ShpDer_Jac)) if (allocated(InData%QPtw_ShpDer_ShpDer_Jac)) then call RegPackBounds(Buf, 4, lbound(InData%QPtw_ShpDer_ShpDer_Jac), ubound(InData%QPtw_ShpDer_ShpDer_Jac)) call RegPack(Buf, InData%QPtw_ShpDer_ShpDer_Jac) end if if (RegCheckErr(Buf, RoutineName)) return - ! QPtw_Shp_Jac call RegPack(Buf, allocated(InData%QPtw_Shp_Jac)) if (allocated(InData%QPtw_Shp_Jac)) then call RegPackBounds(Buf, 3, lbound(InData%QPtw_Shp_Jac), ubound(InData%QPtw_Shp_Jac)) call RegPack(Buf, InData%QPtw_Shp_Jac) end if if (RegCheckErr(Buf, RoutineName)) return - ! QPtw_ShpDer call RegPack(Buf, allocated(InData%QPtw_ShpDer)) if (allocated(InData%QPtw_ShpDer)) then call RegPackBounds(Buf, 2, lbound(InData%QPtw_ShpDer), ubound(InData%QPtw_ShpDer)) call RegPack(Buf, InData%QPtw_ShpDer) end if if (RegCheckErr(Buf, RoutineName)) return - ! FEweight call RegPack(Buf, allocated(InData%FEweight)) if (allocated(InData%FEweight)) then call RegPackBounds(Buf, 2, lbound(InData%FEweight), ubound(InData%FEweight)) call RegPack(Buf, InData%FEweight) end if if (RegCheckErr(Buf, RoutineName)) return - ! Jac_u_indx call RegPack(Buf, allocated(InData%Jac_u_indx)) if (allocated(InData%Jac_u_indx)) then call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx), ubound(InData%Jac_u_indx)) call RegPack(Buf, InData%Jac_u_indx) end if if (RegCheckErr(Buf, RoutineName)) return - ! du call RegPack(Buf, allocated(InData%du)) if (allocated(InData%du)) then call RegPackBounds(Buf, 1, lbound(InData%du), ubound(InData%du)) call RegPack(Buf, InData%du) end if if (RegCheckErr(Buf, RoutineName)) return - ! dx call RegPack(Buf, InData%dx) if (RegCheckErr(Buf, RoutineName)) return - ! Jac_ny call RegPack(Buf, InData%Jac_ny) if (RegCheckErr(Buf, RoutineName)) return - ! Jac_nx call RegPack(Buf, InData%Jac_nx) if (RegCheckErr(Buf, RoutineName)) return - ! RotStates call RegPack(Buf, InData%RotStates) if (RegCheckErr(Buf, RoutineName)) return - ! RelStates call RegPack(Buf, InData%RelStates) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3081,16 +2755,12 @@ subroutine BD_UnPackParam(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! dt call RegUnpack(Buf, OutData%dt) if (RegCheckErr(Buf, RoutineName)) return - ! coef call RegUnpack(Buf, OutData%coef) if (RegCheckErr(Buf, RoutineName)) return - ! rhoinf call RegUnpack(Buf, OutData%rhoinf) if (RegCheckErr(Buf, RoutineName)) return - ! uuN0 if (allocated(OutData%uuN0)) deallocate(OutData%uuN0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3105,7 +2775,6 @@ subroutine BD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%uuN0) if (RegCheckErr(Buf, RoutineName)) return end if - ! Stif0_QP if (allocated(OutData%Stif0_QP)) deallocate(OutData%Stif0_QP) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3120,7 +2789,6 @@ subroutine BD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%Stif0_QP) if (RegCheckErr(Buf, RoutineName)) return end if - ! Mass0_QP if (allocated(OutData%Mass0_QP)) deallocate(OutData%Mass0_QP) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3135,10 +2803,8 @@ subroutine BD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%Mass0_QP) if (RegCheckErr(Buf, RoutineName)) return end if - ! gravity call RegUnpack(Buf, OutData%gravity) if (RegCheckErr(Buf, RoutineName)) return - ! segment_eta if (allocated(OutData%segment_eta)) deallocate(OutData%segment_eta) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3153,7 +2819,6 @@ subroutine BD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%segment_eta) if (RegCheckErr(Buf, RoutineName)) return end if - ! member_eta if (allocated(OutData%member_eta)) deallocate(OutData%member_eta) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3168,34 +2833,24 @@ subroutine BD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%member_eta) if (RegCheckErr(Buf, RoutineName)) return end if - ! blade_length call RegUnpack(Buf, OutData%blade_length) if (RegCheckErr(Buf, RoutineName)) return - ! blade_mass call RegUnpack(Buf, OutData%blade_mass) if (RegCheckErr(Buf, RoutineName)) return - ! blade_CG call RegUnpack(Buf, OutData%blade_CG) if (RegCheckErr(Buf, RoutineName)) return - ! blade_IN call RegUnpack(Buf, OutData%blade_IN) if (RegCheckErr(Buf, RoutineName)) return - ! beta call RegUnpack(Buf, OutData%beta) if (RegCheckErr(Buf, RoutineName)) return - ! tol call RegUnpack(Buf, OutData%tol) if (RegCheckErr(Buf, RoutineName)) return - ! GlbPos call RegUnpack(Buf, OutData%GlbPos) if (RegCheckErr(Buf, RoutineName)) return - ! GlbRot call RegUnpack(Buf, OutData%GlbRot) if (RegCheckErr(Buf, RoutineName)) return - ! Glb_crv call RegUnpack(Buf, OutData%Glb_crv) if (RegCheckErr(Buf, RoutineName)) return - ! QPtN if (allocated(OutData%QPtN)) deallocate(OutData%QPtN) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3210,7 +2865,6 @@ subroutine BD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%QPtN) if (RegCheckErr(Buf, RoutineName)) return end if - ! QPtWeight if (allocated(OutData%QPtWeight)) deallocate(OutData%QPtWeight) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3225,7 +2879,6 @@ subroutine BD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%QPtWeight) if (RegCheckErr(Buf, RoutineName)) return end if - ! Shp if (allocated(OutData%Shp)) deallocate(OutData%Shp) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3240,7 +2893,6 @@ subroutine BD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%Shp) if (RegCheckErr(Buf, RoutineName)) return end if - ! ShpDer if (allocated(OutData%ShpDer)) deallocate(OutData%ShpDer) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3255,7 +2907,6 @@ subroutine BD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%ShpDer) if (RegCheckErr(Buf, RoutineName)) return end if - ! Jacobian if (allocated(OutData%Jacobian)) deallocate(OutData%Jacobian) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3270,7 +2921,6 @@ subroutine BD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%Jacobian) if (RegCheckErr(Buf, RoutineName)) return end if - ! uu0 if (allocated(OutData%uu0)) deallocate(OutData%uu0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3285,7 +2935,6 @@ subroutine BD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%uu0) if (RegCheckErr(Buf, RoutineName)) return end if - ! rrN0 if (allocated(OutData%rrN0)) deallocate(OutData%rrN0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3300,7 +2949,6 @@ subroutine BD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%rrN0) if (RegCheckErr(Buf, RoutineName)) return end if - ! E10 if (allocated(OutData%E10)) deallocate(OutData%E10) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3315,10 +2963,8 @@ subroutine BD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%E10) if (RegCheckErr(Buf, RoutineName)) return end if - ! nodes_per_elem call RegUnpack(Buf, OutData%nodes_per_elem) if (RegCheckErr(Buf, RoutineName)) return - ! node_elem_idx if (allocated(OutData%node_elem_idx)) deallocate(OutData%node_elem_idx) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3333,55 +2979,38 @@ subroutine BD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%node_elem_idx) if (RegCheckErr(Buf, RoutineName)) return end if - ! refine call RegUnpack(Buf, OutData%refine) if (RegCheckErr(Buf, RoutineName)) return - ! dof_node call RegUnpack(Buf, OutData%dof_node) if (RegCheckErr(Buf, RoutineName)) return - ! dof_elem call RegUnpack(Buf, OutData%dof_elem) if (RegCheckErr(Buf, RoutineName)) return - ! rot_elem call RegUnpack(Buf, OutData%rot_elem) if (RegCheckErr(Buf, RoutineName)) return - ! elem_total call RegUnpack(Buf, OutData%elem_total) if (RegCheckErr(Buf, RoutineName)) return - ! node_total call RegUnpack(Buf, OutData%node_total) if (RegCheckErr(Buf, RoutineName)) return - ! dof_total call RegUnpack(Buf, OutData%dof_total) if (RegCheckErr(Buf, RoutineName)) return - ! nqp call RegUnpack(Buf, OutData%nqp) if (RegCheckErr(Buf, RoutineName)) return - ! analysis_type call RegUnpack(Buf, OutData%analysis_type) if (RegCheckErr(Buf, RoutineName)) return - ! damp_flag call RegUnpack(Buf, OutData%damp_flag) if (RegCheckErr(Buf, RoutineName)) return - ! ld_retries call RegUnpack(Buf, OutData%ld_retries) if (RegCheckErr(Buf, RoutineName)) return - ! niter call RegUnpack(Buf, OutData%niter) if (RegCheckErr(Buf, RoutineName)) return - ! quadrature call RegUnpack(Buf, OutData%quadrature) if (RegCheckErr(Buf, RoutineName)) return - ! n_fact call RegUnpack(Buf, OutData%n_fact) if (RegCheckErr(Buf, RoutineName)) return - ! OutInputs call RegUnpack(Buf, OutData%OutInputs) if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegUnpack(Buf, OutData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! OutParam if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3397,13 +3026,10 @@ subroutine BD_UnPackParam(Buf, OutData) call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam end do end if - ! NNodeOuts call RegUnpack(Buf, OutData%NNodeOuts) if (RegCheckErr(Buf, RoutineName)) return - ! OutNd call RegUnpack(Buf, OutData%OutNd) if (RegCheckErr(Buf, RoutineName)) return - ! NdIndx if (allocated(OutData%NdIndx)) deallocate(OutData%NdIndx) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3418,7 +3044,6 @@ subroutine BD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%NdIndx) if (RegCheckErr(Buf, RoutineName)) return end if - ! NdIndxInverse if (allocated(OutData%NdIndxInverse)) deallocate(OutData%NdIndxInverse) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3433,7 +3058,6 @@ subroutine BD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%NdIndxInverse) if (RegCheckErr(Buf, RoutineName)) return end if - ! OutNd2NdElem if (allocated(OutData%OutNd2NdElem)) deallocate(OutData%OutNd2NdElem) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3448,51 +3072,35 @@ subroutine BD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%OutNd2NdElem) if (RegCheckErr(Buf, RoutineName)) return end if - ! OutFmt call RegUnpack(Buf, OutData%OutFmt) if (RegCheckErr(Buf, RoutineName)) return - ! UsePitchAct call RegUnpack(Buf, OutData%UsePitchAct) if (RegCheckErr(Buf, RoutineName)) return - ! pitchJ call RegUnpack(Buf, OutData%pitchJ) if (RegCheckErr(Buf, RoutineName)) return - ! pitchK call RegUnpack(Buf, OutData%pitchK) if (RegCheckErr(Buf, RoutineName)) return - ! pitchC call RegUnpack(Buf, OutData%pitchC) if (RegCheckErr(Buf, RoutineName)) return - ! torqM call RegUnpack(Buf, OutData%torqM) if (RegCheckErr(Buf, RoutineName)) return - ! qp call BD_UnpackqpParam(Buf, OutData%qp) ! qp - ! qp_indx_offset call RegUnpack(Buf, OutData%qp_indx_offset) if (RegCheckErr(Buf, RoutineName)) return - ! BldMotionNodeLoc call RegUnpack(Buf, OutData%BldMotionNodeLoc) if (RegCheckErr(Buf, RoutineName)) return - ! tngt_stf_fd call RegUnpack(Buf, OutData%tngt_stf_fd) if (RegCheckErr(Buf, RoutineName)) return - ! tngt_stf_comp call RegUnpack(Buf, OutData%tngt_stf_comp) if (RegCheckErr(Buf, RoutineName)) return - ! tngt_stf_pert call RegUnpack(Buf, OutData%tngt_stf_pert) if (RegCheckErr(Buf, RoutineName)) return - ! tngt_stf_difftol call RegUnpack(Buf, OutData%tngt_stf_difftol) if (RegCheckErr(Buf, RoutineName)) return - ! BldNd_NumOuts call RegUnpack(Buf, OutData%BldNd_NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! BldNd_TotNumOuts call RegUnpack(Buf, OutData%BldNd_TotNumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! BldNd_OutParam if (allocated(OutData%BldNd_OutParam)) deallocate(OutData%BldNd_OutParam) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3508,7 +3116,6 @@ subroutine BD_UnPackParam(Buf, OutData) call NWTC_Library_UnpackOutParmType(Buf, OutData%BldNd_OutParam(i1)) ! BldNd_OutParam end do end if - ! BldNd_BlOutNd if (allocated(OutData%BldNd_BlOutNd)) deallocate(OutData%BldNd_BlOutNd) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3523,7 +3130,6 @@ subroutine BD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%BldNd_BlOutNd) if (RegCheckErr(Buf, RoutineName)) return end if - ! QPtw_Shp_Shp_Jac if (allocated(OutData%QPtw_Shp_Shp_Jac)) deallocate(OutData%QPtw_Shp_Shp_Jac) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3538,7 +3144,6 @@ subroutine BD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%QPtw_Shp_Shp_Jac) if (RegCheckErr(Buf, RoutineName)) return end if - ! QPtw_Shp_ShpDer if (allocated(OutData%QPtw_Shp_ShpDer)) deallocate(OutData%QPtw_Shp_ShpDer) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3553,7 +3158,6 @@ subroutine BD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%QPtw_Shp_ShpDer) if (RegCheckErr(Buf, RoutineName)) return end if - ! QPtw_ShpDer_ShpDer_Jac if (allocated(OutData%QPtw_ShpDer_ShpDer_Jac)) deallocate(OutData%QPtw_ShpDer_ShpDer_Jac) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3568,7 +3172,6 @@ subroutine BD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%QPtw_ShpDer_ShpDer_Jac) if (RegCheckErr(Buf, RoutineName)) return end if - ! QPtw_Shp_Jac if (allocated(OutData%QPtw_Shp_Jac)) deallocate(OutData%QPtw_Shp_Jac) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3583,7 +3186,6 @@ subroutine BD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%QPtw_Shp_Jac) if (RegCheckErr(Buf, RoutineName)) return end if - ! QPtw_ShpDer if (allocated(OutData%QPtw_ShpDer)) deallocate(OutData%QPtw_ShpDer) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3598,7 +3200,6 @@ subroutine BD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%QPtw_ShpDer) if (RegCheckErr(Buf, RoutineName)) return end if - ! FEweight if (allocated(OutData%FEweight)) deallocate(OutData%FEweight) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3613,7 +3214,6 @@ subroutine BD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%FEweight) if (RegCheckErr(Buf, RoutineName)) return end if - ! Jac_u_indx if (allocated(OutData%Jac_u_indx)) deallocate(OutData%Jac_u_indx) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3628,7 +3228,6 @@ subroutine BD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%Jac_u_indx) if (RegCheckErr(Buf, RoutineName)) return end if - ! du if (allocated(OutData%du)) deallocate(OutData%du) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3643,89 +3242,65 @@ subroutine BD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%du) if (RegCheckErr(Buf, RoutineName)) return end if - ! dx call RegUnpack(Buf, OutData%dx) if (RegCheckErr(Buf, RoutineName)) return - ! Jac_ny call RegUnpack(Buf, OutData%Jac_ny) if (RegCheckErr(Buf, RoutineName)) return - ! Jac_nx call RegUnpack(Buf, OutData%Jac_nx) if (RegCheckErr(Buf, RoutineName)) return - ! RotStates call RegUnpack(Buf, OutData%RotStates) if (RegCheckErr(Buf, RoutineName)) return - ! RelStates call RegUnpack(Buf, OutData%RelStates) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE BD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BD_InputType), INTENT(INOUT) :: SrcInputData - TYPE(BD_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_CopyInput' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcInputData%RootMotion, DstInputData%RootMotion, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcInputData%PointLoad, DstInputData%PointLoad, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcInputData%DistrLoad, DstInputData%DistrLoad, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcInputData%HubMotion, DstInputData%HubMotion, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE BD_CopyInput - - SUBROUTINE BD_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(BD_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - CALL MeshDestroy( InputData%RootMotion, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( InputData%PointLoad, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( InputData%DistrLoad, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( InputData%HubMotion, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE BD_DestroyInput +subroutine BD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(BD_InputType), intent(inout) :: SrcInputData + type(BD_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BD_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcInputData%RootMotion, DstInputData%RootMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcInputData%PointLoad, DstInputData%PointLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcInputData%DistrLoad, DstInputData%DistrLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcInputData%HubMotion, DstInputData%HubMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine BD_DestroyInput(InputData, ErrStat, ErrMsg) + type(BD_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BD_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine BD_PackInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(BD_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'BD_PackInput' if (Buf%ErrStat >= AbortErrLev) return - ! RootMotion call MeshPack(Buf, InData%RootMotion) if (RegCheckErr(Buf, RoutineName)) return - ! PointLoad call MeshPack(Buf, InData%PointLoad) if (RegCheckErr(Buf, RoutineName)) return - ! DistrLoad call MeshPack(Buf, InData%DistrLoad) if (RegCheckErr(Buf, RoutineName)) return - ! HubMotion call MeshPack(Buf, InData%HubMotion) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3735,93 +3310,75 @@ subroutine BD_UnPackInput(Buf, OutData) type(BD_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackInput' if (Buf%ErrStat /= ErrID_None) return - ! RootMotion call MeshUnpack(Buf, OutData%RootMotion) ! RootMotion - ! PointLoad call MeshUnpack(Buf, OutData%PointLoad) ! PointLoad - ! DistrLoad call MeshUnpack(Buf, OutData%DistrLoad) ! DistrLoad - ! HubMotion call MeshUnpack(Buf, OutData%HubMotion) ! HubMotion end subroutine - SUBROUTINE BD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BD_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(BD_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_CopyOutput' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcOutputData%ReactionForce, DstOutputData%ReactionForce, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcOutputData%BldMotion, DstOutputData%BldMotion, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstOutputData%RootMxr = SrcOutputData%RootMxr - DstOutputData%RootMyr = SrcOutputData%RootMyr -IF (ALLOCATED(SrcOutputData%WriteOutput)) THEN - i1_l = LBOUND(SrcOutputData%WriteOutput,1) - i1_u = UBOUND(SrcOutputData%WriteOutput,1) - IF (.NOT. ALLOCATED(DstOutputData%WriteOutput)) THEN - ALLOCATE(DstOutputData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%WriteOutput = SrcOutputData%WriteOutput -ENDIF - END SUBROUTINE BD_CopyOutput - - SUBROUTINE BD_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(BD_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyOutput' - ErrStat = ErrID_None - ErrMsg = "" - - CALL MeshDestroy( OutputData%ReactionForce, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( OutputData%BldMotion, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - END SUBROUTINE BD_DestroyOutput +subroutine BD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(BD_OutputType), intent(inout) :: SrcOutputData + type(BD_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BD_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcOutputData%ReactionForce, DstOutputData%ReactionForce, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcOutputData%BldMotion, DstOutputData%BldMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstOutputData%RootMxr = SrcOutputData%RootMxr + DstOutputData%RootMyr = SrcOutputData%RootMyr + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%WriteOutput = SrcOutputData%WriteOutput + else if (allocated(DstOutputData%WriteOutput)) then + deallocate(DstOutputData%WriteOutput) + end if +end subroutine +subroutine BD_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(BD_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BD_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine subroutine BD_PackOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(BD_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'BD_PackOutput' if (Buf%ErrStat >= AbortErrLev) return - ! ReactionForce call MeshPack(Buf, InData%ReactionForce) if (RegCheckErr(Buf, RoutineName)) return - ! BldMotion call MeshPack(Buf, InData%BldMotion) if (RegCheckErr(Buf, RoutineName)) return - ! RootMxr call RegPack(Buf, InData%RootMxr) if (RegCheckErr(Buf, RoutineName)) return - ! RootMyr call RegPack(Buf, InData%RootMyr) if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutput call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) @@ -3838,17 +3395,12 @@ subroutine BD_UnPackOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! ReactionForce call MeshUnpack(Buf, OutData%ReactionForce) ! ReactionForce - ! BldMotion call MeshUnpack(Buf, OutData%BldMotion) ! BldMotion - ! RootMxr call RegUnpack(Buf, OutData%RootMxr) if (RegCheckErr(Buf, RoutineName)) return - ! RootMyr call RegUnpack(Buf, OutData%RootMyr) if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutput if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3864,881 +3416,741 @@ subroutine BD_UnPackOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE BD_CopyEqMotionQP( SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, ErrStat, ErrMsg ) - TYPE(EqMotionQP), INTENT(IN) :: SrcEqMotionQPData - TYPE(EqMotionQP), INTENT(INOUT) :: DstEqMotionQPData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_CopyEqMotionQP' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcEqMotionQPData%uuu)) THEN - i1_l = LBOUND(SrcEqMotionQPData%uuu,1) - i1_u = UBOUND(SrcEqMotionQPData%uuu,1) - i2_l = LBOUND(SrcEqMotionQPData%uuu,2) - i2_u = UBOUND(SrcEqMotionQPData%uuu,2) - i3_l = LBOUND(SrcEqMotionQPData%uuu,3) - i3_u = UBOUND(SrcEqMotionQPData%uuu,3) - IF (.NOT. ALLOCATED(DstEqMotionQPData%uuu)) THEN - ALLOCATE(DstEqMotionQPData%uuu(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%uuu.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%uuu = SrcEqMotionQPData%uuu -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%uup)) THEN - i1_l = LBOUND(SrcEqMotionQPData%uup,1) - i1_u = UBOUND(SrcEqMotionQPData%uup,1) - i2_l = LBOUND(SrcEqMotionQPData%uup,2) - i2_u = UBOUND(SrcEqMotionQPData%uup,2) - i3_l = LBOUND(SrcEqMotionQPData%uup,3) - i3_u = UBOUND(SrcEqMotionQPData%uup,3) - IF (.NOT. ALLOCATED(DstEqMotionQPData%uup)) THEN - ALLOCATE(DstEqMotionQPData%uup(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%uup.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%uup = SrcEqMotionQPData%uup -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%vvv)) THEN - i1_l = LBOUND(SrcEqMotionQPData%vvv,1) - i1_u = UBOUND(SrcEqMotionQPData%vvv,1) - i2_l = LBOUND(SrcEqMotionQPData%vvv,2) - i2_u = UBOUND(SrcEqMotionQPData%vvv,2) - i3_l = LBOUND(SrcEqMotionQPData%vvv,3) - i3_u = UBOUND(SrcEqMotionQPData%vvv,3) - IF (.NOT. ALLOCATED(DstEqMotionQPData%vvv)) THEN - ALLOCATE(DstEqMotionQPData%vvv(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%vvv.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%vvv = SrcEqMotionQPData%vvv -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%vvp)) THEN - i1_l = LBOUND(SrcEqMotionQPData%vvp,1) - i1_u = UBOUND(SrcEqMotionQPData%vvp,1) - i2_l = LBOUND(SrcEqMotionQPData%vvp,2) - i2_u = UBOUND(SrcEqMotionQPData%vvp,2) - i3_l = LBOUND(SrcEqMotionQPData%vvp,3) - i3_u = UBOUND(SrcEqMotionQPData%vvp,3) - IF (.NOT. ALLOCATED(DstEqMotionQPData%vvp)) THEN - ALLOCATE(DstEqMotionQPData%vvp(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%vvp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%vvp = SrcEqMotionQPData%vvp -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%aaa)) THEN - i1_l = LBOUND(SrcEqMotionQPData%aaa,1) - i1_u = UBOUND(SrcEqMotionQPData%aaa,1) - i2_l = LBOUND(SrcEqMotionQPData%aaa,2) - i2_u = UBOUND(SrcEqMotionQPData%aaa,2) - i3_l = LBOUND(SrcEqMotionQPData%aaa,3) - i3_u = UBOUND(SrcEqMotionQPData%aaa,3) - IF (.NOT. ALLOCATED(DstEqMotionQPData%aaa)) THEN - ALLOCATE(DstEqMotionQPData%aaa(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%aaa.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%aaa = SrcEqMotionQPData%aaa -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%RR0)) THEN - i1_l = LBOUND(SrcEqMotionQPData%RR0,1) - i1_u = UBOUND(SrcEqMotionQPData%RR0,1) - i2_l = LBOUND(SrcEqMotionQPData%RR0,2) - i2_u = UBOUND(SrcEqMotionQPData%RR0,2) - i3_l = LBOUND(SrcEqMotionQPData%RR0,3) - i3_u = UBOUND(SrcEqMotionQPData%RR0,3) - i4_l = LBOUND(SrcEqMotionQPData%RR0,4) - i4_u = UBOUND(SrcEqMotionQPData%RR0,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%RR0)) THEN - ALLOCATE(DstEqMotionQPData%RR0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%RR0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%RR0 = SrcEqMotionQPData%RR0 -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%kappa)) THEN - i1_l = LBOUND(SrcEqMotionQPData%kappa,1) - i1_u = UBOUND(SrcEqMotionQPData%kappa,1) - i2_l = LBOUND(SrcEqMotionQPData%kappa,2) - i2_u = UBOUND(SrcEqMotionQPData%kappa,2) - i3_l = LBOUND(SrcEqMotionQPData%kappa,3) - i3_u = UBOUND(SrcEqMotionQPData%kappa,3) - IF (.NOT. ALLOCATED(DstEqMotionQPData%kappa)) THEN - ALLOCATE(DstEqMotionQPData%kappa(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%kappa.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%kappa = SrcEqMotionQPData%kappa -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%E1)) THEN - i1_l = LBOUND(SrcEqMotionQPData%E1,1) - i1_u = UBOUND(SrcEqMotionQPData%E1,1) - i2_l = LBOUND(SrcEqMotionQPData%E1,2) - i2_u = UBOUND(SrcEqMotionQPData%E1,2) - i3_l = LBOUND(SrcEqMotionQPData%E1,3) - i3_u = UBOUND(SrcEqMotionQPData%E1,3) - IF (.NOT. ALLOCATED(DstEqMotionQPData%E1)) THEN - ALLOCATE(DstEqMotionQPData%E1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%E1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%E1 = SrcEqMotionQPData%E1 -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Stif)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Stif,1) - i1_u = UBOUND(SrcEqMotionQPData%Stif,1) - i2_l = LBOUND(SrcEqMotionQPData%Stif,2) - i2_u = UBOUND(SrcEqMotionQPData%Stif,2) - i3_l = LBOUND(SrcEqMotionQPData%Stif,3) - i3_u = UBOUND(SrcEqMotionQPData%Stif,3) - i4_l = LBOUND(SrcEqMotionQPData%Stif,4) - i4_u = UBOUND(SrcEqMotionQPData%Stif,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Stif)) THEN - ALLOCATE(DstEqMotionQPData%Stif(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Stif.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Stif = SrcEqMotionQPData%Stif -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Fb)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Fb,1) - i1_u = UBOUND(SrcEqMotionQPData%Fb,1) - i2_l = LBOUND(SrcEqMotionQPData%Fb,2) - i2_u = UBOUND(SrcEqMotionQPData%Fb,2) - i3_l = LBOUND(SrcEqMotionQPData%Fb,3) - i3_u = UBOUND(SrcEqMotionQPData%Fb,3) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Fb)) THEN - ALLOCATE(DstEqMotionQPData%Fb(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Fb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Fb = SrcEqMotionQPData%Fb -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Fc)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Fc,1) - i1_u = UBOUND(SrcEqMotionQPData%Fc,1) - i2_l = LBOUND(SrcEqMotionQPData%Fc,2) - i2_u = UBOUND(SrcEqMotionQPData%Fc,2) - i3_l = LBOUND(SrcEqMotionQPData%Fc,3) - i3_u = UBOUND(SrcEqMotionQPData%Fc,3) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Fc)) THEN - ALLOCATE(DstEqMotionQPData%Fc(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Fc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Fc = SrcEqMotionQPData%Fc -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Fd)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Fd,1) - i1_u = UBOUND(SrcEqMotionQPData%Fd,1) - i2_l = LBOUND(SrcEqMotionQPData%Fd,2) - i2_u = UBOUND(SrcEqMotionQPData%Fd,2) - i3_l = LBOUND(SrcEqMotionQPData%Fd,3) - i3_u = UBOUND(SrcEqMotionQPData%Fd,3) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Fd)) THEN - ALLOCATE(DstEqMotionQPData%Fd(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Fd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Fd = SrcEqMotionQPData%Fd -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Fg)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Fg,1) - i1_u = UBOUND(SrcEqMotionQPData%Fg,1) - i2_l = LBOUND(SrcEqMotionQPData%Fg,2) - i2_u = UBOUND(SrcEqMotionQPData%Fg,2) - i3_l = LBOUND(SrcEqMotionQPData%Fg,3) - i3_u = UBOUND(SrcEqMotionQPData%Fg,3) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Fg)) THEN - ALLOCATE(DstEqMotionQPData%Fg(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Fg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Fg = SrcEqMotionQPData%Fg -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Fi)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Fi,1) - i1_u = UBOUND(SrcEqMotionQPData%Fi,1) - i2_l = LBOUND(SrcEqMotionQPData%Fi,2) - i2_u = UBOUND(SrcEqMotionQPData%Fi,2) - i3_l = LBOUND(SrcEqMotionQPData%Fi,3) - i3_u = UBOUND(SrcEqMotionQPData%Fi,3) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Fi)) THEN - ALLOCATE(DstEqMotionQPData%Fi(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Fi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Fi = SrcEqMotionQPData%Fi -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Ftemp)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Ftemp,1) - i1_u = UBOUND(SrcEqMotionQPData%Ftemp,1) - i2_l = LBOUND(SrcEqMotionQPData%Ftemp,2) - i2_u = UBOUND(SrcEqMotionQPData%Ftemp,2) - i3_l = LBOUND(SrcEqMotionQPData%Ftemp,3) - i3_u = UBOUND(SrcEqMotionQPData%Ftemp,3) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Ftemp)) THEN - ALLOCATE(DstEqMotionQPData%Ftemp(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Ftemp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Ftemp = SrcEqMotionQPData%Ftemp -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%RR0mEta)) THEN - i1_l = LBOUND(SrcEqMotionQPData%RR0mEta,1) - i1_u = UBOUND(SrcEqMotionQPData%RR0mEta,1) - i2_l = LBOUND(SrcEqMotionQPData%RR0mEta,2) - i2_u = UBOUND(SrcEqMotionQPData%RR0mEta,2) - i3_l = LBOUND(SrcEqMotionQPData%RR0mEta,3) - i3_u = UBOUND(SrcEqMotionQPData%RR0mEta,3) - IF (.NOT. ALLOCATED(DstEqMotionQPData%RR0mEta)) THEN - ALLOCATE(DstEqMotionQPData%RR0mEta(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%RR0mEta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%RR0mEta = SrcEqMotionQPData%RR0mEta -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%rho)) THEN - i1_l = LBOUND(SrcEqMotionQPData%rho,1) - i1_u = UBOUND(SrcEqMotionQPData%rho,1) - i2_l = LBOUND(SrcEqMotionQPData%rho,2) - i2_u = UBOUND(SrcEqMotionQPData%rho,2) - i3_l = LBOUND(SrcEqMotionQPData%rho,3) - i3_u = UBOUND(SrcEqMotionQPData%rho,3) - i4_l = LBOUND(SrcEqMotionQPData%rho,4) - i4_u = UBOUND(SrcEqMotionQPData%rho,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%rho)) THEN - ALLOCATE(DstEqMotionQPData%rho(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%rho.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%rho = SrcEqMotionQPData%rho -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%betaC)) THEN - i1_l = LBOUND(SrcEqMotionQPData%betaC,1) - i1_u = UBOUND(SrcEqMotionQPData%betaC,1) - i2_l = LBOUND(SrcEqMotionQPData%betaC,2) - i2_u = UBOUND(SrcEqMotionQPData%betaC,2) - i3_l = LBOUND(SrcEqMotionQPData%betaC,3) - i3_u = UBOUND(SrcEqMotionQPData%betaC,3) - i4_l = LBOUND(SrcEqMotionQPData%betaC,4) - i4_u = UBOUND(SrcEqMotionQPData%betaC,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%betaC)) THEN - ALLOCATE(DstEqMotionQPData%betaC(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%betaC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%betaC = SrcEqMotionQPData%betaC -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Gi)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Gi,1) - i1_u = UBOUND(SrcEqMotionQPData%Gi,1) - i2_l = LBOUND(SrcEqMotionQPData%Gi,2) - i2_u = UBOUND(SrcEqMotionQPData%Gi,2) - i3_l = LBOUND(SrcEqMotionQPData%Gi,3) - i3_u = UBOUND(SrcEqMotionQPData%Gi,3) - i4_l = LBOUND(SrcEqMotionQPData%Gi,4) - i4_u = UBOUND(SrcEqMotionQPData%Gi,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Gi)) THEN - ALLOCATE(DstEqMotionQPData%Gi(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Gi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Gi = SrcEqMotionQPData%Gi -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Ki)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Ki,1) - i1_u = UBOUND(SrcEqMotionQPData%Ki,1) - i2_l = LBOUND(SrcEqMotionQPData%Ki,2) - i2_u = UBOUND(SrcEqMotionQPData%Ki,2) - i3_l = LBOUND(SrcEqMotionQPData%Ki,3) - i3_u = UBOUND(SrcEqMotionQPData%Ki,3) - i4_l = LBOUND(SrcEqMotionQPData%Ki,4) - i4_u = UBOUND(SrcEqMotionQPData%Ki,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Ki)) THEN - ALLOCATE(DstEqMotionQPData%Ki(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Ki.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Ki = SrcEqMotionQPData%Ki -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Mi)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Mi,1) - i1_u = UBOUND(SrcEqMotionQPData%Mi,1) - i2_l = LBOUND(SrcEqMotionQPData%Mi,2) - i2_u = UBOUND(SrcEqMotionQPData%Mi,2) - i3_l = LBOUND(SrcEqMotionQPData%Mi,3) - i3_u = UBOUND(SrcEqMotionQPData%Mi,3) - i4_l = LBOUND(SrcEqMotionQPData%Mi,4) - i4_u = UBOUND(SrcEqMotionQPData%Mi,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Mi)) THEN - ALLOCATE(DstEqMotionQPData%Mi(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Mi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Mi = SrcEqMotionQPData%Mi -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Oe)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Oe,1) - i1_u = UBOUND(SrcEqMotionQPData%Oe,1) - i2_l = LBOUND(SrcEqMotionQPData%Oe,2) - i2_u = UBOUND(SrcEqMotionQPData%Oe,2) - i3_l = LBOUND(SrcEqMotionQPData%Oe,3) - i3_u = UBOUND(SrcEqMotionQPData%Oe,3) - i4_l = LBOUND(SrcEqMotionQPData%Oe,4) - i4_u = UBOUND(SrcEqMotionQPData%Oe,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Oe)) THEN - ALLOCATE(DstEqMotionQPData%Oe(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Oe.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Oe = SrcEqMotionQPData%Oe -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Pe)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Pe,1) - i1_u = UBOUND(SrcEqMotionQPData%Pe,1) - i2_l = LBOUND(SrcEqMotionQPData%Pe,2) - i2_u = UBOUND(SrcEqMotionQPData%Pe,2) - i3_l = LBOUND(SrcEqMotionQPData%Pe,3) - i3_u = UBOUND(SrcEqMotionQPData%Pe,3) - i4_l = LBOUND(SrcEqMotionQPData%Pe,4) - i4_u = UBOUND(SrcEqMotionQPData%Pe,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Pe)) THEN - ALLOCATE(DstEqMotionQPData%Pe(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Pe.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Pe = SrcEqMotionQPData%Pe -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Qe)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Qe,1) - i1_u = UBOUND(SrcEqMotionQPData%Qe,1) - i2_l = LBOUND(SrcEqMotionQPData%Qe,2) - i2_u = UBOUND(SrcEqMotionQPData%Qe,2) - i3_l = LBOUND(SrcEqMotionQPData%Qe,3) - i3_u = UBOUND(SrcEqMotionQPData%Qe,3) - i4_l = LBOUND(SrcEqMotionQPData%Qe,4) - i4_u = UBOUND(SrcEqMotionQPData%Qe,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Qe)) THEN - ALLOCATE(DstEqMotionQPData%Qe(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Qe.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Qe = SrcEqMotionQPData%Qe -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Gd)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Gd,1) - i1_u = UBOUND(SrcEqMotionQPData%Gd,1) - i2_l = LBOUND(SrcEqMotionQPData%Gd,2) - i2_u = UBOUND(SrcEqMotionQPData%Gd,2) - i3_l = LBOUND(SrcEqMotionQPData%Gd,3) - i3_u = UBOUND(SrcEqMotionQPData%Gd,3) - i4_l = LBOUND(SrcEqMotionQPData%Gd,4) - i4_u = UBOUND(SrcEqMotionQPData%Gd,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Gd)) THEN - ALLOCATE(DstEqMotionQPData%Gd(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Gd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Gd = SrcEqMotionQPData%Gd -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Od)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Od,1) - i1_u = UBOUND(SrcEqMotionQPData%Od,1) - i2_l = LBOUND(SrcEqMotionQPData%Od,2) - i2_u = UBOUND(SrcEqMotionQPData%Od,2) - i3_l = LBOUND(SrcEqMotionQPData%Od,3) - i3_u = UBOUND(SrcEqMotionQPData%Od,3) - i4_l = LBOUND(SrcEqMotionQPData%Od,4) - i4_u = UBOUND(SrcEqMotionQPData%Od,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Od)) THEN - ALLOCATE(DstEqMotionQPData%Od(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Od.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Od = SrcEqMotionQPData%Od -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Pd)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Pd,1) - i1_u = UBOUND(SrcEqMotionQPData%Pd,1) - i2_l = LBOUND(SrcEqMotionQPData%Pd,2) - i2_u = UBOUND(SrcEqMotionQPData%Pd,2) - i3_l = LBOUND(SrcEqMotionQPData%Pd,3) - i3_u = UBOUND(SrcEqMotionQPData%Pd,3) - i4_l = LBOUND(SrcEqMotionQPData%Pd,4) - i4_u = UBOUND(SrcEqMotionQPData%Pd,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Pd)) THEN - ALLOCATE(DstEqMotionQPData%Pd(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Pd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Pd = SrcEqMotionQPData%Pd -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Qd)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Qd,1) - i1_u = UBOUND(SrcEqMotionQPData%Qd,1) - i2_l = LBOUND(SrcEqMotionQPData%Qd,2) - i2_u = UBOUND(SrcEqMotionQPData%Qd,2) - i3_l = LBOUND(SrcEqMotionQPData%Qd,3) - i3_u = UBOUND(SrcEqMotionQPData%Qd,3) - i4_l = LBOUND(SrcEqMotionQPData%Qd,4) - i4_u = UBOUND(SrcEqMotionQPData%Qd,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Qd)) THEN - ALLOCATE(DstEqMotionQPData%Qd(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Qd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Qd = SrcEqMotionQPData%Qd -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Sd)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Sd,1) - i1_u = UBOUND(SrcEqMotionQPData%Sd,1) - i2_l = LBOUND(SrcEqMotionQPData%Sd,2) - i2_u = UBOUND(SrcEqMotionQPData%Sd,2) - i3_l = LBOUND(SrcEqMotionQPData%Sd,3) - i3_u = UBOUND(SrcEqMotionQPData%Sd,3) - i4_l = LBOUND(SrcEqMotionQPData%Sd,4) - i4_u = UBOUND(SrcEqMotionQPData%Sd,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Sd)) THEN - ALLOCATE(DstEqMotionQPData%Sd(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Sd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Sd = SrcEqMotionQPData%Sd -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Xd)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Xd,1) - i1_u = UBOUND(SrcEqMotionQPData%Xd,1) - i2_l = LBOUND(SrcEqMotionQPData%Xd,2) - i2_u = UBOUND(SrcEqMotionQPData%Xd,2) - i3_l = LBOUND(SrcEqMotionQPData%Xd,3) - i3_u = UBOUND(SrcEqMotionQPData%Xd,3) - i4_l = LBOUND(SrcEqMotionQPData%Xd,4) - i4_u = UBOUND(SrcEqMotionQPData%Xd,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Xd)) THEN - ALLOCATE(DstEqMotionQPData%Xd(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Xd = SrcEqMotionQPData%Xd -ENDIF -IF (ALLOCATED(SrcEqMotionQPData%Yd)) THEN - i1_l = LBOUND(SrcEqMotionQPData%Yd,1) - i1_u = UBOUND(SrcEqMotionQPData%Yd,1) - i2_l = LBOUND(SrcEqMotionQPData%Yd,2) - i2_u = UBOUND(SrcEqMotionQPData%Yd,2) - i3_l = LBOUND(SrcEqMotionQPData%Yd,3) - i3_u = UBOUND(SrcEqMotionQPData%Yd,3) - i4_l = LBOUND(SrcEqMotionQPData%Yd,4) - i4_u = UBOUND(SrcEqMotionQPData%Yd,4) - IF (.NOT. ALLOCATED(DstEqMotionQPData%Yd)) THEN - ALLOCATE(DstEqMotionQPData%Yd(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Yd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstEqMotionQPData%Yd = SrcEqMotionQPData%Yd -ENDIF - END SUBROUTINE BD_CopyEqMotionQP - - SUBROUTINE BD_DestroyEqMotionQP( EqMotionQPData, ErrStat, ErrMsg ) - TYPE(EqMotionQP), INTENT(INOUT) :: EqMotionQPData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyEqMotionQP' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(EqMotionQPData%uuu)) THEN - DEALLOCATE(EqMotionQPData%uuu) -ENDIF -IF (ALLOCATED(EqMotionQPData%uup)) THEN - DEALLOCATE(EqMotionQPData%uup) -ENDIF -IF (ALLOCATED(EqMotionQPData%vvv)) THEN - DEALLOCATE(EqMotionQPData%vvv) -ENDIF -IF (ALLOCATED(EqMotionQPData%vvp)) THEN - DEALLOCATE(EqMotionQPData%vvp) -ENDIF -IF (ALLOCATED(EqMotionQPData%aaa)) THEN - DEALLOCATE(EqMotionQPData%aaa) -ENDIF -IF (ALLOCATED(EqMotionQPData%RR0)) THEN - DEALLOCATE(EqMotionQPData%RR0) -ENDIF -IF (ALLOCATED(EqMotionQPData%kappa)) THEN - DEALLOCATE(EqMotionQPData%kappa) -ENDIF -IF (ALLOCATED(EqMotionQPData%E1)) THEN - DEALLOCATE(EqMotionQPData%E1) -ENDIF -IF (ALLOCATED(EqMotionQPData%Stif)) THEN - DEALLOCATE(EqMotionQPData%Stif) -ENDIF -IF (ALLOCATED(EqMotionQPData%Fb)) THEN - DEALLOCATE(EqMotionQPData%Fb) -ENDIF -IF (ALLOCATED(EqMotionQPData%Fc)) THEN - DEALLOCATE(EqMotionQPData%Fc) -ENDIF -IF (ALLOCATED(EqMotionQPData%Fd)) THEN - DEALLOCATE(EqMotionQPData%Fd) -ENDIF -IF (ALLOCATED(EqMotionQPData%Fg)) THEN - DEALLOCATE(EqMotionQPData%Fg) -ENDIF -IF (ALLOCATED(EqMotionQPData%Fi)) THEN - DEALLOCATE(EqMotionQPData%Fi) -ENDIF -IF (ALLOCATED(EqMotionQPData%Ftemp)) THEN - DEALLOCATE(EqMotionQPData%Ftemp) -ENDIF -IF (ALLOCATED(EqMotionQPData%RR0mEta)) THEN - DEALLOCATE(EqMotionQPData%RR0mEta) -ENDIF -IF (ALLOCATED(EqMotionQPData%rho)) THEN - DEALLOCATE(EqMotionQPData%rho) -ENDIF -IF (ALLOCATED(EqMotionQPData%betaC)) THEN - DEALLOCATE(EqMotionQPData%betaC) -ENDIF -IF (ALLOCATED(EqMotionQPData%Gi)) THEN - DEALLOCATE(EqMotionQPData%Gi) -ENDIF -IF (ALLOCATED(EqMotionQPData%Ki)) THEN - DEALLOCATE(EqMotionQPData%Ki) -ENDIF -IF (ALLOCATED(EqMotionQPData%Mi)) THEN - DEALLOCATE(EqMotionQPData%Mi) -ENDIF -IF (ALLOCATED(EqMotionQPData%Oe)) THEN - DEALLOCATE(EqMotionQPData%Oe) -ENDIF -IF (ALLOCATED(EqMotionQPData%Pe)) THEN - DEALLOCATE(EqMotionQPData%Pe) -ENDIF -IF (ALLOCATED(EqMotionQPData%Qe)) THEN - DEALLOCATE(EqMotionQPData%Qe) -ENDIF -IF (ALLOCATED(EqMotionQPData%Gd)) THEN - DEALLOCATE(EqMotionQPData%Gd) -ENDIF -IF (ALLOCATED(EqMotionQPData%Od)) THEN - DEALLOCATE(EqMotionQPData%Od) -ENDIF -IF (ALLOCATED(EqMotionQPData%Pd)) THEN - DEALLOCATE(EqMotionQPData%Pd) -ENDIF -IF (ALLOCATED(EqMotionQPData%Qd)) THEN - DEALLOCATE(EqMotionQPData%Qd) -ENDIF -IF (ALLOCATED(EqMotionQPData%Sd)) THEN - DEALLOCATE(EqMotionQPData%Sd) -ENDIF -IF (ALLOCATED(EqMotionQPData%Xd)) THEN - DEALLOCATE(EqMotionQPData%Xd) -ENDIF -IF (ALLOCATED(EqMotionQPData%Yd)) THEN - DEALLOCATE(EqMotionQPData%Yd) -ENDIF - END SUBROUTINE BD_DestroyEqMotionQP +subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, ErrStat, ErrMsg) + type(EqMotionQP), intent(in) :: SrcEqMotionQPData + type(EqMotionQP), intent(inout) :: DstEqMotionQPData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'BD_CopyEqMotionQP' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcEqMotionQPData%uuu)) then + LB(1:3) = lbound(SrcEqMotionQPData%uuu) + UB(1:3) = ubound(SrcEqMotionQPData%uuu) + if (.not. allocated(DstEqMotionQPData%uuu)) then + allocate(DstEqMotionQPData%uuu(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%uuu.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%uuu = SrcEqMotionQPData%uuu + else if (allocated(DstEqMotionQPData%uuu)) then + deallocate(DstEqMotionQPData%uuu) + end if + if (allocated(SrcEqMotionQPData%uup)) then + LB(1:3) = lbound(SrcEqMotionQPData%uup) + UB(1:3) = ubound(SrcEqMotionQPData%uup) + if (.not. allocated(DstEqMotionQPData%uup)) then + allocate(DstEqMotionQPData%uup(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%uup.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%uup = SrcEqMotionQPData%uup + else if (allocated(DstEqMotionQPData%uup)) then + deallocate(DstEqMotionQPData%uup) + end if + if (allocated(SrcEqMotionQPData%vvv)) then + LB(1:3) = lbound(SrcEqMotionQPData%vvv) + UB(1:3) = ubound(SrcEqMotionQPData%vvv) + if (.not. allocated(DstEqMotionQPData%vvv)) then + allocate(DstEqMotionQPData%vvv(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%vvv.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%vvv = SrcEqMotionQPData%vvv + else if (allocated(DstEqMotionQPData%vvv)) then + deallocate(DstEqMotionQPData%vvv) + end if + if (allocated(SrcEqMotionQPData%vvp)) then + LB(1:3) = lbound(SrcEqMotionQPData%vvp) + UB(1:3) = ubound(SrcEqMotionQPData%vvp) + if (.not. allocated(DstEqMotionQPData%vvp)) then + allocate(DstEqMotionQPData%vvp(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%vvp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%vvp = SrcEqMotionQPData%vvp + else if (allocated(DstEqMotionQPData%vvp)) then + deallocate(DstEqMotionQPData%vvp) + end if + if (allocated(SrcEqMotionQPData%aaa)) then + LB(1:3) = lbound(SrcEqMotionQPData%aaa) + UB(1:3) = ubound(SrcEqMotionQPData%aaa) + if (.not. allocated(DstEqMotionQPData%aaa)) then + allocate(DstEqMotionQPData%aaa(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%aaa.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%aaa = SrcEqMotionQPData%aaa + else if (allocated(DstEqMotionQPData%aaa)) then + deallocate(DstEqMotionQPData%aaa) + end if + if (allocated(SrcEqMotionQPData%RR0)) then + LB(1:4) = lbound(SrcEqMotionQPData%RR0) + UB(1:4) = ubound(SrcEqMotionQPData%RR0) + if (.not. allocated(DstEqMotionQPData%RR0)) then + allocate(DstEqMotionQPData%RR0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%RR0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%RR0 = SrcEqMotionQPData%RR0 + else if (allocated(DstEqMotionQPData%RR0)) then + deallocate(DstEqMotionQPData%RR0) + end if + if (allocated(SrcEqMotionQPData%kappa)) then + LB(1:3) = lbound(SrcEqMotionQPData%kappa) + UB(1:3) = ubound(SrcEqMotionQPData%kappa) + if (.not. allocated(DstEqMotionQPData%kappa)) then + allocate(DstEqMotionQPData%kappa(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%kappa.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%kappa = SrcEqMotionQPData%kappa + else if (allocated(DstEqMotionQPData%kappa)) then + deallocate(DstEqMotionQPData%kappa) + end if + if (allocated(SrcEqMotionQPData%E1)) then + LB(1:3) = lbound(SrcEqMotionQPData%E1) + UB(1:3) = ubound(SrcEqMotionQPData%E1) + if (.not. allocated(DstEqMotionQPData%E1)) then + allocate(DstEqMotionQPData%E1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%E1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%E1 = SrcEqMotionQPData%E1 + else if (allocated(DstEqMotionQPData%E1)) then + deallocate(DstEqMotionQPData%E1) + end if + if (allocated(SrcEqMotionQPData%Stif)) then + LB(1:4) = lbound(SrcEqMotionQPData%Stif) + UB(1:4) = ubound(SrcEqMotionQPData%Stif) + if (.not. allocated(DstEqMotionQPData%Stif)) then + allocate(DstEqMotionQPData%Stif(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Stif.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Stif = SrcEqMotionQPData%Stif + else if (allocated(DstEqMotionQPData%Stif)) then + deallocate(DstEqMotionQPData%Stif) + end if + if (allocated(SrcEqMotionQPData%Fb)) then + LB(1:3) = lbound(SrcEqMotionQPData%Fb) + UB(1:3) = ubound(SrcEqMotionQPData%Fb) + if (.not. allocated(DstEqMotionQPData%Fb)) then + allocate(DstEqMotionQPData%Fb(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Fb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Fb = SrcEqMotionQPData%Fb + else if (allocated(DstEqMotionQPData%Fb)) then + deallocate(DstEqMotionQPData%Fb) + end if + if (allocated(SrcEqMotionQPData%Fc)) then + LB(1:3) = lbound(SrcEqMotionQPData%Fc) + UB(1:3) = ubound(SrcEqMotionQPData%Fc) + if (.not. allocated(DstEqMotionQPData%Fc)) then + allocate(DstEqMotionQPData%Fc(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Fc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Fc = SrcEqMotionQPData%Fc + else if (allocated(DstEqMotionQPData%Fc)) then + deallocate(DstEqMotionQPData%Fc) + end if + if (allocated(SrcEqMotionQPData%Fd)) then + LB(1:3) = lbound(SrcEqMotionQPData%Fd) + UB(1:3) = ubound(SrcEqMotionQPData%Fd) + if (.not. allocated(DstEqMotionQPData%Fd)) then + allocate(DstEqMotionQPData%Fd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Fd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Fd = SrcEqMotionQPData%Fd + else if (allocated(DstEqMotionQPData%Fd)) then + deallocate(DstEqMotionQPData%Fd) + end if + if (allocated(SrcEqMotionQPData%Fg)) then + LB(1:3) = lbound(SrcEqMotionQPData%Fg) + UB(1:3) = ubound(SrcEqMotionQPData%Fg) + if (.not. allocated(DstEqMotionQPData%Fg)) then + allocate(DstEqMotionQPData%Fg(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Fg.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Fg = SrcEqMotionQPData%Fg + else if (allocated(DstEqMotionQPData%Fg)) then + deallocate(DstEqMotionQPData%Fg) + end if + if (allocated(SrcEqMotionQPData%Fi)) then + LB(1:3) = lbound(SrcEqMotionQPData%Fi) + UB(1:3) = ubound(SrcEqMotionQPData%Fi) + if (.not. allocated(DstEqMotionQPData%Fi)) then + allocate(DstEqMotionQPData%Fi(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Fi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Fi = SrcEqMotionQPData%Fi + else if (allocated(DstEqMotionQPData%Fi)) then + deallocate(DstEqMotionQPData%Fi) + end if + if (allocated(SrcEqMotionQPData%Ftemp)) then + LB(1:3) = lbound(SrcEqMotionQPData%Ftemp) + UB(1:3) = ubound(SrcEqMotionQPData%Ftemp) + if (.not. allocated(DstEqMotionQPData%Ftemp)) then + allocate(DstEqMotionQPData%Ftemp(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Ftemp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Ftemp = SrcEqMotionQPData%Ftemp + else if (allocated(DstEqMotionQPData%Ftemp)) then + deallocate(DstEqMotionQPData%Ftemp) + end if + if (allocated(SrcEqMotionQPData%RR0mEta)) then + LB(1:3) = lbound(SrcEqMotionQPData%RR0mEta) + UB(1:3) = ubound(SrcEqMotionQPData%RR0mEta) + if (.not. allocated(DstEqMotionQPData%RR0mEta)) then + allocate(DstEqMotionQPData%RR0mEta(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%RR0mEta.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%RR0mEta = SrcEqMotionQPData%RR0mEta + else if (allocated(DstEqMotionQPData%RR0mEta)) then + deallocate(DstEqMotionQPData%RR0mEta) + end if + if (allocated(SrcEqMotionQPData%rho)) then + LB(1:4) = lbound(SrcEqMotionQPData%rho) + UB(1:4) = ubound(SrcEqMotionQPData%rho) + if (.not. allocated(DstEqMotionQPData%rho)) then + allocate(DstEqMotionQPData%rho(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%rho.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%rho = SrcEqMotionQPData%rho + else if (allocated(DstEqMotionQPData%rho)) then + deallocate(DstEqMotionQPData%rho) + end if + if (allocated(SrcEqMotionQPData%betaC)) then + LB(1:4) = lbound(SrcEqMotionQPData%betaC) + UB(1:4) = ubound(SrcEqMotionQPData%betaC) + if (.not. allocated(DstEqMotionQPData%betaC)) then + allocate(DstEqMotionQPData%betaC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%betaC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%betaC = SrcEqMotionQPData%betaC + else if (allocated(DstEqMotionQPData%betaC)) then + deallocate(DstEqMotionQPData%betaC) + end if + if (allocated(SrcEqMotionQPData%Gi)) then + LB(1:4) = lbound(SrcEqMotionQPData%Gi) + UB(1:4) = ubound(SrcEqMotionQPData%Gi) + if (.not. allocated(DstEqMotionQPData%Gi)) then + allocate(DstEqMotionQPData%Gi(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Gi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Gi = SrcEqMotionQPData%Gi + else if (allocated(DstEqMotionQPData%Gi)) then + deallocate(DstEqMotionQPData%Gi) + end if + if (allocated(SrcEqMotionQPData%Ki)) then + LB(1:4) = lbound(SrcEqMotionQPData%Ki) + UB(1:4) = ubound(SrcEqMotionQPData%Ki) + if (.not. allocated(DstEqMotionQPData%Ki)) then + allocate(DstEqMotionQPData%Ki(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Ki.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Ki = SrcEqMotionQPData%Ki + else if (allocated(DstEqMotionQPData%Ki)) then + deallocate(DstEqMotionQPData%Ki) + end if + if (allocated(SrcEqMotionQPData%Mi)) then + LB(1:4) = lbound(SrcEqMotionQPData%Mi) + UB(1:4) = ubound(SrcEqMotionQPData%Mi) + if (.not. allocated(DstEqMotionQPData%Mi)) then + allocate(DstEqMotionQPData%Mi(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Mi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Mi = SrcEqMotionQPData%Mi + else if (allocated(DstEqMotionQPData%Mi)) then + deallocate(DstEqMotionQPData%Mi) + end if + if (allocated(SrcEqMotionQPData%Oe)) then + LB(1:4) = lbound(SrcEqMotionQPData%Oe) + UB(1:4) = ubound(SrcEqMotionQPData%Oe) + if (.not. allocated(DstEqMotionQPData%Oe)) then + allocate(DstEqMotionQPData%Oe(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Oe.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Oe = SrcEqMotionQPData%Oe + else if (allocated(DstEqMotionQPData%Oe)) then + deallocate(DstEqMotionQPData%Oe) + end if + if (allocated(SrcEqMotionQPData%Pe)) then + LB(1:4) = lbound(SrcEqMotionQPData%Pe) + UB(1:4) = ubound(SrcEqMotionQPData%Pe) + if (.not. allocated(DstEqMotionQPData%Pe)) then + allocate(DstEqMotionQPData%Pe(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Pe.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Pe = SrcEqMotionQPData%Pe + else if (allocated(DstEqMotionQPData%Pe)) then + deallocate(DstEqMotionQPData%Pe) + end if + if (allocated(SrcEqMotionQPData%Qe)) then + LB(1:4) = lbound(SrcEqMotionQPData%Qe) + UB(1:4) = ubound(SrcEqMotionQPData%Qe) + if (.not. allocated(DstEqMotionQPData%Qe)) then + allocate(DstEqMotionQPData%Qe(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Qe.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Qe = SrcEqMotionQPData%Qe + else if (allocated(DstEqMotionQPData%Qe)) then + deallocate(DstEqMotionQPData%Qe) + end if + if (allocated(SrcEqMotionQPData%Gd)) then + LB(1:4) = lbound(SrcEqMotionQPData%Gd) + UB(1:4) = ubound(SrcEqMotionQPData%Gd) + if (.not. allocated(DstEqMotionQPData%Gd)) then + allocate(DstEqMotionQPData%Gd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Gd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Gd = SrcEqMotionQPData%Gd + else if (allocated(DstEqMotionQPData%Gd)) then + deallocate(DstEqMotionQPData%Gd) + end if + if (allocated(SrcEqMotionQPData%Od)) then + LB(1:4) = lbound(SrcEqMotionQPData%Od) + UB(1:4) = ubound(SrcEqMotionQPData%Od) + if (.not. allocated(DstEqMotionQPData%Od)) then + allocate(DstEqMotionQPData%Od(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Od.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Od = SrcEqMotionQPData%Od + else if (allocated(DstEqMotionQPData%Od)) then + deallocate(DstEqMotionQPData%Od) + end if + if (allocated(SrcEqMotionQPData%Pd)) then + LB(1:4) = lbound(SrcEqMotionQPData%Pd) + UB(1:4) = ubound(SrcEqMotionQPData%Pd) + if (.not. allocated(DstEqMotionQPData%Pd)) then + allocate(DstEqMotionQPData%Pd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Pd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Pd = SrcEqMotionQPData%Pd + else if (allocated(DstEqMotionQPData%Pd)) then + deallocate(DstEqMotionQPData%Pd) + end if + if (allocated(SrcEqMotionQPData%Qd)) then + LB(1:4) = lbound(SrcEqMotionQPData%Qd) + UB(1:4) = ubound(SrcEqMotionQPData%Qd) + if (.not. allocated(DstEqMotionQPData%Qd)) then + allocate(DstEqMotionQPData%Qd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Qd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Qd = SrcEqMotionQPData%Qd + else if (allocated(DstEqMotionQPData%Qd)) then + deallocate(DstEqMotionQPData%Qd) + end if + if (allocated(SrcEqMotionQPData%Sd)) then + LB(1:4) = lbound(SrcEqMotionQPData%Sd) + UB(1:4) = ubound(SrcEqMotionQPData%Sd) + if (.not. allocated(DstEqMotionQPData%Sd)) then + allocate(DstEqMotionQPData%Sd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Sd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Sd = SrcEqMotionQPData%Sd + else if (allocated(DstEqMotionQPData%Sd)) then + deallocate(DstEqMotionQPData%Sd) + end if + if (allocated(SrcEqMotionQPData%Xd)) then + LB(1:4) = lbound(SrcEqMotionQPData%Xd) + UB(1:4) = ubound(SrcEqMotionQPData%Xd) + if (.not. allocated(DstEqMotionQPData%Xd)) then + allocate(DstEqMotionQPData%Xd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Xd = SrcEqMotionQPData%Xd + else if (allocated(DstEqMotionQPData%Xd)) then + deallocate(DstEqMotionQPData%Xd) + end if + if (allocated(SrcEqMotionQPData%Yd)) then + LB(1:4) = lbound(SrcEqMotionQPData%Yd) + UB(1:4) = ubound(SrcEqMotionQPData%Yd) + if (.not. allocated(DstEqMotionQPData%Yd)) then + allocate(DstEqMotionQPData%Yd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstEqMotionQPData%Yd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstEqMotionQPData%Yd = SrcEqMotionQPData%Yd + else if (allocated(DstEqMotionQPData%Yd)) then + deallocate(DstEqMotionQPData%Yd) + end if +end subroutine +subroutine BD_DestroyEqMotionQP(EqMotionQPData, ErrStat, ErrMsg) + type(EqMotionQP), intent(inout) :: EqMotionQPData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'BD_DestroyEqMotionQP' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(EqMotionQPData%uuu)) then + deallocate(EqMotionQPData%uuu) + end if + if (allocated(EqMotionQPData%uup)) then + deallocate(EqMotionQPData%uup) + end if + if (allocated(EqMotionQPData%vvv)) then + deallocate(EqMotionQPData%vvv) + end if + if (allocated(EqMotionQPData%vvp)) then + deallocate(EqMotionQPData%vvp) + end if + if (allocated(EqMotionQPData%aaa)) then + deallocate(EqMotionQPData%aaa) + end if + if (allocated(EqMotionQPData%RR0)) then + deallocate(EqMotionQPData%RR0) + end if + if (allocated(EqMotionQPData%kappa)) then + deallocate(EqMotionQPData%kappa) + end if + if (allocated(EqMotionQPData%E1)) then + deallocate(EqMotionQPData%E1) + end if + if (allocated(EqMotionQPData%Stif)) then + deallocate(EqMotionQPData%Stif) + end if + if (allocated(EqMotionQPData%Fb)) then + deallocate(EqMotionQPData%Fb) + end if + if (allocated(EqMotionQPData%Fc)) then + deallocate(EqMotionQPData%Fc) + end if + if (allocated(EqMotionQPData%Fd)) then + deallocate(EqMotionQPData%Fd) + end if + if (allocated(EqMotionQPData%Fg)) then + deallocate(EqMotionQPData%Fg) + end if + if (allocated(EqMotionQPData%Fi)) then + deallocate(EqMotionQPData%Fi) + end if + if (allocated(EqMotionQPData%Ftemp)) then + deallocate(EqMotionQPData%Ftemp) + end if + if (allocated(EqMotionQPData%RR0mEta)) then + deallocate(EqMotionQPData%RR0mEta) + end if + if (allocated(EqMotionQPData%rho)) then + deallocate(EqMotionQPData%rho) + end if + if (allocated(EqMotionQPData%betaC)) then + deallocate(EqMotionQPData%betaC) + end if + if (allocated(EqMotionQPData%Gi)) then + deallocate(EqMotionQPData%Gi) + end if + if (allocated(EqMotionQPData%Ki)) then + deallocate(EqMotionQPData%Ki) + end if + if (allocated(EqMotionQPData%Mi)) then + deallocate(EqMotionQPData%Mi) + end if + if (allocated(EqMotionQPData%Oe)) then + deallocate(EqMotionQPData%Oe) + end if + if (allocated(EqMotionQPData%Pe)) then + deallocate(EqMotionQPData%Pe) + end if + if (allocated(EqMotionQPData%Qe)) then + deallocate(EqMotionQPData%Qe) + end if + if (allocated(EqMotionQPData%Gd)) then + deallocate(EqMotionQPData%Gd) + end if + if (allocated(EqMotionQPData%Od)) then + deallocate(EqMotionQPData%Od) + end if + if (allocated(EqMotionQPData%Pd)) then + deallocate(EqMotionQPData%Pd) + end if + if (allocated(EqMotionQPData%Qd)) then + deallocate(EqMotionQPData%Qd) + end if + if (allocated(EqMotionQPData%Sd)) then + deallocate(EqMotionQPData%Sd) + end if + if (allocated(EqMotionQPData%Xd)) then + deallocate(EqMotionQPData%Xd) + end if + if (allocated(EqMotionQPData%Yd)) then + deallocate(EqMotionQPData%Yd) + end if +end subroutine subroutine BD_PackEqMotionQP(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(EqMotionQP), intent(in) :: InData character(*), parameter :: RoutineName = 'BD_PackEqMotionQP' if (Buf%ErrStat >= AbortErrLev) return - ! uuu call RegPack(Buf, allocated(InData%uuu)) if (allocated(InData%uuu)) then call RegPackBounds(Buf, 3, lbound(InData%uuu), ubound(InData%uuu)) call RegPack(Buf, InData%uuu) end if if (RegCheckErr(Buf, RoutineName)) return - ! uup call RegPack(Buf, allocated(InData%uup)) if (allocated(InData%uup)) then call RegPackBounds(Buf, 3, lbound(InData%uup), ubound(InData%uup)) call RegPack(Buf, InData%uup) end if if (RegCheckErr(Buf, RoutineName)) return - ! vvv call RegPack(Buf, allocated(InData%vvv)) if (allocated(InData%vvv)) then call RegPackBounds(Buf, 3, lbound(InData%vvv), ubound(InData%vvv)) call RegPack(Buf, InData%vvv) end if if (RegCheckErr(Buf, RoutineName)) return - ! vvp call RegPack(Buf, allocated(InData%vvp)) if (allocated(InData%vvp)) then call RegPackBounds(Buf, 3, lbound(InData%vvp), ubound(InData%vvp)) call RegPack(Buf, InData%vvp) end if if (RegCheckErr(Buf, RoutineName)) return - ! aaa call RegPack(Buf, allocated(InData%aaa)) if (allocated(InData%aaa)) then call RegPackBounds(Buf, 3, lbound(InData%aaa), ubound(InData%aaa)) call RegPack(Buf, InData%aaa) end if if (RegCheckErr(Buf, RoutineName)) return - ! RR0 call RegPack(Buf, allocated(InData%RR0)) if (allocated(InData%RR0)) then call RegPackBounds(Buf, 4, lbound(InData%RR0), ubound(InData%RR0)) call RegPack(Buf, InData%RR0) end if if (RegCheckErr(Buf, RoutineName)) return - ! kappa call RegPack(Buf, allocated(InData%kappa)) if (allocated(InData%kappa)) then call RegPackBounds(Buf, 3, lbound(InData%kappa), ubound(InData%kappa)) call RegPack(Buf, InData%kappa) end if if (RegCheckErr(Buf, RoutineName)) return - ! E1 call RegPack(Buf, allocated(InData%E1)) if (allocated(InData%E1)) then call RegPackBounds(Buf, 3, lbound(InData%E1), ubound(InData%E1)) call RegPack(Buf, InData%E1) end if if (RegCheckErr(Buf, RoutineName)) return - ! Stif call RegPack(Buf, allocated(InData%Stif)) if (allocated(InData%Stif)) then call RegPackBounds(Buf, 4, lbound(InData%Stif), ubound(InData%Stif)) call RegPack(Buf, InData%Stif) end if if (RegCheckErr(Buf, RoutineName)) return - ! Fb call RegPack(Buf, allocated(InData%Fb)) if (allocated(InData%Fb)) then call RegPackBounds(Buf, 3, lbound(InData%Fb), ubound(InData%Fb)) call RegPack(Buf, InData%Fb) end if if (RegCheckErr(Buf, RoutineName)) return - ! Fc call RegPack(Buf, allocated(InData%Fc)) if (allocated(InData%Fc)) then call RegPackBounds(Buf, 3, lbound(InData%Fc), ubound(InData%Fc)) call RegPack(Buf, InData%Fc) end if if (RegCheckErr(Buf, RoutineName)) return - ! Fd call RegPack(Buf, allocated(InData%Fd)) if (allocated(InData%Fd)) then call RegPackBounds(Buf, 3, lbound(InData%Fd), ubound(InData%Fd)) call RegPack(Buf, InData%Fd) end if if (RegCheckErr(Buf, RoutineName)) return - ! Fg call RegPack(Buf, allocated(InData%Fg)) if (allocated(InData%Fg)) then call RegPackBounds(Buf, 3, lbound(InData%Fg), ubound(InData%Fg)) call RegPack(Buf, InData%Fg) end if if (RegCheckErr(Buf, RoutineName)) return - ! Fi call RegPack(Buf, allocated(InData%Fi)) if (allocated(InData%Fi)) then call RegPackBounds(Buf, 3, lbound(InData%Fi), ubound(InData%Fi)) call RegPack(Buf, InData%Fi) end if if (RegCheckErr(Buf, RoutineName)) return - ! Ftemp call RegPack(Buf, allocated(InData%Ftemp)) if (allocated(InData%Ftemp)) then call RegPackBounds(Buf, 3, lbound(InData%Ftemp), ubound(InData%Ftemp)) call RegPack(Buf, InData%Ftemp) end if if (RegCheckErr(Buf, RoutineName)) return - ! RR0mEta call RegPack(Buf, allocated(InData%RR0mEta)) if (allocated(InData%RR0mEta)) then call RegPackBounds(Buf, 3, lbound(InData%RR0mEta), ubound(InData%RR0mEta)) call RegPack(Buf, InData%RR0mEta) end if if (RegCheckErr(Buf, RoutineName)) return - ! rho call RegPack(Buf, allocated(InData%rho)) if (allocated(InData%rho)) then call RegPackBounds(Buf, 4, lbound(InData%rho), ubound(InData%rho)) call RegPack(Buf, InData%rho) end if if (RegCheckErr(Buf, RoutineName)) return - ! betaC call RegPack(Buf, allocated(InData%betaC)) if (allocated(InData%betaC)) then call RegPackBounds(Buf, 4, lbound(InData%betaC), ubound(InData%betaC)) call RegPack(Buf, InData%betaC) end if if (RegCheckErr(Buf, RoutineName)) return - ! Gi call RegPack(Buf, allocated(InData%Gi)) if (allocated(InData%Gi)) then call RegPackBounds(Buf, 4, lbound(InData%Gi), ubound(InData%Gi)) call RegPack(Buf, InData%Gi) end if if (RegCheckErr(Buf, RoutineName)) return - ! Ki call RegPack(Buf, allocated(InData%Ki)) if (allocated(InData%Ki)) then call RegPackBounds(Buf, 4, lbound(InData%Ki), ubound(InData%Ki)) call RegPack(Buf, InData%Ki) end if if (RegCheckErr(Buf, RoutineName)) return - ! Mi call RegPack(Buf, allocated(InData%Mi)) if (allocated(InData%Mi)) then call RegPackBounds(Buf, 4, lbound(InData%Mi), ubound(InData%Mi)) call RegPack(Buf, InData%Mi) end if if (RegCheckErr(Buf, RoutineName)) return - ! Oe call RegPack(Buf, allocated(InData%Oe)) if (allocated(InData%Oe)) then call RegPackBounds(Buf, 4, lbound(InData%Oe), ubound(InData%Oe)) call RegPack(Buf, InData%Oe) end if if (RegCheckErr(Buf, RoutineName)) return - ! Pe call RegPack(Buf, allocated(InData%Pe)) if (allocated(InData%Pe)) then call RegPackBounds(Buf, 4, lbound(InData%Pe), ubound(InData%Pe)) call RegPack(Buf, InData%Pe) end if if (RegCheckErr(Buf, RoutineName)) return - ! Qe call RegPack(Buf, allocated(InData%Qe)) if (allocated(InData%Qe)) then call RegPackBounds(Buf, 4, lbound(InData%Qe), ubound(InData%Qe)) call RegPack(Buf, InData%Qe) end if if (RegCheckErr(Buf, RoutineName)) return - ! Gd call RegPack(Buf, allocated(InData%Gd)) if (allocated(InData%Gd)) then call RegPackBounds(Buf, 4, lbound(InData%Gd), ubound(InData%Gd)) call RegPack(Buf, InData%Gd) end if if (RegCheckErr(Buf, RoutineName)) return - ! Od call RegPack(Buf, allocated(InData%Od)) if (allocated(InData%Od)) then call RegPackBounds(Buf, 4, lbound(InData%Od), ubound(InData%Od)) call RegPack(Buf, InData%Od) end if if (RegCheckErr(Buf, RoutineName)) return - ! Pd call RegPack(Buf, allocated(InData%Pd)) if (allocated(InData%Pd)) then call RegPackBounds(Buf, 4, lbound(InData%Pd), ubound(InData%Pd)) call RegPack(Buf, InData%Pd) end if if (RegCheckErr(Buf, RoutineName)) return - ! Qd call RegPack(Buf, allocated(InData%Qd)) if (allocated(InData%Qd)) then call RegPackBounds(Buf, 4, lbound(InData%Qd), ubound(InData%Qd)) call RegPack(Buf, InData%Qd) end if if (RegCheckErr(Buf, RoutineName)) return - ! Sd call RegPack(Buf, allocated(InData%Sd)) if (allocated(InData%Sd)) then call RegPackBounds(Buf, 4, lbound(InData%Sd), ubound(InData%Sd)) call RegPack(Buf, InData%Sd) end if if (RegCheckErr(Buf, RoutineName)) return - ! Xd call RegPack(Buf, allocated(InData%Xd)) if (allocated(InData%Xd)) then call RegPackBounds(Buf, 4, lbound(InData%Xd), ubound(InData%Xd)) call RegPack(Buf, InData%Xd) end if if (RegCheckErr(Buf, RoutineName)) return - ! Yd call RegPack(Buf, allocated(InData%Yd)) if (allocated(InData%Yd)) then call RegPackBounds(Buf, 4, lbound(InData%Yd), ubound(InData%Yd)) @@ -4755,7 +4167,6 @@ subroutine BD_UnPackEqMotionQP(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! uuu if (allocated(OutData%uuu)) deallocate(OutData%uuu) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4770,7 +4181,6 @@ subroutine BD_UnPackEqMotionQP(Buf, OutData) call RegUnpack(Buf, OutData%uuu) if (RegCheckErr(Buf, RoutineName)) return end if - ! uup if (allocated(OutData%uup)) deallocate(OutData%uup) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4785,7 +4195,6 @@ subroutine BD_UnPackEqMotionQP(Buf, OutData) call RegUnpack(Buf, OutData%uup) if (RegCheckErr(Buf, RoutineName)) return end if - ! vvv if (allocated(OutData%vvv)) deallocate(OutData%vvv) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4800,7 +4209,6 @@ subroutine BD_UnPackEqMotionQP(Buf, OutData) call RegUnpack(Buf, OutData%vvv) if (RegCheckErr(Buf, RoutineName)) return end if - ! vvp if (allocated(OutData%vvp)) deallocate(OutData%vvp) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4815,7 +4223,6 @@ subroutine BD_UnPackEqMotionQP(Buf, OutData) call RegUnpack(Buf, OutData%vvp) if (RegCheckErr(Buf, RoutineName)) return end if - ! aaa if (allocated(OutData%aaa)) deallocate(OutData%aaa) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4830,7 +4237,6 @@ subroutine BD_UnPackEqMotionQP(Buf, OutData) call RegUnpack(Buf, OutData%aaa) if (RegCheckErr(Buf, RoutineName)) return end if - ! RR0 if (allocated(OutData%RR0)) deallocate(OutData%RR0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4845,7 +4251,6 @@ subroutine BD_UnPackEqMotionQP(Buf, OutData) call RegUnpack(Buf, OutData%RR0) if (RegCheckErr(Buf, RoutineName)) return end if - ! kappa if (allocated(OutData%kappa)) deallocate(OutData%kappa) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4860,7 +4265,6 @@ subroutine BD_UnPackEqMotionQP(Buf, OutData) call RegUnpack(Buf, OutData%kappa) if (RegCheckErr(Buf, RoutineName)) return end if - ! E1 if (allocated(OutData%E1)) deallocate(OutData%E1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4875,7 +4279,6 @@ subroutine BD_UnPackEqMotionQP(Buf, OutData) call RegUnpack(Buf, OutData%E1) if (RegCheckErr(Buf, RoutineName)) return end if - ! Stif if (allocated(OutData%Stif)) deallocate(OutData%Stif) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4890,7 +4293,6 @@ subroutine BD_UnPackEqMotionQP(Buf, OutData) call RegUnpack(Buf, OutData%Stif) if (RegCheckErr(Buf, RoutineName)) return end if - ! Fb if (allocated(OutData%Fb)) deallocate(OutData%Fb) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4905,7 +4307,6 @@ subroutine BD_UnPackEqMotionQP(Buf, OutData) call RegUnpack(Buf, OutData%Fb) if (RegCheckErr(Buf, RoutineName)) return end if - ! Fc if (allocated(OutData%Fc)) deallocate(OutData%Fc) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4920,7 +4321,6 @@ subroutine BD_UnPackEqMotionQP(Buf, OutData) call RegUnpack(Buf, OutData%Fc) if (RegCheckErr(Buf, RoutineName)) return end if - ! Fd if (allocated(OutData%Fd)) deallocate(OutData%Fd) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4935,7 +4335,6 @@ subroutine BD_UnPackEqMotionQP(Buf, OutData) call RegUnpack(Buf, OutData%Fd) if (RegCheckErr(Buf, RoutineName)) return end if - ! Fg if (allocated(OutData%Fg)) deallocate(OutData%Fg) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4950,7 +4349,6 @@ subroutine BD_UnPackEqMotionQP(Buf, OutData) call RegUnpack(Buf, OutData%Fg) if (RegCheckErr(Buf, RoutineName)) return end if - ! Fi if (allocated(OutData%Fi)) deallocate(OutData%Fi) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4965,7 +4363,6 @@ subroutine BD_UnPackEqMotionQP(Buf, OutData) call RegUnpack(Buf, OutData%Fi) if (RegCheckErr(Buf, RoutineName)) return end if - ! Ftemp if (allocated(OutData%Ftemp)) deallocate(OutData%Ftemp) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4980,7 +4377,6 @@ subroutine BD_UnPackEqMotionQP(Buf, OutData) call RegUnpack(Buf, OutData%Ftemp) if (RegCheckErr(Buf, RoutineName)) return end if - ! RR0mEta if (allocated(OutData%RR0mEta)) deallocate(OutData%RR0mEta) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4995,7 +4391,6 @@ subroutine BD_UnPackEqMotionQP(Buf, OutData) call RegUnpack(Buf, OutData%RR0mEta) if (RegCheckErr(Buf, RoutineName)) return end if - ! rho if (allocated(OutData%rho)) deallocate(OutData%rho) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5010,7 +4405,6 @@ subroutine BD_UnPackEqMotionQP(Buf, OutData) call RegUnpack(Buf, OutData%rho) if (RegCheckErr(Buf, RoutineName)) return end if - ! betaC if (allocated(OutData%betaC)) deallocate(OutData%betaC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5025,7 +4419,6 @@ subroutine BD_UnPackEqMotionQP(Buf, OutData) call RegUnpack(Buf, OutData%betaC) if (RegCheckErr(Buf, RoutineName)) return end if - ! Gi if (allocated(OutData%Gi)) deallocate(OutData%Gi) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5040,7 +4433,6 @@ subroutine BD_UnPackEqMotionQP(Buf, OutData) call RegUnpack(Buf, OutData%Gi) if (RegCheckErr(Buf, RoutineName)) return end if - ! Ki if (allocated(OutData%Ki)) deallocate(OutData%Ki) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5055,7 +4447,6 @@ subroutine BD_UnPackEqMotionQP(Buf, OutData) call RegUnpack(Buf, OutData%Ki) if (RegCheckErr(Buf, RoutineName)) return end if - ! Mi if (allocated(OutData%Mi)) deallocate(OutData%Mi) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5070,7 +4461,6 @@ subroutine BD_UnPackEqMotionQP(Buf, OutData) call RegUnpack(Buf, OutData%Mi) if (RegCheckErr(Buf, RoutineName)) return end if - ! Oe if (allocated(OutData%Oe)) deallocate(OutData%Oe) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5085,7 +4475,6 @@ subroutine BD_UnPackEqMotionQP(Buf, OutData) call RegUnpack(Buf, OutData%Oe) if (RegCheckErr(Buf, RoutineName)) return end if - ! Pe if (allocated(OutData%Pe)) deallocate(OutData%Pe) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5100,7 +4489,6 @@ subroutine BD_UnPackEqMotionQP(Buf, OutData) call RegUnpack(Buf, OutData%Pe) if (RegCheckErr(Buf, RoutineName)) return end if - ! Qe if (allocated(OutData%Qe)) deallocate(OutData%Qe) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5115,7 +4503,6 @@ subroutine BD_UnPackEqMotionQP(Buf, OutData) call RegUnpack(Buf, OutData%Qe) if (RegCheckErr(Buf, RoutineName)) return end if - ! Gd if (allocated(OutData%Gd)) deallocate(OutData%Gd) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5130,7 +4517,6 @@ subroutine BD_UnPackEqMotionQP(Buf, OutData) call RegUnpack(Buf, OutData%Gd) if (RegCheckErr(Buf, RoutineName)) return end if - ! Od if (allocated(OutData%Od)) deallocate(OutData%Od) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5145,7 +4531,6 @@ subroutine BD_UnPackEqMotionQP(Buf, OutData) call RegUnpack(Buf, OutData%Od) if (RegCheckErr(Buf, RoutineName)) return end if - ! Pd if (allocated(OutData%Pd)) deallocate(OutData%Pd) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5160,7 +4545,6 @@ subroutine BD_UnPackEqMotionQP(Buf, OutData) call RegUnpack(Buf, OutData%Pd) if (RegCheckErr(Buf, RoutineName)) return end if - ! Qd if (allocated(OutData%Qd)) deallocate(OutData%Qd) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5175,7 +4559,6 @@ subroutine BD_UnPackEqMotionQP(Buf, OutData) call RegUnpack(Buf, OutData%Qd) if (RegCheckErr(Buf, RoutineName)) return end if - ! Sd if (allocated(OutData%Sd)) deallocate(OutData%Sd) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5190,7 +4573,6 @@ subroutine BD_UnPackEqMotionQP(Buf, OutData) call RegUnpack(Buf, OutData%Sd) if (RegCheckErr(Buf, RoutineName)) return end if - ! Xd if (allocated(OutData%Xd)) deallocate(OutData%Xd) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5205,7 +4587,6 @@ subroutine BD_UnPackEqMotionQP(Buf, OutData) call RegUnpack(Buf, OutData%Xd) if (RegCheckErr(Buf, RoutineName)) return end if - ! Yd if (allocated(OutData%Yd)) deallocate(OutData%Yd) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5221,859 +4602,763 @@ subroutine BD_UnPackEqMotionQP(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE BD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BD_MiscVarType), INTENT(INOUT) :: SrcMiscData - TYPE(BD_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcMiscData%u_DistrLoad_at_y, DstMiscData%u_DistrLoad_at_y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcMiscData%y_BldMotion_at_u, DstMiscData%y_BldMotion_at_u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcMiscData%Map_u_DistrLoad_to_y, DstMiscData%Map_u_DistrLoad_to_y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcMiscData%Map_y_BldMotion_to_u, DstMiscData%Map_y_BldMotion_to_u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstMiscData%Un_Sum = SrcMiscData%Un_Sum - CALL BD_Copyeqmotionqp( SrcMiscData%qp, DstMiscData%qp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMiscData%lin_A)) THEN - i1_l = LBOUND(SrcMiscData%lin_A,1) - i1_u = UBOUND(SrcMiscData%lin_A,1) - i2_l = LBOUND(SrcMiscData%lin_A,2) - i2_u = UBOUND(SrcMiscData%lin_A,2) - IF (.NOT. ALLOCATED(DstMiscData%lin_A)) THEN - ALLOCATE(DstMiscData%lin_A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%lin_A.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%lin_A = SrcMiscData%lin_A -ENDIF -IF (ALLOCATED(SrcMiscData%lin_C)) THEN - i1_l = LBOUND(SrcMiscData%lin_C,1) - i1_u = UBOUND(SrcMiscData%lin_C,1) - i2_l = LBOUND(SrcMiscData%lin_C,2) - i2_u = UBOUND(SrcMiscData%lin_C,2) - IF (.NOT. ALLOCATED(DstMiscData%lin_C)) THEN - ALLOCATE(DstMiscData%lin_C(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%lin_C.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%lin_C = SrcMiscData%lin_C -ENDIF -IF (ALLOCATED(SrcMiscData%Nrrr)) THEN - i1_l = LBOUND(SrcMiscData%Nrrr,1) - i1_u = UBOUND(SrcMiscData%Nrrr,1) - i2_l = LBOUND(SrcMiscData%Nrrr,2) - i2_u = UBOUND(SrcMiscData%Nrrr,2) - i3_l = LBOUND(SrcMiscData%Nrrr,3) - i3_u = UBOUND(SrcMiscData%Nrrr,3) - IF (.NOT. ALLOCATED(DstMiscData%Nrrr)) THEN - ALLOCATE(DstMiscData%Nrrr(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Nrrr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Nrrr = SrcMiscData%Nrrr -ENDIF -IF (ALLOCATED(SrcMiscData%elf)) THEN - i1_l = LBOUND(SrcMiscData%elf,1) - i1_u = UBOUND(SrcMiscData%elf,1) - i2_l = LBOUND(SrcMiscData%elf,2) - i2_u = UBOUND(SrcMiscData%elf,2) - IF (.NOT. ALLOCATED(DstMiscData%elf)) THEN - ALLOCATE(DstMiscData%elf(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%elf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%elf = SrcMiscData%elf -ENDIF -IF (ALLOCATED(SrcMiscData%EFint)) THEN - i1_l = LBOUND(SrcMiscData%EFint,1) - i1_u = UBOUND(SrcMiscData%EFint,1) - i2_l = LBOUND(SrcMiscData%EFint,2) - i2_u = UBOUND(SrcMiscData%EFint,2) - i3_l = LBOUND(SrcMiscData%EFint,3) - i3_u = UBOUND(SrcMiscData%EFint,3) - IF (.NOT. ALLOCATED(DstMiscData%EFint)) THEN - ALLOCATE(DstMiscData%EFint(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%EFint.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%EFint = SrcMiscData%EFint -ENDIF -IF (ALLOCATED(SrcMiscData%elk)) THEN - i1_l = LBOUND(SrcMiscData%elk,1) - i1_u = UBOUND(SrcMiscData%elk,1) - i2_l = LBOUND(SrcMiscData%elk,2) - i2_u = UBOUND(SrcMiscData%elk,2) - i3_l = LBOUND(SrcMiscData%elk,3) - i3_u = UBOUND(SrcMiscData%elk,3) - i4_l = LBOUND(SrcMiscData%elk,4) - i4_u = UBOUND(SrcMiscData%elk,4) - IF (.NOT. ALLOCATED(DstMiscData%elk)) THEN - ALLOCATE(DstMiscData%elk(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%elk.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%elk = SrcMiscData%elk -ENDIF -IF (ALLOCATED(SrcMiscData%elg)) THEN - i1_l = LBOUND(SrcMiscData%elg,1) - i1_u = UBOUND(SrcMiscData%elg,1) - i2_l = LBOUND(SrcMiscData%elg,2) - i2_u = UBOUND(SrcMiscData%elg,2) - i3_l = LBOUND(SrcMiscData%elg,3) - i3_u = UBOUND(SrcMiscData%elg,3) - i4_l = LBOUND(SrcMiscData%elg,4) - i4_u = UBOUND(SrcMiscData%elg,4) - IF (.NOT. ALLOCATED(DstMiscData%elg)) THEN - ALLOCATE(DstMiscData%elg(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%elg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%elg = SrcMiscData%elg -ENDIF -IF (ALLOCATED(SrcMiscData%elm)) THEN - i1_l = LBOUND(SrcMiscData%elm,1) - i1_u = UBOUND(SrcMiscData%elm,1) - i2_l = LBOUND(SrcMiscData%elm,2) - i2_u = UBOUND(SrcMiscData%elm,2) - i3_l = LBOUND(SrcMiscData%elm,3) - i3_u = UBOUND(SrcMiscData%elm,3) - i4_l = LBOUND(SrcMiscData%elm,4) - i4_u = UBOUND(SrcMiscData%elm,4) - IF (.NOT. ALLOCATED(DstMiscData%elm)) THEN - ALLOCATE(DstMiscData%elm(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%elm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%elm = SrcMiscData%elm -ENDIF -IF (ALLOCATED(SrcMiscData%DistrLoad_QP)) THEN - i1_l = LBOUND(SrcMiscData%DistrLoad_QP,1) - i1_u = UBOUND(SrcMiscData%DistrLoad_QP,1) - i2_l = LBOUND(SrcMiscData%DistrLoad_QP,2) - i2_u = UBOUND(SrcMiscData%DistrLoad_QP,2) - i3_l = LBOUND(SrcMiscData%DistrLoad_QP,3) - i3_u = UBOUND(SrcMiscData%DistrLoad_QP,3) - IF (.NOT. ALLOCATED(DstMiscData%DistrLoad_QP)) THEN - ALLOCATE(DstMiscData%DistrLoad_QP(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%DistrLoad_QP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%DistrLoad_QP = SrcMiscData%DistrLoad_QP -ENDIF -IF (ALLOCATED(SrcMiscData%PointLoadLcl)) THEN - i1_l = LBOUND(SrcMiscData%PointLoadLcl,1) - i1_u = UBOUND(SrcMiscData%PointLoadLcl,1) - i2_l = LBOUND(SrcMiscData%PointLoadLcl,2) - i2_u = UBOUND(SrcMiscData%PointLoadLcl,2) - IF (.NOT. ALLOCATED(DstMiscData%PointLoadLcl)) THEN - ALLOCATE(DstMiscData%PointLoadLcl(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%PointLoadLcl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%PointLoadLcl = SrcMiscData%PointLoadLcl -ENDIF -IF (ALLOCATED(SrcMiscData%StifK)) THEN - i1_l = LBOUND(SrcMiscData%StifK,1) - i1_u = UBOUND(SrcMiscData%StifK,1) - i2_l = LBOUND(SrcMiscData%StifK,2) - i2_u = UBOUND(SrcMiscData%StifK,2) - i3_l = LBOUND(SrcMiscData%StifK,3) - i3_u = UBOUND(SrcMiscData%StifK,3) - i4_l = LBOUND(SrcMiscData%StifK,4) - i4_u = UBOUND(SrcMiscData%StifK,4) - IF (.NOT. ALLOCATED(DstMiscData%StifK)) THEN - ALLOCATE(DstMiscData%StifK(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%StifK.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%StifK = SrcMiscData%StifK -ENDIF -IF (ALLOCATED(SrcMiscData%MassM)) THEN - i1_l = LBOUND(SrcMiscData%MassM,1) - i1_u = UBOUND(SrcMiscData%MassM,1) - i2_l = LBOUND(SrcMiscData%MassM,2) - i2_u = UBOUND(SrcMiscData%MassM,2) - i3_l = LBOUND(SrcMiscData%MassM,3) - i3_u = UBOUND(SrcMiscData%MassM,3) - i4_l = LBOUND(SrcMiscData%MassM,4) - i4_u = UBOUND(SrcMiscData%MassM,4) - IF (.NOT. ALLOCATED(DstMiscData%MassM)) THEN - ALLOCATE(DstMiscData%MassM(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%MassM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%MassM = SrcMiscData%MassM -ENDIF -IF (ALLOCATED(SrcMiscData%DampG)) THEN - i1_l = LBOUND(SrcMiscData%DampG,1) - i1_u = UBOUND(SrcMiscData%DampG,1) - i2_l = LBOUND(SrcMiscData%DampG,2) - i2_u = UBOUND(SrcMiscData%DampG,2) - i3_l = LBOUND(SrcMiscData%DampG,3) - i3_u = UBOUND(SrcMiscData%DampG,3) - i4_l = LBOUND(SrcMiscData%DampG,4) - i4_u = UBOUND(SrcMiscData%DampG,4) - IF (.NOT. ALLOCATED(DstMiscData%DampG)) THEN - ALLOCATE(DstMiscData%DampG(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%DampG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%DampG = SrcMiscData%DampG -ENDIF -IF (ALLOCATED(SrcMiscData%StifK_fd)) THEN - i1_l = LBOUND(SrcMiscData%StifK_fd,1) - i1_u = UBOUND(SrcMiscData%StifK_fd,1) - i2_l = LBOUND(SrcMiscData%StifK_fd,2) - i2_u = UBOUND(SrcMiscData%StifK_fd,2) - i3_l = LBOUND(SrcMiscData%StifK_fd,3) - i3_u = UBOUND(SrcMiscData%StifK_fd,3) - i4_l = LBOUND(SrcMiscData%StifK_fd,4) - i4_u = UBOUND(SrcMiscData%StifK_fd,4) - IF (.NOT. ALLOCATED(DstMiscData%StifK_fd)) THEN - ALLOCATE(DstMiscData%StifK_fd(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%StifK_fd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%StifK_fd = SrcMiscData%StifK_fd -ENDIF -IF (ALLOCATED(SrcMiscData%MassM_fd)) THEN - i1_l = LBOUND(SrcMiscData%MassM_fd,1) - i1_u = UBOUND(SrcMiscData%MassM_fd,1) - i2_l = LBOUND(SrcMiscData%MassM_fd,2) - i2_u = UBOUND(SrcMiscData%MassM_fd,2) - i3_l = LBOUND(SrcMiscData%MassM_fd,3) - i3_u = UBOUND(SrcMiscData%MassM_fd,3) - i4_l = LBOUND(SrcMiscData%MassM_fd,4) - i4_u = UBOUND(SrcMiscData%MassM_fd,4) - IF (.NOT. ALLOCATED(DstMiscData%MassM_fd)) THEN - ALLOCATE(DstMiscData%MassM_fd(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%MassM_fd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%MassM_fd = SrcMiscData%MassM_fd -ENDIF -IF (ALLOCATED(SrcMiscData%DampG_fd)) THEN - i1_l = LBOUND(SrcMiscData%DampG_fd,1) - i1_u = UBOUND(SrcMiscData%DampG_fd,1) - i2_l = LBOUND(SrcMiscData%DampG_fd,2) - i2_u = UBOUND(SrcMiscData%DampG_fd,2) - i3_l = LBOUND(SrcMiscData%DampG_fd,3) - i3_u = UBOUND(SrcMiscData%DampG_fd,3) - i4_l = LBOUND(SrcMiscData%DampG_fd,4) - i4_u = UBOUND(SrcMiscData%DampG_fd,4) - IF (.NOT. ALLOCATED(DstMiscData%DampG_fd)) THEN - ALLOCATE(DstMiscData%DampG_fd(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%DampG_fd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%DampG_fd = SrcMiscData%DampG_fd -ENDIF -IF (ALLOCATED(SrcMiscData%RHS)) THEN - i1_l = LBOUND(SrcMiscData%RHS,1) - i1_u = UBOUND(SrcMiscData%RHS,1) - i2_l = LBOUND(SrcMiscData%RHS,2) - i2_u = UBOUND(SrcMiscData%RHS,2) - IF (.NOT. ALLOCATED(DstMiscData%RHS)) THEN - ALLOCATE(DstMiscData%RHS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RHS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%RHS = SrcMiscData%RHS -ENDIF -IF (ALLOCATED(SrcMiscData%RHS_p)) THEN - i1_l = LBOUND(SrcMiscData%RHS_p,1) - i1_u = UBOUND(SrcMiscData%RHS_p,1) - i2_l = LBOUND(SrcMiscData%RHS_p,2) - i2_u = UBOUND(SrcMiscData%RHS_p,2) - IF (.NOT. ALLOCATED(DstMiscData%RHS_p)) THEN - ALLOCATE(DstMiscData%RHS_p(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RHS_p.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%RHS_p = SrcMiscData%RHS_p -ENDIF -IF (ALLOCATED(SrcMiscData%RHS_m)) THEN - i1_l = LBOUND(SrcMiscData%RHS_m,1) - i1_u = UBOUND(SrcMiscData%RHS_m,1) - i2_l = LBOUND(SrcMiscData%RHS_m,2) - i2_u = UBOUND(SrcMiscData%RHS_m,2) - IF (.NOT. ALLOCATED(DstMiscData%RHS_m)) THEN - ALLOCATE(DstMiscData%RHS_m(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RHS_m.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%RHS_m = SrcMiscData%RHS_m -ENDIF -IF (ALLOCATED(SrcMiscData%BldInternalForceFE)) THEN - i1_l = LBOUND(SrcMiscData%BldInternalForceFE,1) - i1_u = UBOUND(SrcMiscData%BldInternalForceFE,1) - i2_l = LBOUND(SrcMiscData%BldInternalForceFE,2) - i2_u = UBOUND(SrcMiscData%BldInternalForceFE,2) - IF (.NOT. ALLOCATED(DstMiscData%BldInternalForceFE)) THEN - ALLOCATE(DstMiscData%BldInternalForceFE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BldInternalForceFE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%BldInternalForceFE = SrcMiscData%BldInternalForceFE -ENDIF -IF (ALLOCATED(SrcMiscData%BldInternalForceQP)) THEN - i1_l = LBOUND(SrcMiscData%BldInternalForceQP,1) - i1_u = UBOUND(SrcMiscData%BldInternalForceQP,1) - i2_l = LBOUND(SrcMiscData%BldInternalForceQP,2) - i2_u = UBOUND(SrcMiscData%BldInternalForceQP,2) - IF (.NOT. ALLOCATED(DstMiscData%BldInternalForceQP)) THEN - ALLOCATE(DstMiscData%BldInternalForceQP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BldInternalForceQP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%BldInternalForceQP = SrcMiscData%BldInternalForceQP -ENDIF -IF (ALLOCATED(SrcMiscData%FirstNodeReactionLclForceMoment)) THEN - i1_l = LBOUND(SrcMiscData%FirstNodeReactionLclForceMoment,1) - i1_u = UBOUND(SrcMiscData%FirstNodeReactionLclForceMoment,1) - IF (.NOT. ALLOCATED(DstMiscData%FirstNodeReactionLclForceMoment)) THEN - ALLOCATE(DstMiscData%FirstNodeReactionLclForceMoment(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FirstNodeReactionLclForceMoment.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%FirstNodeReactionLclForceMoment = SrcMiscData%FirstNodeReactionLclForceMoment -ENDIF -IF (ALLOCATED(SrcMiscData%Solution)) THEN - i1_l = LBOUND(SrcMiscData%Solution,1) - i1_u = UBOUND(SrcMiscData%Solution,1) - i2_l = LBOUND(SrcMiscData%Solution,2) - i2_u = UBOUND(SrcMiscData%Solution,2) - IF (.NOT. ALLOCATED(DstMiscData%Solution)) THEN - ALLOCATE(DstMiscData%Solution(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Solution.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Solution = SrcMiscData%Solution -ENDIF -IF (ALLOCATED(SrcMiscData%LP_StifK)) THEN - i1_l = LBOUND(SrcMiscData%LP_StifK,1) - i1_u = UBOUND(SrcMiscData%LP_StifK,1) - i2_l = LBOUND(SrcMiscData%LP_StifK,2) - i2_u = UBOUND(SrcMiscData%LP_StifK,2) - IF (.NOT. ALLOCATED(DstMiscData%LP_StifK)) THEN - ALLOCATE(DstMiscData%LP_StifK(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LP_StifK.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%LP_StifK = SrcMiscData%LP_StifK -ENDIF -IF (ALLOCATED(SrcMiscData%LP_MassM)) THEN - i1_l = LBOUND(SrcMiscData%LP_MassM,1) - i1_u = UBOUND(SrcMiscData%LP_MassM,1) - i2_l = LBOUND(SrcMiscData%LP_MassM,2) - i2_u = UBOUND(SrcMiscData%LP_MassM,2) - IF (.NOT. ALLOCATED(DstMiscData%LP_MassM)) THEN - ALLOCATE(DstMiscData%LP_MassM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LP_MassM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%LP_MassM = SrcMiscData%LP_MassM -ENDIF -IF (ALLOCATED(SrcMiscData%LP_MassM_LU)) THEN - i1_l = LBOUND(SrcMiscData%LP_MassM_LU,1) - i1_u = UBOUND(SrcMiscData%LP_MassM_LU,1) - i2_l = LBOUND(SrcMiscData%LP_MassM_LU,2) - i2_u = UBOUND(SrcMiscData%LP_MassM_LU,2) - IF (.NOT. ALLOCATED(DstMiscData%LP_MassM_LU)) THEN - ALLOCATE(DstMiscData%LP_MassM_LU(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LP_MassM_LU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%LP_MassM_LU = SrcMiscData%LP_MassM_LU -ENDIF -IF (ALLOCATED(SrcMiscData%LP_RHS)) THEN - i1_l = LBOUND(SrcMiscData%LP_RHS,1) - i1_u = UBOUND(SrcMiscData%LP_RHS,1) - IF (.NOT. ALLOCATED(DstMiscData%LP_RHS)) THEN - ALLOCATE(DstMiscData%LP_RHS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LP_RHS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%LP_RHS = SrcMiscData%LP_RHS -ENDIF -IF (ALLOCATED(SrcMiscData%LP_StifK_LU)) THEN - i1_l = LBOUND(SrcMiscData%LP_StifK_LU,1) - i1_u = UBOUND(SrcMiscData%LP_StifK_LU,1) - i2_l = LBOUND(SrcMiscData%LP_StifK_LU,2) - i2_u = UBOUND(SrcMiscData%LP_StifK_LU,2) - IF (.NOT. ALLOCATED(DstMiscData%LP_StifK_LU)) THEN - ALLOCATE(DstMiscData%LP_StifK_LU(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LP_StifK_LU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%LP_StifK_LU = SrcMiscData%LP_StifK_LU -ENDIF -IF (ALLOCATED(SrcMiscData%LP_RHS_LU)) THEN - i1_l = LBOUND(SrcMiscData%LP_RHS_LU,1) - i1_u = UBOUND(SrcMiscData%LP_RHS_LU,1) - IF (.NOT. ALLOCATED(DstMiscData%LP_RHS_LU)) THEN - ALLOCATE(DstMiscData%LP_RHS_LU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LP_RHS_LU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%LP_RHS_LU = SrcMiscData%LP_RHS_LU -ENDIF -IF (ALLOCATED(SrcMiscData%LP_indx)) THEN - i1_l = LBOUND(SrcMiscData%LP_indx,1) - i1_u = UBOUND(SrcMiscData%LP_indx,1) - IF (.NOT. ALLOCATED(DstMiscData%LP_indx)) THEN - ALLOCATE(DstMiscData%LP_indx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LP_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%LP_indx = SrcMiscData%LP_indx -ENDIF - CALL BD_CopyInput( SrcMiscData%u, DstMiscData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL BD_CopyInput( SrcMiscData%u2, DstMiscData%u2, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE BD_CopyMisc - - SUBROUTINE BD_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(BD_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - CALL MeshDestroy( MiscData%u_DistrLoad_at_y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( MiscData%y_BldMotion_at_u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyMeshMapType( MiscData%Map_u_DistrLoad_to_y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyMeshMapType( MiscData%Map_y_BldMotion_to_u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL BD_DestroyEqMotionQP( MiscData%qp, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MiscData%lin_A)) THEN - DEALLOCATE(MiscData%lin_A) -ENDIF -IF (ALLOCATED(MiscData%lin_C)) THEN - DEALLOCATE(MiscData%lin_C) -ENDIF -IF (ALLOCATED(MiscData%Nrrr)) THEN - DEALLOCATE(MiscData%Nrrr) -ENDIF -IF (ALLOCATED(MiscData%elf)) THEN - DEALLOCATE(MiscData%elf) -ENDIF -IF (ALLOCATED(MiscData%EFint)) THEN - DEALLOCATE(MiscData%EFint) -ENDIF -IF (ALLOCATED(MiscData%elk)) THEN - DEALLOCATE(MiscData%elk) -ENDIF -IF (ALLOCATED(MiscData%elg)) THEN - DEALLOCATE(MiscData%elg) -ENDIF -IF (ALLOCATED(MiscData%elm)) THEN - DEALLOCATE(MiscData%elm) -ENDIF -IF (ALLOCATED(MiscData%DistrLoad_QP)) THEN - DEALLOCATE(MiscData%DistrLoad_QP) -ENDIF -IF (ALLOCATED(MiscData%PointLoadLcl)) THEN - DEALLOCATE(MiscData%PointLoadLcl) -ENDIF -IF (ALLOCATED(MiscData%StifK)) THEN - DEALLOCATE(MiscData%StifK) -ENDIF -IF (ALLOCATED(MiscData%MassM)) THEN - DEALLOCATE(MiscData%MassM) -ENDIF -IF (ALLOCATED(MiscData%DampG)) THEN - DEALLOCATE(MiscData%DampG) -ENDIF -IF (ALLOCATED(MiscData%StifK_fd)) THEN - DEALLOCATE(MiscData%StifK_fd) -ENDIF -IF (ALLOCATED(MiscData%MassM_fd)) THEN - DEALLOCATE(MiscData%MassM_fd) -ENDIF -IF (ALLOCATED(MiscData%DampG_fd)) THEN - DEALLOCATE(MiscData%DampG_fd) -ENDIF -IF (ALLOCATED(MiscData%RHS)) THEN - DEALLOCATE(MiscData%RHS) -ENDIF -IF (ALLOCATED(MiscData%RHS_p)) THEN - DEALLOCATE(MiscData%RHS_p) -ENDIF -IF (ALLOCATED(MiscData%RHS_m)) THEN - DEALLOCATE(MiscData%RHS_m) -ENDIF -IF (ALLOCATED(MiscData%BldInternalForceFE)) THEN - DEALLOCATE(MiscData%BldInternalForceFE) -ENDIF -IF (ALLOCATED(MiscData%BldInternalForceQP)) THEN - DEALLOCATE(MiscData%BldInternalForceQP) -ENDIF -IF (ALLOCATED(MiscData%FirstNodeReactionLclForceMoment)) THEN - DEALLOCATE(MiscData%FirstNodeReactionLclForceMoment) -ENDIF -IF (ALLOCATED(MiscData%Solution)) THEN - DEALLOCATE(MiscData%Solution) -ENDIF -IF (ALLOCATED(MiscData%LP_StifK)) THEN - DEALLOCATE(MiscData%LP_StifK) -ENDIF -IF (ALLOCATED(MiscData%LP_MassM)) THEN - DEALLOCATE(MiscData%LP_MassM) -ENDIF -IF (ALLOCATED(MiscData%LP_MassM_LU)) THEN - DEALLOCATE(MiscData%LP_MassM_LU) -ENDIF -IF (ALLOCATED(MiscData%LP_RHS)) THEN - DEALLOCATE(MiscData%LP_RHS) -ENDIF -IF (ALLOCATED(MiscData%LP_StifK_LU)) THEN - DEALLOCATE(MiscData%LP_StifK_LU) -ENDIF -IF (ALLOCATED(MiscData%LP_RHS_LU)) THEN - DEALLOCATE(MiscData%LP_RHS_LU) -ENDIF -IF (ALLOCATED(MiscData%LP_indx)) THEN - DEALLOCATE(MiscData%LP_indx) -ENDIF - CALL BD_DestroyInput( MiscData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL BD_DestroyInput( MiscData%u2, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE BD_DestroyMisc +subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(BD_MiscVarType), intent(inout) :: SrcMiscData + type(BD_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BD_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcMiscData%u_DistrLoad_at_y, DstMiscData%u_DistrLoad_at_y, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcMiscData%y_BldMotion_at_u, DstMiscData%y_BldMotion_at_u, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcMiscData%Map_u_DistrLoad_to_y, DstMiscData%Map_u_DistrLoad_to_y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcMiscData%Map_y_BldMotion_to_u, DstMiscData%Map_y_BldMotion_to_u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstMiscData%Un_Sum = SrcMiscData%Un_Sum + call BD_CopyEqMotionQP(SrcMiscData%qp, DstMiscData%qp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMiscData%lin_A)) then + LB(1:2) = lbound(SrcMiscData%lin_A) + UB(1:2) = ubound(SrcMiscData%lin_A) + if (.not. allocated(DstMiscData%lin_A)) then + allocate(DstMiscData%lin_A(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%lin_A.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%lin_A = SrcMiscData%lin_A + else if (allocated(DstMiscData%lin_A)) then + deallocate(DstMiscData%lin_A) + end if + if (allocated(SrcMiscData%lin_C)) then + LB(1:2) = lbound(SrcMiscData%lin_C) + UB(1:2) = ubound(SrcMiscData%lin_C) + if (.not. allocated(DstMiscData%lin_C)) then + allocate(DstMiscData%lin_C(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%lin_C.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%lin_C = SrcMiscData%lin_C + else if (allocated(DstMiscData%lin_C)) then + deallocate(DstMiscData%lin_C) + end if + if (allocated(SrcMiscData%Nrrr)) then + LB(1:3) = lbound(SrcMiscData%Nrrr) + UB(1:3) = ubound(SrcMiscData%Nrrr) + if (.not. allocated(DstMiscData%Nrrr)) then + allocate(DstMiscData%Nrrr(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Nrrr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Nrrr = SrcMiscData%Nrrr + else if (allocated(DstMiscData%Nrrr)) then + deallocate(DstMiscData%Nrrr) + end if + if (allocated(SrcMiscData%elf)) then + LB(1:2) = lbound(SrcMiscData%elf) + UB(1:2) = ubound(SrcMiscData%elf) + if (.not. allocated(DstMiscData%elf)) then + allocate(DstMiscData%elf(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%elf.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%elf = SrcMiscData%elf + else if (allocated(DstMiscData%elf)) then + deallocate(DstMiscData%elf) + end if + if (allocated(SrcMiscData%EFint)) then + LB(1:3) = lbound(SrcMiscData%EFint) + UB(1:3) = ubound(SrcMiscData%EFint) + if (.not. allocated(DstMiscData%EFint)) then + allocate(DstMiscData%EFint(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%EFint.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%EFint = SrcMiscData%EFint + else if (allocated(DstMiscData%EFint)) then + deallocate(DstMiscData%EFint) + end if + if (allocated(SrcMiscData%elk)) then + LB(1:4) = lbound(SrcMiscData%elk) + UB(1:4) = ubound(SrcMiscData%elk) + if (.not. allocated(DstMiscData%elk)) then + allocate(DstMiscData%elk(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%elk.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%elk = SrcMiscData%elk + else if (allocated(DstMiscData%elk)) then + deallocate(DstMiscData%elk) + end if + if (allocated(SrcMiscData%elg)) then + LB(1:4) = lbound(SrcMiscData%elg) + UB(1:4) = ubound(SrcMiscData%elg) + if (.not. allocated(DstMiscData%elg)) then + allocate(DstMiscData%elg(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%elg.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%elg = SrcMiscData%elg + else if (allocated(DstMiscData%elg)) then + deallocate(DstMiscData%elg) + end if + if (allocated(SrcMiscData%elm)) then + LB(1:4) = lbound(SrcMiscData%elm) + UB(1:4) = ubound(SrcMiscData%elm) + if (.not. allocated(DstMiscData%elm)) then + allocate(DstMiscData%elm(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%elm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%elm = SrcMiscData%elm + else if (allocated(DstMiscData%elm)) then + deallocate(DstMiscData%elm) + end if + if (allocated(SrcMiscData%DistrLoad_QP)) then + LB(1:3) = lbound(SrcMiscData%DistrLoad_QP) + UB(1:3) = ubound(SrcMiscData%DistrLoad_QP) + if (.not. allocated(DstMiscData%DistrLoad_QP)) then + allocate(DstMiscData%DistrLoad_QP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%DistrLoad_QP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%DistrLoad_QP = SrcMiscData%DistrLoad_QP + else if (allocated(DstMiscData%DistrLoad_QP)) then + deallocate(DstMiscData%DistrLoad_QP) + end if + if (allocated(SrcMiscData%PointLoadLcl)) then + LB(1:2) = lbound(SrcMiscData%PointLoadLcl) + UB(1:2) = ubound(SrcMiscData%PointLoadLcl) + if (.not. allocated(DstMiscData%PointLoadLcl)) then + allocate(DstMiscData%PointLoadLcl(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%PointLoadLcl.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%PointLoadLcl = SrcMiscData%PointLoadLcl + else if (allocated(DstMiscData%PointLoadLcl)) then + deallocate(DstMiscData%PointLoadLcl) + end if + if (allocated(SrcMiscData%StifK)) then + LB(1:4) = lbound(SrcMiscData%StifK) + UB(1:4) = ubound(SrcMiscData%StifK) + if (.not. allocated(DstMiscData%StifK)) then + allocate(DstMiscData%StifK(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%StifK.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%StifK = SrcMiscData%StifK + else if (allocated(DstMiscData%StifK)) then + deallocate(DstMiscData%StifK) + end if + if (allocated(SrcMiscData%MassM)) then + LB(1:4) = lbound(SrcMiscData%MassM) + UB(1:4) = ubound(SrcMiscData%MassM) + if (.not. allocated(DstMiscData%MassM)) then + allocate(DstMiscData%MassM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%MassM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%MassM = SrcMiscData%MassM + else if (allocated(DstMiscData%MassM)) then + deallocate(DstMiscData%MassM) + end if + if (allocated(SrcMiscData%DampG)) then + LB(1:4) = lbound(SrcMiscData%DampG) + UB(1:4) = ubound(SrcMiscData%DampG) + if (.not. allocated(DstMiscData%DampG)) then + allocate(DstMiscData%DampG(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%DampG.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%DampG = SrcMiscData%DampG + else if (allocated(DstMiscData%DampG)) then + deallocate(DstMiscData%DampG) + end if + if (allocated(SrcMiscData%StifK_fd)) then + LB(1:4) = lbound(SrcMiscData%StifK_fd) + UB(1:4) = ubound(SrcMiscData%StifK_fd) + if (.not. allocated(DstMiscData%StifK_fd)) then + allocate(DstMiscData%StifK_fd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%StifK_fd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%StifK_fd = SrcMiscData%StifK_fd + else if (allocated(DstMiscData%StifK_fd)) then + deallocate(DstMiscData%StifK_fd) + end if + if (allocated(SrcMiscData%MassM_fd)) then + LB(1:4) = lbound(SrcMiscData%MassM_fd) + UB(1:4) = ubound(SrcMiscData%MassM_fd) + if (.not. allocated(DstMiscData%MassM_fd)) then + allocate(DstMiscData%MassM_fd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%MassM_fd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%MassM_fd = SrcMiscData%MassM_fd + else if (allocated(DstMiscData%MassM_fd)) then + deallocate(DstMiscData%MassM_fd) + end if + if (allocated(SrcMiscData%DampG_fd)) then + LB(1:4) = lbound(SrcMiscData%DampG_fd) + UB(1:4) = ubound(SrcMiscData%DampG_fd) + if (.not. allocated(DstMiscData%DampG_fd)) then + allocate(DstMiscData%DampG_fd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%DampG_fd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%DampG_fd = SrcMiscData%DampG_fd + else if (allocated(DstMiscData%DampG_fd)) then + deallocate(DstMiscData%DampG_fd) + end if + if (allocated(SrcMiscData%RHS)) then + LB(1:2) = lbound(SrcMiscData%RHS) + UB(1:2) = ubound(SrcMiscData%RHS) + if (.not. allocated(DstMiscData%RHS)) then + allocate(DstMiscData%RHS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RHS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%RHS = SrcMiscData%RHS + else if (allocated(DstMiscData%RHS)) then + deallocate(DstMiscData%RHS) + end if + if (allocated(SrcMiscData%RHS_p)) then + LB(1:2) = lbound(SrcMiscData%RHS_p) + UB(1:2) = ubound(SrcMiscData%RHS_p) + if (.not. allocated(DstMiscData%RHS_p)) then + allocate(DstMiscData%RHS_p(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RHS_p.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%RHS_p = SrcMiscData%RHS_p + else if (allocated(DstMiscData%RHS_p)) then + deallocate(DstMiscData%RHS_p) + end if + if (allocated(SrcMiscData%RHS_m)) then + LB(1:2) = lbound(SrcMiscData%RHS_m) + UB(1:2) = ubound(SrcMiscData%RHS_m) + if (.not. allocated(DstMiscData%RHS_m)) then + allocate(DstMiscData%RHS_m(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RHS_m.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%RHS_m = SrcMiscData%RHS_m + else if (allocated(DstMiscData%RHS_m)) then + deallocate(DstMiscData%RHS_m) + end if + if (allocated(SrcMiscData%BldInternalForceFE)) then + LB(1:2) = lbound(SrcMiscData%BldInternalForceFE) + UB(1:2) = ubound(SrcMiscData%BldInternalForceFE) + if (.not. allocated(DstMiscData%BldInternalForceFE)) then + allocate(DstMiscData%BldInternalForceFE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BldInternalForceFE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%BldInternalForceFE = SrcMiscData%BldInternalForceFE + else if (allocated(DstMiscData%BldInternalForceFE)) then + deallocate(DstMiscData%BldInternalForceFE) + end if + if (allocated(SrcMiscData%BldInternalForceQP)) then + LB(1:2) = lbound(SrcMiscData%BldInternalForceQP) + UB(1:2) = ubound(SrcMiscData%BldInternalForceQP) + if (.not. allocated(DstMiscData%BldInternalForceQP)) then + allocate(DstMiscData%BldInternalForceQP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BldInternalForceQP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%BldInternalForceQP = SrcMiscData%BldInternalForceQP + else if (allocated(DstMiscData%BldInternalForceQP)) then + deallocate(DstMiscData%BldInternalForceQP) + end if + if (allocated(SrcMiscData%FirstNodeReactionLclForceMoment)) then + LB(1:1) = lbound(SrcMiscData%FirstNodeReactionLclForceMoment) + UB(1:1) = ubound(SrcMiscData%FirstNodeReactionLclForceMoment) + if (.not. allocated(DstMiscData%FirstNodeReactionLclForceMoment)) then + allocate(DstMiscData%FirstNodeReactionLclForceMoment(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FirstNodeReactionLclForceMoment.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%FirstNodeReactionLclForceMoment = SrcMiscData%FirstNodeReactionLclForceMoment + else if (allocated(DstMiscData%FirstNodeReactionLclForceMoment)) then + deallocate(DstMiscData%FirstNodeReactionLclForceMoment) + end if + if (allocated(SrcMiscData%Solution)) then + LB(1:2) = lbound(SrcMiscData%Solution) + UB(1:2) = ubound(SrcMiscData%Solution) + if (.not. allocated(DstMiscData%Solution)) then + allocate(DstMiscData%Solution(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Solution.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Solution = SrcMiscData%Solution + else if (allocated(DstMiscData%Solution)) then + deallocate(DstMiscData%Solution) + end if + if (allocated(SrcMiscData%LP_StifK)) then + LB(1:2) = lbound(SrcMiscData%LP_StifK) + UB(1:2) = ubound(SrcMiscData%LP_StifK) + if (.not. allocated(DstMiscData%LP_StifK)) then + allocate(DstMiscData%LP_StifK(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LP_StifK.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%LP_StifK = SrcMiscData%LP_StifK + else if (allocated(DstMiscData%LP_StifK)) then + deallocate(DstMiscData%LP_StifK) + end if + if (allocated(SrcMiscData%LP_MassM)) then + LB(1:2) = lbound(SrcMiscData%LP_MassM) + UB(1:2) = ubound(SrcMiscData%LP_MassM) + if (.not. allocated(DstMiscData%LP_MassM)) then + allocate(DstMiscData%LP_MassM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LP_MassM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%LP_MassM = SrcMiscData%LP_MassM + else if (allocated(DstMiscData%LP_MassM)) then + deallocate(DstMiscData%LP_MassM) + end if + if (allocated(SrcMiscData%LP_MassM_LU)) then + LB(1:2) = lbound(SrcMiscData%LP_MassM_LU) + UB(1:2) = ubound(SrcMiscData%LP_MassM_LU) + if (.not. allocated(DstMiscData%LP_MassM_LU)) then + allocate(DstMiscData%LP_MassM_LU(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LP_MassM_LU.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%LP_MassM_LU = SrcMiscData%LP_MassM_LU + else if (allocated(DstMiscData%LP_MassM_LU)) then + deallocate(DstMiscData%LP_MassM_LU) + end if + if (allocated(SrcMiscData%LP_RHS)) then + LB(1:1) = lbound(SrcMiscData%LP_RHS) + UB(1:1) = ubound(SrcMiscData%LP_RHS) + if (.not. allocated(DstMiscData%LP_RHS)) then + allocate(DstMiscData%LP_RHS(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LP_RHS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%LP_RHS = SrcMiscData%LP_RHS + else if (allocated(DstMiscData%LP_RHS)) then + deallocate(DstMiscData%LP_RHS) + end if + if (allocated(SrcMiscData%LP_StifK_LU)) then + LB(1:2) = lbound(SrcMiscData%LP_StifK_LU) + UB(1:2) = ubound(SrcMiscData%LP_StifK_LU) + if (.not. allocated(DstMiscData%LP_StifK_LU)) then + allocate(DstMiscData%LP_StifK_LU(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LP_StifK_LU.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%LP_StifK_LU = SrcMiscData%LP_StifK_LU + else if (allocated(DstMiscData%LP_StifK_LU)) then + deallocate(DstMiscData%LP_StifK_LU) + end if + if (allocated(SrcMiscData%LP_RHS_LU)) then + LB(1:1) = lbound(SrcMiscData%LP_RHS_LU) + UB(1:1) = ubound(SrcMiscData%LP_RHS_LU) + if (.not. allocated(DstMiscData%LP_RHS_LU)) then + allocate(DstMiscData%LP_RHS_LU(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LP_RHS_LU.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%LP_RHS_LU = SrcMiscData%LP_RHS_LU + else if (allocated(DstMiscData%LP_RHS_LU)) then + deallocate(DstMiscData%LP_RHS_LU) + end if + if (allocated(SrcMiscData%LP_indx)) then + LB(1:1) = lbound(SrcMiscData%LP_indx) + UB(1:1) = ubound(SrcMiscData%LP_indx) + if (.not. allocated(DstMiscData%LP_indx)) then + allocate(DstMiscData%LP_indx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LP_indx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%LP_indx = SrcMiscData%LP_indx + else if (allocated(DstMiscData%LP_indx)) then + deallocate(DstMiscData%LP_indx) + end if + call BD_CopyInput(SrcMiscData%u, DstMiscData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call BD_CopyInput(SrcMiscData%u2, DstMiscData%u2, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine BD_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(BD_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'BD_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%lin_A)) then + deallocate(MiscData%lin_A) + end if + if (allocated(MiscData%lin_C)) then + deallocate(MiscData%lin_C) + end if + if (allocated(MiscData%Nrrr)) then + deallocate(MiscData%Nrrr) + end if + if (allocated(MiscData%elf)) then + deallocate(MiscData%elf) + end if + if (allocated(MiscData%EFint)) then + deallocate(MiscData%EFint) + end if + if (allocated(MiscData%elk)) then + deallocate(MiscData%elk) + end if + if (allocated(MiscData%elg)) then + deallocate(MiscData%elg) + end if + if (allocated(MiscData%elm)) then + deallocate(MiscData%elm) + end if + if (allocated(MiscData%DistrLoad_QP)) then + deallocate(MiscData%DistrLoad_QP) + end if + if (allocated(MiscData%PointLoadLcl)) then + deallocate(MiscData%PointLoadLcl) + end if + if (allocated(MiscData%StifK)) then + deallocate(MiscData%StifK) + end if + if (allocated(MiscData%MassM)) then + deallocate(MiscData%MassM) + end if + if (allocated(MiscData%DampG)) then + deallocate(MiscData%DampG) + end if + if (allocated(MiscData%StifK_fd)) then + deallocate(MiscData%StifK_fd) + end if + if (allocated(MiscData%MassM_fd)) then + deallocate(MiscData%MassM_fd) + end if + if (allocated(MiscData%DampG_fd)) then + deallocate(MiscData%DampG_fd) + end if + if (allocated(MiscData%RHS)) then + deallocate(MiscData%RHS) + end if + if (allocated(MiscData%RHS_p)) then + deallocate(MiscData%RHS_p) + end if + if (allocated(MiscData%RHS_m)) then + deallocate(MiscData%RHS_m) + end if + if (allocated(MiscData%BldInternalForceFE)) then + deallocate(MiscData%BldInternalForceFE) + end if + if (allocated(MiscData%BldInternalForceQP)) then + deallocate(MiscData%BldInternalForceQP) + end if + if (allocated(MiscData%FirstNodeReactionLclForceMoment)) then + deallocate(MiscData%FirstNodeReactionLclForceMoment) + end if + if (allocated(MiscData%Solution)) then + deallocate(MiscData%Solution) + end if + if (allocated(MiscData%LP_StifK)) then + deallocate(MiscData%LP_StifK) + end if + if (allocated(MiscData%LP_MassM)) then + deallocate(MiscData%LP_MassM) + end if + if (allocated(MiscData%LP_MassM_LU)) then + deallocate(MiscData%LP_MassM_LU) + end if + if (allocated(MiscData%LP_RHS)) then + deallocate(MiscData%LP_RHS) + end if + if (allocated(MiscData%LP_StifK_LU)) then + deallocate(MiscData%LP_StifK_LU) + end if + if (allocated(MiscData%LP_RHS_LU)) then + deallocate(MiscData%LP_RHS_LU) + end if + if (allocated(MiscData%LP_indx)) then + deallocate(MiscData%LP_indx) + end if +end subroutine subroutine BD_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(BD_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'BD_PackMisc' if (Buf%ErrStat >= AbortErrLev) return - ! u_DistrLoad_at_y call MeshPack(Buf, InData%u_DistrLoad_at_y) if (RegCheckErr(Buf, RoutineName)) return - ! y_BldMotion_at_u call MeshPack(Buf, InData%y_BldMotion_at_u) if (RegCheckErr(Buf, RoutineName)) return - ! Map_u_DistrLoad_to_y call NWTC_Library_PackMeshMapType(Buf, InData%Map_u_DistrLoad_to_y) if (RegCheckErr(Buf, RoutineName)) return - ! Map_y_BldMotion_to_u call NWTC_Library_PackMeshMapType(Buf, InData%Map_y_BldMotion_to_u) if (RegCheckErr(Buf, RoutineName)) return - ! Un_Sum call RegPack(Buf, InData%Un_Sum) if (RegCheckErr(Buf, RoutineName)) return - ! qp call BD_PackEqMotionQP(Buf, InData%qp) if (RegCheckErr(Buf, RoutineName)) return - ! lin_A call RegPack(Buf, allocated(InData%lin_A)) if (allocated(InData%lin_A)) then call RegPackBounds(Buf, 2, lbound(InData%lin_A), ubound(InData%lin_A)) call RegPack(Buf, InData%lin_A) end if if (RegCheckErr(Buf, RoutineName)) return - ! lin_C call RegPack(Buf, allocated(InData%lin_C)) if (allocated(InData%lin_C)) then call RegPackBounds(Buf, 2, lbound(InData%lin_C), ubound(InData%lin_C)) call RegPack(Buf, InData%lin_C) end if if (RegCheckErr(Buf, RoutineName)) return - ! Nrrr call RegPack(Buf, allocated(InData%Nrrr)) if (allocated(InData%Nrrr)) then call RegPackBounds(Buf, 3, lbound(InData%Nrrr), ubound(InData%Nrrr)) call RegPack(Buf, InData%Nrrr) end if if (RegCheckErr(Buf, RoutineName)) return - ! elf call RegPack(Buf, allocated(InData%elf)) if (allocated(InData%elf)) then call RegPackBounds(Buf, 2, lbound(InData%elf), ubound(InData%elf)) call RegPack(Buf, InData%elf) end if if (RegCheckErr(Buf, RoutineName)) return - ! EFint call RegPack(Buf, allocated(InData%EFint)) if (allocated(InData%EFint)) then call RegPackBounds(Buf, 3, lbound(InData%EFint), ubound(InData%EFint)) call RegPack(Buf, InData%EFint) end if if (RegCheckErr(Buf, RoutineName)) return - ! elk call RegPack(Buf, allocated(InData%elk)) if (allocated(InData%elk)) then call RegPackBounds(Buf, 4, lbound(InData%elk), ubound(InData%elk)) call RegPack(Buf, InData%elk) end if if (RegCheckErr(Buf, RoutineName)) return - ! elg call RegPack(Buf, allocated(InData%elg)) if (allocated(InData%elg)) then call RegPackBounds(Buf, 4, lbound(InData%elg), ubound(InData%elg)) call RegPack(Buf, InData%elg) end if if (RegCheckErr(Buf, RoutineName)) return - ! elm call RegPack(Buf, allocated(InData%elm)) if (allocated(InData%elm)) then call RegPackBounds(Buf, 4, lbound(InData%elm), ubound(InData%elm)) call RegPack(Buf, InData%elm) end if if (RegCheckErr(Buf, RoutineName)) return - ! DistrLoad_QP call RegPack(Buf, allocated(InData%DistrLoad_QP)) if (allocated(InData%DistrLoad_QP)) then call RegPackBounds(Buf, 3, lbound(InData%DistrLoad_QP), ubound(InData%DistrLoad_QP)) call RegPack(Buf, InData%DistrLoad_QP) end if if (RegCheckErr(Buf, RoutineName)) return - ! PointLoadLcl call RegPack(Buf, allocated(InData%PointLoadLcl)) if (allocated(InData%PointLoadLcl)) then call RegPackBounds(Buf, 2, lbound(InData%PointLoadLcl), ubound(InData%PointLoadLcl)) call RegPack(Buf, InData%PointLoadLcl) end if if (RegCheckErr(Buf, RoutineName)) return - ! StifK call RegPack(Buf, allocated(InData%StifK)) if (allocated(InData%StifK)) then call RegPackBounds(Buf, 4, lbound(InData%StifK), ubound(InData%StifK)) call RegPack(Buf, InData%StifK) end if if (RegCheckErr(Buf, RoutineName)) return - ! MassM call RegPack(Buf, allocated(InData%MassM)) if (allocated(InData%MassM)) then call RegPackBounds(Buf, 4, lbound(InData%MassM), ubound(InData%MassM)) call RegPack(Buf, InData%MassM) end if if (RegCheckErr(Buf, RoutineName)) return - ! DampG call RegPack(Buf, allocated(InData%DampG)) if (allocated(InData%DampG)) then call RegPackBounds(Buf, 4, lbound(InData%DampG), ubound(InData%DampG)) call RegPack(Buf, InData%DampG) end if if (RegCheckErr(Buf, RoutineName)) return - ! StifK_fd call RegPack(Buf, allocated(InData%StifK_fd)) if (allocated(InData%StifK_fd)) then call RegPackBounds(Buf, 4, lbound(InData%StifK_fd), ubound(InData%StifK_fd)) call RegPack(Buf, InData%StifK_fd) end if if (RegCheckErr(Buf, RoutineName)) return - ! MassM_fd call RegPack(Buf, allocated(InData%MassM_fd)) if (allocated(InData%MassM_fd)) then call RegPackBounds(Buf, 4, lbound(InData%MassM_fd), ubound(InData%MassM_fd)) call RegPack(Buf, InData%MassM_fd) end if if (RegCheckErr(Buf, RoutineName)) return - ! DampG_fd call RegPack(Buf, allocated(InData%DampG_fd)) if (allocated(InData%DampG_fd)) then call RegPackBounds(Buf, 4, lbound(InData%DampG_fd), ubound(InData%DampG_fd)) call RegPack(Buf, InData%DampG_fd) end if if (RegCheckErr(Buf, RoutineName)) return - ! RHS call RegPack(Buf, allocated(InData%RHS)) if (allocated(InData%RHS)) then call RegPackBounds(Buf, 2, lbound(InData%RHS), ubound(InData%RHS)) call RegPack(Buf, InData%RHS) end if if (RegCheckErr(Buf, RoutineName)) return - ! RHS_p call RegPack(Buf, allocated(InData%RHS_p)) if (allocated(InData%RHS_p)) then call RegPackBounds(Buf, 2, lbound(InData%RHS_p), ubound(InData%RHS_p)) call RegPack(Buf, InData%RHS_p) end if if (RegCheckErr(Buf, RoutineName)) return - ! RHS_m call RegPack(Buf, allocated(InData%RHS_m)) if (allocated(InData%RHS_m)) then call RegPackBounds(Buf, 2, lbound(InData%RHS_m), ubound(InData%RHS_m)) call RegPack(Buf, InData%RHS_m) end if if (RegCheckErr(Buf, RoutineName)) return - ! BldInternalForceFE call RegPack(Buf, allocated(InData%BldInternalForceFE)) if (allocated(InData%BldInternalForceFE)) then call RegPackBounds(Buf, 2, lbound(InData%BldInternalForceFE), ubound(InData%BldInternalForceFE)) call RegPack(Buf, InData%BldInternalForceFE) end if if (RegCheckErr(Buf, RoutineName)) return - ! BldInternalForceQP call RegPack(Buf, allocated(InData%BldInternalForceQP)) if (allocated(InData%BldInternalForceQP)) then call RegPackBounds(Buf, 2, lbound(InData%BldInternalForceQP), ubound(InData%BldInternalForceQP)) call RegPack(Buf, InData%BldInternalForceQP) end if if (RegCheckErr(Buf, RoutineName)) return - ! FirstNodeReactionLclForceMoment call RegPack(Buf, allocated(InData%FirstNodeReactionLclForceMoment)) if (allocated(InData%FirstNodeReactionLclForceMoment)) then call RegPackBounds(Buf, 1, lbound(InData%FirstNodeReactionLclForceMoment), ubound(InData%FirstNodeReactionLclForceMoment)) call RegPack(Buf, InData%FirstNodeReactionLclForceMoment) end if if (RegCheckErr(Buf, RoutineName)) return - ! Solution call RegPack(Buf, allocated(InData%Solution)) if (allocated(InData%Solution)) then call RegPackBounds(Buf, 2, lbound(InData%Solution), ubound(InData%Solution)) call RegPack(Buf, InData%Solution) end if if (RegCheckErr(Buf, RoutineName)) return - ! LP_StifK call RegPack(Buf, allocated(InData%LP_StifK)) if (allocated(InData%LP_StifK)) then call RegPackBounds(Buf, 2, lbound(InData%LP_StifK), ubound(InData%LP_StifK)) call RegPack(Buf, InData%LP_StifK) end if if (RegCheckErr(Buf, RoutineName)) return - ! LP_MassM call RegPack(Buf, allocated(InData%LP_MassM)) if (allocated(InData%LP_MassM)) then call RegPackBounds(Buf, 2, lbound(InData%LP_MassM), ubound(InData%LP_MassM)) call RegPack(Buf, InData%LP_MassM) end if if (RegCheckErr(Buf, RoutineName)) return - ! LP_MassM_LU call RegPack(Buf, allocated(InData%LP_MassM_LU)) if (allocated(InData%LP_MassM_LU)) then call RegPackBounds(Buf, 2, lbound(InData%LP_MassM_LU), ubound(InData%LP_MassM_LU)) call RegPack(Buf, InData%LP_MassM_LU) end if if (RegCheckErr(Buf, RoutineName)) return - ! LP_RHS call RegPack(Buf, allocated(InData%LP_RHS)) if (allocated(InData%LP_RHS)) then call RegPackBounds(Buf, 1, lbound(InData%LP_RHS), ubound(InData%LP_RHS)) call RegPack(Buf, InData%LP_RHS) end if if (RegCheckErr(Buf, RoutineName)) return - ! LP_StifK_LU call RegPack(Buf, allocated(InData%LP_StifK_LU)) if (allocated(InData%LP_StifK_LU)) then call RegPackBounds(Buf, 2, lbound(InData%LP_StifK_LU), ubound(InData%LP_StifK_LU)) call RegPack(Buf, InData%LP_StifK_LU) end if if (RegCheckErr(Buf, RoutineName)) return - ! LP_RHS_LU call RegPack(Buf, allocated(InData%LP_RHS_LU)) if (allocated(InData%LP_RHS_LU)) then call RegPackBounds(Buf, 1, lbound(InData%LP_RHS_LU), ubound(InData%LP_RHS_LU)) call RegPack(Buf, InData%LP_RHS_LU) end if if (RegCheckErr(Buf, RoutineName)) return - ! LP_indx call RegPack(Buf, allocated(InData%LP_indx)) if (allocated(InData%LP_indx)) then call RegPackBounds(Buf, 1, lbound(InData%LP_indx), ubound(InData%LP_indx)) call RegPack(Buf, InData%LP_indx) end if if (RegCheckErr(Buf, RoutineName)) return - ! u call BD_PackInput(Buf, InData%u) if (RegCheckErr(Buf, RoutineName)) return - ! u2 call BD_PackInput(Buf, InData%u2) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -6086,20 +5371,13 @@ subroutine BD_UnPackMisc(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! u_DistrLoad_at_y call MeshUnpack(Buf, OutData%u_DistrLoad_at_y) ! u_DistrLoad_at_y - ! y_BldMotion_at_u call MeshUnpack(Buf, OutData%y_BldMotion_at_u) ! y_BldMotion_at_u - ! Map_u_DistrLoad_to_y call NWTC_Library_UnpackMeshMapType(Buf, OutData%Map_u_DistrLoad_to_y) ! Map_u_DistrLoad_to_y - ! Map_y_BldMotion_to_u call NWTC_Library_UnpackMeshMapType(Buf, OutData%Map_y_BldMotion_to_u) ! Map_y_BldMotion_to_u - ! Un_Sum call RegUnpack(Buf, OutData%Un_Sum) if (RegCheckErr(Buf, RoutineName)) return - ! qp call BD_UnpackEqMotionQP(Buf, OutData%qp) ! qp - ! lin_A if (allocated(OutData%lin_A)) deallocate(OutData%lin_A) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6114,7 +5392,6 @@ subroutine BD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%lin_A) if (RegCheckErr(Buf, RoutineName)) return end if - ! lin_C if (allocated(OutData%lin_C)) deallocate(OutData%lin_C) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6129,7 +5406,6 @@ subroutine BD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%lin_C) if (RegCheckErr(Buf, RoutineName)) return end if - ! Nrrr if (allocated(OutData%Nrrr)) deallocate(OutData%Nrrr) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6144,7 +5420,6 @@ subroutine BD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%Nrrr) if (RegCheckErr(Buf, RoutineName)) return end if - ! elf if (allocated(OutData%elf)) deallocate(OutData%elf) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6159,7 +5434,6 @@ subroutine BD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%elf) if (RegCheckErr(Buf, RoutineName)) return end if - ! EFint if (allocated(OutData%EFint)) deallocate(OutData%EFint) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6174,7 +5448,6 @@ subroutine BD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%EFint) if (RegCheckErr(Buf, RoutineName)) return end if - ! elk if (allocated(OutData%elk)) deallocate(OutData%elk) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6189,7 +5462,6 @@ subroutine BD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%elk) if (RegCheckErr(Buf, RoutineName)) return end if - ! elg if (allocated(OutData%elg)) deallocate(OutData%elg) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6204,7 +5476,6 @@ subroutine BD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%elg) if (RegCheckErr(Buf, RoutineName)) return end if - ! elm if (allocated(OutData%elm)) deallocate(OutData%elm) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6219,7 +5490,6 @@ subroutine BD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%elm) if (RegCheckErr(Buf, RoutineName)) return end if - ! DistrLoad_QP if (allocated(OutData%DistrLoad_QP)) deallocate(OutData%DistrLoad_QP) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6234,7 +5504,6 @@ subroutine BD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%DistrLoad_QP) if (RegCheckErr(Buf, RoutineName)) return end if - ! PointLoadLcl if (allocated(OutData%PointLoadLcl)) deallocate(OutData%PointLoadLcl) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6249,7 +5518,6 @@ subroutine BD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%PointLoadLcl) if (RegCheckErr(Buf, RoutineName)) return end if - ! StifK if (allocated(OutData%StifK)) deallocate(OutData%StifK) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6264,7 +5532,6 @@ subroutine BD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%StifK) if (RegCheckErr(Buf, RoutineName)) return end if - ! MassM if (allocated(OutData%MassM)) deallocate(OutData%MassM) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6279,7 +5546,6 @@ subroutine BD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%MassM) if (RegCheckErr(Buf, RoutineName)) return end if - ! DampG if (allocated(OutData%DampG)) deallocate(OutData%DampG) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6294,7 +5560,6 @@ subroutine BD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%DampG) if (RegCheckErr(Buf, RoutineName)) return end if - ! StifK_fd if (allocated(OutData%StifK_fd)) deallocate(OutData%StifK_fd) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6309,7 +5574,6 @@ subroutine BD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%StifK_fd) if (RegCheckErr(Buf, RoutineName)) return end if - ! MassM_fd if (allocated(OutData%MassM_fd)) deallocate(OutData%MassM_fd) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6324,7 +5588,6 @@ subroutine BD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%MassM_fd) if (RegCheckErr(Buf, RoutineName)) return end if - ! DampG_fd if (allocated(OutData%DampG_fd)) deallocate(OutData%DampG_fd) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6339,7 +5602,6 @@ subroutine BD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%DampG_fd) if (RegCheckErr(Buf, RoutineName)) return end if - ! RHS if (allocated(OutData%RHS)) deallocate(OutData%RHS) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6354,7 +5616,6 @@ subroutine BD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%RHS) if (RegCheckErr(Buf, RoutineName)) return end if - ! RHS_p if (allocated(OutData%RHS_p)) deallocate(OutData%RHS_p) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6369,7 +5630,6 @@ subroutine BD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%RHS_p) if (RegCheckErr(Buf, RoutineName)) return end if - ! RHS_m if (allocated(OutData%RHS_m)) deallocate(OutData%RHS_m) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6384,7 +5644,6 @@ subroutine BD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%RHS_m) if (RegCheckErr(Buf, RoutineName)) return end if - ! BldInternalForceFE if (allocated(OutData%BldInternalForceFE)) deallocate(OutData%BldInternalForceFE) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6399,7 +5658,6 @@ subroutine BD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%BldInternalForceFE) if (RegCheckErr(Buf, RoutineName)) return end if - ! BldInternalForceQP if (allocated(OutData%BldInternalForceQP)) deallocate(OutData%BldInternalForceQP) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6414,7 +5672,6 @@ subroutine BD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%BldInternalForceQP) if (RegCheckErr(Buf, RoutineName)) return end if - ! FirstNodeReactionLclForceMoment if (allocated(OutData%FirstNodeReactionLclForceMoment)) deallocate(OutData%FirstNodeReactionLclForceMoment) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6429,7 +5686,6 @@ subroutine BD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%FirstNodeReactionLclForceMoment) if (RegCheckErr(Buf, RoutineName)) return end if - ! Solution if (allocated(OutData%Solution)) deallocate(OutData%Solution) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6444,7 +5700,6 @@ subroutine BD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%Solution) if (RegCheckErr(Buf, RoutineName)) return end if - ! LP_StifK if (allocated(OutData%LP_StifK)) deallocate(OutData%LP_StifK) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6459,7 +5714,6 @@ subroutine BD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%LP_StifK) if (RegCheckErr(Buf, RoutineName)) return end if - ! LP_MassM if (allocated(OutData%LP_MassM)) deallocate(OutData%LP_MassM) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6474,7 +5728,6 @@ subroutine BD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%LP_MassM) if (RegCheckErr(Buf, RoutineName)) return end if - ! LP_MassM_LU if (allocated(OutData%LP_MassM_LU)) deallocate(OutData%LP_MassM_LU) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6489,7 +5742,6 @@ subroutine BD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%LP_MassM_LU) if (RegCheckErr(Buf, RoutineName)) return end if - ! LP_RHS if (allocated(OutData%LP_RHS)) deallocate(OutData%LP_RHS) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6504,7 +5756,6 @@ subroutine BD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%LP_RHS) if (RegCheckErr(Buf, RoutineName)) return end if - ! LP_StifK_LU if (allocated(OutData%LP_StifK_LU)) deallocate(OutData%LP_StifK_LU) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6519,7 +5770,6 @@ subroutine BD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%LP_StifK_LU) if (RegCheckErr(Buf, RoutineName)) return end if - ! LP_RHS_LU if (allocated(OutData%LP_RHS_LU)) deallocate(OutData%LP_RHS_LU) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6534,7 +5784,6 @@ subroutine BD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%LP_RHS_LU) if (RegCheckErr(Buf, RoutineName)) return end if - ! LP_indx if (allocated(OutData%LP_indx)) deallocate(OutData%LP_indx) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6549,9 +5798,7 @@ subroutine BD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%LP_indx) if (RegCheckErr(Buf, RoutineName)) return end if - ! u call BD_UnpackInput(Buf, OutData%u) ! u - ! u2 call BD_UnpackInput(Buf, OutData%u2) ! u2 end subroutine diff --git a/modules/elastodyn/src/ElastoDyn_Types.f90 b/modules/elastodyn/src/ElastoDyn_Types.f90 index 7afd6d490f..017236a87d 100644 --- a/modules/elastodyn/src/ElastoDyn_Types.f90 +++ b/modules/elastodyn/src/ElastoDyn_Types.f90 @@ -814,73 +814,54 @@ MODULE ElastoDyn_Types END TYPE ED_OutputType ! ======================= CONTAINS - SUBROUTINE ED_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(ED_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFile = SrcInitInputData%InputFile - DstInitInputData%Linearize = SrcInitInputData%Linearize - DstInitInputData%ADInputFile = SrcInitInputData%ADInputFile - DstInitInputData%CompElast = SrcInitInputData%CompElast - DstInitInputData%RootName = SrcInitInputData%RootName - DstInitInputData%Gravity = SrcInitInputData%Gravity - DstInitInputData%MHK = SrcInitInputData%MHK - DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth - END SUBROUTINE ED_CopyInitInput - - SUBROUTINE ED_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(ED_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyInitInput' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE ED_DestroyInitInput +subroutine ED_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(ED_InitInputType), intent(in) :: SrcInitInputData + type(ED_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ED_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%Linearize = SrcInitInputData%Linearize + DstInitInputData%ADInputFile = SrcInitInputData%ADInputFile + DstInitInputData%CompElast = SrcInitInputData%CompElast + DstInitInputData%RootName = SrcInitInputData%RootName + DstInitInputData%Gravity = SrcInitInputData%Gravity + DstInitInputData%MHK = SrcInitInputData%MHK + DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth +end subroutine +subroutine ED_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(ED_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ED_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine ED_PackInitInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ED_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'ED_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return - ! InputFile call RegPack(Buf, InData%InputFile) if (RegCheckErr(Buf, RoutineName)) return - ! Linearize call RegPack(Buf, InData%Linearize) if (RegCheckErr(Buf, RoutineName)) return - ! ADInputFile call RegPack(Buf, InData%ADInputFile) if (RegCheckErr(Buf, RoutineName)) return - ! CompElast call RegPack(Buf, InData%CompElast) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegPack(Buf, InData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! Gravity call RegPack(Buf, InData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - ! MHK call RegPack(Buf, InData%MHK) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDpth call RegPack(Buf, InData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -890,410 +871,391 @@ subroutine ED_UnPackInitInput(Buf, OutData) type(ED_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackInitInput' if (Buf%ErrStat /= ErrID_None) return - ! InputFile call RegUnpack(Buf, OutData%InputFile) if (RegCheckErr(Buf, RoutineName)) return - ! Linearize call RegUnpack(Buf, OutData%Linearize) if (RegCheckErr(Buf, RoutineName)) return - ! ADInputFile call RegUnpack(Buf, OutData%ADInputFile) if (RegCheckErr(Buf, RoutineName)) return - ! CompElast call RegUnpack(Buf, OutData%CompElast) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegUnpack(Buf, OutData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! Gravity call RegUnpack(Buf, OutData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - ! MHK call RegUnpack(Buf, OutData%MHK) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDpth call RegUnpack(Buf, OutData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE ED_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(ED_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_CopyInitOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInitOutputData%WriteOutputHdr)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputHdr,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputHdr,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputHdr)) THEN - ALLOCATE(DstInitOutputData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr -ENDIF -IF (ALLOCATED(SrcInitOutputData%WriteOutputUnt)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputUnt,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputUnt,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputUnt)) THEN - ALLOCATE(DstInitOutputData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt -ENDIF - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitOutputData%NumBl = SrcInitOutputData%NumBl -IF (ALLOCATED(SrcInitOutputData%BlPitch)) THEN - i1_l = LBOUND(SrcInitOutputData%BlPitch,1) - i1_u = UBOUND(SrcInitOutputData%BlPitch,1) - IF (.NOT. ALLOCATED(DstInitOutputData%BlPitch)) THEN - ALLOCATE(DstInitOutputData%BlPitch(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%BlPitch.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%BlPitch = SrcInitOutputData%BlPitch -ENDIF - DstInitOutputData%BladeLength = SrcInitOutputData%BladeLength - DstInitOutputData%TowerHeight = SrcInitOutputData%TowerHeight - DstInitOutputData%TowerBaseHeight = SrcInitOutputData%TowerBaseHeight - DstInitOutputData%HubHt = SrcInitOutputData%HubHt -IF (ALLOCATED(SrcInitOutputData%BldRNodes)) THEN - i1_l = LBOUND(SrcInitOutputData%BldRNodes,1) - i1_u = UBOUND(SrcInitOutputData%BldRNodes,1) - IF (.NOT. ALLOCATED(DstInitOutputData%BldRNodes)) THEN - ALLOCATE(DstInitOutputData%BldRNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%BldRNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%BldRNodes = SrcInitOutputData%BldRNodes -ENDIF -IF (ALLOCATED(SrcInitOutputData%TwrHNodes)) THEN - i1_l = LBOUND(SrcInitOutputData%TwrHNodes,1) - i1_u = UBOUND(SrcInitOutputData%TwrHNodes,1) - IF (.NOT. ALLOCATED(DstInitOutputData%TwrHNodes)) THEN - ALLOCATE(DstInitOutputData%TwrHNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%TwrHNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%TwrHNodes = SrcInitOutputData%TwrHNodes -ENDIF - DstInitOutputData%PlatformPos = SrcInitOutputData%PlatformPos - DstInitOutputData%TwrBaseRefPos = SrcInitOutputData%TwrBaseRefPos - DstInitOutputData%TwrBaseTransDisp = SrcInitOutputData%TwrBaseTransDisp - DstInitOutputData%TwrBaseRefOrient = SrcInitOutputData%TwrBaseRefOrient - DstInitOutputData%TwrBaseOrient = SrcInitOutputData%TwrBaseOrient - DstInitOutputData%HubRad = SrcInitOutputData%HubRad - DstInitOutputData%RotSpeed = SrcInitOutputData%RotSpeed - DstInitOutputData%isFixed_GenDOF = SrcInitOutputData%isFixed_GenDOF -IF (ALLOCATED(SrcInitOutputData%LinNames_y)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_y,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_y,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_y)) THEN - ALLOCATE(DstInitOutputData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y -ENDIF -IF (ALLOCATED(SrcInitOutputData%LinNames_x)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_x,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_x,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_x)) THEN - ALLOCATE(DstInitOutputData%LinNames_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x -ENDIF -IF (ALLOCATED(SrcInitOutputData%LinNames_u)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_u,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_u)) THEN - ALLOCATE(DstInitOutputData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_y)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_y,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_y,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_y)) THEN - ALLOCATE(DstInitOutputData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_x)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_x,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_x,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_x)) THEN - ALLOCATE(DstInitOutputData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x -ENDIF -IF (ALLOCATED(SrcInitOutputData%DerivOrder_x)) THEN - i1_l = LBOUND(SrcInitOutputData%DerivOrder_x,1) - i1_u = UBOUND(SrcInitOutputData%DerivOrder_x,1) - IF (.NOT. ALLOCATED(DstInitOutputData%DerivOrder_x)) THEN - ALLOCATE(DstInitOutputData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_u)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_u,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_u)) THEN - ALLOCATE(DstInitOutputData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%IsLoad_u)) THEN - i1_l = LBOUND(SrcInitOutputData%IsLoad_u,1) - i1_u = UBOUND(SrcInitOutputData%IsLoad_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%IsLoad_u)) THEN - ALLOCATE(DstInitOutputData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u -ENDIF - END SUBROUTINE ED_CopyInitOutput - - SUBROUTINE ED_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(ED_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF - CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitOutputData%BlPitch)) THEN - DEALLOCATE(InitOutputData%BlPitch) -ENDIF -IF (ALLOCATED(InitOutputData%BldRNodes)) THEN - DEALLOCATE(InitOutputData%BldRNodes) -ENDIF -IF (ALLOCATED(InitOutputData%TwrHNodes)) THEN - DEALLOCATE(InitOutputData%TwrHNodes) -ENDIF -IF (ALLOCATED(InitOutputData%LinNames_y)) THEN - DEALLOCATE(InitOutputData%LinNames_y) -ENDIF -IF (ALLOCATED(InitOutputData%LinNames_x)) THEN - DEALLOCATE(InitOutputData%LinNames_x) -ENDIF -IF (ALLOCATED(InitOutputData%LinNames_u)) THEN - DEALLOCATE(InitOutputData%LinNames_u) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_y)) THEN - DEALLOCATE(InitOutputData%RotFrame_y) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_x)) THEN - DEALLOCATE(InitOutputData%RotFrame_x) -ENDIF -IF (ALLOCATED(InitOutputData%DerivOrder_x)) THEN - DEALLOCATE(InitOutputData%DerivOrder_x) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_u)) THEN - DEALLOCATE(InitOutputData%RotFrame_u) -ENDIF -IF (ALLOCATED(InitOutputData%IsLoad_u)) THEN - DEALLOCATE(InitOutputData%IsLoad_u) -ENDIF - END SUBROUTINE ED_DestroyInitOutput +subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(ED_InitOutputType), intent(in) :: SrcInitOutputData + type(ED_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ED_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr + else if (allocated(DstInitOutputData%WriteOutputHdr)) then + deallocate(DstInitOutputData%WriteOutputHdr) + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt + else if (allocated(DstInitOutputData%WriteOutputUnt)) then + deallocate(DstInitOutputData%WriteOutputUnt) + end if + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitOutputData%NumBl = SrcInitOutputData%NumBl + if (allocated(SrcInitOutputData%BlPitch)) then + LB(1:1) = lbound(SrcInitOutputData%BlPitch) + UB(1:1) = ubound(SrcInitOutputData%BlPitch) + if (.not. allocated(DstInitOutputData%BlPitch)) then + allocate(DstInitOutputData%BlPitch(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%BlPitch.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%BlPitch = SrcInitOutputData%BlPitch + else if (allocated(DstInitOutputData%BlPitch)) then + deallocate(DstInitOutputData%BlPitch) + end if + DstInitOutputData%BladeLength = SrcInitOutputData%BladeLength + DstInitOutputData%TowerHeight = SrcInitOutputData%TowerHeight + DstInitOutputData%TowerBaseHeight = SrcInitOutputData%TowerBaseHeight + DstInitOutputData%HubHt = SrcInitOutputData%HubHt + if (allocated(SrcInitOutputData%BldRNodes)) then + LB(1:1) = lbound(SrcInitOutputData%BldRNodes) + UB(1:1) = ubound(SrcInitOutputData%BldRNodes) + if (.not. allocated(DstInitOutputData%BldRNodes)) then + allocate(DstInitOutputData%BldRNodes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%BldRNodes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%BldRNodes = SrcInitOutputData%BldRNodes + else if (allocated(DstInitOutputData%BldRNodes)) then + deallocate(DstInitOutputData%BldRNodes) + end if + if (allocated(SrcInitOutputData%TwrHNodes)) then + LB(1:1) = lbound(SrcInitOutputData%TwrHNodes) + UB(1:1) = ubound(SrcInitOutputData%TwrHNodes) + if (.not. allocated(DstInitOutputData%TwrHNodes)) then + allocate(DstInitOutputData%TwrHNodes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%TwrHNodes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%TwrHNodes = SrcInitOutputData%TwrHNodes + else if (allocated(DstInitOutputData%TwrHNodes)) then + deallocate(DstInitOutputData%TwrHNodes) + end if + DstInitOutputData%PlatformPos = SrcInitOutputData%PlatformPos + DstInitOutputData%TwrBaseRefPos = SrcInitOutputData%TwrBaseRefPos + DstInitOutputData%TwrBaseTransDisp = SrcInitOutputData%TwrBaseTransDisp + DstInitOutputData%TwrBaseRefOrient = SrcInitOutputData%TwrBaseRefOrient + DstInitOutputData%TwrBaseOrient = SrcInitOutputData%TwrBaseOrient + DstInitOutputData%HubRad = SrcInitOutputData%HubRad + DstInitOutputData%RotSpeed = SrcInitOutputData%RotSpeed + DstInitOutputData%isFixed_GenDOF = SrcInitOutputData%isFixed_GenDOF + if (allocated(SrcInitOutputData%LinNames_y)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_y) + UB(1:1) = ubound(SrcInitOutputData%LinNames_y) + if (.not. allocated(DstInitOutputData%LinNames_y)) then + allocate(DstInitOutputData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y + else if (allocated(DstInitOutputData%LinNames_y)) then + deallocate(DstInitOutputData%LinNames_y) + end if + if (allocated(SrcInitOutputData%LinNames_x)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_x) + UB(1:1) = ubound(SrcInitOutputData%LinNames_x) + if (.not. allocated(DstInitOutputData%LinNames_x)) then + allocate(DstInitOutputData%LinNames_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x + else if (allocated(DstInitOutputData%LinNames_x)) then + deallocate(DstInitOutputData%LinNames_x) + end if + if (allocated(SrcInitOutputData%LinNames_u)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_u) + UB(1:1) = ubound(SrcInitOutputData%LinNames_u) + if (.not. allocated(DstInitOutputData%LinNames_u)) then + allocate(DstInitOutputData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u + else if (allocated(DstInitOutputData%LinNames_u)) then + deallocate(DstInitOutputData%LinNames_u) + end if + if (allocated(SrcInitOutputData%RotFrame_y)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_y) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_y) + if (.not. allocated(DstInitOutputData%RotFrame_y)) then + allocate(DstInitOutputData%RotFrame_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y + else if (allocated(DstInitOutputData%RotFrame_y)) then + deallocate(DstInitOutputData%RotFrame_y) + end if + if (allocated(SrcInitOutputData%RotFrame_x)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_x) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_x) + if (.not. allocated(DstInitOutputData%RotFrame_x)) then + allocate(DstInitOutputData%RotFrame_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x + else if (allocated(DstInitOutputData%RotFrame_x)) then + deallocate(DstInitOutputData%RotFrame_x) + end if + if (allocated(SrcInitOutputData%DerivOrder_x)) then + LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) + UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x) + if (.not. allocated(DstInitOutputData%DerivOrder_x)) then + allocate(DstInitOutputData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%DerivOrder_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x + else if (allocated(DstInitOutputData%DerivOrder_x)) then + deallocate(DstInitOutputData%DerivOrder_x) + end if + if (allocated(SrcInitOutputData%RotFrame_u)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_u) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_u) + if (.not. allocated(DstInitOutputData%RotFrame_u)) then + allocate(DstInitOutputData%RotFrame_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u + else if (allocated(DstInitOutputData%RotFrame_u)) then + deallocate(DstInitOutputData%RotFrame_u) + end if + if (allocated(SrcInitOutputData%IsLoad_u)) then + LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) + UB(1:1) = ubound(SrcInitOutputData%IsLoad_u) + if (.not. allocated(DstInitOutputData%IsLoad_u)) then + allocate(DstInitOutputData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%IsLoad_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u + else if (allocated(DstInitOutputData%IsLoad_u)) then + deallocate(DstInitOutputData%IsLoad_u) + end if +end subroutine +subroutine ED_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(ED_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ED_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if + if (allocated(InitOutputData%BlPitch)) then + deallocate(InitOutputData%BlPitch) + end if + if (allocated(InitOutputData%BldRNodes)) then + deallocate(InitOutputData%BldRNodes) + end if + if (allocated(InitOutputData%TwrHNodes)) then + deallocate(InitOutputData%TwrHNodes) + end if + if (allocated(InitOutputData%LinNames_y)) then + deallocate(InitOutputData%LinNames_y) + end if + if (allocated(InitOutputData%LinNames_x)) then + deallocate(InitOutputData%LinNames_x) + end if + if (allocated(InitOutputData%LinNames_u)) then + deallocate(InitOutputData%LinNames_u) + end if + if (allocated(InitOutputData%RotFrame_y)) then + deallocate(InitOutputData%RotFrame_y) + end if + if (allocated(InitOutputData%RotFrame_x)) then + deallocate(InitOutputData%RotFrame_x) + end if + if (allocated(InitOutputData%DerivOrder_x)) then + deallocate(InitOutputData%DerivOrder_x) + end if + if (allocated(InitOutputData%RotFrame_u)) then + deallocate(InitOutputData%RotFrame_u) + end if + if (allocated(InitOutputData%IsLoad_u)) then + deallocate(InitOutputData%IsLoad_u) + end if +end subroutine subroutine ED_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ED_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'ED_PackInitOutput' if (Buf%ErrStat >= AbortErrLev) return - ! WriteOutputHdr call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) call RegPack(Buf, InData%WriteOutputHdr) end if if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutputUnt call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) call RegPack(Buf, InData%WriteOutputUnt) end if if (RegCheckErr(Buf, RoutineName)) return - ! Ver call NWTC_Library_PackProgDesc(Buf, InData%Ver) if (RegCheckErr(Buf, RoutineName)) return - ! NumBl call RegPack(Buf, InData%NumBl) if (RegCheckErr(Buf, RoutineName)) return - ! BlPitch call RegPack(Buf, allocated(InData%BlPitch)) if (allocated(InData%BlPitch)) then call RegPackBounds(Buf, 1, lbound(InData%BlPitch), ubound(InData%BlPitch)) call RegPack(Buf, InData%BlPitch) end if if (RegCheckErr(Buf, RoutineName)) return - ! BladeLength call RegPack(Buf, InData%BladeLength) if (RegCheckErr(Buf, RoutineName)) return - ! TowerHeight call RegPack(Buf, InData%TowerHeight) if (RegCheckErr(Buf, RoutineName)) return - ! TowerBaseHeight call RegPack(Buf, InData%TowerBaseHeight) if (RegCheckErr(Buf, RoutineName)) return - ! HubHt call RegPack(Buf, InData%HubHt) if (RegCheckErr(Buf, RoutineName)) return - ! BldRNodes call RegPack(Buf, allocated(InData%BldRNodes)) if (allocated(InData%BldRNodes)) then call RegPackBounds(Buf, 1, lbound(InData%BldRNodes), ubound(InData%BldRNodes)) call RegPack(Buf, InData%BldRNodes) end if if (RegCheckErr(Buf, RoutineName)) return - ! TwrHNodes call RegPack(Buf, allocated(InData%TwrHNodes)) if (allocated(InData%TwrHNodes)) then call RegPackBounds(Buf, 1, lbound(InData%TwrHNodes), ubound(InData%TwrHNodes)) call RegPack(Buf, InData%TwrHNodes) end if if (RegCheckErr(Buf, RoutineName)) return - ! PlatformPos call RegPack(Buf, InData%PlatformPos) if (RegCheckErr(Buf, RoutineName)) return - ! TwrBaseRefPos call RegPack(Buf, InData%TwrBaseRefPos) if (RegCheckErr(Buf, RoutineName)) return - ! TwrBaseTransDisp call RegPack(Buf, InData%TwrBaseTransDisp) if (RegCheckErr(Buf, RoutineName)) return - ! TwrBaseRefOrient call RegPack(Buf, InData%TwrBaseRefOrient) if (RegCheckErr(Buf, RoutineName)) return - ! TwrBaseOrient call RegPack(Buf, InData%TwrBaseOrient) if (RegCheckErr(Buf, RoutineName)) return - ! HubRad call RegPack(Buf, InData%HubRad) if (RegCheckErr(Buf, RoutineName)) return - ! RotSpeed call RegPack(Buf, InData%RotSpeed) if (RegCheckErr(Buf, RoutineName)) return - ! isFixed_GenDOF call RegPack(Buf, InData%isFixed_GenDOF) if (RegCheckErr(Buf, RoutineName)) return - ! LinNames_y call RegPack(Buf, allocated(InData%LinNames_y)) if (allocated(InData%LinNames_y)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) call RegPack(Buf, InData%LinNames_y) end if if (RegCheckErr(Buf, RoutineName)) return - ! LinNames_x call RegPack(Buf, allocated(InData%LinNames_x)) if (allocated(InData%LinNames_x)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_x), ubound(InData%LinNames_x)) call RegPack(Buf, InData%LinNames_x) end if if (RegCheckErr(Buf, RoutineName)) return - ! LinNames_u call RegPack(Buf, allocated(InData%LinNames_u)) if (allocated(InData%LinNames_u)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) call RegPack(Buf, InData%LinNames_u) end if if (RegCheckErr(Buf, RoutineName)) return - ! RotFrame_y call RegPack(Buf, allocated(InData%RotFrame_y)) if (allocated(InData%RotFrame_y)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y), ubound(InData%RotFrame_y)) call RegPack(Buf, InData%RotFrame_y) end if if (RegCheckErr(Buf, RoutineName)) return - ! RotFrame_x call RegPack(Buf, allocated(InData%RotFrame_x)) if (allocated(InData%RotFrame_x)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x), ubound(InData%RotFrame_x)) call RegPack(Buf, InData%RotFrame_x) end if if (RegCheckErr(Buf, RoutineName)) return - ! DerivOrder_x call RegPack(Buf, allocated(InData%DerivOrder_x)) if (allocated(InData%DerivOrder_x)) then call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x), ubound(InData%DerivOrder_x)) call RegPack(Buf, InData%DerivOrder_x) end if if (RegCheckErr(Buf, RoutineName)) return - ! RotFrame_u call RegPack(Buf, allocated(InData%RotFrame_u)) if (allocated(InData%RotFrame_u)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u), ubound(InData%RotFrame_u)) call RegPack(Buf, InData%RotFrame_u) end if if (RegCheckErr(Buf, RoutineName)) return - ! IsLoad_u call RegPack(Buf, allocated(InData%IsLoad_u)) if (allocated(InData%IsLoad_u)) then call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) @@ -1310,7 +1272,6 @@ subroutine ED_UnPackInitOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! WriteOutputHdr if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1325,7 +1286,6 @@ subroutine ED_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutputHdr) if (RegCheckErr(Buf, RoutineName)) return end if - ! WriteOutputUnt if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1340,12 +1300,9 @@ subroutine ED_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutputUnt) if (RegCheckErr(Buf, RoutineName)) return end if - ! Ver call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver - ! NumBl call RegUnpack(Buf, OutData%NumBl) if (RegCheckErr(Buf, RoutineName)) return - ! BlPitch if (allocated(OutData%BlPitch)) deallocate(OutData%BlPitch) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1360,19 +1317,14 @@ subroutine ED_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%BlPitch) if (RegCheckErr(Buf, RoutineName)) return end if - ! BladeLength call RegUnpack(Buf, OutData%BladeLength) if (RegCheckErr(Buf, RoutineName)) return - ! TowerHeight call RegUnpack(Buf, OutData%TowerHeight) if (RegCheckErr(Buf, RoutineName)) return - ! TowerBaseHeight call RegUnpack(Buf, OutData%TowerBaseHeight) if (RegCheckErr(Buf, RoutineName)) return - ! HubHt call RegUnpack(Buf, OutData%HubHt) if (RegCheckErr(Buf, RoutineName)) return - ! BldRNodes if (allocated(OutData%BldRNodes)) deallocate(OutData%BldRNodes) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1387,7 +1339,6 @@ subroutine ED_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%BldRNodes) if (RegCheckErr(Buf, RoutineName)) return end if - ! TwrHNodes if (allocated(OutData%TwrHNodes)) deallocate(OutData%TwrHNodes) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1402,31 +1353,22 @@ subroutine ED_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%TwrHNodes) if (RegCheckErr(Buf, RoutineName)) return end if - ! PlatformPos call RegUnpack(Buf, OutData%PlatformPos) if (RegCheckErr(Buf, RoutineName)) return - ! TwrBaseRefPos call RegUnpack(Buf, OutData%TwrBaseRefPos) if (RegCheckErr(Buf, RoutineName)) return - ! TwrBaseTransDisp call RegUnpack(Buf, OutData%TwrBaseTransDisp) if (RegCheckErr(Buf, RoutineName)) return - ! TwrBaseRefOrient call RegUnpack(Buf, OutData%TwrBaseRefOrient) if (RegCheckErr(Buf, RoutineName)) return - ! TwrBaseOrient call RegUnpack(Buf, OutData%TwrBaseOrient) if (RegCheckErr(Buf, RoutineName)) return - ! HubRad call RegUnpack(Buf, OutData%HubRad) if (RegCheckErr(Buf, RoutineName)) return - ! RotSpeed call RegUnpack(Buf, OutData%RotSpeed) if (RegCheckErr(Buf, RoutineName)) return - ! isFixed_GenDOF call RegUnpack(Buf, OutData%isFixed_GenDOF) if (RegCheckErr(Buf, RoutineName)) return - ! LinNames_y if (allocated(OutData%LinNames_y)) deallocate(OutData%LinNames_y) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1441,7 +1383,6 @@ subroutine ED_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%LinNames_y) if (RegCheckErr(Buf, RoutineName)) return end if - ! LinNames_x if (allocated(OutData%LinNames_x)) deallocate(OutData%LinNames_x) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1456,7 +1397,6 @@ subroutine ED_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%LinNames_x) if (RegCheckErr(Buf, RoutineName)) return end if - ! LinNames_u if (allocated(OutData%LinNames_u)) deallocate(OutData%LinNames_u) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1471,7 +1411,6 @@ subroutine ED_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%LinNames_u) if (RegCheckErr(Buf, RoutineName)) return end if - ! RotFrame_y if (allocated(OutData%RotFrame_y)) deallocate(OutData%RotFrame_y) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1486,7 +1425,6 @@ subroutine ED_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%RotFrame_y) if (RegCheckErr(Buf, RoutineName)) return end if - ! RotFrame_x if (allocated(OutData%RotFrame_x)) deallocate(OutData%RotFrame_x) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1501,7 +1439,6 @@ subroutine ED_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%RotFrame_x) if (RegCheckErr(Buf, RoutineName)) return end if - ! DerivOrder_x if (allocated(OutData%DerivOrder_x)) deallocate(OutData%DerivOrder_x) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1516,7 +1453,6 @@ subroutine ED_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%DerivOrder_x) if (RegCheckErr(Buf, RoutineName)) return end if - ! RotFrame_u if (allocated(OutData%RotFrame_u)) deallocate(OutData%RotFrame_u) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1531,7 +1467,6 @@ subroutine ED_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%RotFrame_u) if (RegCheckErr(Buf, RoutineName)) return end if - ! IsLoad_u if (allocated(OutData%IsLoad_u)) deallocate(OutData%IsLoad_u) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1547,252 +1482,247 @@ subroutine ED_UnPackInitOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE ED_CopyBladeInputData( SrcBladeInputDataData, DstBladeInputDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BladeInputData), INTENT(IN) :: SrcBladeInputDataData - TYPE(BladeInputData), INTENT(INOUT) :: DstBladeInputDataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_CopyBladeInputData' -! - ErrStat = ErrID_None - ErrMsg = "" - DstBladeInputDataData%NBlInpSt = SrcBladeInputDataData%NBlInpSt -IF (ALLOCATED(SrcBladeInputDataData%BlFract)) THEN - i1_l = LBOUND(SrcBladeInputDataData%BlFract,1) - i1_u = UBOUND(SrcBladeInputDataData%BlFract,1) - IF (.NOT. ALLOCATED(DstBladeInputDataData%BlFract)) THEN - ALLOCATE(DstBladeInputDataData%BlFract(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%BlFract.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeInputDataData%BlFract = SrcBladeInputDataData%BlFract -ENDIF -IF (ALLOCATED(SrcBladeInputDataData%PitchAx)) THEN - i1_l = LBOUND(SrcBladeInputDataData%PitchAx,1) - i1_u = UBOUND(SrcBladeInputDataData%PitchAx,1) - IF (.NOT. ALLOCATED(DstBladeInputDataData%PitchAx)) THEN - ALLOCATE(DstBladeInputDataData%PitchAx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%PitchAx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeInputDataData%PitchAx = SrcBladeInputDataData%PitchAx -ENDIF -IF (ALLOCATED(SrcBladeInputDataData%StrcTwst)) THEN - i1_l = LBOUND(SrcBladeInputDataData%StrcTwst,1) - i1_u = UBOUND(SrcBladeInputDataData%StrcTwst,1) - IF (.NOT. ALLOCATED(DstBladeInputDataData%StrcTwst)) THEN - ALLOCATE(DstBladeInputDataData%StrcTwst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%StrcTwst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeInputDataData%StrcTwst = SrcBladeInputDataData%StrcTwst -ENDIF -IF (ALLOCATED(SrcBladeInputDataData%BMassDen)) THEN - i1_l = LBOUND(SrcBladeInputDataData%BMassDen,1) - i1_u = UBOUND(SrcBladeInputDataData%BMassDen,1) - IF (.NOT. ALLOCATED(DstBladeInputDataData%BMassDen)) THEN - ALLOCATE(DstBladeInputDataData%BMassDen(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%BMassDen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeInputDataData%BMassDen = SrcBladeInputDataData%BMassDen -ENDIF -IF (ALLOCATED(SrcBladeInputDataData%FlpStff)) THEN - i1_l = LBOUND(SrcBladeInputDataData%FlpStff,1) - i1_u = UBOUND(SrcBladeInputDataData%FlpStff,1) - IF (.NOT. ALLOCATED(DstBladeInputDataData%FlpStff)) THEN - ALLOCATE(DstBladeInputDataData%FlpStff(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%FlpStff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeInputDataData%FlpStff = SrcBladeInputDataData%FlpStff -ENDIF -IF (ALLOCATED(SrcBladeInputDataData%EdgStff)) THEN - i1_l = LBOUND(SrcBladeInputDataData%EdgStff,1) - i1_u = UBOUND(SrcBladeInputDataData%EdgStff,1) - IF (.NOT. ALLOCATED(DstBladeInputDataData%EdgStff)) THEN - ALLOCATE(DstBladeInputDataData%EdgStff(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%EdgStff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeInputDataData%EdgStff = SrcBladeInputDataData%EdgStff -ENDIF - DstBladeInputDataData%BldFlDmp = SrcBladeInputDataData%BldFlDmp - DstBladeInputDataData%BldEdDmp = SrcBladeInputDataData%BldEdDmp - DstBladeInputDataData%FlStTunr = SrcBladeInputDataData%FlStTunr -IF (ALLOCATED(SrcBladeInputDataData%BldFl1Sh)) THEN - i1_l = LBOUND(SrcBladeInputDataData%BldFl1Sh,1) - i1_u = UBOUND(SrcBladeInputDataData%BldFl1Sh,1) - IF (.NOT. ALLOCATED(DstBladeInputDataData%BldFl1Sh)) THEN - ALLOCATE(DstBladeInputDataData%BldFl1Sh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%BldFl1Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeInputDataData%BldFl1Sh = SrcBladeInputDataData%BldFl1Sh -ENDIF -IF (ALLOCATED(SrcBladeInputDataData%BldFl2Sh)) THEN - i1_l = LBOUND(SrcBladeInputDataData%BldFl2Sh,1) - i1_u = UBOUND(SrcBladeInputDataData%BldFl2Sh,1) - IF (.NOT. ALLOCATED(DstBladeInputDataData%BldFl2Sh)) THEN - ALLOCATE(DstBladeInputDataData%BldFl2Sh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%BldFl2Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeInputDataData%BldFl2Sh = SrcBladeInputDataData%BldFl2Sh -ENDIF -IF (ALLOCATED(SrcBladeInputDataData%BldEdgSh)) THEN - i1_l = LBOUND(SrcBladeInputDataData%BldEdgSh,1) - i1_u = UBOUND(SrcBladeInputDataData%BldEdgSh,1) - IF (.NOT. ALLOCATED(DstBladeInputDataData%BldEdgSh)) THEN - ALLOCATE(DstBladeInputDataData%BldEdgSh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%BldEdgSh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeInputDataData%BldEdgSh = SrcBladeInputDataData%BldEdgSh -ENDIF - END SUBROUTINE ED_CopyBladeInputData - - SUBROUTINE ED_DestroyBladeInputData( BladeInputDataData, ErrStat, ErrMsg ) - TYPE(BladeInputData), INTENT(INOUT) :: BladeInputDataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyBladeInputData' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(BladeInputDataData%BlFract)) THEN - DEALLOCATE(BladeInputDataData%BlFract) -ENDIF -IF (ALLOCATED(BladeInputDataData%PitchAx)) THEN - DEALLOCATE(BladeInputDataData%PitchAx) -ENDIF -IF (ALLOCATED(BladeInputDataData%StrcTwst)) THEN - DEALLOCATE(BladeInputDataData%StrcTwst) -ENDIF -IF (ALLOCATED(BladeInputDataData%BMassDen)) THEN - DEALLOCATE(BladeInputDataData%BMassDen) -ENDIF -IF (ALLOCATED(BladeInputDataData%FlpStff)) THEN - DEALLOCATE(BladeInputDataData%FlpStff) -ENDIF -IF (ALLOCATED(BladeInputDataData%EdgStff)) THEN - DEALLOCATE(BladeInputDataData%EdgStff) -ENDIF -IF (ALLOCATED(BladeInputDataData%BldFl1Sh)) THEN - DEALLOCATE(BladeInputDataData%BldFl1Sh) -ENDIF -IF (ALLOCATED(BladeInputDataData%BldFl2Sh)) THEN - DEALLOCATE(BladeInputDataData%BldFl2Sh) -ENDIF -IF (ALLOCATED(BladeInputDataData%BldEdgSh)) THEN - DEALLOCATE(BladeInputDataData%BldEdgSh) -ENDIF - END SUBROUTINE ED_DestroyBladeInputData +subroutine ED_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, CtrlCode, ErrStat, ErrMsg) + type(BladeInputData), intent(in) :: SrcBladeInputDataData + type(BladeInputData), intent(inout) :: DstBladeInputDataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'ED_CopyBladeInputData' + ErrStat = ErrID_None + ErrMsg = '' + DstBladeInputDataData%NBlInpSt = SrcBladeInputDataData%NBlInpSt + if (allocated(SrcBladeInputDataData%BlFract)) then + LB(1:1) = lbound(SrcBladeInputDataData%BlFract) + UB(1:1) = ubound(SrcBladeInputDataData%BlFract) + if (.not. allocated(DstBladeInputDataData%BlFract)) then + allocate(DstBladeInputDataData%BlFract(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%BlFract.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeInputDataData%BlFract = SrcBladeInputDataData%BlFract + else if (allocated(DstBladeInputDataData%BlFract)) then + deallocate(DstBladeInputDataData%BlFract) + end if + if (allocated(SrcBladeInputDataData%PitchAx)) then + LB(1:1) = lbound(SrcBladeInputDataData%PitchAx) + UB(1:1) = ubound(SrcBladeInputDataData%PitchAx) + if (.not. allocated(DstBladeInputDataData%PitchAx)) then + allocate(DstBladeInputDataData%PitchAx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%PitchAx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeInputDataData%PitchAx = SrcBladeInputDataData%PitchAx + else if (allocated(DstBladeInputDataData%PitchAx)) then + deallocate(DstBladeInputDataData%PitchAx) + end if + if (allocated(SrcBladeInputDataData%StrcTwst)) then + LB(1:1) = lbound(SrcBladeInputDataData%StrcTwst) + UB(1:1) = ubound(SrcBladeInputDataData%StrcTwst) + if (.not. allocated(DstBladeInputDataData%StrcTwst)) then + allocate(DstBladeInputDataData%StrcTwst(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%StrcTwst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeInputDataData%StrcTwst = SrcBladeInputDataData%StrcTwst + else if (allocated(DstBladeInputDataData%StrcTwst)) then + deallocate(DstBladeInputDataData%StrcTwst) + end if + if (allocated(SrcBladeInputDataData%BMassDen)) then + LB(1:1) = lbound(SrcBladeInputDataData%BMassDen) + UB(1:1) = ubound(SrcBladeInputDataData%BMassDen) + if (.not. allocated(DstBladeInputDataData%BMassDen)) then + allocate(DstBladeInputDataData%BMassDen(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%BMassDen.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeInputDataData%BMassDen = SrcBladeInputDataData%BMassDen + else if (allocated(DstBladeInputDataData%BMassDen)) then + deallocate(DstBladeInputDataData%BMassDen) + end if + if (allocated(SrcBladeInputDataData%FlpStff)) then + LB(1:1) = lbound(SrcBladeInputDataData%FlpStff) + UB(1:1) = ubound(SrcBladeInputDataData%FlpStff) + if (.not. allocated(DstBladeInputDataData%FlpStff)) then + allocate(DstBladeInputDataData%FlpStff(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%FlpStff.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeInputDataData%FlpStff = SrcBladeInputDataData%FlpStff + else if (allocated(DstBladeInputDataData%FlpStff)) then + deallocate(DstBladeInputDataData%FlpStff) + end if + if (allocated(SrcBladeInputDataData%EdgStff)) then + LB(1:1) = lbound(SrcBladeInputDataData%EdgStff) + UB(1:1) = ubound(SrcBladeInputDataData%EdgStff) + if (.not. allocated(DstBladeInputDataData%EdgStff)) then + allocate(DstBladeInputDataData%EdgStff(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%EdgStff.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeInputDataData%EdgStff = SrcBladeInputDataData%EdgStff + else if (allocated(DstBladeInputDataData%EdgStff)) then + deallocate(DstBladeInputDataData%EdgStff) + end if + DstBladeInputDataData%BldFlDmp = SrcBladeInputDataData%BldFlDmp + DstBladeInputDataData%BldEdDmp = SrcBladeInputDataData%BldEdDmp + DstBladeInputDataData%FlStTunr = SrcBladeInputDataData%FlStTunr + if (allocated(SrcBladeInputDataData%BldFl1Sh)) then + LB(1:1) = lbound(SrcBladeInputDataData%BldFl1Sh) + UB(1:1) = ubound(SrcBladeInputDataData%BldFl1Sh) + if (.not. allocated(DstBladeInputDataData%BldFl1Sh)) then + allocate(DstBladeInputDataData%BldFl1Sh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%BldFl1Sh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeInputDataData%BldFl1Sh = SrcBladeInputDataData%BldFl1Sh + else if (allocated(DstBladeInputDataData%BldFl1Sh)) then + deallocate(DstBladeInputDataData%BldFl1Sh) + end if + if (allocated(SrcBladeInputDataData%BldFl2Sh)) then + LB(1:1) = lbound(SrcBladeInputDataData%BldFl2Sh) + UB(1:1) = ubound(SrcBladeInputDataData%BldFl2Sh) + if (.not. allocated(DstBladeInputDataData%BldFl2Sh)) then + allocate(DstBladeInputDataData%BldFl2Sh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%BldFl2Sh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeInputDataData%BldFl2Sh = SrcBladeInputDataData%BldFl2Sh + else if (allocated(DstBladeInputDataData%BldFl2Sh)) then + deallocate(DstBladeInputDataData%BldFl2Sh) + end if + if (allocated(SrcBladeInputDataData%BldEdgSh)) then + LB(1:1) = lbound(SrcBladeInputDataData%BldEdgSh) + UB(1:1) = ubound(SrcBladeInputDataData%BldEdgSh) + if (.not. allocated(DstBladeInputDataData%BldEdgSh)) then + allocate(DstBladeInputDataData%BldEdgSh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeInputDataData%BldEdgSh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeInputDataData%BldEdgSh = SrcBladeInputDataData%BldEdgSh + else if (allocated(DstBladeInputDataData%BldEdgSh)) then + deallocate(DstBladeInputDataData%BldEdgSh) + end if +end subroutine +subroutine ED_DestroyBladeInputData(BladeInputDataData, ErrStat, ErrMsg) + type(BladeInputData), intent(inout) :: BladeInputDataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ED_DestroyBladeInputData' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(BladeInputDataData%BlFract)) then + deallocate(BladeInputDataData%BlFract) + end if + if (allocated(BladeInputDataData%PitchAx)) then + deallocate(BladeInputDataData%PitchAx) + end if + if (allocated(BladeInputDataData%StrcTwst)) then + deallocate(BladeInputDataData%StrcTwst) + end if + if (allocated(BladeInputDataData%BMassDen)) then + deallocate(BladeInputDataData%BMassDen) + end if + if (allocated(BladeInputDataData%FlpStff)) then + deallocate(BladeInputDataData%FlpStff) + end if + if (allocated(BladeInputDataData%EdgStff)) then + deallocate(BladeInputDataData%EdgStff) + end if + if (allocated(BladeInputDataData%BldFl1Sh)) then + deallocate(BladeInputDataData%BldFl1Sh) + end if + if (allocated(BladeInputDataData%BldFl2Sh)) then + deallocate(BladeInputDataData%BldFl2Sh) + end if + if (allocated(BladeInputDataData%BldEdgSh)) then + deallocate(BladeInputDataData%BldEdgSh) + end if +end subroutine subroutine ED_PackBladeInputData(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(BladeInputData), intent(in) :: InData character(*), parameter :: RoutineName = 'ED_PackBladeInputData' if (Buf%ErrStat >= AbortErrLev) return - ! NBlInpSt call RegPack(Buf, InData%NBlInpSt) if (RegCheckErr(Buf, RoutineName)) return - ! BlFract call RegPack(Buf, allocated(InData%BlFract)) if (allocated(InData%BlFract)) then call RegPackBounds(Buf, 1, lbound(InData%BlFract), ubound(InData%BlFract)) call RegPack(Buf, InData%BlFract) end if if (RegCheckErr(Buf, RoutineName)) return - ! PitchAx call RegPack(Buf, allocated(InData%PitchAx)) if (allocated(InData%PitchAx)) then call RegPackBounds(Buf, 1, lbound(InData%PitchAx), ubound(InData%PitchAx)) call RegPack(Buf, InData%PitchAx) end if if (RegCheckErr(Buf, RoutineName)) return - ! StrcTwst call RegPack(Buf, allocated(InData%StrcTwst)) if (allocated(InData%StrcTwst)) then call RegPackBounds(Buf, 1, lbound(InData%StrcTwst), ubound(InData%StrcTwst)) call RegPack(Buf, InData%StrcTwst) end if if (RegCheckErr(Buf, RoutineName)) return - ! BMassDen call RegPack(Buf, allocated(InData%BMassDen)) if (allocated(InData%BMassDen)) then call RegPackBounds(Buf, 1, lbound(InData%BMassDen), ubound(InData%BMassDen)) call RegPack(Buf, InData%BMassDen) end if if (RegCheckErr(Buf, RoutineName)) return - ! FlpStff call RegPack(Buf, allocated(InData%FlpStff)) if (allocated(InData%FlpStff)) then call RegPackBounds(Buf, 1, lbound(InData%FlpStff), ubound(InData%FlpStff)) call RegPack(Buf, InData%FlpStff) end if if (RegCheckErr(Buf, RoutineName)) return - ! EdgStff call RegPack(Buf, allocated(InData%EdgStff)) if (allocated(InData%EdgStff)) then call RegPackBounds(Buf, 1, lbound(InData%EdgStff), ubound(InData%EdgStff)) call RegPack(Buf, InData%EdgStff) end if if (RegCheckErr(Buf, RoutineName)) return - ! BldFlDmp call RegPack(Buf, InData%BldFlDmp) if (RegCheckErr(Buf, RoutineName)) return - ! BldEdDmp call RegPack(Buf, InData%BldEdDmp) if (RegCheckErr(Buf, RoutineName)) return - ! FlStTunr call RegPack(Buf, InData%FlStTunr) if (RegCheckErr(Buf, RoutineName)) return - ! BldFl1Sh call RegPack(Buf, allocated(InData%BldFl1Sh)) if (allocated(InData%BldFl1Sh)) then call RegPackBounds(Buf, 1, lbound(InData%BldFl1Sh), ubound(InData%BldFl1Sh)) call RegPack(Buf, InData%BldFl1Sh) end if if (RegCheckErr(Buf, RoutineName)) return - ! BldFl2Sh call RegPack(Buf, allocated(InData%BldFl2Sh)) if (allocated(InData%BldFl2Sh)) then call RegPackBounds(Buf, 1, lbound(InData%BldFl2Sh), ubound(InData%BldFl2Sh)) call RegPack(Buf, InData%BldFl2Sh) end if if (RegCheckErr(Buf, RoutineName)) return - ! BldEdgSh call RegPack(Buf, allocated(InData%BldEdgSh)) if (allocated(InData%BldEdgSh)) then call RegPackBounds(Buf, 1, lbound(InData%BldEdgSh), ubound(InData%BldEdgSh)) @@ -1809,10 +1739,8 @@ subroutine ED_UnPackBladeInputData(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! NBlInpSt call RegUnpack(Buf, OutData%NBlInpSt) if (RegCheckErr(Buf, RoutineName)) return - ! BlFract if (allocated(OutData%BlFract)) deallocate(OutData%BlFract) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1827,7 +1755,6 @@ subroutine ED_UnPackBladeInputData(Buf, OutData) call RegUnpack(Buf, OutData%BlFract) if (RegCheckErr(Buf, RoutineName)) return end if - ! PitchAx if (allocated(OutData%PitchAx)) deallocate(OutData%PitchAx) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1842,7 +1769,6 @@ subroutine ED_UnPackBladeInputData(Buf, OutData) call RegUnpack(Buf, OutData%PitchAx) if (RegCheckErr(Buf, RoutineName)) return end if - ! StrcTwst if (allocated(OutData%StrcTwst)) deallocate(OutData%StrcTwst) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1857,7 +1783,6 @@ subroutine ED_UnPackBladeInputData(Buf, OutData) call RegUnpack(Buf, OutData%StrcTwst) if (RegCheckErr(Buf, RoutineName)) return end if - ! BMassDen if (allocated(OutData%BMassDen)) deallocate(OutData%BMassDen) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1872,7 +1797,6 @@ subroutine ED_UnPackBladeInputData(Buf, OutData) call RegUnpack(Buf, OutData%BMassDen) if (RegCheckErr(Buf, RoutineName)) return end if - ! FlpStff if (allocated(OutData%FlpStff)) deallocate(OutData%FlpStff) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1887,7 +1811,6 @@ subroutine ED_UnPackBladeInputData(Buf, OutData) call RegUnpack(Buf, OutData%FlpStff) if (RegCheckErr(Buf, RoutineName)) return end if - ! EdgStff if (allocated(OutData%EdgStff)) deallocate(OutData%EdgStff) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1902,16 +1825,12 @@ subroutine ED_UnPackBladeInputData(Buf, OutData) call RegUnpack(Buf, OutData%EdgStff) if (RegCheckErr(Buf, RoutineName)) return end if - ! BldFlDmp call RegUnpack(Buf, OutData%BldFlDmp) if (RegCheckErr(Buf, RoutineName)) return - ! BldEdDmp call RegUnpack(Buf, OutData%BldEdDmp) if (RegCheckErr(Buf, RoutineName)) return - ! FlStTunr call RegUnpack(Buf, OutData%FlStTunr) if (RegCheckErr(Buf, RoutineName)) return - ! BldFl1Sh if (allocated(OutData%BldFl1Sh)) deallocate(OutData%BldFl1Sh) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1926,7 +1845,6 @@ subroutine ED_UnPackBladeInputData(Buf, OutData) call RegUnpack(Buf, OutData%BldFl1Sh) if (RegCheckErr(Buf, RoutineName)) return end if - ! BldFl2Sh if (allocated(OutData%BldFl2Sh)) deallocate(OutData%BldFl2Sh) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1941,7 +1859,6 @@ subroutine ED_UnPackBladeInputData(Buf, OutData) call RegUnpack(Buf, OutData%BldFl2Sh) if (RegCheckErr(Buf, RoutineName)) return end if - ! BldEdgSh if (allocated(OutData%BldEdgSh)) deallocate(OutData%BldEdgSh) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1957,108 +1874,100 @@ subroutine ED_UnPackBladeInputData(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE ED_CopyBladeMeshInputData( SrcBladeMeshInputDataData, DstBladeMeshInputDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_BladeMeshInputData), INTENT(IN) :: SrcBladeMeshInputDataData - TYPE(ED_BladeMeshInputData), INTENT(INOUT) :: DstBladeMeshInputDataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_CopyBladeMeshInputData' -! - ErrStat = ErrID_None - ErrMsg = "" - DstBladeMeshInputDataData%BldNodes = SrcBladeMeshInputDataData%BldNodes -IF (ALLOCATED(SrcBladeMeshInputDataData%RNodes)) THEN - i1_l = LBOUND(SrcBladeMeshInputDataData%RNodes,1) - i1_u = UBOUND(SrcBladeMeshInputDataData%RNodes,1) - IF (.NOT. ALLOCATED(DstBladeMeshInputDataData%RNodes)) THEN - ALLOCATE(DstBladeMeshInputDataData%RNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeMeshInputDataData%RNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeMeshInputDataData%RNodes = SrcBladeMeshInputDataData%RNodes -ENDIF -IF (ALLOCATED(SrcBladeMeshInputDataData%AeroTwst)) THEN - i1_l = LBOUND(SrcBladeMeshInputDataData%AeroTwst,1) - i1_u = UBOUND(SrcBladeMeshInputDataData%AeroTwst,1) - IF (.NOT. ALLOCATED(DstBladeMeshInputDataData%AeroTwst)) THEN - ALLOCATE(DstBladeMeshInputDataData%AeroTwst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeMeshInputDataData%AeroTwst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeMeshInputDataData%AeroTwst = SrcBladeMeshInputDataData%AeroTwst -ENDIF -IF (ALLOCATED(SrcBladeMeshInputDataData%Chord)) THEN - i1_l = LBOUND(SrcBladeMeshInputDataData%Chord,1) - i1_u = UBOUND(SrcBladeMeshInputDataData%Chord,1) - IF (.NOT. ALLOCATED(DstBladeMeshInputDataData%Chord)) THEN - ALLOCATE(DstBladeMeshInputDataData%Chord(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladeMeshInputDataData%Chord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladeMeshInputDataData%Chord = SrcBladeMeshInputDataData%Chord -ENDIF - END SUBROUTINE ED_CopyBladeMeshInputData - SUBROUTINE ED_DestroyBladeMeshInputData( BladeMeshInputDataData, ErrStat, ErrMsg ) - TYPE(ED_BladeMeshInputData), INTENT(INOUT) :: BladeMeshInputDataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyBladeMeshInputData' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(BladeMeshInputDataData%RNodes)) THEN - DEALLOCATE(BladeMeshInputDataData%RNodes) -ENDIF -IF (ALLOCATED(BladeMeshInputDataData%AeroTwst)) THEN - DEALLOCATE(BladeMeshInputDataData%AeroTwst) -ENDIF -IF (ALLOCATED(BladeMeshInputDataData%Chord)) THEN - DEALLOCATE(BladeMeshInputDataData%Chord) -ENDIF - END SUBROUTINE ED_DestroyBladeMeshInputData +subroutine ED_CopyBladeMeshInputData(SrcBladeMeshInputDataData, DstBladeMeshInputDataData, CtrlCode, ErrStat, ErrMsg) + type(ED_BladeMeshInputData), intent(in) :: SrcBladeMeshInputDataData + type(ED_BladeMeshInputData), intent(inout) :: DstBladeMeshInputDataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'ED_CopyBladeMeshInputData' + ErrStat = ErrID_None + ErrMsg = '' + DstBladeMeshInputDataData%BldNodes = SrcBladeMeshInputDataData%BldNodes + if (allocated(SrcBladeMeshInputDataData%RNodes)) then + LB(1:1) = lbound(SrcBladeMeshInputDataData%RNodes) + UB(1:1) = ubound(SrcBladeMeshInputDataData%RNodes) + if (.not. allocated(DstBladeMeshInputDataData%RNodes)) then + allocate(DstBladeMeshInputDataData%RNodes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeMeshInputDataData%RNodes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeMeshInputDataData%RNodes = SrcBladeMeshInputDataData%RNodes + else if (allocated(DstBladeMeshInputDataData%RNodes)) then + deallocate(DstBladeMeshInputDataData%RNodes) + end if + if (allocated(SrcBladeMeshInputDataData%AeroTwst)) then + LB(1:1) = lbound(SrcBladeMeshInputDataData%AeroTwst) + UB(1:1) = ubound(SrcBladeMeshInputDataData%AeroTwst) + if (.not. allocated(DstBladeMeshInputDataData%AeroTwst)) then + allocate(DstBladeMeshInputDataData%AeroTwst(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeMeshInputDataData%AeroTwst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeMeshInputDataData%AeroTwst = SrcBladeMeshInputDataData%AeroTwst + else if (allocated(DstBladeMeshInputDataData%AeroTwst)) then + deallocate(DstBladeMeshInputDataData%AeroTwst) + end if + if (allocated(SrcBladeMeshInputDataData%Chord)) then + LB(1:1) = lbound(SrcBladeMeshInputDataData%Chord) + UB(1:1) = ubound(SrcBladeMeshInputDataData%Chord) + if (.not. allocated(DstBladeMeshInputDataData%Chord)) then + allocate(DstBladeMeshInputDataData%Chord(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladeMeshInputDataData%Chord.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladeMeshInputDataData%Chord = SrcBladeMeshInputDataData%Chord + else if (allocated(DstBladeMeshInputDataData%Chord)) then + deallocate(DstBladeMeshInputDataData%Chord) + end if +end subroutine +subroutine ED_DestroyBladeMeshInputData(BladeMeshInputDataData, ErrStat, ErrMsg) + type(ED_BladeMeshInputData), intent(inout) :: BladeMeshInputDataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ED_DestroyBladeMeshInputData' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(BladeMeshInputDataData%RNodes)) then + deallocate(BladeMeshInputDataData%RNodes) + end if + if (allocated(BladeMeshInputDataData%AeroTwst)) then + deallocate(BladeMeshInputDataData%AeroTwst) + end if + if (allocated(BladeMeshInputDataData%Chord)) then + deallocate(BladeMeshInputDataData%Chord) + end if +end subroutine subroutine ED_PackBladeMeshInputData(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ED_BladeMeshInputData), intent(in) :: InData character(*), parameter :: RoutineName = 'ED_PackBladeMeshInputData' if (Buf%ErrStat >= AbortErrLev) return - ! BldNodes call RegPack(Buf, InData%BldNodes) if (RegCheckErr(Buf, RoutineName)) return - ! RNodes call RegPack(Buf, allocated(InData%RNodes)) if (allocated(InData%RNodes)) then call RegPackBounds(Buf, 1, lbound(InData%RNodes), ubound(InData%RNodes)) call RegPack(Buf, InData%RNodes) end if if (RegCheckErr(Buf, RoutineName)) return - ! AeroTwst call RegPack(Buf, allocated(InData%AeroTwst)) if (allocated(InData%AeroTwst)) then call RegPackBounds(Buf, 1, lbound(InData%AeroTwst), ubound(InData%AeroTwst)) call RegPack(Buf, InData%AeroTwst) end if if (RegCheckErr(Buf, RoutineName)) return - ! Chord call RegPack(Buf, allocated(InData%Chord)) if (allocated(InData%Chord)) then call RegPackBounds(Buf, 1, lbound(InData%Chord), ubound(InData%Chord)) @@ -2075,10 +1984,8 @@ subroutine ED_UnPackBladeMeshInputData(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! BldNodes call RegUnpack(Buf, OutData%BldNodes) if (RegCheckErr(Buf, RoutineName)) return - ! RNodes if (allocated(OutData%RNodes)) deallocate(OutData%RNodes) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2093,7 +2000,6 @@ subroutine ED_UnPackBladeMeshInputData(Buf, OutData) call RegUnpack(Buf, OutData%RNodes) if (RegCheckErr(Buf, RoutineName)) return end if - ! AeroTwst if (allocated(OutData%AeroTwst)) deallocate(OutData%AeroTwst) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2108,7 +2014,6 @@ subroutine ED_UnPackBladeMeshInputData(Buf, OutData) call RegUnpack(Buf, OutData%AeroTwst) if (RegCheckErr(Buf, RoutineName)) return end if - ! Chord if (allocated(OutData%Chord)) deallocate(OutData%Chord) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2124,421 +2029,451 @@ subroutine ED_UnPackBladeMeshInputData(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE ED_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_InputFile), INTENT(IN) :: SrcInputFileData - TYPE(ED_InputFile), INTENT(INOUT) :: DstInputFileData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_CopyInputFile' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInputFileData%DT = SrcInputFileData%DT - DstInputFileData%FlapDOF1 = SrcInputFileData%FlapDOF1 - DstInputFileData%FlapDOF2 = SrcInputFileData%FlapDOF2 - DstInputFileData%EdgeDOF = SrcInputFileData%EdgeDOF - DstInputFileData%TeetDOF = SrcInputFileData%TeetDOF - DstInputFileData%DrTrDOF = SrcInputFileData%DrTrDOF - DstInputFileData%GenDOF = SrcInputFileData%GenDOF - DstInputFileData%YawDOF = SrcInputFileData%YawDOF - DstInputFileData%TwFADOF1 = SrcInputFileData%TwFADOF1 - DstInputFileData%TwFADOF2 = SrcInputFileData%TwFADOF2 - DstInputFileData%TwSSDOF1 = SrcInputFileData%TwSSDOF1 - DstInputFileData%TwSSDOF2 = SrcInputFileData%TwSSDOF2 - DstInputFileData%PtfmSgDOF = SrcInputFileData%PtfmSgDOF - DstInputFileData%PtfmSwDOF = SrcInputFileData%PtfmSwDOF - DstInputFileData%PtfmHvDOF = SrcInputFileData%PtfmHvDOF - DstInputFileData%PtfmRDOF = SrcInputFileData%PtfmRDOF - DstInputFileData%PtfmPDOF = SrcInputFileData%PtfmPDOF - DstInputFileData%PtfmYDOF = SrcInputFileData%PtfmYDOF - DstInputFileData%OoPDefl = SrcInputFileData%OoPDefl - DstInputFileData%IPDefl = SrcInputFileData%IPDefl -IF (ALLOCATED(SrcInputFileData%BlPitch)) THEN - i1_l = LBOUND(SrcInputFileData%BlPitch,1) - i1_u = UBOUND(SrcInputFileData%BlPitch,1) - IF (.NOT. ALLOCATED(DstInputFileData%BlPitch)) THEN - ALLOCATE(DstInputFileData%BlPitch(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BlPitch.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%BlPitch = SrcInputFileData%BlPitch -ENDIF - DstInputFileData%TeetDefl = SrcInputFileData%TeetDefl - DstInputFileData%Azimuth = SrcInputFileData%Azimuth - DstInputFileData%RotSpeed = SrcInputFileData%RotSpeed - DstInputFileData%NacYaw = SrcInputFileData%NacYaw - DstInputFileData%TTDspFA = SrcInputFileData%TTDspFA - DstInputFileData%TTDspSS = SrcInputFileData%TTDspSS - DstInputFileData%PtfmSurge = SrcInputFileData%PtfmSurge - DstInputFileData%PtfmSway = SrcInputFileData%PtfmSway - DstInputFileData%PtfmHeave = SrcInputFileData%PtfmHeave - DstInputFileData%PtfmRoll = SrcInputFileData%PtfmRoll - DstInputFileData%PtfmPitch = SrcInputFileData%PtfmPitch - DstInputFileData%PtfmYaw = SrcInputFileData%PtfmYaw - DstInputFileData%NumBl = SrcInputFileData%NumBl - DstInputFileData%TipRad = SrcInputFileData%TipRad - DstInputFileData%HubRad = SrcInputFileData%HubRad -IF (ALLOCATED(SrcInputFileData%PreCone)) THEN - i1_l = LBOUND(SrcInputFileData%PreCone,1) - i1_u = UBOUND(SrcInputFileData%PreCone,1) - IF (.NOT. ALLOCATED(DstInputFileData%PreCone)) THEN - ALLOCATE(DstInputFileData%PreCone(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PreCone.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%PreCone = SrcInputFileData%PreCone -ENDIF - DstInputFileData%HubCM = SrcInputFileData%HubCM - DstInputFileData%UndSling = SrcInputFileData%UndSling - DstInputFileData%Delta3 = SrcInputFileData%Delta3 - DstInputFileData%AzimB1Up = SrcInputFileData%AzimB1Up - DstInputFileData%OverHang = SrcInputFileData%OverHang - DstInputFileData%ShftGagL = SrcInputFileData%ShftGagL - DstInputFileData%ShftTilt = SrcInputFileData%ShftTilt - DstInputFileData%NacCMxn = SrcInputFileData%NacCMxn - DstInputFileData%NacCMyn = SrcInputFileData%NacCMyn - DstInputFileData%NacCMzn = SrcInputFileData%NacCMzn - DstInputFileData%NcIMUxn = SrcInputFileData%NcIMUxn - DstInputFileData%NcIMUyn = SrcInputFileData%NcIMUyn - DstInputFileData%NcIMUzn = SrcInputFileData%NcIMUzn - DstInputFileData%Twr2Shft = SrcInputFileData%Twr2Shft - DstInputFileData%TowerHt = SrcInputFileData%TowerHt - DstInputFileData%TowerBsHt = SrcInputFileData%TowerBsHt - DstInputFileData%PtfmCMxt = SrcInputFileData%PtfmCMxt - DstInputFileData%PtfmCMyt = SrcInputFileData%PtfmCMyt - DstInputFileData%PtfmCMzt = SrcInputFileData%PtfmCMzt - DstInputFileData%PtfmRefzt = SrcInputFileData%PtfmRefzt -IF (ALLOCATED(SrcInputFileData%TipMass)) THEN - i1_l = LBOUND(SrcInputFileData%TipMass,1) - i1_u = UBOUND(SrcInputFileData%TipMass,1) - IF (.NOT. ALLOCATED(DstInputFileData%TipMass)) THEN - ALLOCATE(DstInputFileData%TipMass(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TipMass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%TipMass = SrcInputFileData%TipMass -ENDIF - DstInputFileData%HubMass = SrcInputFileData%HubMass - DstInputFileData%HubIner = SrcInputFileData%HubIner - DstInputFileData%GenIner = SrcInputFileData%GenIner - DstInputFileData%NacMass = SrcInputFileData%NacMass - DstInputFileData%NacYIner = SrcInputFileData%NacYIner - DstInputFileData%YawBrMass = SrcInputFileData%YawBrMass - DstInputFileData%PtfmMass = SrcInputFileData%PtfmMass - DstInputFileData%PtfmRIner = SrcInputFileData%PtfmRIner - DstInputFileData%PtfmPIner = SrcInputFileData%PtfmPIner - DstInputFileData%PtfmYIner = SrcInputFileData%PtfmYIner - DstInputFileData%BldNodes = SrcInputFileData%BldNodes -IF (ALLOCATED(SrcInputFileData%InpBlMesh)) THEN - i1_l = LBOUND(SrcInputFileData%InpBlMesh,1) - i1_u = UBOUND(SrcInputFileData%InpBlMesh,1) - IF (.NOT. ALLOCATED(DstInputFileData%InpBlMesh)) THEN - ALLOCATE(DstInputFileData%InpBlMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%InpBlMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputFileData%InpBlMesh,1), UBOUND(SrcInputFileData%InpBlMesh,1) - CALL ED_Copyblademeshinputdata( SrcInputFileData%InpBlMesh(i1), DstInputFileData%InpBlMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInputFileData%InpBl)) THEN - i1_l = LBOUND(SrcInputFileData%InpBl,1) - i1_u = UBOUND(SrcInputFileData%InpBl,1) - IF (.NOT. ALLOCATED(DstInputFileData%InpBl)) THEN - ALLOCATE(DstInputFileData%InpBl(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%InpBl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputFileData%InpBl,1), UBOUND(SrcInputFileData%InpBl,1) - CALL ED_Copybladeinputdata( SrcInputFileData%InpBl(i1), DstInputFileData%InpBl(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstInputFileData%TeetMod = SrcInputFileData%TeetMod - DstInputFileData%TeetDmpP = SrcInputFileData%TeetDmpP - DstInputFileData%TeetDmp = SrcInputFileData%TeetDmp - DstInputFileData%TeetCDmp = SrcInputFileData%TeetCDmp - DstInputFileData%TeetSStP = SrcInputFileData%TeetSStP - DstInputFileData%TeetHStP = SrcInputFileData%TeetHStP - DstInputFileData%TeetSSSp = SrcInputFileData%TeetSSSp - DstInputFileData%TeetHSSp = SrcInputFileData%TeetHSSp - DstInputFileData%GBoxEff = SrcInputFileData%GBoxEff - DstInputFileData%GBRatio = SrcInputFileData%GBRatio - DstInputFileData%DTTorSpr = SrcInputFileData%DTTorSpr - DstInputFileData%DTTorDmp = SrcInputFileData%DTTorDmp - DstInputFileData%Furling = SrcInputFileData%Furling - DstInputFileData%TwrNodes = SrcInputFileData%TwrNodes - DstInputFileData%SumPrint = SrcInputFileData%SumPrint - DstInputFileData%OutFile = SrcInputFileData%OutFile - DstInputFileData%TabDelim = SrcInputFileData%TabDelim - DstInputFileData%OutFmt = SrcInputFileData%OutFmt - DstInputFileData%Tstart = SrcInputFileData%Tstart - DstInputFileData%DecFact = SrcInputFileData%DecFact - DstInputFileData%NTwGages = SrcInputFileData%NTwGages - DstInputFileData%TwrGagNd = SrcInputFileData%TwrGagNd - DstInputFileData%NBlGages = SrcInputFileData%NBlGages - DstInputFileData%BldGagNd = SrcInputFileData%BldGagNd - DstInputFileData%NumOuts = SrcInputFileData%NumOuts -IF (ALLOCATED(SrcInputFileData%OutList)) THEN - i1_l = LBOUND(SrcInputFileData%OutList,1) - i1_u = UBOUND(SrcInputFileData%OutList,1) - IF (.NOT. ALLOCATED(DstInputFileData%OutList)) THEN - ALLOCATE(DstInputFileData%OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%OutList = SrcInputFileData%OutList -ENDIF - DstInputFileData%NTwInpSt = SrcInputFileData%NTwInpSt - DstInputFileData%TwrFADmp = SrcInputFileData%TwrFADmp - DstInputFileData%TwrSSDmp = SrcInputFileData%TwrSSDmp - DstInputFileData%FAStTunr = SrcInputFileData%FAStTunr - DstInputFileData%SSStTunr = SrcInputFileData%SSStTunr -IF (ALLOCATED(SrcInputFileData%HtFract)) THEN - i1_l = LBOUND(SrcInputFileData%HtFract,1) - i1_u = UBOUND(SrcInputFileData%HtFract,1) - IF (.NOT. ALLOCATED(DstInputFileData%HtFract)) THEN - ALLOCATE(DstInputFileData%HtFract(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%HtFract.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%HtFract = SrcInputFileData%HtFract -ENDIF -IF (ALLOCATED(SrcInputFileData%TMassDen)) THEN - i1_l = LBOUND(SrcInputFileData%TMassDen,1) - i1_u = UBOUND(SrcInputFileData%TMassDen,1) - IF (.NOT. ALLOCATED(DstInputFileData%TMassDen)) THEN - ALLOCATE(DstInputFileData%TMassDen(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TMassDen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%TMassDen = SrcInputFileData%TMassDen -ENDIF -IF (ALLOCATED(SrcInputFileData%TwFAStif)) THEN - i1_l = LBOUND(SrcInputFileData%TwFAStif,1) - i1_u = UBOUND(SrcInputFileData%TwFAStif,1) - IF (.NOT. ALLOCATED(DstInputFileData%TwFAStif)) THEN - ALLOCATE(DstInputFileData%TwFAStif(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TwFAStif.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%TwFAStif = SrcInputFileData%TwFAStif -ENDIF -IF (ALLOCATED(SrcInputFileData%TwSSStif)) THEN - i1_l = LBOUND(SrcInputFileData%TwSSStif,1) - i1_u = UBOUND(SrcInputFileData%TwSSStif,1) - IF (.NOT. ALLOCATED(DstInputFileData%TwSSStif)) THEN - ALLOCATE(DstInputFileData%TwSSStif(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TwSSStif.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%TwSSStif = SrcInputFileData%TwSSStif -ENDIF -IF (ALLOCATED(SrcInputFileData%TwFAM1Sh)) THEN - i1_l = LBOUND(SrcInputFileData%TwFAM1Sh,1) - i1_u = UBOUND(SrcInputFileData%TwFAM1Sh,1) - IF (.NOT. ALLOCATED(DstInputFileData%TwFAM1Sh)) THEN - ALLOCATE(DstInputFileData%TwFAM1Sh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TwFAM1Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%TwFAM1Sh = SrcInputFileData%TwFAM1Sh -ENDIF -IF (ALLOCATED(SrcInputFileData%TwFAM2Sh)) THEN - i1_l = LBOUND(SrcInputFileData%TwFAM2Sh,1) - i1_u = UBOUND(SrcInputFileData%TwFAM2Sh,1) - IF (.NOT. ALLOCATED(DstInputFileData%TwFAM2Sh)) THEN - ALLOCATE(DstInputFileData%TwFAM2Sh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TwFAM2Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%TwFAM2Sh = SrcInputFileData%TwFAM2Sh -ENDIF -IF (ALLOCATED(SrcInputFileData%TwSSM1Sh)) THEN - i1_l = LBOUND(SrcInputFileData%TwSSM1Sh,1) - i1_u = UBOUND(SrcInputFileData%TwSSM1Sh,1) - IF (.NOT. ALLOCATED(DstInputFileData%TwSSM1Sh)) THEN - ALLOCATE(DstInputFileData%TwSSM1Sh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TwSSM1Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%TwSSM1Sh = SrcInputFileData%TwSSM1Sh -ENDIF -IF (ALLOCATED(SrcInputFileData%TwSSM2Sh)) THEN - i1_l = LBOUND(SrcInputFileData%TwSSM2Sh,1) - i1_u = UBOUND(SrcInputFileData%TwSSM2Sh,1) - IF (.NOT. ALLOCATED(DstInputFileData%TwSSM2Sh)) THEN - ALLOCATE(DstInputFileData%TwSSM2Sh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TwSSM2Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%TwSSM2Sh = SrcInputFileData%TwSSM2Sh -ENDIF - DstInputFileData%RFrlDOF = SrcInputFileData%RFrlDOF - DstInputFileData%TFrlDOF = SrcInputFileData%TFrlDOF - DstInputFileData%RotFurl = SrcInputFileData%RotFurl - DstInputFileData%TailFurl = SrcInputFileData%TailFurl - DstInputFileData%Yaw2Shft = SrcInputFileData%Yaw2Shft - DstInputFileData%ShftSkew = SrcInputFileData%ShftSkew - DstInputFileData%RFrlCM_n = SrcInputFileData%RFrlCM_n - DstInputFileData%BoomCM_n = SrcInputFileData%BoomCM_n - DstInputFileData%TFinCM_n = SrcInputFileData%TFinCM_n - DstInputFileData%RFrlPnt_n = SrcInputFileData%RFrlPnt_n - DstInputFileData%RFrlSkew = SrcInputFileData%RFrlSkew - DstInputFileData%RFrlTilt = SrcInputFileData%RFrlTilt - DstInputFileData%TFrlPnt_n = SrcInputFileData%TFrlPnt_n - DstInputFileData%TFrlSkew = SrcInputFileData%TFrlSkew - DstInputFileData%TFrlTilt = SrcInputFileData%TFrlTilt - DstInputFileData%RFrlMass = SrcInputFileData%RFrlMass - DstInputFileData%BoomMass = SrcInputFileData%BoomMass - DstInputFileData%TFinMass = SrcInputFileData%TFinMass - DstInputFileData%RFrlIner = SrcInputFileData%RFrlIner - DstInputFileData%TFrlIner = SrcInputFileData%TFrlIner - DstInputFileData%RFrlMod = SrcInputFileData%RFrlMod - DstInputFileData%RFrlSpr = SrcInputFileData%RFrlSpr - DstInputFileData%RFrlDmp = SrcInputFileData%RFrlDmp - DstInputFileData%RFrlUSSP = SrcInputFileData%RFrlUSSP - DstInputFileData%RFrlDSSP = SrcInputFileData%RFrlDSSP - DstInputFileData%RFrlUSSpr = SrcInputFileData%RFrlUSSpr - DstInputFileData%RFrlDSSpr = SrcInputFileData%RFrlDSSpr - DstInputFileData%RFrlUSDP = SrcInputFileData%RFrlUSDP - DstInputFileData%RFrlDSDP = SrcInputFileData%RFrlDSDP - DstInputFileData%RFrlUSDmp = SrcInputFileData%RFrlUSDmp - DstInputFileData%RFrlDSDmp = SrcInputFileData%RFrlDSDmp - DstInputFileData%TFrlMod = SrcInputFileData%TFrlMod - DstInputFileData%TFrlSpr = SrcInputFileData%TFrlSpr - DstInputFileData%TFrlDmp = SrcInputFileData%TFrlDmp - DstInputFileData%TFrlUSSP = SrcInputFileData%TFrlUSSP - DstInputFileData%TFrlDSSP = SrcInputFileData%TFrlDSSP - DstInputFileData%TFrlUSSpr = SrcInputFileData%TFrlUSSpr - DstInputFileData%TFrlDSSpr = SrcInputFileData%TFrlDSSpr - DstInputFileData%TFrlUSDP = SrcInputFileData%TFrlUSDP - DstInputFileData%TFrlDSDP = SrcInputFileData%TFrlDSDP - DstInputFileData%TFrlUSDmp = SrcInputFileData%TFrlUSDmp - DstInputFileData%TFrlDSDmp = SrcInputFileData%TFrlDSDmp - DstInputFileData%method = SrcInputFileData%method - DstInputFileData%BldNd_NumOuts = SrcInputFileData%BldNd_NumOuts -IF (ALLOCATED(SrcInputFileData%BldNd_OutList)) THEN - i1_l = LBOUND(SrcInputFileData%BldNd_OutList,1) - i1_u = UBOUND(SrcInputFileData%BldNd_OutList,1) - IF (.NOT. ALLOCATED(DstInputFileData%BldNd_OutList)) THEN - ALLOCATE(DstInputFileData%BldNd_OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BldNd_OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%BldNd_OutList = SrcInputFileData%BldNd_OutList -ENDIF - DstInputFileData%BldNd_BlOutNd_Str = SrcInputFileData%BldNd_BlOutNd_Str - DstInputFileData%BldNd_BladesOut = SrcInputFileData%BldNd_BladesOut - END SUBROUTINE ED_CopyInputFile - - SUBROUTINE ED_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) - TYPE(ED_InputFile), INTENT(INOUT) :: InputFileData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyInputFile' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputFileData%BlPitch)) THEN - DEALLOCATE(InputFileData%BlPitch) -ENDIF -IF (ALLOCATED(InputFileData%PreCone)) THEN - DEALLOCATE(InputFileData%PreCone) -ENDIF -IF (ALLOCATED(InputFileData%TipMass)) THEN - DEALLOCATE(InputFileData%TipMass) -ENDIF -IF (ALLOCATED(InputFileData%InpBlMesh)) THEN -DO i1 = LBOUND(InputFileData%InpBlMesh,1), UBOUND(InputFileData%InpBlMesh,1) - CALL ED_DestroyBladeMeshInputData( InputFileData%InpBlMesh(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InputFileData%InpBlMesh) -ENDIF -IF (ALLOCATED(InputFileData%InpBl)) THEN -DO i1 = LBOUND(InputFileData%InpBl,1), UBOUND(InputFileData%InpBl,1) - CALL ED_DestroyBladeInputData( InputFileData%InpBl(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InputFileData%InpBl) -ENDIF -IF (ALLOCATED(InputFileData%OutList)) THEN - DEALLOCATE(InputFileData%OutList) -ENDIF -IF (ALLOCATED(InputFileData%HtFract)) THEN - DEALLOCATE(InputFileData%HtFract) -ENDIF -IF (ALLOCATED(InputFileData%TMassDen)) THEN - DEALLOCATE(InputFileData%TMassDen) -ENDIF -IF (ALLOCATED(InputFileData%TwFAStif)) THEN - DEALLOCATE(InputFileData%TwFAStif) -ENDIF -IF (ALLOCATED(InputFileData%TwSSStif)) THEN - DEALLOCATE(InputFileData%TwSSStif) -ENDIF -IF (ALLOCATED(InputFileData%TwFAM1Sh)) THEN - DEALLOCATE(InputFileData%TwFAM1Sh) -ENDIF -IF (ALLOCATED(InputFileData%TwFAM2Sh)) THEN - DEALLOCATE(InputFileData%TwFAM2Sh) -ENDIF -IF (ALLOCATED(InputFileData%TwSSM1Sh)) THEN - DEALLOCATE(InputFileData%TwSSM1Sh) -ENDIF -IF (ALLOCATED(InputFileData%TwSSM2Sh)) THEN - DEALLOCATE(InputFileData%TwSSM2Sh) -ENDIF -IF (ALLOCATED(InputFileData%BldNd_OutList)) THEN - DEALLOCATE(InputFileData%BldNd_OutList) -ENDIF - END SUBROUTINE ED_DestroyInputFile +subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) + type(ED_InputFile), intent(in) :: SrcInputFileData + type(ED_InputFile), intent(inout) :: DstInputFileData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ED_CopyInputFile' + ErrStat = ErrID_None + ErrMsg = '' + DstInputFileData%DT = SrcInputFileData%DT + DstInputFileData%FlapDOF1 = SrcInputFileData%FlapDOF1 + DstInputFileData%FlapDOF2 = SrcInputFileData%FlapDOF2 + DstInputFileData%EdgeDOF = SrcInputFileData%EdgeDOF + DstInputFileData%TeetDOF = SrcInputFileData%TeetDOF + DstInputFileData%DrTrDOF = SrcInputFileData%DrTrDOF + DstInputFileData%GenDOF = SrcInputFileData%GenDOF + DstInputFileData%YawDOF = SrcInputFileData%YawDOF + DstInputFileData%TwFADOF1 = SrcInputFileData%TwFADOF1 + DstInputFileData%TwFADOF2 = SrcInputFileData%TwFADOF2 + DstInputFileData%TwSSDOF1 = SrcInputFileData%TwSSDOF1 + DstInputFileData%TwSSDOF2 = SrcInputFileData%TwSSDOF2 + DstInputFileData%PtfmSgDOF = SrcInputFileData%PtfmSgDOF + DstInputFileData%PtfmSwDOF = SrcInputFileData%PtfmSwDOF + DstInputFileData%PtfmHvDOF = SrcInputFileData%PtfmHvDOF + DstInputFileData%PtfmRDOF = SrcInputFileData%PtfmRDOF + DstInputFileData%PtfmPDOF = SrcInputFileData%PtfmPDOF + DstInputFileData%PtfmYDOF = SrcInputFileData%PtfmYDOF + DstInputFileData%OoPDefl = SrcInputFileData%OoPDefl + DstInputFileData%IPDefl = SrcInputFileData%IPDefl + if (allocated(SrcInputFileData%BlPitch)) then + LB(1:1) = lbound(SrcInputFileData%BlPitch) + UB(1:1) = ubound(SrcInputFileData%BlPitch) + if (.not. allocated(DstInputFileData%BlPitch)) then + allocate(DstInputFileData%BlPitch(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BlPitch.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%BlPitch = SrcInputFileData%BlPitch + else if (allocated(DstInputFileData%BlPitch)) then + deallocate(DstInputFileData%BlPitch) + end if + DstInputFileData%TeetDefl = SrcInputFileData%TeetDefl + DstInputFileData%Azimuth = SrcInputFileData%Azimuth + DstInputFileData%RotSpeed = SrcInputFileData%RotSpeed + DstInputFileData%NacYaw = SrcInputFileData%NacYaw + DstInputFileData%TTDspFA = SrcInputFileData%TTDspFA + DstInputFileData%TTDspSS = SrcInputFileData%TTDspSS + DstInputFileData%PtfmSurge = SrcInputFileData%PtfmSurge + DstInputFileData%PtfmSway = SrcInputFileData%PtfmSway + DstInputFileData%PtfmHeave = SrcInputFileData%PtfmHeave + DstInputFileData%PtfmRoll = SrcInputFileData%PtfmRoll + DstInputFileData%PtfmPitch = SrcInputFileData%PtfmPitch + DstInputFileData%PtfmYaw = SrcInputFileData%PtfmYaw + DstInputFileData%NumBl = SrcInputFileData%NumBl + DstInputFileData%TipRad = SrcInputFileData%TipRad + DstInputFileData%HubRad = SrcInputFileData%HubRad + if (allocated(SrcInputFileData%PreCone)) then + LB(1:1) = lbound(SrcInputFileData%PreCone) + UB(1:1) = ubound(SrcInputFileData%PreCone) + if (.not. allocated(DstInputFileData%PreCone)) then + allocate(DstInputFileData%PreCone(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PreCone.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%PreCone = SrcInputFileData%PreCone + else if (allocated(DstInputFileData%PreCone)) then + deallocate(DstInputFileData%PreCone) + end if + DstInputFileData%HubCM = SrcInputFileData%HubCM + DstInputFileData%UndSling = SrcInputFileData%UndSling + DstInputFileData%Delta3 = SrcInputFileData%Delta3 + DstInputFileData%AzimB1Up = SrcInputFileData%AzimB1Up + DstInputFileData%OverHang = SrcInputFileData%OverHang + DstInputFileData%ShftGagL = SrcInputFileData%ShftGagL + DstInputFileData%ShftTilt = SrcInputFileData%ShftTilt + DstInputFileData%NacCMxn = SrcInputFileData%NacCMxn + DstInputFileData%NacCMyn = SrcInputFileData%NacCMyn + DstInputFileData%NacCMzn = SrcInputFileData%NacCMzn + DstInputFileData%NcIMUxn = SrcInputFileData%NcIMUxn + DstInputFileData%NcIMUyn = SrcInputFileData%NcIMUyn + DstInputFileData%NcIMUzn = SrcInputFileData%NcIMUzn + DstInputFileData%Twr2Shft = SrcInputFileData%Twr2Shft + DstInputFileData%TowerHt = SrcInputFileData%TowerHt + DstInputFileData%TowerBsHt = SrcInputFileData%TowerBsHt + DstInputFileData%PtfmCMxt = SrcInputFileData%PtfmCMxt + DstInputFileData%PtfmCMyt = SrcInputFileData%PtfmCMyt + DstInputFileData%PtfmCMzt = SrcInputFileData%PtfmCMzt + DstInputFileData%PtfmRefzt = SrcInputFileData%PtfmRefzt + if (allocated(SrcInputFileData%TipMass)) then + LB(1:1) = lbound(SrcInputFileData%TipMass) + UB(1:1) = ubound(SrcInputFileData%TipMass) + if (.not. allocated(DstInputFileData%TipMass)) then + allocate(DstInputFileData%TipMass(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TipMass.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%TipMass = SrcInputFileData%TipMass + else if (allocated(DstInputFileData%TipMass)) then + deallocate(DstInputFileData%TipMass) + end if + DstInputFileData%HubMass = SrcInputFileData%HubMass + DstInputFileData%HubIner = SrcInputFileData%HubIner + DstInputFileData%GenIner = SrcInputFileData%GenIner + DstInputFileData%NacMass = SrcInputFileData%NacMass + DstInputFileData%NacYIner = SrcInputFileData%NacYIner + DstInputFileData%YawBrMass = SrcInputFileData%YawBrMass + DstInputFileData%PtfmMass = SrcInputFileData%PtfmMass + DstInputFileData%PtfmRIner = SrcInputFileData%PtfmRIner + DstInputFileData%PtfmPIner = SrcInputFileData%PtfmPIner + DstInputFileData%PtfmYIner = SrcInputFileData%PtfmYIner + DstInputFileData%BldNodes = SrcInputFileData%BldNodes + if (allocated(SrcInputFileData%InpBlMesh)) then + LB(1:1) = lbound(SrcInputFileData%InpBlMesh) + UB(1:1) = ubound(SrcInputFileData%InpBlMesh) + if (.not. allocated(DstInputFileData%InpBlMesh)) then + allocate(DstInputFileData%InpBlMesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%InpBlMesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ED_CopyBladeMeshInputData(SrcInputFileData%InpBlMesh(i1), DstInputFileData%InpBlMesh(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstInputFileData%InpBlMesh)) then + deallocate(DstInputFileData%InpBlMesh) + end if + if (allocated(SrcInputFileData%InpBl)) then + LB(1:1) = lbound(SrcInputFileData%InpBl) + UB(1:1) = ubound(SrcInputFileData%InpBl) + if (.not. allocated(DstInputFileData%InpBl)) then + allocate(DstInputFileData%InpBl(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%InpBl.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ED_CopyBladeInputData(SrcInputFileData%InpBl(i1), DstInputFileData%InpBl(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstInputFileData%InpBl)) then + deallocate(DstInputFileData%InpBl) + end if + DstInputFileData%TeetMod = SrcInputFileData%TeetMod + DstInputFileData%TeetDmpP = SrcInputFileData%TeetDmpP + DstInputFileData%TeetDmp = SrcInputFileData%TeetDmp + DstInputFileData%TeetCDmp = SrcInputFileData%TeetCDmp + DstInputFileData%TeetSStP = SrcInputFileData%TeetSStP + DstInputFileData%TeetHStP = SrcInputFileData%TeetHStP + DstInputFileData%TeetSSSp = SrcInputFileData%TeetSSSp + DstInputFileData%TeetHSSp = SrcInputFileData%TeetHSSp + DstInputFileData%GBoxEff = SrcInputFileData%GBoxEff + DstInputFileData%GBRatio = SrcInputFileData%GBRatio + DstInputFileData%DTTorSpr = SrcInputFileData%DTTorSpr + DstInputFileData%DTTorDmp = SrcInputFileData%DTTorDmp + DstInputFileData%Furling = SrcInputFileData%Furling + DstInputFileData%TwrNodes = SrcInputFileData%TwrNodes + DstInputFileData%SumPrint = SrcInputFileData%SumPrint + DstInputFileData%OutFile = SrcInputFileData%OutFile + DstInputFileData%TabDelim = SrcInputFileData%TabDelim + DstInputFileData%OutFmt = SrcInputFileData%OutFmt + DstInputFileData%Tstart = SrcInputFileData%Tstart + DstInputFileData%DecFact = SrcInputFileData%DecFact + DstInputFileData%NTwGages = SrcInputFileData%NTwGages + DstInputFileData%TwrGagNd = SrcInputFileData%TwrGagNd + DstInputFileData%NBlGages = SrcInputFileData%NBlGages + DstInputFileData%BldGagNd = SrcInputFileData%BldGagNd + DstInputFileData%NumOuts = SrcInputFileData%NumOuts + if (allocated(SrcInputFileData%OutList)) then + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) + if (.not. allocated(DstInputFileData%OutList)) then + allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%OutList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%OutList = SrcInputFileData%OutList + else if (allocated(DstInputFileData%OutList)) then + deallocate(DstInputFileData%OutList) + end if + DstInputFileData%NTwInpSt = SrcInputFileData%NTwInpSt + DstInputFileData%TwrFADmp = SrcInputFileData%TwrFADmp + DstInputFileData%TwrSSDmp = SrcInputFileData%TwrSSDmp + DstInputFileData%FAStTunr = SrcInputFileData%FAStTunr + DstInputFileData%SSStTunr = SrcInputFileData%SSStTunr + if (allocated(SrcInputFileData%HtFract)) then + LB(1:1) = lbound(SrcInputFileData%HtFract) + UB(1:1) = ubound(SrcInputFileData%HtFract) + if (.not. allocated(DstInputFileData%HtFract)) then + allocate(DstInputFileData%HtFract(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%HtFract.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%HtFract = SrcInputFileData%HtFract + else if (allocated(DstInputFileData%HtFract)) then + deallocate(DstInputFileData%HtFract) + end if + if (allocated(SrcInputFileData%TMassDen)) then + LB(1:1) = lbound(SrcInputFileData%TMassDen) + UB(1:1) = ubound(SrcInputFileData%TMassDen) + if (.not. allocated(DstInputFileData%TMassDen)) then + allocate(DstInputFileData%TMassDen(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TMassDen.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%TMassDen = SrcInputFileData%TMassDen + else if (allocated(DstInputFileData%TMassDen)) then + deallocate(DstInputFileData%TMassDen) + end if + if (allocated(SrcInputFileData%TwFAStif)) then + LB(1:1) = lbound(SrcInputFileData%TwFAStif) + UB(1:1) = ubound(SrcInputFileData%TwFAStif) + if (.not. allocated(DstInputFileData%TwFAStif)) then + allocate(DstInputFileData%TwFAStif(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TwFAStif.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%TwFAStif = SrcInputFileData%TwFAStif + else if (allocated(DstInputFileData%TwFAStif)) then + deallocate(DstInputFileData%TwFAStif) + end if + if (allocated(SrcInputFileData%TwSSStif)) then + LB(1:1) = lbound(SrcInputFileData%TwSSStif) + UB(1:1) = ubound(SrcInputFileData%TwSSStif) + if (.not. allocated(DstInputFileData%TwSSStif)) then + allocate(DstInputFileData%TwSSStif(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TwSSStif.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%TwSSStif = SrcInputFileData%TwSSStif + else if (allocated(DstInputFileData%TwSSStif)) then + deallocate(DstInputFileData%TwSSStif) + end if + if (allocated(SrcInputFileData%TwFAM1Sh)) then + LB(1:1) = lbound(SrcInputFileData%TwFAM1Sh) + UB(1:1) = ubound(SrcInputFileData%TwFAM1Sh) + if (.not. allocated(DstInputFileData%TwFAM1Sh)) then + allocate(DstInputFileData%TwFAM1Sh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TwFAM1Sh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%TwFAM1Sh = SrcInputFileData%TwFAM1Sh + else if (allocated(DstInputFileData%TwFAM1Sh)) then + deallocate(DstInputFileData%TwFAM1Sh) + end if + if (allocated(SrcInputFileData%TwFAM2Sh)) then + LB(1:1) = lbound(SrcInputFileData%TwFAM2Sh) + UB(1:1) = ubound(SrcInputFileData%TwFAM2Sh) + if (.not. allocated(DstInputFileData%TwFAM2Sh)) then + allocate(DstInputFileData%TwFAM2Sh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TwFAM2Sh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%TwFAM2Sh = SrcInputFileData%TwFAM2Sh + else if (allocated(DstInputFileData%TwFAM2Sh)) then + deallocate(DstInputFileData%TwFAM2Sh) + end if + if (allocated(SrcInputFileData%TwSSM1Sh)) then + LB(1:1) = lbound(SrcInputFileData%TwSSM1Sh) + UB(1:1) = ubound(SrcInputFileData%TwSSM1Sh) + if (.not. allocated(DstInputFileData%TwSSM1Sh)) then + allocate(DstInputFileData%TwSSM1Sh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TwSSM1Sh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%TwSSM1Sh = SrcInputFileData%TwSSM1Sh + else if (allocated(DstInputFileData%TwSSM1Sh)) then + deallocate(DstInputFileData%TwSSM1Sh) + end if + if (allocated(SrcInputFileData%TwSSM2Sh)) then + LB(1:1) = lbound(SrcInputFileData%TwSSM2Sh) + UB(1:1) = ubound(SrcInputFileData%TwSSM2Sh) + if (.not. allocated(DstInputFileData%TwSSM2Sh)) then + allocate(DstInputFileData%TwSSM2Sh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TwSSM2Sh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%TwSSM2Sh = SrcInputFileData%TwSSM2Sh + else if (allocated(DstInputFileData%TwSSM2Sh)) then + deallocate(DstInputFileData%TwSSM2Sh) + end if + DstInputFileData%RFrlDOF = SrcInputFileData%RFrlDOF + DstInputFileData%TFrlDOF = SrcInputFileData%TFrlDOF + DstInputFileData%RotFurl = SrcInputFileData%RotFurl + DstInputFileData%TailFurl = SrcInputFileData%TailFurl + DstInputFileData%Yaw2Shft = SrcInputFileData%Yaw2Shft + DstInputFileData%ShftSkew = SrcInputFileData%ShftSkew + DstInputFileData%RFrlCM_n = SrcInputFileData%RFrlCM_n + DstInputFileData%BoomCM_n = SrcInputFileData%BoomCM_n + DstInputFileData%TFinCM_n = SrcInputFileData%TFinCM_n + DstInputFileData%RFrlPnt_n = SrcInputFileData%RFrlPnt_n + DstInputFileData%RFrlSkew = SrcInputFileData%RFrlSkew + DstInputFileData%RFrlTilt = SrcInputFileData%RFrlTilt + DstInputFileData%TFrlPnt_n = SrcInputFileData%TFrlPnt_n + DstInputFileData%TFrlSkew = SrcInputFileData%TFrlSkew + DstInputFileData%TFrlTilt = SrcInputFileData%TFrlTilt + DstInputFileData%RFrlMass = SrcInputFileData%RFrlMass + DstInputFileData%BoomMass = SrcInputFileData%BoomMass + DstInputFileData%TFinMass = SrcInputFileData%TFinMass + DstInputFileData%RFrlIner = SrcInputFileData%RFrlIner + DstInputFileData%TFrlIner = SrcInputFileData%TFrlIner + DstInputFileData%RFrlMod = SrcInputFileData%RFrlMod + DstInputFileData%RFrlSpr = SrcInputFileData%RFrlSpr + DstInputFileData%RFrlDmp = SrcInputFileData%RFrlDmp + DstInputFileData%RFrlUSSP = SrcInputFileData%RFrlUSSP + DstInputFileData%RFrlDSSP = SrcInputFileData%RFrlDSSP + DstInputFileData%RFrlUSSpr = SrcInputFileData%RFrlUSSpr + DstInputFileData%RFrlDSSpr = SrcInputFileData%RFrlDSSpr + DstInputFileData%RFrlUSDP = SrcInputFileData%RFrlUSDP + DstInputFileData%RFrlDSDP = SrcInputFileData%RFrlDSDP + DstInputFileData%RFrlUSDmp = SrcInputFileData%RFrlUSDmp + DstInputFileData%RFrlDSDmp = SrcInputFileData%RFrlDSDmp + DstInputFileData%TFrlMod = SrcInputFileData%TFrlMod + DstInputFileData%TFrlSpr = SrcInputFileData%TFrlSpr + DstInputFileData%TFrlDmp = SrcInputFileData%TFrlDmp + DstInputFileData%TFrlUSSP = SrcInputFileData%TFrlUSSP + DstInputFileData%TFrlDSSP = SrcInputFileData%TFrlDSSP + DstInputFileData%TFrlUSSpr = SrcInputFileData%TFrlUSSpr + DstInputFileData%TFrlDSSpr = SrcInputFileData%TFrlDSSpr + DstInputFileData%TFrlUSDP = SrcInputFileData%TFrlUSDP + DstInputFileData%TFrlDSDP = SrcInputFileData%TFrlDSDP + DstInputFileData%TFrlUSDmp = SrcInputFileData%TFrlUSDmp + DstInputFileData%TFrlDSDmp = SrcInputFileData%TFrlDSDmp + DstInputFileData%method = SrcInputFileData%method + DstInputFileData%BldNd_NumOuts = SrcInputFileData%BldNd_NumOuts + if (allocated(SrcInputFileData%BldNd_OutList)) then + LB(1:1) = lbound(SrcInputFileData%BldNd_OutList) + UB(1:1) = ubound(SrcInputFileData%BldNd_OutList) + if (.not. allocated(DstInputFileData%BldNd_OutList)) then + allocate(DstInputFileData%BldNd_OutList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BldNd_OutList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%BldNd_OutList = SrcInputFileData%BldNd_OutList + else if (allocated(DstInputFileData%BldNd_OutList)) then + deallocate(DstInputFileData%BldNd_OutList) + end if + DstInputFileData%BldNd_BlOutNd_Str = SrcInputFileData%BldNd_BlOutNd_Str + DstInputFileData%BldNd_BladesOut = SrcInputFileData%BldNd_BladesOut +end subroutine +subroutine ED_DestroyInputFile(InputFileData, ErrStat, ErrMsg) + type(ED_InputFile), intent(inout) :: InputFileData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ED_DestroyInputFile' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputFileData%BlPitch)) then + deallocate(InputFileData%BlPitch) + end if + if (allocated(InputFileData%PreCone)) then + deallocate(InputFileData%PreCone) + end if + if (allocated(InputFileData%TipMass)) then + deallocate(InputFileData%TipMass) + end if + if (allocated(InputFileData%InpBlMesh)) then + LB(1:1) = lbound(InputFileData%InpBlMesh) + UB(1:1) = ubound(InputFileData%InpBlMesh) + do i1 = LB(1), UB(1) + call ED_DestroyBladeMeshInputData(InputFileData%InpBlMesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputFileData%InpBlMesh) + end if + if (allocated(InputFileData%InpBl)) then + LB(1:1) = lbound(InputFileData%InpBl) + UB(1:1) = ubound(InputFileData%InpBl) + do i1 = LB(1), UB(1) + call ED_DestroyBladeInputData(InputFileData%InpBl(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputFileData%InpBl) + end if + if (allocated(InputFileData%OutList)) then + deallocate(InputFileData%OutList) + end if + if (allocated(InputFileData%HtFract)) then + deallocate(InputFileData%HtFract) + end if + if (allocated(InputFileData%TMassDen)) then + deallocate(InputFileData%TMassDen) + end if + if (allocated(InputFileData%TwFAStif)) then + deallocate(InputFileData%TwFAStif) + end if + if (allocated(InputFileData%TwSSStif)) then + deallocate(InputFileData%TwSSStif) + end if + if (allocated(InputFileData%TwFAM1Sh)) then + deallocate(InputFileData%TwFAM1Sh) + end if + if (allocated(InputFileData%TwFAM2Sh)) then + deallocate(InputFileData%TwFAM2Sh) + end if + if (allocated(InputFileData%TwSSM1Sh)) then + deallocate(InputFileData%TwSSM1Sh) + end if + if (allocated(InputFileData%TwSSM2Sh)) then + deallocate(InputFileData%TwSSM2Sh) + end if + if (allocated(InputFileData%BldNd_OutList)) then + deallocate(InputFileData%BldNd_OutList) + end if +end subroutine subroutine ED_PackInputFile(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -2547,226 +2482,156 @@ subroutine ED_PackInputFile(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! DT call RegPack(Buf, InData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! FlapDOF1 call RegPack(Buf, InData%FlapDOF1) if (RegCheckErr(Buf, RoutineName)) return - ! FlapDOF2 call RegPack(Buf, InData%FlapDOF2) if (RegCheckErr(Buf, RoutineName)) return - ! EdgeDOF call RegPack(Buf, InData%EdgeDOF) if (RegCheckErr(Buf, RoutineName)) return - ! TeetDOF call RegPack(Buf, InData%TeetDOF) if (RegCheckErr(Buf, RoutineName)) return - ! DrTrDOF call RegPack(Buf, InData%DrTrDOF) if (RegCheckErr(Buf, RoutineName)) return - ! GenDOF call RegPack(Buf, InData%GenDOF) if (RegCheckErr(Buf, RoutineName)) return - ! YawDOF call RegPack(Buf, InData%YawDOF) if (RegCheckErr(Buf, RoutineName)) return - ! TwFADOF1 call RegPack(Buf, InData%TwFADOF1) if (RegCheckErr(Buf, RoutineName)) return - ! TwFADOF2 call RegPack(Buf, InData%TwFADOF2) if (RegCheckErr(Buf, RoutineName)) return - ! TwSSDOF1 call RegPack(Buf, InData%TwSSDOF1) if (RegCheckErr(Buf, RoutineName)) return - ! TwSSDOF2 call RegPack(Buf, InData%TwSSDOF2) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmSgDOF call RegPack(Buf, InData%PtfmSgDOF) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmSwDOF call RegPack(Buf, InData%PtfmSwDOF) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmHvDOF call RegPack(Buf, InData%PtfmHvDOF) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmRDOF call RegPack(Buf, InData%PtfmRDOF) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmPDOF call RegPack(Buf, InData%PtfmPDOF) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmYDOF call RegPack(Buf, InData%PtfmYDOF) if (RegCheckErr(Buf, RoutineName)) return - ! OoPDefl call RegPack(Buf, InData%OoPDefl) if (RegCheckErr(Buf, RoutineName)) return - ! IPDefl call RegPack(Buf, InData%IPDefl) if (RegCheckErr(Buf, RoutineName)) return - ! BlPitch call RegPack(Buf, allocated(InData%BlPitch)) if (allocated(InData%BlPitch)) then call RegPackBounds(Buf, 1, lbound(InData%BlPitch), ubound(InData%BlPitch)) call RegPack(Buf, InData%BlPitch) end if if (RegCheckErr(Buf, RoutineName)) return - ! TeetDefl call RegPack(Buf, InData%TeetDefl) if (RegCheckErr(Buf, RoutineName)) return - ! Azimuth call RegPack(Buf, InData%Azimuth) if (RegCheckErr(Buf, RoutineName)) return - ! RotSpeed call RegPack(Buf, InData%RotSpeed) if (RegCheckErr(Buf, RoutineName)) return - ! NacYaw call RegPack(Buf, InData%NacYaw) if (RegCheckErr(Buf, RoutineName)) return - ! TTDspFA call RegPack(Buf, InData%TTDspFA) if (RegCheckErr(Buf, RoutineName)) return - ! TTDspSS call RegPack(Buf, InData%TTDspSS) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmSurge call RegPack(Buf, InData%PtfmSurge) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmSway call RegPack(Buf, InData%PtfmSway) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmHeave call RegPack(Buf, InData%PtfmHeave) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmRoll call RegPack(Buf, InData%PtfmRoll) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmPitch call RegPack(Buf, InData%PtfmPitch) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmYaw call RegPack(Buf, InData%PtfmYaw) if (RegCheckErr(Buf, RoutineName)) return - ! NumBl call RegPack(Buf, InData%NumBl) if (RegCheckErr(Buf, RoutineName)) return - ! TipRad call RegPack(Buf, InData%TipRad) if (RegCheckErr(Buf, RoutineName)) return - ! HubRad call RegPack(Buf, InData%HubRad) if (RegCheckErr(Buf, RoutineName)) return - ! PreCone call RegPack(Buf, allocated(InData%PreCone)) if (allocated(InData%PreCone)) then call RegPackBounds(Buf, 1, lbound(InData%PreCone), ubound(InData%PreCone)) call RegPack(Buf, InData%PreCone) end if if (RegCheckErr(Buf, RoutineName)) return - ! HubCM call RegPack(Buf, InData%HubCM) if (RegCheckErr(Buf, RoutineName)) return - ! UndSling call RegPack(Buf, InData%UndSling) if (RegCheckErr(Buf, RoutineName)) return - ! Delta3 call RegPack(Buf, InData%Delta3) if (RegCheckErr(Buf, RoutineName)) return - ! AzimB1Up call RegPack(Buf, InData%AzimB1Up) if (RegCheckErr(Buf, RoutineName)) return - ! OverHang call RegPack(Buf, InData%OverHang) if (RegCheckErr(Buf, RoutineName)) return - ! ShftGagL call RegPack(Buf, InData%ShftGagL) if (RegCheckErr(Buf, RoutineName)) return - ! ShftTilt call RegPack(Buf, InData%ShftTilt) if (RegCheckErr(Buf, RoutineName)) return - ! NacCMxn call RegPack(Buf, InData%NacCMxn) if (RegCheckErr(Buf, RoutineName)) return - ! NacCMyn call RegPack(Buf, InData%NacCMyn) if (RegCheckErr(Buf, RoutineName)) return - ! NacCMzn call RegPack(Buf, InData%NacCMzn) if (RegCheckErr(Buf, RoutineName)) return - ! NcIMUxn call RegPack(Buf, InData%NcIMUxn) if (RegCheckErr(Buf, RoutineName)) return - ! NcIMUyn call RegPack(Buf, InData%NcIMUyn) if (RegCheckErr(Buf, RoutineName)) return - ! NcIMUzn call RegPack(Buf, InData%NcIMUzn) if (RegCheckErr(Buf, RoutineName)) return - ! Twr2Shft call RegPack(Buf, InData%Twr2Shft) if (RegCheckErr(Buf, RoutineName)) return - ! TowerHt call RegPack(Buf, InData%TowerHt) if (RegCheckErr(Buf, RoutineName)) return - ! TowerBsHt call RegPack(Buf, InData%TowerBsHt) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmCMxt call RegPack(Buf, InData%PtfmCMxt) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmCMyt call RegPack(Buf, InData%PtfmCMyt) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmCMzt call RegPack(Buf, InData%PtfmCMzt) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmRefzt call RegPack(Buf, InData%PtfmRefzt) if (RegCheckErr(Buf, RoutineName)) return - ! TipMass call RegPack(Buf, allocated(InData%TipMass)) if (allocated(InData%TipMass)) then call RegPackBounds(Buf, 1, lbound(InData%TipMass), ubound(InData%TipMass)) call RegPack(Buf, InData%TipMass) end if if (RegCheckErr(Buf, RoutineName)) return - ! HubMass call RegPack(Buf, InData%HubMass) if (RegCheckErr(Buf, RoutineName)) return - ! HubIner call RegPack(Buf, InData%HubIner) if (RegCheckErr(Buf, RoutineName)) return - ! GenIner call RegPack(Buf, InData%GenIner) if (RegCheckErr(Buf, RoutineName)) return - ! NacMass call RegPack(Buf, InData%NacMass) if (RegCheckErr(Buf, RoutineName)) return - ! NacYIner call RegPack(Buf, InData%NacYIner) if (RegCheckErr(Buf, RoutineName)) return - ! YawBrMass call RegPack(Buf, InData%YawBrMass) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmMass call RegPack(Buf, InData%PtfmMass) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmRIner call RegPack(Buf, InData%PtfmRIner) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmPIner call RegPack(Buf, InData%PtfmPIner) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmYIner call RegPack(Buf, InData%PtfmYIner) if (RegCheckErr(Buf, RoutineName)) return - ! BldNodes call RegPack(Buf, InData%BldNodes) if (RegCheckErr(Buf, RoutineName)) return - ! InpBlMesh call RegPack(Buf, allocated(InData%InpBlMesh)) if (allocated(InData%InpBlMesh)) then call RegPackBounds(Buf, 1, lbound(InData%InpBlMesh), ubound(InData%InpBlMesh)) @@ -2777,7 +2642,6 @@ subroutine ED_PackInputFile(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! InpBl call RegPack(Buf, allocated(InData%InpBl)) if (allocated(InData%InpBl)) then call RegPackBounds(Buf, 1, lbound(InData%InpBl), ubound(InData%InpBl)) @@ -2788,302 +2652,216 @@ subroutine ED_PackInputFile(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! TeetMod call RegPack(Buf, InData%TeetMod) if (RegCheckErr(Buf, RoutineName)) return - ! TeetDmpP call RegPack(Buf, InData%TeetDmpP) if (RegCheckErr(Buf, RoutineName)) return - ! TeetDmp call RegPack(Buf, InData%TeetDmp) if (RegCheckErr(Buf, RoutineName)) return - ! TeetCDmp call RegPack(Buf, InData%TeetCDmp) if (RegCheckErr(Buf, RoutineName)) return - ! TeetSStP call RegPack(Buf, InData%TeetSStP) if (RegCheckErr(Buf, RoutineName)) return - ! TeetHStP call RegPack(Buf, InData%TeetHStP) if (RegCheckErr(Buf, RoutineName)) return - ! TeetSSSp call RegPack(Buf, InData%TeetSSSp) if (RegCheckErr(Buf, RoutineName)) return - ! TeetHSSp call RegPack(Buf, InData%TeetHSSp) if (RegCheckErr(Buf, RoutineName)) return - ! GBoxEff call RegPack(Buf, InData%GBoxEff) if (RegCheckErr(Buf, RoutineName)) return - ! GBRatio call RegPack(Buf, InData%GBRatio) if (RegCheckErr(Buf, RoutineName)) return - ! DTTorSpr call RegPack(Buf, InData%DTTorSpr) if (RegCheckErr(Buf, RoutineName)) return - ! DTTorDmp call RegPack(Buf, InData%DTTorDmp) if (RegCheckErr(Buf, RoutineName)) return - ! Furling call RegPack(Buf, InData%Furling) if (RegCheckErr(Buf, RoutineName)) return - ! TwrNodes call RegPack(Buf, InData%TwrNodes) if (RegCheckErr(Buf, RoutineName)) return - ! SumPrint call RegPack(Buf, InData%SumPrint) if (RegCheckErr(Buf, RoutineName)) return - ! OutFile call RegPack(Buf, InData%OutFile) if (RegCheckErr(Buf, RoutineName)) return - ! TabDelim call RegPack(Buf, InData%TabDelim) if (RegCheckErr(Buf, RoutineName)) return - ! OutFmt call RegPack(Buf, InData%OutFmt) if (RegCheckErr(Buf, RoutineName)) return - ! Tstart call RegPack(Buf, InData%Tstart) if (RegCheckErr(Buf, RoutineName)) return - ! DecFact call RegPack(Buf, InData%DecFact) if (RegCheckErr(Buf, RoutineName)) return - ! NTwGages call RegPack(Buf, InData%NTwGages) if (RegCheckErr(Buf, RoutineName)) return - ! TwrGagNd call RegPack(Buf, InData%TwrGagNd) if (RegCheckErr(Buf, RoutineName)) return - ! NBlGages call RegPack(Buf, InData%NBlGages) if (RegCheckErr(Buf, RoutineName)) return - ! BldGagNd call RegPack(Buf, InData%BldGagNd) if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegPack(Buf, InData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! OutList call RegPack(Buf, allocated(InData%OutList)) if (allocated(InData%OutList)) then call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) call RegPack(Buf, InData%OutList) end if if (RegCheckErr(Buf, RoutineName)) return - ! NTwInpSt call RegPack(Buf, InData%NTwInpSt) if (RegCheckErr(Buf, RoutineName)) return - ! TwrFADmp call RegPack(Buf, InData%TwrFADmp) if (RegCheckErr(Buf, RoutineName)) return - ! TwrSSDmp call RegPack(Buf, InData%TwrSSDmp) if (RegCheckErr(Buf, RoutineName)) return - ! FAStTunr call RegPack(Buf, InData%FAStTunr) if (RegCheckErr(Buf, RoutineName)) return - ! SSStTunr call RegPack(Buf, InData%SSStTunr) if (RegCheckErr(Buf, RoutineName)) return - ! HtFract call RegPack(Buf, allocated(InData%HtFract)) if (allocated(InData%HtFract)) then call RegPackBounds(Buf, 1, lbound(InData%HtFract), ubound(InData%HtFract)) call RegPack(Buf, InData%HtFract) end if if (RegCheckErr(Buf, RoutineName)) return - ! TMassDen call RegPack(Buf, allocated(InData%TMassDen)) if (allocated(InData%TMassDen)) then call RegPackBounds(Buf, 1, lbound(InData%TMassDen), ubound(InData%TMassDen)) call RegPack(Buf, InData%TMassDen) end if if (RegCheckErr(Buf, RoutineName)) return - ! TwFAStif call RegPack(Buf, allocated(InData%TwFAStif)) if (allocated(InData%TwFAStif)) then call RegPackBounds(Buf, 1, lbound(InData%TwFAStif), ubound(InData%TwFAStif)) call RegPack(Buf, InData%TwFAStif) end if if (RegCheckErr(Buf, RoutineName)) return - ! TwSSStif call RegPack(Buf, allocated(InData%TwSSStif)) if (allocated(InData%TwSSStif)) then call RegPackBounds(Buf, 1, lbound(InData%TwSSStif), ubound(InData%TwSSStif)) call RegPack(Buf, InData%TwSSStif) end if if (RegCheckErr(Buf, RoutineName)) return - ! TwFAM1Sh call RegPack(Buf, allocated(InData%TwFAM1Sh)) if (allocated(InData%TwFAM1Sh)) then call RegPackBounds(Buf, 1, lbound(InData%TwFAM1Sh), ubound(InData%TwFAM1Sh)) call RegPack(Buf, InData%TwFAM1Sh) end if if (RegCheckErr(Buf, RoutineName)) return - ! TwFAM2Sh call RegPack(Buf, allocated(InData%TwFAM2Sh)) if (allocated(InData%TwFAM2Sh)) then call RegPackBounds(Buf, 1, lbound(InData%TwFAM2Sh), ubound(InData%TwFAM2Sh)) call RegPack(Buf, InData%TwFAM2Sh) end if if (RegCheckErr(Buf, RoutineName)) return - ! TwSSM1Sh call RegPack(Buf, allocated(InData%TwSSM1Sh)) if (allocated(InData%TwSSM1Sh)) then call RegPackBounds(Buf, 1, lbound(InData%TwSSM1Sh), ubound(InData%TwSSM1Sh)) call RegPack(Buf, InData%TwSSM1Sh) end if if (RegCheckErr(Buf, RoutineName)) return - ! TwSSM2Sh call RegPack(Buf, allocated(InData%TwSSM2Sh)) if (allocated(InData%TwSSM2Sh)) then call RegPackBounds(Buf, 1, lbound(InData%TwSSM2Sh), ubound(InData%TwSSM2Sh)) call RegPack(Buf, InData%TwSSM2Sh) end if if (RegCheckErr(Buf, RoutineName)) return - ! RFrlDOF call RegPack(Buf, InData%RFrlDOF) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlDOF call RegPack(Buf, InData%TFrlDOF) if (RegCheckErr(Buf, RoutineName)) return - ! RotFurl call RegPack(Buf, InData%RotFurl) if (RegCheckErr(Buf, RoutineName)) return - ! TailFurl call RegPack(Buf, InData%TailFurl) if (RegCheckErr(Buf, RoutineName)) return - ! Yaw2Shft call RegPack(Buf, InData%Yaw2Shft) if (RegCheckErr(Buf, RoutineName)) return - ! ShftSkew call RegPack(Buf, InData%ShftSkew) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlCM_n call RegPack(Buf, InData%RFrlCM_n) if (RegCheckErr(Buf, RoutineName)) return - ! BoomCM_n call RegPack(Buf, InData%BoomCM_n) if (RegCheckErr(Buf, RoutineName)) return - ! TFinCM_n call RegPack(Buf, InData%TFinCM_n) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlPnt_n call RegPack(Buf, InData%RFrlPnt_n) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlSkew call RegPack(Buf, InData%RFrlSkew) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlTilt call RegPack(Buf, InData%RFrlTilt) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlPnt_n call RegPack(Buf, InData%TFrlPnt_n) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlSkew call RegPack(Buf, InData%TFrlSkew) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlTilt call RegPack(Buf, InData%TFrlTilt) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlMass call RegPack(Buf, InData%RFrlMass) if (RegCheckErr(Buf, RoutineName)) return - ! BoomMass call RegPack(Buf, InData%BoomMass) if (RegCheckErr(Buf, RoutineName)) return - ! TFinMass call RegPack(Buf, InData%TFinMass) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlIner call RegPack(Buf, InData%RFrlIner) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlIner call RegPack(Buf, InData%TFrlIner) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlMod call RegPack(Buf, InData%RFrlMod) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlSpr call RegPack(Buf, InData%RFrlSpr) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlDmp call RegPack(Buf, InData%RFrlDmp) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlUSSP call RegPack(Buf, InData%RFrlUSSP) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlDSSP call RegPack(Buf, InData%RFrlDSSP) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlUSSpr call RegPack(Buf, InData%RFrlUSSpr) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlDSSpr call RegPack(Buf, InData%RFrlDSSpr) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlUSDP call RegPack(Buf, InData%RFrlUSDP) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlDSDP call RegPack(Buf, InData%RFrlDSDP) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlUSDmp call RegPack(Buf, InData%RFrlUSDmp) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlDSDmp call RegPack(Buf, InData%RFrlDSDmp) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlMod call RegPack(Buf, InData%TFrlMod) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlSpr call RegPack(Buf, InData%TFrlSpr) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlDmp call RegPack(Buf, InData%TFrlDmp) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlUSSP call RegPack(Buf, InData%TFrlUSSP) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlDSSP call RegPack(Buf, InData%TFrlDSSP) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlUSSpr call RegPack(Buf, InData%TFrlUSSpr) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlDSSpr call RegPack(Buf, InData%TFrlDSSpr) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlUSDP call RegPack(Buf, InData%TFrlUSDP) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlDSDP call RegPack(Buf, InData%TFrlDSDP) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlUSDmp call RegPack(Buf, InData%TFrlUSDmp) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlDSDmp call RegPack(Buf, InData%TFrlDSDmp) if (RegCheckErr(Buf, RoutineName)) return - ! method call RegPack(Buf, InData%method) if (RegCheckErr(Buf, RoutineName)) return - ! BldNd_NumOuts call RegPack(Buf, InData%BldNd_NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! BldNd_OutList call RegPack(Buf, allocated(InData%BldNd_OutList)) if (allocated(InData%BldNd_OutList)) then call RegPackBounds(Buf, 1, lbound(InData%BldNd_OutList), ubound(InData%BldNd_OutList)) call RegPack(Buf, InData%BldNd_OutList) end if if (RegCheckErr(Buf, RoutineName)) return - ! BldNd_BlOutNd_Str call RegPack(Buf, InData%BldNd_BlOutNd_Str) if (RegCheckErr(Buf, RoutineName)) return - ! BldNd_BladesOut call RegPack(Buf, InData%BldNd_BladesOut) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3097,67 +2875,46 @@ subroutine ED_UnPackInputFile(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! DT call RegUnpack(Buf, OutData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! FlapDOF1 call RegUnpack(Buf, OutData%FlapDOF1) if (RegCheckErr(Buf, RoutineName)) return - ! FlapDOF2 call RegUnpack(Buf, OutData%FlapDOF2) if (RegCheckErr(Buf, RoutineName)) return - ! EdgeDOF call RegUnpack(Buf, OutData%EdgeDOF) if (RegCheckErr(Buf, RoutineName)) return - ! TeetDOF call RegUnpack(Buf, OutData%TeetDOF) if (RegCheckErr(Buf, RoutineName)) return - ! DrTrDOF call RegUnpack(Buf, OutData%DrTrDOF) if (RegCheckErr(Buf, RoutineName)) return - ! GenDOF call RegUnpack(Buf, OutData%GenDOF) if (RegCheckErr(Buf, RoutineName)) return - ! YawDOF call RegUnpack(Buf, OutData%YawDOF) if (RegCheckErr(Buf, RoutineName)) return - ! TwFADOF1 call RegUnpack(Buf, OutData%TwFADOF1) if (RegCheckErr(Buf, RoutineName)) return - ! TwFADOF2 call RegUnpack(Buf, OutData%TwFADOF2) if (RegCheckErr(Buf, RoutineName)) return - ! TwSSDOF1 call RegUnpack(Buf, OutData%TwSSDOF1) if (RegCheckErr(Buf, RoutineName)) return - ! TwSSDOF2 call RegUnpack(Buf, OutData%TwSSDOF2) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmSgDOF call RegUnpack(Buf, OutData%PtfmSgDOF) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmSwDOF call RegUnpack(Buf, OutData%PtfmSwDOF) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmHvDOF call RegUnpack(Buf, OutData%PtfmHvDOF) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmRDOF call RegUnpack(Buf, OutData%PtfmRDOF) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmPDOF call RegUnpack(Buf, OutData%PtfmPDOF) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmYDOF call RegUnpack(Buf, OutData%PtfmYDOF) if (RegCheckErr(Buf, RoutineName)) return - ! OoPDefl call RegUnpack(Buf, OutData%OoPDefl) if (RegCheckErr(Buf, RoutineName)) return - ! IPDefl call RegUnpack(Buf, OutData%IPDefl) if (RegCheckErr(Buf, RoutineName)) return - ! BlPitch if (allocated(OutData%BlPitch)) deallocate(OutData%BlPitch) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3172,52 +2929,36 @@ subroutine ED_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%BlPitch) if (RegCheckErr(Buf, RoutineName)) return end if - ! TeetDefl call RegUnpack(Buf, OutData%TeetDefl) if (RegCheckErr(Buf, RoutineName)) return - ! Azimuth call RegUnpack(Buf, OutData%Azimuth) if (RegCheckErr(Buf, RoutineName)) return - ! RotSpeed call RegUnpack(Buf, OutData%RotSpeed) if (RegCheckErr(Buf, RoutineName)) return - ! NacYaw call RegUnpack(Buf, OutData%NacYaw) if (RegCheckErr(Buf, RoutineName)) return - ! TTDspFA call RegUnpack(Buf, OutData%TTDspFA) if (RegCheckErr(Buf, RoutineName)) return - ! TTDspSS call RegUnpack(Buf, OutData%TTDspSS) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmSurge call RegUnpack(Buf, OutData%PtfmSurge) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmSway call RegUnpack(Buf, OutData%PtfmSway) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmHeave call RegUnpack(Buf, OutData%PtfmHeave) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmRoll call RegUnpack(Buf, OutData%PtfmRoll) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmPitch call RegUnpack(Buf, OutData%PtfmPitch) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmYaw call RegUnpack(Buf, OutData%PtfmYaw) if (RegCheckErr(Buf, RoutineName)) return - ! NumBl call RegUnpack(Buf, OutData%NumBl) if (RegCheckErr(Buf, RoutineName)) return - ! TipRad call RegUnpack(Buf, OutData%TipRad) if (RegCheckErr(Buf, RoutineName)) return - ! HubRad call RegUnpack(Buf, OutData%HubRad) if (RegCheckErr(Buf, RoutineName)) return - ! PreCone if (allocated(OutData%PreCone)) deallocate(OutData%PreCone) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3232,67 +2973,46 @@ subroutine ED_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%PreCone) if (RegCheckErr(Buf, RoutineName)) return end if - ! HubCM call RegUnpack(Buf, OutData%HubCM) if (RegCheckErr(Buf, RoutineName)) return - ! UndSling call RegUnpack(Buf, OutData%UndSling) if (RegCheckErr(Buf, RoutineName)) return - ! Delta3 call RegUnpack(Buf, OutData%Delta3) if (RegCheckErr(Buf, RoutineName)) return - ! AzimB1Up call RegUnpack(Buf, OutData%AzimB1Up) if (RegCheckErr(Buf, RoutineName)) return - ! OverHang call RegUnpack(Buf, OutData%OverHang) if (RegCheckErr(Buf, RoutineName)) return - ! ShftGagL call RegUnpack(Buf, OutData%ShftGagL) if (RegCheckErr(Buf, RoutineName)) return - ! ShftTilt call RegUnpack(Buf, OutData%ShftTilt) if (RegCheckErr(Buf, RoutineName)) return - ! NacCMxn call RegUnpack(Buf, OutData%NacCMxn) if (RegCheckErr(Buf, RoutineName)) return - ! NacCMyn call RegUnpack(Buf, OutData%NacCMyn) if (RegCheckErr(Buf, RoutineName)) return - ! NacCMzn call RegUnpack(Buf, OutData%NacCMzn) if (RegCheckErr(Buf, RoutineName)) return - ! NcIMUxn call RegUnpack(Buf, OutData%NcIMUxn) if (RegCheckErr(Buf, RoutineName)) return - ! NcIMUyn call RegUnpack(Buf, OutData%NcIMUyn) if (RegCheckErr(Buf, RoutineName)) return - ! NcIMUzn call RegUnpack(Buf, OutData%NcIMUzn) if (RegCheckErr(Buf, RoutineName)) return - ! Twr2Shft call RegUnpack(Buf, OutData%Twr2Shft) if (RegCheckErr(Buf, RoutineName)) return - ! TowerHt call RegUnpack(Buf, OutData%TowerHt) if (RegCheckErr(Buf, RoutineName)) return - ! TowerBsHt call RegUnpack(Buf, OutData%TowerBsHt) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmCMxt call RegUnpack(Buf, OutData%PtfmCMxt) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmCMyt call RegUnpack(Buf, OutData%PtfmCMyt) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmCMzt call RegUnpack(Buf, OutData%PtfmCMzt) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmRefzt call RegUnpack(Buf, OutData%PtfmRefzt) if (RegCheckErr(Buf, RoutineName)) return - ! TipMass if (allocated(OutData%TipMass)) deallocate(OutData%TipMass) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3307,40 +3027,28 @@ subroutine ED_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%TipMass) if (RegCheckErr(Buf, RoutineName)) return end if - ! HubMass call RegUnpack(Buf, OutData%HubMass) if (RegCheckErr(Buf, RoutineName)) return - ! HubIner call RegUnpack(Buf, OutData%HubIner) if (RegCheckErr(Buf, RoutineName)) return - ! GenIner call RegUnpack(Buf, OutData%GenIner) if (RegCheckErr(Buf, RoutineName)) return - ! NacMass call RegUnpack(Buf, OutData%NacMass) if (RegCheckErr(Buf, RoutineName)) return - ! NacYIner call RegUnpack(Buf, OutData%NacYIner) if (RegCheckErr(Buf, RoutineName)) return - ! YawBrMass call RegUnpack(Buf, OutData%YawBrMass) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmMass call RegUnpack(Buf, OutData%PtfmMass) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmRIner call RegUnpack(Buf, OutData%PtfmRIner) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmPIner call RegUnpack(Buf, OutData%PtfmPIner) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmYIner call RegUnpack(Buf, OutData%PtfmYIner) if (RegCheckErr(Buf, RoutineName)) return - ! BldNodes call RegUnpack(Buf, OutData%BldNodes) if (RegCheckErr(Buf, RoutineName)) return - ! InpBlMesh if (allocated(OutData%InpBlMesh)) deallocate(OutData%InpBlMesh) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3356,7 +3064,6 @@ subroutine ED_UnPackInputFile(Buf, OutData) call ED_UnpackBladeMeshInputData(Buf, OutData%InpBlMesh(i1)) ! InpBlMesh end do end if - ! InpBl if (allocated(OutData%InpBl)) deallocate(OutData%InpBl) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3372,82 +3079,56 @@ subroutine ED_UnPackInputFile(Buf, OutData) call ED_UnpackBladeInputData(Buf, OutData%InpBl(i1)) ! InpBl end do end if - ! TeetMod call RegUnpack(Buf, OutData%TeetMod) if (RegCheckErr(Buf, RoutineName)) return - ! TeetDmpP call RegUnpack(Buf, OutData%TeetDmpP) if (RegCheckErr(Buf, RoutineName)) return - ! TeetDmp call RegUnpack(Buf, OutData%TeetDmp) if (RegCheckErr(Buf, RoutineName)) return - ! TeetCDmp call RegUnpack(Buf, OutData%TeetCDmp) if (RegCheckErr(Buf, RoutineName)) return - ! TeetSStP call RegUnpack(Buf, OutData%TeetSStP) if (RegCheckErr(Buf, RoutineName)) return - ! TeetHStP call RegUnpack(Buf, OutData%TeetHStP) if (RegCheckErr(Buf, RoutineName)) return - ! TeetSSSp call RegUnpack(Buf, OutData%TeetSSSp) if (RegCheckErr(Buf, RoutineName)) return - ! TeetHSSp call RegUnpack(Buf, OutData%TeetHSSp) if (RegCheckErr(Buf, RoutineName)) return - ! GBoxEff call RegUnpack(Buf, OutData%GBoxEff) if (RegCheckErr(Buf, RoutineName)) return - ! GBRatio call RegUnpack(Buf, OutData%GBRatio) if (RegCheckErr(Buf, RoutineName)) return - ! DTTorSpr call RegUnpack(Buf, OutData%DTTorSpr) if (RegCheckErr(Buf, RoutineName)) return - ! DTTorDmp call RegUnpack(Buf, OutData%DTTorDmp) if (RegCheckErr(Buf, RoutineName)) return - ! Furling call RegUnpack(Buf, OutData%Furling) if (RegCheckErr(Buf, RoutineName)) return - ! TwrNodes call RegUnpack(Buf, OutData%TwrNodes) if (RegCheckErr(Buf, RoutineName)) return - ! SumPrint call RegUnpack(Buf, OutData%SumPrint) if (RegCheckErr(Buf, RoutineName)) return - ! OutFile call RegUnpack(Buf, OutData%OutFile) if (RegCheckErr(Buf, RoutineName)) return - ! TabDelim call RegUnpack(Buf, OutData%TabDelim) if (RegCheckErr(Buf, RoutineName)) return - ! OutFmt call RegUnpack(Buf, OutData%OutFmt) if (RegCheckErr(Buf, RoutineName)) return - ! Tstart call RegUnpack(Buf, OutData%Tstart) if (RegCheckErr(Buf, RoutineName)) return - ! DecFact call RegUnpack(Buf, OutData%DecFact) if (RegCheckErr(Buf, RoutineName)) return - ! NTwGages call RegUnpack(Buf, OutData%NTwGages) if (RegCheckErr(Buf, RoutineName)) return - ! TwrGagNd call RegUnpack(Buf, OutData%TwrGagNd) if (RegCheckErr(Buf, RoutineName)) return - ! NBlGages call RegUnpack(Buf, OutData%NBlGages) if (RegCheckErr(Buf, RoutineName)) return - ! BldGagNd call RegUnpack(Buf, OutData%BldGagNd) if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegUnpack(Buf, OutData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! OutList if (allocated(OutData%OutList)) deallocate(OutData%OutList) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3462,22 +3143,16 @@ subroutine ED_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%OutList) if (RegCheckErr(Buf, RoutineName)) return end if - ! NTwInpSt call RegUnpack(Buf, OutData%NTwInpSt) if (RegCheckErr(Buf, RoutineName)) return - ! TwrFADmp call RegUnpack(Buf, OutData%TwrFADmp) if (RegCheckErr(Buf, RoutineName)) return - ! TwrSSDmp call RegUnpack(Buf, OutData%TwrSSDmp) if (RegCheckErr(Buf, RoutineName)) return - ! FAStTunr call RegUnpack(Buf, OutData%FAStTunr) if (RegCheckErr(Buf, RoutineName)) return - ! SSStTunr call RegUnpack(Buf, OutData%SSStTunr) if (RegCheckErr(Buf, RoutineName)) return - ! HtFract if (allocated(OutData%HtFract)) deallocate(OutData%HtFract) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3492,7 +3167,6 @@ subroutine ED_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%HtFract) if (RegCheckErr(Buf, RoutineName)) return end if - ! TMassDen if (allocated(OutData%TMassDen)) deallocate(OutData%TMassDen) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3507,7 +3181,6 @@ subroutine ED_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%TMassDen) if (RegCheckErr(Buf, RoutineName)) return end if - ! TwFAStif if (allocated(OutData%TwFAStif)) deallocate(OutData%TwFAStif) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3522,7 +3195,6 @@ subroutine ED_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%TwFAStif) if (RegCheckErr(Buf, RoutineName)) return end if - ! TwSSStif if (allocated(OutData%TwSSStif)) deallocate(OutData%TwSSStif) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3537,7 +3209,6 @@ subroutine ED_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%TwSSStif) if (RegCheckErr(Buf, RoutineName)) return end if - ! TwFAM1Sh if (allocated(OutData%TwFAM1Sh)) deallocate(OutData%TwFAM1Sh) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3552,7 +3223,6 @@ subroutine ED_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%TwFAM1Sh) if (RegCheckErr(Buf, RoutineName)) return end if - ! TwFAM2Sh if (allocated(OutData%TwFAM2Sh)) deallocate(OutData%TwFAM2Sh) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3567,7 +3237,6 @@ subroutine ED_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%TwFAM2Sh) if (RegCheckErr(Buf, RoutineName)) return end if - ! TwSSM1Sh if (allocated(OutData%TwSSM1Sh)) deallocate(OutData%TwSSM1Sh) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3582,7 +3251,6 @@ subroutine ED_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%TwSSM1Sh) if (RegCheckErr(Buf, RoutineName)) return end if - ! TwSSM2Sh if (allocated(OutData%TwSSM2Sh)) deallocate(OutData%TwSSM2Sh) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3597,139 +3265,94 @@ subroutine ED_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%TwSSM2Sh) if (RegCheckErr(Buf, RoutineName)) return end if - ! RFrlDOF call RegUnpack(Buf, OutData%RFrlDOF) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlDOF call RegUnpack(Buf, OutData%TFrlDOF) if (RegCheckErr(Buf, RoutineName)) return - ! RotFurl call RegUnpack(Buf, OutData%RotFurl) if (RegCheckErr(Buf, RoutineName)) return - ! TailFurl call RegUnpack(Buf, OutData%TailFurl) if (RegCheckErr(Buf, RoutineName)) return - ! Yaw2Shft call RegUnpack(Buf, OutData%Yaw2Shft) if (RegCheckErr(Buf, RoutineName)) return - ! ShftSkew call RegUnpack(Buf, OutData%ShftSkew) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlCM_n call RegUnpack(Buf, OutData%RFrlCM_n) if (RegCheckErr(Buf, RoutineName)) return - ! BoomCM_n call RegUnpack(Buf, OutData%BoomCM_n) if (RegCheckErr(Buf, RoutineName)) return - ! TFinCM_n call RegUnpack(Buf, OutData%TFinCM_n) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlPnt_n call RegUnpack(Buf, OutData%RFrlPnt_n) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlSkew call RegUnpack(Buf, OutData%RFrlSkew) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlTilt call RegUnpack(Buf, OutData%RFrlTilt) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlPnt_n call RegUnpack(Buf, OutData%TFrlPnt_n) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlSkew call RegUnpack(Buf, OutData%TFrlSkew) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlTilt call RegUnpack(Buf, OutData%TFrlTilt) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlMass call RegUnpack(Buf, OutData%RFrlMass) if (RegCheckErr(Buf, RoutineName)) return - ! BoomMass call RegUnpack(Buf, OutData%BoomMass) if (RegCheckErr(Buf, RoutineName)) return - ! TFinMass call RegUnpack(Buf, OutData%TFinMass) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlIner call RegUnpack(Buf, OutData%RFrlIner) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlIner call RegUnpack(Buf, OutData%TFrlIner) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlMod call RegUnpack(Buf, OutData%RFrlMod) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlSpr call RegUnpack(Buf, OutData%RFrlSpr) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlDmp call RegUnpack(Buf, OutData%RFrlDmp) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlUSSP call RegUnpack(Buf, OutData%RFrlUSSP) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlDSSP call RegUnpack(Buf, OutData%RFrlDSSP) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlUSSpr call RegUnpack(Buf, OutData%RFrlUSSpr) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlDSSpr call RegUnpack(Buf, OutData%RFrlDSSpr) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlUSDP call RegUnpack(Buf, OutData%RFrlUSDP) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlDSDP call RegUnpack(Buf, OutData%RFrlDSDP) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlUSDmp call RegUnpack(Buf, OutData%RFrlUSDmp) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlDSDmp call RegUnpack(Buf, OutData%RFrlDSDmp) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlMod call RegUnpack(Buf, OutData%TFrlMod) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlSpr call RegUnpack(Buf, OutData%TFrlSpr) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlDmp call RegUnpack(Buf, OutData%TFrlDmp) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlUSSP call RegUnpack(Buf, OutData%TFrlUSSP) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlDSSP call RegUnpack(Buf, OutData%TFrlDSSP) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlUSSpr call RegUnpack(Buf, OutData%TFrlUSSpr) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlDSSpr call RegUnpack(Buf, OutData%TFrlDSSpr) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlUSDP call RegUnpack(Buf, OutData%TFrlUSDP) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlDSDP call RegUnpack(Buf, OutData%TFrlDSDP) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlUSDmp call RegUnpack(Buf, OutData%TFrlUSDmp) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlDSDmp call RegUnpack(Buf, OutData%TFrlDSDmp) if (RegCheckErr(Buf, RoutineName)) return - ! method call RegUnpack(Buf, OutData%method) if (RegCheckErr(Buf, RoutineName)) return - ! BldNd_NumOuts call RegUnpack(Buf, OutData%BldNd_NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! BldNd_OutList if (allocated(OutData%BldNd_OutList)) deallocate(OutData%BldNd_OutList) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3744,629 +3367,547 @@ subroutine ED_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%BldNd_OutList) if (RegCheckErr(Buf, RoutineName)) return end if - ! BldNd_BlOutNd_Str call RegUnpack(Buf, OutData%BldNd_BlOutNd_Str) if (RegCheckErr(Buf, RoutineName)) return - ! BldNd_BladesOut call RegUnpack(Buf, OutData%BldNd_BladesOut) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE ED_CopyCoordSys( SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_CoordSys), INTENT(IN) :: SrcCoordSysData - TYPE(ED_CoordSys), INTENT(INOUT) :: DstCoordSysData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_CopyCoordSys' -! - ErrStat = ErrID_None - ErrMsg = "" - DstCoordSysData%a1 = SrcCoordSysData%a1 - DstCoordSysData%a2 = SrcCoordSysData%a2 - DstCoordSysData%a3 = SrcCoordSysData%a3 - DstCoordSysData%b1 = SrcCoordSysData%b1 - DstCoordSysData%b2 = SrcCoordSysData%b2 - DstCoordSysData%b3 = SrcCoordSysData%b3 - DstCoordSysData%c1 = SrcCoordSysData%c1 - DstCoordSysData%c2 = SrcCoordSysData%c2 - DstCoordSysData%c3 = SrcCoordSysData%c3 - DstCoordSysData%d1 = SrcCoordSysData%d1 - DstCoordSysData%d2 = SrcCoordSysData%d2 - DstCoordSysData%d3 = SrcCoordSysData%d3 - DstCoordSysData%e1 = SrcCoordSysData%e1 - DstCoordSysData%e2 = SrcCoordSysData%e2 - DstCoordSysData%e3 = SrcCoordSysData%e3 - DstCoordSysData%f1 = SrcCoordSysData%f1 - DstCoordSysData%f2 = SrcCoordSysData%f2 - DstCoordSysData%f3 = SrcCoordSysData%f3 - DstCoordSysData%g1 = SrcCoordSysData%g1 - DstCoordSysData%g2 = SrcCoordSysData%g2 - DstCoordSysData%g3 = SrcCoordSysData%g3 -IF (ALLOCATED(SrcCoordSysData%i1)) THEN - i1_l = LBOUND(SrcCoordSysData%i1,1) - i1_u = UBOUND(SrcCoordSysData%i1,1) - i2_l = LBOUND(SrcCoordSysData%i1,2) - i2_u = UBOUND(SrcCoordSysData%i1,2) - IF (.NOT. ALLOCATED(DstCoordSysData%i1)) THEN - ALLOCATE(DstCoordSysData%i1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%i1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%i1 = SrcCoordSysData%i1 -ENDIF -IF (ALLOCATED(SrcCoordSysData%i2)) THEN - i1_l = LBOUND(SrcCoordSysData%i2,1) - i1_u = UBOUND(SrcCoordSysData%i2,1) - i2_l = LBOUND(SrcCoordSysData%i2,2) - i2_u = UBOUND(SrcCoordSysData%i2,2) - IF (.NOT. ALLOCATED(DstCoordSysData%i2)) THEN - ALLOCATE(DstCoordSysData%i2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%i2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%i2 = SrcCoordSysData%i2 -ENDIF -IF (ALLOCATED(SrcCoordSysData%i3)) THEN - i1_l = LBOUND(SrcCoordSysData%i3,1) - i1_u = UBOUND(SrcCoordSysData%i3,1) - i2_l = LBOUND(SrcCoordSysData%i3,2) - i2_u = UBOUND(SrcCoordSysData%i3,2) - IF (.NOT. ALLOCATED(DstCoordSysData%i3)) THEN - ALLOCATE(DstCoordSysData%i3(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%i3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%i3 = SrcCoordSysData%i3 -ENDIF -IF (ALLOCATED(SrcCoordSysData%j1)) THEN - i1_l = LBOUND(SrcCoordSysData%j1,1) - i1_u = UBOUND(SrcCoordSysData%j1,1) - i2_l = LBOUND(SrcCoordSysData%j1,2) - i2_u = UBOUND(SrcCoordSysData%j1,2) - IF (.NOT. ALLOCATED(DstCoordSysData%j1)) THEN - ALLOCATE(DstCoordSysData%j1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%j1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%j1 = SrcCoordSysData%j1 -ENDIF -IF (ALLOCATED(SrcCoordSysData%j2)) THEN - i1_l = LBOUND(SrcCoordSysData%j2,1) - i1_u = UBOUND(SrcCoordSysData%j2,1) - i2_l = LBOUND(SrcCoordSysData%j2,2) - i2_u = UBOUND(SrcCoordSysData%j2,2) - IF (.NOT. ALLOCATED(DstCoordSysData%j2)) THEN - ALLOCATE(DstCoordSysData%j2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%j2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%j2 = SrcCoordSysData%j2 -ENDIF -IF (ALLOCATED(SrcCoordSysData%j3)) THEN - i1_l = LBOUND(SrcCoordSysData%j3,1) - i1_u = UBOUND(SrcCoordSysData%j3,1) - i2_l = LBOUND(SrcCoordSysData%j3,2) - i2_u = UBOUND(SrcCoordSysData%j3,2) - IF (.NOT. ALLOCATED(DstCoordSysData%j3)) THEN - ALLOCATE(DstCoordSysData%j3(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%j3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%j3 = SrcCoordSysData%j3 -ENDIF -IF (ALLOCATED(SrcCoordSysData%m1)) THEN - i1_l = LBOUND(SrcCoordSysData%m1,1) - i1_u = UBOUND(SrcCoordSysData%m1,1) - i2_l = LBOUND(SrcCoordSysData%m1,2) - i2_u = UBOUND(SrcCoordSysData%m1,2) - i3_l = LBOUND(SrcCoordSysData%m1,3) - i3_u = UBOUND(SrcCoordSysData%m1,3) - IF (.NOT. ALLOCATED(DstCoordSysData%m1)) THEN - ALLOCATE(DstCoordSysData%m1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%m1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%m1 = SrcCoordSysData%m1 -ENDIF -IF (ALLOCATED(SrcCoordSysData%m2)) THEN - i1_l = LBOUND(SrcCoordSysData%m2,1) - i1_u = UBOUND(SrcCoordSysData%m2,1) - i2_l = LBOUND(SrcCoordSysData%m2,2) - i2_u = UBOUND(SrcCoordSysData%m2,2) - i3_l = LBOUND(SrcCoordSysData%m2,3) - i3_u = UBOUND(SrcCoordSysData%m2,3) - IF (.NOT. ALLOCATED(DstCoordSysData%m2)) THEN - ALLOCATE(DstCoordSysData%m2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%m2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%m2 = SrcCoordSysData%m2 -ENDIF -IF (ALLOCATED(SrcCoordSysData%m3)) THEN - i1_l = LBOUND(SrcCoordSysData%m3,1) - i1_u = UBOUND(SrcCoordSysData%m3,1) - i2_l = LBOUND(SrcCoordSysData%m3,2) - i2_u = UBOUND(SrcCoordSysData%m3,2) - i3_l = LBOUND(SrcCoordSysData%m3,3) - i3_u = UBOUND(SrcCoordSysData%m3,3) - IF (.NOT. ALLOCATED(DstCoordSysData%m3)) THEN - ALLOCATE(DstCoordSysData%m3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%m3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%m3 = SrcCoordSysData%m3 -ENDIF -IF (ALLOCATED(SrcCoordSysData%n1)) THEN - i1_l = LBOUND(SrcCoordSysData%n1,1) - i1_u = UBOUND(SrcCoordSysData%n1,1) - i2_l = LBOUND(SrcCoordSysData%n1,2) - i2_u = UBOUND(SrcCoordSysData%n1,2) - i3_l = LBOUND(SrcCoordSysData%n1,3) - i3_u = UBOUND(SrcCoordSysData%n1,3) - IF (.NOT. ALLOCATED(DstCoordSysData%n1)) THEN - ALLOCATE(DstCoordSysData%n1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%n1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%n1 = SrcCoordSysData%n1 -ENDIF -IF (ALLOCATED(SrcCoordSysData%n2)) THEN - i1_l = LBOUND(SrcCoordSysData%n2,1) - i1_u = UBOUND(SrcCoordSysData%n2,1) - i2_l = LBOUND(SrcCoordSysData%n2,2) - i2_u = UBOUND(SrcCoordSysData%n2,2) - i3_l = LBOUND(SrcCoordSysData%n2,3) - i3_u = UBOUND(SrcCoordSysData%n2,3) - IF (.NOT. ALLOCATED(DstCoordSysData%n2)) THEN - ALLOCATE(DstCoordSysData%n2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%n2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%n2 = SrcCoordSysData%n2 -ENDIF -IF (ALLOCATED(SrcCoordSysData%n3)) THEN - i1_l = LBOUND(SrcCoordSysData%n3,1) - i1_u = UBOUND(SrcCoordSysData%n3,1) - i2_l = LBOUND(SrcCoordSysData%n3,2) - i2_u = UBOUND(SrcCoordSysData%n3,2) - i3_l = LBOUND(SrcCoordSysData%n3,3) - i3_u = UBOUND(SrcCoordSysData%n3,3) - IF (.NOT. ALLOCATED(DstCoordSysData%n3)) THEN - ALLOCATE(DstCoordSysData%n3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%n3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%n3 = SrcCoordSysData%n3 -ENDIF - DstCoordSysData%rf1 = SrcCoordSysData%rf1 - DstCoordSysData%rf2 = SrcCoordSysData%rf2 - DstCoordSysData%rf3 = SrcCoordSysData%rf3 - DstCoordSysData%rfa = SrcCoordSysData%rfa -IF (ALLOCATED(SrcCoordSysData%t1)) THEN - i1_l = LBOUND(SrcCoordSysData%t1,1) - i1_u = UBOUND(SrcCoordSysData%t1,1) - i2_l = LBOUND(SrcCoordSysData%t1,2) - i2_u = UBOUND(SrcCoordSysData%t1,2) - IF (.NOT. ALLOCATED(DstCoordSysData%t1)) THEN - ALLOCATE(DstCoordSysData%t1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%t1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%t1 = SrcCoordSysData%t1 -ENDIF -IF (ALLOCATED(SrcCoordSysData%t2)) THEN - i1_l = LBOUND(SrcCoordSysData%t2,1) - i1_u = UBOUND(SrcCoordSysData%t2,1) - i2_l = LBOUND(SrcCoordSysData%t2,2) - i2_u = UBOUND(SrcCoordSysData%t2,2) - IF (.NOT. ALLOCATED(DstCoordSysData%t2)) THEN - ALLOCATE(DstCoordSysData%t2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%t2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%t2 = SrcCoordSysData%t2 -ENDIF -IF (ALLOCATED(SrcCoordSysData%t3)) THEN - i1_l = LBOUND(SrcCoordSysData%t3,1) - i1_u = UBOUND(SrcCoordSysData%t3,1) - i2_l = LBOUND(SrcCoordSysData%t3,2) - i2_u = UBOUND(SrcCoordSysData%t3,2) - IF (.NOT. ALLOCATED(DstCoordSysData%t3)) THEN - ALLOCATE(DstCoordSysData%t3(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%t3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%t3 = SrcCoordSysData%t3 -ENDIF -IF (ALLOCATED(SrcCoordSysData%te1)) THEN - i1_l = LBOUND(SrcCoordSysData%te1,1) - i1_u = UBOUND(SrcCoordSysData%te1,1) - i2_l = LBOUND(SrcCoordSysData%te1,2) - i2_u = UBOUND(SrcCoordSysData%te1,2) - i3_l = LBOUND(SrcCoordSysData%te1,3) - i3_u = UBOUND(SrcCoordSysData%te1,3) - IF (.NOT. ALLOCATED(DstCoordSysData%te1)) THEN - ALLOCATE(DstCoordSysData%te1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%te1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%te1 = SrcCoordSysData%te1 -ENDIF -IF (ALLOCATED(SrcCoordSysData%te2)) THEN - i1_l = LBOUND(SrcCoordSysData%te2,1) - i1_u = UBOUND(SrcCoordSysData%te2,1) - i2_l = LBOUND(SrcCoordSysData%te2,2) - i2_u = UBOUND(SrcCoordSysData%te2,2) - i3_l = LBOUND(SrcCoordSysData%te2,3) - i3_u = UBOUND(SrcCoordSysData%te2,3) - IF (.NOT. ALLOCATED(DstCoordSysData%te2)) THEN - ALLOCATE(DstCoordSysData%te2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%te2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%te2 = SrcCoordSysData%te2 -ENDIF -IF (ALLOCATED(SrcCoordSysData%te3)) THEN - i1_l = LBOUND(SrcCoordSysData%te3,1) - i1_u = UBOUND(SrcCoordSysData%te3,1) - i2_l = LBOUND(SrcCoordSysData%te3,2) - i2_u = UBOUND(SrcCoordSysData%te3,2) - i3_l = LBOUND(SrcCoordSysData%te3,3) - i3_u = UBOUND(SrcCoordSysData%te3,3) - IF (.NOT. ALLOCATED(DstCoordSysData%te3)) THEN - ALLOCATE(DstCoordSysData%te3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%te3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCoordSysData%te3 = SrcCoordSysData%te3 -ENDIF - DstCoordSysData%tf1 = SrcCoordSysData%tf1 - DstCoordSysData%tf2 = SrcCoordSysData%tf2 - DstCoordSysData%tf3 = SrcCoordSysData%tf3 - DstCoordSysData%tfa = SrcCoordSysData%tfa - DstCoordSysData%z1 = SrcCoordSysData%z1 - DstCoordSysData%z2 = SrcCoordSysData%z2 - DstCoordSysData%z3 = SrcCoordSysData%z3 - END SUBROUTINE ED_CopyCoordSys - - SUBROUTINE ED_DestroyCoordSys( CoordSysData, ErrStat, ErrMsg ) - TYPE(ED_CoordSys), INTENT(INOUT) :: CoordSysData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyCoordSys' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(CoordSysData%i1)) THEN - DEALLOCATE(CoordSysData%i1) -ENDIF -IF (ALLOCATED(CoordSysData%i2)) THEN - DEALLOCATE(CoordSysData%i2) -ENDIF -IF (ALLOCATED(CoordSysData%i3)) THEN - DEALLOCATE(CoordSysData%i3) -ENDIF -IF (ALLOCATED(CoordSysData%j1)) THEN - DEALLOCATE(CoordSysData%j1) -ENDIF -IF (ALLOCATED(CoordSysData%j2)) THEN - DEALLOCATE(CoordSysData%j2) -ENDIF -IF (ALLOCATED(CoordSysData%j3)) THEN - DEALLOCATE(CoordSysData%j3) -ENDIF -IF (ALLOCATED(CoordSysData%m1)) THEN - DEALLOCATE(CoordSysData%m1) -ENDIF -IF (ALLOCATED(CoordSysData%m2)) THEN - DEALLOCATE(CoordSysData%m2) -ENDIF -IF (ALLOCATED(CoordSysData%m3)) THEN - DEALLOCATE(CoordSysData%m3) -ENDIF -IF (ALLOCATED(CoordSysData%n1)) THEN - DEALLOCATE(CoordSysData%n1) -ENDIF -IF (ALLOCATED(CoordSysData%n2)) THEN - DEALLOCATE(CoordSysData%n2) -ENDIF -IF (ALLOCATED(CoordSysData%n3)) THEN - DEALLOCATE(CoordSysData%n3) -ENDIF -IF (ALLOCATED(CoordSysData%t1)) THEN - DEALLOCATE(CoordSysData%t1) -ENDIF -IF (ALLOCATED(CoordSysData%t2)) THEN - DEALLOCATE(CoordSysData%t2) -ENDIF -IF (ALLOCATED(CoordSysData%t3)) THEN - DEALLOCATE(CoordSysData%t3) -ENDIF -IF (ALLOCATED(CoordSysData%te1)) THEN - DEALLOCATE(CoordSysData%te1) -ENDIF -IF (ALLOCATED(CoordSysData%te2)) THEN - DEALLOCATE(CoordSysData%te2) -ENDIF -IF (ALLOCATED(CoordSysData%te3)) THEN - DEALLOCATE(CoordSysData%te3) -ENDIF - END SUBROUTINE ED_DestroyCoordSys +subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, ErrMsg) + type(ED_CoordSys), intent(in) :: SrcCoordSysData + type(ED_CoordSys), intent(inout) :: DstCoordSysData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'ED_CopyCoordSys' + ErrStat = ErrID_None + ErrMsg = '' + DstCoordSysData%a1 = SrcCoordSysData%a1 + DstCoordSysData%a2 = SrcCoordSysData%a2 + DstCoordSysData%a3 = SrcCoordSysData%a3 + DstCoordSysData%b1 = SrcCoordSysData%b1 + DstCoordSysData%b2 = SrcCoordSysData%b2 + DstCoordSysData%b3 = SrcCoordSysData%b3 + DstCoordSysData%c1 = SrcCoordSysData%c1 + DstCoordSysData%c2 = SrcCoordSysData%c2 + DstCoordSysData%c3 = SrcCoordSysData%c3 + DstCoordSysData%d1 = SrcCoordSysData%d1 + DstCoordSysData%d2 = SrcCoordSysData%d2 + DstCoordSysData%d3 = SrcCoordSysData%d3 + DstCoordSysData%e1 = SrcCoordSysData%e1 + DstCoordSysData%e2 = SrcCoordSysData%e2 + DstCoordSysData%e3 = SrcCoordSysData%e3 + DstCoordSysData%f1 = SrcCoordSysData%f1 + DstCoordSysData%f2 = SrcCoordSysData%f2 + DstCoordSysData%f3 = SrcCoordSysData%f3 + DstCoordSysData%g1 = SrcCoordSysData%g1 + DstCoordSysData%g2 = SrcCoordSysData%g2 + DstCoordSysData%g3 = SrcCoordSysData%g3 + if (allocated(SrcCoordSysData%i1)) then + LB(1:2) = lbound(SrcCoordSysData%i1) + UB(1:2) = ubound(SrcCoordSysData%i1) + if (.not. allocated(DstCoordSysData%i1)) then + allocate(DstCoordSysData%i1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%i1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%i1 = SrcCoordSysData%i1 + else if (allocated(DstCoordSysData%i1)) then + deallocate(DstCoordSysData%i1) + end if + if (allocated(SrcCoordSysData%i2)) then + LB(1:2) = lbound(SrcCoordSysData%i2) + UB(1:2) = ubound(SrcCoordSysData%i2) + if (.not. allocated(DstCoordSysData%i2)) then + allocate(DstCoordSysData%i2(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%i2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%i2 = SrcCoordSysData%i2 + else if (allocated(DstCoordSysData%i2)) then + deallocate(DstCoordSysData%i2) + end if + if (allocated(SrcCoordSysData%i3)) then + LB(1:2) = lbound(SrcCoordSysData%i3) + UB(1:2) = ubound(SrcCoordSysData%i3) + if (.not. allocated(DstCoordSysData%i3)) then + allocate(DstCoordSysData%i3(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%i3.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%i3 = SrcCoordSysData%i3 + else if (allocated(DstCoordSysData%i3)) then + deallocate(DstCoordSysData%i3) + end if + if (allocated(SrcCoordSysData%j1)) then + LB(1:2) = lbound(SrcCoordSysData%j1) + UB(1:2) = ubound(SrcCoordSysData%j1) + if (.not. allocated(DstCoordSysData%j1)) then + allocate(DstCoordSysData%j1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%j1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%j1 = SrcCoordSysData%j1 + else if (allocated(DstCoordSysData%j1)) then + deallocate(DstCoordSysData%j1) + end if + if (allocated(SrcCoordSysData%j2)) then + LB(1:2) = lbound(SrcCoordSysData%j2) + UB(1:2) = ubound(SrcCoordSysData%j2) + if (.not. allocated(DstCoordSysData%j2)) then + allocate(DstCoordSysData%j2(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%j2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%j2 = SrcCoordSysData%j2 + else if (allocated(DstCoordSysData%j2)) then + deallocate(DstCoordSysData%j2) + end if + if (allocated(SrcCoordSysData%j3)) then + LB(1:2) = lbound(SrcCoordSysData%j3) + UB(1:2) = ubound(SrcCoordSysData%j3) + if (.not. allocated(DstCoordSysData%j3)) then + allocate(DstCoordSysData%j3(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%j3.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%j3 = SrcCoordSysData%j3 + else if (allocated(DstCoordSysData%j3)) then + deallocate(DstCoordSysData%j3) + end if + if (allocated(SrcCoordSysData%m1)) then + LB(1:3) = lbound(SrcCoordSysData%m1) + UB(1:3) = ubound(SrcCoordSysData%m1) + if (.not. allocated(DstCoordSysData%m1)) then + allocate(DstCoordSysData%m1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%m1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%m1 = SrcCoordSysData%m1 + else if (allocated(DstCoordSysData%m1)) then + deallocate(DstCoordSysData%m1) + end if + if (allocated(SrcCoordSysData%m2)) then + LB(1:3) = lbound(SrcCoordSysData%m2) + UB(1:3) = ubound(SrcCoordSysData%m2) + if (.not. allocated(DstCoordSysData%m2)) then + allocate(DstCoordSysData%m2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%m2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%m2 = SrcCoordSysData%m2 + else if (allocated(DstCoordSysData%m2)) then + deallocate(DstCoordSysData%m2) + end if + if (allocated(SrcCoordSysData%m3)) then + LB(1:3) = lbound(SrcCoordSysData%m3) + UB(1:3) = ubound(SrcCoordSysData%m3) + if (.not. allocated(DstCoordSysData%m3)) then + allocate(DstCoordSysData%m3(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%m3.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%m3 = SrcCoordSysData%m3 + else if (allocated(DstCoordSysData%m3)) then + deallocate(DstCoordSysData%m3) + end if + if (allocated(SrcCoordSysData%n1)) then + LB(1:3) = lbound(SrcCoordSysData%n1) + UB(1:3) = ubound(SrcCoordSysData%n1) + if (.not. allocated(DstCoordSysData%n1)) then + allocate(DstCoordSysData%n1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%n1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%n1 = SrcCoordSysData%n1 + else if (allocated(DstCoordSysData%n1)) then + deallocate(DstCoordSysData%n1) + end if + if (allocated(SrcCoordSysData%n2)) then + LB(1:3) = lbound(SrcCoordSysData%n2) + UB(1:3) = ubound(SrcCoordSysData%n2) + if (.not. allocated(DstCoordSysData%n2)) then + allocate(DstCoordSysData%n2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%n2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%n2 = SrcCoordSysData%n2 + else if (allocated(DstCoordSysData%n2)) then + deallocate(DstCoordSysData%n2) + end if + if (allocated(SrcCoordSysData%n3)) then + LB(1:3) = lbound(SrcCoordSysData%n3) + UB(1:3) = ubound(SrcCoordSysData%n3) + if (.not. allocated(DstCoordSysData%n3)) then + allocate(DstCoordSysData%n3(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%n3.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%n3 = SrcCoordSysData%n3 + else if (allocated(DstCoordSysData%n3)) then + deallocate(DstCoordSysData%n3) + end if + DstCoordSysData%rf1 = SrcCoordSysData%rf1 + DstCoordSysData%rf2 = SrcCoordSysData%rf2 + DstCoordSysData%rf3 = SrcCoordSysData%rf3 + DstCoordSysData%rfa = SrcCoordSysData%rfa + if (allocated(SrcCoordSysData%t1)) then + LB(1:2) = lbound(SrcCoordSysData%t1) + UB(1:2) = ubound(SrcCoordSysData%t1) + if (.not. allocated(DstCoordSysData%t1)) then + allocate(DstCoordSysData%t1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%t1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%t1 = SrcCoordSysData%t1 + else if (allocated(DstCoordSysData%t1)) then + deallocate(DstCoordSysData%t1) + end if + if (allocated(SrcCoordSysData%t2)) then + LB(1:2) = lbound(SrcCoordSysData%t2) + UB(1:2) = ubound(SrcCoordSysData%t2) + if (.not. allocated(DstCoordSysData%t2)) then + allocate(DstCoordSysData%t2(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%t2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%t2 = SrcCoordSysData%t2 + else if (allocated(DstCoordSysData%t2)) then + deallocate(DstCoordSysData%t2) + end if + if (allocated(SrcCoordSysData%t3)) then + LB(1:2) = lbound(SrcCoordSysData%t3) + UB(1:2) = ubound(SrcCoordSysData%t3) + if (.not. allocated(DstCoordSysData%t3)) then + allocate(DstCoordSysData%t3(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%t3.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%t3 = SrcCoordSysData%t3 + else if (allocated(DstCoordSysData%t3)) then + deallocate(DstCoordSysData%t3) + end if + if (allocated(SrcCoordSysData%te1)) then + LB(1:3) = lbound(SrcCoordSysData%te1) + UB(1:3) = ubound(SrcCoordSysData%te1) + if (.not. allocated(DstCoordSysData%te1)) then + allocate(DstCoordSysData%te1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%te1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%te1 = SrcCoordSysData%te1 + else if (allocated(DstCoordSysData%te1)) then + deallocate(DstCoordSysData%te1) + end if + if (allocated(SrcCoordSysData%te2)) then + LB(1:3) = lbound(SrcCoordSysData%te2) + UB(1:3) = ubound(SrcCoordSysData%te2) + if (.not. allocated(DstCoordSysData%te2)) then + allocate(DstCoordSysData%te2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%te2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%te2 = SrcCoordSysData%te2 + else if (allocated(DstCoordSysData%te2)) then + deallocate(DstCoordSysData%te2) + end if + if (allocated(SrcCoordSysData%te3)) then + LB(1:3) = lbound(SrcCoordSysData%te3) + UB(1:3) = ubound(SrcCoordSysData%te3) + if (.not. allocated(DstCoordSysData%te3)) then + allocate(DstCoordSysData%te3(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCoordSysData%te3.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCoordSysData%te3 = SrcCoordSysData%te3 + else if (allocated(DstCoordSysData%te3)) then + deallocate(DstCoordSysData%te3) + end if + DstCoordSysData%tf1 = SrcCoordSysData%tf1 + DstCoordSysData%tf2 = SrcCoordSysData%tf2 + DstCoordSysData%tf3 = SrcCoordSysData%tf3 + DstCoordSysData%tfa = SrcCoordSysData%tfa + DstCoordSysData%z1 = SrcCoordSysData%z1 + DstCoordSysData%z2 = SrcCoordSysData%z2 + DstCoordSysData%z3 = SrcCoordSysData%z3 +end subroutine +subroutine ED_DestroyCoordSys(CoordSysData, ErrStat, ErrMsg) + type(ED_CoordSys), intent(inout) :: CoordSysData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ED_DestroyCoordSys' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(CoordSysData%i1)) then + deallocate(CoordSysData%i1) + end if + if (allocated(CoordSysData%i2)) then + deallocate(CoordSysData%i2) + end if + if (allocated(CoordSysData%i3)) then + deallocate(CoordSysData%i3) + end if + if (allocated(CoordSysData%j1)) then + deallocate(CoordSysData%j1) + end if + if (allocated(CoordSysData%j2)) then + deallocate(CoordSysData%j2) + end if + if (allocated(CoordSysData%j3)) then + deallocate(CoordSysData%j3) + end if + if (allocated(CoordSysData%m1)) then + deallocate(CoordSysData%m1) + end if + if (allocated(CoordSysData%m2)) then + deallocate(CoordSysData%m2) + end if + if (allocated(CoordSysData%m3)) then + deallocate(CoordSysData%m3) + end if + if (allocated(CoordSysData%n1)) then + deallocate(CoordSysData%n1) + end if + if (allocated(CoordSysData%n2)) then + deallocate(CoordSysData%n2) + end if + if (allocated(CoordSysData%n3)) then + deallocate(CoordSysData%n3) + end if + if (allocated(CoordSysData%t1)) then + deallocate(CoordSysData%t1) + end if + if (allocated(CoordSysData%t2)) then + deallocate(CoordSysData%t2) + end if + if (allocated(CoordSysData%t3)) then + deallocate(CoordSysData%t3) + end if + if (allocated(CoordSysData%te1)) then + deallocate(CoordSysData%te1) + end if + if (allocated(CoordSysData%te2)) then + deallocate(CoordSysData%te2) + end if + if (allocated(CoordSysData%te3)) then + deallocate(CoordSysData%te3) + end if +end subroutine subroutine ED_PackCoordSys(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ED_CoordSys), intent(in) :: InData character(*), parameter :: RoutineName = 'ED_PackCoordSys' if (Buf%ErrStat >= AbortErrLev) return - ! a1 call RegPack(Buf, InData%a1) if (RegCheckErr(Buf, RoutineName)) return - ! a2 call RegPack(Buf, InData%a2) if (RegCheckErr(Buf, RoutineName)) return - ! a3 call RegPack(Buf, InData%a3) if (RegCheckErr(Buf, RoutineName)) return - ! b1 call RegPack(Buf, InData%b1) if (RegCheckErr(Buf, RoutineName)) return - ! b2 call RegPack(Buf, InData%b2) if (RegCheckErr(Buf, RoutineName)) return - ! b3 call RegPack(Buf, InData%b3) if (RegCheckErr(Buf, RoutineName)) return - ! c1 call RegPack(Buf, InData%c1) if (RegCheckErr(Buf, RoutineName)) return - ! c2 call RegPack(Buf, InData%c2) if (RegCheckErr(Buf, RoutineName)) return - ! c3 call RegPack(Buf, InData%c3) if (RegCheckErr(Buf, RoutineName)) return - ! d1 call RegPack(Buf, InData%d1) if (RegCheckErr(Buf, RoutineName)) return - ! d2 call RegPack(Buf, InData%d2) if (RegCheckErr(Buf, RoutineName)) return - ! d3 call RegPack(Buf, InData%d3) if (RegCheckErr(Buf, RoutineName)) return - ! e1 call RegPack(Buf, InData%e1) if (RegCheckErr(Buf, RoutineName)) return - ! e2 call RegPack(Buf, InData%e2) if (RegCheckErr(Buf, RoutineName)) return - ! e3 call RegPack(Buf, InData%e3) if (RegCheckErr(Buf, RoutineName)) return - ! f1 call RegPack(Buf, InData%f1) if (RegCheckErr(Buf, RoutineName)) return - ! f2 call RegPack(Buf, InData%f2) if (RegCheckErr(Buf, RoutineName)) return - ! f3 call RegPack(Buf, InData%f3) if (RegCheckErr(Buf, RoutineName)) return - ! g1 call RegPack(Buf, InData%g1) if (RegCheckErr(Buf, RoutineName)) return - ! g2 call RegPack(Buf, InData%g2) if (RegCheckErr(Buf, RoutineName)) return - ! g3 call RegPack(Buf, InData%g3) if (RegCheckErr(Buf, RoutineName)) return - ! i1 call RegPack(Buf, allocated(InData%i1)) if (allocated(InData%i1)) then call RegPackBounds(Buf, 2, lbound(InData%i1), ubound(InData%i1)) call RegPack(Buf, InData%i1) end if if (RegCheckErr(Buf, RoutineName)) return - ! i2 call RegPack(Buf, allocated(InData%i2)) if (allocated(InData%i2)) then call RegPackBounds(Buf, 2, lbound(InData%i2), ubound(InData%i2)) call RegPack(Buf, InData%i2) end if if (RegCheckErr(Buf, RoutineName)) return - ! i3 call RegPack(Buf, allocated(InData%i3)) if (allocated(InData%i3)) then call RegPackBounds(Buf, 2, lbound(InData%i3), ubound(InData%i3)) call RegPack(Buf, InData%i3) end if if (RegCheckErr(Buf, RoutineName)) return - ! j1 call RegPack(Buf, allocated(InData%j1)) if (allocated(InData%j1)) then call RegPackBounds(Buf, 2, lbound(InData%j1), ubound(InData%j1)) call RegPack(Buf, InData%j1) end if if (RegCheckErr(Buf, RoutineName)) return - ! j2 call RegPack(Buf, allocated(InData%j2)) if (allocated(InData%j2)) then call RegPackBounds(Buf, 2, lbound(InData%j2), ubound(InData%j2)) call RegPack(Buf, InData%j2) end if if (RegCheckErr(Buf, RoutineName)) return - ! j3 call RegPack(Buf, allocated(InData%j3)) if (allocated(InData%j3)) then call RegPackBounds(Buf, 2, lbound(InData%j3), ubound(InData%j3)) call RegPack(Buf, InData%j3) end if if (RegCheckErr(Buf, RoutineName)) return - ! m1 call RegPack(Buf, allocated(InData%m1)) if (allocated(InData%m1)) then call RegPackBounds(Buf, 3, lbound(InData%m1), ubound(InData%m1)) call RegPack(Buf, InData%m1) end if if (RegCheckErr(Buf, RoutineName)) return - ! m2 call RegPack(Buf, allocated(InData%m2)) if (allocated(InData%m2)) then call RegPackBounds(Buf, 3, lbound(InData%m2), ubound(InData%m2)) call RegPack(Buf, InData%m2) end if if (RegCheckErr(Buf, RoutineName)) return - ! m3 call RegPack(Buf, allocated(InData%m3)) if (allocated(InData%m3)) then call RegPackBounds(Buf, 3, lbound(InData%m3), ubound(InData%m3)) call RegPack(Buf, InData%m3) end if if (RegCheckErr(Buf, RoutineName)) return - ! n1 call RegPack(Buf, allocated(InData%n1)) if (allocated(InData%n1)) then call RegPackBounds(Buf, 3, lbound(InData%n1), ubound(InData%n1)) call RegPack(Buf, InData%n1) end if if (RegCheckErr(Buf, RoutineName)) return - ! n2 call RegPack(Buf, allocated(InData%n2)) if (allocated(InData%n2)) then call RegPackBounds(Buf, 3, lbound(InData%n2), ubound(InData%n2)) call RegPack(Buf, InData%n2) end if if (RegCheckErr(Buf, RoutineName)) return - ! n3 call RegPack(Buf, allocated(InData%n3)) if (allocated(InData%n3)) then call RegPackBounds(Buf, 3, lbound(InData%n3), ubound(InData%n3)) call RegPack(Buf, InData%n3) end if if (RegCheckErr(Buf, RoutineName)) return - ! rf1 call RegPack(Buf, InData%rf1) if (RegCheckErr(Buf, RoutineName)) return - ! rf2 call RegPack(Buf, InData%rf2) if (RegCheckErr(Buf, RoutineName)) return - ! rf3 call RegPack(Buf, InData%rf3) if (RegCheckErr(Buf, RoutineName)) return - ! rfa call RegPack(Buf, InData%rfa) if (RegCheckErr(Buf, RoutineName)) return - ! t1 call RegPack(Buf, allocated(InData%t1)) if (allocated(InData%t1)) then call RegPackBounds(Buf, 2, lbound(InData%t1), ubound(InData%t1)) call RegPack(Buf, InData%t1) end if if (RegCheckErr(Buf, RoutineName)) return - ! t2 call RegPack(Buf, allocated(InData%t2)) if (allocated(InData%t2)) then call RegPackBounds(Buf, 2, lbound(InData%t2), ubound(InData%t2)) call RegPack(Buf, InData%t2) end if if (RegCheckErr(Buf, RoutineName)) return - ! t3 call RegPack(Buf, allocated(InData%t3)) if (allocated(InData%t3)) then call RegPackBounds(Buf, 2, lbound(InData%t3), ubound(InData%t3)) call RegPack(Buf, InData%t3) end if if (RegCheckErr(Buf, RoutineName)) return - ! te1 call RegPack(Buf, allocated(InData%te1)) if (allocated(InData%te1)) then call RegPackBounds(Buf, 3, lbound(InData%te1), ubound(InData%te1)) call RegPack(Buf, InData%te1) end if if (RegCheckErr(Buf, RoutineName)) return - ! te2 call RegPack(Buf, allocated(InData%te2)) if (allocated(InData%te2)) then call RegPackBounds(Buf, 3, lbound(InData%te2), ubound(InData%te2)) call RegPack(Buf, InData%te2) end if if (RegCheckErr(Buf, RoutineName)) return - ! te3 call RegPack(Buf, allocated(InData%te3)) if (allocated(InData%te3)) then call RegPackBounds(Buf, 3, lbound(InData%te3), ubound(InData%te3)) call RegPack(Buf, InData%te3) end if if (RegCheckErr(Buf, RoutineName)) return - ! tf1 call RegPack(Buf, InData%tf1) if (RegCheckErr(Buf, RoutineName)) return - ! tf2 call RegPack(Buf, InData%tf2) if (RegCheckErr(Buf, RoutineName)) return - ! tf3 call RegPack(Buf, InData%tf3) if (RegCheckErr(Buf, RoutineName)) return - ! tfa call RegPack(Buf, InData%tfa) if (RegCheckErr(Buf, RoutineName)) return - ! z1 call RegPack(Buf, InData%z1) if (RegCheckErr(Buf, RoutineName)) return - ! z2 call RegPack(Buf, InData%z2) if (RegCheckErr(Buf, RoutineName)) return - ! z3 call RegPack(Buf, InData%z3) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -4379,70 +3920,48 @@ subroutine ED_UnPackCoordSys(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! a1 call RegUnpack(Buf, OutData%a1) if (RegCheckErr(Buf, RoutineName)) return - ! a2 call RegUnpack(Buf, OutData%a2) if (RegCheckErr(Buf, RoutineName)) return - ! a3 call RegUnpack(Buf, OutData%a3) if (RegCheckErr(Buf, RoutineName)) return - ! b1 call RegUnpack(Buf, OutData%b1) if (RegCheckErr(Buf, RoutineName)) return - ! b2 call RegUnpack(Buf, OutData%b2) if (RegCheckErr(Buf, RoutineName)) return - ! b3 call RegUnpack(Buf, OutData%b3) if (RegCheckErr(Buf, RoutineName)) return - ! c1 call RegUnpack(Buf, OutData%c1) if (RegCheckErr(Buf, RoutineName)) return - ! c2 call RegUnpack(Buf, OutData%c2) if (RegCheckErr(Buf, RoutineName)) return - ! c3 call RegUnpack(Buf, OutData%c3) if (RegCheckErr(Buf, RoutineName)) return - ! d1 call RegUnpack(Buf, OutData%d1) if (RegCheckErr(Buf, RoutineName)) return - ! d2 call RegUnpack(Buf, OutData%d2) if (RegCheckErr(Buf, RoutineName)) return - ! d3 call RegUnpack(Buf, OutData%d3) if (RegCheckErr(Buf, RoutineName)) return - ! e1 call RegUnpack(Buf, OutData%e1) if (RegCheckErr(Buf, RoutineName)) return - ! e2 call RegUnpack(Buf, OutData%e2) if (RegCheckErr(Buf, RoutineName)) return - ! e3 call RegUnpack(Buf, OutData%e3) if (RegCheckErr(Buf, RoutineName)) return - ! f1 call RegUnpack(Buf, OutData%f1) if (RegCheckErr(Buf, RoutineName)) return - ! f2 call RegUnpack(Buf, OutData%f2) if (RegCheckErr(Buf, RoutineName)) return - ! f3 call RegUnpack(Buf, OutData%f3) if (RegCheckErr(Buf, RoutineName)) return - ! g1 call RegUnpack(Buf, OutData%g1) if (RegCheckErr(Buf, RoutineName)) return - ! g2 call RegUnpack(Buf, OutData%g2) if (RegCheckErr(Buf, RoutineName)) return - ! g3 call RegUnpack(Buf, OutData%g3) if (RegCheckErr(Buf, RoutineName)) return - ! i1 if (allocated(OutData%i1)) deallocate(OutData%i1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4457,7 +3976,6 @@ subroutine ED_UnPackCoordSys(Buf, OutData) call RegUnpack(Buf, OutData%i1) if (RegCheckErr(Buf, RoutineName)) return end if - ! i2 if (allocated(OutData%i2)) deallocate(OutData%i2) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4472,7 +3990,6 @@ subroutine ED_UnPackCoordSys(Buf, OutData) call RegUnpack(Buf, OutData%i2) if (RegCheckErr(Buf, RoutineName)) return end if - ! i3 if (allocated(OutData%i3)) deallocate(OutData%i3) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4487,7 +4004,6 @@ subroutine ED_UnPackCoordSys(Buf, OutData) call RegUnpack(Buf, OutData%i3) if (RegCheckErr(Buf, RoutineName)) return end if - ! j1 if (allocated(OutData%j1)) deallocate(OutData%j1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4502,7 +4018,6 @@ subroutine ED_UnPackCoordSys(Buf, OutData) call RegUnpack(Buf, OutData%j1) if (RegCheckErr(Buf, RoutineName)) return end if - ! j2 if (allocated(OutData%j2)) deallocate(OutData%j2) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4517,7 +4032,6 @@ subroutine ED_UnPackCoordSys(Buf, OutData) call RegUnpack(Buf, OutData%j2) if (RegCheckErr(Buf, RoutineName)) return end if - ! j3 if (allocated(OutData%j3)) deallocate(OutData%j3) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4532,7 +4046,6 @@ subroutine ED_UnPackCoordSys(Buf, OutData) call RegUnpack(Buf, OutData%j3) if (RegCheckErr(Buf, RoutineName)) return end if - ! m1 if (allocated(OutData%m1)) deallocate(OutData%m1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4547,7 +4060,6 @@ subroutine ED_UnPackCoordSys(Buf, OutData) call RegUnpack(Buf, OutData%m1) if (RegCheckErr(Buf, RoutineName)) return end if - ! m2 if (allocated(OutData%m2)) deallocate(OutData%m2) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4562,7 +4074,6 @@ subroutine ED_UnPackCoordSys(Buf, OutData) call RegUnpack(Buf, OutData%m2) if (RegCheckErr(Buf, RoutineName)) return end if - ! m3 if (allocated(OutData%m3)) deallocate(OutData%m3) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4577,7 +4088,6 @@ subroutine ED_UnPackCoordSys(Buf, OutData) call RegUnpack(Buf, OutData%m3) if (RegCheckErr(Buf, RoutineName)) return end if - ! n1 if (allocated(OutData%n1)) deallocate(OutData%n1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4592,7 +4102,6 @@ subroutine ED_UnPackCoordSys(Buf, OutData) call RegUnpack(Buf, OutData%n1) if (RegCheckErr(Buf, RoutineName)) return end if - ! n2 if (allocated(OutData%n2)) deallocate(OutData%n2) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4607,7 +4116,6 @@ subroutine ED_UnPackCoordSys(Buf, OutData) call RegUnpack(Buf, OutData%n2) if (RegCheckErr(Buf, RoutineName)) return end if - ! n3 if (allocated(OutData%n3)) deallocate(OutData%n3) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4622,19 +4130,14 @@ subroutine ED_UnPackCoordSys(Buf, OutData) call RegUnpack(Buf, OutData%n3) if (RegCheckErr(Buf, RoutineName)) return end if - ! rf1 call RegUnpack(Buf, OutData%rf1) if (RegCheckErr(Buf, RoutineName)) return - ! rf2 call RegUnpack(Buf, OutData%rf2) if (RegCheckErr(Buf, RoutineName)) return - ! rf3 call RegUnpack(Buf, OutData%rf3) if (RegCheckErr(Buf, RoutineName)) return - ! rfa call RegUnpack(Buf, OutData%rfa) if (RegCheckErr(Buf, RoutineName)) return - ! t1 if (allocated(OutData%t1)) deallocate(OutData%t1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4649,7 +4152,6 @@ subroutine ED_UnPackCoordSys(Buf, OutData) call RegUnpack(Buf, OutData%t1) if (RegCheckErr(Buf, RoutineName)) return end if - ! t2 if (allocated(OutData%t2)) deallocate(OutData%t2) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4664,7 +4166,6 @@ subroutine ED_UnPackCoordSys(Buf, OutData) call RegUnpack(Buf, OutData%t2) if (RegCheckErr(Buf, RoutineName)) return end if - ! t3 if (allocated(OutData%t3)) deallocate(OutData%t3) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4679,7 +4180,6 @@ subroutine ED_UnPackCoordSys(Buf, OutData) call RegUnpack(Buf, OutData%t3) if (RegCheckErr(Buf, RoutineName)) return end if - ! te1 if (allocated(OutData%te1)) deallocate(OutData%te1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4694,7 +4194,6 @@ subroutine ED_UnPackCoordSys(Buf, OutData) call RegUnpack(Buf, OutData%te1) if (RegCheckErr(Buf, RoutineName)) return end if - ! te2 if (allocated(OutData%te2)) deallocate(OutData%te2) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4709,7 +4208,6 @@ subroutine ED_UnPackCoordSys(Buf, OutData) call RegUnpack(Buf, OutData%te2) if (RegCheckErr(Buf, RoutineName)) return end if - ! te3 if (allocated(OutData%te3)) deallocate(OutData%te3) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4724,427 +4222,412 @@ subroutine ED_UnPackCoordSys(Buf, OutData) call RegUnpack(Buf, OutData%te3) if (RegCheckErr(Buf, RoutineName)) return end if - ! tf1 call RegUnpack(Buf, OutData%tf1) if (RegCheckErr(Buf, RoutineName)) return - ! tf2 call RegUnpack(Buf, OutData%tf2) if (RegCheckErr(Buf, RoutineName)) return - ! tf3 call RegUnpack(Buf, OutData%tf3) if (RegCheckErr(Buf, RoutineName)) return - ! tfa call RegUnpack(Buf, OutData%tfa) if (RegCheckErr(Buf, RoutineName)) return - ! z1 call RegUnpack(Buf, OutData%z1) if (RegCheckErr(Buf, RoutineName)) return - ! z2 call RegUnpack(Buf, OutData%z2) if (RegCheckErr(Buf, RoutineName)) return - ! z3 call RegUnpack(Buf, OutData%z3) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE ED_CopyActiveDOFs( SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_ActiveDOFs), INTENT(IN) :: SrcActiveDOFsData - TYPE(ED_ActiveDOFs), INTENT(INOUT) :: DstActiveDOFsData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_CopyActiveDOFs' -! - ErrStat = ErrID_None - ErrMsg = "" - DstActiveDOFsData%NActvDOF = SrcActiveDOFsData%NActvDOF - DstActiveDOFsData%NPCE = SrcActiveDOFsData%NPCE - DstActiveDOFsData%NPDE = SrcActiveDOFsData%NPDE - DstActiveDOFsData%NPIE = SrcActiveDOFsData%NPIE - DstActiveDOFsData%NPTE = SrcActiveDOFsData%NPTE - DstActiveDOFsData%NPTTE = SrcActiveDOFsData%NPTTE -IF (ALLOCATED(SrcActiveDOFsData%NPSBE)) THEN - i1_l = LBOUND(SrcActiveDOFsData%NPSBE,1) - i1_u = UBOUND(SrcActiveDOFsData%NPSBE,1) - IF (.NOT. ALLOCATED(DstActiveDOFsData%NPSBE)) THEN - ALLOCATE(DstActiveDOFsData%NPSBE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%NPSBE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstActiveDOFsData%NPSBE = SrcActiveDOFsData%NPSBE -ENDIF -IF (ALLOCATED(SrcActiveDOFsData%NPSE)) THEN - i1_l = LBOUND(SrcActiveDOFsData%NPSE,1) - i1_u = UBOUND(SrcActiveDOFsData%NPSE,1) - IF (.NOT. ALLOCATED(DstActiveDOFsData%NPSE)) THEN - ALLOCATE(DstActiveDOFsData%NPSE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%NPSE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstActiveDOFsData%NPSE = SrcActiveDOFsData%NPSE -ENDIF - DstActiveDOFsData%NPUE = SrcActiveDOFsData%NPUE - DstActiveDOFsData%NPYE = SrcActiveDOFsData%NPYE -IF (ALLOCATED(SrcActiveDOFsData%PCE)) THEN - i1_l = LBOUND(SrcActiveDOFsData%PCE,1) - i1_u = UBOUND(SrcActiveDOFsData%PCE,1) - IF (.NOT. ALLOCATED(DstActiveDOFsData%PCE)) THEN - ALLOCATE(DstActiveDOFsData%PCE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PCE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstActiveDOFsData%PCE = SrcActiveDOFsData%PCE -ENDIF -IF (ALLOCATED(SrcActiveDOFsData%PDE)) THEN - i1_l = LBOUND(SrcActiveDOFsData%PDE,1) - i1_u = UBOUND(SrcActiveDOFsData%PDE,1) - IF (.NOT. ALLOCATED(DstActiveDOFsData%PDE)) THEN - ALLOCATE(DstActiveDOFsData%PDE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PDE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstActiveDOFsData%PDE = SrcActiveDOFsData%PDE -ENDIF -IF (ALLOCATED(SrcActiveDOFsData%PIE)) THEN - i1_l = LBOUND(SrcActiveDOFsData%PIE,1) - i1_u = UBOUND(SrcActiveDOFsData%PIE,1) - IF (.NOT. ALLOCATED(DstActiveDOFsData%PIE)) THEN - ALLOCATE(DstActiveDOFsData%PIE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PIE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstActiveDOFsData%PIE = SrcActiveDOFsData%PIE -ENDIF -IF (ALLOCATED(SrcActiveDOFsData%PTE)) THEN - i1_l = LBOUND(SrcActiveDOFsData%PTE,1) - i1_u = UBOUND(SrcActiveDOFsData%PTE,1) - IF (.NOT. ALLOCATED(DstActiveDOFsData%PTE)) THEN - ALLOCATE(DstActiveDOFsData%PTE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PTE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstActiveDOFsData%PTE = SrcActiveDOFsData%PTE -ENDIF -IF (ALLOCATED(SrcActiveDOFsData%PTTE)) THEN - i1_l = LBOUND(SrcActiveDOFsData%PTTE,1) - i1_u = UBOUND(SrcActiveDOFsData%PTTE,1) - IF (.NOT. ALLOCATED(DstActiveDOFsData%PTTE)) THEN - ALLOCATE(DstActiveDOFsData%PTTE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PTTE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstActiveDOFsData%PTTE = SrcActiveDOFsData%PTTE -ENDIF -IF (ALLOCATED(SrcActiveDOFsData%PS)) THEN - i1_l = LBOUND(SrcActiveDOFsData%PS,1) - i1_u = UBOUND(SrcActiveDOFsData%PS,1) - IF (.NOT. ALLOCATED(DstActiveDOFsData%PS)) THEN - ALLOCATE(DstActiveDOFsData%PS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstActiveDOFsData%PS = SrcActiveDOFsData%PS -ENDIF -IF (ALLOCATED(SrcActiveDOFsData%PSBE)) THEN - i1_l = LBOUND(SrcActiveDOFsData%PSBE,1) - i1_u = UBOUND(SrcActiveDOFsData%PSBE,1) - i2_l = LBOUND(SrcActiveDOFsData%PSBE,2) - i2_u = UBOUND(SrcActiveDOFsData%PSBE,2) - IF (.NOT. ALLOCATED(DstActiveDOFsData%PSBE)) THEN - ALLOCATE(DstActiveDOFsData%PSBE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PSBE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstActiveDOFsData%PSBE = SrcActiveDOFsData%PSBE -ENDIF -IF (ALLOCATED(SrcActiveDOFsData%PSE)) THEN - i1_l = LBOUND(SrcActiveDOFsData%PSE,1) - i1_u = UBOUND(SrcActiveDOFsData%PSE,1) - i2_l = LBOUND(SrcActiveDOFsData%PSE,2) - i2_u = UBOUND(SrcActiveDOFsData%PSE,2) - IF (.NOT. ALLOCATED(DstActiveDOFsData%PSE)) THEN - ALLOCATE(DstActiveDOFsData%PSE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PSE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstActiveDOFsData%PSE = SrcActiveDOFsData%PSE -ENDIF -IF (ALLOCATED(SrcActiveDOFsData%PUE)) THEN - i1_l = LBOUND(SrcActiveDOFsData%PUE,1) - i1_u = UBOUND(SrcActiveDOFsData%PUE,1) - IF (.NOT. ALLOCATED(DstActiveDOFsData%PUE)) THEN - ALLOCATE(DstActiveDOFsData%PUE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PUE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstActiveDOFsData%PUE = SrcActiveDOFsData%PUE -ENDIF -IF (ALLOCATED(SrcActiveDOFsData%PYE)) THEN - i1_l = LBOUND(SrcActiveDOFsData%PYE,1) - i1_u = UBOUND(SrcActiveDOFsData%PYE,1) - IF (.NOT. ALLOCATED(DstActiveDOFsData%PYE)) THEN - ALLOCATE(DstActiveDOFsData%PYE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PYE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstActiveDOFsData%PYE = SrcActiveDOFsData%PYE -ENDIF -IF (ALLOCATED(SrcActiveDOFsData%SrtPS)) THEN - i1_l = LBOUND(SrcActiveDOFsData%SrtPS,1) - i1_u = UBOUND(SrcActiveDOFsData%SrtPS,1) - IF (.NOT. ALLOCATED(DstActiveDOFsData%SrtPS)) THEN - ALLOCATE(DstActiveDOFsData%SrtPS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%SrtPS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstActiveDOFsData%SrtPS = SrcActiveDOFsData%SrtPS -ENDIF -IF (ALLOCATED(SrcActiveDOFsData%SrtPSNAUG)) THEN - i1_l = LBOUND(SrcActiveDOFsData%SrtPSNAUG,1) - i1_u = UBOUND(SrcActiveDOFsData%SrtPSNAUG,1) - IF (.NOT. ALLOCATED(DstActiveDOFsData%SrtPSNAUG)) THEN - ALLOCATE(DstActiveDOFsData%SrtPSNAUG(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%SrtPSNAUG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstActiveDOFsData%SrtPSNAUG = SrcActiveDOFsData%SrtPSNAUG -ENDIF -IF (ALLOCATED(SrcActiveDOFsData%Diag)) THEN - i1_l = LBOUND(SrcActiveDOFsData%Diag,1) - i1_u = UBOUND(SrcActiveDOFsData%Diag,1) - IF (.NOT. ALLOCATED(DstActiveDOFsData%Diag)) THEN - ALLOCATE(DstActiveDOFsData%Diag(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%Diag.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstActiveDOFsData%Diag = SrcActiveDOFsData%Diag -ENDIF - END SUBROUTINE ED_CopyActiveDOFs - - SUBROUTINE ED_DestroyActiveDOFs( ActiveDOFsData, ErrStat, ErrMsg ) - TYPE(ED_ActiveDOFs), INTENT(INOUT) :: ActiveDOFsData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyActiveDOFs' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(ActiveDOFsData%NPSBE)) THEN - DEALLOCATE(ActiveDOFsData%NPSBE) -ENDIF -IF (ALLOCATED(ActiveDOFsData%NPSE)) THEN - DEALLOCATE(ActiveDOFsData%NPSE) -ENDIF -IF (ALLOCATED(ActiveDOFsData%PCE)) THEN - DEALLOCATE(ActiveDOFsData%PCE) -ENDIF -IF (ALLOCATED(ActiveDOFsData%PDE)) THEN - DEALLOCATE(ActiveDOFsData%PDE) -ENDIF -IF (ALLOCATED(ActiveDOFsData%PIE)) THEN - DEALLOCATE(ActiveDOFsData%PIE) -ENDIF -IF (ALLOCATED(ActiveDOFsData%PTE)) THEN - DEALLOCATE(ActiveDOFsData%PTE) -ENDIF -IF (ALLOCATED(ActiveDOFsData%PTTE)) THEN - DEALLOCATE(ActiveDOFsData%PTTE) -ENDIF -IF (ALLOCATED(ActiveDOFsData%PS)) THEN - DEALLOCATE(ActiveDOFsData%PS) -ENDIF -IF (ALLOCATED(ActiveDOFsData%PSBE)) THEN - DEALLOCATE(ActiveDOFsData%PSBE) -ENDIF -IF (ALLOCATED(ActiveDOFsData%PSE)) THEN - DEALLOCATE(ActiveDOFsData%PSE) -ENDIF -IF (ALLOCATED(ActiveDOFsData%PUE)) THEN - DEALLOCATE(ActiveDOFsData%PUE) -ENDIF -IF (ALLOCATED(ActiveDOFsData%PYE)) THEN - DEALLOCATE(ActiveDOFsData%PYE) -ENDIF -IF (ALLOCATED(ActiveDOFsData%SrtPS)) THEN - DEALLOCATE(ActiveDOFsData%SrtPS) -ENDIF -IF (ALLOCATED(ActiveDOFsData%SrtPSNAUG)) THEN - DEALLOCATE(ActiveDOFsData%SrtPSNAUG) -ENDIF -IF (ALLOCATED(ActiveDOFsData%Diag)) THEN - DEALLOCATE(ActiveDOFsData%Diag) -ENDIF - END SUBROUTINE ED_DestroyActiveDOFs +subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, ErrStat, ErrMsg) + type(ED_ActiveDOFs), intent(in) :: SrcActiveDOFsData + type(ED_ActiveDOFs), intent(inout) :: DstActiveDOFsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'ED_CopyActiveDOFs' + ErrStat = ErrID_None + ErrMsg = '' + DstActiveDOFsData%NActvDOF = SrcActiveDOFsData%NActvDOF + DstActiveDOFsData%NPCE = SrcActiveDOFsData%NPCE + DstActiveDOFsData%NPDE = SrcActiveDOFsData%NPDE + DstActiveDOFsData%NPIE = SrcActiveDOFsData%NPIE + DstActiveDOFsData%NPTE = SrcActiveDOFsData%NPTE + DstActiveDOFsData%NPTTE = SrcActiveDOFsData%NPTTE + if (allocated(SrcActiveDOFsData%NPSBE)) then + LB(1:1) = lbound(SrcActiveDOFsData%NPSBE) + UB(1:1) = ubound(SrcActiveDOFsData%NPSBE) + if (.not. allocated(DstActiveDOFsData%NPSBE)) then + allocate(DstActiveDOFsData%NPSBE(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%NPSBE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstActiveDOFsData%NPSBE = SrcActiveDOFsData%NPSBE + else if (allocated(DstActiveDOFsData%NPSBE)) then + deallocate(DstActiveDOFsData%NPSBE) + end if + if (allocated(SrcActiveDOFsData%NPSE)) then + LB(1:1) = lbound(SrcActiveDOFsData%NPSE) + UB(1:1) = ubound(SrcActiveDOFsData%NPSE) + if (.not. allocated(DstActiveDOFsData%NPSE)) then + allocate(DstActiveDOFsData%NPSE(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%NPSE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstActiveDOFsData%NPSE = SrcActiveDOFsData%NPSE + else if (allocated(DstActiveDOFsData%NPSE)) then + deallocate(DstActiveDOFsData%NPSE) + end if + DstActiveDOFsData%NPUE = SrcActiveDOFsData%NPUE + DstActiveDOFsData%NPYE = SrcActiveDOFsData%NPYE + if (allocated(SrcActiveDOFsData%PCE)) then + LB(1:1) = lbound(SrcActiveDOFsData%PCE) + UB(1:1) = ubound(SrcActiveDOFsData%PCE) + if (.not. allocated(DstActiveDOFsData%PCE)) then + allocate(DstActiveDOFsData%PCE(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PCE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstActiveDOFsData%PCE = SrcActiveDOFsData%PCE + else if (allocated(DstActiveDOFsData%PCE)) then + deallocate(DstActiveDOFsData%PCE) + end if + if (allocated(SrcActiveDOFsData%PDE)) then + LB(1:1) = lbound(SrcActiveDOFsData%PDE) + UB(1:1) = ubound(SrcActiveDOFsData%PDE) + if (.not. allocated(DstActiveDOFsData%PDE)) then + allocate(DstActiveDOFsData%PDE(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PDE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstActiveDOFsData%PDE = SrcActiveDOFsData%PDE + else if (allocated(DstActiveDOFsData%PDE)) then + deallocate(DstActiveDOFsData%PDE) + end if + if (allocated(SrcActiveDOFsData%PIE)) then + LB(1:1) = lbound(SrcActiveDOFsData%PIE) + UB(1:1) = ubound(SrcActiveDOFsData%PIE) + if (.not. allocated(DstActiveDOFsData%PIE)) then + allocate(DstActiveDOFsData%PIE(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PIE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstActiveDOFsData%PIE = SrcActiveDOFsData%PIE + else if (allocated(DstActiveDOFsData%PIE)) then + deallocate(DstActiveDOFsData%PIE) + end if + if (allocated(SrcActiveDOFsData%PTE)) then + LB(1:1) = lbound(SrcActiveDOFsData%PTE) + UB(1:1) = ubound(SrcActiveDOFsData%PTE) + if (.not. allocated(DstActiveDOFsData%PTE)) then + allocate(DstActiveDOFsData%PTE(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PTE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstActiveDOFsData%PTE = SrcActiveDOFsData%PTE + else if (allocated(DstActiveDOFsData%PTE)) then + deallocate(DstActiveDOFsData%PTE) + end if + if (allocated(SrcActiveDOFsData%PTTE)) then + LB(1:1) = lbound(SrcActiveDOFsData%PTTE) + UB(1:1) = ubound(SrcActiveDOFsData%PTTE) + if (.not. allocated(DstActiveDOFsData%PTTE)) then + allocate(DstActiveDOFsData%PTTE(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PTTE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstActiveDOFsData%PTTE = SrcActiveDOFsData%PTTE + else if (allocated(DstActiveDOFsData%PTTE)) then + deallocate(DstActiveDOFsData%PTTE) + end if + if (allocated(SrcActiveDOFsData%PS)) then + LB(1:1) = lbound(SrcActiveDOFsData%PS) + UB(1:1) = ubound(SrcActiveDOFsData%PS) + if (.not. allocated(DstActiveDOFsData%PS)) then + allocate(DstActiveDOFsData%PS(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstActiveDOFsData%PS = SrcActiveDOFsData%PS + else if (allocated(DstActiveDOFsData%PS)) then + deallocate(DstActiveDOFsData%PS) + end if + if (allocated(SrcActiveDOFsData%PSBE)) then + LB(1:2) = lbound(SrcActiveDOFsData%PSBE) + UB(1:2) = ubound(SrcActiveDOFsData%PSBE) + if (.not. allocated(DstActiveDOFsData%PSBE)) then + allocate(DstActiveDOFsData%PSBE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PSBE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstActiveDOFsData%PSBE = SrcActiveDOFsData%PSBE + else if (allocated(DstActiveDOFsData%PSBE)) then + deallocate(DstActiveDOFsData%PSBE) + end if + if (allocated(SrcActiveDOFsData%PSE)) then + LB(1:2) = lbound(SrcActiveDOFsData%PSE) + UB(1:2) = ubound(SrcActiveDOFsData%PSE) + if (.not. allocated(DstActiveDOFsData%PSE)) then + allocate(DstActiveDOFsData%PSE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PSE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstActiveDOFsData%PSE = SrcActiveDOFsData%PSE + else if (allocated(DstActiveDOFsData%PSE)) then + deallocate(DstActiveDOFsData%PSE) + end if + if (allocated(SrcActiveDOFsData%PUE)) then + LB(1:1) = lbound(SrcActiveDOFsData%PUE) + UB(1:1) = ubound(SrcActiveDOFsData%PUE) + if (.not. allocated(DstActiveDOFsData%PUE)) then + allocate(DstActiveDOFsData%PUE(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PUE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstActiveDOFsData%PUE = SrcActiveDOFsData%PUE + else if (allocated(DstActiveDOFsData%PUE)) then + deallocate(DstActiveDOFsData%PUE) + end if + if (allocated(SrcActiveDOFsData%PYE)) then + LB(1:1) = lbound(SrcActiveDOFsData%PYE) + UB(1:1) = ubound(SrcActiveDOFsData%PYE) + if (.not. allocated(DstActiveDOFsData%PYE)) then + allocate(DstActiveDOFsData%PYE(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%PYE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstActiveDOFsData%PYE = SrcActiveDOFsData%PYE + else if (allocated(DstActiveDOFsData%PYE)) then + deallocate(DstActiveDOFsData%PYE) + end if + if (allocated(SrcActiveDOFsData%SrtPS)) then + LB(1:1) = lbound(SrcActiveDOFsData%SrtPS) + UB(1:1) = ubound(SrcActiveDOFsData%SrtPS) + if (.not. allocated(DstActiveDOFsData%SrtPS)) then + allocate(DstActiveDOFsData%SrtPS(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%SrtPS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstActiveDOFsData%SrtPS = SrcActiveDOFsData%SrtPS + else if (allocated(DstActiveDOFsData%SrtPS)) then + deallocate(DstActiveDOFsData%SrtPS) + end if + if (allocated(SrcActiveDOFsData%SrtPSNAUG)) then + LB(1:1) = lbound(SrcActiveDOFsData%SrtPSNAUG) + UB(1:1) = ubound(SrcActiveDOFsData%SrtPSNAUG) + if (.not. allocated(DstActiveDOFsData%SrtPSNAUG)) then + allocate(DstActiveDOFsData%SrtPSNAUG(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%SrtPSNAUG.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstActiveDOFsData%SrtPSNAUG = SrcActiveDOFsData%SrtPSNAUG + else if (allocated(DstActiveDOFsData%SrtPSNAUG)) then + deallocate(DstActiveDOFsData%SrtPSNAUG) + end if + if (allocated(SrcActiveDOFsData%Diag)) then + LB(1:1) = lbound(SrcActiveDOFsData%Diag) + UB(1:1) = ubound(SrcActiveDOFsData%Diag) + if (.not. allocated(DstActiveDOFsData%Diag)) then + allocate(DstActiveDOFsData%Diag(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstActiveDOFsData%Diag.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstActiveDOFsData%Diag = SrcActiveDOFsData%Diag + else if (allocated(DstActiveDOFsData%Diag)) then + deallocate(DstActiveDOFsData%Diag) + end if +end subroutine +subroutine ED_DestroyActiveDOFs(ActiveDOFsData, ErrStat, ErrMsg) + type(ED_ActiveDOFs), intent(inout) :: ActiveDOFsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ED_DestroyActiveDOFs' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ActiveDOFsData%NPSBE)) then + deallocate(ActiveDOFsData%NPSBE) + end if + if (allocated(ActiveDOFsData%NPSE)) then + deallocate(ActiveDOFsData%NPSE) + end if + if (allocated(ActiveDOFsData%PCE)) then + deallocate(ActiveDOFsData%PCE) + end if + if (allocated(ActiveDOFsData%PDE)) then + deallocate(ActiveDOFsData%PDE) + end if + if (allocated(ActiveDOFsData%PIE)) then + deallocate(ActiveDOFsData%PIE) + end if + if (allocated(ActiveDOFsData%PTE)) then + deallocate(ActiveDOFsData%PTE) + end if + if (allocated(ActiveDOFsData%PTTE)) then + deallocate(ActiveDOFsData%PTTE) + end if + if (allocated(ActiveDOFsData%PS)) then + deallocate(ActiveDOFsData%PS) + end if + if (allocated(ActiveDOFsData%PSBE)) then + deallocate(ActiveDOFsData%PSBE) + end if + if (allocated(ActiveDOFsData%PSE)) then + deallocate(ActiveDOFsData%PSE) + end if + if (allocated(ActiveDOFsData%PUE)) then + deallocate(ActiveDOFsData%PUE) + end if + if (allocated(ActiveDOFsData%PYE)) then + deallocate(ActiveDOFsData%PYE) + end if + if (allocated(ActiveDOFsData%SrtPS)) then + deallocate(ActiveDOFsData%SrtPS) + end if + if (allocated(ActiveDOFsData%SrtPSNAUG)) then + deallocate(ActiveDOFsData%SrtPSNAUG) + end if + if (allocated(ActiveDOFsData%Diag)) then + deallocate(ActiveDOFsData%Diag) + end if +end subroutine subroutine ED_PackActiveDOFs(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ED_ActiveDOFs), intent(in) :: InData character(*), parameter :: RoutineName = 'ED_PackActiveDOFs' if (Buf%ErrStat >= AbortErrLev) return - ! NActvDOF call RegPack(Buf, InData%NActvDOF) if (RegCheckErr(Buf, RoutineName)) return - ! NPCE call RegPack(Buf, InData%NPCE) if (RegCheckErr(Buf, RoutineName)) return - ! NPDE call RegPack(Buf, InData%NPDE) if (RegCheckErr(Buf, RoutineName)) return - ! NPIE call RegPack(Buf, InData%NPIE) if (RegCheckErr(Buf, RoutineName)) return - ! NPTE call RegPack(Buf, InData%NPTE) if (RegCheckErr(Buf, RoutineName)) return - ! NPTTE call RegPack(Buf, InData%NPTTE) if (RegCheckErr(Buf, RoutineName)) return - ! NPSBE call RegPack(Buf, allocated(InData%NPSBE)) if (allocated(InData%NPSBE)) then call RegPackBounds(Buf, 1, lbound(InData%NPSBE), ubound(InData%NPSBE)) call RegPack(Buf, InData%NPSBE) end if if (RegCheckErr(Buf, RoutineName)) return - ! NPSE call RegPack(Buf, allocated(InData%NPSE)) if (allocated(InData%NPSE)) then call RegPackBounds(Buf, 1, lbound(InData%NPSE), ubound(InData%NPSE)) call RegPack(Buf, InData%NPSE) end if if (RegCheckErr(Buf, RoutineName)) return - ! NPUE call RegPack(Buf, InData%NPUE) if (RegCheckErr(Buf, RoutineName)) return - ! NPYE call RegPack(Buf, InData%NPYE) if (RegCheckErr(Buf, RoutineName)) return - ! PCE call RegPack(Buf, allocated(InData%PCE)) if (allocated(InData%PCE)) then call RegPackBounds(Buf, 1, lbound(InData%PCE), ubound(InData%PCE)) call RegPack(Buf, InData%PCE) end if if (RegCheckErr(Buf, RoutineName)) return - ! PDE call RegPack(Buf, allocated(InData%PDE)) if (allocated(InData%PDE)) then call RegPackBounds(Buf, 1, lbound(InData%PDE), ubound(InData%PDE)) call RegPack(Buf, InData%PDE) end if if (RegCheckErr(Buf, RoutineName)) return - ! PIE call RegPack(Buf, allocated(InData%PIE)) if (allocated(InData%PIE)) then call RegPackBounds(Buf, 1, lbound(InData%PIE), ubound(InData%PIE)) call RegPack(Buf, InData%PIE) end if if (RegCheckErr(Buf, RoutineName)) return - ! PTE call RegPack(Buf, allocated(InData%PTE)) if (allocated(InData%PTE)) then call RegPackBounds(Buf, 1, lbound(InData%PTE), ubound(InData%PTE)) call RegPack(Buf, InData%PTE) end if if (RegCheckErr(Buf, RoutineName)) return - ! PTTE call RegPack(Buf, allocated(InData%PTTE)) if (allocated(InData%PTTE)) then call RegPackBounds(Buf, 1, lbound(InData%PTTE), ubound(InData%PTTE)) call RegPack(Buf, InData%PTTE) end if if (RegCheckErr(Buf, RoutineName)) return - ! PS call RegPack(Buf, allocated(InData%PS)) if (allocated(InData%PS)) then call RegPackBounds(Buf, 1, lbound(InData%PS), ubound(InData%PS)) call RegPack(Buf, InData%PS) end if if (RegCheckErr(Buf, RoutineName)) return - ! PSBE call RegPack(Buf, allocated(InData%PSBE)) if (allocated(InData%PSBE)) then call RegPackBounds(Buf, 2, lbound(InData%PSBE), ubound(InData%PSBE)) call RegPack(Buf, InData%PSBE) end if if (RegCheckErr(Buf, RoutineName)) return - ! PSE call RegPack(Buf, allocated(InData%PSE)) if (allocated(InData%PSE)) then call RegPackBounds(Buf, 2, lbound(InData%PSE), ubound(InData%PSE)) call RegPack(Buf, InData%PSE) end if if (RegCheckErr(Buf, RoutineName)) return - ! PUE call RegPack(Buf, allocated(InData%PUE)) if (allocated(InData%PUE)) then call RegPackBounds(Buf, 1, lbound(InData%PUE), ubound(InData%PUE)) call RegPack(Buf, InData%PUE) end if if (RegCheckErr(Buf, RoutineName)) return - ! PYE call RegPack(Buf, allocated(InData%PYE)) if (allocated(InData%PYE)) then call RegPackBounds(Buf, 1, lbound(InData%PYE), ubound(InData%PYE)) call RegPack(Buf, InData%PYE) end if if (RegCheckErr(Buf, RoutineName)) return - ! SrtPS call RegPack(Buf, allocated(InData%SrtPS)) if (allocated(InData%SrtPS)) then call RegPackBounds(Buf, 1, lbound(InData%SrtPS), ubound(InData%SrtPS)) call RegPack(Buf, InData%SrtPS) end if if (RegCheckErr(Buf, RoutineName)) return - ! SrtPSNAUG call RegPack(Buf, allocated(InData%SrtPSNAUG)) if (allocated(InData%SrtPSNAUG)) then call RegPackBounds(Buf, 1, lbound(InData%SrtPSNAUG), ubound(InData%SrtPSNAUG)) call RegPack(Buf, InData%SrtPSNAUG) end if if (RegCheckErr(Buf, RoutineName)) return - ! Diag call RegPack(Buf, allocated(InData%Diag)) if (allocated(InData%Diag)) then call RegPackBounds(Buf, 1, lbound(InData%Diag), ubound(InData%Diag)) @@ -5161,25 +4644,18 @@ subroutine ED_UnPackActiveDOFs(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! NActvDOF call RegUnpack(Buf, OutData%NActvDOF) if (RegCheckErr(Buf, RoutineName)) return - ! NPCE call RegUnpack(Buf, OutData%NPCE) if (RegCheckErr(Buf, RoutineName)) return - ! NPDE call RegUnpack(Buf, OutData%NPDE) if (RegCheckErr(Buf, RoutineName)) return - ! NPIE call RegUnpack(Buf, OutData%NPIE) if (RegCheckErr(Buf, RoutineName)) return - ! NPTE call RegUnpack(Buf, OutData%NPTE) if (RegCheckErr(Buf, RoutineName)) return - ! NPTTE call RegUnpack(Buf, OutData%NPTTE) if (RegCheckErr(Buf, RoutineName)) return - ! NPSBE if (allocated(OutData%NPSBE)) deallocate(OutData%NPSBE) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5194,7 +4670,6 @@ subroutine ED_UnPackActiveDOFs(Buf, OutData) call RegUnpack(Buf, OutData%NPSBE) if (RegCheckErr(Buf, RoutineName)) return end if - ! NPSE if (allocated(OutData%NPSE)) deallocate(OutData%NPSE) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5209,13 +4684,10 @@ subroutine ED_UnPackActiveDOFs(Buf, OutData) call RegUnpack(Buf, OutData%NPSE) if (RegCheckErr(Buf, RoutineName)) return end if - ! NPUE call RegUnpack(Buf, OutData%NPUE) if (RegCheckErr(Buf, RoutineName)) return - ! NPYE call RegUnpack(Buf, OutData%NPYE) if (RegCheckErr(Buf, RoutineName)) return - ! PCE if (allocated(OutData%PCE)) deallocate(OutData%PCE) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5230,7 +4702,6 @@ subroutine ED_UnPackActiveDOFs(Buf, OutData) call RegUnpack(Buf, OutData%PCE) if (RegCheckErr(Buf, RoutineName)) return end if - ! PDE if (allocated(OutData%PDE)) deallocate(OutData%PDE) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5245,7 +4716,6 @@ subroutine ED_UnPackActiveDOFs(Buf, OutData) call RegUnpack(Buf, OutData%PDE) if (RegCheckErr(Buf, RoutineName)) return end if - ! PIE if (allocated(OutData%PIE)) deallocate(OutData%PIE) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5260,7 +4730,6 @@ subroutine ED_UnPackActiveDOFs(Buf, OutData) call RegUnpack(Buf, OutData%PIE) if (RegCheckErr(Buf, RoutineName)) return end if - ! PTE if (allocated(OutData%PTE)) deallocate(OutData%PTE) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5275,7 +4744,6 @@ subroutine ED_UnPackActiveDOFs(Buf, OutData) call RegUnpack(Buf, OutData%PTE) if (RegCheckErr(Buf, RoutineName)) return end if - ! PTTE if (allocated(OutData%PTTE)) deallocate(OutData%PTTE) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5290,7 +4758,6 @@ subroutine ED_UnPackActiveDOFs(Buf, OutData) call RegUnpack(Buf, OutData%PTTE) if (RegCheckErr(Buf, RoutineName)) return end if - ! PS if (allocated(OutData%PS)) deallocate(OutData%PS) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5305,7 +4772,6 @@ subroutine ED_UnPackActiveDOFs(Buf, OutData) call RegUnpack(Buf, OutData%PS) if (RegCheckErr(Buf, RoutineName)) return end if - ! PSBE if (allocated(OutData%PSBE)) deallocate(OutData%PSBE) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5320,7 +4786,6 @@ subroutine ED_UnPackActiveDOFs(Buf, OutData) call RegUnpack(Buf, OutData%PSBE) if (RegCheckErr(Buf, RoutineName)) return end if - ! PSE if (allocated(OutData%PSE)) deallocate(OutData%PSE) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5335,7 +4800,6 @@ subroutine ED_UnPackActiveDOFs(Buf, OutData) call RegUnpack(Buf, OutData%PSE) if (RegCheckErr(Buf, RoutineName)) return end if - ! PUE if (allocated(OutData%PUE)) deallocate(OutData%PUE) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5350,7 +4814,6 @@ subroutine ED_UnPackActiveDOFs(Buf, OutData) call RegUnpack(Buf, OutData%PUE) if (RegCheckErr(Buf, RoutineName)) return end if - ! PYE if (allocated(OutData%PYE)) deallocate(OutData%PYE) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5365,7 +4828,6 @@ subroutine ED_UnPackActiveDOFs(Buf, OutData) call RegUnpack(Buf, OutData%PYE) if (RegCheckErr(Buf, RoutineName)) return end if - ! SrtPS if (allocated(OutData%SrtPS)) deallocate(OutData%SrtPS) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5380,7 +4842,6 @@ subroutine ED_UnPackActiveDOFs(Buf, OutData) call RegUnpack(Buf, OutData%SrtPS) if (RegCheckErr(Buf, RoutineName)) return end if - ! SrtPSNAUG if (allocated(OutData%SrtPSNAUG)) deallocate(OutData%SrtPSNAUG) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5395,7 +4856,6 @@ subroutine ED_UnPackActiveDOFs(Buf, OutData) call RegUnpack(Buf, OutData%SrtPSNAUG) if (RegCheckErr(Buf, RoutineName)) return end if - ! Diag if (allocated(OutData%Diag)) deallocate(OutData%Diag) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5411,2086 +4871,1837 @@ subroutine ED_UnPackActiveDOFs(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE ED_CopyRtHndSide( SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_RtHndSide), INTENT(IN) :: SrcRtHndSideData - TYPE(ED_RtHndSide), INTENT(INOUT) :: DstRtHndSideData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_CopyRtHndSide' -! - ErrStat = ErrID_None - ErrMsg = "" - DstRtHndSideData%rO = SrcRtHndSideData%rO -IF (ALLOCATED(SrcRtHndSideData%rQS)) THEN - i1_l = LBOUND(SrcRtHndSideData%rQS,1) - i1_u = UBOUND(SrcRtHndSideData%rQS,1) - i2_l = LBOUND(SrcRtHndSideData%rQS,2) - i2_u = UBOUND(SrcRtHndSideData%rQS,2) - i3_l = LBOUND(SrcRtHndSideData%rQS,3) - i3_u = UBOUND(SrcRtHndSideData%rQS,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%rQS)) THEN - ALLOCATE(DstRtHndSideData%rQS(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rQS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%rQS = SrcRtHndSideData%rQS -ENDIF -IF (ALLOCATED(SrcRtHndSideData%rS)) THEN - i1_l = LBOUND(SrcRtHndSideData%rS,1) - i1_u = UBOUND(SrcRtHndSideData%rS,1) - i2_l = LBOUND(SrcRtHndSideData%rS,2) - i2_u = UBOUND(SrcRtHndSideData%rS,2) - i3_l = LBOUND(SrcRtHndSideData%rS,3) - i3_u = UBOUND(SrcRtHndSideData%rS,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%rS)) THEN - ALLOCATE(DstRtHndSideData%rS(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%rS = SrcRtHndSideData%rS -ENDIF -IF (ALLOCATED(SrcRtHndSideData%rS0S)) THEN - i1_l = LBOUND(SrcRtHndSideData%rS0S,1) - i1_u = UBOUND(SrcRtHndSideData%rS0S,1) - i2_l = LBOUND(SrcRtHndSideData%rS0S,2) - i2_u = UBOUND(SrcRtHndSideData%rS0S,2) - i3_l = LBOUND(SrcRtHndSideData%rS0S,3) - i3_u = UBOUND(SrcRtHndSideData%rS0S,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%rS0S)) THEN - ALLOCATE(DstRtHndSideData%rS0S(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rS0S.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%rS0S = SrcRtHndSideData%rS0S -ENDIF -IF (ALLOCATED(SrcRtHndSideData%rT)) THEN - i1_l = LBOUND(SrcRtHndSideData%rT,1) - i1_u = UBOUND(SrcRtHndSideData%rT,1) - i2_l = LBOUND(SrcRtHndSideData%rT,2) - i2_u = UBOUND(SrcRtHndSideData%rT,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%rT)) THEN - ALLOCATE(DstRtHndSideData%rT(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%rT = SrcRtHndSideData%rT -ENDIF - DstRtHndSideData%rT0O = SrcRtHndSideData%rT0O -IF (ALLOCATED(SrcRtHndSideData%rT0T)) THEN - i1_l = LBOUND(SrcRtHndSideData%rT0T,1) - i1_u = UBOUND(SrcRtHndSideData%rT0T,1) - i2_l = LBOUND(SrcRtHndSideData%rT0T,2) - i2_u = UBOUND(SrcRtHndSideData%rT0T,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%rT0T)) THEN - ALLOCATE(DstRtHndSideData%rT0T(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rT0T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%rT0T = SrcRtHndSideData%rT0T -ENDIF - DstRtHndSideData%rZ = SrcRtHndSideData%rZ - DstRtHndSideData%rZO = SrcRtHndSideData%rZO -IF (ALLOCATED(SrcRtHndSideData%rZT)) THEN - i1_l = LBOUND(SrcRtHndSideData%rZT,1) - i1_u = UBOUND(SrcRtHndSideData%rZT,1) - i2_l = LBOUND(SrcRtHndSideData%rZT,2) - i2_u = UBOUND(SrcRtHndSideData%rZT,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%rZT)) THEN - ALLOCATE(DstRtHndSideData%rZT(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rZT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%rZT = SrcRtHndSideData%rZT -ENDIF - DstRtHndSideData%rPQ = SrcRtHndSideData%rPQ - DstRtHndSideData%rP = SrcRtHndSideData%rP - DstRtHndSideData%rV = SrcRtHndSideData%rV - DstRtHndSideData%rJ = SrcRtHndSideData%rJ - DstRtHndSideData%rZY = SrcRtHndSideData%rZY - DstRtHndSideData%rOU = SrcRtHndSideData%rOU - DstRtHndSideData%rOV = SrcRtHndSideData%rOV - DstRtHndSideData%rVD = SrcRtHndSideData%rVD - DstRtHndSideData%rOW = SrcRtHndSideData%rOW - DstRtHndSideData%rPC = SrcRtHndSideData%rPC -IF (ALLOCATED(SrcRtHndSideData%rPS0)) THEN - i1_l = LBOUND(SrcRtHndSideData%rPS0,1) - i1_u = UBOUND(SrcRtHndSideData%rPS0,1) - i2_l = LBOUND(SrcRtHndSideData%rPS0,2) - i2_u = UBOUND(SrcRtHndSideData%rPS0,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%rPS0)) THEN - ALLOCATE(DstRtHndSideData%rPS0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rPS0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%rPS0 = SrcRtHndSideData%rPS0 -ENDIF - DstRtHndSideData%rQ = SrcRtHndSideData%rQ - DstRtHndSideData%rQC = SrcRtHndSideData%rQC - DstRtHndSideData%rVIMU = SrcRtHndSideData%rVIMU - DstRtHndSideData%rVP = SrcRtHndSideData%rVP - DstRtHndSideData%rWI = SrcRtHndSideData%rWI - DstRtHndSideData%rWJ = SrcRtHndSideData%rWJ - DstRtHndSideData%rZT0 = SrcRtHndSideData%rZT0 -IF (ALLOCATED(SrcRtHndSideData%AngPosEF)) THEN - i1_l = LBOUND(SrcRtHndSideData%AngPosEF,1) - i1_u = UBOUND(SrcRtHndSideData%AngPosEF,1) - i2_l = LBOUND(SrcRtHndSideData%AngPosEF,2) - i2_u = UBOUND(SrcRtHndSideData%AngPosEF,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%AngPosEF)) THEN - ALLOCATE(DstRtHndSideData%AngPosEF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngPosEF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%AngPosEF = SrcRtHndSideData%AngPosEF -ENDIF -IF (ALLOCATED(SrcRtHndSideData%AngPosXF)) THEN - i1_l = LBOUND(SrcRtHndSideData%AngPosXF,1) - i1_u = UBOUND(SrcRtHndSideData%AngPosXF,1) - i2_l = LBOUND(SrcRtHndSideData%AngPosXF,2) - i2_u = UBOUND(SrcRtHndSideData%AngPosXF,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%AngPosXF)) THEN - ALLOCATE(DstRtHndSideData%AngPosXF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngPosXF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%AngPosXF = SrcRtHndSideData%AngPosXF -ENDIF -IF (ALLOCATED(SrcRtHndSideData%AngPosHM)) THEN - i1_l = LBOUND(SrcRtHndSideData%AngPosHM,1) - i1_u = UBOUND(SrcRtHndSideData%AngPosHM,1) - i2_l = LBOUND(SrcRtHndSideData%AngPosHM,2) - i2_u = UBOUND(SrcRtHndSideData%AngPosHM,2) - i3_l = LBOUND(SrcRtHndSideData%AngPosHM,3) - i3_u = UBOUND(SrcRtHndSideData%AngPosHM,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%AngPosHM)) THEN - ALLOCATE(DstRtHndSideData%AngPosHM(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngPosHM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%AngPosHM = SrcRtHndSideData%AngPosHM -ENDIF - DstRtHndSideData%AngPosXB = SrcRtHndSideData%AngPosXB - DstRtHndSideData%AngPosEX = SrcRtHndSideData%AngPosEX -IF (ALLOCATED(SrcRtHndSideData%PAngVelEA)) THEN - i1_l = LBOUND(SrcRtHndSideData%PAngVelEA,1) - i1_u = UBOUND(SrcRtHndSideData%PAngVelEA,1) - i2_l = LBOUND(SrcRtHndSideData%PAngVelEA,2) - i2_u = UBOUND(SrcRtHndSideData%PAngVelEA,2) - i3_l = LBOUND(SrcRtHndSideData%PAngVelEA,3) - i3_u = UBOUND(SrcRtHndSideData%PAngVelEA,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PAngVelEA)) THEN - ALLOCATE(DstRtHndSideData%PAngVelEA(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PAngVelEA = SrcRtHndSideData%PAngVelEA -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PAngVelEF)) THEN - i1_l = LBOUND(SrcRtHndSideData%PAngVelEF,1) - i1_u = UBOUND(SrcRtHndSideData%PAngVelEF,1) - i2_l = LBOUND(SrcRtHndSideData%PAngVelEF,2) - i2_u = UBOUND(SrcRtHndSideData%PAngVelEF,2) - i3_l = LBOUND(SrcRtHndSideData%PAngVelEF,3) - i3_u = UBOUND(SrcRtHndSideData%PAngVelEF,3) - i4_l = LBOUND(SrcRtHndSideData%PAngVelEF,4) - i4_u = UBOUND(SrcRtHndSideData%PAngVelEF,4) - IF (.NOT. ALLOCATED(DstRtHndSideData%PAngVelEF)) THEN - ALLOCATE(DstRtHndSideData%PAngVelEF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PAngVelEF = SrcRtHndSideData%PAngVelEF -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PAngVelEG)) THEN - i1_l = LBOUND(SrcRtHndSideData%PAngVelEG,1) - i1_u = UBOUND(SrcRtHndSideData%PAngVelEG,1) - i2_l = LBOUND(SrcRtHndSideData%PAngVelEG,2) - i2_u = UBOUND(SrcRtHndSideData%PAngVelEG,2) - i3_l = LBOUND(SrcRtHndSideData%PAngVelEG,3) - i3_u = UBOUND(SrcRtHndSideData%PAngVelEG,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PAngVelEG)) THEN - ALLOCATE(DstRtHndSideData%PAngVelEG(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PAngVelEG = SrcRtHndSideData%PAngVelEG -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PAngVelEH)) THEN - i1_l = LBOUND(SrcRtHndSideData%PAngVelEH,1) - i1_u = UBOUND(SrcRtHndSideData%PAngVelEH,1) - i2_l = LBOUND(SrcRtHndSideData%PAngVelEH,2) - i2_u = UBOUND(SrcRtHndSideData%PAngVelEH,2) - i3_l = LBOUND(SrcRtHndSideData%PAngVelEH,3) - i3_u = UBOUND(SrcRtHndSideData%PAngVelEH,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PAngVelEH)) THEN - ALLOCATE(DstRtHndSideData%PAngVelEH(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEH.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PAngVelEH = SrcRtHndSideData%PAngVelEH -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PAngVelEL)) THEN - i1_l = LBOUND(SrcRtHndSideData%PAngVelEL,1) - i1_u = UBOUND(SrcRtHndSideData%PAngVelEL,1) - i2_l = LBOUND(SrcRtHndSideData%PAngVelEL,2) - i2_u = UBOUND(SrcRtHndSideData%PAngVelEL,2) - i3_l = LBOUND(SrcRtHndSideData%PAngVelEL,3) - i3_u = UBOUND(SrcRtHndSideData%PAngVelEL,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PAngVelEL)) THEN - ALLOCATE(DstRtHndSideData%PAngVelEL(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PAngVelEL = SrcRtHndSideData%PAngVelEL -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PAngVelEM)) THEN - i1_l = LBOUND(SrcRtHndSideData%PAngVelEM,1) - i1_u = UBOUND(SrcRtHndSideData%PAngVelEM,1) - i2_l = LBOUND(SrcRtHndSideData%PAngVelEM,2) - i2_u = UBOUND(SrcRtHndSideData%PAngVelEM,2) - i3_l = LBOUND(SrcRtHndSideData%PAngVelEM,3) - i3_u = UBOUND(SrcRtHndSideData%PAngVelEM,3) - i4_l = LBOUND(SrcRtHndSideData%PAngVelEM,4) - i4_u = UBOUND(SrcRtHndSideData%PAngVelEM,4) - i5_l = LBOUND(SrcRtHndSideData%PAngVelEM,5) - i5_u = UBOUND(SrcRtHndSideData%PAngVelEM,5) - IF (.NOT. ALLOCATED(DstRtHndSideData%PAngVelEM)) THEN - ALLOCATE(DstRtHndSideData%PAngVelEM(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PAngVelEM = SrcRtHndSideData%PAngVelEM -ENDIF -IF (ALLOCATED(SrcRtHndSideData%AngVelEM)) THEN - i1_l = LBOUND(SrcRtHndSideData%AngVelEM,1) - i1_u = UBOUND(SrcRtHndSideData%AngVelEM,1) - i2_l = LBOUND(SrcRtHndSideData%AngVelEM,2) - i2_u = UBOUND(SrcRtHndSideData%AngVelEM,2) - i3_l = LBOUND(SrcRtHndSideData%AngVelEM,3) - i3_u = UBOUND(SrcRtHndSideData%AngVelEM,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%AngVelEM)) THEN - ALLOCATE(DstRtHndSideData%AngVelEM(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngVelEM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%AngVelEM = SrcRtHndSideData%AngVelEM -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PAngVelEN)) THEN - i1_l = LBOUND(SrcRtHndSideData%PAngVelEN,1) - i1_u = UBOUND(SrcRtHndSideData%PAngVelEN,1) - i2_l = LBOUND(SrcRtHndSideData%PAngVelEN,2) - i2_u = UBOUND(SrcRtHndSideData%PAngVelEN,2) - i3_l = LBOUND(SrcRtHndSideData%PAngVelEN,3) - i3_u = UBOUND(SrcRtHndSideData%PAngVelEN,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PAngVelEN)) THEN - ALLOCATE(DstRtHndSideData%PAngVelEN(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PAngVelEN = SrcRtHndSideData%PAngVelEN -ENDIF - DstRtHndSideData%AngVelEA = SrcRtHndSideData%AngVelEA -IF (ALLOCATED(SrcRtHndSideData%PAngVelEB)) THEN - i1_l = LBOUND(SrcRtHndSideData%PAngVelEB,1) - i1_u = UBOUND(SrcRtHndSideData%PAngVelEB,1) - i2_l = LBOUND(SrcRtHndSideData%PAngVelEB,2) - i2_u = UBOUND(SrcRtHndSideData%PAngVelEB,2) - i3_l = LBOUND(SrcRtHndSideData%PAngVelEB,3) - i3_u = UBOUND(SrcRtHndSideData%PAngVelEB,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PAngVelEB)) THEN - ALLOCATE(DstRtHndSideData%PAngVelEB(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PAngVelEB = SrcRtHndSideData%PAngVelEB -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PAngVelER)) THEN - i1_l = LBOUND(SrcRtHndSideData%PAngVelER,1) - i1_u = UBOUND(SrcRtHndSideData%PAngVelER,1) - i2_l = LBOUND(SrcRtHndSideData%PAngVelER,2) - i2_u = UBOUND(SrcRtHndSideData%PAngVelER,2) - i3_l = LBOUND(SrcRtHndSideData%PAngVelER,3) - i3_u = UBOUND(SrcRtHndSideData%PAngVelER,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PAngVelER)) THEN - ALLOCATE(DstRtHndSideData%PAngVelER(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelER.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PAngVelER = SrcRtHndSideData%PAngVelER -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PAngVelEX)) THEN - i1_l = LBOUND(SrcRtHndSideData%PAngVelEX,1) - i1_u = UBOUND(SrcRtHndSideData%PAngVelEX,1) - i2_l = LBOUND(SrcRtHndSideData%PAngVelEX,2) - i2_u = UBOUND(SrcRtHndSideData%PAngVelEX,2) - i3_l = LBOUND(SrcRtHndSideData%PAngVelEX,3) - i3_u = UBOUND(SrcRtHndSideData%PAngVelEX,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PAngVelEX)) THEN - ALLOCATE(DstRtHndSideData%PAngVelEX(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PAngVelEX = SrcRtHndSideData%PAngVelEX -ENDIF - DstRtHndSideData%AngVelEG = SrcRtHndSideData%AngVelEG - DstRtHndSideData%AngVelEH = SrcRtHndSideData%AngVelEH - DstRtHndSideData%AngVelEL = SrcRtHndSideData%AngVelEL - DstRtHndSideData%AngVelEN = SrcRtHndSideData%AngVelEN - DstRtHndSideData%AngVelEB = SrcRtHndSideData%AngVelEB - DstRtHndSideData%AngVelER = SrcRtHndSideData%AngVelER - DstRtHndSideData%AngVelEX = SrcRtHndSideData%AngVelEX - DstRtHndSideData%TeetAngVel = SrcRtHndSideData%TeetAngVel - DstRtHndSideData%AngAccEBt = SrcRtHndSideData%AngAccEBt - DstRtHndSideData%AngAccERt = SrcRtHndSideData%AngAccERt - DstRtHndSideData%AngAccEXt = SrcRtHndSideData%AngAccEXt -IF (ALLOCATED(SrcRtHndSideData%AngAccEFt)) THEN - i1_l = LBOUND(SrcRtHndSideData%AngAccEFt,1) - i1_u = UBOUND(SrcRtHndSideData%AngAccEFt,1) - i2_l = LBOUND(SrcRtHndSideData%AngAccEFt,2) - i2_u = UBOUND(SrcRtHndSideData%AngAccEFt,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%AngAccEFt)) THEN - ALLOCATE(DstRtHndSideData%AngAccEFt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngAccEFt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%AngAccEFt = SrcRtHndSideData%AngAccEFt -ENDIF -IF (ALLOCATED(SrcRtHndSideData%AngVelEF)) THEN - i1_l = LBOUND(SrcRtHndSideData%AngVelEF,1) - i1_u = UBOUND(SrcRtHndSideData%AngVelEF,1) - i2_l = LBOUND(SrcRtHndSideData%AngVelEF,2) - i2_u = UBOUND(SrcRtHndSideData%AngVelEF,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%AngVelEF)) THEN - ALLOCATE(DstRtHndSideData%AngVelEF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngVelEF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%AngVelEF = SrcRtHndSideData%AngVelEF -ENDIF -IF (ALLOCATED(SrcRtHndSideData%AngVelHM)) THEN - i1_l = LBOUND(SrcRtHndSideData%AngVelHM,1) - i1_u = UBOUND(SrcRtHndSideData%AngVelHM,1) - i2_l = LBOUND(SrcRtHndSideData%AngVelHM,2) - i2_u = UBOUND(SrcRtHndSideData%AngVelHM,2) - i3_l = LBOUND(SrcRtHndSideData%AngVelHM,3) - i3_u = UBOUND(SrcRtHndSideData%AngVelHM,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%AngVelHM)) THEN - ALLOCATE(DstRtHndSideData%AngVelHM(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngVelHM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%AngVelHM = SrcRtHndSideData%AngVelHM -ENDIF - DstRtHndSideData%AngAccEAt = SrcRtHndSideData%AngAccEAt - DstRtHndSideData%AngAccEGt = SrcRtHndSideData%AngAccEGt - DstRtHndSideData%AngAccEHt = SrcRtHndSideData%AngAccEHt -IF (ALLOCATED(SrcRtHndSideData%AngAccEKt)) THEN - i1_l = LBOUND(SrcRtHndSideData%AngAccEKt,1) - i1_u = UBOUND(SrcRtHndSideData%AngAccEKt,1) - i2_l = LBOUND(SrcRtHndSideData%AngAccEKt,2) - i2_u = UBOUND(SrcRtHndSideData%AngAccEKt,2) - i3_l = LBOUND(SrcRtHndSideData%AngAccEKt,3) - i3_u = UBOUND(SrcRtHndSideData%AngAccEKt,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%AngAccEKt)) THEN - ALLOCATE(DstRtHndSideData%AngAccEKt(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngAccEKt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%AngAccEKt = SrcRtHndSideData%AngAccEKt -ENDIF - DstRtHndSideData%AngAccENt = SrcRtHndSideData%AngAccENt - DstRtHndSideData%LinAccECt = SrcRtHndSideData%LinAccECt - DstRtHndSideData%LinAccEDt = SrcRtHndSideData%LinAccEDt - DstRtHndSideData%LinAccEIt = SrcRtHndSideData%LinAccEIt - DstRtHndSideData%LinAccEJt = SrcRtHndSideData%LinAccEJt - DstRtHndSideData%LinAccEUt = SrcRtHndSideData%LinAccEUt - DstRtHndSideData%LinAccEYt = SrcRtHndSideData%LinAccEYt -IF (ALLOCATED(SrcRtHndSideData%LinVelES)) THEN - i1_l = LBOUND(SrcRtHndSideData%LinVelES,1) - i1_u = UBOUND(SrcRtHndSideData%LinVelES,1) - i2_l = LBOUND(SrcRtHndSideData%LinVelES,2) - i2_u = UBOUND(SrcRtHndSideData%LinVelES,2) - i3_l = LBOUND(SrcRtHndSideData%LinVelES,3) - i3_u = UBOUND(SrcRtHndSideData%LinVelES,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%LinVelES)) THEN - ALLOCATE(DstRtHndSideData%LinVelES(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%LinVelES.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%LinVelES = SrcRtHndSideData%LinVelES -ENDIF - DstRtHndSideData%LinVelEQ = SrcRtHndSideData%LinVelEQ -IF (ALLOCATED(SrcRtHndSideData%LinVelET)) THEN - i1_l = LBOUND(SrcRtHndSideData%LinVelET,1) - i1_u = UBOUND(SrcRtHndSideData%LinVelET,1) - i2_l = LBOUND(SrcRtHndSideData%LinVelET,2) - i2_u = UBOUND(SrcRtHndSideData%LinVelET,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%LinVelET)) THEN - ALLOCATE(DstRtHndSideData%LinVelET(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%LinVelET.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%LinVelET = SrcRtHndSideData%LinVelET -ENDIF -IF (ALLOCATED(SrcRtHndSideData%LinVelESm2)) THEN - i1_l = LBOUND(SrcRtHndSideData%LinVelESm2,1) - i1_u = UBOUND(SrcRtHndSideData%LinVelESm2,1) - IF (.NOT. ALLOCATED(DstRtHndSideData%LinVelESm2)) THEN - ALLOCATE(DstRtHndSideData%LinVelESm2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%LinVelESm2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%LinVelESm2 = SrcRtHndSideData%LinVelESm2 -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PLinVelEIMU)) THEN - i1_l = LBOUND(SrcRtHndSideData%PLinVelEIMU,1) - i1_u = UBOUND(SrcRtHndSideData%PLinVelEIMU,1) - i2_l = LBOUND(SrcRtHndSideData%PLinVelEIMU,2) - i2_u = UBOUND(SrcRtHndSideData%PLinVelEIMU,2) - i3_l = LBOUND(SrcRtHndSideData%PLinVelEIMU,3) - i3_u = UBOUND(SrcRtHndSideData%PLinVelEIMU,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PLinVelEIMU)) THEN - ALLOCATE(DstRtHndSideData%PLinVelEIMU(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEIMU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PLinVelEIMU = SrcRtHndSideData%PLinVelEIMU -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PLinVelEO)) THEN - i1_l = LBOUND(SrcRtHndSideData%PLinVelEO,1) - i1_u = UBOUND(SrcRtHndSideData%PLinVelEO,1) - i2_l = LBOUND(SrcRtHndSideData%PLinVelEO,2) - i2_u = UBOUND(SrcRtHndSideData%PLinVelEO,2) - i3_l = LBOUND(SrcRtHndSideData%PLinVelEO,3) - i3_u = UBOUND(SrcRtHndSideData%PLinVelEO,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PLinVelEO)) THEN - ALLOCATE(DstRtHndSideData%PLinVelEO(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEO.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PLinVelEO = SrcRtHndSideData%PLinVelEO -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PLinVelES)) THEN - i1_l = LBOUND(SrcRtHndSideData%PLinVelES,1) - i1_u = UBOUND(SrcRtHndSideData%PLinVelES,1) - i2_l = LBOUND(SrcRtHndSideData%PLinVelES,2) - i2_u = UBOUND(SrcRtHndSideData%PLinVelES,2) - i3_l = LBOUND(SrcRtHndSideData%PLinVelES,3) - i3_u = UBOUND(SrcRtHndSideData%PLinVelES,3) - i4_l = LBOUND(SrcRtHndSideData%PLinVelES,4) - i4_u = UBOUND(SrcRtHndSideData%PLinVelES,4) - i5_l = LBOUND(SrcRtHndSideData%PLinVelES,5) - i5_u = UBOUND(SrcRtHndSideData%PLinVelES,5) - IF (.NOT. ALLOCATED(DstRtHndSideData%PLinVelES)) THEN - ALLOCATE(DstRtHndSideData%PLinVelES(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelES.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PLinVelES = SrcRtHndSideData%PLinVelES -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PLinVelET)) THEN - i1_l = LBOUND(SrcRtHndSideData%PLinVelET,1) - i1_u = UBOUND(SrcRtHndSideData%PLinVelET,1) - i2_l = LBOUND(SrcRtHndSideData%PLinVelET,2) - i2_u = UBOUND(SrcRtHndSideData%PLinVelET,2) - i3_l = LBOUND(SrcRtHndSideData%PLinVelET,3) - i3_u = UBOUND(SrcRtHndSideData%PLinVelET,3) - i4_l = LBOUND(SrcRtHndSideData%PLinVelET,4) - i4_u = UBOUND(SrcRtHndSideData%PLinVelET,4) - IF (.NOT. ALLOCATED(DstRtHndSideData%PLinVelET)) THEN - ALLOCATE(DstRtHndSideData%PLinVelET(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelET.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PLinVelET = SrcRtHndSideData%PLinVelET -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PLinVelEZ)) THEN - i1_l = LBOUND(SrcRtHndSideData%PLinVelEZ,1) - i1_u = UBOUND(SrcRtHndSideData%PLinVelEZ,1) - i2_l = LBOUND(SrcRtHndSideData%PLinVelEZ,2) - i2_u = UBOUND(SrcRtHndSideData%PLinVelEZ,2) - i3_l = LBOUND(SrcRtHndSideData%PLinVelEZ,3) - i3_u = UBOUND(SrcRtHndSideData%PLinVelEZ,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PLinVelEZ)) THEN - ALLOCATE(DstRtHndSideData%PLinVelEZ(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PLinVelEZ = SrcRtHndSideData%PLinVelEZ -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PLinVelEC)) THEN - i1_l = LBOUND(SrcRtHndSideData%PLinVelEC,1) - i1_u = UBOUND(SrcRtHndSideData%PLinVelEC,1) - i2_l = LBOUND(SrcRtHndSideData%PLinVelEC,2) - i2_u = UBOUND(SrcRtHndSideData%PLinVelEC,2) - i3_l = LBOUND(SrcRtHndSideData%PLinVelEC,3) - i3_u = UBOUND(SrcRtHndSideData%PLinVelEC,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PLinVelEC)) THEN - ALLOCATE(DstRtHndSideData%PLinVelEC(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PLinVelEC = SrcRtHndSideData%PLinVelEC -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PLinVelED)) THEN - i1_l = LBOUND(SrcRtHndSideData%PLinVelED,1) - i1_u = UBOUND(SrcRtHndSideData%PLinVelED,1) - i2_l = LBOUND(SrcRtHndSideData%PLinVelED,2) - i2_u = UBOUND(SrcRtHndSideData%PLinVelED,2) - i3_l = LBOUND(SrcRtHndSideData%PLinVelED,3) - i3_u = UBOUND(SrcRtHndSideData%PLinVelED,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PLinVelED)) THEN - ALLOCATE(DstRtHndSideData%PLinVelED(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelED.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PLinVelED = SrcRtHndSideData%PLinVelED -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PLinVelEI)) THEN - i1_l = LBOUND(SrcRtHndSideData%PLinVelEI,1) - i1_u = UBOUND(SrcRtHndSideData%PLinVelEI,1) - i2_l = LBOUND(SrcRtHndSideData%PLinVelEI,2) - i2_u = UBOUND(SrcRtHndSideData%PLinVelEI,2) - i3_l = LBOUND(SrcRtHndSideData%PLinVelEI,3) - i3_u = UBOUND(SrcRtHndSideData%PLinVelEI,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PLinVelEI)) THEN - ALLOCATE(DstRtHndSideData%PLinVelEI(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PLinVelEI = SrcRtHndSideData%PLinVelEI -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PLinVelEJ)) THEN - i1_l = LBOUND(SrcRtHndSideData%PLinVelEJ,1) - i1_u = UBOUND(SrcRtHndSideData%PLinVelEJ,1) - i2_l = LBOUND(SrcRtHndSideData%PLinVelEJ,2) - i2_u = UBOUND(SrcRtHndSideData%PLinVelEJ,2) - i3_l = LBOUND(SrcRtHndSideData%PLinVelEJ,3) - i3_u = UBOUND(SrcRtHndSideData%PLinVelEJ,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PLinVelEJ)) THEN - ALLOCATE(DstRtHndSideData%PLinVelEJ(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEJ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PLinVelEJ = SrcRtHndSideData%PLinVelEJ -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PLinVelEP)) THEN - i1_l = LBOUND(SrcRtHndSideData%PLinVelEP,1) - i1_u = UBOUND(SrcRtHndSideData%PLinVelEP,1) - i2_l = LBOUND(SrcRtHndSideData%PLinVelEP,2) - i2_u = UBOUND(SrcRtHndSideData%PLinVelEP,2) - i3_l = LBOUND(SrcRtHndSideData%PLinVelEP,3) - i3_u = UBOUND(SrcRtHndSideData%PLinVelEP,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PLinVelEP)) THEN - ALLOCATE(DstRtHndSideData%PLinVelEP(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PLinVelEP = SrcRtHndSideData%PLinVelEP -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PLinVelEQ)) THEN - i1_l = LBOUND(SrcRtHndSideData%PLinVelEQ,1) - i1_u = UBOUND(SrcRtHndSideData%PLinVelEQ,1) - i2_l = LBOUND(SrcRtHndSideData%PLinVelEQ,2) - i2_u = UBOUND(SrcRtHndSideData%PLinVelEQ,2) - i3_l = LBOUND(SrcRtHndSideData%PLinVelEQ,3) - i3_u = UBOUND(SrcRtHndSideData%PLinVelEQ,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PLinVelEQ)) THEN - ALLOCATE(DstRtHndSideData%PLinVelEQ(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEQ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PLinVelEQ = SrcRtHndSideData%PLinVelEQ -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PLinVelEU)) THEN - i1_l = LBOUND(SrcRtHndSideData%PLinVelEU,1) - i1_u = UBOUND(SrcRtHndSideData%PLinVelEU,1) - i2_l = LBOUND(SrcRtHndSideData%PLinVelEU,2) - i2_u = UBOUND(SrcRtHndSideData%PLinVelEU,2) - i3_l = LBOUND(SrcRtHndSideData%PLinVelEU,3) - i3_u = UBOUND(SrcRtHndSideData%PLinVelEU,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PLinVelEU)) THEN - ALLOCATE(DstRtHndSideData%PLinVelEU(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PLinVelEU = SrcRtHndSideData%PLinVelEU -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PLinVelEV)) THEN - i1_l = LBOUND(SrcRtHndSideData%PLinVelEV,1) - i1_u = UBOUND(SrcRtHndSideData%PLinVelEV,1) - i2_l = LBOUND(SrcRtHndSideData%PLinVelEV,2) - i2_u = UBOUND(SrcRtHndSideData%PLinVelEV,2) - i3_l = LBOUND(SrcRtHndSideData%PLinVelEV,3) - i3_u = UBOUND(SrcRtHndSideData%PLinVelEV,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PLinVelEV)) THEN - ALLOCATE(DstRtHndSideData%PLinVelEV(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PLinVelEV = SrcRtHndSideData%PLinVelEV -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PLinVelEW)) THEN - i1_l = LBOUND(SrcRtHndSideData%PLinVelEW,1) - i1_u = UBOUND(SrcRtHndSideData%PLinVelEW,1) - i2_l = LBOUND(SrcRtHndSideData%PLinVelEW,2) - i2_u = UBOUND(SrcRtHndSideData%PLinVelEW,2) - i3_l = LBOUND(SrcRtHndSideData%PLinVelEW,3) - i3_u = UBOUND(SrcRtHndSideData%PLinVelEW,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PLinVelEW)) THEN - ALLOCATE(DstRtHndSideData%PLinVelEW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PLinVelEW = SrcRtHndSideData%PLinVelEW -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PLinVelEY)) THEN - i1_l = LBOUND(SrcRtHndSideData%PLinVelEY,1) - i1_u = UBOUND(SrcRtHndSideData%PLinVelEY,1) - i2_l = LBOUND(SrcRtHndSideData%PLinVelEY,2) - i2_u = UBOUND(SrcRtHndSideData%PLinVelEY,2) - i3_l = LBOUND(SrcRtHndSideData%PLinVelEY,3) - i3_u = UBOUND(SrcRtHndSideData%PLinVelEY,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PLinVelEY)) THEN - ALLOCATE(DstRtHndSideData%PLinVelEY(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PLinVelEY = SrcRtHndSideData%PLinVelEY -ENDIF - DstRtHndSideData%LinAccEIMUt = SrcRtHndSideData%LinAccEIMUt - DstRtHndSideData%LinAccEOt = SrcRtHndSideData%LinAccEOt -IF (ALLOCATED(SrcRtHndSideData%LinAccESt)) THEN - i1_l = LBOUND(SrcRtHndSideData%LinAccESt,1) - i1_u = UBOUND(SrcRtHndSideData%LinAccESt,1) - i2_l = LBOUND(SrcRtHndSideData%LinAccESt,2) - i2_u = UBOUND(SrcRtHndSideData%LinAccESt,2) - i3_l = LBOUND(SrcRtHndSideData%LinAccESt,3) - i3_u = UBOUND(SrcRtHndSideData%LinAccESt,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%LinAccESt)) THEN - ALLOCATE(DstRtHndSideData%LinAccESt(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%LinAccESt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%LinAccESt = SrcRtHndSideData%LinAccESt -ENDIF -IF (ALLOCATED(SrcRtHndSideData%LinAccETt)) THEN - i1_l = LBOUND(SrcRtHndSideData%LinAccETt,1) - i1_u = UBOUND(SrcRtHndSideData%LinAccETt,1) - i2_l = LBOUND(SrcRtHndSideData%LinAccETt,2) - i2_u = UBOUND(SrcRtHndSideData%LinAccETt,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%LinAccETt)) THEN - ALLOCATE(DstRtHndSideData%LinAccETt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%LinAccETt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%LinAccETt = SrcRtHndSideData%LinAccETt -ENDIF - DstRtHndSideData%LinAccEZt = SrcRtHndSideData%LinAccEZt - DstRtHndSideData%LinVelEIMU = SrcRtHndSideData%LinVelEIMU - DstRtHndSideData%LinVelEZ = SrcRtHndSideData%LinVelEZ - DstRtHndSideData%LinVelEO = SrcRtHndSideData%LinVelEO - DstRtHndSideData%LinVelEJ = SrcRtHndSideData%LinVelEJ - DstRtHndSideData%FrcONcRtt = SrcRtHndSideData%FrcONcRtt - DstRtHndSideData%FrcPRott = SrcRtHndSideData%FrcPRott -IF (ALLOCATED(SrcRtHndSideData%FrcS0Bt)) THEN - i1_l = LBOUND(SrcRtHndSideData%FrcS0Bt,1) - i1_u = UBOUND(SrcRtHndSideData%FrcS0Bt,1) - i2_l = LBOUND(SrcRtHndSideData%FrcS0Bt,2) - i2_u = UBOUND(SrcRtHndSideData%FrcS0Bt,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%FrcS0Bt)) THEN - ALLOCATE(DstRtHndSideData%FrcS0Bt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%FrcS0Bt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%FrcS0Bt = SrcRtHndSideData%FrcS0Bt -ENDIF - DstRtHndSideData%FrcT0Trbt = SrcRtHndSideData%FrcT0Trbt -IF (ALLOCATED(SrcRtHndSideData%FSAero)) THEN - i1_l = LBOUND(SrcRtHndSideData%FSAero,1) - i1_u = UBOUND(SrcRtHndSideData%FSAero,1) - i2_l = LBOUND(SrcRtHndSideData%FSAero,2) - i2_u = UBOUND(SrcRtHndSideData%FSAero,2) - i3_l = LBOUND(SrcRtHndSideData%FSAero,3) - i3_u = UBOUND(SrcRtHndSideData%FSAero,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%FSAero)) THEN - ALLOCATE(DstRtHndSideData%FSAero(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%FSAero.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%FSAero = SrcRtHndSideData%FSAero -ENDIF -IF (ALLOCATED(SrcRtHndSideData%FSTipDrag)) THEN - i1_l = LBOUND(SrcRtHndSideData%FSTipDrag,1) - i1_u = UBOUND(SrcRtHndSideData%FSTipDrag,1) - i2_l = LBOUND(SrcRtHndSideData%FSTipDrag,2) - i2_u = UBOUND(SrcRtHndSideData%FSTipDrag,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%FSTipDrag)) THEN - ALLOCATE(DstRtHndSideData%FSTipDrag(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%FSTipDrag.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%FSTipDrag = SrcRtHndSideData%FSTipDrag -ENDIF -IF (ALLOCATED(SrcRtHndSideData%FTHydrot)) THEN - i1_l = LBOUND(SrcRtHndSideData%FTHydrot,1) - i1_u = UBOUND(SrcRtHndSideData%FTHydrot,1) - i2_l = LBOUND(SrcRtHndSideData%FTHydrot,2) - i2_u = UBOUND(SrcRtHndSideData%FTHydrot,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%FTHydrot)) THEN - ALLOCATE(DstRtHndSideData%FTHydrot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%FTHydrot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%FTHydrot = SrcRtHndSideData%FTHydrot -ENDIF - DstRtHndSideData%FZHydrot = SrcRtHndSideData%FZHydrot -IF (ALLOCATED(SrcRtHndSideData%MFHydrot)) THEN - i1_l = LBOUND(SrcRtHndSideData%MFHydrot,1) - i1_u = UBOUND(SrcRtHndSideData%MFHydrot,1) - i2_l = LBOUND(SrcRtHndSideData%MFHydrot,2) - i2_u = UBOUND(SrcRtHndSideData%MFHydrot,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%MFHydrot)) THEN - ALLOCATE(DstRtHndSideData%MFHydrot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%MFHydrot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%MFHydrot = SrcRtHndSideData%MFHydrot -ENDIF - DstRtHndSideData%MomBNcRtt = SrcRtHndSideData%MomBNcRtt -IF (ALLOCATED(SrcRtHndSideData%MomH0Bt)) THEN - i1_l = LBOUND(SrcRtHndSideData%MomH0Bt,1) - i1_u = UBOUND(SrcRtHndSideData%MomH0Bt,1) - i2_l = LBOUND(SrcRtHndSideData%MomH0Bt,2) - i2_u = UBOUND(SrcRtHndSideData%MomH0Bt,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%MomH0Bt)) THEN - ALLOCATE(DstRtHndSideData%MomH0Bt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%MomH0Bt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%MomH0Bt = SrcRtHndSideData%MomH0Bt -ENDIF - DstRtHndSideData%MomLPRott = SrcRtHndSideData%MomLPRott - DstRtHndSideData%MomNGnRtt = SrcRtHndSideData%MomNGnRtt - DstRtHndSideData%MomNTailt = SrcRtHndSideData%MomNTailt - DstRtHndSideData%MomX0Trbt = SrcRtHndSideData%MomX0Trbt -IF (ALLOCATED(SrcRtHndSideData%MMAero)) THEN - i1_l = LBOUND(SrcRtHndSideData%MMAero,1) - i1_u = UBOUND(SrcRtHndSideData%MMAero,1) - i2_l = LBOUND(SrcRtHndSideData%MMAero,2) - i2_u = UBOUND(SrcRtHndSideData%MMAero,2) - i3_l = LBOUND(SrcRtHndSideData%MMAero,3) - i3_u = UBOUND(SrcRtHndSideData%MMAero,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%MMAero)) THEN - ALLOCATE(DstRtHndSideData%MMAero(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%MMAero.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%MMAero = SrcRtHndSideData%MMAero -ENDIF - DstRtHndSideData%MXHydrot = SrcRtHndSideData%MXHydrot -IF (ALLOCATED(SrcRtHndSideData%PFrcONcRt)) THEN - i1_l = LBOUND(SrcRtHndSideData%PFrcONcRt,1) - i1_u = UBOUND(SrcRtHndSideData%PFrcONcRt,1) - i2_l = LBOUND(SrcRtHndSideData%PFrcONcRt,2) - i2_u = UBOUND(SrcRtHndSideData%PFrcONcRt,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%PFrcONcRt)) THEN - ALLOCATE(DstRtHndSideData%PFrcONcRt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFrcONcRt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PFrcONcRt = SrcRtHndSideData%PFrcONcRt -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PFrcPRot)) THEN - i1_l = LBOUND(SrcRtHndSideData%PFrcPRot,1) - i1_u = UBOUND(SrcRtHndSideData%PFrcPRot,1) - i2_l = LBOUND(SrcRtHndSideData%PFrcPRot,2) - i2_u = UBOUND(SrcRtHndSideData%PFrcPRot,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%PFrcPRot)) THEN - ALLOCATE(DstRtHndSideData%PFrcPRot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFrcPRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PFrcPRot = SrcRtHndSideData%PFrcPRot -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PFrcS0B)) THEN - i1_l = LBOUND(SrcRtHndSideData%PFrcS0B,1) - i1_u = UBOUND(SrcRtHndSideData%PFrcS0B,1) - i2_l = LBOUND(SrcRtHndSideData%PFrcS0B,2) - i2_u = UBOUND(SrcRtHndSideData%PFrcS0B,2) - i3_l = LBOUND(SrcRtHndSideData%PFrcS0B,3) - i3_u = UBOUND(SrcRtHndSideData%PFrcS0B,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PFrcS0B)) THEN - ALLOCATE(DstRtHndSideData%PFrcS0B(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFrcS0B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PFrcS0B = SrcRtHndSideData%PFrcS0B -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PFrcT0Trb)) THEN - i1_l = LBOUND(SrcRtHndSideData%PFrcT0Trb,1) - i1_u = UBOUND(SrcRtHndSideData%PFrcT0Trb,1) - i2_l = LBOUND(SrcRtHndSideData%PFrcT0Trb,2) - i2_u = UBOUND(SrcRtHndSideData%PFrcT0Trb,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%PFrcT0Trb)) THEN - ALLOCATE(DstRtHndSideData%PFrcT0Trb(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFrcT0Trb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PFrcT0Trb = SrcRtHndSideData%PFrcT0Trb -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PFTHydro)) THEN - i1_l = LBOUND(SrcRtHndSideData%PFTHydro,1) - i1_u = UBOUND(SrcRtHndSideData%PFTHydro,1) - i2_l = LBOUND(SrcRtHndSideData%PFTHydro,2) - i2_u = UBOUND(SrcRtHndSideData%PFTHydro,2) - i3_l = LBOUND(SrcRtHndSideData%PFTHydro,3) - i3_u = UBOUND(SrcRtHndSideData%PFTHydro,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PFTHydro)) THEN - ALLOCATE(DstRtHndSideData%PFTHydro(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFTHydro.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PFTHydro = SrcRtHndSideData%PFTHydro -ENDIF - DstRtHndSideData%PFZHydro = SrcRtHndSideData%PFZHydro -IF (ALLOCATED(SrcRtHndSideData%PMFHydro)) THEN - i1_l = LBOUND(SrcRtHndSideData%PMFHydro,1) - i1_u = UBOUND(SrcRtHndSideData%PMFHydro,1) - i2_l = LBOUND(SrcRtHndSideData%PMFHydro,2) - i2_u = UBOUND(SrcRtHndSideData%PMFHydro,2) - i3_l = LBOUND(SrcRtHndSideData%PMFHydro,3) - i3_u = UBOUND(SrcRtHndSideData%PMFHydro,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PMFHydro)) THEN - ALLOCATE(DstRtHndSideData%PMFHydro(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMFHydro.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PMFHydro = SrcRtHndSideData%PMFHydro -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PMomBNcRt)) THEN - i1_l = LBOUND(SrcRtHndSideData%PMomBNcRt,1) - i1_u = UBOUND(SrcRtHndSideData%PMomBNcRt,1) - i2_l = LBOUND(SrcRtHndSideData%PMomBNcRt,2) - i2_u = UBOUND(SrcRtHndSideData%PMomBNcRt,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%PMomBNcRt)) THEN - ALLOCATE(DstRtHndSideData%PMomBNcRt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMomBNcRt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PMomBNcRt = SrcRtHndSideData%PMomBNcRt -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PMomH0B)) THEN - i1_l = LBOUND(SrcRtHndSideData%PMomH0B,1) - i1_u = UBOUND(SrcRtHndSideData%PMomH0B,1) - i2_l = LBOUND(SrcRtHndSideData%PMomH0B,2) - i2_u = UBOUND(SrcRtHndSideData%PMomH0B,2) - i3_l = LBOUND(SrcRtHndSideData%PMomH0B,3) - i3_u = UBOUND(SrcRtHndSideData%PMomH0B,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%PMomH0B)) THEN - ALLOCATE(DstRtHndSideData%PMomH0B(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMomH0B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PMomH0B = SrcRtHndSideData%PMomH0B -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PMomLPRot)) THEN - i1_l = LBOUND(SrcRtHndSideData%PMomLPRot,1) - i1_u = UBOUND(SrcRtHndSideData%PMomLPRot,1) - i2_l = LBOUND(SrcRtHndSideData%PMomLPRot,2) - i2_u = UBOUND(SrcRtHndSideData%PMomLPRot,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%PMomLPRot)) THEN - ALLOCATE(DstRtHndSideData%PMomLPRot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMomLPRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PMomLPRot = SrcRtHndSideData%PMomLPRot -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PMomNGnRt)) THEN - i1_l = LBOUND(SrcRtHndSideData%PMomNGnRt,1) - i1_u = UBOUND(SrcRtHndSideData%PMomNGnRt,1) - i2_l = LBOUND(SrcRtHndSideData%PMomNGnRt,2) - i2_u = UBOUND(SrcRtHndSideData%PMomNGnRt,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%PMomNGnRt)) THEN - ALLOCATE(DstRtHndSideData%PMomNGnRt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMomNGnRt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PMomNGnRt = SrcRtHndSideData%PMomNGnRt -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PMomNTail)) THEN - i1_l = LBOUND(SrcRtHndSideData%PMomNTail,1) - i1_u = UBOUND(SrcRtHndSideData%PMomNTail,1) - i2_l = LBOUND(SrcRtHndSideData%PMomNTail,2) - i2_u = UBOUND(SrcRtHndSideData%PMomNTail,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%PMomNTail)) THEN - ALLOCATE(DstRtHndSideData%PMomNTail(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMomNTail.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PMomNTail = SrcRtHndSideData%PMomNTail -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PMomX0Trb)) THEN - i1_l = LBOUND(SrcRtHndSideData%PMomX0Trb,1) - i1_u = UBOUND(SrcRtHndSideData%PMomX0Trb,1) - i2_l = LBOUND(SrcRtHndSideData%PMomX0Trb,2) - i2_u = UBOUND(SrcRtHndSideData%PMomX0Trb,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%PMomX0Trb)) THEN - ALLOCATE(DstRtHndSideData%PMomX0Trb(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMomX0Trb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PMomX0Trb = SrcRtHndSideData%PMomX0Trb -ENDIF - DstRtHndSideData%PMXHydro = SrcRtHndSideData%PMXHydro - DstRtHndSideData%TeetAng = SrcRtHndSideData%TeetAng - DstRtHndSideData%FrcVGnRtt = SrcRtHndSideData%FrcVGnRtt - DstRtHndSideData%FrcWTailt = SrcRtHndSideData%FrcWTailt - DstRtHndSideData%FrcZAllt = SrcRtHndSideData%FrcZAllt - DstRtHndSideData%MomXAllt = SrcRtHndSideData%MomXAllt -IF (ALLOCATED(SrcRtHndSideData%PFrcVGnRt)) THEN - i1_l = LBOUND(SrcRtHndSideData%PFrcVGnRt,1) - i1_u = UBOUND(SrcRtHndSideData%PFrcVGnRt,1) - i2_l = LBOUND(SrcRtHndSideData%PFrcVGnRt,2) - i2_u = UBOUND(SrcRtHndSideData%PFrcVGnRt,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%PFrcVGnRt)) THEN - ALLOCATE(DstRtHndSideData%PFrcVGnRt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFrcVGnRt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PFrcVGnRt = SrcRtHndSideData%PFrcVGnRt -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PFrcWTail)) THEN - i1_l = LBOUND(SrcRtHndSideData%PFrcWTail,1) - i1_u = UBOUND(SrcRtHndSideData%PFrcWTail,1) - i2_l = LBOUND(SrcRtHndSideData%PFrcWTail,2) - i2_u = UBOUND(SrcRtHndSideData%PFrcWTail,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%PFrcWTail)) THEN - ALLOCATE(DstRtHndSideData%PFrcWTail(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFrcWTail.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PFrcWTail = SrcRtHndSideData%PFrcWTail -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PFrcZAll)) THEN - i1_l = LBOUND(SrcRtHndSideData%PFrcZAll,1) - i1_u = UBOUND(SrcRtHndSideData%PFrcZAll,1) - i2_l = LBOUND(SrcRtHndSideData%PFrcZAll,2) - i2_u = UBOUND(SrcRtHndSideData%PFrcZAll,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%PFrcZAll)) THEN - ALLOCATE(DstRtHndSideData%PFrcZAll(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFrcZAll.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PFrcZAll = SrcRtHndSideData%PFrcZAll -ENDIF -IF (ALLOCATED(SrcRtHndSideData%PMomXAll)) THEN - i1_l = LBOUND(SrcRtHndSideData%PMomXAll,1) - i1_u = UBOUND(SrcRtHndSideData%PMomXAll,1) - i2_l = LBOUND(SrcRtHndSideData%PMomXAll,2) - i2_u = UBOUND(SrcRtHndSideData%PMomXAll,2) - IF (.NOT. ALLOCATED(DstRtHndSideData%PMomXAll)) THEN - ALLOCATE(DstRtHndSideData%PMomXAll(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMomXAll.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%PMomXAll = SrcRtHndSideData%PMomXAll -ENDIF - DstRtHndSideData%TeetMom = SrcRtHndSideData%TeetMom - DstRtHndSideData%TFrlMom = SrcRtHndSideData%TFrlMom - DstRtHndSideData%RFrlMom = SrcRtHndSideData%RFrlMom - DstRtHndSideData%GBoxEffFac = SrcRtHndSideData%GBoxEffFac -IF (ALLOCATED(SrcRtHndSideData%rSAerCen)) THEN - i1_l = LBOUND(SrcRtHndSideData%rSAerCen,1) - i1_u = UBOUND(SrcRtHndSideData%rSAerCen,1) - i2_l = LBOUND(SrcRtHndSideData%rSAerCen,2) - i2_u = UBOUND(SrcRtHndSideData%rSAerCen,2) - i3_l = LBOUND(SrcRtHndSideData%rSAerCen,3) - i3_u = UBOUND(SrcRtHndSideData%rSAerCen,3) - IF (.NOT. ALLOCATED(DstRtHndSideData%rSAerCen)) THEN - ALLOCATE(DstRtHndSideData%rSAerCen(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rSAerCen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRtHndSideData%rSAerCen = SrcRtHndSideData%rSAerCen -ENDIF - END SUBROUTINE ED_CopyRtHndSide - SUBROUTINE ED_DestroyRtHndSide( RtHndSideData, ErrStat, ErrMsg ) - TYPE(ED_RtHndSide), INTENT(INOUT) :: RtHndSideData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyRtHndSide' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(RtHndSideData%rQS)) THEN - DEALLOCATE(RtHndSideData%rQS) -ENDIF -IF (ALLOCATED(RtHndSideData%rS)) THEN - DEALLOCATE(RtHndSideData%rS) -ENDIF -IF (ALLOCATED(RtHndSideData%rS0S)) THEN - DEALLOCATE(RtHndSideData%rS0S) -ENDIF -IF (ALLOCATED(RtHndSideData%rT)) THEN - DEALLOCATE(RtHndSideData%rT) -ENDIF -IF (ALLOCATED(RtHndSideData%rT0T)) THEN - DEALLOCATE(RtHndSideData%rT0T) -ENDIF -IF (ALLOCATED(RtHndSideData%rZT)) THEN - DEALLOCATE(RtHndSideData%rZT) -ENDIF -IF (ALLOCATED(RtHndSideData%rPS0)) THEN - DEALLOCATE(RtHndSideData%rPS0) -ENDIF -IF (ALLOCATED(RtHndSideData%AngPosEF)) THEN - DEALLOCATE(RtHndSideData%AngPosEF) -ENDIF -IF (ALLOCATED(RtHndSideData%AngPosXF)) THEN - DEALLOCATE(RtHndSideData%AngPosXF) -ENDIF -IF (ALLOCATED(RtHndSideData%AngPosHM)) THEN - DEALLOCATE(RtHndSideData%AngPosHM) -ENDIF -IF (ALLOCATED(RtHndSideData%PAngVelEA)) THEN - DEALLOCATE(RtHndSideData%PAngVelEA) -ENDIF -IF (ALLOCATED(RtHndSideData%PAngVelEF)) THEN - DEALLOCATE(RtHndSideData%PAngVelEF) -ENDIF -IF (ALLOCATED(RtHndSideData%PAngVelEG)) THEN - DEALLOCATE(RtHndSideData%PAngVelEG) -ENDIF -IF (ALLOCATED(RtHndSideData%PAngVelEH)) THEN - DEALLOCATE(RtHndSideData%PAngVelEH) -ENDIF -IF (ALLOCATED(RtHndSideData%PAngVelEL)) THEN - DEALLOCATE(RtHndSideData%PAngVelEL) -ENDIF -IF (ALLOCATED(RtHndSideData%PAngVelEM)) THEN - DEALLOCATE(RtHndSideData%PAngVelEM) -ENDIF -IF (ALLOCATED(RtHndSideData%AngVelEM)) THEN - DEALLOCATE(RtHndSideData%AngVelEM) -ENDIF -IF (ALLOCATED(RtHndSideData%PAngVelEN)) THEN - DEALLOCATE(RtHndSideData%PAngVelEN) -ENDIF -IF (ALLOCATED(RtHndSideData%PAngVelEB)) THEN - DEALLOCATE(RtHndSideData%PAngVelEB) -ENDIF -IF (ALLOCATED(RtHndSideData%PAngVelER)) THEN - DEALLOCATE(RtHndSideData%PAngVelER) -ENDIF -IF (ALLOCATED(RtHndSideData%PAngVelEX)) THEN - DEALLOCATE(RtHndSideData%PAngVelEX) -ENDIF -IF (ALLOCATED(RtHndSideData%AngAccEFt)) THEN - DEALLOCATE(RtHndSideData%AngAccEFt) -ENDIF -IF (ALLOCATED(RtHndSideData%AngVelEF)) THEN - DEALLOCATE(RtHndSideData%AngVelEF) -ENDIF -IF (ALLOCATED(RtHndSideData%AngVelHM)) THEN - DEALLOCATE(RtHndSideData%AngVelHM) -ENDIF -IF (ALLOCATED(RtHndSideData%AngAccEKt)) THEN - DEALLOCATE(RtHndSideData%AngAccEKt) -ENDIF -IF (ALLOCATED(RtHndSideData%LinVelES)) THEN - DEALLOCATE(RtHndSideData%LinVelES) -ENDIF -IF (ALLOCATED(RtHndSideData%LinVelET)) THEN - DEALLOCATE(RtHndSideData%LinVelET) -ENDIF -IF (ALLOCATED(RtHndSideData%LinVelESm2)) THEN - DEALLOCATE(RtHndSideData%LinVelESm2) -ENDIF -IF (ALLOCATED(RtHndSideData%PLinVelEIMU)) THEN - DEALLOCATE(RtHndSideData%PLinVelEIMU) -ENDIF -IF (ALLOCATED(RtHndSideData%PLinVelEO)) THEN - DEALLOCATE(RtHndSideData%PLinVelEO) -ENDIF -IF (ALLOCATED(RtHndSideData%PLinVelES)) THEN - DEALLOCATE(RtHndSideData%PLinVelES) -ENDIF -IF (ALLOCATED(RtHndSideData%PLinVelET)) THEN - DEALLOCATE(RtHndSideData%PLinVelET) -ENDIF -IF (ALLOCATED(RtHndSideData%PLinVelEZ)) THEN - DEALLOCATE(RtHndSideData%PLinVelEZ) -ENDIF -IF (ALLOCATED(RtHndSideData%PLinVelEC)) THEN - DEALLOCATE(RtHndSideData%PLinVelEC) -ENDIF -IF (ALLOCATED(RtHndSideData%PLinVelED)) THEN - DEALLOCATE(RtHndSideData%PLinVelED) -ENDIF -IF (ALLOCATED(RtHndSideData%PLinVelEI)) THEN - DEALLOCATE(RtHndSideData%PLinVelEI) -ENDIF -IF (ALLOCATED(RtHndSideData%PLinVelEJ)) THEN - DEALLOCATE(RtHndSideData%PLinVelEJ) -ENDIF -IF (ALLOCATED(RtHndSideData%PLinVelEP)) THEN - DEALLOCATE(RtHndSideData%PLinVelEP) -ENDIF -IF (ALLOCATED(RtHndSideData%PLinVelEQ)) THEN - DEALLOCATE(RtHndSideData%PLinVelEQ) -ENDIF -IF (ALLOCATED(RtHndSideData%PLinVelEU)) THEN - DEALLOCATE(RtHndSideData%PLinVelEU) -ENDIF -IF (ALLOCATED(RtHndSideData%PLinVelEV)) THEN - DEALLOCATE(RtHndSideData%PLinVelEV) -ENDIF -IF (ALLOCATED(RtHndSideData%PLinVelEW)) THEN - DEALLOCATE(RtHndSideData%PLinVelEW) -ENDIF -IF (ALLOCATED(RtHndSideData%PLinVelEY)) THEN - DEALLOCATE(RtHndSideData%PLinVelEY) -ENDIF -IF (ALLOCATED(RtHndSideData%LinAccESt)) THEN - DEALLOCATE(RtHndSideData%LinAccESt) -ENDIF -IF (ALLOCATED(RtHndSideData%LinAccETt)) THEN - DEALLOCATE(RtHndSideData%LinAccETt) -ENDIF -IF (ALLOCATED(RtHndSideData%FrcS0Bt)) THEN - DEALLOCATE(RtHndSideData%FrcS0Bt) -ENDIF -IF (ALLOCATED(RtHndSideData%FSAero)) THEN - DEALLOCATE(RtHndSideData%FSAero) -ENDIF -IF (ALLOCATED(RtHndSideData%FSTipDrag)) THEN - DEALLOCATE(RtHndSideData%FSTipDrag) -ENDIF -IF (ALLOCATED(RtHndSideData%FTHydrot)) THEN - DEALLOCATE(RtHndSideData%FTHydrot) -ENDIF -IF (ALLOCATED(RtHndSideData%MFHydrot)) THEN - DEALLOCATE(RtHndSideData%MFHydrot) -ENDIF -IF (ALLOCATED(RtHndSideData%MomH0Bt)) THEN - DEALLOCATE(RtHndSideData%MomH0Bt) -ENDIF -IF (ALLOCATED(RtHndSideData%MMAero)) THEN - DEALLOCATE(RtHndSideData%MMAero) -ENDIF -IF (ALLOCATED(RtHndSideData%PFrcONcRt)) THEN - DEALLOCATE(RtHndSideData%PFrcONcRt) -ENDIF -IF (ALLOCATED(RtHndSideData%PFrcPRot)) THEN - DEALLOCATE(RtHndSideData%PFrcPRot) -ENDIF -IF (ALLOCATED(RtHndSideData%PFrcS0B)) THEN - DEALLOCATE(RtHndSideData%PFrcS0B) -ENDIF -IF (ALLOCATED(RtHndSideData%PFrcT0Trb)) THEN - DEALLOCATE(RtHndSideData%PFrcT0Trb) -ENDIF -IF (ALLOCATED(RtHndSideData%PFTHydro)) THEN - DEALLOCATE(RtHndSideData%PFTHydro) -ENDIF -IF (ALLOCATED(RtHndSideData%PMFHydro)) THEN - DEALLOCATE(RtHndSideData%PMFHydro) -ENDIF -IF (ALLOCATED(RtHndSideData%PMomBNcRt)) THEN - DEALLOCATE(RtHndSideData%PMomBNcRt) -ENDIF -IF (ALLOCATED(RtHndSideData%PMomH0B)) THEN - DEALLOCATE(RtHndSideData%PMomH0B) -ENDIF -IF (ALLOCATED(RtHndSideData%PMomLPRot)) THEN - DEALLOCATE(RtHndSideData%PMomLPRot) -ENDIF -IF (ALLOCATED(RtHndSideData%PMomNGnRt)) THEN - DEALLOCATE(RtHndSideData%PMomNGnRt) -ENDIF -IF (ALLOCATED(RtHndSideData%PMomNTail)) THEN - DEALLOCATE(RtHndSideData%PMomNTail) -ENDIF -IF (ALLOCATED(RtHndSideData%PMomX0Trb)) THEN - DEALLOCATE(RtHndSideData%PMomX0Trb) -ENDIF -IF (ALLOCATED(RtHndSideData%PFrcVGnRt)) THEN - DEALLOCATE(RtHndSideData%PFrcVGnRt) -ENDIF -IF (ALLOCATED(RtHndSideData%PFrcWTail)) THEN - DEALLOCATE(RtHndSideData%PFrcWTail) -ENDIF -IF (ALLOCATED(RtHndSideData%PFrcZAll)) THEN - DEALLOCATE(RtHndSideData%PFrcZAll) -ENDIF -IF (ALLOCATED(RtHndSideData%PMomXAll)) THEN - DEALLOCATE(RtHndSideData%PMomXAll) -ENDIF -IF (ALLOCATED(RtHndSideData%rSAerCen)) THEN - DEALLOCATE(RtHndSideData%rSAerCen) -ENDIF - END SUBROUTINE ED_DestroyRtHndSide +subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrStat, ErrMsg) + type(ED_RtHndSide), intent(in) :: SrcRtHndSideData + type(ED_RtHndSide), intent(inout) :: DstRtHndSideData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'ED_CopyRtHndSide' + ErrStat = ErrID_None + ErrMsg = '' + DstRtHndSideData%rO = SrcRtHndSideData%rO + if (allocated(SrcRtHndSideData%rQS)) then + LB(1:3) = lbound(SrcRtHndSideData%rQS) + UB(1:3) = ubound(SrcRtHndSideData%rQS) + if (.not. allocated(DstRtHndSideData%rQS)) then + allocate(DstRtHndSideData%rQS(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rQS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%rQS = SrcRtHndSideData%rQS + else if (allocated(DstRtHndSideData%rQS)) then + deallocate(DstRtHndSideData%rQS) + end if + if (allocated(SrcRtHndSideData%rS)) then + LB(1:3) = lbound(SrcRtHndSideData%rS) + UB(1:3) = ubound(SrcRtHndSideData%rS) + if (.not. allocated(DstRtHndSideData%rS)) then + allocate(DstRtHndSideData%rS(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%rS = SrcRtHndSideData%rS + else if (allocated(DstRtHndSideData%rS)) then + deallocate(DstRtHndSideData%rS) + end if + if (allocated(SrcRtHndSideData%rS0S)) then + LB(1:3) = lbound(SrcRtHndSideData%rS0S) + UB(1:3) = ubound(SrcRtHndSideData%rS0S) + if (.not. allocated(DstRtHndSideData%rS0S)) then + allocate(DstRtHndSideData%rS0S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rS0S.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%rS0S = SrcRtHndSideData%rS0S + else if (allocated(DstRtHndSideData%rS0S)) then + deallocate(DstRtHndSideData%rS0S) + end if + if (allocated(SrcRtHndSideData%rT)) then + LB(1:2) = lbound(SrcRtHndSideData%rT) + UB(1:2) = ubound(SrcRtHndSideData%rT) + if (.not. allocated(DstRtHndSideData%rT)) then + allocate(DstRtHndSideData%rT(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%rT = SrcRtHndSideData%rT + else if (allocated(DstRtHndSideData%rT)) then + deallocate(DstRtHndSideData%rT) + end if + DstRtHndSideData%rT0O = SrcRtHndSideData%rT0O + if (allocated(SrcRtHndSideData%rT0T)) then + LB(1:2) = lbound(SrcRtHndSideData%rT0T) + UB(1:2) = ubound(SrcRtHndSideData%rT0T) + if (.not. allocated(DstRtHndSideData%rT0T)) then + allocate(DstRtHndSideData%rT0T(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rT0T.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%rT0T = SrcRtHndSideData%rT0T + else if (allocated(DstRtHndSideData%rT0T)) then + deallocate(DstRtHndSideData%rT0T) + end if + DstRtHndSideData%rZ = SrcRtHndSideData%rZ + DstRtHndSideData%rZO = SrcRtHndSideData%rZO + if (allocated(SrcRtHndSideData%rZT)) then + LB(1:2) = lbound(SrcRtHndSideData%rZT) + UB(1:2) = ubound(SrcRtHndSideData%rZT) + if (.not. allocated(DstRtHndSideData%rZT)) then + allocate(DstRtHndSideData%rZT(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rZT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%rZT = SrcRtHndSideData%rZT + else if (allocated(DstRtHndSideData%rZT)) then + deallocate(DstRtHndSideData%rZT) + end if + DstRtHndSideData%rPQ = SrcRtHndSideData%rPQ + DstRtHndSideData%rP = SrcRtHndSideData%rP + DstRtHndSideData%rV = SrcRtHndSideData%rV + DstRtHndSideData%rJ = SrcRtHndSideData%rJ + DstRtHndSideData%rZY = SrcRtHndSideData%rZY + DstRtHndSideData%rOU = SrcRtHndSideData%rOU + DstRtHndSideData%rOV = SrcRtHndSideData%rOV + DstRtHndSideData%rVD = SrcRtHndSideData%rVD + DstRtHndSideData%rOW = SrcRtHndSideData%rOW + DstRtHndSideData%rPC = SrcRtHndSideData%rPC + if (allocated(SrcRtHndSideData%rPS0)) then + LB(1:2) = lbound(SrcRtHndSideData%rPS0) + UB(1:2) = ubound(SrcRtHndSideData%rPS0) + if (.not. allocated(DstRtHndSideData%rPS0)) then + allocate(DstRtHndSideData%rPS0(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rPS0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%rPS0 = SrcRtHndSideData%rPS0 + else if (allocated(DstRtHndSideData%rPS0)) then + deallocate(DstRtHndSideData%rPS0) + end if + DstRtHndSideData%rQ = SrcRtHndSideData%rQ + DstRtHndSideData%rQC = SrcRtHndSideData%rQC + DstRtHndSideData%rVIMU = SrcRtHndSideData%rVIMU + DstRtHndSideData%rVP = SrcRtHndSideData%rVP + DstRtHndSideData%rWI = SrcRtHndSideData%rWI + DstRtHndSideData%rWJ = SrcRtHndSideData%rWJ + DstRtHndSideData%rZT0 = SrcRtHndSideData%rZT0 + if (allocated(SrcRtHndSideData%AngPosEF)) then + LB(1:2) = lbound(SrcRtHndSideData%AngPosEF) + UB(1:2) = ubound(SrcRtHndSideData%AngPosEF) + if (.not. allocated(DstRtHndSideData%AngPosEF)) then + allocate(DstRtHndSideData%AngPosEF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngPosEF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%AngPosEF = SrcRtHndSideData%AngPosEF + else if (allocated(DstRtHndSideData%AngPosEF)) then + deallocate(DstRtHndSideData%AngPosEF) + end if + if (allocated(SrcRtHndSideData%AngPosXF)) then + LB(1:2) = lbound(SrcRtHndSideData%AngPosXF) + UB(1:2) = ubound(SrcRtHndSideData%AngPosXF) + if (.not. allocated(DstRtHndSideData%AngPosXF)) then + allocate(DstRtHndSideData%AngPosXF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngPosXF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%AngPosXF = SrcRtHndSideData%AngPosXF + else if (allocated(DstRtHndSideData%AngPosXF)) then + deallocate(DstRtHndSideData%AngPosXF) + end if + if (allocated(SrcRtHndSideData%AngPosHM)) then + LB(1:3) = lbound(SrcRtHndSideData%AngPosHM) + UB(1:3) = ubound(SrcRtHndSideData%AngPosHM) + if (.not. allocated(DstRtHndSideData%AngPosHM)) then + allocate(DstRtHndSideData%AngPosHM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngPosHM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%AngPosHM = SrcRtHndSideData%AngPosHM + else if (allocated(DstRtHndSideData%AngPosHM)) then + deallocate(DstRtHndSideData%AngPosHM) + end if + DstRtHndSideData%AngPosXB = SrcRtHndSideData%AngPosXB + DstRtHndSideData%AngPosEX = SrcRtHndSideData%AngPosEX + if (allocated(SrcRtHndSideData%PAngVelEA)) then + LB(1:3) = lbound(SrcRtHndSideData%PAngVelEA) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelEA) + if (.not. allocated(DstRtHndSideData%PAngVelEA)) then + allocate(DstRtHndSideData%PAngVelEA(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEA.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PAngVelEA = SrcRtHndSideData%PAngVelEA + else if (allocated(DstRtHndSideData%PAngVelEA)) then + deallocate(DstRtHndSideData%PAngVelEA) + end if + if (allocated(SrcRtHndSideData%PAngVelEF)) then + LB(1:4) = lbound(SrcRtHndSideData%PAngVelEF) + UB(1:4) = ubound(SrcRtHndSideData%PAngVelEF) + if (.not. allocated(DstRtHndSideData%PAngVelEF)) then + allocate(DstRtHndSideData%PAngVelEF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PAngVelEF = SrcRtHndSideData%PAngVelEF + else if (allocated(DstRtHndSideData%PAngVelEF)) then + deallocate(DstRtHndSideData%PAngVelEF) + end if + if (allocated(SrcRtHndSideData%PAngVelEG)) then + LB(1:3) = lbound(SrcRtHndSideData%PAngVelEG) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelEG) + if (.not. allocated(DstRtHndSideData%PAngVelEG)) then + allocate(DstRtHndSideData%PAngVelEG(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEG.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PAngVelEG = SrcRtHndSideData%PAngVelEG + else if (allocated(DstRtHndSideData%PAngVelEG)) then + deallocate(DstRtHndSideData%PAngVelEG) + end if + if (allocated(SrcRtHndSideData%PAngVelEH)) then + LB(1:3) = lbound(SrcRtHndSideData%PAngVelEH) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelEH) + if (.not. allocated(DstRtHndSideData%PAngVelEH)) then + allocate(DstRtHndSideData%PAngVelEH(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEH.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PAngVelEH = SrcRtHndSideData%PAngVelEH + else if (allocated(DstRtHndSideData%PAngVelEH)) then + deallocate(DstRtHndSideData%PAngVelEH) + end if + if (allocated(SrcRtHndSideData%PAngVelEL)) then + LB(1:3) = lbound(SrcRtHndSideData%PAngVelEL) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelEL) + if (.not. allocated(DstRtHndSideData%PAngVelEL)) then + allocate(DstRtHndSideData%PAngVelEL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PAngVelEL = SrcRtHndSideData%PAngVelEL + else if (allocated(DstRtHndSideData%PAngVelEL)) then + deallocate(DstRtHndSideData%PAngVelEL) + end if + if (allocated(SrcRtHndSideData%PAngVelEM)) then + LB(1:5) = lbound(SrcRtHndSideData%PAngVelEM) + UB(1:5) = ubound(SrcRtHndSideData%PAngVelEM) + if (.not. allocated(DstRtHndSideData%PAngVelEM)) then + allocate(DstRtHndSideData%PAngVelEM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PAngVelEM = SrcRtHndSideData%PAngVelEM + else if (allocated(DstRtHndSideData%PAngVelEM)) then + deallocate(DstRtHndSideData%PAngVelEM) + end if + if (allocated(SrcRtHndSideData%AngVelEM)) then + LB(1:3) = lbound(SrcRtHndSideData%AngVelEM) + UB(1:3) = ubound(SrcRtHndSideData%AngVelEM) + if (.not. allocated(DstRtHndSideData%AngVelEM)) then + allocate(DstRtHndSideData%AngVelEM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngVelEM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%AngVelEM = SrcRtHndSideData%AngVelEM + else if (allocated(DstRtHndSideData%AngVelEM)) then + deallocate(DstRtHndSideData%AngVelEM) + end if + if (allocated(SrcRtHndSideData%PAngVelEN)) then + LB(1:3) = lbound(SrcRtHndSideData%PAngVelEN) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelEN) + if (.not. allocated(DstRtHndSideData%PAngVelEN)) then + allocate(DstRtHndSideData%PAngVelEN(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEN.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PAngVelEN = SrcRtHndSideData%PAngVelEN + else if (allocated(DstRtHndSideData%PAngVelEN)) then + deallocate(DstRtHndSideData%PAngVelEN) + end if + DstRtHndSideData%AngVelEA = SrcRtHndSideData%AngVelEA + if (allocated(SrcRtHndSideData%PAngVelEB)) then + LB(1:3) = lbound(SrcRtHndSideData%PAngVelEB) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelEB) + if (.not. allocated(DstRtHndSideData%PAngVelEB)) then + allocate(DstRtHndSideData%PAngVelEB(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PAngVelEB = SrcRtHndSideData%PAngVelEB + else if (allocated(DstRtHndSideData%PAngVelEB)) then + deallocate(DstRtHndSideData%PAngVelEB) + end if + if (allocated(SrcRtHndSideData%PAngVelER)) then + LB(1:3) = lbound(SrcRtHndSideData%PAngVelER) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelER) + if (.not. allocated(DstRtHndSideData%PAngVelER)) then + allocate(DstRtHndSideData%PAngVelER(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelER.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PAngVelER = SrcRtHndSideData%PAngVelER + else if (allocated(DstRtHndSideData%PAngVelER)) then + deallocate(DstRtHndSideData%PAngVelER) + end if + if (allocated(SrcRtHndSideData%PAngVelEX)) then + LB(1:3) = lbound(SrcRtHndSideData%PAngVelEX) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelEX) + if (.not. allocated(DstRtHndSideData%PAngVelEX)) then + allocate(DstRtHndSideData%PAngVelEX(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PAngVelEX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PAngVelEX = SrcRtHndSideData%PAngVelEX + else if (allocated(DstRtHndSideData%PAngVelEX)) then + deallocate(DstRtHndSideData%PAngVelEX) + end if + DstRtHndSideData%AngVelEG = SrcRtHndSideData%AngVelEG + DstRtHndSideData%AngVelEH = SrcRtHndSideData%AngVelEH + DstRtHndSideData%AngVelEL = SrcRtHndSideData%AngVelEL + DstRtHndSideData%AngVelEN = SrcRtHndSideData%AngVelEN + DstRtHndSideData%AngVelEB = SrcRtHndSideData%AngVelEB + DstRtHndSideData%AngVelER = SrcRtHndSideData%AngVelER + DstRtHndSideData%AngVelEX = SrcRtHndSideData%AngVelEX + DstRtHndSideData%TeetAngVel = SrcRtHndSideData%TeetAngVel + DstRtHndSideData%AngAccEBt = SrcRtHndSideData%AngAccEBt + DstRtHndSideData%AngAccERt = SrcRtHndSideData%AngAccERt + DstRtHndSideData%AngAccEXt = SrcRtHndSideData%AngAccEXt + if (allocated(SrcRtHndSideData%AngAccEFt)) then + LB(1:2) = lbound(SrcRtHndSideData%AngAccEFt) + UB(1:2) = ubound(SrcRtHndSideData%AngAccEFt) + if (.not. allocated(DstRtHndSideData%AngAccEFt)) then + allocate(DstRtHndSideData%AngAccEFt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngAccEFt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%AngAccEFt = SrcRtHndSideData%AngAccEFt + else if (allocated(DstRtHndSideData%AngAccEFt)) then + deallocate(DstRtHndSideData%AngAccEFt) + end if + if (allocated(SrcRtHndSideData%AngVelEF)) then + LB(1:2) = lbound(SrcRtHndSideData%AngVelEF) + UB(1:2) = ubound(SrcRtHndSideData%AngVelEF) + if (.not. allocated(DstRtHndSideData%AngVelEF)) then + allocate(DstRtHndSideData%AngVelEF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngVelEF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%AngVelEF = SrcRtHndSideData%AngVelEF + else if (allocated(DstRtHndSideData%AngVelEF)) then + deallocate(DstRtHndSideData%AngVelEF) + end if + if (allocated(SrcRtHndSideData%AngVelHM)) then + LB(1:3) = lbound(SrcRtHndSideData%AngVelHM) + UB(1:3) = ubound(SrcRtHndSideData%AngVelHM) + if (.not. allocated(DstRtHndSideData%AngVelHM)) then + allocate(DstRtHndSideData%AngVelHM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngVelHM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%AngVelHM = SrcRtHndSideData%AngVelHM + else if (allocated(DstRtHndSideData%AngVelHM)) then + deallocate(DstRtHndSideData%AngVelHM) + end if + DstRtHndSideData%AngAccEAt = SrcRtHndSideData%AngAccEAt + DstRtHndSideData%AngAccEGt = SrcRtHndSideData%AngAccEGt + DstRtHndSideData%AngAccEHt = SrcRtHndSideData%AngAccEHt + if (allocated(SrcRtHndSideData%AngAccEKt)) then + LB(1:3) = lbound(SrcRtHndSideData%AngAccEKt) + UB(1:3) = ubound(SrcRtHndSideData%AngAccEKt) + if (.not. allocated(DstRtHndSideData%AngAccEKt)) then + allocate(DstRtHndSideData%AngAccEKt(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%AngAccEKt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%AngAccEKt = SrcRtHndSideData%AngAccEKt + else if (allocated(DstRtHndSideData%AngAccEKt)) then + deallocate(DstRtHndSideData%AngAccEKt) + end if + DstRtHndSideData%AngAccENt = SrcRtHndSideData%AngAccENt + DstRtHndSideData%LinAccECt = SrcRtHndSideData%LinAccECt + DstRtHndSideData%LinAccEDt = SrcRtHndSideData%LinAccEDt + DstRtHndSideData%LinAccEIt = SrcRtHndSideData%LinAccEIt + DstRtHndSideData%LinAccEJt = SrcRtHndSideData%LinAccEJt + DstRtHndSideData%LinAccEUt = SrcRtHndSideData%LinAccEUt + DstRtHndSideData%LinAccEYt = SrcRtHndSideData%LinAccEYt + if (allocated(SrcRtHndSideData%LinVelES)) then + LB(1:3) = lbound(SrcRtHndSideData%LinVelES) + UB(1:3) = ubound(SrcRtHndSideData%LinVelES) + if (.not. allocated(DstRtHndSideData%LinVelES)) then + allocate(DstRtHndSideData%LinVelES(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%LinVelES.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%LinVelES = SrcRtHndSideData%LinVelES + else if (allocated(DstRtHndSideData%LinVelES)) then + deallocate(DstRtHndSideData%LinVelES) + end if + DstRtHndSideData%LinVelEQ = SrcRtHndSideData%LinVelEQ + if (allocated(SrcRtHndSideData%LinVelET)) then + LB(1:2) = lbound(SrcRtHndSideData%LinVelET) + UB(1:2) = ubound(SrcRtHndSideData%LinVelET) + if (.not. allocated(DstRtHndSideData%LinVelET)) then + allocate(DstRtHndSideData%LinVelET(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%LinVelET.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%LinVelET = SrcRtHndSideData%LinVelET + else if (allocated(DstRtHndSideData%LinVelET)) then + deallocate(DstRtHndSideData%LinVelET) + end if + if (allocated(SrcRtHndSideData%LinVelESm2)) then + LB(1:1) = lbound(SrcRtHndSideData%LinVelESm2) + UB(1:1) = ubound(SrcRtHndSideData%LinVelESm2) + if (.not. allocated(DstRtHndSideData%LinVelESm2)) then + allocate(DstRtHndSideData%LinVelESm2(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%LinVelESm2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%LinVelESm2 = SrcRtHndSideData%LinVelESm2 + else if (allocated(DstRtHndSideData%LinVelESm2)) then + deallocate(DstRtHndSideData%LinVelESm2) + end if + if (allocated(SrcRtHndSideData%PLinVelEIMU)) then + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEIMU) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEIMU) + if (.not. allocated(DstRtHndSideData%PLinVelEIMU)) then + allocate(DstRtHndSideData%PLinVelEIMU(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEIMU.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PLinVelEIMU = SrcRtHndSideData%PLinVelEIMU + else if (allocated(DstRtHndSideData%PLinVelEIMU)) then + deallocate(DstRtHndSideData%PLinVelEIMU) + end if + if (allocated(SrcRtHndSideData%PLinVelEO)) then + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEO) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEO) + if (.not. allocated(DstRtHndSideData%PLinVelEO)) then + allocate(DstRtHndSideData%PLinVelEO(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEO.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PLinVelEO = SrcRtHndSideData%PLinVelEO + else if (allocated(DstRtHndSideData%PLinVelEO)) then + deallocate(DstRtHndSideData%PLinVelEO) + end if + if (allocated(SrcRtHndSideData%PLinVelES)) then + LB(1:5) = lbound(SrcRtHndSideData%PLinVelES) + UB(1:5) = ubound(SrcRtHndSideData%PLinVelES) + if (.not. allocated(DstRtHndSideData%PLinVelES)) then + allocate(DstRtHndSideData%PLinVelES(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelES.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PLinVelES = SrcRtHndSideData%PLinVelES + else if (allocated(DstRtHndSideData%PLinVelES)) then + deallocate(DstRtHndSideData%PLinVelES) + end if + if (allocated(SrcRtHndSideData%PLinVelET)) then + LB(1:4) = lbound(SrcRtHndSideData%PLinVelET) + UB(1:4) = ubound(SrcRtHndSideData%PLinVelET) + if (.not. allocated(DstRtHndSideData%PLinVelET)) then + allocate(DstRtHndSideData%PLinVelET(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelET.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PLinVelET = SrcRtHndSideData%PLinVelET + else if (allocated(DstRtHndSideData%PLinVelET)) then + deallocate(DstRtHndSideData%PLinVelET) + end if + if (allocated(SrcRtHndSideData%PLinVelEZ)) then + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEZ) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEZ) + if (.not. allocated(DstRtHndSideData%PLinVelEZ)) then + allocate(DstRtHndSideData%PLinVelEZ(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEZ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PLinVelEZ = SrcRtHndSideData%PLinVelEZ + else if (allocated(DstRtHndSideData%PLinVelEZ)) then + deallocate(DstRtHndSideData%PLinVelEZ) + end if + if (allocated(SrcRtHndSideData%PLinVelEC)) then + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEC) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEC) + if (.not. allocated(DstRtHndSideData%PLinVelEC)) then + allocate(DstRtHndSideData%PLinVelEC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PLinVelEC = SrcRtHndSideData%PLinVelEC + else if (allocated(DstRtHndSideData%PLinVelEC)) then + deallocate(DstRtHndSideData%PLinVelEC) + end if + if (allocated(SrcRtHndSideData%PLinVelED)) then + LB(1:3) = lbound(SrcRtHndSideData%PLinVelED) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelED) + if (.not. allocated(DstRtHndSideData%PLinVelED)) then + allocate(DstRtHndSideData%PLinVelED(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelED.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PLinVelED = SrcRtHndSideData%PLinVelED + else if (allocated(DstRtHndSideData%PLinVelED)) then + deallocate(DstRtHndSideData%PLinVelED) + end if + if (allocated(SrcRtHndSideData%PLinVelEI)) then + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEI) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEI) + if (.not. allocated(DstRtHndSideData%PLinVelEI)) then + allocate(DstRtHndSideData%PLinVelEI(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEI.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PLinVelEI = SrcRtHndSideData%PLinVelEI + else if (allocated(DstRtHndSideData%PLinVelEI)) then + deallocate(DstRtHndSideData%PLinVelEI) + end if + if (allocated(SrcRtHndSideData%PLinVelEJ)) then + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEJ) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEJ) + if (.not. allocated(DstRtHndSideData%PLinVelEJ)) then + allocate(DstRtHndSideData%PLinVelEJ(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEJ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PLinVelEJ = SrcRtHndSideData%PLinVelEJ + else if (allocated(DstRtHndSideData%PLinVelEJ)) then + deallocate(DstRtHndSideData%PLinVelEJ) + end if + if (allocated(SrcRtHndSideData%PLinVelEP)) then + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEP) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEP) + if (.not. allocated(DstRtHndSideData%PLinVelEP)) then + allocate(DstRtHndSideData%PLinVelEP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PLinVelEP = SrcRtHndSideData%PLinVelEP + else if (allocated(DstRtHndSideData%PLinVelEP)) then + deallocate(DstRtHndSideData%PLinVelEP) + end if + if (allocated(SrcRtHndSideData%PLinVelEQ)) then + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEQ) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEQ) + if (.not. allocated(DstRtHndSideData%PLinVelEQ)) then + allocate(DstRtHndSideData%PLinVelEQ(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEQ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PLinVelEQ = SrcRtHndSideData%PLinVelEQ + else if (allocated(DstRtHndSideData%PLinVelEQ)) then + deallocate(DstRtHndSideData%PLinVelEQ) + end if + if (allocated(SrcRtHndSideData%PLinVelEU)) then + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEU) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEU) + if (.not. allocated(DstRtHndSideData%PLinVelEU)) then + allocate(DstRtHndSideData%PLinVelEU(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEU.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PLinVelEU = SrcRtHndSideData%PLinVelEU + else if (allocated(DstRtHndSideData%PLinVelEU)) then + deallocate(DstRtHndSideData%PLinVelEU) + end if + if (allocated(SrcRtHndSideData%PLinVelEV)) then + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEV) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEV) + if (.not. allocated(DstRtHndSideData%PLinVelEV)) then + allocate(DstRtHndSideData%PLinVelEV(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEV.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PLinVelEV = SrcRtHndSideData%PLinVelEV + else if (allocated(DstRtHndSideData%PLinVelEV)) then + deallocate(DstRtHndSideData%PLinVelEV) + end if + if (allocated(SrcRtHndSideData%PLinVelEW)) then + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEW) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEW) + if (.not. allocated(DstRtHndSideData%PLinVelEW)) then + allocate(DstRtHndSideData%PLinVelEW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PLinVelEW = SrcRtHndSideData%PLinVelEW + else if (allocated(DstRtHndSideData%PLinVelEW)) then + deallocate(DstRtHndSideData%PLinVelEW) + end if + if (allocated(SrcRtHndSideData%PLinVelEY)) then + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEY) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEY) + if (.not. allocated(DstRtHndSideData%PLinVelEY)) then + allocate(DstRtHndSideData%PLinVelEY(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PLinVelEY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PLinVelEY = SrcRtHndSideData%PLinVelEY + else if (allocated(DstRtHndSideData%PLinVelEY)) then + deallocate(DstRtHndSideData%PLinVelEY) + end if + DstRtHndSideData%LinAccEIMUt = SrcRtHndSideData%LinAccEIMUt + DstRtHndSideData%LinAccEOt = SrcRtHndSideData%LinAccEOt + if (allocated(SrcRtHndSideData%LinAccESt)) then + LB(1:3) = lbound(SrcRtHndSideData%LinAccESt) + UB(1:3) = ubound(SrcRtHndSideData%LinAccESt) + if (.not. allocated(DstRtHndSideData%LinAccESt)) then + allocate(DstRtHndSideData%LinAccESt(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%LinAccESt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%LinAccESt = SrcRtHndSideData%LinAccESt + else if (allocated(DstRtHndSideData%LinAccESt)) then + deallocate(DstRtHndSideData%LinAccESt) + end if + if (allocated(SrcRtHndSideData%LinAccETt)) then + LB(1:2) = lbound(SrcRtHndSideData%LinAccETt) + UB(1:2) = ubound(SrcRtHndSideData%LinAccETt) + if (.not. allocated(DstRtHndSideData%LinAccETt)) then + allocate(DstRtHndSideData%LinAccETt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%LinAccETt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%LinAccETt = SrcRtHndSideData%LinAccETt + else if (allocated(DstRtHndSideData%LinAccETt)) then + deallocate(DstRtHndSideData%LinAccETt) + end if + DstRtHndSideData%LinAccEZt = SrcRtHndSideData%LinAccEZt + DstRtHndSideData%LinVelEIMU = SrcRtHndSideData%LinVelEIMU + DstRtHndSideData%LinVelEZ = SrcRtHndSideData%LinVelEZ + DstRtHndSideData%LinVelEO = SrcRtHndSideData%LinVelEO + DstRtHndSideData%LinVelEJ = SrcRtHndSideData%LinVelEJ + DstRtHndSideData%FrcONcRtt = SrcRtHndSideData%FrcONcRtt + DstRtHndSideData%FrcPRott = SrcRtHndSideData%FrcPRott + if (allocated(SrcRtHndSideData%FrcS0Bt)) then + LB(1:2) = lbound(SrcRtHndSideData%FrcS0Bt) + UB(1:2) = ubound(SrcRtHndSideData%FrcS0Bt) + if (.not. allocated(DstRtHndSideData%FrcS0Bt)) then + allocate(DstRtHndSideData%FrcS0Bt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%FrcS0Bt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%FrcS0Bt = SrcRtHndSideData%FrcS0Bt + else if (allocated(DstRtHndSideData%FrcS0Bt)) then + deallocate(DstRtHndSideData%FrcS0Bt) + end if + DstRtHndSideData%FrcT0Trbt = SrcRtHndSideData%FrcT0Trbt + if (allocated(SrcRtHndSideData%FSAero)) then + LB(1:3) = lbound(SrcRtHndSideData%FSAero) + UB(1:3) = ubound(SrcRtHndSideData%FSAero) + if (.not. allocated(DstRtHndSideData%FSAero)) then + allocate(DstRtHndSideData%FSAero(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%FSAero.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%FSAero = SrcRtHndSideData%FSAero + else if (allocated(DstRtHndSideData%FSAero)) then + deallocate(DstRtHndSideData%FSAero) + end if + if (allocated(SrcRtHndSideData%FSTipDrag)) then + LB(1:2) = lbound(SrcRtHndSideData%FSTipDrag) + UB(1:2) = ubound(SrcRtHndSideData%FSTipDrag) + if (.not. allocated(DstRtHndSideData%FSTipDrag)) then + allocate(DstRtHndSideData%FSTipDrag(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%FSTipDrag.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%FSTipDrag = SrcRtHndSideData%FSTipDrag + else if (allocated(DstRtHndSideData%FSTipDrag)) then + deallocate(DstRtHndSideData%FSTipDrag) + end if + if (allocated(SrcRtHndSideData%FTHydrot)) then + LB(1:2) = lbound(SrcRtHndSideData%FTHydrot) + UB(1:2) = ubound(SrcRtHndSideData%FTHydrot) + if (.not. allocated(DstRtHndSideData%FTHydrot)) then + allocate(DstRtHndSideData%FTHydrot(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%FTHydrot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%FTHydrot = SrcRtHndSideData%FTHydrot + else if (allocated(DstRtHndSideData%FTHydrot)) then + deallocate(DstRtHndSideData%FTHydrot) + end if + DstRtHndSideData%FZHydrot = SrcRtHndSideData%FZHydrot + if (allocated(SrcRtHndSideData%MFHydrot)) then + LB(1:2) = lbound(SrcRtHndSideData%MFHydrot) + UB(1:2) = ubound(SrcRtHndSideData%MFHydrot) + if (.not. allocated(DstRtHndSideData%MFHydrot)) then + allocate(DstRtHndSideData%MFHydrot(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%MFHydrot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%MFHydrot = SrcRtHndSideData%MFHydrot + else if (allocated(DstRtHndSideData%MFHydrot)) then + deallocate(DstRtHndSideData%MFHydrot) + end if + DstRtHndSideData%MomBNcRtt = SrcRtHndSideData%MomBNcRtt + if (allocated(SrcRtHndSideData%MomH0Bt)) then + LB(1:2) = lbound(SrcRtHndSideData%MomH0Bt) + UB(1:2) = ubound(SrcRtHndSideData%MomH0Bt) + if (.not. allocated(DstRtHndSideData%MomH0Bt)) then + allocate(DstRtHndSideData%MomH0Bt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%MomH0Bt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%MomH0Bt = SrcRtHndSideData%MomH0Bt + else if (allocated(DstRtHndSideData%MomH0Bt)) then + deallocate(DstRtHndSideData%MomH0Bt) + end if + DstRtHndSideData%MomLPRott = SrcRtHndSideData%MomLPRott + DstRtHndSideData%MomNGnRtt = SrcRtHndSideData%MomNGnRtt + DstRtHndSideData%MomNTailt = SrcRtHndSideData%MomNTailt + DstRtHndSideData%MomX0Trbt = SrcRtHndSideData%MomX0Trbt + if (allocated(SrcRtHndSideData%MMAero)) then + LB(1:3) = lbound(SrcRtHndSideData%MMAero) + UB(1:3) = ubound(SrcRtHndSideData%MMAero) + if (.not. allocated(DstRtHndSideData%MMAero)) then + allocate(DstRtHndSideData%MMAero(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%MMAero.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%MMAero = SrcRtHndSideData%MMAero + else if (allocated(DstRtHndSideData%MMAero)) then + deallocate(DstRtHndSideData%MMAero) + end if + DstRtHndSideData%MXHydrot = SrcRtHndSideData%MXHydrot + if (allocated(SrcRtHndSideData%PFrcONcRt)) then + LB(1:2) = lbound(SrcRtHndSideData%PFrcONcRt) + UB(1:2) = ubound(SrcRtHndSideData%PFrcONcRt) + if (.not. allocated(DstRtHndSideData%PFrcONcRt)) then + allocate(DstRtHndSideData%PFrcONcRt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFrcONcRt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PFrcONcRt = SrcRtHndSideData%PFrcONcRt + else if (allocated(DstRtHndSideData%PFrcONcRt)) then + deallocate(DstRtHndSideData%PFrcONcRt) + end if + if (allocated(SrcRtHndSideData%PFrcPRot)) then + LB(1:2) = lbound(SrcRtHndSideData%PFrcPRot) + UB(1:2) = ubound(SrcRtHndSideData%PFrcPRot) + if (.not. allocated(DstRtHndSideData%PFrcPRot)) then + allocate(DstRtHndSideData%PFrcPRot(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFrcPRot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PFrcPRot = SrcRtHndSideData%PFrcPRot + else if (allocated(DstRtHndSideData%PFrcPRot)) then + deallocate(DstRtHndSideData%PFrcPRot) + end if + if (allocated(SrcRtHndSideData%PFrcS0B)) then + LB(1:3) = lbound(SrcRtHndSideData%PFrcS0B) + UB(1:3) = ubound(SrcRtHndSideData%PFrcS0B) + if (.not. allocated(DstRtHndSideData%PFrcS0B)) then + allocate(DstRtHndSideData%PFrcS0B(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFrcS0B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PFrcS0B = SrcRtHndSideData%PFrcS0B + else if (allocated(DstRtHndSideData%PFrcS0B)) then + deallocate(DstRtHndSideData%PFrcS0B) + end if + if (allocated(SrcRtHndSideData%PFrcT0Trb)) then + LB(1:2) = lbound(SrcRtHndSideData%PFrcT0Trb) + UB(1:2) = ubound(SrcRtHndSideData%PFrcT0Trb) + if (.not. allocated(DstRtHndSideData%PFrcT0Trb)) then + allocate(DstRtHndSideData%PFrcT0Trb(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFrcT0Trb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PFrcT0Trb = SrcRtHndSideData%PFrcT0Trb + else if (allocated(DstRtHndSideData%PFrcT0Trb)) then + deallocate(DstRtHndSideData%PFrcT0Trb) + end if + if (allocated(SrcRtHndSideData%PFTHydro)) then + LB(1:3) = lbound(SrcRtHndSideData%PFTHydro) + UB(1:3) = ubound(SrcRtHndSideData%PFTHydro) + if (.not. allocated(DstRtHndSideData%PFTHydro)) then + allocate(DstRtHndSideData%PFTHydro(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFTHydro.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PFTHydro = SrcRtHndSideData%PFTHydro + else if (allocated(DstRtHndSideData%PFTHydro)) then + deallocate(DstRtHndSideData%PFTHydro) + end if + DstRtHndSideData%PFZHydro = SrcRtHndSideData%PFZHydro + if (allocated(SrcRtHndSideData%PMFHydro)) then + LB(1:3) = lbound(SrcRtHndSideData%PMFHydro) + UB(1:3) = ubound(SrcRtHndSideData%PMFHydro) + if (.not. allocated(DstRtHndSideData%PMFHydro)) then + allocate(DstRtHndSideData%PMFHydro(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMFHydro.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PMFHydro = SrcRtHndSideData%PMFHydro + else if (allocated(DstRtHndSideData%PMFHydro)) then + deallocate(DstRtHndSideData%PMFHydro) + end if + if (allocated(SrcRtHndSideData%PMomBNcRt)) then + LB(1:2) = lbound(SrcRtHndSideData%PMomBNcRt) + UB(1:2) = ubound(SrcRtHndSideData%PMomBNcRt) + if (.not. allocated(DstRtHndSideData%PMomBNcRt)) then + allocate(DstRtHndSideData%PMomBNcRt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMomBNcRt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PMomBNcRt = SrcRtHndSideData%PMomBNcRt + else if (allocated(DstRtHndSideData%PMomBNcRt)) then + deallocate(DstRtHndSideData%PMomBNcRt) + end if + if (allocated(SrcRtHndSideData%PMomH0B)) then + LB(1:3) = lbound(SrcRtHndSideData%PMomH0B) + UB(1:3) = ubound(SrcRtHndSideData%PMomH0B) + if (.not. allocated(DstRtHndSideData%PMomH0B)) then + allocate(DstRtHndSideData%PMomH0B(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMomH0B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PMomH0B = SrcRtHndSideData%PMomH0B + else if (allocated(DstRtHndSideData%PMomH0B)) then + deallocate(DstRtHndSideData%PMomH0B) + end if + if (allocated(SrcRtHndSideData%PMomLPRot)) then + LB(1:2) = lbound(SrcRtHndSideData%PMomLPRot) + UB(1:2) = ubound(SrcRtHndSideData%PMomLPRot) + if (.not. allocated(DstRtHndSideData%PMomLPRot)) then + allocate(DstRtHndSideData%PMomLPRot(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMomLPRot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PMomLPRot = SrcRtHndSideData%PMomLPRot + else if (allocated(DstRtHndSideData%PMomLPRot)) then + deallocate(DstRtHndSideData%PMomLPRot) + end if + if (allocated(SrcRtHndSideData%PMomNGnRt)) then + LB(1:2) = lbound(SrcRtHndSideData%PMomNGnRt) + UB(1:2) = ubound(SrcRtHndSideData%PMomNGnRt) + if (.not. allocated(DstRtHndSideData%PMomNGnRt)) then + allocate(DstRtHndSideData%PMomNGnRt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMomNGnRt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PMomNGnRt = SrcRtHndSideData%PMomNGnRt + else if (allocated(DstRtHndSideData%PMomNGnRt)) then + deallocate(DstRtHndSideData%PMomNGnRt) + end if + if (allocated(SrcRtHndSideData%PMomNTail)) then + LB(1:2) = lbound(SrcRtHndSideData%PMomNTail) + UB(1:2) = ubound(SrcRtHndSideData%PMomNTail) + if (.not. allocated(DstRtHndSideData%PMomNTail)) then + allocate(DstRtHndSideData%PMomNTail(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMomNTail.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PMomNTail = SrcRtHndSideData%PMomNTail + else if (allocated(DstRtHndSideData%PMomNTail)) then + deallocate(DstRtHndSideData%PMomNTail) + end if + if (allocated(SrcRtHndSideData%PMomX0Trb)) then + LB(1:2) = lbound(SrcRtHndSideData%PMomX0Trb) + UB(1:2) = ubound(SrcRtHndSideData%PMomX0Trb) + if (.not. allocated(DstRtHndSideData%PMomX0Trb)) then + allocate(DstRtHndSideData%PMomX0Trb(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMomX0Trb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PMomX0Trb = SrcRtHndSideData%PMomX0Trb + else if (allocated(DstRtHndSideData%PMomX0Trb)) then + deallocate(DstRtHndSideData%PMomX0Trb) + end if + DstRtHndSideData%PMXHydro = SrcRtHndSideData%PMXHydro + DstRtHndSideData%TeetAng = SrcRtHndSideData%TeetAng + DstRtHndSideData%FrcVGnRtt = SrcRtHndSideData%FrcVGnRtt + DstRtHndSideData%FrcWTailt = SrcRtHndSideData%FrcWTailt + DstRtHndSideData%FrcZAllt = SrcRtHndSideData%FrcZAllt + DstRtHndSideData%MomXAllt = SrcRtHndSideData%MomXAllt + if (allocated(SrcRtHndSideData%PFrcVGnRt)) then + LB(1:2) = lbound(SrcRtHndSideData%PFrcVGnRt) + UB(1:2) = ubound(SrcRtHndSideData%PFrcVGnRt) + if (.not. allocated(DstRtHndSideData%PFrcVGnRt)) then + allocate(DstRtHndSideData%PFrcVGnRt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFrcVGnRt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PFrcVGnRt = SrcRtHndSideData%PFrcVGnRt + else if (allocated(DstRtHndSideData%PFrcVGnRt)) then + deallocate(DstRtHndSideData%PFrcVGnRt) + end if + if (allocated(SrcRtHndSideData%PFrcWTail)) then + LB(1:2) = lbound(SrcRtHndSideData%PFrcWTail) + UB(1:2) = ubound(SrcRtHndSideData%PFrcWTail) + if (.not. allocated(DstRtHndSideData%PFrcWTail)) then + allocate(DstRtHndSideData%PFrcWTail(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFrcWTail.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PFrcWTail = SrcRtHndSideData%PFrcWTail + else if (allocated(DstRtHndSideData%PFrcWTail)) then + deallocate(DstRtHndSideData%PFrcWTail) + end if + if (allocated(SrcRtHndSideData%PFrcZAll)) then + LB(1:2) = lbound(SrcRtHndSideData%PFrcZAll) + UB(1:2) = ubound(SrcRtHndSideData%PFrcZAll) + if (.not. allocated(DstRtHndSideData%PFrcZAll)) then + allocate(DstRtHndSideData%PFrcZAll(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PFrcZAll.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PFrcZAll = SrcRtHndSideData%PFrcZAll + else if (allocated(DstRtHndSideData%PFrcZAll)) then + deallocate(DstRtHndSideData%PFrcZAll) + end if + if (allocated(SrcRtHndSideData%PMomXAll)) then + LB(1:2) = lbound(SrcRtHndSideData%PMomXAll) + UB(1:2) = ubound(SrcRtHndSideData%PMomXAll) + if (.not. allocated(DstRtHndSideData%PMomXAll)) then + allocate(DstRtHndSideData%PMomXAll(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%PMomXAll.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%PMomXAll = SrcRtHndSideData%PMomXAll + else if (allocated(DstRtHndSideData%PMomXAll)) then + deallocate(DstRtHndSideData%PMomXAll) + end if + DstRtHndSideData%TeetMom = SrcRtHndSideData%TeetMom + DstRtHndSideData%TFrlMom = SrcRtHndSideData%TFrlMom + DstRtHndSideData%RFrlMom = SrcRtHndSideData%RFrlMom + DstRtHndSideData%GBoxEffFac = SrcRtHndSideData%GBoxEffFac + if (allocated(SrcRtHndSideData%rSAerCen)) then + LB(1:3) = lbound(SrcRtHndSideData%rSAerCen) + UB(1:3) = ubound(SrcRtHndSideData%rSAerCen) + if (.not. allocated(DstRtHndSideData%rSAerCen)) then + allocate(DstRtHndSideData%rSAerCen(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRtHndSideData%rSAerCen.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRtHndSideData%rSAerCen = SrcRtHndSideData%rSAerCen + else if (allocated(DstRtHndSideData%rSAerCen)) then + deallocate(DstRtHndSideData%rSAerCen) + end if +end subroutine +subroutine ED_DestroyRtHndSide(RtHndSideData, ErrStat, ErrMsg) + type(ED_RtHndSide), intent(inout) :: RtHndSideData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ED_DestroyRtHndSide' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(RtHndSideData%rQS)) then + deallocate(RtHndSideData%rQS) + end if + if (allocated(RtHndSideData%rS)) then + deallocate(RtHndSideData%rS) + end if + if (allocated(RtHndSideData%rS0S)) then + deallocate(RtHndSideData%rS0S) + end if + if (allocated(RtHndSideData%rT)) then + deallocate(RtHndSideData%rT) + end if + if (allocated(RtHndSideData%rT0T)) then + deallocate(RtHndSideData%rT0T) + end if + if (allocated(RtHndSideData%rZT)) then + deallocate(RtHndSideData%rZT) + end if + if (allocated(RtHndSideData%rPS0)) then + deallocate(RtHndSideData%rPS0) + end if + if (allocated(RtHndSideData%AngPosEF)) then + deallocate(RtHndSideData%AngPosEF) + end if + if (allocated(RtHndSideData%AngPosXF)) then + deallocate(RtHndSideData%AngPosXF) + end if + if (allocated(RtHndSideData%AngPosHM)) then + deallocate(RtHndSideData%AngPosHM) + end if + if (allocated(RtHndSideData%PAngVelEA)) then + deallocate(RtHndSideData%PAngVelEA) + end if + if (allocated(RtHndSideData%PAngVelEF)) then + deallocate(RtHndSideData%PAngVelEF) + end if + if (allocated(RtHndSideData%PAngVelEG)) then + deallocate(RtHndSideData%PAngVelEG) + end if + if (allocated(RtHndSideData%PAngVelEH)) then + deallocate(RtHndSideData%PAngVelEH) + end if + if (allocated(RtHndSideData%PAngVelEL)) then + deallocate(RtHndSideData%PAngVelEL) + end if + if (allocated(RtHndSideData%PAngVelEM)) then + deallocate(RtHndSideData%PAngVelEM) + end if + if (allocated(RtHndSideData%AngVelEM)) then + deallocate(RtHndSideData%AngVelEM) + end if + if (allocated(RtHndSideData%PAngVelEN)) then + deallocate(RtHndSideData%PAngVelEN) + end if + if (allocated(RtHndSideData%PAngVelEB)) then + deallocate(RtHndSideData%PAngVelEB) + end if + if (allocated(RtHndSideData%PAngVelER)) then + deallocate(RtHndSideData%PAngVelER) + end if + if (allocated(RtHndSideData%PAngVelEX)) then + deallocate(RtHndSideData%PAngVelEX) + end if + if (allocated(RtHndSideData%AngAccEFt)) then + deallocate(RtHndSideData%AngAccEFt) + end if + if (allocated(RtHndSideData%AngVelEF)) then + deallocate(RtHndSideData%AngVelEF) + end if + if (allocated(RtHndSideData%AngVelHM)) then + deallocate(RtHndSideData%AngVelHM) + end if + if (allocated(RtHndSideData%AngAccEKt)) then + deallocate(RtHndSideData%AngAccEKt) + end if + if (allocated(RtHndSideData%LinVelES)) then + deallocate(RtHndSideData%LinVelES) + end if + if (allocated(RtHndSideData%LinVelET)) then + deallocate(RtHndSideData%LinVelET) + end if + if (allocated(RtHndSideData%LinVelESm2)) then + deallocate(RtHndSideData%LinVelESm2) + end if + if (allocated(RtHndSideData%PLinVelEIMU)) then + deallocate(RtHndSideData%PLinVelEIMU) + end if + if (allocated(RtHndSideData%PLinVelEO)) then + deallocate(RtHndSideData%PLinVelEO) + end if + if (allocated(RtHndSideData%PLinVelES)) then + deallocate(RtHndSideData%PLinVelES) + end if + if (allocated(RtHndSideData%PLinVelET)) then + deallocate(RtHndSideData%PLinVelET) + end if + if (allocated(RtHndSideData%PLinVelEZ)) then + deallocate(RtHndSideData%PLinVelEZ) + end if + if (allocated(RtHndSideData%PLinVelEC)) then + deallocate(RtHndSideData%PLinVelEC) + end if + if (allocated(RtHndSideData%PLinVelED)) then + deallocate(RtHndSideData%PLinVelED) + end if + if (allocated(RtHndSideData%PLinVelEI)) then + deallocate(RtHndSideData%PLinVelEI) + end if + if (allocated(RtHndSideData%PLinVelEJ)) then + deallocate(RtHndSideData%PLinVelEJ) + end if + if (allocated(RtHndSideData%PLinVelEP)) then + deallocate(RtHndSideData%PLinVelEP) + end if + if (allocated(RtHndSideData%PLinVelEQ)) then + deallocate(RtHndSideData%PLinVelEQ) + end if + if (allocated(RtHndSideData%PLinVelEU)) then + deallocate(RtHndSideData%PLinVelEU) + end if + if (allocated(RtHndSideData%PLinVelEV)) then + deallocate(RtHndSideData%PLinVelEV) + end if + if (allocated(RtHndSideData%PLinVelEW)) then + deallocate(RtHndSideData%PLinVelEW) + end if + if (allocated(RtHndSideData%PLinVelEY)) then + deallocate(RtHndSideData%PLinVelEY) + end if + if (allocated(RtHndSideData%LinAccESt)) then + deallocate(RtHndSideData%LinAccESt) + end if + if (allocated(RtHndSideData%LinAccETt)) then + deallocate(RtHndSideData%LinAccETt) + end if + if (allocated(RtHndSideData%FrcS0Bt)) then + deallocate(RtHndSideData%FrcS0Bt) + end if + if (allocated(RtHndSideData%FSAero)) then + deallocate(RtHndSideData%FSAero) + end if + if (allocated(RtHndSideData%FSTipDrag)) then + deallocate(RtHndSideData%FSTipDrag) + end if + if (allocated(RtHndSideData%FTHydrot)) then + deallocate(RtHndSideData%FTHydrot) + end if + if (allocated(RtHndSideData%MFHydrot)) then + deallocate(RtHndSideData%MFHydrot) + end if + if (allocated(RtHndSideData%MomH0Bt)) then + deallocate(RtHndSideData%MomH0Bt) + end if + if (allocated(RtHndSideData%MMAero)) then + deallocate(RtHndSideData%MMAero) + end if + if (allocated(RtHndSideData%PFrcONcRt)) then + deallocate(RtHndSideData%PFrcONcRt) + end if + if (allocated(RtHndSideData%PFrcPRot)) then + deallocate(RtHndSideData%PFrcPRot) + end if + if (allocated(RtHndSideData%PFrcS0B)) then + deallocate(RtHndSideData%PFrcS0B) + end if + if (allocated(RtHndSideData%PFrcT0Trb)) then + deallocate(RtHndSideData%PFrcT0Trb) + end if + if (allocated(RtHndSideData%PFTHydro)) then + deallocate(RtHndSideData%PFTHydro) + end if + if (allocated(RtHndSideData%PMFHydro)) then + deallocate(RtHndSideData%PMFHydro) + end if + if (allocated(RtHndSideData%PMomBNcRt)) then + deallocate(RtHndSideData%PMomBNcRt) + end if + if (allocated(RtHndSideData%PMomH0B)) then + deallocate(RtHndSideData%PMomH0B) + end if + if (allocated(RtHndSideData%PMomLPRot)) then + deallocate(RtHndSideData%PMomLPRot) + end if + if (allocated(RtHndSideData%PMomNGnRt)) then + deallocate(RtHndSideData%PMomNGnRt) + end if + if (allocated(RtHndSideData%PMomNTail)) then + deallocate(RtHndSideData%PMomNTail) + end if + if (allocated(RtHndSideData%PMomX0Trb)) then + deallocate(RtHndSideData%PMomX0Trb) + end if + if (allocated(RtHndSideData%PFrcVGnRt)) then + deallocate(RtHndSideData%PFrcVGnRt) + end if + if (allocated(RtHndSideData%PFrcWTail)) then + deallocate(RtHndSideData%PFrcWTail) + end if + if (allocated(RtHndSideData%PFrcZAll)) then + deallocate(RtHndSideData%PFrcZAll) + end if + if (allocated(RtHndSideData%PMomXAll)) then + deallocate(RtHndSideData%PMomXAll) + end if + if (allocated(RtHndSideData%rSAerCen)) then + deallocate(RtHndSideData%rSAerCen) + end if +end subroutine subroutine ED_PackRtHndSide(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ED_RtHndSide), intent(in) :: InData character(*), parameter :: RoutineName = 'ED_PackRtHndSide' if (Buf%ErrStat >= AbortErrLev) return - ! rO call RegPack(Buf, InData%rO) if (RegCheckErr(Buf, RoutineName)) return - ! rQS call RegPack(Buf, allocated(InData%rQS)) if (allocated(InData%rQS)) then call RegPackBounds(Buf, 3, lbound(InData%rQS), ubound(InData%rQS)) call RegPack(Buf, InData%rQS) end if if (RegCheckErr(Buf, RoutineName)) return - ! rS call RegPack(Buf, allocated(InData%rS)) if (allocated(InData%rS)) then call RegPackBounds(Buf, 3, lbound(InData%rS), ubound(InData%rS)) call RegPack(Buf, InData%rS) end if if (RegCheckErr(Buf, RoutineName)) return - ! rS0S call RegPack(Buf, allocated(InData%rS0S)) if (allocated(InData%rS0S)) then call RegPackBounds(Buf, 3, lbound(InData%rS0S), ubound(InData%rS0S)) call RegPack(Buf, InData%rS0S) end if if (RegCheckErr(Buf, RoutineName)) return - ! rT call RegPack(Buf, allocated(InData%rT)) if (allocated(InData%rT)) then call RegPackBounds(Buf, 2, lbound(InData%rT), ubound(InData%rT)) call RegPack(Buf, InData%rT) end if if (RegCheckErr(Buf, RoutineName)) return - ! rT0O call RegPack(Buf, InData%rT0O) if (RegCheckErr(Buf, RoutineName)) return - ! rT0T call RegPack(Buf, allocated(InData%rT0T)) if (allocated(InData%rT0T)) then call RegPackBounds(Buf, 2, lbound(InData%rT0T), ubound(InData%rT0T)) call RegPack(Buf, InData%rT0T) end if if (RegCheckErr(Buf, RoutineName)) return - ! rZ call RegPack(Buf, InData%rZ) if (RegCheckErr(Buf, RoutineName)) return - ! rZO call RegPack(Buf, InData%rZO) if (RegCheckErr(Buf, RoutineName)) return - ! rZT call RegPack(Buf, allocated(InData%rZT)) if (allocated(InData%rZT)) then call RegPackBounds(Buf, 2, lbound(InData%rZT), ubound(InData%rZT)) call RegPack(Buf, InData%rZT) end if if (RegCheckErr(Buf, RoutineName)) return - ! rPQ call RegPack(Buf, InData%rPQ) if (RegCheckErr(Buf, RoutineName)) return - ! rP call RegPack(Buf, InData%rP) if (RegCheckErr(Buf, RoutineName)) return - ! rV call RegPack(Buf, InData%rV) if (RegCheckErr(Buf, RoutineName)) return - ! rJ call RegPack(Buf, InData%rJ) if (RegCheckErr(Buf, RoutineName)) return - ! rZY call RegPack(Buf, InData%rZY) if (RegCheckErr(Buf, RoutineName)) return - ! rOU call RegPack(Buf, InData%rOU) if (RegCheckErr(Buf, RoutineName)) return - ! rOV call RegPack(Buf, InData%rOV) if (RegCheckErr(Buf, RoutineName)) return - ! rVD call RegPack(Buf, InData%rVD) if (RegCheckErr(Buf, RoutineName)) return - ! rOW call RegPack(Buf, InData%rOW) if (RegCheckErr(Buf, RoutineName)) return - ! rPC call RegPack(Buf, InData%rPC) if (RegCheckErr(Buf, RoutineName)) return - ! rPS0 call RegPack(Buf, allocated(InData%rPS0)) if (allocated(InData%rPS0)) then call RegPackBounds(Buf, 2, lbound(InData%rPS0), ubound(InData%rPS0)) call RegPack(Buf, InData%rPS0) end if if (RegCheckErr(Buf, RoutineName)) return - ! rQ call RegPack(Buf, InData%rQ) if (RegCheckErr(Buf, RoutineName)) return - ! rQC call RegPack(Buf, InData%rQC) if (RegCheckErr(Buf, RoutineName)) return - ! rVIMU call RegPack(Buf, InData%rVIMU) if (RegCheckErr(Buf, RoutineName)) return - ! rVP call RegPack(Buf, InData%rVP) if (RegCheckErr(Buf, RoutineName)) return - ! rWI call RegPack(Buf, InData%rWI) if (RegCheckErr(Buf, RoutineName)) return - ! rWJ call RegPack(Buf, InData%rWJ) if (RegCheckErr(Buf, RoutineName)) return - ! rZT0 call RegPack(Buf, InData%rZT0) if (RegCheckErr(Buf, RoutineName)) return - ! AngPosEF call RegPack(Buf, allocated(InData%AngPosEF)) if (allocated(InData%AngPosEF)) then call RegPackBounds(Buf, 2, lbound(InData%AngPosEF), ubound(InData%AngPosEF)) call RegPack(Buf, InData%AngPosEF) end if if (RegCheckErr(Buf, RoutineName)) return - ! AngPosXF call RegPack(Buf, allocated(InData%AngPosXF)) if (allocated(InData%AngPosXF)) then call RegPackBounds(Buf, 2, lbound(InData%AngPosXF), ubound(InData%AngPosXF)) call RegPack(Buf, InData%AngPosXF) end if if (RegCheckErr(Buf, RoutineName)) return - ! AngPosHM call RegPack(Buf, allocated(InData%AngPosHM)) if (allocated(InData%AngPosHM)) then call RegPackBounds(Buf, 3, lbound(InData%AngPosHM), ubound(InData%AngPosHM)) call RegPack(Buf, InData%AngPosHM) end if if (RegCheckErr(Buf, RoutineName)) return - ! AngPosXB call RegPack(Buf, InData%AngPosXB) if (RegCheckErr(Buf, RoutineName)) return - ! AngPosEX call RegPack(Buf, InData%AngPosEX) if (RegCheckErr(Buf, RoutineName)) return - ! PAngVelEA call RegPack(Buf, allocated(InData%PAngVelEA)) if (allocated(InData%PAngVelEA)) then call RegPackBounds(Buf, 3, lbound(InData%PAngVelEA), ubound(InData%PAngVelEA)) call RegPack(Buf, InData%PAngVelEA) end if if (RegCheckErr(Buf, RoutineName)) return - ! PAngVelEF call RegPack(Buf, allocated(InData%PAngVelEF)) if (allocated(InData%PAngVelEF)) then call RegPackBounds(Buf, 4, lbound(InData%PAngVelEF), ubound(InData%PAngVelEF)) call RegPack(Buf, InData%PAngVelEF) end if if (RegCheckErr(Buf, RoutineName)) return - ! PAngVelEG call RegPack(Buf, allocated(InData%PAngVelEG)) if (allocated(InData%PAngVelEG)) then call RegPackBounds(Buf, 3, lbound(InData%PAngVelEG), ubound(InData%PAngVelEG)) call RegPack(Buf, InData%PAngVelEG) end if if (RegCheckErr(Buf, RoutineName)) return - ! PAngVelEH call RegPack(Buf, allocated(InData%PAngVelEH)) if (allocated(InData%PAngVelEH)) then call RegPackBounds(Buf, 3, lbound(InData%PAngVelEH), ubound(InData%PAngVelEH)) call RegPack(Buf, InData%PAngVelEH) end if if (RegCheckErr(Buf, RoutineName)) return - ! PAngVelEL call RegPack(Buf, allocated(InData%PAngVelEL)) if (allocated(InData%PAngVelEL)) then call RegPackBounds(Buf, 3, lbound(InData%PAngVelEL), ubound(InData%PAngVelEL)) call RegPack(Buf, InData%PAngVelEL) end if if (RegCheckErr(Buf, RoutineName)) return - ! PAngVelEM call RegPack(Buf, allocated(InData%PAngVelEM)) if (allocated(InData%PAngVelEM)) then call RegPackBounds(Buf, 5, lbound(InData%PAngVelEM), ubound(InData%PAngVelEM)) call RegPack(Buf, InData%PAngVelEM) end if if (RegCheckErr(Buf, RoutineName)) return - ! AngVelEM call RegPack(Buf, allocated(InData%AngVelEM)) if (allocated(InData%AngVelEM)) then call RegPackBounds(Buf, 3, lbound(InData%AngVelEM), ubound(InData%AngVelEM)) call RegPack(Buf, InData%AngVelEM) end if if (RegCheckErr(Buf, RoutineName)) return - ! PAngVelEN call RegPack(Buf, allocated(InData%PAngVelEN)) if (allocated(InData%PAngVelEN)) then call RegPackBounds(Buf, 3, lbound(InData%PAngVelEN), ubound(InData%PAngVelEN)) call RegPack(Buf, InData%PAngVelEN) end if if (RegCheckErr(Buf, RoutineName)) return - ! AngVelEA call RegPack(Buf, InData%AngVelEA) if (RegCheckErr(Buf, RoutineName)) return - ! PAngVelEB call RegPack(Buf, allocated(InData%PAngVelEB)) if (allocated(InData%PAngVelEB)) then call RegPackBounds(Buf, 3, lbound(InData%PAngVelEB), ubound(InData%PAngVelEB)) call RegPack(Buf, InData%PAngVelEB) end if if (RegCheckErr(Buf, RoutineName)) return - ! PAngVelER call RegPack(Buf, allocated(InData%PAngVelER)) if (allocated(InData%PAngVelER)) then call RegPackBounds(Buf, 3, lbound(InData%PAngVelER), ubound(InData%PAngVelER)) call RegPack(Buf, InData%PAngVelER) end if if (RegCheckErr(Buf, RoutineName)) return - ! PAngVelEX call RegPack(Buf, allocated(InData%PAngVelEX)) if (allocated(InData%PAngVelEX)) then call RegPackBounds(Buf, 3, lbound(InData%PAngVelEX), ubound(InData%PAngVelEX)) call RegPack(Buf, InData%PAngVelEX) end if if (RegCheckErr(Buf, RoutineName)) return - ! AngVelEG call RegPack(Buf, InData%AngVelEG) if (RegCheckErr(Buf, RoutineName)) return - ! AngVelEH call RegPack(Buf, InData%AngVelEH) if (RegCheckErr(Buf, RoutineName)) return - ! AngVelEL call RegPack(Buf, InData%AngVelEL) if (RegCheckErr(Buf, RoutineName)) return - ! AngVelEN call RegPack(Buf, InData%AngVelEN) if (RegCheckErr(Buf, RoutineName)) return - ! AngVelEB call RegPack(Buf, InData%AngVelEB) if (RegCheckErr(Buf, RoutineName)) return - ! AngVelER call RegPack(Buf, InData%AngVelER) if (RegCheckErr(Buf, RoutineName)) return - ! AngVelEX call RegPack(Buf, InData%AngVelEX) if (RegCheckErr(Buf, RoutineName)) return - ! TeetAngVel call RegPack(Buf, InData%TeetAngVel) if (RegCheckErr(Buf, RoutineName)) return - ! AngAccEBt call RegPack(Buf, InData%AngAccEBt) if (RegCheckErr(Buf, RoutineName)) return - ! AngAccERt call RegPack(Buf, InData%AngAccERt) if (RegCheckErr(Buf, RoutineName)) return - ! AngAccEXt call RegPack(Buf, InData%AngAccEXt) if (RegCheckErr(Buf, RoutineName)) return - ! AngAccEFt call RegPack(Buf, allocated(InData%AngAccEFt)) if (allocated(InData%AngAccEFt)) then call RegPackBounds(Buf, 2, lbound(InData%AngAccEFt), ubound(InData%AngAccEFt)) call RegPack(Buf, InData%AngAccEFt) end if if (RegCheckErr(Buf, RoutineName)) return - ! AngVelEF call RegPack(Buf, allocated(InData%AngVelEF)) if (allocated(InData%AngVelEF)) then call RegPackBounds(Buf, 2, lbound(InData%AngVelEF), ubound(InData%AngVelEF)) call RegPack(Buf, InData%AngVelEF) end if if (RegCheckErr(Buf, RoutineName)) return - ! AngVelHM call RegPack(Buf, allocated(InData%AngVelHM)) if (allocated(InData%AngVelHM)) then call RegPackBounds(Buf, 3, lbound(InData%AngVelHM), ubound(InData%AngVelHM)) call RegPack(Buf, InData%AngVelHM) end if if (RegCheckErr(Buf, RoutineName)) return - ! AngAccEAt call RegPack(Buf, InData%AngAccEAt) if (RegCheckErr(Buf, RoutineName)) return - ! AngAccEGt call RegPack(Buf, InData%AngAccEGt) if (RegCheckErr(Buf, RoutineName)) return - ! AngAccEHt call RegPack(Buf, InData%AngAccEHt) if (RegCheckErr(Buf, RoutineName)) return - ! AngAccEKt call RegPack(Buf, allocated(InData%AngAccEKt)) if (allocated(InData%AngAccEKt)) then call RegPackBounds(Buf, 3, lbound(InData%AngAccEKt), ubound(InData%AngAccEKt)) call RegPack(Buf, InData%AngAccEKt) end if if (RegCheckErr(Buf, RoutineName)) return - ! AngAccENt call RegPack(Buf, InData%AngAccENt) if (RegCheckErr(Buf, RoutineName)) return - ! LinAccECt call RegPack(Buf, InData%LinAccECt) if (RegCheckErr(Buf, RoutineName)) return - ! LinAccEDt call RegPack(Buf, InData%LinAccEDt) if (RegCheckErr(Buf, RoutineName)) return - ! LinAccEIt call RegPack(Buf, InData%LinAccEIt) if (RegCheckErr(Buf, RoutineName)) return - ! LinAccEJt call RegPack(Buf, InData%LinAccEJt) if (RegCheckErr(Buf, RoutineName)) return - ! LinAccEUt call RegPack(Buf, InData%LinAccEUt) if (RegCheckErr(Buf, RoutineName)) return - ! LinAccEYt call RegPack(Buf, InData%LinAccEYt) if (RegCheckErr(Buf, RoutineName)) return - ! LinVelES call RegPack(Buf, allocated(InData%LinVelES)) if (allocated(InData%LinVelES)) then call RegPackBounds(Buf, 3, lbound(InData%LinVelES), ubound(InData%LinVelES)) call RegPack(Buf, InData%LinVelES) end if if (RegCheckErr(Buf, RoutineName)) return - ! LinVelEQ call RegPack(Buf, InData%LinVelEQ) if (RegCheckErr(Buf, RoutineName)) return - ! LinVelET call RegPack(Buf, allocated(InData%LinVelET)) if (allocated(InData%LinVelET)) then call RegPackBounds(Buf, 2, lbound(InData%LinVelET), ubound(InData%LinVelET)) call RegPack(Buf, InData%LinVelET) end if if (RegCheckErr(Buf, RoutineName)) return - ! LinVelESm2 call RegPack(Buf, allocated(InData%LinVelESm2)) if (allocated(InData%LinVelESm2)) then call RegPackBounds(Buf, 1, lbound(InData%LinVelESm2), ubound(InData%LinVelESm2)) call RegPack(Buf, InData%LinVelESm2) end if if (RegCheckErr(Buf, RoutineName)) return - ! PLinVelEIMU call RegPack(Buf, allocated(InData%PLinVelEIMU)) if (allocated(InData%PLinVelEIMU)) then call RegPackBounds(Buf, 3, lbound(InData%PLinVelEIMU), ubound(InData%PLinVelEIMU)) call RegPack(Buf, InData%PLinVelEIMU) end if if (RegCheckErr(Buf, RoutineName)) return - ! PLinVelEO call RegPack(Buf, allocated(InData%PLinVelEO)) if (allocated(InData%PLinVelEO)) then call RegPackBounds(Buf, 3, lbound(InData%PLinVelEO), ubound(InData%PLinVelEO)) call RegPack(Buf, InData%PLinVelEO) end if if (RegCheckErr(Buf, RoutineName)) return - ! PLinVelES call RegPack(Buf, allocated(InData%PLinVelES)) if (allocated(InData%PLinVelES)) then call RegPackBounds(Buf, 5, lbound(InData%PLinVelES), ubound(InData%PLinVelES)) call RegPack(Buf, InData%PLinVelES) end if if (RegCheckErr(Buf, RoutineName)) return - ! PLinVelET call RegPack(Buf, allocated(InData%PLinVelET)) if (allocated(InData%PLinVelET)) then call RegPackBounds(Buf, 4, lbound(InData%PLinVelET), ubound(InData%PLinVelET)) call RegPack(Buf, InData%PLinVelET) end if if (RegCheckErr(Buf, RoutineName)) return - ! PLinVelEZ call RegPack(Buf, allocated(InData%PLinVelEZ)) if (allocated(InData%PLinVelEZ)) then call RegPackBounds(Buf, 3, lbound(InData%PLinVelEZ), ubound(InData%PLinVelEZ)) call RegPack(Buf, InData%PLinVelEZ) end if if (RegCheckErr(Buf, RoutineName)) return - ! PLinVelEC call RegPack(Buf, allocated(InData%PLinVelEC)) if (allocated(InData%PLinVelEC)) then call RegPackBounds(Buf, 3, lbound(InData%PLinVelEC), ubound(InData%PLinVelEC)) call RegPack(Buf, InData%PLinVelEC) end if if (RegCheckErr(Buf, RoutineName)) return - ! PLinVelED call RegPack(Buf, allocated(InData%PLinVelED)) if (allocated(InData%PLinVelED)) then call RegPackBounds(Buf, 3, lbound(InData%PLinVelED), ubound(InData%PLinVelED)) call RegPack(Buf, InData%PLinVelED) end if if (RegCheckErr(Buf, RoutineName)) return - ! PLinVelEI call RegPack(Buf, allocated(InData%PLinVelEI)) if (allocated(InData%PLinVelEI)) then call RegPackBounds(Buf, 3, lbound(InData%PLinVelEI), ubound(InData%PLinVelEI)) call RegPack(Buf, InData%PLinVelEI) end if if (RegCheckErr(Buf, RoutineName)) return - ! PLinVelEJ call RegPack(Buf, allocated(InData%PLinVelEJ)) if (allocated(InData%PLinVelEJ)) then call RegPackBounds(Buf, 3, lbound(InData%PLinVelEJ), ubound(InData%PLinVelEJ)) call RegPack(Buf, InData%PLinVelEJ) end if if (RegCheckErr(Buf, RoutineName)) return - ! PLinVelEP call RegPack(Buf, allocated(InData%PLinVelEP)) if (allocated(InData%PLinVelEP)) then call RegPackBounds(Buf, 3, lbound(InData%PLinVelEP), ubound(InData%PLinVelEP)) call RegPack(Buf, InData%PLinVelEP) end if if (RegCheckErr(Buf, RoutineName)) return - ! PLinVelEQ call RegPack(Buf, allocated(InData%PLinVelEQ)) if (allocated(InData%PLinVelEQ)) then call RegPackBounds(Buf, 3, lbound(InData%PLinVelEQ), ubound(InData%PLinVelEQ)) call RegPack(Buf, InData%PLinVelEQ) end if if (RegCheckErr(Buf, RoutineName)) return - ! PLinVelEU call RegPack(Buf, allocated(InData%PLinVelEU)) if (allocated(InData%PLinVelEU)) then call RegPackBounds(Buf, 3, lbound(InData%PLinVelEU), ubound(InData%PLinVelEU)) call RegPack(Buf, InData%PLinVelEU) end if if (RegCheckErr(Buf, RoutineName)) return - ! PLinVelEV call RegPack(Buf, allocated(InData%PLinVelEV)) if (allocated(InData%PLinVelEV)) then call RegPackBounds(Buf, 3, lbound(InData%PLinVelEV), ubound(InData%PLinVelEV)) call RegPack(Buf, InData%PLinVelEV) end if if (RegCheckErr(Buf, RoutineName)) return - ! PLinVelEW call RegPack(Buf, allocated(InData%PLinVelEW)) if (allocated(InData%PLinVelEW)) then call RegPackBounds(Buf, 3, lbound(InData%PLinVelEW), ubound(InData%PLinVelEW)) call RegPack(Buf, InData%PLinVelEW) end if if (RegCheckErr(Buf, RoutineName)) return - ! PLinVelEY call RegPack(Buf, allocated(InData%PLinVelEY)) if (allocated(InData%PLinVelEY)) then call RegPackBounds(Buf, 3, lbound(InData%PLinVelEY), ubound(InData%PLinVelEY)) call RegPack(Buf, InData%PLinVelEY) end if if (RegCheckErr(Buf, RoutineName)) return - ! LinAccEIMUt call RegPack(Buf, InData%LinAccEIMUt) if (RegCheckErr(Buf, RoutineName)) return - ! LinAccEOt call RegPack(Buf, InData%LinAccEOt) if (RegCheckErr(Buf, RoutineName)) return - ! LinAccESt call RegPack(Buf, allocated(InData%LinAccESt)) if (allocated(InData%LinAccESt)) then call RegPackBounds(Buf, 3, lbound(InData%LinAccESt), ubound(InData%LinAccESt)) call RegPack(Buf, InData%LinAccESt) end if if (RegCheckErr(Buf, RoutineName)) return - ! LinAccETt call RegPack(Buf, allocated(InData%LinAccETt)) if (allocated(InData%LinAccETt)) then call RegPackBounds(Buf, 2, lbound(InData%LinAccETt), ubound(InData%LinAccETt)) call RegPack(Buf, InData%LinAccETt) end if if (RegCheckErr(Buf, RoutineName)) return - ! LinAccEZt call RegPack(Buf, InData%LinAccEZt) if (RegCheckErr(Buf, RoutineName)) return - ! LinVelEIMU call RegPack(Buf, InData%LinVelEIMU) if (RegCheckErr(Buf, RoutineName)) return - ! LinVelEZ call RegPack(Buf, InData%LinVelEZ) if (RegCheckErr(Buf, RoutineName)) return - ! LinVelEO call RegPack(Buf, InData%LinVelEO) if (RegCheckErr(Buf, RoutineName)) return - ! LinVelEJ call RegPack(Buf, InData%LinVelEJ) if (RegCheckErr(Buf, RoutineName)) return - ! FrcONcRtt call RegPack(Buf, InData%FrcONcRtt) if (RegCheckErr(Buf, RoutineName)) return - ! FrcPRott call RegPack(Buf, InData%FrcPRott) if (RegCheckErr(Buf, RoutineName)) return - ! FrcS0Bt call RegPack(Buf, allocated(InData%FrcS0Bt)) if (allocated(InData%FrcS0Bt)) then call RegPackBounds(Buf, 2, lbound(InData%FrcS0Bt), ubound(InData%FrcS0Bt)) call RegPack(Buf, InData%FrcS0Bt) end if if (RegCheckErr(Buf, RoutineName)) return - ! FrcT0Trbt call RegPack(Buf, InData%FrcT0Trbt) if (RegCheckErr(Buf, RoutineName)) return - ! FSAero call RegPack(Buf, allocated(InData%FSAero)) if (allocated(InData%FSAero)) then call RegPackBounds(Buf, 3, lbound(InData%FSAero), ubound(InData%FSAero)) call RegPack(Buf, InData%FSAero) end if if (RegCheckErr(Buf, RoutineName)) return - ! FSTipDrag call RegPack(Buf, allocated(InData%FSTipDrag)) if (allocated(InData%FSTipDrag)) then call RegPackBounds(Buf, 2, lbound(InData%FSTipDrag), ubound(InData%FSTipDrag)) call RegPack(Buf, InData%FSTipDrag) end if if (RegCheckErr(Buf, RoutineName)) return - ! FTHydrot call RegPack(Buf, allocated(InData%FTHydrot)) if (allocated(InData%FTHydrot)) then call RegPackBounds(Buf, 2, lbound(InData%FTHydrot), ubound(InData%FTHydrot)) call RegPack(Buf, InData%FTHydrot) end if if (RegCheckErr(Buf, RoutineName)) return - ! FZHydrot call RegPack(Buf, InData%FZHydrot) if (RegCheckErr(Buf, RoutineName)) return - ! MFHydrot call RegPack(Buf, allocated(InData%MFHydrot)) if (allocated(InData%MFHydrot)) then call RegPackBounds(Buf, 2, lbound(InData%MFHydrot), ubound(InData%MFHydrot)) call RegPack(Buf, InData%MFHydrot) end if if (RegCheckErr(Buf, RoutineName)) return - ! MomBNcRtt call RegPack(Buf, InData%MomBNcRtt) if (RegCheckErr(Buf, RoutineName)) return - ! MomH0Bt call RegPack(Buf, allocated(InData%MomH0Bt)) if (allocated(InData%MomH0Bt)) then call RegPackBounds(Buf, 2, lbound(InData%MomH0Bt), ubound(InData%MomH0Bt)) call RegPack(Buf, InData%MomH0Bt) end if if (RegCheckErr(Buf, RoutineName)) return - ! MomLPRott call RegPack(Buf, InData%MomLPRott) if (RegCheckErr(Buf, RoutineName)) return - ! MomNGnRtt call RegPack(Buf, InData%MomNGnRtt) if (RegCheckErr(Buf, RoutineName)) return - ! MomNTailt call RegPack(Buf, InData%MomNTailt) if (RegCheckErr(Buf, RoutineName)) return - ! MomX0Trbt call RegPack(Buf, InData%MomX0Trbt) if (RegCheckErr(Buf, RoutineName)) return - ! MMAero call RegPack(Buf, allocated(InData%MMAero)) if (allocated(InData%MMAero)) then call RegPackBounds(Buf, 3, lbound(InData%MMAero), ubound(InData%MMAero)) call RegPack(Buf, InData%MMAero) end if if (RegCheckErr(Buf, RoutineName)) return - ! MXHydrot call RegPack(Buf, InData%MXHydrot) if (RegCheckErr(Buf, RoutineName)) return - ! PFrcONcRt call RegPack(Buf, allocated(InData%PFrcONcRt)) if (allocated(InData%PFrcONcRt)) then call RegPackBounds(Buf, 2, lbound(InData%PFrcONcRt), ubound(InData%PFrcONcRt)) call RegPack(Buf, InData%PFrcONcRt) end if if (RegCheckErr(Buf, RoutineName)) return - ! PFrcPRot call RegPack(Buf, allocated(InData%PFrcPRot)) if (allocated(InData%PFrcPRot)) then call RegPackBounds(Buf, 2, lbound(InData%PFrcPRot), ubound(InData%PFrcPRot)) call RegPack(Buf, InData%PFrcPRot) end if if (RegCheckErr(Buf, RoutineName)) return - ! PFrcS0B call RegPack(Buf, allocated(InData%PFrcS0B)) if (allocated(InData%PFrcS0B)) then call RegPackBounds(Buf, 3, lbound(InData%PFrcS0B), ubound(InData%PFrcS0B)) call RegPack(Buf, InData%PFrcS0B) end if if (RegCheckErr(Buf, RoutineName)) return - ! PFrcT0Trb call RegPack(Buf, allocated(InData%PFrcT0Trb)) if (allocated(InData%PFrcT0Trb)) then call RegPackBounds(Buf, 2, lbound(InData%PFrcT0Trb), ubound(InData%PFrcT0Trb)) call RegPack(Buf, InData%PFrcT0Trb) end if if (RegCheckErr(Buf, RoutineName)) return - ! PFTHydro call RegPack(Buf, allocated(InData%PFTHydro)) if (allocated(InData%PFTHydro)) then call RegPackBounds(Buf, 3, lbound(InData%PFTHydro), ubound(InData%PFTHydro)) call RegPack(Buf, InData%PFTHydro) end if if (RegCheckErr(Buf, RoutineName)) return - ! PFZHydro call RegPack(Buf, InData%PFZHydro) if (RegCheckErr(Buf, RoutineName)) return - ! PMFHydro call RegPack(Buf, allocated(InData%PMFHydro)) if (allocated(InData%PMFHydro)) then call RegPackBounds(Buf, 3, lbound(InData%PMFHydro), ubound(InData%PMFHydro)) call RegPack(Buf, InData%PMFHydro) end if if (RegCheckErr(Buf, RoutineName)) return - ! PMomBNcRt call RegPack(Buf, allocated(InData%PMomBNcRt)) if (allocated(InData%PMomBNcRt)) then call RegPackBounds(Buf, 2, lbound(InData%PMomBNcRt), ubound(InData%PMomBNcRt)) call RegPack(Buf, InData%PMomBNcRt) end if if (RegCheckErr(Buf, RoutineName)) return - ! PMomH0B call RegPack(Buf, allocated(InData%PMomH0B)) if (allocated(InData%PMomH0B)) then call RegPackBounds(Buf, 3, lbound(InData%PMomH0B), ubound(InData%PMomH0B)) call RegPack(Buf, InData%PMomH0B) end if if (RegCheckErr(Buf, RoutineName)) return - ! PMomLPRot call RegPack(Buf, allocated(InData%PMomLPRot)) if (allocated(InData%PMomLPRot)) then call RegPackBounds(Buf, 2, lbound(InData%PMomLPRot), ubound(InData%PMomLPRot)) call RegPack(Buf, InData%PMomLPRot) end if if (RegCheckErr(Buf, RoutineName)) return - ! PMomNGnRt call RegPack(Buf, allocated(InData%PMomNGnRt)) if (allocated(InData%PMomNGnRt)) then call RegPackBounds(Buf, 2, lbound(InData%PMomNGnRt), ubound(InData%PMomNGnRt)) call RegPack(Buf, InData%PMomNGnRt) end if if (RegCheckErr(Buf, RoutineName)) return - ! PMomNTail call RegPack(Buf, allocated(InData%PMomNTail)) if (allocated(InData%PMomNTail)) then call RegPackBounds(Buf, 2, lbound(InData%PMomNTail), ubound(InData%PMomNTail)) call RegPack(Buf, InData%PMomNTail) end if if (RegCheckErr(Buf, RoutineName)) return - ! PMomX0Trb call RegPack(Buf, allocated(InData%PMomX0Trb)) if (allocated(InData%PMomX0Trb)) then call RegPackBounds(Buf, 2, lbound(InData%PMomX0Trb), ubound(InData%PMomX0Trb)) call RegPack(Buf, InData%PMomX0Trb) end if if (RegCheckErr(Buf, RoutineName)) return - ! PMXHydro call RegPack(Buf, InData%PMXHydro) if (RegCheckErr(Buf, RoutineName)) return - ! TeetAng call RegPack(Buf, InData%TeetAng) if (RegCheckErr(Buf, RoutineName)) return - ! FrcVGnRtt call RegPack(Buf, InData%FrcVGnRtt) if (RegCheckErr(Buf, RoutineName)) return - ! FrcWTailt call RegPack(Buf, InData%FrcWTailt) if (RegCheckErr(Buf, RoutineName)) return - ! FrcZAllt call RegPack(Buf, InData%FrcZAllt) if (RegCheckErr(Buf, RoutineName)) return - ! MomXAllt call RegPack(Buf, InData%MomXAllt) if (RegCheckErr(Buf, RoutineName)) return - ! PFrcVGnRt call RegPack(Buf, allocated(InData%PFrcVGnRt)) if (allocated(InData%PFrcVGnRt)) then call RegPackBounds(Buf, 2, lbound(InData%PFrcVGnRt), ubound(InData%PFrcVGnRt)) call RegPack(Buf, InData%PFrcVGnRt) end if if (RegCheckErr(Buf, RoutineName)) return - ! PFrcWTail call RegPack(Buf, allocated(InData%PFrcWTail)) if (allocated(InData%PFrcWTail)) then call RegPackBounds(Buf, 2, lbound(InData%PFrcWTail), ubound(InData%PFrcWTail)) call RegPack(Buf, InData%PFrcWTail) end if if (RegCheckErr(Buf, RoutineName)) return - ! PFrcZAll call RegPack(Buf, allocated(InData%PFrcZAll)) if (allocated(InData%PFrcZAll)) then call RegPackBounds(Buf, 2, lbound(InData%PFrcZAll), ubound(InData%PFrcZAll)) call RegPack(Buf, InData%PFrcZAll) end if if (RegCheckErr(Buf, RoutineName)) return - ! PMomXAll call RegPack(Buf, allocated(InData%PMomXAll)) if (allocated(InData%PMomXAll)) then call RegPackBounds(Buf, 2, lbound(InData%PMomXAll), ubound(InData%PMomXAll)) call RegPack(Buf, InData%PMomXAll) end if if (RegCheckErr(Buf, RoutineName)) return - ! TeetMom call RegPack(Buf, InData%TeetMom) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlMom call RegPack(Buf, InData%TFrlMom) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlMom call RegPack(Buf, InData%RFrlMom) if (RegCheckErr(Buf, RoutineName)) return - ! GBoxEffFac call RegPack(Buf, InData%GBoxEffFac) if (RegCheckErr(Buf, RoutineName)) return - ! rSAerCen call RegPack(Buf, allocated(InData%rSAerCen)) if (allocated(InData%rSAerCen)) then call RegPackBounds(Buf, 3, lbound(InData%rSAerCen), ubound(InData%rSAerCen)) @@ -7507,10 +6718,8 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! rO call RegUnpack(Buf, OutData%rO) if (RegCheckErr(Buf, RoutineName)) return - ! rQS if (allocated(OutData%rQS)) deallocate(OutData%rQS) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7525,7 +6734,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%rQS) if (RegCheckErr(Buf, RoutineName)) return end if - ! rS if (allocated(OutData%rS)) deallocate(OutData%rS) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7540,7 +6748,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%rS) if (RegCheckErr(Buf, RoutineName)) return end if - ! rS0S if (allocated(OutData%rS0S)) deallocate(OutData%rS0S) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7555,7 +6762,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%rS0S) if (RegCheckErr(Buf, RoutineName)) return end if - ! rT if (allocated(OutData%rT)) deallocate(OutData%rT) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7570,10 +6776,8 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%rT) if (RegCheckErr(Buf, RoutineName)) return end if - ! rT0O call RegUnpack(Buf, OutData%rT0O) if (RegCheckErr(Buf, RoutineName)) return - ! rT0T if (allocated(OutData%rT0T)) deallocate(OutData%rT0T) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7588,13 +6792,10 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%rT0T) if (RegCheckErr(Buf, RoutineName)) return end if - ! rZ call RegUnpack(Buf, OutData%rZ) if (RegCheckErr(Buf, RoutineName)) return - ! rZO call RegUnpack(Buf, OutData%rZO) if (RegCheckErr(Buf, RoutineName)) return - ! rZT if (allocated(OutData%rZT)) deallocate(OutData%rZT) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7609,37 +6810,26 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%rZT) if (RegCheckErr(Buf, RoutineName)) return end if - ! rPQ call RegUnpack(Buf, OutData%rPQ) if (RegCheckErr(Buf, RoutineName)) return - ! rP call RegUnpack(Buf, OutData%rP) if (RegCheckErr(Buf, RoutineName)) return - ! rV call RegUnpack(Buf, OutData%rV) if (RegCheckErr(Buf, RoutineName)) return - ! rJ call RegUnpack(Buf, OutData%rJ) if (RegCheckErr(Buf, RoutineName)) return - ! rZY call RegUnpack(Buf, OutData%rZY) if (RegCheckErr(Buf, RoutineName)) return - ! rOU call RegUnpack(Buf, OutData%rOU) if (RegCheckErr(Buf, RoutineName)) return - ! rOV call RegUnpack(Buf, OutData%rOV) if (RegCheckErr(Buf, RoutineName)) return - ! rVD call RegUnpack(Buf, OutData%rVD) if (RegCheckErr(Buf, RoutineName)) return - ! rOW call RegUnpack(Buf, OutData%rOW) if (RegCheckErr(Buf, RoutineName)) return - ! rPC call RegUnpack(Buf, OutData%rPC) if (RegCheckErr(Buf, RoutineName)) return - ! rPS0 if (allocated(OutData%rPS0)) deallocate(OutData%rPS0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7654,28 +6844,20 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%rPS0) if (RegCheckErr(Buf, RoutineName)) return end if - ! rQ call RegUnpack(Buf, OutData%rQ) if (RegCheckErr(Buf, RoutineName)) return - ! rQC call RegUnpack(Buf, OutData%rQC) if (RegCheckErr(Buf, RoutineName)) return - ! rVIMU call RegUnpack(Buf, OutData%rVIMU) if (RegCheckErr(Buf, RoutineName)) return - ! rVP call RegUnpack(Buf, OutData%rVP) if (RegCheckErr(Buf, RoutineName)) return - ! rWI call RegUnpack(Buf, OutData%rWI) if (RegCheckErr(Buf, RoutineName)) return - ! rWJ call RegUnpack(Buf, OutData%rWJ) if (RegCheckErr(Buf, RoutineName)) return - ! rZT0 call RegUnpack(Buf, OutData%rZT0) if (RegCheckErr(Buf, RoutineName)) return - ! AngPosEF if (allocated(OutData%AngPosEF)) deallocate(OutData%AngPosEF) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7690,7 +6872,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%AngPosEF) if (RegCheckErr(Buf, RoutineName)) return end if - ! AngPosXF if (allocated(OutData%AngPosXF)) deallocate(OutData%AngPosXF) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7705,7 +6886,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%AngPosXF) if (RegCheckErr(Buf, RoutineName)) return end if - ! AngPosHM if (allocated(OutData%AngPosHM)) deallocate(OutData%AngPosHM) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7720,13 +6900,10 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%AngPosHM) if (RegCheckErr(Buf, RoutineName)) return end if - ! AngPosXB call RegUnpack(Buf, OutData%AngPosXB) if (RegCheckErr(Buf, RoutineName)) return - ! AngPosEX call RegUnpack(Buf, OutData%AngPosEX) if (RegCheckErr(Buf, RoutineName)) return - ! PAngVelEA if (allocated(OutData%PAngVelEA)) deallocate(OutData%PAngVelEA) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7741,7 +6918,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%PAngVelEA) if (RegCheckErr(Buf, RoutineName)) return end if - ! PAngVelEF if (allocated(OutData%PAngVelEF)) deallocate(OutData%PAngVelEF) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7756,7 +6932,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%PAngVelEF) if (RegCheckErr(Buf, RoutineName)) return end if - ! PAngVelEG if (allocated(OutData%PAngVelEG)) deallocate(OutData%PAngVelEG) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7771,7 +6946,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%PAngVelEG) if (RegCheckErr(Buf, RoutineName)) return end if - ! PAngVelEH if (allocated(OutData%PAngVelEH)) deallocate(OutData%PAngVelEH) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7786,7 +6960,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%PAngVelEH) if (RegCheckErr(Buf, RoutineName)) return end if - ! PAngVelEL if (allocated(OutData%PAngVelEL)) deallocate(OutData%PAngVelEL) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7801,7 +6974,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%PAngVelEL) if (RegCheckErr(Buf, RoutineName)) return end if - ! PAngVelEM if (allocated(OutData%PAngVelEM)) deallocate(OutData%PAngVelEM) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7816,7 +6988,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%PAngVelEM) if (RegCheckErr(Buf, RoutineName)) return end if - ! AngVelEM if (allocated(OutData%AngVelEM)) deallocate(OutData%AngVelEM) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7831,7 +7002,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%AngVelEM) if (RegCheckErr(Buf, RoutineName)) return end if - ! PAngVelEN if (allocated(OutData%PAngVelEN)) deallocate(OutData%PAngVelEN) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7846,10 +7016,8 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%PAngVelEN) if (RegCheckErr(Buf, RoutineName)) return end if - ! AngVelEA call RegUnpack(Buf, OutData%AngVelEA) if (RegCheckErr(Buf, RoutineName)) return - ! PAngVelEB if (allocated(OutData%PAngVelEB)) deallocate(OutData%PAngVelEB) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7864,7 +7032,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%PAngVelEB) if (RegCheckErr(Buf, RoutineName)) return end if - ! PAngVelER if (allocated(OutData%PAngVelER)) deallocate(OutData%PAngVelER) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7879,7 +7046,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%PAngVelER) if (RegCheckErr(Buf, RoutineName)) return end if - ! PAngVelEX if (allocated(OutData%PAngVelEX)) deallocate(OutData%PAngVelEX) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7894,40 +7060,28 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%PAngVelEX) if (RegCheckErr(Buf, RoutineName)) return end if - ! AngVelEG call RegUnpack(Buf, OutData%AngVelEG) if (RegCheckErr(Buf, RoutineName)) return - ! AngVelEH call RegUnpack(Buf, OutData%AngVelEH) if (RegCheckErr(Buf, RoutineName)) return - ! AngVelEL call RegUnpack(Buf, OutData%AngVelEL) if (RegCheckErr(Buf, RoutineName)) return - ! AngVelEN call RegUnpack(Buf, OutData%AngVelEN) if (RegCheckErr(Buf, RoutineName)) return - ! AngVelEB call RegUnpack(Buf, OutData%AngVelEB) if (RegCheckErr(Buf, RoutineName)) return - ! AngVelER call RegUnpack(Buf, OutData%AngVelER) if (RegCheckErr(Buf, RoutineName)) return - ! AngVelEX call RegUnpack(Buf, OutData%AngVelEX) if (RegCheckErr(Buf, RoutineName)) return - ! TeetAngVel call RegUnpack(Buf, OutData%TeetAngVel) if (RegCheckErr(Buf, RoutineName)) return - ! AngAccEBt call RegUnpack(Buf, OutData%AngAccEBt) if (RegCheckErr(Buf, RoutineName)) return - ! AngAccERt call RegUnpack(Buf, OutData%AngAccERt) if (RegCheckErr(Buf, RoutineName)) return - ! AngAccEXt call RegUnpack(Buf, OutData%AngAccEXt) if (RegCheckErr(Buf, RoutineName)) return - ! AngAccEFt if (allocated(OutData%AngAccEFt)) deallocate(OutData%AngAccEFt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7942,7 +7096,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%AngAccEFt) if (RegCheckErr(Buf, RoutineName)) return end if - ! AngVelEF if (allocated(OutData%AngVelEF)) deallocate(OutData%AngVelEF) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7957,7 +7110,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%AngVelEF) if (RegCheckErr(Buf, RoutineName)) return end if - ! AngVelHM if (allocated(OutData%AngVelHM)) deallocate(OutData%AngVelHM) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7972,16 +7124,12 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%AngVelHM) if (RegCheckErr(Buf, RoutineName)) return end if - ! AngAccEAt call RegUnpack(Buf, OutData%AngAccEAt) if (RegCheckErr(Buf, RoutineName)) return - ! AngAccEGt call RegUnpack(Buf, OutData%AngAccEGt) if (RegCheckErr(Buf, RoutineName)) return - ! AngAccEHt call RegUnpack(Buf, OutData%AngAccEHt) if (RegCheckErr(Buf, RoutineName)) return - ! AngAccEKt if (allocated(OutData%AngAccEKt)) deallocate(OutData%AngAccEKt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7996,28 +7144,20 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%AngAccEKt) if (RegCheckErr(Buf, RoutineName)) return end if - ! AngAccENt call RegUnpack(Buf, OutData%AngAccENt) if (RegCheckErr(Buf, RoutineName)) return - ! LinAccECt call RegUnpack(Buf, OutData%LinAccECt) if (RegCheckErr(Buf, RoutineName)) return - ! LinAccEDt call RegUnpack(Buf, OutData%LinAccEDt) if (RegCheckErr(Buf, RoutineName)) return - ! LinAccEIt call RegUnpack(Buf, OutData%LinAccEIt) if (RegCheckErr(Buf, RoutineName)) return - ! LinAccEJt call RegUnpack(Buf, OutData%LinAccEJt) if (RegCheckErr(Buf, RoutineName)) return - ! LinAccEUt call RegUnpack(Buf, OutData%LinAccEUt) if (RegCheckErr(Buf, RoutineName)) return - ! LinAccEYt call RegUnpack(Buf, OutData%LinAccEYt) if (RegCheckErr(Buf, RoutineName)) return - ! LinVelES if (allocated(OutData%LinVelES)) deallocate(OutData%LinVelES) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8032,10 +7172,8 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%LinVelES) if (RegCheckErr(Buf, RoutineName)) return end if - ! LinVelEQ call RegUnpack(Buf, OutData%LinVelEQ) if (RegCheckErr(Buf, RoutineName)) return - ! LinVelET if (allocated(OutData%LinVelET)) deallocate(OutData%LinVelET) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8050,7 +7188,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%LinVelET) if (RegCheckErr(Buf, RoutineName)) return end if - ! LinVelESm2 if (allocated(OutData%LinVelESm2)) deallocate(OutData%LinVelESm2) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8065,7 +7202,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%LinVelESm2) if (RegCheckErr(Buf, RoutineName)) return end if - ! PLinVelEIMU if (allocated(OutData%PLinVelEIMU)) deallocate(OutData%PLinVelEIMU) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8080,7 +7216,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%PLinVelEIMU) if (RegCheckErr(Buf, RoutineName)) return end if - ! PLinVelEO if (allocated(OutData%PLinVelEO)) deallocate(OutData%PLinVelEO) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8095,7 +7230,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%PLinVelEO) if (RegCheckErr(Buf, RoutineName)) return end if - ! PLinVelES if (allocated(OutData%PLinVelES)) deallocate(OutData%PLinVelES) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8110,7 +7244,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%PLinVelES) if (RegCheckErr(Buf, RoutineName)) return end if - ! PLinVelET if (allocated(OutData%PLinVelET)) deallocate(OutData%PLinVelET) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8125,7 +7258,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%PLinVelET) if (RegCheckErr(Buf, RoutineName)) return end if - ! PLinVelEZ if (allocated(OutData%PLinVelEZ)) deallocate(OutData%PLinVelEZ) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8140,7 +7272,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%PLinVelEZ) if (RegCheckErr(Buf, RoutineName)) return end if - ! PLinVelEC if (allocated(OutData%PLinVelEC)) deallocate(OutData%PLinVelEC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8155,7 +7286,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%PLinVelEC) if (RegCheckErr(Buf, RoutineName)) return end if - ! PLinVelED if (allocated(OutData%PLinVelED)) deallocate(OutData%PLinVelED) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8170,7 +7300,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%PLinVelED) if (RegCheckErr(Buf, RoutineName)) return end if - ! PLinVelEI if (allocated(OutData%PLinVelEI)) deallocate(OutData%PLinVelEI) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8185,7 +7314,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%PLinVelEI) if (RegCheckErr(Buf, RoutineName)) return end if - ! PLinVelEJ if (allocated(OutData%PLinVelEJ)) deallocate(OutData%PLinVelEJ) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8200,7 +7328,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%PLinVelEJ) if (RegCheckErr(Buf, RoutineName)) return end if - ! PLinVelEP if (allocated(OutData%PLinVelEP)) deallocate(OutData%PLinVelEP) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8215,7 +7342,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%PLinVelEP) if (RegCheckErr(Buf, RoutineName)) return end if - ! PLinVelEQ if (allocated(OutData%PLinVelEQ)) deallocate(OutData%PLinVelEQ) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8230,7 +7356,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%PLinVelEQ) if (RegCheckErr(Buf, RoutineName)) return end if - ! PLinVelEU if (allocated(OutData%PLinVelEU)) deallocate(OutData%PLinVelEU) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8245,7 +7370,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%PLinVelEU) if (RegCheckErr(Buf, RoutineName)) return end if - ! PLinVelEV if (allocated(OutData%PLinVelEV)) deallocate(OutData%PLinVelEV) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8260,7 +7384,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%PLinVelEV) if (RegCheckErr(Buf, RoutineName)) return end if - ! PLinVelEW if (allocated(OutData%PLinVelEW)) deallocate(OutData%PLinVelEW) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8275,7 +7398,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%PLinVelEW) if (RegCheckErr(Buf, RoutineName)) return end if - ! PLinVelEY if (allocated(OutData%PLinVelEY)) deallocate(OutData%PLinVelEY) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8290,13 +7412,10 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%PLinVelEY) if (RegCheckErr(Buf, RoutineName)) return end if - ! LinAccEIMUt call RegUnpack(Buf, OutData%LinAccEIMUt) if (RegCheckErr(Buf, RoutineName)) return - ! LinAccEOt call RegUnpack(Buf, OutData%LinAccEOt) if (RegCheckErr(Buf, RoutineName)) return - ! LinAccESt if (allocated(OutData%LinAccESt)) deallocate(OutData%LinAccESt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8311,7 +7430,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%LinAccESt) if (RegCheckErr(Buf, RoutineName)) return end if - ! LinAccETt if (allocated(OutData%LinAccETt)) deallocate(OutData%LinAccETt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8326,28 +7444,20 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%LinAccETt) if (RegCheckErr(Buf, RoutineName)) return end if - ! LinAccEZt call RegUnpack(Buf, OutData%LinAccEZt) if (RegCheckErr(Buf, RoutineName)) return - ! LinVelEIMU call RegUnpack(Buf, OutData%LinVelEIMU) if (RegCheckErr(Buf, RoutineName)) return - ! LinVelEZ call RegUnpack(Buf, OutData%LinVelEZ) if (RegCheckErr(Buf, RoutineName)) return - ! LinVelEO call RegUnpack(Buf, OutData%LinVelEO) if (RegCheckErr(Buf, RoutineName)) return - ! LinVelEJ call RegUnpack(Buf, OutData%LinVelEJ) if (RegCheckErr(Buf, RoutineName)) return - ! FrcONcRtt call RegUnpack(Buf, OutData%FrcONcRtt) if (RegCheckErr(Buf, RoutineName)) return - ! FrcPRott call RegUnpack(Buf, OutData%FrcPRott) if (RegCheckErr(Buf, RoutineName)) return - ! FrcS0Bt if (allocated(OutData%FrcS0Bt)) deallocate(OutData%FrcS0Bt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8362,10 +7472,8 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%FrcS0Bt) if (RegCheckErr(Buf, RoutineName)) return end if - ! FrcT0Trbt call RegUnpack(Buf, OutData%FrcT0Trbt) if (RegCheckErr(Buf, RoutineName)) return - ! FSAero if (allocated(OutData%FSAero)) deallocate(OutData%FSAero) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8380,7 +7488,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%FSAero) if (RegCheckErr(Buf, RoutineName)) return end if - ! FSTipDrag if (allocated(OutData%FSTipDrag)) deallocate(OutData%FSTipDrag) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8395,7 +7502,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%FSTipDrag) if (RegCheckErr(Buf, RoutineName)) return end if - ! FTHydrot if (allocated(OutData%FTHydrot)) deallocate(OutData%FTHydrot) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8410,10 +7516,8 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%FTHydrot) if (RegCheckErr(Buf, RoutineName)) return end if - ! FZHydrot call RegUnpack(Buf, OutData%FZHydrot) if (RegCheckErr(Buf, RoutineName)) return - ! MFHydrot if (allocated(OutData%MFHydrot)) deallocate(OutData%MFHydrot) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8428,10 +7532,8 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%MFHydrot) if (RegCheckErr(Buf, RoutineName)) return end if - ! MomBNcRtt call RegUnpack(Buf, OutData%MomBNcRtt) if (RegCheckErr(Buf, RoutineName)) return - ! MomH0Bt if (allocated(OutData%MomH0Bt)) deallocate(OutData%MomH0Bt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8446,19 +7548,14 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%MomH0Bt) if (RegCheckErr(Buf, RoutineName)) return end if - ! MomLPRott call RegUnpack(Buf, OutData%MomLPRott) if (RegCheckErr(Buf, RoutineName)) return - ! MomNGnRtt call RegUnpack(Buf, OutData%MomNGnRtt) if (RegCheckErr(Buf, RoutineName)) return - ! MomNTailt call RegUnpack(Buf, OutData%MomNTailt) if (RegCheckErr(Buf, RoutineName)) return - ! MomX0Trbt call RegUnpack(Buf, OutData%MomX0Trbt) if (RegCheckErr(Buf, RoutineName)) return - ! MMAero if (allocated(OutData%MMAero)) deallocate(OutData%MMAero) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8473,10 +7570,8 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%MMAero) if (RegCheckErr(Buf, RoutineName)) return end if - ! MXHydrot call RegUnpack(Buf, OutData%MXHydrot) if (RegCheckErr(Buf, RoutineName)) return - ! PFrcONcRt if (allocated(OutData%PFrcONcRt)) deallocate(OutData%PFrcONcRt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8491,7 +7586,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%PFrcONcRt) if (RegCheckErr(Buf, RoutineName)) return end if - ! PFrcPRot if (allocated(OutData%PFrcPRot)) deallocate(OutData%PFrcPRot) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8506,7 +7600,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%PFrcPRot) if (RegCheckErr(Buf, RoutineName)) return end if - ! PFrcS0B if (allocated(OutData%PFrcS0B)) deallocate(OutData%PFrcS0B) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8521,7 +7614,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%PFrcS0B) if (RegCheckErr(Buf, RoutineName)) return end if - ! PFrcT0Trb if (allocated(OutData%PFrcT0Trb)) deallocate(OutData%PFrcT0Trb) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8536,7 +7628,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%PFrcT0Trb) if (RegCheckErr(Buf, RoutineName)) return end if - ! PFTHydro if (allocated(OutData%PFTHydro)) deallocate(OutData%PFTHydro) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8551,10 +7642,8 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%PFTHydro) if (RegCheckErr(Buf, RoutineName)) return end if - ! PFZHydro call RegUnpack(Buf, OutData%PFZHydro) if (RegCheckErr(Buf, RoutineName)) return - ! PMFHydro if (allocated(OutData%PMFHydro)) deallocate(OutData%PMFHydro) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8569,7 +7658,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%PMFHydro) if (RegCheckErr(Buf, RoutineName)) return end if - ! PMomBNcRt if (allocated(OutData%PMomBNcRt)) deallocate(OutData%PMomBNcRt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8584,7 +7672,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%PMomBNcRt) if (RegCheckErr(Buf, RoutineName)) return end if - ! PMomH0B if (allocated(OutData%PMomH0B)) deallocate(OutData%PMomH0B) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8599,7 +7686,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%PMomH0B) if (RegCheckErr(Buf, RoutineName)) return end if - ! PMomLPRot if (allocated(OutData%PMomLPRot)) deallocate(OutData%PMomLPRot) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8614,7 +7700,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%PMomLPRot) if (RegCheckErr(Buf, RoutineName)) return end if - ! PMomNGnRt if (allocated(OutData%PMomNGnRt)) deallocate(OutData%PMomNGnRt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8629,7 +7714,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%PMomNGnRt) if (RegCheckErr(Buf, RoutineName)) return end if - ! PMomNTail if (allocated(OutData%PMomNTail)) deallocate(OutData%PMomNTail) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8644,7 +7728,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%PMomNTail) if (RegCheckErr(Buf, RoutineName)) return end if - ! PMomX0Trb if (allocated(OutData%PMomX0Trb)) deallocate(OutData%PMomX0Trb) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8659,25 +7742,18 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%PMomX0Trb) if (RegCheckErr(Buf, RoutineName)) return end if - ! PMXHydro call RegUnpack(Buf, OutData%PMXHydro) if (RegCheckErr(Buf, RoutineName)) return - ! TeetAng call RegUnpack(Buf, OutData%TeetAng) if (RegCheckErr(Buf, RoutineName)) return - ! FrcVGnRtt call RegUnpack(Buf, OutData%FrcVGnRtt) if (RegCheckErr(Buf, RoutineName)) return - ! FrcWTailt call RegUnpack(Buf, OutData%FrcWTailt) if (RegCheckErr(Buf, RoutineName)) return - ! FrcZAllt call RegUnpack(Buf, OutData%FrcZAllt) if (RegCheckErr(Buf, RoutineName)) return - ! MomXAllt call RegUnpack(Buf, OutData%MomXAllt) if (RegCheckErr(Buf, RoutineName)) return - ! PFrcVGnRt if (allocated(OutData%PFrcVGnRt)) deallocate(OutData%PFrcVGnRt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8692,7 +7768,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%PFrcVGnRt) if (RegCheckErr(Buf, RoutineName)) return end if - ! PFrcWTail if (allocated(OutData%PFrcWTail)) deallocate(OutData%PFrcWTail) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8707,7 +7782,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%PFrcWTail) if (RegCheckErr(Buf, RoutineName)) return end if - ! PFrcZAll if (allocated(OutData%PFrcZAll)) deallocate(OutData%PFrcZAll) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8722,7 +7796,6 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%PFrcZAll) if (RegCheckErr(Buf, RoutineName)) return end if - ! PMomXAll if (allocated(OutData%PMomXAll)) deallocate(OutData%PMomXAll) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8737,19 +7810,14 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) call RegUnpack(Buf, OutData%PMomXAll) if (RegCheckErr(Buf, RoutineName)) return end if - ! TeetMom call RegUnpack(Buf, OutData%TeetMom) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlMom call RegUnpack(Buf, OutData%TFrlMom) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlMom call RegUnpack(Buf, OutData%RFrlMom) if (RegCheckErr(Buf, RoutineName)) return - ! GBoxEffFac call RegUnpack(Buf, OutData%GBoxEffFac) if (RegCheckErr(Buf, RoutineName)) return - ! rSAerCen if (allocated(OutData%rSAerCen)) deallocate(OutData%rSAerCen) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8765,82 +7833,74 @@ subroutine ED_UnPackRtHndSide(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE ED_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(ED_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcContStateData%QT)) THEN - i1_l = LBOUND(SrcContStateData%QT,1) - i1_u = UBOUND(SrcContStateData%QT,1) - IF (.NOT. ALLOCATED(DstContStateData%QT)) THEN - ALLOCATE(DstContStateData%QT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%QT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstContStateData%QT = SrcContStateData%QT -ENDIF -IF (ALLOCATED(SrcContStateData%QDT)) THEN - i1_l = LBOUND(SrcContStateData%QDT,1) - i1_u = UBOUND(SrcContStateData%QDT,1) - IF (.NOT. ALLOCATED(DstContStateData%QDT)) THEN - ALLOCATE(DstContStateData%QDT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%QDT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstContStateData%QDT = SrcContStateData%QDT -ENDIF - END SUBROUTINE ED_CopyContState - - SUBROUTINE ED_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(ED_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(ContStateData%QT)) THEN - DEALLOCATE(ContStateData%QT) -ENDIF -IF (ALLOCATED(ContStateData%QDT)) THEN - DEALLOCATE(ContStateData%QDT) -ENDIF - END SUBROUTINE ED_DestroyContState +subroutine ED_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(ED_ContinuousStateType), intent(in) :: SrcContStateData + type(ED_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'ED_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcContStateData%QT)) then + LB(1:1) = lbound(SrcContStateData%QT) + UB(1:1) = ubound(SrcContStateData%QT) + if (.not. allocated(DstContStateData%QT)) then + allocate(DstContStateData%QT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%QT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstContStateData%QT = SrcContStateData%QT + else if (allocated(DstContStateData%QT)) then + deallocate(DstContStateData%QT) + end if + if (allocated(SrcContStateData%QDT)) then + LB(1:1) = lbound(SrcContStateData%QDT) + UB(1:1) = ubound(SrcContStateData%QDT) + if (.not. allocated(DstContStateData%QDT)) then + allocate(DstContStateData%QDT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%QDT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstContStateData%QDT = SrcContStateData%QDT + else if (allocated(DstContStateData%QDT)) then + deallocate(DstContStateData%QDT) + end if +end subroutine +subroutine ED_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(ED_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ED_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ContStateData%QT)) then + deallocate(ContStateData%QT) + end if + if (allocated(ContStateData%QDT)) then + deallocate(ContStateData%QDT) + end if +end subroutine subroutine ED_PackContState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ED_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'ED_PackContState' if (Buf%ErrStat >= AbortErrLev) return - ! QT call RegPack(Buf, allocated(InData%QT)) if (allocated(InData%QT)) then call RegPackBounds(Buf, 1, lbound(InData%QT), ubound(InData%QT)) call RegPack(Buf, InData%QT) end if if (RegCheckErr(Buf, RoutineName)) return - ! QDT call RegPack(Buf, allocated(InData%QDT)) if (allocated(InData%QDT)) then call RegPackBounds(Buf, 1, lbound(InData%QDT), ubound(InData%QDT)) @@ -8857,7 +7917,6 @@ subroutine ED_UnPackContState(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! QT if (allocated(OutData%QT)) deallocate(OutData%QT) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8872,7 +7931,6 @@ subroutine ED_UnPackContState(Buf, OutData) call RegUnpack(Buf, OutData%QT) if (RegCheckErr(Buf, RoutineName)) return end if - ! QDT if (allocated(OutData%QDT)) deallocate(OutData%QDT) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8888,45 +7946,33 @@ subroutine ED_UnPackContState(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE ED_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(ED_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState - END SUBROUTINE ED_CopyDiscState - - SUBROUTINE ED_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(ED_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyDiscState' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE ED_DestroyDiscState +subroutine ED_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(ED_DiscreteStateType), intent(in) :: SrcDiscStateData + type(ED_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ED_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState +end subroutine +subroutine ED_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(ED_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ED_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine ED_PackDiscState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ED_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'ED_PackDiscState' if (Buf%ErrStat >= AbortErrLev) return - ! DummyDiscState call RegPack(Buf, InData%DummyDiscState) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -8936,49 +7982,36 @@ subroutine ED_UnPackDiscState(Buf, OutData) type(ED_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackDiscState' if (Buf%ErrStat /= ErrID_None) return - ! DummyDiscState call RegUnpack(Buf, OutData%DummyDiscState) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE ED_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(ED_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE ED_CopyConstrState - SUBROUTINE ED_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(ED_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE ED_DestroyConstrState +subroutine ED_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(ED_ConstraintStateType), intent(in) :: SrcConstrStateData + type(ED_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ED_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine +subroutine ED_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(ED_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ED_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine ED_PackConstrState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ED_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'ED_PackConstrState' if (Buf%ErrStat >= AbortErrLev) return - ! DummyConstrState call RegPack(Buf, InData%DummyConstrState) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -8988,71 +8021,64 @@ subroutine ED_UnPackConstrState(Buf, OutData) type(ED_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackConstrState' if (Buf%ErrStat /= ErrID_None) return - ! DummyConstrState call RegUnpack(Buf, OutData%DummyConstrState) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE ED_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(ED_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%n = SrcOtherStateData%n - DO i1 = LBOUND(SrcOtherStateData%xdot,1), UBOUND(SrcOtherStateData%xdot,1) - CALL ED_CopyContState( SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -IF (ALLOCATED(SrcOtherStateData%IC)) THEN - i1_l = LBOUND(SrcOtherStateData%IC,1) - i1_u = UBOUND(SrcOtherStateData%IC,1) - IF (.NOT. ALLOCATED(DstOtherStateData%IC)) THEN - ALLOCATE(DstOtherStateData%IC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%IC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%IC = SrcOtherStateData%IC -ENDIF - DstOtherStateData%HSSBrTrq = SrcOtherStateData%HSSBrTrq - DstOtherStateData%HSSBrTrqC = SrcOtherStateData%HSSBrTrqC - DstOtherStateData%SgnPrvLSTQ = SrcOtherStateData%SgnPrvLSTQ - DstOtherStateData%SgnLSTQ = SrcOtherStateData%SgnLSTQ - END SUBROUTINE ED_CopyOtherState - - SUBROUTINE ED_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(ED_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" -DO i1 = LBOUND(OtherStateData%xdot,1), UBOUND(OtherStateData%xdot,1) - CALL ED_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -IF (ALLOCATED(OtherStateData%IC)) THEN - DEALLOCATE(OtherStateData%IC) -ENDIF - END SUBROUTINE ED_DestroyOtherState +subroutine ED_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(ED_OtherStateType), intent(in) :: SrcOtherStateData + type(ED_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ED_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%n = SrcOtherStateData%n + do i1 = LB(1), UB(1) + call ED_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + if (allocated(SrcOtherStateData%IC)) then + LB(1:1) = lbound(SrcOtherStateData%IC) + UB(1:1) = ubound(SrcOtherStateData%IC) + if (.not. allocated(DstOtherStateData%IC)) then + allocate(DstOtherStateData%IC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%IC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%IC = SrcOtherStateData%IC + else if (allocated(DstOtherStateData%IC)) then + deallocate(DstOtherStateData%IC) + end if + DstOtherStateData%HSSBrTrq = SrcOtherStateData%HSSBrTrq + DstOtherStateData%HSSBrTrqC = SrcOtherStateData%HSSBrTrqC + DstOtherStateData%SgnPrvLSTQ = SrcOtherStateData%SgnPrvLSTQ + DstOtherStateData%SgnLSTQ = SrcOtherStateData%SgnLSTQ +end subroutine +subroutine ED_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(ED_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ED_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OtherStateData%IC)) then + deallocate(OtherStateData%IC) + end if +end subroutine subroutine ED_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -9061,33 +8087,26 @@ subroutine ED_PackOtherState(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! n call RegPack(Buf, InData%n) if (RegCheckErr(Buf, RoutineName)) return - ! xdot LB(1:1) = lbound(InData%xdot) UB(1:1) = ubound(InData%xdot) do i1 = LB(1), UB(1) call ED_PackContState(Buf, InData%xdot(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! IC call RegPack(Buf, allocated(InData%IC)) if (allocated(InData%IC)) then call RegPackBounds(Buf, 1, lbound(InData%IC), ubound(InData%IC)) call RegPack(Buf, InData%IC) end if if (RegCheckErr(Buf, RoutineName)) return - ! HSSBrTrq call RegPack(Buf, InData%HSSBrTrq) if (RegCheckErr(Buf, RoutineName)) return - ! HSSBrTrqC call RegPack(Buf, InData%HSSBrTrqC) if (RegCheckErr(Buf, RoutineName)) return - ! SgnPrvLSTQ call RegPack(Buf, InData%SgnPrvLSTQ) if (RegCheckErr(Buf, RoutineName)) return - ! SgnLSTQ call RegPack(Buf, InData%SgnLSTQ) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -9101,16 +8120,13 @@ subroutine ED_UnPackOtherState(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! n call RegUnpack(Buf, OutData%n) if (RegCheckErr(Buf, RoutineName)) return - ! xdot LB(1:1) = lbound(OutData%xdot) UB(1:1) = ubound(OutData%xdot) do i1 = LB(1), UB(1) call ED_UnpackContState(Buf, OutData%xdot(i1)) ! xdot end do - ! IC if (allocated(OutData%IC)) deallocate(OutData%IC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -9125,234 +8141,218 @@ subroutine ED_UnPackOtherState(Buf, OutData) call RegUnpack(Buf, OutData%IC) if (RegCheckErr(Buf, RoutineName)) return end if - ! HSSBrTrq call RegUnpack(Buf, OutData%HSSBrTrq) if (RegCheckErr(Buf, RoutineName)) return - ! HSSBrTrqC call RegUnpack(Buf, OutData%HSSBrTrqC) if (RegCheckErr(Buf, RoutineName)) return - ! SgnPrvLSTQ call RegUnpack(Buf, OutData%SgnPrvLSTQ) if (RegCheckErr(Buf, RoutineName)) return - ! SgnLSTQ call RegUnpack(Buf, OutData%SgnLSTQ) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE ED_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(ED_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL ED_Copycoordsys( SrcMiscData%CoordSys, DstMiscData%CoordSys, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ED_Copyrthndside( SrcMiscData%RtHS, DstMiscData%RtHS, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMiscData%AllOuts)) THEN - i1_l = LBOUND(SrcMiscData%AllOuts,1) - i1_u = UBOUND(SrcMiscData%AllOuts,1) - IF (.NOT. ALLOCATED(DstMiscData%AllOuts)) THEN - ALLOCATE(DstMiscData%AllOuts(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%AllOuts = SrcMiscData%AllOuts -ENDIF -IF (ALLOCATED(SrcMiscData%AugMat)) THEN - i1_l = LBOUND(SrcMiscData%AugMat,1) - i1_u = UBOUND(SrcMiscData%AugMat,1) - i2_l = LBOUND(SrcMiscData%AugMat,2) - i2_u = UBOUND(SrcMiscData%AugMat,2) - IF (.NOT. ALLOCATED(DstMiscData%AugMat)) THEN - ALLOCATE(DstMiscData%AugMat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AugMat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%AugMat = SrcMiscData%AugMat -ENDIF -IF (ALLOCATED(SrcMiscData%AugMat_factor)) THEN - i1_l = LBOUND(SrcMiscData%AugMat_factor,1) - i1_u = UBOUND(SrcMiscData%AugMat_factor,1) - i2_l = LBOUND(SrcMiscData%AugMat_factor,2) - i2_u = UBOUND(SrcMiscData%AugMat_factor,2) - IF (.NOT. ALLOCATED(DstMiscData%AugMat_factor)) THEN - ALLOCATE(DstMiscData%AugMat_factor(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AugMat_factor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%AugMat_factor = SrcMiscData%AugMat_factor -ENDIF -IF (ALLOCATED(SrcMiscData%SolnVec)) THEN - i1_l = LBOUND(SrcMiscData%SolnVec,1) - i1_u = UBOUND(SrcMiscData%SolnVec,1) - IF (.NOT. ALLOCATED(DstMiscData%SolnVec)) THEN - ALLOCATE(DstMiscData%SolnVec(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SolnVec.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SolnVec = SrcMiscData%SolnVec -ENDIF -IF (ALLOCATED(SrcMiscData%AugMat_pivot)) THEN - i1_l = LBOUND(SrcMiscData%AugMat_pivot,1) - i1_u = UBOUND(SrcMiscData%AugMat_pivot,1) - IF (.NOT. ALLOCATED(DstMiscData%AugMat_pivot)) THEN - ALLOCATE(DstMiscData%AugMat_pivot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AugMat_pivot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%AugMat_pivot = SrcMiscData%AugMat_pivot -ENDIF -IF (ALLOCATED(SrcMiscData%OgnlGeAzRo)) THEN - i1_l = LBOUND(SrcMiscData%OgnlGeAzRo,1) - i1_u = UBOUND(SrcMiscData%OgnlGeAzRo,1) - IF (.NOT. ALLOCATED(DstMiscData%OgnlGeAzRo)) THEN - ALLOCATE(DstMiscData%OgnlGeAzRo(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%OgnlGeAzRo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%OgnlGeAzRo = SrcMiscData%OgnlGeAzRo -ENDIF -IF (ALLOCATED(SrcMiscData%QD2T)) THEN - i1_l = LBOUND(SrcMiscData%QD2T,1) - i1_u = UBOUND(SrcMiscData%QD2T,1) - IF (.NOT. ALLOCATED(DstMiscData%QD2T)) THEN - ALLOCATE(DstMiscData%QD2T(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%QD2T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%QD2T = SrcMiscData%QD2T -ENDIF - DstMiscData%IgnoreMod = SrcMiscData%IgnoreMod - END SUBROUTINE ED_CopyMisc - - SUBROUTINE ED_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(ED_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyMisc' - ErrStat = ErrID_None - ErrMsg = "" - - CALL ED_DestroyCoordSys( MiscData%CoordSys, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ED_DestroyRtHndSide( MiscData%RtHS, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MiscData%AllOuts)) THEN - DEALLOCATE(MiscData%AllOuts) -ENDIF -IF (ALLOCATED(MiscData%AugMat)) THEN - DEALLOCATE(MiscData%AugMat) -ENDIF -IF (ALLOCATED(MiscData%AugMat_factor)) THEN - DEALLOCATE(MiscData%AugMat_factor) -ENDIF -IF (ALLOCATED(MiscData%SolnVec)) THEN - DEALLOCATE(MiscData%SolnVec) -ENDIF -IF (ALLOCATED(MiscData%AugMat_pivot)) THEN - DEALLOCATE(MiscData%AugMat_pivot) -ENDIF -IF (ALLOCATED(MiscData%OgnlGeAzRo)) THEN - DEALLOCATE(MiscData%OgnlGeAzRo) -ENDIF -IF (ALLOCATED(MiscData%QD2T)) THEN - DEALLOCATE(MiscData%QD2T) -ENDIF - END SUBROUTINE ED_DestroyMisc +subroutine ED_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(ED_MiscVarType), intent(in) :: SrcMiscData + type(ED_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ED_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + call ED_CopyCoordSys(SrcMiscData%CoordSys, DstMiscData%CoordSys, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ED_CopyRtHndSide(SrcMiscData%RtHS, DstMiscData%RtHS, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMiscData%AllOuts)) then + LB(1:1) = lbound(SrcMiscData%AllOuts) + UB(1:1) = ubound(SrcMiscData%AllOuts) + if (.not. allocated(DstMiscData%AllOuts)) then + allocate(DstMiscData%AllOuts(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%AllOuts = SrcMiscData%AllOuts + else if (allocated(DstMiscData%AllOuts)) then + deallocate(DstMiscData%AllOuts) + end if + if (allocated(SrcMiscData%AugMat)) then + LB(1:2) = lbound(SrcMiscData%AugMat) + UB(1:2) = ubound(SrcMiscData%AugMat) + if (.not. allocated(DstMiscData%AugMat)) then + allocate(DstMiscData%AugMat(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AugMat.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%AugMat = SrcMiscData%AugMat + else if (allocated(DstMiscData%AugMat)) then + deallocate(DstMiscData%AugMat) + end if + if (allocated(SrcMiscData%AugMat_factor)) then + LB(1:2) = lbound(SrcMiscData%AugMat_factor) + UB(1:2) = ubound(SrcMiscData%AugMat_factor) + if (.not. allocated(DstMiscData%AugMat_factor)) then + allocate(DstMiscData%AugMat_factor(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AugMat_factor.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%AugMat_factor = SrcMiscData%AugMat_factor + else if (allocated(DstMiscData%AugMat_factor)) then + deallocate(DstMiscData%AugMat_factor) + end if + if (allocated(SrcMiscData%SolnVec)) then + LB(1:1) = lbound(SrcMiscData%SolnVec) + UB(1:1) = ubound(SrcMiscData%SolnVec) + if (.not. allocated(DstMiscData%SolnVec)) then + allocate(DstMiscData%SolnVec(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SolnVec.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%SolnVec = SrcMiscData%SolnVec + else if (allocated(DstMiscData%SolnVec)) then + deallocate(DstMiscData%SolnVec) + end if + if (allocated(SrcMiscData%AugMat_pivot)) then + LB(1:1) = lbound(SrcMiscData%AugMat_pivot) + UB(1:1) = ubound(SrcMiscData%AugMat_pivot) + if (.not. allocated(DstMiscData%AugMat_pivot)) then + allocate(DstMiscData%AugMat_pivot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AugMat_pivot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%AugMat_pivot = SrcMiscData%AugMat_pivot + else if (allocated(DstMiscData%AugMat_pivot)) then + deallocate(DstMiscData%AugMat_pivot) + end if + if (allocated(SrcMiscData%OgnlGeAzRo)) then + LB(1:1) = lbound(SrcMiscData%OgnlGeAzRo) + UB(1:1) = ubound(SrcMiscData%OgnlGeAzRo) + if (.not. allocated(DstMiscData%OgnlGeAzRo)) then + allocate(DstMiscData%OgnlGeAzRo(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%OgnlGeAzRo.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%OgnlGeAzRo = SrcMiscData%OgnlGeAzRo + else if (allocated(DstMiscData%OgnlGeAzRo)) then + deallocate(DstMiscData%OgnlGeAzRo) + end if + if (allocated(SrcMiscData%QD2T)) then + LB(1:1) = lbound(SrcMiscData%QD2T) + UB(1:1) = ubound(SrcMiscData%QD2T) + if (.not. allocated(DstMiscData%QD2T)) then + allocate(DstMiscData%QD2T(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%QD2T.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%QD2T = SrcMiscData%QD2T + else if (allocated(DstMiscData%QD2T)) then + deallocate(DstMiscData%QD2T) + end if + DstMiscData%IgnoreMod = SrcMiscData%IgnoreMod +end subroutine +subroutine ED_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(ED_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ED_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%AllOuts)) then + deallocate(MiscData%AllOuts) + end if + if (allocated(MiscData%AugMat)) then + deallocate(MiscData%AugMat) + end if + if (allocated(MiscData%AugMat_factor)) then + deallocate(MiscData%AugMat_factor) + end if + if (allocated(MiscData%SolnVec)) then + deallocate(MiscData%SolnVec) + end if + if (allocated(MiscData%AugMat_pivot)) then + deallocate(MiscData%AugMat_pivot) + end if + if (allocated(MiscData%OgnlGeAzRo)) then + deallocate(MiscData%OgnlGeAzRo) + end if + if (allocated(MiscData%QD2T)) then + deallocate(MiscData%QD2T) + end if +end subroutine subroutine ED_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ED_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'ED_PackMisc' if (Buf%ErrStat >= AbortErrLev) return - ! CoordSys call ED_PackCoordSys(Buf, InData%CoordSys) if (RegCheckErr(Buf, RoutineName)) return - ! RtHS call ED_PackRtHndSide(Buf, InData%RtHS) if (RegCheckErr(Buf, RoutineName)) return - ! AllOuts call RegPack(Buf, allocated(InData%AllOuts)) if (allocated(InData%AllOuts)) then call RegPackBounds(Buf, 1, lbound(InData%AllOuts), ubound(InData%AllOuts)) call RegPack(Buf, InData%AllOuts) end if if (RegCheckErr(Buf, RoutineName)) return - ! AugMat call RegPack(Buf, allocated(InData%AugMat)) if (allocated(InData%AugMat)) then call RegPackBounds(Buf, 2, lbound(InData%AugMat), ubound(InData%AugMat)) call RegPack(Buf, InData%AugMat) end if if (RegCheckErr(Buf, RoutineName)) return - ! AugMat_factor call RegPack(Buf, allocated(InData%AugMat_factor)) if (allocated(InData%AugMat_factor)) then call RegPackBounds(Buf, 2, lbound(InData%AugMat_factor), ubound(InData%AugMat_factor)) call RegPack(Buf, InData%AugMat_factor) end if if (RegCheckErr(Buf, RoutineName)) return - ! SolnVec call RegPack(Buf, allocated(InData%SolnVec)) if (allocated(InData%SolnVec)) then call RegPackBounds(Buf, 1, lbound(InData%SolnVec), ubound(InData%SolnVec)) call RegPack(Buf, InData%SolnVec) end if if (RegCheckErr(Buf, RoutineName)) return - ! AugMat_pivot call RegPack(Buf, allocated(InData%AugMat_pivot)) if (allocated(InData%AugMat_pivot)) then call RegPackBounds(Buf, 1, lbound(InData%AugMat_pivot), ubound(InData%AugMat_pivot)) call RegPack(Buf, InData%AugMat_pivot) end if if (RegCheckErr(Buf, RoutineName)) return - ! OgnlGeAzRo call RegPack(Buf, allocated(InData%OgnlGeAzRo)) if (allocated(InData%OgnlGeAzRo)) then call RegPackBounds(Buf, 1, lbound(InData%OgnlGeAzRo), ubound(InData%OgnlGeAzRo)) call RegPack(Buf, InData%OgnlGeAzRo) end if if (RegCheckErr(Buf, RoutineName)) return - ! QD2T call RegPack(Buf, allocated(InData%QD2T)) if (allocated(InData%QD2T)) then call RegPackBounds(Buf, 1, lbound(InData%QD2T), ubound(InData%QD2T)) call RegPack(Buf, InData%QD2T) end if if (RegCheckErr(Buf, RoutineName)) return - ! IgnoreMod call RegPack(Buf, InData%IgnoreMod) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -9365,11 +8365,8 @@ subroutine ED_UnPackMisc(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! CoordSys call ED_UnpackCoordSys(Buf, OutData%CoordSys) ! CoordSys - ! RtHS call ED_UnpackRtHndSide(Buf, OutData%RtHS) ! RtHS - ! AllOuts if (allocated(OutData%AllOuts)) deallocate(OutData%AllOuts) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -9384,7 +8381,6 @@ subroutine ED_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%AllOuts) if (RegCheckErr(Buf, RoutineName)) return end if - ! AugMat if (allocated(OutData%AugMat)) deallocate(OutData%AugMat) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -9399,7 +8395,6 @@ subroutine ED_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%AugMat) if (RegCheckErr(Buf, RoutineName)) return end if - ! AugMat_factor if (allocated(OutData%AugMat_factor)) deallocate(OutData%AugMat_factor) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -9414,7 +8409,6 @@ subroutine ED_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%AugMat_factor) if (RegCheckErr(Buf, RoutineName)) return end if - ! SolnVec if (allocated(OutData%SolnVec)) deallocate(OutData%SolnVec) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -9429,7 +8423,6 @@ subroutine ED_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%SolnVec) if (RegCheckErr(Buf, RoutineName)) return end if - ! AugMat_pivot if (allocated(OutData%AugMat_pivot)) deallocate(OutData%AugMat_pivot) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -9444,7 +8437,6 @@ subroutine ED_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%AugMat_pivot) if (RegCheckErr(Buf, RoutineName)) return end if - ! OgnlGeAzRo if (allocated(OutData%OgnlGeAzRo)) deallocate(OutData%OgnlGeAzRo) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -9459,7 +8451,6 @@ subroutine ED_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%OgnlGeAzRo) if (RegCheckErr(Buf, RoutineName)) return end if - ! QD2T if (allocated(OutData%QD2T)) deallocate(OutData%QD2T) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -9474,1186 +8465,1205 @@ subroutine ED_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%QD2T) if (RegCheckErr(Buf, RoutineName)) return end if - ! IgnoreMod call RegUnpack(Buf, OutData%IgnoreMod) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE ED_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_ParameterType), INTENT(IN) :: SrcParamData - TYPE(ED_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT - DstParamData%DT24 = SrcParamData%DT24 - DstParamData%BldNodes = SrcParamData%BldNodes - DstParamData%TipNode = SrcParamData%TipNode - DstParamData%NDOF = SrcParamData%NDOF - DstParamData%TwoPiNB = SrcParamData%TwoPiNB - DstParamData%NAug = SrcParamData%NAug - DstParamData%NPH = SrcParamData%NPH -IF (ALLOCATED(SrcParamData%PH)) THEN - i1_l = LBOUND(SrcParamData%PH,1) - i1_u = UBOUND(SrcParamData%PH,1) - IF (.NOT. ALLOCATED(DstParamData%PH)) THEN - ALLOCATE(DstParamData%PH(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PH.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%PH = SrcParamData%PH -ENDIF - DstParamData%NPM = SrcParamData%NPM -IF (ALLOCATED(SrcParamData%PM)) THEN - i1_l = LBOUND(SrcParamData%PM,1) - i1_u = UBOUND(SrcParamData%PM,1) - i2_l = LBOUND(SrcParamData%PM,2) - i2_u = UBOUND(SrcParamData%PM,2) - IF (.NOT. ALLOCATED(DstParamData%PM)) THEN - ALLOCATE(DstParamData%PM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%PM = SrcParamData%PM -ENDIF -IF (ALLOCATED(SrcParamData%DOF_Flag)) THEN - i1_l = LBOUND(SrcParamData%DOF_Flag,1) - i1_u = UBOUND(SrcParamData%DOF_Flag,1) - IF (.NOT. ALLOCATED(DstParamData%DOF_Flag)) THEN - ALLOCATE(DstParamData%DOF_Flag(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DOF_Flag.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%DOF_Flag = SrcParamData%DOF_Flag -ENDIF -IF (ALLOCATED(SrcParamData%DOF_Desc)) THEN - i1_l = LBOUND(SrcParamData%DOF_Desc,1) - i1_u = UBOUND(SrcParamData%DOF_Desc,1) - IF (.NOT. ALLOCATED(DstParamData%DOF_Desc)) THEN - ALLOCATE(DstParamData%DOF_Desc(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DOF_Desc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%DOF_Desc = SrcParamData%DOF_Desc -ENDIF - CALL ED_Copyactivedofs( SrcParamData%DOFs, DstParamData%DOFs, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%OutFmt = SrcParamData%OutFmt - DstParamData%NBlGages = SrcParamData%NBlGages - DstParamData%NTwGages = SrcParamData%NTwGages -IF (ALLOCATED(SrcParamData%OutParam)) THEN - i1_l = LBOUND(SrcParamData%OutParam,1) - i1_u = UBOUND(SrcParamData%OutParam,1) - IF (.NOT. ALLOCATED(DstParamData%OutParam)) THEN - ALLOCATE(DstParamData%OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%OutParam,1), UBOUND(SrcParamData%OutParam,1) - CALL NWTC_Library_Copyoutparmtype( SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstParamData%Delim = SrcParamData%Delim - DstParamData%AvgNrmTpRd = SrcParamData%AvgNrmTpRd - DstParamData%AzimB1Up = SrcParamData%AzimB1Up - DstParamData%CosDel3 = SrcParamData%CosDel3 -IF (ALLOCATED(SrcParamData%CosPreC)) THEN - i1_l = LBOUND(SrcParamData%CosPreC,1) - i1_u = UBOUND(SrcParamData%CosPreC,1) - IF (.NOT. ALLOCATED(DstParamData%CosPreC)) THEN - ALLOCATE(DstParamData%CosPreC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CosPreC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CosPreC = SrcParamData%CosPreC -ENDIF - DstParamData%CRFrlSkew = SrcParamData%CRFrlSkew - DstParamData%CRFrlSkw2 = SrcParamData%CRFrlSkw2 - DstParamData%CRFrlTilt = SrcParamData%CRFrlTilt - DstParamData%CRFrlTlt2 = SrcParamData%CRFrlTlt2 - DstParamData%CShftSkew = SrcParamData%CShftSkew - DstParamData%CShftTilt = SrcParamData%CShftTilt - DstParamData%CSRFrlSkw = SrcParamData%CSRFrlSkw - DstParamData%CSRFrlTlt = SrcParamData%CSRFrlTlt - DstParamData%CSTFrlSkw = SrcParamData%CSTFrlSkw - DstParamData%CSTFrlTlt = SrcParamData%CSTFrlTlt - DstParamData%CTFrlSkew = SrcParamData%CTFrlSkew - DstParamData%CTFrlSkw2 = SrcParamData%CTFrlSkw2 - DstParamData%CTFrlTilt = SrcParamData%CTFrlTilt - DstParamData%CTFrlTlt2 = SrcParamData%CTFrlTlt2 - DstParamData%HubHt = SrcParamData%HubHt - DstParamData%HubCM = SrcParamData%HubCM - DstParamData%HubRad = SrcParamData%HubRad - DstParamData%NacCMxn = SrcParamData%NacCMxn - DstParamData%NacCMyn = SrcParamData%NacCMyn - DstParamData%NacCMzn = SrcParamData%NacCMzn - DstParamData%OverHang = SrcParamData%OverHang - DstParamData%ProjArea = SrcParamData%ProjArea - DstParamData%PtfmRefzt = SrcParamData%PtfmRefzt - DstParamData%RefTwrHt = SrcParamData%RefTwrHt - DstParamData%RFrlPnt_n = SrcParamData%RFrlPnt_n - DstParamData%rVDxn = SrcParamData%rVDxn - DstParamData%rVDyn = SrcParamData%rVDyn - DstParamData%rVDzn = SrcParamData%rVDzn - DstParamData%rVIMUxn = SrcParamData%rVIMUxn - DstParamData%rVIMUyn = SrcParamData%rVIMUyn - DstParamData%rVIMUzn = SrcParamData%rVIMUzn - DstParamData%rVPxn = SrcParamData%rVPxn - DstParamData%rVPyn = SrcParamData%rVPyn - DstParamData%rVPzn = SrcParamData%rVPzn - DstParamData%rWIxn = SrcParamData%rWIxn - DstParamData%rWIyn = SrcParamData%rWIyn - DstParamData%rWIzn = SrcParamData%rWIzn - DstParamData%rWJxn = SrcParamData%rWJxn - DstParamData%rWJyn = SrcParamData%rWJyn - DstParamData%rWJzn = SrcParamData%rWJzn - DstParamData%rZT0zt = SrcParamData%rZT0zt - DstParamData%rZYzt = SrcParamData%rZYzt - DstParamData%SinDel3 = SrcParamData%SinDel3 -IF (ALLOCATED(SrcParamData%SinPreC)) THEN - i1_l = LBOUND(SrcParamData%SinPreC,1) - i1_u = UBOUND(SrcParamData%SinPreC,1) - IF (.NOT. ALLOCATED(DstParamData%SinPreC)) THEN - ALLOCATE(DstParamData%SinPreC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%SinPreC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%SinPreC = SrcParamData%SinPreC -ENDIF - DstParamData%SRFrlSkew = SrcParamData%SRFrlSkew - DstParamData%SRFrlSkw2 = SrcParamData%SRFrlSkw2 - DstParamData%SRFrlTilt = SrcParamData%SRFrlTilt - DstParamData%SRFrlTlt2 = SrcParamData%SRFrlTlt2 - DstParamData%SShftSkew = SrcParamData%SShftSkew - DstParamData%SShftTilt = SrcParamData%SShftTilt - DstParamData%STFrlSkew = SrcParamData%STFrlSkew - DstParamData%STFrlSkw2 = SrcParamData%STFrlSkw2 - DstParamData%STFrlTilt = SrcParamData%STFrlTilt - DstParamData%STFrlTlt2 = SrcParamData%STFrlTlt2 - DstParamData%TFrlPnt_n = SrcParamData%TFrlPnt_n - DstParamData%TipRad = SrcParamData%TipRad - DstParamData%TowerHt = SrcParamData%TowerHt - DstParamData%TowerBsHt = SrcParamData%TowerBsHt - DstParamData%UndSling = SrcParamData%UndSling - DstParamData%NumBl = SrcParamData%NumBl -IF (ALLOCATED(SrcParamData%AxRedTFA)) THEN - i1_l = LBOUND(SrcParamData%AxRedTFA,1) - i1_u = UBOUND(SrcParamData%AxRedTFA,1) - i2_l = LBOUND(SrcParamData%AxRedTFA,2) - i2_u = UBOUND(SrcParamData%AxRedTFA,2) - i3_l = LBOUND(SrcParamData%AxRedTFA,3) - i3_u = UBOUND(SrcParamData%AxRedTFA,3) - IF (.NOT. ALLOCATED(DstParamData%AxRedTFA)) THEN - ALLOCATE(DstParamData%AxRedTFA(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AxRedTFA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AxRedTFA = SrcParamData%AxRedTFA -ENDIF -IF (ALLOCATED(SrcParamData%AxRedTSS)) THEN - i1_l = LBOUND(SrcParamData%AxRedTSS,1) - i1_u = UBOUND(SrcParamData%AxRedTSS,1) - i2_l = LBOUND(SrcParamData%AxRedTSS,2) - i2_u = UBOUND(SrcParamData%AxRedTSS,2) - i3_l = LBOUND(SrcParamData%AxRedTSS,3) - i3_u = UBOUND(SrcParamData%AxRedTSS,3) - IF (.NOT. ALLOCATED(DstParamData%AxRedTSS)) THEN - ALLOCATE(DstParamData%AxRedTSS(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AxRedTSS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AxRedTSS = SrcParamData%AxRedTSS -ENDIF - DstParamData%CTFA = SrcParamData%CTFA - DstParamData%CTSS = SrcParamData%CTSS -IF (ALLOCATED(SrcParamData%DHNodes)) THEN - i1_l = LBOUND(SrcParamData%DHNodes,1) - i1_u = UBOUND(SrcParamData%DHNodes,1) - IF (.NOT. ALLOCATED(DstParamData%DHNodes)) THEN - ALLOCATE(DstParamData%DHNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DHNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%DHNodes = SrcParamData%DHNodes -ENDIF -IF (ALLOCATED(SrcParamData%HNodes)) THEN - i1_l = LBOUND(SrcParamData%HNodes,1) - i1_u = UBOUND(SrcParamData%HNodes,1) - IF (.NOT. ALLOCATED(DstParamData%HNodes)) THEN - ALLOCATE(DstParamData%HNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%HNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%HNodes = SrcParamData%HNodes -ENDIF -IF (ALLOCATED(SrcParamData%HNodesNorm)) THEN - i1_l = LBOUND(SrcParamData%HNodesNorm,1) - i1_u = UBOUND(SrcParamData%HNodesNorm,1) - IF (.NOT. ALLOCATED(DstParamData%HNodesNorm)) THEN - ALLOCATE(DstParamData%HNodesNorm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%HNodesNorm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%HNodesNorm = SrcParamData%HNodesNorm -ENDIF - DstParamData%KTFA = SrcParamData%KTFA - DstParamData%KTSS = SrcParamData%KTSS -IF (ALLOCATED(SrcParamData%MassT)) THEN - i1_l = LBOUND(SrcParamData%MassT,1) - i1_u = UBOUND(SrcParamData%MassT,1) - IF (.NOT. ALLOCATED(DstParamData%MassT)) THEN - ALLOCATE(DstParamData%MassT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MassT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%MassT = SrcParamData%MassT -ENDIF -IF (ALLOCATED(SrcParamData%StiffTSS)) THEN - i1_l = LBOUND(SrcParamData%StiffTSS,1) - i1_u = UBOUND(SrcParamData%StiffTSS,1) - IF (.NOT. ALLOCATED(DstParamData%StiffTSS)) THEN - ALLOCATE(DstParamData%StiffTSS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StiffTSS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%StiffTSS = SrcParamData%StiffTSS -ENDIF -IF (ALLOCATED(SrcParamData%TwrFASF)) THEN - i1_l = LBOUND(SrcParamData%TwrFASF,1) - i1_u = UBOUND(SrcParamData%TwrFASF,1) - i2_l = LBOUND(SrcParamData%TwrFASF,2) - i2_u = UBOUND(SrcParamData%TwrFASF,2) - i3_l = LBOUND(SrcParamData%TwrFASF,3) - i3_u = UBOUND(SrcParamData%TwrFASF,3) - IF (.NOT. ALLOCATED(DstParamData%TwrFASF)) THEN - ALLOCATE(DstParamData%TwrFASF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TwrFASF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TwrFASF = SrcParamData%TwrFASF -ENDIF - DstParamData%TwrFlexL = SrcParamData%TwrFlexL -IF (ALLOCATED(SrcParamData%TwrSSSF)) THEN - i1_l = LBOUND(SrcParamData%TwrSSSF,1) - i1_u = UBOUND(SrcParamData%TwrSSSF,1) - i2_l = LBOUND(SrcParamData%TwrSSSF,2) - i2_u = UBOUND(SrcParamData%TwrSSSF,2) - i3_l = LBOUND(SrcParamData%TwrSSSF,3) - i3_u = UBOUND(SrcParamData%TwrSSSF,3) - IF (.NOT. ALLOCATED(DstParamData%TwrSSSF)) THEN - ALLOCATE(DstParamData%TwrSSSF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TwrSSSF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TwrSSSF = SrcParamData%TwrSSSF -ENDIF - DstParamData%TTopNode = SrcParamData%TTopNode - DstParamData%TwrNodes = SrcParamData%TwrNodes - DstParamData%MHK = SrcParamData%MHK -IF (ALLOCATED(SrcParamData%StiffTFA)) THEN - i1_l = LBOUND(SrcParamData%StiffTFA,1) - i1_u = UBOUND(SrcParamData%StiffTFA,1) - IF (.NOT. ALLOCATED(DstParamData%StiffTFA)) THEN - ALLOCATE(DstParamData%StiffTFA(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StiffTFA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%StiffTFA = SrcParamData%StiffTFA -ENDIF - DstParamData%AtfaIner = SrcParamData%AtfaIner -IF (ALLOCATED(SrcParamData%BldCG)) THEN - i1_l = LBOUND(SrcParamData%BldCG,1) - i1_u = UBOUND(SrcParamData%BldCG,1) - IF (.NOT. ALLOCATED(DstParamData%BldCG)) THEN - ALLOCATE(DstParamData%BldCG(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldCG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BldCG = SrcParamData%BldCG -ENDIF -IF (ALLOCATED(SrcParamData%BldMass)) THEN - i1_l = LBOUND(SrcParamData%BldMass,1) - i1_u = UBOUND(SrcParamData%BldMass,1) - IF (.NOT. ALLOCATED(DstParamData%BldMass)) THEN - ALLOCATE(DstParamData%BldMass(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldMass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BldMass = SrcParamData%BldMass -ENDIF - DstParamData%BoomMass = SrcParamData%BoomMass -IF (ALLOCATED(SrcParamData%FirstMom)) THEN - i1_l = LBOUND(SrcParamData%FirstMom,1) - i1_u = UBOUND(SrcParamData%FirstMom,1) - IF (.NOT. ALLOCATED(DstParamData%FirstMom)) THEN - ALLOCATE(DstParamData%FirstMom(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FirstMom.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FirstMom = SrcParamData%FirstMom -ENDIF - DstParamData%GenIner = SrcParamData%GenIner - DstParamData%Hubg1Iner = SrcParamData%Hubg1Iner - DstParamData%Hubg2Iner = SrcParamData%Hubg2Iner - DstParamData%HubMass = SrcParamData%HubMass - DstParamData%Nacd2Iner = SrcParamData%Nacd2Iner - DstParamData%NacMass = SrcParamData%NacMass - DstParamData%PtfmMass = SrcParamData%PtfmMass - DstParamData%PtfmPIner = SrcParamData%PtfmPIner - DstParamData%PtfmRIner = SrcParamData%PtfmRIner - DstParamData%PtfmYIner = SrcParamData%PtfmYIner - DstParamData%RFrlMass = SrcParamData%RFrlMass - DstParamData%RotIner = SrcParamData%RotIner - DstParamData%RotMass = SrcParamData%RotMass - DstParamData%RrfaIner = SrcParamData%RrfaIner -IF (ALLOCATED(SrcParamData%SecondMom)) THEN - i1_l = LBOUND(SrcParamData%SecondMom,1) - i1_u = UBOUND(SrcParamData%SecondMom,1) - IF (.NOT. ALLOCATED(DstParamData%SecondMom)) THEN - ALLOCATE(DstParamData%SecondMom(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%SecondMom.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%SecondMom = SrcParamData%SecondMom -ENDIF - DstParamData%TFinMass = SrcParamData%TFinMass - DstParamData%TFrlIner = SrcParamData%TFrlIner -IF (ALLOCATED(SrcParamData%TipMass)) THEN - i1_l = LBOUND(SrcParamData%TipMass,1) - i1_u = UBOUND(SrcParamData%TipMass,1) - IF (.NOT. ALLOCATED(DstParamData%TipMass)) THEN - ALLOCATE(DstParamData%TipMass(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TipMass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TipMass = SrcParamData%TipMass -ENDIF - DstParamData%TurbMass = SrcParamData%TurbMass - DstParamData%TwrMass = SrcParamData%TwrMass - DstParamData%TwrTpMass = SrcParamData%TwrTpMass - DstParamData%YawBrMass = SrcParamData%YawBrMass - DstParamData%Gravity = SrcParamData%Gravity -IF (ALLOCATED(SrcParamData%PitchAxis)) THEN - i1_l = LBOUND(SrcParamData%PitchAxis,1) - i1_u = UBOUND(SrcParamData%PitchAxis,1) - i2_l = LBOUND(SrcParamData%PitchAxis,2) - i2_u = UBOUND(SrcParamData%PitchAxis,2) - IF (.NOT. ALLOCATED(DstParamData%PitchAxis)) THEN - ALLOCATE(DstParamData%PitchAxis(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PitchAxis.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%PitchAxis = SrcParamData%PitchAxis -ENDIF -IF (ALLOCATED(SrcParamData%AeroTwst)) THEN - i1_l = LBOUND(SrcParamData%AeroTwst,1) - i1_u = UBOUND(SrcParamData%AeroTwst,1) - IF (.NOT. ALLOCATED(DstParamData%AeroTwst)) THEN - ALLOCATE(DstParamData%AeroTwst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AeroTwst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AeroTwst = SrcParamData%AeroTwst -ENDIF -IF (ALLOCATED(SrcParamData%AxRedBld)) THEN - i1_l = LBOUND(SrcParamData%AxRedBld,1) - i1_u = UBOUND(SrcParamData%AxRedBld,1) - i2_l = LBOUND(SrcParamData%AxRedBld,2) - i2_u = UBOUND(SrcParamData%AxRedBld,2) - i3_l = LBOUND(SrcParamData%AxRedBld,3) - i3_u = UBOUND(SrcParamData%AxRedBld,3) - i4_l = LBOUND(SrcParamData%AxRedBld,4) - i4_u = UBOUND(SrcParamData%AxRedBld,4) - IF (.NOT. ALLOCATED(DstParamData%AxRedBld)) THEN - ALLOCATE(DstParamData%AxRedBld(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AxRedBld.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AxRedBld = SrcParamData%AxRedBld -ENDIF -IF (ALLOCATED(SrcParamData%BldEDamp)) THEN - i1_l = LBOUND(SrcParamData%BldEDamp,1) - i1_u = UBOUND(SrcParamData%BldEDamp,1) - i2_l = LBOUND(SrcParamData%BldEDamp,2) - i2_u = UBOUND(SrcParamData%BldEDamp,2) - IF (.NOT. ALLOCATED(DstParamData%BldEDamp)) THEN - ALLOCATE(DstParamData%BldEDamp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldEDamp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BldEDamp = SrcParamData%BldEDamp -ENDIF -IF (ALLOCATED(SrcParamData%BldFDamp)) THEN - i1_l = LBOUND(SrcParamData%BldFDamp,1) - i1_u = UBOUND(SrcParamData%BldFDamp,1) - i2_l = LBOUND(SrcParamData%BldFDamp,2) - i2_u = UBOUND(SrcParamData%BldFDamp,2) - IF (.NOT. ALLOCATED(DstParamData%BldFDamp)) THEN - ALLOCATE(DstParamData%BldFDamp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldFDamp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BldFDamp = SrcParamData%BldFDamp -ENDIF - DstParamData%BldFlexL = SrcParamData%BldFlexL -IF (ALLOCATED(SrcParamData%CAeroTwst)) THEN - i1_l = LBOUND(SrcParamData%CAeroTwst,1) - i1_u = UBOUND(SrcParamData%CAeroTwst,1) - IF (.NOT. ALLOCATED(DstParamData%CAeroTwst)) THEN - ALLOCATE(DstParamData%CAeroTwst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CAeroTwst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CAeroTwst = SrcParamData%CAeroTwst -ENDIF -IF (ALLOCATED(SrcParamData%CBE)) THEN - i1_l = LBOUND(SrcParamData%CBE,1) - i1_u = UBOUND(SrcParamData%CBE,1) - i2_l = LBOUND(SrcParamData%CBE,2) - i2_u = UBOUND(SrcParamData%CBE,2) - i3_l = LBOUND(SrcParamData%CBE,3) - i3_u = UBOUND(SrcParamData%CBE,3) - IF (.NOT. ALLOCATED(DstParamData%CBE)) THEN - ALLOCATE(DstParamData%CBE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CBE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CBE = SrcParamData%CBE -ENDIF -IF (ALLOCATED(SrcParamData%CBF)) THEN - i1_l = LBOUND(SrcParamData%CBF,1) - i1_u = UBOUND(SrcParamData%CBF,1) - i2_l = LBOUND(SrcParamData%CBF,2) - i2_u = UBOUND(SrcParamData%CBF,2) - i3_l = LBOUND(SrcParamData%CBF,3) - i3_u = UBOUND(SrcParamData%CBF,3) - IF (.NOT. ALLOCATED(DstParamData%CBF)) THEN - ALLOCATE(DstParamData%CBF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CBF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CBF = SrcParamData%CBF -ENDIF -IF (ALLOCATED(SrcParamData%Chord)) THEN - i1_l = LBOUND(SrcParamData%Chord,1) - i1_u = UBOUND(SrcParamData%Chord,1) - IF (.NOT. ALLOCATED(DstParamData%Chord)) THEN - ALLOCATE(DstParamData%Chord(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Chord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Chord = SrcParamData%Chord -ENDIF -IF (ALLOCATED(SrcParamData%CThetaS)) THEN - i1_l = LBOUND(SrcParamData%CThetaS,1) - i1_u = UBOUND(SrcParamData%CThetaS,1) - i2_l = LBOUND(SrcParamData%CThetaS,2) - i2_u = UBOUND(SrcParamData%CThetaS,2) - IF (.NOT. ALLOCATED(DstParamData%CThetaS)) THEN - ALLOCATE(DstParamData%CThetaS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CThetaS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CThetaS = SrcParamData%CThetaS -ENDIF -IF (ALLOCATED(SrcParamData%DRNodes)) THEN - i1_l = LBOUND(SrcParamData%DRNodes,1) - i1_u = UBOUND(SrcParamData%DRNodes,1) - IF (.NOT. ALLOCATED(DstParamData%DRNodes)) THEN - ALLOCATE(DstParamData%DRNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DRNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%DRNodes = SrcParamData%DRNodes -ENDIF -IF (ALLOCATED(SrcParamData%FStTunr)) THEN - i1_l = LBOUND(SrcParamData%FStTunr,1) - i1_u = UBOUND(SrcParamData%FStTunr,1) - i2_l = LBOUND(SrcParamData%FStTunr,2) - i2_u = UBOUND(SrcParamData%FStTunr,2) - IF (.NOT. ALLOCATED(DstParamData%FStTunr)) THEN - ALLOCATE(DstParamData%FStTunr(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FStTunr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FStTunr = SrcParamData%FStTunr -ENDIF -IF (ALLOCATED(SrcParamData%KBE)) THEN - i1_l = LBOUND(SrcParamData%KBE,1) - i1_u = UBOUND(SrcParamData%KBE,1) - i2_l = LBOUND(SrcParamData%KBE,2) - i2_u = UBOUND(SrcParamData%KBE,2) - i3_l = LBOUND(SrcParamData%KBE,3) - i3_u = UBOUND(SrcParamData%KBE,3) - IF (.NOT. ALLOCATED(DstParamData%KBE)) THEN - ALLOCATE(DstParamData%KBE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KBE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%KBE = SrcParamData%KBE -ENDIF -IF (ALLOCATED(SrcParamData%KBF)) THEN - i1_l = LBOUND(SrcParamData%KBF,1) - i1_u = UBOUND(SrcParamData%KBF,1) - i2_l = LBOUND(SrcParamData%KBF,2) - i2_u = UBOUND(SrcParamData%KBF,2) - i3_l = LBOUND(SrcParamData%KBF,3) - i3_u = UBOUND(SrcParamData%KBF,3) - IF (.NOT. ALLOCATED(DstParamData%KBF)) THEN - ALLOCATE(DstParamData%KBF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KBF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%KBF = SrcParamData%KBF -ENDIF -IF (ALLOCATED(SrcParamData%MassB)) THEN - i1_l = LBOUND(SrcParamData%MassB,1) - i1_u = UBOUND(SrcParamData%MassB,1) - i2_l = LBOUND(SrcParamData%MassB,2) - i2_u = UBOUND(SrcParamData%MassB,2) - IF (.NOT. ALLOCATED(DstParamData%MassB)) THEN - ALLOCATE(DstParamData%MassB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MassB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%MassB = SrcParamData%MassB -ENDIF -IF (ALLOCATED(SrcParamData%RNodes)) THEN - i1_l = LBOUND(SrcParamData%RNodes,1) - i1_u = UBOUND(SrcParamData%RNodes,1) - IF (.NOT. ALLOCATED(DstParamData%RNodes)) THEN - ALLOCATE(DstParamData%RNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%RNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%RNodes = SrcParamData%RNodes -ENDIF -IF (ALLOCATED(SrcParamData%RNodesNorm)) THEN - i1_l = LBOUND(SrcParamData%RNodesNorm,1) - i1_u = UBOUND(SrcParamData%RNodesNorm,1) - IF (.NOT. ALLOCATED(DstParamData%RNodesNorm)) THEN - ALLOCATE(DstParamData%RNodesNorm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%RNodesNorm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%RNodesNorm = SrcParamData%RNodesNorm -ENDIF -IF (ALLOCATED(SrcParamData%rSAerCenn1)) THEN - i1_l = LBOUND(SrcParamData%rSAerCenn1,1) - i1_u = UBOUND(SrcParamData%rSAerCenn1,1) - i2_l = LBOUND(SrcParamData%rSAerCenn1,2) - i2_u = UBOUND(SrcParamData%rSAerCenn1,2) - IF (.NOT. ALLOCATED(DstParamData%rSAerCenn1)) THEN - ALLOCATE(DstParamData%rSAerCenn1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rSAerCenn1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%rSAerCenn1 = SrcParamData%rSAerCenn1 -ENDIF -IF (ALLOCATED(SrcParamData%rSAerCenn2)) THEN - i1_l = LBOUND(SrcParamData%rSAerCenn2,1) - i1_u = UBOUND(SrcParamData%rSAerCenn2,1) - i2_l = LBOUND(SrcParamData%rSAerCenn2,2) - i2_u = UBOUND(SrcParamData%rSAerCenn2,2) - IF (.NOT. ALLOCATED(DstParamData%rSAerCenn2)) THEN - ALLOCATE(DstParamData%rSAerCenn2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rSAerCenn2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%rSAerCenn2 = SrcParamData%rSAerCenn2 -ENDIF -IF (ALLOCATED(SrcParamData%SAeroTwst)) THEN - i1_l = LBOUND(SrcParamData%SAeroTwst,1) - i1_u = UBOUND(SrcParamData%SAeroTwst,1) - IF (.NOT. ALLOCATED(DstParamData%SAeroTwst)) THEN - ALLOCATE(DstParamData%SAeroTwst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%SAeroTwst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%SAeroTwst = SrcParamData%SAeroTwst -ENDIF -IF (ALLOCATED(SrcParamData%StiffBE)) THEN - i1_l = LBOUND(SrcParamData%StiffBE,1) - i1_u = UBOUND(SrcParamData%StiffBE,1) - i2_l = LBOUND(SrcParamData%StiffBE,2) - i2_u = UBOUND(SrcParamData%StiffBE,2) - IF (.NOT. ALLOCATED(DstParamData%StiffBE)) THEN - ALLOCATE(DstParamData%StiffBE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StiffBE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%StiffBE = SrcParamData%StiffBE -ENDIF -IF (ALLOCATED(SrcParamData%StiffBF)) THEN - i1_l = LBOUND(SrcParamData%StiffBF,1) - i1_u = UBOUND(SrcParamData%StiffBF,1) - i2_l = LBOUND(SrcParamData%StiffBF,2) - i2_u = UBOUND(SrcParamData%StiffBF,2) - IF (.NOT. ALLOCATED(DstParamData%StiffBF)) THEN - ALLOCATE(DstParamData%StiffBF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StiffBF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%StiffBF = SrcParamData%StiffBF -ENDIF -IF (ALLOCATED(SrcParamData%SThetaS)) THEN - i1_l = LBOUND(SrcParamData%SThetaS,1) - i1_u = UBOUND(SrcParamData%SThetaS,1) - i2_l = LBOUND(SrcParamData%SThetaS,2) - i2_u = UBOUND(SrcParamData%SThetaS,2) - IF (.NOT. ALLOCATED(DstParamData%SThetaS)) THEN - ALLOCATE(DstParamData%SThetaS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%SThetaS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%SThetaS = SrcParamData%SThetaS -ENDIF -IF (ALLOCATED(SrcParamData%ThetaS)) THEN - i1_l = LBOUND(SrcParamData%ThetaS,1) - i1_u = UBOUND(SrcParamData%ThetaS,1) - i2_l = LBOUND(SrcParamData%ThetaS,2) - i2_u = UBOUND(SrcParamData%ThetaS,2) - IF (.NOT. ALLOCATED(DstParamData%ThetaS)) THEN - ALLOCATE(DstParamData%ThetaS(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ThetaS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ThetaS = SrcParamData%ThetaS -ENDIF -IF (ALLOCATED(SrcParamData%TwistedSF)) THEN - i1_l = LBOUND(SrcParamData%TwistedSF,1) - i1_u = UBOUND(SrcParamData%TwistedSF,1) - i2_l = LBOUND(SrcParamData%TwistedSF,2) - i2_u = UBOUND(SrcParamData%TwistedSF,2) - i3_l = LBOUND(SrcParamData%TwistedSF,3) - i3_u = UBOUND(SrcParamData%TwistedSF,3) - i4_l = LBOUND(SrcParamData%TwistedSF,4) - i4_u = UBOUND(SrcParamData%TwistedSF,4) - i5_l = LBOUND(SrcParamData%TwistedSF,5) - i5_u = UBOUND(SrcParamData%TwistedSF,5) - IF (.NOT. ALLOCATED(DstParamData%TwistedSF)) THEN - ALLOCATE(DstParamData%TwistedSF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TwistedSF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TwistedSF = SrcParamData%TwistedSF -ENDIF -IF (ALLOCATED(SrcParamData%BldFl1Sh)) THEN - i1_l = LBOUND(SrcParamData%BldFl1Sh,1) - i1_u = UBOUND(SrcParamData%BldFl1Sh,1) - i2_l = LBOUND(SrcParamData%BldFl1Sh,2) - i2_u = UBOUND(SrcParamData%BldFl1Sh,2) - IF (.NOT. ALLOCATED(DstParamData%BldFl1Sh)) THEN - ALLOCATE(DstParamData%BldFl1Sh(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldFl1Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BldFl1Sh = SrcParamData%BldFl1Sh -ENDIF -IF (ALLOCATED(SrcParamData%BldFl2Sh)) THEN - i1_l = LBOUND(SrcParamData%BldFl2Sh,1) - i1_u = UBOUND(SrcParamData%BldFl2Sh,1) - i2_l = LBOUND(SrcParamData%BldFl2Sh,2) - i2_u = UBOUND(SrcParamData%BldFl2Sh,2) - IF (.NOT. ALLOCATED(DstParamData%BldFl2Sh)) THEN - ALLOCATE(DstParamData%BldFl2Sh(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldFl2Sh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BldFl2Sh = SrcParamData%BldFl2Sh -ENDIF -IF (ALLOCATED(SrcParamData%BldEdgSh)) THEN - i1_l = LBOUND(SrcParamData%BldEdgSh,1) - i1_u = UBOUND(SrcParamData%BldEdgSh,1) - i2_l = LBOUND(SrcParamData%BldEdgSh,2) - i2_u = UBOUND(SrcParamData%BldEdgSh,2) - IF (.NOT. ALLOCATED(DstParamData%BldEdgSh)) THEN - ALLOCATE(DstParamData%BldEdgSh(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldEdgSh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BldEdgSh = SrcParamData%BldEdgSh -ENDIF -IF (ALLOCATED(SrcParamData%FreqBE)) THEN - i1_l = LBOUND(SrcParamData%FreqBE,1) - i1_u = UBOUND(SrcParamData%FreqBE,1) - i2_l = LBOUND(SrcParamData%FreqBE,2) - i2_u = UBOUND(SrcParamData%FreqBE,2) - i3_l = LBOUND(SrcParamData%FreqBE,3) - i3_u = UBOUND(SrcParamData%FreqBE,3) - IF (.NOT. ALLOCATED(DstParamData%FreqBE)) THEN - ALLOCATE(DstParamData%FreqBE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FreqBE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FreqBE = SrcParamData%FreqBE -ENDIF -IF (ALLOCATED(SrcParamData%FreqBF)) THEN - i1_l = LBOUND(SrcParamData%FreqBF,1) - i1_u = UBOUND(SrcParamData%FreqBF,1) - i2_l = LBOUND(SrcParamData%FreqBF,2) - i2_u = UBOUND(SrcParamData%FreqBF,2) - i3_l = LBOUND(SrcParamData%FreqBF,3) - i3_u = UBOUND(SrcParamData%FreqBF,3) - IF (.NOT. ALLOCATED(DstParamData%FreqBF)) THEN - ALLOCATE(DstParamData%FreqBF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FreqBF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FreqBF = SrcParamData%FreqBF -ENDIF - DstParamData%FreqTFA = SrcParamData%FreqTFA - DstParamData%FreqTSS = SrcParamData%FreqTSS - DstParamData%TeetCDmp = SrcParamData%TeetCDmp - DstParamData%TeetDmp = SrcParamData%TeetDmp - DstParamData%TeetDmpP = SrcParamData%TeetDmpP - DstParamData%TeetHSSp = SrcParamData%TeetHSSp - DstParamData%TeetHStP = SrcParamData%TeetHStP - DstParamData%TeetSSSp = SrcParamData%TeetSSSp - DstParamData%TeetSStP = SrcParamData%TeetSStP - DstParamData%TeetMod = SrcParamData%TeetMod - DstParamData%TFrlDmp = SrcParamData%TFrlDmp - DstParamData%TFrlDSDmp = SrcParamData%TFrlDSDmp - DstParamData%TFrlDSDP = SrcParamData%TFrlDSDP - DstParamData%TFrlDSSP = SrcParamData%TFrlDSSP - DstParamData%TFrlDSSpr = SrcParamData%TFrlDSSpr - DstParamData%TFrlSpr = SrcParamData%TFrlSpr - DstParamData%TFrlUSDmp = SrcParamData%TFrlUSDmp - DstParamData%TFrlUSDP = SrcParamData%TFrlUSDP - DstParamData%TFrlUSSP = SrcParamData%TFrlUSSP - DstParamData%TFrlUSSpr = SrcParamData%TFrlUSSpr - DstParamData%TFrlMod = SrcParamData%TFrlMod - DstParamData%RFrlDmp = SrcParamData%RFrlDmp - DstParamData%RFrlDSDmp = SrcParamData%RFrlDSDmp - DstParamData%RFrlDSDP = SrcParamData%RFrlDSDP - DstParamData%RFrlDSSP = SrcParamData%RFrlDSSP - DstParamData%RFrlDSSpr = SrcParamData%RFrlDSSpr - DstParamData%RFrlSpr = SrcParamData%RFrlSpr - DstParamData%RFrlUSDmp = SrcParamData%RFrlUSDmp - DstParamData%RFrlUSDP = SrcParamData%RFrlUSDP - DstParamData%RFrlUSSP = SrcParamData%RFrlUSSP - DstParamData%RFrlUSSpr = SrcParamData%RFrlUSSpr - DstParamData%RFrlMod = SrcParamData%RFrlMod - DstParamData%ShftGagL = SrcParamData%ShftGagL - DstParamData%BldGagNd = SrcParamData%BldGagNd - DstParamData%TwrGagNd = SrcParamData%TwrGagNd - DstParamData%TStart = SrcParamData%TStart - DstParamData%DTTorDmp = SrcParamData%DTTorDmp - DstParamData%DTTorSpr = SrcParamData%DTTorSpr - DstParamData%GBRatio = SrcParamData%GBRatio - DstParamData%GBoxEff = SrcParamData%GBoxEff - DstParamData%RotSpeed = SrcParamData%RotSpeed - DstParamData%RootName = SrcParamData%RootName -IF (ALLOCATED(SrcParamData%BElmntMass)) THEN - i1_l = LBOUND(SrcParamData%BElmntMass,1) - i1_u = UBOUND(SrcParamData%BElmntMass,1) - i2_l = LBOUND(SrcParamData%BElmntMass,2) - i2_u = UBOUND(SrcParamData%BElmntMass,2) - IF (.NOT. ALLOCATED(DstParamData%BElmntMass)) THEN - ALLOCATE(DstParamData%BElmntMass(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BElmntMass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BElmntMass = SrcParamData%BElmntMass -ENDIF -IF (ALLOCATED(SrcParamData%TElmntMass)) THEN - i1_l = LBOUND(SrcParamData%TElmntMass,1) - i1_u = UBOUND(SrcParamData%TElmntMass,1) - IF (.NOT. ALLOCATED(DstParamData%TElmntMass)) THEN - ALLOCATE(DstParamData%TElmntMass(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TElmntMass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TElmntMass = SrcParamData%TElmntMass -ENDIF - DstParamData%method = SrcParamData%method - DstParamData%PtfmCMxt = SrcParamData%PtfmCMxt - DstParamData%PtfmCMyt = SrcParamData%PtfmCMyt - DstParamData%BD4Blades = SrcParamData%BD4Blades - DstParamData%UseAD14 = SrcParamData%UseAD14 - DstParamData%BldNd_NumOuts = SrcParamData%BldNd_NumOuts - DstParamData%BldNd_TotNumOuts = SrcParamData%BldNd_TotNumOuts -IF (ALLOCATED(SrcParamData%BldNd_OutParam)) THEN - i1_l = LBOUND(SrcParamData%BldNd_OutParam,1) - i1_u = UBOUND(SrcParamData%BldNd_OutParam,1) - IF (.NOT. ALLOCATED(DstParamData%BldNd_OutParam)) THEN - ALLOCATE(DstParamData%BldNd_OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldNd_OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%BldNd_OutParam,1), UBOUND(SrcParamData%BldNd_OutParam,1) - CALL NWTC_Library_Copyoutparmtype( SrcParamData%BldNd_OutParam(i1), DstParamData%BldNd_OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstParamData%BldNd_BladesOut = SrcParamData%BldNd_BladesOut -IF (ALLOCATED(SrcParamData%Jac_u_indx)) THEN - i1_l = LBOUND(SrcParamData%Jac_u_indx,1) - i1_u = UBOUND(SrcParamData%Jac_u_indx,1) - i2_l = LBOUND(SrcParamData%Jac_u_indx,2) - i2_u = UBOUND(SrcParamData%Jac_u_indx,2) - IF (.NOT. ALLOCATED(DstParamData%Jac_u_indx)) THEN - ALLOCATE(DstParamData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx -ENDIF -IF (ALLOCATED(SrcParamData%du)) THEN - i1_l = LBOUND(SrcParamData%du,1) - i1_u = UBOUND(SrcParamData%du,1) - IF (.NOT. ALLOCATED(DstParamData%du)) THEN - ALLOCATE(DstParamData%du(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%du = SrcParamData%du -ENDIF -IF (ALLOCATED(SrcParamData%dx)) THEN - i1_l = LBOUND(SrcParamData%dx,1) - i1_u = UBOUND(SrcParamData%dx,1) - IF (.NOT. ALLOCATED(DstParamData%dx)) THEN - ALLOCATE(DstParamData%dx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%dx = SrcParamData%dx -ENDIF - DstParamData%Jac_ny = SrcParamData%Jac_ny - END SUBROUTINE ED_CopyParam - - SUBROUTINE ED_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(ED_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(ParamData%PH)) THEN - DEALLOCATE(ParamData%PH) -ENDIF -IF (ALLOCATED(ParamData%PM)) THEN - DEALLOCATE(ParamData%PM) -ENDIF -IF (ALLOCATED(ParamData%DOF_Flag)) THEN - DEALLOCATE(ParamData%DOF_Flag) -ENDIF -IF (ALLOCATED(ParamData%DOF_Desc)) THEN - DEALLOCATE(ParamData%DOF_Desc) -ENDIF - CALL ED_DestroyActiveDOFs( ParamData%DOFs, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ParamData%OutParam)) THEN -DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_DestroyOutParmType( ParamData%OutParam(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%OutParam) -ENDIF -IF (ALLOCATED(ParamData%CosPreC)) THEN - DEALLOCATE(ParamData%CosPreC) -ENDIF -IF (ALLOCATED(ParamData%SinPreC)) THEN - DEALLOCATE(ParamData%SinPreC) -ENDIF -IF (ALLOCATED(ParamData%AxRedTFA)) THEN - DEALLOCATE(ParamData%AxRedTFA) -ENDIF -IF (ALLOCATED(ParamData%AxRedTSS)) THEN - DEALLOCATE(ParamData%AxRedTSS) -ENDIF -IF (ALLOCATED(ParamData%DHNodes)) THEN - DEALLOCATE(ParamData%DHNodes) -ENDIF -IF (ALLOCATED(ParamData%HNodes)) THEN - DEALLOCATE(ParamData%HNodes) -ENDIF -IF (ALLOCATED(ParamData%HNodesNorm)) THEN - DEALLOCATE(ParamData%HNodesNorm) -ENDIF -IF (ALLOCATED(ParamData%MassT)) THEN - DEALLOCATE(ParamData%MassT) -ENDIF -IF (ALLOCATED(ParamData%StiffTSS)) THEN - DEALLOCATE(ParamData%StiffTSS) -ENDIF -IF (ALLOCATED(ParamData%TwrFASF)) THEN - DEALLOCATE(ParamData%TwrFASF) -ENDIF -IF (ALLOCATED(ParamData%TwrSSSF)) THEN - DEALLOCATE(ParamData%TwrSSSF) -ENDIF -IF (ALLOCATED(ParamData%StiffTFA)) THEN - DEALLOCATE(ParamData%StiffTFA) -ENDIF -IF (ALLOCATED(ParamData%BldCG)) THEN - DEALLOCATE(ParamData%BldCG) -ENDIF -IF (ALLOCATED(ParamData%BldMass)) THEN - DEALLOCATE(ParamData%BldMass) -ENDIF -IF (ALLOCATED(ParamData%FirstMom)) THEN - DEALLOCATE(ParamData%FirstMom) -ENDIF -IF (ALLOCATED(ParamData%SecondMom)) THEN - DEALLOCATE(ParamData%SecondMom) -ENDIF -IF (ALLOCATED(ParamData%TipMass)) THEN - DEALLOCATE(ParamData%TipMass) -ENDIF -IF (ALLOCATED(ParamData%PitchAxis)) THEN - DEALLOCATE(ParamData%PitchAxis) -ENDIF -IF (ALLOCATED(ParamData%AeroTwst)) THEN - DEALLOCATE(ParamData%AeroTwst) -ENDIF -IF (ALLOCATED(ParamData%AxRedBld)) THEN - DEALLOCATE(ParamData%AxRedBld) -ENDIF -IF (ALLOCATED(ParamData%BldEDamp)) THEN - DEALLOCATE(ParamData%BldEDamp) -ENDIF -IF (ALLOCATED(ParamData%BldFDamp)) THEN - DEALLOCATE(ParamData%BldFDamp) -ENDIF -IF (ALLOCATED(ParamData%CAeroTwst)) THEN - DEALLOCATE(ParamData%CAeroTwst) -ENDIF -IF (ALLOCATED(ParamData%CBE)) THEN - DEALLOCATE(ParamData%CBE) -ENDIF -IF (ALLOCATED(ParamData%CBF)) THEN - DEALLOCATE(ParamData%CBF) -ENDIF -IF (ALLOCATED(ParamData%Chord)) THEN - DEALLOCATE(ParamData%Chord) -ENDIF -IF (ALLOCATED(ParamData%CThetaS)) THEN - DEALLOCATE(ParamData%CThetaS) -ENDIF -IF (ALLOCATED(ParamData%DRNodes)) THEN - DEALLOCATE(ParamData%DRNodes) -ENDIF -IF (ALLOCATED(ParamData%FStTunr)) THEN - DEALLOCATE(ParamData%FStTunr) -ENDIF -IF (ALLOCATED(ParamData%KBE)) THEN - DEALLOCATE(ParamData%KBE) -ENDIF -IF (ALLOCATED(ParamData%KBF)) THEN - DEALLOCATE(ParamData%KBF) -ENDIF -IF (ALLOCATED(ParamData%MassB)) THEN - DEALLOCATE(ParamData%MassB) -ENDIF -IF (ALLOCATED(ParamData%RNodes)) THEN - DEALLOCATE(ParamData%RNodes) -ENDIF -IF (ALLOCATED(ParamData%RNodesNorm)) THEN - DEALLOCATE(ParamData%RNodesNorm) -ENDIF -IF (ALLOCATED(ParamData%rSAerCenn1)) THEN - DEALLOCATE(ParamData%rSAerCenn1) -ENDIF -IF (ALLOCATED(ParamData%rSAerCenn2)) THEN - DEALLOCATE(ParamData%rSAerCenn2) -ENDIF -IF (ALLOCATED(ParamData%SAeroTwst)) THEN - DEALLOCATE(ParamData%SAeroTwst) -ENDIF -IF (ALLOCATED(ParamData%StiffBE)) THEN - DEALLOCATE(ParamData%StiffBE) -ENDIF -IF (ALLOCATED(ParamData%StiffBF)) THEN - DEALLOCATE(ParamData%StiffBF) -ENDIF -IF (ALLOCATED(ParamData%SThetaS)) THEN - DEALLOCATE(ParamData%SThetaS) -ENDIF -IF (ALLOCATED(ParamData%ThetaS)) THEN - DEALLOCATE(ParamData%ThetaS) -ENDIF -IF (ALLOCATED(ParamData%TwistedSF)) THEN - DEALLOCATE(ParamData%TwistedSF) -ENDIF -IF (ALLOCATED(ParamData%BldFl1Sh)) THEN - DEALLOCATE(ParamData%BldFl1Sh) -ENDIF -IF (ALLOCATED(ParamData%BldFl2Sh)) THEN - DEALLOCATE(ParamData%BldFl2Sh) -ENDIF -IF (ALLOCATED(ParamData%BldEdgSh)) THEN - DEALLOCATE(ParamData%BldEdgSh) -ENDIF -IF (ALLOCATED(ParamData%FreqBE)) THEN - DEALLOCATE(ParamData%FreqBE) -ENDIF -IF (ALLOCATED(ParamData%FreqBF)) THEN - DEALLOCATE(ParamData%FreqBF) -ENDIF -IF (ALLOCATED(ParamData%BElmntMass)) THEN - DEALLOCATE(ParamData%BElmntMass) -ENDIF -IF (ALLOCATED(ParamData%TElmntMass)) THEN - DEALLOCATE(ParamData%TElmntMass) -ENDIF -IF (ALLOCATED(ParamData%BldNd_OutParam)) THEN -DO i1 = LBOUND(ParamData%BldNd_OutParam,1), UBOUND(ParamData%BldNd_OutParam,1) - CALL NWTC_Library_DestroyOutParmType( ParamData%BldNd_OutParam(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%BldNd_OutParam) -ENDIF -IF (ALLOCATED(ParamData%Jac_u_indx)) THEN - DEALLOCATE(ParamData%Jac_u_indx) -ENDIF -IF (ALLOCATED(ParamData%du)) THEN - DEALLOCATE(ParamData%du) -ENDIF -IF (ALLOCATED(ParamData%dx)) THEN - DEALLOCATE(ParamData%dx) -ENDIF - END SUBROUTINE ED_DestroyParam +subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(ED_ParameterType), intent(in) :: SrcParamData + type(ED_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3, i4, i5 + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ED_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%DT = SrcParamData%DT + DstParamData%DT24 = SrcParamData%DT24 + DstParamData%BldNodes = SrcParamData%BldNodes + DstParamData%TipNode = SrcParamData%TipNode + DstParamData%NDOF = SrcParamData%NDOF + DstParamData%TwoPiNB = SrcParamData%TwoPiNB + DstParamData%NAug = SrcParamData%NAug + DstParamData%NPH = SrcParamData%NPH + if (allocated(SrcParamData%PH)) then + LB(1:1) = lbound(SrcParamData%PH) + UB(1:1) = ubound(SrcParamData%PH) + if (.not. allocated(DstParamData%PH)) then + allocate(DstParamData%PH(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PH.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%PH = SrcParamData%PH + else if (allocated(DstParamData%PH)) then + deallocate(DstParamData%PH) + end if + DstParamData%NPM = SrcParamData%NPM + if (allocated(SrcParamData%PM)) then + LB(1:2) = lbound(SrcParamData%PM) + UB(1:2) = ubound(SrcParamData%PM) + if (.not. allocated(DstParamData%PM)) then + allocate(DstParamData%PM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%PM = SrcParamData%PM + else if (allocated(DstParamData%PM)) then + deallocate(DstParamData%PM) + end if + if (allocated(SrcParamData%DOF_Flag)) then + LB(1:1) = lbound(SrcParamData%DOF_Flag) + UB(1:1) = ubound(SrcParamData%DOF_Flag) + if (.not. allocated(DstParamData%DOF_Flag)) then + allocate(DstParamData%DOF_Flag(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DOF_Flag.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%DOF_Flag = SrcParamData%DOF_Flag + else if (allocated(DstParamData%DOF_Flag)) then + deallocate(DstParamData%DOF_Flag) + end if + if (allocated(SrcParamData%DOF_Desc)) then + LB(1:1) = lbound(SrcParamData%DOF_Desc) + UB(1:1) = ubound(SrcParamData%DOF_Desc) + if (.not. allocated(DstParamData%DOF_Desc)) then + allocate(DstParamData%DOF_Desc(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DOF_Desc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%DOF_Desc = SrcParamData%DOF_Desc + else if (allocated(DstParamData%DOF_Desc)) then + deallocate(DstParamData%DOF_Desc) + end if + call ED_CopyActiveDOFs(SrcParamData%DOFs, DstParamData%DOFs, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%OutFmt = SrcParamData%OutFmt + DstParamData%NBlGages = SrcParamData%NBlGages + DstParamData%NTwGages = SrcParamData%NTwGages + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstParamData%OutParam)) then + deallocate(DstParamData%OutParam) + end if + DstParamData%Delim = SrcParamData%Delim + DstParamData%AvgNrmTpRd = SrcParamData%AvgNrmTpRd + DstParamData%AzimB1Up = SrcParamData%AzimB1Up + DstParamData%CosDel3 = SrcParamData%CosDel3 + if (allocated(SrcParamData%CosPreC)) then + LB(1:1) = lbound(SrcParamData%CosPreC) + UB(1:1) = ubound(SrcParamData%CosPreC) + if (.not. allocated(DstParamData%CosPreC)) then + allocate(DstParamData%CosPreC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CosPreC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%CosPreC = SrcParamData%CosPreC + else if (allocated(DstParamData%CosPreC)) then + deallocate(DstParamData%CosPreC) + end if + DstParamData%CRFrlSkew = SrcParamData%CRFrlSkew + DstParamData%CRFrlSkw2 = SrcParamData%CRFrlSkw2 + DstParamData%CRFrlTilt = SrcParamData%CRFrlTilt + DstParamData%CRFrlTlt2 = SrcParamData%CRFrlTlt2 + DstParamData%CShftSkew = SrcParamData%CShftSkew + DstParamData%CShftTilt = SrcParamData%CShftTilt + DstParamData%CSRFrlSkw = SrcParamData%CSRFrlSkw + DstParamData%CSRFrlTlt = SrcParamData%CSRFrlTlt + DstParamData%CSTFrlSkw = SrcParamData%CSTFrlSkw + DstParamData%CSTFrlTlt = SrcParamData%CSTFrlTlt + DstParamData%CTFrlSkew = SrcParamData%CTFrlSkew + DstParamData%CTFrlSkw2 = SrcParamData%CTFrlSkw2 + DstParamData%CTFrlTilt = SrcParamData%CTFrlTilt + DstParamData%CTFrlTlt2 = SrcParamData%CTFrlTlt2 + DstParamData%HubHt = SrcParamData%HubHt + DstParamData%HubCM = SrcParamData%HubCM + DstParamData%HubRad = SrcParamData%HubRad + DstParamData%NacCMxn = SrcParamData%NacCMxn + DstParamData%NacCMyn = SrcParamData%NacCMyn + DstParamData%NacCMzn = SrcParamData%NacCMzn + DstParamData%OverHang = SrcParamData%OverHang + DstParamData%ProjArea = SrcParamData%ProjArea + DstParamData%PtfmRefzt = SrcParamData%PtfmRefzt + DstParamData%RefTwrHt = SrcParamData%RefTwrHt + DstParamData%RFrlPnt_n = SrcParamData%RFrlPnt_n + DstParamData%rVDxn = SrcParamData%rVDxn + DstParamData%rVDyn = SrcParamData%rVDyn + DstParamData%rVDzn = SrcParamData%rVDzn + DstParamData%rVIMUxn = SrcParamData%rVIMUxn + DstParamData%rVIMUyn = SrcParamData%rVIMUyn + DstParamData%rVIMUzn = SrcParamData%rVIMUzn + DstParamData%rVPxn = SrcParamData%rVPxn + DstParamData%rVPyn = SrcParamData%rVPyn + DstParamData%rVPzn = SrcParamData%rVPzn + DstParamData%rWIxn = SrcParamData%rWIxn + DstParamData%rWIyn = SrcParamData%rWIyn + DstParamData%rWIzn = SrcParamData%rWIzn + DstParamData%rWJxn = SrcParamData%rWJxn + DstParamData%rWJyn = SrcParamData%rWJyn + DstParamData%rWJzn = SrcParamData%rWJzn + DstParamData%rZT0zt = SrcParamData%rZT0zt + DstParamData%rZYzt = SrcParamData%rZYzt + DstParamData%SinDel3 = SrcParamData%SinDel3 + if (allocated(SrcParamData%SinPreC)) then + LB(1:1) = lbound(SrcParamData%SinPreC) + UB(1:1) = ubound(SrcParamData%SinPreC) + if (.not. allocated(DstParamData%SinPreC)) then + allocate(DstParamData%SinPreC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%SinPreC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%SinPreC = SrcParamData%SinPreC + else if (allocated(DstParamData%SinPreC)) then + deallocate(DstParamData%SinPreC) + end if + DstParamData%SRFrlSkew = SrcParamData%SRFrlSkew + DstParamData%SRFrlSkw2 = SrcParamData%SRFrlSkw2 + DstParamData%SRFrlTilt = SrcParamData%SRFrlTilt + DstParamData%SRFrlTlt2 = SrcParamData%SRFrlTlt2 + DstParamData%SShftSkew = SrcParamData%SShftSkew + DstParamData%SShftTilt = SrcParamData%SShftTilt + DstParamData%STFrlSkew = SrcParamData%STFrlSkew + DstParamData%STFrlSkw2 = SrcParamData%STFrlSkw2 + DstParamData%STFrlTilt = SrcParamData%STFrlTilt + DstParamData%STFrlTlt2 = SrcParamData%STFrlTlt2 + DstParamData%TFrlPnt_n = SrcParamData%TFrlPnt_n + DstParamData%TipRad = SrcParamData%TipRad + DstParamData%TowerHt = SrcParamData%TowerHt + DstParamData%TowerBsHt = SrcParamData%TowerBsHt + DstParamData%UndSling = SrcParamData%UndSling + DstParamData%NumBl = SrcParamData%NumBl + if (allocated(SrcParamData%AxRedTFA)) then + LB(1:3) = lbound(SrcParamData%AxRedTFA) + UB(1:3) = ubound(SrcParamData%AxRedTFA) + if (.not. allocated(DstParamData%AxRedTFA)) then + allocate(DstParamData%AxRedTFA(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AxRedTFA.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AxRedTFA = SrcParamData%AxRedTFA + else if (allocated(DstParamData%AxRedTFA)) then + deallocate(DstParamData%AxRedTFA) + end if + if (allocated(SrcParamData%AxRedTSS)) then + LB(1:3) = lbound(SrcParamData%AxRedTSS) + UB(1:3) = ubound(SrcParamData%AxRedTSS) + if (.not. allocated(DstParamData%AxRedTSS)) then + allocate(DstParamData%AxRedTSS(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AxRedTSS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AxRedTSS = SrcParamData%AxRedTSS + else if (allocated(DstParamData%AxRedTSS)) then + deallocate(DstParamData%AxRedTSS) + end if + DstParamData%CTFA = SrcParamData%CTFA + DstParamData%CTSS = SrcParamData%CTSS + if (allocated(SrcParamData%DHNodes)) then + LB(1:1) = lbound(SrcParamData%DHNodes) + UB(1:1) = ubound(SrcParamData%DHNodes) + if (.not. allocated(DstParamData%DHNodes)) then + allocate(DstParamData%DHNodes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DHNodes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%DHNodes = SrcParamData%DHNodes + else if (allocated(DstParamData%DHNodes)) then + deallocate(DstParamData%DHNodes) + end if + if (allocated(SrcParamData%HNodes)) then + LB(1:1) = lbound(SrcParamData%HNodes) + UB(1:1) = ubound(SrcParamData%HNodes) + if (.not. allocated(DstParamData%HNodes)) then + allocate(DstParamData%HNodes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%HNodes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%HNodes = SrcParamData%HNodes + else if (allocated(DstParamData%HNodes)) then + deallocate(DstParamData%HNodes) + end if + if (allocated(SrcParamData%HNodesNorm)) then + LB(1:1) = lbound(SrcParamData%HNodesNorm) + UB(1:1) = ubound(SrcParamData%HNodesNorm) + if (.not. allocated(DstParamData%HNodesNorm)) then + allocate(DstParamData%HNodesNorm(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%HNodesNorm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%HNodesNorm = SrcParamData%HNodesNorm + else if (allocated(DstParamData%HNodesNorm)) then + deallocate(DstParamData%HNodesNorm) + end if + DstParamData%KTFA = SrcParamData%KTFA + DstParamData%KTSS = SrcParamData%KTSS + if (allocated(SrcParamData%MassT)) then + LB(1:1) = lbound(SrcParamData%MassT) + UB(1:1) = ubound(SrcParamData%MassT) + if (.not. allocated(DstParamData%MassT)) then + allocate(DstParamData%MassT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MassT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%MassT = SrcParamData%MassT + else if (allocated(DstParamData%MassT)) then + deallocate(DstParamData%MassT) + end if + if (allocated(SrcParamData%StiffTSS)) then + LB(1:1) = lbound(SrcParamData%StiffTSS) + UB(1:1) = ubound(SrcParamData%StiffTSS) + if (.not. allocated(DstParamData%StiffTSS)) then + allocate(DstParamData%StiffTSS(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StiffTSS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%StiffTSS = SrcParamData%StiffTSS + else if (allocated(DstParamData%StiffTSS)) then + deallocate(DstParamData%StiffTSS) + end if + if (allocated(SrcParamData%TwrFASF)) then + LB(1:3) = lbound(SrcParamData%TwrFASF) + UB(1:3) = ubound(SrcParamData%TwrFASF) + if (.not. allocated(DstParamData%TwrFASF)) then + allocate(DstParamData%TwrFASF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TwrFASF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%TwrFASF = SrcParamData%TwrFASF + else if (allocated(DstParamData%TwrFASF)) then + deallocate(DstParamData%TwrFASF) + end if + DstParamData%TwrFlexL = SrcParamData%TwrFlexL + if (allocated(SrcParamData%TwrSSSF)) then + LB(1:3) = lbound(SrcParamData%TwrSSSF) + UB(1:3) = ubound(SrcParamData%TwrSSSF) + if (.not. allocated(DstParamData%TwrSSSF)) then + allocate(DstParamData%TwrSSSF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TwrSSSF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%TwrSSSF = SrcParamData%TwrSSSF + else if (allocated(DstParamData%TwrSSSF)) then + deallocate(DstParamData%TwrSSSF) + end if + DstParamData%TTopNode = SrcParamData%TTopNode + DstParamData%TwrNodes = SrcParamData%TwrNodes + DstParamData%MHK = SrcParamData%MHK + if (allocated(SrcParamData%StiffTFA)) then + LB(1:1) = lbound(SrcParamData%StiffTFA) + UB(1:1) = ubound(SrcParamData%StiffTFA) + if (.not. allocated(DstParamData%StiffTFA)) then + allocate(DstParamData%StiffTFA(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StiffTFA.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%StiffTFA = SrcParamData%StiffTFA + else if (allocated(DstParamData%StiffTFA)) then + deallocate(DstParamData%StiffTFA) + end if + DstParamData%AtfaIner = SrcParamData%AtfaIner + if (allocated(SrcParamData%BldCG)) then + LB(1:1) = lbound(SrcParamData%BldCG) + UB(1:1) = ubound(SrcParamData%BldCG) + if (.not. allocated(DstParamData%BldCG)) then + allocate(DstParamData%BldCG(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldCG.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BldCG = SrcParamData%BldCG + else if (allocated(DstParamData%BldCG)) then + deallocate(DstParamData%BldCG) + end if + if (allocated(SrcParamData%BldMass)) then + LB(1:1) = lbound(SrcParamData%BldMass) + UB(1:1) = ubound(SrcParamData%BldMass) + if (.not. allocated(DstParamData%BldMass)) then + allocate(DstParamData%BldMass(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldMass.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BldMass = SrcParamData%BldMass + else if (allocated(DstParamData%BldMass)) then + deallocate(DstParamData%BldMass) + end if + DstParamData%BoomMass = SrcParamData%BoomMass + if (allocated(SrcParamData%FirstMom)) then + LB(1:1) = lbound(SrcParamData%FirstMom) + UB(1:1) = ubound(SrcParamData%FirstMom) + if (.not. allocated(DstParamData%FirstMom)) then + allocate(DstParamData%FirstMom(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FirstMom.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%FirstMom = SrcParamData%FirstMom + else if (allocated(DstParamData%FirstMom)) then + deallocate(DstParamData%FirstMom) + end if + DstParamData%GenIner = SrcParamData%GenIner + DstParamData%Hubg1Iner = SrcParamData%Hubg1Iner + DstParamData%Hubg2Iner = SrcParamData%Hubg2Iner + DstParamData%HubMass = SrcParamData%HubMass + DstParamData%Nacd2Iner = SrcParamData%Nacd2Iner + DstParamData%NacMass = SrcParamData%NacMass + DstParamData%PtfmMass = SrcParamData%PtfmMass + DstParamData%PtfmPIner = SrcParamData%PtfmPIner + DstParamData%PtfmRIner = SrcParamData%PtfmRIner + DstParamData%PtfmYIner = SrcParamData%PtfmYIner + DstParamData%RFrlMass = SrcParamData%RFrlMass + DstParamData%RotIner = SrcParamData%RotIner + DstParamData%RotMass = SrcParamData%RotMass + DstParamData%RrfaIner = SrcParamData%RrfaIner + if (allocated(SrcParamData%SecondMom)) then + LB(1:1) = lbound(SrcParamData%SecondMom) + UB(1:1) = ubound(SrcParamData%SecondMom) + if (.not. allocated(DstParamData%SecondMom)) then + allocate(DstParamData%SecondMom(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%SecondMom.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%SecondMom = SrcParamData%SecondMom + else if (allocated(DstParamData%SecondMom)) then + deallocate(DstParamData%SecondMom) + end if + DstParamData%TFinMass = SrcParamData%TFinMass + DstParamData%TFrlIner = SrcParamData%TFrlIner + if (allocated(SrcParamData%TipMass)) then + LB(1:1) = lbound(SrcParamData%TipMass) + UB(1:1) = ubound(SrcParamData%TipMass) + if (.not. allocated(DstParamData%TipMass)) then + allocate(DstParamData%TipMass(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TipMass.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%TipMass = SrcParamData%TipMass + else if (allocated(DstParamData%TipMass)) then + deallocate(DstParamData%TipMass) + end if + DstParamData%TurbMass = SrcParamData%TurbMass + DstParamData%TwrMass = SrcParamData%TwrMass + DstParamData%TwrTpMass = SrcParamData%TwrTpMass + DstParamData%YawBrMass = SrcParamData%YawBrMass + DstParamData%Gravity = SrcParamData%Gravity + if (allocated(SrcParamData%PitchAxis)) then + LB(1:2) = lbound(SrcParamData%PitchAxis) + UB(1:2) = ubound(SrcParamData%PitchAxis) + if (.not. allocated(DstParamData%PitchAxis)) then + allocate(DstParamData%PitchAxis(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PitchAxis.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%PitchAxis = SrcParamData%PitchAxis + else if (allocated(DstParamData%PitchAxis)) then + deallocate(DstParamData%PitchAxis) + end if + if (allocated(SrcParamData%AeroTwst)) then + LB(1:1) = lbound(SrcParamData%AeroTwst) + UB(1:1) = ubound(SrcParamData%AeroTwst) + if (.not. allocated(DstParamData%AeroTwst)) then + allocate(DstParamData%AeroTwst(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AeroTwst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AeroTwst = SrcParamData%AeroTwst + else if (allocated(DstParamData%AeroTwst)) then + deallocate(DstParamData%AeroTwst) + end if + if (allocated(SrcParamData%AxRedBld)) then + LB(1:4) = lbound(SrcParamData%AxRedBld) + UB(1:4) = ubound(SrcParamData%AxRedBld) + if (.not. allocated(DstParamData%AxRedBld)) then + allocate(DstParamData%AxRedBld(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AxRedBld.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AxRedBld = SrcParamData%AxRedBld + else if (allocated(DstParamData%AxRedBld)) then + deallocate(DstParamData%AxRedBld) + end if + if (allocated(SrcParamData%BldEDamp)) then + LB(1:2) = lbound(SrcParamData%BldEDamp) + UB(1:2) = ubound(SrcParamData%BldEDamp) + if (.not. allocated(DstParamData%BldEDamp)) then + allocate(DstParamData%BldEDamp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldEDamp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BldEDamp = SrcParamData%BldEDamp + else if (allocated(DstParamData%BldEDamp)) then + deallocate(DstParamData%BldEDamp) + end if + if (allocated(SrcParamData%BldFDamp)) then + LB(1:2) = lbound(SrcParamData%BldFDamp) + UB(1:2) = ubound(SrcParamData%BldFDamp) + if (.not. allocated(DstParamData%BldFDamp)) then + allocate(DstParamData%BldFDamp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldFDamp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BldFDamp = SrcParamData%BldFDamp + else if (allocated(DstParamData%BldFDamp)) then + deallocate(DstParamData%BldFDamp) + end if + DstParamData%BldFlexL = SrcParamData%BldFlexL + if (allocated(SrcParamData%CAeroTwst)) then + LB(1:1) = lbound(SrcParamData%CAeroTwst) + UB(1:1) = ubound(SrcParamData%CAeroTwst) + if (.not. allocated(DstParamData%CAeroTwst)) then + allocate(DstParamData%CAeroTwst(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CAeroTwst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%CAeroTwst = SrcParamData%CAeroTwst + else if (allocated(DstParamData%CAeroTwst)) then + deallocate(DstParamData%CAeroTwst) + end if + if (allocated(SrcParamData%CBE)) then + LB(1:3) = lbound(SrcParamData%CBE) + UB(1:3) = ubound(SrcParamData%CBE) + if (.not. allocated(DstParamData%CBE)) then + allocate(DstParamData%CBE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CBE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%CBE = SrcParamData%CBE + else if (allocated(DstParamData%CBE)) then + deallocate(DstParamData%CBE) + end if + if (allocated(SrcParamData%CBF)) then + LB(1:3) = lbound(SrcParamData%CBF) + UB(1:3) = ubound(SrcParamData%CBF) + if (.not. allocated(DstParamData%CBF)) then + allocate(DstParamData%CBF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CBF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%CBF = SrcParamData%CBF + else if (allocated(DstParamData%CBF)) then + deallocate(DstParamData%CBF) + end if + if (allocated(SrcParamData%Chord)) then + LB(1:1) = lbound(SrcParamData%Chord) + UB(1:1) = ubound(SrcParamData%Chord) + if (.not. allocated(DstParamData%Chord)) then + allocate(DstParamData%Chord(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Chord.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Chord = SrcParamData%Chord + else if (allocated(DstParamData%Chord)) then + deallocate(DstParamData%Chord) + end if + if (allocated(SrcParamData%CThetaS)) then + LB(1:2) = lbound(SrcParamData%CThetaS) + UB(1:2) = ubound(SrcParamData%CThetaS) + if (.not. allocated(DstParamData%CThetaS)) then + allocate(DstParamData%CThetaS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CThetaS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%CThetaS = SrcParamData%CThetaS + else if (allocated(DstParamData%CThetaS)) then + deallocate(DstParamData%CThetaS) + end if + if (allocated(SrcParamData%DRNodes)) then + LB(1:1) = lbound(SrcParamData%DRNodes) + UB(1:1) = ubound(SrcParamData%DRNodes) + if (.not. allocated(DstParamData%DRNodes)) then + allocate(DstParamData%DRNodes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DRNodes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%DRNodes = SrcParamData%DRNodes + else if (allocated(DstParamData%DRNodes)) then + deallocate(DstParamData%DRNodes) + end if + if (allocated(SrcParamData%FStTunr)) then + LB(1:2) = lbound(SrcParamData%FStTunr) + UB(1:2) = ubound(SrcParamData%FStTunr) + if (.not. allocated(DstParamData%FStTunr)) then + allocate(DstParamData%FStTunr(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FStTunr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%FStTunr = SrcParamData%FStTunr + else if (allocated(DstParamData%FStTunr)) then + deallocate(DstParamData%FStTunr) + end if + if (allocated(SrcParamData%KBE)) then + LB(1:3) = lbound(SrcParamData%KBE) + UB(1:3) = ubound(SrcParamData%KBE) + if (.not. allocated(DstParamData%KBE)) then + allocate(DstParamData%KBE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KBE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%KBE = SrcParamData%KBE + else if (allocated(DstParamData%KBE)) then + deallocate(DstParamData%KBE) + end if + if (allocated(SrcParamData%KBF)) then + LB(1:3) = lbound(SrcParamData%KBF) + UB(1:3) = ubound(SrcParamData%KBF) + if (.not. allocated(DstParamData%KBF)) then + allocate(DstParamData%KBF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KBF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%KBF = SrcParamData%KBF + else if (allocated(DstParamData%KBF)) then + deallocate(DstParamData%KBF) + end if + if (allocated(SrcParamData%MassB)) then + LB(1:2) = lbound(SrcParamData%MassB) + UB(1:2) = ubound(SrcParamData%MassB) + if (.not. allocated(DstParamData%MassB)) then + allocate(DstParamData%MassB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MassB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%MassB = SrcParamData%MassB + else if (allocated(DstParamData%MassB)) then + deallocate(DstParamData%MassB) + end if + if (allocated(SrcParamData%RNodes)) then + LB(1:1) = lbound(SrcParamData%RNodes) + UB(1:1) = ubound(SrcParamData%RNodes) + if (.not. allocated(DstParamData%RNodes)) then + allocate(DstParamData%RNodes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%RNodes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%RNodes = SrcParamData%RNodes + else if (allocated(DstParamData%RNodes)) then + deallocate(DstParamData%RNodes) + end if + if (allocated(SrcParamData%RNodesNorm)) then + LB(1:1) = lbound(SrcParamData%RNodesNorm) + UB(1:1) = ubound(SrcParamData%RNodesNorm) + if (.not. allocated(DstParamData%RNodesNorm)) then + allocate(DstParamData%RNodesNorm(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%RNodesNorm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%RNodesNorm = SrcParamData%RNodesNorm + else if (allocated(DstParamData%RNodesNorm)) then + deallocate(DstParamData%RNodesNorm) + end if + if (allocated(SrcParamData%rSAerCenn1)) then + LB(1:2) = lbound(SrcParamData%rSAerCenn1) + UB(1:2) = ubound(SrcParamData%rSAerCenn1) + if (.not. allocated(DstParamData%rSAerCenn1)) then + allocate(DstParamData%rSAerCenn1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rSAerCenn1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%rSAerCenn1 = SrcParamData%rSAerCenn1 + else if (allocated(DstParamData%rSAerCenn1)) then + deallocate(DstParamData%rSAerCenn1) + end if + if (allocated(SrcParamData%rSAerCenn2)) then + LB(1:2) = lbound(SrcParamData%rSAerCenn2) + UB(1:2) = ubound(SrcParamData%rSAerCenn2) + if (.not. allocated(DstParamData%rSAerCenn2)) then + allocate(DstParamData%rSAerCenn2(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rSAerCenn2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%rSAerCenn2 = SrcParamData%rSAerCenn2 + else if (allocated(DstParamData%rSAerCenn2)) then + deallocate(DstParamData%rSAerCenn2) + end if + if (allocated(SrcParamData%SAeroTwst)) then + LB(1:1) = lbound(SrcParamData%SAeroTwst) + UB(1:1) = ubound(SrcParamData%SAeroTwst) + if (.not. allocated(DstParamData%SAeroTwst)) then + allocate(DstParamData%SAeroTwst(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%SAeroTwst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%SAeroTwst = SrcParamData%SAeroTwst + else if (allocated(DstParamData%SAeroTwst)) then + deallocate(DstParamData%SAeroTwst) + end if + if (allocated(SrcParamData%StiffBE)) then + LB(1:2) = lbound(SrcParamData%StiffBE) + UB(1:2) = ubound(SrcParamData%StiffBE) + if (.not. allocated(DstParamData%StiffBE)) then + allocate(DstParamData%StiffBE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StiffBE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%StiffBE = SrcParamData%StiffBE + else if (allocated(DstParamData%StiffBE)) then + deallocate(DstParamData%StiffBE) + end if + if (allocated(SrcParamData%StiffBF)) then + LB(1:2) = lbound(SrcParamData%StiffBF) + UB(1:2) = ubound(SrcParamData%StiffBF) + if (.not. allocated(DstParamData%StiffBF)) then + allocate(DstParamData%StiffBF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StiffBF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%StiffBF = SrcParamData%StiffBF + else if (allocated(DstParamData%StiffBF)) then + deallocate(DstParamData%StiffBF) + end if + if (allocated(SrcParamData%SThetaS)) then + LB(1:2) = lbound(SrcParamData%SThetaS) + UB(1:2) = ubound(SrcParamData%SThetaS) + if (.not. allocated(DstParamData%SThetaS)) then + allocate(DstParamData%SThetaS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%SThetaS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%SThetaS = SrcParamData%SThetaS + else if (allocated(DstParamData%SThetaS)) then + deallocate(DstParamData%SThetaS) + end if + if (allocated(SrcParamData%ThetaS)) then + LB(1:2) = lbound(SrcParamData%ThetaS) + UB(1:2) = ubound(SrcParamData%ThetaS) + if (.not. allocated(DstParamData%ThetaS)) then + allocate(DstParamData%ThetaS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ThetaS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%ThetaS = SrcParamData%ThetaS + else if (allocated(DstParamData%ThetaS)) then + deallocate(DstParamData%ThetaS) + end if + if (allocated(SrcParamData%TwistedSF)) then + LB(1:5) = lbound(SrcParamData%TwistedSF) + UB(1:5) = ubound(SrcParamData%TwistedSF) + if (.not. allocated(DstParamData%TwistedSF)) then + allocate(DstParamData%TwistedSF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TwistedSF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%TwistedSF = SrcParamData%TwistedSF + else if (allocated(DstParamData%TwistedSF)) then + deallocate(DstParamData%TwistedSF) + end if + if (allocated(SrcParamData%BldFl1Sh)) then + LB(1:2) = lbound(SrcParamData%BldFl1Sh) + UB(1:2) = ubound(SrcParamData%BldFl1Sh) + if (.not. allocated(DstParamData%BldFl1Sh)) then + allocate(DstParamData%BldFl1Sh(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldFl1Sh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BldFl1Sh = SrcParamData%BldFl1Sh + else if (allocated(DstParamData%BldFl1Sh)) then + deallocate(DstParamData%BldFl1Sh) + end if + if (allocated(SrcParamData%BldFl2Sh)) then + LB(1:2) = lbound(SrcParamData%BldFl2Sh) + UB(1:2) = ubound(SrcParamData%BldFl2Sh) + if (.not. allocated(DstParamData%BldFl2Sh)) then + allocate(DstParamData%BldFl2Sh(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldFl2Sh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BldFl2Sh = SrcParamData%BldFl2Sh + else if (allocated(DstParamData%BldFl2Sh)) then + deallocate(DstParamData%BldFl2Sh) + end if + if (allocated(SrcParamData%BldEdgSh)) then + LB(1:2) = lbound(SrcParamData%BldEdgSh) + UB(1:2) = ubound(SrcParamData%BldEdgSh) + if (.not. allocated(DstParamData%BldEdgSh)) then + allocate(DstParamData%BldEdgSh(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldEdgSh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BldEdgSh = SrcParamData%BldEdgSh + else if (allocated(DstParamData%BldEdgSh)) then + deallocate(DstParamData%BldEdgSh) + end if + if (allocated(SrcParamData%FreqBE)) then + LB(1:3) = lbound(SrcParamData%FreqBE) + UB(1:3) = ubound(SrcParamData%FreqBE) + if (.not. allocated(DstParamData%FreqBE)) then + allocate(DstParamData%FreqBE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FreqBE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%FreqBE = SrcParamData%FreqBE + else if (allocated(DstParamData%FreqBE)) then + deallocate(DstParamData%FreqBE) + end if + if (allocated(SrcParamData%FreqBF)) then + LB(1:3) = lbound(SrcParamData%FreqBF) + UB(1:3) = ubound(SrcParamData%FreqBF) + if (.not. allocated(DstParamData%FreqBF)) then + allocate(DstParamData%FreqBF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FreqBF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%FreqBF = SrcParamData%FreqBF + else if (allocated(DstParamData%FreqBF)) then + deallocate(DstParamData%FreqBF) + end if + DstParamData%FreqTFA = SrcParamData%FreqTFA + DstParamData%FreqTSS = SrcParamData%FreqTSS + DstParamData%TeetCDmp = SrcParamData%TeetCDmp + DstParamData%TeetDmp = SrcParamData%TeetDmp + DstParamData%TeetDmpP = SrcParamData%TeetDmpP + DstParamData%TeetHSSp = SrcParamData%TeetHSSp + DstParamData%TeetHStP = SrcParamData%TeetHStP + DstParamData%TeetSSSp = SrcParamData%TeetSSSp + DstParamData%TeetSStP = SrcParamData%TeetSStP + DstParamData%TeetMod = SrcParamData%TeetMod + DstParamData%TFrlDmp = SrcParamData%TFrlDmp + DstParamData%TFrlDSDmp = SrcParamData%TFrlDSDmp + DstParamData%TFrlDSDP = SrcParamData%TFrlDSDP + DstParamData%TFrlDSSP = SrcParamData%TFrlDSSP + DstParamData%TFrlDSSpr = SrcParamData%TFrlDSSpr + DstParamData%TFrlSpr = SrcParamData%TFrlSpr + DstParamData%TFrlUSDmp = SrcParamData%TFrlUSDmp + DstParamData%TFrlUSDP = SrcParamData%TFrlUSDP + DstParamData%TFrlUSSP = SrcParamData%TFrlUSSP + DstParamData%TFrlUSSpr = SrcParamData%TFrlUSSpr + DstParamData%TFrlMod = SrcParamData%TFrlMod + DstParamData%RFrlDmp = SrcParamData%RFrlDmp + DstParamData%RFrlDSDmp = SrcParamData%RFrlDSDmp + DstParamData%RFrlDSDP = SrcParamData%RFrlDSDP + DstParamData%RFrlDSSP = SrcParamData%RFrlDSSP + DstParamData%RFrlDSSpr = SrcParamData%RFrlDSSpr + DstParamData%RFrlSpr = SrcParamData%RFrlSpr + DstParamData%RFrlUSDmp = SrcParamData%RFrlUSDmp + DstParamData%RFrlUSDP = SrcParamData%RFrlUSDP + DstParamData%RFrlUSSP = SrcParamData%RFrlUSSP + DstParamData%RFrlUSSpr = SrcParamData%RFrlUSSpr + DstParamData%RFrlMod = SrcParamData%RFrlMod + DstParamData%ShftGagL = SrcParamData%ShftGagL + DstParamData%BldGagNd = SrcParamData%BldGagNd + DstParamData%TwrGagNd = SrcParamData%TwrGagNd + DstParamData%TStart = SrcParamData%TStart + DstParamData%DTTorDmp = SrcParamData%DTTorDmp + DstParamData%DTTorSpr = SrcParamData%DTTorSpr + DstParamData%GBRatio = SrcParamData%GBRatio + DstParamData%GBoxEff = SrcParamData%GBoxEff + DstParamData%RotSpeed = SrcParamData%RotSpeed + DstParamData%RootName = SrcParamData%RootName + if (allocated(SrcParamData%BElmntMass)) then + LB(1:2) = lbound(SrcParamData%BElmntMass) + UB(1:2) = ubound(SrcParamData%BElmntMass) + if (.not. allocated(DstParamData%BElmntMass)) then + allocate(DstParamData%BElmntMass(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BElmntMass.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BElmntMass = SrcParamData%BElmntMass + else if (allocated(DstParamData%BElmntMass)) then + deallocate(DstParamData%BElmntMass) + end if + if (allocated(SrcParamData%TElmntMass)) then + LB(1:1) = lbound(SrcParamData%TElmntMass) + UB(1:1) = ubound(SrcParamData%TElmntMass) + if (.not. allocated(DstParamData%TElmntMass)) then + allocate(DstParamData%TElmntMass(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TElmntMass.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%TElmntMass = SrcParamData%TElmntMass + else if (allocated(DstParamData%TElmntMass)) then + deallocate(DstParamData%TElmntMass) + end if + DstParamData%method = SrcParamData%method + DstParamData%PtfmCMxt = SrcParamData%PtfmCMxt + DstParamData%PtfmCMyt = SrcParamData%PtfmCMyt + DstParamData%BD4Blades = SrcParamData%BD4Blades + DstParamData%UseAD14 = SrcParamData%UseAD14 + DstParamData%BldNd_NumOuts = SrcParamData%BldNd_NumOuts + DstParamData%BldNd_TotNumOuts = SrcParamData%BldNd_TotNumOuts + if (allocated(SrcParamData%BldNd_OutParam)) then + LB(1:1) = lbound(SrcParamData%BldNd_OutParam) + UB(1:1) = ubound(SrcParamData%BldNd_OutParam) + if (.not. allocated(DstParamData%BldNd_OutParam)) then + allocate(DstParamData%BldNd_OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldNd_OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcParamData%BldNd_OutParam(i1), DstParamData%BldNd_OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstParamData%BldNd_OutParam)) then + deallocate(DstParamData%BldNd_OutParam) + end if + DstParamData%BldNd_BladesOut = SrcParamData%BldNd_BladesOut + if (allocated(SrcParamData%Jac_u_indx)) then + LB(1:2) = lbound(SrcParamData%Jac_u_indx) + UB(1:2) = ubound(SrcParamData%Jac_u_indx) + if (.not. allocated(DstParamData%Jac_u_indx)) then + allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx + else if (allocated(DstParamData%Jac_u_indx)) then + deallocate(DstParamData%Jac_u_indx) + end if + if (allocated(SrcParamData%du)) then + LB(1:1) = lbound(SrcParamData%du) + UB(1:1) = ubound(SrcParamData%du) + if (.not. allocated(DstParamData%du)) then + allocate(DstParamData%du(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%du = SrcParamData%du + else if (allocated(DstParamData%du)) then + deallocate(DstParamData%du) + end if + if (allocated(SrcParamData%dx)) then + LB(1:1) = lbound(SrcParamData%dx) + UB(1:1) = ubound(SrcParamData%dx) + if (.not. allocated(DstParamData%dx)) then + allocate(DstParamData%dx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%dx = SrcParamData%dx + else if (allocated(DstParamData%dx)) then + deallocate(DstParamData%dx) + end if + DstParamData%Jac_ny = SrcParamData%Jac_ny +end subroutine +subroutine ED_DestroyParam(ParamData, ErrStat, ErrMsg) + type(ED_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3, i4, i5 + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ED_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%PH)) then + deallocate(ParamData%PH) + end if + if (allocated(ParamData%PM)) then + deallocate(ParamData%PM) + end if + if (allocated(ParamData%DOF_Flag)) then + deallocate(ParamData%DOF_Flag) + end if + if (allocated(ParamData%DOF_Desc)) then + deallocate(ParamData%DOF_Desc) + end if + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%OutParam) + end if + if (allocated(ParamData%CosPreC)) then + deallocate(ParamData%CosPreC) + end if + if (allocated(ParamData%SinPreC)) then + deallocate(ParamData%SinPreC) + end if + if (allocated(ParamData%AxRedTFA)) then + deallocate(ParamData%AxRedTFA) + end if + if (allocated(ParamData%AxRedTSS)) then + deallocate(ParamData%AxRedTSS) + end if + if (allocated(ParamData%DHNodes)) then + deallocate(ParamData%DHNodes) + end if + if (allocated(ParamData%HNodes)) then + deallocate(ParamData%HNodes) + end if + if (allocated(ParamData%HNodesNorm)) then + deallocate(ParamData%HNodesNorm) + end if + if (allocated(ParamData%MassT)) then + deallocate(ParamData%MassT) + end if + if (allocated(ParamData%StiffTSS)) then + deallocate(ParamData%StiffTSS) + end if + if (allocated(ParamData%TwrFASF)) then + deallocate(ParamData%TwrFASF) + end if + if (allocated(ParamData%TwrSSSF)) then + deallocate(ParamData%TwrSSSF) + end if + if (allocated(ParamData%StiffTFA)) then + deallocate(ParamData%StiffTFA) + end if + if (allocated(ParamData%BldCG)) then + deallocate(ParamData%BldCG) + end if + if (allocated(ParamData%BldMass)) then + deallocate(ParamData%BldMass) + end if + if (allocated(ParamData%FirstMom)) then + deallocate(ParamData%FirstMom) + end if + if (allocated(ParamData%SecondMom)) then + deallocate(ParamData%SecondMom) + end if + if (allocated(ParamData%TipMass)) then + deallocate(ParamData%TipMass) + end if + if (allocated(ParamData%PitchAxis)) then + deallocate(ParamData%PitchAxis) + end if + if (allocated(ParamData%AeroTwst)) then + deallocate(ParamData%AeroTwst) + end if + if (allocated(ParamData%AxRedBld)) then + deallocate(ParamData%AxRedBld) + end if + if (allocated(ParamData%BldEDamp)) then + deallocate(ParamData%BldEDamp) + end if + if (allocated(ParamData%BldFDamp)) then + deallocate(ParamData%BldFDamp) + end if + if (allocated(ParamData%CAeroTwst)) then + deallocate(ParamData%CAeroTwst) + end if + if (allocated(ParamData%CBE)) then + deallocate(ParamData%CBE) + end if + if (allocated(ParamData%CBF)) then + deallocate(ParamData%CBF) + end if + if (allocated(ParamData%Chord)) then + deallocate(ParamData%Chord) + end if + if (allocated(ParamData%CThetaS)) then + deallocate(ParamData%CThetaS) + end if + if (allocated(ParamData%DRNodes)) then + deallocate(ParamData%DRNodes) + end if + if (allocated(ParamData%FStTunr)) then + deallocate(ParamData%FStTunr) + end if + if (allocated(ParamData%KBE)) then + deallocate(ParamData%KBE) + end if + if (allocated(ParamData%KBF)) then + deallocate(ParamData%KBF) + end if + if (allocated(ParamData%MassB)) then + deallocate(ParamData%MassB) + end if + if (allocated(ParamData%RNodes)) then + deallocate(ParamData%RNodes) + end if + if (allocated(ParamData%RNodesNorm)) then + deallocate(ParamData%RNodesNorm) + end if + if (allocated(ParamData%rSAerCenn1)) then + deallocate(ParamData%rSAerCenn1) + end if + if (allocated(ParamData%rSAerCenn2)) then + deallocate(ParamData%rSAerCenn2) + end if + if (allocated(ParamData%SAeroTwst)) then + deallocate(ParamData%SAeroTwst) + end if + if (allocated(ParamData%StiffBE)) then + deallocate(ParamData%StiffBE) + end if + if (allocated(ParamData%StiffBF)) then + deallocate(ParamData%StiffBF) + end if + if (allocated(ParamData%SThetaS)) then + deallocate(ParamData%SThetaS) + end if + if (allocated(ParamData%ThetaS)) then + deallocate(ParamData%ThetaS) + end if + if (allocated(ParamData%TwistedSF)) then + deallocate(ParamData%TwistedSF) + end if + if (allocated(ParamData%BldFl1Sh)) then + deallocate(ParamData%BldFl1Sh) + end if + if (allocated(ParamData%BldFl2Sh)) then + deallocate(ParamData%BldFl2Sh) + end if + if (allocated(ParamData%BldEdgSh)) then + deallocate(ParamData%BldEdgSh) + end if + if (allocated(ParamData%FreqBE)) then + deallocate(ParamData%FreqBE) + end if + if (allocated(ParamData%FreqBF)) then + deallocate(ParamData%FreqBF) + end if + if (allocated(ParamData%BElmntMass)) then + deallocate(ParamData%BElmntMass) + end if + if (allocated(ParamData%TElmntMass)) then + deallocate(ParamData%TElmntMass) + end if + if (allocated(ParamData%BldNd_OutParam)) then + LB(1:1) = lbound(ParamData%BldNd_OutParam) + UB(1:1) = ubound(ParamData%BldNd_OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%BldNd_OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%BldNd_OutParam) + end if + if (allocated(ParamData%Jac_u_indx)) then + deallocate(ParamData%Jac_u_indx) + end if + if (allocated(ParamData%du)) then + deallocate(ParamData%du) + end if + if (allocated(ParamData%dx)) then + deallocate(ParamData%dx) + end if +end subroutine subroutine ED_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -10662,77 +9672,58 @@ subroutine ED_PackParam(Buf, Indata) integer(IntKi) :: i1, i2, i3, i4, i5 integer(IntKi) :: LB(5), UB(5) if (Buf%ErrStat >= AbortErrLev) return - ! DT call RegPack(Buf, InData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! DT24 call RegPack(Buf, InData%DT24) if (RegCheckErr(Buf, RoutineName)) return - ! BldNodes call RegPack(Buf, InData%BldNodes) if (RegCheckErr(Buf, RoutineName)) return - ! TipNode call RegPack(Buf, InData%TipNode) if (RegCheckErr(Buf, RoutineName)) return - ! NDOF call RegPack(Buf, InData%NDOF) if (RegCheckErr(Buf, RoutineName)) return - ! TwoPiNB call RegPack(Buf, InData%TwoPiNB) if (RegCheckErr(Buf, RoutineName)) return - ! NAug call RegPack(Buf, InData%NAug) if (RegCheckErr(Buf, RoutineName)) return - ! NPH call RegPack(Buf, InData%NPH) if (RegCheckErr(Buf, RoutineName)) return - ! PH call RegPack(Buf, allocated(InData%PH)) if (allocated(InData%PH)) then call RegPackBounds(Buf, 1, lbound(InData%PH), ubound(InData%PH)) call RegPack(Buf, InData%PH) end if if (RegCheckErr(Buf, RoutineName)) return - ! NPM call RegPack(Buf, InData%NPM) if (RegCheckErr(Buf, RoutineName)) return - ! PM call RegPack(Buf, allocated(InData%PM)) if (allocated(InData%PM)) then call RegPackBounds(Buf, 2, lbound(InData%PM), ubound(InData%PM)) call RegPack(Buf, InData%PM) end if if (RegCheckErr(Buf, RoutineName)) return - ! DOF_Flag call RegPack(Buf, allocated(InData%DOF_Flag)) if (allocated(InData%DOF_Flag)) then call RegPackBounds(Buf, 1, lbound(InData%DOF_Flag), ubound(InData%DOF_Flag)) call RegPack(Buf, InData%DOF_Flag) end if if (RegCheckErr(Buf, RoutineName)) return - ! DOF_Desc call RegPack(Buf, allocated(InData%DOF_Desc)) if (allocated(InData%DOF_Desc)) then call RegPackBounds(Buf, 1, lbound(InData%DOF_Desc), ubound(InData%DOF_Desc)) call RegPack(Buf, InData%DOF_Desc) end if if (RegCheckErr(Buf, RoutineName)) return - ! DOFs call ED_PackActiveDOFs(Buf, InData%DOFs) if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegPack(Buf, InData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! OutFmt call RegPack(Buf, InData%OutFmt) if (RegCheckErr(Buf, RoutineName)) return - ! NBlGages call RegPack(Buf, InData%NBlGages) if (RegCheckErr(Buf, RoutineName)) return - ! NTwGages call RegPack(Buf, InData%NTwGages) if (RegCheckErr(Buf, RoutineName)) return - ! OutParam call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) @@ -10743,782 +9734,588 @@ subroutine ED_PackParam(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! Delim call RegPack(Buf, InData%Delim) if (RegCheckErr(Buf, RoutineName)) return - ! AvgNrmTpRd call RegPack(Buf, InData%AvgNrmTpRd) if (RegCheckErr(Buf, RoutineName)) return - ! AzimB1Up call RegPack(Buf, InData%AzimB1Up) if (RegCheckErr(Buf, RoutineName)) return - ! CosDel3 call RegPack(Buf, InData%CosDel3) if (RegCheckErr(Buf, RoutineName)) return - ! CosPreC call RegPack(Buf, allocated(InData%CosPreC)) if (allocated(InData%CosPreC)) then call RegPackBounds(Buf, 1, lbound(InData%CosPreC), ubound(InData%CosPreC)) call RegPack(Buf, InData%CosPreC) end if if (RegCheckErr(Buf, RoutineName)) return - ! CRFrlSkew call RegPack(Buf, InData%CRFrlSkew) if (RegCheckErr(Buf, RoutineName)) return - ! CRFrlSkw2 call RegPack(Buf, InData%CRFrlSkw2) if (RegCheckErr(Buf, RoutineName)) return - ! CRFrlTilt call RegPack(Buf, InData%CRFrlTilt) if (RegCheckErr(Buf, RoutineName)) return - ! CRFrlTlt2 call RegPack(Buf, InData%CRFrlTlt2) if (RegCheckErr(Buf, RoutineName)) return - ! CShftSkew call RegPack(Buf, InData%CShftSkew) if (RegCheckErr(Buf, RoutineName)) return - ! CShftTilt call RegPack(Buf, InData%CShftTilt) if (RegCheckErr(Buf, RoutineName)) return - ! CSRFrlSkw call RegPack(Buf, InData%CSRFrlSkw) if (RegCheckErr(Buf, RoutineName)) return - ! CSRFrlTlt call RegPack(Buf, InData%CSRFrlTlt) if (RegCheckErr(Buf, RoutineName)) return - ! CSTFrlSkw call RegPack(Buf, InData%CSTFrlSkw) if (RegCheckErr(Buf, RoutineName)) return - ! CSTFrlTlt call RegPack(Buf, InData%CSTFrlTlt) if (RegCheckErr(Buf, RoutineName)) return - ! CTFrlSkew call RegPack(Buf, InData%CTFrlSkew) if (RegCheckErr(Buf, RoutineName)) return - ! CTFrlSkw2 call RegPack(Buf, InData%CTFrlSkw2) if (RegCheckErr(Buf, RoutineName)) return - ! CTFrlTilt call RegPack(Buf, InData%CTFrlTilt) if (RegCheckErr(Buf, RoutineName)) return - ! CTFrlTlt2 call RegPack(Buf, InData%CTFrlTlt2) if (RegCheckErr(Buf, RoutineName)) return - ! HubHt call RegPack(Buf, InData%HubHt) if (RegCheckErr(Buf, RoutineName)) return - ! HubCM call RegPack(Buf, InData%HubCM) if (RegCheckErr(Buf, RoutineName)) return - ! HubRad call RegPack(Buf, InData%HubRad) if (RegCheckErr(Buf, RoutineName)) return - ! NacCMxn call RegPack(Buf, InData%NacCMxn) if (RegCheckErr(Buf, RoutineName)) return - ! NacCMyn call RegPack(Buf, InData%NacCMyn) if (RegCheckErr(Buf, RoutineName)) return - ! NacCMzn call RegPack(Buf, InData%NacCMzn) if (RegCheckErr(Buf, RoutineName)) return - ! OverHang call RegPack(Buf, InData%OverHang) if (RegCheckErr(Buf, RoutineName)) return - ! ProjArea call RegPack(Buf, InData%ProjArea) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmRefzt call RegPack(Buf, InData%PtfmRefzt) if (RegCheckErr(Buf, RoutineName)) return - ! RefTwrHt call RegPack(Buf, InData%RefTwrHt) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlPnt_n call RegPack(Buf, InData%RFrlPnt_n) if (RegCheckErr(Buf, RoutineName)) return - ! rVDxn call RegPack(Buf, InData%rVDxn) if (RegCheckErr(Buf, RoutineName)) return - ! rVDyn call RegPack(Buf, InData%rVDyn) if (RegCheckErr(Buf, RoutineName)) return - ! rVDzn call RegPack(Buf, InData%rVDzn) if (RegCheckErr(Buf, RoutineName)) return - ! rVIMUxn call RegPack(Buf, InData%rVIMUxn) if (RegCheckErr(Buf, RoutineName)) return - ! rVIMUyn call RegPack(Buf, InData%rVIMUyn) if (RegCheckErr(Buf, RoutineName)) return - ! rVIMUzn call RegPack(Buf, InData%rVIMUzn) if (RegCheckErr(Buf, RoutineName)) return - ! rVPxn call RegPack(Buf, InData%rVPxn) if (RegCheckErr(Buf, RoutineName)) return - ! rVPyn call RegPack(Buf, InData%rVPyn) if (RegCheckErr(Buf, RoutineName)) return - ! rVPzn call RegPack(Buf, InData%rVPzn) if (RegCheckErr(Buf, RoutineName)) return - ! rWIxn call RegPack(Buf, InData%rWIxn) if (RegCheckErr(Buf, RoutineName)) return - ! rWIyn call RegPack(Buf, InData%rWIyn) if (RegCheckErr(Buf, RoutineName)) return - ! rWIzn call RegPack(Buf, InData%rWIzn) if (RegCheckErr(Buf, RoutineName)) return - ! rWJxn call RegPack(Buf, InData%rWJxn) if (RegCheckErr(Buf, RoutineName)) return - ! rWJyn call RegPack(Buf, InData%rWJyn) if (RegCheckErr(Buf, RoutineName)) return - ! rWJzn call RegPack(Buf, InData%rWJzn) if (RegCheckErr(Buf, RoutineName)) return - ! rZT0zt call RegPack(Buf, InData%rZT0zt) if (RegCheckErr(Buf, RoutineName)) return - ! rZYzt call RegPack(Buf, InData%rZYzt) if (RegCheckErr(Buf, RoutineName)) return - ! SinDel3 call RegPack(Buf, InData%SinDel3) if (RegCheckErr(Buf, RoutineName)) return - ! SinPreC call RegPack(Buf, allocated(InData%SinPreC)) if (allocated(InData%SinPreC)) then call RegPackBounds(Buf, 1, lbound(InData%SinPreC), ubound(InData%SinPreC)) call RegPack(Buf, InData%SinPreC) end if if (RegCheckErr(Buf, RoutineName)) return - ! SRFrlSkew call RegPack(Buf, InData%SRFrlSkew) if (RegCheckErr(Buf, RoutineName)) return - ! SRFrlSkw2 call RegPack(Buf, InData%SRFrlSkw2) if (RegCheckErr(Buf, RoutineName)) return - ! SRFrlTilt call RegPack(Buf, InData%SRFrlTilt) if (RegCheckErr(Buf, RoutineName)) return - ! SRFrlTlt2 call RegPack(Buf, InData%SRFrlTlt2) if (RegCheckErr(Buf, RoutineName)) return - ! SShftSkew call RegPack(Buf, InData%SShftSkew) if (RegCheckErr(Buf, RoutineName)) return - ! SShftTilt call RegPack(Buf, InData%SShftTilt) if (RegCheckErr(Buf, RoutineName)) return - ! STFrlSkew call RegPack(Buf, InData%STFrlSkew) if (RegCheckErr(Buf, RoutineName)) return - ! STFrlSkw2 call RegPack(Buf, InData%STFrlSkw2) if (RegCheckErr(Buf, RoutineName)) return - ! STFrlTilt call RegPack(Buf, InData%STFrlTilt) if (RegCheckErr(Buf, RoutineName)) return - ! STFrlTlt2 call RegPack(Buf, InData%STFrlTlt2) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlPnt_n call RegPack(Buf, InData%TFrlPnt_n) if (RegCheckErr(Buf, RoutineName)) return - ! TipRad call RegPack(Buf, InData%TipRad) if (RegCheckErr(Buf, RoutineName)) return - ! TowerHt call RegPack(Buf, InData%TowerHt) if (RegCheckErr(Buf, RoutineName)) return - ! TowerBsHt call RegPack(Buf, InData%TowerBsHt) if (RegCheckErr(Buf, RoutineName)) return - ! UndSling call RegPack(Buf, InData%UndSling) if (RegCheckErr(Buf, RoutineName)) return - ! NumBl call RegPack(Buf, InData%NumBl) if (RegCheckErr(Buf, RoutineName)) return - ! AxRedTFA call RegPack(Buf, allocated(InData%AxRedTFA)) if (allocated(InData%AxRedTFA)) then call RegPackBounds(Buf, 3, lbound(InData%AxRedTFA), ubound(InData%AxRedTFA)) call RegPack(Buf, InData%AxRedTFA) end if if (RegCheckErr(Buf, RoutineName)) return - ! AxRedTSS call RegPack(Buf, allocated(InData%AxRedTSS)) if (allocated(InData%AxRedTSS)) then call RegPackBounds(Buf, 3, lbound(InData%AxRedTSS), ubound(InData%AxRedTSS)) call RegPack(Buf, InData%AxRedTSS) end if if (RegCheckErr(Buf, RoutineName)) return - ! CTFA call RegPack(Buf, InData%CTFA) if (RegCheckErr(Buf, RoutineName)) return - ! CTSS call RegPack(Buf, InData%CTSS) if (RegCheckErr(Buf, RoutineName)) return - ! DHNodes call RegPack(Buf, allocated(InData%DHNodes)) if (allocated(InData%DHNodes)) then call RegPackBounds(Buf, 1, lbound(InData%DHNodes), ubound(InData%DHNodes)) call RegPack(Buf, InData%DHNodes) end if if (RegCheckErr(Buf, RoutineName)) return - ! HNodes call RegPack(Buf, allocated(InData%HNodes)) if (allocated(InData%HNodes)) then call RegPackBounds(Buf, 1, lbound(InData%HNodes), ubound(InData%HNodes)) call RegPack(Buf, InData%HNodes) end if if (RegCheckErr(Buf, RoutineName)) return - ! HNodesNorm call RegPack(Buf, allocated(InData%HNodesNorm)) if (allocated(InData%HNodesNorm)) then call RegPackBounds(Buf, 1, lbound(InData%HNodesNorm), ubound(InData%HNodesNorm)) call RegPack(Buf, InData%HNodesNorm) end if if (RegCheckErr(Buf, RoutineName)) return - ! KTFA call RegPack(Buf, InData%KTFA) if (RegCheckErr(Buf, RoutineName)) return - ! KTSS call RegPack(Buf, InData%KTSS) if (RegCheckErr(Buf, RoutineName)) return - ! MassT call RegPack(Buf, allocated(InData%MassT)) if (allocated(InData%MassT)) then call RegPackBounds(Buf, 1, lbound(InData%MassT), ubound(InData%MassT)) call RegPack(Buf, InData%MassT) end if if (RegCheckErr(Buf, RoutineName)) return - ! StiffTSS call RegPack(Buf, allocated(InData%StiffTSS)) if (allocated(InData%StiffTSS)) then call RegPackBounds(Buf, 1, lbound(InData%StiffTSS), ubound(InData%StiffTSS)) call RegPack(Buf, InData%StiffTSS) end if if (RegCheckErr(Buf, RoutineName)) return - ! TwrFASF call RegPack(Buf, allocated(InData%TwrFASF)) if (allocated(InData%TwrFASF)) then call RegPackBounds(Buf, 3, lbound(InData%TwrFASF), ubound(InData%TwrFASF)) call RegPack(Buf, InData%TwrFASF) end if if (RegCheckErr(Buf, RoutineName)) return - ! TwrFlexL call RegPack(Buf, InData%TwrFlexL) if (RegCheckErr(Buf, RoutineName)) return - ! TwrSSSF call RegPack(Buf, allocated(InData%TwrSSSF)) if (allocated(InData%TwrSSSF)) then call RegPackBounds(Buf, 3, lbound(InData%TwrSSSF), ubound(InData%TwrSSSF)) call RegPack(Buf, InData%TwrSSSF) end if if (RegCheckErr(Buf, RoutineName)) return - ! TTopNode call RegPack(Buf, InData%TTopNode) if (RegCheckErr(Buf, RoutineName)) return - ! TwrNodes call RegPack(Buf, InData%TwrNodes) if (RegCheckErr(Buf, RoutineName)) return - ! MHK call RegPack(Buf, InData%MHK) if (RegCheckErr(Buf, RoutineName)) return - ! StiffTFA call RegPack(Buf, allocated(InData%StiffTFA)) if (allocated(InData%StiffTFA)) then call RegPackBounds(Buf, 1, lbound(InData%StiffTFA), ubound(InData%StiffTFA)) call RegPack(Buf, InData%StiffTFA) end if if (RegCheckErr(Buf, RoutineName)) return - ! AtfaIner call RegPack(Buf, InData%AtfaIner) if (RegCheckErr(Buf, RoutineName)) return - ! BldCG call RegPack(Buf, allocated(InData%BldCG)) if (allocated(InData%BldCG)) then call RegPackBounds(Buf, 1, lbound(InData%BldCG), ubound(InData%BldCG)) call RegPack(Buf, InData%BldCG) end if if (RegCheckErr(Buf, RoutineName)) return - ! BldMass call RegPack(Buf, allocated(InData%BldMass)) if (allocated(InData%BldMass)) then call RegPackBounds(Buf, 1, lbound(InData%BldMass), ubound(InData%BldMass)) call RegPack(Buf, InData%BldMass) end if if (RegCheckErr(Buf, RoutineName)) return - ! BoomMass call RegPack(Buf, InData%BoomMass) if (RegCheckErr(Buf, RoutineName)) return - ! FirstMom call RegPack(Buf, allocated(InData%FirstMom)) if (allocated(InData%FirstMom)) then call RegPackBounds(Buf, 1, lbound(InData%FirstMom), ubound(InData%FirstMom)) call RegPack(Buf, InData%FirstMom) end if if (RegCheckErr(Buf, RoutineName)) return - ! GenIner call RegPack(Buf, InData%GenIner) if (RegCheckErr(Buf, RoutineName)) return - ! Hubg1Iner call RegPack(Buf, InData%Hubg1Iner) if (RegCheckErr(Buf, RoutineName)) return - ! Hubg2Iner call RegPack(Buf, InData%Hubg2Iner) if (RegCheckErr(Buf, RoutineName)) return - ! HubMass call RegPack(Buf, InData%HubMass) if (RegCheckErr(Buf, RoutineName)) return - ! Nacd2Iner call RegPack(Buf, InData%Nacd2Iner) if (RegCheckErr(Buf, RoutineName)) return - ! NacMass call RegPack(Buf, InData%NacMass) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmMass call RegPack(Buf, InData%PtfmMass) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmPIner call RegPack(Buf, InData%PtfmPIner) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmRIner call RegPack(Buf, InData%PtfmRIner) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmYIner call RegPack(Buf, InData%PtfmYIner) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlMass call RegPack(Buf, InData%RFrlMass) if (RegCheckErr(Buf, RoutineName)) return - ! RotIner call RegPack(Buf, InData%RotIner) if (RegCheckErr(Buf, RoutineName)) return - ! RotMass call RegPack(Buf, InData%RotMass) if (RegCheckErr(Buf, RoutineName)) return - ! RrfaIner call RegPack(Buf, InData%RrfaIner) if (RegCheckErr(Buf, RoutineName)) return - ! SecondMom call RegPack(Buf, allocated(InData%SecondMom)) if (allocated(InData%SecondMom)) then call RegPackBounds(Buf, 1, lbound(InData%SecondMom), ubound(InData%SecondMom)) call RegPack(Buf, InData%SecondMom) end if if (RegCheckErr(Buf, RoutineName)) return - ! TFinMass call RegPack(Buf, InData%TFinMass) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlIner call RegPack(Buf, InData%TFrlIner) if (RegCheckErr(Buf, RoutineName)) return - ! TipMass call RegPack(Buf, allocated(InData%TipMass)) if (allocated(InData%TipMass)) then call RegPackBounds(Buf, 1, lbound(InData%TipMass), ubound(InData%TipMass)) call RegPack(Buf, InData%TipMass) end if if (RegCheckErr(Buf, RoutineName)) return - ! TurbMass call RegPack(Buf, InData%TurbMass) if (RegCheckErr(Buf, RoutineName)) return - ! TwrMass call RegPack(Buf, InData%TwrMass) if (RegCheckErr(Buf, RoutineName)) return - ! TwrTpMass call RegPack(Buf, InData%TwrTpMass) if (RegCheckErr(Buf, RoutineName)) return - ! YawBrMass call RegPack(Buf, InData%YawBrMass) if (RegCheckErr(Buf, RoutineName)) return - ! Gravity call RegPack(Buf, InData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - ! PitchAxis call RegPack(Buf, allocated(InData%PitchAxis)) if (allocated(InData%PitchAxis)) then call RegPackBounds(Buf, 2, lbound(InData%PitchAxis), ubound(InData%PitchAxis)) call RegPack(Buf, InData%PitchAxis) end if if (RegCheckErr(Buf, RoutineName)) return - ! AeroTwst call RegPack(Buf, allocated(InData%AeroTwst)) if (allocated(InData%AeroTwst)) then call RegPackBounds(Buf, 1, lbound(InData%AeroTwst), ubound(InData%AeroTwst)) call RegPack(Buf, InData%AeroTwst) end if if (RegCheckErr(Buf, RoutineName)) return - ! AxRedBld call RegPack(Buf, allocated(InData%AxRedBld)) if (allocated(InData%AxRedBld)) then call RegPackBounds(Buf, 4, lbound(InData%AxRedBld), ubound(InData%AxRedBld)) call RegPack(Buf, InData%AxRedBld) end if if (RegCheckErr(Buf, RoutineName)) return - ! BldEDamp call RegPack(Buf, allocated(InData%BldEDamp)) if (allocated(InData%BldEDamp)) then call RegPackBounds(Buf, 2, lbound(InData%BldEDamp), ubound(InData%BldEDamp)) call RegPack(Buf, InData%BldEDamp) end if if (RegCheckErr(Buf, RoutineName)) return - ! BldFDamp call RegPack(Buf, allocated(InData%BldFDamp)) if (allocated(InData%BldFDamp)) then call RegPackBounds(Buf, 2, lbound(InData%BldFDamp), ubound(InData%BldFDamp)) call RegPack(Buf, InData%BldFDamp) end if if (RegCheckErr(Buf, RoutineName)) return - ! BldFlexL call RegPack(Buf, InData%BldFlexL) if (RegCheckErr(Buf, RoutineName)) return - ! CAeroTwst call RegPack(Buf, allocated(InData%CAeroTwst)) if (allocated(InData%CAeroTwst)) then call RegPackBounds(Buf, 1, lbound(InData%CAeroTwst), ubound(InData%CAeroTwst)) call RegPack(Buf, InData%CAeroTwst) end if if (RegCheckErr(Buf, RoutineName)) return - ! CBE call RegPack(Buf, allocated(InData%CBE)) if (allocated(InData%CBE)) then call RegPackBounds(Buf, 3, lbound(InData%CBE), ubound(InData%CBE)) call RegPack(Buf, InData%CBE) end if if (RegCheckErr(Buf, RoutineName)) return - ! CBF call RegPack(Buf, allocated(InData%CBF)) if (allocated(InData%CBF)) then call RegPackBounds(Buf, 3, lbound(InData%CBF), ubound(InData%CBF)) call RegPack(Buf, InData%CBF) end if if (RegCheckErr(Buf, RoutineName)) return - ! Chord call RegPack(Buf, allocated(InData%Chord)) if (allocated(InData%Chord)) then call RegPackBounds(Buf, 1, lbound(InData%Chord), ubound(InData%Chord)) call RegPack(Buf, InData%Chord) end if if (RegCheckErr(Buf, RoutineName)) return - ! CThetaS call RegPack(Buf, allocated(InData%CThetaS)) if (allocated(InData%CThetaS)) then call RegPackBounds(Buf, 2, lbound(InData%CThetaS), ubound(InData%CThetaS)) call RegPack(Buf, InData%CThetaS) end if if (RegCheckErr(Buf, RoutineName)) return - ! DRNodes call RegPack(Buf, allocated(InData%DRNodes)) if (allocated(InData%DRNodes)) then call RegPackBounds(Buf, 1, lbound(InData%DRNodes), ubound(InData%DRNodes)) call RegPack(Buf, InData%DRNodes) end if if (RegCheckErr(Buf, RoutineName)) return - ! FStTunr call RegPack(Buf, allocated(InData%FStTunr)) if (allocated(InData%FStTunr)) then call RegPackBounds(Buf, 2, lbound(InData%FStTunr), ubound(InData%FStTunr)) call RegPack(Buf, InData%FStTunr) end if if (RegCheckErr(Buf, RoutineName)) return - ! KBE call RegPack(Buf, allocated(InData%KBE)) if (allocated(InData%KBE)) then call RegPackBounds(Buf, 3, lbound(InData%KBE), ubound(InData%KBE)) call RegPack(Buf, InData%KBE) end if if (RegCheckErr(Buf, RoutineName)) return - ! KBF call RegPack(Buf, allocated(InData%KBF)) if (allocated(InData%KBF)) then call RegPackBounds(Buf, 3, lbound(InData%KBF), ubound(InData%KBF)) call RegPack(Buf, InData%KBF) end if if (RegCheckErr(Buf, RoutineName)) return - ! MassB call RegPack(Buf, allocated(InData%MassB)) if (allocated(InData%MassB)) then call RegPackBounds(Buf, 2, lbound(InData%MassB), ubound(InData%MassB)) call RegPack(Buf, InData%MassB) end if if (RegCheckErr(Buf, RoutineName)) return - ! RNodes call RegPack(Buf, allocated(InData%RNodes)) if (allocated(InData%RNodes)) then call RegPackBounds(Buf, 1, lbound(InData%RNodes), ubound(InData%RNodes)) call RegPack(Buf, InData%RNodes) end if if (RegCheckErr(Buf, RoutineName)) return - ! RNodesNorm call RegPack(Buf, allocated(InData%RNodesNorm)) if (allocated(InData%RNodesNorm)) then call RegPackBounds(Buf, 1, lbound(InData%RNodesNorm), ubound(InData%RNodesNorm)) call RegPack(Buf, InData%RNodesNorm) end if if (RegCheckErr(Buf, RoutineName)) return - ! rSAerCenn1 call RegPack(Buf, allocated(InData%rSAerCenn1)) if (allocated(InData%rSAerCenn1)) then call RegPackBounds(Buf, 2, lbound(InData%rSAerCenn1), ubound(InData%rSAerCenn1)) call RegPack(Buf, InData%rSAerCenn1) end if if (RegCheckErr(Buf, RoutineName)) return - ! rSAerCenn2 call RegPack(Buf, allocated(InData%rSAerCenn2)) if (allocated(InData%rSAerCenn2)) then call RegPackBounds(Buf, 2, lbound(InData%rSAerCenn2), ubound(InData%rSAerCenn2)) call RegPack(Buf, InData%rSAerCenn2) end if if (RegCheckErr(Buf, RoutineName)) return - ! SAeroTwst call RegPack(Buf, allocated(InData%SAeroTwst)) if (allocated(InData%SAeroTwst)) then call RegPackBounds(Buf, 1, lbound(InData%SAeroTwst), ubound(InData%SAeroTwst)) call RegPack(Buf, InData%SAeroTwst) end if if (RegCheckErr(Buf, RoutineName)) return - ! StiffBE call RegPack(Buf, allocated(InData%StiffBE)) if (allocated(InData%StiffBE)) then call RegPackBounds(Buf, 2, lbound(InData%StiffBE), ubound(InData%StiffBE)) call RegPack(Buf, InData%StiffBE) end if if (RegCheckErr(Buf, RoutineName)) return - ! StiffBF call RegPack(Buf, allocated(InData%StiffBF)) if (allocated(InData%StiffBF)) then call RegPackBounds(Buf, 2, lbound(InData%StiffBF), ubound(InData%StiffBF)) call RegPack(Buf, InData%StiffBF) end if if (RegCheckErr(Buf, RoutineName)) return - ! SThetaS call RegPack(Buf, allocated(InData%SThetaS)) if (allocated(InData%SThetaS)) then call RegPackBounds(Buf, 2, lbound(InData%SThetaS), ubound(InData%SThetaS)) call RegPack(Buf, InData%SThetaS) end if if (RegCheckErr(Buf, RoutineName)) return - ! ThetaS call RegPack(Buf, allocated(InData%ThetaS)) if (allocated(InData%ThetaS)) then call RegPackBounds(Buf, 2, lbound(InData%ThetaS), ubound(InData%ThetaS)) call RegPack(Buf, InData%ThetaS) end if if (RegCheckErr(Buf, RoutineName)) return - ! TwistedSF call RegPack(Buf, allocated(InData%TwistedSF)) if (allocated(InData%TwistedSF)) then call RegPackBounds(Buf, 5, lbound(InData%TwistedSF), ubound(InData%TwistedSF)) call RegPack(Buf, InData%TwistedSF) end if if (RegCheckErr(Buf, RoutineName)) return - ! BldFl1Sh call RegPack(Buf, allocated(InData%BldFl1Sh)) if (allocated(InData%BldFl1Sh)) then call RegPackBounds(Buf, 2, lbound(InData%BldFl1Sh), ubound(InData%BldFl1Sh)) call RegPack(Buf, InData%BldFl1Sh) end if if (RegCheckErr(Buf, RoutineName)) return - ! BldFl2Sh call RegPack(Buf, allocated(InData%BldFl2Sh)) if (allocated(InData%BldFl2Sh)) then call RegPackBounds(Buf, 2, lbound(InData%BldFl2Sh), ubound(InData%BldFl2Sh)) call RegPack(Buf, InData%BldFl2Sh) end if if (RegCheckErr(Buf, RoutineName)) return - ! BldEdgSh call RegPack(Buf, allocated(InData%BldEdgSh)) if (allocated(InData%BldEdgSh)) then call RegPackBounds(Buf, 2, lbound(InData%BldEdgSh), ubound(InData%BldEdgSh)) call RegPack(Buf, InData%BldEdgSh) end if if (RegCheckErr(Buf, RoutineName)) return - ! FreqBE call RegPack(Buf, allocated(InData%FreqBE)) if (allocated(InData%FreqBE)) then call RegPackBounds(Buf, 3, lbound(InData%FreqBE), ubound(InData%FreqBE)) call RegPack(Buf, InData%FreqBE) end if if (RegCheckErr(Buf, RoutineName)) return - ! FreqBF call RegPack(Buf, allocated(InData%FreqBF)) if (allocated(InData%FreqBF)) then call RegPackBounds(Buf, 3, lbound(InData%FreqBF), ubound(InData%FreqBF)) call RegPack(Buf, InData%FreqBF) end if if (RegCheckErr(Buf, RoutineName)) return - ! FreqTFA call RegPack(Buf, InData%FreqTFA) if (RegCheckErr(Buf, RoutineName)) return - ! FreqTSS call RegPack(Buf, InData%FreqTSS) if (RegCheckErr(Buf, RoutineName)) return - ! TeetCDmp call RegPack(Buf, InData%TeetCDmp) if (RegCheckErr(Buf, RoutineName)) return - ! TeetDmp call RegPack(Buf, InData%TeetDmp) if (RegCheckErr(Buf, RoutineName)) return - ! TeetDmpP call RegPack(Buf, InData%TeetDmpP) if (RegCheckErr(Buf, RoutineName)) return - ! TeetHSSp call RegPack(Buf, InData%TeetHSSp) if (RegCheckErr(Buf, RoutineName)) return - ! TeetHStP call RegPack(Buf, InData%TeetHStP) if (RegCheckErr(Buf, RoutineName)) return - ! TeetSSSp call RegPack(Buf, InData%TeetSSSp) if (RegCheckErr(Buf, RoutineName)) return - ! TeetSStP call RegPack(Buf, InData%TeetSStP) if (RegCheckErr(Buf, RoutineName)) return - ! TeetMod call RegPack(Buf, InData%TeetMod) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlDmp call RegPack(Buf, InData%TFrlDmp) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlDSDmp call RegPack(Buf, InData%TFrlDSDmp) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlDSDP call RegPack(Buf, InData%TFrlDSDP) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlDSSP call RegPack(Buf, InData%TFrlDSSP) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlDSSpr call RegPack(Buf, InData%TFrlDSSpr) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlSpr call RegPack(Buf, InData%TFrlSpr) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlUSDmp call RegPack(Buf, InData%TFrlUSDmp) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlUSDP call RegPack(Buf, InData%TFrlUSDP) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlUSSP call RegPack(Buf, InData%TFrlUSSP) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlUSSpr call RegPack(Buf, InData%TFrlUSSpr) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlMod call RegPack(Buf, InData%TFrlMod) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlDmp call RegPack(Buf, InData%RFrlDmp) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlDSDmp call RegPack(Buf, InData%RFrlDSDmp) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlDSDP call RegPack(Buf, InData%RFrlDSDP) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlDSSP call RegPack(Buf, InData%RFrlDSSP) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlDSSpr call RegPack(Buf, InData%RFrlDSSpr) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlSpr call RegPack(Buf, InData%RFrlSpr) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlUSDmp call RegPack(Buf, InData%RFrlUSDmp) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlUSDP call RegPack(Buf, InData%RFrlUSDP) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlUSSP call RegPack(Buf, InData%RFrlUSSP) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlUSSpr call RegPack(Buf, InData%RFrlUSSpr) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlMod call RegPack(Buf, InData%RFrlMod) if (RegCheckErr(Buf, RoutineName)) return - ! ShftGagL call RegPack(Buf, InData%ShftGagL) if (RegCheckErr(Buf, RoutineName)) return - ! BldGagNd call RegPack(Buf, InData%BldGagNd) if (RegCheckErr(Buf, RoutineName)) return - ! TwrGagNd call RegPack(Buf, InData%TwrGagNd) if (RegCheckErr(Buf, RoutineName)) return - ! TStart call RegPack(Buf, InData%TStart) if (RegCheckErr(Buf, RoutineName)) return - ! DTTorDmp call RegPack(Buf, InData%DTTorDmp) if (RegCheckErr(Buf, RoutineName)) return - ! DTTorSpr call RegPack(Buf, InData%DTTorSpr) if (RegCheckErr(Buf, RoutineName)) return - ! GBRatio call RegPack(Buf, InData%GBRatio) if (RegCheckErr(Buf, RoutineName)) return - ! GBoxEff call RegPack(Buf, InData%GBoxEff) if (RegCheckErr(Buf, RoutineName)) return - ! RotSpeed call RegPack(Buf, InData%RotSpeed) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegPack(Buf, InData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! BElmntMass call RegPack(Buf, allocated(InData%BElmntMass)) if (allocated(InData%BElmntMass)) then call RegPackBounds(Buf, 2, lbound(InData%BElmntMass), ubound(InData%BElmntMass)) call RegPack(Buf, InData%BElmntMass) end if if (RegCheckErr(Buf, RoutineName)) return - ! TElmntMass call RegPack(Buf, allocated(InData%TElmntMass)) if (allocated(InData%TElmntMass)) then call RegPackBounds(Buf, 1, lbound(InData%TElmntMass), ubound(InData%TElmntMass)) call RegPack(Buf, InData%TElmntMass) end if if (RegCheckErr(Buf, RoutineName)) return - ! method call RegPack(Buf, InData%method) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmCMxt call RegPack(Buf, InData%PtfmCMxt) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmCMyt call RegPack(Buf, InData%PtfmCMyt) if (RegCheckErr(Buf, RoutineName)) return - ! BD4Blades call RegPack(Buf, InData%BD4Blades) if (RegCheckErr(Buf, RoutineName)) return - ! UseAD14 call RegPack(Buf, InData%UseAD14) if (RegCheckErr(Buf, RoutineName)) return - ! BldNd_NumOuts call RegPack(Buf, InData%BldNd_NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! BldNd_TotNumOuts call RegPack(Buf, InData%BldNd_TotNumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! BldNd_OutParam call RegPack(Buf, allocated(InData%BldNd_OutParam)) if (allocated(InData%BldNd_OutParam)) then call RegPackBounds(Buf, 1, lbound(InData%BldNd_OutParam), ubound(InData%BldNd_OutParam)) @@ -11529,31 +10326,26 @@ subroutine ED_PackParam(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! BldNd_BladesOut call RegPack(Buf, InData%BldNd_BladesOut) if (RegCheckErr(Buf, RoutineName)) return - ! Jac_u_indx call RegPack(Buf, allocated(InData%Jac_u_indx)) if (allocated(InData%Jac_u_indx)) then call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx), ubound(InData%Jac_u_indx)) call RegPack(Buf, InData%Jac_u_indx) end if if (RegCheckErr(Buf, RoutineName)) return - ! du call RegPack(Buf, allocated(InData%du)) if (allocated(InData%du)) then call RegPackBounds(Buf, 1, lbound(InData%du), ubound(InData%du)) call RegPack(Buf, InData%du) end if if (RegCheckErr(Buf, RoutineName)) return - ! dx call RegPack(Buf, allocated(InData%dx)) if (allocated(InData%dx)) then call RegPackBounds(Buf, 1, lbound(InData%dx), ubound(InData%dx)) call RegPack(Buf, InData%dx) end if if (RegCheckErr(Buf, RoutineName)) return - ! Jac_ny call RegPack(Buf, InData%Jac_ny) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -11567,31 +10359,22 @@ subroutine ED_UnPackParam(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! DT call RegUnpack(Buf, OutData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! DT24 call RegUnpack(Buf, OutData%DT24) if (RegCheckErr(Buf, RoutineName)) return - ! BldNodes call RegUnpack(Buf, OutData%BldNodes) if (RegCheckErr(Buf, RoutineName)) return - ! TipNode call RegUnpack(Buf, OutData%TipNode) if (RegCheckErr(Buf, RoutineName)) return - ! NDOF call RegUnpack(Buf, OutData%NDOF) if (RegCheckErr(Buf, RoutineName)) return - ! TwoPiNB call RegUnpack(Buf, OutData%TwoPiNB) if (RegCheckErr(Buf, RoutineName)) return - ! NAug call RegUnpack(Buf, OutData%NAug) if (RegCheckErr(Buf, RoutineName)) return - ! NPH call RegUnpack(Buf, OutData%NPH) if (RegCheckErr(Buf, RoutineName)) return - ! PH if (allocated(OutData%PH)) deallocate(OutData%PH) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -11606,10 +10389,8 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%PH) if (RegCheckErr(Buf, RoutineName)) return end if - ! NPM call RegUnpack(Buf, OutData%NPM) if (RegCheckErr(Buf, RoutineName)) return - ! PM if (allocated(OutData%PM)) deallocate(OutData%PM) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -11624,7 +10405,6 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%PM) if (RegCheckErr(Buf, RoutineName)) return end if - ! DOF_Flag if (allocated(OutData%DOF_Flag)) deallocate(OutData%DOF_Flag) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -11639,7 +10419,6 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%DOF_Flag) if (RegCheckErr(Buf, RoutineName)) return end if - ! DOF_Desc if (allocated(OutData%DOF_Desc)) deallocate(OutData%DOF_Desc) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -11654,21 +10433,15 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%DOF_Desc) if (RegCheckErr(Buf, RoutineName)) return end if - ! DOFs call ED_UnpackActiveDOFs(Buf, OutData%DOFs) ! DOFs - ! NumOuts call RegUnpack(Buf, OutData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! OutFmt call RegUnpack(Buf, OutData%OutFmt) if (RegCheckErr(Buf, RoutineName)) return - ! NBlGages call RegUnpack(Buf, OutData%NBlGages) if (RegCheckErr(Buf, RoutineName)) return - ! NTwGages call RegUnpack(Buf, OutData%NTwGages) if (RegCheckErr(Buf, RoutineName)) return - ! OutParam if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -11684,19 +10457,14 @@ subroutine ED_UnPackParam(Buf, OutData) call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam end do end if - ! Delim call RegUnpack(Buf, OutData%Delim) if (RegCheckErr(Buf, RoutineName)) return - ! AvgNrmTpRd call RegUnpack(Buf, OutData%AvgNrmTpRd) if (RegCheckErr(Buf, RoutineName)) return - ! AzimB1Up call RegUnpack(Buf, OutData%AzimB1Up) if (RegCheckErr(Buf, RoutineName)) return - ! CosDel3 call RegUnpack(Buf, OutData%CosDel3) if (RegCheckErr(Buf, RoutineName)) return - ! CosPreC if (allocated(OutData%CosPreC)) deallocate(OutData%CosPreC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -11711,136 +10479,92 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%CosPreC) if (RegCheckErr(Buf, RoutineName)) return end if - ! CRFrlSkew call RegUnpack(Buf, OutData%CRFrlSkew) if (RegCheckErr(Buf, RoutineName)) return - ! CRFrlSkw2 call RegUnpack(Buf, OutData%CRFrlSkw2) if (RegCheckErr(Buf, RoutineName)) return - ! CRFrlTilt call RegUnpack(Buf, OutData%CRFrlTilt) if (RegCheckErr(Buf, RoutineName)) return - ! CRFrlTlt2 call RegUnpack(Buf, OutData%CRFrlTlt2) if (RegCheckErr(Buf, RoutineName)) return - ! CShftSkew call RegUnpack(Buf, OutData%CShftSkew) if (RegCheckErr(Buf, RoutineName)) return - ! CShftTilt call RegUnpack(Buf, OutData%CShftTilt) if (RegCheckErr(Buf, RoutineName)) return - ! CSRFrlSkw call RegUnpack(Buf, OutData%CSRFrlSkw) if (RegCheckErr(Buf, RoutineName)) return - ! CSRFrlTlt call RegUnpack(Buf, OutData%CSRFrlTlt) if (RegCheckErr(Buf, RoutineName)) return - ! CSTFrlSkw call RegUnpack(Buf, OutData%CSTFrlSkw) if (RegCheckErr(Buf, RoutineName)) return - ! CSTFrlTlt call RegUnpack(Buf, OutData%CSTFrlTlt) if (RegCheckErr(Buf, RoutineName)) return - ! CTFrlSkew call RegUnpack(Buf, OutData%CTFrlSkew) if (RegCheckErr(Buf, RoutineName)) return - ! CTFrlSkw2 call RegUnpack(Buf, OutData%CTFrlSkw2) if (RegCheckErr(Buf, RoutineName)) return - ! CTFrlTilt call RegUnpack(Buf, OutData%CTFrlTilt) if (RegCheckErr(Buf, RoutineName)) return - ! CTFrlTlt2 call RegUnpack(Buf, OutData%CTFrlTlt2) if (RegCheckErr(Buf, RoutineName)) return - ! HubHt call RegUnpack(Buf, OutData%HubHt) if (RegCheckErr(Buf, RoutineName)) return - ! HubCM call RegUnpack(Buf, OutData%HubCM) if (RegCheckErr(Buf, RoutineName)) return - ! HubRad call RegUnpack(Buf, OutData%HubRad) if (RegCheckErr(Buf, RoutineName)) return - ! NacCMxn call RegUnpack(Buf, OutData%NacCMxn) if (RegCheckErr(Buf, RoutineName)) return - ! NacCMyn call RegUnpack(Buf, OutData%NacCMyn) if (RegCheckErr(Buf, RoutineName)) return - ! NacCMzn call RegUnpack(Buf, OutData%NacCMzn) if (RegCheckErr(Buf, RoutineName)) return - ! OverHang call RegUnpack(Buf, OutData%OverHang) if (RegCheckErr(Buf, RoutineName)) return - ! ProjArea call RegUnpack(Buf, OutData%ProjArea) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmRefzt call RegUnpack(Buf, OutData%PtfmRefzt) if (RegCheckErr(Buf, RoutineName)) return - ! RefTwrHt call RegUnpack(Buf, OutData%RefTwrHt) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlPnt_n call RegUnpack(Buf, OutData%RFrlPnt_n) if (RegCheckErr(Buf, RoutineName)) return - ! rVDxn call RegUnpack(Buf, OutData%rVDxn) if (RegCheckErr(Buf, RoutineName)) return - ! rVDyn call RegUnpack(Buf, OutData%rVDyn) if (RegCheckErr(Buf, RoutineName)) return - ! rVDzn call RegUnpack(Buf, OutData%rVDzn) if (RegCheckErr(Buf, RoutineName)) return - ! rVIMUxn call RegUnpack(Buf, OutData%rVIMUxn) if (RegCheckErr(Buf, RoutineName)) return - ! rVIMUyn call RegUnpack(Buf, OutData%rVIMUyn) if (RegCheckErr(Buf, RoutineName)) return - ! rVIMUzn call RegUnpack(Buf, OutData%rVIMUzn) if (RegCheckErr(Buf, RoutineName)) return - ! rVPxn call RegUnpack(Buf, OutData%rVPxn) if (RegCheckErr(Buf, RoutineName)) return - ! rVPyn call RegUnpack(Buf, OutData%rVPyn) if (RegCheckErr(Buf, RoutineName)) return - ! rVPzn call RegUnpack(Buf, OutData%rVPzn) if (RegCheckErr(Buf, RoutineName)) return - ! rWIxn call RegUnpack(Buf, OutData%rWIxn) if (RegCheckErr(Buf, RoutineName)) return - ! rWIyn call RegUnpack(Buf, OutData%rWIyn) if (RegCheckErr(Buf, RoutineName)) return - ! rWIzn call RegUnpack(Buf, OutData%rWIzn) if (RegCheckErr(Buf, RoutineName)) return - ! rWJxn call RegUnpack(Buf, OutData%rWJxn) if (RegCheckErr(Buf, RoutineName)) return - ! rWJyn call RegUnpack(Buf, OutData%rWJyn) if (RegCheckErr(Buf, RoutineName)) return - ! rWJzn call RegUnpack(Buf, OutData%rWJzn) if (RegCheckErr(Buf, RoutineName)) return - ! rZT0zt call RegUnpack(Buf, OutData%rZT0zt) if (RegCheckErr(Buf, RoutineName)) return - ! rZYzt call RegUnpack(Buf, OutData%rZYzt) if (RegCheckErr(Buf, RoutineName)) return - ! SinDel3 call RegUnpack(Buf, OutData%SinDel3) if (RegCheckErr(Buf, RoutineName)) return - ! SinPreC if (allocated(OutData%SinPreC)) deallocate(OutData%SinPreC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -11855,55 +10579,38 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%SinPreC) if (RegCheckErr(Buf, RoutineName)) return end if - ! SRFrlSkew call RegUnpack(Buf, OutData%SRFrlSkew) if (RegCheckErr(Buf, RoutineName)) return - ! SRFrlSkw2 call RegUnpack(Buf, OutData%SRFrlSkw2) if (RegCheckErr(Buf, RoutineName)) return - ! SRFrlTilt call RegUnpack(Buf, OutData%SRFrlTilt) if (RegCheckErr(Buf, RoutineName)) return - ! SRFrlTlt2 call RegUnpack(Buf, OutData%SRFrlTlt2) if (RegCheckErr(Buf, RoutineName)) return - ! SShftSkew call RegUnpack(Buf, OutData%SShftSkew) if (RegCheckErr(Buf, RoutineName)) return - ! SShftTilt call RegUnpack(Buf, OutData%SShftTilt) if (RegCheckErr(Buf, RoutineName)) return - ! STFrlSkew call RegUnpack(Buf, OutData%STFrlSkew) if (RegCheckErr(Buf, RoutineName)) return - ! STFrlSkw2 call RegUnpack(Buf, OutData%STFrlSkw2) if (RegCheckErr(Buf, RoutineName)) return - ! STFrlTilt call RegUnpack(Buf, OutData%STFrlTilt) if (RegCheckErr(Buf, RoutineName)) return - ! STFrlTlt2 call RegUnpack(Buf, OutData%STFrlTlt2) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlPnt_n call RegUnpack(Buf, OutData%TFrlPnt_n) if (RegCheckErr(Buf, RoutineName)) return - ! TipRad call RegUnpack(Buf, OutData%TipRad) if (RegCheckErr(Buf, RoutineName)) return - ! TowerHt call RegUnpack(Buf, OutData%TowerHt) if (RegCheckErr(Buf, RoutineName)) return - ! TowerBsHt call RegUnpack(Buf, OutData%TowerBsHt) if (RegCheckErr(Buf, RoutineName)) return - ! UndSling call RegUnpack(Buf, OutData%UndSling) if (RegCheckErr(Buf, RoutineName)) return - ! NumBl call RegUnpack(Buf, OutData%NumBl) if (RegCheckErr(Buf, RoutineName)) return - ! AxRedTFA if (allocated(OutData%AxRedTFA)) deallocate(OutData%AxRedTFA) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -11918,7 +10625,6 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%AxRedTFA) if (RegCheckErr(Buf, RoutineName)) return end if - ! AxRedTSS if (allocated(OutData%AxRedTSS)) deallocate(OutData%AxRedTSS) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -11933,13 +10639,10 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%AxRedTSS) if (RegCheckErr(Buf, RoutineName)) return end if - ! CTFA call RegUnpack(Buf, OutData%CTFA) if (RegCheckErr(Buf, RoutineName)) return - ! CTSS call RegUnpack(Buf, OutData%CTSS) if (RegCheckErr(Buf, RoutineName)) return - ! DHNodes if (allocated(OutData%DHNodes)) deallocate(OutData%DHNodes) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -11954,7 +10657,6 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%DHNodes) if (RegCheckErr(Buf, RoutineName)) return end if - ! HNodes if (allocated(OutData%HNodes)) deallocate(OutData%HNodes) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -11969,7 +10671,6 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%HNodes) if (RegCheckErr(Buf, RoutineName)) return end if - ! HNodesNorm if (allocated(OutData%HNodesNorm)) deallocate(OutData%HNodesNorm) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -11984,13 +10685,10 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%HNodesNorm) if (RegCheckErr(Buf, RoutineName)) return end if - ! KTFA call RegUnpack(Buf, OutData%KTFA) if (RegCheckErr(Buf, RoutineName)) return - ! KTSS call RegUnpack(Buf, OutData%KTSS) if (RegCheckErr(Buf, RoutineName)) return - ! MassT if (allocated(OutData%MassT)) deallocate(OutData%MassT) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12005,7 +10703,6 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%MassT) if (RegCheckErr(Buf, RoutineName)) return end if - ! StiffTSS if (allocated(OutData%StiffTSS)) deallocate(OutData%StiffTSS) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12020,7 +10717,6 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%StiffTSS) if (RegCheckErr(Buf, RoutineName)) return end if - ! TwrFASF if (allocated(OutData%TwrFASF)) deallocate(OutData%TwrFASF) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12035,10 +10731,8 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%TwrFASF) if (RegCheckErr(Buf, RoutineName)) return end if - ! TwrFlexL call RegUnpack(Buf, OutData%TwrFlexL) if (RegCheckErr(Buf, RoutineName)) return - ! TwrSSSF if (allocated(OutData%TwrSSSF)) deallocate(OutData%TwrSSSF) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12053,16 +10747,12 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%TwrSSSF) if (RegCheckErr(Buf, RoutineName)) return end if - ! TTopNode call RegUnpack(Buf, OutData%TTopNode) if (RegCheckErr(Buf, RoutineName)) return - ! TwrNodes call RegUnpack(Buf, OutData%TwrNodes) if (RegCheckErr(Buf, RoutineName)) return - ! MHK call RegUnpack(Buf, OutData%MHK) if (RegCheckErr(Buf, RoutineName)) return - ! StiffTFA if (allocated(OutData%StiffTFA)) deallocate(OutData%StiffTFA) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12077,10 +10767,8 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%StiffTFA) if (RegCheckErr(Buf, RoutineName)) return end if - ! AtfaIner call RegUnpack(Buf, OutData%AtfaIner) if (RegCheckErr(Buf, RoutineName)) return - ! BldCG if (allocated(OutData%BldCG)) deallocate(OutData%BldCG) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12095,7 +10783,6 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%BldCG) if (RegCheckErr(Buf, RoutineName)) return end if - ! BldMass if (allocated(OutData%BldMass)) deallocate(OutData%BldMass) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12110,10 +10797,8 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%BldMass) if (RegCheckErr(Buf, RoutineName)) return end if - ! BoomMass call RegUnpack(Buf, OutData%BoomMass) if (RegCheckErr(Buf, RoutineName)) return - ! FirstMom if (allocated(OutData%FirstMom)) deallocate(OutData%FirstMom) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12128,49 +10813,34 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%FirstMom) if (RegCheckErr(Buf, RoutineName)) return end if - ! GenIner call RegUnpack(Buf, OutData%GenIner) if (RegCheckErr(Buf, RoutineName)) return - ! Hubg1Iner call RegUnpack(Buf, OutData%Hubg1Iner) if (RegCheckErr(Buf, RoutineName)) return - ! Hubg2Iner call RegUnpack(Buf, OutData%Hubg2Iner) if (RegCheckErr(Buf, RoutineName)) return - ! HubMass call RegUnpack(Buf, OutData%HubMass) if (RegCheckErr(Buf, RoutineName)) return - ! Nacd2Iner call RegUnpack(Buf, OutData%Nacd2Iner) if (RegCheckErr(Buf, RoutineName)) return - ! NacMass call RegUnpack(Buf, OutData%NacMass) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmMass call RegUnpack(Buf, OutData%PtfmMass) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmPIner call RegUnpack(Buf, OutData%PtfmPIner) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmRIner call RegUnpack(Buf, OutData%PtfmRIner) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmYIner call RegUnpack(Buf, OutData%PtfmYIner) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlMass call RegUnpack(Buf, OutData%RFrlMass) if (RegCheckErr(Buf, RoutineName)) return - ! RotIner call RegUnpack(Buf, OutData%RotIner) if (RegCheckErr(Buf, RoutineName)) return - ! RotMass call RegUnpack(Buf, OutData%RotMass) if (RegCheckErr(Buf, RoutineName)) return - ! RrfaIner call RegUnpack(Buf, OutData%RrfaIner) if (RegCheckErr(Buf, RoutineName)) return - ! SecondMom if (allocated(OutData%SecondMom)) deallocate(OutData%SecondMom) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12185,13 +10855,10 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%SecondMom) if (RegCheckErr(Buf, RoutineName)) return end if - ! TFinMass call RegUnpack(Buf, OutData%TFinMass) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlIner call RegUnpack(Buf, OutData%TFrlIner) if (RegCheckErr(Buf, RoutineName)) return - ! TipMass if (allocated(OutData%TipMass)) deallocate(OutData%TipMass) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12206,22 +10873,16 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%TipMass) if (RegCheckErr(Buf, RoutineName)) return end if - ! TurbMass call RegUnpack(Buf, OutData%TurbMass) if (RegCheckErr(Buf, RoutineName)) return - ! TwrMass call RegUnpack(Buf, OutData%TwrMass) if (RegCheckErr(Buf, RoutineName)) return - ! TwrTpMass call RegUnpack(Buf, OutData%TwrTpMass) if (RegCheckErr(Buf, RoutineName)) return - ! YawBrMass call RegUnpack(Buf, OutData%YawBrMass) if (RegCheckErr(Buf, RoutineName)) return - ! Gravity call RegUnpack(Buf, OutData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - ! PitchAxis if (allocated(OutData%PitchAxis)) deallocate(OutData%PitchAxis) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12236,7 +10897,6 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%PitchAxis) if (RegCheckErr(Buf, RoutineName)) return end if - ! AeroTwst if (allocated(OutData%AeroTwst)) deallocate(OutData%AeroTwst) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12251,7 +10911,6 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%AeroTwst) if (RegCheckErr(Buf, RoutineName)) return end if - ! AxRedBld if (allocated(OutData%AxRedBld)) deallocate(OutData%AxRedBld) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12266,7 +10925,6 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%AxRedBld) if (RegCheckErr(Buf, RoutineName)) return end if - ! BldEDamp if (allocated(OutData%BldEDamp)) deallocate(OutData%BldEDamp) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12281,7 +10939,6 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%BldEDamp) if (RegCheckErr(Buf, RoutineName)) return end if - ! BldFDamp if (allocated(OutData%BldFDamp)) deallocate(OutData%BldFDamp) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12296,10 +10953,8 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%BldFDamp) if (RegCheckErr(Buf, RoutineName)) return end if - ! BldFlexL call RegUnpack(Buf, OutData%BldFlexL) if (RegCheckErr(Buf, RoutineName)) return - ! CAeroTwst if (allocated(OutData%CAeroTwst)) deallocate(OutData%CAeroTwst) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12314,7 +10969,6 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%CAeroTwst) if (RegCheckErr(Buf, RoutineName)) return end if - ! CBE if (allocated(OutData%CBE)) deallocate(OutData%CBE) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12329,7 +10983,6 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%CBE) if (RegCheckErr(Buf, RoutineName)) return end if - ! CBF if (allocated(OutData%CBF)) deallocate(OutData%CBF) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12344,7 +10997,6 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%CBF) if (RegCheckErr(Buf, RoutineName)) return end if - ! Chord if (allocated(OutData%Chord)) deallocate(OutData%Chord) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12359,7 +11011,6 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%Chord) if (RegCheckErr(Buf, RoutineName)) return end if - ! CThetaS if (allocated(OutData%CThetaS)) deallocate(OutData%CThetaS) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12374,7 +11025,6 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%CThetaS) if (RegCheckErr(Buf, RoutineName)) return end if - ! DRNodes if (allocated(OutData%DRNodes)) deallocate(OutData%DRNodes) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12389,7 +11039,6 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%DRNodes) if (RegCheckErr(Buf, RoutineName)) return end if - ! FStTunr if (allocated(OutData%FStTunr)) deallocate(OutData%FStTunr) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12404,7 +11053,6 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%FStTunr) if (RegCheckErr(Buf, RoutineName)) return end if - ! KBE if (allocated(OutData%KBE)) deallocate(OutData%KBE) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12419,7 +11067,6 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%KBE) if (RegCheckErr(Buf, RoutineName)) return end if - ! KBF if (allocated(OutData%KBF)) deallocate(OutData%KBF) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12434,7 +11081,6 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%KBF) if (RegCheckErr(Buf, RoutineName)) return end if - ! MassB if (allocated(OutData%MassB)) deallocate(OutData%MassB) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12449,7 +11095,6 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%MassB) if (RegCheckErr(Buf, RoutineName)) return end if - ! RNodes if (allocated(OutData%RNodes)) deallocate(OutData%RNodes) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12464,7 +11109,6 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%RNodes) if (RegCheckErr(Buf, RoutineName)) return end if - ! RNodesNorm if (allocated(OutData%RNodesNorm)) deallocate(OutData%RNodesNorm) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12479,7 +11123,6 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%RNodesNorm) if (RegCheckErr(Buf, RoutineName)) return end if - ! rSAerCenn1 if (allocated(OutData%rSAerCenn1)) deallocate(OutData%rSAerCenn1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12494,7 +11137,6 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%rSAerCenn1) if (RegCheckErr(Buf, RoutineName)) return end if - ! rSAerCenn2 if (allocated(OutData%rSAerCenn2)) deallocate(OutData%rSAerCenn2) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12509,7 +11151,6 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%rSAerCenn2) if (RegCheckErr(Buf, RoutineName)) return end if - ! SAeroTwst if (allocated(OutData%SAeroTwst)) deallocate(OutData%SAeroTwst) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12524,7 +11165,6 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%SAeroTwst) if (RegCheckErr(Buf, RoutineName)) return end if - ! StiffBE if (allocated(OutData%StiffBE)) deallocate(OutData%StiffBE) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12539,7 +11179,6 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%StiffBE) if (RegCheckErr(Buf, RoutineName)) return end if - ! StiffBF if (allocated(OutData%StiffBF)) deallocate(OutData%StiffBF) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12554,7 +11193,6 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%StiffBF) if (RegCheckErr(Buf, RoutineName)) return end if - ! SThetaS if (allocated(OutData%SThetaS)) deallocate(OutData%SThetaS) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12569,7 +11207,6 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%SThetaS) if (RegCheckErr(Buf, RoutineName)) return end if - ! ThetaS if (allocated(OutData%ThetaS)) deallocate(OutData%ThetaS) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12584,7 +11221,6 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%ThetaS) if (RegCheckErr(Buf, RoutineName)) return end if - ! TwistedSF if (allocated(OutData%TwistedSF)) deallocate(OutData%TwistedSF) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12599,7 +11235,6 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%TwistedSF) if (RegCheckErr(Buf, RoutineName)) return end if - ! BldFl1Sh if (allocated(OutData%BldFl1Sh)) deallocate(OutData%BldFl1Sh) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12614,7 +11249,6 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%BldFl1Sh) if (RegCheckErr(Buf, RoutineName)) return end if - ! BldFl2Sh if (allocated(OutData%BldFl2Sh)) deallocate(OutData%BldFl2Sh) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12629,7 +11263,6 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%BldFl2Sh) if (RegCheckErr(Buf, RoutineName)) return end if - ! BldEdgSh if (allocated(OutData%BldEdgSh)) deallocate(OutData%BldEdgSh) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12644,7 +11277,6 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%BldEdgSh) if (RegCheckErr(Buf, RoutineName)) return end if - ! FreqBE if (allocated(OutData%FreqBE)) deallocate(OutData%FreqBE) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12659,7 +11291,6 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%FreqBE) if (RegCheckErr(Buf, RoutineName)) return end if - ! FreqBF if (allocated(OutData%FreqBF)) deallocate(OutData%FreqBF) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12674,133 +11305,90 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%FreqBF) if (RegCheckErr(Buf, RoutineName)) return end if - ! FreqTFA call RegUnpack(Buf, OutData%FreqTFA) if (RegCheckErr(Buf, RoutineName)) return - ! FreqTSS call RegUnpack(Buf, OutData%FreqTSS) if (RegCheckErr(Buf, RoutineName)) return - ! TeetCDmp call RegUnpack(Buf, OutData%TeetCDmp) if (RegCheckErr(Buf, RoutineName)) return - ! TeetDmp call RegUnpack(Buf, OutData%TeetDmp) if (RegCheckErr(Buf, RoutineName)) return - ! TeetDmpP call RegUnpack(Buf, OutData%TeetDmpP) if (RegCheckErr(Buf, RoutineName)) return - ! TeetHSSp call RegUnpack(Buf, OutData%TeetHSSp) if (RegCheckErr(Buf, RoutineName)) return - ! TeetHStP call RegUnpack(Buf, OutData%TeetHStP) if (RegCheckErr(Buf, RoutineName)) return - ! TeetSSSp call RegUnpack(Buf, OutData%TeetSSSp) if (RegCheckErr(Buf, RoutineName)) return - ! TeetSStP call RegUnpack(Buf, OutData%TeetSStP) if (RegCheckErr(Buf, RoutineName)) return - ! TeetMod call RegUnpack(Buf, OutData%TeetMod) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlDmp call RegUnpack(Buf, OutData%TFrlDmp) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlDSDmp call RegUnpack(Buf, OutData%TFrlDSDmp) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlDSDP call RegUnpack(Buf, OutData%TFrlDSDP) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlDSSP call RegUnpack(Buf, OutData%TFrlDSSP) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlDSSpr call RegUnpack(Buf, OutData%TFrlDSSpr) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlSpr call RegUnpack(Buf, OutData%TFrlSpr) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlUSDmp call RegUnpack(Buf, OutData%TFrlUSDmp) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlUSDP call RegUnpack(Buf, OutData%TFrlUSDP) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlUSSP call RegUnpack(Buf, OutData%TFrlUSSP) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlUSSpr call RegUnpack(Buf, OutData%TFrlUSSpr) if (RegCheckErr(Buf, RoutineName)) return - ! TFrlMod call RegUnpack(Buf, OutData%TFrlMod) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlDmp call RegUnpack(Buf, OutData%RFrlDmp) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlDSDmp call RegUnpack(Buf, OutData%RFrlDSDmp) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlDSDP call RegUnpack(Buf, OutData%RFrlDSDP) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlDSSP call RegUnpack(Buf, OutData%RFrlDSSP) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlDSSpr call RegUnpack(Buf, OutData%RFrlDSSpr) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlSpr call RegUnpack(Buf, OutData%RFrlSpr) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlUSDmp call RegUnpack(Buf, OutData%RFrlUSDmp) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlUSDP call RegUnpack(Buf, OutData%RFrlUSDP) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlUSSP call RegUnpack(Buf, OutData%RFrlUSSP) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlUSSpr call RegUnpack(Buf, OutData%RFrlUSSpr) if (RegCheckErr(Buf, RoutineName)) return - ! RFrlMod call RegUnpack(Buf, OutData%RFrlMod) if (RegCheckErr(Buf, RoutineName)) return - ! ShftGagL call RegUnpack(Buf, OutData%ShftGagL) if (RegCheckErr(Buf, RoutineName)) return - ! BldGagNd call RegUnpack(Buf, OutData%BldGagNd) if (RegCheckErr(Buf, RoutineName)) return - ! TwrGagNd call RegUnpack(Buf, OutData%TwrGagNd) if (RegCheckErr(Buf, RoutineName)) return - ! TStart call RegUnpack(Buf, OutData%TStart) if (RegCheckErr(Buf, RoutineName)) return - ! DTTorDmp call RegUnpack(Buf, OutData%DTTorDmp) if (RegCheckErr(Buf, RoutineName)) return - ! DTTorSpr call RegUnpack(Buf, OutData%DTTorSpr) if (RegCheckErr(Buf, RoutineName)) return - ! GBRatio call RegUnpack(Buf, OutData%GBRatio) if (RegCheckErr(Buf, RoutineName)) return - ! GBoxEff call RegUnpack(Buf, OutData%GBoxEff) if (RegCheckErr(Buf, RoutineName)) return - ! RotSpeed call RegUnpack(Buf, OutData%RotSpeed) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegUnpack(Buf, OutData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! BElmntMass if (allocated(OutData%BElmntMass)) deallocate(OutData%BElmntMass) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12815,7 +11403,6 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%BElmntMass) if (RegCheckErr(Buf, RoutineName)) return end if - ! TElmntMass if (allocated(OutData%TElmntMass)) deallocate(OutData%TElmntMass) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12830,28 +11417,20 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%TElmntMass) if (RegCheckErr(Buf, RoutineName)) return end if - ! method call RegUnpack(Buf, OutData%method) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmCMxt call RegUnpack(Buf, OutData%PtfmCMxt) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmCMyt call RegUnpack(Buf, OutData%PtfmCMyt) if (RegCheckErr(Buf, RoutineName)) return - ! BD4Blades call RegUnpack(Buf, OutData%BD4Blades) if (RegCheckErr(Buf, RoutineName)) return - ! UseAD14 call RegUnpack(Buf, OutData%UseAD14) if (RegCheckErr(Buf, RoutineName)) return - ! BldNd_NumOuts call RegUnpack(Buf, OutData%BldNd_NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! BldNd_TotNumOuts call RegUnpack(Buf, OutData%BldNd_TotNumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! BldNd_OutParam if (allocated(OutData%BldNd_OutParam)) deallocate(OutData%BldNd_OutParam) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12867,10 +11446,8 @@ subroutine ED_UnPackParam(Buf, OutData) call NWTC_Library_UnpackOutParmType(Buf, OutData%BldNd_OutParam(i1)) ! BldNd_OutParam end do end if - ! BldNd_BladesOut call RegUnpack(Buf, OutData%BldNd_BladesOut) if (RegCheckErr(Buf, RoutineName)) return - ! Jac_u_indx if (allocated(OutData%Jac_u_indx)) deallocate(OutData%Jac_u_indx) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12885,7 +11462,6 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%Jac_u_indx) if (RegCheckErr(Buf, RoutineName)) return end if - ! du if (allocated(OutData%du)) deallocate(OutData%du) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12900,7 +11476,6 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%du) if (RegCheckErr(Buf, RoutineName)) return end if - ! dx if (allocated(OutData%dx)) deallocate(OutData%dx) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12915,130 +11490,117 @@ subroutine ED_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%dx) if (RegCheckErr(Buf, RoutineName)) return end if - ! Jac_ny call RegUnpack(Buf, OutData%Jac_ny) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE ED_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_InputType), INTENT(INOUT) :: SrcInputData - TYPE(ED_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_CopyInput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInputData%BladePtLoads)) THEN - i1_l = LBOUND(SrcInputData%BladePtLoads,1) - i1_u = UBOUND(SrcInputData%BladePtLoads,1) - IF (.NOT. ALLOCATED(DstInputData%BladePtLoads)) THEN - ALLOCATE(DstInputData%BladePtLoads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%BladePtLoads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputData%BladePtLoads,1), UBOUND(SrcInputData%BladePtLoads,1) - CALL MeshCopy( SrcInputData%BladePtLoads(i1), DstInputData%BladePtLoads(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL MeshCopy( SrcInputData%PlatformPtMesh, DstInputData%PlatformPtMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcInputData%TowerPtLoads, DstInputData%TowerPtLoads, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcInputData%HubPtLoad, DstInputData%HubPtLoad, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcInputData%NacelleLoads, DstInputData%NacelleLoads, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcInputData%TFinCMLoads, DstInputData%TFinCMLoads, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInputData%TwrAddedMass)) THEN - i1_l = LBOUND(SrcInputData%TwrAddedMass,1) - i1_u = UBOUND(SrcInputData%TwrAddedMass,1) - i2_l = LBOUND(SrcInputData%TwrAddedMass,2) - i2_u = UBOUND(SrcInputData%TwrAddedMass,2) - i3_l = LBOUND(SrcInputData%TwrAddedMass,3) - i3_u = UBOUND(SrcInputData%TwrAddedMass,3) - IF (.NOT. ALLOCATED(DstInputData%TwrAddedMass)) THEN - ALLOCATE(DstInputData%TwrAddedMass(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%TwrAddedMass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%TwrAddedMass = SrcInputData%TwrAddedMass -ENDIF - DstInputData%PtfmAddedMass = SrcInputData%PtfmAddedMass -IF (ALLOCATED(SrcInputData%BlPitchCom)) THEN - i1_l = LBOUND(SrcInputData%BlPitchCom,1) - i1_u = UBOUND(SrcInputData%BlPitchCom,1) - IF (.NOT. ALLOCATED(DstInputData%BlPitchCom)) THEN - ALLOCATE(DstInputData%BlPitchCom(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%BlPitchCom.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%BlPitchCom = SrcInputData%BlPitchCom -ENDIF - DstInputData%YawMom = SrcInputData%YawMom - DstInputData%GenTrq = SrcInputData%GenTrq - DstInputData%HSSBrTrqC = SrcInputData%HSSBrTrqC - END SUBROUTINE ED_CopyInput - - SUBROUTINE ED_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(ED_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(InputData%BladePtLoads)) THEN -DO i1 = LBOUND(InputData%BladePtLoads,1), UBOUND(InputData%BladePtLoads,1) - CALL MeshDestroy( InputData%BladePtLoads(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InputData%BladePtLoads) -ENDIF - CALL MeshDestroy( InputData%PlatformPtMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( InputData%TowerPtLoads, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( InputData%HubPtLoad, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( InputData%NacelleLoads, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( InputData%TFinCMLoads, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InputData%TwrAddedMass)) THEN - DEALLOCATE(InputData%TwrAddedMass) -ENDIF -IF (ALLOCATED(InputData%BlPitchCom)) THEN - DEALLOCATE(InputData%BlPitchCom) -ENDIF - END SUBROUTINE ED_DestroyInput +subroutine ED_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(ED_InputType), intent(inout) :: SrcInputData + type(ED_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ED_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInputData%BladePtLoads)) then + LB(1:1) = lbound(SrcInputData%BladePtLoads) + UB(1:1) = ubound(SrcInputData%BladePtLoads) + if (.not. allocated(DstInputData%BladePtLoads)) then + allocate(DstInputData%BladePtLoads(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%BladePtLoads.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcInputData%BladePtLoads(i1), DstInputData%BladePtLoads(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstInputData%BladePtLoads)) then + deallocate(DstInputData%BladePtLoads) + end if + call MeshCopy(SrcInputData%PlatformPtMesh, DstInputData%PlatformPtMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcInputData%TowerPtLoads, DstInputData%TowerPtLoads, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcInputData%HubPtLoad, DstInputData%HubPtLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcInputData%NacelleLoads, DstInputData%NacelleLoads, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcInputData%TFinCMLoads, DstInputData%TFinCMLoads, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInputData%TwrAddedMass)) then + LB(1:3) = lbound(SrcInputData%TwrAddedMass) + UB(1:3) = ubound(SrcInputData%TwrAddedMass) + if (.not. allocated(DstInputData%TwrAddedMass)) then + allocate(DstInputData%TwrAddedMass(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%TwrAddedMass.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%TwrAddedMass = SrcInputData%TwrAddedMass + else if (allocated(DstInputData%TwrAddedMass)) then + deallocate(DstInputData%TwrAddedMass) + end if + DstInputData%PtfmAddedMass = SrcInputData%PtfmAddedMass + if (allocated(SrcInputData%BlPitchCom)) then + LB(1:1) = lbound(SrcInputData%BlPitchCom) + UB(1:1) = ubound(SrcInputData%BlPitchCom) + if (.not. allocated(DstInputData%BlPitchCom)) then + allocate(DstInputData%BlPitchCom(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%BlPitchCom.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%BlPitchCom = SrcInputData%BlPitchCom + else if (allocated(DstInputData%BlPitchCom)) then + deallocate(DstInputData%BlPitchCom) + end if + DstInputData%YawMom = SrcInputData%YawMom + DstInputData%GenTrq = SrcInputData%GenTrq + DstInputData%HSSBrTrqC = SrcInputData%HSSBrTrqC +end subroutine +subroutine ED_DestroyInput(InputData, ErrStat, ErrMsg) + type(ED_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ED_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%BladePtLoads)) then + LB(1:1) = lbound(InputData%BladePtLoads) + UB(1:1) = ubound(InputData%BladePtLoads) + do i1 = LB(1), UB(1) + call MeshDestroy( InputData%BladePtLoads(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputData%BladePtLoads) + end if + if (allocated(InputData%TwrAddedMass)) then + deallocate(InputData%TwrAddedMass) + end if + if (allocated(InputData%BlPitchCom)) then + deallocate(InputData%BlPitchCom) + end if +end subroutine subroutine ED_PackInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -13047,7 +11609,6 @@ subroutine ED_PackInput(Buf, Indata) integer(IntKi) :: i1, i2, i3 integer(IntKi) :: LB(3), UB(3) if (Buf%ErrStat >= AbortErrLev) return - ! BladePtLoads call RegPack(Buf, allocated(InData%BladePtLoads)) if (allocated(InData%BladePtLoads)) then call RegPackBounds(Buf, 1, lbound(InData%BladePtLoads), ubound(InData%BladePtLoads)) @@ -13058,45 +11619,34 @@ subroutine ED_PackInput(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! PlatformPtMesh call MeshPack(Buf, InData%PlatformPtMesh) if (RegCheckErr(Buf, RoutineName)) return - ! TowerPtLoads call MeshPack(Buf, InData%TowerPtLoads) if (RegCheckErr(Buf, RoutineName)) return - ! HubPtLoad call MeshPack(Buf, InData%HubPtLoad) if (RegCheckErr(Buf, RoutineName)) return - ! NacelleLoads call MeshPack(Buf, InData%NacelleLoads) if (RegCheckErr(Buf, RoutineName)) return - ! TFinCMLoads call MeshPack(Buf, InData%TFinCMLoads) if (RegCheckErr(Buf, RoutineName)) return - ! TwrAddedMass call RegPack(Buf, allocated(InData%TwrAddedMass)) if (allocated(InData%TwrAddedMass)) then call RegPackBounds(Buf, 3, lbound(InData%TwrAddedMass), ubound(InData%TwrAddedMass)) call RegPack(Buf, InData%TwrAddedMass) end if if (RegCheckErr(Buf, RoutineName)) return - ! PtfmAddedMass call RegPack(Buf, InData%PtfmAddedMass) if (RegCheckErr(Buf, RoutineName)) return - ! BlPitchCom call RegPack(Buf, allocated(InData%BlPitchCom)) if (allocated(InData%BlPitchCom)) then call RegPackBounds(Buf, 1, lbound(InData%BlPitchCom), ubound(InData%BlPitchCom)) call RegPack(Buf, InData%BlPitchCom) end if if (RegCheckErr(Buf, RoutineName)) return - ! YawMom call RegPack(Buf, InData%YawMom) if (RegCheckErr(Buf, RoutineName)) return - ! GenTrq call RegPack(Buf, InData%GenTrq) if (RegCheckErr(Buf, RoutineName)) return - ! HSSBrTrqC call RegPack(Buf, InData%HSSBrTrqC) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -13110,7 +11660,6 @@ subroutine ED_UnPackInput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! BladePtLoads if (allocated(OutData%BladePtLoads)) deallocate(OutData%BladePtLoads) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -13126,17 +11675,11 @@ subroutine ED_UnPackInput(Buf, OutData) call MeshUnpack(Buf, OutData%BladePtLoads(i1)) ! BladePtLoads end do end if - ! PlatformPtMesh call MeshUnpack(Buf, OutData%PlatformPtMesh) ! PlatformPtMesh - ! TowerPtLoads call MeshUnpack(Buf, OutData%TowerPtLoads) ! TowerPtLoads - ! HubPtLoad call MeshUnpack(Buf, OutData%HubPtLoad) ! HubPtLoad - ! NacelleLoads call MeshUnpack(Buf, OutData%NacelleLoads) ! NacelleLoads - ! TFinCMLoads call MeshUnpack(Buf, OutData%TFinCMLoads) ! TFinCMLoads - ! TwrAddedMass if (allocated(OutData%TwrAddedMass)) deallocate(OutData%TwrAddedMass) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -13151,10 +11694,8 @@ subroutine ED_UnPackInput(Buf, OutData) call RegUnpack(Buf, OutData%TwrAddedMass) if (RegCheckErr(Buf, RoutineName)) return end if - ! PtfmAddedMass call RegUnpack(Buf, OutData%PtfmAddedMass) if (RegCheckErr(Buf, RoutineName)) return - ! BlPitchCom if (allocated(OutData%BlPitchCom)) deallocate(OutData%BlPitchCom) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -13169,195 +11710,182 @@ subroutine ED_UnPackInput(Buf, OutData) call RegUnpack(Buf, OutData%BlPitchCom) if (RegCheckErr(Buf, RoutineName)) return end if - ! YawMom call RegUnpack(Buf, OutData%YawMom) if (RegCheckErr(Buf, RoutineName)) return - ! GenTrq call RegUnpack(Buf, OutData%GenTrq) if (RegCheckErr(Buf, RoutineName)) return - ! HSSBrTrqC call RegUnpack(Buf, OutData%HSSBrTrqC) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE ED_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ED_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(ED_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_CopyOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%BladeLn2Mesh)) THEN - i1_l = LBOUND(SrcOutputData%BladeLn2Mesh,1) - i1_u = UBOUND(SrcOutputData%BladeLn2Mesh,1) - IF (.NOT. ALLOCATED(DstOutputData%BladeLn2Mesh)) THEN - ALLOCATE(DstOutputData%BladeLn2Mesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BladeLn2Mesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOutputData%BladeLn2Mesh,1), UBOUND(SrcOutputData%BladeLn2Mesh,1) - CALL MeshCopy( SrcOutputData%BladeLn2Mesh(i1), DstOutputData%BladeLn2Mesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL MeshCopy( SrcOutputData%PlatformPtMesh, DstOutputData%PlatformPtMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcOutputData%TowerLn2Mesh, DstOutputData%TowerLn2Mesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcOutputData%HubPtMotion14, DstOutputData%HubPtMotion14, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcOutputData%HubPtMotion, DstOutputData%HubPtMotion, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcOutputData%BladeRootMotion14, DstOutputData%BladeRootMotion14, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcOutputData%BladeRootMotion)) THEN - i1_l = LBOUND(SrcOutputData%BladeRootMotion,1) - i1_u = UBOUND(SrcOutputData%BladeRootMotion,1) - IF (.NOT. ALLOCATED(DstOutputData%BladeRootMotion)) THEN - ALLOCATE(DstOutputData%BladeRootMotion(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BladeRootMotion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOutputData%BladeRootMotion,1), UBOUND(SrcOutputData%BladeRootMotion,1) - CALL MeshCopy( SrcOutputData%BladeRootMotion(i1), DstOutputData%BladeRootMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL MeshCopy( SrcOutputData%RotorFurlMotion14, DstOutputData%RotorFurlMotion14, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcOutputData%NacelleMotion, DstOutputData%NacelleMotion, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcOutputData%TowerBaseMotion14, DstOutputData%TowerBaseMotion14, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcOutputData%TFinCMMotion, DstOutputData%TFinCMMotion, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcOutputData%WriteOutput)) THEN - i1_l = LBOUND(SrcOutputData%WriteOutput,1) - i1_u = UBOUND(SrcOutputData%WriteOutput,1) - IF (.NOT. ALLOCATED(DstOutputData%WriteOutput)) THEN - ALLOCATE(DstOutputData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%WriteOutput = SrcOutputData%WriteOutput -ENDIF -IF (ALLOCATED(SrcOutputData%BlPitch)) THEN - i1_l = LBOUND(SrcOutputData%BlPitch,1) - i1_u = UBOUND(SrcOutputData%BlPitch,1) - IF (.NOT. ALLOCATED(DstOutputData%BlPitch)) THEN - ALLOCATE(DstOutputData%BlPitch(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BlPitch.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%BlPitch = SrcOutputData%BlPitch -ENDIF - DstOutputData%Yaw = SrcOutputData%Yaw - DstOutputData%YawRate = SrcOutputData%YawRate - DstOutputData%LSS_Spd = SrcOutputData%LSS_Spd - DstOutputData%HSS_Spd = SrcOutputData%HSS_Spd - DstOutputData%RotSpeed = SrcOutputData%RotSpeed - DstOutputData%TwrAccel = SrcOutputData%TwrAccel - DstOutputData%YawAngle = SrcOutputData%YawAngle - DstOutputData%RootMyc = SrcOutputData%RootMyc - DstOutputData%YawBrTAxp = SrcOutputData%YawBrTAxp - DstOutputData%YawBrTAyp = SrcOutputData%YawBrTAyp - DstOutputData%LSSTipPxa = SrcOutputData%LSSTipPxa - DstOutputData%RootMxc = SrcOutputData%RootMxc - DstOutputData%LSSTipMxa = SrcOutputData%LSSTipMxa - DstOutputData%LSSTipMya = SrcOutputData%LSSTipMya - DstOutputData%LSSTipMza = SrcOutputData%LSSTipMza - DstOutputData%LSSTipMys = SrcOutputData%LSSTipMys - DstOutputData%LSSTipMzs = SrcOutputData%LSSTipMzs - DstOutputData%YawBrMyn = SrcOutputData%YawBrMyn - DstOutputData%YawBrMzn = SrcOutputData%YawBrMzn - DstOutputData%NcIMURAxs = SrcOutputData%NcIMURAxs - DstOutputData%NcIMURAys = SrcOutputData%NcIMURAys - DstOutputData%NcIMURAzs = SrcOutputData%NcIMURAzs - DstOutputData%RotPwr = SrcOutputData%RotPwr - DstOutputData%LSShftFxa = SrcOutputData%LSShftFxa - DstOutputData%LSShftFys = SrcOutputData%LSShftFys - DstOutputData%LSShftFzs = SrcOutputData%LSShftFzs - END SUBROUTINE ED_CopyOutput - - SUBROUTINE ED_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(ED_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ED_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(OutputData%BladeLn2Mesh)) THEN -DO i1 = LBOUND(OutputData%BladeLn2Mesh,1), UBOUND(OutputData%BladeLn2Mesh,1) - CALL MeshDestroy( OutputData%BladeLn2Mesh(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OutputData%BladeLn2Mesh) -ENDIF - CALL MeshDestroy( OutputData%PlatformPtMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( OutputData%TowerLn2Mesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( OutputData%HubPtMotion14, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( OutputData%HubPtMotion, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( OutputData%BladeRootMotion14, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(OutputData%BladeRootMotion)) THEN -DO i1 = LBOUND(OutputData%BladeRootMotion,1), UBOUND(OutputData%BladeRootMotion,1) - CALL MeshDestroy( OutputData%BladeRootMotion(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OutputData%BladeRootMotion) -ENDIF - CALL MeshDestroy( OutputData%RotorFurlMotion14, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( OutputData%NacelleMotion, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( OutputData%TowerBaseMotion14, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( OutputData%TFinCMMotion, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF -IF (ALLOCATED(OutputData%BlPitch)) THEN - DEALLOCATE(OutputData%BlPitch) -ENDIF - END SUBROUTINE ED_DestroyOutput +subroutine ED_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(ED_OutputType), intent(inout) :: SrcOutputData + type(ED_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ED_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%BladeLn2Mesh)) then + LB(1:1) = lbound(SrcOutputData%BladeLn2Mesh) + UB(1:1) = ubound(SrcOutputData%BladeLn2Mesh) + if (.not. allocated(DstOutputData%BladeLn2Mesh)) then + allocate(DstOutputData%BladeLn2Mesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BladeLn2Mesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcOutputData%BladeLn2Mesh(i1), DstOutputData%BladeLn2Mesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstOutputData%BladeLn2Mesh)) then + deallocate(DstOutputData%BladeLn2Mesh) + end if + call MeshCopy(SrcOutputData%PlatformPtMesh, DstOutputData%PlatformPtMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcOutputData%TowerLn2Mesh, DstOutputData%TowerLn2Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcOutputData%HubPtMotion14, DstOutputData%HubPtMotion14, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcOutputData%HubPtMotion, DstOutputData%HubPtMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcOutputData%BladeRootMotion14, DstOutputData%BladeRootMotion14, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcOutputData%BladeRootMotion)) then + LB(1:1) = lbound(SrcOutputData%BladeRootMotion) + UB(1:1) = ubound(SrcOutputData%BladeRootMotion) + if (.not. allocated(DstOutputData%BladeRootMotion)) then + allocate(DstOutputData%BladeRootMotion(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BladeRootMotion.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcOutputData%BladeRootMotion(i1), DstOutputData%BladeRootMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstOutputData%BladeRootMotion)) then + deallocate(DstOutputData%BladeRootMotion) + end if + call MeshCopy(SrcOutputData%RotorFurlMotion14, DstOutputData%RotorFurlMotion14, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcOutputData%NacelleMotion, DstOutputData%NacelleMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcOutputData%TowerBaseMotion14, DstOutputData%TowerBaseMotion14, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcOutputData%TFinCMMotion, DstOutputData%TFinCMMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%WriteOutput = SrcOutputData%WriteOutput + else if (allocated(DstOutputData%WriteOutput)) then + deallocate(DstOutputData%WriteOutput) + end if + if (allocated(SrcOutputData%BlPitch)) then + LB(1:1) = lbound(SrcOutputData%BlPitch) + UB(1:1) = ubound(SrcOutputData%BlPitch) + if (.not. allocated(DstOutputData%BlPitch)) then + allocate(DstOutputData%BlPitch(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BlPitch.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%BlPitch = SrcOutputData%BlPitch + else if (allocated(DstOutputData%BlPitch)) then + deallocate(DstOutputData%BlPitch) + end if + DstOutputData%Yaw = SrcOutputData%Yaw + DstOutputData%YawRate = SrcOutputData%YawRate + DstOutputData%LSS_Spd = SrcOutputData%LSS_Spd + DstOutputData%HSS_Spd = SrcOutputData%HSS_Spd + DstOutputData%RotSpeed = SrcOutputData%RotSpeed + DstOutputData%TwrAccel = SrcOutputData%TwrAccel + DstOutputData%YawAngle = SrcOutputData%YawAngle + DstOutputData%RootMyc = SrcOutputData%RootMyc + DstOutputData%YawBrTAxp = SrcOutputData%YawBrTAxp + DstOutputData%YawBrTAyp = SrcOutputData%YawBrTAyp + DstOutputData%LSSTipPxa = SrcOutputData%LSSTipPxa + DstOutputData%RootMxc = SrcOutputData%RootMxc + DstOutputData%LSSTipMxa = SrcOutputData%LSSTipMxa + DstOutputData%LSSTipMya = SrcOutputData%LSSTipMya + DstOutputData%LSSTipMza = SrcOutputData%LSSTipMza + DstOutputData%LSSTipMys = SrcOutputData%LSSTipMys + DstOutputData%LSSTipMzs = SrcOutputData%LSSTipMzs + DstOutputData%YawBrMyn = SrcOutputData%YawBrMyn + DstOutputData%YawBrMzn = SrcOutputData%YawBrMzn + DstOutputData%NcIMURAxs = SrcOutputData%NcIMURAxs + DstOutputData%NcIMURAys = SrcOutputData%NcIMURAys + DstOutputData%NcIMURAzs = SrcOutputData%NcIMURAzs + DstOutputData%RotPwr = SrcOutputData%RotPwr + DstOutputData%LSShftFxa = SrcOutputData%LSShftFxa + DstOutputData%LSShftFys = SrcOutputData%LSShftFys + DstOutputData%LSShftFzs = SrcOutputData%LSShftFzs +end subroutine +subroutine ED_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(ED_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ED_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%BladeLn2Mesh)) then + LB(1:1) = lbound(OutputData%BladeLn2Mesh) + UB(1:1) = ubound(OutputData%BladeLn2Mesh) + do i1 = LB(1), UB(1) + call MeshDestroy( OutputData%BladeLn2Mesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%BladeLn2Mesh) + end if + if (allocated(OutputData%BladeRootMotion)) then + LB(1:1) = lbound(OutputData%BladeRootMotion) + UB(1:1) = ubound(OutputData%BladeRootMotion) + do i1 = LB(1), UB(1) + call MeshDestroy( OutputData%BladeRootMotion(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%BladeRootMotion) + end if + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if + if (allocated(OutputData%BlPitch)) then + deallocate(OutputData%BlPitch) + end if +end subroutine subroutine ED_PackOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -13366,7 +11894,6 @@ subroutine ED_PackOutput(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! BladeLn2Mesh call RegPack(Buf, allocated(InData%BladeLn2Mesh)) if (allocated(InData%BladeLn2Mesh)) then call RegPackBounds(Buf, 1, lbound(InData%BladeLn2Mesh), ubound(InData%BladeLn2Mesh)) @@ -13377,22 +11904,16 @@ subroutine ED_PackOutput(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! PlatformPtMesh call MeshPack(Buf, InData%PlatformPtMesh) if (RegCheckErr(Buf, RoutineName)) return - ! TowerLn2Mesh call MeshPack(Buf, InData%TowerLn2Mesh) if (RegCheckErr(Buf, RoutineName)) return - ! HubPtMotion14 call MeshPack(Buf, InData%HubPtMotion14) if (RegCheckErr(Buf, RoutineName)) return - ! HubPtMotion call MeshPack(Buf, InData%HubPtMotion) if (RegCheckErr(Buf, RoutineName)) return - ! BladeRootMotion14 call MeshPack(Buf, InData%BladeRootMotion14) if (RegCheckErr(Buf, RoutineName)) return - ! BladeRootMotion call RegPack(Buf, allocated(InData%BladeRootMotion)) if (allocated(InData%BladeRootMotion)) then call RegPackBounds(Buf, 1, lbound(InData%BladeRootMotion), ubound(InData%BladeRootMotion)) @@ -13403,108 +11924,76 @@ subroutine ED_PackOutput(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! RotorFurlMotion14 call MeshPack(Buf, InData%RotorFurlMotion14) if (RegCheckErr(Buf, RoutineName)) return - ! NacelleMotion call MeshPack(Buf, InData%NacelleMotion) if (RegCheckErr(Buf, RoutineName)) return - ! TowerBaseMotion14 call MeshPack(Buf, InData%TowerBaseMotion14) if (RegCheckErr(Buf, RoutineName)) return - ! TFinCMMotion call MeshPack(Buf, InData%TFinCMMotion) if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutput call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) call RegPack(Buf, InData%WriteOutput) end if if (RegCheckErr(Buf, RoutineName)) return - ! BlPitch call RegPack(Buf, allocated(InData%BlPitch)) if (allocated(InData%BlPitch)) then call RegPackBounds(Buf, 1, lbound(InData%BlPitch), ubound(InData%BlPitch)) call RegPack(Buf, InData%BlPitch) end if if (RegCheckErr(Buf, RoutineName)) return - ! Yaw call RegPack(Buf, InData%Yaw) if (RegCheckErr(Buf, RoutineName)) return - ! YawRate call RegPack(Buf, InData%YawRate) if (RegCheckErr(Buf, RoutineName)) return - ! LSS_Spd call RegPack(Buf, InData%LSS_Spd) if (RegCheckErr(Buf, RoutineName)) return - ! HSS_Spd call RegPack(Buf, InData%HSS_Spd) if (RegCheckErr(Buf, RoutineName)) return - ! RotSpeed call RegPack(Buf, InData%RotSpeed) if (RegCheckErr(Buf, RoutineName)) return - ! TwrAccel call RegPack(Buf, InData%TwrAccel) if (RegCheckErr(Buf, RoutineName)) return - ! YawAngle call RegPack(Buf, InData%YawAngle) if (RegCheckErr(Buf, RoutineName)) return - ! RootMyc call RegPack(Buf, InData%RootMyc) if (RegCheckErr(Buf, RoutineName)) return - ! YawBrTAxp call RegPack(Buf, InData%YawBrTAxp) if (RegCheckErr(Buf, RoutineName)) return - ! YawBrTAyp call RegPack(Buf, InData%YawBrTAyp) if (RegCheckErr(Buf, RoutineName)) return - ! LSSTipPxa call RegPack(Buf, InData%LSSTipPxa) if (RegCheckErr(Buf, RoutineName)) return - ! RootMxc call RegPack(Buf, InData%RootMxc) if (RegCheckErr(Buf, RoutineName)) return - ! LSSTipMxa call RegPack(Buf, InData%LSSTipMxa) if (RegCheckErr(Buf, RoutineName)) return - ! LSSTipMya call RegPack(Buf, InData%LSSTipMya) if (RegCheckErr(Buf, RoutineName)) return - ! LSSTipMza call RegPack(Buf, InData%LSSTipMza) if (RegCheckErr(Buf, RoutineName)) return - ! LSSTipMys call RegPack(Buf, InData%LSSTipMys) if (RegCheckErr(Buf, RoutineName)) return - ! LSSTipMzs call RegPack(Buf, InData%LSSTipMzs) if (RegCheckErr(Buf, RoutineName)) return - ! YawBrMyn call RegPack(Buf, InData%YawBrMyn) if (RegCheckErr(Buf, RoutineName)) return - ! YawBrMzn call RegPack(Buf, InData%YawBrMzn) if (RegCheckErr(Buf, RoutineName)) return - ! NcIMURAxs call RegPack(Buf, InData%NcIMURAxs) if (RegCheckErr(Buf, RoutineName)) return - ! NcIMURAys call RegPack(Buf, InData%NcIMURAys) if (RegCheckErr(Buf, RoutineName)) return - ! NcIMURAzs call RegPack(Buf, InData%NcIMURAzs) if (RegCheckErr(Buf, RoutineName)) return - ! RotPwr call RegPack(Buf, InData%RotPwr) if (RegCheckErr(Buf, RoutineName)) return - ! LSShftFxa call RegPack(Buf, InData%LSShftFxa) if (RegCheckErr(Buf, RoutineName)) return - ! LSShftFys call RegPack(Buf, InData%LSShftFys) if (RegCheckErr(Buf, RoutineName)) return - ! LSShftFzs call RegPack(Buf, InData%LSShftFzs) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -13518,7 +12007,6 @@ subroutine ED_UnPackOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! BladeLn2Mesh if (allocated(OutData%BladeLn2Mesh)) deallocate(OutData%BladeLn2Mesh) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -13534,17 +12022,11 @@ subroutine ED_UnPackOutput(Buf, OutData) call MeshUnpack(Buf, OutData%BladeLn2Mesh(i1)) ! BladeLn2Mesh end do end if - ! PlatformPtMesh call MeshUnpack(Buf, OutData%PlatformPtMesh) ! PlatformPtMesh - ! TowerLn2Mesh call MeshUnpack(Buf, OutData%TowerLn2Mesh) ! TowerLn2Mesh - ! HubPtMotion14 call MeshUnpack(Buf, OutData%HubPtMotion14) ! HubPtMotion14 - ! HubPtMotion call MeshUnpack(Buf, OutData%HubPtMotion) ! HubPtMotion - ! BladeRootMotion14 call MeshUnpack(Buf, OutData%BladeRootMotion14) ! BladeRootMotion14 - ! BladeRootMotion if (allocated(OutData%BladeRootMotion)) deallocate(OutData%BladeRootMotion) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -13560,15 +12042,10 @@ subroutine ED_UnPackOutput(Buf, OutData) call MeshUnpack(Buf, OutData%BladeRootMotion(i1)) ! BladeRootMotion end do end if - ! RotorFurlMotion14 call MeshUnpack(Buf, OutData%RotorFurlMotion14) ! RotorFurlMotion14 - ! NacelleMotion call MeshUnpack(Buf, OutData%NacelleMotion) ! NacelleMotion - ! TowerBaseMotion14 call MeshUnpack(Buf, OutData%TowerBaseMotion14) ! TowerBaseMotion14 - ! TFinCMMotion call MeshUnpack(Buf, OutData%TFinCMMotion) ! TFinCMMotion - ! WriteOutput if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -13583,7 +12060,6 @@ subroutine ED_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutput) if (RegCheckErr(Buf, RoutineName)) return end if - ! BlPitch if (allocated(OutData%BlPitch)) deallocate(OutData%BlPitch) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -13598,82 +12074,56 @@ subroutine ED_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%BlPitch) if (RegCheckErr(Buf, RoutineName)) return end if - ! Yaw call RegUnpack(Buf, OutData%Yaw) if (RegCheckErr(Buf, RoutineName)) return - ! YawRate call RegUnpack(Buf, OutData%YawRate) if (RegCheckErr(Buf, RoutineName)) return - ! LSS_Spd call RegUnpack(Buf, OutData%LSS_Spd) if (RegCheckErr(Buf, RoutineName)) return - ! HSS_Spd call RegUnpack(Buf, OutData%HSS_Spd) if (RegCheckErr(Buf, RoutineName)) return - ! RotSpeed call RegUnpack(Buf, OutData%RotSpeed) if (RegCheckErr(Buf, RoutineName)) return - ! TwrAccel call RegUnpack(Buf, OutData%TwrAccel) if (RegCheckErr(Buf, RoutineName)) return - ! YawAngle call RegUnpack(Buf, OutData%YawAngle) if (RegCheckErr(Buf, RoutineName)) return - ! RootMyc call RegUnpack(Buf, OutData%RootMyc) if (RegCheckErr(Buf, RoutineName)) return - ! YawBrTAxp call RegUnpack(Buf, OutData%YawBrTAxp) if (RegCheckErr(Buf, RoutineName)) return - ! YawBrTAyp call RegUnpack(Buf, OutData%YawBrTAyp) if (RegCheckErr(Buf, RoutineName)) return - ! LSSTipPxa call RegUnpack(Buf, OutData%LSSTipPxa) if (RegCheckErr(Buf, RoutineName)) return - ! RootMxc call RegUnpack(Buf, OutData%RootMxc) if (RegCheckErr(Buf, RoutineName)) return - ! LSSTipMxa call RegUnpack(Buf, OutData%LSSTipMxa) if (RegCheckErr(Buf, RoutineName)) return - ! LSSTipMya call RegUnpack(Buf, OutData%LSSTipMya) if (RegCheckErr(Buf, RoutineName)) return - ! LSSTipMza call RegUnpack(Buf, OutData%LSSTipMza) if (RegCheckErr(Buf, RoutineName)) return - ! LSSTipMys call RegUnpack(Buf, OutData%LSSTipMys) if (RegCheckErr(Buf, RoutineName)) return - ! LSSTipMzs call RegUnpack(Buf, OutData%LSSTipMzs) if (RegCheckErr(Buf, RoutineName)) return - ! YawBrMyn call RegUnpack(Buf, OutData%YawBrMyn) if (RegCheckErr(Buf, RoutineName)) return - ! YawBrMzn call RegUnpack(Buf, OutData%YawBrMzn) if (RegCheckErr(Buf, RoutineName)) return - ! NcIMURAxs call RegUnpack(Buf, OutData%NcIMURAxs) if (RegCheckErr(Buf, RoutineName)) return - ! NcIMURAys call RegUnpack(Buf, OutData%NcIMURAys) if (RegCheckErr(Buf, RoutineName)) return - ! NcIMURAzs call RegUnpack(Buf, OutData%NcIMURAzs) if (RegCheckErr(Buf, RoutineName)) return - ! RotPwr call RegUnpack(Buf, OutData%RotPwr) if (RegCheckErr(Buf, RoutineName)) return - ! LSShftFxa call RegUnpack(Buf, OutData%LSShftFxa) if (RegCheckErr(Buf, RoutineName)) return - ! LSShftFys call RegUnpack(Buf, OutData%LSShftFys) if (RegCheckErr(Buf, RoutineName)) return - ! LSShftFzs call RegUnpack(Buf, OutData%LSShftFzs) if (RegCheckErr(Buf, RoutineName)) return end subroutine diff --git a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 index f517d60d61..8831de1099 100644 --- a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 +++ b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 @@ -155,57 +155,42 @@ MODULE ExtPtfm_MCKF_Types END TYPE ExtPtfm_OutputType ! ======================= CONTAINS - SUBROUTINE ExtPtfm_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtPtfm_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(ExtPtfm_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFile = SrcInitInputData%InputFile - DstInitInputData%Linearize = SrcInitInputData%Linearize - DstInitInputData%PtfmRefzt = SrcInitInputData%PtfmRefzt - DstInitInputData%RootName = SrcInitInputData%RootName - END SUBROUTINE ExtPtfm_CopyInitInput - - SUBROUTINE ExtPtfm_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(ExtPtfm_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE ExtPtfm_DestroyInitInput +subroutine ExtPtfm_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(ExtPtfm_InitInputType), intent(in) :: SrcInitInputData + type(ExtPtfm_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ExtPtfm_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%Linearize = SrcInitInputData%Linearize + DstInitInputData%PtfmRefzt = SrcInitInputData%PtfmRefzt + DstInitInputData%RootName = SrcInitInputData%RootName +end subroutine +subroutine ExtPtfm_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(ExtPtfm_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ExtPtfm_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine ExtPtfm_PackInitInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ExtPtfm_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'ExtPtfm_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return - ! InputFile call RegPack(Buf, InData%InputFile) if (RegCheckErr(Buf, RoutineName)) return - ! Linearize call RegPack(Buf, InData%Linearize) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmRefzt call RegPack(Buf, InData%PtfmRefzt) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegPack(Buf, InData%RootName) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -215,187 +200,165 @@ subroutine ExtPtfm_UnPackInitInput(Buf, OutData) type(ExtPtfm_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtPtfm_UnPackInitInput' if (Buf%ErrStat /= ErrID_None) return - ! InputFile call RegUnpack(Buf, OutData%InputFile) if (RegCheckErr(Buf, RoutineName)) return - ! Linearize call RegUnpack(Buf, OutData%Linearize) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmRefzt call RegUnpack(Buf, OutData%PtfmRefzt) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegUnpack(Buf, OutData%RootName) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE ExtPtfm_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtPtfm_InputFile), INTENT(IN) :: SrcInputFileData - TYPE(ExtPtfm_InputFile), INTENT(INOUT) :: DstInputFileData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_CopyInputFile' -! + +subroutine ExtPtfm_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) + type(ExtPtfm_InputFile), intent(in) :: SrcInputFileData + type(ExtPtfm_InputFile), intent(inout) :: DstInputFileData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'ExtPtfm_CopyInputFile' ErrStat = ErrID_None - ErrMsg = "" - DstInputFileData%DT = SrcInputFileData%DT - DstInputFileData%IntMethod = SrcInputFileData%IntMethod - DstInputFileData%FileFormat = SrcInputFileData%FileFormat - DstInputFileData%RedFile = SrcInputFileData%RedFile - DstInputFileData%RedFileCst = SrcInputFileData%RedFileCst - DstInputFileData%EquilStart = SrcInputFileData%EquilStart -IF (ALLOCATED(SrcInputFileData%ActiveCBDOF)) THEN - i1_l = LBOUND(SrcInputFileData%ActiveCBDOF,1) - i1_u = UBOUND(SrcInputFileData%ActiveCBDOF,1) - IF (.NOT. ALLOCATED(DstInputFileData%ActiveCBDOF)) THEN - ALLOCATE(DstInputFileData%ActiveCBDOF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ActiveCBDOF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%ActiveCBDOF = SrcInputFileData%ActiveCBDOF -ENDIF -IF (ALLOCATED(SrcInputFileData%InitPosList)) THEN - i1_l = LBOUND(SrcInputFileData%InitPosList,1) - i1_u = UBOUND(SrcInputFileData%InitPosList,1) - IF (.NOT. ALLOCATED(DstInputFileData%InitPosList)) THEN - ALLOCATE(DstInputFileData%InitPosList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%InitPosList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%InitPosList = SrcInputFileData%InitPosList -ENDIF -IF (ALLOCATED(SrcInputFileData%InitVelList)) THEN - i1_l = LBOUND(SrcInputFileData%InitVelList,1) - i1_u = UBOUND(SrcInputFileData%InitVelList,1) - IF (.NOT. ALLOCATED(DstInputFileData%InitVelList)) THEN - ALLOCATE(DstInputFileData%InitVelList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%InitVelList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%InitVelList = SrcInputFileData%InitVelList -ENDIF - DstInputFileData%SumPrint = SrcInputFileData%SumPrint - DstInputFileData%OutFile = SrcInputFileData%OutFile - DstInputFileData%TabDelim = SrcInputFileData%TabDelim - DstInputFileData%OutFmt = SrcInputFileData%OutFmt - DstInputFileData%Tstart = SrcInputFileData%Tstart - DstInputFileData%NumOuts = SrcInputFileData%NumOuts -IF (ALLOCATED(SrcInputFileData%OutList)) THEN - i1_l = LBOUND(SrcInputFileData%OutList,1) - i1_u = UBOUND(SrcInputFileData%OutList,1) - IF (.NOT. ALLOCATED(DstInputFileData%OutList)) THEN - ALLOCATE(DstInputFileData%OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%OutList = SrcInputFileData%OutList -ENDIF - END SUBROUTINE ExtPtfm_CopyInputFile - - SUBROUTINE ExtPtfm_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) - TYPE(ExtPtfm_InputFile), INTENT(INOUT) :: InputFileData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyInputFile' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputFileData%ActiveCBDOF)) THEN - DEALLOCATE(InputFileData%ActiveCBDOF) -ENDIF -IF (ALLOCATED(InputFileData%InitPosList)) THEN - DEALLOCATE(InputFileData%InitPosList) -ENDIF -IF (ALLOCATED(InputFileData%InitVelList)) THEN - DEALLOCATE(InputFileData%InitVelList) -ENDIF -IF (ALLOCATED(InputFileData%OutList)) THEN - DEALLOCATE(InputFileData%OutList) -ENDIF - END SUBROUTINE ExtPtfm_DestroyInputFile + ErrMsg = '' + DstInputFileData%DT = SrcInputFileData%DT + DstInputFileData%IntMethod = SrcInputFileData%IntMethod + DstInputFileData%FileFormat = SrcInputFileData%FileFormat + DstInputFileData%RedFile = SrcInputFileData%RedFile + DstInputFileData%RedFileCst = SrcInputFileData%RedFileCst + DstInputFileData%EquilStart = SrcInputFileData%EquilStart + if (allocated(SrcInputFileData%ActiveCBDOF)) then + LB(1:1) = lbound(SrcInputFileData%ActiveCBDOF) + UB(1:1) = ubound(SrcInputFileData%ActiveCBDOF) + if (.not. allocated(DstInputFileData%ActiveCBDOF)) then + allocate(DstInputFileData%ActiveCBDOF(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ActiveCBDOF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%ActiveCBDOF = SrcInputFileData%ActiveCBDOF + else if (allocated(DstInputFileData%ActiveCBDOF)) then + deallocate(DstInputFileData%ActiveCBDOF) + end if + if (allocated(SrcInputFileData%InitPosList)) then + LB(1:1) = lbound(SrcInputFileData%InitPosList) + UB(1:1) = ubound(SrcInputFileData%InitPosList) + if (.not. allocated(DstInputFileData%InitPosList)) then + allocate(DstInputFileData%InitPosList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%InitPosList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%InitPosList = SrcInputFileData%InitPosList + else if (allocated(DstInputFileData%InitPosList)) then + deallocate(DstInputFileData%InitPosList) + end if + if (allocated(SrcInputFileData%InitVelList)) then + LB(1:1) = lbound(SrcInputFileData%InitVelList) + UB(1:1) = ubound(SrcInputFileData%InitVelList) + if (.not. allocated(DstInputFileData%InitVelList)) then + allocate(DstInputFileData%InitVelList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%InitVelList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%InitVelList = SrcInputFileData%InitVelList + else if (allocated(DstInputFileData%InitVelList)) then + deallocate(DstInputFileData%InitVelList) + end if + DstInputFileData%SumPrint = SrcInputFileData%SumPrint + DstInputFileData%OutFile = SrcInputFileData%OutFile + DstInputFileData%TabDelim = SrcInputFileData%TabDelim + DstInputFileData%OutFmt = SrcInputFileData%OutFmt + DstInputFileData%Tstart = SrcInputFileData%Tstart + DstInputFileData%NumOuts = SrcInputFileData%NumOuts + if (allocated(SrcInputFileData%OutList)) then + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) + if (.not. allocated(DstInputFileData%OutList)) then + allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%OutList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%OutList = SrcInputFileData%OutList + else if (allocated(DstInputFileData%OutList)) then + deallocate(DstInputFileData%OutList) + end if +end subroutine +subroutine ExtPtfm_DestroyInputFile(InputFileData, ErrStat, ErrMsg) + type(ExtPtfm_InputFile), intent(inout) :: InputFileData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ExtPtfm_DestroyInputFile' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputFileData%ActiveCBDOF)) then + deallocate(InputFileData%ActiveCBDOF) + end if + if (allocated(InputFileData%InitPosList)) then + deallocate(InputFileData%InitPosList) + end if + if (allocated(InputFileData%InitVelList)) then + deallocate(InputFileData%InitVelList) + end if + if (allocated(InputFileData%OutList)) then + deallocate(InputFileData%OutList) + end if +end subroutine subroutine ExtPtfm_PackInputFile(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ExtPtfm_InputFile), intent(in) :: InData character(*), parameter :: RoutineName = 'ExtPtfm_PackInputFile' if (Buf%ErrStat >= AbortErrLev) return - ! DT call RegPack(Buf, InData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! IntMethod call RegPack(Buf, InData%IntMethod) if (RegCheckErr(Buf, RoutineName)) return - ! FileFormat call RegPack(Buf, InData%FileFormat) if (RegCheckErr(Buf, RoutineName)) return - ! RedFile call RegPack(Buf, InData%RedFile) if (RegCheckErr(Buf, RoutineName)) return - ! RedFileCst call RegPack(Buf, InData%RedFileCst) if (RegCheckErr(Buf, RoutineName)) return - ! EquilStart call RegPack(Buf, InData%EquilStart) if (RegCheckErr(Buf, RoutineName)) return - ! ActiveCBDOF call RegPack(Buf, allocated(InData%ActiveCBDOF)) if (allocated(InData%ActiveCBDOF)) then call RegPackBounds(Buf, 1, lbound(InData%ActiveCBDOF), ubound(InData%ActiveCBDOF)) call RegPack(Buf, InData%ActiveCBDOF) end if if (RegCheckErr(Buf, RoutineName)) return - ! InitPosList call RegPack(Buf, allocated(InData%InitPosList)) if (allocated(InData%InitPosList)) then call RegPackBounds(Buf, 1, lbound(InData%InitPosList), ubound(InData%InitPosList)) call RegPack(Buf, InData%InitPosList) end if if (RegCheckErr(Buf, RoutineName)) return - ! InitVelList call RegPack(Buf, allocated(InData%InitVelList)) if (allocated(InData%InitVelList)) then call RegPackBounds(Buf, 1, lbound(InData%InitVelList), ubound(InData%InitVelList)) call RegPack(Buf, InData%InitVelList) end if if (RegCheckErr(Buf, RoutineName)) return - ! SumPrint call RegPack(Buf, InData%SumPrint) if (RegCheckErr(Buf, RoutineName)) return - ! OutFile call RegPack(Buf, InData%OutFile) if (RegCheckErr(Buf, RoutineName)) return - ! TabDelim call RegPack(Buf, InData%TabDelim) if (RegCheckErr(Buf, RoutineName)) return - ! OutFmt call RegPack(Buf, InData%OutFmt) if (RegCheckErr(Buf, RoutineName)) return - ! Tstart call RegPack(Buf, InData%Tstart) if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegPack(Buf, InData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! OutList call RegPack(Buf, allocated(InData%OutList)) if (allocated(InData%OutList)) then call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) @@ -412,25 +375,18 @@ subroutine ExtPtfm_UnPackInputFile(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! DT call RegUnpack(Buf, OutData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! IntMethod call RegUnpack(Buf, OutData%IntMethod) if (RegCheckErr(Buf, RoutineName)) return - ! FileFormat call RegUnpack(Buf, OutData%FileFormat) if (RegCheckErr(Buf, RoutineName)) return - ! RedFile call RegUnpack(Buf, OutData%RedFile) if (RegCheckErr(Buf, RoutineName)) return - ! RedFileCst call RegUnpack(Buf, OutData%RedFileCst) if (RegCheckErr(Buf, RoutineName)) return - ! EquilStart call RegUnpack(Buf, OutData%EquilStart) if (RegCheckErr(Buf, RoutineName)) return - ! ActiveCBDOF if (allocated(OutData%ActiveCBDOF)) deallocate(OutData%ActiveCBDOF) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -445,7 +401,6 @@ subroutine ExtPtfm_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%ActiveCBDOF) if (RegCheckErr(Buf, RoutineName)) return end if - ! InitPosList if (allocated(OutData%InitPosList)) deallocate(OutData%InitPosList) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -460,7 +415,6 @@ subroutine ExtPtfm_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%InitPosList) if (RegCheckErr(Buf, RoutineName)) return end if - ! InitVelList if (allocated(OutData%InitVelList)) deallocate(OutData%InitVelList) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -475,25 +429,18 @@ subroutine ExtPtfm_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%InitVelList) if (RegCheckErr(Buf, RoutineName)) return end if - ! SumPrint call RegUnpack(Buf, OutData%SumPrint) if (RegCheckErr(Buf, RoutineName)) return - ! OutFile call RegUnpack(Buf, OutData%OutFile) if (RegCheckErr(Buf, RoutineName)) return - ! TabDelim call RegUnpack(Buf, OutData%TabDelim) if (RegCheckErr(Buf, RoutineName)) return - ! OutFmt call RegUnpack(Buf, OutData%OutFmt) if (RegCheckErr(Buf, RoutineName)) return - ! Tstart call RegUnpack(Buf, OutData%Tstart) if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegUnpack(Buf, OutData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! OutList if (allocated(OutData%OutList)) deallocate(OutData%OutList) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -509,266 +456,266 @@ subroutine ExtPtfm_UnPackInputFile(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE ExtPtfm_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtPtfm_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(ExtPtfm_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_CopyInitOutput' -! + +subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(ExtPtfm_InitOutputType), intent(in) :: SrcInitOutputData + type(ExtPtfm_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtPtfm_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 -IF (ALLOCATED(SrcInitOutputData%LinNames_y)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_y,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_y,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_y)) THEN - ALLOCATE(DstInitOutputData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y -ENDIF -IF (ALLOCATED(SrcInitOutputData%LinNames_x)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_x,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_x,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_x)) THEN - ALLOCATE(DstInitOutputData%LinNames_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x -ENDIF -IF (ALLOCATED(SrcInitOutputData%LinNames_u)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_u,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_u)) THEN - ALLOCATE(DstInitOutputData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_y)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_y,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_y,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_y)) THEN - ALLOCATE(DstInitOutputData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_x)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_x,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_x,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_x)) THEN - ALLOCATE(DstInitOutputData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_u)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_u,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_u)) THEN - ALLOCATE(DstInitOutputData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%IsLoad_u)) THEN - i1_l = LBOUND(SrcInitOutputData%IsLoad_u,1) - i1_u = UBOUND(SrcInitOutputData%IsLoad_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%IsLoad_u)) THEN - ALLOCATE(DstInitOutputData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%DerivOrder_x)) THEN - i1_l = LBOUND(SrcInitOutputData%DerivOrder_x,1) - i1_u = UBOUND(SrcInitOutputData%DerivOrder_x,1) - IF (.NOT. ALLOCATED(DstInitOutputData%DerivOrder_x)) THEN - ALLOCATE(DstInitOutputData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x -ENDIF - END SUBROUTINE ExtPtfm_CopyInitOutput - - SUBROUTINE ExtPtfm_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(ExtPtfm_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF -IF (ALLOCATED(InitOutputData%LinNames_y)) THEN - DEALLOCATE(InitOutputData%LinNames_y) -ENDIF -IF (ALLOCATED(InitOutputData%LinNames_x)) THEN - DEALLOCATE(InitOutputData%LinNames_x) -ENDIF -IF (ALLOCATED(InitOutputData%LinNames_u)) THEN - DEALLOCATE(InitOutputData%LinNames_u) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_y)) THEN - DEALLOCATE(InitOutputData%RotFrame_y) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_x)) THEN - DEALLOCATE(InitOutputData%RotFrame_x) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_u)) THEN - DEALLOCATE(InitOutputData%RotFrame_u) -ENDIF -IF (ALLOCATED(InitOutputData%IsLoad_u)) THEN - DEALLOCATE(InitOutputData%IsLoad_u) -ENDIF -IF (ALLOCATED(InitOutputData%DerivOrder_x)) THEN - DEALLOCATE(InitOutputData%DerivOrder_x) -ENDIF - END SUBROUTINE ExtPtfm_DestroyInitOutput + ErrMsg = '' + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr + else if (allocated(DstInitOutputData%WriteOutputHdr)) then + deallocate(DstInitOutputData%WriteOutputHdr) + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt + else if (allocated(DstInitOutputData%WriteOutputUnt)) then + deallocate(DstInitOutputData%WriteOutputUnt) + end if + if (allocated(SrcInitOutputData%LinNames_y)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_y) + UB(1:1) = ubound(SrcInitOutputData%LinNames_y) + if (.not. allocated(DstInitOutputData%LinNames_y)) then + allocate(DstInitOutputData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y + else if (allocated(DstInitOutputData%LinNames_y)) then + deallocate(DstInitOutputData%LinNames_y) + end if + if (allocated(SrcInitOutputData%LinNames_x)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_x) + UB(1:1) = ubound(SrcInitOutputData%LinNames_x) + if (.not. allocated(DstInitOutputData%LinNames_x)) then + allocate(DstInitOutputData%LinNames_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x + else if (allocated(DstInitOutputData%LinNames_x)) then + deallocate(DstInitOutputData%LinNames_x) + end if + if (allocated(SrcInitOutputData%LinNames_u)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_u) + UB(1:1) = ubound(SrcInitOutputData%LinNames_u) + if (.not. allocated(DstInitOutputData%LinNames_u)) then + allocate(DstInitOutputData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u + else if (allocated(DstInitOutputData%LinNames_u)) then + deallocate(DstInitOutputData%LinNames_u) + end if + if (allocated(SrcInitOutputData%RotFrame_y)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_y) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_y) + if (.not. allocated(DstInitOutputData%RotFrame_y)) then + allocate(DstInitOutputData%RotFrame_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y + else if (allocated(DstInitOutputData%RotFrame_y)) then + deallocate(DstInitOutputData%RotFrame_y) + end if + if (allocated(SrcInitOutputData%RotFrame_x)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_x) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_x) + if (.not. allocated(DstInitOutputData%RotFrame_x)) then + allocate(DstInitOutputData%RotFrame_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x + else if (allocated(DstInitOutputData%RotFrame_x)) then + deallocate(DstInitOutputData%RotFrame_x) + end if + if (allocated(SrcInitOutputData%RotFrame_u)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_u) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_u) + if (.not. allocated(DstInitOutputData%RotFrame_u)) then + allocate(DstInitOutputData%RotFrame_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u + else if (allocated(DstInitOutputData%RotFrame_u)) then + deallocate(DstInitOutputData%RotFrame_u) + end if + if (allocated(SrcInitOutputData%IsLoad_u)) then + LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) + UB(1:1) = ubound(SrcInitOutputData%IsLoad_u) + if (.not. allocated(DstInitOutputData%IsLoad_u)) then + allocate(DstInitOutputData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%IsLoad_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u + else if (allocated(DstInitOutputData%IsLoad_u)) then + deallocate(DstInitOutputData%IsLoad_u) + end if + if (allocated(SrcInitOutputData%DerivOrder_x)) then + LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) + UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x) + if (.not. allocated(DstInitOutputData%DerivOrder_x)) then + allocate(DstInitOutputData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%DerivOrder_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x + else if (allocated(DstInitOutputData%DerivOrder_x)) then + deallocate(DstInitOutputData%DerivOrder_x) + end if +end subroutine +subroutine ExtPtfm_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(ExtPtfm_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtPtfm_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if + if (allocated(InitOutputData%LinNames_y)) then + deallocate(InitOutputData%LinNames_y) + end if + if (allocated(InitOutputData%LinNames_x)) then + deallocate(InitOutputData%LinNames_x) + end if + if (allocated(InitOutputData%LinNames_u)) then + deallocate(InitOutputData%LinNames_u) + end if + if (allocated(InitOutputData%RotFrame_y)) then + deallocate(InitOutputData%RotFrame_y) + end if + if (allocated(InitOutputData%RotFrame_x)) then + deallocate(InitOutputData%RotFrame_x) + end if + if (allocated(InitOutputData%RotFrame_u)) then + deallocate(InitOutputData%RotFrame_u) + end if + if (allocated(InitOutputData%IsLoad_u)) then + deallocate(InitOutputData%IsLoad_u) + end if + if (allocated(InitOutputData%DerivOrder_x)) then + deallocate(InitOutputData%DerivOrder_x) + end if +end subroutine subroutine ExtPtfm_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ExtPtfm_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'ExtPtfm_PackInitOutput' if (Buf%ErrStat >= AbortErrLev) return - ! Ver call NWTC_Library_PackProgDesc(Buf, InData%Ver) if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutputHdr call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) call RegPack(Buf, InData%WriteOutputHdr) end if if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutputUnt call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) call RegPack(Buf, InData%WriteOutputUnt) end if if (RegCheckErr(Buf, RoutineName)) return - ! LinNames_y call RegPack(Buf, allocated(InData%LinNames_y)) if (allocated(InData%LinNames_y)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) call RegPack(Buf, InData%LinNames_y) end if if (RegCheckErr(Buf, RoutineName)) return - ! LinNames_x call RegPack(Buf, allocated(InData%LinNames_x)) if (allocated(InData%LinNames_x)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_x), ubound(InData%LinNames_x)) call RegPack(Buf, InData%LinNames_x) end if if (RegCheckErr(Buf, RoutineName)) return - ! LinNames_u call RegPack(Buf, allocated(InData%LinNames_u)) if (allocated(InData%LinNames_u)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) call RegPack(Buf, InData%LinNames_u) end if if (RegCheckErr(Buf, RoutineName)) return - ! RotFrame_y call RegPack(Buf, allocated(InData%RotFrame_y)) if (allocated(InData%RotFrame_y)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y), ubound(InData%RotFrame_y)) call RegPack(Buf, InData%RotFrame_y) end if if (RegCheckErr(Buf, RoutineName)) return - ! RotFrame_x call RegPack(Buf, allocated(InData%RotFrame_x)) if (allocated(InData%RotFrame_x)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x), ubound(InData%RotFrame_x)) call RegPack(Buf, InData%RotFrame_x) end if if (RegCheckErr(Buf, RoutineName)) return - ! RotFrame_u call RegPack(Buf, allocated(InData%RotFrame_u)) if (allocated(InData%RotFrame_u)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u), ubound(InData%RotFrame_u)) call RegPack(Buf, InData%RotFrame_u) end if if (RegCheckErr(Buf, RoutineName)) return - ! IsLoad_u call RegPack(Buf, allocated(InData%IsLoad_u)) if (allocated(InData%IsLoad_u)) then call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) call RegPack(Buf, InData%IsLoad_u) end if if (RegCheckErr(Buf, RoutineName)) return - ! DerivOrder_x call RegPack(Buf, allocated(InData%DerivOrder_x)) if (allocated(InData%DerivOrder_x)) then call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x), ubound(InData%DerivOrder_x)) @@ -785,9 +732,7 @@ subroutine ExtPtfm_UnPackInitOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! Ver call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver - ! WriteOutputHdr if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -802,7 +747,6 @@ subroutine ExtPtfm_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutputHdr) if (RegCheckErr(Buf, RoutineName)) return end if - ! WriteOutputUnt if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -817,7 +761,6 @@ subroutine ExtPtfm_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutputUnt) if (RegCheckErr(Buf, RoutineName)) return end if - ! LinNames_y if (allocated(OutData%LinNames_y)) deallocate(OutData%LinNames_y) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -832,7 +775,6 @@ subroutine ExtPtfm_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%LinNames_y) if (RegCheckErr(Buf, RoutineName)) return end if - ! LinNames_x if (allocated(OutData%LinNames_x)) deallocate(OutData%LinNames_x) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -847,7 +789,6 @@ subroutine ExtPtfm_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%LinNames_x) if (RegCheckErr(Buf, RoutineName)) return end if - ! LinNames_u if (allocated(OutData%LinNames_u)) deallocate(OutData%LinNames_u) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -862,7 +803,6 @@ subroutine ExtPtfm_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%LinNames_u) if (RegCheckErr(Buf, RoutineName)) return end if - ! RotFrame_y if (allocated(OutData%RotFrame_y)) deallocate(OutData%RotFrame_y) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -877,7 +817,6 @@ subroutine ExtPtfm_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%RotFrame_y) if (RegCheckErr(Buf, RoutineName)) return end if - ! RotFrame_x if (allocated(OutData%RotFrame_x)) deallocate(OutData%RotFrame_x) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -892,7 +831,6 @@ subroutine ExtPtfm_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%RotFrame_x) if (RegCheckErr(Buf, RoutineName)) return end if - ! RotFrame_u if (allocated(OutData%RotFrame_u)) deallocate(OutData%RotFrame_u) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -907,7 +845,6 @@ subroutine ExtPtfm_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%RotFrame_u) if (RegCheckErr(Buf, RoutineName)) return end if - ! IsLoad_u if (allocated(OutData%IsLoad_u)) deallocate(OutData%IsLoad_u) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -922,7 +859,6 @@ subroutine ExtPtfm_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%IsLoad_u) if (RegCheckErr(Buf, RoutineName)) return end if - ! DerivOrder_x if (allocated(OutData%DerivOrder_x)) deallocate(OutData%DerivOrder_x) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -938,82 +874,74 @@ subroutine ExtPtfm_UnPackInitOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE ExtPtfm_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtPtfm_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(ExtPtfm_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_CopyContState' -! + +subroutine ExtPtfm_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(ExtPtfm_ContinuousStateType), intent(in) :: SrcContStateData + type(ExtPtfm_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'ExtPtfm_CopyContState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcContStateData%qm)) THEN - i1_l = LBOUND(SrcContStateData%qm,1) - i1_u = UBOUND(SrcContStateData%qm,1) - IF (.NOT. ALLOCATED(DstContStateData%qm)) THEN - ALLOCATE(DstContStateData%qm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%qm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstContStateData%qm = SrcContStateData%qm -ENDIF -IF (ALLOCATED(SrcContStateData%qmdot)) THEN - i1_l = LBOUND(SrcContStateData%qmdot,1) - i1_u = UBOUND(SrcContStateData%qmdot,1) - IF (.NOT. ALLOCATED(DstContStateData%qmdot)) THEN - ALLOCATE(DstContStateData%qmdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%qmdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstContStateData%qmdot = SrcContStateData%qmdot -ENDIF - END SUBROUTINE ExtPtfm_CopyContState - - SUBROUTINE ExtPtfm_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(ExtPtfm_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ContStateData%qm)) THEN - DEALLOCATE(ContStateData%qm) -ENDIF -IF (ALLOCATED(ContStateData%qmdot)) THEN - DEALLOCATE(ContStateData%qmdot) -ENDIF - END SUBROUTINE ExtPtfm_DestroyContState + ErrMsg = '' + if (allocated(SrcContStateData%qm)) then + LB(1:1) = lbound(SrcContStateData%qm) + UB(1:1) = ubound(SrcContStateData%qm) + if (.not. allocated(DstContStateData%qm)) then + allocate(DstContStateData%qm(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%qm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstContStateData%qm = SrcContStateData%qm + else if (allocated(DstContStateData%qm)) then + deallocate(DstContStateData%qm) + end if + if (allocated(SrcContStateData%qmdot)) then + LB(1:1) = lbound(SrcContStateData%qmdot) + UB(1:1) = ubound(SrcContStateData%qmdot) + if (.not. allocated(DstContStateData%qmdot)) then + allocate(DstContStateData%qmdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%qmdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstContStateData%qmdot = SrcContStateData%qmdot + else if (allocated(DstContStateData%qmdot)) then + deallocate(DstContStateData%qmdot) + end if +end subroutine +subroutine ExtPtfm_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(ExtPtfm_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ExtPtfm_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ContStateData%qm)) then + deallocate(ContStateData%qm) + end if + if (allocated(ContStateData%qmdot)) then + deallocate(ContStateData%qmdot) + end if +end subroutine subroutine ExtPtfm_PackContState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ExtPtfm_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'ExtPtfm_PackContState' if (Buf%ErrStat >= AbortErrLev) return - ! qm call RegPack(Buf, allocated(InData%qm)) if (allocated(InData%qm)) then call RegPackBounds(Buf, 1, lbound(InData%qm), ubound(InData%qm)) call RegPack(Buf, InData%qm) end if if (RegCheckErr(Buf, RoutineName)) return - ! qmdot call RegPack(Buf, allocated(InData%qmdot)) if (allocated(InData%qmdot)) then call RegPackBounds(Buf, 1, lbound(InData%qmdot), ubound(InData%qmdot)) @@ -1030,7 +958,6 @@ subroutine ExtPtfm_UnPackContState(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! qm if (allocated(OutData%qm)) deallocate(OutData%qm) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1045,7 +972,6 @@ subroutine ExtPtfm_UnPackContState(Buf, OutData) call RegUnpack(Buf, OutData%qm) if (RegCheckErr(Buf, RoutineName)) return end if - ! qmdot if (allocated(OutData%qmdot)) deallocate(OutData%qmdot) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1061,45 +987,33 @@ subroutine ExtPtfm_UnPackContState(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE ExtPtfm_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtPtfm_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(ExtPtfm_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState - END SUBROUTINE ExtPtfm_CopyDiscState - - SUBROUTINE ExtPtfm_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(ExtPtfm_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE ExtPtfm_DestroyDiscState +subroutine ExtPtfm_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(ExtPtfm_DiscreteStateType), intent(in) :: SrcDiscStateData + type(ExtPtfm_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ExtPtfm_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState +end subroutine +subroutine ExtPtfm_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(ExtPtfm_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ExtPtfm_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine ExtPtfm_PackDiscState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ExtPtfm_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'ExtPtfm_PackDiscState' if (Buf%ErrStat >= AbortErrLev) return - ! DummyDiscState call RegPack(Buf, InData%DummyDiscState) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1109,49 +1023,36 @@ subroutine ExtPtfm_UnPackDiscState(Buf, OutData) type(ExtPtfm_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtPtfm_UnPackDiscState' if (Buf%ErrStat /= ErrID_None) return - ! DummyDiscState call RegUnpack(Buf, OutData%DummyDiscState) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE ExtPtfm_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtPtfm_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(ExtPtfm_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE ExtPtfm_CopyConstrState - SUBROUTINE ExtPtfm_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(ExtPtfm_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE ExtPtfm_DestroyConstrState +subroutine ExtPtfm_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(ExtPtfm_ConstraintStateType), intent(in) :: SrcConstrStateData + type(ExtPtfm_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ExtPtfm_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine +subroutine ExtPtfm_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(ExtPtfm_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ExtPtfm_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine ExtPtfm_PackConstrState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ExtPtfm_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'ExtPtfm_PackConstrState' if (Buf%ErrStat >= AbortErrLev) return - ! DummyConstrState call RegPack(Buf, InData%DummyConstrState) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1161,66 +1062,65 @@ subroutine ExtPtfm_UnPackConstrState(Buf, OutData) type(ExtPtfm_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtPtfm_UnPackConstrState' if (Buf%ErrStat /= ErrID_None) return - ! DummyConstrState call RegUnpack(Buf, OutData%DummyConstrState) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE ExtPtfm_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtPtfm_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(ExtPtfm_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_CopyOtherState' -! + +subroutine ExtPtfm_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(ExtPtfm_OtherStateType), intent(in) :: SrcOtherStateData + type(ExtPtfm_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtPtfm_CopyOtherState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOtherStateData%xdot)) THEN - i1_l = LBOUND(SrcOtherStateData%xdot,1) - i1_u = UBOUND(SrcOtherStateData%xdot,1) - IF (.NOT. ALLOCATED(DstOtherStateData%xdot)) THEN - ALLOCATE(DstOtherStateData%xdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%xdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOtherStateData%xdot,1), UBOUND(SrcOtherStateData%xdot,1) - CALL ExtPtfm_CopyContState( SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstOtherStateData%n = SrcOtherStateData%n - END SUBROUTINE ExtPtfm_CopyOtherState - - SUBROUTINE ExtPtfm_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(ExtPtfm_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OtherStateData%xdot)) THEN -DO i1 = LBOUND(OtherStateData%xdot,1), UBOUND(OtherStateData%xdot,1) - CALL ExtPtfm_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OtherStateData%xdot) -ENDIF - END SUBROUTINE ExtPtfm_DestroyOtherState + ErrMsg = '' + if (allocated(SrcOtherStateData%xdot)) then + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) + if (.not. allocated(DstOtherStateData%xdot)) then + allocate(DstOtherStateData%xdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%xdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ExtPtfm_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstOtherStateData%xdot)) then + deallocate(DstOtherStateData%xdot) + end if + DstOtherStateData%n = SrcOtherStateData%n +end subroutine +subroutine ExtPtfm_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(ExtPtfm_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtPtfm_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OtherStateData%xdot)) then + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) + do i1 = LB(1), UB(1) + call ExtPtfm_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OtherStateData%xdot) + end if +end subroutine subroutine ExtPtfm_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -1229,7 +1129,6 @@ subroutine ExtPtfm_PackOtherState(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! xdot call RegPack(Buf, allocated(InData%xdot)) if (allocated(InData%xdot)) then call RegPackBounds(Buf, 1, lbound(InData%xdot), ubound(InData%xdot)) @@ -1240,7 +1139,6 @@ subroutine ExtPtfm_PackOtherState(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! n call RegPack(Buf, InData%n) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1254,7 +1152,6 @@ subroutine ExtPtfm_UnPackOtherState(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! xdot if (allocated(OutData%xdot)) deallocate(OutData%xdot) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1270,120 +1167,109 @@ subroutine ExtPtfm_UnPackOtherState(Buf, OutData) call ExtPtfm_UnpackContState(Buf, OutData%xdot(i1)) ! xdot end do end if - ! n call RegUnpack(Buf, OutData%n) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE ExtPtfm_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtPtfm_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(ExtPtfm_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_CopyMisc' -! + +subroutine ExtPtfm_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(ExtPtfm_MiscVarType), intent(in) :: SrcMiscData + type(ExtPtfm_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'ExtPtfm_CopyMisc' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscData%xFlat)) THEN - i1_l = LBOUND(SrcMiscData%xFlat,1) - i1_u = UBOUND(SrcMiscData%xFlat,1) - IF (.NOT. ALLOCATED(DstMiscData%xFlat)) THEN - ALLOCATE(DstMiscData%xFlat(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%xFlat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%xFlat = SrcMiscData%xFlat -ENDIF - DstMiscData%uFlat = SrcMiscData%uFlat -IF (ALLOCATED(SrcMiscData%F_at_t)) THEN - i1_l = LBOUND(SrcMiscData%F_at_t,1) - i1_u = UBOUND(SrcMiscData%F_at_t,1) - IF (.NOT. ALLOCATED(DstMiscData%F_at_t)) THEN - ALLOCATE(DstMiscData%F_at_t(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_at_t.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_at_t = SrcMiscData%F_at_t -ENDIF - DstMiscData%Indx = SrcMiscData%Indx - DstMiscData%EquilStart = SrcMiscData%EquilStart -IF (ALLOCATED(SrcMiscData%AllOuts)) THEN - i1_l = LBOUND(SrcMiscData%AllOuts,1) - i1_u = UBOUND(SrcMiscData%AllOuts,1) - IF (.NOT. ALLOCATED(DstMiscData%AllOuts)) THEN - ALLOCATE(DstMiscData%AllOuts(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%AllOuts = SrcMiscData%AllOuts -ENDIF - END SUBROUTINE ExtPtfm_CopyMisc - - SUBROUTINE ExtPtfm_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(ExtPtfm_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MiscData%xFlat)) THEN - DEALLOCATE(MiscData%xFlat) -ENDIF -IF (ALLOCATED(MiscData%F_at_t)) THEN - DEALLOCATE(MiscData%F_at_t) -ENDIF -IF (ALLOCATED(MiscData%AllOuts)) THEN - DEALLOCATE(MiscData%AllOuts) -ENDIF - END SUBROUTINE ExtPtfm_DestroyMisc + ErrMsg = '' + if (allocated(SrcMiscData%xFlat)) then + LB(1:1) = lbound(SrcMiscData%xFlat) + UB(1:1) = ubound(SrcMiscData%xFlat) + if (.not. allocated(DstMiscData%xFlat)) then + allocate(DstMiscData%xFlat(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%xFlat.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%xFlat = SrcMiscData%xFlat + else if (allocated(DstMiscData%xFlat)) then + deallocate(DstMiscData%xFlat) + end if + DstMiscData%uFlat = SrcMiscData%uFlat + if (allocated(SrcMiscData%F_at_t)) then + LB(1:1) = lbound(SrcMiscData%F_at_t) + UB(1:1) = ubound(SrcMiscData%F_at_t) + if (.not. allocated(DstMiscData%F_at_t)) then + allocate(DstMiscData%F_at_t(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_at_t.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_at_t = SrcMiscData%F_at_t + else if (allocated(DstMiscData%F_at_t)) then + deallocate(DstMiscData%F_at_t) + end if + DstMiscData%Indx = SrcMiscData%Indx + DstMiscData%EquilStart = SrcMiscData%EquilStart + if (allocated(SrcMiscData%AllOuts)) then + LB(1:1) = lbound(SrcMiscData%AllOuts) + UB(1:1) = ubound(SrcMiscData%AllOuts) + if (.not. allocated(DstMiscData%AllOuts)) then + allocate(DstMiscData%AllOuts(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%AllOuts = SrcMiscData%AllOuts + else if (allocated(DstMiscData%AllOuts)) then + deallocate(DstMiscData%AllOuts) + end if +end subroutine +subroutine ExtPtfm_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(ExtPtfm_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ExtPtfm_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%xFlat)) then + deallocate(MiscData%xFlat) + end if + if (allocated(MiscData%F_at_t)) then + deallocate(MiscData%F_at_t) + end if + if (allocated(MiscData%AllOuts)) then + deallocate(MiscData%AllOuts) + end if +end subroutine subroutine ExtPtfm_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ExtPtfm_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'ExtPtfm_PackMisc' if (Buf%ErrStat >= AbortErrLev) return - ! xFlat call RegPack(Buf, allocated(InData%xFlat)) if (allocated(InData%xFlat)) then call RegPackBounds(Buf, 1, lbound(InData%xFlat), ubound(InData%xFlat)) call RegPack(Buf, InData%xFlat) end if if (RegCheckErr(Buf, RoutineName)) return - ! uFlat call RegPack(Buf, InData%uFlat) if (RegCheckErr(Buf, RoutineName)) return - ! F_at_t call RegPack(Buf, allocated(InData%F_at_t)) if (allocated(InData%F_at_t)) then call RegPackBounds(Buf, 1, lbound(InData%F_at_t), ubound(InData%F_at_t)) call RegPack(Buf, InData%F_at_t) end if if (RegCheckErr(Buf, RoutineName)) return - ! Indx call RegPack(Buf, InData%Indx) if (RegCheckErr(Buf, RoutineName)) return - ! EquilStart call RegPack(Buf, InData%EquilStart) if (RegCheckErr(Buf, RoutineName)) return - ! AllOuts call RegPack(Buf, allocated(InData%AllOuts)) if (allocated(InData%AllOuts)) then call RegPackBounds(Buf, 1, lbound(InData%AllOuts), ubound(InData%AllOuts)) @@ -1400,7 +1286,6 @@ subroutine ExtPtfm_UnPackMisc(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! xFlat if (allocated(OutData%xFlat)) deallocate(OutData%xFlat) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1415,10 +1300,8 @@ subroutine ExtPtfm_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%xFlat) if (RegCheckErr(Buf, RoutineName)) return end if - ! uFlat call RegUnpack(Buf, OutData%uFlat) if (RegCheckErr(Buf, RoutineName)) return - ! F_at_t if (allocated(OutData%F_at_t)) deallocate(OutData%F_at_t) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1433,13 +1316,10 @@ subroutine ExtPtfm_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%F_at_t) if (RegCheckErr(Buf, RoutineName)) return end if - ! Indx call RegUnpack(Buf, OutData%Indx) if (RegCheckErr(Buf, RoutineName)) return - ! EquilStart call RegUnpack(Buf, OutData%EquilStart) if (RegCheckErr(Buf, RoutineName)) return - ! AllOuts if (allocated(OutData%AllOuts)) deallocate(OutData%AllOuts) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1455,452 +1335,459 @@ subroutine ExtPtfm_UnPackMisc(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE ExtPtfm_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtPtfm_ParameterType), INTENT(IN) :: SrcParamData - TYPE(ExtPtfm_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_CopyParam' -! + +subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(ExtPtfm_ParameterType), intent(in) :: SrcParamData + type(ExtPtfm_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtPtfm_CopyParam' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcParamData%Mass)) THEN - i1_l = LBOUND(SrcParamData%Mass,1) - i1_u = UBOUND(SrcParamData%Mass,1) - i2_l = LBOUND(SrcParamData%Mass,2) - i2_u = UBOUND(SrcParamData%Mass,2) - IF (.NOT. ALLOCATED(DstParamData%Mass)) THEN - ALLOCATE(DstParamData%Mass(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Mass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Mass = SrcParamData%Mass -ENDIF -IF (ALLOCATED(SrcParamData%Damp)) THEN - i1_l = LBOUND(SrcParamData%Damp,1) - i1_u = UBOUND(SrcParamData%Damp,1) - i2_l = LBOUND(SrcParamData%Damp,2) - i2_u = UBOUND(SrcParamData%Damp,2) - IF (.NOT. ALLOCATED(DstParamData%Damp)) THEN - ALLOCATE(DstParamData%Damp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Damp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Damp = SrcParamData%Damp -ENDIF -IF (ALLOCATED(SrcParamData%Stff)) THEN - i1_l = LBOUND(SrcParamData%Stff,1) - i1_u = UBOUND(SrcParamData%Stff,1) - i2_l = LBOUND(SrcParamData%Stff,2) - i2_u = UBOUND(SrcParamData%Stff,2) - IF (.NOT. ALLOCATED(DstParamData%Stff)) THEN - ALLOCATE(DstParamData%Stff(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Stff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Stff = SrcParamData%Stff -ENDIF -IF (ALLOCATED(SrcParamData%Forces)) THEN - i1_l = LBOUND(SrcParamData%Forces,1) - i1_u = UBOUND(SrcParamData%Forces,1) - i2_l = LBOUND(SrcParamData%Forces,2) - i2_u = UBOUND(SrcParamData%Forces,2) - IF (.NOT. ALLOCATED(DstParamData%Forces)) THEN - ALLOCATE(DstParamData%Forces(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Forces.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Forces = SrcParamData%Forces -ENDIF -IF (ALLOCATED(SrcParamData%times)) THEN - i1_l = LBOUND(SrcParamData%times,1) - i1_u = UBOUND(SrcParamData%times,1) - IF (.NOT. ALLOCATED(DstParamData%times)) THEN - ALLOCATE(DstParamData%times(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%times.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%times = SrcParamData%times -ENDIF -IF (ALLOCATED(SrcParamData%AMat)) THEN - i1_l = LBOUND(SrcParamData%AMat,1) - i1_u = UBOUND(SrcParamData%AMat,1) - i2_l = LBOUND(SrcParamData%AMat,2) - i2_u = UBOUND(SrcParamData%AMat,2) - IF (.NOT. ALLOCATED(DstParamData%AMat)) THEN - ALLOCATE(DstParamData%AMat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AMat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AMat = SrcParamData%AMat -ENDIF -IF (ALLOCATED(SrcParamData%BMat)) THEN - i1_l = LBOUND(SrcParamData%BMat,1) - i1_u = UBOUND(SrcParamData%BMat,1) - i2_l = LBOUND(SrcParamData%BMat,2) - i2_u = UBOUND(SrcParamData%BMat,2) - IF (.NOT. ALLOCATED(DstParamData%BMat)) THEN - ALLOCATE(DstParamData%BMat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BMat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BMat = SrcParamData%BMat -ENDIF -IF (ALLOCATED(SrcParamData%CMat)) THEN - i1_l = LBOUND(SrcParamData%CMat,1) - i1_u = UBOUND(SrcParamData%CMat,1) - i2_l = LBOUND(SrcParamData%CMat,2) - i2_u = UBOUND(SrcParamData%CMat,2) - IF (.NOT. ALLOCATED(DstParamData%CMat)) THEN - ALLOCATE(DstParamData%CMat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CMat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CMat = SrcParamData%CMat -ENDIF -IF (ALLOCATED(SrcParamData%DMat)) THEN - i1_l = LBOUND(SrcParamData%DMat,1) - i1_u = UBOUND(SrcParamData%DMat,1) - i2_l = LBOUND(SrcParamData%DMat,2) - i2_u = UBOUND(SrcParamData%DMat,2) - IF (.NOT. ALLOCATED(DstParamData%DMat)) THEN - ALLOCATE(DstParamData%DMat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DMat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%DMat = SrcParamData%DMat -ENDIF -IF (ALLOCATED(SrcParamData%FX)) THEN - i1_l = LBOUND(SrcParamData%FX,1) - i1_u = UBOUND(SrcParamData%FX,1) - IF (.NOT. ALLOCATED(DstParamData%FX)) THEN - ALLOCATE(DstParamData%FX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FX = SrcParamData%FX -ENDIF -IF (ALLOCATED(SrcParamData%FY)) THEN - i1_l = LBOUND(SrcParamData%FY,1) - i1_u = UBOUND(SrcParamData%FY,1) - IF (.NOT. ALLOCATED(DstParamData%FY)) THEN - ALLOCATE(DstParamData%FY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FY = SrcParamData%FY -ENDIF -IF (ALLOCATED(SrcParamData%M11)) THEN - i1_l = LBOUND(SrcParamData%M11,1) - i1_u = UBOUND(SrcParamData%M11,1) - i2_l = LBOUND(SrcParamData%M11,2) - i2_u = UBOUND(SrcParamData%M11,2) - IF (.NOT. ALLOCATED(DstParamData%M11)) THEN - ALLOCATE(DstParamData%M11(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%M11.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%M11 = SrcParamData%M11 -ENDIF -IF (ALLOCATED(SrcParamData%M12)) THEN - i1_l = LBOUND(SrcParamData%M12,1) - i1_u = UBOUND(SrcParamData%M12,1) - i2_l = LBOUND(SrcParamData%M12,2) - i2_u = UBOUND(SrcParamData%M12,2) - IF (.NOT. ALLOCATED(DstParamData%M12)) THEN - ALLOCATE(DstParamData%M12(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%M12.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%M12 = SrcParamData%M12 -ENDIF -IF (ALLOCATED(SrcParamData%M22)) THEN - i1_l = LBOUND(SrcParamData%M22,1) - i1_u = UBOUND(SrcParamData%M22,1) - i2_l = LBOUND(SrcParamData%M22,2) - i2_u = UBOUND(SrcParamData%M22,2) - IF (.NOT. ALLOCATED(DstParamData%M22)) THEN - ALLOCATE(DstParamData%M22(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%M22.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%M22 = SrcParamData%M22 -ENDIF -IF (ALLOCATED(SrcParamData%M21)) THEN - i1_l = LBOUND(SrcParamData%M21,1) - i1_u = UBOUND(SrcParamData%M21,1) - i2_l = LBOUND(SrcParamData%M21,2) - i2_u = UBOUND(SrcParamData%M21,2) - IF (.NOT. ALLOCATED(DstParamData%M21)) THEN - ALLOCATE(DstParamData%M21(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%M21.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%M21 = SrcParamData%M21 -ENDIF -IF (ALLOCATED(SrcParamData%K11)) THEN - i1_l = LBOUND(SrcParamData%K11,1) - i1_u = UBOUND(SrcParamData%K11,1) - i2_l = LBOUND(SrcParamData%K11,2) - i2_u = UBOUND(SrcParamData%K11,2) - IF (.NOT. ALLOCATED(DstParamData%K11)) THEN - ALLOCATE(DstParamData%K11(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%K11.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%K11 = SrcParamData%K11 -ENDIF -IF (ALLOCATED(SrcParamData%K22)) THEN - i1_l = LBOUND(SrcParamData%K22,1) - i1_u = UBOUND(SrcParamData%K22,1) - i2_l = LBOUND(SrcParamData%K22,2) - i2_u = UBOUND(SrcParamData%K22,2) - IF (.NOT. ALLOCATED(DstParamData%K22)) THEN - ALLOCATE(DstParamData%K22(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%K22.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%K22 = SrcParamData%K22 -ENDIF -IF (ALLOCATED(SrcParamData%C11)) THEN - i1_l = LBOUND(SrcParamData%C11,1) - i1_u = UBOUND(SrcParamData%C11,1) - i2_l = LBOUND(SrcParamData%C11,2) - i2_u = UBOUND(SrcParamData%C11,2) - IF (.NOT. ALLOCATED(DstParamData%C11)) THEN - ALLOCATE(DstParamData%C11(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C11.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%C11 = SrcParamData%C11 -ENDIF -IF (ALLOCATED(SrcParamData%C12)) THEN - i1_l = LBOUND(SrcParamData%C12,1) - i1_u = UBOUND(SrcParamData%C12,1) - i2_l = LBOUND(SrcParamData%C12,2) - i2_u = UBOUND(SrcParamData%C12,2) - IF (.NOT. ALLOCATED(DstParamData%C12)) THEN - ALLOCATE(DstParamData%C12(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C12.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%C12 = SrcParamData%C12 -ENDIF -IF (ALLOCATED(SrcParamData%C22)) THEN - i1_l = LBOUND(SrcParamData%C22,1) - i1_u = UBOUND(SrcParamData%C22,1) - i2_l = LBOUND(SrcParamData%C22,2) - i2_u = UBOUND(SrcParamData%C22,2) - IF (.NOT. ALLOCATED(DstParamData%C22)) THEN - ALLOCATE(DstParamData%C22(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C22.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%C22 = SrcParamData%C22 -ENDIF -IF (ALLOCATED(SrcParamData%C21)) THEN - i1_l = LBOUND(SrcParamData%C21,1) - i1_u = UBOUND(SrcParamData%C21,1) - i2_l = LBOUND(SrcParamData%C21,2) - i2_u = UBOUND(SrcParamData%C21,2) - IF (.NOT. ALLOCATED(DstParamData%C21)) THEN - ALLOCATE(DstParamData%C21(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C21.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%C21 = SrcParamData%C21 -ENDIF - DstParamData%EP_DeltaT = SrcParamData%EP_DeltaT - DstParamData%nTimeSteps = SrcParamData%nTimeSteps - DstParamData%nCB = SrcParamData%nCB - DstParamData%nCBFull = SrcParamData%nCBFull - DstParamData%nTot = SrcParamData%nTot - DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%IntMethod = SrcParamData%IntMethod -IF (ALLOCATED(SrcParamData%ActiveCBDOF)) THEN - i1_l = LBOUND(SrcParamData%ActiveCBDOF,1) - i1_u = UBOUND(SrcParamData%ActiveCBDOF,1) - IF (.NOT. ALLOCATED(DstParamData%ActiveCBDOF)) THEN - ALLOCATE(DstParamData%ActiveCBDOF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ActiveCBDOF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ActiveCBDOF = SrcParamData%ActiveCBDOF -ENDIF -IF (ALLOCATED(SrcParamData%OutParam)) THEN - i1_l = LBOUND(SrcParamData%OutParam,1) - i1_u = UBOUND(SrcParamData%OutParam,1) - IF (.NOT. ALLOCATED(DstParamData%OutParam)) THEN - ALLOCATE(DstParamData%OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%OutParam,1), UBOUND(SrcParamData%OutParam,1) - CALL NWTC_Library_Copyoutparmtype( SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%OutParamLinIndx)) THEN - i1_l = LBOUND(SrcParamData%OutParamLinIndx,1) - i1_u = UBOUND(SrcParamData%OutParamLinIndx,1) - i2_l = LBOUND(SrcParamData%OutParamLinIndx,2) - i2_u = UBOUND(SrcParamData%OutParamLinIndx,2) - IF (.NOT. ALLOCATED(DstParamData%OutParamLinIndx)) THEN - ALLOCATE(DstParamData%OutParamLinIndx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParamLinIndx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%OutParamLinIndx = SrcParamData%OutParamLinIndx -ENDIF - END SUBROUTINE ExtPtfm_CopyParam - - SUBROUTINE ExtPtfm_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(ExtPtfm_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%Mass)) THEN - DEALLOCATE(ParamData%Mass) -ENDIF -IF (ALLOCATED(ParamData%Damp)) THEN - DEALLOCATE(ParamData%Damp) -ENDIF -IF (ALLOCATED(ParamData%Stff)) THEN - DEALLOCATE(ParamData%Stff) -ENDIF -IF (ALLOCATED(ParamData%Forces)) THEN - DEALLOCATE(ParamData%Forces) -ENDIF -IF (ALLOCATED(ParamData%times)) THEN - DEALLOCATE(ParamData%times) -ENDIF -IF (ALLOCATED(ParamData%AMat)) THEN - DEALLOCATE(ParamData%AMat) -ENDIF -IF (ALLOCATED(ParamData%BMat)) THEN - DEALLOCATE(ParamData%BMat) -ENDIF -IF (ALLOCATED(ParamData%CMat)) THEN - DEALLOCATE(ParamData%CMat) -ENDIF -IF (ALLOCATED(ParamData%DMat)) THEN - DEALLOCATE(ParamData%DMat) -ENDIF -IF (ALLOCATED(ParamData%FX)) THEN - DEALLOCATE(ParamData%FX) -ENDIF -IF (ALLOCATED(ParamData%FY)) THEN - DEALLOCATE(ParamData%FY) -ENDIF -IF (ALLOCATED(ParamData%M11)) THEN - DEALLOCATE(ParamData%M11) -ENDIF -IF (ALLOCATED(ParamData%M12)) THEN - DEALLOCATE(ParamData%M12) -ENDIF -IF (ALLOCATED(ParamData%M22)) THEN - DEALLOCATE(ParamData%M22) -ENDIF -IF (ALLOCATED(ParamData%M21)) THEN - DEALLOCATE(ParamData%M21) -ENDIF -IF (ALLOCATED(ParamData%K11)) THEN - DEALLOCATE(ParamData%K11) -ENDIF -IF (ALLOCATED(ParamData%K22)) THEN - DEALLOCATE(ParamData%K22) -ENDIF -IF (ALLOCATED(ParamData%C11)) THEN - DEALLOCATE(ParamData%C11) -ENDIF -IF (ALLOCATED(ParamData%C12)) THEN - DEALLOCATE(ParamData%C12) -ENDIF -IF (ALLOCATED(ParamData%C22)) THEN - DEALLOCATE(ParamData%C22) -ENDIF -IF (ALLOCATED(ParamData%C21)) THEN - DEALLOCATE(ParamData%C21) -ENDIF -IF (ALLOCATED(ParamData%ActiveCBDOF)) THEN - DEALLOCATE(ParamData%ActiveCBDOF) -ENDIF -IF (ALLOCATED(ParamData%OutParam)) THEN -DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_DestroyOutParmType( ParamData%OutParam(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%OutParam) -ENDIF -IF (ALLOCATED(ParamData%OutParamLinIndx)) THEN - DEALLOCATE(ParamData%OutParamLinIndx) -ENDIF - END SUBROUTINE ExtPtfm_DestroyParam + ErrMsg = '' + if (allocated(SrcParamData%Mass)) then + LB(1:2) = lbound(SrcParamData%Mass) + UB(1:2) = ubound(SrcParamData%Mass) + if (.not. allocated(DstParamData%Mass)) then + allocate(DstParamData%Mass(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Mass.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Mass = SrcParamData%Mass + else if (allocated(DstParamData%Mass)) then + deallocate(DstParamData%Mass) + end if + if (allocated(SrcParamData%Damp)) then + LB(1:2) = lbound(SrcParamData%Damp) + UB(1:2) = ubound(SrcParamData%Damp) + if (.not. allocated(DstParamData%Damp)) then + allocate(DstParamData%Damp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Damp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Damp = SrcParamData%Damp + else if (allocated(DstParamData%Damp)) then + deallocate(DstParamData%Damp) + end if + if (allocated(SrcParamData%Stff)) then + LB(1:2) = lbound(SrcParamData%Stff) + UB(1:2) = ubound(SrcParamData%Stff) + if (.not. allocated(DstParamData%Stff)) then + allocate(DstParamData%Stff(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Stff.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Stff = SrcParamData%Stff + else if (allocated(DstParamData%Stff)) then + deallocate(DstParamData%Stff) + end if + if (allocated(SrcParamData%Forces)) then + LB(1:2) = lbound(SrcParamData%Forces) + UB(1:2) = ubound(SrcParamData%Forces) + if (.not. allocated(DstParamData%Forces)) then + allocate(DstParamData%Forces(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Forces.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Forces = SrcParamData%Forces + else if (allocated(DstParamData%Forces)) then + deallocate(DstParamData%Forces) + end if + if (allocated(SrcParamData%times)) then + LB(1:1) = lbound(SrcParamData%times) + UB(1:1) = ubound(SrcParamData%times) + if (.not. allocated(DstParamData%times)) then + allocate(DstParamData%times(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%times.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%times = SrcParamData%times + else if (allocated(DstParamData%times)) then + deallocate(DstParamData%times) + end if + if (allocated(SrcParamData%AMat)) then + LB(1:2) = lbound(SrcParamData%AMat) + UB(1:2) = ubound(SrcParamData%AMat) + if (.not. allocated(DstParamData%AMat)) then + allocate(DstParamData%AMat(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AMat.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AMat = SrcParamData%AMat + else if (allocated(DstParamData%AMat)) then + deallocate(DstParamData%AMat) + end if + if (allocated(SrcParamData%BMat)) then + LB(1:2) = lbound(SrcParamData%BMat) + UB(1:2) = ubound(SrcParamData%BMat) + if (.not. allocated(DstParamData%BMat)) then + allocate(DstParamData%BMat(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BMat.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BMat = SrcParamData%BMat + else if (allocated(DstParamData%BMat)) then + deallocate(DstParamData%BMat) + end if + if (allocated(SrcParamData%CMat)) then + LB(1:2) = lbound(SrcParamData%CMat) + UB(1:2) = ubound(SrcParamData%CMat) + if (.not. allocated(DstParamData%CMat)) then + allocate(DstParamData%CMat(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CMat.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%CMat = SrcParamData%CMat + else if (allocated(DstParamData%CMat)) then + deallocate(DstParamData%CMat) + end if + if (allocated(SrcParamData%DMat)) then + LB(1:2) = lbound(SrcParamData%DMat) + UB(1:2) = ubound(SrcParamData%DMat) + if (.not. allocated(DstParamData%DMat)) then + allocate(DstParamData%DMat(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DMat.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%DMat = SrcParamData%DMat + else if (allocated(DstParamData%DMat)) then + deallocate(DstParamData%DMat) + end if + if (allocated(SrcParamData%FX)) then + LB(1:1) = lbound(SrcParamData%FX) + UB(1:1) = ubound(SrcParamData%FX) + if (.not. allocated(DstParamData%FX)) then + allocate(DstParamData%FX(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%FX = SrcParamData%FX + else if (allocated(DstParamData%FX)) then + deallocate(DstParamData%FX) + end if + if (allocated(SrcParamData%FY)) then + LB(1:1) = lbound(SrcParamData%FY) + UB(1:1) = ubound(SrcParamData%FY) + if (.not. allocated(DstParamData%FY)) then + allocate(DstParamData%FY(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%FY = SrcParamData%FY + else if (allocated(DstParamData%FY)) then + deallocate(DstParamData%FY) + end if + if (allocated(SrcParamData%M11)) then + LB(1:2) = lbound(SrcParamData%M11) + UB(1:2) = ubound(SrcParamData%M11) + if (.not. allocated(DstParamData%M11)) then + allocate(DstParamData%M11(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%M11.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%M11 = SrcParamData%M11 + else if (allocated(DstParamData%M11)) then + deallocate(DstParamData%M11) + end if + if (allocated(SrcParamData%M12)) then + LB(1:2) = lbound(SrcParamData%M12) + UB(1:2) = ubound(SrcParamData%M12) + if (.not. allocated(DstParamData%M12)) then + allocate(DstParamData%M12(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%M12.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%M12 = SrcParamData%M12 + else if (allocated(DstParamData%M12)) then + deallocate(DstParamData%M12) + end if + if (allocated(SrcParamData%M22)) then + LB(1:2) = lbound(SrcParamData%M22) + UB(1:2) = ubound(SrcParamData%M22) + if (.not. allocated(DstParamData%M22)) then + allocate(DstParamData%M22(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%M22.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%M22 = SrcParamData%M22 + else if (allocated(DstParamData%M22)) then + deallocate(DstParamData%M22) + end if + if (allocated(SrcParamData%M21)) then + LB(1:2) = lbound(SrcParamData%M21) + UB(1:2) = ubound(SrcParamData%M21) + if (.not. allocated(DstParamData%M21)) then + allocate(DstParamData%M21(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%M21.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%M21 = SrcParamData%M21 + else if (allocated(DstParamData%M21)) then + deallocate(DstParamData%M21) + end if + if (allocated(SrcParamData%K11)) then + LB(1:2) = lbound(SrcParamData%K11) + UB(1:2) = ubound(SrcParamData%K11) + if (.not. allocated(DstParamData%K11)) then + allocate(DstParamData%K11(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%K11.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%K11 = SrcParamData%K11 + else if (allocated(DstParamData%K11)) then + deallocate(DstParamData%K11) + end if + if (allocated(SrcParamData%K22)) then + LB(1:2) = lbound(SrcParamData%K22) + UB(1:2) = ubound(SrcParamData%K22) + if (.not. allocated(DstParamData%K22)) then + allocate(DstParamData%K22(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%K22.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%K22 = SrcParamData%K22 + else if (allocated(DstParamData%K22)) then + deallocate(DstParamData%K22) + end if + if (allocated(SrcParamData%C11)) then + LB(1:2) = lbound(SrcParamData%C11) + UB(1:2) = ubound(SrcParamData%C11) + if (.not. allocated(DstParamData%C11)) then + allocate(DstParamData%C11(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C11.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%C11 = SrcParamData%C11 + else if (allocated(DstParamData%C11)) then + deallocate(DstParamData%C11) + end if + if (allocated(SrcParamData%C12)) then + LB(1:2) = lbound(SrcParamData%C12) + UB(1:2) = ubound(SrcParamData%C12) + if (.not. allocated(DstParamData%C12)) then + allocate(DstParamData%C12(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C12.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%C12 = SrcParamData%C12 + else if (allocated(DstParamData%C12)) then + deallocate(DstParamData%C12) + end if + if (allocated(SrcParamData%C22)) then + LB(1:2) = lbound(SrcParamData%C22) + UB(1:2) = ubound(SrcParamData%C22) + if (.not. allocated(DstParamData%C22)) then + allocate(DstParamData%C22(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C22.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%C22 = SrcParamData%C22 + else if (allocated(DstParamData%C22)) then + deallocate(DstParamData%C22) + end if + if (allocated(SrcParamData%C21)) then + LB(1:2) = lbound(SrcParamData%C21) + UB(1:2) = ubound(SrcParamData%C21) + if (.not. allocated(DstParamData%C21)) then + allocate(DstParamData%C21(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C21.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%C21 = SrcParamData%C21 + else if (allocated(DstParamData%C21)) then + deallocate(DstParamData%C21) + end if + DstParamData%EP_DeltaT = SrcParamData%EP_DeltaT + DstParamData%nTimeSteps = SrcParamData%nTimeSteps + DstParamData%nCB = SrcParamData%nCB + DstParamData%nCBFull = SrcParamData%nCBFull + DstParamData%nTot = SrcParamData%nTot + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%IntMethod = SrcParamData%IntMethod + if (allocated(SrcParamData%ActiveCBDOF)) then + LB(1:1) = lbound(SrcParamData%ActiveCBDOF) + UB(1:1) = ubound(SrcParamData%ActiveCBDOF) + if (.not. allocated(DstParamData%ActiveCBDOF)) then + allocate(DstParamData%ActiveCBDOF(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ActiveCBDOF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%ActiveCBDOF = SrcParamData%ActiveCBDOF + else if (allocated(DstParamData%ActiveCBDOF)) then + deallocate(DstParamData%ActiveCBDOF) + end if + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstParamData%OutParam)) then + deallocate(DstParamData%OutParam) + end if + if (allocated(SrcParamData%OutParamLinIndx)) then + LB(1:2) = lbound(SrcParamData%OutParamLinIndx) + UB(1:2) = ubound(SrcParamData%OutParamLinIndx) + if (.not. allocated(DstParamData%OutParamLinIndx)) then + allocate(DstParamData%OutParamLinIndx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParamLinIndx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%OutParamLinIndx = SrcParamData%OutParamLinIndx + else if (allocated(DstParamData%OutParamLinIndx)) then + deallocate(DstParamData%OutParamLinIndx) + end if +end subroutine +subroutine ExtPtfm_DestroyParam(ParamData, ErrStat, ErrMsg) + type(ExtPtfm_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtPtfm_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%Mass)) then + deallocate(ParamData%Mass) + end if + if (allocated(ParamData%Damp)) then + deallocate(ParamData%Damp) + end if + if (allocated(ParamData%Stff)) then + deallocate(ParamData%Stff) + end if + if (allocated(ParamData%Forces)) then + deallocate(ParamData%Forces) + end if + if (allocated(ParamData%times)) then + deallocate(ParamData%times) + end if + if (allocated(ParamData%AMat)) then + deallocate(ParamData%AMat) + end if + if (allocated(ParamData%BMat)) then + deallocate(ParamData%BMat) + end if + if (allocated(ParamData%CMat)) then + deallocate(ParamData%CMat) + end if + if (allocated(ParamData%DMat)) then + deallocate(ParamData%DMat) + end if + if (allocated(ParamData%FX)) then + deallocate(ParamData%FX) + end if + if (allocated(ParamData%FY)) then + deallocate(ParamData%FY) + end if + if (allocated(ParamData%M11)) then + deallocate(ParamData%M11) + end if + if (allocated(ParamData%M12)) then + deallocate(ParamData%M12) + end if + if (allocated(ParamData%M22)) then + deallocate(ParamData%M22) + end if + if (allocated(ParamData%M21)) then + deallocate(ParamData%M21) + end if + if (allocated(ParamData%K11)) then + deallocate(ParamData%K11) + end if + if (allocated(ParamData%K22)) then + deallocate(ParamData%K22) + end if + if (allocated(ParamData%C11)) then + deallocate(ParamData%C11) + end if + if (allocated(ParamData%C12)) then + deallocate(ParamData%C12) + end if + if (allocated(ParamData%C22)) then + deallocate(ParamData%C22) + end if + if (allocated(ParamData%C21)) then + deallocate(ParamData%C21) + end if + if (allocated(ParamData%ActiveCBDOF)) then + deallocate(ParamData%ActiveCBDOF) + end if + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%OutParam) + end if + if (allocated(ParamData%OutParamLinIndx)) then + deallocate(ParamData%OutParamLinIndx) + end if +end subroutine subroutine ExtPtfm_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -1909,182 +1796,152 @@ subroutine ExtPtfm_PackParam(Buf, Indata) integer(IntKi) :: i1, i2 integer(IntKi) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return - ! Mass call RegPack(Buf, allocated(InData%Mass)) if (allocated(InData%Mass)) then call RegPackBounds(Buf, 2, lbound(InData%Mass), ubound(InData%Mass)) call RegPack(Buf, InData%Mass) end if if (RegCheckErr(Buf, RoutineName)) return - ! Damp call RegPack(Buf, allocated(InData%Damp)) if (allocated(InData%Damp)) then call RegPackBounds(Buf, 2, lbound(InData%Damp), ubound(InData%Damp)) call RegPack(Buf, InData%Damp) end if if (RegCheckErr(Buf, RoutineName)) return - ! Stff call RegPack(Buf, allocated(InData%Stff)) if (allocated(InData%Stff)) then call RegPackBounds(Buf, 2, lbound(InData%Stff), ubound(InData%Stff)) call RegPack(Buf, InData%Stff) end if if (RegCheckErr(Buf, RoutineName)) return - ! Forces call RegPack(Buf, allocated(InData%Forces)) if (allocated(InData%Forces)) then call RegPackBounds(Buf, 2, lbound(InData%Forces), ubound(InData%Forces)) call RegPack(Buf, InData%Forces) end if if (RegCheckErr(Buf, RoutineName)) return - ! times call RegPack(Buf, allocated(InData%times)) if (allocated(InData%times)) then call RegPackBounds(Buf, 1, lbound(InData%times), ubound(InData%times)) call RegPack(Buf, InData%times) end if if (RegCheckErr(Buf, RoutineName)) return - ! AMat call RegPack(Buf, allocated(InData%AMat)) if (allocated(InData%AMat)) then call RegPackBounds(Buf, 2, lbound(InData%AMat), ubound(InData%AMat)) call RegPack(Buf, InData%AMat) end if if (RegCheckErr(Buf, RoutineName)) return - ! BMat call RegPack(Buf, allocated(InData%BMat)) if (allocated(InData%BMat)) then call RegPackBounds(Buf, 2, lbound(InData%BMat), ubound(InData%BMat)) call RegPack(Buf, InData%BMat) end if if (RegCheckErr(Buf, RoutineName)) return - ! CMat call RegPack(Buf, allocated(InData%CMat)) if (allocated(InData%CMat)) then call RegPackBounds(Buf, 2, lbound(InData%CMat), ubound(InData%CMat)) call RegPack(Buf, InData%CMat) end if if (RegCheckErr(Buf, RoutineName)) return - ! DMat call RegPack(Buf, allocated(InData%DMat)) if (allocated(InData%DMat)) then call RegPackBounds(Buf, 2, lbound(InData%DMat), ubound(InData%DMat)) call RegPack(Buf, InData%DMat) end if if (RegCheckErr(Buf, RoutineName)) return - ! FX call RegPack(Buf, allocated(InData%FX)) if (allocated(InData%FX)) then call RegPackBounds(Buf, 1, lbound(InData%FX), ubound(InData%FX)) call RegPack(Buf, InData%FX) end if if (RegCheckErr(Buf, RoutineName)) return - ! FY call RegPack(Buf, allocated(InData%FY)) if (allocated(InData%FY)) then call RegPackBounds(Buf, 1, lbound(InData%FY), ubound(InData%FY)) call RegPack(Buf, InData%FY) end if if (RegCheckErr(Buf, RoutineName)) return - ! M11 call RegPack(Buf, allocated(InData%M11)) if (allocated(InData%M11)) then call RegPackBounds(Buf, 2, lbound(InData%M11), ubound(InData%M11)) call RegPack(Buf, InData%M11) end if if (RegCheckErr(Buf, RoutineName)) return - ! M12 call RegPack(Buf, allocated(InData%M12)) if (allocated(InData%M12)) then call RegPackBounds(Buf, 2, lbound(InData%M12), ubound(InData%M12)) call RegPack(Buf, InData%M12) end if if (RegCheckErr(Buf, RoutineName)) return - ! M22 call RegPack(Buf, allocated(InData%M22)) if (allocated(InData%M22)) then call RegPackBounds(Buf, 2, lbound(InData%M22), ubound(InData%M22)) call RegPack(Buf, InData%M22) end if if (RegCheckErr(Buf, RoutineName)) return - ! M21 call RegPack(Buf, allocated(InData%M21)) if (allocated(InData%M21)) then call RegPackBounds(Buf, 2, lbound(InData%M21), ubound(InData%M21)) call RegPack(Buf, InData%M21) end if if (RegCheckErr(Buf, RoutineName)) return - ! K11 call RegPack(Buf, allocated(InData%K11)) if (allocated(InData%K11)) then call RegPackBounds(Buf, 2, lbound(InData%K11), ubound(InData%K11)) call RegPack(Buf, InData%K11) end if if (RegCheckErr(Buf, RoutineName)) return - ! K22 call RegPack(Buf, allocated(InData%K22)) if (allocated(InData%K22)) then call RegPackBounds(Buf, 2, lbound(InData%K22), ubound(InData%K22)) call RegPack(Buf, InData%K22) end if if (RegCheckErr(Buf, RoutineName)) return - ! C11 call RegPack(Buf, allocated(InData%C11)) if (allocated(InData%C11)) then call RegPackBounds(Buf, 2, lbound(InData%C11), ubound(InData%C11)) call RegPack(Buf, InData%C11) end if if (RegCheckErr(Buf, RoutineName)) return - ! C12 call RegPack(Buf, allocated(InData%C12)) if (allocated(InData%C12)) then call RegPackBounds(Buf, 2, lbound(InData%C12), ubound(InData%C12)) call RegPack(Buf, InData%C12) end if if (RegCheckErr(Buf, RoutineName)) return - ! C22 call RegPack(Buf, allocated(InData%C22)) if (allocated(InData%C22)) then call RegPackBounds(Buf, 2, lbound(InData%C22), ubound(InData%C22)) call RegPack(Buf, InData%C22) end if if (RegCheckErr(Buf, RoutineName)) return - ! C21 call RegPack(Buf, allocated(InData%C21)) if (allocated(InData%C21)) then call RegPackBounds(Buf, 2, lbound(InData%C21), ubound(InData%C21)) call RegPack(Buf, InData%C21) end if if (RegCheckErr(Buf, RoutineName)) return - ! EP_DeltaT call RegPack(Buf, InData%EP_DeltaT) if (RegCheckErr(Buf, RoutineName)) return - ! nTimeSteps call RegPack(Buf, InData%nTimeSteps) if (RegCheckErr(Buf, RoutineName)) return - ! nCB call RegPack(Buf, InData%nCB) if (RegCheckErr(Buf, RoutineName)) return - ! nCBFull call RegPack(Buf, InData%nCBFull) if (RegCheckErr(Buf, RoutineName)) return - ! nTot call RegPack(Buf, InData%nTot) if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegPack(Buf, InData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! IntMethod call RegPack(Buf, InData%IntMethod) if (RegCheckErr(Buf, RoutineName)) return - ! ActiveCBDOF call RegPack(Buf, allocated(InData%ActiveCBDOF)) if (allocated(InData%ActiveCBDOF)) then call RegPackBounds(Buf, 1, lbound(InData%ActiveCBDOF), ubound(InData%ActiveCBDOF)) call RegPack(Buf, InData%ActiveCBDOF) end if if (RegCheckErr(Buf, RoutineName)) return - ! OutParam call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) @@ -2095,7 +1952,6 @@ subroutine ExtPtfm_PackParam(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! OutParamLinIndx call RegPack(Buf, allocated(InData%OutParamLinIndx)) if (allocated(InData%OutParamLinIndx)) then call RegPackBounds(Buf, 2, lbound(InData%OutParamLinIndx), ubound(InData%OutParamLinIndx)) @@ -2113,7 +1969,6 @@ subroutine ExtPtfm_UnPackParam(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! Mass if (allocated(OutData%Mass)) deallocate(OutData%Mass) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2128,7 +1983,6 @@ subroutine ExtPtfm_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%Mass) if (RegCheckErr(Buf, RoutineName)) return end if - ! Damp if (allocated(OutData%Damp)) deallocate(OutData%Damp) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2143,7 +1997,6 @@ subroutine ExtPtfm_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%Damp) if (RegCheckErr(Buf, RoutineName)) return end if - ! Stff if (allocated(OutData%Stff)) deallocate(OutData%Stff) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2158,7 +2011,6 @@ subroutine ExtPtfm_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%Stff) if (RegCheckErr(Buf, RoutineName)) return end if - ! Forces if (allocated(OutData%Forces)) deallocate(OutData%Forces) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2173,7 +2025,6 @@ subroutine ExtPtfm_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%Forces) if (RegCheckErr(Buf, RoutineName)) return end if - ! times if (allocated(OutData%times)) deallocate(OutData%times) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2188,7 +2039,6 @@ subroutine ExtPtfm_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%times) if (RegCheckErr(Buf, RoutineName)) return end if - ! AMat if (allocated(OutData%AMat)) deallocate(OutData%AMat) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2203,7 +2053,6 @@ subroutine ExtPtfm_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%AMat) if (RegCheckErr(Buf, RoutineName)) return end if - ! BMat if (allocated(OutData%BMat)) deallocate(OutData%BMat) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2218,7 +2067,6 @@ subroutine ExtPtfm_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%BMat) if (RegCheckErr(Buf, RoutineName)) return end if - ! CMat if (allocated(OutData%CMat)) deallocate(OutData%CMat) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2233,7 +2081,6 @@ subroutine ExtPtfm_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%CMat) if (RegCheckErr(Buf, RoutineName)) return end if - ! DMat if (allocated(OutData%DMat)) deallocate(OutData%DMat) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2248,7 +2095,6 @@ subroutine ExtPtfm_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%DMat) if (RegCheckErr(Buf, RoutineName)) return end if - ! FX if (allocated(OutData%FX)) deallocate(OutData%FX) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2263,7 +2109,6 @@ subroutine ExtPtfm_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%FX) if (RegCheckErr(Buf, RoutineName)) return end if - ! FY if (allocated(OutData%FY)) deallocate(OutData%FY) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2278,7 +2123,6 @@ subroutine ExtPtfm_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%FY) if (RegCheckErr(Buf, RoutineName)) return end if - ! M11 if (allocated(OutData%M11)) deallocate(OutData%M11) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2293,7 +2137,6 @@ subroutine ExtPtfm_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%M11) if (RegCheckErr(Buf, RoutineName)) return end if - ! M12 if (allocated(OutData%M12)) deallocate(OutData%M12) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2308,7 +2151,6 @@ subroutine ExtPtfm_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%M12) if (RegCheckErr(Buf, RoutineName)) return end if - ! M22 if (allocated(OutData%M22)) deallocate(OutData%M22) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2323,7 +2165,6 @@ subroutine ExtPtfm_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%M22) if (RegCheckErr(Buf, RoutineName)) return end if - ! M21 if (allocated(OutData%M21)) deallocate(OutData%M21) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2338,7 +2179,6 @@ subroutine ExtPtfm_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%M21) if (RegCheckErr(Buf, RoutineName)) return end if - ! K11 if (allocated(OutData%K11)) deallocate(OutData%K11) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2353,7 +2193,6 @@ subroutine ExtPtfm_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%K11) if (RegCheckErr(Buf, RoutineName)) return end if - ! K22 if (allocated(OutData%K22)) deallocate(OutData%K22) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2368,7 +2207,6 @@ subroutine ExtPtfm_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%K22) if (RegCheckErr(Buf, RoutineName)) return end if - ! C11 if (allocated(OutData%C11)) deallocate(OutData%C11) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2383,7 +2221,6 @@ subroutine ExtPtfm_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%C11) if (RegCheckErr(Buf, RoutineName)) return end if - ! C12 if (allocated(OutData%C12)) deallocate(OutData%C12) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2398,7 +2235,6 @@ subroutine ExtPtfm_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%C12) if (RegCheckErr(Buf, RoutineName)) return end if - ! C22 if (allocated(OutData%C22)) deallocate(OutData%C22) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2413,7 +2249,6 @@ subroutine ExtPtfm_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%C22) if (RegCheckErr(Buf, RoutineName)) return end if - ! C21 if (allocated(OutData%C21)) deallocate(OutData%C21) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2428,28 +2263,20 @@ subroutine ExtPtfm_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%C21) if (RegCheckErr(Buf, RoutineName)) return end if - ! EP_DeltaT call RegUnpack(Buf, OutData%EP_DeltaT) if (RegCheckErr(Buf, RoutineName)) return - ! nTimeSteps call RegUnpack(Buf, OutData%nTimeSteps) if (RegCheckErr(Buf, RoutineName)) return - ! nCB call RegUnpack(Buf, OutData%nCB) if (RegCheckErr(Buf, RoutineName)) return - ! nCBFull call RegUnpack(Buf, OutData%nCBFull) if (RegCheckErr(Buf, RoutineName)) return - ! nTot call RegUnpack(Buf, OutData%nTot) if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegUnpack(Buf, OutData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! IntMethod call RegUnpack(Buf, OutData%IntMethod) if (RegCheckErr(Buf, RoutineName)) return - ! ActiveCBDOF if (allocated(OutData%ActiveCBDOF)) deallocate(OutData%ActiveCBDOF) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2464,7 +2291,6 @@ subroutine ExtPtfm_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%ActiveCBDOF) if (RegCheckErr(Buf, RoutineName)) return end if - ! OutParam if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2480,7 +2306,6 @@ subroutine ExtPtfm_UnPackParam(Buf, OutData) call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam end do end if - ! OutParamLinIndx if (allocated(OutData%OutParamLinIndx)) deallocate(OutData%OutParamLinIndx) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2496,49 +2321,39 @@ subroutine ExtPtfm_UnPackParam(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE ExtPtfm_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtPtfm_InputType), INTENT(INOUT) :: SrcInputData - TYPE(ExtPtfm_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_CopyInput' -! + +subroutine ExtPtfm_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(ExtPtfm_InputType), intent(inout) :: SrcInputData + type(ExtPtfm_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtPtfm_CopyInput' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcInputData%PtfmMesh, DstInputData%PtfmMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE ExtPtfm_CopyInput - - SUBROUTINE ExtPtfm_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(ExtPtfm_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL MeshDestroy( InputData%PtfmMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE ExtPtfm_DestroyInput + ErrMsg = '' + call MeshCopy(SrcInputData%PtfmMesh, DstInputData%PtfmMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine ExtPtfm_DestroyInput(InputData, ErrStat, ErrMsg) + type(ExtPtfm_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtPtfm_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine ExtPtfm_PackInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ExtPtfm_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'ExtPtfm_PackInput' if (Buf%ErrStat >= AbortErrLev) return - ! PtfmMesh call MeshPack(Buf, InData%PtfmMesh) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2548,71 +2363,61 @@ subroutine ExtPtfm_UnPackInput(Buf, OutData) type(ExtPtfm_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtPtfm_UnPackInput' if (Buf%ErrStat /= ErrID_None) return - ! PtfmMesh call MeshUnpack(Buf, OutData%PtfmMesh) ! PtfmMesh end subroutine - SUBROUTINE ExtPtfm_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_CopyOutput' -! + +subroutine ExtPtfm_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(ExtPtfm_OutputType), intent(inout) :: SrcOutputData + type(ExtPtfm_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtPtfm_CopyOutput' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcOutputData%PtfmMesh, DstOutputData%PtfmMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcOutputData%WriteOutput)) THEN - i1_l = LBOUND(SrcOutputData%WriteOutput,1) - i1_u = UBOUND(SrcOutputData%WriteOutput,1) - IF (.NOT. ALLOCATED(DstOutputData%WriteOutput)) THEN - ALLOCATE(DstOutputData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%WriteOutput = SrcOutputData%WriteOutput -ENDIF - END SUBROUTINE ExtPtfm_CopyOutput - - SUBROUTINE ExtPtfm_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL MeshDestroy( OutputData%PtfmMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - END SUBROUTINE ExtPtfm_DestroyOutput + ErrMsg = '' + call MeshCopy(SrcOutputData%PtfmMesh, DstOutputData%PtfmMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%WriteOutput = SrcOutputData%WriteOutput + else if (allocated(DstOutputData%WriteOutput)) then + deallocate(DstOutputData%WriteOutput) + end if +end subroutine +subroutine ExtPtfm_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(ExtPtfm_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ExtPtfm_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine subroutine ExtPtfm_PackOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ExtPtfm_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'ExtPtfm_PackOutput' if (Buf%ErrStat >= AbortErrLev) return - ! PtfmMesh call MeshPack(Buf, InData%PtfmMesh) if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutput call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) @@ -2629,9 +2434,7 @@ subroutine ExtPtfm_UnPackOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! PtfmMesh call MeshUnpack(Buf, OutData%PtfmMesh) ! PtfmMesh - ! WriteOutput if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/feamooring/src/FEAMooring_Types.f90 b/modules/feamooring/src/FEAMooring_Types.f90 index bef3481d96..e62c830e95 100644 --- a/modules/feamooring/src/FEAMooring_Types.f90 +++ b/modules/feamooring/src/FEAMooring_Types.f90 @@ -224,498 +224,481 @@ MODULE FEAMooring_Types END TYPE FEAM_OutputType ! ======================= CONTAINS - SUBROUTINE FEAM_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FEAM_InputFile), INTENT(IN) :: SrcInputFileData - TYPE(FEAM_InputFile), INTENT(INOUT) :: DstInputFileData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_CopyInputFile' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInputFileData%DT = SrcInputFileData%DT -IF (ALLOCATED(SrcInputFileData%LineCI)) THEN - i1_l = LBOUND(SrcInputFileData%LineCI,1) - i1_u = UBOUND(SrcInputFileData%LineCI,1) - IF (.NOT. ALLOCATED(DstInputFileData%LineCI)) THEN - ALLOCATE(DstInputFileData%LineCI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LineCI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%LineCI = SrcInputFileData%LineCI -ENDIF -IF (ALLOCATED(SrcInputFileData%LineCD)) THEN - i1_l = LBOUND(SrcInputFileData%LineCD,1) - i1_u = UBOUND(SrcInputFileData%LineCD,1) - IF (.NOT. ALLOCATED(DstInputFileData%LineCD)) THEN - ALLOCATE(DstInputFileData%LineCD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LineCD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%LineCD = SrcInputFileData%LineCD -ENDIF -IF (ALLOCATED(SrcInputFileData%LEAStiff)) THEN - i1_l = LBOUND(SrcInputFileData%LEAStiff,1) - i1_u = UBOUND(SrcInputFileData%LEAStiff,1) - IF (.NOT. ALLOCATED(DstInputFileData%LEAStiff)) THEN - ALLOCATE(DstInputFileData%LEAStiff(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LEAStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%LEAStiff = SrcInputFileData%LEAStiff -ENDIF -IF (ALLOCATED(SrcInputFileData%LMassDen)) THEN - i1_l = LBOUND(SrcInputFileData%LMassDen,1) - i1_u = UBOUND(SrcInputFileData%LMassDen,1) - IF (.NOT. ALLOCATED(DstInputFileData%LMassDen)) THEN - ALLOCATE(DstInputFileData%LMassDen(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LMassDen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%LMassDen = SrcInputFileData%LMassDen -ENDIF -IF (ALLOCATED(SrcInputFileData%LDMassDen)) THEN - i1_l = LBOUND(SrcInputFileData%LDMassDen,1) - i1_u = UBOUND(SrcInputFileData%LDMassDen,1) - IF (.NOT. ALLOCATED(DstInputFileData%LDMassDen)) THEN - ALLOCATE(DstInputFileData%LDMassDen(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LDMassDen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%LDMassDen = SrcInputFileData%LDMassDen -ENDIF -IF (ALLOCATED(SrcInputFileData%BottmStiff)) THEN - i1_l = LBOUND(SrcInputFileData%BottmStiff,1) - i1_u = UBOUND(SrcInputFileData%BottmStiff,1) - IF (.NOT. ALLOCATED(DstInputFileData%BottmStiff)) THEN - ALLOCATE(DstInputFileData%BottmStiff(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BottmStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%BottmStiff = SrcInputFileData%BottmStiff -ENDIF -IF (ALLOCATED(SrcInputFileData%LRadAnch)) THEN - i1_l = LBOUND(SrcInputFileData%LRadAnch,1) - i1_u = UBOUND(SrcInputFileData%LRadAnch,1) - IF (.NOT. ALLOCATED(DstInputFileData%LRadAnch)) THEN - ALLOCATE(DstInputFileData%LRadAnch(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LRadAnch.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%LRadAnch = SrcInputFileData%LRadAnch -ENDIF -IF (ALLOCATED(SrcInputFileData%LAngAnch)) THEN - i1_l = LBOUND(SrcInputFileData%LAngAnch,1) - i1_u = UBOUND(SrcInputFileData%LAngAnch,1) - IF (.NOT. ALLOCATED(DstInputFileData%LAngAnch)) THEN - ALLOCATE(DstInputFileData%LAngAnch(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LAngAnch.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%LAngAnch = SrcInputFileData%LAngAnch -ENDIF -IF (ALLOCATED(SrcInputFileData%LDpthAnch)) THEN - i1_l = LBOUND(SrcInputFileData%LDpthAnch,1) - i1_u = UBOUND(SrcInputFileData%LDpthAnch,1) - IF (.NOT. ALLOCATED(DstInputFileData%LDpthAnch)) THEN - ALLOCATE(DstInputFileData%LDpthAnch(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LDpthAnch.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%LDpthAnch = SrcInputFileData%LDpthAnch -ENDIF -IF (ALLOCATED(SrcInputFileData%LRadFair)) THEN - i1_l = LBOUND(SrcInputFileData%LRadFair,1) - i1_u = UBOUND(SrcInputFileData%LRadFair,1) - IF (.NOT. ALLOCATED(DstInputFileData%LRadFair)) THEN - ALLOCATE(DstInputFileData%LRadFair(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LRadFair.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%LRadFair = SrcInputFileData%LRadFair -ENDIF -IF (ALLOCATED(SrcInputFileData%LAngFair)) THEN - i1_l = LBOUND(SrcInputFileData%LAngFair,1) - i1_u = UBOUND(SrcInputFileData%LAngFair,1) - IF (.NOT. ALLOCATED(DstInputFileData%LAngFair)) THEN - ALLOCATE(DstInputFileData%LAngFair(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LAngFair.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%LAngFair = SrcInputFileData%LAngFair -ENDIF -IF (ALLOCATED(SrcInputFileData%LDrftFair)) THEN - i1_l = LBOUND(SrcInputFileData%LDrftFair,1) - i1_u = UBOUND(SrcInputFileData%LDrftFair,1) - IF (.NOT. ALLOCATED(DstInputFileData%LDrftFair)) THEN - ALLOCATE(DstInputFileData%LDrftFair(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LDrftFair.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%LDrftFair = SrcInputFileData%LDrftFair -ENDIF -IF (ALLOCATED(SrcInputFileData%LUnstrLen)) THEN - i1_l = LBOUND(SrcInputFileData%LUnstrLen,1) - i1_u = UBOUND(SrcInputFileData%LUnstrLen,1) - IF (.NOT. ALLOCATED(DstInputFileData%LUnstrLen)) THEN - ALLOCATE(DstInputFileData%LUnstrLen(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LUnstrLen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%LUnstrLen = SrcInputFileData%LUnstrLen -ENDIF -IF (ALLOCATED(SrcInputFileData%Tension)) THEN - i1_l = LBOUND(SrcInputFileData%Tension,1) - i1_u = UBOUND(SrcInputFileData%Tension,1) - IF (.NOT. ALLOCATED(DstInputFileData%Tension)) THEN - ALLOCATE(DstInputFileData%Tension(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Tension.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%Tension = SrcInputFileData%Tension -ENDIF -IF (ALLOCATED(SrcInputFileData%GSL)) THEN - i1_l = LBOUND(SrcInputFileData%GSL,1) - i1_u = UBOUND(SrcInputFileData%GSL,1) - i2_l = LBOUND(SrcInputFileData%GSL,2) - i2_u = UBOUND(SrcInputFileData%GSL,2) - i3_l = LBOUND(SrcInputFileData%GSL,3) - i3_u = UBOUND(SrcInputFileData%GSL,3) - IF (.NOT. ALLOCATED(DstInputFileData%GSL)) THEN - ALLOCATE(DstInputFileData%GSL(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%GSL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%GSL = SrcInputFileData%GSL -ENDIF -IF (ALLOCATED(SrcInputFileData%GSR)) THEN - i1_l = LBOUND(SrcInputFileData%GSR,1) - i1_u = UBOUND(SrcInputFileData%GSR,1) - i2_l = LBOUND(SrcInputFileData%GSR,2) - i2_u = UBOUND(SrcInputFileData%GSR,2) - IF (.NOT. ALLOCATED(DstInputFileData%GSR)) THEN - ALLOCATE(DstInputFileData%GSR(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%GSR.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%GSR = SrcInputFileData%GSR -ENDIF -IF (ALLOCATED(SrcInputFileData%GE)) THEN - i1_l = LBOUND(SrcInputFileData%GE,1) - i1_u = UBOUND(SrcInputFileData%GE,1) - i2_l = LBOUND(SrcInputFileData%GE,2) - i2_u = UBOUND(SrcInputFileData%GE,2) - i3_l = LBOUND(SrcInputFileData%GE,3) - i3_u = UBOUND(SrcInputFileData%GE,3) - IF (.NOT. ALLOCATED(DstInputFileData%GE)) THEN - ALLOCATE(DstInputFileData%GE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%GE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%GE = SrcInputFileData%GE -ENDIF - DstInputFileData%NumLines = SrcInputFileData%NumLines - DstInputFileData%NumElems = SrcInputFileData%NumElems - DstInputFileData%Eps = SrcInputFileData%Eps - DstInputFileData%Gravity = SrcInputFileData%Gravity - DstInputFileData%WtrDens = SrcInputFileData%WtrDens - DstInputFileData%MaxIter = SrcInputFileData%MaxIter - DstInputFileData%SumPrint = SrcInputFileData%SumPrint - DstInputFileData%OutFile = SrcInputFileData%OutFile - DstInputFileData%TabDelim = SrcInputFileData%TabDelim - DstInputFileData%OutFmt = SrcInputFileData%OutFmt - DstInputFileData%Tstart = SrcInputFileData%Tstart - DstInputFileData%NumOuts = SrcInputFileData%NumOuts -IF (ALLOCATED(SrcInputFileData%OutList)) THEN - i1_l = LBOUND(SrcInputFileData%OutList,1) - i1_u = UBOUND(SrcInputFileData%OutList,1) - IF (.NOT. ALLOCATED(DstInputFileData%OutList)) THEN - ALLOCATE(DstInputFileData%OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%OutList = SrcInputFileData%OutList -ENDIF - END SUBROUTINE FEAM_CopyInputFile - - SUBROUTINE FEAM_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) - TYPE(FEAM_InputFile), INTENT(INOUT) :: InputFileData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_DestroyInputFile' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(InputFileData%LineCI)) THEN - DEALLOCATE(InputFileData%LineCI) -ENDIF -IF (ALLOCATED(InputFileData%LineCD)) THEN - DEALLOCATE(InputFileData%LineCD) -ENDIF -IF (ALLOCATED(InputFileData%LEAStiff)) THEN - DEALLOCATE(InputFileData%LEAStiff) -ENDIF -IF (ALLOCATED(InputFileData%LMassDen)) THEN - DEALLOCATE(InputFileData%LMassDen) -ENDIF -IF (ALLOCATED(InputFileData%LDMassDen)) THEN - DEALLOCATE(InputFileData%LDMassDen) -ENDIF -IF (ALLOCATED(InputFileData%BottmStiff)) THEN - DEALLOCATE(InputFileData%BottmStiff) -ENDIF -IF (ALLOCATED(InputFileData%LRadAnch)) THEN - DEALLOCATE(InputFileData%LRadAnch) -ENDIF -IF (ALLOCATED(InputFileData%LAngAnch)) THEN - DEALLOCATE(InputFileData%LAngAnch) -ENDIF -IF (ALLOCATED(InputFileData%LDpthAnch)) THEN - DEALLOCATE(InputFileData%LDpthAnch) -ENDIF -IF (ALLOCATED(InputFileData%LRadFair)) THEN - DEALLOCATE(InputFileData%LRadFair) -ENDIF -IF (ALLOCATED(InputFileData%LAngFair)) THEN - DEALLOCATE(InputFileData%LAngFair) -ENDIF -IF (ALLOCATED(InputFileData%LDrftFair)) THEN - DEALLOCATE(InputFileData%LDrftFair) -ENDIF -IF (ALLOCATED(InputFileData%LUnstrLen)) THEN - DEALLOCATE(InputFileData%LUnstrLen) -ENDIF -IF (ALLOCATED(InputFileData%Tension)) THEN - DEALLOCATE(InputFileData%Tension) -ENDIF -IF (ALLOCATED(InputFileData%GSL)) THEN - DEALLOCATE(InputFileData%GSL) -ENDIF -IF (ALLOCATED(InputFileData%GSR)) THEN - DEALLOCATE(InputFileData%GSR) -ENDIF -IF (ALLOCATED(InputFileData%GE)) THEN - DEALLOCATE(InputFileData%GE) -ENDIF -IF (ALLOCATED(InputFileData%OutList)) THEN - DEALLOCATE(InputFileData%OutList) -ENDIF - END SUBROUTINE FEAM_DestroyInputFile +subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) + type(FEAM_InputFile), intent(in) :: SrcInputFileData + type(FEAM_InputFile), intent(inout) :: DstInputFileData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FEAM_CopyInputFile' + ErrStat = ErrID_None + ErrMsg = '' + DstInputFileData%DT = SrcInputFileData%DT + if (allocated(SrcInputFileData%LineCI)) then + LB(1:1) = lbound(SrcInputFileData%LineCI) + UB(1:1) = ubound(SrcInputFileData%LineCI) + if (.not. allocated(DstInputFileData%LineCI)) then + allocate(DstInputFileData%LineCI(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LineCI.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%LineCI = SrcInputFileData%LineCI + else if (allocated(DstInputFileData%LineCI)) then + deallocate(DstInputFileData%LineCI) + end if + if (allocated(SrcInputFileData%LineCD)) then + LB(1:1) = lbound(SrcInputFileData%LineCD) + UB(1:1) = ubound(SrcInputFileData%LineCD) + if (.not. allocated(DstInputFileData%LineCD)) then + allocate(DstInputFileData%LineCD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LineCD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%LineCD = SrcInputFileData%LineCD + else if (allocated(DstInputFileData%LineCD)) then + deallocate(DstInputFileData%LineCD) + end if + if (allocated(SrcInputFileData%LEAStiff)) then + LB(1:1) = lbound(SrcInputFileData%LEAStiff) + UB(1:1) = ubound(SrcInputFileData%LEAStiff) + if (.not. allocated(DstInputFileData%LEAStiff)) then + allocate(DstInputFileData%LEAStiff(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LEAStiff.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%LEAStiff = SrcInputFileData%LEAStiff + else if (allocated(DstInputFileData%LEAStiff)) then + deallocate(DstInputFileData%LEAStiff) + end if + if (allocated(SrcInputFileData%LMassDen)) then + LB(1:1) = lbound(SrcInputFileData%LMassDen) + UB(1:1) = ubound(SrcInputFileData%LMassDen) + if (.not. allocated(DstInputFileData%LMassDen)) then + allocate(DstInputFileData%LMassDen(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LMassDen.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%LMassDen = SrcInputFileData%LMassDen + else if (allocated(DstInputFileData%LMassDen)) then + deallocate(DstInputFileData%LMassDen) + end if + if (allocated(SrcInputFileData%LDMassDen)) then + LB(1:1) = lbound(SrcInputFileData%LDMassDen) + UB(1:1) = ubound(SrcInputFileData%LDMassDen) + if (.not. allocated(DstInputFileData%LDMassDen)) then + allocate(DstInputFileData%LDMassDen(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LDMassDen.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%LDMassDen = SrcInputFileData%LDMassDen + else if (allocated(DstInputFileData%LDMassDen)) then + deallocate(DstInputFileData%LDMassDen) + end if + if (allocated(SrcInputFileData%BottmStiff)) then + LB(1:1) = lbound(SrcInputFileData%BottmStiff) + UB(1:1) = ubound(SrcInputFileData%BottmStiff) + if (.not. allocated(DstInputFileData%BottmStiff)) then + allocate(DstInputFileData%BottmStiff(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BottmStiff.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%BottmStiff = SrcInputFileData%BottmStiff + else if (allocated(DstInputFileData%BottmStiff)) then + deallocate(DstInputFileData%BottmStiff) + end if + if (allocated(SrcInputFileData%LRadAnch)) then + LB(1:1) = lbound(SrcInputFileData%LRadAnch) + UB(1:1) = ubound(SrcInputFileData%LRadAnch) + if (.not. allocated(DstInputFileData%LRadAnch)) then + allocate(DstInputFileData%LRadAnch(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LRadAnch.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%LRadAnch = SrcInputFileData%LRadAnch + else if (allocated(DstInputFileData%LRadAnch)) then + deallocate(DstInputFileData%LRadAnch) + end if + if (allocated(SrcInputFileData%LAngAnch)) then + LB(1:1) = lbound(SrcInputFileData%LAngAnch) + UB(1:1) = ubound(SrcInputFileData%LAngAnch) + if (.not. allocated(DstInputFileData%LAngAnch)) then + allocate(DstInputFileData%LAngAnch(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LAngAnch.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%LAngAnch = SrcInputFileData%LAngAnch + else if (allocated(DstInputFileData%LAngAnch)) then + deallocate(DstInputFileData%LAngAnch) + end if + if (allocated(SrcInputFileData%LDpthAnch)) then + LB(1:1) = lbound(SrcInputFileData%LDpthAnch) + UB(1:1) = ubound(SrcInputFileData%LDpthAnch) + if (.not. allocated(DstInputFileData%LDpthAnch)) then + allocate(DstInputFileData%LDpthAnch(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LDpthAnch.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%LDpthAnch = SrcInputFileData%LDpthAnch + else if (allocated(DstInputFileData%LDpthAnch)) then + deallocate(DstInputFileData%LDpthAnch) + end if + if (allocated(SrcInputFileData%LRadFair)) then + LB(1:1) = lbound(SrcInputFileData%LRadFair) + UB(1:1) = ubound(SrcInputFileData%LRadFair) + if (.not. allocated(DstInputFileData%LRadFair)) then + allocate(DstInputFileData%LRadFair(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LRadFair.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%LRadFair = SrcInputFileData%LRadFair + else if (allocated(DstInputFileData%LRadFair)) then + deallocate(DstInputFileData%LRadFair) + end if + if (allocated(SrcInputFileData%LAngFair)) then + LB(1:1) = lbound(SrcInputFileData%LAngFair) + UB(1:1) = ubound(SrcInputFileData%LAngFair) + if (.not. allocated(DstInputFileData%LAngFair)) then + allocate(DstInputFileData%LAngFair(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LAngFair.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%LAngFair = SrcInputFileData%LAngFair + else if (allocated(DstInputFileData%LAngFair)) then + deallocate(DstInputFileData%LAngFair) + end if + if (allocated(SrcInputFileData%LDrftFair)) then + LB(1:1) = lbound(SrcInputFileData%LDrftFair) + UB(1:1) = ubound(SrcInputFileData%LDrftFair) + if (.not. allocated(DstInputFileData%LDrftFair)) then + allocate(DstInputFileData%LDrftFair(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LDrftFair.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%LDrftFair = SrcInputFileData%LDrftFair + else if (allocated(DstInputFileData%LDrftFair)) then + deallocate(DstInputFileData%LDrftFair) + end if + if (allocated(SrcInputFileData%LUnstrLen)) then + LB(1:1) = lbound(SrcInputFileData%LUnstrLen) + UB(1:1) = ubound(SrcInputFileData%LUnstrLen) + if (.not. allocated(DstInputFileData%LUnstrLen)) then + allocate(DstInputFileData%LUnstrLen(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LUnstrLen.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%LUnstrLen = SrcInputFileData%LUnstrLen + else if (allocated(DstInputFileData%LUnstrLen)) then + deallocate(DstInputFileData%LUnstrLen) + end if + if (allocated(SrcInputFileData%Tension)) then + LB(1:1) = lbound(SrcInputFileData%Tension) + UB(1:1) = ubound(SrcInputFileData%Tension) + if (.not. allocated(DstInputFileData%Tension)) then + allocate(DstInputFileData%Tension(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Tension.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%Tension = SrcInputFileData%Tension + else if (allocated(DstInputFileData%Tension)) then + deallocate(DstInputFileData%Tension) + end if + if (allocated(SrcInputFileData%GSL)) then + LB(1:3) = lbound(SrcInputFileData%GSL) + UB(1:3) = ubound(SrcInputFileData%GSL) + if (.not. allocated(DstInputFileData%GSL)) then + allocate(DstInputFileData%GSL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%GSL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%GSL = SrcInputFileData%GSL + else if (allocated(DstInputFileData%GSL)) then + deallocate(DstInputFileData%GSL) + end if + if (allocated(SrcInputFileData%GSR)) then + LB(1:2) = lbound(SrcInputFileData%GSR) + UB(1:2) = ubound(SrcInputFileData%GSR) + if (.not. allocated(DstInputFileData%GSR)) then + allocate(DstInputFileData%GSR(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%GSR.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%GSR = SrcInputFileData%GSR + else if (allocated(DstInputFileData%GSR)) then + deallocate(DstInputFileData%GSR) + end if + if (allocated(SrcInputFileData%GE)) then + LB(1:3) = lbound(SrcInputFileData%GE) + UB(1:3) = ubound(SrcInputFileData%GE) + if (.not. allocated(DstInputFileData%GE)) then + allocate(DstInputFileData%GE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%GE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%GE = SrcInputFileData%GE + else if (allocated(DstInputFileData%GE)) then + deallocate(DstInputFileData%GE) + end if + DstInputFileData%NumLines = SrcInputFileData%NumLines + DstInputFileData%NumElems = SrcInputFileData%NumElems + DstInputFileData%Eps = SrcInputFileData%Eps + DstInputFileData%Gravity = SrcInputFileData%Gravity + DstInputFileData%WtrDens = SrcInputFileData%WtrDens + DstInputFileData%MaxIter = SrcInputFileData%MaxIter + DstInputFileData%SumPrint = SrcInputFileData%SumPrint + DstInputFileData%OutFile = SrcInputFileData%OutFile + DstInputFileData%TabDelim = SrcInputFileData%TabDelim + DstInputFileData%OutFmt = SrcInputFileData%OutFmt + DstInputFileData%Tstart = SrcInputFileData%Tstart + DstInputFileData%NumOuts = SrcInputFileData%NumOuts + if (allocated(SrcInputFileData%OutList)) then + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) + if (.not. allocated(DstInputFileData%OutList)) then + allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%OutList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%OutList = SrcInputFileData%OutList + else if (allocated(DstInputFileData%OutList)) then + deallocate(DstInputFileData%OutList) + end if +end subroutine +subroutine FEAM_DestroyInputFile(InputFileData, ErrStat, ErrMsg) + type(FEAM_InputFile), intent(inout) :: InputFileData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FEAM_DestroyInputFile' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputFileData%LineCI)) then + deallocate(InputFileData%LineCI) + end if + if (allocated(InputFileData%LineCD)) then + deallocate(InputFileData%LineCD) + end if + if (allocated(InputFileData%LEAStiff)) then + deallocate(InputFileData%LEAStiff) + end if + if (allocated(InputFileData%LMassDen)) then + deallocate(InputFileData%LMassDen) + end if + if (allocated(InputFileData%LDMassDen)) then + deallocate(InputFileData%LDMassDen) + end if + if (allocated(InputFileData%BottmStiff)) then + deallocate(InputFileData%BottmStiff) + end if + if (allocated(InputFileData%LRadAnch)) then + deallocate(InputFileData%LRadAnch) + end if + if (allocated(InputFileData%LAngAnch)) then + deallocate(InputFileData%LAngAnch) + end if + if (allocated(InputFileData%LDpthAnch)) then + deallocate(InputFileData%LDpthAnch) + end if + if (allocated(InputFileData%LRadFair)) then + deallocate(InputFileData%LRadFair) + end if + if (allocated(InputFileData%LAngFair)) then + deallocate(InputFileData%LAngFair) + end if + if (allocated(InputFileData%LDrftFair)) then + deallocate(InputFileData%LDrftFair) + end if + if (allocated(InputFileData%LUnstrLen)) then + deallocate(InputFileData%LUnstrLen) + end if + if (allocated(InputFileData%Tension)) then + deallocate(InputFileData%Tension) + end if + if (allocated(InputFileData%GSL)) then + deallocate(InputFileData%GSL) + end if + if (allocated(InputFileData%GSR)) then + deallocate(InputFileData%GSR) + end if + if (allocated(InputFileData%GE)) then + deallocate(InputFileData%GE) + end if + if (allocated(InputFileData%OutList)) then + deallocate(InputFileData%OutList) + end if +end subroutine subroutine FEAM_PackInputFile(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FEAM_InputFile), intent(in) :: InData character(*), parameter :: RoutineName = 'FEAM_PackInputFile' if (Buf%ErrStat >= AbortErrLev) return - ! DT call RegPack(Buf, InData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! LineCI call RegPack(Buf, allocated(InData%LineCI)) if (allocated(InData%LineCI)) then call RegPackBounds(Buf, 1, lbound(InData%LineCI), ubound(InData%LineCI)) call RegPack(Buf, InData%LineCI) end if if (RegCheckErr(Buf, RoutineName)) return - ! LineCD call RegPack(Buf, allocated(InData%LineCD)) if (allocated(InData%LineCD)) then call RegPackBounds(Buf, 1, lbound(InData%LineCD), ubound(InData%LineCD)) call RegPack(Buf, InData%LineCD) end if if (RegCheckErr(Buf, RoutineName)) return - ! LEAStiff call RegPack(Buf, allocated(InData%LEAStiff)) if (allocated(InData%LEAStiff)) then call RegPackBounds(Buf, 1, lbound(InData%LEAStiff), ubound(InData%LEAStiff)) call RegPack(Buf, InData%LEAStiff) end if if (RegCheckErr(Buf, RoutineName)) return - ! LMassDen call RegPack(Buf, allocated(InData%LMassDen)) if (allocated(InData%LMassDen)) then call RegPackBounds(Buf, 1, lbound(InData%LMassDen), ubound(InData%LMassDen)) call RegPack(Buf, InData%LMassDen) end if if (RegCheckErr(Buf, RoutineName)) return - ! LDMassDen call RegPack(Buf, allocated(InData%LDMassDen)) if (allocated(InData%LDMassDen)) then call RegPackBounds(Buf, 1, lbound(InData%LDMassDen), ubound(InData%LDMassDen)) call RegPack(Buf, InData%LDMassDen) end if if (RegCheckErr(Buf, RoutineName)) return - ! BottmStiff call RegPack(Buf, allocated(InData%BottmStiff)) if (allocated(InData%BottmStiff)) then call RegPackBounds(Buf, 1, lbound(InData%BottmStiff), ubound(InData%BottmStiff)) call RegPack(Buf, InData%BottmStiff) end if if (RegCheckErr(Buf, RoutineName)) return - ! LRadAnch call RegPack(Buf, allocated(InData%LRadAnch)) if (allocated(InData%LRadAnch)) then call RegPackBounds(Buf, 1, lbound(InData%LRadAnch), ubound(InData%LRadAnch)) call RegPack(Buf, InData%LRadAnch) end if if (RegCheckErr(Buf, RoutineName)) return - ! LAngAnch call RegPack(Buf, allocated(InData%LAngAnch)) if (allocated(InData%LAngAnch)) then call RegPackBounds(Buf, 1, lbound(InData%LAngAnch), ubound(InData%LAngAnch)) call RegPack(Buf, InData%LAngAnch) end if if (RegCheckErr(Buf, RoutineName)) return - ! LDpthAnch call RegPack(Buf, allocated(InData%LDpthAnch)) if (allocated(InData%LDpthAnch)) then call RegPackBounds(Buf, 1, lbound(InData%LDpthAnch), ubound(InData%LDpthAnch)) call RegPack(Buf, InData%LDpthAnch) end if if (RegCheckErr(Buf, RoutineName)) return - ! LRadFair call RegPack(Buf, allocated(InData%LRadFair)) if (allocated(InData%LRadFair)) then call RegPackBounds(Buf, 1, lbound(InData%LRadFair), ubound(InData%LRadFair)) call RegPack(Buf, InData%LRadFair) end if if (RegCheckErr(Buf, RoutineName)) return - ! LAngFair call RegPack(Buf, allocated(InData%LAngFair)) if (allocated(InData%LAngFair)) then call RegPackBounds(Buf, 1, lbound(InData%LAngFair), ubound(InData%LAngFair)) call RegPack(Buf, InData%LAngFair) end if if (RegCheckErr(Buf, RoutineName)) return - ! LDrftFair call RegPack(Buf, allocated(InData%LDrftFair)) if (allocated(InData%LDrftFair)) then call RegPackBounds(Buf, 1, lbound(InData%LDrftFair), ubound(InData%LDrftFair)) call RegPack(Buf, InData%LDrftFair) end if if (RegCheckErr(Buf, RoutineName)) return - ! LUnstrLen call RegPack(Buf, allocated(InData%LUnstrLen)) if (allocated(InData%LUnstrLen)) then call RegPackBounds(Buf, 1, lbound(InData%LUnstrLen), ubound(InData%LUnstrLen)) call RegPack(Buf, InData%LUnstrLen) end if if (RegCheckErr(Buf, RoutineName)) return - ! Tension call RegPack(Buf, allocated(InData%Tension)) if (allocated(InData%Tension)) then call RegPackBounds(Buf, 1, lbound(InData%Tension), ubound(InData%Tension)) call RegPack(Buf, InData%Tension) end if if (RegCheckErr(Buf, RoutineName)) return - ! GSL call RegPack(Buf, allocated(InData%GSL)) if (allocated(InData%GSL)) then call RegPackBounds(Buf, 3, lbound(InData%GSL), ubound(InData%GSL)) call RegPack(Buf, InData%GSL) end if if (RegCheckErr(Buf, RoutineName)) return - ! GSR call RegPack(Buf, allocated(InData%GSR)) if (allocated(InData%GSR)) then call RegPackBounds(Buf, 2, lbound(InData%GSR), ubound(InData%GSR)) call RegPack(Buf, InData%GSR) end if if (RegCheckErr(Buf, RoutineName)) return - ! GE call RegPack(Buf, allocated(InData%GE)) if (allocated(InData%GE)) then call RegPackBounds(Buf, 3, lbound(InData%GE), ubound(InData%GE)) call RegPack(Buf, InData%GE) end if if (RegCheckErr(Buf, RoutineName)) return - ! NumLines call RegPack(Buf, InData%NumLines) if (RegCheckErr(Buf, RoutineName)) return - ! NumElems call RegPack(Buf, InData%NumElems) if (RegCheckErr(Buf, RoutineName)) return - ! Eps call RegPack(Buf, InData%Eps) if (RegCheckErr(Buf, RoutineName)) return - ! Gravity call RegPack(Buf, InData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDens call RegPack(Buf, InData%WtrDens) if (RegCheckErr(Buf, RoutineName)) return - ! MaxIter call RegPack(Buf, InData%MaxIter) if (RegCheckErr(Buf, RoutineName)) return - ! SumPrint call RegPack(Buf, InData%SumPrint) if (RegCheckErr(Buf, RoutineName)) return - ! OutFile call RegPack(Buf, InData%OutFile) if (RegCheckErr(Buf, RoutineName)) return - ! TabDelim call RegPack(Buf, InData%TabDelim) if (RegCheckErr(Buf, RoutineName)) return - ! OutFmt call RegPack(Buf, InData%OutFmt) if (RegCheckErr(Buf, RoutineName)) return - ! Tstart call RegPack(Buf, InData%Tstart) if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegPack(Buf, InData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! OutList call RegPack(Buf, allocated(InData%OutList)) if (allocated(InData%OutList)) then call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) @@ -732,10 +715,8 @@ subroutine FEAM_UnPackInputFile(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! DT call RegUnpack(Buf, OutData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! LineCI if (allocated(OutData%LineCI)) deallocate(OutData%LineCI) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -750,7 +731,6 @@ subroutine FEAM_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%LineCI) if (RegCheckErr(Buf, RoutineName)) return end if - ! LineCD if (allocated(OutData%LineCD)) deallocate(OutData%LineCD) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -765,7 +745,6 @@ subroutine FEAM_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%LineCD) if (RegCheckErr(Buf, RoutineName)) return end if - ! LEAStiff if (allocated(OutData%LEAStiff)) deallocate(OutData%LEAStiff) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -780,7 +759,6 @@ subroutine FEAM_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%LEAStiff) if (RegCheckErr(Buf, RoutineName)) return end if - ! LMassDen if (allocated(OutData%LMassDen)) deallocate(OutData%LMassDen) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -795,7 +773,6 @@ subroutine FEAM_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%LMassDen) if (RegCheckErr(Buf, RoutineName)) return end if - ! LDMassDen if (allocated(OutData%LDMassDen)) deallocate(OutData%LDMassDen) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -810,7 +787,6 @@ subroutine FEAM_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%LDMassDen) if (RegCheckErr(Buf, RoutineName)) return end if - ! BottmStiff if (allocated(OutData%BottmStiff)) deallocate(OutData%BottmStiff) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -825,7 +801,6 @@ subroutine FEAM_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%BottmStiff) if (RegCheckErr(Buf, RoutineName)) return end if - ! LRadAnch if (allocated(OutData%LRadAnch)) deallocate(OutData%LRadAnch) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -840,7 +815,6 @@ subroutine FEAM_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%LRadAnch) if (RegCheckErr(Buf, RoutineName)) return end if - ! LAngAnch if (allocated(OutData%LAngAnch)) deallocate(OutData%LAngAnch) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -855,7 +829,6 @@ subroutine FEAM_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%LAngAnch) if (RegCheckErr(Buf, RoutineName)) return end if - ! LDpthAnch if (allocated(OutData%LDpthAnch)) deallocate(OutData%LDpthAnch) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -870,7 +843,6 @@ subroutine FEAM_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%LDpthAnch) if (RegCheckErr(Buf, RoutineName)) return end if - ! LRadFair if (allocated(OutData%LRadFair)) deallocate(OutData%LRadFair) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -885,7 +857,6 @@ subroutine FEAM_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%LRadFair) if (RegCheckErr(Buf, RoutineName)) return end if - ! LAngFair if (allocated(OutData%LAngFair)) deallocate(OutData%LAngFair) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -900,7 +871,6 @@ subroutine FEAM_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%LAngFair) if (RegCheckErr(Buf, RoutineName)) return end if - ! LDrftFair if (allocated(OutData%LDrftFair)) deallocate(OutData%LDrftFair) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -915,7 +885,6 @@ subroutine FEAM_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%LDrftFair) if (RegCheckErr(Buf, RoutineName)) return end if - ! LUnstrLen if (allocated(OutData%LUnstrLen)) deallocate(OutData%LUnstrLen) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -930,7 +899,6 @@ subroutine FEAM_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%LUnstrLen) if (RegCheckErr(Buf, RoutineName)) return end if - ! Tension if (allocated(OutData%Tension)) deallocate(OutData%Tension) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -945,7 +913,6 @@ subroutine FEAM_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%Tension) if (RegCheckErr(Buf, RoutineName)) return end if - ! GSL if (allocated(OutData%GSL)) deallocate(OutData%GSL) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -960,7 +927,6 @@ subroutine FEAM_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%GSL) if (RegCheckErr(Buf, RoutineName)) return end if - ! GSR if (allocated(OutData%GSR)) deallocate(OutData%GSR) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -975,7 +941,6 @@ subroutine FEAM_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%GSR) if (RegCheckErr(Buf, RoutineName)) return end if - ! GE if (allocated(OutData%GE)) deallocate(OutData%GE) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -990,43 +955,30 @@ subroutine FEAM_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%GE) if (RegCheckErr(Buf, RoutineName)) return end if - ! NumLines call RegUnpack(Buf, OutData%NumLines) if (RegCheckErr(Buf, RoutineName)) return - ! NumElems call RegUnpack(Buf, OutData%NumElems) if (RegCheckErr(Buf, RoutineName)) return - ! Eps call RegUnpack(Buf, OutData%Eps) if (RegCheckErr(Buf, RoutineName)) return - ! Gravity call RegUnpack(Buf, OutData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDens call RegUnpack(Buf, OutData%WtrDens) if (RegCheckErr(Buf, RoutineName)) return - ! MaxIter call RegUnpack(Buf, OutData%MaxIter) if (RegCheckErr(Buf, RoutineName)) return - ! SumPrint call RegUnpack(Buf, OutData%SumPrint) if (RegCheckErr(Buf, RoutineName)) return - ! OutFile call RegUnpack(Buf, OutData%OutFile) if (RegCheckErr(Buf, RoutineName)) return - ! TabDelim call RegUnpack(Buf, OutData%TabDelim) if (RegCheckErr(Buf, RoutineName)) return - ! OutFmt call RegUnpack(Buf, OutData%OutFmt) if (RegCheckErr(Buf, RoutineName)) return - ! Tstart call RegUnpack(Buf, OutData%Tstart) if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegUnpack(Buf, OutData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! OutList if (allocated(OutData%OutList)) deallocate(OutData%OutList) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1042,142 +994,119 @@ subroutine FEAM_UnPackInputFile(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE FEAM_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FEAM_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(FEAM_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFile = SrcInitInputData%InputFile - DstInitInputData%RootName = SrcInitInputData%RootName - DstInitInputData%PtfmInit = SrcInitInputData%PtfmInit - DstInitInputData%NStepWave = SrcInitInputData%NStepWave -IF (ALLOCATED(SrcInitInputData%WaveAcc0)) THEN - i1_l = LBOUND(SrcInitInputData%WaveAcc0,1) - i1_u = UBOUND(SrcInitInputData%WaveAcc0,1) - i2_l = LBOUND(SrcInitInputData%WaveAcc0,2) - i2_u = UBOUND(SrcInitInputData%WaveAcc0,2) - i3_l = LBOUND(SrcInitInputData%WaveAcc0,3) - i3_u = UBOUND(SrcInitInputData%WaveAcc0,3) - IF (.NOT. ALLOCATED(DstInitInputData%WaveAcc0)) THEN - ALLOCATE(DstInitInputData%WaveAcc0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveAcc0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveAcc0 = SrcInitInputData%WaveAcc0 -ENDIF -IF (ALLOCATED(SrcInitInputData%WaveTime)) THEN - i1_l = LBOUND(SrcInitInputData%WaveTime,1) - i1_u = UBOUND(SrcInitInputData%WaveTime,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveTime)) THEN - ALLOCATE(DstInitInputData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveTime = SrcInitInputData%WaveTime -ENDIF -IF (ALLOCATED(SrcInitInputData%WaveVel0)) THEN - i1_l = LBOUND(SrcInitInputData%WaveVel0,1) - i1_u = UBOUND(SrcInitInputData%WaveVel0,1) - i2_l = LBOUND(SrcInitInputData%WaveVel0,2) - i2_u = UBOUND(SrcInitInputData%WaveVel0,2) - i3_l = LBOUND(SrcInitInputData%WaveVel0,3) - i3_u = UBOUND(SrcInitInputData%WaveVel0,3) - IF (.NOT. ALLOCATED(DstInitInputData%WaveVel0)) THEN - ALLOCATE(DstInitInputData%WaveVel0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveVel0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveVel0 = SrcInitInputData%WaveVel0 -ENDIF - DstInitInputData%Gravity = SrcInitInputData%Gravity - DstInitInputData%WtrDens = SrcInitInputData%WtrDens - END SUBROUTINE FEAM_CopyInitInput - - SUBROUTINE FEAM_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(FEAM_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_DestroyInitInput' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitInputData%WaveAcc0)) THEN - DEALLOCATE(InitInputData%WaveAcc0) -ENDIF -IF (ALLOCATED(InitInputData%WaveTime)) THEN - DEALLOCATE(InitInputData%WaveTime) -ENDIF -IF (ALLOCATED(InitInputData%WaveVel0)) THEN - DEALLOCATE(InitInputData%WaveVel0) -ENDIF - END SUBROUTINE FEAM_DestroyInitInput +subroutine FEAM_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(FEAM_InitInputType), intent(in) :: SrcInitInputData + type(FEAM_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FEAM_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%RootName = SrcInitInputData%RootName + DstInitInputData%PtfmInit = SrcInitInputData%PtfmInit + DstInitInputData%NStepWave = SrcInitInputData%NStepWave + if (allocated(SrcInitInputData%WaveAcc0)) then + LB(1:3) = lbound(SrcInitInputData%WaveAcc0) + UB(1:3) = ubound(SrcInitInputData%WaveAcc0) + if (.not. allocated(DstInitInputData%WaveAcc0)) then + allocate(DstInitInputData%WaveAcc0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveAcc0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%WaveAcc0 = SrcInitInputData%WaveAcc0 + else if (allocated(DstInitInputData%WaveAcc0)) then + deallocate(DstInitInputData%WaveAcc0) + end if + if (allocated(SrcInitInputData%WaveTime)) then + LB(1:1) = lbound(SrcInitInputData%WaveTime) + UB(1:1) = ubound(SrcInitInputData%WaveTime) + if (.not. allocated(DstInitInputData%WaveTime)) then + allocate(DstInitInputData%WaveTime(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveTime.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%WaveTime = SrcInitInputData%WaveTime + else if (allocated(DstInitInputData%WaveTime)) then + deallocate(DstInitInputData%WaveTime) + end if + if (allocated(SrcInitInputData%WaveVel0)) then + LB(1:3) = lbound(SrcInitInputData%WaveVel0) + UB(1:3) = ubound(SrcInitInputData%WaveVel0) + if (.not. allocated(DstInitInputData%WaveVel0)) then + allocate(DstInitInputData%WaveVel0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveVel0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%WaveVel0 = SrcInitInputData%WaveVel0 + else if (allocated(DstInitInputData%WaveVel0)) then + deallocate(DstInitInputData%WaveVel0) + end if + DstInitInputData%Gravity = SrcInitInputData%Gravity + DstInitInputData%WtrDens = SrcInitInputData%WtrDens +end subroutine +subroutine FEAM_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(FEAM_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FEAM_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitInputData%WaveAcc0)) then + deallocate(InitInputData%WaveAcc0) + end if + if (allocated(InitInputData%WaveTime)) then + deallocate(InitInputData%WaveTime) + end if + if (allocated(InitInputData%WaveVel0)) then + deallocate(InitInputData%WaveVel0) + end if +end subroutine subroutine FEAM_PackInitInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FEAM_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'FEAM_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return - ! InputFile call RegPack(Buf, InData%InputFile) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegPack(Buf, InData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmInit call RegPack(Buf, InData%PtfmInit) if (RegCheckErr(Buf, RoutineName)) return - ! NStepWave call RegPack(Buf, InData%NStepWave) if (RegCheckErr(Buf, RoutineName)) return - ! WaveAcc0 call RegPack(Buf, allocated(InData%WaveAcc0)) if (allocated(InData%WaveAcc0)) then call RegPackBounds(Buf, 3, lbound(InData%WaveAcc0), ubound(InData%WaveAcc0)) call RegPack(Buf, InData%WaveAcc0) end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveTime call RegPack(Buf, allocated(InData%WaveTime)) if (allocated(InData%WaveTime)) then call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) call RegPack(Buf, InData%WaveTime) end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveVel0 call RegPack(Buf, allocated(InData%WaveVel0)) if (allocated(InData%WaveVel0)) then call RegPackBounds(Buf, 3, lbound(InData%WaveVel0), ubound(InData%WaveVel0)) call RegPack(Buf, InData%WaveVel0) end if if (RegCheckErr(Buf, RoutineName)) return - ! Gravity call RegPack(Buf, InData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDens call RegPack(Buf, InData%WtrDens) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1190,19 +1119,14 @@ subroutine FEAM_UnPackInitInput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! InputFile call RegUnpack(Buf, OutData%InputFile) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegUnpack(Buf, OutData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmInit call RegUnpack(Buf, OutData%PtfmInit) if (RegCheckErr(Buf, RoutineName)) return - ! NStepWave call RegUnpack(Buf, OutData%NStepWave) if (RegCheckErr(Buf, RoutineName)) return - ! WaveAcc0 if (allocated(OutData%WaveAcc0)) deallocate(OutData%WaveAcc0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1217,7 +1141,6 @@ subroutine FEAM_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%WaveAcc0) if (RegCheckErr(Buf, RoutineName)) return end if - ! WaveTime if (allocated(OutData%WaveTime)) deallocate(OutData%WaveTime) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1232,7 +1155,6 @@ subroutine FEAM_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%WaveTime) if (RegCheckErr(Buf, RoutineName)) return end if - ! WaveVel0 if (allocated(OutData%WaveVel0)) deallocate(OutData%WaveVel0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1247,229 +1169,225 @@ subroutine FEAM_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%WaveVel0) if (RegCheckErr(Buf, RoutineName)) return end if - ! Gravity call RegUnpack(Buf, OutData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDens call RegUnpack(Buf, OutData%WtrDens) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE FEAM_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FEAM_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(FEAM_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_CopyInitOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInitOutputData%WriteOutputHdr)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputHdr,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputHdr,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputHdr)) THEN - ALLOCATE(DstInitOutputData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr -ENDIF -IF (ALLOCATED(SrcInitOutputData%WriteOutputUnt)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputUnt,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputUnt,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputUnt)) THEN - ALLOCATE(DstInitOutputData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt -ENDIF - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInitOutputData%LAnchxi)) THEN - i1_l = LBOUND(SrcInitOutputData%LAnchxi,1) - i1_u = UBOUND(SrcInitOutputData%LAnchxi,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LAnchxi)) THEN - ALLOCATE(DstInitOutputData%LAnchxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LAnchxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LAnchxi = SrcInitOutputData%LAnchxi -ENDIF -IF (ALLOCATED(SrcInitOutputData%LAnchyi)) THEN - i1_l = LBOUND(SrcInitOutputData%LAnchyi,1) - i1_u = UBOUND(SrcInitOutputData%LAnchyi,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LAnchyi)) THEN - ALLOCATE(DstInitOutputData%LAnchyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LAnchyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LAnchyi = SrcInitOutputData%LAnchyi -ENDIF -IF (ALLOCATED(SrcInitOutputData%LAnchzi)) THEN - i1_l = LBOUND(SrcInitOutputData%LAnchzi,1) - i1_u = UBOUND(SrcInitOutputData%LAnchzi,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LAnchzi)) THEN - ALLOCATE(DstInitOutputData%LAnchzi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LAnchzi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LAnchzi = SrcInitOutputData%LAnchzi -ENDIF -IF (ALLOCATED(SrcInitOutputData%LFairxt)) THEN - i1_l = LBOUND(SrcInitOutputData%LFairxt,1) - i1_u = UBOUND(SrcInitOutputData%LFairxt,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LFairxt)) THEN - ALLOCATE(DstInitOutputData%LFairxt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LFairxt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LFairxt = SrcInitOutputData%LFairxt -ENDIF -IF (ALLOCATED(SrcInitOutputData%LFairyt)) THEN - i1_l = LBOUND(SrcInitOutputData%LFairyt,1) - i1_u = UBOUND(SrcInitOutputData%LFairyt,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LFairyt)) THEN - ALLOCATE(DstInitOutputData%LFairyt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LFairyt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LFairyt = SrcInitOutputData%LFairyt -ENDIF -IF (ALLOCATED(SrcInitOutputData%LFairzt)) THEN - i1_l = LBOUND(SrcInitOutputData%LFairzt,1) - i1_u = UBOUND(SrcInitOutputData%LFairzt,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LFairzt)) THEN - ALLOCATE(DstInitOutputData%LFairzt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LFairzt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LFairzt = SrcInitOutputData%LFairzt -ENDIF - END SUBROUTINE FEAM_CopyInitOutput - - SUBROUTINE FEAM_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(FEAM_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF - CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitOutputData%LAnchxi)) THEN - DEALLOCATE(InitOutputData%LAnchxi) -ENDIF -IF (ALLOCATED(InitOutputData%LAnchyi)) THEN - DEALLOCATE(InitOutputData%LAnchyi) -ENDIF -IF (ALLOCATED(InitOutputData%LAnchzi)) THEN - DEALLOCATE(InitOutputData%LAnchzi) -ENDIF -IF (ALLOCATED(InitOutputData%LFairxt)) THEN - DEALLOCATE(InitOutputData%LFairxt) -ENDIF -IF (ALLOCATED(InitOutputData%LFairyt)) THEN - DEALLOCATE(InitOutputData%LFairyt) -ENDIF -IF (ALLOCATED(InitOutputData%LFairzt)) THEN - DEALLOCATE(InitOutputData%LFairzt) -ENDIF - END SUBROUTINE FEAM_DestroyInitOutput +subroutine FEAM_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(FEAM_InitOutputType), intent(in) :: SrcInitOutputData + type(FEAM_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FEAM_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr + else if (allocated(DstInitOutputData%WriteOutputHdr)) then + deallocate(DstInitOutputData%WriteOutputHdr) + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt + else if (allocated(DstInitOutputData%WriteOutputUnt)) then + deallocate(DstInitOutputData%WriteOutputUnt) + end if + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInitOutputData%LAnchxi)) then + LB(1:1) = lbound(SrcInitOutputData%LAnchxi) + UB(1:1) = ubound(SrcInitOutputData%LAnchxi) + if (.not. allocated(DstInitOutputData%LAnchxi)) then + allocate(DstInitOutputData%LAnchxi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LAnchxi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LAnchxi = SrcInitOutputData%LAnchxi + else if (allocated(DstInitOutputData%LAnchxi)) then + deallocate(DstInitOutputData%LAnchxi) + end if + if (allocated(SrcInitOutputData%LAnchyi)) then + LB(1:1) = lbound(SrcInitOutputData%LAnchyi) + UB(1:1) = ubound(SrcInitOutputData%LAnchyi) + if (.not. allocated(DstInitOutputData%LAnchyi)) then + allocate(DstInitOutputData%LAnchyi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LAnchyi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LAnchyi = SrcInitOutputData%LAnchyi + else if (allocated(DstInitOutputData%LAnchyi)) then + deallocate(DstInitOutputData%LAnchyi) + end if + if (allocated(SrcInitOutputData%LAnchzi)) then + LB(1:1) = lbound(SrcInitOutputData%LAnchzi) + UB(1:1) = ubound(SrcInitOutputData%LAnchzi) + if (.not. allocated(DstInitOutputData%LAnchzi)) then + allocate(DstInitOutputData%LAnchzi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LAnchzi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LAnchzi = SrcInitOutputData%LAnchzi + else if (allocated(DstInitOutputData%LAnchzi)) then + deallocate(DstInitOutputData%LAnchzi) + end if + if (allocated(SrcInitOutputData%LFairxt)) then + LB(1:1) = lbound(SrcInitOutputData%LFairxt) + UB(1:1) = ubound(SrcInitOutputData%LFairxt) + if (.not. allocated(DstInitOutputData%LFairxt)) then + allocate(DstInitOutputData%LFairxt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LFairxt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LFairxt = SrcInitOutputData%LFairxt + else if (allocated(DstInitOutputData%LFairxt)) then + deallocate(DstInitOutputData%LFairxt) + end if + if (allocated(SrcInitOutputData%LFairyt)) then + LB(1:1) = lbound(SrcInitOutputData%LFairyt) + UB(1:1) = ubound(SrcInitOutputData%LFairyt) + if (.not. allocated(DstInitOutputData%LFairyt)) then + allocate(DstInitOutputData%LFairyt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LFairyt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LFairyt = SrcInitOutputData%LFairyt + else if (allocated(DstInitOutputData%LFairyt)) then + deallocate(DstInitOutputData%LFairyt) + end if + if (allocated(SrcInitOutputData%LFairzt)) then + LB(1:1) = lbound(SrcInitOutputData%LFairzt) + UB(1:1) = ubound(SrcInitOutputData%LFairzt) + if (.not. allocated(DstInitOutputData%LFairzt)) then + allocate(DstInitOutputData%LFairzt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LFairzt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LFairzt = SrcInitOutputData%LFairzt + else if (allocated(DstInitOutputData%LFairzt)) then + deallocate(DstInitOutputData%LFairzt) + end if +end subroutine +subroutine FEAM_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(FEAM_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FEAM_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if + if (allocated(InitOutputData%LAnchxi)) then + deallocate(InitOutputData%LAnchxi) + end if + if (allocated(InitOutputData%LAnchyi)) then + deallocate(InitOutputData%LAnchyi) + end if + if (allocated(InitOutputData%LAnchzi)) then + deallocate(InitOutputData%LAnchzi) + end if + if (allocated(InitOutputData%LFairxt)) then + deallocate(InitOutputData%LFairxt) + end if + if (allocated(InitOutputData%LFairyt)) then + deallocate(InitOutputData%LFairyt) + end if + if (allocated(InitOutputData%LFairzt)) then + deallocate(InitOutputData%LFairzt) + end if +end subroutine subroutine FEAM_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FEAM_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'FEAM_PackInitOutput' if (Buf%ErrStat >= AbortErrLev) return - ! WriteOutputHdr call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) call RegPack(Buf, InData%WriteOutputHdr) end if if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutputUnt call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) call RegPack(Buf, InData%WriteOutputUnt) end if if (RegCheckErr(Buf, RoutineName)) return - ! Ver call NWTC_Library_PackProgDesc(Buf, InData%Ver) if (RegCheckErr(Buf, RoutineName)) return - ! LAnchxi call RegPack(Buf, allocated(InData%LAnchxi)) if (allocated(InData%LAnchxi)) then call RegPackBounds(Buf, 1, lbound(InData%LAnchxi), ubound(InData%LAnchxi)) call RegPack(Buf, InData%LAnchxi) end if if (RegCheckErr(Buf, RoutineName)) return - ! LAnchyi call RegPack(Buf, allocated(InData%LAnchyi)) if (allocated(InData%LAnchyi)) then call RegPackBounds(Buf, 1, lbound(InData%LAnchyi), ubound(InData%LAnchyi)) call RegPack(Buf, InData%LAnchyi) end if if (RegCheckErr(Buf, RoutineName)) return - ! LAnchzi call RegPack(Buf, allocated(InData%LAnchzi)) if (allocated(InData%LAnchzi)) then call RegPackBounds(Buf, 1, lbound(InData%LAnchzi), ubound(InData%LAnchzi)) call RegPack(Buf, InData%LAnchzi) end if if (RegCheckErr(Buf, RoutineName)) return - ! LFairxt call RegPack(Buf, allocated(InData%LFairxt)) if (allocated(InData%LFairxt)) then call RegPackBounds(Buf, 1, lbound(InData%LFairxt), ubound(InData%LFairxt)) call RegPack(Buf, InData%LFairxt) end if if (RegCheckErr(Buf, RoutineName)) return - ! LFairyt call RegPack(Buf, allocated(InData%LFairyt)) if (allocated(InData%LFairyt)) then call RegPackBounds(Buf, 1, lbound(InData%LFairyt), ubound(InData%LFairyt)) call RegPack(Buf, InData%LFairyt) end if if (RegCheckErr(Buf, RoutineName)) return - ! LFairzt call RegPack(Buf, allocated(InData%LFairzt)) if (allocated(InData%LFairzt)) then call RegPackBounds(Buf, 1, lbound(InData%LFairzt), ubound(InData%LFairzt)) @@ -1486,7 +1404,6 @@ subroutine FEAM_UnPackInitOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! WriteOutputHdr if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1501,7 +1418,6 @@ subroutine FEAM_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutputHdr) if (RegCheckErr(Buf, RoutineName)) return end if - ! WriteOutputUnt if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1516,9 +1432,7 @@ subroutine FEAM_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutputUnt) if (RegCheckErr(Buf, RoutineName)) return end if - ! Ver call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver - ! LAnchxi if (allocated(OutData%LAnchxi)) deallocate(OutData%LAnchxi) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1533,7 +1447,6 @@ subroutine FEAM_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%LAnchxi) if (RegCheckErr(Buf, RoutineName)) return end if - ! LAnchyi if (allocated(OutData%LAnchyi)) deallocate(OutData%LAnchyi) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1548,7 +1461,6 @@ subroutine FEAM_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%LAnchyi) if (RegCheckErr(Buf, RoutineName)) return end if - ! LAnchzi if (allocated(OutData%LAnchzi)) deallocate(OutData%LAnchzi) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1563,7 +1475,6 @@ subroutine FEAM_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%LAnchzi) if (RegCheckErr(Buf, RoutineName)) return end if - ! LFairxt if (allocated(OutData%LFairxt)) deallocate(OutData%LFairxt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1578,7 +1489,6 @@ subroutine FEAM_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%LFairxt) if (RegCheckErr(Buf, RoutineName)) return end if - ! LFairyt if (allocated(OutData%LFairyt)) deallocate(OutData%LFairyt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1593,7 +1503,6 @@ subroutine FEAM_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%LFairyt) if (RegCheckErr(Buf, RoutineName)) return end if - ! LFairzt if (allocated(OutData%LFairzt)) deallocate(OutData%LFairzt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1609,87 +1518,74 @@ subroutine FEAM_UnPackInitOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE FEAM_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FEAM_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(FEAM_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcContStateData%GLU)) THEN - i1_l = LBOUND(SrcContStateData%GLU,1) - i1_u = UBOUND(SrcContStateData%GLU,1) - i2_l = LBOUND(SrcContStateData%GLU,2) - i2_u = UBOUND(SrcContStateData%GLU,2) - IF (.NOT. ALLOCATED(DstContStateData%GLU)) THEN - ALLOCATE(DstContStateData%GLU(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%GLU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstContStateData%GLU = SrcContStateData%GLU -ENDIF -IF (ALLOCATED(SrcContStateData%GLDU)) THEN - i1_l = LBOUND(SrcContStateData%GLDU,1) - i1_u = UBOUND(SrcContStateData%GLDU,1) - i2_l = LBOUND(SrcContStateData%GLDU,2) - i2_u = UBOUND(SrcContStateData%GLDU,2) - IF (.NOT. ALLOCATED(DstContStateData%GLDU)) THEN - ALLOCATE(DstContStateData%GLDU(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%GLDU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstContStateData%GLDU = SrcContStateData%GLDU -ENDIF - END SUBROUTINE FEAM_CopyContState - - SUBROUTINE FEAM_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(FEAM_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_DestroyContState' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ContStateData%GLU)) THEN - DEALLOCATE(ContStateData%GLU) -ENDIF -IF (ALLOCATED(ContStateData%GLDU)) THEN - DEALLOCATE(ContStateData%GLDU) -ENDIF - END SUBROUTINE FEAM_DestroyContState +subroutine FEAM_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(FEAM_ContinuousStateType), intent(in) :: SrcContStateData + type(FEAM_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FEAM_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcContStateData%GLU)) then + LB(1:2) = lbound(SrcContStateData%GLU) + UB(1:2) = ubound(SrcContStateData%GLU) + if (.not. allocated(DstContStateData%GLU)) then + allocate(DstContStateData%GLU(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%GLU.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstContStateData%GLU = SrcContStateData%GLU + else if (allocated(DstContStateData%GLU)) then + deallocate(DstContStateData%GLU) + end if + if (allocated(SrcContStateData%GLDU)) then + LB(1:2) = lbound(SrcContStateData%GLDU) + UB(1:2) = ubound(SrcContStateData%GLDU) + if (.not. allocated(DstContStateData%GLDU)) then + allocate(DstContStateData%GLDU(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%GLDU.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstContStateData%GLDU = SrcContStateData%GLDU + else if (allocated(DstContStateData%GLDU)) then + deallocate(DstContStateData%GLDU) + end if +end subroutine +subroutine FEAM_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(FEAM_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FEAM_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ContStateData%GLU)) then + deallocate(ContStateData%GLU) + end if + if (allocated(ContStateData%GLDU)) then + deallocate(ContStateData%GLDU) + end if +end subroutine subroutine FEAM_PackContState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FEAM_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'FEAM_PackContState' if (Buf%ErrStat >= AbortErrLev) return - ! GLU call RegPack(Buf, allocated(InData%GLU)) if (allocated(InData%GLU)) then call RegPackBounds(Buf, 2, lbound(InData%GLU), ubound(InData%GLU)) call RegPack(Buf, InData%GLU) end if if (RegCheckErr(Buf, RoutineName)) return - ! GLDU call RegPack(Buf, allocated(InData%GLDU)) if (allocated(InData%GLDU)) then call RegPackBounds(Buf, 2, lbound(InData%GLDU), ubound(InData%GLDU)) @@ -1706,7 +1602,6 @@ subroutine FEAM_UnPackContState(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! GLU if (allocated(OutData%GLU)) deallocate(OutData%GLU) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1721,7 +1616,6 @@ subroutine FEAM_UnPackContState(Buf, OutData) call RegUnpack(Buf, OutData%GLU) if (RegCheckErr(Buf, RoutineName)) return end if - ! GLDU if (allocated(OutData%GLDU)) deallocate(OutData%GLDU) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1737,45 +1631,33 @@ subroutine FEAM_UnPackContState(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE FEAM_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FEAM_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(FEAM_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState - END SUBROUTINE FEAM_CopyDiscState - - SUBROUTINE FEAM_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(FEAM_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_DestroyDiscState' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE FEAM_DestroyDiscState +subroutine FEAM_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(FEAM_DiscreteStateType), intent(in) :: SrcDiscStateData + type(FEAM_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FEAM_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState +end subroutine +subroutine FEAM_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(FEAM_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FEAM_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine FEAM_PackDiscState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FEAM_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'FEAM_PackDiscState' if (Buf%ErrStat >= AbortErrLev) return - ! DummyDiscState call RegPack(Buf, InData%DummyDiscState) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1785,54 +1667,39 @@ subroutine FEAM_UnPackDiscState(Buf, OutData) type(FEAM_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FEAM_UnPackDiscState' if (Buf%ErrStat /= ErrID_None) return - ! DummyDiscState call RegUnpack(Buf, OutData%DummyDiscState) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE FEAM_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FEAM_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(FEAM_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%TSN = SrcConstrStateData%TSN - DstConstrStateData%TZER = SrcConstrStateData%TZER - END SUBROUTINE FEAM_CopyConstrState - - SUBROUTINE FEAM_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(FEAM_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE FEAM_DestroyConstrState +subroutine FEAM_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(FEAM_ConstraintStateType), intent(in) :: SrcConstrStateData + type(FEAM_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FEAM_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%TSN = SrcConstrStateData%TSN + DstConstrStateData%TZER = SrcConstrStateData%TZER +end subroutine +subroutine FEAM_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(FEAM_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FEAM_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine FEAM_PackConstrState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FEAM_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'FEAM_PackConstrState' if (Buf%ErrStat >= AbortErrLev) return - ! TSN call RegPack(Buf, InData%TSN) if (RegCheckErr(Buf, RoutineName)) return - ! TZER call RegPack(Buf, InData%TZER) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1842,222 +1709,190 @@ subroutine FEAM_UnPackConstrState(Buf, OutData) type(FEAM_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FEAM_UnPackConstrState' if (Buf%ErrStat /= ErrID_None) return - ! TSN call RegUnpack(Buf, OutData%TSN) if (RegCheckErr(Buf, RoutineName)) return - ! TZER call RegUnpack(Buf, OutData%TZER) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE FEAM_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FEAM_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(FEAM_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOtherStateData%GLU0)) THEN - i1_l = LBOUND(SrcOtherStateData%GLU0,1) - i1_u = UBOUND(SrcOtherStateData%GLU0,1) - i2_l = LBOUND(SrcOtherStateData%GLU0,2) - i2_u = UBOUND(SrcOtherStateData%GLU0,2) - IF (.NOT. ALLOCATED(DstOtherStateData%GLU0)) THEN - ALLOCATE(DstOtherStateData%GLU0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%GLU0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%GLU0 = SrcOtherStateData%GLU0 -ENDIF -IF (ALLOCATED(SrcOtherStateData%GLDDU)) THEN - i1_l = LBOUND(SrcOtherStateData%GLDDU,1) - i1_u = UBOUND(SrcOtherStateData%GLDDU,1) - i2_l = LBOUND(SrcOtherStateData%GLDDU,2) - i2_u = UBOUND(SrcOtherStateData%GLDDU,2) - IF (.NOT. ALLOCATED(DstOtherStateData%GLDDU)) THEN - ALLOCATE(DstOtherStateData%GLDDU(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%GLDDU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%GLDDU = SrcOtherStateData%GLDDU -ENDIF - DstOtherStateData%BottomTouch = SrcOtherStateData%BottomTouch -IF (ALLOCATED(SrcOtherStateData%GFORC0)) THEN - i1_l = LBOUND(SrcOtherStateData%GFORC0,1) - i1_u = UBOUND(SrcOtherStateData%GFORC0,1) - i2_l = LBOUND(SrcOtherStateData%GFORC0,2) - i2_u = UBOUND(SrcOtherStateData%GFORC0,2) - i3_l = LBOUND(SrcOtherStateData%GFORC0,3) - i3_u = UBOUND(SrcOtherStateData%GFORC0,3) - IF (.NOT. ALLOCATED(DstOtherStateData%GFORC0)) THEN - ALLOCATE(DstOtherStateData%GFORC0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%GFORC0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%GFORC0 = SrcOtherStateData%GFORC0 -ENDIF -IF (ALLOCATED(SrcOtherStateData%GMASS0)) THEN - i1_l = LBOUND(SrcOtherStateData%GMASS0,1) - i1_u = UBOUND(SrcOtherStateData%GMASS0,1) - i2_l = LBOUND(SrcOtherStateData%GMASS0,2) - i2_u = UBOUND(SrcOtherStateData%GMASS0,2) - i3_l = LBOUND(SrcOtherStateData%GMASS0,3) - i3_u = UBOUND(SrcOtherStateData%GMASS0,3) - i4_l = LBOUND(SrcOtherStateData%GMASS0,4) - i4_u = UBOUND(SrcOtherStateData%GMASS0,4) - IF (.NOT. ALLOCATED(DstOtherStateData%GMASS0)) THEN - ALLOCATE(DstOtherStateData%GMASS0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%GMASS0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%GMASS0 = SrcOtherStateData%GMASS0 -ENDIF -IF (ALLOCATED(SrcOtherStateData%FAST_FPA)) THEN - i1_l = LBOUND(SrcOtherStateData%FAST_FPA,1) - i1_u = UBOUND(SrcOtherStateData%FAST_FPA,1) - i2_l = LBOUND(SrcOtherStateData%FAST_FPA,2) - i2_u = UBOUND(SrcOtherStateData%FAST_FPA,2) - IF (.NOT. ALLOCATED(DstOtherStateData%FAST_FPA)) THEN - ALLOCATE(DstOtherStateData%FAST_FPA(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%FAST_FPA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%FAST_FPA = SrcOtherStateData%FAST_FPA -ENDIF -IF (ALLOCATED(SrcOtherStateData%FAST_RP)) THEN - i1_l = LBOUND(SrcOtherStateData%FAST_RP,1) - i1_u = UBOUND(SrcOtherStateData%FAST_RP,1) - i2_l = LBOUND(SrcOtherStateData%FAST_RP,2) - i2_u = UBOUND(SrcOtherStateData%FAST_RP,2) - IF (.NOT. ALLOCATED(DstOtherStateData%FAST_RP)) THEN - ALLOCATE(DstOtherStateData%FAST_RP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%FAST_RP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%FAST_RP = SrcOtherStateData%FAST_RP -ENDIF - DstOtherStateData%INCR = SrcOtherStateData%INCR - DstOtherStateData%RSDF = SrcOtherStateData%RSDF - DstOtherStateData%FORC0 = SrcOtherStateData%FORC0 - DstOtherStateData%EMAS0 = SrcOtherStateData%EMAS0 - END SUBROUTINE FEAM_CopyOtherState - - SUBROUTINE FEAM_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(FEAM_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_DestroyOtherState' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OtherStateData%GLU0)) THEN - DEALLOCATE(OtherStateData%GLU0) -ENDIF -IF (ALLOCATED(OtherStateData%GLDDU)) THEN - DEALLOCATE(OtherStateData%GLDDU) -ENDIF -IF (ALLOCATED(OtherStateData%GFORC0)) THEN - DEALLOCATE(OtherStateData%GFORC0) -ENDIF -IF (ALLOCATED(OtherStateData%GMASS0)) THEN - DEALLOCATE(OtherStateData%GMASS0) -ENDIF -IF (ALLOCATED(OtherStateData%FAST_FPA)) THEN - DEALLOCATE(OtherStateData%FAST_FPA) -ENDIF -IF (ALLOCATED(OtherStateData%FAST_RP)) THEN - DEALLOCATE(OtherStateData%FAST_RP) -ENDIF - END SUBROUTINE FEAM_DestroyOtherState +subroutine FEAM_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(FEAM_OtherStateType), intent(in) :: SrcOtherStateData + type(FEAM_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FEAM_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOtherStateData%GLU0)) then + LB(1:2) = lbound(SrcOtherStateData%GLU0) + UB(1:2) = ubound(SrcOtherStateData%GLU0) + if (.not. allocated(DstOtherStateData%GLU0)) then + allocate(DstOtherStateData%GLU0(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%GLU0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%GLU0 = SrcOtherStateData%GLU0 + else if (allocated(DstOtherStateData%GLU0)) then + deallocate(DstOtherStateData%GLU0) + end if + if (allocated(SrcOtherStateData%GLDDU)) then + LB(1:2) = lbound(SrcOtherStateData%GLDDU) + UB(1:2) = ubound(SrcOtherStateData%GLDDU) + if (.not. allocated(DstOtherStateData%GLDDU)) then + allocate(DstOtherStateData%GLDDU(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%GLDDU.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%GLDDU = SrcOtherStateData%GLDDU + else if (allocated(DstOtherStateData%GLDDU)) then + deallocate(DstOtherStateData%GLDDU) + end if + DstOtherStateData%BottomTouch = SrcOtherStateData%BottomTouch + if (allocated(SrcOtherStateData%GFORC0)) then + LB(1:3) = lbound(SrcOtherStateData%GFORC0) + UB(1:3) = ubound(SrcOtherStateData%GFORC0) + if (.not. allocated(DstOtherStateData%GFORC0)) then + allocate(DstOtherStateData%GFORC0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%GFORC0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%GFORC0 = SrcOtherStateData%GFORC0 + else if (allocated(DstOtherStateData%GFORC0)) then + deallocate(DstOtherStateData%GFORC0) + end if + if (allocated(SrcOtherStateData%GMASS0)) then + LB(1:4) = lbound(SrcOtherStateData%GMASS0) + UB(1:4) = ubound(SrcOtherStateData%GMASS0) + if (.not. allocated(DstOtherStateData%GMASS0)) then + allocate(DstOtherStateData%GMASS0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%GMASS0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%GMASS0 = SrcOtherStateData%GMASS0 + else if (allocated(DstOtherStateData%GMASS0)) then + deallocate(DstOtherStateData%GMASS0) + end if + if (allocated(SrcOtherStateData%FAST_FPA)) then + LB(1:2) = lbound(SrcOtherStateData%FAST_FPA) + UB(1:2) = ubound(SrcOtherStateData%FAST_FPA) + if (.not. allocated(DstOtherStateData%FAST_FPA)) then + allocate(DstOtherStateData%FAST_FPA(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%FAST_FPA.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%FAST_FPA = SrcOtherStateData%FAST_FPA + else if (allocated(DstOtherStateData%FAST_FPA)) then + deallocate(DstOtherStateData%FAST_FPA) + end if + if (allocated(SrcOtherStateData%FAST_RP)) then + LB(1:2) = lbound(SrcOtherStateData%FAST_RP) + UB(1:2) = ubound(SrcOtherStateData%FAST_RP) + if (.not. allocated(DstOtherStateData%FAST_RP)) then + allocate(DstOtherStateData%FAST_RP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%FAST_RP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%FAST_RP = SrcOtherStateData%FAST_RP + else if (allocated(DstOtherStateData%FAST_RP)) then + deallocate(DstOtherStateData%FAST_RP) + end if + DstOtherStateData%INCR = SrcOtherStateData%INCR + DstOtherStateData%RSDF = SrcOtherStateData%RSDF + DstOtherStateData%FORC0 = SrcOtherStateData%FORC0 + DstOtherStateData%EMAS0 = SrcOtherStateData%EMAS0 +end subroutine +subroutine FEAM_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(FEAM_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FEAM_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OtherStateData%GLU0)) then + deallocate(OtherStateData%GLU0) + end if + if (allocated(OtherStateData%GLDDU)) then + deallocate(OtherStateData%GLDDU) + end if + if (allocated(OtherStateData%GFORC0)) then + deallocate(OtherStateData%GFORC0) + end if + if (allocated(OtherStateData%GMASS0)) then + deallocate(OtherStateData%GMASS0) + end if + if (allocated(OtherStateData%FAST_FPA)) then + deallocate(OtherStateData%FAST_FPA) + end if + if (allocated(OtherStateData%FAST_RP)) then + deallocate(OtherStateData%FAST_RP) + end if +end subroutine subroutine FEAM_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FEAM_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'FEAM_PackOtherState' if (Buf%ErrStat >= AbortErrLev) return - ! GLU0 call RegPack(Buf, allocated(InData%GLU0)) if (allocated(InData%GLU0)) then call RegPackBounds(Buf, 2, lbound(InData%GLU0), ubound(InData%GLU0)) call RegPack(Buf, InData%GLU0) end if if (RegCheckErr(Buf, RoutineName)) return - ! GLDDU call RegPack(Buf, allocated(InData%GLDDU)) if (allocated(InData%GLDDU)) then call RegPackBounds(Buf, 2, lbound(InData%GLDDU), ubound(InData%GLDDU)) call RegPack(Buf, InData%GLDDU) end if if (RegCheckErr(Buf, RoutineName)) return - ! BottomTouch call RegPack(Buf, InData%BottomTouch) if (RegCheckErr(Buf, RoutineName)) return - ! GFORC0 call RegPack(Buf, allocated(InData%GFORC0)) if (allocated(InData%GFORC0)) then call RegPackBounds(Buf, 3, lbound(InData%GFORC0), ubound(InData%GFORC0)) call RegPack(Buf, InData%GFORC0) end if if (RegCheckErr(Buf, RoutineName)) return - ! GMASS0 call RegPack(Buf, allocated(InData%GMASS0)) if (allocated(InData%GMASS0)) then call RegPackBounds(Buf, 4, lbound(InData%GMASS0), ubound(InData%GMASS0)) call RegPack(Buf, InData%GMASS0) end if if (RegCheckErr(Buf, RoutineName)) return - ! FAST_FPA call RegPack(Buf, allocated(InData%FAST_FPA)) if (allocated(InData%FAST_FPA)) then call RegPackBounds(Buf, 2, lbound(InData%FAST_FPA), ubound(InData%FAST_FPA)) call RegPack(Buf, InData%FAST_FPA) end if if (RegCheckErr(Buf, RoutineName)) return - ! FAST_RP call RegPack(Buf, allocated(InData%FAST_RP)) if (allocated(InData%FAST_RP)) then call RegPackBounds(Buf, 2, lbound(InData%FAST_RP), ubound(InData%FAST_RP)) call RegPack(Buf, InData%FAST_RP) end if if (RegCheckErr(Buf, RoutineName)) return - ! INCR call RegPack(Buf, InData%INCR) if (RegCheckErr(Buf, RoutineName)) return - ! RSDF call RegPack(Buf, InData%RSDF) if (RegCheckErr(Buf, RoutineName)) return - ! FORC0 call RegPack(Buf, InData%FORC0) if (RegCheckErr(Buf, RoutineName)) return - ! EMAS0 call RegPack(Buf, InData%EMAS0) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2070,7 +1905,6 @@ subroutine FEAM_UnPackOtherState(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! GLU0 if (allocated(OutData%GLU0)) deallocate(OutData%GLU0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2085,7 +1919,6 @@ subroutine FEAM_UnPackOtherState(Buf, OutData) call RegUnpack(Buf, OutData%GLU0) if (RegCheckErr(Buf, RoutineName)) return end if - ! GLDDU if (allocated(OutData%GLDDU)) deallocate(OutData%GLDDU) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2100,10 +1933,8 @@ subroutine FEAM_UnPackOtherState(Buf, OutData) call RegUnpack(Buf, OutData%GLDDU) if (RegCheckErr(Buf, RoutineName)) return end if - ! BottomTouch call RegUnpack(Buf, OutData%BottomTouch) if (RegCheckErr(Buf, RoutineName)) return - ! GFORC0 if (allocated(OutData%GFORC0)) deallocate(OutData%GFORC0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2118,7 +1949,6 @@ subroutine FEAM_UnPackOtherState(Buf, OutData) call RegUnpack(Buf, OutData%GFORC0) if (RegCheckErr(Buf, RoutineName)) return end if - ! GMASS0 if (allocated(OutData%GMASS0)) deallocate(OutData%GMASS0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2133,7 +1963,6 @@ subroutine FEAM_UnPackOtherState(Buf, OutData) call RegUnpack(Buf, OutData%GMASS0) if (RegCheckErr(Buf, RoutineName)) return end if - ! FAST_FPA if (allocated(OutData%FAST_FPA)) deallocate(OutData%FAST_FPA) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2148,7 +1977,6 @@ subroutine FEAM_UnPackOtherState(Buf, OutData) call RegUnpack(Buf, OutData%FAST_FPA) if (RegCheckErr(Buf, RoutineName)) return end if - ! FAST_RP if (allocated(OutData%FAST_RP)) deallocate(OutData%FAST_RP) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2163,355 +1991,313 @@ subroutine FEAM_UnPackOtherState(Buf, OutData) call RegUnpack(Buf, OutData%FAST_RP) if (RegCheckErr(Buf, RoutineName)) return end if - ! INCR call RegUnpack(Buf, OutData%INCR) if (RegCheckErr(Buf, RoutineName)) return - ! RSDF call RegUnpack(Buf, OutData%RSDF) if (RegCheckErr(Buf, RoutineName)) return - ! FORC0 call RegUnpack(Buf, OutData%FORC0) if (RegCheckErr(Buf, RoutineName)) return - ! EMAS0 call RegUnpack(Buf, OutData%EMAS0) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE FEAM_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FEAM_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(FEAM_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscData%GLF)) THEN - i1_l = LBOUND(SrcMiscData%GLF,1) - i1_u = UBOUND(SrcMiscData%GLF,1) - i2_l = LBOUND(SrcMiscData%GLF,2) - i2_u = UBOUND(SrcMiscData%GLF,2) - IF (.NOT. ALLOCATED(DstMiscData%GLF)) THEN - ALLOCATE(DstMiscData%GLF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%GLF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%GLF = SrcMiscData%GLF -ENDIF -IF (ALLOCATED(SrcMiscData%GLK)) THEN - i1_l = LBOUND(SrcMiscData%GLK,1) - i1_u = UBOUND(SrcMiscData%GLK,1) - i2_l = LBOUND(SrcMiscData%GLK,2) - i2_u = UBOUND(SrcMiscData%GLK,2) - i3_l = LBOUND(SrcMiscData%GLK,3) - i3_u = UBOUND(SrcMiscData%GLK,3) - IF (.NOT. ALLOCATED(DstMiscData%GLK)) THEN - ALLOCATE(DstMiscData%GLK(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%GLK.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%GLK = SrcMiscData%GLK -ENDIF - DstMiscData%EMASS = SrcMiscData%EMASS - DstMiscData%ESTIF = SrcMiscData%ESTIF -IF (ALLOCATED(SrcMiscData%FAST_FP)) THEN - i1_l = LBOUND(SrcMiscData%FAST_FP,1) - i1_u = UBOUND(SrcMiscData%FAST_FP,1) - i2_l = LBOUND(SrcMiscData%FAST_FP,2) - i2_u = UBOUND(SrcMiscData%FAST_FP,2) - IF (.NOT. ALLOCATED(DstMiscData%FAST_FP)) THEN - ALLOCATE(DstMiscData%FAST_FP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FAST_FP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%FAST_FP = SrcMiscData%FAST_FP -ENDIF - DstMiscData%FORCE = SrcMiscData%FORCE - DstMiscData%FP = SrcMiscData%FP - DstMiscData%U = SrcMiscData%U - DstMiscData%U0 = SrcMiscData%U0 - DstMiscData%DU = SrcMiscData%DU - DstMiscData%DDU = SrcMiscData%DDU - DstMiscData%R = SrcMiscData%R - DstMiscData%RP = SrcMiscData%RP - DstMiscData%RHSR = SrcMiscData%RHSR - DstMiscData%SLIN = SrcMiscData%SLIN - DstMiscData%STIFR = SrcMiscData%STIFR -IF (ALLOCATED(SrcMiscData%FAIR_ANG)) THEN - i1_l = LBOUND(SrcMiscData%FAIR_ANG,1) - i1_u = UBOUND(SrcMiscData%FAIR_ANG,1) - i2_l = LBOUND(SrcMiscData%FAIR_ANG,2) - i2_u = UBOUND(SrcMiscData%FAIR_ANG,2) - IF (.NOT. ALLOCATED(DstMiscData%FAIR_ANG)) THEN - ALLOCATE(DstMiscData%FAIR_ANG(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FAIR_ANG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%FAIR_ANG = SrcMiscData%FAIR_ANG -ENDIF -IF (ALLOCATED(SrcMiscData%FAIR_T)) THEN - i1_l = LBOUND(SrcMiscData%FAIR_T,1) - i1_u = UBOUND(SrcMiscData%FAIR_T,1) - IF (.NOT. ALLOCATED(DstMiscData%FAIR_T)) THEN - ALLOCATE(DstMiscData%FAIR_T(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FAIR_T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%FAIR_T = SrcMiscData%FAIR_T -ENDIF -IF (ALLOCATED(SrcMiscData%ANCH_ANG)) THEN - i1_l = LBOUND(SrcMiscData%ANCH_ANG,1) - i1_u = UBOUND(SrcMiscData%ANCH_ANG,1) - i2_l = LBOUND(SrcMiscData%ANCH_ANG,2) - i2_u = UBOUND(SrcMiscData%ANCH_ANG,2) - IF (.NOT. ALLOCATED(DstMiscData%ANCH_ANG)) THEN - ALLOCATE(DstMiscData%ANCH_ANG(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ANCH_ANG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%ANCH_ANG = SrcMiscData%ANCH_ANG -ENDIF -IF (ALLOCATED(SrcMiscData%ANCH_T)) THEN - i1_l = LBOUND(SrcMiscData%ANCH_T,1) - i1_u = UBOUND(SrcMiscData%ANCH_T,1) - IF (.NOT. ALLOCATED(DstMiscData%ANCH_T)) THEN - ALLOCATE(DstMiscData%ANCH_T(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ANCH_T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%ANCH_T = SrcMiscData%ANCH_T -ENDIF -IF (ALLOCATED(SrcMiscData%Line_Coordinate)) THEN - i1_l = LBOUND(SrcMiscData%Line_Coordinate,1) - i1_u = UBOUND(SrcMiscData%Line_Coordinate,1) - i2_l = LBOUND(SrcMiscData%Line_Coordinate,2) - i2_u = UBOUND(SrcMiscData%Line_Coordinate,2) - i3_l = LBOUND(SrcMiscData%Line_Coordinate,3) - i3_u = UBOUND(SrcMiscData%Line_Coordinate,3) - IF (.NOT. ALLOCATED(DstMiscData%Line_Coordinate)) THEN - ALLOCATE(DstMiscData%Line_Coordinate(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Line_Coordinate.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Line_Coordinate = SrcMiscData%Line_Coordinate -ENDIF -IF (ALLOCATED(SrcMiscData%Line_Tangent)) THEN - i1_l = LBOUND(SrcMiscData%Line_Tangent,1) - i1_u = UBOUND(SrcMiscData%Line_Tangent,1) - i2_l = LBOUND(SrcMiscData%Line_Tangent,2) - i2_u = UBOUND(SrcMiscData%Line_Tangent,2) - i3_l = LBOUND(SrcMiscData%Line_Tangent,3) - i3_u = UBOUND(SrcMiscData%Line_Tangent,3) - IF (.NOT. ALLOCATED(DstMiscData%Line_Tangent)) THEN - ALLOCATE(DstMiscData%Line_Tangent(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Line_Tangent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Line_Tangent = SrcMiscData%Line_Tangent -ENDIF -IF (ALLOCATED(SrcMiscData%F_Lines)) THEN - i1_l = LBOUND(SrcMiscData%F_Lines,1) - i1_u = UBOUND(SrcMiscData%F_Lines,1) - i2_l = LBOUND(SrcMiscData%F_Lines,2) - i2_u = UBOUND(SrcMiscData%F_Lines,2) - IF (.NOT. ALLOCATED(DstMiscData%F_Lines)) THEN - ALLOCATE(DstMiscData%F_Lines(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_Lines.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_Lines = SrcMiscData%F_Lines -ENDIF - DstMiscData%LastIndWave = SrcMiscData%LastIndWave - END SUBROUTINE FEAM_CopyMisc - - SUBROUTINE FEAM_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(FEAM_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_DestroyMisc' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MiscData%GLF)) THEN - DEALLOCATE(MiscData%GLF) -ENDIF -IF (ALLOCATED(MiscData%GLK)) THEN - DEALLOCATE(MiscData%GLK) -ENDIF -IF (ALLOCATED(MiscData%FAST_FP)) THEN - DEALLOCATE(MiscData%FAST_FP) -ENDIF -IF (ALLOCATED(MiscData%FAIR_ANG)) THEN - DEALLOCATE(MiscData%FAIR_ANG) -ENDIF -IF (ALLOCATED(MiscData%FAIR_T)) THEN - DEALLOCATE(MiscData%FAIR_T) -ENDIF -IF (ALLOCATED(MiscData%ANCH_ANG)) THEN - DEALLOCATE(MiscData%ANCH_ANG) -ENDIF -IF (ALLOCATED(MiscData%ANCH_T)) THEN - DEALLOCATE(MiscData%ANCH_T) -ENDIF -IF (ALLOCATED(MiscData%Line_Coordinate)) THEN - DEALLOCATE(MiscData%Line_Coordinate) -ENDIF -IF (ALLOCATED(MiscData%Line_Tangent)) THEN - DEALLOCATE(MiscData%Line_Tangent) -ENDIF -IF (ALLOCATED(MiscData%F_Lines)) THEN - DEALLOCATE(MiscData%F_Lines) -ENDIF - END SUBROUTINE FEAM_DestroyMisc +subroutine FEAM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(FEAM_MiscVarType), intent(in) :: SrcMiscData + type(FEAM_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FEAM_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMiscData%GLF)) then + LB(1:2) = lbound(SrcMiscData%GLF) + UB(1:2) = ubound(SrcMiscData%GLF) + if (.not. allocated(DstMiscData%GLF)) then + allocate(DstMiscData%GLF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%GLF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%GLF = SrcMiscData%GLF + else if (allocated(DstMiscData%GLF)) then + deallocate(DstMiscData%GLF) + end if + if (allocated(SrcMiscData%GLK)) then + LB(1:3) = lbound(SrcMiscData%GLK) + UB(1:3) = ubound(SrcMiscData%GLK) + if (.not. allocated(DstMiscData%GLK)) then + allocate(DstMiscData%GLK(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%GLK.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%GLK = SrcMiscData%GLK + else if (allocated(DstMiscData%GLK)) then + deallocate(DstMiscData%GLK) + end if + DstMiscData%EMASS = SrcMiscData%EMASS + DstMiscData%ESTIF = SrcMiscData%ESTIF + if (allocated(SrcMiscData%FAST_FP)) then + LB(1:2) = lbound(SrcMiscData%FAST_FP) + UB(1:2) = ubound(SrcMiscData%FAST_FP) + if (.not. allocated(DstMiscData%FAST_FP)) then + allocate(DstMiscData%FAST_FP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FAST_FP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%FAST_FP = SrcMiscData%FAST_FP + else if (allocated(DstMiscData%FAST_FP)) then + deallocate(DstMiscData%FAST_FP) + end if + DstMiscData%FORCE = SrcMiscData%FORCE + DstMiscData%FP = SrcMiscData%FP + DstMiscData%U = SrcMiscData%U + DstMiscData%U0 = SrcMiscData%U0 + DstMiscData%DU = SrcMiscData%DU + DstMiscData%DDU = SrcMiscData%DDU + DstMiscData%R = SrcMiscData%R + DstMiscData%RP = SrcMiscData%RP + DstMiscData%RHSR = SrcMiscData%RHSR + DstMiscData%SLIN = SrcMiscData%SLIN + DstMiscData%STIFR = SrcMiscData%STIFR + if (allocated(SrcMiscData%FAIR_ANG)) then + LB(1:2) = lbound(SrcMiscData%FAIR_ANG) + UB(1:2) = ubound(SrcMiscData%FAIR_ANG) + if (.not. allocated(DstMiscData%FAIR_ANG)) then + allocate(DstMiscData%FAIR_ANG(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FAIR_ANG.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%FAIR_ANG = SrcMiscData%FAIR_ANG + else if (allocated(DstMiscData%FAIR_ANG)) then + deallocate(DstMiscData%FAIR_ANG) + end if + if (allocated(SrcMiscData%FAIR_T)) then + LB(1:1) = lbound(SrcMiscData%FAIR_T) + UB(1:1) = ubound(SrcMiscData%FAIR_T) + if (.not. allocated(DstMiscData%FAIR_T)) then + allocate(DstMiscData%FAIR_T(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FAIR_T.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%FAIR_T = SrcMiscData%FAIR_T + else if (allocated(DstMiscData%FAIR_T)) then + deallocate(DstMiscData%FAIR_T) + end if + if (allocated(SrcMiscData%ANCH_ANG)) then + LB(1:2) = lbound(SrcMiscData%ANCH_ANG) + UB(1:2) = ubound(SrcMiscData%ANCH_ANG) + if (.not. allocated(DstMiscData%ANCH_ANG)) then + allocate(DstMiscData%ANCH_ANG(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ANCH_ANG.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%ANCH_ANG = SrcMiscData%ANCH_ANG + else if (allocated(DstMiscData%ANCH_ANG)) then + deallocate(DstMiscData%ANCH_ANG) + end if + if (allocated(SrcMiscData%ANCH_T)) then + LB(1:1) = lbound(SrcMiscData%ANCH_T) + UB(1:1) = ubound(SrcMiscData%ANCH_T) + if (.not. allocated(DstMiscData%ANCH_T)) then + allocate(DstMiscData%ANCH_T(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ANCH_T.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%ANCH_T = SrcMiscData%ANCH_T + else if (allocated(DstMiscData%ANCH_T)) then + deallocate(DstMiscData%ANCH_T) + end if + if (allocated(SrcMiscData%Line_Coordinate)) then + LB(1:3) = lbound(SrcMiscData%Line_Coordinate) + UB(1:3) = ubound(SrcMiscData%Line_Coordinate) + if (.not. allocated(DstMiscData%Line_Coordinate)) then + allocate(DstMiscData%Line_Coordinate(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Line_Coordinate.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Line_Coordinate = SrcMiscData%Line_Coordinate + else if (allocated(DstMiscData%Line_Coordinate)) then + deallocate(DstMiscData%Line_Coordinate) + end if + if (allocated(SrcMiscData%Line_Tangent)) then + LB(1:3) = lbound(SrcMiscData%Line_Tangent) + UB(1:3) = ubound(SrcMiscData%Line_Tangent) + if (.not. allocated(DstMiscData%Line_Tangent)) then + allocate(DstMiscData%Line_Tangent(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Line_Tangent.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Line_Tangent = SrcMiscData%Line_Tangent + else if (allocated(DstMiscData%Line_Tangent)) then + deallocate(DstMiscData%Line_Tangent) + end if + if (allocated(SrcMiscData%F_Lines)) then + LB(1:2) = lbound(SrcMiscData%F_Lines) + UB(1:2) = ubound(SrcMiscData%F_Lines) + if (.not. allocated(DstMiscData%F_Lines)) then + allocate(DstMiscData%F_Lines(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_Lines.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_Lines = SrcMiscData%F_Lines + else if (allocated(DstMiscData%F_Lines)) then + deallocate(DstMiscData%F_Lines) + end if + DstMiscData%LastIndWave = SrcMiscData%LastIndWave +end subroutine +subroutine FEAM_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(FEAM_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FEAM_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%GLF)) then + deallocate(MiscData%GLF) + end if + if (allocated(MiscData%GLK)) then + deallocate(MiscData%GLK) + end if + if (allocated(MiscData%FAST_FP)) then + deallocate(MiscData%FAST_FP) + end if + if (allocated(MiscData%FAIR_ANG)) then + deallocate(MiscData%FAIR_ANG) + end if + if (allocated(MiscData%FAIR_T)) then + deallocate(MiscData%FAIR_T) + end if + if (allocated(MiscData%ANCH_ANG)) then + deallocate(MiscData%ANCH_ANG) + end if + if (allocated(MiscData%ANCH_T)) then + deallocate(MiscData%ANCH_T) + end if + if (allocated(MiscData%Line_Coordinate)) then + deallocate(MiscData%Line_Coordinate) + end if + if (allocated(MiscData%Line_Tangent)) then + deallocate(MiscData%Line_Tangent) + end if + if (allocated(MiscData%F_Lines)) then + deallocate(MiscData%F_Lines) + end if +end subroutine subroutine FEAM_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FEAM_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'FEAM_PackMisc' if (Buf%ErrStat >= AbortErrLev) return - ! GLF call RegPack(Buf, allocated(InData%GLF)) if (allocated(InData%GLF)) then call RegPackBounds(Buf, 2, lbound(InData%GLF), ubound(InData%GLF)) call RegPack(Buf, InData%GLF) end if if (RegCheckErr(Buf, RoutineName)) return - ! GLK call RegPack(Buf, allocated(InData%GLK)) if (allocated(InData%GLK)) then call RegPackBounds(Buf, 3, lbound(InData%GLK), ubound(InData%GLK)) call RegPack(Buf, InData%GLK) end if if (RegCheckErr(Buf, RoutineName)) return - ! EMASS call RegPack(Buf, InData%EMASS) if (RegCheckErr(Buf, RoutineName)) return - ! ESTIF call RegPack(Buf, InData%ESTIF) if (RegCheckErr(Buf, RoutineName)) return - ! FAST_FP call RegPack(Buf, allocated(InData%FAST_FP)) if (allocated(InData%FAST_FP)) then call RegPackBounds(Buf, 2, lbound(InData%FAST_FP), ubound(InData%FAST_FP)) call RegPack(Buf, InData%FAST_FP) end if if (RegCheckErr(Buf, RoutineName)) return - ! FORCE call RegPack(Buf, InData%FORCE) if (RegCheckErr(Buf, RoutineName)) return - ! FP call RegPack(Buf, InData%FP) if (RegCheckErr(Buf, RoutineName)) return - ! U call RegPack(Buf, InData%U) if (RegCheckErr(Buf, RoutineName)) return - ! U0 call RegPack(Buf, InData%U0) if (RegCheckErr(Buf, RoutineName)) return - ! DU call RegPack(Buf, InData%DU) if (RegCheckErr(Buf, RoutineName)) return - ! DDU call RegPack(Buf, InData%DDU) if (RegCheckErr(Buf, RoutineName)) return - ! R call RegPack(Buf, InData%R) if (RegCheckErr(Buf, RoutineName)) return - ! RP call RegPack(Buf, InData%RP) if (RegCheckErr(Buf, RoutineName)) return - ! RHSR call RegPack(Buf, InData%RHSR) if (RegCheckErr(Buf, RoutineName)) return - ! SLIN call RegPack(Buf, InData%SLIN) if (RegCheckErr(Buf, RoutineName)) return - ! STIFR call RegPack(Buf, InData%STIFR) if (RegCheckErr(Buf, RoutineName)) return - ! FAIR_ANG call RegPack(Buf, allocated(InData%FAIR_ANG)) if (allocated(InData%FAIR_ANG)) then call RegPackBounds(Buf, 2, lbound(InData%FAIR_ANG), ubound(InData%FAIR_ANG)) call RegPack(Buf, InData%FAIR_ANG) end if if (RegCheckErr(Buf, RoutineName)) return - ! FAIR_T call RegPack(Buf, allocated(InData%FAIR_T)) if (allocated(InData%FAIR_T)) then call RegPackBounds(Buf, 1, lbound(InData%FAIR_T), ubound(InData%FAIR_T)) call RegPack(Buf, InData%FAIR_T) end if if (RegCheckErr(Buf, RoutineName)) return - ! ANCH_ANG call RegPack(Buf, allocated(InData%ANCH_ANG)) if (allocated(InData%ANCH_ANG)) then call RegPackBounds(Buf, 2, lbound(InData%ANCH_ANG), ubound(InData%ANCH_ANG)) call RegPack(Buf, InData%ANCH_ANG) end if if (RegCheckErr(Buf, RoutineName)) return - ! ANCH_T call RegPack(Buf, allocated(InData%ANCH_T)) if (allocated(InData%ANCH_T)) then call RegPackBounds(Buf, 1, lbound(InData%ANCH_T), ubound(InData%ANCH_T)) call RegPack(Buf, InData%ANCH_T) end if if (RegCheckErr(Buf, RoutineName)) return - ! Line_Coordinate call RegPack(Buf, allocated(InData%Line_Coordinate)) if (allocated(InData%Line_Coordinate)) then call RegPackBounds(Buf, 3, lbound(InData%Line_Coordinate), ubound(InData%Line_Coordinate)) call RegPack(Buf, InData%Line_Coordinate) end if if (RegCheckErr(Buf, RoutineName)) return - ! Line_Tangent call RegPack(Buf, allocated(InData%Line_Tangent)) if (allocated(InData%Line_Tangent)) then call RegPackBounds(Buf, 3, lbound(InData%Line_Tangent), ubound(InData%Line_Tangent)) call RegPack(Buf, InData%Line_Tangent) end if if (RegCheckErr(Buf, RoutineName)) return - ! F_Lines call RegPack(Buf, allocated(InData%F_Lines)) if (allocated(InData%F_Lines)) then call RegPackBounds(Buf, 2, lbound(InData%F_Lines), ubound(InData%F_Lines)) call RegPack(Buf, InData%F_Lines) end if if (RegCheckErr(Buf, RoutineName)) return - ! LastIndWave call RegPack(Buf, InData%LastIndWave) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2524,7 +2310,6 @@ subroutine FEAM_UnPackMisc(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! GLF if (allocated(OutData%GLF)) deallocate(OutData%GLF) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2539,7 +2324,6 @@ subroutine FEAM_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%GLF) if (RegCheckErr(Buf, RoutineName)) return end if - ! GLK if (allocated(OutData%GLK)) deallocate(OutData%GLK) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2554,13 +2338,10 @@ subroutine FEAM_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%GLK) if (RegCheckErr(Buf, RoutineName)) return end if - ! EMASS call RegUnpack(Buf, OutData%EMASS) if (RegCheckErr(Buf, RoutineName)) return - ! ESTIF call RegUnpack(Buf, OutData%ESTIF) if (RegCheckErr(Buf, RoutineName)) return - ! FAST_FP if (allocated(OutData%FAST_FP)) deallocate(OutData%FAST_FP) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2575,40 +2356,28 @@ subroutine FEAM_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%FAST_FP) if (RegCheckErr(Buf, RoutineName)) return end if - ! FORCE call RegUnpack(Buf, OutData%FORCE) if (RegCheckErr(Buf, RoutineName)) return - ! FP call RegUnpack(Buf, OutData%FP) if (RegCheckErr(Buf, RoutineName)) return - ! U call RegUnpack(Buf, OutData%U) if (RegCheckErr(Buf, RoutineName)) return - ! U0 call RegUnpack(Buf, OutData%U0) if (RegCheckErr(Buf, RoutineName)) return - ! DU call RegUnpack(Buf, OutData%DU) if (RegCheckErr(Buf, RoutineName)) return - ! DDU call RegUnpack(Buf, OutData%DDU) if (RegCheckErr(Buf, RoutineName)) return - ! R call RegUnpack(Buf, OutData%R) if (RegCheckErr(Buf, RoutineName)) return - ! RP call RegUnpack(Buf, OutData%RP) if (RegCheckErr(Buf, RoutineName)) return - ! RHSR call RegUnpack(Buf, OutData%RHSR) if (RegCheckErr(Buf, RoutineName)) return - ! SLIN call RegUnpack(Buf, OutData%SLIN) if (RegCheckErr(Buf, RoutineName)) return - ! STIFR call RegUnpack(Buf, OutData%STIFR) if (RegCheckErr(Buf, RoutineName)) return - ! FAIR_ANG if (allocated(OutData%FAIR_ANG)) deallocate(OutData%FAIR_ANG) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2623,7 +2392,6 @@ subroutine FEAM_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%FAIR_ANG) if (RegCheckErr(Buf, RoutineName)) return end if - ! FAIR_T if (allocated(OutData%FAIR_T)) deallocate(OutData%FAIR_T) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2638,7 +2406,6 @@ subroutine FEAM_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%FAIR_T) if (RegCheckErr(Buf, RoutineName)) return end if - ! ANCH_ANG if (allocated(OutData%ANCH_ANG)) deallocate(OutData%ANCH_ANG) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2653,7 +2420,6 @@ subroutine FEAM_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%ANCH_ANG) if (RegCheckErr(Buf, RoutineName)) return end if - ! ANCH_T if (allocated(OutData%ANCH_T)) deallocate(OutData%ANCH_T) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2668,7 +2434,6 @@ subroutine FEAM_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%ANCH_T) if (RegCheckErr(Buf, RoutineName)) return end if - ! Line_Coordinate if (allocated(OutData%Line_Coordinate)) deallocate(OutData%Line_Coordinate) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2683,7 +2448,6 @@ subroutine FEAM_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%Line_Coordinate) if (RegCheckErr(Buf, RoutineName)) return end if - ! Line_Tangent if (allocated(OutData%Line_Tangent)) deallocate(OutData%Line_Tangent) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2698,7 +2462,6 @@ subroutine FEAM_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%Line_Tangent) if (RegCheckErr(Buf, RoutineName)) return end if - ! F_Lines if (allocated(OutData%F_Lines)) deallocate(OutData%F_Lines) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2713,379 +2476,387 @@ subroutine FEAM_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%F_Lines) if (RegCheckErr(Buf, RoutineName)) return end if - ! LastIndWave call RegUnpack(Buf, OutData%LastIndWave) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE FEAM_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FEAM_ParameterType), INTENT(IN) :: SrcParamData - TYPE(FEAM_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT - DstParamData%GRAV = SrcParamData%GRAV - DstParamData%Eps = SrcParamData%Eps - DstParamData%Gravity = SrcParamData%Gravity - DstParamData%WtrDens = SrcParamData%WtrDens - DstParamData%MaxIter = SrcParamData%MaxIter - DstParamData%NHBD = SrcParamData%NHBD - DstParamData%NDIM = SrcParamData%NDIM -IF (ALLOCATED(SrcParamData%NEQ)) THEN - i1_l = LBOUND(SrcParamData%NEQ,1) - i1_u = UBOUND(SrcParamData%NEQ,1) - IF (.NOT. ALLOCATED(DstParamData%NEQ)) THEN - ALLOCATE(DstParamData%NEQ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NEQ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%NEQ = SrcParamData%NEQ -ENDIF - DstParamData%NBAND = SrcParamData%NBAND - DstParamData%NumLines = SrcParamData%NumLines - DstParamData%NumElems = SrcParamData%NumElems - DstParamData%NumNodes = SrcParamData%NumNodes -IF (ALLOCATED(SrcParamData%GSL)) THEN - i1_l = LBOUND(SrcParamData%GSL,1) - i1_u = UBOUND(SrcParamData%GSL,1) - i2_l = LBOUND(SrcParamData%GSL,2) - i2_u = UBOUND(SrcParamData%GSL,2) - i3_l = LBOUND(SrcParamData%GSL,3) - i3_u = UBOUND(SrcParamData%GSL,3) - IF (.NOT. ALLOCATED(DstParamData%GSL)) THEN - ALLOCATE(DstParamData%GSL(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%GSL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%GSL = SrcParamData%GSL -ENDIF -IF (ALLOCATED(SrcParamData%GP)) THEN - i1_l = LBOUND(SrcParamData%GP,1) - i1_u = UBOUND(SrcParamData%GP,1) - i2_l = LBOUND(SrcParamData%GP,2) - i2_u = UBOUND(SrcParamData%GP,2) - IF (.NOT. ALLOCATED(DstParamData%GP)) THEN - ALLOCATE(DstParamData%GP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%GP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%GP = SrcParamData%GP -ENDIF -IF (ALLOCATED(SrcParamData%Elength)) THEN - i1_l = LBOUND(SrcParamData%Elength,1) - i1_u = UBOUND(SrcParamData%Elength,1) - IF (.NOT. ALLOCATED(DstParamData%Elength)) THEN - ALLOCATE(DstParamData%Elength(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Elength.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Elength = SrcParamData%Elength -ENDIF -IF (ALLOCATED(SrcParamData%BottmElev)) THEN - i1_l = LBOUND(SrcParamData%BottmElev,1) - i1_u = UBOUND(SrcParamData%BottmElev,1) - IF (.NOT. ALLOCATED(DstParamData%BottmElev)) THEN - ALLOCATE(DstParamData%BottmElev(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BottmElev.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BottmElev = SrcParamData%BottmElev -ENDIF -IF (ALLOCATED(SrcParamData%BottmStiff)) THEN - i1_l = LBOUND(SrcParamData%BottmStiff,1) - i1_u = UBOUND(SrcParamData%BottmStiff,1) - IF (.NOT. ALLOCATED(DstParamData%BottmStiff)) THEN - ALLOCATE(DstParamData%BottmStiff(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BottmStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BottmStiff = SrcParamData%BottmStiff -ENDIF -IF (ALLOCATED(SrcParamData%LMassDen)) THEN - i1_l = LBOUND(SrcParamData%LMassDen,1) - i1_u = UBOUND(SrcParamData%LMassDen,1) - IF (.NOT. ALLOCATED(DstParamData%LMassDen)) THEN - ALLOCATE(DstParamData%LMassDen(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%LMassDen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%LMassDen = SrcParamData%LMassDen -ENDIF -IF (ALLOCATED(SrcParamData%LDMassDen)) THEN - i1_l = LBOUND(SrcParamData%LDMassDen,1) - i1_u = UBOUND(SrcParamData%LDMassDen,1) - IF (.NOT. ALLOCATED(DstParamData%LDMassDen)) THEN - ALLOCATE(DstParamData%LDMassDen(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%LDMassDen.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%LDMassDen = SrcParamData%LDMassDen -ENDIF -IF (ALLOCATED(SrcParamData%LEAStiff)) THEN - i1_l = LBOUND(SrcParamData%LEAStiff,1) - i1_u = UBOUND(SrcParamData%LEAStiff,1) - IF (.NOT. ALLOCATED(DstParamData%LEAStiff)) THEN - ALLOCATE(DstParamData%LEAStiff(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%LEAStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%LEAStiff = SrcParamData%LEAStiff -ENDIF -IF (ALLOCATED(SrcParamData%LineCI)) THEN - i1_l = LBOUND(SrcParamData%LineCI,1) - i1_u = UBOUND(SrcParamData%LineCI,1) - IF (.NOT. ALLOCATED(DstParamData%LineCI)) THEN - ALLOCATE(DstParamData%LineCI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%LineCI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%LineCI = SrcParamData%LineCI -ENDIF -IF (ALLOCATED(SrcParamData%LineCD)) THEN - i1_l = LBOUND(SrcParamData%LineCD,1) - i1_u = UBOUND(SrcParamData%LineCD,1) - IF (.NOT. ALLOCATED(DstParamData%LineCD)) THEN - ALLOCATE(DstParamData%LineCD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%LineCD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%LineCD = SrcParamData%LineCD -ENDIF -IF (ALLOCATED(SrcParamData%Bvp)) THEN - i1_l = LBOUND(SrcParamData%Bvp,1) - i1_u = UBOUND(SrcParamData%Bvp,1) - i2_l = LBOUND(SrcParamData%Bvp,2) - i2_u = UBOUND(SrcParamData%Bvp,2) - IF (.NOT. ALLOCATED(DstParamData%Bvp)) THEN - ALLOCATE(DstParamData%Bvp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Bvp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Bvp = SrcParamData%Bvp -ENDIF -IF (ALLOCATED(SrcParamData%WaveAcc0)) THEN - i1_l = LBOUND(SrcParamData%WaveAcc0,1) - i1_u = UBOUND(SrcParamData%WaveAcc0,1) - i2_l = LBOUND(SrcParamData%WaveAcc0,2) - i2_u = UBOUND(SrcParamData%WaveAcc0,2) - i3_l = LBOUND(SrcParamData%WaveAcc0,3) - i3_u = UBOUND(SrcParamData%WaveAcc0,3) - IF (.NOT. ALLOCATED(DstParamData%WaveAcc0)) THEN - ALLOCATE(DstParamData%WaveAcc0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveAcc0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveAcc0 = SrcParamData%WaveAcc0 -ENDIF -IF (ALLOCATED(SrcParamData%WaveTime)) THEN - i1_l = LBOUND(SrcParamData%WaveTime,1) - i1_u = UBOUND(SrcParamData%WaveTime,1) - IF (.NOT. ALLOCATED(DstParamData%WaveTime)) THEN - ALLOCATE(DstParamData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveTime = SrcParamData%WaveTime -ENDIF -IF (ALLOCATED(SrcParamData%WaveVel0)) THEN - i1_l = LBOUND(SrcParamData%WaveVel0,1) - i1_u = UBOUND(SrcParamData%WaveVel0,1) - i2_l = LBOUND(SrcParamData%WaveVel0,2) - i2_u = UBOUND(SrcParamData%WaveVel0,2) - i3_l = LBOUND(SrcParamData%WaveVel0,3) - i3_u = UBOUND(SrcParamData%WaveVel0,3) - IF (.NOT. ALLOCATED(DstParamData%WaveVel0)) THEN - ALLOCATE(DstParamData%WaveVel0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveVel0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveVel0 = SrcParamData%WaveVel0 -ENDIF - DstParamData%NStepWave = SrcParamData%NStepWave - DstParamData%SHAP = SrcParamData%SHAP - DstParamData%SHAPS = SrcParamData%SHAPS - DstParamData%GAUSSW = SrcParamData%GAUSSW - DstParamData%NGAUSS = SrcParamData%NGAUSS - DstParamData%SHAPT = SrcParamData%SHAPT - DstParamData%SHAPTS = SrcParamData%SHAPTS - DstParamData%NTRAP = SrcParamData%NTRAP - DstParamData%SBEND = SrcParamData%SBEND - DstParamData%STEN = SrcParamData%STEN - DstParamData%RMASS = SrcParamData%RMASS - DstParamData%RADDM = SrcParamData%RADDM - DstParamData%PMPN = SrcParamData%PMPN - DstParamData%AM = SrcParamData%AM - DstParamData%PM = SrcParamData%PM - DstParamData%IDOF = SrcParamData%IDOF - DstParamData%JDOF = SrcParamData%JDOF - DstParamData%PPA = SrcParamData%PPA - DstParamData%PtfmRefzt = SrcParamData%PtfmRefzt - DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%RootName = SrcParamData%RootName -IF (ALLOCATED(SrcParamData%OutParam)) THEN - i1_l = LBOUND(SrcParamData%OutParam,1) - i1_u = UBOUND(SrcParamData%OutParam,1) - IF (.NOT. ALLOCATED(DstParamData%OutParam)) THEN - ALLOCATE(DstParamData%OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%OutParam,1), UBOUND(SrcParamData%OutParam,1) - CALL NWTC_Library_Copyoutparmtype( SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstParamData%Delim = SrcParamData%Delim -IF (ALLOCATED(SrcParamData%GLUZR)) THEN - i1_l = LBOUND(SrcParamData%GLUZR,1) - i1_u = UBOUND(SrcParamData%GLUZR,1) - i2_l = LBOUND(SrcParamData%GLUZR,2) - i2_u = UBOUND(SrcParamData%GLUZR,2) - i3_l = LBOUND(SrcParamData%GLUZR,3) - i3_u = UBOUND(SrcParamData%GLUZR,3) - IF (.NOT. ALLOCATED(DstParamData%GLUZR)) THEN - ALLOCATE(DstParamData%GLUZR(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%GLUZR.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%GLUZR = SrcParamData%GLUZR -ENDIF -IF (ALLOCATED(SrcParamData%GTZER)) THEN - i1_l = LBOUND(SrcParamData%GTZER,1) - i1_u = UBOUND(SrcParamData%GTZER,1) - i2_l = LBOUND(SrcParamData%GTZER,2) - i2_u = UBOUND(SrcParamData%GTZER,2) - IF (.NOT. ALLOCATED(DstParamData%GTZER)) THEN - ALLOCATE(DstParamData%GTZER(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%GTZER.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%GTZER = SrcParamData%GTZER -ENDIF - END SUBROUTINE FEAM_CopyParam - - SUBROUTINE FEAM_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(FEAM_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_DestroyParam' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%NEQ)) THEN - DEALLOCATE(ParamData%NEQ) -ENDIF -IF (ALLOCATED(ParamData%GSL)) THEN - DEALLOCATE(ParamData%GSL) -ENDIF -IF (ALLOCATED(ParamData%GP)) THEN - DEALLOCATE(ParamData%GP) -ENDIF -IF (ALLOCATED(ParamData%Elength)) THEN - DEALLOCATE(ParamData%Elength) -ENDIF -IF (ALLOCATED(ParamData%BottmElev)) THEN - DEALLOCATE(ParamData%BottmElev) -ENDIF -IF (ALLOCATED(ParamData%BottmStiff)) THEN - DEALLOCATE(ParamData%BottmStiff) -ENDIF -IF (ALLOCATED(ParamData%LMassDen)) THEN - DEALLOCATE(ParamData%LMassDen) -ENDIF -IF (ALLOCATED(ParamData%LDMassDen)) THEN - DEALLOCATE(ParamData%LDMassDen) -ENDIF -IF (ALLOCATED(ParamData%LEAStiff)) THEN - DEALLOCATE(ParamData%LEAStiff) -ENDIF -IF (ALLOCATED(ParamData%LineCI)) THEN - DEALLOCATE(ParamData%LineCI) -ENDIF -IF (ALLOCATED(ParamData%LineCD)) THEN - DEALLOCATE(ParamData%LineCD) -ENDIF -IF (ALLOCATED(ParamData%Bvp)) THEN - DEALLOCATE(ParamData%Bvp) -ENDIF -IF (ALLOCATED(ParamData%WaveAcc0)) THEN - DEALLOCATE(ParamData%WaveAcc0) -ENDIF -IF (ALLOCATED(ParamData%WaveTime)) THEN - DEALLOCATE(ParamData%WaveTime) -ENDIF -IF (ALLOCATED(ParamData%WaveVel0)) THEN - DEALLOCATE(ParamData%WaveVel0) -ENDIF -IF (ALLOCATED(ParamData%OutParam)) THEN -DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_DestroyOutParmType( ParamData%OutParam(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%OutParam) -ENDIF -IF (ALLOCATED(ParamData%GLUZR)) THEN - DEALLOCATE(ParamData%GLUZR) -ENDIF -IF (ALLOCATED(ParamData%GTZER)) THEN - DEALLOCATE(ParamData%GTZER) -ENDIF - END SUBROUTINE FEAM_DestroyParam +subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(FEAM_ParameterType), intent(in) :: SrcParamData + type(FEAM_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3, i4 + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FEAM_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%DT = SrcParamData%DT + DstParamData%GRAV = SrcParamData%GRAV + DstParamData%Eps = SrcParamData%Eps + DstParamData%Gravity = SrcParamData%Gravity + DstParamData%WtrDens = SrcParamData%WtrDens + DstParamData%MaxIter = SrcParamData%MaxIter + DstParamData%NHBD = SrcParamData%NHBD + DstParamData%NDIM = SrcParamData%NDIM + if (allocated(SrcParamData%NEQ)) then + LB(1:1) = lbound(SrcParamData%NEQ) + UB(1:1) = ubound(SrcParamData%NEQ) + if (.not. allocated(DstParamData%NEQ)) then + allocate(DstParamData%NEQ(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NEQ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%NEQ = SrcParamData%NEQ + else if (allocated(DstParamData%NEQ)) then + deallocate(DstParamData%NEQ) + end if + DstParamData%NBAND = SrcParamData%NBAND + DstParamData%NumLines = SrcParamData%NumLines + DstParamData%NumElems = SrcParamData%NumElems + DstParamData%NumNodes = SrcParamData%NumNodes + if (allocated(SrcParamData%GSL)) then + LB(1:3) = lbound(SrcParamData%GSL) + UB(1:3) = ubound(SrcParamData%GSL) + if (.not. allocated(DstParamData%GSL)) then + allocate(DstParamData%GSL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%GSL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%GSL = SrcParamData%GSL + else if (allocated(DstParamData%GSL)) then + deallocate(DstParamData%GSL) + end if + if (allocated(SrcParamData%GP)) then + LB(1:2) = lbound(SrcParamData%GP) + UB(1:2) = ubound(SrcParamData%GP) + if (.not. allocated(DstParamData%GP)) then + allocate(DstParamData%GP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%GP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%GP = SrcParamData%GP + else if (allocated(DstParamData%GP)) then + deallocate(DstParamData%GP) + end if + if (allocated(SrcParamData%Elength)) then + LB(1:1) = lbound(SrcParamData%Elength) + UB(1:1) = ubound(SrcParamData%Elength) + if (.not. allocated(DstParamData%Elength)) then + allocate(DstParamData%Elength(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Elength.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Elength = SrcParamData%Elength + else if (allocated(DstParamData%Elength)) then + deallocate(DstParamData%Elength) + end if + if (allocated(SrcParamData%BottmElev)) then + LB(1:1) = lbound(SrcParamData%BottmElev) + UB(1:1) = ubound(SrcParamData%BottmElev) + if (.not. allocated(DstParamData%BottmElev)) then + allocate(DstParamData%BottmElev(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BottmElev.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BottmElev = SrcParamData%BottmElev + else if (allocated(DstParamData%BottmElev)) then + deallocate(DstParamData%BottmElev) + end if + if (allocated(SrcParamData%BottmStiff)) then + LB(1:1) = lbound(SrcParamData%BottmStiff) + UB(1:1) = ubound(SrcParamData%BottmStiff) + if (.not. allocated(DstParamData%BottmStiff)) then + allocate(DstParamData%BottmStiff(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BottmStiff.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BottmStiff = SrcParamData%BottmStiff + else if (allocated(DstParamData%BottmStiff)) then + deallocate(DstParamData%BottmStiff) + end if + if (allocated(SrcParamData%LMassDen)) then + LB(1:1) = lbound(SrcParamData%LMassDen) + UB(1:1) = ubound(SrcParamData%LMassDen) + if (.not. allocated(DstParamData%LMassDen)) then + allocate(DstParamData%LMassDen(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%LMassDen.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%LMassDen = SrcParamData%LMassDen + else if (allocated(DstParamData%LMassDen)) then + deallocate(DstParamData%LMassDen) + end if + if (allocated(SrcParamData%LDMassDen)) then + LB(1:1) = lbound(SrcParamData%LDMassDen) + UB(1:1) = ubound(SrcParamData%LDMassDen) + if (.not. allocated(DstParamData%LDMassDen)) then + allocate(DstParamData%LDMassDen(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%LDMassDen.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%LDMassDen = SrcParamData%LDMassDen + else if (allocated(DstParamData%LDMassDen)) then + deallocate(DstParamData%LDMassDen) + end if + if (allocated(SrcParamData%LEAStiff)) then + LB(1:1) = lbound(SrcParamData%LEAStiff) + UB(1:1) = ubound(SrcParamData%LEAStiff) + if (.not. allocated(DstParamData%LEAStiff)) then + allocate(DstParamData%LEAStiff(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%LEAStiff.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%LEAStiff = SrcParamData%LEAStiff + else if (allocated(DstParamData%LEAStiff)) then + deallocate(DstParamData%LEAStiff) + end if + if (allocated(SrcParamData%LineCI)) then + LB(1:1) = lbound(SrcParamData%LineCI) + UB(1:1) = ubound(SrcParamData%LineCI) + if (.not. allocated(DstParamData%LineCI)) then + allocate(DstParamData%LineCI(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%LineCI.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%LineCI = SrcParamData%LineCI + else if (allocated(DstParamData%LineCI)) then + deallocate(DstParamData%LineCI) + end if + if (allocated(SrcParamData%LineCD)) then + LB(1:1) = lbound(SrcParamData%LineCD) + UB(1:1) = ubound(SrcParamData%LineCD) + if (.not. allocated(DstParamData%LineCD)) then + allocate(DstParamData%LineCD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%LineCD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%LineCD = SrcParamData%LineCD + else if (allocated(DstParamData%LineCD)) then + deallocate(DstParamData%LineCD) + end if + if (allocated(SrcParamData%Bvp)) then + LB(1:2) = lbound(SrcParamData%Bvp) + UB(1:2) = ubound(SrcParamData%Bvp) + if (.not. allocated(DstParamData%Bvp)) then + allocate(DstParamData%Bvp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Bvp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Bvp = SrcParamData%Bvp + else if (allocated(DstParamData%Bvp)) then + deallocate(DstParamData%Bvp) + end if + if (allocated(SrcParamData%WaveAcc0)) then + LB(1:3) = lbound(SrcParamData%WaveAcc0) + UB(1:3) = ubound(SrcParamData%WaveAcc0) + if (.not. allocated(DstParamData%WaveAcc0)) then + allocate(DstParamData%WaveAcc0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveAcc0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WaveAcc0 = SrcParamData%WaveAcc0 + else if (allocated(DstParamData%WaveAcc0)) then + deallocate(DstParamData%WaveAcc0) + end if + if (allocated(SrcParamData%WaveTime)) then + LB(1:1) = lbound(SrcParamData%WaveTime) + UB(1:1) = ubound(SrcParamData%WaveTime) + if (.not. allocated(DstParamData%WaveTime)) then + allocate(DstParamData%WaveTime(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveTime.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WaveTime = SrcParamData%WaveTime + else if (allocated(DstParamData%WaveTime)) then + deallocate(DstParamData%WaveTime) + end if + if (allocated(SrcParamData%WaveVel0)) then + LB(1:3) = lbound(SrcParamData%WaveVel0) + UB(1:3) = ubound(SrcParamData%WaveVel0) + if (.not. allocated(DstParamData%WaveVel0)) then + allocate(DstParamData%WaveVel0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveVel0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WaveVel0 = SrcParamData%WaveVel0 + else if (allocated(DstParamData%WaveVel0)) then + deallocate(DstParamData%WaveVel0) + end if + DstParamData%NStepWave = SrcParamData%NStepWave + DstParamData%SHAP = SrcParamData%SHAP + DstParamData%SHAPS = SrcParamData%SHAPS + DstParamData%GAUSSW = SrcParamData%GAUSSW + DstParamData%NGAUSS = SrcParamData%NGAUSS + DstParamData%SHAPT = SrcParamData%SHAPT + DstParamData%SHAPTS = SrcParamData%SHAPTS + DstParamData%NTRAP = SrcParamData%NTRAP + DstParamData%SBEND = SrcParamData%SBEND + DstParamData%STEN = SrcParamData%STEN + DstParamData%RMASS = SrcParamData%RMASS + DstParamData%RADDM = SrcParamData%RADDM + DstParamData%PMPN = SrcParamData%PMPN + DstParamData%AM = SrcParamData%AM + DstParamData%PM = SrcParamData%PM + DstParamData%IDOF = SrcParamData%IDOF + DstParamData%JDOF = SrcParamData%JDOF + DstParamData%PPA = SrcParamData%PPA + DstParamData%PtfmRefzt = SrcParamData%PtfmRefzt + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%RootName = SrcParamData%RootName + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstParamData%OutParam)) then + deallocate(DstParamData%OutParam) + end if + DstParamData%Delim = SrcParamData%Delim + if (allocated(SrcParamData%GLUZR)) then + LB(1:3) = lbound(SrcParamData%GLUZR) + UB(1:3) = ubound(SrcParamData%GLUZR) + if (.not. allocated(DstParamData%GLUZR)) then + allocate(DstParamData%GLUZR(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%GLUZR.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%GLUZR = SrcParamData%GLUZR + else if (allocated(DstParamData%GLUZR)) then + deallocate(DstParamData%GLUZR) + end if + if (allocated(SrcParamData%GTZER)) then + LB(1:2) = lbound(SrcParamData%GTZER) + UB(1:2) = ubound(SrcParamData%GTZER) + if (.not. allocated(DstParamData%GTZER)) then + allocate(DstParamData%GTZER(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%GTZER.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%GTZER = SrcParamData%GTZER + else if (allocated(DstParamData%GTZER)) then + deallocate(DstParamData%GTZER) + end if +end subroutine +subroutine FEAM_DestroyParam(ParamData, ErrStat, ErrMsg) + type(FEAM_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3, i4 + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FEAM_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%NEQ)) then + deallocate(ParamData%NEQ) + end if + if (allocated(ParamData%GSL)) then + deallocate(ParamData%GSL) + end if + if (allocated(ParamData%GP)) then + deallocate(ParamData%GP) + end if + if (allocated(ParamData%Elength)) then + deallocate(ParamData%Elength) + end if + if (allocated(ParamData%BottmElev)) then + deallocate(ParamData%BottmElev) + end if + if (allocated(ParamData%BottmStiff)) then + deallocate(ParamData%BottmStiff) + end if + if (allocated(ParamData%LMassDen)) then + deallocate(ParamData%LMassDen) + end if + if (allocated(ParamData%LDMassDen)) then + deallocate(ParamData%LDMassDen) + end if + if (allocated(ParamData%LEAStiff)) then + deallocate(ParamData%LEAStiff) + end if + if (allocated(ParamData%LineCI)) then + deallocate(ParamData%LineCI) + end if + if (allocated(ParamData%LineCD)) then + deallocate(ParamData%LineCD) + end if + if (allocated(ParamData%Bvp)) then + deallocate(ParamData%Bvp) + end if + if (allocated(ParamData%WaveAcc0)) then + deallocate(ParamData%WaveAcc0) + end if + if (allocated(ParamData%WaveTime)) then + deallocate(ParamData%WaveTime) + end if + if (allocated(ParamData%WaveVel0)) then + deallocate(ParamData%WaveVel0) + end if + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%OutParam) + end if + if (allocated(ParamData%GLUZR)) then + deallocate(ParamData%GLUZR) + end if + if (allocated(ParamData%GTZER)) then + deallocate(ParamData%GTZER) + end if +end subroutine subroutine FEAM_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -3094,211 +2865,162 @@ subroutine FEAM_PackParam(Buf, Indata) integer(IntKi) :: i1, i2, i3, i4 integer(IntKi) :: LB(4), UB(4) if (Buf%ErrStat >= AbortErrLev) return - ! DT call RegPack(Buf, InData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! GRAV call RegPack(Buf, InData%GRAV) if (RegCheckErr(Buf, RoutineName)) return - ! Eps call RegPack(Buf, InData%Eps) if (RegCheckErr(Buf, RoutineName)) return - ! Gravity call RegPack(Buf, InData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDens call RegPack(Buf, InData%WtrDens) if (RegCheckErr(Buf, RoutineName)) return - ! MaxIter call RegPack(Buf, InData%MaxIter) if (RegCheckErr(Buf, RoutineName)) return - ! NHBD call RegPack(Buf, InData%NHBD) if (RegCheckErr(Buf, RoutineName)) return - ! NDIM call RegPack(Buf, InData%NDIM) if (RegCheckErr(Buf, RoutineName)) return - ! NEQ call RegPack(Buf, allocated(InData%NEQ)) if (allocated(InData%NEQ)) then call RegPackBounds(Buf, 1, lbound(InData%NEQ), ubound(InData%NEQ)) call RegPack(Buf, InData%NEQ) end if if (RegCheckErr(Buf, RoutineName)) return - ! NBAND call RegPack(Buf, InData%NBAND) if (RegCheckErr(Buf, RoutineName)) return - ! NumLines call RegPack(Buf, InData%NumLines) if (RegCheckErr(Buf, RoutineName)) return - ! NumElems call RegPack(Buf, InData%NumElems) if (RegCheckErr(Buf, RoutineName)) return - ! NumNodes call RegPack(Buf, InData%NumNodes) if (RegCheckErr(Buf, RoutineName)) return - ! GSL call RegPack(Buf, allocated(InData%GSL)) if (allocated(InData%GSL)) then call RegPackBounds(Buf, 3, lbound(InData%GSL), ubound(InData%GSL)) call RegPack(Buf, InData%GSL) end if if (RegCheckErr(Buf, RoutineName)) return - ! GP call RegPack(Buf, allocated(InData%GP)) if (allocated(InData%GP)) then call RegPackBounds(Buf, 2, lbound(InData%GP), ubound(InData%GP)) call RegPack(Buf, InData%GP) end if if (RegCheckErr(Buf, RoutineName)) return - ! Elength call RegPack(Buf, allocated(InData%Elength)) if (allocated(InData%Elength)) then call RegPackBounds(Buf, 1, lbound(InData%Elength), ubound(InData%Elength)) call RegPack(Buf, InData%Elength) end if if (RegCheckErr(Buf, RoutineName)) return - ! BottmElev call RegPack(Buf, allocated(InData%BottmElev)) if (allocated(InData%BottmElev)) then call RegPackBounds(Buf, 1, lbound(InData%BottmElev), ubound(InData%BottmElev)) call RegPack(Buf, InData%BottmElev) end if if (RegCheckErr(Buf, RoutineName)) return - ! BottmStiff call RegPack(Buf, allocated(InData%BottmStiff)) if (allocated(InData%BottmStiff)) then call RegPackBounds(Buf, 1, lbound(InData%BottmStiff), ubound(InData%BottmStiff)) call RegPack(Buf, InData%BottmStiff) end if if (RegCheckErr(Buf, RoutineName)) return - ! LMassDen call RegPack(Buf, allocated(InData%LMassDen)) if (allocated(InData%LMassDen)) then call RegPackBounds(Buf, 1, lbound(InData%LMassDen), ubound(InData%LMassDen)) call RegPack(Buf, InData%LMassDen) end if if (RegCheckErr(Buf, RoutineName)) return - ! LDMassDen call RegPack(Buf, allocated(InData%LDMassDen)) if (allocated(InData%LDMassDen)) then call RegPackBounds(Buf, 1, lbound(InData%LDMassDen), ubound(InData%LDMassDen)) call RegPack(Buf, InData%LDMassDen) end if if (RegCheckErr(Buf, RoutineName)) return - ! LEAStiff call RegPack(Buf, allocated(InData%LEAStiff)) if (allocated(InData%LEAStiff)) then call RegPackBounds(Buf, 1, lbound(InData%LEAStiff), ubound(InData%LEAStiff)) call RegPack(Buf, InData%LEAStiff) end if if (RegCheckErr(Buf, RoutineName)) return - ! LineCI call RegPack(Buf, allocated(InData%LineCI)) if (allocated(InData%LineCI)) then call RegPackBounds(Buf, 1, lbound(InData%LineCI), ubound(InData%LineCI)) call RegPack(Buf, InData%LineCI) end if if (RegCheckErr(Buf, RoutineName)) return - ! LineCD call RegPack(Buf, allocated(InData%LineCD)) if (allocated(InData%LineCD)) then call RegPackBounds(Buf, 1, lbound(InData%LineCD), ubound(InData%LineCD)) call RegPack(Buf, InData%LineCD) end if if (RegCheckErr(Buf, RoutineName)) return - ! Bvp call RegPack(Buf, allocated(InData%Bvp)) if (allocated(InData%Bvp)) then call RegPackBounds(Buf, 2, lbound(InData%Bvp), ubound(InData%Bvp)) call RegPack(Buf, InData%Bvp) end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveAcc0 call RegPack(Buf, allocated(InData%WaveAcc0)) if (allocated(InData%WaveAcc0)) then call RegPackBounds(Buf, 3, lbound(InData%WaveAcc0), ubound(InData%WaveAcc0)) call RegPack(Buf, InData%WaveAcc0) end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveTime call RegPack(Buf, allocated(InData%WaveTime)) if (allocated(InData%WaveTime)) then call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) call RegPack(Buf, InData%WaveTime) end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveVel0 call RegPack(Buf, allocated(InData%WaveVel0)) if (allocated(InData%WaveVel0)) then call RegPackBounds(Buf, 3, lbound(InData%WaveVel0), ubound(InData%WaveVel0)) call RegPack(Buf, InData%WaveVel0) end if if (RegCheckErr(Buf, RoutineName)) return - ! NStepWave call RegPack(Buf, InData%NStepWave) if (RegCheckErr(Buf, RoutineName)) return - ! SHAP call RegPack(Buf, InData%SHAP) if (RegCheckErr(Buf, RoutineName)) return - ! SHAPS call RegPack(Buf, InData%SHAPS) if (RegCheckErr(Buf, RoutineName)) return - ! GAUSSW call RegPack(Buf, InData%GAUSSW) if (RegCheckErr(Buf, RoutineName)) return - ! NGAUSS call RegPack(Buf, InData%NGAUSS) if (RegCheckErr(Buf, RoutineName)) return - ! SHAPT call RegPack(Buf, InData%SHAPT) if (RegCheckErr(Buf, RoutineName)) return - ! SHAPTS call RegPack(Buf, InData%SHAPTS) if (RegCheckErr(Buf, RoutineName)) return - ! NTRAP call RegPack(Buf, InData%NTRAP) if (RegCheckErr(Buf, RoutineName)) return - ! SBEND call RegPack(Buf, InData%SBEND) if (RegCheckErr(Buf, RoutineName)) return - ! STEN call RegPack(Buf, InData%STEN) if (RegCheckErr(Buf, RoutineName)) return - ! RMASS call RegPack(Buf, InData%RMASS) if (RegCheckErr(Buf, RoutineName)) return - ! RADDM call RegPack(Buf, InData%RADDM) if (RegCheckErr(Buf, RoutineName)) return - ! PMPN call RegPack(Buf, InData%PMPN) if (RegCheckErr(Buf, RoutineName)) return - ! AM call RegPack(Buf, InData%AM) if (RegCheckErr(Buf, RoutineName)) return - ! PM call RegPack(Buf, InData%PM) if (RegCheckErr(Buf, RoutineName)) return - ! IDOF call RegPack(Buf, InData%IDOF) if (RegCheckErr(Buf, RoutineName)) return - ! JDOF call RegPack(Buf, InData%JDOF) if (RegCheckErr(Buf, RoutineName)) return - ! PPA call RegPack(Buf, InData%PPA) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmRefzt call RegPack(Buf, InData%PtfmRefzt) if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegPack(Buf, InData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegPack(Buf, InData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! OutParam call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) @@ -3309,17 +3031,14 @@ subroutine FEAM_PackParam(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! Delim call RegPack(Buf, InData%Delim) if (RegCheckErr(Buf, RoutineName)) return - ! GLUZR call RegPack(Buf, allocated(InData%GLUZR)) if (allocated(InData%GLUZR)) then call RegPackBounds(Buf, 3, lbound(InData%GLUZR), ubound(InData%GLUZR)) call RegPack(Buf, InData%GLUZR) end if if (RegCheckErr(Buf, RoutineName)) return - ! GTZER call RegPack(Buf, allocated(InData%GTZER)) if (allocated(InData%GTZER)) then call RegPackBounds(Buf, 2, lbound(InData%GTZER), ubound(InData%GTZER)) @@ -3337,31 +3056,22 @@ subroutine FEAM_UnPackParam(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! DT call RegUnpack(Buf, OutData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! GRAV call RegUnpack(Buf, OutData%GRAV) if (RegCheckErr(Buf, RoutineName)) return - ! Eps call RegUnpack(Buf, OutData%Eps) if (RegCheckErr(Buf, RoutineName)) return - ! Gravity call RegUnpack(Buf, OutData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDens call RegUnpack(Buf, OutData%WtrDens) if (RegCheckErr(Buf, RoutineName)) return - ! MaxIter call RegUnpack(Buf, OutData%MaxIter) if (RegCheckErr(Buf, RoutineName)) return - ! NHBD call RegUnpack(Buf, OutData%NHBD) if (RegCheckErr(Buf, RoutineName)) return - ! NDIM call RegUnpack(Buf, OutData%NDIM) if (RegCheckErr(Buf, RoutineName)) return - ! NEQ if (allocated(OutData%NEQ)) deallocate(OutData%NEQ) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3376,19 +3086,14 @@ subroutine FEAM_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%NEQ) if (RegCheckErr(Buf, RoutineName)) return end if - ! NBAND call RegUnpack(Buf, OutData%NBAND) if (RegCheckErr(Buf, RoutineName)) return - ! NumLines call RegUnpack(Buf, OutData%NumLines) if (RegCheckErr(Buf, RoutineName)) return - ! NumElems call RegUnpack(Buf, OutData%NumElems) if (RegCheckErr(Buf, RoutineName)) return - ! NumNodes call RegUnpack(Buf, OutData%NumNodes) if (RegCheckErr(Buf, RoutineName)) return - ! GSL if (allocated(OutData%GSL)) deallocate(OutData%GSL) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3403,7 +3108,6 @@ subroutine FEAM_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%GSL) if (RegCheckErr(Buf, RoutineName)) return end if - ! GP if (allocated(OutData%GP)) deallocate(OutData%GP) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3418,7 +3122,6 @@ subroutine FEAM_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%GP) if (RegCheckErr(Buf, RoutineName)) return end if - ! Elength if (allocated(OutData%Elength)) deallocate(OutData%Elength) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3433,7 +3136,6 @@ subroutine FEAM_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%Elength) if (RegCheckErr(Buf, RoutineName)) return end if - ! BottmElev if (allocated(OutData%BottmElev)) deallocate(OutData%BottmElev) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3448,7 +3150,6 @@ subroutine FEAM_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%BottmElev) if (RegCheckErr(Buf, RoutineName)) return end if - ! BottmStiff if (allocated(OutData%BottmStiff)) deallocate(OutData%BottmStiff) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3463,7 +3164,6 @@ subroutine FEAM_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%BottmStiff) if (RegCheckErr(Buf, RoutineName)) return end if - ! LMassDen if (allocated(OutData%LMassDen)) deallocate(OutData%LMassDen) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3478,7 +3178,6 @@ subroutine FEAM_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%LMassDen) if (RegCheckErr(Buf, RoutineName)) return end if - ! LDMassDen if (allocated(OutData%LDMassDen)) deallocate(OutData%LDMassDen) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3493,7 +3192,6 @@ subroutine FEAM_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%LDMassDen) if (RegCheckErr(Buf, RoutineName)) return end if - ! LEAStiff if (allocated(OutData%LEAStiff)) deallocate(OutData%LEAStiff) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3508,7 +3206,6 @@ subroutine FEAM_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%LEAStiff) if (RegCheckErr(Buf, RoutineName)) return end if - ! LineCI if (allocated(OutData%LineCI)) deallocate(OutData%LineCI) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3523,7 +3220,6 @@ subroutine FEAM_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%LineCI) if (RegCheckErr(Buf, RoutineName)) return end if - ! LineCD if (allocated(OutData%LineCD)) deallocate(OutData%LineCD) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3538,7 +3234,6 @@ subroutine FEAM_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%LineCD) if (RegCheckErr(Buf, RoutineName)) return end if - ! Bvp if (allocated(OutData%Bvp)) deallocate(OutData%Bvp) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3553,7 +3248,6 @@ subroutine FEAM_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%Bvp) if (RegCheckErr(Buf, RoutineName)) return end if - ! WaveAcc0 if (allocated(OutData%WaveAcc0)) deallocate(OutData%WaveAcc0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3568,7 +3262,6 @@ subroutine FEAM_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%WaveAcc0) if (RegCheckErr(Buf, RoutineName)) return end if - ! WaveTime if (allocated(OutData%WaveTime)) deallocate(OutData%WaveTime) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3583,7 +3276,6 @@ subroutine FEAM_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%WaveTime) if (RegCheckErr(Buf, RoutineName)) return end if - ! WaveVel0 if (allocated(OutData%WaveVel0)) deallocate(OutData%WaveVel0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3598,70 +3290,48 @@ subroutine FEAM_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%WaveVel0) if (RegCheckErr(Buf, RoutineName)) return end if - ! NStepWave call RegUnpack(Buf, OutData%NStepWave) if (RegCheckErr(Buf, RoutineName)) return - ! SHAP call RegUnpack(Buf, OutData%SHAP) if (RegCheckErr(Buf, RoutineName)) return - ! SHAPS call RegUnpack(Buf, OutData%SHAPS) if (RegCheckErr(Buf, RoutineName)) return - ! GAUSSW call RegUnpack(Buf, OutData%GAUSSW) if (RegCheckErr(Buf, RoutineName)) return - ! NGAUSS call RegUnpack(Buf, OutData%NGAUSS) if (RegCheckErr(Buf, RoutineName)) return - ! SHAPT call RegUnpack(Buf, OutData%SHAPT) if (RegCheckErr(Buf, RoutineName)) return - ! SHAPTS call RegUnpack(Buf, OutData%SHAPTS) if (RegCheckErr(Buf, RoutineName)) return - ! NTRAP call RegUnpack(Buf, OutData%NTRAP) if (RegCheckErr(Buf, RoutineName)) return - ! SBEND call RegUnpack(Buf, OutData%SBEND) if (RegCheckErr(Buf, RoutineName)) return - ! STEN call RegUnpack(Buf, OutData%STEN) if (RegCheckErr(Buf, RoutineName)) return - ! RMASS call RegUnpack(Buf, OutData%RMASS) if (RegCheckErr(Buf, RoutineName)) return - ! RADDM call RegUnpack(Buf, OutData%RADDM) if (RegCheckErr(Buf, RoutineName)) return - ! PMPN call RegUnpack(Buf, OutData%PMPN) if (RegCheckErr(Buf, RoutineName)) return - ! AM call RegUnpack(Buf, OutData%AM) if (RegCheckErr(Buf, RoutineName)) return - ! PM call RegUnpack(Buf, OutData%PM) if (RegCheckErr(Buf, RoutineName)) return - ! IDOF call RegUnpack(Buf, OutData%IDOF) if (RegCheckErr(Buf, RoutineName)) return - ! JDOF call RegUnpack(Buf, OutData%JDOF) if (RegCheckErr(Buf, RoutineName)) return - ! PPA call RegUnpack(Buf, OutData%PPA) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmRefzt call RegUnpack(Buf, OutData%PtfmRefzt) if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegUnpack(Buf, OutData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegUnpack(Buf, OutData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! OutParam if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3677,10 +3347,8 @@ subroutine FEAM_UnPackParam(Buf, OutData) call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam end do end if - ! Delim call RegUnpack(Buf, OutData%Delim) if (RegCheckErr(Buf, RoutineName)) return - ! GLUZR if (allocated(OutData%GLUZR)) deallocate(OutData%GLUZR) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3695,7 +3363,6 @@ subroutine FEAM_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%GLUZR) if (RegCheckErr(Buf, RoutineName)) return end if - ! GTZER if (allocated(OutData%GTZER)) deallocate(OutData%GTZER) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3711,57 +3378,44 @@ subroutine FEAM_UnPackParam(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE FEAM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FEAM_InputType), INTENT(INOUT) :: SrcInputData - TYPE(FEAM_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_CopyInput' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcInputData%HydroForceLineMesh, DstInputData%HydroForceLineMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcInputData%PtFairleadDisplacement, DstInputData%PtFairleadDisplacement, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE FEAM_CopyInput - SUBROUTINE FEAM_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(FEAM_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL MeshDestroy( InputData%HydroForceLineMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( InputData%PtFairleadDisplacement, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE FEAM_DestroyInput +subroutine FEAM_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(FEAM_InputType), intent(inout) :: SrcInputData + type(FEAM_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FEAM_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcInputData%HydroForceLineMesh, DstInputData%HydroForceLineMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcInputData%PtFairleadDisplacement, DstInputData%PtFairleadDisplacement, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine FEAM_DestroyInput(InputData, ErrStat, ErrMsg) + type(FEAM_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FEAM_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine FEAM_PackInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FEAM_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'FEAM_PackInput' if (Buf%ErrStat >= AbortErrLev) return - ! HydroForceLineMesh call MeshPack(Buf, InData%HydroForceLineMesh) if (RegCheckErr(Buf, RoutineName)) return - ! PtFairleadDisplacement call MeshPack(Buf, InData%PtFairleadDisplacement) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3771,85 +3425,71 @@ subroutine FEAM_UnPackInput(Buf, OutData) type(FEAM_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FEAM_UnPackInput' if (Buf%ErrStat /= ErrID_None) return - ! HydroForceLineMesh call MeshUnpack(Buf, OutData%HydroForceLineMesh) ! HydroForceLineMesh - ! PtFairleadDisplacement call MeshUnpack(Buf, OutData%PtFairleadDisplacement) ! PtFairleadDisplacement end subroutine - SUBROUTINE FEAM_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FEAM_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(FEAM_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_CopyOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%WriteOutput)) THEN - i1_l = LBOUND(SrcOutputData%WriteOutput,1) - i1_u = UBOUND(SrcOutputData%WriteOutput,1) - IF (.NOT. ALLOCATED(DstOutputData%WriteOutput)) THEN - ALLOCATE(DstOutputData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%WriteOutput = SrcOutputData%WriteOutput -ENDIF - CALL MeshCopy( SrcOutputData%PtFairleadLoad, DstOutputData%PtFairleadLoad, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcOutputData%LineMeshPosition, DstOutputData%LineMeshPosition, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE FEAM_CopyOutput - - SUBROUTINE FEAM_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(FEAM_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_DestroyOutput' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - CALL MeshDestroy( OutputData%PtFairleadLoad, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( OutputData%LineMeshPosition, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE FEAM_DestroyOutput +subroutine FEAM_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(FEAM_OutputType), intent(inout) :: SrcOutputData + type(FEAM_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FEAM_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%WriteOutput = SrcOutputData%WriteOutput + else if (allocated(DstOutputData%WriteOutput)) then + deallocate(DstOutputData%WriteOutput) + end if + call MeshCopy(SrcOutputData%PtFairleadLoad, DstOutputData%PtFairleadLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcOutputData%LineMeshPosition, DstOutputData%LineMeshPosition, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine FEAM_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(FEAM_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FEAM_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine subroutine FEAM_PackOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FEAM_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'FEAM_PackOutput' if (Buf%ErrStat >= AbortErrLev) return - ! WriteOutput call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) call RegPack(Buf, InData%WriteOutput) end if if (RegCheckErr(Buf, RoutineName)) return - ! PtFairleadLoad call MeshPack(Buf, InData%PtFairleadLoad) if (RegCheckErr(Buf, RoutineName)) return - ! LineMeshPosition call MeshPack(Buf, InData%LineMeshPosition) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3862,7 +3502,6 @@ subroutine FEAM_UnPackOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! WriteOutput if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3877,9 +3516,7 @@ subroutine FEAM_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutput) if (RegCheckErr(Buf, RoutineName)) return end if - ! PtFairleadLoad call MeshUnpack(Buf, OutData%PtFairleadLoad) ! PtFairleadLoad - ! LineMeshPosition call MeshUnpack(Buf, OutData%LineMeshPosition) ! LineMeshPosition end subroutine diff --git a/modules/hydrodyn/src/Conv_Radiation_Types.f90 b/modules/hydrodyn/src/Conv_Radiation_Types.f90 index 56f0fb430e..606d49f341 100644 --- a/modules/hydrodyn/src/Conv_Radiation_Types.f90 +++ b/modules/hydrodyn/src/Conv_Radiation_Types.f90 @@ -99,146 +99,122 @@ MODULE Conv_Radiation_Types END TYPE Conv_Rdtn_OutputType ! ======================= CONTAINS - SUBROUTINE Conv_Rdtn_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(Conv_Rdtn_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_CopyInitInput' -! + +subroutine Conv_Rdtn_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(Conv_Rdtn_InitInputType), intent(in) :: SrcInitInputData + type(Conv_Rdtn_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Conv_Rdtn_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%RdtnDT = SrcInitInputData%RdtnDT - DstInitInputData%RdtnDTChr = SrcInitInputData%RdtnDTChr - DstInitInputData%NBody = SrcInitInputData%NBody - DstInitInputData%HighFreq = SrcInitInputData%HighFreq - DstInitInputData%WAMITFile = SrcInitInputData%WAMITFile -IF (ALLOCATED(SrcInitInputData%HdroAddMs)) THEN - i1_l = LBOUND(SrcInitInputData%HdroAddMs,1) - i1_u = UBOUND(SrcInitInputData%HdroAddMs,1) - i2_l = LBOUND(SrcInitInputData%HdroAddMs,2) - i2_u = UBOUND(SrcInitInputData%HdroAddMs,2) - i3_l = LBOUND(SrcInitInputData%HdroAddMs,3) - i3_u = UBOUND(SrcInitInputData%HdroAddMs,3) - IF (.NOT. ALLOCATED(DstInitInputData%HdroAddMs)) THEN - ALLOCATE(DstInitInputData%HdroAddMs(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%HdroAddMs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%HdroAddMs = SrcInitInputData%HdroAddMs -ENDIF -IF (ALLOCATED(SrcInitInputData%HdroFreq)) THEN - i1_l = LBOUND(SrcInitInputData%HdroFreq,1) - i1_u = UBOUND(SrcInitInputData%HdroFreq,1) - IF (.NOT. ALLOCATED(DstInitInputData%HdroFreq)) THEN - ALLOCATE(DstInitInputData%HdroFreq(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%HdroFreq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%HdroFreq = SrcInitInputData%HdroFreq -ENDIF -IF (ALLOCATED(SrcInitInputData%HdroDmpng)) THEN - i1_l = LBOUND(SrcInitInputData%HdroDmpng,1) - i1_u = UBOUND(SrcInitInputData%HdroDmpng,1) - i2_l = LBOUND(SrcInitInputData%HdroDmpng,2) - i2_u = UBOUND(SrcInitInputData%HdroDmpng,2) - i3_l = LBOUND(SrcInitInputData%HdroDmpng,3) - i3_u = UBOUND(SrcInitInputData%HdroDmpng,3) - IF (.NOT. ALLOCATED(DstInitInputData%HdroDmpng)) THEN - ALLOCATE(DstInitInputData%HdroDmpng(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%HdroDmpng.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%HdroDmpng = SrcInitInputData%HdroDmpng -ENDIF - DstInitInputData%NInpFreq = SrcInitInputData%NInpFreq - DstInitInputData%RdtnTMax = SrcInitInputData%RdtnTMax - END SUBROUTINE Conv_Rdtn_CopyInitInput - - SUBROUTINE Conv_Rdtn_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitInputData%HdroAddMs)) THEN - DEALLOCATE(InitInputData%HdroAddMs) -ENDIF -IF (ALLOCATED(InitInputData%HdroFreq)) THEN - DEALLOCATE(InitInputData%HdroFreq) -ENDIF -IF (ALLOCATED(InitInputData%HdroDmpng)) THEN - DEALLOCATE(InitInputData%HdroDmpng) -ENDIF - END SUBROUTINE Conv_Rdtn_DestroyInitInput + ErrMsg = '' + DstInitInputData%RdtnDT = SrcInitInputData%RdtnDT + DstInitInputData%RdtnDTChr = SrcInitInputData%RdtnDTChr + DstInitInputData%NBody = SrcInitInputData%NBody + DstInitInputData%HighFreq = SrcInitInputData%HighFreq + DstInitInputData%WAMITFile = SrcInitInputData%WAMITFile + if (allocated(SrcInitInputData%HdroAddMs)) then + LB(1:3) = lbound(SrcInitInputData%HdroAddMs) + UB(1:3) = ubound(SrcInitInputData%HdroAddMs) + if (.not. allocated(DstInitInputData%HdroAddMs)) then + allocate(DstInitInputData%HdroAddMs(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%HdroAddMs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%HdroAddMs = SrcInitInputData%HdroAddMs + else if (allocated(DstInitInputData%HdroAddMs)) then + deallocate(DstInitInputData%HdroAddMs) + end if + if (allocated(SrcInitInputData%HdroFreq)) then + LB(1:1) = lbound(SrcInitInputData%HdroFreq) + UB(1:1) = ubound(SrcInitInputData%HdroFreq) + if (.not. allocated(DstInitInputData%HdroFreq)) then + allocate(DstInitInputData%HdroFreq(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%HdroFreq.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%HdroFreq = SrcInitInputData%HdroFreq + else if (allocated(DstInitInputData%HdroFreq)) then + deallocate(DstInitInputData%HdroFreq) + end if + if (allocated(SrcInitInputData%HdroDmpng)) then + LB(1:3) = lbound(SrcInitInputData%HdroDmpng) + UB(1:3) = ubound(SrcInitInputData%HdroDmpng) + if (.not. allocated(DstInitInputData%HdroDmpng)) then + allocate(DstInitInputData%HdroDmpng(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%HdroDmpng.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%HdroDmpng = SrcInitInputData%HdroDmpng + else if (allocated(DstInitInputData%HdroDmpng)) then + deallocate(DstInitInputData%HdroDmpng) + end if + DstInitInputData%NInpFreq = SrcInitInputData%NInpFreq + DstInitInputData%RdtnTMax = SrcInitInputData%RdtnTMax +end subroutine +subroutine Conv_Rdtn_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(Conv_Rdtn_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Conv_Rdtn_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitInputData%HdroAddMs)) then + deallocate(InitInputData%HdroAddMs) + end if + if (allocated(InitInputData%HdroFreq)) then + deallocate(InitInputData%HdroFreq) + end if + if (allocated(InitInputData%HdroDmpng)) then + deallocate(InitInputData%HdroDmpng) + end if +end subroutine subroutine Conv_Rdtn_PackInitInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Conv_Rdtn_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Conv_Rdtn_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return - ! RdtnDT call RegPack(Buf, InData%RdtnDT) if (RegCheckErr(Buf, RoutineName)) return - ! RdtnDTChr call RegPack(Buf, InData%RdtnDTChr) if (RegCheckErr(Buf, RoutineName)) return - ! NBody call RegPack(Buf, InData%NBody) if (RegCheckErr(Buf, RoutineName)) return - ! HighFreq call RegPack(Buf, InData%HighFreq) if (RegCheckErr(Buf, RoutineName)) return - ! WAMITFile call RegPack(Buf, InData%WAMITFile) if (RegCheckErr(Buf, RoutineName)) return - ! HdroAddMs call RegPack(Buf, allocated(InData%HdroAddMs)) if (allocated(InData%HdroAddMs)) then call RegPackBounds(Buf, 3, lbound(InData%HdroAddMs), ubound(InData%HdroAddMs)) call RegPack(Buf, InData%HdroAddMs) end if if (RegCheckErr(Buf, RoutineName)) return - ! HdroFreq call RegPack(Buf, allocated(InData%HdroFreq)) if (allocated(InData%HdroFreq)) then call RegPackBounds(Buf, 1, lbound(InData%HdroFreq), ubound(InData%HdroFreq)) call RegPack(Buf, InData%HdroFreq) end if if (RegCheckErr(Buf, RoutineName)) return - ! HdroDmpng call RegPack(Buf, allocated(InData%HdroDmpng)) if (allocated(InData%HdroDmpng)) then call RegPackBounds(Buf, 3, lbound(InData%HdroDmpng), ubound(InData%HdroDmpng)) call RegPack(Buf, InData%HdroDmpng) end if if (RegCheckErr(Buf, RoutineName)) return - ! NInpFreq call RegPack(Buf, InData%NInpFreq) if (RegCheckErr(Buf, RoutineName)) return - ! RdtnTMax call RegPack(Buf, InData%RdtnTMax) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -251,22 +227,16 @@ subroutine Conv_Rdtn_UnPackInitInput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! RdtnDT call RegUnpack(Buf, OutData%RdtnDT) if (RegCheckErr(Buf, RoutineName)) return - ! RdtnDTChr call RegUnpack(Buf, OutData%RdtnDTChr) if (RegCheckErr(Buf, RoutineName)) return - ! NBody call RegUnpack(Buf, OutData%NBody) if (RegCheckErr(Buf, RoutineName)) return - ! HighFreq call RegUnpack(Buf, OutData%HighFreq) if (RegCheckErr(Buf, RoutineName)) return - ! WAMITFile call RegUnpack(Buf, OutData%WAMITFile) if (RegCheckErr(Buf, RoutineName)) return - ! HdroAddMs if (allocated(OutData%HdroAddMs)) deallocate(OutData%HdroAddMs) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -281,7 +251,6 @@ subroutine Conv_Rdtn_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%HdroAddMs) if (RegCheckErr(Buf, RoutineName)) return end if - ! HdroFreq if (allocated(OutData%HdroFreq)) deallocate(OutData%HdroFreq) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -296,7 +265,6 @@ subroutine Conv_Rdtn_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%HdroFreq) if (RegCheckErr(Buf, RoutineName)) return end if - ! HdroDmpng if (allocated(OutData%HdroDmpng)) deallocate(OutData%HdroDmpng) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -311,52 +279,38 @@ subroutine Conv_Rdtn_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%HdroDmpng) if (RegCheckErr(Buf, RoutineName)) return end if - ! NInpFreq call RegUnpack(Buf, OutData%NInpFreq) if (RegCheckErr(Buf, RoutineName)) return - ! RdtnTMax call RegUnpack(Buf, OutData%RdtnTMax) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Conv_Rdtn_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(Conv_Rdtn_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_CopyInitOutput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitOutputData%DummyInitOut = SrcInitOutputData%DummyInitOut - END SUBROUTINE Conv_Rdtn_CopyInitOutput - - SUBROUTINE Conv_Rdtn_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_DestroyInitOutput' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Conv_Rdtn_DestroyInitOutput +subroutine Conv_Rdtn_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(Conv_Rdtn_InitOutputType), intent(in) :: SrcInitOutputData + type(Conv_Rdtn_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Conv_Rdtn_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitOutputData%DummyInitOut = SrcInitOutputData%DummyInitOut +end subroutine +subroutine Conv_Rdtn_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(Conv_Rdtn_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Conv_Rdtn_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine Conv_Rdtn_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Conv_Rdtn_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Conv_Rdtn_PackInitOutput' if (Buf%ErrStat >= AbortErrLev) return - ! DummyInitOut call RegPack(Buf, InData%DummyInitOut) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -366,49 +320,36 @@ subroutine Conv_Rdtn_UnPackInitOutput(Buf, OutData) type(Conv_Rdtn_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackInitOutput' if (Buf%ErrStat /= ErrID_None) return - ! DummyInitOut call RegUnpack(Buf, OutData%DummyInitOut) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Conv_Rdtn_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(Conv_Rdtn_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%DummyContState = SrcContStateData%DummyContState - END SUBROUTINE Conv_Rdtn_CopyContState - - SUBROUTINE Conv_Rdtn_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_DestroyContState' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Conv_Rdtn_DestroyContState +subroutine Conv_Rdtn_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(Conv_Rdtn_ContinuousStateType), intent(in) :: SrcContStateData + type(Conv_Rdtn_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Conv_Rdtn_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + DstContStateData%DummyContState = SrcContStateData%DummyContState +end subroutine +subroutine Conv_Rdtn_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(Conv_Rdtn_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Conv_Rdtn_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine Conv_Rdtn_PackContState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Conv_Rdtn_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'Conv_Rdtn_PackContState' if (Buf%ErrStat >= AbortErrLev) return - ! DummyContState call RegPack(Buf, InData%DummyContState) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -418,75 +359,61 @@ subroutine Conv_Rdtn_UnPackContState(Buf, OutData) type(Conv_Rdtn_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackContState' if (Buf%ErrStat /= ErrID_None) return - ! DummyContState call RegUnpack(Buf, OutData%DummyContState) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Conv_Rdtn_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(Conv_Rdtn_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_CopyDiscState' -! + +subroutine Conv_Rdtn_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(Conv_Rdtn_DiscreteStateType), intent(in) :: SrcDiscStateData + type(Conv_Rdtn_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Conv_Rdtn_CopyDiscState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcDiscStateData%XDHistory)) THEN - i1_l = LBOUND(SrcDiscStateData%XDHistory,1) - i1_u = UBOUND(SrcDiscStateData%XDHistory,1) - i2_l = LBOUND(SrcDiscStateData%XDHistory,2) - i2_u = UBOUND(SrcDiscStateData%XDHistory,2) - IF (.NOT. ALLOCATED(DstDiscStateData%XDHistory)) THEN - ALLOCATE(DstDiscStateData%XDHistory(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%XDHistory.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%XDHistory = SrcDiscStateData%XDHistory -ENDIF - DstDiscStateData%LastTime = SrcDiscStateData%LastTime - END SUBROUTINE Conv_Rdtn_CopyDiscState - - SUBROUTINE Conv_Rdtn_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(DiscStateData%XDHistory)) THEN - DEALLOCATE(DiscStateData%XDHistory) -ENDIF - END SUBROUTINE Conv_Rdtn_DestroyDiscState + ErrMsg = '' + if (allocated(SrcDiscStateData%XDHistory)) then + LB(1:2) = lbound(SrcDiscStateData%XDHistory) + UB(1:2) = ubound(SrcDiscStateData%XDHistory) + if (.not. allocated(DstDiscStateData%XDHistory)) then + allocate(DstDiscStateData%XDHistory(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%XDHistory.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%XDHistory = SrcDiscStateData%XDHistory + else if (allocated(DstDiscStateData%XDHistory)) then + deallocate(DstDiscStateData%XDHistory) + end if + DstDiscStateData%LastTime = SrcDiscStateData%LastTime +end subroutine +subroutine Conv_Rdtn_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(Conv_Rdtn_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Conv_Rdtn_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(DiscStateData%XDHistory)) then + deallocate(DiscStateData%XDHistory) + end if +end subroutine subroutine Conv_Rdtn_PackDiscState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Conv_Rdtn_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'Conv_Rdtn_PackDiscState' if (Buf%ErrStat >= AbortErrLev) return - ! XDHistory call RegPack(Buf, allocated(InData%XDHistory)) if (allocated(InData%XDHistory)) then call RegPackBounds(Buf, 2, lbound(InData%XDHistory), ubound(InData%XDHistory)) call RegPack(Buf, InData%XDHistory) end if if (RegCheckErr(Buf, RoutineName)) return - ! LastTime call RegPack(Buf, InData%LastTime) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -499,7 +426,6 @@ subroutine Conv_Rdtn_UnPackDiscState(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! XDHistory if (allocated(OutData%XDHistory)) deallocate(OutData%XDHistory) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -514,49 +440,36 @@ subroutine Conv_Rdtn_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%XDHistory) if (RegCheckErr(Buf, RoutineName)) return end if - ! LastTime call RegUnpack(Buf, OutData%LastTime) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Conv_Rdtn_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(Conv_Rdtn_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE Conv_Rdtn_CopyConstrState - - SUBROUTINE Conv_Rdtn_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_DestroyConstrState' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Conv_Rdtn_DestroyConstrState +subroutine Conv_Rdtn_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(Conv_Rdtn_ConstraintStateType), intent(in) :: SrcConstrStateData + type(Conv_Rdtn_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Conv_Rdtn_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine +subroutine Conv_Rdtn_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(Conv_Rdtn_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Conv_Rdtn_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine Conv_Rdtn_PackConstrState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Conv_Rdtn_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'Conv_Rdtn_PackConstrState' if (Buf%ErrStat >= AbortErrLev) return - ! DummyConstrState call RegPack(Buf, InData%DummyConstrState) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -566,49 +479,36 @@ subroutine Conv_Rdtn_UnPackConstrState(Buf, OutData) type(Conv_Rdtn_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackConstrState' if (Buf%ErrStat /= ErrID_None) return - ! DummyConstrState call RegUnpack(Buf, OutData%DummyConstrState) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Conv_Rdtn_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(Conv_Rdtn_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%IndRdtn = SrcOtherStateData%IndRdtn - END SUBROUTINE Conv_Rdtn_CopyOtherState - - SUBROUTINE Conv_Rdtn_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_DestroyOtherState' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Conv_Rdtn_DestroyOtherState +subroutine Conv_Rdtn_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(Conv_Rdtn_OtherStateType), intent(in) :: SrcOtherStateData + type(Conv_Rdtn_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Conv_Rdtn_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%IndRdtn = SrcOtherStateData%IndRdtn +end subroutine +subroutine Conv_Rdtn_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(Conv_Rdtn_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Conv_Rdtn_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine Conv_Rdtn_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Conv_Rdtn_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'Conv_Rdtn_PackOtherState' if (Buf%ErrStat >= AbortErrLev) return - ! IndRdtn call RegPack(Buf, InData%IndRdtn) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -618,49 +518,36 @@ subroutine Conv_Rdtn_UnPackOtherState(Buf, OutData) type(Conv_Rdtn_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackOtherState' if (Buf%ErrStat /= ErrID_None) return - ! IndRdtn call RegUnpack(Buf, OutData%IndRdtn) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Conv_Rdtn_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(Conv_Rdtn_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%LastIndRdtn = SrcMiscData%LastIndRdtn - END SUBROUTINE Conv_Rdtn_CopyMisc - - SUBROUTINE Conv_Rdtn_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE Conv_Rdtn_DestroyMisc +subroutine Conv_Rdtn_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(Conv_Rdtn_MiscVarType), intent(in) :: SrcMiscData + type(Conv_Rdtn_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Conv_Rdtn_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%LastIndRdtn = SrcMiscData%LastIndRdtn +end subroutine +subroutine Conv_Rdtn_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(Conv_Rdtn_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Conv_Rdtn_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine Conv_Rdtn_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Conv_Rdtn_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'Conv_Rdtn_PackMisc' if (Buf%ErrStat >= AbortErrLev) return - ! LastIndRdtn call RegPack(Buf, InData%LastIndRdtn) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -670,94 +557,73 @@ subroutine Conv_Rdtn_UnPackMisc(Buf, OutData) type(Conv_Rdtn_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackMisc' if (Buf%ErrStat /= ErrID_None) return - ! LastIndRdtn call RegUnpack(Buf, OutData%LastIndRdtn) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Conv_Rdtn_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_ParameterType), INTENT(IN) :: SrcParamData - TYPE(Conv_Rdtn_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_CopyParam' -! + +subroutine Conv_Rdtn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(Conv_Rdtn_ParameterType), intent(in) :: SrcParamData + type(Conv_Rdtn_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Conv_Rdtn_CopyParam' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT - DstParamData%RdtnDT = SrcParamData%RdtnDT - DstParamData%NBody = SrcParamData%NBody -IF (ALLOCATED(SrcParamData%RdtnKrnl)) THEN - i1_l = LBOUND(SrcParamData%RdtnKrnl,1) - i1_u = UBOUND(SrcParamData%RdtnKrnl,1) - i2_l = LBOUND(SrcParamData%RdtnKrnl,2) - i2_u = UBOUND(SrcParamData%RdtnKrnl,2) - i3_l = LBOUND(SrcParamData%RdtnKrnl,3) - i3_u = UBOUND(SrcParamData%RdtnKrnl,3) - IF (.NOT. ALLOCATED(DstParamData%RdtnKrnl)) THEN - ALLOCATE(DstParamData%RdtnKrnl(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%RdtnKrnl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%RdtnKrnl = SrcParamData%RdtnKrnl -ENDIF - DstParamData%NStepRdtn = SrcParamData%NStepRdtn - DstParamData%NStepRdtn1 = SrcParamData%NStepRdtn1 - END SUBROUTINE Conv_Rdtn_CopyParam - - SUBROUTINE Conv_Rdtn_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%RdtnKrnl)) THEN - DEALLOCATE(ParamData%RdtnKrnl) -ENDIF - END SUBROUTINE Conv_Rdtn_DestroyParam + ErrMsg = '' + DstParamData%DT = SrcParamData%DT + DstParamData%RdtnDT = SrcParamData%RdtnDT + DstParamData%NBody = SrcParamData%NBody + if (allocated(SrcParamData%RdtnKrnl)) then + LB(1:3) = lbound(SrcParamData%RdtnKrnl) + UB(1:3) = ubound(SrcParamData%RdtnKrnl) + if (.not. allocated(DstParamData%RdtnKrnl)) then + allocate(DstParamData%RdtnKrnl(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%RdtnKrnl.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%RdtnKrnl = SrcParamData%RdtnKrnl + else if (allocated(DstParamData%RdtnKrnl)) then + deallocate(DstParamData%RdtnKrnl) + end if + DstParamData%NStepRdtn = SrcParamData%NStepRdtn + DstParamData%NStepRdtn1 = SrcParamData%NStepRdtn1 +end subroutine +subroutine Conv_Rdtn_DestroyParam(ParamData, ErrStat, ErrMsg) + type(Conv_Rdtn_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Conv_Rdtn_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%RdtnKrnl)) then + deallocate(ParamData%RdtnKrnl) + end if +end subroutine subroutine Conv_Rdtn_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Conv_Rdtn_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'Conv_Rdtn_PackParam' if (Buf%ErrStat >= AbortErrLev) return - ! DT call RegPack(Buf, InData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! RdtnDT call RegPack(Buf, InData%RdtnDT) if (RegCheckErr(Buf, RoutineName)) return - ! NBody call RegPack(Buf, InData%NBody) if (RegCheckErr(Buf, RoutineName)) return - ! RdtnKrnl call RegPack(Buf, allocated(InData%RdtnKrnl)) if (allocated(InData%RdtnKrnl)) then call RegPackBounds(Buf, 3, lbound(InData%RdtnKrnl), ubound(InData%RdtnKrnl)) call RegPack(Buf, InData%RdtnKrnl) end if if (RegCheckErr(Buf, RoutineName)) return - ! NStepRdtn call RegPack(Buf, InData%NStepRdtn) if (RegCheckErr(Buf, RoutineName)) return - ! NStepRdtn1 call RegPack(Buf, InData%NStepRdtn1) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -770,16 +636,12 @@ subroutine Conv_Rdtn_UnPackParam(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! DT call RegUnpack(Buf, OutData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! RdtnDT call RegUnpack(Buf, OutData%RdtnDT) if (RegCheckErr(Buf, RoutineName)) return - ! NBody call RegUnpack(Buf, OutData%NBody) if (RegCheckErr(Buf, RoutineName)) return - ! RdtnKrnl if (allocated(OutData%RdtnKrnl)) deallocate(OutData%RdtnKrnl) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -794,67 +656,56 @@ subroutine Conv_Rdtn_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%RdtnKrnl) if (RegCheckErr(Buf, RoutineName)) return end if - ! NStepRdtn call RegUnpack(Buf, OutData%NStepRdtn) if (RegCheckErr(Buf, RoutineName)) return - ! NStepRdtn1 call RegUnpack(Buf, OutData%NStepRdtn1) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Conv_Rdtn_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_InputType), INTENT(IN) :: SrcInputData - TYPE(Conv_Rdtn_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_CopyInput' -! + +subroutine Conv_Rdtn_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(Conv_Rdtn_InputType), intent(in) :: SrcInputData + type(Conv_Rdtn_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Conv_Rdtn_CopyInput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInputData%Velocity)) THEN - i1_l = LBOUND(SrcInputData%Velocity,1) - i1_u = UBOUND(SrcInputData%Velocity,1) - IF (.NOT. ALLOCATED(DstInputData%Velocity)) THEN - ALLOCATE(DstInputData%Velocity(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Velocity.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%Velocity = SrcInputData%Velocity -ENDIF - END SUBROUTINE Conv_Rdtn_CopyInput - - SUBROUTINE Conv_Rdtn_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputData%Velocity)) THEN - DEALLOCATE(InputData%Velocity) -ENDIF - END SUBROUTINE Conv_Rdtn_DestroyInput + ErrMsg = '' + if (allocated(SrcInputData%Velocity)) then + LB(1:1) = lbound(SrcInputData%Velocity) + UB(1:1) = ubound(SrcInputData%Velocity) + if (.not. allocated(DstInputData%Velocity)) then + allocate(DstInputData%Velocity(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Velocity.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%Velocity = SrcInputData%Velocity + else if (allocated(DstInputData%Velocity)) then + deallocate(DstInputData%Velocity) + end if +end subroutine +subroutine Conv_Rdtn_DestroyInput(InputData, ErrStat, ErrMsg) + type(Conv_Rdtn_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Conv_Rdtn_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%Velocity)) then + deallocate(InputData%Velocity) + end if +end subroutine subroutine Conv_Rdtn_PackInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Conv_Rdtn_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Conv_Rdtn_PackInput' if (Buf%ErrStat >= AbortErrLev) return - ! Velocity call RegPack(Buf, allocated(InData%Velocity)) if (allocated(InData%Velocity)) then call RegPackBounds(Buf, 1, lbound(InData%Velocity), ubound(InData%Velocity)) @@ -871,7 +722,6 @@ subroutine Conv_Rdtn_UnPackInput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! Velocity if (allocated(OutData%Velocity)) deallocate(OutData%Velocity) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -887,60 +737,51 @@ subroutine Conv_Rdtn_UnPackInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE Conv_Rdtn_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_OutputType), INTENT(IN) :: SrcOutputData - TYPE(Conv_Rdtn_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_CopyOutput' -! + +subroutine Conv_Rdtn_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(Conv_Rdtn_OutputType), intent(in) :: SrcOutputData + type(Conv_Rdtn_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Conv_Rdtn_CopyOutput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%F_Rdtn)) THEN - i1_l = LBOUND(SrcOutputData%F_Rdtn,1) - i1_u = UBOUND(SrcOutputData%F_Rdtn,1) - IF (.NOT. ALLOCATED(DstOutputData%F_Rdtn)) THEN - ALLOCATE(DstOutputData%F_Rdtn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%F_Rdtn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%F_Rdtn = SrcOutputData%F_Rdtn -ENDIF - END SUBROUTINE Conv_Rdtn_CopyOutput - - SUBROUTINE Conv_Rdtn_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(Conv_Rdtn_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OutputData%F_Rdtn)) THEN - DEALLOCATE(OutputData%F_Rdtn) -ENDIF - END SUBROUTINE Conv_Rdtn_DestroyOutput + ErrMsg = '' + if (allocated(SrcOutputData%F_Rdtn)) then + LB(1:1) = lbound(SrcOutputData%F_Rdtn) + UB(1:1) = ubound(SrcOutputData%F_Rdtn) + if (.not. allocated(DstOutputData%F_Rdtn)) then + allocate(DstOutputData%F_Rdtn(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%F_Rdtn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%F_Rdtn = SrcOutputData%F_Rdtn + else if (allocated(DstOutputData%F_Rdtn)) then + deallocate(DstOutputData%F_Rdtn) + end if +end subroutine +subroutine Conv_Rdtn_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(Conv_Rdtn_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Conv_Rdtn_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%F_Rdtn)) then + deallocate(OutputData%F_Rdtn) + end if +end subroutine subroutine Conv_Rdtn_PackOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Conv_Rdtn_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Conv_Rdtn_PackOutput' if (Buf%ErrStat >= AbortErrLev) return - ! F_Rdtn call RegPack(Buf, allocated(InData%F_Rdtn)) if (allocated(InData%F_Rdtn)) then call RegPackBounds(Buf, 1, lbound(InData%F_Rdtn), ubound(InData%F_Rdtn)) @@ -957,7 +798,6 @@ subroutine Conv_Rdtn_UnPackOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! F_Rdtn if (allocated(OutData%F_Rdtn)) deallocate(OutData%F_Rdtn) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index a8f4756bc8..253e475695 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -234,484 +234,448 @@ MODULE HydroDyn_Types END TYPE HydroDyn_OutputType ! ======================= CONTAINS - SUBROUTINE HydroDyn_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HydroDyn_InputFile), INTENT(IN) :: SrcInputFileData - TYPE(HydroDyn_InputFile), INTENT(INOUT) :: DstInputFileData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_CopyInputFile' -! + +subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) + type(HydroDyn_InputFile), intent(in) :: SrcInputFileData + type(HydroDyn_InputFile), intent(inout) :: DstInputFileData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_CopyInputFile' ErrStat = ErrID_None - ErrMsg = "" - DstInputFileData%EchoFlag = SrcInputFileData%EchoFlag -IF (ALLOCATED(SrcInputFileData%AddF0)) THEN - i1_l = LBOUND(SrcInputFileData%AddF0,1) - i1_u = UBOUND(SrcInputFileData%AddF0,1) - i2_l = LBOUND(SrcInputFileData%AddF0,2) - i2_u = UBOUND(SrcInputFileData%AddF0,2) - IF (.NOT. ALLOCATED(DstInputFileData%AddF0)) THEN - ALLOCATE(DstInputFileData%AddF0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%AddF0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%AddF0 = SrcInputFileData%AddF0 -ENDIF -IF (ALLOCATED(SrcInputFileData%AddCLin)) THEN - i1_l = LBOUND(SrcInputFileData%AddCLin,1) - i1_u = UBOUND(SrcInputFileData%AddCLin,1) - i2_l = LBOUND(SrcInputFileData%AddCLin,2) - i2_u = UBOUND(SrcInputFileData%AddCLin,2) - i3_l = LBOUND(SrcInputFileData%AddCLin,3) - i3_u = UBOUND(SrcInputFileData%AddCLin,3) - IF (.NOT. ALLOCATED(DstInputFileData%AddCLin)) THEN - ALLOCATE(DstInputFileData%AddCLin(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%AddCLin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%AddCLin = SrcInputFileData%AddCLin -ENDIF -IF (ALLOCATED(SrcInputFileData%AddBLin)) THEN - i1_l = LBOUND(SrcInputFileData%AddBLin,1) - i1_u = UBOUND(SrcInputFileData%AddBLin,1) - i2_l = LBOUND(SrcInputFileData%AddBLin,2) - i2_u = UBOUND(SrcInputFileData%AddBLin,2) - i3_l = LBOUND(SrcInputFileData%AddBLin,3) - i3_u = UBOUND(SrcInputFileData%AddBLin,3) - IF (.NOT. ALLOCATED(DstInputFileData%AddBLin)) THEN - ALLOCATE(DstInputFileData%AddBLin(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%AddBLin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%AddBLin = SrcInputFileData%AddBLin -ENDIF -IF (ALLOCATED(SrcInputFileData%AddBQuad)) THEN - i1_l = LBOUND(SrcInputFileData%AddBQuad,1) - i1_u = UBOUND(SrcInputFileData%AddBQuad,1) - i2_l = LBOUND(SrcInputFileData%AddBQuad,2) - i2_u = UBOUND(SrcInputFileData%AddBQuad,2) - i3_l = LBOUND(SrcInputFileData%AddBQuad,3) - i3_u = UBOUND(SrcInputFileData%AddBQuad,3) - IF (.NOT. ALLOCATED(DstInputFileData%AddBQuad)) THEN - ALLOCATE(DstInputFileData%AddBQuad(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%AddBQuad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%AddBQuad = SrcInputFileData%AddBQuad -ENDIF - CALL SeaSt_CopyInitInput( SrcInputFileData%SeaState, DstInputFileData%SeaState, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInputFileData%PotFile)) THEN - i1_l = LBOUND(SrcInputFileData%PotFile,1) - i1_u = UBOUND(SrcInputFileData%PotFile,1) - IF (.NOT. ALLOCATED(DstInputFileData%PotFile)) THEN - ALLOCATE(DstInputFileData%PotFile(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PotFile.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%PotFile = SrcInputFileData%PotFile -ENDIF - DstInputFileData%nWAMITObj = SrcInputFileData%nWAMITObj - DstInputFileData%vecMultiplier = SrcInputFileData%vecMultiplier - DstInputFileData%NBody = SrcInputFileData%NBody - DstInputFileData%NBodyMod = SrcInputFileData%NBodyMod -IF (ALLOCATED(SrcInputFileData%PtfmVol0)) THEN - i1_l = LBOUND(SrcInputFileData%PtfmVol0,1) - i1_u = UBOUND(SrcInputFileData%PtfmVol0,1) - IF (.NOT. ALLOCATED(DstInputFileData%PtfmVol0)) THEN - ALLOCATE(DstInputFileData%PtfmVol0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PtfmVol0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%PtfmVol0 = SrcInputFileData%PtfmVol0 -ENDIF - DstInputFileData%HasWAMIT = SrcInputFileData%HasWAMIT -IF (ALLOCATED(SrcInputFileData%WAMITULEN)) THEN - i1_l = LBOUND(SrcInputFileData%WAMITULEN,1) - i1_u = UBOUND(SrcInputFileData%WAMITULEN,1) - IF (.NOT. ALLOCATED(DstInputFileData%WAMITULEN)) THEN - ALLOCATE(DstInputFileData%WAMITULEN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WAMITULEN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%WAMITULEN = SrcInputFileData%WAMITULEN -ENDIF -IF (ALLOCATED(SrcInputFileData%PtfmRefxt)) THEN - i1_l = LBOUND(SrcInputFileData%PtfmRefxt,1) - i1_u = UBOUND(SrcInputFileData%PtfmRefxt,1) - IF (.NOT. ALLOCATED(DstInputFileData%PtfmRefxt)) THEN - ALLOCATE(DstInputFileData%PtfmRefxt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PtfmRefxt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%PtfmRefxt = SrcInputFileData%PtfmRefxt -ENDIF -IF (ALLOCATED(SrcInputFileData%PtfmRefyt)) THEN - i1_l = LBOUND(SrcInputFileData%PtfmRefyt,1) - i1_u = UBOUND(SrcInputFileData%PtfmRefyt,1) - IF (.NOT. ALLOCATED(DstInputFileData%PtfmRefyt)) THEN - ALLOCATE(DstInputFileData%PtfmRefyt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PtfmRefyt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%PtfmRefyt = SrcInputFileData%PtfmRefyt -ENDIF -IF (ALLOCATED(SrcInputFileData%PtfmRefzt)) THEN - i1_l = LBOUND(SrcInputFileData%PtfmRefzt,1) - i1_u = UBOUND(SrcInputFileData%PtfmRefzt,1) - IF (.NOT. ALLOCATED(DstInputFileData%PtfmRefzt)) THEN - ALLOCATE(DstInputFileData%PtfmRefzt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PtfmRefzt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%PtfmRefzt = SrcInputFileData%PtfmRefzt -ENDIF -IF (ALLOCATED(SrcInputFileData%PtfmRefztRot)) THEN - i1_l = LBOUND(SrcInputFileData%PtfmRefztRot,1) - i1_u = UBOUND(SrcInputFileData%PtfmRefztRot,1) - IF (.NOT. ALLOCATED(DstInputFileData%PtfmRefztRot)) THEN - ALLOCATE(DstInputFileData%PtfmRefztRot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PtfmRefztRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%PtfmRefztRot = SrcInputFileData%PtfmRefztRot -ENDIF -IF (ALLOCATED(SrcInputFileData%PtfmCOBxt)) THEN - i1_l = LBOUND(SrcInputFileData%PtfmCOBxt,1) - i1_u = UBOUND(SrcInputFileData%PtfmCOBxt,1) - IF (.NOT. ALLOCATED(DstInputFileData%PtfmCOBxt)) THEN - ALLOCATE(DstInputFileData%PtfmCOBxt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PtfmCOBxt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%PtfmCOBxt = SrcInputFileData%PtfmCOBxt -ENDIF -IF (ALLOCATED(SrcInputFileData%PtfmCOByt)) THEN - i1_l = LBOUND(SrcInputFileData%PtfmCOByt,1) - i1_u = UBOUND(SrcInputFileData%PtfmCOByt,1) - IF (.NOT. ALLOCATED(DstInputFileData%PtfmCOByt)) THEN - ALLOCATE(DstInputFileData%PtfmCOByt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PtfmCOByt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%PtfmCOByt = SrcInputFileData%PtfmCOByt -ENDIF - CALL WAMIT_CopyInitInput( SrcInputFileData%WAMIT, DstInputFileData%WAMIT, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL WAMIT2_CopyInitInput( SrcInputFileData%WAMIT2, DstInputFileData%WAMIT2, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Morison_CopyInitInput( SrcInputFileData%Morison, DstInputFileData%Morison, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInputFileData%Echo = SrcInputFileData%Echo - DstInputFileData%PotMod = SrcInputFileData%PotMod - DstInputFileData%NUserOutputs = SrcInputFileData%NUserOutputs -IF (ALLOCATED(SrcInputFileData%UserOutputs)) THEN - i1_l = LBOUND(SrcInputFileData%UserOutputs,1) - i1_u = UBOUND(SrcInputFileData%UserOutputs,1) - IF (.NOT. ALLOCATED(DstInputFileData%UserOutputs)) THEN - ALLOCATE(DstInputFileData%UserOutputs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%UserOutputs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%UserOutputs = SrcInputFileData%UserOutputs -ENDIF - DstInputFileData%OutSwtch = SrcInputFileData%OutSwtch - DstInputFileData%OutAll = SrcInputFileData%OutAll - DstInputFileData%NumOuts = SrcInputFileData%NumOuts -IF (ALLOCATED(SrcInputFileData%OutList)) THEN - i1_l = LBOUND(SrcInputFileData%OutList,1) - i1_u = UBOUND(SrcInputFileData%OutList,1) - IF (.NOT. ALLOCATED(DstInputFileData%OutList)) THEN - ALLOCATE(DstInputFileData%OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%OutList = SrcInputFileData%OutList -ENDIF - DstInputFileData%HDSum = SrcInputFileData%HDSum - DstInputFileData%UnSum = SrcInputFileData%UnSum - DstInputFileData%OutFmt = SrcInputFileData%OutFmt - DstInputFileData%OutSFmt = SrcInputFileData%OutSFmt - END SUBROUTINE HydroDyn_CopyInputFile - - SUBROUTINE HydroDyn_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) - TYPE(HydroDyn_InputFile), INTENT(INOUT) :: InputFileData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyInputFile' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputFileData%AddF0)) THEN - DEALLOCATE(InputFileData%AddF0) -ENDIF -IF (ALLOCATED(InputFileData%AddCLin)) THEN - DEALLOCATE(InputFileData%AddCLin) -ENDIF -IF (ALLOCATED(InputFileData%AddBLin)) THEN - DEALLOCATE(InputFileData%AddBLin) -ENDIF -IF (ALLOCATED(InputFileData%AddBQuad)) THEN - DEALLOCATE(InputFileData%AddBQuad) -ENDIF - CALL SeaSt_DestroyInitInput( InputFileData%SeaState, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InputFileData%PotFile)) THEN - DEALLOCATE(InputFileData%PotFile) -ENDIF -IF (ALLOCATED(InputFileData%PtfmVol0)) THEN - DEALLOCATE(InputFileData%PtfmVol0) -ENDIF -IF (ALLOCATED(InputFileData%WAMITULEN)) THEN - DEALLOCATE(InputFileData%WAMITULEN) -ENDIF -IF (ALLOCATED(InputFileData%PtfmRefxt)) THEN - DEALLOCATE(InputFileData%PtfmRefxt) -ENDIF -IF (ALLOCATED(InputFileData%PtfmRefyt)) THEN - DEALLOCATE(InputFileData%PtfmRefyt) -ENDIF -IF (ALLOCATED(InputFileData%PtfmRefzt)) THEN - DEALLOCATE(InputFileData%PtfmRefzt) -ENDIF -IF (ALLOCATED(InputFileData%PtfmRefztRot)) THEN - DEALLOCATE(InputFileData%PtfmRefztRot) -ENDIF -IF (ALLOCATED(InputFileData%PtfmCOBxt)) THEN - DEALLOCATE(InputFileData%PtfmCOBxt) -ENDIF -IF (ALLOCATED(InputFileData%PtfmCOByt)) THEN - DEALLOCATE(InputFileData%PtfmCOByt) -ENDIF - CALL WAMIT_DestroyInitInput( InputFileData%WAMIT, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL WAMIT2_DestroyInitInput( InputFileData%WAMIT2, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Morison_DestroyInitInput( InputFileData%Morison, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InputFileData%UserOutputs)) THEN - DEALLOCATE(InputFileData%UserOutputs) -ENDIF -IF (ALLOCATED(InputFileData%OutList)) THEN - DEALLOCATE(InputFileData%OutList) -ENDIF - END SUBROUTINE HydroDyn_DestroyInputFile + ErrMsg = '' + DstInputFileData%EchoFlag = SrcInputFileData%EchoFlag + if (allocated(SrcInputFileData%AddF0)) then + LB(1:2) = lbound(SrcInputFileData%AddF0) + UB(1:2) = ubound(SrcInputFileData%AddF0) + if (.not. allocated(DstInputFileData%AddF0)) then + allocate(DstInputFileData%AddF0(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%AddF0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%AddF0 = SrcInputFileData%AddF0 + else if (allocated(DstInputFileData%AddF0)) then + deallocate(DstInputFileData%AddF0) + end if + if (allocated(SrcInputFileData%AddCLin)) then + LB(1:3) = lbound(SrcInputFileData%AddCLin) + UB(1:3) = ubound(SrcInputFileData%AddCLin) + if (.not. allocated(DstInputFileData%AddCLin)) then + allocate(DstInputFileData%AddCLin(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%AddCLin.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%AddCLin = SrcInputFileData%AddCLin + else if (allocated(DstInputFileData%AddCLin)) then + deallocate(DstInputFileData%AddCLin) + end if + if (allocated(SrcInputFileData%AddBLin)) then + LB(1:3) = lbound(SrcInputFileData%AddBLin) + UB(1:3) = ubound(SrcInputFileData%AddBLin) + if (.not. allocated(DstInputFileData%AddBLin)) then + allocate(DstInputFileData%AddBLin(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%AddBLin.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%AddBLin = SrcInputFileData%AddBLin + else if (allocated(DstInputFileData%AddBLin)) then + deallocate(DstInputFileData%AddBLin) + end if + if (allocated(SrcInputFileData%AddBQuad)) then + LB(1:3) = lbound(SrcInputFileData%AddBQuad) + UB(1:3) = ubound(SrcInputFileData%AddBQuad) + if (.not. allocated(DstInputFileData%AddBQuad)) then + allocate(DstInputFileData%AddBQuad(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%AddBQuad.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%AddBQuad = SrcInputFileData%AddBQuad + else if (allocated(DstInputFileData%AddBQuad)) then + deallocate(DstInputFileData%AddBQuad) + end if + call SeaSt_CopyInitInput(SrcInputFileData%SeaState, DstInputFileData%SeaState, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInputFileData%PotFile)) then + LB(1:1) = lbound(SrcInputFileData%PotFile) + UB(1:1) = ubound(SrcInputFileData%PotFile) + if (.not. allocated(DstInputFileData%PotFile)) then + allocate(DstInputFileData%PotFile(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PotFile.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%PotFile = SrcInputFileData%PotFile + else if (allocated(DstInputFileData%PotFile)) then + deallocate(DstInputFileData%PotFile) + end if + DstInputFileData%nWAMITObj = SrcInputFileData%nWAMITObj + DstInputFileData%vecMultiplier = SrcInputFileData%vecMultiplier + DstInputFileData%NBody = SrcInputFileData%NBody + DstInputFileData%NBodyMod = SrcInputFileData%NBodyMod + if (allocated(SrcInputFileData%PtfmVol0)) then + LB(1:1) = lbound(SrcInputFileData%PtfmVol0) + UB(1:1) = ubound(SrcInputFileData%PtfmVol0) + if (.not. allocated(DstInputFileData%PtfmVol0)) then + allocate(DstInputFileData%PtfmVol0(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PtfmVol0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%PtfmVol0 = SrcInputFileData%PtfmVol0 + else if (allocated(DstInputFileData%PtfmVol0)) then + deallocate(DstInputFileData%PtfmVol0) + end if + DstInputFileData%HasWAMIT = SrcInputFileData%HasWAMIT + if (allocated(SrcInputFileData%WAMITULEN)) then + LB(1:1) = lbound(SrcInputFileData%WAMITULEN) + UB(1:1) = ubound(SrcInputFileData%WAMITULEN) + if (.not. allocated(DstInputFileData%WAMITULEN)) then + allocate(DstInputFileData%WAMITULEN(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WAMITULEN.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%WAMITULEN = SrcInputFileData%WAMITULEN + else if (allocated(DstInputFileData%WAMITULEN)) then + deallocate(DstInputFileData%WAMITULEN) + end if + if (allocated(SrcInputFileData%PtfmRefxt)) then + LB(1:1) = lbound(SrcInputFileData%PtfmRefxt) + UB(1:1) = ubound(SrcInputFileData%PtfmRefxt) + if (.not. allocated(DstInputFileData%PtfmRefxt)) then + allocate(DstInputFileData%PtfmRefxt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PtfmRefxt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%PtfmRefxt = SrcInputFileData%PtfmRefxt + else if (allocated(DstInputFileData%PtfmRefxt)) then + deallocate(DstInputFileData%PtfmRefxt) + end if + if (allocated(SrcInputFileData%PtfmRefyt)) then + LB(1:1) = lbound(SrcInputFileData%PtfmRefyt) + UB(1:1) = ubound(SrcInputFileData%PtfmRefyt) + if (.not. allocated(DstInputFileData%PtfmRefyt)) then + allocate(DstInputFileData%PtfmRefyt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PtfmRefyt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%PtfmRefyt = SrcInputFileData%PtfmRefyt + else if (allocated(DstInputFileData%PtfmRefyt)) then + deallocate(DstInputFileData%PtfmRefyt) + end if + if (allocated(SrcInputFileData%PtfmRefzt)) then + LB(1:1) = lbound(SrcInputFileData%PtfmRefzt) + UB(1:1) = ubound(SrcInputFileData%PtfmRefzt) + if (.not. allocated(DstInputFileData%PtfmRefzt)) then + allocate(DstInputFileData%PtfmRefzt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PtfmRefzt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%PtfmRefzt = SrcInputFileData%PtfmRefzt + else if (allocated(DstInputFileData%PtfmRefzt)) then + deallocate(DstInputFileData%PtfmRefzt) + end if + if (allocated(SrcInputFileData%PtfmRefztRot)) then + LB(1:1) = lbound(SrcInputFileData%PtfmRefztRot) + UB(1:1) = ubound(SrcInputFileData%PtfmRefztRot) + if (.not. allocated(DstInputFileData%PtfmRefztRot)) then + allocate(DstInputFileData%PtfmRefztRot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PtfmRefztRot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%PtfmRefztRot = SrcInputFileData%PtfmRefztRot + else if (allocated(DstInputFileData%PtfmRefztRot)) then + deallocate(DstInputFileData%PtfmRefztRot) + end if + if (allocated(SrcInputFileData%PtfmCOBxt)) then + LB(1:1) = lbound(SrcInputFileData%PtfmCOBxt) + UB(1:1) = ubound(SrcInputFileData%PtfmCOBxt) + if (.not. allocated(DstInputFileData%PtfmCOBxt)) then + allocate(DstInputFileData%PtfmCOBxt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PtfmCOBxt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%PtfmCOBxt = SrcInputFileData%PtfmCOBxt + else if (allocated(DstInputFileData%PtfmCOBxt)) then + deallocate(DstInputFileData%PtfmCOBxt) + end if + if (allocated(SrcInputFileData%PtfmCOByt)) then + LB(1:1) = lbound(SrcInputFileData%PtfmCOByt) + UB(1:1) = ubound(SrcInputFileData%PtfmCOByt) + if (.not. allocated(DstInputFileData%PtfmCOByt)) then + allocate(DstInputFileData%PtfmCOByt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PtfmCOByt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%PtfmCOByt = SrcInputFileData%PtfmCOByt + else if (allocated(DstInputFileData%PtfmCOByt)) then + deallocate(DstInputFileData%PtfmCOByt) + end if + call WAMIT_CopyInitInput(SrcInputFileData%WAMIT, DstInputFileData%WAMIT, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call WAMIT2_CopyInitInput(SrcInputFileData%WAMIT2, DstInputFileData%WAMIT2, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Morison_CopyInitInput(SrcInputFileData%Morison, DstInputFileData%Morison, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInputFileData%Echo = SrcInputFileData%Echo + DstInputFileData%PotMod = SrcInputFileData%PotMod + DstInputFileData%NUserOutputs = SrcInputFileData%NUserOutputs + if (allocated(SrcInputFileData%UserOutputs)) then + LB(1:1) = lbound(SrcInputFileData%UserOutputs) + UB(1:1) = ubound(SrcInputFileData%UserOutputs) + if (.not. allocated(DstInputFileData%UserOutputs)) then + allocate(DstInputFileData%UserOutputs(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%UserOutputs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%UserOutputs = SrcInputFileData%UserOutputs + else if (allocated(DstInputFileData%UserOutputs)) then + deallocate(DstInputFileData%UserOutputs) + end if + DstInputFileData%OutSwtch = SrcInputFileData%OutSwtch + DstInputFileData%OutAll = SrcInputFileData%OutAll + DstInputFileData%NumOuts = SrcInputFileData%NumOuts + if (allocated(SrcInputFileData%OutList)) then + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) + if (.not. allocated(DstInputFileData%OutList)) then + allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%OutList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%OutList = SrcInputFileData%OutList + else if (allocated(DstInputFileData%OutList)) then + deallocate(DstInputFileData%OutList) + end if + DstInputFileData%HDSum = SrcInputFileData%HDSum + DstInputFileData%UnSum = SrcInputFileData%UnSum + DstInputFileData%OutFmt = SrcInputFileData%OutFmt + DstInputFileData%OutSFmt = SrcInputFileData%OutSFmt +end subroutine +subroutine HydroDyn_DestroyInputFile(InputFileData, ErrStat, ErrMsg) + type(HydroDyn_InputFile), intent(inout) :: InputFileData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_DestroyInputFile' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputFileData%AddF0)) then + deallocate(InputFileData%AddF0) + end if + if (allocated(InputFileData%AddCLin)) then + deallocate(InputFileData%AddCLin) + end if + if (allocated(InputFileData%AddBLin)) then + deallocate(InputFileData%AddBLin) + end if + if (allocated(InputFileData%AddBQuad)) then + deallocate(InputFileData%AddBQuad) + end if + if (allocated(InputFileData%PotFile)) then + deallocate(InputFileData%PotFile) + end if + if (allocated(InputFileData%PtfmVol0)) then + deallocate(InputFileData%PtfmVol0) + end if + if (allocated(InputFileData%WAMITULEN)) then + deallocate(InputFileData%WAMITULEN) + end if + if (allocated(InputFileData%PtfmRefxt)) then + deallocate(InputFileData%PtfmRefxt) + end if + if (allocated(InputFileData%PtfmRefyt)) then + deallocate(InputFileData%PtfmRefyt) + end if + if (allocated(InputFileData%PtfmRefzt)) then + deallocate(InputFileData%PtfmRefzt) + end if + if (allocated(InputFileData%PtfmRefztRot)) then + deallocate(InputFileData%PtfmRefztRot) + end if + if (allocated(InputFileData%PtfmCOBxt)) then + deallocate(InputFileData%PtfmCOBxt) + end if + if (allocated(InputFileData%PtfmCOByt)) then + deallocate(InputFileData%PtfmCOByt) + end if + if (allocated(InputFileData%UserOutputs)) then + deallocate(InputFileData%UserOutputs) + end if + if (allocated(InputFileData%OutList)) then + deallocate(InputFileData%OutList) + end if +end subroutine subroutine HydroDyn_PackInputFile(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(HydroDyn_InputFile), intent(in) :: InData character(*), parameter :: RoutineName = 'HydroDyn_PackInputFile' if (Buf%ErrStat >= AbortErrLev) return - ! EchoFlag call RegPack(Buf, InData%EchoFlag) if (RegCheckErr(Buf, RoutineName)) return - ! AddF0 call RegPack(Buf, allocated(InData%AddF0)) if (allocated(InData%AddF0)) then call RegPackBounds(Buf, 2, lbound(InData%AddF0), ubound(InData%AddF0)) call RegPack(Buf, InData%AddF0) end if if (RegCheckErr(Buf, RoutineName)) return - ! AddCLin call RegPack(Buf, allocated(InData%AddCLin)) if (allocated(InData%AddCLin)) then call RegPackBounds(Buf, 3, lbound(InData%AddCLin), ubound(InData%AddCLin)) call RegPack(Buf, InData%AddCLin) end if if (RegCheckErr(Buf, RoutineName)) return - ! AddBLin call RegPack(Buf, allocated(InData%AddBLin)) if (allocated(InData%AddBLin)) then call RegPackBounds(Buf, 3, lbound(InData%AddBLin), ubound(InData%AddBLin)) call RegPack(Buf, InData%AddBLin) end if if (RegCheckErr(Buf, RoutineName)) return - ! AddBQuad call RegPack(Buf, allocated(InData%AddBQuad)) if (allocated(InData%AddBQuad)) then call RegPackBounds(Buf, 3, lbound(InData%AddBQuad), ubound(InData%AddBQuad)) call RegPack(Buf, InData%AddBQuad) end if if (RegCheckErr(Buf, RoutineName)) return - ! SeaState call SeaSt_PackInitInput(Buf, InData%SeaState) if (RegCheckErr(Buf, RoutineName)) return - ! PotFile call RegPack(Buf, allocated(InData%PotFile)) if (allocated(InData%PotFile)) then call RegPackBounds(Buf, 1, lbound(InData%PotFile), ubound(InData%PotFile)) call RegPack(Buf, InData%PotFile) end if if (RegCheckErr(Buf, RoutineName)) return - ! nWAMITObj call RegPack(Buf, InData%nWAMITObj) if (RegCheckErr(Buf, RoutineName)) return - ! vecMultiplier call RegPack(Buf, InData%vecMultiplier) if (RegCheckErr(Buf, RoutineName)) return - ! NBody call RegPack(Buf, InData%NBody) if (RegCheckErr(Buf, RoutineName)) return - ! NBodyMod call RegPack(Buf, InData%NBodyMod) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmVol0 call RegPack(Buf, allocated(InData%PtfmVol0)) if (allocated(InData%PtfmVol0)) then call RegPackBounds(Buf, 1, lbound(InData%PtfmVol0), ubound(InData%PtfmVol0)) call RegPack(Buf, InData%PtfmVol0) end if if (RegCheckErr(Buf, RoutineName)) return - ! HasWAMIT call RegPack(Buf, InData%HasWAMIT) if (RegCheckErr(Buf, RoutineName)) return - ! WAMITULEN call RegPack(Buf, allocated(InData%WAMITULEN)) if (allocated(InData%WAMITULEN)) then call RegPackBounds(Buf, 1, lbound(InData%WAMITULEN), ubound(InData%WAMITULEN)) call RegPack(Buf, InData%WAMITULEN) end if if (RegCheckErr(Buf, RoutineName)) return - ! PtfmRefxt call RegPack(Buf, allocated(InData%PtfmRefxt)) if (allocated(InData%PtfmRefxt)) then call RegPackBounds(Buf, 1, lbound(InData%PtfmRefxt), ubound(InData%PtfmRefxt)) call RegPack(Buf, InData%PtfmRefxt) end if if (RegCheckErr(Buf, RoutineName)) return - ! PtfmRefyt call RegPack(Buf, allocated(InData%PtfmRefyt)) if (allocated(InData%PtfmRefyt)) then call RegPackBounds(Buf, 1, lbound(InData%PtfmRefyt), ubound(InData%PtfmRefyt)) call RegPack(Buf, InData%PtfmRefyt) end if if (RegCheckErr(Buf, RoutineName)) return - ! PtfmRefzt call RegPack(Buf, allocated(InData%PtfmRefzt)) if (allocated(InData%PtfmRefzt)) then call RegPackBounds(Buf, 1, lbound(InData%PtfmRefzt), ubound(InData%PtfmRefzt)) call RegPack(Buf, InData%PtfmRefzt) end if if (RegCheckErr(Buf, RoutineName)) return - ! PtfmRefztRot call RegPack(Buf, allocated(InData%PtfmRefztRot)) if (allocated(InData%PtfmRefztRot)) then call RegPackBounds(Buf, 1, lbound(InData%PtfmRefztRot), ubound(InData%PtfmRefztRot)) call RegPack(Buf, InData%PtfmRefztRot) end if if (RegCheckErr(Buf, RoutineName)) return - ! PtfmCOBxt call RegPack(Buf, allocated(InData%PtfmCOBxt)) if (allocated(InData%PtfmCOBxt)) then call RegPackBounds(Buf, 1, lbound(InData%PtfmCOBxt), ubound(InData%PtfmCOBxt)) call RegPack(Buf, InData%PtfmCOBxt) end if if (RegCheckErr(Buf, RoutineName)) return - ! PtfmCOByt call RegPack(Buf, allocated(InData%PtfmCOByt)) if (allocated(InData%PtfmCOByt)) then call RegPackBounds(Buf, 1, lbound(InData%PtfmCOByt), ubound(InData%PtfmCOByt)) call RegPack(Buf, InData%PtfmCOByt) end if if (RegCheckErr(Buf, RoutineName)) return - ! WAMIT call WAMIT_PackInitInput(Buf, InData%WAMIT) if (RegCheckErr(Buf, RoutineName)) return - ! WAMIT2 call WAMIT2_PackInitInput(Buf, InData%WAMIT2) if (RegCheckErr(Buf, RoutineName)) return - ! Morison call Morison_PackInitInput(Buf, InData%Morison) if (RegCheckErr(Buf, RoutineName)) return - ! Echo call RegPack(Buf, InData%Echo) if (RegCheckErr(Buf, RoutineName)) return - ! PotMod call RegPack(Buf, InData%PotMod) if (RegCheckErr(Buf, RoutineName)) return - ! NUserOutputs call RegPack(Buf, InData%NUserOutputs) if (RegCheckErr(Buf, RoutineName)) return - ! UserOutputs call RegPack(Buf, allocated(InData%UserOutputs)) if (allocated(InData%UserOutputs)) then call RegPackBounds(Buf, 1, lbound(InData%UserOutputs), ubound(InData%UserOutputs)) call RegPack(Buf, InData%UserOutputs) end if if (RegCheckErr(Buf, RoutineName)) return - ! OutSwtch call RegPack(Buf, InData%OutSwtch) if (RegCheckErr(Buf, RoutineName)) return - ! OutAll call RegPack(Buf, InData%OutAll) if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegPack(Buf, InData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! OutList call RegPack(Buf, allocated(InData%OutList)) if (allocated(InData%OutList)) then call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) call RegPack(Buf, InData%OutList) end if if (RegCheckErr(Buf, RoutineName)) return - ! HDSum call RegPack(Buf, InData%HDSum) if (RegCheckErr(Buf, RoutineName)) return - ! UnSum call RegPack(Buf, InData%UnSum) if (RegCheckErr(Buf, RoutineName)) return - ! OutFmt call RegPack(Buf, InData%OutFmt) if (RegCheckErr(Buf, RoutineName)) return - ! OutSFmt call RegPack(Buf, InData%OutSFmt) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -724,10 +688,8 @@ subroutine HydroDyn_UnPackInputFile(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! EchoFlag call RegUnpack(Buf, OutData%EchoFlag) if (RegCheckErr(Buf, RoutineName)) return - ! AddF0 if (allocated(OutData%AddF0)) deallocate(OutData%AddF0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -742,7 +704,6 @@ subroutine HydroDyn_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%AddF0) if (RegCheckErr(Buf, RoutineName)) return end if - ! AddCLin if (allocated(OutData%AddCLin)) deallocate(OutData%AddCLin) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -757,7 +718,6 @@ subroutine HydroDyn_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%AddCLin) if (RegCheckErr(Buf, RoutineName)) return end if - ! AddBLin if (allocated(OutData%AddBLin)) deallocate(OutData%AddBLin) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -772,7 +732,6 @@ subroutine HydroDyn_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%AddBLin) if (RegCheckErr(Buf, RoutineName)) return end if - ! AddBQuad if (allocated(OutData%AddBQuad)) deallocate(OutData%AddBQuad) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -787,9 +746,7 @@ subroutine HydroDyn_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%AddBQuad) if (RegCheckErr(Buf, RoutineName)) return end if - ! SeaState call SeaSt_UnpackInitInput(Buf, OutData%SeaState) ! SeaState - ! PotFile if (allocated(OutData%PotFile)) deallocate(OutData%PotFile) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -804,19 +761,14 @@ subroutine HydroDyn_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%PotFile) if (RegCheckErr(Buf, RoutineName)) return end if - ! nWAMITObj call RegUnpack(Buf, OutData%nWAMITObj) if (RegCheckErr(Buf, RoutineName)) return - ! vecMultiplier call RegUnpack(Buf, OutData%vecMultiplier) if (RegCheckErr(Buf, RoutineName)) return - ! NBody call RegUnpack(Buf, OutData%NBody) if (RegCheckErr(Buf, RoutineName)) return - ! NBodyMod call RegUnpack(Buf, OutData%NBodyMod) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmVol0 if (allocated(OutData%PtfmVol0)) deallocate(OutData%PtfmVol0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -831,10 +783,8 @@ subroutine HydroDyn_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%PtfmVol0) if (RegCheckErr(Buf, RoutineName)) return end if - ! HasWAMIT call RegUnpack(Buf, OutData%HasWAMIT) if (RegCheckErr(Buf, RoutineName)) return - ! WAMITULEN if (allocated(OutData%WAMITULEN)) deallocate(OutData%WAMITULEN) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -849,7 +799,6 @@ subroutine HydroDyn_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%WAMITULEN) if (RegCheckErr(Buf, RoutineName)) return end if - ! PtfmRefxt if (allocated(OutData%PtfmRefxt)) deallocate(OutData%PtfmRefxt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -864,7 +813,6 @@ subroutine HydroDyn_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%PtfmRefxt) if (RegCheckErr(Buf, RoutineName)) return end if - ! PtfmRefyt if (allocated(OutData%PtfmRefyt)) deallocate(OutData%PtfmRefyt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -879,7 +827,6 @@ subroutine HydroDyn_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%PtfmRefyt) if (RegCheckErr(Buf, RoutineName)) return end if - ! PtfmRefzt if (allocated(OutData%PtfmRefzt)) deallocate(OutData%PtfmRefzt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -894,7 +841,6 @@ subroutine HydroDyn_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%PtfmRefzt) if (RegCheckErr(Buf, RoutineName)) return end if - ! PtfmRefztRot if (allocated(OutData%PtfmRefztRot)) deallocate(OutData%PtfmRefztRot) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -909,7 +855,6 @@ subroutine HydroDyn_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%PtfmRefztRot) if (RegCheckErr(Buf, RoutineName)) return end if - ! PtfmCOBxt if (allocated(OutData%PtfmCOBxt)) deallocate(OutData%PtfmCOBxt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -924,7 +869,6 @@ subroutine HydroDyn_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%PtfmCOBxt) if (RegCheckErr(Buf, RoutineName)) return end if - ! PtfmCOByt if (allocated(OutData%PtfmCOByt)) deallocate(OutData%PtfmCOByt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -939,22 +883,15 @@ subroutine HydroDyn_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%PtfmCOByt) if (RegCheckErr(Buf, RoutineName)) return end if - ! WAMIT call WAMIT_UnpackInitInput(Buf, OutData%WAMIT) ! WAMIT - ! WAMIT2 call WAMIT2_UnpackInitInput(Buf, OutData%WAMIT2) ! WAMIT2 - ! Morison call Morison_UnpackInitInput(Buf, OutData%Morison) ! Morison - ! Echo call RegUnpack(Buf, OutData%Echo) if (RegCheckErr(Buf, RoutineName)) return - ! PotMod call RegUnpack(Buf, OutData%PotMod) if (RegCheckErr(Buf, RoutineName)) return - ! NUserOutputs call RegUnpack(Buf, OutData%NUserOutputs) if (RegCheckErr(Buf, RoutineName)) return - ! UserOutputs if (allocated(OutData%UserOutputs)) deallocate(OutData%UserOutputs) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -969,16 +906,12 @@ subroutine HydroDyn_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%UserOutputs) if (RegCheckErr(Buf, RoutineName)) return end if - ! OutSwtch call RegUnpack(Buf, OutData%OutSwtch) if (RegCheckErr(Buf, RoutineName)) return - ! OutAll call RegUnpack(Buf, OutData%OutAll) if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegUnpack(Buf, OutData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! OutList if (allocated(OutData%OutList)) deallocate(OutData%OutList) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -993,124 +926,109 @@ subroutine HydroDyn_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%OutList) if (RegCheckErr(Buf, RoutineName)) return end if - ! HDSum call RegUnpack(Buf, OutData%HDSum) if (RegCheckErr(Buf, RoutineName)) return - ! UnSum call RegUnpack(Buf, OutData%UnSum) if (RegCheckErr(Buf, RoutineName)) return - ! OutFmt call RegUnpack(Buf, OutData%OutFmt) if (RegCheckErr(Buf, RoutineName)) return - ! OutSFmt call RegUnpack(Buf, OutData%OutSFmt) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE HydroDyn_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HydroDyn_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(HydroDyn_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_CopyInitInput' -! + +subroutine HydroDyn_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(HydroDyn_InitInputType), intent(in) :: SrcInitInputData + type(HydroDyn_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFile = SrcInitInputData%InputFile - DstInitInputData%UseInputFile = SrcInitInputData%UseInputFile - CALL NWTC_Library_Copyfileinfotype( SrcInitInputData%PassedFileData, DstInitInputData%PassedFileData, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitInputData%OutRootName = SrcInitInputData%OutRootName - DstInitInputData%Linearize = SrcInitInputData%Linearize - DstInitInputData%Gravity = SrcInitInputData%Gravity - DstInitInputData%WtrDens = SrcInitInputData%WtrDens - DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth - DstInitInputData%MSL2SWL = SrcInitInputData%MSL2SWL - DstInitInputData%TMax = SrcInitInputData%TMax - DstInitInputData%PtfmLocationX = SrcInitInputData%PtfmLocationX - DstInitInputData%PtfmLocationY = SrcInitInputData%PtfmLocationY - DstInitInputData%NStepWave = SrcInitInputData%NStepWave - DstInitInputData%NStepWave2 = SrcInitInputData%NStepWave2 - DstInitInputData%RhoXg = SrcInitInputData%RhoXg - DstInitInputData%WaveMod = SrcInitInputData%WaveMod - DstInitInputData%WaveStMod = SrcInitInputData%WaveStMod - DstInitInputData%WaveDirMod = SrcInitInputData%WaveDirMod - DstInitInputData%WvLowCOff = SrcInitInputData%WvLowCOff - DstInitInputData%WvHiCOff = SrcInitInputData%WvHiCOff - DstInitInputData%WvLowCOffD = SrcInitInputData%WvLowCOffD - DstInitInputData%WvHiCOffD = SrcInitInputData%WvHiCOffD - DstInitInputData%WvLowCOffS = SrcInitInputData%WvLowCOffS - DstInitInputData%WvHiCOffS = SrcInitInputData%WvHiCOffS - DstInitInputData%InvalidWithSSExctn = SrcInitInputData%InvalidWithSSExctn -IF (ALLOCATED(SrcInitInputData%WaveElev0)) THEN - i1_l = LBOUND(SrcInitInputData%WaveElev0,1) - i1_u = UBOUND(SrcInitInputData%WaveElev0,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveElev0)) THEN - ALLOCATE(DstInitInputData%WaveElev0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElev0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveElev0 = SrcInitInputData%WaveElev0 -ENDIF -IF (ALLOCATED(SrcInitInputData%WaveElevC)) THEN - i1_l = LBOUND(SrcInitInputData%WaveElevC,1) - i1_u = UBOUND(SrcInitInputData%WaveElevC,1) - i2_l = LBOUND(SrcInitInputData%WaveElevC,2) - i2_u = UBOUND(SrcInitInputData%WaveElevC,2) - i3_l = LBOUND(SrcInitInputData%WaveElevC,3) - i3_u = UBOUND(SrcInitInputData%WaveElevC,3) - IF (.NOT. ALLOCATED(DstInitInputData%WaveElevC)) THEN - ALLOCATE(DstInitInputData%WaveElevC(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElevC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveElevC = SrcInitInputData%WaveElevC -ENDIF - DstInitInputData%WaveDirMin = SrcInitInputData%WaveDirMin - DstInitInputData%WaveDirMax = SrcInitInputData%WaveDirMax - DstInitInputData%WaveDir = SrcInitInputData%WaveDir - DstInitInputData%WaveMultiDir = SrcInitInputData%WaveMultiDir - DstInitInputData%WaveDOmega = SrcInitInputData%WaveDOmega - DstInitInputData%MCFD = SrcInitInputData%MCFD - DstInitInputData%WaveField => SrcInitInputData%WaveField - END SUBROUTINE HydroDyn_CopyInitInput - - SUBROUTINE HydroDyn_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(HydroDyn_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL NWTC_Library_DestroyFileInfoType( InitInputData%PassedFileData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitInputData%WaveElev0)) THEN - DEALLOCATE(InitInputData%WaveElev0) -ENDIF -IF (ALLOCATED(InitInputData%WaveElevC)) THEN - DEALLOCATE(InitInputData%WaveElevC) -ENDIF -NULLIFY(InitInputData%WaveField) - END SUBROUTINE HydroDyn_DestroyInitInput + ErrMsg = '' + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%UseInputFile = SrcInitInputData%UseInputFile + call NWTC_Library_CopyFileInfoType(SrcInitInputData%PassedFileData, DstInitInputData%PassedFileData, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitInputData%OutRootName = SrcInitInputData%OutRootName + DstInitInputData%Linearize = SrcInitInputData%Linearize + DstInitInputData%Gravity = SrcInitInputData%Gravity + DstInitInputData%WtrDens = SrcInitInputData%WtrDens + DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth + DstInitInputData%MSL2SWL = SrcInitInputData%MSL2SWL + DstInitInputData%TMax = SrcInitInputData%TMax + DstInitInputData%PtfmLocationX = SrcInitInputData%PtfmLocationX + DstInitInputData%PtfmLocationY = SrcInitInputData%PtfmLocationY + DstInitInputData%NStepWave = SrcInitInputData%NStepWave + DstInitInputData%NStepWave2 = SrcInitInputData%NStepWave2 + DstInitInputData%RhoXg = SrcInitInputData%RhoXg + DstInitInputData%WaveMod = SrcInitInputData%WaveMod + DstInitInputData%WaveStMod = SrcInitInputData%WaveStMod + DstInitInputData%WaveDirMod = SrcInitInputData%WaveDirMod + DstInitInputData%WvLowCOff = SrcInitInputData%WvLowCOff + DstInitInputData%WvHiCOff = SrcInitInputData%WvHiCOff + DstInitInputData%WvLowCOffD = SrcInitInputData%WvLowCOffD + DstInitInputData%WvHiCOffD = SrcInitInputData%WvHiCOffD + DstInitInputData%WvLowCOffS = SrcInitInputData%WvLowCOffS + DstInitInputData%WvHiCOffS = SrcInitInputData%WvHiCOffS + DstInitInputData%InvalidWithSSExctn = SrcInitInputData%InvalidWithSSExctn + if (allocated(SrcInitInputData%WaveElev0)) then + LB(1:1) = lbound(SrcInitInputData%WaveElev0) + UB(1:1) = ubound(SrcInitInputData%WaveElev0) + if (.not. allocated(DstInitInputData%WaveElev0)) then + allocate(DstInitInputData%WaveElev0(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElev0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%WaveElev0 = SrcInitInputData%WaveElev0 + else if (allocated(DstInitInputData%WaveElev0)) then + deallocate(DstInitInputData%WaveElev0) + end if + if (allocated(SrcInitInputData%WaveElevC)) then + LB(1:3) = lbound(SrcInitInputData%WaveElevC) + UB(1:3) = ubound(SrcInitInputData%WaveElevC) + if (.not. allocated(DstInitInputData%WaveElevC)) then + allocate(DstInitInputData%WaveElevC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElevC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%WaveElevC = SrcInitInputData%WaveElevC + else if (allocated(DstInitInputData%WaveElevC)) then + deallocate(DstInitInputData%WaveElevC) + end if + DstInitInputData%WaveDirMin = SrcInitInputData%WaveDirMin + DstInitInputData%WaveDirMax = SrcInitInputData%WaveDirMax + DstInitInputData%WaveDir = SrcInitInputData%WaveDir + DstInitInputData%WaveMultiDir = SrcInitInputData%WaveMultiDir + DstInitInputData%WaveDOmega = SrcInitInputData%WaveDOmega + DstInitInputData%MCFD = SrcInitInputData%MCFD + DstInitInputData%WaveField => SrcInitInputData%WaveField +end subroutine +subroutine HydroDyn_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(HydroDyn_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitInputData%WaveElev0)) then + deallocate(InitInputData%WaveElev0) + end if + if (allocated(InitInputData%WaveElevC)) then + deallocate(InitInputData%WaveElevC) + end if + nullify(InitInputData%WaveField) +end subroutine subroutine HydroDyn_PackInitInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -1118,114 +1036,80 @@ subroutine HydroDyn_PackInitInput(Buf, Indata) character(*), parameter :: RoutineName = 'HydroDyn_PackInitInput' logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return - ! InputFile call RegPack(Buf, InData%InputFile) if (RegCheckErr(Buf, RoutineName)) return - ! UseInputFile call RegPack(Buf, InData%UseInputFile) if (RegCheckErr(Buf, RoutineName)) return - ! PassedFileData call NWTC_Library_PackFileInfoType(Buf, InData%PassedFileData) if (RegCheckErr(Buf, RoutineName)) return - ! OutRootName call RegPack(Buf, InData%OutRootName) if (RegCheckErr(Buf, RoutineName)) return - ! Linearize call RegPack(Buf, InData%Linearize) if (RegCheckErr(Buf, RoutineName)) return - ! Gravity call RegPack(Buf, InData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDens call RegPack(Buf, InData%WtrDens) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDpth call RegPack(Buf, InData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - ! MSL2SWL call RegPack(Buf, InData%MSL2SWL) if (RegCheckErr(Buf, RoutineName)) return - ! TMax call RegPack(Buf, InData%TMax) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmLocationX call RegPack(Buf, InData%PtfmLocationX) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmLocationY call RegPack(Buf, InData%PtfmLocationY) if (RegCheckErr(Buf, RoutineName)) return - ! NStepWave call RegPack(Buf, InData%NStepWave) if (RegCheckErr(Buf, RoutineName)) return - ! NStepWave2 call RegPack(Buf, InData%NStepWave2) if (RegCheckErr(Buf, RoutineName)) return - ! RhoXg call RegPack(Buf, InData%RhoXg) if (RegCheckErr(Buf, RoutineName)) return - ! WaveMod call RegPack(Buf, InData%WaveMod) if (RegCheckErr(Buf, RoutineName)) return - ! WaveStMod call RegPack(Buf, InData%WaveStMod) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDirMod call RegPack(Buf, InData%WaveDirMod) if (RegCheckErr(Buf, RoutineName)) return - ! WvLowCOff call RegPack(Buf, InData%WvLowCOff) if (RegCheckErr(Buf, RoutineName)) return - ! WvHiCOff call RegPack(Buf, InData%WvHiCOff) if (RegCheckErr(Buf, RoutineName)) return - ! WvLowCOffD call RegPack(Buf, InData%WvLowCOffD) if (RegCheckErr(Buf, RoutineName)) return - ! WvHiCOffD call RegPack(Buf, InData%WvHiCOffD) if (RegCheckErr(Buf, RoutineName)) return - ! WvLowCOffS call RegPack(Buf, InData%WvLowCOffS) if (RegCheckErr(Buf, RoutineName)) return - ! WvHiCOffS call RegPack(Buf, InData%WvHiCOffS) if (RegCheckErr(Buf, RoutineName)) return - ! InvalidWithSSExctn call RegPack(Buf, InData%InvalidWithSSExctn) if (RegCheckErr(Buf, RoutineName)) return - ! WaveElev0 call RegPack(Buf, allocated(InData%WaveElev0)) if (allocated(InData%WaveElev0)) then call RegPackBounds(Buf, 1, lbound(InData%WaveElev0), ubound(InData%WaveElev0)) call RegPack(Buf, InData%WaveElev0) end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveElevC call RegPack(Buf, allocated(InData%WaveElevC)) if (allocated(InData%WaveElevC)) then call RegPackBounds(Buf, 3, lbound(InData%WaveElevC), ubound(InData%WaveElevC)) call RegPack(Buf, InData%WaveElevC) end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveDirMin call RegPack(Buf, InData%WaveDirMin) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDirMax call RegPack(Buf, InData%WaveDirMax) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDir call RegPack(Buf, InData%WaveDir) if (RegCheckErr(Buf, RoutineName)) return - ! WaveMultiDir call RegPack(Buf, InData%WaveMultiDir) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDOmega call RegPack(Buf, InData%WaveDOmega) if (RegCheckErr(Buf, RoutineName)) return - ! MCFD call RegPack(Buf, InData%MCFD) if (RegCheckErr(Buf, RoutineName)) return - ! WaveField call RegPack(Buf, associated(InData%WaveField)) if (associated(InData%WaveField)) then call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) @@ -1246,81 +1130,55 @@ subroutine HydroDyn_UnPackInitInput(Buf, OutData) integer(IntKi) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return - ! InputFile call RegUnpack(Buf, OutData%InputFile) if (RegCheckErr(Buf, RoutineName)) return - ! UseInputFile call RegUnpack(Buf, OutData%UseInputFile) if (RegCheckErr(Buf, RoutineName)) return - ! PassedFileData call NWTC_Library_UnpackFileInfoType(Buf, OutData%PassedFileData) ! PassedFileData - ! OutRootName call RegUnpack(Buf, OutData%OutRootName) if (RegCheckErr(Buf, RoutineName)) return - ! Linearize call RegUnpack(Buf, OutData%Linearize) if (RegCheckErr(Buf, RoutineName)) return - ! Gravity call RegUnpack(Buf, OutData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDens call RegUnpack(Buf, OutData%WtrDens) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDpth call RegUnpack(Buf, OutData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - ! MSL2SWL call RegUnpack(Buf, OutData%MSL2SWL) if (RegCheckErr(Buf, RoutineName)) return - ! TMax call RegUnpack(Buf, OutData%TMax) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmLocationX call RegUnpack(Buf, OutData%PtfmLocationX) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmLocationY call RegUnpack(Buf, OutData%PtfmLocationY) if (RegCheckErr(Buf, RoutineName)) return - ! NStepWave call RegUnpack(Buf, OutData%NStepWave) if (RegCheckErr(Buf, RoutineName)) return - ! NStepWave2 call RegUnpack(Buf, OutData%NStepWave2) if (RegCheckErr(Buf, RoutineName)) return - ! RhoXg call RegUnpack(Buf, OutData%RhoXg) if (RegCheckErr(Buf, RoutineName)) return - ! WaveMod call RegUnpack(Buf, OutData%WaveMod) if (RegCheckErr(Buf, RoutineName)) return - ! WaveStMod call RegUnpack(Buf, OutData%WaveStMod) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDirMod call RegUnpack(Buf, OutData%WaveDirMod) if (RegCheckErr(Buf, RoutineName)) return - ! WvLowCOff call RegUnpack(Buf, OutData%WvLowCOff) if (RegCheckErr(Buf, RoutineName)) return - ! WvHiCOff call RegUnpack(Buf, OutData%WvHiCOff) if (RegCheckErr(Buf, RoutineName)) return - ! WvLowCOffD call RegUnpack(Buf, OutData%WvLowCOffD) if (RegCheckErr(Buf, RoutineName)) return - ! WvHiCOffD call RegUnpack(Buf, OutData%WvHiCOffD) if (RegCheckErr(Buf, RoutineName)) return - ! WvLowCOffS call RegUnpack(Buf, OutData%WvLowCOffS) if (RegCheckErr(Buf, RoutineName)) return - ! WvHiCOffS call RegUnpack(Buf, OutData%WvHiCOffS) if (RegCheckErr(Buf, RoutineName)) return - ! InvalidWithSSExctn call RegUnpack(Buf, OutData%InvalidWithSSExctn) if (RegCheckErr(Buf, RoutineName)) return - ! WaveElev0 if (allocated(OutData%WaveElev0)) deallocate(OutData%WaveElev0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1335,7 +1193,6 @@ subroutine HydroDyn_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%WaveElev0) if (RegCheckErr(Buf, RoutineName)) return end if - ! WaveElevC if (allocated(OutData%WaveElevC)) deallocate(OutData%WaveElevC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1350,25 +1207,18 @@ subroutine HydroDyn_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%WaveElevC) if (RegCheckErr(Buf, RoutineName)) return end if - ! WaveDirMin call RegUnpack(Buf, OutData%WaveDirMin) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDirMax call RegUnpack(Buf, OutData%WaveDirMax) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDir call RegUnpack(Buf, OutData%WaveDir) if (RegCheckErr(Buf, RoutineName)) return - ! WaveMultiDir call RegUnpack(Buf, OutData%WaveMultiDir) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDOmega call RegUnpack(Buf, OutData%WaveDOmega) if (RegCheckErr(Buf, RoutineName)) return - ! MCFD call RegUnpack(Buf, OutData%MCFD) if (RegCheckErr(Buf, RoutineName)) return - ! WaveField if (associated(OutData%WaveField)) deallocate(OutData%WaveField) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1390,208 +1240,202 @@ subroutine HydroDyn_UnPackInitInput(Buf, OutData) OutData%WaveField => null() end if end subroutine - SUBROUTINE HydroDyn_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HydroDyn_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(HydroDyn_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_CopyInitOutput' -! + +subroutine HydroDyn_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(HydroDyn_InitOutputType), intent(in) :: SrcInitOutputData + type(HydroDyn_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - CALL Morison_CopyInitOutput( SrcInitOutputData%Morison, DstInitOutputData%Morison, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInitOutputData%WriteOutputHdr)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputHdr,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputHdr,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputHdr)) THEN - ALLOCATE(DstInitOutputData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr -ENDIF -IF (ALLOCATED(SrcInitOutputData%WriteOutputUnt)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputUnt,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputUnt,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputUnt)) THEN - ALLOCATE(DstInitOutputData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt -ENDIF - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInitOutputData%LinNames_y)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_y,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_y,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_y)) THEN - ALLOCATE(DstInitOutputData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y -ENDIF -IF (ALLOCATED(SrcInitOutputData%LinNames_x)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_x,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_x,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_x)) THEN - ALLOCATE(DstInitOutputData%LinNames_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x -ENDIF -IF (ALLOCATED(SrcInitOutputData%LinNames_u)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_u,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_u)) THEN - ALLOCATE(DstInitOutputData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%DerivOrder_x)) THEN - i1_l = LBOUND(SrcInitOutputData%DerivOrder_x,1) - i1_u = UBOUND(SrcInitOutputData%DerivOrder_x,1) - IF (.NOT. ALLOCATED(DstInitOutputData%DerivOrder_x)) THEN - ALLOCATE(DstInitOutputData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x -ENDIF -IF (ALLOCATED(SrcInitOutputData%IsLoad_u)) THEN - i1_l = LBOUND(SrcInitOutputData%IsLoad_u,1) - i1_u = UBOUND(SrcInitOutputData%IsLoad_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%IsLoad_u)) THEN - ALLOCATE(DstInitOutputData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u -ENDIF - END SUBROUTINE HydroDyn_CopyInitOutput - - SUBROUTINE HydroDyn_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(HydroDyn_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL Morison_DestroyInitOutput( InitOutputData%Morison, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF - CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitOutputData%LinNames_y)) THEN - DEALLOCATE(InitOutputData%LinNames_y) -ENDIF -IF (ALLOCATED(InitOutputData%LinNames_x)) THEN - DEALLOCATE(InitOutputData%LinNames_x) -ENDIF -IF (ALLOCATED(InitOutputData%LinNames_u)) THEN - DEALLOCATE(InitOutputData%LinNames_u) -ENDIF -IF (ALLOCATED(InitOutputData%DerivOrder_x)) THEN - DEALLOCATE(InitOutputData%DerivOrder_x) -ENDIF -IF (ALLOCATED(InitOutputData%IsLoad_u)) THEN - DEALLOCATE(InitOutputData%IsLoad_u) -ENDIF - END SUBROUTINE HydroDyn_DestroyInitOutput + ErrMsg = '' + call Morison_CopyInitOutput(SrcInitOutputData%Morison, DstInitOutputData%Morison, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr + else if (allocated(DstInitOutputData%WriteOutputHdr)) then + deallocate(DstInitOutputData%WriteOutputHdr) + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt + else if (allocated(DstInitOutputData%WriteOutputUnt)) then + deallocate(DstInitOutputData%WriteOutputUnt) + end if + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInitOutputData%LinNames_y)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_y) + UB(1:1) = ubound(SrcInitOutputData%LinNames_y) + if (.not. allocated(DstInitOutputData%LinNames_y)) then + allocate(DstInitOutputData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y + else if (allocated(DstInitOutputData%LinNames_y)) then + deallocate(DstInitOutputData%LinNames_y) + end if + if (allocated(SrcInitOutputData%LinNames_x)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_x) + UB(1:1) = ubound(SrcInitOutputData%LinNames_x) + if (.not. allocated(DstInitOutputData%LinNames_x)) then + allocate(DstInitOutputData%LinNames_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x + else if (allocated(DstInitOutputData%LinNames_x)) then + deallocate(DstInitOutputData%LinNames_x) + end if + if (allocated(SrcInitOutputData%LinNames_u)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_u) + UB(1:1) = ubound(SrcInitOutputData%LinNames_u) + if (.not. allocated(DstInitOutputData%LinNames_u)) then + allocate(DstInitOutputData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u + else if (allocated(DstInitOutputData%LinNames_u)) then + deallocate(DstInitOutputData%LinNames_u) + end if + if (allocated(SrcInitOutputData%DerivOrder_x)) then + LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) + UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x) + if (.not. allocated(DstInitOutputData%DerivOrder_x)) then + allocate(DstInitOutputData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%DerivOrder_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x + else if (allocated(DstInitOutputData%DerivOrder_x)) then + deallocate(DstInitOutputData%DerivOrder_x) + end if + if (allocated(SrcInitOutputData%IsLoad_u)) then + LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) + UB(1:1) = ubound(SrcInitOutputData%IsLoad_u) + if (.not. allocated(DstInitOutputData%IsLoad_u)) then + allocate(DstInitOutputData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%IsLoad_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u + else if (allocated(DstInitOutputData%IsLoad_u)) then + deallocate(DstInitOutputData%IsLoad_u) + end if +end subroutine +subroutine HydroDyn_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(HydroDyn_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if + if (allocated(InitOutputData%LinNames_y)) then + deallocate(InitOutputData%LinNames_y) + end if + if (allocated(InitOutputData%LinNames_x)) then + deallocate(InitOutputData%LinNames_x) + end if + if (allocated(InitOutputData%LinNames_u)) then + deallocate(InitOutputData%LinNames_u) + end if + if (allocated(InitOutputData%DerivOrder_x)) then + deallocate(InitOutputData%DerivOrder_x) + end if + if (allocated(InitOutputData%IsLoad_u)) then + deallocate(InitOutputData%IsLoad_u) + end if +end subroutine subroutine HydroDyn_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(HydroDyn_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'HydroDyn_PackInitOutput' if (Buf%ErrStat >= AbortErrLev) return - ! Morison call Morison_PackInitOutput(Buf, InData%Morison) if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutputHdr call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) call RegPack(Buf, InData%WriteOutputHdr) end if if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutputUnt call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) call RegPack(Buf, InData%WriteOutputUnt) end if if (RegCheckErr(Buf, RoutineName)) return - ! Ver call NWTC_Library_PackProgDesc(Buf, InData%Ver) if (RegCheckErr(Buf, RoutineName)) return - ! LinNames_y call RegPack(Buf, allocated(InData%LinNames_y)) if (allocated(InData%LinNames_y)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) call RegPack(Buf, InData%LinNames_y) end if if (RegCheckErr(Buf, RoutineName)) return - ! LinNames_x call RegPack(Buf, allocated(InData%LinNames_x)) if (allocated(InData%LinNames_x)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_x), ubound(InData%LinNames_x)) call RegPack(Buf, InData%LinNames_x) end if if (RegCheckErr(Buf, RoutineName)) return - ! LinNames_u call RegPack(Buf, allocated(InData%LinNames_u)) if (allocated(InData%LinNames_u)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) call RegPack(Buf, InData%LinNames_u) end if if (RegCheckErr(Buf, RoutineName)) return - ! DerivOrder_x call RegPack(Buf, allocated(InData%DerivOrder_x)) if (allocated(InData%DerivOrder_x)) then call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x), ubound(InData%DerivOrder_x)) call RegPack(Buf, InData%DerivOrder_x) end if if (RegCheckErr(Buf, RoutineName)) return - ! IsLoad_u call RegPack(Buf, allocated(InData%IsLoad_u)) if (allocated(InData%IsLoad_u)) then call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) @@ -1608,9 +1452,7 @@ subroutine HydroDyn_UnPackInitOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! Morison call Morison_UnpackInitOutput(Buf, OutData%Morison) ! Morison - ! WriteOutputHdr if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1625,7 +1467,6 @@ subroutine HydroDyn_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutputHdr) if (RegCheckErr(Buf, RoutineName)) return end if - ! WriteOutputUnt if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1640,9 +1481,7 @@ subroutine HydroDyn_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutputUnt) if (RegCheckErr(Buf, RoutineName)) return end if - ! Ver call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver - ! LinNames_y if (allocated(OutData%LinNames_y)) deallocate(OutData%LinNames_y) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1657,7 +1496,6 @@ subroutine HydroDyn_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%LinNames_y) if (RegCheckErr(Buf, RoutineName)) return end if - ! LinNames_x if (allocated(OutData%LinNames_x)) deallocate(OutData%LinNames_x) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1672,7 +1510,6 @@ subroutine HydroDyn_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%LinNames_x) if (RegCheckErr(Buf, RoutineName)) return end if - ! LinNames_u if (allocated(OutData%LinNames_u)) deallocate(OutData%LinNames_u) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1687,7 +1524,6 @@ subroutine HydroDyn_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%LinNames_u) if (RegCheckErr(Buf, RoutineName)) return end if - ! DerivOrder_x if (allocated(OutData%DerivOrder_x)) deallocate(OutData%DerivOrder_x) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1702,7 +1538,6 @@ subroutine HydroDyn_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%DerivOrder_x) if (RegCheckErr(Buf, RoutineName)) return end if - ! IsLoad_u if (allocated(OutData%IsLoad_u)) deallocate(OutData%IsLoad_u) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1718,65 +1553,49 @@ subroutine HydroDyn_UnPackInitOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE HydroDyn_CopyHD_ModuleMapType( SrcHD_ModuleMapTypeData, DstHD_ModuleMapTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HD_ModuleMapType), INTENT(INOUT) :: SrcHD_ModuleMapTypeData - TYPE(HD_ModuleMapType), INTENT(INOUT) :: DstHD_ModuleMapTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_CopyHD_ModuleMapType' -! + +subroutine HydroDyn_CopyHD_ModuleMapType(SrcHD_ModuleMapTypeData, DstHD_ModuleMapTypeData, CtrlCode, ErrStat, ErrMsg) + type(HD_ModuleMapType), intent(inout) :: SrcHD_ModuleMapTypeData + type(HD_ModuleMapType), intent(inout) :: DstHD_ModuleMapTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_CopyHD_ModuleMapType' ErrStat = ErrID_None - ErrMsg = "" - CALL NWTC_Library_Copymeshmaptype( SrcHD_ModuleMapTypeData%uW_P_2_PRP_P, DstHD_ModuleMapTypeData%uW_P_2_PRP_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcHD_ModuleMapTypeData%W_P_2_PRP_P, DstHD_ModuleMapTypeData%W_P_2_PRP_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcHD_ModuleMapTypeData%M_P_2_PRP_P, DstHD_ModuleMapTypeData%M_P_2_PRP_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE HydroDyn_CopyHD_ModuleMapType - - SUBROUTINE HydroDyn_DestroyHD_ModuleMapType( HD_ModuleMapTypeData, ErrStat, ErrMsg ) - TYPE(HD_ModuleMapType), INTENT(INOUT) :: HD_ModuleMapTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyHD_ModuleMapType' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL NWTC_Library_DestroyMeshMapType( HD_ModuleMapTypeData%uW_P_2_PRP_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyMeshMapType( HD_ModuleMapTypeData%W_P_2_PRP_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyMeshMapType( HD_ModuleMapTypeData%M_P_2_PRP_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE HydroDyn_DestroyHD_ModuleMapType + ErrMsg = '' + call NWTC_Library_CopyMeshMapType(SrcHD_ModuleMapTypeData%uW_P_2_PRP_P, DstHD_ModuleMapTypeData%uW_P_2_PRP_P, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcHD_ModuleMapTypeData%W_P_2_PRP_P, DstHD_ModuleMapTypeData%W_P_2_PRP_P, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcHD_ModuleMapTypeData%M_P_2_PRP_P, DstHD_ModuleMapTypeData%M_P_2_PRP_P, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine HydroDyn_DestroyHD_ModuleMapType(HD_ModuleMapTypeData, ErrStat, ErrMsg) + type(HD_ModuleMapType), intent(inout) :: HD_ModuleMapTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_DestroyHD_ModuleMapType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine HydroDyn_PackHD_ModuleMapType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(HD_ModuleMapType), intent(in) :: InData character(*), parameter :: RoutineName = 'HydroDyn_PackHD_ModuleMapType' if (Buf%ErrStat >= AbortErrLev) return - ! uW_P_2_PRP_P call NWTC_Library_PackMeshMapType(Buf, InData%uW_P_2_PRP_P) if (RegCheckErr(Buf, RoutineName)) return - ! W_P_2_PRP_P call NWTC_Library_PackMeshMapType(Buf, InData%W_P_2_PRP_P) if (RegCheckErr(Buf, RoutineName)) return - ! M_P_2_PRP_P call NWTC_Library_PackMeshMapType(Buf, InData%M_P_2_PRP_P) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1786,73 +1605,68 @@ subroutine HydroDyn_UnPackHD_ModuleMapType(Buf, OutData) type(HD_ModuleMapType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'HydroDyn_UnPackHD_ModuleMapType' if (Buf%ErrStat /= ErrID_None) return - ! uW_P_2_PRP_P call NWTC_Library_UnpackMeshMapType(Buf, OutData%uW_P_2_PRP_P) ! uW_P_2_PRP_P - ! W_P_2_PRP_P call NWTC_Library_UnpackMeshMapType(Buf, OutData%W_P_2_PRP_P) ! W_P_2_PRP_P - ! M_P_2_PRP_P call NWTC_Library_UnpackMeshMapType(Buf, OutData%M_P_2_PRP_P) ! M_P_2_PRP_P end subroutine - SUBROUTINE HydroDyn_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HydroDyn_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(HydroDyn_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_CopyContState' -! + +subroutine HydroDyn_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(HydroDyn_ContinuousStateType), intent(in) :: SrcContStateData + type(HydroDyn_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_CopyContState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcContStateData%WAMIT)) THEN - i1_l = LBOUND(SrcContStateData%WAMIT,1) - i1_u = UBOUND(SrcContStateData%WAMIT,1) - IF (.NOT. ALLOCATED(DstContStateData%WAMIT)) THEN - ALLOCATE(DstContStateData%WAMIT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%WAMIT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcContStateData%WAMIT,1), UBOUND(SrcContStateData%WAMIT,1) - CALL WAMIT_CopyContState( SrcContStateData%WAMIT(i1), DstContStateData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL Morison_CopyContState( SrcContStateData%Morison, DstContStateData%Morison, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE HydroDyn_CopyContState - - SUBROUTINE HydroDyn_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(HydroDyn_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ContStateData%WAMIT)) THEN -DO i1 = LBOUND(ContStateData%WAMIT,1), UBOUND(ContStateData%WAMIT,1) - CALL WAMIT_DestroyContState( ContStateData%WAMIT(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ContStateData%WAMIT) -ENDIF - CALL Morison_DestroyContState( ContStateData%Morison, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE HydroDyn_DestroyContState + ErrMsg = '' + if (allocated(SrcContStateData%WAMIT)) then + LB(1:1) = lbound(SrcContStateData%WAMIT) + UB(1:1) = ubound(SrcContStateData%WAMIT) + if (.not. allocated(DstContStateData%WAMIT)) then + allocate(DstContStateData%WAMIT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%WAMIT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call WAMIT_CopyContState(SrcContStateData%WAMIT(i1), DstContStateData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstContStateData%WAMIT)) then + deallocate(DstContStateData%WAMIT) + end if + call Morison_CopyContState(SrcContStateData%Morison, DstContStateData%Morison, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine HydroDyn_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(HydroDyn_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ContStateData%WAMIT)) then + LB(1:1) = lbound(ContStateData%WAMIT) + UB(1:1) = ubound(ContStateData%WAMIT) + do i1 = LB(1), UB(1) + call WAMIT_DestroyContState(ContStateData%WAMIT(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ContStateData%WAMIT) + end if +end subroutine subroutine HydroDyn_PackContState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -1861,7 +1675,6 @@ subroutine HydroDyn_PackContState(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! WAMIT call RegPack(Buf, allocated(InData%WAMIT)) if (allocated(InData%WAMIT)) then call RegPackBounds(Buf, 1, lbound(InData%WAMIT), ubound(InData%WAMIT)) @@ -1872,7 +1685,6 @@ subroutine HydroDyn_PackContState(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! Morison call Morison_PackContState(Buf, InData%Morison) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1886,7 +1698,6 @@ subroutine HydroDyn_UnPackContState(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! WAMIT if (allocated(OutData%WAMIT)) deallocate(OutData%WAMIT) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1902,69 +1713,66 @@ subroutine HydroDyn_UnPackContState(Buf, OutData) call WAMIT_UnpackContState(Buf, OutData%WAMIT(i1)) ! WAMIT end do end if - ! Morison call Morison_UnpackContState(Buf, OutData%Morison) ! Morison end subroutine - SUBROUTINE HydroDyn_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HydroDyn_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(HydroDyn_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_CopyDiscState' -! + +subroutine HydroDyn_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(HydroDyn_DiscreteStateType), intent(in) :: SrcDiscStateData + type(HydroDyn_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_CopyDiscState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcDiscStateData%WAMIT)) THEN - i1_l = LBOUND(SrcDiscStateData%WAMIT,1) - i1_u = UBOUND(SrcDiscStateData%WAMIT,1) - IF (.NOT. ALLOCATED(DstDiscStateData%WAMIT)) THEN - ALLOCATE(DstDiscStateData%WAMIT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%WAMIT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDiscStateData%WAMIT,1), UBOUND(SrcDiscStateData%WAMIT,1) - CALL WAMIT_CopyDiscState( SrcDiscStateData%WAMIT(i1), DstDiscStateData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL Morison_CopyDiscState( SrcDiscStateData%Morison, DstDiscStateData%Morison, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE HydroDyn_CopyDiscState - - SUBROUTINE HydroDyn_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(HydroDyn_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(DiscStateData%WAMIT)) THEN -DO i1 = LBOUND(DiscStateData%WAMIT,1), UBOUND(DiscStateData%WAMIT,1) - CALL WAMIT_DestroyDiscState( DiscStateData%WAMIT(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(DiscStateData%WAMIT) -ENDIF - CALL Morison_DestroyDiscState( DiscStateData%Morison, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE HydroDyn_DestroyDiscState + ErrMsg = '' + if (allocated(SrcDiscStateData%WAMIT)) then + LB(1:1) = lbound(SrcDiscStateData%WAMIT) + UB(1:1) = ubound(SrcDiscStateData%WAMIT) + if (.not. allocated(DstDiscStateData%WAMIT)) then + allocate(DstDiscStateData%WAMIT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%WAMIT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call WAMIT_CopyDiscState(SrcDiscStateData%WAMIT(i1), DstDiscStateData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstDiscStateData%WAMIT)) then + deallocate(DstDiscStateData%WAMIT) + end if + call Morison_CopyDiscState(SrcDiscStateData%Morison, DstDiscStateData%Morison, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine HydroDyn_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(HydroDyn_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(DiscStateData%WAMIT)) then + LB(1:1) = lbound(DiscStateData%WAMIT) + UB(1:1) = ubound(DiscStateData%WAMIT) + do i1 = LB(1), UB(1) + call WAMIT_DestroyDiscState(DiscStateData%WAMIT(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(DiscStateData%WAMIT) + end if +end subroutine subroutine HydroDyn_PackDiscState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -1973,7 +1781,6 @@ subroutine HydroDyn_PackDiscState(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! WAMIT call RegPack(Buf, allocated(InData%WAMIT)) if (allocated(InData%WAMIT)) then call RegPackBounds(Buf, 1, lbound(InData%WAMIT), ubound(InData%WAMIT)) @@ -1984,7 +1791,6 @@ subroutine HydroDyn_PackDiscState(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! Morison call Morison_PackDiscState(Buf, InData%Morison) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1998,7 +1804,6 @@ subroutine HydroDyn_UnPackDiscState(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! WAMIT if (allocated(OutData%WAMIT)) deallocate(OutData%WAMIT) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2014,60 +1819,46 @@ subroutine HydroDyn_UnPackDiscState(Buf, OutData) call WAMIT_UnpackDiscState(Buf, OutData%WAMIT(i1)) ! WAMIT end do end if - ! Morison call Morison_UnpackDiscState(Buf, OutData%Morison) ! Morison end subroutine - SUBROUTINE HydroDyn_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HydroDyn_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(HydroDyn_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_CopyConstrState' -! + +subroutine HydroDyn_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(HydroDyn_ConstraintStateType), intent(in) :: SrcConstrStateData + type(HydroDyn_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_CopyConstrState' ErrStat = ErrID_None - ErrMsg = "" - CALL WAMIT_CopyConstrState( SrcConstrStateData%WAMIT, DstConstrStateData%WAMIT, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Morison_CopyConstrState( SrcConstrStateData%Morison, DstConstrStateData%Morison, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE HydroDyn_CopyConstrState - - SUBROUTINE HydroDyn_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(HydroDyn_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL WAMIT_DestroyConstrState( ConstrStateData%WAMIT, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Morison_DestroyConstrState( ConstrStateData%Morison, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE HydroDyn_DestroyConstrState + ErrMsg = '' + call WAMIT_CopyConstrState(SrcConstrStateData%WAMIT, DstConstrStateData%WAMIT, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Morison_CopyConstrState(SrcConstrStateData%Morison, DstConstrStateData%Morison, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine HydroDyn_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(HydroDyn_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine HydroDyn_PackConstrState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(HydroDyn_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'HydroDyn_PackConstrState' if (Buf%ErrStat >= AbortErrLev) return - ! WAMIT call WAMIT_PackConstrState(Buf, InData%WAMIT) if (RegCheckErr(Buf, RoutineName)) return - ! Morison call Morison_PackConstrState(Buf, InData%Morison) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2077,71 +1868,67 @@ subroutine HydroDyn_UnPackConstrState(Buf, OutData) type(HydroDyn_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'HydroDyn_UnPackConstrState' if (Buf%ErrStat /= ErrID_None) return - ! WAMIT call WAMIT_UnpackConstrState(Buf, OutData%WAMIT) ! WAMIT - ! Morison call Morison_UnpackConstrState(Buf, OutData%Morison) ! Morison end subroutine - SUBROUTINE HydroDyn_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HydroDyn_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(HydroDyn_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_CopyOtherState' -! + +subroutine HydroDyn_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(HydroDyn_OtherStateType), intent(in) :: SrcOtherStateData + type(HydroDyn_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_CopyOtherState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOtherStateData%WAMIT)) THEN - i1_l = LBOUND(SrcOtherStateData%WAMIT,1) - i1_u = UBOUND(SrcOtherStateData%WAMIT,1) - IF (.NOT. ALLOCATED(DstOtherStateData%WAMIT)) THEN - ALLOCATE(DstOtherStateData%WAMIT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%WAMIT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOtherStateData%WAMIT,1), UBOUND(SrcOtherStateData%WAMIT,1) - CALL WAMIT_CopyOtherState( SrcOtherStateData%WAMIT(i1), DstOtherStateData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL Morison_CopyOtherState( SrcOtherStateData%Morison, DstOtherStateData%Morison, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE HydroDyn_CopyOtherState - - SUBROUTINE HydroDyn_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(HydroDyn_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OtherStateData%WAMIT)) THEN -DO i1 = LBOUND(OtherStateData%WAMIT,1), UBOUND(OtherStateData%WAMIT,1) - CALL WAMIT_DestroyOtherState( OtherStateData%WAMIT(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OtherStateData%WAMIT) -ENDIF - CALL Morison_DestroyOtherState( OtherStateData%Morison, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE HydroDyn_DestroyOtherState + ErrMsg = '' + if (allocated(SrcOtherStateData%WAMIT)) then + LB(1:1) = lbound(SrcOtherStateData%WAMIT) + UB(1:1) = ubound(SrcOtherStateData%WAMIT) + if (.not. allocated(DstOtherStateData%WAMIT)) then + allocate(DstOtherStateData%WAMIT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%WAMIT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call WAMIT_CopyOtherState(SrcOtherStateData%WAMIT(i1), DstOtherStateData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstOtherStateData%WAMIT)) then + deallocate(DstOtherStateData%WAMIT) + end if + call Morison_CopyOtherState(SrcOtherStateData%Morison, DstOtherStateData%Morison, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine HydroDyn_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(HydroDyn_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OtherStateData%WAMIT)) then + LB(1:1) = lbound(OtherStateData%WAMIT) + UB(1:1) = ubound(OtherStateData%WAMIT) + do i1 = LB(1), UB(1) + call WAMIT_DestroyOtherState(OtherStateData%WAMIT(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OtherStateData%WAMIT) + end if +end subroutine subroutine HydroDyn_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -2150,7 +1937,6 @@ subroutine HydroDyn_PackOtherState(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! WAMIT call RegPack(Buf, allocated(InData%WAMIT)) if (allocated(InData%WAMIT)) then call RegPackBounds(Buf, 1, lbound(InData%WAMIT), ubound(InData%WAMIT)) @@ -2161,7 +1947,6 @@ subroutine HydroDyn_PackOtherState(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! Morison call Morison_PackOtherState(Buf, InData%Morison) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2175,7 +1960,6 @@ subroutine HydroDyn_UnPackOtherState(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! WAMIT if (allocated(OutData%WAMIT)) deallocate(OutData%WAMIT) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2191,159 +1975,164 @@ subroutine HydroDyn_UnPackOtherState(Buf, OutData) call WAMIT_UnpackOtherState(Buf, OutData%WAMIT(i1)) ! WAMIT end do end if - ! Morison call Morison_UnpackOtherState(Buf, OutData%Morison) ! Morison end subroutine - SUBROUTINE HydroDyn_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HydroDyn_MiscVarType), INTENT(INOUT) :: SrcMiscData - TYPE(HydroDyn_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_CopyMisc' -! + +subroutine HydroDyn_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(HydroDyn_MiscVarType), intent(inout) :: SrcMiscData + type(HydroDyn_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_CopyMisc' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcMiscData%AllHdroOrigin, DstMiscData%AllHdroOrigin, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL HydroDyn_Copyhd_modulemaptype( SrcMiscData%HD_MeshMap, DstMiscData%HD_MeshMap, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstMiscData%Decimate = SrcMiscData%Decimate - DstMiscData%LastOutTime = SrcMiscData%LastOutTime - DstMiscData%LastIndWave = SrcMiscData%LastIndWave -IF (ALLOCATED(SrcMiscData%F_PtfmAdd)) THEN - i1_l = LBOUND(SrcMiscData%F_PtfmAdd,1) - i1_u = UBOUND(SrcMiscData%F_PtfmAdd,1) - IF (.NOT. ALLOCATED(DstMiscData%F_PtfmAdd)) THEN - ALLOCATE(DstMiscData%F_PtfmAdd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_PtfmAdd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_PtfmAdd = SrcMiscData%F_PtfmAdd -ENDIF - DstMiscData%F_Hydro = SrcMiscData%F_Hydro -IF (ALLOCATED(SrcMiscData%F_Waves)) THEN - i1_l = LBOUND(SrcMiscData%F_Waves,1) - i1_u = UBOUND(SrcMiscData%F_Waves,1) - IF (.NOT. ALLOCATED(DstMiscData%F_Waves)) THEN - ALLOCATE(DstMiscData%F_Waves(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_Waves.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_Waves = SrcMiscData%F_Waves -ENDIF -IF (ALLOCATED(SrcMiscData%WAMIT)) THEN - i1_l = LBOUND(SrcMiscData%WAMIT,1) - i1_u = UBOUND(SrcMiscData%WAMIT,1) - IF (.NOT. ALLOCATED(DstMiscData%WAMIT)) THEN - ALLOCATE(DstMiscData%WAMIT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WAMIT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%WAMIT,1), UBOUND(SrcMiscData%WAMIT,1) - CALL WAMIT_CopyMisc( SrcMiscData%WAMIT(i1), DstMiscData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%WAMIT2)) THEN - i1_l = LBOUND(SrcMiscData%WAMIT2,1) - i1_u = UBOUND(SrcMiscData%WAMIT2,1) - IF (.NOT. ALLOCATED(DstMiscData%WAMIT2)) THEN - ALLOCATE(DstMiscData%WAMIT2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WAMIT2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%WAMIT2,1), UBOUND(SrcMiscData%WAMIT2,1) - CALL WAMIT2_CopyMisc( SrcMiscData%WAMIT2(i1), DstMiscData%WAMIT2(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL Morison_CopyMisc( SrcMiscData%Morison, DstMiscData%Morison, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMiscData%u_WAMIT)) THEN - i1_l = LBOUND(SrcMiscData%u_WAMIT,1) - i1_u = UBOUND(SrcMiscData%u_WAMIT,1) - IF (.NOT. ALLOCATED(DstMiscData%u_WAMIT)) THEN - ALLOCATE(DstMiscData%u_WAMIT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_WAMIT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%u_WAMIT,1), UBOUND(SrcMiscData%u_WAMIT,1) - CALL WAMIT_CopyInput( SrcMiscData%u_WAMIT(i1), DstMiscData%u_WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE HydroDyn_CopyMisc - - SUBROUTINE HydroDyn_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(HydroDyn_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL MeshDestroy( MiscData%AllHdroOrigin, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL HydroDyn_DestroyHD_ModuleMapType( MiscData%HD_MeshMap, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MiscData%F_PtfmAdd)) THEN - DEALLOCATE(MiscData%F_PtfmAdd) -ENDIF -IF (ALLOCATED(MiscData%F_Waves)) THEN - DEALLOCATE(MiscData%F_Waves) -ENDIF -IF (ALLOCATED(MiscData%WAMIT)) THEN -DO i1 = LBOUND(MiscData%WAMIT,1), UBOUND(MiscData%WAMIT,1) - CALL WAMIT_DestroyMisc( MiscData%WAMIT(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%WAMIT) -ENDIF -IF (ALLOCATED(MiscData%WAMIT2)) THEN -DO i1 = LBOUND(MiscData%WAMIT2,1), UBOUND(MiscData%WAMIT2,1) - CALL WAMIT2_DestroyMisc( MiscData%WAMIT2(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%WAMIT2) -ENDIF - CALL Morison_DestroyMisc( MiscData%Morison, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MiscData%u_WAMIT)) THEN -DO i1 = LBOUND(MiscData%u_WAMIT,1), UBOUND(MiscData%u_WAMIT,1) - CALL WAMIT_DestroyInput( MiscData%u_WAMIT(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%u_WAMIT) -ENDIF - END SUBROUTINE HydroDyn_DestroyMisc + ErrMsg = '' + call MeshCopy(SrcMiscData%AllHdroOrigin, DstMiscData%AllHdroOrigin, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call HydroDyn_CopyHD_ModuleMapType(SrcMiscData%HD_MeshMap, DstMiscData%HD_MeshMap, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstMiscData%Decimate = SrcMiscData%Decimate + DstMiscData%LastOutTime = SrcMiscData%LastOutTime + DstMiscData%LastIndWave = SrcMiscData%LastIndWave + if (allocated(SrcMiscData%F_PtfmAdd)) then + LB(1:1) = lbound(SrcMiscData%F_PtfmAdd) + UB(1:1) = ubound(SrcMiscData%F_PtfmAdd) + if (.not. allocated(DstMiscData%F_PtfmAdd)) then + allocate(DstMiscData%F_PtfmAdd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_PtfmAdd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_PtfmAdd = SrcMiscData%F_PtfmAdd + else if (allocated(DstMiscData%F_PtfmAdd)) then + deallocate(DstMiscData%F_PtfmAdd) + end if + DstMiscData%F_Hydro = SrcMiscData%F_Hydro + if (allocated(SrcMiscData%F_Waves)) then + LB(1:1) = lbound(SrcMiscData%F_Waves) + UB(1:1) = ubound(SrcMiscData%F_Waves) + if (.not. allocated(DstMiscData%F_Waves)) then + allocate(DstMiscData%F_Waves(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_Waves.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_Waves = SrcMiscData%F_Waves + else if (allocated(DstMiscData%F_Waves)) then + deallocate(DstMiscData%F_Waves) + end if + if (allocated(SrcMiscData%WAMIT)) then + LB(1:1) = lbound(SrcMiscData%WAMIT) + UB(1:1) = ubound(SrcMiscData%WAMIT) + if (.not. allocated(DstMiscData%WAMIT)) then + allocate(DstMiscData%WAMIT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WAMIT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call WAMIT_CopyMisc(SrcMiscData%WAMIT(i1), DstMiscData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstMiscData%WAMIT)) then + deallocate(DstMiscData%WAMIT) + end if + if (allocated(SrcMiscData%WAMIT2)) then + LB(1:1) = lbound(SrcMiscData%WAMIT2) + UB(1:1) = ubound(SrcMiscData%WAMIT2) + if (.not. allocated(DstMiscData%WAMIT2)) then + allocate(DstMiscData%WAMIT2(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WAMIT2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call WAMIT2_CopyMisc(SrcMiscData%WAMIT2(i1), DstMiscData%WAMIT2(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstMiscData%WAMIT2)) then + deallocate(DstMiscData%WAMIT2) + end if + call Morison_CopyMisc(SrcMiscData%Morison, DstMiscData%Morison, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMiscData%u_WAMIT)) then + LB(1:1) = lbound(SrcMiscData%u_WAMIT) + UB(1:1) = ubound(SrcMiscData%u_WAMIT) + if (.not. allocated(DstMiscData%u_WAMIT)) then + allocate(DstMiscData%u_WAMIT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_WAMIT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call WAMIT_CopyInput(SrcMiscData%u_WAMIT(i1), DstMiscData%u_WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstMiscData%u_WAMIT)) then + deallocate(DstMiscData%u_WAMIT) + end if +end subroutine +subroutine HydroDyn_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(HydroDyn_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%F_PtfmAdd)) then + deallocate(MiscData%F_PtfmAdd) + end if + if (allocated(MiscData%F_Waves)) then + deallocate(MiscData%F_Waves) + end if + if (allocated(MiscData%WAMIT)) then + LB(1:1) = lbound(MiscData%WAMIT) + UB(1:1) = ubound(MiscData%WAMIT) + do i1 = LB(1), UB(1) + call WAMIT_DestroyMisc(MiscData%WAMIT(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%WAMIT) + end if + if (allocated(MiscData%WAMIT2)) then + LB(1:1) = lbound(MiscData%WAMIT2) + UB(1:1) = ubound(MiscData%WAMIT2) + do i1 = LB(1), UB(1) + call WAMIT2_DestroyMisc(MiscData%WAMIT2(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%WAMIT2) + end if + if (allocated(MiscData%u_WAMIT)) then + LB(1:1) = lbound(MiscData%u_WAMIT) + UB(1:1) = ubound(MiscData%u_WAMIT) + do i1 = LB(1), UB(1) + call WAMIT_DestroyInput(MiscData%u_WAMIT(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%u_WAMIT) + end if +end subroutine subroutine HydroDyn_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -2352,39 +2141,30 @@ subroutine HydroDyn_PackMisc(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! AllHdroOrigin call MeshPack(Buf, InData%AllHdroOrigin) if (RegCheckErr(Buf, RoutineName)) return - ! HD_MeshMap call HydroDyn_PackHD_ModuleMapType(Buf, InData%HD_MeshMap) if (RegCheckErr(Buf, RoutineName)) return - ! Decimate call RegPack(Buf, InData%Decimate) if (RegCheckErr(Buf, RoutineName)) return - ! LastOutTime call RegPack(Buf, InData%LastOutTime) if (RegCheckErr(Buf, RoutineName)) return - ! LastIndWave call RegPack(Buf, InData%LastIndWave) if (RegCheckErr(Buf, RoutineName)) return - ! F_PtfmAdd call RegPack(Buf, allocated(InData%F_PtfmAdd)) if (allocated(InData%F_PtfmAdd)) then call RegPackBounds(Buf, 1, lbound(InData%F_PtfmAdd), ubound(InData%F_PtfmAdd)) call RegPack(Buf, InData%F_PtfmAdd) end if if (RegCheckErr(Buf, RoutineName)) return - ! F_Hydro call RegPack(Buf, InData%F_Hydro) if (RegCheckErr(Buf, RoutineName)) return - ! F_Waves call RegPack(Buf, allocated(InData%F_Waves)) if (allocated(InData%F_Waves)) then call RegPackBounds(Buf, 1, lbound(InData%F_Waves), ubound(InData%F_Waves)) call RegPack(Buf, InData%F_Waves) end if if (RegCheckErr(Buf, RoutineName)) return - ! WAMIT call RegPack(Buf, allocated(InData%WAMIT)) if (allocated(InData%WAMIT)) then call RegPackBounds(Buf, 1, lbound(InData%WAMIT), ubound(InData%WAMIT)) @@ -2395,7 +2175,6 @@ subroutine HydroDyn_PackMisc(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! WAMIT2 call RegPack(Buf, allocated(InData%WAMIT2)) if (allocated(InData%WAMIT2)) then call RegPackBounds(Buf, 1, lbound(InData%WAMIT2), ubound(InData%WAMIT2)) @@ -2406,10 +2185,8 @@ subroutine HydroDyn_PackMisc(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! Morison call Morison_PackMisc(Buf, InData%Morison) if (RegCheckErr(Buf, RoutineName)) return - ! u_WAMIT call RegPack(Buf, allocated(InData%u_WAMIT)) if (allocated(InData%u_WAMIT)) then call RegPackBounds(Buf, 1, lbound(InData%u_WAMIT), ubound(InData%u_WAMIT)) @@ -2431,20 +2208,14 @@ subroutine HydroDyn_UnPackMisc(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! AllHdroOrigin call MeshUnpack(Buf, OutData%AllHdroOrigin) ! AllHdroOrigin - ! HD_MeshMap call HydroDyn_UnpackHD_ModuleMapType(Buf, OutData%HD_MeshMap) ! HD_MeshMap - ! Decimate call RegUnpack(Buf, OutData%Decimate) if (RegCheckErr(Buf, RoutineName)) return - ! LastOutTime call RegUnpack(Buf, OutData%LastOutTime) if (RegCheckErr(Buf, RoutineName)) return - ! LastIndWave call RegUnpack(Buf, OutData%LastIndWave) if (RegCheckErr(Buf, RoutineName)) return - ! F_PtfmAdd if (allocated(OutData%F_PtfmAdd)) deallocate(OutData%F_PtfmAdd) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2459,10 +2230,8 @@ subroutine HydroDyn_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%F_PtfmAdd) if (RegCheckErr(Buf, RoutineName)) return end if - ! F_Hydro call RegUnpack(Buf, OutData%F_Hydro) if (RegCheckErr(Buf, RoutineName)) return - ! F_Waves if (allocated(OutData%F_Waves)) deallocate(OutData%F_Waves) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2477,7 +2246,6 @@ subroutine HydroDyn_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%F_Waves) if (RegCheckErr(Buf, RoutineName)) return end if - ! WAMIT if (allocated(OutData%WAMIT)) deallocate(OutData%WAMIT) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2493,7 +2261,6 @@ subroutine HydroDyn_UnPackMisc(Buf, OutData) call WAMIT_UnpackMisc(Buf, OutData%WAMIT(i1)) ! WAMIT end do end if - ! WAMIT2 if (allocated(OutData%WAMIT2)) deallocate(OutData%WAMIT2) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2509,9 +2276,7 @@ subroutine HydroDyn_UnPackMisc(Buf, OutData) call WAMIT2_UnpackMisc(Buf, OutData%WAMIT2(i1)) ! WAMIT2 end do end if - ! Morison call Morison_UnpackMisc(Buf, OutData%Morison) ! Morison - ! u_WAMIT if (allocated(OutData%u_WAMIT)) deallocate(OutData%u_WAMIT) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2528,259 +2293,261 @@ subroutine HydroDyn_UnPackMisc(Buf, OutData) end do end if end subroutine - SUBROUTINE HydroDyn_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HydroDyn_ParameterType), INTENT(IN) :: SrcParamData - TYPE(HydroDyn_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_CopyParam' -! + +subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(HydroDyn_ParameterType), intent(in) :: SrcParamData + type(HydroDyn_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_CopyParam' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%nWAMITObj = SrcParamData%nWAMITObj - DstParamData%vecMultiplier = SrcParamData%vecMultiplier -IF (ALLOCATED(SrcParamData%WAMIT)) THEN - i1_l = LBOUND(SrcParamData%WAMIT,1) - i1_u = UBOUND(SrcParamData%WAMIT,1) - IF (.NOT. ALLOCATED(DstParamData%WAMIT)) THEN - ALLOCATE(DstParamData%WAMIT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WAMIT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%WAMIT,1), UBOUND(SrcParamData%WAMIT,1) - CALL WAMIT_CopyParam( SrcParamData%WAMIT(i1), DstParamData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%WAMIT2)) THEN - i1_l = LBOUND(SrcParamData%WAMIT2,1) - i1_u = UBOUND(SrcParamData%WAMIT2,1) - IF (.NOT. ALLOCATED(DstParamData%WAMIT2)) THEN - ALLOCATE(DstParamData%WAMIT2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WAMIT2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%WAMIT2,1), UBOUND(SrcParamData%WAMIT2,1) - CALL WAMIT2_CopyParam( SrcParamData%WAMIT2(i1), DstParamData%WAMIT2(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstParamData%WAMIT2used = SrcParamData%WAMIT2used - CALL Morison_CopyParam( SrcParamData%Morison, DstParamData%Morison, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstParamData%PotMod = SrcParamData%PotMod - DstParamData%NBody = SrcParamData%NBody - DstParamData%NBodyMod = SrcParamData%NBodyMod - DstParamData%totalStates = SrcParamData%totalStates - DstParamData%totalExctnStates = SrcParamData%totalExctnStates - DstParamData%totalRdtnStates = SrcParamData%totalRdtnStates - DstParamData%WaveTime => SrcParamData%WaveTime - DstParamData%NStepWave = SrcParamData%NStepWave - DstParamData%WtrDpth = SrcParamData%WtrDpth -IF (ALLOCATED(SrcParamData%AddF0)) THEN - i1_l = LBOUND(SrcParamData%AddF0,1) - i1_u = UBOUND(SrcParamData%AddF0,1) - i2_l = LBOUND(SrcParamData%AddF0,2) - i2_u = UBOUND(SrcParamData%AddF0,2) - IF (.NOT. ALLOCATED(DstParamData%AddF0)) THEN - ALLOCATE(DstParamData%AddF0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AddF0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AddF0 = SrcParamData%AddF0 -ENDIF -IF (ALLOCATED(SrcParamData%AddCLin)) THEN - i1_l = LBOUND(SrcParamData%AddCLin,1) - i1_u = UBOUND(SrcParamData%AddCLin,1) - i2_l = LBOUND(SrcParamData%AddCLin,2) - i2_u = UBOUND(SrcParamData%AddCLin,2) - i3_l = LBOUND(SrcParamData%AddCLin,3) - i3_u = UBOUND(SrcParamData%AddCLin,3) - IF (.NOT. ALLOCATED(DstParamData%AddCLin)) THEN - ALLOCATE(DstParamData%AddCLin(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AddCLin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AddCLin = SrcParamData%AddCLin -ENDIF -IF (ALLOCATED(SrcParamData%AddBLin)) THEN - i1_l = LBOUND(SrcParamData%AddBLin,1) - i1_u = UBOUND(SrcParamData%AddBLin,1) - i2_l = LBOUND(SrcParamData%AddBLin,2) - i2_u = UBOUND(SrcParamData%AddBLin,2) - i3_l = LBOUND(SrcParamData%AddBLin,3) - i3_u = UBOUND(SrcParamData%AddBLin,3) - IF (.NOT. ALLOCATED(DstParamData%AddBLin)) THEN - ALLOCATE(DstParamData%AddBLin(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AddBLin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AddBLin = SrcParamData%AddBLin -ENDIF -IF (ALLOCATED(SrcParamData%AddBQuad)) THEN - i1_l = LBOUND(SrcParamData%AddBQuad,1) - i1_u = UBOUND(SrcParamData%AddBQuad,1) - i2_l = LBOUND(SrcParamData%AddBQuad,2) - i2_u = UBOUND(SrcParamData%AddBQuad,2) - i3_l = LBOUND(SrcParamData%AddBQuad,3) - i3_u = UBOUND(SrcParamData%AddBQuad,3) - IF (.NOT. ALLOCATED(DstParamData%AddBQuad)) THEN - ALLOCATE(DstParamData%AddBQuad(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AddBQuad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AddBQuad = SrcParamData%AddBQuad -ENDIF - DstParamData%DT = SrcParamData%DT -IF (ALLOCATED(SrcParamData%OutParam)) THEN - i1_l = LBOUND(SrcParamData%OutParam,1) - i1_u = UBOUND(SrcParamData%OutParam,1) - IF (.NOT. ALLOCATED(DstParamData%OutParam)) THEN - ALLOCATE(DstParamData%OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%OutParam,1), UBOUND(SrcParamData%OutParam,1) - CALL NWTC_Library_Copyoutparmtype( SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%NumTotalOuts = SrcParamData%NumTotalOuts - DstParamData%OutSwtch = SrcParamData%OutSwtch - DstParamData%OutFmt = SrcParamData%OutFmt - DstParamData%OutSFmt = SrcParamData%OutSFmt - DstParamData%Delim = SrcParamData%Delim - DstParamData%UnOutFile = SrcParamData%UnOutFile - DstParamData%OutDec = SrcParamData%OutDec -IF (ALLOCATED(SrcParamData%Jac_u_indx)) THEN - i1_l = LBOUND(SrcParamData%Jac_u_indx,1) - i1_u = UBOUND(SrcParamData%Jac_u_indx,1) - i2_l = LBOUND(SrcParamData%Jac_u_indx,2) - i2_u = UBOUND(SrcParamData%Jac_u_indx,2) - IF (.NOT. ALLOCATED(DstParamData%Jac_u_indx)) THEN - ALLOCATE(DstParamData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx -ENDIF -IF (ALLOCATED(SrcParamData%du)) THEN - i1_l = LBOUND(SrcParamData%du,1) - i1_u = UBOUND(SrcParamData%du,1) - IF (.NOT. ALLOCATED(DstParamData%du)) THEN - ALLOCATE(DstParamData%du(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%du = SrcParamData%du -ENDIF -IF (ALLOCATED(SrcParamData%dx)) THEN - i1_l = LBOUND(SrcParamData%dx,1) - i1_u = UBOUND(SrcParamData%dx,1) - IF (.NOT. ALLOCATED(DstParamData%dx)) THEN - ALLOCATE(DstParamData%dx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%dx = SrcParamData%dx -ENDIF - DstParamData%Jac_ny = SrcParamData%Jac_ny - DstParamData%PointsToSeaState = SrcParamData%PointsToSeaState - END SUBROUTINE HydroDyn_CopyParam - - SUBROUTINE HydroDyn_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(HydroDyn_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%WAMIT)) THEN -DO i1 = LBOUND(ParamData%WAMIT,1), UBOUND(ParamData%WAMIT,1) - CALL WAMIT_DestroyParam( ParamData%WAMIT(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%WAMIT) -ENDIF -IF (ALLOCATED(ParamData%WAMIT2)) THEN -DO i1 = LBOUND(ParamData%WAMIT2,1), UBOUND(ParamData%WAMIT2,1) - CALL WAMIT2_DestroyParam( ParamData%WAMIT2(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%WAMIT2) -ENDIF - CALL Morison_DestroyParam( ParamData%Morison, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -NULLIFY(ParamData%WaveTime) -IF (ALLOCATED(ParamData%AddF0)) THEN - DEALLOCATE(ParamData%AddF0) -ENDIF -IF (ALLOCATED(ParamData%AddCLin)) THEN - DEALLOCATE(ParamData%AddCLin) -ENDIF -IF (ALLOCATED(ParamData%AddBLin)) THEN - DEALLOCATE(ParamData%AddBLin) -ENDIF -IF (ALLOCATED(ParamData%AddBQuad)) THEN - DEALLOCATE(ParamData%AddBQuad) -ENDIF -IF (ALLOCATED(ParamData%OutParam)) THEN -DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_DestroyOutParmType( ParamData%OutParam(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%OutParam) -ENDIF -IF (ALLOCATED(ParamData%Jac_u_indx)) THEN - DEALLOCATE(ParamData%Jac_u_indx) -ENDIF -IF (ALLOCATED(ParamData%du)) THEN - DEALLOCATE(ParamData%du) -ENDIF -IF (ALLOCATED(ParamData%dx)) THEN - DEALLOCATE(ParamData%dx) -ENDIF - END SUBROUTINE HydroDyn_DestroyParam + ErrMsg = '' + DstParamData%nWAMITObj = SrcParamData%nWAMITObj + DstParamData%vecMultiplier = SrcParamData%vecMultiplier + if (allocated(SrcParamData%WAMIT)) then + LB(1:1) = lbound(SrcParamData%WAMIT) + UB(1:1) = ubound(SrcParamData%WAMIT) + if (.not. allocated(DstParamData%WAMIT)) then + allocate(DstParamData%WAMIT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WAMIT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call WAMIT_CopyParam(SrcParamData%WAMIT(i1), DstParamData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstParamData%WAMIT)) then + deallocate(DstParamData%WAMIT) + end if + if (allocated(SrcParamData%WAMIT2)) then + LB(1:1) = lbound(SrcParamData%WAMIT2) + UB(1:1) = ubound(SrcParamData%WAMIT2) + if (.not. allocated(DstParamData%WAMIT2)) then + allocate(DstParamData%WAMIT2(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WAMIT2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call WAMIT2_CopyParam(SrcParamData%WAMIT2(i1), DstParamData%WAMIT2(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstParamData%WAMIT2)) then + deallocate(DstParamData%WAMIT2) + end if + DstParamData%WAMIT2used = SrcParamData%WAMIT2used + call Morison_CopyParam(SrcParamData%Morison, DstParamData%Morison, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstParamData%PotMod = SrcParamData%PotMod + DstParamData%NBody = SrcParamData%NBody + DstParamData%NBodyMod = SrcParamData%NBodyMod + DstParamData%totalStates = SrcParamData%totalStates + DstParamData%totalExctnStates = SrcParamData%totalExctnStates + DstParamData%totalRdtnStates = SrcParamData%totalRdtnStates + DstParamData%WaveTime => SrcParamData%WaveTime + DstParamData%NStepWave = SrcParamData%NStepWave + DstParamData%WtrDpth = SrcParamData%WtrDpth + if (allocated(SrcParamData%AddF0)) then + LB(1:2) = lbound(SrcParamData%AddF0) + UB(1:2) = ubound(SrcParamData%AddF0) + if (.not. allocated(DstParamData%AddF0)) then + allocate(DstParamData%AddF0(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AddF0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AddF0 = SrcParamData%AddF0 + else if (allocated(DstParamData%AddF0)) then + deallocate(DstParamData%AddF0) + end if + if (allocated(SrcParamData%AddCLin)) then + LB(1:3) = lbound(SrcParamData%AddCLin) + UB(1:3) = ubound(SrcParamData%AddCLin) + if (.not. allocated(DstParamData%AddCLin)) then + allocate(DstParamData%AddCLin(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AddCLin.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AddCLin = SrcParamData%AddCLin + else if (allocated(DstParamData%AddCLin)) then + deallocate(DstParamData%AddCLin) + end if + if (allocated(SrcParamData%AddBLin)) then + LB(1:3) = lbound(SrcParamData%AddBLin) + UB(1:3) = ubound(SrcParamData%AddBLin) + if (.not. allocated(DstParamData%AddBLin)) then + allocate(DstParamData%AddBLin(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AddBLin.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AddBLin = SrcParamData%AddBLin + else if (allocated(DstParamData%AddBLin)) then + deallocate(DstParamData%AddBLin) + end if + if (allocated(SrcParamData%AddBQuad)) then + LB(1:3) = lbound(SrcParamData%AddBQuad) + UB(1:3) = ubound(SrcParamData%AddBQuad) + if (.not. allocated(DstParamData%AddBQuad)) then + allocate(DstParamData%AddBQuad(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AddBQuad.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AddBQuad = SrcParamData%AddBQuad + else if (allocated(DstParamData%AddBQuad)) then + deallocate(DstParamData%AddBQuad) + end if + DstParamData%DT = SrcParamData%DT + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstParamData%OutParam)) then + deallocate(DstParamData%OutParam) + end if + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%NumTotalOuts = SrcParamData%NumTotalOuts + DstParamData%OutSwtch = SrcParamData%OutSwtch + DstParamData%OutFmt = SrcParamData%OutFmt + DstParamData%OutSFmt = SrcParamData%OutSFmt + DstParamData%Delim = SrcParamData%Delim + DstParamData%UnOutFile = SrcParamData%UnOutFile + DstParamData%OutDec = SrcParamData%OutDec + if (allocated(SrcParamData%Jac_u_indx)) then + LB(1:2) = lbound(SrcParamData%Jac_u_indx) + UB(1:2) = ubound(SrcParamData%Jac_u_indx) + if (.not. allocated(DstParamData%Jac_u_indx)) then + allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx + else if (allocated(DstParamData%Jac_u_indx)) then + deallocate(DstParamData%Jac_u_indx) + end if + if (allocated(SrcParamData%du)) then + LB(1:1) = lbound(SrcParamData%du) + UB(1:1) = ubound(SrcParamData%du) + if (.not. allocated(DstParamData%du)) then + allocate(DstParamData%du(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%du = SrcParamData%du + else if (allocated(DstParamData%du)) then + deallocate(DstParamData%du) + end if + if (allocated(SrcParamData%dx)) then + LB(1:1) = lbound(SrcParamData%dx) + UB(1:1) = ubound(SrcParamData%dx) + if (.not. allocated(DstParamData%dx)) then + allocate(DstParamData%dx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%dx = SrcParamData%dx + else if (allocated(DstParamData%dx)) then + deallocate(DstParamData%dx) + end if + DstParamData%Jac_ny = SrcParamData%Jac_ny + DstParamData%PointsToSeaState = SrcParamData%PointsToSeaState +end subroutine +subroutine HydroDyn_DestroyParam(ParamData, ErrStat, ErrMsg) + type(HydroDyn_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%WAMIT)) then + LB(1:1) = lbound(ParamData%WAMIT) + UB(1:1) = ubound(ParamData%WAMIT) + do i1 = LB(1), UB(1) + call WAMIT_DestroyParam(ParamData%WAMIT(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%WAMIT) + end if + if (allocated(ParamData%WAMIT2)) then + LB(1:1) = lbound(ParamData%WAMIT2) + UB(1:1) = ubound(ParamData%WAMIT2) + do i1 = LB(1), UB(1) + call WAMIT2_DestroyParam(ParamData%WAMIT2(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%WAMIT2) + end if + nullify(ParamData%WaveTime) + if (allocated(ParamData%AddF0)) then + deallocate(ParamData%AddF0) + end if + if (allocated(ParamData%AddCLin)) then + deallocate(ParamData%AddCLin) + end if + if (allocated(ParamData%AddBLin)) then + deallocate(ParamData%AddBLin) + end if + if (allocated(ParamData%AddBQuad)) then + deallocate(ParamData%AddBQuad) + end if + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%OutParam) + end if + if (allocated(ParamData%Jac_u_indx)) then + deallocate(ParamData%Jac_u_indx) + end if + if (allocated(ParamData%du)) then + deallocate(ParamData%du) + end if + if (allocated(ParamData%dx)) then + deallocate(ParamData%dx) + end if +end subroutine subroutine HydroDyn_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -2790,13 +2557,10 @@ subroutine HydroDyn_PackParam(Buf, Indata) integer(IntKi) :: LB(3), UB(3) logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return - ! nWAMITObj call RegPack(Buf, InData%nWAMITObj) if (RegCheckErr(Buf, RoutineName)) return - ! vecMultiplier call RegPack(Buf, InData%vecMultiplier) if (RegCheckErr(Buf, RoutineName)) return - ! WAMIT call RegPack(Buf, allocated(InData%WAMIT)) if (allocated(InData%WAMIT)) then call RegPackBounds(Buf, 1, lbound(InData%WAMIT), ubound(InData%WAMIT)) @@ -2807,7 +2571,6 @@ subroutine HydroDyn_PackParam(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! WAMIT2 call RegPack(Buf, allocated(InData%WAMIT2)) if (allocated(InData%WAMIT2)) then call RegPackBounds(Buf, 1, lbound(InData%WAMIT2), ubound(InData%WAMIT2)) @@ -2818,31 +2581,22 @@ subroutine HydroDyn_PackParam(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! WAMIT2used call RegPack(Buf, InData%WAMIT2used) if (RegCheckErr(Buf, RoutineName)) return - ! Morison call Morison_PackParam(Buf, InData%Morison) if (RegCheckErr(Buf, RoutineName)) return - ! PotMod call RegPack(Buf, InData%PotMod) if (RegCheckErr(Buf, RoutineName)) return - ! NBody call RegPack(Buf, InData%NBody) if (RegCheckErr(Buf, RoutineName)) return - ! NBodyMod call RegPack(Buf, InData%NBodyMod) if (RegCheckErr(Buf, RoutineName)) return - ! totalStates call RegPack(Buf, InData%totalStates) if (RegCheckErr(Buf, RoutineName)) return - ! totalExctnStates call RegPack(Buf, InData%totalExctnStates) if (RegCheckErr(Buf, RoutineName)) return - ! totalRdtnStates call RegPack(Buf, InData%totalRdtnStates) if (RegCheckErr(Buf, RoutineName)) return - ! WaveTime call RegPack(Buf, associated(InData%WaveTime)) if (associated(InData%WaveTime)) then call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) @@ -2852,44 +2606,36 @@ subroutine HydroDyn_PackParam(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! NStepWave call RegPack(Buf, InData%NStepWave) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDpth call RegPack(Buf, InData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - ! AddF0 call RegPack(Buf, allocated(InData%AddF0)) if (allocated(InData%AddF0)) then call RegPackBounds(Buf, 2, lbound(InData%AddF0), ubound(InData%AddF0)) call RegPack(Buf, InData%AddF0) end if if (RegCheckErr(Buf, RoutineName)) return - ! AddCLin call RegPack(Buf, allocated(InData%AddCLin)) if (allocated(InData%AddCLin)) then call RegPackBounds(Buf, 3, lbound(InData%AddCLin), ubound(InData%AddCLin)) call RegPack(Buf, InData%AddCLin) end if if (RegCheckErr(Buf, RoutineName)) return - ! AddBLin call RegPack(Buf, allocated(InData%AddBLin)) if (allocated(InData%AddBLin)) then call RegPackBounds(Buf, 3, lbound(InData%AddBLin), ubound(InData%AddBLin)) call RegPack(Buf, InData%AddBLin) end if if (RegCheckErr(Buf, RoutineName)) return - ! AddBQuad call RegPack(Buf, allocated(InData%AddBQuad)) if (allocated(InData%AddBQuad)) then call RegPackBounds(Buf, 3, lbound(InData%AddBQuad), ubound(InData%AddBQuad)) call RegPack(Buf, InData%AddBQuad) end if if (RegCheckErr(Buf, RoutineName)) return - ! DT call RegPack(Buf, InData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! OutParam call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) @@ -2900,55 +2646,42 @@ subroutine HydroDyn_PackParam(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegPack(Buf, InData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! NumTotalOuts call RegPack(Buf, InData%NumTotalOuts) if (RegCheckErr(Buf, RoutineName)) return - ! OutSwtch call RegPack(Buf, InData%OutSwtch) if (RegCheckErr(Buf, RoutineName)) return - ! OutFmt call RegPack(Buf, InData%OutFmt) if (RegCheckErr(Buf, RoutineName)) return - ! OutSFmt call RegPack(Buf, InData%OutSFmt) if (RegCheckErr(Buf, RoutineName)) return - ! Delim call RegPack(Buf, InData%Delim) if (RegCheckErr(Buf, RoutineName)) return - ! UnOutFile call RegPack(Buf, InData%UnOutFile) if (RegCheckErr(Buf, RoutineName)) return - ! OutDec call RegPack(Buf, InData%OutDec) if (RegCheckErr(Buf, RoutineName)) return - ! Jac_u_indx call RegPack(Buf, allocated(InData%Jac_u_indx)) if (allocated(InData%Jac_u_indx)) then call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx), ubound(InData%Jac_u_indx)) call RegPack(Buf, InData%Jac_u_indx) end if if (RegCheckErr(Buf, RoutineName)) return - ! du call RegPack(Buf, allocated(InData%du)) if (allocated(InData%du)) then call RegPackBounds(Buf, 1, lbound(InData%du), ubound(InData%du)) call RegPack(Buf, InData%du) end if if (RegCheckErr(Buf, RoutineName)) return - ! dx call RegPack(Buf, allocated(InData%dx)) if (allocated(InData%dx)) then call RegPackBounds(Buf, 1, lbound(InData%dx), ubound(InData%dx)) call RegPack(Buf, InData%dx) end if if (RegCheckErr(Buf, RoutineName)) return - ! Jac_ny call RegPack(Buf, InData%Jac_ny) if (RegCheckErr(Buf, RoutineName)) return - ! PointsToSeaState call RegPack(Buf, InData%PointsToSeaState) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2964,13 +2697,10 @@ subroutine HydroDyn_UnPackParam(Buf, OutData) integer(IntKi) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return - ! nWAMITObj call RegUnpack(Buf, OutData%nWAMITObj) if (RegCheckErr(Buf, RoutineName)) return - ! vecMultiplier call RegUnpack(Buf, OutData%vecMultiplier) if (RegCheckErr(Buf, RoutineName)) return - ! WAMIT if (allocated(OutData%WAMIT)) deallocate(OutData%WAMIT) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2986,7 +2716,6 @@ subroutine HydroDyn_UnPackParam(Buf, OutData) call WAMIT_UnpackParam(Buf, OutData%WAMIT(i1)) ! WAMIT end do end if - ! WAMIT2 if (allocated(OutData%WAMIT2)) deallocate(OutData%WAMIT2) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3002,30 +2731,21 @@ subroutine HydroDyn_UnPackParam(Buf, OutData) call WAMIT2_UnpackParam(Buf, OutData%WAMIT2(i1)) ! WAMIT2 end do end if - ! WAMIT2used call RegUnpack(Buf, OutData%WAMIT2used) if (RegCheckErr(Buf, RoutineName)) return - ! Morison call Morison_UnpackParam(Buf, OutData%Morison) ! Morison - ! PotMod call RegUnpack(Buf, OutData%PotMod) if (RegCheckErr(Buf, RoutineName)) return - ! NBody call RegUnpack(Buf, OutData%NBody) if (RegCheckErr(Buf, RoutineName)) return - ! NBodyMod call RegUnpack(Buf, OutData%NBodyMod) if (RegCheckErr(Buf, RoutineName)) return - ! totalStates call RegUnpack(Buf, OutData%totalStates) if (RegCheckErr(Buf, RoutineName)) return - ! totalExctnStates call RegUnpack(Buf, OutData%totalExctnStates) if (RegCheckErr(Buf, RoutineName)) return - ! totalRdtnStates call RegUnpack(Buf, OutData%totalRdtnStates) if (RegCheckErr(Buf, RoutineName)) return - ! WaveTime if (associated(OutData%WaveTime)) deallocate(OutData%WaveTime) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3050,13 +2770,10 @@ subroutine HydroDyn_UnPackParam(Buf, OutData) else OutData%WaveTime => null() end if - ! NStepWave call RegUnpack(Buf, OutData%NStepWave) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDpth call RegUnpack(Buf, OutData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - ! AddF0 if (allocated(OutData%AddF0)) deallocate(OutData%AddF0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3071,7 +2788,6 @@ subroutine HydroDyn_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%AddF0) if (RegCheckErr(Buf, RoutineName)) return end if - ! AddCLin if (allocated(OutData%AddCLin)) deallocate(OutData%AddCLin) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3086,7 +2802,6 @@ subroutine HydroDyn_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%AddCLin) if (RegCheckErr(Buf, RoutineName)) return end if - ! AddBLin if (allocated(OutData%AddBLin)) deallocate(OutData%AddBLin) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3101,7 +2816,6 @@ subroutine HydroDyn_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%AddBLin) if (RegCheckErr(Buf, RoutineName)) return end if - ! AddBQuad if (allocated(OutData%AddBQuad)) deallocate(OutData%AddBQuad) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3116,10 +2830,8 @@ subroutine HydroDyn_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%AddBQuad) if (RegCheckErr(Buf, RoutineName)) return end if - ! DT call RegUnpack(Buf, OutData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! OutParam if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3135,31 +2847,22 @@ subroutine HydroDyn_UnPackParam(Buf, OutData) call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam end do end if - ! NumOuts call RegUnpack(Buf, OutData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! NumTotalOuts call RegUnpack(Buf, OutData%NumTotalOuts) if (RegCheckErr(Buf, RoutineName)) return - ! OutSwtch call RegUnpack(Buf, OutData%OutSwtch) if (RegCheckErr(Buf, RoutineName)) return - ! OutFmt call RegUnpack(Buf, OutData%OutFmt) if (RegCheckErr(Buf, RoutineName)) return - ! OutSFmt call RegUnpack(Buf, OutData%OutSFmt) if (RegCheckErr(Buf, RoutineName)) return - ! Delim call RegUnpack(Buf, OutData%Delim) if (RegCheckErr(Buf, RoutineName)) return - ! UnOutFile call RegUnpack(Buf, OutData%UnOutFile) if (RegCheckErr(Buf, RoutineName)) return - ! OutDec call RegUnpack(Buf, OutData%OutDec) if (RegCheckErr(Buf, RoutineName)) return - ! Jac_u_indx if (allocated(OutData%Jac_u_indx)) deallocate(OutData%Jac_u_indx) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3174,7 +2877,6 @@ subroutine HydroDyn_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%Jac_u_indx) if (RegCheckErr(Buf, RoutineName)) return end if - ! du if (allocated(OutData%du)) deallocate(OutData%du) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3189,7 +2891,6 @@ subroutine HydroDyn_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%du) if (RegCheckErr(Buf, RoutineName)) return end if - ! dx if (allocated(OutData%dx)) deallocate(OutData%dx) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3204,72 +2905,54 @@ subroutine HydroDyn_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%dx) if (RegCheckErr(Buf, RoutineName)) return end if - ! Jac_ny call RegUnpack(Buf, OutData%Jac_ny) if (RegCheckErr(Buf, RoutineName)) return - ! PointsToSeaState call RegUnpack(Buf, OutData%PointsToSeaState) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE HydroDyn_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HydroDyn_InputType), INTENT(INOUT) :: SrcInputData - TYPE(HydroDyn_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_CopyInput' -! + +subroutine HydroDyn_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(HydroDyn_InputType), intent(inout) :: SrcInputData + type(HydroDyn_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_CopyInput' ErrStat = ErrID_None - ErrMsg = "" - CALL Morison_CopyInput( SrcInputData%Morison, DstInputData%Morison, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcInputData%WAMITMesh, DstInputData%WAMITMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcInputData%PRPMesh, DstInputData%PRPMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE HydroDyn_CopyInput - - SUBROUTINE HydroDyn_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(HydroDyn_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL Morison_DestroyInput( InputData%Morison, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( InputData%WAMITMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( InputData%PRPMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE HydroDyn_DestroyInput + ErrMsg = '' + call Morison_CopyInput(SrcInputData%Morison, DstInputData%Morison, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcInputData%WAMITMesh, DstInputData%WAMITMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcInputData%PRPMesh, DstInputData%PRPMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine HydroDyn_DestroyInput(InputData, ErrStat, ErrMsg) + type(HydroDyn_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine HydroDyn_PackInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(HydroDyn_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'HydroDyn_PackInput' if (Buf%ErrStat >= AbortErrLev) return - ! Morison call Morison_PackInput(Buf, InData%Morison) if (RegCheckErr(Buf, RoutineName)) return - ! WAMITMesh call MeshPack(Buf, InData%WAMITMesh) if (RegCheckErr(Buf, RoutineName)) return - ! PRPMesh call MeshPack(Buf, InData%PRPMesh) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3279,116 +2962,115 @@ subroutine HydroDyn_UnPackInput(Buf, OutData) type(HydroDyn_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'HydroDyn_UnPackInput' if (Buf%ErrStat /= ErrID_None) return - ! Morison call Morison_UnpackInput(Buf, OutData%Morison) ! Morison - ! WAMITMesh call MeshUnpack(Buf, OutData%WAMITMesh) ! WAMITMesh - ! PRPMesh call MeshUnpack(Buf, OutData%PRPMesh) ! PRPMesh end subroutine - SUBROUTINE HydroDyn_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HydroDyn_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(HydroDyn_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_CopyOutput' -! + +subroutine HydroDyn_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(HydroDyn_OutputType), intent(inout) :: SrcOutputData + type(HydroDyn_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_CopyOutput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%WAMIT)) THEN - i1_l = LBOUND(SrcOutputData%WAMIT,1) - i1_u = UBOUND(SrcOutputData%WAMIT,1) - IF (.NOT. ALLOCATED(DstOutputData%WAMIT)) THEN - ALLOCATE(DstOutputData%WAMIT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WAMIT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOutputData%WAMIT,1), UBOUND(SrcOutputData%WAMIT,1) - CALL WAMIT_CopyOutput( SrcOutputData%WAMIT(i1), DstOutputData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcOutputData%WAMIT2)) THEN - i1_l = LBOUND(SrcOutputData%WAMIT2,1) - i1_u = UBOUND(SrcOutputData%WAMIT2,1) - IF (.NOT. ALLOCATED(DstOutputData%WAMIT2)) THEN - ALLOCATE(DstOutputData%WAMIT2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WAMIT2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOutputData%WAMIT2,1), UBOUND(SrcOutputData%WAMIT2,1) - CALL WAMIT2_CopyOutput( SrcOutputData%WAMIT2(i1), DstOutputData%WAMIT2(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL Morison_CopyOutput( SrcOutputData%Morison, DstOutputData%Morison, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcOutputData%WAMITMesh, DstOutputData%WAMITMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcOutputData%WriteOutput)) THEN - i1_l = LBOUND(SrcOutputData%WriteOutput,1) - i1_u = UBOUND(SrcOutputData%WriteOutput,1) - IF (.NOT. ALLOCATED(DstOutputData%WriteOutput)) THEN - ALLOCATE(DstOutputData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%WriteOutput = SrcOutputData%WriteOutput -ENDIF - END SUBROUTINE HydroDyn_CopyOutput - - SUBROUTINE HydroDyn_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(HydroDyn_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OutputData%WAMIT)) THEN -DO i1 = LBOUND(OutputData%WAMIT,1), UBOUND(OutputData%WAMIT,1) - CALL WAMIT_DestroyOutput( OutputData%WAMIT(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OutputData%WAMIT) -ENDIF -IF (ALLOCATED(OutputData%WAMIT2)) THEN -DO i1 = LBOUND(OutputData%WAMIT2,1), UBOUND(OutputData%WAMIT2,1) - CALL WAMIT2_DestroyOutput( OutputData%WAMIT2(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OutputData%WAMIT2) -ENDIF - CALL Morison_DestroyOutput( OutputData%Morison, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( OutputData%WAMITMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - END SUBROUTINE HydroDyn_DestroyOutput + ErrMsg = '' + if (allocated(SrcOutputData%WAMIT)) then + LB(1:1) = lbound(SrcOutputData%WAMIT) + UB(1:1) = ubound(SrcOutputData%WAMIT) + if (.not. allocated(DstOutputData%WAMIT)) then + allocate(DstOutputData%WAMIT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WAMIT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call WAMIT_CopyOutput(SrcOutputData%WAMIT(i1), DstOutputData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstOutputData%WAMIT)) then + deallocate(DstOutputData%WAMIT) + end if + if (allocated(SrcOutputData%WAMIT2)) then + LB(1:1) = lbound(SrcOutputData%WAMIT2) + UB(1:1) = ubound(SrcOutputData%WAMIT2) + if (.not. allocated(DstOutputData%WAMIT2)) then + allocate(DstOutputData%WAMIT2(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WAMIT2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call WAMIT2_CopyOutput(SrcOutputData%WAMIT2(i1), DstOutputData%WAMIT2(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstOutputData%WAMIT2)) then + deallocate(DstOutputData%WAMIT2) + end if + call Morison_CopyOutput(SrcOutputData%Morison, DstOutputData%Morison, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcOutputData%WAMITMesh, DstOutputData%WAMITMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%WriteOutput = SrcOutputData%WriteOutput + else if (allocated(DstOutputData%WriteOutput)) then + deallocate(DstOutputData%WriteOutput) + end if +end subroutine +subroutine HydroDyn_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(HydroDyn_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%WAMIT)) then + LB(1:1) = lbound(OutputData%WAMIT) + UB(1:1) = ubound(OutputData%WAMIT) + do i1 = LB(1), UB(1) + call WAMIT_DestroyOutput(OutputData%WAMIT(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%WAMIT) + end if + if (allocated(OutputData%WAMIT2)) then + LB(1:1) = lbound(OutputData%WAMIT2) + UB(1:1) = ubound(OutputData%WAMIT2) + do i1 = LB(1), UB(1) + call WAMIT2_DestroyOutput(OutputData%WAMIT2(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%WAMIT2) + end if + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine subroutine HydroDyn_PackOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -3397,7 +3079,6 @@ subroutine HydroDyn_PackOutput(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! WAMIT call RegPack(Buf, allocated(InData%WAMIT)) if (allocated(InData%WAMIT)) then call RegPackBounds(Buf, 1, lbound(InData%WAMIT), ubound(InData%WAMIT)) @@ -3408,7 +3089,6 @@ subroutine HydroDyn_PackOutput(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! WAMIT2 call RegPack(Buf, allocated(InData%WAMIT2)) if (allocated(InData%WAMIT2)) then call RegPackBounds(Buf, 1, lbound(InData%WAMIT2), ubound(InData%WAMIT2)) @@ -3419,13 +3099,10 @@ subroutine HydroDyn_PackOutput(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! Morison call Morison_PackOutput(Buf, InData%Morison) if (RegCheckErr(Buf, RoutineName)) return - ! WAMITMesh call MeshPack(Buf, InData%WAMITMesh) if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutput call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) @@ -3443,7 +3120,6 @@ subroutine HydroDyn_UnPackOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! WAMIT if (allocated(OutData%WAMIT)) deallocate(OutData%WAMIT) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3459,7 +3135,6 @@ subroutine HydroDyn_UnPackOutput(Buf, OutData) call WAMIT_UnpackOutput(Buf, OutData%WAMIT(i1)) ! WAMIT end do end if - ! WAMIT2 if (allocated(OutData%WAMIT2)) deallocate(OutData%WAMIT2) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3475,11 +3150,8 @@ subroutine HydroDyn_UnPackOutput(Buf, OutData) call WAMIT2_UnpackOutput(Buf, OutData%WAMIT2(i1)) ! WAMIT2 end do end if - ! Morison call Morison_UnpackOutput(Buf, OutData%Morison) ! Morison - ! WAMITMesh call MeshUnpack(Buf, OutData%WAMITMesh) ! WAMITMesh - ! WriteOutput if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/hydrodyn/src/Morison_Types.f90 b/modules/hydrodyn/src/Morison_Types.f90 index e1e5551a15..d574ba006c 100644 --- a/modules/hydrodyn/src/Morison_Types.f90 +++ b/modules/hydrodyn/src/Morison_Types.f90 @@ -436,70 +436,51 @@ MODULE Morison_Types END TYPE Morison_OutputType ! ======================= CONTAINS - SUBROUTINE Morison_CopyJointType( SrcJointTypeData, DstJointTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_JointType), INTENT(IN) :: SrcJointTypeData - TYPE(Morison_JointType), INTENT(INOUT) :: DstJointTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_CopyJointType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstJointTypeData%JointID = SrcJointTypeData%JointID - DstJointTypeData%Position = SrcJointTypeData%Position - DstJointTypeData%JointAxID = SrcJointTypeData%JointAxID - DstJointTypeData%JointAxIDIndx = SrcJointTypeData%JointAxIDIndx - DstJointTypeData%JointOvrlp = SrcJointTypeData%JointOvrlp - DstJointTypeData%NConnections = SrcJointTypeData%NConnections - DstJointTypeData%ConnectionList = SrcJointTypeData%ConnectionList - END SUBROUTINE Morison_CopyJointType - - SUBROUTINE Morison_DestroyJointType( JointTypeData, ErrStat, ErrMsg ) - TYPE(Morison_JointType), INTENT(INOUT) :: JointTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyJointType' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Morison_DestroyJointType +subroutine Morison_CopyJointType(SrcJointTypeData, DstJointTypeData, CtrlCode, ErrStat, ErrMsg) + type(Morison_JointType), intent(in) :: SrcJointTypeData + type(Morison_JointType), intent(inout) :: DstJointTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_CopyJointType' + ErrStat = ErrID_None + ErrMsg = '' + DstJointTypeData%JointID = SrcJointTypeData%JointID + DstJointTypeData%Position = SrcJointTypeData%Position + DstJointTypeData%JointAxID = SrcJointTypeData%JointAxID + DstJointTypeData%JointAxIDIndx = SrcJointTypeData%JointAxIDIndx + DstJointTypeData%JointOvrlp = SrcJointTypeData%JointOvrlp + DstJointTypeData%NConnections = SrcJointTypeData%NConnections + DstJointTypeData%ConnectionList = SrcJointTypeData%ConnectionList +end subroutine +subroutine Morison_DestroyJointType(JointTypeData, ErrStat, ErrMsg) + type(Morison_JointType), intent(inout) :: JointTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyJointType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine Morison_PackJointType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Morison_JointType), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackJointType' if (Buf%ErrStat >= AbortErrLev) return - ! JointID call RegPack(Buf, InData%JointID) if (RegCheckErr(Buf, RoutineName)) return - ! Position call RegPack(Buf, InData%Position) if (RegCheckErr(Buf, RoutineName)) return - ! JointAxID call RegPack(Buf, InData%JointAxID) if (RegCheckErr(Buf, RoutineName)) return - ! JointAxIDIndx call RegPack(Buf, InData%JointAxIDIndx) if (RegCheckErr(Buf, RoutineName)) return - ! JointOvrlp call RegPack(Buf, InData%JointOvrlp) if (RegCheckErr(Buf, RoutineName)) return - ! NConnections call RegPack(Buf, InData%NConnections) if (RegCheckErr(Buf, RoutineName)) return - ! ConnectionList call RegPack(Buf, InData%ConnectionList) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -509,75 +490,54 @@ subroutine Morison_UnPackJointType(Buf, OutData) type(Morison_JointType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackJointType' if (Buf%ErrStat /= ErrID_None) return - ! JointID call RegUnpack(Buf, OutData%JointID) if (RegCheckErr(Buf, RoutineName)) return - ! Position call RegUnpack(Buf, OutData%Position) if (RegCheckErr(Buf, RoutineName)) return - ! JointAxID call RegUnpack(Buf, OutData%JointAxID) if (RegCheckErr(Buf, RoutineName)) return - ! JointAxIDIndx call RegUnpack(Buf, OutData%JointAxIDIndx) if (RegCheckErr(Buf, RoutineName)) return - ! JointOvrlp call RegUnpack(Buf, OutData%JointOvrlp) if (RegCheckErr(Buf, RoutineName)) return - ! NConnections call RegUnpack(Buf, OutData%NConnections) if (RegCheckErr(Buf, RoutineName)) return - ! ConnectionList call RegUnpack(Buf, OutData%ConnectionList) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Morison_CopyMemberPropType( SrcMemberPropTypeData, DstMemberPropTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_MemberPropType), INTENT(IN) :: SrcMemberPropTypeData - TYPE(Morison_MemberPropType), INTENT(INOUT) :: DstMemberPropTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_CopyMemberPropType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstMemberPropTypeData%PropSetID = SrcMemberPropTypeData%PropSetID - DstMemberPropTypeData%PropD = SrcMemberPropTypeData%PropD - DstMemberPropTypeData%PropThck = SrcMemberPropTypeData%PropThck - END SUBROUTINE Morison_CopyMemberPropType - - SUBROUTINE Morison_DestroyMemberPropType( MemberPropTypeData, ErrStat, ErrMsg ) - TYPE(Morison_MemberPropType), INTENT(INOUT) :: MemberPropTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyMemberPropType' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Morison_DestroyMemberPropType +subroutine Morison_CopyMemberPropType(SrcMemberPropTypeData, DstMemberPropTypeData, CtrlCode, ErrStat, ErrMsg) + type(Morison_MemberPropType), intent(in) :: SrcMemberPropTypeData + type(Morison_MemberPropType), intent(inout) :: DstMemberPropTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_CopyMemberPropType' + ErrStat = ErrID_None + ErrMsg = '' + DstMemberPropTypeData%PropSetID = SrcMemberPropTypeData%PropSetID + DstMemberPropTypeData%PropD = SrcMemberPropTypeData%PropD + DstMemberPropTypeData%PropThck = SrcMemberPropTypeData%PropThck +end subroutine +subroutine Morison_DestroyMemberPropType(MemberPropTypeData, ErrStat, ErrMsg) + type(Morison_MemberPropType), intent(inout) :: MemberPropTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyMemberPropType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine Morison_PackMemberPropType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Morison_MemberPropType), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackMemberPropType' if (Buf%ErrStat >= AbortErrLev) return - ! PropSetID call RegPack(Buf, InData%PropSetID) if (RegCheckErr(Buf, RoutineName)) return - ! PropD call RegPack(Buf, InData%PropD) if (RegCheckErr(Buf, RoutineName)) return - ! PropThck call RegPack(Buf, InData%PropThck) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -587,90 +547,74 @@ subroutine Morison_UnPackMemberPropType(Buf, OutData) type(Morison_MemberPropType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackMemberPropType' if (Buf%ErrStat /= ErrID_None) return - ! PropSetID call RegUnpack(Buf, OutData%PropSetID) if (RegCheckErr(Buf, RoutineName)) return - ! PropD call RegUnpack(Buf, OutData%PropD) if (RegCheckErr(Buf, RoutineName)) return - ! PropThck call RegUnpack(Buf, OutData%PropThck) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Morison_CopyFilledGroupType( SrcFilledGroupTypeData, DstFilledGroupTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_FilledGroupType), INTENT(IN) :: SrcFilledGroupTypeData - TYPE(Morison_FilledGroupType), INTENT(INOUT) :: DstFilledGroupTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_CopyFilledGroupType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstFilledGroupTypeData%FillNumM = SrcFilledGroupTypeData%FillNumM -IF (ALLOCATED(SrcFilledGroupTypeData%FillMList)) THEN - i1_l = LBOUND(SrcFilledGroupTypeData%FillMList,1) - i1_u = UBOUND(SrcFilledGroupTypeData%FillMList,1) - IF (.NOT. ALLOCATED(DstFilledGroupTypeData%FillMList)) THEN - ALLOCATE(DstFilledGroupTypeData%FillMList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFilledGroupTypeData%FillMList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstFilledGroupTypeData%FillMList = SrcFilledGroupTypeData%FillMList -ENDIF - DstFilledGroupTypeData%FillFSLoc = SrcFilledGroupTypeData%FillFSLoc - DstFilledGroupTypeData%FillDensChr = SrcFilledGroupTypeData%FillDensChr - DstFilledGroupTypeData%FillDens = SrcFilledGroupTypeData%FillDens - END SUBROUTINE Morison_CopyFilledGroupType - - SUBROUTINE Morison_DestroyFilledGroupType( FilledGroupTypeData, ErrStat, ErrMsg ) - TYPE(Morison_FilledGroupType), INTENT(INOUT) :: FilledGroupTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyFilledGroupType' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(FilledGroupTypeData%FillMList)) THEN - DEALLOCATE(FilledGroupTypeData%FillMList) -ENDIF - END SUBROUTINE Morison_DestroyFilledGroupType +subroutine Morison_CopyFilledGroupType(SrcFilledGroupTypeData, DstFilledGroupTypeData, CtrlCode, ErrStat, ErrMsg) + type(Morison_FilledGroupType), intent(in) :: SrcFilledGroupTypeData + type(Morison_FilledGroupType), intent(inout) :: DstFilledGroupTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Morison_CopyFilledGroupType' + ErrStat = ErrID_None + ErrMsg = '' + DstFilledGroupTypeData%FillNumM = SrcFilledGroupTypeData%FillNumM + if (allocated(SrcFilledGroupTypeData%FillMList)) then + LB(1:1) = lbound(SrcFilledGroupTypeData%FillMList) + UB(1:1) = ubound(SrcFilledGroupTypeData%FillMList) + if (.not. allocated(DstFilledGroupTypeData%FillMList)) then + allocate(DstFilledGroupTypeData%FillMList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstFilledGroupTypeData%FillMList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstFilledGroupTypeData%FillMList = SrcFilledGroupTypeData%FillMList + else if (allocated(DstFilledGroupTypeData%FillMList)) then + deallocate(DstFilledGroupTypeData%FillMList) + end if + DstFilledGroupTypeData%FillFSLoc = SrcFilledGroupTypeData%FillFSLoc + DstFilledGroupTypeData%FillDensChr = SrcFilledGroupTypeData%FillDensChr + DstFilledGroupTypeData%FillDens = SrcFilledGroupTypeData%FillDens +end subroutine +subroutine Morison_DestroyFilledGroupType(FilledGroupTypeData, ErrStat, ErrMsg) + type(Morison_FilledGroupType), intent(inout) :: FilledGroupTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyFilledGroupType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(FilledGroupTypeData%FillMList)) then + deallocate(FilledGroupTypeData%FillMList) + end if +end subroutine subroutine Morison_PackFilledGroupType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Morison_FilledGroupType), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackFilledGroupType' if (Buf%ErrStat >= AbortErrLev) return - ! FillNumM call RegPack(Buf, InData%FillNumM) if (RegCheckErr(Buf, RoutineName)) return - ! FillMList call RegPack(Buf, allocated(InData%FillMList)) if (allocated(InData%FillMList)) then call RegPackBounds(Buf, 1, lbound(InData%FillMList), ubound(InData%FillMList)) call RegPack(Buf, InData%FillMList) end if if (RegCheckErr(Buf, RoutineName)) return - ! FillFSLoc call RegPack(Buf, InData%FillFSLoc) if (RegCheckErr(Buf, RoutineName)) return - ! FillDensChr call RegPack(Buf, InData%FillDensChr) if (RegCheckErr(Buf, RoutineName)) return - ! FillDens call RegPack(Buf, InData%FillDens) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -683,10 +627,8 @@ subroutine Morison_UnPackFilledGroupType(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! FillNumM call RegUnpack(Buf, OutData%FillNumM) if (RegCheckErr(Buf, RoutineName)) return - ! FillMList if (allocated(OutData%FillMList)) deallocate(OutData%FillMList) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -701,115 +643,85 @@ subroutine Morison_UnPackFilledGroupType(Buf, OutData) call RegUnpack(Buf, OutData%FillMList) if (RegCheckErr(Buf, RoutineName)) return end if - ! FillFSLoc call RegUnpack(Buf, OutData%FillFSLoc) if (RegCheckErr(Buf, RoutineName)) return - ! FillDensChr call RegUnpack(Buf, OutData%FillDensChr) if (RegCheckErr(Buf, RoutineName)) return - ! FillDens call RegUnpack(Buf, OutData%FillDens) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Morison_CopyCoefDpths( SrcCoefDpthsData, DstCoefDpthsData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_CoefDpths), INTENT(IN) :: SrcCoefDpthsData - TYPE(Morison_CoefDpths), INTENT(INOUT) :: DstCoefDpthsData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_CopyCoefDpths' -! - ErrStat = ErrID_None - ErrMsg = "" - DstCoefDpthsData%Dpth = SrcCoefDpthsData%Dpth - DstCoefDpthsData%DpthCd = SrcCoefDpthsData%DpthCd - DstCoefDpthsData%DpthCdMG = SrcCoefDpthsData%DpthCdMG - DstCoefDpthsData%DpthCa = SrcCoefDpthsData%DpthCa - DstCoefDpthsData%DpthCaMG = SrcCoefDpthsData%DpthCaMG - DstCoefDpthsData%DpthCp = SrcCoefDpthsData%DpthCp - DstCoefDpthsData%DpthCpMG = SrcCoefDpthsData%DpthCpMG - DstCoefDpthsData%DpthAxCd = SrcCoefDpthsData%DpthAxCd - DstCoefDpthsData%DpthAxCdMG = SrcCoefDpthsData%DpthAxCdMG - DstCoefDpthsData%DpthAxCa = SrcCoefDpthsData%DpthAxCa - DstCoefDpthsData%DpthAxCaMG = SrcCoefDpthsData%DpthAxCaMG - DstCoefDpthsData%DpthAxCp = SrcCoefDpthsData%DpthAxCp - DstCoefDpthsData%DpthAxCpMG = SrcCoefDpthsData%DpthAxCpMG - DstCoefDpthsData%DpthCb = SrcCoefDpthsData%DpthCb - DstCoefDpthsData%DpthCbMg = SrcCoefDpthsData%DpthCbMg - DstCoefDpthsData%DpthMCF = SrcCoefDpthsData%DpthMCF - END SUBROUTINE Morison_CopyCoefDpths - SUBROUTINE Morison_DestroyCoefDpths( CoefDpthsData, ErrStat, ErrMsg ) - TYPE(Morison_CoefDpths), INTENT(INOUT) :: CoefDpthsData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyCoefDpths' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Morison_DestroyCoefDpths +subroutine Morison_CopyCoefDpths(SrcCoefDpthsData, DstCoefDpthsData, CtrlCode, ErrStat, ErrMsg) + type(Morison_CoefDpths), intent(in) :: SrcCoefDpthsData + type(Morison_CoefDpths), intent(inout) :: DstCoefDpthsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_CopyCoefDpths' + ErrStat = ErrID_None + ErrMsg = '' + DstCoefDpthsData%Dpth = SrcCoefDpthsData%Dpth + DstCoefDpthsData%DpthCd = SrcCoefDpthsData%DpthCd + DstCoefDpthsData%DpthCdMG = SrcCoefDpthsData%DpthCdMG + DstCoefDpthsData%DpthCa = SrcCoefDpthsData%DpthCa + DstCoefDpthsData%DpthCaMG = SrcCoefDpthsData%DpthCaMG + DstCoefDpthsData%DpthCp = SrcCoefDpthsData%DpthCp + DstCoefDpthsData%DpthCpMG = SrcCoefDpthsData%DpthCpMG + DstCoefDpthsData%DpthAxCd = SrcCoefDpthsData%DpthAxCd + DstCoefDpthsData%DpthAxCdMG = SrcCoefDpthsData%DpthAxCdMG + DstCoefDpthsData%DpthAxCa = SrcCoefDpthsData%DpthAxCa + DstCoefDpthsData%DpthAxCaMG = SrcCoefDpthsData%DpthAxCaMG + DstCoefDpthsData%DpthAxCp = SrcCoefDpthsData%DpthAxCp + DstCoefDpthsData%DpthAxCpMG = SrcCoefDpthsData%DpthAxCpMG + DstCoefDpthsData%DpthCb = SrcCoefDpthsData%DpthCb + DstCoefDpthsData%DpthCbMg = SrcCoefDpthsData%DpthCbMg + DstCoefDpthsData%DpthMCF = SrcCoefDpthsData%DpthMCF +end subroutine +subroutine Morison_DestroyCoefDpths(CoefDpthsData, ErrStat, ErrMsg) + type(Morison_CoefDpths), intent(inout) :: CoefDpthsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyCoefDpths' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine Morison_PackCoefDpths(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Morison_CoefDpths), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackCoefDpths' if (Buf%ErrStat >= AbortErrLev) return - ! Dpth call RegPack(Buf, InData%Dpth) if (RegCheckErr(Buf, RoutineName)) return - ! DpthCd call RegPack(Buf, InData%DpthCd) if (RegCheckErr(Buf, RoutineName)) return - ! DpthCdMG call RegPack(Buf, InData%DpthCdMG) if (RegCheckErr(Buf, RoutineName)) return - ! DpthCa call RegPack(Buf, InData%DpthCa) if (RegCheckErr(Buf, RoutineName)) return - ! DpthCaMG call RegPack(Buf, InData%DpthCaMG) if (RegCheckErr(Buf, RoutineName)) return - ! DpthCp call RegPack(Buf, InData%DpthCp) if (RegCheckErr(Buf, RoutineName)) return - ! DpthCpMG call RegPack(Buf, InData%DpthCpMG) if (RegCheckErr(Buf, RoutineName)) return - ! DpthAxCd call RegPack(Buf, InData%DpthAxCd) if (RegCheckErr(Buf, RoutineName)) return - ! DpthAxCdMG call RegPack(Buf, InData%DpthAxCdMG) if (RegCheckErr(Buf, RoutineName)) return - ! DpthAxCa call RegPack(Buf, InData%DpthAxCa) if (RegCheckErr(Buf, RoutineName)) return - ! DpthAxCaMG call RegPack(Buf, InData%DpthAxCaMG) if (RegCheckErr(Buf, RoutineName)) return - ! DpthAxCp call RegPack(Buf, InData%DpthAxCp) if (RegCheckErr(Buf, RoutineName)) return - ! DpthAxCpMG call RegPack(Buf, InData%DpthAxCpMG) if (RegCheckErr(Buf, RoutineName)) return - ! DpthCb call RegPack(Buf, InData%DpthCb) if (RegCheckErr(Buf, RoutineName)) return - ! DpthCbMg call RegPack(Buf, InData%DpthCbMg) if (RegCheckErr(Buf, RoutineName)) return - ! DpthMCF call RegPack(Buf, InData%DpthMCF) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -819,118 +731,84 @@ subroutine Morison_UnPackCoefDpths(Buf, OutData) type(Morison_CoefDpths), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackCoefDpths' if (Buf%ErrStat /= ErrID_None) return - ! Dpth call RegUnpack(Buf, OutData%Dpth) if (RegCheckErr(Buf, RoutineName)) return - ! DpthCd call RegUnpack(Buf, OutData%DpthCd) if (RegCheckErr(Buf, RoutineName)) return - ! DpthCdMG call RegUnpack(Buf, OutData%DpthCdMG) if (RegCheckErr(Buf, RoutineName)) return - ! DpthCa call RegUnpack(Buf, OutData%DpthCa) if (RegCheckErr(Buf, RoutineName)) return - ! DpthCaMG call RegUnpack(Buf, OutData%DpthCaMG) if (RegCheckErr(Buf, RoutineName)) return - ! DpthCp call RegUnpack(Buf, OutData%DpthCp) if (RegCheckErr(Buf, RoutineName)) return - ! DpthCpMG call RegUnpack(Buf, OutData%DpthCpMG) if (RegCheckErr(Buf, RoutineName)) return - ! DpthAxCd call RegUnpack(Buf, OutData%DpthAxCd) if (RegCheckErr(Buf, RoutineName)) return - ! DpthAxCdMG call RegUnpack(Buf, OutData%DpthAxCdMG) if (RegCheckErr(Buf, RoutineName)) return - ! DpthAxCa call RegUnpack(Buf, OutData%DpthAxCa) if (RegCheckErr(Buf, RoutineName)) return - ! DpthAxCaMG call RegUnpack(Buf, OutData%DpthAxCaMG) if (RegCheckErr(Buf, RoutineName)) return - ! DpthAxCp call RegUnpack(Buf, OutData%DpthAxCp) if (RegCheckErr(Buf, RoutineName)) return - ! DpthAxCpMG call RegUnpack(Buf, OutData%DpthAxCpMG) if (RegCheckErr(Buf, RoutineName)) return - ! DpthCb call RegUnpack(Buf, OutData%DpthCb) if (RegCheckErr(Buf, RoutineName)) return - ! DpthCbMg call RegUnpack(Buf, OutData%DpthCbMg) if (RegCheckErr(Buf, RoutineName)) return - ! DpthMCF call RegUnpack(Buf, OutData%DpthMCF) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Morison_CopyAxialCoefType( SrcAxialCoefTypeData, DstAxialCoefTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_AxialCoefType), INTENT(IN) :: SrcAxialCoefTypeData - TYPE(Morison_AxialCoefType), INTENT(INOUT) :: DstAxialCoefTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_CopyAxialCoefType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstAxialCoefTypeData%AxCoefID = SrcAxialCoefTypeData%AxCoefID - DstAxialCoefTypeData%AxCd = SrcAxialCoefTypeData%AxCd - DstAxialCoefTypeData%AxCa = SrcAxialCoefTypeData%AxCa - DstAxialCoefTypeData%AxCp = SrcAxialCoefTypeData%AxCp - DstAxialCoefTypeData%AxVnCOff = SrcAxialCoefTypeData%AxVnCOff - DstAxialCoefTypeData%AxFDLoFSc = SrcAxialCoefTypeData%AxFDLoFSc - DstAxialCoefTypeData%AxFDMod = SrcAxialCoefTypeData%AxFDMod - END SUBROUTINE Morison_CopyAxialCoefType - SUBROUTINE Morison_DestroyAxialCoefType( AxialCoefTypeData, ErrStat, ErrMsg ) - TYPE(Morison_AxialCoefType), INTENT(INOUT) :: AxialCoefTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyAxialCoefType' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Morison_DestroyAxialCoefType +subroutine Morison_CopyAxialCoefType(SrcAxialCoefTypeData, DstAxialCoefTypeData, CtrlCode, ErrStat, ErrMsg) + type(Morison_AxialCoefType), intent(in) :: SrcAxialCoefTypeData + type(Morison_AxialCoefType), intent(inout) :: DstAxialCoefTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_CopyAxialCoefType' + ErrStat = ErrID_None + ErrMsg = '' + DstAxialCoefTypeData%AxCoefID = SrcAxialCoefTypeData%AxCoefID + DstAxialCoefTypeData%AxCd = SrcAxialCoefTypeData%AxCd + DstAxialCoefTypeData%AxCa = SrcAxialCoefTypeData%AxCa + DstAxialCoefTypeData%AxCp = SrcAxialCoefTypeData%AxCp + DstAxialCoefTypeData%AxVnCOff = SrcAxialCoefTypeData%AxVnCOff + DstAxialCoefTypeData%AxFDLoFSc = SrcAxialCoefTypeData%AxFDLoFSc + DstAxialCoefTypeData%AxFDMod = SrcAxialCoefTypeData%AxFDMod +end subroutine +subroutine Morison_DestroyAxialCoefType(AxialCoefTypeData, ErrStat, ErrMsg) + type(Morison_AxialCoefType), intent(inout) :: AxialCoefTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyAxialCoefType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine Morison_PackAxialCoefType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Morison_AxialCoefType), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackAxialCoefType' if (Buf%ErrStat >= AbortErrLev) return - ! AxCoefID call RegPack(Buf, InData%AxCoefID) if (RegCheckErr(Buf, RoutineName)) return - ! AxCd call RegPack(Buf, InData%AxCd) if (RegCheckErr(Buf, RoutineName)) return - ! AxCa call RegPack(Buf, InData%AxCa) if (RegCheckErr(Buf, RoutineName)) return - ! AxCp call RegPack(Buf, InData%AxCp) if (RegCheckErr(Buf, RoutineName)) return - ! AxVnCOff call RegPack(Buf, InData%AxVnCOff) if (RegCheckErr(Buf, RoutineName)) return - ! AxFDLoFSc call RegPack(Buf, InData%AxFDLoFSc) if (RegCheckErr(Buf, RoutineName)) return - ! AxFDMod call RegPack(Buf, InData%AxFDMod) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -940,162 +818,127 @@ subroutine Morison_UnPackAxialCoefType(Buf, OutData) type(Morison_AxialCoefType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackAxialCoefType' if (Buf%ErrStat /= ErrID_None) return - ! AxCoefID call RegUnpack(Buf, OutData%AxCoefID) if (RegCheckErr(Buf, RoutineName)) return - ! AxCd call RegUnpack(Buf, OutData%AxCd) if (RegCheckErr(Buf, RoutineName)) return - ! AxCa call RegUnpack(Buf, OutData%AxCa) if (RegCheckErr(Buf, RoutineName)) return - ! AxCp call RegUnpack(Buf, OutData%AxCp) if (RegCheckErr(Buf, RoutineName)) return - ! AxVnCOff call RegUnpack(Buf, OutData%AxVnCOff) if (RegCheckErr(Buf, RoutineName)) return - ! AxFDLoFSc call RegUnpack(Buf, OutData%AxFDLoFSc) if (RegCheckErr(Buf, RoutineName)) return - ! AxFDMod call RegUnpack(Buf, OutData%AxFDMod) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Morison_CopyMemberInputType( SrcMemberInputTypeData, DstMemberInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_MemberInputType), INTENT(IN) :: SrcMemberInputTypeData - TYPE(Morison_MemberInputType), INTENT(INOUT) :: DstMemberInputTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_CopyMemberInputType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstMemberInputTypeData%MemberID = SrcMemberInputTypeData%MemberID -IF (ALLOCATED(SrcMemberInputTypeData%NodeIndx)) THEN - i1_l = LBOUND(SrcMemberInputTypeData%NodeIndx,1) - i1_u = UBOUND(SrcMemberInputTypeData%NodeIndx,1) - IF (.NOT. ALLOCATED(DstMemberInputTypeData%NodeIndx)) THEN - ALLOCATE(DstMemberInputTypeData%NodeIndx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberInputTypeData%NodeIndx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberInputTypeData%NodeIndx = SrcMemberInputTypeData%NodeIndx -ENDIF - DstMemberInputTypeData%MJointID1 = SrcMemberInputTypeData%MJointID1 - DstMemberInputTypeData%MJointID2 = SrcMemberInputTypeData%MJointID2 - DstMemberInputTypeData%MJointID1Indx = SrcMemberInputTypeData%MJointID1Indx - DstMemberInputTypeData%MJointID2Indx = SrcMemberInputTypeData%MJointID2Indx - DstMemberInputTypeData%MPropSetID1 = SrcMemberInputTypeData%MPropSetID1 - DstMemberInputTypeData%MPropSetID2 = SrcMemberInputTypeData%MPropSetID2 - DstMemberInputTypeData%MPropSetID1Indx = SrcMemberInputTypeData%MPropSetID1Indx - DstMemberInputTypeData%MPropSetID2Indx = SrcMemberInputTypeData%MPropSetID2Indx - DstMemberInputTypeData%MDivSize = SrcMemberInputTypeData%MDivSize - DstMemberInputTypeData%MCoefMod = SrcMemberInputTypeData%MCoefMod - DstMemberInputTypeData%MHstLMod = SrcMemberInputTypeData%MHstLMod - DstMemberInputTypeData%MmbrCoefIDIndx = SrcMemberInputTypeData%MmbrCoefIDIndx - DstMemberInputTypeData%MmbrFilledIDIndx = SrcMemberInputTypeData%MmbrFilledIDIndx - DstMemberInputTypeData%PropPot = SrcMemberInputTypeData%PropPot - DstMemberInputTypeData%PropMCF = SrcMemberInputTypeData%PropMCF - DstMemberInputTypeData%NElements = SrcMemberInputTypeData%NElements - DstMemberInputTypeData%RefLength = SrcMemberInputTypeData%RefLength - DstMemberInputTypeData%dl = SrcMemberInputTypeData%dl - END SUBROUTINE Morison_CopyMemberInputType - - SUBROUTINE Morison_DestroyMemberInputType( MemberInputTypeData, ErrStat, ErrMsg ) - TYPE(Morison_MemberInputType), INTENT(INOUT) :: MemberInputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyMemberInputType' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MemberInputTypeData%NodeIndx)) THEN - DEALLOCATE(MemberInputTypeData%NodeIndx) -ENDIF - END SUBROUTINE Morison_DestroyMemberInputType +subroutine Morison_CopyMemberInputType(SrcMemberInputTypeData, DstMemberInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(Morison_MemberInputType), intent(in) :: SrcMemberInputTypeData + type(Morison_MemberInputType), intent(inout) :: DstMemberInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Morison_CopyMemberInputType' + ErrStat = ErrID_None + ErrMsg = '' + DstMemberInputTypeData%MemberID = SrcMemberInputTypeData%MemberID + if (allocated(SrcMemberInputTypeData%NodeIndx)) then + LB(1:1) = lbound(SrcMemberInputTypeData%NodeIndx) + UB(1:1) = ubound(SrcMemberInputTypeData%NodeIndx) + if (.not. allocated(DstMemberInputTypeData%NodeIndx)) then + allocate(DstMemberInputTypeData%NodeIndx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberInputTypeData%NodeIndx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberInputTypeData%NodeIndx = SrcMemberInputTypeData%NodeIndx + else if (allocated(DstMemberInputTypeData%NodeIndx)) then + deallocate(DstMemberInputTypeData%NodeIndx) + end if + DstMemberInputTypeData%MJointID1 = SrcMemberInputTypeData%MJointID1 + DstMemberInputTypeData%MJointID2 = SrcMemberInputTypeData%MJointID2 + DstMemberInputTypeData%MJointID1Indx = SrcMemberInputTypeData%MJointID1Indx + DstMemberInputTypeData%MJointID2Indx = SrcMemberInputTypeData%MJointID2Indx + DstMemberInputTypeData%MPropSetID1 = SrcMemberInputTypeData%MPropSetID1 + DstMemberInputTypeData%MPropSetID2 = SrcMemberInputTypeData%MPropSetID2 + DstMemberInputTypeData%MPropSetID1Indx = SrcMemberInputTypeData%MPropSetID1Indx + DstMemberInputTypeData%MPropSetID2Indx = SrcMemberInputTypeData%MPropSetID2Indx + DstMemberInputTypeData%MDivSize = SrcMemberInputTypeData%MDivSize + DstMemberInputTypeData%MCoefMod = SrcMemberInputTypeData%MCoefMod + DstMemberInputTypeData%MHstLMod = SrcMemberInputTypeData%MHstLMod + DstMemberInputTypeData%MmbrCoefIDIndx = SrcMemberInputTypeData%MmbrCoefIDIndx + DstMemberInputTypeData%MmbrFilledIDIndx = SrcMemberInputTypeData%MmbrFilledIDIndx + DstMemberInputTypeData%PropPot = SrcMemberInputTypeData%PropPot + DstMemberInputTypeData%PropMCF = SrcMemberInputTypeData%PropMCF + DstMemberInputTypeData%NElements = SrcMemberInputTypeData%NElements + DstMemberInputTypeData%RefLength = SrcMemberInputTypeData%RefLength + DstMemberInputTypeData%dl = SrcMemberInputTypeData%dl +end subroutine +subroutine Morison_DestroyMemberInputType(MemberInputTypeData, ErrStat, ErrMsg) + type(Morison_MemberInputType), intent(inout) :: MemberInputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyMemberInputType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MemberInputTypeData%NodeIndx)) then + deallocate(MemberInputTypeData%NodeIndx) + end if +end subroutine subroutine Morison_PackMemberInputType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Morison_MemberInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackMemberInputType' if (Buf%ErrStat >= AbortErrLev) return - ! MemberID call RegPack(Buf, InData%MemberID) if (RegCheckErr(Buf, RoutineName)) return - ! NodeIndx call RegPack(Buf, allocated(InData%NodeIndx)) if (allocated(InData%NodeIndx)) then call RegPackBounds(Buf, 1, lbound(InData%NodeIndx), ubound(InData%NodeIndx)) call RegPack(Buf, InData%NodeIndx) end if if (RegCheckErr(Buf, RoutineName)) return - ! MJointID1 call RegPack(Buf, InData%MJointID1) if (RegCheckErr(Buf, RoutineName)) return - ! MJointID2 call RegPack(Buf, InData%MJointID2) if (RegCheckErr(Buf, RoutineName)) return - ! MJointID1Indx call RegPack(Buf, InData%MJointID1Indx) if (RegCheckErr(Buf, RoutineName)) return - ! MJointID2Indx call RegPack(Buf, InData%MJointID2Indx) if (RegCheckErr(Buf, RoutineName)) return - ! MPropSetID1 call RegPack(Buf, InData%MPropSetID1) if (RegCheckErr(Buf, RoutineName)) return - ! MPropSetID2 call RegPack(Buf, InData%MPropSetID2) if (RegCheckErr(Buf, RoutineName)) return - ! MPropSetID1Indx call RegPack(Buf, InData%MPropSetID1Indx) if (RegCheckErr(Buf, RoutineName)) return - ! MPropSetID2Indx call RegPack(Buf, InData%MPropSetID2Indx) if (RegCheckErr(Buf, RoutineName)) return - ! MDivSize call RegPack(Buf, InData%MDivSize) if (RegCheckErr(Buf, RoutineName)) return - ! MCoefMod call RegPack(Buf, InData%MCoefMod) if (RegCheckErr(Buf, RoutineName)) return - ! MHstLMod call RegPack(Buf, InData%MHstLMod) if (RegCheckErr(Buf, RoutineName)) return - ! MmbrCoefIDIndx call RegPack(Buf, InData%MmbrCoefIDIndx) if (RegCheckErr(Buf, RoutineName)) return - ! MmbrFilledIDIndx call RegPack(Buf, InData%MmbrFilledIDIndx) if (RegCheckErr(Buf, RoutineName)) return - ! PropPot call RegPack(Buf, InData%PropPot) if (RegCheckErr(Buf, RoutineName)) return - ! PropMCF call RegPack(Buf, InData%PropMCF) if (RegCheckErr(Buf, RoutineName)) return - ! NElements call RegPack(Buf, InData%NElements) if (RegCheckErr(Buf, RoutineName)) return - ! RefLength call RegPack(Buf, InData%RefLength) if (RegCheckErr(Buf, RoutineName)) return - ! dl call RegPack(Buf, InData%dl) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1108,10 +951,8 @@ subroutine Morison_UnPackMemberInputType(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! MemberID call RegUnpack(Buf, OutData%MemberID) if (RegCheckErr(Buf, RoutineName)) return - ! NodeIndx if (allocated(OutData%NodeIndx)) deallocate(OutData%NodeIndx) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1126,157 +967,112 @@ subroutine Morison_UnPackMemberInputType(Buf, OutData) call RegUnpack(Buf, OutData%NodeIndx) if (RegCheckErr(Buf, RoutineName)) return end if - ! MJointID1 call RegUnpack(Buf, OutData%MJointID1) if (RegCheckErr(Buf, RoutineName)) return - ! MJointID2 call RegUnpack(Buf, OutData%MJointID2) if (RegCheckErr(Buf, RoutineName)) return - ! MJointID1Indx call RegUnpack(Buf, OutData%MJointID1Indx) if (RegCheckErr(Buf, RoutineName)) return - ! MJointID2Indx call RegUnpack(Buf, OutData%MJointID2Indx) if (RegCheckErr(Buf, RoutineName)) return - ! MPropSetID1 call RegUnpack(Buf, OutData%MPropSetID1) if (RegCheckErr(Buf, RoutineName)) return - ! MPropSetID2 call RegUnpack(Buf, OutData%MPropSetID2) if (RegCheckErr(Buf, RoutineName)) return - ! MPropSetID1Indx call RegUnpack(Buf, OutData%MPropSetID1Indx) if (RegCheckErr(Buf, RoutineName)) return - ! MPropSetID2Indx call RegUnpack(Buf, OutData%MPropSetID2Indx) if (RegCheckErr(Buf, RoutineName)) return - ! MDivSize call RegUnpack(Buf, OutData%MDivSize) if (RegCheckErr(Buf, RoutineName)) return - ! MCoefMod call RegUnpack(Buf, OutData%MCoefMod) if (RegCheckErr(Buf, RoutineName)) return - ! MHstLMod call RegUnpack(Buf, OutData%MHstLMod) if (RegCheckErr(Buf, RoutineName)) return - ! MmbrCoefIDIndx call RegUnpack(Buf, OutData%MmbrCoefIDIndx) if (RegCheckErr(Buf, RoutineName)) return - ! MmbrFilledIDIndx call RegUnpack(Buf, OutData%MmbrFilledIDIndx) if (RegCheckErr(Buf, RoutineName)) return - ! PropPot call RegUnpack(Buf, OutData%PropPot) if (RegCheckErr(Buf, RoutineName)) return - ! PropMCF call RegUnpack(Buf, OutData%PropMCF) if (RegCheckErr(Buf, RoutineName)) return - ! NElements call RegUnpack(Buf, OutData%NElements) if (RegCheckErr(Buf, RoutineName)) return - ! RefLength call RegUnpack(Buf, OutData%RefLength) if (RegCheckErr(Buf, RoutineName)) return - ! dl call RegUnpack(Buf, OutData%dl) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Morison_CopyNodeType( SrcNodeTypeData, DstNodeTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_NodeType), INTENT(IN) :: SrcNodeTypeData - TYPE(Morison_NodeType), INTENT(INOUT) :: DstNodeTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_CopyNodeType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstNodeTypeData%JointIndx = SrcNodeTypeData%JointIndx - DstNodeTypeData%Position = SrcNodeTypeData%Position - DstNodeTypeData%JointOvrlp = SrcNodeTypeData%JointOvrlp - DstNodeTypeData%JointAxIDIndx = SrcNodeTypeData%JointAxIDIndx - DstNodeTypeData%NConnections = SrcNodeTypeData%NConnections - DstNodeTypeData%ConnectionList = SrcNodeTypeData%ConnectionList - DstNodeTypeData%JAxCd = SrcNodeTypeData%JAxCd - DstNodeTypeData%JAxCa = SrcNodeTypeData%JAxCa - DstNodeTypeData%JAxCp = SrcNodeTypeData%JAxCp - DstNodeTypeData%JAxVnCOff = SrcNodeTypeData%JAxVnCOff - DstNodeTypeData%JAxFDLoFSc = SrcNodeTypeData%JAxFDLoFSc - DstNodeTypeData%JAxFDMod = SrcNodeTypeData%JAxFDMod - DstNodeTypeData%FillDensity = SrcNodeTypeData%FillDensity - DstNodeTypeData%tMG = SrcNodeTypeData%tMG - DstNodeTypeData%MGdensity = SrcNodeTypeData%MGdensity - END SUBROUTINE Morison_CopyNodeType - - SUBROUTINE Morison_DestroyNodeType( NodeTypeData, ErrStat, ErrMsg ) - TYPE(Morison_NodeType), INTENT(INOUT) :: NodeTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyNodeType' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Morison_DestroyNodeType +subroutine Morison_CopyNodeType(SrcNodeTypeData, DstNodeTypeData, CtrlCode, ErrStat, ErrMsg) + type(Morison_NodeType), intent(in) :: SrcNodeTypeData + type(Morison_NodeType), intent(inout) :: DstNodeTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_CopyNodeType' + ErrStat = ErrID_None + ErrMsg = '' + DstNodeTypeData%JointIndx = SrcNodeTypeData%JointIndx + DstNodeTypeData%Position = SrcNodeTypeData%Position + DstNodeTypeData%JointOvrlp = SrcNodeTypeData%JointOvrlp + DstNodeTypeData%JointAxIDIndx = SrcNodeTypeData%JointAxIDIndx + DstNodeTypeData%NConnections = SrcNodeTypeData%NConnections + DstNodeTypeData%ConnectionList = SrcNodeTypeData%ConnectionList + DstNodeTypeData%JAxCd = SrcNodeTypeData%JAxCd + DstNodeTypeData%JAxCa = SrcNodeTypeData%JAxCa + DstNodeTypeData%JAxCp = SrcNodeTypeData%JAxCp + DstNodeTypeData%JAxVnCOff = SrcNodeTypeData%JAxVnCOff + DstNodeTypeData%JAxFDLoFSc = SrcNodeTypeData%JAxFDLoFSc + DstNodeTypeData%JAxFDMod = SrcNodeTypeData%JAxFDMod + DstNodeTypeData%FillDensity = SrcNodeTypeData%FillDensity + DstNodeTypeData%tMG = SrcNodeTypeData%tMG + DstNodeTypeData%MGdensity = SrcNodeTypeData%MGdensity +end subroutine +subroutine Morison_DestroyNodeType(NodeTypeData, ErrStat, ErrMsg) + type(Morison_NodeType), intent(inout) :: NodeTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyNodeType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine Morison_PackNodeType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Morison_NodeType), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackNodeType' if (Buf%ErrStat >= AbortErrLev) return - ! JointIndx call RegPack(Buf, InData%JointIndx) if (RegCheckErr(Buf, RoutineName)) return - ! Position call RegPack(Buf, InData%Position) if (RegCheckErr(Buf, RoutineName)) return - ! JointOvrlp call RegPack(Buf, InData%JointOvrlp) if (RegCheckErr(Buf, RoutineName)) return - ! JointAxIDIndx call RegPack(Buf, InData%JointAxIDIndx) if (RegCheckErr(Buf, RoutineName)) return - ! NConnections call RegPack(Buf, InData%NConnections) if (RegCheckErr(Buf, RoutineName)) return - ! ConnectionList call RegPack(Buf, InData%ConnectionList) if (RegCheckErr(Buf, RoutineName)) return - ! JAxCd call RegPack(Buf, InData%JAxCd) if (RegCheckErr(Buf, RoutineName)) return - ! JAxCa call RegPack(Buf, InData%JAxCa) if (RegCheckErr(Buf, RoutineName)) return - ! JAxCp call RegPack(Buf, InData%JAxCp) if (RegCheckErr(Buf, RoutineName)) return - ! JAxVnCOff call RegPack(Buf, InData%JAxVnCOff) if (RegCheckErr(Buf, RoutineName)) return - ! JAxFDLoFSc call RegPack(Buf, InData%JAxFDLoFSc) if (RegCheckErr(Buf, RoutineName)) return - ! JAxFDMod call RegPack(Buf, InData%JAxFDMod) if (RegCheckErr(Buf, RoutineName)) return - ! FillDensity call RegPack(Buf, InData%FillDensity) if (RegCheckErr(Buf, RoutineName)) return - ! tMG call RegPack(Buf, InData%tMG) if (RegCheckErr(Buf, RoutineName)) return - ! MGdensity call RegPack(Buf, InData%MGdensity) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1286,1089 +1082,1073 @@ subroutine Morison_UnPackNodeType(Buf, OutData) type(Morison_NodeType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackNodeType' if (Buf%ErrStat /= ErrID_None) return - ! JointIndx call RegUnpack(Buf, OutData%JointIndx) if (RegCheckErr(Buf, RoutineName)) return - ! Position call RegUnpack(Buf, OutData%Position) if (RegCheckErr(Buf, RoutineName)) return - ! JointOvrlp call RegUnpack(Buf, OutData%JointOvrlp) if (RegCheckErr(Buf, RoutineName)) return - ! JointAxIDIndx call RegUnpack(Buf, OutData%JointAxIDIndx) if (RegCheckErr(Buf, RoutineName)) return - ! NConnections call RegUnpack(Buf, OutData%NConnections) if (RegCheckErr(Buf, RoutineName)) return - ! ConnectionList call RegUnpack(Buf, OutData%ConnectionList) if (RegCheckErr(Buf, RoutineName)) return - ! JAxCd call RegUnpack(Buf, OutData%JAxCd) if (RegCheckErr(Buf, RoutineName)) return - ! JAxCa call RegUnpack(Buf, OutData%JAxCa) if (RegCheckErr(Buf, RoutineName)) return - ! JAxCp call RegUnpack(Buf, OutData%JAxCp) if (RegCheckErr(Buf, RoutineName)) return - ! JAxVnCOff call RegUnpack(Buf, OutData%JAxVnCOff) if (RegCheckErr(Buf, RoutineName)) return - ! JAxFDLoFSc call RegUnpack(Buf, OutData%JAxFDLoFSc) if (RegCheckErr(Buf, RoutineName)) return - ! JAxFDMod call RegUnpack(Buf, OutData%JAxFDMod) if (RegCheckErr(Buf, RoutineName)) return - ! FillDensity call RegUnpack(Buf, OutData%FillDensity) if (RegCheckErr(Buf, RoutineName)) return - ! tMG call RegUnpack(Buf, OutData%tMG) if (RegCheckErr(Buf, RoutineName)) return - ! MGdensity call RegUnpack(Buf, OutData%MGdensity) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Morison_CopyMemberType( SrcMemberTypeData, DstMemberTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_MemberType), INTENT(IN) :: SrcMemberTypeData - TYPE(Morison_MemberType), INTENT(INOUT) :: DstMemberTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_CopyMemberType' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMemberTypeData%NodeIndx)) THEN - i1_l = LBOUND(SrcMemberTypeData%NodeIndx,1) - i1_u = UBOUND(SrcMemberTypeData%NodeIndx,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%NodeIndx)) THEN - ALLOCATE(DstMemberTypeData%NodeIndx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%NodeIndx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%NodeIndx = SrcMemberTypeData%NodeIndx -ENDIF - DstMemberTypeData%MemberID = SrcMemberTypeData%MemberID - DstMemberTypeData%NElements = SrcMemberTypeData%NElements - DstMemberTypeData%RefLength = SrcMemberTypeData%RefLength - DstMemberTypeData%cosPhi_ref = SrcMemberTypeData%cosPhi_ref - DstMemberTypeData%dl = SrcMemberTypeData%dl - DstMemberTypeData%k = SrcMemberTypeData%k - DstMemberTypeData%kkt = SrcMemberTypeData%kkt - DstMemberTypeData%Ak = SrcMemberTypeData%Ak -IF (ALLOCATED(SrcMemberTypeData%R)) THEN - i1_l = LBOUND(SrcMemberTypeData%R,1) - i1_u = UBOUND(SrcMemberTypeData%R,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%R)) THEN - ALLOCATE(DstMemberTypeData%R(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%R.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%R = SrcMemberTypeData%R -ENDIF -IF (ALLOCATED(SrcMemberTypeData%RMG)) THEN - i1_l = LBOUND(SrcMemberTypeData%RMG,1) - i1_u = UBOUND(SrcMemberTypeData%RMG,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%RMG)) THEN - ALLOCATE(DstMemberTypeData%RMG(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%RMG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%RMG = SrcMemberTypeData%RMG -ENDIF -IF (ALLOCATED(SrcMemberTypeData%RMGB)) THEN - i1_l = LBOUND(SrcMemberTypeData%RMGB,1) - i1_u = UBOUND(SrcMemberTypeData%RMGB,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%RMGB)) THEN - ALLOCATE(DstMemberTypeData%RMGB(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%RMGB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%RMGB = SrcMemberTypeData%RMGB -ENDIF -IF (ALLOCATED(SrcMemberTypeData%Rin)) THEN - i1_l = LBOUND(SrcMemberTypeData%Rin,1) - i1_u = UBOUND(SrcMemberTypeData%Rin,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%Rin)) THEN - ALLOCATE(DstMemberTypeData%Rin(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%Rin.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%Rin = SrcMemberTypeData%Rin -ENDIF -IF (ALLOCATED(SrcMemberTypeData%tMG)) THEN - i1_l = LBOUND(SrcMemberTypeData%tMG,1) - i1_u = UBOUND(SrcMemberTypeData%tMG,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%tMG)) THEN - ALLOCATE(DstMemberTypeData%tMG(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%tMG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%tMG = SrcMemberTypeData%tMG -ENDIF -IF (ALLOCATED(SrcMemberTypeData%MGdensity)) THEN - i1_l = LBOUND(SrcMemberTypeData%MGdensity,1) - i1_u = UBOUND(SrcMemberTypeData%MGdensity,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%MGdensity)) THEN - ALLOCATE(DstMemberTypeData%MGdensity(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%MGdensity.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%MGdensity = SrcMemberTypeData%MGdensity -ENDIF -IF (ALLOCATED(SrcMemberTypeData%dRdl_mg)) THEN - i1_l = LBOUND(SrcMemberTypeData%dRdl_mg,1) - i1_u = UBOUND(SrcMemberTypeData%dRdl_mg,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%dRdl_mg)) THEN - ALLOCATE(DstMemberTypeData%dRdl_mg(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%dRdl_mg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%dRdl_mg = SrcMemberTypeData%dRdl_mg -ENDIF -IF (ALLOCATED(SrcMemberTypeData%dRdl_mg_b)) THEN - i1_l = LBOUND(SrcMemberTypeData%dRdl_mg_b,1) - i1_u = UBOUND(SrcMemberTypeData%dRdl_mg_b,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%dRdl_mg_b)) THEN - ALLOCATE(DstMemberTypeData%dRdl_mg_b(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%dRdl_mg_b.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%dRdl_mg_b = SrcMemberTypeData%dRdl_mg_b -ENDIF -IF (ALLOCATED(SrcMemberTypeData%dRdl_in)) THEN - i1_l = LBOUND(SrcMemberTypeData%dRdl_in,1) - i1_u = UBOUND(SrcMemberTypeData%dRdl_in,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%dRdl_in)) THEN - ALLOCATE(DstMemberTypeData%dRdl_in(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%dRdl_in.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%dRdl_in = SrcMemberTypeData%dRdl_in -ENDIF - DstMemberTypeData%Vinner = SrcMemberTypeData%Vinner - DstMemberTypeData%Vouter = SrcMemberTypeData%Vouter - DstMemberTypeData%Vballast = SrcMemberTypeData%Vballast - DstMemberTypeData%Vsubmerged = SrcMemberTypeData%Vsubmerged - DstMemberTypeData%l_fill = SrcMemberTypeData%l_fill - DstMemberTypeData%h_fill = SrcMemberTypeData%h_fill - DstMemberTypeData%z_overfill = SrcMemberTypeData%z_overfill - DstMemberTypeData%h_floor = SrcMemberTypeData%h_floor - DstMemberTypeData%i_floor = SrcMemberTypeData%i_floor - DstMemberTypeData%doEndBuoyancy = SrcMemberTypeData%doEndBuoyancy - DstMemberTypeData%memfloodstatus = SrcMemberTypeData%memfloodstatus -IF (ALLOCATED(SrcMemberTypeData%floodstatus)) THEN - i1_l = LBOUND(SrcMemberTypeData%floodstatus,1) - i1_u = UBOUND(SrcMemberTypeData%floodstatus,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%floodstatus)) THEN - ALLOCATE(DstMemberTypeData%floodstatus(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%floodstatus.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%floodstatus = SrcMemberTypeData%floodstatus -ENDIF -IF (ALLOCATED(SrcMemberTypeData%alpha)) THEN - i1_l = LBOUND(SrcMemberTypeData%alpha,1) - i1_u = UBOUND(SrcMemberTypeData%alpha,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%alpha)) THEN - ALLOCATE(DstMemberTypeData%alpha(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%alpha.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%alpha = SrcMemberTypeData%alpha -ENDIF -IF (ALLOCATED(SrcMemberTypeData%alpha_fb)) THEN - i1_l = LBOUND(SrcMemberTypeData%alpha_fb,1) - i1_u = UBOUND(SrcMemberTypeData%alpha_fb,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%alpha_fb)) THEN - ALLOCATE(DstMemberTypeData%alpha_fb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%alpha_fb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%alpha_fb = SrcMemberTypeData%alpha_fb -ENDIF -IF (ALLOCATED(SrcMemberTypeData%alpha_fb_star)) THEN - i1_l = LBOUND(SrcMemberTypeData%alpha_fb_star,1) - i1_u = UBOUND(SrcMemberTypeData%alpha_fb_star,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%alpha_fb_star)) THEN - ALLOCATE(DstMemberTypeData%alpha_fb_star(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%alpha_fb_star.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%alpha_fb_star = SrcMemberTypeData%alpha_fb_star -ENDIF -IF (ALLOCATED(SrcMemberTypeData%Cd)) THEN - i1_l = LBOUND(SrcMemberTypeData%Cd,1) - i1_u = UBOUND(SrcMemberTypeData%Cd,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%Cd)) THEN - ALLOCATE(DstMemberTypeData%Cd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%Cd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%Cd = SrcMemberTypeData%Cd -ENDIF -IF (ALLOCATED(SrcMemberTypeData%Ca)) THEN - i1_l = LBOUND(SrcMemberTypeData%Ca,1) - i1_u = UBOUND(SrcMemberTypeData%Ca,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%Ca)) THEN - ALLOCATE(DstMemberTypeData%Ca(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%Ca.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%Ca = SrcMemberTypeData%Ca -ENDIF -IF (ALLOCATED(SrcMemberTypeData%Cp)) THEN - i1_l = LBOUND(SrcMemberTypeData%Cp,1) - i1_u = UBOUND(SrcMemberTypeData%Cp,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%Cp)) THEN - ALLOCATE(DstMemberTypeData%Cp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%Cp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%Cp = SrcMemberTypeData%Cp -ENDIF -IF (ALLOCATED(SrcMemberTypeData%AxCd)) THEN - i1_l = LBOUND(SrcMemberTypeData%AxCd,1) - i1_u = UBOUND(SrcMemberTypeData%AxCd,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%AxCd)) THEN - ALLOCATE(DstMemberTypeData%AxCd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%AxCd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%AxCd = SrcMemberTypeData%AxCd -ENDIF -IF (ALLOCATED(SrcMemberTypeData%AxCa)) THEN - i1_l = LBOUND(SrcMemberTypeData%AxCa,1) - i1_u = UBOUND(SrcMemberTypeData%AxCa,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%AxCa)) THEN - ALLOCATE(DstMemberTypeData%AxCa(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%AxCa.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%AxCa = SrcMemberTypeData%AxCa -ENDIF -IF (ALLOCATED(SrcMemberTypeData%AxCp)) THEN - i1_l = LBOUND(SrcMemberTypeData%AxCp,1) - i1_u = UBOUND(SrcMemberTypeData%AxCp,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%AxCp)) THEN - ALLOCATE(DstMemberTypeData%AxCp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%AxCp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%AxCp = SrcMemberTypeData%AxCp -ENDIF -IF (ALLOCATED(SrcMemberTypeData%Cb)) THEN - i1_l = LBOUND(SrcMemberTypeData%Cb,1) - i1_u = UBOUND(SrcMemberTypeData%Cb,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%Cb)) THEN - ALLOCATE(DstMemberTypeData%Cb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%Cb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%Cb = SrcMemberTypeData%Cb -ENDIF -IF (ALLOCATED(SrcMemberTypeData%m_fb_l)) THEN - i1_l = LBOUND(SrcMemberTypeData%m_fb_l,1) - i1_u = UBOUND(SrcMemberTypeData%m_fb_l,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%m_fb_l)) THEN - ALLOCATE(DstMemberTypeData%m_fb_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%m_fb_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%m_fb_l = SrcMemberTypeData%m_fb_l -ENDIF -IF (ALLOCATED(SrcMemberTypeData%m_fb_u)) THEN - i1_l = LBOUND(SrcMemberTypeData%m_fb_u,1) - i1_u = UBOUND(SrcMemberTypeData%m_fb_u,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%m_fb_u)) THEN - ALLOCATE(DstMemberTypeData%m_fb_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%m_fb_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%m_fb_u = SrcMemberTypeData%m_fb_u -ENDIF -IF (ALLOCATED(SrcMemberTypeData%h_cfb_l)) THEN - i1_l = LBOUND(SrcMemberTypeData%h_cfb_l,1) - i1_u = UBOUND(SrcMemberTypeData%h_cfb_l,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%h_cfb_l)) THEN - ALLOCATE(DstMemberTypeData%h_cfb_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%h_cfb_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%h_cfb_l = SrcMemberTypeData%h_cfb_l -ENDIF -IF (ALLOCATED(SrcMemberTypeData%h_cfb_u)) THEN - i1_l = LBOUND(SrcMemberTypeData%h_cfb_u,1) - i1_u = UBOUND(SrcMemberTypeData%h_cfb_u,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%h_cfb_u)) THEN - ALLOCATE(DstMemberTypeData%h_cfb_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%h_cfb_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%h_cfb_u = SrcMemberTypeData%h_cfb_u -ENDIF -IF (ALLOCATED(SrcMemberTypeData%I_lfb_l)) THEN - i1_l = LBOUND(SrcMemberTypeData%I_lfb_l,1) - i1_u = UBOUND(SrcMemberTypeData%I_lfb_l,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%I_lfb_l)) THEN - ALLOCATE(DstMemberTypeData%I_lfb_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_lfb_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%I_lfb_l = SrcMemberTypeData%I_lfb_l -ENDIF -IF (ALLOCATED(SrcMemberTypeData%I_lfb_u)) THEN - i1_l = LBOUND(SrcMemberTypeData%I_lfb_u,1) - i1_u = UBOUND(SrcMemberTypeData%I_lfb_u,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%I_lfb_u)) THEN - ALLOCATE(DstMemberTypeData%I_lfb_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_lfb_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%I_lfb_u = SrcMemberTypeData%I_lfb_u -ENDIF -IF (ALLOCATED(SrcMemberTypeData%I_rfb_l)) THEN - i1_l = LBOUND(SrcMemberTypeData%I_rfb_l,1) - i1_u = UBOUND(SrcMemberTypeData%I_rfb_l,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%I_rfb_l)) THEN - ALLOCATE(DstMemberTypeData%I_rfb_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_rfb_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%I_rfb_l = SrcMemberTypeData%I_rfb_l -ENDIF -IF (ALLOCATED(SrcMemberTypeData%I_rfb_u)) THEN - i1_l = LBOUND(SrcMemberTypeData%I_rfb_u,1) - i1_u = UBOUND(SrcMemberTypeData%I_rfb_u,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%I_rfb_u)) THEN - ALLOCATE(DstMemberTypeData%I_rfb_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_rfb_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%I_rfb_u = SrcMemberTypeData%I_rfb_u -ENDIF -IF (ALLOCATED(SrcMemberTypeData%m_mg_l)) THEN - i1_l = LBOUND(SrcMemberTypeData%m_mg_l,1) - i1_u = UBOUND(SrcMemberTypeData%m_mg_l,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%m_mg_l)) THEN - ALLOCATE(DstMemberTypeData%m_mg_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%m_mg_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%m_mg_l = SrcMemberTypeData%m_mg_l -ENDIF -IF (ALLOCATED(SrcMemberTypeData%m_mg_u)) THEN - i1_l = LBOUND(SrcMemberTypeData%m_mg_u,1) - i1_u = UBOUND(SrcMemberTypeData%m_mg_u,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%m_mg_u)) THEN - ALLOCATE(DstMemberTypeData%m_mg_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%m_mg_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%m_mg_u = SrcMemberTypeData%m_mg_u -ENDIF -IF (ALLOCATED(SrcMemberTypeData%h_cmg_l)) THEN - i1_l = LBOUND(SrcMemberTypeData%h_cmg_l,1) - i1_u = UBOUND(SrcMemberTypeData%h_cmg_l,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%h_cmg_l)) THEN - ALLOCATE(DstMemberTypeData%h_cmg_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%h_cmg_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%h_cmg_l = SrcMemberTypeData%h_cmg_l -ENDIF -IF (ALLOCATED(SrcMemberTypeData%h_cmg_u)) THEN - i1_l = LBOUND(SrcMemberTypeData%h_cmg_u,1) - i1_u = UBOUND(SrcMemberTypeData%h_cmg_u,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%h_cmg_u)) THEN - ALLOCATE(DstMemberTypeData%h_cmg_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%h_cmg_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%h_cmg_u = SrcMemberTypeData%h_cmg_u -ENDIF -IF (ALLOCATED(SrcMemberTypeData%I_lmg_l)) THEN - i1_l = LBOUND(SrcMemberTypeData%I_lmg_l,1) - i1_u = UBOUND(SrcMemberTypeData%I_lmg_l,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%I_lmg_l)) THEN - ALLOCATE(DstMemberTypeData%I_lmg_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_lmg_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%I_lmg_l = SrcMemberTypeData%I_lmg_l -ENDIF -IF (ALLOCATED(SrcMemberTypeData%I_lmg_u)) THEN - i1_l = LBOUND(SrcMemberTypeData%I_lmg_u,1) - i1_u = UBOUND(SrcMemberTypeData%I_lmg_u,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%I_lmg_u)) THEN - ALLOCATE(DstMemberTypeData%I_lmg_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_lmg_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%I_lmg_u = SrcMemberTypeData%I_lmg_u -ENDIF -IF (ALLOCATED(SrcMemberTypeData%I_rmg_l)) THEN - i1_l = LBOUND(SrcMemberTypeData%I_rmg_l,1) - i1_u = UBOUND(SrcMemberTypeData%I_rmg_l,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%I_rmg_l)) THEN - ALLOCATE(DstMemberTypeData%I_rmg_l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_rmg_l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%I_rmg_l = SrcMemberTypeData%I_rmg_l -ENDIF -IF (ALLOCATED(SrcMemberTypeData%I_rmg_u)) THEN - i1_l = LBOUND(SrcMemberTypeData%I_rmg_u,1) - i1_u = UBOUND(SrcMemberTypeData%I_rmg_u,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%I_rmg_u)) THEN - ALLOCATE(DstMemberTypeData%I_rmg_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_rmg_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%I_rmg_u = SrcMemberTypeData%I_rmg_u -ENDIF -IF (ALLOCATED(SrcMemberTypeData%Cfl_fb)) THEN - i1_l = LBOUND(SrcMemberTypeData%Cfl_fb,1) - i1_u = UBOUND(SrcMemberTypeData%Cfl_fb,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%Cfl_fb)) THEN - ALLOCATE(DstMemberTypeData%Cfl_fb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%Cfl_fb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%Cfl_fb = SrcMemberTypeData%Cfl_fb -ENDIF -IF (ALLOCATED(SrcMemberTypeData%Cfr_fb)) THEN - i1_l = LBOUND(SrcMemberTypeData%Cfr_fb,1) - i1_u = UBOUND(SrcMemberTypeData%Cfr_fb,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%Cfr_fb)) THEN - ALLOCATE(DstMemberTypeData%Cfr_fb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%Cfr_fb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%Cfr_fb = SrcMemberTypeData%Cfr_fb -ENDIF -IF (ALLOCATED(SrcMemberTypeData%CM0_fb)) THEN - i1_l = LBOUND(SrcMemberTypeData%CM0_fb,1) - i1_u = UBOUND(SrcMemberTypeData%CM0_fb,1) - IF (.NOT. ALLOCATED(DstMemberTypeData%CM0_fb)) THEN - ALLOCATE(DstMemberTypeData%CM0_fb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%CM0_fb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberTypeData%CM0_fb = SrcMemberTypeData%CM0_fb -ENDIF - DstMemberTypeData%MGvolume = SrcMemberTypeData%MGvolume - DstMemberTypeData%MDivSize = SrcMemberTypeData%MDivSize - DstMemberTypeData%MCoefMod = SrcMemberTypeData%MCoefMod - DstMemberTypeData%MmbrCoefIDIndx = SrcMemberTypeData%MmbrCoefIDIndx - DstMemberTypeData%MmbrFilledIDIndx = SrcMemberTypeData%MmbrFilledIDIndx - DstMemberTypeData%MHstLMod = SrcMemberTypeData%MHstLMod - DstMemberTypeData%FillFSLoc = SrcMemberTypeData%FillFSLoc - DstMemberTypeData%FillDens = SrcMemberTypeData%FillDens - DstMemberTypeData%PropPot = SrcMemberTypeData%PropPot - DstMemberTypeData%PropMCF = SrcMemberTypeData%PropMCF - DstMemberTypeData%Flipped = SrcMemberTypeData%Flipped - END SUBROUTINE Morison_CopyMemberType - - SUBROUTINE Morison_DestroyMemberType( MemberTypeData, ErrStat, ErrMsg ) - TYPE(Morison_MemberType), INTENT(INOUT) :: MemberTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyMemberType' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MemberTypeData%NodeIndx)) THEN - DEALLOCATE(MemberTypeData%NodeIndx) -ENDIF -IF (ALLOCATED(MemberTypeData%R)) THEN - DEALLOCATE(MemberTypeData%R) -ENDIF -IF (ALLOCATED(MemberTypeData%RMG)) THEN - DEALLOCATE(MemberTypeData%RMG) -ENDIF -IF (ALLOCATED(MemberTypeData%RMGB)) THEN - DEALLOCATE(MemberTypeData%RMGB) -ENDIF -IF (ALLOCATED(MemberTypeData%Rin)) THEN - DEALLOCATE(MemberTypeData%Rin) -ENDIF -IF (ALLOCATED(MemberTypeData%tMG)) THEN - DEALLOCATE(MemberTypeData%tMG) -ENDIF -IF (ALLOCATED(MemberTypeData%MGdensity)) THEN - DEALLOCATE(MemberTypeData%MGdensity) -ENDIF -IF (ALLOCATED(MemberTypeData%dRdl_mg)) THEN - DEALLOCATE(MemberTypeData%dRdl_mg) -ENDIF -IF (ALLOCATED(MemberTypeData%dRdl_mg_b)) THEN - DEALLOCATE(MemberTypeData%dRdl_mg_b) -ENDIF -IF (ALLOCATED(MemberTypeData%dRdl_in)) THEN - DEALLOCATE(MemberTypeData%dRdl_in) -ENDIF -IF (ALLOCATED(MemberTypeData%floodstatus)) THEN - DEALLOCATE(MemberTypeData%floodstatus) -ENDIF -IF (ALLOCATED(MemberTypeData%alpha)) THEN - DEALLOCATE(MemberTypeData%alpha) -ENDIF -IF (ALLOCATED(MemberTypeData%alpha_fb)) THEN - DEALLOCATE(MemberTypeData%alpha_fb) -ENDIF -IF (ALLOCATED(MemberTypeData%alpha_fb_star)) THEN - DEALLOCATE(MemberTypeData%alpha_fb_star) -ENDIF -IF (ALLOCATED(MemberTypeData%Cd)) THEN - DEALLOCATE(MemberTypeData%Cd) -ENDIF -IF (ALLOCATED(MemberTypeData%Ca)) THEN - DEALLOCATE(MemberTypeData%Ca) -ENDIF -IF (ALLOCATED(MemberTypeData%Cp)) THEN - DEALLOCATE(MemberTypeData%Cp) -ENDIF -IF (ALLOCATED(MemberTypeData%AxCd)) THEN - DEALLOCATE(MemberTypeData%AxCd) -ENDIF -IF (ALLOCATED(MemberTypeData%AxCa)) THEN - DEALLOCATE(MemberTypeData%AxCa) -ENDIF -IF (ALLOCATED(MemberTypeData%AxCp)) THEN - DEALLOCATE(MemberTypeData%AxCp) -ENDIF -IF (ALLOCATED(MemberTypeData%Cb)) THEN - DEALLOCATE(MemberTypeData%Cb) -ENDIF -IF (ALLOCATED(MemberTypeData%m_fb_l)) THEN - DEALLOCATE(MemberTypeData%m_fb_l) -ENDIF -IF (ALLOCATED(MemberTypeData%m_fb_u)) THEN - DEALLOCATE(MemberTypeData%m_fb_u) -ENDIF -IF (ALLOCATED(MemberTypeData%h_cfb_l)) THEN - DEALLOCATE(MemberTypeData%h_cfb_l) -ENDIF -IF (ALLOCATED(MemberTypeData%h_cfb_u)) THEN - DEALLOCATE(MemberTypeData%h_cfb_u) -ENDIF -IF (ALLOCATED(MemberTypeData%I_lfb_l)) THEN - DEALLOCATE(MemberTypeData%I_lfb_l) -ENDIF -IF (ALLOCATED(MemberTypeData%I_lfb_u)) THEN - DEALLOCATE(MemberTypeData%I_lfb_u) -ENDIF -IF (ALLOCATED(MemberTypeData%I_rfb_l)) THEN - DEALLOCATE(MemberTypeData%I_rfb_l) -ENDIF -IF (ALLOCATED(MemberTypeData%I_rfb_u)) THEN - DEALLOCATE(MemberTypeData%I_rfb_u) -ENDIF -IF (ALLOCATED(MemberTypeData%m_mg_l)) THEN - DEALLOCATE(MemberTypeData%m_mg_l) -ENDIF -IF (ALLOCATED(MemberTypeData%m_mg_u)) THEN - DEALLOCATE(MemberTypeData%m_mg_u) -ENDIF -IF (ALLOCATED(MemberTypeData%h_cmg_l)) THEN - DEALLOCATE(MemberTypeData%h_cmg_l) -ENDIF -IF (ALLOCATED(MemberTypeData%h_cmg_u)) THEN - DEALLOCATE(MemberTypeData%h_cmg_u) -ENDIF -IF (ALLOCATED(MemberTypeData%I_lmg_l)) THEN - DEALLOCATE(MemberTypeData%I_lmg_l) -ENDIF -IF (ALLOCATED(MemberTypeData%I_lmg_u)) THEN - DEALLOCATE(MemberTypeData%I_lmg_u) -ENDIF -IF (ALLOCATED(MemberTypeData%I_rmg_l)) THEN - DEALLOCATE(MemberTypeData%I_rmg_l) -ENDIF -IF (ALLOCATED(MemberTypeData%I_rmg_u)) THEN - DEALLOCATE(MemberTypeData%I_rmg_u) -ENDIF -IF (ALLOCATED(MemberTypeData%Cfl_fb)) THEN - DEALLOCATE(MemberTypeData%Cfl_fb) -ENDIF -IF (ALLOCATED(MemberTypeData%Cfr_fb)) THEN - DEALLOCATE(MemberTypeData%Cfr_fb) -ENDIF -IF (ALLOCATED(MemberTypeData%CM0_fb)) THEN - DEALLOCATE(MemberTypeData%CM0_fb) -ENDIF - END SUBROUTINE Morison_DestroyMemberType +subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode, ErrStat, ErrMsg) + type(Morison_MemberType), intent(in) :: SrcMemberTypeData + type(Morison_MemberType), intent(inout) :: DstMemberTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Morison_CopyMemberType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMemberTypeData%NodeIndx)) then + LB(1:1) = lbound(SrcMemberTypeData%NodeIndx) + UB(1:1) = ubound(SrcMemberTypeData%NodeIndx) + if (.not. allocated(DstMemberTypeData%NodeIndx)) then + allocate(DstMemberTypeData%NodeIndx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%NodeIndx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%NodeIndx = SrcMemberTypeData%NodeIndx + else if (allocated(DstMemberTypeData%NodeIndx)) then + deallocate(DstMemberTypeData%NodeIndx) + end if + DstMemberTypeData%MemberID = SrcMemberTypeData%MemberID + DstMemberTypeData%NElements = SrcMemberTypeData%NElements + DstMemberTypeData%RefLength = SrcMemberTypeData%RefLength + DstMemberTypeData%cosPhi_ref = SrcMemberTypeData%cosPhi_ref + DstMemberTypeData%dl = SrcMemberTypeData%dl + DstMemberTypeData%k = SrcMemberTypeData%k + DstMemberTypeData%kkt = SrcMemberTypeData%kkt + DstMemberTypeData%Ak = SrcMemberTypeData%Ak + if (allocated(SrcMemberTypeData%R)) then + LB(1:1) = lbound(SrcMemberTypeData%R) + UB(1:1) = ubound(SrcMemberTypeData%R) + if (.not. allocated(DstMemberTypeData%R)) then + allocate(DstMemberTypeData%R(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%R.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%R = SrcMemberTypeData%R + else if (allocated(DstMemberTypeData%R)) then + deallocate(DstMemberTypeData%R) + end if + if (allocated(SrcMemberTypeData%RMG)) then + LB(1:1) = lbound(SrcMemberTypeData%RMG) + UB(1:1) = ubound(SrcMemberTypeData%RMG) + if (.not. allocated(DstMemberTypeData%RMG)) then + allocate(DstMemberTypeData%RMG(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%RMG.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%RMG = SrcMemberTypeData%RMG + else if (allocated(DstMemberTypeData%RMG)) then + deallocate(DstMemberTypeData%RMG) + end if + if (allocated(SrcMemberTypeData%RMGB)) then + LB(1:1) = lbound(SrcMemberTypeData%RMGB) + UB(1:1) = ubound(SrcMemberTypeData%RMGB) + if (.not. allocated(DstMemberTypeData%RMGB)) then + allocate(DstMemberTypeData%RMGB(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%RMGB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%RMGB = SrcMemberTypeData%RMGB + else if (allocated(DstMemberTypeData%RMGB)) then + deallocate(DstMemberTypeData%RMGB) + end if + if (allocated(SrcMemberTypeData%Rin)) then + LB(1:1) = lbound(SrcMemberTypeData%Rin) + UB(1:1) = ubound(SrcMemberTypeData%Rin) + if (.not. allocated(DstMemberTypeData%Rin)) then + allocate(DstMemberTypeData%Rin(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%Rin.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%Rin = SrcMemberTypeData%Rin + else if (allocated(DstMemberTypeData%Rin)) then + deallocate(DstMemberTypeData%Rin) + end if + if (allocated(SrcMemberTypeData%tMG)) then + LB(1:1) = lbound(SrcMemberTypeData%tMG) + UB(1:1) = ubound(SrcMemberTypeData%tMG) + if (.not. allocated(DstMemberTypeData%tMG)) then + allocate(DstMemberTypeData%tMG(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%tMG.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%tMG = SrcMemberTypeData%tMG + else if (allocated(DstMemberTypeData%tMG)) then + deallocate(DstMemberTypeData%tMG) + end if + if (allocated(SrcMemberTypeData%MGdensity)) then + LB(1:1) = lbound(SrcMemberTypeData%MGdensity) + UB(1:1) = ubound(SrcMemberTypeData%MGdensity) + if (.not. allocated(DstMemberTypeData%MGdensity)) then + allocate(DstMemberTypeData%MGdensity(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%MGdensity.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%MGdensity = SrcMemberTypeData%MGdensity + else if (allocated(DstMemberTypeData%MGdensity)) then + deallocate(DstMemberTypeData%MGdensity) + end if + if (allocated(SrcMemberTypeData%dRdl_mg)) then + LB(1:1) = lbound(SrcMemberTypeData%dRdl_mg) + UB(1:1) = ubound(SrcMemberTypeData%dRdl_mg) + if (.not. allocated(DstMemberTypeData%dRdl_mg)) then + allocate(DstMemberTypeData%dRdl_mg(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%dRdl_mg.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%dRdl_mg = SrcMemberTypeData%dRdl_mg + else if (allocated(DstMemberTypeData%dRdl_mg)) then + deallocate(DstMemberTypeData%dRdl_mg) + end if + if (allocated(SrcMemberTypeData%dRdl_mg_b)) then + LB(1:1) = lbound(SrcMemberTypeData%dRdl_mg_b) + UB(1:1) = ubound(SrcMemberTypeData%dRdl_mg_b) + if (.not. allocated(DstMemberTypeData%dRdl_mg_b)) then + allocate(DstMemberTypeData%dRdl_mg_b(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%dRdl_mg_b.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%dRdl_mg_b = SrcMemberTypeData%dRdl_mg_b + else if (allocated(DstMemberTypeData%dRdl_mg_b)) then + deallocate(DstMemberTypeData%dRdl_mg_b) + end if + if (allocated(SrcMemberTypeData%dRdl_in)) then + LB(1:1) = lbound(SrcMemberTypeData%dRdl_in) + UB(1:1) = ubound(SrcMemberTypeData%dRdl_in) + if (.not. allocated(DstMemberTypeData%dRdl_in)) then + allocate(DstMemberTypeData%dRdl_in(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%dRdl_in.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%dRdl_in = SrcMemberTypeData%dRdl_in + else if (allocated(DstMemberTypeData%dRdl_in)) then + deallocate(DstMemberTypeData%dRdl_in) + end if + DstMemberTypeData%Vinner = SrcMemberTypeData%Vinner + DstMemberTypeData%Vouter = SrcMemberTypeData%Vouter + DstMemberTypeData%Vballast = SrcMemberTypeData%Vballast + DstMemberTypeData%Vsubmerged = SrcMemberTypeData%Vsubmerged + DstMemberTypeData%l_fill = SrcMemberTypeData%l_fill + DstMemberTypeData%h_fill = SrcMemberTypeData%h_fill + DstMemberTypeData%z_overfill = SrcMemberTypeData%z_overfill + DstMemberTypeData%h_floor = SrcMemberTypeData%h_floor + DstMemberTypeData%i_floor = SrcMemberTypeData%i_floor + DstMemberTypeData%doEndBuoyancy = SrcMemberTypeData%doEndBuoyancy + DstMemberTypeData%memfloodstatus = SrcMemberTypeData%memfloodstatus + if (allocated(SrcMemberTypeData%floodstatus)) then + LB(1:1) = lbound(SrcMemberTypeData%floodstatus) + UB(1:1) = ubound(SrcMemberTypeData%floodstatus) + if (.not. allocated(DstMemberTypeData%floodstatus)) then + allocate(DstMemberTypeData%floodstatus(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%floodstatus.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%floodstatus = SrcMemberTypeData%floodstatus + else if (allocated(DstMemberTypeData%floodstatus)) then + deallocate(DstMemberTypeData%floodstatus) + end if + if (allocated(SrcMemberTypeData%alpha)) then + LB(1:1) = lbound(SrcMemberTypeData%alpha) + UB(1:1) = ubound(SrcMemberTypeData%alpha) + if (.not. allocated(DstMemberTypeData%alpha)) then + allocate(DstMemberTypeData%alpha(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%alpha.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%alpha = SrcMemberTypeData%alpha + else if (allocated(DstMemberTypeData%alpha)) then + deallocate(DstMemberTypeData%alpha) + end if + if (allocated(SrcMemberTypeData%alpha_fb)) then + LB(1:1) = lbound(SrcMemberTypeData%alpha_fb) + UB(1:1) = ubound(SrcMemberTypeData%alpha_fb) + if (.not. allocated(DstMemberTypeData%alpha_fb)) then + allocate(DstMemberTypeData%alpha_fb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%alpha_fb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%alpha_fb = SrcMemberTypeData%alpha_fb + else if (allocated(DstMemberTypeData%alpha_fb)) then + deallocate(DstMemberTypeData%alpha_fb) + end if + if (allocated(SrcMemberTypeData%alpha_fb_star)) then + LB(1:1) = lbound(SrcMemberTypeData%alpha_fb_star) + UB(1:1) = ubound(SrcMemberTypeData%alpha_fb_star) + if (.not. allocated(DstMemberTypeData%alpha_fb_star)) then + allocate(DstMemberTypeData%alpha_fb_star(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%alpha_fb_star.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%alpha_fb_star = SrcMemberTypeData%alpha_fb_star + else if (allocated(DstMemberTypeData%alpha_fb_star)) then + deallocate(DstMemberTypeData%alpha_fb_star) + end if + if (allocated(SrcMemberTypeData%Cd)) then + LB(1:1) = lbound(SrcMemberTypeData%Cd) + UB(1:1) = ubound(SrcMemberTypeData%Cd) + if (.not. allocated(DstMemberTypeData%Cd)) then + allocate(DstMemberTypeData%Cd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%Cd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%Cd = SrcMemberTypeData%Cd + else if (allocated(DstMemberTypeData%Cd)) then + deallocate(DstMemberTypeData%Cd) + end if + if (allocated(SrcMemberTypeData%Ca)) then + LB(1:1) = lbound(SrcMemberTypeData%Ca) + UB(1:1) = ubound(SrcMemberTypeData%Ca) + if (.not. allocated(DstMemberTypeData%Ca)) then + allocate(DstMemberTypeData%Ca(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%Ca.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%Ca = SrcMemberTypeData%Ca + else if (allocated(DstMemberTypeData%Ca)) then + deallocate(DstMemberTypeData%Ca) + end if + if (allocated(SrcMemberTypeData%Cp)) then + LB(1:1) = lbound(SrcMemberTypeData%Cp) + UB(1:1) = ubound(SrcMemberTypeData%Cp) + if (.not. allocated(DstMemberTypeData%Cp)) then + allocate(DstMemberTypeData%Cp(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%Cp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%Cp = SrcMemberTypeData%Cp + else if (allocated(DstMemberTypeData%Cp)) then + deallocate(DstMemberTypeData%Cp) + end if + if (allocated(SrcMemberTypeData%AxCd)) then + LB(1:1) = lbound(SrcMemberTypeData%AxCd) + UB(1:1) = ubound(SrcMemberTypeData%AxCd) + if (.not. allocated(DstMemberTypeData%AxCd)) then + allocate(DstMemberTypeData%AxCd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%AxCd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%AxCd = SrcMemberTypeData%AxCd + else if (allocated(DstMemberTypeData%AxCd)) then + deallocate(DstMemberTypeData%AxCd) + end if + if (allocated(SrcMemberTypeData%AxCa)) then + LB(1:1) = lbound(SrcMemberTypeData%AxCa) + UB(1:1) = ubound(SrcMemberTypeData%AxCa) + if (.not. allocated(DstMemberTypeData%AxCa)) then + allocate(DstMemberTypeData%AxCa(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%AxCa.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%AxCa = SrcMemberTypeData%AxCa + else if (allocated(DstMemberTypeData%AxCa)) then + deallocate(DstMemberTypeData%AxCa) + end if + if (allocated(SrcMemberTypeData%AxCp)) then + LB(1:1) = lbound(SrcMemberTypeData%AxCp) + UB(1:1) = ubound(SrcMemberTypeData%AxCp) + if (.not. allocated(DstMemberTypeData%AxCp)) then + allocate(DstMemberTypeData%AxCp(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%AxCp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%AxCp = SrcMemberTypeData%AxCp + else if (allocated(DstMemberTypeData%AxCp)) then + deallocate(DstMemberTypeData%AxCp) + end if + if (allocated(SrcMemberTypeData%Cb)) then + LB(1:1) = lbound(SrcMemberTypeData%Cb) + UB(1:1) = ubound(SrcMemberTypeData%Cb) + if (.not. allocated(DstMemberTypeData%Cb)) then + allocate(DstMemberTypeData%Cb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%Cb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%Cb = SrcMemberTypeData%Cb + else if (allocated(DstMemberTypeData%Cb)) then + deallocate(DstMemberTypeData%Cb) + end if + if (allocated(SrcMemberTypeData%m_fb_l)) then + LB(1:1) = lbound(SrcMemberTypeData%m_fb_l) + UB(1:1) = ubound(SrcMemberTypeData%m_fb_l) + if (.not. allocated(DstMemberTypeData%m_fb_l)) then + allocate(DstMemberTypeData%m_fb_l(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%m_fb_l.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%m_fb_l = SrcMemberTypeData%m_fb_l + else if (allocated(DstMemberTypeData%m_fb_l)) then + deallocate(DstMemberTypeData%m_fb_l) + end if + if (allocated(SrcMemberTypeData%m_fb_u)) then + LB(1:1) = lbound(SrcMemberTypeData%m_fb_u) + UB(1:1) = ubound(SrcMemberTypeData%m_fb_u) + if (.not. allocated(DstMemberTypeData%m_fb_u)) then + allocate(DstMemberTypeData%m_fb_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%m_fb_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%m_fb_u = SrcMemberTypeData%m_fb_u + else if (allocated(DstMemberTypeData%m_fb_u)) then + deallocate(DstMemberTypeData%m_fb_u) + end if + if (allocated(SrcMemberTypeData%h_cfb_l)) then + LB(1:1) = lbound(SrcMemberTypeData%h_cfb_l) + UB(1:1) = ubound(SrcMemberTypeData%h_cfb_l) + if (.not. allocated(DstMemberTypeData%h_cfb_l)) then + allocate(DstMemberTypeData%h_cfb_l(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%h_cfb_l.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%h_cfb_l = SrcMemberTypeData%h_cfb_l + else if (allocated(DstMemberTypeData%h_cfb_l)) then + deallocate(DstMemberTypeData%h_cfb_l) + end if + if (allocated(SrcMemberTypeData%h_cfb_u)) then + LB(1:1) = lbound(SrcMemberTypeData%h_cfb_u) + UB(1:1) = ubound(SrcMemberTypeData%h_cfb_u) + if (.not. allocated(DstMemberTypeData%h_cfb_u)) then + allocate(DstMemberTypeData%h_cfb_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%h_cfb_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%h_cfb_u = SrcMemberTypeData%h_cfb_u + else if (allocated(DstMemberTypeData%h_cfb_u)) then + deallocate(DstMemberTypeData%h_cfb_u) + end if + if (allocated(SrcMemberTypeData%I_lfb_l)) then + LB(1:1) = lbound(SrcMemberTypeData%I_lfb_l) + UB(1:1) = ubound(SrcMemberTypeData%I_lfb_l) + if (.not. allocated(DstMemberTypeData%I_lfb_l)) then + allocate(DstMemberTypeData%I_lfb_l(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_lfb_l.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%I_lfb_l = SrcMemberTypeData%I_lfb_l + else if (allocated(DstMemberTypeData%I_lfb_l)) then + deallocate(DstMemberTypeData%I_lfb_l) + end if + if (allocated(SrcMemberTypeData%I_lfb_u)) then + LB(1:1) = lbound(SrcMemberTypeData%I_lfb_u) + UB(1:1) = ubound(SrcMemberTypeData%I_lfb_u) + if (.not. allocated(DstMemberTypeData%I_lfb_u)) then + allocate(DstMemberTypeData%I_lfb_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_lfb_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%I_lfb_u = SrcMemberTypeData%I_lfb_u + else if (allocated(DstMemberTypeData%I_lfb_u)) then + deallocate(DstMemberTypeData%I_lfb_u) + end if + if (allocated(SrcMemberTypeData%I_rfb_l)) then + LB(1:1) = lbound(SrcMemberTypeData%I_rfb_l) + UB(1:1) = ubound(SrcMemberTypeData%I_rfb_l) + if (.not. allocated(DstMemberTypeData%I_rfb_l)) then + allocate(DstMemberTypeData%I_rfb_l(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_rfb_l.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%I_rfb_l = SrcMemberTypeData%I_rfb_l + else if (allocated(DstMemberTypeData%I_rfb_l)) then + deallocate(DstMemberTypeData%I_rfb_l) + end if + if (allocated(SrcMemberTypeData%I_rfb_u)) then + LB(1:1) = lbound(SrcMemberTypeData%I_rfb_u) + UB(1:1) = ubound(SrcMemberTypeData%I_rfb_u) + if (.not. allocated(DstMemberTypeData%I_rfb_u)) then + allocate(DstMemberTypeData%I_rfb_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_rfb_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%I_rfb_u = SrcMemberTypeData%I_rfb_u + else if (allocated(DstMemberTypeData%I_rfb_u)) then + deallocate(DstMemberTypeData%I_rfb_u) + end if + if (allocated(SrcMemberTypeData%m_mg_l)) then + LB(1:1) = lbound(SrcMemberTypeData%m_mg_l) + UB(1:1) = ubound(SrcMemberTypeData%m_mg_l) + if (.not. allocated(DstMemberTypeData%m_mg_l)) then + allocate(DstMemberTypeData%m_mg_l(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%m_mg_l.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%m_mg_l = SrcMemberTypeData%m_mg_l + else if (allocated(DstMemberTypeData%m_mg_l)) then + deallocate(DstMemberTypeData%m_mg_l) + end if + if (allocated(SrcMemberTypeData%m_mg_u)) then + LB(1:1) = lbound(SrcMemberTypeData%m_mg_u) + UB(1:1) = ubound(SrcMemberTypeData%m_mg_u) + if (.not. allocated(DstMemberTypeData%m_mg_u)) then + allocate(DstMemberTypeData%m_mg_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%m_mg_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%m_mg_u = SrcMemberTypeData%m_mg_u + else if (allocated(DstMemberTypeData%m_mg_u)) then + deallocate(DstMemberTypeData%m_mg_u) + end if + if (allocated(SrcMemberTypeData%h_cmg_l)) then + LB(1:1) = lbound(SrcMemberTypeData%h_cmg_l) + UB(1:1) = ubound(SrcMemberTypeData%h_cmg_l) + if (.not. allocated(DstMemberTypeData%h_cmg_l)) then + allocate(DstMemberTypeData%h_cmg_l(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%h_cmg_l.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%h_cmg_l = SrcMemberTypeData%h_cmg_l + else if (allocated(DstMemberTypeData%h_cmg_l)) then + deallocate(DstMemberTypeData%h_cmg_l) + end if + if (allocated(SrcMemberTypeData%h_cmg_u)) then + LB(1:1) = lbound(SrcMemberTypeData%h_cmg_u) + UB(1:1) = ubound(SrcMemberTypeData%h_cmg_u) + if (.not. allocated(DstMemberTypeData%h_cmg_u)) then + allocate(DstMemberTypeData%h_cmg_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%h_cmg_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%h_cmg_u = SrcMemberTypeData%h_cmg_u + else if (allocated(DstMemberTypeData%h_cmg_u)) then + deallocate(DstMemberTypeData%h_cmg_u) + end if + if (allocated(SrcMemberTypeData%I_lmg_l)) then + LB(1:1) = lbound(SrcMemberTypeData%I_lmg_l) + UB(1:1) = ubound(SrcMemberTypeData%I_lmg_l) + if (.not. allocated(DstMemberTypeData%I_lmg_l)) then + allocate(DstMemberTypeData%I_lmg_l(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_lmg_l.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%I_lmg_l = SrcMemberTypeData%I_lmg_l + else if (allocated(DstMemberTypeData%I_lmg_l)) then + deallocate(DstMemberTypeData%I_lmg_l) + end if + if (allocated(SrcMemberTypeData%I_lmg_u)) then + LB(1:1) = lbound(SrcMemberTypeData%I_lmg_u) + UB(1:1) = ubound(SrcMemberTypeData%I_lmg_u) + if (.not. allocated(DstMemberTypeData%I_lmg_u)) then + allocate(DstMemberTypeData%I_lmg_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_lmg_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%I_lmg_u = SrcMemberTypeData%I_lmg_u + else if (allocated(DstMemberTypeData%I_lmg_u)) then + deallocate(DstMemberTypeData%I_lmg_u) + end if + if (allocated(SrcMemberTypeData%I_rmg_l)) then + LB(1:1) = lbound(SrcMemberTypeData%I_rmg_l) + UB(1:1) = ubound(SrcMemberTypeData%I_rmg_l) + if (.not. allocated(DstMemberTypeData%I_rmg_l)) then + allocate(DstMemberTypeData%I_rmg_l(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_rmg_l.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%I_rmg_l = SrcMemberTypeData%I_rmg_l + else if (allocated(DstMemberTypeData%I_rmg_l)) then + deallocate(DstMemberTypeData%I_rmg_l) + end if + if (allocated(SrcMemberTypeData%I_rmg_u)) then + LB(1:1) = lbound(SrcMemberTypeData%I_rmg_u) + UB(1:1) = ubound(SrcMemberTypeData%I_rmg_u) + if (.not. allocated(DstMemberTypeData%I_rmg_u)) then + allocate(DstMemberTypeData%I_rmg_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%I_rmg_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%I_rmg_u = SrcMemberTypeData%I_rmg_u + else if (allocated(DstMemberTypeData%I_rmg_u)) then + deallocate(DstMemberTypeData%I_rmg_u) + end if + if (allocated(SrcMemberTypeData%Cfl_fb)) then + LB(1:1) = lbound(SrcMemberTypeData%Cfl_fb) + UB(1:1) = ubound(SrcMemberTypeData%Cfl_fb) + if (.not. allocated(DstMemberTypeData%Cfl_fb)) then + allocate(DstMemberTypeData%Cfl_fb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%Cfl_fb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%Cfl_fb = SrcMemberTypeData%Cfl_fb + else if (allocated(DstMemberTypeData%Cfl_fb)) then + deallocate(DstMemberTypeData%Cfl_fb) + end if + if (allocated(SrcMemberTypeData%Cfr_fb)) then + LB(1:1) = lbound(SrcMemberTypeData%Cfr_fb) + UB(1:1) = ubound(SrcMemberTypeData%Cfr_fb) + if (.not. allocated(DstMemberTypeData%Cfr_fb)) then + allocate(DstMemberTypeData%Cfr_fb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%Cfr_fb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%Cfr_fb = SrcMemberTypeData%Cfr_fb + else if (allocated(DstMemberTypeData%Cfr_fb)) then + deallocate(DstMemberTypeData%Cfr_fb) + end if + if (allocated(SrcMemberTypeData%CM0_fb)) then + LB(1:1) = lbound(SrcMemberTypeData%CM0_fb) + UB(1:1) = ubound(SrcMemberTypeData%CM0_fb) + if (.not. allocated(DstMemberTypeData%CM0_fb)) then + allocate(DstMemberTypeData%CM0_fb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberTypeData%CM0_fb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberTypeData%CM0_fb = SrcMemberTypeData%CM0_fb + else if (allocated(DstMemberTypeData%CM0_fb)) then + deallocate(DstMemberTypeData%CM0_fb) + end if + DstMemberTypeData%MGvolume = SrcMemberTypeData%MGvolume + DstMemberTypeData%MDivSize = SrcMemberTypeData%MDivSize + DstMemberTypeData%MCoefMod = SrcMemberTypeData%MCoefMod + DstMemberTypeData%MmbrCoefIDIndx = SrcMemberTypeData%MmbrCoefIDIndx + DstMemberTypeData%MmbrFilledIDIndx = SrcMemberTypeData%MmbrFilledIDIndx + DstMemberTypeData%MHstLMod = SrcMemberTypeData%MHstLMod + DstMemberTypeData%FillFSLoc = SrcMemberTypeData%FillFSLoc + DstMemberTypeData%FillDens = SrcMemberTypeData%FillDens + DstMemberTypeData%PropPot = SrcMemberTypeData%PropPot + DstMemberTypeData%PropMCF = SrcMemberTypeData%PropMCF + DstMemberTypeData%Flipped = SrcMemberTypeData%Flipped +end subroutine +subroutine Morison_DestroyMemberType(MemberTypeData, ErrStat, ErrMsg) + type(Morison_MemberType), intent(inout) :: MemberTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyMemberType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MemberTypeData%NodeIndx)) then + deallocate(MemberTypeData%NodeIndx) + end if + if (allocated(MemberTypeData%R)) then + deallocate(MemberTypeData%R) + end if + if (allocated(MemberTypeData%RMG)) then + deallocate(MemberTypeData%RMG) + end if + if (allocated(MemberTypeData%RMGB)) then + deallocate(MemberTypeData%RMGB) + end if + if (allocated(MemberTypeData%Rin)) then + deallocate(MemberTypeData%Rin) + end if + if (allocated(MemberTypeData%tMG)) then + deallocate(MemberTypeData%tMG) + end if + if (allocated(MemberTypeData%MGdensity)) then + deallocate(MemberTypeData%MGdensity) + end if + if (allocated(MemberTypeData%dRdl_mg)) then + deallocate(MemberTypeData%dRdl_mg) + end if + if (allocated(MemberTypeData%dRdl_mg_b)) then + deallocate(MemberTypeData%dRdl_mg_b) + end if + if (allocated(MemberTypeData%dRdl_in)) then + deallocate(MemberTypeData%dRdl_in) + end if + if (allocated(MemberTypeData%floodstatus)) then + deallocate(MemberTypeData%floodstatus) + end if + if (allocated(MemberTypeData%alpha)) then + deallocate(MemberTypeData%alpha) + end if + if (allocated(MemberTypeData%alpha_fb)) then + deallocate(MemberTypeData%alpha_fb) + end if + if (allocated(MemberTypeData%alpha_fb_star)) then + deallocate(MemberTypeData%alpha_fb_star) + end if + if (allocated(MemberTypeData%Cd)) then + deallocate(MemberTypeData%Cd) + end if + if (allocated(MemberTypeData%Ca)) then + deallocate(MemberTypeData%Ca) + end if + if (allocated(MemberTypeData%Cp)) then + deallocate(MemberTypeData%Cp) + end if + if (allocated(MemberTypeData%AxCd)) then + deallocate(MemberTypeData%AxCd) + end if + if (allocated(MemberTypeData%AxCa)) then + deallocate(MemberTypeData%AxCa) + end if + if (allocated(MemberTypeData%AxCp)) then + deallocate(MemberTypeData%AxCp) + end if + if (allocated(MemberTypeData%Cb)) then + deallocate(MemberTypeData%Cb) + end if + if (allocated(MemberTypeData%m_fb_l)) then + deallocate(MemberTypeData%m_fb_l) + end if + if (allocated(MemberTypeData%m_fb_u)) then + deallocate(MemberTypeData%m_fb_u) + end if + if (allocated(MemberTypeData%h_cfb_l)) then + deallocate(MemberTypeData%h_cfb_l) + end if + if (allocated(MemberTypeData%h_cfb_u)) then + deallocate(MemberTypeData%h_cfb_u) + end if + if (allocated(MemberTypeData%I_lfb_l)) then + deallocate(MemberTypeData%I_lfb_l) + end if + if (allocated(MemberTypeData%I_lfb_u)) then + deallocate(MemberTypeData%I_lfb_u) + end if + if (allocated(MemberTypeData%I_rfb_l)) then + deallocate(MemberTypeData%I_rfb_l) + end if + if (allocated(MemberTypeData%I_rfb_u)) then + deallocate(MemberTypeData%I_rfb_u) + end if + if (allocated(MemberTypeData%m_mg_l)) then + deallocate(MemberTypeData%m_mg_l) + end if + if (allocated(MemberTypeData%m_mg_u)) then + deallocate(MemberTypeData%m_mg_u) + end if + if (allocated(MemberTypeData%h_cmg_l)) then + deallocate(MemberTypeData%h_cmg_l) + end if + if (allocated(MemberTypeData%h_cmg_u)) then + deallocate(MemberTypeData%h_cmg_u) + end if + if (allocated(MemberTypeData%I_lmg_l)) then + deallocate(MemberTypeData%I_lmg_l) + end if + if (allocated(MemberTypeData%I_lmg_u)) then + deallocate(MemberTypeData%I_lmg_u) + end if + if (allocated(MemberTypeData%I_rmg_l)) then + deallocate(MemberTypeData%I_rmg_l) + end if + if (allocated(MemberTypeData%I_rmg_u)) then + deallocate(MemberTypeData%I_rmg_u) + end if + if (allocated(MemberTypeData%Cfl_fb)) then + deallocate(MemberTypeData%Cfl_fb) + end if + if (allocated(MemberTypeData%Cfr_fb)) then + deallocate(MemberTypeData%Cfr_fb) + end if + if (allocated(MemberTypeData%CM0_fb)) then + deallocate(MemberTypeData%CM0_fb) + end if +end subroutine subroutine Morison_PackMemberType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Morison_MemberType), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackMemberType' if (Buf%ErrStat >= AbortErrLev) return - ! NodeIndx call RegPack(Buf, allocated(InData%NodeIndx)) if (allocated(InData%NodeIndx)) then call RegPackBounds(Buf, 1, lbound(InData%NodeIndx), ubound(InData%NodeIndx)) call RegPack(Buf, InData%NodeIndx) end if if (RegCheckErr(Buf, RoutineName)) return - ! MemberID call RegPack(Buf, InData%MemberID) if (RegCheckErr(Buf, RoutineName)) return - ! NElements call RegPack(Buf, InData%NElements) if (RegCheckErr(Buf, RoutineName)) return - ! RefLength call RegPack(Buf, InData%RefLength) if (RegCheckErr(Buf, RoutineName)) return - ! cosPhi_ref call RegPack(Buf, InData%cosPhi_ref) if (RegCheckErr(Buf, RoutineName)) return - ! dl call RegPack(Buf, InData%dl) if (RegCheckErr(Buf, RoutineName)) return - ! k call RegPack(Buf, InData%k) if (RegCheckErr(Buf, RoutineName)) return - ! kkt call RegPack(Buf, InData%kkt) if (RegCheckErr(Buf, RoutineName)) return - ! Ak call RegPack(Buf, InData%Ak) if (RegCheckErr(Buf, RoutineName)) return - ! R call RegPack(Buf, allocated(InData%R)) if (allocated(InData%R)) then call RegPackBounds(Buf, 1, lbound(InData%R), ubound(InData%R)) call RegPack(Buf, InData%R) end if if (RegCheckErr(Buf, RoutineName)) return - ! RMG call RegPack(Buf, allocated(InData%RMG)) if (allocated(InData%RMG)) then call RegPackBounds(Buf, 1, lbound(InData%RMG), ubound(InData%RMG)) call RegPack(Buf, InData%RMG) end if if (RegCheckErr(Buf, RoutineName)) return - ! RMGB call RegPack(Buf, allocated(InData%RMGB)) if (allocated(InData%RMGB)) then call RegPackBounds(Buf, 1, lbound(InData%RMGB), ubound(InData%RMGB)) call RegPack(Buf, InData%RMGB) end if if (RegCheckErr(Buf, RoutineName)) return - ! Rin call RegPack(Buf, allocated(InData%Rin)) if (allocated(InData%Rin)) then call RegPackBounds(Buf, 1, lbound(InData%Rin), ubound(InData%Rin)) call RegPack(Buf, InData%Rin) end if if (RegCheckErr(Buf, RoutineName)) return - ! tMG call RegPack(Buf, allocated(InData%tMG)) if (allocated(InData%tMG)) then call RegPackBounds(Buf, 1, lbound(InData%tMG), ubound(InData%tMG)) call RegPack(Buf, InData%tMG) end if if (RegCheckErr(Buf, RoutineName)) return - ! MGdensity call RegPack(Buf, allocated(InData%MGdensity)) if (allocated(InData%MGdensity)) then call RegPackBounds(Buf, 1, lbound(InData%MGdensity), ubound(InData%MGdensity)) call RegPack(Buf, InData%MGdensity) end if if (RegCheckErr(Buf, RoutineName)) return - ! dRdl_mg call RegPack(Buf, allocated(InData%dRdl_mg)) if (allocated(InData%dRdl_mg)) then call RegPackBounds(Buf, 1, lbound(InData%dRdl_mg), ubound(InData%dRdl_mg)) call RegPack(Buf, InData%dRdl_mg) end if if (RegCheckErr(Buf, RoutineName)) return - ! dRdl_mg_b call RegPack(Buf, allocated(InData%dRdl_mg_b)) if (allocated(InData%dRdl_mg_b)) then call RegPackBounds(Buf, 1, lbound(InData%dRdl_mg_b), ubound(InData%dRdl_mg_b)) call RegPack(Buf, InData%dRdl_mg_b) end if if (RegCheckErr(Buf, RoutineName)) return - ! dRdl_in call RegPack(Buf, allocated(InData%dRdl_in)) if (allocated(InData%dRdl_in)) then call RegPackBounds(Buf, 1, lbound(InData%dRdl_in), ubound(InData%dRdl_in)) call RegPack(Buf, InData%dRdl_in) end if if (RegCheckErr(Buf, RoutineName)) return - ! Vinner call RegPack(Buf, InData%Vinner) if (RegCheckErr(Buf, RoutineName)) return - ! Vouter call RegPack(Buf, InData%Vouter) if (RegCheckErr(Buf, RoutineName)) return - ! Vballast call RegPack(Buf, InData%Vballast) if (RegCheckErr(Buf, RoutineName)) return - ! Vsubmerged call RegPack(Buf, InData%Vsubmerged) if (RegCheckErr(Buf, RoutineName)) return - ! l_fill call RegPack(Buf, InData%l_fill) if (RegCheckErr(Buf, RoutineName)) return - ! h_fill call RegPack(Buf, InData%h_fill) if (RegCheckErr(Buf, RoutineName)) return - ! z_overfill call RegPack(Buf, InData%z_overfill) if (RegCheckErr(Buf, RoutineName)) return - ! h_floor call RegPack(Buf, InData%h_floor) if (RegCheckErr(Buf, RoutineName)) return - ! i_floor call RegPack(Buf, InData%i_floor) if (RegCheckErr(Buf, RoutineName)) return - ! doEndBuoyancy call RegPack(Buf, InData%doEndBuoyancy) if (RegCheckErr(Buf, RoutineName)) return - ! memfloodstatus call RegPack(Buf, InData%memfloodstatus) if (RegCheckErr(Buf, RoutineName)) return - ! floodstatus call RegPack(Buf, allocated(InData%floodstatus)) if (allocated(InData%floodstatus)) then call RegPackBounds(Buf, 1, lbound(InData%floodstatus), ubound(InData%floodstatus)) call RegPack(Buf, InData%floodstatus) end if if (RegCheckErr(Buf, RoutineName)) return - ! alpha call RegPack(Buf, allocated(InData%alpha)) if (allocated(InData%alpha)) then call RegPackBounds(Buf, 1, lbound(InData%alpha), ubound(InData%alpha)) call RegPack(Buf, InData%alpha) end if if (RegCheckErr(Buf, RoutineName)) return - ! alpha_fb call RegPack(Buf, allocated(InData%alpha_fb)) if (allocated(InData%alpha_fb)) then call RegPackBounds(Buf, 1, lbound(InData%alpha_fb), ubound(InData%alpha_fb)) call RegPack(Buf, InData%alpha_fb) end if if (RegCheckErr(Buf, RoutineName)) return - ! alpha_fb_star call RegPack(Buf, allocated(InData%alpha_fb_star)) if (allocated(InData%alpha_fb_star)) then call RegPackBounds(Buf, 1, lbound(InData%alpha_fb_star), ubound(InData%alpha_fb_star)) call RegPack(Buf, InData%alpha_fb_star) end if if (RegCheckErr(Buf, RoutineName)) return - ! Cd call RegPack(Buf, allocated(InData%Cd)) if (allocated(InData%Cd)) then call RegPackBounds(Buf, 1, lbound(InData%Cd), ubound(InData%Cd)) call RegPack(Buf, InData%Cd) end if if (RegCheckErr(Buf, RoutineName)) return - ! Ca call RegPack(Buf, allocated(InData%Ca)) if (allocated(InData%Ca)) then call RegPackBounds(Buf, 1, lbound(InData%Ca), ubound(InData%Ca)) call RegPack(Buf, InData%Ca) end if if (RegCheckErr(Buf, RoutineName)) return - ! Cp call RegPack(Buf, allocated(InData%Cp)) if (allocated(InData%Cp)) then call RegPackBounds(Buf, 1, lbound(InData%Cp), ubound(InData%Cp)) call RegPack(Buf, InData%Cp) end if if (RegCheckErr(Buf, RoutineName)) return - ! AxCd call RegPack(Buf, allocated(InData%AxCd)) if (allocated(InData%AxCd)) then call RegPackBounds(Buf, 1, lbound(InData%AxCd), ubound(InData%AxCd)) call RegPack(Buf, InData%AxCd) end if if (RegCheckErr(Buf, RoutineName)) return - ! AxCa call RegPack(Buf, allocated(InData%AxCa)) if (allocated(InData%AxCa)) then call RegPackBounds(Buf, 1, lbound(InData%AxCa), ubound(InData%AxCa)) call RegPack(Buf, InData%AxCa) end if if (RegCheckErr(Buf, RoutineName)) return - ! AxCp call RegPack(Buf, allocated(InData%AxCp)) if (allocated(InData%AxCp)) then call RegPackBounds(Buf, 1, lbound(InData%AxCp), ubound(InData%AxCp)) call RegPack(Buf, InData%AxCp) end if if (RegCheckErr(Buf, RoutineName)) return - ! Cb call RegPack(Buf, allocated(InData%Cb)) if (allocated(InData%Cb)) then call RegPackBounds(Buf, 1, lbound(InData%Cb), ubound(InData%Cb)) call RegPack(Buf, InData%Cb) end if if (RegCheckErr(Buf, RoutineName)) return - ! m_fb_l call RegPack(Buf, allocated(InData%m_fb_l)) if (allocated(InData%m_fb_l)) then call RegPackBounds(Buf, 1, lbound(InData%m_fb_l), ubound(InData%m_fb_l)) call RegPack(Buf, InData%m_fb_l) end if if (RegCheckErr(Buf, RoutineName)) return - ! m_fb_u call RegPack(Buf, allocated(InData%m_fb_u)) if (allocated(InData%m_fb_u)) then call RegPackBounds(Buf, 1, lbound(InData%m_fb_u), ubound(InData%m_fb_u)) call RegPack(Buf, InData%m_fb_u) end if if (RegCheckErr(Buf, RoutineName)) return - ! h_cfb_l call RegPack(Buf, allocated(InData%h_cfb_l)) if (allocated(InData%h_cfb_l)) then call RegPackBounds(Buf, 1, lbound(InData%h_cfb_l), ubound(InData%h_cfb_l)) call RegPack(Buf, InData%h_cfb_l) end if if (RegCheckErr(Buf, RoutineName)) return - ! h_cfb_u call RegPack(Buf, allocated(InData%h_cfb_u)) if (allocated(InData%h_cfb_u)) then call RegPackBounds(Buf, 1, lbound(InData%h_cfb_u), ubound(InData%h_cfb_u)) call RegPack(Buf, InData%h_cfb_u) end if if (RegCheckErr(Buf, RoutineName)) return - ! I_lfb_l call RegPack(Buf, allocated(InData%I_lfb_l)) if (allocated(InData%I_lfb_l)) then call RegPackBounds(Buf, 1, lbound(InData%I_lfb_l), ubound(InData%I_lfb_l)) call RegPack(Buf, InData%I_lfb_l) end if if (RegCheckErr(Buf, RoutineName)) return - ! I_lfb_u call RegPack(Buf, allocated(InData%I_lfb_u)) if (allocated(InData%I_lfb_u)) then call RegPackBounds(Buf, 1, lbound(InData%I_lfb_u), ubound(InData%I_lfb_u)) call RegPack(Buf, InData%I_lfb_u) end if if (RegCheckErr(Buf, RoutineName)) return - ! I_rfb_l call RegPack(Buf, allocated(InData%I_rfb_l)) if (allocated(InData%I_rfb_l)) then call RegPackBounds(Buf, 1, lbound(InData%I_rfb_l), ubound(InData%I_rfb_l)) call RegPack(Buf, InData%I_rfb_l) end if if (RegCheckErr(Buf, RoutineName)) return - ! I_rfb_u call RegPack(Buf, allocated(InData%I_rfb_u)) if (allocated(InData%I_rfb_u)) then call RegPackBounds(Buf, 1, lbound(InData%I_rfb_u), ubound(InData%I_rfb_u)) call RegPack(Buf, InData%I_rfb_u) end if if (RegCheckErr(Buf, RoutineName)) return - ! m_mg_l call RegPack(Buf, allocated(InData%m_mg_l)) if (allocated(InData%m_mg_l)) then call RegPackBounds(Buf, 1, lbound(InData%m_mg_l), ubound(InData%m_mg_l)) call RegPack(Buf, InData%m_mg_l) end if if (RegCheckErr(Buf, RoutineName)) return - ! m_mg_u call RegPack(Buf, allocated(InData%m_mg_u)) if (allocated(InData%m_mg_u)) then call RegPackBounds(Buf, 1, lbound(InData%m_mg_u), ubound(InData%m_mg_u)) call RegPack(Buf, InData%m_mg_u) end if if (RegCheckErr(Buf, RoutineName)) return - ! h_cmg_l call RegPack(Buf, allocated(InData%h_cmg_l)) if (allocated(InData%h_cmg_l)) then call RegPackBounds(Buf, 1, lbound(InData%h_cmg_l), ubound(InData%h_cmg_l)) call RegPack(Buf, InData%h_cmg_l) end if if (RegCheckErr(Buf, RoutineName)) return - ! h_cmg_u call RegPack(Buf, allocated(InData%h_cmg_u)) if (allocated(InData%h_cmg_u)) then call RegPackBounds(Buf, 1, lbound(InData%h_cmg_u), ubound(InData%h_cmg_u)) call RegPack(Buf, InData%h_cmg_u) end if if (RegCheckErr(Buf, RoutineName)) return - ! I_lmg_l call RegPack(Buf, allocated(InData%I_lmg_l)) if (allocated(InData%I_lmg_l)) then call RegPackBounds(Buf, 1, lbound(InData%I_lmg_l), ubound(InData%I_lmg_l)) call RegPack(Buf, InData%I_lmg_l) end if if (RegCheckErr(Buf, RoutineName)) return - ! I_lmg_u call RegPack(Buf, allocated(InData%I_lmg_u)) if (allocated(InData%I_lmg_u)) then call RegPackBounds(Buf, 1, lbound(InData%I_lmg_u), ubound(InData%I_lmg_u)) call RegPack(Buf, InData%I_lmg_u) end if if (RegCheckErr(Buf, RoutineName)) return - ! I_rmg_l call RegPack(Buf, allocated(InData%I_rmg_l)) if (allocated(InData%I_rmg_l)) then call RegPackBounds(Buf, 1, lbound(InData%I_rmg_l), ubound(InData%I_rmg_l)) call RegPack(Buf, InData%I_rmg_l) end if if (RegCheckErr(Buf, RoutineName)) return - ! I_rmg_u call RegPack(Buf, allocated(InData%I_rmg_u)) if (allocated(InData%I_rmg_u)) then call RegPackBounds(Buf, 1, lbound(InData%I_rmg_u), ubound(InData%I_rmg_u)) call RegPack(Buf, InData%I_rmg_u) end if if (RegCheckErr(Buf, RoutineName)) return - ! Cfl_fb call RegPack(Buf, allocated(InData%Cfl_fb)) if (allocated(InData%Cfl_fb)) then call RegPackBounds(Buf, 1, lbound(InData%Cfl_fb), ubound(InData%Cfl_fb)) call RegPack(Buf, InData%Cfl_fb) end if if (RegCheckErr(Buf, RoutineName)) return - ! Cfr_fb call RegPack(Buf, allocated(InData%Cfr_fb)) if (allocated(InData%Cfr_fb)) then call RegPackBounds(Buf, 1, lbound(InData%Cfr_fb), ubound(InData%Cfr_fb)) call RegPack(Buf, InData%Cfr_fb) end if if (RegCheckErr(Buf, RoutineName)) return - ! CM0_fb call RegPack(Buf, allocated(InData%CM0_fb)) if (allocated(InData%CM0_fb)) then call RegPackBounds(Buf, 1, lbound(InData%CM0_fb), ubound(InData%CM0_fb)) call RegPack(Buf, InData%CM0_fb) end if if (RegCheckErr(Buf, RoutineName)) return - ! MGvolume call RegPack(Buf, InData%MGvolume) if (RegCheckErr(Buf, RoutineName)) return - ! MDivSize call RegPack(Buf, InData%MDivSize) if (RegCheckErr(Buf, RoutineName)) return - ! MCoefMod call RegPack(Buf, InData%MCoefMod) if (RegCheckErr(Buf, RoutineName)) return - ! MmbrCoefIDIndx call RegPack(Buf, InData%MmbrCoefIDIndx) if (RegCheckErr(Buf, RoutineName)) return - ! MmbrFilledIDIndx call RegPack(Buf, InData%MmbrFilledIDIndx) if (RegCheckErr(Buf, RoutineName)) return - ! MHstLMod call RegPack(Buf, InData%MHstLMod) if (RegCheckErr(Buf, RoutineName)) return - ! FillFSLoc call RegPack(Buf, InData%FillFSLoc) if (RegCheckErr(Buf, RoutineName)) return - ! FillDens call RegPack(Buf, InData%FillDens) if (RegCheckErr(Buf, RoutineName)) return - ! PropPot call RegPack(Buf, InData%PropPot) if (RegCheckErr(Buf, RoutineName)) return - ! PropMCF call RegPack(Buf, InData%PropMCF) if (RegCheckErr(Buf, RoutineName)) return - ! Flipped call RegPack(Buf, InData%Flipped) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2381,7 +2161,6 @@ subroutine Morison_UnPackMemberType(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! NodeIndx if (allocated(OutData%NodeIndx)) deallocate(OutData%NodeIndx) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2396,31 +2175,22 @@ subroutine Morison_UnPackMemberType(Buf, OutData) call RegUnpack(Buf, OutData%NodeIndx) if (RegCheckErr(Buf, RoutineName)) return end if - ! MemberID call RegUnpack(Buf, OutData%MemberID) if (RegCheckErr(Buf, RoutineName)) return - ! NElements call RegUnpack(Buf, OutData%NElements) if (RegCheckErr(Buf, RoutineName)) return - ! RefLength call RegUnpack(Buf, OutData%RefLength) if (RegCheckErr(Buf, RoutineName)) return - ! cosPhi_ref call RegUnpack(Buf, OutData%cosPhi_ref) if (RegCheckErr(Buf, RoutineName)) return - ! dl call RegUnpack(Buf, OutData%dl) if (RegCheckErr(Buf, RoutineName)) return - ! k call RegUnpack(Buf, OutData%k) if (RegCheckErr(Buf, RoutineName)) return - ! kkt call RegUnpack(Buf, OutData%kkt) if (RegCheckErr(Buf, RoutineName)) return - ! Ak call RegUnpack(Buf, OutData%Ak) if (RegCheckErr(Buf, RoutineName)) return - ! R if (allocated(OutData%R)) deallocate(OutData%R) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2435,7 +2205,6 @@ subroutine Morison_UnPackMemberType(Buf, OutData) call RegUnpack(Buf, OutData%R) if (RegCheckErr(Buf, RoutineName)) return end if - ! RMG if (allocated(OutData%RMG)) deallocate(OutData%RMG) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2450,7 +2219,6 @@ subroutine Morison_UnPackMemberType(Buf, OutData) call RegUnpack(Buf, OutData%RMG) if (RegCheckErr(Buf, RoutineName)) return end if - ! RMGB if (allocated(OutData%RMGB)) deallocate(OutData%RMGB) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2465,7 +2233,6 @@ subroutine Morison_UnPackMemberType(Buf, OutData) call RegUnpack(Buf, OutData%RMGB) if (RegCheckErr(Buf, RoutineName)) return end if - ! Rin if (allocated(OutData%Rin)) deallocate(OutData%Rin) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2480,7 +2247,6 @@ subroutine Morison_UnPackMemberType(Buf, OutData) call RegUnpack(Buf, OutData%Rin) if (RegCheckErr(Buf, RoutineName)) return end if - ! tMG if (allocated(OutData%tMG)) deallocate(OutData%tMG) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2495,7 +2261,6 @@ subroutine Morison_UnPackMemberType(Buf, OutData) call RegUnpack(Buf, OutData%tMG) if (RegCheckErr(Buf, RoutineName)) return end if - ! MGdensity if (allocated(OutData%MGdensity)) deallocate(OutData%MGdensity) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2510,7 +2275,6 @@ subroutine Morison_UnPackMemberType(Buf, OutData) call RegUnpack(Buf, OutData%MGdensity) if (RegCheckErr(Buf, RoutineName)) return end if - ! dRdl_mg if (allocated(OutData%dRdl_mg)) deallocate(OutData%dRdl_mg) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2525,7 +2289,6 @@ subroutine Morison_UnPackMemberType(Buf, OutData) call RegUnpack(Buf, OutData%dRdl_mg) if (RegCheckErr(Buf, RoutineName)) return end if - ! dRdl_mg_b if (allocated(OutData%dRdl_mg_b)) deallocate(OutData%dRdl_mg_b) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2540,7 +2303,6 @@ subroutine Morison_UnPackMemberType(Buf, OutData) call RegUnpack(Buf, OutData%dRdl_mg_b) if (RegCheckErr(Buf, RoutineName)) return end if - ! dRdl_in if (allocated(OutData%dRdl_in)) deallocate(OutData%dRdl_in) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2555,40 +2317,28 @@ subroutine Morison_UnPackMemberType(Buf, OutData) call RegUnpack(Buf, OutData%dRdl_in) if (RegCheckErr(Buf, RoutineName)) return end if - ! Vinner call RegUnpack(Buf, OutData%Vinner) if (RegCheckErr(Buf, RoutineName)) return - ! Vouter call RegUnpack(Buf, OutData%Vouter) if (RegCheckErr(Buf, RoutineName)) return - ! Vballast call RegUnpack(Buf, OutData%Vballast) if (RegCheckErr(Buf, RoutineName)) return - ! Vsubmerged call RegUnpack(Buf, OutData%Vsubmerged) if (RegCheckErr(Buf, RoutineName)) return - ! l_fill call RegUnpack(Buf, OutData%l_fill) if (RegCheckErr(Buf, RoutineName)) return - ! h_fill call RegUnpack(Buf, OutData%h_fill) if (RegCheckErr(Buf, RoutineName)) return - ! z_overfill call RegUnpack(Buf, OutData%z_overfill) if (RegCheckErr(Buf, RoutineName)) return - ! h_floor call RegUnpack(Buf, OutData%h_floor) if (RegCheckErr(Buf, RoutineName)) return - ! i_floor call RegUnpack(Buf, OutData%i_floor) if (RegCheckErr(Buf, RoutineName)) return - ! doEndBuoyancy call RegUnpack(Buf, OutData%doEndBuoyancy) if (RegCheckErr(Buf, RoutineName)) return - ! memfloodstatus call RegUnpack(Buf, OutData%memfloodstatus) if (RegCheckErr(Buf, RoutineName)) return - ! floodstatus if (allocated(OutData%floodstatus)) deallocate(OutData%floodstatus) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2603,7 +2353,6 @@ subroutine Morison_UnPackMemberType(Buf, OutData) call RegUnpack(Buf, OutData%floodstatus) if (RegCheckErr(Buf, RoutineName)) return end if - ! alpha if (allocated(OutData%alpha)) deallocate(OutData%alpha) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2618,7 +2367,6 @@ subroutine Morison_UnPackMemberType(Buf, OutData) call RegUnpack(Buf, OutData%alpha) if (RegCheckErr(Buf, RoutineName)) return end if - ! alpha_fb if (allocated(OutData%alpha_fb)) deallocate(OutData%alpha_fb) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2633,7 +2381,6 @@ subroutine Morison_UnPackMemberType(Buf, OutData) call RegUnpack(Buf, OutData%alpha_fb) if (RegCheckErr(Buf, RoutineName)) return end if - ! alpha_fb_star if (allocated(OutData%alpha_fb_star)) deallocate(OutData%alpha_fb_star) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2648,7 +2395,6 @@ subroutine Morison_UnPackMemberType(Buf, OutData) call RegUnpack(Buf, OutData%alpha_fb_star) if (RegCheckErr(Buf, RoutineName)) return end if - ! Cd if (allocated(OutData%Cd)) deallocate(OutData%Cd) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2663,7 +2409,6 @@ subroutine Morison_UnPackMemberType(Buf, OutData) call RegUnpack(Buf, OutData%Cd) if (RegCheckErr(Buf, RoutineName)) return end if - ! Ca if (allocated(OutData%Ca)) deallocate(OutData%Ca) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2678,7 +2423,6 @@ subroutine Morison_UnPackMemberType(Buf, OutData) call RegUnpack(Buf, OutData%Ca) if (RegCheckErr(Buf, RoutineName)) return end if - ! Cp if (allocated(OutData%Cp)) deallocate(OutData%Cp) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2693,7 +2437,6 @@ subroutine Morison_UnPackMemberType(Buf, OutData) call RegUnpack(Buf, OutData%Cp) if (RegCheckErr(Buf, RoutineName)) return end if - ! AxCd if (allocated(OutData%AxCd)) deallocate(OutData%AxCd) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2708,7 +2451,6 @@ subroutine Morison_UnPackMemberType(Buf, OutData) call RegUnpack(Buf, OutData%AxCd) if (RegCheckErr(Buf, RoutineName)) return end if - ! AxCa if (allocated(OutData%AxCa)) deallocate(OutData%AxCa) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2723,7 +2465,6 @@ subroutine Morison_UnPackMemberType(Buf, OutData) call RegUnpack(Buf, OutData%AxCa) if (RegCheckErr(Buf, RoutineName)) return end if - ! AxCp if (allocated(OutData%AxCp)) deallocate(OutData%AxCp) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2738,7 +2479,6 @@ subroutine Morison_UnPackMemberType(Buf, OutData) call RegUnpack(Buf, OutData%AxCp) if (RegCheckErr(Buf, RoutineName)) return end if - ! Cb if (allocated(OutData%Cb)) deallocate(OutData%Cb) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2753,7 +2493,6 @@ subroutine Morison_UnPackMemberType(Buf, OutData) call RegUnpack(Buf, OutData%Cb) if (RegCheckErr(Buf, RoutineName)) return end if - ! m_fb_l if (allocated(OutData%m_fb_l)) deallocate(OutData%m_fb_l) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2768,7 +2507,6 @@ subroutine Morison_UnPackMemberType(Buf, OutData) call RegUnpack(Buf, OutData%m_fb_l) if (RegCheckErr(Buf, RoutineName)) return end if - ! m_fb_u if (allocated(OutData%m_fb_u)) deallocate(OutData%m_fb_u) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2783,7 +2521,6 @@ subroutine Morison_UnPackMemberType(Buf, OutData) call RegUnpack(Buf, OutData%m_fb_u) if (RegCheckErr(Buf, RoutineName)) return end if - ! h_cfb_l if (allocated(OutData%h_cfb_l)) deallocate(OutData%h_cfb_l) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2798,7 +2535,6 @@ subroutine Morison_UnPackMemberType(Buf, OutData) call RegUnpack(Buf, OutData%h_cfb_l) if (RegCheckErr(Buf, RoutineName)) return end if - ! h_cfb_u if (allocated(OutData%h_cfb_u)) deallocate(OutData%h_cfb_u) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2813,7 +2549,6 @@ subroutine Morison_UnPackMemberType(Buf, OutData) call RegUnpack(Buf, OutData%h_cfb_u) if (RegCheckErr(Buf, RoutineName)) return end if - ! I_lfb_l if (allocated(OutData%I_lfb_l)) deallocate(OutData%I_lfb_l) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2828,7 +2563,6 @@ subroutine Morison_UnPackMemberType(Buf, OutData) call RegUnpack(Buf, OutData%I_lfb_l) if (RegCheckErr(Buf, RoutineName)) return end if - ! I_lfb_u if (allocated(OutData%I_lfb_u)) deallocate(OutData%I_lfb_u) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2843,7 +2577,6 @@ subroutine Morison_UnPackMemberType(Buf, OutData) call RegUnpack(Buf, OutData%I_lfb_u) if (RegCheckErr(Buf, RoutineName)) return end if - ! I_rfb_l if (allocated(OutData%I_rfb_l)) deallocate(OutData%I_rfb_l) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2858,7 +2591,6 @@ subroutine Morison_UnPackMemberType(Buf, OutData) call RegUnpack(Buf, OutData%I_rfb_l) if (RegCheckErr(Buf, RoutineName)) return end if - ! I_rfb_u if (allocated(OutData%I_rfb_u)) deallocate(OutData%I_rfb_u) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2873,7 +2605,6 @@ subroutine Morison_UnPackMemberType(Buf, OutData) call RegUnpack(Buf, OutData%I_rfb_u) if (RegCheckErr(Buf, RoutineName)) return end if - ! m_mg_l if (allocated(OutData%m_mg_l)) deallocate(OutData%m_mg_l) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2888,7 +2619,6 @@ subroutine Morison_UnPackMemberType(Buf, OutData) call RegUnpack(Buf, OutData%m_mg_l) if (RegCheckErr(Buf, RoutineName)) return end if - ! m_mg_u if (allocated(OutData%m_mg_u)) deallocate(OutData%m_mg_u) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2903,7 +2633,6 @@ subroutine Morison_UnPackMemberType(Buf, OutData) call RegUnpack(Buf, OutData%m_mg_u) if (RegCheckErr(Buf, RoutineName)) return end if - ! h_cmg_l if (allocated(OutData%h_cmg_l)) deallocate(OutData%h_cmg_l) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2918,7 +2647,6 @@ subroutine Morison_UnPackMemberType(Buf, OutData) call RegUnpack(Buf, OutData%h_cmg_l) if (RegCheckErr(Buf, RoutineName)) return end if - ! h_cmg_u if (allocated(OutData%h_cmg_u)) deallocate(OutData%h_cmg_u) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2933,7 +2661,6 @@ subroutine Morison_UnPackMemberType(Buf, OutData) call RegUnpack(Buf, OutData%h_cmg_u) if (RegCheckErr(Buf, RoutineName)) return end if - ! I_lmg_l if (allocated(OutData%I_lmg_l)) deallocate(OutData%I_lmg_l) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2948,7 +2675,6 @@ subroutine Morison_UnPackMemberType(Buf, OutData) call RegUnpack(Buf, OutData%I_lmg_l) if (RegCheckErr(Buf, RoutineName)) return end if - ! I_lmg_u if (allocated(OutData%I_lmg_u)) deallocate(OutData%I_lmg_u) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2963,7 +2689,6 @@ subroutine Morison_UnPackMemberType(Buf, OutData) call RegUnpack(Buf, OutData%I_lmg_u) if (RegCheckErr(Buf, RoutineName)) return end if - ! I_rmg_l if (allocated(OutData%I_rmg_l)) deallocate(OutData%I_rmg_l) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2978,7 +2703,6 @@ subroutine Morison_UnPackMemberType(Buf, OutData) call RegUnpack(Buf, OutData%I_rmg_l) if (RegCheckErr(Buf, RoutineName)) return end if - ! I_rmg_u if (allocated(OutData%I_rmg_u)) deallocate(OutData%I_rmg_u) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2993,7 +2717,6 @@ subroutine Morison_UnPackMemberType(Buf, OutData) call RegUnpack(Buf, OutData%I_rmg_u) if (RegCheckErr(Buf, RoutineName)) return end if - ! Cfl_fb if (allocated(OutData%Cfl_fb)) deallocate(OutData%Cfl_fb) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3008,7 +2731,6 @@ subroutine Morison_UnPackMemberType(Buf, OutData) call RegUnpack(Buf, OutData%Cfl_fb) if (RegCheckErr(Buf, RoutineName)) return end if - ! Cfr_fb if (allocated(OutData%Cfr_fb)) deallocate(OutData%Cfr_fb) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3023,7 +2745,6 @@ subroutine Morison_UnPackMemberType(Buf, OutData) call RegUnpack(Buf, OutData%Cfr_fb) if (RegCheckErr(Buf, RoutineName)) return end if - ! CM0_fb if (allocated(OutData%CM0_fb)) deallocate(OutData%CM0_fb) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3038,337 +2759,304 @@ subroutine Morison_UnPackMemberType(Buf, OutData) call RegUnpack(Buf, OutData%CM0_fb) if (RegCheckErr(Buf, RoutineName)) return end if - ! MGvolume call RegUnpack(Buf, OutData%MGvolume) if (RegCheckErr(Buf, RoutineName)) return - ! MDivSize call RegUnpack(Buf, OutData%MDivSize) if (RegCheckErr(Buf, RoutineName)) return - ! MCoefMod call RegUnpack(Buf, OutData%MCoefMod) if (RegCheckErr(Buf, RoutineName)) return - ! MmbrCoefIDIndx call RegUnpack(Buf, OutData%MmbrCoefIDIndx) if (RegCheckErr(Buf, RoutineName)) return - ! MmbrFilledIDIndx call RegUnpack(Buf, OutData%MmbrFilledIDIndx) if (RegCheckErr(Buf, RoutineName)) return - ! MHstLMod call RegUnpack(Buf, OutData%MHstLMod) if (RegCheckErr(Buf, RoutineName)) return - ! FillFSLoc call RegUnpack(Buf, OutData%FillFSLoc) if (RegCheckErr(Buf, RoutineName)) return - ! FillDens call RegUnpack(Buf, OutData%FillDens) if (RegCheckErr(Buf, RoutineName)) return - ! PropPot call RegUnpack(Buf, OutData%PropPot) if (RegCheckErr(Buf, RoutineName)) return - ! PropMCF call RegUnpack(Buf, OutData%PropMCF) if (RegCheckErr(Buf, RoutineName)) return - ! Flipped call RegUnpack(Buf, OutData%Flipped) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Morison_CopyMemberLoads( SrcMemberLoadsData, DstMemberLoadsData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_MemberLoads), INTENT(IN) :: SrcMemberLoadsData - TYPE(Morison_MemberLoads), INTENT(INOUT) :: DstMemberLoadsData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_CopyMemberLoads' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMemberLoadsData%F_D)) THEN - i1_l = LBOUND(SrcMemberLoadsData%F_D,1) - i1_u = UBOUND(SrcMemberLoadsData%F_D,1) - i2_l = LBOUND(SrcMemberLoadsData%F_D,2) - i2_u = UBOUND(SrcMemberLoadsData%F_D,2) - IF (.NOT. ALLOCATED(DstMemberLoadsData%F_D)) THEN - ALLOCATE(DstMemberLoadsData%F_D(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_D.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberLoadsData%F_D = SrcMemberLoadsData%F_D -ENDIF -IF (ALLOCATED(SrcMemberLoadsData%F_I)) THEN - i1_l = LBOUND(SrcMemberLoadsData%F_I,1) - i1_u = UBOUND(SrcMemberLoadsData%F_I,1) - i2_l = LBOUND(SrcMemberLoadsData%F_I,2) - i2_u = UBOUND(SrcMemberLoadsData%F_I,2) - IF (.NOT. ALLOCATED(DstMemberLoadsData%F_I)) THEN - ALLOCATE(DstMemberLoadsData%F_I(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_I.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberLoadsData%F_I = SrcMemberLoadsData%F_I -ENDIF -IF (ALLOCATED(SrcMemberLoadsData%F_A)) THEN - i1_l = LBOUND(SrcMemberLoadsData%F_A,1) - i1_u = UBOUND(SrcMemberLoadsData%F_A,1) - i2_l = LBOUND(SrcMemberLoadsData%F_A,2) - i2_u = UBOUND(SrcMemberLoadsData%F_A,2) - IF (.NOT. ALLOCATED(DstMemberLoadsData%F_A)) THEN - ALLOCATE(DstMemberLoadsData%F_A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_A.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberLoadsData%F_A = SrcMemberLoadsData%F_A -ENDIF -IF (ALLOCATED(SrcMemberLoadsData%F_B)) THEN - i1_l = LBOUND(SrcMemberLoadsData%F_B,1) - i1_u = UBOUND(SrcMemberLoadsData%F_B,1) - i2_l = LBOUND(SrcMemberLoadsData%F_B,2) - i2_u = UBOUND(SrcMemberLoadsData%F_B,2) - IF (.NOT. ALLOCATED(DstMemberLoadsData%F_B)) THEN - ALLOCATE(DstMemberLoadsData%F_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberLoadsData%F_B = SrcMemberLoadsData%F_B -ENDIF -IF (ALLOCATED(SrcMemberLoadsData%F_BF)) THEN - i1_l = LBOUND(SrcMemberLoadsData%F_BF,1) - i1_u = UBOUND(SrcMemberLoadsData%F_BF,1) - i2_l = LBOUND(SrcMemberLoadsData%F_BF,2) - i2_u = UBOUND(SrcMemberLoadsData%F_BF,2) - IF (.NOT. ALLOCATED(DstMemberLoadsData%F_BF)) THEN - ALLOCATE(DstMemberLoadsData%F_BF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_BF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberLoadsData%F_BF = SrcMemberLoadsData%F_BF -ENDIF -IF (ALLOCATED(SrcMemberLoadsData%F_If)) THEN - i1_l = LBOUND(SrcMemberLoadsData%F_If,1) - i1_u = UBOUND(SrcMemberLoadsData%F_If,1) - i2_l = LBOUND(SrcMemberLoadsData%F_If,2) - i2_u = UBOUND(SrcMemberLoadsData%F_If,2) - IF (.NOT. ALLOCATED(DstMemberLoadsData%F_If)) THEN - ALLOCATE(DstMemberLoadsData%F_If(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_If.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberLoadsData%F_If = SrcMemberLoadsData%F_If -ENDIF -IF (ALLOCATED(SrcMemberLoadsData%F_WMG)) THEN - i1_l = LBOUND(SrcMemberLoadsData%F_WMG,1) - i1_u = UBOUND(SrcMemberLoadsData%F_WMG,1) - i2_l = LBOUND(SrcMemberLoadsData%F_WMG,2) - i2_u = UBOUND(SrcMemberLoadsData%F_WMG,2) - IF (.NOT. ALLOCATED(DstMemberLoadsData%F_WMG)) THEN - ALLOCATE(DstMemberLoadsData%F_WMG(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_WMG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberLoadsData%F_WMG = SrcMemberLoadsData%F_WMG -ENDIF -IF (ALLOCATED(SrcMemberLoadsData%F_IMG)) THEN - i1_l = LBOUND(SrcMemberLoadsData%F_IMG,1) - i1_u = UBOUND(SrcMemberLoadsData%F_IMG,1) - i2_l = LBOUND(SrcMemberLoadsData%F_IMG,2) - i2_u = UBOUND(SrcMemberLoadsData%F_IMG,2) - IF (.NOT. ALLOCATED(DstMemberLoadsData%F_IMG)) THEN - ALLOCATE(DstMemberLoadsData%F_IMG(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_IMG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberLoadsData%F_IMG = SrcMemberLoadsData%F_IMG -ENDIF -IF (ALLOCATED(SrcMemberLoadsData%FV)) THEN - i1_l = LBOUND(SrcMemberLoadsData%FV,1) - i1_u = UBOUND(SrcMemberLoadsData%FV,1) - i2_l = LBOUND(SrcMemberLoadsData%FV,2) - i2_u = UBOUND(SrcMemberLoadsData%FV,2) - IF (.NOT. ALLOCATED(DstMemberLoadsData%FV)) THEN - ALLOCATE(DstMemberLoadsData%FV(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%FV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberLoadsData%FV = SrcMemberLoadsData%FV -ENDIF -IF (ALLOCATED(SrcMemberLoadsData%FA)) THEN - i1_l = LBOUND(SrcMemberLoadsData%FA,1) - i1_u = UBOUND(SrcMemberLoadsData%FA,1) - i2_l = LBOUND(SrcMemberLoadsData%FA,2) - i2_u = UBOUND(SrcMemberLoadsData%FA,2) - IF (.NOT. ALLOCATED(DstMemberLoadsData%FA)) THEN - ALLOCATE(DstMemberLoadsData%FA(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%FA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberLoadsData%FA = SrcMemberLoadsData%FA -ENDIF -IF (ALLOCATED(SrcMemberLoadsData%F_DP)) THEN - i1_l = LBOUND(SrcMemberLoadsData%F_DP,1) - i1_u = UBOUND(SrcMemberLoadsData%F_DP,1) - i2_l = LBOUND(SrcMemberLoadsData%F_DP,2) - i2_u = UBOUND(SrcMemberLoadsData%F_DP,2) - IF (.NOT. ALLOCATED(DstMemberLoadsData%F_DP)) THEN - ALLOCATE(DstMemberLoadsData%F_DP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_DP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMemberLoadsData%F_DP = SrcMemberLoadsData%F_DP -ENDIF - END SUBROUTINE Morison_CopyMemberLoads - - SUBROUTINE Morison_DestroyMemberLoads( MemberLoadsData, ErrStat, ErrMsg ) - TYPE(Morison_MemberLoads), INTENT(INOUT) :: MemberLoadsData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyMemberLoads' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MemberLoadsData%F_D)) THEN - DEALLOCATE(MemberLoadsData%F_D) -ENDIF -IF (ALLOCATED(MemberLoadsData%F_I)) THEN - DEALLOCATE(MemberLoadsData%F_I) -ENDIF -IF (ALLOCATED(MemberLoadsData%F_A)) THEN - DEALLOCATE(MemberLoadsData%F_A) -ENDIF -IF (ALLOCATED(MemberLoadsData%F_B)) THEN - DEALLOCATE(MemberLoadsData%F_B) -ENDIF -IF (ALLOCATED(MemberLoadsData%F_BF)) THEN - DEALLOCATE(MemberLoadsData%F_BF) -ENDIF -IF (ALLOCATED(MemberLoadsData%F_If)) THEN - DEALLOCATE(MemberLoadsData%F_If) -ENDIF -IF (ALLOCATED(MemberLoadsData%F_WMG)) THEN - DEALLOCATE(MemberLoadsData%F_WMG) -ENDIF -IF (ALLOCATED(MemberLoadsData%F_IMG)) THEN - DEALLOCATE(MemberLoadsData%F_IMG) -ENDIF -IF (ALLOCATED(MemberLoadsData%FV)) THEN - DEALLOCATE(MemberLoadsData%FV) -ENDIF -IF (ALLOCATED(MemberLoadsData%FA)) THEN - DEALLOCATE(MemberLoadsData%FA) -ENDIF -IF (ALLOCATED(MemberLoadsData%F_DP)) THEN - DEALLOCATE(MemberLoadsData%F_DP) -ENDIF - END SUBROUTINE Morison_DestroyMemberLoads +subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlCode, ErrStat, ErrMsg) + type(Morison_MemberLoads), intent(in) :: SrcMemberLoadsData + type(Morison_MemberLoads), intent(inout) :: DstMemberLoadsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Morison_CopyMemberLoads' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMemberLoadsData%F_D)) then + LB(1:2) = lbound(SrcMemberLoadsData%F_D) + UB(1:2) = ubound(SrcMemberLoadsData%F_D) + if (.not. allocated(DstMemberLoadsData%F_D)) then + allocate(DstMemberLoadsData%F_D(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_D.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberLoadsData%F_D = SrcMemberLoadsData%F_D + else if (allocated(DstMemberLoadsData%F_D)) then + deallocate(DstMemberLoadsData%F_D) + end if + if (allocated(SrcMemberLoadsData%F_I)) then + LB(1:2) = lbound(SrcMemberLoadsData%F_I) + UB(1:2) = ubound(SrcMemberLoadsData%F_I) + if (.not. allocated(DstMemberLoadsData%F_I)) then + allocate(DstMemberLoadsData%F_I(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_I.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberLoadsData%F_I = SrcMemberLoadsData%F_I + else if (allocated(DstMemberLoadsData%F_I)) then + deallocate(DstMemberLoadsData%F_I) + end if + if (allocated(SrcMemberLoadsData%F_A)) then + LB(1:2) = lbound(SrcMemberLoadsData%F_A) + UB(1:2) = ubound(SrcMemberLoadsData%F_A) + if (.not. allocated(DstMemberLoadsData%F_A)) then + allocate(DstMemberLoadsData%F_A(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_A.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberLoadsData%F_A = SrcMemberLoadsData%F_A + else if (allocated(DstMemberLoadsData%F_A)) then + deallocate(DstMemberLoadsData%F_A) + end if + if (allocated(SrcMemberLoadsData%F_B)) then + LB(1:2) = lbound(SrcMemberLoadsData%F_B) + UB(1:2) = ubound(SrcMemberLoadsData%F_B) + if (.not. allocated(DstMemberLoadsData%F_B)) then + allocate(DstMemberLoadsData%F_B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberLoadsData%F_B = SrcMemberLoadsData%F_B + else if (allocated(DstMemberLoadsData%F_B)) then + deallocate(DstMemberLoadsData%F_B) + end if + if (allocated(SrcMemberLoadsData%F_BF)) then + LB(1:2) = lbound(SrcMemberLoadsData%F_BF) + UB(1:2) = ubound(SrcMemberLoadsData%F_BF) + if (.not. allocated(DstMemberLoadsData%F_BF)) then + allocate(DstMemberLoadsData%F_BF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_BF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberLoadsData%F_BF = SrcMemberLoadsData%F_BF + else if (allocated(DstMemberLoadsData%F_BF)) then + deallocate(DstMemberLoadsData%F_BF) + end if + if (allocated(SrcMemberLoadsData%F_If)) then + LB(1:2) = lbound(SrcMemberLoadsData%F_If) + UB(1:2) = ubound(SrcMemberLoadsData%F_If) + if (.not. allocated(DstMemberLoadsData%F_If)) then + allocate(DstMemberLoadsData%F_If(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_If.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberLoadsData%F_If = SrcMemberLoadsData%F_If + else if (allocated(DstMemberLoadsData%F_If)) then + deallocate(DstMemberLoadsData%F_If) + end if + if (allocated(SrcMemberLoadsData%F_WMG)) then + LB(1:2) = lbound(SrcMemberLoadsData%F_WMG) + UB(1:2) = ubound(SrcMemberLoadsData%F_WMG) + if (.not. allocated(DstMemberLoadsData%F_WMG)) then + allocate(DstMemberLoadsData%F_WMG(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_WMG.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberLoadsData%F_WMG = SrcMemberLoadsData%F_WMG + else if (allocated(DstMemberLoadsData%F_WMG)) then + deallocate(DstMemberLoadsData%F_WMG) + end if + if (allocated(SrcMemberLoadsData%F_IMG)) then + LB(1:2) = lbound(SrcMemberLoadsData%F_IMG) + UB(1:2) = ubound(SrcMemberLoadsData%F_IMG) + if (.not. allocated(DstMemberLoadsData%F_IMG)) then + allocate(DstMemberLoadsData%F_IMG(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_IMG.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberLoadsData%F_IMG = SrcMemberLoadsData%F_IMG + else if (allocated(DstMemberLoadsData%F_IMG)) then + deallocate(DstMemberLoadsData%F_IMG) + end if + if (allocated(SrcMemberLoadsData%FV)) then + LB(1:2) = lbound(SrcMemberLoadsData%FV) + UB(1:2) = ubound(SrcMemberLoadsData%FV) + if (.not. allocated(DstMemberLoadsData%FV)) then + allocate(DstMemberLoadsData%FV(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%FV.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberLoadsData%FV = SrcMemberLoadsData%FV + else if (allocated(DstMemberLoadsData%FV)) then + deallocate(DstMemberLoadsData%FV) + end if + if (allocated(SrcMemberLoadsData%FA)) then + LB(1:2) = lbound(SrcMemberLoadsData%FA) + UB(1:2) = ubound(SrcMemberLoadsData%FA) + if (.not. allocated(DstMemberLoadsData%FA)) then + allocate(DstMemberLoadsData%FA(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%FA.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberLoadsData%FA = SrcMemberLoadsData%FA + else if (allocated(DstMemberLoadsData%FA)) then + deallocate(DstMemberLoadsData%FA) + end if + if (allocated(SrcMemberLoadsData%F_DP)) then + LB(1:2) = lbound(SrcMemberLoadsData%F_DP) + UB(1:2) = ubound(SrcMemberLoadsData%F_DP) + if (.not. allocated(DstMemberLoadsData%F_DP)) then + allocate(DstMemberLoadsData%F_DP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMemberLoadsData%F_DP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMemberLoadsData%F_DP = SrcMemberLoadsData%F_DP + else if (allocated(DstMemberLoadsData%F_DP)) then + deallocate(DstMemberLoadsData%F_DP) + end if +end subroutine +subroutine Morison_DestroyMemberLoads(MemberLoadsData, ErrStat, ErrMsg) + type(Morison_MemberLoads), intent(inout) :: MemberLoadsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyMemberLoads' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MemberLoadsData%F_D)) then + deallocate(MemberLoadsData%F_D) + end if + if (allocated(MemberLoadsData%F_I)) then + deallocate(MemberLoadsData%F_I) + end if + if (allocated(MemberLoadsData%F_A)) then + deallocate(MemberLoadsData%F_A) + end if + if (allocated(MemberLoadsData%F_B)) then + deallocate(MemberLoadsData%F_B) + end if + if (allocated(MemberLoadsData%F_BF)) then + deallocate(MemberLoadsData%F_BF) + end if + if (allocated(MemberLoadsData%F_If)) then + deallocate(MemberLoadsData%F_If) + end if + if (allocated(MemberLoadsData%F_WMG)) then + deallocate(MemberLoadsData%F_WMG) + end if + if (allocated(MemberLoadsData%F_IMG)) then + deallocate(MemberLoadsData%F_IMG) + end if + if (allocated(MemberLoadsData%FV)) then + deallocate(MemberLoadsData%FV) + end if + if (allocated(MemberLoadsData%FA)) then + deallocate(MemberLoadsData%FA) + end if + if (allocated(MemberLoadsData%F_DP)) then + deallocate(MemberLoadsData%F_DP) + end if +end subroutine subroutine Morison_PackMemberLoads(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Morison_MemberLoads), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackMemberLoads' if (Buf%ErrStat >= AbortErrLev) return - ! F_D call RegPack(Buf, allocated(InData%F_D)) if (allocated(InData%F_D)) then call RegPackBounds(Buf, 2, lbound(InData%F_D), ubound(InData%F_D)) call RegPack(Buf, InData%F_D) end if if (RegCheckErr(Buf, RoutineName)) return - ! F_I call RegPack(Buf, allocated(InData%F_I)) if (allocated(InData%F_I)) then call RegPackBounds(Buf, 2, lbound(InData%F_I), ubound(InData%F_I)) call RegPack(Buf, InData%F_I) end if if (RegCheckErr(Buf, RoutineName)) return - ! F_A call RegPack(Buf, allocated(InData%F_A)) if (allocated(InData%F_A)) then call RegPackBounds(Buf, 2, lbound(InData%F_A), ubound(InData%F_A)) call RegPack(Buf, InData%F_A) end if if (RegCheckErr(Buf, RoutineName)) return - ! F_B call RegPack(Buf, allocated(InData%F_B)) if (allocated(InData%F_B)) then call RegPackBounds(Buf, 2, lbound(InData%F_B), ubound(InData%F_B)) call RegPack(Buf, InData%F_B) end if if (RegCheckErr(Buf, RoutineName)) return - ! F_BF call RegPack(Buf, allocated(InData%F_BF)) if (allocated(InData%F_BF)) then call RegPackBounds(Buf, 2, lbound(InData%F_BF), ubound(InData%F_BF)) call RegPack(Buf, InData%F_BF) end if if (RegCheckErr(Buf, RoutineName)) return - ! F_If call RegPack(Buf, allocated(InData%F_If)) if (allocated(InData%F_If)) then call RegPackBounds(Buf, 2, lbound(InData%F_If), ubound(InData%F_If)) call RegPack(Buf, InData%F_If) end if if (RegCheckErr(Buf, RoutineName)) return - ! F_WMG call RegPack(Buf, allocated(InData%F_WMG)) if (allocated(InData%F_WMG)) then call RegPackBounds(Buf, 2, lbound(InData%F_WMG), ubound(InData%F_WMG)) call RegPack(Buf, InData%F_WMG) end if if (RegCheckErr(Buf, RoutineName)) return - ! F_IMG call RegPack(Buf, allocated(InData%F_IMG)) if (allocated(InData%F_IMG)) then call RegPackBounds(Buf, 2, lbound(InData%F_IMG), ubound(InData%F_IMG)) call RegPack(Buf, InData%F_IMG) end if if (RegCheckErr(Buf, RoutineName)) return - ! FV call RegPack(Buf, allocated(InData%FV)) if (allocated(InData%FV)) then call RegPackBounds(Buf, 2, lbound(InData%FV), ubound(InData%FV)) call RegPack(Buf, InData%FV) end if if (RegCheckErr(Buf, RoutineName)) return - ! FA call RegPack(Buf, allocated(InData%FA)) if (allocated(InData%FA)) then call RegPackBounds(Buf, 2, lbound(InData%FA), ubound(InData%FA)) call RegPack(Buf, InData%FA) end if if (RegCheckErr(Buf, RoutineName)) return - ! F_DP call RegPack(Buf, allocated(InData%F_DP)) if (allocated(InData%F_DP)) then call RegPackBounds(Buf, 2, lbound(InData%F_DP), ubound(InData%F_DP)) @@ -3385,7 +3073,6 @@ subroutine Morison_UnPackMemberLoads(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! F_D if (allocated(OutData%F_D)) deallocate(OutData%F_D) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3400,7 +3087,6 @@ subroutine Morison_UnPackMemberLoads(Buf, OutData) call RegUnpack(Buf, OutData%F_D) if (RegCheckErr(Buf, RoutineName)) return end if - ! F_I if (allocated(OutData%F_I)) deallocate(OutData%F_I) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3415,7 +3101,6 @@ subroutine Morison_UnPackMemberLoads(Buf, OutData) call RegUnpack(Buf, OutData%F_I) if (RegCheckErr(Buf, RoutineName)) return end if - ! F_A if (allocated(OutData%F_A)) deallocate(OutData%F_A) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3430,7 +3115,6 @@ subroutine Morison_UnPackMemberLoads(Buf, OutData) call RegUnpack(Buf, OutData%F_A) if (RegCheckErr(Buf, RoutineName)) return end if - ! F_B if (allocated(OutData%F_B)) deallocate(OutData%F_B) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3445,7 +3129,6 @@ subroutine Morison_UnPackMemberLoads(Buf, OutData) call RegUnpack(Buf, OutData%F_B) if (RegCheckErr(Buf, RoutineName)) return end if - ! F_BF if (allocated(OutData%F_BF)) deallocate(OutData%F_BF) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3460,7 +3143,6 @@ subroutine Morison_UnPackMemberLoads(Buf, OutData) call RegUnpack(Buf, OutData%F_BF) if (RegCheckErr(Buf, RoutineName)) return end if - ! F_If if (allocated(OutData%F_If)) deallocate(OutData%F_If) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3475,7 +3157,6 @@ subroutine Morison_UnPackMemberLoads(Buf, OutData) call RegUnpack(Buf, OutData%F_If) if (RegCheckErr(Buf, RoutineName)) return end if - ! F_WMG if (allocated(OutData%F_WMG)) deallocate(OutData%F_WMG) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3490,7 +3171,6 @@ subroutine Morison_UnPackMemberLoads(Buf, OutData) call RegUnpack(Buf, OutData%F_WMG) if (RegCheckErr(Buf, RoutineName)) return end if - ! F_IMG if (allocated(OutData%F_IMG)) deallocate(OutData%F_IMG) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3505,7 +3185,6 @@ subroutine Morison_UnPackMemberLoads(Buf, OutData) call RegUnpack(Buf, OutData%F_IMG) if (RegCheckErr(Buf, RoutineName)) return end if - ! FV if (allocated(OutData%FV)) deallocate(OutData%FV) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3520,7 +3199,6 @@ subroutine Morison_UnPackMemberLoads(Buf, OutData) call RegUnpack(Buf, OutData%FV) if (RegCheckErr(Buf, RoutineName)) return end if - ! FA if (allocated(OutData%FA)) deallocate(OutData%FA) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3535,7 +3213,6 @@ subroutine Morison_UnPackMemberLoads(Buf, OutData) call RegUnpack(Buf, OutData%FA) if (RegCheckErr(Buf, RoutineName)) return end if - ! F_DP if (allocated(OutData%F_DP)) deallocate(OutData%F_DP) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3551,161 +3228,120 @@ subroutine Morison_UnPackMemberLoads(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE Morison_CopyCoefMembers( SrcCoefMembersData, DstCoefMembersData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_CoefMembers), INTENT(IN) :: SrcCoefMembersData - TYPE(Morison_CoefMembers), INTENT(INOUT) :: DstCoefMembersData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_CopyCoefMembers' -! - ErrStat = ErrID_None - ErrMsg = "" - DstCoefMembersData%MemberID = SrcCoefMembersData%MemberID - DstCoefMembersData%MemberCd1 = SrcCoefMembersData%MemberCd1 - DstCoefMembersData%MemberCd2 = SrcCoefMembersData%MemberCd2 - DstCoefMembersData%MemberCdMG1 = SrcCoefMembersData%MemberCdMG1 - DstCoefMembersData%MemberCdMG2 = SrcCoefMembersData%MemberCdMG2 - DstCoefMembersData%MemberCa1 = SrcCoefMembersData%MemberCa1 - DstCoefMembersData%MemberCa2 = SrcCoefMembersData%MemberCa2 - DstCoefMembersData%MemberCaMG1 = SrcCoefMembersData%MemberCaMG1 - DstCoefMembersData%MemberCaMG2 = SrcCoefMembersData%MemberCaMG2 - DstCoefMembersData%MemberCp1 = SrcCoefMembersData%MemberCp1 - DstCoefMembersData%MemberCp2 = SrcCoefMembersData%MemberCp2 - DstCoefMembersData%MemberCpMG1 = SrcCoefMembersData%MemberCpMG1 - DstCoefMembersData%MemberCpMG2 = SrcCoefMembersData%MemberCpMG2 - DstCoefMembersData%MemberAxCd1 = SrcCoefMembersData%MemberAxCd1 - DstCoefMembersData%MemberAxCd2 = SrcCoefMembersData%MemberAxCd2 - DstCoefMembersData%MemberAxCdMG1 = SrcCoefMembersData%MemberAxCdMG1 - DstCoefMembersData%MemberAxCdMG2 = SrcCoefMembersData%MemberAxCdMG2 - DstCoefMembersData%MemberAxCa1 = SrcCoefMembersData%MemberAxCa1 - DstCoefMembersData%MemberAxCa2 = SrcCoefMembersData%MemberAxCa2 - DstCoefMembersData%MemberAxCaMG1 = SrcCoefMembersData%MemberAxCaMG1 - DstCoefMembersData%MemberAxCaMG2 = SrcCoefMembersData%MemberAxCaMG2 - DstCoefMembersData%MemberAxCp1 = SrcCoefMembersData%MemberAxCp1 - DstCoefMembersData%MemberAxCp2 = SrcCoefMembersData%MemberAxCp2 - DstCoefMembersData%MemberAxCpMG1 = SrcCoefMembersData%MemberAxCpMG1 - DstCoefMembersData%MemberAxCpMG2 = SrcCoefMembersData%MemberAxCpMG2 - DstCoefMembersData%MemberCb1 = SrcCoefMembersData%MemberCb1 - DstCoefMembersData%MemberCb2 = SrcCoefMembersData%MemberCb2 - DstCoefMembersData%MemberCbMG1 = SrcCoefMembersData%MemberCbMG1 - DstCoefMembersData%MemberCbMG2 = SrcCoefMembersData%MemberCbMG2 - DstCoefMembersData%MemberMCF = SrcCoefMembersData%MemberMCF - END SUBROUTINE Morison_CopyCoefMembers - - SUBROUTINE Morison_DestroyCoefMembers( CoefMembersData, ErrStat, ErrMsg ) - TYPE(Morison_CoefMembers), INTENT(INOUT) :: CoefMembersData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyCoefMembers' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Morison_DestroyCoefMembers +subroutine Morison_CopyCoefMembers(SrcCoefMembersData, DstCoefMembersData, CtrlCode, ErrStat, ErrMsg) + type(Morison_CoefMembers), intent(in) :: SrcCoefMembersData + type(Morison_CoefMembers), intent(inout) :: DstCoefMembersData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_CopyCoefMembers' + ErrStat = ErrID_None + ErrMsg = '' + DstCoefMembersData%MemberID = SrcCoefMembersData%MemberID + DstCoefMembersData%MemberCd1 = SrcCoefMembersData%MemberCd1 + DstCoefMembersData%MemberCd2 = SrcCoefMembersData%MemberCd2 + DstCoefMembersData%MemberCdMG1 = SrcCoefMembersData%MemberCdMG1 + DstCoefMembersData%MemberCdMG2 = SrcCoefMembersData%MemberCdMG2 + DstCoefMembersData%MemberCa1 = SrcCoefMembersData%MemberCa1 + DstCoefMembersData%MemberCa2 = SrcCoefMembersData%MemberCa2 + DstCoefMembersData%MemberCaMG1 = SrcCoefMembersData%MemberCaMG1 + DstCoefMembersData%MemberCaMG2 = SrcCoefMembersData%MemberCaMG2 + DstCoefMembersData%MemberCp1 = SrcCoefMembersData%MemberCp1 + DstCoefMembersData%MemberCp2 = SrcCoefMembersData%MemberCp2 + DstCoefMembersData%MemberCpMG1 = SrcCoefMembersData%MemberCpMG1 + DstCoefMembersData%MemberCpMG2 = SrcCoefMembersData%MemberCpMG2 + DstCoefMembersData%MemberAxCd1 = SrcCoefMembersData%MemberAxCd1 + DstCoefMembersData%MemberAxCd2 = SrcCoefMembersData%MemberAxCd2 + DstCoefMembersData%MemberAxCdMG1 = SrcCoefMembersData%MemberAxCdMG1 + DstCoefMembersData%MemberAxCdMG2 = SrcCoefMembersData%MemberAxCdMG2 + DstCoefMembersData%MemberAxCa1 = SrcCoefMembersData%MemberAxCa1 + DstCoefMembersData%MemberAxCa2 = SrcCoefMembersData%MemberAxCa2 + DstCoefMembersData%MemberAxCaMG1 = SrcCoefMembersData%MemberAxCaMG1 + DstCoefMembersData%MemberAxCaMG2 = SrcCoefMembersData%MemberAxCaMG2 + DstCoefMembersData%MemberAxCp1 = SrcCoefMembersData%MemberAxCp1 + DstCoefMembersData%MemberAxCp2 = SrcCoefMembersData%MemberAxCp2 + DstCoefMembersData%MemberAxCpMG1 = SrcCoefMembersData%MemberAxCpMG1 + DstCoefMembersData%MemberAxCpMG2 = SrcCoefMembersData%MemberAxCpMG2 + DstCoefMembersData%MemberCb1 = SrcCoefMembersData%MemberCb1 + DstCoefMembersData%MemberCb2 = SrcCoefMembersData%MemberCb2 + DstCoefMembersData%MemberCbMG1 = SrcCoefMembersData%MemberCbMG1 + DstCoefMembersData%MemberCbMG2 = SrcCoefMembersData%MemberCbMG2 + DstCoefMembersData%MemberMCF = SrcCoefMembersData%MemberMCF +end subroutine +subroutine Morison_DestroyCoefMembers(CoefMembersData, ErrStat, ErrMsg) + type(Morison_CoefMembers), intent(inout) :: CoefMembersData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyCoefMembers' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine Morison_PackCoefMembers(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Morison_CoefMembers), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackCoefMembers' if (Buf%ErrStat >= AbortErrLev) return - ! MemberID call RegPack(Buf, InData%MemberID) if (RegCheckErr(Buf, RoutineName)) return - ! MemberCd1 call RegPack(Buf, InData%MemberCd1) if (RegCheckErr(Buf, RoutineName)) return - ! MemberCd2 call RegPack(Buf, InData%MemberCd2) if (RegCheckErr(Buf, RoutineName)) return - ! MemberCdMG1 call RegPack(Buf, InData%MemberCdMG1) if (RegCheckErr(Buf, RoutineName)) return - ! MemberCdMG2 call RegPack(Buf, InData%MemberCdMG2) if (RegCheckErr(Buf, RoutineName)) return - ! MemberCa1 call RegPack(Buf, InData%MemberCa1) if (RegCheckErr(Buf, RoutineName)) return - ! MemberCa2 call RegPack(Buf, InData%MemberCa2) if (RegCheckErr(Buf, RoutineName)) return - ! MemberCaMG1 call RegPack(Buf, InData%MemberCaMG1) if (RegCheckErr(Buf, RoutineName)) return - ! MemberCaMG2 call RegPack(Buf, InData%MemberCaMG2) if (RegCheckErr(Buf, RoutineName)) return - ! MemberCp1 call RegPack(Buf, InData%MemberCp1) if (RegCheckErr(Buf, RoutineName)) return - ! MemberCp2 call RegPack(Buf, InData%MemberCp2) if (RegCheckErr(Buf, RoutineName)) return - ! MemberCpMG1 call RegPack(Buf, InData%MemberCpMG1) if (RegCheckErr(Buf, RoutineName)) return - ! MemberCpMG2 call RegPack(Buf, InData%MemberCpMG2) if (RegCheckErr(Buf, RoutineName)) return - ! MemberAxCd1 call RegPack(Buf, InData%MemberAxCd1) if (RegCheckErr(Buf, RoutineName)) return - ! MemberAxCd2 call RegPack(Buf, InData%MemberAxCd2) if (RegCheckErr(Buf, RoutineName)) return - ! MemberAxCdMG1 call RegPack(Buf, InData%MemberAxCdMG1) if (RegCheckErr(Buf, RoutineName)) return - ! MemberAxCdMG2 call RegPack(Buf, InData%MemberAxCdMG2) if (RegCheckErr(Buf, RoutineName)) return - ! MemberAxCa1 call RegPack(Buf, InData%MemberAxCa1) if (RegCheckErr(Buf, RoutineName)) return - ! MemberAxCa2 call RegPack(Buf, InData%MemberAxCa2) if (RegCheckErr(Buf, RoutineName)) return - ! MemberAxCaMG1 call RegPack(Buf, InData%MemberAxCaMG1) if (RegCheckErr(Buf, RoutineName)) return - ! MemberAxCaMG2 call RegPack(Buf, InData%MemberAxCaMG2) if (RegCheckErr(Buf, RoutineName)) return - ! MemberAxCp1 call RegPack(Buf, InData%MemberAxCp1) if (RegCheckErr(Buf, RoutineName)) return - ! MemberAxCp2 call RegPack(Buf, InData%MemberAxCp2) if (RegCheckErr(Buf, RoutineName)) return - ! MemberAxCpMG1 call RegPack(Buf, InData%MemberAxCpMG1) if (RegCheckErr(Buf, RoutineName)) return - ! MemberAxCpMG2 call RegPack(Buf, InData%MemberAxCpMG2) if (RegCheckErr(Buf, RoutineName)) return - ! MemberCb1 call RegPack(Buf, InData%MemberCb1) if (RegCheckErr(Buf, RoutineName)) return - ! MemberCb2 call RegPack(Buf, InData%MemberCb2) if (RegCheckErr(Buf, RoutineName)) return - ! MemberCbMG1 call RegPack(Buf, InData%MemberCbMG1) if (RegCheckErr(Buf, RoutineName)) return - ! MemberCbMG2 call RegPack(Buf, InData%MemberCbMG2) if (RegCheckErr(Buf, RoutineName)) return - ! MemberMCF call RegPack(Buf, InData%MemberMCF) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3715,144 +3351,100 @@ subroutine Morison_UnPackCoefMembers(Buf, OutData) type(Morison_CoefMembers), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackCoefMembers' if (Buf%ErrStat /= ErrID_None) return - ! MemberID call RegUnpack(Buf, OutData%MemberID) if (RegCheckErr(Buf, RoutineName)) return - ! MemberCd1 call RegUnpack(Buf, OutData%MemberCd1) if (RegCheckErr(Buf, RoutineName)) return - ! MemberCd2 call RegUnpack(Buf, OutData%MemberCd2) if (RegCheckErr(Buf, RoutineName)) return - ! MemberCdMG1 call RegUnpack(Buf, OutData%MemberCdMG1) if (RegCheckErr(Buf, RoutineName)) return - ! MemberCdMG2 call RegUnpack(Buf, OutData%MemberCdMG2) if (RegCheckErr(Buf, RoutineName)) return - ! MemberCa1 call RegUnpack(Buf, OutData%MemberCa1) if (RegCheckErr(Buf, RoutineName)) return - ! MemberCa2 call RegUnpack(Buf, OutData%MemberCa2) if (RegCheckErr(Buf, RoutineName)) return - ! MemberCaMG1 call RegUnpack(Buf, OutData%MemberCaMG1) if (RegCheckErr(Buf, RoutineName)) return - ! MemberCaMG2 call RegUnpack(Buf, OutData%MemberCaMG2) if (RegCheckErr(Buf, RoutineName)) return - ! MemberCp1 call RegUnpack(Buf, OutData%MemberCp1) if (RegCheckErr(Buf, RoutineName)) return - ! MemberCp2 call RegUnpack(Buf, OutData%MemberCp2) if (RegCheckErr(Buf, RoutineName)) return - ! MemberCpMG1 call RegUnpack(Buf, OutData%MemberCpMG1) if (RegCheckErr(Buf, RoutineName)) return - ! MemberCpMG2 call RegUnpack(Buf, OutData%MemberCpMG2) if (RegCheckErr(Buf, RoutineName)) return - ! MemberAxCd1 call RegUnpack(Buf, OutData%MemberAxCd1) if (RegCheckErr(Buf, RoutineName)) return - ! MemberAxCd2 call RegUnpack(Buf, OutData%MemberAxCd2) if (RegCheckErr(Buf, RoutineName)) return - ! MemberAxCdMG1 call RegUnpack(Buf, OutData%MemberAxCdMG1) if (RegCheckErr(Buf, RoutineName)) return - ! MemberAxCdMG2 call RegUnpack(Buf, OutData%MemberAxCdMG2) if (RegCheckErr(Buf, RoutineName)) return - ! MemberAxCa1 call RegUnpack(Buf, OutData%MemberAxCa1) if (RegCheckErr(Buf, RoutineName)) return - ! MemberAxCa2 call RegUnpack(Buf, OutData%MemberAxCa2) if (RegCheckErr(Buf, RoutineName)) return - ! MemberAxCaMG1 call RegUnpack(Buf, OutData%MemberAxCaMG1) if (RegCheckErr(Buf, RoutineName)) return - ! MemberAxCaMG2 call RegUnpack(Buf, OutData%MemberAxCaMG2) if (RegCheckErr(Buf, RoutineName)) return - ! MemberAxCp1 call RegUnpack(Buf, OutData%MemberAxCp1) if (RegCheckErr(Buf, RoutineName)) return - ! MemberAxCp2 call RegUnpack(Buf, OutData%MemberAxCp2) if (RegCheckErr(Buf, RoutineName)) return - ! MemberAxCpMG1 call RegUnpack(Buf, OutData%MemberAxCpMG1) if (RegCheckErr(Buf, RoutineName)) return - ! MemberAxCpMG2 call RegUnpack(Buf, OutData%MemberAxCpMG2) if (RegCheckErr(Buf, RoutineName)) return - ! MemberCb1 call RegUnpack(Buf, OutData%MemberCb1) if (RegCheckErr(Buf, RoutineName)) return - ! MemberCb2 call RegUnpack(Buf, OutData%MemberCb2) if (RegCheckErr(Buf, RoutineName)) return - ! MemberCbMG1 call RegUnpack(Buf, OutData%MemberCbMG1) if (RegCheckErr(Buf, RoutineName)) return - ! MemberCbMG2 call RegUnpack(Buf, OutData%MemberCbMG2) if (RegCheckErr(Buf, RoutineName)) return - ! MemberMCF call RegUnpack(Buf, OutData%MemberMCF) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Morison_CopyMGDepthsType( SrcMGDepthsTypeData, DstMGDepthsTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_MGDepthsType), INTENT(IN) :: SrcMGDepthsTypeData - TYPE(Morison_MGDepthsType), INTENT(INOUT) :: DstMGDepthsTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_CopyMGDepthsType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstMGDepthsTypeData%MGDpth = SrcMGDepthsTypeData%MGDpth - DstMGDepthsTypeData%MGThck = SrcMGDepthsTypeData%MGThck - DstMGDepthsTypeData%MGDens = SrcMGDepthsTypeData%MGDens - END SUBROUTINE Morison_CopyMGDepthsType - SUBROUTINE Morison_DestroyMGDepthsType( MGDepthsTypeData, ErrStat, ErrMsg ) - TYPE(Morison_MGDepthsType), INTENT(INOUT) :: MGDepthsTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyMGDepthsType' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Morison_DestroyMGDepthsType +subroutine Morison_CopyMGDepthsType(SrcMGDepthsTypeData, DstMGDepthsTypeData, CtrlCode, ErrStat, ErrMsg) + type(Morison_MGDepthsType), intent(in) :: SrcMGDepthsTypeData + type(Morison_MGDepthsType), intent(inout) :: DstMGDepthsTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_CopyMGDepthsType' + ErrStat = ErrID_None + ErrMsg = '' + DstMGDepthsTypeData%MGDpth = SrcMGDepthsTypeData%MGDpth + DstMGDepthsTypeData%MGThck = SrcMGDepthsTypeData%MGThck + DstMGDepthsTypeData%MGDens = SrcMGDepthsTypeData%MGDens +end subroutine +subroutine Morison_DestroyMGDepthsType(MGDepthsTypeData, ErrStat, ErrMsg) + type(Morison_MGDepthsType), intent(inout) :: MGDepthsTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyMGDepthsType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine Morison_PackMGDepthsType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Morison_MGDepthsType), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackMGDepthsType' if (Buf%ErrStat >= AbortErrLev) return - ! MGDpth call RegPack(Buf, InData%MGDpth) if (RegCheckErr(Buf, RoutineName)) return - ! MGThck call RegPack(Buf, InData%MGThck) if (RegCheckErr(Buf, RoutineName)) return - ! MGDens call RegPack(Buf, InData%MGDens) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3862,192 +3454,182 @@ subroutine Morison_UnPackMGDepthsType(Buf, OutData) type(Morison_MGDepthsType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackMGDepthsType' if (Buf%ErrStat /= ErrID_None) return - ! MGDpth call RegUnpack(Buf, OutData%MGDpth) if (RegCheckErr(Buf, RoutineName)) return - ! MGThck call RegUnpack(Buf, OutData%MGThck) if (RegCheckErr(Buf, RoutineName)) return - ! MGDens call RegUnpack(Buf, OutData%MGDens) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Morison_CopyMOutput( SrcMOutputData, DstMOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_MOutput), INTENT(IN) :: SrcMOutputData - TYPE(Morison_MOutput), INTENT(INOUT) :: DstMOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_CopyMOutput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstMOutputData%MemberID = SrcMOutputData%MemberID - DstMOutputData%NOutLoc = SrcMOutputData%NOutLoc -IF (ALLOCATED(SrcMOutputData%NodeLocs)) THEN - i1_l = LBOUND(SrcMOutputData%NodeLocs,1) - i1_u = UBOUND(SrcMOutputData%NodeLocs,1) - IF (.NOT. ALLOCATED(DstMOutputData%NodeLocs)) THEN - ALLOCATE(DstMOutputData%NodeLocs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMOutputData%NodeLocs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMOutputData%NodeLocs = SrcMOutputData%NodeLocs -ENDIF - DstMOutputData%MemberIDIndx = SrcMOutputData%MemberIDIndx -IF (ALLOCATED(SrcMOutputData%MeshIndx1)) THEN - i1_l = LBOUND(SrcMOutputData%MeshIndx1,1) - i1_u = UBOUND(SrcMOutputData%MeshIndx1,1) - IF (.NOT. ALLOCATED(DstMOutputData%MeshIndx1)) THEN - ALLOCATE(DstMOutputData%MeshIndx1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMOutputData%MeshIndx1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMOutputData%MeshIndx1 = SrcMOutputData%MeshIndx1 -ENDIF -IF (ALLOCATED(SrcMOutputData%MeshIndx2)) THEN - i1_l = LBOUND(SrcMOutputData%MeshIndx2,1) - i1_u = UBOUND(SrcMOutputData%MeshIndx2,1) - IF (.NOT. ALLOCATED(DstMOutputData%MeshIndx2)) THEN - ALLOCATE(DstMOutputData%MeshIndx2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMOutputData%MeshIndx2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMOutputData%MeshIndx2 = SrcMOutputData%MeshIndx2 -ENDIF -IF (ALLOCATED(SrcMOutputData%MemberIndx1)) THEN - i1_l = LBOUND(SrcMOutputData%MemberIndx1,1) - i1_u = UBOUND(SrcMOutputData%MemberIndx1,1) - IF (.NOT. ALLOCATED(DstMOutputData%MemberIndx1)) THEN - ALLOCATE(DstMOutputData%MemberIndx1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMOutputData%MemberIndx1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMOutputData%MemberIndx1 = SrcMOutputData%MemberIndx1 -ENDIF -IF (ALLOCATED(SrcMOutputData%MemberIndx2)) THEN - i1_l = LBOUND(SrcMOutputData%MemberIndx2,1) - i1_u = UBOUND(SrcMOutputData%MemberIndx2,1) - IF (.NOT. ALLOCATED(DstMOutputData%MemberIndx2)) THEN - ALLOCATE(DstMOutputData%MemberIndx2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMOutputData%MemberIndx2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMOutputData%MemberIndx2 = SrcMOutputData%MemberIndx2 -ENDIF -IF (ALLOCATED(SrcMOutputData%s)) THEN - i1_l = LBOUND(SrcMOutputData%s,1) - i1_u = UBOUND(SrcMOutputData%s,1) - IF (.NOT. ALLOCATED(DstMOutputData%s)) THEN - ALLOCATE(DstMOutputData%s(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMOutputData%s.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMOutputData%s = SrcMOutputData%s -ENDIF - END SUBROUTINE Morison_CopyMOutput - SUBROUTINE Morison_DestroyMOutput( MOutputData, ErrStat, ErrMsg ) - TYPE(Morison_MOutput), INTENT(INOUT) :: MOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyMOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MOutputData%NodeLocs)) THEN - DEALLOCATE(MOutputData%NodeLocs) -ENDIF -IF (ALLOCATED(MOutputData%MeshIndx1)) THEN - DEALLOCATE(MOutputData%MeshIndx1) -ENDIF -IF (ALLOCATED(MOutputData%MeshIndx2)) THEN - DEALLOCATE(MOutputData%MeshIndx2) -ENDIF -IF (ALLOCATED(MOutputData%MemberIndx1)) THEN - DEALLOCATE(MOutputData%MemberIndx1) -ENDIF -IF (ALLOCATED(MOutputData%MemberIndx2)) THEN - DEALLOCATE(MOutputData%MemberIndx2) -ENDIF -IF (ALLOCATED(MOutputData%s)) THEN - DEALLOCATE(MOutputData%s) -ENDIF - END SUBROUTINE Morison_DestroyMOutput +subroutine Morison_CopyMOutput(SrcMOutputData, DstMOutputData, CtrlCode, ErrStat, ErrMsg) + type(Morison_MOutput), intent(in) :: SrcMOutputData + type(Morison_MOutput), intent(inout) :: DstMOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Morison_CopyMOutput' + ErrStat = ErrID_None + ErrMsg = '' + DstMOutputData%MemberID = SrcMOutputData%MemberID + DstMOutputData%NOutLoc = SrcMOutputData%NOutLoc + if (allocated(SrcMOutputData%NodeLocs)) then + LB(1:1) = lbound(SrcMOutputData%NodeLocs) + UB(1:1) = ubound(SrcMOutputData%NodeLocs) + if (.not. allocated(DstMOutputData%NodeLocs)) then + allocate(DstMOutputData%NodeLocs(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMOutputData%NodeLocs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMOutputData%NodeLocs = SrcMOutputData%NodeLocs + else if (allocated(DstMOutputData%NodeLocs)) then + deallocate(DstMOutputData%NodeLocs) + end if + DstMOutputData%MemberIDIndx = SrcMOutputData%MemberIDIndx + if (allocated(SrcMOutputData%MeshIndx1)) then + LB(1:1) = lbound(SrcMOutputData%MeshIndx1) + UB(1:1) = ubound(SrcMOutputData%MeshIndx1) + if (.not. allocated(DstMOutputData%MeshIndx1)) then + allocate(DstMOutputData%MeshIndx1(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMOutputData%MeshIndx1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMOutputData%MeshIndx1 = SrcMOutputData%MeshIndx1 + else if (allocated(DstMOutputData%MeshIndx1)) then + deallocate(DstMOutputData%MeshIndx1) + end if + if (allocated(SrcMOutputData%MeshIndx2)) then + LB(1:1) = lbound(SrcMOutputData%MeshIndx2) + UB(1:1) = ubound(SrcMOutputData%MeshIndx2) + if (.not. allocated(DstMOutputData%MeshIndx2)) then + allocate(DstMOutputData%MeshIndx2(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMOutputData%MeshIndx2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMOutputData%MeshIndx2 = SrcMOutputData%MeshIndx2 + else if (allocated(DstMOutputData%MeshIndx2)) then + deallocate(DstMOutputData%MeshIndx2) + end if + if (allocated(SrcMOutputData%MemberIndx1)) then + LB(1:1) = lbound(SrcMOutputData%MemberIndx1) + UB(1:1) = ubound(SrcMOutputData%MemberIndx1) + if (.not. allocated(DstMOutputData%MemberIndx1)) then + allocate(DstMOutputData%MemberIndx1(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMOutputData%MemberIndx1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMOutputData%MemberIndx1 = SrcMOutputData%MemberIndx1 + else if (allocated(DstMOutputData%MemberIndx1)) then + deallocate(DstMOutputData%MemberIndx1) + end if + if (allocated(SrcMOutputData%MemberIndx2)) then + LB(1:1) = lbound(SrcMOutputData%MemberIndx2) + UB(1:1) = ubound(SrcMOutputData%MemberIndx2) + if (.not. allocated(DstMOutputData%MemberIndx2)) then + allocate(DstMOutputData%MemberIndx2(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMOutputData%MemberIndx2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMOutputData%MemberIndx2 = SrcMOutputData%MemberIndx2 + else if (allocated(DstMOutputData%MemberIndx2)) then + deallocate(DstMOutputData%MemberIndx2) + end if + if (allocated(SrcMOutputData%s)) then + LB(1:1) = lbound(SrcMOutputData%s) + UB(1:1) = ubound(SrcMOutputData%s) + if (.not. allocated(DstMOutputData%s)) then + allocate(DstMOutputData%s(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMOutputData%s.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMOutputData%s = SrcMOutputData%s + else if (allocated(DstMOutputData%s)) then + deallocate(DstMOutputData%s) + end if +end subroutine +subroutine Morison_DestroyMOutput(MOutputData, ErrStat, ErrMsg) + type(Morison_MOutput), intent(inout) :: MOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyMOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MOutputData%NodeLocs)) then + deallocate(MOutputData%NodeLocs) + end if + if (allocated(MOutputData%MeshIndx1)) then + deallocate(MOutputData%MeshIndx1) + end if + if (allocated(MOutputData%MeshIndx2)) then + deallocate(MOutputData%MeshIndx2) + end if + if (allocated(MOutputData%MemberIndx1)) then + deallocate(MOutputData%MemberIndx1) + end if + if (allocated(MOutputData%MemberIndx2)) then + deallocate(MOutputData%MemberIndx2) + end if + if (allocated(MOutputData%s)) then + deallocate(MOutputData%s) + end if +end subroutine subroutine Morison_PackMOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Morison_MOutput), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackMOutput' if (Buf%ErrStat >= AbortErrLev) return - ! MemberID call RegPack(Buf, InData%MemberID) if (RegCheckErr(Buf, RoutineName)) return - ! NOutLoc call RegPack(Buf, InData%NOutLoc) if (RegCheckErr(Buf, RoutineName)) return - ! NodeLocs call RegPack(Buf, allocated(InData%NodeLocs)) if (allocated(InData%NodeLocs)) then call RegPackBounds(Buf, 1, lbound(InData%NodeLocs), ubound(InData%NodeLocs)) call RegPack(Buf, InData%NodeLocs) end if if (RegCheckErr(Buf, RoutineName)) return - ! MemberIDIndx call RegPack(Buf, InData%MemberIDIndx) if (RegCheckErr(Buf, RoutineName)) return - ! MeshIndx1 call RegPack(Buf, allocated(InData%MeshIndx1)) if (allocated(InData%MeshIndx1)) then call RegPackBounds(Buf, 1, lbound(InData%MeshIndx1), ubound(InData%MeshIndx1)) call RegPack(Buf, InData%MeshIndx1) end if if (RegCheckErr(Buf, RoutineName)) return - ! MeshIndx2 call RegPack(Buf, allocated(InData%MeshIndx2)) if (allocated(InData%MeshIndx2)) then call RegPackBounds(Buf, 1, lbound(InData%MeshIndx2), ubound(InData%MeshIndx2)) call RegPack(Buf, InData%MeshIndx2) end if if (RegCheckErr(Buf, RoutineName)) return - ! MemberIndx1 call RegPack(Buf, allocated(InData%MemberIndx1)) if (allocated(InData%MemberIndx1)) then call RegPackBounds(Buf, 1, lbound(InData%MemberIndx1), ubound(InData%MemberIndx1)) call RegPack(Buf, InData%MemberIndx1) end if if (RegCheckErr(Buf, RoutineName)) return - ! MemberIndx2 call RegPack(Buf, allocated(InData%MemberIndx2)) if (allocated(InData%MemberIndx2)) then call RegPackBounds(Buf, 1, lbound(InData%MemberIndx2), ubound(InData%MemberIndx2)) call RegPack(Buf, InData%MemberIndx2) end if if (RegCheckErr(Buf, RoutineName)) return - ! s call RegPack(Buf, allocated(InData%s)) if (allocated(InData%s)) then call RegPackBounds(Buf, 1, lbound(InData%s), ubound(InData%s)) @@ -4064,13 +3646,10 @@ subroutine Morison_UnPackMOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! MemberID call RegUnpack(Buf, OutData%MemberID) if (RegCheckErr(Buf, RoutineName)) return - ! NOutLoc call RegUnpack(Buf, OutData%NOutLoc) if (RegCheckErr(Buf, RoutineName)) return - ! NodeLocs if (allocated(OutData%NodeLocs)) deallocate(OutData%NodeLocs) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4085,10 +3664,8 @@ subroutine Morison_UnPackMOutput(Buf, OutData) call RegUnpack(Buf, OutData%NodeLocs) if (RegCheckErr(Buf, RoutineName)) return end if - ! MemberIDIndx call RegUnpack(Buf, OutData%MemberIDIndx) if (RegCheckErr(Buf, RoutineName)) return - ! MeshIndx1 if (allocated(OutData%MeshIndx1)) deallocate(OutData%MeshIndx1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4103,7 +3680,6 @@ subroutine Morison_UnPackMOutput(Buf, OutData) call RegUnpack(Buf, OutData%MeshIndx1) if (RegCheckErr(Buf, RoutineName)) return end if - ! MeshIndx2 if (allocated(OutData%MeshIndx2)) deallocate(OutData%MeshIndx2) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4118,7 +3694,6 @@ subroutine Morison_UnPackMOutput(Buf, OutData) call RegUnpack(Buf, OutData%MeshIndx2) if (RegCheckErr(Buf, RoutineName)) return end if - ! MemberIndx1 if (allocated(OutData%MemberIndx1)) deallocate(OutData%MemberIndx1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4133,7 +3708,6 @@ subroutine Morison_UnPackMOutput(Buf, OutData) call RegUnpack(Buf, OutData%MemberIndx1) if (RegCheckErr(Buf, RoutineName)) return end if - ! MemberIndx2 if (allocated(OutData%MemberIndx2)) deallocate(OutData%MemberIndx2) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4148,7 +3722,6 @@ subroutine Morison_UnPackMOutput(Buf, OutData) call RegUnpack(Buf, OutData%MemberIndx2) if (RegCheckErr(Buf, RoutineName)) return end if - ! s if (allocated(OutData%s)) deallocate(OutData%s) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4164,49 +3737,36 @@ subroutine Morison_UnPackMOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE Morison_CopyJOutput( SrcJOutputData, DstJOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_JOutput), INTENT(IN) :: SrcJOutputData - TYPE(Morison_JOutput), INTENT(INOUT) :: DstJOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_CopyJOutput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstJOutputData%JointID = SrcJOutputData%JointID - DstJOutputData%JointIDIndx = SrcJOutputData%JointIDIndx - END SUBROUTINE Morison_CopyJOutput - SUBROUTINE Morison_DestroyJOutput( JOutputData, ErrStat, ErrMsg ) - TYPE(Morison_JOutput), INTENT(INOUT) :: JOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyJOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Morison_DestroyJOutput +subroutine Morison_CopyJOutput(SrcJOutputData, DstJOutputData, CtrlCode, ErrStat, ErrMsg) + type(Morison_JOutput), intent(in) :: SrcJOutputData + type(Morison_JOutput), intent(inout) :: DstJOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_CopyJOutput' + ErrStat = ErrID_None + ErrMsg = '' + DstJOutputData%JointID = SrcJOutputData%JointID + DstJOutputData%JointIDIndx = SrcJOutputData%JointIDIndx +end subroutine +subroutine Morison_DestroyJOutput(JOutputData, ErrStat, ErrMsg) + type(Morison_JOutput), intent(inout) :: JOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyJOutput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine Morison_PackJOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Morison_JOutput), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackJOutput' if (Buf%ErrStat >= AbortErrLev) return - ! JointID call RegPack(Buf, InData%JointID) if (RegCheckErr(Buf, RoutineName)) return - ! JointIDIndx call RegPack(Buf, InData%JointIDIndx) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -4216,354 +3776,394 @@ subroutine Morison_UnPackJOutput(Buf, OutData) type(Morison_JOutput), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackJOutput' if (Buf%ErrStat /= ErrID_None) return - ! JointID call RegUnpack(Buf, OutData%JointID) if (RegCheckErr(Buf, RoutineName)) return - ! JointIDIndx call RegUnpack(Buf, OutData%JointIDIndx) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Morison_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(Morison_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%Gravity = SrcInitInputData%Gravity - DstInitInputData%WtrDens = SrcInitInputData%WtrDens - DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth - DstInitInputData%MSL2SWL = SrcInitInputData%MSL2SWL - DstInitInputData%WaveDisp = SrcInitInputData%WaveDisp - DstInitInputData%AMMod = SrcInitInputData%AMMod - DstInitInputData%NJoints = SrcInitInputData%NJoints - DstInitInputData%NNodes = SrcInitInputData%NNodes -IF (ALLOCATED(SrcInitInputData%InpJoints)) THEN - i1_l = LBOUND(SrcInitInputData%InpJoints,1) - i1_u = UBOUND(SrcInitInputData%InpJoints,1) - IF (.NOT. ALLOCATED(DstInitInputData%InpJoints)) THEN - ALLOCATE(DstInitInputData%InpJoints(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%InpJoints.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitInputData%InpJoints,1), UBOUND(SrcInitInputData%InpJoints,1) - CALL Morison_Copyjointtype( SrcInitInputData%InpJoints(i1), DstInitInputData%InpJoints(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInitInputData%Nodes)) THEN - i1_l = LBOUND(SrcInitInputData%Nodes,1) - i1_u = UBOUND(SrcInitInputData%Nodes,1) - IF (.NOT. ALLOCATED(DstInitInputData%Nodes)) THEN - ALLOCATE(DstInitInputData%Nodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%Nodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitInputData%Nodes,1), UBOUND(SrcInitInputData%Nodes,1) - CALL Morison_Copynodetype( SrcInitInputData%Nodes(i1), DstInitInputData%Nodes(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstInitInputData%NAxCoefs = SrcInitInputData%NAxCoefs -IF (ALLOCATED(SrcInitInputData%AxialCoefs)) THEN - i1_l = LBOUND(SrcInitInputData%AxialCoefs,1) - i1_u = UBOUND(SrcInitInputData%AxialCoefs,1) - IF (.NOT. ALLOCATED(DstInitInputData%AxialCoefs)) THEN - ALLOCATE(DstInitInputData%AxialCoefs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%AxialCoefs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitInputData%AxialCoefs,1), UBOUND(SrcInitInputData%AxialCoefs,1) - CALL Morison_Copyaxialcoeftype( SrcInitInputData%AxialCoefs(i1), DstInitInputData%AxialCoefs(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstInitInputData%NPropSets = SrcInitInputData%NPropSets -IF (ALLOCATED(SrcInitInputData%MPropSets)) THEN - i1_l = LBOUND(SrcInitInputData%MPropSets,1) - i1_u = UBOUND(SrcInitInputData%MPropSets,1) - IF (.NOT. ALLOCATED(DstInitInputData%MPropSets)) THEN - ALLOCATE(DstInitInputData%MPropSets(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%MPropSets.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitInputData%MPropSets,1), UBOUND(SrcInitInputData%MPropSets,1) - CALL Morison_Copymemberproptype( SrcInitInputData%MPropSets(i1), DstInitInputData%MPropSets(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstInitInputData%SimplCd = SrcInitInputData%SimplCd - DstInitInputData%SimplCdMG = SrcInitInputData%SimplCdMG - DstInitInputData%SimplCa = SrcInitInputData%SimplCa - DstInitInputData%SimplCaMG = SrcInitInputData%SimplCaMG - DstInitInputData%SimplCp = SrcInitInputData%SimplCp - DstInitInputData%SimplCpMG = SrcInitInputData%SimplCpMG - DstInitInputData%SimplAxCd = SrcInitInputData%SimplAxCd - DstInitInputData%SimplAxCdMG = SrcInitInputData%SimplAxCdMG - DstInitInputData%SimplAxCa = SrcInitInputData%SimplAxCa - DstInitInputData%SimplAxCaMG = SrcInitInputData%SimplAxCaMG - DstInitInputData%SimplAxCp = SrcInitInputData%SimplAxCp - DstInitInputData%SimplAxCpMG = SrcInitInputData%SimplAxCpMG - DstInitInputData%SimplCb = SrcInitInputData%SimplCb - DstInitInputData%SimplCbMg = SrcInitInputData%SimplCbMg - DstInitInputData%SimplMCF = SrcInitInputData%SimplMCF - DstInitInputData%NCoefDpth = SrcInitInputData%NCoefDpth -IF (ALLOCATED(SrcInitInputData%CoefDpths)) THEN - i1_l = LBOUND(SrcInitInputData%CoefDpths,1) - i1_u = UBOUND(SrcInitInputData%CoefDpths,1) - IF (.NOT. ALLOCATED(DstInitInputData%CoefDpths)) THEN - ALLOCATE(DstInitInputData%CoefDpths(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%CoefDpths.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitInputData%CoefDpths,1), UBOUND(SrcInitInputData%CoefDpths,1) - CALL Morison_Copycoefdpths( SrcInitInputData%CoefDpths(i1), DstInitInputData%CoefDpths(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstInitInputData%NCoefMembers = SrcInitInputData%NCoefMembers -IF (ALLOCATED(SrcInitInputData%CoefMembers)) THEN - i1_l = LBOUND(SrcInitInputData%CoefMembers,1) - i1_u = UBOUND(SrcInitInputData%CoefMembers,1) - IF (.NOT. ALLOCATED(DstInitInputData%CoefMembers)) THEN - ALLOCATE(DstInitInputData%CoefMembers(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%CoefMembers.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitInputData%CoefMembers,1), UBOUND(SrcInitInputData%CoefMembers,1) - CALL Morison_Copycoefmembers( SrcInitInputData%CoefMembers(i1), DstInitInputData%CoefMembers(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstInitInputData%NMembers = SrcInitInputData%NMembers -IF (ALLOCATED(SrcInitInputData%InpMembers)) THEN - i1_l = LBOUND(SrcInitInputData%InpMembers,1) - i1_u = UBOUND(SrcInitInputData%InpMembers,1) - IF (.NOT. ALLOCATED(DstInitInputData%InpMembers)) THEN - ALLOCATE(DstInitInputData%InpMembers(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%InpMembers.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitInputData%InpMembers,1), UBOUND(SrcInitInputData%InpMembers,1) - CALL Morison_Copymemberinputtype( SrcInitInputData%InpMembers(i1), DstInitInputData%InpMembers(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstInitInputData%NFillGroups = SrcInitInputData%NFillGroups -IF (ALLOCATED(SrcInitInputData%FilledGroups)) THEN - i1_l = LBOUND(SrcInitInputData%FilledGroups,1) - i1_u = UBOUND(SrcInitInputData%FilledGroups,1) - IF (.NOT. ALLOCATED(DstInitInputData%FilledGroups)) THEN - ALLOCATE(DstInitInputData%FilledGroups(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%FilledGroups.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitInputData%FilledGroups,1), UBOUND(SrcInitInputData%FilledGroups,1) - CALL Morison_Copyfilledgrouptype( SrcInitInputData%FilledGroups(i1), DstInitInputData%FilledGroups(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstInitInputData%NMGDepths = SrcInitInputData%NMGDepths -IF (ALLOCATED(SrcInitInputData%MGDepths)) THEN - i1_l = LBOUND(SrcInitInputData%MGDepths,1) - i1_u = UBOUND(SrcInitInputData%MGDepths,1) - IF (.NOT. ALLOCATED(DstInitInputData%MGDepths)) THEN - ALLOCATE(DstInitInputData%MGDepths(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%MGDepths.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitInputData%MGDepths,1), UBOUND(SrcInitInputData%MGDepths,1) - CALL Morison_Copymgdepthstype( SrcInitInputData%MGDepths(i1), DstInitInputData%MGDepths(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstInitInputData%MGTop = SrcInitInputData%MGTop - DstInitInputData%MGBottom = SrcInitInputData%MGBottom - DstInitInputData%NMOutputs = SrcInitInputData%NMOutputs -IF (ALLOCATED(SrcInitInputData%MOutLst)) THEN - i1_l = LBOUND(SrcInitInputData%MOutLst,1) - i1_u = UBOUND(SrcInitInputData%MOutLst,1) - IF (.NOT. ALLOCATED(DstInitInputData%MOutLst)) THEN - ALLOCATE(DstInitInputData%MOutLst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%MOutLst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitInputData%MOutLst,1), UBOUND(SrcInitInputData%MOutLst,1) - CALL Morison_Copymoutput( SrcInitInputData%MOutLst(i1), DstInitInputData%MOutLst(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstInitInputData%NJOutputs = SrcInitInputData%NJOutputs -IF (ALLOCATED(SrcInitInputData%JOutLst)) THEN - i1_l = LBOUND(SrcInitInputData%JOutLst,1) - i1_u = UBOUND(SrcInitInputData%JOutLst,1) - IF (.NOT. ALLOCATED(DstInitInputData%JOutLst)) THEN - ALLOCATE(DstInitInputData%JOutLst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%JOutLst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitInputData%JOutLst,1), UBOUND(SrcInitInputData%JOutLst,1) - CALL Morison_Copyjoutput( SrcInitInputData%JOutLst(i1), DstInitInputData%JOutLst(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInitInputData%OutList)) THEN - i1_l = LBOUND(SrcInitInputData%OutList,1) - i1_u = UBOUND(SrcInitInputData%OutList,1) - IF (.NOT. ALLOCATED(DstInitInputData%OutList)) THEN - ALLOCATE(DstInitInputData%OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%OutList = SrcInitInputData%OutList -ENDIF - DstInitInputData%NumOuts = SrcInitInputData%NumOuts - DstInitInputData%UnSum = SrcInitInputData%UnSum - DstInitInputData%NStepWave = SrcInitInputData%NStepWave - DstInitInputData%WaveStMod = SrcInitInputData%WaveStMod - DstInitInputData%MCFD = SrcInitInputData%MCFD - DstInitInputData%WaveField => SrcInitInputData%WaveField - END SUBROUTINE Morison_CopyInitInput - - SUBROUTINE Morison_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(Morison_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitInputData%InpJoints)) THEN -DO i1 = LBOUND(InitInputData%InpJoints,1), UBOUND(InitInputData%InpJoints,1) - CALL Morison_DestroyJointType( InitInputData%InpJoints(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InitInputData%InpJoints) -ENDIF -IF (ALLOCATED(InitInputData%Nodes)) THEN -DO i1 = LBOUND(InitInputData%Nodes,1), UBOUND(InitInputData%Nodes,1) - CALL Morison_DestroyNodeType( InitInputData%Nodes(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InitInputData%Nodes) -ENDIF -IF (ALLOCATED(InitInputData%AxialCoefs)) THEN -DO i1 = LBOUND(InitInputData%AxialCoefs,1), UBOUND(InitInputData%AxialCoefs,1) - CALL Morison_DestroyAxialCoefType( InitInputData%AxialCoefs(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InitInputData%AxialCoefs) -ENDIF -IF (ALLOCATED(InitInputData%MPropSets)) THEN -DO i1 = LBOUND(InitInputData%MPropSets,1), UBOUND(InitInputData%MPropSets,1) - CALL Morison_DestroyMemberPropType( InitInputData%MPropSets(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InitInputData%MPropSets) -ENDIF -IF (ALLOCATED(InitInputData%CoefDpths)) THEN -DO i1 = LBOUND(InitInputData%CoefDpths,1), UBOUND(InitInputData%CoefDpths,1) - CALL Morison_DestroyCoefDpths( InitInputData%CoefDpths(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InitInputData%CoefDpths) -ENDIF -IF (ALLOCATED(InitInputData%CoefMembers)) THEN -DO i1 = LBOUND(InitInputData%CoefMembers,1), UBOUND(InitInputData%CoefMembers,1) - CALL Morison_DestroyCoefMembers( InitInputData%CoefMembers(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InitInputData%CoefMembers) -ENDIF -IF (ALLOCATED(InitInputData%InpMembers)) THEN -DO i1 = LBOUND(InitInputData%InpMembers,1), UBOUND(InitInputData%InpMembers,1) - CALL Morison_DestroyMemberInputType( InitInputData%InpMembers(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InitInputData%InpMembers) -ENDIF -IF (ALLOCATED(InitInputData%FilledGroups)) THEN -DO i1 = LBOUND(InitInputData%FilledGroups,1), UBOUND(InitInputData%FilledGroups,1) - CALL Morison_DestroyFilledGroupType( InitInputData%FilledGroups(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InitInputData%FilledGroups) -ENDIF -IF (ALLOCATED(InitInputData%MGDepths)) THEN -DO i1 = LBOUND(InitInputData%MGDepths,1), UBOUND(InitInputData%MGDepths,1) - CALL Morison_DestroyMGDepthsType( InitInputData%MGDepths(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InitInputData%MGDepths) -ENDIF -IF (ALLOCATED(InitInputData%MOutLst)) THEN -DO i1 = LBOUND(InitInputData%MOutLst,1), UBOUND(InitInputData%MOutLst,1) - CALL Morison_DestroyMOutput( InitInputData%MOutLst(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InitInputData%MOutLst) -ENDIF -IF (ALLOCATED(InitInputData%JOutLst)) THEN -DO i1 = LBOUND(InitInputData%JOutLst,1), UBOUND(InitInputData%JOutLst,1) - CALL Morison_DestroyJOutput( InitInputData%JOutLst(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InitInputData%JOutLst) -ENDIF -IF (ALLOCATED(InitInputData%OutList)) THEN - DEALLOCATE(InitInputData%OutList) -ENDIF -NULLIFY(InitInputData%WaveField) - END SUBROUTINE Morison_DestroyInitInput - + +subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(Morison_InitInputType), intent(in) :: SrcInitInputData + type(Morison_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Morison_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitInputData%Gravity = SrcInitInputData%Gravity + DstInitInputData%WtrDens = SrcInitInputData%WtrDens + DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth + DstInitInputData%MSL2SWL = SrcInitInputData%MSL2SWL + DstInitInputData%WaveDisp = SrcInitInputData%WaveDisp + DstInitInputData%AMMod = SrcInitInputData%AMMod + DstInitInputData%NJoints = SrcInitInputData%NJoints + DstInitInputData%NNodes = SrcInitInputData%NNodes + if (allocated(SrcInitInputData%InpJoints)) then + LB(1:1) = lbound(SrcInitInputData%InpJoints) + UB(1:1) = ubound(SrcInitInputData%InpJoints) + if (.not. allocated(DstInitInputData%InpJoints)) then + allocate(DstInitInputData%InpJoints(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%InpJoints.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Morison_CopyJointType(SrcInitInputData%InpJoints(i1), DstInitInputData%InpJoints(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstInitInputData%InpJoints)) then + deallocate(DstInitInputData%InpJoints) + end if + if (allocated(SrcInitInputData%Nodes)) then + LB(1:1) = lbound(SrcInitInputData%Nodes) + UB(1:1) = ubound(SrcInitInputData%Nodes) + if (.not. allocated(DstInitInputData%Nodes)) then + allocate(DstInitInputData%Nodes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%Nodes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Morison_CopyNodeType(SrcInitInputData%Nodes(i1), DstInitInputData%Nodes(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstInitInputData%Nodes)) then + deallocate(DstInitInputData%Nodes) + end if + DstInitInputData%NAxCoefs = SrcInitInputData%NAxCoefs + if (allocated(SrcInitInputData%AxialCoefs)) then + LB(1:1) = lbound(SrcInitInputData%AxialCoefs) + UB(1:1) = ubound(SrcInitInputData%AxialCoefs) + if (.not. allocated(DstInitInputData%AxialCoefs)) then + allocate(DstInitInputData%AxialCoefs(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%AxialCoefs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Morison_CopyAxialCoefType(SrcInitInputData%AxialCoefs(i1), DstInitInputData%AxialCoefs(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstInitInputData%AxialCoefs)) then + deallocate(DstInitInputData%AxialCoefs) + end if + DstInitInputData%NPropSets = SrcInitInputData%NPropSets + if (allocated(SrcInitInputData%MPropSets)) then + LB(1:1) = lbound(SrcInitInputData%MPropSets) + UB(1:1) = ubound(SrcInitInputData%MPropSets) + if (.not. allocated(DstInitInputData%MPropSets)) then + allocate(DstInitInputData%MPropSets(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%MPropSets.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Morison_CopyMemberPropType(SrcInitInputData%MPropSets(i1), DstInitInputData%MPropSets(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstInitInputData%MPropSets)) then + deallocate(DstInitInputData%MPropSets) + end if + DstInitInputData%SimplCd = SrcInitInputData%SimplCd + DstInitInputData%SimplCdMG = SrcInitInputData%SimplCdMG + DstInitInputData%SimplCa = SrcInitInputData%SimplCa + DstInitInputData%SimplCaMG = SrcInitInputData%SimplCaMG + DstInitInputData%SimplCp = SrcInitInputData%SimplCp + DstInitInputData%SimplCpMG = SrcInitInputData%SimplCpMG + DstInitInputData%SimplAxCd = SrcInitInputData%SimplAxCd + DstInitInputData%SimplAxCdMG = SrcInitInputData%SimplAxCdMG + DstInitInputData%SimplAxCa = SrcInitInputData%SimplAxCa + DstInitInputData%SimplAxCaMG = SrcInitInputData%SimplAxCaMG + DstInitInputData%SimplAxCp = SrcInitInputData%SimplAxCp + DstInitInputData%SimplAxCpMG = SrcInitInputData%SimplAxCpMG + DstInitInputData%SimplCb = SrcInitInputData%SimplCb + DstInitInputData%SimplCbMg = SrcInitInputData%SimplCbMg + DstInitInputData%SimplMCF = SrcInitInputData%SimplMCF + DstInitInputData%NCoefDpth = SrcInitInputData%NCoefDpth + if (allocated(SrcInitInputData%CoefDpths)) then + LB(1:1) = lbound(SrcInitInputData%CoefDpths) + UB(1:1) = ubound(SrcInitInputData%CoefDpths) + if (.not. allocated(DstInitInputData%CoefDpths)) then + allocate(DstInitInputData%CoefDpths(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%CoefDpths.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Morison_CopyCoefDpths(SrcInitInputData%CoefDpths(i1), DstInitInputData%CoefDpths(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstInitInputData%CoefDpths)) then + deallocate(DstInitInputData%CoefDpths) + end if + DstInitInputData%NCoefMembers = SrcInitInputData%NCoefMembers + if (allocated(SrcInitInputData%CoefMembers)) then + LB(1:1) = lbound(SrcInitInputData%CoefMembers) + UB(1:1) = ubound(SrcInitInputData%CoefMembers) + if (.not. allocated(DstInitInputData%CoefMembers)) then + allocate(DstInitInputData%CoefMembers(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%CoefMembers.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Morison_CopyCoefMembers(SrcInitInputData%CoefMembers(i1), DstInitInputData%CoefMembers(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstInitInputData%CoefMembers)) then + deallocate(DstInitInputData%CoefMembers) + end if + DstInitInputData%NMembers = SrcInitInputData%NMembers + if (allocated(SrcInitInputData%InpMembers)) then + LB(1:1) = lbound(SrcInitInputData%InpMembers) + UB(1:1) = ubound(SrcInitInputData%InpMembers) + if (.not. allocated(DstInitInputData%InpMembers)) then + allocate(DstInitInputData%InpMembers(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%InpMembers.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Morison_CopyMemberInputType(SrcInitInputData%InpMembers(i1), DstInitInputData%InpMembers(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstInitInputData%InpMembers)) then + deallocate(DstInitInputData%InpMembers) + end if + DstInitInputData%NFillGroups = SrcInitInputData%NFillGroups + if (allocated(SrcInitInputData%FilledGroups)) then + LB(1:1) = lbound(SrcInitInputData%FilledGroups) + UB(1:1) = ubound(SrcInitInputData%FilledGroups) + if (.not. allocated(DstInitInputData%FilledGroups)) then + allocate(DstInitInputData%FilledGroups(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%FilledGroups.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Morison_CopyFilledGroupType(SrcInitInputData%FilledGroups(i1), DstInitInputData%FilledGroups(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstInitInputData%FilledGroups)) then + deallocate(DstInitInputData%FilledGroups) + end if + DstInitInputData%NMGDepths = SrcInitInputData%NMGDepths + if (allocated(SrcInitInputData%MGDepths)) then + LB(1:1) = lbound(SrcInitInputData%MGDepths) + UB(1:1) = ubound(SrcInitInputData%MGDepths) + if (.not. allocated(DstInitInputData%MGDepths)) then + allocate(DstInitInputData%MGDepths(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%MGDepths.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Morison_CopyMGDepthsType(SrcInitInputData%MGDepths(i1), DstInitInputData%MGDepths(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstInitInputData%MGDepths)) then + deallocate(DstInitInputData%MGDepths) + end if + DstInitInputData%MGTop = SrcInitInputData%MGTop + DstInitInputData%MGBottom = SrcInitInputData%MGBottom + DstInitInputData%NMOutputs = SrcInitInputData%NMOutputs + if (allocated(SrcInitInputData%MOutLst)) then + LB(1:1) = lbound(SrcInitInputData%MOutLst) + UB(1:1) = ubound(SrcInitInputData%MOutLst) + if (.not. allocated(DstInitInputData%MOutLst)) then + allocate(DstInitInputData%MOutLst(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%MOutLst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Morison_CopyMOutput(SrcInitInputData%MOutLst(i1), DstInitInputData%MOutLst(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstInitInputData%MOutLst)) then + deallocate(DstInitInputData%MOutLst) + end if + DstInitInputData%NJOutputs = SrcInitInputData%NJOutputs + if (allocated(SrcInitInputData%JOutLst)) then + LB(1:1) = lbound(SrcInitInputData%JOutLst) + UB(1:1) = ubound(SrcInitInputData%JOutLst) + if (.not. allocated(DstInitInputData%JOutLst)) then + allocate(DstInitInputData%JOutLst(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%JOutLst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Morison_CopyJOutput(SrcInitInputData%JOutLst(i1), DstInitInputData%JOutLst(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstInitInputData%JOutLst)) then + deallocate(DstInitInputData%JOutLst) + end if + if (allocated(SrcInitInputData%OutList)) then + LB(1:1) = lbound(SrcInitInputData%OutList) + UB(1:1) = ubound(SrcInitInputData%OutList) + if (.not. allocated(DstInitInputData%OutList)) then + allocate(DstInitInputData%OutList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%OutList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%OutList = SrcInitInputData%OutList + else if (allocated(DstInitInputData%OutList)) then + deallocate(DstInitInputData%OutList) + end if + DstInitInputData%NumOuts = SrcInitInputData%NumOuts + DstInitInputData%UnSum = SrcInitInputData%UnSum + DstInitInputData%NStepWave = SrcInitInputData%NStepWave + DstInitInputData%WaveStMod = SrcInitInputData%WaveStMod + DstInitInputData%MCFD = SrcInitInputData%MCFD + DstInitInputData%WaveField => SrcInitInputData%WaveField +end subroutine + +subroutine Morison_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(Morison_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Morison_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitInputData%InpJoints)) then + LB(1:1) = lbound(InitInputData%InpJoints) + UB(1:1) = ubound(InitInputData%InpJoints) + do i1 = LB(1), UB(1) + call Morison_DestroyJointType(InitInputData%InpJoints(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitInputData%InpJoints) + end if + if (allocated(InitInputData%Nodes)) then + LB(1:1) = lbound(InitInputData%Nodes) + UB(1:1) = ubound(InitInputData%Nodes) + do i1 = LB(1), UB(1) + call Morison_DestroyNodeType(InitInputData%Nodes(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitInputData%Nodes) + end if + if (allocated(InitInputData%AxialCoefs)) then + LB(1:1) = lbound(InitInputData%AxialCoefs) + UB(1:1) = ubound(InitInputData%AxialCoefs) + do i1 = LB(1), UB(1) + call Morison_DestroyAxialCoefType(InitInputData%AxialCoefs(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitInputData%AxialCoefs) + end if + if (allocated(InitInputData%MPropSets)) then + LB(1:1) = lbound(InitInputData%MPropSets) + UB(1:1) = ubound(InitInputData%MPropSets) + do i1 = LB(1), UB(1) + call Morison_DestroyMemberPropType(InitInputData%MPropSets(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitInputData%MPropSets) + end if + if (allocated(InitInputData%CoefDpths)) then + LB(1:1) = lbound(InitInputData%CoefDpths) + UB(1:1) = ubound(InitInputData%CoefDpths) + do i1 = LB(1), UB(1) + call Morison_DestroyCoefDpths(InitInputData%CoefDpths(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitInputData%CoefDpths) + end if + if (allocated(InitInputData%CoefMembers)) then + LB(1:1) = lbound(InitInputData%CoefMembers) + UB(1:1) = ubound(InitInputData%CoefMembers) + do i1 = LB(1), UB(1) + call Morison_DestroyCoefMembers(InitInputData%CoefMembers(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitInputData%CoefMembers) + end if + if (allocated(InitInputData%InpMembers)) then + LB(1:1) = lbound(InitInputData%InpMembers) + UB(1:1) = ubound(InitInputData%InpMembers) + do i1 = LB(1), UB(1) + call Morison_DestroyMemberInputType(InitInputData%InpMembers(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitInputData%InpMembers) + end if + if (allocated(InitInputData%FilledGroups)) then + LB(1:1) = lbound(InitInputData%FilledGroups) + UB(1:1) = ubound(InitInputData%FilledGroups) + do i1 = LB(1), UB(1) + call Morison_DestroyFilledGroupType(InitInputData%FilledGroups(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitInputData%FilledGroups) + end if + if (allocated(InitInputData%MGDepths)) then + LB(1:1) = lbound(InitInputData%MGDepths) + UB(1:1) = ubound(InitInputData%MGDepths) + do i1 = LB(1), UB(1) + call Morison_DestroyMGDepthsType(InitInputData%MGDepths(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitInputData%MGDepths) + end if + if (allocated(InitInputData%MOutLst)) then + LB(1:1) = lbound(InitInputData%MOutLst) + UB(1:1) = ubound(InitInputData%MOutLst) + do i1 = LB(1), UB(1) + call Morison_DestroyMOutput(InitInputData%MOutLst(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitInputData%MOutLst) + end if + if (allocated(InitInputData%JOutLst)) then + LB(1:1) = lbound(InitInputData%JOutLst) + UB(1:1) = ubound(InitInputData%JOutLst) + do i1 = LB(1), UB(1) + call Morison_DestroyJOutput(InitInputData%JOutLst(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitInputData%JOutLst) + end if + if (allocated(InitInputData%OutList)) then + deallocate(InitInputData%OutList) + end if + nullify(InitInputData%WaveField) +end subroutine subroutine Morison_PackInitInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -4573,31 +4173,22 @@ subroutine Morison_PackInitInput(Buf, Indata) integer(IntKi) :: LB(1), UB(1) logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return - ! Gravity call RegPack(Buf, InData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDens call RegPack(Buf, InData%WtrDens) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDpth call RegPack(Buf, InData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - ! MSL2SWL call RegPack(Buf, InData%MSL2SWL) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDisp call RegPack(Buf, InData%WaveDisp) if (RegCheckErr(Buf, RoutineName)) return - ! AMMod call RegPack(Buf, InData%AMMod) if (RegCheckErr(Buf, RoutineName)) return - ! NJoints call RegPack(Buf, InData%NJoints) if (RegCheckErr(Buf, RoutineName)) return - ! NNodes call RegPack(Buf, InData%NNodes) if (RegCheckErr(Buf, RoutineName)) return - ! InpJoints call RegPack(Buf, allocated(InData%InpJoints)) if (allocated(InData%InpJoints)) then call RegPackBounds(Buf, 1, lbound(InData%InpJoints), ubound(InData%InpJoints)) @@ -4608,7 +4199,6 @@ subroutine Morison_PackInitInput(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! Nodes call RegPack(Buf, allocated(InData%Nodes)) if (allocated(InData%Nodes)) then call RegPackBounds(Buf, 1, lbound(InData%Nodes), ubound(InData%Nodes)) @@ -4619,10 +4209,8 @@ subroutine Morison_PackInitInput(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! NAxCoefs call RegPack(Buf, InData%NAxCoefs) if (RegCheckErr(Buf, RoutineName)) return - ! AxialCoefs call RegPack(Buf, allocated(InData%AxialCoefs)) if (allocated(InData%AxialCoefs)) then call RegPackBounds(Buf, 1, lbound(InData%AxialCoefs), ubound(InData%AxialCoefs)) @@ -4633,10 +4221,8 @@ subroutine Morison_PackInitInput(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! NPropSets call RegPack(Buf, InData%NPropSets) if (RegCheckErr(Buf, RoutineName)) return - ! MPropSets call RegPack(Buf, allocated(InData%MPropSets)) if (allocated(InData%MPropSets)) then call RegPackBounds(Buf, 1, lbound(InData%MPropSets), ubound(InData%MPropSets)) @@ -4647,55 +4233,38 @@ subroutine Morison_PackInitInput(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! SimplCd call RegPack(Buf, InData%SimplCd) if (RegCheckErr(Buf, RoutineName)) return - ! SimplCdMG call RegPack(Buf, InData%SimplCdMG) if (RegCheckErr(Buf, RoutineName)) return - ! SimplCa call RegPack(Buf, InData%SimplCa) if (RegCheckErr(Buf, RoutineName)) return - ! SimplCaMG call RegPack(Buf, InData%SimplCaMG) if (RegCheckErr(Buf, RoutineName)) return - ! SimplCp call RegPack(Buf, InData%SimplCp) if (RegCheckErr(Buf, RoutineName)) return - ! SimplCpMG call RegPack(Buf, InData%SimplCpMG) if (RegCheckErr(Buf, RoutineName)) return - ! SimplAxCd call RegPack(Buf, InData%SimplAxCd) if (RegCheckErr(Buf, RoutineName)) return - ! SimplAxCdMG call RegPack(Buf, InData%SimplAxCdMG) if (RegCheckErr(Buf, RoutineName)) return - ! SimplAxCa call RegPack(Buf, InData%SimplAxCa) if (RegCheckErr(Buf, RoutineName)) return - ! SimplAxCaMG call RegPack(Buf, InData%SimplAxCaMG) if (RegCheckErr(Buf, RoutineName)) return - ! SimplAxCp call RegPack(Buf, InData%SimplAxCp) if (RegCheckErr(Buf, RoutineName)) return - ! SimplAxCpMG call RegPack(Buf, InData%SimplAxCpMG) if (RegCheckErr(Buf, RoutineName)) return - ! SimplCb call RegPack(Buf, InData%SimplCb) if (RegCheckErr(Buf, RoutineName)) return - ! SimplCbMg call RegPack(Buf, InData%SimplCbMg) if (RegCheckErr(Buf, RoutineName)) return - ! SimplMCF call RegPack(Buf, InData%SimplMCF) if (RegCheckErr(Buf, RoutineName)) return - ! NCoefDpth call RegPack(Buf, InData%NCoefDpth) if (RegCheckErr(Buf, RoutineName)) return - ! CoefDpths call RegPack(Buf, allocated(InData%CoefDpths)) if (allocated(InData%CoefDpths)) then call RegPackBounds(Buf, 1, lbound(InData%CoefDpths), ubound(InData%CoefDpths)) @@ -4706,10 +4275,8 @@ subroutine Morison_PackInitInput(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! NCoefMembers call RegPack(Buf, InData%NCoefMembers) if (RegCheckErr(Buf, RoutineName)) return - ! CoefMembers call RegPack(Buf, allocated(InData%CoefMembers)) if (allocated(InData%CoefMembers)) then call RegPackBounds(Buf, 1, lbound(InData%CoefMembers), ubound(InData%CoefMembers)) @@ -4720,10 +4287,8 @@ subroutine Morison_PackInitInput(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! NMembers call RegPack(Buf, InData%NMembers) if (RegCheckErr(Buf, RoutineName)) return - ! InpMembers call RegPack(Buf, allocated(InData%InpMembers)) if (allocated(InData%InpMembers)) then call RegPackBounds(Buf, 1, lbound(InData%InpMembers), ubound(InData%InpMembers)) @@ -4734,10 +4299,8 @@ subroutine Morison_PackInitInput(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! NFillGroups call RegPack(Buf, InData%NFillGroups) if (RegCheckErr(Buf, RoutineName)) return - ! FilledGroups call RegPack(Buf, allocated(InData%FilledGroups)) if (allocated(InData%FilledGroups)) then call RegPackBounds(Buf, 1, lbound(InData%FilledGroups), ubound(InData%FilledGroups)) @@ -4748,10 +4311,8 @@ subroutine Morison_PackInitInput(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! NMGDepths call RegPack(Buf, InData%NMGDepths) if (RegCheckErr(Buf, RoutineName)) return - ! MGDepths call RegPack(Buf, allocated(InData%MGDepths)) if (allocated(InData%MGDepths)) then call RegPackBounds(Buf, 1, lbound(InData%MGDepths), ubound(InData%MGDepths)) @@ -4762,16 +4323,12 @@ subroutine Morison_PackInitInput(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! MGTop call RegPack(Buf, InData%MGTop) if (RegCheckErr(Buf, RoutineName)) return - ! MGBottom call RegPack(Buf, InData%MGBottom) if (RegCheckErr(Buf, RoutineName)) return - ! NMOutputs call RegPack(Buf, InData%NMOutputs) if (RegCheckErr(Buf, RoutineName)) return - ! MOutLst call RegPack(Buf, allocated(InData%MOutLst)) if (allocated(InData%MOutLst)) then call RegPackBounds(Buf, 1, lbound(InData%MOutLst), ubound(InData%MOutLst)) @@ -4782,10 +4339,8 @@ subroutine Morison_PackInitInput(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! NJOutputs call RegPack(Buf, InData%NJOutputs) if (RegCheckErr(Buf, RoutineName)) return - ! JOutLst call RegPack(Buf, allocated(InData%JOutLst)) if (allocated(InData%JOutLst)) then call RegPackBounds(Buf, 1, lbound(InData%JOutLst), ubound(InData%JOutLst)) @@ -4796,29 +4351,22 @@ subroutine Morison_PackInitInput(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! OutList call RegPack(Buf, allocated(InData%OutList)) if (allocated(InData%OutList)) then call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) call RegPack(Buf, InData%OutList) end if if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegPack(Buf, InData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! UnSum call RegPack(Buf, InData%UnSum) if (RegCheckErr(Buf, RoutineName)) return - ! NStepWave call RegPack(Buf, InData%NStepWave) if (RegCheckErr(Buf, RoutineName)) return - ! WaveStMod call RegPack(Buf, InData%WaveStMod) if (RegCheckErr(Buf, RoutineName)) return - ! MCFD call RegPack(Buf, InData%MCFD) if (RegCheckErr(Buf, RoutineName)) return - ! WaveField call RegPack(Buf, associated(InData%WaveField)) if (associated(InData%WaveField)) then call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) @@ -4840,31 +4388,22 @@ subroutine Morison_UnPackInitInput(Buf, OutData) integer(IntKi) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return - ! Gravity call RegUnpack(Buf, OutData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDens call RegUnpack(Buf, OutData%WtrDens) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDpth call RegUnpack(Buf, OutData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - ! MSL2SWL call RegUnpack(Buf, OutData%MSL2SWL) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDisp call RegUnpack(Buf, OutData%WaveDisp) if (RegCheckErr(Buf, RoutineName)) return - ! AMMod call RegUnpack(Buf, OutData%AMMod) if (RegCheckErr(Buf, RoutineName)) return - ! NJoints call RegUnpack(Buf, OutData%NJoints) if (RegCheckErr(Buf, RoutineName)) return - ! NNodes call RegUnpack(Buf, OutData%NNodes) if (RegCheckErr(Buf, RoutineName)) return - ! InpJoints if (allocated(OutData%InpJoints)) deallocate(OutData%InpJoints) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4880,7 +4419,6 @@ subroutine Morison_UnPackInitInput(Buf, OutData) call Morison_UnpackJointType(Buf, OutData%InpJoints(i1)) ! InpJoints end do end if - ! Nodes if (allocated(OutData%Nodes)) deallocate(OutData%Nodes) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4896,10 +4434,8 @@ subroutine Morison_UnPackInitInput(Buf, OutData) call Morison_UnpackNodeType(Buf, OutData%Nodes(i1)) ! Nodes end do end if - ! NAxCoefs call RegUnpack(Buf, OutData%NAxCoefs) if (RegCheckErr(Buf, RoutineName)) return - ! AxialCoefs if (allocated(OutData%AxialCoefs)) deallocate(OutData%AxialCoefs) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4915,10 +4451,8 @@ subroutine Morison_UnPackInitInput(Buf, OutData) call Morison_UnpackAxialCoefType(Buf, OutData%AxialCoefs(i1)) ! AxialCoefs end do end if - ! NPropSets call RegUnpack(Buf, OutData%NPropSets) if (RegCheckErr(Buf, RoutineName)) return - ! MPropSets if (allocated(OutData%MPropSets)) deallocate(OutData%MPropSets) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4934,55 +4468,38 @@ subroutine Morison_UnPackInitInput(Buf, OutData) call Morison_UnpackMemberPropType(Buf, OutData%MPropSets(i1)) ! MPropSets end do end if - ! SimplCd call RegUnpack(Buf, OutData%SimplCd) if (RegCheckErr(Buf, RoutineName)) return - ! SimplCdMG call RegUnpack(Buf, OutData%SimplCdMG) if (RegCheckErr(Buf, RoutineName)) return - ! SimplCa call RegUnpack(Buf, OutData%SimplCa) if (RegCheckErr(Buf, RoutineName)) return - ! SimplCaMG call RegUnpack(Buf, OutData%SimplCaMG) if (RegCheckErr(Buf, RoutineName)) return - ! SimplCp call RegUnpack(Buf, OutData%SimplCp) if (RegCheckErr(Buf, RoutineName)) return - ! SimplCpMG call RegUnpack(Buf, OutData%SimplCpMG) if (RegCheckErr(Buf, RoutineName)) return - ! SimplAxCd call RegUnpack(Buf, OutData%SimplAxCd) if (RegCheckErr(Buf, RoutineName)) return - ! SimplAxCdMG call RegUnpack(Buf, OutData%SimplAxCdMG) if (RegCheckErr(Buf, RoutineName)) return - ! SimplAxCa call RegUnpack(Buf, OutData%SimplAxCa) if (RegCheckErr(Buf, RoutineName)) return - ! SimplAxCaMG call RegUnpack(Buf, OutData%SimplAxCaMG) if (RegCheckErr(Buf, RoutineName)) return - ! SimplAxCp call RegUnpack(Buf, OutData%SimplAxCp) if (RegCheckErr(Buf, RoutineName)) return - ! SimplAxCpMG call RegUnpack(Buf, OutData%SimplAxCpMG) if (RegCheckErr(Buf, RoutineName)) return - ! SimplCb call RegUnpack(Buf, OutData%SimplCb) if (RegCheckErr(Buf, RoutineName)) return - ! SimplCbMg call RegUnpack(Buf, OutData%SimplCbMg) if (RegCheckErr(Buf, RoutineName)) return - ! SimplMCF call RegUnpack(Buf, OutData%SimplMCF) if (RegCheckErr(Buf, RoutineName)) return - ! NCoefDpth call RegUnpack(Buf, OutData%NCoefDpth) if (RegCheckErr(Buf, RoutineName)) return - ! CoefDpths if (allocated(OutData%CoefDpths)) deallocate(OutData%CoefDpths) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4998,10 +4515,8 @@ subroutine Morison_UnPackInitInput(Buf, OutData) call Morison_UnpackCoefDpths(Buf, OutData%CoefDpths(i1)) ! CoefDpths end do end if - ! NCoefMembers call RegUnpack(Buf, OutData%NCoefMembers) if (RegCheckErr(Buf, RoutineName)) return - ! CoefMembers if (allocated(OutData%CoefMembers)) deallocate(OutData%CoefMembers) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5017,10 +4532,8 @@ subroutine Morison_UnPackInitInput(Buf, OutData) call Morison_UnpackCoefMembers(Buf, OutData%CoefMembers(i1)) ! CoefMembers end do end if - ! NMembers call RegUnpack(Buf, OutData%NMembers) if (RegCheckErr(Buf, RoutineName)) return - ! InpMembers if (allocated(OutData%InpMembers)) deallocate(OutData%InpMembers) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5036,10 +4549,8 @@ subroutine Morison_UnPackInitInput(Buf, OutData) call Morison_UnpackMemberInputType(Buf, OutData%InpMembers(i1)) ! InpMembers end do end if - ! NFillGroups call RegUnpack(Buf, OutData%NFillGroups) if (RegCheckErr(Buf, RoutineName)) return - ! FilledGroups if (allocated(OutData%FilledGroups)) deallocate(OutData%FilledGroups) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5055,10 +4566,8 @@ subroutine Morison_UnPackInitInput(Buf, OutData) call Morison_UnpackFilledGroupType(Buf, OutData%FilledGroups(i1)) ! FilledGroups end do end if - ! NMGDepths call RegUnpack(Buf, OutData%NMGDepths) if (RegCheckErr(Buf, RoutineName)) return - ! MGDepths if (allocated(OutData%MGDepths)) deallocate(OutData%MGDepths) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5074,16 +4583,12 @@ subroutine Morison_UnPackInitInput(Buf, OutData) call Morison_UnpackMGDepthsType(Buf, OutData%MGDepths(i1)) ! MGDepths end do end if - ! MGTop call RegUnpack(Buf, OutData%MGTop) if (RegCheckErr(Buf, RoutineName)) return - ! MGBottom call RegUnpack(Buf, OutData%MGBottom) if (RegCheckErr(Buf, RoutineName)) return - ! NMOutputs call RegUnpack(Buf, OutData%NMOutputs) if (RegCheckErr(Buf, RoutineName)) return - ! MOutLst if (allocated(OutData%MOutLst)) deallocate(OutData%MOutLst) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5099,10 +4604,8 @@ subroutine Morison_UnPackInitInput(Buf, OutData) call Morison_UnpackMOutput(Buf, OutData%MOutLst(i1)) ! MOutLst end do end if - ! NJOutputs call RegUnpack(Buf, OutData%NJOutputs) if (RegCheckErr(Buf, RoutineName)) return - ! JOutLst if (allocated(OutData%JOutLst)) deallocate(OutData%JOutLst) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5118,7 +4621,6 @@ subroutine Morison_UnPackInitInput(Buf, OutData) call Morison_UnpackJOutput(Buf, OutData%JOutLst(i1)) ! JOutLst end do end if - ! OutList if (allocated(OutData%OutList)) deallocate(OutData%OutList) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5133,22 +4635,16 @@ subroutine Morison_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%OutList) if (RegCheckErr(Buf, RoutineName)) return end if - ! NumOuts call RegUnpack(Buf, OutData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! UnSum call RegUnpack(Buf, OutData%UnSum) if (RegCheckErr(Buf, RoutineName)) return - ! NStepWave call RegUnpack(Buf, OutData%NStepWave) if (RegCheckErr(Buf, RoutineName)) return - ! WaveStMod call RegUnpack(Buf, OutData%WaveStMod) if (RegCheckErr(Buf, RoutineName)) return - ! MCFD call RegUnpack(Buf, OutData%MCFD) if (RegCheckErr(Buf, RoutineName)) return - ! WaveField if (associated(OutData%WaveField)) deallocate(OutData%WaveField) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5170,82 +4666,74 @@ subroutine Morison_UnPackInitInput(Buf, OutData) OutData%WaveField => null() end if end subroutine - SUBROUTINE Morison_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(Morison_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_CopyInitOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInitOutputData%WriteOutputHdr)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputHdr,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputHdr,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputHdr)) THEN - ALLOCATE(DstInitOutputData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr -ENDIF -IF (ALLOCATED(SrcInitOutputData%WriteOutputUnt)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputUnt,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputUnt,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputUnt)) THEN - ALLOCATE(DstInitOutputData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt -ENDIF - END SUBROUTINE Morison_CopyInitOutput - - SUBROUTINE Morison_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(Morison_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyInitOutput' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF - END SUBROUTINE Morison_DestroyInitOutput +subroutine Morison_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(Morison_InitOutputType), intent(in) :: SrcInitOutputData + type(Morison_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Morison_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr + else if (allocated(DstInitOutputData%WriteOutputHdr)) then + deallocate(DstInitOutputData%WriteOutputHdr) + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt + else if (allocated(DstInitOutputData%WriteOutputUnt)) then + deallocate(DstInitOutputData%WriteOutputUnt) + end if +end subroutine +subroutine Morison_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(Morison_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if +end subroutine subroutine Morison_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Morison_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackInitOutput' if (Buf%ErrStat >= AbortErrLev) return - ! WriteOutputHdr call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) call RegPack(Buf, InData%WriteOutputHdr) end if if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutputUnt call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) @@ -5262,7 +4750,6 @@ subroutine Morison_UnPackInitOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! WriteOutputHdr if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5277,7 +4764,6 @@ subroutine Morison_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutputHdr) if (RegCheckErr(Buf, RoutineName)) return end if - ! WriteOutputUnt if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5293,45 +4779,33 @@ subroutine Morison_UnPackInitOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE Morison_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(Morison_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%DummyContState = SrcContStateData%DummyContState - END SUBROUTINE Morison_CopyContState - - SUBROUTINE Morison_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(Morison_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyContState' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Morison_DestroyContState +subroutine Morison_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(Morison_ContinuousStateType), intent(in) :: SrcContStateData + type(Morison_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + DstContStateData%DummyContState = SrcContStateData%DummyContState +end subroutine +subroutine Morison_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(Morison_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine Morison_PackContState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Morison_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackContState' if (Buf%ErrStat >= AbortErrLev) return - ! DummyContState call RegPack(Buf, InData%DummyContState) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -5341,64 +4815,54 @@ subroutine Morison_UnPackContState(Buf, OutData) type(Morison_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackContState' if (Buf%ErrStat /= ErrID_None) return - ! DummyContState call RegUnpack(Buf, OutData%DummyContState) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Morison_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(Morison_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcDiscStateData%V_rel_n_FiltStat)) THEN - i1_l = LBOUND(SrcDiscStateData%V_rel_n_FiltStat,1) - i1_u = UBOUND(SrcDiscStateData%V_rel_n_FiltStat,1) - IF (.NOT. ALLOCATED(DstDiscStateData%V_rel_n_FiltStat)) THEN - ALLOCATE(DstDiscStateData%V_rel_n_FiltStat(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%V_rel_n_FiltStat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%V_rel_n_FiltStat = SrcDiscStateData%V_rel_n_FiltStat -ENDIF - END SUBROUTINE Morison_CopyDiscState - - SUBROUTINE Morison_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(Morison_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(DiscStateData%V_rel_n_FiltStat)) THEN - DEALLOCATE(DiscStateData%V_rel_n_FiltStat) -ENDIF - END SUBROUTINE Morison_DestroyDiscState +subroutine Morison_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(Morison_DiscreteStateType), intent(in) :: SrcDiscStateData + type(Morison_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Morison_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcDiscStateData%V_rel_n_FiltStat)) then + LB(1:1) = lbound(SrcDiscStateData%V_rel_n_FiltStat) + UB(1:1) = ubound(SrcDiscStateData%V_rel_n_FiltStat) + if (.not. allocated(DstDiscStateData%V_rel_n_FiltStat)) then + allocate(DstDiscStateData%V_rel_n_FiltStat(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%V_rel_n_FiltStat.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%V_rel_n_FiltStat = SrcDiscStateData%V_rel_n_FiltStat + else if (allocated(DstDiscStateData%V_rel_n_FiltStat)) then + deallocate(DstDiscStateData%V_rel_n_FiltStat) + end if +end subroutine +subroutine Morison_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(Morison_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(DiscStateData%V_rel_n_FiltStat)) then + deallocate(DiscStateData%V_rel_n_FiltStat) + end if +end subroutine subroutine Morison_PackDiscState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Morison_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackDiscState' if (Buf%ErrStat >= AbortErrLev) return - ! V_rel_n_FiltStat call RegPack(Buf, allocated(InData%V_rel_n_FiltStat)) if (allocated(InData%V_rel_n_FiltStat)) then call RegPackBounds(Buf, 1, lbound(InData%V_rel_n_FiltStat), ubound(InData%V_rel_n_FiltStat)) @@ -5415,7 +4879,6 @@ subroutine Morison_UnPackDiscState(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! V_rel_n_FiltStat if (allocated(OutData%V_rel_n_FiltStat)) deallocate(OutData%V_rel_n_FiltStat) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5431,45 +4894,33 @@ subroutine Morison_UnPackDiscState(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE Morison_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(Morison_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE Morison_CopyConstrState - - SUBROUTINE Morison_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(Morison_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE Morison_DestroyConstrState +subroutine Morison_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(Morison_ConstraintStateType), intent(in) :: SrcConstrStateData + type(Morison_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine +subroutine Morison_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(Morison_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine Morison_PackConstrState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Morison_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackConstrState' if (Buf%ErrStat >= AbortErrLev) return - ! DummyConstrState call RegPack(Buf, InData%DummyConstrState) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -5479,49 +4930,36 @@ subroutine Morison_UnPackConstrState(Buf, OutData) type(Morison_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackConstrState' if (Buf%ErrStat /= ErrID_None) return - ! DummyConstrState call RegUnpack(Buf, OutData%DummyConstrState) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Morison_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(Morison_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState - END SUBROUTINE Morison_CopyOtherState - - SUBROUTINE Morison_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(Morison_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyOtherState' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Morison_DestroyOtherState +subroutine Morison_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(Morison_OtherStateType), intent(in) :: SrcOtherStateData + type(Morison_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState +end subroutine +subroutine Morison_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(Morison_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine Morison_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Morison_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackOtherState' if (Buf%ErrStat >= AbortErrLev) return - ! DummyOtherState call RegPack(Buf, InData%DummyOtherState) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -5531,342 +4969,354 @@ subroutine Morison_UnPackOtherState(Buf, OutData) type(Morison_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackOtherState' if (Buf%ErrStat /= ErrID_None) return - ! DummyOtherState call RegUnpack(Buf, OutData%DummyOtherState) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Morison_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(Morison_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscData%FV)) THEN - i1_l = LBOUND(SrcMiscData%FV,1) - i1_u = UBOUND(SrcMiscData%FV,1) - i2_l = LBOUND(SrcMiscData%FV,2) - i2_u = UBOUND(SrcMiscData%FV,2) - IF (.NOT. ALLOCATED(DstMiscData%FV)) THEN - ALLOCATE(DstMiscData%FV(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%FV = SrcMiscData%FV -ENDIF -IF (ALLOCATED(SrcMiscData%FA)) THEN - i1_l = LBOUND(SrcMiscData%FA,1) - i1_u = UBOUND(SrcMiscData%FA,1) - i2_l = LBOUND(SrcMiscData%FA,2) - i2_u = UBOUND(SrcMiscData%FA,2) - IF (.NOT. ALLOCATED(DstMiscData%FA)) THEN - ALLOCATE(DstMiscData%FA(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%FA = SrcMiscData%FA -ENDIF -IF (ALLOCATED(SrcMiscData%FAMCF)) THEN - i1_l = LBOUND(SrcMiscData%FAMCF,1) - i1_u = UBOUND(SrcMiscData%FAMCF,1) - i2_l = LBOUND(SrcMiscData%FAMCF,2) - i2_u = UBOUND(SrcMiscData%FAMCF,2) - IF (.NOT. ALLOCATED(DstMiscData%FAMCF)) THEN - ALLOCATE(DstMiscData%FAMCF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FAMCF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%FAMCF = SrcMiscData%FAMCF -ENDIF -IF (ALLOCATED(SrcMiscData%FDynP)) THEN - i1_l = LBOUND(SrcMiscData%FDynP,1) - i1_u = UBOUND(SrcMiscData%FDynP,1) - IF (.NOT. ALLOCATED(DstMiscData%FDynP)) THEN - ALLOCATE(DstMiscData%FDynP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FDynP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%FDynP = SrcMiscData%FDynP -ENDIF -IF (ALLOCATED(SrcMiscData%WaveElev)) THEN - i1_l = LBOUND(SrcMiscData%WaveElev,1) - i1_u = UBOUND(SrcMiscData%WaveElev,1) - IF (.NOT. ALLOCATED(DstMiscData%WaveElev)) THEN - ALLOCATE(DstMiscData%WaveElev(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WaveElev.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%WaveElev = SrcMiscData%WaveElev -ENDIF -IF (ALLOCATED(SrcMiscData%WaveElev1)) THEN - i1_l = LBOUND(SrcMiscData%WaveElev1,1) - i1_u = UBOUND(SrcMiscData%WaveElev1,1) - IF (.NOT. ALLOCATED(DstMiscData%WaveElev1)) THEN - ALLOCATE(DstMiscData%WaveElev1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WaveElev1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%WaveElev1 = SrcMiscData%WaveElev1 -ENDIF -IF (ALLOCATED(SrcMiscData%WaveElev2)) THEN - i1_l = LBOUND(SrcMiscData%WaveElev2,1) - i1_u = UBOUND(SrcMiscData%WaveElev2,1) - IF (.NOT. ALLOCATED(DstMiscData%WaveElev2)) THEN - ALLOCATE(DstMiscData%WaveElev2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WaveElev2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%WaveElev2 = SrcMiscData%WaveElev2 -ENDIF -IF (ALLOCATED(SrcMiscData%vrel)) THEN - i1_l = LBOUND(SrcMiscData%vrel,1) - i1_u = UBOUND(SrcMiscData%vrel,1) - i2_l = LBOUND(SrcMiscData%vrel,2) - i2_u = UBOUND(SrcMiscData%vrel,2) - IF (.NOT. ALLOCATED(DstMiscData%vrel)) THEN - ALLOCATE(DstMiscData%vrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%vrel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%vrel = SrcMiscData%vrel -ENDIF -IF (ALLOCATED(SrcMiscData%nodeInWater)) THEN - i1_l = LBOUND(SrcMiscData%nodeInWater,1) - i1_u = UBOUND(SrcMiscData%nodeInWater,1) - IF (.NOT. ALLOCATED(DstMiscData%nodeInWater)) THEN - ALLOCATE(DstMiscData%nodeInWater(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%nodeInWater.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%nodeInWater = SrcMiscData%nodeInWater -ENDIF -IF (ALLOCATED(SrcMiscData%memberLoads)) THEN - i1_l = LBOUND(SrcMiscData%memberLoads,1) - i1_u = UBOUND(SrcMiscData%memberLoads,1) - IF (.NOT. ALLOCATED(DstMiscData%memberLoads)) THEN - ALLOCATE(DstMiscData%memberLoads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%memberLoads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%memberLoads,1), UBOUND(SrcMiscData%memberLoads,1) - CALL Morison_Copymemberloads( SrcMiscData%memberLoads(i1), DstMiscData%memberLoads(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%F_B_End)) THEN - i1_l = LBOUND(SrcMiscData%F_B_End,1) - i1_u = UBOUND(SrcMiscData%F_B_End,1) - i2_l = LBOUND(SrcMiscData%F_B_End,2) - i2_u = UBOUND(SrcMiscData%F_B_End,2) - IF (.NOT. ALLOCATED(DstMiscData%F_B_End)) THEN - ALLOCATE(DstMiscData%F_B_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_B_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_B_End = SrcMiscData%F_B_End -ENDIF -IF (ALLOCATED(SrcMiscData%F_D_End)) THEN - i1_l = LBOUND(SrcMiscData%F_D_End,1) - i1_u = UBOUND(SrcMiscData%F_D_End,1) - i2_l = LBOUND(SrcMiscData%F_D_End,2) - i2_u = UBOUND(SrcMiscData%F_D_End,2) - IF (.NOT. ALLOCATED(DstMiscData%F_D_End)) THEN - ALLOCATE(DstMiscData%F_D_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_D_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_D_End = SrcMiscData%F_D_End -ENDIF -IF (ALLOCATED(SrcMiscData%F_I_End)) THEN - i1_l = LBOUND(SrcMiscData%F_I_End,1) - i1_u = UBOUND(SrcMiscData%F_I_End,1) - i2_l = LBOUND(SrcMiscData%F_I_End,2) - i2_u = UBOUND(SrcMiscData%F_I_End,2) - IF (.NOT. ALLOCATED(DstMiscData%F_I_End)) THEN - ALLOCATE(DstMiscData%F_I_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_I_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_I_End = SrcMiscData%F_I_End -ENDIF -IF (ALLOCATED(SrcMiscData%F_IMG_End)) THEN - i1_l = LBOUND(SrcMiscData%F_IMG_End,1) - i1_u = UBOUND(SrcMiscData%F_IMG_End,1) - i2_l = LBOUND(SrcMiscData%F_IMG_End,2) - i2_u = UBOUND(SrcMiscData%F_IMG_End,2) - IF (.NOT. ALLOCATED(DstMiscData%F_IMG_End)) THEN - ALLOCATE(DstMiscData%F_IMG_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_IMG_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_IMG_End = SrcMiscData%F_IMG_End -ENDIF -IF (ALLOCATED(SrcMiscData%F_A_End)) THEN - i1_l = LBOUND(SrcMiscData%F_A_End,1) - i1_u = UBOUND(SrcMiscData%F_A_End,1) - i2_l = LBOUND(SrcMiscData%F_A_End,2) - i2_u = UBOUND(SrcMiscData%F_A_End,2) - IF (.NOT. ALLOCATED(DstMiscData%F_A_End)) THEN - ALLOCATE(DstMiscData%F_A_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_A_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_A_End = SrcMiscData%F_A_End -ENDIF -IF (ALLOCATED(SrcMiscData%F_BF_End)) THEN - i1_l = LBOUND(SrcMiscData%F_BF_End,1) - i1_u = UBOUND(SrcMiscData%F_BF_End,1) - i2_l = LBOUND(SrcMiscData%F_BF_End,2) - i2_u = UBOUND(SrcMiscData%F_BF_End,2) - IF (.NOT. ALLOCATED(DstMiscData%F_BF_End)) THEN - ALLOCATE(DstMiscData%F_BF_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_BF_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_BF_End = SrcMiscData%F_BF_End -ENDIF -IF (ALLOCATED(SrcMiscData%V_rel_n)) THEN - i1_l = LBOUND(SrcMiscData%V_rel_n,1) - i1_u = UBOUND(SrcMiscData%V_rel_n,1) - IF (.NOT. ALLOCATED(DstMiscData%V_rel_n)) THEN - ALLOCATE(DstMiscData%V_rel_n(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%V_rel_n.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%V_rel_n = SrcMiscData%V_rel_n -ENDIF -IF (ALLOCATED(SrcMiscData%V_rel_n_HiPass)) THEN - i1_l = LBOUND(SrcMiscData%V_rel_n_HiPass,1) - i1_u = UBOUND(SrcMiscData%V_rel_n_HiPass,1) - IF (.NOT. ALLOCATED(DstMiscData%V_rel_n_HiPass)) THEN - ALLOCATE(DstMiscData%V_rel_n_HiPass(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%V_rel_n_HiPass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%V_rel_n_HiPass = SrcMiscData%V_rel_n_HiPass -ENDIF - DstMiscData%LastIndWave = SrcMiscData%LastIndWave - END SUBROUTINE Morison_CopyMisc - SUBROUTINE Morison_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(Morison_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MiscData%FV)) THEN - DEALLOCATE(MiscData%FV) -ENDIF -IF (ALLOCATED(MiscData%FA)) THEN - DEALLOCATE(MiscData%FA) -ENDIF -IF (ALLOCATED(MiscData%FAMCF)) THEN - DEALLOCATE(MiscData%FAMCF) -ENDIF -IF (ALLOCATED(MiscData%FDynP)) THEN - DEALLOCATE(MiscData%FDynP) -ENDIF -IF (ALLOCATED(MiscData%WaveElev)) THEN - DEALLOCATE(MiscData%WaveElev) -ENDIF -IF (ALLOCATED(MiscData%WaveElev1)) THEN - DEALLOCATE(MiscData%WaveElev1) -ENDIF -IF (ALLOCATED(MiscData%WaveElev2)) THEN - DEALLOCATE(MiscData%WaveElev2) -ENDIF -IF (ALLOCATED(MiscData%vrel)) THEN - DEALLOCATE(MiscData%vrel) -ENDIF -IF (ALLOCATED(MiscData%nodeInWater)) THEN - DEALLOCATE(MiscData%nodeInWater) -ENDIF -IF (ALLOCATED(MiscData%memberLoads)) THEN -DO i1 = LBOUND(MiscData%memberLoads,1), UBOUND(MiscData%memberLoads,1) - CALL Morison_DestroyMemberLoads( MiscData%memberLoads(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%memberLoads) -ENDIF -IF (ALLOCATED(MiscData%F_B_End)) THEN - DEALLOCATE(MiscData%F_B_End) -ENDIF -IF (ALLOCATED(MiscData%F_D_End)) THEN - DEALLOCATE(MiscData%F_D_End) -ENDIF -IF (ALLOCATED(MiscData%F_I_End)) THEN - DEALLOCATE(MiscData%F_I_End) -ENDIF -IF (ALLOCATED(MiscData%F_IMG_End)) THEN - DEALLOCATE(MiscData%F_IMG_End) -ENDIF -IF (ALLOCATED(MiscData%F_A_End)) THEN - DEALLOCATE(MiscData%F_A_End) -ENDIF -IF (ALLOCATED(MiscData%F_BF_End)) THEN - DEALLOCATE(MiscData%F_BF_End) -ENDIF -IF (ALLOCATED(MiscData%V_rel_n)) THEN - DEALLOCATE(MiscData%V_rel_n) -ENDIF -IF (ALLOCATED(MiscData%V_rel_n_HiPass)) THEN - DEALLOCATE(MiscData%V_rel_n_HiPass) -ENDIF - END SUBROUTINE Morison_DestroyMisc +subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(Morison_MiscVarType), intent(in) :: SrcMiscData + type(Morison_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Morison_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMiscData%FV)) then + LB(1:2) = lbound(SrcMiscData%FV) + UB(1:2) = ubound(SrcMiscData%FV) + if (.not. allocated(DstMiscData%FV)) then + allocate(DstMiscData%FV(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FV.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%FV = SrcMiscData%FV + else if (allocated(DstMiscData%FV)) then + deallocate(DstMiscData%FV) + end if + if (allocated(SrcMiscData%FA)) then + LB(1:2) = lbound(SrcMiscData%FA) + UB(1:2) = ubound(SrcMiscData%FA) + if (.not. allocated(DstMiscData%FA)) then + allocate(DstMiscData%FA(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FA.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%FA = SrcMiscData%FA + else if (allocated(DstMiscData%FA)) then + deallocate(DstMiscData%FA) + end if + if (allocated(SrcMiscData%FAMCF)) then + LB(1:2) = lbound(SrcMiscData%FAMCF) + UB(1:2) = ubound(SrcMiscData%FAMCF) + if (.not. allocated(DstMiscData%FAMCF)) then + allocate(DstMiscData%FAMCF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FAMCF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%FAMCF = SrcMiscData%FAMCF + else if (allocated(DstMiscData%FAMCF)) then + deallocate(DstMiscData%FAMCF) + end if + if (allocated(SrcMiscData%FDynP)) then + LB(1:1) = lbound(SrcMiscData%FDynP) + UB(1:1) = ubound(SrcMiscData%FDynP) + if (.not. allocated(DstMiscData%FDynP)) then + allocate(DstMiscData%FDynP(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FDynP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%FDynP = SrcMiscData%FDynP + else if (allocated(DstMiscData%FDynP)) then + deallocate(DstMiscData%FDynP) + end if + if (allocated(SrcMiscData%WaveElev)) then + LB(1:1) = lbound(SrcMiscData%WaveElev) + UB(1:1) = ubound(SrcMiscData%WaveElev) + if (.not. allocated(DstMiscData%WaveElev)) then + allocate(DstMiscData%WaveElev(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WaveElev.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%WaveElev = SrcMiscData%WaveElev + else if (allocated(DstMiscData%WaveElev)) then + deallocate(DstMiscData%WaveElev) + end if + if (allocated(SrcMiscData%WaveElev1)) then + LB(1:1) = lbound(SrcMiscData%WaveElev1) + UB(1:1) = ubound(SrcMiscData%WaveElev1) + if (.not. allocated(DstMiscData%WaveElev1)) then + allocate(DstMiscData%WaveElev1(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WaveElev1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%WaveElev1 = SrcMiscData%WaveElev1 + else if (allocated(DstMiscData%WaveElev1)) then + deallocate(DstMiscData%WaveElev1) + end if + if (allocated(SrcMiscData%WaveElev2)) then + LB(1:1) = lbound(SrcMiscData%WaveElev2) + UB(1:1) = ubound(SrcMiscData%WaveElev2) + if (.not. allocated(DstMiscData%WaveElev2)) then + allocate(DstMiscData%WaveElev2(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WaveElev2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%WaveElev2 = SrcMiscData%WaveElev2 + else if (allocated(DstMiscData%WaveElev2)) then + deallocate(DstMiscData%WaveElev2) + end if + if (allocated(SrcMiscData%vrel)) then + LB(1:2) = lbound(SrcMiscData%vrel) + UB(1:2) = ubound(SrcMiscData%vrel) + if (.not. allocated(DstMiscData%vrel)) then + allocate(DstMiscData%vrel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%vrel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%vrel = SrcMiscData%vrel + else if (allocated(DstMiscData%vrel)) then + deallocate(DstMiscData%vrel) + end if + if (allocated(SrcMiscData%nodeInWater)) then + LB(1:1) = lbound(SrcMiscData%nodeInWater) + UB(1:1) = ubound(SrcMiscData%nodeInWater) + if (.not. allocated(DstMiscData%nodeInWater)) then + allocate(DstMiscData%nodeInWater(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%nodeInWater.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%nodeInWater = SrcMiscData%nodeInWater + else if (allocated(DstMiscData%nodeInWater)) then + deallocate(DstMiscData%nodeInWater) + end if + if (allocated(SrcMiscData%memberLoads)) then + LB(1:1) = lbound(SrcMiscData%memberLoads) + UB(1:1) = ubound(SrcMiscData%memberLoads) + if (.not. allocated(DstMiscData%memberLoads)) then + allocate(DstMiscData%memberLoads(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%memberLoads.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Morison_CopyMemberLoads(SrcMiscData%memberLoads(i1), DstMiscData%memberLoads(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstMiscData%memberLoads)) then + deallocate(DstMiscData%memberLoads) + end if + if (allocated(SrcMiscData%F_B_End)) then + LB(1:2) = lbound(SrcMiscData%F_B_End) + UB(1:2) = ubound(SrcMiscData%F_B_End) + if (.not. allocated(DstMiscData%F_B_End)) then + allocate(DstMiscData%F_B_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_B_End.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_B_End = SrcMiscData%F_B_End + else if (allocated(DstMiscData%F_B_End)) then + deallocate(DstMiscData%F_B_End) + end if + if (allocated(SrcMiscData%F_D_End)) then + LB(1:2) = lbound(SrcMiscData%F_D_End) + UB(1:2) = ubound(SrcMiscData%F_D_End) + if (.not. allocated(DstMiscData%F_D_End)) then + allocate(DstMiscData%F_D_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_D_End.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_D_End = SrcMiscData%F_D_End + else if (allocated(DstMiscData%F_D_End)) then + deallocate(DstMiscData%F_D_End) + end if + if (allocated(SrcMiscData%F_I_End)) then + LB(1:2) = lbound(SrcMiscData%F_I_End) + UB(1:2) = ubound(SrcMiscData%F_I_End) + if (.not. allocated(DstMiscData%F_I_End)) then + allocate(DstMiscData%F_I_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_I_End.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_I_End = SrcMiscData%F_I_End + else if (allocated(DstMiscData%F_I_End)) then + deallocate(DstMiscData%F_I_End) + end if + if (allocated(SrcMiscData%F_IMG_End)) then + LB(1:2) = lbound(SrcMiscData%F_IMG_End) + UB(1:2) = ubound(SrcMiscData%F_IMG_End) + if (.not. allocated(DstMiscData%F_IMG_End)) then + allocate(DstMiscData%F_IMG_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_IMG_End.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_IMG_End = SrcMiscData%F_IMG_End + else if (allocated(DstMiscData%F_IMG_End)) then + deallocate(DstMiscData%F_IMG_End) + end if + if (allocated(SrcMiscData%F_A_End)) then + LB(1:2) = lbound(SrcMiscData%F_A_End) + UB(1:2) = ubound(SrcMiscData%F_A_End) + if (.not. allocated(DstMiscData%F_A_End)) then + allocate(DstMiscData%F_A_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_A_End.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_A_End = SrcMiscData%F_A_End + else if (allocated(DstMiscData%F_A_End)) then + deallocate(DstMiscData%F_A_End) + end if + if (allocated(SrcMiscData%F_BF_End)) then + LB(1:2) = lbound(SrcMiscData%F_BF_End) + UB(1:2) = ubound(SrcMiscData%F_BF_End) + if (.not. allocated(DstMiscData%F_BF_End)) then + allocate(DstMiscData%F_BF_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_BF_End.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_BF_End = SrcMiscData%F_BF_End + else if (allocated(DstMiscData%F_BF_End)) then + deallocate(DstMiscData%F_BF_End) + end if + if (allocated(SrcMiscData%V_rel_n)) then + LB(1:1) = lbound(SrcMiscData%V_rel_n) + UB(1:1) = ubound(SrcMiscData%V_rel_n) + if (.not. allocated(DstMiscData%V_rel_n)) then + allocate(DstMiscData%V_rel_n(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%V_rel_n.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%V_rel_n = SrcMiscData%V_rel_n + else if (allocated(DstMiscData%V_rel_n)) then + deallocate(DstMiscData%V_rel_n) + end if + if (allocated(SrcMiscData%V_rel_n_HiPass)) then + LB(1:1) = lbound(SrcMiscData%V_rel_n_HiPass) + UB(1:1) = ubound(SrcMiscData%V_rel_n_HiPass) + if (.not. allocated(DstMiscData%V_rel_n_HiPass)) then + allocate(DstMiscData%V_rel_n_HiPass(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%V_rel_n_HiPass.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%V_rel_n_HiPass = SrcMiscData%V_rel_n_HiPass + else if (allocated(DstMiscData%V_rel_n_HiPass)) then + deallocate(DstMiscData%V_rel_n_HiPass) + end if + DstMiscData%LastIndWave = SrcMiscData%LastIndWave +end subroutine +subroutine Morison_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(Morison_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Morison_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%FV)) then + deallocate(MiscData%FV) + end if + if (allocated(MiscData%FA)) then + deallocate(MiscData%FA) + end if + if (allocated(MiscData%FAMCF)) then + deallocate(MiscData%FAMCF) + end if + if (allocated(MiscData%FDynP)) then + deallocate(MiscData%FDynP) + end if + if (allocated(MiscData%WaveElev)) then + deallocate(MiscData%WaveElev) + end if + if (allocated(MiscData%WaveElev1)) then + deallocate(MiscData%WaveElev1) + end if + if (allocated(MiscData%WaveElev2)) then + deallocate(MiscData%WaveElev2) + end if + if (allocated(MiscData%vrel)) then + deallocate(MiscData%vrel) + end if + if (allocated(MiscData%nodeInWater)) then + deallocate(MiscData%nodeInWater) + end if + if (allocated(MiscData%memberLoads)) then + LB(1:1) = lbound(MiscData%memberLoads) + UB(1:1) = ubound(MiscData%memberLoads) + do i1 = LB(1), UB(1) + call Morison_DestroyMemberLoads(MiscData%memberLoads(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%memberLoads) + end if + if (allocated(MiscData%F_B_End)) then + deallocate(MiscData%F_B_End) + end if + if (allocated(MiscData%F_D_End)) then + deallocate(MiscData%F_D_End) + end if + if (allocated(MiscData%F_I_End)) then + deallocate(MiscData%F_I_End) + end if + if (allocated(MiscData%F_IMG_End)) then + deallocate(MiscData%F_IMG_End) + end if + if (allocated(MiscData%F_A_End)) then + deallocate(MiscData%F_A_End) + end if + if (allocated(MiscData%F_BF_End)) then + deallocate(MiscData%F_BF_End) + end if + if (allocated(MiscData%V_rel_n)) then + deallocate(MiscData%V_rel_n) + end if + if (allocated(MiscData%V_rel_n_HiPass)) then + deallocate(MiscData%V_rel_n_HiPass) + end if +end subroutine subroutine Morison_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -5875,70 +5325,60 @@ subroutine Morison_PackMisc(Buf, Indata) integer(IntKi) :: i1, i2 integer(IntKi) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return - ! FV call RegPack(Buf, allocated(InData%FV)) if (allocated(InData%FV)) then call RegPackBounds(Buf, 2, lbound(InData%FV), ubound(InData%FV)) call RegPack(Buf, InData%FV) end if if (RegCheckErr(Buf, RoutineName)) return - ! FA call RegPack(Buf, allocated(InData%FA)) if (allocated(InData%FA)) then call RegPackBounds(Buf, 2, lbound(InData%FA), ubound(InData%FA)) call RegPack(Buf, InData%FA) end if if (RegCheckErr(Buf, RoutineName)) return - ! FAMCF call RegPack(Buf, allocated(InData%FAMCF)) if (allocated(InData%FAMCF)) then call RegPackBounds(Buf, 2, lbound(InData%FAMCF), ubound(InData%FAMCF)) call RegPack(Buf, InData%FAMCF) end if if (RegCheckErr(Buf, RoutineName)) return - ! FDynP call RegPack(Buf, allocated(InData%FDynP)) if (allocated(InData%FDynP)) then call RegPackBounds(Buf, 1, lbound(InData%FDynP), ubound(InData%FDynP)) call RegPack(Buf, InData%FDynP) end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveElev call RegPack(Buf, allocated(InData%WaveElev)) if (allocated(InData%WaveElev)) then call RegPackBounds(Buf, 1, lbound(InData%WaveElev), ubound(InData%WaveElev)) call RegPack(Buf, InData%WaveElev) end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveElev1 call RegPack(Buf, allocated(InData%WaveElev1)) if (allocated(InData%WaveElev1)) then call RegPackBounds(Buf, 1, lbound(InData%WaveElev1), ubound(InData%WaveElev1)) call RegPack(Buf, InData%WaveElev1) end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveElev2 call RegPack(Buf, allocated(InData%WaveElev2)) if (allocated(InData%WaveElev2)) then call RegPackBounds(Buf, 1, lbound(InData%WaveElev2), ubound(InData%WaveElev2)) call RegPack(Buf, InData%WaveElev2) end if if (RegCheckErr(Buf, RoutineName)) return - ! vrel call RegPack(Buf, allocated(InData%vrel)) if (allocated(InData%vrel)) then call RegPackBounds(Buf, 2, lbound(InData%vrel), ubound(InData%vrel)) call RegPack(Buf, InData%vrel) end if if (RegCheckErr(Buf, RoutineName)) return - ! nodeInWater call RegPack(Buf, allocated(InData%nodeInWater)) if (allocated(InData%nodeInWater)) then call RegPackBounds(Buf, 1, lbound(InData%nodeInWater), ubound(InData%nodeInWater)) call RegPack(Buf, InData%nodeInWater) end if if (RegCheckErr(Buf, RoutineName)) return - ! memberLoads call RegPack(Buf, allocated(InData%memberLoads)) if (allocated(InData%memberLoads)) then call RegPackBounds(Buf, 1, lbound(InData%memberLoads), ubound(InData%memberLoads)) @@ -5949,63 +5389,54 @@ subroutine Morison_PackMisc(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! F_B_End call RegPack(Buf, allocated(InData%F_B_End)) if (allocated(InData%F_B_End)) then call RegPackBounds(Buf, 2, lbound(InData%F_B_End), ubound(InData%F_B_End)) call RegPack(Buf, InData%F_B_End) end if if (RegCheckErr(Buf, RoutineName)) return - ! F_D_End call RegPack(Buf, allocated(InData%F_D_End)) if (allocated(InData%F_D_End)) then call RegPackBounds(Buf, 2, lbound(InData%F_D_End), ubound(InData%F_D_End)) call RegPack(Buf, InData%F_D_End) end if if (RegCheckErr(Buf, RoutineName)) return - ! F_I_End call RegPack(Buf, allocated(InData%F_I_End)) if (allocated(InData%F_I_End)) then call RegPackBounds(Buf, 2, lbound(InData%F_I_End), ubound(InData%F_I_End)) call RegPack(Buf, InData%F_I_End) end if if (RegCheckErr(Buf, RoutineName)) return - ! F_IMG_End call RegPack(Buf, allocated(InData%F_IMG_End)) if (allocated(InData%F_IMG_End)) then call RegPackBounds(Buf, 2, lbound(InData%F_IMG_End), ubound(InData%F_IMG_End)) call RegPack(Buf, InData%F_IMG_End) end if if (RegCheckErr(Buf, RoutineName)) return - ! F_A_End call RegPack(Buf, allocated(InData%F_A_End)) if (allocated(InData%F_A_End)) then call RegPackBounds(Buf, 2, lbound(InData%F_A_End), ubound(InData%F_A_End)) call RegPack(Buf, InData%F_A_End) end if if (RegCheckErr(Buf, RoutineName)) return - ! F_BF_End call RegPack(Buf, allocated(InData%F_BF_End)) if (allocated(InData%F_BF_End)) then call RegPackBounds(Buf, 2, lbound(InData%F_BF_End), ubound(InData%F_BF_End)) call RegPack(Buf, InData%F_BF_End) end if if (RegCheckErr(Buf, RoutineName)) return - ! V_rel_n call RegPack(Buf, allocated(InData%V_rel_n)) if (allocated(InData%V_rel_n)) then call RegPackBounds(Buf, 1, lbound(InData%V_rel_n), ubound(InData%V_rel_n)) call RegPack(Buf, InData%V_rel_n) end if if (RegCheckErr(Buf, RoutineName)) return - ! V_rel_n_HiPass call RegPack(Buf, allocated(InData%V_rel_n_HiPass)) if (allocated(InData%V_rel_n_HiPass)) then call RegPackBounds(Buf, 1, lbound(InData%V_rel_n_HiPass), ubound(InData%V_rel_n_HiPass)) call RegPack(Buf, InData%V_rel_n_HiPass) end if if (RegCheckErr(Buf, RoutineName)) return - ! LastIndWave call RegPack(Buf, InData%LastIndWave) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -6019,7 +5450,6 @@ subroutine Morison_UnPackMisc(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! FV if (allocated(OutData%FV)) deallocate(OutData%FV) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6034,7 +5464,6 @@ subroutine Morison_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%FV) if (RegCheckErr(Buf, RoutineName)) return end if - ! FA if (allocated(OutData%FA)) deallocate(OutData%FA) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6049,7 +5478,6 @@ subroutine Morison_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%FA) if (RegCheckErr(Buf, RoutineName)) return end if - ! FAMCF if (allocated(OutData%FAMCF)) deallocate(OutData%FAMCF) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6064,7 +5492,6 @@ subroutine Morison_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%FAMCF) if (RegCheckErr(Buf, RoutineName)) return end if - ! FDynP if (allocated(OutData%FDynP)) deallocate(OutData%FDynP) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6079,7 +5506,6 @@ subroutine Morison_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%FDynP) if (RegCheckErr(Buf, RoutineName)) return end if - ! WaveElev if (allocated(OutData%WaveElev)) deallocate(OutData%WaveElev) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6094,7 +5520,6 @@ subroutine Morison_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%WaveElev) if (RegCheckErr(Buf, RoutineName)) return end if - ! WaveElev1 if (allocated(OutData%WaveElev1)) deallocate(OutData%WaveElev1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6109,7 +5534,6 @@ subroutine Morison_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%WaveElev1) if (RegCheckErr(Buf, RoutineName)) return end if - ! WaveElev2 if (allocated(OutData%WaveElev2)) deallocate(OutData%WaveElev2) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6124,7 +5548,6 @@ subroutine Morison_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%WaveElev2) if (RegCheckErr(Buf, RoutineName)) return end if - ! vrel if (allocated(OutData%vrel)) deallocate(OutData%vrel) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6139,7 +5562,6 @@ subroutine Morison_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%vrel) if (RegCheckErr(Buf, RoutineName)) return end if - ! nodeInWater if (allocated(OutData%nodeInWater)) deallocate(OutData%nodeInWater) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6154,7 +5576,6 @@ subroutine Morison_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%nodeInWater) if (RegCheckErr(Buf, RoutineName)) return end if - ! memberLoads if (allocated(OutData%memberLoads)) deallocate(OutData%memberLoads) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6170,7 +5591,6 @@ subroutine Morison_UnPackMisc(Buf, OutData) call Morison_UnpackMemberLoads(Buf, OutData%memberLoads(i1)) ! memberLoads end do end if - ! F_B_End if (allocated(OutData%F_B_End)) deallocate(OutData%F_B_End) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6185,7 +5605,6 @@ subroutine Morison_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%F_B_End) if (RegCheckErr(Buf, RoutineName)) return end if - ! F_D_End if (allocated(OutData%F_D_End)) deallocate(OutData%F_D_End) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6200,7 +5619,6 @@ subroutine Morison_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%F_D_End) if (RegCheckErr(Buf, RoutineName)) return end if - ! F_I_End if (allocated(OutData%F_I_End)) deallocate(OutData%F_I_End) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6215,7 +5633,6 @@ subroutine Morison_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%F_I_End) if (RegCheckErr(Buf, RoutineName)) return end if - ! F_IMG_End if (allocated(OutData%F_IMG_End)) deallocate(OutData%F_IMG_End) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6230,7 +5647,6 @@ subroutine Morison_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%F_IMG_End) if (RegCheckErr(Buf, RoutineName)) return end if - ! F_A_End if (allocated(OutData%F_A_End)) deallocate(OutData%F_A_End) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6245,7 +5661,6 @@ subroutine Morison_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%F_A_End) if (RegCheckErr(Buf, RoutineName)) return end if - ! F_BF_End if (allocated(OutData%F_BF_End)) deallocate(OutData%F_BF_End) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6260,7 +5675,6 @@ subroutine Morison_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%F_BF_End) if (RegCheckErr(Buf, RoutineName)) return end if - ! V_rel_n if (allocated(OutData%V_rel_n)) deallocate(OutData%V_rel_n) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6275,7 +5689,6 @@ subroutine Morison_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%V_rel_n) if (RegCheckErr(Buf, RoutineName)) return end if - ! V_rel_n_HiPass if (allocated(OutData%V_rel_n_HiPass)) deallocate(OutData%V_rel_n_HiPass) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6290,317 +5703,332 @@ subroutine Morison_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%V_rel_n_HiPass) if (RegCheckErr(Buf, RoutineName)) return end if - ! LastIndWave call RegUnpack(Buf, OutData%LastIndWave) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Morison_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_ParameterType), INTENT(IN) :: SrcParamData - TYPE(Morison_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT - DstParamData%Gravity = SrcParamData%Gravity - DstParamData%WtrDens = SrcParamData%WtrDens - DstParamData%WtrDpth = SrcParamData%WtrDpth - DstParamData%MSL2SWL = SrcParamData%MSL2SWL - DstParamData%WaveDisp = SrcParamData%WaveDisp - DstParamData%AMMod = SrcParamData%AMMod - DstParamData%NMembers = SrcParamData%NMembers -IF (ALLOCATED(SrcParamData%Members)) THEN - i1_l = LBOUND(SrcParamData%Members,1) - i1_u = UBOUND(SrcParamData%Members,1) - IF (.NOT. ALLOCATED(DstParamData%Members)) THEN - ALLOCATE(DstParamData%Members(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Members.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%Members,1), UBOUND(SrcParamData%Members,1) - CALL Morison_Copymembertype( SrcParamData%Members(i1), DstParamData%Members(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstParamData%NNodes = SrcParamData%NNodes - DstParamData%NJoints = SrcParamData%NJoints -IF (ALLOCATED(SrcParamData%I_MG_End)) THEN - i1_l = LBOUND(SrcParamData%I_MG_End,1) - i1_u = UBOUND(SrcParamData%I_MG_End,1) - i2_l = LBOUND(SrcParamData%I_MG_End,2) - i2_u = UBOUND(SrcParamData%I_MG_End,2) - i3_l = LBOUND(SrcParamData%I_MG_End,3) - i3_u = UBOUND(SrcParamData%I_MG_End,3) - IF (.NOT. ALLOCATED(DstParamData%I_MG_End)) THEN - ALLOCATE(DstParamData%I_MG_End(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%I_MG_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%I_MG_End = SrcParamData%I_MG_End -ENDIF -IF (ALLOCATED(SrcParamData%An_End)) THEN - i1_l = LBOUND(SrcParamData%An_End,1) - i1_u = UBOUND(SrcParamData%An_End,1) - i2_l = LBOUND(SrcParamData%An_End,2) - i2_u = UBOUND(SrcParamData%An_End,2) - IF (.NOT. ALLOCATED(DstParamData%An_End)) THEN - ALLOCATE(DstParamData%An_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%An_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%An_End = SrcParamData%An_End -ENDIF -IF (ALLOCATED(SrcParamData%DragConst_End)) THEN - i1_l = LBOUND(SrcParamData%DragConst_End,1) - i1_u = UBOUND(SrcParamData%DragConst_End,1) - IF (.NOT. ALLOCATED(DstParamData%DragConst_End)) THEN - ALLOCATE(DstParamData%DragConst_End(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DragConst_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%DragConst_End = SrcParamData%DragConst_End -ENDIF -IF (ALLOCATED(SrcParamData%VRelNFiltConst)) THEN - i1_l = LBOUND(SrcParamData%VRelNFiltConst,1) - i1_u = UBOUND(SrcParamData%VRelNFiltConst,1) - IF (.NOT. ALLOCATED(DstParamData%VRelNFiltConst)) THEN - ALLOCATE(DstParamData%VRelNFiltConst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%VRelNFiltConst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%VRelNFiltConst = SrcParamData%VRelNFiltConst -ENDIF -IF (ALLOCATED(SrcParamData%DragMod_End)) THEN - i1_l = LBOUND(SrcParamData%DragMod_End,1) - i1_u = UBOUND(SrcParamData%DragMod_End,1) - IF (.NOT. ALLOCATED(DstParamData%DragMod_End)) THEN - ALLOCATE(DstParamData%DragMod_End(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DragMod_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%DragMod_End = SrcParamData%DragMod_End -ENDIF -IF (ALLOCATED(SrcParamData%DragLoFSc_End)) THEN - i1_l = LBOUND(SrcParamData%DragLoFSc_End,1) - i1_u = UBOUND(SrcParamData%DragLoFSc_End,1) - IF (.NOT. ALLOCATED(DstParamData%DragLoFSc_End)) THEN - ALLOCATE(DstParamData%DragLoFSc_End(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DragLoFSc_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%DragLoFSc_End = SrcParamData%DragLoFSc_End -ENDIF -IF (ALLOCATED(SrcParamData%F_WMG_End)) THEN - i1_l = LBOUND(SrcParamData%F_WMG_End,1) - i1_u = UBOUND(SrcParamData%F_WMG_End,1) - i2_l = LBOUND(SrcParamData%F_WMG_End,2) - i2_u = UBOUND(SrcParamData%F_WMG_End,2) - IF (.NOT. ALLOCATED(DstParamData%F_WMG_End)) THEN - ALLOCATE(DstParamData%F_WMG_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%F_WMG_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%F_WMG_End = SrcParamData%F_WMG_End -ENDIF -IF (ALLOCATED(SrcParamData%DP_Const_End)) THEN - i1_l = LBOUND(SrcParamData%DP_Const_End,1) - i1_u = UBOUND(SrcParamData%DP_Const_End,1) - i2_l = LBOUND(SrcParamData%DP_Const_End,2) - i2_u = UBOUND(SrcParamData%DP_Const_End,2) - IF (.NOT. ALLOCATED(DstParamData%DP_Const_End)) THEN - ALLOCATE(DstParamData%DP_Const_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DP_Const_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%DP_Const_End = SrcParamData%DP_Const_End -ENDIF -IF (ALLOCATED(SrcParamData%Mass_MG_End)) THEN - i1_l = LBOUND(SrcParamData%Mass_MG_End,1) - i1_u = UBOUND(SrcParamData%Mass_MG_End,1) - IF (.NOT. ALLOCATED(DstParamData%Mass_MG_End)) THEN - ALLOCATE(DstParamData%Mass_MG_End(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Mass_MG_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Mass_MG_End = SrcParamData%Mass_MG_End -ENDIF -IF (ALLOCATED(SrcParamData%AM_End)) THEN - i1_l = LBOUND(SrcParamData%AM_End,1) - i1_u = UBOUND(SrcParamData%AM_End,1) - i2_l = LBOUND(SrcParamData%AM_End,2) - i2_u = UBOUND(SrcParamData%AM_End,2) - i3_l = LBOUND(SrcParamData%AM_End,3) - i3_u = UBOUND(SrcParamData%AM_End,3) - IF (.NOT. ALLOCATED(DstParamData%AM_End)) THEN - ALLOCATE(DstParamData%AM_End(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AM_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AM_End = SrcParamData%AM_End -ENDIF - DstParamData%NStepWave = SrcParamData%NStepWave - DstParamData%NMOutputs = SrcParamData%NMOutputs -IF (ALLOCATED(SrcParamData%MOutLst)) THEN - i1_l = LBOUND(SrcParamData%MOutLst,1) - i1_u = UBOUND(SrcParamData%MOutLst,1) - IF (.NOT. ALLOCATED(DstParamData%MOutLst)) THEN - ALLOCATE(DstParamData%MOutLst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MOutLst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%MOutLst,1), UBOUND(SrcParamData%MOutLst,1) - CALL Morison_Copymoutput( SrcParamData%MOutLst(i1), DstParamData%MOutLst(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstParamData%NJOutputs = SrcParamData%NJOutputs -IF (ALLOCATED(SrcParamData%JOutLst)) THEN - i1_l = LBOUND(SrcParamData%JOutLst,1) - i1_u = UBOUND(SrcParamData%JOutLst,1) - IF (.NOT. ALLOCATED(DstParamData%JOutLst)) THEN - ALLOCATE(DstParamData%JOutLst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%JOutLst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%JOutLst,1), UBOUND(SrcParamData%JOutLst,1) - CALL Morison_Copyjoutput( SrcParamData%JOutLst(i1), DstParamData%JOutLst(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%OutParam)) THEN - i1_l = LBOUND(SrcParamData%OutParam,1) - i1_u = UBOUND(SrcParamData%OutParam,1) - IF (.NOT. ALLOCATED(DstParamData%OutParam)) THEN - ALLOCATE(DstParamData%OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%OutParam,1), UBOUND(SrcParamData%OutParam,1) - CALL NWTC_Library_Copyoutparmtype( SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%WaveStMod = SrcParamData%WaveStMod - DstParamData%WaveField => SrcParamData%WaveField - END SUBROUTINE Morison_CopyParam - - SUBROUTINE Morison_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(Morison_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyParam' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%Members)) THEN -DO i1 = LBOUND(ParamData%Members,1), UBOUND(ParamData%Members,1) - CALL Morison_DestroyMemberType( ParamData%Members(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%Members) -ENDIF -IF (ALLOCATED(ParamData%I_MG_End)) THEN - DEALLOCATE(ParamData%I_MG_End) -ENDIF -IF (ALLOCATED(ParamData%An_End)) THEN - DEALLOCATE(ParamData%An_End) -ENDIF -IF (ALLOCATED(ParamData%DragConst_End)) THEN - DEALLOCATE(ParamData%DragConst_End) -ENDIF -IF (ALLOCATED(ParamData%VRelNFiltConst)) THEN - DEALLOCATE(ParamData%VRelNFiltConst) -ENDIF -IF (ALLOCATED(ParamData%DragMod_End)) THEN - DEALLOCATE(ParamData%DragMod_End) -ENDIF -IF (ALLOCATED(ParamData%DragLoFSc_End)) THEN - DEALLOCATE(ParamData%DragLoFSc_End) -ENDIF -IF (ALLOCATED(ParamData%F_WMG_End)) THEN - DEALLOCATE(ParamData%F_WMG_End) -ENDIF -IF (ALLOCATED(ParamData%DP_Const_End)) THEN - DEALLOCATE(ParamData%DP_Const_End) -ENDIF -IF (ALLOCATED(ParamData%Mass_MG_End)) THEN - DEALLOCATE(ParamData%Mass_MG_End) -ENDIF -IF (ALLOCATED(ParamData%AM_End)) THEN - DEALLOCATE(ParamData%AM_End) -ENDIF -IF (ALLOCATED(ParamData%MOutLst)) THEN -DO i1 = LBOUND(ParamData%MOutLst,1), UBOUND(ParamData%MOutLst,1) - CALL Morison_DestroyMOutput( ParamData%MOutLst(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%MOutLst) -ENDIF -IF (ALLOCATED(ParamData%JOutLst)) THEN -DO i1 = LBOUND(ParamData%JOutLst,1), UBOUND(ParamData%JOutLst,1) - CALL Morison_DestroyJOutput( ParamData%JOutLst(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%JOutLst) -ENDIF -IF (ALLOCATED(ParamData%OutParam)) THEN -DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_DestroyOutParmType( ParamData%OutParam(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%OutParam) -ENDIF -NULLIFY(ParamData%WaveField) - END SUBROUTINE Morison_DestroyParam +subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(Morison_ParameterType), intent(in) :: SrcParamData + type(Morison_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Morison_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%DT = SrcParamData%DT + DstParamData%Gravity = SrcParamData%Gravity + DstParamData%WtrDens = SrcParamData%WtrDens + DstParamData%WtrDpth = SrcParamData%WtrDpth + DstParamData%MSL2SWL = SrcParamData%MSL2SWL + DstParamData%WaveDisp = SrcParamData%WaveDisp + DstParamData%AMMod = SrcParamData%AMMod + DstParamData%NMembers = SrcParamData%NMembers + if (allocated(SrcParamData%Members)) then + LB(1:1) = lbound(SrcParamData%Members) + UB(1:1) = ubound(SrcParamData%Members) + if (.not. allocated(DstParamData%Members)) then + allocate(DstParamData%Members(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Members.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Morison_CopyMemberType(SrcParamData%Members(i1), DstParamData%Members(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstParamData%Members)) then + deallocate(DstParamData%Members) + end if + DstParamData%NNodes = SrcParamData%NNodes + DstParamData%NJoints = SrcParamData%NJoints + if (allocated(SrcParamData%I_MG_End)) then + LB(1:3) = lbound(SrcParamData%I_MG_End) + UB(1:3) = ubound(SrcParamData%I_MG_End) + if (.not. allocated(DstParamData%I_MG_End)) then + allocate(DstParamData%I_MG_End(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%I_MG_End.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%I_MG_End = SrcParamData%I_MG_End + else if (allocated(DstParamData%I_MG_End)) then + deallocate(DstParamData%I_MG_End) + end if + if (allocated(SrcParamData%An_End)) then + LB(1:2) = lbound(SrcParamData%An_End) + UB(1:2) = ubound(SrcParamData%An_End) + if (.not. allocated(DstParamData%An_End)) then + allocate(DstParamData%An_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%An_End.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%An_End = SrcParamData%An_End + else if (allocated(DstParamData%An_End)) then + deallocate(DstParamData%An_End) + end if + if (allocated(SrcParamData%DragConst_End)) then + LB(1:1) = lbound(SrcParamData%DragConst_End) + UB(1:1) = ubound(SrcParamData%DragConst_End) + if (.not. allocated(DstParamData%DragConst_End)) then + allocate(DstParamData%DragConst_End(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DragConst_End.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%DragConst_End = SrcParamData%DragConst_End + else if (allocated(DstParamData%DragConst_End)) then + deallocate(DstParamData%DragConst_End) + end if + if (allocated(SrcParamData%VRelNFiltConst)) then + LB(1:1) = lbound(SrcParamData%VRelNFiltConst) + UB(1:1) = ubound(SrcParamData%VRelNFiltConst) + if (.not. allocated(DstParamData%VRelNFiltConst)) then + allocate(DstParamData%VRelNFiltConst(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%VRelNFiltConst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%VRelNFiltConst = SrcParamData%VRelNFiltConst + else if (allocated(DstParamData%VRelNFiltConst)) then + deallocate(DstParamData%VRelNFiltConst) + end if + if (allocated(SrcParamData%DragMod_End)) then + LB(1:1) = lbound(SrcParamData%DragMod_End) + UB(1:1) = ubound(SrcParamData%DragMod_End) + if (.not. allocated(DstParamData%DragMod_End)) then + allocate(DstParamData%DragMod_End(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DragMod_End.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%DragMod_End = SrcParamData%DragMod_End + else if (allocated(DstParamData%DragMod_End)) then + deallocate(DstParamData%DragMod_End) + end if + if (allocated(SrcParamData%DragLoFSc_End)) then + LB(1:1) = lbound(SrcParamData%DragLoFSc_End) + UB(1:1) = ubound(SrcParamData%DragLoFSc_End) + if (.not. allocated(DstParamData%DragLoFSc_End)) then + allocate(DstParamData%DragLoFSc_End(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DragLoFSc_End.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%DragLoFSc_End = SrcParamData%DragLoFSc_End + else if (allocated(DstParamData%DragLoFSc_End)) then + deallocate(DstParamData%DragLoFSc_End) + end if + if (allocated(SrcParamData%F_WMG_End)) then + LB(1:2) = lbound(SrcParamData%F_WMG_End) + UB(1:2) = ubound(SrcParamData%F_WMG_End) + if (.not. allocated(DstParamData%F_WMG_End)) then + allocate(DstParamData%F_WMG_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%F_WMG_End.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%F_WMG_End = SrcParamData%F_WMG_End + else if (allocated(DstParamData%F_WMG_End)) then + deallocate(DstParamData%F_WMG_End) + end if + if (allocated(SrcParamData%DP_Const_End)) then + LB(1:2) = lbound(SrcParamData%DP_Const_End) + UB(1:2) = ubound(SrcParamData%DP_Const_End) + if (.not. allocated(DstParamData%DP_Const_End)) then + allocate(DstParamData%DP_Const_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DP_Const_End.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%DP_Const_End = SrcParamData%DP_Const_End + else if (allocated(DstParamData%DP_Const_End)) then + deallocate(DstParamData%DP_Const_End) + end if + if (allocated(SrcParamData%Mass_MG_End)) then + LB(1:1) = lbound(SrcParamData%Mass_MG_End) + UB(1:1) = ubound(SrcParamData%Mass_MG_End) + if (.not. allocated(DstParamData%Mass_MG_End)) then + allocate(DstParamData%Mass_MG_End(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Mass_MG_End.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Mass_MG_End = SrcParamData%Mass_MG_End + else if (allocated(DstParamData%Mass_MG_End)) then + deallocate(DstParamData%Mass_MG_End) + end if + if (allocated(SrcParamData%AM_End)) then + LB(1:3) = lbound(SrcParamData%AM_End) + UB(1:3) = ubound(SrcParamData%AM_End) + if (.not. allocated(DstParamData%AM_End)) then + allocate(DstParamData%AM_End(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AM_End.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AM_End = SrcParamData%AM_End + else if (allocated(DstParamData%AM_End)) then + deallocate(DstParamData%AM_End) + end if + DstParamData%NStepWave = SrcParamData%NStepWave + DstParamData%NMOutputs = SrcParamData%NMOutputs + if (allocated(SrcParamData%MOutLst)) then + LB(1:1) = lbound(SrcParamData%MOutLst) + UB(1:1) = ubound(SrcParamData%MOutLst) + if (.not. allocated(DstParamData%MOutLst)) then + allocate(DstParamData%MOutLst(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MOutLst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Morison_CopyMOutput(SrcParamData%MOutLst(i1), DstParamData%MOutLst(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstParamData%MOutLst)) then + deallocate(DstParamData%MOutLst) + end if + DstParamData%NJOutputs = SrcParamData%NJOutputs + if (allocated(SrcParamData%JOutLst)) then + LB(1:1) = lbound(SrcParamData%JOutLst) + UB(1:1) = ubound(SrcParamData%JOutLst) + if (.not. allocated(DstParamData%JOutLst)) then + allocate(DstParamData%JOutLst(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%JOutLst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Morison_CopyJOutput(SrcParamData%JOutLst(i1), DstParamData%JOutLst(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstParamData%JOutLst)) then + deallocate(DstParamData%JOutLst) + end if + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstParamData%OutParam)) then + deallocate(DstParamData%OutParam) + end if + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%WaveStMod = SrcParamData%WaveStMod + DstParamData%WaveField => SrcParamData%WaveField +end subroutine +subroutine Morison_DestroyParam(ParamData, ErrStat, ErrMsg) + type(Morison_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Morison_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%Members)) then + LB(1:1) = lbound(ParamData%Members) + UB(1:1) = ubound(ParamData%Members) + do i1 = LB(1), UB(1) + call Morison_DestroyMemberType(ParamData%Members(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%Members) + end if + if (allocated(ParamData%I_MG_End)) then + deallocate(ParamData%I_MG_End) + end if + if (allocated(ParamData%An_End)) then + deallocate(ParamData%An_End) + end if + if (allocated(ParamData%DragConst_End)) then + deallocate(ParamData%DragConst_End) + end if + if (allocated(ParamData%VRelNFiltConst)) then + deallocate(ParamData%VRelNFiltConst) + end if + if (allocated(ParamData%DragMod_End)) then + deallocate(ParamData%DragMod_End) + end if + if (allocated(ParamData%DragLoFSc_End)) then + deallocate(ParamData%DragLoFSc_End) + end if + if (allocated(ParamData%F_WMG_End)) then + deallocate(ParamData%F_WMG_End) + end if + if (allocated(ParamData%DP_Const_End)) then + deallocate(ParamData%DP_Const_End) + end if + if (allocated(ParamData%Mass_MG_End)) then + deallocate(ParamData%Mass_MG_End) + end if + if (allocated(ParamData%AM_End)) then + deallocate(ParamData%AM_End) + end if + if (allocated(ParamData%MOutLst)) then + LB(1:1) = lbound(ParamData%MOutLst) + UB(1:1) = ubound(ParamData%MOutLst) + do i1 = LB(1), UB(1) + call Morison_DestroyMOutput(ParamData%MOutLst(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%MOutLst) + end if + if (allocated(ParamData%JOutLst)) then + LB(1:1) = lbound(ParamData%JOutLst) + UB(1:1) = ubound(ParamData%JOutLst) + do i1 = LB(1), UB(1) + call Morison_DestroyJOutput(ParamData%JOutLst(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%JOutLst) + end if + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%OutParam) + end if + nullify(ParamData%WaveField) +end subroutine subroutine Morison_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -6610,31 +6038,22 @@ subroutine Morison_PackParam(Buf, Indata) integer(IntKi) :: LB(3), UB(3) logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return - ! DT call RegPack(Buf, InData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! Gravity call RegPack(Buf, InData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDens call RegPack(Buf, InData%WtrDens) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDpth call RegPack(Buf, InData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - ! MSL2SWL call RegPack(Buf, InData%MSL2SWL) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDisp call RegPack(Buf, InData%WaveDisp) if (RegCheckErr(Buf, RoutineName)) return - ! AMMod call RegPack(Buf, InData%AMMod) if (RegCheckErr(Buf, RoutineName)) return - ! NMembers call RegPack(Buf, InData%NMembers) if (RegCheckErr(Buf, RoutineName)) return - ! Members call RegPack(Buf, allocated(InData%Members)) if (allocated(InData%Members)) then call RegPackBounds(Buf, 1, lbound(InData%Members), ubound(InData%Members)) @@ -6645,89 +6064,74 @@ subroutine Morison_PackParam(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! NNodes call RegPack(Buf, InData%NNodes) if (RegCheckErr(Buf, RoutineName)) return - ! NJoints call RegPack(Buf, InData%NJoints) if (RegCheckErr(Buf, RoutineName)) return - ! I_MG_End call RegPack(Buf, allocated(InData%I_MG_End)) if (allocated(InData%I_MG_End)) then call RegPackBounds(Buf, 3, lbound(InData%I_MG_End), ubound(InData%I_MG_End)) call RegPack(Buf, InData%I_MG_End) end if if (RegCheckErr(Buf, RoutineName)) return - ! An_End call RegPack(Buf, allocated(InData%An_End)) if (allocated(InData%An_End)) then call RegPackBounds(Buf, 2, lbound(InData%An_End), ubound(InData%An_End)) call RegPack(Buf, InData%An_End) end if if (RegCheckErr(Buf, RoutineName)) return - ! DragConst_End call RegPack(Buf, allocated(InData%DragConst_End)) if (allocated(InData%DragConst_End)) then call RegPackBounds(Buf, 1, lbound(InData%DragConst_End), ubound(InData%DragConst_End)) call RegPack(Buf, InData%DragConst_End) end if if (RegCheckErr(Buf, RoutineName)) return - ! VRelNFiltConst call RegPack(Buf, allocated(InData%VRelNFiltConst)) if (allocated(InData%VRelNFiltConst)) then call RegPackBounds(Buf, 1, lbound(InData%VRelNFiltConst), ubound(InData%VRelNFiltConst)) call RegPack(Buf, InData%VRelNFiltConst) end if if (RegCheckErr(Buf, RoutineName)) return - ! DragMod_End call RegPack(Buf, allocated(InData%DragMod_End)) if (allocated(InData%DragMod_End)) then call RegPackBounds(Buf, 1, lbound(InData%DragMod_End), ubound(InData%DragMod_End)) call RegPack(Buf, InData%DragMod_End) end if if (RegCheckErr(Buf, RoutineName)) return - ! DragLoFSc_End call RegPack(Buf, allocated(InData%DragLoFSc_End)) if (allocated(InData%DragLoFSc_End)) then call RegPackBounds(Buf, 1, lbound(InData%DragLoFSc_End), ubound(InData%DragLoFSc_End)) call RegPack(Buf, InData%DragLoFSc_End) end if if (RegCheckErr(Buf, RoutineName)) return - ! F_WMG_End call RegPack(Buf, allocated(InData%F_WMG_End)) if (allocated(InData%F_WMG_End)) then call RegPackBounds(Buf, 2, lbound(InData%F_WMG_End), ubound(InData%F_WMG_End)) call RegPack(Buf, InData%F_WMG_End) end if if (RegCheckErr(Buf, RoutineName)) return - ! DP_Const_End call RegPack(Buf, allocated(InData%DP_Const_End)) if (allocated(InData%DP_Const_End)) then call RegPackBounds(Buf, 2, lbound(InData%DP_Const_End), ubound(InData%DP_Const_End)) call RegPack(Buf, InData%DP_Const_End) end if if (RegCheckErr(Buf, RoutineName)) return - ! Mass_MG_End call RegPack(Buf, allocated(InData%Mass_MG_End)) if (allocated(InData%Mass_MG_End)) then call RegPackBounds(Buf, 1, lbound(InData%Mass_MG_End), ubound(InData%Mass_MG_End)) call RegPack(Buf, InData%Mass_MG_End) end if if (RegCheckErr(Buf, RoutineName)) return - ! AM_End call RegPack(Buf, allocated(InData%AM_End)) if (allocated(InData%AM_End)) then call RegPackBounds(Buf, 3, lbound(InData%AM_End), ubound(InData%AM_End)) call RegPack(Buf, InData%AM_End) end if if (RegCheckErr(Buf, RoutineName)) return - ! NStepWave call RegPack(Buf, InData%NStepWave) if (RegCheckErr(Buf, RoutineName)) return - ! NMOutputs call RegPack(Buf, InData%NMOutputs) if (RegCheckErr(Buf, RoutineName)) return - ! MOutLst call RegPack(Buf, allocated(InData%MOutLst)) if (allocated(InData%MOutLst)) then call RegPackBounds(Buf, 1, lbound(InData%MOutLst), ubound(InData%MOutLst)) @@ -6738,10 +6142,8 @@ subroutine Morison_PackParam(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! NJOutputs call RegPack(Buf, InData%NJOutputs) if (RegCheckErr(Buf, RoutineName)) return - ! JOutLst call RegPack(Buf, allocated(InData%JOutLst)) if (allocated(InData%JOutLst)) then call RegPackBounds(Buf, 1, lbound(InData%JOutLst), ubound(InData%JOutLst)) @@ -6752,7 +6154,6 @@ subroutine Morison_PackParam(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! OutParam call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) @@ -6763,13 +6164,10 @@ subroutine Morison_PackParam(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegPack(Buf, InData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! WaveStMod call RegPack(Buf, InData%WaveStMod) if (RegCheckErr(Buf, RoutineName)) return - ! WaveField call RegPack(Buf, associated(InData%WaveField)) if (associated(InData%WaveField)) then call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) @@ -6791,31 +6189,22 @@ subroutine Morison_UnPackParam(Buf, OutData) integer(IntKi) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return - ! DT call RegUnpack(Buf, OutData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! Gravity call RegUnpack(Buf, OutData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDens call RegUnpack(Buf, OutData%WtrDens) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDpth call RegUnpack(Buf, OutData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - ! MSL2SWL call RegUnpack(Buf, OutData%MSL2SWL) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDisp call RegUnpack(Buf, OutData%WaveDisp) if (RegCheckErr(Buf, RoutineName)) return - ! AMMod call RegUnpack(Buf, OutData%AMMod) if (RegCheckErr(Buf, RoutineName)) return - ! NMembers call RegUnpack(Buf, OutData%NMembers) if (RegCheckErr(Buf, RoutineName)) return - ! Members if (allocated(OutData%Members)) deallocate(OutData%Members) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6831,13 +6220,10 @@ subroutine Morison_UnPackParam(Buf, OutData) call Morison_UnpackMemberType(Buf, OutData%Members(i1)) ! Members end do end if - ! NNodes call RegUnpack(Buf, OutData%NNodes) if (RegCheckErr(Buf, RoutineName)) return - ! NJoints call RegUnpack(Buf, OutData%NJoints) if (RegCheckErr(Buf, RoutineName)) return - ! I_MG_End if (allocated(OutData%I_MG_End)) deallocate(OutData%I_MG_End) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6852,7 +6238,6 @@ subroutine Morison_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%I_MG_End) if (RegCheckErr(Buf, RoutineName)) return end if - ! An_End if (allocated(OutData%An_End)) deallocate(OutData%An_End) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6867,7 +6252,6 @@ subroutine Morison_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%An_End) if (RegCheckErr(Buf, RoutineName)) return end if - ! DragConst_End if (allocated(OutData%DragConst_End)) deallocate(OutData%DragConst_End) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6882,7 +6266,6 @@ subroutine Morison_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%DragConst_End) if (RegCheckErr(Buf, RoutineName)) return end if - ! VRelNFiltConst if (allocated(OutData%VRelNFiltConst)) deallocate(OutData%VRelNFiltConst) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6897,7 +6280,6 @@ subroutine Morison_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%VRelNFiltConst) if (RegCheckErr(Buf, RoutineName)) return end if - ! DragMod_End if (allocated(OutData%DragMod_End)) deallocate(OutData%DragMod_End) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6912,7 +6294,6 @@ subroutine Morison_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%DragMod_End) if (RegCheckErr(Buf, RoutineName)) return end if - ! DragLoFSc_End if (allocated(OutData%DragLoFSc_End)) deallocate(OutData%DragLoFSc_End) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6927,7 +6308,6 @@ subroutine Morison_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%DragLoFSc_End) if (RegCheckErr(Buf, RoutineName)) return end if - ! F_WMG_End if (allocated(OutData%F_WMG_End)) deallocate(OutData%F_WMG_End) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6942,7 +6322,6 @@ subroutine Morison_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%F_WMG_End) if (RegCheckErr(Buf, RoutineName)) return end if - ! DP_Const_End if (allocated(OutData%DP_Const_End)) deallocate(OutData%DP_Const_End) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6957,7 +6336,6 @@ subroutine Morison_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%DP_Const_End) if (RegCheckErr(Buf, RoutineName)) return end if - ! Mass_MG_End if (allocated(OutData%Mass_MG_End)) deallocate(OutData%Mass_MG_End) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6972,7 +6350,6 @@ subroutine Morison_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%Mass_MG_End) if (RegCheckErr(Buf, RoutineName)) return end if - ! AM_End if (allocated(OutData%AM_End)) deallocate(OutData%AM_End) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6987,13 +6364,10 @@ subroutine Morison_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%AM_End) if (RegCheckErr(Buf, RoutineName)) return end if - ! NStepWave call RegUnpack(Buf, OutData%NStepWave) if (RegCheckErr(Buf, RoutineName)) return - ! NMOutputs call RegUnpack(Buf, OutData%NMOutputs) if (RegCheckErr(Buf, RoutineName)) return - ! MOutLst if (allocated(OutData%MOutLst)) deallocate(OutData%MOutLst) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7009,10 +6383,8 @@ subroutine Morison_UnPackParam(Buf, OutData) call Morison_UnpackMOutput(Buf, OutData%MOutLst(i1)) ! MOutLst end do end if - ! NJOutputs call RegUnpack(Buf, OutData%NJOutputs) if (RegCheckErr(Buf, RoutineName)) return - ! JOutLst if (allocated(OutData%JOutLst)) deallocate(OutData%JOutLst) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7028,7 +6400,6 @@ subroutine Morison_UnPackParam(Buf, OutData) call Morison_UnpackJOutput(Buf, OutData%JOutLst(i1)) ! JOutLst end do end if - ! OutParam if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7044,13 +6415,10 @@ subroutine Morison_UnPackParam(Buf, OutData) call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam end do end if - ! NumOuts call RegUnpack(Buf, OutData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! WaveStMod call RegUnpack(Buf, OutData%WaveStMod) if (RegCheckErr(Buf, RoutineName)) return - ! WaveField if (associated(OutData%WaveField)) deallocate(OutData%WaveField) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7072,49 +6440,39 @@ subroutine Morison_UnPackParam(Buf, OutData) OutData%WaveField => null() end if end subroutine - SUBROUTINE Morison_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_InputType), INTENT(INOUT) :: SrcInputData - TYPE(Morison_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_CopyInput' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcInputData%Mesh, DstInputData%Mesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE Morison_CopyInput - - SUBROUTINE Morison_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(Morison_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - CALL MeshDestroy( InputData%Mesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE Morison_DestroyInput +subroutine Morison_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(Morison_InputType), intent(inout) :: SrcInputData + type(Morison_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Morison_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcInputData%Mesh, DstInputData%Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine Morison_DestroyInput(InputData, ErrStat, ErrMsg) + type(Morison_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Morison_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine Morison_PackInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Morison_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackInput' if (Buf%ErrStat >= AbortErrLev) return - ! Mesh call MeshPack(Buf, InData%Mesh) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -7124,71 +6482,61 @@ subroutine Morison_UnPackInput(Buf, OutData) type(Morison_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackInput' if (Buf%ErrStat /= ErrID_None) return - ! Mesh call MeshUnpack(Buf, OutData%Mesh) ! Mesh end subroutine - SUBROUTINE Morison_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(Morison_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_CopyOutput' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcOutputData%Mesh, DstOutputData%Mesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcOutputData%WriteOutput)) THEN - i1_l = LBOUND(SrcOutputData%WriteOutput,1) - i1_u = UBOUND(SrcOutputData%WriteOutput,1) - IF (.NOT. ALLOCATED(DstOutputData%WriteOutput)) THEN - ALLOCATE(DstOutputData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%WriteOutput = SrcOutputData%WriteOutput -ENDIF - END SUBROUTINE Morison_CopyOutput - - SUBROUTINE Morison_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(Morison_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_DestroyOutput' - ErrStat = ErrID_None - ErrMsg = "" - - CALL MeshDestroy( OutputData%Mesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - END SUBROUTINE Morison_DestroyOutput +subroutine Morison_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(Morison_OutputType), intent(inout) :: SrcOutputData + type(Morison_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Morison_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcOutputData%Mesh, DstOutputData%Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%WriteOutput = SrcOutputData%WriteOutput + else if (allocated(DstOutputData%WriteOutput)) then + deallocate(DstOutputData%WriteOutput) + end if +end subroutine +subroutine Morison_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(Morison_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Morison_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine subroutine Morison_PackOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Morison_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackOutput' if (Buf%ErrStat >= AbortErrLev) return - ! Mesh call MeshPack(Buf, InData%Mesh) if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutput call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) @@ -7205,9 +6553,7 @@ subroutine Morison_UnPackOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! Mesh call MeshUnpack(Buf, OutData%Mesh) ! Mesh - ! WriteOutput if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/hydrodyn/src/SS_Excitation_Types.f90 b/modules/hydrodyn/src/SS_Excitation_Types.f90 index 350b0b3bff..1df2409362 100644 --- a/modules/hydrodyn/src/SS_Excitation_Types.f90 +++ b/modules/hydrodyn/src/SS_Excitation_Types.f90 @@ -111,71 +111,62 @@ MODULE SS_Excitation_Types END TYPE SS_Exc_OutputType ! ======================= CONTAINS - SUBROUTINE SS_Exc_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Exc_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(SS_Exc_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_CopyInitInput' -! + +subroutine SS_Exc_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(SS_Exc_InitInputType), intent(in) :: SrcInitInputData + type(SS_Exc_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SS_Exc_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFile = SrcInitInputData%InputFile - DstInitInputData%NBody = SrcInitInputData%NBody - DstInitInputData%ExctnDisp = SrcInitInputData%ExctnDisp - DstInitInputData%WaveDir = SrcInitInputData%WaveDir - DstInitInputData%NStepWave = SrcInitInputData%NStepWave -IF (ALLOCATED(SrcInitInputData%PtfmRefztRot)) THEN - i1_l = LBOUND(SrcInitInputData%PtfmRefztRot,1) - i1_u = UBOUND(SrcInitInputData%PtfmRefztRot,1) - IF (.NOT. ALLOCATED(DstInitInputData%PtfmRefztRot)) THEN - ALLOCATE(DstInitInputData%PtfmRefztRot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefztRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PtfmRefztRot = SrcInitInputData%PtfmRefztRot -ENDIF - DstInitInputData%WaveElev0 => SrcInitInputData%WaveElev0 - DstInitInputData%WaveElev1 => SrcInitInputData%WaveElev1 - DstInitInputData%WaveTime => SrcInitInputData%WaveTime - CALL SeaSt_Interp_CopyParam( SrcInitInputData%SeaSt_Interp_p, DstInitInputData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE SS_Exc_CopyInitInput - - SUBROUTINE SS_Exc_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(SS_Exc_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitInputData%PtfmRefztRot)) THEN - DEALLOCATE(InitInputData%PtfmRefztRot) -ENDIF -NULLIFY(InitInputData%WaveElev0) -NULLIFY(InitInputData%WaveElev1) -NULLIFY(InitInputData%WaveTime) - CALL SeaSt_Interp_DestroyParam( InitInputData%SeaSt_Interp_p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE SS_Exc_DestroyInitInput + ErrMsg = '' + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%NBody = SrcInitInputData%NBody + DstInitInputData%ExctnDisp = SrcInitInputData%ExctnDisp + DstInitInputData%WaveDir = SrcInitInputData%WaveDir + DstInitInputData%NStepWave = SrcInitInputData%NStepWave + if (allocated(SrcInitInputData%PtfmRefztRot)) then + LB(1:1) = lbound(SrcInitInputData%PtfmRefztRot) + UB(1:1) = ubound(SrcInitInputData%PtfmRefztRot) + if (.not. allocated(DstInitInputData%PtfmRefztRot)) then + allocate(DstInitInputData%PtfmRefztRot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefztRot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%PtfmRefztRot = SrcInitInputData%PtfmRefztRot + else if (allocated(DstInitInputData%PtfmRefztRot)) then + deallocate(DstInitInputData%PtfmRefztRot) + end if + DstInitInputData%WaveElev0 => SrcInitInputData%WaveElev0 + DstInitInputData%WaveElev1 => SrcInitInputData%WaveElev1 + DstInitInputData%WaveTime => SrcInitInputData%WaveTime + call SeaSt_Interp_CopyParam(SrcInitInputData%SeaSt_Interp_p, DstInitInputData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine SS_Exc_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(SS_Exc_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SS_Exc_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitInputData%PtfmRefztRot)) then + deallocate(InitInputData%PtfmRefztRot) + end if + nullify(InitInputData%WaveElev0) + nullify(InitInputData%WaveElev1) + nullify(InitInputData%WaveTime) +end subroutine subroutine SS_Exc_PackInitInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -183,29 +174,22 @@ subroutine SS_Exc_PackInitInput(Buf, Indata) character(*), parameter :: RoutineName = 'SS_Exc_PackInitInput' logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return - ! InputFile call RegPack(Buf, InData%InputFile) if (RegCheckErr(Buf, RoutineName)) return - ! NBody call RegPack(Buf, InData%NBody) if (RegCheckErr(Buf, RoutineName)) return - ! ExctnDisp call RegPack(Buf, InData%ExctnDisp) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDir call RegPack(Buf, InData%WaveDir) if (RegCheckErr(Buf, RoutineName)) return - ! NStepWave call RegPack(Buf, InData%NStepWave) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmRefztRot call RegPack(Buf, allocated(InData%PtfmRefztRot)) if (allocated(InData%PtfmRefztRot)) then call RegPackBounds(Buf, 1, lbound(InData%PtfmRefztRot), ubound(InData%PtfmRefztRot)) call RegPack(Buf, InData%PtfmRefztRot) end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveElev0 call RegPack(Buf, associated(InData%WaveElev0)) if (associated(InData%WaveElev0)) then call RegPackBounds(Buf, 1, lbound(InData%WaveElev0), ubound(InData%WaveElev0)) @@ -215,7 +199,6 @@ subroutine SS_Exc_PackInitInput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveElev1 call RegPack(Buf, associated(InData%WaveElev1)) if (associated(InData%WaveElev1)) then call RegPackBounds(Buf, 3, lbound(InData%WaveElev1), ubound(InData%WaveElev1)) @@ -225,7 +208,6 @@ subroutine SS_Exc_PackInitInput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveTime call RegPack(Buf, associated(InData%WaveTime)) if (associated(InData%WaveTime)) then call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) @@ -235,7 +217,6 @@ subroutine SS_Exc_PackInitInput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! SeaSt_Interp_p call SeaSt_Interp_PackParam(Buf, InData%SeaSt_Interp_p) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -250,22 +231,16 @@ subroutine SS_Exc_UnPackInitInput(Buf, OutData) integer(IntKi) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return - ! InputFile call RegUnpack(Buf, OutData%InputFile) if (RegCheckErr(Buf, RoutineName)) return - ! NBody call RegUnpack(Buf, OutData%NBody) if (RegCheckErr(Buf, RoutineName)) return - ! ExctnDisp call RegUnpack(Buf, OutData%ExctnDisp) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDir call RegUnpack(Buf, OutData%WaveDir) if (RegCheckErr(Buf, RoutineName)) return - ! NStepWave call RegUnpack(Buf, OutData%NStepWave) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmRefztRot if (allocated(OutData%PtfmRefztRot)) deallocate(OutData%PtfmRefztRot) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -280,7 +255,6 @@ subroutine SS_Exc_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%PtfmRefztRot) if (RegCheckErr(Buf, RoutineName)) return end if - ! WaveElev0 if (associated(OutData%WaveElev0)) deallocate(OutData%WaveElev0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -305,7 +279,6 @@ subroutine SS_Exc_UnPackInitInput(Buf, OutData) else OutData%WaveElev0 => null() end if - ! WaveElev1 if (associated(OutData%WaveElev1)) deallocate(OutData%WaveElev1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -330,7 +303,6 @@ subroutine SS_Exc_UnPackInitInput(Buf, OutData) else OutData%WaveElev1 => null() end if - ! WaveTime if (associated(OutData%WaveTime)) deallocate(OutData%WaveTime) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -355,85 +327,76 @@ subroutine SS_Exc_UnPackInitInput(Buf, OutData) else OutData%WaveTime => null() end if - ! SeaSt_Interp_p call SeaSt_Interp_UnpackParam(Buf, OutData%SeaSt_Interp_p) ! SeaSt_Interp_p end subroutine - SUBROUTINE SS_Exc_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Exc_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(SS_Exc_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_CopyInitOutput' -! + +subroutine SS_Exc_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(SS_Exc_InitOutputType), intent(in) :: SrcInitOutputData + type(SS_Exc_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SS_Exc_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInitOutputData%WriteOutputHdr)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputHdr,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputHdr,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputHdr)) THEN - ALLOCATE(DstInitOutputData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr -ENDIF -IF (ALLOCATED(SrcInitOutputData%WriteOutputUnt)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputUnt,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputUnt,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputUnt)) THEN - ALLOCATE(DstInitOutputData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt -ENDIF - END SUBROUTINE SS_Exc_CopyInitOutput - - SUBROUTINE SS_Exc_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(SS_Exc_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF - END SUBROUTINE SS_Exc_DestroyInitOutput + ErrMsg = '' + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr + else if (allocated(DstInitOutputData%WriteOutputHdr)) then + deallocate(DstInitOutputData%WriteOutputHdr) + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt + else if (allocated(DstInitOutputData%WriteOutputUnt)) then + deallocate(DstInitOutputData%WriteOutputUnt) + end if +end subroutine +subroutine SS_Exc_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(SS_Exc_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Exc_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if +end subroutine subroutine SS_Exc_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SS_Exc_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SS_Exc_PackInitOutput' if (Buf%ErrStat >= AbortErrLev) return - ! WriteOutputHdr call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) call RegPack(Buf, InData%WriteOutputHdr) end if if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutputUnt call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) @@ -450,7 +413,6 @@ subroutine SS_Exc_UnPackInitOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! WriteOutputHdr if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -465,7 +427,6 @@ subroutine SS_Exc_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutputHdr) if (RegCheckErr(Buf, RoutineName)) return end if - ! WriteOutputUnt if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -481,60 +442,51 @@ subroutine SS_Exc_UnPackInitOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE SS_Exc_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Exc_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(SS_Exc_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_CopyContState' -! + +subroutine SS_Exc_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(SS_Exc_ContinuousStateType), intent(in) :: SrcContStateData + type(SS_Exc_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SS_Exc_CopyContState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcContStateData%x)) THEN - i1_l = LBOUND(SrcContStateData%x,1) - i1_u = UBOUND(SrcContStateData%x,1) - IF (.NOT. ALLOCATED(DstContStateData%x)) THEN - ALLOCATE(DstContStateData%x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstContStateData%x = SrcContStateData%x -ENDIF - END SUBROUTINE SS_Exc_CopyContState - - SUBROUTINE SS_Exc_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(SS_Exc_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ContStateData%x)) THEN - DEALLOCATE(ContStateData%x) -ENDIF - END SUBROUTINE SS_Exc_DestroyContState + ErrMsg = '' + if (allocated(SrcContStateData%x)) then + LB(1:1) = lbound(SrcContStateData%x) + UB(1:1) = ubound(SrcContStateData%x) + if (.not. allocated(DstContStateData%x)) then + allocate(DstContStateData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstContStateData%x = SrcContStateData%x + else if (allocated(DstContStateData%x)) then + deallocate(DstContStateData%x) + end if +end subroutine +subroutine SS_Exc_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(SS_Exc_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Exc_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ContStateData%x)) then + deallocate(ContStateData%x) + end if +end subroutine subroutine SS_Exc_PackContState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SS_Exc_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SS_Exc_PackContState' if (Buf%ErrStat >= AbortErrLev) return - ! x call RegPack(Buf, allocated(InData%x)) if (allocated(InData%x)) then call RegPackBounds(Buf, 1, lbound(InData%x), ubound(InData%x)) @@ -551,7 +503,6 @@ subroutine SS_Exc_UnPackContState(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! x if (allocated(OutData%x)) deallocate(OutData%x) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -567,45 +518,33 @@ subroutine SS_Exc_UnPackContState(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE SS_Exc_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Exc_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(SS_Exc_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState - END SUBROUTINE SS_Exc_CopyDiscState - - SUBROUTINE SS_Exc_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(SS_Exc_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyDiscState' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE SS_Exc_DestroyDiscState +subroutine SS_Exc_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(SS_Exc_DiscreteStateType), intent(in) :: SrcDiscStateData + type(SS_Exc_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Exc_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState +end subroutine +subroutine SS_Exc_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(SS_Exc_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Exc_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine SS_Exc_PackDiscState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SS_Exc_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SS_Exc_PackDiscState' if (Buf%ErrStat >= AbortErrLev) return - ! DummyDiscState call RegPack(Buf, InData%DummyDiscState) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -615,49 +554,36 @@ subroutine SS_Exc_UnPackDiscState(Buf, OutData) type(SS_Exc_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Exc_UnPackDiscState' if (Buf%ErrStat /= ErrID_None) return - ! DummyDiscState call RegUnpack(Buf, OutData%DummyDiscState) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE SS_Exc_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Exc_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(SS_Exc_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE SS_Exc_CopyConstrState - SUBROUTINE SS_Exc_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(SS_Exc_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE SS_Exc_DestroyConstrState +subroutine SS_Exc_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(SS_Exc_ConstraintStateType), intent(in) :: SrcConstrStateData + type(SS_Exc_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Exc_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine +subroutine SS_Exc_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(SS_Exc_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Exc_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine SS_Exc_PackConstrState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SS_Exc_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SS_Exc_PackConstrState' if (Buf%ErrStat >= AbortErrLev) return - ! DummyConstrState call RegPack(Buf, InData%DummyConstrState) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -667,52 +593,43 @@ subroutine SS_Exc_UnPackConstrState(Buf, OutData) type(SS_Exc_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Exc_UnPackConstrState' if (Buf%ErrStat /= ErrID_None) return - ! DummyConstrState call RegUnpack(Buf, OutData%DummyConstrState) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE SS_Exc_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Exc_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(SS_Exc_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_CopyOtherState' -! + +subroutine SS_Exc_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(SS_Exc_OtherStateType), intent(in) :: SrcOtherStateData + type(SS_Exc_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SS_Exc_CopyOtherState' ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%n = SrcOtherStateData%n - DO i1 = LBOUND(SrcOtherStateData%xdot,1), UBOUND(SrcOtherStateData%xdot,1) - CALL SS_Exc_CopyContState( SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - END SUBROUTINE SS_Exc_CopyOtherState - - SUBROUTINE SS_Exc_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(SS_Exc_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(OtherStateData%xdot,1), UBOUND(OtherStateData%xdot,1) - CALL SS_Exc_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - END SUBROUTINE SS_Exc_DestroyOtherState + ErrMsg = '' + DstOtherStateData%n = SrcOtherStateData%n + do i1 = LB(1), UB(1) + call SS_Exc_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do +end subroutine +subroutine SS_Exc_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(SS_Exc_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SS_Exc_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine SS_Exc_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -721,10 +638,8 @@ subroutine SS_Exc_PackOtherState(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! n call RegPack(Buf, InData%n) if (RegCheckErr(Buf, RoutineName)) return - ! xdot LB(1:1) = lbound(InData%xdot) UB(1:1) = ubound(InData%xdot) do i1 = LB(1), UB(1) @@ -740,63 +655,50 @@ subroutine SS_Exc_UnPackOtherState(Buf, OutData) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat /= ErrID_None) return - ! n call RegUnpack(Buf, OutData%n) if (RegCheckErr(Buf, RoutineName)) return - ! xdot LB(1:1) = lbound(OutData%xdot) UB(1:1) = ubound(OutData%xdot) do i1 = LB(1), UB(1) call SS_Exc_UnpackContState(Buf, OutData%xdot(i1)) ! xdot end do end subroutine - SUBROUTINE SS_Exc_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Exc_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(SS_Exc_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_CopyMisc' -! + +subroutine SS_Exc_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(SS_Exc_MiscVarType), intent(in) :: SrcMiscData + type(SS_Exc_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SS_Exc_CopyMisc' ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%LastIndWave = SrcMiscData%LastIndWave - CALL SeaSt_Interp_CopyMisc( SrcMiscData%SeaSt_Interp_m, DstMiscData%SeaSt_Interp_m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE SS_Exc_CopyMisc - - SUBROUTINE SS_Exc_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(SS_Exc_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL SeaSt_Interp_DestroyMisc( MiscData%SeaSt_Interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE SS_Exc_DestroyMisc + ErrMsg = '' + DstMiscData%LastIndWave = SrcMiscData%LastIndWave + call SeaSt_Interp_CopyMisc(SrcMiscData%SeaSt_Interp_m, DstMiscData%SeaSt_Interp_m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine SS_Exc_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(SS_Exc_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SS_Exc_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine SS_Exc_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SS_Exc_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'SS_Exc_PackMisc' if (Buf%ErrStat >= AbortErrLev) return - ! LastIndWave call RegPack(Buf, InData%LastIndWave) if (RegCheckErr(Buf, RoutineName)) return - ! SeaSt_Interp_m call SeaSt_Interp_PackMisc(Buf, InData%SeaSt_Interp_m) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -806,127 +708,118 @@ subroutine SS_Exc_UnPackMisc(Buf, OutData) type(SS_Exc_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Exc_UnPackMisc' if (Buf%ErrStat /= ErrID_None) return - ! LastIndWave call RegUnpack(Buf, OutData%LastIndWave) if (RegCheckErr(Buf, RoutineName)) return - ! SeaSt_Interp_m call SeaSt_Interp_UnpackMisc(Buf, OutData%SeaSt_Interp_m) ! SeaSt_Interp_m end subroutine - SUBROUTINE SS_Exc_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Exc_ParameterType), INTENT(IN) :: SrcParamData - TYPE(SS_Exc_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (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 = 'SS_Exc_CopyParam' -! + +subroutine SS_Exc_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(SS_Exc_ParameterType), intent(in) :: SrcParamData + type(SS_Exc_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SS_Exc_CopyParam' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT - DstParamData%NBody = SrcParamData%NBody - DstParamData%ExctnDisp = SrcParamData%ExctnDisp - DstParamData%NStepWave = SrcParamData%NStepWave -IF (ALLOCATED(SrcParamData%spDOF)) THEN - i1_l = LBOUND(SrcParamData%spDOF,1) - i1_u = UBOUND(SrcParamData%spDOF,1) - IF (.NOT. ALLOCATED(DstParamData%spDOF)) THEN - ALLOCATE(DstParamData%spDOF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%spDOF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%spDOF = SrcParamData%spDOF -ENDIF -IF (ALLOCATED(SrcParamData%A)) THEN - i1_l = LBOUND(SrcParamData%A,1) - i1_u = UBOUND(SrcParamData%A,1) - i2_l = LBOUND(SrcParamData%A,2) - i2_u = UBOUND(SrcParamData%A,2) - IF (.NOT. ALLOCATED(DstParamData%A)) THEN - ALLOCATE(DstParamData%A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%A.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%A = SrcParamData%A -ENDIF -IF (ALLOCATED(SrcParamData%B)) THEN - i1_l = LBOUND(SrcParamData%B,1) - i1_u = UBOUND(SrcParamData%B,1) - IF (.NOT. ALLOCATED(DstParamData%B)) THEN - ALLOCATE(DstParamData%B(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%B = SrcParamData%B -ENDIF -IF (ALLOCATED(SrcParamData%C)) THEN - i1_l = LBOUND(SrcParamData%C,1) - i1_u = UBOUND(SrcParamData%C,1) - i2_l = LBOUND(SrcParamData%C,2) - i2_u = UBOUND(SrcParamData%C,2) - IF (.NOT. ALLOCATED(DstParamData%C)) THEN - ALLOCATE(DstParamData%C(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%C = SrcParamData%C -ENDIF - DstParamData%numStates = SrcParamData%numStates - DstParamData%Tc = SrcParamData%Tc - DstParamData%WaveElev0 => SrcParamData%WaveElev0 - DstParamData%WaveElev1 => SrcParamData%WaveElev1 - DstParamData%WaveTime => SrcParamData%WaveTime - CALL SeaSt_Interp_CopyParam( SrcParamData%SeaSt_Interp_p, DstParamData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE SS_Exc_CopyParam - - SUBROUTINE SS_Exc_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(SS_Exc_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%spDOF)) THEN - DEALLOCATE(ParamData%spDOF) -ENDIF -IF (ALLOCATED(ParamData%A)) THEN - DEALLOCATE(ParamData%A) -ENDIF -IF (ALLOCATED(ParamData%B)) THEN - DEALLOCATE(ParamData%B) -ENDIF -IF (ALLOCATED(ParamData%C)) THEN - DEALLOCATE(ParamData%C) -ENDIF -NULLIFY(ParamData%WaveElev0) -NULLIFY(ParamData%WaveElev1) -NULLIFY(ParamData%WaveTime) - CALL SeaSt_Interp_DestroyParam( ParamData%SeaSt_Interp_p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE SS_Exc_DestroyParam + ErrMsg = '' + DstParamData%DT = SrcParamData%DT + DstParamData%NBody = SrcParamData%NBody + DstParamData%ExctnDisp = SrcParamData%ExctnDisp + DstParamData%NStepWave = SrcParamData%NStepWave + if (allocated(SrcParamData%spDOF)) then + LB(1:1) = lbound(SrcParamData%spDOF) + UB(1:1) = ubound(SrcParamData%spDOF) + if (.not. allocated(DstParamData%spDOF)) then + allocate(DstParamData%spDOF(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%spDOF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%spDOF = SrcParamData%spDOF + else if (allocated(DstParamData%spDOF)) then + deallocate(DstParamData%spDOF) + end if + if (allocated(SrcParamData%A)) then + LB(1:2) = lbound(SrcParamData%A) + UB(1:2) = ubound(SrcParamData%A) + if (.not. allocated(DstParamData%A)) then + allocate(DstParamData%A(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%A.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%A = SrcParamData%A + else if (allocated(DstParamData%A)) then + deallocate(DstParamData%A) + end if + if (allocated(SrcParamData%B)) then + LB(1:1) = lbound(SrcParamData%B) + UB(1:1) = ubound(SrcParamData%B) + if (.not. allocated(DstParamData%B)) then + allocate(DstParamData%B(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%B = SrcParamData%B + else if (allocated(DstParamData%B)) then + deallocate(DstParamData%B) + end if + if (allocated(SrcParamData%C)) then + LB(1:2) = lbound(SrcParamData%C) + UB(1:2) = ubound(SrcParamData%C) + if (.not. allocated(DstParamData%C)) then + allocate(DstParamData%C(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%C = SrcParamData%C + else if (allocated(DstParamData%C)) then + deallocate(DstParamData%C) + end if + DstParamData%numStates = SrcParamData%numStates + DstParamData%Tc = SrcParamData%Tc + DstParamData%WaveElev0 => SrcParamData%WaveElev0 + DstParamData%WaveElev1 => SrcParamData%WaveElev1 + DstParamData%WaveTime => SrcParamData%WaveTime + call SeaSt_Interp_CopyParam(SrcParamData%SeaSt_Interp_p, DstParamData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine SS_Exc_DestroyParam(ParamData, ErrStat, ErrMsg) + type(SS_Exc_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SS_Exc_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%spDOF)) then + deallocate(ParamData%spDOF) + end if + if (allocated(ParamData%A)) then + deallocate(ParamData%A) + end if + if (allocated(ParamData%B)) then + deallocate(ParamData%B) + end if + if (allocated(ParamData%C)) then + deallocate(ParamData%C) + end if + nullify(ParamData%WaveElev0) + nullify(ParamData%WaveElev1) + nullify(ParamData%WaveTime) +end subroutine subroutine SS_Exc_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -934,53 +827,42 @@ subroutine SS_Exc_PackParam(Buf, Indata) character(*), parameter :: RoutineName = 'SS_Exc_PackParam' logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return - ! DT call RegPack(Buf, InData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! NBody call RegPack(Buf, InData%NBody) if (RegCheckErr(Buf, RoutineName)) return - ! ExctnDisp call RegPack(Buf, InData%ExctnDisp) if (RegCheckErr(Buf, RoutineName)) return - ! NStepWave call RegPack(Buf, InData%NStepWave) if (RegCheckErr(Buf, RoutineName)) return - ! spDOF call RegPack(Buf, allocated(InData%spDOF)) if (allocated(InData%spDOF)) then call RegPackBounds(Buf, 1, lbound(InData%spDOF), ubound(InData%spDOF)) call RegPack(Buf, InData%spDOF) end if if (RegCheckErr(Buf, RoutineName)) return - ! A call RegPack(Buf, allocated(InData%A)) if (allocated(InData%A)) then call RegPackBounds(Buf, 2, lbound(InData%A), ubound(InData%A)) call RegPack(Buf, InData%A) end if if (RegCheckErr(Buf, RoutineName)) return - ! B call RegPack(Buf, allocated(InData%B)) if (allocated(InData%B)) then call RegPackBounds(Buf, 1, lbound(InData%B), ubound(InData%B)) call RegPack(Buf, InData%B) end if if (RegCheckErr(Buf, RoutineName)) return - ! C call RegPack(Buf, allocated(InData%C)) if (allocated(InData%C)) then call RegPackBounds(Buf, 2, lbound(InData%C), ubound(InData%C)) call RegPack(Buf, InData%C) end if if (RegCheckErr(Buf, RoutineName)) return - ! numStates call RegPack(Buf, InData%numStates) if (RegCheckErr(Buf, RoutineName)) return - ! Tc call RegPack(Buf, InData%Tc) if (RegCheckErr(Buf, RoutineName)) return - ! WaveElev0 call RegPack(Buf, associated(InData%WaveElev0)) if (associated(InData%WaveElev0)) then call RegPackBounds(Buf, 1, lbound(InData%WaveElev0), ubound(InData%WaveElev0)) @@ -990,7 +872,6 @@ subroutine SS_Exc_PackParam(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveElev1 call RegPack(Buf, associated(InData%WaveElev1)) if (associated(InData%WaveElev1)) then call RegPackBounds(Buf, 3, lbound(InData%WaveElev1), ubound(InData%WaveElev1)) @@ -1000,7 +881,6 @@ subroutine SS_Exc_PackParam(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveTime call RegPack(Buf, associated(InData%WaveTime)) if (associated(InData%WaveTime)) then call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) @@ -1010,7 +890,6 @@ subroutine SS_Exc_PackParam(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! SeaSt_Interp_p call SeaSt_Interp_PackParam(Buf, InData%SeaSt_Interp_p) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1025,19 +904,14 @@ subroutine SS_Exc_UnPackParam(Buf, OutData) integer(IntKi) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return - ! DT call RegUnpack(Buf, OutData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! NBody call RegUnpack(Buf, OutData%NBody) if (RegCheckErr(Buf, RoutineName)) return - ! ExctnDisp call RegUnpack(Buf, OutData%ExctnDisp) if (RegCheckErr(Buf, RoutineName)) return - ! NStepWave call RegUnpack(Buf, OutData%NStepWave) if (RegCheckErr(Buf, RoutineName)) return - ! spDOF if (allocated(OutData%spDOF)) deallocate(OutData%spDOF) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1052,7 +926,6 @@ subroutine SS_Exc_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%spDOF) if (RegCheckErr(Buf, RoutineName)) return end if - ! A if (allocated(OutData%A)) deallocate(OutData%A) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1067,7 +940,6 @@ subroutine SS_Exc_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%A) if (RegCheckErr(Buf, RoutineName)) return end if - ! B if (allocated(OutData%B)) deallocate(OutData%B) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1082,7 +954,6 @@ subroutine SS_Exc_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%B) if (RegCheckErr(Buf, RoutineName)) return end if - ! C if (allocated(OutData%C)) deallocate(OutData%C) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1097,13 +968,10 @@ subroutine SS_Exc_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%C) if (RegCheckErr(Buf, RoutineName)) return end if - ! numStates call RegUnpack(Buf, OutData%numStates) if (RegCheckErr(Buf, RoutineName)) return - ! Tc call RegUnpack(Buf, OutData%Tc) if (RegCheckErr(Buf, RoutineName)) return - ! WaveElev0 if (associated(OutData%WaveElev0)) deallocate(OutData%WaveElev0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1128,7 +996,6 @@ subroutine SS_Exc_UnPackParam(Buf, OutData) else OutData%WaveElev0 => null() end if - ! WaveElev1 if (associated(OutData%WaveElev1)) deallocate(OutData%WaveElev1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1153,7 +1020,6 @@ subroutine SS_Exc_UnPackParam(Buf, OutData) else OutData%WaveElev1 => null() end if - ! WaveTime if (associated(OutData%WaveTime)) deallocate(OutData%WaveTime) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1178,66 +1044,53 @@ subroutine SS_Exc_UnPackParam(Buf, OutData) else OutData%WaveTime => null() end if - ! SeaSt_Interp_p call SeaSt_Interp_UnpackParam(Buf, OutData%SeaSt_Interp_p) ! SeaSt_Interp_p end subroutine - SUBROUTINE SS_Exc_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Exc_InputType), INTENT(IN) :: SrcInputData - TYPE(SS_Exc_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_CopyInput' -! + +subroutine SS_Exc_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(SS_Exc_InputType), intent(in) :: SrcInputData + type(SS_Exc_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SS_Exc_CopyInput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInputData%PtfmPos)) THEN - i1_l = LBOUND(SrcInputData%PtfmPos,1) - i1_u = UBOUND(SrcInputData%PtfmPos,1) - i2_l = LBOUND(SrcInputData%PtfmPos,2) - i2_u = UBOUND(SrcInputData%PtfmPos,2) - IF (.NOT. ALLOCATED(DstInputData%PtfmPos)) THEN - ALLOCATE(DstInputData%PtfmPos(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%PtfmPos.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%PtfmPos = SrcInputData%PtfmPos -ENDIF - END SUBROUTINE SS_Exc_CopyInput - - SUBROUTINE SS_Exc_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(SS_Exc_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputData%PtfmPos)) THEN - DEALLOCATE(InputData%PtfmPos) -ENDIF - END SUBROUTINE SS_Exc_DestroyInput + ErrMsg = '' + if (allocated(SrcInputData%PtfmPos)) then + LB(1:2) = lbound(SrcInputData%PtfmPos) + UB(1:2) = ubound(SrcInputData%PtfmPos) + if (.not. allocated(DstInputData%PtfmPos)) then + allocate(DstInputData%PtfmPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%PtfmPos.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%PtfmPos = SrcInputData%PtfmPos + else if (allocated(DstInputData%PtfmPos)) then + deallocate(DstInputData%PtfmPos) + end if +end subroutine +subroutine SS_Exc_DestroyInput(InputData, ErrStat, ErrMsg) + type(SS_Exc_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Exc_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%PtfmPos)) then + deallocate(InputData%PtfmPos) + end if +end subroutine subroutine SS_Exc_PackInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SS_Exc_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SS_Exc_PackInput' if (Buf%ErrStat >= AbortErrLev) return - ! PtfmPos call RegPack(Buf, allocated(InData%PtfmPos)) if (allocated(InData%PtfmPos)) then call RegPackBounds(Buf, 2, lbound(InData%PtfmPos), ubound(InData%PtfmPos)) @@ -1254,7 +1107,6 @@ subroutine SS_Exc_UnPackInput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! PtfmPos if (allocated(OutData%PtfmPos)) deallocate(OutData%PtfmPos) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1270,82 +1122,74 @@ subroutine SS_Exc_UnPackInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE SS_Exc_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Exc_OutputType), INTENT(IN) :: SrcOutputData - TYPE(SS_Exc_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_CopyOutput' -! + +subroutine SS_Exc_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(SS_Exc_OutputType), intent(in) :: SrcOutputData + type(SS_Exc_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SS_Exc_CopyOutput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%y)) THEN - i1_l = LBOUND(SrcOutputData%y,1) - i1_u = UBOUND(SrcOutputData%y,1) - IF (.NOT. ALLOCATED(DstOutputData%y)) THEN - ALLOCATE(DstOutputData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%y = SrcOutputData%y -ENDIF -IF (ALLOCATED(SrcOutputData%WriteOutput)) THEN - i1_l = LBOUND(SrcOutputData%WriteOutput,1) - i1_u = UBOUND(SrcOutputData%WriteOutput,1) - IF (.NOT. ALLOCATED(DstOutputData%WriteOutput)) THEN - ALLOCATE(DstOutputData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%WriteOutput = SrcOutputData%WriteOutput -ENDIF - END SUBROUTINE SS_Exc_CopyOutput - - SUBROUTINE SS_Exc_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(SS_Exc_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OutputData%y)) THEN - DEALLOCATE(OutputData%y) -ENDIF -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - END SUBROUTINE SS_Exc_DestroyOutput + ErrMsg = '' + if (allocated(SrcOutputData%y)) then + LB(1:1) = lbound(SrcOutputData%y) + UB(1:1) = ubound(SrcOutputData%y) + if (.not. allocated(DstOutputData%y)) then + allocate(DstOutputData%y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%y = SrcOutputData%y + else if (allocated(DstOutputData%y)) then + deallocate(DstOutputData%y) + end if + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%WriteOutput = SrcOutputData%WriteOutput + else if (allocated(DstOutputData%WriteOutput)) then + deallocate(DstOutputData%WriteOutput) + end if +end subroutine +subroutine SS_Exc_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(SS_Exc_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Exc_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%y)) then + deallocate(OutputData%y) + end if + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine subroutine SS_Exc_PackOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SS_Exc_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SS_Exc_PackOutput' if (Buf%ErrStat >= AbortErrLev) return - ! y call RegPack(Buf, allocated(InData%y)) if (allocated(InData%y)) then call RegPackBounds(Buf, 1, lbound(InData%y), ubound(InData%y)) call RegPack(Buf, InData%y) end if if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutput call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) @@ -1362,7 +1206,6 @@ subroutine SS_Exc_UnPackOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! y if (allocated(OutData%y)) deallocate(OutData%y) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1377,7 +1220,6 @@ subroutine SS_Exc_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%y) if (RegCheckErr(Buf, RoutineName)) return end if - ! WriteOutput if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/hydrodyn/src/SS_Radiation_Types.f90 b/modules/hydrodyn/src/SS_Radiation_Types.f90 index 930afa462d..ff99861351 100644 --- a/modules/hydrodyn/src/SS_Radiation_Types.f90 +++ b/modules/hydrodyn/src/SS_Radiation_Types.f90 @@ -96,90 +96,80 @@ MODULE SS_Radiation_Types END TYPE SS_Rad_OutputType ! ======================= CONTAINS - SUBROUTINE SS_Rad_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Rad_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(SS_Rad_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_CopyInitInput' -! + +subroutine SS_Rad_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(SS_Rad_InitInputType), intent(in) :: SrcInitInputData + type(SS_Rad_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SS_Rad_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFile = SrcInitInputData%InputFile -IF (ALLOCATED(SrcInitInputData%enabledDOFs)) THEN - i1_l = LBOUND(SrcInitInputData%enabledDOFs,1) - i1_u = UBOUND(SrcInitInputData%enabledDOFs,1) - IF (.NOT. ALLOCATED(DstInitInputData%enabledDOFs)) THEN - ALLOCATE(DstInitInputData%enabledDOFs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%enabledDOFs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%enabledDOFs = SrcInitInputData%enabledDOFs -ENDIF - DstInitInputData%NBody = SrcInitInputData%NBody -IF (ALLOCATED(SrcInitInputData%PtfmRefztRot)) THEN - i1_l = LBOUND(SrcInitInputData%PtfmRefztRot,1) - i1_u = UBOUND(SrcInitInputData%PtfmRefztRot,1) - IF (.NOT. ALLOCATED(DstInitInputData%PtfmRefztRot)) THEN - ALLOCATE(DstInitInputData%PtfmRefztRot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefztRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PtfmRefztRot = SrcInitInputData%PtfmRefztRot -ENDIF - END SUBROUTINE SS_Rad_CopyInitInput - - SUBROUTINE SS_Rad_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(SS_Rad_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitInputData%enabledDOFs)) THEN - DEALLOCATE(InitInputData%enabledDOFs) -ENDIF -IF (ALLOCATED(InitInputData%PtfmRefztRot)) THEN - DEALLOCATE(InitInputData%PtfmRefztRot) -ENDIF - END SUBROUTINE SS_Rad_DestroyInitInput + ErrMsg = '' + DstInitInputData%InputFile = SrcInitInputData%InputFile + if (allocated(SrcInitInputData%enabledDOFs)) then + LB(1:1) = lbound(SrcInitInputData%enabledDOFs) + UB(1:1) = ubound(SrcInitInputData%enabledDOFs) + if (.not. allocated(DstInitInputData%enabledDOFs)) then + allocate(DstInitInputData%enabledDOFs(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%enabledDOFs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%enabledDOFs = SrcInitInputData%enabledDOFs + else if (allocated(DstInitInputData%enabledDOFs)) then + deallocate(DstInitInputData%enabledDOFs) + end if + DstInitInputData%NBody = SrcInitInputData%NBody + if (allocated(SrcInitInputData%PtfmRefztRot)) then + LB(1:1) = lbound(SrcInitInputData%PtfmRefztRot) + UB(1:1) = ubound(SrcInitInputData%PtfmRefztRot) + if (.not. allocated(DstInitInputData%PtfmRefztRot)) then + allocate(DstInitInputData%PtfmRefztRot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefztRot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%PtfmRefztRot = SrcInitInputData%PtfmRefztRot + else if (allocated(DstInitInputData%PtfmRefztRot)) then + deallocate(DstInitInputData%PtfmRefztRot) + end if +end subroutine +subroutine SS_Rad_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(SS_Rad_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Rad_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitInputData%enabledDOFs)) then + deallocate(InitInputData%enabledDOFs) + end if + if (allocated(InitInputData%PtfmRefztRot)) then + deallocate(InitInputData%PtfmRefztRot) + end if +end subroutine subroutine SS_Rad_PackInitInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SS_Rad_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SS_Rad_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return - ! InputFile call RegPack(Buf, InData%InputFile) if (RegCheckErr(Buf, RoutineName)) return - ! enabledDOFs call RegPack(Buf, allocated(InData%enabledDOFs)) if (allocated(InData%enabledDOFs)) then call RegPackBounds(Buf, 1, lbound(InData%enabledDOFs), ubound(InData%enabledDOFs)) call RegPack(Buf, InData%enabledDOFs) end if if (RegCheckErr(Buf, RoutineName)) return - ! NBody call RegPack(Buf, InData%NBody) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmRefztRot call RegPack(Buf, allocated(InData%PtfmRefztRot)) if (allocated(InData%PtfmRefztRot)) then call RegPackBounds(Buf, 1, lbound(InData%PtfmRefztRot), ubound(InData%PtfmRefztRot)) @@ -196,10 +186,8 @@ subroutine SS_Rad_UnPackInitInput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! InputFile call RegUnpack(Buf, OutData%InputFile) if (RegCheckErr(Buf, RoutineName)) return - ! enabledDOFs if (allocated(OutData%enabledDOFs)) deallocate(OutData%enabledDOFs) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -214,10 +202,8 @@ subroutine SS_Rad_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%enabledDOFs) if (RegCheckErr(Buf, RoutineName)) return end if - ! NBody call RegUnpack(Buf, OutData%NBody) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmRefztRot if (allocated(OutData%PtfmRefztRot)) deallocate(OutData%PtfmRefztRot) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -233,82 +219,74 @@ subroutine SS_Rad_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE SS_Rad_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Rad_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(SS_Rad_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_CopyInitOutput' -! + +subroutine SS_Rad_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(SS_Rad_InitOutputType), intent(in) :: SrcInitOutputData + type(SS_Rad_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SS_Rad_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInitOutputData%WriteOutputHdr)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputHdr,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputHdr,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputHdr)) THEN - ALLOCATE(DstInitOutputData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr -ENDIF -IF (ALLOCATED(SrcInitOutputData%WriteOutputUnt)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputUnt,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputUnt,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputUnt)) THEN - ALLOCATE(DstInitOutputData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt -ENDIF - END SUBROUTINE SS_Rad_CopyInitOutput - - SUBROUTINE SS_Rad_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(SS_Rad_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF - END SUBROUTINE SS_Rad_DestroyInitOutput + ErrMsg = '' + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr + else if (allocated(DstInitOutputData%WriteOutputHdr)) then + deallocate(DstInitOutputData%WriteOutputHdr) + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt + else if (allocated(DstInitOutputData%WriteOutputUnt)) then + deallocate(DstInitOutputData%WriteOutputUnt) + end if +end subroutine +subroutine SS_Rad_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(SS_Rad_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Rad_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if +end subroutine subroutine SS_Rad_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SS_Rad_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SS_Rad_PackInitOutput' if (Buf%ErrStat >= AbortErrLev) return - ! WriteOutputHdr call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) call RegPack(Buf, InData%WriteOutputHdr) end if if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutputUnt call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) @@ -325,7 +303,6 @@ subroutine SS_Rad_UnPackInitOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! WriteOutputHdr if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -340,7 +317,6 @@ subroutine SS_Rad_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutputHdr) if (RegCheckErr(Buf, RoutineName)) return end if - ! WriteOutputUnt if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -356,60 +332,51 @@ subroutine SS_Rad_UnPackInitOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE SS_Rad_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Rad_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(SS_Rad_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_CopyContState' -! + +subroutine SS_Rad_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(SS_Rad_ContinuousStateType), intent(in) :: SrcContStateData + type(SS_Rad_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SS_Rad_CopyContState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcContStateData%x)) THEN - i1_l = LBOUND(SrcContStateData%x,1) - i1_u = UBOUND(SrcContStateData%x,1) - IF (.NOT. ALLOCATED(DstContStateData%x)) THEN - ALLOCATE(DstContStateData%x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstContStateData%x = SrcContStateData%x -ENDIF - END SUBROUTINE SS_Rad_CopyContState - - SUBROUTINE SS_Rad_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(SS_Rad_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ContStateData%x)) THEN - DEALLOCATE(ContStateData%x) -ENDIF - END SUBROUTINE SS_Rad_DestroyContState + ErrMsg = '' + if (allocated(SrcContStateData%x)) then + LB(1:1) = lbound(SrcContStateData%x) + UB(1:1) = ubound(SrcContStateData%x) + if (.not. allocated(DstContStateData%x)) then + allocate(DstContStateData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstContStateData%x = SrcContStateData%x + else if (allocated(DstContStateData%x)) then + deallocate(DstContStateData%x) + end if +end subroutine +subroutine SS_Rad_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(SS_Rad_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Rad_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ContStateData%x)) then + deallocate(ContStateData%x) + end if +end subroutine subroutine SS_Rad_PackContState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SS_Rad_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SS_Rad_PackContState' if (Buf%ErrStat >= AbortErrLev) return - ! x call RegPack(Buf, allocated(InData%x)) if (allocated(InData%x)) then call RegPackBounds(Buf, 1, lbound(InData%x), ubound(InData%x)) @@ -426,7 +393,6 @@ subroutine SS_Rad_UnPackContState(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! x if (allocated(OutData%x)) deallocate(OutData%x) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -442,45 +408,33 @@ subroutine SS_Rad_UnPackContState(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE SS_Rad_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Rad_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(SS_Rad_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState - END SUBROUTINE SS_Rad_CopyDiscState - - SUBROUTINE SS_Rad_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(SS_Rad_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_DestroyDiscState' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE SS_Rad_DestroyDiscState +subroutine SS_Rad_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(SS_Rad_DiscreteStateType), intent(in) :: SrcDiscStateData + type(SS_Rad_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Rad_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState +end subroutine +subroutine SS_Rad_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(SS_Rad_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Rad_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine SS_Rad_PackDiscState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SS_Rad_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SS_Rad_PackDiscState' if (Buf%ErrStat >= AbortErrLev) return - ! DummyDiscState call RegPack(Buf, InData%DummyDiscState) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -490,49 +444,36 @@ subroutine SS_Rad_UnPackDiscState(Buf, OutData) type(SS_Rad_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Rad_UnPackDiscState' if (Buf%ErrStat /= ErrID_None) return - ! DummyDiscState call RegUnpack(Buf, OutData%DummyDiscState) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE SS_Rad_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Rad_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(SS_Rad_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE SS_Rad_CopyConstrState - - SUBROUTINE SS_Rad_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(SS_Rad_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE SS_Rad_DestroyConstrState +subroutine SS_Rad_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(SS_Rad_ConstraintStateType), intent(in) :: SrcConstrStateData + type(SS_Rad_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Rad_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine +subroutine SS_Rad_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(SS_Rad_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Rad_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine SS_Rad_PackConstrState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SS_Rad_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SS_Rad_PackConstrState' if (Buf%ErrStat >= AbortErrLev) return - ! DummyConstrState call RegPack(Buf, InData%DummyConstrState) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -542,52 +483,43 @@ subroutine SS_Rad_UnPackConstrState(Buf, OutData) type(SS_Rad_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Rad_UnPackConstrState' if (Buf%ErrStat /= ErrID_None) return - ! DummyConstrState call RegUnpack(Buf, OutData%DummyConstrState) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE SS_Rad_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Rad_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(SS_Rad_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_CopyOtherState' -! + +subroutine SS_Rad_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(SS_Rad_OtherStateType), intent(in) :: SrcOtherStateData + type(SS_Rad_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SS_Rad_CopyOtherState' ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%n = SrcOtherStateData%n - DO i1 = LBOUND(SrcOtherStateData%xdot,1), UBOUND(SrcOtherStateData%xdot,1) - CALL SS_Rad_CopyContState( SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - END SUBROUTINE SS_Rad_CopyOtherState - - SUBROUTINE SS_Rad_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(SS_Rad_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(OtherStateData%xdot,1), UBOUND(OtherStateData%xdot,1) - CALL SS_Rad_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - END SUBROUTINE SS_Rad_DestroyOtherState + ErrMsg = '' + DstOtherStateData%n = SrcOtherStateData%n + do i1 = LB(1), UB(1) + call SS_Rad_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do +end subroutine +subroutine SS_Rad_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(SS_Rad_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SS_Rad_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine SS_Rad_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -596,10 +528,8 @@ subroutine SS_Rad_PackOtherState(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! n call RegPack(Buf, InData%n) if (RegCheckErr(Buf, RoutineName)) return - ! xdot LB(1:1) = lbound(InData%xdot) UB(1:1) = ubound(InData%xdot) do i1 = LB(1), UB(1) @@ -615,55 +545,41 @@ subroutine SS_Rad_UnPackOtherState(Buf, OutData) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat /= ErrID_None) return - ! n call RegUnpack(Buf, OutData%n) if (RegCheckErr(Buf, RoutineName)) return - ! xdot LB(1:1) = lbound(OutData%xdot) UB(1:1) = ubound(OutData%xdot) do i1 = LB(1), UB(1) call SS_Rad_UnpackContState(Buf, OutData%xdot(i1)) ! xdot end do end subroutine - SUBROUTINE SS_Rad_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Rad_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(SS_Rad_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar - END SUBROUTINE SS_Rad_CopyMisc - SUBROUTINE SS_Rad_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(SS_Rad_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE SS_Rad_DestroyMisc +subroutine SS_Rad_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(SS_Rad_MiscVarType), intent(in) :: SrcMiscData + type(SS_Rad_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Rad_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar +end subroutine +subroutine SS_Rad_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(SS_Rad_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Rad_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine SS_Rad_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SS_Rad_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'SS_Rad_PackMisc' if (Buf%ErrStat >= AbortErrLev) return - ! DummyMiscVar call RegPack(Buf, InData%DummyMiscVar) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -673,153 +589,136 @@ subroutine SS_Rad_UnPackMisc(Buf, OutData) type(SS_Rad_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Rad_UnPackMisc' if (Buf%ErrStat /= ErrID_None) return - ! DummyMiscVar call RegUnpack(Buf, OutData%DummyMiscVar) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE SS_Rad_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Rad_ParameterType), INTENT(IN) :: SrcParamData - TYPE(SS_Rad_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_CopyParam' -! + +subroutine SS_Rad_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(SS_Rad_ParameterType), intent(in) :: SrcParamData + type(SS_Rad_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SS_Rad_CopyParam' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT -IF (ALLOCATED(SrcParamData%A)) THEN - i1_l = LBOUND(SrcParamData%A,1) - i1_u = UBOUND(SrcParamData%A,1) - i2_l = LBOUND(SrcParamData%A,2) - i2_u = UBOUND(SrcParamData%A,2) - IF (.NOT. ALLOCATED(DstParamData%A)) THEN - ALLOCATE(DstParamData%A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%A.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%A = SrcParamData%A -ENDIF -IF (ALLOCATED(SrcParamData%B)) THEN - i1_l = LBOUND(SrcParamData%B,1) - i1_u = UBOUND(SrcParamData%B,1) - i2_l = LBOUND(SrcParamData%B,2) - i2_u = UBOUND(SrcParamData%B,2) - IF (.NOT. ALLOCATED(DstParamData%B)) THEN - ALLOCATE(DstParamData%B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%B = SrcParamData%B -ENDIF -IF (ALLOCATED(SrcParamData%C)) THEN - i1_l = LBOUND(SrcParamData%C,1) - i1_u = UBOUND(SrcParamData%C,1) - i2_l = LBOUND(SrcParamData%C,2) - i2_u = UBOUND(SrcParamData%C,2) - IF (.NOT. ALLOCATED(DstParamData%C)) THEN - ALLOCATE(DstParamData%C(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%C = SrcParamData%C -ENDIF - DstParamData%numStates = SrcParamData%numStates -IF (ALLOCATED(SrcParamData%spdof)) THEN - i1_l = LBOUND(SrcParamData%spdof,1) - i1_u = UBOUND(SrcParamData%spdof,1) - IF (.NOT. ALLOCATED(DstParamData%spdof)) THEN - ALLOCATE(DstParamData%spdof(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%spdof.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%spdof = SrcParamData%spdof -ENDIF - DstParamData%NBody = SrcParamData%NBody - END SUBROUTINE SS_Rad_CopyParam - - SUBROUTINE SS_Rad_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(SS_Rad_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%A)) THEN - DEALLOCATE(ParamData%A) -ENDIF -IF (ALLOCATED(ParamData%B)) THEN - DEALLOCATE(ParamData%B) -ENDIF -IF (ALLOCATED(ParamData%C)) THEN - DEALLOCATE(ParamData%C) -ENDIF -IF (ALLOCATED(ParamData%spdof)) THEN - DEALLOCATE(ParamData%spdof) -ENDIF - END SUBROUTINE SS_Rad_DestroyParam + ErrMsg = '' + DstParamData%DT = SrcParamData%DT + if (allocated(SrcParamData%A)) then + LB(1:2) = lbound(SrcParamData%A) + UB(1:2) = ubound(SrcParamData%A) + if (.not. allocated(DstParamData%A)) then + allocate(DstParamData%A(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%A.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%A = SrcParamData%A + else if (allocated(DstParamData%A)) then + deallocate(DstParamData%A) + end if + if (allocated(SrcParamData%B)) then + LB(1:2) = lbound(SrcParamData%B) + UB(1:2) = ubound(SrcParamData%B) + if (.not. allocated(DstParamData%B)) then + allocate(DstParamData%B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%B = SrcParamData%B + else if (allocated(DstParamData%B)) then + deallocate(DstParamData%B) + end if + if (allocated(SrcParamData%C)) then + LB(1:2) = lbound(SrcParamData%C) + UB(1:2) = ubound(SrcParamData%C) + if (.not. allocated(DstParamData%C)) then + allocate(DstParamData%C(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%C = SrcParamData%C + else if (allocated(DstParamData%C)) then + deallocate(DstParamData%C) + end if + DstParamData%numStates = SrcParamData%numStates + if (allocated(SrcParamData%spdof)) then + LB(1:1) = lbound(SrcParamData%spdof) + UB(1:1) = ubound(SrcParamData%spdof) + if (.not. allocated(DstParamData%spdof)) then + allocate(DstParamData%spdof(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%spdof.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%spdof = SrcParamData%spdof + else if (allocated(DstParamData%spdof)) then + deallocate(DstParamData%spdof) + end if + DstParamData%NBody = SrcParamData%NBody +end subroutine +subroutine SS_Rad_DestroyParam(ParamData, ErrStat, ErrMsg) + type(SS_Rad_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Rad_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%A)) then + deallocate(ParamData%A) + end if + if (allocated(ParamData%B)) then + deallocate(ParamData%B) + end if + if (allocated(ParamData%C)) then + deallocate(ParamData%C) + end if + if (allocated(ParamData%spdof)) then + deallocate(ParamData%spdof) + end if +end subroutine subroutine SS_Rad_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SS_Rad_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'SS_Rad_PackParam' if (Buf%ErrStat >= AbortErrLev) return - ! DT call RegPack(Buf, InData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! A call RegPack(Buf, allocated(InData%A)) if (allocated(InData%A)) then call RegPackBounds(Buf, 2, lbound(InData%A), ubound(InData%A)) call RegPack(Buf, InData%A) end if if (RegCheckErr(Buf, RoutineName)) return - ! B call RegPack(Buf, allocated(InData%B)) if (allocated(InData%B)) then call RegPackBounds(Buf, 2, lbound(InData%B), ubound(InData%B)) call RegPack(Buf, InData%B) end if if (RegCheckErr(Buf, RoutineName)) return - ! C call RegPack(Buf, allocated(InData%C)) if (allocated(InData%C)) then call RegPackBounds(Buf, 2, lbound(InData%C), ubound(InData%C)) call RegPack(Buf, InData%C) end if if (RegCheckErr(Buf, RoutineName)) return - ! numStates call RegPack(Buf, InData%numStates) if (RegCheckErr(Buf, RoutineName)) return - ! spdof call RegPack(Buf, allocated(InData%spdof)) if (allocated(InData%spdof)) then call RegPackBounds(Buf, 1, lbound(InData%spdof), ubound(InData%spdof)) call RegPack(Buf, InData%spdof) end if if (RegCheckErr(Buf, RoutineName)) return - ! NBody call RegPack(Buf, InData%NBody) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -832,10 +731,8 @@ subroutine SS_Rad_UnPackParam(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! DT call RegUnpack(Buf, OutData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! A if (allocated(OutData%A)) deallocate(OutData%A) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -850,7 +747,6 @@ subroutine SS_Rad_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%A) if (RegCheckErr(Buf, RoutineName)) return end if - ! B if (allocated(OutData%B)) deallocate(OutData%B) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -865,7 +761,6 @@ subroutine SS_Rad_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%B) if (RegCheckErr(Buf, RoutineName)) return end if - ! C if (allocated(OutData%C)) deallocate(OutData%C) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -880,10 +775,8 @@ subroutine SS_Rad_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%C) if (RegCheckErr(Buf, RoutineName)) return end if - ! numStates call RegUnpack(Buf, OutData%numStates) if (RegCheckErr(Buf, RoutineName)) return - ! spdof if (allocated(OutData%spdof)) deallocate(OutData%spdof) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -898,64 +791,54 @@ subroutine SS_Rad_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%spdof) if (RegCheckErr(Buf, RoutineName)) return end if - ! NBody call RegUnpack(Buf, OutData%NBody) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE SS_Rad_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Rad_InputType), INTENT(IN) :: SrcInputData - TYPE(SS_Rad_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_CopyInput' -! + +subroutine SS_Rad_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(SS_Rad_InputType), intent(in) :: SrcInputData + type(SS_Rad_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SS_Rad_CopyInput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInputData%dq)) THEN - i1_l = LBOUND(SrcInputData%dq,1) - i1_u = UBOUND(SrcInputData%dq,1) - IF (.NOT. ALLOCATED(DstInputData%dq)) THEN - ALLOCATE(DstInputData%dq(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%dq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%dq = SrcInputData%dq -ENDIF - END SUBROUTINE SS_Rad_CopyInput - - SUBROUTINE SS_Rad_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(SS_Rad_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputData%dq)) THEN - DEALLOCATE(InputData%dq) -ENDIF - END SUBROUTINE SS_Rad_DestroyInput + ErrMsg = '' + if (allocated(SrcInputData%dq)) then + LB(1:1) = lbound(SrcInputData%dq) + UB(1:1) = ubound(SrcInputData%dq) + if (.not. allocated(DstInputData%dq)) then + allocate(DstInputData%dq(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%dq.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%dq = SrcInputData%dq + else if (allocated(DstInputData%dq)) then + deallocate(DstInputData%dq) + end if +end subroutine +subroutine SS_Rad_DestroyInput(InputData, ErrStat, ErrMsg) + type(SS_Rad_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Rad_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%dq)) then + deallocate(InputData%dq) + end if +end subroutine subroutine SS_Rad_PackInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SS_Rad_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SS_Rad_PackInput' if (Buf%ErrStat >= AbortErrLev) return - ! dq call RegPack(Buf, allocated(InData%dq)) if (allocated(InData%dq)) then call RegPackBounds(Buf, 1, lbound(InData%dq), ubound(InData%dq)) @@ -972,7 +855,6 @@ subroutine SS_Rad_UnPackInput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! dq if (allocated(OutData%dq)) deallocate(OutData%dq) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -988,82 +870,74 @@ subroutine SS_Rad_UnPackInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE SS_Rad_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SS_Rad_OutputType), INTENT(IN) :: SrcOutputData - TYPE(SS_Rad_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_CopyOutput' -! + +subroutine SS_Rad_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(SS_Rad_OutputType), intent(in) :: SrcOutputData + type(SS_Rad_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SS_Rad_CopyOutput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%y)) THEN - i1_l = LBOUND(SrcOutputData%y,1) - i1_u = UBOUND(SrcOutputData%y,1) - IF (.NOT. ALLOCATED(DstOutputData%y)) THEN - ALLOCATE(DstOutputData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%y = SrcOutputData%y -ENDIF -IF (ALLOCATED(SrcOutputData%WriteOutput)) THEN - i1_l = LBOUND(SrcOutputData%WriteOutput,1) - i1_u = UBOUND(SrcOutputData%WriteOutput,1) - IF (.NOT. ALLOCATED(DstOutputData%WriteOutput)) THEN - ALLOCATE(DstOutputData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%WriteOutput = SrcOutputData%WriteOutput -ENDIF - END SUBROUTINE SS_Rad_CopyOutput - - SUBROUTINE SS_Rad_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(SS_Rad_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OutputData%y)) THEN - DEALLOCATE(OutputData%y) -ENDIF -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - END SUBROUTINE SS_Rad_DestroyOutput + ErrMsg = '' + if (allocated(SrcOutputData%y)) then + LB(1:1) = lbound(SrcOutputData%y) + UB(1:1) = ubound(SrcOutputData%y) + if (.not. allocated(DstOutputData%y)) then + allocate(DstOutputData%y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%y = SrcOutputData%y + else if (allocated(DstOutputData%y)) then + deallocate(DstOutputData%y) + end if + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%WriteOutput = SrcOutputData%WriteOutput + else if (allocated(DstOutputData%WriteOutput)) then + deallocate(DstOutputData%WriteOutput) + end if +end subroutine +subroutine SS_Rad_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(SS_Rad_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SS_Rad_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%y)) then + deallocate(OutputData%y) + end if + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine subroutine SS_Rad_PackOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SS_Rad_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SS_Rad_PackOutput' if (Buf%ErrStat >= AbortErrLev) return - ! y call RegPack(Buf, allocated(InData%y)) if (allocated(InData%y)) then call RegPackBounds(Buf, 1, lbound(InData%y), ubound(InData%y)) call RegPack(Buf, InData%y) end if if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutput call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) @@ -1080,7 +954,6 @@ subroutine SS_Rad_UnPackOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! y if (allocated(OutData%y)) deallocate(OutData%y) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1095,7 +968,6 @@ subroutine SS_Rad_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%y) if (RegCheckErr(Buf, RoutineName)) return end if - ! WriteOutput if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/hydrodyn/src/WAMIT2_Types.f90 b/modules/hydrodyn/src/WAMIT2_Types.f90 index c8fdf5ef68..c63a29c26c 100644 --- a/modules/hydrodyn/src/WAMIT2_Types.f90 +++ b/modules/hydrodyn/src/WAMIT2_Types.f90 @@ -103,134 +103,131 @@ MODULE WAMIT2_Types END TYPE WAMIT2_OutputType ! ======================= CONTAINS - SUBROUTINE WAMIT2_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WAMIT2_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(WAMIT2_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%HasWAMIT = SrcInitInputData%HasWAMIT - DstInitInputData%WAMITFile = SrcInitInputData%WAMITFile - DstInitInputData%NBody = SrcInitInputData%NBody - DstInitInputData%NBodyMod = SrcInitInputData%NBodyMod -IF (ALLOCATED(SrcInitInputData%PtfmRefxt)) THEN - i1_l = LBOUND(SrcInitInputData%PtfmRefxt,1) - i1_u = UBOUND(SrcInitInputData%PtfmRefxt,1) - IF (.NOT. ALLOCATED(DstInitInputData%PtfmRefxt)) THEN - ALLOCATE(DstInitInputData%PtfmRefxt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefxt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PtfmRefxt = SrcInitInputData%PtfmRefxt -ENDIF -IF (ALLOCATED(SrcInitInputData%PtfmRefyt)) THEN - i1_l = LBOUND(SrcInitInputData%PtfmRefyt,1) - i1_u = UBOUND(SrcInitInputData%PtfmRefyt,1) - IF (.NOT. ALLOCATED(DstInitInputData%PtfmRefyt)) THEN - ALLOCATE(DstInitInputData%PtfmRefyt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefyt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PtfmRefyt = SrcInitInputData%PtfmRefyt -ENDIF -IF (ALLOCATED(SrcInitInputData%PtfmRefzt)) THEN - i1_l = LBOUND(SrcInitInputData%PtfmRefzt,1) - i1_u = UBOUND(SrcInitInputData%PtfmRefzt,1) - IF (.NOT. ALLOCATED(DstInitInputData%PtfmRefzt)) THEN - ALLOCATE(DstInitInputData%PtfmRefzt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefzt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PtfmRefzt = SrcInitInputData%PtfmRefzt -ENDIF -IF (ALLOCATED(SrcInitInputData%PtfmRefztRot)) THEN - i1_l = LBOUND(SrcInitInputData%PtfmRefztRot,1) - i1_u = UBOUND(SrcInitInputData%PtfmRefztRot,1) - IF (.NOT. ALLOCATED(DstInitInputData%PtfmRefztRot)) THEN - ALLOCATE(DstInitInputData%PtfmRefztRot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefztRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PtfmRefztRot = SrcInitInputData%PtfmRefztRot -ENDIF - DstInitInputData%WAMITULEN = SrcInitInputData%WAMITULEN - DstInitInputData%RhoXg = SrcInitInputData%RhoXg - DstInitInputData%NStepWave = SrcInitInputData%NStepWave - DstInitInputData%NStepWave2 = SrcInitInputData%NStepWave2 - DstInitInputData%WaveDOmega = SrcInitInputData%WaveDOmega - DstInitInputData%WtrDens = SrcInitInputData%WtrDens - DstInitInputData%Gravity = SrcInitInputData%Gravity - DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth - DstInitInputData%WaveElevC0 => SrcInitInputData%WaveElevC0 - DstInitInputData%WaveDir = SrcInitInputData%WaveDir - DstInitInputData%WaveMultiDir = SrcInitInputData%WaveMultiDir - DstInitInputData%WaveDirArr => SrcInitInputData%WaveDirArr - DstInitInputData%WaveDirMin = SrcInitInputData%WaveDirMin - DstInitInputData%WaveDirMax = SrcInitInputData%WaveDirMax - DstInitInputData%WaveMod = SrcInitInputData%WaveMod - DstInitInputData%MnDrift = SrcInitInputData%MnDrift - DstInitInputData%NewmanApp = SrcInitInputData%NewmanApp - DstInitInputData%DiffQTF = SrcInitInputData%DiffQTF - DstInitInputData%SumQTF = SrcInitInputData%SumQTF - DstInitInputData%MnDriftF = SrcInitInputData%MnDriftF - DstInitInputData%NewmanAppF = SrcInitInputData%NewmanAppF - DstInitInputData%DiffQTFF = SrcInitInputData%DiffQTFF - DstInitInputData%SumQTFF = SrcInitInputData%SumQTFF - DstInitInputData%WvLowCOff = SrcInitInputData%WvLowCOff - DstInitInputData%WvHiCOff = SrcInitInputData%WvHiCOff - DstInitInputData%WvLowCOffD = SrcInitInputData%WvLowCOffD - DstInitInputData%WvHiCOffD = SrcInitInputData%WvHiCOffD - DstInitInputData%WvLowCOffS = SrcInitInputData%WvLowCOffS - DstInitInputData%WvHiCOffS = SrcInitInputData%WvHiCOffS - END SUBROUTINE WAMIT2_CopyInitInput - - SUBROUTINE WAMIT2_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(WAMIT2_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_DestroyInitInput' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitInputData%PtfmRefxt)) THEN - DEALLOCATE(InitInputData%PtfmRefxt) -ENDIF -IF (ALLOCATED(InitInputData%PtfmRefyt)) THEN - DEALLOCATE(InitInputData%PtfmRefyt) -ENDIF -IF (ALLOCATED(InitInputData%PtfmRefzt)) THEN - DEALLOCATE(InitInputData%PtfmRefzt) -ENDIF -IF (ALLOCATED(InitInputData%PtfmRefztRot)) THEN - DEALLOCATE(InitInputData%PtfmRefztRot) -ENDIF -NULLIFY(InitInputData%WaveElevC0) -NULLIFY(InitInputData%WaveDirArr) - END SUBROUTINE WAMIT2_DestroyInitInput +subroutine WAMIT2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(WAMIT2_InitInputType), intent(in) :: SrcInitInputData + type(WAMIT2_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'WAMIT2_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitInputData%HasWAMIT = SrcInitInputData%HasWAMIT + DstInitInputData%WAMITFile = SrcInitInputData%WAMITFile + DstInitInputData%NBody = SrcInitInputData%NBody + DstInitInputData%NBodyMod = SrcInitInputData%NBodyMod + if (allocated(SrcInitInputData%PtfmRefxt)) then + LB(1:1) = lbound(SrcInitInputData%PtfmRefxt) + UB(1:1) = ubound(SrcInitInputData%PtfmRefxt) + if (.not. allocated(DstInitInputData%PtfmRefxt)) then + allocate(DstInitInputData%PtfmRefxt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefxt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%PtfmRefxt = SrcInitInputData%PtfmRefxt + else if (allocated(DstInitInputData%PtfmRefxt)) then + deallocate(DstInitInputData%PtfmRefxt) + end if + if (allocated(SrcInitInputData%PtfmRefyt)) then + LB(1:1) = lbound(SrcInitInputData%PtfmRefyt) + UB(1:1) = ubound(SrcInitInputData%PtfmRefyt) + if (.not. allocated(DstInitInputData%PtfmRefyt)) then + allocate(DstInitInputData%PtfmRefyt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefyt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%PtfmRefyt = SrcInitInputData%PtfmRefyt + else if (allocated(DstInitInputData%PtfmRefyt)) then + deallocate(DstInitInputData%PtfmRefyt) + end if + if (allocated(SrcInitInputData%PtfmRefzt)) then + LB(1:1) = lbound(SrcInitInputData%PtfmRefzt) + UB(1:1) = ubound(SrcInitInputData%PtfmRefzt) + if (.not. allocated(DstInitInputData%PtfmRefzt)) then + allocate(DstInitInputData%PtfmRefzt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefzt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%PtfmRefzt = SrcInitInputData%PtfmRefzt + else if (allocated(DstInitInputData%PtfmRefzt)) then + deallocate(DstInitInputData%PtfmRefzt) + end if + if (allocated(SrcInitInputData%PtfmRefztRot)) then + LB(1:1) = lbound(SrcInitInputData%PtfmRefztRot) + UB(1:1) = ubound(SrcInitInputData%PtfmRefztRot) + if (.not. allocated(DstInitInputData%PtfmRefztRot)) then + allocate(DstInitInputData%PtfmRefztRot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefztRot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%PtfmRefztRot = SrcInitInputData%PtfmRefztRot + else if (allocated(DstInitInputData%PtfmRefztRot)) then + deallocate(DstInitInputData%PtfmRefztRot) + end if + DstInitInputData%WAMITULEN = SrcInitInputData%WAMITULEN + DstInitInputData%RhoXg = SrcInitInputData%RhoXg + DstInitInputData%NStepWave = SrcInitInputData%NStepWave + DstInitInputData%NStepWave2 = SrcInitInputData%NStepWave2 + DstInitInputData%WaveDOmega = SrcInitInputData%WaveDOmega + DstInitInputData%WtrDens = SrcInitInputData%WtrDens + DstInitInputData%Gravity = SrcInitInputData%Gravity + DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth + DstInitInputData%WaveElevC0 => SrcInitInputData%WaveElevC0 + DstInitInputData%WaveDir = SrcInitInputData%WaveDir + DstInitInputData%WaveMultiDir = SrcInitInputData%WaveMultiDir + DstInitInputData%WaveDirArr => SrcInitInputData%WaveDirArr + DstInitInputData%WaveDirMin = SrcInitInputData%WaveDirMin + DstInitInputData%WaveDirMax = SrcInitInputData%WaveDirMax + DstInitInputData%WaveMod = SrcInitInputData%WaveMod + DstInitInputData%MnDrift = SrcInitInputData%MnDrift + DstInitInputData%NewmanApp = SrcInitInputData%NewmanApp + DstInitInputData%DiffQTF = SrcInitInputData%DiffQTF + DstInitInputData%SumQTF = SrcInitInputData%SumQTF + DstInitInputData%MnDriftF = SrcInitInputData%MnDriftF + DstInitInputData%NewmanAppF = SrcInitInputData%NewmanAppF + DstInitInputData%DiffQTFF = SrcInitInputData%DiffQTFF + DstInitInputData%SumQTFF = SrcInitInputData%SumQTFF + DstInitInputData%WvLowCOff = SrcInitInputData%WvLowCOff + DstInitInputData%WvHiCOff = SrcInitInputData%WvHiCOff + DstInitInputData%WvLowCOffD = SrcInitInputData%WvLowCOffD + DstInitInputData%WvHiCOffD = SrcInitInputData%WvHiCOffD + DstInitInputData%WvLowCOffS = SrcInitInputData%WvLowCOffS + DstInitInputData%WvHiCOffS = SrcInitInputData%WvHiCOffS +end subroutine +subroutine WAMIT2_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(WAMIT2_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WAMIT2_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitInputData%PtfmRefxt)) then + deallocate(InitInputData%PtfmRefxt) + end if + if (allocated(InitInputData%PtfmRefyt)) then + deallocate(InitInputData%PtfmRefyt) + end if + if (allocated(InitInputData%PtfmRefzt)) then + deallocate(InitInputData%PtfmRefzt) + end if + if (allocated(InitInputData%PtfmRefztRot)) then + deallocate(InitInputData%PtfmRefztRot) + end if + nullify(InitInputData%WaveElevC0) + nullify(InitInputData%WaveDirArr) +end subroutine subroutine WAMIT2_PackInitInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -238,71 +235,54 @@ subroutine WAMIT2_PackInitInput(Buf, Indata) character(*), parameter :: RoutineName = 'WAMIT2_PackInitInput' logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return - ! HasWAMIT call RegPack(Buf, InData%HasWAMIT) if (RegCheckErr(Buf, RoutineName)) return - ! WAMITFile call RegPack(Buf, InData%WAMITFile) if (RegCheckErr(Buf, RoutineName)) return - ! NBody call RegPack(Buf, InData%NBody) if (RegCheckErr(Buf, RoutineName)) return - ! NBodyMod call RegPack(Buf, InData%NBodyMod) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmRefxt call RegPack(Buf, allocated(InData%PtfmRefxt)) if (allocated(InData%PtfmRefxt)) then call RegPackBounds(Buf, 1, lbound(InData%PtfmRefxt), ubound(InData%PtfmRefxt)) call RegPack(Buf, InData%PtfmRefxt) end if if (RegCheckErr(Buf, RoutineName)) return - ! PtfmRefyt call RegPack(Buf, allocated(InData%PtfmRefyt)) if (allocated(InData%PtfmRefyt)) then call RegPackBounds(Buf, 1, lbound(InData%PtfmRefyt), ubound(InData%PtfmRefyt)) call RegPack(Buf, InData%PtfmRefyt) end if if (RegCheckErr(Buf, RoutineName)) return - ! PtfmRefzt call RegPack(Buf, allocated(InData%PtfmRefzt)) if (allocated(InData%PtfmRefzt)) then call RegPackBounds(Buf, 1, lbound(InData%PtfmRefzt), ubound(InData%PtfmRefzt)) call RegPack(Buf, InData%PtfmRefzt) end if if (RegCheckErr(Buf, RoutineName)) return - ! PtfmRefztRot call RegPack(Buf, allocated(InData%PtfmRefztRot)) if (allocated(InData%PtfmRefztRot)) then call RegPackBounds(Buf, 1, lbound(InData%PtfmRefztRot), ubound(InData%PtfmRefztRot)) call RegPack(Buf, InData%PtfmRefztRot) end if if (RegCheckErr(Buf, RoutineName)) return - ! WAMITULEN call RegPack(Buf, InData%WAMITULEN) if (RegCheckErr(Buf, RoutineName)) return - ! RhoXg call RegPack(Buf, InData%RhoXg) if (RegCheckErr(Buf, RoutineName)) return - ! NStepWave call RegPack(Buf, InData%NStepWave) if (RegCheckErr(Buf, RoutineName)) return - ! NStepWave2 call RegPack(Buf, InData%NStepWave2) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDOmega call RegPack(Buf, InData%WaveDOmega) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDens call RegPack(Buf, InData%WtrDens) if (RegCheckErr(Buf, RoutineName)) return - ! Gravity call RegPack(Buf, InData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDpth call RegPack(Buf, InData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - ! WaveElevC0 call RegPack(Buf, associated(InData%WaveElevC0)) if (associated(InData%WaveElevC0)) then call RegPackBounds(Buf, 2, lbound(InData%WaveElevC0), ubound(InData%WaveElevC0)) @@ -312,13 +292,10 @@ subroutine WAMIT2_PackInitInput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveDir call RegPack(Buf, InData%WaveDir) if (RegCheckErr(Buf, RoutineName)) return - ! WaveMultiDir call RegPack(Buf, InData%WaveMultiDir) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDirArr call RegPack(Buf, associated(InData%WaveDirArr)) if (associated(InData%WaveDirArr)) then call RegPackBounds(Buf, 1, lbound(InData%WaveDirArr), ubound(InData%WaveDirArr)) @@ -328,55 +305,38 @@ subroutine WAMIT2_PackInitInput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveDirMin call RegPack(Buf, InData%WaveDirMin) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDirMax call RegPack(Buf, InData%WaveDirMax) if (RegCheckErr(Buf, RoutineName)) return - ! WaveMod call RegPack(Buf, InData%WaveMod) if (RegCheckErr(Buf, RoutineName)) return - ! MnDrift call RegPack(Buf, InData%MnDrift) if (RegCheckErr(Buf, RoutineName)) return - ! NewmanApp call RegPack(Buf, InData%NewmanApp) if (RegCheckErr(Buf, RoutineName)) return - ! DiffQTF call RegPack(Buf, InData%DiffQTF) if (RegCheckErr(Buf, RoutineName)) return - ! SumQTF call RegPack(Buf, InData%SumQTF) if (RegCheckErr(Buf, RoutineName)) return - ! MnDriftF call RegPack(Buf, InData%MnDriftF) if (RegCheckErr(Buf, RoutineName)) return - ! NewmanAppF call RegPack(Buf, InData%NewmanAppF) if (RegCheckErr(Buf, RoutineName)) return - ! DiffQTFF call RegPack(Buf, InData%DiffQTFF) if (RegCheckErr(Buf, RoutineName)) return - ! SumQTFF call RegPack(Buf, InData%SumQTFF) if (RegCheckErr(Buf, RoutineName)) return - ! WvLowCOff call RegPack(Buf, InData%WvLowCOff) if (RegCheckErr(Buf, RoutineName)) return - ! WvHiCOff call RegPack(Buf, InData%WvHiCOff) if (RegCheckErr(Buf, RoutineName)) return - ! WvLowCOffD call RegPack(Buf, InData%WvLowCOffD) if (RegCheckErr(Buf, RoutineName)) return - ! WvHiCOffD call RegPack(Buf, InData%WvHiCOffD) if (RegCheckErr(Buf, RoutineName)) return - ! WvLowCOffS call RegPack(Buf, InData%WvLowCOffS) if (RegCheckErr(Buf, RoutineName)) return - ! WvHiCOffS call RegPack(Buf, InData%WvHiCOffS) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -391,19 +351,14 @@ subroutine WAMIT2_UnPackInitInput(Buf, OutData) integer(IntKi) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return - ! HasWAMIT call RegUnpack(Buf, OutData%HasWAMIT) if (RegCheckErr(Buf, RoutineName)) return - ! WAMITFile call RegUnpack(Buf, OutData%WAMITFile) if (RegCheckErr(Buf, RoutineName)) return - ! NBody call RegUnpack(Buf, OutData%NBody) if (RegCheckErr(Buf, RoutineName)) return - ! NBodyMod call RegUnpack(Buf, OutData%NBodyMod) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmRefxt if (allocated(OutData%PtfmRefxt)) deallocate(OutData%PtfmRefxt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -418,7 +373,6 @@ subroutine WAMIT2_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%PtfmRefxt) if (RegCheckErr(Buf, RoutineName)) return end if - ! PtfmRefyt if (allocated(OutData%PtfmRefyt)) deallocate(OutData%PtfmRefyt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -433,7 +387,6 @@ subroutine WAMIT2_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%PtfmRefyt) if (RegCheckErr(Buf, RoutineName)) return end if - ! PtfmRefzt if (allocated(OutData%PtfmRefzt)) deallocate(OutData%PtfmRefzt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -448,7 +401,6 @@ subroutine WAMIT2_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%PtfmRefzt) if (RegCheckErr(Buf, RoutineName)) return end if - ! PtfmRefztRot if (allocated(OutData%PtfmRefztRot)) deallocate(OutData%PtfmRefztRot) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -463,31 +415,22 @@ subroutine WAMIT2_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%PtfmRefztRot) if (RegCheckErr(Buf, RoutineName)) return end if - ! WAMITULEN call RegUnpack(Buf, OutData%WAMITULEN) if (RegCheckErr(Buf, RoutineName)) return - ! RhoXg call RegUnpack(Buf, OutData%RhoXg) if (RegCheckErr(Buf, RoutineName)) return - ! NStepWave call RegUnpack(Buf, OutData%NStepWave) if (RegCheckErr(Buf, RoutineName)) return - ! NStepWave2 call RegUnpack(Buf, OutData%NStepWave2) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDOmega call RegUnpack(Buf, OutData%WaveDOmega) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDens call RegUnpack(Buf, OutData%WtrDens) if (RegCheckErr(Buf, RoutineName)) return - ! Gravity call RegUnpack(Buf, OutData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDpth call RegUnpack(Buf, OutData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - ! WaveElevC0 if (associated(OutData%WaveElevC0)) deallocate(OutData%WaveElevC0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -512,13 +455,10 @@ subroutine WAMIT2_UnPackInitInput(Buf, OutData) else OutData%WaveElevC0 => null() end if - ! WaveDir call RegUnpack(Buf, OutData%WaveDir) if (RegCheckErr(Buf, RoutineName)) return - ! WaveMultiDir call RegUnpack(Buf, OutData%WaveMultiDir) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDirArr if (associated(OutData%WaveDirArr)) deallocate(OutData%WaveDirArr) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -543,134 +483,109 @@ subroutine WAMIT2_UnPackInitInput(Buf, OutData) else OutData%WaveDirArr => null() end if - ! WaveDirMin call RegUnpack(Buf, OutData%WaveDirMin) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDirMax call RegUnpack(Buf, OutData%WaveDirMax) if (RegCheckErr(Buf, RoutineName)) return - ! WaveMod call RegUnpack(Buf, OutData%WaveMod) if (RegCheckErr(Buf, RoutineName)) return - ! MnDrift call RegUnpack(Buf, OutData%MnDrift) if (RegCheckErr(Buf, RoutineName)) return - ! NewmanApp call RegUnpack(Buf, OutData%NewmanApp) if (RegCheckErr(Buf, RoutineName)) return - ! DiffQTF call RegUnpack(Buf, OutData%DiffQTF) if (RegCheckErr(Buf, RoutineName)) return - ! SumQTF call RegUnpack(Buf, OutData%SumQTF) if (RegCheckErr(Buf, RoutineName)) return - ! MnDriftF call RegUnpack(Buf, OutData%MnDriftF) if (RegCheckErr(Buf, RoutineName)) return - ! NewmanAppF call RegUnpack(Buf, OutData%NewmanAppF) if (RegCheckErr(Buf, RoutineName)) return - ! DiffQTFF call RegUnpack(Buf, OutData%DiffQTFF) if (RegCheckErr(Buf, RoutineName)) return - ! SumQTFF call RegUnpack(Buf, OutData%SumQTFF) if (RegCheckErr(Buf, RoutineName)) return - ! WvLowCOff call RegUnpack(Buf, OutData%WvLowCOff) if (RegCheckErr(Buf, RoutineName)) return - ! WvHiCOff call RegUnpack(Buf, OutData%WvHiCOff) if (RegCheckErr(Buf, RoutineName)) return - ! WvLowCOffD call RegUnpack(Buf, OutData%WvLowCOffD) if (RegCheckErr(Buf, RoutineName)) return - ! WvHiCOffD call RegUnpack(Buf, OutData%WvHiCOffD) if (RegCheckErr(Buf, RoutineName)) return - ! WvLowCOffS call RegUnpack(Buf, OutData%WvLowCOffS) if (RegCheckErr(Buf, RoutineName)) return - ! WvHiCOffS call RegUnpack(Buf, OutData%WvHiCOffS) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE WAMIT2_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WAMIT2_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(WAMIT2_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscData%LastIndWave)) THEN - i1_l = LBOUND(SrcMiscData%LastIndWave,1) - i1_u = UBOUND(SrcMiscData%LastIndWave,1) - IF (.NOT. ALLOCATED(DstMiscData%LastIndWave)) THEN - ALLOCATE(DstMiscData%LastIndWave(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LastIndWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%LastIndWave = SrcMiscData%LastIndWave -ENDIF -IF (ALLOCATED(SrcMiscData%F_Waves2)) THEN - i1_l = LBOUND(SrcMiscData%F_Waves2,1) - i1_u = UBOUND(SrcMiscData%F_Waves2,1) - IF (.NOT. ALLOCATED(DstMiscData%F_Waves2)) THEN - ALLOCATE(DstMiscData%F_Waves2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_Waves2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_Waves2 = SrcMiscData%F_Waves2 -ENDIF - END SUBROUTINE WAMIT2_CopyMisc - SUBROUTINE WAMIT2_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(WAMIT2_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MiscData%LastIndWave)) THEN - DEALLOCATE(MiscData%LastIndWave) -ENDIF -IF (ALLOCATED(MiscData%F_Waves2)) THEN - DEALLOCATE(MiscData%F_Waves2) -ENDIF - END SUBROUTINE WAMIT2_DestroyMisc +subroutine WAMIT2_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(WAMIT2_MiscVarType), intent(in) :: SrcMiscData + type(WAMIT2_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'WAMIT2_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMiscData%LastIndWave)) then + LB(1:1) = lbound(SrcMiscData%LastIndWave) + UB(1:1) = ubound(SrcMiscData%LastIndWave) + if (.not. allocated(DstMiscData%LastIndWave)) then + allocate(DstMiscData%LastIndWave(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LastIndWave.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%LastIndWave = SrcMiscData%LastIndWave + else if (allocated(DstMiscData%LastIndWave)) then + deallocate(DstMiscData%LastIndWave) + end if + if (allocated(SrcMiscData%F_Waves2)) then + LB(1:1) = lbound(SrcMiscData%F_Waves2) + UB(1:1) = ubound(SrcMiscData%F_Waves2) + if (.not. allocated(DstMiscData%F_Waves2)) then + allocate(DstMiscData%F_Waves2(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_Waves2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_Waves2 = SrcMiscData%F_Waves2 + else if (allocated(DstMiscData%F_Waves2)) then + deallocate(DstMiscData%F_Waves2) + end if +end subroutine +subroutine WAMIT2_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(WAMIT2_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WAMIT2_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%LastIndWave)) then + deallocate(MiscData%LastIndWave) + end if + if (allocated(MiscData%F_Waves2)) then + deallocate(MiscData%F_Waves2) + end if +end subroutine subroutine WAMIT2_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(WAMIT2_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'WAMIT2_PackMisc' if (Buf%ErrStat >= AbortErrLev) return - ! LastIndWave call RegPack(Buf, allocated(InData%LastIndWave)) if (allocated(InData%LastIndWave)) then call RegPackBounds(Buf, 1, lbound(InData%LastIndWave), ubound(InData%LastIndWave)) call RegPack(Buf, InData%LastIndWave) end if if (RegCheckErr(Buf, RoutineName)) return - ! F_Waves2 call RegPack(Buf, allocated(InData%F_Waves2)) if (allocated(InData%F_Waves2)) then call RegPackBounds(Buf, 1, lbound(InData%F_Waves2), ubound(InData%F_Waves2)) @@ -687,7 +602,6 @@ subroutine WAMIT2_UnPackMisc(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! LastIndWave if (allocated(OutData%LastIndWave)) deallocate(OutData%LastIndWave) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -702,7 +616,6 @@ subroutine WAMIT2_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%LastIndWave) if (RegCheckErr(Buf, RoutineName)) return end if - ! F_Waves2 if (allocated(OutData%F_Waves2)) deallocate(OutData%F_Waves2) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -718,111 +631,88 @@ subroutine WAMIT2_UnPackMisc(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE WAMIT2_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WAMIT2_ParameterType), INTENT(IN) :: SrcParamData - TYPE(WAMIT2_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%NStepWave = SrcParamData%NStepWave - DstParamData%NBody = SrcParamData%NBody - DstParamData%NBodyMod = SrcParamData%NBodyMod -IF (ALLOCATED(SrcParamData%WaveExctn2)) THEN - i1_l = LBOUND(SrcParamData%WaveExctn2,1) - i1_u = UBOUND(SrcParamData%WaveExctn2,1) - i2_l = LBOUND(SrcParamData%WaveExctn2,2) - i2_u = UBOUND(SrcParamData%WaveExctn2,2) - IF (.NOT. ALLOCATED(DstParamData%WaveExctn2)) THEN - ALLOCATE(DstParamData%WaveExctn2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveExctn2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveExctn2 = SrcParamData%WaveExctn2 -ENDIF - DstParamData%MnDriftDims = SrcParamData%MnDriftDims - DstParamData%NewmanAppDims = SrcParamData%NewmanAppDims - DstParamData%DiffQTFDims = SrcParamData%DiffQTFDims - DstParamData%SumQTFDims = SrcParamData%SumQTFDims - DstParamData%MnDriftF = SrcParamData%MnDriftF - DstParamData%NewmanAppF = SrcParamData%NewmanAppF - DstParamData%DiffQTFF = SrcParamData%DiffQTFF - DstParamData%SumQTFF = SrcParamData%SumQTFF - END SUBROUTINE WAMIT2_CopyParam - - SUBROUTINE WAMIT2_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(WAMIT2_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_DestroyParam' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%WaveExctn2)) THEN - DEALLOCATE(ParamData%WaveExctn2) -ENDIF - END SUBROUTINE WAMIT2_DestroyParam +subroutine WAMIT2_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(WAMIT2_ParameterType), intent(in) :: SrcParamData + type(WAMIT2_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'WAMIT2_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%NStepWave = SrcParamData%NStepWave + DstParamData%NBody = SrcParamData%NBody + DstParamData%NBodyMod = SrcParamData%NBodyMod + if (allocated(SrcParamData%WaveExctn2)) then + LB(1:2) = lbound(SrcParamData%WaveExctn2) + UB(1:2) = ubound(SrcParamData%WaveExctn2) + if (.not. allocated(DstParamData%WaveExctn2)) then + allocate(DstParamData%WaveExctn2(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveExctn2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WaveExctn2 = SrcParamData%WaveExctn2 + else if (allocated(DstParamData%WaveExctn2)) then + deallocate(DstParamData%WaveExctn2) + end if + DstParamData%MnDriftDims = SrcParamData%MnDriftDims + DstParamData%NewmanAppDims = SrcParamData%NewmanAppDims + DstParamData%DiffQTFDims = SrcParamData%DiffQTFDims + DstParamData%SumQTFDims = SrcParamData%SumQTFDims + DstParamData%MnDriftF = SrcParamData%MnDriftF + DstParamData%NewmanAppF = SrcParamData%NewmanAppF + DstParamData%DiffQTFF = SrcParamData%DiffQTFF + DstParamData%SumQTFF = SrcParamData%SumQTFF +end subroutine +subroutine WAMIT2_DestroyParam(ParamData, ErrStat, ErrMsg) + type(WAMIT2_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WAMIT2_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%WaveExctn2)) then + deallocate(ParamData%WaveExctn2) + end if +end subroutine subroutine WAMIT2_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(WAMIT2_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'WAMIT2_PackParam' if (Buf%ErrStat >= AbortErrLev) return - ! NStepWave call RegPack(Buf, InData%NStepWave) if (RegCheckErr(Buf, RoutineName)) return - ! NBody call RegPack(Buf, InData%NBody) if (RegCheckErr(Buf, RoutineName)) return - ! NBodyMod call RegPack(Buf, InData%NBodyMod) if (RegCheckErr(Buf, RoutineName)) return - ! WaveExctn2 call RegPack(Buf, allocated(InData%WaveExctn2)) if (allocated(InData%WaveExctn2)) then call RegPackBounds(Buf, 2, lbound(InData%WaveExctn2), ubound(InData%WaveExctn2)) call RegPack(Buf, InData%WaveExctn2) end if if (RegCheckErr(Buf, RoutineName)) return - ! MnDriftDims call RegPack(Buf, InData%MnDriftDims) if (RegCheckErr(Buf, RoutineName)) return - ! NewmanAppDims call RegPack(Buf, InData%NewmanAppDims) if (RegCheckErr(Buf, RoutineName)) return - ! DiffQTFDims call RegPack(Buf, InData%DiffQTFDims) if (RegCheckErr(Buf, RoutineName)) return - ! SumQTFDims call RegPack(Buf, InData%SumQTFDims) if (RegCheckErr(Buf, RoutineName)) return - ! MnDriftF call RegPack(Buf, InData%MnDriftF) if (RegCheckErr(Buf, RoutineName)) return - ! NewmanAppF call RegPack(Buf, InData%NewmanAppF) if (RegCheckErr(Buf, RoutineName)) return - ! DiffQTFF call RegPack(Buf, InData%DiffQTFF) if (RegCheckErr(Buf, RoutineName)) return - ! SumQTFF call RegPack(Buf, InData%SumQTFF) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -835,16 +725,12 @@ subroutine WAMIT2_UnPackParam(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! NStepWave call RegUnpack(Buf, OutData%NStepWave) if (RegCheckErr(Buf, RoutineName)) return - ! NBody call RegUnpack(Buf, OutData%NBody) if (RegCheckErr(Buf, RoutineName)) return - ! NBodyMod call RegUnpack(Buf, OutData%NBodyMod) if (RegCheckErr(Buf, RoutineName)) return - ! WaveExctn2 if (allocated(OutData%WaveExctn2)) deallocate(OutData%WaveExctn2) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -859,74 +745,56 @@ subroutine WAMIT2_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%WaveExctn2) if (RegCheckErr(Buf, RoutineName)) return end if - ! MnDriftDims call RegUnpack(Buf, OutData%MnDriftDims) if (RegCheckErr(Buf, RoutineName)) return - ! NewmanAppDims call RegUnpack(Buf, OutData%NewmanAppDims) if (RegCheckErr(Buf, RoutineName)) return - ! DiffQTFDims call RegUnpack(Buf, OutData%DiffQTFDims) if (RegCheckErr(Buf, RoutineName)) return - ! SumQTFDims call RegUnpack(Buf, OutData%SumQTFDims) if (RegCheckErr(Buf, RoutineName)) return - ! MnDriftF call RegUnpack(Buf, OutData%MnDriftF) if (RegCheckErr(Buf, RoutineName)) return - ! NewmanAppF call RegUnpack(Buf, OutData%NewmanAppF) if (RegCheckErr(Buf, RoutineName)) return - ! DiffQTFF call RegUnpack(Buf, OutData%DiffQTFF) if (RegCheckErr(Buf, RoutineName)) return - ! SumQTFF call RegUnpack(Buf, OutData%SumQTFF) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE WAMIT2_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WAMIT2_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(WAMIT2_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_CopyOutput' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcOutputData%Mesh, DstOutputData%Mesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE WAMIT2_CopyOutput - - SUBROUTINE WAMIT2_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(WAMIT2_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_DestroyOutput' - ErrStat = ErrID_None - ErrMsg = "" - - CALL MeshDestroy( OutputData%Mesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE WAMIT2_DestroyOutput +subroutine WAMIT2_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(WAMIT2_OutputType), intent(inout) :: SrcOutputData + type(WAMIT2_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT2_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcOutputData%Mesh, DstOutputData%Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine WAMIT2_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(WAMIT2_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT2_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine WAMIT2_PackOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(WAMIT2_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'WAMIT2_PackOutput' if (Buf%ErrStat >= AbortErrLev) return - ! Mesh call MeshPack(Buf, InData%Mesh) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -936,7 +804,6 @@ subroutine WAMIT2_UnPackOutput(Buf, OutData) type(WAMIT2_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WAMIT2_UnPackOutput' if (Buf%ErrStat /= ErrID_None) return - ! Mesh call MeshUnpack(Buf, OutData%Mesh) ! Mesh end subroutine diff --git a/modules/hydrodyn/src/WAMIT_Types.f90 b/modules/hydrodyn/src/WAMIT_Types.f90 index a1bc9d1fc8..8f682ab5ea 100644 --- a/modules/hydrodyn/src/WAMIT_Types.f90 +++ b/modules/hydrodyn/src/WAMIT_Types.f90 @@ -157,188 +157,189 @@ MODULE WAMIT_Types END TYPE WAMIT_OutputType ! ======================= CONTAINS - SUBROUTINE WAMIT_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WAMIT_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(WAMIT_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%NBody = SrcInitInputData%NBody - DstInitInputData%NBodyMod = SrcInitInputData%NBodyMod - DstInitInputData%Gravity = SrcInitInputData%Gravity - DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth -IF (ALLOCATED(SrcInitInputData%PtfmVol0)) THEN - i1_l = LBOUND(SrcInitInputData%PtfmVol0,1) - i1_u = UBOUND(SrcInitInputData%PtfmVol0,1) - IF (.NOT. ALLOCATED(DstInitInputData%PtfmVol0)) THEN - ALLOCATE(DstInitInputData%PtfmVol0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmVol0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PtfmVol0 = SrcInitInputData%PtfmVol0 -ENDIF - DstInitInputData%HasWAMIT = SrcInitInputData%HasWAMIT - DstInitInputData%WAMITULEN = SrcInitInputData%WAMITULEN -IF (ALLOCATED(SrcInitInputData%PtfmRefxt)) THEN - i1_l = LBOUND(SrcInitInputData%PtfmRefxt,1) - i1_u = UBOUND(SrcInitInputData%PtfmRefxt,1) - IF (.NOT. ALLOCATED(DstInitInputData%PtfmRefxt)) THEN - ALLOCATE(DstInitInputData%PtfmRefxt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefxt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PtfmRefxt = SrcInitInputData%PtfmRefxt -ENDIF -IF (ALLOCATED(SrcInitInputData%PtfmRefyt)) THEN - i1_l = LBOUND(SrcInitInputData%PtfmRefyt,1) - i1_u = UBOUND(SrcInitInputData%PtfmRefyt,1) - IF (.NOT. ALLOCATED(DstInitInputData%PtfmRefyt)) THEN - ALLOCATE(DstInitInputData%PtfmRefyt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefyt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PtfmRefyt = SrcInitInputData%PtfmRefyt -ENDIF -IF (ALLOCATED(SrcInitInputData%PtfmRefzt)) THEN - i1_l = LBOUND(SrcInitInputData%PtfmRefzt,1) - i1_u = UBOUND(SrcInitInputData%PtfmRefzt,1) - IF (.NOT. ALLOCATED(DstInitInputData%PtfmRefzt)) THEN - ALLOCATE(DstInitInputData%PtfmRefzt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefzt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PtfmRefzt = SrcInitInputData%PtfmRefzt -ENDIF -IF (ALLOCATED(SrcInitInputData%PtfmRefztRot)) THEN - i1_l = LBOUND(SrcInitInputData%PtfmRefztRot,1) - i1_u = UBOUND(SrcInitInputData%PtfmRefztRot,1) - IF (.NOT. ALLOCATED(DstInitInputData%PtfmRefztRot)) THEN - ALLOCATE(DstInitInputData%PtfmRefztRot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefztRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PtfmRefztRot = SrcInitInputData%PtfmRefztRot -ENDIF -IF (ALLOCATED(SrcInitInputData%PtfmCOBxt)) THEN - i1_l = LBOUND(SrcInitInputData%PtfmCOBxt,1) - i1_u = UBOUND(SrcInitInputData%PtfmCOBxt,1) - IF (.NOT. ALLOCATED(DstInitInputData%PtfmCOBxt)) THEN - ALLOCATE(DstInitInputData%PtfmCOBxt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmCOBxt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PtfmCOBxt = SrcInitInputData%PtfmCOBxt -ENDIF -IF (ALLOCATED(SrcInitInputData%PtfmCOByt)) THEN - i1_l = LBOUND(SrcInitInputData%PtfmCOByt,1) - i1_u = UBOUND(SrcInitInputData%PtfmCOByt,1) - IF (.NOT. ALLOCATED(DstInitInputData%PtfmCOByt)) THEN - ALLOCATE(DstInitInputData%PtfmCOByt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmCOByt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PtfmCOByt = SrcInitInputData%PtfmCOByt -ENDIF - DstInitInputData%RdtnMod = SrcInitInputData%RdtnMod - DstInitInputData%ExctnMod = SrcInitInputData%ExctnMod - DstInitInputData%ExctnDisp = SrcInitInputData%ExctnDisp - DstInitInputData%ExctnCutOff = SrcInitInputData%ExctnCutOff - DstInitInputData%RdtnTMax = SrcInitInputData%RdtnTMax - DstInitInputData%WaveDir = SrcInitInputData%WaveDir - DstInitInputData%WAMITFile = SrcInitInputData%WAMITFile - CALL Conv_Rdtn_CopyInitInput( SrcInitInputData%Conv_Rdtn, DstInitInputData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitInputData%Rhoxg = SrcInitInputData%Rhoxg - DstInitInputData%NStepWave = SrcInitInputData%NStepWave - DstInitInputData%NStepWave2 = SrcInitInputData%NStepWave2 - DstInitInputData%WaveDOmega = SrcInitInputData%WaveDOmega - DstInitInputData%WaveElev0 => SrcInitInputData%WaveElev0 - DstInitInputData%WaveElev1 => SrcInitInputData%WaveElev1 - DstInitInputData%WaveElevC0 => SrcInitInputData%WaveElevC0 - DstInitInputData%WaveElevC => SrcInitInputData%WaveElevC - DstInitInputData%WaveTime => SrcInitInputData%WaveTime - DstInitInputData%WaveMod = SrcInitInputData%WaveMod - DstInitInputData%WtrDens = SrcInitInputData%WtrDens - DstInitInputData%WaveDirArr => SrcInitInputData%WaveDirArr - DstInitInputData%WaveDirMin = SrcInitInputData%WaveDirMin - DstInitInputData%WaveDirMax = SrcInitInputData%WaveDirMax - CALL SeaSt_Interp_CopyParam( SrcInitInputData%SeaSt_Interp_p, DstInitInputData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE WAMIT_CopyInitInput - - SUBROUTINE WAMIT_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(WAMIT_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(InitInputData%PtfmVol0)) THEN - DEALLOCATE(InitInputData%PtfmVol0) -ENDIF -IF (ALLOCATED(InitInputData%PtfmRefxt)) THEN - DEALLOCATE(InitInputData%PtfmRefxt) -ENDIF -IF (ALLOCATED(InitInputData%PtfmRefyt)) THEN - DEALLOCATE(InitInputData%PtfmRefyt) -ENDIF -IF (ALLOCATED(InitInputData%PtfmRefzt)) THEN - DEALLOCATE(InitInputData%PtfmRefzt) -ENDIF -IF (ALLOCATED(InitInputData%PtfmRefztRot)) THEN - DEALLOCATE(InitInputData%PtfmRefztRot) -ENDIF -IF (ALLOCATED(InitInputData%PtfmCOBxt)) THEN - DEALLOCATE(InitInputData%PtfmCOBxt) -ENDIF -IF (ALLOCATED(InitInputData%PtfmCOByt)) THEN - DEALLOCATE(InitInputData%PtfmCOByt) -ENDIF - CALL Conv_Rdtn_DestroyInitInput( InitInputData%Conv_Rdtn, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -NULLIFY(InitInputData%WaveElev0) -NULLIFY(InitInputData%WaveElev1) -NULLIFY(InitInputData%WaveElevC0) -NULLIFY(InitInputData%WaveElevC) -NULLIFY(InitInputData%WaveTime) -NULLIFY(InitInputData%WaveDirArr) - CALL SeaSt_Interp_DestroyParam( InitInputData%SeaSt_Interp_p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE WAMIT_DestroyInitInput +subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(WAMIT_InitInputType), intent(in) :: SrcInitInputData + type(WAMIT_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitInputData%NBody = SrcInitInputData%NBody + DstInitInputData%NBodyMod = SrcInitInputData%NBodyMod + DstInitInputData%Gravity = SrcInitInputData%Gravity + DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth + if (allocated(SrcInitInputData%PtfmVol0)) then + LB(1:1) = lbound(SrcInitInputData%PtfmVol0) + UB(1:1) = ubound(SrcInitInputData%PtfmVol0) + if (.not. allocated(DstInitInputData%PtfmVol0)) then + allocate(DstInitInputData%PtfmVol0(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmVol0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%PtfmVol0 = SrcInitInputData%PtfmVol0 + else if (allocated(DstInitInputData%PtfmVol0)) then + deallocate(DstInitInputData%PtfmVol0) + end if + DstInitInputData%HasWAMIT = SrcInitInputData%HasWAMIT + DstInitInputData%WAMITULEN = SrcInitInputData%WAMITULEN + if (allocated(SrcInitInputData%PtfmRefxt)) then + LB(1:1) = lbound(SrcInitInputData%PtfmRefxt) + UB(1:1) = ubound(SrcInitInputData%PtfmRefxt) + if (.not. allocated(DstInitInputData%PtfmRefxt)) then + allocate(DstInitInputData%PtfmRefxt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefxt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%PtfmRefxt = SrcInitInputData%PtfmRefxt + else if (allocated(DstInitInputData%PtfmRefxt)) then + deallocate(DstInitInputData%PtfmRefxt) + end if + if (allocated(SrcInitInputData%PtfmRefyt)) then + LB(1:1) = lbound(SrcInitInputData%PtfmRefyt) + UB(1:1) = ubound(SrcInitInputData%PtfmRefyt) + if (.not. allocated(DstInitInputData%PtfmRefyt)) then + allocate(DstInitInputData%PtfmRefyt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefyt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%PtfmRefyt = SrcInitInputData%PtfmRefyt + else if (allocated(DstInitInputData%PtfmRefyt)) then + deallocate(DstInitInputData%PtfmRefyt) + end if + if (allocated(SrcInitInputData%PtfmRefzt)) then + LB(1:1) = lbound(SrcInitInputData%PtfmRefzt) + UB(1:1) = ubound(SrcInitInputData%PtfmRefzt) + if (.not. allocated(DstInitInputData%PtfmRefzt)) then + allocate(DstInitInputData%PtfmRefzt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefzt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%PtfmRefzt = SrcInitInputData%PtfmRefzt + else if (allocated(DstInitInputData%PtfmRefzt)) then + deallocate(DstInitInputData%PtfmRefzt) + end if + if (allocated(SrcInitInputData%PtfmRefztRot)) then + LB(1:1) = lbound(SrcInitInputData%PtfmRefztRot) + UB(1:1) = ubound(SrcInitInputData%PtfmRefztRot) + if (.not. allocated(DstInitInputData%PtfmRefztRot)) then + allocate(DstInitInputData%PtfmRefztRot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmRefztRot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%PtfmRefztRot = SrcInitInputData%PtfmRefztRot + else if (allocated(DstInitInputData%PtfmRefztRot)) then + deallocate(DstInitInputData%PtfmRefztRot) + end if + if (allocated(SrcInitInputData%PtfmCOBxt)) then + LB(1:1) = lbound(SrcInitInputData%PtfmCOBxt) + UB(1:1) = ubound(SrcInitInputData%PtfmCOBxt) + if (.not. allocated(DstInitInputData%PtfmCOBxt)) then + allocate(DstInitInputData%PtfmCOBxt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmCOBxt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%PtfmCOBxt = SrcInitInputData%PtfmCOBxt + else if (allocated(DstInitInputData%PtfmCOBxt)) then + deallocate(DstInitInputData%PtfmCOBxt) + end if + if (allocated(SrcInitInputData%PtfmCOByt)) then + LB(1:1) = lbound(SrcInitInputData%PtfmCOByt) + UB(1:1) = ubound(SrcInitInputData%PtfmCOByt) + if (.not. allocated(DstInitInputData%PtfmCOByt)) then + allocate(DstInitInputData%PtfmCOByt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmCOByt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%PtfmCOByt = SrcInitInputData%PtfmCOByt + else if (allocated(DstInitInputData%PtfmCOByt)) then + deallocate(DstInitInputData%PtfmCOByt) + end if + DstInitInputData%RdtnMod = SrcInitInputData%RdtnMod + DstInitInputData%ExctnMod = SrcInitInputData%ExctnMod + DstInitInputData%ExctnDisp = SrcInitInputData%ExctnDisp + DstInitInputData%ExctnCutOff = SrcInitInputData%ExctnCutOff + DstInitInputData%RdtnTMax = SrcInitInputData%RdtnTMax + DstInitInputData%WaveDir = SrcInitInputData%WaveDir + DstInitInputData%WAMITFile = SrcInitInputData%WAMITFile + call Conv_Rdtn_CopyInitInput(SrcInitInputData%Conv_Rdtn, DstInitInputData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitInputData%Rhoxg = SrcInitInputData%Rhoxg + DstInitInputData%NStepWave = SrcInitInputData%NStepWave + DstInitInputData%NStepWave2 = SrcInitInputData%NStepWave2 + DstInitInputData%WaveDOmega = SrcInitInputData%WaveDOmega + DstInitInputData%WaveElev0 => SrcInitInputData%WaveElev0 + DstInitInputData%WaveElev1 => SrcInitInputData%WaveElev1 + DstInitInputData%WaveElevC0 => SrcInitInputData%WaveElevC0 + DstInitInputData%WaveElevC => SrcInitInputData%WaveElevC + DstInitInputData%WaveTime => SrcInitInputData%WaveTime + DstInitInputData%WaveMod = SrcInitInputData%WaveMod + DstInitInputData%WtrDens = SrcInitInputData%WtrDens + DstInitInputData%WaveDirArr => SrcInitInputData%WaveDirArr + DstInitInputData%WaveDirMin = SrcInitInputData%WaveDirMin + DstInitInputData%WaveDirMax = SrcInitInputData%WaveDirMax + call SeaSt_Interp_CopyParam(SrcInitInputData%SeaSt_Interp_p, DstInitInputData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine WAMIT_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(WAMIT_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitInputData%PtfmVol0)) then + deallocate(InitInputData%PtfmVol0) + end if + if (allocated(InitInputData%PtfmRefxt)) then + deallocate(InitInputData%PtfmRefxt) + end if + if (allocated(InitInputData%PtfmRefyt)) then + deallocate(InitInputData%PtfmRefyt) + end if + if (allocated(InitInputData%PtfmRefzt)) then + deallocate(InitInputData%PtfmRefzt) + end if + if (allocated(InitInputData%PtfmRefztRot)) then + deallocate(InitInputData%PtfmRefztRot) + end if + if (allocated(InitInputData%PtfmCOBxt)) then + deallocate(InitInputData%PtfmCOBxt) + end if + if (allocated(InitInputData%PtfmCOByt)) then + deallocate(InitInputData%PtfmCOByt) + end if + nullify(InitInputData%WaveElev0) + nullify(InitInputData%WaveElev1) + nullify(InitInputData%WaveElevC0) + nullify(InitInputData%WaveElevC) + nullify(InitInputData%WaveTime) + nullify(InitInputData%WaveDirArr) +end subroutine subroutine WAMIT_PackInitInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -346,110 +347,84 @@ subroutine WAMIT_PackInitInput(Buf, Indata) character(*), parameter :: RoutineName = 'WAMIT_PackInitInput' logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return - ! NBody call RegPack(Buf, InData%NBody) if (RegCheckErr(Buf, RoutineName)) return - ! NBodyMod call RegPack(Buf, InData%NBodyMod) if (RegCheckErr(Buf, RoutineName)) return - ! Gravity call RegPack(Buf, InData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDpth call RegPack(Buf, InData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmVol0 call RegPack(Buf, allocated(InData%PtfmVol0)) if (allocated(InData%PtfmVol0)) then call RegPackBounds(Buf, 1, lbound(InData%PtfmVol0), ubound(InData%PtfmVol0)) call RegPack(Buf, InData%PtfmVol0) end if if (RegCheckErr(Buf, RoutineName)) return - ! HasWAMIT call RegPack(Buf, InData%HasWAMIT) if (RegCheckErr(Buf, RoutineName)) return - ! WAMITULEN call RegPack(Buf, InData%WAMITULEN) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmRefxt call RegPack(Buf, allocated(InData%PtfmRefxt)) if (allocated(InData%PtfmRefxt)) then call RegPackBounds(Buf, 1, lbound(InData%PtfmRefxt), ubound(InData%PtfmRefxt)) call RegPack(Buf, InData%PtfmRefxt) end if if (RegCheckErr(Buf, RoutineName)) return - ! PtfmRefyt call RegPack(Buf, allocated(InData%PtfmRefyt)) if (allocated(InData%PtfmRefyt)) then call RegPackBounds(Buf, 1, lbound(InData%PtfmRefyt), ubound(InData%PtfmRefyt)) call RegPack(Buf, InData%PtfmRefyt) end if if (RegCheckErr(Buf, RoutineName)) return - ! PtfmRefzt call RegPack(Buf, allocated(InData%PtfmRefzt)) if (allocated(InData%PtfmRefzt)) then call RegPackBounds(Buf, 1, lbound(InData%PtfmRefzt), ubound(InData%PtfmRefzt)) call RegPack(Buf, InData%PtfmRefzt) end if if (RegCheckErr(Buf, RoutineName)) return - ! PtfmRefztRot call RegPack(Buf, allocated(InData%PtfmRefztRot)) if (allocated(InData%PtfmRefztRot)) then call RegPackBounds(Buf, 1, lbound(InData%PtfmRefztRot), ubound(InData%PtfmRefztRot)) call RegPack(Buf, InData%PtfmRefztRot) end if if (RegCheckErr(Buf, RoutineName)) return - ! PtfmCOBxt call RegPack(Buf, allocated(InData%PtfmCOBxt)) if (allocated(InData%PtfmCOBxt)) then call RegPackBounds(Buf, 1, lbound(InData%PtfmCOBxt), ubound(InData%PtfmCOBxt)) call RegPack(Buf, InData%PtfmCOBxt) end if if (RegCheckErr(Buf, RoutineName)) return - ! PtfmCOByt call RegPack(Buf, allocated(InData%PtfmCOByt)) if (allocated(InData%PtfmCOByt)) then call RegPackBounds(Buf, 1, lbound(InData%PtfmCOByt), ubound(InData%PtfmCOByt)) call RegPack(Buf, InData%PtfmCOByt) end if if (RegCheckErr(Buf, RoutineName)) return - ! RdtnMod call RegPack(Buf, InData%RdtnMod) if (RegCheckErr(Buf, RoutineName)) return - ! ExctnMod call RegPack(Buf, InData%ExctnMod) if (RegCheckErr(Buf, RoutineName)) return - ! ExctnDisp call RegPack(Buf, InData%ExctnDisp) if (RegCheckErr(Buf, RoutineName)) return - ! ExctnCutOff call RegPack(Buf, InData%ExctnCutOff) if (RegCheckErr(Buf, RoutineName)) return - ! RdtnTMax call RegPack(Buf, InData%RdtnTMax) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDir call RegPack(Buf, InData%WaveDir) if (RegCheckErr(Buf, RoutineName)) return - ! WAMITFile call RegPack(Buf, InData%WAMITFile) if (RegCheckErr(Buf, RoutineName)) return - ! Conv_Rdtn call Conv_Rdtn_PackInitInput(Buf, InData%Conv_Rdtn) if (RegCheckErr(Buf, RoutineName)) return - ! Rhoxg call RegPack(Buf, InData%Rhoxg) if (RegCheckErr(Buf, RoutineName)) return - ! NStepWave call RegPack(Buf, InData%NStepWave) if (RegCheckErr(Buf, RoutineName)) return - ! NStepWave2 call RegPack(Buf, InData%NStepWave2) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDOmega call RegPack(Buf, InData%WaveDOmega) if (RegCheckErr(Buf, RoutineName)) return - ! WaveElev0 call RegPack(Buf, associated(InData%WaveElev0)) if (associated(InData%WaveElev0)) then call RegPackBounds(Buf, 1, lbound(InData%WaveElev0), ubound(InData%WaveElev0)) @@ -459,7 +434,6 @@ subroutine WAMIT_PackInitInput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveElev1 call RegPack(Buf, associated(InData%WaveElev1)) if (associated(InData%WaveElev1)) then call RegPackBounds(Buf, 3, lbound(InData%WaveElev1), ubound(InData%WaveElev1)) @@ -469,7 +443,6 @@ subroutine WAMIT_PackInitInput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveElevC0 call RegPack(Buf, associated(InData%WaveElevC0)) if (associated(InData%WaveElevC0)) then call RegPackBounds(Buf, 2, lbound(InData%WaveElevC0), ubound(InData%WaveElevC0)) @@ -479,7 +452,6 @@ subroutine WAMIT_PackInitInput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveElevC call RegPack(Buf, associated(InData%WaveElevC)) if (associated(InData%WaveElevC)) then call RegPackBounds(Buf, 3, lbound(InData%WaveElevC), ubound(InData%WaveElevC)) @@ -489,7 +461,6 @@ subroutine WAMIT_PackInitInput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveTime call RegPack(Buf, associated(InData%WaveTime)) if (associated(InData%WaveTime)) then call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) @@ -499,13 +470,10 @@ subroutine WAMIT_PackInitInput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveMod call RegPack(Buf, InData%WaveMod) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDens call RegPack(Buf, InData%WtrDens) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDirArr call RegPack(Buf, associated(InData%WaveDirArr)) if (associated(InData%WaveDirArr)) then call RegPackBounds(Buf, 1, lbound(InData%WaveDirArr), ubound(InData%WaveDirArr)) @@ -515,13 +483,10 @@ subroutine WAMIT_PackInitInput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveDirMin call RegPack(Buf, InData%WaveDirMin) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDirMax call RegPack(Buf, InData%WaveDirMax) if (RegCheckErr(Buf, RoutineName)) return - ! SeaSt_Interp_p call SeaSt_Interp_PackParam(Buf, InData%SeaSt_Interp_p) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -536,19 +501,14 @@ subroutine WAMIT_UnPackInitInput(Buf, OutData) integer(IntKi) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return - ! NBody call RegUnpack(Buf, OutData%NBody) if (RegCheckErr(Buf, RoutineName)) return - ! NBodyMod call RegUnpack(Buf, OutData%NBodyMod) if (RegCheckErr(Buf, RoutineName)) return - ! Gravity call RegUnpack(Buf, OutData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDpth call RegUnpack(Buf, OutData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmVol0 if (allocated(OutData%PtfmVol0)) deallocate(OutData%PtfmVol0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -563,13 +523,10 @@ subroutine WAMIT_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%PtfmVol0) if (RegCheckErr(Buf, RoutineName)) return end if - ! HasWAMIT call RegUnpack(Buf, OutData%HasWAMIT) if (RegCheckErr(Buf, RoutineName)) return - ! WAMITULEN call RegUnpack(Buf, OutData%WAMITULEN) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmRefxt if (allocated(OutData%PtfmRefxt)) deallocate(OutData%PtfmRefxt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -584,7 +541,6 @@ subroutine WAMIT_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%PtfmRefxt) if (RegCheckErr(Buf, RoutineName)) return end if - ! PtfmRefyt if (allocated(OutData%PtfmRefyt)) deallocate(OutData%PtfmRefyt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -599,7 +555,6 @@ subroutine WAMIT_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%PtfmRefyt) if (RegCheckErr(Buf, RoutineName)) return end if - ! PtfmRefzt if (allocated(OutData%PtfmRefzt)) deallocate(OutData%PtfmRefzt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -614,7 +569,6 @@ subroutine WAMIT_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%PtfmRefzt) if (RegCheckErr(Buf, RoutineName)) return end if - ! PtfmRefztRot if (allocated(OutData%PtfmRefztRot)) deallocate(OutData%PtfmRefztRot) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -629,7 +583,6 @@ subroutine WAMIT_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%PtfmRefztRot) if (RegCheckErr(Buf, RoutineName)) return end if - ! PtfmCOBxt if (allocated(OutData%PtfmCOBxt)) deallocate(OutData%PtfmCOBxt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -644,7 +597,6 @@ subroutine WAMIT_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%PtfmCOBxt) if (RegCheckErr(Buf, RoutineName)) return end if - ! PtfmCOByt if (allocated(OutData%PtfmCOByt)) deallocate(OutData%PtfmCOByt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -659,42 +611,29 @@ subroutine WAMIT_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%PtfmCOByt) if (RegCheckErr(Buf, RoutineName)) return end if - ! RdtnMod call RegUnpack(Buf, OutData%RdtnMod) if (RegCheckErr(Buf, RoutineName)) return - ! ExctnMod call RegUnpack(Buf, OutData%ExctnMod) if (RegCheckErr(Buf, RoutineName)) return - ! ExctnDisp call RegUnpack(Buf, OutData%ExctnDisp) if (RegCheckErr(Buf, RoutineName)) return - ! ExctnCutOff call RegUnpack(Buf, OutData%ExctnCutOff) if (RegCheckErr(Buf, RoutineName)) return - ! RdtnTMax call RegUnpack(Buf, OutData%RdtnTMax) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDir call RegUnpack(Buf, OutData%WaveDir) if (RegCheckErr(Buf, RoutineName)) return - ! WAMITFile call RegUnpack(Buf, OutData%WAMITFile) if (RegCheckErr(Buf, RoutineName)) return - ! Conv_Rdtn call Conv_Rdtn_UnpackInitInput(Buf, OutData%Conv_Rdtn) ! Conv_Rdtn - ! Rhoxg call RegUnpack(Buf, OutData%Rhoxg) if (RegCheckErr(Buf, RoutineName)) return - ! NStepWave call RegUnpack(Buf, OutData%NStepWave) if (RegCheckErr(Buf, RoutineName)) return - ! NStepWave2 call RegUnpack(Buf, OutData%NStepWave2) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDOmega call RegUnpack(Buf, OutData%WaveDOmega) if (RegCheckErr(Buf, RoutineName)) return - ! WaveElev0 if (associated(OutData%WaveElev0)) deallocate(OutData%WaveElev0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -719,7 +658,6 @@ subroutine WAMIT_UnPackInitInput(Buf, OutData) else OutData%WaveElev0 => null() end if - ! WaveElev1 if (associated(OutData%WaveElev1)) deallocate(OutData%WaveElev1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -744,7 +682,6 @@ subroutine WAMIT_UnPackInitInput(Buf, OutData) else OutData%WaveElev1 => null() end if - ! WaveElevC0 if (associated(OutData%WaveElevC0)) deallocate(OutData%WaveElevC0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -769,7 +706,6 @@ subroutine WAMIT_UnPackInitInput(Buf, OutData) else OutData%WaveElevC0 => null() end if - ! WaveElevC if (associated(OutData%WaveElevC)) deallocate(OutData%WaveElevC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -794,7 +730,6 @@ subroutine WAMIT_UnPackInitInput(Buf, OutData) else OutData%WaveElevC => null() end if - ! WaveTime if (associated(OutData%WaveTime)) deallocate(OutData%WaveTime) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -819,13 +754,10 @@ subroutine WAMIT_UnPackInitInput(Buf, OutData) else OutData%WaveTime => null() end if - ! WaveMod call RegUnpack(Buf, OutData%WaveMod) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDens call RegUnpack(Buf, OutData%WtrDens) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDirArr if (associated(OutData%WaveDirArr)) deallocate(OutData%WaveDirArr) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -850,74 +782,55 @@ subroutine WAMIT_UnPackInitInput(Buf, OutData) else OutData%WaveDirArr => null() end if - ! WaveDirMin call RegUnpack(Buf, OutData%WaveDirMin) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDirMax call RegUnpack(Buf, OutData%WaveDirMax) if (RegCheckErr(Buf, RoutineName)) return - ! SeaSt_Interp_p call SeaSt_Interp_UnpackParam(Buf, OutData%SeaSt_Interp_p) ! SeaSt_Interp_p end subroutine - SUBROUTINE WAMIT_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WAMIT_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(WAMIT_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL SS_Rad_CopyContState( SrcContStateData%SS_Rdtn, DstContStateData%SS_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SS_Exc_CopyContState( SrcContStateData%SS_Exctn, DstContStateData%SS_Exctn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Conv_Rdtn_CopyContState( SrcContStateData%Conv_Rdtn, DstContStateData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE WAMIT_CopyContState - - SUBROUTINE WAMIT_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(WAMIT_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - CALL SS_Rad_DestroyContState( ContStateData%SS_Rdtn, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SS_Exc_DestroyContState( ContStateData%SS_Exctn, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Conv_Rdtn_DestroyContState( ContStateData%Conv_Rdtn, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE WAMIT_DestroyContState +subroutine WAMIT_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(WAMIT_ContinuousStateType), intent(in) :: SrcContStateData + type(WAMIT_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + call SS_Rad_CopyContState(SrcContStateData%SS_Rdtn, DstContStateData%SS_Rdtn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SS_Exc_CopyContState(SrcContStateData%SS_Exctn, DstContStateData%SS_Exctn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Conv_Rdtn_CopyContState(SrcContStateData%Conv_Rdtn, DstContStateData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine WAMIT_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(WAMIT_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine WAMIT_PackContState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(WAMIT_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'WAMIT_PackContState' if (Buf%ErrStat >= AbortErrLev) return - ! SS_Rdtn call SS_Rad_PackContState(Buf, InData%SS_Rdtn) if (RegCheckErr(Buf, RoutineName)) return - ! SS_Exctn call SS_Exc_PackContState(Buf, InData%SS_Exctn) if (RegCheckErr(Buf, RoutineName)) return - ! Conv_Rdtn call Conv_Rdtn_PackContState(Buf, InData%Conv_Rdtn) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -927,97 +840,73 @@ subroutine WAMIT_UnPackContState(Buf, OutData) type(WAMIT_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WAMIT_UnPackContState' if (Buf%ErrStat /= ErrID_None) return - ! SS_Rdtn call SS_Rad_UnpackContState(Buf, OutData%SS_Rdtn) ! SS_Rdtn - ! SS_Exctn call SS_Exc_UnpackContState(Buf, OutData%SS_Exctn) ! SS_Exctn - ! Conv_Rdtn call Conv_Rdtn_UnpackContState(Buf, OutData%Conv_Rdtn) ! Conv_Rdtn end subroutine - SUBROUTINE WAMIT_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WAMIT_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(WAMIT_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (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 = 'WAMIT_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL Conv_Rdtn_CopyDiscState( SrcDiscStateData%Conv_Rdtn, DstDiscStateData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SS_Rad_CopyDiscState( SrcDiscStateData%SS_Rdtn, DstDiscStateData%SS_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SS_Exc_CopyDiscState( SrcDiscStateData%SS_Exctn, DstDiscStateData%SS_Exctn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcDiscStateData%BdyPosFilt)) THEN - i1_l = LBOUND(SrcDiscStateData%BdyPosFilt,1) - i1_u = UBOUND(SrcDiscStateData%BdyPosFilt,1) - i2_l = LBOUND(SrcDiscStateData%BdyPosFilt,2) - i2_u = UBOUND(SrcDiscStateData%BdyPosFilt,2) - i3_l = LBOUND(SrcDiscStateData%BdyPosFilt,3) - i3_u = UBOUND(SrcDiscStateData%BdyPosFilt,3) - IF (.NOT. ALLOCATED(DstDiscStateData%BdyPosFilt)) THEN - ALLOCATE(DstDiscStateData%BdyPosFilt(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%BdyPosFilt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%BdyPosFilt = SrcDiscStateData%BdyPosFilt -ENDIF - END SUBROUTINE WAMIT_CopyDiscState - - SUBROUTINE WAMIT_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(WAMIT_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - CALL Conv_Rdtn_DestroyDiscState( DiscStateData%Conv_Rdtn, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SS_Rad_DestroyDiscState( DiscStateData%SS_Rdtn, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SS_Exc_DestroyDiscState( DiscStateData%SS_Exctn, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(DiscStateData%BdyPosFilt)) THEN - DEALLOCATE(DiscStateData%BdyPosFilt) -ENDIF - END SUBROUTINE WAMIT_DestroyDiscState +subroutine WAMIT_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(WAMIT_DiscreteStateType), intent(in) :: SrcDiscStateData + type(WAMIT_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + call Conv_Rdtn_CopyDiscState(SrcDiscStateData%Conv_Rdtn, DstDiscStateData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SS_Rad_CopyDiscState(SrcDiscStateData%SS_Rdtn, DstDiscStateData%SS_Rdtn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SS_Exc_CopyDiscState(SrcDiscStateData%SS_Exctn, DstDiscStateData%SS_Exctn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcDiscStateData%BdyPosFilt)) then + LB(1:3) = lbound(SrcDiscStateData%BdyPosFilt) + UB(1:3) = ubound(SrcDiscStateData%BdyPosFilt) + if (.not. allocated(DstDiscStateData%BdyPosFilt)) then + allocate(DstDiscStateData%BdyPosFilt(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%BdyPosFilt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%BdyPosFilt = SrcDiscStateData%BdyPosFilt + else if (allocated(DstDiscStateData%BdyPosFilt)) then + deallocate(DstDiscStateData%BdyPosFilt) + end if +end subroutine +subroutine WAMIT_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(WAMIT_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(DiscStateData%BdyPosFilt)) then + deallocate(DiscStateData%BdyPosFilt) + end if +end subroutine subroutine WAMIT_PackDiscState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(WAMIT_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'WAMIT_PackDiscState' if (Buf%ErrStat >= AbortErrLev) return - ! Conv_Rdtn call Conv_Rdtn_PackDiscState(Buf, InData%Conv_Rdtn) if (RegCheckErr(Buf, RoutineName)) return - ! SS_Rdtn call SS_Rad_PackDiscState(Buf, InData%SS_Rdtn) if (RegCheckErr(Buf, RoutineName)) return - ! SS_Exctn call SS_Exc_PackDiscState(Buf, InData%SS_Exctn) if (RegCheckErr(Buf, RoutineName)) return - ! BdyPosFilt call RegPack(Buf, allocated(InData%BdyPosFilt)) if (allocated(InData%BdyPosFilt)) then call RegPackBounds(Buf, 3, lbound(InData%BdyPosFilt), ubound(InData%BdyPosFilt)) @@ -1034,13 +923,9 @@ subroutine WAMIT_UnPackDiscState(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! Conv_Rdtn call Conv_Rdtn_UnpackDiscState(Buf, OutData%Conv_Rdtn) ! Conv_Rdtn - ! SS_Rdtn call SS_Rad_UnpackDiscState(Buf, OutData%SS_Rdtn) ! SS_Rdtn - ! SS_Exctn call SS_Exc_UnpackDiscState(Buf, OutData%SS_Exctn) ! SS_Exctn - ! BdyPosFilt if (allocated(OutData%BdyPosFilt)) deallocate(OutData%BdyPosFilt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1056,65 +941,49 @@ subroutine WAMIT_UnPackDiscState(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE WAMIT_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WAMIT_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(WAMIT_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL Conv_Rdtn_CopyConstrState( SrcConstrStateData%Conv_Rdtn, DstConstrStateData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SS_Rad_CopyConstrState( SrcConstrStateData%SS_Rdtn, DstConstrStateData%SS_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SS_Exc_CopyConstrState( SrcConstrStateData%SS_Exctn, DstConstrStateData%SS_Exctn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE WAMIT_CopyConstrState - - SUBROUTINE WAMIT_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(WAMIT_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_DestroyConstrState' - ErrStat = ErrID_None - ErrMsg = "" - - CALL Conv_Rdtn_DestroyConstrState( ConstrStateData%Conv_Rdtn, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SS_Rad_DestroyConstrState( ConstrStateData%SS_Rdtn, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SS_Exc_DestroyConstrState( ConstrStateData%SS_Exctn, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE WAMIT_DestroyConstrState +subroutine WAMIT_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(WAMIT_ConstraintStateType), intent(in) :: SrcConstrStateData + type(WAMIT_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + call Conv_Rdtn_CopyConstrState(SrcConstrStateData%Conv_Rdtn, DstConstrStateData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SS_Rad_CopyConstrState(SrcConstrStateData%SS_Rdtn, DstConstrStateData%SS_Rdtn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SS_Exc_CopyConstrState(SrcConstrStateData%SS_Exctn, DstConstrStateData%SS_Exctn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine WAMIT_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(WAMIT_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine WAMIT_PackConstrState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(WAMIT_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'WAMIT_PackConstrState' if (Buf%ErrStat >= AbortErrLev) return - ! Conv_Rdtn call Conv_Rdtn_PackConstrState(Buf, InData%Conv_Rdtn) if (RegCheckErr(Buf, RoutineName)) return - ! SS_Rdtn call SS_Rad_PackConstrState(Buf, InData%SS_Rdtn) if (RegCheckErr(Buf, RoutineName)) return - ! SS_Exctn call SS_Exc_PackConstrState(Buf, InData%SS_Exctn) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1124,72 +993,53 @@ subroutine WAMIT_UnPackConstrState(Buf, OutData) type(WAMIT_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WAMIT_UnPackConstrState' if (Buf%ErrStat /= ErrID_None) return - ! Conv_Rdtn call Conv_Rdtn_UnpackConstrState(Buf, OutData%Conv_Rdtn) ! Conv_Rdtn - ! SS_Rdtn call SS_Rad_UnpackConstrState(Buf, OutData%SS_Rdtn) ! SS_Rdtn - ! SS_Exctn call SS_Exc_UnpackConstrState(Buf, OutData%SS_Exctn) ! SS_Exctn end subroutine - SUBROUTINE WAMIT_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WAMIT_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(WAMIT_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL SS_Rad_CopyOtherState( SrcOtherStateData%SS_Rdtn, DstOtherStateData%SS_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SS_Exc_CopyOtherState( SrcOtherStateData%SS_Exctn, DstOtherStateData%SS_Exctn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Conv_Rdtn_CopyOtherState( SrcOtherStateData%Conv_Rdtn, DstOtherStateData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE WAMIT_CopyOtherState - - SUBROUTINE WAMIT_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(WAMIT_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_DestroyOtherState' - ErrStat = ErrID_None - ErrMsg = "" - - CALL SS_Rad_DestroyOtherState( OtherStateData%SS_Rdtn, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SS_Exc_DestroyOtherState( OtherStateData%SS_Exctn, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Conv_Rdtn_DestroyOtherState( OtherStateData%Conv_Rdtn, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE WAMIT_DestroyOtherState +subroutine WAMIT_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(WAMIT_OtherStateType), intent(in) :: SrcOtherStateData + type(WAMIT_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + call SS_Rad_CopyOtherState(SrcOtherStateData%SS_Rdtn, DstOtherStateData%SS_Rdtn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SS_Exc_CopyOtherState(SrcOtherStateData%SS_Exctn, DstOtherStateData%SS_Exctn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Conv_Rdtn_CopyOtherState(SrcOtherStateData%Conv_Rdtn, DstOtherStateData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine WAMIT_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(WAMIT_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine WAMIT_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(WAMIT_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'WAMIT_PackOtherState' if (Buf%ErrStat >= AbortErrLev) return - ! SS_Rdtn call SS_Rad_PackOtherState(Buf, InData%SS_Rdtn) if (RegCheckErr(Buf, RoutineName)) return - ! SS_Exctn call SS_Exc_PackOtherState(Buf, InData%SS_Exctn) if (RegCheckErr(Buf, RoutineName)) return - ! Conv_Rdtn call Conv_Rdtn_PackOtherState(Buf, InData%Conv_Rdtn) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1199,221 +1049,184 @@ subroutine WAMIT_UnPackOtherState(Buf, OutData) type(WAMIT_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WAMIT_UnPackOtherState' if (Buf%ErrStat /= ErrID_None) return - ! SS_Rdtn call SS_Rad_UnpackOtherState(Buf, OutData%SS_Rdtn) ! SS_Rdtn - ! SS_Exctn call SS_Exc_UnpackOtherState(Buf, OutData%SS_Exctn) ! SS_Exctn - ! Conv_Rdtn call Conv_Rdtn_UnpackOtherState(Buf, OutData%Conv_Rdtn) ! Conv_Rdtn end subroutine - SUBROUTINE WAMIT_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WAMIT_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(WAMIT_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%LastIndWave = SrcMiscData%LastIndWave -IF (ALLOCATED(SrcMiscData%F_HS)) THEN - i1_l = LBOUND(SrcMiscData%F_HS,1) - i1_u = UBOUND(SrcMiscData%F_HS,1) - IF (.NOT. ALLOCATED(DstMiscData%F_HS)) THEN - ALLOCATE(DstMiscData%F_HS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_HS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_HS = SrcMiscData%F_HS -ENDIF -IF (ALLOCATED(SrcMiscData%F_Waves1)) THEN - i1_l = LBOUND(SrcMiscData%F_Waves1,1) - i1_u = UBOUND(SrcMiscData%F_Waves1,1) - IF (.NOT. ALLOCATED(DstMiscData%F_Waves1)) THEN - ALLOCATE(DstMiscData%F_Waves1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_Waves1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_Waves1 = SrcMiscData%F_Waves1 -ENDIF -IF (ALLOCATED(SrcMiscData%F_Rdtn)) THEN - i1_l = LBOUND(SrcMiscData%F_Rdtn,1) - i1_u = UBOUND(SrcMiscData%F_Rdtn,1) - IF (.NOT. ALLOCATED(DstMiscData%F_Rdtn)) THEN - ALLOCATE(DstMiscData%F_Rdtn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_Rdtn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_Rdtn = SrcMiscData%F_Rdtn -ENDIF -IF (ALLOCATED(SrcMiscData%F_PtfmAM)) THEN - i1_l = LBOUND(SrcMiscData%F_PtfmAM,1) - i1_u = UBOUND(SrcMiscData%F_PtfmAM,1) - IF (.NOT. ALLOCATED(DstMiscData%F_PtfmAM)) THEN - ALLOCATE(DstMiscData%F_PtfmAM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_PtfmAM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_PtfmAM = SrcMiscData%F_PtfmAM -ENDIF - CALL SS_Rad_CopyMisc( SrcMiscData%SS_Rdtn, DstMiscData%SS_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SS_Rad_CopyInput( SrcMiscData%SS_Rdtn_u, DstMiscData%SS_Rdtn_u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SS_Rad_CopyOutput( SrcMiscData%SS_Rdtn_y, DstMiscData%SS_Rdtn_y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SS_Exc_CopyMisc( SrcMiscData%SS_Exctn, DstMiscData%SS_Exctn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SS_Exc_CopyInput( SrcMiscData%SS_Exctn_u, DstMiscData%SS_Exctn_u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SS_Exc_CopyOutput( SrcMiscData%SS_Exctn_y, DstMiscData%SS_Exctn_y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Conv_Rdtn_CopyMisc( SrcMiscData%Conv_Rdtn, DstMiscData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Conv_Rdtn_CopyInput( SrcMiscData%Conv_Rdtn_u, DstMiscData%Conv_Rdtn_u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Conv_Rdtn_CopyOutput( SrcMiscData%Conv_Rdtn_y, DstMiscData%Conv_Rdtn_y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SeaSt_Interp_CopyMisc( SrcMiscData%SeaSt_Interp_m, DstMiscData%SeaSt_Interp_m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE WAMIT_CopyMisc - - SUBROUTINE WAMIT_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(WAMIT_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_DestroyMisc' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MiscData%F_HS)) THEN - DEALLOCATE(MiscData%F_HS) -ENDIF -IF (ALLOCATED(MiscData%F_Waves1)) THEN - DEALLOCATE(MiscData%F_Waves1) -ENDIF -IF (ALLOCATED(MiscData%F_Rdtn)) THEN - DEALLOCATE(MiscData%F_Rdtn) -ENDIF -IF (ALLOCATED(MiscData%F_PtfmAM)) THEN - DEALLOCATE(MiscData%F_PtfmAM) -ENDIF - CALL SS_Rad_DestroyMisc( MiscData%SS_Rdtn, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SS_Rad_DestroyInput( MiscData%SS_Rdtn_u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SS_Rad_DestroyOutput( MiscData%SS_Rdtn_y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SS_Exc_DestroyMisc( MiscData%SS_Exctn, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SS_Exc_DestroyInput( MiscData%SS_Exctn_u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SS_Exc_DestroyOutput( MiscData%SS_Exctn_y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Conv_Rdtn_DestroyMisc( MiscData%Conv_Rdtn, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Conv_Rdtn_DestroyInput( MiscData%Conv_Rdtn_u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Conv_Rdtn_DestroyOutput( MiscData%Conv_Rdtn_y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SeaSt_Interp_DestroyMisc( MiscData%SeaSt_Interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE WAMIT_DestroyMisc +subroutine WAMIT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(WAMIT_MiscVarType), intent(in) :: SrcMiscData + type(WAMIT_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%LastIndWave = SrcMiscData%LastIndWave + if (allocated(SrcMiscData%F_HS)) then + LB(1:1) = lbound(SrcMiscData%F_HS) + UB(1:1) = ubound(SrcMiscData%F_HS) + if (.not. allocated(DstMiscData%F_HS)) then + allocate(DstMiscData%F_HS(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_HS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_HS = SrcMiscData%F_HS + else if (allocated(DstMiscData%F_HS)) then + deallocate(DstMiscData%F_HS) + end if + if (allocated(SrcMiscData%F_Waves1)) then + LB(1:1) = lbound(SrcMiscData%F_Waves1) + UB(1:1) = ubound(SrcMiscData%F_Waves1) + if (.not. allocated(DstMiscData%F_Waves1)) then + allocate(DstMiscData%F_Waves1(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_Waves1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_Waves1 = SrcMiscData%F_Waves1 + else if (allocated(DstMiscData%F_Waves1)) then + deallocate(DstMiscData%F_Waves1) + end if + if (allocated(SrcMiscData%F_Rdtn)) then + LB(1:1) = lbound(SrcMiscData%F_Rdtn) + UB(1:1) = ubound(SrcMiscData%F_Rdtn) + if (.not. allocated(DstMiscData%F_Rdtn)) then + allocate(DstMiscData%F_Rdtn(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_Rdtn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_Rdtn = SrcMiscData%F_Rdtn + else if (allocated(DstMiscData%F_Rdtn)) then + deallocate(DstMiscData%F_Rdtn) + end if + if (allocated(SrcMiscData%F_PtfmAM)) then + LB(1:1) = lbound(SrcMiscData%F_PtfmAM) + UB(1:1) = ubound(SrcMiscData%F_PtfmAM) + if (.not. allocated(DstMiscData%F_PtfmAM)) then + allocate(DstMiscData%F_PtfmAM(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_PtfmAM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_PtfmAM = SrcMiscData%F_PtfmAM + else if (allocated(DstMiscData%F_PtfmAM)) then + deallocate(DstMiscData%F_PtfmAM) + end if + call SS_Rad_CopyMisc(SrcMiscData%SS_Rdtn, DstMiscData%SS_Rdtn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SS_Rad_CopyInput(SrcMiscData%SS_Rdtn_u, DstMiscData%SS_Rdtn_u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SS_Rad_CopyOutput(SrcMiscData%SS_Rdtn_y, DstMiscData%SS_Rdtn_y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SS_Exc_CopyMisc(SrcMiscData%SS_Exctn, DstMiscData%SS_Exctn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SS_Exc_CopyInput(SrcMiscData%SS_Exctn_u, DstMiscData%SS_Exctn_u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SS_Exc_CopyOutput(SrcMiscData%SS_Exctn_y, DstMiscData%SS_Exctn_y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Conv_Rdtn_CopyMisc(SrcMiscData%Conv_Rdtn, DstMiscData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Conv_Rdtn_CopyInput(SrcMiscData%Conv_Rdtn_u, DstMiscData%Conv_Rdtn_u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Conv_Rdtn_CopyOutput(SrcMiscData%Conv_Rdtn_y, DstMiscData%Conv_Rdtn_y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_Interp_CopyMisc(SrcMiscData%SeaSt_Interp_m, DstMiscData%SeaSt_Interp_m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine WAMIT_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(WAMIT_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%F_HS)) then + deallocate(MiscData%F_HS) + end if + if (allocated(MiscData%F_Waves1)) then + deallocate(MiscData%F_Waves1) + end if + if (allocated(MiscData%F_Rdtn)) then + deallocate(MiscData%F_Rdtn) + end if + if (allocated(MiscData%F_PtfmAM)) then + deallocate(MiscData%F_PtfmAM) + end if +end subroutine subroutine WAMIT_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(WAMIT_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'WAMIT_PackMisc' if (Buf%ErrStat >= AbortErrLev) return - ! LastIndWave call RegPack(Buf, InData%LastIndWave) if (RegCheckErr(Buf, RoutineName)) return - ! F_HS call RegPack(Buf, allocated(InData%F_HS)) if (allocated(InData%F_HS)) then call RegPackBounds(Buf, 1, lbound(InData%F_HS), ubound(InData%F_HS)) call RegPack(Buf, InData%F_HS) end if if (RegCheckErr(Buf, RoutineName)) return - ! F_Waves1 call RegPack(Buf, allocated(InData%F_Waves1)) if (allocated(InData%F_Waves1)) then call RegPackBounds(Buf, 1, lbound(InData%F_Waves1), ubound(InData%F_Waves1)) call RegPack(Buf, InData%F_Waves1) end if if (RegCheckErr(Buf, RoutineName)) return - ! F_Rdtn call RegPack(Buf, allocated(InData%F_Rdtn)) if (allocated(InData%F_Rdtn)) then call RegPackBounds(Buf, 1, lbound(InData%F_Rdtn), ubound(InData%F_Rdtn)) call RegPack(Buf, InData%F_Rdtn) end if if (RegCheckErr(Buf, RoutineName)) return - ! F_PtfmAM call RegPack(Buf, allocated(InData%F_PtfmAM)) if (allocated(InData%F_PtfmAM)) then call RegPackBounds(Buf, 1, lbound(InData%F_PtfmAM), ubound(InData%F_PtfmAM)) call RegPack(Buf, InData%F_PtfmAM) end if if (RegCheckErr(Buf, RoutineName)) return - ! SS_Rdtn call SS_Rad_PackMisc(Buf, InData%SS_Rdtn) if (RegCheckErr(Buf, RoutineName)) return - ! SS_Rdtn_u call SS_Rad_PackInput(Buf, InData%SS_Rdtn_u) if (RegCheckErr(Buf, RoutineName)) return - ! SS_Rdtn_y call SS_Rad_PackOutput(Buf, InData%SS_Rdtn_y) if (RegCheckErr(Buf, RoutineName)) return - ! SS_Exctn call SS_Exc_PackMisc(Buf, InData%SS_Exctn) if (RegCheckErr(Buf, RoutineName)) return - ! SS_Exctn_u call SS_Exc_PackInput(Buf, InData%SS_Exctn_u) if (RegCheckErr(Buf, RoutineName)) return - ! SS_Exctn_y call SS_Exc_PackOutput(Buf, InData%SS_Exctn_y) if (RegCheckErr(Buf, RoutineName)) return - ! Conv_Rdtn call Conv_Rdtn_PackMisc(Buf, InData%Conv_Rdtn) if (RegCheckErr(Buf, RoutineName)) return - ! Conv_Rdtn_u call Conv_Rdtn_PackInput(Buf, InData%Conv_Rdtn_u) if (RegCheckErr(Buf, RoutineName)) return - ! Conv_Rdtn_y call Conv_Rdtn_PackOutput(Buf, InData%Conv_Rdtn_y) if (RegCheckErr(Buf, RoutineName)) return - ! SeaSt_Interp_m call SeaSt_Interp_PackMisc(Buf, InData%SeaSt_Interp_m) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1426,10 +1239,8 @@ subroutine WAMIT_UnPackMisc(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! LastIndWave call RegUnpack(Buf, OutData%LastIndWave) if (RegCheckErr(Buf, RoutineName)) return - ! F_HS if (allocated(OutData%F_HS)) deallocate(OutData%F_HS) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1444,7 +1255,6 @@ subroutine WAMIT_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%F_HS) if (RegCheckErr(Buf, RoutineName)) return end if - ! F_Waves1 if (allocated(OutData%F_Waves1)) deallocate(OutData%F_Waves1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1459,7 +1269,6 @@ subroutine WAMIT_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%F_Waves1) if (RegCheckErr(Buf, RoutineName)) return end if - ! F_Rdtn if (allocated(OutData%F_Rdtn)) deallocate(OutData%F_Rdtn) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1474,7 +1283,6 @@ subroutine WAMIT_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%F_Rdtn) if (RegCheckErr(Buf, RoutineName)) return end if - ! F_PtfmAM if (allocated(OutData%F_PtfmAM)) deallocate(OutData%F_PtfmAM) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1489,258 +1297,208 @@ subroutine WAMIT_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%F_PtfmAM) if (RegCheckErr(Buf, RoutineName)) return end if - ! SS_Rdtn call SS_Rad_UnpackMisc(Buf, OutData%SS_Rdtn) ! SS_Rdtn - ! SS_Rdtn_u call SS_Rad_UnpackInput(Buf, OutData%SS_Rdtn_u) ! SS_Rdtn_u - ! SS_Rdtn_y call SS_Rad_UnpackOutput(Buf, OutData%SS_Rdtn_y) ! SS_Rdtn_y - ! SS_Exctn call SS_Exc_UnpackMisc(Buf, OutData%SS_Exctn) ! SS_Exctn - ! SS_Exctn_u call SS_Exc_UnpackInput(Buf, OutData%SS_Exctn_u) ! SS_Exctn_u - ! SS_Exctn_y call SS_Exc_UnpackOutput(Buf, OutData%SS_Exctn_y) ! SS_Exctn_y - ! Conv_Rdtn call Conv_Rdtn_UnpackMisc(Buf, OutData%Conv_Rdtn) ! Conv_Rdtn - ! Conv_Rdtn_u call Conv_Rdtn_UnpackInput(Buf, OutData%Conv_Rdtn_u) ! Conv_Rdtn_u - ! Conv_Rdtn_y call Conv_Rdtn_UnpackOutput(Buf, OutData%Conv_Rdtn_y) ! Conv_Rdtn_y - ! SeaSt_Interp_m call SeaSt_Interp_UnpackMisc(Buf, OutData%SeaSt_Interp_m) ! SeaSt_Interp_m end subroutine - SUBROUTINE WAMIT_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WAMIT_ParameterType), INTENT(IN) :: SrcParamData - TYPE(WAMIT_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%NBody = SrcParamData%NBody - DstParamData%NBodyMod = SrcParamData%NBodyMod -IF (ALLOCATED(SrcParamData%F_HS_Moment_Offset)) THEN - i1_l = LBOUND(SrcParamData%F_HS_Moment_Offset,1) - i1_u = UBOUND(SrcParamData%F_HS_Moment_Offset,1) - i2_l = LBOUND(SrcParamData%F_HS_Moment_Offset,2) - i2_u = UBOUND(SrcParamData%F_HS_Moment_Offset,2) - IF (.NOT. ALLOCATED(DstParamData%F_HS_Moment_Offset)) THEN - ALLOCATE(DstParamData%F_HS_Moment_Offset(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%F_HS_Moment_Offset.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%F_HS_Moment_Offset = SrcParamData%F_HS_Moment_Offset -ENDIF -IF (ALLOCATED(SrcParamData%HdroAdMsI)) THEN - i1_l = LBOUND(SrcParamData%HdroAdMsI,1) - i1_u = UBOUND(SrcParamData%HdroAdMsI,1) - i2_l = LBOUND(SrcParamData%HdroAdMsI,2) - i2_u = UBOUND(SrcParamData%HdroAdMsI,2) - IF (.NOT. ALLOCATED(DstParamData%HdroAdMsI)) THEN - ALLOCATE(DstParamData%HdroAdMsI(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%HdroAdMsI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%HdroAdMsI = SrcParamData%HdroAdMsI -ENDIF -IF (ALLOCATED(SrcParamData%HdroSttc)) THEN - i1_l = LBOUND(SrcParamData%HdroSttc,1) - i1_u = UBOUND(SrcParamData%HdroSttc,1) - i2_l = LBOUND(SrcParamData%HdroSttc,2) - i2_u = UBOUND(SrcParamData%HdroSttc,2) - IF (.NOT. ALLOCATED(DstParamData%HdroSttc)) THEN - ALLOCATE(DstParamData%HdroSttc(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%HdroSttc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%HdroSttc = SrcParamData%HdroSttc -ENDIF - DstParamData%RdtnMod = SrcParamData%RdtnMod - DstParamData%ExctnMod = SrcParamData%ExctnMod - DstParamData%ExctnDisp = SrcParamData%ExctnDisp - DstParamData%ExctnCutOff = SrcParamData%ExctnCutOff - DstParamData%ExctnFiltConst = SrcParamData%ExctnFiltConst -IF (ALLOCATED(SrcParamData%WaveExctn)) THEN - i1_l = LBOUND(SrcParamData%WaveExctn,1) - i1_u = UBOUND(SrcParamData%WaveExctn,1) - i2_l = LBOUND(SrcParamData%WaveExctn,2) - i2_u = UBOUND(SrcParamData%WaveExctn,2) - IF (.NOT. ALLOCATED(DstParamData%WaveExctn)) THEN - ALLOCATE(DstParamData%WaveExctn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveExctn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveExctn = SrcParamData%WaveExctn -ENDIF -IF (ALLOCATED(SrcParamData%WaveExctnGrid)) THEN - i1_l = LBOUND(SrcParamData%WaveExctnGrid,1) - i1_u = UBOUND(SrcParamData%WaveExctnGrid,1) - i2_l = LBOUND(SrcParamData%WaveExctnGrid,2) - i2_u = UBOUND(SrcParamData%WaveExctnGrid,2) - i3_l = LBOUND(SrcParamData%WaveExctnGrid,3) - i3_u = UBOUND(SrcParamData%WaveExctnGrid,3) - i4_l = LBOUND(SrcParamData%WaveExctnGrid,4) - i4_u = UBOUND(SrcParamData%WaveExctnGrid,4) - IF (.NOT. ALLOCATED(DstParamData%WaveExctnGrid)) THEN - ALLOCATE(DstParamData%WaveExctnGrid(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveExctnGrid.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveExctnGrid = SrcParamData%WaveExctnGrid -ENDIF - DstParamData%NStepWave = SrcParamData%NStepWave - CALL Conv_Rdtn_CopyParam( SrcParamData%Conv_Rdtn, DstParamData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SS_Rad_CopyParam( SrcParamData%SS_Rdtn, DstParamData%SS_Rdtn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SS_Exc_CopyParam( SrcParamData%SS_Exctn, DstParamData%SS_Exctn, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstParamData%DT = SrcParamData%DT - CALL SeaSt_Interp_CopyParam( SrcParamData%SeaSt_Interp_p, DstParamData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE WAMIT_CopyParam - - SUBROUTINE WAMIT_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(WAMIT_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(ParamData%F_HS_Moment_Offset)) THEN - DEALLOCATE(ParamData%F_HS_Moment_Offset) -ENDIF -IF (ALLOCATED(ParamData%HdroAdMsI)) THEN - DEALLOCATE(ParamData%HdroAdMsI) -ENDIF -IF (ALLOCATED(ParamData%HdroSttc)) THEN - DEALLOCATE(ParamData%HdroSttc) -ENDIF -IF (ALLOCATED(ParamData%WaveExctn)) THEN - DEALLOCATE(ParamData%WaveExctn) -ENDIF -IF (ALLOCATED(ParamData%WaveExctnGrid)) THEN - DEALLOCATE(ParamData%WaveExctnGrid) -ENDIF - CALL Conv_Rdtn_DestroyParam( ParamData%Conv_Rdtn, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SS_Rad_DestroyParam( ParamData%SS_Rdtn, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SS_Exc_DestroyParam( ParamData%SS_Exctn, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SeaSt_Interp_DestroyParam( ParamData%SeaSt_Interp_p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE WAMIT_DestroyParam +subroutine WAMIT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(WAMIT_ParameterType), intent(in) :: SrcParamData + type(WAMIT_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%NBody = SrcParamData%NBody + DstParamData%NBodyMod = SrcParamData%NBodyMod + if (allocated(SrcParamData%F_HS_Moment_Offset)) then + LB(1:2) = lbound(SrcParamData%F_HS_Moment_Offset) + UB(1:2) = ubound(SrcParamData%F_HS_Moment_Offset) + if (.not. allocated(DstParamData%F_HS_Moment_Offset)) then + allocate(DstParamData%F_HS_Moment_Offset(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%F_HS_Moment_Offset.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%F_HS_Moment_Offset = SrcParamData%F_HS_Moment_Offset + else if (allocated(DstParamData%F_HS_Moment_Offset)) then + deallocate(DstParamData%F_HS_Moment_Offset) + end if + if (allocated(SrcParamData%HdroAdMsI)) then + LB(1:2) = lbound(SrcParamData%HdroAdMsI) + UB(1:2) = ubound(SrcParamData%HdroAdMsI) + if (.not. allocated(DstParamData%HdroAdMsI)) then + allocate(DstParamData%HdroAdMsI(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%HdroAdMsI.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%HdroAdMsI = SrcParamData%HdroAdMsI + else if (allocated(DstParamData%HdroAdMsI)) then + deallocate(DstParamData%HdroAdMsI) + end if + if (allocated(SrcParamData%HdroSttc)) then + LB(1:2) = lbound(SrcParamData%HdroSttc) + UB(1:2) = ubound(SrcParamData%HdroSttc) + if (.not. allocated(DstParamData%HdroSttc)) then + allocate(DstParamData%HdroSttc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%HdroSttc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%HdroSttc = SrcParamData%HdroSttc + else if (allocated(DstParamData%HdroSttc)) then + deallocate(DstParamData%HdroSttc) + end if + DstParamData%RdtnMod = SrcParamData%RdtnMod + DstParamData%ExctnMod = SrcParamData%ExctnMod + DstParamData%ExctnDisp = SrcParamData%ExctnDisp + DstParamData%ExctnCutOff = SrcParamData%ExctnCutOff + DstParamData%ExctnFiltConst = SrcParamData%ExctnFiltConst + if (allocated(SrcParamData%WaveExctn)) then + LB(1:2) = lbound(SrcParamData%WaveExctn) + UB(1:2) = ubound(SrcParamData%WaveExctn) + if (.not. allocated(DstParamData%WaveExctn)) then + allocate(DstParamData%WaveExctn(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveExctn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WaveExctn = SrcParamData%WaveExctn + else if (allocated(DstParamData%WaveExctn)) then + deallocate(DstParamData%WaveExctn) + end if + if (allocated(SrcParamData%WaveExctnGrid)) then + LB(1:4) = lbound(SrcParamData%WaveExctnGrid) + UB(1:4) = ubound(SrcParamData%WaveExctnGrid) + if (.not. allocated(DstParamData%WaveExctnGrid)) then + allocate(DstParamData%WaveExctnGrid(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveExctnGrid.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WaveExctnGrid = SrcParamData%WaveExctnGrid + else if (allocated(DstParamData%WaveExctnGrid)) then + deallocate(DstParamData%WaveExctnGrid) + end if + DstParamData%NStepWave = SrcParamData%NStepWave + call Conv_Rdtn_CopyParam(SrcParamData%Conv_Rdtn, DstParamData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SS_Rad_CopyParam(SrcParamData%SS_Rdtn, DstParamData%SS_Rdtn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SS_Exc_CopyParam(SrcParamData%SS_Exctn, DstParamData%SS_Exctn, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstParamData%DT = SrcParamData%DT + call SeaSt_Interp_CopyParam(SrcParamData%SeaSt_Interp_p, DstParamData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine WAMIT_DestroyParam(ParamData, ErrStat, ErrMsg) + type(WAMIT_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%F_HS_Moment_Offset)) then + deallocate(ParamData%F_HS_Moment_Offset) + end if + if (allocated(ParamData%HdroAdMsI)) then + deallocate(ParamData%HdroAdMsI) + end if + if (allocated(ParamData%HdroSttc)) then + deallocate(ParamData%HdroSttc) + end if + if (allocated(ParamData%WaveExctn)) then + deallocate(ParamData%WaveExctn) + end if + if (allocated(ParamData%WaveExctnGrid)) then + deallocate(ParamData%WaveExctnGrid) + end if +end subroutine subroutine WAMIT_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(WAMIT_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'WAMIT_PackParam' if (Buf%ErrStat >= AbortErrLev) return - ! NBody call RegPack(Buf, InData%NBody) if (RegCheckErr(Buf, RoutineName)) return - ! NBodyMod call RegPack(Buf, InData%NBodyMod) if (RegCheckErr(Buf, RoutineName)) return - ! F_HS_Moment_Offset call RegPack(Buf, allocated(InData%F_HS_Moment_Offset)) if (allocated(InData%F_HS_Moment_Offset)) then call RegPackBounds(Buf, 2, lbound(InData%F_HS_Moment_Offset), ubound(InData%F_HS_Moment_Offset)) call RegPack(Buf, InData%F_HS_Moment_Offset) end if if (RegCheckErr(Buf, RoutineName)) return - ! HdroAdMsI call RegPack(Buf, allocated(InData%HdroAdMsI)) if (allocated(InData%HdroAdMsI)) then call RegPackBounds(Buf, 2, lbound(InData%HdroAdMsI), ubound(InData%HdroAdMsI)) call RegPack(Buf, InData%HdroAdMsI) end if if (RegCheckErr(Buf, RoutineName)) return - ! HdroSttc call RegPack(Buf, allocated(InData%HdroSttc)) if (allocated(InData%HdroSttc)) then call RegPackBounds(Buf, 2, lbound(InData%HdroSttc), ubound(InData%HdroSttc)) call RegPack(Buf, InData%HdroSttc) end if if (RegCheckErr(Buf, RoutineName)) return - ! RdtnMod call RegPack(Buf, InData%RdtnMod) if (RegCheckErr(Buf, RoutineName)) return - ! ExctnMod call RegPack(Buf, InData%ExctnMod) if (RegCheckErr(Buf, RoutineName)) return - ! ExctnDisp call RegPack(Buf, InData%ExctnDisp) if (RegCheckErr(Buf, RoutineName)) return - ! ExctnCutOff call RegPack(Buf, InData%ExctnCutOff) if (RegCheckErr(Buf, RoutineName)) return - ! ExctnFiltConst call RegPack(Buf, InData%ExctnFiltConst) if (RegCheckErr(Buf, RoutineName)) return - ! WaveExctn call RegPack(Buf, allocated(InData%WaveExctn)) if (allocated(InData%WaveExctn)) then call RegPackBounds(Buf, 2, lbound(InData%WaveExctn), ubound(InData%WaveExctn)) call RegPack(Buf, InData%WaveExctn) end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveExctnGrid call RegPack(Buf, allocated(InData%WaveExctnGrid)) if (allocated(InData%WaveExctnGrid)) then call RegPackBounds(Buf, 4, lbound(InData%WaveExctnGrid), ubound(InData%WaveExctnGrid)) call RegPack(Buf, InData%WaveExctnGrid) end if if (RegCheckErr(Buf, RoutineName)) return - ! NStepWave call RegPack(Buf, InData%NStepWave) if (RegCheckErr(Buf, RoutineName)) return - ! Conv_Rdtn call Conv_Rdtn_PackParam(Buf, InData%Conv_Rdtn) if (RegCheckErr(Buf, RoutineName)) return - ! SS_Rdtn call SS_Rad_PackParam(Buf, InData%SS_Rdtn) if (RegCheckErr(Buf, RoutineName)) return - ! SS_Exctn call SS_Exc_PackParam(Buf, InData%SS_Exctn) if (RegCheckErr(Buf, RoutineName)) return - ! DT call RegPack(Buf, InData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! SeaSt_Interp_p call SeaSt_Interp_PackParam(Buf, InData%SeaSt_Interp_p) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1753,13 +1511,10 @@ subroutine WAMIT_UnPackParam(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! NBody call RegUnpack(Buf, OutData%NBody) if (RegCheckErr(Buf, RoutineName)) return - ! NBodyMod call RegUnpack(Buf, OutData%NBodyMod) if (RegCheckErr(Buf, RoutineName)) return - ! F_HS_Moment_Offset if (allocated(OutData%F_HS_Moment_Offset)) deallocate(OutData%F_HS_Moment_Offset) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1774,7 +1529,6 @@ subroutine WAMIT_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%F_HS_Moment_Offset) if (RegCheckErr(Buf, RoutineName)) return end if - ! HdroAdMsI if (allocated(OutData%HdroAdMsI)) deallocate(OutData%HdroAdMsI) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1789,7 +1543,6 @@ subroutine WAMIT_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%HdroAdMsI) if (RegCheckErr(Buf, RoutineName)) return end if - ! HdroSttc if (allocated(OutData%HdroSttc)) deallocate(OutData%HdroSttc) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1804,22 +1557,16 @@ subroutine WAMIT_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%HdroSttc) if (RegCheckErr(Buf, RoutineName)) return end if - ! RdtnMod call RegUnpack(Buf, OutData%RdtnMod) if (RegCheckErr(Buf, RoutineName)) return - ! ExctnMod call RegUnpack(Buf, OutData%ExctnMod) if (RegCheckErr(Buf, RoutineName)) return - ! ExctnDisp call RegUnpack(Buf, OutData%ExctnDisp) if (RegCheckErr(Buf, RoutineName)) return - ! ExctnCutOff call RegUnpack(Buf, OutData%ExctnCutOff) if (RegCheckErr(Buf, RoutineName)) return - ! ExctnFiltConst call RegUnpack(Buf, OutData%ExctnFiltConst) if (RegCheckErr(Buf, RoutineName)) return - ! WaveExctn if (allocated(OutData%WaveExctn)) deallocate(OutData%WaveExctn) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1834,7 +1581,6 @@ subroutine WAMIT_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%WaveExctn) if (RegCheckErr(Buf, RoutineName)) return end if - ! WaveExctnGrid if (allocated(OutData%WaveExctnGrid)) deallocate(OutData%WaveExctnGrid) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1849,64 +1595,48 @@ subroutine WAMIT_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%WaveExctnGrid) if (RegCheckErr(Buf, RoutineName)) return end if - ! NStepWave call RegUnpack(Buf, OutData%NStepWave) if (RegCheckErr(Buf, RoutineName)) return - ! Conv_Rdtn call Conv_Rdtn_UnpackParam(Buf, OutData%Conv_Rdtn) ! Conv_Rdtn - ! SS_Rdtn call SS_Rad_UnpackParam(Buf, OutData%SS_Rdtn) ! SS_Rdtn - ! SS_Exctn call SS_Exc_UnpackParam(Buf, OutData%SS_Exctn) ! SS_Exctn - ! DT call RegUnpack(Buf, OutData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! SeaSt_Interp_p call SeaSt_Interp_UnpackParam(Buf, OutData%SeaSt_Interp_p) ! SeaSt_Interp_p end subroutine - SUBROUTINE WAMIT_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WAMIT_InputType), INTENT(INOUT) :: SrcInputData - TYPE(WAMIT_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_CopyInput' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcInputData%Mesh, DstInputData%Mesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE WAMIT_CopyInput - SUBROUTINE WAMIT_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(WAMIT_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL MeshDestroy( InputData%Mesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE WAMIT_DestroyInput +subroutine WAMIT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(WAMIT_InputType), intent(inout) :: SrcInputData + type(WAMIT_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcInputData%Mesh, DstInputData%Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine WAMIT_DestroyInput(InputData, ErrStat, ErrMsg) + type(WAMIT_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine WAMIT_PackInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(WAMIT_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'WAMIT_PackInput' if (Buf%ErrStat >= AbortErrLev) return - ! Mesh call MeshPack(Buf, InData%Mesh) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1916,52 +1646,41 @@ subroutine WAMIT_UnPackInput(Buf, OutData) type(WAMIT_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WAMIT_UnPackInput' if (Buf%ErrStat /= ErrID_None) return - ! Mesh call MeshUnpack(Buf, OutData%Mesh) ! Mesh end subroutine - SUBROUTINE WAMIT_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WAMIT_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(WAMIT_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_CopyOutput' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcOutputData%Mesh, DstOutputData%Mesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE WAMIT_CopyOutput - - SUBROUTINE WAMIT_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(WAMIT_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - CALL MeshDestroy( OutputData%Mesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE WAMIT_DestroyOutput +subroutine WAMIT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(WAMIT_OutputType), intent(inout) :: SrcOutputData + type(WAMIT_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcOutputData%Mesh, DstOutputData%Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine WAMIT_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(WAMIT_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WAMIT_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine WAMIT_PackOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(WAMIT_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'WAMIT_PackOutput' if (Buf%ErrStat >= AbortErrLev) return - ! Mesh call MeshPack(Buf, InData%Mesh) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1971,7 +1690,6 @@ subroutine WAMIT_UnPackOutput(Buf, OutData) type(WAMIT_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WAMIT_UnPackOutput' if (Buf%ErrStat /= ErrID_None) return - ! Mesh call MeshUnpack(Buf, OutData%Mesh) ! Mesh end subroutine diff --git a/modules/icedyn/src/IceDyn_Types.f90 b/modules/icedyn/src/IceDyn_Types.f90 index f1d46cef8e..cb005cedf3 100644 --- a/modules/icedyn/src/IceDyn_Types.f90 +++ b/modules/icedyn/src/IceDyn_Types.f90 @@ -225,336 +225,272 @@ MODULE IceDyn_Types END TYPE IceD_OutputType ! ======================= CONTAINS - SUBROUTINE IceD_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceD_InputFile), INTENT(IN) :: SrcInputFileData - TYPE(IceD_InputFile), INTENT(INOUT) :: DstInputFileData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_CopyInputFile' -! + +subroutine IceD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) + type(IceD_InputFile), intent(in) :: SrcInputFileData + type(IceD_InputFile), intent(inout) :: DstInputFileData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'IceD_CopyInputFile' ErrStat = ErrID_None - ErrMsg = "" - DstInputFileData%IceModel = SrcInputFileData%IceModel - DstInputFileData%IceSubModel = SrcInputFileData%IceSubModel - DstInputFileData%h = SrcInputFileData%h - DstInputFileData%v = SrcInputFileData%v - DstInputFileData%InitLoc = SrcInputFileData%InitLoc - DstInputFileData%t0 = SrcInputFileData%t0 - DstInputFileData%rhow = SrcInputFileData%rhow - DstInputFileData%rhoi = SrcInputFileData%rhoi - DstInputFileData%Seed1 = SrcInputFileData%Seed1 - DstInputFileData%Seed2 = SrcInputFileData%Seed2 - DstInputFileData%NumLegs = SrcInputFileData%NumLegs -IF (ALLOCATED(SrcInputFileData%LegPosX)) THEN - i1_l = LBOUND(SrcInputFileData%LegPosX,1) - i1_u = UBOUND(SrcInputFileData%LegPosX,1) - IF (.NOT. ALLOCATED(DstInputFileData%LegPosX)) THEN - ALLOCATE(DstInputFileData%LegPosX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LegPosX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%LegPosX = SrcInputFileData%LegPosX -ENDIF -IF (ALLOCATED(SrcInputFileData%LegPosY)) THEN - i1_l = LBOUND(SrcInputFileData%LegPosY,1) - i1_u = UBOUND(SrcInputFileData%LegPosY,1) - IF (.NOT. ALLOCATED(DstInputFileData%LegPosY)) THEN - ALLOCATE(DstInputFileData%LegPosY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LegPosY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%LegPosY = SrcInputFileData%LegPosY -ENDIF -IF (ALLOCATED(SrcInputFileData%StrWd)) THEN - i1_l = LBOUND(SrcInputFileData%StrWd,1) - i1_u = UBOUND(SrcInputFileData%StrWd,1) - IF (.NOT. ALLOCATED(DstInputFileData%StrWd)) THEN - ALLOCATE(DstInputFileData%StrWd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%StrWd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%StrWd = SrcInputFileData%StrWd -ENDIF - DstInputFileData%Ikm = SrcInputFileData%Ikm - DstInputFileData%Ag = SrcInputFileData%Ag - DstInputFileData%Qg = SrcInputFileData%Qg - DstInputFileData%Rg = SrcInputFileData%Rg - DstInputFileData%Tice = SrcInputFileData%Tice - DstInputFileData%nu = SrcInputFileData%nu - DstInputFileData%phi = SrcInputFileData%phi - DstInputFileData%SigNm = SrcInputFileData%SigNm - DstInputFileData%Eice = SrcInputFileData%Eice - DstInputFileData%IceStr2 = SrcInputFileData%IceStr2 - DstInputFileData%Delmax2 = SrcInputFileData%Delmax2 - DstInputFileData%Pitch = SrcInputFileData%Pitch - DstInputFileData%miuh = SrcInputFileData%miuh - DstInputFileData%varh = SrcInputFileData%varh - DstInputFileData%miuv = SrcInputFileData%miuv - DstInputFileData%varv = SrcInputFileData%varv - DstInputFileData%miut = SrcInputFileData%miut - DstInputFileData%miubr = SrcInputFileData%miubr - DstInputFileData%varbr = SrcInputFileData%varbr - DstInputFileData%miuDelm = SrcInputFileData%miuDelm - DstInputFileData%varDelm = SrcInputFileData%varDelm - DstInputFileData%miuP = SrcInputFileData%miuP - DstInputFileData%varP = SrcInputFileData%varP - DstInputFileData%Zn1 = SrcInputFileData%Zn1 - DstInputFileData%Zn2 = SrcInputFileData%Zn2 - DstInputFileData%ZonePitch = SrcInputFileData%ZonePitch - DstInputFileData%PrflMean = SrcInputFileData%PrflMean - DstInputFileData%PrflSig = SrcInputFileData%PrflSig - DstInputFileData%IceStr = SrcInputFileData%IceStr - DstInputFileData%Delmax = SrcInputFileData%Delmax - DstInputFileData%alpha = SrcInputFileData%alpha - DstInputFileData%Dwl = SrcInputFileData%Dwl - DstInputFileData%Dtp = SrcInputFileData%Dtp - DstInputFileData%hr = SrcInputFileData%hr - DstInputFileData%mu = SrcInputFileData%mu - DstInputFileData%sigf = SrcInputFileData%sigf - DstInputFileData%StrLim = SrcInputFileData%StrLim - DstInputFileData%StrRtLim = SrcInputFileData%StrRtLim - DstInputFileData%UorD = SrcInputFileData%UorD - DstInputFileData%Ll = SrcInputFileData%Ll - DstInputFileData%Lw = SrcInputFileData%Lw - DstInputFileData%Cpa = SrcInputFileData%Cpa - DstInputFileData%dpa = SrcInputFileData%dpa - DstInputFileData%Fdr = SrcInputFileData%Fdr - DstInputFileData%Kic = SrcInputFileData%Kic - DstInputFileData%FspN = SrcInputFileData%FspN - END SUBROUTINE IceD_CopyInputFile - - SUBROUTINE IceD_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) - TYPE(IceD_InputFile), INTENT(INOUT) :: InputFileData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_DestroyInputFile' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputFileData%LegPosX)) THEN - DEALLOCATE(InputFileData%LegPosX) -ENDIF -IF (ALLOCATED(InputFileData%LegPosY)) THEN - DEALLOCATE(InputFileData%LegPosY) -ENDIF -IF (ALLOCATED(InputFileData%StrWd)) THEN - DEALLOCATE(InputFileData%StrWd) -ENDIF - END SUBROUTINE IceD_DestroyInputFile + ErrMsg = '' + DstInputFileData%IceModel = SrcInputFileData%IceModel + DstInputFileData%IceSubModel = SrcInputFileData%IceSubModel + DstInputFileData%h = SrcInputFileData%h + DstInputFileData%v = SrcInputFileData%v + DstInputFileData%InitLoc = SrcInputFileData%InitLoc + DstInputFileData%t0 = SrcInputFileData%t0 + DstInputFileData%rhow = SrcInputFileData%rhow + DstInputFileData%rhoi = SrcInputFileData%rhoi + DstInputFileData%Seed1 = SrcInputFileData%Seed1 + DstInputFileData%Seed2 = SrcInputFileData%Seed2 + DstInputFileData%NumLegs = SrcInputFileData%NumLegs + if (allocated(SrcInputFileData%LegPosX)) then + LB(1:1) = lbound(SrcInputFileData%LegPosX) + UB(1:1) = ubound(SrcInputFileData%LegPosX) + if (.not. allocated(DstInputFileData%LegPosX)) then + allocate(DstInputFileData%LegPosX(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LegPosX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%LegPosX = SrcInputFileData%LegPosX + else if (allocated(DstInputFileData%LegPosX)) then + deallocate(DstInputFileData%LegPosX) + end if + if (allocated(SrcInputFileData%LegPosY)) then + LB(1:1) = lbound(SrcInputFileData%LegPosY) + UB(1:1) = ubound(SrcInputFileData%LegPosY) + if (.not. allocated(DstInputFileData%LegPosY)) then + allocate(DstInputFileData%LegPosY(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%LegPosY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%LegPosY = SrcInputFileData%LegPosY + else if (allocated(DstInputFileData%LegPosY)) then + deallocate(DstInputFileData%LegPosY) + end if + if (allocated(SrcInputFileData%StrWd)) then + LB(1:1) = lbound(SrcInputFileData%StrWd) + UB(1:1) = ubound(SrcInputFileData%StrWd) + if (.not. allocated(DstInputFileData%StrWd)) then + allocate(DstInputFileData%StrWd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%StrWd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%StrWd = SrcInputFileData%StrWd + else if (allocated(DstInputFileData%StrWd)) then + deallocate(DstInputFileData%StrWd) + end if + DstInputFileData%Ikm = SrcInputFileData%Ikm + DstInputFileData%Ag = SrcInputFileData%Ag + DstInputFileData%Qg = SrcInputFileData%Qg + DstInputFileData%Rg = SrcInputFileData%Rg + DstInputFileData%Tice = SrcInputFileData%Tice + DstInputFileData%nu = SrcInputFileData%nu + DstInputFileData%phi = SrcInputFileData%phi + DstInputFileData%SigNm = SrcInputFileData%SigNm + DstInputFileData%Eice = SrcInputFileData%Eice + DstInputFileData%IceStr2 = SrcInputFileData%IceStr2 + DstInputFileData%Delmax2 = SrcInputFileData%Delmax2 + DstInputFileData%Pitch = SrcInputFileData%Pitch + DstInputFileData%miuh = SrcInputFileData%miuh + DstInputFileData%varh = SrcInputFileData%varh + DstInputFileData%miuv = SrcInputFileData%miuv + DstInputFileData%varv = SrcInputFileData%varv + DstInputFileData%miut = SrcInputFileData%miut + DstInputFileData%miubr = SrcInputFileData%miubr + DstInputFileData%varbr = SrcInputFileData%varbr + DstInputFileData%miuDelm = SrcInputFileData%miuDelm + DstInputFileData%varDelm = SrcInputFileData%varDelm + DstInputFileData%miuP = SrcInputFileData%miuP + DstInputFileData%varP = SrcInputFileData%varP + DstInputFileData%Zn1 = SrcInputFileData%Zn1 + DstInputFileData%Zn2 = SrcInputFileData%Zn2 + DstInputFileData%ZonePitch = SrcInputFileData%ZonePitch + DstInputFileData%PrflMean = SrcInputFileData%PrflMean + DstInputFileData%PrflSig = SrcInputFileData%PrflSig + DstInputFileData%IceStr = SrcInputFileData%IceStr + DstInputFileData%Delmax = SrcInputFileData%Delmax + DstInputFileData%alpha = SrcInputFileData%alpha + DstInputFileData%Dwl = SrcInputFileData%Dwl + DstInputFileData%Dtp = SrcInputFileData%Dtp + DstInputFileData%hr = SrcInputFileData%hr + DstInputFileData%mu = SrcInputFileData%mu + DstInputFileData%sigf = SrcInputFileData%sigf + DstInputFileData%StrLim = SrcInputFileData%StrLim + DstInputFileData%StrRtLim = SrcInputFileData%StrRtLim + DstInputFileData%UorD = SrcInputFileData%UorD + DstInputFileData%Ll = SrcInputFileData%Ll + DstInputFileData%Lw = SrcInputFileData%Lw + DstInputFileData%Cpa = SrcInputFileData%Cpa + DstInputFileData%dpa = SrcInputFileData%dpa + DstInputFileData%Fdr = SrcInputFileData%Fdr + DstInputFileData%Kic = SrcInputFileData%Kic + DstInputFileData%FspN = SrcInputFileData%FspN +end subroutine +subroutine IceD_DestroyInputFile(InputFileData, ErrStat, ErrMsg) + type(IceD_InputFile), intent(inout) :: InputFileData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceD_DestroyInputFile' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputFileData%LegPosX)) then + deallocate(InputFileData%LegPosX) + end if + if (allocated(InputFileData%LegPosY)) then + deallocate(InputFileData%LegPosY) + end if + if (allocated(InputFileData%StrWd)) then + deallocate(InputFileData%StrWd) + end if +end subroutine subroutine IceD_PackInputFile(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(IceD_InputFile), intent(in) :: InData character(*), parameter :: RoutineName = 'IceD_PackInputFile' if (Buf%ErrStat >= AbortErrLev) return - ! IceModel call RegPack(Buf, InData%IceModel) if (RegCheckErr(Buf, RoutineName)) return - ! IceSubModel call RegPack(Buf, InData%IceSubModel) if (RegCheckErr(Buf, RoutineName)) return - ! h call RegPack(Buf, InData%h) if (RegCheckErr(Buf, RoutineName)) return - ! v call RegPack(Buf, InData%v) if (RegCheckErr(Buf, RoutineName)) return - ! InitLoc call RegPack(Buf, InData%InitLoc) if (RegCheckErr(Buf, RoutineName)) return - ! t0 call RegPack(Buf, InData%t0) if (RegCheckErr(Buf, RoutineName)) return - ! rhow call RegPack(Buf, InData%rhow) if (RegCheckErr(Buf, RoutineName)) return - ! rhoi call RegPack(Buf, InData%rhoi) if (RegCheckErr(Buf, RoutineName)) return - ! Seed1 call RegPack(Buf, InData%Seed1) if (RegCheckErr(Buf, RoutineName)) return - ! Seed2 call RegPack(Buf, InData%Seed2) if (RegCheckErr(Buf, RoutineName)) return - ! NumLegs call RegPack(Buf, InData%NumLegs) if (RegCheckErr(Buf, RoutineName)) return - ! LegPosX call RegPack(Buf, allocated(InData%LegPosX)) if (allocated(InData%LegPosX)) then call RegPackBounds(Buf, 1, lbound(InData%LegPosX), ubound(InData%LegPosX)) call RegPack(Buf, InData%LegPosX) end if if (RegCheckErr(Buf, RoutineName)) return - ! LegPosY call RegPack(Buf, allocated(InData%LegPosY)) if (allocated(InData%LegPosY)) then call RegPackBounds(Buf, 1, lbound(InData%LegPosY), ubound(InData%LegPosY)) call RegPack(Buf, InData%LegPosY) end if if (RegCheckErr(Buf, RoutineName)) return - ! StrWd call RegPack(Buf, allocated(InData%StrWd)) if (allocated(InData%StrWd)) then call RegPackBounds(Buf, 1, lbound(InData%StrWd), ubound(InData%StrWd)) call RegPack(Buf, InData%StrWd) end if if (RegCheckErr(Buf, RoutineName)) return - ! Ikm call RegPack(Buf, InData%Ikm) if (RegCheckErr(Buf, RoutineName)) return - ! Ag call RegPack(Buf, InData%Ag) if (RegCheckErr(Buf, RoutineName)) return - ! Qg call RegPack(Buf, InData%Qg) if (RegCheckErr(Buf, RoutineName)) return - ! Rg call RegPack(Buf, InData%Rg) if (RegCheckErr(Buf, RoutineName)) return - ! Tice call RegPack(Buf, InData%Tice) if (RegCheckErr(Buf, RoutineName)) return - ! nu call RegPack(Buf, InData%nu) if (RegCheckErr(Buf, RoutineName)) return - ! phi call RegPack(Buf, InData%phi) if (RegCheckErr(Buf, RoutineName)) return - ! SigNm call RegPack(Buf, InData%SigNm) if (RegCheckErr(Buf, RoutineName)) return - ! Eice call RegPack(Buf, InData%Eice) if (RegCheckErr(Buf, RoutineName)) return - ! IceStr2 call RegPack(Buf, InData%IceStr2) if (RegCheckErr(Buf, RoutineName)) return - ! Delmax2 call RegPack(Buf, InData%Delmax2) if (RegCheckErr(Buf, RoutineName)) return - ! Pitch call RegPack(Buf, InData%Pitch) if (RegCheckErr(Buf, RoutineName)) return - ! miuh call RegPack(Buf, InData%miuh) if (RegCheckErr(Buf, RoutineName)) return - ! varh call RegPack(Buf, InData%varh) if (RegCheckErr(Buf, RoutineName)) return - ! miuv call RegPack(Buf, InData%miuv) if (RegCheckErr(Buf, RoutineName)) return - ! varv call RegPack(Buf, InData%varv) if (RegCheckErr(Buf, RoutineName)) return - ! miut call RegPack(Buf, InData%miut) if (RegCheckErr(Buf, RoutineName)) return - ! miubr call RegPack(Buf, InData%miubr) if (RegCheckErr(Buf, RoutineName)) return - ! varbr call RegPack(Buf, InData%varbr) if (RegCheckErr(Buf, RoutineName)) return - ! miuDelm call RegPack(Buf, InData%miuDelm) if (RegCheckErr(Buf, RoutineName)) return - ! varDelm call RegPack(Buf, InData%varDelm) if (RegCheckErr(Buf, RoutineName)) return - ! miuP call RegPack(Buf, InData%miuP) if (RegCheckErr(Buf, RoutineName)) return - ! varP call RegPack(Buf, InData%varP) if (RegCheckErr(Buf, RoutineName)) return - ! Zn1 call RegPack(Buf, InData%Zn1) if (RegCheckErr(Buf, RoutineName)) return - ! Zn2 call RegPack(Buf, InData%Zn2) if (RegCheckErr(Buf, RoutineName)) return - ! ZonePitch call RegPack(Buf, InData%ZonePitch) if (RegCheckErr(Buf, RoutineName)) return - ! PrflMean call RegPack(Buf, InData%PrflMean) if (RegCheckErr(Buf, RoutineName)) return - ! PrflSig call RegPack(Buf, InData%PrflSig) if (RegCheckErr(Buf, RoutineName)) return - ! IceStr call RegPack(Buf, InData%IceStr) if (RegCheckErr(Buf, RoutineName)) return - ! Delmax call RegPack(Buf, InData%Delmax) if (RegCheckErr(Buf, RoutineName)) return - ! alpha call RegPack(Buf, InData%alpha) if (RegCheckErr(Buf, RoutineName)) return - ! Dwl call RegPack(Buf, InData%Dwl) if (RegCheckErr(Buf, RoutineName)) return - ! Dtp call RegPack(Buf, InData%Dtp) if (RegCheckErr(Buf, RoutineName)) return - ! hr call RegPack(Buf, InData%hr) if (RegCheckErr(Buf, RoutineName)) return - ! mu call RegPack(Buf, InData%mu) if (RegCheckErr(Buf, RoutineName)) return - ! sigf call RegPack(Buf, InData%sigf) if (RegCheckErr(Buf, RoutineName)) return - ! StrLim call RegPack(Buf, InData%StrLim) if (RegCheckErr(Buf, RoutineName)) return - ! StrRtLim call RegPack(Buf, InData%StrRtLim) if (RegCheckErr(Buf, RoutineName)) return - ! UorD call RegPack(Buf, InData%UorD) if (RegCheckErr(Buf, RoutineName)) return - ! Ll call RegPack(Buf, InData%Ll) if (RegCheckErr(Buf, RoutineName)) return - ! Lw call RegPack(Buf, InData%Lw) if (RegCheckErr(Buf, RoutineName)) return - ! Cpa call RegPack(Buf, InData%Cpa) if (RegCheckErr(Buf, RoutineName)) return - ! dpa call RegPack(Buf, InData%dpa) if (RegCheckErr(Buf, RoutineName)) return - ! Fdr call RegPack(Buf, InData%Fdr) if (RegCheckErr(Buf, RoutineName)) return - ! Kic call RegPack(Buf, InData%Kic) if (RegCheckErr(Buf, RoutineName)) return - ! FspN call RegPack(Buf, InData%FspN) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -567,40 +503,28 @@ subroutine IceD_UnPackInputFile(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! IceModel call RegUnpack(Buf, OutData%IceModel) if (RegCheckErr(Buf, RoutineName)) return - ! IceSubModel call RegUnpack(Buf, OutData%IceSubModel) if (RegCheckErr(Buf, RoutineName)) return - ! h call RegUnpack(Buf, OutData%h) if (RegCheckErr(Buf, RoutineName)) return - ! v call RegUnpack(Buf, OutData%v) if (RegCheckErr(Buf, RoutineName)) return - ! InitLoc call RegUnpack(Buf, OutData%InitLoc) if (RegCheckErr(Buf, RoutineName)) return - ! t0 call RegUnpack(Buf, OutData%t0) if (RegCheckErr(Buf, RoutineName)) return - ! rhow call RegUnpack(Buf, OutData%rhow) if (RegCheckErr(Buf, RoutineName)) return - ! rhoi call RegUnpack(Buf, OutData%rhoi) if (RegCheckErr(Buf, RoutineName)) return - ! Seed1 call RegUnpack(Buf, OutData%Seed1) if (RegCheckErr(Buf, RoutineName)) return - ! Seed2 call RegUnpack(Buf, OutData%Seed2) if (RegCheckErr(Buf, RoutineName)) return - ! NumLegs call RegUnpack(Buf, OutData%NumLegs) if (RegCheckErr(Buf, RoutineName)) return - ! LegPosX if (allocated(OutData%LegPosX)) deallocate(OutData%LegPosX) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -615,7 +539,6 @@ subroutine IceD_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%LegPosX) if (RegCheckErr(Buf, RoutineName)) return end if - ! LegPosY if (allocated(OutData%LegPosY)) deallocate(OutData%LegPosY) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -630,7 +553,6 @@ subroutine IceD_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%LegPosY) if (RegCheckErr(Buf, RoutineName)) return end if - ! StrWd if (allocated(OutData%StrWd)) deallocate(OutData%StrWd) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -645,208 +567,144 @@ subroutine IceD_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%StrWd) if (RegCheckErr(Buf, RoutineName)) return end if - ! Ikm call RegUnpack(Buf, OutData%Ikm) if (RegCheckErr(Buf, RoutineName)) return - ! Ag call RegUnpack(Buf, OutData%Ag) if (RegCheckErr(Buf, RoutineName)) return - ! Qg call RegUnpack(Buf, OutData%Qg) if (RegCheckErr(Buf, RoutineName)) return - ! Rg call RegUnpack(Buf, OutData%Rg) if (RegCheckErr(Buf, RoutineName)) return - ! Tice call RegUnpack(Buf, OutData%Tice) if (RegCheckErr(Buf, RoutineName)) return - ! nu call RegUnpack(Buf, OutData%nu) if (RegCheckErr(Buf, RoutineName)) return - ! phi call RegUnpack(Buf, OutData%phi) if (RegCheckErr(Buf, RoutineName)) return - ! SigNm call RegUnpack(Buf, OutData%SigNm) if (RegCheckErr(Buf, RoutineName)) return - ! Eice call RegUnpack(Buf, OutData%Eice) if (RegCheckErr(Buf, RoutineName)) return - ! IceStr2 call RegUnpack(Buf, OutData%IceStr2) if (RegCheckErr(Buf, RoutineName)) return - ! Delmax2 call RegUnpack(Buf, OutData%Delmax2) if (RegCheckErr(Buf, RoutineName)) return - ! Pitch call RegUnpack(Buf, OutData%Pitch) if (RegCheckErr(Buf, RoutineName)) return - ! miuh call RegUnpack(Buf, OutData%miuh) if (RegCheckErr(Buf, RoutineName)) return - ! varh call RegUnpack(Buf, OutData%varh) if (RegCheckErr(Buf, RoutineName)) return - ! miuv call RegUnpack(Buf, OutData%miuv) if (RegCheckErr(Buf, RoutineName)) return - ! varv call RegUnpack(Buf, OutData%varv) if (RegCheckErr(Buf, RoutineName)) return - ! miut call RegUnpack(Buf, OutData%miut) if (RegCheckErr(Buf, RoutineName)) return - ! miubr call RegUnpack(Buf, OutData%miubr) if (RegCheckErr(Buf, RoutineName)) return - ! varbr call RegUnpack(Buf, OutData%varbr) if (RegCheckErr(Buf, RoutineName)) return - ! miuDelm call RegUnpack(Buf, OutData%miuDelm) if (RegCheckErr(Buf, RoutineName)) return - ! varDelm call RegUnpack(Buf, OutData%varDelm) if (RegCheckErr(Buf, RoutineName)) return - ! miuP call RegUnpack(Buf, OutData%miuP) if (RegCheckErr(Buf, RoutineName)) return - ! varP call RegUnpack(Buf, OutData%varP) if (RegCheckErr(Buf, RoutineName)) return - ! Zn1 call RegUnpack(Buf, OutData%Zn1) if (RegCheckErr(Buf, RoutineName)) return - ! Zn2 call RegUnpack(Buf, OutData%Zn2) if (RegCheckErr(Buf, RoutineName)) return - ! ZonePitch call RegUnpack(Buf, OutData%ZonePitch) if (RegCheckErr(Buf, RoutineName)) return - ! PrflMean call RegUnpack(Buf, OutData%PrflMean) if (RegCheckErr(Buf, RoutineName)) return - ! PrflSig call RegUnpack(Buf, OutData%PrflSig) if (RegCheckErr(Buf, RoutineName)) return - ! IceStr call RegUnpack(Buf, OutData%IceStr) if (RegCheckErr(Buf, RoutineName)) return - ! Delmax call RegUnpack(Buf, OutData%Delmax) if (RegCheckErr(Buf, RoutineName)) return - ! alpha call RegUnpack(Buf, OutData%alpha) if (RegCheckErr(Buf, RoutineName)) return - ! Dwl call RegUnpack(Buf, OutData%Dwl) if (RegCheckErr(Buf, RoutineName)) return - ! Dtp call RegUnpack(Buf, OutData%Dtp) if (RegCheckErr(Buf, RoutineName)) return - ! hr call RegUnpack(Buf, OutData%hr) if (RegCheckErr(Buf, RoutineName)) return - ! mu call RegUnpack(Buf, OutData%mu) if (RegCheckErr(Buf, RoutineName)) return - ! sigf call RegUnpack(Buf, OutData%sigf) if (RegCheckErr(Buf, RoutineName)) return - ! StrLim call RegUnpack(Buf, OutData%StrLim) if (RegCheckErr(Buf, RoutineName)) return - ! StrRtLim call RegUnpack(Buf, OutData%StrRtLim) if (RegCheckErr(Buf, RoutineName)) return - ! UorD call RegUnpack(Buf, OutData%UorD) if (RegCheckErr(Buf, RoutineName)) return - ! Ll call RegUnpack(Buf, OutData%Ll) if (RegCheckErr(Buf, RoutineName)) return - ! Lw call RegUnpack(Buf, OutData%Lw) if (RegCheckErr(Buf, RoutineName)) return - ! Cpa call RegUnpack(Buf, OutData%Cpa) if (RegCheckErr(Buf, RoutineName)) return - ! dpa call RegUnpack(Buf, OutData%dpa) if (RegCheckErr(Buf, RoutineName)) return - ! Fdr call RegUnpack(Buf, OutData%Fdr) if (RegCheckErr(Buf, RoutineName)) return - ! Kic call RegUnpack(Buf, OutData%Kic) if (RegCheckErr(Buf, RoutineName)) return - ! FspN call RegUnpack(Buf, OutData%FspN) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE IceD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceD_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(IceD_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_CopyInitInput' -! + +subroutine IceD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(IceD_InitInputType), intent(in) :: SrcInitInputData + type(IceD_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceD_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFile = SrcInitInputData%InputFile - DstInitInputData%RootName = SrcInitInputData%RootName - DstInitInputData%MSL2SWL = SrcInitInputData%MSL2SWL - DstInitInputData%WtrDens = SrcInitInputData%WtrDens - DstInitInputData%gravity = SrcInitInputData%gravity - DstInitInputData%LegNum = SrcInitInputData%LegNum - DstInitInputData%TMax = SrcInitInputData%TMax - END SUBROUTINE IceD_CopyInitInput - - SUBROUTINE IceD_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(IceD_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE IceD_DestroyInitInput + ErrMsg = '' + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%RootName = SrcInitInputData%RootName + DstInitInputData%MSL2SWL = SrcInitInputData%MSL2SWL + DstInitInputData%WtrDens = SrcInitInputData%WtrDens + DstInitInputData%gravity = SrcInitInputData%gravity + DstInitInputData%LegNum = SrcInitInputData%LegNum + DstInitInputData%TMax = SrcInitInputData%TMax +end subroutine +subroutine IceD_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(IceD_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceD_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine IceD_PackInitInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(IceD_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'IceD_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return - ! InputFile call RegPack(Buf, InData%InputFile) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegPack(Buf, InData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! MSL2SWL call RegPack(Buf, InData%MSL2SWL) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDens call RegPack(Buf, InData%WtrDens) if (RegCheckErr(Buf, RoutineName)) return - ! gravity call RegPack(Buf, InData%gravity) if (RegCheckErr(Buf, RoutineName)) return - ! LegNum call RegPack(Buf, InData%LegNum) if (RegCheckErr(Buf, RoutineName)) return - ! TMax call RegPack(Buf, InData%TMax) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -856,120 +714,104 @@ subroutine IceD_UnPackInitInput(Buf, OutData) type(IceD_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceD_UnPackInitInput' if (Buf%ErrStat /= ErrID_None) return - ! InputFile call RegUnpack(Buf, OutData%InputFile) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegUnpack(Buf, OutData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! MSL2SWL call RegUnpack(Buf, OutData%MSL2SWL) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDens call RegUnpack(Buf, OutData%WtrDens) if (RegCheckErr(Buf, RoutineName)) return - ! gravity call RegUnpack(Buf, OutData%gravity) if (RegCheckErr(Buf, RoutineName)) return - ! LegNum call RegUnpack(Buf, OutData%LegNum) if (RegCheckErr(Buf, RoutineName)) return - ! TMax call RegUnpack(Buf, OutData%TMax) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE IceD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceD_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(IceD_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_CopyInitOutput' -! + +subroutine IceD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(IceD_InitOutputType), intent(in) :: SrcInitOutputData + type(IceD_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceD_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInitOutputData%WriteOutputHdr)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputHdr,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputHdr,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputHdr)) THEN - ALLOCATE(DstInitOutputData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr -ENDIF -IF (ALLOCATED(SrcInitOutputData%WriteOutputUnt)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputUnt,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputUnt,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputUnt)) THEN - ALLOCATE(DstInitOutputData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt -ENDIF - DstInitOutputData%numLegs = SrcInitOutputData%numLegs - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE IceD_CopyInitOutput - - SUBROUTINE IceD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(IceD_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF - CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE IceD_DestroyInitOutput + ErrMsg = '' + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr + else if (allocated(DstInitOutputData%WriteOutputHdr)) then + deallocate(DstInitOutputData%WriteOutputHdr) + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt + else if (allocated(DstInitOutputData%WriteOutputUnt)) then + deallocate(DstInitOutputData%WriteOutputUnt) + end if + DstInitOutputData%numLegs = SrcInitOutputData%numLegs + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine IceD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(IceD_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceD_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if +end subroutine subroutine IceD_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(IceD_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'IceD_PackInitOutput' if (Buf%ErrStat >= AbortErrLev) return - ! WriteOutputHdr call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) call RegPack(Buf, InData%WriteOutputHdr) end if if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutputUnt call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) call RegPack(Buf, InData%WriteOutputUnt) end if if (RegCheckErr(Buf, RoutineName)) return - ! numLegs call RegPack(Buf, InData%numLegs) if (RegCheckErr(Buf, RoutineName)) return - ! Ver call NWTC_Library_PackProgDesc(Buf, InData%Ver) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -982,7 +824,6 @@ subroutine IceD_UnPackInitOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! WriteOutputHdr if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -997,7 +838,6 @@ subroutine IceD_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutputHdr) if (RegCheckErr(Buf, RoutineName)) return end if - ! WriteOutputUnt if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1012,55 +852,40 @@ subroutine IceD_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutputUnt) if (RegCheckErr(Buf, RoutineName)) return end if - ! numLegs call RegUnpack(Buf, OutData%numLegs) if (RegCheckErr(Buf, RoutineName)) return - ! Ver call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver end subroutine - SUBROUTINE IceD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceD_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(IceD_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%q = SrcContStateData%q - DstContStateData%dqdt = SrcContStateData%dqdt - END SUBROUTINE IceD_CopyContState - SUBROUTINE IceD_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(IceD_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE IceD_DestroyContState +subroutine IceD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(IceD_ContinuousStateType), intent(in) :: SrcContStateData + type(IceD_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceD_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + DstContStateData%q = SrcContStateData%q + DstContStateData%dqdt = SrcContStateData%dqdt +end subroutine +subroutine IceD_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(IceD_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceD_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine IceD_PackContState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(IceD_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'IceD_PackContState' if (Buf%ErrStat >= AbortErrLev) return - ! q call RegPack(Buf, InData%q) if (RegCheckErr(Buf, RoutineName)) return - ! dqdt call RegPack(Buf, InData%dqdt) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1070,52 +895,38 @@ subroutine IceD_UnPackContState(Buf, OutData) type(IceD_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceD_UnPackContState' if (Buf%ErrStat /= ErrID_None) return - ! q call RegUnpack(Buf, OutData%q) if (RegCheckErr(Buf, RoutineName)) return - ! dqdt call RegUnpack(Buf, OutData%dqdt) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE IceD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceD_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(IceD_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState - END SUBROUTINE IceD_CopyDiscState - SUBROUTINE IceD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(IceD_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE IceD_DestroyDiscState +subroutine IceD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(IceD_DiscreteStateType), intent(in) :: SrcDiscStateData + type(IceD_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceD_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState +end subroutine +subroutine IceD_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(IceD_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceD_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine IceD_PackDiscState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(IceD_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'IceD_PackDiscState' if (Buf%ErrStat >= AbortErrLev) return - ! DummyDiscState call RegPack(Buf, InData%DummyDiscState) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1125,49 +936,36 @@ subroutine IceD_UnPackDiscState(Buf, OutData) type(IceD_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceD_UnPackDiscState' if (Buf%ErrStat /= ErrID_None) return - ! DummyDiscState call RegUnpack(Buf, OutData%DummyDiscState) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE IceD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceD_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(IceD_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE IceD_CopyConstrState - - SUBROUTINE IceD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(IceD_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_DestroyConstrState' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE IceD_DestroyConstrState +subroutine IceD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(IceD_ConstraintStateType), intent(in) :: SrcConstrStateData + type(IceD_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceD_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine +subroutine IceD_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(IceD_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceD_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine IceD_PackConstrState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(IceD_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'IceD_PackConstrState' if (Buf%ErrStat >= AbortErrLev) return - ! DummyConstrState call RegPack(Buf, InData%DummyConstrState) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1177,116 +975,121 @@ subroutine IceD_UnPackConstrState(Buf, OutData) type(IceD_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceD_UnPackConstrState' if (Buf%ErrStat /= ErrID_None) return - ! DummyConstrState call RegUnpack(Buf, OutData%DummyConstrState) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE IceD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceD_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(IceD_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_CopyOtherState' -! + +subroutine IceD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(IceD_OtherStateType), intent(in) :: SrcOtherStateData + type(IceD_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceD_CopyOtherState' ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%IceTthNo2 = SrcOtherStateData%IceTthNo2 -IF (ALLOCATED(SrcOtherStateData%Nc)) THEN - i1_l = LBOUND(SrcOtherStateData%Nc,1) - i1_u = UBOUND(SrcOtherStateData%Nc,1) - IF (.NOT. ALLOCATED(DstOtherStateData%Nc)) THEN - ALLOCATE(DstOtherStateData%Nc(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Nc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%Nc = SrcOtherStateData%Nc -ENDIF -IF (ALLOCATED(SrcOtherStateData%Psum)) THEN - i1_l = LBOUND(SrcOtherStateData%Psum,1) - i1_u = UBOUND(SrcOtherStateData%Psum,1) - IF (.NOT. ALLOCATED(DstOtherStateData%Psum)) THEN - ALLOCATE(DstOtherStateData%Psum(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Psum.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%Psum = SrcOtherStateData%Psum -ENDIF -IF (ALLOCATED(SrcOtherStateData%IceTthNo)) THEN - i1_l = LBOUND(SrcOtherStateData%IceTthNo,1) - i1_u = UBOUND(SrcOtherStateData%IceTthNo,1) - IF (.NOT. ALLOCATED(DstOtherStateData%IceTthNo)) THEN - ALLOCATE(DstOtherStateData%IceTthNo(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%IceTthNo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%IceTthNo = SrcOtherStateData%IceTthNo -ENDIF - DstOtherStateData%Beta = SrcOtherStateData%Beta - DstOtherStateData%Tinit = SrcOtherStateData%Tinit - DstOtherStateData%Splitf = SrcOtherStateData%Splitf - DstOtherStateData%dxc = SrcOtherStateData%dxc -IF (ALLOCATED(SrcOtherStateData%xdot)) THEN - i1_l = LBOUND(SrcOtherStateData%xdot,1) - i1_u = UBOUND(SrcOtherStateData%xdot,1) - IF (.NOT. ALLOCATED(DstOtherStateData%xdot)) THEN - ALLOCATE(DstOtherStateData%xdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%xdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOtherStateData%xdot,1), UBOUND(SrcOtherStateData%xdot,1) - CALL IceD_CopyContState( SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstOtherStateData%n = SrcOtherStateData%n - END SUBROUTINE IceD_CopyOtherState - - SUBROUTINE IceD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(IceD_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OtherStateData%Nc)) THEN - DEALLOCATE(OtherStateData%Nc) -ENDIF -IF (ALLOCATED(OtherStateData%Psum)) THEN - DEALLOCATE(OtherStateData%Psum) -ENDIF -IF (ALLOCATED(OtherStateData%IceTthNo)) THEN - DEALLOCATE(OtherStateData%IceTthNo) -ENDIF -IF (ALLOCATED(OtherStateData%xdot)) THEN -DO i1 = LBOUND(OtherStateData%xdot,1), UBOUND(OtherStateData%xdot,1) - CALL IceD_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OtherStateData%xdot) -ENDIF - END SUBROUTINE IceD_DestroyOtherState + ErrMsg = '' + DstOtherStateData%IceTthNo2 = SrcOtherStateData%IceTthNo2 + if (allocated(SrcOtherStateData%Nc)) then + LB(1:1) = lbound(SrcOtherStateData%Nc) + UB(1:1) = ubound(SrcOtherStateData%Nc) + if (.not. allocated(DstOtherStateData%Nc)) then + allocate(DstOtherStateData%Nc(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Nc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%Nc = SrcOtherStateData%Nc + else if (allocated(DstOtherStateData%Nc)) then + deallocate(DstOtherStateData%Nc) + end if + if (allocated(SrcOtherStateData%Psum)) then + LB(1:1) = lbound(SrcOtherStateData%Psum) + UB(1:1) = ubound(SrcOtherStateData%Psum) + if (.not. allocated(DstOtherStateData%Psum)) then + allocate(DstOtherStateData%Psum(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Psum.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%Psum = SrcOtherStateData%Psum + else if (allocated(DstOtherStateData%Psum)) then + deallocate(DstOtherStateData%Psum) + end if + if (allocated(SrcOtherStateData%IceTthNo)) then + LB(1:1) = lbound(SrcOtherStateData%IceTthNo) + UB(1:1) = ubound(SrcOtherStateData%IceTthNo) + if (.not. allocated(DstOtherStateData%IceTthNo)) then + allocate(DstOtherStateData%IceTthNo(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%IceTthNo.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%IceTthNo = SrcOtherStateData%IceTthNo + else if (allocated(DstOtherStateData%IceTthNo)) then + deallocate(DstOtherStateData%IceTthNo) + end if + DstOtherStateData%Beta = SrcOtherStateData%Beta + DstOtherStateData%Tinit = SrcOtherStateData%Tinit + DstOtherStateData%Splitf = SrcOtherStateData%Splitf + DstOtherStateData%dxc = SrcOtherStateData%dxc + if (allocated(SrcOtherStateData%xdot)) then + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) + if (.not. allocated(DstOtherStateData%xdot)) then + allocate(DstOtherStateData%xdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%xdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call IceD_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstOtherStateData%xdot)) then + deallocate(DstOtherStateData%xdot) + end if + DstOtherStateData%n = SrcOtherStateData%n +end subroutine +subroutine IceD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(IceD_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceD_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OtherStateData%Nc)) then + deallocate(OtherStateData%Nc) + end if + if (allocated(OtherStateData%Psum)) then + deallocate(OtherStateData%Psum) + end if + if (allocated(OtherStateData%IceTthNo)) then + deallocate(OtherStateData%IceTthNo) + end if + if (allocated(OtherStateData%xdot)) then + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) + do i1 = LB(1), UB(1) + call IceD_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OtherStateData%xdot) + end if +end subroutine subroutine IceD_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -1295,43 +1098,34 @@ subroutine IceD_PackOtherState(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! IceTthNo2 call RegPack(Buf, InData%IceTthNo2) if (RegCheckErr(Buf, RoutineName)) return - ! Nc call RegPack(Buf, allocated(InData%Nc)) if (allocated(InData%Nc)) then call RegPackBounds(Buf, 1, lbound(InData%Nc), ubound(InData%Nc)) call RegPack(Buf, InData%Nc) end if if (RegCheckErr(Buf, RoutineName)) return - ! Psum call RegPack(Buf, allocated(InData%Psum)) if (allocated(InData%Psum)) then call RegPackBounds(Buf, 1, lbound(InData%Psum), ubound(InData%Psum)) call RegPack(Buf, InData%Psum) end if if (RegCheckErr(Buf, RoutineName)) return - ! IceTthNo call RegPack(Buf, allocated(InData%IceTthNo)) if (allocated(InData%IceTthNo)) then call RegPackBounds(Buf, 1, lbound(InData%IceTthNo), ubound(InData%IceTthNo)) call RegPack(Buf, InData%IceTthNo) end if if (RegCheckErr(Buf, RoutineName)) return - ! Beta call RegPack(Buf, InData%Beta) if (RegCheckErr(Buf, RoutineName)) return - ! Tinit call RegPack(Buf, InData%Tinit) if (RegCheckErr(Buf, RoutineName)) return - ! Splitf call RegPack(Buf, InData%Splitf) if (RegCheckErr(Buf, RoutineName)) return - ! dxc call RegPack(Buf, InData%dxc) if (RegCheckErr(Buf, RoutineName)) return - ! xdot call RegPack(Buf, allocated(InData%xdot)) if (allocated(InData%xdot)) then call RegPackBounds(Buf, 1, lbound(InData%xdot), ubound(InData%xdot)) @@ -1342,7 +1136,6 @@ subroutine IceD_PackOtherState(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! n call RegPack(Buf, InData%n) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1356,10 +1149,8 @@ subroutine IceD_UnPackOtherState(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! IceTthNo2 call RegUnpack(Buf, OutData%IceTthNo2) if (RegCheckErr(Buf, RoutineName)) return - ! Nc if (allocated(OutData%Nc)) deallocate(OutData%Nc) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1374,7 +1165,6 @@ subroutine IceD_UnPackOtherState(Buf, OutData) call RegUnpack(Buf, OutData%Nc) if (RegCheckErr(Buf, RoutineName)) return end if - ! Psum if (allocated(OutData%Psum)) deallocate(OutData%Psum) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1389,7 +1179,6 @@ subroutine IceD_UnPackOtherState(Buf, OutData) call RegUnpack(Buf, OutData%Psum) if (RegCheckErr(Buf, RoutineName)) return end if - ! IceTthNo if (allocated(OutData%IceTthNo)) deallocate(OutData%IceTthNo) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1404,19 +1193,14 @@ subroutine IceD_UnPackOtherState(Buf, OutData) call RegUnpack(Buf, OutData%IceTthNo) if (RegCheckErr(Buf, RoutineName)) return end if - ! Beta call RegUnpack(Buf, OutData%Beta) if (RegCheckErr(Buf, RoutineName)) return - ! Tinit call RegUnpack(Buf, OutData%Tinit) if (RegCheckErr(Buf, RoutineName)) return - ! Splitf call RegUnpack(Buf, OutData%Splitf) if (RegCheckErr(Buf, RoutineName)) return - ! dxc call RegUnpack(Buf, OutData%dxc) if (RegCheckErr(Buf, RoutineName)) return - ! xdot if (allocated(OutData%xdot)) deallocate(OutData%xdot) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1432,49 +1216,36 @@ subroutine IceD_UnPackOtherState(Buf, OutData) call IceD_UnpackContState(Buf, OutData%xdot(i1)) ! xdot end do end if - ! n call RegUnpack(Buf, OutData%n) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE IceD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceD_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(IceD_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar - END SUBROUTINE IceD_CopyMisc - - SUBROUTINE IceD_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(IceD_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE IceD_DestroyMisc +subroutine IceD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(IceD_MiscVarType), intent(in) :: SrcMiscData + type(IceD_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceD_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar +end subroutine +subroutine IceD_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(IceD_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceD_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine IceD_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(IceD_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'IceD_PackMisc' if (Buf%ErrStat >= AbortErrLev) return - ! DummyMiscVar call RegPack(Buf, InData%DummyMiscVar) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1484,458 +1255,409 @@ subroutine IceD_UnPackMisc(Buf, OutData) type(IceD_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceD_UnPackMisc' if (Buf%ErrStat /= ErrID_None) return - ! DummyMiscVar call RegUnpack(Buf, OutData%DummyMiscVar) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE IceD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceD_ParameterType), INTENT(IN) :: SrcParamData - TYPE(IceD_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_CopyParam' -! + +subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(IceD_ParameterType), intent(in) :: SrcParamData + type(IceD_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'IceD_CopyParam' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%h = SrcParamData%h - DstParamData%v = SrcParamData%v - DstParamData%t0 = SrcParamData%t0 - DstParamData%StrWd = SrcParamData%StrWd - DstParamData%dt = SrcParamData%dt - DstParamData%InitLoc = SrcParamData%InitLoc - DstParamData%tolerance = SrcParamData%tolerance - DstParamData%Tmax = SrcParamData%Tmax - DstParamData%verif = SrcParamData%verif - DstParamData%ModNo = SrcParamData%ModNo - DstParamData%SubModNo = SrcParamData%SubModNo - DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%method = SrcParamData%method - DstParamData%TmStep = SrcParamData%TmStep -IF (ALLOCATED(SrcParamData%OutName)) THEN - i1_l = LBOUND(SrcParamData%OutName,1) - i1_u = UBOUND(SrcParamData%OutName,1) - IF (.NOT. ALLOCATED(DstParamData%OutName)) THEN - ALLOCATE(DstParamData%OutName(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutName.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%OutName = SrcParamData%OutName -ENDIF -IF (ALLOCATED(SrcParamData%OutUnit)) THEN - i1_l = LBOUND(SrcParamData%OutUnit,1) - i1_u = UBOUND(SrcParamData%OutUnit,1) - IF (.NOT. ALLOCATED(DstParamData%OutUnit)) THEN - ALLOCATE(DstParamData%OutUnit(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutUnit.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%OutUnit = SrcParamData%OutUnit -ENDIF - DstParamData%RootName = SrcParamData%RootName - DstParamData%tm1a = SrcParamData%tm1a - DstParamData%tm1b = SrcParamData%tm1b - DstParamData%tm1c = SrcParamData%tm1c - DstParamData%Fmax1a = SrcParamData%Fmax1a - DstParamData%Fmax1b = SrcParamData%Fmax1b - DstParamData%Fmax1c = SrcParamData%Fmax1c - DstParamData%Ikm = SrcParamData%Ikm - DstParamData%Cstr = SrcParamData%Cstr - DstParamData%EiPa = SrcParamData%EiPa - DstParamData%Delmax2 = SrcParamData%Delmax2 - DstParamData%Pitch = SrcParamData%Pitch - DstParamData%Kice2 = SrcParamData%Kice2 -IF (ALLOCATED(SrcParamData%rdmFm)) THEN - i1_l = LBOUND(SrcParamData%rdmFm,1) - i1_u = UBOUND(SrcParamData%rdmFm,1) - IF (.NOT. ALLOCATED(DstParamData%rdmFm)) THEN - ALLOCATE(DstParamData%rdmFm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rdmFm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%rdmFm = SrcParamData%rdmFm -ENDIF -IF (ALLOCATED(SrcParamData%rdmt0)) THEN - i1_l = LBOUND(SrcParamData%rdmt0,1) - i1_u = UBOUND(SrcParamData%rdmt0,1) - IF (.NOT. ALLOCATED(DstParamData%rdmt0)) THEN - ALLOCATE(DstParamData%rdmt0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rdmt0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%rdmt0 = SrcParamData%rdmt0 -ENDIF -IF (ALLOCATED(SrcParamData%rdmtm)) THEN - i1_l = LBOUND(SrcParamData%rdmtm,1) - i1_u = UBOUND(SrcParamData%rdmtm,1) - IF (.NOT. ALLOCATED(DstParamData%rdmtm)) THEN - ALLOCATE(DstParamData%rdmtm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rdmtm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%rdmtm = SrcParamData%rdmtm -ENDIF -IF (ALLOCATED(SrcParamData%rdmDm)) THEN - i1_l = LBOUND(SrcParamData%rdmDm,1) - i1_u = UBOUND(SrcParamData%rdmDm,1) - IF (.NOT. ALLOCATED(DstParamData%rdmDm)) THEN - ALLOCATE(DstParamData%rdmDm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rdmDm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%rdmDm = SrcParamData%rdmDm -ENDIF -IF (ALLOCATED(SrcParamData%rdmP)) THEN - i1_l = LBOUND(SrcParamData%rdmP,1) - i1_u = UBOUND(SrcParamData%rdmP,1) - IF (.NOT. ALLOCATED(DstParamData%rdmP)) THEN - ALLOCATE(DstParamData%rdmP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rdmP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%rdmP = SrcParamData%rdmP -ENDIF -IF (ALLOCATED(SrcParamData%rdmKi)) THEN - i1_l = LBOUND(SrcParamData%rdmKi,1) - i1_u = UBOUND(SrcParamData%rdmKi,1) - IF (.NOT. ALLOCATED(DstParamData%rdmKi)) THEN - ALLOCATE(DstParamData%rdmKi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rdmKi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%rdmKi = SrcParamData%rdmKi -ENDIF - DstParamData%ZonePitch = SrcParamData%ZonePitch - DstParamData%Kice = SrcParamData%Kice - DstParamData%Delmax = SrcParamData%Delmax -IF (ALLOCATED(SrcParamData%Y0)) THEN - i1_l = LBOUND(SrcParamData%Y0,1) - i1_u = UBOUND(SrcParamData%Y0,1) - IF (.NOT. ALLOCATED(DstParamData%Y0)) THEN - ALLOCATE(DstParamData%Y0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Y0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Y0 = SrcParamData%Y0 -ENDIF -IF (ALLOCATED(SrcParamData%ContPrfl)) THEN - i1_l = LBOUND(SrcParamData%ContPrfl,1) - i1_u = UBOUND(SrcParamData%ContPrfl,1) - IF (.NOT. ALLOCATED(DstParamData%ContPrfl)) THEN - ALLOCATE(DstParamData%ContPrfl(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ContPrfl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ContPrfl = SrcParamData%ContPrfl -ENDIF - DstParamData%Zn = SrcParamData%Zn - DstParamData%rhoi = SrcParamData%rhoi - DstParamData%rhow = SrcParamData%rhow - DstParamData%alphaR = SrcParamData%alphaR - DstParamData%Dwl = SrcParamData%Dwl - DstParamData%Zr = SrcParamData%Zr - DstParamData%RHbr = SrcParamData%RHbr - DstParamData%RVbr = SrcParamData%RVbr - DstParamData%Lbr = SrcParamData%Lbr - DstParamData%LovR = SrcParamData%LovR - DstParamData%mu = SrcParamData%mu - DstParamData%Wri = SrcParamData%Wri - DstParamData%WL = SrcParamData%WL - DstParamData%Cpa = SrcParamData%Cpa - DstParamData%dpa = SrcParamData%dpa - DstParamData%FdrN = SrcParamData%FdrN - DstParamData%Mice = SrcParamData%Mice - DstParamData%Fsp = SrcParamData%Fsp - END SUBROUTINE IceD_CopyParam - - SUBROUTINE IceD_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(IceD_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%OutName)) THEN - DEALLOCATE(ParamData%OutName) -ENDIF -IF (ALLOCATED(ParamData%OutUnit)) THEN - DEALLOCATE(ParamData%OutUnit) -ENDIF -IF (ALLOCATED(ParamData%rdmFm)) THEN - DEALLOCATE(ParamData%rdmFm) -ENDIF -IF (ALLOCATED(ParamData%rdmt0)) THEN - DEALLOCATE(ParamData%rdmt0) -ENDIF -IF (ALLOCATED(ParamData%rdmtm)) THEN - DEALLOCATE(ParamData%rdmtm) -ENDIF -IF (ALLOCATED(ParamData%rdmDm)) THEN - DEALLOCATE(ParamData%rdmDm) -ENDIF -IF (ALLOCATED(ParamData%rdmP)) THEN - DEALLOCATE(ParamData%rdmP) -ENDIF -IF (ALLOCATED(ParamData%rdmKi)) THEN - DEALLOCATE(ParamData%rdmKi) -ENDIF -IF (ALLOCATED(ParamData%Y0)) THEN - DEALLOCATE(ParamData%Y0) -ENDIF -IF (ALLOCATED(ParamData%ContPrfl)) THEN - DEALLOCATE(ParamData%ContPrfl) -ENDIF - END SUBROUTINE IceD_DestroyParam + ErrMsg = '' + DstParamData%h = SrcParamData%h + DstParamData%v = SrcParamData%v + DstParamData%t0 = SrcParamData%t0 + DstParamData%StrWd = SrcParamData%StrWd + DstParamData%dt = SrcParamData%dt + DstParamData%InitLoc = SrcParamData%InitLoc + DstParamData%tolerance = SrcParamData%tolerance + DstParamData%Tmax = SrcParamData%Tmax + DstParamData%verif = SrcParamData%verif + DstParamData%ModNo = SrcParamData%ModNo + DstParamData%SubModNo = SrcParamData%SubModNo + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%method = SrcParamData%method + DstParamData%TmStep = SrcParamData%TmStep + if (allocated(SrcParamData%OutName)) then + LB(1:1) = lbound(SrcParamData%OutName) + UB(1:1) = ubound(SrcParamData%OutName) + if (.not. allocated(DstParamData%OutName)) then + allocate(DstParamData%OutName(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutName.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%OutName = SrcParamData%OutName + else if (allocated(DstParamData%OutName)) then + deallocate(DstParamData%OutName) + end if + if (allocated(SrcParamData%OutUnit)) then + LB(1:1) = lbound(SrcParamData%OutUnit) + UB(1:1) = ubound(SrcParamData%OutUnit) + if (.not. allocated(DstParamData%OutUnit)) then + allocate(DstParamData%OutUnit(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutUnit.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%OutUnit = SrcParamData%OutUnit + else if (allocated(DstParamData%OutUnit)) then + deallocate(DstParamData%OutUnit) + end if + DstParamData%RootName = SrcParamData%RootName + DstParamData%tm1a = SrcParamData%tm1a + DstParamData%tm1b = SrcParamData%tm1b + DstParamData%tm1c = SrcParamData%tm1c + DstParamData%Fmax1a = SrcParamData%Fmax1a + DstParamData%Fmax1b = SrcParamData%Fmax1b + DstParamData%Fmax1c = SrcParamData%Fmax1c + DstParamData%Ikm = SrcParamData%Ikm + DstParamData%Cstr = SrcParamData%Cstr + DstParamData%EiPa = SrcParamData%EiPa + DstParamData%Delmax2 = SrcParamData%Delmax2 + DstParamData%Pitch = SrcParamData%Pitch + DstParamData%Kice2 = SrcParamData%Kice2 + if (allocated(SrcParamData%rdmFm)) then + LB(1:1) = lbound(SrcParamData%rdmFm) + UB(1:1) = ubound(SrcParamData%rdmFm) + if (.not. allocated(DstParamData%rdmFm)) then + allocate(DstParamData%rdmFm(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rdmFm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%rdmFm = SrcParamData%rdmFm + else if (allocated(DstParamData%rdmFm)) then + deallocate(DstParamData%rdmFm) + end if + if (allocated(SrcParamData%rdmt0)) then + LB(1:1) = lbound(SrcParamData%rdmt0) + UB(1:1) = ubound(SrcParamData%rdmt0) + if (.not. allocated(DstParamData%rdmt0)) then + allocate(DstParamData%rdmt0(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rdmt0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%rdmt0 = SrcParamData%rdmt0 + else if (allocated(DstParamData%rdmt0)) then + deallocate(DstParamData%rdmt0) + end if + if (allocated(SrcParamData%rdmtm)) then + LB(1:1) = lbound(SrcParamData%rdmtm) + UB(1:1) = ubound(SrcParamData%rdmtm) + if (.not. allocated(DstParamData%rdmtm)) then + allocate(DstParamData%rdmtm(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rdmtm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%rdmtm = SrcParamData%rdmtm + else if (allocated(DstParamData%rdmtm)) then + deallocate(DstParamData%rdmtm) + end if + if (allocated(SrcParamData%rdmDm)) then + LB(1:1) = lbound(SrcParamData%rdmDm) + UB(1:1) = ubound(SrcParamData%rdmDm) + if (.not. allocated(DstParamData%rdmDm)) then + allocate(DstParamData%rdmDm(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rdmDm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%rdmDm = SrcParamData%rdmDm + else if (allocated(DstParamData%rdmDm)) then + deallocate(DstParamData%rdmDm) + end if + if (allocated(SrcParamData%rdmP)) then + LB(1:1) = lbound(SrcParamData%rdmP) + UB(1:1) = ubound(SrcParamData%rdmP) + if (.not. allocated(DstParamData%rdmP)) then + allocate(DstParamData%rdmP(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rdmP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%rdmP = SrcParamData%rdmP + else if (allocated(DstParamData%rdmP)) then + deallocate(DstParamData%rdmP) + end if + if (allocated(SrcParamData%rdmKi)) then + LB(1:1) = lbound(SrcParamData%rdmKi) + UB(1:1) = ubound(SrcParamData%rdmKi) + if (.not. allocated(DstParamData%rdmKi)) then + allocate(DstParamData%rdmKi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rdmKi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%rdmKi = SrcParamData%rdmKi + else if (allocated(DstParamData%rdmKi)) then + deallocate(DstParamData%rdmKi) + end if + DstParamData%ZonePitch = SrcParamData%ZonePitch + DstParamData%Kice = SrcParamData%Kice + DstParamData%Delmax = SrcParamData%Delmax + if (allocated(SrcParamData%Y0)) then + LB(1:1) = lbound(SrcParamData%Y0) + UB(1:1) = ubound(SrcParamData%Y0) + if (.not. allocated(DstParamData%Y0)) then + allocate(DstParamData%Y0(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Y0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Y0 = SrcParamData%Y0 + else if (allocated(DstParamData%Y0)) then + deallocate(DstParamData%Y0) + end if + if (allocated(SrcParamData%ContPrfl)) then + LB(1:1) = lbound(SrcParamData%ContPrfl) + UB(1:1) = ubound(SrcParamData%ContPrfl) + if (.not. allocated(DstParamData%ContPrfl)) then + allocate(DstParamData%ContPrfl(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ContPrfl.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%ContPrfl = SrcParamData%ContPrfl + else if (allocated(DstParamData%ContPrfl)) then + deallocate(DstParamData%ContPrfl) + end if + DstParamData%Zn = SrcParamData%Zn + DstParamData%rhoi = SrcParamData%rhoi + DstParamData%rhow = SrcParamData%rhow + DstParamData%alphaR = SrcParamData%alphaR + DstParamData%Dwl = SrcParamData%Dwl + DstParamData%Zr = SrcParamData%Zr + DstParamData%RHbr = SrcParamData%RHbr + DstParamData%RVbr = SrcParamData%RVbr + DstParamData%Lbr = SrcParamData%Lbr + DstParamData%LovR = SrcParamData%LovR + DstParamData%mu = SrcParamData%mu + DstParamData%Wri = SrcParamData%Wri + DstParamData%WL = SrcParamData%WL + DstParamData%Cpa = SrcParamData%Cpa + DstParamData%dpa = SrcParamData%dpa + DstParamData%FdrN = SrcParamData%FdrN + DstParamData%Mice = SrcParamData%Mice + DstParamData%Fsp = SrcParamData%Fsp +end subroutine +subroutine IceD_DestroyParam(ParamData, ErrStat, ErrMsg) + type(IceD_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceD_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%OutName)) then + deallocate(ParamData%OutName) + end if + if (allocated(ParamData%OutUnit)) then + deallocate(ParamData%OutUnit) + end if + if (allocated(ParamData%rdmFm)) then + deallocate(ParamData%rdmFm) + end if + if (allocated(ParamData%rdmt0)) then + deallocate(ParamData%rdmt0) + end if + if (allocated(ParamData%rdmtm)) then + deallocate(ParamData%rdmtm) + end if + if (allocated(ParamData%rdmDm)) then + deallocate(ParamData%rdmDm) + end if + if (allocated(ParamData%rdmP)) then + deallocate(ParamData%rdmP) + end if + if (allocated(ParamData%rdmKi)) then + deallocate(ParamData%rdmKi) + end if + if (allocated(ParamData%Y0)) then + deallocate(ParamData%Y0) + end if + if (allocated(ParamData%ContPrfl)) then + deallocate(ParamData%ContPrfl) + end if +end subroutine subroutine IceD_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(IceD_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'IceD_PackParam' if (Buf%ErrStat >= AbortErrLev) return - ! h call RegPack(Buf, InData%h) if (RegCheckErr(Buf, RoutineName)) return - ! v call RegPack(Buf, InData%v) if (RegCheckErr(Buf, RoutineName)) return - ! t0 call RegPack(Buf, InData%t0) if (RegCheckErr(Buf, RoutineName)) return - ! StrWd call RegPack(Buf, InData%StrWd) if (RegCheckErr(Buf, RoutineName)) return - ! dt call RegPack(Buf, InData%dt) if (RegCheckErr(Buf, RoutineName)) return - ! InitLoc call RegPack(Buf, InData%InitLoc) if (RegCheckErr(Buf, RoutineName)) return - ! tolerance call RegPack(Buf, InData%tolerance) if (RegCheckErr(Buf, RoutineName)) return - ! Tmax call RegPack(Buf, InData%Tmax) if (RegCheckErr(Buf, RoutineName)) return - ! verif call RegPack(Buf, InData%verif) if (RegCheckErr(Buf, RoutineName)) return - ! ModNo call RegPack(Buf, InData%ModNo) if (RegCheckErr(Buf, RoutineName)) return - ! SubModNo call RegPack(Buf, InData%SubModNo) if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegPack(Buf, InData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! method call RegPack(Buf, InData%method) if (RegCheckErr(Buf, RoutineName)) return - ! TmStep call RegPack(Buf, InData%TmStep) if (RegCheckErr(Buf, RoutineName)) return - ! OutName call RegPack(Buf, allocated(InData%OutName)) if (allocated(InData%OutName)) then call RegPackBounds(Buf, 1, lbound(InData%OutName), ubound(InData%OutName)) call RegPack(Buf, InData%OutName) end if if (RegCheckErr(Buf, RoutineName)) return - ! OutUnit call RegPack(Buf, allocated(InData%OutUnit)) if (allocated(InData%OutUnit)) then call RegPackBounds(Buf, 1, lbound(InData%OutUnit), ubound(InData%OutUnit)) call RegPack(Buf, InData%OutUnit) end if if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegPack(Buf, InData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! tm1a call RegPack(Buf, InData%tm1a) if (RegCheckErr(Buf, RoutineName)) return - ! tm1b call RegPack(Buf, InData%tm1b) if (RegCheckErr(Buf, RoutineName)) return - ! tm1c call RegPack(Buf, InData%tm1c) if (RegCheckErr(Buf, RoutineName)) return - ! Fmax1a call RegPack(Buf, InData%Fmax1a) if (RegCheckErr(Buf, RoutineName)) return - ! Fmax1b call RegPack(Buf, InData%Fmax1b) if (RegCheckErr(Buf, RoutineName)) return - ! Fmax1c call RegPack(Buf, InData%Fmax1c) if (RegCheckErr(Buf, RoutineName)) return - ! Ikm call RegPack(Buf, InData%Ikm) if (RegCheckErr(Buf, RoutineName)) return - ! Cstr call RegPack(Buf, InData%Cstr) if (RegCheckErr(Buf, RoutineName)) return - ! EiPa call RegPack(Buf, InData%EiPa) if (RegCheckErr(Buf, RoutineName)) return - ! Delmax2 call RegPack(Buf, InData%Delmax2) if (RegCheckErr(Buf, RoutineName)) return - ! Pitch call RegPack(Buf, InData%Pitch) if (RegCheckErr(Buf, RoutineName)) return - ! Kice2 call RegPack(Buf, InData%Kice2) if (RegCheckErr(Buf, RoutineName)) return - ! rdmFm call RegPack(Buf, allocated(InData%rdmFm)) if (allocated(InData%rdmFm)) then call RegPackBounds(Buf, 1, lbound(InData%rdmFm), ubound(InData%rdmFm)) call RegPack(Buf, InData%rdmFm) end if if (RegCheckErr(Buf, RoutineName)) return - ! rdmt0 call RegPack(Buf, allocated(InData%rdmt0)) if (allocated(InData%rdmt0)) then call RegPackBounds(Buf, 1, lbound(InData%rdmt0), ubound(InData%rdmt0)) call RegPack(Buf, InData%rdmt0) end if if (RegCheckErr(Buf, RoutineName)) return - ! rdmtm call RegPack(Buf, allocated(InData%rdmtm)) if (allocated(InData%rdmtm)) then call RegPackBounds(Buf, 1, lbound(InData%rdmtm), ubound(InData%rdmtm)) call RegPack(Buf, InData%rdmtm) end if if (RegCheckErr(Buf, RoutineName)) return - ! rdmDm call RegPack(Buf, allocated(InData%rdmDm)) if (allocated(InData%rdmDm)) then call RegPackBounds(Buf, 1, lbound(InData%rdmDm), ubound(InData%rdmDm)) call RegPack(Buf, InData%rdmDm) end if if (RegCheckErr(Buf, RoutineName)) return - ! rdmP call RegPack(Buf, allocated(InData%rdmP)) if (allocated(InData%rdmP)) then call RegPackBounds(Buf, 1, lbound(InData%rdmP), ubound(InData%rdmP)) call RegPack(Buf, InData%rdmP) end if if (RegCheckErr(Buf, RoutineName)) return - ! rdmKi call RegPack(Buf, allocated(InData%rdmKi)) if (allocated(InData%rdmKi)) then call RegPackBounds(Buf, 1, lbound(InData%rdmKi), ubound(InData%rdmKi)) call RegPack(Buf, InData%rdmKi) end if if (RegCheckErr(Buf, RoutineName)) return - ! ZonePitch call RegPack(Buf, InData%ZonePitch) if (RegCheckErr(Buf, RoutineName)) return - ! Kice call RegPack(Buf, InData%Kice) if (RegCheckErr(Buf, RoutineName)) return - ! Delmax call RegPack(Buf, InData%Delmax) if (RegCheckErr(Buf, RoutineName)) return - ! Y0 call RegPack(Buf, allocated(InData%Y0)) if (allocated(InData%Y0)) then call RegPackBounds(Buf, 1, lbound(InData%Y0), ubound(InData%Y0)) call RegPack(Buf, InData%Y0) end if if (RegCheckErr(Buf, RoutineName)) return - ! ContPrfl call RegPack(Buf, allocated(InData%ContPrfl)) if (allocated(InData%ContPrfl)) then call RegPackBounds(Buf, 1, lbound(InData%ContPrfl), ubound(InData%ContPrfl)) call RegPack(Buf, InData%ContPrfl) end if if (RegCheckErr(Buf, RoutineName)) return - ! Zn call RegPack(Buf, InData%Zn) if (RegCheckErr(Buf, RoutineName)) return - ! rhoi call RegPack(Buf, InData%rhoi) if (RegCheckErr(Buf, RoutineName)) return - ! rhow call RegPack(Buf, InData%rhow) if (RegCheckErr(Buf, RoutineName)) return - ! alphaR call RegPack(Buf, InData%alphaR) if (RegCheckErr(Buf, RoutineName)) return - ! Dwl call RegPack(Buf, InData%Dwl) if (RegCheckErr(Buf, RoutineName)) return - ! Zr call RegPack(Buf, InData%Zr) if (RegCheckErr(Buf, RoutineName)) return - ! RHbr call RegPack(Buf, InData%RHbr) if (RegCheckErr(Buf, RoutineName)) return - ! RVbr call RegPack(Buf, InData%RVbr) if (RegCheckErr(Buf, RoutineName)) return - ! Lbr call RegPack(Buf, InData%Lbr) if (RegCheckErr(Buf, RoutineName)) return - ! LovR call RegPack(Buf, InData%LovR) if (RegCheckErr(Buf, RoutineName)) return - ! mu call RegPack(Buf, InData%mu) if (RegCheckErr(Buf, RoutineName)) return - ! Wri call RegPack(Buf, InData%Wri) if (RegCheckErr(Buf, RoutineName)) return - ! WL call RegPack(Buf, InData%WL) if (RegCheckErr(Buf, RoutineName)) return - ! Cpa call RegPack(Buf, InData%Cpa) if (RegCheckErr(Buf, RoutineName)) return - ! dpa call RegPack(Buf, InData%dpa) if (RegCheckErr(Buf, RoutineName)) return - ! FdrN call RegPack(Buf, InData%FdrN) if (RegCheckErr(Buf, RoutineName)) return - ! Mice call RegPack(Buf, InData%Mice) if (RegCheckErr(Buf, RoutineName)) return - ! Fsp call RegPack(Buf, InData%Fsp) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1948,49 +1670,34 @@ subroutine IceD_UnPackParam(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! h call RegUnpack(Buf, OutData%h) if (RegCheckErr(Buf, RoutineName)) return - ! v call RegUnpack(Buf, OutData%v) if (RegCheckErr(Buf, RoutineName)) return - ! t0 call RegUnpack(Buf, OutData%t0) if (RegCheckErr(Buf, RoutineName)) return - ! StrWd call RegUnpack(Buf, OutData%StrWd) if (RegCheckErr(Buf, RoutineName)) return - ! dt call RegUnpack(Buf, OutData%dt) if (RegCheckErr(Buf, RoutineName)) return - ! InitLoc call RegUnpack(Buf, OutData%InitLoc) if (RegCheckErr(Buf, RoutineName)) return - ! tolerance call RegUnpack(Buf, OutData%tolerance) if (RegCheckErr(Buf, RoutineName)) return - ! Tmax call RegUnpack(Buf, OutData%Tmax) if (RegCheckErr(Buf, RoutineName)) return - ! verif call RegUnpack(Buf, OutData%verif) if (RegCheckErr(Buf, RoutineName)) return - ! ModNo call RegUnpack(Buf, OutData%ModNo) if (RegCheckErr(Buf, RoutineName)) return - ! SubModNo call RegUnpack(Buf, OutData%SubModNo) if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegUnpack(Buf, OutData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! method call RegUnpack(Buf, OutData%method) if (RegCheckErr(Buf, RoutineName)) return - ! TmStep call RegUnpack(Buf, OutData%TmStep) if (RegCheckErr(Buf, RoutineName)) return - ! OutName if (allocated(OutData%OutName)) deallocate(OutData%OutName) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2005,7 +1712,6 @@ subroutine IceD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%OutName) if (RegCheckErr(Buf, RoutineName)) return end if - ! OutUnit if (allocated(OutData%OutUnit)) deallocate(OutData%OutUnit) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2020,46 +1726,32 @@ subroutine IceD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%OutUnit) if (RegCheckErr(Buf, RoutineName)) return end if - ! RootName call RegUnpack(Buf, OutData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! tm1a call RegUnpack(Buf, OutData%tm1a) if (RegCheckErr(Buf, RoutineName)) return - ! tm1b call RegUnpack(Buf, OutData%tm1b) if (RegCheckErr(Buf, RoutineName)) return - ! tm1c call RegUnpack(Buf, OutData%tm1c) if (RegCheckErr(Buf, RoutineName)) return - ! Fmax1a call RegUnpack(Buf, OutData%Fmax1a) if (RegCheckErr(Buf, RoutineName)) return - ! Fmax1b call RegUnpack(Buf, OutData%Fmax1b) if (RegCheckErr(Buf, RoutineName)) return - ! Fmax1c call RegUnpack(Buf, OutData%Fmax1c) if (RegCheckErr(Buf, RoutineName)) return - ! Ikm call RegUnpack(Buf, OutData%Ikm) if (RegCheckErr(Buf, RoutineName)) return - ! Cstr call RegUnpack(Buf, OutData%Cstr) if (RegCheckErr(Buf, RoutineName)) return - ! EiPa call RegUnpack(Buf, OutData%EiPa) if (RegCheckErr(Buf, RoutineName)) return - ! Delmax2 call RegUnpack(Buf, OutData%Delmax2) if (RegCheckErr(Buf, RoutineName)) return - ! Pitch call RegUnpack(Buf, OutData%Pitch) if (RegCheckErr(Buf, RoutineName)) return - ! Kice2 call RegUnpack(Buf, OutData%Kice2) if (RegCheckErr(Buf, RoutineName)) return - ! rdmFm if (allocated(OutData%rdmFm)) deallocate(OutData%rdmFm) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2074,7 +1766,6 @@ subroutine IceD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%rdmFm) if (RegCheckErr(Buf, RoutineName)) return end if - ! rdmt0 if (allocated(OutData%rdmt0)) deallocate(OutData%rdmt0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2089,7 +1780,6 @@ subroutine IceD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%rdmt0) if (RegCheckErr(Buf, RoutineName)) return end if - ! rdmtm if (allocated(OutData%rdmtm)) deallocate(OutData%rdmtm) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2104,7 +1794,6 @@ subroutine IceD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%rdmtm) if (RegCheckErr(Buf, RoutineName)) return end if - ! rdmDm if (allocated(OutData%rdmDm)) deallocate(OutData%rdmDm) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2119,7 +1808,6 @@ subroutine IceD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%rdmDm) if (RegCheckErr(Buf, RoutineName)) return end if - ! rdmP if (allocated(OutData%rdmP)) deallocate(OutData%rdmP) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2134,7 +1822,6 @@ subroutine IceD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%rdmP) if (RegCheckErr(Buf, RoutineName)) return end if - ! rdmKi if (allocated(OutData%rdmKi)) deallocate(OutData%rdmKi) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2149,16 +1836,12 @@ subroutine IceD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%rdmKi) if (RegCheckErr(Buf, RoutineName)) return end if - ! ZonePitch call RegUnpack(Buf, OutData%ZonePitch) if (RegCheckErr(Buf, RoutineName)) return - ! Kice call RegUnpack(Buf, OutData%Kice) if (RegCheckErr(Buf, RoutineName)) return - ! Delmax call RegUnpack(Buf, OutData%Delmax) if (RegCheckErr(Buf, RoutineName)) return - ! Y0 if (allocated(OutData%Y0)) deallocate(OutData%Y0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2173,7 +1856,6 @@ subroutine IceD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%Y0) if (RegCheckErr(Buf, RoutineName)) return end if - ! ContPrfl if (allocated(OutData%ContPrfl)) deallocate(OutData%ContPrfl) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2188,104 +1870,76 @@ subroutine IceD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%ContPrfl) if (RegCheckErr(Buf, RoutineName)) return end if - ! Zn call RegUnpack(Buf, OutData%Zn) if (RegCheckErr(Buf, RoutineName)) return - ! rhoi call RegUnpack(Buf, OutData%rhoi) if (RegCheckErr(Buf, RoutineName)) return - ! rhow call RegUnpack(Buf, OutData%rhow) if (RegCheckErr(Buf, RoutineName)) return - ! alphaR call RegUnpack(Buf, OutData%alphaR) if (RegCheckErr(Buf, RoutineName)) return - ! Dwl call RegUnpack(Buf, OutData%Dwl) if (RegCheckErr(Buf, RoutineName)) return - ! Zr call RegUnpack(Buf, OutData%Zr) if (RegCheckErr(Buf, RoutineName)) return - ! RHbr call RegUnpack(Buf, OutData%RHbr) if (RegCheckErr(Buf, RoutineName)) return - ! RVbr call RegUnpack(Buf, OutData%RVbr) if (RegCheckErr(Buf, RoutineName)) return - ! Lbr call RegUnpack(Buf, OutData%Lbr) if (RegCheckErr(Buf, RoutineName)) return - ! LovR call RegUnpack(Buf, OutData%LovR) if (RegCheckErr(Buf, RoutineName)) return - ! mu call RegUnpack(Buf, OutData%mu) if (RegCheckErr(Buf, RoutineName)) return - ! Wri call RegUnpack(Buf, OutData%Wri) if (RegCheckErr(Buf, RoutineName)) return - ! WL call RegUnpack(Buf, OutData%WL) if (RegCheckErr(Buf, RoutineName)) return - ! Cpa call RegUnpack(Buf, OutData%Cpa) if (RegCheckErr(Buf, RoutineName)) return - ! dpa call RegUnpack(Buf, OutData%dpa) if (RegCheckErr(Buf, RoutineName)) return - ! FdrN call RegUnpack(Buf, OutData%FdrN) if (RegCheckErr(Buf, RoutineName)) return - ! Mice call RegUnpack(Buf, OutData%Mice) if (RegCheckErr(Buf, RoutineName)) return - ! Fsp call RegUnpack(Buf, OutData%Fsp) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE IceD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceD_InputType), INTENT(INOUT) :: SrcInputData - TYPE(IceD_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_CopyInput' -! + +subroutine IceD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(IceD_InputType), intent(inout) :: SrcInputData + type(IceD_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceD_CopyInput' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcInputData%PointMesh, DstInputData%PointMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE IceD_CopyInput - - SUBROUTINE IceD_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(IceD_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL MeshDestroy( InputData%PointMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE IceD_DestroyInput + ErrMsg = '' + call MeshCopy(SrcInputData%PointMesh, DstInputData%PointMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine IceD_DestroyInput(InputData, ErrStat, ErrMsg) + type(IceD_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceD_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine IceD_PackInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(IceD_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'IceD_PackInput' if (Buf%ErrStat >= AbortErrLev) return - ! PointMesh call MeshPack(Buf, InData%PointMesh) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2295,71 +1949,61 @@ subroutine IceD_UnPackInput(Buf, OutData) type(IceD_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceD_UnPackInput' if (Buf%ErrStat /= ErrID_None) return - ! PointMesh call MeshUnpack(Buf, OutData%PointMesh) ! PointMesh end subroutine - SUBROUTINE IceD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceD_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(IceD_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_CopyOutput' -! + +subroutine IceD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(IceD_OutputType), intent(inout) :: SrcOutputData + type(IceD_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceD_CopyOutput' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcOutputData%PointMesh, DstOutputData%PointMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcOutputData%WriteOutput)) THEN - i1_l = LBOUND(SrcOutputData%WriteOutput,1) - i1_u = UBOUND(SrcOutputData%WriteOutput,1) - IF (.NOT. ALLOCATED(DstOutputData%WriteOutput)) THEN - ALLOCATE(DstOutputData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%WriteOutput = SrcOutputData%WriteOutput -ENDIF - END SUBROUTINE IceD_CopyOutput - - SUBROUTINE IceD_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(IceD_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL MeshDestroy( OutputData%PointMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - END SUBROUTINE IceD_DestroyOutput + ErrMsg = '' + call MeshCopy(SrcOutputData%PointMesh, DstOutputData%PointMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%WriteOutput = SrcOutputData%WriteOutput + else if (allocated(DstOutputData%WriteOutput)) then + deallocate(DstOutputData%WriteOutput) + end if +end subroutine +subroutine IceD_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(IceD_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceD_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine subroutine IceD_PackOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(IceD_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'IceD_PackOutput' if (Buf%ErrStat >= AbortErrLev) return - ! PointMesh call MeshPack(Buf, InData%PointMesh) if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutput call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) @@ -2376,9 +2020,7 @@ subroutine IceD_UnPackOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! PointMesh call MeshUnpack(Buf, OutData%PointMesh) ! PointMesh - ! WriteOutput if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/icefloe/src/icefloe/IceFloe_Types.f90 b/modules/icefloe/src/icefloe/IceFloe_Types.f90 index e128b7eb43..50ec328472 100644 --- a/modules/icefloe/src/icefloe/IceFloe_Types.f90 +++ b/modules/icefloe/src/icefloe/IceFloe_Types.f90 @@ -109,61 +109,45 @@ MODULE IceFloe_Types END TYPE IceFloe_OutputType ! ======================= CONTAINS - SUBROUTINE IceFloe_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceFloe_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(IceFloe_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_CopyInitInput' -! + +subroutine IceFloe_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(IceFloe_InitInputType), intent(in) :: SrcInitInputData + type(IceFloe_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceFloe_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFile = SrcInitInputData%InputFile - DstInitInputData%simLength = SrcInitInputData%simLength - DstInitInputData%MSL2SWL = SrcInitInputData%MSL2SWL - DstInitInputData%gravity = SrcInitInputData%gravity - DstInitInputData%RootName = SrcInitInputData%RootName - END SUBROUTINE IceFloe_CopyInitInput - - SUBROUTINE IceFloe_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(IceFloe_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE IceFloe_DestroyInitInput + ErrMsg = '' + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%simLength = SrcInitInputData%simLength + DstInitInputData%MSL2SWL = SrcInitInputData%MSL2SWL + DstInitInputData%gravity = SrcInitInputData%gravity + DstInitInputData%RootName = SrcInitInputData%RootName +end subroutine +subroutine IceFloe_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(IceFloe_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceFloe_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine IceFloe_PackInitInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(IceFloe_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'IceFloe_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return - ! InputFile call RegPack(Buf, InData%InputFile) if (RegCheckErr(Buf, RoutineName)) return - ! simLength call RegPack(Buf, InData%simLength) if (RegCheckErr(Buf, RoutineName)) return - ! MSL2SWL call RegPack(Buf, InData%MSL2SWL) if (RegCheckErr(Buf, RoutineName)) return - ! gravity call RegPack(Buf, InData%gravity) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegPack(Buf, InData%RootName) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -173,110 +157,97 @@ subroutine IceFloe_UnPackInitInput(Buf, OutData) type(IceFloe_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceFloe_UnPackInitInput' if (Buf%ErrStat /= ErrID_None) return - ! InputFile call RegUnpack(Buf, OutData%InputFile) if (RegCheckErr(Buf, RoutineName)) return - ! simLength call RegUnpack(Buf, OutData%simLength) if (RegCheckErr(Buf, RoutineName)) return - ! MSL2SWL call RegUnpack(Buf, OutData%MSL2SWL) if (RegCheckErr(Buf, RoutineName)) return - ! gravity call RegUnpack(Buf, OutData%gravity) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegUnpack(Buf, OutData%RootName) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE IceFloe_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceFloe_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(IceFloe_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_CopyInitOutput' -! + +subroutine IceFloe_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(IceFloe_InitOutputType), intent(in) :: SrcInitOutputData + type(IceFloe_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceFloe_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInitOutputData%WriteOutputHdr)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputHdr,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputHdr,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputHdr)) THEN - ALLOCATE(DstInitOutputData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr -ENDIF -IF (ALLOCATED(SrcInitOutputData%WriteOutputUnt)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputUnt,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputUnt,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputUnt)) THEN - ALLOCATE(DstInitOutputData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt -ENDIF - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE IceFloe_CopyInitOutput - - SUBROUTINE IceFloe_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(IceFloe_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF - CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE IceFloe_DestroyInitOutput + ErrMsg = '' + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr + else if (allocated(DstInitOutputData%WriteOutputHdr)) then + deallocate(DstInitOutputData%WriteOutputHdr) + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt + else if (allocated(DstInitOutputData%WriteOutputUnt)) then + deallocate(DstInitOutputData%WriteOutputUnt) + end if + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine IceFloe_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(IceFloe_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceFloe_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if +end subroutine subroutine IceFloe_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(IceFloe_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'IceFloe_PackInitOutput' if (Buf%ErrStat >= AbortErrLev) return - ! WriteOutputHdr call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) call RegPack(Buf, InData%WriteOutputHdr) end if if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutputUnt call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) call RegPack(Buf, InData%WriteOutputUnt) end if if (RegCheckErr(Buf, RoutineName)) return - ! Ver call NWTC_Library_PackProgDesc(Buf, InData%Ver) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -289,7 +260,6 @@ subroutine IceFloe_UnPackInitOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! WriteOutputHdr if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -304,7 +274,6 @@ subroutine IceFloe_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutputHdr) if (RegCheckErr(Buf, RoutineName)) return end if - ! WriteOutputUnt if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -319,48 +288,35 @@ subroutine IceFloe_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutputUnt) if (RegCheckErr(Buf, RoutineName)) return end if - ! Ver call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver end subroutine - SUBROUTINE IceFloe_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceFloe_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(IceFloe_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%DummyContStateVar = SrcContStateData%DummyContStateVar - END SUBROUTINE IceFloe_CopyContState - SUBROUTINE IceFloe_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(IceFloe_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE IceFloe_DestroyContState +subroutine IceFloe_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(IceFloe_ContinuousStateType), intent(in) :: SrcContStateData + type(IceFloe_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceFloe_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + DstContStateData%DummyContStateVar = SrcContStateData%DummyContStateVar +end subroutine +subroutine IceFloe_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(IceFloe_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceFloe_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine IceFloe_PackContState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(IceFloe_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'IceFloe_PackContState' if (Buf%ErrStat >= AbortErrLev) return - ! DummyContStateVar call RegPack(Buf, InData%DummyContStateVar) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -370,49 +326,36 @@ subroutine IceFloe_UnPackContState(Buf, OutData) type(IceFloe_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceFloe_UnPackContState' if (Buf%ErrStat /= ErrID_None) return - ! DummyContStateVar call RegUnpack(Buf, OutData%DummyContStateVar) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE IceFloe_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceFloe_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(IceFloe_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyDiscStateVar = SrcDiscStateData%DummyDiscStateVar - END SUBROUTINE IceFloe_CopyDiscState - - SUBROUTINE IceFloe_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(IceFloe_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE IceFloe_DestroyDiscState +subroutine IceFloe_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(IceFloe_DiscreteStateType), intent(in) :: SrcDiscStateData + type(IceFloe_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceFloe_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + DstDiscStateData%DummyDiscStateVar = SrcDiscStateData%DummyDiscStateVar +end subroutine +subroutine IceFloe_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(IceFloe_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceFloe_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine IceFloe_PackDiscState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(IceFloe_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'IceFloe_PackDiscState' if (Buf%ErrStat >= AbortErrLev) return - ! DummyDiscStateVar call RegPack(Buf, InData%DummyDiscStateVar) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -422,49 +365,36 @@ subroutine IceFloe_UnPackDiscState(Buf, OutData) type(IceFloe_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceFloe_UnPackDiscState' if (Buf%ErrStat /= ErrID_None) return - ! DummyDiscStateVar call RegUnpack(Buf, OutData%DummyDiscStateVar) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE IceFloe_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceFloe_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(IceFloe_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrStateVar = SrcConstrStateData%DummyConstrStateVar - END SUBROUTINE IceFloe_CopyConstrState - SUBROUTINE IceFloe_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(IceFloe_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE IceFloe_DestroyConstrState +subroutine IceFloe_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(IceFloe_ConstraintStateType), intent(in) :: SrcConstrStateData + type(IceFloe_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceFloe_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%DummyConstrStateVar = SrcConstrStateData%DummyConstrStateVar +end subroutine +subroutine IceFloe_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(IceFloe_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceFloe_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine IceFloe_PackConstrState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(IceFloe_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'IceFloe_PackConstrState' if (Buf%ErrStat >= AbortErrLev) return - ! DummyConstrStateVar call RegPack(Buf, InData%DummyConstrStateVar) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -474,49 +404,36 @@ subroutine IceFloe_UnPackConstrState(Buf, OutData) type(IceFloe_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceFloe_UnPackConstrState' if (Buf%ErrStat /= ErrID_None) return - ! DummyConstrStateVar call RegUnpack(Buf, OutData%DummyConstrStateVar) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE IceFloe_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceFloe_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(IceFloe_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState - END SUBROUTINE IceFloe_CopyOtherState - - SUBROUTINE IceFloe_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(IceFloe_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE IceFloe_DestroyOtherState +subroutine IceFloe_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(IceFloe_OtherStateType), intent(in) :: SrcOtherStateData + type(IceFloe_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceFloe_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState +end subroutine +subroutine IceFloe_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(IceFloe_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceFloe_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine IceFloe_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(IceFloe_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'IceFloe_PackOtherState' if (Buf%ErrStat >= AbortErrLev) return - ! DummyOtherState call RegPack(Buf, InData%DummyOtherState) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -526,49 +443,36 @@ subroutine IceFloe_UnPackOtherState(Buf, OutData) type(IceFloe_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceFloe_UnPackOtherState' if (Buf%ErrStat /= ErrID_None) return - ! DummyOtherState call RegUnpack(Buf, OutData%DummyOtherState) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE IceFloe_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceFloe_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(IceFloe_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar - END SUBROUTINE IceFloe_CopyMisc - SUBROUTINE IceFloe_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(IceFloe_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE IceFloe_DestroyMisc +subroutine IceFloe_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(IceFloe_MiscVarType), intent(in) :: SrcMiscData + type(IceFloe_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceFloe_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar +end subroutine +subroutine IceFloe_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(IceFloe_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceFloe_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine IceFloe_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(IceFloe_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'IceFloe_PackMisc' if (Buf%ErrStat >= AbortErrLev) return - ! DummyMiscVar call RegPack(Buf, InData%DummyMiscVar) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -578,197 +482,172 @@ subroutine IceFloe_UnPackMisc(Buf, OutData) type(IceFloe_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceFloe_UnPackMisc' if (Buf%ErrStat /= ErrID_None) return - ! DummyMiscVar call RegUnpack(Buf, OutData%DummyMiscVar) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE IceFloe_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceFloe_ParameterType), INTENT(IN) :: SrcParamData - TYPE(IceFloe_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_CopyParam' -! + +subroutine IceFloe_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(IceFloe_ParameterType), intent(in) :: SrcParamData + type(IceFloe_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'IceFloe_CopyParam' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcParamData%loadSeries)) THEN - i1_l = LBOUND(SrcParamData%loadSeries,1) - i1_u = UBOUND(SrcParamData%loadSeries,1) - i2_l = LBOUND(SrcParamData%loadSeries,2) - i2_u = UBOUND(SrcParamData%loadSeries,2) - IF (.NOT. ALLOCATED(DstParamData%loadSeries)) THEN - ALLOCATE(DstParamData%loadSeries(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%loadSeries.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%loadSeries = SrcParamData%loadSeries -ENDIF - DstParamData%iceVel = SrcParamData%iceVel - DstParamData%iceDirection = SrcParamData%iceDirection - DstParamData%minStrength = SrcParamData%minStrength - DstParamData%minStrengthNegVel = SrcParamData%minStrengthNegVel - DstParamData%defaultArea = SrcParamData%defaultArea - DstParamData%crushArea = SrcParamData%crushArea - DstParamData%coeffStressRate = SrcParamData%coeffStressRate - DstParamData%C(4) = SrcParamData%C(4) - DstParamData%dt = SrcParamData%dt - DstParamData%rampTime = SrcParamData%rampTime -IF (ALLOCATED(SrcParamData%legX)) THEN - i1_l = LBOUND(SrcParamData%legX,1) - i1_u = UBOUND(SrcParamData%legX,1) - IF (.NOT. ALLOCATED(DstParamData%legX)) THEN - ALLOCATE(DstParamData%legX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%legX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%legX = SrcParamData%legX -ENDIF -IF (ALLOCATED(SrcParamData%legY)) THEN - i1_l = LBOUND(SrcParamData%legY,1) - i1_u = UBOUND(SrcParamData%legY,1) - IF (.NOT. ALLOCATED(DstParamData%legY)) THEN - ALLOCATE(DstParamData%legY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%legY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%legY = SrcParamData%legY -ENDIF -IF (ALLOCATED(SrcParamData%ks)) THEN - i1_l = LBOUND(SrcParamData%ks,1) - i1_u = UBOUND(SrcParamData%ks,1) - IF (.NOT. ALLOCATED(DstParamData%ks)) THEN - ALLOCATE(DstParamData%ks(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ks.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ks = SrcParamData%ks -ENDIF - DstParamData%numLegs = SrcParamData%numLegs - DstParamData%iceType = SrcParamData%iceType - DstParamData%logUnitNum = SrcParamData%logUnitNum - DstParamData%singleLoad = SrcParamData%singleLoad - DstParamData%initFlag = SrcParamData%initFlag - END SUBROUTINE IceFloe_CopyParam - - SUBROUTINE IceFloe_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(IceFloe_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%loadSeries)) THEN - DEALLOCATE(ParamData%loadSeries) -ENDIF -IF (ALLOCATED(ParamData%legX)) THEN - DEALLOCATE(ParamData%legX) -ENDIF -IF (ALLOCATED(ParamData%legY)) THEN - DEALLOCATE(ParamData%legY) -ENDIF -IF (ALLOCATED(ParamData%ks)) THEN - DEALLOCATE(ParamData%ks) -ENDIF - END SUBROUTINE IceFloe_DestroyParam + ErrMsg = '' + if (allocated(SrcParamData%loadSeries)) then + LB(1:2) = lbound(SrcParamData%loadSeries) + UB(1:2) = ubound(SrcParamData%loadSeries) + if (.not. allocated(DstParamData%loadSeries)) then + allocate(DstParamData%loadSeries(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%loadSeries.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%loadSeries = SrcParamData%loadSeries + else if (allocated(DstParamData%loadSeries)) then + deallocate(DstParamData%loadSeries) + end if + DstParamData%iceVel = SrcParamData%iceVel + DstParamData%iceDirection = SrcParamData%iceDirection + DstParamData%minStrength = SrcParamData%minStrength + DstParamData%minStrengthNegVel = SrcParamData%minStrengthNegVel + DstParamData%defaultArea = SrcParamData%defaultArea + DstParamData%crushArea = SrcParamData%crushArea + DstParamData%coeffStressRate = SrcParamData%coeffStressRate + DstParamData%C(4) = SrcParamData%C(4) + DstParamData%dt = SrcParamData%dt + DstParamData%rampTime = SrcParamData%rampTime + if (allocated(SrcParamData%legX)) then + LB(1:1) = lbound(SrcParamData%legX) + UB(1:1) = ubound(SrcParamData%legX) + if (.not. allocated(DstParamData%legX)) then + allocate(DstParamData%legX(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%legX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%legX = SrcParamData%legX + else if (allocated(DstParamData%legX)) then + deallocate(DstParamData%legX) + end if + if (allocated(SrcParamData%legY)) then + LB(1:1) = lbound(SrcParamData%legY) + UB(1:1) = ubound(SrcParamData%legY) + if (.not. allocated(DstParamData%legY)) then + allocate(DstParamData%legY(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%legY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%legY = SrcParamData%legY + else if (allocated(DstParamData%legY)) then + deallocate(DstParamData%legY) + end if + if (allocated(SrcParamData%ks)) then + LB(1:1) = lbound(SrcParamData%ks) + UB(1:1) = ubound(SrcParamData%ks) + if (.not. allocated(DstParamData%ks)) then + allocate(DstParamData%ks(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ks.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%ks = SrcParamData%ks + else if (allocated(DstParamData%ks)) then + deallocate(DstParamData%ks) + end if + DstParamData%numLegs = SrcParamData%numLegs + DstParamData%iceType = SrcParamData%iceType + DstParamData%logUnitNum = SrcParamData%logUnitNum + DstParamData%singleLoad = SrcParamData%singleLoad + DstParamData%initFlag = SrcParamData%initFlag +end subroutine +subroutine IceFloe_DestroyParam(ParamData, ErrStat, ErrMsg) + type(IceFloe_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IceFloe_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%loadSeries)) then + deallocate(ParamData%loadSeries) + end if + if (allocated(ParamData%legX)) then + deallocate(ParamData%legX) + end if + if (allocated(ParamData%legY)) then + deallocate(ParamData%legY) + end if + if (allocated(ParamData%ks)) then + deallocate(ParamData%ks) + end if +end subroutine subroutine IceFloe_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(IceFloe_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'IceFloe_PackParam' if (Buf%ErrStat >= AbortErrLev) return - ! loadSeries call RegPack(Buf, allocated(InData%loadSeries)) if (allocated(InData%loadSeries)) then call RegPackBounds(Buf, 2, lbound(InData%loadSeries), ubound(InData%loadSeries)) call RegPack(Buf, InData%loadSeries) end if if (RegCheckErr(Buf, RoutineName)) return - ! iceVel call RegPack(Buf, InData%iceVel) if (RegCheckErr(Buf, RoutineName)) return - ! iceDirection call RegPack(Buf, InData%iceDirection) if (RegCheckErr(Buf, RoutineName)) return - ! minStrength call RegPack(Buf, InData%minStrength) if (RegCheckErr(Buf, RoutineName)) return - ! minStrengthNegVel call RegPack(Buf, InData%minStrengthNegVel) if (RegCheckErr(Buf, RoutineName)) return - ! defaultArea call RegPack(Buf, InData%defaultArea) if (RegCheckErr(Buf, RoutineName)) return - ! crushArea call RegPack(Buf, InData%crushArea) if (RegCheckErr(Buf, RoutineName)) return - ! coeffStressRate call RegPack(Buf, InData%coeffStressRate) if (RegCheckErr(Buf, RoutineName)) return - ! C(4) call RegPack(Buf, InData%C(4)) if (RegCheckErr(Buf, RoutineName)) return - ! dt call RegPack(Buf, InData%dt) if (RegCheckErr(Buf, RoutineName)) return - ! rampTime call RegPack(Buf, InData%rampTime) if (RegCheckErr(Buf, RoutineName)) return - ! legX call RegPack(Buf, allocated(InData%legX)) if (allocated(InData%legX)) then call RegPackBounds(Buf, 1, lbound(InData%legX), ubound(InData%legX)) call RegPack(Buf, InData%legX) end if if (RegCheckErr(Buf, RoutineName)) return - ! legY call RegPack(Buf, allocated(InData%legY)) if (allocated(InData%legY)) then call RegPackBounds(Buf, 1, lbound(InData%legY), ubound(InData%legY)) call RegPack(Buf, InData%legY) end if if (RegCheckErr(Buf, RoutineName)) return - ! ks call RegPack(Buf, allocated(InData%ks)) if (allocated(InData%ks)) then call RegPackBounds(Buf, 1, lbound(InData%ks), ubound(InData%ks)) call RegPack(Buf, InData%ks) end if if (RegCheckErr(Buf, RoutineName)) return - ! numLegs call RegPack(Buf, InData%numLegs) if (RegCheckErr(Buf, RoutineName)) return - ! iceType call RegPack(Buf, InData%iceType) if (RegCheckErr(Buf, RoutineName)) return - ! logUnitNum call RegPack(Buf, InData%logUnitNum) if (RegCheckErr(Buf, RoutineName)) return - ! singleLoad call RegPack(Buf, InData%singleLoad) if (RegCheckErr(Buf, RoutineName)) return - ! initFlag call RegPack(Buf, InData%initFlag) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -781,7 +660,6 @@ subroutine IceFloe_UnPackParam(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! loadSeries if (allocated(OutData%loadSeries)) deallocate(OutData%loadSeries) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -796,37 +674,26 @@ subroutine IceFloe_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%loadSeries) if (RegCheckErr(Buf, RoutineName)) return end if - ! iceVel call RegUnpack(Buf, OutData%iceVel) if (RegCheckErr(Buf, RoutineName)) return - ! iceDirection call RegUnpack(Buf, OutData%iceDirection) if (RegCheckErr(Buf, RoutineName)) return - ! minStrength call RegUnpack(Buf, OutData%minStrength) if (RegCheckErr(Buf, RoutineName)) return - ! minStrengthNegVel call RegUnpack(Buf, OutData%minStrengthNegVel) if (RegCheckErr(Buf, RoutineName)) return - ! defaultArea call RegUnpack(Buf, OutData%defaultArea) if (RegCheckErr(Buf, RoutineName)) return - ! crushArea call RegUnpack(Buf, OutData%crushArea) if (RegCheckErr(Buf, RoutineName)) return - ! coeffStressRate call RegUnpack(Buf, OutData%coeffStressRate) if (RegCheckErr(Buf, RoutineName)) return - ! C(4) call RegUnpack(Buf, OutData%C(4)) if (RegCheckErr(Buf, RoutineName)) return - ! dt call RegUnpack(Buf, OutData%dt) if (RegCheckErr(Buf, RoutineName)) return - ! rampTime call RegUnpack(Buf, OutData%rampTime) if (RegCheckErr(Buf, RoutineName)) return - ! legX if (allocated(OutData%legX)) deallocate(OutData%legX) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -841,7 +708,6 @@ subroutine IceFloe_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%legX) if (RegCheckErr(Buf, RoutineName)) return end if - ! legY if (allocated(OutData%legY)) deallocate(OutData%legY) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -856,7 +722,6 @@ subroutine IceFloe_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%legY) if (RegCheckErr(Buf, RoutineName)) return end if - ! ks if (allocated(OutData%ks)) deallocate(OutData%ks) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -871,65 +736,50 @@ subroutine IceFloe_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%ks) if (RegCheckErr(Buf, RoutineName)) return end if - ! numLegs call RegUnpack(Buf, OutData%numLegs) if (RegCheckErr(Buf, RoutineName)) return - ! iceType call RegUnpack(Buf, OutData%iceType) if (RegCheckErr(Buf, RoutineName)) return - ! logUnitNum call RegUnpack(Buf, OutData%logUnitNum) if (RegCheckErr(Buf, RoutineName)) return - ! singleLoad call RegUnpack(Buf, OutData%singleLoad) if (RegCheckErr(Buf, RoutineName)) return - ! initFlag call RegUnpack(Buf, OutData%initFlag) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE IceFloe_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceFloe_InputType), INTENT(INOUT) :: SrcInputData - TYPE(IceFloe_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_CopyInput' -! + +subroutine IceFloe_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(IceFloe_InputType), intent(inout) :: SrcInputData + type(IceFloe_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceFloe_CopyInput' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcInputData%iceMesh, DstInputData%iceMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE IceFloe_CopyInput - - SUBROUTINE IceFloe_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(IceFloe_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL MeshDestroy( InputData%iceMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE IceFloe_DestroyInput + ErrMsg = '' + call MeshCopy(SrcInputData%iceMesh, DstInputData%iceMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine IceFloe_DestroyInput(InputData, ErrStat, ErrMsg) + type(IceFloe_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceFloe_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine IceFloe_PackInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(IceFloe_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'IceFloe_PackInput' if (Buf%ErrStat >= AbortErrLev) return - ! iceMesh call MeshPack(Buf, InData%iceMesh) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -939,71 +789,61 @@ subroutine IceFloe_UnPackInput(Buf, OutData) type(IceFloe_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceFloe_UnPackInput' if (Buf%ErrStat /= ErrID_None) return - ! iceMesh call MeshUnpack(Buf, OutData%iceMesh) ! iceMesh end subroutine - SUBROUTINE IceFloe_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceFloe_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(IceFloe_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_CopyOutput' -! + +subroutine IceFloe_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(IceFloe_OutputType), intent(inout) :: SrcOutputData + type(IceFloe_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceFloe_CopyOutput' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcOutputData%iceMesh, DstOutputData%iceMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcOutputData%WriteOutput)) THEN - i1_l = LBOUND(SrcOutputData%WriteOutput,1) - i1_u = UBOUND(SrcOutputData%WriteOutput,1) - IF (.NOT. ALLOCATED(DstOutputData%WriteOutput)) THEN - ALLOCATE(DstOutputData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%WriteOutput = SrcOutputData%WriteOutput -ENDIF - END SUBROUTINE IceFloe_CopyOutput - - SUBROUTINE IceFloe_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(IceFloe_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL MeshDestroy( OutputData%iceMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - END SUBROUTINE IceFloe_DestroyOutput + ErrMsg = '' + call MeshCopy(SrcOutputData%iceMesh, DstOutputData%iceMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%WriteOutput = SrcOutputData%WriteOutput + else if (allocated(DstOutputData%WriteOutput)) then + deallocate(DstOutputData%WriteOutput) + end if +end subroutine +subroutine IceFloe_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(IceFloe_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IceFloe_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine subroutine IceFloe_PackOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(IceFloe_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'IceFloe_PackOutput' if (Buf%ErrStat >= AbortErrLev) return - ! iceMesh call MeshPack(Buf, InData%iceMesh) if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutput call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) @@ -1020,9 +860,7 @@ subroutine IceFloe_UnPackOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! iceMesh call MeshUnpack(Buf, OutData%iceMesh) ! iceMesh - ! WriteOutput if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/inflowwind/src/IfW_FlowField_Types.f90 b/modules/inflowwind/src/IfW_FlowField_Types.f90 index 437c9e6280..87a34b2bbe 100644 --- a/modules/inflowwind/src/IfW_FlowField_Types.f90 +++ b/modules/inflowwind/src/IfW_FlowField_Types.f90 @@ -166,424 +166,428 @@ MODULE IfW_FlowField_Types END TYPE FlowFieldType ! ======================= CONTAINS - SUBROUTINE IfW_FlowField_CopyUniformFieldType( SrcUniformFieldTypeData, DstUniformFieldTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(UniformFieldType), INTENT(IN) :: SrcUniformFieldTypeData - TYPE(UniformFieldType), INTENT(INOUT) :: DstUniformFieldTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_CopyUniformFieldType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstUniformFieldTypeData%RefHeight = SrcUniformFieldTypeData%RefHeight - DstUniformFieldTypeData%RefLength = SrcUniformFieldTypeData%RefLength - DstUniformFieldTypeData%DataSize = SrcUniformFieldTypeData%DataSize -IF (ALLOCATED(SrcUniformFieldTypeData%Time)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%Time,1) - i1_u = UBOUND(SrcUniformFieldTypeData%Time,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%Time)) THEN - ALLOCATE(DstUniformFieldTypeData%Time(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%Time.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%Time = SrcUniformFieldTypeData%Time -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%VelH)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%VelH,1) - i1_u = UBOUND(SrcUniformFieldTypeData%VelH,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%VelH)) THEN - ALLOCATE(DstUniformFieldTypeData%VelH(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%VelH.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%VelH = SrcUniformFieldTypeData%VelH -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%VelHDot)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%VelHDot,1) - i1_u = UBOUND(SrcUniformFieldTypeData%VelHDot,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%VelHDot)) THEN - ALLOCATE(DstUniformFieldTypeData%VelHDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%VelHDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%VelHDot = SrcUniformFieldTypeData%VelHDot -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%VelV)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%VelV,1) - i1_u = UBOUND(SrcUniformFieldTypeData%VelV,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%VelV)) THEN - ALLOCATE(DstUniformFieldTypeData%VelV(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%VelV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%VelV = SrcUniformFieldTypeData%VelV -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%VelVDot)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%VelVDot,1) - i1_u = UBOUND(SrcUniformFieldTypeData%VelVDot,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%VelVDot)) THEN - ALLOCATE(DstUniformFieldTypeData%VelVDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%VelVDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%VelVDot = SrcUniformFieldTypeData%VelVDot -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%VelGust)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%VelGust,1) - i1_u = UBOUND(SrcUniformFieldTypeData%VelGust,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%VelGust)) THEN - ALLOCATE(DstUniformFieldTypeData%VelGust(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%VelGust.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%VelGust = SrcUniformFieldTypeData%VelGust -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%VelGustDot)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%VelGustDot,1) - i1_u = UBOUND(SrcUniformFieldTypeData%VelGustDot,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%VelGustDot)) THEN - ALLOCATE(DstUniformFieldTypeData%VelGustDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%VelGustDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%VelGustDot = SrcUniformFieldTypeData%VelGustDot -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%AngleH)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%AngleH,1) - i1_u = UBOUND(SrcUniformFieldTypeData%AngleH,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%AngleH)) THEN - ALLOCATE(DstUniformFieldTypeData%AngleH(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%AngleH.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%AngleH = SrcUniformFieldTypeData%AngleH -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%AngleHDot)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%AngleHDot,1) - i1_u = UBOUND(SrcUniformFieldTypeData%AngleHDot,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%AngleHDot)) THEN - ALLOCATE(DstUniformFieldTypeData%AngleHDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%AngleHDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%AngleHDot = SrcUniformFieldTypeData%AngleHDot -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%AngleV)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%AngleV,1) - i1_u = UBOUND(SrcUniformFieldTypeData%AngleV,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%AngleV)) THEN - ALLOCATE(DstUniformFieldTypeData%AngleV(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%AngleV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%AngleV = SrcUniformFieldTypeData%AngleV -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%AngleVDot)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%AngleVDot,1) - i1_u = UBOUND(SrcUniformFieldTypeData%AngleVDot,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%AngleVDot)) THEN - ALLOCATE(DstUniformFieldTypeData%AngleVDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%AngleVDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%AngleVDot = SrcUniformFieldTypeData%AngleVDot -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%ShrH)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%ShrH,1) - i1_u = UBOUND(SrcUniformFieldTypeData%ShrH,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%ShrH)) THEN - ALLOCATE(DstUniformFieldTypeData%ShrH(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%ShrH.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%ShrH = SrcUniformFieldTypeData%ShrH -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%ShrHDot)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%ShrHDot,1) - i1_u = UBOUND(SrcUniformFieldTypeData%ShrHDot,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%ShrHDot)) THEN - ALLOCATE(DstUniformFieldTypeData%ShrHDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%ShrHDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%ShrHDot = SrcUniformFieldTypeData%ShrHDot -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%ShrV)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%ShrV,1) - i1_u = UBOUND(SrcUniformFieldTypeData%ShrV,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%ShrV)) THEN - ALLOCATE(DstUniformFieldTypeData%ShrV(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%ShrV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%ShrV = SrcUniformFieldTypeData%ShrV -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%ShrVDot)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%ShrVDot,1) - i1_u = UBOUND(SrcUniformFieldTypeData%ShrVDot,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%ShrVDot)) THEN - ALLOCATE(DstUniformFieldTypeData%ShrVDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%ShrVDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%ShrVDot = SrcUniformFieldTypeData%ShrVDot -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%LinShrV)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%LinShrV,1) - i1_u = UBOUND(SrcUniformFieldTypeData%LinShrV,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%LinShrV)) THEN - ALLOCATE(DstUniformFieldTypeData%LinShrV(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%LinShrV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%LinShrV = SrcUniformFieldTypeData%LinShrV -ENDIF -IF (ALLOCATED(SrcUniformFieldTypeData%LinShrVDot)) THEN - i1_l = LBOUND(SrcUniformFieldTypeData%LinShrVDot,1) - i1_u = UBOUND(SrcUniformFieldTypeData%LinShrVDot,1) - IF (.NOT. ALLOCATED(DstUniformFieldTypeData%LinShrVDot)) THEN - ALLOCATE(DstUniformFieldTypeData%LinShrVDot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%LinShrVDot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstUniformFieldTypeData%LinShrVDot = SrcUniformFieldTypeData%LinShrVDot -ENDIF - END SUBROUTINE IfW_FlowField_CopyUniformFieldType - - SUBROUTINE IfW_FlowField_DestroyUniformFieldType( UniformFieldTypeData, ErrStat, ErrMsg ) - TYPE(UniformFieldType), INTENT(INOUT) :: UniformFieldTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_DestroyUniformFieldType' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(UniformFieldTypeData%Time)) THEN - DEALLOCATE(UniformFieldTypeData%Time) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%VelH)) THEN - DEALLOCATE(UniformFieldTypeData%VelH) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%VelHDot)) THEN - DEALLOCATE(UniformFieldTypeData%VelHDot) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%VelV)) THEN - DEALLOCATE(UniformFieldTypeData%VelV) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%VelVDot)) THEN - DEALLOCATE(UniformFieldTypeData%VelVDot) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%VelGust)) THEN - DEALLOCATE(UniformFieldTypeData%VelGust) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%VelGustDot)) THEN - DEALLOCATE(UniformFieldTypeData%VelGustDot) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%AngleH)) THEN - DEALLOCATE(UniformFieldTypeData%AngleH) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%AngleHDot)) THEN - DEALLOCATE(UniformFieldTypeData%AngleHDot) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%AngleV)) THEN - DEALLOCATE(UniformFieldTypeData%AngleV) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%AngleVDot)) THEN - DEALLOCATE(UniformFieldTypeData%AngleVDot) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%ShrH)) THEN - DEALLOCATE(UniformFieldTypeData%ShrH) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%ShrHDot)) THEN - DEALLOCATE(UniformFieldTypeData%ShrHDot) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%ShrV)) THEN - DEALLOCATE(UniformFieldTypeData%ShrV) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%ShrVDot)) THEN - DEALLOCATE(UniformFieldTypeData%ShrVDot) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%LinShrV)) THEN - DEALLOCATE(UniformFieldTypeData%LinShrV) -ENDIF -IF (ALLOCATED(UniformFieldTypeData%LinShrVDot)) THEN - DEALLOCATE(UniformFieldTypeData%LinShrVDot) -ENDIF - END SUBROUTINE IfW_FlowField_DestroyUniformFieldType +subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUniformFieldTypeData, CtrlCode, ErrStat, ErrMsg) + type(UniformFieldType), intent(in) :: SrcUniformFieldTypeData + type(UniformFieldType), intent(inout) :: DstUniformFieldTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'IfW_FlowField_CopyUniformFieldType' + ErrStat = ErrID_None + ErrMsg = '' + DstUniformFieldTypeData%RefHeight = SrcUniformFieldTypeData%RefHeight + DstUniformFieldTypeData%RefLength = SrcUniformFieldTypeData%RefLength + DstUniformFieldTypeData%DataSize = SrcUniformFieldTypeData%DataSize + if (allocated(SrcUniformFieldTypeData%Time)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%Time) + UB(1:1) = ubound(SrcUniformFieldTypeData%Time) + if (.not. allocated(DstUniformFieldTypeData%Time)) then + allocate(DstUniformFieldTypeData%Time(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%Time.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%Time = SrcUniformFieldTypeData%Time + else if (allocated(DstUniformFieldTypeData%Time)) then + deallocate(DstUniformFieldTypeData%Time) + end if + if (allocated(SrcUniformFieldTypeData%VelH)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%VelH) + UB(1:1) = ubound(SrcUniformFieldTypeData%VelH) + if (.not. allocated(DstUniformFieldTypeData%VelH)) then + allocate(DstUniformFieldTypeData%VelH(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%VelH.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%VelH = SrcUniformFieldTypeData%VelH + else if (allocated(DstUniformFieldTypeData%VelH)) then + deallocate(DstUniformFieldTypeData%VelH) + end if + if (allocated(SrcUniformFieldTypeData%VelHDot)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%VelHDot) + UB(1:1) = ubound(SrcUniformFieldTypeData%VelHDot) + if (.not. allocated(DstUniformFieldTypeData%VelHDot)) then + allocate(DstUniformFieldTypeData%VelHDot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%VelHDot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%VelHDot = SrcUniformFieldTypeData%VelHDot + else if (allocated(DstUniformFieldTypeData%VelHDot)) then + deallocate(DstUniformFieldTypeData%VelHDot) + end if + if (allocated(SrcUniformFieldTypeData%VelV)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%VelV) + UB(1:1) = ubound(SrcUniformFieldTypeData%VelV) + if (.not. allocated(DstUniformFieldTypeData%VelV)) then + allocate(DstUniformFieldTypeData%VelV(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%VelV.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%VelV = SrcUniformFieldTypeData%VelV + else if (allocated(DstUniformFieldTypeData%VelV)) then + deallocate(DstUniformFieldTypeData%VelV) + end if + if (allocated(SrcUniformFieldTypeData%VelVDot)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%VelVDot) + UB(1:1) = ubound(SrcUniformFieldTypeData%VelVDot) + if (.not. allocated(DstUniformFieldTypeData%VelVDot)) then + allocate(DstUniformFieldTypeData%VelVDot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%VelVDot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%VelVDot = SrcUniformFieldTypeData%VelVDot + else if (allocated(DstUniformFieldTypeData%VelVDot)) then + deallocate(DstUniformFieldTypeData%VelVDot) + end if + if (allocated(SrcUniformFieldTypeData%VelGust)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%VelGust) + UB(1:1) = ubound(SrcUniformFieldTypeData%VelGust) + if (.not. allocated(DstUniformFieldTypeData%VelGust)) then + allocate(DstUniformFieldTypeData%VelGust(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%VelGust.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%VelGust = SrcUniformFieldTypeData%VelGust + else if (allocated(DstUniformFieldTypeData%VelGust)) then + deallocate(DstUniformFieldTypeData%VelGust) + end if + if (allocated(SrcUniformFieldTypeData%VelGustDot)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%VelGustDot) + UB(1:1) = ubound(SrcUniformFieldTypeData%VelGustDot) + if (.not. allocated(DstUniformFieldTypeData%VelGustDot)) then + allocate(DstUniformFieldTypeData%VelGustDot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%VelGustDot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%VelGustDot = SrcUniformFieldTypeData%VelGustDot + else if (allocated(DstUniformFieldTypeData%VelGustDot)) then + deallocate(DstUniformFieldTypeData%VelGustDot) + end if + if (allocated(SrcUniformFieldTypeData%AngleH)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%AngleH) + UB(1:1) = ubound(SrcUniformFieldTypeData%AngleH) + if (.not. allocated(DstUniformFieldTypeData%AngleH)) then + allocate(DstUniformFieldTypeData%AngleH(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%AngleH.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%AngleH = SrcUniformFieldTypeData%AngleH + else if (allocated(DstUniformFieldTypeData%AngleH)) then + deallocate(DstUniformFieldTypeData%AngleH) + end if + if (allocated(SrcUniformFieldTypeData%AngleHDot)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%AngleHDot) + UB(1:1) = ubound(SrcUniformFieldTypeData%AngleHDot) + if (.not. allocated(DstUniformFieldTypeData%AngleHDot)) then + allocate(DstUniformFieldTypeData%AngleHDot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%AngleHDot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%AngleHDot = SrcUniformFieldTypeData%AngleHDot + else if (allocated(DstUniformFieldTypeData%AngleHDot)) then + deallocate(DstUniformFieldTypeData%AngleHDot) + end if + if (allocated(SrcUniformFieldTypeData%AngleV)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%AngleV) + UB(1:1) = ubound(SrcUniformFieldTypeData%AngleV) + if (.not. allocated(DstUniformFieldTypeData%AngleV)) then + allocate(DstUniformFieldTypeData%AngleV(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%AngleV.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%AngleV = SrcUniformFieldTypeData%AngleV + else if (allocated(DstUniformFieldTypeData%AngleV)) then + deallocate(DstUniformFieldTypeData%AngleV) + end if + if (allocated(SrcUniformFieldTypeData%AngleVDot)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%AngleVDot) + UB(1:1) = ubound(SrcUniformFieldTypeData%AngleVDot) + if (.not. allocated(DstUniformFieldTypeData%AngleVDot)) then + allocate(DstUniformFieldTypeData%AngleVDot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%AngleVDot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%AngleVDot = SrcUniformFieldTypeData%AngleVDot + else if (allocated(DstUniformFieldTypeData%AngleVDot)) then + deallocate(DstUniformFieldTypeData%AngleVDot) + end if + if (allocated(SrcUniformFieldTypeData%ShrH)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%ShrH) + UB(1:1) = ubound(SrcUniformFieldTypeData%ShrH) + if (.not. allocated(DstUniformFieldTypeData%ShrH)) then + allocate(DstUniformFieldTypeData%ShrH(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%ShrH.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%ShrH = SrcUniformFieldTypeData%ShrH + else if (allocated(DstUniformFieldTypeData%ShrH)) then + deallocate(DstUniformFieldTypeData%ShrH) + end if + if (allocated(SrcUniformFieldTypeData%ShrHDot)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%ShrHDot) + UB(1:1) = ubound(SrcUniformFieldTypeData%ShrHDot) + if (.not. allocated(DstUniformFieldTypeData%ShrHDot)) then + allocate(DstUniformFieldTypeData%ShrHDot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%ShrHDot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%ShrHDot = SrcUniformFieldTypeData%ShrHDot + else if (allocated(DstUniformFieldTypeData%ShrHDot)) then + deallocate(DstUniformFieldTypeData%ShrHDot) + end if + if (allocated(SrcUniformFieldTypeData%ShrV)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%ShrV) + UB(1:1) = ubound(SrcUniformFieldTypeData%ShrV) + if (.not. allocated(DstUniformFieldTypeData%ShrV)) then + allocate(DstUniformFieldTypeData%ShrV(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%ShrV.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%ShrV = SrcUniformFieldTypeData%ShrV + else if (allocated(DstUniformFieldTypeData%ShrV)) then + deallocate(DstUniformFieldTypeData%ShrV) + end if + if (allocated(SrcUniformFieldTypeData%ShrVDot)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%ShrVDot) + UB(1:1) = ubound(SrcUniformFieldTypeData%ShrVDot) + if (.not. allocated(DstUniformFieldTypeData%ShrVDot)) then + allocate(DstUniformFieldTypeData%ShrVDot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%ShrVDot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%ShrVDot = SrcUniformFieldTypeData%ShrVDot + else if (allocated(DstUniformFieldTypeData%ShrVDot)) then + deallocate(DstUniformFieldTypeData%ShrVDot) + end if + if (allocated(SrcUniformFieldTypeData%LinShrV)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%LinShrV) + UB(1:1) = ubound(SrcUniformFieldTypeData%LinShrV) + if (.not. allocated(DstUniformFieldTypeData%LinShrV)) then + allocate(DstUniformFieldTypeData%LinShrV(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%LinShrV.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%LinShrV = SrcUniformFieldTypeData%LinShrV + else if (allocated(DstUniformFieldTypeData%LinShrV)) then + deallocate(DstUniformFieldTypeData%LinShrV) + end if + if (allocated(SrcUniformFieldTypeData%LinShrVDot)) then + LB(1:1) = lbound(SrcUniformFieldTypeData%LinShrVDot) + UB(1:1) = ubound(SrcUniformFieldTypeData%LinShrVDot) + if (.not. allocated(DstUniformFieldTypeData%LinShrVDot)) then + allocate(DstUniformFieldTypeData%LinShrVDot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstUniformFieldTypeData%LinShrVDot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstUniformFieldTypeData%LinShrVDot = SrcUniformFieldTypeData%LinShrVDot + else if (allocated(DstUniformFieldTypeData%LinShrVDot)) then + deallocate(DstUniformFieldTypeData%LinShrVDot) + end if +end subroutine +subroutine IfW_FlowField_DestroyUniformFieldType(UniformFieldTypeData, ErrStat, ErrMsg) + type(UniformFieldType), intent(inout) :: UniformFieldTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IfW_FlowField_DestroyUniformFieldType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(UniformFieldTypeData%Time)) then + deallocate(UniformFieldTypeData%Time) + end if + if (allocated(UniformFieldTypeData%VelH)) then + deallocate(UniformFieldTypeData%VelH) + end if + if (allocated(UniformFieldTypeData%VelHDot)) then + deallocate(UniformFieldTypeData%VelHDot) + end if + if (allocated(UniformFieldTypeData%VelV)) then + deallocate(UniformFieldTypeData%VelV) + end if + if (allocated(UniformFieldTypeData%VelVDot)) then + deallocate(UniformFieldTypeData%VelVDot) + end if + if (allocated(UniformFieldTypeData%VelGust)) then + deallocate(UniformFieldTypeData%VelGust) + end if + if (allocated(UniformFieldTypeData%VelGustDot)) then + deallocate(UniformFieldTypeData%VelGustDot) + end if + if (allocated(UniformFieldTypeData%AngleH)) then + deallocate(UniformFieldTypeData%AngleH) + end if + if (allocated(UniformFieldTypeData%AngleHDot)) then + deallocate(UniformFieldTypeData%AngleHDot) + end if + if (allocated(UniformFieldTypeData%AngleV)) then + deallocate(UniformFieldTypeData%AngleV) + end if + if (allocated(UniformFieldTypeData%AngleVDot)) then + deallocate(UniformFieldTypeData%AngleVDot) + end if + if (allocated(UniformFieldTypeData%ShrH)) then + deallocate(UniformFieldTypeData%ShrH) + end if + if (allocated(UniformFieldTypeData%ShrHDot)) then + deallocate(UniformFieldTypeData%ShrHDot) + end if + if (allocated(UniformFieldTypeData%ShrV)) then + deallocate(UniformFieldTypeData%ShrV) + end if + if (allocated(UniformFieldTypeData%ShrVDot)) then + deallocate(UniformFieldTypeData%ShrVDot) + end if + if (allocated(UniformFieldTypeData%LinShrV)) then + deallocate(UniformFieldTypeData%LinShrV) + end if + if (allocated(UniformFieldTypeData%LinShrVDot)) then + deallocate(UniformFieldTypeData%LinShrVDot) + end if +end subroutine subroutine IfW_FlowField_PackUniformFieldType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(UniformFieldType), intent(in) :: InData character(*), parameter :: RoutineName = 'IfW_FlowField_PackUniformFieldType' if (Buf%ErrStat >= AbortErrLev) return - ! RefHeight call RegPack(Buf, InData%RefHeight) if (RegCheckErr(Buf, RoutineName)) return - ! RefLength call RegPack(Buf, InData%RefLength) if (RegCheckErr(Buf, RoutineName)) return - ! DataSize call RegPack(Buf, InData%DataSize) if (RegCheckErr(Buf, RoutineName)) return - ! Time call RegPack(Buf, allocated(InData%Time)) if (allocated(InData%Time)) then call RegPackBounds(Buf, 1, lbound(InData%Time), ubound(InData%Time)) call RegPack(Buf, InData%Time) end if if (RegCheckErr(Buf, RoutineName)) return - ! VelH call RegPack(Buf, allocated(InData%VelH)) if (allocated(InData%VelH)) then call RegPackBounds(Buf, 1, lbound(InData%VelH), ubound(InData%VelH)) call RegPack(Buf, InData%VelH) end if if (RegCheckErr(Buf, RoutineName)) return - ! VelHDot call RegPack(Buf, allocated(InData%VelHDot)) if (allocated(InData%VelHDot)) then call RegPackBounds(Buf, 1, lbound(InData%VelHDot), ubound(InData%VelHDot)) call RegPack(Buf, InData%VelHDot) end if if (RegCheckErr(Buf, RoutineName)) return - ! VelV call RegPack(Buf, allocated(InData%VelV)) if (allocated(InData%VelV)) then call RegPackBounds(Buf, 1, lbound(InData%VelV), ubound(InData%VelV)) call RegPack(Buf, InData%VelV) end if if (RegCheckErr(Buf, RoutineName)) return - ! VelVDot call RegPack(Buf, allocated(InData%VelVDot)) if (allocated(InData%VelVDot)) then call RegPackBounds(Buf, 1, lbound(InData%VelVDot), ubound(InData%VelVDot)) call RegPack(Buf, InData%VelVDot) end if if (RegCheckErr(Buf, RoutineName)) return - ! VelGust call RegPack(Buf, allocated(InData%VelGust)) if (allocated(InData%VelGust)) then call RegPackBounds(Buf, 1, lbound(InData%VelGust), ubound(InData%VelGust)) call RegPack(Buf, InData%VelGust) end if if (RegCheckErr(Buf, RoutineName)) return - ! VelGustDot call RegPack(Buf, allocated(InData%VelGustDot)) if (allocated(InData%VelGustDot)) then call RegPackBounds(Buf, 1, lbound(InData%VelGustDot), ubound(InData%VelGustDot)) call RegPack(Buf, InData%VelGustDot) end if if (RegCheckErr(Buf, RoutineName)) return - ! AngleH call RegPack(Buf, allocated(InData%AngleH)) if (allocated(InData%AngleH)) then call RegPackBounds(Buf, 1, lbound(InData%AngleH), ubound(InData%AngleH)) call RegPack(Buf, InData%AngleH) end if if (RegCheckErr(Buf, RoutineName)) return - ! AngleHDot call RegPack(Buf, allocated(InData%AngleHDot)) if (allocated(InData%AngleHDot)) then call RegPackBounds(Buf, 1, lbound(InData%AngleHDot), ubound(InData%AngleHDot)) call RegPack(Buf, InData%AngleHDot) end if if (RegCheckErr(Buf, RoutineName)) return - ! AngleV call RegPack(Buf, allocated(InData%AngleV)) if (allocated(InData%AngleV)) then call RegPackBounds(Buf, 1, lbound(InData%AngleV), ubound(InData%AngleV)) call RegPack(Buf, InData%AngleV) end if if (RegCheckErr(Buf, RoutineName)) return - ! AngleVDot call RegPack(Buf, allocated(InData%AngleVDot)) if (allocated(InData%AngleVDot)) then call RegPackBounds(Buf, 1, lbound(InData%AngleVDot), ubound(InData%AngleVDot)) call RegPack(Buf, InData%AngleVDot) end if if (RegCheckErr(Buf, RoutineName)) return - ! ShrH call RegPack(Buf, allocated(InData%ShrH)) if (allocated(InData%ShrH)) then call RegPackBounds(Buf, 1, lbound(InData%ShrH), ubound(InData%ShrH)) call RegPack(Buf, InData%ShrH) end if if (RegCheckErr(Buf, RoutineName)) return - ! ShrHDot call RegPack(Buf, allocated(InData%ShrHDot)) if (allocated(InData%ShrHDot)) then call RegPackBounds(Buf, 1, lbound(InData%ShrHDot), ubound(InData%ShrHDot)) call RegPack(Buf, InData%ShrHDot) end if if (RegCheckErr(Buf, RoutineName)) return - ! ShrV call RegPack(Buf, allocated(InData%ShrV)) if (allocated(InData%ShrV)) then call RegPackBounds(Buf, 1, lbound(InData%ShrV), ubound(InData%ShrV)) call RegPack(Buf, InData%ShrV) end if if (RegCheckErr(Buf, RoutineName)) return - ! ShrVDot call RegPack(Buf, allocated(InData%ShrVDot)) if (allocated(InData%ShrVDot)) then call RegPackBounds(Buf, 1, lbound(InData%ShrVDot), ubound(InData%ShrVDot)) call RegPack(Buf, InData%ShrVDot) end if if (RegCheckErr(Buf, RoutineName)) return - ! LinShrV call RegPack(Buf, allocated(InData%LinShrV)) if (allocated(InData%LinShrV)) then call RegPackBounds(Buf, 1, lbound(InData%LinShrV), ubound(InData%LinShrV)) call RegPack(Buf, InData%LinShrV) end if if (RegCheckErr(Buf, RoutineName)) return - ! LinShrVDot call RegPack(Buf, allocated(InData%LinShrVDot)) if (allocated(InData%LinShrVDot)) then call RegPackBounds(Buf, 1, lbound(InData%LinShrVDot), ubound(InData%LinShrVDot)) @@ -600,16 +604,12 @@ subroutine IfW_FlowField_UnPackUniformFieldType(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! RefHeight call RegUnpack(Buf, OutData%RefHeight) if (RegCheckErr(Buf, RoutineName)) return - ! RefLength call RegUnpack(Buf, OutData%RefLength) if (RegCheckErr(Buf, RoutineName)) return - ! DataSize call RegUnpack(Buf, OutData%DataSize) if (RegCheckErr(Buf, RoutineName)) return - ! Time if (allocated(OutData%Time)) deallocate(OutData%Time) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -624,7 +624,6 @@ subroutine IfW_FlowField_UnPackUniformFieldType(Buf, OutData) call RegUnpack(Buf, OutData%Time) if (RegCheckErr(Buf, RoutineName)) return end if - ! VelH if (allocated(OutData%VelH)) deallocate(OutData%VelH) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -639,7 +638,6 @@ subroutine IfW_FlowField_UnPackUniformFieldType(Buf, OutData) call RegUnpack(Buf, OutData%VelH) if (RegCheckErr(Buf, RoutineName)) return end if - ! VelHDot if (allocated(OutData%VelHDot)) deallocate(OutData%VelHDot) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -654,7 +652,6 @@ subroutine IfW_FlowField_UnPackUniformFieldType(Buf, OutData) call RegUnpack(Buf, OutData%VelHDot) if (RegCheckErr(Buf, RoutineName)) return end if - ! VelV if (allocated(OutData%VelV)) deallocate(OutData%VelV) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -669,7 +666,6 @@ subroutine IfW_FlowField_UnPackUniformFieldType(Buf, OutData) call RegUnpack(Buf, OutData%VelV) if (RegCheckErr(Buf, RoutineName)) return end if - ! VelVDot if (allocated(OutData%VelVDot)) deallocate(OutData%VelVDot) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -684,7 +680,6 @@ subroutine IfW_FlowField_UnPackUniformFieldType(Buf, OutData) call RegUnpack(Buf, OutData%VelVDot) if (RegCheckErr(Buf, RoutineName)) return end if - ! VelGust if (allocated(OutData%VelGust)) deallocate(OutData%VelGust) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -699,7 +694,6 @@ subroutine IfW_FlowField_UnPackUniformFieldType(Buf, OutData) call RegUnpack(Buf, OutData%VelGust) if (RegCheckErr(Buf, RoutineName)) return end if - ! VelGustDot if (allocated(OutData%VelGustDot)) deallocate(OutData%VelGustDot) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -714,7 +708,6 @@ subroutine IfW_FlowField_UnPackUniformFieldType(Buf, OutData) call RegUnpack(Buf, OutData%VelGustDot) if (RegCheckErr(Buf, RoutineName)) return end if - ! AngleH if (allocated(OutData%AngleH)) deallocate(OutData%AngleH) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -729,7 +722,6 @@ subroutine IfW_FlowField_UnPackUniformFieldType(Buf, OutData) call RegUnpack(Buf, OutData%AngleH) if (RegCheckErr(Buf, RoutineName)) return end if - ! AngleHDot if (allocated(OutData%AngleHDot)) deallocate(OutData%AngleHDot) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -744,7 +736,6 @@ subroutine IfW_FlowField_UnPackUniformFieldType(Buf, OutData) call RegUnpack(Buf, OutData%AngleHDot) if (RegCheckErr(Buf, RoutineName)) return end if - ! AngleV if (allocated(OutData%AngleV)) deallocate(OutData%AngleV) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -759,7 +750,6 @@ subroutine IfW_FlowField_UnPackUniformFieldType(Buf, OutData) call RegUnpack(Buf, OutData%AngleV) if (RegCheckErr(Buf, RoutineName)) return end if - ! AngleVDot if (allocated(OutData%AngleVDot)) deallocate(OutData%AngleVDot) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -774,7 +764,6 @@ subroutine IfW_FlowField_UnPackUniformFieldType(Buf, OutData) call RegUnpack(Buf, OutData%AngleVDot) if (RegCheckErr(Buf, RoutineName)) return end if - ! ShrH if (allocated(OutData%ShrH)) deallocate(OutData%ShrH) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -789,7 +778,6 @@ subroutine IfW_FlowField_UnPackUniformFieldType(Buf, OutData) call RegUnpack(Buf, OutData%ShrH) if (RegCheckErr(Buf, RoutineName)) return end if - ! ShrHDot if (allocated(OutData%ShrHDot)) deallocate(OutData%ShrHDot) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -804,7 +792,6 @@ subroutine IfW_FlowField_UnPackUniformFieldType(Buf, OutData) call RegUnpack(Buf, OutData%ShrHDot) if (RegCheckErr(Buf, RoutineName)) return end if - ! ShrV if (allocated(OutData%ShrV)) deallocate(OutData%ShrV) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -819,7 +806,6 @@ subroutine IfW_FlowField_UnPackUniformFieldType(Buf, OutData) call RegUnpack(Buf, OutData%ShrV) if (RegCheckErr(Buf, RoutineName)) return end if - ! ShrVDot if (allocated(OutData%ShrVDot)) deallocate(OutData%ShrVDot) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -834,7 +820,6 @@ subroutine IfW_FlowField_UnPackUniformFieldType(Buf, OutData) call RegUnpack(Buf, OutData%ShrVDot) if (RegCheckErr(Buf, RoutineName)) return end if - ! LinShrV if (allocated(OutData%LinShrV)) deallocate(OutData%LinShrV) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -849,7 +834,6 @@ subroutine IfW_FlowField_UnPackUniformFieldType(Buf, OutData) call RegUnpack(Buf, OutData%LinShrV) if (RegCheckErr(Buf, RoutineName)) return end if - ! LinShrVDot if (allocated(OutData%LinShrVDot)) deallocate(OutData%LinShrVDot) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -865,121 +849,90 @@ subroutine IfW_FlowField_UnPackUniformFieldType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE IfW_FlowField_CopyUniformField_Interp( SrcUniformField_InterpData, DstUniformField_InterpData, CtrlCode, ErrStat, ErrMsg ) - TYPE(UniformField_Interp), INTENT(IN) :: SrcUniformField_InterpData - TYPE(UniformField_Interp), INTENT(INOUT) :: DstUniformField_InterpData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_CopyUniformField_Interp' -! - ErrStat = ErrID_None - ErrMsg = "" - DstUniformField_InterpData%VelH = SrcUniformField_InterpData%VelH - DstUniformField_InterpData%VelHDot = SrcUniformField_InterpData%VelHDot - DstUniformField_InterpData%VelV = SrcUniformField_InterpData%VelV - DstUniformField_InterpData%VelVDot = SrcUniformField_InterpData%VelVDot - DstUniformField_InterpData%VelGust = SrcUniformField_InterpData%VelGust - DstUniformField_InterpData%VelGustDot = SrcUniformField_InterpData%VelGustDot - DstUniformField_InterpData%AngleH = SrcUniformField_InterpData%AngleH - DstUniformField_InterpData%AngleHDot = SrcUniformField_InterpData%AngleHDot - DstUniformField_InterpData%AngleV = SrcUniformField_InterpData%AngleV - DstUniformField_InterpData%AngleVDot = SrcUniformField_InterpData%AngleVDot - DstUniformField_InterpData%ShrH = SrcUniformField_InterpData%ShrH - DstUniformField_InterpData%ShrHDot = SrcUniformField_InterpData%ShrHDot - DstUniformField_InterpData%ShrV = SrcUniformField_InterpData%ShrV - DstUniformField_InterpData%ShrVDot = SrcUniformField_InterpData%ShrVDot - DstUniformField_InterpData%LinShrV = SrcUniformField_InterpData%LinShrV - DstUniformField_InterpData%LinShrVDot = SrcUniformField_InterpData%LinShrVDot - DstUniformField_InterpData%CosAngleH = SrcUniformField_InterpData%CosAngleH - DstUniformField_InterpData%SinAngleH = SrcUniformField_InterpData%SinAngleH - DstUniformField_InterpData%CosAngleV = SrcUniformField_InterpData%CosAngleV - DstUniformField_InterpData%SinAngleV = SrcUniformField_InterpData%SinAngleV - END SUBROUTINE IfW_FlowField_CopyUniformField_Interp - - SUBROUTINE IfW_FlowField_DestroyUniformField_Interp( UniformField_InterpData, ErrStat, ErrMsg ) - TYPE(UniformField_Interp), INTENT(INOUT) :: UniformField_InterpData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_DestroyUniformField_Interp' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE IfW_FlowField_DestroyUniformField_Interp +subroutine IfW_FlowField_CopyUniformField_Interp(SrcUniformField_InterpData, DstUniformField_InterpData, CtrlCode, ErrStat, ErrMsg) + type(UniformField_Interp), intent(in) :: SrcUniformField_InterpData + type(UniformField_Interp), intent(inout) :: DstUniformField_InterpData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IfW_FlowField_CopyUniformField_Interp' + ErrStat = ErrID_None + ErrMsg = '' + DstUniformField_InterpData%VelH = SrcUniformField_InterpData%VelH + DstUniformField_InterpData%VelHDot = SrcUniformField_InterpData%VelHDot + DstUniformField_InterpData%VelV = SrcUniformField_InterpData%VelV + DstUniformField_InterpData%VelVDot = SrcUniformField_InterpData%VelVDot + DstUniformField_InterpData%VelGust = SrcUniformField_InterpData%VelGust + DstUniformField_InterpData%VelGustDot = SrcUniformField_InterpData%VelGustDot + DstUniformField_InterpData%AngleH = SrcUniformField_InterpData%AngleH + DstUniformField_InterpData%AngleHDot = SrcUniformField_InterpData%AngleHDot + DstUniformField_InterpData%AngleV = SrcUniformField_InterpData%AngleV + DstUniformField_InterpData%AngleVDot = SrcUniformField_InterpData%AngleVDot + DstUniformField_InterpData%ShrH = SrcUniformField_InterpData%ShrH + DstUniformField_InterpData%ShrHDot = SrcUniformField_InterpData%ShrHDot + DstUniformField_InterpData%ShrV = SrcUniformField_InterpData%ShrV + DstUniformField_InterpData%ShrVDot = SrcUniformField_InterpData%ShrVDot + DstUniformField_InterpData%LinShrV = SrcUniformField_InterpData%LinShrV + DstUniformField_InterpData%LinShrVDot = SrcUniformField_InterpData%LinShrVDot + DstUniformField_InterpData%CosAngleH = SrcUniformField_InterpData%CosAngleH + DstUniformField_InterpData%SinAngleH = SrcUniformField_InterpData%SinAngleH + DstUniformField_InterpData%CosAngleV = SrcUniformField_InterpData%CosAngleV + DstUniformField_InterpData%SinAngleV = SrcUniformField_InterpData%SinAngleV +end subroutine +subroutine IfW_FlowField_DestroyUniformField_Interp(UniformField_InterpData, ErrStat, ErrMsg) + type(UniformField_Interp), intent(inout) :: UniformField_InterpData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IfW_FlowField_DestroyUniformField_Interp' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine IfW_FlowField_PackUniformField_Interp(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(UniformField_Interp), intent(in) :: InData character(*), parameter :: RoutineName = 'IfW_FlowField_PackUniformField_Interp' if (Buf%ErrStat >= AbortErrLev) return - ! VelH call RegPack(Buf, InData%VelH) if (RegCheckErr(Buf, RoutineName)) return - ! VelHDot call RegPack(Buf, InData%VelHDot) if (RegCheckErr(Buf, RoutineName)) return - ! VelV call RegPack(Buf, InData%VelV) if (RegCheckErr(Buf, RoutineName)) return - ! VelVDot call RegPack(Buf, InData%VelVDot) if (RegCheckErr(Buf, RoutineName)) return - ! VelGust call RegPack(Buf, InData%VelGust) if (RegCheckErr(Buf, RoutineName)) return - ! VelGustDot call RegPack(Buf, InData%VelGustDot) if (RegCheckErr(Buf, RoutineName)) return - ! AngleH call RegPack(Buf, InData%AngleH) if (RegCheckErr(Buf, RoutineName)) return - ! AngleHDot call RegPack(Buf, InData%AngleHDot) if (RegCheckErr(Buf, RoutineName)) return - ! AngleV call RegPack(Buf, InData%AngleV) if (RegCheckErr(Buf, RoutineName)) return - ! AngleVDot call RegPack(Buf, InData%AngleVDot) if (RegCheckErr(Buf, RoutineName)) return - ! ShrH call RegPack(Buf, InData%ShrH) if (RegCheckErr(Buf, RoutineName)) return - ! ShrHDot call RegPack(Buf, InData%ShrHDot) if (RegCheckErr(Buf, RoutineName)) return - ! ShrV call RegPack(Buf, InData%ShrV) if (RegCheckErr(Buf, RoutineName)) return - ! ShrVDot call RegPack(Buf, InData%ShrVDot) if (RegCheckErr(Buf, RoutineName)) return - ! LinShrV call RegPack(Buf, InData%LinShrV) if (RegCheckErr(Buf, RoutineName)) return - ! LinShrVDot call RegPack(Buf, InData%LinShrVDot) if (RegCheckErr(Buf, RoutineName)) return - ! CosAngleH call RegPack(Buf, InData%CosAngleH) if (RegCheckErr(Buf, RoutineName)) return - ! SinAngleH call RegPack(Buf, InData%SinAngleH) if (RegCheckErr(Buf, RoutineName)) return - ! CosAngleV call RegPack(Buf, InData%CosAngleV) if (RegCheckErr(Buf, RoutineName)) return - ! SinAngleV call RegPack(Buf, InData%SinAngleV) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -989,386 +942,301 @@ subroutine IfW_FlowField_UnPackUniformField_Interp(Buf, OutData) type(UniformField_Interp), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IfW_FlowField_UnPackUniformField_Interp' if (Buf%ErrStat /= ErrID_None) return - ! VelH call RegUnpack(Buf, OutData%VelH) if (RegCheckErr(Buf, RoutineName)) return - ! VelHDot call RegUnpack(Buf, OutData%VelHDot) if (RegCheckErr(Buf, RoutineName)) return - ! VelV call RegUnpack(Buf, OutData%VelV) if (RegCheckErr(Buf, RoutineName)) return - ! VelVDot call RegUnpack(Buf, OutData%VelVDot) if (RegCheckErr(Buf, RoutineName)) return - ! VelGust call RegUnpack(Buf, OutData%VelGust) if (RegCheckErr(Buf, RoutineName)) return - ! VelGustDot call RegUnpack(Buf, OutData%VelGustDot) if (RegCheckErr(Buf, RoutineName)) return - ! AngleH call RegUnpack(Buf, OutData%AngleH) if (RegCheckErr(Buf, RoutineName)) return - ! AngleHDot call RegUnpack(Buf, OutData%AngleHDot) if (RegCheckErr(Buf, RoutineName)) return - ! AngleV call RegUnpack(Buf, OutData%AngleV) if (RegCheckErr(Buf, RoutineName)) return - ! AngleVDot call RegUnpack(Buf, OutData%AngleVDot) if (RegCheckErr(Buf, RoutineName)) return - ! ShrH call RegUnpack(Buf, OutData%ShrH) if (RegCheckErr(Buf, RoutineName)) return - ! ShrHDot call RegUnpack(Buf, OutData%ShrHDot) if (RegCheckErr(Buf, RoutineName)) return - ! ShrV call RegUnpack(Buf, OutData%ShrV) if (RegCheckErr(Buf, RoutineName)) return - ! ShrVDot call RegUnpack(Buf, OutData%ShrVDot) if (RegCheckErr(Buf, RoutineName)) return - ! LinShrV call RegUnpack(Buf, OutData%LinShrV) if (RegCheckErr(Buf, RoutineName)) return - ! LinShrVDot call RegUnpack(Buf, OutData%LinShrVDot) if (RegCheckErr(Buf, RoutineName)) return - ! CosAngleH call RegUnpack(Buf, OutData%CosAngleH) if (RegCheckErr(Buf, RoutineName)) return - ! SinAngleH call RegUnpack(Buf, OutData%SinAngleH) if (RegCheckErr(Buf, RoutineName)) return - ! CosAngleV call RegUnpack(Buf, OutData%CosAngleV) if (RegCheckErr(Buf, RoutineName)) return - ! SinAngleV call RegUnpack(Buf, OutData%SinAngleV) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE IfW_FlowField_CopyGrid3DFieldType( SrcGrid3DFieldTypeData, DstGrid3DFieldTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Grid3DFieldType), INTENT(IN) :: SrcGrid3DFieldTypeData - TYPE(Grid3DFieldType), INTENT(INOUT) :: DstGrid3DFieldTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_CopyGrid3DFieldType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstGrid3DFieldTypeData%WindFileFormat = SrcGrid3DFieldTypeData%WindFileFormat - DstGrid3DFieldTypeData%WindProfileType = SrcGrid3DFieldTypeData%WindProfileType - DstGrid3DFieldTypeData%Periodic = SrcGrid3DFieldTypeData%Periodic - DstGrid3DFieldTypeData%InterpTower = SrcGrid3DFieldTypeData%InterpTower - DstGrid3DFieldTypeData%AddMeanAfterInterp = SrcGrid3DFieldTypeData%AddMeanAfterInterp - DstGrid3DFieldTypeData%RefHeight = SrcGrid3DFieldTypeData%RefHeight - DstGrid3DFieldTypeData%RefLength = SrcGrid3DFieldTypeData%RefLength -IF (ALLOCATED(SrcGrid3DFieldTypeData%Vel)) THEN - i1_l = LBOUND(SrcGrid3DFieldTypeData%Vel,1) - i1_u = UBOUND(SrcGrid3DFieldTypeData%Vel,1) - i2_l = LBOUND(SrcGrid3DFieldTypeData%Vel,2) - i2_u = UBOUND(SrcGrid3DFieldTypeData%Vel,2) - i3_l = LBOUND(SrcGrid3DFieldTypeData%Vel,3) - i3_u = UBOUND(SrcGrid3DFieldTypeData%Vel,3) - i4_l = LBOUND(SrcGrid3DFieldTypeData%Vel,4) - i4_u = UBOUND(SrcGrid3DFieldTypeData%Vel,4) - IF (.NOT. ALLOCATED(DstGrid3DFieldTypeData%Vel)) THEN - ALLOCATE(DstGrid3DFieldTypeData%Vel(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstGrid3DFieldTypeData%Vel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstGrid3DFieldTypeData%Vel = SrcGrid3DFieldTypeData%Vel -ENDIF -IF (ALLOCATED(SrcGrid3DFieldTypeData%Acc)) THEN - i1_l = LBOUND(SrcGrid3DFieldTypeData%Acc,1) - i1_u = UBOUND(SrcGrid3DFieldTypeData%Acc,1) - i2_l = LBOUND(SrcGrid3DFieldTypeData%Acc,2) - i2_u = UBOUND(SrcGrid3DFieldTypeData%Acc,2) - i3_l = LBOUND(SrcGrid3DFieldTypeData%Acc,3) - i3_u = UBOUND(SrcGrid3DFieldTypeData%Acc,3) - i4_l = LBOUND(SrcGrid3DFieldTypeData%Acc,4) - i4_u = UBOUND(SrcGrid3DFieldTypeData%Acc,4) - IF (.NOT. ALLOCATED(DstGrid3DFieldTypeData%Acc)) THEN - ALLOCATE(DstGrid3DFieldTypeData%Acc(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstGrid3DFieldTypeData%Acc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstGrid3DFieldTypeData%Acc = SrcGrid3DFieldTypeData%Acc -ENDIF -IF (ALLOCATED(SrcGrid3DFieldTypeData%VelTower)) THEN - i1_l = LBOUND(SrcGrid3DFieldTypeData%VelTower,1) - i1_u = UBOUND(SrcGrid3DFieldTypeData%VelTower,1) - i2_l = LBOUND(SrcGrid3DFieldTypeData%VelTower,2) - i2_u = UBOUND(SrcGrid3DFieldTypeData%VelTower,2) - i3_l = LBOUND(SrcGrid3DFieldTypeData%VelTower,3) - i3_u = UBOUND(SrcGrid3DFieldTypeData%VelTower,3) - IF (.NOT. ALLOCATED(DstGrid3DFieldTypeData%VelTower)) THEN - ALLOCATE(DstGrid3DFieldTypeData%VelTower(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstGrid3DFieldTypeData%VelTower.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstGrid3DFieldTypeData%VelTower = SrcGrid3DFieldTypeData%VelTower -ENDIF -IF (ALLOCATED(SrcGrid3DFieldTypeData%AccTower)) THEN - i1_l = LBOUND(SrcGrid3DFieldTypeData%AccTower,1) - i1_u = UBOUND(SrcGrid3DFieldTypeData%AccTower,1) - i2_l = LBOUND(SrcGrid3DFieldTypeData%AccTower,2) - i2_u = UBOUND(SrcGrid3DFieldTypeData%AccTower,2) - i3_l = LBOUND(SrcGrid3DFieldTypeData%AccTower,3) - i3_u = UBOUND(SrcGrid3DFieldTypeData%AccTower,3) - IF (.NOT. ALLOCATED(DstGrid3DFieldTypeData%AccTower)) THEN - ALLOCATE(DstGrid3DFieldTypeData%AccTower(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstGrid3DFieldTypeData%AccTower.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstGrid3DFieldTypeData%AccTower = SrcGrid3DFieldTypeData%AccTower -ENDIF -IF (ALLOCATED(SrcGrid3DFieldTypeData%VelAvg)) THEN - i1_l = LBOUND(SrcGrid3DFieldTypeData%VelAvg,1) - i1_u = UBOUND(SrcGrid3DFieldTypeData%VelAvg,1) - i2_l = LBOUND(SrcGrid3DFieldTypeData%VelAvg,2) - i2_u = UBOUND(SrcGrid3DFieldTypeData%VelAvg,2) - i3_l = LBOUND(SrcGrid3DFieldTypeData%VelAvg,3) - i3_u = UBOUND(SrcGrid3DFieldTypeData%VelAvg,3) - IF (.NOT. ALLOCATED(DstGrid3DFieldTypeData%VelAvg)) THEN - ALLOCATE(DstGrid3DFieldTypeData%VelAvg(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstGrid3DFieldTypeData%VelAvg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstGrid3DFieldTypeData%VelAvg = SrcGrid3DFieldTypeData%VelAvg -ENDIF -IF (ALLOCATED(SrcGrid3DFieldTypeData%AccAvg)) THEN - i1_l = LBOUND(SrcGrid3DFieldTypeData%AccAvg,1) - i1_u = UBOUND(SrcGrid3DFieldTypeData%AccAvg,1) - i2_l = LBOUND(SrcGrid3DFieldTypeData%AccAvg,2) - i2_u = UBOUND(SrcGrid3DFieldTypeData%AccAvg,2) - i3_l = LBOUND(SrcGrid3DFieldTypeData%AccAvg,3) - i3_u = UBOUND(SrcGrid3DFieldTypeData%AccAvg,3) - IF (.NOT. ALLOCATED(DstGrid3DFieldTypeData%AccAvg)) THEN - ALLOCATE(DstGrid3DFieldTypeData%AccAvg(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstGrid3DFieldTypeData%AccAvg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstGrid3DFieldTypeData%AccAvg = SrcGrid3DFieldTypeData%AccAvg -ENDIF - DstGrid3DFieldTypeData%DTime = SrcGrid3DFieldTypeData%DTime - DstGrid3DFieldTypeData%Rate = SrcGrid3DFieldTypeData%Rate - DstGrid3DFieldTypeData%YHWid = SrcGrid3DFieldTypeData%YHWid - DstGrid3DFieldTypeData%ZHWid = SrcGrid3DFieldTypeData%ZHWid - DstGrid3DFieldTypeData%GridBase = SrcGrid3DFieldTypeData%GridBase - DstGrid3DFieldTypeData%InitXPosition = SrcGrid3DFieldTypeData%InitXPosition - DstGrid3DFieldTypeData%InvDY = SrcGrid3DFieldTypeData%InvDY - DstGrid3DFieldTypeData%InvDZ = SrcGrid3DFieldTypeData%InvDZ - DstGrid3DFieldTypeData%MeanWS = SrcGrid3DFieldTypeData%MeanWS - DstGrid3DFieldTypeData%InvMWS = SrcGrid3DFieldTypeData%InvMWS - DstGrid3DFieldTypeData%TotalTime = SrcGrid3DFieldTypeData%TotalTime - DstGrid3DFieldTypeData%NComp = SrcGrid3DFieldTypeData%NComp - DstGrid3DFieldTypeData%NYGrids = SrcGrid3DFieldTypeData%NYGrids - DstGrid3DFieldTypeData%NZGrids = SrcGrid3DFieldTypeData%NZGrids - DstGrid3DFieldTypeData%NTGrids = SrcGrid3DFieldTypeData%NTGrids - DstGrid3DFieldTypeData%NSteps = SrcGrid3DFieldTypeData%NSteps - DstGrid3DFieldTypeData%PLExp = SrcGrid3DFieldTypeData%PLExp - DstGrid3DFieldTypeData%Z0 = SrcGrid3DFieldTypeData%Z0 - DstGrid3DFieldTypeData%VLinShr = SrcGrid3DFieldTypeData%VLinShr - DstGrid3DFieldTypeData%HLinShr = SrcGrid3DFieldTypeData%HLinShr - DstGrid3DFieldTypeData%BoxExceedAllowF = SrcGrid3DFieldTypeData%BoxExceedAllowF - DstGrid3DFieldTypeData%BoxExceedAllowIdx = SrcGrid3DFieldTypeData%BoxExceedAllowIdx - DstGrid3DFieldTypeData%BoxExceedWarned = SrcGrid3DFieldTypeData%BoxExceedWarned - END SUBROUTINE IfW_FlowField_CopyGrid3DFieldType - - SUBROUTINE IfW_FlowField_DestroyGrid3DFieldType( Grid3DFieldTypeData, ErrStat, ErrMsg ) - TYPE(Grid3DFieldType), INTENT(INOUT) :: Grid3DFieldTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_DestroyGrid3DFieldType' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(Grid3DFieldTypeData%Vel)) THEN - DEALLOCATE(Grid3DFieldTypeData%Vel) -ENDIF -IF (ALLOCATED(Grid3DFieldTypeData%Acc)) THEN - DEALLOCATE(Grid3DFieldTypeData%Acc) -ENDIF -IF (ALLOCATED(Grid3DFieldTypeData%VelTower)) THEN - DEALLOCATE(Grid3DFieldTypeData%VelTower) -ENDIF -IF (ALLOCATED(Grid3DFieldTypeData%AccTower)) THEN - DEALLOCATE(Grid3DFieldTypeData%AccTower) -ENDIF -IF (ALLOCATED(Grid3DFieldTypeData%VelAvg)) THEN - DEALLOCATE(Grid3DFieldTypeData%VelAvg) -ENDIF -IF (ALLOCATED(Grid3DFieldTypeData%AccAvg)) THEN - DEALLOCATE(Grid3DFieldTypeData%AccAvg) -ENDIF - END SUBROUTINE IfW_FlowField_DestroyGrid3DFieldType +subroutine IfW_FlowField_CopyGrid3DFieldType(SrcGrid3DFieldTypeData, DstGrid3DFieldTypeData, CtrlCode, ErrStat, ErrMsg) + type(Grid3DFieldType), intent(in) :: SrcGrid3DFieldTypeData + type(Grid3DFieldType), intent(inout) :: DstGrid3DFieldTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'IfW_FlowField_CopyGrid3DFieldType' + ErrStat = ErrID_None + ErrMsg = '' + DstGrid3DFieldTypeData%WindFileFormat = SrcGrid3DFieldTypeData%WindFileFormat + DstGrid3DFieldTypeData%WindProfileType = SrcGrid3DFieldTypeData%WindProfileType + DstGrid3DFieldTypeData%Periodic = SrcGrid3DFieldTypeData%Periodic + DstGrid3DFieldTypeData%InterpTower = SrcGrid3DFieldTypeData%InterpTower + DstGrid3DFieldTypeData%AddMeanAfterInterp = SrcGrid3DFieldTypeData%AddMeanAfterInterp + DstGrid3DFieldTypeData%RefHeight = SrcGrid3DFieldTypeData%RefHeight + DstGrid3DFieldTypeData%RefLength = SrcGrid3DFieldTypeData%RefLength + if (allocated(SrcGrid3DFieldTypeData%Vel)) then + LB(1:4) = lbound(SrcGrid3DFieldTypeData%Vel) + UB(1:4) = ubound(SrcGrid3DFieldTypeData%Vel) + if (.not. allocated(DstGrid3DFieldTypeData%Vel)) then + allocate(DstGrid3DFieldTypeData%Vel(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstGrid3DFieldTypeData%Vel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstGrid3DFieldTypeData%Vel = SrcGrid3DFieldTypeData%Vel + else if (allocated(DstGrid3DFieldTypeData%Vel)) then + deallocate(DstGrid3DFieldTypeData%Vel) + end if + if (allocated(SrcGrid3DFieldTypeData%Acc)) then + LB(1:4) = lbound(SrcGrid3DFieldTypeData%Acc) + UB(1:4) = ubound(SrcGrid3DFieldTypeData%Acc) + if (.not. allocated(DstGrid3DFieldTypeData%Acc)) then + allocate(DstGrid3DFieldTypeData%Acc(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstGrid3DFieldTypeData%Acc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstGrid3DFieldTypeData%Acc = SrcGrid3DFieldTypeData%Acc + else if (allocated(DstGrid3DFieldTypeData%Acc)) then + deallocate(DstGrid3DFieldTypeData%Acc) + end if + if (allocated(SrcGrid3DFieldTypeData%VelTower)) then + LB(1:3) = lbound(SrcGrid3DFieldTypeData%VelTower) + UB(1:3) = ubound(SrcGrid3DFieldTypeData%VelTower) + if (.not. allocated(DstGrid3DFieldTypeData%VelTower)) then + allocate(DstGrid3DFieldTypeData%VelTower(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstGrid3DFieldTypeData%VelTower.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstGrid3DFieldTypeData%VelTower = SrcGrid3DFieldTypeData%VelTower + else if (allocated(DstGrid3DFieldTypeData%VelTower)) then + deallocate(DstGrid3DFieldTypeData%VelTower) + end if + if (allocated(SrcGrid3DFieldTypeData%AccTower)) then + LB(1:3) = lbound(SrcGrid3DFieldTypeData%AccTower) + UB(1:3) = ubound(SrcGrid3DFieldTypeData%AccTower) + if (.not. allocated(DstGrid3DFieldTypeData%AccTower)) then + allocate(DstGrid3DFieldTypeData%AccTower(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstGrid3DFieldTypeData%AccTower.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstGrid3DFieldTypeData%AccTower = SrcGrid3DFieldTypeData%AccTower + else if (allocated(DstGrid3DFieldTypeData%AccTower)) then + deallocate(DstGrid3DFieldTypeData%AccTower) + end if + if (allocated(SrcGrid3DFieldTypeData%VelAvg)) then + LB(1:3) = lbound(SrcGrid3DFieldTypeData%VelAvg) + UB(1:3) = ubound(SrcGrid3DFieldTypeData%VelAvg) + if (.not. allocated(DstGrid3DFieldTypeData%VelAvg)) then + allocate(DstGrid3DFieldTypeData%VelAvg(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstGrid3DFieldTypeData%VelAvg.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstGrid3DFieldTypeData%VelAvg = SrcGrid3DFieldTypeData%VelAvg + else if (allocated(DstGrid3DFieldTypeData%VelAvg)) then + deallocate(DstGrid3DFieldTypeData%VelAvg) + end if + if (allocated(SrcGrid3DFieldTypeData%AccAvg)) then + LB(1:3) = lbound(SrcGrid3DFieldTypeData%AccAvg) + UB(1:3) = ubound(SrcGrid3DFieldTypeData%AccAvg) + if (.not. allocated(DstGrid3DFieldTypeData%AccAvg)) then + allocate(DstGrid3DFieldTypeData%AccAvg(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstGrid3DFieldTypeData%AccAvg.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstGrid3DFieldTypeData%AccAvg = SrcGrid3DFieldTypeData%AccAvg + else if (allocated(DstGrid3DFieldTypeData%AccAvg)) then + deallocate(DstGrid3DFieldTypeData%AccAvg) + end if + DstGrid3DFieldTypeData%DTime = SrcGrid3DFieldTypeData%DTime + DstGrid3DFieldTypeData%Rate = SrcGrid3DFieldTypeData%Rate + DstGrid3DFieldTypeData%YHWid = SrcGrid3DFieldTypeData%YHWid + DstGrid3DFieldTypeData%ZHWid = SrcGrid3DFieldTypeData%ZHWid + DstGrid3DFieldTypeData%GridBase = SrcGrid3DFieldTypeData%GridBase + DstGrid3DFieldTypeData%InitXPosition = SrcGrid3DFieldTypeData%InitXPosition + DstGrid3DFieldTypeData%InvDY = SrcGrid3DFieldTypeData%InvDY + DstGrid3DFieldTypeData%InvDZ = SrcGrid3DFieldTypeData%InvDZ + DstGrid3DFieldTypeData%MeanWS = SrcGrid3DFieldTypeData%MeanWS + DstGrid3DFieldTypeData%InvMWS = SrcGrid3DFieldTypeData%InvMWS + DstGrid3DFieldTypeData%TotalTime = SrcGrid3DFieldTypeData%TotalTime + DstGrid3DFieldTypeData%NComp = SrcGrid3DFieldTypeData%NComp + DstGrid3DFieldTypeData%NYGrids = SrcGrid3DFieldTypeData%NYGrids + DstGrid3DFieldTypeData%NZGrids = SrcGrid3DFieldTypeData%NZGrids + DstGrid3DFieldTypeData%NTGrids = SrcGrid3DFieldTypeData%NTGrids + DstGrid3DFieldTypeData%NSteps = SrcGrid3DFieldTypeData%NSteps + DstGrid3DFieldTypeData%PLExp = SrcGrid3DFieldTypeData%PLExp + DstGrid3DFieldTypeData%Z0 = SrcGrid3DFieldTypeData%Z0 + DstGrid3DFieldTypeData%VLinShr = SrcGrid3DFieldTypeData%VLinShr + DstGrid3DFieldTypeData%HLinShr = SrcGrid3DFieldTypeData%HLinShr + DstGrid3DFieldTypeData%BoxExceedAllowF = SrcGrid3DFieldTypeData%BoxExceedAllowF + DstGrid3DFieldTypeData%BoxExceedAllowIdx = SrcGrid3DFieldTypeData%BoxExceedAllowIdx + DstGrid3DFieldTypeData%BoxExceedWarned = SrcGrid3DFieldTypeData%BoxExceedWarned +end subroutine +subroutine IfW_FlowField_DestroyGrid3DFieldType(Grid3DFieldTypeData, ErrStat, ErrMsg) + type(Grid3DFieldType), intent(inout) :: Grid3DFieldTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IfW_FlowField_DestroyGrid3DFieldType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(Grid3DFieldTypeData%Vel)) then + deallocate(Grid3DFieldTypeData%Vel) + end if + if (allocated(Grid3DFieldTypeData%Acc)) then + deallocate(Grid3DFieldTypeData%Acc) + end if + if (allocated(Grid3DFieldTypeData%VelTower)) then + deallocate(Grid3DFieldTypeData%VelTower) + end if + if (allocated(Grid3DFieldTypeData%AccTower)) then + deallocate(Grid3DFieldTypeData%AccTower) + end if + if (allocated(Grid3DFieldTypeData%VelAvg)) then + deallocate(Grid3DFieldTypeData%VelAvg) + end if + if (allocated(Grid3DFieldTypeData%AccAvg)) then + deallocate(Grid3DFieldTypeData%AccAvg) + end if +end subroutine subroutine IfW_FlowField_PackGrid3DFieldType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Grid3DFieldType), intent(in) :: InData character(*), parameter :: RoutineName = 'IfW_FlowField_PackGrid3DFieldType' if (Buf%ErrStat >= AbortErrLev) return - ! WindFileFormat call RegPack(Buf, InData%WindFileFormat) if (RegCheckErr(Buf, RoutineName)) return - ! WindProfileType call RegPack(Buf, InData%WindProfileType) if (RegCheckErr(Buf, RoutineName)) return - ! Periodic call RegPack(Buf, InData%Periodic) if (RegCheckErr(Buf, RoutineName)) return - ! InterpTower call RegPack(Buf, InData%InterpTower) if (RegCheckErr(Buf, RoutineName)) return - ! AddMeanAfterInterp call RegPack(Buf, InData%AddMeanAfterInterp) if (RegCheckErr(Buf, RoutineName)) return - ! RefHeight call RegPack(Buf, InData%RefHeight) if (RegCheckErr(Buf, RoutineName)) return - ! RefLength call RegPack(Buf, InData%RefLength) if (RegCheckErr(Buf, RoutineName)) return - ! Vel call RegPack(Buf, allocated(InData%Vel)) if (allocated(InData%Vel)) then call RegPackBounds(Buf, 4, lbound(InData%Vel), ubound(InData%Vel)) call RegPack(Buf, InData%Vel) end if if (RegCheckErr(Buf, RoutineName)) return - ! Acc call RegPack(Buf, allocated(InData%Acc)) if (allocated(InData%Acc)) then call RegPackBounds(Buf, 4, lbound(InData%Acc), ubound(InData%Acc)) call RegPack(Buf, InData%Acc) end if if (RegCheckErr(Buf, RoutineName)) return - ! VelTower call RegPack(Buf, allocated(InData%VelTower)) if (allocated(InData%VelTower)) then call RegPackBounds(Buf, 3, lbound(InData%VelTower), ubound(InData%VelTower)) call RegPack(Buf, InData%VelTower) end if if (RegCheckErr(Buf, RoutineName)) return - ! AccTower call RegPack(Buf, allocated(InData%AccTower)) if (allocated(InData%AccTower)) then call RegPackBounds(Buf, 3, lbound(InData%AccTower), ubound(InData%AccTower)) call RegPack(Buf, InData%AccTower) end if if (RegCheckErr(Buf, RoutineName)) return - ! VelAvg call RegPack(Buf, allocated(InData%VelAvg)) if (allocated(InData%VelAvg)) then call RegPackBounds(Buf, 3, lbound(InData%VelAvg), ubound(InData%VelAvg)) call RegPack(Buf, InData%VelAvg) end if if (RegCheckErr(Buf, RoutineName)) return - ! AccAvg call RegPack(Buf, allocated(InData%AccAvg)) if (allocated(InData%AccAvg)) then call RegPackBounds(Buf, 3, lbound(InData%AccAvg), ubound(InData%AccAvg)) call RegPack(Buf, InData%AccAvg) end if if (RegCheckErr(Buf, RoutineName)) return - ! DTime call RegPack(Buf, InData%DTime) if (RegCheckErr(Buf, RoutineName)) return - ! Rate call RegPack(Buf, InData%Rate) if (RegCheckErr(Buf, RoutineName)) return - ! YHWid call RegPack(Buf, InData%YHWid) if (RegCheckErr(Buf, RoutineName)) return - ! ZHWid call RegPack(Buf, InData%ZHWid) if (RegCheckErr(Buf, RoutineName)) return - ! GridBase call RegPack(Buf, InData%GridBase) if (RegCheckErr(Buf, RoutineName)) return - ! InitXPosition call RegPack(Buf, InData%InitXPosition) if (RegCheckErr(Buf, RoutineName)) return - ! InvDY call RegPack(Buf, InData%InvDY) if (RegCheckErr(Buf, RoutineName)) return - ! InvDZ call RegPack(Buf, InData%InvDZ) if (RegCheckErr(Buf, RoutineName)) return - ! MeanWS call RegPack(Buf, InData%MeanWS) if (RegCheckErr(Buf, RoutineName)) return - ! InvMWS call RegPack(Buf, InData%InvMWS) if (RegCheckErr(Buf, RoutineName)) return - ! TotalTime call RegPack(Buf, InData%TotalTime) if (RegCheckErr(Buf, RoutineName)) return - ! NComp call RegPack(Buf, InData%NComp) if (RegCheckErr(Buf, RoutineName)) return - ! NYGrids call RegPack(Buf, InData%NYGrids) if (RegCheckErr(Buf, RoutineName)) return - ! NZGrids call RegPack(Buf, InData%NZGrids) if (RegCheckErr(Buf, RoutineName)) return - ! NTGrids call RegPack(Buf, InData%NTGrids) if (RegCheckErr(Buf, RoutineName)) return - ! NSteps call RegPack(Buf, InData%NSteps) if (RegCheckErr(Buf, RoutineName)) return - ! PLExp call RegPack(Buf, InData%PLExp) if (RegCheckErr(Buf, RoutineName)) return - ! Z0 call RegPack(Buf, InData%Z0) if (RegCheckErr(Buf, RoutineName)) return - ! VLinShr call RegPack(Buf, InData%VLinShr) if (RegCheckErr(Buf, RoutineName)) return - ! HLinShr call RegPack(Buf, InData%HLinShr) if (RegCheckErr(Buf, RoutineName)) return - ! BoxExceedAllowF call RegPack(Buf, InData%BoxExceedAllowF) if (RegCheckErr(Buf, RoutineName)) return - ! BoxExceedAllowIdx call RegPack(Buf, InData%BoxExceedAllowIdx) if (RegCheckErr(Buf, RoutineName)) return - ! BoxExceedWarned call RegPack(Buf, InData%BoxExceedWarned) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1381,28 +1249,20 @@ subroutine IfW_FlowField_UnPackGrid3DFieldType(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! WindFileFormat call RegUnpack(Buf, OutData%WindFileFormat) if (RegCheckErr(Buf, RoutineName)) return - ! WindProfileType call RegUnpack(Buf, OutData%WindProfileType) if (RegCheckErr(Buf, RoutineName)) return - ! Periodic call RegUnpack(Buf, OutData%Periodic) if (RegCheckErr(Buf, RoutineName)) return - ! InterpTower call RegUnpack(Buf, OutData%InterpTower) if (RegCheckErr(Buf, RoutineName)) return - ! AddMeanAfterInterp call RegUnpack(Buf, OutData%AddMeanAfterInterp) if (RegCheckErr(Buf, RoutineName)) return - ! RefHeight call RegUnpack(Buf, OutData%RefHeight) if (RegCheckErr(Buf, RoutineName)) return - ! RefLength call RegUnpack(Buf, OutData%RefLength) if (RegCheckErr(Buf, RoutineName)) return - ! Vel if (allocated(OutData%Vel)) deallocate(OutData%Vel) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1417,7 +1277,6 @@ subroutine IfW_FlowField_UnPackGrid3DFieldType(Buf, OutData) call RegUnpack(Buf, OutData%Vel) if (RegCheckErr(Buf, RoutineName)) return end if - ! Acc if (allocated(OutData%Acc)) deallocate(OutData%Acc) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1432,7 +1291,6 @@ subroutine IfW_FlowField_UnPackGrid3DFieldType(Buf, OutData) call RegUnpack(Buf, OutData%Acc) if (RegCheckErr(Buf, RoutineName)) return end if - ! VelTower if (allocated(OutData%VelTower)) deallocate(OutData%VelTower) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1447,7 +1305,6 @@ subroutine IfW_FlowField_UnPackGrid3DFieldType(Buf, OutData) call RegUnpack(Buf, OutData%VelTower) if (RegCheckErr(Buf, RoutineName)) return end if - ! AccTower if (allocated(OutData%AccTower)) deallocate(OutData%AccTower) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1462,7 +1319,6 @@ subroutine IfW_FlowField_UnPackGrid3DFieldType(Buf, OutData) call RegUnpack(Buf, OutData%AccTower) if (RegCheckErr(Buf, RoutineName)) return end if - ! VelAvg if (allocated(OutData%VelAvg)) deallocate(OutData%VelAvg) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1477,7 +1333,6 @@ subroutine IfW_FlowField_UnPackGrid3DFieldType(Buf, OutData) call RegUnpack(Buf, OutData%VelAvg) if (RegCheckErr(Buf, RoutineName)) return end if - ! AccAvg if (allocated(OutData%AccAvg)) deallocate(OutData%AccAvg) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1492,119 +1347,82 @@ subroutine IfW_FlowField_UnPackGrid3DFieldType(Buf, OutData) call RegUnpack(Buf, OutData%AccAvg) if (RegCheckErr(Buf, RoutineName)) return end if - ! DTime call RegUnpack(Buf, OutData%DTime) if (RegCheckErr(Buf, RoutineName)) return - ! Rate call RegUnpack(Buf, OutData%Rate) if (RegCheckErr(Buf, RoutineName)) return - ! YHWid call RegUnpack(Buf, OutData%YHWid) if (RegCheckErr(Buf, RoutineName)) return - ! ZHWid call RegUnpack(Buf, OutData%ZHWid) if (RegCheckErr(Buf, RoutineName)) return - ! GridBase call RegUnpack(Buf, OutData%GridBase) if (RegCheckErr(Buf, RoutineName)) return - ! InitXPosition call RegUnpack(Buf, OutData%InitXPosition) if (RegCheckErr(Buf, RoutineName)) return - ! InvDY call RegUnpack(Buf, OutData%InvDY) if (RegCheckErr(Buf, RoutineName)) return - ! InvDZ call RegUnpack(Buf, OutData%InvDZ) if (RegCheckErr(Buf, RoutineName)) return - ! MeanWS call RegUnpack(Buf, OutData%MeanWS) if (RegCheckErr(Buf, RoutineName)) return - ! InvMWS call RegUnpack(Buf, OutData%InvMWS) if (RegCheckErr(Buf, RoutineName)) return - ! TotalTime call RegUnpack(Buf, OutData%TotalTime) if (RegCheckErr(Buf, RoutineName)) return - ! NComp call RegUnpack(Buf, OutData%NComp) if (RegCheckErr(Buf, RoutineName)) return - ! NYGrids call RegUnpack(Buf, OutData%NYGrids) if (RegCheckErr(Buf, RoutineName)) return - ! NZGrids call RegUnpack(Buf, OutData%NZGrids) if (RegCheckErr(Buf, RoutineName)) return - ! NTGrids call RegUnpack(Buf, OutData%NTGrids) if (RegCheckErr(Buf, RoutineName)) return - ! NSteps call RegUnpack(Buf, OutData%NSteps) if (RegCheckErr(Buf, RoutineName)) return - ! PLExp call RegUnpack(Buf, OutData%PLExp) if (RegCheckErr(Buf, RoutineName)) return - ! Z0 call RegUnpack(Buf, OutData%Z0) if (RegCheckErr(Buf, RoutineName)) return - ! VLinShr call RegUnpack(Buf, OutData%VLinShr) if (RegCheckErr(Buf, RoutineName)) return - ! HLinShr call RegUnpack(Buf, OutData%HLinShr) if (RegCheckErr(Buf, RoutineName)) return - ! BoxExceedAllowF call RegUnpack(Buf, OutData%BoxExceedAllowF) if (RegCheckErr(Buf, RoutineName)) return - ! BoxExceedAllowIdx call RegUnpack(Buf, OutData%BoxExceedAllowIdx) if (RegCheckErr(Buf, RoutineName)) return - ! BoxExceedWarned call RegUnpack(Buf, OutData%BoxExceedWarned) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE IfW_FlowField_CopyGrid4DFieldType( SrcGrid4DFieldTypeData, DstGrid4DFieldTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Grid4DFieldType), INTENT(IN) :: SrcGrid4DFieldTypeData - TYPE(Grid4DFieldType), INTENT(INOUT) :: DstGrid4DFieldTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_CopyGrid4DFieldType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstGrid4DFieldTypeData%n = SrcGrid4DFieldTypeData%n - DstGrid4DFieldTypeData%delta = SrcGrid4DFieldTypeData%delta - DstGrid4DFieldTypeData%pZero = SrcGrid4DFieldTypeData%pZero - DstGrid4DFieldTypeData%Vel => SrcGrid4DFieldTypeData%Vel - DstGrid4DFieldTypeData%TimeStart = SrcGrid4DFieldTypeData%TimeStart - DstGrid4DFieldTypeData%RefHeight = SrcGrid4DFieldTypeData%RefHeight - END SUBROUTINE IfW_FlowField_CopyGrid4DFieldType - - SUBROUTINE IfW_FlowField_DestroyGrid4DFieldType( Grid4DFieldTypeData, ErrStat, ErrMsg ) - TYPE(Grid4DFieldType), INTENT(INOUT) :: Grid4DFieldTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_DestroyGrid4DFieldType' - ErrStat = ErrID_None - ErrMsg = "" - -NULLIFY(Grid4DFieldTypeData%Vel) - END SUBROUTINE IfW_FlowField_DestroyGrid4DFieldType +subroutine IfW_FlowField_CopyGrid4DFieldType(SrcGrid4DFieldTypeData, DstGrid4DFieldTypeData, CtrlCode, ErrStat, ErrMsg) + type(Grid4DFieldType), intent(in) :: SrcGrid4DFieldTypeData + type(Grid4DFieldType), intent(inout) :: DstGrid4DFieldTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'IfW_FlowField_CopyGrid4DFieldType' + ErrStat = ErrID_None + ErrMsg = '' + DstGrid4DFieldTypeData%n = SrcGrid4DFieldTypeData%n + DstGrid4DFieldTypeData%delta = SrcGrid4DFieldTypeData%delta + DstGrid4DFieldTypeData%pZero = SrcGrid4DFieldTypeData%pZero + DstGrid4DFieldTypeData%Vel => SrcGrid4DFieldTypeData%Vel + DstGrid4DFieldTypeData%TimeStart = SrcGrid4DFieldTypeData%TimeStart + DstGrid4DFieldTypeData%RefHeight = SrcGrid4DFieldTypeData%RefHeight +end subroutine +subroutine IfW_FlowField_DestroyGrid4DFieldType(Grid4DFieldTypeData, ErrStat, ErrMsg) + type(Grid4DFieldType), intent(inout) :: Grid4DFieldTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IfW_FlowField_DestroyGrid4DFieldType' + ErrStat = ErrID_None + ErrMsg = '' + nullify(Grid4DFieldTypeData%Vel) +end subroutine subroutine IfW_FlowField_PackGrid4DFieldType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -1612,16 +1430,12 @@ subroutine IfW_FlowField_PackGrid4DFieldType(Buf, Indata) character(*), parameter :: RoutineName = 'IfW_FlowField_PackGrid4DFieldType' logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return - ! n call RegPack(Buf, InData%n) if (RegCheckErr(Buf, RoutineName)) return - ! delta call RegPack(Buf, InData%delta) if (RegCheckErr(Buf, RoutineName)) return - ! pZero call RegPack(Buf, InData%pZero) if (RegCheckErr(Buf, RoutineName)) return - ! Vel call RegPack(Buf, associated(InData%Vel)) if (associated(InData%Vel)) then call RegPackBounds(Buf, 5, lbound(InData%Vel), ubound(InData%Vel)) @@ -1631,10 +1445,8 @@ subroutine IfW_FlowField_PackGrid4DFieldType(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! TimeStart call RegPack(Buf, InData%TimeStart) if (RegCheckErr(Buf, RoutineName)) return - ! RefHeight call RegPack(Buf, InData%RefHeight) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1649,16 +1461,12 @@ subroutine IfW_FlowField_UnPackGrid4DFieldType(Buf, OutData) integer(IntKi) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return - ! n call RegUnpack(Buf, OutData%n) if (RegCheckErr(Buf, RoutineName)) return - ! delta call RegUnpack(Buf, OutData%delta) if (RegCheckErr(Buf, RoutineName)) return - ! pZero call RegUnpack(Buf, OutData%pZero) if (RegCheckErr(Buf, RoutineName)) return - ! Vel if (associated(OutData%Vel)) deallocate(OutData%Vel) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1683,70 +1491,56 @@ subroutine IfW_FlowField_UnPackGrid4DFieldType(Buf, OutData) else OutData%Vel => null() end if - ! TimeStart call RegUnpack(Buf, OutData%TimeStart) if (RegCheckErr(Buf, RoutineName)) return - ! RefHeight call RegUnpack(Buf, OutData%RefHeight) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE IfW_FlowField_CopyPointsFieldType( SrcPointsFieldTypeData, DstPointsFieldTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(PointsFieldType), INTENT(IN) :: SrcPointsFieldTypeData - TYPE(PointsFieldType), INTENT(INOUT) :: DstPointsFieldTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_CopyPointsFieldType' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcPointsFieldTypeData%Vel)) THEN - i1_l = LBOUND(SrcPointsFieldTypeData%Vel,1) - i1_u = UBOUND(SrcPointsFieldTypeData%Vel,1) - i2_l = LBOUND(SrcPointsFieldTypeData%Vel,2) - i2_u = UBOUND(SrcPointsFieldTypeData%Vel,2) - IF (.NOT. ALLOCATED(DstPointsFieldTypeData%Vel)) THEN - ALLOCATE(DstPointsFieldTypeData%Vel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstPointsFieldTypeData%Vel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstPointsFieldTypeData%Vel = SrcPointsFieldTypeData%Vel -ENDIF - END SUBROUTINE IfW_FlowField_CopyPointsFieldType - - SUBROUTINE IfW_FlowField_DestroyPointsFieldType( PointsFieldTypeData, ErrStat, ErrMsg ) - TYPE(PointsFieldType), INTENT(INOUT) :: PointsFieldTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_DestroyPointsFieldType' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(PointsFieldTypeData%Vel)) THEN - DEALLOCATE(PointsFieldTypeData%Vel) -ENDIF - END SUBROUTINE IfW_FlowField_DestroyPointsFieldType +subroutine IfW_FlowField_CopyPointsFieldType(SrcPointsFieldTypeData, DstPointsFieldTypeData, CtrlCode, ErrStat, ErrMsg) + type(PointsFieldType), intent(in) :: SrcPointsFieldTypeData + type(PointsFieldType), intent(inout) :: DstPointsFieldTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'IfW_FlowField_CopyPointsFieldType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcPointsFieldTypeData%Vel)) then + LB(1:2) = lbound(SrcPointsFieldTypeData%Vel) + UB(1:2) = ubound(SrcPointsFieldTypeData%Vel) + if (.not. allocated(DstPointsFieldTypeData%Vel)) then + allocate(DstPointsFieldTypeData%Vel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstPointsFieldTypeData%Vel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstPointsFieldTypeData%Vel = SrcPointsFieldTypeData%Vel + else if (allocated(DstPointsFieldTypeData%Vel)) then + deallocate(DstPointsFieldTypeData%Vel) + end if +end subroutine +subroutine IfW_FlowField_DestroyPointsFieldType(PointsFieldTypeData, ErrStat, ErrMsg) + type(PointsFieldType), intent(inout) :: PointsFieldTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IfW_FlowField_DestroyPointsFieldType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(PointsFieldTypeData%Vel)) then + deallocate(PointsFieldTypeData%Vel) + end if +end subroutine subroutine IfW_FlowField_PackPointsFieldType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(PointsFieldType), intent(in) :: InData character(*), parameter :: RoutineName = 'IfW_FlowField_PackPointsFieldType' if (Buf%ErrStat >= AbortErrLev) return - ! Vel call RegPack(Buf, allocated(InData%Vel)) if (allocated(InData%Vel)) then call RegPackBounds(Buf, 2, lbound(InData%Vel), ubound(InData%Vel)) @@ -1763,7 +1557,6 @@ subroutine IfW_FlowField_UnPackPointsFieldType(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! Vel if (allocated(OutData%Vel)) deallocate(OutData%Vel) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1779,45 +1572,33 @@ subroutine IfW_FlowField_UnPackPointsFieldType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE IfW_FlowField_CopyUserFieldType( SrcUserFieldTypeData, DstUserFieldTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(UserFieldType), INTENT(IN) :: SrcUserFieldTypeData - TYPE(UserFieldType), INTENT(INOUT) :: DstUserFieldTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_CopyUserFieldType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstUserFieldTypeData%RefHeight = SrcUserFieldTypeData%RefHeight - END SUBROUTINE IfW_FlowField_CopyUserFieldType - - SUBROUTINE IfW_FlowField_DestroyUserFieldType( UserFieldTypeData, ErrStat, ErrMsg ) - TYPE(UserFieldType), INTENT(INOUT) :: UserFieldTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_DestroyUserFieldType' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE IfW_FlowField_DestroyUserFieldType +subroutine IfW_FlowField_CopyUserFieldType(SrcUserFieldTypeData, DstUserFieldTypeData, CtrlCode, ErrStat, ErrMsg) + type(UserFieldType), intent(in) :: SrcUserFieldTypeData + type(UserFieldType), intent(inout) :: DstUserFieldTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IfW_FlowField_CopyUserFieldType' + ErrStat = ErrID_None + ErrMsg = '' + DstUserFieldTypeData%RefHeight = SrcUserFieldTypeData%RefHeight +end subroutine +subroutine IfW_FlowField_DestroyUserFieldType(UserFieldTypeData, ErrStat, ErrMsg) + type(UserFieldType), intent(inout) :: UserFieldTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'IfW_FlowField_DestroyUserFieldType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine IfW_FlowField_PackUserFieldType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(UserFieldType), intent(in) :: InData character(*), parameter :: RoutineName = 'IfW_FlowField_PackUserFieldType' if (Buf%ErrStat >= AbortErrLev) return - ! RefHeight call RegPack(Buf, InData%RefHeight) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1827,123 +1608,89 @@ subroutine IfW_FlowField_UnPackUserFieldType(Buf, OutData) type(UserFieldType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IfW_FlowField_UnPackUserFieldType' if (Buf%ErrStat /= ErrID_None) return - ! RefHeight call RegUnpack(Buf, OutData%RefHeight) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE IfW_FlowField_CopyFlowFieldType( SrcFlowFieldTypeData, DstFlowFieldTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FlowFieldType), INTENT(IN) :: SrcFlowFieldTypeData - TYPE(FlowFieldType), INTENT(INOUT) :: DstFlowFieldTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_CopyFlowFieldType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstFlowFieldTypeData%FieldType = SrcFlowFieldTypeData%FieldType - DstFlowFieldTypeData%RefPosition = SrcFlowFieldTypeData%RefPosition - DstFlowFieldTypeData%PropagationDir = SrcFlowFieldTypeData%PropagationDir - DstFlowFieldTypeData%VFlowAngle = SrcFlowFieldTypeData%VFlowAngle - DstFlowFieldTypeData%VelInterpCubic = SrcFlowFieldTypeData%VelInterpCubic - DstFlowFieldTypeData%RotateWindBox = SrcFlowFieldTypeData%RotateWindBox - DstFlowFieldTypeData%AccFieldValid = SrcFlowFieldTypeData%AccFieldValid - DstFlowFieldTypeData%RotToWind = SrcFlowFieldTypeData%RotToWind - DstFlowFieldTypeData%RotFromWind = SrcFlowFieldTypeData%RotFromWind - CALL IfW_FlowField_Copyuniformfieldtype( SrcFlowFieldTypeData%Uniform, DstFlowFieldTypeData%Uniform, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL IfW_FlowField_Copygrid3dfieldtype( SrcFlowFieldTypeData%Grid3D, DstFlowFieldTypeData%Grid3D, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL IfW_FlowField_Copygrid4dfieldtype( SrcFlowFieldTypeData%Grid4D, DstFlowFieldTypeData%Grid4D, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL IfW_FlowField_Copypointsfieldtype( SrcFlowFieldTypeData%Points, DstFlowFieldTypeData%Points, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL IfW_FlowField_Copyuserfieldtype( SrcFlowFieldTypeData%User, DstFlowFieldTypeData%User, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE IfW_FlowField_CopyFlowFieldType - - SUBROUTINE IfW_FlowField_DestroyFlowFieldType( FlowFieldTypeData, ErrStat, ErrMsg ) - TYPE(FlowFieldType), INTENT(INOUT) :: FlowFieldTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'IfW_FlowField_DestroyFlowFieldType' - ErrStat = ErrID_None - ErrMsg = "" - - CALL IfW_FlowField_DestroyUniformFieldType( FlowFieldTypeData%Uniform, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL IfW_FlowField_DestroyGrid3DFieldType( FlowFieldTypeData%Grid3D, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL IfW_FlowField_DestroyGrid4DFieldType( FlowFieldTypeData%Grid4D, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL IfW_FlowField_DestroyPointsFieldType( FlowFieldTypeData%Points, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL IfW_FlowField_DestroyUserFieldType( FlowFieldTypeData%User, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE IfW_FlowField_DestroyFlowFieldType +subroutine IfW_FlowField_CopyFlowFieldType(SrcFlowFieldTypeData, DstFlowFieldTypeData, CtrlCode, ErrStat, ErrMsg) + type(FlowFieldType), intent(in) :: SrcFlowFieldTypeData + type(FlowFieldType), intent(inout) :: DstFlowFieldTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IfW_FlowField_CopyFlowFieldType' + ErrStat = ErrID_None + ErrMsg = '' + DstFlowFieldTypeData%FieldType = SrcFlowFieldTypeData%FieldType + DstFlowFieldTypeData%RefPosition = SrcFlowFieldTypeData%RefPosition + DstFlowFieldTypeData%PropagationDir = SrcFlowFieldTypeData%PropagationDir + DstFlowFieldTypeData%VFlowAngle = SrcFlowFieldTypeData%VFlowAngle + DstFlowFieldTypeData%VelInterpCubic = SrcFlowFieldTypeData%VelInterpCubic + DstFlowFieldTypeData%RotateWindBox = SrcFlowFieldTypeData%RotateWindBox + DstFlowFieldTypeData%AccFieldValid = SrcFlowFieldTypeData%AccFieldValid + DstFlowFieldTypeData%RotToWind = SrcFlowFieldTypeData%RotToWind + DstFlowFieldTypeData%RotFromWind = SrcFlowFieldTypeData%RotFromWind + call IfW_FlowField_CopyUniformFieldType(SrcFlowFieldTypeData%Uniform, DstFlowFieldTypeData%Uniform, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IfW_FlowField_CopyGrid3DFieldType(SrcFlowFieldTypeData%Grid3D, DstFlowFieldTypeData%Grid3D, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IfW_FlowField_CopyGrid4DFieldType(SrcFlowFieldTypeData%Grid4D, DstFlowFieldTypeData%Grid4D, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IfW_FlowField_CopyPointsFieldType(SrcFlowFieldTypeData%Points, DstFlowFieldTypeData%Points, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IfW_FlowField_CopyUserFieldType(SrcFlowFieldTypeData%User, DstFlowFieldTypeData%User, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine IfW_FlowField_DestroyFlowFieldType(FlowFieldTypeData, ErrStat, ErrMsg) + type(FlowFieldType), intent(inout) :: FlowFieldTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'IfW_FlowField_DestroyFlowFieldType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine IfW_FlowField_PackFlowFieldType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FlowFieldType), intent(in) :: InData character(*), parameter :: RoutineName = 'IfW_FlowField_PackFlowFieldType' if (Buf%ErrStat >= AbortErrLev) return - ! FieldType call RegPack(Buf, InData%FieldType) if (RegCheckErr(Buf, RoutineName)) return - ! RefPosition call RegPack(Buf, InData%RefPosition) if (RegCheckErr(Buf, RoutineName)) return - ! PropagationDir call RegPack(Buf, InData%PropagationDir) if (RegCheckErr(Buf, RoutineName)) return - ! VFlowAngle call RegPack(Buf, InData%VFlowAngle) if (RegCheckErr(Buf, RoutineName)) return - ! VelInterpCubic call RegPack(Buf, InData%VelInterpCubic) if (RegCheckErr(Buf, RoutineName)) return - ! RotateWindBox call RegPack(Buf, InData%RotateWindBox) if (RegCheckErr(Buf, RoutineName)) return - ! AccFieldValid call RegPack(Buf, InData%AccFieldValid) if (RegCheckErr(Buf, RoutineName)) return - ! RotToWind call RegPack(Buf, InData%RotToWind) if (RegCheckErr(Buf, RoutineName)) return - ! RotFromWind call RegPack(Buf, InData%RotFromWind) if (RegCheckErr(Buf, RoutineName)) return - ! Uniform call IfW_FlowField_PackUniformFieldType(Buf, InData%Uniform) if (RegCheckErr(Buf, RoutineName)) return - ! Grid3D call IfW_FlowField_PackGrid3DFieldType(Buf, InData%Grid3D) if (RegCheckErr(Buf, RoutineName)) return - ! Grid4D call IfW_FlowField_PackGrid4DFieldType(Buf, InData%Grid4D) if (RegCheckErr(Buf, RoutineName)) return - ! Points call IfW_FlowField_PackPointsFieldType(Buf, InData%Points) if (RegCheckErr(Buf, RoutineName)) return - ! User call IfW_FlowField_PackUserFieldType(Buf, InData%User) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1953,42 +1700,28 @@ subroutine IfW_FlowField_UnPackFlowFieldType(Buf, OutData) type(FlowFieldType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IfW_FlowField_UnPackFlowFieldType' if (Buf%ErrStat /= ErrID_None) return - ! FieldType call RegUnpack(Buf, OutData%FieldType) if (RegCheckErr(Buf, RoutineName)) return - ! RefPosition call RegUnpack(Buf, OutData%RefPosition) if (RegCheckErr(Buf, RoutineName)) return - ! PropagationDir call RegUnpack(Buf, OutData%PropagationDir) if (RegCheckErr(Buf, RoutineName)) return - ! VFlowAngle call RegUnpack(Buf, OutData%VFlowAngle) if (RegCheckErr(Buf, RoutineName)) return - ! VelInterpCubic call RegUnpack(Buf, OutData%VelInterpCubic) if (RegCheckErr(Buf, RoutineName)) return - ! RotateWindBox call RegUnpack(Buf, OutData%RotateWindBox) if (RegCheckErr(Buf, RoutineName)) return - ! AccFieldValid call RegUnpack(Buf, OutData%AccFieldValid) if (RegCheckErr(Buf, RoutineName)) return - ! RotToWind call RegUnpack(Buf, OutData%RotToWind) if (RegCheckErr(Buf, RoutineName)) return - ! RotFromWind call RegUnpack(Buf, OutData%RotFromWind) if (RegCheckErr(Buf, RoutineName)) return - ! Uniform call IfW_FlowField_UnpackUniformFieldType(Buf, OutData%Uniform) ! Uniform - ! Grid3D call IfW_FlowField_UnpackGrid3DFieldType(Buf, OutData%Grid3D) ! Grid3D - ! Grid4D call IfW_FlowField_UnpackGrid4DFieldType(Buf, OutData%Grid4D) ! Grid4D - ! Points call IfW_FlowField_UnpackPointsFieldType(Buf, OutData%Points) ! Points - ! User call IfW_FlowField_UnpackUserFieldType(Buf, OutData%User) ! User end subroutine END MODULE IfW_FlowField_Types diff --git a/modules/inflowwind/src/InflowWind_IO_Types.f90 b/modules/inflowwind/src/InflowWind_IO_Types.f90 index d014e7960c..4c6c3b59b0 100644 --- a/modules/inflowwind/src/InflowWind_IO_Types.f90 +++ b/modules/inflowwind/src/InflowWind_IO_Types.f90 @@ -141,114 +141,84 @@ MODULE InflowWind_IO_Types END TYPE Points_InitInputType ! ======================= CONTAINS - SUBROUTINE InflowWind_IO_CopyWindFileDat( SrcWindFileDatData, DstWindFileDatData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WindFileDat), INTENT(IN) :: SrcWindFileDatData - TYPE(WindFileDat), INTENT(INOUT) :: DstWindFileDatData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_CopyWindFileDat' -! - ErrStat = ErrID_None - ErrMsg = "" - DstWindFileDatData%FileName = SrcWindFileDatData%FileName - DstWindFileDatData%WindType = SrcWindFileDatData%WindType - DstWindFileDatData%RefHt = SrcWindFileDatData%RefHt - DstWindFileDatData%RefHt_Set = SrcWindFileDatData%RefHt_Set - DstWindFileDatData%DT = SrcWindFileDatData%DT - DstWindFileDatData%NumTSteps = SrcWindFileDatData%NumTSteps - DstWindFileDatData%ConstantDT = SrcWindFileDatData%ConstantDT - DstWindFileDatData%TRange = SrcWindFileDatData%TRange - DstWindFileDatData%TRange_Limited = SrcWindFileDatData%TRange_Limited - DstWindFileDatData%YRange = SrcWindFileDatData%YRange - DstWindFileDatData%YRange_Limited = SrcWindFileDatData%YRange_Limited - DstWindFileDatData%ZRange = SrcWindFileDatData%ZRange - DstWindFileDatData%ZRange_Limited = SrcWindFileDatData%ZRange_Limited - DstWindFileDatData%BinaryFormat = SrcWindFileDatData%BinaryFormat - DstWindFileDatData%IsBinary = SrcWindFileDatData%IsBinary - DstWindFileDatData%TI = SrcWindFileDatData%TI - DstWindFileDatData%TI_listed = SrcWindFileDatData%TI_listed - DstWindFileDatData%MWS = SrcWindFileDatData%MWS - END SUBROUTINE InflowWind_IO_CopyWindFileDat - - SUBROUTINE InflowWind_IO_DestroyWindFileDat( WindFileDatData, ErrStat, ErrMsg ) - TYPE(WindFileDat), INTENT(INOUT) :: WindFileDatData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_DestroyWindFileDat' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE InflowWind_IO_DestroyWindFileDat +subroutine InflowWind_IO_CopyWindFileDat(SrcWindFileDatData, DstWindFileDatData, CtrlCode, ErrStat, ErrMsg) + type(WindFileDat), intent(in) :: SrcWindFileDatData + type(WindFileDat), intent(inout) :: DstWindFileDatData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_IO_CopyWindFileDat' + ErrStat = ErrID_None + ErrMsg = '' + DstWindFileDatData%FileName = SrcWindFileDatData%FileName + DstWindFileDatData%WindType = SrcWindFileDatData%WindType + DstWindFileDatData%RefHt = SrcWindFileDatData%RefHt + DstWindFileDatData%RefHt_Set = SrcWindFileDatData%RefHt_Set + DstWindFileDatData%DT = SrcWindFileDatData%DT + DstWindFileDatData%NumTSteps = SrcWindFileDatData%NumTSteps + DstWindFileDatData%ConstantDT = SrcWindFileDatData%ConstantDT + DstWindFileDatData%TRange = SrcWindFileDatData%TRange + DstWindFileDatData%TRange_Limited = SrcWindFileDatData%TRange_Limited + DstWindFileDatData%YRange = SrcWindFileDatData%YRange + DstWindFileDatData%YRange_Limited = SrcWindFileDatData%YRange_Limited + DstWindFileDatData%ZRange = SrcWindFileDatData%ZRange + DstWindFileDatData%ZRange_Limited = SrcWindFileDatData%ZRange_Limited + DstWindFileDatData%BinaryFormat = SrcWindFileDatData%BinaryFormat + DstWindFileDatData%IsBinary = SrcWindFileDatData%IsBinary + DstWindFileDatData%TI = SrcWindFileDatData%TI + DstWindFileDatData%TI_listed = SrcWindFileDatData%TI_listed + DstWindFileDatData%MWS = SrcWindFileDatData%MWS +end subroutine +subroutine InflowWind_IO_DestroyWindFileDat(WindFileDatData, ErrStat, ErrMsg) + type(WindFileDat), intent(inout) :: WindFileDatData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_IO_DestroyWindFileDat' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine InflowWind_IO_PackWindFileDat(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(WindFileDat), intent(in) :: InData character(*), parameter :: RoutineName = 'InflowWind_IO_PackWindFileDat' if (Buf%ErrStat >= AbortErrLev) return - ! FileName call RegPack(Buf, InData%FileName) if (RegCheckErr(Buf, RoutineName)) return - ! WindType call RegPack(Buf, InData%WindType) if (RegCheckErr(Buf, RoutineName)) return - ! RefHt call RegPack(Buf, InData%RefHt) if (RegCheckErr(Buf, RoutineName)) return - ! RefHt_Set call RegPack(Buf, InData%RefHt_Set) if (RegCheckErr(Buf, RoutineName)) return - ! DT call RegPack(Buf, InData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! NumTSteps call RegPack(Buf, InData%NumTSteps) if (RegCheckErr(Buf, RoutineName)) return - ! ConstantDT call RegPack(Buf, InData%ConstantDT) if (RegCheckErr(Buf, RoutineName)) return - ! TRange call RegPack(Buf, InData%TRange) if (RegCheckErr(Buf, RoutineName)) return - ! TRange_Limited call RegPack(Buf, InData%TRange_Limited) if (RegCheckErr(Buf, RoutineName)) return - ! YRange call RegPack(Buf, InData%YRange) if (RegCheckErr(Buf, RoutineName)) return - ! YRange_Limited call RegPack(Buf, InData%YRange_Limited) if (RegCheckErr(Buf, RoutineName)) return - ! ZRange call RegPack(Buf, InData%ZRange) if (RegCheckErr(Buf, RoutineName)) return - ! ZRange_Limited call RegPack(Buf, InData%ZRange_Limited) if (RegCheckErr(Buf, RoutineName)) return - ! BinaryFormat call RegPack(Buf, InData%BinaryFormat) if (RegCheckErr(Buf, RoutineName)) return - ! IsBinary call RegPack(Buf, InData%IsBinary) if (RegCheckErr(Buf, RoutineName)) return - ! TI call RegPack(Buf, InData%TI) if (RegCheckErr(Buf, RoutineName)) return - ! TI_listed call RegPack(Buf, InData%TI_listed) if (RegCheckErr(Buf, RoutineName)) return - ! MWS call RegPack(Buf, InData%MWS) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -258,108 +228,76 @@ subroutine InflowWind_IO_UnPackWindFileDat(Buf, OutData) type(WindFileDat), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackWindFileDat' if (Buf%ErrStat /= ErrID_None) return - ! FileName call RegUnpack(Buf, OutData%FileName) if (RegCheckErr(Buf, RoutineName)) return - ! WindType call RegUnpack(Buf, OutData%WindType) if (RegCheckErr(Buf, RoutineName)) return - ! RefHt call RegUnpack(Buf, OutData%RefHt) if (RegCheckErr(Buf, RoutineName)) return - ! RefHt_Set call RegUnpack(Buf, OutData%RefHt_Set) if (RegCheckErr(Buf, RoutineName)) return - ! DT call RegUnpack(Buf, OutData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! NumTSteps call RegUnpack(Buf, OutData%NumTSteps) if (RegCheckErr(Buf, RoutineName)) return - ! ConstantDT call RegUnpack(Buf, OutData%ConstantDT) if (RegCheckErr(Buf, RoutineName)) return - ! TRange call RegUnpack(Buf, OutData%TRange) if (RegCheckErr(Buf, RoutineName)) return - ! TRange_Limited call RegUnpack(Buf, OutData%TRange_Limited) if (RegCheckErr(Buf, RoutineName)) return - ! YRange call RegUnpack(Buf, OutData%YRange) if (RegCheckErr(Buf, RoutineName)) return - ! YRange_Limited call RegUnpack(Buf, OutData%YRange_Limited) if (RegCheckErr(Buf, RoutineName)) return - ! ZRange call RegUnpack(Buf, OutData%ZRange) if (RegCheckErr(Buf, RoutineName)) return - ! ZRange_Limited call RegUnpack(Buf, OutData%ZRange_Limited) if (RegCheckErr(Buf, RoutineName)) return - ! BinaryFormat call RegUnpack(Buf, OutData%BinaryFormat) if (RegCheckErr(Buf, RoutineName)) return - ! IsBinary call RegUnpack(Buf, OutData%IsBinary) if (RegCheckErr(Buf, RoutineName)) return - ! TI call RegUnpack(Buf, OutData%TI) if (RegCheckErr(Buf, RoutineName)) return - ! TI_listed call RegUnpack(Buf, OutData%TI_listed) if (RegCheckErr(Buf, RoutineName)) return - ! MWS call RegUnpack(Buf, OutData%MWS) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE InflowWind_IO_CopySteady_InitInputType( SrcSteady_InitInputTypeData, DstSteady_InitInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Steady_InitInputType), INTENT(IN) :: SrcSteady_InitInputTypeData - TYPE(Steady_InitInputType), INTENT(INOUT) :: DstSteady_InitInputTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_CopySteady_InitInputType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstSteady_InitInputTypeData%HWindSpeed = SrcSteady_InitInputTypeData%HWindSpeed - DstSteady_InitInputTypeData%RefHt = SrcSteady_InitInputTypeData%RefHt - DstSteady_InitInputTypeData%PLExp = SrcSteady_InitInputTypeData%PLExp - END SUBROUTINE InflowWind_IO_CopySteady_InitInputType - - SUBROUTINE InflowWind_IO_DestroySteady_InitInputType( Steady_InitInputTypeData, ErrStat, ErrMsg ) - TYPE(Steady_InitInputType), INTENT(INOUT) :: Steady_InitInputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_DestroySteady_InitInputType' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE InflowWind_IO_DestroySteady_InitInputType +subroutine InflowWind_IO_CopySteady_InitInputType(SrcSteady_InitInputTypeData, DstSteady_InitInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(Steady_InitInputType), intent(in) :: SrcSteady_InitInputTypeData + type(Steady_InitInputType), intent(inout) :: DstSteady_InitInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_IO_CopySteady_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' + DstSteady_InitInputTypeData%HWindSpeed = SrcSteady_InitInputTypeData%HWindSpeed + DstSteady_InitInputTypeData%RefHt = SrcSteady_InitInputTypeData%RefHt + DstSteady_InitInputTypeData%PLExp = SrcSteady_InitInputTypeData%PLExp +end subroutine +subroutine InflowWind_IO_DestroySteady_InitInputType(Steady_InitInputTypeData, ErrStat, ErrMsg) + type(Steady_InitInputType), intent(inout) :: Steady_InitInputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_IO_DestroySteady_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine InflowWind_IO_PackSteady_InitInputType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Steady_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'InflowWind_IO_PackSteady_InitInputType' if (Buf%ErrStat >= AbortErrLev) return - ! HWindSpeed call RegPack(Buf, InData%HWindSpeed) if (RegCheckErr(Buf, RoutineName)) return - ! RefHt call RegPack(Buf, InData%RefHt) if (RegCheckErr(Buf, RoutineName)) return - ! PLExp call RegPack(Buf, InData%PLExp) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -369,79 +307,61 @@ subroutine InflowWind_IO_UnPackSteady_InitInputType(Buf, OutData) type(Steady_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackSteady_InitInputType' if (Buf%ErrStat /= ErrID_None) return - ! HWindSpeed call RegUnpack(Buf, OutData%HWindSpeed) if (RegCheckErr(Buf, RoutineName)) return - ! RefHt call RegUnpack(Buf, OutData%RefHt) if (RegCheckErr(Buf, RoutineName)) return - ! PLExp call RegUnpack(Buf, OutData%PLExp) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE InflowWind_IO_CopyUniform_InitInputType( SrcUniform_InitInputTypeData, DstUniform_InitInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Uniform_InitInputType), INTENT(IN) :: SrcUniform_InitInputTypeData - TYPE(Uniform_InitInputType), INTENT(INOUT) :: DstUniform_InitInputTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_CopyUniform_InitInputType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstUniform_InitInputTypeData%WindFileName = SrcUniform_InitInputTypeData%WindFileName - DstUniform_InitInputTypeData%RefHt = SrcUniform_InitInputTypeData%RefHt - DstUniform_InitInputTypeData%RefLength = SrcUniform_InitInputTypeData%RefLength - DstUniform_InitInputTypeData%PropagationDir = SrcUniform_InitInputTypeData%PropagationDir - DstUniform_InitInputTypeData%UseInputFile = SrcUniform_InitInputTypeData%UseInputFile - CALL NWTC_Library_Copyfileinfotype( SrcUniform_InitInputTypeData%PassedFileData, DstUniform_InitInputTypeData%PassedFileData, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE InflowWind_IO_CopyUniform_InitInputType - SUBROUTINE InflowWind_IO_DestroyUniform_InitInputType( Uniform_InitInputTypeData, ErrStat, ErrMsg ) - TYPE(Uniform_InitInputType), INTENT(INOUT) :: Uniform_InitInputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_DestroyUniform_InitInputType' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL NWTC_Library_DestroyFileInfoType( Uniform_InitInputTypeData%PassedFileData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE InflowWind_IO_DestroyUniform_InitInputType +subroutine InflowWind_IO_CopyUniform_InitInputType(SrcUniform_InitInputTypeData, DstUniform_InitInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(Uniform_InitInputType), intent(in) :: SrcUniform_InitInputTypeData + type(Uniform_InitInputType), intent(inout) :: DstUniform_InitInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_IO_CopyUniform_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' + DstUniform_InitInputTypeData%WindFileName = SrcUniform_InitInputTypeData%WindFileName + DstUniform_InitInputTypeData%RefHt = SrcUniform_InitInputTypeData%RefHt + DstUniform_InitInputTypeData%RefLength = SrcUniform_InitInputTypeData%RefLength + DstUniform_InitInputTypeData%PropagationDir = SrcUniform_InitInputTypeData%PropagationDir + DstUniform_InitInputTypeData%UseInputFile = SrcUniform_InitInputTypeData%UseInputFile + call NWTC_Library_CopyFileInfoType(SrcUniform_InitInputTypeData%PassedFileData, DstUniform_InitInputTypeData%PassedFileData, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine InflowWind_IO_DestroyUniform_InitInputType(Uniform_InitInputTypeData, ErrStat, ErrMsg) + type(Uniform_InitInputType), intent(inout) :: Uniform_InitInputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_IO_DestroyUniform_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine InflowWind_IO_PackUniform_InitInputType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Uniform_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'InflowWind_IO_PackUniform_InitInputType' if (Buf%ErrStat >= AbortErrLev) return - ! WindFileName call RegPack(Buf, InData%WindFileName) if (RegCheckErr(Buf, RoutineName)) return - ! RefHt call RegPack(Buf, InData%RefHt) if (RegCheckErr(Buf, RoutineName)) return - ! RefLength call RegPack(Buf, InData%RefLength) if (RegCheckErr(Buf, RoutineName)) return - ! PropagationDir call RegPack(Buf, InData%PropagationDir) if (RegCheckErr(Buf, RoutineName)) return - ! UseInputFile call RegPack(Buf, InData%UseInputFile) if (RegCheckErr(Buf, RoutineName)) return - ! PassedFileData call NWTC_Library_PackFileInfoType(Buf, InData%PassedFileData) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -451,108 +371,78 @@ subroutine InflowWind_IO_UnPackUniform_InitInputType(Buf, OutData) type(Uniform_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackUniform_InitInputType' if (Buf%ErrStat /= ErrID_None) return - ! WindFileName call RegUnpack(Buf, OutData%WindFileName) if (RegCheckErr(Buf, RoutineName)) return - ! RefHt call RegUnpack(Buf, OutData%RefHt) if (RegCheckErr(Buf, RoutineName)) return - ! RefLength call RegUnpack(Buf, OutData%RefLength) if (RegCheckErr(Buf, RoutineName)) return - ! PropagationDir call RegUnpack(Buf, OutData%PropagationDir) if (RegCheckErr(Buf, RoutineName)) return - ! UseInputFile call RegUnpack(Buf, OutData%UseInputFile) if (RegCheckErr(Buf, RoutineName)) return - ! PassedFileData call NWTC_Library_UnpackFileInfoType(Buf, OutData%PassedFileData) ! PassedFileData end subroutine - SUBROUTINE InflowWind_IO_CopyGrid3D_InitInputType( SrcGrid3D_InitInputTypeData, DstGrid3D_InitInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Grid3D_InitInputType), INTENT(IN) :: SrcGrid3D_InitInputTypeData - TYPE(Grid3D_InitInputType), INTENT(INOUT) :: DstGrid3D_InitInputTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_CopyGrid3D_InitInputType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstGrid3D_InitInputTypeData%ScaleMethod = SrcGrid3D_InitInputTypeData%ScaleMethod - DstGrid3D_InitInputTypeData%SF = SrcGrid3D_InitInputTypeData%SF - DstGrid3D_InitInputTypeData%SigmaF = SrcGrid3D_InitInputTypeData%SigmaF - DstGrid3D_InitInputTypeData%WindProfileType = SrcGrid3D_InitInputTypeData%WindProfileType - DstGrid3D_InitInputTypeData%RefHt = SrcGrid3D_InitInputTypeData%RefHt - DstGrid3D_InitInputTypeData%URef = SrcGrid3D_InitInputTypeData%URef - DstGrid3D_InitInputTypeData%PLExp = SrcGrid3D_InitInputTypeData%PLExp - DstGrid3D_InitInputTypeData%VLinShr = SrcGrid3D_InitInputTypeData%VLinShr - DstGrid3D_InitInputTypeData%HLinShr = SrcGrid3D_InitInputTypeData%HLinShr - DstGrid3D_InitInputTypeData%RefLength = SrcGrid3D_InitInputTypeData%RefLength - DstGrid3D_InitInputTypeData%Z0 = SrcGrid3D_InitInputTypeData%Z0 - DstGrid3D_InitInputTypeData%XOffset = SrcGrid3D_InitInputTypeData%XOffset - END SUBROUTINE InflowWind_IO_CopyGrid3D_InitInputType - - SUBROUTINE InflowWind_IO_DestroyGrid3D_InitInputType( Grid3D_InitInputTypeData, ErrStat, ErrMsg ) - TYPE(Grid3D_InitInputType), INTENT(INOUT) :: Grid3D_InitInputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_DestroyGrid3D_InitInputType' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE InflowWind_IO_DestroyGrid3D_InitInputType +subroutine InflowWind_IO_CopyGrid3D_InitInputType(SrcGrid3D_InitInputTypeData, DstGrid3D_InitInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(Grid3D_InitInputType), intent(in) :: SrcGrid3D_InitInputTypeData + type(Grid3D_InitInputType), intent(inout) :: DstGrid3D_InitInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_IO_CopyGrid3D_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' + DstGrid3D_InitInputTypeData%ScaleMethod = SrcGrid3D_InitInputTypeData%ScaleMethod + DstGrid3D_InitInputTypeData%SF = SrcGrid3D_InitInputTypeData%SF + DstGrid3D_InitInputTypeData%SigmaF = SrcGrid3D_InitInputTypeData%SigmaF + DstGrid3D_InitInputTypeData%WindProfileType = SrcGrid3D_InitInputTypeData%WindProfileType + DstGrid3D_InitInputTypeData%RefHt = SrcGrid3D_InitInputTypeData%RefHt + DstGrid3D_InitInputTypeData%URef = SrcGrid3D_InitInputTypeData%URef + DstGrid3D_InitInputTypeData%PLExp = SrcGrid3D_InitInputTypeData%PLExp + DstGrid3D_InitInputTypeData%VLinShr = SrcGrid3D_InitInputTypeData%VLinShr + DstGrid3D_InitInputTypeData%HLinShr = SrcGrid3D_InitInputTypeData%HLinShr + DstGrid3D_InitInputTypeData%RefLength = SrcGrid3D_InitInputTypeData%RefLength + DstGrid3D_InitInputTypeData%Z0 = SrcGrid3D_InitInputTypeData%Z0 + DstGrid3D_InitInputTypeData%XOffset = SrcGrid3D_InitInputTypeData%XOffset +end subroutine +subroutine InflowWind_IO_DestroyGrid3D_InitInputType(Grid3D_InitInputTypeData, ErrStat, ErrMsg) + type(Grid3D_InitInputType), intent(inout) :: Grid3D_InitInputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_IO_DestroyGrid3D_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine InflowWind_IO_PackGrid3D_InitInputType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Grid3D_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'InflowWind_IO_PackGrid3D_InitInputType' if (Buf%ErrStat >= AbortErrLev) return - ! ScaleMethod call RegPack(Buf, InData%ScaleMethod) if (RegCheckErr(Buf, RoutineName)) return - ! SF call RegPack(Buf, InData%SF) if (RegCheckErr(Buf, RoutineName)) return - ! SigmaF call RegPack(Buf, InData%SigmaF) if (RegCheckErr(Buf, RoutineName)) return - ! WindProfileType call RegPack(Buf, InData%WindProfileType) if (RegCheckErr(Buf, RoutineName)) return - ! RefHt call RegPack(Buf, InData%RefHt) if (RegCheckErr(Buf, RoutineName)) return - ! URef call RegPack(Buf, InData%URef) if (RegCheckErr(Buf, RoutineName)) return - ! PLExp call RegPack(Buf, InData%PLExp) if (RegCheckErr(Buf, RoutineName)) return - ! VLinShr call RegPack(Buf, InData%VLinShr) if (RegCheckErr(Buf, RoutineName)) return - ! HLinShr call RegPack(Buf, InData%HLinShr) if (RegCheckErr(Buf, RoutineName)) return - ! RefLength call RegPack(Buf, InData%RefLength) if (RegCheckErr(Buf, RoutineName)) return - ! Z0 call RegPack(Buf, InData%Z0) if (RegCheckErr(Buf, RoutineName)) return - ! XOffset call RegPack(Buf, InData%XOffset) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -562,82 +452,58 @@ subroutine InflowWind_IO_UnPackGrid3D_InitInputType(Buf, OutData) type(Grid3D_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackGrid3D_InitInputType' if (Buf%ErrStat /= ErrID_None) return - ! ScaleMethod call RegUnpack(Buf, OutData%ScaleMethod) if (RegCheckErr(Buf, RoutineName)) return - ! SF call RegUnpack(Buf, OutData%SF) if (RegCheckErr(Buf, RoutineName)) return - ! SigmaF call RegUnpack(Buf, OutData%SigmaF) if (RegCheckErr(Buf, RoutineName)) return - ! WindProfileType call RegUnpack(Buf, OutData%WindProfileType) if (RegCheckErr(Buf, RoutineName)) return - ! RefHt call RegUnpack(Buf, OutData%RefHt) if (RegCheckErr(Buf, RoutineName)) return - ! URef call RegUnpack(Buf, OutData%URef) if (RegCheckErr(Buf, RoutineName)) return - ! PLExp call RegUnpack(Buf, OutData%PLExp) if (RegCheckErr(Buf, RoutineName)) return - ! VLinShr call RegUnpack(Buf, OutData%VLinShr) if (RegCheckErr(Buf, RoutineName)) return - ! HLinShr call RegUnpack(Buf, OutData%HLinShr) if (RegCheckErr(Buf, RoutineName)) return - ! RefLength call RegUnpack(Buf, OutData%RefLength) if (RegCheckErr(Buf, RoutineName)) return - ! Z0 call RegUnpack(Buf, OutData%Z0) if (RegCheckErr(Buf, RoutineName)) return - ! XOffset call RegUnpack(Buf, OutData%XOffset) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE InflowWind_IO_CopyTurbSim_InitInputType( SrcTurbSim_InitInputTypeData, DstTurbSim_InitInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(TurbSim_InitInputType), INTENT(IN) :: SrcTurbSim_InitInputTypeData - TYPE(TurbSim_InitInputType), INTENT(INOUT) :: DstTurbSim_InitInputTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_CopyTurbSim_InitInputType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstTurbSim_InitInputTypeData%WindFileName = SrcTurbSim_InitInputTypeData%WindFileName - END SUBROUTINE InflowWind_IO_CopyTurbSim_InitInputType - - SUBROUTINE InflowWind_IO_DestroyTurbSim_InitInputType( TurbSim_InitInputTypeData, ErrStat, ErrMsg ) - TYPE(TurbSim_InitInputType), INTENT(INOUT) :: TurbSim_InitInputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_DestroyTurbSim_InitInputType' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE InflowWind_IO_DestroyTurbSim_InitInputType +subroutine InflowWind_IO_CopyTurbSim_InitInputType(SrcTurbSim_InitInputTypeData, DstTurbSim_InitInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(TurbSim_InitInputType), intent(in) :: SrcTurbSim_InitInputTypeData + type(TurbSim_InitInputType), intent(inout) :: DstTurbSim_InitInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_IO_CopyTurbSim_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' + DstTurbSim_InitInputTypeData%WindFileName = SrcTurbSim_InitInputTypeData%WindFileName +end subroutine +subroutine InflowWind_IO_DestroyTurbSim_InitInputType(TurbSim_InitInputTypeData, ErrStat, ErrMsg) + type(TurbSim_InitInputType), intent(inout) :: TurbSim_InitInputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_IO_DestroyTurbSim_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine InflowWind_IO_PackTurbSim_InitInputType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(TurbSim_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'InflowWind_IO_PackTurbSim_InitInputType' if (Buf%ErrStat >= AbortErrLev) return - ! WindFileName call RegPack(Buf, InData%WindFileName) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -647,69 +513,51 @@ subroutine InflowWind_IO_UnPackTurbSim_InitInputType(Buf, OutData) type(TurbSim_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackTurbSim_InitInputType' if (Buf%ErrStat /= ErrID_None) return - ! WindFileName call RegUnpack(Buf, OutData%WindFileName) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE InflowWind_IO_CopyBladed_InitInputType( SrcBladed_InitInputTypeData, DstBladed_InitInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Bladed_InitInputType), INTENT(IN) :: SrcBladed_InitInputTypeData - TYPE(Bladed_InitInputType), INTENT(INOUT) :: DstBladed_InitInputTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_CopyBladed_InitInputType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstBladed_InitInputTypeData%WindFileName = SrcBladed_InitInputTypeData%WindFileName - DstBladed_InitInputTypeData%WindType = SrcBladed_InitInputTypeData%WindType - DstBladed_InitInputTypeData%NativeBladedFmt = SrcBladed_InitInputTypeData%NativeBladedFmt - DstBladed_InitInputTypeData%TowerFileExist = SrcBladed_InitInputTypeData%TowerFileExist - DstBladed_InitInputTypeData%TurbineID = SrcBladed_InitInputTypeData%TurbineID - DstBladed_InitInputTypeData%FixedWindFileRootName = SrcBladed_InitInputTypeData%FixedWindFileRootName - END SUBROUTINE InflowWind_IO_CopyBladed_InitInputType - - SUBROUTINE InflowWind_IO_DestroyBladed_InitInputType( Bladed_InitInputTypeData, ErrStat, ErrMsg ) - TYPE(Bladed_InitInputType), INTENT(INOUT) :: Bladed_InitInputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_DestroyBladed_InitInputType' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE InflowWind_IO_DestroyBladed_InitInputType +subroutine InflowWind_IO_CopyBladed_InitInputType(SrcBladed_InitInputTypeData, DstBladed_InitInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(Bladed_InitInputType), intent(in) :: SrcBladed_InitInputTypeData + type(Bladed_InitInputType), intent(inout) :: DstBladed_InitInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_IO_CopyBladed_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' + DstBladed_InitInputTypeData%WindFileName = SrcBladed_InitInputTypeData%WindFileName + DstBladed_InitInputTypeData%WindType = SrcBladed_InitInputTypeData%WindType + DstBladed_InitInputTypeData%NativeBladedFmt = SrcBladed_InitInputTypeData%NativeBladedFmt + DstBladed_InitInputTypeData%TowerFileExist = SrcBladed_InitInputTypeData%TowerFileExist + DstBladed_InitInputTypeData%TurbineID = SrcBladed_InitInputTypeData%TurbineID + DstBladed_InitInputTypeData%FixedWindFileRootName = SrcBladed_InitInputTypeData%FixedWindFileRootName +end subroutine +subroutine InflowWind_IO_DestroyBladed_InitInputType(Bladed_InitInputTypeData, ErrStat, ErrMsg) + type(Bladed_InitInputType), intent(inout) :: Bladed_InitInputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_IO_DestroyBladed_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine InflowWind_IO_PackBladed_InitInputType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Bladed_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'InflowWind_IO_PackBladed_InitInputType' if (Buf%ErrStat >= AbortErrLev) return - ! WindFileName call RegPack(Buf, InData%WindFileName) if (RegCheckErr(Buf, RoutineName)) return - ! WindType call RegPack(Buf, InData%WindType) if (RegCheckErr(Buf, RoutineName)) return - ! NativeBladedFmt call RegPack(Buf, InData%NativeBladedFmt) if (RegCheckErr(Buf, RoutineName)) return - ! TowerFileExist call RegPack(Buf, InData%TowerFileExist) if (RegCheckErr(Buf, RoutineName)) return - ! TurbineID call RegPack(Buf, InData%TurbineID) if (RegCheckErr(Buf, RoutineName)) return - ! FixedWindFileRootName call RegPack(Buf, InData%FixedWindFileRootName) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -719,68 +567,49 @@ subroutine InflowWind_IO_UnPackBladed_InitInputType(Buf, OutData) type(Bladed_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackBladed_InitInputType' if (Buf%ErrStat /= ErrID_None) return - ! WindFileName call RegUnpack(Buf, OutData%WindFileName) if (RegCheckErr(Buf, RoutineName)) return - ! WindType call RegUnpack(Buf, OutData%WindType) if (RegCheckErr(Buf, RoutineName)) return - ! NativeBladedFmt call RegUnpack(Buf, OutData%NativeBladedFmt) if (RegCheckErr(Buf, RoutineName)) return - ! TowerFileExist call RegUnpack(Buf, OutData%TowerFileExist) if (RegCheckErr(Buf, RoutineName)) return - ! TurbineID call RegUnpack(Buf, OutData%TurbineID) if (RegCheckErr(Buf, RoutineName)) return - ! FixedWindFileRootName call RegUnpack(Buf, OutData%FixedWindFileRootName) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE InflowWind_IO_CopyBladed_InitOutputType( SrcBladed_InitOutputTypeData, DstBladed_InitOutputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Bladed_InitOutputType), INTENT(IN) :: SrcBladed_InitOutputTypeData - TYPE(Bladed_InitOutputType), INTENT(INOUT) :: DstBladed_InitOutputTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_CopyBladed_InitOutputType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstBladed_InitOutputTypeData%PropagationDir = SrcBladed_InitOutputTypeData%PropagationDir - DstBladed_InitOutputTypeData%VFlowAngle = SrcBladed_InitOutputTypeData%VFlowAngle - END SUBROUTINE InflowWind_IO_CopyBladed_InitOutputType - - SUBROUTINE InflowWind_IO_DestroyBladed_InitOutputType( Bladed_InitOutputTypeData, ErrStat, ErrMsg ) - TYPE(Bladed_InitOutputType), INTENT(INOUT) :: Bladed_InitOutputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_DestroyBladed_InitOutputType' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE InflowWind_IO_DestroyBladed_InitOutputType +subroutine InflowWind_IO_CopyBladed_InitOutputType(SrcBladed_InitOutputTypeData, DstBladed_InitOutputTypeData, CtrlCode, ErrStat, ErrMsg) + type(Bladed_InitOutputType), intent(in) :: SrcBladed_InitOutputTypeData + type(Bladed_InitOutputType), intent(inout) :: DstBladed_InitOutputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_IO_CopyBladed_InitOutputType' + ErrStat = ErrID_None + ErrMsg = '' + DstBladed_InitOutputTypeData%PropagationDir = SrcBladed_InitOutputTypeData%PropagationDir + DstBladed_InitOutputTypeData%VFlowAngle = SrcBladed_InitOutputTypeData%VFlowAngle +end subroutine +subroutine InflowWind_IO_DestroyBladed_InitOutputType(Bladed_InitOutputTypeData, ErrStat, ErrMsg) + type(Bladed_InitOutputType), intent(inout) :: Bladed_InitOutputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_IO_DestroyBladed_InitOutputType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine InflowWind_IO_PackBladed_InitOutputType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Bladed_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'InflowWind_IO_PackBladed_InitOutputType' if (Buf%ErrStat >= AbortErrLev) return - ! PropagationDir call RegPack(Buf, InData%PropagationDir) if (RegCheckErr(Buf, RoutineName)) return - ! VFlowAngle call RegPack(Buf, InData%VFlowAngle) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -790,85 +619,65 @@ subroutine InflowWind_IO_UnPackBladed_InitOutputType(Buf, OutData) type(Bladed_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackBladed_InitOutputType' if (Buf%ErrStat /= ErrID_None) return - ! PropagationDir call RegUnpack(Buf, OutData%PropagationDir) if (RegCheckErr(Buf, RoutineName)) return - ! VFlowAngle call RegUnpack(Buf, OutData%VFlowAngle) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE InflowWind_IO_CopyHAWC_InitInputType( SrcHAWC_InitInputTypeData, DstHAWC_InitInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HAWC_InitInputType), INTENT(IN) :: SrcHAWC_InitInputTypeData - TYPE(HAWC_InitInputType), INTENT(INOUT) :: DstHAWC_InitInputTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_CopyHAWC_InitInputType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstHAWC_InitInputTypeData%WindFileName = SrcHAWC_InitInputTypeData%WindFileName - DstHAWC_InitInputTypeData%nx = SrcHAWC_InitInputTypeData%nx - DstHAWC_InitInputTypeData%ny = SrcHAWC_InitInputTypeData%ny - DstHAWC_InitInputTypeData%nz = SrcHAWC_InitInputTypeData%nz - DstHAWC_InitInputTypeData%dx = SrcHAWC_InitInputTypeData%dx - DstHAWC_InitInputTypeData%dy = SrcHAWC_InitInputTypeData%dy - DstHAWC_InitInputTypeData%dz = SrcHAWC_InitInputTypeData%dz - CALL InflowWind_IO_Copygrid3d_initinputtype( SrcHAWC_InitInputTypeData%G3D, DstHAWC_InitInputTypeData%G3D, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE InflowWind_IO_CopyHAWC_InitInputType - - SUBROUTINE InflowWind_IO_DestroyHAWC_InitInputType( HAWC_InitInputTypeData, ErrStat, ErrMsg ) - TYPE(HAWC_InitInputType), INTENT(INOUT) :: HAWC_InitInputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_DestroyHAWC_InitInputType' - - ErrStat = ErrID_None - ErrMsg = "" - CALL InflowWind_IO_DestroyGrid3D_InitInputType( HAWC_InitInputTypeData%G3D, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE InflowWind_IO_DestroyHAWC_InitInputType +subroutine InflowWind_IO_CopyHAWC_InitInputType(SrcHAWC_InitInputTypeData, DstHAWC_InitInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(HAWC_InitInputType), intent(in) :: SrcHAWC_InitInputTypeData + type(HAWC_InitInputType), intent(inout) :: DstHAWC_InitInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_IO_CopyHAWC_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' + DstHAWC_InitInputTypeData%WindFileName = SrcHAWC_InitInputTypeData%WindFileName + DstHAWC_InitInputTypeData%nx = SrcHAWC_InitInputTypeData%nx + DstHAWC_InitInputTypeData%ny = SrcHAWC_InitInputTypeData%ny + DstHAWC_InitInputTypeData%nz = SrcHAWC_InitInputTypeData%nz + DstHAWC_InitInputTypeData%dx = SrcHAWC_InitInputTypeData%dx + DstHAWC_InitInputTypeData%dy = SrcHAWC_InitInputTypeData%dy + DstHAWC_InitInputTypeData%dz = SrcHAWC_InitInputTypeData%dz + call InflowWind_IO_CopyGrid3D_InitInputType(SrcHAWC_InitInputTypeData%G3D, DstHAWC_InitInputTypeData%G3D, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine InflowWind_IO_DestroyHAWC_InitInputType(HAWC_InitInputTypeData, ErrStat, ErrMsg) + type(HAWC_InitInputType), intent(inout) :: HAWC_InitInputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_IO_DestroyHAWC_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine InflowWind_IO_PackHAWC_InitInputType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(HAWC_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'InflowWind_IO_PackHAWC_InitInputType' if (Buf%ErrStat >= AbortErrLev) return - ! WindFileName call RegPack(Buf, InData%WindFileName) if (RegCheckErr(Buf, RoutineName)) return - ! nx call RegPack(Buf, InData%nx) if (RegCheckErr(Buf, RoutineName)) return - ! ny call RegPack(Buf, InData%ny) if (RegCheckErr(Buf, RoutineName)) return - ! nz call RegPack(Buf, InData%nz) if (RegCheckErr(Buf, RoutineName)) return - ! dx call RegPack(Buf, InData%dx) if (RegCheckErr(Buf, RoutineName)) return - ! dy call RegPack(Buf, InData%dy) if (RegCheckErr(Buf, RoutineName)) return - ! dz call RegPack(Buf, InData%dz) if (RegCheckErr(Buf, RoutineName)) return - ! G3D call InflowWind_IO_PackGrid3D_InitInputType(Buf, InData%G3D) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -878,69 +687,49 @@ subroutine InflowWind_IO_UnPackHAWC_InitInputType(Buf, OutData) type(HAWC_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackHAWC_InitInputType' if (Buf%ErrStat /= ErrID_None) return - ! WindFileName call RegUnpack(Buf, OutData%WindFileName) if (RegCheckErr(Buf, RoutineName)) return - ! nx call RegUnpack(Buf, OutData%nx) if (RegCheckErr(Buf, RoutineName)) return - ! ny call RegUnpack(Buf, OutData%ny) if (RegCheckErr(Buf, RoutineName)) return - ! nz call RegUnpack(Buf, OutData%nz) if (RegCheckErr(Buf, RoutineName)) return - ! dx call RegUnpack(Buf, OutData%dx) if (RegCheckErr(Buf, RoutineName)) return - ! dy call RegUnpack(Buf, OutData%dy) if (RegCheckErr(Buf, RoutineName)) return - ! dz call RegUnpack(Buf, OutData%dz) if (RegCheckErr(Buf, RoutineName)) return - ! G3D call InflowWind_IO_UnpackGrid3D_InitInputType(Buf, OutData%G3D) ! G3D end subroutine - SUBROUTINE InflowWind_IO_CopyUser_InitInputType( SrcUser_InitInputTypeData, DstUser_InitInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(User_InitInputType), INTENT(IN) :: SrcUser_InitInputTypeData - TYPE(User_InitInputType), INTENT(INOUT) :: DstUser_InitInputTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_CopyUser_InitInputType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstUser_InitInputTypeData%Dummy = SrcUser_InitInputTypeData%Dummy - END SUBROUTINE InflowWind_IO_CopyUser_InitInputType - - SUBROUTINE InflowWind_IO_DestroyUser_InitInputType( User_InitInputTypeData, ErrStat, ErrMsg ) - TYPE(User_InitInputType), INTENT(INOUT) :: User_InitInputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_DestroyUser_InitInputType' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE InflowWind_IO_DestroyUser_InitInputType +subroutine InflowWind_IO_CopyUser_InitInputType(SrcUser_InitInputTypeData, DstUser_InitInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(User_InitInputType), intent(in) :: SrcUser_InitInputTypeData + type(User_InitInputType), intent(inout) :: DstUser_InitInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_IO_CopyUser_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' + DstUser_InitInputTypeData%Dummy = SrcUser_InitInputTypeData%Dummy +end subroutine +subroutine InflowWind_IO_DestroyUser_InitInputType(User_InitInputTypeData, ErrStat, ErrMsg) + type(User_InitInputType), intent(inout) :: User_InitInputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_IO_DestroyUser_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine InflowWind_IO_PackUser_InitInputType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(User_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'InflowWind_IO_PackUser_InitInputType' if (Buf%ErrStat >= AbortErrLev) return - ! Dummy call RegPack(Buf, InData%Dummy) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -950,51 +739,36 @@ subroutine InflowWind_IO_UnPackUser_InitInputType(Buf, OutData) type(User_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackUser_InitInputType' if (Buf%ErrStat /= ErrID_None) return - ! Dummy call RegUnpack(Buf, OutData%Dummy) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE InflowWind_IO_CopyGrid4D_InitInputType( SrcGrid4D_InitInputTypeData, DstGrid4D_InitInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Grid4D_InitInputType), INTENT(IN) :: SrcGrid4D_InitInputTypeData - TYPE(Grid4D_InitInputType), INTENT(INOUT) :: DstGrid4D_InitInputTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_CopyGrid4D_InitInputType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstGrid4D_InitInputTypeData%n = SrcGrid4D_InitInputTypeData%n - DstGrid4D_InitInputTypeData%delta = SrcGrid4D_InitInputTypeData%delta - DstGrid4D_InitInputTypeData%pZero = SrcGrid4D_InitInputTypeData%pZero - DstGrid4D_InitInputTypeData%Vel => SrcGrid4D_InitInputTypeData%Vel - END SUBROUTINE InflowWind_IO_CopyGrid4D_InitInputType - - SUBROUTINE InflowWind_IO_DestroyGrid4D_InitInputType( Grid4D_InitInputTypeData, ErrStat, ErrMsg ) - TYPE(Grid4D_InitInputType), INTENT(INOUT) :: Grid4D_InitInputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_DestroyGrid4D_InitInputType' - - ErrStat = ErrID_None - ErrMsg = "" -NULLIFY(Grid4D_InitInputTypeData%Vel) - END SUBROUTINE InflowWind_IO_DestroyGrid4D_InitInputType +subroutine InflowWind_IO_CopyGrid4D_InitInputType(SrcGrid4D_InitInputTypeData, DstGrid4D_InitInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(Grid4D_InitInputType), intent(in) :: SrcGrid4D_InitInputTypeData + type(Grid4D_InitInputType), intent(inout) :: DstGrid4D_InitInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'InflowWind_IO_CopyGrid4D_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' + DstGrid4D_InitInputTypeData%n = SrcGrid4D_InitInputTypeData%n + DstGrid4D_InitInputTypeData%delta = SrcGrid4D_InitInputTypeData%delta + DstGrid4D_InitInputTypeData%pZero = SrcGrid4D_InitInputTypeData%pZero + DstGrid4D_InitInputTypeData%Vel => SrcGrid4D_InitInputTypeData%Vel +end subroutine +subroutine InflowWind_IO_DestroyGrid4D_InitInputType(Grid4D_InitInputTypeData, ErrStat, ErrMsg) + type(Grid4D_InitInputType), intent(inout) :: Grid4D_InitInputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_IO_DestroyGrid4D_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' + nullify(Grid4D_InitInputTypeData%Vel) +end subroutine subroutine InflowWind_IO_PackGrid4D_InitInputType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -1002,16 +776,12 @@ subroutine InflowWind_IO_PackGrid4D_InitInputType(Buf, Indata) character(*), parameter :: RoutineName = 'InflowWind_IO_PackGrid4D_InitInputType' logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return - ! n call RegPack(Buf, InData%n) if (RegCheckErr(Buf, RoutineName)) return - ! delta call RegPack(Buf, InData%delta) if (RegCheckErr(Buf, RoutineName)) return - ! pZero call RegPack(Buf, InData%pZero) if (RegCheckErr(Buf, RoutineName)) return - ! Vel call RegPack(Buf, associated(InData%Vel)) if (associated(InData%Vel)) then call RegPackBounds(Buf, 5, lbound(InData%Vel), ubound(InData%Vel)) @@ -1033,16 +803,12 @@ subroutine InflowWind_IO_UnPackGrid4D_InitInputType(Buf, OutData) integer(IntKi) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return - ! n call RegUnpack(Buf, OutData%n) if (RegCheckErr(Buf, RoutineName)) return - ! delta call RegUnpack(Buf, OutData%delta) if (RegCheckErr(Buf, RoutineName)) return - ! pZero call RegUnpack(Buf, OutData%pZero) if (RegCheckErr(Buf, RoutineName)) return - ! Vel if (associated(OutData%Vel)) deallocate(OutData%Vel) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1068,45 +834,33 @@ subroutine InflowWind_IO_UnPackGrid4D_InitInputType(Buf, OutData) OutData%Vel => null() end if end subroutine - SUBROUTINE InflowWind_IO_CopyPoints_InitInputType( SrcPoints_InitInputTypeData, DstPoints_InitInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Points_InitInputType), INTENT(IN) :: SrcPoints_InitInputTypeData - TYPE(Points_InitInputType), INTENT(INOUT) :: DstPoints_InitInputTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_CopyPoints_InitInputType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstPoints_InitInputTypeData%NumWindPoints = SrcPoints_InitInputTypeData%NumWindPoints - END SUBROUTINE InflowWind_IO_CopyPoints_InitInputType - - SUBROUTINE InflowWind_IO_DestroyPoints_InitInputType( Points_InitInputTypeData, ErrStat, ErrMsg ) - TYPE(Points_InitInputType), INTENT(INOUT) :: Points_InitInputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_DestroyPoints_InitInputType' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE InflowWind_IO_DestroyPoints_InitInputType +subroutine InflowWind_IO_CopyPoints_InitInputType(SrcPoints_InitInputTypeData, DstPoints_InitInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(Points_InitInputType), intent(in) :: SrcPoints_InitInputTypeData + type(Points_InitInputType), intent(inout) :: DstPoints_InitInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_IO_CopyPoints_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' + DstPoints_InitInputTypeData%NumWindPoints = SrcPoints_InitInputTypeData%NumWindPoints +end subroutine +subroutine InflowWind_IO_DestroyPoints_InitInputType(Points_InitInputTypeData, ErrStat, ErrMsg) + type(Points_InitInputType), intent(inout) :: Points_InitInputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_IO_DestroyPoints_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine InflowWind_IO_PackPoints_InitInputType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Points_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'InflowWind_IO_PackPoints_InitInputType' if (Buf%ErrStat >= AbortErrLev) return - ! NumWindPoints call RegPack(Buf, InData%NumWindPoints) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1116,7 +870,6 @@ subroutine InflowWind_IO_UnPackPoints_InitInputType(Buf, OutData) type(Points_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackPoints_InitInputType' if (Buf%ErrStat /= ErrID_None) return - ! NumWindPoints call RegUnpack(Buf, OutData%NumWindPoints) if (RegCheckErr(Buf, RoutineName)) return end subroutine diff --git a/modules/inflowwind/src/InflowWind_Types.f90 b/modules/inflowwind/src/InflowWind_Types.f90 index dfe8525dc1..06955f09bd 100644 --- a/modules/inflowwind/src/InflowWind_Types.f90 +++ b/modules/inflowwind/src/InflowWind_Types.f90 @@ -202,356 +202,315 @@ MODULE InflowWind_Types END TYPE InflowWind_MiscVarType ! ======================= CONTAINS - SUBROUTINE InflowWind_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) - TYPE(InflowWind_InputFile), INTENT(IN) :: SrcInputFileData - TYPE(InflowWind_InputFile), INTENT(INOUT) :: DstInputFileData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_CopyInputFile' -! + +subroutine InflowWind_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) + type(InflowWind_InputFile), intent(in) :: SrcInputFileData + type(InflowWind_InputFile), intent(inout) :: DstInputFileData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_CopyInputFile' ErrStat = ErrID_None - ErrMsg = "" - DstInputFileData%EchoFlag = SrcInputFileData%EchoFlag - DstInputFileData%WindType = SrcInputFileData%WindType - DstInputFileData%PropagationDir = SrcInputFileData%PropagationDir - DstInputFileData%VFlowAngle = SrcInputFileData%VFlowAngle - DstInputFileData%VelInterpCubic = SrcInputFileData%VelInterpCubic - DstInputFileData%NWindVel = SrcInputFileData%NWindVel -IF (ALLOCATED(SrcInputFileData%WindVxiList)) THEN - i1_l = LBOUND(SrcInputFileData%WindVxiList,1) - i1_u = UBOUND(SrcInputFileData%WindVxiList,1) - IF (.NOT. ALLOCATED(DstInputFileData%WindVxiList)) THEN - ALLOCATE(DstInputFileData%WindVxiList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WindVxiList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%WindVxiList = SrcInputFileData%WindVxiList -ENDIF -IF (ALLOCATED(SrcInputFileData%WindVyiList)) THEN - i1_l = LBOUND(SrcInputFileData%WindVyiList,1) - i1_u = UBOUND(SrcInputFileData%WindVyiList,1) - IF (.NOT. ALLOCATED(DstInputFileData%WindVyiList)) THEN - ALLOCATE(DstInputFileData%WindVyiList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WindVyiList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%WindVyiList = SrcInputFileData%WindVyiList -ENDIF -IF (ALLOCATED(SrcInputFileData%WindVziList)) THEN - i1_l = LBOUND(SrcInputFileData%WindVziList,1) - i1_u = UBOUND(SrcInputFileData%WindVziList,1) - IF (.NOT. ALLOCATED(DstInputFileData%WindVziList)) THEN - ALLOCATE(DstInputFileData%WindVziList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WindVziList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%WindVziList = SrcInputFileData%WindVziList -ENDIF - DstInputFileData%Steady_HWindSpeed = SrcInputFileData%Steady_HWindSpeed - DstInputFileData%Steady_RefHt = SrcInputFileData%Steady_RefHt - DstInputFileData%Steady_PLexp = SrcInputFileData%Steady_PLexp - DstInputFileData%Uniform_FileName = SrcInputFileData%Uniform_FileName - DstInputFileData%Uniform_RefHt = SrcInputFileData%Uniform_RefHt - DstInputFileData%Uniform_RefLength = SrcInputFileData%Uniform_RefLength - DstInputFileData%TSFF_FileName = SrcInputFileData%TSFF_FileName - DstInputFileData%BladedFF_FileName = SrcInputFileData%BladedFF_FileName - DstInputFileData%BladedFF_TowerFile = SrcInputFileData%BladedFF_TowerFile - DstInputFileData%CTTS_CoherentTurb = SrcInputFileData%CTTS_CoherentTurb - DstInputFileData%CTTS_FileName = SrcInputFileData%CTTS_FileName - DstInputFileData%CTTS_Path = SrcInputFileData%CTTS_Path - DstInputFileData%HAWC_FileName_u = SrcInputFileData%HAWC_FileName_u - DstInputFileData%HAWC_FileName_v = SrcInputFileData%HAWC_FileName_v - DstInputFileData%HAWC_FileName_w = SrcInputFileData%HAWC_FileName_w - DstInputFileData%HAWC_nx = SrcInputFileData%HAWC_nx - DstInputFileData%HAWC_ny = SrcInputFileData%HAWC_ny - DstInputFileData%HAWC_nz = SrcInputFileData%HAWC_nz - DstInputFileData%HAWC_dx = SrcInputFileData%HAWC_dx - DstInputFileData%HAWC_dy = SrcInputFileData%HAWC_dy - DstInputFileData%HAWC_dz = SrcInputFileData%HAWC_dz - DstInputFileData%SumPrint = SrcInputFileData%SumPrint - DstInputFileData%NumOuts = SrcInputFileData%NumOuts -IF (ALLOCATED(SrcInputFileData%OutList)) THEN - i1_l = LBOUND(SrcInputFileData%OutList,1) - i1_u = UBOUND(SrcInputFileData%OutList,1) - IF (.NOT. ALLOCATED(DstInputFileData%OutList)) THEN - ALLOCATE(DstInputFileData%OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%OutList = SrcInputFileData%OutList -ENDIF - DstInputFileData%SensorType = SrcInputFileData%SensorType - DstInputFileData%NumBeam = SrcInputFileData%NumBeam - DstInputFileData%NumPulseGate = SrcInputFileData%NumPulseGate - DstInputFileData%RotorApexOffsetPos = SrcInputFileData%RotorApexOffsetPos -IF (ALLOCATED(SrcInputFileData%FocalDistanceX)) THEN - i1_l = LBOUND(SrcInputFileData%FocalDistanceX,1) - i1_u = UBOUND(SrcInputFileData%FocalDistanceX,1) - IF (.NOT. ALLOCATED(DstInputFileData%FocalDistanceX)) THEN - ALLOCATE(DstInputFileData%FocalDistanceX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%FocalDistanceX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%FocalDistanceX = SrcInputFileData%FocalDistanceX -ENDIF -IF (ALLOCATED(SrcInputFileData%FocalDistanceY)) THEN - i1_l = LBOUND(SrcInputFileData%FocalDistanceY,1) - i1_u = UBOUND(SrcInputFileData%FocalDistanceY,1) - IF (.NOT. ALLOCATED(DstInputFileData%FocalDistanceY)) THEN - ALLOCATE(DstInputFileData%FocalDistanceY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%FocalDistanceY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%FocalDistanceY = SrcInputFileData%FocalDistanceY -ENDIF -IF (ALLOCATED(SrcInputFileData%FocalDistanceZ)) THEN - i1_l = LBOUND(SrcInputFileData%FocalDistanceZ,1) - i1_u = UBOUND(SrcInputFileData%FocalDistanceZ,1) - IF (.NOT. ALLOCATED(DstInputFileData%FocalDistanceZ)) THEN - ALLOCATE(DstInputFileData%FocalDistanceZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%FocalDistanceZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%FocalDistanceZ = SrcInputFileData%FocalDistanceZ -ENDIF - DstInputFileData%PulseSpacing = SrcInputFileData%PulseSpacing - DstInputFileData%MeasurementInterval = SrcInputFileData%MeasurementInterval - DstInputFileData%URefLid = SrcInputFileData%URefLid - DstInputFileData%LidRadialVel = SrcInputFileData%LidRadialVel - DstInputFileData%ConsiderHubMotion = SrcInputFileData%ConsiderHubMotion - CALL InflowWind_IO_Copygrid3d_initinputtype( SrcInputFileData%FF, DstInputFileData%FF, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE InflowWind_CopyInputFile - - SUBROUTINE InflowWind_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) - TYPE(InflowWind_InputFile), INTENT(INOUT) :: InputFileData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_DestroyInputFile' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputFileData%WindVxiList)) THEN - DEALLOCATE(InputFileData%WindVxiList) -ENDIF -IF (ALLOCATED(InputFileData%WindVyiList)) THEN - DEALLOCATE(InputFileData%WindVyiList) -ENDIF -IF (ALLOCATED(InputFileData%WindVziList)) THEN - DEALLOCATE(InputFileData%WindVziList) -ENDIF -IF (ALLOCATED(InputFileData%OutList)) THEN - DEALLOCATE(InputFileData%OutList) -ENDIF -IF (ALLOCATED(InputFileData%FocalDistanceX)) THEN - DEALLOCATE(InputFileData%FocalDistanceX) -ENDIF -IF (ALLOCATED(InputFileData%FocalDistanceY)) THEN - DEALLOCATE(InputFileData%FocalDistanceY) -ENDIF -IF (ALLOCATED(InputFileData%FocalDistanceZ)) THEN - DEALLOCATE(InputFileData%FocalDistanceZ) -ENDIF - CALL InflowWind_IO_DestroyGrid3D_InitInputType( InputFileData%FF, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE InflowWind_DestroyInputFile + ErrMsg = '' + DstInputFileData%EchoFlag = SrcInputFileData%EchoFlag + DstInputFileData%WindType = SrcInputFileData%WindType + DstInputFileData%PropagationDir = SrcInputFileData%PropagationDir + DstInputFileData%VFlowAngle = SrcInputFileData%VFlowAngle + DstInputFileData%VelInterpCubic = SrcInputFileData%VelInterpCubic + DstInputFileData%NWindVel = SrcInputFileData%NWindVel + if (allocated(SrcInputFileData%WindVxiList)) then + LB(1:1) = lbound(SrcInputFileData%WindVxiList) + UB(1:1) = ubound(SrcInputFileData%WindVxiList) + if (.not. allocated(DstInputFileData%WindVxiList)) then + allocate(DstInputFileData%WindVxiList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WindVxiList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%WindVxiList = SrcInputFileData%WindVxiList + else if (allocated(DstInputFileData%WindVxiList)) then + deallocate(DstInputFileData%WindVxiList) + end if + if (allocated(SrcInputFileData%WindVyiList)) then + LB(1:1) = lbound(SrcInputFileData%WindVyiList) + UB(1:1) = ubound(SrcInputFileData%WindVyiList) + if (.not. allocated(DstInputFileData%WindVyiList)) then + allocate(DstInputFileData%WindVyiList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WindVyiList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%WindVyiList = SrcInputFileData%WindVyiList + else if (allocated(DstInputFileData%WindVyiList)) then + deallocate(DstInputFileData%WindVyiList) + end if + if (allocated(SrcInputFileData%WindVziList)) then + LB(1:1) = lbound(SrcInputFileData%WindVziList) + UB(1:1) = ubound(SrcInputFileData%WindVziList) + if (.not. allocated(DstInputFileData%WindVziList)) then + allocate(DstInputFileData%WindVziList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WindVziList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%WindVziList = SrcInputFileData%WindVziList + else if (allocated(DstInputFileData%WindVziList)) then + deallocate(DstInputFileData%WindVziList) + end if + DstInputFileData%Steady_HWindSpeed = SrcInputFileData%Steady_HWindSpeed + DstInputFileData%Steady_RefHt = SrcInputFileData%Steady_RefHt + DstInputFileData%Steady_PLexp = SrcInputFileData%Steady_PLexp + DstInputFileData%Uniform_FileName = SrcInputFileData%Uniform_FileName + DstInputFileData%Uniform_RefHt = SrcInputFileData%Uniform_RefHt + DstInputFileData%Uniform_RefLength = SrcInputFileData%Uniform_RefLength + DstInputFileData%TSFF_FileName = SrcInputFileData%TSFF_FileName + DstInputFileData%BladedFF_FileName = SrcInputFileData%BladedFF_FileName + DstInputFileData%BladedFF_TowerFile = SrcInputFileData%BladedFF_TowerFile + DstInputFileData%CTTS_CoherentTurb = SrcInputFileData%CTTS_CoherentTurb + DstInputFileData%CTTS_FileName = SrcInputFileData%CTTS_FileName + DstInputFileData%CTTS_Path = SrcInputFileData%CTTS_Path + DstInputFileData%HAWC_FileName_u = SrcInputFileData%HAWC_FileName_u + DstInputFileData%HAWC_FileName_v = SrcInputFileData%HAWC_FileName_v + DstInputFileData%HAWC_FileName_w = SrcInputFileData%HAWC_FileName_w + DstInputFileData%HAWC_nx = SrcInputFileData%HAWC_nx + DstInputFileData%HAWC_ny = SrcInputFileData%HAWC_ny + DstInputFileData%HAWC_nz = SrcInputFileData%HAWC_nz + DstInputFileData%HAWC_dx = SrcInputFileData%HAWC_dx + DstInputFileData%HAWC_dy = SrcInputFileData%HAWC_dy + DstInputFileData%HAWC_dz = SrcInputFileData%HAWC_dz + DstInputFileData%SumPrint = SrcInputFileData%SumPrint + DstInputFileData%NumOuts = SrcInputFileData%NumOuts + if (allocated(SrcInputFileData%OutList)) then + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) + if (.not. allocated(DstInputFileData%OutList)) then + allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%OutList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%OutList = SrcInputFileData%OutList + else if (allocated(DstInputFileData%OutList)) then + deallocate(DstInputFileData%OutList) + end if + DstInputFileData%SensorType = SrcInputFileData%SensorType + DstInputFileData%NumBeam = SrcInputFileData%NumBeam + DstInputFileData%NumPulseGate = SrcInputFileData%NumPulseGate + DstInputFileData%RotorApexOffsetPos = SrcInputFileData%RotorApexOffsetPos + if (allocated(SrcInputFileData%FocalDistanceX)) then + LB(1:1) = lbound(SrcInputFileData%FocalDistanceX) + UB(1:1) = ubound(SrcInputFileData%FocalDistanceX) + if (.not. allocated(DstInputFileData%FocalDistanceX)) then + allocate(DstInputFileData%FocalDistanceX(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%FocalDistanceX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%FocalDistanceX = SrcInputFileData%FocalDistanceX + else if (allocated(DstInputFileData%FocalDistanceX)) then + deallocate(DstInputFileData%FocalDistanceX) + end if + if (allocated(SrcInputFileData%FocalDistanceY)) then + LB(1:1) = lbound(SrcInputFileData%FocalDistanceY) + UB(1:1) = ubound(SrcInputFileData%FocalDistanceY) + if (.not. allocated(DstInputFileData%FocalDistanceY)) then + allocate(DstInputFileData%FocalDistanceY(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%FocalDistanceY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%FocalDistanceY = SrcInputFileData%FocalDistanceY + else if (allocated(DstInputFileData%FocalDistanceY)) then + deallocate(DstInputFileData%FocalDistanceY) + end if + if (allocated(SrcInputFileData%FocalDistanceZ)) then + LB(1:1) = lbound(SrcInputFileData%FocalDistanceZ) + UB(1:1) = ubound(SrcInputFileData%FocalDistanceZ) + if (.not. allocated(DstInputFileData%FocalDistanceZ)) then + allocate(DstInputFileData%FocalDistanceZ(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%FocalDistanceZ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%FocalDistanceZ = SrcInputFileData%FocalDistanceZ + else if (allocated(DstInputFileData%FocalDistanceZ)) then + deallocate(DstInputFileData%FocalDistanceZ) + end if + DstInputFileData%PulseSpacing = SrcInputFileData%PulseSpacing + DstInputFileData%MeasurementInterval = SrcInputFileData%MeasurementInterval + DstInputFileData%URefLid = SrcInputFileData%URefLid + DstInputFileData%LidRadialVel = SrcInputFileData%LidRadialVel + DstInputFileData%ConsiderHubMotion = SrcInputFileData%ConsiderHubMotion + call InflowWind_IO_CopyGrid3D_InitInputType(SrcInputFileData%FF, DstInputFileData%FF, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine InflowWind_DestroyInputFile(InputFileData, ErrStat, ErrMsg) + type(InflowWind_InputFile), intent(inout) :: InputFileData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_DestroyInputFile' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputFileData%WindVxiList)) then + deallocate(InputFileData%WindVxiList) + end if + if (allocated(InputFileData%WindVyiList)) then + deallocate(InputFileData%WindVyiList) + end if + if (allocated(InputFileData%WindVziList)) then + deallocate(InputFileData%WindVziList) + end if + if (allocated(InputFileData%OutList)) then + deallocate(InputFileData%OutList) + end if + if (allocated(InputFileData%FocalDistanceX)) then + deallocate(InputFileData%FocalDistanceX) + end if + if (allocated(InputFileData%FocalDistanceY)) then + deallocate(InputFileData%FocalDistanceY) + end if + if (allocated(InputFileData%FocalDistanceZ)) then + deallocate(InputFileData%FocalDistanceZ) + end if +end subroutine subroutine InflowWind_PackInputFile(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(InflowWind_InputFile), intent(in) :: InData character(*), parameter :: RoutineName = 'InflowWind_PackInputFile' if (Buf%ErrStat >= AbortErrLev) return - ! EchoFlag call RegPack(Buf, InData%EchoFlag) if (RegCheckErr(Buf, RoutineName)) return - ! WindType call RegPack(Buf, InData%WindType) if (RegCheckErr(Buf, RoutineName)) return - ! PropagationDir call RegPack(Buf, InData%PropagationDir) if (RegCheckErr(Buf, RoutineName)) return - ! VFlowAngle call RegPack(Buf, InData%VFlowAngle) if (RegCheckErr(Buf, RoutineName)) return - ! VelInterpCubic call RegPack(Buf, InData%VelInterpCubic) if (RegCheckErr(Buf, RoutineName)) return - ! NWindVel call RegPack(Buf, InData%NWindVel) if (RegCheckErr(Buf, RoutineName)) return - ! WindVxiList call RegPack(Buf, allocated(InData%WindVxiList)) if (allocated(InData%WindVxiList)) then call RegPackBounds(Buf, 1, lbound(InData%WindVxiList), ubound(InData%WindVxiList)) call RegPack(Buf, InData%WindVxiList) end if if (RegCheckErr(Buf, RoutineName)) return - ! WindVyiList call RegPack(Buf, allocated(InData%WindVyiList)) if (allocated(InData%WindVyiList)) then call RegPackBounds(Buf, 1, lbound(InData%WindVyiList), ubound(InData%WindVyiList)) call RegPack(Buf, InData%WindVyiList) end if if (RegCheckErr(Buf, RoutineName)) return - ! WindVziList call RegPack(Buf, allocated(InData%WindVziList)) if (allocated(InData%WindVziList)) then call RegPackBounds(Buf, 1, lbound(InData%WindVziList), ubound(InData%WindVziList)) call RegPack(Buf, InData%WindVziList) end if if (RegCheckErr(Buf, RoutineName)) return - ! Steady_HWindSpeed call RegPack(Buf, InData%Steady_HWindSpeed) if (RegCheckErr(Buf, RoutineName)) return - ! Steady_RefHt call RegPack(Buf, InData%Steady_RefHt) if (RegCheckErr(Buf, RoutineName)) return - ! Steady_PLexp call RegPack(Buf, InData%Steady_PLexp) if (RegCheckErr(Buf, RoutineName)) return - ! Uniform_FileName call RegPack(Buf, InData%Uniform_FileName) if (RegCheckErr(Buf, RoutineName)) return - ! Uniform_RefHt call RegPack(Buf, InData%Uniform_RefHt) if (RegCheckErr(Buf, RoutineName)) return - ! Uniform_RefLength call RegPack(Buf, InData%Uniform_RefLength) if (RegCheckErr(Buf, RoutineName)) return - ! TSFF_FileName call RegPack(Buf, InData%TSFF_FileName) if (RegCheckErr(Buf, RoutineName)) return - ! BladedFF_FileName call RegPack(Buf, InData%BladedFF_FileName) if (RegCheckErr(Buf, RoutineName)) return - ! BladedFF_TowerFile call RegPack(Buf, InData%BladedFF_TowerFile) if (RegCheckErr(Buf, RoutineName)) return - ! CTTS_CoherentTurb call RegPack(Buf, InData%CTTS_CoherentTurb) if (RegCheckErr(Buf, RoutineName)) return - ! CTTS_FileName call RegPack(Buf, InData%CTTS_FileName) if (RegCheckErr(Buf, RoutineName)) return - ! CTTS_Path call RegPack(Buf, InData%CTTS_Path) if (RegCheckErr(Buf, RoutineName)) return - ! HAWC_FileName_u call RegPack(Buf, InData%HAWC_FileName_u) if (RegCheckErr(Buf, RoutineName)) return - ! HAWC_FileName_v call RegPack(Buf, InData%HAWC_FileName_v) if (RegCheckErr(Buf, RoutineName)) return - ! HAWC_FileName_w call RegPack(Buf, InData%HAWC_FileName_w) if (RegCheckErr(Buf, RoutineName)) return - ! HAWC_nx call RegPack(Buf, InData%HAWC_nx) if (RegCheckErr(Buf, RoutineName)) return - ! HAWC_ny call RegPack(Buf, InData%HAWC_ny) if (RegCheckErr(Buf, RoutineName)) return - ! HAWC_nz call RegPack(Buf, InData%HAWC_nz) if (RegCheckErr(Buf, RoutineName)) return - ! HAWC_dx call RegPack(Buf, InData%HAWC_dx) if (RegCheckErr(Buf, RoutineName)) return - ! HAWC_dy call RegPack(Buf, InData%HAWC_dy) if (RegCheckErr(Buf, RoutineName)) return - ! HAWC_dz call RegPack(Buf, InData%HAWC_dz) if (RegCheckErr(Buf, RoutineName)) return - ! SumPrint call RegPack(Buf, InData%SumPrint) if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegPack(Buf, InData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! OutList call RegPack(Buf, allocated(InData%OutList)) if (allocated(InData%OutList)) then call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) call RegPack(Buf, InData%OutList) end if if (RegCheckErr(Buf, RoutineName)) return - ! SensorType call RegPack(Buf, InData%SensorType) if (RegCheckErr(Buf, RoutineName)) return - ! NumBeam call RegPack(Buf, InData%NumBeam) if (RegCheckErr(Buf, RoutineName)) return - ! NumPulseGate call RegPack(Buf, InData%NumPulseGate) if (RegCheckErr(Buf, RoutineName)) return - ! RotorApexOffsetPos call RegPack(Buf, InData%RotorApexOffsetPos) if (RegCheckErr(Buf, RoutineName)) return - ! FocalDistanceX call RegPack(Buf, allocated(InData%FocalDistanceX)) if (allocated(InData%FocalDistanceX)) then call RegPackBounds(Buf, 1, lbound(InData%FocalDistanceX), ubound(InData%FocalDistanceX)) call RegPack(Buf, InData%FocalDistanceX) end if if (RegCheckErr(Buf, RoutineName)) return - ! FocalDistanceY call RegPack(Buf, allocated(InData%FocalDistanceY)) if (allocated(InData%FocalDistanceY)) then call RegPackBounds(Buf, 1, lbound(InData%FocalDistanceY), ubound(InData%FocalDistanceY)) call RegPack(Buf, InData%FocalDistanceY) end if if (RegCheckErr(Buf, RoutineName)) return - ! FocalDistanceZ call RegPack(Buf, allocated(InData%FocalDistanceZ)) if (allocated(InData%FocalDistanceZ)) then call RegPackBounds(Buf, 1, lbound(InData%FocalDistanceZ), ubound(InData%FocalDistanceZ)) call RegPack(Buf, InData%FocalDistanceZ) end if if (RegCheckErr(Buf, RoutineName)) return - ! PulseSpacing call RegPack(Buf, InData%PulseSpacing) if (RegCheckErr(Buf, RoutineName)) return - ! MeasurementInterval call RegPack(Buf, InData%MeasurementInterval) if (RegCheckErr(Buf, RoutineName)) return - ! URefLid call RegPack(Buf, InData%URefLid) if (RegCheckErr(Buf, RoutineName)) return - ! LidRadialVel call RegPack(Buf, InData%LidRadialVel) if (RegCheckErr(Buf, RoutineName)) return - ! ConsiderHubMotion call RegPack(Buf, InData%ConsiderHubMotion) if (RegCheckErr(Buf, RoutineName)) return - ! FF call InflowWind_IO_PackGrid3D_InitInputType(Buf, InData%FF) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -564,25 +523,18 @@ subroutine InflowWind_UnPackInputFile(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! EchoFlag call RegUnpack(Buf, OutData%EchoFlag) if (RegCheckErr(Buf, RoutineName)) return - ! WindType call RegUnpack(Buf, OutData%WindType) if (RegCheckErr(Buf, RoutineName)) return - ! PropagationDir call RegUnpack(Buf, OutData%PropagationDir) if (RegCheckErr(Buf, RoutineName)) return - ! VFlowAngle call RegUnpack(Buf, OutData%VFlowAngle) if (RegCheckErr(Buf, RoutineName)) return - ! VelInterpCubic call RegUnpack(Buf, OutData%VelInterpCubic) if (RegCheckErr(Buf, RoutineName)) return - ! NWindVel call RegUnpack(Buf, OutData%NWindVel) if (RegCheckErr(Buf, RoutineName)) return - ! WindVxiList if (allocated(OutData%WindVxiList)) deallocate(OutData%WindVxiList) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -597,7 +549,6 @@ subroutine InflowWind_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%WindVxiList) if (RegCheckErr(Buf, RoutineName)) return end if - ! WindVyiList if (allocated(OutData%WindVyiList)) deallocate(OutData%WindVyiList) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -612,7 +563,6 @@ subroutine InflowWind_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%WindVyiList) if (RegCheckErr(Buf, RoutineName)) return end if - ! WindVziList if (allocated(OutData%WindVziList)) deallocate(OutData%WindVziList) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -627,76 +577,52 @@ subroutine InflowWind_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%WindVziList) if (RegCheckErr(Buf, RoutineName)) return end if - ! Steady_HWindSpeed call RegUnpack(Buf, OutData%Steady_HWindSpeed) if (RegCheckErr(Buf, RoutineName)) return - ! Steady_RefHt call RegUnpack(Buf, OutData%Steady_RefHt) if (RegCheckErr(Buf, RoutineName)) return - ! Steady_PLexp call RegUnpack(Buf, OutData%Steady_PLexp) if (RegCheckErr(Buf, RoutineName)) return - ! Uniform_FileName call RegUnpack(Buf, OutData%Uniform_FileName) if (RegCheckErr(Buf, RoutineName)) return - ! Uniform_RefHt call RegUnpack(Buf, OutData%Uniform_RefHt) if (RegCheckErr(Buf, RoutineName)) return - ! Uniform_RefLength call RegUnpack(Buf, OutData%Uniform_RefLength) if (RegCheckErr(Buf, RoutineName)) return - ! TSFF_FileName call RegUnpack(Buf, OutData%TSFF_FileName) if (RegCheckErr(Buf, RoutineName)) return - ! BladedFF_FileName call RegUnpack(Buf, OutData%BladedFF_FileName) if (RegCheckErr(Buf, RoutineName)) return - ! BladedFF_TowerFile call RegUnpack(Buf, OutData%BladedFF_TowerFile) if (RegCheckErr(Buf, RoutineName)) return - ! CTTS_CoherentTurb call RegUnpack(Buf, OutData%CTTS_CoherentTurb) if (RegCheckErr(Buf, RoutineName)) return - ! CTTS_FileName call RegUnpack(Buf, OutData%CTTS_FileName) if (RegCheckErr(Buf, RoutineName)) return - ! CTTS_Path call RegUnpack(Buf, OutData%CTTS_Path) if (RegCheckErr(Buf, RoutineName)) return - ! HAWC_FileName_u call RegUnpack(Buf, OutData%HAWC_FileName_u) if (RegCheckErr(Buf, RoutineName)) return - ! HAWC_FileName_v call RegUnpack(Buf, OutData%HAWC_FileName_v) if (RegCheckErr(Buf, RoutineName)) return - ! HAWC_FileName_w call RegUnpack(Buf, OutData%HAWC_FileName_w) if (RegCheckErr(Buf, RoutineName)) return - ! HAWC_nx call RegUnpack(Buf, OutData%HAWC_nx) if (RegCheckErr(Buf, RoutineName)) return - ! HAWC_ny call RegUnpack(Buf, OutData%HAWC_ny) if (RegCheckErr(Buf, RoutineName)) return - ! HAWC_nz call RegUnpack(Buf, OutData%HAWC_nz) if (RegCheckErr(Buf, RoutineName)) return - ! HAWC_dx call RegUnpack(Buf, OutData%HAWC_dx) if (RegCheckErr(Buf, RoutineName)) return - ! HAWC_dy call RegUnpack(Buf, OutData%HAWC_dy) if (RegCheckErr(Buf, RoutineName)) return - ! HAWC_dz call RegUnpack(Buf, OutData%HAWC_dz) if (RegCheckErr(Buf, RoutineName)) return - ! SumPrint call RegUnpack(Buf, OutData%SumPrint) if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegUnpack(Buf, OutData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! OutList if (allocated(OutData%OutList)) deallocate(OutData%OutList) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -711,19 +637,14 @@ subroutine InflowWind_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%OutList) if (RegCheckErr(Buf, RoutineName)) return end if - ! SensorType call RegUnpack(Buf, OutData%SensorType) if (RegCheckErr(Buf, RoutineName)) return - ! NumBeam call RegUnpack(Buf, OutData%NumBeam) if (RegCheckErr(Buf, RoutineName)) return - ! NumPulseGate call RegUnpack(Buf, OutData%NumPulseGate) if (RegCheckErr(Buf, RoutineName)) return - ! RotorApexOffsetPos call RegUnpack(Buf, OutData%RotorApexOffsetPos) if (RegCheckErr(Buf, RoutineName)) return - ! FocalDistanceX if (allocated(OutData%FocalDistanceX)) deallocate(OutData%FocalDistanceX) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -738,7 +659,6 @@ subroutine InflowWind_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%FocalDistanceX) if (RegCheckErr(Buf, RoutineName)) return end if - ! FocalDistanceY if (allocated(OutData%FocalDistanceY)) deallocate(OutData%FocalDistanceY) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -753,7 +673,6 @@ subroutine InflowWind_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%FocalDistanceY) if (RegCheckErr(Buf, RoutineName)) return end if - ! FocalDistanceZ if (allocated(OutData%FocalDistanceZ)) deallocate(OutData%FocalDistanceZ) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -768,155 +687,114 @@ subroutine InflowWind_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%FocalDistanceZ) if (RegCheckErr(Buf, RoutineName)) return end if - ! PulseSpacing call RegUnpack(Buf, OutData%PulseSpacing) if (RegCheckErr(Buf, RoutineName)) return - ! MeasurementInterval call RegUnpack(Buf, OutData%MeasurementInterval) if (RegCheckErr(Buf, RoutineName)) return - ! URefLid call RegUnpack(Buf, OutData%URefLid) if (RegCheckErr(Buf, RoutineName)) return - ! LidRadialVel call RegUnpack(Buf, OutData%LidRadialVel) if (RegCheckErr(Buf, RoutineName)) return - ! ConsiderHubMotion call RegUnpack(Buf, OutData%ConsiderHubMotion) if (RegCheckErr(Buf, RoutineName)) return - ! FF call InflowWind_IO_UnpackGrid3D_InitInputType(Buf, OutData%FF) ! FF end subroutine - SUBROUTINE InflowWind_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(InflowWind_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(InflowWind_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_CopyInitInput' -! + +subroutine InflowWind_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(InflowWind_InitInputType), intent(in) :: SrcInitInputData + type(InflowWind_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFileName = SrcInitInputData%InputFileName - DstInitInputData%Linearize = SrcInitInputData%Linearize - DstInitInputData%Use4Dext = SrcInitInputData%Use4Dext - DstInitInputData%NumWindPoints = SrcInitInputData%NumWindPoints - DstInitInputData%TurbineID = SrcInitInputData%TurbineID - DstInitInputData%FixedWindFileRootName = SrcInitInputData%FixedWindFileRootName - DstInitInputData%UseInputFile = SrcInitInputData%UseInputFile - DstInitInputData%RootName = SrcInitInputData%RootName - CALL NWTC_Library_Copyfileinfotype( SrcInitInputData%PassedFileData, DstInitInputData%PassedFileData, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitInputData%WindType2UseInputFile = SrcInitInputData%WindType2UseInputFile - CALL NWTC_Library_Copyfileinfotype( SrcInitInputData%WindType2Data, DstInitInputData%WindType2Data, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitInputData%OutputAccel = SrcInitInputData%OutputAccel - CALL Lidar_CopyInitInput( SrcInitInputData%lidar, DstInitInputData%lidar, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_IO_Copygrid4d_initinputtype( SrcInitInputData%FDext, DstInitInputData%FDext, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitInputData%RadAvg = SrcInitInputData%RadAvg - DstInitInputData%MHK = SrcInitInputData%MHK - DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth - DstInitInputData%MSL2SWL = SrcInitInputData%MSL2SWL - DstInitInputData%BoxExceedAllowIdx = SrcInitInputData%BoxExceedAllowIdx - DstInitInputData%BoxExceedAllowF = SrcInitInputData%BoxExceedAllowF - END SUBROUTINE InflowWind_CopyInitInput - - SUBROUTINE InflowWind_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(InflowWind_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL NWTC_Library_DestroyFileInfoType( InitInputData%PassedFileData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyFileInfoType( InitInputData%WindType2Data, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Lidar_DestroyInitInput( InitInputData%lidar, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_IO_DestroyGrid4D_InitInputType( InitInputData%FDext, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE InflowWind_DestroyInitInput + ErrMsg = '' + DstInitInputData%InputFileName = SrcInitInputData%InputFileName + DstInitInputData%Linearize = SrcInitInputData%Linearize + DstInitInputData%Use4Dext = SrcInitInputData%Use4Dext + DstInitInputData%NumWindPoints = SrcInitInputData%NumWindPoints + DstInitInputData%TurbineID = SrcInitInputData%TurbineID + DstInitInputData%FixedWindFileRootName = SrcInitInputData%FixedWindFileRootName + DstInitInputData%UseInputFile = SrcInitInputData%UseInputFile + DstInitInputData%RootName = SrcInitInputData%RootName + call NWTC_Library_CopyFileInfoType(SrcInitInputData%PassedFileData, DstInitInputData%PassedFileData, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitInputData%WindType2UseInputFile = SrcInitInputData%WindType2UseInputFile + call NWTC_Library_CopyFileInfoType(SrcInitInputData%WindType2Data, DstInitInputData%WindType2Data, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitInputData%OutputAccel = SrcInitInputData%OutputAccel + call Lidar_CopyInitInput(SrcInitInputData%lidar, DstInitInputData%lidar, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_IO_CopyGrid4D_InitInputType(SrcInitInputData%FDext, DstInitInputData%FDext, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitInputData%RadAvg = SrcInitInputData%RadAvg + DstInitInputData%MHK = SrcInitInputData%MHK + DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth + DstInitInputData%MSL2SWL = SrcInitInputData%MSL2SWL + DstInitInputData%BoxExceedAllowIdx = SrcInitInputData%BoxExceedAllowIdx + DstInitInputData%BoxExceedAllowF = SrcInitInputData%BoxExceedAllowF +end subroutine +subroutine InflowWind_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(InflowWind_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine InflowWind_PackInitInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(InflowWind_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'InflowWind_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return - ! InputFileName call RegPack(Buf, InData%InputFileName) if (RegCheckErr(Buf, RoutineName)) return - ! Linearize call RegPack(Buf, InData%Linearize) if (RegCheckErr(Buf, RoutineName)) return - ! Use4Dext call RegPack(Buf, InData%Use4Dext) if (RegCheckErr(Buf, RoutineName)) return - ! NumWindPoints call RegPack(Buf, InData%NumWindPoints) if (RegCheckErr(Buf, RoutineName)) return - ! TurbineID call RegPack(Buf, InData%TurbineID) if (RegCheckErr(Buf, RoutineName)) return - ! FixedWindFileRootName call RegPack(Buf, InData%FixedWindFileRootName) if (RegCheckErr(Buf, RoutineName)) return - ! UseInputFile call RegPack(Buf, InData%UseInputFile) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegPack(Buf, InData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! PassedFileData call NWTC_Library_PackFileInfoType(Buf, InData%PassedFileData) if (RegCheckErr(Buf, RoutineName)) return - ! WindType2UseInputFile call RegPack(Buf, InData%WindType2UseInputFile) if (RegCheckErr(Buf, RoutineName)) return - ! WindType2Data call NWTC_Library_PackFileInfoType(Buf, InData%WindType2Data) if (RegCheckErr(Buf, RoutineName)) return - ! OutputAccel call RegPack(Buf, InData%OutputAccel) if (RegCheckErr(Buf, RoutineName)) return - ! lidar call Lidar_PackInitInput(Buf, InData%lidar) if (RegCheckErr(Buf, RoutineName)) return - ! FDext call InflowWind_IO_PackGrid4D_InitInputType(Buf, InData%FDext) if (RegCheckErr(Buf, RoutineName)) return - ! RadAvg call RegPack(Buf, InData%RadAvg) if (RegCheckErr(Buf, RoutineName)) return - ! MHK call RegPack(Buf, InData%MHK) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDpth call RegPack(Buf, InData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - ! MSL2SWL call RegPack(Buf, InData%MSL2SWL) if (RegCheckErr(Buf, RoutineName)) return - ! BoxExceedAllowIdx call RegPack(Buf, InData%BoxExceedAllowIdx) if (RegCheckErr(Buf, RoutineName)) return - ! BoxExceedAllowF call RegPack(Buf, InData%BoxExceedAllowF) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -926,212 +804,195 @@ subroutine InflowWind_UnPackInitInput(Buf, OutData) type(InflowWind_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_UnPackInitInput' if (Buf%ErrStat /= ErrID_None) return - ! InputFileName call RegUnpack(Buf, OutData%InputFileName) if (RegCheckErr(Buf, RoutineName)) return - ! Linearize call RegUnpack(Buf, OutData%Linearize) if (RegCheckErr(Buf, RoutineName)) return - ! Use4Dext call RegUnpack(Buf, OutData%Use4Dext) if (RegCheckErr(Buf, RoutineName)) return - ! NumWindPoints call RegUnpack(Buf, OutData%NumWindPoints) if (RegCheckErr(Buf, RoutineName)) return - ! TurbineID call RegUnpack(Buf, OutData%TurbineID) if (RegCheckErr(Buf, RoutineName)) return - ! FixedWindFileRootName call RegUnpack(Buf, OutData%FixedWindFileRootName) if (RegCheckErr(Buf, RoutineName)) return - ! UseInputFile call RegUnpack(Buf, OutData%UseInputFile) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegUnpack(Buf, OutData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! PassedFileData call NWTC_Library_UnpackFileInfoType(Buf, OutData%PassedFileData) ! PassedFileData - ! WindType2UseInputFile call RegUnpack(Buf, OutData%WindType2UseInputFile) if (RegCheckErr(Buf, RoutineName)) return - ! WindType2Data call NWTC_Library_UnpackFileInfoType(Buf, OutData%WindType2Data) ! WindType2Data - ! OutputAccel call RegUnpack(Buf, OutData%OutputAccel) if (RegCheckErr(Buf, RoutineName)) return - ! lidar call Lidar_UnpackInitInput(Buf, OutData%lidar) ! lidar - ! FDext call InflowWind_IO_UnpackGrid4D_InitInputType(Buf, OutData%FDext) ! FDext - ! RadAvg call RegUnpack(Buf, OutData%RadAvg) if (RegCheckErr(Buf, RoutineName)) return - ! MHK call RegUnpack(Buf, OutData%MHK) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDpth call RegUnpack(Buf, OutData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - ! MSL2SWL call RegUnpack(Buf, OutData%MSL2SWL) if (RegCheckErr(Buf, RoutineName)) return - ! BoxExceedAllowIdx call RegUnpack(Buf, OutData%BoxExceedAllowIdx) if (RegCheckErr(Buf, RoutineName)) return - ! BoxExceedAllowF call RegUnpack(Buf, OutData%BoxExceedAllowF) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE InflowWind_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(InflowWind_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(InflowWind_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_CopyInitOutput' -! + +subroutine InflowWind_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(InflowWind_InitOutputType), intent(in) :: SrcInitOutputData + type(InflowWind_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInitOutputData%WriteOutputHdr)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputHdr,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputHdr,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputHdr)) THEN - ALLOCATE(DstInitOutputData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr -ENDIF -IF (ALLOCATED(SrcInitOutputData%WriteOutputUnt)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputUnt,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputUnt,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputUnt)) THEN - ALLOCATE(DstInitOutputData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt -ENDIF - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_IO_Copywindfiledat( SrcInitOutputData%WindFileInfo, DstInitOutputData%WindFileInfo, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInitOutputData%LinNames_y)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_y,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_y,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_y)) THEN - ALLOCATE(DstInitOutputData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y -ENDIF -IF (ALLOCATED(SrcInitOutputData%LinNames_u)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_u,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_u)) THEN - ALLOCATE(DstInitOutputData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_y)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_y,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_y,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_y)) THEN - ALLOCATE(DstInitOutputData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_u)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_u,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_u)) THEN - ALLOCATE(DstInitOutputData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%IsLoad_u)) THEN - i1_l = LBOUND(SrcInitOutputData%IsLoad_u,1) - i1_u = UBOUND(SrcInitOutputData%IsLoad_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%IsLoad_u)) THEN - ALLOCATE(DstInitOutputData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u -ENDIF - DstInitOutputData%FlowField => SrcInitOutputData%FlowField - END SUBROUTINE InflowWind_CopyInitOutput - - SUBROUTINE InflowWind_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(InflowWind_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF - CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_IO_DestroyWindFileDat( InitOutputData%WindFileInfo, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitOutputData%LinNames_y)) THEN - DEALLOCATE(InitOutputData%LinNames_y) -ENDIF -IF (ALLOCATED(InitOutputData%LinNames_u)) THEN - DEALLOCATE(InitOutputData%LinNames_u) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_y)) THEN - DEALLOCATE(InitOutputData%RotFrame_y) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_u)) THEN - DEALLOCATE(InitOutputData%RotFrame_u) -ENDIF -IF (ALLOCATED(InitOutputData%IsLoad_u)) THEN - DEALLOCATE(InitOutputData%IsLoad_u) -ENDIF -NULLIFY(InitOutputData%FlowField) - END SUBROUTINE InflowWind_DestroyInitOutput + ErrMsg = '' + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr + else if (allocated(DstInitOutputData%WriteOutputHdr)) then + deallocate(DstInitOutputData%WriteOutputHdr) + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt + else if (allocated(DstInitOutputData%WriteOutputUnt)) then + deallocate(DstInitOutputData%WriteOutputUnt) + end if + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_IO_CopyWindFileDat(SrcInitOutputData%WindFileInfo, DstInitOutputData%WindFileInfo, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInitOutputData%LinNames_y)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_y) + UB(1:1) = ubound(SrcInitOutputData%LinNames_y) + if (.not. allocated(DstInitOutputData%LinNames_y)) then + allocate(DstInitOutputData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y + else if (allocated(DstInitOutputData%LinNames_y)) then + deallocate(DstInitOutputData%LinNames_y) + end if + if (allocated(SrcInitOutputData%LinNames_u)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_u) + UB(1:1) = ubound(SrcInitOutputData%LinNames_u) + if (.not. allocated(DstInitOutputData%LinNames_u)) then + allocate(DstInitOutputData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u + else if (allocated(DstInitOutputData%LinNames_u)) then + deallocate(DstInitOutputData%LinNames_u) + end if + if (allocated(SrcInitOutputData%RotFrame_y)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_y) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_y) + if (.not. allocated(DstInitOutputData%RotFrame_y)) then + allocate(DstInitOutputData%RotFrame_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y + else if (allocated(DstInitOutputData%RotFrame_y)) then + deallocate(DstInitOutputData%RotFrame_y) + end if + if (allocated(SrcInitOutputData%RotFrame_u)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_u) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_u) + if (.not. allocated(DstInitOutputData%RotFrame_u)) then + allocate(DstInitOutputData%RotFrame_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u + else if (allocated(DstInitOutputData%RotFrame_u)) then + deallocate(DstInitOutputData%RotFrame_u) + end if + if (allocated(SrcInitOutputData%IsLoad_u)) then + LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) + UB(1:1) = ubound(SrcInitOutputData%IsLoad_u) + if (.not. allocated(DstInitOutputData%IsLoad_u)) then + allocate(DstInitOutputData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%IsLoad_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u + else if (allocated(DstInitOutputData%IsLoad_u)) then + deallocate(DstInitOutputData%IsLoad_u) + end if + DstInitOutputData%FlowField => SrcInitOutputData%FlowField +end subroutine +subroutine InflowWind_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(InflowWind_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if + if (allocated(InitOutputData%LinNames_y)) then + deallocate(InitOutputData%LinNames_y) + end if + if (allocated(InitOutputData%LinNames_u)) then + deallocate(InitOutputData%LinNames_u) + end if + if (allocated(InitOutputData%RotFrame_y)) then + deallocate(InitOutputData%RotFrame_y) + end if + if (allocated(InitOutputData%RotFrame_u)) then + deallocate(InitOutputData%RotFrame_u) + end if + if (allocated(InitOutputData%IsLoad_u)) then + deallocate(InitOutputData%IsLoad_u) + end if + nullify(InitOutputData%FlowField) +end subroutine subroutine InflowWind_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -1139,62 +1000,52 @@ subroutine InflowWind_PackInitOutput(Buf, Indata) character(*), parameter :: RoutineName = 'InflowWind_PackInitOutput' logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return - ! WriteOutputHdr call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) call RegPack(Buf, InData%WriteOutputHdr) end if if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutputUnt call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) call RegPack(Buf, InData%WriteOutputUnt) end if if (RegCheckErr(Buf, RoutineName)) return - ! Ver call NWTC_Library_PackProgDesc(Buf, InData%Ver) if (RegCheckErr(Buf, RoutineName)) return - ! WindFileInfo call InflowWind_IO_PackWindFileDat(Buf, InData%WindFileInfo) if (RegCheckErr(Buf, RoutineName)) return - ! LinNames_y call RegPack(Buf, allocated(InData%LinNames_y)) if (allocated(InData%LinNames_y)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) call RegPack(Buf, InData%LinNames_y) end if if (RegCheckErr(Buf, RoutineName)) return - ! LinNames_u call RegPack(Buf, allocated(InData%LinNames_u)) if (allocated(InData%LinNames_u)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) call RegPack(Buf, InData%LinNames_u) end if if (RegCheckErr(Buf, RoutineName)) return - ! RotFrame_y call RegPack(Buf, allocated(InData%RotFrame_y)) if (allocated(InData%RotFrame_y)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y), ubound(InData%RotFrame_y)) call RegPack(Buf, InData%RotFrame_y) end if if (RegCheckErr(Buf, RoutineName)) return - ! RotFrame_u call RegPack(Buf, allocated(InData%RotFrame_u)) if (allocated(InData%RotFrame_u)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u), ubound(InData%RotFrame_u)) call RegPack(Buf, InData%RotFrame_u) end if if (RegCheckErr(Buf, RoutineName)) return - ! IsLoad_u call RegPack(Buf, allocated(InData%IsLoad_u)) if (allocated(InData%IsLoad_u)) then call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) call RegPack(Buf, InData%IsLoad_u) end if if (RegCheckErr(Buf, RoutineName)) return - ! FlowField call RegPack(Buf, associated(InData%FlowField)) if (associated(InData%FlowField)) then call RegPackPointer(Buf, c_loc(InData%FlowField), PtrInIndex) @@ -1215,7 +1066,6 @@ subroutine InflowWind_UnPackInitOutput(Buf, OutData) integer(IntKi) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return - ! WriteOutputHdr if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1230,7 +1080,6 @@ subroutine InflowWind_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutputHdr) if (RegCheckErr(Buf, RoutineName)) return end if - ! WriteOutputUnt if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1245,11 +1094,8 @@ subroutine InflowWind_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutputUnt) if (RegCheckErr(Buf, RoutineName)) return end if - ! Ver call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver - ! WindFileInfo call InflowWind_IO_UnpackWindFileDat(Buf, OutData%WindFileInfo) ! WindFileInfo - ! LinNames_y if (allocated(OutData%LinNames_y)) deallocate(OutData%LinNames_y) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1264,7 +1110,6 @@ subroutine InflowWind_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%LinNames_y) if (RegCheckErr(Buf, RoutineName)) return end if - ! LinNames_u if (allocated(OutData%LinNames_u)) deallocate(OutData%LinNames_u) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1279,7 +1124,6 @@ subroutine InflowWind_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%LinNames_u) if (RegCheckErr(Buf, RoutineName)) return end if - ! RotFrame_y if (allocated(OutData%RotFrame_y)) deallocate(OutData%RotFrame_y) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1294,7 +1138,6 @@ subroutine InflowWind_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%RotFrame_y) if (RegCheckErr(Buf, RoutineName)) return end if - ! RotFrame_u if (allocated(OutData%RotFrame_u)) deallocate(OutData%RotFrame_u) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1309,7 +1152,6 @@ subroutine InflowWind_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%RotFrame_u) if (RegCheckErr(Buf, RoutineName)) return end if - ! IsLoad_u if (allocated(OutData%IsLoad_u)) deallocate(OutData%IsLoad_u) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1324,7 +1166,6 @@ subroutine InflowWind_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%IsLoad_u) if (RegCheckErr(Buf, RoutineName)) return end if - ! FlowField if (associated(OutData%FlowField)) deallocate(OutData%FlowField) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1346,160 +1187,157 @@ subroutine InflowWind_UnPackInitOutput(Buf, OutData) OutData%FlowField => null() end if end subroutine - SUBROUTINE InflowWind_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(InflowWind_ParameterType), INTENT(IN) :: SrcParamData - TYPE(InflowWind_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_CopyParam' -! + +subroutine InflowWind_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(InflowWind_ParameterType), intent(in) :: SrcParamData + type(InflowWind_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_CopyParam' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%RootFileName = SrcParamData%RootFileName - DstParamData%DT = SrcParamData%DT -IF (ALLOCATED(SrcParamData%WindViXYZprime)) THEN - i1_l = LBOUND(SrcParamData%WindViXYZprime,1) - i1_u = UBOUND(SrcParamData%WindViXYZprime,1) - i2_l = LBOUND(SrcParamData%WindViXYZprime,2) - i2_u = UBOUND(SrcParamData%WindViXYZprime,2) - IF (.NOT. ALLOCATED(DstParamData%WindViXYZprime)) THEN - ALLOCATE(DstParamData%WindViXYZprime(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WindViXYZprime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WindViXYZprime = SrcParamData%WindViXYZprime -ENDIF -IF (ALLOCATED(SrcParamData%WindViXYZ)) THEN - i1_l = LBOUND(SrcParamData%WindViXYZ,1) - i1_u = UBOUND(SrcParamData%WindViXYZ,1) - i2_l = LBOUND(SrcParamData%WindViXYZ,2) - i2_u = UBOUND(SrcParamData%WindViXYZ,2) - IF (.NOT. ALLOCATED(DstParamData%WindViXYZ)) THEN - ALLOCATE(DstParamData%WindViXYZ(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WindViXYZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WindViXYZ = SrcParamData%WindViXYZ -ENDIF -IF (ASSOCIATED(SrcParamData%FlowField)) THEN - IF (.NOT. ASSOCIATED(DstParamData%FlowField)) THEN - ALLOCATE(DstParamData%FlowField,STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FlowField.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - CALL IfW_FlowField_Copyflowfieldtype( SrcParamData%FlowField, DstParamData%FlowField, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -ENDIF -IF (ALLOCATED(SrcParamData%PositionAvg)) THEN - i1_l = LBOUND(SrcParamData%PositionAvg,1) - i1_u = UBOUND(SrcParamData%PositionAvg,1) - i2_l = LBOUND(SrcParamData%PositionAvg,2) - i2_u = UBOUND(SrcParamData%PositionAvg,2) - IF (.NOT. ALLOCATED(DstParamData%PositionAvg)) THEN - ALLOCATE(DstParamData%PositionAvg(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PositionAvg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%PositionAvg = SrcParamData%PositionAvg -ENDIF - DstParamData%NWindVel = SrcParamData%NWindVel - DstParamData%NumOuts = SrcParamData%NumOuts -IF (ALLOCATED(SrcParamData%OutParam)) THEN - i1_l = LBOUND(SrcParamData%OutParam,1) - i1_u = UBOUND(SrcParamData%OutParam,1) - IF (.NOT. ALLOCATED(DstParamData%OutParam)) THEN - ALLOCATE(DstParamData%OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%OutParam,1), UBOUND(SrcParamData%OutParam,1) - CALL NWTC_Library_Copyoutparmtype( SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%OutParamLinIndx)) THEN - i1_l = LBOUND(SrcParamData%OutParamLinIndx,1) - i1_u = UBOUND(SrcParamData%OutParamLinIndx,1) - i2_l = LBOUND(SrcParamData%OutParamLinIndx,2) - i2_u = UBOUND(SrcParamData%OutParamLinIndx,2) - IF (.NOT. ALLOCATED(DstParamData%OutParamLinIndx)) THEN - ALLOCATE(DstParamData%OutParamLinIndx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParamLinIndx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%OutParamLinIndx = SrcParamData%OutParamLinIndx -ENDIF - CALL Lidar_CopyParam( SrcParamData%lidar, DstParamData%lidar, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstParamData%OutputAccel = SrcParamData%OutputAccel - END SUBROUTINE InflowWind_CopyParam - - SUBROUTINE InflowWind_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(InflowWind_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%WindViXYZprime)) THEN - DEALLOCATE(ParamData%WindViXYZprime) -ENDIF -IF (ALLOCATED(ParamData%WindViXYZ)) THEN - DEALLOCATE(ParamData%WindViXYZ) -ENDIF -IF (ASSOCIATED(ParamData%FlowField)) THEN - IF (ASSOCIATED(ParamData%FlowField)) THEN - CALL IfW_FlowField_DestroyFlowFieldType( ParamData%FlowField, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - ENDIF - DEALLOCATE(ParamData%FlowField) - ParamData%FlowField => NULL() -ENDIF -IF (ALLOCATED(ParamData%PositionAvg)) THEN - DEALLOCATE(ParamData%PositionAvg) -ENDIF -IF (ALLOCATED(ParamData%OutParam)) THEN -DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_DestroyOutParmType( ParamData%OutParam(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%OutParam) -ENDIF -IF (ALLOCATED(ParamData%OutParamLinIndx)) THEN - DEALLOCATE(ParamData%OutParamLinIndx) -ENDIF - CALL Lidar_DestroyParam( ParamData%lidar, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE InflowWind_DestroyParam + ErrMsg = '' + DstParamData%RootFileName = SrcParamData%RootFileName + DstParamData%DT = SrcParamData%DT + if (allocated(SrcParamData%WindViXYZprime)) then + LB(1:2) = lbound(SrcParamData%WindViXYZprime) + UB(1:2) = ubound(SrcParamData%WindViXYZprime) + if (.not. allocated(DstParamData%WindViXYZprime)) then + allocate(DstParamData%WindViXYZprime(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WindViXYZprime.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WindViXYZprime = SrcParamData%WindViXYZprime + else if (allocated(DstParamData%WindViXYZprime)) then + deallocate(DstParamData%WindViXYZprime) + end if + if (allocated(SrcParamData%WindViXYZ)) then + LB(1:2) = lbound(SrcParamData%WindViXYZ) + UB(1:2) = ubound(SrcParamData%WindViXYZ) + if (.not. allocated(DstParamData%WindViXYZ)) then + allocate(DstParamData%WindViXYZ(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WindViXYZ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WindViXYZ = SrcParamData%WindViXYZ + else if (allocated(DstParamData%WindViXYZ)) then + deallocate(DstParamData%WindViXYZ) + end if + if (associated(SrcParamData%FlowField)) then + if (.not. associated(DstParamData%FlowField)) then + allocate(DstParamData%FlowField, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FlowField.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + call IfW_FlowField_CopyFlowFieldType(SrcParamData%FlowField, DstParamData%FlowField, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + else if (associated(DstParamData%FlowField)) then + deallocate(DstParamData%FlowField) + end if + if (allocated(SrcParamData%PositionAvg)) then + LB(1:2) = lbound(SrcParamData%PositionAvg) + UB(1:2) = ubound(SrcParamData%PositionAvg) + if (.not. allocated(DstParamData%PositionAvg)) then + allocate(DstParamData%PositionAvg(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PositionAvg.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%PositionAvg = SrcParamData%PositionAvg + else if (allocated(DstParamData%PositionAvg)) then + deallocate(DstParamData%PositionAvg) + end if + DstParamData%NWindVel = SrcParamData%NWindVel + DstParamData%NumOuts = SrcParamData%NumOuts + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstParamData%OutParam)) then + deallocate(DstParamData%OutParam) + end if + if (allocated(SrcParamData%OutParamLinIndx)) then + LB(1:2) = lbound(SrcParamData%OutParamLinIndx) + UB(1:2) = ubound(SrcParamData%OutParamLinIndx) + if (.not. allocated(DstParamData%OutParamLinIndx)) then + allocate(DstParamData%OutParamLinIndx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParamLinIndx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%OutParamLinIndx = SrcParamData%OutParamLinIndx + else if (allocated(DstParamData%OutParamLinIndx)) then + deallocate(DstParamData%OutParamLinIndx) + end if + call Lidar_CopyParam(SrcParamData%lidar, DstParamData%lidar, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstParamData%OutputAccel = SrcParamData%OutputAccel +end subroutine +subroutine InflowWind_DestroyParam(ParamData, ErrStat, ErrMsg) + type(InflowWind_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%WindViXYZprime)) then + deallocate(ParamData%WindViXYZprime) + end if + if (allocated(ParamData%WindViXYZ)) then + deallocate(ParamData%WindViXYZ) + end if + if (associated(ParamData%FlowField)) then + call IfW_FlowField_DestroyFlowFieldType(ParamData%FlowField, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + deallocate(ParamData%FlowField) + ParamData%FlowField => null() + end if + if (allocated(ParamData%PositionAvg)) then + deallocate(ParamData%PositionAvg) + end if + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%OutParam) + end if + if (allocated(ParamData%OutParamLinIndx)) then + deallocate(ParamData%OutParamLinIndx) + end if +end subroutine subroutine InflowWind_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -1509,27 +1347,22 @@ subroutine InflowWind_PackParam(Buf, Indata) integer(IntKi) :: LB(2), UB(2) logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return - ! RootFileName call RegPack(Buf, InData%RootFileName) if (RegCheckErr(Buf, RoutineName)) return - ! DT call RegPack(Buf, InData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! WindViXYZprime call RegPack(Buf, allocated(InData%WindViXYZprime)) if (allocated(InData%WindViXYZprime)) then call RegPackBounds(Buf, 2, lbound(InData%WindViXYZprime), ubound(InData%WindViXYZprime)) call RegPack(Buf, InData%WindViXYZprime) end if if (RegCheckErr(Buf, RoutineName)) return - ! WindViXYZ call RegPack(Buf, allocated(InData%WindViXYZ)) if (allocated(InData%WindViXYZ)) then call RegPackBounds(Buf, 2, lbound(InData%WindViXYZ), ubound(InData%WindViXYZ)) call RegPack(Buf, InData%WindViXYZ) end if if (RegCheckErr(Buf, RoutineName)) return - ! FlowField call RegPack(Buf, associated(InData%FlowField)) if (associated(InData%FlowField)) then call RegPackPointer(Buf, c_loc(InData%FlowField), PtrInIndex) @@ -1538,20 +1371,16 @@ subroutine InflowWind_PackParam(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! PositionAvg call RegPack(Buf, allocated(InData%PositionAvg)) if (allocated(InData%PositionAvg)) then call RegPackBounds(Buf, 2, lbound(InData%PositionAvg), ubound(InData%PositionAvg)) call RegPack(Buf, InData%PositionAvg) end if if (RegCheckErr(Buf, RoutineName)) return - ! NWindVel call RegPack(Buf, InData%NWindVel) if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegPack(Buf, InData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! OutParam call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) @@ -1562,17 +1391,14 @@ subroutine InflowWind_PackParam(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! OutParamLinIndx call RegPack(Buf, allocated(InData%OutParamLinIndx)) if (allocated(InData%OutParamLinIndx)) then call RegPackBounds(Buf, 2, lbound(InData%OutParamLinIndx), ubound(InData%OutParamLinIndx)) call RegPack(Buf, InData%OutParamLinIndx) end if if (RegCheckErr(Buf, RoutineName)) return - ! lidar call Lidar_PackParam(Buf, InData%lidar) if (RegCheckErr(Buf, RoutineName)) return - ! OutputAccel call RegPack(Buf, InData%OutputAccel) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1588,13 +1414,10 @@ subroutine InflowWind_UnPackParam(Buf, OutData) integer(IntKi) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return - ! RootFileName call RegUnpack(Buf, OutData%RootFileName) if (RegCheckErr(Buf, RoutineName)) return - ! DT call RegUnpack(Buf, OutData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! WindViXYZprime if (allocated(OutData%WindViXYZprime)) deallocate(OutData%WindViXYZprime) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1609,7 +1432,6 @@ subroutine InflowWind_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%WindViXYZprime) if (RegCheckErr(Buf, RoutineName)) return end if - ! WindViXYZ if (allocated(OutData%WindViXYZ)) deallocate(OutData%WindViXYZ) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1624,7 +1446,6 @@ subroutine InflowWind_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%WindViXYZ) if (RegCheckErr(Buf, RoutineName)) return end if - ! FlowField if (associated(OutData%FlowField)) deallocate(OutData%FlowField) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1645,7 +1466,6 @@ subroutine InflowWind_UnPackParam(Buf, OutData) else OutData%FlowField => null() end if - ! PositionAvg if (allocated(OutData%PositionAvg)) deallocate(OutData%PositionAvg) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1660,13 +1480,10 @@ subroutine InflowWind_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%PositionAvg) if (RegCheckErr(Buf, RoutineName)) return end if - ! NWindVel call RegUnpack(Buf, OutData%NWindVel) if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegUnpack(Buf, OutData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! OutParam if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1682,7 +1499,6 @@ subroutine InflowWind_UnPackParam(Buf, OutData) call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam end do end if - ! OutParamLinIndx if (allocated(OutData%OutParamLinIndx)) deallocate(OutData%OutParamLinIndx) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1697,89 +1513,73 @@ subroutine InflowWind_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%OutParamLinIndx) if (RegCheckErr(Buf, RoutineName)) return end if - ! lidar call Lidar_UnpackParam(Buf, OutData%lidar) ! lidar - ! OutputAccel call RegUnpack(Buf, OutData%OutputAccel) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE InflowWind_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(InflowWind_InputType), INTENT(IN) :: SrcInputData - TYPE(InflowWind_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_CopyInput' -! + +subroutine InflowWind_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(InflowWind_InputType), intent(in) :: SrcInputData + type(InflowWind_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_CopyInput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInputData%PositionXYZ)) THEN - i1_l = LBOUND(SrcInputData%PositionXYZ,1) - i1_u = UBOUND(SrcInputData%PositionXYZ,1) - i2_l = LBOUND(SrcInputData%PositionXYZ,2) - i2_u = UBOUND(SrcInputData%PositionXYZ,2) - IF (.NOT. ALLOCATED(DstInputData%PositionXYZ)) THEN - ALLOCATE(DstInputData%PositionXYZ(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%PositionXYZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%PositionXYZ = SrcInputData%PositionXYZ -ENDIF - CALL Lidar_CopyInput( SrcInputData%lidar, DstInputData%lidar, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInputData%HubPosition = SrcInputData%HubPosition - DstInputData%HubOrientation = SrcInputData%HubOrientation - END SUBROUTINE InflowWind_CopyInput - - SUBROUTINE InflowWind_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(InflowWind_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputData%PositionXYZ)) THEN - DEALLOCATE(InputData%PositionXYZ) -ENDIF - CALL Lidar_DestroyInput( InputData%lidar, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE InflowWind_DestroyInput + ErrMsg = '' + if (allocated(SrcInputData%PositionXYZ)) then + LB(1:2) = lbound(SrcInputData%PositionXYZ) + UB(1:2) = ubound(SrcInputData%PositionXYZ) + if (.not. allocated(DstInputData%PositionXYZ)) then + allocate(DstInputData%PositionXYZ(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%PositionXYZ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%PositionXYZ = SrcInputData%PositionXYZ + else if (allocated(DstInputData%PositionXYZ)) then + deallocate(DstInputData%PositionXYZ) + end if + call Lidar_CopyInput(SrcInputData%lidar, DstInputData%lidar, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInputData%HubPosition = SrcInputData%HubPosition + DstInputData%HubOrientation = SrcInputData%HubOrientation +end subroutine +subroutine InflowWind_DestroyInput(InputData, ErrStat, ErrMsg) + type(InflowWind_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%PositionXYZ)) then + deallocate(InputData%PositionXYZ) + end if +end subroutine subroutine InflowWind_PackInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(InflowWind_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'InflowWind_PackInput' if (Buf%ErrStat >= AbortErrLev) return - ! PositionXYZ call RegPack(Buf, allocated(InData%PositionXYZ)) if (allocated(InData%PositionXYZ)) then call RegPackBounds(Buf, 2, lbound(InData%PositionXYZ), ubound(InData%PositionXYZ)) call RegPack(Buf, InData%PositionXYZ) end if if (RegCheckErr(Buf, RoutineName)) return - ! lidar call Lidar_PackInput(Buf, InData%lidar) if (RegCheckErr(Buf, RoutineName)) return - ! HubPosition call RegPack(Buf, InData%HubPosition) if (RegCheckErr(Buf, RoutineName)) return - ! HubOrientation call RegPack(Buf, InData%HubOrientation) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1792,7 +1592,6 @@ subroutine InflowWind_UnPackInput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! PositionXYZ if (allocated(OutData%PositionXYZ)) deallocate(OutData%PositionXYZ) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1807,138 +1606,121 @@ subroutine InflowWind_UnPackInput(Buf, OutData) call RegUnpack(Buf, OutData%PositionXYZ) if (RegCheckErr(Buf, RoutineName)) return end if - ! lidar call Lidar_UnpackInput(Buf, OutData%lidar) ! lidar - ! HubPosition call RegUnpack(Buf, OutData%HubPosition) if (RegCheckErr(Buf, RoutineName)) return - ! HubOrientation call RegUnpack(Buf, OutData%HubOrientation) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE InflowWind_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(InflowWind_OutputType), INTENT(IN) :: SrcOutputData - TYPE(InflowWind_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_CopyOutput' -! + +subroutine InflowWind_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(InflowWind_OutputType), intent(in) :: SrcOutputData + type(InflowWind_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_CopyOutput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%VelocityUVW)) THEN - i1_l = LBOUND(SrcOutputData%VelocityUVW,1) - i1_u = UBOUND(SrcOutputData%VelocityUVW,1) - i2_l = LBOUND(SrcOutputData%VelocityUVW,2) - i2_u = UBOUND(SrcOutputData%VelocityUVW,2) - IF (.NOT. ALLOCATED(DstOutputData%VelocityUVW)) THEN - ALLOCATE(DstOutputData%VelocityUVW(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%VelocityUVW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%VelocityUVW = SrcOutputData%VelocityUVW -ENDIF -IF (ALLOCATED(SrcOutputData%AccelUVW)) THEN - i1_l = LBOUND(SrcOutputData%AccelUVW,1) - i1_u = UBOUND(SrcOutputData%AccelUVW,1) - i2_l = LBOUND(SrcOutputData%AccelUVW,2) - i2_u = UBOUND(SrcOutputData%AccelUVW,2) - IF (.NOT. ALLOCATED(DstOutputData%AccelUVW)) THEN - ALLOCATE(DstOutputData%AccelUVW(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%AccelUVW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%AccelUVW = SrcOutputData%AccelUVW -ENDIF -IF (ALLOCATED(SrcOutputData%WriteOutput)) THEN - i1_l = LBOUND(SrcOutputData%WriteOutput,1) - i1_u = UBOUND(SrcOutputData%WriteOutput,1) - IF (.NOT. ALLOCATED(DstOutputData%WriteOutput)) THEN - ALLOCATE(DstOutputData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%WriteOutput = SrcOutputData%WriteOutput -ENDIF - DstOutputData%DiskVel = SrcOutputData%DiskVel - DstOutputData%HubVel = SrcOutputData%HubVel - CALL Lidar_CopyOutput( SrcOutputData%lidar, DstOutputData%lidar, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE InflowWind_CopyOutput - - SUBROUTINE InflowWind_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(InflowWind_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OutputData%VelocityUVW)) THEN - DEALLOCATE(OutputData%VelocityUVW) -ENDIF -IF (ALLOCATED(OutputData%AccelUVW)) THEN - DEALLOCATE(OutputData%AccelUVW) -ENDIF -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - CALL Lidar_DestroyOutput( OutputData%lidar, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE InflowWind_DestroyOutput + ErrMsg = '' + if (allocated(SrcOutputData%VelocityUVW)) then + LB(1:2) = lbound(SrcOutputData%VelocityUVW) + UB(1:2) = ubound(SrcOutputData%VelocityUVW) + if (.not. allocated(DstOutputData%VelocityUVW)) then + allocate(DstOutputData%VelocityUVW(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%VelocityUVW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%VelocityUVW = SrcOutputData%VelocityUVW + else if (allocated(DstOutputData%VelocityUVW)) then + deallocate(DstOutputData%VelocityUVW) + end if + if (allocated(SrcOutputData%AccelUVW)) then + LB(1:2) = lbound(SrcOutputData%AccelUVW) + UB(1:2) = ubound(SrcOutputData%AccelUVW) + if (.not. allocated(DstOutputData%AccelUVW)) then + allocate(DstOutputData%AccelUVW(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%AccelUVW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%AccelUVW = SrcOutputData%AccelUVW + else if (allocated(DstOutputData%AccelUVW)) then + deallocate(DstOutputData%AccelUVW) + end if + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%WriteOutput = SrcOutputData%WriteOutput + else if (allocated(DstOutputData%WriteOutput)) then + deallocate(DstOutputData%WriteOutput) + end if + DstOutputData%DiskVel = SrcOutputData%DiskVel + DstOutputData%HubVel = SrcOutputData%HubVel + call Lidar_CopyOutput(SrcOutputData%lidar, DstOutputData%lidar, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine InflowWind_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(InflowWind_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%VelocityUVW)) then + deallocate(OutputData%VelocityUVW) + end if + if (allocated(OutputData%AccelUVW)) then + deallocate(OutputData%AccelUVW) + end if + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine subroutine InflowWind_PackOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(InflowWind_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'InflowWind_PackOutput' if (Buf%ErrStat >= AbortErrLev) return - ! VelocityUVW call RegPack(Buf, allocated(InData%VelocityUVW)) if (allocated(InData%VelocityUVW)) then call RegPackBounds(Buf, 2, lbound(InData%VelocityUVW), ubound(InData%VelocityUVW)) call RegPack(Buf, InData%VelocityUVW) end if if (RegCheckErr(Buf, RoutineName)) return - ! AccelUVW call RegPack(Buf, allocated(InData%AccelUVW)) if (allocated(InData%AccelUVW)) then call RegPackBounds(Buf, 2, lbound(InData%AccelUVW), ubound(InData%AccelUVW)) call RegPack(Buf, InData%AccelUVW) end if if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutput call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) call RegPack(Buf, InData%WriteOutput) end if if (RegCheckErr(Buf, RoutineName)) return - ! DiskVel call RegPack(Buf, InData%DiskVel) if (RegCheckErr(Buf, RoutineName)) return - ! HubVel call RegPack(Buf, InData%HubVel) if (RegCheckErr(Buf, RoutineName)) return - ! lidar call Lidar_PackOutput(Buf, InData%lidar) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1951,7 +1733,6 @@ subroutine InflowWind_UnPackOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! VelocityUVW if (allocated(OutData%VelocityUVW)) deallocate(OutData%VelocityUVW) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1966,7 +1747,6 @@ subroutine InflowWind_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%VelocityUVW) if (RegCheckErr(Buf, RoutineName)) return end if - ! AccelUVW if (allocated(OutData%AccelUVW)) deallocate(OutData%AccelUVW) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1981,7 +1761,6 @@ subroutine InflowWind_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%AccelUVW) if (RegCheckErr(Buf, RoutineName)) return end if - ! WriteOutput if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1996,54 +1775,39 @@ subroutine InflowWind_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutput) if (RegCheckErr(Buf, RoutineName)) return end if - ! DiskVel call RegUnpack(Buf, OutData%DiskVel) if (RegCheckErr(Buf, RoutineName)) return - ! HubVel call RegUnpack(Buf, OutData%HubVel) if (RegCheckErr(Buf, RoutineName)) return - ! lidar call Lidar_UnpackOutput(Buf, OutData%lidar) ! lidar end subroutine - SUBROUTINE InflowWind_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(InflowWind_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(InflowWind_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%DummyContState = SrcContStateData%DummyContState - END SUBROUTINE InflowWind_CopyContState - - SUBROUTINE InflowWind_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(InflowWind_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_DestroyContState' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE InflowWind_DestroyContState +subroutine InflowWind_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(InflowWind_ContinuousStateType), intent(in) :: SrcContStateData + type(InflowWind_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + DstContStateData%DummyContState = SrcContStateData%DummyContState +end subroutine +subroutine InflowWind_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(InflowWind_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine InflowWind_PackContState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(InflowWind_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'InflowWind_PackContState' if (Buf%ErrStat >= AbortErrLev) return - ! DummyContState call RegPack(Buf, InData%DummyContState) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2053,49 +1817,36 @@ subroutine InflowWind_UnPackContState(Buf, OutData) type(InflowWind_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_UnPackContState' if (Buf%ErrStat /= ErrID_None) return - ! DummyContState call RegUnpack(Buf, OutData%DummyContState) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE InflowWind_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(InflowWind_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(InflowWind_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState - END SUBROUTINE InflowWind_CopyDiscState - SUBROUTINE InflowWind_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(InflowWind_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE InflowWind_DestroyDiscState +subroutine InflowWind_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(InflowWind_DiscreteStateType), intent(in) :: SrcDiscStateData + type(InflowWind_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState +end subroutine +subroutine InflowWind_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(InflowWind_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine InflowWind_PackDiscState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(InflowWind_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'InflowWind_PackDiscState' if (Buf%ErrStat >= AbortErrLev) return - ! DummyDiscState call RegPack(Buf, InData%DummyDiscState) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2105,49 +1856,36 @@ subroutine InflowWind_UnPackDiscState(Buf, OutData) type(InflowWind_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_UnPackDiscState' if (Buf%ErrStat /= ErrID_None) return - ! DummyDiscState call RegUnpack(Buf, OutData%DummyDiscState) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE InflowWind_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(InflowWind_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(InflowWind_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE InflowWind_CopyConstrState - - SUBROUTINE InflowWind_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(InflowWind_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE InflowWind_DestroyConstrState +subroutine InflowWind_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(InflowWind_ConstraintStateType), intent(in) :: SrcConstrStateData + type(InflowWind_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine +subroutine InflowWind_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(InflowWind_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine InflowWind_PackConstrState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(InflowWind_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'InflowWind_PackConstrState' if (Buf%ErrStat >= AbortErrLev) return - ! DummyConstrState call RegPack(Buf, InData%DummyConstrState) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2157,49 +1895,36 @@ subroutine InflowWind_UnPackConstrState(Buf, OutData) type(InflowWind_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_UnPackConstrState' if (Buf%ErrStat /= ErrID_None) return - ! DummyConstrState call RegUnpack(Buf, OutData%DummyConstrState) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE InflowWind_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(InflowWind_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(InflowWind_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState - END SUBROUTINE InflowWind_CopyOtherState - - SUBROUTINE InflowWind_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(InflowWind_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_DestroyOtherState' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE InflowWind_DestroyOtherState +subroutine InflowWind_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(InflowWind_OtherStateType), intent(in) :: SrcOtherStateData + type(InflowWind_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState +end subroutine +subroutine InflowWind_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(InflowWind_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'InflowWind_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine InflowWind_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(InflowWind_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'InflowWind_PackOtherState' if (Buf%ErrStat >= AbortErrLev) return - ! DummyOtherState call RegPack(Buf, InData%DummyOtherState) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2209,149 +1934,127 @@ subroutine InflowWind_UnPackOtherState(Buf, OutData) type(InflowWind_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_UnPackOtherState' if (Buf%ErrStat /= ErrID_None) return - ! DummyOtherState call RegUnpack(Buf, OutData%DummyOtherState) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE InflowWind_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(InflowWind_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(InflowWind_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_CopyMisc' -! + +subroutine InflowWind_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(InflowWind_MiscVarType), intent(in) :: SrcMiscData + type(InflowWind_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_CopyMisc' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscData%AllOuts)) THEN - i1_l = LBOUND(SrcMiscData%AllOuts,1) - i1_u = UBOUND(SrcMiscData%AllOuts,1) - IF (.NOT. ALLOCATED(DstMiscData%AllOuts)) THEN - ALLOCATE(DstMiscData%AllOuts(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%AllOuts = SrcMiscData%AllOuts -ENDIF -IF (ALLOCATED(SrcMiscData%WindViUVW)) THEN - i1_l = LBOUND(SrcMiscData%WindViUVW,1) - i1_u = UBOUND(SrcMiscData%WindViUVW,1) - i2_l = LBOUND(SrcMiscData%WindViUVW,2) - i2_u = UBOUND(SrcMiscData%WindViUVW,2) - IF (.NOT. ALLOCATED(DstMiscData%WindViUVW)) THEN - ALLOCATE(DstMiscData%WindViUVW(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindViUVW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%WindViUVW = SrcMiscData%WindViUVW -ENDIF -IF (ALLOCATED(SrcMiscData%WindAiUVW)) THEN - i1_l = LBOUND(SrcMiscData%WindAiUVW,1) - i1_u = UBOUND(SrcMiscData%WindAiUVW,1) - i2_l = LBOUND(SrcMiscData%WindAiUVW,2) - i2_u = UBOUND(SrcMiscData%WindAiUVW,2) - IF (.NOT. ALLOCATED(DstMiscData%WindAiUVW)) THEN - ALLOCATE(DstMiscData%WindAiUVW(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindAiUVW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%WindAiUVW = SrcMiscData%WindAiUVW -ENDIF - CALL InflowWind_CopyInput( SrcMiscData%u_Avg, DstMiscData%u_Avg, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyOutput( SrcMiscData%y_Avg, DstMiscData%y_Avg, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyInput( SrcMiscData%u_Hub, DstMiscData%u_Hub, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyOutput( SrcMiscData%y_Hub, DstMiscData%y_Hub, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE InflowWind_CopyMisc - - SUBROUTINE InflowWind_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(InflowWind_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MiscData%AllOuts)) THEN - DEALLOCATE(MiscData%AllOuts) -ENDIF -IF (ALLOCATED(MiscData%WindViUVW)) THEN - DEALLOCATE(MiscData%WindViUVW) -ENDIF -IF (ALLOCATED(MiscData%WindAiUVW)) THEN - DEALLOCATE(MiscData%WindAiUVW) -ENDIF - CALL InflowWind_DestroyInput( MiscData%u_Avg, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyOutput( MiscData%y_Avg, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyInput( MiscData%u_Hub, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyOutput( MiscData%y_Hub, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE InflowWind_DestroyMisc + ErrMsg = '' + if (allocated(SrcMiscData%AllOuts)) then + LB(1:1) = lbound(SrcMiscData%AllOuts) + UB(1:1) = ubound(SrcMiscData%AllOuts) + if (.not. allocated(DstMiscData%AllOuts)) then + allocate(DstMiscData%AllOuts(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%AllOuts = SrcMiscData%AllOuts + else if (allocated(DstMiscData%AllOuts)) then + deallocate(DstMiscData%AllOuts) + end if + if (allocated(SrcMiscData%WindViUVW)) then + LB(1:2) = lbound(SrcMiscData%WindViUVW) + UB(1:2) = ubound(SrcMiscData%WindViUVW) + if (.not. allocated(DstMiscData%WindViUVW)) then + allocate(DstMiscData%WindViUVW(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindViUVW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%WindViUVW = SrcMiscData%WindViUVW + else if (allocated(DstMiscData%WindViUVW)) then + deallocate(DstMiscData%WindViUVW) + end if + if (allocated(SrcMiscData%WindAiUVW)) then + LB(1:2) = lbound(SrcMiscData%WindAiUVW) + UB(1:2) = ubound(SrcMiscData%WindAiUVW) + if (.not. allocated(DstMiscData%WindAiUVW)) then + allocate(DstMiscData%WindAiUVW(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindAiUVW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%WindAiUVW = SrcMiscData%WindAiUVW + else if (allocated(DstMiscData%WindAiUVW)) then + deallocate(DstMiscData%WindAiUVW) + end if + call InflowWind_CopyInput(SrcMiscData%u_Avg, DstMiscData%u_Avg, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyOutput(SrcMiscData%y_Avg, DstMiscData%y_Avg, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyInput(SrcMiscData%u_Hub, DstMiscData%u_Hub, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyOutput(SrcMiscData%y_Hub, DstMiscData%y_Hub, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine InflowWind_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(InflowWind_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'InflowWind_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%AllOuts)) then + deallocate(MiscData%AllOuts) + end if + if (allocated(MiscData%WindViUVW)) then + deallocate(MiscData%WindViUVW) + end if + if (allocated(MiscData%WindAiUVW)) then + deallocate(MiscData%WindAiUVW) + end if +end subroutine subroutine InflowWind_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(InflowWind_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'InflowWind_PackMisc' if (Buf%ErrStat >= AbortErrLev) return - ! AllOuts call RegPack(Buf, allocated(InData%AllOuts)) if (allocated(InData%AllOuts)) then call RegPackBounds(Buf, 1, lbound(InData%AllOuts), ubound(InData%AllOuts)) call RegPack(Buf, InData%AllOuts) end if if (RegCheckErr(Buf, RoutineName)) return - ! WindViUVW call RegPack(Buf, allocated(InData%WindViUVW)) if (allocated(InData%WindViUVW)) then call RegPackBounds(Buf, 2, lbound(InData%WindViUVW), ubound(InData%WindViUVW)) call RegPack(Buf, InData%WindViUVW) end if if (RegCheckErr(Buf, RoutineName)) return - ! WindAiUVW call RegPack(Buf, allocated(InData%WindAiUVW)) if (allocated(InData%WindAiUVW)) then call RegPackBounds(Buf, 2, lbound(InData%WindAiUVW), ubound(InData%WindAiUVW)) call RegPack(Buf, InData%WindAiUVW) end if if (RegCheckErr(Buf, RoutineName)) return - ! u_Avg call InflowWind_PackInput(Buf, InData%u_Avg) if (RegCheckErr(Buf, RoutineName)) return - ! y_Avg call InflowWind_PackOutput(Buf, InData%y_Avg) if (RegCheckErr(Buf, RoutineName)) return - ! u_Hub call InflowWind_PackInput(Buf, InData%u_Hub) if (RegCheckErr(Buf, RoutineName)) return - ! y_Hub call InflowWind_PackOutput(Buf, InData%y_Hub) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2364,7 +2067,6 @@ subroutine InflowWind_UnPackMisc(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! AllOuts if (allocated(OutData%AllOuts)) deallocate(OutData%AllOuts) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2379,7 +2081,6 @@ subroutine InflowWind_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%AllOuts) if (RegCheckErr(Buf, RoutineName)) return end if - ! WindViUVW if (allocated(OutData%WindViUVW)) deallocate(OutData%WindViUVW) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2394,7 +2095,6 @@ subroutine InflowWind_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%WindViUVW) if (RegCheckErr(Buf, RoutineName)) return end if - ! WindAiUVW if (allocated(OutData%WindAiUVW)) deallocate(OutData%WindAiUVW) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2409,13 +2109,9 @@ subroutine InflowWind_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%WindAiUVW) if (RegCheckErr(Buf, RoutineName)) return end if - ! u_Avg call InflowWind_UnpackInput(Buf, OutData%u_Avg) ! u_Avg - ! y_Avg call InflowWind_UnpackOutput(Buf, OutData%y_Avg) ! y_Avg - ! u_Hub call InflowWind_UnpackInput(Buf, OutData%u_Hub) ! u_Hub - ! y_Hub call InflowWind_UnpackOutput(Buf, OutData%y_Hub) ! y_Hub end subroutine diff --git a/modules/inflowwind/src/Lidar_Types.f90 b/modules/inflowwind/src/Lidar_Types.f90 index cd500ab503..06c8aaeca1 100644 --- a/modules/inflowwind/src/Lidar_Types.f90 +++ b/modules/inflowwind/src/Lidar_Types.f90 @@ -124,66 +124,48 @@ MODULE Lidar_Types END TYPE Lidar_OutputType ! ======================= CONTAINS - SUBROUTINE Lidar_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Lidar_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(Lidar_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_CopyInitInput' -! + +subroutine Lidar_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(Lidar_InitInputType), intent(in) :: SrcInitInputData + type(Lidar_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%SensorType = SrcInitInputData%SensorType - DstInitInputData%Tmax = SrcInitInputData%Tmax - DstInitInputData%RotorApexOffsetPos = SrcInitInputData%RotorApexOffsetPos - DstInitInputData%HubPosition = SrcInitInputData%HubPosition - DstInitInputData%NumPulseGate = SrcInitInputData%NumPulseGate - DstInitInputData%LidRadialVel = SrcInitInputData%LidRadialVel - END SUBROUTINE Lidar_CopyInitInput - - SUBROUTINE Lidar_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(Lidar_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Lidar_DestroyInitInput + ErrMsg = '' + DstInitInputData%SensorType = SrcInitInputData%SensorType + DstInitInputData%Tmax = SrcInitInputData%Tmax + DstInitInputData%RotorApexOffsetPos = SrcInitInputData%RotorApexOffsetPos + DstInitInputData%HubPosition = SrcInitInputData%HubPosition + DstInitInputData%NumPulseGate = SrcInitInputData%NumPulseGate + DstInitInputData%LidRadialVel = SrcInitInputData%LidRadialVel +end subroutine +subroutine Lidar_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(Lidar_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine Lidar_PackInitInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Lidar_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Lidar_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return - ! SensorType call RegPack(Buf, InData%SensorType) if (RegCheckErr(Buf, RoutineName)) return - ! Tmax call RegPack(Buf, InData%Tmax) if (RegCheckErr(Buf, RoutineName)) return - ! RotorApexOffsetPos call RegPack(Buf, InData%RotorApexOffsetPos) if (RegCheckErr(Buf, RoutineName)) return - ! HubPosition call RegPack(Buf, InData%HubPosition) if (RegCheckErr(Buf, RoutineName)) return - ! NumPulseGate call RegPack(Buf, InData%NumPulseGate) if (RegCheckErr(Buf, RoutineName)) return - ! LidRadialVel call RegPack(Buf, InData%LidRadialVel) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -193,64 +175,46 @@ subroutine Lidar_UnPackInitInput(Buf, OutData) type(Lidar_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Lidar_UnPackInitInput' if (Buf%ErrStat /= ErrID_None) return - ! SensorType call RegUnpack(Buf, OutData%SensorType) if (RegCheckErr(Buf, RoutineName)) return - ! Tmax call RegUnpack(Buf, OutData%Tmax) if (RegCheckErr(Buf, RoutineName)) return - ! RotorApexOffsetPos call RegUnpack(Buf, OutData%RotorApexOffsetPos) if (RegCheckErr(Buf, RoutineName)) return - ! HubPosition call RegUnpack(Buf, OutData%HubPosition) if (RegCheckErr(Buf, RoutineName)) return - ! NumPulseGate call RegUnpack(Buf, OutData%NumPulseGate) if (RegCheckErr(Buf, RoutineName)) return - ! LidRadialVel call RegUnpack(Buf, OutData%LidRadialVel) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Lidar_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Lidar_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(Lidar_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_CopyInitOutput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitOutputData%DummyInitOut = SrcInitOutputData%DummyInitOut - END SUBROUTINE Lidar_CopyInitOutput - - SUBROUTINE Lidar_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(Lidar_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_DestroyInitOutput' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Lidar_DestroyInitOutput +subroutine Lidar_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(Lidar_InitOutputType), intent(in) :: SrcInitOutputData + type(Lidar_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitOutputData%DummyInitOut = SrcInitOutputData%DummyInitOut +end subroutine +subroutine Lidar_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(Lidar_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine Lidar_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Lidar_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Lidar_PackInitOutput' if (Buf%ErrStat >= AbortErrLev) return - ! DummyInitOut call RegPack(Buf, InData%DummyInitOut) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -260,217 +224,187 @@ subroutine Lidar_UnPackInitOutput(Buf, OutData) type(Lidar_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Lidar_UnPackInitOutput' if (Buf%ErrStat /= ErrID_None) return - ! DummyInitOut call RegUnpack(Buf, OutData%DummyInitOut) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Lidar_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Lidar_ParameterType), INTENT(IN) :: SrcParamData - TYPE(Lidar_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_CopyParam' -! + +subroutine Lidar_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(Lidar_ParameterType), intent(in) :: SrcParamData + type(Lidar_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Lidar_CopyParam' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%NumPulseGate = SrcParamData%NumPulseGate - DstParamData%RotorApexOffsetPos = SrcParamData%RotorApexOffsetPos - DstParamData%RayRangeSq = SrcParamData%RayRangeSq - DstParamData%SpatialRes = SrcParamData%SpatialRes - DstParamData%SensorType = SrcParamData%SensorType - DstParamData%WtFnTrunc = SrcParamData%WtFnTrunc - DstParamData%PulseRangeOne = SrcParamData%PulseRangeOne - DstParamData%DeltaP = SrcParamData%DeltaP - DstParamData%DeltaR = SrcParamData%DeltaR - DstParamData%r_p = SrcParamData%r_p - DstParamData%LidRadialVel = SrcParamData%LidRadialVel - DstParamData%DisplacementLidarX = SrcParamData%DisplacementLidarX - DstParamData%DisplacementLidarY = SrcParamData%DisplacementLidarY - DstParamData%DisplacementLidarZ = SrcParamData%DisplacementLidarZ - DstParamData%NumBeam = SrcParamData%NumBeam -IF (ALLOCATED(SrcParamData%FocalDistanceX)) THEN - i1_l = LBOUND(SrcParamData%FocalDistanceX,1) - i1_u = UBOUND(SrcParamData%FocalDistanceX,1) - IF (.NOT. ALLOCATED(DstParamData%FocalDistanceX)) THEN - ALLOCATE(DstParamData%FocalDistanceX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FocalDistanceX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FocalDistanceX = SrcParamData%FocalDistanceX -ENDIF -IF (ALLOCATED(SrcParamData%FocalDistanceY)) THEN - i1_l = LBOUND(SrcParamData%FocalDistanceY,1) - i1_u = UBOUND(SrcParamData%FocalDistanceY,1) - IF (.NOT. ALLOCATED(DstParamData%FocalDistanceY)) THEN - ALLOCATE(DstParamData%FocalDistanceY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FocalDistanceY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FocalDistanceY = SrcParamData%FocalDistanceY -ENDIF -IF (ALLOCATED(SrcParamData%FocalDistanceZ)) THEN - i1_l = LBOUND(SrcParamData%FocalDistanceZ,1) - i1_u = UBOUND(SrcParamData%FocalDistanceZ,1) - IF (.NOT. ALLOCATED(DstParamData%FocalDistanceZ)) THEN - ALLOCATE(DstParamData%FocalDistanceZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FocalDistanceZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FocalDistanceZ = SrcParamData%FocalDistanceZ -ENDIF -IF (ALLOCATED(SrcParamData%MsrPosition)) THEN - i1_l = LBOUND(SrcParamData%MsrPosition,1) - i1_u = UBOUND(SrcParamData%MsrPosition,1) - i2_l = LBOUND(SrcParamData%MsrPosition,2) - i2_u = UBOUND(SrcParamData%MsrPosition,2) - IF (.NOT. ALLOCATED(DstParamData%MsrPosition)) THEN - ALLOCATE(DstParamData%MsrPosition(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MsrPosition.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%MsrPosition = SrcParamData%MsrPosition -ENDIF - DstParamData%PulseSpacing = SrcParamData%PulseSpacing - DstParamData%URefLid = SrcParamData%URefLid - DstParamData%ConsiderHubMotion = SrcParamData%ConsiderHubMotion - DstParamData%MeasurementInterval = SrcParamData%MeasurementInterval - DstParamData%LidPosition = SrcParamData%LidPosition - END SUBROUTINE Lidar_CopyParam - - SUBROUTINE Lidar_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(Lidar_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%FocalDistanceX)) THEN - DEALLOCATE(ParamData%FocalDistanceX) -ENDIF -IF (ALLOCATED(ParamData%FocalDistanceY)) THEN - DEALLOCATE(ParamData%FocalDistanceY) -ENDIF -IF (ALLOCATED(ParamData%FocalDistanceZ)) THEN - DEALLOCATE(ParamData%FocalDistanceZ) -ENDIF -IF (ALLOCATED(ParamData%MsrPosition)) THEN - DEALLOCATE(ParamData%MsrPosition) -ENDIF - END SUBROUTINE Lidar_DestroyParam + ErrMsg = '' + DstParamData%NumPulseGate = SrcParamData%NumPulseGate + DstParamData%RotorApexOffsetPos = SrcParamData%RotorApexOffsetPos + DstParamData%RayRangeSq = SrcParamData%RayRangeSq + DstParamData%SpatialRes = SrcParamData%SpatialRes + DstParamData%SensorType = SrcParamData%SensorType + DstParamData%WtFnTrunc = SrcParamData%WtFnTrunc + DstParamData%PulseRangeOne = SrcParamData%PulseRangeOne + DstParamData%DeltaP = SrcParamData%DeltaP + DstParamData%DeltaR = SrcParamData%DeltaR + DstParamData%r_p = SrcParamData%r_p + DstParamData%LidRadialVel = SrcParamData%LidRadialVel + DstParamData%DisplacementLidarX = SrcParamData%DisplacementLidarX + DstParamData%DisplacementLidarY = SrcParamData%DisplacementLidarY + DstParamData%DisplacementLidarZ = SrcParamData%DisplacementLidarZ + DstParamData%NumBeam = SrcParamData%NumBeam + if (allocated(SrcParamData%FocalDistanceX)) then + LB(1:1) = lbound(SrcParamData%FocalDistanceX) + UB(1:1) = ubound(SrcParamData%FocalDistanceX) + if (.not. allocated(DstParamData%FocalDistanceX)) then + allocate(DstParamData%FocalDistanceX(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FocalDistanceX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%FocalDistanceX = SrcParamData%FocalDistanceX + else if (allocated(DstParamData%FocalDistanceX)) then + deallocate(DstParamData%FocalDistanceX) + end if + if (allocated(SrcParamData%FocalDistanceY)) then + LB(1:1) = lbound(SrcParamData%FocalDistanceY) + UB(1:1) = ubound(SrcParamData%FocalDistanceY) + if (.not. allocated(DstParamData%FocalDistanceY)) then + allocate(DstParamData%FocalDistanceY(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FocalDistanceY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%FocalDistanceY = SrcParamData%FocalDistanceY + else if (allocated(DstParamData%FocalDistanceY)) then + deallocate(DstParamData%FocalDistanceY) + end if + if (allocated(SrcParamData%FocalDistanceZ)) then + LB(1:1) = lbound(SrcParamData%FocalDistanceZ) + UB(1:1) = ubound(SrcParamData%FocalDistanceZ) + if (.not. allocated(DstParamData%FocalDistanceZ)) then + allocate(DstParamData%FocalDistanceZ(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FocalDistanceZ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%FocalDistanceZ = SrcParamData%FocalDistanceZ + else if (allocated(DstParamData%FocalDistanceZ)) then + deallocate(DstParamData%FocalDistanceZ) + end if + if (allocated(SrcParamData%MsrPosition)) then + LB(1:2) = lbound(SrcParamData%MsrPosition) + UB(1:2) = ubound(SrcParamData%MsrPosition) + if (.not. allocated(DstParamData%MsrPosition)) then + allocate(DstParamData%MsrPosition(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MsrPosition.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%MsrPosition = SrcParamData%MsrPosition + else if (allocated(DstParamData%MsrPosition)) then + deallocate(DstParamData%MsrPosition) + end if + DstParamData%PulseSpacing = SrcParamData%PulseSpacing + DstParamData%URefLid = SrcParamData%URefLid + DstParamData%ConsiderHubMotion = SrcParamData%ConsiderHubMotion + DstParamData%MeasurementInterval = SrcParamData%MeasurementInterval + DstParamData%LidPosition = SrcParamData%LidPosition +end subroutine +subroutine Lidar_DestroyParam(ParamData, ErrStat, ErrMsg) + type(Lidar_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%FocalDistanceX)) then + deallocate(ParamData%FocalDistanceX) + end if + if (allocated(ParamData%FocalDistanceY)) then + deallocate(ParamData%FocalDistanceY) + end if + if (allocated(ParamData%FocalDistanceZ)) then + deallocate(ParamData%FocalDistanceZ) + end if + if (allocated(ParamData%MsrPosition)) then + deallocate(ParamData%MsrPosition) + end if +end subroutine subroutine Lidar_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Lidar_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'Lidar_PackParam' if (Buf%ErrStat >= AbortErrLev) return - ! NumPulseGate call RegPack(Buf, InData%NumPulseGate) if (RegCheckErr(Buf, RoutineName)) return - ! RotorApexOffsetPos call RegPack(Buf, InData%RotorApexOffsetPos) if (RegCheckErr(Buf, RoutineName)) return - ! RayRangeSq call RegPack(Buf, InData%RayRangeSq) if (RegCheckErr(Buf, RoutineName)) return - ! SpatialRes call RegPack(Buf, InData%SpatialRes) if (RegCheckErr(Buf, RoutineName)) return - ! SensorType call RegPack(Buf, InData%SensorType) if (RegCheckErr(Buf, RoutineName)) return - ! WtFnTrunc call RegPack(Buf, InData%WtFnTrunc) if (RegCheckErr(Buf, RoutineName)) return - ! PulseRangeOne call RegPack(Buf, InData%PulseRangeOne) if (RegCheckErr(Buf, RoutineName)) return - ! DeltaP call RegPack(Buf, InData%DeltaP) if (RegCheckErr(Buf, RoutineName)) return - ! DeltaR call RegPack(Buf, InData%DeltaR) if (RegCheckErr(Buf, RoutineName)) return - ! r_p call RegPack(Buf, InData%r_p) if (RegCheckErr(Buf, RoutineName)) return - ! LidRadialVel call RegPack(Buf, InData%LidRadialVel) if (RegCheckErr(Buf, RoutineName)) return - ! DisplacementLidarX call RegPack(Buf, InData%DisplacementLidarX) if (RegCheckErr(Buf, RoutineName)) return - ! DisplacementLidarY call RegPack(Buf, InData%DisplacementLidarY) if (RegCheckErr(Buf, RoutineName)) return - ! DisplacementLidarZ call RegPack(Buf, InData%DisplacementLidarZ) if (RegCheckErr(Buf, RoutineName)) return - ! NumBeam call RegPack(Buf, InData%NumBeam) if (RegCheckErr(Buf, RoutineName)) return - ! FocalDistanceX call RegPack(Buf, allocated(InData%FocalDistanceX)) if (allocated(InData%FocalDistanceX)) then call RegPackBounds(Buf, 1, lbound(InData%FocalDistanceX), ubound(InData%FocalDistanceX)) call RegPack(Buf, InData%FocalDistanceX) end if if (RegCheckErr(Buf, RoutineName)) return - ! FocalDistanceY call RegPack(Buf, allocated(InData%FocalDistanceY)) if (allocated(InData%FocalDistanceY)) then call RegPackBounds(Buf, 1, lbound(InData%FocalDistanceY), ubound(InData%FocalDistanceY)) call RegPack(Buf, InData%FocalDistanceY) end if if (RegCheckErr(Buf, RoutineName)) return - ! FocalDistanceZ call RegPack(Buf, allocated(InData%FocalDistanceZ)) if (allocated(InData%FocalDistanceZ)) then call RegPackBounds(Buf, 1, lbound(InData%FocalDistanceZ), ubound(InData%FocalDistanceZ)) call RegPack(Buf, InData%FocalDistanceZ) end if if (RegCheckErr(Buf, RoutineName)) return - ! MsrPosition call RegPack(Buf, allocated(InData%MsrPosition)) if (allocated(InData%MsrPosition)) then call RegPackBounds(Buf, 2, lbound(InData%MsrPosition), ubound(InData%MsrPosition)) call RegPack(Buf, InData%MsrPosition) end if if (RegCheckErr(Buf, RoutineName)) return - ! PulseSpacing call RegPack(Buf, InData%PulseSpacing) if (RegCheckErr(Buf, RoutineName)) return - ! URefLid call RegPack(Buf, InData%URefLid) if (RegCheckErr(Buf, RoutineName)) return - ! ConsiderHubMotion call RegPack(Buf, InData%ConsiderHubMotion) if (RegCheckErr(Buf, RoutineName)) return - ! MeasurementInterval call RegPack(Buf, InData%MeasurementInterval) if (RegCheckErr(Buf, RoutineName)) return - ! LidPosition call RegPack(Buf, InData%LidPosition) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -483,52 +417,36 @@ subroutine Lidar_UnPackParam(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! NumPulseGate call RegUnpack(Buf, OutData%NumPulseGate) if (RegCheckErr(Buf, RoutineName)) return - ! RotorApexOffsetPos call RegUnpack(Buf, OutData%RotorApexOffsetPos) if (RegCheckErr(Buf, RoutineName)) return - ! RayRangeSq call RegUnpack(Buf, OutData%RayRangeSq) if (RegCheckErr(Buf, RoutineName)) return - ! SpatialRes call RegUnpack(Buf, OutData%SpatialRes) if (RegCheckErr(Buf, RoutineName)) return - ! SensorType call RegUnpack(Buf, OutData%SensorType) if (RegCheckErr(Buf, RoutineName)) return - ! WtFnTrunc call RegUnpack(Buf, OutData%WtFnTrunc) if (RegCheckErr(Buf, RoutineName)) return - ! PulseRangeOne call RegUnpack(Buf, OutData%PulseRangeOne) if (RegCheckErr(Buf, RoutineName)) return - ! DeltaP call RegUnpack(Buf, OutData%DeltaP) if (RegCheckErr(Buf, RoutineName)) return - ! DeltaR call RegUnpack(Buf, OutData%DeltaR) if (RegCheckErr(Buf, RoutineName)) return - ! r_p call RegUnpack(Buf, OutData%r_p) if (RegCheckErr(Buf, RoutineName)) return - ! LidRadialVel call RegUnpack(Buf, OutData%LidRadialVel) if (RegCheckErr(Buf, RoutineName)) return - ! DisplacementLidarX call RegUnpack(Buf, OutData%DisplacementLidarX) if (RegCheckErr(Buf, RoutineName)) return - ! DisplacementLidarY call RegUnpack(Buf, OutData%DisplacementLidarY) if (RegCheckErr(Buf, RoutineName)) return - ! DisplacementLidarZ call RegUnpack(Buf, OutData%DisplacementLidarZ) if (RegCheckErr(Buf, RoutineName)) return - ! NumBeam call RegUnpack(Buf, OutData%NumBeam) if (RegCheckErr(Buf, RoutineName)) return - ! FocalDistanceX if (allocated(OutData%FocalDistanceX)) deallocate(OutData%FocalDistanceX) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -543,7 +461,6 @@ subroutine Lidar_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%FocalDistanceX) if (RegCheckErr(Buf, RoutineName)) return end if - ! FocalDistanceY if (allocated(OutData%FocalDistanceY)) deallocate(OutData%FocalDistanceY) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -558,7 +475,6 @@ subroutine Lidar_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%FocalDistanceY) if (RegCheckErr(Buf, RoutineName)) return end if - ! FocalDistanceZ if (allocated(OutData%FocalDistanceZ)) deallocate(OutData%FocalDistanceZ) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -573,7 +489,6 @@ subroutine Lidar_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%FocalDistanceZ) if (RegCheckErr(Buf, RoutineName)) return end if - ! MsrPosition if (allocated(OutData%MsrPosition)) deallocate(OutData%MsrPosition) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -588,61 +503,44 @@ subroutine Lidar_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%MsrPosition) if (RegCheckErr(Buf, RoutineName)) return end if - ! PulseSpacing call RegUnpack(Buf, OutData%PulseSpacing) if (RegCheckErr(Buf, RoutineName)) return - ! URefLid call RegUnpack(Buf, OutData%URefLid) if (RegCheckErr(Buf, RoutineName)) return - ! ConsiderHubMotion call RegUnpack(Buf, OutData%ConsiderHubMotion) if (RegCheckErr(Buf, RoutineName)) return - ! MeasurementInterval call RegUnpack(Buf, OutData%MeasurementInterval) if (RegCheckErr(Buf, RoutineName)) return - ! LidPosition call RegUnpack(Buf, OutData%LidPosition) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Lidar_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Lidar_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(Lidar_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%DummyContState = SrcContStateData%DummyContState - END SUBROUTINE Lidar_CopyContState - SUBROUTINE Lidar_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(Lidar_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Lidar_DestroyContState +subroutine Lidar_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(Lidar_ContinuousStateType), intent(in) :: SrcContStateData + type(Lidar_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + DstContStateData%DummyContState = SrcContStateData%DummyContState +end subroutine +subroutine Lidar_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(Lidar_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine Lidar_PackContState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Lidar_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'Lidar_PackContState' if (Buf%ErrStat >= AbortErrLev) return - ! DummyContState call RegPack(Buf, InData%DummyContState) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -652,49 +550,36 @@ subroutine Lidar_UnPackContState(Buf, OutData) type(Lidar_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Lidar_UnPackContState' if (Buf%ErrStat /= ErrID_None) return - ! DummyContState call RegUnpack(Buf, OutData%DummyContState) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Lidar_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Lidar_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(Lidar_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState - END SUBROUTINE Lidar_CopyDiscState - - SUBROUTINE Lidar_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(Lidar_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_DestroyDiscState' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Lidar_DestroyDiscState +subroutine Lidar_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(Lidar_DiscreteStateType), intent(in) :: SrcDiscStateData + type(Lidar_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState +end subroutine +subroutine Lidar_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(Lidar_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine Lidar_PackDiscState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Lidar_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'Lidar_PackDiscState' if (Buf%ErrStat >= AbortErrLev) return - ! DummyDiscState call RegPack(Buf, InData%DummyDiscState) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -704,49 +589,36 @@ subroutine Lidar_UnPackDiscState(Buf, OutData) type(Lidar_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Lidar_UnPackDiscState' if (Buf%ErrStat /= ErrID_None) return - ! DummyDiscState call RegUnpack(Buf, OutData%DummyDiscState) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Lidar_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Lidar_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(Lidar_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE Lidar_CopyConstrState - - SUBROUTINE Lidar_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(Lidar_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_DestroyConstrState' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Lidar_DestroyConstrState +subroutine Lidar_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(Lidar_ConstraintStateType), intent(in) :: SrcConstrStateData + type(Lidar_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine +subroutine Lidar_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(Lidar_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine Lidar_PackConstrState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Lidar_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'Lidar_PackConstrState' if (Buf%ErrStat >= AbortErrLev) return - ! DummyConstrState call RegPack(Buf, InData%DummyConstrState) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -756,49 +628,36 @@ subroutine Lidar_UnPackConstrState(Buf, OutData) type(Lidar_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Lidar_UnPackConstrState' if (Buf%ErrStat /= ErrID_None) return - ! DummyConstrState call RegUnpack(Buf, OutData%DummyConstrState) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Lidar_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Lidar_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(Lidar_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState - END SUBROUTINE Lidar_CopyOtherState - SUBROUTINE Lidar_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(Lidar_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Lidar_DestroyOtherState +subroutine Lidar_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(Lidar_OtherStateType), intent(in) :: SrcOtherStateData + type(Lidar_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState +end subroutine +subroutine Lidar_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(Lidar_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine Lidar_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Lidar_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'Lidar_PackOtherState' if (Buf%ErrStat >= AbortErrLev) return - ! DummyOtherState call RegPack(Buf, InData%DummyOtherState) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -808,49 +667,36 @@ subroutine Lidar_UnPackOtherState(Buf, OutData) type(Lidar_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Lidar_UnPackOtherState' if (Buf%ErrStat /= ErrID_None) return - ! DummyOtherState call RegUnpack(Buf, OutData%DummyOtherState) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Lidar_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Lidar_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(Lidar_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar - END SUBROUTINE Lidar_CopyMisc - - SUBROUTINE Lidar_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(Lidar_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_DestroyMisc' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Lidar_DestroyMisc +subroutine Lidar_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(Lidar_MiscVarType), intent(in) :: SrcMiscData + type(Lidar_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar +end subroutine +subroutine Lidar_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(Lidar_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine Lidar_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Lidar_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'Lidar_PackMisc' if (Buf%ErrStat >= AbortErrLev) return - ! DummyMiscVar call RegPack(Buf, InData%DummyMiscVar) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -860,65 +706,48 @@ subroutine Lidar_UnPackMisc(Buf, OutData) type(Lidar_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Lidar_UnPackMisc' if (Buf%ErrStat /= ErrID_None) return - ! DummyMiscVar call RegUnpack(Buf, OutData%DummyMiscVar) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Lidar_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Lidar_InputType), INTENT(IN) :: SrcInputData - TYPE(Lidar_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_CopyInput' -! + +subroutine Lidar_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(Lidar_InputType), intent(in) :: SrcInputData + type(Lidar_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_CopyInput' ErrStat = ErrID_None - ErrMsg = "" - DstInputData%PulseLidEl = SrcInputData%PulseLidEl - DstInputData%PulseLidAz = SrcInputData%PulseLidAz - DstInputData%HubDisplacementX = SrcInputData%HubDisplacementX - DstInputData%HubDisplacementY = SrcInputData%HubDisplacementY - DstInputData%HubDisplacementZ = SrcInputData%HubDisplacementZ - END SUBROUTINE Lidar_CopyInput - - SUBROUTINE Lidar_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(Lidar_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Lidar_DestroyInput + ErrMsg = '' + DstInputData%PulseLidEl = SrcInputData%PulseLidEl + DstInputData%PulseLidAz = SrcInputData%PulseLidAz + DstInputData%HubDisplacementX = SrcInputData%HubDisplacementX + DstInputData%HubDisplacementY = SrcInputData%HubDisplacementY + DstInputData%HubDisplacementZ = SrcInputData%HubDisplacementZ +end subroutine +subroutine Lidar_DestroyInput(InputData, ErrStat, ErrMsg) + type(Lidar_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine Lidar_PackInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Lidar_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Lidar_PackInput' if (Buf%ErrStat >= AbortErrLev) return - ! PulseLidEl call RegPack(Buf, InData%PulseLidEl) if (RegCheckErr(Buf, RoutineName)) return - ! PulseLidAz call RegPack(Buf, InData%PulseLidAz) if (RegCheckErr(Buf, RoutineName)) return - ! HubDisplacementX call RegPack(Buf, InData%HubDisplacementX) if (RegCheckErr(Buf, RoutineName)) return - ! HubDisplacementY call RegPack(Buf, InData%HubDisplacementY) if (RegCheckErr(Buf, RoutineName)) return - ! HubDisplacementZ call RegPack(Buf, InData%HubDisplacementZ) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -928,164 +757,154 @@ subroutine Lidar_UnPackInput(Buf, OutData) type(Lidar_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Lidar_UnPackInput' if (Buf%ErrStat /= ErrID_None) return - ! PulseLidEl call RegUnpack(Buf, OutData%PulseLidEl) if (RegCheckErr(Buf, RoutineName)) return - ! PulseLidAz call RegUnpack(Buf, OutData%PulseLidAz) if (RegCheckErr(Buf, RoutineName)) return - ! HubDisplacementX call RegUnpack(Buf, OutData%HubDisplacementX) if (RegCheckErr(Buf, RoutineName)) return - ! HubDisplacementY call RegUnpack(Buf, OutData%HubDisplacementY) if (RegCheckErr(Buf, RoutineName)) return - ! HubDisplacementZ call RegUnpack(Buf, OutData%HubDisplacementZ) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Lidar_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Lidar_OutputType), INTENT(IN) :: SrcOutputData - TYPE(Lidar_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_CopyOutput' -! + +subroutine Lidar_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(Lidar_OutputType), intent(in) :: SrcOutputData + type(Lidar_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Lidar_CopyOutput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%LidSpeed)) THEN - i1_l = LBOUND(SrcOutputData%LidSpeed,1) - i1_u = UBOUND(SrcOutputData%LidSpeed,1) - IF (.NOT. ALLOCATED(DstOutputData%LidSpeed)) THEN - ALLOCATE(DstOutputData%LidSpeed(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%LidSpeed.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%LidSpeed = SrcOutputData%LidSpeed -ENDIF -IF (ALLOCATED(SrcOutputData%WtTrunc)) THEN - i1_l = LBOUND(SrcOutputData%WtTrunc,1) - i1_u = UBOUND(SrcOutputData%WtTrunc,1) - IF (.NOT. ALLOCATED(DstOutputData%WtTrunc)) THEN - ALLOCATE(DstOutputData%WtTrunc(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WtTrunc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%WtTrunc = SrcOutputData%WtTrunc -ENDIF -IF (ALLOCATED(SrcOutputData%MsrPositionsX)) THEN - i1_l = LBOUND(SrcOutputData%MsrPositionsX,1) - i1_u = UBOUND(SrcOutputData%MsrPositionsX,1) - IF (.NOT. ALLOCATED(DstOutputData%MsrPositionsX)) THEN - ALLOCATE(DstOutputData%MsrPositionsX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%MsrPositionsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%MsrPositionsX = SrcOutputData%MsrPositionsX -ENDIF -IF (ALLOCATED(SrcOutputData%MsrPositionsY)) THEN - i1_l = LBOUND(SrcOutputData%MsrPositionsY,1) - i1_u = UBOUND(SrcOutputData%MsrPositionsY,1) - IF (.NOT. ALLOCATED(DstOutputData%MsrPositionsY)) THEN - ALLOCATE(DstOutputData%MsrPositionsY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%MsrPositionsY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%MsrPositionsY = SrcOutputData%MsrPositionsY -ENDIF -IF (ALLOCATED(SrcOutputData%MsrPositionsZ)) THEN - i1_l = LBOUND(SrcOutputData%MsrPositionsZ,1) - i1_u = UBOUND(SrcOutputData%MsrPositionsZ,1) - IF (.NOT. ALLOCATED(DstOutputData%MsrPositionsZ)) THEN - ALLOCATE(DstOutputData%MsrPositionsZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%MsrPositionsZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%MsrPositionsZ = SrcOutputData%MsrPositionsZ -ENDIF - END SUBROUTINE Lidar_CopyOutput - - SUBROUTINE Lidar_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(Lidar_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OutputData%LidSpeed)) THEN - DEALLOCATE(OutputData%LidSpeed) -ENDIF -IF (ALLOCATED(OutputData%WtTrunc)) THEN - DEALLOCATE(OutputData%WtTrunc) -ENDIF -IF (ALLOCATED(OutputData%MsrPositionsX)) THEN - DEALLOCATE(OutputData%MsrPositionsX) -ENDIF -IF (ALLOCATED(OutputData%MsrPositionsY)) THEN - DEALLOCATE(OutputData%MsrPositionsY) -ENDIF -IF (ALLOCATED(OutputData%MsrPositionsZ)) THEN - DEALLOCATE(OutputData%MsrPositionsZ) -ENDIF - END SUBROUTINE Lidar_DestroyOutput + ErrMsg = '' + if (allocated(SrcOutputData%LidSpeed)) then + LB(1:1) = lbound(SrcOutputData%LidSpeed) + UB(1:1) = ubound(SrcOutputData%LidSpeed) + if (.not. allocated(DstOutputData%LidSpeed)) then + allocate(DstOutputData%LidSpeed(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%LidSpeed.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%LidSpeed = SrcOutputData%LidSpeed + else if (allocated(DstOutputData%LidSpeed)) then + deallocate(DstOutputData%LidSpeed) + end if + if (allocated(SrcOutputData%WtTrunc)) then + LB(1:1) = lbound(SrcOutputData%WtTrunc) + UB(1:1) = ubound(SrcOutputData%WtTrunc) + if (.not. allocated(DstOutputData%WtTrunc)) then + allocate(DstOutputData%WtTrunc(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WtTrunc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%WtTrunc = SrcOutputData%WtTrunc + else if (allocated(DstOutputData%WtTrunc)) then + deallocate(DstOutputData%WtTrunc) + end if + if (allocated(SrcOutputData%MsrPositionsX)) then + LB(1:1) = lbound(SrcOutputData%MsrPositionsX) + UB(1:1) = ubound(SrcOutputData%MsrPositionsX) + if (.not. allocated(DstOutputData%MsrPositionsX)) then + allocate(DstOutputData%MsrPositionsX(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%MsrPositionsX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%MsrPositionsX = SrcOutputData%MsrPositionsX + else if (allocated(DstOutputData%MsrPositionsX)) then + deallocate(DstOutputData%MsrPositionsX) + end if + if (allocated(SrcOutputData%MsrPositionsY)) then + LB(1:1) = lbound(SrcOutputData%MsrPositionsY) + UB(1:1) = ubound(SrcOutputData%MsrPositionsY) + if (.not. allocated(DstOutputData%MsrPositionsY)) then + allocate(DstOutputData%MsrPositionsY(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%MsrPositionsY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%MsrPositionsY = SrcOutputData%MsrPositionsY + else if (allocated(DstOutputData%MsrPositionsY)) then + deallocate(DstOutputData%MsrPositionsY) + end if + if (allocated(SrcOutputData%MsrPositionsZ)) then + LB(1:1) = lbound(SrcOutputData%MsrPositionsZ) + UB(1:1) = ubound(SrcOutputData%MsrPositionsZ) + if (.not. allocated(DstOutputData%MsrPositionsZ)) then + allocate(DstOutputData%MsrPositionsZ(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%MsrPositionsZ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%MsrPositionsZ = SrcOutputData%MsrPositionsZ + else if (allocated(DstOutputData%MsrPositionsZ)) then + deallocate(DstOutputData%MsrPositionsZ) + end if +end subroutine +subroutine Lidar_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(Lidar_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Lidar_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%LidSpeed)) then + deallocate(OutputData%LidSpeed) + end if + if (allocated(OutputData%WtTrunc)) then + deallocate(OutputData%WtTrunc) + end if + if (allocated(OutputData%MsrPositionsX)) then + deallocate(OutputData%MsrPositionsX) + end if + if (allocated(OutputData%MsrPositionsY)) then + deallocate(OutputData%MsrPositionsY) + end if + if (allocated(OutputData%MsrPositionsZ)) then + deallocate(OutputData%MsrPositionsZ) + end if +end subroutine subroutine Lidar_PackOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Lidar_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Lidar_PackOutput' if (Buf%ErrStat >= AbortErrLev) return - ! LidSpeed call RegPack(Buf, allocated(InData%LidSpeed)) if (allocated(InData%LidSpeed)) then call RegPackBounds(Buf, 1, lbound(InData%LidSpeed), ubound(InData%LidSpeed)) call RegPack(Buf, InData%LidSpeed) end if if (RegCheckErr(Buf, RoutineName)) return - ! WtTrunc call RegPack(Buf, allocated(InData%WtTrunc)) if (allocated(InData%WtTrunc)) then call RegPackBounds(Buf, 1, lbound(InData%WtTrunc), ubound(InData%WtTrunc)) call RegPack(Buf, InData%WtTrunc) end if if (RegCheckErr(Buf, RoutineName)) return - ! MsrPositionsX call RegPack(Buf, allocated(InData%MsrPositionsX)) if (allocated(InData%MsrPositionsX)) then call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsX), ubound(InData%MsrPositionsX)) call RegPack(Buf, InData%MsrPositionsX) end if if (RegCheckErr(Buf, RoutineName)) return - ! MsrPositionsY call RegPack(Buf, allocated(InData%MsrPositionsY)) if (allocated(InData%MsrPositionsY)) then call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsY), ubound(InData%MsrPositionsY)) call RegPack(Buf, InData%MsrPositionsY) end if if (RegCheckErr(Buf, RoutineName)) return - ! MsrPositionsZ call RegPack(Buf, allocated(InData%MsrPositionsZ)) if (allocated(InData%MsrPositionsZ)) then call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsZ), ubound(InData%MsrPositionsZ)) @@ -1102,7 +921,6 @@ subroutine Lidar_UnPackOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! LidSpeed if (allocated(OutData%LidSpeed)) deallocate(OutData%LidSpeed) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1117,7 +935,6 @@ subroutine Lidar_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%LidSpeed) if (RegCheckErr(Buf, RoutineName)) return end if - ! WtTrunc if (allocated(OutData%WtTrunc)) deallocate(OutData%WtTrunc) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1132,7 +949,6 @@ subroutine Lidar_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%WtTrunc) if (RegCheckErr(Buf, RoutineName)) return end if - ! MsrPositionsX if (allocated(OutData%MsrPositionsX)) deallocate(OutData%MsrPositionsX) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1147,7 +963,6 @@ subroutine Lidar_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%MsrPositionsX) if (RegCheckErr(Buf, RoutineName)) return end if - ! MsrPositionsY if (allocated(OutData%MsrPositionsY)) deallocate(OutData%MsrPositionsY) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1162,7 +977,6 @@ subroutine Lidar_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%MsrPositionsY) if (RegCheckErr(Buf, RoutineName)) return end if - ! MsrPositionsZ if (allocated(OutData%MsrPositionsZ)) deallocate(OutData%MsrPositionsZ) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/map/src/MAP_Fortran_Types.f90 b/modules/map/src/MAP_Fortran_Types.f90 index 01065f5564..63697c7a7d 100644 --- a/modules/map/src/MAP_Fortran_Types.f90 +++ b/modules/map/src/MAP_Fortran_Types.f90 @@ -53,45 +53,33 @@ MODULE MAP_Fortran_Types END TYPE Lin_ParamType ! ======================= CONTAINS - SUBROUTINE MAP_Fortran_CopyLin_InitInputType( SrcLin_InitInputTypeData, DstLin_InitInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Lin_InitInputType), INTENT(IN) :: SrcLin_InitInputTypeData - TYPE(Lin_InitInputType), INTENT(INOUT) :: DstLin_InitInputTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Fortran_CopyLin_InitInputType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstLin_InitInputTypeData%linearize = SrcLin_InitInputTypeData%linearize - END SUBROUTINE MAP_Fortran_CopyLin_InitInputType - - SUBROUTINE MAP_Fortran_DestroyLin_InitInputType( Lin_InitInputTypeData, ErrStat, ErrMsg ) - TYPE(Lin_InitInputType), INTENT(INOUT) :: Lin_InitInputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Fortran_DestroyLin_InitInputType' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE MAP_Fortran_DestroyLin_InitInputType +subroutine MAP_Fortran_CopyLin_InitInputType(SrcLin_InitInputTypeData, DstLin_InitInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(Lin_InitInputType), intent(in) :: SrcLin_InitInputTypeData + type(Lin_InitInputType), intent(inout) :: DstLin_InitInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MAP_Fortran_CopyLin_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' + DstLin_InitInputTypeData%linearize = SrcLin_InitInputTypeData%linearize +end subroutine +subroutine MAP_Fortran_DestroyLin_InitInputType(Lin_InitInputTypeData, ErrStat, ErrMsg) + type(Lin_InitInputType), intent(inout) :: Lin_InitInputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MAP_Fortran_DestroyLin_InitInputType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine MAP_Fortran_PackLin_InitInputType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Lin_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'MAP_Fortran_PackLin_InitInputType' if (Buf%ErrStat >= AbortErrLev) return - ! linearize call RegPack(Buf, InData%linearize) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -101,108 +89,100 @@ subroutine MAP_Fortran_UnPackLin_InitInputType(Buf, OutData) type(Lin_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MAP_Fortran_UnPackLin_InitInputType' if (Buf%ErrStat /= ErrID_None) return - ! linearize call RegUnpack(Buf, OutData%linearize) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE MAP_Fortran_CopyLin_InitOutputType( SrcLin_InitOutputTypeData, DstLin_InitOutputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Lin_InitOutputType), INTENT(IN) :: SrcLin_InitOutputTypeData - TYPE(Lin_InitOutputType), INTENT(INOUT) :: DstLin_InitOutputTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Fortran_CopyLin_InitOutputType' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcLin_InitOutputTypeData%LinNames_y)) THEN - i1_l = LBOUND(SrcLin_InitOutputTypeData%LinNames_y,1) - i1_u = UBOUND(SrcLin_InitOutputTypeData%LinNames_y,1) - IF (.NOT. ALLOCATED(DstLin_InitOutputTypeData%LinNames_y)) THEN - ALLOCATE(DstLin_InitOutputTypeData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLin_InitOutputTypeData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLin_InitOutputTypeData%LinNames_y = SrcLin_InitOutputTypeData%LinNames_y -ENDIF -IF (ALLOCATED(SrcLin_InitOutputTypeData%LinNames_u)) THEN - i1_l = LBOUND(SrcLin_InitOutputTypeData%LinNames_u,1) - i1_u = UBOUND(SrcLin_InitOutputTypeData%LinNames_u,1) - IF (.NOT. ALLOCATED(DstLin_InitOutputTypeData%LinNames_u)) THEN - ALLOCATE(DstLin_InitOutputTypeData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLin_InitOutputTypeData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLin_InitOutputTypeData%LinNames_u = SrcLin_InitOutputTypeData%LinNames_u -ENDIF -IF (ALLOCATED(SrcLin_InitOutputTypeData%IsLoad_u)) THEN - i1_l = LBOUND(SrcLin_InitOutputTypeData%IsLoad_u,1) - i1_u = UBOUND(SrcLin_InitOutputTypeData%IsLoad_u,1) - IF (.NOT. ALLOCATED(DstLin_InitOutputTypeData%IsLoad_u)) THEN - ALLOCATE(DstLin_InitOutputTypeData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLin_InitOutputTypeData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLin_InitOutputTypeData%IsLoad_u = SrcLin_InitOutputTypeData%IsLoad_u -ENDIF - END SUBROUTINE MAP_Fortran_CopyLin_InitOutputType - - SUBROUTINE MAP_Fortran_DestroyLin_InitOutputType( Lin_InitOutputTypeData, ErrStat, ErrMsg ) - TYPE(Lin_InitOutputType), INTENT(INOUT) :: Lin_InitOutputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Fortran_DestroyLin_InitOutputType' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(Lin_InitOutputTypeData%LinNames_y)) THEN - DEALLOCATE(Lin_InitOutputTypeData%LinNames_y) -ENDIF -IF (ALLOCATED(Lin_InitOutputTypeData%LinNames_u)) THEN - DEALLOCATE(Lin_InitOutputTypeData%LinNames_u) -ENDIF -IF (ALLOCATED(Lin_InitOutputTypeData%IsLoad_u)) THEN - DEALLOCATE(Lin_InitOutputTypeData%IsLoad_u) -ENDIF - END SUBROUTINE MAP_Fortran_DestroyLin_InitOutputType +subroutine MAP_Fortran_CopyLin_InitOutputType(SrcLin_InitOutputTypeData, DstLin_InitOutputTypeData, CtrlCode, ErrStat, ErrMsg) + type(Lin_InitOutputType), intent(in) :: SrcLin_InitOutputTypeData + type(Lin_InitOutputType), intent(inout) :: DstLin_InitOutputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'MAP_Fortran_CopyLin_InitOutputType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcLin_InitOutputTypeData%LinNames_y)) then + LB(1:1) = lbound(SrcLin_InitOutputTypeData%LinNames_y) + UB(1:1) = ubound(SrcLin_InitOutputTypeData%LinNames_y) + if (.not. allocated(DstLin_InitOutputTypeData%LinNames_y)) then + allocate(DstLin_InitOutputTypeData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLin_InitOutputTypeData%LinNames_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLin_InitOutputTypeData%LinNames_y = SrcLin_InitOutputTypeData%LinNames_y + else if (allocated(DstLin_InitOutputTypeData%LinNames_y)) then + deallocate(DstLin_InitOutputTypeData%LinNames_y) + end if + if (allocated(SrcLin_InitOutputTypeData%LinNames_u)) then + LB(1:1) = lbound(SrcLin_InitOutputTypeData%LinNames_u) + UB(1:1) = ubound(SrcLin_InitOutputTypeData%LinNames_u) + if (.not. allocated(DstLin_InitOutputTypeData%LinNames_u)) then + allocate(DstLin_InitOutputTypeData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLin_InitOutputTypeData%LinNames_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLin_InitOutputTypeData%LinNames_u = SrcLin_InitOutputTypeData%LinNames_u + else if (allocated(DstLin_InitOutputTypeData%LinNames_u)) then + deallocate(DstLin_InitOutputTypeData%LinNames_u) + end if + if (allocated(SrcLin_InitOutputTypeData%IsLoad_u)) then + LB(1:1) = lbound(SrcLin_InitOutputTypeData%IsLoad_u) + UB(1:1) = ubound(SrcLin_InitOutputTypeData%IsLoad_u) + if (.not. allocated(DstLin_InitOutputTypeData%IsLoad_u)) then + allocate(DstLin_InitOutputTypeData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLin_InitOutputTypeData%IsLoad_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLin_InitOutputTypeData%IsLoad_u = SrcLin_InitOutputTypeData%IsLoad_u + else if (allocated(DstLin_InitOutputTypeData%IsLoad_u)) then + deallocate(DstLin_InitOutputTypeData%IsLoad_u) + end if +end subroutine +subroutine MAP_Fortran_DestroyLin_InitOutputType(Lin_InitOutputTypeData, ErrStat, ErrMsg) + type(Lin_InitOutputType), intent(inout) :: Lin_InitOutputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MAP_Fortran_DestroyLin_InitOutputType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(Lin_InitOutputTypeData%LinNames_y)) then + deallocate(Lin_InitOutputTypeData%LinNames_y) + end if + if (allocated(Lin_InitOutputTypeData%LinNames_u)) then + deallocate(Lin_InitOutputTypeData%LinNames_u) + end if + if (allocated(Lin_InitOutputTypeData%IsLoad_u)) then + deallocate(Lin_InitOutputTypeData%IsLoad_u) + end if +end subroutine subroutine MAP_Fortran_PackLin_InitOutputType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Lin_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'MAP_Fortran_PackLin_InitOutputType' if (Buf%ErrStat >= AbortErrLev) return - ! LinNames_y call RegPack(Buf, allocated(InData%LinNames_y)) if (allocated(InData%LinNames_y)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) call RegPack(Buf, InData%LinNames_y) end if if (RegCheckErr(Buf, RoutineName)) return - ! LinNames_u call RegPack(Buf, allocated(InData%LinNames_u)) if (allocated(InData%LinNames_u)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) call RegPack(Buf, InData%LinNames_u) end if if (RegCheckErr(Buf, RoutineName)) return - ! IsLoad_u call RegPack(Buf, allocated(InData%IsLoad_u)) if (allocated(InData%IsLoad_u)) then call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) @@ -219,7 +199,6 @@ subroutine MAP_Fortran_UnPackLin_InitOutputType(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! LinNames_y if (allocated(OutData%LinNames_y)) deallocate(OutData%LinNames_y) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -234,7 +213,6 @@ subroutine MAP_Fortran_UnPackLin_InitOutputType(Buf, OutData) call RegUnpack(Buf, OutData%LinNames_y) if (RegCheckErr(Buf, RoutineName)) return end if - ! LinNames_u if (allocated(OutData%LinNames_u)) deallocate(OutData%LinNames_u) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -249,7 +227,6 @@ subroutine MAP_Fortran_UnPackLin_InitOutputType(Buf, OutData) call RegUnpack(Buf, OutData%LinNames_u) if (RegCheckErr(Buf, RoutineName)) return end if - ! IsLoad_u if (allocated(OutData%IsLoad_u)) deallocate(OutData%IsLoad_u) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -265,75 +242,61 @@ subroutine MAP_Fortran_UnPackLin_InitOutputType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE MAP_Fortran_CopyLin_ParamType( SrcLin_ParamTypeData, DstLin_ParamTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Lin_ParamType), INTENT(IN) :: SrcLin_ParamTypeData - TYPE(Lin_ParamType), INTENT(INOUT) :: DstLin_ParamTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Fortran_CopyLin_ParamType' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcLin_ParamTypeData%Jac_u_indx)) THEN - i1_l = LBOUND(SrcLin_ParamTypeData%Jac_u_indx,1) - i1_u = UBOUND(SrcLin_ParamTypeData%Jac_u_indx,1) - i2_l = LBOUND(SrcLin_ParamTypeData%Jac_u_indx,2) - i2_u = UBOUND(SrcLin_ParamTypeData%Jac_u_indx,2) - IF (.NOT. ALLOCATED(DstLin_ParamTypeData%Jac_u_indx)) THEN - ALLOCATE(DstLin_ParamTypeData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLin_ParamTypeData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLin_ParamTypeData%Jac_u_indx = SrcLin_ParamTypeData%Jac_u_indx -ENDIF - DstLin_ParamTypeData%du = SrcLin_ParamTypeData%du - DstLin_ParamTypeData%Jac_ny = SrcLin_ParamTypeData%Jac_ny - END SUBROUTINE MAP_Fortran_CopyLin_ParamType - - SUBROUTINE MAP_Fortran_DestroyLin_ParamType( Lin_ParamTypeData, ErrStat, ErrMsg ) - TYPE(Lin_ParamType), INTENT(INOUT) :: Lin_ParamTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Fortran_DestroyLin_ParamType' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(Lin_ParamTypeData%Jac_u_indx)) THEN - DEALLOCATE(Lin_ParamTypeData%Jac_u_indx) -ENDIF - END SUBROUTINE MAP_Fortran_DestroyLin_ParamType +subroutine MAP_Fortran_CopyLin_ParamType(SrcLin_ParamTypeData, DstLin_ParamTypeData, CtrlCode, ErrStat, ErrMsg) + type(Lin_ParamType), intent(in) :: SrcLin_ParamTypeData + type(Lin_ParamType), intent(inout) :: DstLin_ParamTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'MAP_Fortran_CopyLin_ParamType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcLin_ParamTypeData%Jac_u_indx)) then + LB(1:2) = lbound(SrcLin_ParamTypeData%Jac_u_indx) + UB(1:2) = ubound(SrcLin_ParamTypeData%Jac_u_indx) + if (.not. allocated(DstLin_ParamTypeData%Jac_u_indx)) then + allocate(DstLin_ParamTypeData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLin_ParamTypeData%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLin_ParamTypeData%Jac_u_indx = SrcLin_ParamTypeData%Jac_u_indx + else if (allocated(DstLin_ParamTypeData%Jac_u_indx)) then + deallocate(DstLin_ParamTypeData%Jac_u_indx) + end if + DstLin_ParamTypeData%du = SrcLin_ParamTypeData%du + DstLin_ParamTypeData%Jac_ny = SrcLin_ParamTypeData%Jac_ny +end subroutine +subroutine MAP_Fortran_DestroyLin_ParamType(Lin_ParamTypeData, ErrStat, ErrMsg) + type(Lin_ParamType), intent(inout) :: Lin_ParamTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MAP_Fortran_DestroyLin_ParamType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(Lin_ParamTypeData%Jac_u_indx)) then + deallocate(Lin_ParamTypeData%Jac_u_indx) + end if +end subroutine subroutine MAP_Fortran_PackLin_ParamType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Lin_ParamType), intent(in) :: InData character(*), parameter :: RoutineName = 'MAP_Fortran_PackLin_ParamType' if (Buf%ErrStat >= AbortErrLev) return - ! Jac_u_indx call RegPack(Buf, allocated(InData%Jac_u_indx)) if (allocated(InData%Jac_u_indx)) then call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx), ubound(InData%Jac_u_indx)) call RegPack(Buf, InData%Jac_u_indx) end if if (RegCheckErr(Buf, RoutineName)) return - ! du call RegPack(Buf, InData%du) if (RegCheckErr(Buf, RoutineName)) return - ! Jac_ny call RegPack(Buf, InData%Jac_ny) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -346,7 +309,6 @@ subroutine MAP_Fortran_UnPackLin_ParamType(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! Jac_u_indx if (allocated(OutData%Jac_u_indx)) deallocate(OutData%Jac_u_indx) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -361,10 +323,8 @@ subroutine MAP_Fortran_UnPackLin_ParamType(Buf, OutData) call RegUnpack(Buf, OutData%Jac_u_indx) if (RegCheckErr(Buf, RoutineName)) return end if - ! du call RegUnpack(Buf, OutData%du) if (RegCheckErr(Buf, RoutineName)) return - ! Jac_ny call RegUnpack(Buf, OutData%Jac_ny) if (RegCheckErr(Buf, RoutineName)) return end subroutine diff --git a/modules/map/src/MAP_Types.f90 b/modules/map/src/MAP_Types.f90 index fdaf63fb3f..0d12ba647c 100644 --- a/modules/map/src/MAP_Types.f90 +++ b/modules/map/src/MAP_Types.f90 @@ -246,60 +246,51 @@ MODULE MAP_Types END TYPE MAP_OutputType ! ======================= CONTAINS - SUBROUTINE MAP_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MAP_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(MAP_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_CopyInitInput' -! + +subroutine MAP_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(MAP_InitInputType), intent(in) :: SrcInitInputData + type(MAP_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MAP_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%gravity = SrcInitInputData%gravity - DstInitInputData%C_obj%gravity = SrcInitInputData%C_obj%gravity - DstInitInputData%sea_density = SrcInitInputData%sea_density - DstInitInputData%C_obj%sea_density = SrcInitInputData%C_obj%sea_density - DstInitInputData%depth = SrcInitInputData%depth - DstInitInputData%C_obj%depth = SrcInitInputData%C_obj%depth - DstInitInputData%file_name = SrcInitInputData%file_name - DstInitInputData%C_obj%file_name = SrcInitInputData%C_obj%file_name - DstInitInputData%summary_file_name = SrcInitInputData%summary_file_name - DstInitInputData%C_obj%summary_file_name = SrcInitInputData%C_obj%summary_file_name - DstInitInputData%library_input_str = SrcInitInputData%library_input_str - DstInitInputData%C_obj%library_input_str = SrcInitInputData%C_obj%library_input_str - DstInitInputData%node_input_str = SrcInitInputData%node_input_str - DstInitInputData%C_obj%node_input_str = SrcInitInputData%C_obj%node_input_str - DstInitInputData%line_input_str = SrcInitInputData%line_input_str - DstInitInputData%C_obj%line_input_str = SrcInitInputData%C_obj%line_input_str - DstInitInputData%option_input_str = SrcInitInputData%option_input_str - DstInitInputData%C_obj%option_input_str = SrcInitInputData%C_obj%option_input_str - CALL MAP_Fortran_Copylin_initinputtype( SrcInitInputData%LinInitInp, DstInitInputData%LinInitInp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE MAP_CopyInitInput - - SUBROUTINE MAP_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(MAP_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL MAP_Fortran_DestroyLin_InitInputType( InitInputData%LinInitInp, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE MAP_DestroyInitInput + ErrMsg = '' + DstInitInputData%gravity = SrcInitInputData%gravity + DstInitInputData%C_obj%gravity = SrcInitInputData%C_obj%gravity + DstInitInputData%sea_density = SrcInitInputData%sea_density + DstInitInputData%C_obj%sea_density = SrcInitInputData%C_obj%sea_density + DstInitInputData%depth = SrcInitInputData%depth + DstInitInputData%C_obj%depth = SrcInitInputData%C_obj%depth + DstInitInputData%file_name = SrcInitInputData%file_name + DstInitInputData%C_obj%file_name = SrcInitInputData%C_obj%file_name + DstInitInputData%summary_file_name = SrcInitInputData%summary_file_name + DstInitInputData%C_obj%summary_file_name = SrcInitInputData%C_obj%summary_file_name + DstInitInputData%library_input_str = SrcInitInputData%library_input_str + DstInitInputData%C_obj%library_input_str = SrcInitInputData%C_obj%library_input_str + DstInitInputData%node_input_str = SrcInitInputData%node_input_str + DstInitInputData%C_obj%node_input_str = SrcInitInputData%C_obj%node_input_str + DstInitInputData%line_input_str = SrcInitInputData%line_input_str + DstInitInputData%C_obj%line_input_str = SrcInitInputData%C_obj%line_input_str + DstInitInputData%option_input_str = SrcInitInputData%option_input_str + DstInitInputData%C_obj%option_input_str = SrcInitInputData%C_obj%option_input_str + call MAP_Fortran_CopyLin_InitInputType(SrcInitInputData%LinInitInp, DstInitInputData%LinInitInp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine MAP_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(MAP_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MAP_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine MAP_PackInitInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -310,34 +301,24 @@ subroutine MAP_PackInitInput(Buf, Indata) call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - ! gravity call RegPack(Buf, InData%gravity) if (RegCheckErr(Buf, RoutineName)) return - ! sea_density call RegPack(Buf, InData%sea_density) if (RegCheckErr(Buf, RoutineName)) return - ! depth call RegPack(Buf, InData%depth) if (RegCheckErr(Buf, RoutineName)) return - ! file_name call RegPack(Buf, InData%file_name) if (RegCheckErr(Buf, RoutineName)) return - ! summary_file_name call RegPack(Buf, InData%summary_file_name) if (RegCheckErr(Buf, RoutineName)) return - ! library_input_str call RegPack(Buf, InData%library_input_str) if (RegCheckErr(Buf, RoutineName)) return - ! node_input_str call RegPack(Buf, InData%node_input_str) if (RegCheckErr(Buf, RoutineName)) return - ! line_input_str call RegPack(Buf, InData%line_input_str) if (RegCheckErr(Buf, RoutineName)) return - ! option_input_str call RegPack(Buf, InData%option_input_str) if (RegCheckErr(Buf, RoutineName)) return - ! LinInitInp call MAP_Fortran_PackLin_InitInputType(Buf, InData%LinInitInp) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -347,43 +328,33 @@ subroutine MAP_UnPackInitInput(Buf, OutData) type(MAP_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MAP_UnPackInitInput' if (Buf%ErrStat /= ErrID_None) return - ! gravity call RegUnpack(Buf, OutData%gravity) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%gravity = OutData%gravity - ! sea_density call RegUnpack(Buf, OutData%sea_density) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%sea_density = OutData%sea_density - ! depth call RegUnpack(Buf, OutData%depth) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%depth = OutData%depth - ! file_name call RegUnpack(Buf, OutData%file_name) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%file_name = transfer(OutData%file_name, OutData%C_obj%file_name ) - ! summary_file_name call RegUnpack(Buf, OutData%summary_file_name) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%summary_file_name = transfer(OutData%summary_file_name, OutData%C_obj%summary_file_name ) - ! library_input_str call RegUnpack(Buf, OutData%library_input_str) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%library_input_str = transfer(OutData%library_input_str, OutData%C_obj%library_input_str ) - ! node_input_str call RegUnpack(Buf, OutData%node_input_str) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%node_input_str = transfer(OutData%node_input_str, OutData%C_obj%node_input_str ) - ! line_input_str call RegUnpack(Buf, OutData%line_input_str) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%line_input_str = transfer(OutData%line_input_str, OutData%C_obj%line_input_str ) - ! option_input_str call RegUnpack(Buf, OutData%option_input_str) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%option_input_str = transfer(OutData%option_input_str, OutData%C_obj%option_input_str ) - ! LinInitInp call MAP_Fortran_UnpackLin_InitInputType(Buf, OutData%LinInitInp) ! LinInitInp end subroutine SUBROUTINE MAP_C2Fary_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) @@ -438,84 +409,77 @@ SUBROUTINE MAP_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers InitInputData%C_obj%option_input_str = TRANSFER(InitInputData%option_input_str, InitInputData%C_obj%option_input_str ) END SUBROUTINE MAP_F2C_CopyInitInput - SUBROUTINE MAP_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MAP_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(MAP_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_CopyInitOutput' -! + +subroutine MAP_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(MAP_InitOutputType), intent(in) :: SrcInitOutputData + type(MAP_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MAP_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - DstInitOutputData%progName = SrcInitOutputData%progName - DstInitOutputData%C_obj%progName = SrcInitOutputData%C_obj%progName - DstInitOutputData%version = SrcInitOutputData%version - DstInitOutputData%C_obj%version = SrcInitOutputData%C_obj%version - DstInitOutputData%compilingData = SrcInitOutputData%compilingData - DstInitOutputData%C_obj%compilingData = SrcInitOutputData%C_obj%compilingData -IF (ALLOCATED(SrcInitOutputData%writeOutputHdr)) THEN - i1_l = LBOUND(SrcInitOutputData%writeOutputHdr,1) - i1_u = UBOUND(SrcInitOutputData%writeOutputHdr,1) - IF (.NOT. ALLOCATED(DstInitOutputData%writeOutputHdr)) THEN - ALLOCATE(DstInitOutputData%writeOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%writeOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%writeOutputHdr = SrcInitOutputData%writeOutputHdr -ENDIF -IF (ALLOCATED(SrcInitOutputData%writeOutputUnt)) THEN - i1_l = LBOUND(SrcInitOutputData%writeOutputUnt,1) - i1_u = UBOUND(SrcInitOutputData%writeOutputUnt,1) - IF (.NOT. ALLOCATED(DstInitOutputData%writeOutputUnt)) THEN - ALLOCATE(DstInitOutputData%writeOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%writeOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%writeOutputUnt = SrcInitOutputData%writeOutputUnt -ENDIF - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MAP_Fortran_Copylin_initoutputtype( SrcInitOutputData%LinInitOut, DstInitOutputData%LinInitOut, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE MAP_CopyInitOutput - - SUBROUTINE MAP_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(MAP_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitOutputData%writeOutputHdr)) THEN - DEALLOCATE(InitOutputData%writeOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%writeOutputUnt)) THEN - DEALLOCATE(InitOutputData%writeOutputUnt) -ENDIF - CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MAP_Fortran_DestroyLin_InitOutputType( InitOutputData%LinInitOut, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE MAP_DestroyInitOutput + ErrMsg = '' + DstInitOutputData%progName = SrcInitOutputData%progName + DstInitOutputData%C_obj%progName = SrcInitOutputData%C_obj%progName + DstInitOutputData%version = SrcInitOutputData%version + DstInitOutputData%C_obj%version = SrcInitOutputData%C_obj%version + DstInitOutputData%compilingData = SrcInitOutputData%compilingData + DstInitOutputData%C_obj%compilingData = SrcInitOutputData%C_obj%compilingData + if (allocated(SrcInitOutputData%writeOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%writeOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%writeOutputHdr) + if (.not. allocated(DstInitOutputData%writeOutputHdr)) then + allocate(DstInitOutputData%writeOutputHdr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%writeOutputHdr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%writeOutputHdr = SrcInitOutputData%writeOutputHdr + else if (allocated(DstInitOutputData%writeOutputHdr)) then + deallocate(DstInitOutputData%writeOutputHdr) + end if + if (allocated(SrcInitOutputData%writeOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%writeOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%writeOutputUnt) + if (.not. allocated(DstInitOutputData%writeOutputUnt)) then + allocate(DstInitOutputData%writeOutputUnt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%writeOutputUnt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%writeOutputUnt = SrcInitOutputData%writeOutputUnt + else if (allocated(DstInitOutputData%writeOutputUnt)) then + deallocate(DstInitOutputData%writeOutputUnt) + end if + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MAP_Fortran_CopyLin_InitOutputType(SrcInitOutputData%LinInitOut, DstInitOutputData%LinInitOut, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine MAP_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(MAP_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MAP_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%writeOutputHdr)) then + deallocate(InitOutputData%writeOutputHdr) + end if + if (allocated(InitOutputData%writeOutputUnt)) then + deallocate(InitOutputData%writeOutputUnt) + end if +end subroutine subroutine MAP_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -526,33 +490,26 @@ subroutine MAP_PackInitOutput(Buf, Indata) call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - ! progName call RegPack(Buf, InData%progName) if (RegCheckErr(Buf, RoutineName)) return - ! version call RegPack(Buf, InData%version) if (RegCheckErr(Buf, RoutineName)) return - ! compilingData call RegPack(Buf, InData%compilingData) if (RegCheckErr(Buf, RoutineName)) return - ! writeOutputHdr call RegPack(Buf, allocated(InData%writeOutputHdr)) if (allocated(InData%writeOutputHdr)) then call RegPackBounds(Buf, 1, lbound(InData%writeOutputHdr), ubound(InData%writeOutputHdr)) call RegPack(Buf, InData%writeOutputHdr) end if if (RegCheckErr(Buf, RoutineName)) return - ! writeOutputUnt call RegPack(Buf, allocated(InData%writeOutputUnt)) if (allocated(InData%writeOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%writeOutputUnt), ubound(InData%writeOutputUnt)) call RegPack(Buf, InData%writeOutputUnt) end if if (RegCheckErr(Buf, RoutineName)) return - ! Ver call NWTC_Library_PackProgDesc(Buf, InData%Ver) if (RegCheckErr(Buf, RoutineName)) return - ! LinInitOut call MAP_Fortran_PackLin_InitOutputType(Buf, InData%LinInitOut) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -565,19 +522,15 @@ subroutine MAP_UnPackInitOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! progName call RegUnpack(Buf, OutData%progName) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%progName = transfer(OutData%progName, OutData%C_obj%progName ) - ! version call RegUnpack(Buf, OutData%version) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%version = transfer(OutData%version, OutData%C_obj%version ) - ! compilingData call RegUnpack(Buf, OutData%compilingData) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%compilingData = transfer(OutData%compilingData, OutData%C_obj%compilingData ) - ! writeOutputHdr if (allocated(OutData%writeOutputHdr)) deallocate(OutData%writeOutputHdr) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -592,7 +545,6 @@ subroutine MAP_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%writeOutputHdr) if (RegCheckErr(Buf, RoutineName)) return end if - ! writeOutputUnt if (allocated(OutData%writeOutputUnt)) deallocate(OutData%writeOutputUnt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -607,9 +559,7 @@ subroutine MAP_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%writeOutputUnt) if (RegCheckErr(Buf, RoutineName)) return end if - ! Ver call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver - ! LinInitOut call MAP_Fortran_UnpackLin_InitOutputType(Buf, OutData%LinInitOut) ! LinInitOut end subroutine SUBROUTINE MAP_C2Fary_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) @@ -652,39 +602,28 @@ SUBROUTINE MAP_F2C_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers InitOutputData%C_obj%compilingData = TRANSFER(InitOutputData%compilingData, InitOutputData%C_obj%compilingData ) END SUBROUTINE MAP_F2C_CopyInitOutput - SUBROUTINE MAP_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MAP_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(MAP_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%dummy = SrcContStateData%dummy - DstContStateData%C_obj%dummy = SrcContStateData%C_obj%dummy - END SUBROUTINE MAP_CopyContState - - SUBROUTINE MAP_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(MAP_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE MAP_DestroyContState +subroutine MAP_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(MAP_ContinuousStateType), intent(in) :: SrcContStateData + type(MAP_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MAP_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + DstContStateData%dummy = SrcContStateData%dummy + DstContStateData%C_obj%dummy = SrcContStateData%C_obj%dummy +end subroutine +subroutine MAP_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(MAP_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MAP_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine MAP_PackContState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -695,7 +634,6 @@ subroutine MAP_PackContState(Buf, Indata) call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - ! dummy call RegPack(Buf, InData%dummy) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -705,7 +643,6 @@ subroutine MAP_UnPackContState(Buf, OutData) type(MAP_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MAP_UnPackContState' if (Buf%ErrStat /= ErrID_None) return - ! dummy call RegUnpack(Buf, OutData%dummy) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%dummy = OutData%dummy @@ -746,39 +683,28 @@ SUBROUTINE MAP_F2C_CopyContState( ContStateData, ErrStat, ErrMsg, SkipPointers ContStateData%C_obj%dummy = ContStateData%dummy END SUBROUTINE MAP_F2C_CopyContState - SUBROUTINE MAP_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MAP_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(MAP_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%dummy = SrcDiscStateData%dummy - DstDiscStateData%C_obj%dummy = SrcDiscStateData%C_obj%dummy - END SUBROUTINE MAP_CopyDiscState - SUBROUTINE MAP_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(MAP_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE MAP_DestroyDiscState +subroutine MAP_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(MAP_DiscreteStateType), intent(in) :: SrcDiscStateData + type(MAP_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MAP_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + DstDiscStateData%dummy = SrcDiscStateData%dummy + DstDiscStateData%C_obj%dummy = SrcDiscStateData%C_obj%dummy +end subroutine +subroutine MAP_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(MAP_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MAP_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine MAP_PackDiscState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -789,7 +715,6 @@ subroutine MAP_PackDiscState(Buf, Indata) call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - ! dummy call RegPack(Buf, InData%dummy) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -799,7 +724,6 @@ subroutine MAP_UnPackDiscState(Buf, OutData) type(MAP_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MAP_UnPackDiscState' if (Buf%ErrStat /= ErrID_None) return - ! dummy call RegUnpack(Buf, OutData%dummy) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%dummy = OutData%dummy @@ -840,374 +764,396 @@ SUBROUTINE MAP_F2C_CopyDiscState( DiscStateData, ErrStat, ErrMsg, SkipPointers DiscStateData%C_obj%dummy = DiscStateData%dummy END SUBROUTINE MAP_F2C_CopyDiscState - SUBROUTINE MAP_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MAP_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(MAP_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_CopyOtherState' -! + +subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(MAP_OtherStateType), intent(in) :: SrcOtherStateData + type(MAP_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'MAP_CopyOtherState' ErrStat = ErrID_None - ErrMsg = "" -IF (ASSOCIATED(SrcOtherStateData%H)) THEN - i1_l = LBOUND(SrcOtherStateData%H,1) - i1_u = UBOUND(SrcOtherStateData%H,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%H)) THEN - ALLOCATE(DstOtherStateData%H(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%H.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOtherStateData%C_obj%H_Len = SIZE(DstOtherStateData%H) - IF (DstOtherStateData%C_obj%H_Len > 0) & - DstOtherStateData%C_obj%H = C_LOC( DstOtherStateData%H( i1_l ) ) - END IF - DstOtherStateData%H = SrcOtherStateData%H -ENDIF -IF (ASSOCIATED(SrcOtherStateData%V)) THEN - i1_l = LBOUND(SrcOtherStateData%V,1) - i1_u = UBOUND(SrcOtherStateData%V,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%V)) THEN - ALLOCATE(DstOtherStateData%V(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%V.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOtherStateData%C_obj%V_Len = SIZE(DstOtherStateData%V) - IF (DstOtherStateData%C_obj%V_Len > 0) & - DstOtherStateData%C_obj%V = C_LOC( DstOtherStateData%V( i1_l ) ) - END IF - DstOtherStateData%V = SrcOtherStateData%V -ENDIF -IF (ASSOCIATED(SrcOtherStateData%Ha)) THEN - i1_l = LBOUND(SrcOtherStateData%Ha,1) - i1_u = UBOUND(SrcOtherStateData%Ha,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%Ha)) THEN - ALLOCATE(DstOtherStateData%Ha(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Ha.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOtherStateData%C_obj%Ha_Len = SIZE(DstOtherStateData%Ha) - IF (DstOtherStateData%C_obj%Ha_Len > 0) & - DstOtherStateData%C_obj%Ha = C_LOC( DstOtherStateData%Ha( i1_l ) ) - END IF - DstOtherStateData%Ha = SrcOtherStateData%Ha -ENDIF -IF (ASSOCIATED(SrcOtherStateData%Va)) THEN - i1_l = LBOUND(SrcOtherStateData%Va,1) - i1_u = UBOUND(SrcOtherStateData%Va,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%Va)) THEN - ALLOCATE(DstOtherStateData%Va(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Va.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOtherStateData%C_obj%Va_Len = SIZE(DstOtherStateData%Va) - IF (DstOtherStateData%C_obj%Va_Len > 0) & - DstOtherStateData%C_obj%Va = C_LOC( DstOtherStateData%Va( i1_l ) ) - END IF - DstOtherStateData%Va = SrcOtherStateData%Va -ENDIF -IF (ASSOCIATED(SrcOtherStateData%x)) THEN - i1_l = LBOUND(SrcOtherStateData%x,1) - i1_u = UBOUND(SrcOtherStateData%x,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%x)) THEN - ALLOCATE(DstOtherStateData%x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOtherStateData%C_obj%x_Len = SIZE(DstOtherStateData%x) - IF (DstOtherStateData%C_obj%x_Len > 0) & - DstOtherStateData%C_obj%x = C_LOC( DstOtherStateData%x( i1_l ) ) - END IF - DstOtherStateData%x = SrcOtherStateData%x -ENDIF -IF (ASSOCIATED(SrcOtherStateData%y)) THEN - i1_l = LBOUND(SrcOtherStateData%y,1) - i1_u = UBOUND(SrcOtherStateData%y,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%y)) THEN - ALLOCATE(DstOtherStateData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOtherStateData%C_obj%y_Len = SIZE(DstOtherStateData%y) - IF (DstOtherStateData%C_obj%y_Len > 0) & - DstOtherStateData%C_obj%y = C_LOC( DstOtherStateData%y( i1_l ) ) - END IF - DstOtherStateData%y = SrcOtherStateData%y -ENDIF -IF (ASSOCIATED(SrcOtherStateData%z)) THEN - i1_l = LBOUND(SrcOtherStateData%z,1) - i1_u = UBOUND(SrcOtherStateData%z,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%z)) THEN - ALLOCATE(DstOtherStateData%z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOtherStateData%C_obj%z_Len = SIZE(DstOtherStateData%z) - IF (DstOtherStateData%C_obj%z_Len > 0) & - DstOtherStateData%C_obj%z = C_LOC( DstOtherStateData%z( i1_l ) ) - END IF - DstOtherStateData%z = SrcOtherStateData%z -ENDIF -IF (ASSOCIATED(SrcOtherStateData%xa)) THEN - i1_l = LBOUND(SrcOtherStateData%xa,1) - i1_u = UBOUND(SrcOtherStateData%xa,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%xa)) THEN - ALLOCATE(DstOtherStateData%xa(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%xa.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOtherStateData%C_obj%xa_Len = SIZE(DstOtherStateData%xa) - IF (DstOtherStateData%C_obj%xa_Len > 0) & - DstOtherStateData%C_obj%xa = C_LOC( DstOtherStateData%xa( i1_l ) ) - END IF - DstOtherStateData%xa = SrcOtherStateData%xa -ENDIF -IF (ASSOCIATED(SrcOtherStateData%ya)) THEN - i1_l = LBOUND(SrcOtherStateData%ya,1) - i1_u = UBOUND(SrcOtherStateData%ya,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%ya)) THEN - ALLOCATE(DstOtherStateData%ya(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%ya.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOtherStateData%C_obj%ya_Len = SIZE(DstOtherStateData%ya) - IF (DstOtherStateData%C_obj%ya_Len > 0) & - DstOtherStateData%C_obj%ya = C_LOC( DstOtherStateData%ya( i1_l ) ) - END IF - DstOtherStateData%ya = SrcOtherStateData%ya -ENDIF -IF (ASSOCIATED(SrcOtherStateData%za)) THEN - i1_l = LBOUND(SrcOtherStateData%za,1) - i1_u = UBOUND(SrcOtherStateData%za,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%za)) THEN - ALLOCATE(DstOtherStateData%za(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%za.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOtherStateData%C_obj%za_Len = SIZE(DstOtherStateData%za) - IF (DstOtherStateData%C_obj%za_Len > 0) & - DstOtherStateData%C_obj%za = C_LOC( DstOtherStateData%za( i1_l ) ) - END IF - DstOtherStateData%za = SrcOtherStateData%za -ENDIF -IF (ASSOCIATED(SrcOtherStateData%Fx_connect)) THEN - i1_l = LBOUND(SrcOtherStateData%Fx_connect,1) - i1_u = UBOUND(SrcOtherStateData%Fx_connect,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%Fx_connect)) THEN - ALLOCATE(DstOtherStateData%Fx_connect(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Fx_connect.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOtherStateData%C_obj%Fx_connect_Len = SIZE(DstOtherStateData%Fx_connect) - IF (DstOtherStateData%C_obj%Fx_connect_Len > 0) & - DstOtherStateData%C_obj%Fx_connect = C_LOC( DstOtherStateData%Fx_connect( i1_l ) ) - END IF - DstOtherStateData%Fx_connect = SrcOtherStateData%Fx_connect -ENDIF -IF (ASSOCIATED(SrcOtherStateData%Fy_connect)) THEN - i1_l = LBOUND(SrcOtherStateData%Fy_connect,1) - i1_u = UBOUND(SrcOtherStateData%Fy_connect,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%Fy_connect)) THEN - ALLOCATE(DstOtherStateData%Fy_connect(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Fy_connect.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOtherStateData%C_obj%Fy_connect_Len = SIZE(DstOtherStateData%Fy_connect) - IF (DstOtherStateData%C_obj%Fy_connect_Len > 0) & - DstOtherStateData%C_obj%Fy_connect = C_LOC( DstOtherStateData%Fy_connect( i1_l ) ) - END IF - DstOtherStateData%Fy_connect = SrcOtherStateData%Fy_connect -ENDIF -IF (ASSOCIATED(SrcOtherStateData%Fz_connect)) THEN - i1_l = LBOUND(SrcOtherStateData%Fz_connect,1) - i1_u = UBOUND(SrcOtherStateData%Fz_connect,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%Fz_connect)) THEN - ALLOCATE(DstOtherStateData%Fz_connect(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Fz_connect.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOtherStateData%C_obj%Fz_connect_Len = SIZE(DstOtherStateData%Fz_connect) - IF (DstOtherStateData%C_obj%Fz_connect_Len > 0) & - DstOtherStateData%C_obj%Fz_connect = C_LOC( DstOtherStateData%Fz_connect( i1_l ) ) - END IF - DstOtherStateData%Fz_connect = SrcOtherStateData%Fz_connect -ENDIF -IF (ASSOCIATED(SrcOtherStateData%Fx_anchor)) THEN - i1_l = LBOUND(SrcOtherStateData%Fx_anchor,1) - i1_u = UBOUND(SrcOtherStateData%Fx_anchor,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%Fx_anchor)) THEN - ALLOCATE(DstOtherStateData%Fx_anchor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Fx_anchor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOtherStateData%C_obj%Fx_anchor_Len = SIZE(DstOtherStateData%Fx_anchor) - IF (DstOtherStateData%C_obj%Fx_anchor_Len > 0) & - DstOtherStateData%C_obj%Fx_anchor = C_LOC( DstOtherStateData%Fx_anchor( i1_l ) ) - END IF - DstOtherStateData%Fx_anchor = SrcOtherStateData%Fx_anchor -ENDIF -IF (ASSOCIATED(SrcOtherStateData%Fy_anchor)) THEN - i1_l = LBOUND(SrcOtherStateData%Fy_anchor,1) - i1_u = UBOUND(SrcOtherStateData%Fy_anchor,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%Fy_anchor)) THEN - ALLOCATE(DstOtherStateData%Fy_anchor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Fy_anchor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOtherStateData%C_obj%Fy_anchor_Len = SIZE(DstOtherStateData%Fy_anchor) - IF (DstOtherStateData%C_obj%Fy_anchor_Len > 0) & - DstOtherStateData%C_obj%Fy_anchor = C_LOC( DstOtherStateData%Fy_anchor( i1_l ) ) - END IF - DstOtherStateData%Fy_anchor = SrcOtherStateData%Fy_anchor -ENDIF -IF (ASSOCIATED(SrcOtherStateData%Fz_anchor)) THEN - i1_l = LBOUND(SrcOtherStateData%Fz_anchor,1) - i1_u = UBOUND(SrcOtherStateData%Fz_anchor,1) - IF (.NOT. ASSOCIATED(DstOtherStateData%Fz_anchor)) THEN - ALLOCATE(DstOtherStateData%Fz_anchor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Fz_anchor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOtherStateData%C_obj%Fz_anchor_Len = SIZE(DstOtherStateData%Fz_anchor) - IF (DstOtherStateData%C_obj%Fz_anchor_Len > 0) & - DstOtherStateData%C_obj%Fz_anchor = C_LOC( DstOtherStateData%Fz_anchor( i1_l ) ) - END IF - DstOtherStateData%Fz_anchor = SrcOtherStateData%Fz_anchor -ENDIF - END SUBROUTINE MAP_CopyOtherState - - SUBROUTINE MAP_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(MAP_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ASSOCIATED(OtherStateData%H)) THEN - DEALLOCATE(OtherStateData%H) - OtherStateData%H => NULL() - OtherStateData%C_obj%H = C_NULL_PTR - OtherStateData%C_obj%H_Len = 0 -ENDIF -IF (ASSOCIATED(OtherStateData%V)) THEN - DEALLOCATE(OtherStateData%V) - OtherStateData%V => NULL() - OtherStateData%C_obj%V = C_NULL_PTR - OtherStateData%C_obj%V_Len = 0 -ENDIF -IF (ASSOCIATED(OtherStateData%Ha)) THEN - DEALLOCATE(OtherStateData%Ha) - OtherStateData%Ha => NULL() - OtherStateData%C_obj%Ha = C_NULL_PTR - OtherStateData%C_obj%Ha_Len = 0 -ENDIF -IF (ASSOCIATED(OtherStateData%Va)) THEN - DEALLOCATE(OtherStateData%Va) - OtherStateData%Va => NULL() - OtherStateData%C_obj%Va = C_NULL_PTR - OtherStateData%C_obj%Va_Len = 0 -ENDIF -IF (ASSOCIATED(OtherStateData%x)) THEN - DEALLOCATE(OtherStateData%x) - OtherStateData%x => NULL() - OtherStateData%C_obj%x = C_NULL_PTR - OtherStateData%C_obj%x_Len = 0 -ENDIF -IF (ASSOCIATED(OtherStateData%y)) THEN - DEALLOCATE(OtherStateData%y) - OtherStateData%y => NULL() - OtherStateData%C_obj%y = C_NULL_PTR - OtherStateData%C_obj%y_Len = 0 -ENDIF -IF (ASSOCIATED(OtherStateData%z)) THEN - DEALLOCATE(OtherStateData%z) - OtherStateData%z => NULL() - OtherStateData%C_obj%z = C_NULL_PTR - OtherStateData%C_obj%z_Len = 0 -ENDIF -IF (ASSOCIATED(OtherStateData%xa)) THEN - DEALLOCATE(OtherStateData%xa) - OtherStateData%xa => NULL() - OtherStateData%C_obj%xa = C_NULL_PTR - OtherStateData%C_obj%xa_Len = 0 -ENDIF -IF (ASSOCIATED(OtherStateData%ya)) THEN - DEALLOCATE(OtherStateData%ya) - OtherStateData%ya => NULL() - OtherStateData%C_obj%ya = C_NULL_PTR - OtherStateData%C_obj%ya_Len = 0 -ENDIF -IF (ASSOCIATED(OtherStateData%za)) THEN - DEALLOCATE(OtherStateData%za) - OtherStateData%za => NULL() - OtherStateData%C_obj%za = C_NULL_PTR - OtherStateData%C_obj%za_Len = 0 -ENDIF -IF (ASSOCIATED(OtherStateData%Fx_connect)) THEN - DEALLOCATE(OtherStateData%Fx_connect) - OtherStateData%Fx_connect => NULL() - OtherStateData%C_obj%Fx_connect = C_NULL_PTR - OtherStateData%C_obj%Fx_connect_Len = 0 -ENDIF -IF (ASSOCIATED(OtherStateData%Fy_connect)) THEN - DEALLOCATE(OtherStateData%Fy_connect) - OtherStateData%Fy_connect => NULL() - OtherStateData%C_obj%Fy_connect = C_NULL_PTR - OtherStateData%C_obj%Fy_connect_Len = 0 -ENDIF -IF (ASSOCIATED(OtherStateData%Fz_connect)) THEN - DEALLOCATE(OtherStateData%Fz_connect) - OtherStateData%Fz_connect => NULL() - OtherStateData%C_obj%Fz_connect = C_NULL_PTR - OtherStateData%C_obj%Fz_connect_Len = 0 -ENDIF -IF (ASSOCIATED(OtherStateData%Fx_anchor)) THEN - DEALLOCATE(OtherStateData%Fx_anchor) - OtherStateData%Fx_anchor => NULL() - OtherStateData%C_obj%Fx_anchor = C_NULL_PTR - OtherStateData%C_obj%Fx_anchor_Len = 0 -ENDIF -IF (ASSOCIATED(OtherStateData%Fy_anchor)) THEN - DEALLOCATE(OtherStateData%Fy_anchor) - OtherStateData%Fy_anchor => NULL() - OtherStateData%C_obj%Fy_anchor = C_NULL_PTR - OtherStateData%C_obj%Fy_anchor_Len = 0 -ENDIF -IF (ASSOCIATED(OtherStateData%Fz_anchor)) THEN - DEALLOCATE(OtherStateData%Fz_anchor) - OtherStateData%Fz_anchor => NULL() - OtherStateData%C_obj%Fz_anchor = C_NULL_PTR - OtherStateData%C_obj%Fz_anchor_Len = 0 -ENDIF - END SUBROUTINE MAP_DestroyOtherState + ErrMsg = '' + if (associated(SrcOtherStateData%H)) then + LB(1:1) = lbound(SrcOtherStateData%H) + UB(1:1) = ubound(SrcOtherStateData%H) + if (.not. associated(DstOtherStateData%H)) then + allocate(DstOtherStateData%H(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%H.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOtherStateData%C_obj%H_Len = size(DstOtherStateData%H) + if (DstOtherStateData%C_obj%H_Len > 0) & + DstOtherStateData%C_obj%H = c_loc(DstOtherStateData%H(LB(1))) + end if + DstOtherStateData%H = SrcOtherStateData%H + else if (associated(DstOtherStateData%H)) then + deallocate(DstOtherStateData%H) + end if + if (associated(SrcOtherStateData%V)) then + LB(1:1) = lbound(SrcOtherStateData%V) + UB(1:1) = ubound(SrcOtherStateData%V) + if (.not. associated(DstOtherStateData%V)) then + allocate(DstOtherStateData%V(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%V.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOtherStateData%C_obj%V_Len = size(DstOtherStateData%V) + if (DstOtherStateData%C_obj%V_Len > 0) & + DstOtherStateData%C_obj%V = c_loc(DstOtherStateData%V(LB(1))) + end if + DstOtherStateData%V = SrcOtherStateData%V + else if (associated(DstOtherStateData%V)) then + deallocate(DstOtherStateData%V) + end if + if (associated(SrcOtherStateData%Ha)) then + LB(1:1) = lbound(SrcOtherStateData%Ha) + UB(1:1) = ubound(SrcOtherStateData%Ha) + if (.not. associated(DstOtherStateData%Ha)) then + allocate(DstOtherStateData%Ha(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Ha.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOtherStateData%C_obj%Ha_Len = size(DstOtherStateData%Ha) + if (DstOtherStateData%C_obj%Ha_Len > 0) & + DstOtherStateData%C_obj%Ha = c_loc(DstOtherStateData%Ha(LB(1))) + end if + DstOtherStateData%Ha = SrcOtherStateData%Ha + else if (associated(DstOtherStateData%Ha)) then + deallocate(DstOtherStateData%Ha) + end if + if (associated(SrcOtherStateData%Va)) then + LB(1:1) = lbound(SrcOtherStateData%Va) + UB(1:1) = ubound(SrcOtherStateData%Va) + if (.not. associated(DstOtherStateData%Va)) then + allocate(DstOtherStateData%Va(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Va.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOtherStateData%C_obj%Va_Len = size(DstOtherStateData%Va) + if (DstOtherStateData%C_obj%Va_Len > 0) & + DstOtherStateData%C_obj%Va = c_loc(DstOtherStateData%Va(LB(1))) + end if + DstOtherStateData%Va = SrcOtherStateData%Va + else if (associated(DstOtherStateData%Va)) then + deallocate(DstOtherStateData%Va) + end if + if (associated(SrcOtherStateData%x)) then + LB(1:1) = lbound(SrcOtherStateData%x) + UB(1:1) = ubound(SrcOtherStateData%x) + if (.not. associated(DstOtherStateData%x)) then + allocate(DstOtherStateData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOtherStateData%C_obj%x_Len = size(DstOtherStateData%x) + if (DstOtherStateData%C_obj%x_Len > 0) & + DstOtherStateData%C_obj%x = c_loc(DstOtherStateData%x(LB(1))) + end if + DstOtherStateData%x = SrcOtherStateData%x + else if (associated(DstOtherStateData%x)) then + deallocate(DstOtherStateData%x) + end if + if (associated(SrcOtherStateData%y)) then + LB(1:1) = lbound(SrcOtherStateData%y) + UB(1:1) = ubound(SrcOtherStateData%y) + if (.not. associated(DstOtherStateData%y)) then + allocate(DstOtherStateData%y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%y.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOtherStateData%C_obj%y_Len = size(DstOtherStateData%y) + if (DstOtherStateData%C_obj%y_Len > 0) & + DstOtherStateData%C_obj%y = c_loc(DstOtherStateData%y(LB(1))) + end if + DstOtherStateData%y = SrcOtherStateData%y + else if (associated(DstOtherStateData%y)) then + deallocate(DstOtherStateData%y) + end if + if (associated(SrcOtherStateData%z)) then + LB(1:1) = lbound(SrcOtherStateData%z) + UB(1:1) = ubound(SrcOtherStateData%z) + if (.not. associated(DstOtherStateData%z)) then + allocate(DstOtherStateData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOtherStateData%C_obj%z_Len = size(DstOtherStateData%z) + if (DstOtherStateData%C_obj%z_Len > 0) & + DstOtherStateData%C_obj%z = c_loc(DstOtherStateData%z(LB(1))) + end if + DstOtherStateData%z = SrcOtherStateData%z + else if (associated(DstOtherStateData%z)) then + deallocate(DstOtherStateData%z) + end if + if (associated(SrcOtherStateData%xa)) then + LB(1:1) = lbound(SrcOtherStateData%xa) + UB(1:1) = ubound(SrcOtherStateData%xa) + if (.not. associated(DstOtherStateData%xa)) then + allocate(DstOtherStateData%xa(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%xa.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOtherStateData%C_obj%xa_Len = size(DstOtherStateData%xa) + if (DstOtherStateData%C_obj%xa_Len > 0) & + DstOtherStateData%C_obj%xa = c_loc(DstOtherStateData%xa(LB(1))) + end if + DstOtherStateData%xa = SrcOtherStateData%xa + else if (associated(DstOtherStateData%xa)) then + deallocate(DstOtherStateData%xa) + end if + if (associated(SrcOtherStateData%ya)) then + LB(1:1) = lbound(SrcOtherStateData%ya) + UB(1:1) = ubound(SrcOtherStateData%ya) + if (.not. associated(DstOtherStateData%ya)) then + allocate(DstOtherStateData%ya(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%ya.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOtherStateData%C_obj%ya_Len = size(DstOtherStateData%ya) + if (DstOtherStateData%C_obj%ya_Len > 0) & + DstOtherStateData%C_obj%ya = c_loc(DstOtherStateData%ya(LB(1))) + end if + DstOtherStateData%ya = SrcOtherStateData%ya + else if (associated(DstOtherStateData%ya)) then + deallocate(DstOtherStateData%ya) + end if + if (associated(SrcOtherStateData%za)) then + LB(1:1) = lbound(SrcOtherStateData%za) + UB(1:1) = ubound(SrcOtherStateData%za) + if (.not. associated(DstOtherStateData%za)) then + allocate(DstOtherStateData%za(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%za.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOtherStateData%C_obj%za_Len = size(DstOtherStateData%za) + if (DstOtherStateData%C_obj%za_Len > 0) & + DstOtherStateData%C_obj%za = c_loc(DstOtherStateData%za(LB(1))) + end if + DstOtherStateData%za = SrcOtherStateData%za + else if (associated(DstOtherStateData%za)) then + deallocate(DstOtherStateData%za) + end if + if (associated(SrcOtherStateData%Fx_connect)) then + LB(1:1) = lbound(SrcOtherStateData%Fx_connect) + UB(1:1) = ubound(SrcOtherStateData%Fx_connect) + if (.not. associated(DstOtherStateData%Fx_connect)) then + allocate(DstOtherStateData%Fx_connect(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Fx_connect.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOtherStateData%C_obj%Fx_connect_Len = size(DstOtherStateData%Fx_connect) + if (DstOtherStateData%C_obj%Fx_connect_Len > 0) & + DstOtherStateData%C_obj%Fx_connect = c_loc(DstOtherStateData%Fx_connect(LB(1))) + end if + DstOtherStateData%Fx_connect = SrcOtherStateData%Fx_connect + else if (associated(DstOtherStateData%Fx_connect)) then + deallocate(DstOtherStateData%Fx_connect) + end if + if (associated(SrcOtherStateData%Fy_connect)) then + LB(1:1) = lbound(SrcOtherStateData%Fy_connect) + UB(1:1) = ubound(SrcOtherStateData%Fy_connect) + if (.not. associated(DstOtherStateData%Fy_connect)) then + allocate(DstOtherStateData%Fy_connect(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Fy_connect.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOtherStateData%C_obj%Fy_connect_Len = size(DstOtherStateData%Fy_connect) + if (DstOtherStateData%C_obj%Fy_connect_Len > 0) & + DstOtherStateData%C_obj%Fy_connect = c_loc(DstOtherStateData%Fy_connect(LB(1))) + end if + DstOtherStateData%Fy_connect = SrcOtherStateData%Fy_connect + else if (associated(DstOtherStateData%Fy_connect)) then + deallocate(DstOtherStateData%Fy_connect) + end if + if (associated(SrcOtherStateData%Fz_connect)) then + LB(1:1) = lbound(SrcOtherStateData%Fz_connect) + UB(1:1) = ubound(SrcOtherStateData%Fz_connect) + if (.not. associated(DstOtherStateData%Fz_connect)) then + allocate(DstOtherStateData%Fz_connect(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Fz_connect.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOtherStateData%C_obj%Fz_connect_Len = size(DstOtherStateData%Fz_connect) + if (DstOtherStateData%C_obj%Fz_connect_Len > 0) & + DstOtherStateData%C_obj%Fz_connect = c_loc(DstOtherStateData%Fz_connect(LB(1))) + end if + DstOtherStateData%Fz_connect = SrcOtherStateData%Fz_connect + else if (associated(DstOtherStateData%Fz_connect)) then + deallocate(DstOtherStateData%Fz_connect) + end if + if (associated(SrcOtherStateData%Fx_anchor)) then + LB(1:1) = lbound(SrcOtherStateData%Fx_anchor) + UB(1:1) = ubound(SrcOtherStateData%Fx_anchor) + if (.not. associated(DstOtherStateData%Fx_anchor)) then + allocate(DstOtherStateData%Fx_anchor(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Fx_anchor.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOtherStateData%C_obj%Fx_anchor_Len = size(DstOtherStateData%Fx_anchor) + if (DstOtherStateData%C_obj%Fx_anchor_Len > 0) & + DstOtherStateData%C_obj%Fx_anchor = c_loc(DstOtherStateData%Fx_anchor(LB(1))) + end if + DstOtherStateData%Fx_anchor = SrcOtherStateData%Fx_anchor + else if (associated(DstOtherStateData%Fx_anchor)) then + deallocate(DstOtherStateData%Fx_anchor) + end if + if (associated(SrcOtherStateData%Fy_anchor)) then + LB(1:1) = lbound(SrcOtherStateData%Fy_anchor) + UB(1:1) = ubound(SrcOtherStateData%Fy_anchor) + if (.not. associated(DstOtherStateData%Fy_anchor)) then + allocate(DstOtherStateData%Fy_anchor(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Fy_anchor.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOtherStateData%C_obj%Fy_anchor_Len = size(DstOtherStateData%Fy_anchor) + if (DstOtherStateData%C_obj%Fy_anchor_Len > 0) & + DstOtherStateData%C_obj%Fy_anchor = c_loc(DstOtherStateData%Fy_anchor(LB(1))) + end if + DstOtherStateData%Fy_anchor = SrcOtherStateData%Fy_anchor + else if (associated(DstOtherStateData%Fy_anchor)) then + deallocate(DstOtherStateData%Fy_anchor) + end if + if (associated(SrcOtherStateData%Fz_anchor)) then + LB(1:1) = lbound(SrcOtherStateData%Fz_anchor) + UB(1:1) = ubound(SrcOtherStateData%Fz_anchor) + if (.not. associated(DstOtherStateData%Fz_anchor)) then + allocate(DstOtherStateData%Fz_anchor(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%Fz_anchor.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOtherStateData%C_obj%Fz_anchor_Len = size(DstOtherStateData%Fz_anchor) + if (DstOtherStateData%C_obj%Fz_anchor_Len > 0) & + DstOtherStateData%C_obj%Fz_anchor = c_loc(DstOtherStateData%Fz_anchor(LB(1))) + end if + DstOtherStateData%Fz_anchor = SrcOtherStateData%Fz_anchor + else if (associated(DstOtherStateData%Fz_anchor)) then + deallocate(DstOtherStateData%Fz_anchor) + end if +end subroutine +subroutine MAP_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(MAP_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MAP_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(OtherStateData%H)) then + deallocate(OtherStateData%H) + OtherStateData%H => null() + OtherStateData%C_obj%H = c_null_ptr + OtherStateData%C_obj%H_Len = 0 + end if + if (associated(OtherStateData%V)) then + deallocate(OtherStateData%V) + OtherStateData%V => null() + OtherStateData%C_obj%V = c_null_ptr + OtherStateData%C_obj%V_Len = 0 + end if + if (associated(OtherStateData%Ha)) then + deallocate(OtherStateData%Ha) + OtherStateData%Ha => null() + OtherStateData%C_obj%Ha = c_null_ptr + OtherStateData%C_obj%Ha_Len = 0 + end if + if (associated(OtherStateData%Va)) then + deallocate(OtherStateData%Va) + OtherStateData%Va => null() + OtherStateData%C_obj%Va = c_null_ptr + OtherStateData%C_obj%Va_Len = 0 + end if + if (associated(OtherStateData%x)) then + deallocate(OtherStateData%x) + OtherStateData%x => null() + OtherStateData%C_obj%x = c_null_ptr + OtherStateData%C_obj%x_Len = 0 + end if + if (associated(OtherStateData%y)) then + deallocate(OtherStateData%y) + OtherStateData%y => null() + OtherStateData%C_obj%y = c_null_ptr + OtherStateData%C_obj%y_Len = 0 + end if + if (associated(OtherStateData%z)) then + deallocate(OtherStateData%z) + OtherStateData%z => null() + OtherStateData%C_obj%z = c_null_ptr + OtherStateData%C_obj%z_Len = 0 + end if + if (associated(OtherStateData%xa)) then + deallocate(OtherStateData%xa) + OtherStateData%xa => null() + OtherStateData%C_obj%xa = c_null_ptr + OtherStateData%C_obj%xa_Len = 0 + end if + if (associated(OtherStateData%ya)) then + deallocate(OtherStateData%ya) + OtherStateData%ya => null() + OtherStateData%C_obj%ya = c_null_ptr + OtherStateData%C_obj%ya_Len = 0 + end if + if (associated(OtherStateData%za)) then + deallocate(OtherStateData%za) + OtherStateData%za => null() + OtherStateData%C_obj%za = c_null_ptr + OtherStateData%C_obj%za_Len = 0 + end if + if (associated(OtherStateData%Fx_connect)) then + deallocate(OtherStateData%Fx_connect) + OtherStateData%Fx_connect => null() + OtherStateData%C_obj%Fx_connect = c_null_ptr + OtherStateData%C_obj%Fx_connect_Len = 0 + end if + if (associated(OtherStateData%Fy_connect)) then + deallocate(OtherStateData%Fy_connect) + OtherStateData%Fy_connect => null() + OtherStateData%C_obj%Fy_connect = c_null_ptr + OtherStateData%C_obj%Fy_connect_Len = 0 + end if + if (associated(OtherStateData%Fz_connect)) then + deallocate(OtherStateData%Fz_connect) + OtherStateData%Fz_connect => null() + OtherStateData%C_obj%Fz_connect = c_null_ptr + OtherStateData%C_obj%Fz_connect_Len = 0 + end if + if (associated(OtherStateData%Fx_anchor)) then + deallocate(OtherStateData%Fx_anchor) + OtherStateData%Fx_anchor => null() + OtherStateData%C_obj%Fx_anchor = c_null_ptr + OtherStateData%C_obj%Fx_anchor_Len = 0 + end if + if (associated(OtherStateData%Fy_anchor)) then + deallocate(OtherStateData%Fy_anchor) + OtherStateData%Fy_anchor => null() + OtherStateData%C_obj%Fy_anchor = c_null_ptr + OtherStateData%C_obj%Fy_anchor_Len = 0 + end if + if (associated(OtherStateData%Fz_anchor)) then + deallocate(OtherStateData%Fz_anchor) + OtherStateData%Fz_anchor => null() + OtherStateData%C_obj%Fz_anchor = c_null_ptr + OtherStateData%C_obj%Fz_anchor_Len = 0 + end if +end subroutine subroutine MAP_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -1219,7 +1165,6 @@ subroutine MAP_PackOtherState(Buf, Indata) call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - ! H call RegPack(Buf, associated(InData%H)) if (associated(InData%H)) then call RegPackBounds(Buf, 1, lbound(InData%H), ubound(InData%H)) @@ -1229,7 +1174,6 @@ subroutine MAP_PackOtherState(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! V call RegPack(Buf, associated(InData%V)) if (associated(InData%V)) then call RegPackBounds(Buf, 1, lbound(InData%V), ubound(InData%V)) @@ -1239,7 +1183,6 @@ subroutine MAP_PackOtherState(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! Ha call RegPack(Buf, associated(InData%Ha)) if (associated(InData%Ha)) then call RegPackBounds(Buf, 1, lbound(InData%Ha), ubound(InData%Ha)) @@ -1249,7 +1192,6 @@ subroutine MAP_PackOtherState(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! Va call RegPack(Buf, associated(InData%Va)) if (associated(InData%Va)) then call RegPackBounds(Buf, 1, lbound(InData%Va), ubound(InData%Va)) @@ -1259,7 +1201,6 @@ subroutine MAP_PackOtherState(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! x call RegPack(Buf, associated(InData%x)) if (associated(InData%x)) then call RegPackBounds(Buf, 1, lbound(InData%x), ubound(InData%x)) @@ -1269,7 +1210,6 @@ subroutine MAP_PackOtherState(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! y call RegPack(Buf, associated(InData%y)) if (associated(InData%y)) then call RegPackBounds(Buf, 1, lbound(InData%y), ubound(InData%y)) @@ -1279,7 +1219,6 @@ subroutine MAP_PackOtherState(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! z call RegPack(Buf, associated(InData%z)) if (associated(InData%z)) then call RegPackBounds(Buf, 1, lbound(InData%z), ubound(InData%z)) @@ -1289,7 +1228,6 @@ subroutine MAP_PackOtherState(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! xa call RegPack(Buf, associated(InData%xa)) if (associated(InData%xa)) then call RegPackBounds(Buf, 1, lbound(InData%xa), ubound(InData%xa)) @@ -1299,7 +1237,6 @@ subroutine MAP_PackOtherState(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! ya call RegPack(Buf, associated(InData%ya)) if (associated(InData%ya)) then call RegPackBounds(Buf, 1, lbound(InData%ya), ubound(InData%ya)) @@ -1309,7 +1246,6 @@ subroutine MAP_PackOtherState(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! za call RegPack(Buf, associated(InData%za)) if (associated(InData%za)) then call RegPackBounds(Buf, 1, lbound(InData%za), ubound(InData%za)) @@ -1319,7 +1255,6 @@ subroutine MAP_PackOtherState(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! Fx_connect call RegPack(Buf, associated(InData%Fx_connect)) if (associated(InData%Fx_connect)) then call RegPackBounds(Buf, 1, lbound(InData%Fx_connect), ubound(InData%Fx_connect)) @@ -1329,7 +1264,6 @@ subroutine MAP_PackOtherState(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! Fy_connect call RegPack(Buf, associated(InData%Fy_connect)) if (associated(InData%Fy_connect)) then call RegPackBounds(Buf, 1, lbound(InData%Fy_connect), ubound(InData%Fy_connect)) @@ -1339,7 +1273,6 @@ subroutine MAP_PackOtherState(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! Fz_connect call RegPack(Buf, associated(InData%Fz_connect)) if (associated(InData%Fz_connect)) then call RegPackBounds(Buf, 1, lbound(InData%Fz_connect), ubound(InData%Fz_connect)) @@ -1349,7 +1282,6 @@ subroutine MAP_PackOtherState(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! Fx_anchor call RegPack(Buf, associated(InData%Fx_anchor)) if (associated(InData%Fx_anchor)) then call RegPackBounds(Buf, 1, lbound(InData%Fx_anchor), ubound(InData%Fx_anchor)) @@ -1359,7 +1291,6 @@ subroutine MAP_PackOtherState(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! Fy_anchor call RegPack(Buf, associated(InData%Fy_anchor)) if (associated(InData%Fy_anchor)) then call RegPackBounds(Buf, 1, lbound(InData%Fy_anchor), ubound(InData%Fy_anchor)) @@ -1369,7 +1300,6 @@ subroutine MAP_PackOtherState(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! Fz_anchor call RegPack(Buf, associated(InData%Fz_anchor)) if (associated(InData%Fz_anchor)) then call RegPackBounds(Buf, 1, lbound(InData%Fz_anchor), ubound(InData%Fz_anchor)) @@ -1391,7 +1321,6 @@ subroutine MAP_UnPackOtherState(Buf, OutData) integer(IntKi) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return - ! H if (associated(OutData%H)) deallocate(OutData%H) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1418,7 +1347,6 @@ subroutine MAP_UnPackOtherState(Buf, OutData) else OutData%H => null() end if - ! V if (associated(OutData%V)) deallocate(OutData%V) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1445,7 +1373,6 @@ subroutine MAP_UnPackOtherState(Buf, OutData) else OutData%V => null() end if - ! Ha if (associated(OutData%Ha)) deallocate(OutData%Ha) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1472,7 +1399,6 @@ subroutine MAP_UnPackOtherState(Buf, OutData) else OutData%Ha => null() end if - ! Va if (associated(OutData%Va)) deallocate(OutData%Va) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1499,7 +1425,6 @@ subroutine MAP_UnPackOtherState(Buf, OutData) else OutData%Va => null() end if - ! x if (associated(OutData%x)) deallocate(OutData%x) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1526,7 +1451,6 @@ subroutine MAP_UnPackOtherState(Buf, OutData) else OutData%x => null() end if - ! y if (associated(OutData%y)) deallocate(OutData%y) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1553,7 +1477,6 @@ subroutine MAP_UnPackOtherState(Buf, OutData) else OutData%y => null() end if - ! z if (associated(OutData%z)) deallocate(OutData%z) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1580,7 +1503,6 @@ subroutine MAP_UnPackOtherState(Buf, OutData) else OutData%z => null() end if - ! xa if (associated(OutData%xa)) deallocate(OutData%xa) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1607,7 +1529,6 @@ subroutine MAP_UnPackOtherState(Buf, OutData) else OutData%xa => null() end if - ! ya if (associated(OutData%ya)) deallocate(OutData%ya) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1634,7 +1555,6 @@ subroutine MAP_UnPackOtherState(Buf, OutData) else OutData%ya => null() end if - ! za if (associated(OutData%za)) deallocate(OutData%za) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1661,7 +1581,6 @@ subroutine MAP_UnPackOtherState(Buf, OutData) else OutData%za => null() end if - ! Fx_connect if (associated(OutData%Fx_connect)) deallocate(OutData%Fx_connect) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1688,7 +1607,6 @@ subroutine MAP_UnPackOtherState(Buf, OutData) else OutData%Fx_connect => null() end if - ! Fy_connect if (associated(OutData%Fy_connect)) deallocate(OutData%Fy_connect) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1715,7 +1633,6 @@ subroutine MAP_UnPackOtherState(Buf, OutData) else OutData%Fy_connect => null() end if - ! Fz_connect if (associated(OutData%Fz_connect)) deallocate(OutData%Fz_connect) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1742,7 +1659,6 @@ subroutine MAP_UnPackOtherState(Buf, OutData) else OutData%Fz_connect => null() end if - ! Fx_anchor if (associated(OutData%Fx_anchor)) deallocate(OutData%Fx_anchor) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1769,7 +1685,6 @@ subroutine MAP_UnPackOtherState(Buf, OutData) else OutData%Fx_anchor => null() end if - ! Fy_anchor if (associated(OutData%Fy_anchor)) deallocate(OutData%Fy_anchor) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1796,7 +1711,6 @@ subroutine MAP_UnPackOtherState(Buf, OutData) else OutData%Fy_anchor => null() end if - ! Fz_anchor if (associated(OutData%Fz_anchor)) deallocate(OutData%Fz_anchor) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2194,143 +2108,143 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers END IF END SUBROUTINE MAP_F2C_CopyOtherState - SUBROUTINE MAP_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MAP_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(MAP_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_CopyConstrState' -! + +subroutine MAP_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(MAP_ConstraintStateType), intent(in) :: SrcConstrStateData + type(MAP_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'MAP_CopyConstrState' ErrStat = ErrID_None - ErrMsg = "" -IF (ASSOCIATED(SrcConstrStateData%H)) THEN - i1_l = LBOUND(SrcConstrStateData%H,1) - i1_u = UBOUND(SrcConstrStateData%H,1) - IF (.NOT. ASSOCIATED(DstConstrStateData%H)) THEN - ALLOCATE(DstConstrStateData%H(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%H.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstConstrStateData%C_obj%H_Len = SIZE(DstConstrStateData%H) - IF (DstConstrStateData%C_obj%H_Len > 0) & - DstConstrStateData%C_obj%H = C_LOC( DstConstrStateData%H( i1_l ) ) - END IF - DstConstrStateData%H = SrcConstrStateData%H -ENDIF -IF (ASSOCIATED(SrcConstrStateData%V)) THEN - i1_l = LBOUND(SrcConstrStateData%V,1) - i1_u = UBOUND(SrcConstrStateData%V,1) - IF (.NOT. ASSOCIATED(DstConstrStateData%V)) THEN - ALLOCATE(DstConstrStateData%V(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%V.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstConstrStateData%C_obj%V_Len = SIZE(DstConstrStateData%V) - IF (DstConstrStateData%C_obj%V_Len > 0) & - DstConstrStateData%C_obj%V = C_LOC( DstConstrStateData%V( i1_l ) ) - END IF - DstConstrStateData%V = SrcConstrStateData%V -ENDIF -IF (ASSOCIATED(SrcConstrStateData%x)) THEN - i1_l = LBOUND(SrcConstrStateData%x,1) - i1_u = UBOUND(SrcConstrStateData%x,1) - IF (.NOT. ASSOCIATED(DstConstrStateData%x)) THEN - ALLOCATE(DstConstrStateData%x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstConstrStateData%C_obj%x_Len = SIZE(DstConstrStateData%x) - IF (DstConstrStateData%C_obj%x_Len > 0) & - DstConstrStateData%C_obj%x = C_LOC( DstConstrStateData%x( i1_l ) ) - END IF - DstConstrStateData%x = SrcConstrStateData%x -ENDIF -IF (ASSOCIATED(SrcConstrStateData%y)) THEN - i1_l = LBOUND(SrcConstrStateData%y,1) - i1_u = UBOUND(SrcConstrStateData%y,1) - IF (.NOT. ASSOCIATED(DstConstrStateData%y)) THEN - ALLOCATE(DstConstrStateData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstConstrStateData%C_obj%y_Len = SIZE(DstConstrStateData%y) - IF (DstConstrStateData%C_obj%y_Len > 0) & - DstConstrStateData%C_obj%y = C_LOC( DstConstrStateData%y( i1_l ) ) - END IF - DstConstrStateData%y = SrcConstrStateData%y -ENDIF -IF (ASSOCIATED(SrcConstrStateData%z)) THEN - i1_l = LBOUND(SrcConstrStateData%z,1) - i1_u = UBOUND(SrcConstrStateData%z,1) - IF (.NOT. ASSOCIATED(DstConstrStateData%z)) THEN - ALLOCATE(DstConstrStateData%z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstConstrStateData%C_obj%z_Len = SIZE(DstConstrStateData%z) - IF (DstConstrStateData%C_obj%z_Len > 0) & - DstConstrStateData%C_obj%z = C_LOC( DstConstrStateData%z( i1_l ) ) - END IF - DstConstrStateData%z = SrcConstrStateData%z -ENDIF - END SUBROUTINE MAP_CopyConstrState - - SUBROUTINE MAP_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(MAP_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ASSOCIATED(ConstrStateData%H)) THEN - DEALLOCATE(ConstrStateData%H) - ConstrStateData%H => NULL() - ConstrStateData%C_obj%H = C_NULL_PTR - ConstrStateData%C_obj%H_Len = 0 -ENDIF -IF (ASSOCIATED(ConstrStateData%V)) THEN - DEALLOCATE(ConstrStateData%V) - ConstrStateData%V => NULL() - ConstrStateData%C_obj%V = C_NULL_PTR - ConstrStateData%C_obj%V_Len = 0 -ENDIF -IF (ASSOCIATED(ConstrStateData%x)) THEN - DEALLOCATE(ConstrStateData%x) - ConstrStateData%x => NULL() - ConstrStateData%C_obj%x = C_NULL_PTR - ConstrStateData%C_obj%x_Len = 0 -ENDIF -IF (ASSOCIATED(ConstrStateData%y)) THEN - DEALLOCATE(ConstrStateData%y) - ConstrStateData%y => NULL() - ConstrStateData%C_obj%y = C_NULL_PTR - ConstrStateData%C_obj%y_Len = 0 -ENDIF -IF (ASSOCIATED(ConstrStateData%z)) THEN - DEALLOCATE(ConstrStateData%z) - ConstrStateData%z => NULL() - ConstrStateData%C_obj%z = C_NULL_PTR - ConstrStateData%C_obj%z_Len = 0 -ENDIF - END SUBROUTINE MAP_DestroyConstrState + ErrMsg = '' + if (associated(SrcConstrStateData%H)) then + LB(1:1) = lbound(SrcConstrStateData%H) + UB(1:1) = ubound(SrcConstrStateData%H) + if (.not. associated(DstConstrStateData%H)) then + allocate(DstConstrStateData%H(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%H.', ErrStat, ErrMsg, RoutineName) + return + end if + DstConstrStateData%C_obj%H_Len = size(DstConstrStateData%H) + if (DstConstrStateData%C_obj%H_Len > 0) & + DstConstrStateData%C_obj%H = c_loc(DstConstrStateData%H(LB(1))) + end if + DstConstrStateData%H = SrcConstrStateData%H + else if (associated(DstConstrStateData%H)) then + deallocate(DstConstrStateData%H) + end if + if (associated(SrcConstrStateData%V)) then + LB(1:1) = lbound(SrcConstrStateData%V) + UB(1:1) = ubound(SrcConstrStateData%V) + if (.not. associated(DstConstrStateData%V)) then + allocate(DstConstrStateData%V(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%V.', ErrStat, ErrMsg, RoutineName) + return + end if + DstConstrStateData%C_obj%V_Len = size(DstConstrStateData%V) + if (DstConstrStateData%C_obj%V_Len > 0) & + DstConstrStateData%C_obj%V = c_loc(DstConstrStateData%V(LB(1))) + end if + DstConstrStateData%V = SrcConstrStateData%V + else if (associated(DstConstrStateData%V)) then + deallocate(DstConstrStateData%V) + end if + if (associated(SrcConstrStateData%x)) then + LB(1:1) = lbound(SrcConstrStateData%x) + UB(1:1) = ubound(SrcConstrStateData%x) + if (.not. associated(DstConstrStateData%x)) then + allocate(DstConstrStateData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + DstConstrStateData%C_obj%x_Len = size(DstConstrStateData%x) + if (DstConstrStateData%C_obj%x_Len > 0) & + DstConstrStateData%C_obj%x = c_loc(DstConstrStateData%x(LB(1))) + end if + DstConstrStateData%x = SrcConstrStateData%x + else if (associated(DstConstrStateData%x)) then + deallocate(DstConstrStateData%x) + end if + if (associated(SrcConstrStateData%y)) then + LB(1:1) = lbound(SrcConstrStateData%y) + UB(1:1) = ubound(SrcConstrStateData%y) + if (.not. associated(DstConstrStateData%y)) then + allocate(DstConstrStateData%y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%y.', ErrStat, ErrMsg, RoutineName) + return + end if + DstConstrStateData%C_obj%y_Len = size(DstConstrStateData%y) + if (DstConstrStateData%C_obj%y_Len > 0) & + DstConstrStateData%C_obj%y = c_loc(DstConstrStateData%y(LB(1))) + end if + DstConstrStateData%y = SrcConstrStateData%y + else if (associated(DstConstrStateData%y)) then + deallocate(DstConstrStateData%y) + end if + if (associated(SrcConstrStateData%z)) then + LB(1:1) = lbound(SrcConstrStateData%z) + UB(1:1) = ubound(SrcConstrStateData%z) + if (.not. associated(DstConstrStateData%z)) then + allocate(DstConstrStateData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + DstConstrStateData%C_obj%z_Len = size(DstConstrStateData%z) + if (DstConstrStateData%C_obj%z_Len > 0) & + DstConstrStateData%C_obj%z = c_loc(DstConstrStateData%z(LB(1))) + end if + DstConstrStateData%z = SrcConstrStateData%z + else if (associated(DstConstrStateData%z)) then + deallocate(DstConstrStateData%z) + end if +end subroutine +subroutine MAP_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(MAP_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MAP_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(ConstrStateData%H)) then + deallocate(ConstrStateData%H) + ConstrStateData%H => null() + ConstrStateData%C_obj%H = c_null_ptr + ConstrStateData%C_obj%H_Len = 0 + end if + if (associated(ConstrStateData%V)) then + deallocate(ConstrStateData%V) + ConstrStateData%V => null() + ConstrStateData%C_obj%V = c_null_ptr + ConstrStateData%C_obj%V_Len = 0 + end if + if (associated(ConstrStateData%x)) then + deallocate(ConstrStateData%x) + ConstrStateData%x => null() + ConstrStateData%C_obj%x = c_null_ptr + ConstrStateData%C_obj%x_Len = 0 + end if + if (associated(ConstrStateData%y)) then + deallocate(ConstrStateData%y) + ConstrStateData%y => null() + ConstrStateData%C_obj%y = c_null_ptr + ConstrStateData%C_obj%y_Len = 0 + end if + if (associated(ConstrStateData%z)) then + deallocate(ConstrStateData%z) + ConstrStateData%z => null() + ConstrStateData%C_obj%z = c_null_ptr + ConstrStateData%C_obj%z_Len = 0 + end if +end subroutine subroutine MAP_PackConstrState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -2342,7 +2256,6 @@ subroutine MAP_PackConstrState(Buf, Indata) call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - ! H call RegPack(Buf, associated(InData%H)) if (associated(InData%H)) then call RegPackBounds(Buf, 1, lbound(InData%H), ubound(InData%H)) @@ -2352,7 +2265,6 @@ subroutine MAP_PackConstrState(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! V call RegPack(Buf, associated(InData%V)) if (associated(InData%V)) then call RegPackBounds(Buf, 1, lbound(InData%V), ubound(InData%V)) @@ -2362,7 +2274,6 @@ subroutine MAP_PackConstrState(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! x call RegPack(Buf, associated(InData%x)) if (associated(InData%x)) then call RegPackBounds(Buf, 1, lbound(InData%x), ubound(InData%x)) @@ -2372,7 +2283,6 @@ subroutine MAP_PackConstrState(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! y call RegPack(Buf, associated(InData%y)) if (associated(InData%y)) then call RegPackBounds(Buf, 1, lbound(InData%y), ubound(InData%y)) @@ -2382,7 +2292,6 @@ subroutine MAP_PackConstrState(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! z call RegPack(Buf, associated(InData%z)) if (associated(InData%z)) then call RegPackBounds(Buf, 1, lbound(InData%z), ubound(InData%z)) @@ -2404,7 +2313,6 @@ subroutine MAP_UnPackConstrState(Buf, OutData) integer(IntKi) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return - ! H if (associated(OutData%H)) deallocate(OutData%H) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2431,7 +2339,6 @@ subroutine MAP_UnPackConstrState(Buf, OutData) else OutData%H => null() end if - ! V if (associated(OutData%V)) deallocate(OutData%V) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2458,7 +2365,6 @@ subroutine MAP_UnPackConstrState(Buf, OutData) else OutData%V => null() end if - ! x if (associated(OutData%x)) deallocate(OutData%x) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2485,7 +2391,6 @@ subroutine MAP_UnPackConstrState(Buf, OutData) else OutData%x => null() end if - ! y if (associated(OutData%y)) deallocate(OutData%y) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2512,7 +2417,6 @@ subroutine MAP_UnPackConstrState(Buf, OutData) else OutData%y => null() end if - ! z if (associated(OutData%z)) deallocate(OutData%z) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2679,55 +2583,45 @@ SUBROUTINE MAP_F2C_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointe END IF END SUBROUTINE MAP_F2C_CopyConstrState - SUBROUTINE MAP_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MAP_ParameterType), INTENT(IN) :: SrcParamData - TYPE(MAP_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_CopyParam' -! + +subroutine MAP_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(MAP_ParameterType), intent(in) :: SrcParamData + type(MAP_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MAP_CopyParam' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%g = SrcParamData%g - DstParamData%C_obj%g = SrcParamData%C_obj%g - DstParamData%depth = SrcParamData%depth - DstParamData%C_obj%depth = SrcParamData%C_obj%depth - DstParamData%rho_sea = SrcParamData%rho_sea - DstParamData%C_obj%rho_sea = SrcParamData%C_obj%rho_sea - DstParamData%dt = SrcParamData%dt - DstParamData%C_obj%dt = SrcParamData%C_obj%dt - DstParamData%InputLines = SrcParamData%InputLines - DstParamData%InputLineType = SrcParamData%InputLineType - DstParamData%numOuts = SrcParamData%numOuts - DstParamData%C_obj%numOuts = SrcParamData%C_obj%numOuts - CALL MAP_Fortran_Copylin_paramtype( SrcParamData%LinParams, DstParamData%LinParams, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE MAP_CopyParam - - SUBROUTINE MAP_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(MAP_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL MAP_Fortran_DestroyLin_ParamType( ParamData%LinParams, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE MAP_DestroyParam + ErrMsg = '' + DstParamData%g = SrcParamData%g + DstParamData%C_obj%g = SrcParamData%C_obj%g + DstParamData%depth = SrcParamData%depth + DstParamData%C_obj%depth = SrcParamData%C_obj%depth + DstParamData%rho_sea = SrcParamData%rho_sea + DstParamData%C_obj%rho_sea = SrcParamData%C_obj%rho_sea + DstParamData%dt = SrcParamData%dt + DstParamData%C_obj%dt = SrcParamData%C_obj%dt + DstParamData%InputLines = SrcParamData%InputLines + DstParamData%InputLineType = SrcParamData%InputLineType + DstParamData%numOuts = SrcParamData%numOuts + DstParamData%C_obj%numOuts = SrcParamData%C_obj%numOuts + call MAP_Fortran_CopyLin_ParamType(SrcParamData%LinParams, DstParamData%LinParams, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine MAP_DestroyParam(ParamData, ErrStat, ErrMsg) + type(MAP_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MAP_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine MAP_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -2738,28 +2632,20 @@ subroutine MAP_PackParam(Buf, Indata) call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - ! g call RegPack(Buf, InData%g) if (RegCheckErr(Buf, RoutineName)) return - ! depth call RegPack(Buf, InData%depth) if (RegCheckErr(Buf, RoutineName)) return - ! rho_sea call RegPack(Buf, InData%rho_sea) if (RegCheckErr(Buf, RoutineName)) return - ! dt call RegPack(Buf, InData%dt) if (RegCheckErr(Buf, RoutineName)) return - ! InputLines call RegPack(Buf, InData%InputLines) if (RegCheckErr(Buf, RoutineName)) return - ! InputLineType call RegPack(Buf, InData%InputLineType) if (RegCheckErr(Buf, RoutineName)) return - ! numOuts call RegPack(Buf, InData%numOuts) if (RegCheckErr(Buf, RoutineName)) return - ! LinParams call MAP_Fortran_PackLin_ParamType(Buf, InData%LinParams) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2769,33 +2655,25 @@ subroutine MAP_UnPackParam(Buf, OutData) type(MAP_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MAP_UnPackParam' if (Buf%ErrStat /= ErrID_None) return - ! g call RegUnpack(Buf, OutData%g) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%g = OutData%g - ! depth call RegUnpack(Buf, OutData%depth) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%depth = OutData%depth - ! rho_sea call RegUnpack(Buf, OutData%rho_sea) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%rho_sea = OutData%rho_sea - ! dt call RegUnpack(Buf, OutData%dt) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%dt = OutData%dt - ! InputLines call RegUnpack(Buf, OutData%InputLines) if (RegCheckErr(Buf, RoutineName)) return - ! InputLineType call RegUnpack(Buf, OutData%InputLineType) if (RegCheckErr(Buf, RoutineName)) return - ! numOuts call RegUnpack(Buf, OutData%numOuts) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%numOuts = OutData%numOuts - ! LinParams call MAP_Fortran_UnpackLin_ParamType(Buf, OutData%LinParams) ! LinParams end subroutine SUBROUTINE MAP_C2Fary_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) @@ -2842,106 +2720,103 @@ SUBROUTINE MAP_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) ParamData%C_obj%numOuts = ParamData%numOuts END SUBROUTINE MAP_F2C_CopyParam - SUBROUTINE MAP_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MAP_InputType), INTENT(INOUT) :: SrcInputData - TYPE(MAP_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_CopyInput' -! + +subroutine MAP_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(MAP_InputType), intent(inout) :: SrcInputData + type(MAP_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MAP_CopyInput' ErrStat = ErrID_None - ErrMsg = "" -IF (ASSOCIATED(SrcInputData%x)) THEN - i1_l = LBOUND(SrcInputData%x,1) - i1_u = UBOUND(SrcInputData%x,1) - IF (.NOT. ASSOCIATED(DstInputData%x)) THEN - ALLOCATE(DstInputData%x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%C_obj%x_Len = SIZE(DstInputData%x) - IF (DstInputData%C_obj%x_Len > 0) & - DstInputData%C_obj%x = C_LOC( DstInputData%x( i1_l ) ) - END IF - DstInputData%x = SrcInputData%x -ENDIF -IF (ASSOCIATED(SrcInputData%y)) THEN - i1_l = LBOUND(SrcInputData%y,1) - i1_u = UBOUND(SrcInputData%y,1) - IF (.NOT. ASSOCIATED(DstInputData%y)) THEN - ALLOCATE(DstInputData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%C_obj%y_Len = SIZE(DstInputData%y) - IF (DstInputData%C_obj%y_Len > 0) & - DstInputData%C_obj%y = C_LOC( DstInputData%y( i1_l ) ) - END IF - DstInputData%y = SrcInputData%y -ENDIF -IF (ASSOCIATED(SrcInputData%z)) THEN - i1_l = LBOUND(SrcInputData%z,1) - i1_u = UBOUND(SrcInputData%z,1) - IF (.NOT. ASSOCIATED(DstInputData%z)) THEN - ALLOCATE(DstInputData%z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%C_obj%z_Len = SIZE(DstInputData%z) - IF (DstInputData%C_obj%z_Len > 0) & - DstInputData%C_obj%z = C_LOC( DstInputData%z( i1_l ) ) - END IF - DstInputData%z = SrcInputData%z -ENDIF - CALL MeshCopy( SrcInputData%PtFairDisplacement, DstInputData%PtFairDisplacement, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE MAP_CopyInput - - SUBROUTINE MAP_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(MAP_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ASSOCIATED(InputData%x)) THEN - DEALLOCATE(InputData%x) - InputData%x => NULL() - InputData%C_obj%x = C_NULL_PTR - InputData%C_obj%x_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%y)) THEN - DEALLOCATE(InputData%y) - InputData%y => NULL() - InputData%C_obj%y = C_NULL_PTR - InputData%C_obj%y_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%z)) THEN - DEALLOCATE(InputData%z) - InputData%z => NULL() - InputData%C_obj%z = C_NULL_PTR - InputData%C_obj%z_Len = 0 -ENDIF - CALL MeshDestroy( InputData%PtFairDisplacement, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE MAP_DestroyInput + ErrMsg = '' + if (associated(SrcInputData%x)) then + LB(1:1) = lbound(SrcInputData%x) + UB(1:1) = ubound(SrcInputData%x) + if (.not. associated(DstInputData%x)) then + allocate(DstInputData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + DstInputData%C_obj%x_Len = size(DstInputData%x) + if (DstInputData%C_obj%x_Len > 0) & + DstInputData%C_obj%x = c_loc(DstInputData%x(LB(1))) + end if + DstInputData%x = SrcInputData%x + else if (associated(DstInputData%x)) then + deallocate(DstInputData%x) + end if + if (associated(SrcInputData%y)) then + LB(1:1) = lbound(SrcInputData%y) + UB(1:1) = ubound(SrcInputData%y) + if (.not. associated(DstInputData%y)) then + allocate(DstInputData%y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%y.', ErrStat, ErrMsg, RoutineName) + return + end if + DstInputData%C_obj%y_Len = size(DstInputData%y) + if (DstInputData%C_obj%y_Len > 0) & + DstInputData%C_obj%y = c_loc(DstInputData%y(LB(1))) + end if + DstInputData%y = SrcInputData%y + else if (associated(DstInputData%y)) then + deallocate(DstInputData%y) + end if + if (associated(SrcInputData%z)) then + LB(1:1) = lbound(SrcInputData%z) + UB(1:1) = ubound(SrcInputData%z) + if (.not. associated(DstInputData%z)) then + allocate(DstInputData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + DstInputData%C_obj%z_Len = size(DstInputData%z) + if (DstInputData%C_obj%z_Len > 0) & + DstInputData%C_obj%z = c_loc(DstInputData%z(LB(1))) + end if + DstInputData%z = SrcInputData%z + else if (associated(DstInputData%z)) then + deallocate(DstInputData%z) + end if + call MeshCopy(SrcInputData%PtFairDisplacement, DstInputData%PtFairDisplacement, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine MAP_DestroyInput(InputData, ErrStat, ErrMsg) + type(MAP_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MAP_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(InputData%x)) then + deallocate(InputData%x) + InputData%x => null() + InputData%C_obj%x = c_null_ptr + InputData%C_obj%x_Len = 0 + end if + if (associated(InputData%y)) then + deallocate(InputData%y) + InputData%y => null() + InputData%C_obj%y = c_null_ptr + InputData%C_obj%y_Len = 0 + end if + if (associated(InputData%z)) then + deallocate(InputData%z) + InputData%z => null() + InputData%C_obj%z = c_null_ptr + InputData%C_obj%z_Len = 0 + end if +end subroutine subroutine MAP_PackInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -2953,7 +2828,6 @@ subroutine MAP_PackInput(Buf, Indata) call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - ! x call RegPack(Buf, associated(InData%x)) if (associated(InData%x)) then call RegPackBounds(Buf, 1, lbound(InData%x), ubound(InData%x)) @@ -2963,7 +2837,6 @@ subroutine MAP_PackInput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! y call RegPack(Buf, associated(InData%y)) if (associated(InData%y)) then call RegPackBounds(Buf, 1, lbound(InData%y), ubound(InData%y)) @@ -2973,7 +2846,6 @@ subroutine MAP_PackInput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! z call RegPack(Buf, associated(InData%z)) if (associated(InData%z)) then call RegPackBounds(Buf, 1, lbound(InData%z), ubound(InData%z)) @@ -2983,7 +2855,6 @@ subroutine MAP_PackInput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! PtFairDisplacement call MeshPack(Buf, InData%PtFairDisplacement) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2998,7 +2869,6 @@ subroutine MAP_UnPackInput(Buf, OutData) integer(IntKi) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return - ! x if (associated(OutData%x)) deallocate(OutData%x) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3025,7 +2895,6 @@ subroutine MAP_UnPackInput(Buf, OutData) else OutData%x => null() end if - ! y if (associated(OutData%y)) deallocate(OutData%y) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3052,7 +2921,6 @@ subroutine MAP_UnPackInput(Buf, OutData) else OutData%y => null() end if - ! z if (associated(OutData%z)) deallocate(OutData%z) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3079,7 +2947,6 @@ subroutine MAP_UnPackInput(Buf, OutData) else OutData%z => null() end if - ! PtFairDisplacement call MeshUnpack(Buf, OutData%PtFairDisplacement) ! PtFairDisplacement end subroutine SUBROUTINE MAP_C2Fary_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) @@ -3179,142 +3046,143 @@ SUBROUTINE MAP_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) END IF END SUBROUTINE MAP_F2C_CopyInput - SUBROUTINE MAP_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MAP_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(MAP_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_CopyOutput' -! + +subroutine MAP_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(MAP_OutputType), intent(inout) :: SrcOutputData + type(MAP_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MAP_CopyOutput' ErrStat = ErrID_None - ErrMsg = "" -IF (ASSOCIATED(SrcOutputData%Fx)) THEN - i1_l = LBOUND(SrcOutputData%Fx,1) - i1_u = UBOUND(SrcOutputData%Fx,1) - IF (.NOT. ASSOCIATED(DstOutputData%Fx)) THEN - ALLOCATE(DstOutputData%Fx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Fx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOutputData%C_obj%Fx_Len = SIZE(DstOutputData%Fx) - IF (DstOutputData%C_obj%Fx_Len > 0) & - DstOutputData%C_obj%Fx = C_LOC( DstOutputData%Fx( i1_l ) ) - END IF - DstOutputData%Fx = SrcOutputData%Fx -ENDIF -IF (ASSOCIATED(SrcOutputData%Fy)) THEN - i1_l = LBOUND(SrcOutputData%Fy,1) - i1_u = UBOUND(SrcOutputData%Fy,1) - IF (.NOT. ASSOCIATED(DstOutputData%Fy)) THEN - ALLOCATE(DstOutputData%Fy(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Fy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOutputData%C_obj%Fy_Len = SIZE(DstOutputData%Fy) - IF (DstOutputData%C_obj%Fy_Len > 0) & - DstOutputData%C_obj%Fy = C_LOC( DstOutputData%Fy( i1_l ) ) - END IF - DstOutputData%Fy = SrcOutputData%Fy -ENDIF -IF (ASSOCIATED(SrcOutputData%Fz)) THEN - i1_l = LBOUND(SrcOutputData%Fz,1) - i1_u = UBOUND(SrcOutputData%Fz,1) - IF (.NOT. ASSOCIATED(DstOutputData%Fz)) THEN - ALLOCATE(DstOutputData%Fz(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Fz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOutputData%C_obj%Fz_Len = SIZE(DstOutputData%Fz) - IF (DstOutputData%C_obj%Fz_Len > 0) & - DstOutputData%C_obj%Fz = C_LOC( DstOutputData%Fz( i1_l ) ) - END IF - DstOutputData%Fz = SrcOutputData%Fz -ENDIF -IF (ALLOCATED(SrcOutputData%WriteOutput)) THEN - i1_l = LBOUND(SrcOutputData%WriteOutput,1) - i1_u = UBOUND(SrcOutputData%WriteOutput,1) - IF (.NOT. ALLOCATED(DstOutputData%WriteOutput)) THEN - ALLOCATE(DstOutputData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%WriteOutput = SrcOutputData%WriteOutput -ENDIF -IF (ASSOCIATED(SrcOutputData%wrtOutput)) THEN - i1_l = LBOUND(SrcOutputData%wrtOutput,1) - i1_u = UBOUND(SrcOutputData%wrtOutput,1) - IF (.NOT. ASSOCIATED(DstOutputData%wrtOutput)) THEN - ALLOCATE(DstOutputData%wrtOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%wrtOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOutputData%C_obj%wrtOutput_Len = SIZE(DstOutputData%wrtOutput) - IF (DstOutputData%C_obj%wrtOutput_Len > 0) & - DstOutputData%C_obj%wrtOutput = C_LOC( DstOutputData%wrtOutput( i1_l ) ) - END IF - DstOutputData%wrtOutput = SrcOutputData%wrtOutput -ENDIF - CALL MeshCopy( SrcOutputData%ptFairleadLoad, DstOutputData%ptFairleadLoad, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE MAP_CopyOutput - - SUBROUTINE MAP_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(MAP_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ASSOCIATED(OutputData%Fx)) THEN - DEALLOCATE(OutputData%Fx) - OutputData%Fx => NULL() - OutputData%C_obj%Fx = C_NULL_PTR - OutputData%C_obj%Fx_Len = 0 -ENDIF -IF (ASSOCIATED(OutputData%Fy)) THEN - DEALLOCATE(OutputData%Fy) - OutputData%Fy => NULL() - OutputData%C_obj%Fy = C_NULL_PTR - OutputData%C_obj%Fy_Len = 0 -ENDIF -IF (ASSOCIATED(OutputData%Fz)) THEN - DEALLOCATE(OutputData%Fz) - OutputData%Fz => NULL() - OutputData%C_obj%Fz = C_NULL_PTR - OutputData%C_obj%Fz_Len = 0 -ENDIF -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF -IF (ASSOCIATED(OutputData%wrtOutput)) THEN - DEALLOCATE(OutputData%wrtOutput) - OutputData%wrtOutput => NULL() - OutputData%C_obj%wrtOutput = C_NULL_PTR - OutputData%C_obj%wrtOutput_Len = 0 -ENDIF - CALL MeshDestroy( OutputData%ptFairleadLoad, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE MAP_DestroyOutput + ErrMsg = '' + if (associated(SrcOutputData%Fx)) then + LB(1:1) = lbound(SrcOutputData%Fx) + UB(1:1) = ubound(SrcOutputData%Fx) + if (.not. associated(DstOutputData%Fx)) then + allocate(DstOutputData%Fx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Fx.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOutputData%C_obj%Fx_Len = size(DstOutputData%Fx) + if (DstOutputData%C_obj%Fx_Len > 0) & + DstOutputData%C_obj%Fx = c_loc(DstOutputData%Fx(LB(1))) + end if + DstOutputData%Fx = SrcOutputData%Fx + else if (associated(DstOutputData%Fx)) then + deallocate(DstOutputData%Fx) + end if + if (associated(SrcOutputData%Fy)) then + LB(1:1) = lbound(SrcOutputData%Fy) + UB(1:1) = ubound(SrcOutputData%Fy) + if (.not. associated(DstOutputData%Fy)) then + allocate(DstOutputData%Fy(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Fy.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOutputData%C_obj%Fy_Len = size(DstOutputData%Fy) + if (DstOutputData%C_obj%Fy_Len > 0) & + DstOutputData%C_obj%Fy = c_loc(DstOutputData%Fy(LB(1))) + end if + DstOutputData%Fy = SrcOutputData%Fy + else if (associated(DstOutputData%Fy)) then + deallocate(DstOutputData%Fy) + end if + if (associated(SrcOutputData%Fz)) then + LB(1:1) = lbound(SrcOutputData%Fz) + UB(1:1) = ubound(SrcOutputData%Fz) + if (.not. associated(DstOutputData%Fz)) then + allocate(DstOutputData%Fz(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Fz.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOutputData%C_obj%Fz_Len = size(DstOutputData%Fz) + if (DstOutputData%C_obj%Fz_Len > 0) & + DstOutputData%C_obj%Fz = c_loc(DstOutputData%Fz(LB(1))) + end if + DstOutputData%Fz = SrcOutputData%Fz + else if (associated(DstOutputData%Fz)) then + deallocate(DstOutputData%Fz) + end if + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%WriteOutput = SrcOutputData%WriteOutput + else if (allocated(DstOutputData%WriteOutput)) then + deallocate(DstOutputData%WriteOutput) + end if + if (associated(SrcOutputData%wrtOutput)) then + LB(1:1) = lbound(SrcOutputData%wrtOutput) + UB(1:1) = ubound(SrcOutputData%wrtOutput) + if (.not. associated(DstOutputData%wrtOutput)) then + allocate(DstOutputData%wrtOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%wrtOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOutputData%C_obj%wrtOutput_Len = size(DstOutputData%wrtOutput) + if (DstOutputData%C_obj%wrtOutput_Len > 0) & + DstOutputData%C_obj%wrtOutput = c_loc(DstOutputData%wrtOutput(LB(1))) + end if + DstOutputData%wrtOutput = SrcOutputData%wrtOutput + else if (associated(DstOutputData%wrtOutput)) then + deallocate(DstOutputData%wrtOutput) + end if + call MeshCopy(SrcOutputData%ptFairleadLoad, DstOutputData%ptFairleadLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine MAP_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(MAP_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MAP_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(OutputData%Fx)) then + deallocate(OutputData%Fx) + OutputData%Fx => null() + OutputData%C_obj%Fx = c_null_ptr + OutputData%C_obj%Fx_Len = 0 + end if + if (associated(OutputData%Fy)) then + deallocate(OutputData%Fy) + OutputData%Fy => null() + OutputData%C_obj%Fy = c_null_ptr + OutputData%C_obj%Fy_Len = 0 + end if + if (associated(OutputData%Fz)) then + deallocate(OutputData%Fz) + OutputData%Fz => null() + OutputData%C_obj%Fz = c_null_ptr + OutputData%C_obj%Fz_Len = 0 + end if + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if + if (associated(OutputData%wrtOutput)) then + deallocate(OutputData%wrtOutput) + OutputData%wrtOutput => null() + OutputData%C_obj%wrtOutput = c_null_ptr + OutputData%C_obj%wrtOutput_Len = 0 + end if +end subroutine subroutine MAP_PackOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -3326,7 +3194,6 @@ subroutine MAP_PackOutput(Buf, Indata) call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - ! Fx call RegPack(Buf, associated(InData%Fx)) if (associated(InData%Fx)) then call RegPackBounds(Buf, 1, lbound(InData%Fx), ubound(InData%Fx)) @@ -3336,7 +3203,6 @@ subroutine MAP_PackOutput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! Fy call RegPack(Buf, associated(InData%Fy)) if (associated(InData%Fy)) then call RegPackBounds(Buf, 1, lbound(InData%Fy), ubound(InData%Fy)) @@ -3346,7 +3212,6 @@ subroutine MAP_PackOutput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! Fz call RegPack(Buf, associated(InData%Fz)) if (associated(InData%Fz)) then call RegPackBounds(Buf, 1, lbound(InData%Fz), ubound(InData%Fz)) @@ -3356,14 +3221,12 @@ subroutine MAP_PackOutput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutput call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) call RegPack(Buf, InData%WriteOutput) end if if (RegCheckErr(Buf, RoutineName)) return - ! wrtOutput call RegPack(Buf, associated(InData%wrtOutput)) if (associated(InData%wrtOutput)) then call RegPackBounds(Buf, 1, lbound(InData%wrtOutput), ubound(InData%wrtOutput)) @@ -3373,7 +3236,6 @@ subroutine MAP_PackOutput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! ptFairleadLoad call MeshPack(Buf, InData%ptFairleadLoad) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3388,7 +3250,6 @@ subroutine MAP_UnPackOutput(Buf, OutData) integer(IntKi) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return - ! Fx if (associated(OutData%Fx)) deallocate(OutData%Fx) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3415,7 +3276,6 @@ subroutine MAP_UnPackOutput(Buf, OutData) else OutData%Fx => null() end if - ! Fy if (associated(OutData%Fy)) deallocate(OutData%Fy) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3442,7 +3302,6 @@ subroutine MAP_UnPackOutput(Buf, OutData) else OutData%Fy => null() end if - ! Fz if (associated(OutData%Fz)) deallocate(OutData%Fz) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3469,7 +3328,6 @@ subroutine MAP_UnPackOutput(Buf, OutData) else OutData%Fz => null() end if - ! WriteOutput if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3484,7 +3342,6 @@ subroutine MAP_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutput) if (RegCheckErr(Buf, RoutineName)) return end if - ! wrtOutput if (associated(OutData%wrtOutput)) deallocate(OutData%wrtOutput) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3511,7 +3368,6 @@ subroutine MAP_UnPackOutput(Buf, OutData) else OutData%wrtOutput => null() end if - ! ptFairleadLoad call MeshUnpack(Buf, OutData%ptFairleadLoad) ! ptFairleadLoad end subroutine SUBROUTINE MAP_C2Fary_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) diff --git a/modules/moordyn/src/MoorDyn_Types.f90 b/modules/moordyn/src/MoorDyn_Types.f90 index 85553db338..f5bce9d51a 100644 --- a/modules/moordyn/src/MoorDyn_Types.f90 +++ b/modules/moordyn/src/MoorDyn_Types.f90 @@ -462,57 +462,42 @@ MODULE MoorDyn_Types END TYPE MD_OutputType ! ======================= CONTAINS - SUBROUTINE MD_CopyInputFileType( SrcInputFileTypeData, DstInputFileTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_InputFileType), INTENT(IN) :: SrcInputFileTypeData - TYPE(MD_InputFileType), INTENT(INOUT) :: DstInputFileTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyInputFileType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInputFileTypeData%DTIC = SrcInputFileTypeData%DTIC - DstInputFileTypeData%TMaxIC = SrcInputFileTypeData%TMaxIC - DstInputFileTypeData%CdScaleIC = SrcInputFileTypeData%CdScaleIC - DstInputFileTypeData%threshIC = SrcInputFileTypeData%threshIC - END SUBROUTINE MD_CopyInputFileType - - SUBROUTINE MD_DestroyInputFileType( InputFileTypeData, ErrStat, ErrMsg ) - TYPE(MD_InputFileType), INTENT(INOUT) :: InputFileTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyInputFileType' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE MD_DestroyInputFileType +subroutine MD_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, CtrlCode, ErrStat, ErrMsg) + type(MD_InputFileType), intent(in) :: SrcInputFileTypeData + type(MD_InputFileType), intent(inout) :: DstInputFileTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_CopyInputFileType' + ErrStat = ErrID_None + ErrMsg = '' + DstInputFileTypeData%DTIC = SrcInputFileTypeData%DTIC + DstInputFileTypeData%TMaxIC = SrcInputFileTypeData%TMaxIC + DstInputFileTypeData%CdScaleIC = SrcInputFileTypeData%CdScaleIC + DstInputFileTypeData%threshIC = SrcInputFileTypeData%threshIC +end subroutine +subroutine MD_DestroyInputFileType(InputFileTypeData, ErrStat, ErrMsg) + type(MD_InputFileType), intent(inout) :: InputFileTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_DestroyInputFileType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine MD_PackInputFileType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(MD_InputFileType), intent(in) :: InData character(*), parameter :: RoutineName = 'MD_PackInputFileType' if (Buf%ErrStat >= AbortErrLev) return - ! DTIC call RegPack(Buf, InData%DTIC) if (RegCheckErr(Buf, RoutineName)) return - ! TMaxIC call RegPack(Buf, InData%TMaxIC) if (RegCheckErr(Buf, RoutineName)) return - ! CdScaleIC call RegPack(Buf, InData%CdScaleIC) if (RegCheckErr(Buf, RoutineName)) return - ! threshIC call RegPack(Buf, InData%threshIC) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -522,174 +507,148 @@ subroutine MD_UnPackInputFileType(Buf, OutData) type(MD_InputFileType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackInputFileType' if (Buf%ErrStat /= ErrID_None) return - ! DTIC call RegUnpack(Buf, OutData%DTIC) if (RegCheckErr(Buf, RoutineName)) return - ! TMaxIC call RegUnpack(Buf, OutData%TMaxIC) if (RegCheckErr(Buf, RoutineName)) return - ! CdScaleIC call RegUnpack(Buf, OutData%CdScaleIC) if (RegCheckErr(Buf, RoutineName)) return - ! threshIC call RegUnpack(Buf, OutData%threshIC) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE MD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(MD_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%g = SrcInitInputData%g - DstInitInputData%rhoW = SrcInitInputData%rhoW - DstInitInputData%WtrDepth = SrcInitInputData%WtrDepth -IF (ALLOCATED(SrcInitInputData%PtfmInit)) THEN - i1_l = LBOUND(SrcInitInputData%PtfmInit,1) - i1_u = UBOUND(SrcInitInputData%PtfmInit,1) - i2_l = LBOUND(SrcInitInputData%PtfmInit,2) - i2_u = UBOUND(SrcInitInputData%PtfmInit,2) - IF (.NOT. ALLOCATED(DstInitInputData%PtfmInit)) THEN - ALLOCATE(DstInitInputData%PtfmInit(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmInit.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%PtfmInit = SrcInitInputData%PtfmInit -ENDIF - DstInitInputData%FarmSize = SrcInitInputData%FarmSize -IF (ALLOCATED(SrcInitInputData%TurbineRefPos)) THEN - i1_l = LBOUND(SrcInitInputData%TurbineRefPos,1) - i1_u = UBOUND(SrcInitInputData%TurbineRefPos,1) - i2_l = LBOUND(SrcInitInputData%TurbineRefPos,2) - i2_u = UBOUND(SrcInitInputData%TurbineRefPos,2) - IF (.NOT. ALLOCATED(DstInitInputData%TurbineRefPos)) THEN - ALLOCATE(DstInitInputData%TurbineRefPos(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%TurbineRefPos.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%TurbineRefPos = SrcInitInputData%TurbineRefPos -ENDIF - DstInitInputData%Tmax = SrcInitInputData%Tmax - DstInitInputData%FileName = SrcInitInputData%FileName - DstInitInputData%RootName = SrcInitInputData%RootName - DstInitInputData%UsePrimaryInputFile = SrcInitInputData%UsePrimaryInputFile - CALL NWTC_Library_Copyfileinfotype( SrcInitInputData%PassedPrimaryInputData, DstInitInputData%PassedPrimaryInputData, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitInputData%Echo = SrcInitInputData%Echo -IF (ALLOCATED(SrcInitInputData%OutList)) THEN - i1_l = LBOUND(SrcInitInputData%OutList,1) - i1_u = UBOUND(SrcInitInputData%OutList,1) - IF (.NOT. ALLOCATED(DstInitInputData%OutList)) THEN - ALLOCATE(DstInitInputData%OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%OutList = SrcInitInputData%OutList -ENDIF - DstInitInputData%Linearize = SrcInitInputData%Linearize - END SUBROUTINE MD_CopyInitInput - - SUBROUTINE MD_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(MD_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyInitInput' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitInputData%PtfmInit)) THEN - DEALLOCATE(InitInputData%PtfmInit) -ENDIF -IF (ALLOCATED(InitInputData%TurbineRefPos)) THEN - DEALLOCATE(InitInputData%TurbineRefPos) -ENDIF - CALL NWTC_Library_DestroyFileInfoType( InitInputData%PassedPrimaryInputData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitInputData%OutList)) THEN - DEALLOCATE(InitInputData%OutList) -ENDIF - END SUBROUTINE MD_DestroyInitInput +subroutine MD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(MD_InitInputType), intent(in) :: SrcInitInputData + type(MD_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MD_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitInputData%g = SrcInitInputData%g + DstInitInputData%rhoW = SrcInitInputData%rhoW + DstInitInputData%WtrDepth = SrcInitInputData%WtrDepth + if (allocated(SrcInitInputData%PtfmInit)) then + LB(1:2) = lbound(SrcInitInputData%PtfmInit) + UB(1:2) = ubound(SrcInitInputData%PtfmInit) + if (.not. allocated(DstInitInputData%PtfmInit)) then + allocate(DstInitInputData%PtfmInit(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmInit.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%PtfmInit = SrcInitInputData%PtfmInit + else if (allocated(DstInitInputData%PtfmInit)) then + deallocate(DstInitInputData%PtfmInit) + end if + DstInitInputData%FarmSize = SrcInitInputData%FarmSize + if (allocated(SrcInitInputData%TurbineRefPos)) then + LB(1:2) = lbound(SrcInitInputData%TurbineRefPos) + UB(1:2) = ubound(SrcInitInputData%TurbineRefPos) + if (.not. allocated(DstInitInputData%TurbineRefPos)) then + allocate(DstInitInputData%TurbineRefPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%TurbineRefPos.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%TurbineRefPos = SrcInitInputData%TurbineRefPos + else if (allocated(DstInitInputData%TurbineRefPos)) then + deallocate(DstInitInputData%TurbineRefPos) + end if + DstInitInputData%Tmax = SrcInitInputData%Tmax + DstInitInputData%FileName = SrcInitInputData%FileName + DstInitInputData%RootName = SrcInitInputData%RootName + DstInitInputData%UsePrimaryInputFile = SrcInitInputData%UsePrimaryInputFile + call NWTC_Library_CopyFileInfoType(SrcInitInputData%PassedPrimaryInputData, DstInitInputData%PassedPrimaryInputData, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitInputData%Echo = SrcInitInputData%Echo + if (allocated(SrcInitInputData%OutList)) then + LB(1:1) = lbound(SrcInitInputData%OutList) + UB(1:1) = ubound(SrcInitInputData%OutList) + if (.not. allocated(DstInitInputData%OutList)) then + allocate(DstInitInputData%OutList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%OutList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%OutList = SrcInitInputData%OutList + else if (allocated(DstInitInputData%OutList)) then + deallocate(DstInitInputData%OutList) + end if + DstInitInputData%Linearize = SrcInitInputData%Linearize +end subroutine +subroutine MD_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(MD_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MD_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitInputData%PtfmInit)) then + deallocate(InitInputData%PtfmInit) + end if + if (allocated(InitInputData%TurbineRefPos)) then + deallocate(InitInputData%TurbineRefPos) + end if + if (allocated(InitInputData%OutList)) then + deallocate(InitInputData%OutList) + end if +end subroutine subroutine MD_PackInitInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(MD_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'MD_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return - ! g call RegPack(Buf, InData%g) if (RegCheckErr(Buf, RoutineName)) return - ! rhoW call RegPack(Buf, InData%rhoW) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDepth call RegPack(Buf, InData%WtrDepth) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmInit call RegPack(Buf, allocated(InData%PtfmInit)) if (allocated(InData%PtfmInit)) then call RegPackBounds(Buf, 2, lbound(InData%PtfmInit), ubound(InData%PtfmInit)) call RegPack(Buf, InData%PtfmInit) end if if (RegCheckErr(Buf, RoutineName)) return - ! FarmSize call RegPack(Buf, InData%FarmSize) if (RegCheckErr(Buf, RoutineName)) return - ! TurbineRefPos call RegPack(Buf, allocated(InData%TurbineRefPos)) if (allocated(InData%TurbineRefPos)) then call RegPackBounds(Buf, 2, lbound(InData%TurbineRefPos), ubound(InData%TurbineRefPos)) call RegPack(Buf, InData%TurbineRefPos) end if if (RegCheckErr(Buf, RoutineName)) return - ! Tmax call RegPack(Buf, InData%Tmax) if (RegCheckErr(Buf, RoutineName)) return - ! FileName call RegPack(Buf, InData%FileName) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegPack(Buf, InData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! UsePrimaryInputFile call RegPack(Buf, InData%UsePrimaryInputFile) if (RegCheckErr(Buf, RoutineName)) return - ! PassedPrimaryInputData call NWTC_Library_PackFileInfoType(Buf, InData%PassedPrimaryInputData) if (RegCheckErr(Buf, RoutineName)) return - ! Echo call RegPack(Buf, InData%Echo) if (RegCheckErr(Buf, RoutineName)) return - ! OutList call RegPack(Buf, allocated(InData%OutList)) if (allocated(InData%OutList)) then call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) call RegPack(Buf, InData%OutList) end if if (RegCheckErr(Buf, RoutineName)) return - ! Linearize call RegPack(Buf, InData%Linearize) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -702,16 +661,12 @@ subroutine MD_UnPackInitInput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! g call RegUnpack(Buf, OutData%g) if (RegCheckErr(Buf, RoutineName)) return - ! rhoW call RegUnpack(Buf, OutData%rhoW) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDepth call RegUnpack(Buf, OutData%WtrDepth) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmInit if (allocated(OutData%PtfmInit)) deallocate(OutData%PtfmInit) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -726,10 +681,8 @@ subroutine MD_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%PtfmInit) if (RegCheckErr(Buf, RoutineName)) return end if - ! FarmSize call RegUnpack(Buf, OutData%FarmSize) if (RegCheckErr(Buf, RoutineName)) return - ! TurbineRefPos if (allocated(OutData%TurbineRefPos)) deallocate(OutData%TurbineRefPos) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -744,24 +697,17 @@ subroutine MD_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%TurbineRefPos) if (RegCheckErr(Buf, RoutineName)) return end if - ! Tmax call RegUnpack(Buf, OutData%Tmax) if (RegCheckErr(Buf, RoutineName)) return - ! FileName call RegUnpack(Buf, OutData%FileName) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegUnpack(Buf, OutData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! UsePrimaryInputFile call RegUnpack(Buf, OutData%UsePrimaryInputFile) if (RegCheckErr(Buf, RoutineName)) return - ! PassedPrimaryInputData call NWTC_Library_UnpackFileInfoType(Buf, OutData%PassedPrimaryInputData) ! PassedPrimaryInputData - ! Echo call RegUnpack(Buf, OutData%Echo) if (RegCheckErr(Buf, RoutineName)) return - ! OutList if (allocated(OutData%OutList)) deallocate(OutData%OutList) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -776,138 +722,102 @@ subroutine MD_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%OutList) if (RegCheckErr(Buf, RoutineName)) return end if - ! Linearize call RegUnpack(Buf, OutData%Linearize) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE MD_CopyLineProp( SrcLinePropData, DstLinePropData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_LineProp), INTENT(IN) :: SrcLinePropData - TYPE(MD_LineProp), INTENT(INOUT) :: DstLinePropData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyLineProp' -! - ErrStat = ErrID_None - ErrMsg = "" - DstLinePropData%IdNum = SrcLinePropData%IdNum - DstLinePropData%name = SrcLinePropData%name - DstLinePropData%d = SrcLinePropData%d - DstLinePropData%w = SrcLinePropData%w - DstLinePropData%EA = SrcLinePropData%EA - DstLinePropData%EA_D = SrcLinePropData%EA_D - DstLinePropData%BA = SrcLinePropData%BA - DstLinePropData%BA_D = SrcLinePropData%BA_D - DstLinePropData%EI = SrcLinePropData%EI - DstLinePropData%Can = SrcLinePropData%Can - DstLinePropData%Cat = SrcLinePropData%Cat - DstLinePropData%Cdn = SrcLinePropData%Cdn - DstLinePropData%Cdt = SrcLinePropData%Cdt - DstLinePropData%ElasticMod = SrcLinePropData%ElasticMod - DstLinePropData%nEApoints = SrcLinePropData%nEApoints - DstLinePropData%stiffXs = SrcLinePropData%stiffXs - DstLinePropData%stiffYs = SrcLinePropData%stiffYs - DstLinePropData%nBApoints = SrcLinePropData%nBApoints - DstLinePropData%dampXs = SrcLinePropData%dampXs - DstLinePropData%dampYs = SrcLinePropData%dampYs - DstLinePropData%nEIpoints = SrcLinePropData%nEIpoints - DstLinePropData%bstiffXs = SrcLinePropData%bstiffXs - DstLinePropData%bstiffYs = SrcLinePropData%bstiffYs - END SUBROUTINE MD_CopyLineProp - - SUBROUTINE MD_DestroyLineProp( LinePropData, ErrStat, ErrMsg ) - TYPE(MD_LineProp), INTENT(INOUT) :: LinePropData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyLineProp' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE MD_DestroyLineProp +subroutine MD_CopyLineProp(SrcLinePropData, DstLinePropData, CtrlCode, ErrStat, ErrMsg) + type(MD_LineProp), intent(in) :: SrcLinePropData + type(MD_LineProp), intent(inout) :: DstLinePropData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_CopyLineProp' + ErrStat = ErrID_None + ErrMsg = '' + DstLinePropData%IdNum = SrcLinePropData%IdNum + DstLinePropData%name = SrcLinePropData%name + DstLinePropData%d = SrcLinePropData%d + DstLinePropData%w = SrcLinePropData%w + DstLinePropData%EA = SrcLinePropData%EA + DstLinePropData%EA_D = SrcLinePropData%EA_D + DstLinePropData%BA = SrcLinePropData%BA + DstLinePropData%BA_D = SrcLinePropData%BA_D + DstLinePropData%EI = SrcLinePropData%EI + DstLinePropData%Can = SrcLinePropData%Can + DstLinePropData%Cat = SrcLinePropData%Cat + DstLinePropData%Cdn = SrcLinePropData%Cdn + DstLinePropData%Cdt = SrcLinePropData%Cdt + DstLinePropData%ElasticMod = SrcLinePropData%ElasticMod + DstLinePropData%nEApoints = SrcLinePropData%nEApoints + DstLinePropData%stiffXs = SrcLinePropData%stiffXs + DstLinePropData%stiffYs = SrcLinePropData%stiffYs + DstLinePropData%nBApoints = SrcLinePropData%nBApoints + DstLinePropData%dampXs = SrcLinePropData%dampXs + DstLinePropData%dampYs = SrcLinePropData%dampYs + DstLinePropData%nEIpoints = SrcLinePropData%nEIpoints + DstLinePropData%bstiffXs = SrcLinePropData%bstiffXs + DstLinePropData%bstiffYs = SrcLinePropData%bstiffYs +end subroutine +subroutine MD_DestroyLineProp(LinePropData, ErrStat, ErrMsg) + type(MD_LineProp), intent(inout) :: LinePropData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_DestroyLineProp' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine MD_PackLineProp(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(MD_LineProp), intent(in) :: InData character(*), parameter :: RoutineName = 'MD_PackLineProp' if (Buf%ErrStat >= AbortErrLev) return - ! IdNum call RegPack(Buf, InData%IdNum) if (RegCheckErr(Buf, RoutineName)) return - ! name call RegPack(Buf, InData%name) if (RegCheckErr(Buf, RoutineName)) return - ! d call RegPack(Buf, InData%d) if (RegCheckErr(Buf, RoutineName)) return - ! w call RegPack(Buf, InData%w) if (RegCheckErr(Buf, RoutineName)) return - ! EA call RegPack(Buf, InData%EA) if (RegCheckErr(Buf, RoutineName)) return - ! EA_D call RegPack(Buf, InData%EA_D) if (RegCheckErr(Buf, RoutineName)) return - ! BA call RegPack(Buf, InData%BA) if (RegCheckErr(Buf, RoutineName)) return - ! BA_D call RegPack(Buf, InData%BA_D) if (RegCheckErr(Buf, RoutineName)) return - ! EI call RegPack(Buf, InData%EI) if (RegCheckErr(Buf, RoutineName)) return - ! Can call RegPack(Buf, InData%Can) if (RegCheckErr(Buf, RoutineName)) return - ! Cat call RegPack(Buf, InData%Cat) if (RegCheckErr(Buf, RoutineName)) return - ! Cdn call RegPack(Buf, InData%Cdn) if (RegCheckErr(Buf, RoutineName)) return - ! Cdt call RegPack(Buf, InData%Cdt) if (RegCheckErr(Buf, RoutineName)) return - ! ElasticMod call RegPack(Buf, InData%ElasticMod) if (RegCheckErr(Buf, RoutineName)) return - ! nEApoints call RegPack(Buf, InData%nEApoints) if (RegCheckErr(Buf, RoutineName)) return - ! stiffXs call RegPack(Buf, InData%stiffXs) if (RegCheckErr(Buf, RoutineName)) return - ! stiffYs call RegPack(Buf, InData%stiffYs) if (RegCheckErr(Buf, RoutineName)) return - ! nBApoints call RegPack(Buf, InData%nBApoints) if (RegCheckErr(Buf, RoutineName)) return - ! dampXs call RegPack(Buf, InData%dampXs) if (RegCheckErr(Buf, RoutineName)) return - ! dampYs call RegPack(Buf, InData%dampYs) if (RegCheckErr(Buf, RoutineName)) return - ! nEIpoints call RegPack(Buf, InData%nEIpoints) if (RegCheckErr(Buf, RoutineName)) return - ! bstiffXs call RegPack(Buf, InData%bstiffXs) if (RegCheckErr(Buf, RoutineName)) return - ! bstiffYs call RegPack(Buf, InData%bstiffYs) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -917,151 +827,107 @@ subroutine MD_UnPackLineProp(Buf, OutData) type(MD_LineProp), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackLineProp' if (Buf%ErrStat /= ErrID_None) return - ! IdNum call RegUnpack(Buf, OutData%IdNum) if (RegCheckErr(Buf, RoutineName)) return - ! name call RegUnpack(Buf, OutData%name) if (RegCheckErr(Buf, RoutineName)) return - ! d call RegUnpack(Buf, OutData%d) if (RegCheckErr(Buf, RoutineName)) return - ! w call RegUnpack(Buf, OutData%w) if (RegCheckErr(Buf, RoutineName)) return - ! EA call RegUnpack(Buf, OutData%EA) if (RegCheckErr(Buf, RoutineName)) return - ! EA_D call RegUnpack(Buf, OutData%EA_D) if (RegCheckErr(Buf, RoutineName)) return - ! BA call RegUnpack(Buf, OutData%BA) if (RegCheckErr(Buf, RoutineName)) return - ! BA_D call RegUnpack(Buf, OutData%BA_D) if (RegCheckErr(Buf, RoutineName)) return - ! EI call RegUnpack(Buf, OutData%EI) if (RegCheckErr(Buf, RoutineName)) return - ! Can call RegUnpack(Buf, OutData%Can) if (RegCheckErr(Buf, RoutineName)) return - ! Cat call RegUnpack(Buf, OutData%Cat) if (RegCheckErr(Buf, RoutineName)) return - ! Cdn call RegUnpack(Buf, OutData%Cdn) if (RegCheckErr(Buf, RoutineName)) return - ! Cdt call RegUnpack(Buf, OutData%Cdt) if (RegCheckErr(Buf, RoutineName)) return - ! ElasticMod call RegUnpack(Buf, OutData%ElasticMod) if (RegCheckErr(Buf, RoutineName)) return - ! nEApoints call RegUnpack(Buf, OutData%nEApoints) if (RegCheckErr(Buf, RoutineName)) return - ! stiffXs call RegUnpack(Buf, OutData%stiffXs) if (RegCheckErr(Buf, RoutineName)) return - ! stiffYs call RegUnpack(Buf, OutData%stiffYs) if (RegCheckErr(Buf, RoutineName)) return - ! nBApoints call RegUnpack(Buf, OutData%nBApoints) if (RegCheckErr(Buf, RoutineName)) return - ! dampXs call RegUnpack(Buf, OutData%dampXs) if (RegCheckErr(Buf, RoutineName)) return - ! dampYs call RegUnpack(Buf, OutData%dampYs) if (RegCheckErr(Buf, RoutineName)) return - ! nEIpoints call RegUnpack(Buf, OutData%nEIpoints) if (RegCheckErr(Buf, RoutineName)) return - ! bstiffXs call RegUnpack(Buf, OutData%bstiffXs) if (RegCheckErr(Buf, RoutineName)) return - ! bstiffYs call RegUnpack(Buf, OutData%bstiffYs) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE MD_CopyRodProp( SrcRodPropData, DstRodPropData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_RodProp), INTENT(IN) :: SrcRodPropData - TYPE(MD_RodProp), INTENT(INOUT) :: DstRodPropData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyRodProp' -! - ErrStat = ErrID_None - ErrMsg = "" - DstRodPropData%IdNum = SrcRodPropData%IdNum - DstRodPropData%name = SrcRodPropData%name - DstRodPropData%d = SrcRodPropData%d - DstRodPropData%w = SrcRodPropData%w - DstRodPropData%Can = SrcRodPropData%Can - DstRodPropData%Cat = SrcRodPropData%Cat - DstRodPropData%Cdn = SrcRodPropData%Cdn - DstRodPropData%Cdt = SrcRodPropData%Cdt - DstRodPropData%CdEnd = SrcRodPropData%CdEnd - DstRodPropData%CaEnd = SrcRodPropData%CaEnd - END SUBROUTINE MD_CopyRodProp - - SUBROUTINE MD_DestroyRodProp( RodPropData, ErrStat, ErrMsg ) - TYPE(MD_RodProp), INTENT(INOUT) :: RodPropData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyRodProp' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE MD_DestroyRodProp +subroutine MD_CopyRodProp(SrcRodPropData, DstRodPropData, CtrlCode, ErrStat, ErrMsg) + type(MD_RodProp), intent(in) :: SrcRodPropData + type(MD_RodProp), intent(inout) :: DstRodPropData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_CopyRodProp' + ErrStat = ErrID_None + ErrMsg = '' + DstRodPropData%IdNum = SrcRodPropData%IdNum + DstRodPropData%name = SrcRodPropData%name + DstRodPropData%d = SrcRodPropData%d + DstRodPropData%w = SrcRodPropData%w + DstRodPropData%Can = SrcRodPropData%Can + DstRodPropData%Cat = SrcRodPropData%Cat + DstRodPropData%Cdn = SrcRodPropData%Cdn + DstRodPropData%Cdt = SrcRodPropData%Cdt + DstRodPropData%CdEnd = SrcRodPropData%CdEnd + DstRodPropData%CaEnd = SrcRodPropData%CaEnd +end subroutine +subroutine MD_DestroyRodProp(RodPropData, ErrStat, ErrMsg) + type(MD_RodProp), intent(inout) :: RodPropData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_DestroyRodProp' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine MD_PackRodProp(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(MD_RodProp), intent(in) :: InData character(*), parameter :: RoutineName = 'MD_PackRodProp' if (Buf%ErrStat >= AbortErrLev) return - ! IdNum call RegPack(Buf, InData%IdNum) if (RegCheckErr(Buf, RoutineName)) return - ! name call RegPack(Buf, InData%name) if (RegCheckErr(Buf, RoutineName)) return - ! d call RegPack(Buf, InData%d) if (RegCheckErr(Buf, RoutineName)) return - ! w call RegPack(Buf, InData%w) if (RegCheckErr(Buf, RoutineName)) return - ! Can call RegPack(Buf, InData%Can) if (RegCheckErr(Buf, RoutineName)) return - ! Cat call RegPack(Buf, InData%Cat) if (RegCheckErr(Buf, RoutineName)) return - ! Cdn call RegPack(Buf, InData%Cdn) if (RegCheckErr(Buf, RoutineName)) return - ! Cdt call RegPack(Buf, InData%Cdt) if (RegCheckErr(Buf, RoutineName)) return - ! CdEnd call RegPack(Buf, InData%CdEnd) if (RegCheckErr(Buf, RoutineName)) return - ! CaEnd call RegPack(Buf, InData%CaEnd) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1071,178 +937,129 @@ subroutine MD_UnPackRodProp(Buf, OutData) type(MD_RodProp), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackRodProp' if (Buf%ErrStat /= ErrID_None) return - ! IdNum call RegUnpack(Buf, OutData%IdNum) if (RegCheckErr(Buf, RoutineName)) return - ! name call RegUnpack(Buf, OutData%name) if (RegCheckErr(Buf, RoutineName)) return - ! d call RegUnpack(Buf, OutData%d) if (RegCheckErr(Buf, RoutineName)) return - ! w call RegUnpack(Buf, OutData%w) if (RegCheckErr(Buf, RoutineName)) return - ! Can call RegUnpack(Buf, OutData%Can) if (RegCheckErr(Buf, RoutineName)) return - ! Cat call RegUnpack(Buf, OutData%Cat) if (RegCheckErr(Buf, RoutineName)) return - ! Cdn call RegUnpack(Buf, OutData%Cdn) if (RegCheckErr(Buf, RoutineName)) return - ! Cdt call RegUnpack(Buf, OutData%Cdt) if (RegCheckErr(Buf, RoutineName)) return - ! CdEnd call RegUnpack(Buf, OutData%CdEnd) if (RegCheckErr(Buf, RoutineName)) return - ! CaEnd call RegUnpack(Buf, OutData%CaEnd) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE MD_CopyBody( SrcBodyData, DstBodyData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_Body), INTENT(IN) :: SrcBodyData - TYPE(MD_Body), INTENT(INOUT) :: DstBodyData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyBody' -! - ErrStat = ErrID_None - ErrMsg = "" - DstBodyData%IdNum = SrcBodyData%IdNum - DstBodyData%typeNum = SrcBodyData%typeNum - DstBodyData%AttachedC = SrcBodyData%AttachedC - DstBodyData%AttachedR = SrcBodyData%AttachedR - DstBodyData%nAttachedC = SrcBodyData%nAttachedC - DstBodyData%nAttachedR = SrcBodyData%nAttachedR - DstBodyData%rConnectRel = SrcBodyData%rConnectRel - DstBodyData%r6RodRel = SrcBodyData%r6RodRel - DstBodyData%bodyM = SrcBodyData%bodyM - DstBodyData%bodyV = SrcBodyData%bodyV - DstBodyData%bodyI = SrcBodyData%bodyI - DstBodyData%bodyCdA = SrcBodyData%bodyCdA - DstBodyData%bodyCa = SrcBodyData%bodyCa - DstBodyData%time = SrcBodyData%time - DstBodyData%r6 = SrcBodyData%r6 - DstBodyData%v6 = SrcBodyData%v6 - DstBodyData%a6 = SrcBodyData%a6 - DstBodyData%U = SrcBodyData%U - DstBodyData%Ud = SrcBodyData%Ud - DstBodyData%zeta = SrcBodyData%zeta - DstBodyData%F6net = SrcBodyData%F6net - DstBodyData%M6net = SrcBodyData%M6net - DstBodyData%M = SrcBodyData%M - DstBodyData%M0 = SrcBodyData%M0 - DstBodyData%OrMat = SrcBodyData%OrMat - DstBodyData%rCG = SrcBodyData%rCG - END SUBROUTINE MD_CopyBody - - SUBROUTINE MD_DestroyBody( BodyData, ErrStat, ErrMsg ) - TYPE(MD_Body), INTENT(INOUT) :: BodyData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyBody' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE MD_DestroyBody +subroutine MD_CopyBody(SrcBodyData, DstBodyData, CtrlCode, ErrStat, ErrMsg) + type(MD_Body), intent(in) :: SrcBodyData + type(MD_Body), intent(inout) :: DstBodyData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_CopyBody' + ErrStat = ErrID_None + ErrMsg = '' + DstBodyData%IdNum = SrcBodyData%IdNum + DstBodyData%typeNum = SrcBodyData%typeNum + DstBodyData%AttachedC = SrcBodyData%AttachedC + DstBodyData%AttachedR = SrcBodyData%AttachedR + DstBodyData%nAttachedC = SrcBodyData%nAttachedC + DstBodyData%nAttachedR = SrcBodyData%nAttachedR + DstBodyData%rConnectRel = SrcBodyData%rConnectRel + DstBodyData%r6RodRel = SrcBodyData%r6RodRel + DstBodyData%bodyM = SrcBodyData%bodyM + DstBodyData%bodyV = SrcBodyData%bodyV + DstBodyData%bodyI = SrcBodyData%bodyI + DstBodyData%bodyCdA = SrcBodyData%bodyCdA + DstBodyData%bodyCa = SrcBodyData%bodyCa + DstBodyData%time = SrcBodyData%time + DstBodyData%r6 = SrcBodyData%r6 + DstBodyData%v6 = SrcBodyData%v6 + DstBodyData%a6 = SrcBodyData%a6 + DstBodyData%U = SrcBodyData%U + DstBodyData%Ud = SrcBodyData%Ud + DstBodyData%zeta = SrcBodyData%zeta + DstBodyData%F6net = SrcBodyData%F6net + DstBodyData%M6net = SrcBodyData%M6net + DstBodyData%M = SrcBodyData%M + DstBodyData%M0 = SrcBodyData%M0 + DstBodyData%OrMat = SrcBodyData%OrMat + DstBodyData%rCG = SrcBodyData%rCG +end subroutine +subroutine MD_DestroyBody(BodyData, ErrStat, ErrMsg) + type(MD_Body), intent(inout) :: BodyData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_DestroyBody' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine MD_PackBody(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(MD_Body), intent(in) :: InData character(*), parameter :: RoutineName = 'MD_PackBody' if (Buf%ErrStat >= AbortErrLev) return - ! IdNum call RegPack(Buf, InData%IdNum) if (RegCheckErr(Buf, RoutineName)) return - ! typeNum call RegPack(Buf, InData%typeNum) if (RegCheckErr(Buf, RoutineName)) return - ! AttachedC call RegPack(Buf, InData%AttachedC) if (RegCheckErr(Buf, RoutineName)) return - ! AttachedR call RegPack(Buf, InData%AttachedR) if (RegCheckErr(Buf, RoutineName)) return - ! nAttachedC call RegPack(Buf, InData%nAttachedC) if (RegCheckErr(Buf, RoutineName)) return - ! nAttachedR call RegPack(Buf, InData%nAttachedR) if (RegCheckErr(Buf, RoutineName)) return - ! rConnectRel call RegPack(Buf, InData%rConnectRel) if (RegCheckErr(Buf, RoutineName)) return - ! r6RodRel call RegPack(Buf, InData%r6RodRel) if (RegCheckErr(Buf, RoutineName)) return - ! bodyM call RegPack(Buf, InData%bodyM) if (RegCheckErr(Buf, RoutineName)) return - ! bodyV call RegPack(Buf, InData%bodyV) if (RegCheckErr(Buf, RoutineName)) return - ! bodyI call RegPack(Buf, InData%bodyI) if (RegCheckErr(Buf, RoutineName)) return - ! bodyCdA call RegPack(Buf, InData%bodyCdA) if (RegCheckErr(Buf, RoutineName)) return - ! bodyCa call RegPack(Buf, InData%bodyCa) if (RegCheckErr(Buf, RoutineName)) return - ! time call RegPack(Buf, InData%time) if (RegCheckErr(Buf, RoutineName)) return - ! r6 call RegPack(Buf, InData%r6) if (RegCheckErr(Buf, RoutineName)) return - ! v6 call RegPack(Buf, InData%v6) if (RegCheckErr(Buf, RoutineName)) return - ! a6 call RegPack(Buf, InData%a6) if (RegCheckErr(Buf, RoutineName)) return - ! U call RegPack(Buf, InData%U) if (RegCheckErr(Buf, RoutineName)) return - ! Ud call RegPack(Buf, InData%Ud) if (RegCheckErr(Buf, RoutineName)) return - ! zeta call RegPack(Buf, InData%zeta) if (RegCheckErr(Buf, RoutineName)) return - ! F6net call RegPack(Buf, InData%F6net) if (RegCheckErr(Buf, RoutineName)) return - ! M6net call RegPack(Buf, InData%M6net) if (RegCheckErr(Buf, RoutineName)) return - ! M call RegPack(Buf, InData%M) if (RegCheckErr(Buf, RoutineName)) return - ! M0 call RegPack(Buf, InData%M0) if (RegCheckErr(Buf, RoutineName)) return - ! OrMat call RegPack(Buf, InData%OrMat) if (RegCheckErr(Buf, RoutineName)) return - ! rCG call RegPack(Buf, InData%rCG) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1252,232 +1069,174 @@ subroutine MD_UnPackBody(Buf, OutData) type(MD_Body), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackBody' if (Buf%ErrStat /= ErrID_None) return - ! IdNum call RegUnpack(Buf, OutData%IdNum) if (RegCheckErr(Buf, RoutineName)) return - ! typeNum call RegUnpack(Buf, OutData%typeNum) if (RegCheckErr(Buf, RoutineName)) return - ! AttachedC call RegUnpack(Buf, OutData%AttachedC) if (RegCheckErr(Buf, RoutineName)) return - ! AttachedR call RegUnpack(Buf, OutData%AttachedR) if (RegCheckErr(Buf, RoutineName)) return - ! nAttachedC call RegUnpack(Buf, OutData%nAttachedC) if (RegCheckErr(Buf, RoutineName)) return - ! nAttachedR call RegUnpack(Buf, OutData%nAttachedR) if (RegCheckErr(Buf, RoutineName)) return - ! rConnectRel call RegUnpack(Buf, OutData%rConnectRel) if (RegCheckErr(Buf, RoutineName)) return - ! r6RodRel call RegUnpack(Buf, OutData%r6RodRel) if (RegCheckErr(Buf, RoutineName)) return - ! bodyM call RegUnpack(Buf, OutData%bodyM) if (RegCheckErr(Buf, RoutineName)) return - ! bodyV call RegUnpack(Buf, OutData%bodyV) if (RegCheckErr(Buf, RoutineName)) return - ! bodyI call RegUnpack(Buf, OutData%bodyI) if (RegCheckErr(Buf, RoutineName)) return - ! bodyCdA call RegUnpack(Buf, OutData%bodyCdA) if (RegCheckErr(Buf, RoutineName)) return - ! bodyCa call RegUnpack(Buf, OutData%bodyCa) if (RegCheckErr(Buf, RoutineName)) return - ! time call RegUnpack(Buf, OutData%time) if (RegCheckErr(Buf, RoutineName)) return - ! r6 call RegUnpack(Buf, OutData%r6) if (RegCheckErr(Buf, RoutineName)) return - ! v6 call RegUnpack(Buf, OutData%v6) if (RegCheckErr(Buf, RoutineName)) return - ! a6 call RegUnpack(Buf, OutData%a6) if (RegCheckErr(Buf, RoutineName)) return - ! U call RegUnpack(Buf, OutData%U) if (RegCheckErr(Buf, RoutineName)) return - ! Ud call RegUnpack(Buf, OutData%Ud) if (RegCheckErr(Buf, RoutineName)) return - ! zeta call RegUnpack(Buf, OutData%zeta) if (RegCheckErr(Buf, RoutineName)) return - ! F6net call RegUnpack(Buf, OutData%F6net) if (RegCheckErr(Buf, RoutineName)) return - ! M6net call RegUnpack(Buf, OutData%M6net) if (RegCheckErr(Buf, RoutineName)) return - ! M call RegUnpack(Buf, OutData%M) if (RegCheckErr(Buf, RoutineName)) return - ! M0 call RegUnpack(Buf, OutData%M0) if (RegCheckErr(Buf, RoutineName)) return - ! OrMat call RegUnpack(Buf, OutData%OrMat) if (RegCheckErr(Buf, RoutineName)) return - ! rCG call RegUnpack(Buf, OutData%rCG) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE MD_CopyConnect( SrcConnectData, DstConnectData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_Connect), INTENT(IN) :: SrcConnectData - TYPE(MD_Connect), INTENT(INOUT) :: DstConnectData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyConnect' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConnectData%IdNum = SrcConnectData%IdNum - DstConnectData%type = SrcConnectData%type - DstConnectData%typeNum = SrcConnectData%typeNum - DstConnectData%Attached = SrcConnectData%Attached - DstConnectData%Top = SrcConnectData%Top - DstConnectData%nAttached = SrcConnectData%nAttached - DstConnectData%conM = SrcConnectData%conM - DstConnectData%conV = SrcConnectData%conV - DstConnectData%conFX = SrcConnectData%conFX - DstConnectData%conFY = SrcConnectData%conFY - DstConnectData%conFZ = SrcConnectData%conFZ - DstConnectData%conCa = SrcConnectData%conCa - DstConnectData%conCdA = SrcConnectData%conCdA - DstConnectData%time = SrcConnectData%time - DstConnectData%r = SrcConnectData%r - DstConnectData%rd = SrcConnectData%rd - DstConnectData%a = SrcConnectData%a - DstConnectData%U = SrcConnectData%U - DstConnectData%Ud = SrcConnectData%Ud - DstConnectData%zeta = SrcConnectData%zeta -IF (ALLOCATED(SrcConnectData%PDyn)) THEN - i1_l = LBOUND(SrcConnectData%PDyn,1) - i1_u = UBOUND(SrcConnectData%PDyn,1) - IF (.NOT. ALLOCATED(DstConnectData%PDyn)) THEN - ALLOCATE(DstConnectData%PDyn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConnectData%PDyn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstConnectData%PDyn = SrcConnectData%PDyn -ENDIF - DstConnectData%Fnet = SrcConnectData%Fnet - DstConnectData%M = SrcConnectData%M - END SUBROUTINE MD_CopyConnect - - SUBROUTINE MD_DestroyConnect( ConnectData, ErrStat, ErrMsg ) - TYPE(MD_Connect), INTENT(INOUT) :: ConnectData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyConnect' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(ConnectData%PDyn)) THEN - DEALLOCATE(ConnectData%PDyn) -ENDIF - END SUBROUTINE MD_DestroyConnect +subroutine MD_CopyConnect(SrcConnectData, DstConnectData, CtrlCode, ErrStat, ErrMsg) + type(MD_Connect), intent(in) :: SrcConnectData + type(MD_Connect), intent(inout) :: DstConnectData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'MD_CopyConnect' + ErrStat = ErrID_None + ErrMsg = '' + DstConnectData%IdNum = SrcConnectData%IdNum + DstConnectData%type = SrcConnectData%type + DstConnectData%typeNum = SrcConnectData%typeNum + DstConnectData%Attached = SrcConnectData%Attached + DstConnectData%Top = SrcConnectData%Top + DstConnectData%nAttached = SrcConnectData%nAttached + DstConnectData%conM = SrcConnectData%conM + DstConnectData%conV = SrcConnectData%conV + DstConnectData%conFX = SrcConnectData%conFX + DstConnectData%conFY = SrcConnectData%conFY + DstConnectData%conFZ = SrcConnectData%conFZ + DstConnectData%conCa = SrcConnectData%conCa + DstConnectData%conCdA = SrcConnectData%conCdA + DstConnectData%time = SrcConnectData%time + DstConnectData%r = SrcConnectData%r + DstConnectData%rd = SrcConnectData%rd + DstConnectData%a = SrcConnectData%a + DstConnectData%U = SrcConnectData%U + DstConnectData%Ud = SrcConnectData%Ud + DstConnectData%zeta = SrcConnectData%zeta + if (allocated(SrcConnectData%PDyn)) then + LB(1:1) = lbound(SrcConnectData%PDyn) + UB(1:1) = ubound(SrcConnectData%PDyn) + if (.not. allocated(DstConnectData%PDyn)) then + allocate(DstConnectData%PDyn(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstConnectData%PDyn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstConnectData%PDyn = SrcConnectData%PDyn + else if (allocated(DstConnectData%PDyn)) then + deallocate(DstConnectData%PDyn) + end if + DstConnectData%Fnet = SrcConnectData%Fnet + DstConnectData%M = SrcConnectData%M +end subroutine +subroutine MD_DestroyConnect(ConnectData, ErrStat, ErrMsg) + type(MD_Connect), intent(inout) :: ConnectData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_DestroyConnect' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ConnectData%PDyn)) then + deallocate(ConnectData%PDyn) + end if +end subroutine subroutine MD_PackConnect(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(MD_Connect), intent(in) :: InData character(*), parameter :: RoutineName = 'MD_PackConnect' if (Buf%ErrStat >= AbortErrLev) return - ! IdNum call RegPack(Buf, InData%IdNum) if (RegCheckErr(Buf, RoutineName)) return - ! type call RegPack(Buf, InData%type) if (RegCheckErr(Buf, RoutineName)) return - ! typeNum call RegPack(Buf, InData%typeNum) if (RegCheckErr(Buf, RoutineName)) return - ! Attached call RegPack(Buf, InData%Attached) if (RegCheckErr(Buf, RoutineName)) return - ! Top call RegPack(Buf, InData%Top) if (RegCheckErr(Buf, RoutineName)) return - ! nAttached call RegPack(Buf, InData%nAttached) if (RegCheckErr(Buf, RoutineName)) return - ! conM call RegPack(Buf, InData%conM) if (RegCheckErr(Buf, RoutineName)) return - ! conV call RegPack(Buf, InData%conV) if (RegCheckErr(Buf, RoutineName)) return - ! conFX call RegPack(Buf, InData%conFX) if (RegCheckErr(Buf, RoutineName)) return - ! conFY call RegPack(Buf, InData%conFY) if (RegCheckErr(Buf, RoutineName)) return - ! conFZ call RegPack(Buf, InData%conFZ) if (RegCheckErr(Buf, RoutineName)) return - ! conCa call RegPack(Buf, InData%conCa) if (RegCheckErr(Buf, RoutineName)) return - ! conCdA call RegPack(Buf, InData%conCdA) if (RegCheckErr(Buf, RoutineName)) return - ! time call RegPack(Buf, InData%time) if (RegCheckErr(Buf, RoutineName)) return - ! r call RegPack(Buf, InData%r) if (RegCheckErr(Buf, RoutineName)) return - ! rd call RegPack(Buf, InData%rd) if (RegCheckErr(Buf, RoutineName)) return - ! a call RegPack(Buf, InData%a) if (RegCheckErr(Buf, RoutineName)) return - ! U call RegPack(Buf, InData%U) if (RegCheckErr(Buf, RoutineName)) return - ! Ud call RegPack(Buf, InData%Ud) if (RegCheckErr(Buf, RoutineName)) return - ! zeta call RegPack(Buf, InData%zeta) if (RegCheckErr(Buf, RoutineName)) return - ! PDyn call RegPack(Buf, allocated(InData%PDyn)) if (allocated(InData%PDyn)) then call RegPackBounds(Buf, 1, lbound(InData%PDyn), ubound(InData%PDyn)) call RegPack(Buf, InData%PDyn) end if if (RegCheckErr(Buf, RoutineName)) return - ! Fnet call RegPack(Buf, InData%Fnet) if (RegCheckErr(Buf, RoutineName)) return - ! M call RegPack(Buf, InData%M) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1490,67 +1249,46 @@ subroutine MD_UnPackConnect(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! IdNum call RegUnpack(Buf, OutData%IdNum) if (RegCheckErr(Buf, RoutineName)) return - ! type call RegUnpack(Buf, OutData%type) if (RegCheckErr(Buf, RoutineName)) return - ! typeNum call RegUnpack(Buf, OutData%typeNum) if (RegCheckErr(Buf, RoutineName)) return - ! Attached call RegUnpack(Buf, OutData%Attached) if (RegCheckErr(Buf, RoutineName)) return - ! Top call RegUnpack(Buf, OutData%Top) if (RegCheckErr(Buf, RoutineName)) return - ! nAttached call RegUnpack(Buf, OutData%nAttached) if (RegCheckErr(Buf, RoutineName)) return - ! conM call RegUnpack(Buf, OutData%conM) if (RegCheckErr(Buf, RoutineName)) return - ! conV call RegUnpack(Buf, OutData%conV) if (RegCheckErr(Buf, RoutineName)) return - ! conFX call RegUnpack(Buf, OutData%conFX) if (RegCheckErr(Buf, RoutineName)) return - ! conFY call RegUnpack(Buf, OutData%conFY) if (RegCheckErr(Buf, RoutineName)) return - ! conFZ call RegUnpack(Buf, OutData%conFZ) if (RegCheckErr(Buf, RoutineName)) return - ! conCa call RegUnpack(Buf, OutData%conCa) if (RegCheckErr(Buf, RoutineName)) return - ! conCdA call RegUnpack(Buf, OutData%conCdA) if (RegCheckErr(Buf, RoutineName)) return - ! time call RegUnpack(Buf, OutData%time) if (RegCheckErr(Buf, RoutineName)) return - ! r call RegUnpack(Buf, OutData%r) if (RegCheckErr(Buf, RoutineName)) return - ! rd call RegUnpack(Buf, OutData%rd) if (RegCheckErr(Buf, RoutineName)) return - ! a call RegUnpack(Buf, OutData%a) if (RegCheckErr(Buf, RoutineName)) return - ! U call RegUnpack(Buf, OutData%U) if (RegCheckErr(Buf, RoutineName)) return - ! Ud call RegUnpack(Buf, OutData%Ud) if (RegCheckErr(Buf, RoutineName)) return - ! zeta call RegUnpack(Buf, OutData%zeta) if (RegCheckErr(Buf, RoutineName)) return - ! PDyn if (allocated(OutData%PDyn)) deallocate(OutData%PDyn) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1565,651 +1303,587 @@ subroutine MD_UnPackConnect(Buf, OutData) call RegUnpack(Buf, OutData%PDyn) if (RegCheckErr(Buf, RoutineName)) return end if - ! Fnet call RegUnpack(Buf, OutData%Fnet) if (RegCheckErr(Buf, RoutineName)) return - ! M call RegUnpack(Buf, OutData%M) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE MD_CopyRod( SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_Rod), INTENT(IN) :: SrcRodData - TYPE(MD_Rod), INTENT(INOUT) :: DstRodData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyRod' -! - ErrStat = ErrID_None - ErrMsg = "" - DstRodData%IdNum = SrcRodData%IdNum - DstRodData%type = SrcRodData%type - DstRodData%PropsIdNum = SrcRodData%PropsIdNum - DstRodData%typeNum = SrcRodData%typeNum - DstRodData%AttachedA = SrcRodData%AttachedA - DstRodData%AttachedB = SrcRodData%AttachedB - DstRodData%TopA = SrcRodData%TopA - DstRodData%TopB = SrcRodData%TopB - DstRodData%nAttachedA = SrcRodData%nAttachedA - DstRodData%nAttachedB = SrcRodData%nAttachedB - DstRodData%OutFlagList = SrcRodData%OutFlagList - DstRodData%N = SrcRodData%N - DstRodData%endTypeA = SrcRodData%endTypeA - DstRodData%endTypeB = SrcRodData%endTypeB - DstRodData%UnstrLen = SrcRodData%UnstrLen - DstRodData%mass = SrcRodData%mass - DstRodData%rho = SrcRodData%rho - DstRodData%d = SrcRodData%d - DstRodData%Can = SrcRodData%Can - DstRodData%Cat = SrcRodData%Cat - DstRodData%Cdn = SrcRodData%Cdn - DstRodData%Cdt = SrcRodData%Cdt - DstRodData%CdEnd = SrcRodData%CdEnd - DstRodData%CaEnd = SrcRodData%CaEnd - DstRodData%time = SrcRodData%time - DstRodData%roll = SrcRodData%roll - DstRodData%pitch = SrcRodData%pitch - DstRodData%h0 = SrcRodData%h0 -IF (ALLOCATED(SrcRodData%r)) THEN - i1_l = LBOUND(SrcRodData%r,1) - i1_u = UBOUND(SrcRodData%r,1) - i2_l = LBOUND(SrcRodData%r,2) - i2_u = UBOUND(SrcRodData%r,2) - IF (.NOT. ALLOCATED(DstRodData%r)) THEN - ALLOCATE(DstRodData%r(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%r.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%r = SrcRodData%r -ENDIF -IF (ALLOCATED(SrcRodData%rd)) THEN - i1_l = LBOUND(SrcRodData%rd,1) - i1_u = UBOUND(SrcRodData%rd,1) - i2_l = LBOUND(SrcRodData%rd,2) - i2_u = UBOUND(SrcRodData%rd,2) - IF (.NOT. ALLOCATED(DstRodData%rd)) THEN - ALLOCATE(DstRodData%rd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%rd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%rd = SrcRodData%rd -ENDIF - DstRodData%q = SrcRodData%q -IF (ALLOCATED(SrcRodData%l)) THEN - i1_l = LBOUND(SrcRodData%l,1) - i1_u = UBOUND(SrcRodData%l,1) - IF (.NOT. ALLOCATED(DstRodData%l)) THEN - ALLOCATE(DstRodData%l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%l = SrcRodData%l -ENDIF -IF (ALLOCATED(SrcRodData%V)) THEN - i1_l = LBOUND(SrcRodData%V,1) - i1_u = UBOUND(SrcRodData%V,1) - IF (.NOT. ALLOCATED(DstRodData%V)) THEN - ALLOCATE(DstRodData%V(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%V.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%V = SrcRodData%V -ENDIF -IF (ALLOCATED(SrcRodData%U)) THEN - i1_l = LBOUND(SrcRodData%U,1) - i1_u = UBOUND(SrcRodData%U,1) - i2_l = LBOUND(SrcRodData%U,2) - i2_u = UBOUND(SrcRodData%U,2) - IF (.NOT. ALLOCATED(DstRodData%U)) THEN - ALLOCATE(DstRodData%U(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%U.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%U = SrcRodData%U -ENDIF -IF (ALLOCATED(SrcRodData%Ud)) THEN - i1_l = LBOUND(SrcRodData%Ud,1) - i1_u = UBOUND(SrcRodData%Ud,1) - i2_l = LBOUND(SrcRodData%Ud,2) - i2_u = UBOUND(SrcRodData%Ud,2) - IF (.NOT. ALLOCATED(DstRodData%Ud)) THEN - ALLOCATE(DstRodData%Ud(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Ud.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%Ud = SrcRodData%Ud -ENDIF -IF (ALLOCATED(SrcRodData%zeta)) THEN - i1_l = LBOUND(SrcRodData%zeta,1) - i1_u = UBOUND(SrcRodData%zeta,1) - IF (.NOT. ALLOCATED(DstRodData%zeta)) THEN - ALLOCATE(DstRodData%zeta(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%zeta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%zeta = SrcRodData%zeta -ENDIF -IF (ALLOCATED(SrcRodData%PDyn)) THEN - i1_l = LBOUND(SrcRodData%PDyn,1) - i1_u = UBOUND(SrcRodData%PDyn,1) - IF (.NOT. ALLOCATED(DstRodData%PDyn)) THEN - ALLOCATE(DstRodData%PDyn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%PDyn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%PDyn = SrcRodData%PDyn -ENDIF -IF (ALLOCATED(SrcRodData%W)) THEN - i1_l = LBOUND(SrcRodData%W,1) - i1_u = UBOUND(SrcRodData%W,1) - i2_l = LBOUND(SrcRodData%W,2) - i2_u = UBOUND(SrcRodData%W,2) - IF (.NOT. ALLOCATED(DstRodData%W)) THEN - ALLOCATE(DstRodData%W(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%W.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%W = SrcRodData%W -ENDIF -IF (ALLOCATED(SrcRodData%Bo)) THEN - i1_l = LBOUND(SrcRodData%Bo,1) - i1_u = UBOUND(SrcRodData%Bo,1) - i2_l = LBOUND(SrcRodData%Bo,2) - i2_u = UBOUND(SrcRodData%Bo,2) - IF (.NOT. ALLOCATED(DstRodData%Bo)) THEN - ALLOCATE(DstRodData%Bo(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Bo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%Bo = SrcRodData%Bo -ENDIF -IF (ALLOCATED(SrcRodData%Pd)) THEN - i1_l = LBOUND(SrcRodData%Pd,1) - i1_u = UBOUND(SrcRodData%Pd,1) - i2_l = LBOUND(SrcRodData%Pd,2) - i2_u = UBOUND(SrcRodData%Pd,2) - IF (.NOT. ALLOCATED(DstRodData%Pd)) THEN - ALLOCATE(DstRodData%Pd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Pd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%Pd = SrcRodData%Pd -ENDIF -IF (ALLOCATED(SrcRodData%Dp)) THEN - i1_l = LBOUND(SrcRodData%Dp,1) - i1_u = UBOUND(SrcRodData%Dp,1) - i2_l = LBOUND(SrcRodData%Dp,2) - i2_u = UBOUND(SrcRodData%Dp,2) - IF (.NOT. ALLOCATED(DstRodData%Dp)) THEN - ALLOCATE(DstRodData%Dp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Dp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%Dp = SrcRodData%Dp -ENDIF -IF (ALLOCATED(SrcRodData%Dq)) THEN - i1_l = LBOUND(SrcRodData%Dq,1) - i1_u = UBOUND(SrcRodData%Dq,1) - i2_l = LBOUND(SrcRodData%Dq,2) - i2_u = UBOUND(SrcRodData%Dq,2) - IF (.NOT. ALLOCATED(DstRodData%Dq)) THEN - ALLOCATE(DstRodData%Dq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Dq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%Dq = SrcRodData%Dq -ENDIF -IF (ALLOCATED(SrcRodData%Ap)) THEN - i1_l = LBOUND(SrcRodData%Ap,1) - i1_u = UBOUND(SrcRodData%Ap,1) - i2_l = LBOUND(SrcRodData%Ap,2) - i2_u = UBOUND(SrcRodData%Ap,2) - IF (.NOT. ALLOCATED(DstRodData%Ap)) THEN - ALLOCATE(DstRodData%Ap(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Ap.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%Ap = SrcRodData%Ap -ENDIF -IF (ALLOCATED(SrcRodData%Aq)) THEN - i1_l = LBOUND(SrcRodData%Aq,1) - i1_u = UBOUND(SrcRodData%Aq,1) - i2_l = LBOUND(SrcRodData%Aq,2) - i2_u = UBOUND(SrcRodData%Aq,2) - IF (.NOT. ALLOCATED(DstRodData%Aq)) THEN - ALLOCATE(DstRodData%Aq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Aq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%Aq = SrcRodData%Aq -ENDIF -IF (ALLOCATED(SrcRodData%B)) THEN - i1_l = LBOUND(SrcRodData%B,1) - i1_u = UBOUND(SrcRodData%B,1) - i2_l = LBOUND(SrcRodData%B,2) - i2_u = UBOUND(SrcRodData%B,2) - IF (.NOT. ALLOCATED(DstRodData%B)) THEN - ALLOCATE(DstRodData%B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%B = SrcRodData%B -ENDIF -IF (ALLOCATED(SrcRodData%Fnet)) THEN - i1_l = LBOUND(SrcRodData%Fnet,1) - i1_u = UBOUND(SrcRodData%Fnet,1) - i2_l = LBOUND(SrcRodData%Fnet,2) - i2_u = UBOUND(SrcRodData%Fnet,2) - IF (.NOT. ALLOCATED(DstRodData%Fnet)) THEN - ALLOCATE(DstRodData%Fnet(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Fnet.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%Fnet = SrcRodData%Fnet -ENDIF -IF (ALLOCATED(SrcRodData%M)) THEN - i1_l = LBOUND(SrcRodData%M,1) - i1_u = UBOUND(SrcRodData%M,1) - i2_l = LBOUND(SrcRodData%M,2) - i2_u = UBOUND(SrcRodData%M,2) - i3_l = LBOUND(SrcRodData%M,3) - i3_u = UBOUND(SrcRodData%M,3) - IF (.NOT. ALLOCATED(DstRodData%M)) THEN - ALLOCATE(DstRodData%M(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%M.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%M = SrcRodData%M -ENDIF - DstRodData%FextA = SrcRodData%FextA - DstRodData%FextB = SrcRodData%FextB - DstRodData%Mext = SrcRodData%Mext - DstRodData%r6 = SrcRodData%r6 - DstRodData%v6 = SrcRodData%v6 - DstRodData%a6 = SrcRodData%a6 - DstRodData%F6net = SrcRodData%F6net - DstRodData%M6net = SrcRodData%M6net - DstRodData%OrMat = SrcRodData%OrMat - DstRodData%RodUnOut = SrcRodData%RodUnOut -IF (ALLOCATED(SrcRodData%RodWrOutput)) THEN - i1_l = LBOUND(SrcRodData%RodWrOutput,1) - i1_u = UBOUND(SrcRodData%RodWrOutput,1) - IF (.NOT. ALLOCATED(DstRodData%RodWrOutput)) THEN - ALLOCATE(DstRodData%RodWrOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%RodWrOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstRodData%RodWrOutput = SrcRodData%RodWrOutput -ENDIF - END SUBROUTINE MD_CopyRod - - SUBROUTINE MD_DestroyRod( RodData, ErrStat, ErrMsg ) - TYPE(MD_Rod), INTENT(INOUT) :: RodData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyRod' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(RodData%r)) THEN - DEALLOCATE(RodData%r) -ENDIF -IF (ALLOCATED(RodData%rd)) THEN - DEALLOCATE(RodData%rd) -ENDIF -IF (ALLOCATED(RodData%l)) THEN - DEALLOCATE(RodData%l) -ENDIF -IF (ALLOCATED(RodData%V)) THEN - DEALLOCATE(RodData%V) -ENDIF -IF (ALLOCATED(RodData%U)) THEN - DEALLOCATE(RodData%U) -ENDIF -IF (ALLOCATED(RodData%Ud)) THEN - DEALLOCATE(RodData%Ud) -ENDIF -IF (ALLOCATED(RodData%zeta)) THEN - DEALLOCATE(RodData%zeta) -ENDIF -IF (ALLOCATED(RodData%PDyn)) THEN - DEALLOCATE(RodData%PDyn) -ENDIF -IF (ALLOCATED(RodData%W)) THEN - DEALLOCATE(RodData%W) -ENDIF -IF (ALLOCATED(RodData%Bo)) THEN - DEALLOCATE(RodData%Bo) -ENDIF -IF (ALLOCATED(RodData%Pd)) THEN - DEALLOCATE(RodData%Pd) -ENDIF -IF (ALLOCATED(RodData%Dp)) THEN - DEALLOCATE(RodData%Dp) -ENDIF -IF (ALLOCATED(RodData%Dq)) THEN - DEALLOCATE(RodData%Dq) -ENDIF -IF (ALLOCATED(RodData%Ap)) THEN - DEALLOCATE(RodData%Ap) -ENDIF -IF (ALLOCATED(RodData%Aq)) THEN - DEALLOCATE(RodData%Aq) -ENDIF -IF (ALLOCATED(RodData%B)) THEN - DEALLOCATE(RodData%B) -ENDIF -IF (ALLOCATED(RodData%Fnet)) THEN - DEALLOCATE(RodData%Fnet) -ENDIF -IF (ALLOCATED(RodData%M)) THEN - DEALLOCATE(RodData%M) -ENDIF -IF (ALLOCATED(RodData%RodWrOutput)) THEN - DEALLOCATE(RodData%RodWrOutput) -ENDIF - END SUBROUTINE MD_DestroyRod +subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) + type(MD_Rod), intent(in) :: SrcRodData + type(MD_Rod), intent(inout) :: DstRodData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'MD_CopyRod' + ErrStat = ErrID_None + ErrMsg = '' + DstRodData%IdNum = SrcRodData%IdNum + DstRodData%type = SrcRodData%type + DstRodData%PropsIdNum = SrcRodData%PropsIdNum + DstRodData%typeNum = SrcRodData%typeNum + DstRodData%AttachedA = SrcRodData%AttachedA + DstRodData%AttachedB = SrcRodData%AttachedB + DstRodData%TopA = SrcRodData%TopA + DstRodData%TopB = SrcRodData%TopB + DstRodData%nAttachedA = SrcRodData%nAttachedA + DstRodData%nAttachedB = SrcRodData%nAttachedB + DstRodData%OutFlagList = SrcRodData%OutFlagList + DstRodData%N = SrcRodData%N + DstRodData%endTypeA = SrcRodData%endTypeA + DstRodData%endTypeB = SrcRodData%endTypeB + DstRodData%UnstrLen = SrcRodData%UnstrLen + DstRodData%mass = SrcRodData%mass + DstRodData%rho = SrcRodData%rho + DstRodData%d = SrcRodData%d + DstRodData%Can = SrcRodData%Can + DstRodData%Cat = SrcRodData%Cat + DstRodData%Cdn = SrcRodData%Cdn + DstRodData%Cdt = SrcRodData%Cdt + DstRodData%CdEnd = SrcRodData%CdEnd + DstRodData%CaEnd = SrcRodData%CaEnd + DstRodData%time = SrcRodData%time + DstRodData%roll = SrcRodData%roll + DstRodData%pitch = SrcRodData%pitch + DstRodData%h0 = SrcRodData%h0 + if (allocated(SrcRodData%r)) then + LB(1:2) = lbound(SrcRodData%r) + UB(1:2) = ubound(SrcRodData%r) + if (.not. allocated(DstRodData%r)) then + allocate(DstRodData%r(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%r.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%r = SrcRodData%r + else if (allocated(DstRodData%r)) then + deallocate(DstRodData%r) + end if + if (allocated(SrcRodData%rd)) then + LB(1:2) = lbound(SrcRodData%rd) + UB(1:2) = ubound(SrcRodData%rd) + if (.not. allocated(DstRodData%rd)) then + allocate(DstRodData%rd(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%rd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%rd = SrcRodData%rd + else if (allocated(DstRodData%rd)) then + deallocate(DstRodData%rd) + end if + DstRodData%q = SrcRodData%q + if (allocated(SrcRodData%l)) then + LB(1:1) = lbound(SrcRodData%l) + UB(1:1) = ubound(SrcRodData%l) + if (.not. allocated(DstRodData%l)) then + allocate(DstRodData%l(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%l.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%l = SrcRodData%l + else if (allocated(DstRodData%l)) then + deallocate(DstRodData%l) + end if + if (allocated(SrcRodData%V)) then + LB(1:1) = lbound(SrcRodData%V) + UB(1:1) = ubound(SrcRodData%V) + if (.not. allocated(DstRodData%V)) then + allocate(DstRodData%V(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%V.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%V = SrcRodData%V + else if (allocated(DstRodData%V)) then + deallocate(DstRodData%V) + end if + if (allocated(SrcRodData%U)) then + LB(1:2) = lbound(SrcRodData%U) + UB(1:2) = ubound(SrcRodData%U) + if (.not. allocated(DstRodData%U)) then + allocate(DstRodData%U(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%U.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%U = SrcRodData%U + else if (allocated(DstRodData%U)) then + deallocate(DstRodData%U) + end if + if (allocated(SrcRodData%Ud)) then + LB(1:2) = lbound(SrcRodData%Ud) + UB(1:2) = ubound(SrcRodData%Ud) + if (.not. allocated(DstRodData%Ud)) then + allocate(DstRodData%Ud(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Ud.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%Ud = SrcRodData%Ud + else if (allocated(DstRodData%Ud)) then + deallocate(DstRodData%Ud) + end if + if (allocated(SrcRodData%zeta)) then + LB(1:1) = lbound(SrcRodData%zeta) + UB(1:1) = ubound(SrcRodData%zeta) + if (.not. allocated(DstRodData%zeta)) then + allocate(DstRodData%zeta(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%zeta.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%zeta = SrcRodData%zeta + else if (allocated(DstRodData%zeta)) then + deallocate(DstRodData%zeta) + end if + if (allocated(SrcRodData%PDyn)) then + LB(1:1) = lbound(SrcRodData%PDyn) + UB(1:1) = ubound(SrcRodData%PDyn) + if (.not. allocated(DstRodData%PDyn)) then + allocate(DstRodData%PDyn(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%PDyn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%PDyn = SrcRodData%PDyn + else if (allocated(DstRodData%PDyn)) then + deallocate(DstRodData%PDyn) + end if + if (allocated(SrcRodData%W)) then + LB(1:2) = lbound(SrcRodData%W) + UB(1:2) = ubound(SrcRodData%W) + if (.not. allocated(DstRodData%W)) then + allocate(DstRodData%W(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%W.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%W = SrcRodData%W + else if (allocated(DstRodData%W)) then + deallocate(DstRodData%W) + end if + if (allocated(SrcRodData%Bo)) then + LB(1:2) = lbound(SrcRodData%Bo) + UB(1:2) = ubound(SrcRodData%Bo) + if (.not. allocated(DstRodData%Bo)) then + allocate(DstRodData%Bo(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Bo.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%Bo = SrcRodData%Bo + else if (allocated(DstRodData%Bo)) then + deallocate(DstRodData%Bo) + end if + if (allocated(SrcRodData%Pd)) then + LB(1:2) = lbound(SrcRodData%Pd) + UB(1:2) = ubound(SrcRodData%Pd) + if (.not. allocated(DstRodData%Pd)) then + allocate(DstRodData%Pd(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Pd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%Pd = SrcRodData%Pd + else if (allocated(DstRodData%Pd)) then + deallocate(DstRodData%Pd) + end if + if (allocated(SrcRodData%Dp)) then + LB(1:2) = lbound(SrcRodData%Dp) + UB(1:2) = ubound(SrcRodData%Dp) + if (.not. allocated(DstRodData%Dp)) then + allocate(DstRodData%Dp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Dp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%Dp = SrcRodData%Dp + else if (allocated(DstRodData%Dp)) then + deallocate(DstRodData%Dp) + end if + if (allocated(SrcRodData%Dq)) then + LB(1:2) = lbound(SrcRodData%Dq) + UB(1:2) = ubound(SrcRodData%Dq) + if (.not. allocated(DstRodData%Dq)) then + allocate(DstRodData%Dq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Dq.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%Dq = SrcRodData%Dq + else if (allocated(DstRodData%Dq)) then + deallocate(DstRodData%Dq) + end if + if (allocated(SrcRodData%Ap)) then + LB(1:2) = lbound(SrcRodData%Ap) + UB(1:2) = ubound(SrcRodData%Ap) + if (.not. allocated(DstRodData%Ap)) then + allocate(DstRodData%Ap(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Ap.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%Ap = SrcRodData%Ap + else if (allocated(DstRodData%Ap)) then + deallocate(DstRodData%Ap) + end if + if (allocated(SrcRodData%Aq)) then + LB(1:2) = lbound(SrcRodData%Aq) + UB(1:2) = ubound(SrcRodData%Aq) + if (.not. allocated(DstRodData%Aq)) then + allocate(DstRodData%Aq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Aq.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%Aq = SrcRodData%Aq + else if (allocated(DstRodData%Aq)) then + deallocate(DstRodData%Aq) + end if + if (allocated(SrcRodData%B)) then + LB(1:2) = lbound(SrcRodData%B) + UB(1:2) = ubound(SrcRodData%B) + if (.not. allocated(DstRodData%B)) then + allocate(DstRodData%B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%B = SrcRodData%B + else if (allocated(DstRodData%B)) then + deallocate(DstRodData%B) + end if + if (allocated(SrcRodData%Fnet)) then + LB(1:2) = lbound(SrcRodData%Fnet) + UB(1:2) = ubound(SrcRodData%Fnet) + if (.not. allocated(DstRodData%Fnet)) then + allocate(DstRodData%Fnet(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Fnet.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%Fnet = SrcRodData%Fnet + else if (allocated(DstRodData%Fnet)) then + deallocate(DstRodData%Fnet) + end if + if (allocated(SrcRodData%M)) then + LB(1:3) = lbound(SrcRodData%M) + UB(1:3) = ubound(SrcRodData%M) + if (.not. allocated(DstRodData%M)) then + allocate(DstRodData%M(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%M.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%M = SrcRodData%M + else if (allocated(DstRodData%M)) then + deallocate(DstRodData%M) + end if + DstRodData%FextA = SrcRodData%FextA + DstRodData%FextB = SrcRodData%FextB + DstRodData%Mext = SrcRodData%Mext + DstRodData%r6 = SrcRodData%r6 + DstRodData%v6 = SrcRodData%v6 + DstRodData%a6 = SrcRodData%a6 + DstRodData%F6net = SrcRodData%F6net + DstRodData%M6net = SrcRodData%M6net + DstRodData%OrMat = SrcRodData%OrMat + DstRodData%RodUnOut = SrcRodData%RodUnOut + if (allocated(SrcRodData%RodWrOutput)) then + LB(1:1) = lbound(SrcRodData%RodWrOutput) + UB(1:1) = ubound(SrcRodData%RodWrOutput) + if (.not. allocated(DstRodData%RodWrOutput)) then + allocate(DstRodData%RodWrOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%RodWrOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRodData%RodWrOutput = SrcRodData%RodWrOutput + else if (allocated(DstRodData%RodWrOutput)) then + deallocate(DstRodData%RodWrOutput) + end if +end subroutine +subroutine MD_DestroyRod(RodData, ErrStat, ErrMsg) + type(MD_Rod), intent(inout) :: RodData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_DestroyRod' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(RodData%r)) then + deallocate(RodData%r) + end if + if (allocated(RodData%rd)) then + deallocate(RodData%rd) + end if + if (allocated(RodData%l)) then + deallocate(RodData%l) + end if + if (allocated(RodData%V)) then + deallocate(RodData%V) + end if + if (allocated(RodData%U)) then + deallocate(RodData%U) + end if + if (allocated(RodData%Ud)) then + deallocate(RodData%Ud) + end if + if (allocated(RodData%zeta)) then + deallocate(RodData%zeta) + end if + if (allocated(RodData%PDyn)) then + deallocate(RodData%PDyn) + end if + if (allocated(RodData%W)) then + deallocate(RodData%W) + end if + if (allocated(RodData%Bo)) then + deallocate(RodData%Bo) + end if + if (allocated(RodData%Pd)) then + deallocate(RodData%Pd) + end if + if (allocated(RodData%Dp)) then + deallocate(RodData%Dp) + end if + if (allocated(RodData%Dq)) then + deallocate(RodData%Dq) + end if + if (allocated(RodData%Ap)) then + deallocate(RodData%Ap) + end if + if (allocated(RodData%Aq)) then + deallocate(RodData%Aq) + end if + if (allocated(RodData%B)) then + deallocate(RodData%B) + end if + if (allocated(RodData%Fnet)) then + deallocate(RodData%Fnet) + end if + if (allocated(RodData%M)) then + deallocate(RodData%M) + end if + if (allocated(RodData%RodWrOutput)) then + deallocate(RodData%RodWrOutput) + end if +end subroutine subroutine MD_PackRod(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(MD_Rod), intent(in) :: InData character(*), parameter :: RoutineName = 'MD_PackRod' if (Buf%ErrStat >= AbortErrLev) return - ! IdNum call RegPack(Buf, InData%IdNum) if (RegCheckErr(Buf, RoutineName)) return - ! type call RegPack(Buf, InData%type) if (RegCheckErr(Buf, RoutineName)) return - ! PropsIdNum call RegPack(Buf, InData%PropsIdNum) if (RegCheckErr(Buf, RoutineName)) return - ! typeNum call RegPack(Buf, InData%typeNum) if (RegCheckErr(Buf, RoutineName)) return - ! AttachedA call RegPack(Buf, InData%AttachedA) if (RegCheckErr(Buf, RoutineName)) return - ! AttachedB call RegPack(Buf, InData%AttachedB) if (RegCheckErr(Buf, RoutineName)) return - ! TopA call RegPack(Buf, InData%TopA) if (RegCheckErr(Buf, RoutineName)) return - ! TopB call RegPack(Buf, InData%TopB) if (RegCheckErr(Buf, RoutineName)) return - ! nAttachedA call RegPack(Buf, InData%nAttachedA) if (RegCheckErr(Buf, RoutineName)) return - ! nAttachedB call RegPack(Buf, InData%nAttachedB) if (RegCheckErr(Buf, RoutineName)) return - ! OutFlagList call RegPack(Buf, InData%OutFlagList) if (RegCheckErr(Buf, RoutineName)) return - ! N call RegPack(Buf, InData%N) if (RegCheckErr(Buf, RoutineName)) return - ! endTypeA call RegPack(Buf, InData%endTypeA) if (RegCheckErr(Buf, RoutineName)) return - ! endTypeB call RegPack(Buf, InData%endTypeB) if (RegCheckErr(Buf, RoutineName)) return - ! UnstrLen call RegPack(Buf, InData%UnstrLen) if (RegCheckErr(Buf, RoutineName)) return - ! mass call RegPack(Buf, InData%mass) if (RegCheckErr(Buf, RoutineName)) return - ! rho call RegPack(Buf, InData%rho) if (RegCheckErr(Buf, RoutineName)) return - ! d call RegPack(Buf, InData%d) if (RegCheckErr(Buf, RoutineName)) return - ! Can call RegPack(Buf, InData%Can) if (RegCheckErr(Buf, RoutineName)) return - ! Cat call RegPack(Buf, InData%Cat) if (RegCheckErr(Buf, RoutineName)) return - ! Cdn call RegPack(Buf, InData%Cdn) if (RegCheckErr(Buf, RoutineName)) return - ! Cdt call RegPack(Buf, InData%Cdt) if (RegCheckErr(Buf, RoutineName)) return - ! CdEnd call RegPack(Buf, InData%CdEnd) if (RegCheckErr(Buf, RoutineName)) return - ! CaEnd call RegPack(Buf, InData%CaEnd) if (RegCheckErr(Buf, RoutineName)) return - ! time call RegPack(Buf, InData%time) if (RegCheckErr(Buf, RoutineName)) return - ! roll call RegPack(Buf, InData%roll) if (RegCheckErr(Buf, RoutineName)) return - ! pitch call RegPack(Buf, InData%pitch) if (RegCheckErr(Buf, RoutineName)) return - ! h0 call RegPack(Buf, InData%h0) if (RegCheckErr(Buf, RoutineName)) return - ! r call RegPack(Buf, allocated(InData%r)) if (allocated(InData%r)) then call RegPackBounds(Buf, 2, lbound(InData%r), ubound(InData%r)) call RegPack(Buf, InData%r) end if if (RegCheckErr(Buf, RoutineName)) return - ! rd call RegPack(Buf, allocated(InData%rd)) if (allocated(InData%rd)) then call RegPackBounds(Buf, 2, lbound(InData%rd), ubound(InData%rd)) call RegPack(Buf, InData%rd) end if if (RegCheckErr(Buf, RoutineName)) return - ! q call RegPack(Buf, InData%q) if (RegCheckErr(Buf, RoutineName)) return - ! l call RegPack(Buf, allocated(InData%l)) if (allocated(InData%l)) then call RegPackBounds(Buf, 1, lbound(InData%l), ubound(InData%l)) call RegPack(Buf, InData%l) end if if (RegCheckErr(Buf, RoutineName)) return - ! V call RegPack(Buf, allocated(InData%V)) if (allocated(InData%V)) then call RegPackBounds(Buf, 1, lbound(InData%V), ubound(InData%V)) call RegPack(Buf, InData%V) end if if (RegCheckErr(Buf, RoutineName)) return - ! U call RegPack(Buf, allocated(InData%U)) if (allocated(InData%U)) then call RegPackBounds(Buf, 2, lbound(InData%U), ubound(InData%U)) call RegPack(Buf, InData%U) end if if (RegCheckErr(Buf, RoutineName)) return - ! Ud call RegPack(Buf, allocated(InData%Ud)) if (allocated(InData%Ud)) then call RegPackBounds(Buf, 2, lbound(InData%Ud), ubound(InData%Ud)) call RegPack(Buf, InData%Ud) end if if (RegCheckErr(Buf, RoutineName)) return - ! zeta call RegPack(Buf, allocated(InData%zeta)) if (allocated(InData%zeta)) then call RegPackBounds(Buf, 1, lbound(InData%zeta), ubound(InData%zeta)) call RegPack(Buf, InData%zeta) end if if (RegCheckErr(Buf, RoutineName)) return - ! PDyn call RegPack(Buf, allocated(InData%PDyn)) if (allocated(InData%PDyn)) then call RegPackBounds(Buf, 1, lbound(InData%PDyn), ubound(InData%PDyn)) call RegPack(Buf, InData%PDyn) end if if (RegCheckErr(Buf, RoutineName)) return - ! W call RegPack(Buf, allocated(InData%W)) if (allocated(InData%W)) then call RegPackBounds(Buf, 2, lbound(InData%W), ubound(InData%W)) call RegPack(Buf, InData%W) end if if (RegCheckErr(Buf, RoutineName)) return - ! Bo call RegPack(Buf, allocated(InData%Bo)) if (allocated(InData%Bo)) then call RegPackBounds(Buf, 2, lbound(InData%Bo), ubound(InData%Bo)) call RegPack(Buf, InData%Bo) end if if (RegCheckErr(Buf, RoutineName)) return - ! Pd call RegPack(Buf, allocated(InData%Pd)) if (allocated(InData%Pd)) then call RegPackBounds(Buf, 2, lbound(InData%Pd), ubound(InData%Pd)) call RegPack(Buf, InData%Pd) end if if (RegCheckErr(Buf, RoutineName)) return - ! Dp call RegPack(Buf, allocated(InData%Dp)) if (allocated(InData%Dp)) then call RegPackBounds(Buf, 2, lbound(InData%Dp), ubound(InData%Dp)) call RegPack(Buf, InData%Dp) end if if (RegCheckErr(Buf, RoutineName)) return - ! Dq call RegPack(Buf, allocated(InData%Dq)) if (allocated(InData%Dq)) then call RegPackBounds(Buf, 2, lbound(InData%Dq), ubound(InData%Dq)) call RegPack(Buf, InData%Dq) end if if (RegCheckErr(Buf, RoutineName)) return - ! Ap call RegPack(Buf, allocated(InData%Ap)) if (allocated(InData%Ap)) then call RegPackBounds(Buf, 2, lbound(InData%Ap), ubound(InData%Ap)) call RegPack(Buf, InData%Ap) end if if (RegCheckErr(Buf, RoutineName)) return - ! Aq call RegPack(Buf, allocated(InData%Aq)) if (allocated(InData%Aq)) then call RegPackBounds(Buf, 2, lbound(InData%Aq), ubound(InData%Aq)) call RegPack(Buf, InData%Aq) end if if (RegCheckErr(Buf, RoutineName)) return - ! B call RegPack(Buf, allocated(InData%B)) if (allocated(InData%B)) then call RegPackBounds(Buf, 2, lbound(InData%B), ubound(InData%B)) call RegPack(Buf, InData%B) end if if (RegCheckErr(Buf, RoutineName)) return - ! Fnet call RegPack(Buf, allocated(InData%Fnet)) if (allocated(InData%Fnet)) then call RegPackBounds(Buf, 2, lbound(InData%Fnet), ubound(InData%Fnet)) call RegPack(Buf, InData%Fnet) end if if (RegCheckErr(Buf, RoutineName)) return - ! M call RegPack(Buf, allocated(InData%M)) if (allocated(InData%M)) then call RegPackBounds(Buf, 3, lbound(InData%M), ubound(InData%M)) call RegPack(Buf, InData%M) end if if (RegCheckErr(Buf, RoutineName)) return - ! FextA call RegPack(Buf, InData%FextA) if (RegCheckErr(Buf, RoutineName)) return - ! FextB call RegPack(Buf, InData%FextB) if (RegCheckErr(Buf, RoutineName)) return - ! Mext call RegPack(Buf, InData%Mext) if (RegCheckErr(Buf, RoutineName)) return - ! r6 call RegPack(Buf, InData%r6) if (RegCheckErr(Buf, RoutineName)) return - ! v6 call RegPack(Buf, InData%v6) if (RegCheckErr(Buf, RoutineName)) return - ! a6 call RegPack(Buf, InData%a6) if (RegCheckErr(Buf, RoutineName)) return - ! F6net call RegPack(Buf, InData%F6net) if (RegCheckErr(Buf, RoutineName)) return - ! M6net call RegPack(Buf, InData%M6net) if (RegCheckErr(Buf, RoutineName)) return - ! OrMat call RegPack(Buf, InData%OrMat) if (RegCheckErr(Buf, RoutineName)) return - ! RodUnOut call RegPack(Buf, InData%RodUnOut) if (RegCheckErr(Buf, RoutineName)) return - ! RodWrOutput call RegPack(Buf, allocated(InData%RodWrOutput)) if (allocated(InData%RodWrOutput)) then call RegPackBounds(Buf, 1, lbound(InData%RodWrOutput), ubound(InData%RodWrOutput)) @@ -2226,91 +1900,62 @@ subroutine MD_UnPackRod(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! IdNum call RegUnpack(Buf, OutData%IdNum) if (RegCheckErr(Buf, RoutineName)) return - ! type call RegUnpack(Buf, OutData%type) if (RegCheckErr(Buf, RoutineName)) return - ! PropsIdNum call RegUnpack(Buf, OutData%PropsIdNum) if (RegCheckErr(Buf, RoutineName)) return - ! typeNum call RegUnpack(Buf, OutData%typeNum) if (RegCheckErr(Buf, RoutineName)) return - ! AttachedA call RegUnpack(Buf, OutData%AttachedA) if (RegCheckErr(Buf, RoutineName)) return - ! AttachedB call RegUnpack(Buf, OutData%AttachedB) if (RegCheckErr(Buf, RoutineName)) return - ! TopA call RegUnpack(Buf, OutData%TopA) if (RegCheckErr(Buf, RoutineName)) return - ! TopB call RegUnpack(Buf, OutData%TopB) if (RegCheckErr(Buf, RoutineName)) return - ! nAttachedA call RegUnpack(Buf, OutData%nAttachedA) if (RegCheckErr(Buf, RoutineName)) return - ! nAttachedB call RegUnpack(Buf, OutData%nAttachedB) if (RegCheckErr(Buf, RoutineName)) return - ! OutFlagList call RegUnpack(Buf, OutData%OutFlagList) if (RegCheckErr(Buf, RoutineName)) return - ! N call RegUnpack(Buf, OutData%N) if (RegCheckErr(Buf, RoutineName)) return - ! endTypeA call RegUnpack(Buf, OutData%endTypeA) if (RegCheckErr(Buf, RoutineName)) return - ! endTypeB call RegUnpack(Buf, OutData%endTypeB) if (RegCheckErr(Buf, RoutineName)) return - ! UnstrLen call RegUnpack(Buf, OutData%UnstrLen) if (RegCheckErr(Buf, RoutineName)) return - ! mass call RegUnpack(Buf, OutData%mass) if (RegCheckErr(Buf, RoutineName)) return - ! rho call RegUnpack(Buf, OutData%rho) if (RegCheckErr(Buf, RoutineName)) return - ! d call RegUnpack(Buf, OutData%d) if (RegCheckErr(Buf, RoutineName)) return - ! Can call RegUnpack(Buf, OutData%Can) if (RegCheckErr(Buf, RoutineName)) return - ! Cat call RegUnpack(Buf, OutData%Cat) if (RegCheckErr(Buf, RoutineName)) return - ! Cdn call RegUnpack(Buf, OutData%Cdn) if (RegCheckErr(Buf, RoutineName)) return - ! Cdt call RegUnpack(Buf, OutData%Cdt) if (RegCheckErr(Buf, RoutineName)) return - ! CdEnd call RegUnpack(Buf, OutData%CdEnd) if (RegCheckErr(Buf, RoutineName)) return - ! CaEnd call RegUnpack(Buf, OutData%CaEnd) if (RegCheckErr(Buf, RoutineName)) return - ! time call RegUnpack(Buf, OutData%time) if (RegCheckErr(Buf, RoutineName)) return - ! roll call RegUnpack(Buf, OutData%roll) if (RegCheckErr(Buf, RoutineName)) return - ! pitch call RegUnpack(Buf, OutData%pitch) if (RegCheckErr(Buf, RoutineName)) return - ! h0 call RegUnpack(Buf, OutData%h0) if (RegCheckErr(Buf, RoutineName)) return - ! r if (allocated(OutData%r)) deallocate(OutData%r) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2325,7 +1970,6 @@ subroutine MD_UnPackRod(Buf, OutData) call RegUnpack(Buf, OutData%r) if (RegCheckErr(Buf, RoutineName)) return end if - ! rd if (allocated(OutData%rd)) deallocate(OutData%rd) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2340,10 +1984,8 @@ subroutine MD_UnPackRod(Buf, OutData) call RegUnpack(Buf, OutData%rd) if (RegCheckErr(Buf, RoutineName)) return end if - ! q call RegUnpack(Buf, OutData%q) if (RegCheckErr(Buf, RoutineName)) return - ! l if (allocated(OutData%l)) deallocate(OutData%l) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2358,7 +2000,6 @@ subroutine MD_UnPackRod(Buf, OutData) call RegUnpack(Buf, OutData%l) if (RegCheckErr(Buf, RoutineName)) return end if - ! V if (allocated(OutData%V)) deallocate(OutData%V) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2373,7 +2014,6 @@ subroutine MD_UnPackRod(Buf, OutData) call RegUnpack(Buf, OutData%V) if (RegCheckErr(Buf, RoutineName)) return end if - ! U if (allocated(OutData%U)) deallocate(OutData%U) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2388,7 +2028,6 @@ subroutine MD_UnPackRod(Buf, OutData) call RegUnpack(Buf, OutData%U) if (RegCheckErr(Buf, RoutineName)) return end if - ! Ud if (allocated(OutData%Ud)) deallocate(OutData%Ud) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2403,7 +2042,6 @@ subroutine MD_UnPackRod(Buf, OutData) call RegUnpack(Buf, OutData%Ud) if (RegCheckErr(Buf, RoutineName)) return end if - ! zeta if (allocated(OutData%zeta)) deallocate(OutData%zeta) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2418,7 +2056,6 @@ subroutine MD_UnPackRod(Buf, OutData) call RegUnpack(Buf, OutData%zeta) if (RegCheckErr(Buf, RoutineName)) return end if - ! PDyn if (allocated(OutData%PDyn)) deallocate(OutData%PDyn) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2433,7 +2070,6 @@ subroutine MD_UnPackRod(Buf, OutData) call RegUnpack(Buf, OutData%PDyn) if (RegCheckErr(Buf, RoutineName)) return end if - ! W if (allocated(OutData%W)) deallocate(OutData%W) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2448,7 +2084,6 @@ subroutine MD_UnPackRod(Buf, OutData) call RegUnpack(Buf, OutData%W) if (RegCheckErr(Buf, RoutineName)) return end if - ! Bo if (allocated(OutData%Bo)) deallocate(OutData%Bo) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2463,7 +2098,6 @@ subroutine MD_UnPackRod(Buf, OutData) call RegUnpack(Buf, OutData%Bo) if (RegCheckErr(Buf, RoutineName)) return end if - ! Pd if (allocated(OutData%Pd)) deallocate(OutData%Pd) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2478,7 +2112,6 @@ subroutine MD_UnPackRod(Buf, OutData) call RegUnpack(Buf, OutData%Pd) if (RegCheckErr(Buf, RoutineName)) return end if - ! Dp if (allocated(OutData%Dp)) deallocate(OutData%Dp) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2493,7 +2126,6 @@ subroutine MD_UnPackRod(Buf, OutData) call RegUnpack(Buf, OutData%Dp) if (RegCheckErr(Buf, RoutineName)) return end if - ! Dq if (allocated(OutData%Dq)) deallocate(OutData%Dq) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2508,7 +2140,6 @@ subroutine MD_UnPackRod(Buf, OutData) call RegUnpack(Buf, OutData%Dq) if (RegCheckErr(Buf, RoutineName)) return end if - ! Ap if (allocated(OutData%Ap)) deallocate(OutData%Ap) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2523,7 +2154,6 @@ subroutine MD_UnPackRod(Buf, OutData) call RegUnpack(Buf, OutData%Ap) if (RegCheckErr(Buf, RoutineName)) return end if - ! Aq if (allocated(OutData%Aq)) deallocate(OutData%Aq) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2538,7 +2168,6 @@ subroutine MD_UnPackRod(Buf, OutData) call RegUnpack(Buf, OutData%Aq) if (RegCheckErr(Buf, RoutineName)) return end if - ! B if (allocated(OutData%B)) deallocate(OutData%B) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2553,7 +2182,6 @@ subroutine MD_UnPackRod(Buf, OutData) call RegUnpack(Buf, OutData%B) if (RegCheckErr(Buf, RoutineName)) return end if - ! Fnet if (allocated(OutData%Fnet)) deallocate(OutData%Fnet) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2568,7 +2196,6 @@ subroutine MD_UnPackRod(Buf, OutData) call RegUnpack(Buf, OutData%Fnet) if (RegCheckErr(Buf, RoutineName)) return end if - ! M if (allocated(OutData%M)) deallocate(OutData%M) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2583,37 +2210,26 @@ subroutine MD_UnPackRod(Buf, OutData) call RegUnpack(Buf, OutData%M) if (RegCheckErr(Buf, RoutineName)) return end if - ! FextA call RegUnpack(Buf, OutData%FextA) if (RegCheckErr(Buf, RoutineName)) return - ! FextB call RegUnpack(Buf, OutData%FextB) if (RegCheckErr(Buf, RoutineName)) return - ! Mext call RegUnpack(Buf, OutData%Mext) if (RegCheckErr(Buf, RoutineName)) return - ! r6 call RegUnpack(Buf, OutData%r6) if (RegCheckErr(Buf, RoutineName)) return - ! v6 call RegUnpack(Buf, OutData%v6) if (RegCheckErr(Buf, RoutineName)) return - ! a6 call RegUnpack(Buf, OutData%a6) if (RegCheckErr(Buf, RoutineName)) return - ! F6net call RegUnpack(Buf, OutData%F6net) if (RegCheckErr(Buf, RoutineName)) return - ! M6net call RegUnpack(Buf, OutData%M6net) if (RegCheckErr(Buf, RoutineName)) return - ! OrMat call RegUnpack(Buf, OutData%OrMat) if (RegCheckErr(Buf, RoutineName)) return - ! RodUnOut call RegUnpack(Buf, OutData%RodUnOut) if (RegCheckErr(Buf, RoutineName)) return - ! RodWrOutput if (allocated(OutData%RodWrOutput)) deallocate(OutData%RodWrOutput) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2629,836 +2245,777 @@ subroutine MD_UnPackRod(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE MD_CopyLine( SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_Line), INTENT(IN) :: SrcLineData - TYPE(MD_Line), INTENT(INOUT) :: DstLineData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyLine' -! - ErrStat = ErrID_None - ErrMsg = "" - DstLineData%IdNum = SrcLineData%IdNum - DstLineData%PropsIdNum = SrcLineData%PropsIdNum - DstLineData%ElasticMod = SrcLineData%ElasticMod - DstLineData%OutFlagList = SrcLineData%OutFlagList - DstLineData%CtrlChan = SrcLineData%CtrlChan - DstLineData%FairConnect = SrcLineData%FairConnect - DstLineData%AnchConnect = SrcLineData%AnchConnect - DstLineData%N = SrcLineData%N - DstLineData%endTypeA = SrcLineData%endTypeA - DstLineData%endTypeB = SrcLineData%endTypeB - DstLineData%UnstrLen = SrcLineData%UnstrLen - DstLineData%rho = SrcLineData%rho - DstLineData%d = SrcLineData%d - DstLineData%EA = SrcLineData%EA - DstLineData%EA_D = SrcLineData%EA_D - DstLineData%BA = SrcLineData%BA - DstLineData%BA_D = SrcLineData%BA_D - DstLineData%EI = SrcLineData%EI - DstLineData%Can = SrcLineData%Can - DstLineData%Cat = SrcLineData%Cat - DstLineData%Cdn = SrcLineData%Cdn - DstLineData%Cdt = SrcLineData%Cdt - DstLineData%nEApoints = SrcLineData%nEApoints - DstLineData%stiffXs = SrcLineData%stiffXs - DstLineData%stiffYs = SrcLineData%stiffYs - DstLineData%nBApoints = SrcLineData%nBApoints - DstLineData%dampXs = SrcLineData%dampXs - DstLineData%dampYs = SrcLineData%dampYs - DstLineData%nEIpoints = SrcLineData%nEIpoints - DstLineData%bstiffXs = SrcLineData%bstiffXs - DstLineData%bstiffYs = SrcLineData%bstiffYs - DstLineData%time = SrcLineData%time -IF (ALLOCATED(SrcLineData%r)) THEN - i1_l = LBOUND(SrcLineData%r,1) - i1_u = UBOUND(SrcLineData%r,1) - i2_l = LBOUND(SrcLineData%r,2) - i2_u = UBOUND(SrcLineData%r,2) - IF (.NOT. ALLOCATED(DstLineData%r)) THEN - ALLOCATE(DstLineData%r(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%r.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%r = SrcLineData%r -ENDIF -IF (ALLOCATED(SrcLineData%rd)) THEN - i1_l = LBOUND(SrcLineData%rd,1) - i1_u = UBOUND(SrcLineData%rd,1) - i2_l = LBOUND(SrcLineData%rd,2) - i2_u = UBOUND(SrcLineData%rd,2) - IF (.NOT. ALLOCATED(DstLineData%rd)) THEN - ALLOCATE(DstLineData%rd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%rd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%rd = SrcLineData%rd -ENDIF -IF (ALLOCATED(SrcLineData%q)) THEN - i1_l = LBOUND(SrcLineData%q,1) - i1_u = UBOUND(SrcLineData%q,1) - i2_l = LBOUND(SrcLineData%q,2) - i2_u = UBOUND(SrcLineData%q,2) - IF (.NOT. ALLOCATED(DstLineData%q)) THEN - ALLOCATE(DstLineData%q(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%q.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%q = SrcLineData%q -ENDIF -IF (ALLOCATED(SrcLineData%qs)) THEN - i1_l = LBOUND(SrcLineData%qs,1) - i1_u = UBOUND(SrcLineData%qs,1) - i2_l = LBOUND(SrcLineData%qs,2) - i2_u = UBOUND(SrcLineData%qs,2) - IF (.NOT. ALLOCATED(DstLineData%qs)) THEN - ALLOCATE(DstLineData%qs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%qs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%qs = SrcLineData%qs -ENDIF -IF (ALLOCATED(SrcLineData%l)) THEN - i1_l = LBOUND(SrcLineData%l,1) - i1_u = UBOUND(SrcLineData%l,1) - IF (.NOT. ALLOCATED(DstLineData%l)) THEN - ALLOCATE(DstLineData%l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%l = SrcLineData%l -ENDIF -IF (ALLOCATED(SrcLineData%ld)) THEN - i1_l = LBOUND(SrcLineData%ld,1) - i1_u = UBOUND(SrcLineData%ld,1) - IF (.NOT. ALLOCATED(DstLineData%ld)) THEN - ALLOCATE(DstLineData%ld(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%ld.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%ld = SrcLineData%ld -ENDIF -IF (ALLOCATED(SrcLineData%lstr)) THEN - i1_l = LBOUND(SrcLineData%lstr,1) - i1_u = UBOUND(SrcLineData%lstr,1) - IF (.NOT. ALLOCATED(DstLineData%lstr)) THEN - ALLOCATE(DstLineData%lstr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%lstr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%lstr = SrcLineData%lstr -ENDIF -IF (ALLOCATED(SrcLineData%lstrd)) THEN - i1_l = LBOUND(SrcLineData%lstrd,1) - i1_u = UBOUND(SrcLineData%lstrd,1) - IF (.NOT. ALLOCATED(DstLineData%lstrd)) THEN - ALLOCATE(DstLineData%lstrd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%lstrd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%lstrd = SrcLineData%lstrd -ENDIF -IF (ALLOCATED(SrcLineData%Kurv)) THEN - i1_l = LBOUND(SrcLineData%Kurv,1) - i1_u = UBOUND(SrcLineData%Kurv,1) - IF (.NOT. ALLOCATED(DstLineData%Kurv)) THEN - ALLOCATE(DstLineData%Kurv(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Kurv.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%Kurv = SrcLineData%Kurv -ENDIF -IF (ALLOCATED(SrcLineData%dl_1)) THEN - i1_l = LBOUND(SrcLineData%dl_1,1) - i1_u = UBOUND(SrcLineData%dl_1,1) - IF (.NOT. ALLOCATED(DstLineData%dl_1)) THEN - ALLOCATE(DstLineData%dl_1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%dl_1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%dl_1 = SrcLineData%dl_1 -ENDIF -IF (ALLOCATED(SrcLineData%V)) THEN - i1_l = LBOUND(SrcLineData%V,1) - i1_u = UBOUND(SrcLineData%V,1) - IF (.NOT. ALLOCATED(DstLineData%V)) THEN - ALLOCATE(DstLineData%V(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%V.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%V = SrcLineData%V -ENDIF -IF (ALLOCATED(SrcLineData%U)) THEN - i1_l = LBOUND(SrcLineData%U,1) - i1_u = UBOUND(SrcLineData%U,1) - i2_l = LBOUND(SrcLineData%U,2) - i2_u = UBOUND(SrcLineData%U,2) - IF (.NOT. ALLOCATED(DstLineData%U)) THEN - ALLOCATE(DstLineData%U(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%U.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%U = SrcLineData%U -ENDIF -IF (ALLOCATED(SrcLineData%Ud)) THEN - i1_l = LBOUND(SrcLineData%Ud,1) - i1_u = UBOUND(SrcLineData%Ud,1) - i2_l = LBOUND(SrcLineData%Ud,2) - i2_u = UBOUND(SrcLineData%Ud,2) - IF (.NOT. ALLOCATED(DstLineData%Ud)) THEN - ALLOCATE(DstLineData%Ud(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Ud.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%Ud = SrcLineData%Ud -ENDIF -IF (ALLOCATED(SrcLineData%zeta)) THEN - i1_l = LBOUND(SrcLineData%zeta,1) - i1_u = UBOUND(SrcLineData%zeta,1) - IF (.NOT. ALLOCATED(DstLineData%zeta)) THEN - ALLOCATE(DstLineData%zeta(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%zeta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%zeta = SrcLineData%zeta -ENDIF -IF (ALLOCATED(SrcLineData%PDyn)) THEN - i1_l = LBOUND(SrcLineData%PDyn,1) - i1_u = UBOUND(SrcLineData%PDyn,1) - IF (.NOT. ALLOCATED(DstLineData%PDyn)) THEN - ALLOCATE(DstLineData%PDyn(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%PDyn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%PDyn = SrcLineData%PDyn -ENDIF -IF (ALLOCATED(SrcLineData%T)) THEN - i1_l = LBOUND(SrcLineData%T,1) - i1_u = UBOUND(SrcLineData%T,1) - i2_l = LBOUND(SrcLineData%T,2) - i2_u = UBOUND(SrcLineData%T,2) - IF (.NOT. ALLOCATED(DstLineData%T)) THEN - ALLOCATE(DstLineData%T(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%T = SrcLineData%T -ENDIF -IF (ALLOCATED(SrcLineData%Td)) THEN - i1_l = LBOUND(SrcLineData%Td,1) - i1_u = UBOUND(SrcLineData%Td,1) - i2_l = LBOUND(SrcLineData%Td,2) - i2_u = UBOUND(SrcLineData%Td,2) - IF (.NOT. ALLOCATED(DstLineData%Td)) THEN - ALLOCATE(DstLineData%Td(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Td.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%Td = SrcLineData%Td -ENDIF -IF (ALLOCATED(SrcLineData%W)) THEN - i1_l = LBOUND(SrcLineData%W,1) - i1_u = UBOUND(SrcLineData%W,1) - i2_l = LBOUND(SrcLineData%W,2) - i2_u = UBOUND(SrcLineData%W,2) - IF (.NOT. ALLOCATED(DstLineData%W)) THEN - ALLOCATE(DstLineData%W(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%W.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%W = SrcLineData%W -ENDIF -IF (ALLOCATED(SrcLineData%Dp)) THEN - i1_l = LBOUND(SrcLineData%Dp,1) - i1_u = UBOUND(SrcLineData%Dp,1) - i2_l = LBOUND(SrcLineData%Dp,2) - i2_u = UBOUND(SrcLineData%Dp,2) - IF (.NOT. ALLOCATED(DstLineData%Dp)) THEN - ALLOCATE(DstLineData%Dp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Dp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%Dp = SrcLineData%Dp -ENDIF -IF (ALLOCATED(SrcLineData%Dq)) THEN - i1_l = LBOUND(SrcLineData%Dq,1) - i1_u = UBOUND(SrcLineData%Dq,1) - i2_l = LBOUND(SrcLineData%Dq,2) - i2_u = UBOUND(SrcLineData%Dq,2) - IF (.NOT. ALLOCATED(DstLineData%Dq)) THEN - ALLOCATE(DstLineData%Dq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Dq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%Dq = SrcLineData%Dq -ENDIF -IF (ALLOCATED(SrcLineData%Ap)) THEN - i1_l = LBOUND(SrcLineData%Ap,1) - i1_u = UBOUND(SrcLineData%Ap,1) - i2_l = LBOUND(SrcLineData%Ap,2) - i2_u = UBOUND(SrcLineData%Ap,2) - IF (.NOT. ALLOCATED(DstLineData%Ap)) THEN - ALLOCATE(DstLineData%Ap(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Ap.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%Ap = SrcLineData%Ap -ENDIF -IF (ALLOCATED(SrcLineData%Aq)) THEN - i1_l = LBOUND(SrcLineData%Aq,1) - i1_u = UBOUND(SrcLineData%Aq,1) - i2_l = LBOUND(SrcLineData%Aq,2) - i2_u = UBOUND(SrcLineData%Aq,2) - IF (.NOT. ALLOCATED(DstLineData%Aq)) THEN - ALLOCATE(DstLineData%Aq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Aq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%Aq = SrcLineData%Aq -ENDIF -IF (ALLOCATED(SrcLineData%B)) THEN - i1_l = LBOUND(SrcLineData%B,1) - i1_u = UBOUND(SrcLineData%B,1) - i2_l = LBOUND(SrcLineData%B,2) - i2_u = UBOUND(SrcLineData%B,2) - IF (.NOT. ALLOCATED(DstLineData%B)) THEN - ALLOCATE(DstLineData%B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%B = SrcLineData%B -ENDIF -IF (ALLOCATED(SrcLineData%Bs)) THEN - i1_l = LBOUND(SrcLineData%Bs,1) - i1_u = UBOUND(SrcLineData%Bs,1) - i2_l = LBOUND(SrcLineData%Bs,2) - i2_u = UBOUND(SrcLineData%Bs,2) - IF (.NOT. ALLOCATED(DstLineData%Bs)) THEN - ALLOCATE(DstLineData%Bs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Bs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%Bs = SrcLineData%Bs -ENDIF -IF (ALLOCATED(SrcLineData%Fnet)) THEN - i1_l = LBOUND(SrcLineData%Fnet,1) - i1_u = UBOUND(SrcLineData%Fnet,1) - i2_l = LBOUND(SrcLineData%Fnet,2) - i2_u = UBOUND(SrcLineData%Fnet,2) - IF (.NOT. ALLOCATED(DstLineData%Fnet)) THEN - ALLOCATE(DstLineData%Fnet(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Fnet.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%Fnet = SrcLineData%Fnet -ENDIF -IF (ALLOCATED(SrcLineData%S)) THEN - i1_l = LBOUND(SrcLineData%S,1) - i1_u = UBOUND(SrcLineData%S,1) - i2_l = LBOUND(SrcLineData%S,2) - i2_u = UBOUND(SrcLineData%S,2) - i3_l = LBOUND(SrcLineData%S,3) - i3_u = UBOUND(SrcLineData%S,3) - IF (.NOT. ALLOCATED(DstLineData%S)) THEN - ALLOCATE(DstLineData%S(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%S.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%S = SrcLineData%S -ENDIF -IF (ALLOCATED(SrcLineData%M)) THEN - i1_l = LBOUND(SrcLineData%M,1) - i1_u = UBOUND(SrcLineData%M,1) - i2_l = LBOUND(SrcLineData%M,2) - i2_u = UBOUND(SrcLineData%M,2) - i3_l = LBOUND(SrcLineData%M,3) - i3_u = UBOUND(SrcLineData%M,3) - IF (.NOT. ALLOCATED(DstLineData%M)) THEN - ALLOCATE(DstLineData%M(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%M.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%M = SrcLineData%M -ENDIF - DstLineData%EndMomentA = SrcLineData%EndMomentA - DstLineData%EndMomentB = SrcLineData%EndMomentB - DstLineData%LineUnOut = SrcLineData%LineUnOut -IF (ALLOCATED(SrcLineData%LineWrOutput)) THEN - i1_l = LBOUND(SrcLineData%LineWrOutput,1) - i1_u = UBOUND(SrcLineData%LineWrOutput,1) - IF (.NOT. ALLOCATED(DstLineData%LineWrOutput)) THEN - ALLOCATE(DstLineData%LineWrOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%LineWrOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%LineWrOutput = SrcLineData%LineWrOutput -ENDIF - END SUBROUTINE MD_CopyLine - SUBROUTINE MD_DestroyLine( LineData, ErrStat, ErrMsg ) - TYPE(MD_Line), INTENT(INOUT) :: LineData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyLine' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(LineData%r)) THEN - DEALLOCATE(LineData%r) -ENDIF -IF (ALLOCATED(LineData%rd)) THEN - DEALLOCATE(LineData%rd) -ENDIF -IF (ALLOCATED(LineData%q)) THEN - DEALLOCATE(LineData%q) -ENDIF -IF (ALLOCATED(LineData%qs)) THEN - DEALLOCATE(LineData%qs) -ENDIF -IF (ALLOCATED(LineData%l)) THEN - DEALLOCATE(LineData%l) -ENDIF -IF (ALLOCATED(LineData%ld)) THEN - DEALLOCATE(LineData%ld) -ENDIF -IF (ALLOCATED(LineData%lstr)) THEN - DEALLOCATE(LineData%lstr) -ENDIF -IF (ALLOCATED(LineData%lstrd)) THEN - DEALLOCATE(LineData%lstrd) -ENDIF -IF (ALLOCATED(LineData%Kurv)) THEN - DEALLOCATE(LineData%Kurv) -ENDIF -IF (ALLOCATED(LineData%dl_1)) THEN - DEALLOCATE(LineData%dl_1) -ENDIF -IF (ALLOCATED(LineData%V)) THEN - DEALLOCATE(LineData%V) -ENDIF -IF (ALLOCATED(LineData%U)) THEN - DEALLOCATE(LineData%U) -ENDIF -IF (ALLOCATED(LineData%Ud)) THEN - DEALLOCATE(LineData%Ud) -ENDIF -IF (ALLOCATED(LineData%zeta)) THEN - DEALLOCATE(LineData%zeta) -ENDIF -IF (ALLOCATED(LineData%PDyn)) THEN - DEALLOCATE(LineData%PDyn) -ENDIF -IF (ALLOCATED(LineData%T)) THEN - DEALLOCATE(LineData%T) -ENDIF -IF (ALLOCATED(LineData%Td)) THEN - DEALLOCATE(LineData%Td) -ENDIF -IF (ALLOCATED(LineData%W)) THEN - DEALLOCATE(LineData%W) -ENDIF -IF (ALLOCATED(LineData%Dp)) THEN - DEALLOCATE(LineData%Dp) -ENDIF -IF (ALLOCATED(LineData%Dq)) THEN - DEALLOCATE(LineData%Dq) -ENDIF -IF (ALLOCATED(LineData%Ap)) THEN - DEALLOCATE(LineData%Ap) -ENDIF -IF (ALLOCATED(LineData%Aq)) THEN - DEALLOCATE(LineData%Aq) -ENDIF -IF (ALLOCATED(LineData%B)) THEN - DEALLOCATE(LineData%B) -ENDIF -IF (ALLOCATED(LineData%Bs)) THEN - DEALLOCATE(LineData%Bs) -ENDIF -IF (ALLOCATED(LineData%Fnet)) THEN - DEALLOCATE(LineData%Fnet) -ENDIF -IF (ALLOCATED(LineData%S)) THEN - DEALLOCATE(LineData%S) -ENDIF -IF (ALLOCATED(LineData%M)) THEN - DEALLOCATE(LineData%M) -ENDIF -IF (ALLOCATED(LineData%LineWrOutput)) THEN - DEALLOCATE(LineData%LineWrOutput) -ENDIF - END SUBROUTINE MD_DestroyLine +subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) + type(MD_Line), intent(in) :: SrcLineData + type(MD_Line), intent(inout) :: DstLineData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'MD_CopyLine' + ErrStat = ErrID_None + ErrMsg = '' + DstLineData%IdNum = SrcLineData%IdNum + DstLineData%PropsIdNum = SrcLineData%PropsIdNum + DstLineData%ElasticMod = SrcLineData%ElasticMod + DstLineData%OutFlagList = SrcLineData%OutFlagList + DstLineData%CtrlChan = SrcLineData%CtrlChan + DstLineData%FairConnect = SrcLineData%FairConnect + DstLineData%AnchConnect = SrcLineData%AnchConnect + DstLineData%N = SrcLineData%N + DstLineData%endTypeA = SrcLineData%endTypeA + DstLineData%endTypeB = SrcLineData%endTypeB + DstLineData%UnstrLen = SrcLineData%UnstrLen + DstLineData%rho = SrcLineData%rho + DstLineData%d = SrcLineData%d + DstLineData%EA = SrcLineData%EA + DstLineData%EA_D = SrcLineData%EA_D + DstLineData%BA = SrcLineData%BA + DstLineData%BA_D = SrcLineData%BA_D + DstLineData%EI = SrcLineData%EI + DstLineData%Can = SrcLineData%Can + DstLineData%Cat = SrcLineData%Cat + DstLineData%Cdn = SrcLineData%Cdn + DstLineData%Cdt = SrcLineData%Cdt + DstLineData%nEApoints = SrcLineData%nEApoints + DstLineData%stiffXs = SrcLineData%stiffXs + DstLineData%stiffYs = SrcLineData%stiffYs + DstLineData%nBApoints = SrcLineData%nBApoints + DstLineData%dampXs = SrcLineData%dampXs + DstLineData%dampYs = SrcLineData%dampYs + DstLineData%nEIpoints = SrcLineData%nEIpoints + DstLineData%bstiffXs = SrcLineData%bstiffXs + DstLineData%bstiffYs = SrcLineData%bstiffYs + DstLineData%time = SrcLineData%time + if (allocated(SrcLineData%r)) then + LB(1:2) = lbound(SrcLineData%r) + UB(1:2) = ubound(SrcLineData%r) + if (.not. allocated(DstLineData%r)) then + allocate(DstLineData%r(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%r.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%r = SrcLineData%r + else if (allocated(DstLineData%r)) then + deallocate(DstLineData%r) + end if + if (allocated(SrcLineData%rd)) then + LB(1:2) = lbound(SrcLineData%rd) + UB(1:2) = ubound(SrcLineData%rd) + if (.not. allocated(DstLineData%rd)) then + allocate(DstLineData%rd(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%rd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%rd = SrcLineData%rd + else if (allocated(DstLineData%rd)) then + deallocate(DstLineData%rd) + end if + if (allocated(SrcLineData%q)) then + LB(1:2) = lbound(SrcLineData%q) + UB(1:2) = ubound(SrcLineData%q) + if (.not. allocated(DstLineData%q)) then + allocate(DstLineData%q(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%q.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%q = SrcLineData%q + else if (allocated(DstLineData%q)) then + deallocate(DstLineData%q) + end if + if (allocated(SrcLineData%qs)) then + LB(1:2) = lbound(SrcLineData%qs) + UB(1:2) = ubound(SrcLineData%qs) + if (.not. allocated(DstLineData%qs)) then + allocate(DstLineData%qs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%qs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%qs = SrcLineData%qs + else if (allocated(DstLineData%qs)) then + deallocate(DstLineData%qs) + end if + if (allocated(SrcLineData%l)) then + LB(1:1) = lbound(SrcLineData%l) + UB(1:1) = ubound(SrcLineData%l) + if (.not. allocated(DstLineData%l)) then + allocate(DstLineData%l(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%l.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%l = SrcLineData%l + else if (allocated(DstLineData%l)) then + deallocate(DstLineData%l) + end if + if (allocated(SrcLineData%ld)) then + LB(1:1) = lbound(SrcLineData%ld) + UB(1:1) = ubound(SrcLineData%ld) + if (.not. allocated(DstLineData%ld)) then + allocate(DstLineData%ld(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%ld.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%ld = SrcLineData%ld + else if (allocated(DstLineData%ld)) then + deallocate(DstLineData%ld) + end if + if (allocated(SrcLineData%lstr)) then + LB(1:1) = lbound(SrcLineData%lstr) + UB(1:1) = ubound(SrcLineData%lstr) + if (.not. allocated(DstLineData%lstr)) then + allocate(DstLineData%lstr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%lstr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%lstr = SrcLineData%lstr + else if (allocated(DstLineData%lstr)) then + deallocate(DstLineData%lstr) + end if + if (allocated(SrcLineData%lstrd)) then + LB(1:1) = lbound(SrcLineData%lstrd) + UB(1:1) = ubound(SrcLineData%lstrd) + if (.not. allocated(DstLineData%lstrd)) then + allocate(DstLineData%lstrd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%lstrd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%lstrd = SrcLineData%lstrd + else if (allocated(DstLineData%lstrd)) then + deallocate(DstLineData%lstrd) + end if + if (allocated(SrcLineData%Kurv)) then + LB(1:1) = lbound(SrcLineData%Kurv) + UB(1:1) = ubound(SrcLineData%Kurv) + if (.not. allocated(DstLineData%Kurv)) then + allocate(DstLineData%Kurv(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Kurv.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%Kurv = SrcLineData%Kurv + else if (allocated(DstLineData%Kurv)) then + deallocate(DstLineData%Kurv) + end if + if (allocated(SrcLineData%dl_1)) then + LB(1:1) = lbound(SrcLineData%dl_1) + UB(1:1) = ubound(SrcLineData%dl_1) + if (.not. allocated(DstLineData%dl_1)) then + allocate(DstLineData%dl_1(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%dl_1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%dl_1 = SrcLineData%dl_1 + else if (allocated(DstLineData%dl_1)) then + deallocate(DstLineData%dl_1) + end if + if (allocated(SrcLineData%V)) then + LB(1:1) = lbound(SrcLineData%V) + UB(1:1) = ubound(SrcLineData%V) + if (.not. allocated(DstLineData%V)) then + allocate(DstLineData%V(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%V.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%V = SrcLineData%V + else if (allocated(DstLineData%V)) then + deallocate(DstLineData%V) + end if + if (allocated(SrcLineData%U)) then + LB(1:2) = lbound(SrcLineData%U) + UB(1:2) = ubound(SrcLineData%U) + if (.not. allocated(DstLineData%U)) then + allocate(DstLineData%U(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%U.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%U = SrcLineData%U + else if (allocated(DstLineData%U)) then + deallocate(DstLineData%U) + end if + if (allocated(SrcLineData%Ud)) then + LB(1:2) = lbound(SrcLineData%Ud) + UB(1:2) = ubound(SrcLineData%Ud) + if (.not. allocated(DstLineData%Ud)) then + allocate(DstLineData%Ud(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Ud.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%Ud = SrcLineData%Ud + else if (allocated(DstLineData%Ud)) then + deallocate(DstLineData%Ud) + end if + if (allocated(SrcLineData%zeta)) then + LB(1:1) = lbound(SrcLineData%zeta) + UB(1:1) = ubound(SrcLineData%zeta) + if (.not. allocated(DstLineData%zeta)) then + allocate(DstLineData%zeta(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%zeta.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%zeta = SrcLineData%zeta + else if (allocated(DstLineData%zeta)) then + deallocate(DstLineData%zeta) + end if + if (allocated(SrcLineData%PDyn)) then + LB(1:1) = lbound(SrcLineData%PDyn) + UB(1:1) = ubound(SrcLineData%PDyn) + if (.not. allocated(DstLineData%PDyn)) then + allocate(DstLineData%PDyn(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%PDyn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%PDyn = SrcLineData%PDyn + else if (allocated(DstLineData%PDyn)) then + deallocate(DstLineData%PDyn) + end if + if (allocated(SrcLineData%T)) then + LB(1:2) = lbound(SrcLineData%T) + UB(1:2) = ubound(SrcLineData%T) + if (.not. allocated(DstLineData%T)) then + allocate(DstLineData%T(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%T.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%T = SrcLineData%T + else if (allocated(DstLineData%T)) then + deallocate(DstLineData%T) + end if + if (allocated(SrcLineData%Td)) then + LB(1:2) = lbound(SrcLineData%Td) + UB(1:2) = ubound(SrcLineData%Td) + if (.not. allocated(DstLineData%Td)) then + allocate(DstLineData%Td(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Td.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%Td = SrcLineData%Td + else if (allocated(DstLineData%Td)) then + deallocate(DstLineData%Td) + end if + if (allocated(SrcLineData%W)) then + LB(1:2) = lbound(SrcLineData%W) + UB(1:2) = ubound(SrcLineData%W) + if (.not. allocated(DstLineData%W)) then + allocate(DstLineData%W(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%W.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%W = SrcLineData%W + else if (allocated(DstLineData%W)) then + deallocate(DstLineData%W) + end if + if (allocated(SrcLineData%Dp)) then + LB(1:2) = lbound(SrcLineData%Dp) + UB(1:2) = ubound(SrcLineData%Dp) + if (.not. allocated(DstLineData%Dp)) then + allocate(DstLineData%Dp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Dp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%Dp = SrcLineData%Dp + else if (allocated(DstLineData%Dp)) then + deallocate(DstLineData%Dp) + end if + if (allocated(SrcLineData%Dq)) then + LB(1:2) = lbound(SrcLineData%Dq) + UB(1:2) = ubound(SrcLineData%Dq) + if (.not. allocated(DstLineData%Dq)) then + allocate(DstLineData%Dq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Dq.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%Dq = SrcLineData%Dq + else if (allocated(DstLineData%Dq)) then + deallocate(DstLineData%Dq) + end if + if (allocated(SrcLineData%Ap)) then + LB(1:2) = lbound(SrcLineData%Ap) + UB(1:2) = ubound(SrcLineData%Ap) + if (.not. allocated(DstLineData%Ap)) then + allocate(DstLineData%Ap(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Ap.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%Ap = SrcLineData%Ap + else if (allocated(DstLineData%Ap)) then + deallocate(DstLineData%Ap) + end if + if (allocated(SrcLineData%Aq)) then + LB(1:2) = lbound(SrcLineData%Aq) + UB(1:2) = ubound(SrcLineData%Aq) + if (.not. allocated(DstLineData%Aq)) then + allocate(DstLineData%Aq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Aq.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%Aq = SrcLineData%Aq + else if (allocated(DstLineData%Aq)) then + deallocate(DstLineData%Aq) + end if + if (allocated(SrcLineData%B)) then + LB(1:2) = lbound(SrcLineData%B) + UB(1:2) = ubound(SrcLineData%B) + if (.not. allocated(DstLineData%B)) then + allocate(DstLineData%B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%B = SrcLineData%B + else if (allocated(DstLineData%B)) then + deallocate(DstLineData%B) + end if + if (allocated(SrcLineData%Bs)) then + LB(1:2) = lbound(SrcLineData%Bs) + UB(1:2) = ubound(SrcLineData%Bs) + if (.not. allocated(DstLineData%Bs)) then + allocate(DstLineData%Bs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Bs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%Bs = SrcLineData%Bs + else if (allocated(DstLineData%Bs)) then + deallocate(DstLineData%Bs) + end if + if (allocated(SrcLineData%Fnet)) then + LB(1:2) = lbound(SrcLineData%Fnet) + UB(1:2) = ubound(SrcLineData%Fnet) + if (.not. allocated(DstLineData%Fnet)) then + allocate(DstLineData%Fnet(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Fnet.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%Fnet = SrcLineData%Fnet + else if (allocated(DstLineData%Fnet)) then + deallocate(DstLineData%Fnet) + end if + if (allocated(SrcLineData%S)) then + LB(1:3) = lbound(SrcLineData%S) + UB(1:3) = ubound(SrcLineData%S) + if (.not. allocated(DstLineData%S)) then + allocate(DstLineData%S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%S.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%S = SrcLineData%S + else if (allocated(DstLineData%S)) then + deallocate(DstLineData%S) + end if + if (allocated(SrcLineData%M)) then + LB(1:3) = lbound(SrcLineData%M) + UB(1:3) = ubound(SrcLineData%M) + if (.not. allocated(DstLineData%M)) then + allocate(DstLineData%M(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%M.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%M = SrcLineData%M + else if (allocated(DstLineData%M)) then + deallocate(DstLineData%M) + end if + DstLineData%EndMomentA = SrcLineData%EndMomentA + DstLineData%EndMomentB = SrcLineData%EndMomentB + DstLineData%LineUnOut = SrcLineData%LineUnOut + if (allocated(SrcLineData%LineWrOutput)) then + LB(1:1) = lbound(SrcLineData%LineWrOutput) + UB(1:1) = ubound(SrcLineData%LineWrOutput) + if (.not. allocated(DstLineData%LineWrOutput)) then + allocate(DstLineData%LineWrOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%LineWrOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLineData%LineWrOutput = SrcLineData%LineWrOutput + else if (allocated(DstLineData%LineWrOutput)) then + deallocate(DstLineData%LineWrOutput) + end if +end subroutine +subroutine MD_DestroyLine(LineData, ErrStat, ErrMsg) + type(MD_Line), intent(inout) :: LineData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_DestroyLine' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(LineData%r)) then + deallocate(LineData%r) + end if + if (allocated(LineData%rd)) then + deallocate(LineData%rd) + end if + if (allocated(LineData%q)) then + deallocate(LineData%q) + end if + if (allocated(LineData%qs)) then + deallocate(LineData%qs) + end if + if (allocated(LineData%l)) then + deallocate(LineData%l) + end if + if (allocated(LineData%ld)) then + deallocate(LineData%ld) + end if + if (allocated(LineData%lstr)) then + deallocate(LineData%lstr) + end if + if (allocated(LineData%lstrd)) then + deallocate(LineData%lstrd) + end if + if (allocated(LineData%Kurv)) then + deallocate(LineData%Kurv) + end if + if (allocated(LineData%dl_1)) then + deallocate(LineData%dl_1) + end if + if (allocated(LineData%V)) then + deallocate(LineData%V) + end if + if (allocated(LineData%U)) then + deallocate(LineData%U) + end if + if (allocated(LineData%Ud)) then + deallocate(LineData%Ud) + end if + if (allocated(LineData%zeta)) then + deallocate(LineData%zeta) + end if + if (allocated(LineData%PDyn)) then + deallocate(LineData%PDyn) + end if + if (allocated(LineData%T)) then + deallocate(LineData%T) + end if + if (allocated(LineData%Td)) then + deallocate(LineData%Td) + end if + if (allocated(LineData%W)) then + deallocate(LineData%W) + end if + if (allocated(LineData%Dp)) then + deallocate(LineData%Dp) + end if + if (allocated(LineData%Dq)) then + deallocate(LineData%Dq) + end if + if (allocated(LineData%Ap)) then + deallocate(LineData%Ap) + end if + if (allocated(LineData%Aq)) then + deallocate(LineData%Aq) + end if + if (allocated(LineData%B)) then + deallocate(LineData%B) + end if + if (allocated(LineData%Bs)) then + deallocate(LineData%Bs) + end if + if (allocated(LineData%Fnet)) then + deallocate(LineData%Fnet) + end if + if (allocated(LineData%S)) then + deallocate(LineData%S) + end if + if (allocated(LineData%M)) then + deallocate(LineData%M) + end if + if (allocated(LineData%LineWrOutput)) then + deallocate(LineData%LineWrOutput) + end if +end subroutine subroutine MD_PackLine(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(MD_Line), intent(in) :: InData character(*), parameter :: RoutineName = 'MD_PackLine' if (Buf%ErrStat >= AbortErrLev) return - ! IdNum call RegPack(Buf, InData%IdNum) if (RegCheckErr(Buf, RoutineName)) return - ! PropsIdNum call RegPack(Buf, InData%PropsIdNum) if (RegCheckErr(Buf, RoutineName)) return - ! ElasticMod call RegPack(Buf, InData%ElasticMod) if (RegCheckErr(Buf, RoutineName)) return - ! OutFlagList call RegPack(Buf, InData%OutFlagList) if (RegCheckErr(Buf, RoutineName)) return - ! CtrlChan call RegPack(Buf, InData%CtrlChan) if (RegCheckErr(Buf, RoutineName)) return - ! FairConnect call RegPack(Buf, InData%FairConnect) if (RegCheckErr(Buf, RoutineName)) return - ! AnchConnect call RegPack(Buf, InData%AnchConnect) if (RegCheckErr(Buf, RoutineName)) return - ! N call RegPack(Buf, InData%N) if (RegCheckErr(Buf, RoutineName)) return - ! endTypeA call RegPack(Buf, InData%endTypeA) if (RegCheckErr(Buf, RoutineName)) return - ! endTypeB call RegPack(Buf, InData%endTypeB) if (RegCheckErr(Buf, RoutineName)) return - ! UnstrLen call RegPack(Buf, InData%UnstrLen) if (RegCheckErr(Buf, RoutineName)) return - ! rho call RegPack(Buf, InData%rho) if (RegCheckErr(Buf, RoutineName)) return - ! d call RegPack(Buf, InData%d) if (RegCheckErr(Buf, RoutineName)) return - ! EA call RegPack(Buf, InData%EA) if (RegCheckErr(Buf, RoutineName)) return - ! EA_D call RegPack(Buf, InData%EA_D) if (RegCheckErr(Buf, RoutineName)) return - ! BA call RegPack(Buf, InData%BA) if (RegCheckErr(Buf, RoutineName)) return - ! BA_D call RegPack(Buf, InData%BA_D) if (RegCheckErr(Buf, RoutineName)) return - ! EI call RegPack(Buf, InData%EI) if (RegCheckErr(Buf, RoutineName)) return - ! Can call RegPack(Buf, InData%Can) if (RegCheckErr(Buf, RoutineName)) return - ! Cat call RegPack(Buf, InData%Cat) if (RegCheckErr(Buf, RoutineName)) return - ! Cdn call RegPack(Buf, InData%Cdn) if (RegCheckErr(Buf, RoutineName)) return - ! Cdt call RegPack(Buf, InData%Cdt) if (RegCheckErr(Buf, RoutineName)) return - ! nEApoints call RegPack(Buf, InData%nEApoints) if (RegCheckErr(Buf, RoutineName)) return - ! stiffXs call RegPack(Buf, InData%stiffXs) if (RegCheckErr(Buf, RoutineName)) return - ! stiffYs call RegPack(Buf, InData%stiffYs) if (RegCheckErr(Buf, RoutineName)) return - ! nBApoints call RegPack(Buf, InData%nBApoints) if (RegCheckErr(Buf, RoutineName)) return - ! dampXs call RegPack(Buf, InData%dampXs) if (RegCheckErr(Buf, RoutineName)) return - ! dampYs call RegPack(Buf, InData%dampYs) if (RegCheckErr(Buf, RoutineName)) return - ! nEIpoints call RegPack(Buf, InData%nEIpoints) if (RegCheckErr(Buf, RoutineName)) return - ! bstiffXs call RegPack(Buf, InData%bstiffXs) if (RegCheckErr(Buf, RoutineName)) return - ! bstiffYs call RegPack(Buf, InData%bstiffYs) if (RegCheckErr(Buf, RoutineName)) return - ! time call RegPack(Buf, InData%time) if (RegCheckErr(Buf, RoutineName)) return - ! r call RegPack(Buf, allocated(InData%r)) if (allocated(InData%r)) then call RegPackBounds(Buf, 2, lbound(InData%r), ubound(InData%r)) call RegPack(Buf, InData%r) end if if (RegCheckErr(Buf, RoutineName)) return - ! rd call RegPack(Buf, allocated(InData%rd)) if (allocated(InData%rd)) then call RegPackBounds(Buf, 2, lbound(InData%rd), ubound(InData%rd)) call RegPack(Buf, InData%rd) end if if (RegCheckErr(Buf, RoutineName)) return - ! q call RegPack(Buf, allocated(InData%q)) if (allocated(InData%q)) then call RegPackBounds(Buf, 2, lbound(InData%q), ubound(InData%q)) call RegPack(Buf, InData%q) end if if (RegCheckErr(Buf, RoutineName)) return - ! qs call RegPack(Buf, allocated(InData%qs)) if (allocated(InData%qs)) then call RegPackBounds(Buf, 2, lbound(InData%qs), ubound(InData%qs)) call RegPack(Buf, InData%qs) end if if (RegCheckErr(Buf, RoutineName)) return - ! l call RegPack(Buf, allocated(InData%l)) if (allocated(InData%l)) then call RegPackBounds(Buf, 1, lbound(InData%l), ubound(InData%l)) call RegPack(Buf, InData%l) end if if (RegCheckErr(Buf, RoutineName)) return - ! ld call RegPack(Buf, allocated(InData%ld)) if (allocated(InData%ld)) then call RegPackBounds(Buf, 1, lbound(InData%ld), ubound(InData%ld)) call RegPack(Buf, InData%ld) end if if (RegCheckErr(Buf, RoutineName)) return - ! lstr call RegPack(Buf, allocated(InData%lstr)) if (allocated(InData%lstr)) then call RegPackBounds(Buf, 1, lbound(InData%lstr), ubound(InData%lstr)) call RegPack(Buf, InData%lstr) end if if (RegCheckErr(Buf, RoutineName)) return - ! lstrd call RegPack(Buf, allocated(InData%lstrd)) if (allocated(InData%lstrd)) then call RegPackBounds(Buf, 1, lbound(InData%lstrd), ubound(InData%lstrd)) call RegPack(Buf, InData%lstrd) end if if (RegCheckErr(Buf, RoutineName)) return - ! Kurv call RegPack(Buf, allocated(InData%Kurv)) if (allocated(InData%Kurv)) then call RegPackBounds(Buf, 1, lbound(InData%Kurv), ubound(InData%Kurv)) call RegPack(Buf, InData%Kurv) end if if (RegCheckErr(Buf, RoutineName)) return - ! dl_1 call RegPack(Buf, allocated(InData%dl_1)) if (allocated(InData%dl_1)) then call RegPackBounds(Buf, 1, lbound(InData%dl_1), ubound(InData%dl_1)) call RegPack(Buf, InData%dl_1) end if if (RegCheckErr(Buf, RoutineName)) return - ! V call RegPack(Buf, allocated(InData%V)) if (allocated(InData%V)) then call RegPackBounds(Buf, 1, lbound(InData%V), ubound(InData%V)) call RegPack(Buf, InData%V) end if if (RegCheckErr(Buf, RoutineName)) return - ! U call RegPack(Buf, allocated(InData%U)) if (allocated(InData%U)) then call RegPackBounds(Buf, 2, lbound(InData%U), ubound(InData%U)) call RegPack(Buf, InData%U) end if if (RegCheckErr(Buf, RoutineName)) return - ! Ud call RegPack(Buf, allocated(InData%Ud)) if (allocated(InData%Ud)) then call RegPackBounds(Buf, 2, lbound(InData%Ud), ubound(InData%Ud)) call RegPack(Buf, InData%Ud) end if if (RegCheckErr(Buf, RoutineName)) return - ! zeta call RegPack(Buf, allocated(InData%zeta)) if (allocated(InData%zeta)) then call RegPackBounds(Buf, 1, lbound(InData%zeta), ubound(InData%zeta)) call RegPack(Buf, InData%zeta) end if if (RegCheckErr(Buf, RoutineName)) return - ! PDyn call RegPack(Buf, allocated(InData%PDyn)) if (allocated(InData%PDyn)) then call RegPackBounds(Buf, 1, lbound(InData%PDyn), ubound(InData%PDyn)) call RegPack(Buf, InData%PDyn) end if if (RegCheckErr(Buf, RoutineName)) return - ! T call RegPack(Buf, allocated(InData%T)) if (allocated(InData%T)) then call RegPackBounds(Buf, 2, lbound(InData%T), ubound(InData%T)) call RegPack(Buf, InData%T) end if if (RegCheckErr(Buf, RoutineName)) return - ! Td call RegPack(Buf, allocated(InData%Td)) if (allocated(InData%Td)) then call RegPackBounds(Buf, 2, lbound(InData%Td), ubound(InData%Td)) call RegPack(Buf, InData%Td) end if if (RegCheckErr(Buf, RoutineName)) return - ! W call RegPack(Buf, allocated(InData%W)) if (allocated(InData%W)) then call RegPackBounds(Buf, 2, lbound(InData%W), ubound(InData%W)) call RegPack(Buf, InData%W) end if if (RegCheckErr(Buf, RoutineName)) return - ! Dp call RegPack(Buf, allocated(InData%Dp)) if (allocated(InData%Dp)) then call RegPackBounds(Buf, 2, lbound(InData%Dp), ubound(InData%Dp)) call RegPack(Buf, InData%Dp) end if if (RegCheckErr(Buf, RoutineName)) return - ! Dq call RegPack(Buf, allocated(InData%Dq)) if (allocated(InData%Dq)) then call RegPackBounds(Buf, 2, lbound(InData%Dq), ubound(InData%Dq)) call RegPack(Buf, InData%Dq) end if if (RegCheckErr(Buf, RoutineName)) return - ! Ap call RegPack(Buf, allocated(InData%Ap)) if (allocated(InData%Ap)) then call RegPackBounds(Buf, 2, lbound(InData%Ap), ubound(InData%Ap)) call RegPack(Buf, InData%Ap) end if if (RegCheckErr(Buf, RoutineName)) return - ! Aq call RegPack(Buf, allocated(InData%Aq)) if (allocated(InData%Aq)) then call RegPackBounds(Buf, 2, lbound(InData%Aq), ubound(InData%Aq)) call RegPack(Buf, InData%Aq) end if if (RegCheckErr(Buf, RoutineName)) return - ! B call RegPack(Buf, allocated(InData%B)) if (allocated(InData%B)) then call RegPackBounds(Buf, 2, lbound(InData%B), ubound(InData%B)) call RegPack(Buf, InData%B) end if if (RegCheckErr(Buf, RoutineName)) return - ! Bs call RegPack(Buf, allocated(InData%Bs)) if (allocated(InData%Bs)) then call RegPackBounds(Buf, 2, lbound(InData%Bs), ubound(InData%Bs)) call RegPack(Buf, InData%Bs) end if if (RegCheckErr(Buf, RoutineName)) return - ! Fnet call RegPack(Buf, allocated(InData%Fnet)) if (allocated(InData%Fnet)) then call RegPackBounds(Buf, 2, lbound(InData%Fnet), ubound(InData%Fnet)) call RegPack(Buf, InData%Fnet) end if if (RegCheckErr(Buf, RoutineName)) return - ! S call RegPack(Buf, allocated(InData%S)) if (allocated(InData%S)) then call RegPackBounds(Buf, 3, lbound(InData%S), ubound(InData%S)) call RegPack(Buf, InData%S) end if if (RegCheckErr(Buf, RoutineName)) return - ! M call RegPack(Buf, allocated(InData%M)) if (allocated(InData%M)) then call RegPackBounds(Buf, 3, lbound(InData%M), ubound(InData%M)) call RegPack(Buf, InData%M) end if if (RegCheckErr(Buf, RoutineName)) return - ! EndMomentA call RegPack(Buf, InData%EndMomentA) if (RegCheckErr(Buf, RoutineName)) return - ! EndMomentB call RegPack(Buf, InData%EndMomentB) if (RegCheckErr(Buf, RoutineName)) return - ! LineUnOut call RegPack(Buf, InData%LineUnOut) if (RegCheckErr(Buf, RoutineName)) return - ! LineWrOutput call RegPack(Buf, allocated(InData%LineWrOutput)) if (allocated(InData%LineWrOutput)) then call RegPackBounds(Buf, 1, lbound(InData%LineWrOutput), ubound(InData%LineWrOutput)) @@ -3475,103 +3032,70 @@ subroutine MD_UnPackLine(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! IdNum call RegUnpack(Buf, OutData%IdNum) if (RegCheckErr(Buf, RoutineName)) return - ! PropsIdNum call RegUnpack(Buf, OutData%PropsIdNum) if (RegCheckErr(Buf, RoutineName)) return - ! ElasticMod call RegUnpack(Buf, OutData%ElasticMod) if (RegCheckErr(Buf, RoutineName)) return - ! OutFlagList call RegUnpack(Buf, OutData%OutFlagList) if (RegCheckErr(Buf, RoutineName)) return - ! CtrlChan call RegUnpack(Buf, OutData%CtrlChan) if (RegCheckErr(Buf, RoutineName)) return - ! FairConnect call RegUnpack(Buf, OutData%FairConnect) if (RegCheckErr(Buf, RoutineName)) return - ! AnchConnect call RegUnpack(Buf, OutData%AnchConnect) if (RegCheckErr(Buf, RoutineName)) return - ! N call RegUnpack(Buf, OutData%N) if (RegCheckErr(Buf, RoutineName)) return - ! endTypeA call RegUnpack(Buf, OutData%endTypeA) if (RegCheckErr(Buf, RoutineName)) return - ! endTypeB call RegUnpack(Buf, OutData%endTypeB) if (RegCheckErr(Buf, RoutineName)) return - ! UnstrLen call RegUnpack(Buf, OutData%UnstrLen) if (RegCheckErr(Buf, RoutineName)) return - ! rho call RegUnpack(Buf, OutData%rho) if (RegCheckErr(Buf, RoutineName)) return - ! d call RegUnpack(Buf, OutData%d) if (RegCheckErr(Buf, RoutineName)) return - ! EA call RegUnpack(Buf, OutData%EA) if (RegCheckErr(Buf, RoutineName)) return - ! EA_D call RegUnpack(Buf, OutData%EA_D) if (RegCheckErr(Buf, RoutineName)) return - ! BA call RegUnpack(Buf, OutData%BA) if (RegCheckErr(Buf, RoutineName)) return - ! BA_D call RegUnpack(Buf, OutData%BA_D) if (RegCheckErr(Buf, RoutineName)) return - ! EI call RegUnpack(Buf, OutData%EI) if (RegCheckErr(Buf, RoutineName)) return - ! Can call RegUnpack(Buf, OutData%Can) if (RegCheckErr(Buf, RoutineName)) return - ! Cat call RegUnpack(Buf, OutData%Cat) if (RegCheckErr(Buf, RoutineName)) return - ! Cdn call RegUnpack(Buf, OutData%Cdn) if (RegCheckErr(Buf, RoutineName)) return - ! Cdt call RegUnpack(Buf, OutData%Cdt) if (RegCheckErr(Buf, RoutineName)) return - ! nEApoints call RegUnpack(Buf, OutData%nEApoints) if (RegCheckErr(Buf, RoutineName)) return - ! stiffXs call RegUnpack(Buf, OutData%stiffXs) if (RegCheckErr(Buf, RoutineName)) return - ! stiffYs call RegUnpack(Buf, OutData%stiffYs) if (RegCheckErr(Buf, RoutineName)) return - ! nBApoints call RegUnpack(Buf, OutData%nBApoints) if (RegCheckErr(Buf, RoutineName)) return - ! dampXs call RegUnpack(Buf, OutData%dampXs) if (RegCheckErr(Buf, RoutineName)) return - ! dampYs call RegUnpack(Buf, OutData%dampYs) if (RegCheckErr(Buf, RoutineName)) return - ! nEIpoints call RegUnpack(Buf, OutData%nEIpoints) if (RegCheckErr(Buf, RoutineName)) return - ! bstiffXs call RegUnpack(Buf, OutData%bstiffXs) if (RegCheckErr(Buf, RoutineName)) return - ! bstiffYs call RegUnpack(Buf, OutData%bstiffYs) if (RegCheckErr(Buf, RoutineName)) return - ! time call RegUnpack(Buf, OutData%time) if (RegCheckErr(Buf, RoutineName)) return - ! r if (allocated(OutData%r)) deallocate(OutData%r) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3586,7 +3110,6 @@ subroutine MD_UnPackLine(Buf, OutData) call RegUnpack(Buf, OutData%r) if (RegCheckErr(Buf, RoutineName)) return end if - ! rd if (allocated(OutData%rd)) deallocate(OutData%rd) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3601,7 +3124,6 @@ subroutine MD_UnPackLine(Buf, OutData) call RegUnpack(Buf, OutData%rd) if (RegCheckErr(Buf, RoutineName)) return end if - ! q if (allocated(OutData%q)) deallocate(OutData%q) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3616,7 +3138,6 @@ subroutine MD_UnPackLine(Buf, OutData) call RegUnpack(Buf, OutData%q) if (RegCheckErr(Buf, RoutineName)) return end if - ! qs if (allocated(OutData%qs)) deallocate(OutData%qs) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3631,7 +3152,6 @@ subroutine MD_UnPackLine(Buf, OutData) call RegUnpack(Buf, OutData%qs) if (RegCheckErr(Buf, RoutineName)) return end if - ! l if (allocated(OutData%l)) deallocate(OutData%l) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3646,7 +3166,6 @@ subroutine MD_UnPackLine(Buf, OutData) call RegUnpack(Buf, OutData%l) if (RegCheckErr(Buf, RoutineName)) return end if - ! ld if (allocated(OutData%ld)) deallocate(OutData%ld) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3661,7 +3180,6 @@ subroutine MD_UnPackLine(Buf, OutData) call RegUnpack(Buf, OutData%ld) if (RegCheckErr(Buf, RoutineName)) return end if - ! lstr if (allocated(OutData%lstr)) deallocate(OutData%lstr) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3676,7 +3194,6 @@ subroutine MD_UnPackLine(Buf, OutData) call RegUnpack(Buf, OutData%lstr) if (RegCheckErr(Buf, RoutineName)) return end if - ! lstrd if (allocated(OutData%lstrd)) deallocate(OutData%lstrd) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3691,7 +3208,6 @@ subroutine MD_UnPackLine(Buf, OutData) call RegUnpack(Buf, OutData%lstrd) if (RegCheckErr(Buf, RoutineName)) return end if - ! Kurv if (allocated(OutData%Kurv)) deallocate(OutData%Kurv) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3706,7 +3222,6 @@ subroutine MD_UnPackLine(Buf, OutData) call RegUnpack(Buf, OutData%Kurv) if (RegCheckErr(Buf, RoutineName)) return end if - ! dl_1 if (allocated(OutData%dl_1)) deallocate(OutData%dl_1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3721,7 +3236,6 @@ subroutine MD_UnPackLine(Buf, OutData) call RegUnpack(Buf, OutData%dl_1) if (RegCheckErr(Buf, RoutineName)) return end if - ! V if (allocated(OutData%V)) deallocate(OutData%V) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3736,7 +3250,6 @@ subroutine MD_UnPackLine(Buf, OutData) call RegUnpack(Buf, OutData%V) if (RegCheckErr(Buf, RoutineName)) return end if - ! U if (allocated(OutData%U)) deallocate(OutData%U) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3751,7 +3264,6 @@ subroutine MD_UnPackLine(Buf, OutData) call RegUnpack(Buf, OutData%U) if (RegCheckErr(Buf, RoutineName)) return end if - ! Ud if (allocated(OutData%Ud)) deallocate(OutData%Ud) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3766,7 +3278,6 @@ subroutine MD_UnPackLine(Buf, OutData) call RegUnpack(Buf, OutData%Ud) if (RegCheckErr(Buf, RoutineName)) return end if - ! zeta if (allocated(OutData%zeta)) deallocate(OutData%zeta) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3781,7 +3292,6 @@ subroutine MD_UnPackLine(Buf, OutData) call RegUnpack(Buf, OutData%zeta) if (RegCheckErr(Buf, RoutineName)) return end if - ! PDyn if (allocated(OutData%PDyn)) deallocate(OutData%PDyn) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3796,7 +3306,6 @@ subroutine MD_UnPackLine(Buf, OutData) call RegUnpack(Buf, OutData%PDyn) if (RegCheckErr(Buf, RoutineName)) return end if - ! T if (allocated(OutData%T)) deallocate(OutData%T) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3811,7 +3320,6 @@ subroutine MD_UnPackLine(Buf, OutData) call RegUnpack(Buf, OutData%T) if (RegCheckErr(Buf, RoutineName)) return end if - ! Td if (allocated(OutData%Td)) deallocate(OutData%Td) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3826,7 +3334,6 @@ subroutine MD_UnPackLine(Buf, OutData) call RegUnpack(Buf, OutData%Td) if (RegCheckErr(Buf, RoutineName)) return end if - ! W if (allocated(OutData%W)) deallocate(OutData%W) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3841,7 +3348,6 @@ subroutine MD_UnPackLine(Buf, OutData) call RegUnpack(Buf, OutData%W) if (RegCheckErr(Buf, RoutineName)) return end if - ! Dp if (allocated(OutData%Dp)) deallocate(OutData%Dp) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3856,7 +3362,6 @@ subroutine MD_UnPackLine(Buf, OutData) call RegUnpack(Buf, OutData%Dp) if (RegCheckErr(Buf, RoutineName)) return end if - ! Dq if (allocated(OutData%Dq)) deallocate(OutData%Dq) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3871,7 +3376,6 @@ subroutine MD_UnPackLine(Buf, OutData) call RegUnpack(Buf, OutData%Dq) if (RegCheckErr(Buf, RoutineName)) return end if - ! Ap if (allocated(OutData%Ap)) deallocate(OutData%Ap) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3886,7 +3390,6 @@ subroutine MD_UnPackLine(Buf, OutData) call RegUnpack(Buf, OutData%Ap) if (RegCheckErr(Buf, RoutineName)) return end if - ! Aq if (allocated(OutData%Aq)) deallocate(OutData%Aq) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3901,7 +3404,6 @@ subroutine MD_UnPackLine(Buf, OutData) call RegUnpack(Buf, OutData%Aq) if (RegCheckErr(Buf, RoutineName)) return end if - ! B if (allocated(OutData%B)) deallocate(OutData%B) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3916,7 +3418,6 @@ subroutine MD_UnPackLine(Buf, OutData) call RegUnpack(Buf, OutData%B) if (RegCheckErr(Buf, RoutineName)) return end if - ! Bs if (allocated(OutData%Bs)) deallocate(OutData%Bs) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3931,7 +3432,6 @@ subroutine MD_UnPackLine(Buf, OutData) call RegUnpack(Buf, OutData%Bs) if (RegCheckErr(Buf, RoutineName)) return end if - ! Fnet if (allocated(OutData%Fnet)) deallocate(OutData%Fnet) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3946,7 +3446,6 @@ subroutine MD_UnPackLine(Buf, OutData) call RegUnpack(Buf, OutData%Fnet) if (RegCheckErr(Buf, RoutineName)) return end if - ! S if (allocated(OutData%S)) deallocate(OutData%S) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3961,7 +3460,6 @@ subroutine MD_UnPackLine(Buf, OutData) call RegUnpack(Buf, OutData%S) if (RegCheckErr(Buf, RoutineName)) return end if - ! M if (allocated(OutData%M)) deallocate(OutData%M) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3976,16 +3474,12 @@ subroutine MD_UnPackLine(Buf, OutData) call RegUnpack(Buf, OutData%M) if (RegCheckErr(Buf, RoutineName)) return end if - ! EndMomentA call RegUnpack(Buf, OutData%EndMomentA) if (RegCheckErr(Buf, RoutineName)) return - ! EndMomentB call RegUnpack(Buf, OutData%EndMomentB) if (RegCheckErr(Buf, RoutineName)) return - ! LineUnOut call RegUnpack(Buf, OutData%LineUnOut) if (RegCheckErr(Buf, RoutineName)) return - ! LineWrOutput if (allocated(OutData%LineWrOutput)) deallocate(OutData%LineWrOutput) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4001,45 +3495,33 @@ subroutine MD_UnPackLine(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE MD_CopyFail( SrcFailData, DstFailData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_Fail), INTENT(IN) :: SrcFailData - TYPE(MD_Fail), INTENT(INOUT) :: DstFailData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyFail' -! - ErrStat = ErrID_None - ErrMsg = "" - DstFailData%IdNum = SrcFailData%IdNum - END SUBROUTINE MD_CopyFail - - SUBROUTINE MD_DestroyFail( FailData, ErrStat, ErrMsg ) - TYPE(MD_Fail), INTENT(INOUT) :: FailData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyFail' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE MD_DestroyFail +subroutine MD_CopyFail(SrcFailData, DstFailData, CtrlCode, ErrStat, ErrMsg) + type(MD_Fail), intent(in) :: SrcFailData + type(MD_Fail), intent(inout) :: DstFailData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_CopyFail' + ErrStat = ErrID_None + ErrMsg = '' + DstFailData%IdNum = SrcFailData%IdNum +end subroutine +subroutine MD_DestroyFail(FailData, ErrStat, ErrMsg) + type(MD_Fail), intent(inout) :: FailData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_DestroyFail' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine MD_PackFail(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(MD_Fail), intent(in) :: InData character(*), parameter :: RoutineName = 'MD_PackFail' if (Buf%ErrStat >= AbortErrLev) return - ! IdNum call RegPack(Buf, InData%IdNum) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -4049,69 +3531,51 @@ subroutine MD_UnPackFail(Buf, OutData) type(MD_Fail), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackFail' if (Buf%ErrStat /= ErrID_None) return - ! IdNum call RegUnpack(Buf, OutData%IdNum) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE MD_CopyOutParmType( SrcOutParmTypeData, DstOutParmTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_OutParmType), INTENT(IN) :: SrcOutParmTypeData - TYPE(MD_OutParmType), INTENT(INOUT) :: DstOutParmTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyOutParmType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOutParmTypeData%Name = SrcOutParmTypeData%Name - DstOutParmTypeData%Units = SrcOutParmTypeData%Units - DstOutParmTypeData%QType = SrcOutParmTypeData%QType - DstOutParmTypeData%OType = SrcOutParmTypeData%OType - DstOutParmTypeData%NodeID = SrcOutParmTypeData%NodeID - DstOutParmTypeData%ObjID = SrcOutParmTypeData%ObjID - END SUBROUTINE MD_CopyOutParmType - - SUBROUTINE MD_DestroyOutParmType( OutParmTypeData, ErrStat, ErrMsg ) - TYPE(MD_OutParmType), INTENT(INOUT) :: OutParmTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyOutParmType' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE MD_DestroyOutParmType +subroutine MD_CopyOutParmType(SrcOutParmTypeData, DstOutParmTypeData, CtrlCode, ErrStat, ErrMsg) + type(MD_OutParmType), intent(in) :: SrcOutParmTypeData + type(MD_OutParmType), intent(inout) :: DstOutParmTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_CopyOutParmType' + ErrStat = ErrID_None + ErrMsg = '' + DstOutParmTypeData%Name = SrcOutParmTypeData%Name + DstOutParmTypeData%Units = SrcOutParmTypeData%Units + DstOutParmTypeData%QType = SrcOutParmTypeData%QType + DstOutParmTypeData%OType = SrcOutParmTypeData%OType + DstOutParmTypeData%NodeID = SrcOutParmTypeData%NodeID + DstOutParmTypeData%ObjID = SrcOutParmTypeData%ObjID +end subroutine +subroutine MD_DestroyOutParmType(OutParmTypeData, ErrStat, ErrMsg) + type(MD_OutParmType), intent(inout) :: OutParmTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_DestroyOutParmType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine MD_PackOutParmType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(MD_OutParmType), intent(in) :: InData character(*), parameter :: RoutineName = 'MD_PackOutParmType' if (Buf%ErrStat >= AbortErrLev) return - ! Name call RegPack(Buf, InData%Name) if (RegCheckErr(Buf, RoutineName)) return - ! Units call RegPack(Buf, InData%Units) if (RegCheckErr(Buf, RoutineName)) return - ! QType call RegPack(Buf, InData%QType) if (RegCheckErr(Buf, RoutineName)) return - ! OType call RegPack(Buf, InData%OType) if (RegCheckErr(Buf, RoutineName)) return - ! NodeID call RegPack(Buf, InData%NodeID) if (RegCheckErr(Buf, RoutineName)) return - ! ObjID call RegPack(Buf, InData%ObjID) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -4121,307 +3585,302 @@ subroutine MD_UnPackOutParmType(Buf, OutData) type(MD_OutParmType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackOutParmType' if (Buf%ErrStat /= ErrID_None) return - ! Name call RegUnpack(Buf, OutData%Name) if (RegCheckErr(Buf, RoutineName)) return - ! Units call RegUnpack(Buf, OutData%Units) if (RegCheckErr(Buf, RoutineName)) return - ! QType call RegUnpack(Buf, OutData%QType) if (RegCheckErr(Buf, RoutineName)) return - ! OType call RegUnpack(Buf, OutData%OType) if (RegCheckErr(Buf, RoutineName)) return - ! NodeID call RegUnpack(Buf, OutData%NodeID) if (RegCheckErr(Buf, RoutineName)) return - ! ObjID call RegUnpack(Buf, OutData%ObjID) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE MD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(MD_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyInitOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInitOutputData%writeOutputHdr)) THEN - i1_l = LBOUND(SrcInitOutputData%writeOutputHdr,1) - i1_u = UBOUND(SrcInitOutputData%writeOutputHdr,1) - IF (.NOT. ALLOCATED(DstInitOutputData%writeOutputHdr)) THEN - ALLOCATE(DstInitOutputData%writeOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%writeOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%writeOutputHdr = SrcInitOutputData%writeOutputHdr -ENDIF -IF (ALLOCATED(SrcInitOutputData%writeOutputUnt)) THEN - i1_l = LBOUND(SrcInitOutputData%writeOutputUnt,1) - i1_u = UBOUND(SrcInitOutputData%writeOutputUnt,1) - IF (.NOT. ALLOCATED(DstInitOutputData%writeOutputUnt)) THEN - ALLOCATE(DstInitOutputData%writeOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%writeOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%writeOutputUnt = SrcInitOutputData%writeOutputUnt -ENDIF - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInitOutputData%CableCChanRqst)) THEN - i1_l = LBOUND(SrcInitOutputData%CableCChanRqst,1) - i1_u = UBOUND(SrcInitOutputData%CableCChanRqst,1) - IF (.NOT. ALLOCATED(DstInitOutputData%CableCChanRqst)) THEN - ALLOCATE(DstInitOutputData%CableCChanRqst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%CableCChanRqst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%CableCChanRqst = SrcInitOutputData%CableCChanRqst -ENDIF -IF (ALLOCATED(SrcInitOutputData%LinNames_y)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_y,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_y,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_y)) THEN - ALLOCATE(DstInitOutputData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y -ENDIF -IF (ALLOCATED(SrcInitOutputData%LinNames_x)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_x,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_x,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_x)) THEN - ALLOCATE(DstInitOutputData%LinNames_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x -ENDIF -IF (ALLOCATED(SrcInitOutputData%LinNames_u)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_u,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_u)) THEN - ALLOCATE(DstInitOutputData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_y)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_y,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_y,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_y)) THEN - ALLOCATE(DstInitOutputData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_x)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_x,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_x,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_x)) THEN - ALLOCATE(DstInitOutputData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_u)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_u,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_u)) THEN - ALLOCATE(DstInitOutputData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%IsLoad_u)) THEN - i1_l = LBOUND(SrcInitOutputData%IsLoad_u,1) - i1_u = UBOUND(SrcInitOutputData%IsLoad_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%IsLoad_u)) THEN - ALLOCATE(DstInitOutputData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%DerivOrder_x)) THEN - i1_l = LBOUND(SrcInitOutputData%DerivOrder_x,1) - i1_u = UBOUND(SrcInitOutputData%DerivOrder_x,1) - IF (.NOT. ALLOCATED(DstInitOutputData%DerivOrder_x)) THEN - ALLOCATE(DstInitOutputData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x -ENDIF - END SUBROUTINE MD_CopyInitOutput - - SUBROUTINE MD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(MD_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyInitOutput' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitOutputData%writeOutputHdr)) THEN - DEALLOCATE(InitOutputData%writeOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%writeOutputUnt)) THEN - DEALLOCATE(InitOutputData%writeOutputUnt) -ENDIF - CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitOutputData%CableCChanRqst)) THEN - DEALLOCATE(InitOutputData%CableCChanRqst) -ENDIF -IF (ALLOCATED(InitOutputData%LinNames_y)) THEN - DEALLOCATE(InitOutputData%LinNames_y) -ENDIF -IF (ALLOCATED(InitOutputData%LinNames_x)) THEN - DEALLOCATE(InitOutputData%LinNames_x) -ENDIF -IF (ALLOCATED(InitOutputData%LinNames_u)) THEN - DEALLOCATE(InitOutputData%LinNames_u) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_y)) THEN - DEALLOCATE(InitOutputData%RotFrame_y) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_x)) THEN - DEALLOCATE(InitOutputData%RotFrame_x) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_u)) THEN - DEALLOCATE(InitOutputData%RotFrame_u) -ENDIF -IF (ALLOCATED(InitOutputData%IsLoad_u)) THEN - DEALLOCATE(InitOutputData%IsLoad_u) -ENDIF -IF (ALLOCATED(InitOutputData%DerivOrder_x)) THEN - DEALLOCATE(InitOutputData%DerivOrder_x) -ENDIF - END SUBROUTINE MD_DestroyInitOutput +subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(MD_InitOutputType), intent(in) :: SrcInitOutputData + type(MD_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MD_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInitOutputData%writeOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%writeOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%writeOutputHdr) + if (.not. allocated(DstInitOutputData%writeOutputHdr)) then + allocate(DstInitOutputData%writeOutputHdr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%writeOutputHdr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%writeOutputHdr = SrcInitOutputData%writeOutputHdr + else if (allocated(DstInitOutputData%writeOutputHdr)) then + deallocate(DstInitOutputData%writeOutputHdr) + end if + if (allocated(SrcInitOutputData%writeOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%writeOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%writeOutputUnt) + if (.not. allocated(DstInitOutputData%writeOutputUnt)) then + allocate(DstInitOutputData%writeOutputUnt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%writeOutputUnt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%writeOutputUnt = SrcInitOutputData%writeOutputUnt + else if (allocated(DstInitOutputData%writeOutputUnt)) then + deallocate(DstInitOutputData%writeOutputUnt) + end if + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInitOutputData%CableCChanRqst)) then + LB(1:1) = lbound(SrcInitOutputData%CableCChanRqst) + UB(1:1) = ubound(SrcInitOutputData%CableCChanRqst) + if (.not. allocated(DstInitOutputData%CableCChanRqst)) then + allocate(DstInitOutputData%CableCChanRqst(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%CableCChanRqst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%CableCChanRqst = SrcInitOutputData%CableCChanRqst + else if (allocated(DstInitOutputData%CableCChanRqst)) then + deallocate(DstInitOutputData%CableCChanRqst) + end if + if (allocated(SrcInitOutputData%LinNames_y)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_y) + UB(1:1) = ubound(SrcInitOutputData%LinNames_y) + if (.not. allocated(DstInitOutputData%LinNames_y)) then + allocate(DstInitOutputData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y + else if (allocated(DstInitOutputData%LinNames_y)) then + deallocate(DstInitOutputData%LinNames_y) + end if + if (allocated(SrcInitOutputData%LinNames_x)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_x) + UB(1:1) = ubound(SrcInitOutputData%LinNames_x) + if (.not. allocated(DstInitOutputData%LinNames_x)) then + allocate(DstInitOutputData%LinNames_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x + else if (allocated(DstInitOutputData%LinNames_x)) then + deallocate(DstInitOutputData%LinNames_x) + end if + if (allocated(SrcInitOutputData%LinNames_u)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_u) + UB(1:1) = ubound(SrcInitOutputData%LinNames_u) + if (.not. allocated(DstInitOutputData%LinNames_u)) then + allocate(DstInitOutputData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u + else if (allocated(DstInitOutputData%LinNames_u)) then + deallocate(DstInitOutputData%LinNames_u) + end if + if (allocated(SrcInitOutputData%RotFrame_y)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_y) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_y) + if (.not. allocated(DstInitOutputData%RotFrame_y)) then + allocate(DstInitOutputData%RotFrame_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y + else if (allocated(DstInitOutputData%RotFrame_y)) then + deallocate(DstInitOutputData%RotFrame_y) + end if + if (allocated(SrcInitOutputData%RotFrame_x)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_x) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_x) + if (.not. allocated(DstInitOutputData%RotFrame_x)) then + allocate(DstInitOutputData%RotFrame_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x + else if (allocated(DstInitOutputData%RotFrame_x)) then + deallocate(DstInitOutputData%RotFrame_x) + end if + if (allocated(SrcInitOutputData%RotFrame_u)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_u) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_u) + if (.not. allocated(DstInitOutputData%RotFrame_u)) then + allocate(DstInitOutputData%RotFrame_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u + else if (allocated(DstInitOutputData%RotFrame_u)) then + deallocate(DstInitOutputData%RotFrame_u) + end if + if (allocated(SrcInitOutputData%IsLoad_u)) then + LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) + UB(1:1) = ubound(SrcInitOutputData%IsLoad_u) + if (.not. allocated(DstInitOutputData%IsLoad_u)) then + allocate(DstInitOutputData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%IsLoad_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u + else if (allocated(DstInitOutputData%IsLoad_u)) then + deallocate(DstInitOutputData%IsLoad_u) + end if + if (allocated(SrcInitOutputData%DerivOrder_x)) then + LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) + UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x) + if (.not. allocated(DstInitOutputData%DerivOrder_x)) then + allocate(DstInitOutputData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%DerivOrder_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x + else if (allocated(DstInitOutputData%DerivOrder_x)) then + deallocate(DstInitOutputData%DerivOrder_x) + end if +end subroutine +subroutine MD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(MD_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MD_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%writeOutputHdr)) then + deallocate(InitOutputData%writeOutputHdr) + end if + if (allocated(InitOutputData%writeOutputUnt)) then + deallocate(InitOutputData%writeOutputUnt) + end if + if (allocated(InitOutputData%CableCChanRqst)) then + deallocate(InitOutputData%CableCChanRqst) + end if + if (allocated(InitOutputData%LinNames_y)) then + deallocate(InitOutputData%LinNames_y) + end if + if (allocated(InitOutputData%LinNames_x)) then + deallocate(InitOutputData%LinNames_x) + end if + if (allocated(InitOutputData%LinNames_u)) then + deallocate(InitOutputData%LinNames_u) + end if + if (allocated(InitOutputData%RotFrame_y)) then + deallocate(InitOutputData%RotFrame_y) + end if + if (allocated(InitOutputData%RotFrame_x)) then + deallocate(InitOutputData%RotFrame_x) + end if + if (allocated(InitOutputData%RotFrame_u)) then + deallocate(InitOutputData%RotFrame_u) + end if + if (allocated(InitOutputData%IsLoad_u)) then + deallocate(InitOutputData%IsLoad_u) + end if + if (allocated(InitOutputData%DerivOrder_x)) then + deallocate(InitOutputData%DerivOrder_x) + end if +end subroutine subroutine MD_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(MD_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'MD_PackInitOutput' if (Buf%ErrStat >= AbortErrLev) return - ! writeOutputHdr call RegPack(Buf, allocated(InData%writeOutputHdr)) if (allocated(InData%writeOutputHdr)) then call RegPackBounds(Buf, 1, lbound(InData%writeOutputHdr), ubound(InData%writeOutputHdr)) call RegPack(Buf, InData%writeOutputHdr) end if if (RegCheckErr(Buf, RoutineName)) return - ! writeOutputUnt call RegPack(Buf, allocated(InData%writeOutputUnt)) if (allocated(InData%writeOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%writeOutputUnt), ubound(InData%writeOutputUnt)) call RegPack(Buf, InData%writeOutputUnt) end if if (RegCheckErr(Buf, RoutineName)) return - ! Ver call NWTC_Library_PackProgDesc(Buf, InData%Ver) if (RegCheckErr(Buf, RoutineName)) return - ! CableCChanRqst call RegPack(Buf, allocated(InData%CableCChanRqst)) if (allocated(InData%CableCChanRqst)) then call RegPackBounds(Buf, 1, lbound(InData%CableCChanRqst), ubound(InData%CableCChanRqst)) call RegPack(Buf, InData%CableCChanRqst) end if if (RegCheckErr(Buf, RoutineName)) return - ! LinNames_y call RegPack(Buf, allocated(InData%LinNames_y)) if (allocated(InData%LinNames_y)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) call RegPack(Buf, InData%LinNames_y) end if if (RegCheckErr(Buf, RoutineName)) return - ! LinNames_x call RegPack(Buf, allocated(InData%LinNames_x)) if (allocated(InData%LinNames_x)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_x), ubound(InData%LinNames_x)) call RegPack(Buf, InData%LinNames_x) end if if (RegCheckErr(Buf, RoutineName)) return - ! LinNames_u call RegPack(Buf, allocated(InData%LinNames_u)) if (allocated(InData%LinNames_u)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) call RegPack(Buf, InData%LinNames_u) end if if (RegCheckErr(Buf, RoutineName)) return - ! RotFrame_y call RegPack(Buf, allocated(InData%RotFrame_y)) if (allocated(InData%RotFrame_y)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y), ubound(InData%RotFrame_y)) call RegPack(Buf, InData%RotFrame_y) end if if (RegCheckErr(Buf, RoutineName)) return - ! RotFrame_x call RegPack(Buf, allocated(InData%RotFrame_x)) if (allocated(InData%RotFrame_x)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x), ubound(InData%RotFrame_x)) call RegPack(Buf, InData%RotFrame_x) end if if (RegCheckErr(Buf, RoutineName)) return - ! RotFrame_u call RegPack(Buf, allocated(InData%RotFrame_u)) if (allocated(InData%RotFrame_u)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u), ubound(InData%RotFrame_u)) call RegPack(Buf, InData%RotFrame_u) end if if (RegCheckErr(Buf, RoutineName)) return - ! IsLoad_u call RegPack(Buf, allocated(InData%IsLoad_u)) if (allocated(InData%IsLoad_u)) then call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) call RegPack(Buf, InData%IsLoad_u) end if if (RegCheckErr(Buf, RoutineName)) return - ! DerivOrder_x call RegPack(Buf, allocated(InData%DerivOrder_x)) if (allocated(InData%DerivOrder_x)) then call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x), ubound(InData%DerivOrder_x)) @@ -4438,7 +3897,6 @@ subroutine MD_UnPackInitOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! writeOutputHdr if (allocated(OutData%writeOutputHdr)) deallocate(OutData%writeOutputHdr) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4453,7 +3911,6 @@ subroutine MD_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%writeOutputHdr) if (RegCheckErr(Buf, RoutineName)) return end if - ! writeOutputUnt if (allocated(OutData%writeOutputUnt)) deallocate(OutData%writeOutputUnt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4468,9 +3925,7 @@ subroutine MD_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%writeOutputUnt) if (RegCheckErr(Buf, RoutineName)) return end if - ! Ver call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver - ! CableCChanRqst if (allocated(OutData%CableCChanRqst)) deallocate(OutData%CableCChanRqst) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4485,7 +3940,6 @@ subroutine MD_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%CableCChanRqst) if (RegCheckErr(Buf, RoutineName)) return end if - ! LinNames_y if (allocated(OutData%LinNames_y)) deallocate(OutData%LinNames_y) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4500,7 +3954,6 @@ subroutine MD_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%LinNames_y) if (RegCheckErr(Buf, RoutineName)) return end if - ! LinNames_x if (allocated(OutData%LinNames_x)) deallocate(OutData%LinNames_x) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4515,7 +3968,6 @@ subroutine MD_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%LinNames_x) if (RegCheckErr(Buf, RoutineName)) return end if - ! LinNames_u if (allocated(OutData%LinNames_u)) deallocate(OutData%LinNames_u) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4530,7 +3982,6 @@ subroutine MD_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%LinNames_u) if (RegCheckErr(Buf, RoutineName)) return end if - ! RotFrame_y if (allocated(OutData%RotFrame_y)) deallocate(OutData%RotFrame_y) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4545,7 +3996,6 @@ subroutine MD_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%RotFrame_y) if (RegCheckErr(Buf, RoutineName)) return end if - ! RotFrame_x if (allocated(OutData%RotFrame_x)) deallocate(OutData%RotFrame_x) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4560,7 +4010,6 @@ subroutine MD_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%RotFrame_x) if (RegCheckErr(Buf, RoutineName)) return end if - ! RotFrame_u if (allocated(OutData%RotFrame_u)) deallocate(OutData%RotFrame_u) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4575,7 +4024,6 @@ subroutine MD_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%RotFrame_u) if (RegCheckErr(Buf, RoutineName)) return end if - ! IsLoad_u if (allocated(OutData%IsLoad_u)) deallocate(OutData%IsLoad_u) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4590,7 +4038,6 @@ subroutine MD_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%IsLoad_u) if (RegCheckErr(Buf, RoutineName)) return end if - ! DerivOrder_x if (allocated(OutData%DerivOrder_x)) deallocate(OutData%DerivOrder_x) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4606,60 +4053,51 @@ subroutine MD_UnPackInitOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE MD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(MD_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcContStateData%states)) THEN - i1_l = LBOUND(SrcContStateData%states,1) - i1_u = UBOUND(SrcContStateData%states,1) - IF (.NOT. ALLOCATED(DstContStateData%states)) THEN - ALLOCATE(DstContStateData%states(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%states.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstContStateData%states = SrcContStateData%states -ENDIF - END SUBROUTINE MD_CopyContState - - SUBROUTINE MD_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(MD_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(ContStateData%states)) THEN - DEALLOCATE(ContStateData%states) -ENDIF - END SUBROUTINE MD_DestroyContState +subroutine MD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(MD_ContinuousStateType), intent(in) :: SrcContStateData + type(MD_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'MD_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcContStateData%states)) then + LB(1:1) = lbound(SrcContStateData%states) + UB(1:1) = ubound(SrcContStateData%states) + if (.not. allocated(DstContStateData%states)) then + allocate(DstContStateData%states(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%states.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstContStateData%states = SrcContStateData%states + else if (allocated(DstContStateData%states)) then + deallocate(DstContStateData%states) + end if +end subroutine +subroutine MD_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(MD_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ContStateData%states)) then + deallocate(ContStateData%states) + end if +end subroutine subroutine MD_PackContState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(MD_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'MD_PackContState' if (Buf%ErrStat >= AbortErrLev) return - ! states call RegPack(Buf, allocated(InData%states)) if (allocated(InData%states)) then call RegPackBounds(Buf, 1, lbound(InData%states), ubound(InData%states)) @@ -4676,7 +4114,6 @@ subroutine MD_UnPackContState(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! states if (allocated(OutData%states)) deallocate(OutData%states) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4692,45 +4129,33 @@ subroutine MD_UnPackContState(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE MD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(MD_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%dummy = SrcDiscStateData%dummy - END SUBROUTINE MD_CopyDiscState - - SUBROUTINE MD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(MD_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE MD_DestroyDiscState +subroutine MD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(MD_DiscreteStateType), intent(in) :: SrcDiscStateData + type(MD_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + DstDiscStateData%dummy = SrcDiscStateData%dummy +end subroutine +subroutine MD_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(MD_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine MD_PackDiscState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(MD_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'MD_PackDiscState' if (Buf%ErrStat >= AbortErrLev) return - ! dummy call RegPack(Buf, InData%dummy) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -4740,49 +4165,36 @@ subroutine MD_UnPackDiscState(Buf, OutData) type(MD_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackDiscState' if (Buf%ErrStat /= ErrID_None) return - ! dummy call RegUnpack(Buf, OutData%dummy) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE MD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(MD_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%dummy = SrcConstrStateData%dummy - END SUBROUTINE MD_CopyConstrState - - SUBROUTINE MD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(MD_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE MD_DestroyConstrState +subroutine MD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(MD_ConstraintStateType), intent(in) :: SrcConstrStateData + type(MD_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%dummy = SrcConstrStateData%dummy +end subroutine +subroutine MD_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(MD_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine MD_PackConstrState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(MD_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'MD_PackConstrState' if (Buf%ErrStat >= AbortErrLev) return - ! dummy call RegPack(Buf, InData%dummy) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -4792,49 +4204,36 @@ subroutine MD_UnPackConstrState(Buf, OutData) type(MD_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackConstrState' if (Buf%ErrStat /= ErrID_None) return - ! dummy call RegUnpack(Buf, OutData%dummy) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE MD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(MD_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%dummy = SrcOtherStateData%dummy - END SUBROUTINE MD_CopyOtherState - - SUBROUTINE MD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(MD_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE MD_DestroyOtherState +subroutine MD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(MD_OtherStateType), intent(in) :: SrcOtherStateData + type(MD_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%dummy = SrcOtherStateData%dummy +end subroutine +subroutine MD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(MD_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'MD_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine MD_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(MD_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'MD_PackOtherState' if (Buf%ErrStat >= AbortErrLev) return - ! dummy call RegPack(Buf, InData%dummy) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -4844,517 +4243,563 @@ subroutine MD_UnPackOtherState(Buf, OutData) type(MD_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackOtherState' if (Buf%ErrStat /= ErrID_None) return - ! dummy call RegUnpack(Buf, OutData%dummy) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE MD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(MD_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscData%LineTypeList)) THEN - i1_l = LBOUND(SrcMiscData%LineTypeList,1) - i1_u = UBOUND(SrcMiscData%LineTypeList,1) - IF (.NOT. ALLOCATED(DstMiscData%LineTypeList)) THEN - ALLOCATE(DstMiscData%LineTypeList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineTypeList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%LineTypeList,1), UBOUND(SrcMiscData%LineTypeList,1) - CALL MD_Copylineprop( SrcMiscData%LineTypeList(i1), DstMiscData%LineTypeList(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%RodTypeList)) THEN - i1_l = LBOUND(SrcMiscData%RodTypeList,1) - i1_u = UBOUND(SrcMiscData%RodTypeList,1) - IF (.NOT. ALLOCATED(DstMiscData%RodTypeList)) THEN - ALLOCATE(DstMiscData%RodTypeList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodTypeList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%RodTypeList,1), UBOUND(SrcMiscData%RodTypeList,1) - CALL MD_Copyrodprop( SrcMiscData%RodTypeList(i1), DstMiscData%RodTypeList(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL MD_Copybody( SrcMiscData%GroundBody, DstMiscData%GroundBody, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMiscData%BodyList)) THEN - i1_l = LBOUND(SrcMiscData%BodyList,1) - i1_u = UBOUND(SrcMiscData%BodyList,1) - IF (.NOT. ALLOCATED(DstMiscData%BodyList)) THEN - ALLOCATE(DstMiscData%BodyList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BodyList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%BodyList,1), UBOUND(SrcMiscData%BodyList,1) - CALL MD_Copybody( SrcMiscData%BodyList(i1), DstMiscData%BodyList(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%RodList)) THEN - i1_l = LBOUND(SrcMiscData%RodList,1) - i1_u = UBOUND(SrcMiscData%RodList,1) - IF (.NOT. ALLOCATED(DstMiscData%RodList)) THEN - ALLOCATE(DstMiscData%RodList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%RodList,1), UBOUND(SrcMiscData%RodList,1) - CALL MD_Copyrod( SrcMiscData%RodList(i1), DstMiscData%RodList(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%ConnectList)) THEN - i1_l = LBOUND(SrcMiscData%ConnectList,1) - i1_u = UBOUND(SrcMiscData%ConnectList,1) - IF (.NOT. ALLOCATED(DstMiscData%ConnectList)) THEN - ALLOCATE(DstMiscData%ConnectList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ConnectList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%ConnectList,1), UBOUND(SrcMiscData%ConnectList,1) - CALL MD_Copyconnect( SrcMiscData%ConnectList(i1), DstMiscData%ConnectList(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%LineList)) THEN - i1_l = LBOUND(SrcMiscData%LineList,1) - i1_u = UBOUND(SrcMiscData%LineList,1) - IF (.NOT. ALLOCATED(DstMiscData%LineList)) THEN - ALLOCATE(DstMiscData%LineList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%LineList,1), UBOUND(SrcMiscData%LineList,1) - CALL MD_Copyline( SrcMiscData%LineList(i1), DstMiscData%LineList(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%FailList)) THEN - i1_l = LBOUND(SrcMiscData%FailList,1) - i1_u = UBOUND(SrcMiscData%FailList,1) - IF (.NOT. ALLOCATED(DstMiscData%FailList)) THEN - ALLOCATE(DstMiscData%FailList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FailList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%FailList,1), UBOUND(SrcMiscData%FailList,1) - CALL MD_Copyfail( SrcMiscData%FailList(i1), DstMiscData%FailList(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%FreeConIs)) THEN - i1_l = LBOUND(SrcMiscData%FreeConIs,1) - i1_u = UBOUND(SrcMiscData%FreeConIs,1) - IF (.NOT. ALLOCATED(DstMiscData%FreeConIs)) THEN - ALLOCATE(DstMiscData%FreeConIs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FreeConIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%FreeConIs = SrcMiscData%FreeConIs -ENDIF -IF (ALLOCATED(SrcMiscData%CpldConIs)) THEN - i1_l = LBOUND(SrcMiscData%CpldConIs,1) - i1_u = UBOUND(SrcMiscData%CpldConIs,1) - i2_l = LBOUND(SrcMiscData%CpldConIs,2) - i2_u = UBOUND(SrcMiscData%CpldConIs,2) - IF (.NOT. ALLOCATED(DstMiscData%CpldConIs)) THEN - ALLOCATE(DstMiscData%CpldConIs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CpldConIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%CpldConIs = SrcMiscData%CpldConIs -ENDIF -IF (ALLOCATED(SrcMiscData%FreeRodIs)) THEN - i1_l = LBOUND(SrcMiscData%FreeRodIs,1) - i1_u = UBOUND(SrcMiscData%FreeRodIs,1) - IF (.NOT. ALLOCATED(DstMiscData%FreeRodIs)) THEN - ALLOCATE(DstMiscData%FreeRodIs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FreeRodIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%FreeRodIs = SrcMiscData%FreeRodIs -ENDIF -IF (ALLOCATED(SrcMiscData%CpldRodIs)) THEN - i1_l = LBOUND(SrcMiscData%CpldRodIs,1) - i1_u = UBOUND(SrcMiscData%CpldRodIs,1) - i2_l = LBOUND(SrcMiscData%CpldRodIs,2) - i2_u = UBOUND(SrcMiscData%CpldRodIs,2) - IF (.NOT. ALLOCATED(DstMiscData%CpldRodIs)) THEN - ALLOCATE(DstMiscData%CpldRodIs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CpldRodIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%CpldRodIs = SrcMiscData%CpldRodIs -ENDIF -IF (ALLOCATED(SrcMiscData%FreeBodyIs)) THEN - i1_l = LBOUND(SrcMiscData%FreeBodyIs,1) - i1_u = UBOUND(SrcMiscData%FreeBodyIs,1) - IF (.NOT. ALLOCATED(DstMiscData%FreeBodyIs)) THEN - ALLOCATE(DstMiscData%FreeBodyIs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FreeBodyIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%FreeBodyIs = SrcMiscData%FreeBodyIs -ENDIF -IF (ALLOCATED(SrcMiscData%CpldBodyIs)) THEN - i1_l = LBOUND(SrcMiscData%CpldBodyIs,1) - i1_u = UBOUND(SrcMiscData%CpldBodyIs,1) - i2_l = LBOUND(SrcMiscData%CpldBodyIs,2) - i2_u = UBOUND(SrcMiscData%CpldBodyIs,2) - IF (.NOT. ALLOCATED(DstMiscData%CpldBodyIs)) THEN - ALLOCATE(DstMiscData%CpldBodyIs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CpldBodyIs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%CpldBodyIs = SrcMiscData%CpldBodyIs -ENDIF -IF (ALLOCATED(SrcMiscData%LineStateIs1)) THEN - i1_l = LBOUND(SrcMiscData%LineStateIs1,1) - i1_u = UBOUND(SrcMiscData%LineStateIs1,1) - IF (.NOT. ALLOCATED(DstMiscData%LineStateIs1)) THEN - ALLOCATE(DstMiscData%LineStateIs1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineStateIs1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%LineStateIs1 = SrcMiscData%LineStateIs1 -ENDIF -IF (ALLOCATED(SrcMiscData%LineStateIsN)) THEN - i1_l = LBOUND(SrcMiscData%LineStateIsN,1) - i1_u = UBOUND(SrcMiscData%LineStateIsN,1) - IF (.NOT. ALLOCATED(DstMiscData%LineStateIsN)) THEN - ALLOCATE(DstMiscData%LineStateIsN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineStateIsN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%LineStateIsN = SrcMiscData%LineStateIsN -ENDIF -IF (ALLOCATED(SrcMiscData%ConStateIs1)) THEN - i1_l = LBOUND(SrcMiscData%ConStateIs1,1) - i1_u = UBOUND(SrcMiscData%ConStateIs1,1) - IF (.NOT. ALLOCATED(DstMiscData%ConStateIs1)) THEN - ALLOCATE(DstMiscData%ConStateIs1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ConStateIs1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%ConStateIs1 = SrcMiscData%ConStateIs1 -ENDIF -IF (ALLOCATED(SrcMiscData%ConStateIsN)) THEN - i1_l = LBOUND(SrcMiscData%ConStateIsN,1) - i1_u = UBOUND(SrcMiscData%ConStateIsN,1) - IF (.NOT. ALLOCATED(DstMiscData%ConStateIsN)) THEN - ALLOCATE(DstMiscData%ConStateIsN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ConStateIsN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%ConStateIsN = SrcMiscData%ConStateIsN -ENDIF -IF (ALLOCATED(SrcMiscData%RodStateIs1)) THEN - i1_l = LBOUND(SrcMiscData%RodStateIs1,1) - i1_u = UBOUND(SrcMiscData%RodStateIs1,1) - IF (.NOT. ALLOCATED(DstMiscData%RodStateIs1)) THEN - ALLOCATE(DstMiscData%RodStateIs1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodStateIs1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%RodStateIs1 = SrcMiscData%RodStateIs1 -ENDIF -IF (ALLOCATED(SrcMiscData%RodStateIsN)) THEN - i1_l = LBOUND(SrcMiscData%RodStateIsN,1) - i1_u = UBOUND(SrcMiscData%RodStateIsN,1) - IF (.NOT. ALLOCATED(DstMiscData%RodStateIsN)) THEN - ALLOCATE(DstMiscData%RodStateIsN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodStateIsN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%RodStateIsN = SrcMiscData%RodStateIsN -ENDIF -IF (ALLOCATED(SrcMiscData%BodyStateIs1)) THEN - i1_l = LBOUND(SrcMiscData%BodyStateIs1,1) - i1_u = UBOUND(SrcMiscData%BodyStateIs1,1) - IF (.NOT. ALLOCATED(DstMiscData%BodyStateIs1)) THEN - ALLOCATE(DstMiscData%BodyStateIs1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BodyStateIs1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%BodyStateIs1 = SrcMiscData%BodyStateIs1 -ENDIF -IF (ALLOCATED(SrcMiscData%BodyStateIsN)) THEN - i1_l = LBOUND(SrcMiscData%BodyStateIsN,1) - i1_u = UBOUND(SrcMiscData%BodyStateIsN,1) - IF (.NOT. ALLOCATED(DstMiscData%BodyStateIsN)) THEN - ALLOCATE(DstMiscData%BodyStateIsN(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BodyStateIsN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%BodyStateIsN = SrcMiscData%BodyStateIsN -ENDIF - DstMiscData%Nx = SrcMiscData%Nx - DstMiscData%WaveTi = SrcMiscData%WaveTi - CALL MD_CopyContState( SrcMiscData%xTemp, DstMiscData%xTemp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MD_CopyContState( SrcMiscData%xdTemp, DstMiscData%xdTemp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstMiscData%zeros6 = SrcMiscData%zeros6 -IF (ALLOCATED(SrcMiscData%MDWrOutput)) THEN - i1_l = LBOUND(SrcMiscData%MDWrOutput,1) - i1_u = UBOUND(SrcMiscData%MDWrOutput,1) - IF (.NOT. ALLOCATED(DstMiscData%MDWrOutput)) THEN - ALLOCATE(DstMiscData%MDWrOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%MDWrOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%MDWrOutput = SrcMiscData%MDWrOutput -ENDIF - DstMiscData%LastOutTime = SrcMiscData%LastOutTime - DstMiscData%PtfmInit = SrcMiscData%PtfmInit -IF (ALLOCATED(SrcMiscData%BathymetryGrid)) THEN - i1_l = LBOUND(SrcMiscData%BathymetryGrid,1) - i1_u = UBOUND(SrcMiscData%BathymetryGrid,1) - i2_l = LBOUND(SrcMiscData%BathymetryGrid,2) - i2_u = UBOUND(SrcMiscData%BathymetryGrid,2) - IF (.NOT. ALLOCATED(DstMiscData%BathymetryGrid)) THEN - ALLOCATE(DstMiscData%BathymetryGrid(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathymetryGrid.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%BathymetryGrid = SrcMiscData%BathymetryGrid -ENDIF -IF (ALLOCATED(SrcMiscData%BathGrid_Xs)) THEN - i1_l = LBOUND(SrcMiscData%BathGrid_Xs,1) - i1_u = UBOUND(SrcMiscData%BathGrid_Xs,1) - IF (.NOT. ALLOCATED(DstMiscData%BathGrid_Xs)) THEN - ALLOCATE(DstMiscData%BathGrid_Xs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathGrid_Xs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%BathGrid_Xs = SrcMiscData%BathGrid_Xs -ENDIF -IF (ALLOCATED(SrcMiscData%BathGrid_Ys)) THEN - i1_l = LBOUND(SrcMiscData%BathGrid_Ys,1) - i1_u = UBOUND(SrcMiscData%BathGrid_Ys,1) - IF (.NOT. ALLOCATED(DstMiscData%BathGrid_Ys)) THEN - ALLOCATE(DstMiscData%BathGrid_Ys(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathGrid_Ys.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%BathGrid_Ys = SrcMiscData%BathGrid_Ys -ENDIF -IF (ALLOCATED(SrcMiscData%BathGrid_npoints)) THEN - i1_l = LBOUND(SrcMiscData%BathGrid_npoints,1) - i1_u = UBOUND(SrcMiscData%BathGrid_npoints,1) - IF (.NOT. ALLOCATED(DstMiscData%BathGrid_npoints)) THEN - ALLOCATE(DstMiscData%BathGrid_npoints(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathGrid_npoints.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%BathGrid_npoints = SrcMiscData%BathGrid_npoints -ENDIF - END SUBROUTINE MD_CopyMisc - - SUBROUTINE MD_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(MD_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyMisc' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MiscData%LineTypeList)) THEN -DO i1 = LBOUND(MiscData%LineTypeList,1), UBOUND(MiscData%LineTypeList,1) - CALL MD_DestroyLineProp( MiscData%LineTypeList(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%LineTypeList) -ENDIF -IF (ALLOCATED(MiscData%RodTypeList)) THEN -DO i1 = LBOUND(MiscData%RodTypeList,1), UBOUND(MiscData%RodTypeList,1) - CALL MD_DestroyRodProp( MiscData%RodTypeList(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%RodTypeList) -ENDIF - CALL MD_DestroyBody( MiscData%GroundBody, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MiscData%BodyList)) THEN -DO i1 = LBOUND(MiscData%BodyList,1), UBOUND(MiscData%BodyList,1) - CALL MD_DestroyBody( MiscData%BodyList(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%BodyList) -ENDIF -IF (ALLOCATED(MiscData%RodList)) THEN -DO i1 = LBOUND(MiscData%RodList,1), UBOUND(MiscData%RodList,1) - CALL MD_DestroyRod( MiscData%RodList(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%RodList) -ENDIF -IF (ALLOCATED(MiscData%ConnectList)) THEN -DO i1 = LBOUND(MiscData%ConnectList,1), UBOUND(MiscData%ConnectList,1) - CALL MD_DestroyConnect( MiscData%ConnectList(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%ConnectList) -ENDIF -IF (ALLOCATED(MiscData%LineList)) THEN -DO i1 = LBOUND(MiscData%LineList,1), UBOUND(MiscData%LineList,1) - CALL MD_DestroyLine( MiscData%LineList(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%LineList) -ENDIF -IF (ALLOCATED(MiscData%FailList)) THEN -DO i1 = LBOUND(MiscData%FailList,1), UBOUND(MiscData%FailList,1) - CALL MD_DestroyFail( MiscData%FailList(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%FailList) -ENDIF -IF (ALLOCATED(MiscData%FreeConIs)) THEN - DEALLOCATE(MiscData%FreeConIs) -ENDIF -IF (ALLOCATED(MiscData%CpldConIs)) THEN - DEALLOCATE(MiscData%CpldConIs) -ENDIF -IF (ALLOCATED(MiscData%FreeRodIs)) THEN - DEALLOCATE(MiscData%FreeRodIs) -ENDIF -IF (ALLOCATED(MiscData%CpldRodIs)) THEN - DEALLOCATE(MiscData%CpldRodIs) -ENDIF -IF (ALLOCATED(MiscData%FreeBodyIs)) THEN - DEALLOCATE(MiscData%FreeBodyIs) -ENDIF -IF (ALLOCATED(MiscData%CpldBodyIs)) THEN - DEALLOCATE(MiscData%CpldBodyIs) -ENDIF -IF (ALLOCATED(MiscData%LineStateIs1)) THEN - DEALLOCATE(MiscData%LineStateIs1) -ENDIF -IF (ALLOCATED(MiscData%LineStateIsN)) THEN - DEALLOCATE(MiscData%LineStateIsN) -ENDIF -IF (ALLOCATED(MiscData%ConStateIs1)) THEN - DEALLOCATE(MiscData%ConStateIs1) -ENDIF -IF (ALLOCATED(MiscData%ConStateIsN)) THEN - DEALLOCATE(MiscData%ConStateIsN) -ENDIF -IF (ALLOCATED(MiscData%RodStateIs1)) THEN - DEALLOCATE(MiscData%RodStateIs1) -ENDIF -IF (ALLOCATED(MiscData%RodStateIsN)) THEN - DEALLOCATE(MiscData%RodStateIsN) -ENDIF -IF (ALLOCATED(MiscData%BodyStateIs1)) THEN - DEALLOCATE(MiscData%BodyStateIs1) -ENDIF -IF (ALLOCATED(MiscData%BodyStateIsN)) THEN - DEALLOCATE(MiscData%BodyStateIsN) -ENDIF - CALL MD_DestroyContState( MiscData%xTemp, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyContState( MiscData%xdTemp, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MiscData%MDWrOutput)) THEN - DEALLOCATE(MiscData%MDWrOutput) -ENDIF -IF (ALLOCATED(MiscData%BathymetryGrid)) THEN - DEALLOCATE(MiscData%BathymetryGrid) -ENDIF -IF (ALLOCATED(MiscData%BathGrid_Xs)) THEN - DEALLOCATE(MiscData%BathGrid_Xs) -ENDIF -IF (ALLOCATED(MiscData%BathGrid_Ys)) THEN - DEALLOCATE(MiscData%BathGrid_Ys) -ENDIF -IF (ALLOCATED(MiscData%BathGrid_npoints)) THEN - DEALLOCATE(MiscData%BathGrid_npoints) -ENDIF - END SUBROUTINE MD_DestroyMisc +subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(MD_MiscVarType), intent(in) :: SrcMiscData + type(MD_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MD_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMiscData%LineTypeList)) then + LB(1:1) = lbound(SrcMiscData%LineTypeList) + UB(1:1) = ubound(SrcMiscData%LineTypeList) + if (.not. allocated(DstMiscData%LineTypeList)) then + allocate(DstMiscData%LineTypeList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineTypeList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyLineProp(SrcMiscData%LineTypeList(i1), DstMiscData%LineTypeList(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstMiscData%LineTypeList)) then + deallocate(DstMiscData%LineTypeList) + end if + if (allocated(SrcMiscData%RodTypeList)) then + LB(1:1) = lbound(SrcMiscData%RodTypeList) + UB(1:1) = ubound(SrcMiscData%RodTypeList) + if (.not. allocated(DstMiscData%RodTypeList)) then + allocate(DstMiscData%RodTypeList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodTypeList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyRodProp(SrcMiscData%RodTypeList(i1), DstMiscData%RodTypeList(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstMiscData%RodTypeList)) then + deallocate(DstMiscData%RodTypeList) + end if + call MD_CopyBody(SrcMiscData%GroundBody, DstMiscData%GroundBody, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMiscData%BodyList)) then + LB(1:1) = lbound(SrcMiscData%BodyList) + UB(1:1) = ubound(SrcMiscData%BodyList) + if (.not. allocated(DstMiscData%BodyList)) then + allocate(DstMiscData%BodyList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BodyList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyBody(SrcMiscData%BodyList(i1), DstMiscData%BodyList(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstMiscData%BodyList)) then + deallocate(DstMiscData%BodyList) + end if + if (allocated(SrcMiscData%RodList)) then + LB(1:1) = lbound(SrcMiscData%RodList) + UB(1:1) = ubound(SrcMiscData%RodList) + if (.not. allocated(DstMiscData%RodList)) then + allocate(DstMiscData%RodList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyRod(SrcMiscData%RodList(i1), DstMiscData%RodList(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstMiscData%RodList)) then + deallocate(DstMiscData%RodList) + end if + if (allocated(SrcMiscData%ConnectList)) then + LB(1:1) = lbound(SrcMiscData%ConnectList) + UB(1:1) = ubound(SrcMiscData%ConnectList) + if (.not. allocated(DstMiscData%ConnectList)) then + allocate(DstMiscData%ConnectList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ConnectList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyConnect(SrcMiscData%ConnectList(i1), DstMiscData%ConnectList(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstMiscData%ConnectList)) then + deallocate(DstMiscData%ConnectList) + end if + if (allocated(SrcMiscData%LineList)) then + LB(1:1) = lbound(SrcMiscData%LineList) + UB(1:1) = ubound(SrcMiscData%LineList) + if (.not. allocated(DstMiscData%LineList)) then + allocate(DstMiscData%LineList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyLine(SrcMiscData%LineList(i1), DstMiscData%LineList(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstMiscData%LineList)) then + deallocate(DstMiscData%LineList) + end if + if (allocated(SrcMiscData%FailList)) then + LB(1:1) = lbound(SrcMiscData%FailList) + UB(1:1) = ubound(SrcMiscData%FailList) + if (.not. allocated(DstMiscData%FailList)) then + allocate(DstMiscData%FailList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FailList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyFail(SrcMiscData%FailList(i1), DstMiscData%FailList(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstMiscData%FailList)) then + deallocate(DstMiscData%FailList) + end if + if (allocated(SrcMiscData%FreeConIs)) then + LB(1:1) = lbound(SrcMiscData%FreeConIs) + UB(1:1) = ubound(SrcMiscData%FreeConIs) + if (.not. allocated(DstMiscData%FreeConIs)) then + allocate(DstMiscData%FreeConIs(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FreeConIs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%FreeConIs = SrcMiscData%FreeConIs + else if (allocated(DstMiscData%FreeConIs)) then + deallocate(DstMiscData%FreeConIs) + end if + if (allocated(SrcMiscData%CpldConIs)) then + LB(1:2) = lbound(SrcMiscData%CpldConIs) + UB(1:2) = ubound(SrcMiscData%CpldConIs) + if (.not. allocated(DstMiscData%CpldConIs)) then + allocate(DstMiscData%CpldConIs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CpldConIs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%CpldConIs = SrcMiscData%CpldConIs + else if (allocated(DstMiscData%CpldConIs)) then + deallocate(DstMiscData%CpldConIs) + end if + if (allocated(SrcMiscData%FreeRodIs)) then + LB(1:1) = lbound(SrcMiscData%FreeRodIs) + UB(1:1) = ubound(SrcMiscData%FreeRodIs) + if (.not. allocated(DstMiscData%FreeRodIs)) then + allocate(DstMiscData%FreeRodIs(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FreeRodIs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%FreeRodIs = SrcMiscData%FreeRodIs + else if (allocated(DstMiscData%FreeRodIs)) then + deallocate(DstMiscData%FreeRodIs) + end if + if (allocated(SrcMiscData%CpldRodIs)) then + LB(1:2) = lbound(SrcMiscData%CpldRodIs) + UB(1:2) = ubound(SrcMiscData%CpldRodIs) + if (.not. allocated(DstMiscData%CpldRodIs)) then + allocate(DstMiscData%CpldRodIs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CpldRodIs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%CpldRodIs = SrcMiscData%CpldRodIs + else if (allocated(DstMiscData%CpldRodIs)) then + deallocate(DstMiscData%CpldRodIs) + end if + if (allocated(SrcMiscData%FreeBodyIs)) then + LB(1:1) = lbound(SrcMiscData%FreeBodyIs) + UB(1:1) = ubound(SrcMiscData%FreeBodyIs) + if (.not. allocated(DstMiscData%FreeBodyIs)) then + allocate(DstMiscData%FreeBodyIs(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FreeBodyIs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%FreeBodyIs = SrcMiscData%FreeBodyIs + else if (allocated(DstMiscData%FreeBodyIs)) then + deallocate(DstMiscData%FreeBodyIs) + end if + if (allocated(SrcMiscData%CpldBodyIs)) then + LB(1:2) = lbound(SrcMiscData%CpldBodyIs) + UB(1:2) = ubound(SrcMiscData%CpldBodyIs) + if (.not. allocated(DstMiscData%CpldBodyIs)) then + allocate(DstMiscData%CpldBodyIs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CpldBodyIs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%CpldBodyIs = SrcMiscData%CpldBodyIs + else if (allocated(DstMiscData%CpldBodyIs)) then + deallocate(DstMiscData%CpldBodyIs) + end if + if (allocated(SrcMiscData%LineStateIs1)) then + LB(1:1) = lbound(SrcMiscData%LineStateIs1) + UB(1:1) = ubound(SrcMiscData%LineStateIs1) + if (.not. allocated(DstMiscData%LineStateIs1)) then + allocate(DstMiscData%LineStateIs1(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineStateIs1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%LineStateIs1 = SrcMiscData%LineStateIs1 + else if (allocated(DstMiscData%LineStateIs1)) then + deallocate(DstMiscData%LineStateIs1) + end if + if (allocated(SrcMiscData%LineStateIsN)) then + LB(1:1) = lbound(SrcMiscData%LineStateIsN) + UB(1:1) = ubound(SrcMiscData%LineStateIsN) + if (.not. allocated(DstMiscData%LineStateIsN)) then + allocate(DstMiscData%LineStateIsN(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineStateIsN.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%LineStateIsN = SrcMiscData%LineStateIsN + else if (allocated(DstMiscData%LineStateIsN)) then + deallocate(DstMiscData%LineStateIsN) + end if + if (allocated(SrcMiscData%ConStateIs1)) then + LB(1:1) = lbound(SrcMiscData%ConStateIs1) + UB(1:1) = ubound(SrcMiscData%ConStateIs1) + if (.not. allocated(DstMiscData%ConStateIs1)) then + allocate(DstMiscData%ConStateIs1(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ConStateIs1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%ConStateIs1 = SrcMiscData%ConStateIs1 + else if (allocated(DstMiscData%ConStateIs1)) then + deallocate(DstMiscData%ConStateIs1) + end if + if (allocated(SrcMiscData%ConStateIsN)) then + LB(1:1) = lbound(SrcMiscData%ConStateIsN) + UB(1:1) = ubound(SrcMiscData%ConStateIsN) + if (.not. allocated(DstMiscData%ConStateIsN)) then + allocate(DstMiscData%ConStateIsN(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ConStateIsN.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%ConStateIsN = SrcMiscData%ConStateIsN + else if (allocated(DstMiscData%ConStateIsN)) then + deallocate(DstMiscData%ConStateIsN) + end if + if (allocated(SrcMiscData%RodStateIs1)) then + LB(1:1) = lbound(SrcMiscData%RodStateIs1) + UB(1:1) = ubound(SrcMiscData%RodStateIs1) + if (.not. allocated(DstMiscData%RodStateIs1)) then + allocate(DstMiscData%RodStateIs1(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodStateIs1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%RodStateIs1 = SrcMiscData%RodStateIs1 + else if (allocated(DstMiscData%RodStateIs1)) then + deallocate(DstMiscData%RodStateIs1) + end if + if (allocated(SrcMiscData%RodStateIsN)) then + LB(1:1) = lbound(SrcMiscData%RodStateIsN) + UB(1:1) = ubound(SrcMiscData%RodStateIsN) + if (.not. allocated(DstMiscData%RodStateIsN)) then + allocate(DstMiscData%RodStateIsN(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodStateIsN.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%RodStateIsN = SrcMiscData%RodStateIsN + else if (allocated(DstMiscData%RodStateIsN)) then + deallocate(DstMiscData%RodStateIsN) + end if + if (allocated(SrcMiscData%BodyStateIs1)) then + LB(1:1) = lbound(SrcMiscData%BodyStateIs1) + UB(1:1) = ubound(SrcMiscData%BodyStateIs1) + if (.not. allocated(DstMiscData%BodyStateIs1)) then + allocate(DstMiscData%BodyStateIs1(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BodyStateIs1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%BodyStateIs1 = SrcMiscData%BodyStateIs1 + else if (allocated(DstMiscData%BodyStateIs1)) then + deallocate(DstMiscData%BodyStateIs1) + end if + if (allocated(SrcMiscData%BodyStateIsN)) then + LB(1:1) = lbound(SrcMiscData%BodyStateIsN) + UB(1:1) = ubound(SrcMiscData%BodyStateIsN) + if (.not. allocated(DstMiscData%BodyStateIsN)) then + allocate(DstMiscData%BodyStateIsN(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BodyStateIsN.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%BodyStateIsN = SrcMiscData%BodyStateIsN + else if (allocated(DstMiscData%BodyStateIsN)) then + deallocate(DstMiscData%BodyStateIsN) + end if + DstMiscData%Nx = SrcMiscData%Nx + DstMiscData%WaveTi = SrcMiscData%WaveTi + call MD_CopyContState(SrcMiscData%xTemp, DstMiscData%xTemp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MD_CopyContState(SrcMiscData%xdTemp, DstMiscData%xdTemp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstMiscData%zeros6 = SrcMiscData%zeros6 + if (allocated(SrcMiscData%MDWrOutput)) then + LB(1:1) = lbound(SrcMiscData%MDWrOutput) + UB(1:1) = ubound(SrcMiscData%MDWrOutput) + if (.not. allocated(DstMiscData%MDWrOutput)) then + allocate(DstMiscData%MDWrOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%MDWrOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%MDWrOutput = SrcMiscData%MDWrOutput + else if (allocated(DstMiscData%MDWrOutput)) then + deallocate(DstMiscData%MDWrOutput) + end if + DstMiscData%LastOutTime = SrcMiscData%LastOutTime + DstMiscData%PtfmInit = SrcMiscData%PtfmInit + if (allocated(SrcMiscData%BathymetryGrid)) then + LB(1:2) = lbound(SrcMiscData%BathymetryGrid) + UB(1:2) = ubound(SrcMiscData%BathymetryGrid) + if (.not. allocated(DstMiscData%BathymetryGrid)) then + allocate(DstMiscData%BathymetryGrid(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathymetryGrid.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%BathymetryGrid = SrcMiscData%BathymetryGrid + else if (allocated(DstMiscData%BathymetryGrid)) then + deallocate(DstMiscData%BathymetryGrid) + end if + if (allocated(SrcMiscData%BathGrid_Xs)) then + LB(1:1) = lbound(SrcMiscData%BathGrid_Xs) + UB(1:1) = ubound(SrcMiscData%BathGrid_Xs) + if (.not. allocated(DstMiscData%BathGrid_Xs)) then + allocate(DstMiscData%BathGrid_Xs(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathGrid_Xs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%BathGrid_Xs = SrcMiscData%BathGrid_Xs + else if (allocated(DstMiscData%BathGrid_Xs)) then + deallocate(DstMiscData%BathGrid_Xs) + end if + if (allocated(SrcMiscData%BathGrid_Ys)) then + LB(1:1) = lbound(SrcMiscData%BathGrid_Ys) + UB(1:1) = ubound(SrcMiscData%BathGrid_Ys) + if (.not. allocated(DstMiscData%BathGrid_Ys)) then + allocate(DstMiscData%BathGrid_Ys(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathGrid_Ys.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%BathGrid_Ys = SrcMiscData%BathGrid_Ys + else if (allocated(DstMiscData%BathGrid_Ys)) then + deallocate(DstMiscData%BathGrid_Ys) + end if + if (allocated(SrcMiscData%BathGrid_npoints)) then + LB(1:1) = lbound(SrcMiscData%BathGrid_npoints) + UB(1:1) = ubound(SrcMiscData%BathGrid_npoints) + if (.not. allocated(DstMiscData%BathGrid_npoints)) then + allocate(DstMiscData%BathGrid_npoints(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathGrid_npoints.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%BathGrid_npoints = SrcMiscData%BathGrid_npoints + else if (allocated(DstMiscData%BathGrid_npoints)) then + deallocate(DstMiscData%BathGrid_npoints) + end if +end subroutine +subroutine MD_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(MD_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MD_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%LineTypeList)) then + LB(1:1) = lbound(MiscData%LineTypeList) + UB(1:1) = ubound(MiscData%LineTypeList) + do i1 = LB(1), UB(1) + call MD_DestroyLineProp(MiscData%LineTypeList(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%LineTypeList) + end if + if (allocated(MiscData%RodTypeList)) then + LB(1:1) = lbound(MiscData%RodTypeList) + UB(1:1) = ubound(MiscData%RodTypeList) + do i1 = LB(1), UB(1) + call MD_DestroyRodProp(MiscData%RodTypeList(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%RodTypeList) + end if + if (allocated(MiscData%BodyList)) then + LB(1:1) = lbound(MiscData%BodyList) + UB(1:1) = ubound(MiscData%BodyList) + do i1 = LB(1), UB(1) + call MD_DestroyBody(MiscData%BodyList(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%BodyList) + end if + if (allocated(MiscData%RodList)) then + LB(1:1) = lbound(MiscData%RodList) + UB(1:1) = ubound(MiscData%RodList) + do i1 = LB(1), UB(1) + call MD_DestroyRod(MiscData%RodList(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%RodList) + end if + if (allocated(MiscData%ConnectList)) then + LB(1:1) = lbound(MiscData%ConnectList) + UB(1:1) = ubound(MiscData%ConnectList) + do i1 = LB(1), UB(1) + call MD_DestroyConnect(MiscData%ConnectList(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%ConnectList) + end if + if (allocated(MiscData%LineList)) then + LB(1:1) = lbound(MiscData%LineList) + UB(1:1) = ubound(MiscData%LineList) + do i1 = LB(1), UB(1) + call MD_DestroyLine(MiscData%LineList(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%LineList) + end if + if (allocated(MiscData%FailList)) then + LB(1:1) = lbound(MiscData%FailList) + UB(1:1) = ubound(MiscData%FailList) + do i1 = LB(1), UB(1) + call MD_DestroyFail(MiscData%FailList(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%FailList) + end if + if (allocated(MiscData%FreeConIs)) then + deallocate(MiscData%FreeConIs) + end if + if (allocated(MiscData%CpldConIs)) then + deallocate(MiscData%CpldConIs) + end if + if (allocated(MiscData%FreeRodIs)) then + deallocate(MiscData%FreeRodIs) + end if + if (allocated(MiscData%CpldRodIs)) then + deallocate(MiscData%CpldRodIs) + end if + if (allocated(MiscData%FreeBodyIs)) then + deallocate(MiscData%FreeBodyIs) + end if + if (allocated(MiscData%CpldBodyIs)) then + deallocate(MiscData%CpldBodyIs) + end if + if (allocated(MiscData%LineStateIs1)) then + deallocate(MiscData%LineStateIs1) + end if + if (allocated(MiscData%LineStateIsN)) then + deallocate(MiscData%LineStateIsN) + end if + if (allocated(MiscData%ConStateIs1)) then + deallocate(MiscData%ConStateIs1) + end if + if (allocated(MiscData%ConStateIsN)) then + deallocate(MiscData%ConStateIsN) + end if + if (allocated(MiscData%RodStateIs1)) then + deallocate(MiscData%RodStateIs1) + end if + if (allocated(MiscData%RodStateIsN)) then + deallocate(MiscData%RodStateIsN) + end if + if (allocated(MiscData%BodyStateIs1)) then + deallocate(MiscData%BodyStateIs1) + end if + if (allocated(MiscData%BodyStateIsN)) then + deallocate(MiscData%BodyStateIsN) + end if + if (allocated(MiscData%MDWrOutput)) then + deallocate(MiscData%MDWrOutput) + end if + if (allocated(MiscData%BathymetryGrid)) then + deallocate(MiscData%BathymetryGrid) + end if + if (allocated(MiscData%BathGrid_Xs)) then + deallocate(MiscData%BathGrid_Xs) + end if + if (allocated(MiscData%BathGrid_Ys)) then + deallocate(MiscData%BathGrid_Ys) + end if + if (allocated(MiscData%BathGrid_npoints)) then + deallocate(MiscData%BathGrid_npoints) + end if +end subroutine subroutine MD_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -5363,7 +4808,6 @@ subroutine MD_PackMisc(Buf, Indata) integer(IntKi) :: i1, i2 integer(IntKi) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return - ! LineTypeList call RegPack(Buf, allocated(InData%LineTypeList)) if (allocated(InData%LineTypeList)) then call RegPackBounds(Buf, 1, lbound(InData%LineTypeList), ubound(InData%LineTypeList)) @@ -5374,7 +4818,6 @@ subroutine MD_PackMisc(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! RodTypeList call RegPack(Buf, allocated(InData%RodTypeList)) if (allocated(InData%RodTypeList)) then call RegPackBounds(Buf, 1, lbound(InData%RodTypeList), ubound(InData%RodTypeList)) @@ -5385,10 +4828,8 @@ subroutine MD_PackMisc(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! GroundBody call MD_PackBody(Buf, InData%GroundBody) if (RegCheckErr(Buf, RoutineName)) return - ! BodyList call RegPack(Buf, allocated(InData%BodyList)) if (allocated(InData%BodyList)) then call RegPackBounds(Buf, 1, lbound(InData%BodyList), ubound(InData%BodyList)) @@ -5399,7 +4840,6 @@ subroutine MD_PackMisc(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! RodList call RegPack(Buf, allocated(InData%RodList)) if (allocated(InData%RodList)) then call RegPackBounds(Buf, 1, lbound(InData%RodList), ubound(InData%RodList)) @@ -5410,7 +4850,6 @@ subroutine MD_PackMisc(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! ConnectList call RegPack(Buf, allocated(InData%ConnectList)) if (allocated(InData%ConnectList)) then call RegPackBounds(Buf, 1, lbound(InData%ConnectList), ubound(InData%ConnectList)) @@ -5421,7 +4860,6 @@ subroutine MD_PackMisc(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! LineList call RegPack(Buf, allocated(InData%LineList)) if (allocated(InData%LineList)) then call RegPackBounds(Buf, 1, lbound(InData%LineList), ubound(InData%LineList)) @@ -5432,7 +4870,6 @@ subroutine MD_PackMisc(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! FailList call RegPack(Buf, allocated(InData%FailList)) if (allocated(InData%FailList)) then call RegPackBounds(Buf, 1, lbound(InData%FailList), ubound(InData%FailList)) @@ -5443,154 +4880,128 @@ subroutine MD_PackMisc(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! FreeConIs call RegPack(Buf, allocated(InData%FreeConIs)) if (allocated(InData%FreeConIs)) then call RegPackBounds(Buf, 1, lbound(InData%FreeConIs), ubound(InData%FreeConIs)) call RegPack(Buf, InData%FreeConIs) end if if (RegCheckErr(Buf, RoutineName)) return - ! CpldConIs call RegPack(Buf, allocated(InData%CpldConIs)) if (allocated(InData%CpldConIs)) then call RegPackBounds(Buf, 2, lbound(InData%CpldConIs), ubound(InData%CpldConIs)) call RegPack(Buf, InData%CpldConIs) end if if (RegCheckErr(Buf, RoutineName)) return - ! FreeRodIs call RegPack(Buf, allocated(InData%FreeRodIs)) if (allocated(InData%FreeRodIs)) then call RegPackBounds(Buf, 1, lbound(InData%FreeRodIs), ubound(InData%FreeRodIs)) call RegPack(Buf, InData%FreeRodIs) end if if (RegCheckErr(Buf, RoutineName)) return - ! CpldRodIs call RegPack(Buf, allocated(InData%CpldRodIs)) if (allocated(InData%CpldRodIs)) then call RegPackBounds(Buf, 2, lbound(InData%CpldRodIs), ubound(InData%CpldRodIs)) call RegPack(Buf, InData%CpldRodIs) end if if (RegCheckErr(Buf, RoutineName)) return - ! FreeBodyIs call RegPack(Buf, allocated(InData%FreeBodyIs)) if (allocated(InData%FreeBodyIs)) then call RegPackBounds(Buf, 1, lbound(InData%FreeBodyIs), ubound(InData%FreeBodyIs)) call RegPack(Buf, InData%FreeBodyIs) end if if (RegCheckErr(Buf, RoutineName)) return - ! CpldBodyIs call RegPack(Buf, allocated(InData%CpldBodyIs)) if (allocated(InData%CpldBodyIs)) then call RegPackBounds(Buf, 2, lbound(InData%CpldBodyIs), ubound(InData%CpldBodyIs)) call RegPack(Buf, InData%CpldBodyIs) end if if (RegCheckErr(Buf, RoutineName)) return - ! LineStateIs1 call RegPack(Buf, allocated(InData%LineStateIs1)) if (allocated(InData%LineStateIs1)) then call RegPackBounds(Buf, 1, lbound(InData%LineStateIs1), ubound(InData%LineStateIs1)) call RegPack(Buf, InData%LineStateIs1) end if if (RegCheckErr(Buf, RoutineName)) return - ! LineStateIsN call RegPack(Buf, allocated(InData%LineStateIsN)) if (allocated(InData%LineStateIsN)) then call RegPackBounds(Buf, 1, lbound(InData%LineStateIsN), ubound(InData%LineStateIsN)) call RegPack(Buf, InData%LineStateIsN) end if if (RegCheckErr(Buf, RoutineName)) return - ! ConStateIs1 call RegPack(Buf, allocated(InData%ConStateIs1)) if (allocated(InData%ConStateIs1)) then call RegPackBounds(Buf, 1, lbound(InData%ConStateIs1), ubound(InData%ConStateIs1)) call RegPack(Buf, InData%ConStateIs1) end if if (RegCheckErr(Buf, RoutineName)) return - ! ConStateIsN call RegPack(Buf, allocated(InData%ConStateIsN)) if (allocated(InData%ConStateIsN)) then call RegPackBounds(Buf, 1, lbound(InData%ConStateIsN), ubound(InData%ConStateIsN)) call RegPack(Buf, InData%ConStateIsN) end if if (RegCheckErr(Buf, RoutineName)) return - ! RodStateIs1 call RegPack(Buf, allocated(InData%RodStateIs1)) if (allocated(InData%RodStateIs1)) then call RegPackBounds(Buf, 1, lbound(InData%RodStateIs1), ubound(InData%RodStateIs1)) call RegPack(Buf, InData%RodStateIs1) end if if (RegCheckErr(Buf, RoutineName)) return - ! RodStateIsN call RegPack(Buf, allocated(InData%RodStateIsN)) if (allocated(InData%RodStateIsN)) then call RegPackBounds(Buf, 1, lbound(InData%RodStateIsN), ubound(InData%RodStateIsN)) call RegPack(Buf, InData%RodStateIsN) end if if (RegCheckErr(Buf, RoutineName)) return - ! BodyStateIs1 call RegPack(Buf, allocated(InData%BodyStateIs1)) if (allocated(InData%BodyStateIs1)) then call RegPackBounds(Buf, 1, lbound(InData%BodyStateIs1), ubound(InData%BodyStateIs1)) call RegPack(Buf, InData%BodyStateIs1) end if if (RegCheckErr(Buf, RoutineName)) return - ! BodyStateIsN call RegPack(Buf, allocated(InData%BodyStateIsN)) if (allocated(InData%BodyStateIsN)) then call RegPackBounds(Buf, 1, lbound(InData%BodyStateIsN), ubound(InData%BodyStateIsN)) call RegPack(Buf, InData%BodyStateIsN) end if if (RegCheckErr(Buf, RoutineName)) return - ! Nx call RegPack(Buf, InData%Nx) if (RegCheckErr(Buf, RoutineName)) return - ! WaveTi call RegPack(Buf, InData%WaveTi) if (RegCheckErr(Buf, RoutineName)) return - ! xTemp call MD_PackContState(Buf, InData%xTemp) if (RegCheckErr(Buf, RoutineName)) return - ! xdTemp call MD_PackContState(Buf, InData%xdTemp) if (RegCheckErr(Buf, RoutineName)) return - ! zeros6 call RegPack(Buf, InData%zeros6) if (RegCheckErr(Buf, RoutineName)) return - ! MDWrOutput call RegPack(Buf, allocated(InData%MDWrOutput)) if (allocated(InData%MDWrOutput)) then call RegPackBounds(Buf, 1, lbound(InData%MDWrOutput), ubound(InData%MDWrOutput)) call RegPack(Buf, InData%MDWrOutput) end if if (RegCheckErr(Buf, RoutineName)) return - ! LastOutTime call RegPack(Buf, InData%LastOutTime) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmInit call RegPack(Buf, InData%PtfmInit) if (RegCheckErr(Buf, RoutineName)) return - ! BathymetryGrid call RegPack(Buf, allocated(InData%BathymetryGrid)) if (allocated(InData%BathymetryGrid)) then call RegPackBounds(Buf, 2, lbound(InData%BathymetryGrid), ubound(InData%BathymetryGrid)) call RegPack(Buf, InData%BathymetryGrid) end if if (RegCheckErr(Buf, RoutineName)) return - ! BathGrid_Xs call RegPack(Buf, allocated(InData%BathGrid_Xs)) if (allocated(InData%BathGrid_Xs)) then call RegPackBounds(Buf, 1, lbound(InData%BathGrid_Xs), ubound(InData%BathGrid_Xs)) call RegPack(Buf, InData%BathGrid_Xs) end if if (RegCheckErr(Buf, RoutineName)) return - ! BathGrid_Ys call RegPack(Buf, allocated(InData%BathGrid_Ys)) if (allocated(InData%BathGrid_Ys)) then call RegPackBounds(Buf, 1, lbound(InData%BathGrid_Ys), ubound(InData%BathGrid_Ys)) call RegPack(Buf, InData%BathGrid_Ys) end if if (RegCheckErr(Buf, RoutineName)) return - ! BathGrid_npoints call RegPack(Buf, allocated(InData%BathGrid_npoints)) if (allocated(InData%BathGrid_npoints)) then call RegPackBounds(Buf, 1, lbound(InData%BathGrid_npoints), ubound(InData%BathGrid_npoints)) @@ -5608,7 +5019,6 @@ subroutine MD_UnPackMisc(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! LineTypeList if (allocated(OutData%LineTypeList)) deallocate(OutData%LineTypeList) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5624,7 +5034,6 @@ subroutine MD_UnPackMisc(Buf, OutData) call MD_UnpackLineProp(Buf, OutData%LineTypeList(i1)) ! LineTypeList end do end if - ! RodTypeList if (allocated(OutData%RodTypeList)) deallocate(OutData%RodTypeList) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5640,9 +5049,7 @@ subroutine MD_UnPackMisc(Buf, OutData) call MD_UnpackRodProp(Buf, OutData%RodTypeList(i1)) ! RodTypeList end do end if - ! GroundBody call MD_UnpackBody(Buf, OutData%GroundBody) ! GroundBody - ! BodyList if (allocated(OutData%BodyList)) deallocate(OutData%BodyList) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5658,7 +5065,6 @@ subroutine MD_UnPackMisc(Buf, OutData) call MD_UnpackBody(Buf, OutData%BodyList(i1)) ! BodyList end do end if - ! RodList if (allocated(OutData%RodList)) deallocate(OutData%RodList) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5674,7 +5080,6 @@ subroutine MD_UnPackMisc(Buf, OutData) call MD_UnpackRod(Buf, OutData%RodList(i1)) ! RodList end do end if - ! ConnectList if (allocated(OutData%ConnectList)) deallocate(OutData%ConnectList) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5690,7 +5095,6 @@ subroutine MD_UnPackMisc(Buf, OutData) call MD_UnpackConnect(Buf, OutData%ConnectList(i1)) ! ConnectList end do end if - ! LineList if (allocated(OutData%LineList)) deallocate(OutData%LineList) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5706,7 +5110,6 @@ subroutine MD_UnPackMisc(Buf, OutData) call MD_UnpackLine(Buf, OutData%LineList(i1)) ! LineList end do end if - ! FailList if (allocated(OutData%FailList)) deallocate(OutData%FailList) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5722,7 +5125,6 @@ subroutine MD_UnPackMisc(Buf, OutData) call MD_UnpackFail(Buf, OutData%FailList(i1)) ! FailList end do end if - ! FreeConIs if (allocated(OutData%FreeConIs)) deallocate(OutData%FreeConIs) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5737,7 +5139,6 @@ subroutine MD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%FreeConIs) if (RegCheckErr(Buf, RoutineName)) return end if - ! CpldConIs if (allocated(OutData%CpldConIs)) deallocate(OutData%CpldConIs) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5752,7 +5153,6 @@ subroutine MD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%CpldConIs) if (RegCheckErr(Buf, RoutineName)) return end if - ! FreeRodIs if (allocated(OutData%FreeRodIs)) deallocate(OutData%FreeRodIs) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5767,7 +5167,6 @@ subroutine MD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%FreeRodIs) if (RegCheckErr(Buf, RoutineName)) return end if - ! CpldRodIs if (allocated(OutData%CpldRodIs)) deallocate(OutData%CpldRodIs) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5782,7 +5181,6 @@ subroutine MD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%CpldRodIs) if (RegCheckErr(Buf, RoutineName)) return end if - ! FreeBodyIs if (allocated(OutData%FreeBodyIs)) deallocate(OutData%FreeBodyIs) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5797,7 +5195,6 @@ subroutine MD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%FreeBodyIs) if (RegCheckErr(Buf, RoutineName)) return end if - ! CpldBodyIs if (allocated(OutData%CpldBodyIs)) deallocate(OutData%CpldBodyIs) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5812,7 +5209,6 @@ subroutine MD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%CpldBodyIs) if (RegCheckErr(Buf, RoutineName)) return end if - ! LineStateIs1 if (allocated(OutData%LineStateIs1)) deallocate(OutData%LineStateIs1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5827,7 +5223,6 @@ subroutine MD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%LineStateIs1) if (RegCheckErr(Buf, RoutineName)) return end if - ! LineStateIsN if (allocated(OutData%LineStateIsN)) deallocate(OutData%LineStateIsN) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5842,7 +5237,6 @@ subroutine MD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%LineStateIsN) if (RegCheckErr(Buf, RoutineName)) return end if - ! ConStateIs1 if (allocated(OutData%ConStateIs1)) deallocate(OutData%ConStateIs1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5857,7 +5251,6 @@ subroutine MD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%ConStateIs1) if (RegCheckErr(Buf, RoutineName)) return end if - ! ConStateIsN if (allocated(OutData%ConStateIsN)) deallocate(OutData%ConStateIsN) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5872,7 +5265,6 @@ subroutine MD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%ConStateIsN) if (RegCheckErr(Buf, RoutineName)) return end if - ! RodStateIs1 if (allocated(OutData%RodStateIs1)) deallocate(OutData%RodStateIs1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5887,7 +5279,6 @@ subroutine MD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%RodStateIs1) if (RegCheckErr(Buf, RoutineName)) return end if - ! RodStateIsN if (allocated(OutData%RodStateIsN)) deallocate(OutData%RodStateIsN) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5902,7 +5293,6 @@ subroutine MD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%RodStateIsN) if (RegCheckErr(Buf, RoutineName)) return end if - ! BodyStateIs1 if (allocated(OutData%BodyStateIs1)) deallocate(OutData%BodyStateIs1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5917,7 +5307,6 @@ subroutine MD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%BodyStateIs1) if (RegCheckErr(Buf, RoutineName)) return end if - ! BodyStateIsN if (allocated(OutData%BodyStateIsN)) deallocate(OutData%BodyStateIsN) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5932,20 +5321,14 @@ subroutine MD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%BodyStateIsN) if (RegCheckErr(Buf, RoutineName)) return end if - ! Nx call RegUnpack(Buf, OutData%Nx) if (RegCheckErr(Buf, RoutineName)) return - ! WaveTi call RegUnpack(Buf, OutData%WaveTi) if (RegCheckErr(Buf, RoutineName)) return - ! xTemp call MD_UnpackContState(Buf, OutData%xTemp) ! xTemp - ! xdTemp call MD_UnpackContState(Buf, OutData%xdTemp) ! xdTemp - ! zeros6 call RegUnpack(Buf, OutData%zeros6) if (RegCheckErr(Buf, RoutineName)) return - ! MDWrOutput if (allocated(OutData%MDWrOutput)) deallocate(OutData%MDWrOutput) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5960,13 +5343,10 @@ subroutine MD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%MDWrOutput) if (RegCheckErr(Buf, RoutineName)) return end if - ! LastOutTime call RegUnpack(Buf, OutData%LastOutTime) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmInit call RegUnpack(Buf, OutData%PtfmInit) if (RegCheckErr(Buf, RoutineName)) return - ! BathymetryGrid if (allocated(OutData%BathymetryGrid)) deallocate(OutData%BathymetryGrid) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5981,7 +5361,6 @@ subroutine MD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%BathymetryGrid) if (RegCheckErr(Buf, RoutineName)) return end if - ! BathGrid_Xs if (allocated(OutData%BathGrid_Xs)) deallocate(OutData%BathGrid_Xs) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5996,7 +5375,6 @@ subroutine MD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%BathGrid_Xs) if (RegCheckErr(Buf, RoutineName)) return end if - ! BathGrid_Ys if (allocated(OutData%BathGrid_Ys)) deallocate(OutData%BathGrid_Ys) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6011,7 +5389,6 @@ subroutine MD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%BathGrid_Ys) if (RegCheckErr(Buf, RoutineName)) return end if - ! BathGrid_npoints if (allocated(OutData%BathGrid_npoints)) deallocate(OutData%BathGrid_npoints) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6027,490 +5404,481 @@ subroutine MD_UnPackMisc(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE MD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_ParameterType), INTENT(IN) :: SrcParamData - TYPE(MD_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%nLineTypes = SrcParamData%nLineTypes - DstParamData%nRodTypes = SrcParamData%nRodTypes - DstParamData%nConnects = SrcParamData%nConnects - DstParamData%nConnectsExtra = SrcParamData%nConnectsExtra - DstParamData%nBodies = SrcParamData%nBodies - DstParamData%nRods = SrcParamData%nRods - DstParamData%nLines = SrcParamData%nLines - DstParamData%nCtrlChans = SrcParamData%nCtrlChans - DstParamData%nFails = SrcParamData%nFails - DstParamData%nFreeBodies = SrcParamData%nFreeBodies - DstParamData%nFreeRods = SrcParamData%nFreeRods - DstParamData%nFreeCons = SrcParamData%nFreeCons -IF (ALLOCATED(SrcParamData%nCpldBodies)) THEN - i1_l = LBOUND(SrcParamData%nCpldBodies,1) - i1_u = UBOUND(SrcParamData%nCpldBodies,1) - IF (.NOT. ALLOCATED(DstParamData%nCpldBodies)) THEN - ALLOCATE(DstParamData%nCpldBodies(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%nCpldBodies.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%nCpldBodies = SrcParamData%nCpldBodies -ENDIF -IF (ALLOCATED(SrcParamData%nCpldRods)) THEN - i1_l = LBOUND(SrcParamData%nCpldRods,1) - i1_u = UBOUND(SrcParamData%nCpldRods,1) - IF (.NOT. ALLOCATED(DstParamData%nCpldRods)) THEN - ALLOCATE(DstParamData%nCpldRods(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%nCpldRods.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%nCpldRods = SrcParamData%nCpldRods -ENDIF -IF (ALLOCATED(SrcParamData%nCpldCons)) THEN - i1_l = LBOUND(SrcParamData%nCpldCons,1) - i1_u = UBOUND(SrcParamData%nCpldCons,1) - IF (.NOT. ALLOCATED(DstParamData%nCpldCons)) THEN - ALLOCATE(DstParamData%nCpldCons(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%nCpldCons.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%nCpldCons = SrcParamData%nCpldCons -ENDIF - DstParamData%NConns = SrcParamData%NConns - DstParamData%NAnchs = SrcParamData%NAnchs - DstParamData%Tmax = SrcParamData%Tmax - DstParamData%g = SrcParamData%g - DstParamData%rhoW = SrcParamData%rhoW - DstParamData%WtrDpth = SrcParamData%WtrDpth - DstParamData%kBot = SrcParamData%kBot - DstParamData%cBot = SrcParamData%cBot - DstParamData%dtM0 = SrcParamData%dtM0 - DstParamData%dtCoupling = SrcParamData%dtCoupling - DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%dtOut = SrcParamData%dtOut - DstParamData%RootName = SrcParamData%RootName -IF (ALLOCATED(SrcParamData%OutParam)) THEN - i1_l = LBOUND(SrcParamData%OutParam,1) - i1_u = UBOUND(SrcParamData%OutParam,1) - IF (.NOT. ALLOCATED(DstParamData%OutParam)) THEN - ALLOCATE(DstParamData%OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%OutParam,1), UBOUND(SrcParamData%OutParam,1) - CALL MD_Copyoutparmtype( SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstParamData%Delim = SrcParamData%Delim - DstParamData%MDUnOut = SrcParamData%MDUnOut - DstParamData%PriPath = SrcParamData%PriPath - DstParamData%writeLog = SrcParamData%writeLog - DstParamData%UnLog = SrcParamData%UnLog - DstParamData%WaveKin = SrcParamData%WaveKin - DstParamData%Current = SrcParamData%Current - DstParamData%nTurbines = SrcParamData%nTurbines -IF (ALLOCATED(SrcParamData%TurbineRefPos)) THEN - i1_l = LBOUND(SrcParamData%TurbineRefPos,1) - i1_u = UBOUND(SrcParamData%TurbineRefPos,1) - i2_l = LBOUND(SrcParamData%TurbineRefPos,2) - i2_u = UBOUND(SrcParamData%TurbineRefPos,2) - IF (.NOT. ALLOCATED(DstParamData%TurbineRefPos)) THEN - ALLOCATE(DstParamData%TurbineRefPos(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TurbineRefPos.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TurbineRefPos = SrcParamData%TurbineRefPos -ENDIF - DstParamData%mu_kT = SrcParamData%mu_kT - DstParamData%mu_kA = SrcParamData%mu_kA - DstParamData%mc = SrcParamData%mc - DstParamData%cv = SrcParamData%cv - DstParamData%nxWave = SrcParamData%nxWave - DstParamData%nyWave = SrcParamData%nyWave - DstParamData%nzWave = SrcParamData%nzWave - DstParamData%ntWave = SrcParamData%ntWave -IF (ALLOCATED(SrcParamData%pxWave)) THEN - i1_l = LBOUND(SrcParamData%pxWave,1) - i1_u = UBOUND(SrcParamData%pxWave,1) - IF (.NOT. ALLOCATED(DstParamData%pxWave)) THEN - ALLOCATE(DstParamData%pxWave(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pxWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%pxWave = SrcParamData%pxWave -ENDIF -IF (ALLOCATED(SrcParamData%pyWave)) THEN - i1_l = LBOUND(SrcParamData%pyWave,1) - i1_u = UBOUND(SrcParamData%pyWave,1) - IF (.NOT. ALLOCATED(DstParamData%pyWave)) THEN - ALLOCATE(DstParamData%pyWave(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pyWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%pyWave = SrcParamData%pyWave -ENDIF -IF (ALLOCATED(SrcParamData%pzWave)) THEN - i1_l = LBOUND(SrcParamData%pzWave,1) - i1_u = UBOUND(SrcParamData%pzWave,1) - IF (.NOT. ALLOCATED(DstParamData%pzWave)) THEN - ALLOCATE(DstParamData%pzWave(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pzWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%pzWave = SrcParamData%pzWave -ENDIF - DstParamData%dtWave = SrcParamData%dtWave -IF (ALLOCATED(SrcParamData%uxWave)) THEN - i1_l = LBOUND(SrcParamData%uxWave,1) - i1_u = UBOUND(SrcParamData%uxWave,1) - i2_l = LBOUND(SrcParamData%uxWave,2) - i2_u = UBOUND(SrcParamData%uxWave,2) - i3_l = LBOUND(SrcParamData%uxWave,3) - i3_u = UBOUND(SrcParamData%uxWave,3) - i4_l = LBOUND(SrcParamData%uxWave,4) - i4_u = UBOUND(SrcParamData%uxWave,4) - IF (.NOT. ALLOCATED(DstParamData%uxWave)) THEN - ALLOCATE(DstParamData%uxWave(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uxWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%uxWave = SrcParamData%uxWave -ENDIF -IF (ALLOCATED(SrcParamData%uyWave)) THEN - i1_l = LBOUND(SrcParamData%uyWave,1) - i1_u = UBOUND(SrcParamData%uyWave,1) - i2_l = LBOUND(SrcParamData%uyWave,2) - i2_u = UBOUND(SrcParamData%uyWave,2) - i3_l = LBOUND(SrcParamData%uyWave,3) - i3_u = UBOUND(SrcParamData%uyWave,3) - i4_l = LBOUND(SrcParamData%uyWave,4) - i4_u = UBOUND(SrcParamData%uyWave,4) - IF (.NOT. ALLOCATED(DstParamData%uyWave)) THEN - ALLOCATE(DstParamData%uyWave(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uyWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%uyWave = SrcParamData%uyWave -ENDIF -IF (ALLOCATED(SrcParamData%uzWave)) THEN - i1_l = LBOUND(SrcParamData%uzWave,1) - i1_u = UBOUND(SrcParamData%uzWave,1) - i2_l = LBOUND(SrcParamData%uzWave,2) - i2_u = UBOUND(SrcParamData%uzWave,2) - i3_l = LBOUND(SrcParamData%uzWave,3) - i3_u = UBOUND(SrcParamData%uzWave,3) - i4_l = LBOUND(SrcParamData%uzWave,4) - i4_u = UBOUND(SrcParamData%uzWave,4) - IF (.NOT. ALLOCATED(DstParamData%uzWave)) THEN - ALLOCATE(DstParamData%uzWave(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uzWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%uzWave = SrcParamData%uzWave -ENDIF -IF (ALLOCATED(SrcParamData%axWave)) THEN - i1_l = LBOUND(SrcParamData%axWave,1) - i1_u = UBOUND(SrcParamData%axWave,1) - i2_l = LBOUND(SrcParamData%axWave,2) - i2_u = UBOUND(SrcParamData%axWave,2) - i3_l = LBOUND(SrcParamData%axWave,3) - i3_u = UBOUND(SrcParamData%axWave,3) - i4_l = LBOUND(SrcParamData%axWave,4) - i4_u = UBOUND(SrcParamData%axWave,4) - IF (.NOT. ALLOCATED(DstParamData%axWave)) THEN - ALLOCATE(DstParamData%axWave(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%axWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%axWave = SrcParamData%axWave -ENDIF -IF (ALLOCATED(SrcParamData%ayWave)) THEN - i1_l = LBOUND(SrcParamData%ayWave,1) - i1_u = UBOUND(SrcParamData%ayWave,1) - i2_l = LBOUND(SrcParamData%ayWave,2) - i2_u = UBOUND(SrcParamData%ayWave,2) - i3_l = LBOUND(SrcParamData%ayWave,3) - i3_u = UBOUND(SrcParamData%ayWave,3) - i4_l = LBOUND(SrcParamData%ayWave,4) - i4_u = UBOUND(SrcParamData%ayWave,4) - IF (.NOT. ALLOCATED(DstParamData%ayWave)) THEN - ALLOCATE(DstParamData%ayWave(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ayWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ayWave = SrcParamData%ayWave -ENDIF -IF (ALLOCATED(SrcParamData%azWave)) THEN - i1_l = LBOUND(SrcParamData%azWave,1) - i1_u = UBOUND(SrcParamData%azWave,1) - i2_l = LBOUND(SrcParamData%azWave,2) - i2_u = UBOUND(SrcParamData%azWave,2) - i3_l = LBOUND(SrcParamData%azWave,3) - i3_u = UBOUND(SrcParamData%azWave,3) - i4_l = LBOUND(SrcParamData%azWave,4) - i4_u = UBOUND(SrcParamData%azWave,4) - IF (.NOT. ALLOCATED(DstParamData%azWave)) THEN - ALLOCATE(DstParamData%azWave(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%azWave.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%azWave = SrcParamData%azWave -ENDIF -IF (ALLOCATED(SrcParamData%PDyn)) THEN - i1_l = LBOUND(SrcParamData%PDyn,1) - i1_u = UBOUND(SrcParamData%PDyn,1) - i2_l = LBOUND(SrcParamData%PDyn,2) - i2_u = UBOUND(SrcParamData%PDyn,2) - i3_l = LBOUND(SrcParamData%PDyn,3) - i3_u = UBOUND(SrcParamData%PDyn,3) - i4_l = LBOUND(SrcParamData%PDyn,4) - i4_u = UBOUND(SrcParamData%PDyn,4) - IF (.NOT. ALLOCATED(DstParamData%PDyn)) THEN - ALLOCATE(DstParamData%PDyn(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PDyn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%PDyn = SrcParamData%PDyn -ENDIF -IF (ALLOCATED(SrcParamData%zeta)) THEN - i1_l = LBOUND(SrcParamData%zeta,1) - i1_u = UBOUND(SrcParamData%zeta,1) - i2_l = LBOUND(SrcParamData%zeta,2) - i2_u = UBOUND(SrcParamData%zeta,2) - i3_l = LBOUND(SrcParamData%zeta,3) - i3_u = UBOUND(SrcParamData%zeta,3) - IF (.NOT. ALLOCATED(DstParamData%zeta)) THEN - ALLOCATE(DstParamData%zeta(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%zeta.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%zeta = SrcParamData%zeta -ENDIF - DstParamData%nzCurrent = SrcParamData%nzCurrent -IF (ALLOCATED(SrcParamData%pzCurrent)) THEN - i1_l = LBOUND(SrcParamData%pzCurrent,1) - i1_u = UBOUND(SrcParamData%pzCurrent,1) - IF (.NOT. ALLOCATED(DstParamData%pzCurrent)) THEN - ALLOCATE(DstParamData%pzCurrent(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pzCurrent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%pzCurrent = SrcParamData%pzCurrent -ENDIF -IF (ALLOCATED(SrcParamData%uxCurrent)) THEN - i1_l = LBOUND(SrcParamData%uxCurrent,1) - i1_u = UBOUND(SrcParamData%uxCurrent,1) - IF (.NOT. ALLOCATED(DstParamData%uxCurrent)) THEN - ALLOCATE(DstParamData%uxCurrent(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uxCurrent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%uxCurrent = SrcParamData%uxCurrent -ENDIF -IF (ALLOCATED(SrcParamData%uyCurrent)) THEN - i1_l = LBOUND(SrcParamData%uyCurrent,1) - i1_u = UBOUND(SrcParamData%uyCurrent,1) - IF (.NOT. ALLOCATED(DstParamData%uyCurrent)) THEN - ALLOCATE(DstParamData%uyCurrent(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uyCurrent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%uyCurrent = SrcParamData%uyCurrent -ENDIF - DstParamData%Nx0 = SrcParamData%Nx0 -IF (ALLOCATED(SrcParamData%Jac_u_indx)) THEN - i1_l = LBOUND(SrcParamData%Jac_u_indx,1) - i1_u = UBOUND(SrcParamData%Jac_u_indx,1) - i2_l = LBOUND(SrcParamData%Jac_u_indx,2) - i2_u = UBOUND(SrcParamData%Jac_u_indx,2) - IF (.NOT. ALLOCATED(DstParamData%Jac_u_indx)) THEN - ALLOCATE(DstParamData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx -ENDIF -IF (ALLOCATED(SrcParamData%du)) THEN - i1_l = LBOUND(SrcParamData%du,1) - i1_u = UBOUND(SrcParamData%du,1) - IF (.NOT. ALLOCATED(DstParamData%du)) THEN - ALLOCATE(DstParamData%du(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%du = SrcParamData%du -ENDIF -IF (ALLOCATED(SrcParamData%dx)) THEN - i1_l = LBOUND(SrcParamData%dx,1) - i1_u = UBOUND(SrcParamData%dx,1) - IF (.NOT. ALLOCATED(DstParamData%dx)) THEN - ALLOCATE(DstParamData%dx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%dx = SrcParamData%dx -ENDIF - DstParamData%Jac_ny = SrcParamData%Jac_ny - DstParamData%Jac_nx = SrcParamData%Jac_nx -IF (ALLOCATED(SrcParamData%dxIdx_map2_xStateIdx)) THEN - i1_l = LBOUND(SrcParamData%dxIdx_map2_xStateIdx,1) - i1_u = UBOUND(SrcParamData%dxIdx_map2_xStateIdx,1) - IF (.NOT. ALLOCATED(DstParamData%dxIdx_map2_xStateIdx)) THEN - ALLOCATE(DstParamData%dxIdx_map2_xStateIdx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dxIdx_map2_xStateIdx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%dxIdx_map2_xStateIdx = SrcParamData%dxIdx_map2_xStateIdx -ENDIF - END SUBROUTINE MD_CopyParam - SUBROUTINE MD_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(MD_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%nCpldBodies)) THEN - DEALLOCATE(ParamData%nCpldBodies) -ENDIF -IF (ALLOCATED(ParamData%nCpldRods)) THEN - DEALLOCATE(ParamData%nCpldRods) -ENDIF -IF (ALLOCATED(ParamData%nCpldCons)) THEN - DEALLOCATE(ParamData%nCpldCons) -ENDIF -IF (ALLOCATED(ParamData%OutParam)) THEN -DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL MD_DestroyOutParmType( ParamData%OutParam(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%OutParam) -ENDIF -IF (ALLOCATED(ParamData%TurbineRefPos)) THEN - DEALLOCATE(ParamData%TurbineRefPos) -ENDIF -IF (ALLOCATED(ParamData%pxWave)) THEN - DEALLOCATE(ParamData%pxWave) -ENDIF -IF (ALLOCATED(ParamData%pyWave)) THEN - DEALLOCATE(ParamData%pyWave) -ENDIF -IF (ALLOCATED(ParamData%pzWave)) THEN - DEALLOCATE(ParamData%pzWave) -ENDIF -IF (ALLOCATED(ParamData%uxWave)) THEN - DEALLOCATE(ParamData%uxWave) -ENDIF -IF (ALLOCATED(ParamData%uyWave)) THEN - DEALLOCATE(ParamData%uyWave) -ENDIF -IF (ALLOCATED(ParamData%uzWave)) THEN - DEALLOCATE(ParamData%uzWave) -ENDIF -IF (ALLOCATED(ParamData%axWave)) THEN - DEALLOCATE(ParamData%axWave) -ENDIF -IF (ALLOCATED(ParamData%ayWave)) THEN - DEALLOCATE(ParamData%ayWave) -ENDIF -IF (ALLOCATED(ParamData%azWave)) THEN - DEALLOCATE(ParamData%azWave) -ENDIF -IF (ALLOCATED(ParamData%PDyn)) THEN - DEALLOCATE(ParamData%PDyn) -ENDIF -IF (ALLOCATED(ParamData%zeta)) THEN - DEALLOCATE(ParamData%zeta) -ENDIF -IF (ALLOCATED(ParamData%pzCurrent)) THEN - DEALLOCATE(ParamData%pzCurrent) -ENDIF -IF (ALLOCATED(ParamData%uxCurrent)) THEN - DEALLOCATE(ParamData%uxCurrent) -ENDIF -IF (ALLOCATED(ParamData%uyCurrent)) THEN - DEALLOCATE(ParamData%uyCurrent) -ENDIF -IF (ALLOCATED(ParamData%Jac_u_indx)) THEN - DEALLOCATE(ParamData%Jac_u_indx) -ENDIF -IF (ALLOCATED(ParamData%du)) THEN - DEALLOCATE(ParamData%du) -ENDIF -IF (ALLOCATED(ParamData%dx)) THEN - DEALLOCATE(ParamData%dx) -ENDIF -IF (ALLOCATED(ParamData%dxIdx_map2_xStateIdx)) THEN - DEALLOCATE(ParamData%dxIdx_map2_xStateIdx) -ENDIF - END SUBROUTINE MD_DestroyParam +subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(MD_ParameterType), intent(in) :: SrcParamData + type(MD_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3, i4 + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MD_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%nLineTypes = SrcParamData%nLineTypes + DstParamData%nRodTypes = SrcParamData%nRodTypes + DstParamData%nConnects = SrcParamData%nConnects + DstParamData%nConnectsExtra = SrcParamData%nConnectsExtra + DstParamData%nBodies = SrcParamData%nBodies + DstParamData%nRods = SrcParamData%nRods + DstParamData%nLines = SrcParamData%nLines + DstParamData%nCtrlChans = SrcParamData%nCtrlChans + DstParamData%nFails = SrcParamData%nFails + DstParamData%nFreeBodies = SrcParamData%nFreeBodies + DstParamData%nFreeRods = SrcParamData%nFreeRods + DstParamData%nFreeCons = SrcParamData%nFreeCons + if (allocated(SrcParamData%nCpldBodies)) then + LB(1:1) = lbound(SrcParamData%nCpldBodies) + UB(1:1) = ubound(SrcParamData%nCpldBodies) + if (.not. allocated(DstParamData%nCpldBodies)) then + allocate(DstParamData%nCpldBodies(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%nCpldBodies.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%nCpldBodies = SrcParamData%nCpldBodies + else if (allocated(DstParamData%nCpldBodies)) then + deallocate(DstParamData%nCpldBodies) + end if + if (allocated(SrcParamData%nCpldRods)) then + LB(1:1) = lbound(SrcParamData%nCpldRods) + UB(1:1) = ubound(SrcParamData%nCpldRods) + if (.not. allocated(DstParamData%nCpldRods)) then + allocate(DstParamData%nCpldRods(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%nCpldRods.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%nCpldRods = SrcParamData%nCpldRods + else if (allocated(DstParamData%nCpldRods)) then + deallocate(DstParamData%nCpldRods) + end if + if (allocated(SrcParamData%nCpldCons)) then + LB(1:1) = lbound(SrcParamData%nCpldCons) + UB(1:1) = ubound(SrcParamData%nCpldCons) + if (.not. allocated(DstParamData%nCpldCons)) then + allocate(DstParamData%nCpldCons(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%nCpldCons.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%nCpldCons = SrcParamData%nCpldCons + else if (allocated(DstParamData%nCpldCons)) then + deallocate(DstParamData%nCpldCons) + end if + DstParamData%NConns = SrcParamData%NConns + DstParamData%NAnchs = SrcParamData%NAnchs + DstParamData%Tmax = SrcParamData%Tmax + DstParamData%g = SrcParamData%g + DstParamData%rhoW = SrcParamData%rhoW + DstParamData%WtrDpth = SrcParamData%WtrDpth + DstParamData%kBot = SrcParamData%kBot + DstParamData%cBot = SrcParamData%cBot + DstParamData%dtM0 = SrcParamData%dtM0 + DstParamData%dtCoupling = SrcParamData%dtCoupling + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%dtOut = SrcParamData%dtOut + DstParamData%RootName = SrcParamData%RootName + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstParamData%OutParam)) then + deallocate(DstParamData%OutParam) + end if + DstParamData%Delim = SrcParamData%Delim + DstParamData%MDUnOut = SrcParamData%MDUnOut + DstParamData%PriPath = SrcParamData%PriPath + DstParamData%writeLog = SrcParamData%writeLog + DstParamData%UnLog = SrcParamData%UnLog + DstParamData%WaveKin = SrcParamData%WaveKin + DstParamData%Current = SrcParamData%Current + DstParamData%nTurbines = SrcParamData%nTurbines + if (allocated(SrcParamData%TurbineRefPos)) then + LB(1:2) = lbound(SrcParamData%TurbineRefPos) + UB(1:2) = ubound(SrcParamData%TurbineRefPos) + if (.not. allocated(DstParamData%TurbineRefPos)) then + allocate(DstParamData%TurbineRefPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TurbineRefPos.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%TurbineRefPos = SrcParamData%TurbineRefPos + else if (allocated(DstParamData%TurbineRefPos)) then + deallocate(DstParamData%TurbineRefPos) + end if + DstParamData%mu_kT = SrcParamData%mu_kT + DstParamData%mu_kA = SrcParamData%mu_kA + DstParamData%mc = SrcParamData%mc + DstParamData%cv = SrcParamData%cv + DstParamData%nxWave = SrcParamData%nxWave + DstParamData%nyWave = SrcParamData%nyWave + DstParamData%nzWave = SrcParamData%nzWave + DstParamData%ntWave = SrcParamData%ntWave + if (allocated(SrcParamData%pxWave)) then + LB(1:1) = lbound(SrcParamData%pxWave) + UB(1:1) = ubound(SrcParamData%pxWave) + if (.not. allocated(DstParamData%pxWave)) then + allocate(DstParamData%pxWave(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pxWave.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%pxWave = SrcParamData%pxWave + else if (allocated(DstParamData%pxWave)) then + deallocate(DstParamData%pxWave) + end if + if (allocated(SrcParamData%pyWave)) then + LB(1:1) = lbound(SrcParamData%pyWave) + UB(1:1) = ubound(SrcParamData%pyWave) + if (.not. allocated(DstParamData%pyWave)) then + allocate(DstParamData%pyWave(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pyWave.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%pyWave = SrcParamData%pyWave + else if (allocated(DstParamData%pyWave)) then + deallocate(DstParamData%pyWave) + end if + if (allocated(SrcParamData%pzWave)) then + LB(1:1) = lbound(SrcParamData%pzWave) + UB(1:1) = ubound(SrcParamData%pzWave) + if (.not. allocated(DstParamData%pzWave)) then + allocate(DstParamData%pzWave(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pzWave.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%pzWave = SrcParamData%pzWave + else if (allocated(DstParamData%pzWave)) then + deallocate(DstParamData%pzWave) + end if + DstParamData%dtWave = SrcParamData%dtWave + if (allocated(SrcParamData%uxWave)) then + LB(1:4) = lbound(SrcParamData%uxWave) + UB(1:4) = ubound(SrcParamData%uxWave) + if (.not. allocated(DstParamData%uxWave)) then + allocate(DstParamData%uxWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uxWave.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%uxWave = SrcParamData%uxWave + else if (allocated(DstParamData%uxWave)) then + deallocate(DstParamData%uxWave) + end if + if (allocated(SrcParamData%uyWave)) then + LB(1:4) = lbound(SrcParamData%uyWave) + UB(1:4) = ubound(SrcParamData%uyWave) + if (.not. allocated(DstParamData%uyWave)) then + allocate(DstParamData%uyWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uyWave.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%uyWave = SrcParamData%uyWave + else if (allocated(DstParamData%uyWave)) then + deallocate(DstParamData%uyWave) + end if + if (allocated(SrcParamData%uzWave)) then + LB(1:4) = lbound(SrcParamData%uzWave) + UB(1:4) = ubound(SrcParamData%uzWave) + if (.not. allocated(DstParamData%uzWave)) then + allocate(DstParamData%uzWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uzWave.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%uzWave = SrcParamData%uzWave + else if (allocated(DstParamData%uzWave)) then + deallocate(DstParamData%uzWave) + end if + if (allocated(SrcParamData%axWave)) then + LB(1:4) = lbound(SrcParamData%axWave) + UB(1:4) = ubound(SrcParamData%axWave) + if (.not. allocated(DstParamData%axWave)) then + allocate(DstParamData%axWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%axWave.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%axWave = SrcParamData%axWave + else if (allocated(DstParamData%axWave)) then + deallocate(DstParamData%axWave) + end if + if (allocated(SrcParamData%ayWave)) then + LB(1:4) = lbound(SrcParamData%ayWave) + UB(1:4) = ubound(SrcParamData%ayWave) + if (.not. allocated(DstParamData%ayWave)) then + allocate(DstParamData%ayWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ayWave.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%ayWave = SrcParamData%ayWave + else if (allocated(DstParamData%ayWave)) then + deallocate(DstParamData%ayWave) + end if + if (allocated(SrcParamData%azWave)) then + LB(1:4) = lbound(SrcParamData%azWave) + UB(1:4) = ubound(SrcParamData%azWave) + if (.not. allocated(DstParamData%azWave)) then + allocate(DstParamData%azWave(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%azWave.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%azWave = SrcParamData%azWave + else if (allocated(DstParamData%azWave)) then + deallocate(DstParamData%azWave) + end if + if (allocated(SrcParamData%PDyn)) then + LB(1:4) = lbound(SrcParamData%PDyn) + UB(1:4) = ubound(SrcParamData%PDyn) + if (.not. allocated(DstParamData%PDyn)) then + allocate(DstParamData%PDyn(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PDyn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%PDyn = SrcParamData%PDyn + else if (allocated(DstParamData%PDyn)) then + deallocate(DstParamData%PDyn) + end if + if (allocated(SrcParamData%zeta)) then + LB(1:3) = lbound(SrcParamData%zeta) + UB(1:3) = ubound(SrcParamData%zeta) + if (.not. allocated(DstParamData%zeta)) then + allocate(DstParamData%zeta(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%zeta.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%zeta = SrcParamData%zeta + else if (allocated(DstParamData%zeta)) then + deallocate(DstParamData%zeta) + end if + DstParamData%nzCurrent = SrcParamData%nzCurrent + if (allocated(SrcParamData%pzCurrent)) then + LB(1:1) = lbound(SrcParamData%pzCurrent) + UB(1:1) = ubound(SrcParamData%pzCurrent) + if (.not. allocated(DstParamData%pzCurrent)) then + allocate(DstParamData%pzCurrent(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pzCurrent.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%pzCurrent = SrcParamData%pzCurrent + else if (allocated(DstParamData%pzCurrent)) then + deallocate(DstParamData%pzCurrent) + end if + if (allocated(SrcParamData%uxCurrent)) then + LB(1:1) = lbound(SrcParamData%uxCurrent) + UB(1:1) = ubound(SrcParamData%uxCurrent) + if (.not. allocated(DstParamData%uxCurrent)) then + allocate(DstParamData%uxCurrent(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uxCurrent.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%uxCurrent = SrcParamData%uxCurrent + else if (allocated(DstParamData%uxCurrent)) then + deallocate(DstParamData%uxCurrent) + end if + if (allocated(SrcParamData%uyCurrent)) then + LB(1:1) = lbound(SrcParamData%uyCurrent) + UB(1:1) = ubound(SrcParamData%uyCurrent) + if (.not. allocated(DstParamData%uyCurrent)) then + allocate(DstParamData%uyCurrent(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uyCurrent.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%uyCurrent = SrcParamData%uyCurrent + else if (allocated(DstParamData%uyCurrent)) then + deallocate(DstParamData%uyCurrent) + end if + DstParamData%Nx0 = SrcParamData%Nx0 + if (allocated(SrcParamData%Jac_u_indx)) then + LB(1:2) = lbound(SrcParamData%Jac_u_indx) + UB(1:2) = ubound(SrcParamData%Jac_u_indx) + if (.not. allocated(DstParamData%Jac_u_indx)) then + allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx + else if (allocated(DstParamData%Jac_u_indx)) then + deallocate(DstParamData%Jac_u_indx) + end if + if (allocated(SrcParamData%du)) then + LB(1:1) = lbound(SrcParamData%du) + UB(1:1) = ubound(SrcParamData%du) + if (.not. allocated(DstParamData%du)) then + allocate(DstParamData%du(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%du = SrcParamData%du + else if (allocated(DstParamData%du)) then + deallocate(DstParamData%du) + end if + if (allocated(SrcParamData%dx)) then + LB(1:1) = lbound(SrcParamData%dx) + UB(1:1) = ubound(SrcParamData%dx) + if (.not. allocated(DstParamData%dx)) then + allocate(DstParamData%dx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%dx = SrcParamData%dx + else if (allocated(DstParamData%dx)) then + deallocate(DstParamData%dx) + end if + DstParamData%Jac_ny = SrcParamData%Jac_ny + DstParamData%Jac_nx = SrcParamData%Jac_nx + if (allocated(SrcParamData%dxIdx_map2_xStateIdx)) then + LB(1:1) = lbound(SrcParamData%dxIdx_map2_xStateIdx) + UB(1:1) = ubound(SrcParamData%dxIdx_map2_xStateIdx) + if (.not. allocated(DstParamData%dxIdx_map2_xStateIdx)) then + allocate(DstParamData%dxIdx_map2_xStateIdx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dxIdx_map2_xStateIdx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%dxIdx_map2_xStateIdx = SrcParamData%dxIdx_map2_xStateIdx + else if (allocated(DstParamData%dxIdx_map2_xStateIdx)) then + deallocate(DstParamData%dxIdx_map2_xStateIdx) + end if +end subroutine +subroutine MD_DestroyParam(ParamData, ErrStat, ErrMsg) + type(MD_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3, i4 + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MD_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%nCpldBodies)) then + deallocate(ParamData%nCpldBodies) + end if + if (allocated(ParamData%nCpldRods)) then + deallocate(ParamData%nCpldRods) + end if + if (allocated(ParamData%nCpldCons)) then + deallocate(ParamData%nCpldCons) + end if + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) + do i1 = LB(1), UB(1) + call MD_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%OutParam) + end if + if (allocated(ParamData%TurbineRefPos)) then + deallocate(ParamData%TurbineRefPos) + end if + if (allocated(ParamData%pxWave)) then + deallocate(ParamData%pxWave) + end if + if (allocated(ParamData%pyWave)) then + deallocate(ParamData%pyWave) + end if + if (allocated(ParamData%pzWave)) then + deallocate(ParamData%pzWave) + end if + if (allocated(ParamData%uxWave)) then + deallocate(ParamData%uxWave) + end if + if (allocated(ParamData%uyWave)) then + deallocate(ParamData%uyWave) + end if + if (allocated(ParamData%uzWave)) then + deallocate(ParamData%uzWave) + end if + if (allocated(ParamData%axWave)) then + deallocate(ParamData%axWave) + end if + if (allocated(ParamData%ayWave)) then + deallocate(ParamData%ayWave) + end if + if (allocated(ParamData%azWave)) then + deallocate(ParamData%azWave) + end if + if (allocated(ParamData%PDyn)) then + deallocate(ParamData%PDyn) + end if + if (allocated(ParamData%zeta)) then + deallocate(ParamData%zeta) + end if + if (allocated(ParamData%pzCurrent)) then + deallocate(ParamData%pzCurrent) + end if + if (allocated(ParamData%uxCurrent)) then + deallocate(ParamData%uxCurrent) + end if + if (allocated(ParamData%uyCurrent)) then + deallocate(ParamData%uyCurrent) + end if + if (allocated(ParamData%Jac_u_indx)) then + deallocate(ParamData%Jac_u_indx) + end if + if (allocated(ParamData%du)) then + deallocate(ParamData%du) + end if + if (allocated(ParamData%dx)) then + deallocate(ParamData%dx) + end if + if (allocated(ParamData%dxIdx_map2_xStateIdx)) then + deallocate(ParamData%dxIdx_map2_xStateIdx) + end if +end subroutine subroutine MD_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -6519,103 +5887,74 @@ subroutine MD_PackParam(Buf, Indata) integer(IntKi) :: i1, i2, i3, i4 integer(IntKi) :: LB(4), UB(4) if (Buf%ErrStat >= AbortErrLev) return - ! nLineTypes call RegPack(Buf, InData%nLineTypes) if (RegCheckErr(Buf, RoutineName)) return - ! nRodTypes call RegPack(Buf, InData%nRodTypes) if (RegCheckErr(Buf, RoutineName)) return - ! nConnects call RegPack(Buf, InData%nConnects) if (RegCheckErr(Buf, RoutineName)) return - ! nConnectsExtra call RegPack(Buf, InData%nConnectsExtra) if (RegCheckErr(Buf, RoutineName)) return - ! nBodies call RegPack(Buf, InData%nBodies) if (RegCheckErr(Buf, RoutineName)) return - ! nRods call RegPack(Buf, InData%nRods) if (RegCheckErr(Buf, RoutineName)) return - ! nLines call RegPack(Buf, InData%nLines) if (RegCheckErr(Buf, RoutineName)) return - ! nCtrlChans call RegPack(Buf, InData%nCtrlChans) if (RegCheckErr(Buf, RoutineName)) return - ! nFails call RegPack(Buf, InData%nFails) if (RegCheckErr(Buf, RoutineName)) return - ! nFreeBodies call RegPack(Buf, InData%nFreeBodies) if (RegCheckErr(Buf, RoutineName)) return - ! nFreeRods call RegPack(Buf, InData%nFreeRods) if (RegCheckErr(Buf, RoutineName)) return - ! nFreeCons call RegPack(Buf, InData%nFreeCons) if (RegCheckErr(Buf, RoutineName)) return - ! nCpldBodies call RegPack(Buf, allocated(InData%nCpldBodies)) if (allocated(InData%nCpldBodies)) then call RegPackBounds(Buf, 1, lbound(InData%nCpldBodies), ubound(InData%nCpldBodies)) call RegPack(Buf, InData%nCpldBodies) end if if (RegCheckErr(Buf, RoutineName)) return - ! nCpldRods call RegPack(Buf, allocated(InData%nCpldRods)) if (allocated(InData%nCpldRods)) then call RegPackBounds(Buf, 1, lbound(InData%nCpldRods), ubound(InData%nCpldRods)) call RegPack(Buf, InData%nCpldRods) end if if (RegCheckErr(Buf, RoutineName)) return - ! nCpldCons call RegPack(Buf, allocated(InData%nCpldCons)) if (allocated(InData%nCpldCons)) then call RegPackBounds(Buf, 1, lbound(InData%nCpldCons), ubound(InData%nCpldCons)) call RegPack(Buf, InData%nCpldCons) end if if (RegCheckErr(Buf, RoutineName)) return - ! NConns call RegPack(Buf, InData%NConns) if (RegCheckErr(Buf, RoutineName)) return - ! NAnchs call RegPack(Buf, InData%NAnchs) if (RegCheckErr(Buf, RoutineName)) return - ! Tmax call RegPack(Buf, InData%Tmax) if (RegCheckErr(Buf, RoutineName)) return - ! g call RegPack(Buf, InData%g) if (RegCheckErr(Buf, RoutineName)) return - ! rhoW call RegPack(Buf, InData%rhoW) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDpth call RegPack(Buf, InData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - ! kBot call RegPack(Buf, InData%kBot) if (RegCheckErr(Buf, RoutineName)) return - ! cBot call RegPack(Buf, InData%cBot) if (RegCheckErr(Buf, RoutineName)) return - ! dtM0 call RegPack(Buf, InData%dtM0) if (RegCheckErr(Buf, RoutineName)) return - ! dtCoupling call RegPack(Buf, InData%dtCoupling) if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegPack(Buf, InData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! dtOut call RegPack(Buf, InData%dtOut) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegPack(Buf, InData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! OutParam call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) @@ -6626,196 +5965,156 @@ subroutine MD_PackParam(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! Delim call RegPack(Buf, InData%Delim) if (RegCheckErr(Buf, RoutineName)) return - ! MDUnOut call RegPack(Buf, InData%MDUnOut) if (RegCheckErr(Buf, RoutineName)) return - ! PriPath call RegPack(Buf, InData%PriPath) if (RegCheckErr(Buf, RoutineName)) return - ! writeLog call RegPack(Buf, InData%writeLog) if (RegCheckErr(Buf, RoutineName)) return - ! UnLog call RegPack(Buf, InData%UnLog) if (RegCheckErr(Buf, RoutineName)) return - ! WaveKin call RegPack(Buf, InData%WaveKin) if (RegCheckErr(Buf, RoutineName)) return - ! Current call RegPack(Buf, InData%Current) if (RegCheckErr(Buf, RoutineName)) return - ! nTurbines call RegPack(Buf, InData%nTurbines) if (RegCheckErr(Buf, RoutineName)) return - ! TurbineRefPos call RegPack(Buf, allocated(InData%TurbineRefPos)) if (allocated(InData%TurbineRefPos)) then call RegPackBounds(Buf, 2, lbound(InData%TurbineRefPos), ubound(InData%TurbineRefPos)) call RegPack(Buf, InData%TurbineRefPos) end if if (RegCheckErr(Buf, RoutineName)) return - ! mu_kT call RegPack(Buf, InData%mu_kT) if (RegCheckErr(Buf, RoutineName)) return - ! mu_kA call RegPack(Buf, InData%mu_kA) if (RegCheckErr(Buf, RoutineName)) return - ! mc call RegPack(Buf, InData%mc) if (RegCheckErr(Buf, RoutineName)) return - ! cv call RegPack(Buf, InData%cv) if (RegCheckErr(Buf, RoutineName)) return - ! nxWave call RegPack(Buf, InData%nxWave) if (RegCheckErr(Buf, RoutineName)) return - ! nyWave call RegPack(Buf, InData%nyWave) if (RegCheckErr(Buf, RoutineName)) return - ! nzWave call RegPack(Buf, InData%nzWave) if (RegCheckErr(Buf, RoutineName)) return - ! ntWave call RegPack(Buf, InData%ntWave) if (RegCheckErr(Buf, RoutineName)) return - ! pxWave call RegPack(Buf, allocated(InData%pxWave)) if (allocated(InData%pxWave)) then call RegPackBounds(Buf, 1, lbound(InData%pxWave), ubound(InData%pxWave)) call RegPack(Buf, InData%pxWave) end if if (RegCheckErr(Buf, RoutineName)) return - ! pyWave call RegPack(Buf, allocated(InData%pyWave)) if (allocated(InData%pyWave)) then call RegPackBounds(Buf, 1, lbound(InData%pyWave), ubound(InData%pyWave)) call RegPack(Buf, InData%pyWave) end if if (RegCheckErr(Buf, RoutineName)) return - ! pzWave call RegPack(Buf, allocated(InData%pzWave)) if (allocated(InData%pzWave)) then call RegPackBounds(Buf, 1, lbound(InData%pzWave), ubound(InData%pzWave)) call RegPack(Buf, InData%pzWave) end if if (RegCheckErr(Buf, RoutineName)) return - ! dtWave call RegPack(Buf, InData%dtWave) if (RegCheckErr(Buf, RoutineName)) return - ! uxWave call RegPack(Buf, allocated(InData%uxWave)) if (allocated(InData%uxWave)) then call RegPackBounds(Buf, 4, lbound(InData%uxWave), ubound(InData%uxWave)) call RegPack(Buf, InData%uxWave) end if if (RegCheckErr(Buf, RoutineName)) return - ! uyWave call RegPack(Buf, allocated(InData%uyWave)) if (allocated(InData%uyWave)) then call RegPackBounds(Buf, 4, lbound(InData%uyWave), ubound(InData%uyWave)) call RegPack(Buf, InData%uyWave) end if if (RegCheckErr(Buf, RoutineName)) return - ! uzWave call RegPack(Buf, allocated(InData%uzWave)) if (allocated(InData%uzWave)) then call RegPackBounds(Buf, 4, lbound(InData%uzWave), ubound(InData%uzWave)) call RegPack(Buf, InData%uzWave) end if if (RegCheckErr(Buf, RoutineName)) return - ! axWave call RegPack(Buf, allocated(InData%axWave)) if (allocated(InData%axWave)) then call RegPackBounds(Buf, 4, lbound(InData%axWave), ubound(InData%axWave)) call RegPack(Buf, InData%axWave) end if if (RegCheckErr(Buf, RoutineName)) return - ! ayWave call RegPack(Buf, allocated(InData%ayWave)) if (allocated(InData%ayWave)) then call RegPackBounds(Buf, 4, lbound(InData%ayWave), ubound(InData%ayWave)) call RegPack(Buf, InData%ayWave) end if if (RegCheckErr(Buf, RoutineName)) return - ! azWave call RegPack(Buf, allocated(InData%azWave)) if (allocated(InData%azWave)) then call RegPackBounds(Buf, 4, lbound(InData%azWave), ubound(InData%azWave)) call RegPack(Buf, InData%azWave) end if if (RegCheckErr(Buf, RoutineName)) return - ! PDyn call RegPack(Buf, allocated(InData%PDyn)) if (allocated(InData%PDyn)) then call RegPackBounds(Buf, 4, lbound(InData%PDyn), ubound(InData%PDyn)) call RegPack(Buf, InData%PDyn) end if if (RegCheckErr(Buf, RoutineName)) return - ! zeta call RegPack(Buf, allocated(InData%zeta)) if (allocated(InData%zeta)) then call RegPackBounds(Buf, 3, lbound(InData%zeta), ubound(InData%zeta)) call RegPack(Buf, InData%zeta) end if if (RegCheckErr(Buf, RoutineName)) return - ! nzCurrent call RegPack(Buf, InData%nzCurrent) if (RegCheckErr(Buf, RoutineName)) return - ! pzCurrent call RegPack(Buf, allocated(InData%pzCurrent)) if (allocated(InData%pzCurrent)) then call RegPackBounds(Buf, 1, lbound(InData%pzCurrent), ubound(InData%pzCurrent)) call RegPack(Buf, InData%pzCurrent) end if if (RegCheckErr(Buf, RoutineName)) return - ! uxCurrent call RegPack(Buf, allocated(InData%uxCurrent)) if (allocated(InData%uxCurrent)) then call RegPackBounds(Buf, 1, lbound(InData%uxCurrent), ubound(InData%uxCurrent)) call RegPack(Buf, InData%uxCurrent) end if if (RegCheckErr(Buf, RoutineName)) return - ! uyCurrent call RegPack(Buf, allocated(InData%uyCurrent)) if (allocated(InData%uyCurrent)) then call RegPackBounds(Buf, 1, lbound(InData%uyCurrent), ubound(InData%uyCurrent)) call RegPack(Buf, InData%uyCurrent) end if if (RegCheckErr(Buf, RoutineName)) return - ! Nx0 call RegPack(Buf, InData%Nx0) if (RegCheckErr(Buf, RoutineName)) return - ! Jac_u_indx call RegPack(Buf, allocated(InData%Jac_u_indx)) if (allocated(InData%Jac_u_indx)) then call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx), ubound(InData%Jac_u_indx)) call RegPack(Buf, InData%Jac_u_indx) end if if (RegCheckErr(Buf, RoutineName)) return - ! du call RegPack(Buf, allocated(InData%du)) if (allocated(InData%du)) then call RegPackBounds(Buf, 1, lbound(InData%du), ubound(InData%du)) call RegPack(Buf, InData%du) end if if (RegCheckErr(Buf, RoutineName)) return - ! dx call RegPack(Buf, allocated(InData%dx)) if (allocated(InData%dx)) then call RegPackBounds(Buf, 1, lbound(InData%dx), ubound(InData%dx)) call RegPack(Buf, InData%dx) end if if (RegCheckErr(Buf, RoutineName)) return - ! Jac_ny call RegPack(Buf, InData%Jac_ny) if (RegCheckErr(Buf, RoutineName)) return - ! Jac_nx call RegPack(Buf, InData%Jac_nx) if (RegCheckErr(Buf, RoutineName)) return - ! dxIdx_map2_xStateIdx call RegPack(Buf, allocated(InData%dxIdx_map2_xStateIdx)) if (allocated(InData%dxIdx_map2_xStateIdx)) then call RegPackBounds(Buf, 1, lbound(InData%dxIdx_map2_xStateIdx), ubound(InData%dxIdx_map2_xStateIdx)) @@ -6833,43 +6132,30 @@ subroutine MD_UnPackParam(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! nLineTypes call RegUnpack(Buf, OutData%nLineTypes) if (RegCheckErr(Buf, RoutineName)) return - ! nRodTypes call RegUnpack(Buf, OutData%nRodTypes) if (RegCheckErr(Buf, RoutineName)) return - ! nConnects call RegUnpack(Buf, OutData%nConnects) if (RegCheckErr(Buf, RoutineName)) return - ! nConnectsExtra call RegUnpack(Buf, OutData%nConnectsExtra) if (RegCheckErr(Buf, RoutineName)) return - ! nBodies call RegUnpack(Buf, OutData%nBodies) if (RegCheckErr(Buf, RoutineName)) return - ! nRods call RegUnpack(Buf, OutData%nRods) if (RegCheckErr(Buf, RoutineName)) return - ! nLines call RegUnpack(Buf, OutData%nLines) if (RegCheckErr(Buf, RoutineName)) return - ! nCtrlChans call RegUnpack(Buf, OutData%nCtrlChans) if (RegCheckErr(Buf, RoutineName)) return - ! nFails call RegUnpack(Buf, OutData%nFails) if (RegCheckErr(Buf, RoutineName)) return - ! nFreeBodies call RegUnpack(Buf, OutData%nFreeBodies) if (RegCheckErr(Buf, RoutineName)) return - ! nFreeRods call RegUnpack(Buf, OutData%nFreeRods) if (RegCheckErr(Buf, RoutineName)) return - ! nFreeCons call RegUnpack(Buf, OutData%nFreeCons) if (RegCheckErr(Buf, RoutineName)) return - ! nCpldBodies if (allocated(OutData%nCpldBodies)) deallocate(OutData%nCpldBodies) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6884,7 +6170,6 @@ subroutine MD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%nCpldBodies) if (RegCheckErr(Buf, RoutineName)) return end if - ! nCpldRods if (allocated(OutData%nCpldRods)) deallocate(OutData%nCpldRods) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6899,7 +6184,6 @@ subroutine MD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%nCpldRods) if (RegCheckErr(Buf, RoutineName)) return end if - ! nCpldCons if (allocated(OutData%nCpldCons)) deallocate(OutData%nCpldCons) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6914,46 +6198,32 @@ subroutine MD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%nCpldCons) if (RegCheckErr(Buf, RoutineName)) return end if - ! NConns call RegUnpack(Buf, OutData%NConns) if (RegCheckErr(Buf, RoutineName)) return - ! NAnchs call RegUnpack(Buf, OutData%NAnchs) if (RegCheckErr(Buf, RoutineName)) return - ! Tmax call RegUnpack(Buf, OutData%Tmax) if (RegCheckErr(Buf, RoutineName)) return - ! g call RegUnpack(Buf, OutData%g) if (RegCheckErr(Buf, RoutineName)) return - ! rhoW call RegUnpack(Buf, OutData%rhoW) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDpth call RegUnpack(Buf, OutData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - ! kBot call RegUnpack(Buf, OutData%kBot) if (RegCheckErr(Buf, RoutineName)) return - ! cBot call RegUnpack(Buf, OutData%cBot) if (RegCheckErr(Buf, RoutineName)) return - ! dtM0 call RegUnpack(Buf, OutData%dtM0) if (RegCheckErr(Buf, RoutineName)) return - ! dtCoupling call RegUnpack(Buf, OutData%dtCoupling) if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegUnpack(Buf, OutData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! dtOut call RegUnpack(Buf, OutData%dtOut) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegUnpack(Buf, OutData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! OutParam if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6969,31 +6239,22 @@ subroutine MD_UnPackParam(Buf, OutData) call MD_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam end do end if - ! Delim call RegUnpack(Buf, OutData%Delim) if (RegCheckErr(Buf, RoutineName)) return - ! MDUnOut call RegUnpack(Buf, OutData%MDUnOut) if (RegCheckErr(Buf, RoutineName)) return - ! PriPath call RegUnpack(Buf, OutData%PriPath) if (RegCheckErr(Buf, RoutineName)) return - ! writeLog call RegUnpack(Buf, OutData%writeLog) if (RegCheckErr(Buf, RoutineName)) return - ! UnLog call RegUnpack(Buf, OutData%UnLog) if (RegCheckErr(Buf, RoutineName)) return - ! WaveKin call RegUnpack(Buf, OutData%WaveKin) if (RegCheckErr(Buf, RoutineName)) return - ! Current call RegUnpack(Buf, OutData%Current) if (RegCheckErr(Buf, RoutineName)) return - ! nTurbines call RegUnpack(Buf, OutData%nTurbines) if (RegCheckErr(Buf, RoutineName)) return - ! TurbineRefPos if (allocated(OutData%TurbineRefPos)) deallocate(OutData%TurbineRefPos) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7008,31 +6269,22 @@ subroutine MD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%TurbineRefPos) if (RegCheckErr(Buf, RoutineName)) return end if - ! mu_kT call RegUnpack(Buf, OutData%mu_kT) if (RegCheckErr(Buf, RoutineName)) return - ! mu_kA call RegUnpack(Buf, OutData%mu_kA) if (RegCheckErr(Buf, RoutineName)) return - ! mc call RegUnpack(Buf, OutData%mc) if (RegCheckErr(Buf, RoutineName)) return - ! cv call RegUnpack(Buf, OutData%cv) if (RegCheckErr(Buf, RoutineName)) return - ! nxWave call RegUnpack(Buf, OutData%nxWave) if (RegCheckErr(Buf, RoutineName)) return - ! nyWave call RegUnpack(Buf, OutData%nyWave) if (RegCheckErr(Buf, RoutineName)) return - ! nzWave call RegUnpack(Buf, OutData%nzWave) if (RegCheckErr(Buf, RoutineName)) return - ! ntWave call RegUnpack(Buf, OutData%ntWave) if (RegCheckErr(Buf, RoutineName)) return - ! pxWave if (allocated(OutData%pxWave)) deallocate(OutData%pxWave) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7047,7 +6299,6 @@ subroutine MD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%pxWave) if (RegCheckErr(Buf, RoutineName)) return end if - ! pyWave if (allocated(OutData%pyWave)) deallocate(OutData%pyWave) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7062,7 +6313,6 @@ subroutine MD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%pyWave) if (RegCheckErr(Buf, RoutineName)) return end if - ! pzWave if (allocated(OutData%pzWave)) deallocate(OutData%pzWave) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7077,10 +6327,8 @@ subroutine MD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%pzWave) if (RegCheckErr(Buf, RoutineName)) return end if - ! dtWave call RegUnpack(Buf, OutData%dtWave) if (RegCheckErr(Buf, RoutineName)) return - ! uxWave if (allocated(OutData%uxWave)) deallocate(OutData%uxWave) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7095,7 +6343,6 @@ subroutine MD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%uxWave) if (RegCheckErr(Buf, RoutineName)) return end if - ! uyWave if (allocated(OutData%uyWave)) deallocate(OutData%uyWave) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7110,7 +6357,6 @@ subroutine MD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%uyWave) if (RegCheckErr(Buf, RoutineName)) return end if - ! uzWave if (allocated(OutData%uzWave)) deallocate(OutData%uzWave) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7125,7 +6371,6 @@ subroutine MD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%uzWave) if (RegCheckErr(Buf, RoutineName)) return end if - ! axWave if (allocated(OutData%axWave)) deallocate(OutData%axWave) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7140,7 +6385,6 @@ subroutine MD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%axWave) if (RegCheckErr(Buf, RoutineName)) return end if - ! ayWave if (allocated(OutData%ayWave)) deallocate(OutData%ayWave) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7155,7 +6399,6 @@ subroutine MD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%ayWave) if (RegCheckErr(Buf, RoutineName)) return end if - ! azWave if (allocated(OutData%azWave)) deallocate(OutData%azWave) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7170,7 +6413,6 @@ subroutine MD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%azWave) if (RegCheckErr(Buf, RoutineName)) return end if - ! PDyn if (allocated(OutData%PDyn)) deallocate(OutData%PDyn) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7185,7 +6427,6 @@ subroutine MD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%PDyn) if (RegCheckErr(Buf, RoutineName)) return end if - ! zeta if (allocated(OutData%zeta)) deallocate(OutData%zeta) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7200,10 +6441,8 @@ subroutine MD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%zeta) if (RegCheckErr(Buf, RoutineName)) return end if - ! nzCurrent call RegUnpack(Buf, OutData%nzCurrent) if (RegCheckErr(Buf, RoutineName)) return - ! pzCurrent if (allocated(OutData%pzCurrent)) deallocate(OutData%pzCurrent) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7218,7 +6457,6 @@ subroutine MD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%pzCurrent) if (RegCheckErr(Buf, RoutineName)) return end if - ! uxCurrent if (allocated(OutData%uxCurrent)) deallocate(OutData%uxCurrent) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7233,7 +6471,6 @@ subroutine MD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%uxCurrent) if (RegCheckErr(Buf, RoutineName)) return end if - ! uyCurrent if (allocated(OutData%uyCurrent)) deallocate(OutData%uyCurrent) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7248,10 +6485,8 @@ subroutine MD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%uyCurrent) if (RegCheckErr(Buf, RoutineName)) return end if - ! Nx0 call RegUnpack(Buf, OutData%Nx0) if (RegCheckErr(Buf, RoutineName)) return - ! Jac_u_indx if (allocated(OutData%Jac_u_indx)) deallocate(OutData%Jac_u_indx) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7266,7 +6501,6 @@ subroutine MD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%Jac_u_indx) if (RegCheckErr(Buf, RoutineName)) return end if - ! du if (allocated(OutData%du)) deallocate(OutData%du) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7281,7 +6515,6 @@ subroutine MD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%du) if (RegCheckErr(Buf, RoutineName)) return end if - ! dx if (allocated(OutData%dx)) deallocate(OutData%dx) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7296,13 +6529,10 @@ subroutine MD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%dx) if (RegCheckErr(Buf, RoutineName)) return end if - ! Jac_ny call RegUnpack(Buf, OutData%Jac_ny) if (RegCheckErr(Buf, RoutineName)) return - ! Jac_nx call RegUnpack(Buf, OutData%Jac_nx) if (RegCheckErr(Buf, RoutineName)) return - ! dxIdx_map2_xStateIdx if (allocated(OutData%dxIdx_map2_xStateIdx)) deallocate(OutData%dxIdx_map2_xStateIdx) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7318,91 +6548,95 @@ subroutine MD_UnPackParam(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE MD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_InputType), INTENT(INOUT) :: SrcInputData - TYPE(MD_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyInput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInputData%CoupledKinematics)) THEN - i1_l = LBOUND(SrcInputData%CoupledKinematics,1) - i1_u = UBOUND(SrcInputData%CoupledKinematics,1) - IF (.NOT. ALLOCATED(DstInputData%CoupledKinematics)) THEN - ALLOCATE(DstInputData%CoupledKinematics(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CoupledKinematics.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputData%CoupledKinematics,1), UBOUND(SrcInputData%CoupledKinematics,1) - CALL MeshCopy( SrcInputData%CoupledKinematics(i1), DstInputData%CoupledKinematics(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInputData%DeltaL)) THEN - i1_l = LBOUND(SrcInputData%DeltaL,1) - i1_u = UBOUND(SrcInputData%DeltaL,1) - IF (.NOT. ALLOCATED(DstInputData%DeltaL)) THEN - ALLOCATE(DstInputData%DeltaL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%DeltaL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%DeltaL = SrcInputData%DeltaL -ENDIF -IF (ALLOCATED(SrcInputData%DeltaLdot)) THEN - i1_l = LBOUND(SrcInputData%DeltaLdot,1) - i1_u = UBOUND(SrcInputData%DeltaLdot,1) - IF (.NOT. ALLOCATED(DstInputData%DeltaLdot)) THEN - ALLOCATE(DstInputData%DeltaLdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%DeltaLdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%DeltaLdot = SrcInputData%DeltaLdot -ENDIF - END SUBROUTINE MD_CopyInput - SUBROUTINE MD_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(MD_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputData%CoupledKinematics)) THEN -DO i1 = LBOUND(InputData%CoupledKinematics,1), UBOUND(InputData%CoupledKinematics,1) - CALL MeshDestroy( InputData%CoupledKinematics(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InputData%CoupledKinematics) -ENDIF -IF (ALLOCATED(InputData%DeltaL)) THEN - DEALLOCATE(InputData%DeltaL) -ENDIF -IF (ALLOCATED(InputData%DeltaLdot)) THEN - DEALLOCATE(InputData%DeltaLdot) -ENDIF - END SUBROUTINE MD_DestroyInput +subroutine MD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(MD_InputType), intent(inout) :: SrcInputData + type(MD_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MD_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInputData%CoupledKinematics)) then + LB(1:1) = lbound(SrcInputData%CoupledKinematics) + UB(1:1) = ubound(SrcInputData%CoupledKinematics) + if (.not. allocated(DstInputData%CoupledKinematics)) then + allocate(DstInputData%CoupledKinematics(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CoupledKinematics.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcInputData%CoupledKinematics(i1), DstInputData%CoupledKinematics(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstInputData%CoupledKinematics)) then + deallocate(DstInputData%CoupledKinematics) + end if + if (allocated(SrcInputData%DeltaL)) then + LB(1:1) = lbound(SrcInputData%DeltaL) + UB(1:1) = ubound(SrcInputData%DeltaL) + if (.not. allocated(DstInputData%DeltaL)) then + allocate(DstInputData%DeltaL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%DeltaL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%DeltaL = SrcInputData%DeltaL + else if (allocated(DstInputData%DeltaL)) then + deallocate(DstInputData%DeltaL) + end if + if (allocated(SrcInputData%DeltaLdot)) then + LB(1:1) = lbound(SrcInputData%DeltaLdot) + UB(1:1) = ubound(SrcInputData%DeltaLdot) + if (.not. allocated(DstInputData%DeltaLdot)) then + allocate(DstInputData%DeltaLdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%DeltaLdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%DeltaLdot = SrcInputData%DeltaLdot + else if (allocated(DstInputData%DeltaLdot)) then + deallocate(DstInputData%DeltaLdot) + end if +end subroutine +subroutine MD_DestroyInput(InputData, ErrStat, ErrMsg) + type(MD_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MD_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%CoupledKinematics)) then + LB(1:1) = lbound(InputData%CoupledKinematics) + UB(1:1) = ubound(InputData%CoupledKinematics) + do i1 = LB(1), UB(1) + call MeshDestroy( InputData%CoupledKinematics(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputData%CoupledKinematics) + end if + if (allocated(InputData%DeltaL)) then + deallocate(InputData%DeltaL) + end if + if (allocated(InputData%DeltaLdot)) then + deallocate(InputData%DeltaLdot) + end if +end subroutine subroutine MD_PackInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -7411,7 +6645,6 @@ subroutine MD_PackInput(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! CoupledKinematics call RegPack(Buf, allocated(InData%CoupledKinematics)) if (allocated(InData%CoupledKinematics)) then call RegPackBounds(Buf, 1, lbound(InData%CoupledKinematics), ubound(InData%CoupledKinematics)) @@ -7422,14 +6655,12 @@ subroutine MD_PackInput(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! DeltaL call RegPack(Buf, allocated(InData%DeltaL)) if (allocated(InData%DeltaL)) then call RegPackBounds(Buf, 1, lbound(InData%DeltaL), ubound(InData%DeltaL)) call RegPack(Buf, InData%DeltaL) end if if (RegCheckErr(Buf, RoutineName)) return - ! DeltaLdot call RegPack(Buf, allocated(InData%DeltaLdot)) if (allocated(InData%DeltaLdot)) then call RegPackBounds(Buf, 1, lbound(InData%DeltaLdot), ubound(InData%DeltaLdot)) @@ -7447,7 +6678,6 @@ subroutine MD_UnPackInput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! CoupledKinematics if (allocated(OutData%CoupledKinematics)) deallocate(OutData%CoupledKinematics) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7463,7 +6693,6 @@ subroutine MD_UnPackInput(Buf, OutData) call MeshUnpack(Buf, OutData%CoupledKinematics(i1)) ! CoupledKinematics end do end if - ! DeltaL if (allocated(OutData%DeltaL)) deallocate(OutData%DeltaL) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7478,7 +6707,6 @@ subroutine MD_UnPackInput(Buf, OutData) call RegUnpack(Buf, OutData%DeltaL) if (RegCheckErr(Buf, RoutineName)) return end if - ! DeltaLdot if (allocated(OutData%DeltaLdot)) deallocate(OutData%DeltaLdot) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7494,76 +6722,78 @@ subroutine MD_UnPackInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE MD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(MD_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%CoupledLoads)) THEN - i1_l = LBOUND(SrcOutputData%CoupledLoads,1) - i1_u = UBOUND(SrcOutputData%CoupledLoads,1) - IF (.NOT. ALLOCATED(DstOutputData%CoupledLoads)) THEN - ALLOCATE(DstOutputData%CoupledLoads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%CoupledLoads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOutputData%CoupledLoads,1), UBOUND(SrcOutputData%CoupledLoads,1) - CALL MeshCopy( SrcOutputData%CoupledLoads(i1), DstOutputData%CoupledLoads(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcOutputData%WriteOutput)) THEN - i1_l = LBOUND(SrcOutputData%WriteOutput,1) - i1_u = UBOUND(SrcOutputData%WriteOutput,1) - IF (.NOT. ALLOCATED(DstOutputData%WriteOutput)) THEN - ALLOCATE(DstOutputData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%WriteOutput = SrcOutputData%WriteOutput -ENDIF - END SUBROUTINE MD_CopyOutput - - SUBROUTINE MD_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(MD_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(OutputData%CoupledLoads)) THEN -DO i1 = LBOUND(OutputData%CoupledLoads,1), UBOUND(OutputData%CoupledLoads,1) - CALL MeshDestroy( OutputData%CoupledLoads(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OutputData%CoupledLoads) -ENDIF -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - END SUBROUTINE MD_DestroyOutput +subroutine MD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(MD_OutputType), intent(inout) :: SrcOutputData + type(MD_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MD_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%CoupledLoads)) then + LB(1:1) = lbound(SrcOutputData%CoupledLoads) + UB(1:1) = ubound(SrcOutputData%CoupledLoads) + if (.not. allocated(DstOutputData%CoupledLoads)) then + allocate(DstOutputData%CoupledLoads(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%CoupledLoads.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcOutputData%CoupledLoads(i1), DstOutputData%CoupledLoads(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstOutputData%CoupledLoads)) then + deallocate(DstOutputData%CoupledLoads) + end if + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%WriteOutput = SrcOutputData%WriteOutput + else if (allocated(DstOutputData%WriteOutput)) then + deallocate(DstOutputData%WriteOutput) + end if +end subroutine +subroutine MD_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(MD_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MD_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%CoupledLoads)) then + LB(1:1) = lbound(OutputData%CoupledLoads) + UB(1:1) = ubound(OutputData%CoupledLoads) + do i1 = LB(1), UB(1) + call MeshDestroy( OutputData%CoupledLoads(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%CoupledLoads) + end if + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine subroutine MD_PackOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -7572,7 +6802,6 @@ subroutine MD_PackOutput(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! CoupledLoads call RegPack(Buf, allocated(InData%CoupledLoads)) if (allocated(InData%CoupledLoads)) then call RegPackBounds(Buf, 1, lbound(InData%CoupledLoads), ubound(InData%CoupledLoads)) @@ -7583,7 +6812,6 @@ subroutine MD_PackOutput(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutput call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) @@ -7601,7 +6829,6 @@ subroutine MD_UnPackOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! CoupledLoads if (allocated(OutData%CoupledLoads)) deallocate(OutData%CoupledLoads) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7617,7 +6844,6 @@ subroutine MD_UnPackOutput(Buf, OutData) call MeshUnpack(Buf, OutData%CoupledLoads(i1)) ! CoupledLoads end do end if - ! WriteOutput if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/nwtc-library/src/NWTC_Library_Types.f90 b/modules/nwtc-library/src/NWTC_Library_Types.f90 index 5f2be5a87e..5ef255e3b7 100644 --- a/modules/nwtc-library/src/NWTC_Library_Types.f90 +++ b/modules/nwtc-library/src/NWTC_Library_Types.f90 @@ -86,53 +86,39 @@ MODULE NWTC_Library_Types END TYPE NWTC_RandomNumber_ParameterType ! ======================= CONTAINS - SUBROUTINE NWTC_Library_CopyProgDesc( SrcProgDescData, DstProgDescData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ProgDesc), INTENT(IN) :: SrcProgDescData - TYPE(ProgDesc), INTENT(INOUT) :: DstProgDescData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_CopyProgDesc' -! - ErrStat = ErrID_None - ErrMsg = "" - DstProgDescData%Name = SrcProgDescData%Name - DstProgDescData%Ver = SrcProgDescData%Ver - DstProgDescData%Date = SrcProgDescData%Date - END SUBROUTINE NWTC_Library_CopyProgDesc - - SUBROUTINE NWTC_Library_DestroyProgDesc( ProgDescData, ErrStat, ErrMsg ) - TYPE(ProgDesc), INTENT(INOUT) :: ProgDescData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_DestroyProgDesc' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE NWTC_Library_DestroyProgDesc +subroutine NWTC_Library_CopyProgDesc(SrcProgDescData, DstProgDescData, CtrlCode, ErrStat, ErrMsg) + type(ProgDesc), intent(in) :: SrcProgDescData + type(ProgDesc), intent(inout) :: DstProgDescData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_CopyProgDesc' + ErrStat = ErrID_None + ErrMsg = '' + DstProgDescData%Name = SrcProgDescData%Name + DstProgDescData%Ver = SrcProgDescData%Ver + DstProgDescData%Date = SrcProgDescData%Date +end subroutine +subroutine NWTC_Library_DestroyProgDesc(ProgDescData, ErrStat, ErrMsg) + type(ProgDesc), intent(inout) :: ProgDescData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyProgDesc' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine NWTC_Library_PackProgDesc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ProgDesc), intent(in) :: InData character(*), parameter :: RoutineName = 'NWTC_Library_PackProgDesc' if (Buf%ErrStat >= AbortErrLev) return - ! Name call RegPack(Buf, InData%Name) if (RegCheckErr(Buf, RoutineName)) return - ! Ver call RegPack(Buf, InData%Ver) if (RegCheckErr(Buf, RoutineName)) return - ! Date call RegPack(Buf, InData%Date) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -142,137 +128,119 @@ subroutine NWTC_Library_UnPackProgDesc(Buf, OutData) type(ProgDesc), intent(inout) :: OutData character(*), parameter :: RoutineName = 'NWTC_Library_UnPackProgDesc' if (Buf%ErrStat /= ErrID_None) return - ! Name call RegUnpack(Buf, OutData%Name) if (RegCheckErr(Buf, RoutineName)) return - ! Ver call RegUnpack(Buf, OutData%Ver) if (RegCheckErr(Buf, RoutineName)) return - ! Date call RegUnpack(Buf, OutData%Date) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE NWTC_Library_CopyFASTdataType( SrcFASTdataTypeData, DstFASTdataTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FASTdataType), INTENT(IN) :: SrcFASTdataTypeData - TYPE(FASTdataType), INTENT(INOUT) :: DstFASTdataTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_CopyFASTdataType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstFASTdataTypeData%File = SrcFASTdataTypeData%File - DstFASTdataTypeData%Descr = SrcFASTdataTypeData%Descr - DstFASTdataTypeData%NumChans = SrcFASTdataTypeData%NumChans - DstFASTdataTypeData%NumRecs = SrcFASTdataTypeData%NumRecs - DstFASTdataTypeData%TimeStep = SrcFASTdataTypeData%TimeStep -IF (ALLOCATED(SrcFASTdataTypeData%ChanNames)) THEN - i1_l = LBOUND(SrcFASTdataTypeData%ChanNames,1) - i1_u = UBOUND(SrcFASTdataTypeData%ChanNames,1) - IF (.NOT. ALLOCATED(DstFASTdataTypeData%ChanNames)) THEN - ALLOCATE(DstFASTdataTypeData%ChanNames(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFASTdataTypeData%ChanNames.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstFASTdataTypeData%ChanNames = SrcFASTdataTypeData%ChanNames -ENDIF -IF (ALLOCATED(SrcFASTdataTypeData%ChanUnits)) THEN - i1_l = LBOUND(SrcFASTdataTypeData%ChanUnits,1) - i1_u = UBOUND(SrcFASTdataTypeData%ChanUnits,1) - IF (.NOT. ALLOCATED(DstFASTdataTypeData%ChanUnits)) THEN - ALLOCATE(DstFASTdataTypeData%ChanUnits(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFASTdataTypeData%ChanUnits.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstFASTdataTypeData%ChanUnits = SrcFASTdataTypeData%ChanUnits -ENDIF -IF (ALLOCATED(SrcFASTdataTypeData%Data)) THEN - i1_l = LBOUND(SrcFASTdataTypeData%Data,1) - i1_u = UBOUND(SrcFASTdataTypeData%Data,1) - i2_l = LBOUND(SrcFASTdataTypeData%Data,2) - i2_u = UBOUND(SrcFASTdataTypeData%Data,2) - IF (.NOT. ALLOCATED(DstFASTdataTypeData%Data)) THEN - ALLOCATE(DstFASTdataTypeData%Data(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFASTdataTypeData%Data.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstFASTdataTypeData%Data = SrcFASTdataTypeData%Data -ENDIF - END SUBROUTINE NWTC_Library_CopyFASTdataType - - SUBROUTINE NWTC_Library_DestroyFASTdataType( FASTdataTypeData, ErrStat, ErrMsg ) - TYPE(FASTdataType), INTENT(INOUT) :: FASTdataTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_DestroyFASTdataType' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(FASTdataTypeData%ChanNames)) THEN - DEALLOCATE(FASTdataTypeData%ChanNames) -ENDIF -IF (ALLOCATED(FASTdataTypeData%ChanUnits)) THEN - DEALLOCATE(FASTdataTypeData%ChanUnits) -ENDIF -IF (ALLOCATED(FASTdataTypeData%Data)) THEN - DEALLOCATE(FASTdataTypeData%Data) -ENDIF - END SUBROUTINE NWTC_Library_DestroyFASTdataType +subroutine NWTC_Library_CopyFASTdataType(SrcFASTdataTypeData, DstFASTdataTypeData, CtrlCode, ErrStat, ErrMsg) + type(FASTdataType), intent(in) :: SrcFASTdataTypeData + type(FASTdataType), intent(inout) :: DstFASTdataTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'NWTC_Library_CopyFASTdataType' + ErrStat = ErrID_None + ErrMsg = '' + DstFASTdataTypeData%File = SrcFASTdataTypeData%File + DstFASTdataTypeData%Descr = SrcFASTdataTypeData%Descr + DstFASTdataTypeData%NumChans = SrcFASTdataTypeData%NumChans + DstFASTdataTypeData%NumRecs = SrcFASTdataTypeData%NumRecs + DstFASTdataTypeData%TimeStep = SrcFASTdataTypeData%TimeStep + if (allocated(SrcFASTdataTypeData%ChanNames)) then + LB(1:1) = lbound(SrcFASTdataTypeData%ChanNames) + UB(1:1) = ubound(SrcFASTdataTypeData%ChanNames) + if (.not. allocated(DstFASTdataTypeData%ChanNames)) then + allocate(DstFASTdataTypeData%ChanNames(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstFASTdataTypeData%ChanNames.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstFASTdataTypeData%ChanNames = SrcFASTdataTypeData%ChanNames + else if (allocated(DstFASTdataTypeData%ChanNames)) then + deallocate(DstFASTdataTypeData%ChanNames) + end if + if (allocated(SrcFASTdataTypeData%ChanUnits)) then + LB(1:1) = lbound(SrcFASTdataTypeData%ChanUnits) + UB(1:1) = ubound(SrcFASTdataTypeData%ChanUnits) + if (.not. allocated(DstFASTdataTypeData%ChanUnits)) then + allocate(DstFASTdataTypeData%ChanUnits(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstFASTdataTypeData%ChanUnits.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstFASTdataTypeData%ChanUnits = SrcFASTdataTypeData%ChanUnits + else if (allocated(DstFASTdataTypeData%ChanUnits)) then + deallocate(DstFASTdataTypeData%ChanUnits) + end if + if (allocated(SrcFASTdataTypeData%Data)) then + LB(1:2) = lbound(SrcFASTdataTypeData%Data) + UB(1:2) = ubound(SrcFASTdataTypeData%Data) + if (.not. allocated(DstFASTdataTypeData%Data)) then + allocate(DstFASTdataTypeData%Data(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstFASTdataTypeData%Data.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstFASTdataTypeData%Data = SrcFASTdataTypeData%Data + else if (allocated(DstFASTdataTypeData%Data)) then + deallocate(DstFASTdataTypeData%Data) + end if +end subroutine +subroutine NWTC_Library_DestroyFASTdataType(FASTdataTypeData, ErrStat, ErrMsg) + type(FASTdataType), intent(inout) :: FASTdataTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyFASTdataType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(FASTdataTypeData%ChanNames)) then + deallocate(FASTdataTypeData%ChanNames) + end if + if (allocated(FASTdataTypeData%ChanUnits)) then + deallocate(FASTdataTypeData%ChanUnits) + end if + if (allocated(FASTdataTypeData%Data)) then + deallocate(FASTdataTypeData%Data) + end if +end subroutine subroutine NWTC_Library_PackFASTdataType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FASTdataType), intent(in) :: InData character(*), parameter :: RoutineName = 'NWTC_Library_PackFASTdataType' if (Buf%ErrStat >= AbortErrLev) return - ! File call RegPack(Buf, InData%File) if (RegCheckErr(Buf, RoutineName)) return - ! Descr call RegPack(Buf, InData%Descr) if (RegCheckErr(Buf, RoutineName)) return - ! NumChans call RegPack(Buf, InData%NumChans) if (RegCheckErr(Buf, RoutineName)) return - ! NumRecs call RegPack(Buf, InData%NumRecs) if (RegCheckErr(Buf, RoutineName)) return - ! TimeStep call RegPack(Buf, InData%TimeStep) if (RegCheckErr(Buf, RoutineName)) return - ! ChanNames call RegPack(Buf, allocated(InData%ChanNames)) if (allocated(InData%ChanNames)) then call RegPackBounds(Buf, 1, lbound(InData%ChanNames), ubound(InData%ChanNames)) call RegPack(Buf, InData%ChanNames) end if if (RegCheckErr(Buf, RoutineName)) return - ! ChanUnits call RegPack(Buf, allocated(InData%ChanUnits)) if (allocated(InData%ChanUnits)) then call RegPackBounds(Buf, 1, lbound(InData%ChanUnits), ubound(InData%ChanUnits)) call RegPack(Buf, InData%ChanUnits) end if if (RegCheckErr(Buf, RoutineName)) return - ! Data call RegPack(Buf, allocated(InData%Data)) if (allocated(InData%Data)) then call RegPackBounds(Buf, 2, lbound(InData%Data), ubound(InData%Data)) @@ -289,22 +257,16 @@ subroutine NWTC_Library_UnPackFASTdataType(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! File call RegUnpack(Buf, OutData%File) if (RegCheckErr(Buf, RoutineName)) return - ! Descr call RegUnpack(Buf, OutData%Descr) if (RegCheckErr(Buf, RoutineName)) return - ! NumChans call RegUnpack(Buf, OutData%NumChans) if (RegCheckErr(Buf, RoutineName)) return - ! NumRecs call RegUnpack(Buf, OutData%NumRecs) if (RegCheckErr(Buf, RoutineName)) return - ! TimeStep call RegUnpack(Buf, OutData%TimeStep) if (RegCheckErr(Buf, RoutineName)) return - ! ChanNames if (allocated(OutData%ChanNames)) deallocate(OutData%ChanNames) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -319,7 +281,6 @@ subroutine NWTC_Library_UnPackFASTdataType(Buf, OutData) call RegUnpack(Buf, OutData%ChanNames) if (RegCheckErr(Buf, RoutineName)) return end if - ! ChanUnits if (allocated(OutData%ChanUnits)) deallocate(OutData%ChanUnits) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -334,7 +295,6 @@ subroutine NWTC_Library_UnPackFASTdataType(Buf, OutData) call RegUnpack(Buf, OutData%ChanUnits) if (RegCheckErr(Buf, RoutineName)) return end if - ! Data if (allocated(OutData%Data)) deallocate(OutData%Data) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -350,57 +310,42 @@ subroutine NWTC_Library_UnPackFASTdataType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE NWTC_Library_CopyOutParmType( SrcOutParmTypeData, DstOutParmTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(OutParmType), INTENT(IN) :: SrcOutParmTypeData - TYPE(OutParmType), INTENT(INOUT) :: DstOutParmTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_CopyOutParmType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOutParmTypeData%Indx = SrcOutParmTypeData%Indx - DstOutParmTypeData%Name = SrcOutParmTypeData%Name - DstOutParmTypeData%Units = SrcOutParmTypeData%Units - DstOutParmTypeData%SignM = SrcOutParmTypeData%SignM - END SUBROUTINE NWTC_Library_CopyOutParmType - - SUBROUTINE NWTC_Library_DestroyOutParmType( OutParmTypeData, ErrStat, ErrMsg ) - TYPE(OutParmType), INTENT(INOUT) :: OutParmTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_DestroyOutParmType' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE NWTC_Library_DestroyOutParmType +subroutine NWTC_Library_CopyOutParmType(SrcOutParmTypeData, DstOutParmTypeData, CtrlCode, ErrStat, ErrMsg) + type(OutParmType), intent(in) :: SrcOutParmTypeData + type(OutParmType), intent(inout) :: DstOutParmTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_CopyOutParmType' + ErrStat = ErrID_None + ErrMsg = '' + DstOutParmTypeData%Indx = SrcOutParmTypeData%Indx + DstOutParmTypeData%Name = SrcOutParmTypeData%Name + DstOutParmTypeData%Units = SrcOutParmTypeData%Units + DstOutParmTypeData%SignM = SrcOutParmTypeData%SignM +end subroutine +subroutine NWTC_Library_DestroyOutParmType(OutParmTypeData, ErrStat, ErrMsg) + type(OutParmType), intent(inout) :: OutParmTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyOutParmType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine NWTC_Library_PackOutParmType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(OutParmType), intent(in) :: InData character(*), parameter :: RoutineName = 'NWTC_Library_PackOutParmType' if (Buf%ErrStat >= AbortErrLev) return - ! Indx call RegPack(Buf, InData%Indx) if (RegCheckErr(Buf, RoutineName)) return - ! Name call RegPack(Buf, InData%Name) if (RegCheckErr(Buf, RoutineName)) return - ! Units call RegPack(Buf, InData%Units) if (RegCheckErr(Buf, RoutineName)) return - ! SignM call RegPack(Buf, InData%SignM) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -410,147 +355,135 @@ subroutine NWTC_Library_UnPackOutParmType(Buf, OutData) type(OutParmType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'NWTC_Library_UnPackOutParmType' if (Buf%ErrStat /= ErrID_None) return - ! Indx call RegUnpack(Buf, OutData%Indx) if (RegCheckErr(Buf, RoutineName)) return - ! Name call RegUnpack(Buf, OutData%Name) if (RegCheckErr(Buf, RoutineName)) return - ! Units call RegUnpack(Buf, OutData%Units) if (RegCheckErr(Buf, RoutineName)) return - ! SignM call RegUnpack(Buf, OutData%SignM) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE NWTC_Library_CopyFileInfoType( SrcFileInfoTypeData, DstFileInfoTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FileInfoType), INTENT(IN) :: SrcFileInfoTypeData - TYPE(FileInfoType), INTENT(INOUT) :: DstFileInfoTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_CopyFileInfoType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstFileInfoTypeData%NumLines = SrcFileInfoTypeData%NumLines - DstFileInfoTypeData%NumFiles = SrcFileInfoTypeData%NumFiles -IF (ALLOCATED(SrcFileInfoTypeData%FileLine)) THEN - i1_l = LBOUND(SrcFileInfoTypeData%FileLine,1) - i1_u = UBOUND(SrcFileInfoTypeData%FileLine,1) - IF (.NOT. ALLOCATED(DstFileInfoTypeData%FileLine)) THEN - ALLOCATE(DstFileInfoTypeData%FileLine(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFileInfoTypeData%FileLine.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstFileInfoTypeData%FileLine = SrcFileInfoTypeData%FileLine -ENDIF -IF (ALLOCATED(SrcFileInfoTypeData%FileIndx)) THEN - i1_l = LBOUND(SrcFileInfoTypeData%FileIndx,1) - i1_u = UBOUND(SrcFileInfoTypeData%FileIndx,1) - IF (.NOT. ALLOCATED(DstFileInfoTypeData%FileIndx)) THEN - ALLOCATE(DstFileInfoTypeData%FileIndx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFileInfoTypeData%FileIndx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstFileInfoTypeData%FileIndx = SrcFileInfoTypeData%FileIndx -ENDIF -IF (ALLOCATED(SrcFileInfoTypeData%FileList)) THEN - i1_l = LBOUND(SrcFileInfoTypeData%FileList,1) - i1_u = UBOUND(SrcFileInfoTypeData%FileList,1) - IF (.NOT. ALLOCATED(DstFileInfoTypeData%FileList)) THEN - ALLOCATE(DstFileInfoTypeData%FileList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFileInfoTypeData%FileList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstFileInfoTypeData%FileList = SrcFileInfoTypeData%FileList -ENDIF -IF (ALLOCATED(SrcFileInfoTypeData%Lines)) THEN - i1_l = LBOUND(SrcFileInfoTypeData%Lines,1) - i1_u = UBOUND(SrcFileInfoTypeData%Lines,1) - IF (.NOT. ALLOCATED(DstFileInfoTypeData%Lines)) THEN - ALLOCATE(DstFileInfoTypeData%Lines(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFileInfoTypeData%Lines.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstFileInfoTypeData%Lines = SrcFileInfoTypeData%Lines -ENDIF - END SUBROUTINE NWTC_Library_CopyFileInfoType - - SUBROUTINE NWTC_Library_DestroyFileInfoType( FileInfoTypeData, ErrStat, ErrMsg ) - TYPE(FileInfoType), INTENT(INOUT) :: FileInfoTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_DestroyFileInfoType' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(FileInfoTypeData%FileLine)) THEN - DEALLOCATE(FileInfoTypeData%FileLine) -ENDIF -IF (ALLOCATED(FileInfoTypeData%FileIndx)) THEN - DEALLOCATE(FileInfoTypeData%FileIndx) -ENDIF -IF (ALLOCATED(FileInfoTypeData%FileList)) THEN - DEALLOCATE(FileInfoTypeData%FileList) -ENDIF -IF (ALLOCATED(FileInfoTypeData%Lines)) THEN - DEALLOCATE(FileInfoTypeData%Lines) -ENDIF - END SUBROUTINE NWTC_Library_DestroyFileInfoType +subroutine NWTC_Library_CopyFileInfoType(SrcFileInfoTypeData, DstFileInfoTypeData, CtrlCode, ErrStat, ErrMsg) + type(FileInfoType), intent(in) :: SrcFileInfoTypeData + type(FileInfoType), intent(inout) :: DstFileInfoTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'NWTC_Library_CopyFileInfoType' + ErrStat = ErrID_None + ErrMsg = '' + DstFileInfoTypeData%NumLines = SrcFileInfoTypeData%NumLines + DstFileInfoTypeData%NumFiles = SrcFileInfoTypeData%NumFiles + if (allocated(SrcFileInfoTypeData%FileLine)) then + LB(1:1) = lbound(SrcFileInfoTypeData%FileLine) + UB(1:1) = ubound(SrcFileInfoTypeData%FileLine) + if (.not. allocated(DstFileInfoTypeData%FileLine)) then + allocate(DstFileInfoTypeData%FileLine(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstFileInfoTypeData%FileLine.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstFileInfoTypeData%FileLine = SrcFileInfoTypeData%FileLine + else if (allocated(DstFileInfoTypeData%FileLine)) then + deallocate(DstFileInfoTypeData%FileLine) + end if + if (allocated(SrcFileInfoTypeData%FileIndx)) then + LB(1:1) = lbound(SrcFileInfoTypeData%FileIndx) + UB(1:1) = ubound(SrcFileInfoTypeData%FileIndx) + if (.not. allocated(DstFileInfoTypeData%FileIndx)) then + allocate(DstFileInfoTypeData%FileIndx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstFileInfoTypeData%FileIndx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstFileInfoTypeData%FileIndx = SrcFileInfoTypeData%FileIndx + else if (allocated(DstFileInfoTypeData%FileIndx)) then + deallocate(DstFileInfoTypeData%FileIndx) + end if + if (allocated(SrcFileInfoTypeData%FileList)) then + LB(1:1) = lbound(SrcFileInfoTypeData%FileList) + UB(1:1) = ubound(SrcFileInfoTypeData%FileList) + if (.not. allocated(DstFileInfoTypeData%FileList)) then + allocate(DstFileInfoTypeData%FileList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstFileInfoTypeData%FileList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstFileInfoTypeData%FileList = SrcFileInfoTypeData%FileList + else if (allocated(DstFileInfoTypeData%FileList)) then + deallocate(DstFileInfoTypeData%FileList) + end if + if (allocated(SrcFileInfoTypeData%Lines)) then + LB(1:1) = lbound(SrcFileInfoTypeData%Lines) + UB(1:1) = ubound(SrcFileInfoTypeData%Lines) + if (.not. allocated(DstFileInfoTypeData%Lines)) then + allocate(DstFileInfoTypeData%Lines(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstFileInfoTypeData%Lines.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstFileInfoTypeData%Lines = SrcFileInfoTypeData%Lines + else if (allocated(DstFileInfoTypeData%Lines)) then + deallocate(DstFileInfoTypeData%Lines) + end if +end subroutine +subroutine NWTC_Library_DestroyFileInfoType(FileInfoTypeData, ErrStat, ErrMsg) + type(FileInfoType), intent(inout) :: FileInfoTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyFileInfoType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(FileInfoTypeData%FileLine)) then + deallocate(FileInfoTypeData%FileLine) + end if + if (allocated(FileInfoTypeData%FileIndx)) then + deallocate(FileInfoTypeData%FileIndx) + end if + if (allocated(FileInfoTypeData%FileList)) then + deallocate(FileInfoTypeData%FileList) + end if + if (allocated(FileInfoTypeData%Lines)) then + deallocate(FileInfoTypeData%Lines) + end if +end subroutine subroutine NWTC_Library_PackFileInfoType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FileInfoType), intent(in) :: InData character(*), parameter :: RoutineName = 'NWTC_Library_PackFileInfoType' if (Buf%ErrStat >= AbortErrLev) return - ! NumLines call RegPack(Buf, InData%NumLines) if (RegCheckErr(Buf, RoutineName)) return - ! NumFiles call RegPack(Buf, InData%NumFiles) if (RegCheckErr(Buf, RoutineName)) return - ! FileLine call RegPack(Buf, allocated(InData%FileLine)) if (allocated(InData%FileLine)) then call RegPackBounds(Buf, 1, lbound(InData%FileLine), ubound(InData%FileLine)) call RegPack(Buf, InData%FileLine) end if if (RegCheckErr(Buf, RoutineName)) return - ! FileIndx call RegPack(Buf, allocated(InData%FileIndx)) if (allocated(InData%FileIndx)) then call RegPackBounds(Buf, 1, lbound(InData%FileIndx), ubound(InData%FileIndx)) call RegPack(Buf, InData%FileIndx) end if if (RegCheckErr(Buf, RoutineName)) return - ! FileList call RegPack(Buf, allocated(InData%FileList)) if (allocated(InData%FileList)) then call RegPackBounds(Buf, 1, lbound(InData%FileList), ubound(InData%FileList)) call RegPack(Buf, InData%FileList) end if if (RegCheckErr(Buf, RoutineName)) return - ! Lines call RegPack(Buf, allocated(InData%Lines)) if (allocated(InData%Lines)) then call RegPackBounds(Buf, 1, lbound(InData%Lines), ubound(InData%Lines)) @@ -567,13 +500,10 @@ subroutine NWTC_Library_UnPackFileInfoType(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! NumLines call RegUnpack(Buf, OutData%NumLines) if (RegCheckErr(Buf, RoutineName)) return - ! NumFiles call RegUnpack(Buf, OutData%NumFiles) if (RegCheckErr(Buf, RoutineName)) return - ! FileLine if (allocated(OutData%FileLine)) deallocate(OutData%FileLine) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -588,7 +518,6 @@ subroutine NWTC_Library_UnPackFileInfoType(Buf, OutData) call RegUnpack(Buf, OutData%FileLine) if (RegCheckErr(Buf, RoutineName)) return end if - ! FileIndx if (allocated(OutData%FileIndx)) deallocate(OutData%FileIndx) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -603,7 +532,6 @@ subroutine NWTC_Library_UnPackFileInfoType(Buf, OutData) call RegUnpack(Buf, OutData%FileIndx) if (RegCheckErr(Buf, RoutineName)) return end if - ! FileList if (allocated(OutData%FileList)) deallocate(OutData%FileList) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -618,7 +546,6 @@ subroutine NWTC_Library_UnPackFileInfoType(Buf, OutData) call RegUnpack(Buf, OutData%FileList) if (RegCheckErr(Buf, RoutineName)) return end if - ! Lines if (allocated(OutData%Lines)) deallocate(OutData%Lines) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -634,50 +561,36 @@ subroutine NWTC_Library_UnPackFileInfoType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE NWTC_Library_CopyQuaternion( SrcQuaternionData, DstQuaternionData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Quaternion), INTENT(IN) :: SrcQuaternionData - TYPE(Quaternion), INTENT(INOUT) :: DstQuaternionData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_CopyQuaternion' -! - ErrStat = ErrID_None - ErrMsg = "" - DstQuaternionData%q0 = SrcQuaternionData%q0 - DstQuaternionData%v = SrcQuaternionData%v - END SUBROUTINE NWTC_Library_CopyQuaternion - SUBROUTINE NWTC_Library_DestroyQuaternion( QuaternionData, ErrStat, ErrMsg ) - TYPE(Quaternion), INTENT(INOUT) :: QuaternionData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_DestroyQuaternion' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE NWTC_Library_DestroyQuaternion +subroutine NWTC_Library_CopyQuaternion(SrcQuaternionData, DstQuaternionData, CtrlCode, ErrStat, ErrMsg) + type(Quaternion), intent(in) :: SrcQuaternionData + type(Quaternion), intent(inout) :: DstQuaternionData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_CopyQuaternion' + ErrStat = ErrID_None + ErrMsg = '' + DstQuaternionData%q0 = SrcQuaternionData%q0 + DstQuaternionData%v = SrcQuaternionData%v +end subroutine +subroutine NWTC_Library_DestroyQuaternion(QuaternionData, ErrStat, ErrMsg) + type(Quaternion), intent(inout) :: QuaternionData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyQuaternion' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine NWTC_Library_PackQuaternion(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Quaternion), intent(in) :: InData character(*), parameter :: RoutineName = 'NWTC_Library_PackQuaternion' if (Buf%ErrStat >= AbortErrLev) return - ! q0 call RegPack(Buf, InData%q0) if (RegCheckErr(Buf, RoutineName)) return - ! v call RegPack(Buf, InData%v) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -687,83 +600,69 @@ subroutine NWTC_Library_UnPackQuaternion(Buf, OutData) type(Quaternion), intent(inout) :: OutData character(*), parameter :: RoutineName = 'NWTC_Library_UnPackQuaternion' if (Buf%ErrStat /= ErrID_None) return - ! q0 call RegUnpack(Buf, OutData%q0) if (RegCheckErr(Buf, RoutineName)) return - ! v call RegUnpack(Buf, OutData%v) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE NWTC_Library_CopyNWTC_RandomNumber_ParameterType( SrcNWTC_RandomNumber_ParameterTypeData, DstNWTC_RandomNumber_ParameterTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(NWTC_RandomNumber_ParameterType), INTENT(IN) :: SrcNWTC_RandomNumber_ParameterTypeData - TYPE(NWTC_RandomNumber_ParameterType), INTENT(INOUT) :: DstNWTC_RandomNumber_ParameterTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_CopyNWTC_RandomNumber_ParameterType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstNWTC_RandomNumber_ParameterTypeData%pRNG = SrcNWTC_RandomNumber_ParameterTypeData%pRNG - DstNWTC_RandomNumber_ParameterTypeData%RandSeed = SrcNWTC_RandomNumber_ParameterTypeData%RandSeed -IF (ALLOCATED(SrcNWTC_RandomNumber_ParameterTypeData%RandSeedAry)) THEN - i1_l = LBOUND(SrcNWTC_RandomNumber_ParameterTypeData%RandSeedAry,1) - i1_u = UBOUND(SrcNWTC_RandomNumber_ParameterTypeData%RandSeedAry,1) - IF (.NOT. ALLOCATED(DstNWTC_RandomNumber_ParameterTypeData%RandSeedAry)) THEN - ALLOCATE(DstNWTC_RandomNumber_ParameterTypeData%RandSeedAry(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstNWTC_RandomNumber_ParameterTypeData%RandSeedAry.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstNWTC_RandomNumber_ParameterTypeData%RandSeedAry = SrcNWTC_RandomNumber_ParameterTypeData%RandSeedAry -ENDIF - DstNWTC_RandomNumber_ParameterTypeData%RNG_type = SrcNWTC_RandomNumber_ParameterTypeData%RNG_type - END SUBROUTINE NWTC_Library_CopyNWTC_RandomNumber_ParameterType - - SUBROUTINE NWTC_Library_DestroyNWTC_RandomNumber_ParameterType( NWTC_RandomNumber_ParameterTypeData, ErrStat, ErrMsg ) - TYPE(NWTC_RandomNumber_ParameterType), INTENT(INOUT) :: NWTC_RandomNumber_ParameterTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_DestroyNWTC_RandomNumber_ParameterType' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(NWTC_RandomNumber_ParameterTypeData%RandSeedAry)) THEN - DEALLOCATE(NWTC_RandomNumber_ParameterTypeData%RandSeedAry) -ENDIF - END SUBROUTINE NWTC_Library_DestroyNWTC_RandomNumber_ParameterType +subroutine NWTC_Library_CopyNWTC_RandomNumber_ParameterType(SrcNWTC_RandomNumber_ParameterTypeData, DstNWTC_RandomNumber_ParameterTypeData, CtrlCode, ErrStat, ErrMsg) + type(NWTC_RandomNumber_ParameterType), intent(in) :: SrcNWTC_RandomNumber_ParameterTypeData + type(NWTC_RandomNumber_ParameterType), intent(inout) :: DstNWTC_RandomNumber_ParameterTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'NWTC_Library_CopyNWTC_RandomNumber_ParameterType' + ErrStat = ErrID_None + ErrMsg = '' + DstNWTC_RandomNumber_ParameterTypeData%pRNG = SrcNWTC_RandomNumber_ParameterTypeData%pRNG + DstNWTC_RandomNumber_ParameterTypeData%RandSeed = SrcNWTC_RandomNumber_ParameterTypeData%RandSeed + if (allocated(SrcNWTC_RandomNumber_ParameterTypeData%RandSeedAry)) then + LB(1:1) = lbound(SrcNWTC_RandomNumber_ParameterTypeData%RandSeedAry) + UB(1:1) = ubound(SrcNWTC_RandomNumber_ParameterTypeData%RandSeedAry) + if (.not. allocated(DstNWTC_RandomNumber_ParameterTypeData%RandSeedAry)) then + allocate(DstNWTC_RandomNumber_ParameterTypeData%RandSeedAry(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstNWTC_RandomNumber_ParameterTypeData%RandSeedAry.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstNWTC_RandomNumber_ParameterTypeData%RandSeedAry = SrcNWTC_RandomNumber_ParameterTypeData%RandSeedAry + else if (allocated(DstNWTC_RandomNumber_ParameterTypeData%RandSeedAry)) then + deallocate(DstNWTC_RandomNumber_ParameterTypeData%RandSeedAry) + end if + DstNWTC_RandomNumber_ParameterTypeData%RNG_type = SrcNWTC_RandomNumber_ParameterTypeData%RNG_type +end subroutine +subroutine NWTC_Library_DestroyNWTC_RandomNumber_ParameterType(NWTC_RandomNumber_ParameterTypeData, ErrStat, ErrMsg) + type(NWTC_RandomNumber_ParameterType), intent(inout) :: NWTC_RandomNumber_ParameterTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'NWTC_Library_DestroyNWTC_RandomNumber_ParameterType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(NWTC_RandomNumber_ParameterTypeData%RandSeedAry)) then + deallocate(NWTC_RandomNumber_ParameterTypeData%RandSeedAry) + end if +end subroutine subroutine NWTC_Library_PackNWTC_RandomNumber_ParameterType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(NWTC_RandomNumber_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'NWTC_Library_PackNWTC_RandomNumber_ParameterType' if (Buf%ErrStat >= AbortErrLev) return - ! pRNG call RegPack(Buf, InData%pRNG) if (RegCheckErr(Buf, RoutineName)) return - ! RandSeed call RegPack(Buf, InData%RandSeed) if (RegCheckErr(Buf, RoutineName)) return - ! RandSeedAry call RegPack(Buf, allocated(InData%RandSeedAry)) if (allocated(InData%RandSeedAry)) then call RegPackBounds(Buf, 1, lbound(InData%RandSeedAry), ubound(InData%RandSeedAry)) call RegPack(Buf, InData%RandSeedAry) end if if (RegCheckErr(Buf, RoutineName)) return - ! RNG_type call RegPack(Buf, InData%RNG_type) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -776,13 +675,10 @@ subroutine NWTC_Library_UnPackNWTC_RandomNumber_ParameterType(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! pRNG call RegUnpack(Buf, OutData%pRNG) if (RegCheckErr(Buf, RoutineName)) return - ! RandSeed call RegUnpack(Buf, OutData%RandSeed) if (RegCheckErr(Buf, RoutineName)) return - ! RandSeedAry if (allocated(OutData%RandSeedAry)) deallocate(OutData%RandSeedAry) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -797,7 +693,6 @@ subroutine NWTC_Library_UnPackNWTC_RandomNumber_ParameterType(Buf, OutData) call RegUnpack(Buf, OutData%RandSeedAry) if (RegCheckErr(Buf, RoutineName)) return end if - ! RNG_type call RegUnpack(Buf, OutData%RNG_type) if (RegCheckErr(Buf, RoutineName)) return end subroutine diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index dd11271f03..8e72735bcf 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -807,66 +807,51 @@ MODULE FAST_Types END TYPE FAST_TurbineType ! ======================= CONTAINS - SUBROUTINE FAST_CopyVTK_BLSurfaceType( SrcVTK_BLSurfaceTypeData, DstVTK_BLSurfaceTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_VTK_BLSurfaceType), INTENT(IN) :: SrcVTK_BLSurfaceTypeData - TYPE(FAST_VTK_BLSurfaceType), INTENT(INOUT) :: DstVTK_BLSurfaceTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyVTK_BLSurfaceType' -! + +subroutine FAST_CopyVTK_BLSurfaceType(SrcVTK_BLSurfaceTypeData, DstVTK_BLSurfaceTypeData, CtrlCode, ErrStat, ErrMsg) + type(FAST_VTK_BLSurfaceType), intent(in) :: SrcVTK_BLSurfaceTypeData + type(FAST_VTK_BLSurfaceType), intent(inout) :: DstVTK_BLSurfaceTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FAST_CopyVTK_BLSurfaceType' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcVTK_BLSurfaceTypeData%AirfoilCoords)) THEN - i1_l = LBOUND(SrcVTK_BLSurfaceTypeData%AirfoilCoords,1) - i1_u = UBOUND(SrcVTK_BLSurfaceTypeData%AirfoilCoords,1) - i2_l = LBOUND(SrcVTK_BLSurfaceTypeData%AirfoilCoords,2) - i2_u = UBOUND(SrcVTK_BLSurfaceTypeData%AirfoilCoords,2) - i3_l = LBOUND(SrcVTK_BLSurfaceTypeData%AirfoilCoords,3) - i3_u = UBOUND(SrcVTK_BLSurfaceTypeData%AirfoilCoords,3) - IF (.NOT. ALLOCATED(DstVTK_BLSurfaceTypeData%AirfoilCoords)) THEN - ALLOCATE(DstVTK_BLSurfaceTypeData%AirfoilCoords(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_BLSurfaceTypeData%AirfoilCoords.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstVTK_BLSurfaceTypeData%AirfoilCoords = SrcVTK_BLSurfaceTypeData%AirfoilCoords -ENDIF - END SUBROUTINE FAST_CopyVTK_BLSurfaceType - - SUBROUTINE FAST_DestroyVTK_BLSurfaceType( VTK_BLSurfaceTypeData, ErrStat, ErrMsg ) - TYPE(FAST_VTK_BLSurfaceType), INTENT(INOUT) :: VTK_BLSurfaceTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyVTK_BLSurfaceType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(VTK_BLSurfaceTypeData%AirfoilCoords)) THEN - DEALLOCATE(VTK_BLSurfaceTypeData%AirfoilCoords) -ENDIF - END SUBROUTINE FAST_DestroyVTK_BLSurfaceType + ErrMsg = '' + if (allocated(SrcVTK_BLSurfaceTypeData%AirfoilCoords)) then + LB(1:3) = lbound(SrcVTK_BLSurfaceTypeData%AirfoilCoords) + UB(1:3) = ubound(SrcVTK_BLSurfaceTypeData%AirfoilCoords) + if (.not. allocated(DstVTK_BLSurfaceTypeData%AirfoilCoords)) then + allocate(DstVTK_BLSurfaceTypeData%AirfoilCoords(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_BLSurfaceTypeData%AirfoilCoords.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVTK_BLSurfaceTypeData%AirfoilCoords = SrcVTK_BLSurfaceTypeData%AirfoilCoords + else if (allocated(DstVTK_BLSurfaceTypeData%AirfoilCoords)) then + deallocate(DstVTK_BLSurfaceTypeData%AirfoilCoords) + end if +end subroutine +subroutine FAST_DestroyVTK_BLSurfaceType(VTK_BLSurfaceTypeData, ErrStat, ErrMsg) + type(FAST_VTK_BLSurfaceType), intent(inout) :: VTK_BLSurfaceTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FAST_DestroyVTK_BLSurfaceType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(VTK_BLSurfaceTypeData%AirfoilCoords)) then + deallocate(VTK_BLSurfaceTypeData%AirfoilCoords) + end if +end subroutine subroutine FAST_PackVTK_BLSurfaceType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FAST_VTK_BLSurfaceType), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackVTK_BLSurfaceType' if (Buf%ErrStat >= AbortErrLev) return - ! AirfoilCoords call RegPack(Buf, allocated(InData%AirfoilCoords)) if (allocated(InData%AirfoilCoords)) then call RegPackBounds(Buf, 3, lbound(InData%AirfoilCoords), ubound(InData%AirfoilCoords)) @@ -883,7 +868,6 @@ subroutine FAST_UnPackVTK_BLSurfaceType(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! AirfoilCoords if (allocated(OutData%AirfoilCoords)) deallocate(OutData%AirfoilCoords) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -899,131 +883,134 @@ subroutine FAST_UnPackVTK_BLSurfaceType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE FAST_CopyVTK_SurfaceType( SrcVTK_SurfaceTypeData, DstVTK_SurfaceTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_VTK_SurfaceType), INTENT(IN) :: SrcVTK_SurfaceTypeData - TYPE(FAST_VTK_SurfaceType), INTENT(INOUT) :: DstVTK_SurfaceTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyVTK_SurfaceType' -! + +subroutine FAST_CopyVTK_SurfaceType(SrcVTK_SurfaceTypeData, DstVTK_SurfaceTypeData, CtrlCode, ErrStat, ErrMsg) + type(FAST_VTK_SurfaceType), intent(in) :: SrcVTK_SurfaceTypeData + type(FAST_VTK_SurfaceType), intent(inout) :: DstVTK_SurfaceTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyVTK_SurfaceType' ErrStat = ErrID_None - ErrMsg = "" - DstVTK_SurfaceTypeData%NumSectors = SrcVTK_SurfaceTypeData%NumSectors - DstVTK_SurfaceTypeData%HubRad = SrcVTK_SurfaceTypeData%HubRad - DstVTK_SurfaceTypeData%GroundRad = SrcVTK_SurfaceTypeData%GroundRad - DstVTK_SurfaceTypeData%NacelleBox = SrcVTK_SurfaceTypeData%NacelleBox -IF (ALLOCATED(SrcVTK_SurfaceTypeData%TowerRad)) THEN - i1_l = LBOUND(SrcVTK_SurfaceTypeData%TowerRad,1) - i1_u = UBOUND(SrcVTK_SurfaceTypeData%TowerRad,1) - IF (.NOT. ALLOCATED(DstVTK_SurfaceTypeData%TowerRad)) THEN - ALLOCATE(DstVTK_SurfaceTypeData%TowerRad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_SurfaceTypeData%TowerRad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstVTK_SurfaceTypeData%TowerRad = SrcVTK_SurfaceTypeData%TowerRad -ENDIF - DstVTK_SurfaceTypeData%NWaveElevPts = SrcVTK_SurfaceTypeData%NWaveElevPts -IF (ALLOCATED(SrcVTK_SurfaceTypeData%WaveElevXY)) THEN - i1_l = LBOUND(SrcVTK_SurfaceTypeData%WaveElevXY,1) - i1_u = UBOUND(SrcVTK_SurfaceTypeData%WaveElevXY,1) - i2_l = LBOUND(SrcVTK_SurfaceTypeData%WaveElevXY,2) - i2_u = UBOUND(SrcVTK_SurfaceTypeData%WaveElevXY,2) - IF (.NOT. ALLOCATED(DstVTK_SurfaceTypeData%WaveElevXY)) THEN - ALLOCATE(DstVTK_SurfaceTypeData%WaveElevXY(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_SurfaceTypeData%WaveElevXY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstVTK_SurfaceTypeData%WaveElevXY = SrcVTK_SurfaceTypeData%WaveElevXY -ENDIF -IF (ALLOCATED(SrcVTK_SurfaceTypeData%WaveElev)) THEN - i1_l = LBOUND(SrcVTK_SurfaceTypeData%WaveElev,1) - i1_u = UBOUND(SrcVTK_SurfaceTypeData%WaveElev,1) - i2_l = LBOUND(SrcVTK_SurfaceTypeData%WaveElev,2) - i2_u = UBOUND(SrcVTK_SurfaceTypeData%WaveElev,2) - IF (.NOT. ALLOCATED(DstVTK_SurfaceTypeData%WaveElev)) THEN - ALLOCATE(DstVTK_SurfaceTypeData%WaveElev(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_SurfaceTypeData%WaveElev.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstVTK_SurfaceTypeData%WaveElev = SrcVTK_SurfaceTypeData%WaveElev -ENDIF -IF (ALLOCATED(SrcVTK_SurfaceTypeData%BladeShape)) THEN - i1_l = LBOUND(SrcVTK_SurfaceTypeData%BladeShape,1) - i1_u = UBOUND(SrcVTK_SurfaceTypeData%BladeShape,1) - IF (.NOT. ALLOCATED(DstVTK_SurfaceTypeData%BladeShape)) THEN - ALLOCATE(DstVTK_SurfaceTypeData%BladeShape(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_SurfaceTypeData%BladeShape.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcVTK_SurfaceTypeData%BladeShape,1), UBOUND(SrcVTK_SurfaceTypeData%BladeShape,1) - CALL FAST_Copyvtk_blsurfacetype( SrcVTK_SurfaceTypeData%BladeShape(i1), DstVTK_SurfaceTypeData%BladeShape(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcVTK_SurfaceTypeData%MorisonRad)) THEN - i1_l = LBOUND(SrcVTK_SurfaceTypeData%MorisonRad,1) - i1_u = UBOUND(SrcVTK_SurfaceTypeData%MorisonRad,1) - IF (.NOT. ALLOCATED(DstVTK_SurfaceTypeData%MorisonRad)) THEN - ALLOCATE(DstVTK_SurfaceTypeData%MorisonRad(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_SurfaceTypeData%MorisonRad.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstVTK_SurfaceTypeData%MorisonRad = SrcVTK_SurfaceTypeData%MorisonRad -ENDIF - END SUBROUTINE FAST_CopyVTK_SurfaceType - - SUBROUTINE FAST_DestroyVTK_SurfaceType( VTK_SurfaceTypeData, ErrStat, ErrMsg ) - TYPE(FAST_VTK_SurfaceType), INTENT(INOUT) :: VTK_SurfaceTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyVTK_SurfaceType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(VTK_SurfaceTypeData%TowerRad)) THEN - DEALLOCATE(VTK_SurfaceTypeData%TowerRad) -ENDIF -IF (ALLOCATED(VTK_SurfaceTypeData%WaveElevXY)) THEN - DEALLOCATE(VTK_SurfaceTypeData%WaveElevXY) -ENDIF -IF (ALLOCATED(VTK_SurfaceTypeData%WaveElev)) THEN - DEALLOCATE(VTK_SurfaceTypeData%WaveElev) -ENDIF -IF (ALLOCATED(VTK_SurfaceTypeData%BladeShape)) THEN -DO i1 = LBOUND(VTK_SurfaceTypeData%BladeShape,1), UBOUND(VTK_SurfaceTypeData%BladeShape,1) - CALL FAST_DestroyVTK_BLSurfaceType( VTK_SurfaceTypeData%BladeShape(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(VTK_SurfaceTypeData%BladeShape) -ENDIF -IF (ALLOCATED(VTK_SurfaceTypeData%MorisonRad)) THEN - DEALLOCATE(VTK_SurfaceTypeData%MorisonRad) -ENDIF - END SUBROUTINE FAST_DestroyVTK_SurfaceType + ErrMsg = '' + DstVTK_SurfaceTypeData%NumSectors = SrcVTK_SurfaceTypeData%NumSectors + DstVTK_SurfaceTypeData%HubRad = SrcVTK_SurfaceTypeData%HubRad + DstVTK_SurfaceTypeData%GroundRad = SrcVTK_SurfaceTypeData%GroundRad + DstVTK_SurfaceTypeData%NacelleBox = SrcVTK_SurfaceTypeData%NacelleBox + if (allocated(SrcVTK_SurfaceTypeData%TowerRad)) then + LB(1:1) = lbound(SrcVTK_SurfaceTypeData%TowerRad) + UB(1:1) = ubound(SrcVTK_SurfaceTypeData%TowerRad) + if (.not. allocated(DstVTK_SurfaceTypeData%TowerRad)) then + allocate(DstVTK_SurfaceTypeData%TowerRad(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_SurfaceTypeData%TowerRad.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVTK_SurfaceTypeData%TowerRad = SrcVTK_SurfaceTypeData%TowerRad + else if (allocated(DstVTK_SurfaceTypeData%TowerRad)) then + deallocate(DstVTK_SurfaceTypeData%TowerRad) + end if + DstVTK_SurfaceTypeData%NWaveElevPts = SrcVTK_SurfaceTypeData%NWaveElevPts + if (allocated(SrcVTK_SurfaceTypeData%WaveElevXY)) then + LB(1:2) = lbound(SrcVTK_SurfaceTypeData%WaveElevXY) + UB(1:2) = ubound(SrcVTK_SurfaceTypeData%WaveElevXY) + if (.not. allocated(DstVTK_SurfaceTypeData%WaveElevXY)) then + allocate(DstVTK_SurfaceTypeData%WaveElevXY(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_SurfaceTypeData%WaveElevXY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVTK_SurfaceTypeData%WaveElevXY = SrcVTK_SurfaceTypeData%WaveElevXY + else if (allocated(DstVTK_SurfaceTypeData%WaveElevXY)) then + deallocate(DstVTK_SurfaceTypeData%WaveElevXY) + end if + if (allocated(SrcVTK_SurfaceTypeData%WaveElev)) then + LB(1:2) = lbound(SrcVTK_SurfaceTypeData%WaveElev) + UB(1:2) = ubound(SrcVTK_SurfaceTypeData%WaveElev) + if (.not. allocated(DstVTK_SurfaceTypeData%WaveElev)) then + allocate(DstVTK_SurfaceTypeData%WaveElev(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_SurfaceTypeData%WaveElev.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVTK_SurfaceTypeData%WaveElev = SrcVTK_SurfaceTypeData%WaveElev + else if (allocated(DstVTK_SurfaceTypeData%WaveElev)) then + deallocate(DstVTK_SurfaceTypeData%WaveElev) + end if + if (allocated(SrcVTK_SurfaceTypeData%BladeShape)) then + LB(1:1) = lbound(SrcVTK_SurfaceTypeData%BladeShape) + UB(1:1) = ubound(SrcVTK_SurfaceTypeData%BladeShape) + if (.not. allocated(DstVTK_SurfaceTypeData%BladeShape)) then + allocate(DstVTK_SurfaceTypeData%BladeShape(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_SurfaceTypeData%BladeShape.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FAST_CopyVTK_BLSurfaceType(SrcVTK_SurfaceTypeData%BladeShape(i1), DstVTK_SurfaceTypeData%BladeShape(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstVTK_SurfaceTypeData%BladeShape)) then + deallocate(DstVTK_SurfaceTypeData%BladeShape) + end if + if (allocated(SrcVTK_SurfaceTypeData%MorisonRad)) then + LB(1:1) = lbound(SrcVTK_SurfaceTypeData%MorisonRad) + UB(1:1) = ubound(SrcVTK_SurfaceTypeData%MorisonRad) + if (.not. allocated(DstVTK_SurfaceTypeData%MorisonRad)) then + allocate(DstVTK_SurfaceTypeData%MorisonRad(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_SurfaceTypeData%MorisonRad.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVTK_SurfaceTypeData%MorisonRad = SrcVTK_SurfaceTypeData%MorisonRad + else if (allocated(DstVTK_SurfaceTypeData%MorisonRad)) then + deallocate(DstVTK_SurfaceTypeData%MorisonRad) + end if +end subroutine +subroutine FAST_DestroyVTK_SurfaceType(VTK_SurfaceTypeData, ErrStat, ErrMsg) + type(FAST_VTK_SurfaceType), intent(inout) :: VTK_SurfaceTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyVTK_SurfaceType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(VTK_SurfaceTypeData%TowerRad)) then + deallocate(VTK_SurfaceTypeData%TowerRad) + end if + if (allocated(VTK_SurfaceTypeData%WaveElevXY)) then + deallocate(VTK_SurfaceTypeData%WaveElevXY) + end if + if (allocated(VTK_SurfaceTypeData%WaveElev)) then + deallocate(VTK_SurfaceTypeData%WaveElev) + end if + if (allocated(VTK_SurfaceTypeData%BladeShape)) then + LB(1:1) = lbound(VTK_SurfaceTypeData%BladeShape) + UB(1:1) = ubound(VTK_SurfaceTypeData%BladeShape) + do i1 = LB(1), UB(1) + call FAST_DestroyVTK_BLSurfaceType(VTK_SurfaceTypeData%BladeShape(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(VTK_SurfaceTypeData%BladeShape) + end if + if (allocated(VTK_SurfaceTypeData%MorisonRad)) then + deallocate(VTK_SurfaceTypeData%MorisonRad) + end if +end subroutine subroutine FAST_PackVTK_SurfaceType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -1032,43 +1019,34 @@ subroutine FAST_PackVTK_SurfaceType(Buf, Indata) integer(IntKi) :: i1, i2 integer(IntKi) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return - ! NumSectors call RegPack(Buf, InData%NumSectors) if (RegCheckErr(Buf, RoutineName)) return - ! HubRad call RegPack(Buf, InData%HubRad) if (RegCheckErr(Buf, RoutineName)) return - ! GroundRad call RegPack(Buf, InData%GroundRad) if (RegCheckErr(Buf, RoutineName)) return - ! NacelleBox call RegPack(Buf, InData%NacelleBox) if (RegCheckErr(Buf, RoutineName)) return - ! TowerRad call RegPack(Buf, allocated(InData%TowerRad)) if (allocated(InData%TowerRad)) then call RegPackBounds(Buf, 1, lbound(InData%TowerRad), ubound(InData%TowerRad)) call RegPack(Buf, InData%TowerRad) end if if (RegCheckErr(Buf, RoutineName)) return - ! NWaveElevPts call RegPack(Buf, InData%NWaveElevPts) if (RegCheckErr(Buf, RoutineName)) return - ! WaveElevXY call RegPack(Buf, allocated(InData%WaveElevXY)) if (allocated(InData%WaveElevXY)) then call RegPackBounds(Buf, 2, lbound(InData%WaveElevXY), ubound(InData%WaveElevXY)) call RegPack(Buf, InData%WaveElevXY) end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveElev call RegPack(Buf, allocated(InData%WaveElev)) if (allocated(InData%WaveElev)) then call RegPackBounds(Buf, 2, lbound(InData%WaveElev), ubound(InData%WaveElev)) call RegPack(Buf, InData%WaveElev) end if if (RegCheckErr(Buf, RoutineName)) return - ! BladeShape call RegPack(Buf, allocated(InData%BladeShape)) if (allocated(InData%BladeShape)) then call RegPackBounds(Buf, 1, lbound(InData%BladeShape), ubound(InData%BladeShape)) @@ -1079,7 +1057,6 @@ subroutine FAST_PackVTK_SurfaceType(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! MorisonRad call RegPack(Buf, allocated(InData%MorisonRad)) if (allocated(InData%MorisonRad)) then call RegPackBounds(Buf, 1, lbound(InData%MorisonRad), ubound(InData%MorisonRad)) @@ -1097,19 +1074,14 @@ subroutine FAST_UnPackVTK_SurfaceType(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! NumSectors call RegUnpack(Buf, OutData%NumSectors) if (RegCheckErr(Buf, RoutineName)) return - ! HubRad call RegUnpack(Buf, OutData%HubRad) if (RegCheckErr(Buf, RoutineName)) return - ! GroundRad call RegUnpack(Buf, OutData%GroundRad) if (RegCheckErr(Buf, RoutineName)) return - ! NacelleBox call RegUnpack(Buf, OutData%NacelleBox) if (RegCheckErr(Buf, RoutineName)) return - ! TowerRad if (allocated(OutData%TowerRad)) deallocate(OutData%TowerRad) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1124,10 +1096,8 @@ subroutine FAST_UnPackVTK_SurfaceType(Buf, OutData) call RegUnpack(Buf, OutData%TowerRad) if (RegCheckErr(Buf, RoutineName)) return end if - ! NWaveElevPts call RegUnpack(Buf, OutData%NWaveElevPts) if (RegCheckErr(Buf, RoutineName)) return - ! WaveElevXY if (allocated(OutData%WaveElevXY)) deallocate(OutData%WaveElevXY) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1142,7 +1112,6 @@ subroutine FAST_UnPackVTK_SurfaceType(Buf, OutData) call RegUnpack(Buf, OutData%WaveElevXY) if (RegCheckErr(Buf, RoutineName)) return end if - ! WaveElev if (allocated(OutData%WaveElev)) deallocate(OutData%WaveElev) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1157,7 +1126,6 @@ subroutine FAST_UnPackVTK_SurfaceType(Buf, OutData) call RegUnpack(Buf, OutData%WaveElev) if (RegCheckErr(Buf, RoutineName)) return end if - ! BladeShape if (allocated(OutData%BladeShape)) deallocate(OutData%BladeShape) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1173,7 +1141,6 @@ subroutine FAST_UnPackVTK_SurfaceType(Buf, OutData) call FAST_UnpackVTK_BLSurfaceType(Buf, OutData%BladeShape(i1)) ! BladeShape end do end if - ! MorisonRad if (allocated(OutData%MorisonRad)) deallocate(OutData%MorisonRad) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1189,208 +1156,187 @@ subroutine FAST_UnPackVTK_SurfaceType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE FAST_CopyVTK_ModeShapeType( SrcVTK_ModeShapeTypeData, DstVTK_ModeShapeTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_VTK_ModeShapeType), INTENT(IN) :: SrcVTK_ModeShapeTypeData - TYPE(FAST_VTK_ModeShapeType), INTENT(INOUT) :: DstVTK_ModeShapeTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyVTK_ModeShapeType' -! + +subroutine FAST_CopyVTK_ModeShapeType(SrcVTK_ModeShapeTypeData, DstVTK_ModeShapeTypeData, CtrlCode, ErrStat, ErrMsg) + type(FAST_VTK_ModeShapeType), intent(in) :: SrcVTK_ModeShapeTypeData + type(FAST_VTK_ModeShapeType), intent(inout) :: DstVTK_ModeShapeTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FAST_CopyVTK_ModeShapeType' ErrStat = ErrID_None - ErrMsg = "" - DstVTK_ModeShapeTypeData%CheckpointRoot = SrcVTK_ModeShapeTypeData%CheckpointRoot - DstVTK_ModeShapeTypeData%MatlabFileName = SrcVTK_ModeShapeTypeData%MatlabFileName - DstVTK_ModeShapeTypeData%VTKLinModes = SrcVTK_ModeShapeTypeData%VTKLinModes -IF (ALLOCATED(SrcVTK_ModeShapeTypeData%VTKModes)) THEN - i1_l = LBOUND(SrcVTK_ModeShapeTypeData%VTKModes,1) - i1_u = UBOUND(SrcVTK_ModeShapeTypeData%VTKModes,1) - IF (.NOT. ALLOCATED(DstVTK_ModeShapeTypeData%VTKModes)) THEN - ALLOCATE(DstVTK_ModeShapeTypeData%VTKModes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%VTKModes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstVTK_ModeShapeTypeData%VTKModes = SrcVTK_ModeShapeTypeData%VTKModes -ENDIF - DstVTK_ModeShapeTypeData%VTKLinTim = SrcVTK_ModeShapeTypeData%VTKLinTim - DstVTK_ModeShapeTypeData%VTKNLinTimes = SrcVTK_ModeShapeTypeData%VTKNLinTimes - DstVTK_ModeShapeTypeData%VTKLinScale = SrcVTK_ModeShapeTypeData%VTKLinScale - DstVTK_ModeShapeTypeData%VTKLinPhase = SrcVTK_ModeShapeTypeData%VTKLinPhase -IF (ALLOCATED(SrcVTK_ModeShapeTypeData%DampingRatio)) THEN - i1_l = LBOUND(SrcVTK_ModeShapeTypeData%DampingRatio,1) - i1_u = UBOUND(SrcVTK_ModeShapeTypeData%DampingRatio,1) - IF (.NOT. ALLOCATED(DstVTK_ModeShapeTypeData%DampingRatio)) THEN - ALLOCATE(DstVTK_ModeShapeTypeData%DampingRatio(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%DampingRatio.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstVTK_ModeShapeTypeData%DampingRatio = SrcVTK_ModeShapeTypeData%DampingRatio -ENDIF -IF (ALLOCATED(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz)) THEN - i1_l = LBOUND(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz,1) - i1_u = UBOUND(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz,1) - IF (.NOT. ALLOCATED(DstVTK_ModeShapeTypeData%NaturalFreq_Hz)) THEN - ALLOCATE(DstVTK_ModeShapeTypeData%NaturalFreq_Hz(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%NaturalFreq_Hz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstVTK_ModeShapeTypeData%NaturalFreq_Hz = SrcVTK_ModeShapeTypeData%NaturalFreq_Hz -ENDIF -IF (ALLOCATED(SrcVTK_ModeShapeTypeData%DampedFreq_Hz)) THEN - i1_l = LBOUND(SrcVTK_ModeShapeTypeData%DampedFreq_Hz,1) - i1_u = UBOUND(SrcVTK_ModeShapeTypeData%DampedFreq_Hz,1) - IF (.NOT. ALLOCATED(DstVTK_ModeShapeTypeData%DampedFreq_Hz)) THEN - ALLOCATE(DstVTK_ModeShapeTypeData%DampedFreq_Hz(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%DampedFreq_Hz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstVTK_ModeShapeTypeData%DampedFreq_Hz = SrcVTK_ModeShapeTypeData%DampedFreq_Hz -ENDIF -IF (ALLOCATED(SrcVTK_ModeShapeTypeData%x_eig_magnitude)) THEN - i1_l = LBOUND(SrcVTK_ModeShapeTypeData%x_eig_magnitude,1) - i1_u = UBOUND(SrcVTK_ModeShapeTypeData%x_eig_magnitude,1) - i2_l = LBOUND(SrcVTK_ModeShapeTypeData%x_eig_magnitude,2) - i2_u = UBOUND(SrcVTK_ModeShapeTypeData%x_eig_magnitude,2) - i3_l = LBOUND(SrcVTK_ModeShapeTypeData%x_eig_magnitude,3) - i3_u = UBOUND(SrcVTK_ModeShapeTypeData%x_eig_magnitude,3) - IF (.NOT. ALLOCATED(DstVTK_ModeShapeTypeData%x_eig_magnitude)) THEN - ALLOCATE(DstVTK_ModeShapeTypeData%x_eig_magnitude(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%x_eig_magnitude.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstVTK_ModeShapeTypeData%x_eig_magnitude = SrcVTK_ModeShapeTypeData%x_eig_magnitude -ENDIF -IF (ALLOCATED(SrcVTK_ModeShapeTypeData%x_eig_phase)) THEN - i1_l = LBOUND(SrcVTK_ModeShapeTypeData%x_eig_phase,1) - i1_u = UBOUND(SrcVTK_ModeShapeTypeData%x_eig_phase,1) - i2_l = LBOUND(SrcVTK_ModeShapeTypeData%x_eig_phase,2) - i2_u = UBOUND(SrcVTK_ModeShapeTypeData%x_eig_phase,2) - i3_l = LBOUND(SrcVTK_ModeShapeTypeData%x_eig_phase,3) - i3_u = UBOUND(SrcVTK_ModeShapeTypeData%x_eig_phase,3) - IF (.NOT. ALLOCATED(DstVTK_ModeShapeTypeData%x_eig_phase)) THEN - ALLOCATE(DstVTK_ModeShapeTypeData%x_eig_phase(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%x_eig_phase.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstVTK_ModeShapeTypeData%x_eig_phase = SrcVTK_ModeShapeTypeData%x_eig_phase -ENDIF - END SUBROUTINE FAST_CopyVTK_ModeShapeType - - SUBROUTINE FAST_DestroyVTK_ModeShapeType( VTK_ModeShapeTypeData, ErrStat, ErrMsg ) - TYPE(FAST_VTK_ModeShapeType), INTENT(INOUT) :: VTK_ModeShapeTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyVTK_ModeShapeType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(VTK_ModeShapeTypeData%VTKModes)) THEN - DEALLOCATE(VTK_ModeShapeTypeData%VTKModes) -ENDIF -IF (ALLOCATED(VTK_ModeShapeTypeData%DampingRatio)) THEN - DEALLOCATE(VTK_ModeShapeTypeData%DampingRatio) -ENDIF -IF (ALLOCATED(VTK_ModeShapeTypeData%NaturalFreq_Hz)) THEN - DEALLOCATE(VTK_ModeShapeTypeData%NaturalFreq_Hz) -ENDIF -IF (ALLOCATED(VTK_ModeShapeTypeData%DampedFreq_Hz)) THEN - DEALLOCATE(VTK_ModeShapeTypeData%DampedFreq_Hz) -ENDIF -IF (ALLOCATED(VTK_ModeShapeTypeData%x_eig_magnitude)) THEN - DEALLOCATE(VTK_ModeShapeTypeData%x_eig_magnitude) -ENDIF -IF (ALLOCATED(VTK_ModeShapeTypeData%x_eig_phase)) THEN - DEALLOCATE(VTK_ModeShapeTypeData%x_eig_phase) -ENDIF - END SUBROUTINE FAST_DestroyVTK_ModeShapeType + ErrMsg = '' + DstVTK_ModeShapeTypeData%CheckpointRoot = SrcVTK_ModeShapeTypeData%CheckpointRoot + DstVTK_ModeShapeTypeData%MatlabFileName = SrcVTK_ModeShapeTypeData%MatlabFileName + DstVTK_ModeShapeTypeData%VTKLinModes = SrcVTK_ModeShapeTypeData%VTKLinModes + if (allocated(SrcVTK_ModeShapeTypeData%VTKModes)) then + LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%VTKModes) + UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%VTKModes) + if (.not. allocated(DstVTK_ModeShapeTypeData%VTKModes)) then + allocate(DstVTK_ModeShapeTypeData%VTKModes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%VTKModes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVTK_ModeShapeTypeData%VTKModes = SrcVTK_ModeShapeTypeData%VTKModes + else if (allocated(DstVTK_ModeShapeTypeData%VTKModes)) then + deallocate(DstVTK_ModeShapeTypeData%VTKModes) + end if + DstVTK_ModeShapeTypeData%VTKLinTim = SrcVTK_ModeShapeTypeData%VTKLinTim + DstVTK_ModeShapeTypeData%VTKNLinTimes = SrcVTK_ModeShapeTypeData%VTKNLinTimes + DstVTK_ModeShapeTypeData%VTKLinScale = SrcVTK_ModeShapeTypeData%VTKLinScale + DstVTK_ModeShapeTypeData%VTKLinPhase = SrcVTK_ModeShapeTypeData%VTKLinPhase + if (allocated(SrcVTK_ModeShapeTypeData%DampingRatio)) then + LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%DampingRatio) + UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%DampingRatio) + if (.not. allocated(DstVTK_ModeShapeTypeData%DampingRatio)) then + allocate(DstVTK_ModeShapeTypeData%DampingRatio(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%DampingRatio.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVTK_ModeShapeTypeData%DampingRatio = SrcVTK_ModeShapeTypeData%DampingRatio + else if (allocated(DstVTK_ModeShapeTypeData%DampingRatio)) then + deallocate(DstVTK_ModeShapeTypeData%DampingRatio) + end if + if (allocated(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz)) then + LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz) + UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz) + if (.not. allocated(DstVTK_ModeShapeTypeData%NaturalFreq_Hz)) then + allocate(DstVTK_ModeShapeTypeData%NaturalFreq_Hz(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%NaturalFreq_Hz.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVTK_ModeShapeTypeData%NaturalFreq_Hz = SrcVTK_ModeShapeTypeData%NaturalFreq_Hz + else if (allocated(DstVTK_ModeShapeTypeData%NaturalFreq_Hz)) then + deallocate(DstVTK_ModeShapeTypeData%NaturalFreq_Hz) + end if + if (allocated(SrcVTK_ModeShapeTypeData%DampedFreq_Hz)) then + LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%DampedFreq_Hz) + UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%DampedFreq_Hz) + if (.not. allocated(DstVTK_ModeShapeTypeData%DampedFreq_Hz)) then + allocate(DstVTK_ModeShapeTypeData%DampedFreq_Hz(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%DampedFreq_Hz.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVTK_ModeShapeTypeData%DampedFreq_Hz = SrcVTK_ModeShapeTypeData%DampedFreq_Hz + else if (allocated(DstVTK_ModeShapeTypeData%DampedFreq_Hz)) then + deallocate(DstVTK_ModeShapeTypeData%DampedFreq_Hz) + end if + if (allocated(SrcVTK_ModeShapeTypeData%x_eig_magnitude)) then + LB(1:3) = lbound(SrcVTK_ModeShapeTypeData%x_eig_magnitude) + UB(1:3) = ubound(SrcVTK_ModeShapeTypeData%x_eig_magnitude) + if (.not. allocated(DstVTK_ModeShapeTypeData%x_eig_magnitude)) then + allocate(DstVTK_ModeShapeTypeData%x_eig_magnitude(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%x_eig_magnitude.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVTK_ModeShapeTypeData%x_eig_magnitude = SrcVTK_ModeShapeTypeData%x_eig_magnitude + else if (allocated(DstVTK_ModeShapeTypeData%x_eig_magnitude)) then + deallocate(DstVTK_ModeShapeTypeData%x_eig_magnitude) + end if + if (allocated(SrcVTK_ModeShapeTypeData%x_eig_phase)) then + LB(1:3) = lbound(SrcVTK_ModeShapeTypeData%x_eig_phase) + UB(1:3) = ubound(SrcVTK_ModeShapeTypeData%x_eig_phase) + if (.not. allocated(DstVTK_ModeShapeTypeData%x_eig_phase)) then + allocate(DstVTK_ModeShapeTypeData%x_eig_phase(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%x_eig_phase.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstVTK_ModeShapeTypeData%x_eig_phase = SrcVTK_ModeShapeTypeData%x_eig_phase + else if (allocated(DstVTK_ModeShapeTypeData%x_eig_phase)) then + deallocate(DstVTK_ModeShapeTypeData%x_eig_phase) + end if +end subroutine +subroutine FAST_DestroyVTK_ModeShapeType(VTK_ModeShapeTypeData, ErrStat, ErrMsg) + type(FAST_VTK_ModeShapeType), intent(inout) :: VTK_ModeShapeTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FAST_DestroyVTK_ModeShapeType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(VTK_ModeShapeTypeData%VTKModes)) then + deallocate(VTK_ModeShapeTypeData%VTKModes) + end if + if (allocated(VTK_ModeShapeTypeData%DampingRatio)) then + deallocate(VTK_ModeShapeTypeData%DampingRatio) + end if + if (allocated(VTK_ModeShapeTypeData%NaturalFreq_Hz)) then + deallocate(VTK_ModeShapeTypeData%NaturalFreq_Hz) + end if + if (allocated(VTK_ModeShapeTypeData%DampedFreq_Hz)) then + deallocate(VTK_ModeShapeTypeData%DampedFreq_Hz) + end if + if (allocated(VTK_ModeShapeTypeData%x_eig_magnitude)) then + deallocate(VTK_ModeShapeTypeData%x_eig_magnitude) + end if + if (allocated(VTK_ModeShapeTypeData%x_eig_phase)) then + deallocate(VTK_ModeShapeTypeData%x_eig_phase) + end if +end subroutine subroutine FAST_PackVTK_ModeShapeType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FAST_VTK_ModeShapeType), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackVTK_ModeShapeType' if (Buf%ErrStat >= AbortErrLev) return - ! CheckpointRoot call RegPack(Buf, InData%CheckpointRoot) if (RegCheckErr(Buf, RoutineName)) return - ! MatlabFileName call RegPack(Buf, InData%MatlabFileName) if (RegCheckErr(Buf, RoutineName)) return - ! VTKLinModes call RegPack(Buf, InData%VTKLinModes) if (RegCheckErr(Buf, RoutineName)) return - ! VTKModes call RegPack(Buf, allocated(InData%VTKModes)) if (allocated(InData%VTKModes)) then call RegPackBounds(Buf, 1, lbound(InData%VTKModes), ubound(InData%VTKModes)) call RegPack(Buf, InData%VTKModes) end if if (RegCheckErr(Buf, RoutineName)) return - ! VTKLinTim call RegPack(Buf, InData%VTKLinTim) if (RegCheckErr(Buf, RoutineName)) return - ! VTKNLinTimes call RegPack(Buf, InData%VTKNLinTimes) if (RegCheckErr(Buf, RoutineName)) return - ! VTKLinScale call RegPack(Buf, InData%VTKLinScale) if (RegCheckErr(Buf, RoutineName)) return - ! VTKLinPhase call RegPack(Buf, InData%VTKLinPhase) if (RegCheckErr(Buf, RoutineName)) return - ! DampingRatio call RegPack(Buf, allocated(InData%DampingRatio)) if (allocated(InData%DampingRatio)) then call RegPackBounds(Buf, 1, lbound(InData%DampingRatio), ubound(InData%DampingRatio)) call RegPack(Buf, InData%DampingRatio) end if if (RegCheckErr(Buf, RoutineName)) return - ! NaturalFreq_Hz call RegPack(Buf, allocated(InData%NaturalFreq_Hz)) if (allocated(InData%NaturalFreq_Hz)) then call RegPackBounds(Buf, 1, lbound(InData%NaturalFreq_Hz), ubound(InData%NaturalFreq_Hz)) call RegPack(Buf, InData%NaturalFreq_Hz) end if if (RegCheckErr(Buf, RoutineName)) return - ! DampedFreq_Hz call RegPack(Buf, allocated(InData%DampedFreq_Hz)) if (allocated(InData%DampedFreq_Hz)) then call RegPackBounds(Buf, 1, lbound(InData%DampedFreq_Hz), ubound(InData%DampedFreq_Hz)) call RegPack(Buf, InData%DampedFreq_Hz) end if if (RegCheckErr(Buf, RoutineName)) return - ! x_eig_magnitude call RegPack(Buf, allocated(InData%x_eig_magnitude)) if (allocated(InData%x_eig_magnitude)) then call RegPackBounds(Buf, 3, lbound(InData%x_eig_magnitude), ubound(InData%x_eig_magnitude)) call RegPack(Buf, InData%x_eig_magnitude) end if if (RegCheckErr(Buf, RoutineName)) return - ! x_eig_phase call RegPack(Buf, allocated(InData%x_eig_phase)) if (allocated(InData%x_eig_phase)) then call RegPackBounds(Buf, 3, lbound(InData%x_eig_phase), ubound(InData%x_eig_phase)) @@ -1407,16 +1353,12 @@ subroutine FAST_UnPackVTK_ModeShapeType(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! CheckpointRoot call RegUnpack(Buf, OutData%CheckpointRoot) if (RegCheckErr(Buf, RoutineName)) return - ! MatlabFileName call RegUnpack(Buf, OutData%MatlabFileName) if (RegCheckErr(Buf, RoutineName)) return - ! VTKLinModes call RegUnpack(Buf, OutData%VTKLinModes) if (RegCheckErr(Buf, RoutineName)) return - ! VTKModes if (allocated(OutData%VTKModes)) deallocate(OutData%VTKModes) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1431,19 +1373,14 @@ subroutine FAST_UnPackVTK_ModeShapeType(Buf, OutData) call RegUnpack(Buf, OutData%VTKModes) if (RegCheckErr(Buf, RoutineName)) return end if - ! VTKLinTim call RegUnpack(Buf, OutData%VTKLinTim) if (RegCheckErr(Buf, RoutineName)) return - ! VTKNLinTimes call RegUnpack(Buf, OutData%VTKNLinTimes) if (RegCheckErr(Buf, RoutineName)) return - ! VTKLinScale call RegUnpack(Buf, OutData%VTKLinScale) if (RegCheckErr(Buf, RoutineName)) return - ! VTKLinPhase call RegUnpack(Buf, OutData%VTKLinPhase) if (RegCheckErr(Buf, RoutineName)) return - ! DampingRatio if (allocated(OutData%DampingRatio)) deallocate(OutData%DampingRatio) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1458,7 +1395,6 @@ subroutine FAST_UnPackVTK_ModeShapeType(Buf, OutData) call RegUnpack(Buf, OutData%DampingRatio) if (RegCheckErr(Buf, RoutineName)) return end if - ! NaturalFreq_Hz if (allocated(OutData%NaturalFreq_Hz)) deallocate(OutData%NaturalFreq_Hz) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1473,7 +1409,6 @@ subroutine FAST_UnPackVTK_ModeShapeType(Buf, OutData) call RegUnpack(Buf, OutData%NaturalFreq_Hz) if (RegCheckErr(Buf, RoutineName)) return end if - ! DampedFreq_Hz if (allocated(OutData%DampedFreq_Hz)) deallocate(OutData%DampedFreq_Hz) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1488,7 +1423,6 @@ subroutine FAST_UnPackVTK_ModeShapeType(Buf, OutData) call RegUnpack(Buf, OutData%DampedFreq_Hz) if (RegCheckErr(Buf, RoutineName)) return end if - ! x_eig_magnitude if (allocated(OutData%x_eig_magnitude)) deallocate(OutData%x_eig_magnitude) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1503,7 +1437,6 @@ subroutine FAST_UnPackVTK_ModeShapeType(Buf, OutData) call RegUnpack(Buf, OutData%x_eig_magnitude) if (RegCheckErr(Buf, RoutineName)) return end if - ! x_eig_phase if (allocated(OutData%x_eig_phase)) deallocate(OutData%x_eig_phase) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1519,426 +1452,320 @@ subroutine FAST_UnPackVTK_ModeShapeType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE FAST_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_ParameterType), INTENT(IN) :: SrcParamData - TYPE(FAST_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyParam' -! + +subroutine FAST_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(FAST_ParameterType), intent(in) :: SrcParamData + type(FAST_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyParam' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT - DstParamData%DT_module = SrcParamData%DT_module - DstParamData%n_substeps = SrcParamData%n_substeps - DstParamData%n_TMax_m1 = SrcParamData%n_TMax_m1 - DstParamData%TMax = SrcParamData%TMax - DstParamData%InterpOrder = SrcParamData%InterpOrder - DstParamData%NumCrctn = SrcParamData%NumCrctn - DstParamData%KMax = SrcParamData%KMax - DstParamData%numIceLegs = SrcParamData%numIceLegs - DstParamData%nBeams = SrcParamData%nBeams - DstParamData%BD_OutputSibling = SrcParamData%BD_OutputSibling - DstParamData%ModuleInitialized = SrcParamData%ModuleInitialized - DstParamData%DT_Ujac = SrcParamData%DT_Ujac - DstParamData%UJacSclFact = SrcParamData%UJacSclFact - DstParamData%SizeJac_Opt1 = SrcParamData%SizeJac_Opt1 - DstParamData%SolveOption = SrcParamData%SolveOption - DstParamData%CompElast = SrcParamData%CompElast - DstParamData%CompInflow = SrcParamData%CompInflow - DstParamData%CompAero = SrcParamData%CompAero - DstParamData%CompServo = SrcParamData%CompServo - DstParamData%CompSeaSt = SrcParamData%CompSeaSt - DstParamData%CompHydro = SrcParamData%CompHydro - DstParamData%CompSub = SrcParamData%CompSub - DstParamData%CompMooring = SrcParamData%CompMooring - DstParamData%CompIce = SrcParamData%CompIce - DstParamData%MHK = SrcParamData%MHK - DstParamData%UseDWM = SrcParamData%UseDWM - DstParamData%Linearize = SrcParamData%Linearize - DstParamData%WaveFieldMod = SrcParamData%WaveFieldMod - DstParamData%FarmIntegration = SrcParamData%FarmIntegration - DstParamData%TurbinePos = SrcParamData%TurbinePos - DstParamData%Gravity = SrcParamData%Gravity - DstParamData%AirDens = SrcParamData%AirDens - DstParamData%WtrDens = SrcParamData%WtrDens - DstParamData%KinVisc = SrcParamData%KinVisc - DstParamData%SpdSound = SrcParamData%SpdSound - DstParamData%Patm = SrcParamData%Patm - DstParamData%Pvap = SrcParamData%Pvap - DstParamData%WtrDpth = SrcParamData%WtrDpth - DstParamData%MSL2SWL = SrcParamData%MSL2SWL - DstParamData%EDFile = SrcParamData%EDFile - DstParamData%BDBldFile = SrcParamData%BDBldFile - DstParamData%InflowFile = SrcParamData%InflowFile - DstParamData%AeroFile = SrcParamData%AeroFile - DstParamData%ServoFile = SrcParamData%ServoFile - DstParamData%SeaStFile = SrcParamData%SeaStFile - DstParamData%HydroFile = SrcParamData%HydroFile - DstParamData%SubFile = SrcParamData%SubFile - DstParamData%MooringFile = SrcParamData%MooringFile - DstParamData%IceFile = SrcParamData%IceFile - DstParamData%TStart = SrcParamData%TStart - DstParamData%DT_Out = SrcParamData%DT_Out - DstParamData%WrSttsTime = SrcParamData%WrSttsTime - DstParamData%n_SttsTime = SrcParamData%n_SttsTime - DstParamData%n_ChkptTime = SrcParamData%n_ChkptTime - DstParamData%n_DT_Out = SrcParamData%n_DT_Out - DstParamData%n_VTKTime = SrcParamData%n_VTKTime - DstParamData%TurbineType = SrcParamData%TurbineType - DstParamData%WrBinOutFile = SrcParamData%WrBinOutFile - DstParamData%WrTxtOutFile = SrcParamData%WrTxtOutFile - DstParamData%WrBinMod = SrcParamData%WrBinMod - DstParamData%SumPrint = SrcParamData%SumPrint - DstParamData%WrVTK = SrcParamData%WrVTK - DstParamData%VTK_Type = SrcParamData%VTK_Type - DstParamData%VTK_fields = SrcParamData%VTK_fields - DstParamData%Delim = SrcParamData%Delim - DstParamData%OutFmt = SrcParamData%OutFmt - DstParamData%OutFmt_t = SrcParamData%OutFmt_t - DstParamData%FmtWidth = SrcParamData%FmtWidth - DstParamData%TChanLen = SrcParamData%TChanLen - DstParamData%OutFileRoot = SrcParamData%OutFileRoot - DstParamData%FTitle = SrcParamData%FTitle - DstParamData%VTK_OutFileRoot = SrcParamData%VTK_OutFileRoot - DstParamData%VTK_tWidth = SrcParamData%VTK_tWidth - DstParamData%VTK_fps = SrcParamData%VTK_fps - CALL FAST_Copyvtk_surfacetype( SrcParamData%VTK_surface, DstParamData%VTK_surface, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstParamData%Tdesc = SrcParamData%Tdesc - DstParamData%CalcSteady = SrcParamData%CalcSteady - DstParamData%TrimCase = SrcParamData%TrimCase - DstParamData%TrimTol = SrcParamData%TrimTol - DstParamData%TrimGain = SrcParamData%TrimGain - DstParamData%Twr_Kdmp = SrcParamData%Twr_Kdmp - DstParamData%Bld_Kdmp = SrcParamData%Bld_Kdmp - DstParamData%NLinTimes = SrcParamData%NLinTimes - DstParamData%AzimDelta = SrcParamData%AzimDelta - DstParamData%LinInputs = SrcParamData%LinInputs - DstParamData%LinOutputs = SrcParamData%LinOutputs - DstParamData%LinOutJac = SrcParamData%LinOutJac - DstParamData%LinOutMod = SrcParamData%LinOutMod - CALL FAST_Copyvtk_modeshapetype( SrcParamData%VTK_modes, DstParamData%VTK_modes, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstParamData%UseSC = SrcParamData%UseSC - DstParamData%Lin_NumMods = SrcParamData%Lin_NumMods - DstParamData%Lin_ModOrder = SrcParamData%Lin_ModOrder - DstParamData%LinInterpOrder = SrcParamData%LinInterpOrder - END SUBROUTINE FAST_CopyParam - - SUBROUTINE FAST_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(FAST_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL FAST_DestroyVTK_SurfaceType( ParamData%VTK_surface, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroyVTK_ModeShapeType( ParamData%VTK_modes, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE FAST_DestroyParam + ErrMsg = '' + DstParamData%DT = SrcParamData%DT + DstParamData%DT_module = SrcParamData%DT_module + DstParamData%n_substeps = SrcParamData%n_substeps + DstParamData%n_TMax_m1 = SrcParamData%n_TMax_m1 + DstParamData%TMax = SrcParamData%TMax + DstParamData%InterpOrder = SrcParamData%InterpOrder + DstParamData%NumCrctn = SrcParamData%NumCrctn + DstParamData%KMax = SrcParamData%KMax + DstParamData%numIceLegs = SrcParamData%numIceLegs + DstParamData%nBeams = SrcParamData%nBeams + DstParamData%BD_OutputSibling = SrcParamData%BD_OutputSibling + DstParamData%ModuleInitialized = SrcParamData%ModuleInitialized + DstParamData%DT_Ujac = SrcParamData%DT_Ujac + DstParamData%UJacSclFact = SrcParamData%UJacSclFact + DstParamData%SizeJac_Opt1 = SrcParamData%SizeJac_Opt1 + DstParamData%SolveOption = SrcParamData%SolveOption + DstParamData%CompElast = SrcParamData%CompElast + DstParamData%CompInflow = SrcParamData%CompInflow + DstParamData%CompAero = SrcParamData%CompAero + DstParamData%CompServo = SrcParamData%CompServo + DstParamData%CompSeaSt = SrcParamData%CompSeaSt + DstParamData%CompHydro = SrcParamData%CompHydro + DstParamData%CompSub = SrcParamData%CompSub + DstParamData%CompMooring = SrcParamData%CompMooring + DstParamData%CompIce = SrcParamData%CompIce + DstParamData%MHK = SrcParamData%MHK + DstParamData%UseDWM = SrcParamData%UseDWM + DstParamData%Linearize = SrcParamData%Linearize + DstParamData%WaveFieldMod = SrcParamData%WaveFieldMod + DstParamData%FarmIntegration = SrcParamData%FarmIntegration + DstParamData%TurbinePos = SrcParamData%TurbinePos + DstParamData%Gravity = SrcParamData%Gravity + DstParamData%AirDens = SrcParamData%AirDens + DstParamData%WtrDens = SrcParamData%WtrDens + DstParamData%KinVisc = SrcParamData%KinVisc + DstParamData%SpdSound = SrcParamData%SpdSound + DstParamData%Patm = SrcParamData%Patm + DstParamData%Pvap = SrcParamData%Pvap + DstParamData%WtrDpth = SrcParamData%WtrDpth + DstParamData%MSL2SWL = SrcParamData%MSL2SWL + DstParamData%EDFile = SrcParamData%EDFile + DstParamData%BDBldFile = SrcParamData%BDBldFile + DstParamData%InflowFile = SrcParamData%InflowFile + DstParamData%AeroFile = SrcParamData%AeroFile + DstParamData%ServoFile = SrcParamData%ServoFile + DstParamData%SeaStFile = SrcParamData%SeaStFile + DstParamData%HydroFile = SrcParamData%HydroFile + DstParamData%SubFile = SrcParamData%SubFile + DstParamData%MooringFile = SrcParamData%MooringFile + DstParamData%IceFile = SrcParamData%IceFile + DstParamData%TStart = SrcParamData%TStart + DstParamData%DT_Out = SrcParamData%DT_Out + DstParamData%WrSttsTime = SrcParamData%WrSttsTime + DstParamData%n_SttsTime = SrcParamData%n_SttsTime + DstParamData%n_ChkptTime = SrcParamData%n_ChkptTime + DstParamData%n_DT_Out = SrcParamData%n_DT_Out + DstParamData%n_VTKTime = SrcParamData%n_VTKTime + DstParamData%TurbineType = SrcParamData%TurbineType + DstParamData%WrBinOutFile = SrcParamData%WrBinOutFile + DstParamData%WrTxtOutFile = SrcParamData%WrTxtOutFile + DstParamData%WrBinMod = SrcParamData%WrBinMod + DstParamData%SumPrint = SrcParamData%SumPrint + DstParamData%WrVTK = SrcParamData%WrVTK + DstParamData%VTK_Type = SrcParamData%VTK_Type + DstParamData%VTK_fields = SrcParamData%VTK_fields + DstParamData%Delim = SrcParamData%Delim + DstParamData%OutFmt = SrcParamData%OutFmt + DstParamData%OutFmt_t = SrcParamData%OutFmt_t + DstParamData%FmtWidth = SrcParamData%FmtWidth + DstParamData%TChanLen = SrcParamData%TChanLen + DstParamData%OutFileRoot = SrcParamData%OutFileRoot + DstParamData%FTitle = SrcParamData%FTitle + DstParamData%VTK_OutFileRoot = SrcParamData%VTK_OutFileRoot + DstParamData%VTK_tWidth = SrcParamData%VTK_tWidth + DstParamData%VTK_fps = SrcParamData%VTK_fps + call FAST_CopyVTK_SurfaceType(SrcParamData%VTK_surface, DstParamData%VTK_surface, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstParamData%Tdesc = SrcParamData%Tdesc + DstParamData%CalcSteady = SrcParamData%CalcSteady + DstParamData%TrimCase = SrcParamData%TrimCase + DstParamData%TrimTol = SrcParamData%TrimTol + DstParamData%TrimGain = SrcParamData%TrimGain + DstParamData%Twr_Kdmp = SrcParamData%Twr_Kdmp + DstParamData%Bld_Kdmp = SrcParamData%Bld_Kdmp + DstParamData%NLinTimes = SrcParamData%NLinTimes + DstParamData%AzimDelta = SrcParamData%AzimDelta + DstParamData%LinInputs = SrcParamData%LinInputs + DstParamData%LinOutputs = SrcParamData%LinOutputs + DstParamData%LinOutJac = SrcParamData%LinOutJac + DstParamData%LinOutMod = SrcParamData%LinOutMod + call FAST_CopyVTK_ModeShapeType(SrcParamData%VTK_modes, DstParamData%VTK_modes, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstParamData%UseSC = SrcParamData%UseSC + DstParamData%Lin_NumMods = SrcParamData%Lin_NumMods + DstParamData%Lin_ModOrder = SrcParamData%Lin_ModOrder + DstParamData%LinInterpOrder = SrcParamData%LinInterpOrder +end subroutine +subroutine FAST_DestroyParam(ParamData, ErrStat, ErrMsg) + type(FAST_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine FAST_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FAST_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackParam' if (Buf%ErrStat >= AbortErrLev) return - ! DT call RegPack(Buf, InData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! DT_module call RegPack(Buf, InData%DT_module) if (RegCheckErr(Buf, RoutineName)) return - ! n_substeps call RegPack(Buf, InData%n_substeps) if (RegCheckErr(Buf, RoutineName)) return - ! n_TMax_m1 call RegPack(Buf, InData%n_TMax_m1) if (RegCheckErr(Buf, RoutineName)) return - ! TMax call RegPack(Buf, InData%TMax) if (RegCheckErr(Buf, RoutineName)) return - ! InterpOrder call RegPack(Buf, InData%InterpOrder) if (RegCheckErr(Buf, RoutineName)) return - ! NumCrctn call RegPack(Buf, InData%NumCrctn) if (RegCheckErr(Buf, RoutineName)) return - ! KMax call RegPack(Buf, InData%KMax) if (RegCheckErr(Buf, RoutineName)) return - ! numIceLegs call RegPack(Buf, InData%numIceLegs) if (RegCheckErr(Buf, RoutineName)) return - ! nBeams call RegPack(Buf, InData%nBeams) if (RegCheckErr(Buf, RoutineName)) return - ! BD_OutputSibling call RegPack(Buf, InData%BD_OutputSibling) if (RegCheckErr(Buf, RoutineName)) return - ! ModuleInitialized call RegPack(Buf, InData%ModuleInitialized) if (RegCheckErr(Buf, RoutineName)) return - ! DT_Ujac call RegPack(Buf, InData%DT_Ujac) if (RegCheckErr(Buf, RoutineName)) return - ! UJacSclFact call RegPack(Buf, InData%UJacSclFact) if (RegCheckErr(Buf, RoutineName)) return - ! SizeJac_Opt1 call RegPack(Buf, InData%SizeJac_Opt1) if (RegCheckErr(Buf, RoutineName)) return - ! SolveOption call RegPack(Buf, InData%SolveOption) if (RegCheckErr(Buf, RoutineName)) return - ! CompElast call RegPack(Buf, InData%CompElast) if (RegCheckErr(Buf, RoutineName)) return - ! CompInflow call RegPack(Buf, InData%CompInflow) if (RegCheckErr(Buf, RoutineName)) return - ! CompAero call RegPack(Buf, InData%CompAero) if (RegCheckErr(Buf, RoutineName)) return - ! CompServo call RegPack(Buf, InData%CompServo) if (RegCheckErr(Buf, RoutineName)) return - ! CompSeaSt call RegPack(Buf, InData%CompSeaSt) if (RegCheckErr(Buf, RoutineName)) return - ! CompHydro call RegPack(Buf, InData%CompHydro) if (RegCheckErr(Buf, RoutineName)) return - ! CompSub call RegPack(Buf, InData%CompSub) if (RegCheckErr(Buf, RoutineName)) return - ! CompMooring call RegPack(Buf, InData%CompMooring) if (RegCheckErr(Buf, RoutineName)) return - ! CompIce call RegPack(Buf, InData%CompIce) if (RegCheckErr(Buf, RoutineName)) return - ! MHK call RegPack(Buf, InData%MHK) if (RegCheckErr(Buf, RoutineName)) return - ! UseDWM call RegPack(Buf, InData%UseDWM) if (RegCheckErr(Buf, RoutineName)) return - ! Linearize call RegPack(Buf, InData%Linearize) if (RegCheckErr(Buf, RoutineName)) return - ! WaveFieldMod call RegPack(Buf, InData%WaveFieldMod) if (RegCheckErr(Buf, RoutineName)) return - ! FarmIntegration call RegPack(Buf, InData%FarmIntegration) if (RegCheckErr(Buf, RoutineName)) return - ! TurbinePos call RegPack(Buf, InData%TurbinePos) if (RegCheckErr(Buf, RoutineName)) return - ! Gravity call RegPack(Buf, InData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - ! AirDens call RegPack(Buf, InData%AirDens) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDens call RegPack(Buf, InData%WtrDens) if (RegCheckErr(Buf, RoutineName)) return - ! KinVisc call RegPack(Buf, InData%KinVisc) if (RegCheckErr(Buf, RoutineName)) return - ! SpdSound call RegPack(Buf, InData%SpdSound) if (RegCheckErr(Buf, RoutineName)) return - ! Patm call RegPack(Buf, InData%Patm) if (RegCheckErr(Buf, RoutineName)) return - ! Pvap call RegPack(Buf, InData%Pvap) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDpth call RegPack(Buf, InData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - ! MSL2SWL call RegPack(Buf, InData%MSL2SWL) if (RegCheckErr(Buf, RoutineName)) return - ! EDFile call RegPack(Buf, InData%EDFile) if (RegCheckErr(Buf, RoutineName)) return - ! BDBldFile call RegPack(Buf, InData%BDBldFile) if (RegCheckErr(Buf, RoutineName)) return - ! InflowFile call RegPack(Buf, InData%InflowFile) if (RegCheckErr(Buf, RoutineName)) return - ! AeroFile call RegPack(Buf, InData%AeroFile) if (RegCheckErr(Buf, RoutineName)) return - ! ServoFile call RegPack(Buf, InData%ServoFile) if (RegCheckErr(Buf, RoutineName)) return - ! SeaStFile call RegPack(Buf, InData%SeaStFile) if (RegCheckErr(Buf, RoutineName)) return - ! HydroFile call RegPack(Buf, InData%HydroFile) if (RegCheckErr(Buf, RoutineName)) return - ! SubFile call RegPack(Buf, InData%SubFile) if (RegCheckErr(Buf, RoutineName)) return - ! MooringFile call RegPack(Buf, InData%MooringFile) if (RegCheckErr(Buf, RoutineName)) return - ! IceFile call RegPack(Buf, InData%IceFile) if (RegCheckErr(Buf, RoutineName)) return - ! TStart call RegPack(Buf, InData%TStart) if (RegCheckErr(Buf, RoutineName)) return - ! DT_Out call RegPack(Buf, InData%DT_Out) if (RegCheckErr(Buf, RoutineName)) return - ! WrSttsTime call RegPack(Buf, InData%WrSttsTime) if (RegCheckErr(Buf, RoutineName)) return - ! n_SttsTime call RegPack(Buf, InData%n_SttsTime) if (RegCheckErr(Buf, RoutineName)) return - ! n_ChkptTime call RegPack(Buf, InData%n_ChkptTime) if (RegCheckErr(Buf, RoutineName)) return - ! n_DT_Out call RegPack(Buf, InData%n_DT_Out) if (RegCheckErr(Buf, RoutineName)) return - ! n_VTKTime call RegPack(Buf, InData%n_VTKTime) if (RegCheckErr(Buf, RoutineName)) return - ! TurbineType call RegPack(Buf, InData%TurbineType) if (RegCheckErr(Buf, RoutineName)) return - ! WrBinOutFile call RegPack(Buf, InData%WrBinOutFile) if (RegCheckErr(Buf, RoutineName)) return - ! WrTxtOutFile call RegPack(Buf, InData%WrTxtOutFile) if (RegCheckErr(Buf, RoutineName)) return - ! WrBinMod call RegPack(Buf, InData%WrBinMod) if (RegCheckErr(Buf, RoutineName)) return - ! SumPrint call RegPack(Buf, InData%SumPrint) if (RegCheckErr(Buf, RoutineName)) return - ! WrVTK call RegPack(Buf, InData%WrVTK) if (RegCheckErr(Buf, RoutineName)) return - ! VTK_Type call RegPack(Buf, InData%VTK_Type) if (RegCheckErr(Buf, RoutineName)) return - ! VTK_fields call RegPack(Buf, InData%VTK_fields) if (RegCheckErr(Buf, RoutineName)) return - ! Delim call RegPack(Buf, InData%Delim) if (RegCheckErr(Buf, RoutineName)) return - ! OutFmt call RegPack(Buf, InData%OutFmt) if (RegCheckErr(Buf, RoutineName)) return - ! OutFmt_t call RegPack(Buf, InData%OutFmt_t) if (RegCheckErr(Buf, RoutineName)) return - ! FmtWidth call RegPack(Buf, InData%FmtWidth) if (RegCheckErr(Buf, RoutineName)) return - ! TChanLen call RegPack(Buf, InData%TChanLen) if (RegCheckErr(Buf, RoutineName)) return - ! OutFileRoot call RegPack(Buf, InData%OutFileRoot) if (RegCheckErr(Buf, RoutineName)) return - ! FTitle call RegPack(Buf, InData%FTitle) if (RegCheckErr(Buf, RoutineName)) return - ! VTK_OutFileRoot call RegPack(Buf, InData%VTK_OutFileRoot) if (RegCheckErr(Buf, RoutineName)) return - ! VTK_tWidth call RegPack(Buf, InData%VTK_tWidth) if (RegCheckErr(Buf, RoutineName)) return - ! VTK_fps call RegPack(Buf, InData%VTK_fps) if (RegCheckErr(Buf, RoutineName)) return - ! VTK_surface call FAST_PackVTK_SurfaceType(Buf, InData%VTK_surface) if (RegCheckErr(Buf, RoutineName)) return - ! Tdesc call RegPack(Buf, InData%Tdesc) if (RegCheckErr(Buf, RoutineName)) return - ! CalcSteady call RegPack(Buf, InData%CalcSteady) if (RegCheckErr(Buf, RoutineName)) return - ! TrimCase call RegPack(Buf, InData%TrimCase) if (RegCheckErr(Buf, RoutineName)) return - ! TrimTol call RegPack(Buf, InData%TrimTol) if (RegCheckErr(Buf, RoutineName)) return - ! TrimGain call RegPack(Buf, InData%TrimGain) if (RegCheckErr(Buf, RoutineName)) return - ! Twr_Kdmp call RegPack(Buf, InData%Twr_Kdmp) if (RegCheckErr(Buf, RoutineName)) return - ! Bld_Kdmp call RegPack(Buf, InData%Bld_Kdmp) if (RegCheckErr(Buf, RoutineName)) return - ! NLinTimes call RegPack(Buf, InData%NLinTimes) if (RegCheckErr(Buf, RoutineName)) return - ! AzimDelta call RegPack(Buf, InData%AzimDelta) if (RegCheckErr(Buf, RoutineName)) return - ! LinInputs call RegPack(Buf, InData%LinInputs) if (RegCheckErr(Buf, RoutineName)) return - ! LinOutputs call RegPack(Buf, InData%LinOutputs) if (RegCheckErr(Buf, RoutineName)) return - ! LinOutJac call RegPack(Buf, InData%LinOutJac) if (RegCheckErr(Buf, RoutineName)) return - ! LinOutMod call RegPack(Buf, InData%LinOutMod) if (RegCheckErr(Buf, RoutineName)) return - ! VTK_modes call FAST_PackVTK_ModeShapeType(Buf, InData%VTK_modes) if (RegCheckErr(Buf, RoutineName)) return - ! UseSC call RegPack(Buf, InData%UseSC) if (RegCheckErr(Buf, RoutineName)) return - ! Lin_NumMods call RegPack(Buf, InData%Lin_NumMods) if (RegCheckErr(Buf, RoutineName)) return - ! Lin_ModOrder call RegPack(Buf, InData%Lin_ModOrder) if (RegCheckErr(Buf, RoutineName)) return - ! LinInterpOrder call RegPack(Buf, InData%LinInterpOrder) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1948,4319 +1775,4328 @@ subroutine FAST_UnPackParam(Buf, OutData) type(FAST_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackParam' if (Buf%ErrStat /= ErrID_None) return - ! DT call RegUnpack(Buf, OutData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! DT_module call RegUnpack(Buf, OutData%DT_module) if (RegCheckErr(Buf, RoutineName)) return - ! n_substeps call RegUnpack(Buf, OutData%n_substeps) if (RegCheckErr(Buf, RoutineName)) return - ! n_TMax_m1 call RegUnpack(Buf, OutData%n_TMax_m1) if (RegCheckErr(Buf, RoutineName)) return - ! TMax call RegUnpack(Buf, OutData%TMax) if (RegCheckErr(Buf, RoutineName)) return - ! InterpOrder call RegUnpack(Buf, OutData%InterpOrder) if (RegCheckErr(Buf, RoutineName)) return - ! NumCrctn call RegUnpack(Buf, OutData%NumCrctn) if (RegCheckErr(Buf, RoutineName)) return - ! KMax call RegUnpack(Buf, OutData%KMax) if (RegCheckErr(Buf, RoutineName)) return - ! numIceLegs call RegUnpack(Buf, OutData%numIceLegs) if (RegCheckErr(Buf, RoutineName)) return - ! nBeams call RegUnpack(Buf, OutData%nBeams) if (RegCheckErr(Buf, RoutineName)) return - ! BD_OutputSibling call RegUnpack(Buf, OutData%BD_OutputSibling) if (RegCheckErr(Buf, RoutineName)) return - ! ModuleInitialized call RegUnpack(Buf, OutData%ModuleInitialized) if (RegCheckErr(Buf, RoutineName)) return - ! DT_Ujac call RegUnpack(Buf, OutData%DT_Ujac) if (RegCheckErr(Buf, RoutineName)) return - ! UJacSclFact call RegUnpack(Buf, OutData%UJacSclFact) if (RegCheckErr(Buf, RoutineName)) return - ! SizeJac_Opt1 call RegUnpack(Buf, OutData%SizeJac_Opt1) if (RegCheckErr(Buf, RoutineName)) return - ! SolveOption call RegUnpack(Buf, OutData%SolveOption) if (RegCheckErr(Buf, RoutineName)) return - ! CompElast call RegUnpack(Buf, OutData%CompElast) if (RegCheckErr(Buf, RoutineName)) return - ! CompInflow call RegUnpack(Buf, OutData%CompInflow) if (RegCheckErr(Buf, RoutineName)) return - ! CompAero call RegUnpack(Buf, OutData%CompAero) if (RegCheckErr(Buf, RoutineName)) return - ! CompServo call RegUnpack(Buf, OutData%CompServo) if (RegCheckErr(Buf, RoutineName)) return - ! CompSeaSt call RegUnpack(Buf, OutData%CompSeaSt) if (RegCheckErr(Buf, RoutineName)) return - ! CompHydro call RegUnpack(Buf, OutData%CompHydro) if (RegCheckErr(Buf, RoutineName)) return - ! CompSub call RegUnpack(Buf, OutData%CompSub) if (RegCheckErr(Buf, RoutineName)) return - ! CompMooring call RegUnpack(Buf, OutData%CompMooring) if (RegCheckErr(Buf, RoutineName)) return - ! CompIce call RegUnpack(Buf, OutData%CompIce) if (RegCheckErr(Buf, RoutineName)) return - ! MHK call RegUnpack(Buf, OutData%MHK) if (RegCheckErr(Buf, RoutineName)) return - ! UseDWM call RegUnpack(Buf, OutData%UseDWM) if (RegCheckErr(Buf, RoutineName)) return - ! Linearize call RegUnpack(Buf, OutData%Linearize) if (RegCheckErr(Buf, RoutineName)) return - ! WaveFieldMod call RegUnpack(Buf, OutData%WaveFieldMod) if (RegCheckErr(Buf, RoutineName)) return - ! FarmIntegration call RegUnpack(Buf, OutData%FarmIntegration) if (RegCheckErr(Buf, RoutineName)) return - ! TurbinePos call RegUnpack(Buf, OutData%TurbinePos) if (RegCheckErr(Buf, RoutineName)) return - ! Gravity call RegUnpack(Buf, OutData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - ! AirDens call RegUnpack(Buf, OutData%AirDens) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDens call RegUnpack(Buf, OutData%WtrDens) if (RegCheckErr(Buf, RoutineName)) return - ! KinVisc call RegUnpack(Buf, OutData%KinVisc) if (RegCheckErr(Buf, RoutineName)) return - ! SpdSound call RegUnpack(Buf, OutData%SpdSound) if (RegCheckErr(Buf, RoutineName)) return - ! Patm call RegUnpack(Buf, OutData%Patm) if (RegCheckErr(Buf, RoutineName)) return - ! Pvap call RegUnpack(Buf, OutData%Pvap) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDpth call RegUnpack(Buf, OutData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - ! MSL2SWL call RegUnpack(Buf, OutData%MSL2SWL) if (RegCheckErr(Buf, RoutineName)) return - ! EDFile call RegUnpack(Buf, OutData%EDFile) if (RegCheckErr(Buf, RoutineName)) return - ! BDBldFile call RegUnpack(Buf, OutData%BDBldFile) if (RegCheckErr(Buf, RoutineName)) return - ! InflowFile call RegUnpack(Buf, OutData%InflowFile) if (RegCheckErr(Buf, RoutineName)) return - ! AeroFile call RegUnpack(Buf, OutData%AeroFile) if (RegCheckErr(Buf, RoutineName)) return - ! ServoFile call RegUnpack(Buf, OutData%ServoFile) if (RegCheckErr(Buf, RoutineName)) return - ! SeaStFile call RegUnpack(Buf, OutData%SeaStFile) if (RegCheckErr(Buf, RoutineName)) return - ! HydroFile call RegUnpack(Buf, OutData%HydroFile) if (RegCheckErr(Buf, RoutineName)) return - ! SubFile call RegUnpack(Buf, OutData%SubFile) if (RegCheckErr(Buf, RoutineName)) return - ! MooringFile call RegUnpack(Buf, OutData%MooringFile) if (RegCheckErr(Buf, RoutineName)) return - ! IceFile call RegUnpack(Buf, OutData%IceFile) if (RegCheckErr(Buf, RoutineName)) return - ! TStart call RegUnpack(Buf, OutData%TStart) if (RegCheckErr(Buf, RoutineName)) return - ! DT_Out call RegUnpack(Buf, OutData%DT_Out) if (RegCheckErr(Buf, RoutineName)) return - ! WrSttsTime call RegUnpack(Buf, OutData%WrSttsTime) if (RegCheckErr(Buf, RoutineName)) return - ! n_SttsTime call RegUnpack(Buf, OutData%n_SttsTime) if (RegCheckErr(Buf, RoutineName)) return - ! n_ChkptTime call RegUnpack(Buf, OutData%n_ChkptTime) if (RegCheckErr(Buf, RoutineName)) return - ! n_DT_Out call RegUnpack(Buf, OutData%n_DT_Out) if (RegCheckErr(Buf, RoutineName)) return - ! n_VTKTime call RegUnpack(Buf, OutData%n_VTKTime) if (RegCheckErr(Buf, RoutineName)) return - ! TurbineType call RegUnpack(Buf, OutData%TurbineType) if (RegCheckErr(Buf, RoutineName)) return - ! WrBinOutFile call RegUnpack(Buf, OutData%WrBinOutFile) if (RegCheckErr(Buf, RoutineName)) return - ! WrTxtOutFile call RegUnpack(Buf, OutData%WrTxtOutFile) if (RegCheckErr(Buf, RoutineName)) return - ! WrBinMod call RegUnpack(Buf, OutData%WrBinMod) if (RegCheckErr(Buf, RoutineName)) return - ! SumPrint call RegUnpack(Buf, OutData%SumPrint) if (RegCheckErr(Buf, RoutineName)) return - ! WrVTK call RegUnpack(Buf, OutData%WrVTK) if (RegCheckErr(Buf, RoutineName)) return - ! VTK_Type call RegUnpack(Buf, OutData%VTK_Type) if (RegCheckErr(Buf, RoutineName)) return - ! VTK_fields call RegUnpack(Buf, OutData%VTK_fields) if (RegCheckErr(Buf, RoutineName)) return - ! Delim call RegUnpack(Buf, OutData%Delim) if (RegCheckErr(Buf, RoutineName)) return - ! OutFmt call RegUnpack(Buf, OutData%OutFmt) if (RegCheckErr(Buf, RoutineName)) return - ! OutFmt_t call RegUnpack(Buf, OutData%OutFmt_t) if (RegCheckErr(Buf, RoutineName)) return - ! FmtWidth call RegUnpack(Buf, OutData%FmtWidth) if (RegCheckErr(Buf, RoutineName)) return - ! TChanLen call RegUnpack(Buf, OutData%TChanLen) if (RegCheckErr(Buf, RoutineName)) return - ! OutFileRoot call RegUnpack(Buf, OutData%OutFileRoot) if (RegCheckErr(Buf, RoutineName)) return - ! FTitle call RegUnpack(Buf, OutData%FTitle) if (RegCheckErr(Buf, RoutineName)) return - ! VTK_OutFileRoot call RegUnpack(Buf, OutData%VTK_OutFileRoot) if (RegCheckErr(Buf, RoutineName)) return - ! VTK_tWidth call RegUnpack(Buf, OutData%VTK_tWidth) if (RegCheckErr(Buf, RoutineName)) return - ! VTK_fps call RegUnpack(Buf, OutData%VTK_fps) if (RegCheckErr(Buf, RoutineName)) return - ! VTK_surface call FAST_UnpackVTK_SurfaceType(Buf, OutData%VTK_surface) ! VTK_surface - ! Tdesc call RegUnpack(Buf, OutData%Tdesc) if (RegCheckErr(Buf, RoutineName)) return - ! CalcSteady call RegUnpack(Buf, OutData%CalcSteady) if (RegCheckErr(Buf, RoutineName)) return - ! TrimCase call RegUnpack(Buf, OutData%TrimCase) if (RegCheckErr(Buf, RoutineName)) return - ! TrimTol call RegUnpack(Buf, OutData%TrimTol) if (RegCheckErr(Buf, RoutineName)) return - ! TrimGain call RegUnpack(Buf, OutData%TrimGain) if (RegCheckErr(Buf, RoutineName)) return - ! Twr_Kdmp call RegUnpack(Buf, OutData%Twr_Kdmp) if (RegCheckErr(Buf, RoutineName)) return - ! Bld_Kdmp call RegUnpack(Buf, OutData%Bld_Kdmp) if (RegCheckErr(Buf, RoutineName)) return - ! NLinTimes call RegUnpack(Buf, OutData%NLinTimes) if (RegCheckErr(Buf, RoutineName)) return - ! AzimDelta call RegUnpack(Buf, OutData%AzimDelta) if (RegCheckErr(Buf, RoutineName)) return - ! LinInputs call RegUnpack(Buf, OutData%LinInputs) if (RegCheckErr(Buf, RoutineName)) return - ! LinOutputs call RegUnpack(Buf, OutData%LinOutputs) if (RegCheckErr(Buf, RoutineName)) return - ! LinOutJac call RegUnpack(Buf, OutData%LinOutJac) if (RegCheckErr(Buf, RoutineName)) return - ! LinOutMod call RegUnpack(Buf, OutData%LinOutMod) if (RegCheckErr(Buf, RoutineName)) return - ! VTK_modes call FAST_UnpackVTK_ModeShapeType(Buf, OutData%VTK_modes) ! VTK_modes - ! UseSC call RegUnpack(Buf, OutData%UseSC) if (RegCheckErr(Buf, RoutineName)) return - ! Lin_NumMods call RegUnpack(Buf, OutData%Lin_NumMods) if (RegCheckErr(Buf, RoutineName)) return - ! Lin_ModOrder call RegUnpack(Buf, OutData%Lin_ModOrder) if (RegCheckErr(Buf, RoutineName)) return - ! LinInterpOrder call RegUnpack(Buf, OutData%LinInterpOrder) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE FAST_CopyLinStateSave( SrcLinStateSaveData, DstLinStateSaveData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_LinStateSave), INTENT(INOUT) :: SrcLinStateSaveData - TYPE(FAST_LinStateSave), INTENT(INOUT) :: DstLinStateSaveData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyLinStateSave' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcLinStateSaveData%x_IceD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%x_IceD,1) - i1_u = UBOUND(SrcLinStateSaveData%x_IceD,1) - i2_l = LBOUND(SrcLinStateSaveData%x_IceD,2) - i2_u = UBOUND(SrcLinStateSaveData%x_IceD,2) - IF (.NOT. ALLOCATED(DstLinStateSaveData%x_IceD)) THEN - ALLOCATE(DstLinStateSaveData%x_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_IceD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcLinStateSaveData%x_IceD,2), UBOUND(SrcLinStateSaveData%x_IceD,2) - DO i1 = LBOUND(SrcLinStateSaveData%x_IceD,1), UBOUND(SrcLinStateSaveData%x_IceD,1) - CALL IceD_CopyContState( SrcLinStateSaveData%x_IceD(i1,i2), DstLinStateSaveData%x_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%xd_IceD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%xd_IceD,1) - i1_u = UBOUND(SrcLinStateSaveData%xd_IceD,1) - i2_l = LBOUND(SrcLinStateSaveData%xd_IceD,2) - i2_u = UBOUND(SrcLinStateSaveData%xd_IceD,2) - IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_IceD)) THEN - ALLOCATE(DstLinStateSaveData%xd_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_IceD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcLinStateSaveData%xd_IceD,2), UBOUND(SrcLinStateSaveData%xd_IceD,2) - DO i1 = LBOUND(SrcLinStateSaveData%xd_IceD,1), UBOUND(SrcLinStateSaveData%xd_IceD,1) - CALL IceD_CopyDiscState( SrcLinStateSaveData%xd_IceD(i1,i2), DstLinStateSaveData%xd_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%z_IceD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%z_IceD,1) - i1_u = UBOUND(SrcLinStateSaveData%z_IceD,1) - i2_l = LBOUND(SrcLinStateSaveData%z_IceD,2) - i2_u = UBOUND(SrcLinStateSaveData%z_IceD,2) - IF (.NOT. ALLOCATED(DstLinStateSaveData%z_IceD)) THEN - ALLOCATE(DstLinStateSaveData%z_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_IceD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcLinStateSaveData%z_IceD,2), UBOUND(SrcLinStateSaveData%z_IceD,2) - DO i1 = LBOUND(SrcLinStateSaveData%z_IceD,1), UBOUND(SrcLinStateSaveData%z_IceD,1) - CALL IceD_CopyConstrState( SrcLinStateSaveData%z_IceD(i1,i2), DstLinStateSaveData%z_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%OtherSt_IceD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%OtherSt_IceD,1) - i1_u = UBOUND(SrcLinStateSaveData%OtherSt_IceD,1) - i2_l = LBOUND(SrcLinStateSaveData%OtherSt_IceD,2) - i2_u = UBOUND(SrcLinStateSaveData%OtherSt_IceD,2) - IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_IceD)) THEN - ALLOCATE(DstLinStateSaveData%OtherSt_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_IceD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcLinStateSaveData%OtherSt_IceD,2), UBOUND(SrcLinStateSaveData%OtherSt_IceD,2) - DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_IceD,1), UBOUND(SrcLinStateSaveData%OtherSt_IceD,1) - CALL IceD_CopyOtherState( SrcLinStateSaveData%OtherSt_IceD(i1,i2), DstLinStateSaveData%OtherSt_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%u_IceD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%u_IceD,1) - i1_u = UBOUND(SrcLinStateSaveData%u_IceD,1) - i2_l = LBOUND(SrcLinStateSaveData%u_IceD,2) - i2_u = UBOUND(SrcLinStateSaveData%u_IceD,2) - IF (.NOT. ALLOCATED(DstLinStateSaveData%u_IceD)) THEN - ALLOCATE(DstLinStateSaveData%u_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_IceD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcLinStateSaveData%u_IceD,2), UBOUND(SrcLinStateSaveData%u_IceD,2) - DO i1 = LBOUND(SrcLinStateSaveData%u_IceD,1), UBOUND(SrcLinStateSaveData%u_IceD,1) - CALL IceD_CopyInput( SrcLinStateSaveData%u_IceD(i1,i2), DstLinStateSaveData%u_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%x_BD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%x_BD,1) - i1_u = UBOUND(SrcLinStateSaveData%x_BD,1) - i2_l = LBOUND(SrcLinStateSaveData%x_BD,2) - i2_u = UBOUND(SrcLinStateSaveData%x_BD,2) - IF (.NOT. ALLOCATED(DstLinStateSaveData%x_BD)) THEN - ALLOCATE(DstLinStateSaveData%x_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_BD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcLinStateSaveData%x_BD,2), UBOUND(SrcLinStateSaveData%x_BD,2) - DO i1 = LBOUND(SrcLinStateSaveData%x_BD,1), UBOUND(SrcLinStateSaveData%x_BD,1) - CALL BD_CopyContState( SrcLinStateSaveData%x_BD(i1,i2), DstLinStateSaveData%x_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%xd_BD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%xd_BD,1) - i1_u = UBOUND(SrcLinStateSaveData%xd_BD,1) - i2_l = LBOUND(SrcLinStateSaveData%xd_BD,2) - i2_u = UBOUND(SrcLinStateSaveData%xd_BD,2) - IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_BD)) THEN - ALLOCATE(DstLinStateSaveData%xd_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_BD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcLinStateSaveData%xd_BD,2), UBOUND(SrcLinStateSaveData%xd_BD,2) - DO i1 = LBOUND(SrcLinStateSaveData%xd_BD,1), UBOUND(SrcLinStateSaveData%xd_BD,1) - CALL BD_CopyDiscState( SrcLinStateSaveData%xd_BD(i1,i2), DstLinStateSaveData%xd_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%z_BD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%z_BD,1) - i1_u = UBOUND(SrcLinStateSaveData%z_BD,1) - i2_l = LBOUND(SrcLinStateSaveData%z_BD,2) - i2_u = UBOUND(SrcLinStateSaveData%z_BD,2) - IF (.NOT. ALLOCATED(DstLinStateSaveData%z_BD)) THEN - ALLOCATE(DstLinStateSaveData%z_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_BD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcLinStateSaveData%z_BD,2), UBOUND(SrcLinStateSaveData%z_BD,2) - DO i1 = LBOUND(SrcLinStateSaveData%z_BD,1), UBOUND(SrcLinStateSaveData%z_BD,1) - CALL BD_CopyConstrState( SrcLinStateSaveData%z_BD(i1,i2), DstLinStateSaveData%z_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%OtherSt_BD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%OtherSt_BD,1) - i1_u = UBOUND(SrcLinStateSaveData%OtherSt_BD,1) - i2_l = LBOUND(SrcLinStateSaveData%OtherSt_BD,2) - i2_u = UBOUND(SrcLinStateSaveData%OtherSt_BD,2) - IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_BD)) THEN - ALLOCATE(DstLinStateSaveData%OtherSt_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_BD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcLinStateSaveData%OtherSt_BD,2), UBOUND(SrcLinStateSaveData%OtherSt_BD,2) - DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_BD,1), UBOUND(SrcLinStateSaveData%OtherSt_BD,1) - CALL BD_CopyOtherState( SrcLinStateSaveData%OtherSt_BD(i1,i2), DstLinStateSaveData%OtherSt_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%u_BD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%u_BD,1) - i1_u = UBOUND(SrcLinStateSaveData%u_BD,1) - i2_l = LBOUND(SrcLinStateSaveData%u_BD,2) - i2_u = UBOUND(SrcLinStateSaveData%u_BD,2) - IF (.NOT. ALLOCATED(DstLinStateSaveData%u_BD)) THEN - ALLOCATE(DstLinStateSaveData%u_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_BD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcLinStateSaveData%u_BD,2), UBOUND(SrcLinStateSaveData%u_BD,2) - DO i1 = LBOUND(SrcLinStateSaveData%u_BD,1), UBOUND(SrcLinStateSaveData%u_BD,1) - CALL BD_CopyInput( SrcLinStateSaveData%u_BD(i1,i2), DstLinStateSaveData%u_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%x_ED)) THEN - i1_l = LBOUND(SrcLinStateSaveData%x_ED,1) - i1_u = UBOUND(SrcLinStateSaveData%x_ED,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%x_ED)) THEN - ALLOCATE(DstLinStateSaveData%x_ED(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_ED.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%x_ED,1), UBOUND(SrcLinStateSaveData%x_ED,1) - CALL ED_CopyContState( SrcLinStateSaveData%x_ED(i1), DstLinStateSaveData%x_ED(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%xd_ED)) THEN - i1_l = LBOUND(SrcLinStateSaveData%xd_ED,1) - i1_u = UBOUND(SrcLinStateSaveData%xd_ED,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_ED)) THEN - ALLOCATE(DstLinStateSaveData%xd_ED(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_ED.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%xd_ED,1), UBOUND(SrcLinStateSaveData%xd_ED,1) - CALL ED_CopyDiscState( SrcLinStateSaveData%xd_ED(i1), DstLinStateSaveData%xd_ED(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%z_ED)) THEN - i1_l = LBOUND(SrcLinStateSaveData%z_ED,1) - i1_u = UBOUND(SrcLinStateSaveData%z_ED,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%z_ED)) THEN - ALLOCATE(DstLinStateSaveData%z_ED(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_ED.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%z_ED,1), UBOUND(SrcLinStateSaveData%z_ED,1) - CALL ED_CopyConstrState( SrcLinStateSaveData%z_ED(i1), DstLinStateSaveData%z_ED(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%OtherSt_ED)) THEN - i1_l = LBOUND(SrcLinStateSaveData%OtherSt_ED,1) - i1_u = UBOUND(SrcLinStateSaveData%OtherSt_ED,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_ED)) THEN - ALLOCATE(DstLinStateSaveData%OtherSt_ED(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_ED.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_ED,1), UBOUND(SrcLinStateSaveData%OtherSt_ED,1) - CALL ED_CopyOtherState( SrcLinStateSaveData%OtherSt_ED(i1), DstLinStateSaveData%OtherSt_ED(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%u_ED)) THEN - i1_l = LBOUND(SrcLinStateSaveData%u_ED,1) - i1_u = UBOUND(SrcLinStateSaveData%u_ED,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%u_ED)) THEN - ALLOCATE(DstLinStateSaveData%u_ED(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_ED.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%u_ED,1), UBOUND(SrcLinStateSaveData%u_ED,1) - CALL ED_CopyInput( SrcLinStateSaveData%u_ED(i1), DstLinStateSaveData%u_ED(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%x_SrvD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%x_SrvD,1) - i1_u = UBOUND(SrcLinStateSaveData%x_SrvD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%x_SrvD)) THEN - ALLOCATE(DstLinStateSaveData%x_SrvD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_SrvD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%x_SrvD,1), UBOUND(SrcLinStateSaveData%x_SrvD,1) - CALL SrvD_CopyContState( SrcLinStateSaveData%x_SrvD(i1), DstLinStateSaveData%x_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%xd_SrvD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%xd_SrvD,1) - i1_u = UBOUND(SrcLinStateSaveData%xd_SrvD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_SrvD)) THEN - ALLOCATE(DstLinStateSaveData%xd_SrvD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_SrvD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%xd_SrvD,1), UBOUND(SrcLinStateSaveData%xd_SrvD,1) - CALL SrvD_CopyDiscState( SrcLinStateSaveData%xd_SrvD(i1), DstLinStateSaveData%xd_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%z_SrvD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%z_SrvD,1) - i1_u = UBOUND(SrcLinStateSaveData%z_SrvD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%z_SrvD)) THEN - ALLOCATE(DstLinStateSaveData%z_SrvD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_SrvD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%z_SrvD,1), UBOUND(SrcLinStateSaveData%z_SrvD,1) - CALL SrvD_CopyConstrState( SrcLinStateSaveData%z_SrvD(i1), DstLinStateSaveData%z_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%OtherSt_SrvD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%OtherSt_SrvD,1) - i1_u = UBOUND(SrcLinStateSaveData%OtherSt_SrvD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_SrvD)) THEN - ALLOCATE(DstLinStateSaveData%OtherSt_SrvD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_SrvD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_SrvD,1), UBOUND(SrcLinStateSaveData%OtherSt_SrvD,1) - CALL SrvD_CopyOtherState( SrcLinStateSaveData%OtherSt_SrvD(i1), DstLinStateSaveData%OtherSt_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%u_SrvD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%u_SrvD,1) - i1_u = UBOUND(SrcLinStateSaveData%u_SrvD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%u_SrvD)) THEN - ALLOCATE(DstLinStateSaveData%u_SrvD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_SrvD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%u_SrvD,1), UBOUND(SrcLinStateSaveData%u_SrvD,1) - CALL SrvD_CopyInput( SrcLinStateSaveData%u_SrvD(i1), DstLinStateSaveData%u_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%x_AD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%x_AD,1) - i1_u = UBOUND(SrcLinStateSaveData%x_AD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%x_AD)) THEN - ALLOCATE(DstLinStateSaveData%x_AD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_AD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%x_AD,1), UBOUND(SrcLinStateSaveData%x_AD,1) - CALL AD_CopyContState( SrcLinStateSaveData%x_AD(i1), DstLinStateSaveData%x_AD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%xd_AD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%xd_AD,1) - i1_u = UBOUND(SrcLinStateSaveData%xd_AD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_AD)) THEN - ALLOCATE(DstLinStateSaveData%xd_AD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_AD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%xd_AD,1), UBOUND(SrcLinStateSaveData%xd_AD,1) - CALL AD_CopyDiscState( SrcLinStateSaveData%xd_AD(i1), DstLinStateSaveData%xd_AD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%z_AD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%z_AD,1) - i1_u = UBOUND(SrcLinStateSaveData%z_AD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%z_AD)) THEN - ALLOCATE(DstLinStateSaveData%z_AD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_AD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%z_AD,1), UBOUND(SrcLinStateSaveData%z_AD,1) - CALL AD_CopyConstrState( SrcLinStateSaveData%z_AD(i1), DstLinStateSaveData%z_AD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%OtherSt_AD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%OtherSt_AD,1) - i1_u = UBOUND(SrcLinStateSaveData%OtherSt_AD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_AD)) THEN - ALLOCATE(DstLinStateSaveData%OtherSt_AD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_AD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_AD,1), UBOUND(SrcLinStateSaveData%OtherSt_AD,1) - CALL AD_CopyOtherState( SrcLinStateSaveData%OtherSt_AD(i1), DstLinStateSaveData%OtherSt_AD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%u_AD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%u_AD,1) - i1_u = UBOUND(SrcLinStateSaveData%u_AD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%u_AD)) THEN - ALLOCATE(DstLinStateSaveData%u_AD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_AD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%u_AD,1), UBOUND(SrcLinStateSaveData%u_AD,1) - CALL AD_CopyInput( SrcLinStateSaveData%u_AD(i1), DstLinStateSaveData%u_AD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%x_IfW)) THEN - i1_l = LBOUND(SrcLinStateSaveData%x_IfW,1) - i1_u = UBOUND(SrcLinStateSaveData%x_IfW,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%x_IfW)) THEN - ALLOCATE(DstLinStateSaveData%x_IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%x_IfW,1), UBOUND(SrcLinStateSaveData%x_IfW,1) - CALL InflowWind_CopyContState( SrcLinStateSaveData%x_IfW(i1), DstLinStateSaveData%x_IfW(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%xd_IfW)) THEN - i1_l = LBOUND(SrcLinStateSaveData%xd_IfW,1) - i1_u = UBOUND(SrcLinStateSaveData%xd_IfW,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_IfW)) THEN - ALLOCATE(DstLinStateSaveData%xd_IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%xd_IfW,1), UBOUND(SrcLinStateSaveData%xd_IfW,1) - CALL InflowWind_CopyDiscState( SrcLinStateSaveData%xd_IfW(i1), DstLinStateSaveData%xd_IfW(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%z_IfW)) THEN - i1_l = LBOUND(SrcLinStateSaveData%z_IfW,1) - i1_u = UBOUND(SrcLinStateSaveData%z_IfW,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%z_IfW)) THEN - ALLOCATE(DstLinStateSaveData%z_IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%z_IfW,1), UBOUND(SrcLinStateSaveData%z_IfW,1) - CALL InflowWind_CopyConstrState( SrcLinStateSaveData%z_IfW(i1), DstLinStateSaveData%z_IfW(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%OtherSt_IfW)) THEN - i1_l = LBOUND(SrcLinStateSaveData%OtherSt_IfW,1) - i1_u = UBOUND(SrcLinStateSaveData%OtherSt_IfW,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_IfW)) THEN - ALLOCATE(DstLinStateSaveData%OtherSt_IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_IfW,1), UBOUND(SrcLinStateSaveData%OtherSt_IfW,1) - CALL InflowWind_CopyOtherState( SrcLinStateSaveData%OtherSt_IfW(i1), DstLinStateSaveData%OtherSt_IfW(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%u_IfW)) THEN - i1_l = LBOUND(SrcLinStateSaveData%u_IfW,1) - i1_u = UBOUND(SrcLinStateSaveData%u_IfW,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%u_IfW)) THEN - ALLOCATE(DstLinStateSaveData%u_IfW(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_IfW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%u_IfW,1), UBOUND(SrcLinStateSaveData%u_IfW,1) - CALL InflowWind_CopyInput( SrcLinStateSaveData%u_IfW(i1), DstLinStateSaveData%u_IfW(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%x_SD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%x_SD,1) - i1_u = UBOUND(SrcLinStateSaveData%x_SD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%x_SD)) THEN - ALLOCATE(DstLinStateSaveData%x_SD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_SD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%x_SD,1), UBOUND(SrcLinStateSaveData%x_SD,1) - CALL SD_CopyContState( SrcLinStateSaveData%x_SD(i1), DstLinStateSaveData%x_SD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%xd_SD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%xd_SD,1) - i1_u = UBOUND(SrcLinStateSaveData%xd_SD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_SD)) THEN - ALLOCATE(DstLinStateSaveData%xd_SD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_SD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%xd_SD,1), UBOUND(SrcLinStateSaveData%xd_SD,1) - CALL SD_CopyDiscState( SrcLinStateSaveData%xd_SD(i1), DstLinStateSaveData%xd_SD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%z_SD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%z_SD,1) - i1_u = UBOUND(SrcLinStateSaveData%z_SD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%z_SD)) THEN - ALLOCATE(DstLinStateSaveData%z_SD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_SD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%z_SD,1), UBOUND(SrcLinStateSaveData%z_SD,1) - CALL SD_CopyConstrState( SrcLinStateSaveData%z_SD(i1), DstLinStateSaveData%z_SD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%OtherSt_SD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%OtherSt_SD,1) - i1_u = UBOUND(SrcLinStateSaveData%OtherSt_SD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_SD)) THEN - ALLOCATE(DstLinStateSaveData%OtherSt_SD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_SD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_SD,1), UBOUND(SrcLinStateSaveData%OtherSt_SD,1) - CALL SD_CopyOtherState( SrcLinStateSaveData%OtherSt_SD(i1), DstLinStateSaveData%OtherSt_SD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%u_SD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%u_SD,1) - i1_u = UBOUND(SrcLinStateSaveData%u_SD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%u_SD)) THEN - ALLOCATE(DstLinStateSaveData%u_SD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_SD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%u_SD,1), UBOUND(SrcLinStateSaveData%u_SD,1) - CALL SD_CopyInput( SrcLinStateSaveData%u_SD(i1), DstLinStateSaveData%u_SD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%x_ExtPtfm)) THEN - i1_l = LBOUND(SrcLinStateSaveData%x_ExtPtfm,1) - i1_u = UBOUND(SrcLinStateSaveData%x_ExtPtfm,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%x_ExtPtfm)) THEN - ALLOCATE(DstLinStateSaveData%x_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_ExtPtfm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%x_ExtPtfm,1), UBOUND(SrcLinStateSaveData%x_ExtPtfm,1) - CALL ExtPtfm_CopyContState( SrcLinStateSaveData%x_ExtPtfm(i1), DstLinStateSaveData%x_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%xd_ExtPtfm)) THEN - i1_l = LBOUND(SrcLinStateSaveData%xd_ExtPtfm,1) - i1_u = UBOUND(SrcLinStateSaveData%xd_ExtPtfm,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_ExtPtfm)) THEN - ALLOCATE(DstLinStateSaveData%xd_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_ExtPtfm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%xd_ExtPtfm,1), UBOUND(SrcLinStateSaveData%xd_ExtPtfm,1) - CALL ExtPtfm_CopyDiscState( SrcLinStateSaveData%xd_ExtPtfm(i1), DstLinStateSaveData%xd_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%z_ExtPtfm)) THEN - i1_l = LBOUND(SrcLinStateSaveData%z_ExtPtfm,1) - i1_u = UBOUND(SrcLinStateSaveData%z_ExtPtfm,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%z_ExtPtfm)) THEN - ALLOCATE(DstLinStateSaveData%z_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_ExtPtfm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%z_ExtPtfm,1), UBOUND(SrcLinStateSaveData%z_ExtPtfm,1) - CALL ExtPtfm_CopyConstrState( SrcLinStateSaveData%z_ExtPtfm(i1), DstLinStateSaveData%z_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%OtherSt_ExtPtfm)) THEN - i1_l = LBOUND(SrcLinStateSaveData%OtherSt_ExtPtfm,1) - i1_u = UBOUND(SrcLinStateSaveData%OtherSt_ExtPtfm,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_ExtPtfm)) THEN - ALLOCATE(DstLinStateSaveData%OtherSt_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_ExtPtfm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_ExtPtfm,1), UBOUND(SrcLinStateSaveData%OtherSt_ExtPtfm,1) - CALL ExtPtfm_CopyOtherState( SrcLinStateSaveData%OtherSt_ExtPtfm(i1), DstLinStateSaveData%OtherSt_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%u_ExtPtfm)) THEN - i1_l = LBOUND(SrcLinStateSaveData%u_ExtPtfm,1) - i1_u = UBOUND(SrcLinStateSaveData%u_ExtPtfm,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%u_ExtPtfm)) THEN - ALLOCATE(DstLinStateSaveData%u_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_ExtPtfm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%u_ExtPtfm,1), UBOUND(SrcLinStateSaveData%u_ExtPtfm,1) - CALL ExtPtfm_CopyInput( SrcLinStateSaveData%u_ExtPtfm(i1), DstLinStateSaveData%u_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%x_HD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%x_HD,1) - i1_u = UBOUND(SrcLinStateSaveData%x_HD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%x_HD)) THEN - ALLOCATE(DstLinStateSaveData%x_HD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_HD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%x_HD,1), UBOUND(SrcLinStateSaveData%x_HD,1) - CALL HydroDyn_CopyContState( SrcLinStateSaveData%x_HD(i1), DstLinStateSaveData%x_HD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%xd_HD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%xd_HD,1) - i1_u = UBOUND(SrcLinStateSaveData%xd_HD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_HD)) THEN - ALLOCATE(DstLinStateSaveData%xd_HD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_HD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%xd_HD,1), UBOUND(SrcLinStateSaveData%xd_HD,1) - CALL HydroDyn_CopyDiscState( SrcLinStateSaveData%xd_HD(i1), DstLinStateSaveData%xd_HD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%z_HD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%z_HD,1) - i1_u = UBOUND(SrcLinStateSaveData%z_HD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%z_HD)) THEN - ALLOCATE(DstLinStateSaveData%z_HD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_HD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%z_HD,1), UBOUND(SrcLinStateSaveData%z_HD,1) - CALL HydroDyn_CopyConstrState( SrcLinStateSaveData%z_HD(i1), DstLinStateSaveData%z_HD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%OtherSt_HD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%OtherSt_HD,1) - i1_u = UBOUND(SrcLinStateSaveData%OtherSt_HD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_HD)) THEN - ALLOCATE(DstLinStateSaveData%OtherSt_HD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_HD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_HD,1), UBOUND(SrcLinStateSaveData%OtherSt_HD,1) - CALL HydroDyn_CopyOtherState( SrcLinStateSaveData%OtherSt_HD(i1), DstLinStateSaveData%OtherSt_HD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%u_HD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%u_HD,1) - i1_u = UBOUND(SrcLinStateSaveData%u_HD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%u_HD)) THEN - ALLOCATE(DstLinStateSaveData%u_HD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_HD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%u_HD,1), UBOUND(SrcLinStateSaveData%u_HD,1) - CALL HydroDyn_CopyInput( SrcLinStateSaveData%u_HD(i1), DstLinStateSaveData%u_HD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%x_IceF)) THEN - i1_l = LBOUND(SrcLinStateSaveData%x_IceF,1) - i1_u = UBOUND(SrcLinStateSaveData%x_IceF,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%x_IceF)) THEN - ALLOCATE(DstLinStateSaveData%x_IceF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_IceF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%x_IceF,1), UBOUND(SrcLinStateSaveData%x_IceF,1) - CALL IceFloe_CopyContState( SrcLinStateSaveData%x_IceF(i1), DstLinStateSaveData%x_IceF(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%xd_IceF)) THEN - i1_l = LBOUND(SrcLinStateSaveData%xd_IceF,1) - i1_u = UBOUND(SrcLinStateSaveData%xd_IceF,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_IceF)) THEN - ALLOCATE(DstLinStateSaveData%xd_IceF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_IceF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%xd_IceF,1), UBOUND(SrcLinStateSaveData%xd_IceF,1) - CALL IceFloe_CopyDiscState( SrcLinStateSaveData%xd_IceF(i1), DstLinStateSaveData%xd_IceF(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%z_IceF)) THEN - i1_l = LBOUND(SrcLinStateSaveData%z_IceF,1) - i1_u = UBOUND(SrcLinStateSaveData%z_IceF,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%z_IceF)) THEN - ALLOCATE(DstLinStateSaveData%z_IceF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_IceF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%z_IceF,1), UBOUND(SrcLinStateSaveData%z_IceF,1) - CALL IceFloe_CopyConstrState( SrcLinStateSaveData%z_IceF(i1), DstLinStateSaveData%z_IceF(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%OtherSt_IceF)) THEN - i1_l = LBOUND(SrcLinStateSaveData%OtherSt_IceF,1) - i1_u = UBOUND(SrcLinStateSaveData%OtherSt_IceF,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_IceF)) THEN - ALLOCATE(DstLinStateSaveData%OtherSt_IceF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_IceF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_IceF,1), UBOUND(SrcLinStateSaveData%OtherSt_IceF,1) - CALL IceFloe_CopyOtherState( SrcLinStateSaveData%OtherSt_IceF(i1), DstLinStateSaveData%OtherSt_IceF(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%u_IceF)) THEN - i1_l = LBOUND(SrcLinStateSaveData%u_IceF,1) - i1_u = UBOUND(SrcLinStateSaveData%u_IceF,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%u_IceF)) THEN - ALLOCATE(DstLinStateSaveData%u_IceF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_IceF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%u_IceF,1), UBOUND(SrcLinStateSaveData%u_IceF,1) - CALL IceFloe_CopyInput( SrcLinStateSaveData%u_IceF(i1), DstLinStateSaveData%u_IceF(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%x_MAP)) THEN - i1_l = LBOUND(SrcLinStateSaveData%x_MAP,1) - i1_u = UBOUND(SrcLinStateSaveData%x_MAP,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%x_MAP)) THEN - ALLOCATE(DstLinStateSaveData%x_MAP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_MAP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%x_MAP,1), UBOUND(SrcLinStateSaveData%x_MAP,1) - CALL MAP_CopyContState( SrcLinStateSaveData%x_MAP(i1), DstLinStateSaveData%x_MAP(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%xd_MAP)) THEN - i1_l = LBOUND(SrcLinStateSaveData%xd_MAP,1) - i1_u = UBOUND(SrcLinStateSaveData%xd_MAP,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_MAP)) THEN - ALLOCATE(DstLinStateSaveData%xd_MAP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_MAP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%xd_MAP,1), UBOUND(SrcLinStateSaveData%xd_MAP,1) - CALL MAP_CopyDiscState( SrcLinStateSaveData%xd_MAP(i1), DstLinStateSaveData%xd_MAP(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%z_MAP)) THEN - i1_l = LBOUND(SrcLinStateSaveData%z_MAP,1) - i1_u = UBOUND(SrcLinStateSaveData%z_MAP,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%z_MAP)) THEN - ALLOCATE(DstLinStateSaveData%z_MAP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_MAP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%z_MAP,1), UBOUND(SrcLinStateSaveData%z_MAP,1) - CALL MAP_CopyConstrState( SrcLinStateSaveData%z_MAP(i1), DstLinStateSaveData%z_MAP(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%u_MAP)) THEN - i1_l = LBOUND(SrcLinStateSaveData%u_MAP,1) - i1_u = UBOUND(SrcLinStateSaveData%u_MAP,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%u_MAP)) THEN - ALLOCATE(DstLinStateSaveData%u_MAP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_MAP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%u_MAP,1), UBOUND(SrcLinStateSaveData%u_MAP,1) - CALL MAP_CopyInput( SrcLinStateSaveData%u_MAP(i1), DstLinStateSaveData%u_MAP(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%x_FEAM)) THEN - i1_l = LBOUND(SrcLinStateSaveData%x_FEAM,1) - i1_u = UBOUND(SrcLinStateSaveData%x_FEAM,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%x_FEAM)) THEN - ALLOCATE(DstLinStateSaveData%x_FEAM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_FEAM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%x_FEAM,1), UBOUND(SrcLinStateSaveData%x_FEAM,1) - CALL FEAM_CopyContState( SrcLinStateSaveData%x_FEAM(i1), DstLinStateSaveData%x_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%xd_FEAM)) THEN - i1_l = LBOUND(SrcLinStateSaveData%xd_FEAM,1) - i1_u = UBOUND(SrcLinStateSaveData%xd_FEAM,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_FEAM)) THEN - ALLOCATE(DstLinStateSaveData%xd_FEAM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_FEAM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%xd_FEAM,1), UBOUND(SrcLinStateSaveData%xd_FEAM,1) - CALL FEAM_CopyDiscState( SrcLinStateSaveData%xd_FEAM(i1), DstLinStateSaveData%xd_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%z_FEAM)) THEN - i1_l = LBOUND(SrcLinStateSaveData%z_FEAM,1) - i1_u = UBOUND(SrcLinStateSaveData%z_FEAM,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%z_FEAM)) THEN - ALLOCATE(DstLinStateSaveData%z_FEAM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_FEAM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%z_FEAM,1), UBOUND(SrcLinStateSaveData%z_FEAM,1) - CALL FEAM_CopyConstrState( SrcLinStateSaveData%z_FEAM(i1), DstLinStateSaveData%z_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%OtherSt_FEAM)) THEN - i1_l = LBOUND(SrcLinStateSaveData%OtherSt_FEAM,1) - i1_u = UBOUND(SrcLinStateSaveData%OtherSt_FEAM,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_FEAM)) THEN - ALLOCATE(DstLinStateSaveData%OtherSt_FEAM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_FEAM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_FEAM,1), UBOUND(SrcLinStateSaveData%OtherSt_FEAM,1) - CALL FEAM_CopyOtherState( SrcLinStateSaveData%OtherSt_FEAM(i1), DstLinStateSaveData%OtherSt_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%u_FEAM)) THEN - i1_l = LBOUND(SrcLinStateSaveData%u_FEAM,1) - i1_u = UBOUND(SrcLinStateSaveData%u_FEAM,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%u_FEAM)) THEN - ALLOCATE(DstLinStateSaveData%u_FEAM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_FEAM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%u_FEAM,1), UBOUND(SrcLinStateSaveData%u_FEAM,1) - CALL FEAM_CopyInput( SrcLinStateSaveData%u_FEAM(i1), DstLinStateSaveData%u_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%x_MD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%x_MD,1) - i1_u = UBOUND(SrcLinStateSaveData%x_MD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%x_MD)) THEN - ALLOCATE(DstLinStateSaveData%x_MD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_MD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%x_MD,1), UBOUND(SrcLinStateSaveData%x_MD,1) - CALL MD_CopyContState( SrcLinStateSaveData%x_MD(i1), DstLinStateSaveData%x_MD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%xd_MD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%xd_MD,1) - i1_u = UBOUND(SrcLinStateSaveData%xd_MD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_MD)) THEN - ALLOCATE(DstLinStateSaveData%xd_MD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_MD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%xd_MD,1), UBOUND(SrcLinStateSaveData%xd_MD,1) - CALL MD_CopyDiscState( SrcLinStateSaveData%xd_MD(i1), DstLinStateSaveData%xd_MD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%z_MD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%z_MD,1) - i1_u = UBOUND(SrcLinStateSaveData%z_MD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%z_MD)) THEN - ALLOCATE(DstLinStateSaveData%z_MD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_MD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%z_MD,1), UBOUND(SrcLinStateSaveData%z_MD,1) - CALL MD_CopyConstrState( SrcLinStateSaveData%z_MD(i1), DstLinStateSaveData%z_MD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%OtherSt_MD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%OtherSt_MD,1) - i1_u = UBOUND(SrcLinStateSaveData%OtherSt_MD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_MD)) THEN - ALLOCATE(DstLinStateSaveData%OtherSt_MD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_MD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_MD,1), UBOUND(SrcLinStateSaveData%OtherSt_MD,1) - CALL MD_CopyOtherState( SrcLinStateSaveData%OtherSt_MD(i1), DstLinStateSaveData%OtherSt_MD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcLinStateSaveData%u_MD)) THEN - i1_l = LBOUND(SrcLinStateSaveData%u_MD,1) - i1_u = UBOUND(SrcLinStateSaveData%u_MD,1) - IF (.NOT. ALLOCATED(DstLinStateSaveData%u_MD)) THEN - ALLOCATE(DstLinStateSaveData%u_MD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_MD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcLinStateSaveData%u_MD,1), UBOUND(SrcLinStateSaveData%u_MD,1) - CALL MD_CopyInput( SrcLinStateSaveData%u_MD(i1), DstLinStateSaveData%u_MD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE FAST_CopyLinStateSave - - SUBROUTINE FAST_DestroyLinStateSave( LinStateSaveData, ErrStat, ErrMsg ) - TYPE(FAST_LinStateSave), INTENT(INOUT) :: LinStateSaveData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyLinStateSave' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(LinStateSaveData%x_IceD)) THEN -DO i2 = LBOUND(LinStateSaveData%x_IceD,2), UBOUND(LinStateSaveData%x_IceD,2) -DO i1 = LBOUND(LinStateSaveData%x_IceD,1), UBOUND(LinStateSaveData%x_IceD,1) - CALL IceD_DestroyContState( LinStateSaveData%x_IceD(i1,i2), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(LinStateSaveData%x_IceD) -ENDIF -IF (ALLOCATED(LinStateSaveData%xd_IceD)) THEN -DO i2 = LBOUND(LinStateSaveData%xd_IceD,2), UBOUND(LinStateSaveData%xd_IceD,2) -DO i1 = LBOUND(LinStateSaveData%xd_IceD,1), UBOUND(LinStateSaveData%xd_IceD,1) - CALL IceD_DestroyDiscState( LinStateSaveData%xd_IceD(i1,i2), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(LinStateSaveData%xd_IceD) -ENDIF -IF (ALLOCATED(LinStateSaveData%z_IceD)) THEN -DO i2 = LBOUND(LinStateSaveData%z_IceD,2), UBOUND(LinStateSaveData%z_IceD,2) -DO i1 = LBOUND(LinStateSaveData%z_IceD,1), UBOUND(LinStateSaveData%z_IceD,1) - CALL IceD_DestroyConstrState( LinStateSaveData%z_IceD(i1,i2), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(LinStateSaveData%z_IceD) -ENDIF -IF (ALLOCATED(LinStateSaveData%OtherSt_IceD)) THEN -DO i2 = LBOUND(LinStateSaveData%OtherSt_IceD,2), UBOUND(LinStateSaveData%OtherSt_IceD,2) -DO i1 = LBOUND(LinStateSaveData%OtherSt_IceD,1), UBOUND(LinStateSaveData%OtherSt_IceD,1) - CALL IceD_DestroyOtherState( LinStateSaveData%OtherSt_IceD(i1,i2), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(LinStateSaveData%OtherSt_IceD) -ENDIF -IF (ALLOCATED(LinStateSaveData%u_IceD)) THEN -DO i2 = LBOUND(LinStateSaveData%u_IceD,2), UBOUND(LinStateSaveData%u_IceD,2) -DO i1 = LBOUND(LinStateSaveData%u_IceD,1), UBOUND(LinStateSaveData%u_IceD,1) - CALL IceD_DestroyInput( LinStateSaveData%u_IceD(i1,i2), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(LinStateSaveData%u_IceD) -ENDIF -IF (ALLOCATED(LinStateSaveData%x_BD)) THEN -DO i2 = LBOUND(LinStateSaveData%x_BD,2), UBOUND(LinStateSaveData%x_BD,2) -DO i1 = LBOUND(LinStateSaveData%x_BD,1), UBOUND(LinStateSaveData%x_BD,1) - CALL BD_DestroyContState( LinStateSaveData%x_BD(i1,i2), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(LinStateSaveData%x_BD) -ENDIF -IF (ALLOCATED(LinStateSaveData%xd_BD)) THEN -DO i2 = LBOUND(LinStateSaveData%xd_BD,2), UBOUND(LinStateSaveData%xd_BD,2) -DO i1 = LBOUND(LinStateSaveData%xd_BD,1), UBOUND(LinStateSaveData%xd_BD,1) - CALL BD_DestroyDiscState( LinStateSaveData%xd_BD(i1,i2), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(LinStateSaveData%xd_BD) -ENDIF -IF (ALLOCATED(LinStateSaveData%z_BD)) THEN -DO i2 = LBOUND(LinStateSaveData%z_BD,2), UBOUND(LinStateSaveData%z_BD,2) -DO i1 = LBOUND(LinStateSaveData%z_BD,1), UBOUND(LinStateSaveData%z_BD,1) - CALL BD_DestroyConstrState( LinStateSaveData%z_BD(i1,i2), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(LinStateSaveData%z_BD) -ENDIF -IF (ALLOCATED(LinStateSaveData%OtherSt_BD)) THEN -DO i2 = LBOUND(LinStateSaveData%OtherSt_BD,2), UBOUND(LinStateSaveData%OtherSt_BD,2) -DO i1 = LBOUND(LinStateSaveData%OtherSt_BD,1), UBOUND(LinStateSaveData%OtherSt_BD,1) - CALL BD_DestroyOtherState( LinStateSaveData%OtherSt_BD(i1,i2), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(LinStateSaveData%OtherSt_BD) -ENDIF -IF (ALLOCATED(LinStateSaveData%u_BD)) THEN -DO i2 = LBOUND(LinStateSaveData%u_BD,2), UBOUND(LinStateSaveData%u_BD,2) -DO i1 = LBOUND(LinStateSaveData%u_BD,1), UBOUND(LinStateSaveData%u_BD,1) - CALL BD_DestroyInput( LinStateSaveData%u_BD(i1,i2), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(LinStateSaveData%u_BD) -ENDIF -IF (ALLOCATED(LinStateSaveData%x_ED)) THEN -DO i1 = LBOUND(LinStateSaveData%x_ED,1), UBOUND(LinStateSaveData%x_ED,1) - CALL ED_DestroyContState( LinStateSaveData%x_ED(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%x_ED) -ENDIF -IF (ALLOCATED(LinStateSaveData%xd_ED)) THEN -DO i1 = LBOUND(LinStateSaveData%xd_ED,1), UBOUND(LinStateSaveData%xd_ED,1) - CALL ED_DestroyDiscState( LinStateSaveData%xd_ED(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%xd_ED) -ENDIF -IF (ALLOCATED(LinStateSaveData%z_ED)) THEN -DO i1 = LBOUND(LinStateSaveData%z_ED,1), UBOUND(LinStateSaveData%z_ED,1) - CALL ED_DestroyConstrState( LinStateSaveData%z_ED(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%z_ED) -ENDIF -IF (ALLOCATED(LinStateSaveData%OtherSt_ED)) THEN -DO i1 = LBOUND(LinStateSaveData%OtherSt_ED,1), UBOUND(LinStateSaveData%OtherSt_ED,1) - CALL ED_DestroyOtherState( LinStateSaveData%OtherSt_ED(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%OtherSt_ED) -ENDIF -IF (ALLOCATED(LinStateSaveData%u_ED)) THEN -DO i1 = LBOUND(LinStateSaveData%u_ED,1), UBOUND(LinStateSaveData%u_ED,1) - CALL ED_DestroyInput( LinStateSaveData%u_ED(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%u_ED) -ENDIF -IF (ALLOCATED(LinStateSaveData%x_SrvD)) THEN -DO i1 = LBOUND(LinStateSaveData%x_SrvD,1), UBOUND(LinStateSaveData%x_SrvD,1) - CALL SrvD_DestroyContState( LinStateSaveData%x_SrvD(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%x_SrvD) -ENDIF -IF (ALLOCATED(LinStateSaveData%xd_SrvD)) THEN -DO i1 = LBOUND(LinStateSaveData%xd_SrvD,1), UBOUND(LinStateSaveData%xd_SrvD,1) - CALL SrvD_DestroyDiscState( LinStateSaveData%xd_SrvD(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%xd_SrvD) -ENDIF -IF (ALLOCATED(LinStateSaveData%z_SrvD)) THEN -DO i1 = LBOUND(LinStateSaveData%z_SrvD,1), UBOUND(LinStateSaveData%z_SrvD,1) - CALL SrvD_DestroyConstrState( LinStateSaveData%z_SrvD(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%z_SrvD) -ENDIF -IF (ALLOCATED(LinStateSaveData%OtherSt_SrvD)) THEN -DO i1 = LBOUND(LinStateSaveData%OtherSt_SrvD,1), UBOUND(LinStateSaveData%OtherSt_SrvD,1) - CALL SrvD_DestroyOtherState( LinStateSaveData%OtherSt_SrvD(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%OtherSt_SrvD) -ENDIF -IF (ALLOCATED(LinStateSaveData%u_SrvD)) THEN -DO i1 = LBOUND(LinStateSaveData%u_SrvD,1), UBOUND(LinStateSaveData%u_SrvD,1) - CALL SrvD_DestroyInput( LinStateSaveData%u_SrvD(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%u_SrvD) -ENDIF -IF (ALLOCATED(LinStateSaveData%x_AD)) THEN -DO i1 = LBOUND(LinStateSaveData%x_AD,1), UBOUND(LinStateSaveData%x_AD,1) - CALL AD_DestroyContState( LinStateSaveData%x_AD(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%x_AD) -ENDIF -IF (ALLOCATED(LinStateSaveData%xd_AD)) THEN -DO i1 = LBOUND(LinStateSaveData%xd_AD,1), UBOUND(LinStateSaveData%xd_AD,1) - CALL AD_DestroyDiscState( LinStateSaveData%xd_AD(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%xd_AD) -ENDIF -IF (ALLOCATED(LinStateSaveData%z_AD)) THEN -DO i1 = LBOUND(LinStateSaveData%z_AD,1), UBOUND(LinStateSaveData%z_AD,1) - CALL AD_DestroyConstrState( LinStateSaveData%z_AD(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%z_AD) -ENDIF -IF (ALLOCATED(LinStateSaveData%OtherSt_AD)) THEN -DO i1 = LBOUND(LinStateSaveData%OtherSt_AD,1), UBOUND(LinStateSaveData%OtherSt_AD,1) - CALL AD_DestroyOtherState( LinStateSaveData%OtherSt_AD(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%OtherSt_AD) -ENDIF -IF (ALLOCATED(LinStateSaveData%u_AD)) THEN -DO i1 = LBOUND(LinStateSaveData%u_AD,1), UBOUND(LinStateSaveData%u_AD,1) - CALL AD_DestroyInput( LinStateSaveData%u_AD(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%u_AD) -ENDIF -IF (ALLOCATED(LinStateSaveData%x_IfW)) THEN -DO i1 = LBOUND(LinStateSaveData%x_IfW,1), UBOUND(LinStateSaveData%x_IfW,1) - CALL InflowWind_DestroyContState( LinStateSaveData%x_IfW(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%x_IfW) -ENDIF -IF (ALLOCATED(LinStateSaveData%xd_IfW)) THEN -DO i1 = LBOUND(LinStateSaveData%xd_IfW,1), UBOUND(LinStateSaveData%xd_IfW,1) - CALL InflowWind_DestroyDiscState( LinStateSaveData%xd_IfW(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%xd_IfW) -ENDIF -IF (ALLOCATED(LinStateSaveData%z_IfW)) THEN -DO i1 = LBOUND(LinStateSaveData%z_IfW,1), UBOUND(LinStateSaveData%z_IfW,1) - CALL InflowWind_DestroyConstrState( LinStateSaveData%z_IfW(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%z_IfW) -ENDIF -IF (ALLOCATED(LinStateSaveData%OtherSt_IfW)) THEN -DO i1 = LBOUND(LinStateSaveData%OtherSt_IfW,1), UBOUND(LinStateSaveData%OtherSt_IfW,1) - CALL InflowWind_DestroyOtherState( LinStateSaveData%OtherSt_IfW(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%OtherSt_IfW) -ENDIF -IF (ALLOCATED(LinStateSaveData%u_IfW)) THEN -DO i1 = LBOUND(LinStateSaveData%u_IfW,1), UBOUND(LinStateSaveData%u_IfW,1) - CALL InflowWind_DestroyInput( LinStateSaveData%u_IfW(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%u_IfW) -ENDIF -IF (ALLOCATED(LinStateSaveData%x_SD)) THEN -DO i1 = LBOUND(LinStateSaveData%x_SD,1), UBOUND(LinStateSaveData%x_SD,1) - CALL SD_DestroyContState( LinStateSaveData%x_SD(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%x_SD) -ENDIF -IF (ALLOCATED(LinStateSaveData%xd_SD)) THEN -DO i1 = LBOUND(LinStateSaveData%xd_SD,1), UBOUND(LinStateSaveData%xd_SD,1) - CALL SD_DestroyDiscState( LinStateSaveData%xd_SD(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%xd_SD) -ENDIF -IF (ALLOCATED(LinStateSaveData%z_SD)) THEN -DO i1 = LBOUND(LinStateSaveData%z_SD,1), UBOUND(LinStateSaveData%z_SD,1) - CALL SD_DestroyConstrState( LinStateSaveData%z_SD(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%z_SD) -ENDIF -IF (ALLOCATED(LinStateSaveData%OtherSt_SD)) THEN -DO i1 = LBOUND(LinStateSaveData%OtherSt_SD,1), UBOUND(LinStateSaveData%OtherSt_SD,1) - CALL SD_DestroyOtherState( LinStateSaveData%OtherSt_SD(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%OtherSt_SD) -ENDIF -IF (ALLOCATED(LinStateSaveData%u_SD)) THEN -DO i1 = LBOUND(LinStateSaveData%u_SD,1), UBOUND(LinStateSaveData%u_SD,1) - CALL SD_DestroyInput( LinStateSaveData%u_SD(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%u_SD) -ENDIF -IF (ALLOCATED(LinStateSaveData%x_ExtPtfm)) THEN -DO i1 = LBOUND(LinStateSaveData%x_ExtPtfm,1), UBOUND(LinStateSaveData%x_ExtPtfm,1) - CALL ExtPtfm_DestroyContState( LinStateSaveData%x_ExtPtfm(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%x_ExtPtfm) -ENDIF -IF (ALLOCATED(LinStateSaveData%xd_ExtPtfm)) THEN -DO i1 = LBOUND(LinStateSaveData%xd_ExtPtfm,1), UBOUND(LinStateSaveData%xd_ExtPtfm,1) - CALL ExtPtfm_DestroyDiscState( LinStateSaveData%xd_ExtPtfm(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%xd_ExtPtfm) -ENDIF -IF (ALLOCATED(LinStateSaveData%z_ExtPtfm)) THEN -DO i1 = LBOUND(LinStateSaveData%z_ExtPtfm,1), UBOUND(LinStateSaveData%z_ExtPtfm,1) - CALL ExtPtfm_DestroyConstrState( LinStateSaveData%z_ExtPtfm(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%z_ExtPtfm) -ENDIF -IF (ALLOCATED(LinStateSaveData%OtherSt_ExtPtfm)) THEN -DO i1 = LBOUND(LinStateSaveData%OtherSt_ExtPtfm,1), UBOUND(LinStateSaveData%OtherSt_ExtPtfm,1) - CALL ExtPtfm_DestroyOtherState( LinStateSaveData%OtherSt_ExtPtfm(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%OtherSt_ExtPtfm) -ENDIF -IF (ALLOCATED(LinStateSaveData%u_ExtPtfm)) THEN -DO i1 = LBOUND(LinStateSaveData%u_ExtPtfm,1), UBOUND(LinStateSaveData%u_ExtPtfm,1) - CALL ExtPtfm_DestroyInput( LinStateSaveData%u_ExtPtfm(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%u_ExtPtfm) -ENDIF -IF (ALLOCATED(LinStateSaveData%x_HD)) THEN -DO i1 = LBOUND(LinStateSaveData%x_HD,1), UBOUND(LinStateSaveData%x_HD,1) - CALL HydroDyn_DestroyContState( LinStateSaveData%x_HD(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%x_HD) -ENDIF -IF (ALLOCATED(LinStateSaveData%xd_HD)) THEN -DO i1 = LBOUND(LinStateSaveData%xd_HD,1), UBOUND(LinStateSaveData%xd_HD,1) - CALL HydroDyn_DestroyDiscState( LinStateSaveData%xd_HD(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%xd_HD) -ENDIF -IF (ALLOCATED(LinStateSaveData%z_HD)) THEN -DO i1 = LBOUND(LinStateSaveData%z_HD,1), UBOUND(LinStateSaveData%z_HD,1) - CALL HydroDyn_DestroyConstrState( LinStateSaveData%z_HD(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%z_HD) -ENDIF -IF (ALLOCATED(LinStateSaveData%OtherSt_HD)) THEN -DO i1 = LBOUND(LinStateSaveData%OtherSt_HD,1), UBOUND(LinStateSaveData%OtherSt_HD,1) - CALL HydroDyn_DestroyOtherState( LinStateSaveData%OtherSt_HD(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%OtherSt_HD) -ENDIF -IF (ALLOCATED(LinStateSaveData%u_HD)) THEN -DO i1 = LBOUND(LinStateSaveData%u_HD,1), UBOUND(LinStateSaveData%u_HD,1) - CALL HydroDyn_DestroyInput( LinStateSaveData%u_HD(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%u_HD) -ENDIF -IF (ALLOCATED(LinStateSaveData%x_IceF)) THEN -DO i1 = LBOUND(LinStateSaveData%x_IceF,1), UBOUND(LinStateSaveData%x_IceF,1) - CALL IceFloe_DestroyContState( LinStateSaveData%x_IceF(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%x_IceF) -ENDIF -IF (ALLOCATED(LinStateSaveData%xd_IceF)) THEN -DO i1 = LBOUND(LinStateSaveData%xd_IceF,1), UBOUND(LinStateSaveData%xd_IceF,1) - CALL IceFloe_DestroyDiscState( LinStateSaveData%xd_IceF(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%xd_IceF) -ENDIF -IF (ALLOCATED(LinStateSaveData%z_IceF)) THEN -DO i1 = LBOUND(LinStateSaveData%z_IceF,1), UBOUND(LinStateSaveData%z_IceF,1) - CALL IceFloe_DestroyConstrState( LinStateSaveData%z_IceF(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%z_IceF) -ENDIF -IF (ALLOCATED(LinStateSaveData%OtherSt_IceF)) THEN -DO i1 = LBOUND(LinStateSaveData%OtherSt_IceF,1), UBOUND(LinStateSaveData%OtherSt_IceF,1) - CALL IceFloe_DestroyOtherState( LinStateSaveData%OtherSt_IceF(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%OtherSt_IceF) -ENDIF -IF (ALLOCATED(LinStateSaveData%u_IceF)) THEN -DO i1 = LBOUND(LinStateSaveData%u_IceF,1), UBOUND(LinStateSaveData%u_IceF,1) - CALL IceFloe_DestroyInput( LinStateSaveData%u_IceF(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%u_IceF) -ENDIF -IF (ALLOCATED(LinStateSaveData%x_MAP)) THEN -DO i1 = LBOUND(LinStateSaveData%x_MAP,1), UBOUND(LinStateSaveData%x_MAP,1) - CALL MAP_DestroyContState( LinStateSaveData%x_MAP(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%x_MAP) -ENDIF -IF (ALLOCATED(LinStateSaveData%xd_MAP)) THEN -DO i1 = LBOUND(LinStateSaveData%xd_MAP,1), UBOUND(LinStateSaveData%xd_MAP,1) - CALL MAP_DestroyDiscState( LinStateSaveData%xd_MAP(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%xd_MAP) -ENDIF -IF (ALLOCATED(LinStateSaveData%z_MAP)) THEN -DO i1 = LBOUND(LinStateSaveData%z_MAP,1), UBOUND(LinStateSaveData%z_MAP,1) - CALL MAP_DestroyConstrState( LinStateSaveData%z_MAP(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%z_MAP) -ENDIF -IF (ALLOCATED(LinStateSaveData%u_MAP)) THEN -DO i1 = LBOUND(LinStateSaveData%u_MAP,1), UBOUND(LinStateSaveData%u_MAP,1) - CALL MAP_DestroyInput( LinStateSaveData%u_MAP(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%u_MAP) -ENDIF -IF (ALLOCATED(LinStateSaveData%x_FEAM)) THEN -DO i1 = LBOUND(LinStateSaveData%x_FEAM,1), UBOUND(LinStateSaveData%x_FEAM,1) - CALL FEAM_DestroyContState( LinStateSaveData%x_FEAM(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%x_FEAM) -ENDIF -IF (ALLOCATED(LinStateSaveData%xd_FEAM)) THEN -DO i1 = LBOUND(LinStateSaveData%xd_FEAM,1), UBOUND(LinStateSaveData%xd_FEAM,1) - CALL FEAM_DestroyDiscState( LinStateSaveData%xd_FEAM(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%xd_FEAM) -ENDIF -IF (ALLOCATED(LinStateSaveData%z_FEAM)) THEN -DO i1 = LBOUND(LinStateSaveData%z_FEAM,1), UBOUND(LinStateSaveData%z_FEAM,1) - CALL FEAM_DestroyConstrState( LinStateSaveData%z_FEAM(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%z_FEAM) -ENDIF -IF (ALLOCATED(LinStateSaveData%OtherSt_FEAM)) THEN -DO i1 = LBOUND(LinStateSaveData%OtherSt_FEAM,1), UBOUND(LinStateSaveData%OtherSt_FEAM,1) - CALL FEAM_DestroyOtherState( LinStateSaveData%OtherSt_FEAM(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%OtherSt_FEAM) -ENDIF -IF (ALLOCATED(LinStateSaveData%u_FEAM)) THEN -DO i1 = LBOUND(LinStateSaveData%u_FEAM,1), UBOUND(LinStateSaveData%u_FEAM,1) - CALL FEAM_DestroyInput( LinStateSaveData%u_FEAM(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%u_FEAM) -ENDIF -IF (ALLOCATED(LinStateSaveData%x_MD)) THEN -DO i1 = LBOUND(LinStateSaveData%x_MD,1), UBOUND(LinStateSaveData%x_MD,1) - CALL MD_DestroyContState( LinStateSaveData%x_MD(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%x_MD) -ENDIF -IF (ALLOCATED(LinStateSaveData%xd_MD)) THEN -DO i1 = LBOUND(LinStateSaveData%xd_MD,1), UBOUND(LinStateSaveData%xd_MD,1) - CALL MD_DestroyDiscState( LinStateSaveData%xd_MD(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%xd_MD) -ENDIF -IF (ALLOCATED(LinStateSaveData%z_MD)) THEN -DO i1 = LBOUND(LinStateSaveData%z_MD,1), UBOUND(LinStateSaveData%z_MD,1) - CALL MD_DestroyConstrState( LinStateSaveData%z_MD(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%z_MD) -ENDIF -IF (ALLOCATED(LinStateSaveData%OtherSt_MD)) THEN -DO i1 = LBOUND(LinStateSaveData%OtherSt_MD,1), UBOUND(LinStateSaveData%OtherSt_MD,1) - CALL MD_DestroyOtherState( LinStateSaveData%OtherSt_MD(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%OtherSt_MD) -ENDIF -IF (ALLOCATED(LinStateSaveData%u_MD)) THEN -DO i1 = LBOUND(LinStateSaveData%u_MD,1), UBOUND(LinStateSaveData%u_MD,1) - CALL MD_DestroyInput( LinStateSaveData%u_MD(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(LinStateSaveData%u_MD) -ENDIF - END SUBROUTINE FAST_DestroyLinStateSave - -subroutine FAST_PackLinStateSave(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf - type(FAST_LinStateSave), intent(in) :: InData - character(*), parameter :: RoutineName = 'FAST_PackLinStateSave' +subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlCode, ErrStat, ErrMsg) + type(FAST_LinStateSave), intent(inout) :: SrcLinStateSaveData + type(FAST_LinStateSave), intent(inout) :: DstLinStateSaveData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) - if (Buf%ErrStat >= AbortErrLev) return - ! x_IceD - call RegPack(Buf, allocated(InData%x_IceD)) - if (allocated(InData%x_IceD)) then - call RegPackBounds(Buf, 2, lbound(InData%x_IceD), ubound(InData%x_IceD)) - LB(1:2) = lbound(InData%x_IceD) - UB(1:2) = ubound(InData%x_IceD) + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyLinStateSave' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcLinStateSaveData%x_IceD)) then + LB(1:2) = lbound(SrcLinStateSaveData%x_IceD) + UB(1:2) = ubound(SrcLinStateSaveData%x_IceD) + if (.not. allocated(DstLinStateSaveData%x_IceD)) then + allocate(DstLinStateSaveData%x_IceD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_IceD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call IceD_PackContState(Buf, InData%x_IceD(i1,i2)) + call IceD_CopyContState(SrcLinStateSaveData%x_IceD(i1,i2), DstLinStateSaveData%x_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do end do + else if (allocated(DstLinStateSaveData%x_IceD)) then + deallocate(DstLinStateSaveData%x_IceD) end if - if (RegCheckErr(Buf, RoutineName)) return - ! xd_IceD - call RegPack(Buf, allocated(InData%xd_IceD)) - if (allocated(InData%xd_IceD)) then - call RegPackBounds(Buf, 2, lbound(InData%xd_IceD), ubound(InData%xd_IceD)) - LB(1:2) = lbound(InData%xd_IceD) - UB(1:2) = ubound(InData%xd_IceD) + if (allocated(SrcLinStateSaveData%xd_IceD)) then + LB(1:2) = lbound(SrcLinStateSaveData%xd_IceD) + UB(1:2) = ubound(SrcLinStateSaveData%xd_IceD) + if (.not. allocated(DstLinStateSaveData%xd_IceD)) then + allocate(DstLinStateSaveData%xd_IceD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_IceD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call IceD_PackDiscState(Buf, InData%xd_IceD(i1,i2)) + call IceD_CopyDiscState(SrcLinStateSaveData%xd_IceD(i1,i2), DstLinStateSaveData%xd_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do end do + else if (allocated(DstLinStateSaveData%xd_IceD)) then + deallocate(DstLinStateSaveData%xd_IceD) end if - if (RegCheckErr(Buf, RoutineName)) return - ! z_IceD - call RegPack(Buf, allocated(InData%z_IceD)) - if (allocated(InData%z_IceD)) then - call RegPackBounds(Buf, 2, lbound(InData%z_IceD), ubound(InData%z_IceD)) - LB(1:2) = lbound(InData%z_IceD) - UB(1:2) = ubound(InData%z_IceD) + if (allocated(SrcLinStateSaveData%z_IceD)) then + LB(1:2) = lbound(SrcLinStateSaveData%z_IceD) + UB(1:2) = ubound(SrcLinStateSaveData%z_IceD) + if (.not. allocated(DstLinStateSaveData%z_IceD)) then + allocate(DstLinStateSaveData%z_IceD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_IceD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call IceD_PackConstrState(Buf, InData%z_IceD(i1,i2)) + call IceD_CopyConstrState(SrcLinStateSaveData%z_IceD(i1,i2), DstLinStateSaveData%z_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do end do + else if (allocated(DstLinStateSaveData%z_IceD)) then + deallocate(DstLinStateSaveData%z_IceD) end if - if (RegCheckErr(Buf, RoutineName)) return - ! OtherSt_IceD - call RegPack(Buf, allocated(InData%OtherSt_IceD)) - if (allocated(InData%OtherSt_IceD)) then - call RegPackBounds(Buf, 2, lbound(InData%OtherSt_IceD), ubound(InData%OtherSt_IceD)) - LB(1:2) = lbound(InData%OtherSt_IceD) - UB(1:2) = ubound(InData%OtherSt_IceD) + if (allocated(SrcLinStateSaveData%OtherSt_IceD)) then + LB(1:2) = lbound(SrcLinStateSaveData%OtherSt_IceD) + UB(1:2) = ubound(SrcLinStateSaveData%OtherSt_IceD) + if (.not. allocated(DstLinStateSaveData%OtherSt_IceD)) then + allocate(DstLinStateSaveData%OtherSt_IceD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_IceD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call IceD_PackOtherState(Buf, InData%OtherSt_IceD(i1,i2)) + call IceD_CopyOtherState(SrcLinStateSaveData%OtherSt_IceD(i1,i2), DstLinStateSaveData%OtherSt_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do end do + else if (allocated(DstLinStateSaveData%OtherSt_IceD)) then + deallocate(DstLinStateSaveData%OtherSt_IceD) end if - if (RegCheckErr(Buf, RoutineName)) return - ! u_IceD - call RegPack(Buf, allocated(InData%u_IceD)) - if (allocated(InData%u_IceD)) then - call RegPackBounds(Buf, 2, lbound(InData%u_IceD), ubound(InData%u_IceD)) - LB(1:2) = lbound(InData%u_IceD) - UB(1:2) = ubound(InData%u_IceD) + if (allocated(SrcLinStateSaveData%u_IceD)) then + LB(1:2) = lbound(SrcLinStateSaveData%u_IceD) + UB(1:2) = ubound(SrcLinStateSaveData%u_IceD) + if (.not. allocated(DstLinStateSaveData%u_IceD)) then + allocate(DstLinStateSaveData%u_IceD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_IceD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call IceD_PackInput(Buf, InData%u_IceD(i1,i2)) + call IceD_CopyInput(SrcLinStateSaveData%u_IceD(i1,i2), DstLinStateSaveData%u_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do end do + else if (allocated(DstLinStateSaveData%u_IceD)) then + deallocate(DstLinStateSaveData%u_IceD) end if - if (RegCheckErr(Buf, RoutineName)) return - ! x_BD - call RegPack(Buf, allocated(InData%x_BD)) - if (allocated(InData%x_BD)) then - call RegPackBounds(Buf, 2, lbound(InData%x_BD), ubound(InData%x_BD)) - LB(1:2) = lbound(InData%x_BD) - UB(1:2) = ubound(InData%x_BD) + if (allocated(SrcLinStateSaveData%x_BD)) then + LB(1:2) = lbound(SrcLinStateSaveData%x_BD) + UB(1:2) = ubound(SrcLinStateSaveData%x_BD) + if (.not. allocated(DstLinStateSaveData%x_BD)) then + allocate(DstLinStateSaveData%x_BD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_BD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call BD_PackContState(Buf, InData%x_BD(i1,i2)) + call BD_CopyContState(SrcLinStateSaveData%x_BD(i1,i2), DstLinStateSaveData%x_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do end do + else if (allocated(DstLinStateSaveData%x_BD)) then + deallocate(DstLinStateSaveData%x_BD) end if - if (RegCheckErr(Buf, RoutineName)) return - ! xd_BD - call RegPack(Buf, allocated(InData%xd_BD)) - if (allocated(InData%xd_BD)) then - call RegPackBounds(Buf, 2, lbound(InData%xd_BD), ubound(InData%xd_BD)) - LB(1:2) = lbound(InData%xd_BD) - UB(1:2) = ubound(InData%xd_BD) + if (allocated(SrcLinStateSaveData%xd_BD)) then + LB(1:2) = lbound(SrcLinStateSaveData%xd_BD) + UB(1:2) = ubound(SrcLinStateSaveData%xd_BD) + if (.not. allocated(DstLinStateSaveData%xd_BD)) then + allocate(DstLinStateSaveData%xd_BD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_BD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call BD_PackDiscState(Buf, InData%xd_BD(i1,i2)) + call BD_CopyDiscState(SrcLinStateSaveData%xd_BD(i1,i2), DstLinStateSaveData%xd_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do end do + else if (allocated(DstLinStateSaveData%xd_BD)) then + deallocate(DstLinStateSaveData%xd_BD) end if - if (RegCheckErr(Buf, RoutineName)) return - ! z_BD - call RegPack(Buf, allocated(InData%z_BD)) - if (allocated(InData%z_BD)) then - call RegPackBounds(Buf, 2, lbound(InData%z_BD), ubound(InData%z_BD)) - LB(1:2) = lbound(InData%z_BD) - UB(1:2) = ubound(InData%z_BD) + if (allocated(SrcLinStateSaveData%z_BD)) then + LB(1:2) = lbound(SrcLinStateSaveData%z_BD) + UB(1:2) = ubound(SrcLinStateSaveData%z_BD) + if (.not. allocated(DstLinStateSaveData%z_BD)) then + allocate(DstLinStateSaveData%z_BD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_BD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call BD_PackConstrState(Buf, InData%z_BD(i1,i2)) + call BD_CopyConstrState(SrcLinStateSaveData%z_BD(i1,i2), DstLinStateSaveData%z_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do end do + else if (allocated(DstLinStateSaveData%z_BD)) then + deallocate(DstLinStateSaveData%z_BD) end if - if (RegCheckErr(Buf, RoutineName)) return - ! OtherSt_BD - call RegPack(Buf, allocated(InData%OtherSt_BD)) - if (allocated(InData%OtherSt_BD)) then - call RegPackBounds(Buf, 2, lbound(InData%OtherSt_BD), ubound(InData%OtherSt_BD)) - LB(1:2) = lbound(InData%OtherSt_BD) - UB(1:2) = ubound(InData%OtherSt_BD) + if (allocated(SrcLinStateSaveData%OtherSt_BD)) then + LB(1:2) = lbound(SrcLinStateSaveData%OtherSt_BD) + UB(1:2) = ubound(SrcLinStateSaveData%OtherSt_BD) + if (.not. allocated(DstLinStateSaveData%OtherSt_BD)) then + allocate(DstLinStateSaveData%OtherSt_BD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_BD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call BD_PackOtherState(Buf, InData%OtherSt_BD(i1,i2)) + call BD_CopyOtherState(SrcLinStateSaveData%OtherSt_BD(i1,i2), DstLinStateSaveData%OtherSt_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do end do + else if (allocated(DstLinStateSaveData%OtherSt_BD)) then + deallocate(DstLinStateSaveData%OtherSt_BD) end if - if (RegCheckErr(Buf, RoutineName)) return - ! u_BD - call RegPack(Buf, allocated(InData%u_BD)) - if (allocated(InData%u_BD)) then - call RegPackBounds(Buf, 2, lbound(InData%u_BD), ubound(InData%u_BD)) - LB(1:2) = lbound(InData%u_BD) - UB(1:2) = ubound(InData%u_BD) + if (allocated(SrcLinStateSaveData%u_BD)) then + LB(1:2) = lbound(SrcLinStateSaveData%u_BD) + UB(1:2) = ubound(SrcLinStateSaveData%u_BD) + if (.not. allocated(DstLinStateSaveData%u_BD)) then + allocate(DstLinStateSaveData%u_BD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_BD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call BD_PackInput(Buf, InData%u_BD(i1,i2)) + call BD_CopyInput(SrcLinStateSaveData%u_BD(i1,i2), DstLinStateSaveData%u_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do end do + else if (allocated(DstLinStateSaveData%u_BD)) then + deallocate(DstLinStateSaveData%u_BD) end if - if (RegCheckErr(Buf, RoutineName)) return - ! x_ED - call RegPack(Buf, allocated(InData%x_ED)) - if (allocated(InData%x_ED)) then - call RegPackBounds(Buf, 1, lbound(InData%x_ED), ubound(InData%x_ED)) - LB(1:1) = lbound(InData%x_ED) - UB(1:1) = ubound(InData%x_ED) + if (allocated(SrcLinStateSaveData%x_ED)) then + LB(1:1) = lbound(SrcLinStateSaveData%x_ED) + UB(1:1) = ubound(SrcLinStateSaveData%x_ED) + if (.not. allocated(DstLinStateSaveData%x_ED)) then + allocate(DstLinStateSaveData%x_ED(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_ED.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call ED_PackContState(Buf, InData%x_ED(i1)) + call ED_CopyContState(SrcLinStateSaveData%x_ED(i1), DstLinStateSaveData%x_ED(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%x_ED)) then + deallocate(DstLinStateSaveData%x_ED) end if - if (RegCheckErr(Buf, RoutineName)) return - ! xd_ED - call RegPack(Buf, allocated(InData%xd_ED)) - if (allocated(InData%xd_ED)) then - call RegPackBounds(Buf, 1, lbound(InData%xd_ED), ubound(InData%xd_ED)) - LB(1:1) = lbound(InData%xd_ED) - UB(1:1) = ubound(InData%xd_ED) + if (allocated(SrcLinStateSaveData%xd_ED)) then + LB(1:1) = lbound(SrcLinStateSaveData%xd_ED) + UB(1:1) = ubound(SrcLinStateSaveData%xd_ED) + if (.not. allocated(DstLinStateSaveData%xd_ED)) then + allocate(DstLinStateSaveData%xd_ED(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_ED.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call ED_PackDiscState(Buf, InData%xd_ED(i1)) + call ED_CopyDiscState(SrcLinStateSaveData%xd_ED(i1), DstLinStateSaveData%xd_ED(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%xd_ED)) then + deallocate(DstLinStateSaveData%xd_ED) end if - if (RegCheckErr(Buf, RoutineName)) return - ! z_ED - call RegPack(Buf, allocated(InData%z_ED)) - if (allocated(InData%z_ED)) then - call RegPackBounds(Buf, 1, lbound(InData%z_ED), ubound(InData%z_ED)) - LB(1:1) = lbound(InData%z_ED) - UB(1:1) = ubound(InData%z_ED) + if (allocated(SrcLinStateSaveData%z_ED)) then + LB(1:1) = lbound(SrcLinStateSaveData%z_ED) + UB(1:1) = ubound(SrcLinStateSaveData%z_ED) + if (.not. allocated(DstLinStateSaveData%z_ED)) then + allocate(DstLinStateSaveData%z_ED(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_ED.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call ED_PackConstrState(Buf, InData%z_ED(i1)) + call ED_CopyConstrState(SrcLinStateSaveData%z_ED(i1), DstLinStateSaveData%z_ED(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%z_ED)) then + deallocate(DstLinStateSaveData%z_ED) end if - if (RegCheckErr(Buf, RoutineName)) return - ! OtherSt_ED - call RegPack(Buf, allocated(InData%OtherSt_ED)) - if (allocated(InData%OtherSt_ED)) then - call RegPackBounds(Buf, 1, lbound(InData%OtherSt_ED), ubound(InData%OtherSt_ED)) - LB(1:1) = lbound(InData%OtherSt_ED) - UB(1:1) = ubound(InData%OtherSt_ED) + if (allocated(SrcLinStateSaveData%OtherSt_ED)) then + LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_ED) + UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_ED) + if (.not. allocated(DstLinStateSaveData%OtherSt_ED)) then + allocate(DstLinStateSaveData%OtherSt_ED(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_ED.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call ED_PackOtherState(Buf, InData%OtherSt_ED(i1)) + call ED_CopyOtherState(SrcLinStateSaveData%OtherSt_ED(i1), DstLinStateSaveData%OtherSt_ED(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%OtherSt_ED)) then + deallocate(DstLinStateSaveData%OtherSt_ED) end if - if (RegCheckErr(Buf, RoutineName)) return - ! u_ED - call RegPack(Buf, allocated(InData%u_ED)) - if (allocated(InData%u_ED)) then - call RegPackBounds(Buf, 1, lbound(InData%u_ED), ubound(InData%u_ED)) - LB(1:1) = lbound(InData%u_ED) - UB(1:1) = ubound(InData%u_ED) + if (allocated(SrcLinStateSaveData%u_ED)) then + LB(1:1) = lbound(SrcLinStateSaveData%u_ED) + UB(1:1) = ubound(SrcLinStateSaveData%u_ED) + if (.not. allocated(DstLinStateSaveData%u_ED)) then + allocate(DstLinStateSaveData%u_ED(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_ED.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call ED_PackInput(Buf, InData%u_ED(i1)) + call ED_CopyInput(SrcLinStateSaveData%u_ED(i1), DstLinStateSaveData%u_ED(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%u_ED)) then + deallocate(DstLinStateSaveData%u_ED) end if - if (RegCheckErr(Buf, RoutineName)) return - ! x_SrvD - call RegPack(Buf, allocated(InData%x_SrvD)) - if (allocated(InData%x_SrvD)) then - call RegPackBounds(Buf, 1, lbound(InData%x_SrvD), ubound(InData%x_SrvD)) - LB(1:1) = lbound(InData%x_SrvD) - UB(1:1) = ubound(InData%x_SrvD) + if (allocated(SrcLinStateSaveData%x_SrvD)) then + LB(1:1) = lbound(SrcLinStateSaveData%x_SrvD) + UB(1:1) = ubound(SrcLinStateSaveData%x_SrvD) + if (.not. allocated(DstLinStateSaveData%x_SrvD)) then + allocate(DstLinStateSaveData%x_SrvD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_SrvD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call SrvD_PackContState(Buf, InData%x_SrvD(i1)) + call SrvD_CopyContState(SrcLinStateSaveData%x_SrvD(i1), DstLinStateSaveData%x_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%x_SrvD)) then + deallocate(DstLinStateSaveData%x_SrvD) end if - if (RegCheckErr(Buf, RoutineName)) return - ! xd_SrvD - call RegPack(Buf, allocated(InData%xd_SrvD)) - if (allocated(InData%xd_SrvD)) then - call RegPackBounds(Buf, 1, lbound(InData%xd_SrvD), ubound(InData%xd_SrvD)) - LB(1:1) = lbound(InData%xd_SrvD) - UB(1:1) = ubound(InData%xd_SrvD) + if (allocated(SrcLinStateSaveData%xd_SrvD)) then + LB(1:1) = lbound(SrcLinStateSaveData%xd_SrvD) + UB(1:1) = ubound(SrcLinStateSaveData%xd_SrvD) + if (.not. allocated(DstLinStateSaveData%xd_SrvD)) then + allocate(DstLinStateSaveData%xd_SrvD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_SrvD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call SrvD_PackDiscState(Buf, InData%xd_SrvD(i1)) + call SrvD_CopyDiscState(SrcLinStateSaveData%xd_SrvD(i1), DstLinStateSaveData%xd_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%xd_SrvD)) then + deallocate(DstLinStateSaveData%xd_SrvD) end if - if (RegCheckErr(Buf, RoutineName)) return - ! z_SrvD - call RegPack(Buf, allocated(InData%z_SrvD)) - if (allocated(InData%z_SrvD)) then - call RegPackBounds(Buf, 1, lbound(InData%z_SrvD), ubound(InData%z_SrvD)) - LB(1:1) = lbound(InData%z_SrvD) - UB(1:1) = ubound(InData%z_SrvD) + if (allocated(SrcLinStateSaveData%z_SrvD)) then + LB(1:1) = lbound(SrcLinStateSaveData%z_SrvD) + UB(1:1) = ubound(SrcLinStateSaveData%z_SrvD) + if (.not. allocated(DstLinStateSaveData%z_SrvD)) then + allocate(DstLinStateSaveData%z_SrvD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_SrvD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call SrvD_PackConstrState(Buf, InData%z_SrvD(i1)) + call SrvD_CopyConstrState(SrcLinStateSaveData%z_SrvD(i1), DstLinStateSaveData%z_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%z_SrvD)) then + deallocate(DstLinStateSaveData%z_SrvD) end if - if (RegCheckErr(Buf, RoutineName)) return - ! OtherSt_SrvD - call RegPack(Buf, allocated(InData%OtherSt_SrvD)) - if (allocated(InData%OtherSt_SrvD)) then - call RegPackBounds(Buf, 1, lbound(InData%OtherSt_SrvD), ubound(InData%OtherSt_SrvD)) - LB(1:1) = lbound(InData%OtherSt_SrvD) - UB(1:1) = ubound(InData%OtherSt_SrvD) + if (allocated(SrcLinStateSaveData%OtherSt_SrvD)) then + LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_SrvD) + UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_SrvD) + if (.not. allocated(DstLinStateSaveData%OtherSt_SrvD)) then + allocate(DstLinStateSaveData%OtherSt_SrvD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_SrvD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call SrvD_PackOtherState(Buf, InData%OtherSt_SrvD(i1)) + call SrvD_CopyOtherState(SrcLinStateSaveData%OtherSt_SrvD(i1), DstLinStateSaveData%OtherSt_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%OtherSt_SrvD)) then + deallocate(DstLinStateSaveData%OtherSt_SrvD) end if - if (RegCheckErr(Buf, RoutineName)) return - ! u_SrvD - call RegPack(Buf, allocated(InData%u_SrvD)) - if (allocated(InData%u_SrvD)) then - call RegPackBounds(Buf, 1, lbound(InData%u_SrvD), ubound(InData%u_SrvD)) - LB(1:1) = lbound(InData%u_SrvD) - UB(1:1) = ubound(InData%u_SrvD) + if (allocated(SrcLinStateSaveData%u_SrvD)) then + LB(1:1) = lbound(SrcLinStateSaveData%u_SrvD) + UB(1:1) = ubound(SrcLinStateSaveData%u_SrvD) + if (.not. allocated(DstLinStateSaveData%u_SrvD)) then + allocate(DstLinStateSaveData%u_SrvD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_SrvD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call SrvD_PackInput(Buf, InData%u_SrvD(i1)) + call SrvD_CopyInput(SrcLinStateSaveData%u_SrvD(i1), DstLinStateSaveData%u_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%u_SrvD)) then + deallocate(DstLinStateSaveData%u_SrvD) end if - if (RegCheckErr(Buf, RoutineName)) return - ! x_AD - call RegPack(Buf, allocated(InData%x_AD)) - if (allocated(InData%x_AD)) then - call RegPackBounds(Buf, 1, lbound(InData%x_AD), ubound(InData%x_AD)) - LB(1:1) = lbound(InData%x_AD) - UB(1:1) = ubound(InData%x_AD) + if (allocated(SrcLinStateSaveData%x_AD)) then + LB(1:1) = lbound(SrcLinStateSaveData%x_AD) + UB(1:1) = ubound(SrcLinStateSaveData%x_AD) + if (.not. allocated(DstLinStateSaveData%x_AD)) then + allocate(DstLinStateSaveData%x_AD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_AD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call AD_PackContState(Buf, InData%x_AD(i1)) + call AD_CopyContState(SrcLinStateSaveData%x_AD(i1), DstLinStateSaveData%x_AD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%x_AD)) then + deallocate(DstLinStateSaveData%x_AD) end if - if (RegCheckErr(Buf, RoutineName)) return - ! xd_AD - call RegPack(Buf, allocated(InData%xd_AD)) - if (allocated(InData%xd_AD)) then - call RegPackBounds(Buf, 1, lbound(InData%xd_AD), ubound(InData%xd_AD)) - LB(1:1) = lbound(InData%xd_AD) - UB(1:1) = ubound(InData%xd_AD) + if (allocated(SrcLinStateSaveData%xd_AD)) then + LB(1:1) = lbound(SrcLinStateSaveData%xd_AD) + UB(1:1) = ubound(SrcLinStateSaveData%xd_AD) + if (.not. allocated(DstLinStateSaveData%xd_AD)) then + allocate(DstLinStateSaveData%xd_AD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_AD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call AD_PackDiscState(Buf, InData%xd_AD(i1)) + call AD_CopyDiscState(SrcLinStateSaveData%xd_AD(i1), DstLinStateSaveData%xd_AD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%xd_AD)) then + deallocate(DstLinStateSaveData%xd_AD) end if - if (RegCheckErr(Buf, RoutineName)) return - ! z_AD - call RegPack(Buf, allocated(InData%z_AD)) - if (allocated(InData%z_AD)) then - call RegPackBounds(Buf, 1, lbound(InData%z_AD), ubound(InData%z_AD)) - LB(1:1) = lbound(InData%z_AD) - UB(1:1) = ubound(InData%z_AD) + if (allocated(SrcLinStateSaveData%z_AD)) then + LB(1:1) = lbound(SrcLinStateSaveData%z_AD) + UB(1:1) = ubound(SrcLinStateSaveData%z_AD) + if (.not. allocated(DstLinStateSaveData%z_AD)) then + allocate(DstLinStateSaveData%z_AD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_AD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call AD_PackConstrState(Buf, InData%z_AD(i1)) + call AD_CopyConstrState(SrcLinStateSaveData%z_AD(i1), DstLinStateSaveData%z_AD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%z_AD)) then + deallocate(DstLinStateSaveData%z_AD) end if - if (RegCheckErr(Buf, RoutineName)) return - ! OtherSt_AD - call RegPack(Buf, allocated(InData%OtherSt_AD)) - if (allocated(InData%OtherSt_AD)) then - call RegPackBounds(Buf, 1, lbound(InData%OtherSt_AD), ubound(InData%OtherSt_AD)) - LB(1:1) = lbound(InData%OtherSt_AD) - UB(1:1) = ubound(InData%OtherSt_AD) + if (allocated(SrcLinStateSaveData%OtherSt_AD)) then + LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_AD) + UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_AD) + if (.not. allocated(DstLinStateSaveData%OtherSt_AD)) then + allocate(DstLinStateSaveData%OtherSt_AD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_AD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call AD_PackOtherState(Buf, InData%OtherSt_AD(i1)) + call AD_CopyOtherState(SrcLinStateSaveData%OtherSt_AD(i1), DstLinStateSaveData%OtherSt_AD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%OtherSt_AD)) then + deallocate(DstLinStateSaveData%OtherSt_AD) end if - if (RegCheckErr(Buf, RoutineName)) return - ! u_AD - call RegPack(Buf, allocated(InData%u_AD)) - if (allocated(InData%u_AD)) then - call RegPackBounds(Buf, 1, lbound(InData%u_AD), ubound(InData%u_AD)) - LB(1:1) = lbound(InData%u_AD) - UB(1:1) = ubound(InData%u_AD) + if (allocated(SrcLinStateSaveData%u_AD)) then + LB(1:1) = lbound(SrcLinStateSaveData%u_AD) + UB(1:1) = ubound(SrcLinStateSaveData%u_AD) + if (.not. allocated(DstLinStateSaveData%u_AD)) then + allocate(DstLinStateSaveData%u_AD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_AD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call AD_PackInput(Buf, InData%u_AD(i1)) + call AD_CopyInput(SrcLinStateSaveData%u_AD(i1), DstLinStateSaveData%u_AD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%u_AD)) then + deallocate(DstLinStateSaveData%u_AD) end if - if (RegCheckErr(Buf, RoutineName)) return - ! x_IfW - call RegPack(Buf, allocated(InData%x_IfW)) - if (allocated(InData%x_IfW)) then - call RegPackBounds(Buf, 1, lbound(InData%x_IfW), ubound(InData%x_IfW)) - LB(1:1) = lbound(InData%x_IfW) - UB(1:1) = ubound(InData%x_IfW) + if (allocated(SrcLinStateSaveData%x_IfW)) then + LB(1:1) = lbound(SrcLinStateSaveData%x_IfW) + UB(1:1) = ubound(SrcLinStateSaveData%x_IfW) + if (.not. allocated(DstLinStateSaveData%x_IfW)) then + allocate(DstLinStateSaveData%x_IfW(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_IfW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call InflowWind_PackContState(Buf, InData%x_IfW(i1)) + call InflowWind_CopyContState(SrcLinStateSaveData%x_IfW(i1), DstLinStateSaveData%x_IfW(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%x_IfW)) then + deallocate(DstLinStateSaveData%x_IfW) end if - if (RegCheckErr(Buf, RoutineName)) return - ! xd_IfW - call RegPack(Buf, allocated(InData%xd_IfW)) - if (allocated(InData%xd_IfW)) then - call RegPackBounds(Buf, 1, lbound(InData%xd_IfW), ubound(InData%xd_IfW)) - LB(1:1) = lbound(InData%xd_IfW) - UB(1:1) = ubound(InData%xd_IfW) + if (allocated(SrcLinStateSaveData%xd_IfW)) then + LB(1:1) = lbound(SrcLinStateSaveData%xd_IfW) + UB(1:1) = ubound(SrcLinStateSaveData%xd_IfW) + if (.not. allocated(DstLinStateSaveData%xd_IfW)) then + allocate(DstLinStateSaveData%xd_IfW(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_IfW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call InflowWind_PackDiscState(Buf, InData%xd_IfW(i1)) + call InflowWind_CopyDiscState(SrcLinStateSaveData%xd_IfW(i1), DstLinStateSaveData%xd_IfW(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%xd_IfW)) then + deallocate(DstLinStateSaveData%xd_IfW) end if - if (RegCheckErr(Buf, RoutineName)) return - ! z_IfW - call RegPack(Buf, allocated(InData%z_IfW)) - if (allocated(InData%z_IfW)) then - call RegPackBounds(Buf, 1, lbound(InData%z_IfW), ubound(InData%z_IfW)) - LB(1:1) = lbound(InData%z_IfW) - UB(1:1) = ubound(InData%z_IfW) + if (allocated(SrcLinStateSaveData%z_IfW)) then + LB(1:1) = lbound(SrcLinStateSaveData%z_IfW) + UB(1:1) = ubound(SrcLinStateSaveData%z_IfW) + if (.not. allocated(DstLinStateSaveData%z_IfW)) then + allocate(DstLinStateSaveData%z_IfW(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_IfW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call InflowWind_PackConstrState(Buf, InData%z_IfW(i1)) + call InflowWind_CopyConstrState(SrcLinStateSaveData%z_IfW(i1), DstLinStateSaveData%z_IfW(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%z_IfW)) then + deallocate(DstLinStateSaveData%z_IfW) end if - if (RegCheckErr(Buf, RoutineName)) return - ! OtherSt_IfW - call RegPack(Buf, allocated(InData%OtherSt_IfW)) - if (allocated(InData%OtherSt_IfW)) then - call RegPackBounds(Buf, 1, lbound(InData%OtherSt_IfW), ubound(InData%OtherSt_IfW)) - LB(1:1) = lbound(InData%OtherSt_IfW) - UB(1:1) = ubound(InData%OtherSt_IfW) + if (allocated(SrcLinStateSaveData%OtherSt_IfW)) then + LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_IfW) + UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_IfW) + if (.not. allocated(DstLinStateSaveData%OtherSt_IfW)) then + allocate(DstLinStateSaveData%OtherSt_IfW(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_IfW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call InflowWind_PackOtherState(Buf, InData%OtherSt_IfW(i1)) + call InflowWind_CopyOtherState(SrcLinStateSaveData%OtherSt_IfW(i1), DstLinStateSaveData%OtherSt_IfW(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%OtherSt_IfW)) then + deallocate(DstLinStateSaveData%OtherSt_IfW) end if - if (RegCheckErr(Buf, RoutineName)) return - ! u_IfW - call RegPack(Buf, allocated(InData%u_IfW)) - if (allocated(InData%u_IfW)) then - call RegPackBounds(Buf, 1, lbound(InData%u_IfW), ubound(InData%u_IfW)) - LB(1:1) = lbound(InData%u_IfW) - UB(1:1) = ubound(InData%u_IfW) + if (allocated(SrcLinStateSaveData%u_IfW)) then + LB(1:1) = lbound(SrcLinStateSaveData%u_IfW) + UB(1:1) = ubound(SrcLinStateSaveData%u_IfW) + if (.not. allocated(DstLinStateSaveData%u_IfW)) then + allocate(DstLinStateSaveData%u_IfW(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_IfW.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call InflowWind_PackInput(Buf, InData%u_IfW(i1)) + call InflowWind_CopyInput(SrcLinStateSaveData%u_IfW(i1), DstLinStateSaveData%u_IfW(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%u_IfW)) then + deallocate(DstLinStateSaveData%u_IfW) end if - if (RegCheckErr(Buf, RoutineName)) return - ! x_SD - call RegPack(Buf, allocated(InData%x_SD)) - if (allocated(InData%x_SD)) then - call RegPackBounds(Buf, 1, lbound(InData%x_SD), ubound(InData%x_SD)) - LB(1:1) = lbound(InData%x_SD) - UB(1:1) = ubound(InData%x_SD) + if (allocated(SrcLinStateSaveData%x_SD)) then + LB(1:1) = lbound(SrcLinStateSaveData%x_SD) + UB(1:1) = ubound(SrcLinStateSaveData%x_SD) + if (.not. allocated(DstLinStateSaveData%x_SD)) then + allocate(DstLinStateSaveData%x_SD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_SD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call SD_PackContState(Buf, InData%x_SD(i1)) + call SD_CopyContState(SrcLinStateSaveData%x_SD(i1), DstLinStateSaveData%x_SD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%x_SD)) then + deallocate(DstLinStateSaveData%x_SD) end if - if (RegCheckErr(Buf, RoutineName)) return - ! xd_SD - call RegPack(Buf, allocated(InData%xd_SD)) - if (allocated(InData%xd_SD)) then - call RegPackBounds(Buf, 1, lbound(InData%xd_SD), ubound(InData%xd_SD)) - LB(1:1) = lbound(InData%xd_SD) - UB(1:1) = ubound(InData%xd_SD) + if (allocated(SrcLinStateSaveData%xd_SD)) then + LB(1:1) = lbound(SrcLinStateSaveData%xd_SD) + UB(1:1) = ubound(SrcLinStateSaveData%xd_SD) + if (.not. allocated(DstLinStateSaveData%xd_SD)) then + allocate(DstLinStateSaveData%xd_SD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_SD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call SD_PackDiscState(Buf, InData%xd_SD(i1)) + call SD_CopyDiscState(SrcLinStateSaveData%xd_SD(i1), DstLinStateSaveData%xd_SD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%xd_SD)) then + deallocate(DstLinStateSaveData%xd_SD) end if - if (RegCheckErr(Buf, RoutineName)) return - ! z_SD - call RegPack(Buf, allocated(InData%z_SD)) - if (allocated(InData%z_SD)) then - call RegPackBounds(Buf, 1, lbound(InData%z_SD), ubound(InData%z_SD)) - LB(1:1) = lbound(InData%z_SD) - UB(1:1) = ubound(InData%z_SD) + if (allocated(SrcLinStateSaveData%z_SD)) then + LB(1:1) = lbound(SrcLinStateSaveData%z_SD) + UB(1:1) = ubound(SrcLinStateSaveData%z_SD) + if (.not. allocated(DstLinStateSaveData%z_SD)) then + allocate(DstLinStateSaveData%z_SD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_SD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call SD_PackConstrState(Buf, InData%z_SD(i1)) + call SD_CopyConstrState(SrcLinStateSaveData%z_SD(i1), DstLinStateSaveData%z_SD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%z_SD)) then + deallocate(DstLinStateSaveData%z_SD) end if - if (RegCheckErr(Buf, RoutineName)) return - ! OtherSt_SD - call RegPack(Buf, allocated(InData%OtherSt_SD)) - if (allocated(InData%OtherSt_SD)) then - call RegPackBounds(Buf, 1, lbound(InData%OtherSt_SD), ubound(InData%OtherSt_SD)) - LB(1:1) = lbound(InData%OtherSt_SD) - UB(1:1) = ubound(InData%OtherSt_SD) + if (allocated(SrcLinStateSaveData%OtherSt_SD)) then + LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_SD) + UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_SD) + if (.not. allocated(DstLinStateSaveData%OtherSt_SD)) then + allocate(DstLinStateSaveData%OtherSt_SD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_SD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call SD_PackOtherState(Buf, InData%OtherSt_SD(i1)) + call SD_CopyOtherState(SrcLinStateSaveData%OtherSt_SD(i1), DstLinStateSaveData%OtherSt_SD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%OtherSt_SD)) then + deallocate(DstLinStateSaveData%OtherSt_SD) end if - if (RegCheckErr(Buf, RoutineName)) return - ! u_SD - call RegPack(Buf, allocated(InData%u_SD)) - if (allocated(InData%u_SD)) then - call RegPackBounds(Buf, 1, lbound(InData%u_SD), ubound(InData%u_SD)) - LB(1:1) = lbound(InData%u_SD) - UB(1:1) = ubound(InData%u_SD) + if (allocated(SrcLinStateSaveData%u_SD)) then + LB(1:1) = lbound(SrcLinStateSaveData%u_SD) + UB(1:1) = ubound(SrcLinStateSaveData%u_SD) + if (.not. allocated(DstLinStateSaveData%u_SD)) then + allocate(DstLinStateSaveData%u_SD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_SD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call SD_PackInput(Buf, InData%u_SD(i1)) + call SD_CopyInput(SrcLinStateSaveData%u_SD(i1), DstLinStateSaveData%u_SD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%u_SD)) then + deallocate(DstLinStateSaveData%u_SD) end if - if (RegCheckErr(Buf, RoutineName)) return - ! x_ExtPtfm - call RegPack(Buf, allocated(InData%x_ExtPtfm)) - if (allocated(InData%x_ExtPtfm)) then - call RegPackBounds(Buf, 1, lbound(InData%x_ExtPtfm), ubound(InData%x_ExtPtfm)) - LB(1:1) = lbound(InData%x_ExtPtfm) - UB(1:1) = ubound(InData%x_ExtPtfm) + if (allocated(SrcLinStateSaveData%x_ExtPtfm)) then + LB(1:1) = lbound(SrcLinStateSaveData%x_ExtPtfm) + UB(1:1) = ubound(SrcLinStateSaveData%x_ExtPtfm) + if (.not. allocated(DstLinStateSaveData%x_ExtPtfm)) then + allocate(DstLinStateSaveData%x_ExtPtfm(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_ExtPtfm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call ExtPtfm_PackContState(Buf, InData%x_ExtPtfm(i1)) + call ExtPtfm_CopyContState(SrcLinStateSaveData%x_ExtPtfm(i1), DstLinStateSaveData%x_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%x_ExtPtfm)) then + deallocate(DstLinStateSaveData%x_ExtPtfm) end if - if (RegCheckErr(Buf, RoutineName)) return - ! xd_ExtPtfm - call RegPack(Buf, allocated(InData%xd_ExtPtfm)) - if (allocated(InData%xd_ExtPtfm)) then - call RegPackBounds(Buf, 1, lbound(InData%xd_ExtPtfm), ubound(InData%xd_ExtPtfm)) - LB(1:1) = lbound(InData%xd_ExtPtfm) - UB(1:1) = ubound(InData%xd_ExtPtfm) + if (allocated(SrcLinStateSaveData%xd_ExtPtfm)) then + LB(1:1) = lbound(SrcLinStateSaveData%xd_ExtPtfm) + UB(1:1) = ubound(SrcLinStateSaveData%xd_ExtPtfm) + if (.not. allocated(DstLinStateSaveData%xd_ExtPtfm)) then + allocate(DstLinStateSaveData%xd_ExtPtfm(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_ExtPtfm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call ExtPtfm_PackDiscState(Buf, InData%xd_ExtPtfm(i1)) + call ExtPtfm_CopyDiscState(SrcLinStateSaveData%xd_ExtPtfm(i1), DstLinStateSaveData%xd_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%xd_ExtPtfm)) then + deallocate(DstLinStateSaveData%xd_ExtPtfm) end if - if (RegCheckErr(Buf, RoutineName)) return - ! z_ExtPtfm - call RegPack(Buf, allocated(InData%z_ExtPtfm)) - if (allocated(InData%z_ExtPtfm)) then - call RegPackBounds(Buf, 1, lbound(InData%z_ExtPtfm), ubound(InData%z_ExtPtfm)) - LB(1:1) = lbound(InData%z_ExtPtfm) - UB(1:1) = ubound(InData%z_ExtPtfm) + if (allocated(SrcLinStateSaveData%z_ExtPtfm)) then + LB(1:1) = lbound(SrcLinStateSaveData%z_ExtPtfm) + UB(1:1) = ubound(SrcLinStateSaveData%z_ExtPtfm) + if (.not. allocated(DstLinStateSaveData%z_ExtPtfm)) then + allocate(DstLinStateSaveData%z_ExtPtfm(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_ExtPtfm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call ExtPtfm_PackConstrState(Buf, InData%z_ExtPtfm(i1)) + call ExtPtfm_CopyConstrState(SrcLinStateSaveData%z_ExtPtfm(i1), DstLinStateSaveData%z_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%z_ExtPtfm)) then + deallocate(DstLinStateSaveData%z_ExtPtfm) end if - if (RegCheckErr(Buf, RoutineName)) return - ! OtherSt_ExtPtfm - call RegPack(Buf, allocated(InData%OtherSt_ExtPtfm)) - if (allocated(InData%OtherSt_ExtPtfm)) then - call RegPackBounds(Buf, 1, lbound(InData%OtherSt_ExtPtfm), ubound(InData%OtherSt_ExtPtfm)) - LB(1:1) = lbound(InData%OtherSt_ExtPtfm) - UB(1:1) = ubound(InData%OtherSt_ExtPtfm) + if (allocated(SrcLinStateSaveData%OtherSt_ExtPtfm)) then + LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_ExtPtfm) + UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_ExtPtfm) + if (.not. allocated(DstLinStateSaveData%OtherSt_ExtPtfm)) then + allocate(DstLinStateSaveData%OtherSt_ExtPtfm(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_ExtPtfm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call ExtPtfm_PackOtherState(Buf, InData%OtherSt_ExtPtfm(i1)) + call ExtPtfm_CopyOtherState(SrcLinStateSaveData%OtherSt_ExtPtfm(i1), DstLinStateSaveData%OtherSt_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%OtherSt_ExtPtfm)) then + deallocate(DstLinStateSaveData%OtherSt_ExtPtfm) end if - if (RegCheckErr(Buf, RoutineName)) return - ! u_ExtPtfm - call RegPack(Buf, allocated(InData%u_ExtPtfm)) - if (allocated(InData%u_ExtPtfm)) then - call RegPackBounds(Buf, 1, lbound(InData%u_ExtPtfm), ubound(InData%u_ExtPtfm)) - LB(1:1) = lbound(InData%u_ExtPtfm) - UB(1:1) = ubound(InData%u_ExtPtfm) + if (allocated(SrcLinStateSaveData%u_ExtPtfm)) then + LB(1:1) = lbound(SrcLinStateSaveData%u_ExtPtfm) + UB(1:1) = ubound(SrcLinStateSaveData%u_ExtPtfm) + if (.not. allocated(DstLinStateSaveData%u_ExtPtfm)) then + allocate(DstLinStateSaveData%u_ExtPtfm(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_ExtPtfm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call ExtPtfm_PackInput(Buf, InData%u_ExtPtfm(i1)) + call ExtPtfm_CopyInput(SrcLinStateSaveData%u_ExtPtfm(i1), DstLinStateSaveData%u_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%u_ExtPtfm)) then + deallocate(DstLinStateSaveData%u_ExtPtfm) end if - if (RegCheckErr(Buf, RoutineName)) return - ! x_HD - call RegPack(Buf, allocated(InData%x_HD)) - if (allocated(InData%x_HD)) then - call RegPackBounds(Buf, 1, lbound(InData%x_HD), ubound(InData%x_HD)) - LB(1:1) = lbound(InData%x_HD) - UB(1:1) = ubound(InData%x_HD) + if (allocated(SrcLinStateSaveData%x_HD)) then + LB(1:1) = lbound(SrcLinStateSaveData%x_HD) + UB(1:1) = ubound(SrcLinStateSaveData%x_HD) + if (.not. allocated(DstLinStateSaveData%x_HD)) then + allocate(DstLinStateSaveData%x_HD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_HD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call HydroDyn_PackContState(Buf, InData%x_HD(i1)) + call HydroDyn_CopyContState(SrcLinStateSaveData%x_HD(i1), DstLinStateSaveData%x_HD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%x_HD)) then + deallocate(DstLinStateSaveData%x_HD) end if - if (RegCheckErr(Buf, RoutineName)) return - ! xd_HD - call RegPack(Buf, allocated(InData%xd_HD)) - if (allocated(InData%xd_HD)) then - call RegPackBounds(Buf, 1, lbound(InData%xd_HD), ubound(InData%xd_HD)) - LB(1:1) = lbound(InData%xd_HD) - UB(1:1) = ubound(InData%xd_HD) + if (allocated(SrcLinStateSaveData%xd_HD)) then + LB(1:1) = lbound(SrcLinStateSaveData%xd_HD) + UB(1:1) = ubound(SrcLinStateSaveData%xd_HD) + if (.not. allocated(DstLinStateSaveData%xd_HD)) then + allocate(DstLinStateSaveData%xd_HD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_HD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call HydroDyn_PackDiscState(Buf, InData%xd_HD(i1)) + call HydroDyn_CopyDiscState(SrcLinStateSaveData%xd_HD(i1), DstLinStateSaveData%xd_HD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%xd_HD)) then + deallocate(DstLinStateSaveData%xd_HD) end if - if (RegCheckErr(Buf, RoutineName)) return - ! z_HD - call RegPack(Buf, allocated(InData%z_HD)) - if (allocated(InData%z_HD)) then - call RegPackBounds(Buf, 1, lbound(InData%z_HD), ubound(InData%z_HD)) - LB(1:1) = lbound(InData%z_HD) - UB(1:1) = ubound(InData%z_HD) + if (allocated(SrcLinStateSaveData%z_HD)) then + LB(1:1) = lbound(SrcLinStateSaveData%z_HD) + UB(1:1) = ubound(SrcLinStateSaveData%z_HD) + if (.not. allocated(DstLinStateSaveData%z_HD)) then + allocate(DstLinStateSaveData%z_HD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_HD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call HydroDyn_PackConstrState(Buf, InData%z_HD(i1)) + call HydroDyn_CopyConstrState(SrcLinStateSaveData%z_HD(i1), DstLinStateSaveData%z_HD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%z_HD)) then + deallocate(DstLinStateSaveData%z_HD) end if - if (RegCheckErr(Buf, RoutineName)) return - ! OtherSt_HD - call RegPack(Buf, allocated(InData%OtherSt_HD)) - if (allocated(InData%OtherSt_HD)) then - call RegPackBounds(Buf, 1, lbound(InData%OtherSt_HD), ubound(InData%OtherSt_HD)) - LB(1:1) = lbound(InData%OtherSt_HD) - UB(1:1) = ubound(InData%OtherSt_HD) + if (allocated(SrcLinStateSaveData%OtherSt_HD)) then + LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_HD) + UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_HD) + if (.not. allocated(DstLinStateSaveData%OtherSt_HD)) then + allocate(DstLinStateSaveData%OtherSt_HD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_HD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call HydroDyn_PackOtherState(Buf, InData%OtherSt_HD(i1)) + call HydroDyn_CopyOtherState(SrcLinStateSaveData%OtherSt_HD(i1), DstLinStateSaveData%OtherSt_HD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%OtherSt_HD)) then + deallocate(DstLinStateSaveData%OtherSt_HD) end if - if (RegCheckErr(Buf, RoutineName)) return - ! u_HD - call RegPack(Buf, allocated(InData%u_HD)) - if (allocated(InData%u_HD)) then - call RegPackBounds(Buf, 1, lbound(InData%u_HD), ubound(InData%u_HD)) - LB(1:1) = lbound(InData%u_HD) - UB(1:1) = ubound(InData%u_HD) + if (allocated(SrcLinStateSaveData%u_HD)) then + LB(1:1) = lbound(SrcLinStateSaveData%u_HD) + UB(1:1) = ubound(SrcLinStateSaveData%u_HD) + if (.not. allocated(DstLinStateSaveData%u_HD)) then + allocate(DstLinStateSaveData%u_HD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_HD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call HydroDyn_PackInput(Buf, InData%u_HD(i1)) + call HydroDyn_CopyInput(SrcLinStateSaveData%u_HD(i1), DstLinStateSaveData%u_HD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%u_HD)) then + deallocate(DstLinStateSaveData%u_HD) end if - if (RegCheckErr(Buf, RoutineName)) return - ! x_IceF - call RegPack(Buf, allocated(InData%x_IceF)) - if (allocated(InData%x_IceF)) then - call RegPackBounds(Buf, 1, lbound(InData%x_IceF), ubound(InData%x_IceF)) - LB(1:1) = lbound(InData%x_IceF) - UB(1:1) = ubound(InData%x_IceF) + if (allocated(SrcLinStateSaveData%x_IceF)) then + LB(1:1) = lbound(SrcLinStateSaveData%x_IceF) + UB(1:1) = ubound(SrcLinStateSaveData%x_IceF) + if (.not. allocated(DstLinStateSaveData%x_IceF)) then + allocate(DstLinStateSaveData%x_IceF(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_IceF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call IceFloe_PackContState(Buf, InData%x_IceF(i1)) + call IceFloe_CopyContState(SrcLinStateSaveData%x_IceF(i1), DstLinStateSaveData%x_IceF(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%x_IceF)) then + deallocate(DstLinStateSaveData%x_IceF) end if - if (RegCheckErr(Buf, RoutineName)) return - ! xd_IceF - call RegPack(Buf, allocated(InData%xd_IceF)) - if (allocated(InData%xd_IceF)) then - call RegPackBounds(Buf, 1, lbound(InData%xd_IceF), ubound(InData%xd_IceF)) - LB(1:1) = lbound(InData%xd_IceF) - UB(1:1) = ubound(InData%xd_IceF) + if (allocated(SrcLinStateSaveData%xd_IceF)) then + LB(1:1) = lbound(SrcLinStateSaveData%xd_IceF) + UB(1:1) = ubound(SrcLinStateSaveData%xd_IceF) + if (.not. allocated(DstLinStateSaveData%xd_IceF)) then + allocate(DstLinStateSaveData%xd_IceF(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_IceF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call IceFloe_PackDiscState(Buf, InData%xd_IceF(i1)) + call IceFloe_CopyDiscState(SrcLinStateSaveData%xd_IceF(i1), DstLinStateSaveData%xd_IceF(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%xd_IceF)) then + deallocate(DstLinStateSaveData%xd_IceF) end if - if (RegCheckErr(Buf, RoutineName)) return - ! z_IceF - call RegPack(Buf, allocated(InData%z_IceF)) - if (allocated(InData%z_IceF)) then - call RegPackBounds(Buf, 1, lbound(InData%z_IceF), ubound(InData%z_IceF)) - LB(1:1) = lbound(InData%z_IceF) - UB(1:1) = ubound(InData%z_IceF) + if (allocated(SrcLinStateSaveData%z_IceF)) then + LB(1:1) = lbound(SrcLinStateSaveData%z_IceF) + UB(1:1) = ubound(SrcLinStateSaveData%z_IceF) + if (.not. allocated(DstLinStateSaveData%z_IceF)) then + allocate(DstLinStateSaveData%z_IceF(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_IceF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call IceFloe_PackConstrState(Buf, InData%z_IceF(i1)) + call IceFloe_CopyConstrState(SrcLinStateSaveData%z_IceF(i1), DstLinStateSaveData%z_IceF(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%z_IceF)) then + deallocate(DstLinStateSaveData%z_IceF) end if - if (RegCheckErr(Buf, RoutineName)) return - ! OtherSt_IceF - call RegPack(Buf, allocated(InData%OtherSt_IceF)) - if (allocated(InData%OtherSt_IceF)) then - call RegPackBounds(Buf, 1, lbound(InData%OtherSt_IceF), ubound(InData%OtherSt_IceF)) - LB(1:1) = lbound(InData%OtherSt_IceF) - UB(1:1) = ubound(InData%OtherSt_IceF) + if (allocated(SrcLinStateSaveData%OtherSt_IceF)) then + LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_IceF) + UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_IceF) + if (.not. allocated(DstLinStateSaveData%OtherSt_IceF)) then + allocate(DstLinStateSaveData%OtherSt_IceF(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_IceF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call IceFloe_PackOtherState(Buf, InData%OtherSt_IceF(i1)) + call IceFloe_CopyOtherState(SrcLinStateSaveData%OtherSt_IceF(i1), DstLinStateSaveData%OtherSt_IceF(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%OtherSt_IceF)) then + deallocate(DstLinStateSaveData%OtherSt_IceF) end if - if (RegCheckErr(Buf, RoutineName)) return - ! u_IceF - call RegPack(Buf, allocated(InData%u_IceF)) - if (allocated(InData%u_IceF)) then - call RegPackBounds(Buf, 1, lbound(InData%u_IceF), ubound(InData%u_IceF)) - LB(1:1) = lbound(InData%u_IceF) - UB(1:1) = ubound(InData%u_IceF) + if (allocated(SrcLinStateSaveData%u_IceF)) then + LB(1:1) = lbound(SrcLinStateSaveData%u_IceF) + UB(1:1) = ubound(SrcLinStateSaveData%u_IceF) + if (.not. allocated(DstLinStateSaveData%u_IceF)) then + allocate(DstLinStateSaveData%u_IceF(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_IceF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call IceFloe_PackInput(Buf, InData%u_IceF(i1)) + call IceFloe_CopyInput(SrcLinStateSaveData%u_IceF(i1), DstLinStateSaveData%u_IceF(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%u_IceF)) then + deallocate(DstLinStateSaveData%u_IceF) end if - if (RegCheckErr(Buf, RoutineName)) return - ! x_MAP - call RegPack(Buf, allocated(InData%x_MAP)) - if (allocated(InData%x_MAP)) then - call RegPackBounds(Buf, 1, lbound(InData%x_MAP), ubound(InData%x_MAP)) - LB(1:1) = lbound(InData%x_MAP) - UB(1:1) = ubound(InData%x_MAP) + if (allocated(SrcLinStateSaveData%x_MAP)) then + LB(1:1) = lbound(SrcLinStateSaveData%x_MAP) + UB(1:1) = ubound(SrcLinStateSaveData%x_MAP) + if (.not. allocated(DstLinStateSaveData%x_MAP)) then + allocate(DstLinStateSaveData%x_MAP(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_MAP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call MAP_PackContState(Buf, InData%x_MAP(i1)) + call MAP_CopyContState(SrcLinStateSaveData%x_MAP(i1), DstLinStateSaveData%x_MAP(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%x_MAP)) then + deallocate(DstLinStateSaveData%x_MAP) end if - if (RegCheckErr(Buf, RoutineName)) return - ! xd_MAP - call RegPack(Buf, allocated(InData%xd_MAP)) - if (allocated(InData%xd_MAP)) then - call RegPackBounds(Buf, 1, lbound(InData%xd_MAP), ubound(InData%xd_MAP)) - LB(1:1) = lbound(InData%xd_MAP) - UB(1:1) = ubound(InData%xd_MAP) + if (allocated(SrcLinStateSaveData%xd_MAP)) then + LB(1:1) = lbound(SrcLinStateSaveData%xd_MAP) + UB(1:1) = ubound(SrcLinStateSaveData%xd_MAP) + if (.not. allocated(DstLinStateSaveData%xd_MAP)) then + allocate(DstLinStateSaveData%xd_MAP(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_MAP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call MAP_PackDiscState(Buf, InData%xd_MAP(i1)) + call MAP_CopyDiscState(SrcLinStateSaveData%xd_MAP(i1), DstLinStateSaveData%xd_MAP(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%xd_MAP)) then + deallocate(DstLinStateSaveData%xd_MAP) end if - if (RegCheckErr(Buf, RoutineName)) return - ! z_MAP - call RegPack(Buf, allocated(InData%z_MAP)) - if (allocated(InData%z_MAP)) then - call RegPackBounds(Buf, 1, lbound(InData%z_MAP), ubound(InData%z_MAP)) - LB(1:1) = lbound(InData%z_MAP) - UB(1:1) = ubound(InData%z_MAP) + if (allocated(SrcLinStateSaveData%z_MAP)) then + LB(1:1) = lbound(SrcLinStateSaveData%z_MAP) + UB(1:1) = ubound(SrcLinStateSaveData%z_MAP) + if (.not. allocated(DstLinStateSaveData%z_MAP)) then + allocate(DstLinStateSaveData%z_MAP(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_MAP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call MAP_PackConstrState(Buf, InData%z_MAP(i1)) + call MAP_CopyConstrState(SrcLinStateSaveData%z_MAP(i1), DstLinStateSaveData%z_MAP(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%z_MAP)) then + deallocate(DstLinStateSaveData%z_MAP) end if - if (RegCheckErr(Buf, RoutineName)) return - ! u_MAP - call RegPack(Buf, allocated(InData%u_MAP)) - if (allocated(InData%u_MAP)) then - call RegPackBounds(Buf, 1, lbound(InData%u_MAP), ubound(InData%u_MAP)) - LB(1:1) = lbound(InData%u_MAP) - UB(1:1) = ubound(InData%u_MAP) + if (allocated(SrcLinStateSaveData%u_MAP)) then + LB(1:1) = lbound(SrcLinStateSaveData%u_MAP) + UB(1:1) = ubound(SrcLinStateSaveData%u_MAP) + if (.not. allocated(DstLinStateSaveData%u_MAP)) then + allocate(DstLinStateSaveData%u_MAP(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_MAP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call MAP_PackInput(Buf, InData%u_MAP(i1)) + call MAP_CopyInput(SrcLinStateSaveData%u_MAP(i1), DstLinStateSaveData%u_MAP(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%u_MAP)) then + deallocate(DstLinStateSaveData%u_MAP) end if - if (RegCheckErr(Buf, RoutineName)) return - ! x_FEAM - call RegPack(Buf, allocated(InData%x_FEAM)) - if (allocated(InData%x_FEAM)) then - call RegPackBounds(Buf, 1, lbound(InData%x_FEAM), ubound(InData%x_FEAM)) - LB(1:1) = lbound(InData%x_FEAM) - UB(1:1) = ubound(InData%x_FEAM) + if (allocated(SrcLinStateSaveData%x_FEAM)) then + LB(1:1) = lbound(SrcLinStateSaveData%x_FEAM) + UB(1:1) = ubound(SrcLinStateSaveData%x_FEAM) + if (.not. allocated(DstLinStateSaveData%x_FEAM)) then + allocate(DstLinStateSaveData%x_FEAM(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_FEAM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call FEAM_PackContState(Buf, InData%x_FEAM(i1)) + call FEAM_CopyContState(SrcLinStateSaveData%x_FEAM(i1), DstLinStateSaveData%x_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%x_FEAM)) then + deallocate(DstLinStateSaveData%x_FEAM) end if - if (RegCheckErr(Buf, RoutineName)) return - ! xd_FEAM - call RegPack(Buf, allocated(InData%xd_FEAM)) - if (allocated(InData%xd_FEAM)) then - call RegPackBounds(Buf, 1, lbound(InData%xd_FEAM), ubound(InData%xd_FEAM)) - LB(1:1) = lbound(InData%xd_FEAM) - UB(1:1) = ubound(InData%xd_FEAM) + if (allocated(SrcLinStateSaveData%xd_FEAM)) then + LB(1:1) = lbound(SrcLinStateSaveData%xd_FEAM) + UB(1:1) = ubound(SrcLinStateSaveData%xd_FEAM) + if (.not. allocated(DstLinStateSaveData%xd_FEAM)) then + allocate(DstLinStateSaveData%xd_FEAM(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_FEAM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call FEAM_PackDiscState(Buf, InData%xd_FEAM(i1)) + call FEAM_CopyDiscState(SrcLinStateSaveData%xd_FEAM(i1), DstLinStateSaveData%xd_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%xd_FEAM)) then + deallocate(DstLinStateSaveData%xd_FEAM) end if - if (RegCheckErr(Buf, RoutineName)) return - ! z_FEAM - call RegPack(Buf, allocated(InData%z_FEAM)) - if (allocated(InData%z_FEAM)) then - call RegPackBounds(Buf, 1, lbound(InData%z_FEAM), ubound(InData%z_FEAM)) - LB(1:1) = lbound(InData%z_FEAM) - UB(1:1) = ubound(InData%z_FEAM) + if (allocated(SrcLinStateSaveData%z_FEAM)) then + LB(1:1) = lbound(SrcLinStateSaveData%z_FEAM) + UB(1:1) = ubound(SrcLinStateSaveData%z_FEAM) + if (.not. allocated(DstLinStateSaveData%z_FEAM)) then + allocate(DstLinStateSaveData%z_FEAM(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_FEAM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call FEAM_PackConstrState(Buf, InData%z_FEAM(i1)) + call FEAM_CopyConstrState(SrcLinStateSaveData%z_FEAM(i1), DstLinStateSaveData%z_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%z_FEAM)) then + deallocate(DstLinStateSaveData%z_FEAM) end if - if (RegCheckErr(Buf, RoutineName)) return - ! OtherSt_FEAM - call RegPack(Buf, allocated(InData%OtherSt_FEAM)) - if (allocated(InData%OtherSt_FEAM)) then - call RegPackBounds(Buf, 1, lbound(InData%OtherSt_FEAM), ubound(InData%OtherSt_FEAM)) - LB(1:1) = lbound(InData%OtherSt_FEAM) - UB(1:1) = ubound(InData%OtherSt_FEAM) + if (allocated(SrcLinStateSaveData%OtherSt_FEAM)) then + LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_FEAM) + UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_FEAM) + if (.not. allocated(DstLinStateSaveData%OtherSt_FEAM)) then + allocate(DstLinStateSaveData%OtherSt_FEAM(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_FEAM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call FEAM_PackOtherState(Buf, InData%OtherSt_FEAM(i1)) + call FEAM_CopyOtherState(SrcLinStateSaveData%OtherSt_FEAM(i1), DstLinStateSaveData%OtherSt_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%OtherSt_FEAM)) then + deallocate(DstLinStateSaveData%OtherSt_FEAM) end if - if (RegCheckErr(Buf, RoutineName)) return - ! u_FEAM - call RegPack(Buf, allocated(InData%u_FEAM)) - if (allocated(InData%u_FEAM)) then - call RegPackBounds(Buf, 1, lbound(InData%u_FEAM), ubound(InData%u_FEAM)) - LB(1:1) = lbound(InData%u_FEAM) - UB(1:1) = ubound(InData%u_FEAM) + if (allocated(SrcLinStateSaveData%u_FEAM)) then + LB(1:1) = lbound(SrcLinStateSaveData%u_FEAM) + UB(1:1) = ubound(SrcLinStateSaveData%u_FEAM) + if (.not. allocated(DstLinStateSaveData%u_FEAM)) then + allocate(DstLinStateSaveData%u_FEAM(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_FEAM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call FEAM_PackInput(Buf, InData%u_FEAM(i1)) + call FEAM_CopyInput(SrcLinStateSaveData%u_FEAM(i1), DstLinStateSaveData%u_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%u_FEAM)) then + deallocate(DstLinStateSaveData%u_FEAM) end if - if (RegCheckErr(Buf, RoutineName)) return - ! x_MD - call RegPack(Buf, allocated(InData%x_MD)) - if (allocated(InData%x_MD)) then - call RegPackBounds(Buf, 1, lbound(InData%x_MD), ubound(InData%x_MD)) - LB(1:1) = lbound(InData%x_MD) - UB(1:1) = ubound(InData%x_MD) + if (allocated(SrcLinStateSaveData%x_MD)) then + LB(1:1) = lbound(SrcLinStateSaveData%x_MD) + UB(1:1) = ubound(SrcLinStateSaveData%x_MD) + if (.not. allocated(DstLinStateSaveData%x_MD)) then + allocate(DstLinStateSaveData%x_MD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_MD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call MD_PackContState(Buf, InData%x_MD(i1)) + call MD_CopyContState(SrcLinStateSaveData%x_MD(i1), DstLinStateSaveData%x_MD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%x_MD)) then + deallocate(DstLinStateSaveData%x_MD) end if - if (RegCheckErr(Buf, RoutineName)) return - ! xd_MD - call RegPack(Buf, allocated(InData%xd_MD)) - if (allocated(InData%xd_MD)) then - call RegPackBounds(Buf, 1, lbound(InData%xd_MD), ubound(InData%xd_MD)) - LB(1:1) = lbound(InData%xd_MD) - UB(1:1) = ubound(InData%xd_MD) + if (allocated(SrcLinStateSaveData%xd_MD)) then + LB(1:1) = lbound(SrcLinStateSaveData%xd_MD) + UB(1:1) = ubound(SrcLinStateSaveData%xd_MD) + if (.not. allocated(DstLinStateSaveData%xd_MD)) then + allocate(DstLinStateSaveData%xd_MD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_MD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call MD_PackDiscState(Buf, InData%xd_MD(i1)) + call MD_CopyDiscState(SrcLinStateSaveData%xd_MD(i1), DstLinStateSaveData%xd_MD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%xd_MD)) then + deallocate(DstLinStateSaveData%xd_MD) end if - if (RegCheckErr(Buf, RoutineName)) return - ! z_MD - call RegPack(Buf, allocated(InData%z_MD)) - if (allocated(InData%z_MD)) then - call RegPackBounds(Buf, 1, lbound(InData%z_MD), ubound(InData%z_MD)) - LB(1:1) = lbound(InData%z_MD) - UB(1:1) = ubound(InData%z_MD) + if (allocated(SrcLinStateSaveData%z_MD)) then + LB(1:1) = lbound(SrcLinStateSaveData%z_MD) + UB(1:1) = ubound(SrcLinStateSaveData%z_MD) + if (.not. allocated(DstLinStateSaveData%z_MD)) then + allocate(DstLinStateSaveData%z_MD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_MD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call MD_PackConstrState(Buf, InData%z_MD(i1)) + call MD_CopyConstrState(SrcLinStateSaveData%z_MD(i1), DstLinStateSaveData%z_MD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%z_MD)) then + deallocate(DstLinStateSaveData%z_MD) end if - if (RegCheckErr(Buf, RoutineName)) return - ! OtherSt_MD - call RegPack(Buf, allocated(InData%OtherSt_MD)) - if (allocated(InData%OtherSt_MD)) then - call RegPackBounds(Buf, 1, lbound(InData%OtherSt_MD), ubound(InData%OtherSt_MD)) - LB(1:1) = lbound(InData%OtherSt_MD) - UB(1:1) = ubound(InData%OtherSt_MD) + if (allocated(SrcLinStateSaveData%OtherSt_MD)) then + LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_MD) + UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_MD) + if (.not. allocated(DstLinStateSaveData%OtherSt_MD)) then + allocate(DstLinStateSaveData%OtherSt_MD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_MD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call MD_PackOtherState(Buf, InData%OtherSt_MD(i1)) + call MD_CopyOtherState(SrcLinStateSaveData%OtherSt_MD(i1), DstLinStateSaveData%OtherSt_MD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%OtherSt_MD)) then + deallocate(DstLinStateSaveData%OtherSt_MD) end if - if (RegCheckErr(Buf, RoutineName)) return - ! u_MD - call RegPack(Buf, allocated(InData%u_MD)) - if (allocated(InData%u_MD)) then - call RegPackBounds(Buf, 1, lbound(InData%u_MD), ubound(InData%u_MD)) - LB(1:1) = lbound(InData%u_MD) - UB(1:1) = ubound(InData%u_MD) + if (allocated(SrcLinStateSaveData%u_MD)) then + LB(1:1) = lbound(SrcLinStateSaveData%u_MD) + UB(1:1) = ubound(SrcLinStateSaveData%u_MD) + if (.not. allocated(DstLinStateSaveData%u_MD)) then + allocate(DstLinStateSaveData%u_MD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_MD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call MD_PackInput(Buf, InData%u_MD(i1)) + call MD_CopyInput(SrcLinStateSaveData%u_MD(i1), DstLinStateSaveData%u_MD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstLinStateSaveData%u_MD)) then + deallocate(DstLinStateSaveData%u_MD) end if - if (RegCheckErr(Buf, RoutineName)) return end subroutine -subroutine FAST_UnPackLinStateSave(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf - type(FAST_LinStateSave), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'FAST_UnPackLinStateSave' +subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) + type(FAST_LinStateSave), intent(inout) :: LinStateSaveData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg integer(IntKi) :: i1, i2 integer(IntKi) :: LB(2), UB(2) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - ! x_IceD - if (allocated(OutData%x_IceD)) deallocate(OutData%x_IceD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%x_IceD(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_IceD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyLinStateSave' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(LinStateSaveData%x_IceD)) then + LB(1:2) = lbound(LinStateSaveData%x_IceD) + UB(1:2) = ubound(LinStateSaveData%x_IceD) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call IceD_UnpackContState(Buf, OutData%x_IceD(i1,i2)) ! x_IceD + call IceD_DestroyContState(LinStateSaveData%x_IceD(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do end do + deallocate(LinStateSaveData%x_IceD) end if - ! xd_IceD - if (allocated(OutData%xd_IceD)) deallocate(OutData%xd_IceD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%xd_IceD(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_IceD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%xd_IceD)) then + LB(1:2) = lbound(LinStateSaveData%xd_IceD) + UB(1:2) = ubound(LinStateSaveData%xd_IceD) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call IceD_UnpackDiscState(Buf, OutData%xd_IceD(i1,i2)) ! xd_IceD + call IceD_DestroyDiscState(LinStateSaveData%xd_IceD(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do end do + deallocate(LinStateSaveData%xd_IceD) end if - ! z_IceD - if (allocated(OutData%z_IceD)) deallocate(OutData%z_IceD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%z_IceD(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_IceD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%z_IceD)) then + LB(1:2) = lbound(LinStateSaveData%z_IceD) + UB(1:2) = ubound(LinStateSaveData%z_IceD) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call IceD_UnpackConstrState(Buf, OutData%z_IceD(i1,i2)) ! z_IceD + call IceD_DestroyConstrState(LinStateSaveData%z_IceD(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do end do + deallocate(LinStateSaveData%z_IceD) end if - ! OtherSt_IceD - if (allocated(OutData%OtherSt_IceD)) deallocate(OutData%OtherSt_IceD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OtherSt_IceD(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_IceD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%OtherSt_IceD)) then + LB(1:2) = lbound(LinStateSaveData%OtherSt_IceD) + UB(1:2) = ubound(LinStateSaveData%OtherSt_IceD) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call IceD_UnpackOtherState(Buf, OutData%OtherSt_IceD(i1,i2)) ! OtherSt_IceD + call IceD_DestroyOtherState(LinStateSaveData%OtherSt_IceD(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do end do + deallocate(LinStateSaveData%OtherSt_IceD) end if - ! u_IceD - if (allocated(OutData%u_IceD)) deallocate(OutData%u_IceD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%u_IceD(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_IceD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%u_IceD)) then + LB(1:2) = lbound(LinStateSaveData%u_IceD) + UB(1:2) = ubound(LinStateSaveData%u_IceD) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call IceD_UnpackInput(Buf, OutData%u_IceD(i1,i2)) ! u_IceD + call IceD_DestroyInput(LinStateSaveData%u_IceD(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do end do + deallocate(LinStateSaveData%u_IceD) end if - ! x_BD - if (allocated(OutData%x_BD)) deallocate(OutData%x_BD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%x_BD(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_BD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%x_BD)) then + LB(1:2) = lbound(LinStateSaveData%x_BD) + UB(1:2) = ubound(LinStateSaveData%x_BD) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call BD_UnpackContState(Buf, OutData%x_BD(i1,i2)) ! x_BD + call BD_DestroyContState(LinStateSaveData%x_BD(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do end do + deallocate(LinStateSaveData%x_BD) end if - ! xd_BD - if (allocated(OutData%xd_BD)) deallocate(OutData%xd_BD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%xd_BD(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_BD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%xd_BD)) then + LB(1:2) = lbound(LinStateSaveData%xd_BD) + UB(1:2) = ubound(LinStateSaveData%xd_BD) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call BD_UnpackDiscState(Buf, OutData%xd_BD(i1,i2)) ! xd_BD + call BD_DestroyDiscState(LinStateSaveData%xd_BD(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do end do + deallocate(LinStateSaveData%xd_BD) end if - ! z_BD - if (allocated(OutData%z_BD)) deallocate(OutData%z_BD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%z_BD(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_BD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%z_BD)) then + LB(1:2) = lbound(LinStateSaveData%z_BD) + UB(1:2) = ubound(LinStateSaveData%z_BD) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call BD_UnpackConstrState(Buf, OutData%z_BD(i1,i2)) ! z_BD + call BD_DestroyConstrState(LinStateSaveData%z_BD(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do end do + deallocate(LinStateSaveData%z_BD) end if - ! OtherSt_BD - if (allocated(OutData%OtherSt_BD)) deallocate(OutData%OtherSt_BD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OtherSt_BD(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_BD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%OtherSt_BD)) then + LB(1:2) = lbound(LinStateSaveData%OtherSt_BD) + UB(1:2) = ubound(LinStateSaveData%OtherSt_BD) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call BD_UnpackOtherState(Buf, OutData%OtherSt_BD(i1,i2)) ! OtherSt_BD + call BD_DestroyOtherState(LinStateSaveData%OtherSt_BD(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do end do + deallocate(LinStateSaveData%OtherSt_BD) end if - ! u_BD - if (allocated(OutData%u_BD)) deallocate(OutData%u_BD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%u_BD(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%u_BD)) then + LB(1:2) = lbound(LinStateSaveData%u_BD) + UB(1:2) = ubound(LinStateSaveData%u_BD) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call BD_UnpackInput(Buf, OutData%u_BD(i1,i2)) ! u_BD + call BD_DestroyInput(LinStateSaveData%u_BD(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do end do + deallocate(LinStateSaveData%u_BD) end if - ! x_ED - if (allocated(OutData%x_ED)) deallocate(OutData%x_ED) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%x_ED(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_ED.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%x_ED)) then + LB(1:1) = lbound(LinStateSaveData%x_ED) + UB(1:1) = ubound(LinStateSaveData%x_ED) do i1 = LB(1), UB(1) - call ED_UnpackContState(Buf, OutData%x_ED(i1)) ! x_ED + call ED_DestroyContState(LinStateSaveData%x_ED(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%x_ED) end if - ! xd_ED - if (allocated(OutData%xd_ED)) deallocate(OutData%xd_ED) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%xd_ED(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_ED.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%xd_ED)) then + LB(1:1) = lbound(LinStateSaveData%xd_ED) + UB(1:1) = ubound(LinStateSaveData%xd_ED) do i1 = LB(1), UB(1) - call ED_UnpackDiscState(Buf, OutData%xd_ED(i1)) ! xd_ED + call ED_DestroyDiscState(LinStateSaveData%xd_ED(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%xd_ED) end if - ! z_ED - if (allocated(OutData%z_ED)) deallocate(OutData%z_ED) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%z_ED(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_ED.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%z_ED)) then + LB(1:1) = lbound(LinStateSaveData%z_ED) + UB(1:1) = ubound(LinStateSaveData%z_ED) do i1 = LB(1), UB(1) - call ED_UnpackConstrState(Buf, OutData%z_ED(i1)) ! z_ED + call ED_DestroyConstrState(LinStateSaveData%z_ED(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%z_ED) end if - ! OtherSt_ED - if (allocated(OutData%OtherSt_ED)) deallocate(OutData%OtherSt_ED) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OtherSt_ED(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_ED.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%OtherSt_ED)) then + LB(1:1) = lbound(LinStateSaveData%OtherSt_ED) + UB(1:1) = ubound(LinStateSaveData%OtherSt_ED) do i1 = LB(1), UB(1) - call ED_UnpackOtherState(Buf, OutData%OtherSt_ED(i1)) ! OtherSt_ED + call ED_DestroyOtherState(LinStateSaveData%OtherSt_ED(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%OtherSt_ED) end if - ! u_ED - if (allocated(OutData%u_ED)) deallocate(OutData%u_ED) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%u_ED(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_ED.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%u_ED)) then + LB(1:1) = lbound(LinStateSaveData%u_ED) + UB(1:1) = ubound(LinStateSaveData%u_ED) do i1 = LB(1), UB(1) - call ED_UnpackInput(Buf, OutData%u_ED(i1)) ! u_ED + call ED_DestroyInput(LinStateSaveData%u_ED(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%u_ED) end if - ! x_SrvD - if (allocated(OutData%x_SrvD)) deallocate(OutData%x_SrvD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%x_SrvD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_SrvD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%x_SrvD)) then + LB(1:1) = lbound(LinStateSaveData%x_SrvD) + UB(1:1) = ubound(LinStateSaveData%x_SrvD) do i1 = LB(1), UB(1) - call SrvD_UnpackContState(Buf, OutData%x_SrvD(i1)) ! x_SrvD + call SrvD_DestroyContState(LinStateSaveData%x_SrvD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%x_SrvD) end if - ! xd_SrvD - if (allocated(OutData%xd_SrvD)) deallocate(OutData%xd_SrvD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%xd_SrvD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_SrvD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%xd_SrvD)) then + LB(1:1) = lbound(LinStateSaveData%xd_SrvD) + UB(1:1) = ubound(LinStateSaveData%xd_SrvD) do i1 = LB(1), UB(1) - call SrvD_UnpackDiscState(Buf, OutData%xd_SrvD(i1)) ! xd_SrvD + call SrvD_DestroyDiscState(LinStateSaveData%xd_SrvD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%xd_SrvD) end if - ! z_SrvD - if (allocated(OutData%z_SrvD)) deallocate(OutData%z_SrvD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%z_SrvD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_SrvD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%z_SrvD)) then + LB(1:1) = lbound(LinStateSaveData%z_SrvD) + UB(1:1) = ubound(LinStateSaveData%z_SrvD) do i1 = LB(1), UB(1) - call SrvD_UnpackConstrState(Buf, OutData%z_SrvD(i1)) ! z_SrvD + call SrvD_DestroyConstrState(LinStateSaveData%z_SrvD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%z_SrvD) end if - ! OtherSt_SrvD - if (allocated(OutData%OtherSt_SrvD)) deallocate(OutData%OtherSt_SrvD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OtherSt_SrvD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_SrvD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%OtherSt_SrvD)) then + LB(1:1) = lbound(LinStateSaveData%OtherSt_SrvD) + UB(1:1) = ubound(LinStateSaveData%OtherSt_SrvD) do i1 = LB(1), UB(1) - call SrvD_UnpackOtherState(Buf, OutData%OtherSt_SrvD(i1)) ! OtherSt_SrvD + call SrvD_DestroyOtherState(LinStateSaveData%OtherSt_SrvD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%OtherSt_SrvD) end if - ! u_SrvD - if (allocated(OutData%u_SrvD)) deallocate(OutData%u_SrvD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%u_SrvD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SrvD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%u_SrvD)) then + LB(1:1) = lbound(LinStateSaveData%u_SrvD) + UB(1:1) = ubound(LinStateSaveData%u_SrvD) do i1 = LB(1), UB(1) - call SrvD_UnpackInput(Buf, OutData%u_SrvD(i1)) ! u_SrvD + call SrvD_DestroyInput(LinStateSaveData%u_SrvD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%u_SrvD) end if - ! x_AD - if (allocated(OutData%x_AD)) deallocate(OutData%x_AD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%x_AD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_AD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%x_AD)) then + LB(1:1) = lbound(LinStateSaveData%x_AD) + UB(1:1) = ubound(LinStateSaveData%x_AD) do i1 = LB(1), UB(1) - call AD_UnpackContState(Buf, OutData%x_AD(i1)) ! x_AD + call AD_DestroyContState(LinStateSaveData%x_AD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%x_AD) end if - ! xd_AD - if (allocated(OutData%xd_AD)) deallocate(OutData%xd_AD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%xd_AD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_AD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%xd_AD)) then + LB(1:1) = lbound(LinStateSaveData%xd_AD) + UB(1:1) = ubound(LinStateSaveData%xd_AD) do i1 = LB(1), UB(1) - call AD_UnpackDiscState(Buf, OutData%xd_AD(i1)) ! xd_AD + call AD_DestroyDiscState(LinStateSaveData%xd_AD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%xd_AD) end if - ! z_AD - if (allocated(OutData%z_AD)) deallocate(OutData%z_AD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%z_AD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_AD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%z_AD)) then + LB(1:1) = lbound(LinStateSaveData%z_AD) + UB(1:1) = ubound(LinStateSaveData%z_AD) do i1 = LB(1), UB(1) - call AD_UnpackConstrState(Buf, OutData%z_AD(i1)) ! z_AD + call AD_DestroyConstrState(LinStateSaveData%z_AD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%z_AD) end if - ! OtherSt_AD - if (allocated(OutData%OtherSt_AD)) deallocate(OutData%OtherSt_AD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OtherSt_AD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_AD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%OtherSt_AD)) then + LB(1:1) = lbound(LinStateSaveData%OtherSt_AD) + UB(1:1) = ubound(LinStateSaveData%OtherSt_AD) do i1 = LB(1), UB(1) - call AD_UnpackOtherState(Buf, OutData%OtherSt_AD(i1)) ! OtherSt_AD + call AD_DestroyOtherState(LinStateSaveData%OtherSt_AD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%OtherSt_AD) end if - ! u_AD - if (allocated(OutData%u_AD)) deallocate(OutData%u_AD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%u_AD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_AD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%u_AD)) then + LB(1:1) = lbound(LinStateSaveData%u_AD) + UB(1:1) = ubound(LinStateSaveData%u_AD) do i1 = LB(1), UB(1) - call AD_UnpackInput(Buf, OutData%u_AD(i1)) ! u_AD + call AD_DestroyInput(LinStateSaveData%u_AD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%u_AD) end if - ! x_IfW - if (allocated(OutData%x_IfW)) deallocate(OutData%x_IfW) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%x_IfW(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_IfW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%x_IfW)) then + LB(1:1) = lbound(LinStateSaveData%x_IfW) + UB(1:1) = ubound(LinStateSaveData%x_IfW) do i1 = LB(1), UB(1) - call InflowWind_UnpackContState(Buf, OutData%x_IfW(i1)) ! x_IfW + call InflowWind_DestroyContState(LinStateSaveData%x_IfW(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%x_IfW) end if - ! xd_IfW - if (allocated(OutData%xd_IfW)) deallocate(OutData%xd_IfW) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%xd_IfW(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_IfW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%xd_IfW)) then + LB(1:1) = lbound(LinStateSaveData%xd_IfW) + UB(1:1) = ubound(LinStateSaveData%xd_IfW) do i1 = LB(1), UB(1) - call InflowWind_UnpackDiscState(Buf, OutData%xd_IfW(i1)) ! xd_IfW + call InflowWind_DestroyDiscState(LinStateSaveData%xd_IfW(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%xd_IfW) end if - ! z_IfW - if (allocated(OutData%z_IfW)) deallocate(OutData%z_IfW) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%z_IfW(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_IfW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%z_IfW)) then + LB(1:1) = lbound(LinStateSaveData%z_IfW) + UB(1:1) = ubound(LinStateSaveData%z_IfW) do i1 = LB(1), UB(1) - call InflowWind_UnpackConstrState(Buf, OutData%z_IfW(i1)) ! z_IfW + call InflowWind_DestroyConstrState(LinStateSaveData%z_IfW(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%z_IfW) end if - ! OtherSt_IfW - if (allocated(OutData%OtherSt_IfW)) deallocate(OutData%OtherSt_IfW) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OtherSt_IfW(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_IfW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%OtherSt_IfW)) then + LB(1:1) = lbound(LinStateSaveData%OtherSt_IfW) + UB(1:1) = ubound(LinStateSaveData%OtherSt_IfW) do i1 = LB(1), UB(1) - call InflowWind_UnpackOtherState(Buf, OutData%OtherSt_IfW(i1)) ! OtherSt_IfW + call InflowWind_DestroyOtherState(LinStateSaveData%OtherSt_IfW(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%OtherSt_IfW) end if - ! u_IfW - if (allocated(OutData%u_IfW)) deallocate(OutData%u_IfW) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%u_IfW(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_IfW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%u_IfW)) then + LB(1:1) = lbound(LinStateSaveData%u_IfW) + UB(1:1) = ubound(LinStateSaveData%u_IfW) do i1 = LB(1), UB(1) - call InflowWind_UnpackInput(Buf, OutData%u_IfW(i1)) ! u_IfW + call InflowWind_DestroyInput(LinStateSaveData%u_IfW(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%u_IfW) end if - ! x_SD - if (allocated(OutData%x_SD)) deallocate(OutData%x_SD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%x_SD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_SD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%x_SD)) then + LB(1:1) = lbound(LinStateSaveData%x_SD) + UB(1:1) = ubound(LinStateSaveData%x_SD) do i1 = LB(1), UB(1) - call SD_UnpackContState(Buf, OutData%x_SD(i1)) ! x_SD + call SD_DestroyContState(LinStateSaveData%x_SD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%x_SD) end if - ! xd_SD - if (allocated(OutData%xd_SD)) deallocate(OutData%xd_SD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%xd_SD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_SD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%xd_SD)) then + LB(1:1) = lbound(LinStateSaveData%xd_SD) + UB(1:1) = ubound(LinStateSaveData%xd_SD) do i1 = LB(1), UB(1) - call SD_UnpackDiscState(Buf, OutData%xd_SD(i1)) ! xd_SD + call SD_DestroyDiscState(LinStateSaveData%xd_SD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%xd_SD) end if - ! z_SD - if (allocated(OutData%z_SD)) deallocate(OutData%z_SD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%z_SD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_SD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%z_SD)) then + LB(1:1) = lbound(LinStateSaveData%z_SD) + UB(1:1) = ubound(LinStateSaveData%z_SD) do i1 = LB(1), UB(1) - call SD_UnpackConstrState(Buf, OutData%z_SD(i1)) ! z_SD + call SD_DestroyConstrState(LinStateSaveData%z_SD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%z_SD) end if - ! OtherSt_SD - if (allocated(OutData%OtherSt_SD)) deallocate(OutData%OtherSt_SD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OtherSt_SD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_SD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%OtherSt_SD)) then + LB(1:1) = lbound(LinStateSaveData%OtherSt_SD) + UB(1:1) = ubound(LinStateSaveData%OtherSt_SD) do i1 = LB(1), UB(1) - call SD_UnpackOtherState(Buf, OutData%OtherSt_SD(i1)) ! OtherSt_SD + call SD_DestroyOtherState(LinStateSaveData%OtherSt_SD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%OtherSt_SD) end if - ! u_SD - if (allocated(OutData%u_SD)) deallocate(OutData%u_SD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%u_SD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%u_SD)) then + LB(1:1) = lbound(LinStateSaveData%u_SD) + UB(1:1) = ubound(LinStateSaveData%u_SD) do i1 = LB(1), UB(1) - call SD_UnpackInput(Buf, OutData%u_SD(i1)) ! u_SD + call SD_DestroyInput(LinStateSaveData%u_SD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%u_SD) end if - ! x_ExtPtfm - if (allocated(OutData%x_ExtPtfm)) deallocate(OutData%x_ExtPtfm) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%x_ExtPtfm(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_ExtPtfm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%x_ExtPtfm)) then + LB(1:1) = lbound(LinStateSaveData%x_ExtPtfm) + UB(1:1) = ubound(LinStateSaveData%x_ExtPtfm) do i1 = LB(1), UB(1) - call ExtPtfm_UnpackContState(Buf, OutData%x_ExtPtfm(i1)) ! x_ExtPtfm + call ExtPtfm_DestroyContState(LinStateSaveData%x_ExtPtfm(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%x_ExtPtfm) end if - ! xd_ExtPtfm - if (allocated(OutData%xd_ExtPtfm)) deallocate(OutData%xd_ExtPtfm) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%xd_ExtPtfm(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_ExtPtfm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%xd_ExtPtfm)) then + LB(1:1) = lbound(LinStateSaveData%xd_ExtPtfm) + UB(1:1) = ubound(LinStateSaveData%xd_ExtPtfm) do i1 = LB(1), UB(1) - call ExtPtfm_UnpackDiscState(Buf, OutData%xd_ExtPtfm(i1)) ! xd_ExtPtfm + call ExtPtfm_DestroyDiscState(LinStateSaveData%xd_ExtPtfm(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%xd_ExtPtfm) end if - ! z_ExtPtfm - if (allocated(OutData%z_ExtPtfm)) deallocate(OutData%z_ExtPtfm) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%z_ExtPtfm(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_ExtPtfm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%z_ExtPtfm)) then + LB(1:1) = lbound(LinStateSaveData%z_ExtPtfm) + UB(1:1) = ubound(LinStateSaveData%z_ExtPtfm) do i1 = LB(1), UB(1) - call ExtPtfm_UnpackConstrState(Buf, OutData%z_ExtPtfm(i1)) ! z_ExtPtfm + call ExtPtfm_DestroyConstrState(LinStateSaveData%z_ExtPtfm(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%z_ExtPtfm) end if - ! OtherSt_ExtPtfm - if (allocated(OutData%OtherSt_ExtPtfm)) deallocate(OutData%OtherSt_ExtPtfm) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OtherSt_ExtPtfm(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_ExtPtfm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%OtherSt_ExtPtfm)) then + LB(1:1) = lbound(LinStateSaveData%OtherSt_ExtPtfm) + UB(1:1) = ubound(LinStateSaveData%OtherSt_ExtPtfm) do i1 = LB(1), UB(1) - call ExtPtfm_UnpackOtherState(Buf, OutData%OtherSt_ExtPtfm(i1)) ! OtherSt_ExtPtfm + call ExtPtfm_DestroyOtherState(LinStateSaveData%OtherSt_ExtPtfm(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%OtherSt_ExtPtfm) end if - ! u_ExtPtfm - if (allocated(OutData%u_ExtPtfm)) deallocate(OutData%u_ExtPtfm) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%u_ExtPtfm(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_ExtPtfm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%u_ExtPtfm)) then + LB(1:1) = lbound(LinStateSaveData%u_ExtPtfm) + UB(1:1) = ubound(LinStateSaveData%u_ExtPtfm) do i1 = LB(1), UB(1) - call ExtPtfm_UnpackInput(Buf, OutData%u_ExtPtfm(i1)) ! u_ExtPtfm + call ExtPtfm_DestroyInput(LinStateSaveData%u_ExtPtfm(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%u_ExtPtfm) end if - ! x_HD - if (allocated(OutData%x_HD)) deallocate(OutData%x_HD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%x_HD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_HD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%x_HD)) then + LB(1:1) = lbound(LinStateSaveData%x_HD) + UB(1:1) = ubound(LinStateSaveData%x_HD) do i1 = LB(1), UB(1) - call HydroDyn_UnpackContState(Buf, OutData%x_HD(i1)) ! x_HD + call HydroDyn_DestroyContState(LinStateSaveData%x_HD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%x_HD) end if - ! xd_HD - if (allocated(OutData%xd_HD)) deallocate(OutData%xd_HD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%xd_HD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_HD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%xd_HD)) then + LB(1:1) = lbound(LinStateSaveData%xd_HD) + UB(1:1) = ubound(LinStateSaveData%xd_HD) do i1 = LB(1), UB(1) - call HydroDyn_UnpackDiscState(Buf, OutData%xd_HD(i1)) ! xd_HD + call HydroDyn_DestroyDiscState(LinStateSaveData%xd_HD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%xd_HD) end if - ! z_HD - if (allocated(OutData%z_HD)) deallocate(OutData%z_HD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%z_HD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_HD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%z_HD)) then + LB(1:1) = lbound(LinStateSaveData%z_HD) + UB(1:1) = ubound(LinStateSaveData%z_HD) do i1 = LB(1), UB(1) - call HydroDyn_UnpackConstrState(Buf, OutData%z_HD(i1)) ! z_HD + call HydroDyn_DestroyConstrState(LinStateSaveData%z_HD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%z_HD) end if - ! OtherSt_HD - if (allocated(OutData%OtherSt_HD)) deallocate(OutData%OtherSt_HD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OtherSt_HD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_HD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%OtherSt_HD)) then + LB(1:1) = lbound(LinStateSaveData%OtherSt_HD) + UB(1:1) = ubound(LinStateSaveData%OtherSt_HD) do i1 = LB(1), UB(1) - call HydroDyn_UnpackOtherState(Buf, OutData%OtherSt_HD(i1)) ! OtherSt_HD + call HydroDyn_DestroyOtherState(LinStateSaveData%OtherSt_HD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%OtherSt_HD) end if - ! u_HD - if (allocated(OutData%u_HD)) deallocate(OutData%u_HD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%u_HD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_HD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%u_HD)) then + LB(1:1) = lbound(LinStateSaveData%u_HD) + UB(1:1) = ubound(LinStateSaveData%u_HD) do i1 = LB(1), UB(1) - call HydroDyn_UnpackInput(Buf, OutData%u_HD(i1)) ! u_HD + call HydroDyn_DestroyInput(LinStateSaveData%u_HD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%u_HD) end if - ! x_IceF - if (allocated(OutData%x_IceF)) deallocate(OutData%x_IceF) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%x_IceF(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_IceF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%x_IceF)) then + LB(1:1) = lbound(LinStateSaveData%x_IceF) + UB(1:1) = ubound(LinStateSaveData%x_IceF) do i1 = LB(1), UB(1) - call IceFloe_UnpackContState(Buf, OutData%x_IceF(i1)) ! x_IceF + call IceFloe_DestroyContState(LinStateSaveData%x_IceF(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%x_IceF) end if - ! xd_IceF - if (allocated(OutData%xd_IceF)) deallocate(OutData%xd_IceF) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%xd_IceF(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_IceF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%xd_IceF)) then + LB(1:1) = lbound(LinStateSaveData%xd_IceF) + UB(1:1) = ubound(LinStateSaveData%xd_IceF) do i1 = LB(1), UB(1) - call IceFloe_UnpackDiscState(Buf, OutData%xd_IceF(i1)) ! xd_IceF + call IceFloe_DestroyDiscState(LinStateSaveData%xd_IceF(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%xd_IceF) end if - ! z_IceF - if (allocated(OutData%z_IceF)) deallocate(OutData%z_IceF) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%z_IceF(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_IceF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%z_IceF)) then + LB(1:1) = lbound(LinStateSaveData%z_IceF) + UB(1:1) = ubound(LinStateSaveData%z_IceF) do i1 = LB(1), UB(1) - call IceFloe_UnpackConstrState(Buf, OutData%z_IceF(i1)) ! z_IceF + call IceFloe_DestroyConstrState(LinStateSaveData%z_IceF(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%z_IceF) end if - ! OtherSt_IceF - if (allocated(OutData%OtherSt_IceF)) deallocate(OutData%OtherSt_IceF) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OtherSt_IceF(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_IceF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%OtherSt_IceF)) then + LB(1:1) = lbound(LinStateSaveData%OtherSt_IceF) + UB(1:1) = ubound(LinStateSaveData%OtherSt_IceF) do i1 = LB(1), UB(1) - call IceFloe_UnpackOtherState(Buf, OutData%OtherSt_IceF(i1)) ! OtherSt_IceF + call IceFloe_DestroyOtherState(LinStateSaveData%OtherSt_IceF(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%OtherSt_IceF) end if - ! u_IceF - if (allocated(OutData%u_IceF)) deallocate(OutData%u_IceF) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%u_IceF(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_IceF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%u_IceF)) then + LB(1:1) = lbound(LinStateSaveData%u_IceF) + UB(1:1) = ubound(LinStateSaveData%u_IceF) do i1 = LB(1), UB(1) - call IceFloe_UnpackInput(Buf, OutData%u_IceF(i1)) ! u_IceF + call IceFloe_DestroyInput(LinStateSaveData%u_IceF(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%u_IceF) end if - ! x_MAP - if (allocated(OutData%x_MAP)) deallocate(OutData%x_MAP) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%x_MAP(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_MAP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%x_MAP)) then + LB(1:1) = lbound(LinStateSaveData%x_MAP) + UB(1:1) = ubound(LinStateSaveData%x_MAP) do i1 = LB(1), UB(1) - call MAP_UnpackContState(Buf, OutData%x_MAP(i1)) ! x_MAP + call MAP_DestroyContState(LinStateSaveData%x_MAP(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%x_MAP) end if - ! xd_MAP - if (allocated(OutData%xd_MAP)) deallocate(OutData%xd_MAP) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%xd_MAP(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_MAP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%xd_MAP)) then + LB(1:1) = lbound(LinStateSaveData%xd_MAP) + UB(1:1) = ubound(LinStateSaveData%xd_MAP) do i1 = LB(1), UB(1) - call MAP_UnpackDiscState(Buf, OutData%xd_MAP(i1)) ! xd_MAP + call MAP_DestroyDiscState(LinStateSaveData%xd_MAP(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%xd_MAP) end if - ! z_MAP - if (allocated(OutData%z_MAP)) deallocate(OutData%z_MAP) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%z_MAP(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_MAP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%z_MAP)) then + LB(1:1) = lbound(LinStateSaveData%z_MAP) + UB(1:1) = ubound(LinStateSaveData%z_MAP) do i1 = LB(1), UB(1) - call MAP_UnpackConstrState(Buf, OutData%z_MAP(i1)) ! z_MAP + call MAP_DestroyConstrState(LinStateSaveData%z_MAP(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%z_MAP) end if - ! u_MAP - if (allocated(OutData%u_MAP)) deallocate(OutData%u_MAP) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%u_MAP(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_MAP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%u_MAP)) then + LB(1:1) = lbound(LinStateSaveData%u_MAP) + UB(1:1) = ubound(LinStateSaveData%u_MAP) do i1 = LB(1), UB(1) - call MAP_UnpackInput(Buf, OutData%u_MAP(i1)) ! u_MAP + call MAP_DestroyInput(LinStateSaveData%u_MAP(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%u_MAP) end if - ! x_FEAM - if (allocated(OutData%x_FEAM)) deallocate(OutData%x_FEAM) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%x_FEAM(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_FEAM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%x_FEAM)) then + LB(1:1) = lbound(LinStateSaveData%x_FEAM) + UB(1:1) = ubound(LinStateSaveData%x_FEAM) do i1 = LB(1), UB(1) - call FEAM_UnpackContState(Buf, OutData%x_FEAM(i1)) ! x_FEAM + call FEAM_DestroyContState(LinStateSaveData%x_FEAM(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%x_FEAM) end if - ! xd_FEAM - if (allocated(OutData%xd_FEAM)) deallocate(OutData%xd_FEAM) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%xd_FEAM(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_FEAM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%xd_FEAM)) then + LB(1:1) = lbound(LinStateSaveData%xd_FEAM) + UB(1:1) = ubound(LinStateSaveData%xd_FEAM) do i1 = LB(1), UB(1) - call FEAM_UnpackDiscState(Buf, OutData%xd_FEAM(i1)) ! xd_FEAM + call FEAM_DestroyDiscState(LinStateSaveData%xd_FEAM(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%xd_FEAM) end if - ! z_FEAM - if (allocated(OutData%z_FEAM)) deallocate(OutData%z_FEAM) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%z_FEAM(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_FEAM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%z_FEAM)) then + LB(1:1) = lbound(LinStateSaveData%z_FEAM) + UB(1:1) = ubound(LinStateSaveData%z_FEAM) do i1 = LB(1), UB(1) - call FEAM_UnpackConstrState(Buf, OutData%z_FEAM(i1)) ! z_FEAM + call FEAM_DestroyConstrState(LinStateSaveData%z_FEAM(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%z_FEAM) end if - ! OtherSt_FEAM - if (allocated(OutData%OtherSt_FEAM)) deallocate(OutData%OtherSt_FEAM) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OtherSt_FEAM(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_FEAM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%OtherSt_FEAM)) then + LB(1:1) = lbound(LinStateSaveData%OtherSt_FEAM) + UB(1:1) = ubound(LinStateSaveData%OtherSt_FEAM) do i1 = LB(1), UB(1) - call FEAM_UnpackOtherState(Buf, OutData%OtherSt_FEAM(i1)) ! OtherSt_FEAM + call FEAM_DestroyOtherState(LinStateSaveData%OtherSt_FEAM(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%OtherSt_FEAM) end if - ! u_FEAM - if (allocated(OutData%u_FEAM)) deallocate(OutData%u_FEAM) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%u_FEAM(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_FEAM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%u_FEAM)) then + LB(1:1) = lbound(LinStateSaveData%u_FEAM) + UB(1:1) = ubound(LinStateSaveData%u_FEAM) do i1 = LB(1), UB(1) - call FEAM_UnpackInput(Buf, OutData%u_FEAM(i1)) ! u_FEAM + call FEAM_DestroyInput(LinStateSaveData%u_FEAM(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%u_FEAM) end if - ! x_MD - if (allocated(OutData%x_MD)) deallocate(OutData%x_MD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%x_MD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_MD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%x_MD)) then + LB(1:1) = lbound(LinStateSaveData%x_MD) + UB(1:1) = ubound(LinStateSaveData%x_MD) do i1 = LB(1), UB(1) - call MD_UnpackContState(Buf, OutData%x_MD(i1)) ! x_MD + call MD_DestroyContState(LinStateSaveData%x_MD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%x_MD) end if - ! xd_MD - if (allocated(OutData%xd_MD)) deallocate(OutData%xd_MD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%xd_MD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_MD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%xd_MD)) then + LB(1:1) = lbound(LinStateSaveData%xd_MD) + UB(1:1) = ubound(LinStateSaveData%xd_MD) do i1 = LB(1), UB(1) - call MD_UnpackDiscState(Buf, OutData%xd_MD(i1)) ! xd_MD + call MD_DestroyDiscState(LinStateSaveData%xd_MD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%xd_MD) end if - ! z_MD - if (allocated(OutData%z_MD)) deallocate(OutData%z_MD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%z_MD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_MD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%z_MD)) then + LB(1:1) = lbound(LinStateSaveData%z_MD) + UB(1:1) = ubound(LinStateSaveData%z_MD) do i1 = LB(1), UB(1) - call MD_UnpackConstrState(Buf, OutData%z_MD(i1)) ! z_MD + call MD_DestroyConstrState(LinStateSaveData%z_MD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%z_MD) end if - ! OtherSt_MD - if (allocated(OutData%OtherSt_MD)) deallocate(OutData%OtherSt_MD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OtherSt_MD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_MD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%OtherSt_MD)) then + LB(1:1) = lbound(LinStateSaveData%OtherSt_MD) + UB(1:1) = ubound(LinStateSaveData%OtherSt_MD) do i1 = LB(1), UB(1) - call MD_UnpackOtherState(Buf, OutData%OtherSt_MD(i1)) ! OtherSt_MD + call MD_DestroyOtherState(LinStateSaveData%OtherSt_MD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%OtherSt_MD) end if - ! u_MD - if (allocated(OutData%u_MD)) deallocate(OutData%u_MD) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%u_MD(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_MD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(LinStateSaveData%u_MD)) then + LB(1:1) = lbound(LinStateSaveData%u_MD) + UB(1:1) = ubound(LinStateSaveData%u_MD) do i1 = LB(1), UB(1) - call MD_UnpackInput(Buf, OutData%u_MD(i1)) ! u_MD + call MD_DestroyInput(LinStateSaveData%u_MD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(LinStateSaveData%u_MD) end if end subroutine - SUBROUTINE FAST_CopyLinType( SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_LinType), INTENT(IN) :: SrcLinTypeData - TYPE(FAST_LinType), INTENT(INOUT) :: DstLinTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyLinType' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcLinTypeData%Names_u)) THEN - i1_l = LBOUND(SrcLinTypeData%Names_u,1) - i1_u = UBOUND(SrcLinTypeData%Names_u,1) - IF (.NOT. ALLOCATED(DstLinTypeData%Names_u)) THEN - ALLOCATE(DstLinTypeData%Names_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%Names_u = SrcLinTypeData%Names_u -ENDIF -IF (ALLOCATED(SrcLinTypeData%Names_y)) THEN - i1_l = LBOUND(SrcLinTypeData%Names_y,1) - i1_u = UBOUND(SrcLinTypeData%Names_y,1) - IF (.NOT. ALLOCATED(DstLinTypeData%Names_y)) THEN - ALLOCATE(DstLinTypeData%Names_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%Names_y = SrcLinTypeData%Names_y -ENDIF -IF (ALLOCATED(SrcLinTypeData%Names_x)) THEN - i1_l = LBOUND(SrcLinTypeData%Names_x,1) - i1_u = UBOUND(SrcLinTypeData%Names_x,1) - IF (.NOT. ALLOCATED(DstLinTypeData%Names_x)) THEN - ALLOCATE(DstLinTypeData%Names_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%Names_x = SrcLinTypeData%Names_x -ENDIF -IF (ALLOCATED(SrcLinTypeData%Names_xd)) THEN - i1_l = LBOUND(SrcLinTypeData%Names_xd,1) - i1_u = UBOUND(SrcLinTypeData%Names_xd,1) - IF (.NOT. ALLOCATED(DstLinTypeData%Names_xd)) THEN - ALLOCATE(DstLinTypeData%Names_xd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%Names_xd = SrcLinTypeData%Names_xd -ENDIF -IF (ALLOCATED(SrcLinTypeData%Names_z)) THEN - i1_l = LBOUND(SrcLinTypeData%Names_z,1) - i1_u = UBOUND(SrcLinTypeData%Names_z,1) - IF (.NOT. ALLOCATED(DstLinTypeData%Names_z)) THEN - ALLOCATE(DstLinTypeData%Names_z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%Names_z = SrcLinTypeData%Names_z -ENDIF -IF (ALLOCATED(SrcLinTypeData%op_u)) THEN - i1_l = LBOUND(SrcLinTypeData%op_u,1) - i1_u = UBOUND(SrcLinTypeData%op_u,1) - IF (.NOT. ALLOCATED(DstLinTypeData%op_u)) THEN - ALLOCATE(DstLinTypeData%op_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%op_u = SrcLinTypeData%op_u -ENDIF -IF (ALLOCATED(SrcLinTypeData%op_y)) THEN - i1_l = LBOUND(SrcLinTypeData%op_y,1) - i1_u = UBOUND(SrcLinTypeData%op_y,1) - IF (.NOT. ALLOCATED(DstLinTypeData%op_y)) THEN - ALLOCATE(DstLinTypeData%op_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%op_y = SrcLinTypeData%op_y -ENDIF -IF (ALLOCATED(SrcLinTypeData%op_x)) THEN - i1_l = LBOUND(SrcLinTypeData%op_x,1) - i1_u = UBOUND(SrcLinTypeData%op_x,1) - IF (.NOT. ALLOCATED(DstLinTypeData%op_x)) THEN - ALLOCATE(DstLinTypeData%op_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%op_x = SrcLinTypeData%op_x -ENDIF -IF (ALLOCATED(SrcLinTypeData%op_dx)) THEN - i1_l = LBOUND(SrcLinTypeData%op_dx,1) - i1_u = UBOUND(SrcLinTypeData%op_dx,1) - IF (.NOT. ALLOCATED(DstLinTypeData%op_dx)) THEN - ALLOCATE(DstLinTypeData%op_dx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_dx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%op_dx = SrcLinTypeData%op_dx -ENDIF -IF (ALLOCATED(SrcLinTypeData%op_xd)) THEN - i1_l = LBOUND(SrcLinTypeData%op_xd,1) - i1_u = UBOUND(SrcLinTypeData%op_xd,1) - IF (.NOT. ALLOCATED(DstLinTypeData%op_xd)) THEN - ALLOCATE(DstLinTypeData%op_xd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%op_xd = SrcLinTypeData%op_xd -ENDIF -IF (ALLOCATED(SrcLinTypeData%op_z)) THEN - i1_l = LBOUND(SrcLinTypeData%op_z,1) - i1_u = UBOUND(SrcLinTypeData%op_z,1) - IF (.NOT. ALLOCATED(DstLinTypeData%op_z)) THEN - ALLOCATE(DstLinTypeData%op_z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%op_z = SrcLinTypeData%op_z -ENDIF -IF (ALLOCATED(SrcLinTypeData%op_x_eig_mag)) THEN - i1_l = LBOUND(SrcLinTypeData%op_x_eig_mag,1) - i1_u = UBOUND(SrcLinTypeData%op_x_eig_mag,1) - IF (.NOT. ALLOCATED(DstLinTypeData%op_x_eig_mag)) THEN - ALLOCATE(DstLinTypeData%op_x_eig_mag(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_x_eig_mag.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%op_x_eig_mag = SrcLinTypeData%op_x_eig_mag -ENDIF -IF (ALLOCATED(SrcLinTypeData%op_x_eig_phase)) THEN - i1_l = LBOUND(SrcLinTypeData%op_x_eig_phase,1) - i1_u = UBOUND(SrcLinTypeData%op_x_eig_phase,1) - IF (.NOT. ALLOCATED(DstLinTypeData%op_x_eig_phase)) THEN - ALLOCATE(DstLinTypeData%op_x_eig_phase(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_x_eig_phase.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%op_x_eig_phase = SrcLinTypeData%op_x_eig_phase -ENDIF -IF (ALLOCATED(SrcLinTypeData%Use_u)) THEN - i1_l = LBOUND(SrcLinTypeData%Use_u,1) - i1_u = UBOUND(SrcLinTypeData%Use_u,1) - IF (.NOT. ALLOCATED(DstLinTypeData%Use_u)) THEN - ALLOCATE(DstLinTypeData%Use_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Use_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%Use_u = SrcLinTypeData%Use_u -ENDIF -IF (ALLOCATED(SrcLinTypeData%Use_y)) THEN - i1_l = LBOUND(SrcLinTypeData%Use_y,1) - i1_u = UBOUND(SrcLinTypeData%Use_y,1) - IF (.NOT. ALLOCATED(DstLinTypeData%Use_y)) THEN - ALLOCATE(DstLinTypeData%Use_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Use_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%Use_y = SrcLinTypeData%Use_y -ENDIF -IF (ALLOCATED(SrcLinTypeData%A)) THEN - i1_l = LBOUND(SrcLinTypeData%A,1) - i1_u = UBOUND(SrcLinTypeData%A,1) - i2_l = LBOUND(SrcLinTypeData%A,2) - i2_u = UBOUND(SrcLinTypeData%A,2) - IF (.NOT. ALLOCATED(DstLinTypeData%A)) THEN - ALLOCATE(DstLinTypeData%A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%A.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%A = SrcLinTypeData%A -ENDIF -IF (ALLOCATED(SrcLinTypeData%B)) THEN - i1_l = LBOUND(SrcLinTypeData%B,1) - i1_u = UBOUND(SrcLinTypeData%B,1) - i2_l = LBOUND(SrcLinTypeData%B,2) - i2_u = UBOUND(SrcLinTypeData%B,2) - IF (.NOT. ALLOCATED(DstLinTypeData%B)) THEN - ALLOCATE(DstLinTypeData%B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%B = SrcLinTypeData%B -ENDIF -IF (ALLOCATED(SrcLinTypeData%C)) THEN - i1_l = LBOUND(SrcLinTypeData%C,1) - i1_u = UBOUND(SrcLinTypeData%C,1) - i2_l = LBOUND(SrcLinTypeData%C,2) - i2_u = UBOUND(SrcLinTypeData%C,2) - IF (.NOT. ALLOCATED(DstLinTypeData%C)) THEN - ALLOCATE(DstLinTypeData%C(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%C.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%C = SrcLinTypeData%C -ENDIF -IF (ALLOCATED(SrcLinTypeData%D)) THEN - i1_l = LBOUND(SrcLinTypeData%D,1) - i1_u = UBOUND(SrcLinTypeData%D,1) - i2_l = LBOUND(SrcLinTypeData%D,2) - i2_u = UBOUND(SrcLinTypeData%D,2) - IF (.NOT. ALLOCATED(DstLinTypeData%D)) THEN - ALLOCATE(DstLinTypeData%D(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%D.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%D = SrcLinTypeData%D -ENDIF -IF (ALLOCATED(SrcLinTypeData%StateRotation)) THEN - i1_l = LBOUND(SrcLinTypeData%StateRotation,1) - i1_u = UBOUND(SrcLinTypeData%StateRotation,1) - i2_l = LBOUND(SrcLinTypeData%StateRotation,2) - i2_u = UBOUND(SrcLinTypeData%StateRotation,2) - IF (.NOT. ALLOCATED(DstLinTypeData%StateRotation)) THEN - ALLOCATE(DstLinTypeData%StateRotation(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%StateRotation.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%StateRotation = SrcLinTypeData%StateRotation -ENDIF -IF (ALLOCATED(SrcLinTypeData%StateRel_x)) THEN - i1_l = LBOUND(SrcLinTypeData%StateRel_x,1) - i1_u = UBOUND(SrcLinTypeData%StateRel_x,1) - i2_l = LBOUND(SrcLinTypeData%StateRel_x,2) - i2_u = UBOUND(SrcLinTypeData%StateRel_x,2) - IF (.NOT. ALLOCATED(DstLinTypeData%StateRel_x)) THEN - ALLOCATE(DstLinTypeData%StateRel_x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%StateRel_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%StateRel_x = SrcLinTypeData%StateRel_x -ENDIF -IF (ALLOCATED(SrcLinTypeData%StateRel_xdot)) THEN - i1_l = LBOUND(SrcLinTypeData%StateRel_xdot,1) - i1_u = UBOUND(SrcLinTypeData%StateRel_xdot,1) - i2_l = LBOUND(SrcLinTypeData%StateRel_xdot,2) - i2_u = UBOUND(SrcLinTypeData%StateRel_xdot,2) - IF (.NOT. ALLOCATED(DstLinTypeData%StateRel_xdot)) THEN - ALLOCATE(DstLinTypeData%StateRel_xdot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%StateRel_xdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%StateRel_xdot = SrcLinTypeData%StateRel_xdot -ENDIF -IF (ALLOCATED(SrcLinTypeData%IsLoad_u)) THEN - i1_l = LBOUND(SrcLinTypeData%IsLoad_u,1) - i1_u = UBOUND(SrcLinTypeData%IsLoad_u,1) - IF (.NOT. ALLOCATED(DstLinTypeData%IsLoad_u)) THEN - ALLOCATE(DstLinTypeData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%IsLoad_u = SrcLinTypeData%IsLoad_u -ENDIF -IF (ALLOCATED(SrcLinTypeData%RotFrame_u)) THEN - i1_l = LBOUND(SrcLinTypeData%RotFrame_u,1) - i1_u = UBOUND(SrcLinTypeData%RotFrame_u,1) - IF (.NOT. ALLOCATED(DstLinTypeData%RotFrame_u)) THEN - ALLOCATE(DstLinTypeData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%RotFrame_u = SrcLinTypeData%RotFrame_u -ENDIF -IF (ALLOCATED(SrcLinTypeData%RotFrame_y)) THEN - i1_l = LBOUND(SrcLinTypeData%RotFrame_y,1) - i1_u = UBOUND(SrcLinTypeData%RotFrame_y,1) - IF (.NOT. ALLOCATED(DstLinTypeData%RotFrame_y)) THEN - ALLOCATE(DstLinTypeData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%RotFrame_y = SrcLinTypeData%RotFrame_y -ENDIF -IF (ALLOCATED(SrcLinTypeData%RotFrame_x)) THEN - i1_l = LBOUND(SrcLinTypeData%RotFrame_x,1) - i1_u = UBOUND(SrcLinTypeData%RotFrame_x,1) - IF (.NOT. ALLOCATED(DstLinTypeData%RotFrame_x)) THEN - ALLOCATE(DstLinTypeData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%RotFrame_x = SrcLinTypeData%RotFrame_x -ENDIF -IF (ALLOCATED(SrcLinTypeData%RotFrame_z)) THEN - i1_l = LBOUND(SrcLinTypeData%RotFrame_z,1) - i1_u = UBOUND(SrcLinTypeData%RotFrame_z,1) - IF (.NOT. ALLOCATED(DstLinTypeData%RotFrame_z)) THEN - ALLOCATE(DstLinTypeData%RotFrame_z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%RotFrame_z = SrcLinTypeData%RotFrame_z -ENDIF -IF (ALLOCATED(SrcLinTypeData%DerivOrder_x)) THEN - i1_l = LBOUND(SrcLinTypeData%DerivOrder_x,1) - i1_u = UBOUND(SrcLinTypeData%DerivOrder_x,1) - IF (.NOT. ALLOCATED(DstLinTypeData%DerivOrder_x)) THEN - ALLOCATE(DstLinTypeData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLinTypeData%DerivOrder_x = SrcLinTypeData%DerivOrder_x -ENDIF - DstLinTypeData%SizeLin = SrcLinTypeData%SizeLin - DstLinTypeData%LinStartIndx = SrcLinTypeData%LinStartIndx - DstLinTypeData%NumOutputs = SrcLinTypeData%NumOutputs - END SUBROUTINE FAST_CopyLinType - - SUBROUTINE FAST_DestroyLinType( LinTypeData, ErrStat, ErrMsg ) - TYPE(FAST_LinType), INTENT(INOUT) :: LinTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyLinType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(LinTypeData%Names_u)) THEN - DEALLOCATE(LinTypeData%Names_u) -ENDIF -IF (ALLOCATED(LinTypeData%Names_y)) THEN - DEALLOCATE(LinTypeData%Names_y) -ENDIF -IF (ALLOCATED(LinTypeData%Names_x)) THEN - DEALLOCATE(LinTypeData%Names_x) -ENDIF -IF (ALLOCATED(LinTypeData%Names_xd)) THEN - DEALLOCATE(LinTypeData%Names_xd) -ENDIF -IF (ALLOCATED(LinTypeData%Names_z)) THEN - DEALLOCATE(LinTypeData%Names_z) -ENDIF -IF (ALLOCATED(LinTypeData%op_u)) THEN - DEALLOCATE(LinTypeData%op_u) -ENDIF -IF (ALLOCATED(LinTypeData%op_y)) THEN - DEALLOCATE(LinTypeData%op_y) -ENDIF -IF (ALLOCATED(LinTypeData%op_x)) THEN - DEALLOCATE(LinTypeData%op_x) -ENDIF -IF (ALLOCATED(LinTypeData%op_dx)) THEN - DEALLOCATE(LinTypeData%op_dx) -ENDIF -IF (ALLOCATED(LinTypeData%op_xd)) THEN - DEALLOCATE(LinTypeData%op_xd) -ENDIF -IF (ALLOCATED(LinTypeData%op_z)) THEN - DEALLOCATE(LinTypeData%op_z) -ENDIF -IF (ALLOCATED(LinTypeData%op_x_eig_mag)) THEN - DEALLOCATE(LinTypeData%op_x_eig_mag) -ENDIF -IF (ALLOCATED(LinTypeData%op_x_eig_phase)) THEN - DEALLOCATE(LinTypeData%op_x_eig_phase) -ENDIF -IF (ALLOCATED(LinTypeData%Use_u)) THEN - DEALLOCATE(LinTypeData%Use_u) -ENDIF -IF (ALLOCATED(LinTypeData%Use_y)) THEN - DEALLOCATE(LinTypeData%Use_y) -ENDIF -IF (ALLOCATED(LinTypeData%A)) THEN - DEALLOCATE(LinTypeData%A) -ENDIF -IF (ALLOCATED(LinTypeData%B)) THEN - DEALLOCATE(LinTypeData%B) -ENDIF -IF (ALLOCATED(LinTypeData%C)) THEN - DEALLOCATE(LinTypeData%C) -ENDIF -IF (ALLOCATED(LinTypeData%D)) THEN - DEALLOCATE(LinTypeData%D) -ENDIF -IF (ALLOCATED(LinTypeData%StateRotation)) THEN - DEALLOCATE(LinTypeData%StateRotation) -ENDIF -IF (ALLOCATED(LinTypeData%StateRel_x)) THEN - DEALLOCATE(LinTypeData%StateRel_x) -ENDIF -IF (ALLOCATED(LinTypeData%StateRel_xdot)) THEN - DEALLOCATE(LinTypeData%StateRel_xdot) -ENDIF -IF (ALLOCATED(LinTypeData%IsLoad_u)) THEN - DEALLOCATE(LinTypeData%IsLoad_u) -ENDIF -IF (ALLOCATED(LinTypeData%RotFrame_u)) THEN - DEALLOCATE(LinTypeData%RotFrame_u) -ENDIF -IF (ALLOCATED(LinTypeData%RotFrame_y)) THEN - DEALLOCATE(LinTypeData%RotFrame_y) -ENDIF -IF (ALLOCATED(LinTypeData%RotFrame_x)) THEN - DEALLOCATE(LinTypeData%RotFrame_x) -ENDIF -IF (ALLOCATED(LinTypeData%RotFrame_z)) THEN - DEALLOCATE(LinTypeData%RotFrame_z) -ENDIF -IF (ALLOCATED(LinTypeData%DerivOrder_x)) THEN - DEALLOCATE(LinTypeData%DerivOrder_x) -ENDIF - END SUBROUTINE FAST_DestroyLinType - -subroutine FAST_PackLinType(Buf, Indata) +subroutine FAST_PackLinStateSave(Buf, Indata) type(PackBuffer), intent(inout) :: Buf - type(FAST_LinType), intent(in) :: InData - character(*), parameter :: RoutineName = 'FAST_PackLinType' + type(FAST_LinStateSave), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackLinStateSave' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return - ! Names_u - call RegPack(Buf, allocated(InData%Names_u)) - if (allocated(InData%Names_u)) then - call RegPackBounds(Buf, 1, lbound(InData%Names_u), ubound(InData%Names_u)) - call RegPack(Buf, InData%Names_u) - end if - if (RegCheckErr(Buf, RoutineName)) return - ! Names_y - call RegPack(Buf, allocated(InData%Names_y)) - if (allocated(InData%Names_y)) then - call RegPackBounds(Buf, 1, lbound(InData%Names_y), ubound(InData%Names_y)) - call RegPack(Buf, InData%Names_y) - end if - if (RegCheckErr(Buf, RoutineName)) return - ! Names_x - call RegPack(Buf, allocated(InData%Names_x)) - if (allocated(InData%Names_x)) then - call RegPackBounds(Buf, 1, lbound(InData%Names_x), ubound(InData%Names_x)) - call RegPack(Buf, InData%Names_x) + call RegPack(Buf, allocated(InData%x_IceD)) + if (allocated(InData%x_IceD)) then + call RegPackBounds(Buf, 2, lbound(InData%x_IceD), ubound(InData%x_IceD)) + LB(1:2) = lbound(InData%x_IceD) + UB(1:2) = ubound(InData%x_IceD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_PackContState(Buf, InData%x_IceD(i1,i2)) + end do + end do end if if (RegCheckErr(Buf, RoutineName)) return - ! Names_xd - call RegPack(Buf, allocated(InData%Names_xd)) - if (allocated(InData%Names_xd)) then - call RegPackBounds(Buf, 1, lbound(InData%Names_xd), ubound(InData%Names_xd)) - call RegPack(Buf, InData%Names_xd) - end if - if (RegCheckErr(Buf, RoutineName)) return - ! Names_z - call RegPack(Buf, allocated(InData%Names_z)) - if (allocated(InData%Names_z)) then - call RegPackBounds(Buf, 1, lbound(InData%Names_z), ubound(InData%Names_z)) - call RegPack(Buf, InData%Names_z) + call RegPack(Buf, allocated(InData%xd_IceD)) + if (allocated(InData%xd_IceD)) then + call RegPackBounds(Buf, 2, lbound(InData%xd_IceD), ubound(InData%xd_IceD)) + LB(1:2) = lbound(InData%xd_IceD) + UB(1:2) = ubound(InData%xd_IceD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_PackDiscState(Buf, InData%xd_IceD(i1,i2)) + end do + end do end if if (RegCheckErr(Buf, RoutineName)) return - ! op_u - call RegPack(Buf, allocated(InData%op_u)) - if (allocated(InData%op_u)) then - call RegPackBounds(Buf, 1, lbound(InData%op_u), ubound(InData%op_u)) - call RegPack(Buf, InData%op_u) + call RegPack(Buf, allocated(InData%z_IceD)) + if (allocated(InData%z_IceD)) then + call RegPackBounds(Buf, 2, lbound(InData%z_IceD), ubound(InData%z_IceD)) + LB(1:2) = lbound(InData%z_IceD) + UB(1:2) = ubound(InData%z_IceD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_PackConstrState(Buf, InData%z_IceD(i1,i2)) + end do + end do end if if (RegCheckErr(Buf, RoutineName)) return - ! op_y - call RegPack(Buf, allocated(InData%op_y)) - if (allocated(InData%op_y)) then - call RegPackBounds(Buf, 1, lbound(InData%op_y), ubound(InData%op_y)) - call RegPack(Buf, InData%op_y) + call RegPack(Buf, allocated(InData%OtherSt_IceD)) + if (allocated(InData%OtherSt_IceD)) then + call RegPackBounds(Buf, 2, lbound(InData%OtherSt_IceD), ubound(InData%OtherSt_IceD)) + LB(1:2) = lbound(InData%OtherSt_IceD) + UB(1:2) = ubound(InData%OtherSt_IceD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_PackOtherState(Buf, InData%OtherSt_IceD(i1,i2)) + end do + end do end if if (RegCheckErr(Buf, RoutineName)) return - ! op_x - call RegPack(Buf, allocated(InData%op_x)) - if (allocated(InData%op_x)) then - call RegPackBounds(Buf, 1, lbound(InData%op_x), ubound(InData%op_x)) - call RegPack(Buf, InData%op_x) + call RegPack(Buf, allocated(InData%u_IceD)) + if (allocated(InData%u_IceD)) then + call RegPackBounds(Buf, 2, lbound(InData%u_IceD), ubound(InData%u_IceD)) + LB(1:2) = lbound(InData%u_IceD) + UB(1:2) = ubound(InData%u_IceD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_PackInput(Buf, InData%u_IceD(i1,i2)) + end do + end do end if if (RegCheckErr(Buf, RoutineName)) return - ! op_dx - call RegPack(Buf, allocated(InData%op_dx)) - if (allocated(InData%op_dx)) then - call RegPackBounds(Buf, 1, lbound(InData%op_dx), ubound(InData%op_dx)) - call RegPack(Buf, InData%op_dx) + call RegPack(Buf, allocated(InData%x_BD)) + if (allocated(InData%x_BD)) then + call RegPackBounds(Buf, 2, lbound(InData%x_BD), ubound(InData%x_BD)) + LB(1:2) = lbound(InData%x_BD) + UB(1:2) = ubound(InData%x_BD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_PackContState(Buf, InData%x_BD(i1,i2)) + end do + end do end if if (RegCheckErr(Buf, RoutineName)) return - ! op_xd - call RegPack(Buf, allocated(InData%op_xd)) - if (allocated(InData%op_xd)) then - call RegPackBounds(Buf, 1, lbound(InData%op_xd), ubound(InData%op_xd)) - call RegPack(Buf, InData%op_xd) + call RegPack(Buf, allocated(InData%xd_BD)) + if (allocated(InData%xd_BD)) then + call RegPackBounds(Buf, 2, lbound(InData%xd_BD), ubound(InData%xd_BD)) + LB(1:2) = lbound(InData%xd_BD) + UB(1:2) = ubound(InData%xd_BD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_PackDiscState(Buf, InData%xd_BD(i1,i2)) + end do + end do end if if (RegCheckErr(Buf, RoutineName)) return - ! op_z - call RegPack(Buf, allocated(InData%op_z)) - if (allocated(InData%op_z)) then - call RegPackBounds(Buf, 1, lbound(InData%op_z), ubound(InData%op_z)) - call RegPack(Buf, InData%op_z) + call RegPack(Buf, allocated(InData%z_BD)) + if (allocated(InData%z_BD)) then + call RegPackBounds(Buf, 2, lbound(InData%z_BD), ubound(InData%z_BD)) + LB(1:2) = lbound(InData%z_BD) + UB(1:2) = ubound(InData%z_BD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_PackConstrState(Buf, InData%z_BD(i1,i2)) + end do + end do end if if (RegCheckErr(Buf, RoutineName)) return - ! op_x_eig_mag - call RegPack(Buf, allocated(InData%op_x_eig_mag)) - if (allocated(InData%op_x_eig_mag)) then - call RegPackBounds(Buf, 1, lbound(InData%op_x_eig_mag), ubound(InData%op_x_eig_mag)) - call RegPack(Buf, InData%op_x_eig_mag) + call RegPack(Buf, allocated(InData%OtherSt_BD)) + if (allocated(InData%OtherSt_BD)) then + call RegPackBounds(Buf, 2, lbound(InData%OtherSt_BD), ubound(InData%OtherSt_BD)) + LB(1:2) = lbound(InData%OtherSt_BD) + UB(1:2) = ubound(InData%OtherSt_BD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_PackOtherState(Buf, InData%OtherSt_BD(i1,i2)) + end do + end do end if if (RegCheckErr(Buf, RoutineName)) return - ! op_x_eig_phase - call RegPack(Buf, allocated(InData%op_x_eig_phase)) - if (allocated(InData%op_x_eig_phase)) then - call RegPackBounds(Buf, 1, lbound(InData%op_x_eig_phase), ubound(InData%op_x_eig_phase)) - call RegPack(Buf, InData%op_x_eig_phase) + call RegPack(Buf, allocated(InData%u_BD)) + if (allocated(InData%u_BD)) then + call RegPackBounds(Buf, 2, lbound(InData%u_BD), ubound(InData%u_BD)) + LB(1:2) = lbound(InData%u_BD) + UB(1:2) = ubound(InData%u_BD) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_PackInput(Buf, InData%u_BD(i1,i2)) + end do + end do end if if (RegCheckErr(Buf, RoutineName)) return - ! Use_u - call RegPack(Buf, allocated(InData%Use_u)) - if (allocated(InData%Use_u)) then - call RegPackBounds(Buf, 1, lbound(InData%Use_u), ubound(InData%Use_u)) - call RegPack(Buf, InData%Use_u) + call RegPack(Buf, allocated(InData%x_ED)) + if (allocated(InData%x_ED)) then + call RegPackBounds(Buf, 1, lbound(InData%x_ED), ubound(InData%x_ED)) + LB(1:1) = lbound(InData%x_ED) + UB(1:1) = ubound(InData%x_ED) + do i1 = LB(1), UB(1) + call ED_PackContState(Buf, InData%x_ED(i1)) + end do end if if (RegCheckErr(Buf, RoutineName)) return - ! Use_y - call RegPack(Buf, allocated(InData%Use_y)) - if (allocated(InData%Use_y)) then - call RegPackBounds(Buf, 1, lbound(InData%Use_y), ubound(InData%Use_y)) - call RegPack(Buf, InData%Use_y) + call RegPack(Buf, allocated(InData%xd_ED)) + if (allocated(InData%xd_ED)) then + call RegPackBounds(Buf, 1, lbound(InData%xd_ED), ubound(InData%xd_ED)) + LB(1:1) = lbound(InData%xd_ED) + UB(1:1) = ubound(InData%xd_ED) + do i1 = LB(1), UB(1) + call ED_PackDiscState(Buf, InData%xd_ED(i1)) + end do end if if (RegCheckErr(Buf, RoutineName)) return - ! A - call RegPack(Buf, allocated(InData%A)) - if (allocated(InData%A)) then - call RegPackBounds(Buf, 2, lbound(InData%A), ubound(InData%A)) - call RegPack(Buf, InData%A) + call RegPack(Buf, allocated(InData%z_ED)) + if (allocated(InData%z_ED)) then + call RegPackBounds(Buf, 1, lbound(InData%z_ED), ubound(InData%z_ED)) + LB(1:1) = lbound(InData%z_ED) + UB(1:1) = ubound(InData%z_ED) + do i1 = LB(1), UB(1) + call ED_PackConstrState(Buf, InData%z_ED(i1)) + end do end if if (RegCheckErr(Buf, RoutineName)) return - ! B - call RegPack(Buf, allocated(InData%B)) - if (allocated(InData%B)) then - call RegPackBounds(Buf, 2, lbound(InData%B), ubound(InData%B)) - call RegPack(Buf, InData%B) + call RegPack(Buf, allocated(InData%OtherSt_ED)) + if (allocated(InData%OtherSt_ED)) then + call RegPackBounds(Buf, 1, lbound(InData%OtherSt_ED), ubound(InData%OtherSt_ED)) + LB(1:1) = lbound(InData%OtherSt_ED) + UB(1:1) = ubound(InData%OtherSt_ED) + do i1 = LB(1), UB(1) + call ED_PackOtherState(Buf, InData%OtherSt_ED(i1)) + end do end if if (RegCheckErr(Buf, RoutineName)) return - ! C - call RegPack(Buf, allocated(InData%C)) - if (allocated(InData%C)) then - call RegPackBounds(Buf, 2, lbound(InData%C), ubound(InData%C)) - call RegPack(Buf, InData%C) + call RegPack(Buf, allocated(InData%u_ED)) + if (allocated(InData%u_ED)) then + call RegPackBounds(Buf, 1, lbound(InData%u_ED), ubound(InData%u_ED)) + LB(1:1) = lbound(InData%u_ED) + UB(1:1) = ubound(InData%u_ED) + do i1 = LB(1), UB(1) + call ED_PackInput(Buf, InData%u_ED(i1)) + end do end if if (RegCheckErr(Buf, RoutineName)) return - ! D - call RegPack(Buf, allocated(InData%D)) - if (allocated(InData%D)) then - call RegPackBounds(Buf, 2, lbound(InData%D), ubound(InData%D)) - call RegPack(Buf, InData%D) + call RegPack(Buf, allocated(InData%x_SrvD)) + if (allocated(InData%x_SrvD)) then + call RegPackBounds(Buf, 1, lbound(InData%x_SrvD), ubound(InData%x_SrvD)) + LB(1:1) = lbound(InData%x_SrvD) + UB(1:1) = ubound(InData%x_SrvD) + do i1 = LB(1), UB(1) + call SrvD_PackContState(Buf, InData%x_SrvD(i1)) + end do end if if (RegCheckErr(Buf, RoutineName)) return - ! StateRotation - call RegPack(Buf, allocated(InData%StateRotation)) - if (allocated(InData%StateRotation)) then - call RegPackBounds(Buf, 2, lbound(InData%StateRotation), ubound(InData%StateRotation)) - call RegPack(Buf, InData%StateRotation) + call RegPack(Buf, allocated(InData%xd_SrvD)) + if (allocated(InData%xd_SrvD)) then + call RegPackBounds(Buf, 1, lbound(InData%xd_SrvD), ubound(InData%xd_SrvD)) + LB(1:1) = lbound(InData%xd_SrvD) + UB(1:1) = ubound(InData%xd_SrvD) + do i1 = LB(1), UB(1) + call SrvD_PackDiscState(Buf, InData%xd_SrvD(i1)) + end do end if if (RegCheckErr(Buf, RoutineName)) return - ! StateRel_x - call RegPack(Buf, allocated(InData%StateRel_x)) - if (allocated(InData%StateRel_x)) then - call RegPackBounds(Buf, 2, lbound(InData%StateRel_x), ubound(InData%StateRel_x)) - call RegPack(Buf, InData%StateRel_x) + call RegPack(Buf, allocated(InData%z_SrvD)) + if (allocated(InData%z_SrvD)) then + call RegPackBounds(Buf, 1, lbound(InData%z_SrvD), ubound(InData%z_SrvD)) + LB(1:1) = lbound(InData%z_SrvD) + UB(1:1) = ubound(InData%z_SrvD) + do i1 = LB(1), UB(1) + call SrvD_PackConstrState(Buf, InData%z_SrvD(i1)) + end do end if if (RegCheckErr(Buf, RoutineName)) return - ! StateRel_xdot - call RegPack(Buf, allocated(InData%StateRel_xdot)) - if (allocated(InData%StateRel_xdot)) then - call RegPackBounds(Buf, 2, lbound(InData%StateRel_xdot), ubound(InData%StateRel_xdot)) - call RegPack(Buf, InData%StateRel_xdot) + call RegPack(Buf, allocated(InData%OtherSt_SrvD)) + if (allocated(InData%OtherSt_SrvD)) then + call RegPackBounds(Buf, 1, lbound(InData%OtherSt_SrvD), ubound(InData%OtherSt_SrvD)) + LB(1:1) = lbound(InData%OtherSt_SrvD) + UB(1:1) = ubound(InData%OtherSt_SrvD) + do i1 = LB(1), UB(1) + call SrvD_PackOtherState(Buf, InData%OtherSt_SrvD(i1)) + end do end if if (RegCheckErr(Buf, RoutineName)) return - ! IsLoad_u - call RegPack(Buf, allocated(InData%IsLoad_u)) - if (allocated(InData%IsLoad_u)) then - call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) - call RegPack(Buf, InData%IsLoad_u) + call RegPack(Buf, allocated(InData%u_SrvD)) + if (allocated(InData%u_SrvD)) then + call RegPackBounds(Buf, 1, lbound(InData%u_SrvD), ubound(InData%u_SrvD)) + LB(1:1) = lbound(InData%u_SrvD) + UB(1:1) = ubound(InData%u_SrvD) + do i1 = LB(1), UB(1) + call SrvD_PackInput(Buf, InData%u_SrvD(i1)) + end do end if if (RegCheckErr(Buf, RoutineName)) return - ! RotFrame_u - call RegPack(Buf, allocated(InData%RotFrame_u)) - if (allocated(InData%RotFrame_u)) then - call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u), ubound(InData%RotFrame_u)) - call RegPack(Buf, InData%RotFrame_u) + call RegPack(Buf, allocated(InData%x_AD)) + if (allocated(InData%x_AD)) then + call RegPackBounds(Buf, 1, lbound(InData%x_AD), ubound(InData%x_AD)) + LB(1:1) = lbound(InData%x_AD) + UB(1:1) = ubound(InData%x_AD) + do i1 = LB(1), UB(1) + call AD_PackContState(Buf, InData%x_AD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%xd_AD)) + if (allocated(InData%xd_AD)) then + call RegPackBounds(Buf, 1, lbound(InData%xd_AD), ubound(InData%xd_AD)) + LB(1:1) = lbound(InData%xd_AD) + UB(1:1) = ubound(InData%xd_AD) + do i1 = LB(1), UB(1) + call AD_PackDiscState(Buf, InData%xd_AD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%z_AD)) + if (allocated(InData%z_AD)) then + call RegPackBounds(Buf, 1, lbound(InData%z_AD), ubound(InData%z_AD)) + LB(1:1) = lbound(InData%z_AD) + UB(1:1) = ubound(InData%z_AD) + do i1 = LB(1), UB(1) + call AD_PackConstrState(Buf, InData%z_AD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%OtherSt_AD)) + if (allocated(InData%OtherSt_AD)) then + call RegPackBounds(Buf, 1, lbound(InData%OtherSt_AD), ubound(InData%OtherSt_AD)) + LB(1:1) = lbound(InData%OtherSt_AD) + UB(1:1) = ubound(InData%OtherSt_AD) + do i1 = LB(1), UB(1) + call AD_PackOtherState(Buf, InData%OtherSt_AD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%u_AD)) + if (allocated(InData%u_AD)) then + call RegPackBounds(Buf, 1, lbound(InData%u_AD), ubound(InData%u_AD)) + LB(1:1) = lbound(InData%u_AD) + UB(1:1) = ubound(InData%u_AD) + do i1 = LB(1), UB(1) + call AD_PackInput(Buf, InData%u_AD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%x_IfW)) + if (allocated(InData%x_IfW)) then + call RegPackBounds(Buf, 1, lbound(InData%x_IfW), ubound(InData%x_IfW)) + LB(1:1) = lbound(InData%x_IfW) + UB(1:1) = ubound(InData%x_IfW) + do i1 = LB(1), UB(1) + call InflowWind_PackContState(Buf, InData%x_IfW(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%xd_IfW)) + if (allocated(InData%xd_IfW)) then + call RegPackBounds(Buf, 1, lbound(InData%xd_IfW), ubound(InData%xd_IfW)) + LB(1:1) = lbound(InData%xd_IfW) + UB(1:1) = ubound(InData%xd_IfW) + do i1 = LB(1), UB(1) + call InflowWind_PackDiscState(Buf, InData%xd_IfW(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%z_IfW)) + if (allocated(InData%z_IfW)) then + call RegPackBounds(Buf, 1, lbound(InData%z_IfW), ubound(InData%z_IfW)) + LB(1:1) = lbound(InData%z_IfW) + UB(1:1) = ubound(InData%z_IfW) + do i1 = LB(1), UB(1) + call InflowWind_PackConstrState(Buf, InData%z_IfW(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%OtherSt_IfW)) + if (allocated(InData%OtherSt_IfW)) then + call RegPackBounds(Buf, 1, lbound(InData%OtherSt_IfW), ubound(InData%OtherSt_IfW)) + LB(1:1) = lbound(InData%OtherSt_IfW) + UB(1:1) = ubound(InData%OtherSt_IfW) + do i1 = LB(1), UB(1) + call InflowWind_PackOtherState(Buf, InData%OtherSt_IfW(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%u_IfW)) + if (allocated(InData%u_IfW)) then + call RegPackBounds(Buf, 1, lbound(InData%u_IfW), ubound(InData%u_IfW)) + LB(1:1) = lbound(InData%u_IfW) + UB(1:1) = ubound(InData%u_IfW) + do i1 = LB(1), UB(1) + call InflowWind_PackInput(Buf, InData%u_IfW(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%x_SD)) + if (allocated(InData%x_SD)) then + call RegPackBounds(Buf, 1, lbound(InData%x_SD), ubound(InData%x_SD)) + LB(1:1) = lbound(InData%x_SD) + UB(1:1) = ubound(InData%x_SD) + do i1 = LB(1), UB(1) + call SD_PackContState(Buf, InData%x_SD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%xd_SD)) + if (allocated(InData%xd_SD)) then + call RegPackBounds(Buf, 1, lbound(InData%xd_SD), ubound(InData%xd_SD)) + LB(1:1) = lbound(InData%xd_SD) + UB(1:1) = ubound(InData%xd_SD) + do i1 = LB(1), UB(1) + call SD_PackDiscState(Buf, InData%xd_SD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%z_SD)) + if (allocated(InData%z_SD)) then + call RegPackBounds(Buf, 1, lbound(InData%z_SD), ubound(InData%z_SD)) + LB(1:1) = lbound(InData%z_SD) + UB(1:1) = ubound(InData%z_SD) + do i1 = LB(1), UB(1) + call SD_PackConstrState(Buf, InData%z_SD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%OtherSt_SD)) + if (allocated(InData%OtherSt_SD)) then + call RegPackBounds(Buf, 1, lbound(InData%OtherSt_SD), ubound(InData%OtherSt_SD)) + LB(1:1) = lbound(InData%OtherSt_SD) + UB(1:1) = ubound(InData%OtherSt_SD) + do i1 = LB(1), UB(1) + call SD_PackOtherState(Buf, InData%OtherSt_SD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%u_SD)) + if (allocated(InData%u_SD)) then + call RegPackBounds(Buf, 1, lbound(InData%u_SD), ubound(InData%u_SD)) + LB(1:1) = lbound(InData%u_SD) + UB(1:1) = ubound(InData%u_SD) + do i1 = LB(1), UB(1) + call SD_PackInput(Buf, InData%u_SD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%x_ExtPtfm)) + if (allocated(InData%x_ExtPtfm)) then + call RegPackBounds(Buf, 1, lbound(InData%x_ExtPtfm), ubound(InData%x_ExtPtfm)) + LB(1:1) = lbound(InData%x_ExtPtfm) + UB(1:1) = ubound(InData%x_ExtPtfm) + do i1 = LB(1), UB(1) + call ExtPtfm_PackContState(Buf, InData%x_ExtPtfm(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%xd_ExtPtfm)) + if (allocated(InData%xd_ExtPtfm)) then + call RegPackBounds(Buf, 1, lbound(InData%xd_ExtPtfm), ubound(InData%xd_ExtPtfm)) + LB(1:1) = lbound(InData%xd_ExtPtfm) + UB(1:1) = ubound(InData%xd_ExtPtfm) + do i1 = LB(1), UB(1) + call ExtPtfm_PackDiscState(Buf, InData%xd_ExtPtfm(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%z_ExtPtfm)) + if (allocated(InData%z_ExtPtfm)) then + call RegPackBounds(Buf, 1, lbound(InData%z_ExtPtfm), ubound(InData%z_ExtPtfm)) + LB(1:1) = lbound(InData%z_ExtPtfm) + UB(1:1) = ubound(InData%z_ExtPtfm) + do i1 = LB(1), UB(1) + call ExtPtfm_PackConstrState(Buf, InData%z_ExtPtfm(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%OtherSt_ExtPtfm)) + if (allocated(InData%OtherSt_ExtPtfm)) then + call RegPackBounds(Buf, 1, lbound(InData%OtherSt_ExtPtfm), ubound(InData%OtherSt_ExtPtfm)) + LB(1:1) = lbound(InData%OtherSt_ExtPtfm) + UB(1:1) = ubound(InData%OtherSt_ExtPtfm) + do i1 = LB(1), UB(1) + call ExtPtfm_PackOtherState(Buf, InData%OtherSt_ExtPtfm(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%u_ExtPtfm)) + if (allocated(InData%u_ExtPtfm)) then + call RegPackBounds(Buf, 1, lbound(InData%u_ExtPtfm), ubound(InData%u_ExtPtfm)) + LB(1:1) = lbound(InData%u_ExtPtfm) + UB(1:1) = ubound(InData%u_ExtPtfm) + do i1 = LB(1), UB(1) + call ExtPtfm_PackInput(Buf, InData%u_ExtPtfm(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%x_HD)) + if (allocated(InData%x_HD)) then + call RegPackBounds(Buf, 1, lbound(InData%x_HD), ubound(InData%x_HD)) + LB(1:1) = lbound(InData%x_HD) + UB(1:1) = ubound(InData%x_HD) + do i1 = LB(1), UB(1) + call HydroDyn_PackContState(Buf, InData%x_HD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%xd_HD)) + if (allocated(InData%xd_HD)) then + call RegPackBounds(Buf, 1, lbound(InData%xd_HD), ubound(InData%xd_HD)) + LB(1:1) = lbound(InData%xd_HD) + UB(1:1) = ubound(InData%xd_HD) + do i1 = LB(1), UB(1) + call HydroDyn_PackDiscState(Buf, InData%xd_HD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%z_HD)) + if (allocated(InData%z_HD)) then + call RegPackBounds(Buf, 1, lbound(InData%z_HD), ubound(InData%z_HD)) + LB(1:1) = lbound(InData%z_HD) + UB(1:1) = ubound(InData%z_HD) + do i1 = LB(1), UB(1) + call HydroDyn_PackConstrState(Buf, InData%z_HD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%OtherSt_HD)) + if (allocated(InData%OtherSt_HD)) then + call RegPackBounds(Buf, 1, lbound(InData%OtherSt_HD), ubound(InData%OtherSt_HD)) + LB(1:1) = lbound(InData%OtherSt_HD) + UB(1:1) = ubound(InData%OtherSt_HD) + do i1 = LB(1), UB(1) + call HydroDyn_PackOtherState(Buf, InData%OtherSt_HD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%u_HD)) + if (allocated(InData%u_HD)) then + call RegPackBounds(Buf, 1, lbound(InData%u_HD), ubound(InData%u_HD)) + LB(1:1) = lbound(InData%u_HD) + UB(1:1) = ubound(InData%u_HD) + do i1 = LB(1), UB(1) + call HydroDyn_PackInput(Buf, InData%u_HD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%x_IceF)) + if (allocated(InData%x_IceF)) then + call RegPackBounds(Buf, 1, lbound(InData%x_IceF), ubound(InData%x_IceF)) + LB(1:1) = lbound(InData%x_IceF) + UB(1:1) = ubound(InData%x_IceF) + do i1 = LB(1), UB(1) + call IceFloe_PackContState(Buf, InData%x_IceF(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%xd_IceF)) + if (allocated(InData%xd_IceF)) then + call RegPackBounds(Buf, 1, lbound(InData%xd_IceF), ubound(InData%xd_IceF)) + LB(1:1) = lbound(InData%xd_IceF) + UB(1:1) = ubound(InData%xd_IceF) + do i1 = LB(1), UB(1) + call IceFloe_PackDiscState(Buf, InData%xd_IceF(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%z_IceF)) + if (allocated(InData%z_IceF)) then + call RegPackBounds(Buf, 1, lbound(InData%z_IceF), ubound(InData%z_IceF)) + LB(1:1) = lbound(InData%z_IceF) + UB(1:1) = ubound(InData%z_IceF) + do i1 = LB(1), UB(1) + call IceFloe_PackConstrState(Buf, InData%z_IceF(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%OtherSt_IceF)) + if (allocated(InData%OtherSt_IceF)) then + call RegPackBounds(Buf, 1, lbound(InData%OtherSt_IceF), ubound(InData%OtherSt_IceF)) + LB(1:1) = lbound(InData%OtherSt_IceF) + UB(1:1) = ubound(InData%OtherSt_IceF) + do i1 = LB(1), UB(1) + call IceFloe_PackOtherState(Buf, InData%OtherSt_IceF(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%u_IceF)) + if (allocated(InData%u_IceF)) then + call RegPackBounds(Buf, 1, lbound(InData%u_IceF), ubound(InData%u_IceF)) + LB(1:1) = lbound(InData%u_IceF) + UB(1:1) = ubound(InData%u_IceF) + do i1 = LB(1), UB(1) + call IceFloe_PackInput(Buf, InData%u_IceF(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%x_MAP)) + if (allocated(InData%x_MAP)) then + call RegPackBounds(Buf, 1, lbound(InData%x_MAP), ubound(InData%x_MAP)) + LB(1:1) = lbound(InData%x_MAP) + UB(1:1) = ubound(InData%x_MAP) + do i1 = LB(1), UB(1) + call MAP_PackContState(Buf, InData%x_MAP(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%xd_MAP)) + if (allocated(InData%xd_MAP)) then + call RegPackBounds(Buf, 1, lbound(InData%xd_MAP), ubound(InData%xd_MAP)) + LB(1:1) = lbound(InData%xd_MAP) + UB(1:1) = ubound(InData%xd_MAP) + do i1 = LB(1), UB(1) + call MAP_PackDiscState(Buf, InData%xd_MAP(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%z_MAP)) + if (allocated(InData%z_MAP)) then + call RegPackBounds(Buf, 1, lbound(InData%z_MAP), ubound(InData%z_MAP)) + LB(1:1) = lbound(InData%z_MAP) + UB(1:1) = ubound(InData%z_MAP) + do i1 = LB(1), UB(1) + call MAP_PackConstrState(Buf, InData%z_MAP(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%u_MAP)) + if (allocated(InData%u_MAP)) then + call RegPackBounds(Buf, 1, lbound(InData%u_MAP), ubound(InData%u_MAP)) + LB(1:1) = lbound(InData%u_MAP) + UB(1:1) = ubound(InData%u_MAP) + do i1 = LB(1), UB(1) + call MAP_PackInput(Buf, InData%u_MAP(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%x_FEAM)) + if (allocated(InData%x_FEAM)) then + call RegPackBounds(Buf, 1, lbound(InData%x_FEAM), ubound(InData%x_FEAM)) + LB(1:1) = lbound(InData%x_FEAM) + UB(1:1) = ubound(InData%x_FEAM) + do i1 = LB(1), UB(1) + call FEAM_PackContState(Buf, InData%x_FEAM(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%xd_FEAM)) + if (allocated(InData%xd_FEAM)) then + call RegPackBounds(Buf, 1, lbound(InData%xd_FEAM), ubound(InData%xd_FEAM)) + LB(1:1) = lbound(InData%xd_FEAM) + UB(1:1) = ubound(InData%xd_FEAM) + do i1 = LB(1), UB(1) + call FEAM_PackDiscState(Buf, InData%xd_FEAM(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%z_FEAM)) + if (allocated(InData%z_FEAM)) then + call RegPackBounds(Buf, 1, lbound(InData%z_FEAM), ubound(InData%z_FEAM)) + LB(1:1) = lbound(InData%z_FEAM) + UB(1:1) = ubound(InData%z_FEAM) + do i1 = LB(1), UB(1) + call FEAM_PackConstrState(Buf, InData%z_FEAM(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%OtherSt_FEAM)) + if (allocated(InData%OtherSt_FEAM)) then + call RegPackBounds(Buf, 1, lbound(InData%OtherSt_FEAM), ubound(InData%OtherSt_FEAM)) + LB(1:1) = lbound(InData%OtherSt_FEAM) + UB(1:1) = ubound(InData%OtherSt_FEAM) + do i1 = LB(1), UB(1) + call FEAM_PackOtherState(Buf, InData%OtherSt_FEAM(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%u_FEAM)) + if (allocated(InData%u_FEAM)) then + call RegPackBounds(Buf, 1, lbound(InData%u_FEAM), ubound(InData%u_FEAM)) + LB(1:1) = lbound(InData%u_FEAM) + UB(1:1) = ubound(InData%u_FEAM) + do i1 = LB(1), UB(1) + call FEAM_PackInput(Buf, InData%u_FEAM(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%x_MD)) + if (allocated(InData%x_MD)) then + call RegPackBounds(Buf, 1, lbound(InData%x_MD), ubound(InData%x_MD)) + LB(1:1) = lbound(InData%x_MD) + UB(1:1) = ubound(InData%x_MD) + do i1 = LB(1), UB(1) + call MD_PackContState(Buf, InData%x_MD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%xd_MD)) + if (allocated(InData%xd_MD)) then + call RegPackBounds(Buf, 1, lbound(InData%xd_MD), ubound(InData%xd_MD)) + LB(1:1) = lbound(InData%xd_MD) + UB(1:1) = ubound(InData%xd_MD) + do i1 = LB(1), UB(1) + call MD_PackDiscState(Buf, InData%xd_MD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%z_MD)) + if (allocated(InData%z_MD)) then + call RegPackBounds(Buf, 1, lbound(InData%z_MD), ubound(InData%z_MD)) + LB(1:1) = lbound(InData%z_MD) + UB(1:1) = ubound(InData%z_MD) + do i1 = LB(1), UB(1) + call MD_PackConstrState(Buf, InData%z_MD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%OtherSt_MD)) + if (allocated(InData%OtherSt_MD)) then + call RegPackBounds(Buf, 1, lbound(InData%OtherSt_MD), ubound(InData%OtherSt_MD)) + LB(1:1) = lbound(InData%OtherSt_MD) + UB(1:1) = ubound(InData%OtherSt_MD) + do i1 = LB(1), UB(1) + call MD_PackOtherState(Buf, InData%OtherSt_MD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%u_MD)) + if (allocated(InData%u_MD)) then + call RegPackBounds(Buf, 1, lbound(InData%u_MD), ubound(InData%u_MD)) + LB(1:1) = lbound(InData%u_MD) + UB(1:1) = ubound(InData%u_MD) + do i1 = LB(1), UB(1) + call MD_PackInput(Buf, InData%u_MD(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackLinStateSave(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FAST_LinStateSave), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackLinStateSave' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%x_IceD)) deallocate(OutData%x_IceD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_IceD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_IceD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_UnpackContState(Buf, OutData%x_IceD(i1,i2)) ! x_IceD + end do + end do + end if + if (allocated(OutData%xd_IceD)) deallocate(OutData%xd_IceD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xd_IceD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_IceD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_UnpackDiscState(Buf, OutData%xd_IceD(i1,i2)) ! xd_IceD + end do + end do + end if + if (allocated(OutData%z_IceD)) deallocate(OutData%z_IceD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z_IceD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_IceD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_UnpackConstrState(Buf, OutData%z_IceD(i1,i2)) ! z_IceD + end do + end do + end if + if (allocated(OutData%OtherSt_IceD)) deallocate(OutData%OtherSt_IceD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OtherSt_IceD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_IceD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_UnpackOtherState(Buf, OutData%OtherSt_IceD(i1,i2)) ! OtherSt_IceD + end do + end do + end if + if (allocated(OutData%u_IceD)) deallocate(OutData%u_IceD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_IceD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_IceD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_UnpackInput(Buf, OutData%u_IceD(i1,i2)) ! u_IceD + end do + end do + end if + if (allocated(OutData%x_BD)) deallocate(OutData%x_BD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_BD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_BD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_UnpackContState(Buf, OutData%x_BD(i1,i2)) ! x_BD + end do + end do + end if + if (allocated(OutData%xd_BD)) deallocate(OutData%xd_BD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xd_BD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_BD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_UnpackDiscState(Buf, OutData%xd_BD(i1,i2)) ! xd_BD + end do + end do + end if + if (allocated(OutData%z_BD)) deallocate(OutData%z_BD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z_BD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_BD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_UnpackConstrState(Buf, OutData%z_BD(i1,i2)) ! z_BD + end do + end do + end if + if (allocated(OutData%OtherSt_BD)) deallocate(OutData%OtherSt_BD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OtherSt_BD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_BD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_UnpackOtherState(Buf, OutData%OtherSt_BD(i1,i2)) ! OtherSt_BD + end do + end do + end if + if (allocated(OutData%u_BD)) deallocate(OutData%u_BD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_BD(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_UnpackInput(Buf, OutData%u_BD(i1,i2)) ! u_BD + end do + end do + end if + if (allocated(OutData%x_ED)) deallocate(OutData%x_ED) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_ED(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_ED.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ED_UnpackContState(Buf, OutData%x_ED(i1)) ! x_ED + end do + end if + if (allocated(OutData%xd_ED)) deallocate(OutData%xd_ED) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xd_ED(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_ED.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ED_UnpackDiscState(Buf, OutData%xd_ED(i1)) ! xd_ED + end do + end if + if (allocated(OutData%z_ED)) deallocate(OutData%z_ED) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z_ED(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_ED.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ED_UnpackConstrState(Buf, OutData%z_ED(i1)) ! z_ED + end do + end if + if (allocated(OutData%OtherSt_ED)) deallocate(OutData%OtherSt_ED) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OtherSt_ED(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_ED.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ED_UnpackOtherState(Buf, OutData%OtherSt_ED(i1)) ! OtherSt_ED + end do + end if + if (allocated(OutData%u_ED)) deallocate(OutData%u_ED) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_ED(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_ED.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ED_UnpackInput(Buf, OutData%u_ED(i1)) ! u_ED + end do + end if + if (allocated(OutData%x_SrvD)) deallocate(OutData%x_SrvD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_SrvD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_SrvD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SrvD_UnpackContState(Buf, OutData%x_SrvD(i1)) ! x_SrvD + end do + end if + if (allocated(OutData%xd_SrvD)) deallocate(OutData%xd_SrvD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xd_SrvD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_SrvD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SrvD_UnpackDiscState(Buf, OutData%xd_SrvD(i1)) ! xd_SrvD + end do + end if + if (allocated(OutData%z_SrvD)) deallocate(OutData%z_SrvD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z_SrvD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_SrvD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SrvD_UnpackConstrState(Buf, OutData%z_SrvD(i1)) ! z_SrvD + end do + end if + if (allocated(OutData%OtherSt_SrvD)) deallocate(OutData%OtherSt_SrvD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OtherSt_SrvD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_SrvD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SrvD_UnpackOtherState(Buf, OutData%OtherSt_SrvD(i1)) ! OtherSt_SrvD + end do + end if + if (allocated(OutData%u_SrvD)) deallocate(OutData%u_SrvD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_SrvD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SrvD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SrvD_UnpackInput(Buf, OutData%u_SrvD(i1)) ! u_SrvD + end do + end if + if (allocated(OutData%x_AD)) deallocate(OutData%x_AD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_AD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_AD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackContState(Buf, OutData%x_AD(i1)) ! x_AD + end do + end if + if (allocated(OutData%xd_AD)) deallocate(OutData%xd_AD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xd_AD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_AD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackDiscState(Buf, OutData%xd_AD(i1)) ! xd_AD + end do + end if + if (allocated(OutData%z_AD)) deallocate(OutData%z_AD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z_AD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_AD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackConstrState(Buf, OutData%z_AD(i1)) ! z_AD + end do + end if + if (allocated(OutData%OtherSt_AD)) deallocate(OutData%OtherSt_AD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OtherSt_AD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_AD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackOtherState(Buf, OutData%OtherSt_AD(i1)) ! OtherSt_AD + end do + end if + if (allocated(OutData%u_AD)) deallocate(OutData%u_AD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_AD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_AD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call AD_UnpackInput(Buf, OutData%u_AD(i1)) ! u_AD + end do + end if + if (allocated(OutData%x_IfW)) deallocate(OutData%x_IfW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_IfW(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_IfW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackContState(Buf, OutData%x_IfW(i1)) ! x_IfW + end do + end if + if (allocated(OutData%xd_IfW)) deallocate(OutData%xd_IfW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xd_IfW(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_IfW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackDiscState(Buf, OutData%xd_IfW(i1)) ! xd_IfW + end do + end if + if (allocated(OutData%z_IfW)) deallocate(OutData%z_IfW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z_IfW(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_IfW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackConstrState(Buf, OutData%z_IfW(i1)) ! z_IfW + end do + end if + if (allocated(OutData%OtherSt_IfW)) deallocate(OutData%OtherSt_IfW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OtherSt_IfW(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_IfW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackOtherState(Buf, OutData%OtherSt_IfW(i1)) ! OtherSt_IfW + end do + end if + if (allocated(OutData%u_IfW)) deallocate(OutData%u_IfW) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_IfW(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_IfW.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackInput(Buf, OutData%u_IfW(i1)) ! u_IfW + end do + end if + if (allocated(OutData%x_SD)) deallocate(OutData%x_SD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_SD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_SD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackContState(Buf, OutData%x_SD(i1)) ! x_SD + end do + end if + if (allocated(OutData%xd_SD)) deallocate(OutData%xd_SD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xd_SD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_SD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackDiscState(Buf, OutData%xd_SD(i1)) ! xd_SD + end do + end if + if (allocated(OutData%z_SD)) deallocate(OutData%z_SD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z_SD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_SD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackConstrState(Buf, OutData%z_SD(i1)) ! z_SD + end do + end if + if (allocated(OutData%OtherSt_SD)) deallocate(OutData%OtherSt_SD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OtherSt_SD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_SD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackOtherState(Buf, OutData%OtherSt_SD(i1)) ! OtherSt_SD + end do + end if + if (allocated(OutData%u_SD)) deallocate(OutData%u_SD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_SD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SD_UnpackInput(Buf, OutData%u_SD(i1)) ! u_SD + end do + end if + if (allocated(OutData%x_ExtPtfm)) deallocate(OutData%x_ExtPtfm) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_ExtPtfm(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_ExtPtfm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ExtPtfm_UnpackContState(Buf, OutData%x_ExtPtfm(i1)) ! x_ExtPtfm + end do + end if + if (allocated(OutData%xd_ExtPtfm)) deallocate(OutData%xd_ExtPtfm) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xd_ExtPtfm(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_ExtPtfm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ExtPtfm_UnpackDiscState(Buf, OutData%xd_ExtPtfm(i1)) ! xd_ExtPtfm + end do + end if + if (allocated(OutData%z_ExtPtfm)) deallocate(OutData%z_ExtPtfm) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z_ExtPtfm(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_ExtPtfm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ExtPtfm_UnpackConstrState(Buf, OutData%z_ExtPtfm(i1)) ! z_ExtPtfm + end do + end if + if (allocated(OutData%OtherSt_ExtPtfm)) deallocate(OutData%OtherSt_ExtPtfm) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OtherSt_ExtPtfm(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_ExtPtfm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ExtPtfm_UnpackOtherState(Buf, OutData%OtherSt_ExtPtfm(i1)) ! OtherSt_ExtPtfm + end do + end if + if (allocated(OutData%u_ExtPtfm)) deallocate(OutData%u_ExtPtfm) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_ExtPtfm(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_ExtPtfm.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call ExtPtfm_UnpackInput(Buf, OutData%u_ExtPtfm(i1)) ! u_ExtPtfm + end do + end if + if (allocated(OutData%x_HD)) deallocate(OutData%x_HD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_HD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_HD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call HydroDyn_UnpackContState(Buf, OutData%x_HD(i1)) ! x_HD + end do + end if + if (allocated(OutData%xd_HD)) deallocate(OutData%xd_HD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xd_HD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_HD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call HydroDyn_UnpackDiscState(Buf, OutData%xd_HD(i1)) ! xd_HD + end do + end if + if (allocated(OutData%z_HD)) deallocate(OutData%z_HD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z_HD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_HD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call HydroDyn_UnpackConstrState(Buf, OutData%z_HD(i1)) ! z_HD + end do + end if + if (allocated(OutData%OtherSt_HD)) deallocate(OutData%OtherSt_HD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OtherSt_HD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_HD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call HydroDyn_UnpackOtherState(Buf, OutData%OtherSt_HD(i1)) ! OtherSt_HD + end do + end if + if (allocated(OutData%u_HD)) deallocate(OutData%u_HD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_HD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_HD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call HydroDyn_UnpackInput(Buf, OutData%u_HD(i1)) ! u_HD + end do + end if + if (allocated(OutData%x_IceF)) deallocate(OutData%x_IceF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_IceF(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_IceF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceFloe_UnpackContState(Buf, OutData%x_IceF(i1)) ! x_IceF + end do + end if + if (allocated(OutData%xd_IceF)) deallocate(OutData%xd_IceF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xd_IceF(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_IceF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceFloe_UnpackDiscState(Buf, OutData%xd_IceF(i1)) ! xd_IceF + end do + end if + if (allocated(OutData%z_IceF)) deallocate(OutData%z_IceF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z_IceF(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_IceF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceFloe_UnpackConstrState(Buf, OutData%z_IceF(i1)) ! z_IceF + end do + end if + if (allocated(OutData%OtherSt_IceF)) deallocate(OutData%OtherSt_IceF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OtherSt_IceF(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_IceF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceFloe_UnpackOtherState(Buf, OutData%OtherSt_IceF(i1)) ! OtherSt_IceF + end do + end if + if (allocated(OutData%u_IceF)) deallocate(OutData%u_IceF) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_IceF(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_IceF.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceFloe_UnpackInput(Buf, OutData%u_IceF(i1)) ! u_IceF + end do + end if + if (allocated(OutData%x_MAP)) deallocate(OutData%x_MAP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_MAP(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_MAP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MAP_UnpackContState(Buf, OutData%x_MAP(i1)) ! x_MAP + end do + end if + if (allocated(OutData%xd_MAP)) deallocate(OutData%xd_MAP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xd_MAP(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_MAP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MAP_UnpackDiscState(Buf, OutData%xd_MAP(i1)) ! xd_MAP + end do + end if + if (allocated(OutData%z_MAP)) deallocate(OutData%z_MAP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z_MAP(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_MAP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MAP_UnpackConstrState(Buf, OutData%z_MAP(i1)) ! z_MAP + end do + end if + if (allocated(OutData%u_MAP)) deallocate(OutData%u_MAP) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_MAP(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_MAP.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MAP_UnpackInput(Buf, OutData%u_MAP(i1)) ! u_MAP + end do + end if + if (allocated(OutData%x_FEAM)) deallocate(OutData%x_FEAM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_FEAM(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_FEAM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FEAM_UnpackContState(Buf, OutData%x_FEAM(i1)) ! x_FEAM + end do + end if + if (allocated(OutData%xd_FEAM)) deallocate(OutData%xd_FEAM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xd_FEAM(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_FEAM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FEAM_UnpackDiscState(Buf, OutData%xd_FEAM(i1)) ! xd_FEAM + end do + end if + if (allocated(OutData%z_FEAM)) deallocate(OutData%z_FEAM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z_FEAM(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_FEAM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FEAM_UnpackConstrState(Buf, OutData%z_FEAM(i1)) ! z_FEAM + end do + end if + if (allocated(OutData%OtherSt_FEAM)) deallocate(OutData%OtherSt_FEAM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OtherSt_FEAM(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_FEAM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FEAM_UnpackOtherState(Buf, OutData%OtherSt_FEAM(i1)) ! OtherSt_FEAM + end do + end if + if (allocated(OutData%u_FEAM)) deallocate(OutData%u_FEAM) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_FEAM(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_FEAM.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call FEAM_UnpackInput(Buf, OutData%u_FEAM(i1)) ! u_FEAM + end do + end if + if (allocated(OutData%x_MD)) deallocate(OutData%x_MD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%x_MD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_MD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackContState(Buf, OutData%x_MD(i1)) ! x_MD + end do + end if + if (allocated(OutData%xd_MD)) deallocate(OutData%xd_MD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%xd_MD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_MD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackDiscState(Buf, OutData%xd_MD(i1)) ! xd_MD + end do + end if + if (allocated(OutData%z_MD)) deallocate(OutData%z_MD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%z_MD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_MD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackConstrState(Buf, OutData%z_MD(i1)) ! z_MD + end do + end if + if (allocated(OutData%OtherSt_MD)) deallocate(OutData%OtherSt_MD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%OtherSt_MD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_MD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackOtherState(Buf, OutData%OtherSt_MD(i1)) ! OtherSt_MD + end do + end if + if (allocated(OutData%u_MD)) deallocate(OutData%u_MD) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u_MD(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_MD.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call MD_UnpackInput(Buf, OutData%u_MD(i1)) ! u_MD + end do + end if +end subroutine + +subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, ErrMsg) + type(FAST_LinType), intent(in) :: SrcLinTypeData + type(FAST_LinType), intent(inout) :: DstLinTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FAST_CopyLinType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcLinTypeData%Names_u)) then + LB(1:1) = lbound(SrcLinTypeData%Names_u) + UB(1:1) = ubound(SrcLinTypeData%Names_u) + if (.not. allocated(DstLinTypeData%Names_u)) then + allocate(DstLinTypeData%Names_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%Names_u = SrcLinTypeData%Names_u + else if (allocated(DstLinTypeData%Names_u)) then + deallocate(DstLinTypeData%Names_u) + end if + if (allocated(SrcLinTypeData%Names_y)) then + LB(1:1) = lbound(SrcLinTypeData%Names_y) + UB(1:1) = ubound(SrcLinTypeData%Names_y) + if (.not. allocated(DstLinTypeData%Names_y)) then + allocate(DstLinTypeData%Names_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%Names_y = SrcLinTypeData%Names_y + else if (allocated(DstLinTypeData%Names_y)) then + deallocate(DstLinTypeData%Names_y) + end if + if (allocated(SrcLinTypeData%Names_x)) then + LB(1:1) = lbound(SrcLinTypeData%Names_x) + UB(1:1) = ubound(SrcLinTypeData%Names_x) + if (.not. allocated(DstLinTypeData%Names_x)) then + allocate(DstLinTypeData%Names_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%Names_x = SrcLinTypeData%Names_x + else if (allocated(DstLinTypeData%Names_x)) then + deallocate(DstLinTypeData%Names_x) + end if + if (allocated(SrcLinTypeData%Names_xd)) then + LB(1:1) = lbound(SrcLinTypeData%Names_xd) + UB(1:1) = ubound(SrcLinTypeData%Names_xd) + if (.not. allocated(DstLinTypeData%Names_xd)) then + allocate(DstLinTypeData%Names_xd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%Names_xd = SrcLinTypeData%Names_xd + else if (allocated(DstLinTypeData%Names_xd)) then + deallocate(DstLinTypeData%Names_xd) + end if + if (allocated(SrcLinTypeData%Names_z)) then + LB(1:1) = lbound(SrcLinTypeData%Names_z) + UB(1:1) = ubound(SrcLinTypeData%Names_z) + if (.not. allocated(DstLinTypeData%Names_z)) then + allocate(DstLinTypeData%Names_z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%Names_z = SrcLinTypeData%Names_z + else if (allocated(DstLinTypeData%Names_z)) then + deallocate(DstLinTypeData%Names_z) + end if + if (allocated(SrcLinTypeData%op_u)) then + LB(1:1) = lbound(SrcLinTypeData%op_u) + UB(1:1) = ubound(SrcLinTypeData%op_u) + if (.not. allocated(DstLinTypeData%op_u)) then + allocate(DstLinTypeData%op_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%op_u = SrcLinTypeData%op_u + else if (allocated(DstLinTypeData%op_u)) then + deallocate(DstLinTypeData%op_u) + end if + if (allocated(SrcLinTypeData%op_y)) then + LB(1:1) = lbound(SrcLinTypeData%op_y) + UB(1:1) = ubound(SrcLinTypeData%op_y) + if (.not. allocated(DstLinTypeData%op_y)) then + allocate(DstLinTypeData%op_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%op_y = SrcLinTypeData%op_y + else if (allocated(DstLinTypeData%op_y)) then + deallocate(DstLinTypeData%op_y) + end if + if (allocated(SrcLinTypeData%op_x)) then + LB(1:1) = lbound(SrcLinTypeData%op_x) + UB(1:1) = ubound(SrcLinTypeData%op_x) + if (.not. allocated(DstLinTypeData%op_x)) then + allocate(DstLinTypeData%op_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%op_x = SrcLinTypeData%op_x + else if (allocated(DstLinTypeData%op_x)) then + deallocate(DstLinTypeData%op_x) + end if + if (allocated(SrcLinTypeData%op_dx)) then + LB(1:1) = lbound(SrcLinTypeData%op_dx) + UB(1:1) = ubound(SrcLinTypeData%op_dx) + if (.not. allocated(DstLinTypeData%op_dx)) then + allocate(DstLinTypeData%op_dx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_dx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%op_dx = SrcLinTypeData%op_dx + else if (allocated(DstLinTypeData%op_dx)) then + deallocate(DstLinTypeData%op_dx) + end if + if (allocated(SrcLinTypeData%op_xd)) then + LB(1:1) = lbound(SrcLinTypeData%op_xd) + UB(1:1) = ubound(SrcLinTypeData%op_xd) + if (.not. allocated(DstLinTypeData%op_xd)) then + allocate(DstLinTypeData%op_xd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%op_xd = SrcLinTypeData%op_xd + else if (allocated(DstLinTypeData%op_xd)) then + deallocate(DstLinTypeData%op_xd) + end if + if (allocated(SrcLinTypeData%op_z)) then + LB(1:1) = lbound(SrcLinTypeData%op_z) + UB(1:1) = ubound(SrcLinTypeData%op_z) + if (.not. allocated(DstLinTypeData%op_z)) then + allocate(DstLinTypeData%op_z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%op_z = SrcLinTypeData%op_z + else if (allocated(DstLinTypeData%op_z)) then + deallocate(DstLinTypeData%op_z) + end if + if (allocated(SrcLinTypeData%op_x_eig_mag)) then + LB(1:1) = lbound(SrcLinTypeData%op_x_eig_mag) + UB(1:1) = ubound(SrcLinTypeData%op_x_eig_mag) + if (.not. allocated(DstLinTypeData%op_x_eig_mag)) then + allocate(DstLinTypeData%op_x_eig_mag(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_x_eig_mag.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%op_x_eig_mag = SrcLinTypeData%op_x_eig_mag + else if (allocated(DstLinTypeData%op_x_eig_mag)) then + deallocate(DstLinTypeData%op_x_eig_mag) + end if + if (allocated(SrcLinTypeData%op_x_eig_phase)) then + LB(1:1) = lbound(SrcLinTypeData%op_x_eig_phase) + UB(1:1) = ubound(SrcLinTypeData%op_x_eig_phase) + if (.not. allocated(DstLinTypeData%op_x_eig_phase)) then + allocate(DstLinTypeData%op_x_eig_phase(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_x_eig_phase.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%op_x_eig_phase = SrcLinTypeData%op_x_eig_phase + else if (allocated(DstLinTypeData%op_x_eig_phase)) then + deallocate(DstLinTypeData%op_x_eig_phase) + end if + if (allocated(SrcLinTypeData%Use_u)) then + LB(1:1) = lbound(SrcLinTypeData%Use_u) + UB(1:1) = ubound(SrcLinTypeData%Use_u) + if (.not. allocated(DstLinTypeData%Use_u)) then + allocate(DstLinTypeData%Use_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Use_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%Use_u = SrcLinTypeData%Use_u + else if (allocated(DstLinTypeData%Use_u)) then + deallocate(DstLinTypeData%Use_u) + end if + if (allocated(SrcLinTypeData%Use_y)) then + LB(1:1) = lbound(SrcLinTypeData%Use_y) + UB(1:1) = ubound(SrcLinTypeData%Use_y) + if (.not. allocated(DstLinTypeData%Use_y)) then + allocate(DstLinTypeData%Use_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Use_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%Use_y = SrcLinTypeData%Use_y + else if (allocated(DstLinTypeData%Use_y)) then + deallocate(DstLinTypeData%Use_y) + end if + if (allocated(SrcLinTypeData%A)) then + LB(1:2) = lbound(SrcLinTypeData%A) + UB(1:2) = ubound(SrcLinTypeData%A) + if (.not. allocated(DstLinTypeData%A)) then + allocate(DstLinTypeData%A(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%A.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%A = SrcLinTypeData%A + else if (allocated(DstLinTypeData%A)) then + deallocate(DstLinTypeData%A) + end if + if (allocated(SrcLinTypeData%B)) then + LB(1:2) = lbound(SrcLinTypeData%B) + UB(1:2) = ubound(SrcLinTypeData%B) + if (.not. allocated(DstLinTypeData%B)) then + allocate(DstLinTypeData%B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%B = SrcLinTypeData%B + else if (allocated(DstLinTypeData%B)) then + deallocate(DstLinTypeData%B) + end if + if (allocated(SrcLinTypeData%C)) then + LB(1:2) = lbound(SrcLinTypeData%C) + UB(1:2) = ubound(SrcLinTypeData%C) + if (.not. allocated(DstLinTypeData%C)) then + allocate(DstLinTypeData%C(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%C.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%C = SrcLinTypeData%C + else if (allocated(DstLinTypeData%C)) then + deallocate(DstLinTypeData%C) + end if + if (allocated(SrcLinTypeData%D)) then + LB(1:2) = lbound(SrcLinTypeData%D) + UB(1:2) = ubound(SrcLinTypeData%D) + if (.not. allocated(DstLinTypeData%D)) then + allocate(DstLinTypeData%D(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%D.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%D = SrcLinTypeData%D + else if (allocated(DstLinTypeData%D)) then + deallocate(DstLinTypeData%D) + end if + if (allocated(SrcLinTypeData%StateRotation)) then + LB(1:2) = lbound(SrcLinTypeData%StateRotation) + UB(1:2) = ubound(SrcLinTypeData%StateRotation) + if (.not. allocated(DstLinTypeData%StateRotation)) then + allocate(DstLinTypeData%StateRotation(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%StateRotation.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%StateRotation = SrcLinTypeData%StateRotation + else if (allocated(DstLinTypeData%StateRotation)) then + deallocate(DstLinTypeData%StateRotation) + end if + if (allocated(SrcLinTypeData%StateRel_x)) then + LB(1:2) = lbound(SrcLinTypeData%StateRel_x) + UB(1:2) = ubound(SrcLinTypeData%StateRel_x) + if (.not. allocated(DstLinTypeData%StateRel_x)) then + allocate(DstLinTypeData%StateRel_x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%StateRel_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%StateRel_x = SrcLinTypeData%StateRel_x + else if (allocated(DstLinTypeData%StateRel_x)) then + deallocate(DstLinTypeData%StateRel_x) + end if + if (allocated(SrcLinTypeData%StateRel_xdot)) then + LB(1:2) = lbound(SrcLinTypeData%StateRel_xdot) + UB(1:2) = ubound(SrcLinTypeData%StateRel_xdot) + if (.not. allocated(DstLinTypeData%StateRel_xdot)) then + allocate(DstLinTypeData%StateRel_xdot(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%StateRel_xdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%StateRel_xdot = SrcLinTypeData%StateRel_xdot + else if (allocated(DstLinTypeData%StateRel_xdot)) then + deallocate(DstLinTypeData%StateRel_xdot) + end if + if (allocated(SrcLinTypeData%IsLoad_u)) then + LB(1:1) = lbound(SrcLinTypeData%IsLoad_u) + UB(1:1) = ubound(SrcLinTypeData%IsLoad_u) + if (.not. allocated(DstLinTypeData%IsLoad_u)) then + allocate(DstLinTypeData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%IsLoad_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%IsLoad_u = SrcLinTypeData%IsLoad_u + else if (allocated(DstLinTypeData%IsLoad_u)) then + deallocate(DstLinTypeData%IsLoad_u) + end if + if (allocated(SrcLinTypeData%RotFrame_u)) then + LB(1:1) = lbound(SrcLinTypeData%RotFrame_u) + UB(1:1) = ubound(SrcLinTypeData%RotFrame_u) + if (.not. allocated(DstLinTypeData%RotFrame_u)) then + allocate(DstLinTypeData%RotFrame_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%RotFrame_u = SrcLinTypeData%RotFrame_u + else if (allocated(DstLinTypeData%RotFrame_u)) then + deallocate(DstLinTypeData%RotFrame_u) + end if + if (allocated(SrcLinTypeData%RotFrame_y)) then + LB(1:1) = lbound(SrcLinTypeData%RotFrame_y) + UB(1:1) = ubound(SrcLinTypeData%RotFrame_y) + if (.not. allocated(DstLinTypeData%RotFrame_y)) then + allocate(DstLinTypeData%RotFrame_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%RotFrame_y = SrcLinTypeData%RotFrame_y + else if (allocated(DstLinTypeData%RotFrame_y)) then + deallocate(DstLinTypeData%RotFrame_y) + end if + if (allocated(SrcLinTypeData%RotFrame_x)) then + LB(1:1) = lbound(SrcLinTypeData%RotFrame_x) + UB(1:1) = ubound(SrcLinTypeData%RotFrame_x) + if (.not. allocated(DstLinTypeData%RotFrame_x)) then + allocate(DstLinTypeData%RotFrame_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%RotFrame_x = SrcLinTypeData%RotFrame_x + else if (allocated(DstLinTypeData%RotFrame_x)) then + deallocate(DstLinTypeData%RotFrame_x) + end if + if (allocated(SrcLinTypeData%RotFrame_z)) then + LB(1:1) = lbound(SrcLinTypeData%RotFrame_z) + UB(1:1) = ubound(SrcLinTypeData%RotFrame_z) + if (.not. allocated(DstLinTypeData%RotFrame_z)) then + allocate(DstLinTypeData%RotFrame_z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%RotFrame_z = SrcLinTypeData%RotFrame_z + else if (allocated(DstLinTypeData%RotFrame_z)) then + deallocate(DstLinTypeData%RotFrame_z) + end if + if (allocated(SrcLinTypeData%DerivOrder_x)) then + LB(1:1) = lbound(SrcLinTypeData%DerivOrder_x) + UB(1:1) = ubound(SrcLinTypeData%DerivOrder_x) + if (.not. allocated(DstLinTypeData%DerivOrder_x)) then + allocate(DstLinTypeData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%DerivOrder_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinTypeData%DerivOrder_x = SrcLinTypeData%DerivOrder_x + else if (allocated(DstLinTypeData%DerivOrder_x)) then + deallocate(DstLinTypeData%DerivOrder_x) + end if + DstLinTypeData%SizeLin = SrcLinTypeData%SizeLin + DstLinTypeData%LinStartIndx = SrcLinTypeData%LinStartIndx + DstLinTypeData%NumOutputs = SrcLinTypeData%NumOutputs +end subroutine + +subroutine FAST_DestroyLinType(LinTypeData, ErrStat, ErrMsg) + type(FAST_LinType), intent(inout) :: LinTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FAST_DestroyLinType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(LinTypeData%Names_u)) then + deallocate(LinTypeData%Names_u) + end if + if (allocated(LinTypeData%Names_y)) then + deallocate(LinTypeData%Names_y) + end if + if (allocated(LinTypeData%Names_x)) then + deallocate(LinTypeData%Names_x) + end if + if (allocated(LinTypeData%Names_xd)) then + deallocate(LinTypeData%Names_xd) + end if + if (allocated(LinTypeData%Names_z)) then + deallocate(LinTypeData%Names_z) + end if + if (allocated(LinTypeData%op_u)) then + deallocate(LinTypeData%op_u) + end if + if (allocated(LinTypeData%op_y)) then + deallocate(LinTypeData%op_y) + end if + if (allocated(LinTypeData%op_x)) then + deallocate(LinTypeData%op_x) + end if + if (allocated(LinTypeData%op_dx)) then + deallocate(LinTypeData%op_dx) + end if + if (allocated(LinTypeData%op_xd)) then + deallocate(LinTypeData%op_xd) + end if + if (allocated(LinTypeData%op_z)) then + deallocate(LinTypeData%op_z) + end if + if (allocated(LinTypeData%op_x_eig_mag)) then + deallocate(LinTypeData%op_x_eig_mag) + end if + if (allocated(LinTypeData%op_x_eig_phase)) then + deallocate(LinTypeData%op_x_eig_phase) + end if + if (allocated(LinTypeData%Use_u)) then + deallocate(LinTypeData%Use_u) + end if + if (allocated(LinTypeData%Use_y)) then + deallocate(LinTypeData%Use_y) + end if + if (allocated(LinTypeData%A)) then + deallocate(LinTypeData%A) + end if + if (allocated(LinTypeData%B)) then + deallocate(LinTypeData%B) + end if + if (allocated(LinTypeData%C)) then + deallocate(LinTypeData%C) + end if + if (allocated(LinTypeData%D)) then + deallocate(LinTypeData%D) + end if + if (allocated(LinTypeData%StateRotation)) then + deallocate(LinTypeData%StateRotation) + end if + if (allocated(LinTypeData%StateRel_x)) then + deallocate(LinTypeData%StateRel_x) + end if + if (allocated(LinTypeData%StateRel_xdot)) then + deallocate(LinTypeData%StateRel_xdot) + end if + if (allocated(LinTypeData%IsLoad_u)) then + deallocate(LinTypeData%IsLoad_u) + end if + if (allocated(LinTypeData%RotFrame_u)) then + deallocate(LinTypeData%RotFrame_u) + end if + if (allocated(LinTypeData%RotFrame_y)) then + deallocate(LinTypeData%RotFrame_y) + end if + if (allocated(LinTypeData%RotFrame_x)) then + deallocate(LinTypeData%RotFrame_x) + end if + if (allocated(LinTypeData%RotFrame_z)) then + deallocate(LinTypeData%RotFrame_z) + end if + if (allocated(LinTypeData%DerivOrder_x)) then + deallocate(LinTypeData%DerivOrder_x) + end if +end subroutine + +subroutine FAST_PackLinType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FAST_LinType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackLinType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%Names_u)) + if (allocated(InData%Names_u)) then + call RegPackBounds(Buf, 1, lbound(InData%Names_u), ubound(InData%Names_u)) + call RegPack(Buf, InData%Names_u) + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%Names_y)) + if (allocated(InData%Names_y)) then + call RegPackBounds(Buf, 1, lbound(InData%Names_y), ubound(InData%Names_y)) + call RegPack(Buf, InData%Names_y) + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%Names_x)) + if (allocated(InData%Names_x)) then + call RegPackBounds(Buf, 1, lbound(InData%Names_x), ubound(InData%Names_x)) + call RegPack(Buf, InData%Names_x) + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%Names_xd)) + if (allocated(InData%Names_xd)) then + call RegPackBounds(Buf, 1, lbound(InData%Names_xd), ubound(InData%Names_xd)) + call RegPack(Buf, InData%Names_xd) + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%Names_z)) + if (allocated(InData%Names_z)) then + call RegPackBounds(Buf, 1, lbound(InData%Names_z), ubound(InData%Names_z)) + call RegPack(Buf, InData%Names_z) + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%op_u)) + if (allocated(InData%op_u)) then + call RegPackBounds(Buf, 1, lbound(InData%op_u), ubound(InData%op_u)) + call RegPack(Buf, InData%op_u) + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%op_y)) + if (allocated(InData%op_y)) then + call RegPackBounds(Buf, 1, lbound(InData%op_y), ubound(InData%op_y)) + call RegPack(Buf, InData%op_y) + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%op_x)) + if (allocated(InData%op_x)) then + call RegPackBounds(Buf, 1, lbound(InData%op_x), ubound(InData%op_x)) + call RegPack(Buf, InData%op_x) + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%op_dx)) + if (allocated(InData%op_dx)) then + call RegPackBounds(Buf, 1, lbound(InData%op_dx), ubound(InData%op_dx)) + call RegPack(Buf, InData%op_dx) + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%op_xd)) + if (allocated(InData%op_xd)) then + call RegPackBounds(Buf, 1, lbound(InData%op_xd), ubound(InData%op_xd)) + call RegPack(Buf, InData%op_xd) + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%op_z)) + if (allocated(InData%op_z)) then + call RegPackBounds(Buf, 1, lbound(InData%op_z), ubound(InData%op_z)) + call RegPack(Buf, InData%op_z) + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%op_x_eig_mag)) + if (allocated(InData%op_x_eig_mag)) then + call RegPackBounds(Buf, 1, lbound(InData%op_x_eig_mag), ubound(InData%op_x_eig_mag)) + call RegPack(Buf, InData%op_x_eig_mag) + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%op_x_eig_phase)) + if (allocated(InData%op_x_eig_phase)) then + call RegPackBounds(Buf, 1, lbound(InData%op_x_eig_phase), ubound(InData%op_x_eig_phase)) + call RegPack(Buf, InData%op_x_eig_phase) + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%Use_u)) + if (allocated(InData%Use_u)) then + call RegPackBounds(Buf, 1, lbound(InData%Use_u), ubound(InData%Use_u)) + call RegPack(Buf, InData%Use_u) + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%Use_y)) + if (allocated(InData%Use_y)) then + call RegPackBounds(Buf, 1, lbound(InData%Use_y), ubound(InData%Use_y)) + call RegPack(Buf, InData%Use_y) + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%A)) + if (allocated(InData%A)) then + call RegPackBounds(Buf, 2, lbound(InData%A), ubound(InData%A)) + call RegPack(Buf, InData%A) + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%B)) + if (allocated(InData%B)) then + call RegPackBounds(Buf, 2, lbound(InData%B), ubound(InData%B)) + call RegPack(Buf, InData%B) + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%C)) + if (allocated(InData%C)) then + call RegPackBounds(Buf, 2, lbound(InData%C), ubound(InData%C)) + call RegPack(Buf, InData%C) + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%D)) + if (allocated(InData%D)) then + call RegPackBounds(Buf, 2, lbound(InData%D), ubound(InData%D)) + call RegPack(Buf, InData%D) + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%StateRotation)) + if (allocated(InData%StateRotation)) then + call RegPackBounds(Buf, 2, lbound(InData%StateRotation), ubound(InData%StateRotation)) + call RegPack(Buf, InData%StateRotation) + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%StateRel_x)) + if (allocated(InData%StateRel_x)) then + call RegPackBounds(Buf, 2, lbound(InData%StateRel_x), ubound(InData%StateRel_x)) + call RegPack(Buf, InData%StateRel_x) + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%StateRel_xdot)) + if (allocated(InData%StateRel_xdot)) then + call RegPackBounds(Buf, 2, lbound(InData%StateRel_xdot), ubound(InData%StateRel_xdot)) + call RegPack(Buf, InData%StateRel_xdot) + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%IsLoad_u)) + if (allocated(InData%IsLoad_u)) then + call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) + call RegPack(Buf, InData%IsLoad_u) + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%RotFrame_u)) + if (allocated(InData%RotFrame_u)) then + call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u), ubound(InData%RotFrame_u)) + call RegPack(Buf, InData%RotFrame_u) end if if (RegCheckErr(Buf, RoutineName)) return - ! RotFrame_y call RegPack(Buf, allocated(InData%RotFrame_y)) if (allocated(InData%RotFrame_y)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y), ubound(InData%RotFrame_y)) call RegPack(Buf, InData%RotFrame_y) end if if (RegCheckErr(Buf, RoutineName)) return - ! RotFrame_x call RegPack(Buf, allocated(InData%RotFrame_x)) if (allocated(InData%RotFrame_x)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x), ubound(InData%RotFrame_x)) call RegPack(Buf, InData%RotFrame_x) end if if (RegCheckErr(Buf, RoutineName)) return - ! RotFrame_z call RegPack(Buf, allocated(InData%RotFrame_z)) if (allocated(InData%RotFrame_z)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_z), ubound(InData%RotFrame_z)) call RegPack(Buf, InData%RotFrame_z) end if if (RegCheckErr(Buf, RoutineName)) return - ! DerivOrder_x call RegPack(Buf, allocated(InData%DerivOrder_x)) if (allocated(InData%DerivOrder_x)) then call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x), ubound(InData%DerivOrder_x)) call RegPack(Buf, InData%DerivOrder_x) end if if (RegCheckErr(Buf, RoutineName)) return - ! SizeLin call RegPack(Buf, InData%SizeLin) if (RegCheckErr(Buf, RoutineName)) return - ! LinStartIndx call RegPack(Buf, InData%LinStartIndx) if (RegCheckErr(Buf, RoutineName)) return - ! NumOutputs call RegPack(Buf, InData%NumOutputs) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -6273,7 +6109,6 @@ subroutine FAST_UnPackLinType(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! Names_u if (allocated(OutData%Names_u)) deallocate(OutData%Names_u) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6288,7 +6123,6 @@ subroutine FAST_UnPackLinType(Buf, OutData) call RegUnpack(Buf, OutData%Names_u) if (RegCheckErr(Buf, RoutineName)) return end if - ! Names_y if (allocated(OutData%Names_y)) deallocate(OutData%Names_y) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6303,7 +6137,6 @@ subroutine FAST_UnPackLinType(Buf, OutData) call RegUnpack(Buf, OutData%Names_y) if (RegCheckErr(Buf, RoutineName)) return end if - ! Names_x if (allocated(OutData%Names_x)) deallocate(OutData%Names_x) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6318,7 +6151,6 @@ subroutine FAST_UnPackLinType(Buf, OutData) call RegUnpack(Buf, OutData%Names_x) if (RegCheckErr(Buf, RoutineName)) return end if - ! Names_xd if (allocated(OutData%Names_xd)) deallocate(OutData%Names_xd) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6333,7 +6165,6 @@ subroutine FAST_UnPackLinType(Buf, OutData) call RegUnpack(Buf, OutData%Names_xd) if (RegCheckErr(Buf, RoutineName)) return end if - ! Names_z if (allocated(OutData%Names_z)) deallocate(OutData%Names_z) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6348,7 +6179,6 @@ subroutine FAST_UnPackLinType(Buf, OutData) call RegUnpack(Buf, OutData%Names_z) if (RegCheckErr(Buf, RoutineName)) return end if - ! op_u if (allocated(OutData%op_u)) deallocate(OutData%op_u) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6363,7 +6193,6 @@ subroutine FAST_UnPackLinType(Buf, OutData) call RegUnpack(Buf, OutData%op_u) if (RegCheckErr(Buf, RoutineName)) return end if - ! op_y if (allocated(OutData%op_y)) deallocate(OutData%op_y) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6372,1497 +6201,2048 @@ subroutine FAST_UnPackLinType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return allocate(OutData%op_y(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%op_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%op_x)) deallocate(OutData%op_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%op_x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%op_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%op_dx)) deallocate(OutData%op_dx) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%op_dx(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_dx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%op_dx) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%op_xd)) deallocate(OutData%op_xd) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%op_xd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_xd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%op_xd) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%op_z)) deallocate(OutData%op_z) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%op_z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%op_z) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%op_x_eig_mag)) deallocate(OutData%op_x_eig_mag) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%op_x_eig_mag(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_x_eig_mag.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%op_x_eig_mag) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%op_x_eig_phase)) deallocate(OutData%op_x_eig_phase) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%op_x_eig_phase(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_x_eig_phase.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%op_x_eig_phase) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Use_u)) deallocate(OutData%Use_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Use_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Use_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Use_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%Use_y)) deallocate(OutData%Use_y) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Use_y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Use_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%Use_y) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%A)) deallocate(OutData%A) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%A(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%A.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%A) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%B)) deallocate(OutData%B) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%B(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%B) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%C)) deallocate(OutData%C) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%C(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%C.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%C) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%D)) deallocate(OutData%D) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%D(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%D.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%D) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%StateRotation)) deallocate(OutData%StateRotation) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StateRotation(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StateRotation.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StateRotation) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%StateRel_x)) deallocate(OutData%StateRel_x) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StateRel_x(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StateRel_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StateRel_x) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%StateRel_xdot)) deallocate(OutData%StateRel_xdot) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%StateRel_xdot(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StateRel_xdot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%StateRel_xdot) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%IsLoad_u)) deallocate(OutData%IsLoad_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%IsLoad_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%IsLoad_u) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%RotFrame_u)) deallocate(OutData%RotFrame_u) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%RotFrame_u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - call RegUnpack(Buf, OutData%op_y) + call RegUnpack(Buf, OutData%RotFrame_u) if (RegCheckErr(Buf, RoutineName)) return end if - ! op_x - if (allocated(OutData%op_x)) deallocate(OutData%op_x) + if (allocated(OutData%RotFrame_y)) deallocate(OutData%RotFrame_y) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(Buf, 1, LB, UB) if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%op_x(LB(1):UB(1)),stat=stat) + allocate(OutData%RotFrame_y(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - call RegUnpack(Buf, OutData%op_x) + call RegUnpack(Buf, OutData%RotFrame_y) if (RegCheckErr(Buf, RoutineName)) return end if - ! op_dx - if (allocated(OutData%op_dx)) deallocate(OutData%op_dx) + if (allocated(OutData%RotFrame_x)) deallocate(OutData%RotFrame_x) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(Buf, 1, LB, UB) if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%op_dx(LB(1):UB(1)),stat=stat) + allocate(OutData%RotFrame_x(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_dx.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - call RegUnpack(Buf, OutData%op_dx) + call RegUnpack(Buf, OutData%RotFrame_x) if (RegCheckErr(Buf, RoutineName)) return end if - ! op_xd - if (allocated(OutData%op_xd)) deallocate(OutData%op_xd) + if (allocated(OutData%RotFrame_z)) deallocate(OutData%RotFrame_z) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(Buf, 1, LB, UB) if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%op_xd(LB(1):UB(1)),stat=stat) + allocate(OutData%RotFrame_z(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_xd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - call RegUnpack(Buf, OutData%op_xd) + call RegUnpack(Buf, OutData%RotFrame_z) if (RegCheckErr(Buf, RoutineName)) return end if - ! op_z - if (allocated(OutData%op_z)) deallocate(OutData%op_z) + if (allocated(OutData%DerivOrder_x)) deallocate(OutData%DerivOrder_x) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(Buf, 1, LB, UB) if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%op_z(LB(1):UB(1)),stat=stat) + allocate(OutData%DerivOrder_x(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - call RegUnpack(Buf, OutData%op_z) + call RegUnpack(Buf, OutData%DerivOrder_x) if (RegCheckErr(Buf, RoutineName)) return end if - ! op_x_eig_mag - if (allocated(OutData%op_x_eig_mag)) deallocate(OutData%op_x_eig_mag) + call RegUnpack(Buf, OutData%SizeLin) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%LinStartIndx) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NumOutputs) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_CopyModLinType(SrcModLinTypeData, DstModLinTypeData, CtrlCode, ErrStat, ErrMsg) + type(FAST_ModLinType), intent(in) :: SrcModLinTypeData + type(FAST_ModLinType), intent(inout) :: DstModLinTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyModLinType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcModLinTypeData%Instance)) then + LB(1:1) = lbound(SrcModLinTypeData%Instance) + UB(1:1) = ubound(SrcModLinTypeData%Instance) + if (.not. allocated(DstModLinTypeData%Instance)) then + allocate(DstModLinTypeData%Instance(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%Instance.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FAST_CopyLinType(SrcModLinTypeData%Instance(i1), DstModLinTypeData%Instance(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstModLinTypeData%Instance)) then + deallocate(DstModLinTypeData%Instance) + end if +end subroutine + +subroutine FAST_DestroyModLinType(ModLinTypeData, ErrStat, ErrMsg) + type(FAST_ModLinType), intent(inout) :: ModLinTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyModLinType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ModLinTypeData%Instance)) then + LB(1:1) = lbound(ModLinTypeData%Instance) + UB(1:1) = ubound(ModLinTypeData%Instance) + do i1 = LB(1), UB(1) + call FAST_DestroyLinType(ModLinTypeData%Instance(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModLinTypeData%Instance) + end if +end subroutine + +subroutine FAST_PackModLinType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FAST_ModLinType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackModLinType' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%Instance)) + if (allocated(InData%Instance)) then + call RegPackBounds(Buf, 1, lbound(InData%Instance), ubound(InData%Instance)) + LB(1:1) = lbound(InData%Instance) + UB(1:1) = ubound(InData%Instance) + do i1 = LB(1), UB(1) + call FAST_PackLinType(Buf, InData%Instance(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackModLinType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FAST_ModLinType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackModLinType' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%Instance)) deallocate(OutData%Instance) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(Buf, 1, LB, UB) if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%op_x_eig_mag(LB(1):UB(1)),stat=stat) + allocate(OutData%Instance(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_x_eig_mag.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Instance.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - call RegUnpack(Buf, OutData%op_x_eig_mag) - if (RegCheckErr(Buf, RoutineName)) return + do i1 = LB(1), UB(1) + call FAST_UnpackLinType(Buf, OutData%Instance(i1)) ! Instance + end do end if - ! op_x_eig_phase - if (allocated(OutData%op_x_eig_phase)) deallocate(OutData%op_x_eig_phase) +end subroutine + +subroutine FAST_CopyLinFileType(SrcLinFileTypeData, DstLinFileTypeData, CtrlCode, ErrStat, ErrMsg) + type(FAST_LinFileType), intent(in) :: SrcLinFileTypeData + type(FAST_LinFileType), intent(inout) :: DstLinFileTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyLinFileType' + ErrStat = ErrID_None + ErrMsg = '' + do i1 = LB(1), UB(1) + call FAST_CopyModLinType(SrcLinFileTypeData%Modules(i1), DstLinFileTypeData%Modules(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call FAST_CopyLinType(SrcLinFileTypeData%Glue, DstLinFileTypeData%Glue, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstLinFileTypeData%RotSpeed = SrcLinFileTypeData%RotSpeed + DstLinFileTypeData%Azimuth = SrcLinFileTypeData%Azimuth + DstLinFileTypeData%WindSpeed = SrcLinFileTypeData%WindSpeed +end subroutine + +subroutine FAST_DestroyLinFileType(LinFileTypeData, ErrStat, ErrMsg) + type(FAST_LinFileType), intent(inout) :: LinFileTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyLinFileType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine FAST_PackLinFileType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FAST_LinFileType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackLinFileType' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + LB(1:1) = lbound(InData%Modules) + UB(1:1) = ubound(InData%Modules) + do i1 = LB(1), UB(1) + call FAST_PackModLinType(Buf, InData%Modules(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + call FAST_PackLinType(Buf, InData%Glue) + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, InData%RotSpeed) + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, InData%Azimuth) + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, InData%WindSpeed) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackLinFileType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FAST_LinFileType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackLinFileType' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat /= ErrID_None) return + LB(1:1) = lbound(OutData%Modules) + UB(1:1) = ubound(OutData%Modules) + do i1 = LB(1), UB(1) + call FAST_UnpackModLinType(Buf, OutData%Modules(i1)) ! Modules + end do + call FAST_UnpackLinType(Buf, OutData%Glue) ! Glue + call RegUnpack(Buf, OutData%RotSpeed) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Azimuth) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%WindSpeed) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_CopyMiscLinType(SrcMiscLinTypeData, DstMiscLinTypeData, CtrlCode, ErrStat, ErrMsg) + type(FAST_MiscLinType), intent(in) :: SrcMiscLinTypeData + type(FAST_MiscLinType), intent(inout) :: DstMiscLinTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FAST_CopyMiscLinType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMiscLinTypeData%LinTimes)) then + LB(1:1) = lbound(SrcMiscLinTypeData%LinTimes) + UB(1:1) = ubound(SrcMiscLinTypeData%LinTimes) + if (.not. allocated(DstMiscLinTypeData%LinTimes)) then + allocate(DstMiscLinTypeData%LinTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%LinTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscLinTypeData%LinTimes = SrcMiscLinTypeData%LinTimes + else if (allocated(DstMiscLinTypeData%LinTimes)) then + deallocate(DstMiscLinTypeData%LinTimes) + end if + DstMiscLinTypeData%CopyOP_CtrlCode = SrcMiscLinTypeData%CopyOP_CtrlCode + if (allocated(SrcMiscLinTypeData%AzimTarget)) then + LB(1:1) = lbound(SrcMiscLinTypeData%AzimTarget) + UB(1:1) = ubound(SrcMiscLinTypeData%AzimTarget) + if (.not. allocated(DstMiscLinTypeData%AzimTarget)) then + allocate(DstMiscLinTypeData%AzimTarget(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%AzimTarget.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscLinTypeData%AzimTarget = SrcMiscLinTypeData%AzimTarget + else if (allocated(DstMiscLinTypeData%AzimTarget)) then + deallocate(DstMiscLinTypeData%AzimTarget) + end if + DstMiscLinTypeData%IsConverged = SrcMiscLinTypeData%IsConverged + DstMiscLinTypeData%FoundSteady = SrcMiscLinTypeData%FoundSteady + DstMiscLinTypeData%ForceLin = SrcMiscLinTypeData%ForceLin + DstMiscLinTypeData%n_rot = SrcMiscLinTypeData%n_rot + DstMiscLinTypeData%AzimIndx = SrcMiscLinTypeData%AzimIndx + DstMiscLinTypeData%NextLinTimeIndx = SrcMiscLinTypeData%NextLinTimeIndx + if (allocated(SrcMiscLinTypeData%Psi)) then + LB(1:1) = lbound(SrcMiscLinTypeData%Psi) + UB(1:1) = ubound(SrcMiscLinTypeData%Psi) + if (.not. allocated(DstMiscLinTypeData%Psi)) then + allocate(DstMiscLinTypeData%Psi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%Psi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscLinTypeData%Psi = SrcMiscLinTypeData%Psi + else if (allocated(DstMiscLinTypeData%Psi)) then + deallocate(DstMiscLinTypeData%Psi) + end if + if (allocated(SrcMiscLinTypeData%y_interp)) then + LB(1:1) = lbound(SrcMiscLinTypeData%y_interp) + UB(1:1) = ubound(SrcMiscLinTypeData%y_interp) + if (.not. allocated(DstMiscLinTypeData%y_interp)) then + allocate(DstMiscLinTypeData%y_interp(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%y_interp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscLinTypeData%y_interp = SrcMiscLinTypeData%y_interp + else if (allocated(DstMiscLinTypeData%y_interp)) then + deallocate(DstMiscLinTypeData%y_interp) + end if + if (allocated(SrcMiscLinTypeData%y_ref)) then + LB(1:1) = lbound(SrcMiscLinTypeData%y_ref) + UB(1:1) = ubound(SrcMiscLinTypeData%y_ref) + if (.not. allocated(DstMiscLinTypeData%y_ref)) then + allocate(DstMiscLinTypeData%y_ref(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%y_ref.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscLinTypeData%y_ref = SrcMiscLinTypeData%y_ref + else if (allocated(DstMiscLinTypeData%y_ref)) then + deallocate(DstMiscLinTypeData%y_ref) + end if + if (allocated(SrcMiscLinTypeData%Y_prevRot)) then + LB(1:2) = lbound(SrcMiscLinTypeData%Y_prevRot) + UB(1:2) = ubound(SrcMiscLinTypeData%Y_prevRot) + if (.not. allocated(DstMiscLinTypeData%Y_prevRot)) then + allocate(DstMiscLinTypeData%Y_prevRot(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%Y_prevRot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscLinTypeData%Y_prevRot = SrcMiscLinTypeData%Y_prevRot + else if (allocated(DstMiscLinTypeData%Y_prevRot)) then + deallocate(DstMiscLinTypeData%Y_prevRot) + end if +end subroutine + +subroutine FAST_DestroyMiscLinType(MiscLinTypeData, ErrStat, ErrMsg) + type(FAST_MiscLinType), intent(inout) :: MiscLinTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FAST_DestroyMiscLinType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscLinTypeData%LinTimes)) then + deallocate(MiscLinTypeData%LinTimes) + end if + if (allocated(MiscLinTypeData%AzimTarget)) then + deallocate(MiscLinTypeData%AzimTarget) + end if + if (allocated(MiscLinTypeData%Psi)) then + deallocate(MiscLinTypeData%Psi) + end if + if (allocated(MiscLinTypeData%y_interp)) then + deallocate(MiscLinTypeData%y_interp) + end if + if (allocated(MiscLinTypeData%y_ref)) then + deallocate(MiscLinTypeData%y_ref) + end if + if (allocated(MiscLinTypeData%Y_prevRot)) then + deallocate(MiscLinTypeData%Y_prevRot) + end if +end subroutine + +subroutine FAST_PackMiscLinType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FAST_MiscLinType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackMiscLinType' + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%LinTimes)) + if (allocated(InData%LinTimes)) then + call RegPackBounds(Buf, 1, lbound(InData%LinTimes), ubound(InData%LinTimes)) + call RegPack(Buf, InData%LinTimes) + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, InData%CopyOP_CtrlCode) + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%AzimTarget)) + if (allocated(InData%AzimTarget)) then + call RegPackBounds(Buf, 1, lbound(InData%AzimTarget), ubound(InData%AzimTarget)) + call RegPack(Buf, InData%AzimTarget) + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, InData%IsConverged) + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, InData%FoundSteady) + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, InData%ForceLin) + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, InData%n_rot) + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, InData%AzimIndx) + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, InData%NextLinTimeIndx) + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%Psi)) + if (allocated(InData%Psi)) then + call RegPackBounds(Buf, 1, lbound(InData%Psi), ubound(InData%Psi)) + call RegPack(Buf, InData%Psi) + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%y_interp)) + if (allocated(InData%y_interp)) then + call RegPackBounds(Buf, 1, lbound(InData%y_interp), ubound(InData%y_interp)) + call RegPack(Buf, InData%y_interp) + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%y_ref)) + if (allocated(InData%y_ref)) then + call RegPackBounds(Buf, 1, lbound(InData%y_ref), ubound(InData%y_ref)) + call RegPack(Buf, InData%y_ref) + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%Y_prevRot)) + if (allocated(InData%Y_prevRot)) then + call RegPackBounds(Buf, 2, lbound(InData%Y_prevRot), ubound(InData%Y_prevRot)) + call RegPack(Buf, InData%Y_prevRot) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackMiscLinType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FAST_MiscLinType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackMiscLinType' + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%LinTimes)) deallocate(OutData%LinTimes) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(Buf, 1, LB, UB) if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%op_x_eig_phase(LB(1):UB(1)),stat=stat) + allocate(OutData%LinTimes(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_x_eig_phase.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - call RegUnpack(Buf, OutData%op_x_eig_phase) + call RegUnpack(Buf, OutData%LinTimes) if (RegCheckErr(Buf, RoutineName)) return end if - ! Use_u - if (allocated(OutData%Use_u)) deallocate(OutData%Use_u) + call RegUnpack(Buf, OutData%CopyOP_CtrlCode) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%AzimTarget)) deallocate(OutData%AzimTarget) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(Buf, 1, LB, UB) if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Use_u(LB(1):UB(1)),stat=stat) + allocate(OutData%AzimTarget(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Use_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AzimTarget.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - call RegUnpack(Buf, OutData%Use_u) + call RegUnpack(Buf, OutData%AzimTarget) if (RegCheckErr(Buf, RoutineName)) return end if - ! Use_y - if (allocated(OutData%Use_y)) deallocate(OutData%Use_y) + call RegUnpack(Buf, OutData%IsConverged) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%FoundSteady) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%ForceLin) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%n_rot) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%AzimIndx) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NextLinTimeIndx) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%Psi)) deallocate(OutData%Psi) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(Buf, 1, LB, UB) if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Use_y(LB(1):UB(1)),stat=stat) + allocate(OutData%Psi(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Use_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Psi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - call RegUnpack(Buf, OutData%Use_y) + call RegUnpack(Buf, OutData%Psi) if (RegCheckErr(Buf, RoutineName)) return end if - ! A - if (allocated(OutData%A)) deallocate(OutData%A) + if (allocated(OutData%y_interp)) deallocate(OutData%y_interp) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) + call RegUnpackBounds(Buf, 1, LB, UB) if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%A(LB(1):UB(1),LB(2):UB(2)),stat=stat) + allocate(OutData%y_interp(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%A.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_interp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - call RegUnpack(Buf, OutData%A) + call RegUnpack(Buf, OutData%y_interp) if (RegCheckErr(Buf, RoutineName)) return end if - ! B - if (allocated(OutData%B)) deallocate(OutData%B) + if (allocated(OutData%y_ref)) deallocate(OutData%y_ref) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) + call RegUnpackBounds(Buf, 1, LB, UB) if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%B(LB(1):UB(1),LB(2):UB(2)),stat=stat) + allocate(OutData%y_ref(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%B.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_ref.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - call RegUnpack(Buf, OutData%B) + call RegUnpack(Buf, OutData%y_ref) if (RegCheckErr(Buf, RoutineName)) return end if - ! C - if (allocated(OutData%C)) deallocate(OutData%C) + if (allocated(OutData%Y_prevRot)) deallocate(OutData%Y_prevRot) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(Buf, 2, LB, UB) if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%C(LB(1):UB(1),LB(2):UB(2)),stat=stat) + allocate(OutData%Y_prevRot(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%C.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y_prevRot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - call RegUnpack(Buf, OutData%C) + call RegUnpack(Buf, OutData%Y_prevRot) if (RegCheckErr(Buf, RoutineName)) return end if - ! D - if (allocated(OutData%D)) deallocate(OutData%D) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%D(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%D.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return +end subroutine + +subroutine FAST_CopyOutputFileType(SrcOutputFileTypeData, DstOutputFileTypeData, CtrlCode, ErrStat, ErrMsg) + type(FAST_OutputFileType), intent(inout) :: SrcOutputFileTypeData + type(FAST_OutputFileType), intent(inout) :: DstOutputFileTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyOutputFileType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputFileTypeData%TimeData)) then + LB(1:1) = lbound(SrcOutputFileTypeData%TimeData) + UB(1:1) = ubound(SrcOutputFileTypeData%TimeData) + if (.not. allocated(DstOutputFileTypeData%TimeData)) then + allocate(DstOutputFileTypeData%TimeData(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%TimeData.', ErrStat, ErrMsg, RoutineName) + return + end if end if - call RegUnpack(Buf, OutData%D) - if (RegCheckErr(Buf, RoutineName)) return - end if - ! StateRotation - if (allocated(OutData%StateRotation)) deallocate(OutData%StateRotation) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%StateRotation(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StateRotation.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return + DstOutputFileTypeData%TimeData = SrcOutputFileTypeData%TimeData + else if (allocated(DstOutputFileTypeData%TimeData)) then + deallocate(DstOutputFileTypeData%TimeData) + end if + if (allocated(SrcOutputFileTypeData%AllOutData)) then + LB(1:2) = lbound(SrcOutputFileTypeData%AllOutData) + UB(1:2) = ubound(SrcOutputFileTypeData%AllOutData) + if (.not. allocated(DstOutputFileTypeData%AllOutData)) then + allocate(DstOutputFileTypeData%AllOutData(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%AllOutData.', ErrStat, ErrMsg, RoutineName) + return + end if end if - call RegUnpack(Buf, OutData%StateRotation) - if (RegCheckErr(Buf, RoutineName)) return + DstOutputFileTypeData%AllOutData = SrcOutputFileTypeData%AllOutData + else if (allocated(DstOutputFileTypeData%AllOutData)) then + deallocate(DstOutputFileTypeData%AllOutData) + end if + DstOutputFileTypeData%n_Out = SrcOutputFileTypeData%n_Out + DstOutputFileTypeData%NOutSteps = SrcOutputFileTypeData%NOutSteps + DstOutputFileTypeData%numOuts = SrcOutputFileTypeData%numOuts + DstOutputFileTypeData%UnOu = SrcOutputFileTypeData%UnOu + DstOutputFileTypeData%UnSum = SrcOutputFileTypeData%UnSum + DstOutputFileTypeData%UnGra = SrcOutputFileTypeData%UnGra + DstOutputFileTypeData%FileDescLines = SrcOutputFileTypeData%FileDescLines + if (allocated(SrcOutputFileTypeData%ChannelNames)) then + LB(1:1) = lbound(SrcOutputFileTypeData%ChannelNames) + UB(1:1) = ubound(SrcOutputFileTypeData%ChannelNames) + if (.not. allocated(DstOutputFileTypeData%ChannelNames)) then + allocate(DstOutputFileTypeData%ChannelNames(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%ChannelNames.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputFileTypeData%ChannelNames = SrcOutputFileTypeData%ChannelNames + else if (allocated(DstOutputFileTypeData%ChannelNames)) then + deallocate(DstOutputFileTypeData%ChannelNames) + end if + if (allocated(SrcOutputFileTypeData%ChannelUnits)) then + LB(1:1) = lbound(SrcOutputFileTypeData%ChannelUnits) + UB(1:1) = ubound(SrcOutputFileTypeData%ChannelUnits) + if (.not. allocated(DstOutputFileTypeData%ChannelUnits)) then + allocate(DstOutputFileTypeData%ChannelUnits(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%ChannelUnits.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputFileTypeData%ChannelUnits = SrcOutputFileTypeData%ChannelUnits + else if (allocated(DstOutputFileTypeData%ChannelUnits)) then + deallocate(DstOutputFileTypeData%ChannelUnits) + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyProgDesc(SrcOutputFileTypeData%Module_Ver(i1), DstOutputFileTypeData%Module_Ver(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + DstOutputFileTypeData%Module_Abrev = SrcOutputFileTypeData%Module_Abrev + DstOutputFileTypeData%WriteThisStep = SrcOutputFileTypeData%WriteThisStep + DstOutputFileTypeData%VTK_count = SrcOutputFileTypeData%VTK_count + DstOutputFileTypeData%VTK_LastWaveIndx = SrcOutputFileTypeData%VTK_LastWaveIndx + call FAST_CopyLinFileType(SrcOutputFileTypeData%Lin, DstOutputFileTypeData%Lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstOutputFileTypeData%ActualChanLen = SrcOutputFileTypeData%ActualChanLen + call FAST_CopyLinStateSave(SrcOutputFileTypeData%op, DstOutputFileTypeData%op, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstOutputFileTypeData%DriverWriteOutput = SrcOutputFileTypeData%DriverWriteOutput +end subroutine + +subroutine FAST_DestroyOutputFileType(OutputFileTypeData, ErrStat, ErrMsg) + type(FAST_OutputFileType), intent(inout) :: OutputFileTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyOutputFileType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputFileTypeData%TimeData)) then + deallocate(OutputFileTypeData%TimeData) + end if + if (allocated(OutputFileTypeData%AllOutData)) then + deallocate(OutputFileTypeData%AllOutData) + end if + if (allocated(OutputFileTypeData%ChannelNames)) then + deallocate(OutputFileTypeData%ChannelNames) + end if + if (allocated(OutputFileTypeData%ChannelUnits)) then + deallocate(OutputFileTypeData%ChannelUnits) + end if +end subroutine + +subroutine FAST_PackOutputFileType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(FAST_OutputFileType), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackOutputFileType' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%TimeData)) + if (allocated(InData%TimeData)) then + call RegPackBounds(Buf, 1, lbound(InData%TimeData), ubound(InData%TimeData)) + call RegPack(Buf, InData%TimeData) end if - ! StateRel_x - if (allocated(OutData%StateRel_x)) deallocate(OutData%StateRel_x) - call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%StateRel_x(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StateRel_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%StateRel_x) - if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%AllOutData)) + if (allocated(InData%AllOutData)) then + call RegPackBounds(Buf, 2, lbound(InData%AllOutData), ubound(InData%AllOutData)) + call RegPack(Buf, InData%AllOutData) end if - ! StateRel_xdot - if (allocated(OutData%StateRel_xdot)) deallocate(OutData%StateRel_xdot) - call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%StateRel_xdot(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%StateRel_xdot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%StateRel_xdot) - if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, InData%n_Out) + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, InData%NOutSteps) + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, InData%numOuts) + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, InData%UnOu) + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, InData%UnSum) + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, InData%UnGra) + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, InData%FileDescLines) + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%ChannelNames)) + if (allocated(InData%ChannelNames)) then + call RegPackBounds(Buf, 1, lbound(InData%ChannelNames), ubound(InData%ChannelNames)) + call RegPack(Buf, InData%ChannelNames) end if - ! IsLoad_u - if (allocated(OutData%IsLoad_u)) deallocate(OutData%IsLoad_u) - call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%IsLoad_u(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%IsLoad_u) - if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%ChannelUnits)) + if (allocated(InData%ChannelUnits)) then + call RegPackBounds(Buf, 1, lbound(InData%ChannelUnits), ubound(InData%ChannelUnits)) + call RegPack(Buf, InData%ChannelUnits) end if - ! RotFrame_u - if (allocated(OutData%RotFrame_u)) deallocate(OutData%RotFrame_u) + if (RegCheckErr(Buf, RoutineName)) return + LB(1:1) = lbound(InData%Module_Ver) + UB(1:1) = ubound(InData%Module_Ver) + do i1 = LB(1), UB(1) + call NWTC_Library_PackProgDesc(Buf, InData%Module_Ver(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, InData%Module_Abrev) + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, InData%WriteThisStep) + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, InData%VTK_count) + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, InData%VTK_LastWaveIndx) + if (RegCheckErr(Buf, RoutineName)) return + call FAST_PackLinFileType(Buf, InData%Lin) + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, InData%ActualChanLen) + if (RegCheckErr(Buf, RoutineName)) return + call FAST_PackLinStateSave(Buf, InData%op) + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, InData%DriverWriteOutput) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackOutputFileType(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(FAST_OutputFileType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackOutputFileType' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%TimeData)) deallocate(OutData%TimeData) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(Buf, 1, LB, UB) if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RotFrame_u(LB(1):UB(1)),stat=stat) + allocate(OutData%TimeData(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TimeData.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - call RegUnpack(Buf, OutData%RotFrame_u) + call RegUnpack(Buf, OutData%TimeData) if (RegCheckErr(Buf, RoutineName)) return end if - ! RotFrame_y - if (allocated(OutData%RotFrame_y)) deallocate(OutData%RotFrame_y) + if (allocated(OutData%AllOutData)) deallocate(OutData%AllOutData) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) + call RegUnpackBounds(Buf, 2, LB, UB) if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RotFrame_y(LB(1):UB(1)),stat=stat) + allocate(OutData%AllOutData(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOutData.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - call RegUnpack(Buf, OutData%RotFrame_y) + call RegUnpack(Buf, OutData%AllOutData) if (RegCheckErr(Buf, RoutineName)) return end if - ! RotFrame_x - if (allocated(OutData%RotFrame_x)) deallocate(OutData%RotFrame_x) - call RegUnpack(Buf, IsAllocAssoc) + call RegUnpack(Buf, OutData%n_Out) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%NOutSteps) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%numOuts) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UnOu) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UnSum) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%UnGra) if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RotFrame_x(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%RotFrame_x) - if (RegCheckErr(Buf, RoutineName)) return - end if - ! RotFrame_z - if (allocated(OutData%RotFrame_z)) deallocate(OutData%RotFrame_z) + call RegUnpack(Buf, OutData%FileDescLines) + if (RegCheckErr(Buf, RoutineName)) return + if (allocated(OutData%ChannelNames)) deallocate(OutData%ChannelNames) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(Buf, 1, LB, UB) if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%RotFrame_z(LB(1):UB(1)),stat=stat) + allocate(OutData%ChannelNames(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChannelNames.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - call RegUnpack(Buf, OutData%RotFrame_z) + call RegUnpack(Buf, OutData%ChannelNames) if (RegCheckErr(Buf, RoutineName)) return end if - ! DerivOrder_x - if (allocated(OutData%DerivOrder_x)) deallocate(OutData%DerivOrder_x) + if (allocated(OutData%ChannelUnits)) deallocate(OutData%ChannelUnits) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(Buf, 1, LB, UB) if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%DerivOrder_x(LB(1):UB(1)),stat=stat) + allocate(OutData%ChannelUnits(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChannelUnits.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - call RegUnpack(Buf, OutData%DerivOrder_x) + call RegUnpack(Buf, OutData%ChannelUnits) if (RegCheckErr(Buf, RoutineName)) return end if - ! SizeLin - call RegUnpack(Buf, OutData%SizeLin) + LB(1:1) = lbound(OutData%Module_Ver) + UB(1:1) = ubound(OutData%Module_Ver) + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackProgDesc(Buf, OutData%Module_Ver(i1)) ! Module_Ver + end do + call RegUnpack(Buf, OutData%Module_Abrev) if (RegCheckErr(Buf, RoutineName)) return - ! LinStartIndx - call RegUnpack(Buf, OutData%LinStartIndx) + call RegUnpack(Buf, OutData%WriteThisStep) if (RegCheckErr(Buf, RoutineName)) return - ! NumOutputs - call RegUnpack(Buf, OutData%NumOutputs) + call RegUnpack(Buf, OutData%VTK_count) + if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%VTK_LastWaveIndx) + if (RegCheckErr(Buf, RoutineName)) return + call FAST_UnpackLinFileType(Buf, OutData%Lin) ! Lin + call RegUnpack(Buf, OutData%ActualChanLen) + if (RegCheckErr(Buf, RoutineName)) return + call FAST_UnpackLinStateSave(Buf, OutData%op) ! op + call RegUnpack(Buf, OutData%DriverWriteOutput) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE FAST_CopyModLinType( SrcModLinTypeData, DstModLinTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_ModLinType), INTENT(IN) :: SrcModLinTypeData - TYPE(FAST_ModLinType), INTENT(INOUT) :: DstModLinTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyModLinType' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcModLinTypeData%Instance)) THEN - i1_l = LBOUND(SrcModLinTypeData%Instance,1) - i1_u = UBOUND(SrcModLinTypeData%Instance,1) - IF (.NOT. ALLOCATED(DstModLinTypeData%Instance)) THEN - ALLOCATE(DstModLinTypeData%Instance(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%Instance.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModLinTypeData%Instance,1), UBOUND(SrcModLinTypeData%Instance,1) - CALL FAST_Copylintype( SrcModLinTypeData%Instance(i1), DstModLinTypeData%Instance(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE FAST_CopyModLinType - - SUBROUTINE FAST_DestroyModLinType( ModLinTypeData, ErrStat, ErrMsg ) - TYPE(FAST_ModLinType), INTENT(INOUT) :: ModLinTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyModLinType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ModLinTypeData%Instance)) THEN -DO i1 = LBOUND(ModLinTypeData%Instance,1), UBOUND(ModLinTypeData%Instance,1) - CALL FAST_DestroyLinType( ModLinTypeData%Instance(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModLinTypeData%Instance) -ENDIF - END SUBROUTINE FAST_DestroyModLinType - -subroutine FAST_PackModLinType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf - type(FAST_ModLinType), intent(in) :: InData - character(*), parameter :: RoutineName = 'FAST_PackModLinType' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - ! Instance - call RegPack(Buf, allocated(InData%Instance)) - if (allocated(InData%Instance)) then - call RegPackBounds(Buf, 1, lbound(InData%Instance), ubound(InData%Instance)) - LB(1:1) = lbound(InData%Instance) - UB(1:1) = ubound(InData%Instance) +subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode, ErrStat, ErrMsg) + type(IceDyn_Data), intent(inout) :: SrcIceDyn_DataData + type(IceDyn_Data), intent(inout) :: DstIceDyn_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyIceDyn_Data' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcIceDyn_DataData%x)) then + LB(1:2) = lbound(SrcIceDyn_DataData%x) + UB(1:2) = ubound(SrcIceDyn_DataData%x) + if (.not. allocated(DstIceDyn_DataData%x)) then + allocate(DstIceDyn_DataData%x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_CopyContState(SrcIceDyn_DataData%x(i1,i2), DstIceDyn_DataData%x(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + else if (allocated(DstIceDyn_DataData%x)) then + deallocate(DstIceDyn_DataData%x) + end if + if (allocated(SrcIceDyn_DataData%xd)) then + LB(1:2) = lbound(SrcIceDyn_DataData%xd) + UB(1:2) = ubound(SrcIceDyn_DataData%xd) + if (.not. allocated(DstIceDyn_DataData%xd)) then + allocate(DstIceDyn_DataData%xd(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_CopyDiscState(SrcIceDyn_DataData%xd(i1,i2), DstIceDyn_DataData%xd(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + else if (allocated(DstIceDyn_DataData%xd)) then + deallocate(DstIceDyn_DataData%xd) + end if + if (allocated(SrcIceDyn_DataData%z)) then + LB(1:2) = lbound(SrcIceDyn_DataData%z) + UB(1:2) = ubound(SrcIceDyn_DataData%z) + if (.not. allocated(DstIceDyn_DataData%z)) then + allocate(DstIceDyn_DataData%z(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_CopyConstrState(SrcIceDyn_DataData%z(i1,i2), DstIceDyn_DataData%z(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + else if (allocated(DstIceDyn_DataData%z)) then + deallocate(DstIceDyn_DataData%z) + end if + if (allocated(SrcIceDyn_DataData%OtherSt)) then + LB(1:2) = lbound(SrcIceDyn_DataData%OtherSt) + UB(1:2) = ubound(SrcIceDyn_DataData%OtherSt) + if (.not. allocated(DstIceDyn_DataData%OtherSt)) then + allocate(DstIceDyn_DataData%OtherSt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%OtherSt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_CopyOtherState(SrcIceDyn_DataData%OtherSt(i1,i2), DstIceDyn_DataData%OtherSt(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + else if (allocated(DstIceDyn_DataData%OtherSt)) then + deallocate(DstIceDyn_DataData%OtherSt) + end if + if (allocated(SrcIceDyn_DataData%p)) then + LB(1:1) = lbound(SrcIceDyn_DataData%p) + UB(1:1) = ubound(SrcIceDyn_DataData%p) + if (.not. allocated(DstIceDyn_DataData%p)) then + allocate(DstIceDyn_DataData%p(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%p.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call FAST_PackLinType(Buf, InData%Instance(i1)) + call IceD_CopyParam(SrcIceDyn_DataData%p(i1), DstIceDyn_DataData%p(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstIceDyn_DataData%p)) then + deallocate(DstIceDyn_DataData%p) end if - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine FAST_UnPackModLinType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf - type(FAST_ModLinType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'FAST_UnPackModLinType' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - ! Instance - if (allocated(OutData%Instance)) deallocate(OutData%Instance) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Instance(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Instance.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return + if (allocated(SrcIceDyn_DataData%u)) then + LB(1:1) = lbound(SrcIceDyn_DataData%u) + UB(1:1) = ubound(SrcIceDyn_DataData%u) + if (.not. allocated(DstIceDyn_DataData%u)) then + allocate(DstIceDyn_DataData%u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%u.', ErrStat, ErrMsg, RoutineName) + return + end if end if do i1 = LB(1), UB(1) - call FAST_UnpackLinType(Buf, OutData%Instance(i1)) ! Instance + call IceD_CopyInput(SrcIceDyn_DataData%u(i1), DstIceDyn_DataData%u(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstIceDyn_DataData%u)) then + deallocate(DstIceDyn_DataData%u) + end if + if (allocated(SrcIceDyn_DataData%y)) then + LB(1:1) = lbound(SrcIceDyn_DataData%y) + UB(1:1) = ubound(SrcIceDyn_DataData%y) + if (.not. allocated(DstIceDyn_DataData%y)) then + allocate(DstIceDyn_DataData%y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call IceD_CopyOutput(SrcIceDyn_DataData%y(i1), DstIceDyn_DataData%y(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstIceDyn_DataData%y)) then + deallocate(DstIceDyn_DataData%y) + end if + if (allocated(SrcIceDyn_DataData%m)) then + LB(1:1) = lbound(SrcIceDyn_DataData%m) + UB(1:1) = ubound(SrcIceDyn_DataData%m) + if (.not. allocated(DstIceDyn_DataData%m)) then + allocate(DstIceDyn_DataData%m(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%m.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call IceD_CopyMisc(SrcIceDyn_DataData%m(i1), DstIceDyn_DataData%m(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstIceDyn_DataData%m)) then + deallocate(DstIceDyn_DataData%m) + end if + if (allocated(SrcIceDyn_DataData%Input)) then + LB(1:2) = lbound(SrcIceDyn_DataData%Input) + UB(1:2) = ubound(SrcIceDyn_DataData%Input) + if (.not. allocated(DstIceDyn_DataData%Input)) then + allocate(DstIceDyn_DataData%Input(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_CopyInput(SrcIceDyn_DataData%Input(i1,i2), DstIceDyn_DataData%Input(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + else if (allocated(DstIceDyn_DataData%Input)) then + deallocate(DstIceDyn_DataData%Input) + end if + if (allocated(SrcIceDyn_DataData%InputTimes)) then + LB(1:2) = lbound(SrcIceDyn_DataData%InputTimes) + UB(1:2) = ubound(SrcIceDyn_DataData%InputTimes) + if (.not. allocated(DstIceDyn_DataData%InputTimes)) then + allocate(DstIceDyn_DataData%InputTimes(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstIceDyn_DataData%InputTimes = SrcIceDyn_DataData%InputTimes + else if (allocated(DstIceDyn_DataData%InputTimes)) then + deallocate(DstIceDyn_DataData%InputTimes) end if -end subroutine - SUBROUTINE FAST_CopyLinFileType( SrcLinFileTypeData, DstLinFileTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_LinFileType), INTENT(IN) :: SrcLinFileTypeData - TYPE(FAST_LinFileType), INTENT(INOUT) :: DstLinFileTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyLinFileType' -! - ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcLinFileTypeData%Modules,1), UBOUND(SrcLinFileTypeData%Modules,1) - CALL FAST_Copymodlintype( SrcLinFileTypeData%Modules(i1), DstLinFileTypeData%Modules(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL FAST_Copylintype( SrcLinFileTypeData%Glue, DstLinFileTypeData%Glue, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstLinFileTypeData%RotSpeed = SrcLinFileTypeData%RotSpeed - DstLinFileTypeData%Azimuth = SrcLinFileTypeData%Azimuth - DstLinFileTypeData%WindSpeed = SrcLinFileTypeData%WindSpeed - END SUBROUTINE FAST_CopyLinFileType - - SUBROUTINE FAST_DestroyLinFileType( LinFileTypeData, ErrStat, ErrMsg ) - TYPE(FAST_LinFileType), INTENT(INOUT) :: LinFileTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyLinFileType' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(LinFileTypeData%Modules,1), UBOUND(LinFileTypeData%Modules,1) - CALL FAST_DestroyModLinType( LinFileTypeData%Modules(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL FAST_DestroyLinType( LinFileTypeData%Glue, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE FAST_DestroyLinFileType - - -subroutine FAST_PackLinFileType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf - type(FAST_LinFileType), intent(in) :: InData - character(*), parameter :: RoutineName = 'FAST_PackLinFileType' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - ! Modules - LB(1:1) = lbound(InData%Modules) - UB(1:1) = ubound(InData%Modules) - do i1 = LB(1), UB(1) - call FAST_PackModLinType(Buf, InData%Modules(i1)) - end do - if (RegCheckErr(Buf, RoutineName)) return - ! Glue - call FAST_PackLinType(Buf, InData%Glue) - if (RegCheckErr(Buf, RoutineName)) return - ! RotSpeed - call RegPack(Buf, InData%RotSpeed) - if (RegCheckErr(Buf, RoutineName)) return - ! Azimuth - call RegPack(Buf, InData%Azimuth) - if (RegCheckErr(Buf, RoutineName)) return - ! WindSpeed - call RegPack(Buf, InData%WindSpeed) - if (RegCheckErr(Buf, RoutineName)) return end subroutine -subroutine FAST_UnPackLinFileType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf - type(FAST_LinFileType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'FAST_UnPackLinFileType' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) - if (Buf%ErrStat /= ErrID_None) return - ! Modules - LB(1:1) = lbound(OutData%Modules) - UB(1:1) = ubound(OutData%Modules) - do i1 = LB(1), UB(1) - call FAST_UnpackModLinType(Buf, OutData%Modules(i1)) ! Modules - end do - ! Glue - call FAST_UnpackLinType(Buf, OutData%Glue) ! Glue - ! RotSpeed - call RegUnpack(Buf, OutData%RotSpeed) - if (RegCheckErr(Buf, RoutineName)) return - ! Azimuth - call RegUnpack(Buf, OutData%Azimuth) - if (RegCheckErr(Buf, RoutineName)) return - ! WindSpeed - call RegUnpack(Buf, OutData%WindSpeed) - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - SUBROUTINE FAST_CopyMiscLinType( SrcMiscLinTypeData, DstMiscLinTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_MiscLinType), INTENT(IN) :: SrcMiscLinTypeData - TYPE(FAST_MiscLinType), INTENT(INOUT) :: DstMiscLinTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyMiscLinType' -! +subroutine FAST_DestroyIceDyn_Data(IceDyn_DataData, ErrStat, ErrMsg) + type(IceDyn_Data), intent(inout) :: IceDyn_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyIceDyn_Data' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscLinTypeData%LinTimes)) THEN - i1_l = LBOUND(SrcMiscLinTypeData%LinTimes,1) - i1_u = UBOUND(SrcMiscLinTypeData%LinTimes,1) - IF (.NOT. ALLOCATED(DstMiscLinTypeData%LinTimes)) THEN - ALLOCATE(DstMiscLinTypeData%LinTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%LinTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscLinTypeData%LinTimes = SrcMiscLinTypeData%LinTimes -ENDIF - DstMiscLinTypeData%CopyOP_CtrlCode = SrcMiscLinTypeData%CopyOP_CtrlCode -IF (ALLOCATED(SrcMiscLinTypeData%AzimTarget)) THEN - i1_l = LBOUND(SrcMiscLinTypeData%AzimTarget,1) - i1_u = UBOUND(SrcMiscLinTypeData%AzimTarget,1) - IF (.NOT. ALLOCATED(DstMiscLinTypeData%AzimTarget)) THEN - ALLOCATE(DstMiscLinTypeData%AzimTarget(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%AzimTarget.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscLinTypeData%AzimTarget = SrcMiscLinTypeData%AzimTarget -ENDIF - DstMiscLinTypeData%IsConverged = SrcMiscLinTypeData%IsConverged - DstMiscLinTypeData%FoundSteady = SrcMiscLinTypeData%FoundSteady - DstMiscLinTypeData%ForceLin = SrcMiscLinTypeData%ForceLin - DstMiscLinTypeData%n_rot = SrcMiscLinTypeData%n_rot - DstMiscLinTypeData%AzimIndx = SrcMiscLinTypeData%AzimIndx - DstMiscLinTypeData%NextLinTimeIndx = SrcMiscLinTypeData%NextLinTimeIndx -IF (ALLOCATED(SrcMiscLinTypeData%Psi)) THEN - i1_l = LBOUND(SrcMiscLinTypeData%Psi,1) - i1_u = UBOUND(SrcMiscLinTypeData%Psi,1) - IF (.NOT. ALLOCATED(DstMiscLinTypeData%Psi)) THEN - ALLOCATE(DstMiscLinTypeData%Psi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%Psi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscLinTypeData%Psi = SrcMiscLinTypeData%Psi -ENDIF -IF (ALLOCATED(SrcMiscLinTypeData%y_interp)) THEN - i1_l = LBOUND(SrcMiscLinTypeData%y_interp,1) - i1_u = UBOUND(SrcMiscLinTypeData%y_interp,1) - IF (.NOT. ALLOCATED(DstMiscLinTypeData%y_interp)) THEN - ALLOCATE(DstMiscLinTypeData%y_interp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%y_interp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscLinTypeData%y_interp = SrcMiscLinTypeData%y_interp -ENDIF -IF (ALLOCATED(SrcMiscLinTypeData%y_ref)) THEN - i1_l = LBOUND(SrcMiscLinTypeData%y_ref,1) - i1_u = UBOUND(SrcMiscLinTypeData%y_ref,1) - IF (.NOT. ALLOCATED(DstMiscLinTypeData%y_ref)) THEN - ALLOCATE(DstMiscLinTypeData%y_ref(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%y_ref.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscLinTypeData%y_ref = SrcMiscLinTypeData%y_ref -ENDIF -IF (ALLOCATED(SrcMiscLinTypeData%Y_prevRot)) THEN - i1_l = LBOUND(SrcMiscLinTypeData%Y_prevRot,1) - i1_u = UBOUND(SrcMiscLinTypeData%Y_prevRot,1) - i2_l = LBOUND(SrcMiscLinTypeData%Y_prevRot,2) - i2_u = UBOUND(SrcMiscLinTypeData%Y_prevRot,2) - IF (.NOT. ALLOCATED(DstMiscLinTypeData%Y_prevRot)) THEN - ALLOCATE(DstMiscLinTypeData%Y_prevRot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%Y_prevRot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscLinTypeData%Y_prevRot = SrcMiscLinTypeData%Y_prevRot -ENDIF - END SUBROUTINE FAST_CopyMiscLinType - - SUBROUTINE FAST_DestroyMiscLinType( MiscLinTypeData, ErrStat, ErrMsg ) - TYPE(FAST_MiscLinType), INTENT(INOUT) :: MiscLinTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyMiscLinType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MiscLinTypeData%LinTimes)) THEN - DEALLOCATE(MiscLinTypeData%LinTimes) -ENDIF -IF (ALLOCATED(MiscLinTypeData%AzimTarget)) THEN - DEALLOCATE(MiscLinTypeData%AzimTarget) -ENDIF -IF (ALLOCATED(MiscLinTypeData%Psi)) THEN - DEALLOCATE(MiscLinTypeData%Psi) -ENDIF -IF (ALLOCATED(MiscLinTypeData%y_interp)) THEN - DEALLOCATE(MiscLinTypeData%y_interp) -ENDIF -IF (ALLOCATED(MiscLinTypeData%y_ref)) THEN - DEALLOCATE(MiscLinTypeData%y_ref) -ENDIF -IF (ALLOCATED(MiscLinTypeData%Y_prevRot)) THEN - DEALLOCATE(MiscLinTypeData%Y_prevRot) -ENDIF - END SUBROUTINE FAST_DestroyMiscLinType - + ErrMsg = '' + if (allocated(IceDyn_DataData%x)) then + LB(1:2) = lbound(IceDyn_DataData%x) + UB(1:2) = ubound(IceDyn_DataData%x) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_DestroyContState(IceDyn_DataData%x(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(IceDyn_DataData%x) + end if + if (allocated(IceDyn_DataData%xd)) then + LB(1:2) = lbound(IceDyn_DataData%xd) + UB(1:2) = ubound(IceDyn_DataData%xd) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_DestroyDiscState(IceDyn_DataData%xd(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(IceDyn_DataData%xd) + end if + if (allocated(IceDyn_DataData%z)) then + LB(1:2) = lbound(IceDyn_DataData%z) + UB(1:2) = ubound(IceDyn_DataData%z) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_DestroyConstrState(IceDyn_DataData%z(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(IceDyn_DataData%z) + end if + if (allocated(IceDyn_DataData%OtherSt)) then + LB(1:2) = lbound(IceDyn_DataData%OtherSt) + UB(1:2) = ubound(IceDyn_DataData%OtherSt) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_DestroyOtherState(IceDyn_DataData%OtherSt(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(IceDyn_DataData%OtherSt) + end if + if (allocated(IceDyn_DataData%p)) then + LB(1:1) = lbound(IceDyn_DataData%p) + UB(1:1) = ubound(IceDyn_DataData%p) + do i1 = LB(1), UB(1) + call IceD_DestroyParam(IceDyn_DataData%p(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(IceDyn_DataData%p) + end if + if (allocated(IceDyn_DataData%u)) then + LB(1:1) = lbound(IceDyn_DataData%u) + UB(1:1) = ubound(IceDyn_DataData%u) + do i1 = LB(1), UB(1) + call IceD_DestroyInput(IceDyn_DataData%u(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(IceDyn_DataData%u) + end if + if (allocated(IceDyn_DataData%y)) then + LB(1:1) = lbound(IceDyn_DataData%y) + UB(1:1) = ubound(IceDyn_DataData%y) + do i1 = LB(1), UB(1) + call IceD_DestroyOutput(IceDyn_DataData%y(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(IceDyn_DataData%y) + end if + if (allocated(IceDyn_DataData%m)) then + LB(1:1) = lbound(IceDyn_DataData%m) + UB(1:1) = ubound(IceDyn_DataData%m) + do i1 = LB(1), UB(1) + call IceD_DestroyMisc(IceDyn_DataData%m(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(IceDyn_DataData%m) + end if + if (allocated(IceDyn_DataData%Input)) then + LB(1:2) = lbound(IceDyn_DataData%Input) + UB(1:2) = ubound(IceDyn_DataData%Input) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_DestroyInput(IceDyn_DataData%Input(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(IceDyn_DataData%Input) + end if + if (allocated(IceDyn_DataData%InputTimes)) then + deallocate(IceDyn_DataData%InputTimes) + end if +end subroutine -subroutine FAST_PackMiscLinType(Buf, Indata) +subroutine FAST_PackIceDyn_Data(Buf, Indata) type(PackBuffer), intent(inout) :: Buf - type(FAST_MiscLinType), intent(in) :: InData - character(*), parameter :: RoutineName = 'FAST_PackMiscLinType' + type(IceDyn_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackIceDyn_Data' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return - ! LinTimes - call RegPack(Buf, allocated(InData%LinTimes)) - if (allocated(InData%LinTimes)) then - call RegPackBounds(Buf, 1, lbound(InData%LinTimes), ubound(InData%LinTimes)) - call RegPack(Buf, InData%LinTimes) + call RegPack(Buf, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(Buf, 2, lbound(InData%x), ubound(InData%x)) + LB(1:2) = lbound(InData%x) + UB(1:2) = ubound(InData%x) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_PackContState(Buf, InData%x(i1,i2)) + end do + end do end if if (RegCheckErr(Buf, RoutineName)) return - ! CopyOP_CtrlCode - call RegPack(Buf, InData%CopyOP_CtrlCode) - if (RegCheckErr(Buf, RoutineName)) return - ! AzimTarget - call RegPack(Buf, allocated(InData%AzimTarget)) - if (allocated(InData%AzimTarget)) then - call RegPackBounds(Buf, 1, lbound(InData%AzimTarget), ubound(InData%AzimTarget)) - call RegPack(Buf, InData%AzimTarget) + call RegPack(Buf, allocated(InData%xd)) + if (allocated(InData%xd)) then + call RegPackBounds(Buf, 2, lbound(InData%xd), ubound(InData%xd)) + LB(1:2) = lbound(InData%xd) + UB(1:2) = ubound(InData%xd) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_PackDiscState(Buf, InData%xd(i1,i2)) + end do + end do end if if (RegCheckErr(Buf, RoutineName)) return - ! IsConverged - call RegPack(Buf, InData%IsConverged) - if (RegCheckErr(Buf, RoutineName)) return - ! FoundSteady - call RegPack(Buf, InData%FoundSteady) - if (RegCheckErr(Buf, RoutineName)) return - ! ForceLin - call RegPack(Buf, InData%ForceLin) + call RegPack(Buf, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(Buf, 2, lbound(InData%z), ubound(InData%z)) + LB(1:2) = lbound(InData%z) + UB(1:2) = ubound(InData%z) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_PackConstrState(Buf, InData%z(i1,i2)) + end do + end do + end if if (RegCheckErr(Buf, RoutineName)) return - ! n_rot - call RegPack(Buf, InData%n_rot) + call RegPack(Buf, allocated(InData%OtherSt)) + if (allocated(InData%OtherSt)) then + call RegPackBounds(Buf, 2, lbound(InData%OtherSt), ubound(InData%OtherSt)) + LB(1:2) = lbound(InData%OtherSt) + UB(1:2) = ubound(InData%OtherSt) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_PackOtherState(Buf, InData%OtherSt(i1,i2)) + end do + end do + end if if (RegCheckErr(Buf, RoutineName)) return - ! AzimIndx - call RegPack(Buf, InData%AzimIndx) + call RegPack(Buf, allocated(InData%p)) + if (allocated(InData%p)) then + call RegPackBounds(Buf, 1, lbound(InData%p), ubound(InData%p)) + LB(1:1) = lbound(InData%p) + UB(1:1) = ubound(InData%p) + do i1 = LB(1), UB(1) + call IceD_PackParam(Buf, InData%p(i1)) + end do + end if if (RegCheckErr(Buf, RoutineName)) return - ! NextLinTimeIndx - call RegPack(Buf, InData%NextLinTimeIndx) + call RegPack(Buf, allocated(InData%u)) + if (allocated(InData%u)) then + call RegPackBounds(Buf, 1, lbound(InData%u), ubound(InData%u)) + LB(1:1) = lbound(InData%u) + UB(1:1) = ubound(InData%u) + do i1 = LB(1), UB(1) + call IceD_PackInput(Buf, InData%u(i1)) + end do + end if if (RegCheckErr(Buf, RoutineName)) return - ! Psi - call RegPack(Buf, allocated(InData%Psi)) - if (allocated(InData%Psi)) then - call RegPackBounds(Buf, 1, lbound(InData%Psi), ubound(InData%Psi)) - call RegPack(Buf, InData%Psi) + call RegPack(Buf, allocated(InData%y)) + if (allocated(InData%y)) then + call RegPackBounds(Buf, 1, lbound(InData%y), ubound(InData%y)) + LB(1:1) = lbound(InData%y) + UB(1:1) = ubound(InData%y) + do i1 = LB(1), UB(1) + call IceD_PackOutput(Buf, InData%y(i1)) + end do end if if (RegCheckErr(Buf, RoutineName)) return - ! y_interp - call RegPack(Buf, allocated(InData%y_interp)) - if (allocated(InData%y_interp)) then - call RegPackBounds(Buf, 1, lbound(InData%y_interp), ubound(InData%y_interp)) - call RegPack(Buf, InData%y_interp) + call RegPack(Buf, allocated(InData%m)) + if (allocated(InData%m)) then + call RegPackBounds(Buf, 1, lbound(InData%m), ubound(InData%m)) + LB(1:1) = lbound(InData%m) + UB(1:1) = ubound(InData%m) + do i1 = LB(1), UB(1) + call IceD_PackMisc(Buf, InData%m(i1)) + end do end if if (RegCheckErr(Buf, RoutineName)) return - ! y_ref - call RegPack(Buf, allocated(InData%y_ref)) - if (allocated(InData%y_ref)) then - call RegPackBounds(Buf, 1, lbound(InData%y_ref), ubound(InData%y_ref)) - call RegPack(Buf, InData%y_ref) + call RegPack(Buf, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(Buf, 2, lbound(InData%Input), ubound(InData%Input)) + LB(1:2) = lbound(InData%Input) + UB(1:2) = ubound(InData%Input) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_PackInput(Buf, InData%Input(i1,i2)) + end do + end do end if if (RegCheckErr(Buf, RoutineName)) return - ! Y_prevRot - call RegPack(Buf, allocated(InData%Y_prevRot)) - if (allocated(InData%Y_prevRot)) then - call RegPackBounds(Buf, 2, lbound(InData%Y_prevRot), ubound(InData%Y_prevRot)) - call RegPack(Buf, InData%Y_prevRot) + call RegPack(Buf, allocated(InData%InputTimes)) + if (allocated(InData%InputTimes)) then + call RegPackBounds(Buf, 2, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPack(Buf, InData%InputTimes) end if if (RegCheckErr(Buf, RoutineName)) return end subroutine -subroutine FAST_UnPackMiscLinType(Buf, OutData) +subroutine FAST_UnPackIceDyn_Data(Buf, OutData) type(PackBuffer), intent(inout) :: Buf - type(FAST_MiscLinType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'FAST_UnPackMiscLinType' + type(IceDyn_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackIceDyn_Data' + integer(IntKi) :: i1, i2 integer(IntKi) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! LinTimes - if (allocated(OutData%LinTimes)) deallocate(OutData%LinTimes) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%LinTimes(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%LinTimes) - if (RegCheckErr(Buf, RoutineName)) return - end if - ! CopyOP_CtrlCode - call RegUnpack(Buf, OutData%CopyOP_CtrlCode) - if (RegCheckErr(Buf, RoutineName)) return - ! AzimTarget - if (allocated(OutData%AzimTarget)) deallocate(OutData%AzimTarget) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AzimTarget(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AzimTarget.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%AzimTarget) - if (RegCheckErr(Buf, RoutineName)) return - end if - ! IsConverged - call RegUnpack(Buf, OutData%IsConverged) - if (RegCheckErr(Buf, RoutineName)) return - ! FoundSteady - call RegUnpack(Buf, OutData%FoundSteady) - if (RegCheckErr(Buf, RoutineName)) return - ! ForceLin - call RegUnpack(Buf, OutData%ForceLin) - if (RegCheckErr(Buf, RoutineName)) return - ! n_rot - call RegUnpack(Buf, OutData%n_rot) - if (RegCheckErr(Buf, RoutineName)) return - ! AzimIndx - call RegUnpack(Buf, OutData%AzimIndx) - if (RegCheckErr(Buf, RoutineName)) return - ! NextLinTimeIndx - call RegUnpack(Buf, OutData%NextLinTimeIndx) - if (RegCheckErr(Buf, RoutineName)) return - ! Psi - if (allocated(OutData%Psi)) deallocate(OutData%Psi) + if (allocated(OutData%x)) deallocate(OutData%x) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) + call RegUnpackBounds(Buf, 2, LB, UB) if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Psi(LB(1):UB(1)),stat=stat) + allocate(OutData%x(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Psi.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - call RegUnpack(Buf, OutData%Psi) - if (RegCheckErr(Buf, RoutineName)) return + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_UnpackContState(Buf, OutData%x(i1,i2)) ! x + end do + end do end if - ! y_interp - if (allocated(OutData%y_interp)) deallocate(OutData%y_interp) + if (allocated(OutData%xd)) deallocate(OutData%xd) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) + call RegUnpackBounds(Buf, 2, LB, UB) if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%y_interp(LB(1):UB(1)),stat=stat) + allocate(OutData%xd(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_interp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - call RegUnpack(Buf, OutData%y_interp) - if (RegCheckErr(Buf, RoutineName)) return + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_UnpackDiscState(Buf, OutData%xd(i1,i2)) ! xd + end do + end do end if - ! y_ref - if (allocated(OutData%y_ref)) deallocate(OutData%y_ref) + if (allocated(OutData%z)) deallocate(OutData%z) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) + call RegUnpackBounds(Buf, 2, LB, UB) if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%y_ref(LB(1):UB(1)),stat=stat) + allocate(OutData%z(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_ref.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - call RegUnpack(Buf, OutData%y_ref) - if (RegCheckErr(Buf, RoutineName)) return + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_UnpackConstrState(Buf, OutData%z(i1,i2)) ! z + end do + end do end if - ! Y_prevRot - if (allocated(OutData%Y_prevRot)) deallocate(OutData%Y_prevRot) + if (allocated(OutData%OtherSt)) deallocate(OutData%OtherSt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(Buf, 2, LB, UB) if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Y_prevRot(LB(1):UB(1),LB(2):UB(2)),stat=stat) + allocate(OutData%OtherSt(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y_prevRot.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - call RegUnpack(Buf, OutData%Y_prevRot) - if (RegCheckErr(Buf, RoutineName)) return - end if -end subroutine - SUBROUTINE FAST_CopyOutputFileType( SrcOutputFileTypeData, DstOutputFileTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_OutputFileType), INTENT(INOUT) :: SrcOutputFileTypeData - TYPE(FAST_OutputFileType), INTENT(INOUT) :: DstOutputFileTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyOutputFileType' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputFileTypeData%TimeData)) THEN - i1_l = LBOUND(SrcOutputFileTypeData%TimeData,1) - i1_u = UBOUND(SrcOutputFileTypeData%TimeData,1) - IF (.NOT. ALLOCATED(DstOutputFileTypeData%TimeData)) THEN - ALLOCATE(DstOutputFileTypeData%TimeData(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%TimeData.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputFileTypeData%TimeData = SrcOutputFileTypeData%TimeData -ENDIF -IF (ALLOCATED(SrcOutputFileTypeData%AllOutData)) THEN - i1_l = LBOUND(SrcOutputFileTypeData%AllOutData,1) - i1_u = UBOUND(SrcOutputFileTypeData%AllOutData,1) - i2_l = LBOUND(SrcOutputFileTypeData%AllOutData,2) - i2_u = UBOUND(SrcOutputFileTypeData%AllOutData,2) - IF (.NOT. ALLOCATED(DstOutputFileTypeData%AllOutData)) THEN - ALLOCATE(DstOutputFileTypeData%AllOutData(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%AllOutData.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputFileTypeData%AllOutData = SrcOutputFileTypeData%AllOutData -ENDIF - DstOutputFileTypeData%n_Out = SrcOutputFileTypeData%n_Out - DstOutputFileTypeData%NOutSteps = SrcOutputFileTypeData%NOutSteps - DstOutputFileTypeData%numOuts = SrcOutputFileTypeData%numOuts - DstOutputFileTypeData%UnOu = SrcOutputFileTypeData%UnOu - DstOutputFileTypeData%UnSum = SrcOutputFileTypeData%UnSum - DstOutputFileTypeData%UnGra = SrcOutputFileTypeData%UnGra - DstOutputFileTypeData%FileDescLines = SrcOutputFileTypeData%FileDescLines -IF (ALLOCATED(SrcOutputFileTypeData%ChannelNames)) THEN - i1_l = LBOUND(SrcOutputFileTypeData%ChannelNames,1) - i1_u = UBOUND(SrcOutputFileTypeData%ChannelNames,1) - IF (.NOT. ALLOCATED(DstOutputFileTypeData%ChannelNames)) THEN - ALLOCATE(DstOutputFileTypeData%ChannelNames(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%ChannelNames.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputFileTypeData%ChannelNames = SrcOutputFileTypeData%ChannelNames -ENDIF -IF (ALLOCATED(SrcOutputFileTypeData%ChannelUnits)) THEN - i1_l = LBOUND(SrcOutputFileTypeData%ChannelUnits,1) - i1_u = UBOUND(SrcOutputFileTypeData%ChannelUnits,1) - IF (.NOT. ALLOCATED(DstOutputFileTypeData%ChannelUnits)) THEN - ALLOCATE(DstOutputFileTypeData%ChannelUnits(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%ChannelUnits.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputFileTypeData%ChannelUnits = SrcOutputFileTypeData%ChannelUnits -ENDIF - DO i1 = LBOUND(SrcOutputFileTypeData%Module_Ver,1), UBOUND(SrcOutputFileTypeData%Module_Ver,1) - CALL NWTC_Library_Copyprogdesc( SrcOutputFileTypeData%Module_Ver(i1), DstOutputFileTypeData%Module_Ver(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DstOutputFileTypeData%Module_Abrev = SrcOutputFileTypeData%Module_Abrev - DstOutputFileTypeData%WriteThisStep = SrcOutputFileTypeData%WriteThisStep - DstOutputFileTypeData%VTK_count = SrcOutputFileTypeData%VTK_count - DstOutputFileTypeData%VTK_LastWaveIndx = SrcOutputFileTypeData%VTK_LastWaveIndx - CALL FAST_Copylinfiletype( SrcOutputFileTypeData%Lin, DstOutputFileTypeData%Lin, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstOutputFileTypeData%ActualChanLen = SrcOutputFileTypeData%ActualChanLen - CALL FAST_Copylinstatesave( SrcOutputFileTypeData%op, DstOutputFileTypeData%op, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstOutputFileTypeData%DriverWriteOutput = SrcOutputFileTypeData%DriverWriteOutput - END SUBROUTINE FAST_CopyOutputFileType - - SUBROUTINE FAST_DestroyOutputFileType( OutputFileTypeData, ErrStat, ErrMsg ) - TYPE(FAST_OutputFileType), INTENT(INOUT) :: OutputFileTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyOutputFileType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OutputFileTypeData%TimeData)) THEN - DEALLOCATE(OutputFileTypeData%TimeData) -ENDIF -IF (ALLOCATED(OutputFileTypeData%AllOutData)) THEN - DEALLOCATE(OutputFileTypeData%AllOutData) -ENDIF -IF (ALLOCATED(OutputFileTypeData%ChannelNames)) THEN - DEALLOCATE(OutputFileTypeData%ChannelNames) -ENDIF -IF (ALLOCATED(OutputFileTypeData%ChannelUnits)) THEN - DEALLOCATE(OutputFileTypeData%ChannelUnits) -ENDIF -DO i1 = LBOUND(OutputFileTypeData%Module_Ver,1), UBOUND(OutputFileTypeData%Module_Ver,1) - CALL NWTC_Library_DestroyProgDesc( OutputFileTypeData%Module_Ver(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL FAST_DestroyLinFileType( OutputFileTypeData%Lin, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroyLinStateSave( OutputFileTypeData%op, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE FAST_DestroyOutputFileType - - -subroutine FAST_PackOutputFileType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf - type(FAST_OutputFileType), intent(in) :: InData - character(*), parameter :: RoutineName = 'FAST_PackOutputFileType' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) - if (Buf%ErrStat >= AbortErrLev) return - ! TimeData - call RegPack(Buf, allocated(InData%TimeData)) - if (allocated(InData%TimeData)) then - call RegPackBounds(Buf, 1, lbound(InData%TimeData), ubound(InData%TimeData)) - call RegPack(Buf, InData%TimeData) - end if - if (RegCheckErr(Buf, RoutineName)) return - ! AllOutData - call RegPack(Buf, allocated(InData%AllOutData)) - if (allocated(InData%AllOutData)) then - call RegPackBounds(Buf, 2, lbound(InData%AllOutData), ubound(InData%AllOutData)) - call RegPack(Buf, InData%AllOutData) - end if - if (RegCheckErr(Buf, RoutineName)) return - ! n_Out - call RegPack(Buf, InData%n_Out) - if (RegCheckErr(Buf, RoutineName)) return - ! NOutSteps - call RegPack(Buf, InData%NOutSteps) - if (RegCheckErr(Buf, RoutineName)) return - ! numOuts - call RegPack(Buf, InData%numOuts) - if (RegCheckErr(Buf, RoutineName)) return - ! UnOu - call RegPack(Buf, InData%UnOu) - if (RegCheckErr(Buf, RoutineName)) return - ! UnSum - call RegPack(Buf, InData%UnSum) - if (RegCheckErr(Buf, RoutineName)) return - ! UnGra - call RegPack(Buf, InData%UnGra) - if (RegCheckErr(Buf, RoutineName)) return - ! FileDescLines - call RegPack(Buf, InData%FileDescLines) - if (RegCheckErr(Buf, RoutineName)) return - ! ChannelNames - call RegPack(Buf, allocated(InData%ChannelNames)) - if (allocated(InData%ChannelNames)) then - call RegPackBounds(Buf, 1, lbound(InData%ChannelNames), ubound(InData%ChannelNames)) - call RegPack(Buf, InData%ChannelNames) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_UnpackOtherState(Buf, OutData%OtherSt(i1,i2)) ! OtherSt + end do + end do end if + if (allocated(OutData%p)) deallocate(OutData%p) + call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return - ! ChannelUnits - call RegPack(Buf, allocated(InData%ChannelUnits)) - if (allocated(InData%ChannelUnits)) then - call RegPackBounds(Buf, 1, lbound(InData%ChannelUnits), ubound(InData%ChannelUnits)) - call RegPack(Buf, InData%ChannelUnits) + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%p(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%p.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceD_UnpackParam(Buf, OutData%p(i1)) ! p + end do end if + if (allocated(OutData%u)) deallocate(OutData%u) + call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return - ! Module_Ver - LB(1:1) = lbound(InData%Module_Ver) - UB(1:1) = ubound(InData%Module_Ver) - do i1 = LB(1), UB(1) - call NWTC_Library_PackProgDesc(Buf, InData%Module_Ver(i1)) - end do - if (RegCheckErr(Buf, RoutineName)) return - ! Module_Abrev - call RegPack(Buf, InData%Module_Abrev) - if (RegCheckErr(Buf, RoutineName)) return - ! WriteThisStep - call RegPack(Buf, InData%WriteThisStep) - if (RegCheckErr(Buf, RoutineName)) return - ! VTK_count - call RegPack(Buf, InData%VTK_count) - if (RegCheckErr(Buf, RoutineName)) return - ! VTK_LastWaveIndx - call RegPack(Buf, InData%VTK_LastWaveIndx) - if (RegCheckErr(Buf, RoutineName)) return - ! Lin - call FAST_PackLinFileType(Buf, InData%Lin) - if (RegCheckErr(Buf, RoutineName)) return - ! ActualChanLen - call RegPack(Buf, InData%ActualChanLen) - if (RegCheckErr(Buf, RoutineName)) return - ! op - call FAST_PackLinStateSave(Buf, InData%op) - if (RegCheckErr(Buf, RoutineName)) return - ! DriverWriteOutput - call RegPack(Buf, InData%DriverWriteOutput) - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine FAST_UnPackOutputFileType(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf - type(FAST_OutputFileType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'FAST_UnPackOutputFileType' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - ! TimeData - if (allocated(OutData%TimeData)) deallocate(OutData%TimeData) + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%u(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceD_UnpackInput(Buf, OutData%u(i1)) ! u + end do + end if + if (allocated(OutData%y)) deallocate(OutData%y) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(Buf, 1, LB, UB) if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%TimeData(LB(1):UB(1)),stat=stat) + allocate(OutData%y(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%TimeData.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - call RegUnpack(Buf, OutData%TimeData) + do i1 = LB(1), UB(1) + call IceD_UnpackOutput(Buf, OutData%y(i1)) ! y + end do + end if + if (allocated(OutData%m)) deallocate(OutData%m) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%m(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%m.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call IceD_UnpackMisc(Buf, OutData%m(i1)) ! m + end do end if - ! AllOutData - if (allocated(OutData%AllOutData)) deallocate(OutData%AllOutData) + if (allocated(OutData%Input)) deallocate(OutData%Input) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(Buf, 2, LB, UB) if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%AllOutData(LB(1):UB(1),LB(2):UB(2)),stat=stat) + allocate(OutData%Input(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOutData.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - call RegUnpack(Buf, OutData%AllOutData) - if (RegCheckErr(Buf, RoutineName)) return + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call IceD_UnpackInput(Buf, OutData%Input(i1,i2)) ! Input + end do + end do end if - ! n_Out - call RegUnpack(Buf, OutData%n_Out) - if (RegCheckErr(Buf, RoutineName)) return - ! NOutSteps - call RegUnpack(Buf, OutData%NOutSteps) - if (RegCheckErr(Buf, RoutineName)) return - ! numOuts - call RegUnpack(Buf, OutData%numOuts) - if (RegCheckErr(Buf, RoutineName)) return - ! UnOu - call RegUnpack(Buf, OutData%UnOu) - if (RegCheckErr(Buf, RoutineName)) return - ! UnSum - call RegUnpack(Buf, OutData%UnSum) - if (RegCheckErr(Buf, RoutineName)) return - ! UnGra - call RegUnpack(Buf, OutData%UnGra) - if (RegCheckErr(Buf, RoutineName)) return - ! FileDescLines - call RegUnpack(Buf, OutData%FileDescLines) - if (RegCheckErr(Buf, RoutineName)) return - ! ChannelNames - if (allocated(OutData%ChannelNames)) deallocate(OutData%ChannelNames) + if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) + call RegUnpackBounds(Buf, 2, LB, UB) if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ChannelNames(LB(1):UB(1)),stat=stat) + allocate(OutData%InputTimes(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChannelNames.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - call RegUnpack(Buf, OutData%ChannelNames) + call RegUnpack(Buf, OutData%InputTimes) if (RegCheckErr(Buf, RoutineName)) return end if - ! ChannelUnits - if (allocated(OutData%ChannelUnits)) deallocate(OutData%ChannelUnits) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%ChannelUnits(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChannelUnits.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%ChannelUnits) - if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlCode, ErrStat, ErrMsg) + type(BeamDyn_Data), intent(inout) :: SrcBeamDyn_DataData + type(BeamDyn_Data), intent(inout) :: DstBeamDyn_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyBeamDyn_Data' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcBeamDyn_DataData%x)) then + LB(1:2) = lbound(SrcBeamDyn_DataData%x) + UB(1:2) = ubound(SrcBeamDyn_DataData%x) + if (.not. allocated(DstBeamDyn_DataData%x)) then + allocate(DstBeamDyn_DataData%x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_CopyContState(SrcBeamDyn_DataData%x(i1,i2), DstBeamDyn_DataData%x(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + else if (allocated(DstBeamDyn_DataData%x)) then + deallocate(DstBeamDyn_DataData%x) + end if + if (allocated(SrcBeamDyn_DataData%xd)) then + LB(1:2) = lbound(SrcBeamDyn_DataData%xd) + UB(1:2) = ubound(SrcBeamDyn_DataData%xd) + if (.not. allocated(DstBeamDyn_DataData%xd)) then + allocate(DstBeamDyn_DataData%xd(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_CopyDiscState(SrcBeamDyn_DataData%xd(i1,i2), DstBeamDyn_DataData%xd(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + else if (allocated(DstBeamDyn_DataData%xd)) then + deallocate(DstBeamDyn_DataData%xd) + end if + if (allocated(SrcBeamDyn_DataData%z)) then + LB(1:2) = lbound(SrcBeamDyn_DataData%z) + UB(1:2) = ubound(SrcBeamDyn_DataData%z) + if (.not. allocated(DstBeamDyn_DataData%z)) then + allocate(DstBeamDyn_DataData%z(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_CopyConstrState(SrcBeamDyn_DataData%z(i1,i2), DstBeamDyn_DataData%z(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + else if (allocated(DstBeamDyn_DataData%z)) then + deallocate(DstBeamDyn_DataData%z) + end if + if (allocated(SrcBeamDyn_DataData%OtherSt)) then + LB(1:2) = lbound(SrcBeamDyn_DataData%OtherSt) + UB(1:2) = ubound(SrcBeamDyn_DataData%OtherSt) + if (.not. allocated(DstBeamDyn_DataData%OtherSt)) then + allocate(DstBeamDyn_DataData%OtherSt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%OtherSt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_CopyOtherState(SrcBeamDyn_DataData%OtherSt(i1,i2), DstBeamDyn_DataData%OtherSt(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + else if (allocated(DstBeamDyn_DataData%OtherSt)) then + deallocate(DstBeamDyn_DataData%OtherSt) + end if + if (allocated(SrcBeamDyn_DataData%p)) then + LB(1:1) = lbound(SrcBeamDyn_DataData%p) + UB(1:1) = ubound(SrcBeamDyn_DataData%p) + if (.not. allocated(DstBeamDyn_DataData%p)) then + allocate(DstBeamDyn_DataData%p(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%p.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call BD_CopyParam(SrcBeamDyn_DataData%p(i1), DstBeamDyn_DataData%p(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstBeamDyn_DataData%p)) then + deallocate(DstBeamDyn_DataData%p) + end if + if (allocated(SrcBeamDyn_DataData%u)) then + LB(1:1) = lbound(SrcBeamDyn_DataData%u) + UB(1:1) = ubound(SrcBeamDyn_DataData%u) + if (.not. allocated(DstBeamDyn_DataData%u)) then + allocate(DstBeamDyn_DataData%u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call BD_CopyInput(SrcBeamDyn_DataData%u(i1), DstBeamDyn_DataData%u(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstBeamDyn_DataData%u)) then + deallocate(DstBeamDyn_DataData%u) + end if + if (allocated(SrcBeamDyn_DataData%y)) then + LB(1:1) = lbound(SrcBeamDyn_DataData%y) + UB(1:1) = ubound(SrcBeamDyn_DataData%y) + if (.not. allocated(DstBeamDyn_DataData%y)) then + allocate(DstBeamDyn_DataData%y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call BD_CopyOutput(SrcBeamDyn_DataData%y(i1), DstBeamDyn_DataData%y(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstBeamDyn_DataData%y)) then + deallocate(DstBeamDyn_DataData%y) + end if + if (allocated(SrcBeamDyn_DataData%m)) then + LB(1:1) = lbound(SrcBeamDyn_DataData%m) + UB(1:1) = ubound(SrcBeamDyn_DataData%m) + if (.not. allocated(DstBeamDyn_DataData%m)) then + allocate(DstBeamDyn_DataData%m(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%m.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call BD_CopyMisc(SrcBeamDyn_DataData%m(i1), DstBeamDyn_DataData%m(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstBeamDyn_DataData%m)) then + deallocate(DstBeamDyn_DataData%m) + end if + if (allocated(SrcBeamDyn_DataData%Output)) then + LB(1:2) = lbound(SrcBeamDyn_DataData%Output) + UB(1:2) = ubound(SrcBeamDyn_DataData%Output) + if (.not. allocated(DstBeamDyn_DataData%Output)) then + allocate(DstBeamDyn_DataData%Output(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%Output.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_CopyOutput(SrcBeamDyn_DataData%Output(i1,i2), DstBeamDyn_DataData%Output(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + else if (allocated(DstBeamDyn_DataData%Output)) then + deallocate(DstBeamDyn_DataData%Output) + end if + if (allocated(SrcBeamDyn_DataData%y_interp)) then + LB(1:1) = lbound(SrcBeamDyn_DataData%y_interp) + UB(1:1) = ubound(SrcBeamDyn_DataData%y_interp) + if (.not. allocated(DstBeamDyn_DataData%y_interp)) then + allocate(DstBeamDyn_DataData%y_interp(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%y_interp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call BD_CopyOutput(SrcBeamDyn_DataData%y_interp(i1), DstBeamDyn_DataData%y_interp(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstBeamDyn_DataData%y_interp)) then + deallocate(DstBeamDyn_DataData%y_interp) + end if + if (allocated(SrcBeamDyn_DataData%Input)) then + LB(1:2) = lbound(SrcBeamDyn_DataData%Input) + UB(1:2) = ubound(SrcBeamDyn_DataData%Input) + if (.not. allocated(DstBeamDyn_DataData%Input)) then + allocate(DstBeamDyn_DataData%Input(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_CopyInput(SrcBeamDyn_DataData%Input(i1,i2), DstBeamDyn_DataData%Input(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + else if (allocated(DstBeamDyn_DataData%Input)) then + deallocate(DstBeamDyn_DataData%Input) + end if + if (allocated(SrcBeamDyn_DataData%InputTimes)) then + LB(1:2) = lbound(SrcBeamDyn_DataData%InputTimes) + UB(1:2) = ubound(SrcBeamDyn_DataData%InputTimes) + if (.not. allocated(DstBeamDyn_DataData%InputTimes)) then + allocate(DstBeamDyn_DataData%InputTimes(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBeamDyn_DataData%InputTimes = SrcBeamDyn_DataData%InputTimes + else if (allocated(DstBeamDyn_DataData%InputTimes)) then + deallocate(DstBeamDyn_DataData%InputTimes) + end if +end subroutine + +subroutine FAST_DestroyBeamDyn_Data(BeamDyn_DataData, ErrStat, ErrMsg) + type(BeamDyn_Data), intent(inout) :: BeamDyn_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyBeamDyn_Data' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(BeamDyn_DataData%x)) then + LB(1:2) = lbound(BeamDyn_DataData%x) + UB(1:2) = ubound(BeamDyn_DataData%x) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_DestroyContState(BeamDyn_DataData%x(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(BeamDyn_DataData%x) + end if + if (allocated(BeamDyn_DataData%xd)) then + LB(1:2) = lbound(BeamDyn_DataData%xd) + UB(1:2) = ubound(BeamDyn_DataData%xd) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_DestroyDiscState(BeamDyn_DataData%xd(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(BeamDyn_DataData%xd) + end if + if (allocated(BeamDyn_DataData%z)) then + LB(1:2) = lbound(BeamDyn_DataData%z) + UB(1:2) = ubound(BeamDyn_DataData%z) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_DestroyConstrState(BeamDyn_DataData%z(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(BeamDyn_DataData%z) + end if + if (allocated(BeamDyn_DataData%OtherSt)) then + LB(1:2) = lbound(BeamDyn_DataData%OtherSt) + UB(1:2) = ubound(BeamDyn_DataData%OtherSt) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_DestroyOtherState(BeamDyn_DataData%OtherSt(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(BeamDyn_DataData%OtherSt) + end if + if (allocated(BeamDyn_DataData%p)) then + LB(1:1) = lbound(BeamDyn_DataData%p) + UB(1:1) = ubound(BeamDyn_DataData%p) + do i1 = LB(1), UB(1) + call BD_DestroyParam(BeamDyn_DataData%p(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(BeamDyn_DataData%p) + end if + if (allocated(BeamDyn_DataData%u)) then + LB(1:1) = lbound(BeamDyn_DataData%u) + UB(1:1) = ubound(BeamDyn_DataData%u) + do i1 = LB(1), UB(1) + call BD_DestroyInput(BeamDyn_DataData%u(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(BeamDyn_DataData%u) + end if + if (allocated(BeamDyn_DataData%y)) then + LB(1:1) = lbound(BeamDyn_DataData%y) + UB(1:1) = ubound(BeamDyn_DataData%y) + do i1 = LB(1), UB(1) + call BD_DestroyOutput(BeamDyn_DataData%y(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(BeamDyn_DataData%y) + end if + if (allocated(BeamDyn_DataData%m)) then + LB(1:1) = lbound(BeamDyn_DataData%m) + UB(1:1) = ubound(BeamDyn_DataData%m) + do i1 = LB(1), UB(1) + call BD_DestroyMisc(BeamDyn_DataData%m(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(BeamDyn_DataData%m) + end if + if (allocated(BeamDyn_DataData%Output)) then + LB(1:2) = lbound(BeamDyn_DataData%Output) + UB(1:2) = ubound(BeamDyn_DataData%Output) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_DestroyOutput(BeamDyn_DataData%Output(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(BeamDyn_DataData%Output) + end if + if (allocated(BeamDyn_DataData%y_interp)) then + LB(1:1) = lbound(BeamDyn_DataData%y_interp) + UB(1:1) = ubound(BeamDyn_DataData%y_interp) + do i1 = LB(1), UB(1) + call BD_DestroyOutput(BeamDyn_DataData%y_interp(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(BeamDyn_DataData%y_interp) + end if + if (allocated(BeamDyn_DataData%Input)) then + LB(1:2) = lbound(BeamDyn_DataData%Input) + UB(1:2) = ubound(BeamDyn_DataData%Input) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_DestroyInput(BeamDyn_DataData%Input(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(BeamDyn_DataData%Input) + end if + if (allocated(BeamDyn_DataData%InputTimes)) then + deallocate(BeamDyn_DataData%InputTimes) end if - ! Module_Ver - LB(1:1) = lbound(OutData%Module_Ver) - UB(1:1) = ubound(OutData%Module_Ver) - do i1 = LB(1), UB(1) - call NWTC_Library_UnpackProgDesc(Buf, OutData%Module_Ver(i1)) ! Module_Ver - end do - ! Module_Abrev - call RegUnpack(Buf, OutData%Module_Abrev) - if (RegCheckErr(Buf, RoutineName)) return - ! WriteThisStep - call RegUnpack(Buf, OutData%WriteThisStep) - if (RegCheckErr(Buf, RoutineName)) return - ! VTK_count - call RegUnpack(Buf, OutData%VTK_count) - if (RegCheckErr(Buf, RoutineName)) return - ! VTK_LastWaveIndx - call RegUnpack(Buf, OutData%VTK_LastWaveIndx) - if (RegCheckErr(Buf, RoutineName)) return - ! Lin - call FAST_UnpackLinFileType(Buf, OutData%Lin) ! Lin - ! ActualChanLen - call RegUnpack(Buf, OutData%ActualChanLen) - if (RegCheckErr(Buf, RoutineName)) return - ! op - call FAST_UnpackLinStateSave(Buf, OutData%op) ! op - ! DriverWriteOutput - call RegUnpack(Buf, OutData%DriverWriteOutput) - if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE FAST_CopyIceDyn_Data( SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceDyn_Data), INTENT(INOUT) :: SrcIceDyn_DataData - TYPE(IceDyn_Data), INTENT(INOUT) :: DstIceDyn_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyIceDyn_Data' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcIceDyn_DataData%x)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%x,1) - i1_u = UBOUND(SrcIceDyn_DataData%x,1) - i2_l = LBOUND(SrcIceDyn_DataData%x,2) - i2_u = UBOUND(SrcIceDyn_DataData%x,2) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%x)) THEN - ALLOCATE(DstIceDyn_DataData%x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcIceDyn_DataData%x,2), UBOUND(SrcIceDyn_DataData%x,2) - DO i1 = LBOUND(SrcIceDyn_DataData%x,1), UBOUND(SrcIceDyn_DataData%x,1) - CALL IceD_CopyContState( SrcIceDyn_DataData%x(i1,i2), DstIceDyn_DataData%x(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%xd)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%xd,1) - i1_u = UBOUND(SrcIceDyn_DataData%xd,1) - i2_l = LBOUND(SrcIceDyn_DataData%xd,2) - i2_u = UBOUND(SrcIceDyn_DataData%xd,2) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%xd)) THEN - ALLOCATE(DstIceDyn_DataData%xd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcIceDyn_DataData%xd,2), UBOUND(SrcIceDyn_DataData%xd,2) - DO i1 = LBOUND(SrcIceDyn_DataData%xd,1), UBOUND(SrcIceDyn_DataData%xd,1) - CALL IceD_CopyDiscState( SrcIceDyn_DataData%xd(i1,i2), DstIceDyn_DataData%xd(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%z)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%z,1) - i1_u = UBOUND(SrcIceDyn_DataData%z,1) - i2_l = LBOUND(SrcIceDyn_DataData%z,2) - i2_u = UBOUND(SrcIceDyn_DataData%z,2) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%z)) THEN - ALLOCATE(DstIceDyn_DataData%z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcIceDyn_DataData%z,2), UBOUND(SrcIceDyn_DataData%z,2) - DO i1 = LBOUND(SrcIceDyn_DataData%z,1), UBOUND(SrcIceDyn_DataData%z,1) - CALL IceD_CopyConstrState( SrcIceDyn_DataData%z(i1,i2), DstIceDyn_DataData%z(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%OtherSt)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%OtherSt,1) - i1_u = UBOUND(SrcIceDyn_DataData%OtherSt,1) - i2_l = LBOUND(SrcIceDyn_DataData%OtherSt,2) - i2_u = UBOUND(SrcIceDyn_DataData%OtherSt,2) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%OtherSt)) THEN - ALLOCATE(DstIceDyn_DataData%OtherSt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%OtherSt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcIceDyn_DataData%OtherSt,2), UBOUND(SrcIceDyn_DataData%OtherSt,2) - DO i1 = LBOUND(SrcIceDyn_DataData%OtherSt,1), UBOUND(SrcIceDyn_DataData%OtherSt,1) - CALL IceD_CopyOtherState( SrcIceDyn_DataData%OtherSt(i1,i2), DstIceDyn_DataData%OtherSt(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%p)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%p,1) - i1_u = UBOUND(SrcIceDyn_DataData%p,1) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%p)) THEN - ALLOCATE(DstIceDyn_DataData%p(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%p.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcIceDyn_DataData%p,1), UBOUND(SrcIceDyn_DataData%p,1) - CALL IceD_CopyParam( SrcIceDyn_DataData%p(i1), DstIceDyn_DataData%p(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%u)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%u,1) - i1_u = UBOUND(SrcIceDyn_DataData%u,1) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%u)) THEN - ALLOCATE(DstIceDyn_DataData%u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcIceDyn_DataData%u,1), UBOUND(SrcIceDyn_DataData%u,1) - CALL IceD_CopyInput( SrcIceDyn_DataData%u(i1), DstIceDyn_DataData%u(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%y)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%y,1) - i1_u = UBOUND(SrcIceDyn_DataData%y,1) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%y)) THEN - ALLOCATE(DstIceDyn_DataData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcIceDyn_DataData%y,1), UBOUND(SrcIceDyn_DataData%y,1) - CALL IceD_CopyOutput( SrcIceDyn_DataData%y(i1), DstIceDyn_DataData%y(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%m)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%m,1) - i1_u = UBOUND(SrcIceDyn_DataData%m,1) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%m)) THEN - ALLOCATE(DstIceDyn_DataData%m(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%m.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcIceDyn_DataData%m,1), UBOUND(SrcIceDyn_DataData%m,1) - CALL IceD_CopyMisc( SrcIceDyn_DataData%m(i1), DstIceDyn_DataData%m(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%Input,1) - i1_u = UBOUND(SrcIceDyn_DataData%Input,1) - i2_l = LBOUND(SrcIceDyn_DataData%Input,2) - i2_u = UBOUND(SrcIceDyn_DataData%Input,2) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%Input)) THEN - ALLOCATE(DstIceDyn_DataData%Input(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcIceDyn_DataData%Input,2), UBOUND(SrcIceDyn_DataData%Input,2) - DO i1 = LBOUND(SrcIceDyn_DataData%Input,1), UBOUND(SrcIceDyn_DataData%Input,1) - CALL IceD_CopyInput( SrcIceDyn_DataData%Input(i1,i2), DstIceDyn_DataData%Input(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcIceDyn_DataData%InputTimes,1) - i2_l = LBOUND(SrcIceDyn_DataData%InputTimes,2) - i2_u = UBOUND(SrcIceDyn_DataData%InputTimes,2) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%InputTimes)) THEN - ALLOCATE(DstIceDyn_DataData%InputTimes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstIceDyn_DataData%InputTimes = SrcIceDyn_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyIceDyn_Data - - SUBROUTINE FAST_DestroyIceDyn_Data( IceDyn_DataData, ErrStat, ErrMsg ) - TYPE(IceDyn_Data), INTENT(INOUT) :: IceDyn_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyIceDyn_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(IceDyn_DataData%x)) THEN -DO i2 = LBOUND(IceDyn_DataData%x,2), UBOUND(IceDyn_DataData%x,2) -DO i1 = LBOUND(IceDyn_DataData%x,1), UBOUND(IceDyn_DataData%x,1) - CALL IceD_DestroyContState( IceDyn_DataData%x(i1,i2), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(IceDyn_DataData%x) -ENDIF -IF (ALLOCATED(IceDyn_DataData%xd)) THEN -DO i2 = LBOUND(IceDyn_DataData%xd,2), UBOUND(IceDyn_DataData%xd,2) -DO i1 = LBOUND(IceDyn_DataData%xd,1), UBOUND(IceDyn_DataData%xd,1) - CALL IceD_DestroyDiscState( IceDyn_DataData%xd(i1,i2), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(IceDyn_DataData%xd) -ENDIF -IF (ALLOCATED(IceDyn_DataData%z)) THEN -DO i2 = LBOUND(IceDyn_DataData%z,2), UBOUND(IceDyn_DataData%z,2) -DO i1 = LBOUND(IceDyn_DataData%z,1), UBOUND(IceDyn_DataData%z,1) - CALL IceD_DestroyConstrState( IceDyn_DataData%z(i1,i2), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(IceDyn_DataData%z) -ENDIF -IF (ALLOCATED(IceDyn_DataData%OtherSt)) THEN -DO i2 = LBOUND(IceDyn_DataData%OtherSt,2), UBOUND(IceDyn_DataData%OtherSt,2) -DO i1 = LBOUND(IceDyn_DataData%OtherSt,1), UBOUND(IceDyn_DataData%OtherSt,1) - CALL IceD_DestroyOtherState( IceDyn_DataData%OtherSt(i1,i2), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(IceDyn_DataData%OtherSt) -ENDIF -IF (ALLOCATED(IceDyn_DataData%p)) THEN -DO i1 = LBOUND(IceDyn_DataData%p,1), UBOUND(IceDyn_DataData%p,1) - CALL IceD_DestroyParam( IceDyn_DataData%p(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(IceDyn_DataData%p) -ENDIF -IF (ALLOCATED(IceDyn_DataData%u)) THEN -DO i1 = LBOUND(IceDyn_DataData%u,1), UBOUND(IceDyn_DataData%u,1) - CALL IceD_DestroyInput( IceDyn_DataData%u(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(IceDyn_DataData%u) -ENDIF -IF (ALLOCATED(IceDyn_DataData%y)) THEN -DO i1 = LBOUND(IceDyn_DataData%y,1), UBOUND(IceDyn_DataData%y,1) - CALL IceD_DestroyOutput( IceDyn_DataData%y(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(IceDyn_DataData%y) -ENDIF -IF (ALLOCATED(IceDyn_DataData%m)) THEN -DO i1 = LBOUND(IceDyn_DataData%m,1), UBOUND(IceDyn_DataData%m,1) - CALL IceD_DestroyMisc( IceDyn_DataData%m(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(IceDyn_DataData%m) -ENDIF -IF (ALLOCATED(IceDyn_DataData%Input)) THEN -DO i2 = LBOUND(IceDyn_DataData%Input,2), UBOUND(IceDyn_DataData%Input,2) -DO i1 = LBOUND(IceDyn_DataData%Input,1), UBOUND(IceDyn_DataData%Input,1) - CALL IceD_DestroyInput( IceDyn_DataData%Input(i1,i2), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(IceDyn_DataData%Input) -ENDIF -IF (ALLOCATED(IceDyn_DataData%InputTimes)) THEN - DEALLOCATE(IceDyn_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyIceDyn_Data - -subroutine FAST_PackIceDyn_Data(Buf, Indata) +subroutine FAST_PackBeamDyn_Data(Buf, Indata) type(PackBuffer), intent(inout) :: Buf - type(IceDyn_Data), intent(in) :: InData - character(*), parameter :: RoutineName = 'FAST_PackIceDyn_Data' + type(BeamDyn_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackBeamDyn_Data' integer(IntKi) :: i1, i2 integer(IntKi) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return - ! x call RegPack(Buf, allocated(InData%x)) if (allocated(InData%x)) then call RegPackBounds(Buf, 2, lbound(InData%x), ubound(InData%x)) @@ -7870,12 +8250,11 @@ subroutine FAST_PackIceDyn_Data(Buf, Indata) UB(1:2) = ubound(InData%x) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call IceD_PackContState(Buf, InData%x(i1,i2)) + call BD_PackContState(Buf, InData%x(i1,i2)) end do end do end if if (RegCheckErr(Buf, RoutineName)) return - ! xd call RegPack(Buf, allocated(InData%xd)) if (allocated(InData%xd)) then call RegPackBounds(Buf, 2, lbound(InData%xd), ubound(InData%xd)) @@ -7883,12 +8262,11 @@ subroutine FAST_PackIceDyn_Data(Buf, Indata) UB(1:2) = ubound(InData%xd) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call IceD_PackDiscState(Buf, InData%xd(i1,i2)) + call BD_PackDiscState(Buf, InData%xd(i1,i2)) end do end do end if if (RegCheckErr(Buf, RoutineName)) return - ! z call RegPack(Buf, allocated(InData%z)) if (allocated(InData%z)) then call RegPackBounds(Buf, 2, lbound(InData%z), ubound(InData%z)) @@ -7896,12 +8274,11 @@ subroutine FAST_PackIceDyn_Data(Buf, Indata) UB(1:2) = ubound(InData%z) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call IceD_PackConstrState(Buf, InData%z(i1,i2)) + call BD_PackConstrState(Buf, InData%z(i1,i2)) end do end do end if if (RegCheckErr(Buf, RoutineName)) return - ! OtherSt call RegPack(Buf, allocated(InData%OtherSt)) if (allocated(InData%OtherSt)) then call RegPackBounds(Buf, 2, lbound(InData%OtherSt), ubound(InData%OtherSt)) @@ -7909,56 +8286,73 @@ subroutine FAST_PackIceDyn_Data(Buf, Indata) UB(1:2) = ubound(InData%OtherSt) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call IceD_PackOtherState(Buf, InData%OtherSt(i1,i2)) + call BD_PackOtherState(Buf, InData%OtherSt(i1,i2)) end do end do end if if (RegCheckErr(Buf, RoutineName)) return - ! p call RegPack(Buf, allocated(InData%p)) if (allocated(InData%p)) then call RegPackBounds(Buf, 1, lbound(InData%p), ubound(InData%p)) LB(1:1) = lbound(InData%p) UB(1:1) = ubound(InData%p) do i1 = LB(1), UB(1) - call IceD_PackParam(Buf, InData%p(i1)) + call BD_PackParam(Buf, InData%p(i1)) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! u call RegPack(Buf, allocated(InData%u)) if (allocated(InData%u)) then call RegPackBounds(Buf, 1, lbound(InData%u), ubound(InData%u)) LB(1:1) = lbound(InData%u) UB(1:1) = ubound(InData%u) do i1 = LB(1), UB(1) - call IceD_PackInput(Buf, InData%u(i1)) + call BD_PackInput(Buf, InData%u(i1)) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! y call RegPack(Buf, allocated(InData%y)) if (allocated(InData%y)) then call RegPackBounds(Buf, 1, lbound(InData%y), ubound(InData%y)) LB(1:1) = lbound(InData%y) UB(1:1) = ubound(InData%y) do i1 = LB(1), UB(1) - call IceD_PackOutput(Buf, InData%y(i1)) + call BD_PackOutput(Buf, InData%y(i1)) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! m call RegPack(Buf, allocated(InData%m)) if (allocated(InData%m)) then call RegPackBounds(Buf, 1, lbound(InData%m), ubound(InData%m)) LB(1:1) = lbound(InData%m) UB(1:1) = ubound(InData%m) do i1 = LB(1), UB(1) - call IceD_PackMisc(Buf, InData%m(i1)) + call BD_PackMisc(Buf, InData%m(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%Output)) + if (allocated(InData%Output)) then + call RegPackBounds(Buf, 2, lbound(InData%Output), ubound(InData%Output)) + LB(1:2) = lbound(InData%Output) + UB(1:2) = ubound(InData%Output) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call BD_PackOutput(Buf, InData%Output(i1,i2)) + end do + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%y_interp)) + if (allocated(InData%y_interp)) then + call RegPackBounds(Buf, 1, lbound(InData%y_interp), ubound(InData%y_interp)) + LB(1:1) = lbound(InData%y_interp) + UB(1:1) = ubound(InData%y_interp) + do i1 = LB(1), UB(1) + call BD_PackOutput(Buf, InData%y_interp(i1)) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! Input call RegPack(Buf, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(Buf, 2, lbound(InData%Input), ubound(InData%Input)) @@ -7966,12 +8360,11 @@ subroutine FAST_PackIceDyn_Data(Buf, Indata) UB(1:2) = ubound(InData%Input) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call IceD_PackInput(Buf, InData%Input(i1,i2)) + call BD_PackInput(Buf, InData%Input(i1,i2)) end do end do end if if (RegCheckErr(Buf, RoutineName)) return - ! InputTimes call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then call RegPackBounds(Buf, 2, lbound(InData%InputTimes), ubound(InData%InputTimes)) @@ -7980,16 +8373,15 @@ subroutine FAST_PackIceDyn_Data(Buf, Indata) if (RegCheckErr(Buf, RoutineName)) return end subroutine -subroutine FAST_UnPackIceDyn_Data(Buf, OutData) +subroutine FAST_UnPackBeamDyn_Data(Buf, OutData) type(PackBuffer), intent(inout) :: Buf - type(IceDyn_Data), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'FAST_UnPackIceDyn_Data' + type(BeamDyn_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackBeamDyn_Data' integer(IntKi) :: i1, i2 integer(IntKi) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! x if (allocated(OutData%x)) deallocate(OutData%x) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8003,11 +8395,10 @@ subroutine FAST_UnPackIceDyn_Data(Buf, OutData) end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call IceD_UnpackContState(Buf, OutData%x(i1,i2)) ! x + call BD_UnpackContState(Buf, OutData%x(i1,i2)) ! x end do end do end if - ! xd if (allocated(OutData%xd)) deallocate(OutData%xd) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8021,11 +8412,10 @@ subroutine FAST_UnPackIceDyn_Data(Buf, OutData) end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call IceD_UnpackDiscState(Buf, OutData%xd(i1,i2)) ! xd + call BD_UnpackDiscState(Buf, OutData%xd(i1,i2)) ! xd end do end do end if - ! z if (allocated(OutData%z)) deallocate(OutData%z) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8039,11 +8429,10 @@ subroutine FAST_UnPackIceDyn_Data(Buf, OutData) end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call IceD_UnpackConstrState(Buf, OutData%z(i1,i2)) ! z + call BD_UnpackConstrState(Buf, OutData%z(i1,i2)) ! z end do end do end if - ! OtherSt if (allocated(OutData%OtherSt)) deallocate(OutData%OtherSt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8057,11 +8446,10 @@ subroutine FAST_UnPackIceDyn_Data(Buf, OutData) end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call IceD_UnpackOtherState(Buf, OutData%OtherSt(i1,i2)) ! OtherSt + call BD_UnpackOtherState(Buf, OutData%OtherSt(i1,i2)) ! OtherSt end do end do end if - ! p if (allocated(OutData%p)) deallocate(OutData%p) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8074,10 +8462,9 @@ subroutine FAST_UnPackIceDyn_Data(Buf, OutData) return end if do i1 = LB(1), UB(1) - call IceD_UnpackParam(Buf, OutData%p(i1)) ! p + call BD_UnpackParam(Buf, OutData%p(i1)) ! p end do end if - ! u if (allocated(OutData%u)) deallocate(OutData%u) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8088,771 +8475,663 @@ subroutine FAST_UnPackIceDyn_Data(Buf, OutData) if (stat /= 0) then call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return - end if - do i1 = LB(1), UB(1) - call IceD_UnpackInput(Buf, OutData%u(i1)) ! u - end do - end if - ! y - if (allocated(OutData%y)) deallocate(OutData%y) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%y(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call IceD_UnpackOutput(Buf, OutData%y(i1)) ! y - end do - end if - ! m - if (allocated(OutData%m)) deallocate(OutData%m) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%m(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%m.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call IceD_UnpackMisc(Buf, OutData%m(i1)) ! m - end do - end if - ! Input - if (allocated(OutData%Input)) deallocate(OutData%Input) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Input(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call IceD_UnpackInput(Buf, OutData%Input(i1,i2)) ! Input - end do - end do - end if - ! InputTimes - if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%InputTimes(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%InputTimes) - if (RegCheckErr(Buf, RoutineName)) return - end if -end subroutine - SUBROUTINE FAST_CopyBeamDyn_Data( SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BeamDyn_Data), INTENT(INOUT) :: SrcBeamDyn_DataData - TYPE(BeamDyn_Data), INTENT(INOUT) :: DstBeamDyn_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyBeamDyn_Data' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcBeamDyn_DataData%x)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%x,1) - i1_u = UBOUND(SrcBeamDyn_DataData%x,1) - i2_l = LBOUND(SrcBeamDyn_DataData%x,2) - i2_u = UBOUND(SrcBeamDyn_DataData%x,2) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%x)) THEN - ALLOCATE(DstBeamDyn_DataData%x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcBeamDyn_DataData%x,2), UBOUND(SrcBeamDyn_DataData%x,2) - DO i1 = LBOUND(SrcBeamDyn_DataData%x,1), UBOUND(SrcBeamDyn_DataData%x,1) - CALL BD_CopyContState( SrcBeamDyn_DataData%x(i1,i2), DstBeamDyn_DataData%x(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%xd)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%xd,1) - i1_u = UBOUND(SrcBeamDyn_DataData%xd,1) - i2_l = LBOUND(SrcBeamDyn_DataData%xd,2) - i2_u = UBOUND(SrcBeamDyn_DataData%xd,2) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%xd)) THEN - ALLOCATE(DstBeamDyn_DataData%xd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcBeamDyn_DataData%xd,2), UBOUND(SrcBeamDyn_DataData%xd,2) - DO i1 = LBOUND(SrcBeamDyn_DataData%xd,1), UBOUND(SrcBeamDyn_DataData%xd,1) - CALL BD_CopyDiscState( SrcBeamDyn_DataData%xd(i1,i2), DstBeamDyn_DataData%xd(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%z)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%z,1) - i1_u = UBOUND(SrcBeamDyn_DataData%z,1) - i2_l = LBOUND(SrcBeamDyn_DataData%z,2) - i2_u = UBOUND(SrcBeamDyn_DataData%z,2) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%z)) THEN - ALLOCATE(DstBeamDyn_DataData%z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcBeamDyn_DataData%z,2), UBOUND(SrcBeamDyn_DataData%z,2) - DO i1 = LBOUND(SrcBeamDyn_DataData%z,1), UBOUND(SrcBeamDyn_DataData%z,1) - CALL BD_CopyConstrState( SrcBeamDyn_DataData%z(i1,i2), DstBeamDyn_DataData%z(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%OtherSt)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%OtherSt,1) - i1_u = UBOUND(SrcBeamDyn_DataData%OtherSt,1) - i2_l = LBOUND(SrcBeamDyn_DataData%OtherSt,2) - i2_u = UBOUND(SrcBeamDyn_DataData%OtherSt,2) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%OtherSt)) THEN - ALLOCATE(DstBeamDyn_DataData%OtherSt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%OtherSt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcBeamDyn_DataData%OtherSt,2), UBOUND(SrcBeamDyn_DataData%OtherSt,2) - DO i1 = LBOUND(SrcBeamDyn_DataData%OtherSt,1), UBOUND(SrcBeamDyn_DataData%OtherSt,1) - CALL BD_CopyOtherState( SrcBeamDyn_DataData%OtherSt(i1,i2), DstBeamDyn_DataData%OtherSt(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%p)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%p,1) - i1_u = UBOUND(SrcBeamDyn_DataData%p,1) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%p)) THEN - ALLOCATE(DstBeamDyn_DataData%p(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%p.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcBeamDyn_DataData%p,1), UBOUND(SrcBeamDyn_DataData%p,1) - CALL BD_CopyParam( SrcBeamDyn_DataData%p(i1), DstBeamDyn_DataData%p(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%u)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%u,1) - i1_u = UBOUND(SrcBeamDyn_DataData%u,1) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%u)) THEN - ALLOCATE(DstBeamDyn_DataData%u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcBeamDyn_DataData%u,1), UBOUND(SrcBeamDyn_DataData%u,1) - CALL BD_CopyInput( SrcBeamDyn_DataData%u(i1), DstBeamDyn_DataData%u(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%y)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%y,1) - i1_u = UBOUND(SrcBeamDyn_DataData%y,1) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%y)) THEN - ALLOCATE(DstBeamDyn_DataData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcBeamDyn_DataData%y,1), UBOUND(SrcBeamDyn_DataData%y,1) - CALL BD_CopyOutput( SrcBeamDyn_DataData%y(i1), DstBeamDyn_DataData%y(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%m)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%m,1) - i1_u = UBOUND(SrcBeamDyn_DataData%m,1) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%m)) THEN - ALLOCATE(DstBeamDyn_DataData%m(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%m.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcBeamDyn_DataData%m,1), UBOUND(SrcBeamDyn_DataData%m,1) - CALL BD_CopyMisc( SrcBeamDyn_DataData%m(i1), DstBeamDyn_DataData%m(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%Output)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%Output,1) - i1_u = UBOUND(SrcBeamDyn_DataData%Output,1) - i2_l = LBOUND(SrcBeamDyn_DataData%Output,2) - i2_u = UBOUND(SrcBeamDyn_DataData%Output,2) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%Output)) THEN - ALLOCATE(DstBeamDyn_DataData%Output(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcBeamDyn_DataData%Output,2), UBOUND(SrcBeamDyn_DataData%Output,2) - DO i1 = LBOUND(SrcBeamDyn_DataData%Output,1), UBOUND(SrcBeamDyn_DataData%Output,1) - CALL BD_CopyOutput( SrcBeamDyn_DataData%Output(i1,i2), DstBeamDyn_DataData%Output(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%y_interp)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%y_interp,1) - i1_u = UBOUND(SrcBeamDyn_DataData%y_interp,1) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%y_interp)) THEN - ALLOCATE(DstBeamDyn_DataData%y_interp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%y_interp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcBeamDyn_DataData%y_interp,1), UBOUND(SrcBeamDyn_DataData%y_interp,1) - CALL BD_CopyOutput( SrcBeamDyn_DataData%y_interp(i1), DstBeamDyn_DataData%y_interp(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%Input,1) - i1_u = UBOUND(SrcBeamDyn_DataData%Input,1) - i2_l = LBOUND(SrcBeamDyn_DataData%Input,2) - i2_u = UBOUND(SrcBeamDyn_DataData%Input,2) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%Input)) THEN - ALLOCATE(DstBeamDyn_DataData%Input(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcBeamDyn_DataData%Input,2), UBOUND(SrcBeamDyn_DataData%Input,2) - DO i1 = LBOUND(SrcBeamDyn_DataData%Input,1), UBOUND(SrcBeamDyn_DataData%Input,1) - CALL BD_CopyInput( SrcBeamDyn_DataData%Input(i1,i2), DstBeamDyn_DataData%Input(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcBeamDyn_DataData%InputTimes,1) - i2_l = LBOUND(SrcBeamDyn_DataData%InputTimes,2) - i2_u = UBOUND(SrcBeamDyn_DataData%InputTimes,2) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%InputTimes)) THEN - ALLOCATE(DstBeamDyn_DataData%InputTimes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeamDyn_DataData%InputTimes = SrcBeamDyn_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyBeamDyn_Data - - SUBROUTINE FAST_DestroyBeamDyn_Data( BeamDyn_DataData, ErrStat, ErrMsg ) - TYPE(BeamDyn_Data), INTENT(INOUT) :: BeamDyn_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyBeamDyn_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(BeamDyn_DataData%x)) THEN -DO i2 = LBOUND(BeamDyn_DataData%x,2), UBOUND(BeamDyn_DataData%x,2) -DO i1 = LBOUND(BeamDyn_DataData%x,1), UBOUND(BeamDyn_DataData%x,1) - CALL BD_DestroyContState( BeamDyn_DataData%x(i1,i2), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(BeamDyn_DataData%x) -ENDIF -IF (ALLOCATED(BeamDyn_DataData%xd)) THEN -DO i2 = LBOUND(BeamDyn_DataData%xd,2), UBOUND(BeamDyn_DataData%xd,2) -DO i1 = LBOUND(BeamDyn_DataData%xd,1), UBOUND(BeamDyn_DataData%xd,1) - CALL BD_DestroyDiscState( BeamDyn_DataData%xd(i1,i2), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(BeamDyn_DataData%xd) -ENDIF -IF (ALLOCATED(BeamDyn_DataData%z)) THEN -DO i2 = LBOUND(BeamDyn_DataData%z,2), UBOUND(BeamDyn_DataData%z,2) -DO i1 = LBOUND(BeamDyn_DataData%z,1), UBOUND(BeamDyn_DataData%z,1) - CALL BD_DestroyConstrState( BeamDyn_DataData%z(i1,i2), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(BeamDyn_DataData%z) -ENDIF -IF (ALLOCATED(BeamDyn_DataData%OtherSt)) THEN -DO i2 = LBOUND(BeamDyn_DataData%OtherSt,2), UBOUND(BeamDyn_DataData%OtherSt,2) -DO i1 = LBOUND(BeamDyn_DataData%OtherSt,1), UBOUND(BeamDyn_DataData%OtherSt,1) - CALL BD_DestroyOtherState( BeamDyn_DataData%OtherSt(i1,i2), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(BeamDyn_DataData%OtherSt) -ENDIF -IF (ALLOCATED(BeamDyn_DataData%p)) THEN -DO i1 = LBOUND(BeamDyn_DataData%p,1), UBOUND(BeamDyn_DataData%p,1) - CALL BD_DestroyParam( BeamDyn_DataData%p(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(BeamDyn_DataData%p) -ENDIF -IF (ALLOCATED(BeamDyn_DataData%u)) THEN -DO i1 = LBOUND(BeamDyn_DataData%u,1), UBOUND(BeamDyn_DataData%u,1) - CALL BD_DestroyInput( BeamDyn_DataData%u(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(BeamDyn_DataData%u) -ENDIF -IF (ALLOCATED(BeamDyn_DataData%y)) THEN -DO i1 = LBOUND(BeamDyn_DataData%y,1), UBOUND(BeamDyn_DataData%y,1) - CALL BD_DestroyOutput( BeamDyn_DataData%y(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(BeamDyn_DataData%y) -ENDIF -IF (ALLOCATED(BeamDyn_DataData%m)) THEN -DO i1 = LBOUND(BeamDyn_DataData%m,1), UBOUND(BeamDyn_DataData%m,1) - CALL BD_DestroyMisc( BeamDyn_DataData%m(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(BeamDyn_DataData%m) -ENDIF -IF (ALLOCATED(BeamDyn_DataData%Output)) THEN -DO i2 = LBOUND(BeamDyn_DataData%Output,2), UBOUND(BeamDyn_DataData%Output,2) -DO i1 = LBOUND(BeamDyn_DataData%Output,1), UBOUND(BeamDyn_DataData%Output,1) - CALL BD_DestroyOutput( BeamDyn_DataData%Output(i1,i2), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(BeamDyn_DataData%Output) -ENDIF -IF (ALLOCATED(BeamDyn_DataData%y_interp)) THEN -DO i1 = LBOUND(BeamDyn_DataData%y_interp,1), UBOUND(BeamDyn_DataData%y_interp,1) - CALL BD_DestroyOutput( BeamDyn_DataData%y_interp(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(BeamDyn_DataData%y_interp) -ENDIF -IF (ALLOCATED(BeamDyn_DataData%Input)) THEN -DO i2 = LBOUND(BeamDyn_DataData%Input,2), UBOUND(BeamDyn_DataData%Input,2) -DO i1 = LBOUND(BeamDyn_DataData%Input,1), UBOUND(BeamDyn_DataData%Input,1) - CALL BD_DestroyInput( BeamDyn_DataData%Input(i1,i2), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(BeamDyn_DataData%Input) -ENDIF -IF (ALLOCATED(BeamDyn_DataData%InputTimes)) THEN - DEALLOCATE(BeamDyn_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyBeamDyn_Data - - -subroutine FAST_PackBeamDyn_Data(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf - type(BeamDyn_Data), intent(in) :: InData - character(*), parameter :: RoutineName = 'FAST_PackBeamDyn_Data' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) - if (Buf%ErrStat >= AbortErrLev) return - ! x - call RegPack(Buf, allocated(InData%x)) - if (allocated(InData%x)) then - call RegPackBounds(Buf, 2, lbound(InData%x), ubound(InData%x)) - LB(1:2) = lbound(InData%x) - UB(1:2) = ubound(InData%x) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_PackContState(Buf, InData%x(i1,i2)) - end do - end do - end if - if (RegCheckErr(Buf, RoutineName)) return - ! xd - call RegPack(Buf, allocated(InData%xd)) - if (allocated(InData%xd)) then - call RegPackBounds(Buf, 2, lbound(InData%xd), ubound(InData%xd)) - LB(1:2) = lbound(InData%xd) - UB(1:2) = ubound(InData%xd) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_PackDiscState(Buf, InData%xd(i1,i2)) - end do - end do - end if - if (RegCheckErr(Buf, RoutineName)) return - ! z - call RegPack(Buf, allocated(InData%z)) - if (allocated(InData%z)) then - call RegPackBounds(Buf, 2, lbound(InData%z), ubound(InData%z)) - LB(1:2) = lbound(InData%z) - UB(1:2) = ubound(InData%z) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_PackConstrState(Buf, InData%z(i1,i2)) - end do - end do - end if - if (RegCheckErr(Buf, RoutineName)) return - ! OtherSt - call RegPack(Buf, allocated(InData%OtherSt)) - if (allocated(InData%OtherSt)) then - call RegPackBounds(Buf, 2, lbound(InData%OtherSt), ubound(InData%OtherSt)) - LB(1:2) = lbound(InData%OtherSt) - UB(1:2) = ubound(InData%OtherSt) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_PackOtherState(Buf, InData%OtherSt(i1,i2)) - end do - end do - end if - if (RegCheckErr(Buf, RoutineName)) return - ! p - call RegPack(Buf, allocated(InData%p)) - if (allocated(InData%p)) then - call RegPackBounds(Buf, 1, lbound(InData%p), ubound(InData%p)) - LB(1:1) = lbound(InData%p) - UB(1:1) = ubound(InData%p) - do i1 = LB(1), UB(1) - call BD_PackParam(Buf, InData%p(i1)) - end do - end if - if (RegCheckErr(Buf, RoutineName)) return - ! u - call RegPack(Buf, allocated(InData%u)) - if (allocated(InData%u)) then - call RegPackBounds(Buf, 1, lbound(InData%u), ubound(InData%u)) - LB(1:1) = lbound(InData%u) - UB(1:1) = ubound(InData%u) - do i1 = LB(1), UB(1) - call BD_PackInput(Buf, InData%u(i1)) - end do - end if - if (RegCheckErr(Buf, RoutineName)) return - ! y - call RegPack(Buf, allocated(InData%y)) - if (allocated(InData%y)) then - call RegPackBounds(Buf, 1, lbound(InData%y), ubound(InData%y)) - LB(1:1) = lbound(InData%y) - UB(1:1) = ubound(InData%y) + end if do i1 = LB(1), UB(1) - call BD_PackOutput(Buf, InData%y(i1)) + call BD_UnpackInput(Buf, OutData%u(i1)) ! u end do end if + if (allocated(OutData%y)) deallocate(OutData%y) + call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return - ! m - call RegPack(Buf, allocated(InData%m)) - if (allocated(InData%m)) then - call RegPackBounds(Buf, 1, lbound(InData%m), ubound(InData%m)) - LB(1:1) = lbound(InData%m) - UB(1:1) = ubound(InData%m) + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%y(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if do i1 = LB(1), UB(1) - call BD_PackMisc(Buf, InData%m(i1)) - end do - end if - if (RegCheckErr(Buf, RoutineName)) return - ! Output - call RegPack(Buf, allocated(InData%Output)) - if (allocated(InData%Output)) then - call RegPackBounds(Buf, 2, lbound(InData%Output), ubound(InData%Output)) - LB(1:2) = lbound(InData%Output) - UB(1:2) = ubound(InData%Output) - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_PackOutput(Buf, InData%Output(i1,i2)) - end do + call BD_UnpackOutput(Buf, OutData%y(i1)) ! y end do end if + if (allocated(OutData%m)) deallocate(OutData%m) + call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return - ! y_interp - call RegPack(Buf, allocated(InData%y_interp)) - if (allocated(InData%y_interp)) then - call RegPackBounds(Buf, 1, lbound(InData%y_interp), ubound(InData%y_interp)) - LB(1:1) = lbound(InData%y_interp) - UB(1:1) = ubound(InData%y_interp) + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%m(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%m.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if do i1 = LB(1), UB(1) - call BD_PackOutput(Buf, InData%y_interp(i1)) + call BD_UnpackMisc(Buf, OutData%m(i1)) ! m end do end if + if (allocated(OutData%Output)) deallocate(OutData%Output) + call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return - ! Input - call RegPack(Buf, allocated(InData%Input)) - if (allocated(InData%Input)) then - call RegPackBounds(Buf, 2, lbound(InData%Input), ubound(InData%Input)) - LB(1:2) = lbound(InData%Input) - UB(1:2) = ubound(InData%Input) + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Output(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call BD_PackInput(Buf, InData%Input(i1,i2)) + call BD_UnpackOutput(Buf, OutData%Output(i1,i2)) ! Output end do end do end if - if (RegCheckErr(Buf, RoutineName)) return - ! InputTimes - call RegPack(Buf, allocated(InData%InputTimes)) - if (allocated(InData%InputTimes)) then - call RegPackBounds(Buf, 2, lbound(InData%InputTimes), ubound(InData%InputTimes)) - call RegPack(Buf, InData%InputTimes) - end if - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine FAST_UnPackBeamDyn_Data(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf - type(BeamDyn_Data), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'FAST_UnPackBeamDyn_Data' - integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - ! x - if (allocated(OutData%x)) deallocate(OutData%x) + if (allocated(OutData%y_interp)) deallocate(OutData%y_interp) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) + call RegUnpackBounds(Buf, 1, LB, UB) if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%x(LB(1):UB(1),LB(2):UB(2)),stat=stat) + allocate(OutData%y_interp(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_interp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_UnpackContState(Buf, OutData%x(i1,i2)) ! x - end do + do i1 = LB(1), UB(1) + call BD_UnpackOutput(Buf, OutData%y_interp(i1)) ! y_interp end do end if - ! xd - if (allocated(OutData%xd)) deallocate(OutData%xd) + if (allocated(OutData%Input)) deallocate(OutData%Input) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(Buf, 2, LB, UB) if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%xd(LB(1):UB(1),LB(2):UB(2)),stat=stat) + allocate(OutData%Input(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call BD_UnpackDiscState(Buf, OutData%xd(i1,i2)) ! xd + call BD_UnpackInput(Buf, OutData%Input(i1,i2)) ! Input end do end do end if - ! z - if (allocated(OutData%z)) deallocate(OutData%z) + if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(Buf, 2, LB, UB) if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%z(LB(1):UB(1),LB(2):UB(2)),stat=stat) + allocate(OutData%InputTimes(LB(1):UB(1),LB(2):UB(2)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_UnpackConstrState(Buf, OutData%z(i1,i2)) ! z - end do + call RegUnpack(Buf, OutData%InputTimes) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine FAST_CopyElastoDyn_Data(SrcElastoDyn_DataData, DstElastoDyn_DataData, CtrlCode, ErrStat, ErrMsg) + type(ElastoDyn_Data), intent(inout) :: SrcElastoDyn_DataData + type(ElastoDyn_Data), intent(inout) :: DstElastoDyn_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyElastoDyn_Data' + ErrStat = ErrID_None + ErrMsg = '' + do i1 = LB(1), UB(1) + call ED_CopyContState(SrcElastoDyn_DataData%x(i1), DstElastoDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + do i1 = LB(1), UB(1) + call ED_CopyDiscState(SrcElastoDyn_DataData%xd(i1), DstElastoDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + do i1 = LB(1), UB(1) + call ED_CopyConstrState(SrcElastoDyn_DataData%z(i1), DstElastoDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + do i1 = LB(1), UB(1) + call ED_CopyOtherState(SrcElastoDyn_DataData%OtherSt(i1), DstElastoDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call ED_CopyParam(SrcElastoDyn_DataData%p, DstElastoDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ED_CopyInput(SrcElastoDyn_DataData%u, DstElastoDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ED_CopyOutput(SrcElastoDyn_DataData%y, DstElastoDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ED_CopyMisc(SrcElastoDyn_DataData%m, DstElastoDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcElastoDyn_DataData%Output)) then + LB(1:1) = lbound(SrcElastoDyn_DataData%Output) + UB(1:1) = ubound(SrcElastoDyn_DataData%Output) + if (.not. allocated(DstElastoDyn_DataData%Output)) then + allocate(DstElastoDyn_DataData%Output(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%Output.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ED_CopyOutput(SrcElastoDyn_DataData%Output(i1), DstElastoDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstElastoDyn_DataData%Output)) then + deallocate(DstElastoDyn_DataData%Output) end if - ! OtherSt - if (allocated(OutData%OtherSt)) deallocate(OutData%OtherSt) + call ED_CopyOutput(SrcElastoDyn_DataData%y_interp, DstElastoDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcElastoDyn_DataData%Input)) then + LB(1:1) = lbound(SrcElastoDyn_DataData%Input) + UB(1:1) = ubound(SrcElastoDyn_DataData%Input) + if (.not. allocated(DstElastoDyn_DataData%Input)) then + allocate(DstElastoDyn_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ED_CopyInput(SrcElastoDyn_DataData%Input(i1), DstElastoDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstElastoDyn_DataData%Input)) then + deallocate(DstElastoDyn_DataData%Input) + end if + if (allocated(SrcElastoDyn_DataData%InputTimes)) then + LB(1:1) = lbound(SrcElastoDyn_DataData%InputTimes) + UB(1:1) = ubound(SrcElastoDyn_DataData%InputTimes) + if (.not. allocated(DstElastoDyn_DataData%InputTimes)) then + allocate(DstElastoDyn_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstElastoDyn_DataData%InputTimes = SrcElastoDyn_DataData%InputTimes + else if (allocated(DstElastoDyn_DataData%InputTimes)) then + deallocate(DstElastoDyn_DataData%InputTimes) + end if +end subroutine + +subroutine FAST_DestroyElastoDyn_Data(ElastoDyn_DataData, ErrStat, ErrMsg) + type(ElastoDyn_Data), intent(inout) :: ElastoDyn_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyElastoDyn_Data' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ElastoDyn_DataData%Output)) then + LB(1:1) = lbound(ElastoDyn_DataData%Output) + UB(1:1) = ubound(ElastoDyn_DataData%Output) + do i1 = LB(1), UB(1) + call ED_DestroyOutput(ElastoDyn_DataData%Output(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ElastoDyn_DataData%Output) + end if + if (allocated(ElastoDyn_DataData%Input)) then + LB(1:1) = lbound(ElastoDyn_DataData%Input) + UB(1:1) = ubound(ElastoDyn_DataData%Input) + do i1 = LB(1), UB(1) + call ED_DestroyInput(ElastoDyn_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ElastoDyn_DataData%Input) + end if + if (allocated(ElastoDyn_DataData%InputTimes)) then + deallocate(ElastoDyn_DataData%InputTimes) + end if +end subroutine + +subroutine FAST_PackElastoDyn_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ElastoDyn_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackElastoDyn_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call ED_PackContState(Buf, InData%x(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call ED_PackDiscState(Buf, InData%xd(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call ED_PackConstrState(Buf, InData%z(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call ED_PackOtherState(Buf, InData%OtherSt(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + call ED_PackParam(Buf, InData%p) + if (RegCheckErr(Buf, RoutineName)) return + call ED_PackInput(Buf, InData%u) + if (RegCheckErr(Buf, RoutineName)) return + call ED_PackOutput(Buf, InData%y) + if (RegCheckErr(Buf, RoutineName)) return + call ED_PackMisc(Buf, InData%m) + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%Output)) + if (allocated(InData%Output)) then + call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) + LB(1:1) = lbound(InData%Output) + UB(1:1) = ubound(InData%Output) + do i1 = LB(1), UB(1) + call ED_PackOutput(Buf, InData%Output(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call ED_PackOutput(Buf, InData%y_interp) + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call ED_PackInput(Buf, InData%Input(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%InputTimes)) + if (allocated(InData%InputTimes)) then + call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPack(Buf, InData%InputTimes) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackElastoDyn_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ElastoDyn_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackElastoDyn_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) + do i1 = LB(1), UB(1) + call ED_UnpackContState(Buf, OutData%x(i1)) ! x + end do + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) + do i1 = LB(1), UB(1) + call ED_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + end do + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) + do i1 = LB(1), UB(1) + call ED_UnpackConstrState(Buf, OutData%z(i1)) ! z + end do + LB(1:1) = lbound(OutData%OtherSt) + UB(1:1) = ubound(OutData%OtherSt) + do i1 = LB(1), UB(1) + call ED_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + end do + call ED_UnpackParam(Buf, OutData%p) ! p + call ED_UnpackInput(Buf, OutData%u) ! u + call ED_UnpackOutput(Buf, OutData%y) ! y + call ED_UnpackMisc(Buf, OutData%m) ! m + if (allocated(OutData%Output)) deallocate(OutData%Output) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) + call RegUnpackBounds(Buf, 1, LB, UB) if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%OtherSt(LB(1):UB(1),LB(2):UB(2)),stat=stat) + allocate(OutData%Output(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_UnpackOtherState(Buf, OutData%OtherSt(i1,i2)) ! OtherSt - end do + do i1 = LB(1), UB(1) + call ED_UnpackOutput(Buf, OutData%Output(i1)) ! Output end do end if - ! p - if (allocated(OutData%p)) deallocate(OutData%p) + call ED_UnpackOutput(Buf, OutData%y_interp) ! y_interp + if (allocated(OutData%Input)) deallocate(OutData%Input) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(Buf, 1, LB, UB) if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%p(LB(1):UB(1)),stat=stat) + allocate(OutData%Input(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%p.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call BD_UnpackParam(Buf, OutData%p(i1)) ! p + call ED_UnpackInput(Buf, OutData%Input(i1)) ! Input end do end if - ! u - if (allocated(OutData%u)) deallocate(OutData%u) + if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(Buf, 1, LB, UB) if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%u(LB(1):UB(1)),stat=stat) + allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if + call RegUnpack(Buf, OutData%InputTimes) + if (RegCheckErr(Buf, RoutineName)) return + end if +end subroutine + +subroutine FAST_CopyServoDyn_Data(SrcServoDyn_DataData, DstServoDyn_DataData, CtrlCode, ErrStat, ErrMsg) + type(ServoDyn_Data), intent(inout) :: SrcServoDyn_DataData + type(ServoDyn_Data), intent(inout) :: DstServoDyn_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyServoDyn_Data' + ErrStat = ErrID_None + ErrMsg = '' + do i1 = LB(1), UB(1) + call SrvD_CopyContState(SrcServoDyn_DataData%x(i1), DstServoDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + do i1 = LB(1), UB(1) + call SrvD_CopyDiscState(SrcServoDyn_DataData%xd(i1), DstServoDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + do i1 = LB(1), UB(1) + call SrvD_CopyConstrState(SrcServoDyn_DataData%z(i1), DstServoDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + do i1 = LB(1), UB(1) + call SrvD_CopyOtherState(SrcServoDyn_DataData%OtherSt(i1), DstServoDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call SrvD_CopyParam(SrcServoDyn_DataData%p, DstServoDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SrvD_CopyInput(SrcServoDyn_DataData%u, DstServoDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SrvD_CopyOutput(SrcServoDyn_DataData%y, DstServoDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SrvD_CopyMisc(SrcServoDyn_DataData%m, DstServoDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcServoDyn_DataData%Output)) then + LB(1:1) = lbound(SrcServoDyn_DataData%Output) + UB(1:1) = ubound(SrcServoDyn_DataData%Output) + if (.not. allocated(DstServoDyn_DataData%Output)) then + allocate(DstServoDyn_DataData%Output(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%Output.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call BD_UnpackInput(Buf, OutData%u(i1)) ! u + call SrvD_CopyOutput(SrcServoDyn_DataData%Output(i1), DstServoDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstServoDyn_DataData%Output)) then + deallocate(DstServoDyn_DataData%Output) end if - ! y - if (allocated(OutData%y)) deallocate(OutData%y) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%y(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return + call SrvD_CopyOutput(SrcServoDyn_DataData%y_interp, DstServoDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcServoDyn_DataData%Input)) then + LB(1:1) = lbound(SrcServoDyn_DataData%Input) + UB(1:1) = ubound(SrcServoDyn_DataData%Input) + if (.not. allocated(DstServoDyn_DataData%Input)) then + allocate(DstServoDyn_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if end if do i1 = LB(1), UB(1) - call BD_UnpackOutput(Buf, OutData%y(i1)) ! y + call SrvD_CopyInput(SrcServoDyn_DataData%Input(i1), DstServoDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end do + else if (allocated(DstServoDyn_DataData%Input)) then + deallocate(DstServoDyn_DataData%Input) end if - ! m - if (allocated(OutData%m)) deallocate(OutData%m) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%m(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%m.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return + if (allocated(SrcServoDyn_DataData%InputTimes)) then + LB(1:1) = lbound(SrcServoDyn_DataData%InputTimes) + UB(1:1) = ubound(SrcServoDyn_DataData%InputTimes) + if (.not. allocated(DstServoDyn_DataData%InputTimes)) then + allocate(DstServoDyn_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if end if + DstServoDyn_DataData%InputTimes = SrcServoDyn_DataData%InputTimes + else if (allocated(DstServoDyn_DataData%InputTimes)) then + deallocate(DstServoDyn_DataData%InputTimes) + end if +end subroutine + +subroutine FAST_DestroyServoDyn_Data(ServoDyn_DataData, ErrStat, ErrMsg) + type(ServoDyn_Data), intent(inout) :: ServoDyn_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyServoDyn_Data' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ServoDyn_DataData%Output)) then + LB(1:1) = lbound(ServoDyn_DataData%Output) + UB(1:1) = ubound(ServoDyn_DataData%Output) do i1 = LB(1), UB(1) - call BD_UnpackMisc(Buf, OutData%m(i1)) ! m + call SrvD_DestroyOutput(ServoDyn_DataData%Output(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(ServoDyn_DataData%Output) end if - ! Output - if (allocated(OutData%Output)) deallocate(OutData%Output) - call RegUnpack(Buf, IsAllocAssoc) + if (allocated(ServoDyn_DataData%Input)) then + LB(1:1) = lbound(ServoDyn_DataData%Input) + UB(1:1) = ubound(ServoDyn_DataData%Input) + do i1 = LB(1), UB(1) + call SrvD_DestroyInput(ServoDyn_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ServoDyn_DataData%Input) + end if + if (allocated(ServoDyn_DataData%InputTimes)) then + deallocate(ServoDyn_DataData%InputTimes) + end if +end subroutine + +subroutine FAST_PackServoDyn_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(ServoDyn_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackServoDyn_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + if (Buf%ErrStat >= AbortErrLev) return + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call SrvD_PackContState(Buf, InData%x(i1)) + end do if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Output(LB(1):UB(1),LB(2):UB(2)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_UnpackOutput(Buf, OutData%Output(i1,i2)) ! Output - end do + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call SrvD_PackDiscState(Buf, InData%xd(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call SrvD_PackConstrState(Buf, InData%z(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call SrvD_PackOtherState(Buf, InData%OtherSt(i1)) + end do + if (RegCheckErr(Buf, RoutineName)) return + call SrvD_PackParam(Buf, InData%p) + if (RegCheckErr(Buf, RoutineName)) return + call SrvD_PackInput(Buf, InData%u) + if (RegCheckErr(Buf, RoutineName)) return + call SrvD_PackOutput(Buf, InData%y) + if (RegCheckErr(Buf, RoutineName)) return + call SrvD_PackMisc(Buf, InData%m) + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%Output)) + if (allocated(InData%Output)) then + call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) + LB(1:1) = lbound(InData%Output) + UB(1:1) = ubound(InData%Output) + do i1 = LB(1), UB(1) + call SrvD_PackOutput(Buf, InData%Output(i1)) end do end if - ! y_interp - if (allocated(OutData%y_interp)) deallocate(OutData%y_interp) + if (RegCheckErr(Buf, RoutineName)) return + call SrvD_PackOutput(Buf, InData%y_interp) + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call SrvD_PackInput(Buf, InData%Input(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%InputTimes)) + if (allocated(InData%InputTimes)) then + call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) + call RegPack(Buf, InData%InputTimes) + end if + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackServoDyn_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(ServoDyn_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackServoDyn_Data' + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (Buf%ErrStat /= ErrID_None) return + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) + do i1 = LB(1), UB(1) + call SrvD_UnpackContState(Buf, OutData%x(i1)) ! x + end do + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) + do i1 = LB(1), UB(1) + call SrvD_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + end do + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) + do i1 = LB(1), UB(1) + call SrvD_UnpackConstrState(Buf, OutData%z(i1)) ! z + end do + LB(1:1) = lbound(OutData%OtherSt) + UB(1:1) = ubound(OutData%OtherSt) + do i1 = LB(1), UB(1) + call SrvD_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + end do + call SrvD_UnpackParam(Buf, OutData%p) ! p + call SrvD_UnpackInput(Buf, OutData%u) ! u + call SrvD_UnpackOutput(Buf, OutData%y) ! y + call SrvD_UnpackMisc(Buf, OutData%m) ! m + if (allocated(OutData%Output)) deallocate(OutData%Output) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(Buf, 1, LB, UB) if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%y_interp(LB(1):UB(1)),stat=stat) + allocate(OutData%Output(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_interp.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call BD_UnpackOutput(Buf, OutData%y_interp(i1)) ! y_interp + call SrvD_UnpackOutput(Buf, OutData%Output(i1)) ! Output end do end if - ! Input + call SrvD_UnpackOutput(Buf, OutData%y_interp) ! y_interp if (allocated(OutData%Input)) deallocate(OutData%Input) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) + call RegUnpackBounds(Buf, 1, LB, UB) if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Input(LB(1):UB(1),LB(2):UB(2)),stat=stat) + allocate(OutData%Input(LB(1):UB(1)),stat=stat) if (stat /= 0) then call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call BD_UnpackInput(Buf, OutData%Input(i1,i2)) ! Input - end do + do i1 = LB(1), UB(1) + call SrvD_UnpackInput(Buf, OutData%Input(i1)) ! Input end do end if - ! InputTimes if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 2, LB, UB) + call RegUnpackBounds(Buf, 1, LB, UB) if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%InputTimes(LB(1):UB(1),LB(2):UB(2)),stat=stat) + allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) if (stat /= 0) then call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return @@ -8861,234 +9140,160 @@ subroutine FAST_UnPackBeamDyn_Data(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE FAST_CopyElastoDyn_Data( SrcElastoDyn_DataData, DstElastoDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ElastoDyn_Data), INTENT(INOUT) :: SrcElastoDyn_DataData - TYPE(ElastoDyn_Data), INTENT(INOUT) :: DstElastoDyn_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyElastoDyn_Data' -! + +subroutine FAST_CopyAeroDyn14_Data(SrcAeroDyn14_DataData, DstAeroDyn14_DataData, CtrlCode, ErrStat, ErrMsg) + type(AeroDyn14_Data), intent(inout) :: SrcAeroDyn14_DataData + type(AeroDyn14_Data), intent(inout) :: DstAeroDyn14_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyAeroDyn14_Data' ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcElastoDyn_DataData%x,1), UBOUND(SrcElastoDyn_DataData%x,1) - CALL ED_CopyContState( SrcElastoDyn_DataData%x(i1), DstElastoDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcElastoDyn_DataData%xd,1), UBOUND(SrcElastoDyn_DataData%xd,1) - CALL ED_CopyDiscState( SrcElastoDyn_DataData%xd(i1), DstElastoDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcElastoDyn_DataData%z,1), UBOUND(SrcElastoDyn_DataData%z,1) - CALL ED_CopyConstrState( SrcElastoDyn_DataData%z(i1), DstElastoDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcElastoDyn_DataData%OtherSt,1), UBOUND(SrcElastoDyn_DataData%OtherSt,1) - CALL ED_CopyOtherState( SrcElastoDyn_DataData%OtherSt(i1), DstElastoDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL ED_CopyParam( SrcElastoDyn_DataData%p, DstElastoDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ED_CopyInput( SrcElastoDyn_DataData%u, DstElastoDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ED_CopyOutput( SrcElastoDyn_DataData%y, DstElastoDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ED_CopyMisc( SrcElastoDyn_DataData%m, DstElastoDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcElastoDyn_DataData%Output)) THEN - i1_l = LBOUND(SrcElastoDyn_DataData%Output,1) - i1_u = UBOUND(SrcElastoDyn_DataData%Output,1) - IF (.NOT. ALLOCATED(DstElastoDyn_DataData%Output)) THEN - ALLOCATE(DstElastoDyn_DataData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcElastoDyn_DataData%Output,1), UBOUND(SrcElastoDyn_DataData%Output,1) - CALL ED_CopyOutput( SrcElastoDyn_DataData%Output(i1), DstElastoDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL ED_CopyOutput( SrcElastoDyn_DataData%y_interp, DstElastoDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcElastoDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcElastoDyn_DataData%Input,1) - i1_u = UBOUND(SrcElastoDyn_DataData%Input,1) - IF (.NOT. ALLOCATED(DstElastoDyn_DataData%Input)) THEN - ALLOCATE(DstElastoDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcElastoDyn_DataData%Input,1), UBOUND(SrcElastoDyn_DataData%Input,1) - CALL ED_CopyInput( SrcElastoDyn_DataData%Input(i1), DstElastoDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcElastoDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcElastoDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcElastoDyn_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstElastoDyn_DataData%InputTimes)) THEN - ALLOCATE(DstElastoDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElastoDyn_DataData%InputTimes = SrcElastoDyn_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyElastoDyn_Data - - SUBROUTINE FAST_DestroyElastoDyn_Data( ElastoDyn_DataData, ErrStat, ErrMsg ) - TYPE(ElastoDyn_Data), INTENT(INOUT) :: ElastoDyn_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyElastoDyn_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(ElastoDyn_DataData%x,1), UBOUND(ElastoDyn_DataData%x,1) - CALL ED_DestroyContState( ElastoDyn_DataData%x(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(ElastoDyn_DataData%xd,1), UBOUND(ElastoDyn_DataData%xd,1) - CALL ED_DestroyDiscState( ElastoDyn_DataData%xd(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(ElastoDyn_DataData%z,1), UBOUND(ElastoDyn_DataData%z,1) - CALL ED_DestroyConstrState( ElastoDyn_DataData%z(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(ElastoDyn_DataData%OtherSt,1), UBOUND(ElastoDyn_DataData%OtherSt,1) - CALL ED_DestroyOtherState( ElastoDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL ED_DestroyParam( ElastoDyn_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ED_DestroyInput( ElastoDyn_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ED_DestroyOutput( ElastoDyn_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ED_DestroyMisc( ElastoDyn_DataData%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ElastoDyn_DataData%Output)) THEN -DO i1 = LBOUND(ElastoDyn_DataData%Output,1), UBOUND(ElastoDyn_DataData%Output,1) - CALL ED_DestroyOutput( ElastoDyn_DataData%Output(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ElastoDyn_DataData%Output) -ENDIF - CALL ED_DestroyOutput( ElastoDyn_DataData%y_interp, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ElastoDyn_DataData%Input)) THEN -DO i1 = LBOUND(ElastoDyn_DataData%Input,1), UBOUND(ElastoDyn_DataData%Input,1) - CALL ED_DestroyInput( ElastoDyn_DataData%Input(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ElastoDyn_DataData%Input) -ENDIF -IF (ALLOCATED(ElastoDyn_DataData%InputTimes)) THEN - DEALLOCATE(ElastoDyn_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyElastoDyn_Data + ErrMsg = '' + do i1 = LB(1), UB(1) + call AD14_CopyContState(SrcAeroDyn14_DataData%x(i1), DstAeroDyn14_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + do i1 = LB(1), UB(1) + call AD14_CopyDiscState(SrcAeroDyn14_DataData%xd(i1), DstAeroDyn14_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + do i1 = LB(1), UB(1) + call AD14_CopyConstrState(SrcAeroDyn14_DataData%z(i1), DstAeroDyn14_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + do i1 = LB(1), UB(1) + call AD14_CopyOtherState(SrcAeroDyn14_DataData%OtherSt(i1), DstAeroDyn14_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call AD14_CopyParam(SrcAeroDyn14_DataData%p, DstAeroDyn14_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyInput(SrcAeroDyn14_DataData%u, DstAeroDyn14_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyOutput(SrcAeroDyn14_DataData%y, DstAeroDyn14_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyMisc(SrcAeroDyn14_DataData%m, DstAeroDyn14_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcAeroDyn14_DataData%Input)) then + LB(1:1) = lbound(SrcAeroDyn14_DataData%Input) + UB(1:1) = ubound(SrcAeroDyn14_DataData%Input) + if (.not. allocated(DstAeroDyn14_DataData%Input)) then + allocate(DstAeroDyn14_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn14_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD14_CopyInput(SrcAeroDyn14_DataData%Input(i1), DstAeroDyn14_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstAeroDyn14_DataData%Input)) then + deallocate(DstAeroDyn14_DataData%Input) + end if + if (allocated(SrcAeroDyn14_DataData%InputTimes)) then + LB(1:1) = lbound(SrcAeroDyn14_DataData%InputTimes) + UB(1:1) = ubound(SrcAeroDyn14_DataData%InputTimes) + if (.not. allocated(DstAeroDyn14_DataData%InputTimes)) then + allocate(DstAeroDyn14_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn14_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAeroDyn14_DataData%InputTimes = SrcAeroDyn14_DataData%InputTimes + else if (allocated(DstAeroDyn14_DataData%InputTimes)) then + deallocate(DstAeroDyn14_DataData%InputTimes) + end if +end subroutine +subroutine FAST_DestroyAeroDyn14_Data(AeroDyn14_DataData, ErrStat, ErrMsg) + type(AeroDyn14_Data), intent(inout) :: AeroDyn14_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyAeroDyn14_Data' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(AeroDyn14_DataData%Input)) then + LB(1:1) = lbound(AeroDyn14_DataData%Input) + UB(1:1) = ubound(AeroDyn14_DataData%Input) + do i1 = LB(1), UB(1) + call AD14_DestroyInput(AeroDyn14_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(AeroDyn14_DataData%Input) + end if + if (allocated(AeroDyn14_DataData%InputTimes)) then + deallocate(AeroDyn14_DataData%InputTimes) + end if +end subroutine -subroutine FAST_PackElastoDyn_Data(Buf, Indata) +subroutine FAST_PackAeroDyn14_Data(Buf, Indata) type(PackBuffer), intent(inout) :: Buf - type(ElastoDyn_Data), intent(in) :: InData - character(*), parameter :: RoutineName = 'FAST_PackElastoDyn_Data' + type(AeroDyn14_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackAeroDyn14_Data' integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! x LB(1:1) = lbound(InData%x) UB(1:1) = ubound(InData%x) do i1 = LB(1), UB(1) - call ED_PackContState(Buf, InData%x(i1)) + call AD14_PackContState(Buf, InData%x(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! xd LB(1:1) = lbound(InData%xd) UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) - call ED_PackDiscState(Buf, InData%xd(i1)) + call AD14_PackDiscState(Buf, InData%xd(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! z LB(1:1) = lbound(InData%z) UB(1:1) = ubound(InData%z) do i1 = LB(1), UB(1) - call ED_PackConstrState(Buf, InData%z(i1)) + call AD14_PackConstrState(Buf, InData%z(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! OtherSt LB(1:1) = lbound(InData%OtherSt) UB(1:1) = ubound(InData%OtherSt) do i1 = LB(1), UB(1) - call ED_PackOtherState(Buf, InData%OtherSt(i1)) + call AD14_PackOtherState(Buf, InData%OtherSt(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! p - call ED_PackParam(Buf, InData%p) - if (RegCheckErr(Buf, RoutineName)) return - ! u - call ED_PackInput(Buf, InData%u) - if (RegCheckErr(Buf, RoutineName)) return - ! y - call ED_PackOutput(Buf, InData%y) + call AD14_PackParam(Buf, InData%p) if (RegCheckErr(Buf, RoutineName)) return - ! m - call ED_PackMisc(Buf, InData%m) + call AD14_PackInput(Buf, InData%u) if (RegCheckErr(Buf, RoutineName)) return - ! Output - call RegPack(Buf, allocated(InData%Output)) - if (allocated(InData%Output)) then - call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) - LB(1:1) = lbound(InData%Output) - UB(1:1) = ubound(InData%Output) - do i1 = LB(1), UB(1) - call ED_PackOutput(Buf, InData%Output(i1)) - end do - end if + call AD14_PackOutput(Buf, InData%y) if (RegCheckErr(Buf, RoutineName)) return - ! y_interp - call ED_PackOutput(Buf, InData%y_interp) + call AD14_PackMisc(Buf, InData%m) if (RegCheckErr(Buf, RoutineName)) return - ! Input call RegPack(Buf, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) LB(1:1) = lbound(InData%Input) UB(1:1) = ubound(InData%Input) do i1 = LB(1), UB(1) - call ED_PackInput(Buf, InData%Input(i1)) + call AD14_PackInput(Buf, InData%Input(i1)) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! InputTimes call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) @@ -9097,66 +9302,39 @@ subroutine FAST_PackElastoDyn_Data(Buf, Indata) if (RegCheckErr(Buf, RoutineName)) return end subroutine -subroutine FAST_UnPackElastoDyn_Data(Buf, OutData) +subroutine FAST_UnPackAeroDyn14_Data(Buf, OutData) type(PackBuffer), intent(inout) :: Buf - type(ElastoDyn_Data), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'FAST_UnPackElastoDyn_Data' + type(AeroDyn14_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackAeroDyn14_Data' integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! x LB(1:1) = lbound(OutData%x) UB(1:1) = ubound(OutData%x) do i1 = LB(1), UB(1) - call ED_UnpackContState(Buf, OutData%x(i1)) ! x + call AD14_UnpackContState(Buf, OutData%x(i1)) ! x end do - ! xd LB(1:1) = lbound(OutData%xd) UB(1:1) = ubound(OutData%xd) do i1 = LB(1), UB(1) - call ED_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + call AD14_UnpackDiscState(Buf, OutData%xd(i1)) ! xd end do - ! z LB(1:1) = lbound(OutData%z) UB(1:1) = ubound(OutData%z) do i1 = LB(1), UB(1) - call ED_UnpackConstrState(Buf, OutData%z(i1)) ! z + call AD14_UnpackConstrState(Buf, OutData%z(i1)) ! z end do - ! OtherSt LB(1:1) = lbound(OutData%OtherSt) UB(1:1) = ubound(OutData%OtherSt) do i1 = LB(1), UB(1) - call ED_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + call AD14_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt end do - ! p - call ED_UnpackParam(Buf, OutData%p) ! p - ! u - call ED_UnpackInput(Buf, OutData%u) ! u - ! y - call ED_UnpackOutput(Buf, OutData%y) ! y - ! m - call ED_UnpackMisc(Buf, OutData%m) ! m - ! Output - if (allocated(OutData%Output)) deallocate(OutData%Output) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Output(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call ED_UnpackOutput(Buf, OutData%Output(i1)) ! Output - end do - end if - ! y_interp - call ED_UnpackOutput(Buf, OutData%y_interp) ! y_interp - ! Input + call AD14_UnpackParam(Buf, OutData%p) ! p + call AD14_UnpackInput(Buf, OutData%u) ! u + call AD14_UnpackOutput(Buf, OutData%y) ! y + call AD14_UnpackMisc(Buf, OutData%m) ! m if (allocated(OutData%Input)) deallocate(OutData%Input) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -9169,10 +9347,9 @@ subroutine FAST_UnPackElastoDyn_Data(Buf, OutData) return end if do i1 = LB(1), UB(1) - call ED_UnpackInput(Buf, OutData%Input(i1)) ! Input + call AD14_UnpackInput(Buf, OutData%Input(i1)) ! Input end do end if - ! InputTimes if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -9188,234 +9365,202 @@ subroutine FAST_UnPackElastoDyn_Data(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE FAST_CopyServoDyn_Data( SrcServoDyn_DataData, DstServoDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ServoDyn_Data), INTENT(INOUT) :: SrcServoDyn_DataData - TYPE(ServoDyn_Data), INTENT(INOUT) :: DstServoDyn_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyServoDyn_Data' -! + +subroutine FAST_CopyAeroDyn_Data(SrcAeroDyn_DataData, DstAeroDyn_DataData, CtrlCode, ErrStat, ErrMsg) + type(AeroDyn_Data), intent(inout) :: SrcAeroDyn_DataData + type(AeroDyn_Data), intent(inout) :: DstAeroDyn_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyAeroDyn_Data' ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcServoDyn_DataData%x,1), UBOUND(SrcServoDyn_DataData%x,1) - CALL SrvD_CopyContState( SrcServoDyn_DataData%x(i1), DstServoDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcServoDyn_DataData%xd,1), UBOUND(SrcServoDyn_DataData%xd,1) - CALL SrvD_CopyDiscState( SrcServoDyn_DataData%xd(i1), DstServoDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcServoDyn_DataData%z,1), UBOUND(SrcServoDyn_DataData%z,1) - CALL SrvD_CopyConstrState( SrcServoDyn_DataData%z(i1), DstServoDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcServoDyn_DataData%OtherSt,1), UBOUND(SrcServoDyn_DataData%OtherSt,1) - CALL SrvD_CopyOtherState( SrcServoDyn_DataData%OtherSt(i1), DstServoDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL SrvD_CopyParam( SrcServoDyn_DataData%p, DstServoDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SrvD_CopyInput( SrcServoDyn_DataData%u, DstServoDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SrvD_CopyOutput( SrcServoDyn_DataData%y, DstServoDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SrvD_CopyMisc( SrcServoDyn_DataData%m, DstServoDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcServoDyn_DataData%Output)) THEN - i1_l = LBOUND(SrcServoDyn_DataData%Output,1) - i1_u = UBOUND(SrcServoDyn_DataData%Output,1) - IF (.NOT. ALLOCATED(DstServoDyn_DataData%Output)) THEN - ALLOCATE(DstServoDyn_DataData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcServoDyn_DataData%Output,1), UBOUND(SrcServoDyn_DataData%Output,1) - CALL SrvD_CopyOutput( SrcServoDyn_DataData%Output(i1), DstServoDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL SrvD_CopyOutput( SrcServoDyn_DataData%y_interp, DstServoDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcServoDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcServoDyn_DataData%Input,1) - i1_u = UBOUND(SrcServoDyn_DataData%Input,1) - IF (.NOT. ALLOCATED(DstServoDyn_DataData%Input)) THEN - ALLOCATE(DstServoDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcServoDyn_DataData%Input,1), UBOUND(SrcServoDyn_DataData%Input,1) - CALL SrvD_CopyInput( SrcServoDyn_DataData%Input(i1), DstServoDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcServoDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcServoDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcServoDyn_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstServoDyn_DataData%InputTimes)) THEN - ALLOCATE(DstServoDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstServoDyn_DataData%InputTimes = SrcServoDyn_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyServoDyn_Data - - SUBROUTINE FAST_DestroyServoDyn_Data( ServoDyn_DataData, ErrStat, ErrMsg ) - TYPE(ServoDyn_Data), INTENT(INOUT) :: ServoDyn_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyServoDyn_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(ServoDyn_DataData%x,1), UBOUND(ServoDyn_DataData%x,1) - CALL SrvD_DestroyContState( ServoDyn_DataData%x(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(ServoDyn_DataData%xd,1), UBOUND(ServoDyn_DataData%xd,1) - CALL SrvD_DestroyDiscState( ServoDyn_DataData%xd(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(ServoDyn_DataData%z,1), UBOUND(ServoDyn_DataData%z,1) - CALL SrvD_DestroyConstrState( ServoDyn_DataData%z(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(ServoDyn_DataData%OtherSt,1), UBOUND(ServoDyn_DataData%OtherSt,1) - CALL SrvD_DestroyOtherState( ServoDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL SrvD_DestroyParam( ServoDyn_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SrvD_DestroyInput( ServoDyn_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SrvD_DestroyOutput( ServoDyn_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SrvD_DestroyMisc( ServoDyn_DataData%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ServoDyn_DataData%Output)) THEN -DO i1 = LBOUND(ServoDyn_DataData%Output,1), UBOUND(ServoDyn_DataData%Output,1) - CALL SrvD_DestroyOutput( ServoDyn_DataData%Output(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ServoDyn_DataData%Output) -ENDIF - CALL SrvD_DestroyOutput( ServoDyn_DataData%y_interp, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ServoDyn_DataData%Input)) THEN -DO i1 = LBOUND(ServoDyn_DataData%Input,1), UBOUND(ServoDyn_DataData%Input,1) - CALL SrvD_DestroyInput( ServoDyn_DataData%Input(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ServoDyn_DataData%Input) -ENDIF -IF (ALLOCATED(ServoDyn_DataData%InputTimes)) THEN - DEALLOCATE(ServoDyn_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyServoDyn_Data + ErrMsg = '' + do i1 = LB(1), UB(1) + call AD_CopyContState(SrcAeroDyn_DataData%x(i1), DstAeroDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + do i1 = LB(1), UB(1) + call AD_CopyDiscState(SrcAeroDyn_DataData%xd(i1), DstAeroDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + do i1 = LB(1), UB(1) + call AD_CopyConstrState(SrcAeroDyn_DataData%z(i1), DstAeroDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + do i1 = LB(1), UB(1) + call AD_CopyOtherState(SrcAeroDyn_DataData%OtherSt(i1), DstAeroDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call AD_CopyParam(SrcAeroDyn_DataData%p, DstAeroDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD_CopyInput(SrcAeroDyn_DataData%u, DstAeroDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD_CopyOutput(SrcAeroDyn_DataData%y, DstAeroDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD_CopyMisc(SrcAeroDyn_DataData%m, DstAeroDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcAeroDyn_DataData%Output)) then + LB(1:1) = lbound(SrcAeroDyn_DataData%Output) + UB(1:1) = ubound(SrcAeroDyn_DataData%Output) + if (.not. allocated(DstAeroDyn_DataData%Output)) then + allocate(DstAeroDyn_DataData%Output(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%Output.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyOutput(SrcAeroDyn_DataData%Output(i1), DstAeroDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstAeroDyn_DataData%Output)) then + deallocate(DstAeroDyn_DataData%Output) + end if + call AD_CopyOutput(SrcAeroDyn_DataData%y_interp, DstAeroDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcAeroDyn_DataData%Input)) then + LB(1:1) = lbound(SrcAeroDyn_DataData%Input) + UB(1:1) = ubound(SrcAeroDyn_DataData%Input) + if (.not. allocated(DstAeroDyn_DataData%Input)) then + allocate(DstAeroDyn_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyInput(SrcAeroDyn_DataData%Input(i1), DstAeroDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstAeroDyn_DataData%Input)) then + deallocate(DstAeroDyn_DataData%Input) + end if + if (allocated(SrcAeroDyn_DataData%InputTimes)) then + LB(1:1) = lbound(SrcAeroDyn_DataData%InputTimes) + UB(1:1) = ubound(SrcAeroDyn_DataData%InputTimes) + if (.not. allocated(DstAeroDyn_DataData%InputTimes)) then + allocate(DstAeroDyn_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstAeroDyn_DataData%InputTimes = SrcAeroDyn_DataData%InputTimes + else if (allocated(DstAeroDyn_DataData%InputTimes)) then + deallocate(DstAeroDyn_DataData%InputTimes) + end if +end subroutine +subroutine FAST_DestroyAeroDyn_Data(AeroDyn_DataData, ErrStat, ErrMsg) + type(AeroDyn_Data), intent(inout) :: AeroDyn_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyAeroDyn_Data' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(AeroDyn_DataData%Output)) then + LB(1:1) = lbound(AeroDyn_DataData%Output) + UB(1:1) = ubound(AeroDyn_DataData%Output) + do i1 = LB(1), UB(1) + call AD_DestroyOutput(AeroDyn_DataData%Output(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(AeroDyn_DataData%Output) + end if + if (allocated(AeroDyn_DataData%Input)) then + LB(1:1) = lbound(AeroDyn_DataData%Input) + UB(1:1) = ubound(AeroDyn_DataData%Input) + do i1 = LB(1), UB(1) + call AD_DestroyInput(AeroDyn_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(AeroDyn_DataData%Input) + end if + if (allocated(AeroDyn_DataData%InputTimes)) then + deallocate(AeroDyn_DataData%InputTimes) + end if +end subroutine -subroutine FAST_PackServoDyn_Data(Buf, Indata) +subroutine FAST_PackAeroDyn_Data(Buf, Indata) type(PackBuffer), intent(inout) :: Buf - type(ServoDyn_Data), intent(in) :: InData - character(*), parameter :: RoutineName = 'FAST_PackServoDyn_Data' + type(AeroDyn_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackAeroDyn_Data' integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! x LB(1:1) = lbound(InData%x) UB(1:1) = ubound(InData%x) do i1 = LB(1), UB(1) - call SrvD_PackContState(Buf, InData%x(i1)) + call AD_PackContState(Buf, InData%x(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! xd LB(1:1) = lbound(InData%xd) UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) - call SrvD_PackDiscState(Buf, InData%xd(i1)) + call AD_PackDiscState(Buf, InData%xd(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! z LB(1:1) = lbound(InData%z) UB(1:1) = ubound(InData%z) do i1 = LB(1), UB(1) - call SrvD_PackConstrState(Buf, InData%z(i1)) + call AD_PackConstrState(Buf, InData%z(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! OtherSt LB(1:1) = lbound(InData%OtherSt) UB(1:1) = ubound(InData%OtherSt) do i1 = LB(1), UB(1) - call SrvD_PackOtherState(Buf, InData%OtherSt(i1)) + call AD_PackOtherState(Buf, InData%OtherSt(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! p - call SrvD_PackParam(Buf, InData%p) + call AD_PackParam(Buf, InData%p) if (RegCheckErr(Buf, RoutineName)) return - ! u - call SrvD_PackInput(Buf, InData%u) + call AD_PackInput(Buf, InData%u) if (RegCheckErr(Buf, RoutineName)) return - ! y - call SrvD_PackOutput(Buf, InData%y) + call AD_PackOutput(Buf, InData%y) if (RegCheckErr(Buf, RoutineName)) return - ! m - call SrvD_PackMisc(Buf, InData%m) + call AD_PackMisc(Buf, InData%m) if (RegCheckErr(Buf, RoutineName)) return - ! Output call RegPack(Buf, allocated(InData%Output)) if (allocated(InData%Output)) then call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) LB(1:1) = lbound(InData%Output) UB(1:1) = ubound(InData%Output) do i1 = LB(1), UB(1) - call SrvD_PackOutput(Buf, InData%Output(i1)) + call AD_PackOutput(Buf, InData%Output(i1)) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! y_interp - call SrvD_PackOutput(Buf, InData%y_interp) + call AD_PackOutput(Buf, InData%y_interp) if (RegCheckErr(Buf, RoutineName)) return - ! Input call RegPack(Buf, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) LB(1:1) = lbound(InData%Input) UB(1:1) = ubound(InData%Input) do i1 = LB(1), UB(1) - call SrvD_PackInput(Buf, InData%Input(i1)) + call AD_PackInput(Buf, InData%Input(i1)) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! InputTimes call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) @@ -9424,48 +9569,39 @@ subroutine FAST_PackServoDyn_Data(Buf, Indata) if (RegCheckErr(Buf, RoutineName)) return end subroutine -subroutine FAST_UnPackServoDyn_Data(Buf, OutData) +subroutine FAST_UnPackAeroDyn_Data(Buf, OutData) type(PackBuffer), intent(inout) :: Buf - type(ServoDyn_Data), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'FAST_UnPackServoDyn_Data' + type(AeroDyn_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackAeroDyn_Data' integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! x LB(1:1) = lbound(OutData%x) UB(1:1) = ubound(OutData%x) do i1 = LB(1), UB(1) - call SrvD_UnpackContState(Buf, OutData%x(i1)) ! x + call AD_UnpackContState(Buf, OutData%x(i1)) ! x end do - ! xd LB(1:1) = lbound(OutData%xd) UB(1:1) = ubound(OutData%xd) do i1 = LB(1), UB(1) - call SrvD_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + call AD_UnpackDiscState(Buf, OutData%xd(i1)) ! xd end do - ! z LB(1:1) = lbound(OutData%z) UB(1:1) = ubound(OutData%z) do i1 = LB(1), UB(1) - call SrvD_UnpackConstrState(Buf, OutData%z(i1)) ! z + call AD_UnpackConstrState(Buf, OutData%z(i1)) ! z end do - ! OtherSt LB(1:1) = lbound(OutData%OtherSt) UB(1:1) = ubound(OutData%OtherSt) do i1 = LB(1), UB(1) - call SrvD_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + call AD_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt end do - ! p - call SrvD_UnpackParam(Buf, OutData%p) ! p - ! u - call SrvD_UnpackInput(Buf, OutData%u) ! u - ! y - call SrvD_UnpackOutput(Buf, OutData%y) ! y - ! m - call SrvD_UnpackMisc(Buf, OutData%m) ! m - ! Output + call AD_UnpackParam(Buf, OutData%p) ! p + call AD_UnpackInput(Buf, OutData%u) ! u + call AD_UnpackOutput(Buf, OutData%y) ! y + call AD_UnpackMisc(Buf, OutData%m) ! m if (allocated(OutData%Output)) deallocate(OutData%Output) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -9478,12 +9614,10 @@ subroutine FAST_UnPackServoDyn_Data(Buf, OutData) return end if do i1 = LB(1), UB(1) - call SrvD_UnpackOutput(Buf, OutData%Output(i1)) ! Output + call AD_UnpackOutput(Buf, OutData%Output(i1)) ! Output end do end if - ! y_interp - call SrvD_UnpackOutput(Buf, OutData%y_interp) ! y_interp - ! Input + call AD_UnpackOutput(Buf, OutData%y_interp) ! y_interp if (allocated(OutData%Input)) deallocate(OutData%Input) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -9496,10 +9630,9 @@ subroutine FAST_UnPackServoDyn_Data(Buf, OutData) return end if do i1 = LB(1), UB(1) - call SrvD_UnpackInput(Buf, OutData%Input(i1)) ! Input + call AD_UnpackInput(Buf, OutData%Input(i1)) ! Input end do end if - ! InputTimes if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -9515,192 +9648,202 @@ subroutine FAST_UnPackServoDyn_Data(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE FAST_CopyAeroDyn14_Data( SrcAeroDyn14_DataData, DstAeroDyn14_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AeroDyn14_Data), INTENT(INOUT) :: SrcAeroDyn14_DataData - TYPE(AeroDyn14_Data), INTENT(INOUT) :: DstAeroDyn14_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyAeroDyn14_Data' -! + +subroutine FAST_CopyInflowWind_Data(SrcInflowWind_DataData, DstInflowWind_DataData, CtrlCode, ErrStat, ErrMsg) + type(InflowWind_Data), intent(in) :: SrcInflowWind_DataData + type(InflowWind_Data), intent(inout) :: DstInflowWind_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyInflowWind_Data' ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcAeroDyn14_DataData%x,1), UBOUND(SrcAeroDyn14_DataData%x,1) - CALL AD14_CopyContState( SrcAeroDyn14_DataData%x(i1), DstAeroDyn14_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcAeroDyn14_DataData%xd,1), UBOUND(SrcAeroDyn14_DataData%xd,1) - CALL AD14_CopyDiscState( SrcAeroDyn14_DataData%xd(i1), DstAeroDyn14_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcAeroDyn14_DataData%z,1), UBOUND(SrcAeroDyn14_DataData%z,1) - CALL AD14_CopyConstrState( SrcAeroDyn14_DataData%z(i1), DstAeroDyn14_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcAeroDyn14_DataData%OtherSt,1), UBOUND(SrcAeroDyn14_DataData%OtherSt,1) - CALL AD14_CopyOtherState( SrcAeroDyn14_DataData%OtherSt(i1), DstAeroDyn14_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL AD14_CopyParam( SrcAeroDyn14_DataData%p, DstAeroDyn14_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_CopyInput( SrcAeroDyn14_DataData%u, DstAeroDyn14_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_CopyOutput( SrcAeroDyn14_DataData%y, DstAeroDyn14_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_CopyMisc( SrcAeroDyn14_DataData%m, DstAeroDyn14_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcAeroDyn14_DataData%Input)) THEN - i1_l = LBOUND(SrcAeroDyn14_DataData%Input,1) - i1_u = UBOUND(SrcAeroDyn14_DataData%Input,1) - IF (.NOT. ALLOCATED(DstAeroDyn14_DataData%Input)) THEN - ALLOCATE(DstAeroDyn14_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn14_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcAeroDyn14_DataData%Input,1), UBOUND(SrcAeroDyn14_DataData%Input,1) - CALL AD14_CopyInput( SrcAeroDyn14_DataData%Input(i1), DstAeroDyn14_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcAeroDyn14_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcAeroDyn14_DataData%InputTimes,1) - i1_u = UBOUND(SrcAeroDyn14_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstAeroDyn14_DataData%InputTimes)) THEN - ALLOCATE(DstAeroDyn14_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn14_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstAeroDyn14_DataData%InputTimes = SrcAeroDyn14_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyAeroDyn14_Data - - SUBROUTINE FAST_DestroyAeroDyn14_Data( AeroDyn14_DataData, ErrStat, ErrMsg ) - TYPE(AeroDyn14_Data), INTENT(INOUT) :: AeroDyn14_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyAeroDyn14_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(AeroDyn14_DataData%x,1), UBOUND(AeroDyn14_DataData%x,1) - CALL AD14_DestroyContState( AeroDyn14_DataData%x(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(AeroDyn14_DataData%xd,1), UBOUND(AeroDyn14_DataData%xd,1) - CALL AD14_DestroyDiscState( AeroDyn14_DataData%xd(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(AeroDyn14_DataData%z,1), UBOUND(AeroDyn14_DataData%z,1) - CALL AD14_DestroyConstrState( AeroDyn14_DataData%z(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(AeroDyn14_DataData%OtherSt,1), UBOUND(AeroDyn14_DataData%OtherSt,1) - CALL AD14_DestroyOtherState( AeroDyn14_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL AD14_DestroyParam( AeroDyn14_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyInput( AeroDyn14_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyOutput( AeroDyn14_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyMisc( AeroDyn14_DataData%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(AeroDyn14_DataData%Input)) THEN -DO i1 = LBOUND(AeroDyn14_DataData%Input,1), UBOUND(AeroDyn14_DataData%Input,1) - CALL AD14_DestroyInput( AeroDyn14_DataData%Input(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(AeroDyn14_DataData%Input) -ENDIF -IF (ALLOCATED(AeroDyn14_DataData%InputTimes)) THEN - DEALLOCATE(AeroDyn14_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyAeroDyn14_Data + ErrMsg = '' + do i1 = LB(1), UB(1) + call InflowWind_CopyContState(SrcInflowWind_DataData%x(i1), DstInflowWind_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + do i1 = LB(1), UB(1) + call InflowWind_CopyDiscState(SrcInflowWind_DataData%xd(i1), DstInflowWind_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + do i1 = LB(1), UB(1) + call InflowWind_CopyConstrState(SrcInflowWind_DataData%z(i1), DstInflowWind_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + do i1 = LB(1), UB(1) + call InflowWind_CopyOtherState(SrcInflowWind_DataData%OtherSt(i1), DstInflowWind_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call InflowWind_CopyParam(SrcInflowWind_DataData%p, DstInflowWind_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyInput(SrcInflowWind_DataData%u, DstInflowWind_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyOutput(SrcInflowWind_DataData%y, DstInflowWind_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyMisc(SrcInflowWind_DataData%m, DstInflowWind_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInflowWind_DataData%Output)) then + LB(1:1) = lbound(SrcInflowWind_DataData%Output) + UB(1:1) = ubound(SrcInflowWind_DataData%Output) + if (.not. allocated(DstInflowWind_DataData%Output)) then + allocate(DstInflowWind_DataData%Output(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%Output.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call InflowWind_CopyOutput(SrcInflowWind_DataData%Output(i1), DstInflowWind_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstInflowWind_DataData%Output)) then + deallocate(DstInflowWind_DataData%Output) + end if + call InflowWind_CopyOutput(SrcInflowWind_DataData%y_interp, DstInflowWind_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInflowWind_DataData%Input)) then + LB(1:1) = lbound(SrcInflowWind_DataData%Input) + UB(1:1) = ubound(SrcInflowWind_DataData%Input) + if (.not. allocated(DstInflowWind_DataData%Input)) then + allocate(DstInflowWind_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call InflowWind_CopyInput(SrcInflowWind_DataData%Input(i1), DstInflowWind_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstInflowWind_DataData%Input)) then + deallocate(DstInflowWind_DataData%Input) + end if + if (allocated(SrcInflowWind_DataData%InputTimes)) then + LB(1:1) = lbound(SrcInflowWind_DataData%InputTimes) + UB(1:1) = ubound(SrcInflowWind_DataData%InputTimes) + if (.not. allocated(DstInflowWind_DataData%InputTimes)) then + allocate(DstInflowWind_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInflowWind_DataData%InputTimes = SrcInflowWind_DataData%InputTimes + else if (allocated(DstInflowWind_DataData%InputTimes)) then + deallocate(DstInflowWind_DataData%InputTimes) + end if +end subroutine +subroutine FAST_DestroyInflowWind_Data(InflowWind_DataData, ErrStat, ErrMsg) + type(InflowWind_Data), intent(inout) :: InflowWind_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyInflowWind_Data' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InflowWind_DataData%Output)) then + LB(1:1) = lbound(InflowWind_DataData%Output) + UB(1:1) = ubound(InflowWind_DataData%Output) + do i1 = LB(1), UB(1) + call InflowWind_DestroyOutput(InflowWind_DataData%Output(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InflowWind_DataData%Output) + end if + if (allocated(InflowWind_DataData%Input)) then + LB(1:1) = lbound(InflowWind_DataData%Input) + UB(1:1) = ubound(InflowWind_DataData%Input) + do i1 = LB(1), UB(1) + call InflowWind_DestroyInput(InflowWind_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InflowWind_DataData%Input) + end if + if (allocated(InflowWind_DataData%InputTimes)) then + deallocate(InflowWind_DataData%InputTimes) + end if +end subroutine -subroutine FAST_PackAeroDyn14_Data(Buf, Indata) +subroutine FAST_PackInflowWind_Data(Buf, Indata) type(PackBuffer), intent(inout) :: Buf - type(AeroDyn14_Data), intent(in) :: InData - character(*), parameter :: RoutineName = 'FAST_PackAeroDyn14_Data' + type(InflowWind_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackInflowWind_Data' integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! x LB(1:1) = lbound(InData%x) UB(1:1) = ubound(InData%x) do i1 = LB(1), UB(1) - call AD14_PackContState(Buf, InData%x(i1)) + call InflowWind_PackContState(Buf, InData%x(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! xd LB(1:1) = lbound(InData%xd) UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) - call AD14_PackDiscState(Buf, InData%xd(i1)) + call InflowWind_PackDiscState(Buf, InData%xd(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! z LB(1:1) = lbound(InData%z) UB(1:1) = ubound(InData%z) do i1 = LB(1), UB(1) - call AD14_PackConstrState(Buf, InData%z(i1)) + call InflowWind_PackConstrState(Buf, InData%z(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! OtherSt LB(1:1) = lbound(InData%OtherSt) UB(1:1) = ubound(InData%OtherSt) do i1 = LB(1), UB(1) - call AD14_PackOtherState(Buf, InData%OtherSt(i1)) + call InflowWind_PackOtherState(Buf, InData%OtherSt(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! p - call AD14_PackParam(Buf, InData%p) + call InflowWind_PackParam(Buf, InData%p) if (RegCheckErr(Buf, RoutineName)) return - ! u - call AD14_PackInput(Buf, InData%u) + call InflowWind_PackInput(Buf, InData%u) if (RegCheckErr(Buf, RoutineName)) return - ! y - call AD14_PackOutput(Buf, InData%y) + call InflowWind_PackOutput(Buf, InData%y) if (RegCheckErr(Buf, RoutineName)) return - ! m - call AD14_PackMisc(Buf, InData%m) + call InflowWind_PackMisc(Buf, InData%m) + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%Output)) + if (allocated(InData%Output)) then + call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) + LB(1:1) = lbound(InData%Output) + UB(1:1) = ubound(InData%Output) + do i1 = LB(1), UB(1) + call InflowWind_PackOutput(Buf, InData%Output(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call InflowWind_PackOutput(Buf, InData%y_interp) if (RegCheckErr(Buf, RoutineName)) return - ! Input call RegPack(Buf, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) LB(1:1) = lbound(InData%Input) UB(1:1) = ubound(InData%Input) do i1 = LB(1), UB(1) - call AD14_PackInput(Buf, InData%Input(i1)) + call InflowWind_PackInput(Buf, InData%Input(i1)) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! InputTimes call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) @@ -9709,48 +9852,55 @@ subroutine FAST_PackAeroDyn14_Data(Buf, Indata) if (RegCheckErr(Buf, RoutineName)) return end subroutine -subroutine FAST_UnPackAeroDyn14_Data(Buf, OutData) +subroutine FAST_UnPackInflowWind_Data(Buf, OutData) type(PackBuffer), intent(inout) :: Buf - type(AeroDyn14_Data), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'FAST_UnPackAeroDyn14_Data' + type(InflowWind_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackInflowWind_Data' integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! x LB(1:1) = lbound(OutData%x) UB(1:1) = ubound(OutData%x) do i1 = LB(1), UB(1) - call AD14_UnpackContState(Buf, OutData%x(i1)) ! x + call InflowWind_UnpackContState(Buf, OutData%x(i1)) ! x end do - ! xd LB(1:1) = lbound(OutData%xd) UB(1:1) = ubound(OutData%xd) do i1 = LB(1), UB(1) - call AD14_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + call InflowWind_UnpackDiscState(Buf, OutData%xd(i1)) ! xd end do - ! z LB(1:1) = lbound(OutData%z) UB(1:1) = ubound(OutData%z) do i1 = LB(1), UB(1) - call AD14_UnpackConstrState(Buf, OutData%z(i1)) ! z + call InflowWind_UnpackConstrState(Buf, OutData%z(i1)) ! z end do - ! OtherSt LB(1:1) = lbound(OutData%OtherSt) UB(1:1) = ubound(OutData%OtherSt) do i1 = LB(1), UB(1) - call AD14_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + call InflowWind_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt end do - ! p - call AD14_UnpackParam(Buf, OutData%p) ! p - ! u - call AD14_UnpackInput(Buf, OutData%u) ! u - ! y - call AD14_UnpackOutput(Buf, OutData%y) ! y - ! m - call AD14_UnpackMisc(Buf, OutData%m) ! m - ! Input + call InflowWind_UnpackParam(Buf, OutData%p) ! p + call InflowWind_UnpackInput(Buf, OutData%u) ! u + call InflowWind_UnpackOutput(Buf, OutData%y) ! y + call InflowWind_UnpackMisc(Buf, OutData%m) ! m + if (allocated(OutData%Output)) deallocate(OutData%Output) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Output(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call InflowWind_UnpackOutput(Buf, OutData%Output(i1)) ! Output + end do + end if + call InflowWind_UnpackOutput(Buf, OutData%y_interp) ! y_interp if (allocated(OutData%Input)) deallocate(OutData%Input) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -9763,10 +9913,9 @@ subroutine FAST_UnPackAeroDyn14_Data(Buf, OutData) return end if do i1 = LB(1), UB(1) - call AD14_UnpackInput(Buf, OutData%Input(i1)) ! Input + call InflowWind_UnpackInput(Buf, OutData%Input(i1)) ! Input end do end if - ! InputTimes if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -9782,234 +9931,320 @@ subroutine FAST_UnPackAeroDyn14_Data(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE FAST_CopyAeroDyn_Data( SrcAeroDyn_DataData, DstAeroDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AeroDyn_Data), INTENT(INOUT) :: SrcAeroDyn_DataData - TYPE(AeroDyn_Data), INTENT(INOUT) :: DstAeroDyn_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyAeroDyn_Data' -! + +subroutine FAST_CopyOpenFOAM_Data(SrcOpenFOAM_DataData, DstOpenFOAM_DataData, CtrlCode, ErrStat, ErrMsg) + type(OpenFOAM_Data), intent(inout) :: SrcOpenFOAM_DataData + type(OpenFOAM_Data), intent(inout) :: DstOpenFOAM_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyOpenFOAM_Data' ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcAeroDyn_DataData%x,1), UBOUND(SrcAeroDyn_DataData%x,1) - CALL AD_CopyContState( SrcAeroDyn_DataData%x(i1), DstAeroDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcAeroDyn_DataData%xd,1), UBOUND(SrcAeroDyn_DataData%xd,1) - CALL AD_CopyDiscState( SrcAeroDyn_DataData%xd(i1), DstAeroDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcAeroDyn_DataData%z,1), UBOUND(SrcAeroDyn_DataData%z,1) - CALL AD_CopyConstrState( SrcAeroDyn_DataData%z(i1), DstAeroDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcAeroDyn_DataData%OtherSt,1), UBOUND(SrcAeroDyn_DataData%OtherSt,1) - CALL AD_CopyOtherState( SrcAeroDyn_DataData%OtherSt(i1), DstAeroDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL AD_CopyParam( SrcAeroDyn_DataData%p, DstAeroDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD_CopyInput( SrcAeroDyn_DataData%u, DstAeroDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD_CopyOutput( SrcAeroDyn_DataData%y, DstAeroDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD_CopyMisc( SrcAeroDyn_DataData%m, DstAeroDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcAeroDyn_DataData%Output)) THEN - i1_l = LBOUND(SrcAeroDyn_DataData%Output,1) - i1_u = UBOUND(SrcAeroDyn_DataData%Output,1) - IF (.NOT. ALLOCATED(DstAeroDyn_DataData%Output)) THEN - ALLOCATE(DstAeroDyn_DataData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcAeroDyn_DataData%Output,1), UBOUND(SrcAeroDyn_DataData%Output,1) - CALL AD_CopyOutput( SrcAeroDyn_DataData%Output(i1), DstAeroDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL AD_CopyOutput( SrcAeroDyn_DataData%y_interp, DstAeroDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcAeroDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcAeroDyn_DataData%Input,1) - i1_u = UBOUND(SrcAeroDyn_DataData%Input,1) - IF (.NOT. ALLOCATED(DstAeroDyn_DataData%Input)) THEN - ALLOCATE(DstAeroDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcAeroDyn_DataData%Input,1), UBOUND(SrcAeroDyn_DataData%Input,1) - CALL AD_CopyInput( SrcAeroDyn_DataData%Input(i1), DstAeroDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcAeroDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcAeroDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcAeroDyn_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstAeroDyn_DataData%InputTimes)) THEN - ALLOCATE(DstAeroDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstAeroDyn_DataData%InputTimes = SrcAeroDyn_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyAeroDyn_Data - - SUBROUTINE FAST_DestroyAeroDyn_Data( AeroDyn_DataData, ErrStat, ErrMsg ) - TYPE(AeroDyn_Data), INTENT(INOUT) :: AeroDyn_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyAeroDyn_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(AeroDyn_DataData%x,1), UBOUND(AeroDyn_DataData%x,1) - CALL AD_DestroyContState( AeroDyn_DataData%x(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(AeroDyn_DataData%xd,1), UBOUND(AeroDyn_DataData%xd,1) - CALL AD_DestroyDiscState( AeroDyn_DataData%xd(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(AeroDyn_DataData%z,1), UBOUND(AeroDyn_DataData%z,1) - CALL AD_DestroyConstrState( AeroDyn_DataData%z(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(AeroDyn_DataData%OtherSt,1), UBOUND(AeroDyn_DataData%OtherSt,1) - CALL AD_DestroyOtherState( AeroDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL AD_DestroyParam( AeroDyn_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD_DestroyInput( AeroDyn_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD_DestroyOutput( AeroDyn_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD_DestroyMisc( AeroDyn_DataData%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(AeroDyn_DataData%Output)) THEN -DO i1 = LBOUND(AeroDyn_DataData%Output,1), UBOUND(AeroDyn_DataData%Output,1) - CALL AD_DestroyOutput( AeroDyn_DataData%Output(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(AeroDyn_DataData%Output) -ENDIF - CALL AD_DestroyOutput( AeroDyn_DataData%y_interp, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(AeroDyn_DataData%Input)) THEN -DO i1 = LBOUND(AeroDyn_DataData%Input,1), UBOUND(AeroDyn_DataData%Input,1) - CALL AD_DestroyInput( AeroDyn_DataData%Input(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(AeroDyn_DataData%Input) -ENDIF -IF (ALLOCATED(AeroDyn_DataData%InputTimes)) THEN - DEALLOCATE(AeroDyn_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyAeroDyn_Data + ErrMsg = '' + call OpFM_CopyInput(SrcOpenFOAM_DataData%u, DstOpenFOAM_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call OpFM_CopyOutput(SrcOpenFOAM_DataData%y, DstOpenFOAM_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call OpFM_CopyParam(SrcOpenFOAM_DataData%p, DstOpenFOAM_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call OpFM_CopyMisc(SrcOpenFOAM_DataData%m, DstOpenFOAM_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine FAST_DestroyOpenFOAM_Data(OpenFOAM_DataData, ErrStat, ErrMsg) + type(OpenFOAM_Data), intent(inout) :: OpenFOAM_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyOpenFOAM_Data' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine -subroutine FAST_PackAeroDyn_Data(Buf, Indata) +subroutine FAST_PackOpenFOAM_Data(Buf, Indata) type(PackBuffer), intent(inout) :: Buf - type(AeroDyn_Data), intent(in) :: InData - character(*), parameter :: RoutineName = 'FAST_PackAeroDyn_Data' + type(OpenFOAM_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackOpenFOAM_Data' + if (Buf%ErrStat >= AbortErrLev) return + call OpFM_PackInput(Buf, InData%u) + if (RegCheckErr(Buf, RoutineName)) return + call OpFM_PackOutput(Buf, InData%y) + if (RegCheckErr(Buf, RoutineName)) return + call OpFM_PackParam(Buf, InData%p) + if (RegCheckErr(Buf, RoutineName)) return + call OpFM_PackMisc(Buf, InData%m) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackOpenFOAM_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(OpenFOAM_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackOpenFOAM_Data' + if (Buf%ErrStat /= ErrID_None) return + call OpFM_UnpackInput(Buf, OutData%u) ! u + call OpFM_UnpackOutput(Buf, OutData%y) ! y + call OpFM_UnpackParam(Buf, OutData%p) ! p + call OpFM_UnpackMisc(Buf, OutData%m) ! m +end subroutine + +subroutine FAST_CopySCDataEx_Data(SrcSCDataEx_DataData, DstSCDataEx_DataData, CtrlCode, ErrStat, ErrMsg) + type(SCDataEx_Data), intent(in) :: SrcSCDataEx_DataData + type(SCDataEx_Data), intent(inout) :: DstSCDataEx_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopySCDataEx_Data' + ErrStat = ErrID_None + ErrMsg = '' + call SC_DX_CopyInput(SrcSCDataEx_DataData%u, DstSCDataEx_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SC_DX_CopyOutput(SrcSCDataEx_DataData%y, DstSCDataEx_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SC_DX_CopyParam(SrcSCDataEx_DataData%p, DstSCDataEx_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine FAST_DestroySCDataEx_Data(SCDataEx_DataData, ErrStat, ErrMsg) + type(SCDataEx_Data), intent(inout) :: SCDataEx_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroySCDataEx_Data' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine FAST_PackSCDataEx_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SCDataEx_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackSCDataEx_Data' + if (Buf%ErrStat >= AbortErrLev) return + call SC_DX_PackInput(Buf, InData%u) + if (RegCheckErr(Buf, RoutineName)) return + call SC_DX_PackOutput(Buf, InData%y) + if (RegCheckErr(Buf, RoutineName)) return + call SC_DX_PackParam(Buf, InData%p) + if (RegCheckErr(Buf, RoutineName)) return +end subroutine + +subroutine FAST_UnPackSCDataEx_Data(Buf, OutData) + type(PackBuffer), intent(inout) :: Buf + type(SCDataEx_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackSCDataEx_Data' + if (Buf%ErrStat /= ErrID_None) return + call SC_DX_UnpackInput(Buf, OutData%u) ! u + call SC_DX_UnpackOutput(Buf, OutData%y) ! y + call SC_DX_UnpackParam(Buf, OutData%p) ! p +end subroutine + +subroutine FAST_CopySubDyn_Data(SrcSubDyn_DataData, DstSubDyn_DataData, CtrlCode, ErrStat, ErrMsg) + type(SubDyn_Data), intent(inout) :: SrcSubDyn_DataData + type(SubDyn_Data), intent(inout) :: DstSubDyn_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopySubDyn_Data' + ErrStat = ErrID_None + ErrMsg = '' + do i1 = LB(1), UB(1) + call SD_CopyContState(SrcSubDyn_DataData%x(i1), DstSubDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + do i1 = LB(1), UB(1) + call SD_CopyDiscState(SrcSubDyn_DataData%xd(i1), DstSubDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + do i1 = LB(1), UB(1) + call SD_CopyConstrState(SrcSubDyn_DataData%z(i1), DstSubDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + do i1 = LB(1), UB(1) + call SD_CopyOtherState(SrcSubDyn_DataData%OtherSt(i1), DstSubDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call SD_CopyParam(SrcSubDyn_DataData%p, DstSubDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SD_CopyInput(SrcSubDyn_DataData%u, DstSubDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SD_CopyOutput(SrcSubDyn_DataData%y, DstSubDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SD_CopyMisc(SrcSubDyn_DataData%m, DstSubDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcSubDyn_DataData%Input)) then + LB(1:1) = lbound(SrcSubDyn_DataData%Input) + UB(1:1) = ubound(SrcSubDyn_DataData%Input) + if (.not. allocated(DstSubDyn_DataData%Input)) then + allocate(DstSubDyn_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SD_CopyInput(SrcSubDyn_DataData%Input(i1), DstSubDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstSubDyn_DataData%Input)) then + deallocate(DstSubDyn_DataData%Input) + end if + if (allocated(SrcSubDyn_DataData%Output)) then + LB(1:1) = lbound(SrcSubDyn_DataData%Output) + UB(1:1) = ubound(SrcSubDyn_DataData%Output) + if (.not. allocated(DstSubDyn_DataData%Output)) then + allocate(DstSubDyn_DataData%Output(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%Output.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SD_CopyOutput(SrcSubDyn_DataData%Output(i1), DstSubDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstSubDyn_DataData%Output)) then + deallocate(DstSubDyn_DataData%Output) + end if + call SD_CopyOutput(SrcSubDyn_DataData%y_interp, DstSubDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcSubDyn_DataData%InputTimes)) then + LB(1:1) = lbound(SrcSubDyn_DataData%InputTimes) + UB(1:1) = ubound(SrcSubDyn_DataData%InputTimes) + if (.not. allocated(DstSubDyn_DataData%InputTimes)) then + allocate(DstSubDyn_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSubDyn_DataData%InputTimes = SrcSubDyn_DataData%InputTimes + else if (allocated(DstSubDyn_DataData%InputTimes)) then + deallocate(DstSubDyn_DataData%InputTimes) + end if +end subroutine + +subroutine FAST_DestroySubDyn_Data(SubDyn_DataData, ErrStat, ErrMsg) + type(SubDyn_Data), intent(inout) :: SubDyn_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroySubDyn_Data' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SubDyn_DataData%Input)) then + LB(1:1) = lbound(SubDyn_DataData%Input) + UB(1:1) = ubound(SubDyn_DataData%Input) + do i1 = LB(1), UB(1) + call SD_DestroyInput(SubDyn_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SubDyn_DataData%Input) + end if + if (allocated(SubDyn_DataData%Output)) then + LB(1:1) = lbound(SubDyn_DataData%Output) + UB(1:1) = ubound(SubDyn_DataData%Output) + do i1 = LB(1), UB(1) + call SD_DestroyOutput(SubDyn_DataData%Output(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SubDyn_DataData%Output) + end if + if (allocated(SubDyn_DataData%InputTimes)) then + deallocate(SubDyn_DataData%InputTimes) + end if +end subroutine + +subroutine FAST_PackSubDyn_Data(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SubDyn_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackSubDyn_Data' integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! x LB(1:1) = lbound(InData%x) UB(1:1) = ubound(InData%x) do i1 = LB(1), UB(1) - call AD_PackContState(Buf, InData%x(i1)) + call SD_PackContState(Buf, InData%x(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! xd LB(1:1) = lbound(InData%xd) UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) - call AD_PackDiscState(Buf, InData%xd(i1)) + call SD_PackDiscState(Buf, InData%xd(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! z LB(1:1) = lbound(InData%z) UB(1:1) = ubound(InData%z) do i1 = LB(1), UB(1) - call AD_PackConstrState(Buf, InData%z(i1)) + call SD_PackConstrState(Buf, InData%z(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! OtherSt LB(1:1) = lbound(InData%OtherSt) UB(1:1) = ubound(InData%OtherSt) do i1 = LB(1), UB(1) - call AD_PackOtherState(Buf, InData%OtherSt(i1)) + call SD_PackOtherState(Buf, InData%OtherSt(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! p - call AD_PackParam(Buf, InData%p) + call SD_PackParam(Buf, InData%p) if (RegCheckErr(Buf, RoutineName)) return - ! u - call AD_PackInput(Buf, InData%u) + call SD_PackInput(Buf, InData%u) if (RegCheckErr(Buf, RoutineName)) return - ! y - call AD_PackOutput(Buf, InData%y) + call SD_PackOutput(Buf, InData%y) if (RegCheckErr(Buf, RoutineName)) return - ! m - call AD_PackMisc(Buf, InData%m) + call SD_PackMisc(Buf, InData%m) + if (RegCheckErr(Buf, RoutineName)) return + call RegPack(Buf, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call SD_PackInput(Buf, InData%Input(i1)) + end do + end if if (RegCheckErr(Buf, RoutineName)) return - ! Output call RegPack(Buf, allocated(InData%Output)) if (allocated(InData%Output)) then call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) LB(1:1) = lbound(InData%Output) UB(1:1) = ubound(InData%Output) do i1 = LB(1), UB(1) - call AD_PackOutput(Buf, InData%Output(i1)) + call SD_PackOutput(Buf, InData%Output(i1)) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! y_interp - call AD_PackOutput(Buf, InData%y_interp) - if (RegCheckErr(Buf, RoutineName)) return - ! Input - call RegPack(Buf, allocated(InData%Input)) - if (allocated(InData%Input)) then - call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) - LB(1:1) = lbound(InData%Input) - UB(1:1) = ubound(InData%Input) - do i1 = LB(1), UB(1) - call AD_PackInput(Buf, InData%Input(i1)) - end do - end if + call SD_PackOutput(Buf, InData%y_interp) if (RegCheckErr(Buf, RoutineName)) return - ! InputTimes call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) @@ -10018,82 +10253,70 @@ subroutine FAST_PackAeroDyn_Data(Buf, Indata) if (RegCheckErr(Buf, RoutineName)) return end subroutine -subroutine FAST_UnPackAeroDyn_Data(Buf, OutData) +subroutine FAST_UnPackSubDyn_Data(Buf, OutData) type(PackBuffer), intent(inout) :: Buf - type(AeroDyn_Data), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'FAST_UnPackAeroDyn_Data' + type(SubDyn_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackSubDyn_Data' integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! x LB(1:1) = lbound(OutData%x) UB(1:1) = ubound(OutData%x) do i1 = LB(1), UB(1) - call AD_UnpackContState(Buf, OutData%x(i1)) ! x + call SD_UnpackContState(Buf, OutData%x(i1)) ! x end do - ! xd LB(1:1) = lbound(OutData%xd) UB(1:1) = ubound(OutData%xd) do i1 = LB(1), UB(1) - call AD_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + call SD_UnpackDiscState(Buf, OutData%xd(i1)) ! xd end do - ! z LB(1:1) = lbound(OutData%z) UB(1:1) = ubound(OutData%z) do i1 = LB(1), UB(1) - call AD_UnpackConstrState(Buf, OutData%z(i1)) ! z + call SD_UnpackConstrState(Buf, OutData%z(i1)) ! z end do - ! OtherSt LB(1:1) = lbound(OutData%OtherSt) UB(1:1) = ubound(OutData%OtherSt) do i1 = LB(1), UB(1) - call AD_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + call SD_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt end do - ! p - call AD_UnpackParam(Buf, OutData%p) ! p - ! u - call AD_UnpackInput(Buf, OutData%u) ! u - ! y - call AD_UnpackOutput(Buf, OutData%y) ! y - ! m - call AD_UnpackMisc(Buf, OutData%m) ! m - ! Output - if (allocated(OutData%Output)) deallocate(OutData%Output) + call SD_UnpackParam(Buf, OutData%p) ! p + call SD_UnpackInput(Buf, OutData%u) ! u + call SD_UnpackOutput(Buf, OutData%y) ! y + call SD_UnpackMisc(Buf, OutData%m) ! m + if (allocated(OutData%Input)) deallocate(OutData%Input) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(Buf, 1, LB, UB) if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Output(LB(1):UB(1)),stat=stat) + allocate(OutData%Input(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AD_UnpackOutput(Buf, OutData%Output(i1)) ! Output + call SD_UnpackInput(Buf, OutData%Input(i1)) ! Input end do end if - ! y_interp - call AD_UnpackOutput(Buf, OutData%y_interp) ! y_interp - ! Input - if (allocated(OutData%Input)) deallocate(OutData%Input) + if (allocated(OutData%Output)) deallocate(OutData%Output) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return if (IsAllocAssoc) then call RegUnpackBounds(Buf, 1, LB, UB) if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Input(LB(1):UB(1)),stat=stat) + allocate(OutData%Output(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call AD_UnpackInput(Buf, OutData%Input(i1)) ! Input + call SD_UnpackOutput(Buf, OutData%Output(i1)) ! Output end do end if - ! InputTimes + call SD_UnpackOutput(Buf, OutData%y_interp) ! y_interp if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -10109,234 +10332,160 @@ subroutine FAST_UnPackAeroDyn_Data(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE FAST_CopyInflowWind_Data( SrcInflowWind_DataData, DstInflowWind_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(InflowWind_Data), INTENT(IN) :: SrcInflowWind_DataData - TYPE(InflowWind_Data), INTENT(INOUT) :: DstInflowWind_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyInflowWind_Data' -! + +subroutine FAST_CopyExtPtfm_Data(SrcExtPtfm_DataData, DstExtPtfm_DataData, CtrlCode, ErrStat, ErrMsg) + type(ExtPtfm_Data), intent(inout) :: SrcExtPtfm_DataData + type(ExtPtfm_Data), intent(inout) :: DstExtPtfm_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyExtPtfm_Data' ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcInflowWind_DataData%x,1), UBOUND(SrcInflowWind_DataData%x,1) - CALL InflowWind_CopyContState( SrcInflowWind_DataData%x(i1), DstInflowWind_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcInflowWind_DataData%xd,1), UBOUND(SrcInflowWind_DataData%xd,1) - CALL InflowWind_CopyDiscState( SrcInflowWind_DataData%xd(i1), DstInflowWind_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcInflowWind_DataData%z,1), UBOUND(SrcInflowWind_DataData%z,1) - CALL InflowWind_CopyConstrState( SrcInflowWind_DataData%z(i1), DstInflowWind_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcInflowWind_DataData%OtherSt,1), UBOUND(SrcInflowWind_DataData%OtherSt,1) - CALL InflowWind_CopyOtherState( SrcInflowWind_DataData%OtherSt(i1), DstInflowWind_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL InflowWind_CopyParam( SrcInflowWind_DataData%p, DstInflowWind_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyInput( SrcInflowWind_DataData%u, DstInflowWind_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyOutput( SrcInflowWind_DataData%y, DstInflowWind_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyMisc( SrcInflowWind_DataData%m, DstInflowWind_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInflowWind_DataData%Output)) THEN - i1_l = LBOUND(SrcInflowWind_DataData%Output,1) - i1_u = UBOUND(SrcInflowWind_DataData%Output,1) - IF (.NOT. ALLOCATED(DstInflowWind_DataData%Output)) THEN - ALLOCATE(DstInflowWind_DataData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInflowWind_DataData%Output,1), UBOUND(SrcInflowWind_DataData%Output,1) - CALL InflowWind_CopyOutput( SrcInflowWind_DataData%Output(i1), DstInflowWind_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL InflowWind_CopyOutput( SrcInflowWind_DataData%y_interp, DstInflowWind_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInflowWind_DataData%Input)) THEN - i1_l = LBOUND(SrcInflowWind_DataData%Input,1) - i1_u = UBOUND(SrcInflowWind_DataData%Input,1) - IF (.NOT. ALLOCATED(DstInflowWind_DataData%Input)) THEN - ALLOCATE(DstInflowWind_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInflowWind_DataData%Input,1), UBOUND(SrcInflowWind_DataData%Input,1) - CALL InflowWind_CopyInput( SrcInflowWind_DataData%Input(i1), DstInflowWind_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInflowWind_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcInflowWind_DataData%InputTimes,1) - i1_u = UBOUND(SrcInflowWind_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstInflowWind_DataData%InputTimes)) THEN - ALLOCATE(DstInflowWind_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInflowWind_DataData%InputTimes = SrcInflowWind_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyInflowWind_Data - - SUBROUTINE FAST_DestroyInflowWind_Data( InflowWind_DataData, ErrStat, ErrMsg ) - TYPE(InflowWind_Data), INTENT(INOUT) :: InflowWind_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyInflowWind_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(InflowWind_DataData%x,1), UBOUND(InflowWind_DataData%x,1) - CALL InflowWind_DestroyContState( InflowWind_DataData%x(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(InflowWind_DataData%xd,1), UBOUND(InflowWind_DataData%xd,1) - CALL InflowWind_DestroyDiscState( InflowWind_DataData%xd(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(InflowWind_DataData%z,1), UBOUND(InflowWind_DataData%z,1) - CALL InflowWind_DestroyConstrState( InflowWind_DataData%z(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(InflowWind_DataData%OtherSt,1), UBOUND(InflowWind_DataData%OtherSt,1) - CALL InflowWind_DestroyOtherState( InflowWind_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL InflowWind_DestroyParam( InflowWind_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyInput( InflowWind_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyOutput( InflowWind_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyMisc( InflowWind_DataData%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InflowWind_DataData%Output)) THEN -DO i1 = LBOUND(InflowWind_DataData%Output,1), UBOUND(InflowWind_DataData%Output,1) - CALL InflowWind_DestroyOutput( InflowWind_DataData%Output(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InflowWind_DataData%Output) -ENDIF - CALL InflowWind_DestroyOutput( InflowWind_DataData%y_interp, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InflowWind_DataData%Input)) THEN -DO i1 = LBOUND(InflowWind_DataData%Input,1), UBOUND(InflowWind_DataData%Input,1) - CALL InflowWind_DestroyInput( InflowWind_DataData%Input(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InflowWind_DataData%Input) -ENDIF -IF (ALLOCATED(InflowWind_DataData%InputTimes)) THEN - DEALLOCATE(InflowWind_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyInflowWind_Data + ErrMsg = '' + do i1 = LB(1), UB(1) + call ExtPtfm_CopyContState(SrcExtPtfm_DataData%x(i1), DstExtPtfm_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + do i1 = LB(1), UB(1) + call ExtPtfm_CopyDiscState(SrcExtPtfm_DataData%xd(i1), DstExtPtfm_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + do i1 = LB(1), UB(1) + call ExtPtfm_CopyConstrState(SrcExtPtfm_DataData%z(i1), DstExtPtfm_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + do i1 = LB(1), UB(1) + call ExtPtfm_CopyOtherState(SrcExtPtfm_DataData%OtherSt(i1), DstExtPtfm_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call ExtPtfm_CopyParam(SrcExtPtfm_DataData%p, DstExtPtfm_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ExtPtfm_CopyInput(SrcExtPtfm_DataData%u, DstExtPtfm_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ExtPtfm_CopyOutput(SrcExtPtfm_DataData%y, DstExtPtfm_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ExtPtfm_CopyMisc(SrcExtPtfm_DataData%m, DstExtPtfm_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcExtPtfm_DataData%Input)) then + LB(1:1) = lbound(SrcExtPtfm_DataData%Input) + UB(1:1) = ubound(SrcExtPtfm_DataData%Input) + if (.not. allocated(DstExtPtfm_DataData%Input)) then + allocate(DstExtPtfm_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstExtPtfm_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call ExtPtfm_CopyInput(SrcExtPtfm_DataData%Input(i1), DstExtPtfm_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstExtPtfm_DataData%Input)) then + deallocate(DstExtPtfm_DataData%Input) + end if + if (allocated(SrcExtPtfm_DataData%InputTimes)) then + LB(1:1) = lbound(SrcExtPtfm_DataData%InputTimes) + UB(1:1) = ubound(SrcExtPtfm_DataData%InputTimes) + if (.not. allocated(DstExtPtfm_DataData%InputTimes)) then + allocate(DstExtPtfm_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstExtPtfm_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstExtPtfm_DataData%InputTimes = SrcExtPtfm_DataData%InputTimes + else if (allocated(DstExtPtfm_DataData%InputTimes)) then + deallocate(DstExtPtfm_DataData%InputTimes) + end if +end subroutine +subroutine FAST_DestroyExtPtfm_Data(ExtPtfm_DataData, ErrStat, ErrMsg) + type(ExtPtfm_Data), intent(inout) :: ExtPtfm_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyExtPtfm_Data' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ExtPtfm_DataData%Input)) then + LB(1:1) = lbound(ExtPtfm_DataData%Input) + UB(1:1) = ubound(ExtPtfm_DataData%Input) + do i1 = LB(1), UB(1) + call ExtPtfm_DestroyInput(ExtPtfm_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ExtPtfm_DataData%Input) + end if + if (allocated(ExtPtfm_DataData%InputTimes)) then + deallocate(ExtPtfm_DataData%InputTimes) + end if +end subroutine -subroutine FAST_PackInflowWind_Data(Buf, Indata) +subroutine FAST_PackExtPtfm_Data(Buf, Indata) type(PackBuffer), intent(inout) :: Buf - type(InflowWind_Data), intent(in) :: InData - character(*), parameter :: RoutineName = 'FAST_PackInflowWind_Data' + type(ExtPtfm_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackExtPtfm_Data' integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! x LB(1:1) = lbound(InData%x) UB(1:1) = ubound(InData%x) do i1 = LB(1), UB(1) - call InflowWind_PackContState(Buf, InData%x(i1)) + call ExtPtfm_PackContState(Buf, InData%x(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! xd LB(1:1) = lbound(InData%xd) UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) - call InflowWind_PackDiscState(Buf, InData%xd(i1)) + call ExtPtfm_PackDiscState(Buf, InData%xd(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! z LB(1:1) = lbound(InData%z) UB(1:1) = ubound(InData%z) do i1 = LB(1), UB(1) - call InflowWind_PackConstrState(Buf, InData%z(i1)) + call ExtPtfm_PackConstrState(Buf, InData%z(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! OtherSt LB(1:1) = lbound(InData%OtherSt) UB(1:1) = ubound(InData%OtherSt) do i1 = LB(1), UB(1) - call InflowWind_PackOtherState(Buf, InData%OtherSt(i1)) + call ExtPtfm_PackOtherState(Buf, InData%OtherSt(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! p - call InflowWind_PackParam(Buf, InData%p) - if (RegCheckErr(Buf, RoutineName)) return - ! u - call InflowWind_PackInput(Buf, InData%u) - if (RegCheckErr(Buf, RoutineName)) return - ! y - call InflowWind_PackOutput(Buf, InData%y) + call ExtPtfm_PackParam(Buf, InData%p) if (RegCheckErr(Buf, RoutineName)) return - ! m - call InflowWind_PackMisc(Buf, InData%m) + call ExtPtfm_PackInput(Buf, InData%u) if (RegCheckErr(Buf, RoutineName)) return - ! Output - call RegPack(Buf, allocated(InData%Output)) - if (allocated(InData%Output)) then - call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) - LB(1:1) = lbound(InData%Output) - UB(1:1) = ubound(InData%Output) - do i1 = LB(1), UB(1) - call InflowWind_PackOutput(Buf, InData%Output(i1)) - end do - end if + call ExtPtfm_PackOutput(Buf, InData%y) if (RegCheckErr(Buf, RoutineName)) return - ! y_interp - call InflowWind_PackOutput(Buf, InData%y_interp) + call ExtPtfm_PackMisc(Buf, InData%m) if (RegCheckErr(Buf, RoutineName)) return - ! Input call RegPack(Buf, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) LB(1:1) = lbound(InData%Input) UB(1:1) = ubound(InData%Input) do i1 = LB(1), UB(1) - call InflowWind_PackInput(Buf, InData%Input(i1)) + call ExtPtfm_PackInput(Buf, InData%Input(i1)) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! InputTimes call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) @@ -10345,66 +10494,39 @@ subroutine FAST_PackInflowWind_Data(Buf, Indata) if (RegCheckErr(Buf, RoutineName)) return end subroutine -subroutine FAST_UnPackInflowWind_Data(Buf, OutData) +subroutine FAST_UnPackExtPtfm_Data(Buf, OutData) type(PackBuffer), intent(inout) :: Buf - type(InflowWind_Data), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'FAST_UnPackInflowWind_Data' + type(ExtPtfm_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackExtPtfm_Data' integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! x LB(1:1) = lbound(OutData%x) UB(1:1) = ubound(OutData%x) do i1 = LB(1), UB(1) - call InflowWind_UnpackContState(Buf, OutData%x(i1)) ! x + call ExtPtfm_UnpackContState(Buf, OutData%x(i1)) ! x end do - ! xd LB(1:1) = lbound(OutData%xd) UB(1:1) = ubound(OutData%xd) do i1 = LB(1), UB(1) - call InflowWind_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + call ExtPtfm_UnpackDiscState(Buf, OutData%xd(i1)) ! xd end do - ! z LB(1:1) = lbound(OutData%z) UB(1:1) = ubound(OutData%z) do i1 = LB(1), UB(1) - call InflowWind_UnpackConstrState(Buf, OutData%z(i1)) ! z + call ExtPtfm_UnpackConstrState(Buf, OutData%z(i1)) ! z end do - ! OtherSt LB(1:1) = lbound(OutData%OtherSt) UB(1:1) = ubound(OutData%OtherSt) do i1 = LB(1), UB(1) - call InflowWind_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + call ExtPtfm_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt end do - ! p - call InflowWind_UnpackParam(Buf, OutData%p) ! p - ! u - call InflowWind_UnpackInput(Buf, OutData%u) ! u - ! y - call InflowWind_UnpackOutput(Buf, OutData%y) ! y - ! m - call InflowWind_UnpackMisc(Buf, OutData%m) ! m - ! Output - if (allocated(OutData%Output)) deallocate(OutData%Output) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Output(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call InflowWind_UnpackOutput(Buf, OutData%Output(i1)) ! Output - end do - end if - ! y_interp - call InflowWind_UnpackOutput(Buf, OutData%y_interp) ! y_interp - ! Input + call ExtPtfm_UnpackParam(Buf, OutData%p) ! p + call ExtPtfm_UnpackInput(Buf, OutData%u) ! u + call ExtPtfm_UnpackOutput(Buf, OutData%y) ! y + call ExtPtfm_UnpackMisc(Buf, OutData%m) ! m if (allocated(OutData%Input)) deallocate(OutData%Input) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -10417,10 +10539,9 @@ subroutine FAST_UnPackInflowWind_Data(Buf, OutData) return end if do i1 = LB(1), UB(1) - call InflowWind_UnpackInput(Buf, OutData%Input(i1)) ! Input + call ExtPtfm_UnpackInput(Buf, OutData%Input(i1)) ! Input end do end if - ! InputTimes if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -10436,394 +10557,202 @@ subroutine FAST_UnPackInflowWind_Data(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE FAST_CopyOpenFOAM_Data( SrcOpenFOAM_DataData, DstOpenFOAM_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(OpenFOAM_Data), INTENT(INOUT) :: SrcOpenFOAM_DataData - TYPE(OpenFOAM_Data), INTENT(INOUT) :: DstOpenFOAM_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyOpenFOAM_Data' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL OpFM_CopyInput( SrcOpenFOAM_DataData%u, DstOpenFOAM_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL OpFM_CopyOutput( SrcOpenFOAM_DataData%y, DstOpenFOAM_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL OpFM_CopyParam( SrcOpenFOAM_DataData%p, DstOpenFOAM_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL OpFM_CopyMisc( SrcOpenFOAM_DataData%m, DstOpenFOAM_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE FAST_CopyOpenFOAM_Data - - SUBROUTINE FAST_DestroyOpenFOAM_Data( OpenFOAM_DataData, ErrStat, ErrMsg ) - TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpenFOAM_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyOpenFOAM_Data' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL OpFM_DestroyInput( OpenFOAM_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL OpFM_DestroyOutput( OpenFOAM_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL OpFM_DestroyParam( OpenFOAM_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL OpFM_DestroyMisc( OpenFOAM_DataData%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE FAST_DestroyOpenFOAM_Data - - -subroutine FAST_PackOpenFOAM_Data(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf - type(OpenFOAM_Data), intent(in) :: InData - character(*), parameter :: RoutineName = 'FAST_PackOpenFOAM_Data' - if (Buf%ErrStat >= AbortErrLev) return - ! u - call OpFM_PackInput(Buf, InData%u) - if (RegCheckErr(Buf, RoutineName)) return - ! y - call OpFM_PackOutput(Buf, InData%y) - if (RegCheckErr(Buf, RoutineName)) return - ! p - call OpFM_PackParam(Buf, InData%p) - if (RegCheckErr(Buf, RoutineName)) return - ! m - call OpFM_PackMisc(Buf, InData%m) - if (RegCheckErr(Buf, RoutineName)) return -end subroutine -subroutine FAST_UnPackOpenFOAM_Data(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf - type(OpenFOAM_Data), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'FAST_UnPackOpenFOAM_Data' - if (Buf%ErrStat /= ErrID_None) return - ! u - call OpFM_UnpackInput(Buf, OutData%u) ! u - ! y - call OpFM_UnpackOutput(Buf, OutData%y) ! y - ! p - call OpFM_UnpackParam(Buf, OutData%p) ! p - ! m - call OpFM_UnpackMisc(Buf, OutData%m) ! m -end subroutine - SUBROUTINE FAST_CopySCDataEx_Data( SrcSCDataEx_DataData, DstSCDataEx_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SCDataEx_Data), INTENT(IN) :: SrcSCDataEx_DataData - TYPE(SCDataEx_Data), INTENT(INOUT) :: DstSCDataEx_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopySCDataEx_Data' -! +subroutine FAST_CopySeaState_Data(SrcSeaState_DataData, DstSeaState_DataData, CtrlCode, ErrStat, ErrMsg) + type(SeaState_Data), intent(in) :: SrcSeaState_DataData + type(SeaState_Data), intent(inout) :: DstSeaState_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopySeaState_Data' ErrStat = ErrID_None - ErrMsg = "" - CALL SC_DX_CopyInput( SrcSCDataEx_DataData%u, DstSCDataEx_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SC_DX_CopyOutput( SrcSCDataEx_DataData%y, DstSCDataEx_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SC_DX_CopyParam( SrcSCDataEx_DataData%p, DstSCDataEx_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE FAST_CopySCDataEx_Data - - SUBROUTINE FAST_DestroySCDataEx_Data( SCDataEx_DataData, ErrStat, ErrMsg ) - TYPE(SCDataEx_Data), INTENT(INOUT) :: SCDataEx_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroySCDataEx_Data' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL SC_DX_DestroyInput( SCDataEx_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SC_DX_DestroyOutput( SCDataEx_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SC_DX_DestroyParam( SCDataEx_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE FAST_DestroySCDataEx_Data - - -subroutine FAST_PackSCDataEx_Data(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf - type(SCDataEx_Data), intent(in) :: InData - character(*), parameter :: RoutineName = 'FAST_PackSCDataEx_Data' - if (Buf%ErrStat >= AbortErrLev) return - ! u - call SC_DX_PackInput(Buf, InData%u) - if (RegCheckErr(Buf, RoutineName)) return - ! y - call SC_DX_PackOutput(Buf, InData%y) - if (RegCheckErr(Buf, RoutineName)) return - ! p - call SC_DX_PackParam(Buf, InData%p) - if (RegCheckErr(Buf, RoutineName)) return + ErrMsg = '' + do i1 = LB(1), UB(1) + call SeaSt_CopyContState(SrcSeaState_DataData%x(i1), DstSeaState_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + do i1 = LB(1), UB(1) + call SeaSt_CopyDiscState(SrcSeaState_DataData%xd(i1), DstSeaState_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + do i1 = LB(1), UB(1) + call SeaSt_CopyConstrState(SrcSeaState_DataData%z(i1), DstSeaState_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + do i1 = LB(1), UB(1) + call SeaSt_CopyOtherState(SrcSeaState_DataData%OtherSt(i1), DstSeaState_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call SeaSt_CopyParam(SrcSeaState_DataData%p, DstSeaState_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyInput(SrcSeaState_DataData%u, DstSeaState_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyOutput(SrcSeaState_DataData%y, DstSeaState_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyMisc(SrcSeaState_DataData%m, DstSeaState_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcSeaState_DataData%Input)) then + LB(1:1) = lbound(SrcSeaState_DataData%Input) + UB(1:1) = ubound(SrcSeaState_DataData%Input) + if (.not. allocated(DstSeaState_DataData%Input)) then + allocate(DstSeaState_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaState_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SeaSt_CopyInput(SrcSeaState_DataData%Input(i1), DstSeaState_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstSeaState_DataData%Input)) then + deallocate(DstSeaState_DataData%Input) + end if + if (allocated(SrcSeaState_DataData%Output)) then + LB(1:1) = lbound(SrcSeaState_DataData%Output) + UB(1:1) = ubound(SrcSeaState_DataData%Output) + if (.not. allocated(DstSeaState_DataData%Output)) then + allocate(DstSeaState_DataData%Output(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaState_DataData%Output.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SeaSt_CopyOutput(SrcSeaState_DataData%Output(i1), DstSeaState_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstSeaState_DataData%Output)) then + deallocate(DstSeaState_DataData%Output) + end if + call SeaSt_CopyOutput(SrcSeaState_DataData%y_interp, DstSeaState_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcSeaState_DataData%InputTimes)) then + LB(1:1) = lbound(SrcSeaState_DataData%InputTimes) + UB(1:1) = ubound(SrcSeaState_DataData%InputTimes) + if (.not. allocated(DstSeaState_DataData%InputTimes)) then + allocate(DstSeaState_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaState_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaState_DataData%InputTimes = SrcSeaState_DataData%InputTimes + else if (allocated(DstSeaState_DataData%InputTimes)) then + deallocate(DstSeaState_DataData%InputTimes) + end if end subroutine -subroutine FAST_UnPackSCDataEx_Data(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf - type(SCDataEx_Data), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'FAST_UnPackSCDataEx_Data' - if (Buf%ErrStat /= ErrID_None) return - ! u - call SC_DX_UnpackInput(Buf, OutData%u) ! u - ! y - call SC_DX_UnpackOutput(Buf, OutData%y) ! y - ! p - call SC_DX_UnpackParam(Buf, OutData%p) ! p -end subroutine - SUBROUTINE FAST_CopySubDyn_Data( SrcSubDyn_DataData, DstSubDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SubDyn_Data), INTENT(INOUT) :: SrcSubDyn_DataData - TYPE(SubDyn_Data), INTENT(INOUT) :: DstSubDyn_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopySubDyn_Data' -! +subroutine FAST_DestroySeaState_Data(SeaState_DataData, ErrStat, ErrMsg) + type(SeaState_Data), intent(inout) :: SeaState_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroySeaState_Data' ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcSubDyn_DataData%x,1), UBOUND(SrcSubDyn_DataData%x,1) - CALL SD_CopyContState( SrcSubDyn_DataData%x(i1), DstSubDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcSubDyn_DataData%xd,1), UBOUND(SrcSubDyn_DataData%xd,1) - CALL SD_CopyDiscState( SrcSubDyn_DataData%xd(i1), DstSubDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcSubDyn_DataData%z,1), UBOUND(SrcSubDyn_DataData%z,1) - CALL SD_CopyConstrState( SrcSubDyn_DataData%z(i1), DstSubDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcSubDyn_DataData%OtherSt,1), UBOUND(SrcSubDyn_DataData%OtherSt,1) - CALL SD_CopyOtherState( SrcSubDyn_DataData%OtherSt(i1), DstSubDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL SD_CopyParam( SrcSubDyn_DataData%p, DstSubDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SD_CopyInput( SrcSubDyn_DataData%u, DstSubDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SD_CopyOutput( SrcSubDyn_DataData%y, DstSubDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SD_CopyMisc( SrcSubDyn_DataData%m, DstSubDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcSubDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcSubDyn_DataData%Input,1) - i1_u = UBOUND(SrcSubDyn_DataData%Input,1) - IF (.NOT. ALLOCATED(DstSubDyn_DataData%Input)) THEN - ALLOCATE(DstSubDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcSubDyn_DataData%Input,1), UBOUND(SrcSubDyn_DataData%Input,1) - CALL SD_CopyInput( SrcSubDyn_DataData%Input(i1), DstSubDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcSubDyn_DataData%Output)) THEN - i1_l = LBOUND(SrcSubDyn_DataData%Output,1) - i1_u = UBOUND(SrcSubDyn_DataData%Output,1) - IF (.NOT. ALLOCATED(DstSubDyn_DataData%Output)) THEN - ALLOCATE(DstSubDyn_DataData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcSubDyn_DataData%Output,1), UBOUND(SrcSubDyn_DataData%Output,1) - CALL SD_CopyOutput( SrcSubDyn_DataData%Output(i1), DstSubDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL SD_CopyOutput( SrcSubDyn_DataData%y_interp, DstSubDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcSubDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcSubDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcSubDyn_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstSubDyn_DataData%InputTimes)) THEN - ALLOCATE(DstSubDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstSubDyn_DataData%InputTimes = SrcSubDyn_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopySubDyn_Data - - SUBROUTINE FAST_DestroySubDyn_Data( SubDyn_DataData, ErrStat, ErrMsg ) - TYPE(SubDyn_Data), INTENT(INOUT) :: SubDyn_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroySubDyn_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(SubDyn_DataData%x,1), UBOUND(SubDyn_DataData%x,1) - CALL SD_DestroyContState( SubDyn_DataData%x(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(SubDyn_DataData%xd,1), UBOUND(SubDyn_DataData%xd,1) - CALL SD_DestroyDiscState( SubDyn_DataData%xd(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(SubDyn_DataData%z,1), UBOUND(SubDyn_DataData%z,1) - CALL SD_DestroyConstrState( SubDyn_DataData%z(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(SubDyn_DataData%OtherSt,1), UBOUND(SubDyn_DataData%OtherSt,1) - CALL SD_DestroyOtherState( SubDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL SD_DestroyParam( SubDyn_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SD_DestroyInput( SubDyn_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SD_DestroyOutput( SubDyn_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SD_DestroyMisc( SubDyn_DataData%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(SubDyn_DataData%Input)) THEN -DO i1 = LBOUND(SubDyn_DataData%Input,1), UBOUND(SubDyn_DataData%Input,1) - CALL SD_DestroyInput( SubDyn_DataData%Input(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(SubDyn_DataData%Input) -ENDIF -IF (ALLOCATED(SubDyn_DataData%Output)) THEN -DO i1 = LBOUND(SubDyn_DataData%Output,1), UBOUND(SubDyn_DataData%Output,1) - CALL SD_DestroyOutput( SubDyn_DataData%Output(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(SubDyn_DataData%Output) -ENDIF - CALL SD_DestroyOutput( SubDyn_DataData%y_interp, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(SubDyn_DataData%InputTimes)) THEN - DEALLOCATE(SubDyn_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroySubDyn_Data - + ErrMsg = '' + if (allocated(SeaState_DataData%Input)) then + LB(1:1) = lbound(SeaState_DataData%Input) + UB(1:1) = ubound(SeaState_DataData%Input) + do i1 = LB(1), UB(1) + call SeaSt_DestroyInput(SeaState_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SeaState_DataData%Input) + end if + if (allocated(SeaState_DataData%Output)) then + LB(1:1) = lbound(SeaState_DataData%Output) + UB(1:1) = ubound(SeaState_DataData%Output) + do i1 = LB(1), UB(1) + call SeaSt_DestroyOutput(SeaState_DataData%Output(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SeaState_DataData%Output) + end if + if (allocated(SeaState_DataData%InputTimes)) then + deallocate(SeaState_DataData%InputTimes) + end if +end subroutine -subroutine FAST_PackSubDyn_Data(Buf, Indata) +subroutine FAST_PackSeaState_Data(Buf, Indata) type(PackBuffer), intent(inout) :: Buf - type(SubDyn_Data), intent(in) :: InData - character(*), parameter :: RoutineName = 'FAST_PackSubDyn_Data' + type(SeaState_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackSeaState_Data' integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! x LB(1:1) = lbound(InData%x) UB(1:1) = ubound(InData%x) do i1 = LB(1), UB(1) - call SD_PackContState(Buf, InData%x(i1)) + call SeaSt_PackContState(Buf, InData%x(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! xd LB(1:1) = lbound(InData%xd) UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) - call SD_PackDiscState(Buf, InData%xd(i1)) + call SeaSt_PackDiscState(Buf, InData%xd(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! z LB(1:1) = lbound(InData%z) UB(1:1) = ubound(InData%z) do i1 = LB(1), UB(1) - call SD_PackConstrState(Buf, InData%z(i1)) + call SeaSt_PackConstrState(Buf, InData%z(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! OtherSt LB(1:1) = lbound(InData%OtherSt) UB(1:1) = ubound(InData%OtherSt) do i1 = LB(1), UB(1) - call SD_PackOtherState(Buf, InData%OtherSt(i1)) + call SeaSt_PackOtherState(Buf, InData%OtherSt(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! p - call SD_PackParam(Buf, InData%p) + call SeaSt_PackParam(Buf, InData%p) if (RegCheckErr(Buf, RoutineName)) return - ! u - call SD_PackInput(Buf, InData%u) + call SeaSt_PackInput(Buf, InData%u) if (RegCheckErr(Buf, RoutineName)) return - ! y - call SD_PackOutput(Buf, InData%y) + call SeaSt_PackOutput(Buf, InData%y) if (RegCheckErr(Buf, RoutineName)) return - ! m - call SD_PackMisc(Buf, InData%m) + call SeaSt_PackMisc(Buf, InData%m) if (RegCheckErr(Buf, RoutineName)) return - ! Input call RegPack(Buf, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) LB(1:1) = lbound(InData%Input) UB(1:1) = ubound(InData%Input) do i1 = LB(1), UB(1) - call SD_PackInput(Buf, InData%Input(i1)) + call SeaSt_PackInput(Buf, InData%Input(i1)) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! Output call RegPack(Buf, allocated(InData%Output)) if (allocated(InData%Output)) then call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) LB(1:1) = lbound(InData%Output) UB(1:1) = ubound(InData%Output) do i1 = LB(1), UB(1) - call SD_PackOutput(Buf, InData%Output(i1)) + call SeaSt_PackOutput(Buf, InData%Output(i1)) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! y_interp - call SD_PackOutput(Buf, InData%y_interp) + call SeaSt_PackOutput(Buf, InData%y_interp) if (RegCheckErr(Buf, RoutineName)) return - ! InputTimes call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) @@ -10832,48 +10761,39 @@ subroutine FAST_PackSubDyn_Data(Buf, Indata) if (RegCheckErr(Buf, RoutineName)) return end subroutine -subroutine FAST_UnPackSubDyn_Data(Buf, OutData) +subroutine FAST_UnPackSeaState_Data(Buf, OutData) type(PackBuffer), intent(inout) :: Buf - type(SubDyn_Data), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'FAST_UnPackSubDyn_Data' + type(SeaState_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackSeaState_Data' integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! x LB(1:1) = lbound(OutData%x) UB(1:1) = ubound(OutData%x) do i1 = LB(1), UB(1) - call SD_UnpackContState(Buf, OutData%x(i1)) ! x + call SeaSt_UnpackContState(Buf, OutData%x(i1)) ! x end do - ! xd LB(1:1) = lbound(OutData%xd) UB(1:1) = ubound(OutData%xd) do i1 = LB(1), UB(1) - call SD_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + call SeaSt_UnpackDiscState(Buf, OutData%xd(i1)) ! xd end do - ! z LB(1:1) = lbound(OutData%z) UB(1:1) = ubound(OutData%z) do i1 = LB(1), UB(1) - call SD_UnpackConstrState(Buf, OutData%z(i1)) ! z + call SeaSt_UnpackConstrState(Buf, OutData%z(i1)) ! z end do - ! OtherSt LB(1:1) = lbound(OutData%OtherSt) UB(1:1) = ubound(OutData%OtherSt) do i1 = LB(1), UB(1) - call SD_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + call SeaSt_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt end do - ! p - call SD_UnpackParam(Buf, OutData%p) ! p - ! u - call SD_UnpackInput(Buf, OutData%u) ! u - ! y - call SD_UnpackOutput(Buf, OutData%y) ! y - ! m - call SD_UnpackMisc(Buf, OutData%m) ! m - ! Input + call SeaSt_UnpackParam(Buf, OutData%p) ! p + call SeaSt_UnpackInput(Buf, OutData%u) ! u + call SeaSt_UnpackOutput(Buf, OutData%y) ! y + call SeaSt_UnpackMisc(Buf, OutData%m) ! m if (allocated(OutData%Input)) deallocate(OutData%Input) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -10886,10 +10806,9 @@ subroutine FAST_UnPackSubDyn_Data(Buf, OutData) return end if do i1 = LB(1), UB(1) - call SD_UnpackInput(Buf, OutData%Input(i1)) ! Input + call SeaSt_UnpackInput(Buf, OutData%Input(i1)) ! Input end do end if - ! Output if (allocated(OutData%Output)) deallocate(OutData%Output) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -10902,12 +10821,10 @@ subroutine FAST_UnPackSubDyn_Data(Buf, OutData) return end if do i1 = LB(1), UB(1) - call SD_UnpackOutput(Buf, OutData%Output(i1)) ! Output + call SeaSt_UnpackOutput(Buf, OutData%Output(i1)) ! Output end do end if - ! y_interp - call SD_UnpackOutput(Buf, OutData%y_interp) ! y_interp - ! InputTimes + call SeaSt_UnpackOutput(Buf, OutData%y_interp) ! y_interp if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -10923,192 +10840,202 @@ subroutine FAST_UnPackSubDyn_Data(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE FAST_CopyExtPtfm_Data( SrcExtPtfm_DataData, DstExtPtfm_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtPtfm_Data), INTENT(INOUT) :: SrcExtPtfm_DataData - TYPE(ExtPtfm_Data), INTENT(INOUT) :: DstExtPtfm_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyExtPtfm_Data' -! + +subroutine FAST_CopyHydroDyn_Data(SrcHydroDyn_DataData, DstHydroDyn_DataData, CtrlCode, ErrStat, ErrMsg) + type(HydroDyn_Data), intent(inout) :: SrcHydroDyn_DataData + type(HydroDyn_Data), intent(inout) :: DstHydroDyn_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyHydroDyn_Data' ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcExtPtfm_DataData%x,1), UBOUND(SrcExtPtfm_DataData%x,1) - CALL ExtPtfm_CopyContState( SrcExtPtfm_DataData%x(i1), DstExtPtfm_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcExtPtfm_DataData%xd,1), UBOUND(SrcExtPtfm_DataData%xd,1) - CALL ExtPtfm_CopyDiscState( SrcExtPtfm_DataData%xd(i1), DstExtPtfm_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcExtPtfm_DataData%z,1), UBOUND(SrcExtPtfm_DataData%z,1) - CALL ExtPtfm_CopyConstrState( SrcExtPtfm_DataData%z(i1), DstExtPtfm_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcExtPtfm_DataData%OtherSt,1), UBOUND(SrcExtPtfm_DataData%OtherSt,1) - CALL ExtPtfm_CopyOtherState( SrcExtPtfm_DataData%OtherSt(i1), DstExtPtfm_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL ExtPtfm_CopyParam( SrcExtPtfm_DataData%p, DstExtPtfm_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ExtPtfm_CopyInput( SrcExtPtfm_DataData%u, DstExtPtfm_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ExtPtfm_CopyOutput( SrcExtPtfm_DataData%y, DstExtPtfm_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ExtPtfm_CopyMisc( SrcExtPtfm_DataData%m, DstExtPtfm_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcExtPtfm_DataData%Input)) THEN - i1_l = LBOUND(SrcExtPtfm_DataData%Input,1) - i1_u = UBOUND(SrcExtPtfm_DataData%Input,1) - IF (.NOT. ALLOCATED(DstExtPtfm_DataData%Input)) THEN - ALLOCATE(DstExtPtfm_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstExtPtfm_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcExtPtfm_DataData%Input,1), UBOUND(SrcExtPtfm_DataData%Input,1) - CALL ExtPtfm_CopyInput( SrcExtPtfm_DataData%Input(i1), DstExtPtfm_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcExtPtfm_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcExtPtfm_DataData%InputTimes,1) - i1_u = UBOUND(SrcExtPtfm_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstExtPtfm_DataData%InputTimes)) THEN - ALLOCATE(DstExtPtfm_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstExtPtfm_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstExtPtfm_DataData%InputTimes = SrcExtPtfm_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyExtPtfm_Data - - SUBROUTINE FAST_DestroyExtPtfm_Data( ExtPtfm_DataData, ErrStat, ErrMsg ) - TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyExtPtfm_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(ExtPtfm_DataData%x,1), UBOUND(ExtPtfm_DataData%x,1) - CALL ExtPtfm_DestroyContState( ExtPtfm_DataData%x(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(ExtPtfm_DataData%xd,1), UBOUND(ExtPtfm_DataData%xd,1) - CALL ExtPtfm_DestroyDiscState( ExtPtfm_DataData%xd(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(ExtPtfm_DataData%z,1), UBOUND(ExtPtfm_DataData%z,1) - CALL ExtPtfm_DestroyConstrState( ExtPtfm_DataData%z(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(ExtPtfm_DataData%OtherSt,1), UBOUND(ExtPtfm_DataData%OtherSt,1) - CALL ExtPtfm_DestroyOtherState( ExtPtfm_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL ExtPtfm_DestroyParam( ExtPtfm_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ExtPtfm_DestroyInput( ExtPtfm_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ExtPtfm_DestroyOutput( ExtPtfm_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ExtPtfm_DestroyMisc( ExtPtfm_DataData%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ExtPtfm_DataData%Input)) THEN -DO i1 = LBOUND(ExtPtfm_DataData%Input,1), UBOUND(ExtPtfm_DataData%Input,1) - CALL ExtPtfm_DestroyInput( ExtPtfm_DataData%Input(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ExtPtfm_DataData%Input) -ENDIF -IF (ALLOCATED(ExtPtfm_DataData%InputTimes)) THEN - DEALLOCATE(ExtPtfm_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyExtPtfm_Data + ErrMsg = '' + do i1 = LB(1), UB(1) + call HydroDyn_CopyContState(SrcHydroDyn_DataData%x(i1), DstHydroDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + do i1 = LB(1), UB(1) + call HydroDyn_CopyDiscState(SrcHydroDyn_DataData%xd(i1), DstHydroDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + do i1 = LB(1), UB(1) + call HydroDyn_CopyConstrState(SrcHydroDyn_DataData%z(i1), DstHydroDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + do i1 = LB(1), UB(1) + call HydroDyn_CopyOtherState(SrcHydroDyn_DataData%OtherSt(i1), DstHydroDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call HydroDyn_CopyParam(SrcHydroDyn_DataData%p, DstHydroDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call HydroDyn_CopyInput(SrcHydroDyn_DataData%u, DstHydroDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call HydroDyn_CopyOutput(SrcHydroDyn_DataData%y, DstHydroDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call HydroDyn_CopyMisc(SrcHydroDyn_DataData%m, DstHydroDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcHydroDyn_DataData%Output)) then + LB(1:1) = lbound(SrcHydroDyn_DataData%Output) + UB(1:1) = ubound(SrcHydroDyn_DataData%Output) + if (.not. allocated(DstHydroDyn_DataData%Output)) then + allocate(DstHydroDyn_DataData%Output(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%Output.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call HydroDyn_CopyOutput(SrcHydroDyn_DataData%Output(i1), DstHydroDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstHydroDyn_DataData%Output)) then + deallocate(DstHydroDyn_DataData%Output) + end if + call HydroDyn_CopyOutput(SrcHydroDyn_DataData%y_interp, DstHydroDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcHydroDyn_DataData%Input)) then + LB(1:1) = lbound(SrcHydroDyn_DataData%Input) + UB(1:1) = ubound(SrcHydroDyn_DataData%Input) + if (.not. allocated(DstHydroDyn_DataData%Input)) then + allocate(DstHydroDyn_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call HydroDyn_CopyInput(SrcHydroDyn_DataData%Input(i1), DstHydroDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstHydroDyn_DataData%Input)) then + deallocate(DstHydroDyn_DataData%Input) + end if + if (allocated(SrcHydroDyn_DataData%InputTimes)) then + LB(1:1) = lbound(SrcHydroDyn_DataData%InputTimes) + UB(1:1) = ubound(SrcHydroDyn_DataData%InputTimes) + if (.not. allocated(DstHydroDyn_DataData%InputTimes)) then + allocate(DstHydroDyn_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstHydroDyn_DataData%InputTimes = SrcHydroDyn_DataData%InputTimes + else if (allocated(DstHydroDyn_DataData%InputTimes)) then + deallocate(DstHydroDyn_DataData%InputTimes) + end if +end subroutine +subroutine FAST_DestroyHydroDyn_Data(HydroDyn_DataData, ErrStat, ErrMsg) + type(HydroDyn_Data), intent(inout) :: HydroDyn_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyHydroDyn_Data' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(HydroDyn_DataData%Output)) then + LB(1:1) = lbound(HydroDyn_DataData%Output) + UB(1:1) = ubound(HydroDyn_DataData%Output) + do i1 = LB(1), UB(1) + call HydroDyn_DestroyOutput(HydroDyn_DataData%Output(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(HydroDyn_DataData%Output) + end if + if (allocated(HydroDyn_DataData%Input)) then + LB(1:1) = lbound(HydroDyn_DataData%Input) + UB(1:1) = ubound(HydroDyn_DataData%Input) + do i1 = LB(1), UB(1) + call HydroDyn_DestroyInput(HydroDyn_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(HydroDyn_DataData%Input) + end if + if (allocated(HydroDyn_DataData%InputTimes)) then + deallocate(HydroDyn_DataData%InputTimes) + end if +end subroutine -subroutine FAST_PackExtPtfm_Data(Buf, Indata) +subroutine FAST_PackHydroDyn_Data(Buf, Indata) type(PackBuffer), intent(inout) :: Buf - type(ExtPtfm_Data), intent(in) :: InData - character(*), parameter :: RoutineName = 'FAST_PackExtPtfm_Data' + type(HydroDyn_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackHydroDyn_Data' integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! x LB(1:1) = lbound(InData%x) UB(1:1) = ubound(InData%x) do i1 = LB(1), UB(1) - call ExtPtfm_PackContState(Buf, InData%x(i1)) + call HydroDyn_PackContState(Buf, InData%x(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! xd LB(1:1) = lbound(InData%xd) UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) - call ExtPtfm_PackDiscState(Buf, InData%xd(i1)) + call HydroDyn_PackDiscState(Buf, InData%xd(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! z LB(1:1) = lbound(InData%z) UB(1:1) = ubound(InData%z) do i1 = LB(1), UB(1) - call ExtPtfm_PackConstrState(Buf, InData%z(i1)) + call HydroDyn_PackConstrState(Buf, InData%z(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! OtherSt LB(1:1) = lbound(InData%OtherSt) UB(1:1) = ubound(InData%OtherSt) do i1 = LB(1), UB(1) - call ExtPtfm_PackOtherState(Buf, InData%OtherSt(i1)) + call HydroDyn_PackOtherState(Buf, InData%OtherSt(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! p - call ExtPtfm_PackParam(Buf, InData%p) + call HydroDyn_PackParam(Buf, InData%p) + if (RegCheckErr(Buf, RoutineName)) return + call HydroDyn_PackInput(Buf, InData%u) if (RegCheckErr(Buf, RoutineName)) return - ! u - call ExtPtfm_PackInput(Buf, InData%u) + call HydroDyn_PackOutput(Buf, InData%y) if (RegCheckErr(Buf, RoutineName)) return - ! y - call ExtPtfm_PackOutput(Buf, InData%y) + call HydroDyn_PackMisc(Buf, InData%m) if (RegCheckErr(Buf, RoutineName)) return - ! m - call ExtPtfm_PackMisc(Buf, InData%m) + call RegPack(Buf, allocated(InData%Output)) + if (allocated(InData%Output)) then + call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) + LB(1:1) = lbound(InData%Output) + UB(1:1) = ubound(InData%Output) + do i1 = LB(1), UB(1) + call HydroDyn_PackOutput(Buf, InData%Output(i1)) + end do + end if + if (RegCheckErr(Buf, RoutineName)) return + call HydroDyn_PackOutput(Buf, InData%y_interp) if (RegCheckErr(Buf, RoutineName)) return - ! Input call RegPack(Buf, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) LB(1:1) = lbound(InData%Input) UB(1:1) = ubound(InData%Input) do i1 = LB(1), UB(1) - call ExtPtfm_PackInput(Buf, InData%Input(i1)) + call HydroDyn_PackInput(Buf, InData%Input(i1)) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! InputTimes call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) @@ -11117,48 +11044,55 @@ subroutine FAST_PackExtPtfm_Data(Buf, Indata) if (RegCheckErr(Buf, RoutineName)) return end subroutine -subroutine FAST_UnPackExtPtfm_Data(Buf, OutData) +subroutine FAST_UnPackHydroDyn_Data(Buf, OutData) type(PackBuffer), intent(inout) :: Buf - type(ExtPtfm_Data), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'FAST_UnPackExtPtfm_Data' + type(HydroDyn_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackHydroDyn_Data' integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! x LB(1:1) = lbound(OutData%x) UB(1:1) = ubound(OutData%x) do i1 = LB(1), UB(1) - call ExtPtfm_UnpackContState(Buf, OutData%x(i1)) ! x + call HydroDyn_UnpackContState(Buf, OutData%x(i1)) ! x end do - ! xd LB(1:1) = lbound(OutData%xd) UB(1:1) = ubound(OutData%xd) do i1 = LB(1), UB(1) - call ExtPtfm_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + call HydroDyn_UnpackDiscState(Buf, OutData%xd(i1)) ! xd end do - ! z LB(1:1) = lbound(OutData%z) UB(1:1) = ubound(OutData%z) do i1 = LB(1), UB(1) - call ExtPtfm_UnpackConstrState(Buf, OutData%z(i1)) ! z + call HydroDyn_UnpackConstrState(Buf, OutData%z(i1)) ! z end do - ! OtherSt LB(1:1) = lbound(OutData%OtherSt) UB(1:1) = ubound(OutData%OtherSt) do i1 = LB(1), UB(1) - call ExtPtfm_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + call HydroDyn_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt end do - ! p - call ExtPtfm_UnpackParam(Buf, OutData%p) ! p - ! u - call ExtPtfm_UnpackInput(Buf, OutData%u) ! u - ! y - call ExtPtfm_UnpackOutput(Buf, OutData%y) ! y - ! m - call ExtPtfm_UnpackMisc(Buf, OutData%m) ! m - ! Input + call HydroDyn_UnpackParam(Buf, OutData%p) ! p + call HydroDyn_UnpackInput(Buf, OutData%u) ! u + call HydroDyn_UnpackOutput(Buf, OutData%y) ! y + call HydroDyn_UnpackMisc(Buf, OutData%m) ! m + if (allocated(OutData%Output)) deallocate(OutData%Output) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 1, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%Output(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call HydroDyn_UnpackOutput(Buf, OutData%Output(i1)) ! Output + end do + end if + call HydroDyn_UnpackOutput(Buf, OutData%y_interp) ! y_interp if (allocated(OutData%Input)) deallocate(OutData%Input) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -11171,10 +11105,9 @@ subroutine FAST_UnPackExtPtfm_Data(Buf, OutData) return end if do i1 = LB(1), UB(1) - call ExtPtfm_UnpackInput(Buf, OutData%Input(i1)) ! Input + call HydroDyn_UnpackInput(Buf, OutData%Input(i1)) ! Input end do end if - ! InputTimes if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -11190,234 +11123,160 @@ subroutine FAST_UnPackExtPtfm_Data(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE FAST_CopySeaState_Data( SrcSeaState_DataData, DstSeaState_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SeaState_Data), INTENT(IN) :: SrcSeaState_DataData - TYPE(SeaState_Data), INTENT(INOUT) :: DstSeaState_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopySeaState_Data' -! + +subroutine FAST_CopyIceFloe_Data(SrcIceFloe_DataData, DstIceFloe_DataData, CtrlCode, ErrStat, ErrMsg) + type(IceFloe_Data), intent(inout) :: SrcIceFloe_DataData + type(IceFloe_Data), intent(inout) :: DstIceFloe_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyIceFloe_Data' ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcSeaState_DataData%x,1), UBOUND(SrcSeaState_DataData%x,1) - CALL SeaSt_CopyContState( SrcSeaState_DataData%x(i1), DstSeaState_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcSeaState_DataData%xd,1), UBOUND(SrcSeaState_DataData%xd,1) - CALL SeaSt_CopyDiscState( SrcSeaState_DataData%xd(i1), DstSeaState_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcSeaState_DataData%z,1), UBOUND(SrcSeaState_DataData%z,1) - CALL SeaSt_CopyConstrState( SrcSeaState_DataData%z(i1), DstSeaState_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcSeaState_DataData%OtherSt,1), UBOUND(SrcSeaState_DataData%OtherSt,1) - CALL SeaSt_CopyOtherState( SrcSeaState_DataData%OtherSt(i1), DstSeaState_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL SeaSt_CopyParam( SrcSeaState_DataData%p, DstSeaState_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SeaSt_CopyInput( SrcSeaState_DataData%u, DstSeaState_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SeaSt_CopyOutput( SrcSeaState_DataData%y, DstSeaState_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SeaSt_CopyMisc( SrcSeaState_DataData%m, DstSeaState_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcSeaState_DataData%Input)) THEN - i1_l = LBOUND(SrcSeaState_DataData%Input,1) - i1_u = UBOUND(SrcSeaState_DataData%Input,1) - IF (.NOT. ALLOCATED(DstSeaState_DataData%Input)) THEN - ALLOCATE(DstSeaState_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaState_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcSeaState_DataData%Input,1), UBOUND(SrcSeaState_DataData%Input,1) - CALL SeaSt_CopyInput( SrcSeaState_DataData%Input(i1), DstSeaState_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcSeaState_DataData%Output)) THEN - i1_l = LBOUND(SrcSeaState_DataData%Output,1) - i1_u = UBOUND(SrcSeaState_DataData%Output,1) - IF (.NOT. ALLOCATED(DstSeaState_DataData%Output)) THEN - ALLOCATE(DstSeaState_DataData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaState_DataData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcSeaState_DataData%Output,1), UBOUND(SrcSeaState_DataData%Output,1) - CALL SeaSt_CopyOutput( SrcSeaState_DataData%Output(i1), DstSeaState_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL SeaSt_CopyOutput( SrcSeaState_DataData%y_interp, DstSeaState_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcSeaState_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcSeaState_DataData%InputTimes,1) - i1_u = UBOUND(SrcSeaState_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstSeaState_DataData%InputTimes)) THEN - ALLOCATE(DstSeaState_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaState_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstSeaState_DataData%InputTimes = SrcSeaState_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopySeaState_Data - - SUBROUTINE FAST_DestroySeaState_Data( SeaState_DataData, ErrStat, ErrMsg ) - TYPE(SeaState_Data), INTENT(INOUT) :: SeaState_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroySeaState_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(SeaState_DataData%x,1), UBOUND(SeaState_DataData%x,1) - CALL SeaSt_DestroyContState( SeaState_DataData%x(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(SeaState_DataData%xd,1), UBOUND(SeaState_DataData%xd,1) - CALL SeaSt_DestroyDiscState( SeaState_DataData%xd(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(SeaState_DataData%z,1), UBOUND(SeaState_DataData%z,1) - CALL SeaSt_DestroyConstrState( SeaState_DataData%z(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(SeaState_DataData%OtherSt,1), UBOUND(SeaState_DataData%OtherSt,1) - CALL SeaSt_DestroyOtherState( SeaState_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL SeaSt_DestroyParam( SeaState_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SeaSt_DestroyInput( SeaState_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SeaSt_DestroyOutput( SeaState_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SeaSt_DestroyMisc( SeaState_DataData%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(SeaState_DataData%Input)) THEN -DO i1 = LBOUND(SeaState_DataData%Input,1), UBOUND(SeaState_DataData%Input,1) - CALL SeaSt_DestroyInput( SeaState_DataData%Input(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(SeaState_DataData%Input) -ENDIF -IF (ALLOCATED(SeaState_DataData%Output)) THEN -DO i1 = LBOUND(SeaState_DataData%Output,1), UBOUND(SeaState_DataData%Output,1) - CALL SeaSt_DestroyOutput( SeaState_DataData%Output(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(SeaState_DataData%Output) -ENDIF - CALL SeaSt_DestroyOutput( SeaState_DataData%y_interp, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(SeaState_DataData%InputTimes)) THEN - DEALLOCATE(SeaState_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroySeaState_Data + ErrMsg = '' + do i1 = LB(1), UB(1) + call IceFloe_CopyContState(SrcIceFloe_DataData%x(i1), DstIceFloe_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + do i1 = LB(1), UB(1) + call IceFloe_CopyDiscState(SrcIceFloe_DataData%xd(i1), DstIceFloe_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + do i1 = LB(1), UB(1) + call IceFloe_CopyConstrState(SrcIceFloe_DataData%z(i1), DstIceFloe_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + do i1 = LB(1), UB(1) + call IceFloe_CopyOtherState(SrcIceFloe_DataData%OtherSt(i1), DstIceFloe_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call IceFloe_CopyParam(SrcIceFloe_DataData%p, DstIceFloe_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IceFloe_CopyInput(SrcIceFloe_DataData%u, DstIceFloe_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IceFloe_CopyOutput(SrcIceFloe_DataData%y, DstIceFloe_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IceFloe_CopyMisc(SrcIceFloe_DataData%m, DstIceFloe_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcIceFloe_DataData%Input)) then + LB(1:1) = lbound(SrcIceFloe_DataData%Input) + UB(1:1) = ubound(SrcIceFloe_DataData%Input) + if (.not. allocated(DstIceFloe_DataData%Input)) then + allocate(DstIceFloe_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceFloe_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call IceFloe_CopyInput(SrcIceFloe_DataData%Input(i1), DstIceFloe_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstIceFloe_DataData%Input)) then + deallocate(DstIceFloe_DataData%Input) + end if + if (allocated(SrcIceFloe_DataData%InputTimes)) then + LB(1:1) = lbound(SrcIceFloe_DataData%InputTimes) + UB(1:1) = ubound(SrcIceFloe_DataData%InputTimes) + if (.not. allocated(DstIceFloe_DataData%InputTimes)) then + allocate(DstIceFloe_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIceFloe_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstIceFloe_DataData%InputTimes = SrcIceFloe_DataData%InputTimes + else if (allocated(DstIceFloe_DataData%InputTimes)) then + deallocate(DstIceFloe_DataData%InputTimes) + end if +end subroutine +subroutine FAST_DestroyIceFloe_Data(IceFloe_DataData, ErrStat, ErrMsg) + type(IceFloe_Data), intent(inout) :: IceFloe_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyIceFloe_Data' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(IceFloe_DataData%Input)) then + LB(1:1) = lbound(IceFloe_DataData%Input) + UB(1:1) = ubound(IceFloe_DataData%Input) + do i1 = LB(1), UB(1) + call IceFloe_DestroyInput(IceFloe_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(IceFloe_DataData%Input) + end if + if (allocated(IceFloe_DataData%InputTimes)) then + deallocate(IceFloe_DataData%InputTimes) + end if +end subroutine -subroutine FAST_PackSeaState_Data(Buf, Indata) +subroutine FAST_PackIceFloe_Data(Buf, Indata) type(PackBuffer), intent(inout) :: Buf - type(SeaState_Data), intent(in) :: InData - character(*), parameter :: RoutineName = 'FAST_PackSeaState_Data' + type(IceFloe_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackIceFloe_Data' integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! x LB(1:1) = lbound(InData%x) UB(1:1) = ubound(InData%x) do i1 = LB(1), UB(1) - call SeaSt_PackContState(Buf, InData%x(i1)) + call IceFloe_PackContState(Buf, InData%x(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! xd LB(1:1) = lbound(InData%xd) UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) - call SeaSt_PackDiscState(Buf, InData%xd(i1)) + call IceFloe_PackDiscState(Buf, InData%xd(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! z LB(1:1) = lbound(InData%z) UB(1:1) = ubound(InData%z) do i1 = LB(1), UB(1) - call SeaSt_PackConstrState(Buf, InData%z(i1)) + call IceFloe_PackConstrState(Buf, InData%z(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! OtherSt LB(1:1) = lbound(InData%OtherSt) UB(1:1) = ubound(InData%OtherSt) do i1 = LB(1), UB(1) - call SeaSt_PackOtherState(Buf, InData%OtherSt(i1)) + call IceFloe_PackOtherState(Buf, InData%OtherSt(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! p - call SeaSt_PackParam(Buf, InData%p) + call IceFloe_PackParam(Buf, InData%p) if (RegCheckErr(Buf, RoutineName)) return - ! u - call SeaSt_PackInput(Buf, InData%u) + call IceFloe_PackInput(Buf, InData%u) if (RegCheckErr(Buf, RoutineName)) return - ! y - call SeaSt_PackOutput(Buf, InData%y) + call IceFloe_PackOutput(Buf, InData%y) if (RegCheckErr(Buf, RoutineName)) return - ! m - call SeaSt_PackMisc(Buf, InData%m) + call IceFloe_PackMisc(Buf, InData%m) if (RegCheckErr(Buf, RoutineName)) return - ! Input call RegPack(Buf, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) LB(1:1) = lbound(InData%Input) UB(1:1) = ubound(InData%Input) do i1 = LB(1), UB(1) - call SeaSt_PackInput(Buf, InData%Input(i1)) - end do - end if - if (RegCheckErr(Buf, RoutineName)) return - ! Output - call RegPack(Buf, allocated(InData%Output)) - if (allocated(InData%Output)) then - call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) - LB(1:1) = lbound(InData%Output) - UB(1:1) = ubound(InData%Output) - do i1 = LB(1), UB(1) - call SeaSt_PackOutput(Buf, InData%Output(i1)) + call IceFloe_PackInput(Buf, InData%Input(i1)) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! y_interp - call SeaSt_PackOutput(Buf, InData%y_interp) - if (RegCheckErr(Buf, RoutineName)) return - ! InputTimes call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) @@ -11426,48 +11285,39 @@ subroutine FAST_PackSeaState_Data(Buf, Indata) if (RegCheckErr(Buf, RoutineName)) return end subroutine -subroutine FAST_UnPackSeaState_Data(Buf, OutData) +subroutine FAST_UnPackIceFloe_Data(Buf, OutData) type(PackBuffer), intent(inout) :: Buf - type(SeaState_Data), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'FAST_UnPackSeaState_Data' + type(IceFloe_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackIceFloe_Data' integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! x LB(1:1) = lbound(OutData%x) UB(1:1) = ubound(OutData%x) do i1 = LB(1), UB(1) - call SeaSt_UnpackContState(Buf, OutData%x(i1)) ! x + call IceFloe_UnpackContState(Buf, OutData%x(i1)) ! x end do - ! xd LB(1:1) = lbound(OutData%xd) UB(1:1) = ubound(OutData%xd) do i1 = LB(1), UB(1) - call SeaSt_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + call IceFloe_UnpackDiscState(Buf, OutData%xd(i1)) ! xd end do - ! z LB(1:1) = lbound(OutData%z) UB(1:1) = ubound(OutData%z) do i1 = LB(1), UB(1) - call SeaSt_UnpackConstrState(Buf, OutData%z(i1)) ! z + call IceFloe_UnpackConstrState(Buf, OutData%z(i1)) ! z end do - ! OtherSt LB(1:1) = lbound(OutData%OtherSt) UB(1:1) = ubound(OutData%OtherSt) do i1 = LB(1), UB(1) - call SeaSt_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + call IceFloe_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt end do - ! p - call SeaSt_UnpackParam(Buf, OutData%p) ! p - ! u - call SeaSt_UnpackInput(Buf, OutData%u) ! u - ! y - call SeaSt_UnpackOutput(Buf, OutData%y) ! y - ! m - call SeaSt_UnpackMisc(Buf, OutData%m) ! m - ! Input + call IceFloe_UnpackParam(Buf, OutData%p) ! p + call IceFloe_UnpackInput(Buf, OutData%u) ! u + call IceFloe_UnpackOutput(Buf, OutData%y) ! y + call IceFloe_UnpackMisc(Buf, OutData%m) ! m if (allocated(OutData%Input)) deallocate(OutData%Input) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -11480,28 +11330,9 @@ subroutine FAST_UnPackSeaState_Data(Buf, OutData) return end if do i1 = LB(1), UB(1) - call SeaSt_UnpackInput(Buf, OutData%Input(i1)) ! Input - end do - end if - ! Output - if (allocated(OutData%Output)) deallocate(OutData%Output) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Output(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call SeaSt_UnpackOutput(Buf, OutData%Output(i1)) ! Output + call IceFloe_UnpackInput(Buf, OutData%Input(i1)) ! Input end do end if - ! y_interp - call SeaSt_UnpackOutput(Buf, OutData%y_interp) ! y_interp - ! InputTimes if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -11517,234 +11348,196 @@ subroutine FAST_UnPackSeaState_Data(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE FAST_CopyHydroDyn_Data( SrcHydroDyn_DataData, DstHydroDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HydroDyn_Data), INTENT(INOUT) :: SrcHydroDyn_DataData - TYPE(HydroDyn_Data), INTENT(INOUT) :: DstHydroDyn_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyHydroDyn_Data' -! + +subroutine FAST_CopyMAP_Data(SrcMAP_DataData, DstMAP_DataData, CtrlCode, ErrStat, ErrMsg) + type(MAP_Data), intent(inout) :: SrcMAP_DataData + type(MAP_Data), intent(inout) :: DstMAP_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyMAP_Data' ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcHydroDyn_DataData%x,1), UBOUND(SrcHydroDyn_DataData%x,1) - CALL HydroDyn_CopyContState( SrcHydroDyn_DataData%x(i1), DstHydroDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcHydroDyn_DataData%xd,1), UBOUND(SrcHydroDyn_DataData%xd,1) - CALL HydroDyn_CopyDiscState( SrcHydroDyn_DataData%xd(i1), DstHydroDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcHydroDyn_DataData%z,1), UBOUND(SrcHydroDyn_DataData%z,1) - CALL HydroDyn_CopyConstrState( SrcHydroDyn_DataData%z(i1), DstHydroDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcHydroDyn_DataData%OtherSt,1), UBOUND(SrcHydroDyn_DataData%OtherSt,1) - CALL HydroDyn_CopyOtherState( SrcHydroDyn_DataData%OtherSt(i1), DstHydroDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL HydroDyn_CopyParam( SrcHydroDyn_DataData%p, DstHydroDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL HydroDyn_CopyInput( SrcHydroDyn_DataData%u, DstHydroDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL HydroDyn_CopyOutput( SrcHydroDyn_DataData%y, DstHydroDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL HydroDyn_CopyMisc( SrcHydroDyn_DataData%m, DstHydroDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcHydroDyn_DataData%Output)) THEN - i1_l = LBOUND(SrcHydroDyn_DataData%Output,1) - i1_u = UBOUND(SrcHydroDyn_DataData%Output,1) - IF (.NOT. ALLOCATED(DstHydroDyn_DataData%Output)) THEN - ALLOCATE(DstHydroDyn_DataData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcHydroDyn_DataData%Output,1), UBOUND(SrcHydroDyn_DataData%Output,1) - CALL HydroDyn_CopyOutput( SrcHydroDyn_DataData%Output(i1), DstHydroDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL HydroDyn_CopyOutput( SrcHydroDyn_DataData%y_interp, DstHydroDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcHydroDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcHydroDyn_DataData%Input,1) - i1_u = UBOUND(SrcHydroDyn_DataData%Input,1) - IF (.NOT. ALLOCATED(DstHydroDyn_DataData%Input)) THEN - ALLOCATE(DstHydroDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcHydroDyn_DataData%Input,1), UBOUND(SrcHydroDyn_DataData%Input,1) - CALL HydroDyn_CopyInput( SrcHydroDyn_DataData%Input(i1), DstHydroDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcHydroDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcHydroDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcHydroDyn_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstHydroDyn_DataData%InputTimes)) THEN - ALLOCATE(DstHydroDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstHydroDyn_DataData%InputTimes = SrcHydroDyn_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyHydroDyn_Data - - SUBROUTINE FAST_DestroyHydroDyn_Data( HydroDyn_DataData, ErrStat, ErrMsg ) - TYPE(HydroDyn_Data), INTENT(INOUT) :: HydroDyn_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyHydroDyn_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(HydroDyn_DataData%x,1), UBOUND(HydroDyn_DataData%x,1) - CALL HydroDyn_DestroyContState( HydroDyn_DataData%x(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(HydroDyn_DataData%xd,1), UBOUND(HydroDyn_DataData%xd,1) - CALL HydroDyn_DestroyDiscState( HydroDyn_DataData%xd(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(HydroDyn_DataData%z,1), UBOUND(HydroDyn_DataData%z,1) - CALL HydroDyn_DestroyConstrState( HydroDyn_DataData%z(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(HydroDyn_DataData%OtherSt,1), UBOUND(HydroDyn_DataData%OtherSt,1) - CALL HydroDyn_DestroyOtherState( HydroDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL HydroDyn_DestroyParam( HydroDyn_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL HydroDyn_DestroyInput( HydroDyn_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL HydroDyn_DestroyOutput( HydroDyn_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL HydroDyn_DestroyMisc( HydroDyn_DataData%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(HydroDyn_DataData%Output)) THEN -DO i1 = LBOUND(HydroDyn_DataData%Output,1), UBOUND(HydroDyn_DataData%Output,1) - CALL HydroDyn_DestroyOutput( HydroDyn_DataData%Output(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(HydroDyn_DataData%Output) -ENDIF - CALL HydroDyn_DestroyOutput( HydroDyn_DataData%y_interp, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(HydroDyn_DataData%Input)) THEN -DO i1 = LBOUND(HydroDyn_DataData%Input,1), UBOUND(HydroDyn_DataData%Input,1) - CALL HydroDyn_DestroyInput( HydroDyn_DataData%Input(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(HydroDyn_DataData%Input) -ENDIF -IF (ALLOCATED(HydroDyn_DataData%InputTimes)) THEN - DEALLOCATE(HydroDyn_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyHydroDyn_Data + ErrMsg = '' + do i1 = LB(1), UB(1) + call MAP_CopyContState(SrcMAP_DataData%x(i1), DstMAP_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + do i1 = LB(1), UB(1) + call MAP_CopyDiscState(SrcMAP_DataData%xd(i1), DstMAP_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + do i1 = LB(1), UB(1) + call MAP_CopyConstrState(SrcMAP_DataData%z(i1), DstMAP_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call MAP_CopyOtherState(SrcMAP_DataData%OtherSt, DstMAP_DataData%OtherSt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MAP_CopyParam(SrcMAP_DataData%p, DstMAP_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MAP_CopyInput(SrcMAP_DataData%u, DstMAP_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MAP_CopyOutput(SrcMAP_DataData%y, DstMAP_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MAP_CopyOtherState(SrcMAP_DataData%OtherSt_old, DstMAP_DataData%OtherSt_old, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMAP_DataData%Output)) then + LB(1:1) = lbound(SrcMAP_DataData%Output) + UB(1:1) = ubound(SrcMAP_DataData%Output) + if (.not. allocated(DstMAP_DataData%Output)) then + allocate(DstMAP_DataData%Output(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%Output.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MAP_CopyOutput(SrcMAP_DataData%Output(i1), DstMAP_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstMAP_DataData%Output)) then + deallocate(DstMAP_DataData%Output) + end if + call MAP_CopyOutput(SrcMAP_DataData%y_interp, DstMAP_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMAP_DataData%Input)) then + LB(1:1) = lbound(SrcMAP_DataData%Input) + UB(1:1) = ubound(SrcMAP_DataData%Input) + if (.not. allocated(DstMAP_DataData%Input)) then + allocate(DstMAP_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MAP_CopyInput(SrcMAP_DataData%Input(i1), DstMAP_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstMAP_DataData%Input)) then + deallocate(DstMAP_DataData%Input) + end if + if (allocated(SrcMAP_DataData%InputTimes)) then + LB(1:1) = lbound(SrcMAP_DataData%InputTimes) + UB(1:1) = ubound(SrcMAP_DataData%InputTimes) + if (.not. allocated(DstMAP_DataData%InputTimes)) then + allocate(DstMAP_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMAP_DataData%InputTimes = SrcMAP_DataData%InputTimes + else if (allocated(DstMAP_DataData%InputTimes)) then + deallocate(DstMAP_DataData%InputTimes) + end if +end subroutine +subroutine FAST_DestroyMAP_Data(MAP_DataData, ErrStat, ErrMsg) + type(MAP_Data), intent(inout) :: MAP_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyMAP_Data' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MAP_DataData%Output)) then + LB(1:1) = lbound(MAP_DataData%Output) + UB(1:1) = ubound(MAP_DataData%Output) + do i1 = LB(1), UB(1) + call MAP_DestroyOutput(MAP_DataData%Output(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MAP_DataData%Output) + end if + if (allocated(MAP_DataData%Input)) then + LB(1:1) = lbound(MAP_DataData%Input) + UB(1:1) = ubound(MAP_DataData%Input) + do i1 = LB(1), UB(1) + call MAP_DestroyInput(MAP_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MAP_DataData%Input) + end if + if (allocated(MAP_DataData%InputTimes)) then + deallocate(MAP_DataData%InputTimes) + end if +end subroutine -subroutine FAST_PackHydroDyn_Data(Buf, Indata) +subroutine FAST_PackMAP_Data(Buf, Indata) type(PackBuffer), intent(inout) :: Buf - type(HydroDyn_Data), intent(in) :: InData - character(*), parameter :: RoutineName = 'FAST_PackHydroDyn_Data' + type(MAP_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackMAP_Data' integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! x LB(1:1) = lbound(InData%x) UB(1:1) = ubound(InData%x) do i1 = LB(1), UB(1) - call HydroDyn_PackContState(Buf, InData%x(i1)) + call MAP_PackContState(Buf, InData%x(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! xd LB(1:1) = lbound(InData%xd) UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) - call HydroDyn_PackDiscState(Buf, InData%xd(i1)) + call MAP_PackDiscState(Buf, InData%xd(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! z LB(1:1) = lbound(InData%z) UB(1:1) = ubound(InData%z) do i1 = LB(1), UB(1) - call HydroDyn_PackConstrState(Buf, InData%z(i1)) + call MAP_PackConstrState(Buf, InData%z(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! OtherSt - LB(1:1) = lbound(InData%OtherSt) - UB(1:1) = ubound(InData%OtherSt) - do i1 = LB(1), UB(1) - call HydroDyn_PackOtherState(Buf, InData%OtherSt(i1)) - end do + call MAP_PackOtherState(Buf, InData%OtherSt) if (RegCheckErr(Buf, RoutineName)) return - ! p - call HydroDyn_PackParam(Buf, InData%p) + call MAP_PackParam(Buf, InData%p) if (RegCheckErr(Buf, RoutineName)) return - ! u - call HydroDyn_PackInput(Buf, InData%u) + call MAP_PackInput(Buf, InData%u) if (RegCheckErr(Buf, RoutineName)) return - ! y - call HydroDyn_PackOutput(Buf, InData%y) + call MAP_PackOutput(Buf, InData%y) if (RegCheckErr(Buf, RoutineName)) return - ! m - call HydroDyn_PackMisc(Buf, InData%m) + call MAP_PackOtherState(Buf, InData%OtherSt_old) if (RegCheckErr(Buf, RoutineName)) return - ! Output call RegPack(Buf, allocated(InData%Output)) if (allocated(InData%Output)) then call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) LB(1:1) = lbound(InData%Output) UB(1:1) = ubound(InData%Output) do i1 = LB(1), UB(1) - call HydroDyn_PackOutput(Buf, InData%Output(i1)) + call MAP_PackOutput(Buf, InData%Output(i1)) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! y_interp - call HydroDyn_PackOutput(Buf, InData%y_interp) + call MAP_PackOutput(Buf, InData%y_interp) if (RegCheckErr(Buf, RoutineName)) return - ! Input call RegPack(Buf, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) LB(1:1) = lbound(InData%Input) UB(1:1) = ubound(InData%Input) do i1 = LB(1), UB(1) - call HydroDyn_PackInput(Buf, InData%Input(i1)) + call MAP_PackInput(Buf, InData%Input(i1)) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! InputTimes call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) @@ -11753,48 +11546,35 @@ subroutine FAST_PackHydroDyn_Data(Buf, Indata) if (RegCheckErr(Buf, RoutineName)) return end subroutine -subroutine FAST_UnPackHydroDyn_Data(Buf, OutData) +subroutine FAST_UnPackMAP_Data(Buf, OutData) type(PackBuffer), intent(inout) :: Buf - type(HydroDyn_Data), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'FAST_UnPackHydroDyn_Data' + type(MAP_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackMAP_Data' integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! x LB(1:1) = lbound(OutData%x) UB(1:1) = ubound(OutData%x) do i1 = LB(1), UB(1) - call HydroDyn_UnpackContState(Buf, OutData%x(i1)) ! x + call MAP_UnpackContState(Buf, OutData%x(i1)) ! x end do - ! xd LB(1:1) = lbound(OutData%xd) UB(1:1) = ubound(OutData%xd) do i1 = LB(1), UB(1) - call HydroDyn_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + call MAP_UnpackDiscState(Buf, OutData%xd(i1)) ! xd end do - ! z LB(1:1) = lbound(OutData%z) UB(1:1) = ubound(OutData%z) do i1 = LB(1), UB(1) - call HydroDyn_UnpackConstrState(Buf, OutData%z(i1)) ! z - end do - ! OtherSt - LB(1:1) = lbound(OutData%OtherSt) - UB(1:1) = ubound(OutData%OtherSt) - do i1 = LB(1), UB(1) - call HydroDyn_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt - end do - ! p - call HydroDyn_UnpackParam(Buf, OutData%p) ! p - ! u - call HydroDyn_UnpackInput(Buf, OutData%u) ! u - ! y - call HydroDyn_UnpackOutput(Buf, OutData%y) ! y - ! m - call HydroDyn_UnpackMisc(Buf, OutData%m) ! m - ! Output + call MAP_UnpackConstrState(Buf, OutData%z(i1)) ! z + end do + call MAP_UnpackOtherState(Buf, OutData%OtherSt) ! OtherSt + call MAP_UnpackParam(Buf, OutData%p) ! p + call MAP_UnpackInput(Buf, OutData%u) ! u + call MAP_UnpackOutput(Buf, OutData%y) ! y + call MAP_UnpackOtherState(Buf, OutData%OtherSt_old) ! OtherSt_old if (allocated(OutData%Output)) deallocate(OutData%Output) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -11807,12 +11587,10 @@ subroutine FAST_UnPackHydroDyn_Data(Buf, OutData) return end if do i1 = LB(1), UB(1) - call HydroDyn_UnpackOutput(Buf, OutData%Output(i1)) ! Output + call MAP_UnpackOutput(Buf, OutData%Output(i1)) ! Output end do end if - ! y_interp - call HydroDyn_UnpackOutput(Buf, OutData%y_interp) ! y_interp - ! Input + call MAP_UnpackOutput(Buf, OutData%y_interp) ! y_interp if (allocated(OutData%Input)) deallocate(OutData%Input) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -11825,10 +11603,9 @@ subroutine FAST_UnPackHydroDyn_Data(Buf, OutData) return end if do i1 = LB(1), UB(1) - call HydroDyn_UnpackInput(Buf, OutData%Input(i1)) ! Input + call MAP_UnpackInput(Buf, OutData%Input(i1)) ! Input end do end if - ! InputTimes if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -11844,192 +11621,160 @@ subroutine FAST_UnPackHydroDyn_Data(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE FAST_CopyIceFloe_Data( SrcIceFloe_DataData, DstIceFloe_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceFloe_Data), INTENT(INOUT) :: SrcIceFloe_DataData - TYPE(IceFloe_Data), INTENT(INOUT) :: DstIceFloe_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyIceFloe_Data' -! + +subroutine FAST_CopyFEAMooring_Data(SrcFEAMooring_DataData, DstFEAMooring_DataData, CtrlCode, ErrStat, ErrMsg) + type(FEAMooring_Data), intent(inout) :: SrcFEAMooring_DataData + type(FEAMooring_Data), intent(inout) :: DstFEAMooring_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyFEAMooring_Data' ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcIceFloe_DataData%x,1), UBOUND(SrcIceFloe_DataData%x,1) - CALL IceFloe_CopyContState( SrcIceFloe_DataData%x(i1), DstIceFloe_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcIceFloe_DataData%xd,1), UBOUND(SrcIceFloe_DataData%xd,1) - CALL IceFloe_CopyDiscState( SrcIceFloe_DataData%xd(i1), DstIceFloe_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcIceFloe_DataData%z,1), UBOUND(SrcIceFloe_DataData%z,1) - CALL IceFloe_CopyConstrState( SrcIceFloe_DataData%z(i1), DstIceFloe_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcIceFloe_DataData%OtherSt,1), UBOUND(SrcIceFloe_DataData%OtherSt,1) - CALL IceFloe_CopyOtherState( SrcIceFloe_DataData%OtherSt(i1), DstIceFloe_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL IceFloe_CopyParam( SrcIceFloe_DataData%p, DstIceFloe_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL IceFloe_CopyInput( SrcIceFloe_DataData%u, DstIceFloe_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL IceFloe_CopyOutput( SrcIceFloe_DataData%y, DstIceFloe_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL IceFloe_CopyMisc( SrcIceFloe_DataData%m, DstIceFloe_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcIceFloe_DataData%Input)) THEN - i1_l = LBOUND(SrcIceFloe_DataData%Input,1) - i1_u = UBOUND(SrcIceFloe_DataData%Input,1) - IF (.NOT. ALLOCATED(DstIceFloe_DataData%Input)) THEN - ALLOCATE(DstIceFloe_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceFloe_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcIceFloe_DataData%Input,1), UBOUND(SrcIceFloe_DataData%Input,1) - CALL IceFloe_CopyInput( SrcIceFloe_DataData%Input(i1), DstIceFloe_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcIceFloe_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcIceFloe_DataData%InputTimes,1) - i1_u = UBOUND(SrcIceFloe_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstIceFloe_DataData%InputTimes)) THEN - ALLOCATE(DstIceFloe_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceFloe_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstIceFloe_DataData%InputTimes = SrcIceFloe_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyIceFloe_Data - - SUBROUTINE FAST_DestroyIceFloe_Data( IceFloe_DataData, ErrStat, ErrMsg ) - TYPE(IceFloe_Data), INTENT(INOUT) :: IceFloe_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyIceFloe_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(IceFloe_DataData%x,1), UBOUND(IceFloe_DataData%x,1) - CALL IceFloe_DestroyContState( IceFloe_DataData%x(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(IceFloe_DataData%xd,1), UBOUND(IceFloe_DataData%xd,1) - CALL IceFloe_DestroyDiscState( IceFloe_DataData%xd(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(IceFloe_DataData%z,1), UBOUND(IceFloe_DataData%z,1) - CALL IceFloe_DestroyConstrState( IceFloe_DataData%z(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(IceFloe_DataData%OtherSt,1), UBOUND(IceFloe_DataData%OtherSt,1) - CALL IceFloe_DestroyOtherState( IceFloe_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL IceFloe_DestroyParam( IceFloe_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL IceFloe_DestroyInput( IceFloe_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL IceFloe_DestroyOutput( IceFloe_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL IceFloe_DestroyMisc( IceFloe_DataData%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(IceFloe_DataData%Input)) THEN -DO i1 = LBOUND(IceFloe_DataData%Input,1), UBOUND(IceFloe_DataData%Input,1) - CALL IceFloe_DestroyInput( IceFloe_DataData%Input(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(IceFloe_DataData%Input) -ENDIF -IF (ALLOCATED(IceFloe_DataData%InputTimes)) THEN - DEALLOCATE(IceFloe_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyIceFloe_Data + ErrMsg = '' + do i1 = LB(1), UB(1) + call FEAM_CopyContState(SrcFEAMooring_DataData%x(i1), DstFEAMooring_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + do i1 = LB(1), UB(1) + call FEAM_CopyDiscState(SrcFEAMooring_DataData%xd(i1), DstFEAMooring_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + do i1 = LB(1), UB(1) + call FEAM_CopyConstrState(SrcFEAMooring_DataData%z(i1), DstFEAMooring_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + do i1 = LB(1), UB(1) + call FEAM_CopyOtherState(SrcFEAMooring_DataData%OtherSt(i1), DstFEAMooring_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call FEAM_CopyParam(SrcFEAMooring_DataData%p, DstFEAMooring_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FEAM_CopyInput(SrcFEAMooring_DataData%u, DstFEAMooring_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FEAM_CopyOutput(SrcFEAMooring_DataData%y, DstFEAMooring_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FEAM_CopyMisc(SrcFEAMooring_DataData%m, DstFEAMooring_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcFEAMooring_DataData%Input)) then + LB(1:1) = lbound(SrcFEAMooring_DataData%Input) + UB(1:1) = ubound(SrcFEAMooring_DataData%Input) + if (.not. allocated(DstFEAMooring_DataData%Input)) then + allocate(DstFEAMooring_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstFEAMooring_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FEAM_CopyInput(SrcFEAMooring_DataData%Input(i1), DstFEAMooring_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstFEAMooring_DataData%Input)) then + deallocate(DstFEAMooring_DataData%Input) + end if + if (allocated(SrcFEAMooring_DataData%InputTimes)) then + LB(1:1) = lbound(SrcFEAMooring_DataData%InputTimes) + UB(1:1) = ubound(SrcFEAMooring_DataData%InputTimes) + if (.not. allocated(DstFEAMooring_DataData%InputTimes)) then + allocate(DstFEAMooring_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstFEAMooring_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstFEAMooring_DataData%InputTimes = SrcFEAMooring_DataData%InputTimes + else if (allocated(DstFEAMooring_DataData%InputTimes)) then + deallocate(DstFEAMooring_DataData%InputTimes) + end if +end subroutine +subroutine FAST_DestroyFEAMooring_Data(FEAMooring_DataData, ErrStat, ErrMsg) + type(FEAMooring_Data), intent(inout) :: FEAMooring_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyFEAMooring_Data' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(FEAMooring_DataData%Input)) then + LB(1:1) = lbound(FEAMooring_DataData%Input) + UB(1:1) = ubound(FEAMooring_DataData%Input) + do i1 = LB(1), UB(1) + call FEAM_DestroyInput(FEAMooring_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(FEAMooring_DataData%Input) + end if + if (allocated(FEAMooring_DataData%InputTimes)) then + deallocate(FEAMooring_DataData%InputTimes) + end if +end subroutine -subroutine FAST_PackIceFloe_Data(Buf, Indata) +subroutine FAST_PackFEAMooring_Data(Buf, Indata) type(PackBuffer), intent(inout) :: Buf - type(IceFloe_Data), intent(in) :: InData - character(*), parameter :: RoutineName = 'FAST_PackIceFloe_Data' + type(FEAMooring_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackFEAMooring_Data' integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! x LB(1:1) = lbound(InData%x) UB(1:1) = ubound(InData%x) do i1 = LB(1), UB(1) - call IceFloe_PackContState(Buf, InData%x(i1)) + call FEAM_PackContState(Buf, InData%x(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! xd LB(1:1) = lbound(InData%xd) UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) - call IceFloe_PackDiscState(Buf, InData%xd(i1)) + call FEAM_PackDiscState(Buf, InData%xd(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! z LB(1:1) = lbound(InData%z) UB(1:1) = ubound(InData%z) do i1 = LB(1), UB(1) - call IceFloe_PackConstrState(Buf, InData%z(i1)) + call FEAM_PackConstrState(Buf, InData%z(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! OtherSt LB(1:1) = lbound(InData%OtherSt) UB(1:1) = ubound(InData%OtherSt) do i1 = LB(1), UB(1) - call IceFloe_PackOtherState(Buf, InData%OtherSt(i1)) + call FEAM_PackOtherState(Buf, InData%OtherSt(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! p - call IceFloe_PackParam(Buf, InData%p) + call FEAM_PackParam(Buf, InData%p) if (RegCheckErr(Buf, RoutineName)) return - ! u - call IceFloe_PackInput(Buf, InData%u) + call FEAM_PackInput(Buf, InData%u) if (RegCheckErr(Buf, RoutineName)) return - ! y - call IceFloe_PackOutput(Buf, InData%y) + call FEAM_PackOutput(Buf, InData%y) if (RegCheckErr(Buf, RoutineName)) return - ! m - call IceFloe_PackMisc(Buf, InData%m) + call FEAM_PackMisc(Buf, InData%m) if (RegCheckErr(Buf, RoutineName)) return - ! Input call RegPack(Buf, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) LB(1:1) = lbound(InData%Input) UB(1:1) = ubound(InData%Input) do i1 = LB(1), UB(1) - call IceFloe_PackInput(Buf, InData%Input(i1)) + call FEAM_PackInput(Buf, InData%Input(i1)) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! InputTimes call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) @@ -12038,48 +11783,39 @@ subroutine FAST_PackIceFloe_Data(Buf, Indata) if (RegCheckErr(Buf, RoutineName)) return end subroutine -subroutine FAST_UnPackIceFloe_Data(Buf, OutData) +subroutine FAST_UnPackFEAMooring_Data(Buf, OutData) type(PackBuffer), intent(inout) :: Buf - type(IceFloe_Data), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'FAST_UnPackIceFloe_Data' + type(FEAMooring_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackFEAMooring_Data' integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! x LB(1:1) = lbound(OutData%x) UB(1:1) = ubound(OutData%x) do i1 = LB(1), UB(1) - call IceFloe_UnpackContState(Buf, OutData%x(i1)) ! x + call FEAM_UnpackContState(Buf, OutData%x(i1)) ! x end do - ! xd LB(1:1) = lbound(OutData%xd) UB(1:1) = ubound(OutData%xd) do i1 = LB(1), UB(1) - call IceFloe_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + call FEAM_UnpackDiscState(Buf, OutData%xd(i1)) ! xd end do - ! z LB(1:1) = lbound(OutData%z) UB(1:1) = ubound(OutData%z) do i1 = LB(1), UB(1) - call IceFloe_UnpackConstrState(Buf, OutData%z(i1)) ! z + call FEAM_UnpackConstrState(Buf, OutData%z(i1)) ! z end do - ! OtherSt LB(1:1) = lbound(OutData%OtherSt) UB(1:1) = ubound(OutData%OtherSt) do i1 = LB(1), UB(1) - call IceFloe_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + call FEAM_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt end do - ! p - call IceFloe_UnpackParam(Buf, OutData%p) ! p - ! u - call IceFloe_UnpackInput(Buf, OutData%u) ! u - ! y - call IceFloe_UnpackOutput(Buf, OutData%y) ! y - ! m - call IceFloe_UnpackMisc(Buf, OutData%m) ! m - ! Input + call FEAM_UnpackParam(Buf, OutData%p) ! p + call FEAM_UnpackInput(Buf, OutData%u) ! u + call FEAM_UnpackOutput(Buf, OutData%y) ! y + call FEAM_UnpackMisc(Buf, OutData%m) ! m if (allocated(OutData%Input)) deallocate(OutData%Input) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12092,10 +11828,9 @@ subroutine FAST_UnPackIceFloe_Data(Buf, OutData) return end if do i1 = LB(1), UB(1) - call IceFloe_UnpackInput(Buf, OutData%Input(i1)) ! Input + call FEAM_UnpackInput(Buf, OutData%Input(i1)) ! Input end do end if - ! InputTimes if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12111,226 +11846,202 @@ subroutine FAST_UnPackIceFloe_Data(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE FAST_CopyMAP_Data( SrcMAP_DataData, DstMAP_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MAP_Data), INTENT(INOUT) :: SrcMAP_DataData - TYPE(MAP_Data), INTENT(INOUT) :: DstMAP_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyMAP_Data' -! + +subroutine FAST_CopyMoorDyn_Data(SrcMoorDyn_DataData, DstMoorDyn_DataData, CtrlCode, ErrStat, ErrMsg) + type(MoorDyn_Data), intent(inout) :: SrcMoorDyn_DataData + type(MoorDyn_Data), intent(inout) :: DstMoorDyn_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyMoorDyn_Data' ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcMAP_DataData%x,1), UBOUND(SrcMAP_DataData%x,1) - CALL MAP_CopyContState( SrcMAP_DataData%x(i1), DstMAP_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcMAP_DataData%xd,1), UBOUND(SrcMAP_DataData%xd,1) - CALL MAP_CopyDiscState( SrcMAP_DataData%xd(i1), DstMAP_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcMAP_DataData%z,1), UBOUND(SrcMAP_DataData%z,1) - CALL MAP_CopyConstrState( SrcMAP_DataData%z(i1), DstMAP_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL MAP_CopyOtherState( SrcMAP_DataData%OtherSt, DstMAP_DataData%OtherSt, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MAP_CopyParam( SrcMAP_DataData%p, DstMAP_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MAP_CopyInput( SrcMAP_DataData%u, DstMAP_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MAP_CopyOutput( SrcMAP_DataData%y, DstMAP_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MAP_CopyOtherState( SrcMAP_DataData%OtherSt_old, DstMAP_DataData%OtherSt_old, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMAP_DataData%Output)) THEN - i1_l = LBOUND(SrcMAP_DataData%Output,1) - i1_u = UBOUND(SrcMAP_DataData%Output,1) - IF (.NOT. ALLOCATED(DstMAP_DataData%Output)) THEN - ALLOCATE(DstMAP_DataData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMAP_DataData%Output,1), UBOUND(SrcMAP_DataData%Output,1) - CALL MAP_CopyOutput( SrcMAP_DataData%Output(i1), DstMAP_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL MAP_CopyOutput( SrcMAP_DataData%y_interp, DstMAP_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMAP_DataData%Input)) THEN - i1_l = LBOUND(SrcMAP_DataData%Input,1) - i1_u = UBOUND(SrcMAP_DataData%Input,1) - IF (.NOT. ALLOCATED(DstMAP_DataData%Input)) THEN - ALLOCATE(DstMAP_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMAP_DataData%Input,1), UBOUND(SrcMAP_DataData%Input,1) - CALL MAP_CopyInput( SrcMAP_DataData%Input(i1), DstMAP_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMAP_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcMAP_DataData%InputTimes,1) - i1_u = UBOUND(SrcMAP_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstMAP_DataData%InputTimes)) THEN - ALLOCATE(DstMAP_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMAP_DataData%InputTimes = SrcMAP_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyMAP_Data - - SUBROUTINE FAST_DestroyMAP_Data( MAP_DataData, ErrStat, ErrMsg ) - TYPE(MAP_Data), INTENT(INOUT) :: MAP_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyMAP_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(MAP_DataData%x,1), UBOUND(MAP_DataData%x,1) - CALL MAP_DestroyContState( MAP_DataData%x(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(MAP_DataData%xd,1), UBOUND(MAP_DataData%xd,1) - CALL MAP_DestroyDiscState( MAP_DataData%xd(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(MAP_DataData%z,1), UBOUND(MAP_DataData%z,1) - CALL MAP_DestroyConstrState( MAP_DataData%z(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL MAP_DestroyOtherState( MAP_DataData%OtherSt, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MAP_DestroyParam( MAP_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MAP_DestroyInput( MAP_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MAP_DestroyOutput( MAP_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MAP_DestroyOtherState( MAP_DataData%OtherSt_old, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MAP_DataData%Output)) THEN -DO i1 = LBOUND(MAP_DataData%Output,1), UBOUND(MAP_DataData%Output,1) - CALL MAP_DestroyOutput( MAP_DataData%Output(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MAP_DataData%Output) -ENDIF - CALL MAP_DestroyOutput( MAP_DataData%y_interp, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MAP_DataData%Input)) THEN -DO i1 = LBOUND(MAP_DataData%Input,1), UBOUND(MAP_DataData%Input,1) - CALL MAP_DestroyInput( MAP_DataData%Input(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MAP_DataData%Input) -ENDIF -IF (ALLOCATED(MAP_DataData%InputTimes)) THEN - DEALLOCATE(MAP_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyMAP_Data + ErrMsg = '' + do i1 = LB(1), UB(1) + call MD_CopyContState(SrcMoorDyn_DataData%x(i1), DstMoorDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + do i1 = LB(1), UB(1) + call MD_CopyDiscState(SrcMoorDyn_DataData%xd(i1), DstMoorDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + do i1 = LB(1), UB(1) + call MD_CopyConstrState(SrcMoorDyn_DataData%z(i1), DstMoorDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + do i1 = LB(1), UB(1) + call MD_CopyOtherState(SrcMoorDyn_DataData%OtherSt(i1), DstMoorDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call MD_CopyParam(SrcMoorDyn_DataData%p, DstMoorDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MD_CopyInput(SrcMoorDyn_DataData%u, DstMoorDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MD_CopyOutput(SrcMoorDyn_DataData%y, DstMoorDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MD_CopyMisc(SrcMoorDyn_DataData%m, DstMoorDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMoorDyn_DataData%Output)) then + LB(1:1) = lbound(SrcMoorDyn_DataData%Output) + UB(1:1) = ubound(SrcMoorDyn_DataData%Output) + if (.not. allocated(DstMoorDyn_DataData%Output)) then + allocate(DstMoorDyn_DataData%Output(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%Output.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyOutput(SrcMoorDyn_DataData%Output(i1), DstMoorDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstMoorDyn_DataData%Output)) then + deallocate(DstMoorDyn_DataData%Output) + end if + call MD_CopyOutput(SrcMoorDyn_DataData%y_interp, DstMoorDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMoorDyn_DataData%Input)) then + LB(1:1) = lbound(SrcMoorDyn_DataData%Input) + UB(1:1) = ubound(SrcMoorDyn_DataData%Input) + if (.not. allocated(DstMoorDyn_DataData%Input)) then + allocate(DstMoorDyn_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyInput(SrcMoorDyn_DataData%Input(i1), DstMoorDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstMoorDyn_DataData%Input)) then + deallocate(DstMoorDyn_DataData%Input) + end if + if (allocated(SrcMoorDyn_DataData%InputTimes)) then + LB(1:1) = lbound(SrcMoorDyn_DataData%InputTimes) + UB(1:1) = ubound(SrcMoorDyn_DataData%InputTimes) + if (.not. allocated(DstMoorDyn_DataData%InputTimes)) then + allocate(DstMoorDyn_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMoorDyn_DataData%InputTimes = SrcMoorDyn_DataData%InputTimes + else if (allocated(DstMoorDyn_DataData%InputTimes)) then + deallocate(DstMoorDyn_DataData%InputTimes) + end if +end subroutine +subroutine FAST_DestroyMoorDyn_Data(MoorDyn_DataData, ErrStat, ErrMsg) + type(MoorDyn_Data), intent(inout) :: MoorDyn_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyMoorDyn_Data' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MoorDyn_DataData%Output)) then + LB(1:1) = lbound(MoorDyn_DataData%Output) + UB(1:1) = ubound(MoorDyn_DataData%Output) + do i1 = LB(1), UB(1) + call MD_DestroyOutput(MoorDyn_DataData%Output(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MoorDyn_DataData%Output) + end if + if (allocated(MoorDyn_DataData%Input)) then + LB(1:1) = lbound(MoorDyn_DataData%Input) + UB(1:1) = ubound(MoorDyn_DataData%Input) + do i1 = LB(1), UB(1) + call MD_DestroyInput(MoorDyn_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MoorDyn_DataData%Input) + end if + if (allocated(MoorDyn_DataData%InputTimes)) then + deallocate(MoorDyn_DataData%InputTimes) + end if +end subroutine -subroutine FAST_PackMAP_Data(Buf, Indata) +subroutine FAST_PackMoorDyn_Data(Buf, Indata) type(PackBuffer), intent(inout) :: Buf - type(MAP_Data), intent(in) :: InData - character(*), parameter :: RoutineName = 'FAST_PackMAP_Data' + type(MoorDyn_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackMoorDyn_Data' integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! x LB(1:1) = lbound(InData%x) UB(1:1) = ubound(InData%x) do i1 = LB(1), UB(1) - call MAP_PackContState(Buf, InData%x(i1)) + call MD_PackContState(Buf, InData%x(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! xd LB(1:1) = lbound(InData%xd) UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) - call MAP_PackDiscState(Buf, InData%xd(i1)) + call MD_PackDiscState(Buf, InData%xd(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! z LB(1:1) = lbound(InData%z) UB(1:1) = ubound(InData%z) do i1 = LB(1), UB(1) - call MAP_PackConstrState(Buf, InData%z(i1)) + call MD_PackConstrState(Buf, InData%z(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! OtherSt - call MAP_PackOtherState(Buf, InData%OtherSt) + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call MD_PackOtherState(Buf, InData%OtherSt(i1)) + end do if (RegCheckErr(Buf, RoutineName)) return - ! p - call MAP_PackParam(Buf, InData%p) + call MD_PackParam(Buf, InData%p) if (RegCheckErr(Buf, RoutineName)) return - ! u - call MAP_PackInput(Buf, InData%u) + call MD_PackInput(Buf, InData%u) if (RegCheckErr(Buf, RoutineName)) return - ! y - call MAP_PackOutput(Buf, InData%y) + call MD_PackOutput(Buf, InData%y) if (RegCheckErr(Buf, RoutineName)) return - ! OtherSt_old - call MAP_PackOtherState(Buf, InData%OtherSt_old) + call MD_PackMisc(Buf, InData%m) if (RegCheckErr(Buf, RoutineName)) return - ! Output call RegPack(Buf, allocated(InData%Output)) if (allocated(InData%Output)) then call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) LB(1:1) = lbound(InData%Output) UB(1:1) = ubound(InData%Output) do i1 = LB(1), UB(1) - call MAP_PackOutput(Buf, InData%Output(i1)) + call MD_PackOutput(Buf, InData%Output(i1)) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! y_interp - call MAP_PackOutput(Buf, InData%y_interp) + call MD_PackOutput(Buf, InData%y_interp) if (RegCheckErr(Buf, RoutineName)) return - ! Input call RegPack(Buf, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) LB(1:1) = lbound(InData%Input) UB(1:1) = ubound(InData%Input) do i1 = LB(1), UB(1) - call MAP_PackInput(Buf, InData%Input(i1)) + call MD_PackInput(Buf, InData%Input(i1)) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! InputTimes call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) @@ -12339,44 +12050,39 @@ subroutine FAST_PackMAP_Data(Buf, Indata) if (RegCheckErr(Buf, RoutineName)) return end subroutine -subroutine FAST_UnPackMAP_Data(Buf, OutData) +subroutine FAST_UnPackMoorDyn_Data(Buf, OutData) type(PackBuffer), intent(inout) :: Buf - type(MAP_Data), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'FAST_UnPackMAP_Data' + type(MoorDyn_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackMoorDyn_Data' integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! x LB(1:1) = lbound(OutData%x) UB(1:1) = ubound(OutData%x) do i1 = LB(1), UB(1) - call MAP_UnpackContState(Buf, OutData%x(i1)) ! x + call MD_UnpackContState(Buf, OutData%x(i1)) ! x end do - ! xd LB(1:1) = lbound(OutData%xd) UB(1:1) = ubound(OutData%xd) do i1 = LB(1), UB(1) - call MAP_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + call MD_UnpackDiscState(Buf, OutData%xd(i1)) ! xd end do - ! z LB(1:1) = lbound(OutData%z) UB(1:1) = ubound(OutData%z) do i1 = LB(1), UB(1) - call MAP_UnpackConstrState(Buf, OutData%z(i1)) ! z + call MD_UnpackConstrState(Buf, OutData%z(i1)) ! z end do - ! OtherSt - call MAP_UnpackOtherState(Buf, OutData%OtherSt) ! OtherSt - ! p - call MAP_UnpackParam(Buf, OutData%p) ! p - ! u - call MAP_UnpackInput(Buf, OutData%u) ! u - ! y - call MAP_UnpackOutput(Buf, OutData%y) ! y - ! OtherSt_old - call MAP_UnpackOtherState(Buf, OutData%OtherSt_old) ! OtherSt_old - ! Output + LB(1:1) = lbound(OutData%OtherSt) + UB(1:1) = ubound(OutData%OtherSt) + do i1 = LB(1), UB(1) + call MD_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + end do + call MD_UnpackParam(Buf, OutData%p) ! p + call MD_UnpackInput(Buf, OutData%u) ! u + call MD_UnpackOutput(Buf, OutData%y) ! y + call MD_UnpackMisc(Buf, OutData%m) ! m if (allocated(OutData%Output)) deallocate(OutData%Output) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12389,12 +12095,10 @@ subroutine FAST_UnPackMAP_Data(Buf, OutData) return end if do i1 = LB(1), UB(1) - call MAP_UnpackOutput(Buf, OutData%Output(i1)) ! Output + call MD_UnpackOutput(Buf, OutData%Output(i1)) ! Output end do end if - ! y_interp - call MAP_UnpackOutput(Buf, OutData%y_interp) ! y_interp - ! Input + call MD_UnpackOutput(Buf, OutData%y_interp) ! y_interp if (allocated(OutData%Input)) deallocate(OutData%Input) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12407,10 +12111,9 @@ subroutine FAST_UnPackMAP_Data(Buf, OutData) return end if do i1 = LB(1), UB(1) - call MAP_UnpackInput(Buf, OutData%Input(i1)) ! Input + call MD_UnpackInput(Buf, OutData%Input(i1)) ! Input end do end if - ! InputTimes if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12426,192 +12129,160 @@ subroutine FAST_UnPackMAP_Data(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE FAST_CopyFEAMooring_Data( SrcFEAMooring_DataData, DstFEAMooring_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FEAMooring_Data), INTENT(INOUT) :: SrcFEAMooring_DataData - TYPE(FEAMooring_Data), INTENT(INOUT) :: DstFEAMooring_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyFEAMooring_Data' -! + +subroutine FAST_CopyOrcaFlex_Data(SrcOrcaFlex_DataData, DstOrcaFlex_DataData, CtrlCode, ErrStat, ErrMsg) + type(OrcaFlex_Data), intent(inout) :: SrcOrcaFlex_DataData + type(OrcaFlex_Data), intent(inout) :: DstOrcaFlex_DataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyOrcaFlex_Data' ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcFEAMooring_DataData%x,1), UBOUND(SrcFEAMooring_DataData%x,1) - CALL FEAM_CopyContState( SrcFEAMooring_DataData%x(i1), DstFEAMooring_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcFEAMooring_DataData%xd,1), UBOUND(SrcFEAMooring_DataData%xd,1) - CALL FEAM_CopyDiscState( SrcFEAMooring_DataData%xd(i1), DstFEAMooring_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcFEAMooring_DataData%z,1), UBOUND(SrcFEAMooring_DataData%z,1) - CALL FEAM_CopyConstrState( SrcFEAMooring_DataData%z(i1), DstFEAMooring_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcFEAMooring_DataData%OtherSt,1), UBOUND(SrcFEAMooring_DataData%OtherSt,1) - CALL FEAM_CopyOtherState( SrcFEAMooring_DataData%OtherSt(i1), DstFEAMooring_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL FEAM_CopyParam( SrcFEAMooring_DataData%p, DstFEAMooring_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FEAM_CopyInput( SrcFEAMooring_DataData%u, DstFEAMooring_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FEAM_CopyOutput( SrcFEAMooring_DataData%y, DstFEAMooring_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FEAM_CopyMisc( SrcFEAMooring_DataData%m, DstFEAMooring_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcFEAMooring_DataData%Input)) THEN - i1_l = LBOUND(SrcFEAMooring_DataData%Input,1) - i1_u = UBOUND(SrcFEAMooring_DataData%Input,1) - IF (.NOT. ALLOCATED(DstFEAMooring_DataData%Input)) THEN - ALLOCATE(DstFEAMooring_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFEAMooring_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcFEAMooring_DataData%Input,1), UBOUND(SrcFEAMooring_DataData%Input,1) - CALL FEAM_CopyInput( SrcFEAMooring_DataData%Input(i1), DstFEAMooring_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcFEAMooring_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcFEAMooring_DataData%InputTimes,1) - i1_u = UBOUND(SrcFEAMooring_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstFEAMooring_DataData%InputTimes)) THEN - ALLOCATE(DstFEAMooring_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFEAMooring_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstFEAMooring_DataData%InputTimes = SrcFEAMooring_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyFEAMooring_Data - - SUBROUTINE FAST_DestroyFEAMooring_Data( FEAMooring_DataData, ErrStat, ErrMsg ) - TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAMooring_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyFEAMooring_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(FEAMooring_DataData%x,1), UBOUND(FEAMooring_DataData%x,1) - CALL FEAM_DestroyContState( FEAMooring_DataData%x(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(FEAMooring_DataData%xd,1), UBOUND(FEAMooring_DataData%xd,1) - CALL FEAM_DestroyDiscState( FEAMooring_DataData%xd(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(FEAMooring_DataData%z,1), UBOUND(FEAMooring_DataData%z,1) - CALL FEAM_DestroyConstrState( FEAMooring_DataData%z(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(FEAMooring_DataData%OtherSt,1), UBOUND(FEAMooring_DataData%OtherSt,1) - CALL FEAM_DestroyOtherState( FEAMooring_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL FEAM_DestroyParam( FEAMooring_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FEAM_DestroyInput( FEAMooring_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FEAM_DestroyOutput( FEAMooring_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FEAM_DestroyMisc( FEAMooring_DataData%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(FEAMooring_DataData%Input)) THEN -DO i1 = LBOUND(FEAMooring_DataData%Input,1), UBOUND(FEAMooring_DataData%Input,1) - CALL FEAM_DestroyInput( FEAMooring_DataData%Input(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(FEAMooring_DataData%Input) -ENDIF -IF (ALLOCATED(FEAMooring_DataData%InputTimes)) THEN - DEALLOCATE(FEAMooring_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyFEAMooring_Data + ErrMsg = '' + do i1 = LB(1), UB(1) + call Orca_CopyContState(SrcOrcaFlex_DataData%x(i1), DstOrcaFlex_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + do i1 = LB(1), UB(1) + call Orca_CopyDiscState(SrcOrcaFlex_DataData%xd(i1), DstOrcaFlex_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + do i1 = LB(1), UB(1) + call Orca_CopyConstrState(SrcOrcaFlex_DataData%z(i1), DstOrcaFlex_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + do i1 = LB(1), UB(1) + call Orca_CopyOtherState(SrcOrcaFlex_DataData%OtherSt(i1), DstOrcaFlex_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + call Orca_CopyParam(SrcOrcaFlex_DataData%p, DstOrcaFlex_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Orca_CopyInput(SrcOrcaFlex_DataData%u, DstOrcaFlex_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Orca_CopyOutput(SrcOrcaFlex_DataData%y, DstOrcaFlex_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Orca_CopyMisc(SrcOrcaFlex_DataData%m, DstOrcaFlex_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcOrcaFlex_DataData%Input)) then + LB(1:1) = lbound(SrcOrcaFlex_DataData%Input) + UB(1:1) = ubound(SrcOrcaFlex_DataData%Input) + if (.not. allocated(DstOrcaFlex_DataData%Input)) then + allocate(DstOrcaFlex_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOrcaFlex_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call Orca_CopyInput(SrcOrcaFlex_DataData%Input(i1), DstOrcaFlex_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstOrcaFlex_DataData%Input)) then + deallocate(DstOrcaFlex_DataData%Input) + end if + if (allocated(SrcOrcaFlex_DataData%InputTimes)) then + LB(1:1) = lbound(SrcOrcaFlex_DataData%InputTimes) + UB(1:1) = ubound(SrcOrcaFlex_DataData%InputTimes) + if (.not. allocated(DstOrcaFlex_DataData%InputTimes)) then + allocate(DstOrcaFlex_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOrcaFlex_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOrcaFlex_DataData%InputTimes = SrcOrcaFlex_DataData%InputTimes + else if (allocated(DstOrcaFlex_DataData%InputTimes)) then + deallocate(DstOrcaFlex_DataData%InputTimes) + end if +end subroutine +subroutine FAST_DestroyOrcaFlex_Data(OrcaFlex_DataData, ErrStat, ErrMsg) + type(OrcaFlex_Data), intent(inout) :: OrcaFlex_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyOrcaFlex_Data' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OrcaFlex_DataData%Input)) then + LB(1:1) = lbound(OrcaFlex_DataData%Input) + UB(1:1) = ubound(OrcaFlex_DataData%Input) + do i1 = LB(1), UB(1) + call Orca_DestroyInput(OrcaFlex_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OrcaFlex_DataData%Input) + end if + if (allocated(OrcaFlex_DataData%InputTimes)) then + deallocate(OrcaFlex_DataData%InputTimes) + end if +end subroutine -subroutine FAST_PackFEAMooring_Data(Buf, Indata) +subroutine FAST_PackOrcaFlex_Data(Buf, Indata) type(PackBuffer), intent(inout) :: Buf - type(FEAMooring_Data), intent(in) :: InData - character(*), parameter :: RoutineName = 'FAST_PackFEAMooring_Data' + type(OrcaFlex_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackOrcaFlex_Data' integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! x LB(1:1) = lbound(InData%x) UB(1:1) = ubound(InData%x) do i1 = LB(1), UB(1) - call FEAM_PackContState(Buf, InData%x(i1)) + call Orca_PackContState(Buf, InData%x(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! xd LB(1:1) = lbound(InData%xd) UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) - call FEAM_PackDiscState(Buf, InData%xd(i1)) + call Orca_PackDiscState(Buf, InData%xd(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! z LB(1:1) = lbound(InData%z) UB(1:1) = ubound(InData%z) do i1 = LB(1), UB(1) - call FEAM_PackConstrState(Buf, InData%z(i1)) + call Orca_PackConstrState(Buf, InData%z(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! OtherSt LB(1:1) = lbound(InData%OtherSt) UB(1:1) = ubound(InData%OtherSt) do i1 = LB(1), UB(1) - call FEAM_PackOtherState(Buf, InData%OtherSt(i1)) + call Orca_PackOtherState(Buf, InData%OtherSt(i1)) end do if (RegCheckErr(Buf, RoutineName)) return - ! p - call FEAM_PackParam(Buf, InData%p) + call Orca_PackParam(Buf, InData%p) if (RegCheckErr(Buf, RoutineName)) return - ! u - call FEAM_PackInput(Buf, InData%u) + call Orca_PackInput(Buf, InData%u) if (RegCheckErr(Buf, RoutineName)) return - ! y - call FEAM_PackOutput(Buf, InData%y) + call Orca_PackOutput(Buf, InData%y) if (RegCheckErr(Buf, RoutineName)) return - ! m - call FEAM_PackMisc(Buf, InData%m) + call Orca_PackMisc(Buf, InData%m) if (RegCheckErr(Buf, RoutineName)) return - ! Input call RegPack(Buf, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) LB(1:1) = lbound(InData%Input) UB(1:1) = ubound(InData%Input) do i1 = LB(1), UB(1) - call FEAM_PackInput(Buf, InData%Input(i1)) + call Orca_PackInput(Buf, InData%Input(i1)) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! InputTimes call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) @@ -12620,48 +12291,39 @@ subroutine FAST_PackFEAMooring_Data(Buf, Indata) if (RegCheckErr(Buf, RoutineName)) return end subroutine -subroutine FAST_UnPackFEAMooring_Data(Buf, OutData) +subroutine FAST_UnPackOrcaFlex_Data(Buf, OutData) type(PackBuffer), intent(inout) :: Buf - type(FEAMooring_Data), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'FAST_UnPackFEAMooring_Data' + type(OrcaFlex_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackOrcaFlex_Data' integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! x LB(1:1) = lbound(OutData%x) UB(1:1) = ubound(OutData%x) do i1 = LB(1), UB(1) - call FEAM_UnpackContState(Buf, OutData%x(i1)) ! x + call Orca_UnpackContState(Buf, OutData%x(i1)) ! x end do - ! xd LB(1:1) = lbound(OutData%xd) UB(1:1) = ubound(OutData%xd) do i1 = LB(1), UB(1) - call FEAM_UnpackDiscState(Buf, OutData%xd(i1)) ! xd + call Orca_UnpackDiscState(Buf, OutData%xd(i1)) ! xd end do - ! z LB(1:1) = lbound(OutData%z) UB(1:1) = ubound(OutData%z) do i1 = LB(1), UB(1) - call FEAM_UnpackConstrState(Buf, OutData%z(i1)) ! z + call Orca_UnpackConstrState(Buf, OutData%z(i1)) ! z end do - ! OtherSt LB(1:1) = lbound(OutData%OtherSt) UB(1:1) = ubound(OutData%OtherSt) do i1 = LB(1), UB(1) - call FEAM_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt + call Orca_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt end do - ! p - call FEAM_UnpackParam(Buf, OutData%p) ! p - ! u - call FEAM_UnpackInput(Buf, OutData%u) ! u - ! y - call FEAM_UnpackOutput(Buf, OutData%y) ! y - ! m - call FEAM_UnpackMisc(Buf, OutData%m) ! m - ! Input + call Orca_UnpackParam(Buf, OutData%p) ! p + call Orca_UnpackInput(Buf, OutData%u) ! u + call Orca_UnpackOutput(Buf, OutData%y) ! y + call Orca_UnpackMisc(Buf, OutData%m) ! m if (allocated(OutData%Input)) deallocate(OutData%Input) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12674,10 +12336,9 @@ subroutine FAST_UnPackFEAMooring_Data(Buf, OutData) return end if do i1 = LB(1), UB(1) - call FEAM_UnpackInput(Buf, OutData%Input(i1)) ! Input + call Orca_UnpackInput(Buf, OutData%Input(i1)) ! Input end do end if - ! InputTimes if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -12693,1405 +12354,824 @@ subroutine FAST_UnPackFEAMooring_Data(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE FAST_CopyMoorDyn_Data( SrcMoorDyn_DataData, DstMoorDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MoorDyn_Data), INTENT(INOUT) :: SrcMoorDyn_DataData - TYPE(MoorDyn_Data), INTENT(INOUT) :: DstMoorDyn_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyMoorDyn_Data' -! - ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcMoorDyn_DataData%x,1), UBOUND(SrcMoorDyn_DataData%x,1) - CALL MD_CopyContState( SrcMoorDyn_DataData%x(i1), DstMoorDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcMoorDyn_DataData%xd,1), UBOUND(SrcMoorDyn_DataData%xd,1) - CALL MD_CopyDiscState( SrcMoorDyn_DataData%xd(i1), DstMoorDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcMoorDyn_DataData%z,1), UBOUND(SrcMoorDyn_DataData%z,1) - CALL MD_CopyConstrState( SrcMoorDyn_DataData%z(i1), DstMoorDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcMoorDyn_DataData%OtherSt,1), UBOUND(SrcMoorDyn_DataData%OtherSt,1) - CALL MD_CopyOtherState( SrcMoorDyn_DataData%OtherSt(i1), DstMoorDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL MD_CopyParam( SrcMoorDyn_DataData%p, DstMoorDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MD_CopyInput( SrcMoorDyn_DataData%u, DstMoorDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MD_CopyOutput( SrcMoorDyn_DataData%y, DstMoorDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MD_CopyMisc( SrcMoorDyn_DataData%m, DstMoorDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMoorDyn_DataData%Output)) THEN - i1_l = LBOUND(SrcMoorDyn_DataData%Output,1) - i1_u = UBOUND(SrcMoorDyn_DataData%Output,1) - IF (.NOT. ALLOCATED(DstMoorDyn_DataData%Output)) THEN - ALLOCATE(DstMoorDyn_DataData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMoorDyn_DataData%Output,1), UBOUND(SrcMoorDyn_DataData%Output,1) - CALL MD_CopyOutput( SrcMoorDyn_DataData%Output(i1), DstMoorDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL MD_CopyOutput( SrcMoorDyn_DataData%y_interp, DstMoorDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMoorDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcMoorDyn_DataData%Input,1) - i1_u = UBOUND(SrcMoorDyn_DataData%Input,1) - IF (.NOT. ALLOCATED(DstMoorDyn_DataData%Input)) THEN - ALLOCATE(DstMoorDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMoorDyn_DataData%Input,1), UBOUND(SrcMoorDyn_DataData%Input,1) - CALL MD_CopyInput( SrcMoorDyn_DataData%Input(i1), DstMoorDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMoorDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcMoorDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcMoorDyn_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstMoorDyn_DataData%InputTimes)) THEN - ALLOCATE(DstMoorDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMoorDyn_DataData%InputTimes = SrcMoorDyn_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyMoorDyn_Data - - SUBROUTINE FAST_DestroyMoorDyn_Data( MoorDyn_DataData, ErrStat, ErrMsg ) - TYPE(MoorDyn_Data), INTENT(INOUT) :: MoorDyn_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyMoorDyn_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(MoorDyn_DataData%x,1), UBOUND(MoorDyn_DataData%x,1) - CALL MD_DestroyContState( MoorDyn_DataData%x(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(MoorDyn_DataData%xd,1), UBOUND(MoorDyn_DataData%xd,1) - CALL MD_DestroyDiscState( MoorDyn_DataData%xd(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(MoorDyn_DataData%z,1), UBOUND(MoorDyn_DataData%z,1) - CALL MD_DestroyConstrState( MoorDyn_DataData%z(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(MoorDyn_DataData%OtherSt,1), UBOUND(MoorDyn_DataData%OtherSt,1) - CALL MD_DestroyOtherState( MoorDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL MD_DestroyParam( MoorDyn_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyInput( MoorDyn_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyOutput( MoorDyn_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyMisc( MoorDyn_DataData%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MoorDyn_DataData%Output)) THEN -DO i1 = LBOUND(MoorDyn_DataData%Output,1), UBOUND(MoorDyn_DataData%Output,1) - CALL MD_DestroyOutput( MoorDyn_DataData%Output(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MoorDyn_DataData%Output) -ENDIF - CALL MD_DestroyOutput( MoorDyn_DataData%y_interp, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MoorDyn_DataData%Input)) THEN -DO i1 = LBOUND(MoorDyn_DataData%Input,1), UBOUND(MoorDyn_DataData%Input,1) - CALL MD_DestroyInput( MoorDyn_DataData%Input(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MoorDyn_DataData%Input) -ENDIF -IF (ALLOCATED(MoorDyn_DataData%InputTimes)) THEN - DEALLOCATE(MoorDyn_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyMoorDyn_Data +subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, CtrlCode, ErrStat, ErrMsg) + type(FAST_ModuleMapType), intent(inout) :: SrcModuleMapTypeData + type(FAST_ModuleMapType), intent(inout) :: DstModuleMapTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyModuleMapType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcModuleMapTypeData%ED_P_2_BD_P)) then + LB(1:1) = lbound(SrcModuleMapTypeData%ED_P_2_BD_P) + UB(1:1) = ubound(SrcModuleMapTypeData%ED_P_2_BD_P) + if (.not. allocated(DstModuleMapTypeData%ED_P_2_BD_P)) then + allocate(DstModuleMapTypeData%ED_P_2_BD_P(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_P_2_BD_P.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ED_P_2_BD_P(i1), DstModuleMapTypeData%ED_P_2_BD_P(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstModuleMapTypeData%ED_P_2_BD_P)) then + deallocate(DstModuleMapTypeData%ED_P_2_BD_P) + end if + if (allocated(SrcModuleMapTypeData%BD_P_2_ED_P)) then + LB(1:1) = lbound(SrcModuleMapTypeData%BD_P_2_ED_P) + UB(1:1) = ubound(SrcModuleMapTypeData%BD_P_2_ED_P) + if (.not. allocated(DstModuleMapTypeData%BD_P_2_ED_P)) then + allocate(DstModuleMapTypeData%BD_P_2_ED_P(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BD_P_2_ED_P.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%BD_P_2_ED_P(i1), DstModuleMapTypeData%BD_P_2_ED_P(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstModuleMapTypeData%BD_P_2_ED_P)) then + deallocate(DstModuleMapTypeData%BD_P_2_ED_P) + end if + if (allocated(SrcModuleMapTypeData%ED_P_2_BD_P_Hub)) then + LB(1:1) = lbound(SrcModuleMapTypeData%ED_P_2_BD_P_Hub) + UB(1:1) = ubound(SrcModuleMapTypeData%ED_P_2_BD_P_Hub) + if (.not. allocated(DstModuleMapTypeData%ED_P_2_BD_P_Hub)) then + allocate(DstModuleMapTypeData%ED_P_2_BD_P_Hub(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_P_2_BD_P_Hub.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ED_P_2_BD_P_Hub(i1), DstModuleMapTypeData%ED_P_2_BD_P_Hub(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstModuleMapTypeData%ED_P_2_BD_P_Hub)) then + deallocate(DstModuleMapTypeData%ED_P_2_BD_P_Hub) + end if + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ED_P_2_HD_PRP_P, DstModuleMapTypeData%ED_P_2_HD_PRP_P, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%SubStructure_2_HD_W_P, DstModuleMapTypeData%SubStructure_2_HD_W_P, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%HD_W_P_2_SubStructure, DstModuleMapTypeData%HD_W_P_2_SubStructure, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%SubStructure_2_HD_M_P, DstModuleMapTypeData%SubStructure_2_HD_M_P, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%HD_M_P_2_SubStructure, DstModuleMapTypeData%HD_M_P_2_SubStructure, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%Structure_2_Mooring, DstModuleMapTypeData%Structure_2_Mooring, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%Mooring_2_Structure, DstModuleMapTypeData%Mooring_2_Structure, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ED_P_2_SD_TP, DstModuleMapTypeData%ED_P_2_SD_TP, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%SD_TP_2_ED_P, DstModuleMapTypeData%SD_TP_2_ED_P, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcModuleMapTypeData%ED_P_2_NStC_P_N)) then + LB(1:1) = lbound(SrcModuleMapTypeData%ED_P_2_NStC_P_N) + UB(1:1) = ubound(SrcModuleMapTypeData%ED_P_2_NStC_P_N) + if (.not. allocated(DstModuleMapTypeData%ED_P_2_NStC_P_N)) then + allocate(DstModuleMapTypeData%ED_P_2_NStC_P_N(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_P_2_NStC_P_N.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ED_P_2_NStC_P_N(i1), DstModuleMapTypeData%ED_P_2_NStC_P_N(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstModuleMapTypeData%ED_P_2_NStC_P_N)) then + deallocate(DstModuleMapTypeData%ED_P_2_NStC_P_N) + end if + if (allocated(SrcModuleMapTypeData%NStC_P_2_ED_P_N)) then + LB(1:1) = lbound(SrcModuleMapTypeData%NStC_P_2_ED_P_N) + UB(1:1) = ubound(SrcModuleMapTypeData%NStC_P_2_ED_P_N) + if (.not. allocated(DstModuleMapTypeData%NStC_P_2_ED_P_N)) then + allocate(DstModuleMapTypeData%NStC_P_2_ED_P_N(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%NStC_P_2_ED_P_N.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%NStC_P_2_ED_P_N(i1), DstModuleMapTypeData%NStC_P_2_ED_P_N(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstModuleMapTypeData%NStC_P_2_ED_P_N)) then + deallocate(DstModuleMapTypeData%NStC_P_2_ED_P_N) + end if + if (allocated(SrcModuleMapTypeData%ED_L_2_TStC_P_T)) then + LB(1:1) = lbound(SrcModuleMapTypeData%ED_L_2_TStC_P_T) + UB(1:1) = ubound(SrcModuleMapTypeData%ED_L_2_TStC_P_T) + if (.not. allocated(DstModuleMapTypeData%ED_L_2_TStC_P_T)) then + allocate(DstModuleMapTypeData%ED_L_2_TStC_P_T(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_L_2_TStC_P_T.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ED_L_2_TStC_P_T(i1), DstModuleMapTypeData%ED_L_2_TStC_P_T(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstModuleMapTypeData%ED_L_2_TStC_P_T)) then + deallocate(DstModuleMapTypeData%ED_L_2_TStC_P_T) + end if + if (allocated(SrcModuleMapTypeData%TStC_P_2_ED_P_T)) then + LB(1:1) = lbound(SrcModuleMapTypeData%TStC_P_2_ED_P_T) + UB(1:1) = ubound(SrcModuleMapTypeData%TStC_P_2_ED_P_T) + if (.not. allocated(DstModuleMapTypeData%TStC_P_2_ED_P_T)) then + allocate(DstModuleMapTypeData%TStC_P_2_ED_P_T(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%TStC_P_2_ED_P_T.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%TStC_P_2_ED_P_T(i1), DstModuleMapTypeData%TStC_P_2_ED_P_T(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstModuleMapTypeData%TStC_P_2_ED_P_T)) then + deallocate(DstModuleMapTypeData%TStC_P_2_ED_P_T) + end if + if (allocated(SrcModuleMapTypeData%ED_L_2_BStC_P_B)) then + LB(1:2) = lbound(SrcModuleMapTypeData%ED_L_2_BStC_P_B) + UB(1:2) = ubound(SrcModuleMapTypeData%ED_L_2_BStC_P_B) + if (.not. allocated(DstModuleMapTypeData%ED_L_2_BStC_P_B)) then + allocate(DstModuleMapTypeData%ED_L_2_BStC_P_B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_L_2_BStC_P_B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ED_L_2_BStC_P_B(i1,i2), DstModuleMapTypeData%ED_L_2_BStC_P_B(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + else if (allocated(DstModuleMapTypeData%ED_L_2_BStC_P_B)) then + deallocate(DstModuleMapTypeData%ED_L_2_BStC_P_B) + end if + if (allocated(SrcModuleMapTypeData%BStC_P_2_ED_P_B)) then + LB(1:2) = lbound(SrcModuleMapTypeData%BStC_P_2_ED_P_B) + UB(1:2) = ubound(SrcModuleMapTypeData%BStC_P_2_ED_P_B) + if (.not. allocated(DstModuleMapTypeData%BStC_P_2_ED_P_B)) then + allocate(DstModuleMapTypeData%BStC_P_2_ED_P_B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BStC_P_2_ED_P_B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%BStC_P_2_ED_P_B(i1,i2), DstModuleMapTypeData%BStC_P_2_ED_P_B(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + else if (allocated(DstModuleMapTypeData%BStC_P_2_ED_P_B)) then + deallocate(DstModuleMapTypeData%BStC_P_2_ED_P_B) + end if + if (allocated(SrcModuleMapTypeData%BD_L_2_BStC_P_B)) then + LB(1:2) = lbound(SrcModuleMapTypeData%BD_L_2_BStC_P_B) + UB(1:2) = ubound(SrcModuleMapTypeData%BD_L_2_BStC_P_B) + if (.not. allocated(DstModuleMapTypeData%BD_L_2_BStC_P_B)) then + allocate(DstModuleMapTypeData%BD_L_2_BStC_P_B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BD_L_2_BStC_P_B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%BD_L_2_BStC_P_B(i1,i2), DstModuleMapTypeData%BD_L_2_BStC_P_B(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + else if (allocated(DstModuleMapTypeData%BD_L_2_BStC_P_B)) then + deallocate(DstModuleMapTypeData%BD_L_2_BStC_P_B) + end if + if (allocated(SrcModuleMapTypeData%BStC_P_2_BD_P_B)) then + LB(1:2) = lbound(SrcModuleMapTypeData%BStC_P_2_BD_P_B) + UB(1:2) = ubound(SrcModuleMapTypeData%BStC_P_2_BD_P_B) + if (.not. allocated(DstModuleMapTypeData%BStC_P_2_BD_P_B)) then + allocate(DstModuleMapTypeData%BStC_P_2_BD_P_B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BStC_P_2_BD_P_B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%BStC_P_2_BD_P_B(i1,i2), DstModuleMapTypeData%BStC_P_2_BD_P_B(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + else if (allocated(DstModuleMapTypeData%BStC_P_2_BD_P_B)) then + deallocate(DstModuleMapTypeData%BStC_P_2_BD_P_B) + end if + if (allocated(SrcModuleMapTypeData%SStC_P_P_2_SubStructure)) then + LB(1:1) = lbound(SrcModuleMapTypeData%SStC_P_P_2_SubStructure) + UB(1:1) = ubound(SrcModuleMapTypeData%SStC_P_P_2_SubStructure) + if (.not. allocated(DstModuleMapTypeData%SStC_P_P_2_SubStructure)) then + allocate(DstModuleMapTypeData%SStC_P_P_2_SubStructure(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%SStC_P_P_2_SubStructure.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%SStC_P_P_2_SubStructure(i1), DstModuleMapTypeData%SStC_P_P_2_SubStructure(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstModuleMapTypeData%SStC_P_P_2_SubStructure)) then + deallocate(DstModuleMapTypeData%SStC_P_P_2_SubStructure) + end if + if (allocated(SrcModuleMapTypeData%SubStructure_2_SStC_P_P)) then + LB(1:1) = lbound(SrcModuleMapTypeData%SubStructure_2_SStC_P_P) + UB(1:1) = ubound(SrcModuleMapTypeData%SubStructure_2_SStC_P_P) + if (.not. allocated(DstModuleMapTypeData%SubStructure_2_SStC_P_P)) then + allocate(DstModuleMapTypeData%SubStructure_2_SStC_P_P(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%SubStructure_2_SStC_P_P.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%SubStructure_2_SStC_P_P(i1), DstModuleMapTypeData%SubStructure_2_SStC_P_P(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstModuleMapTypeData%SubStructure_2_SStC_P_P)) then + deallocate(DstModuleMapTypeData%SubStructure_2_SStC_P_P) + end if + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ED_P_2_SrvD_P_P, DstModuleMapTypeData%ED_P_2_SrvD_P_P, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcModuleMapTypeData%BDED_L_2_AD_L_B)) then + LB(1:1) = lbound(SrcModuleMapTypeData%BDED_L_2_AD_L_B) + UB(1:1) = ubound(SrcModuleMapTypeData%BDED_L_2_AD_L_B) + if (.not. allocated(DstModuleMapTypeData%BDED_L_2_AD_L_B)) then + allocate(DstModuleMapTypeData%BDED_L_2_AD_L_B(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BDED_L_2_AD_L_B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%BDED_L_2_AD_L_B(i1), DstModuleMapTypeData%BDED_L_2_AD_L_B(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstModuleMapTypeData%BDED_L_2_AD_L_B)) then + deallocate(DstModuleMapTypeData%BDED_L_2_AD_L_B) + end if + if (allocated(SrcModuleMapTypeData%AD_L_2_BDED_B)) then + LB(1:1) = lbound(SrcModuleMapTypeData%AD_L_2_BDED_B) + UB(1:1) = ubound(SrcModuleMapTypeData%AD_L_2_BDED_B) + if (.not. allocated(DstModuleMapTypeData%AD_L_2_BDED_B)) then + allocate(DstModuleMapTypeData%AD_L_2_BDED_B(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%AD_L_2_BDED_B.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%AD_L_2_BDED_B(i1), DstModuleMapTypeData%AD_L_2_BDED_B(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstModuleMapTypeData%AD_L_2_BDED_B)) then + deallocate(DstModuleMapTypeData%AD_L_2_BDED_B) + end if + if (allocated(SrcModuleMapTypeData%BD_L_2_BD_L)) then + LB(1:1) = lbound(SrcModuleMapTypeData%BD_L_2_BD_L) + UB(1:1) = ubound(SrcModuleMapTypeData%BD_L_2_BD_L) + if (.not. allocated(DstModuleMapTypeData%BD_L_2_BD_L)) then + allocate(DstModuleMapTypeData%BD_L_2_BD_L(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BD_L_2_BD_L.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%BD_L_2_BD_L(i1), DstModuleMapTypeData%BD_L_2_BD_L(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstModuleMapTypeData%BD_L_2_BD_L)) then + deallocate(DstModuleMapTypeData%BD_L_2_BD_L) + end if + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ED_P_2_AD_P_N, DstModuleMapTypeData%ED_P_2_AD_P_N, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%AD_P_2_ED_P_N, DstModuleMapTypeData%AD_P_2_ED_P_N, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ED_P_2_AD_P_TF, DstModuleMapTypeData%ED_P_2_AD_P_TF, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%AD_P_2_ED_P_TF, DstModuleMapTypeData%AD_P_2_ED_P_TF, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ED_L_2_AD_L_T, DstModuleMapTypeData%ED_L_2_AD_L_T, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%AD_L_2_ED_P_T, DstModuleMapTypeData%AD_L_2_ED_P_T, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcModuleMapTypeData%ED_P_2_AD_P_R)) then + LB(1:1) = lbound(SrcModuleMapTypeData%ED_P_2_AD_P_R) + UB(1:1) = ubound(SrcModuleMapTypeData%ED_P_2_AD_P_R) + if (.not. allocated(DstModuleMapTypeData%ED_P_2_AD_P_R)) then + allocate(DstModuleMapTypeData%ED_P_2_AD_P_R(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_P_2_AD_P_R.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ED_P_2_AD_P_R(i1), DstModuleMapTypeData%ED_P_2_AD_P_R(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstModuleMapTypeData%ED_P_2_AD_P_R)) then + deallocate(DstModuleMapTypeData%ED_P_2_AD_P_R) + end if + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ED_P_2_AD_P_H, DstModuleMapTypeData%ED_P_2_AD_P_H, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%AD_P_2_ED_P_H, DstModuleMapTypeData%AD_P_2_ED_P_H, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%IceF_P_2_SD_P, DstModuleMapTypeData%IceF_P_2_SD_P, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%SDy3_P_2_IceF_P, DstModuleMapTypeData%SDy3_P_2_IceF_P, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcModuleMapTypeData%IceD_P_2_SD_P)) then + LB(1:1) = lbound(SrcModuleMapTypeData%IceD_P_2_SD_P) + UB(1:1) = ubound(SrcModuleMapTypeData%IceD_P_2_SD_P) + if (.not. allocated(DstModuleMapTypeData%IceD_P_2_SD_P)) then + allocate(DstModuleMapTypeData%IceD_P_2_SD_P(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%IceD_P_2_SD_P.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%IceD_P_2_SD_P(i1), DstModuleMapTypeData%IceD_P_2_SD_P(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstModuleMapTypeData%IceD_P_2_SD_P)) then + deallocate(DstModuleMapTypeData%IceD_P_2_SD_P) + end if + if (allocated(SrcModuleMapTypeData%SDy3_P_2_IceD_P)) then + LB(1:1) = lbound(SrcModuleMapTypeData%SDy3_P_2_IceD_P) + UB(1:1) = ubound(SrcModuleMapTypeData%SDy3_P_2_IceD_P) + if (.not. allocated(DstModuleMapTypeData%SDy3_P_2_IceD_P)) then + allocate(DstModuleMapTypeData%SDy3_P_2_IceD_P(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%SDy3_P_2_IceD_P.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%SDy3_P_2_IceD_P(i1), DstModuleMapTypeData%SDy3_P_2_IceD_P(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstModuleMapTypeData%SDy3_P_2_IceD_P)) then + deallocate(DstModuleMapTypeData%SDy3_P_2_IceD_P) + end if + if (allocated(SrcModuleMapTypeData%Jacobian_Opt1)) then + LB(1:2) = lbound(SrcModuleMapTypeData%Jacobian_Opt1) + UB(1:2) = ubound(SrcModuleMapTypeData%Jacobian_Opt1) + if (.not. allocated(DstModuleMapTypeData%Jacobian_Opt1)) then + allocate(DstModuleMapTypeData%Jacobian_Opt1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%Jacobian_Opt1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModuleMapTypeData%Jacobian_Opt1 = SrcModuleMapTypeData%Jacobian_Opt1 + else if (allocated(DstModuleMapTypeData%Jacobian_Opt1)) then + deallocate(DstModuleMapTypeData%Jacobian_Opt1) + end if + if (allocated(SrcModuleMapTypeData%Jacobian_pivot)) then + LB(1:1) = lbound(SrcModuleMapTypeData%Jacobian_pivot) + UB(1:1) = ubound(SrcModuleMapTypeData%Jacobian_pivot) + if (.not. allocated(DstModuleMapTypeData%Jacobian_pivot)) then + allocate(DstModuleMapTypeData%Jacobian_pivot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%Jacobian_pivot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModuleMapTypeData%Jacobian_pivot = SrcModuleMapTypeData%Jacobian_pivot + else if (allocated(DstModuleMapTypeData%Jacobian_pivot)) then + deallocate(DstModuleMapTypeData%Jacobian_pivot) + end if + if (allocated(SrcModuleMapTypeData%Jac_u_indx)) then + LB(1:2) = lbound(SrcModuleMapTypeData%Jac_u_indx) + UB(1:2) = ubound(SrcModuleMapTypeData%Jac_u_indx) + if (.not. allocated(DstModuleMapTypeData%Jac_u_indx)) then + allocate(DstModuleMapTypeData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstModuleMapTypeData%Jac_u_indx = SrcModuleMapTypeData%Jac_u_indx + else if (allocated(DstModuleMapTypeData%Jac_u_indx)) then + deallocate(DstModuleMapTypeData%Jac_u_indx) + end if + call MeshCopy(SrcModuleMapTypeData%u_ED_NacelleLoads, DstModuleMapTypeData%u_ED_NacelleLoads, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcModuleMapTypeData%SubstructureLoads_Tmp, DstModuleMapTypeData%SubstructureLoads_Tmp, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcModuleMapTypeData%SubstructureLoads_Tmp2, DstModuleMapTypeData%SubstructureLoads_Tmp2, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcModuleMapTypeData%PlatformLoads_Tmp, DstModuleMapTypeData%PlatformLoads_Tmp, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcModuleMapTypeData%PlatformLoads_Tmp2, DstModuleMapTypeData%PlatformLoads_Tmp2, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcModuleMapTypeData%SubstructureLoads_Tmp_Farm, DstModuleMapTypeData%SubstructureLoads_Tmp_Farm, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcModuleMapTypeData%u_ED_TowerPtloads, DstModuleMapTypeData%u_ED_TowerPtloads, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcModuleMapTypeData%u_ED_BladePtLoads)) then + LB(1:1) = lbound(SrcModuleMapTypeData%u_ED_BladePtLoads) + UB(1:1) = ubound(SrcModuleMapTypeData%u_ED_BladePtLoads) + if (.not. allocated(DstModuleMapTypeData%u_ED_BladePtLoads)) then + allocate(DstModuleMapTypeData%u_ED_BladePtLoads(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_ED_BladePtLoads.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcModuleMapTypeData%u_ED_BladePtLoads(i1), DstModuleMapTypeData%u_ED_BladePtLoads(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstModuleMapTypeData%u_ED_BladePtLoads)) then + deallocate(DstModuleMapTypeData%u_ED_BladePtLoads) + end if + call MeshCopy(SrcModuleMapTypeData%u_SD_TPMesh, DstModuleMapTypeData%u_SD_TPMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcModuleMapTypeData%u_HD_M_Mesh, DstModuleMapTypeData%u_HD_M_Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcModuleMapTypeData%u_HD_W_Mesh, DstModuleMapTypeData%u_HD_W_Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcModuleMapTypeData%u_ED_HubPtLoad, DstModuleMapTypeData%u_ED_HubPtLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcModuleMapTypeData%u_ED_HubPtLoad_2, DstModuleMapTypeData%u_ED_HubPtLoad_2, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcModuleMapTypeData%u_BD_RootMotion)) then + LB(1:1) = lbound(SrcModuleMapTypeData%u_BD_RootMotion) + UB(1:1) = ubound(SrcModuleMapTypeData%u_BD_RootMotion) + if (.not. allocated(DstModuleMapTypeData%u_BD_RootMotion)) then + allocate(DstModuleMapTypeData%u_BD_RootMotion(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_BD_RootMotion.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcModuleMapTypeData%u_BD_RootMotion(i1), DstModuleMapTypeData%u_BD_RootMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstModuleMapTypeData%u_BD_RootMotion)) then + deallocate(DstModuleMapTypeData%u_BD_RootMotion) + end if + if (allocated(SrcModuleMapTypeData%y_BD_BldMotion_4Loads)) then + LB(1:1) = lbound(SrcModuleMapTypeData%y_BD_BldMotion_4Loads) + UB(1:1) = ubound(SrcModuleMapTypeData%y_BD_BldMotion_4Loads) + if (.not. allocated(DstModuleMapTypeData%y_BD_BldMotion_4Loads)) then + allocate(DstModuleMapTypeData%y_BD_BldMotion_4Loads(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%y_BD_BldMotion_4Loads.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcModuleMapTypeData%y_BD_BldMotion_4Loads(i1), DstModuleMapTypeData%y_BD_BldMotion_4Loads(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstModuleMapTypeData%y_BD_BldMotion_4Loads)) then + deallocate(DstModuleMapTypeData%y_BD_BldMotion_4Loads) + end if + if (allocated(SrcModuleMapTypeData%u_BD_Distrload)) then + LB(1:1) = lbound(SrcModuleMapTypeData%u_BD_Distrload) + UB(1:1) = ubound(SrcModuleMapTypeData%u_BD_Distrload) + if (.not. allocated(DstModuleMapTypeData%u_BD_Distrload)) then + allocate(DstModuleMapTypeData%u_BD_Distrload(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_BD_Distrload.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcModuleMapTypeData%u_BD_Distrload(i1), DstModuleMapTypeData%u_BD_Distrload(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstModuleMapTypeData%u_BD_Distrload)) then + deallocate(DstModuleMapTypeData%u_BD_Distrload) + end if + call MeshCopy(SrcModuleMapTypeData%u_Orca_PtfmMesh, DstModuleMapTypeData%u_Orca_PtfmMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcModuleMapTypeData%u_ExtPtfm_PtfmMesh, DstModuleMapTypeData%u_ExtPtfm_PtfmMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine -subroutine FAST_PackMoorDyn_Data(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf - type(MoorDyn_Data), intent(in) :: InData - character(*), parameter :: RoutineName = 'FAST_PackMoorDyn_Data' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - ! x - LB(1:1) = lbound(InData%x) - UB(1:1) = ubound(InData%x) - do i1 = LB(1), UB(1) - call MD_PackContState(Buf, InData%x(i1)) - end do - if (RegCheckErr(Buf, RoutineName)) return - ! xd - LB(1:1) = lbound(InData%xd) - UB(1:1) = ubound(InData%xd) - do i1 = LB(1), UB(1) - call MD_PackDiscState(Buf, InData%xd(i1)) - end do - if (RegCheckErr(Buf, RoutineName)) return - ! z - LB(1:1) = lbound(InData%z) - UB(1:1) = ubound(InData%z) - do i1 = LB(1), UB(1) - call MD_PackConstrState(Buf, InData%z(i1)) - end do - if (RegCheckErr(Buf, RoutineName)) return - ! OtherSt - LB(1:1) = lbound(InData%OtherSt) - UB(1:1) = ubound(InData%OtherSt) - do i1 = LB(1), UB(1) - call MD_PackOtherState(Buf, InData%OtherSt(i1)) - end do - if (RegCheckErr(Buf, RoutineName)) return - ! p - call MD_PackParam(Buf, InData%p) - if (RegCheckErr(Buf, RoutineName)) return - ! u - call MD_PackInput(Buf, InData%u) - if (RegCheckErr(Buf, RoutineName)) return - ! y - call MD_PackOutput(Buf, InData%y) - if (RegCheckErr(Buf, RoutineName)) return - ! m - call MD_PackMisc(Buf, InData%m) - if (RegCheckErr(Buf, RoutineName)) return - ! Output - call RegPack(Buf, allocated(InData%Output)) - if (allocated(InData%Output)) then - call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) - LB(1:1) = lbound(InData%Output) - UB(1:1) = ubound(InData%Output) +subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) + type(FAST_ModuleMapType), intent(inout) :: ModuleMapTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyModuleMapType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ModuleMapTypeData%ED_P_2_BD_P)) then + LB(1:1) = lbound(ModuleMapTypeData%ED_P_2_BD_P) + UB(1:1) = ubound(ModuleMapTypeData%ED_P_2_BD_P) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_P_2_BD_P(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%ED_P_2_BD_P) + end if + if (allocated(ModuleMapTypeData%BD_P_2_ED_P)) then + LB(1:1) = lbound(ModuleMapTypeData%BD_P_2_ED_P) + UB(1:1) = ubound(ModuleMapTypeData%BD_P_2_ED_P) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%BD_P_2_ED_P(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%BD_P_2_ED_P) + end if + if (allocated(ModuleMapTypeData%ED_P_2_BD_P_Hub)) then + LB(1:1) = lbound(ModuleMapTypeData%ED_P_2_BD_P_Hub) + UB(1:1) = ubound(ModuleMapTypeData%ED_P_2_BD_P_Hub) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_P_2_BD_P_Hub(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%ED_P_2_BD_P_Hub) + end if + if (allocated(ModuleMapTypeData%ED_P_2_NStC_P_N)) then + LB(1:1) = lbound(ModuleMapTypeData%ED_P_2_NStC_P_N) + UB(1:1) = ubound(ModuleMapTypeData%ED_P_2_NStC_P_N) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_P_2_NStC_P_N(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%ED_P_2_NStC_P_N) + end if + if (allocated(ModuleMapTypeData%NStC_P_2_ED_P_N)) then + LB(1:1) = lbound(ModuleMapTypeData%NStC_P_2_ED_P_N) + UB(1:1) = ubound(ModuleMapTypeData%NStC_P_2_ED_P_N) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%NStC_P_2_ED_P_N(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%NStC_P_2_ED_P_N) + end if + if (allocated(ModuleMapTypeData%ED_L_2_TStC_P_T)) then + LB(1:1) = lbound(ModuleMapTypeData%ED_L_2_TStC_P_T) + UB(1:1) = ubound(ModuleMapTypeData%ED_L_2_TStC_P_T) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_L_2_TStC_P_T(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%ED_L_2_TStC_P_T) + end if + if (allocated(ModuleMapTypeData%TStC_P_2_ED_P_T)) then + LB(1:1) = lbound(ModuleMapTypeData%TStC_P_2_ED_P_T) + UB(1:1) = ubound(ModuleMapTypeData%TStC_P_2_ED_P_T) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%TStC_P_2_ED_P_T(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%TStC_P_2_ED_P_T) + end if + if (allocated(ModuleMapTypeData%ED_L_2_BStC_P_B)) then + LB(1:2) = lbound(ModuleMapTypeData%ED_L_2_BStC_P_B) + UB(1:2) = ubound(ModuleMapTypeData%ED_L_2_BStC_P_B) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(ModuleMapTypeData%ED_L_2_BStC_P_B) + end if + if (allocated(ModuleMapTypeData%BStC_P_2_ED_P_B)) then + LB(1:2) = lbound(ModuleMapTypeData%BStC_P_2_ED_P_B) + UB(1:2) = ubound(ModuleMapTypeData%BStC_P_2_ED_P_B) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%BStC_P_2_ED_P_B(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(ModuleMapTypeData%BStC_P_2_ED_P_B) + end if + if (allocated(ModuleMapTypeData%BD_L_2_BStC_P_B)) then + LB(1:2) = lbound(ModuleMapTypeData%BD_L_2_BStC_P_B) + UB(1:2) = ubound(ModuleMapTypeData%BD_L_2_BStC_P_B) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%BD_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(ModuleMapTypeData%BD_L_2_BStC_P_B) + end if + if (allocated(ModuleMapTypeData%BStC_P_2_BD_P_B)) then + LB(1:2) = lbound(ModuleMapTypeData%BStC_P_2_BD_P_B) + UB(1:2) = ubound(ModuleMapTypeData%BStC_P_2_BD_P_B) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%BStC_P_2_BD_P_B(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(ModuleMapTypeData%BStC_P_2_BD_P_B) + end if + if (allocated(ModuleMapTypeData%SStC_P_P_2_SubStructure)) then + LB(1:1) = lbound(ModuleMapTypeData%SStC_P_P_2_SubStructure) + UB(1:1) = ubound(ModuleMapTypeData%SStC_P_P_2_SubStructure) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SStC_P_P_2_SubStructure(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%SStC_P_P_2_SubStructure) + end if + if (allocated(ModuleMapTypeData%SubStructure_2_SStC_P_P)) then + LB(1:1) = lbound(ModuleMapTypeData%SubStructure_2_SStC_P_P) + UB(1:1) = ubound(ModuleMapTypeData%SubStructure_2_SStC_P_P) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SubStructure_2_SStC_P_P(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%SubStructure_2_SStC_P_P) + end if + if (allocated(ModuleMapTypeData%BDED_L_2_AD_L_B)) then + LB(1:1) = lbound(ModuleMapTypeData%BDED_L_2_AD_L_B) + UB(1:1) = ubound(ModuleMapTypeData%BDED_L_2_AD_L_B) do i1 = LB(1), UB(1) - call MD_PackOutput(Buf, InData%Output(i1)) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%BDED_L_2_AD_L_B(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(ModuleMapTypeData%BDED_L_2_AD_L_B) end if - if (RegCheckErr(Buf, RoutineName)) return - ! y_interp - call MD_PackOutput(Buf, InData%y_interp) - if (RegCheckErr(Buf, RoutineName)) return - ! Input - call RegPack(Buf, allocated(InData%Input)) - if (allocated(InData%Input)) then - call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) - LB(1:1) = lbound(InData%Input) - UB(1:1) = ubound(InData%Input) + if (allocated(ModuleMapTypeData%AD_L_2_BDED_B)) then + LB(1:1) = lbound(ModuleMapTypeData%AD_L_2_BDED_B) + UB(1:1) = ubound(ModuleMapTypeData%AD_L_2_BDED_B) do i1 = LB(1), UB(1) - call MD_PackInput(Buf, InData%Input(i1)) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%AD_L_2_BDED_B(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(ModuleMapTypeData%AD_L_2_BDED_B) end if - if (RegCheckErr(Buf, RoutineName)) return - ! InputTimes - call RegPack(Buf, allocated(InData%InputTimes)) - if (allocated(InData%InputTimes)) then - call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) - call RegPack(Buf, InData%InputTimes) + if (allocated(ModuleMapTypeData%BD_L_2_BD_L)) then + LB(1:1) = lbound(ModuleMapTypeData%BD_L_2_BD_L) + UB(1:1) = ubound(ModuleMapTypeData%BD_L_2_BD_L) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%BD_L_2_BD_L(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%BD_L_2_BD_L) end if - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine FAST_UnPackMoorDyn_Data(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf - type(MoorDyn_Data), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'FAST_UnPackMoorDyn_Data' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - ! x - LB(1:1) = lbound(OutData%x) - UB(1:1) = ubound(OutData%x) - do i1 = LB(1), UB(1) - call MD_UnpackContState(Buf, OutData%x(i1)) ! x - end do - ! xd - LB(1:1) = lbound(OutData%xd) - UB(1:1) = ubound(OutData%xd) - do i1 = LB(1), UB(1) - call MD_UnpackDiscState(Buf, OutData%xd(i1)) ! xd - end do - ! z - LB(1:1) = lbound(OutData%z) - UB(1:1) = ubound(OutData%z) - do i1 = LB(1), UB(1) - call MD_UnpackConstrState(Buf, OutData%z(i1)) ! z - end do - ! OtherSt - LB(1:1) = lbound(OutData%OtherSt) - UB(1:1) = ubound(OutData%OtherSt) - do i1 = LB(1), UB(1) - call MD_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt - end do - ! p - call MD_UnpackParam(Buf, OutData%p) ! p - ! u - call MD_UnpackInput(Buf, OutData%u) ! u - ! y - call MD_UnpackOutput(Buf, OutData%y) ! y - ! m - call MD_UnpackMisc(Buf, OutData%m) ! m - ! Output - if (allocated(OutData%Output)) deallocate(OutData%Output) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Output(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(ModuleMapTypeData%ED_P_2_AD_P_R)) then + LB(1:1) = lbound(ModuleMapTypeData%ED_P_2_AD_P_R) + UB(1:1) = ubound(ModuleMapTypeData%ED_P_2_AD_P_R) do i1 = LB(1), UB(1) - call MD_UnpackOutput(Buf, OutData%Output(i1)) ! Output + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(ModuleMapTypeData%ED_P_2_AD_P_R) end if - ! y_interp - call MD_UnpackOutput(Buf, OutData%y_interp) ! y_interp - ! Input - if (allocated(OutData%Input)) deallocate(OutData%Input) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Input(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(ModuleMapTypeData%IceD_P_2_SD_P)) then + LB(1:1) = lbound(ModuleMapTypeData%IceD_P_2_SD_P) + UB(1:1) = ubound(ModuleMapTypeData%IceD_P_2_SD_P) do i1 = LB(1), UB(1) - call MD_UnpackInput(Buf, OutData%Input(i1)) ! Input + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%IceD_P_2_SD_P(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(ModuleMapTypeData%IceD_P_2_SD_P) end if - ! InputTimes - if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%InputTimes) - if (RegCheckErr(Buf, RoutineName)) return + if (allocated(ModuleMapTypeData%SDy3_P_2_IceD_P)) then + LB(1:1) = lbound(ModuleMapTypeData%SDy3_P_2_IceD_P) + UB(1:1) = ubound(ModuleMapTypeData%SDy3_P_2_IceD_P) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SDy3_P_2_IceD_P(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%SDy3_P_2_IceD_P) end if -end subroutine - SUBROUTINE FAST_CopyOrcaFlex_Data( SrcOrcaFlex_DataData, DstOrcaFlex_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(OrcaFlex_Data), INTENT(INOUT) :: SrcOrcaFlex_DataData - TYPE(OrcaFlex_Data), INTENT(INOUT) :: DstOrcaFlex_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyOrcaFlex_Data' -! - ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcOrcaFlex_DataData%x,1), UBOUND(SrcOrcaFlex_DataData%x,1) - CALL Orca_CopyContState( SrcOrcaFlex_DataData%x(i1), DstOrcaFlex_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcOrcaFlex_DataData%xd,1), UBOUND(SrcOrcaFlex_DataData%xd,1) - CALL Orca_CopyDiscState( SrcOrcaFlex_DataData%xd(i1), DstOrcaFlex_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcOrcaFlex_DataData%z,1), UBOUND(SrcOrcaFlex_DataData%z,1) - CALL Orca_CopyConstrState( SrcOrcaFlex_DataData%z(i1), DstOrcaFlex_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcOrcaFlex_DataData%OtherSt,1), UBOUND(SrcOrcaFlex_DataData%OtherSt,1) - CALL Orca_CopyOtherState( SrcOrcaFlex_DataData%OtherSt(i1), DstOrcaFlex_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL Orca_CopyParam( SrcOrcaFlex_DataData%p, DstOrcaFlex_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Orca_CopyInput( SrcOrcaFlex_DataData%u, DstOrcaFlex_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Orca_CopyOutput( SrcOrcaFlex_DataData%y, DstOrcaFlex_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Orca_CopyMisc( SrcOrcaFlex_DataData%m, DstOrcaFlex_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcOrcaFlex_DataData%Input)) THEN - i1_l = LBOUND(SrcOrcaFlex_DataData%Input,1) - i1_u = UBOUND(SrcOrcaFlex_DataData%Input,1) - IF (.NOT. ALLOCATED(DstOrcaFlex_DataData%Input)) THEN - ALLOCATE(DstOrcaFlex_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOrcaFlex_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOrcaFlex_DataData%Input,1), UBOUND(SrcOrcaFlex_DataData%Input,1) - CALL Orca_CopyInput( SrcOrcaFlex_DataData%Input(i1), DstOrcaFlex_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcOrcaFlex_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcOrcaFlex_DataData%InputTimes,1) - i1_u = UBOUND(SrcOrcaFlex_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstOrcaFlex_DataData%InputTimes)) THEN - ALLOCATE(DstOrcaFlex_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOrcaFlex_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOrcaFlex_DataData%InputTimes = SrcOrcaFlex_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyOrcaFlex_Data - - SUBROUTINE FAST_DestroyOrcaFlex_Data( OrcaFlex_DataData, ErrStat, ErrMsg ) - TYPE(OrcaFlex_Data), INTENT(INOUT) :: OrcaFlex_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyOrcaFlex_Data' - - ErrStat = ErrID_None - ErrMsg = "" - -DO i1 = LBOUND(OrcaFlex_DataData%x,1), UBOUND(OrcaFlex_DataData%x,1) - CALL Orca_DestroyContState( OrcaFlex_DataData%x(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(OrcaFlex_DataData%xd,1), UBOUND(OrcaFlex_DataData%xd,1) - CALL Orca_DestroyDiscState( OrcaFlex_DataData%xd(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(OrcaFlex_DataData%z,1), UBOUND(OrcaFlex_DataData%z,1) - CALL Orca_DestroyConstrState( OrcaFlex_DataData%z(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -DO i1 = LBOUND(OrcaFlex_DataData%OtherSt,1), UBOUND(OrcaFlex_DataData%OtherSt,1) - CALL Orca_DestroyOtherState( OrcaFlex_DataData%OtherSt(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - CALL Orca_DestroyParam( OrcaFlex_DataData%p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Orca_DestroyInput( OrcaFlex_DataData%u, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Orca_DestroyOutput( OrcaFlex_DataData%y, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Orca_DestroyMisc( OrcaFlex_DataData%m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(OrcaFlex_DataData%Input)) THEN -DO i1 = LBOUND(OrcaFlex_DataData%Input,1), UBOUND(OrcaFlex_DataData%Input,1) - CALL Orca_DestroyInput( OrcaFlex_DataData%Input(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OrcaFlex_DataData%Input) -ENDIF -IF (ALLOCATED(OrcaFlex_DataData%InputTimes)) THEN - DEALLOCATE(OrcaFlex_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyOrcaFlex_Data - - -subroutine FAST_PackOrcaFlex_Data(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf - type(OrcaFlex_Data), intent(in) :: InData - character(*), parameter :: RoutineName = 'FAST_PackOrcaFlex_Data' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) - if (Buf%ErrStat >= AbortErrLev) return - ! x - LB(1:1) = lbound(InData%x) - UB(1:1) = ubound(InData%x) - do i1 = LB(1), UB(1) - call Orca_PackContState(Buf, InData%x(i1)) - end do - if (RegCheckErr(Buf, RoutineName)) return - ! xd - LB(1:1) = lbound(InData%xd) - UB(1:1) = ubound(InData%xd) - do i1 = LB(1), UB(1) - call Orca_PackDiscState(Buf, InData%xd(i1)) - end do - if (RegCheckErr(Buf, RoutineName)) return - ! z - LB(1:1) = lbound(InData%z) - UB(1:1) = ubound(InData%z) - do i1 = LB(1), UB(1) - call Orca_PackConstrState(Buf, InData%z(i1)) - end do - if (RegCheckErr(Buf, RoutineName)) return - ! OtherSt - LB(1:1) = lbound(InData%OtherSt) - UB(1:1) = ubound(InData%OtherSt) - do i1 = LB(1), UB(1) - call Orca_PackOtherState(Buf, InData%OtherSt(i1)) - end do - if (RegCheckErr(Buf, RoutineName)) return - ! p - call Orca_PackParam(Buf, InData%p) - if (RegCheckErr(Buf, RoutineName)) return - ! u - call Orca_PackInput(Buf, InData%u) - if (RegCheckErr(Buf, RoutineName)) return - ! y - call Orca_PackOutput(Buf, InData%y) - if (RegCheckErr(Buf, RoutineName)) return - ! m - call Orca_PackMisc(Buf, InData%m) - if (RegCheckErr(Buf, RoutineName)) return - ! Input - call RegPack(Buf, allocated(InData%Input)) - if (allocated(InData%Input)) then - call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) - LB(1:1) = lbound(InData%Input) - UB(1:1) = ubound(InData%Input) + if (allocated(ModuleMapTypeData%Jacobian_Opt1)) then + deallocate(ModuleMapTypeData%Jacobian_Opt1) + end if + if (allocated(ModuleMapTypeData%Jacobian_pivot)) then + deallocate(ModuleMapTypeData%Jacobian_pivot) + end if + if (allocated(ModuleMapTypeData%Jac_u_indx)) then + deallocate(ModuleMapTypeData%Jac_u_indx) + end if + if (allocated(ModuleMapTypeData%u_ED_BladePtLoads)) then + LB(1:1) = lbound(ModuleMapTypeData%u_ED_BladePtLoads) + UB(1:1) = ubound(ModuleMapTypeData%u_ED_BladePtLoads) do i1 = LB(1), UB(1) - call Orca_PackInput(Buf, InData%Input(i1)) + call MeshDestroy( ModuleMapTypeData%u_ED_BladePtLoads(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(ModuleMapTypeData%u_ED_BladePtLoads) end if - if (RegCheckErr(Buf, RoutineName)) return - ! InputTimes - call RegPack(Buf, allocated(InData%InputTimes)) - if (allocated(InData%InputTimes)) then - call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) - call RegPack(Buf, InData%InputTimes) + if (allocated(ModuleMapTypeData%u_BD_RootMotion)) then + LB(1:1) = lbound(ModuleMapTypeData%u_BD_RootMotion) + UB(1:1) = ubound(ModuleMapTypeData%u_BD_RootMotion) + do i1 = LB(1), UB(1) + call MeshDestroy( ModuleMapTypeData%u_BD_RootMotion(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%u_BD_RootMotion) end if - if (RegCheckErr(Buf, RoutineName)) return -end subroutine - -subroutine FAST_UnPackOrcaFlex_Data(Buf, OutData) - type(PackBuffer), intent(inout) :: Buf - type(OrcaFlex_Data), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'FAST_UnPackOrcaFlex_Data' - integer(IntKi) :: i1 - integer(IntKi) :: LB(1), UB(1) - integer(IntKi) :: stat - logical :: IsAllocAssoc - if (Buf%ErrStat /= ErrID_None) return - ! x - LB(1:1) = lbound(OutData%x) - UB(1:1) = ubound(OutData%x) - do i1 = LB(1), UB(1) - call Orca_UnpackContState(Buf, OutData%x(i1)) ! x - end do - ! xd - LB(1:1) = lbound(OutData%xd) - UB(1:1) = ubound(OutData%xd) - do i1 = LB(1), UB(1) - call Orca_UnpackDiscState(Buf, OutData%xd(i1)) ! xd - end do - ! z - LB(1:1) = lbound(OutData%z) - UB(1:1) = ubound(OutData%z) - do i1 = LB(1), UB(1) - call Orca_UnpackConstrState(Buf, OutData%z(i1)) ! z - end do - ! OtherSt - LB(1:1) = lbound(OutData%OtherSt) - UB(1:1) = ubound(OutData%OtherSt) - do i1 = LB(1), UB(1) - call Orca_UnpackOtherState(Buf, OutData%OtherSt(i1)) ! OtherSt - end do - ! p - call Orca_UnpackParam(Buf, OutData%p) ! p - ! u - call Orca_UnpackInput(Buf, OutData%u) ! u - ! y - call Orca_UnpackOutput(Buf, OutData%y) ! y - ! m - call Orca_UnpackMisc(Buf, OutData%m) ! m - ! Input - if (allocated(OutData%Input)) deallocate(OutData%Input) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%Input(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if + if (allocated(ModuleMapTypeData%y_BD_BldMotion_4Loads)) then + LB(1:1) = lbound(ModuleMapTypeData%y_BD_BldMotion_4Loads) + UB(1:1) = ubound(ModuleMapTypeData%y_BD_BldMotion_4Loads) do i1 = LB(1), UB(1) - call Orca_UnpackInput(Buf, OutData%Input(i1)) ! Input + call MeshDestroy( ModuleMapTypeData%y_BD_BldMotion_4Loads(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(ModuleMapTypeData%y_BD_BldMotion_4Loads) end if - ! InputTimes - if (allocated(OutData%InputTimes)) deallocate(OutData%InputTimes) - call RegUnpack(Buf, IsAllocAssoc) - if (RegCheckErr(Buf, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(Buf, 1, LB, UB) - if (RegCheckErr(Buf, RoutineName)) return - allocate(OutData%InputTimes(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', Buf%ErrStat, Buf%ErrMsg, RoutineName) - return - end if - call RegUnpack(Buf, OutData%InputTimes) - if (RegCheckErr(Buf, RoutineName)) return + if (allocated(ModuleMapTypeData%u_BD_Distrload)) then + LB(1:1) = lbound(ModuleMapTypeData%u_BD_Distrload) + UB(1:1) = ubound(ModuleMapTypeData%u_BD_Distrload) + do i1 = LB(1), UB(1) + call MeshDestroy( ModuleMapTypeData%u_BD_Distrload(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%u_BD_Distrload) end if end subroutine - SUBROUTINE FAST_CopyModuleMapType( SrcModuleMapTypeData, DstModuleMapTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: SrcModuleMapTypeData - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: DstModuleMapTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyModuleMapType' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcModuleMapTypeData%ED_P_2_BD_P)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%ED_P_2_BD_P,1) - i1_u = UBOUND(SrcModuleMapTypeData%ED_P_2_BD_P,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%ED_P_2_BD_P)) THEN - ALLOCATE(DstModuleMapTypeData%ED_P_2_BD_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_P_2_BD_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%ED_P_2_BD_P,1), UBOUND(SrcModuleMapTypeData%ED_P_2_BD_P,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_BD_P(i1), DstModuleMapTypeData%ED_P_2_BD_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%BD_P_2_ED_P)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%BD_P_2_ED_P,1) - i1_u = UBOUND(SrcModuleMapTypeData%BD_P_2_ED_P,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%BD_P_2_ED_P)) THEN - ALLOCATE(DstModuleMapTypeData%BD_P_2_ED_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BD_P_2_ED_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%BD_P_2_ED_P,1), UBOUND(SrcModuleMapTypeData%BD_P_2_ED_P,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%BD_P_2_ED_P(i1), DstModuleMapTypeData%BD_P_2_ED_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%ED_P_2_BD_P_Hub)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%ED_P_2_BD_P_Hub,1) - i1_u = UBOUND(SrcModuleMapTypeData%ED_P_2_BD_P_Hub,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%ED_P_2_BD_P_Hub)) THEN - ALLOCATE(DstModuleMapTypeData%ED_P_2_BD_P_Hub(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_P_2_BD_P_Hub.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%ED_P_2_BD_P_Hub,1), UBOUND(SrcModuleMapTypeData%ED_P_2_BD_P_Hub,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_BD_P_Hub(i1), DstModuleMapTypeData%ED_P_2_BD_P_Hub(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_HD_PRP_P, DstModuleMapTypeData%ED_P_2_HD_PRP_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SubStructure_2_HD_W_P, DstModuleMapTypeData%SubStructure_2_HD_W_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%HD_W_P_2_SubStructure, DstModuleMapTypeData%HD_W_P_2_SubStructure, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SubStructure_2_HD_M_P, DstModuleMapTypeData%SubStructure_2_HD_M_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%HD_M_P_2_SubStructure, DstModuleMapTypeData%HD_M_P_2_SubStructure, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%Structure_2_Mooring, DstModuleMapTypeData%Structure_2_Mooring, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%Mooring_2_Structure, DstModuleMapTypeData%Mooring_2_Structure, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_SD_TP, DstModuleMapTypeData%ED_P_2_SD_TP, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SD_TP_2_ED_P, DstModuleMapTypeData%SD_TP_2_ED_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcModuleMapTypeData%ED_P_2_NStC_P_N)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%ED_P_2_NStC_P_N,1) - i1_u = UBOUND(SrcModuleMapTypeData%ED_P_2_NStC_P_N,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%ED_P_2_NStC_P_N)) THEN - ALLOCATE(DstModuleMapTypeData%ED_P_2_NStC_P_N(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_P_2_NStC_P_N.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%ED_P_2_NStC_P_N,1), UBOUND(SrcModuleMapTypeData%ED_P_2_NStC_P_N,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_NStC_P_N(i1), DstModuleMapTypeData%ED_P_2_NStC_P_N(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%NStC_P_2_ED_P_N)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%NStC_P_2_ED_P_N,1) - i1_u = UBOUND(SrcModuleMapTypeData%NStC_P_2_ED_P_N,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%NStC_P_2_ED_P_N)) THEN - ALLOCATE(DstModuleMapTypeData%NStC_P_2_ED_P_N(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%NStC_P_2_ED_P_N.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%NStC_P_2_ED_P_N,1), UBOUND(SrcModuleMapTypeData%NStC_P_2_ED_P_N,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%NStC_P_2_ED_P_N(i1), DstModuleMapTypeData%NStC_P_2_ED_P_N(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%ED_L_2_TStC_P_T)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%ED_L_2_TStC_P_T,1) - i1_u = UBOUND(SrcModuleMapTypeData%ED_L_2_TStC_P_T,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%ED_L_2_TStC_P_T)) THEN - ALLOCATE(DstModuleMapTypeData%ED_L_2_TStC_P_T(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_L_2_TStC_P_T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%ED_L_2_TStC_P_T,1), UBOUND(SrcModuleMapTypeData%ED_L_2_TStC_P_T,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_L_2_TStC_P_T(i1), DstModuleMapTypeData%ED_L_2_TStC_P_T(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%TStC_P_2_ED_P_T)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%TStC_P_2_ED_P_T,1) - i1_u = UBOUND(SrcModuleMapTypeData%TStC_P_2_ED_P_T,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%TStC_P_2_ED_P_T)) THEN - ALLOCATE(DstModuleMapTypeData%TStC_P_2_ED_P_T(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%TStC_P_2_ED_P_T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%TStC_P_2_ED_P_T,1), UBOUND(SrcModuleMapTypeData%TStC_P_2_ED_P_T,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%TStC_P_2_ED_P_T(i1), DstModuleMapTypeData%TStC_P_2_ED_P_T(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%ED_L_2_BStC_P_B)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%ED_L_2_BStC_P_B,1) - i1_u = UBOUND(SrcModuleMapTypeData%ED_L_2_BStC_P_B,1) - i2_l = LBOUND(SrcModuleMapTypeData%ED_L_2_BStC_P_B,2) - i2_u = UBOUND(SrcModuleMapTypeData%ED_L_2_BStC_P_B,2) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%ED_L_2_BStC_P_B)) THEN - ALLOCATE(DstModuleMapTypeData%ED_L_2_BStC_P_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_L_2_BStC_P_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcModuleMapTypeData%ED_L_2_BStC_P_B,2), UBOUND(SrcModuleMapTypeData%ED_L_2_BStC_P_B,2) - DO i1 = LBOUND(SrcModuleMapTypeData%ED_L_2_BStC_P_B,1), UBOUND(SrcModuleMapTypeData%ED_L_2_BStC_P_B,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_L_2_BStC_P_B(i1,i2), DstModuleMapTypeData%ED_L_2_BStC_P_B(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%BStC_P_2_ED_P_B)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%BStC_P_2_ED_P_B,1) - i1_u = UBOUND(SrcModuleMapTypeData%BStC_P_2_ED_P_B,1) - i2_l = LBOUND(SrcModuleMapTypeData%BStC_P_2_ED_P_B,2) - i2_u = UBOUND(SrcModuleMapTypeData%BStC_P_2_ED_P_B,2) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%BStC_P_2_ED_P_B)) THEN - ALLOCATE(DstModuleMapTypeData%BStC_P_2_ED_P_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BStC_P_2_ED_P_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcModuleMapTypeData%BStC_P_2_ED_P_B,2), UBOUND(SrcModuleMapTypeData%BStC_P_2_ED_P_B,2) - DO i1 = LBOUND(SrcModuleMapTypeData%BStC_P_2_ED_P_B,1), UBOUND(SrcModuleMapTypeData%BStC_P_2_ED_P_B,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%BStC_P_2_ED_P_B(i1,i2), DstModuleMapTypeData%BStC_P_2_ED_P_B(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%BD_L_2_BStC_P_B)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%BD_L_2_BStC_P_B,1) - i1_u = UBOUND(SrcModuleMapTypeData%BD_L_2_BStC_P_B,1) - i2_l = LBOUND(SrcModuleMapTypeData%BD_L_2_BStC_P_B,2) - i2_u = UBOUND(SrcModuleMapTypeData%BD_L_2_BStC_P_B,2) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%BD_L_2_BStC_P_B)) THEN - ALLOCATE(DstModuleMapTypeData%BD_L_2_BStC_P_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BD_L_2_BStC_P_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcModuleMapTypeData%BD_L_2_BStC_P_B,2), UBOUND(SrcModuleMapTypeData%BD_L_2_BStC_P_B,2) - DO i1 = LBOUND(SrcModuleMapTypeData%BD_L_2_BStC_P_B,1), UBOUND(SrcModuleMapTypeData%BD_L_2_BStC_P_B,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%BD_L_2_BStC_P_B(i1,i2), DstModuleMapTypeData%BD_L_2_BStC_P_B(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%BStC_P_2_BD_P_B)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%BStC_P_2_BD_P_B,1) - i1_u = UBOUND(SrcModuleMapTypeData%BStC_P_2_BD_P_B,1) - i2_l = LBOUND(SrcModuleMapTypeData%BStC_P_2_BD_P_B,2) - i2_u = UBOUND(SrcModuleMapTypeData%BStC_P_2_BD_P_B,2) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%BStC_P_2_BD_P_B)) THEN - ALLOCATE(DstModuleMapTypeData%BStC_P_2_BD_P_B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BStC_P_2_BD_P_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcModuleMapTypeData%BStC_P_2_BD_P_B,2), UBOUND(SrcModuleMapTypeData%BStC_P_2_BD_P_B,2) - DO i1 = LBOUND(SrcModuleMapTypeData%BStC_P_2_BD_P_B,1), UBOUND(SrcModuleMapTypeData%BStC_P_2_BD_P_B,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%BStC_P_2_BD_P_B(i1,i2), DstModuleMapTypeData%BStC_P_2_BD_P_B(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%SStC_P_P_2_SubStructure)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%SStC_P_P_2_SubStructure,1) - i1_u = UBOUND(SrcModuleMapTypeData%SStC_P_P_2_SubStructure,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%SStC_P_P_2_SubStructure)) THEN - ALLOCATE(DstModuleMapTypeData%SStC_P_P_2_SubStructure(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%SStC_P_P_2_SubStructure.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%SStC_P_P_2_SubStructure,1), UBOUND(SrcModuleMapTypeData%SStC_P_P_2_SubStructure,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SStC_P_P_2_SubStructure(i1), DstModuleMapTypeData%SStC_P_P_2_SubStructure(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%SubStructure_2_SStC_P_P)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%SubStructure_2_SStC_P_P,1) - i1_u = UBOUND(SrcModuleMapTypeData%SubStructure_2_SStC_P_P,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%SubStructure_2_SStC_P_P)) THEN - ALLOCATE(DstModuleMapTypeData%SubStructure_2_SStC_P_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%SubStructure_2_SStC_P_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%SubStructure_2_SStC_P_P,1), UBOUND(SrcModuleMapTypeData%SubStructure_2_SStC_P_P,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SubStructure_2_SStC_P_P(i1), DstModuleMapTypeData%SubStructure_2_SStC_P_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_SrvD_P_P, DstModuleMapTypeData%ED_P_2_SrvD_P_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcModuleMapTypeData%BDED_L_2_AD_L_B)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%BDED_L_2_AD_L_B,1) - i1_u = UBOUND(SrcModuleMapTypeData%BDED_L_2_AD_L_B,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%BDED_L_2_AD_L_B)) THEN - ALLOCATE(DstModuleMapTypeData%BDED_L_2_AD_L_B(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BDED_L_2_AD_L_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%BDED_L_2_AD_L_B,1), UBOUND(SrcModuleMapTypeData%BDED_L_2_AD_L_B,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%BDED_L_2_AD_L_B(i1), DstModuleMapTypeData%BDED_L_2_AD_L_B(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%AD_L_2_BDED_B)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%AD_L_2_BDED_B,1) - i1_u = UBOUND(SrcModuleMapTypeData%AD_L_2_BDED_B,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%AD_L_2_BDED_B)) THEN - ALLOCATE(DstModuleMapTypeData%AD_L_2_BDED_B(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%AD_L_2_BDED_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%AD_L_2_BDED_B,1), UBOUND(SrcModuleMapTypeData%AD_L_2_BDED_B,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%AD_L_2_BDED_B(i1), DstModuleMapTypeData%AD_L_2_BDED_B(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%BD_L_2_BD_L)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%BD_L_2_BD_L,1) - i1_u = UBOUND(SrcModuleMapTypeData%BD_L_2_BD_L,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%BD_L_2_BD_L)) THEN - ALLOCATE(DstModuleMapTypeData%BD_L_2_BD_L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BD_L_2_BD_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%BD_L_2_BD_L,1), UBOUND(SrcModuleMapTypeData%BD_L_2_BD_L,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%BD_L_2_BD_L(i1), DstModuleMapTypeData%BD_L_2_BD_L(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_AD_P_N, DstModuleMapTypeData%ED_P_2_AD_P_N, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%AD_P_2_ED_P_N, DstModuleMapTypeData%AD_P_2_ED_P_N, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_AD_P_TF, DstModuleMapTypeData%ED_P_2_AD_P_TF, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%AD_P_2_ED_P_TF, DstModuleMapTypeData%AD_P_2_ED_P_TF, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_L_2_AD_L_T, DstModuleMapTypeData%ED_L_2_AD_L_T, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%AD_L_2_ED_P_T, DstModuleMapTypeData%AD_L_2_ED_P_T, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcModuleMapTypeData%ED_P_2_AD_P_R)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%ED_P_2_AD_P_R,1) - i1_u = UBOUND(SrcModuleMapTypeData%ED_P_2_AD_P_R,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%ED_P_2_AD_P_R)) THEN - ALLOCATE(DstModuleMapTypeData%ED_P_2_AD_P_R(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_P_2_AD_P_R.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%ED_P_2_AD_P_R,1), UBOUND(SrcModuleMapTypeData%ED_P_2_AD_P_R,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_AD_P_R(i1), DstModuleMapTypeData%ED_P_2_AD_P_R(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_AD_P_H, DstModuleMapTypeData%ED_P_2_AD_P_H, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%AD_P_2_ED_P_H, DstModuleMapTypeData%AD_P_2_ED_P_H, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%IceF_P_2_SD_P, DstModuleMapTypeData%IceF_P_2_SD_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SDy3_P_2_IceF_P, DstModuleMapTypeData%SDy3_P_2_IceF_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcModuleMapTypeData%IceD_P_2_SD_P)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%IceD_P_2_SD_P,1) - i1_u = UBOUND(SrcModuleMapTypeData%IceD_P_2_SD_P,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%IceD_P_2_SD_P)) THEN - ALLOCATE(DstModuleMapTypeData%IceD_P_2_SD_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%IceD_P_2_SD_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%IceD_P_2_SD_P,1), UBOUND(SrcModuleMapTypeData%IceD_P_2_SD_P,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%IceD_P_2_SD_P(i1), DstModuleMapTypeData%IceD_P_2_SD_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%SDy3_P_2_IceD_P)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%SDy3_P_2_IceD_P,1) - i1_u = UBOUND(SrcModuleMapTypeData%SDy3_P_2_IceD_P,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%SDy3_P_2_IceD_P)) THEN - ALLOCATE(DstModuleMapTypeData%SDy3_P_2_IceD_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%SDy3_P_2_IceD_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%SDy3_P_2_IceD_P,1), UBOUND(SrcModuleMapTypeData%SDy3_P_2_IceD_P,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SDy3_P_2_IceD_P(i1), DstModuleMapTypeData%SDy3_P_2_IceD_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%Jacobian_Opt1)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%Jacobian_Opt1,1) - i1_u = UBOUND(SrcModuleMapTypeData%Jacobian_Opt1,1) - i2_l = LBOUND(SrcModuleMapTypeData%Jacobian_Opt1,2) - i2_u = UBOUND(SrcModuleMapTypeData%Jacobian_Opt1,2) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%Jacobian_Opt1)) THEN - ALLOCATE(DstModuleMapTypeData%Jacobian_Opt1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%Jacobian_Opt1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstModuleMapTypeData%Jacobian_Opt1 = SrcModuleMapTypeData%Jacobian_Opt1 -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%Jacobian_pivot)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%Jacobian_pivot,1) - i1_u = UBOUND(SrcModuleMapTypeData%Jacobian_pivot,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%Jacobian_pivot)) THEN - ALLOCATE(DstModuleMapTypeData%Jacobian_pivot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%Jacobian_pivot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstModuleMapTypeData%Jacobian_pivot = SrcModuleMapTypeData%Jacobian_pivot -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%Jac_u_indx)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%Jac_u_indx,1) - i1_u = UBOUND(SrcModuleMapTypeData%Jac_u_indx,1) - i2_l = LBOUND(SrcModuleMapTypeData%Jac_u_indx,2) - i2_u = UBOUND(SrcModuleMapTypeData%Jac_u_indx,2) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%Jac_u_indx)) THEN - ALLOCATE(DstModuleMapTypeData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstModuleMapTypeData%Jac_u_indx = SrcModuleMapTypeData%Jac_u_indx -ENDIF - CALL MeshCopy( SrcModuleMapTypeData%u_ED_NacelleLoads, DstModuleMapTypeData%u_ED_NacelleLoads, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%SubstructureLoads_Tmp, DstModuleMapTypeData%SubstructureLoads_Tmp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%SubstructureLoads_Tmp2, DstModuleMapTypeData%SubstructureLoads_Tmp2, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%PlatformLoads_Tmp, DstModuleMapTypeData%PlatformLoads_Tmp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%PlatformLoads_Tmp2, DstModuleMapTypeData%PlatformLoads_Tmp2, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%SubstructureLoads_Tmp_Farm, DstModuleMapTypeData%SubstructureLoads_Tmp_Farm, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_ED_TowerPtloads, DstModuleMapTypeData%u_ED_TowerPtloads, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcModuleMapTypeData%u_ED_BladePtLoads)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%u_ED_BladePtLoads,1) - i1_u = UBOUND(SrcModuleMapTypeData%u_ED_BladePtLoads,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%u_ED_BladePtLoads)) THEN - ALLOCATE(DstModuleMapTypeData%u_ED_BladePtLoads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_ED_BladePtLoads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%u_ED_BladePtLoads,1), UBOUND(SrcModuleMapTypeData%u_ED_BladePtLoads,1) - CALL MeshCopy( SrcModuleMapTypeData%u_ED_BladePtLoads(i1), DstModuleMapTypeData%u_ED_BladePtLoads(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL MeshCopy( SrcModuleMapTypeData%u_SD_TPMesh, DstModuleMapTypeData%u_SD_TPMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_HD_M_Mesh, DstModuleMapTypeData%u_HD_M_Mesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_HD_W_Mesh, DstModuleMapTypeData%u_HD_W_Mesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_ED_HubPtLoad, DstModuleMapTypeData%u_ED_HubPtLoad, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_ED_HubPtLoad_2, DstModuleMapTypeData%u_ED_HubPtLoad_2, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcModuleMapTypeData%u_BD_RootMotion)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%u_BD_RootMotion,1) - i1_u = UBOUND(SrcModuleMapTypeData%u_BD_RootMotion,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%u_BD_RootMotion)) THEN - ALLOCATE(DstModuleMapTypeData%u_BD_RootMotion(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_BD_RootMotion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%u_BD_RootMotion,1), UBOUND(SrcModuleMapTypeData%u_BD_RootMotion,1) - CALL MeshCopy( SrcModuleMapTypeData%u_BD_RootMotion(i1), DstModuleMapTypeData%u_BD_RootMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%y_BD_BldMotion_4Loads)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%y_BD_BldMotion_4Loads,1) - i1_u = UBOUND(SrcModuleMapTypeData%y_BD_BldMotion_4Loads,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%y_BD_BldMotion_4Loads)) THEN - ALLOCATE(DstModuleMapTypeData%y_BD_BldMotion_4Loads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%y_BD_BldMotion_4Loads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%y_BD_BldMotion_4Loads,1), UBOUND(SrcModuleMapTypeData%y_BD_BldMotion_4Loads,1) - CALL MeshCopy( SrcModuleMapTypeData%y_BD_BldMotion_4Loads(i1), DstModuleMapTypeData%y_BD_BldMotion_4Loads(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%u_BD_Distrload)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%u_BD_Distrload,1) - i1_u = UBOUND(SrcModuleMapTypeData%u_BD_Distrload,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%u_BD_Distrload)) THEN - ALLOCATE(DstModuleMapTypeData%u_BD_Distrload(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_BD_Distrload.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%u_BD_Distrload,1), UBOUND(SrcModuleMapTypeData%u_BD_Distrload,1) - CALL MeshCopy( SrcModuleMapTypeData%u_BD_Distrload(i1), DstModuleMapTypeData%u_BD_Distrload(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL MeshCopy( SrcModuleMapTypeData%u_Orca_PtfmMesh, DstModuleMapTypeData%u_Orca_PtfmMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_ExtPtfm_PtfmMesh, DstModuleMapTypeData%u_ExtPtfm_PtfmMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE FAST_CopyModuleMapType - - SUBROUTINE FAST_DestroyModuleMapType( ModuleMapTypeData, ErrStat, ErrMsg ) - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: ModuleMapTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyModuleMapType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ModuleMapTypeData%ED_P_2_BD_P)) THEN -DO i1 = LBOUND(ModuleMapTypeData%ED_P_2_BD_P,1), UBOUND(ModuleMapTypeData%ED_P_2_BD_P,1) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_P_2_BD_P(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%ED_P_2_BD_P) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%BD_P_2_ED_P)) THEN -DO i1 = LBOUND(ModuleMapTypeData%BD_P_2_ED_P,1), UBOUND(ModuleMapTypeData%BD_P_2_ED_P,1) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%BD_P_2_ED_P(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%BD_P_2_ED_P) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%ED_P_2_BD_P_Hub)) THEN -DO i1 = LBOUND(ModuleMapTypeData%ED_P_2_BD_P_Hub,1), UBOUND(ModuleMapTypeData%ED_P_2_BD_P_Hub,1) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_P_2_BD_P_Hub(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%ED_P_2_BD_P_Hub) -ENDIF - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_P_2_HD_PRP_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%SubStructure_2_HD_W_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%HD_W_P_2_SubStructure, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%SubStructure_2_HD_M_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%HD_M_P_2_SubStructure, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%Structure_2_Mooring, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%Mooring_2_Structure, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%SD_TP_2_ED_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ModuleMapTypeData%ED_P_2_NStC_P_N)) THEN -DO i1 = LBOUND(ModuleMapTypeData%ED_P_2_NStC_P_N,1), UBOUND(ModuleMapTypeData%ED_P_2_NStC_P_N,1) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_P_2_NStC_P_N(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%ED_P_2_NStC_P_N) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%NStC_P_2_ED_P_N)) THEN -DO i1 = LBOUND(ModuleMapTypeData%NStC_P_2_ED_P_N,1), UBOUND(ModuleMapTypeData%NStC_P_2_ED_P_N,1) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%NStC_P_2_ED_P_N(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%NStC_P_2_ED_P_N) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%ED_L_2_TStC_P_T)) THEN -DO i1 = LBOUND(ModuleMapTypeData%ED_L_2_TStC_P_T,1), UBOUND(ModuleMapTypeData%ED_L_2_TStC_P_T,1) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_L_2_TStC_P_T(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%ED_L_2_TStC_P_T) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%TStC_P_2_ED_P_T)) THEN -DO i1 = LBOUND(ModuleMapTypeData%TStC_P_2_ED_P_T,1), UBOUND(ModuleMapTypeData%TStC_P_2_ED_P_T,1) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%TStC_P_2_ED_P_T(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%TStC_P_2_ED_P_T) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%ED_L_2_BStC_P_B)) THEN -DO i2 = LBOUND(ModuleMapTypeData%ED_L_2_BStC_P_B,2), UBOUND(ModuleMapTypeData%ED_L_2_BStC_P_B,2) -DO i1 = LBOUND(ModuleMapTypeData%ED_L_2_BStC_P_B,1), UBOUND(ModuleMapTypeData%ED_L_2_BStC_P_B,1) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(ModuleMapTypeData%ED_L_2_BStC_P_B) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%BStC_P_2_ED_P_B)) THEN -DO i2 = LBOUND(ModuleMapTypeData%BStC_P_2_ED_P_B,2), UBOUND(ModuleMapTypeData%BStC_P_2_ED_P_B,2) -DO i1 = LBOUND(ModuleMapTypeData%BStC_P_2_ED_P_B,1), UBOUND(ModuleMapTypeData%BStC_P_2_ED_P_B,1) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%BStC_P_2_ED_P_B(i1,i2), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(ModuleMapTypeData%BStC_P_2_ED_P_B) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%BD_L_2_BStC_P_B)) THEN -DO i2 = LBOUND(ModuleMapTypeData%BD_L_2_BStC_P_B,2), UBOUND(ModuleMapTypeData%BD_L_2_BStC_P_B,2) -DO i1 = LBOUND(ModuleMapTypeData%BD_L_2_BStC_P_B,1), UBOUND(ModuleMapTypeData%BD_L_2_BStC_P_B,1) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%BD_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(ModuleMapTypeData%BD_L_2_BStC_P_B) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%BStC_P_2_BD_P_B)) THEN -DO i2 = LBOUND(ModuleMapTypeData%BStC_P_2_BD_P_B,2), UBOUND(ModuleMapTypeData%BStC_P_2_BD_P_B,2) -DO i1 = LBOUND(ModuleMapTypeData%BStC_P_2_BD_P_B,1), UBOUND(ModuleMapTypeData%BStC_P_2_BD_P_B,1) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%BStC_P_2_BD_P_B(i1,i2), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(ModuleMapTypeData%BStC_P_2_BD_P_B) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%SStC_P_P_2_SubStructure)) THEN -DO i1 = LBOUND(ModuleMapTypeData%SStC_P_P_2_SubStructure,1), UBOUND(ModuleMapTypeData%SStC_P_P_2_SubStructure,1) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%SStC_P_P_2_SubStructure(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%SStC_P_P_2_SubStructure) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%SubStructure_2_SStC_P_P)) THEN -DO i1 = LBOUND(ModuleMapTypeData%SubStructure_2_SStC_P_P,1), UBOUND(ModuleMapTypeData%SubStructure_2_SStC_P_P,1) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%SubStructure_2_SStC_P_P(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%SubStructure_2_SStC_P_P) -ENDIF - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_P_2_SrvD_P_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ModuleMapTypeData%BDED_L_2_AD_L_B)) THEN -DO i1 = LBOUND(ModuleMapTypeData%BDED_L_2_AD_L_B,1), UBOUND(ModuleMapTypeData%BDED_L_2_AD_L_B,1) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%BDED_L_2_AD_L_B(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%BDED_L_2_AD_L_B) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%AD_L_2_BDED_B)) THEN -DO i1 = LBOUND(ModuleMapTypeData%AD_L_2_BDED_B,1), UBOUND(ModuleMapTypeData%AD_L_2_BDED_B,1) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%AD_L_2_BDED_B(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%AD_L_2_BDED_B) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%BD_L_2_BD_L)) THEN -DO i1 = LBOUND(ModuleMapTypeData%BD_L_2_BD_L,1), UBOUND(ModuleMapTypeData%BD_L_2_BD_L,1) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%BD_L_2_BD_L(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%BD_L_2_BD_L) -ENDIF - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%AD_P_2_ED_P_N, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%AD_P_2_ED_P_TF, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ModuleMapTypeData%ED_P_2_AD_P_R)) THEN -DO i1 = LBOUND(ModuleMapTypeData%ED_P_2_AD_P_R,1), UBOUND(ModuleMapTypeData%ED_P_2_AD_P_R,1) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%ED_P_2_AD_P_R) -ENDIF - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%AD_P_2_ED_P_H, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%IceF_P_2_SD_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%SDy3_P_2_IceF_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ModuleMapTypeData%IceD_P_2_SD_P)) THEN -DO i1 = LBOUND(ModuleMapTypeData%IceD_P_2_SD_P,1), UBOUND(ModuleMapTypeData%IceD_P_2_SD_P,1) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%IceD_P_2_SD_P(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%IceD_P_2_SD_P) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%SDy3_P_2_IceD_P)) THEN -DO i1 = LBOUND(ModuleMapTypeData%SDy3_P_2_IceD_P,1), UBOUND(ModuleMapTypeData%SDy3_P_2_IceD_P,1) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%SDy3_P_2_IceD_P(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%SDy3_P_2_IceD_P) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%Jacobian_Opt1)) THEN - DEALLOCATE(ModuleMapTypeData%Jacobian_Opt1) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%Jacobian_pivot)) THEN - DEALLOCATE(ModuleMapTypeData%Jacobian_pivot) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%Jac_u_indx)) THEN - DEALLOCATE(ModuleMapTypeData%Jac_u_indx) -ENDIF - CALL MeshDestroy( ModuleMapTypeData%u_ED_NacelleLoads, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( ModuleMapTypeData%SubstructureLoads_Tmp, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( ModuleMapTypeData%SubstructureLoads_Tmp2, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( ModuleMapTypeData%PlatformLoads_Tmp, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( ModuleMapTypeData%PlatformLoads_Tmp2, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( ModuleMapTypeData%SubstructureLoads_Tmp_Farm, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( ModuleMapTypeData%u_ED_TowerPtloads, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ModuleMapTypeData%u_ED_BladePtLoads)) THEN -DO i1 = LBOUND(ModuleMapTypeData%u_ED_BladePtLoads,1), UBOUND(ModuleMapTypeData%u_ED_BladePtLoads,1) - CALL MeshDestroy( ModuleMapTypeData%u_ED_BladePtLoads(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%u_ED_BladePtLoads) -ENDIF - CALL MeshDestroy( ModuleMapTypeData%u_SD_TPMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( ModuleMapTypeData%u_HD_M_Mesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( ModuleMapTypeData%u_HD_W_Mesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( ModuleMapTypeData%u_ED_HubPtLoad, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( ModuleMapTypeData%u_ED_HubPtLoad_2, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ModuleMapTypeData%u_BD_RootMotion)) THEN -DO i1 = LBOUND(ModuleMapTypeData%u_BD_RootMotion,1), UBOUND(ModuleMapTypeData%u_BD_RootMotion,1) - CALL MeshDestroy( ModuleMapTypeData%u_BD_RootMotion(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%u_BD_RootMotion) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%y_BD_BldMotion_4Loads)) THEN -DO i1 = LBOUND(ModuleMapTypeData%y_BD_BldMotion_4Loads,1), UBOUND(ModuleMapTypeData%y_BD_BldMotion_4Loads,1) - CALL MeshDestroy( ModuleMapTypeData%y_BD_BldMotion_4Loads(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%y_BD_BldMotion_4Loads) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%u_BD_Distrload)) THEN -DO i1 = LBOUND(ModuleMapTypeData%u_BD_Distrload,1), UBOUND(ModuleMapTypeData%u_BD_Distrload,1) - CALL MeshDestroy( ModuleMapTypeData%u_BD_Distrload(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%u_BD_Distrload) -ENDIF - CALL MeshDestroy( ModuleMapTypeData%u_Orca_PtfmMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( ModuleMapTypeData%u_ExtPtfm_PtfmMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE FAST_DestroyModuleMapType - subroutine FAST_PackModuleMapType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -14100,7 +13180,6 @@ subroutine FAST_PackModuleMapType(Buf, Indata) integer(IntKi) :: i1, i2 integer(IntKi) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return - ! ED_P_2_BD_P call RegPack(Buf, allocated(InData%ED_P_2_BD_P)) if (allocated(InData%ED_P_2_BD_P)) then call RegPackBounds(Buf, 1, lbound(InData%ED_P_2_BD_P), ubound(InData%ED_P_2_BD_P)) @@ -14111,7 +13190,6 @@ subroutine FAST_PackModuleMapType(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! BD_P_2_ED_P call RegPack(Buf, allocated(InData%BD_P_2_ED_P)) if (allocated(InData%BD_P_2_ED_P)) then call RegPackBounds(Buf, 1, lbound(InData%BD_P_2_ED_P), ubound(InData%BD_P_2_ED_P)) @@ -14122,7 +13200,6 @@ subroutine FAST_PackModuleMapType(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! ED_P_2_BD_P_Hub call RegPack(Buf, allocated(InData%ED_P_2_BD_P_Hub)) if (allocated(InData%ED_P_2_BD_P_Hub)) then call RegPackBounds(Buf, 1, lbound(InData%ED_P_2_BD_P_Hub), ubound(InData%ED_P_2_BD_P_Hub)) @@ -14133,34 +13210,24 @@ subroutine FAST_PackModuleMapType(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! ED_P_2_HD_PRP_P call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_HD_PRP_P) if (RegCheckErr(Buf, RoutineName)) return - ! SubStructure_2_HD_W_P call NWTC_Library_PackMeshMapType(Buf, InData%SubStructure_2_HD_W_P) if (RegCheckErr(Buf, RoutineName)) return - ! HD_W_P_2_SubStructure call NWTC_Library_PackMeshMapType(Buf, InData%HD_W_P_2_SubStructure) if (RegCheckErr(Buf, RoutineName)) return - ! SubStructure_2_HD_M_P call NWTC_Library_PackMeshMapType(Buf, InData%SubStructure_2_HD_M_P) if (RegCheckErr(Buf, RoutineName)) return - ! HD_M_P_2_SubStructure call NWTC_Library_PackMeshMapType(Buf, InData%HD_M_P_2_SubStructure) if (RegCheckErr(Buf, RoutineName)) return - ! Structure_2_Mooring call NWTC_Library_PackMeshMapType(Buf, InData%Structure_2_Mooring) if (RegCheckErr(Buf, RoutineName)) return - ! Mooring_2_Structure call NWTC_Library_PackMeshMapType(Buf, InData%Mooring_2_Structure) if (RegCheckErr(Buf, RoutineName)) return - ! ED_P_2_SD_TP call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_SD_TP) if (RegCheckErr(Buf, RoutineName)) return - ! SD_TP_2_ED_P call NWTC_Library_PackMeshMapType(Buf, InData%SD_TP_2_ED_P) if (RegCheckErr(Buf, RoutineName)) return - ! ED_P_2_NStC_P_N call RegPack(Buf, allocated(InData%ED_P_2_NStC_P_N)) if (allocated(InData%ED_P_2_NStC_P_N)) then call RegPackBounds(Buf, 1, lbound(InData%ED_P_2_NStC_P_N), ubound(InData%ED_P_2_NStC_P_N)) @@ -14171,7 +13238,6 @@ subroutine FAST_PackModuleMapType(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! NStC_P_2_ED_P_N call RegPack(Buf, allocated(InData%NStC_P_2_ED_P_N)) if (allocated(InData%NStC_P_2_ED_P_N)) then call RegPackBounds(Buf, 1, lbound(InData%NStC_P_2_ED_P_N), ubound(InData%NStC_P_2_ED_P_N)) @@ -14182,7 +13248,6 @@ subroutine FAST_PackModuleMapType(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! ED_L_2_TStC_P_T call RegPack(Buf, allocated(InData%ED_L_2_TStC_P_T)) if (allocated(InData%ED_L_2_TStC_P_T)) then call RegPackBounds(Buf, 1, lbound(InData%ED_L_2_TStC_P_T), ubound(InData%ED_L_2_TStC_P_T)) @@ -14193,7 +13258,6 @@ subroutine FAST_PackModuleMapType(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! TStC_P_2_ED_P_T call RegPack(Buf, allocated(InData%TStC_P_2_ED_P_T)) if (allocated(InData%TStC_P_2_ED_P_T)) then call RegPackBounds(Buf, 1, lbound(InData%TStC_P_2_ED_P_T), ubound(InData%TStC_P_2_ED_P_T)) @@ -14204,7 +13268,6 @@ subroutine FAST_PackModuleMapType(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! ED_L_2_BStC_P_B call RegPack(Buf, allocated(InData%ED_L_2_BStC_P_B)) if (allocated(InData%ED_L_2_BStC_P_B)) then call RegPackBounds(Buf, 2, lbound(InData%ED_L_2_BStC_P_B), ubound(InData%ED_L_2_BStC_P_B)) @@ -14217,7 +13280,6 @@ subroutine FAST_PackModuleMapType(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! BStC_P_2_ED_P_B call RegPack(Buf, allocated(InData%BStC_P_2_ED_P_B)) if (allocated(InData%BStC_P_2_ED_P_B)) then call RegPackBounds(Buf, 2, lbound(InData%BStC_P_2_ED_P_B), ubound(InData%BStC_P_2_ED_P_B)) @@ -14230,7 +13292,6 @@ subroutine FAST_PackModuleMapType(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! BD_L_2_BStC_P_B call RegPack(Buf, allocated(InData%BD_L_2_BStC_P_B)) if (allocated(InData%BD_L_2_BStC_P_B)) then call RegPackBounds(Buf, 2, lbound(InData%BD_L_2_BStC_P_B), ubound(InData%BD_L_2_BStC_P_B)) @@ -14243,7 +13304,6 @@ subroutine FAST_PackModuleMapType(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! BStC_P_2_BD_P_B call RegPack(Buf, allocated(InData%BStC_P_2_BD_P_B)) if (allocated(InData%BStC_P_2_BD_P_B)) then call RegPackBounds(Buf, 2, lbound(InData%BStC_P_2_BD_P_B), ubound(InData%BStC_P_2_BD_P_B)) @@ -14256,7 +13316,6 @@ subroutine FAST_PackModuleMapType(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! SStC_P_P_2_SubStructure call RegPack(Buf, allocated(InData%SStC_P_P_2_SubStructure)) if (allocated(InData%SStC_P_P_2_SubStructure)) then call RegPackBounds(Buf, 1, lbound(InData%SStC_P_P_2_SubStructure), ubound(InData%SStC_P_P_2_SubStructure)) @@ -14267,7 +13326,6 @@ subroutine FAST_PackModuleMapType(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! SubStructure_2_SStC_P_P call RegPack(Buf, allocated(InData%SubStructure_2_SStC_P_P)) if (allocated(InData%SubStructure_2_SStC_P_P)) then call RegPackBounds(Buf, 1, lbound(InData%SubStructure_2_SStC_P_P), ubound(InData%SubStructure_2_SStC_P_P)) @@ -14278,10 +13336,8 @@ subroutine FAST_PackModuleMapType(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! ED_P_2_SrvD_P_P call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_SrvD_P_P) if (RegCheckErr(Buf, RoutineName)) return - ! BDED_L_2_AD_L_B call RegPack(Buf, allocated(InData%BDED_L_2_AD_L_B)) if (allocated(InData%BDED_L_2_AD_L_B)) then call RegPackBounds(Buf, 1, lbound(InData%BDED_L_2_AD_L_B), ubound(InData%BDED_L_2_AD_L_B)) @@ -14292,7 +13348,6 @@ subroutine FAST_PackModuleMapType(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! AD_L_2_BDED_B call RegPack(Buf, allocated(InData%AD_L_2_BDED_B)) if (allocated(InData%AD_L_2_BDED_B)) then call RegPackBounds(Buf, 1, lbound(InData%AD_L_2_BDED_B), ubound(InData%AD_L_2_BDED_B)) @@ -14303,7 +13358,6 @@ subroutine FAST_PackModuleMapType(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! BD_L_2_BD_L call RegPack(Buf, allocated(InData%BD_L_2_BD_L)) if (allocated(InData%BD_L_2_BD_L)) then call RegPackBounds(Buf, 1, lbound(InData%BD_L_2_BD_L), ubound(InData%BD_L_2_BD_L)) @@ -14314,25 +13368,18 @@ subroutine FAST_PackModuleMapType(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! ED_P_2_AD_P_N call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_AD_P_N) if (RegCheckErr(Buf, RoutineName)) return - ! AD_P_2_ED_P_N call NWTC_Library_PackMeshMapType(Buf, InData%AD_P_2_ED_P_N) if (RegCheckErr(Buf, RoutineName)) return - ! ED_P_2_AD_P_TF call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_AD_P_TF) if (RegCheckErr(Buf, RoutineName)) return - ! AD_P_2_ED_P_TF call NWTC_Library_PackMeshMapType(Buf, InData%AD_P_2_ED_P_TF) if (RegCheckErr(Buf, RoutineName)) return - ! ED_L_2_AD_L_T call NWTC_Library_PackMeshMapType(Buf, InData%ED_L_2_AD_L_T) if (RegCheckErr(Buf, RoutineName)) return - ! AD_L_2_ED_P_T call NWTC_Library_PackMeshMapType(Buf, InData%AD_L_2_ED_P_T) if (RegCheckErr(Buf, RoutineName)) return - ! ED_P_2_AD_P_R call RegPack(Buf, allocated(InData%ED_P_2_AD_P_R)) if (allocated(InData%ED_P_2_AD_P_R)) then call RegPackBounds(Buf, 1, lbound(InData%ED_P_2_AD_P_R), ubound(InData%ED_P_2_AD_P_R)) @@ -14343,19 +13390,14 @@ subroutine FAST_PackModuleMapType(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! ED_P_2_AD_P_H call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_AD_P_H) if (RegCheckErr(Buf, RoutineName)) return - ! AD_P_2_ED_P_H call NWTC_Library_PackMeshMapType(Buf, InData%AD_P_2_ED_P_H) if (RegCheckErr(Buf, RoutineName)) return - ! IceF_P_2_SD_P call NWTC_Library_PackMeshMapType(Buf, InData%IceF_P_2_SD_P) if (RegCheckErr(Buf, RoutineName)) return - ! SDy3_P_2_IceF_P call NWTC_Library_PackMeshMapType(Buf, InData%SDy3_P_2_IceF_P) if (RegCheckErr(Buf, RoutineName)) return - ! IceD_P_2_SD_P call RegPack(Buf, allocated(InData%IceD_P_2_SD_P)) if (allocated(InData%IceD_P_2_SD_P)) then call RegPackBounds(Buf, 1, lbound(InData%IceD_P_2_SD_P), ubound(InData%IceD_P_2_SD_P)) @@ -14366,7 +13408,6 @@ subroutine FAST_PackModuleMapType(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! SDy3_P_2_IceD_P call RegPack(Buf, allocated(InData%SDy3_P_2_IceD_P)) if (allocated(InData%SDy3_P_2_IceD_P)) then call RegPackBounds(Buf, 1, lbound(InData%SDy3_P_2_IceD_P), ubound(InData%SDy3_P_2_IceD_P)) @@ -14377,49 +13418,38 @@ subroutine FAST_PackModuleMapType(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! Jacobian_Opt1 call RegPack(Buf, allocated(InData%Jacobian_Opt1)) if (allocated(InData%Jacobian_Opt1)) then call RegPackBounds(Buf, 2, lbound(InData%Jacobian_Opt1), ubound(InData%Jacobian_Opt1)) call RegPack(Buf, InData%Jacobian_Opt1) end if if (RegCheckErr(Buf, RoutineName)) return - ! Jacobian_pivot call RegPack(Buf, allocated(InData%Jacobian_pivot)) if (allocated(InData%Jacobian_pivot)) then call RegPackBounds(Buf, 1, lbound(InData%Jacobian_pivot), ubound(InData%Jacobian_pivot)) call RegPack(Buf, InData%Jacobian_pivot) end if if (RegCheckErr(Buf, RoutineName)) return - ! Jac_u_indx call RegPack(Buf, allocated(InData%Jac_u_indx)) if (allocated(InData%Jac_u_indx)) then call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx), ubound(InData%Jac_u_indx)) call RegPack(Buf, InData%Jac_u_indx) end if if (RegCheckErr(Buf, RoutineName)) return - ! u_ED_NacelleLoads call MeshPack(Buf, InData%u_ED_NacelleLoads) if (RegCheckErr(Buf, RoutineName)) return - ! SubstructureLoads_Tmp call MeshPack(Buf, InData%SubstructureLoads_Tmp) if (RegCheckErr(Buf, RoutineName)) return - ! SubstructureLoads_Tmp2 call MeshPack(Buf, InData%SubstructureLoads_Tmp2) if (RegCheckErr(Buf, RoutineName)) return - ! PlatformLoads_Tmp call MeshPack(Buf, InData%PlatformLoads_Tmp) if (RegCheckErr(Buf, RoutineName)) return - ! PlatformLoads_Tmp2 call MeshPack(Buf, InData%PlatformLoads_Tmp2) if (RegCheckErr(Buf, RoutineName)) return - ! SubstructureLoads_Tmp_Farm call MeshPack(Buf, InData%SubstructureLoads_Tmp_Farm) if (RegCheckErr(Buf, RoutineName)) return - ! u_ED_TowerPtloads call MeshPack(Buf, InData%u_ED_TowerPtloads) if (RegCheckErr(Buf, RoutineName)) return - ! u_ED_BladePtLoads call RegPack(Buf, allocated(InData%u_ED_BladePtLoads)) if (allocated(InData%u_ED_BladePtLoads)) then call RegPackBounds(Buf, 1, lbound(InData%u_ED_BladePtLoads), ubound(InData%u_ED_BladePtLoads)) @@ -14430,22 +13460,16 @@ subroutine FAST_PackModuleMapType(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! u_SD_TPMesh call MeshPack(Buf, InData%u_SD_TPMesh) if (RegCheckErr(Buf, RoutineName)) return - ! u_HD_M_Mesh call MeshPack(Buf, InData%u_HD_M_Mesh) if (RegCheckErr(Buf, RoutineName)) return - ! u_HD_W_Mesh call MeshPack(Buf, InData%u_HD_W_Mesh) if (RegCheckErr(Buf, RoutineName)) return - ! u_ED_HubPtLoad call MeshPack(Buf, InData%u_ED_HubPtLoad) if (RegCheckErr(Buf, RoutineName)) return - ! u_ED_HubPtLoad_2 call MeshPack(Buf, InData%u_ED_HubPtLoad_2) if (RegCheckErr(Buf, RoutineName)) return - ! u_BD_RootMotion call RegPack(Buf, allocated(InData%u_BD_RootMotion)) if (allocated(InData%u_BD_RootMotion)) then call RegPackBounds(Buf, 1, lbound(InData%u_BD_RootMotion), ubound(InData%u_BD_RootMotion)) @@ -14456,7 +13480,6 @@ subroutine FAST_PackModuleMapType(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! y_BD_BldMotion_4Loads call RegPack(Buf, allocated(InData%y_BD_BldMotion_4Loads)) if (allocated(InData%y_BD_BldMotion_4Loads)) then call RegPackBounds(Buf, 1, lbound(InData%y_BD_BldMotion_4Loads), ubound(InData%y_BD_BldMotion_4Loads)) @@ -14467,7 +13490,6 @@ subroutine FAST_PackModuleMapType(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! u_BD_Distrload call RegPack(Buf, allocated(InData%u_BD_Distrload)) if (allocated(InData%u_BD_Distrload)) then call RegPackBounds(Buf, 1, lbound(InData%u_BD_Distrload), ubound(InData%u_BD_Distrload)) @@ -14478,10 +13500,8 @@ subroutine FAST_PackModuleMapType(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! u_Orca_PtfmMesh call MeshPack(Buf, InData%u_Orca_PtfmMesh) if (RegCheckErr(Buf, RoutineName)) return - ! u_ExtPtfm_PtfmMesh call MeshPack(Buf, InData%u_ExtPtfm_PtfmMesh) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -14495,7 +13515,6 @@ subroutine FAST_UnPackModuleMapType(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! ED_P_2_BD_P if (allocated(OutData%ED_P_2_BD_P)) deallocate(OutData%ED_P_2_BD_P) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -14511,7 +13530,6 @@ subroutine FAST_UnPackModuleMapType(Buf, OutData) call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_BD_P(i1)) ! ED_P_2_BD_P end do end if - ! BD_P_2_ED_P if (allocated(OutData%BD_P_2_ED_P)) deallocate(OutData%BD_P_2_ED_P) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -14527,7 +13545,6 @@ subroutine FAST_UnPackModuleMapType(Buf, OutData) call NWTC_Library_UnpackMeshMapType(Buf, OutData%BD_P_2_ED_P(i1)) ! BD_P_2_ED_P end do end if - ! ED_P_2_BD_P_Hub if (allocated(OutData%ED_P_2_BD_P_Hub)) deallocate(OutData%ED_P_2_BD_P_Hub) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -14543,25 +13560,15 @@ subroutine FAST_UnPackModuleMapType(Buf, OutData) call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_BD_P_Hub(i1)) ! ED_P_2_BD_P_Hub end do end if - ! ED_P_2_HD_PRP_P call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_HD_PRP_P) ! ED_P_2_HD_PRP_P - ! SubStructure_2_HD_W_P call NWTC_Library_UnpackMeshMapType(Buf, OutData%SubStructure_2_HD_W_P) ! SubStructure_2_HD_W_P - ! HD_W_P_2_SubStructure call NWTC_Library_UnpackMeshMapType(Buf, OutData%HD_W_P_2_SubStructure) ! HD_W_P_2_SubStructure - ! SubStructure_2_HD_M_P call NWTC_Library_UnpackMeshMapType(Buf, OutData%SubStructure_2_HD_M_P) ! SubStructure_2_HD_M_P - ! HD_M_P_2_SubStructure call NWTC_Library_UnpackMeshMapType(Buf, OutData%HD_M_P_2_SubStructure) ! HD_M_P_2_SubStructure - ! Structure_2_Mooring call NWTC_Library_UnpackMeshMapType(Buf, OutData%Structure_2_Mooring) ! Structure_2_Mooring - ! Mooring_2_Structure call NWTC_Library_UnpackMeshMapType(Buf, OutData%Mooring_2_Structure) ! Mooring_2_Structure - ! ED_P_2_SD_TP call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_SD_TP) ! ED_P_2_SD_TP - ! SD_TP_2_ED_P call NWTC_Library_UnpackMeshMapType(Buf, OutData%SD_TP_2_ED_P) ! SD_TP_2_ED_P - ! ED_P_2_NStC_P_N if (allocated(OutData%ED_P_2_NStC_P_N)) deallocate(OutData%ED_P_2_NStC_P_N) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -14577,7 +13584,6 @@ subroutine FAST_UnPackModuleMapType(Buf, OutData) call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_NStC_P_N(i1)) ! ED_P_2_NStC_P_N end do end if - ! NStC_P_2_ED_P_N if (allocated(OutData%NStC_P_2_ED_P_N)) deallocate(OutData%NStC_P_2_ED_P_N) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -14593,7 +13599,6 @@ subroutine FAST_UnPackModuleMapType(Buf, OutData) call NWTC_Library_UnpackMeshMapType(Buf, OutData%NStC_P_2_ED_P_N(i1)) ! NStC_P_2_ED_P_N end do end if - ! ED_L_2_TStC_P_T if (allocated(OutData%ED_L_2_TStC_P_T)) deallocate(OutData%ED_L_2_TStC_P_T) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -14609,7 +13614,6 @@ subroutine FAST_UnPackModuleMapType(Buf, OutData) call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_L_2_TStC_P_T(i1)) ! ED_L_2_TStC_P_T end do end if - ! TStC_P_2_ED_P_T if (allocated(OutData%TStC_P_2_ED_P_T)) deallocate(OutData%TStC_P_2_ED_P_T) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -14625,7 +13629,6 @@ subroutine FAST_UnPackModuleMapType(Buf, OutData) call NWTC_Library_UnpackMeshMapType(Buf, OutData%TStC_P_2_ED_P_T(i1)) ! TStC_P_2_ED_P_T end do end if - ! ED_L_2_BStC_P_B if (allocated(OutData%ED_L_2_BStC_P_B)) deallocate(OutData%ED_L_2_BStC_P_B) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -14643,7 +13646,6 @@ subroutine FAST_UnPackModuleMapType(Buf, OutData) end do end do end if - ! BStC_P_2_ED_P_B if (allocated(OutData%BStC_P_2_ED_P_B)) deallocate(OutData%BStC_P_2_ED_P_B) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -14661,7 +13663,6 @@ subroutine FAST_UnPackModuleMapType(Buf, OutData) end do end do end if - ! BD_L_2_BStC_P_B if (allocated(OutData%BD_L_2_BStC_P_B)) deallocate(OutData%BD_L_2_BStC_P_B) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -14679,7 +13680,6 @@ subroutine FAST_UnPackModuleMapType(Buf, OutData) end do end do end if - ! BStC_P_2_BD_P_B if (allocated(OutData%BStC_P_2_BD_P_B)) deallocate(OutData%BStC_P_2_BD_P_B) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -14697,7 +13697,6 @@ subroutine FAST_UnPackModuleMapType(Buf, OutData) end do end do end if - ! SStC_P_P_2_SubStructure if (allocated(OutData%SStC_P_P_2_SubStructure)) deallocate(OutData%SStC_P_P_2_SubStructure) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -14713,7 +13712,6 @@ subroutine FAST_UnPackModuleMapType(Buf, OutData) call NWTC_Library_UnpackMeshMapType(Buf, OutData%SStC_P_P_2_SubStructure(i1)) ! SStC_P_P_2_SubStructure end do end if - ! SubStructure_2_SStC_P_P if (allocated(OutData%SubStructure_2_SStC_P_P)) deallocate(OutData%SubStructure_2_SStC_P_P) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -14729,9 +13727,7 @@ subroutine FAST_UnPackModuleMapType(Buf, OutData) call NWTC_Library_UnpackMeshMapType(Buf, OutData%SubStructure_2_SStC_P_P(i1)) ! SubStructure_2_SStC_P_P end do end if - ! ED_P_2_SrvD_P_P call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_SrvD_P_P) ! ED_P_2_SrvD_P_P - ! BDED_L_2_AD_L_B if (allocated(OutData%BDED_L_2_AD_L_B)) deallocate(OutData%BDED_L_2_AD_L_B) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -14747,7 +13743,6 @@ subroutine FAST_UnPackModuleMapType(Buf, OutData) call NWTC_Library_UnpackMeshMapType(Buf, OutData%BDED_L_2_AD_L_B(i1)) ! BDED_L_2_AD_L_B end do end if - ! AD_L_2_BDED_B if (allocated(OutData%AD_L_2_BDED_B)) deallocate(OutData%AD_L_2_BDED_B) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -14763,7 +13758,6 @@ subroutine FAST_UnPackModuleMapType(Buf, OutData) call NWTC_Library_UnpackMeshMapType(Buf, OutData%AD_L_2_BDED_B(i1)) ! AD_L_2_BDED_B end do end if - ! BD_L_2_BD_L if (allocated(OutData%BD_L_2_BD_L)) deallocate(OutData%BD_L_2_BD_L) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -14779,19 +13773,12 @@ subroutine FAST_UnPackModuleMapType(Buf, OutData) call NWTC_Library_UnpackMeshMapType(Buf, OutData%BD_L_2_BD_L(i1)) ! BD_L_2_BD_L end do end if - ! ED_P_2_AD_P_N call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_AD_P_N) ! ED_P_2_AD_P_N - ! AD_P_2_ED_P_N call NWTC_Library_UnpackMeshMapType(Buf, OutData%AD_P_2_ED_P_N) ! AD_P_2_ED_P_N - ! ED_P_2_AD_P_TF call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_AD_P_TF) ! ED_P_2_AD_P_TF - ! AD_P_2_ED_P_TF call NWTC_Library_UnpackMeshMapType(Buf, OutData%AD_P_2_ED_P_TF) ! AD_P_2_ED_P_TF - ! ED_L_2_AD_L_T call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_L_2_AD_L_T) ! ED_L_2_AD_L_T - ! AD_L_2_ED_P_T call NWTC_Library_UnpackMeshMapType(Buf, OutData%AD_L_2_ED_P_T) ! AD_L_2_ED_P_T - ! ED_P_2_AD_P_R if (allocated(OutData%ED_P_2_AD_P_R)) deallocate(OutData%ED_P_2_AD_P_R) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -14807,15 +13794,10 @@ subroutine FAST_UnPackModuleMapType(Buf, OutData) call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_AD_P_R(i1)) ! ED_P_2_AD_P_R end do end if - ! ED_P_2_AD_P_H call NWTC_Library_UnpackMeshMapType(Buf, OutData%ED_P_2_AD_P_H) ! ED_P_2_AD_P_H - ! AD_P_2_ED_P_H call NWTC_Library_UnpackMeshMapType(Buf, OutData%AD_P_2_ED_P_H) ! AD_P_2_ED_P_H - ! IceF_P_2_SD_P call NWTC_Library_UnpackMeshMapType(Buf, OutData%IceF_P_2_SD_P) ! IceF_P_2_SD_P - ! SDy3_P_2_IceF_P call NWTC_Library_UnpackMeshMapType(Buf, OutData%SDy3_P_2_IceF_P) ! SDy3_P_2_IceF_P - ! IceD_P_2_SD_P if (allocated(OutData%IceD_P_2_SD_P)) deallocate(OutData%IceD_P_2_SD_P) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -14831,7 +13813,6 @@ subroutine FAST_UnPackModuleMapType(Buf, OutData) call NWTC_Library_UnpackMeshMapType(Buf, OutData%IceD_P_2_SD_P(i1)) ! IceD_P_2_SD_P end do end if - ! SDy3_P_2_IceD_P if (allocated(OutData%SDy3_P_2_IceD_P)) deallocate(OutData%SDy3_P_2_IceD_P) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -14847,7 +13828,6 @@ subroutine FAST_UnPackModuleMapType(Buf, OutData) call NWTC_Library_UnpackMeshMapType(Buf, OutData%SDy3_P_2_IceD_P(i1)) ! SDy3_P_2_IceD_P end do end if - ! Jacobian_Opt1 if (allocated(OutData%Jacobian_Opt1)) deallocate(OutData%Jacobian_Opt1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -14862,7 +13842,6 @@ subroutine FAST_UnPackModuleMapType(Buf, OutData) call RegUnpack(Buf, OutData%Jacobian_Opt1) if (RegCheckErr(Buf, RoutineName)) return end if - ! Jacobian_pivot if (allocated(OutData%Jacobian_pivot)) deallocate(OutData%Jacobian_pivot) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -14877,7 +13856,6 @@ subroutine FAST_UnPackModuleMapType(Buf, OutData) call RegUnpack(Buf, OutData%Jacobian_pivot) if (RegCheckErr(Buf, RoutineName)) return end if - ! Jac_u_indx if (allocated(OutData%Jac_u_indx)) deallocate(OutData%Jac_u_indx) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -14892,21 +13870,13 @@ subroutine FAST_UnPackModuleMapType(Buf, OutData) call RegUnpack(Buf, OutData%Jac_u_indx) if (RegCheckErr(Buf, RoutineName)) return end if - ! u_ED_NacelleLoads call MeshUnpack(Buf, OutData%u_ED_NacelleLoads) ! u_ED_NacelleLoads - ! SubstructureLoads_Tmp call MeshUnpack(Buf, OutData%SubstructureLoads_Tmp) ! SubstructureLoads_Tmp - ! SubstructureLoads_Tmp2 call MeshUnpack(Buf, OutData%SubstructureLoads_Tmp2) ! SubstructureLoads_Tmp2 - ! PlatformLoads_Tmp call MeshUnpack(Buf, OutData%PlatformLoads_Tmp) ! PlatformLoads_Tmp - ! PlatformLoads_Tmp2 call MeshUnpack(Buf, OutData%PlatformLoads_Tmp2) ! PlatformLoads_Tmp2 - ! SubstructureLoads_Tmp_Farm call MeshUnpack(Buf, OutData%SubstructureLoads_Tmp_Farm) ! SubstructureLoads_Tmp_Farm - ! u_ED_TowerPtloads call MeshUnpack(Buf, OutData%u_ED_TowerPtloads) ! u_ED_TowerPtloads - ! u_ED_BladePtLoads if (allocated(OutData%u_ED_BladePtLoads)) deallocate(OutData%u_ED_BladePtLoads) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -14922,17 +13892,11 @@ subroutine FAST_UnPackModuleMapType(Buf, OutData) call MeshUnpack(Buf, OutData%u_ED_BladePtLoads(i1)) ! u_ED_BladePtLoads end do end if - ! u_SD_TPMesh call MeshUnpack(Buf, OutData%u_SD_TPMesh) ! u_SD_TPMesh - ! u_HD_M_Mesh call MeshUnpack(Buf, OutData%u_HD_M_Mesh) ! u_HD_M_Mesh - ! u_HD_W_Mesh call MeshUnpack(Buf, OutData%u_HD_W_Mesh) ! u_HD_W_Mesh - ! u_ED_HubPtLoad call MeshUnpack(Buf, OutData%u_ED_HubPtLoad) ! u_ED_HubPtLoad - ! u_ED_HubPtLoad_2 call MeshUnpack(Buf, OutData%u_ED_HubPtLoad_2) ! u_ED_HubPtLoad_2 - ! u_BD_RootMotion if (allocated(OutData%u_BD_RootMotion)) deallocate(OutData%u_BD_RootMotion) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -14948,7 +13912,6 @@ subroutine FAST_UnPackModuleMapType(Buf, OutData) call MeshUnpack(Buf, OutData%u_BD_RootMotion(i1)) ! u_BD_RootMotion end do end if - ! y_BD_BldMotion_4Loads if (allocated(OutData%y_BD_BldMotion_4Loads)) deallocate(OutData%y_BD_BldMotion_4Loads) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -14964,7 +13927,6 @@ subroutine FAST_UnPackModuleMapType(Buf, OutData) call MeshUnpack(Buf, OutData%y_BD_BldMotion_4Loads(i1)) ! y_BD_BldMotion_4Loads end do end if - ! u_BD_Distrload if (allocated(OutData%u_BD_Distrload)) deallocate(OutData%u_BD_Distrload) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -14980,87 +13942,63 @@ subroutine FAST_UnPackModuleMapType(Buf, OutData) call MeshUnpack(Buf, OutData%u_BD_Distrload(i1)) ! u_BD_Distrload end do end if - ! u_Orca_PtfmMesh call MeshUnpack(Buf, OutData%u_Orca_PtfmMesh) ! u_Orca_PtfmMesh - ! u_ExtPtfm_PtfmMesh call MeshUnpack(Buf, OutData%u_ExtPtfm_PtfmMesh) ! u_ExtPtfm_PtfmMesh end subroutine - SUBROUTINE FAST_CopyExternInputType( SrcExternInputTypeData, DstExternInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_ExternInputType), INTENT(IN) :: SrcExternInputTypeData - TYPE(FAST_ExternInputType), INTENT(INOUT) :: DstExternInputTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyExternInputType' -! + +subroutine FAST_CopyExternInputType(SrcExternInputTypeData, DstExternInputTypeData, CtrlCode, ErrStat, ErrMsg) + type(FAST_ExternInputType), intent(in) :: SrcExternInputTypeData + type(FAST_ExternInputType), intent(inout) :: DstExternInputTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FAST_CopyExternInputType' ErrStat = ErrID_None - ErrMsg = "" - DstExternInputTypeData%GenTrq = SrcExternInputTypeData%GenTrq - DstExternInputTypeData%ElecPwr = SrcExternInputTypeData%ElecPwr - DstExternInputTypeData%YawPosCom = SrcExternInputTypeData%YawPosCom - DstExternInputTypeData%YawRateCom = SrcExternInputTypeData%YawRateCom - DstExternInputTypeData%BlPitchCom = SrcExternInputTypeData%BlPitchCom - DstExternInputTypeData%BlAirfoilCom = SrcExternInputTypeData%BlAirfoilCom - DstExternInputTypeData%HSSBrFrac = SrcExternInputTypeData%HSSBrFrac - DstExternInputTypeData%LidarFocus = SrcExternInputTypeData%LidarFocus - DstExternInputTypeData%CableDeltaL = SrcExternInputTypeData%CableDeltaL - DstExternInputTypeData%CableDeltaLdot = SrcExternInputTypeData%CableDeltaLdot - END SUBROUTINE FAST_CopyExternInputType - - SUBROUTINE FAST_DestroyExternInputType( ExternInputTypeData, ErrStat, ErrMsg ) - TYPE(FAST_ExternInputType), INTENT(INOUT) :: ExternInputTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyExternInputType' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE FAST_DestroyExternInputType + ErrMsg = '' + DstExternInputTypeData%GenTrq = SrcExternInputTypeData%GenTrq + DstExternInputTypeData%ElecPwr = SrcExternInputTypeData%ElecPwr + DstExternInputTypeData%YawPosCom = SrcExternInputTypeData%YawPosCom + DstExternInputTypeData%YawRateCom = SrcExternInputTypeData%YawRateCom + DstExternInputTypeData%BlPitchCom = SrcExternInputTypeData%BlPitchCom + DstExternInputTypeData%BlAirfoilCom = SrcExternInputTypeData%BlAirfoilCom + DstExternInputTypeData%HSSBrFrac = SrcExternInputTypeData%HSSBrFrac + DstExternInputTypeData%LidarFocus = SrcExternInputTypeData%LidarFocus + DstExternInputTypeData%CableDeltaL = SrcExternInputTypeData%CableDeltaL + DstExternInputTypeData%CableDeltaLdot = SrcExternInputTypeData%CableDeltaLdot +end subroutine +subroutine FAST_DestroyExternInputType(ExternInputTypeData, ErrStat, ErrMsg) + type(FAST_ExternInputType), intent(inout) :: ExternInputTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FAST_DestroyExternInputType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine FAST_PackExternInputType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FAST_ExternInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackExternInputType' if (Buf%ErrStat >= AbortErrLev) return - ! GenTrq call RegPack(Buf, InData%GenTrq) if (RegCheckErr(Buf, RoutineName)) return - ! ElecPwr call RegPack(Buf, InData%ElecPwr) if (RegCheckErr(Buf, RoutineName)) return - ! YawPosCom call RegPack(Buf, InData%YawPosCom) if (RegCheckErr(Buf, RoutineName)) return - ! YawRateCom call RegPack(Buf, InData%YawRateCom) if (RegCheckErr(Buf, RoutineName)) return - ! BlPitchCom call RegPack(Buf, InData%BlPitchCom) if (RegCheckErr(Buf, RoutineName)) return - ! BlAirfoilCom call RegPack(Buf, InData%BlAirfoilCom) if (RegCheckErr(Buf, RoutineName)) return - ! HSSBrFrac call RegPack(Buf, InData%HSSBrFrac) if (RegCheckErr(Buf, RoutineName)) return - ! LidarFocus call RegPack(Buf, InData%LidarFocus) if (RegCheckErr(Buf, RoutineName)) return - ! CableDeltaL call RegPack(Buf, InData%CableDeltaL) if (RegCheckErr(Buf, RoutineName)) return - ! CableDeltaLdot call RegPack(Buf, InData%CableDeltaLdot) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -15070,125 +14008,92 @@ subroutine FAST_UnPackExternInputType(Buf, OutData) type(FAST_ExternInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackExternInputType' if (Buf%ErrStat /= ErrID_None) return - ! GenTrq call RegUnpack(Buf, OutData%GenTrq) if (RegCheckErr(Buf, RoutineName)) return - ! ElecPwr call RegUnpack(Buf, OutData%ElecPwr) if (RegCheckErr(Buf, RoutineName)) return - ! YawPosCom call RegUnpack(Buf, OutData%YawPosCom) if (RegCheckErr(Buf, RoutineName)) return - ! YawRateCom call RegUnpack(Buf, OutData%YawRateCom) if (RegCheckErr(Buf, RoutineName)) return - ! BlPitchCom call RegUnpack(Buf, OutData%BlPitchCom) if (RegCheckErr(Buf, RoutineName)) return - ! BlAirfoilCom call RegUnpack(Buf, OutData%BlAirfoilCom) if (RegCheckErr(Buf, RoutineName)) return - ! HSSBrFrac call RegUnpack(Buf, OutData%HSSBrFrac) if (RegCheckErr(Buf, RoutineName)) return - ! LidarFocus call RegUnpack(Buf, OutData%LidarFocus) if (RegCheckErr(Buf, RoutineName)) return - ! CableDeltaL call RegUnpack(Buf, OutData%CableDeltaL) if (RegCheckErr(Buf, RoutineName)) return - ! CableDeltaLdot call RegUnpack(Buf, OutData%CableDeltaLdot) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE FAST_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(FAST_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyMisc' -! + +subroutine FAST_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(FAST_MiscVarType), intent(in) :: SrcMiscData + type(FAST_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyMisc' ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%TiLstPrn = SrcMiscData%TiLstPrn - DstMiscData%t_global = SrcMiscData%t_global - DstMiscData%NextJacCalcTime = SrcMiscData%NextJacCalcTime - DstMiscData%PrevClockTime = SrcMiscData%PrevClockTime - DstMiscData%UsrTime1 = SrcMiscData%UsrTime1 - DstMiscData%UsrTime2 = SrcMiscData%UsrTime2 - DstMiscData%StrtTime = SrcMiscData%StrtTime - DstMiscData%SimStrtTime = SrcMiscData%SimStrtTime - DstMiscData%calcJacobian = SrcMiscData%calcJacobian - CALL FAST_Copyexterninputtype( SrcMiscData%ExternInput, DstMiscData%ExternInput, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copymisclintype( SrcMiscData%Lin, DstMiscData%Lin, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE FAST_CopyMisc - - SUBROUTINE FAST_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(FAST_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL FAST_DestroyExternInputType( MiscData%ExternInput, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroyMiscLinType( MiscData%Lin, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE FAST_DestroyMisc + ErrMsg = '' + DstMiscData%TiLstPrn = SrcMiscData%TiLstPrn + DstMiscData%t_global = SrcMiscData%t_global + DstMiscData%NextJacCalcTime = SrcMiscData%NextJacCalcTime + DstMiscData%PrevClockTime = SrcMiscData%PrevClockTime + DstMiscData%UsrTime1 = SrcMiscData%UsrTime1 + DstMiscData%UsrTime2 = SrcMiscData%UsrTime2 + DstMiscData%StrtTime = SrcMiscData%StrtTime + DstMiscData%SimStrtTime = SrcMiscData%SimStrtTime + DstMiscData%calcJacobian = SrcMiscData%calcJacobian + call FAST_CopyExternInputType(SrcMiscData%ExternInput, DstMiscData%ExternInput, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyMiscLinType(SrcMiscData%Lin, DstMiscData%Lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine FAST_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(FAST_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine FAST_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FAST_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackMisc' if (Buf%ErrStat >= AbortErrLev) return - ! TiLstPrn call RegPack(Buf, InData%TiLstPrn) if (RegCheckErr(Buf, RoutineName)) return - ! t_global call RegPack(Buf, InData%t_global) if (RegCheckErr(Buf, RoutineName)) return - ! NextJacCalcTime call RegPack(Buf, InData%NextJacCalcTime) if (RegCheckErr(Buf, RoutineName)) return - ! PrevClockTime call RegPack(Buf, InData%PrevClockTime) if (RegCheckErr(Buf, RoutineName)) return - ! UsrTime1 call RegPack(Buf, InData%UsrTime1) if (RegCheckErr(Buf, RoutineName)) return - ! UsrTime2 call RegPack(Buf, InData%UsrTime2) if (RegCheckErr(Buf, RoutineName)) return - ! StrtTime call RegPack(Buf, InData%StrtTime) if (RegCheckErr(Buf, RoutineName)) return - ! SimStrtTime call RegPack(Buf, InData%SimStrtTime) if (RegCheckErr(Buf, RoutineName)) return - ! calcJacobian call RegPack(Buf, InData%calcJacobian) if (RegCheckErr(Buf, RoutineName)) return - ! ExternInput call FAST_PackExternInputType(Buf, InData%ExternInput) if (RegCheckErr(Buf, RoutineName)) return - ! Lin call FAST_PackMiscLinType(Buf, InData%Lin) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -15198,258 +14103,181 @@ subroutine FAST_UnPackMisc(Buf, OutData) type(FAST_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackMisc' if (Buf%ErrStat /= ErrID_None) return - ! TiLstPrn call RegUnpack(Buf, OutData%TiLstPrn) if (RegCheckErr(Buf, RoutineName)) return - ! t_global call RegUnpack(Buf, OutData%t_global) if (RegCheckErr(Buf, RoutineName)) return - ! NextJacCalcTime call RegUnpack(Buf, OutData%NextJacCalcTime) if (RegCheckErr(Buf, RoutineName)) return - ! PrevClockTime call RegUnpack(Buf, OutData%PrevClockTime) if (RegCheckErr(Buf, RoutineName)) return - ! UsrTime1 call RegUnpack(Buf, OutData%UsrTime1) if (RegCheckErr(Buf, RoutineName)) return - ! UsrTime2 call RegUnpack(Buf, OutData%UsrTime2) if (RegCheckErr(Buf, RoutineName)) return - ! StrtTime call RegUnpack(Buf, OutData%StrtTime) if (RegCheckErr(Buf, RoutineName)) return - ! SimStrtTime call RegUnpack(Buf, OutData%SimStrtTime) if (RegCheckErr(Buf, RoutineName)) return - ! calcJacobian call RegUnpack(Buf, OutData%calcJacobian) if (RegCheckErr(Buf, RoutineName)) return - ! ExternInput call FAST_UnpackExternInputType(Buf, OutData%ExternInput) ! ExternInput - ! Lin call FAST_UnpackMiscLinType(Buf, OutData%Lin) ! Lin end subroutine - SUBROUTINE FAST_CopyInitData( SrcInitDataData, DstInitDataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_InitData), INTENT(INOUT) :: SrcInitDataData - TYPE(FAST_InitData), INTENT(INOUT) :: DstInitDataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyInitData' -! + +subroutine FAST_CopyInitData(SrcInitDataData, DstInitDataData, CtrlCode, ErrStat, ErrMsg) + type(FAST_InitData), intent(inout) :: SrcInitDataData + type(FAST_InitData), intent(inout) :: DstInitDataData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyInitData' ErrStat = ErrID_None - ErrMsg = "" - CALL ED_CopyInitInput( SrcInitDataData%InData_ED, DstInitDataData%InData_ED, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ED_CopyInitOutput( SrcInitDataData%OutData_ED, DstInitDataData%OutData_ED, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL BD_CopyInitInput( SrcInitDataData%InData_BD, DstInitDataData%InData_BD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInitDataData%OutData_BD)) THEN - i1_l = LBOUND(SrcInitDataData%OutData_BD,1) - i1_u = UBOUND(SrcInitDataData%OutData_BD,1) - IF (.NOT. ALLOCATED(DstInitDataData%OutData_BD)) THEN - ALLOCATE(DstInitDataData%OutData_BD(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitDataData%OutData_BD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitDataData%OutData_BD,1), UBOUND(SrcInitDataData%OutData_BD,1) - CALL BD_CopyInitOutput( SrcInitDataData%OutData_BD(i1), DstInitDataData%OutData_BD(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL SrvD_CopyInitInput( SrcInitDataData%InData_SrvD, DstInitDataData%InData_SrvD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SrvD_CopyInitOutput( SrcInitDataData%OutData_SrvD, DstInitDataData%OutData_SrvD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_CopyInitInput( SrcInitDataData%InData_AD14, DstInitDataData%InData_AD14, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_CopyInitOutput( SrcInitDataData%OutData_AD14, DstInitDataData%OutData_AD14, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD_CopyInitInput( SrcInitDataData%InData_AD, DstInitDataData%InData_AD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD_CopyInitOutput( SrcInitDataData%OutData_AD, DstInitDataData%OutData_AD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyInitInput( SrcInitDataData%InData_IfW, DstInitDataData%InData_IfW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyInitOutput( SrcInitDataData%OutData_IfW, DstInitDataData%OutData_IfW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL OpFM_CopyInitInput( SrcInitDataData%InData_OpFM, DstInitDataData%InData_OpFM, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL OpFM_CopyInitOutput( SrcInitDataData%OutData_OpFM, DstInitDataData%OutData_OpFM, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SeaSt_CopyInitInput( SrcInitDataData%InData_SeaSt, DstInitDataData%InData_SeaSt, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SeaSt_CopyInitOutput( SrcInitDataData%OutData_SeaSt, DstInitDataData%OutData_SeaSt, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL HydroDyn_CopyInitInput( SrcInitDataData%InData_HD, DstInitDataData%InData_HD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL HydroDyn_CopyInitOutput( SrcInitDataData%OutData_HD, DstInitDataData%OutData_HD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SD_CopyInitInput( SrcInitDataData%InData_SD, DstInitDataData%InData_SD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SD_CopyInitOutput( SrcInitDataData%OutData_SD, DstInitDataData%OutData_SD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ExtPtfm_CopyInitInput( SrcInitDataData%InData_ExtPtfm, DstInitDataData%InData_ExtPtfm, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ExtPtfm_CopyInitOutput( SrcInitDataData%OutData_ExtPtfm, DstInitDataData%OutData_ExtPtfm, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MAP_CopyInitInput( SrcInitDataData%InData_MAP, DstInitDataData%InData_MAP, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MAP_CopyInitOutput( SrcInitDataData%OutData_MAP, DstInitDataData%OutData_MAP, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FEAM_CopyInitInput( SrcInitDataData%InData_FEAM, DstInitDataData%InData_FEAM, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FEAM_CopyInitOutput( SrcInitDataData%OutData_FEAM, DstInitDataData%OutData_FEAM, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MD_CopyInitInput( SrcInitDataData%InData_MD, DstInitDataData%InData_MD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MD_CopyInitOutput( SrcInitDataData%OutData_MD, DstInitDataData%OutData_MD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Orca_CopyInitInput( SrcInitDataData%InData_Orca, DstInitDataData%InData_Orca, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Orca_CopyInitOutput( SrcInitDataData%OutData_Orca, DstInitDataData%OutData_Orca, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL IceFloe_CopyInitInput( SrcInitDataData%InData_IceF, DstInitDataData%InData_IceF, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL IceFloe_CopyInitOutput( SrcInitDataData%OutData_IceF, DstInitDataData%OutData_IceF, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL IceD_CopyInitInput( SrcInitDataData%InData_IceD, DstInitDataData%InData_IceD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL IceD_CopyInitOutput( SrcInitDataData%OutData_IceD, DstInitDataData%OutData_IceD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE FAST_CopyInitData - - SUBROUTINE FAST_DestroyInitData( InitDataData, ErrStat, ErrMsg ) - TYPE(FAST_InitData), INTENT(INOUT) :: InitDataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyInitData' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL ED_DestroyInitInput( InitDataData%InData_ED, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ED_DestroyInitOutput( InitDataData%OutData_ED, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL BD_DestroyInitInput( InitDataData%InData_BD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitDataData%OutData_BD)) THEN -DO i1 = LBOUND(InitDataData%OutData_BD,1), UBOUND(InitDataData%OutData_BD,1) - CALL BD_DestroyInitOutput( InitDataData%OutData_BD(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InitDataData%OutData_BD) -ENDIF - CALL SrvD_DestroyInitInput( InitDataData%InData_SrvD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SrvD_DestroyInitOutput( InitDataData%OutData_SrvD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyInitInput( InitDataData%InData_AD14, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD14_DestroyInitOutput( InitDataData%OutData_AD14, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD_DestroyInitInput( InitDataData%InData_AD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AD_DestroyInitOutput( InitDataData%OutData_AD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyInitInput( InitDataData%InData_IfW, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL InflowWind_DestroyInitOutput( InitDataData%OutData_IfW, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL OpFM_DestroyInitInput( InitDataData%InData_OpFM, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL OpFM_DestroyInitOutput( InitDataData%OutData_OpFM, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SeaSt_DestroyInitInput( InitDataData%InData_SeaSt, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SeaSt_DestroyInitOutput( InitDataData%OutData_SeaSt, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL HydroDyn_DestroyInitInput( InitDataData%InData_HD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL HydroDyn_DestroyInitOutput( InitDataData%OutData_HD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SD_DestroyInitInput( InitDataData%InData_SD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL SD_DestroyInitOutput( InitDataData%OutData_SD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ExtPtfm_DestroyInitInput( InitDataData%InData_ExtPtfm, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ExtPtfm_DestroyInitOutput( InitDataData%OutData_ExtPtfm, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MAP_DestroyInitInput( InitDataData%InData_MAP, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MAP_DestroyInitOutput( InitDataData%OutData_MAP, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FEAM_DestroyInitInput( InitDataData%InData_FEAM, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FEAM_DestroyInitOutput( InitDataData%OutData_FEAM, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyInitInput( InitDataData%InData_MD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MD_DestroyInitOutput( InitDataData%OutData_MD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Orca_DestroyInitInput( InitDataData%InData_Orca, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Orca_DestroyInitOutput( InitDataData%OutData_Orca, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL IceFloe_DestroyInitInput( InitDataData%InData_IceF, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL IceFloe_DestroyInitOutput( InitDataData%OutData_IceF, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL IceD_DestroyInitInput( InitDataData%InData_IceD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL IceD_DestroyInitOutput( InitDataData%OutData_IceD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE FAST_DestroyInitData + ErrMsg = '' + call ED_CopyInitInput(SrcInitDataData%InData_ED, DstInitDataData%InData_ED, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ED_CopyInitOutput(SrcInitDataData%OutData_ED, DstInitDataData%OutData_ED, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call BD_CopyInitInput(SrcInitDataData%InData_BD, DstInitDataData%InData_BD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInitDataData%OutData_BD)) then + LB(1:1) = lbound(SrcInitDataData%OutData_BD) + UB(1:1) = ubound(SrcInitDataData%OutData_BD) + if (.not. allocated(DstInitDataData%OutData_BD)) then + allocate(DstInitDataData%OutData_BD(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitDataData%OutData_BD.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call BD_CopyInitOutput(SrcInitDataData%OutData_BD(i1), DstInitDataData%OutData_BD(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstInitDataData%OutData_BD)) then + deallocate(DstInitDataData%OutData_BD) + end if + call SrvD_CopyInitInput(SrcInitDataData%InData_SrvD, DstInitDataData%InData_SrvD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SrvD_CopyInitOutput(SrcInitDataData%OutData_SrvD, DstInitDataData%OutData_SrvD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyInitInput(SrcInitDataData%InData_AD14, DstInitDataData%InData_AD14, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD14_CopyInitOutput(SrcInitDataData%OutData_AD14, DstInitDataData%OutData_AD14, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD_CopyInitInput(SrcInitDataData%InData_AD, DstInitDataData%InData_AD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD_CopyInitOutput(SrcInitDataData%OutData_AD, DstInitDataData%OutData_AD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyInitInput(SrcInitDataData%InData_IfW, DstInitDataData%InData_IfW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call InflowWind_CopyInitOutput(SrcInitDataData%OutData_IfW, DstInitDataData%OutData_IfW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call OpFM_CopyInitInput(SrcInitDataData%InData_OpFM, DstInitDataData%InData_OpFM, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call OpFM_CopyInitOutput(SrcInitDataData%OutData_OpFM, DstInitDataData%OutData_OpFM, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyInitInput(SrcInitDataData%InData_SeaSt, DstInitDataData%InData_SeaSt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyInitOutput(SrcInitDataData%OutData_SeaSt, DstInitDataData%OutData_SeaSt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call HydroDyn_CopyInitInput(SrcInitDataData%InData_HD, DstInitDataData%InData_HD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call HydroDyn_CopyInitOutput(SrcInitDataData%OutData_HD, DstInitDataData%OutData_HD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SD_CopyInitInput(SrcInitDataData%InData_SD, DstInitDataData%InData_SD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SD_CopyInitOutput(SrcInitDataData%OutData_SD, DstInitDataData%OutData_SD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ExtPtfm_CopyInitInput(SrcInitDataData%InData_ExtPtfm, DstInitDataData%InData_ExtPtfm, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ExtPtfm_CopyInitOutput(SrcInitDataData%OutData_ExtPtfm, DstInitDataData%OutData_ExtPtfm, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MAP_CopyInitInput(SrcInitDataData%InData_MAP, DstInitDataData%InData_MAP, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MAP_CopyInitOutput(SrcInitDataData%OutData_MAP, DstInitDataData%OutData_MAP, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FEAM_CopyInitInput(SrcInitDataData%InData_FEAM, DstInitDataData%InData_FEAM, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FEAM_CopyInitOutput(SrcInitDataData%OutData_FEAM, DstInitDataData%OutData_FEAM, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MD_CopyInitInput(SrcInitDataData%InData_MD, DstInitDataData%InData_MD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MD_CopyInitOutput(SrcInitDataData%OutData_MD, DstInitDataData%OutData_MD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Orca_CopyInitInput(SrcInitDataData%InData_Orca, DstInitDataData%InData_Orca, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Orca_CopyInitOutput(SrcInitDataData%OutData_Orca, DstInitDataData%OutData_Orca, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IceFloe_CopyInitInput(SrcInitDataData%InData_IceF, DstInitDataData%InData_IceF, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IceFloe_CopyInitOutput(SrcInitDataData%OutData_IceF, DstInitDataData%OutData_IceF, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IceD_CopyInitInput(SrcInitDataData%InData_IceD, DstInitDataData%InData_IceD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call IceD_CopyInitOutput(SrcInitDataData%OutData_IceD, DstInitDataData%OutData_IceD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine FAST_DestroyInitData(InitDataData, ErrStat, ErrMsg) + type(FAST_InitData), intent(inout) :: InitDataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyInitData' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitDataData%OutData_BD)) then + LB(1:1) = lbound(InitDataData%OutData_BD) + UB(1:1) = ubound(InitDataData%OutData_BD) + do i1 = LB(1), UB(1) + call BD_DestroyInitOutput(InitDataData%OutData_BD(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InitDataData%OutData_BD) + end if +end subroutine subroutine FAST_PackInitData(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -15458,16 +14286,12 @@ subroutine FAST_PackInitData(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! InData_ED call ED_PackInitInput(Buf, InData%InData_ED) if (RegCheckErr(Buf, RoutineName)) return - ! OutData_ED call ED_PackInitOutput(Buf, InData%OutData_ED) if (RegCheckErr(Buf, RoutineName)) return - ! InData_BD call BD_PackInitInput(Buf, InData%InData_BD) if (RegCheckErr(Buf, RoutineName)) return - ! OutData_BD call RegPack(Buf, allocated(InData%OutData_BD)) if (allocated(InData%OutData_BD)) then call RegPackBounds(Buf, 1, lbound(InData%OutData_BD), ubound(InData%OutData_BD)) @@ -15478,94 +14302,64 @@ subroutine FAST_PackInitData(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! InData_SrvD call SrvD_PackInitInput(Buf, InData%InData_SrvD) if (RegCheckErr(Buf, RoutineName)) return - ! OutData_SrvD call SrvD_PackInitOutput(Buf, InData%OutData_SrvD) if (RegCheckErr(Buf, RoutineName)) return - ! InData_AD14 call AD14_PackInitInput(Buf, InData%InData_AD14) if (RegCheckErr(Buf, RoutineName)) return - ! OutData_AD14 call AD14_PackInitOutput(Buf, InData%OutData_AD14) if (RegCheckErr(Buf, RoutineName)) return - ! InData_AD call AD_PackInitInput(Buf, InData%InData_AD) if (RegCheckErr(Buf, RoutineName)) return - ! OutData_AD call AD_PackInitOutput(Buf, InData%OutData_AD) if (RegCheckErr(Buf, RoutineName)) return - ! InData_IfW call InflowWind_PackInitInput(Buf, InData%InData_IfW) if (RegCheckErr(Buf, RoutineName)) return - ! OutData_IfW call InflowWind_PackInitOutput(Buf, InData%OutData_IfW) if (RegCheckErr(Buf, RoutineName)) return - ! InData_OpFM call OpFM_PackInitInput(Buf, InData%InData_OpFM) if (RegCheckErr(Buf, RoutineName)) return - ! OutData_OpFM call OpFM_PackInitOutput(Buf, InData%OutData_OpFM) if (RegCheckErr(Buf, RoutineName)) return - ! InData_SeaSt call SeaSt_PackInitInput(Buf, InData%InData_SeaSt) if (RegCheckErr(Buf, RoutineName)) return - ! OutData_SeaSt call SeaSt_PackInitOutput(Buf, InData%OutData_SeaSt) if (RegCheckErr(Buf, RoutineName)) return - ! InData_HD call HydroDyn_PackInitInput(Buf, InData%InData_HD) if (RegCheckErr(Buf, RoutineName)) return - ! OutData_HD call HydroDyn_PackInitOutput(Buf, InData%OutData_HD) if (RegCheckErr(Buf, RoutineName)) return - ! InData_SD call SD_PackInitInput(Buf, InData%InData_SD) if (RegCheckErr(Buf, RoutineName)) return - ! OutData_SD call SD_PackInitOutput(Buf, InData%OutData_SD) if (RegCheckErr(Buf, RoutineName)) return - ! InData_ExtPtfm call ExtPtfm_PackInitInput(Buf, InData%InData_ExtPtfm) if (RegCheckErr(Buf, RoutineName)) return - ! OutData_ExtPtfm call ExtPtfm_PackInitOutput(Buf, InData%OutData_ExtPtfm) if (RegCheckErr(Buf, RoutineName)) return - ! InData_MAP call MAP_PackInitInput(Buf, InData%InData_MAP) if (RegCheckErr(Buf, RoutineName)) return - ! OutData_MAP call MAP_PackInitOutput(Buf, InData%OutData_MAP) if (RegCheckErr(Buf, RoutineName)) return - ! InData_FEAM call FEAM_PackInitInput(Buf, InData%InData_FEAM) if (RegCheckErr(Buf, RoutineName)) return - ! OutData_FEAM call FEAM_PackInitOutput(Buf, InData%OutData_FEAM) if (RegCheckErr(Buf, RoutineName)) return - ! InData_MD call MD_PackInitInput(Buf, InData%InData_MD) if (RegCheckErr(Buf, RoutineName)) return - ! OutData_MD call MD_PackInitOutput(Buf, InData%OutData_MD) if (RegCheckErr(Buf, RoutineName)) return - ! InData_Orca call Orca_PackInitInput(Buf, InData%InData_Orca) if (RegCheckErr(Buf, RoutineName)) return - ! OutData_Orca call Orca_PackInitOutput(Buf, InData%OutData_Orca) if (RegCheckErr(Buf, RoutineName)) return - ! InData_IceF call IceFloe_PackInitInput(Buf, InData%InData_IceF) if (RegCheckErr(Buf, RoutineName)) return - ! OutData_IceF call IceFloe_PackInitOutput(Buf, InData%OutData_IceF) if (RegCheckErr(Buf, RoutineName)) return - ! InData_IceD call IceD_PackInitInput(Buf, InData%InData_IceD) if (RegCheckErr(Buf, RoutineName)) return - ! OutData_IceD call IceD_PackInitOutput(Buf, InData%OutData_IceD) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -15579,13 +14373,9 @@ subroutine FAST_UnPackInitData(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! InData_ED call ED_UnpackInitInput(Buf, OutData%InData_ED) ! InData_ED - ! OutData_ED call ED_UnpackInitOutput(Buf, OutData%OutData_ED) ! OutData_ED - ! InData_BD call BD_UnpackInitInput(Buf, OutData%InData_BD) ! InData_BD - ! OutData_BD if (allocated(OutData%OutData_BD)) deallocate(OutData%OutData_BD) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -15601,152 +14391,112 @@ subroutine FAST_UnPackInitData(Buf, OutData) call BD_UnpackInitOutput(Buf, OutData%OutData_BD(i1)) ! OutData_BD end do end if - ! InData_SrvD call SrvD_UnpackInitInput(Buf, OutData%InData_SrvD) ! InData_SrvD - ! OutData_SrvD call SrvD_UnpackInitOutput(Buf, OutData%OutData_SrvD) ! OutData_SrvD - ! InData_AD14 call AD14_UnpackInitInput(Buf, OutData%InData_AD14) ! InData_AD14 - ! OutData_AD14 call AD14_UnpackInitOutput(Buf, OutData%OutData_AD14) ! OutData_AD14 - ! InData_AD call AD_UnpackInitInput(Buf, OutData%InData_AD) ! InData_AD - ! OutData_AD call AD_UnpackInitOutput(Buf, OutData%OutData_AD) ! OutData_AD - ! InData_IfW call InflowWind_UnpackInitInput(Buf, OutData%InData_IfW) ! InData_IfW - ! OutData_IfW call InflowWind_UnpackInitOutput(Buf, OutData%OutData_IfW) ! OutData_IfW - ! InData_OpFM call OpFM_UnpackInitInput(Buf, OutData%InData_OpFM) ! InData_OpFM - ! OutData_OpFM call OpFM_UnpackInitOutput(Buf, OutData%OutData_OpFM) ! OutData_OpFM - ! InData_SeaSt call SeaSt_UnpackInitInput(Buf, OutData%InData_SeaSt) ! InData_SeaSt - ! OutData_SeaSt call SeaSt_UnpackInitOutput(Buf, OutData%OutData_SeaSt) ! OutData_SeaSt - ! InData_HD call HydroDyn_UnpackInitInput(Buf, OutData%InData_HD) ! InData_HD - ! OutData_HD call HydroDyn_UnpackInitOutput(Buf, OutData%OutData_HD) ! OutData_HD - ! InData_SD call SD_UnpackInitInput(Buf, OutData%InData_SD) ! InData_SD - ! OutData_SD call SD_UnpackInitOutput(Buf, OutData%OutData_SD) ! OutData_SD - ! InData_ExtPtfm call ExtPtfm_UnpackInitInput(Buf, OutData%InData_ExtPtfm) ! InData_ExtPtfm - ! OutData_ExtPtfm call ExtPtfm_UnpackInitOutput(Buf, OutData%OutData_ExtPtfm) ! OutData_ExtPtfm - ! InData_MAP call MAP_UnpackInitInput(Buf, OutData%InData_MAP) ! InData_MAP - ! OutData_MAP call MAP_UnpackInitOutput(Buf, OutData%OutData_MAP) ! OutData_MAP - ! InData_FEAM call FEAM_UnpackInitInput(Buf, OutData%InData_FEAM) ! InData_FEAM - ! OutData_FEAM call FEAM_UnpackInitOutput(Buf, OutData%OutData_FEAM) ! OutData_FEAM - ! InData_MD call MD_UnpackInitInput(Buf, OutData%InData_MD) ! InData_MD - ! OutData_MD call MD_UnpackInitOutput(Buf, OutData%OutData_MD) ! OutData_MD - ! InData_Orca call Orca_UnpackInitInput(Buf, OutData%InData_Orca) ! InData_Orca - ! OutData_Orca call Orca_UnpackInitOutput(Buf, OutData%OutData_Orca) ! OutData_Orca - ! InData_IceF call IceFloe_UnpackInitInput(Buf, OutData%InData_IceF) ! InData_IceF - ! OutData_IceF call IceFloe_UnpackInitOutput(Buf, OutData%OutData_IceF) ! OutData_IceF - ! InData_IceD call IceD_UnpackInitInput(Buf, OutData%InData_IceD) ! InData_IceD - ! OutData_IceD call IceD_UnpackInitOutput(Buf, OutData%OutData_IceD) ! OutData_IceD end subroutine - SUBROUTINE FAST_CopyExternInitType( SrcExternInitTypeData, DstExternInitTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_ExternInitType), INTENT(IN) :: SrcExternInitTypeData - TYPE(FAST_ExternInitType), INTENT(INOUT) :: DstExternInitTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyExternInitType' -! + +subroutine FAST_CopyExternInitType(SrcExternInitTypeData, DstExternInitTypeData, CtrlCode, ErrStat, ErrMsg) + type(FAST_ExternInitType), intent(in) :: SrcExternInitTypeData + type(FAST_ExternInitType), intent(inout) :: DstExternInitTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'FAST_CopyExternInitType' ErrStat = ErrID_None - ErrMsg = "" - DstExternInitTypeData%Tmax = SrcExternInitTypeData%Tmax - DstExternInitTypeData%SensorType = SrcExternInitTypeData%SensorType - DstExternInitTypeData%LidRadialVel = SrcExternInitTypeData%LidRadialVel - DstExternInitTypeData%TurbineID = SrcExternInitTypeData%TurbineID - DstExternInitTypeData%TurbinePos = SrcExternInitTypeData%TurbinePos - DstExternInitTypeData%WaveFieldMod = SrcExternInitTypeData%WaveFieldMod - DstExternInitTypeData%NumSC2CtrlGlob = SrcExternInitTypeData%NumSC2CtrlGlob - DstExternInitTypeData%NumSC2Ctrl = SrcExternInitTypeData%NumSC2Ctrl - DstExternInitTypeData%NumCtrl2SC = SrcExternInitTypeData%NumCtrl2SC -IF (ALLOCATED(SrcExternInitTypeData%fromSCGlob)) THEN - i1_l = LBOUND(SrcExternInitTypeData%fromSCGlob,1) - i1_u = UBOUND(SrcExternInitTypeData%fromSCGlob,1) - IF (.NOT. ALLOCATED(DstExternInitTypeData%fromSCGlob)) THEN - ALLOCATE(DstExternInitTypeData%fromSCGlob(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstExternInitTypeData%fromSCGlob.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstExternInitTypeData%fromSCGlob = SrcExternInitTypeData%fromSCGlob -ENDIF -IF (ALLOCATED(SrcExternInitTypeData%fromSC)) THEN - i1_l = LBOUND(SrcExternInitTypeData%fromSC,1) - i1_u = UBOUND(SrcExternInitTypeData%fromSC,1) - IF (.NOT. ALLOCATED(DstExternInitTypeData%fromSC)) THEN - ALLOCATE(DstExternInitTypeData%fromSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstExternInitTypeData%fromSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstExternInitTypeData%fromSC = SrcExternInitTypeData%fromSC -ENDIF - DstExternInitTypeData%FarmIntegration = SrcExternInitTypeData%FarmIntegration - DstExternInitTypeData%windGrid_n = SrcExternInitTypeData%windGrid_n - DstExternInitTypeData%windGrid_delta = SrcExternInitTypeData%windGrid_delta - DstExternInitTypeData%windGrid_pZero = SrcExternInitTypeData%windGrid_pZero - DstExternInitTypeData%windGrid_data => SrcExternInitTypeData%windGrid_data - DstExternInitTypeData%RootName = SrcExternInitTypeData%RootName - DstExternInitTypeData%NumActForcePtsBlade = SrcExternInitTypeData%NumActForcePtsBlade - DstExternInitTypeData%NumActForcePtsTower = SrcExternInitTypeData%NumActForcePtsTower - DstExternInitTypeData%NodeClusterType = SrcExternInitTypeData%NodeClusterType - END SUBROUTINE FAST_CopyExternInitType - - SUBROUTINE FAST_DestroyExternInitType( ExternInitTypeData, ErrStat, ErrMsg ) - TYPE(FAST_ExternInitType), INTENT(INOUT) :: ExternInitTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyExternInitType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ExternInitTypeData%fromSCGlob)) THEN - DEALLOCATE(ExternInitTypeData%fromSCGlob) -ENDIF -IF (ALLOCATED(ExternInitTypeData%fromSC)) THEN - DEALLOCATE(ExternInitTypeData%fromSC) -ENDIF -NULLIFY(ExternInitTypeData%windGrid_data) - END SUBROUTINE FAST_DestroyExternInitType + ErrMsg = '' + DstExternInitTypeData%Tmax = SrcExternInitTypeData%Tmax + DstExternInitTypeData%SensorType = SrcExternInitTypeData%SensorType + DstExternInitTypeData%LidRadialVel = SrcExternInitTypeData%LidRadialVel + DstExternInitTypeData%TurbineID = SrcExternInitTypeData%TurbineID + DstExternInitTypeData%TurbinePos = SrcExternInitTypeData%TurbinePos + DstExternInitTypeData%WaveFieldMod = SrcExternInitTypeData%WaveFieldMod + DstExternInitTypeData%NumSC2CtrlGlob = SrcExternInitTypeData%NumSC2CtrlGlob + DstExternInitTypeData%NumSC2Ctrl = SrcExternInitTypeData%NumSC2Ctrl + DstExternInitTypeData%NumCtrl2SC = SrcExternInitTypeData%NumCtrl2SC + if (allocated(SrcExternInitTypeData%fromSCGlob)) then + LB(1:1) = lbound(SrcExternInitTypeData%fromSCGlob) + UB(1:1) = ubound(SrcExternInitTypeData%fromSCGlob) + if (.not. allocated(DstExternInitTypeData%fromSCGlob)) then + allocate(DstExternInitTypeData%fromSCGlob(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstExternInitTypeData%fromSCGlob.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstExternInitTypeData%fromSCGlob = SrcExternInitTypeData%fromSCGlob + else if (allocated(DstExternInitTypeData%fromSCGlob)) then + deallocate(DstExternInitTypeData%fromSCGlob) + end if + if (allocated(SrcExternInitTypeData%fromSC)) then + LB(1:1) = lbound(SrcExternInitTypeData%fromSC) + UB(1:1) = ubound(SrcExternInitTypeData%fromSC) + if (.not. allocated(DstExternInitTypeData%fromSC)) then + allocate(DstExternInitTypeData%fromSC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstExternInitTypeData%fromSC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstExternInitTypeData%fromSC = SrcExternInitTypeData%fromSC + else if (allocated(DstExternInitTypeData%fromSC)) then + deallocate(DstExternInitTypeData%fromSC) + end if + DstExternInitTypeData%FarmIntegration = SrcExternInitTypeData%FarmIntegration + DstExternInitTypeData%windGrid_n = SrcExternInitTypeData%windGrid_n + DstExternInitTypeData%windGrid_delta = SrcExternInitTypeData%windGrid_delta + DstExternInitTypeData%windGrid_pZero = SrcExternInitTypeData%windGrid_pZero + DstExternInitTypeData%windGrid_data => SrcExternInitTypeData%windGrid_data + DstExternInitTypeData%RootName = SrcExternInitTypeData%RootName + DstExternInitTypeData%NumActForcePtsBlade = SrcExternInitTypeData%NumActForcePtsBlade + DstExternInitTypeData%NumActForcePtsTower = SrcExternInitTypeData%NumActForcePtsTower + DstExternInitTypeData%NodeClusterType = SrcExternInitTypeData%NodeClusterType +end subroutine +subroutine FAST_DestroyExternInitType(ExternInitTypeData, ErrStat, ErrMsg) + type(FAST_ExternInitType), intent(inout) :: ExternInitTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'FAST_DestroyExternInitType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ExternInitTypeData%fromSCGlob)) then + deallocate(ExternInitTypeData%fromSCGlob) + end if + if (allocated(ExternInitTypeData%fromSC)) then + deallocate(ExternInitTypeData%fromSC) + end if + nullify(ExternInitTypeData%windGrid_data) +end subroutine subroutine FAST_PackExternInitType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -15754,60 +14504,44 @@ subroutine FAST_PackExternInitType(Buf, Indata) character(*), parameter :: RoutineName = 'FAST_PackExternInitType' logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return - ! Tmax call RegPack(Buf, InData%Tmax) if (RegCheckErr(Buf, RoutineName)) return - ! SensorType call RegPack(Buf, InData%SensorType) if (RegCheckErr(Buf, RoutineName)) return - ! LidRadialVel call RegPack(Buf, InData%LidRadialVel) if (RegCheckErr(Buf, RoutineName)) return - ! TurbineID call RegPack(Buf, InData%TurbineID) if (RegCheckErr(Buf, RoutineName)) return - ! TurbinePos call RegPack(Buf, InData%TurbinePos) if (RegCheckErr(Buf, RoutineName)) return - ! WaveFieldMod call RegPack(Buf, InData%WaveFieldMod) if (RegCheckErr(Buf, RoutineName)) return - ! NumSC2CtrlGlob call RegPack(Buf, InData%NumSC2CtrlGlob) if (RegCheckErr(Buf, RoutineName)) return - ! NumSC2Ctrl call RegPack(Buf, InData%NumSC2Ctrl) if (RegCheckErr(Buf, RoutineName)) return - ! NumCtrl2SC call RegPack(Buf, InData%NumCtrl2SC) if (RegCheckErr(Buf, RoutineName)) return - ! fromSCGlob call RegPack(Buf, allocated(InData%fromSCGlob)) if (allocated(InData%fromSCGlob)) then call RegPackBounds(Buf, 1, lbound(InData%fromSCGlob), ubound(InData%fromSCGlob)) call RegPack(Buf, InData%fromSCGlob) end if if (RegCheckErr(Buf, RoutineName)) return - ! fromSC call RegPack(Buf, allocated(InData%fromSC)) if (allocated(InData%fromSC)) then call RegPackBounds(Buf, 1, lbound(InData%fromSC), ubound(InData%fromSC)) call RegPack(Buf, InData%fromSC) end if if (RegCheckErr(Buf, RoutineName)) return - ! FarmIntegration call RegPack(Buf, InData%FarmIntegration) if (RegCheckErr(Buf, RoutineName)) return - ! windGrid_n call RegPack(Buf, InData%windGrid_n) if (RegCheckErr(Buf, RoutineName)) return - ! windGrid_delta call RegPack(Buf, InData%windGrid_delta) if (RegCheckErr(Buf, RoutineName)) return - ! windGrid_pZero call RegPack(Buf, InData%windGrid_pZero) if (RegCheckErr(Buf, RoutineName)) return - ! windGrid_data call RegPack(Buf, associated(InData%windGrid_data)) if (associated(InData%windGrid_data)) then call RegPackBounds(Buf, 5, lbound(InData%windGrid_data), ubound(InData%windGrid_data)) @@ -15817,16 +14551,12 @@ subroutine FAST_PackExternInitType(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegPack(Buf, InData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! NumActForcePtsBlade call RegPack(Buf, InData%NumActForcePtsBlade) if (RegCheckErr(Buf, RoutineName)) return - ! NumActForcePtsTower call RegPack(Buf, InData%NumActForcePtsTower) if (RegCheckErr(Buf, RoutineName)) return - ! NodeClusterType call RegPack(Buf, InData%NodeClusterType) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -15841,34 +14571,24 @@ subroutine FAST_UnPackExternInitType(Buf, OutData) integer(IntKi) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return - ! Tmax call RegUnpack(Buf, OutData%Tmax) if (RegCheckErr(Buf, RoutineName)) return - ! SensorType call RegUnpack(Buf, OutData%SensorType) if (RegCheckErr(Buf, RoutineName)) return - ! LidRadialVel call RegUnpack(Buf, OutData%LidRadialVel) if (RegCheckErr(Buf, RoutineName)) return - ! TurbineID call RegUnpack(Buf, OutData%TurbineID) if (RegCheckErr(Buf, RoutineName)) return - ! TurbinePos call RegUnpack(Buf, OutData%TurbinePos) if (RegCheckErr(Buf, RoutineName)) return - ! WaveFieldMod call RegUnpack(Buf, OutData%WaveFieldMod) if (RegCheckErr(Buf, RoutineName)) return - ! NumSC2CtrlGlob call RegUnpack(Buf, OutData%NumSC2CtrlGlob) if (RegCheckErr(Buf, RoutineName)) return - ! NumSC2Ctrl call RegUnpack(Buf, OutData%NumSC2Ctrl) if (RegCheckErr(Buf, RoutineName)) return - ! NumCtrl2SC call RegUnpack(Buf, OutData%NumCtrl2SC) if (RegCheckErr(Buf, RoutineName)) return - ! fromSCGlob if (allocated(OutData%fromSCGlob)) deallocate(OutData%fromSCGlob) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -15883,7 +14603,6 @@ subroutine FAST_UnPackExternInitType(Buf, OutData) call RegUnpack(Buf, OutData%fromSCGlob) if (RegCheckErr(Buf, RoutineName)) return end if - ! fromSC if (allocated(OutData%fromSC)) deallocate(OutData%fromSC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -15898,19 +14617,14 @@ subroutine FAST_UnPackExternInitType(Buf, OutData) call RegUnpack(Buf, OutData%fromSC) if (RegCheckErr(Buf, RoutineName)) return end if - ! FarmIntegration call RegUnpack(Buf, OutData%FarmIntegration) if (RegCheckErr(Buf, RoutineName)) return - ! windGrid_n call RegUnpack(Buf, OutData%windGrid_n) if (RegCheckErr(Buf, RoutineName)) return - ! windGrid_delta call RegUnpack(Buf, OutData%windGrid_delta) if (RegCheckErr(Buf, RoutineName)) return - ! windGrid_pZero call RegUnpack(Buf, OutData%windGrid_pZero) if (RegCheckErr(Buf, RoutineName)) return - ! windGrid_data if (associated(OutData%windGrid_data)) deallocate(OutData%windGrid_data) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -15935,234 +14649,156 @@ subroutine FAST_UnPackExternInitType(Buf, OutData) else OutData%windGrid_data => null() end if - ! RootName call RegUnpack(Buf, OutData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! NumActForcePtsBlade call RegUnpack(Buf, OutData%NumActForcePtsBlade) if (RegCheckErr(Buf, RoutineName)) return - ! NumActForcePtsTower call RegUnpack(Buf, OutData%NumActForcePtsTower) if (RegCheckErr(Buf, RoutineName)) return - ! NodeClusterType call RegUnpack(Buf, OutData%NodeClusterType) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE FAST_CopyTurbineType( SrcTurbineTypeData, DstTurbineTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_TurbineType), INTENT(INOUT) :: SrcTurbineTypeData - TYPE(FAST_TurbineType), INTENT(INOUT) :: DstTurbineTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyTurbineType' -! + +subroutine FAST_CopyTurbineType(SrcTurbineTypeData, DstTurbineTypeData, CtrlCode, ErrStat, ErrMsg) + type(FAST_TurbineType), intent(inout) :: SrcTurbineTypeData + type(FAST_TurbineType), intent(inout) :: DstTurbineTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopyTurbineType' ErrStat = ErrID_None - ErrMsg = "" - DstTurbineTypeData%TurbID = SrcTurbineTypeData%TurbID - CALL FAST_CopyParam( SrcTurbineTypeData%p_FAST, DstTurbineTypeData%p_FAST, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copyoutputfiletype( SrcTurbineTypeData%y_FAST, DstTurbineTypeData%y_FAST, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_CopyMisc( SrcTurbineTypeData%m_FAST, DstTurbineTypeData%m_FAST, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copymodulemaptype( SrcTurbineTypeData%MeshMapData, DstTurbineTypeData%MeshMapData, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copyelastodyn_data( SrcTurbineTypeData%ED, DstTurbineTypeData%ED, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copybeamdyn_data( SrcTurbineTypeData%BD, DstTurbineTypeData%BD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copyservodyn_data( SrcTurbineTypeData%SrvD, DstTurbineTypeData%SrvD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copyaerodyn_data( SrcTurbineTypeData%AD, DstTurbineTypeData%AD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copyaerodyn14_data( SrcTurbineTypeData%AD14, DstTurbineTypeData%AD14, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copyinflowwind_data( SrcTurbineTypeData%IfW, DstTurbineTypeData%IfW, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copyopenfoam_data( SrcTurbineTypeData%OpFM, DstTurbineTypeData%OpFM, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copyscdataex_data( SrcTurbineTypeData%SC_DX, DstTurbineTypeData%SC_DX, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copyseastate_data( SrcTurbineTypeData%SeaSt, DstTurbineTypeData%SeaSt, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copyhydrodyn_data( SrcTurbineTypeData%HD, DstTurbineTypeData%HD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copysubdyn_data( SrcTurbineTypeData%SD, DstTurbineTypeData%SD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copymap_data( SrcTurbineTypeData%MAP, DstTurbineTypeData%MAP, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copyfeamooring_data( SrcTurbineTypeData%FEAM, DstTurbineTypeData%FEAM, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copymoordyn_data( SrcTurbineTypeData%MD, DstTurbineTypeData%MD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copyorcaflex_data( SrcTurbineTypeData%Orca, DstTurbineTypeData%Orca, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copyicefloe_data( SrcTurbineTypeData%IceF, DstTurbineTypeData%IceF, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copyicedyn_data( SrcTurbineTypeData%IceD, DstTurbineTypeData%IceD, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL FAST_Copyextptfm_data( SrcTurbineTypeData%ExtPtfm, DstTurbineTypeData%ExtPtfm, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE FAST_CopyTurbineType - - SUBROUTINE FAST_DestroyTurbineType( TurbineTypeData, ErrStat, ErrMsg ) - TYPE(FAST_TurbineType), INTENT(INOUT) :: TurbineTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyTurbineType' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL FAST_DestroyParam( TurbineTypeData%p_FAST, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroyOutputFileType( TurbineTypeData%y_FAST, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroyMisc( TurbineTypeData%m_FAST, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroyModuleMapType( TurbineTypeData%MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroyElastoDyn_Data( TurbineTypeData%ED, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroyBeamDyn_Data( TurbineTypeData%BD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroyServoDyn_Data( TurbineTypeData%SrvD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroyAeroDyn_Data( TurbineTypeData%AD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroyAeroDyn14_Data( TurbineTypeData%AD14, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroyInflowWind_Data( TurbineTypeData%IfW, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroyOpenFOAM_Data( TurbineTypeData%OpFM, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroySCDataEx_Data( TurbineTypeData%SC_DX, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroySeaState_Data( TurbineTypeData%SeaSt, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroyHydroDyn_Data( TurbineTypeData%HD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroySubDyn_Data( TurbineTypeData%SD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroyMAP_Data( TurbineTypeData%MAP, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroyFEAMooring_Data( TurbineTypeData%FEAM, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroyMoorDyn_Data( TurbineTypeData%MD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroyOrcaFlex_Data( TurbineTypeData%Orca, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroyIceFloe_Data( TurbineTypeData%IceF, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroyIceDyn_Data( TurbineTypeData%IceD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL FAST_DestroyExtPtfm_Data( TurbineTypeData%ExtPtfm, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE FAST_DestroyTurbineType + ErrMsg = '' + DstTurbineTypeData%TurbID = SrcTurbineTypeData%TurbID + call FAST_CopyParam(SrcTurbineTypeData%p_FAST, DstTurbineTypeData%p_FAST, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyOutputFileType(SrcTurbineTypeData%y_FAST, DstTurbineTypeData%y_FAST, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyMisc(SrcTurbineTypeData%m_FAST, DstTurbineTypeData%m_FAST, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyModuleMapType(SrcTurbineTypeData%MeshMapData, DstTurbineTypeData%MeshMapData, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyElastoDyn_Data(SrcTurbineTypeData%ED, DstTurbineTypeData%ED, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyBeamDyn_Data(SrcTurbineTypeData%BD, DstTurbineTypeData%BD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyServoDyn_Data(SrcTurbineTypeData%SrvD, DstTurbineTypeData%SrvD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyAeroDyn_Data(SrcTurbineTypeData%AD, DstTurbineTypeData%AD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyAeroDyn14_Data(SrcTurbineTypeData%AD14, DstTurbineTypeData%AD14, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyInflowWind_Data(SrcTurbineTypeData%IfW, DstTurbineTypeData%IfW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyOpenFOAM_Data(SrcTurbineTypeData%OpFM, DstTurbineTypeData%OpFM, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopySCDataEx_Data(SrcTurbineTypeData%SC_DX, DstTurbineTypeData%SC_DX, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopySeaState_Data(SrcTurbineTypeData%SeaSt, DstTurbineTypeData%SeaSt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyHydroDyn_Data(SrcTurbineTypeData%HD, DstTurbineTypeData%HD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopySubDyn_Data(SrcTurbineTypeData%SD, DstTurbineTypeData%SD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyMAP_Data(SrcTurbineTypeData%MAP, DstTurbineTypeData%MAP, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyFEAMooring_Data(SrcTurbineTypeData%FEAM, DstTurbineTypeData%FEAM, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyMoorDyn_Data(SrcTurbineTypeData%MD, DstTurbineTypeData%MD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyOrcaFlex_Data(SrcTurbineTypeData%Orca, DstTurbineTypeData%Orca, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyIceFloe_Data(SrcTurbineTypeData%IceF, DstTurbineTypeData%IceF, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyIceDyn_Data(SrcTurbineTypeData%IceD, DstTurbineTypeData%IceD, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FAST_CopyExtPtfm_Data(SrcTurbineTypeData%ExtPtfm, DstTurbineTypeData%ExtPtfm, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine FAST_DestroyTurbineType(TurbineTypeData, ErrStat, ErrMsg) + type(FAST_TurbineType), intent(inout) :: TurbineTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyTurbineType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine FAST_PackTurbineType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(FAST_TurbineType), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackTurbineType' if (Buf%ErrStat >= AbortErrLev) return - ! TurbID call RegPack(Buf, InData%TurbID) if (RegCheckErr(Buf, RoutineName)) return - ! p_FAST call FAST_PackParam(Buf, InData%p_FAST) if (RegCheckErr(Buf, RoutineName)) return - ! y_FAST call FAST_PackOutputFileType(Buf, InData%y_FAST) if (RegCheckErr(Buf, RoutineName)) return - ! m_FAST call FAST_PackMisc(Buf, InData%m_FAST) if (RegCheckErr(Buf, RoutineName)) return - ! MeshMapData call FAST_PackModuleMapType(Buf, InData%MeshMapData) if (RegCheckErr(Buf, RoutineName)) return - ! ED call FAST_PackElastoDyn_Data(Buf, InData%ED) if (RegCheckErr(Buf, RoutineName)) return - ! BD call FAST_PackBeamDyn_Data(Buf, InData%BD) if (RegCheckErr(Buf, RoutineName)) return - ! SrvD call FAST_PackServoDyn_Data(Buf, InData%SrvD) if (RegCheckErr(Buf, RoutineName)) return - ! AD call FAST_PackAeroDyn_Data(Buf, InData%AD) if (RegCheckErr(Buf, RoutineName)) return - ! AD14 call FAST_PackAeroDyn14_Data(Buf, InData%AD14) if (RegCheckErr(Buf, RoutineName)) return - ! IfW call FAST_PackInflowWind_Data(Buf, InData%IfW) if (RegCheckErr(Buf, RoutineName)) return - ! OpFM call FAST_PackOpenFOAM_Data(Buf, InData%OpFM) if (RegCheckErr(Buf, RoutineName)) return - ! SC_DX call FAST_PackSCDataEx_Data(Buf, InData%SC_DX) if (RegCheckErr(Buf, RoutineName)) return - ! SeaSt call FAST_PackSeaState_Data(Buf, InData%SeaSt) if (RegCheckErr(Buf, RoutineName)) return - ! HD call FAST_PackHydroDyn_Data(Buf, InData%HD) if (RegCheckErr(Buf, RoutineName)) return - ! SD call FAST_PackSubDyn_Data(Buf, InData%SD) if (RegCheckErr(Buf, RoutineName)) return - ! MAP call FAST_PackMAP_Data(Buf, InData%MAP) if (RegCheckErr(Buf, RoutineName)) return - ! FEAM call FAST_PackFEAMooring_Data(Buf, InData%FEAM) if (RegCheckErr(Buf, RoutineName)) return - ! MD call FAST_PackMoorDyn_Data(Buf, InData%MD) if (RegCheckErr(Buf, RoutineName)) return - ! Orca call FAST_PackOrcaFlex_Data(Buf, InData%Orca) if (RegCheckErr(Buf, RoutineName)) return - ! IceF call FAST_PackIceFloe_Data(Buf, InData%IceF) if (RegCheckErr(Buf, RoutineName)) return - ! IceD call FAST_PackIceDyn_Data(Buf, InData%IceD) if (RegCheckErr(Buf, RoutineName)) return - ! ExtPtfm call FAST_PackExtPtfm_Data(Buf, InData%ExtPtfm) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -16172,52 +14808,29 @@ subroutine FAST_UnPackTurbineType(Buf, OutData) type(FAST_TurbineType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackTurbineType' if (Buf%ErrStat /= ErrID_None) return - ! TurbID call RegUnpack(Buf, OutData%TurbID) if (RegCheckErr(Buf, RoutineName)) return - ! p_FAST call FAST_UnpackParam(Buf, OutData%p_FAST) ! p_FAST - ! y_FAST call FAST_UnpackOutputFileType(Buf, OutData%y_FAST) ! y_FAST - ! m_FAST call FAST_UnpackMisc(Buf, OutData%m_FAST) ! m_FAST - ! MeshMapData call FAST_UnpackModuleMapType(Buf, OutData%MeshMapData) ! MeshMapData - ! ED call FAST_UnpackElastoDyn_Data(Buf, OutData%ED) ! ED - ! BD call FAST_UnpackBeamDyn_Data(Buf, OutData%BD) ! BD - ! SrvD call FAST_UnpackServoDyn_Data(Buf, OutData%SrvD) ! SrvD - ! AD call FAST_UnpackAeroDyn_Data(Buf, OutData%AD) ! AD - ! AD14 call FAST_UnpackAeroDyn14_Data(Buf, OutData%AD14) ! AD14 - ! IfW call FAST_UnpackInflowWind_Data(Buf, OutData%IfW) ! IfW - ! OpFM call FAST_UnpackOpenFOAM_Data(Buf, OutData%OpFM) ! OpFM - ! SC_DX call FAST_UnpackSCDataEx_Data(Buf, OutData%SC_DX) ! SC_DX - ! SeaSt call FAST_UnpackSeaState_Data(Buf, OutData%SeaSt) ! SeaSt - ! HD call FAST_UnpackHydroDyn_Data(Buf, OutData%HD) ! HD - ! SD call FAST_UnpackSubDyn_Data(Buf, OutData%SD) ! SD - ! MAP call FAST_UnpackMAP_Data(Buf, OutData%MAP) ! MAP - ! FEAM call FAST_UnpackFEAMooring_Data(Buf, OutData%FEAM) ! FEAM - ! MD call FAST_UnpackMoorDyn_Data(Buf, OutData%MD) ! MD - ! Orca call FAST_UnpackOrcaFlex_Data(Buf, OutData%Orca) ! Orca - ! IceF call FAST_UnpackIceFloe_Data(Buf, OutData%IceF) ! IceF - ! IceD call FAST_UnpackIceDyn_Data(Buf, OutData%IceD) ! IceD - ! ExtPtfm call FAST_UnpackExtPtfm_Data(Buf, OutData%ExtPtfm) ! ExtPtfm end subroutine END MODULE FAST_Types diff --git a/modules/openfast-registry/src/registry_gen_fortran.cpp b/modules/openfast-registry/src/registry_gen_fortran.cpp index 22fc1422cf..8c6e91e5ec 100644 --- a/modules/openfast-registry/src/registry_gen_fortran.cpp +++ b/modules/openfast-registry/src/registry_gen_fortran.cpp @@ -280,138 +280,167 @@ void Registry::gen_fortran_module(const Module &mod, const std::string &out_dir) void gen_copy(std::ostream &w, const Module &mod, const DataType::Derived &ddt, const bool gen_c_code) { - w << " SUBROUTINE " << mod.nickname << "_Copy" << ddt.name_short << "( Src" << ddt.name_short - << "Data, Dst" << ddt.name_short << "Data, CtrlCode, ErrStat, ErrMsg )\n"; - w << " TYPE(" << ddt.type_fortran << "), INTENT(" << (ddt.contains_mesh ? "INOUT" : "IN") - << ") :: Src" << ddt.name_short << "Data\n"; - w << " TYPE(" << ddt.type_fortran << "), INTENT(INOUT) :: Dst" << ddt.name_short << "Data\n"; - w << " INTEGER(IntKi), INTENT(IN ) :: CtrlCode\n"; - w << " INTEGER(IntKi), INTENT( OUT) :: ErrStat\n"; - w << " CHARACTER(*), INTENT( OUT) :: ErrMsg\n"; - w << "! Local \n"; - w << " INTEGER(IntKi) :: i,j,k\n"; - for (int d = 1; d <= ddt.max_rank; d++) - w << " INTEGER(IntKi) :: i" << d << ", i" << d << "_l, i" << d - << "_u ! bounds (upper/lower) for an array dimension " << d << "\n"; - w << " INTEGER(IntKi) :: ErrStat2\n"; - w << " CHARACTER(ErrMsgLen) :: ErrMsg2\n"; - w << " CHARACTER(*), PARAMETER :: RoutineName = '" << mod.nickname << "_Copy" - << ddt.name_short << "'\n"; - w << "! \n"; - w << " ErrStat = ErrID_None\n"; - w << " ErrMsg = \"\"\n"; + auto routine_name = mod.nickname + "_Copy" + ddt.name_short; + std::string indent("\n"); + + bool has_alloc = std::any_of(ddt.fields.begin(), ddt.fields.end(), [](Field f) + { return f.is_allocatable; }); + bool has_ddt = std::any_of(ddt.fields.begin(), ddt.fields.end(), [](Field f) + { return f.data_type->tag == DataType::Tag::Derived; }); + bool has_ddt_arr = std::any_of(ddt.fields.begin(), ddt.fields.end(), [](Field f) + { return f.data_type->tag == DataType::Tag::Derived && f.rank > 0; }); + + w << indent << "subroutine " << routine_name << "(Src" << ddt.name_short + << "Data, Dst" << ddt.name_short << "Data, CtrlCode, ErrStat, ErrMsg)"; + indent += " "; + w << indent << "type(" << ddt.type_fortran << "), intent(" << (ddt.contains_mesh ? "inout" : "in") + << ") :: Src" << ddt.name_short << "Data"; + w << indent << "type(" << ddt.type_fortran << "), intent(inout) :: Dst" << ddt.name_short << "Data"; + w << indent << "integer(IntKi), intent(in ) :: CtrlCode"; + w << indent << "integer(IntKi), intent( out) :: ErrStat"; + w << indent << "character(*), intent( out) :: ErrMsg"; + if (has_ddt_arr) + { + w << indent << "integer(IntKi) :: "; + for (int i = 1; i <= ddt.max_rank; i++) + w << (i > 1 ? ", " : "") << "i" << i; + w << ""; + } + if (has_ddt_arr || has_alloc) + w << indent << "integer(IntKi) :: LB(" << ddt.max_rank << "), UB(" << ddt.max_rank << ")"; + if (has_ddt || has_alloc) + w << indent << "integer(IntKi) :: ErrStat2"; + if (has_ddt) + w << indent << "character(ErrMsgLen) :: ErrMsg2"; + w << indent << "character(*), parameter :: RoutineName = '" << routine_name << "'"; + w << indent << "ErrStat = ErrID_None"; + w << indent << "ErrMsg = ''"; // Loop through fields for (auto &field : ddt.fields) { - std::string alloc_assoc = field.is_pointer ? "ASSOCIATED" : "ALLOCATED"; + std::string alloc_assoc = field.is_pointer ? "associated" : "allocated"; std::string src = "Src" + ddt.name_short + "Data%" + field.name; std::string dst = "Dst" + ddt.name_short + "Data%" + field.name; - // If field is a non-target pointer, set the associate the destination + // w << indent << "! " << field.name; + + // If field is a non-target pointer, associate the destination // pointer with the source pointer if (field.is_pointer && !field.is_target) { - w << " " << dst << " => " << src << "\n"; + w << indent << dst << " => " << src; continue; } - // If field is an allocatable array + // If field is allocatable if (field.is_allocatable) { - w << "IF (" << alloc_assoc << "(" << src << ")) THEN\n"; + w << indent << "if (" << alloc_assoc << "(" << src << ")) then"; + indent += " "; - std::string dims; - for (int d = 1; d <= field.rank; d++) + std::string dims(""); + if (field.rank > 0) { - w << " i" << d << "_l = LBOUND(" << src << "," << d << ")\n"; - w << " i" << d << "_u = UBOUND(" << src << "," << d << ")\n"; - dims += (d == 1 ? "(i" : "i") + std::to_string(d) + "_l:i" + - std::to_string(d) + "_u" + (d == field.rank ? ")" : ","); + w << indent << "LB(1:" << field.rank << ") = lbound(" << src << ")"; + w << indent << "UB(1:" << field.rank << ") = ubound(" << src << ")"; + for (int d = 1; d <= field.rank; d++) + dims += ",LB(" + std::to_string(d) + "):UB(" + std::to_string(d) + ")"; + dims = "(" + dims.substr(1) + ")"; } - w << " IF (.NOT. " << alloc_assoc << "(" << dst << ")) THEN \n"; - w << " ALLOCATE(" << dst << dims << ",STAT=ErrStat2)\n"; - w << " IF (ErrStat2 /= 0) THEN \n"; - w << " CALL SetErrStat(ErrID_Fatal, 'Error allocating " << dst - << ".', ErrStat, ErrMsg,RoutineName)\n"; - w << " RETURN\n"; - w << " END IF\n"; + // If dst alloc/assoc + w << indent << "if (.not. " << alloc_assoc << "(" << dst << ")) then"; + indent += " "; + w << indent << "allocate(" << dst << dims << ", stat=ErrStat2)"; + w << indent << "if (ErrStat2 /= 0) then"; + w << indent << " call SetErrStat(ErrID_Fatal, 'Error allocating " << dst << ".', ErrStat, ErrMsg, RoutineName)"; + w << indent << " return"; + w << indent << "end if"; // bjj: this needs to be updated if we've got multidimensional arrays if (gen_c_code && field.is_pointer) { std::string dst_c = "Dst" + ddt.name_short + "Data%C_obj%" + field.name; - w << " " << dst_c << "_Len = SIZE(" << dst << ")\n"; - w << " IF (" << dst_c << "_Len > 0) &\n"; - w << " " << dst_c << " = C_LOC( " << dst << "("; + w << indent << dst_c << "_Len = size(" << dst << ")"; + w << indent << "if (" << dst_c << "_Len > 0) &"; + w << indent << " " << dst_c << " = c_loc(" << dst << "("; for (int d = 1; d <= field.rank; d++) - { - w << (d > 1 ? "," : "") << " i" << d << "_l"; - } - w << " ) )\n"; + w << (d > 1 ? "," : "") << "LB(" << d << ")"; + w << "))"; } - w << " END IF\n"; + // End if dst alloc/assoc + indent.erase(indent.size() - 3); + w << indent << "end if"; } - // includes mesh and dll_type + // If derived data type (includes mesh and dll_type) if (field.data_type->tag == DataType::Tag::Derived) { auto &ddt = field.data_type->derived; for (int d = field.rank; d >= 1; d--) { - w << " DO i" << d << " = LBOUND(" << src << "," << d << "), UBOUND(" << src - << "," << d << ")\n"; + w << indent << "do i" << d << " = LB(" << d << "), UB(" << d << ")"; + indent += " "; } if (ddt.name_short.compare("MeshType") == 0) { - w << " CALL MeshCopy( " << src << dimstr(field.rank) << ", " << dst - << dimstr(field.rank) << ", CtrlCode, ErrStat2, ErrMsg2 )\n"; - w << " CALL SetErrStat(ErrStat2, ErrMsg2, " - "ErrStat, ErrMsg, RoutineName)\n"; - w << " IF (ErrStat>=AbortErrLev) RETURN\n"; + w << indent << "call MeshCopy(" << src << dimstr(field.rank) << ", " << dst + << dimstr(field.rank) << ", CtrlCode, ErrStat2, ErrMsg2 )"; + w << indent << "call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)"; + w << indent << "if (ErrStat >= AbortErrLev) return"; } else if (ddt.name_short.compare("DLL_Type") == 0) { - w << " " << dst << " = " << src << "\n"; + w << indent << dst << " = " << src << ""; } else { - w << " CALL " << ddt.module->nickname << "_Copy" - << (ddt.interface == nullptr ? tolower(ddt.name_short) : ddt.name_short) << "( " + w << indent << "call " << ddt.module->nickname << "_Copy" << ddt.name_short << "(" << src << dimstr(field.rank) << ", " << dst << dimstr(field.rank) - << ", CtrlCode, ErrStat2, ErrMsg2 )\n"; - w << " CALL SetErrStat(ErrStat2, ErrMsg2, " - "ErrStat, ErrMsg,RoutineName)\n"; - w << " IF (ErrStat>=AbortErrLev) RETURN\n"; + << ", CtrlCode, ErrStat2, ErrMsg2)"; + w << indent << "call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)"; + w << indent << "if (ErrStat >= AbortErrLev) return"; } for (auto &d : field.dims) - w << " ENDDO\n"; + { + indent.erase(indent.size() - 3); + w << indent << "end do"; + } } else { - w << " " << dst << " = " << src << "\n"; + // Copy values + w << indent << dst << " = " << src; + + // If C code and field isn't a pointer, copy data to C object if (gen_c_code && !field.is_pointer) { if (field.rank == 0) // scalar of any type OR a character array { std::string tmp = ddt.name_short + "Data%C_obj%" + field.name; - w << " Dst" << tmp << " = Src" << tmp << "\n"; + w << indent << "Dst" << tmp << " = Src" << tmp; } } } // close IF (check on allocatable array) if (field.is_allocatable) - w << "ENDIF\n"; + { + indent.erase(indent.size() - 3); + w << indent << "else if (" << alloc_assoc << "(" << dst << ")) then"; + w << indent << " deallocate(" << dst << ")"; + w << indent << "end if"; + } } - w << " END SUBROUTINE " << mod.nickname << "_Copy" << ddt.name_short << "\n" - << std::endl; + indent.erase(indent.size() - 3); + w << indent << "end subroutine"; + w << indent; } void gen_destroy(std::ostream &w, const Module &mod, const DataType::Derived &ddt, @@ -419,106 +448,124 @@ void gen_destroy(std::ostream &w, const Module &mod, const DataType::Derived &dd { auto ddt_data = ddt.name_short + "Data"; auto routine_name = mod.nickname + "_Destroy" + ddt.name_short; + std::string indent("\n"); - w << " SUBROUTINE " << routine_name << "( " << ddt_data << ", ErrStat, ErrMsg )\n"; - w << " TYPE(" << ddt.type_fortran << "), INTENT(INOUT) :: " << ddt_data << "\n"; - w << " INTEGER(IntKi), INTENT( OUT) :: ErrStat\n"; - w << " CHARACTER(*), INTENT( OUT) :: ErrMsg\n"; - w << " \n"; - w << " INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 \n"; - w << " INTEGER(IntKi) :: ErrStat2\n"; - w << " CHARACTER(ErrMsgLen) :: ErrMsg2\n"; - w << " CHARACTER(*), PARAMETER :: RoutineName = '" << routine_name << "'\n\n"; - w << " ErrStat = ErrID_None\n"; - w << " ErrMsg = \"\"\n"; - w << "\n"; + bool has_ddt = std::any_of(ddt.fields.begin(), ddt.fields.end(), [](Field f) + { return f.data_type->tag == DataType::Tag::Derived; }); + bool has_ddt_arr = std::any_of(ddt.fields.begin(), ddt.fields.end(), [](Field f) + { return f.data_type->tag == DataType::Tag::Derived && f.rank > 0; }); + w << indent << "subroutine " << routine_name << "(" << ddt_data << ", ErrStat, ErrMsg)"; + indent += " "; + w << indent << "type(" << ddt.type_fortran << "), intent(inout) :: " << ddt_data; + w << indent << "integer(IntKi), intent( out) :: ErrStat"; + w << indent << "character(*), intent( out) :: ErrMsg"; + if (has_ddt_arr) + { + w << indent << "integer(IntKi) :: "; + for (int i = 1; i <= ddt.max_rank; i++) + w << (i > 1 ? ", " : "") << "i" << i; + w << indent << "integer(IntKi) :: LB(" << ddt.max_rank << "), UB(" << ddt.max_rank << ")"; + } + if (has_ddt) + { + w << indent << "integer(IntKi) :: ErrStat2"; + w << indent << "character(ErrMsgLen) :: ErrMsg2"; + } + w << indent << "character(*), parameter :: RoutineName = '" << routine_name << "'"; + w << indent << "ErrStat = ErrID_None"; + w << indent << "ErrMsg = ''"; + + // Loop through fields in derived data type for (auto &field : ddt.fields) { - // Combine data name and field name - auto ddt_field = ddt_data + "%" + field.name; + auto var = ddt_data + "%" + field.name; + std::string alloc_assoc = field.is_pointer ? "associated" : "allocated"; + + // If field is not allocatable, skip it + if (!field.is_allocatable) + continue; + + // w << indent << "! " << field.name; // If non-target pointer field, just nullify pointer if (field.is_pointer && !field.is_target) { - w << "NULLIFY(" << ddt_field << ")\n"; + w << indent << "nullify(" << var << ")"; continue; } - // If field is an array with deferred dimensions + // If field is allocatable if (field.is_allocatable) { - w << "IF (" << (field.is_pointer ? "ASSOCIATED" : "ALLOCATED") << "(" << ddt_field - << ")) THEN\n"; + w << indent << "if (" << alloc_assoc << "(" << var << ")) then"; + indent += " "; } // If field is a derived data type, loop through elements and destroy if (field.data_type->tag == DataType::Tag::Derived) { + auto var_dims = var + dimstr(field.rank); + + if (field.rank > 0) + { + w << indent << "LB(1:" << field.rank << ") = lbound(" << var << ")"; + w << indent << "UB(1:" << field.rank << ") = ubound(" << var << ")"; + } for (int d = field.rank; d >= 1; d--) { - w << "DO i" << d << " = LBOUND(" << ddt_field << "," << d << "), UBOUND(" - << ddt_field << "," << d << ")\n"; + w << indent << "do i" << d << " = LB(" << d << "), UB(" << d << ")"; + indent += " "; } - auto ddt_field_dims = ddt_field + dimstr(field.rank); - if (field.data_type->derived.name.compare("MeshType") == 0) { - w << " CALL MeshDestroy( " << ddt_field_dims << ", ErrStat2, ErrMsg2 )\n"; - w << " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)\n"; + w << indent << "call MeshDestroy( " << var_dims << ", ErrStat2, ErrMsg2)"; + w << indent << "call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)"; } else if (field.data_type->derived.name.compare("DLL_Type") == 0) { - w << " CALL FreeDynamicLib( " << ddt_field_dims << ", ErrStat2, ErrMsg2 )\n"; - w << " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)\n"; + w << indent << "call FreeDynamicLib( " << var_dims << ", ErrStat2, ErrMsg2)"; + w << indent << "call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)"; } else { - // If field is a non-target pointer, just nullify, don't deallocate - if (field.is_pointer && !field.is_target) - { - w << " NULLIFY(" << ddt_field_dims << ")\n"; - } - else - { - std::string indent(""); - if (field.is_target) - { - w << " IF (ASSOCIATED(" << ddt_field_dims << ")) THEN\n"; - indent = " "; - } - w << indent << " CALL " << field.data_type->derived.module->nickname << "_Destroy" - << field.data_type->derived.name_short << "( " << ddt_field_dims - << ", ErrStat2, ErrMsg2 )\n"; - w << indent << " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)\n"; - if (field.is_target) - w << " ENDIF\n"; - } + w << indent << "call " << field.data_type->derived.module->nickname << "_Destroy" + << field.data_type->derived.name_short << "(" << var_dims << ", ErrStat2, ErrMsg2)"; + w << indent << "call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)"; } // Close for loops for (int d = field.rank; d >= 1; d--) - w << "ENDDO\n"; + { + indent.erase(indent.size() - 3); + w << indent << "end do"; + } } if (field.is_allocatable) { - w << " DEALLOCATE(" << ddt_field << ")\n"; + w << indent << "deallocate(" << var << ")"; if (field.is_pointer) - w << " " << ddt_field << " => NULL()\n"; + { + w << indent << var << " => null()"; + } if (gen_c_code && field.is_pointer) { - auto ddt_field_c = ddt_data + "%C_obj%" + field.name; - w << " " << ddt_field_c << " = C_NULL_PTR\n"; - w << " " << ddt_field_c << "_Len = 0\n"; + auto var_c = ddt_data + "%C_obj%" + field.name; + w << indent << var_c << " = c_null_ptr"; + w << indent << var_c << "_Len = 0"; } - w << "ENDIF\n"; + + indent.erase(indent.size() - 3); + w << indent << "end if"; } } - w << " END SUBROUTINE " << mod.nickname << "_Destroy" << ddt.name_short << "\n\n"; + indent.erase(indent.size() - 3); + w << indent << "end subroutine"; + w << indent; } void gen_pack(std::ostream &w, const Module &mod, const DataType::Derived &ddt, @@ -532,20 +579,19 @@ void gen_pack(std::ostream &w, const Module &mod, const DataType::Derived &ddt, { return f.is_allocatable; }); bool has_ptr = std::any_of(ddt.fields.begin(), ddt.fields.end(), [](Field f) { return f.is_pointer; }); - bool has_ddt_array = std::any_of(ddt.fields.begin(), ddt.fields.end(), [](Field f) - { return f.data_type->tag == DataType::Tag::Derived && f.rank > 0; }); + bool has_ddt_arr = std::any_of(ddt.fields.begin(), ddt.fields.end(), [](Field f) + { return f.data_type->tag == DataType::Tag::Derived && f.rank > 0; }); w << indent << "subroutine " << routine_name << "(Buf, Indata)"; indent += " "; w << indent << "type(PackBuffer), intent(inout) :: Buf"; w << indent << "type(" << ddt.type_fortran << "), intent(in) :: InData"; w << indent << "character(*), parameter :: RoutineName = '" << routine_name << "'"; - if (has_ddt_array) + if (has_ddt_arr) { w << indent << "integer(IntKi) :: "; for (int i = 1; i <= ddt.max_rank; i++) w << (i > 1 ? ", " : "") << "i" << i; - w << ""; w << indent << "integer(IntKi) :: LB(" << ddt.max_rank << "), UB(" << ddt.max_rank << ")"; } if (has_ptr) @@ -569,7 +615,7 @@ void gen_pack(std::ostream &w, const Module &mod, const DataType::Derived &ddt, auto assoc_alloc = field.is_pointer ? "associated" : "allocated"; auto var = "InData%" + field.name; - w << indent << "! " << field.name; + // w << indent << "! " << field.name; if (field.is_allocatable) { @@ -621,7 +667,7 @@ void gen_pack(std::ostream &w, const Module &mod, const DataType::Derived &ddt, for (int d = field.rank; d >= 1; d--) { - indent = indent.substr(0, indent.size() - 3); + indent.erase(indent.size() - 3); w << indent << "end do"; } } @@ -633,13 +679,13 @@ void gen_pack(std::ostream &w, const Module &mod, const DataType::Derived &ddt, if (field.is_pointer) { - indent = indent.substr(0, indent.size() - 3); + indent.erase(indent.size() - 3); w << indent << "end if"; } if (field.is_allocatable) { - indent = indent.substr(0, indent.size() - 3); + indent.erase(indent.size() - 3); w << indent << "end if"; } @@ -647,7 +693,7 @@ void gen_pack(std::ostream &w, const Module &mod, const DataType::Derived &ddt, w << indent << "if (RegCheckErr(Buf, RoutineName)) return"; } - indent = indent.substr(0, indent.size() - 3); + indent.erase(indent.size() - 3); w << indent << "end subroutine"; w << indent; } @@ -661,22 +707,22 @@ void gen_unpack(std::ostream &w, const Module &mod, const DataType::Derived &ddt { return f.is_allocatable; }); bool has_ptr = std::any_of(ddt.fields.begin(), ddt.fields.end(), [](Field f) { return f.is_pointer; }); - bool has_ddt_array = std::any_of(ddt.fields.begin(), ddt.fields.end(), [](Field f) - { return f.data_type->tag == DataType::Tag::Derived && f.rank > 0; }); + bool has_ddt_arr = std::any_of(ddt.fields.begin(), ddt.fields.end(), [](Field f) + { return f.data_type->tag == DataType::Tag::Derived && f.rank > 0; }); w << indent << "subroutine " << routine_name << "(Buf, OutData)"; indent += " "; w << indent << "type(PackBuffer), intent(inout) :: Buf"; w << indent << "type(" << ddt.type_fortran << "), intent(inout) :: OutData"; w << indent << "character(*), parameter :: RoutineName = '" << routine_name << "'"; - if (has_ddt_array) + if (has_ddt_arr) { w << indent << "integer(IntKi) :: "; for (int i = 1; i <= ddt.max_rank; i++) w << (i > 1 ? ", " : "") << "i" << i; w << ""; } - if (has_ddt_array || has_alloc) + if (has_ddt_arr || has_alloc) { w << indent << "integer(IntKi) :: LB(" << ddt.max_rank << "), UB(" << ddt.max_rank << ")"; } @@ -703,7 +749,7 @@ void gen_unpack(std::ostream &w, const Module &mod, const DataType::Derived &ddt std::string var_c = "OutData%C_obj%" + field.name; auto assoc_alloc = field.is_pointer ? "associated" : "allocated"; - w << indent << "! " << field.name << ""; + // w << indent << "! " << field.name << ""; if (field.is_allocatable) { @@ -802,7 +848,7 @@ void gen_unpack(std::ostream &w, const Module &mod, const DataType::Derived &ddt for (int d = field.rank; d >= 1; d--) { - indent = indent.substr(0, indent.size() - 3); + indent.erase(indent.size() - 3); w << indent << "end do"; } } @@ -834,13 +880,13 @@ void gen_unpack(std::ostream &w, const Module &mod, const DataType::Derived &ddt if (field.is_pointer) { - indent = indent.substr(0, indent.size() - 3); + indent.erase(indent.size() - 3); w << indent << "end if"; } if (field.is_allocatable) { - indent = indent.substr(0, indent.size() - 3); + indent.erase(indent.size() - 3); if (field.is_pointer) { w << indent << "else"; @@ -850,7 +896,7 @@ void gen_unpack(std::ostream &w, const Module &mod, const DataType::Derived &ddt } } - indent = indent.substr(0, indent.size() - 3); + indent.erase(indent.size() - 3); w << indent << "end subroutine"; w << indent; } diff --git a/modules/openfoam/src/OpenFOAM_Types.f90 b/modules/openfoam/src/OpenFOAM_Types.f90 index c29a2c345e..b6e27e5cfc 100644 --- a/modules/openfoam/src/OpenFOAM_Types.f90 +++ b/modules/openfoam/src/OpenFOAM_Types.f90 @@ -202,92 +202,86 @@ MODULE OpenFOAM_Types END TYPE OpFM_OutputType ! ======================= CONTAINS - SUBROUTINE OpFM_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(OpFM_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(OpFM_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_CopyInitInput' -! + +subroutine OpFM_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(OpFM_InitInputType), intent(in) :: SrcInitInputData + type(OpFM_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'OpFM_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%NumActForcePtsBlade = SrcInitInputData%NumActForcePtsBlade - DstInitInputData%C_obj%NumActForcePtsBlade = SrcInitInputData%C_obj%NumActForcePtsBlade - DstInitInputData%NumActForcePtsTower = SrcInitInputData%NumActForcePtsTower - DstInitInputData%C_obj%NumActForcePtsTower = SrcInitInputData%C_obj%NumActForcePtsTower -IF (ASSOCIATED(SrcInitInputData%StructBldRNodes)) THEN - i1_l = LBOUND(SrcInitInputData%StructBldRNodes,1) - i1_u = UBOUND(SrcInitInputData%StructBldRNodes,1) - IF (.NOT. ASSOCIATED(DstInitInputData%StructBldRNodes)) THEN - ALLOCATE(DstInitInputData%StructBldRNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%StructBldRNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInitInputData%C_obj%StructBldRNodes_Len = SIZE(DstInitInputData%StructBldRNodes) - IF (DstInitInputData%C_obj%StructBldRNodes_Len > 0) & - DstInitInputData%C_obj%StructBldRNodes = C_LOC( DstInitInputData%StructBldRNodes( i1_l ) ) - END IF - DstInitInputData%StructBldRNodes = SrcInitInputData%StructBldRNodes -ENDIF -IF (ASSOCIATED(SrcInitInputData%StructTwrHNodes)) THEN - i1_l = LBOUND(SrcInitInputData%StructTwrHNodes,1) - i1_u = UBOUND(SrcInitInputData%StructTwrHNodes,1) - IF (.NOT. ASSOCIATED(DstInitInputData%StructTwrHNodes)) THEN - ALLOCATE(DstInitInputData%StructTwrHNodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%StructTwrHNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInitInputData%C_obj%StructTwrHNodes_Len = SIZE(DstInitInputData%StructTwrHNodes) - IF (DstInitInputData%C_obj%StructTwrHNodes_Len > 0) & - DstInitInputData%C_obj%StructTwrHNodes = C_LOC( DstInitInputData%StructTwrHNodes( i1_l ) ) - END IF - DstInitInputData%StructTwrHNodes = SrcInitInputData%StructTwrHNodes -ENDIF - DstInitInputData%BladeLength = SrcInitInputData%BladeLength - DstInitInputData%C_obj%BladeLength = SrcInitInputData%C_obj%BladeLength - DstInitInputData%TowerHeight = SrcInitInputData%TowerHeight - DstInitInputData%C_obj%TowerHeight = SrcInitInputData%C_obj%TowerHeight - DstInitInputData%TowerBaseHeight = SrcInitInputData%TowerBaseHeight - DstInitInputData%C_obj%TowerBaseHeight = SrcInitInputData%C_obj%TowerBaseHeight - DstInitInputData%NodeClusterType = SrcInitInputData%NodeClusterType - DstInitInputData%C_obj%NodeClusterType = SrcInitInputData%C_obj%NodeClusterType - END SUBROUTINE OpFM_CopyInitInput - - SUBROUTINE OpFM_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(OpFM_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ASSOCIATED(InitInputData%StructBldRNodes)) THEN - DEALLOCATE(InitInputData%StructBldRNodes) - InitInputData%StructBldRNodes => NULL() - InitInputData%C_obj%StructBldRNodes = C_NULL_PTR - InitInputData%C_obj%StructBldRNodes_Len = 0 -ENDIF -IF (ASSOCIATED(InitInputData%StructTwrHNodes)) THEN - DEALLOCATE(InitInputData%StructTwrHNodes) - InitInputData%StructTwrHNodes => NULL() - InitInputData%C_obj%StructTwrHNodes = C_NULL_PTR - InitInputData%C_obj%StructTwrHNodes_Len = 0 -ENDIF - END SUBROUTINE OpFM_DestroyInitInput + ErrMsg = '' + DstInitInputData%NumActForcePtsBlade = SrcInitInputData%NumActForcePtsBlade + DstInitInputData%C_obj%NumActForcePtsBlade = SrcInitInputData%C_obj%NumActForcePtsBlade + DstInitInputData%NumActForcePtsTower = SrcInitInputData%NumActForcePtsTower + DstInitInputData%C_obj%NumActForcePtsTower = SrcInitInputData%C_obj%NumActForcePtsTower + if (associated(SrcInitInputData%StructBldRNodes)) then + LB(1:1) = lbound(SrcInitInputData%StructBldRNodes) + UB(1:1) = ubound(SrcInitInputData%StructBldRNodes) + if (.not. associated(DstInitInputData%StructBldRNodes)) then + allocate(DstInitInputData%StructBldRNodes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%StructBldRNodes.', ErrStat, ErrMsg, RoutineName) + return + end if + DstInitInputData%C_obj%StructBldRNodes_Len = size(DstInitInputData%StructBldRNodes) + if (DstInitInputData%C_obj%StructBldRNodes_Len > 0) & + DstInitInputData%C_obj%StructBldRNodes = c_loc(DstInitInputData%StructBldRNodes(LB(1))) + end if + DstInitInputData%StructBldRNodes = SrcInitInputData%StructBldRNodes + else if (associated(DstInitInputData%StructBldRNodes)) then + deallocate(DstInitInputData%StructBldRNodes) + end if + if (associated(SrcInitInputData%StructTwrHNodes)) then + LB(1:1) = lbound(SrcInitInputData%StructTwrHNodes) + UB(1:1) = ubound(SrcInitInputData%StructTwrHNodes) + if (.not. associated(DstInitInputData%StructTwrHNodes)) then + allocate(DstInitInputData%StructTwrHNodes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%StructTwrHNodes.', ErrStat, ErrMsg, RoutineName) + return + end if + DstInitInputData%C_obj%StructTwrHNodes_Len = size(DstInitInputData%StructTwrHNodes) + if (DstInitInputData%C_obj%StructTwrHNodes_Len > 0) & + DstInitInputData%C_obj%StructTwrHNodes = c_loc(DstInitInputData%StructTwrHNodes(LB(1))) + end if + DstInitInputData%StructTwrHNodes = SrcInitInputData%StructTwrHNodes + else if (associated(DstInitInputData%StructTwrHNodes)) then + deallocate(DstInitInputData%StructTwrHNodes) + end if + DstInitInputData%BladeLength = SrcInitInputData%BladeLength + DstInitInputData%C_obj%BladeLength = SrcInitInputData%C_obj%BladeLength + DstInitInputData%TowerHeight = SrcInitInputData%TowerHeight + DstInitInputData%C_obj%TowerHeight = SrcInitInputData%C_obj%TowerHeight + DstInitInputData%TowerBaseHeight = SrcInitInputData%TowerBaseHeight + DstInitInputData%C_obj%TowerBaseHeight = SrcInitInputData%C_obj%TowerBaseHeight + DstInitInputData%NodeClusterType = SrcInitInputData%NodeClusterType + DstInitInputData%C_obj%NodeClusterType = SrcInitInputData%C_obj%NodeClusterType +end subroutine +subroutine OpFM_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(OpFM_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'OpFM_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(InitInputData%StructBldRNodes)) then + deallocate(InitInputData%StructBldRNodes) + InitInputData%StructBldRNodes => null() + InitInputData%C_obj%StructBldRNodes = c_null_ptr + InitInputData%C_obj%StructBldRNodes_Len = 0 + end if + if (associated(InitInputData%StructTwrHNodes)) then + deallocate(InitInputData%StructTwrHNodes) + InitInputData%StructTwrHNodes => null() + InitInputData%C_obj%StructTwrHNodes = c_null_ptr + InitInputData%C_obj%StructTwrHNodes_Len = 0 + end if +end subroutine subroutine OpFM_PackInitInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -299,13 +293,10 @@ subroutine OpFM_PackInitInput(Buf, Indata) call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - ! NumActForcePtsBlade call RegPack(Buf, InData%NumActForcePtsBlade) if (RegCheckErr(Buf, RoutineName)) return - ! NumActForcePtsTower call RegPack(Buf, InData%NumActForcePtsTower) if (RegCheckErr(Buf, RoutineName)) return - ! StructBldRNodes call RegPack(Buf, associated(InData%StructBldRNodes)) if (associated(InData%StructBldRNodes)) then call RegPackBounds(Buf, 1, lbound(InData%StructBldRNodes), ubound(InData%StructBldRNodes)) @@ -315,7 +306,6 @@ subroutine OpFM_PackInitInput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! StructTwrHNodes call RegPack(Buf, associated(InData%StructTwrHNodes)) if (associated(InData%StructTwrHNodes)) then call RegPackBounds(Buf, 1, lbound(InData%StructTwrHNodes), ubound(InData%StructTwrHNodes)) @@ -325,16 +315,12 @@ subroutine OpFM_PackInitInput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! BladeLength call RegPack(Buf, InData%BladeLength) if (RegCheckErr(Buf, RoutineName)) return - ! TowerHeight call RegPack(Buf, InData%TowerHeight) if (RegCheckErr(Buf, RoutineName)) return - ! TowerBaseHeight call RegPack(Buf, InData%TowerBaseHeight) if (RegCheckErr(Buf, RoutineName)) return - ! NodeClusterType call RegPack(Buf, InData%NodeClusterType) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -349,15 +335,12 @@ subroutine OpFM_UnPackInitInput(Buf, OutData) integer(IntKi) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return - ! NumActForcePtsBlade call RegUnpack(Buf, OutData%NumActForcePtsBlade) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%NumActForcePtsBlade = OutData%NumActForcePtsBlade - ! NumActForcePtsTower call RegUnpack(Buf, OutData%NumActForcePtsTower) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%NumActForcePtsTower = OutData%NumActForcePtsTower - ! StructBldRNodes if (associated(OutData%StructBldRNodes)) deallocate(OutData%StructBldRNodes) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -384,7 +367,6 @@ subroutine OpFM_UnPackInitInput(Buf, OutData) else OutData%StructBldRNodes => null() end if - ! StructTwrHNodes if (associated(OutData%StructTwrHNodes)) deallocate(OutData%StructTwrHNodes) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -411,19 +393,15 @@ subroutine OpFM_UnPackInitInput(Buf, OutData) else OutData%StructTwrHNodes => null() end if - ! BladeLength call RegUnpack(Buf, OutData%BladeLength) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%BladeLength = OutData%BladeLength - ! TowerHeight call RegUnpack(Buf, OutData%TowerHeight) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%TowerHeight = OutData%TowerHeight - ! TowerBaseHeight call RegUnpack(Buf, OutData%TowerBaseHeight) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%TowerBaseHeight = OutData%TowerBaseHeight - ! NodeClusterType call RegUnpack(Buf, OutData%NodeClusterType) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%NodeClusterType = OutData%NodeClusterType @@ -516,73 +494,68 @@ SUBROUTINE OpFM_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers InitInputData%C_obj%NodeClusterType = InitInputData%NodeClusterType END SUBROUTINE OpFM_F2C_CopyInitInput - SUBROUTINE OpFM_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(OpFM_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(OpFM_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_CopyInitOutput' -! + +subroutine OpFM_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(OpFM_InitOutputType), intent(in) :: SrcInitOutputData + type(OpFM_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'OpFM_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInitOutputData%WriteOutputHdr)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputHdr,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputHdr,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputHdr)) THEN - ALLOCATE(DstInitOutputData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr -ENDIF -IF (ALLOCATED(SrcInitOutputData%WriteOutputUnt)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputUnt,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputUnt,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputUnt)) THEN - ALLOCATE(DstInitOutputData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt -ENDIF - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE OpFM_CopyInitOutput - - SUBROUTINE OpFM_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(OpFM_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF - CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE OpFM_DestroyInitOutput + ErrMsg = '' + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr + else if (allocated(DstInitOutputData%WriteOutputHdr)) then + deallocate(DstInitOutputData%WriteOutputHdr) + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt + else if (allocated(DstInitOutputData%WriteOutputUnt)) then + deallocate(DstInitOutputData%WriteOutputUnt) + end if + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine OpFM_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(OpFM_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'OpFM_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if +end subroutine subroutine OpFM_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -593,21 +566,18 @@ subroutine OpFM_PackInitOutput(Buf, Indata) call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - ! WriteOutputHdr call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) call RegPack(Buf, InData%WriteOutputHdr) end if if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutputUnt call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) call RegPack(Buf, InData%WriteOutputUnt) end if if (RegCheckErr(Buf, RoutineName)) return - ! Ver call NWTC_Library_PackProgDesc(Buf, InData%Ver) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -620,7 +590,6 @@ subroutine OpFM_UnPackInitOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! WriteOutputHdr if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -635,7 +604,6 @@ subroutine OpFM_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutputHdr) if (RegCheckErr(Buf, RoutineName)) return end if - ! WriteOutputUnt if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -650,7 +618,6 @@ subroutine OpFM_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutputUnt) if (RegCheckErr(Buf, RoutineName)) return end if - ! Ver call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver end subroutine SUBROUTINE OpFM_C2Fary_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) @@ -687,130 +654,142 @@ SUBROUTINE OpFM_F2C_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointer END IF END SUBROUTINE OpFM_F2C_CopyInitOutput - SUBROUTINE OpFM_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(OpFM_MiscVarType), INTENT(INOUT) :: SrcMiscData - TYPE(OpFM_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_CopyMisc' -! + +subroutine OpFM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(OpFM_MiscVarType), intent(inout) :: SrcMiscData + type(OpFM_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'OpFM_CopyMisc' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscData%ActForceMotionsPoints)) THEN - i1_l = LBOUND(SrcMiscData%ActForceMotionsPoints,1) - i1_u = UBOUND(SrcMiscData%ActForceMotionsPoints,1) - IF (.NOT. ALLOCATED(DstMiscData%ActForceMotionsPoints)) THEN - ALLOCATE(DstMiscData%ActForceMotionsPoints(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ActForceMotionsPoints.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%ActForceMotionsPoints,1), UBOUND(SrcMiscData%ActForceMotionsPoints,1) - CALL MeshCopy( SrcMiscData%ActForceMotionsPoints(i1), DstMiscData%ActForceMotionsPoints(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%ActForceLoadsPoints)) THEN - i1_l = LBOUND(SrcMiscData%ActForceLoadsPoints,1) - i1_u = UBOUND(SrcMiscData%ActForceLoadsPoints,1) - IF (.NOT. ALLOCATED(DstMiscData%ActForceLoadsPoints)) THEN - ALLOCATE(DstMiscData%ActForceLoadsPoints(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ActForceLoadsPoints.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%ActForceLoadsPoints,1), UBOUND(SrcMiscData%ActForceLoadsPoints,1) - CALL MeshCopy( SrcMiscData%ActForceLoadsPoints(i1), DstMiscData%ActForceLoadsPoints(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%Line2_to_Point_Loads)) THEN - i1_l = LBOUND(SrcMiscData%Line2_to_Point_Loads,1) - i1_u = UBOUND(SrcMiscData%Line2_to_Point_Loads,1) - IF (.NOT. ALLOCATED(DstMiscData%Line2_to_Point_Loads)) THEN - ALLOCATE(DstMiscData%Line2_to_Point_Loads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Line2_to_Point_Loads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%Line2_to_Point_Loads,1), UBOUND(SrcMiscData%Line2_to_Point_Loads,1) - CALL NWTC_Library_Copymeshmaptype( SrcMiscData%Line2_to_Point_Loads(i1), DstMiscData%Line2_to_Point_Loads(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%Line2_to_Point_Motions)) THEN - i1_l = LBOUND(SrcMiscData%Line2_to_Point_Motions,1) - i1_u = UBOUND(SrcMiscData%Line2_to_Point_Motions,1) - IF (.NOT. ALLOCATED(DstMiscData%Line2_to_Point_Motions)) THEN - ALLOCATE(DstMiscData%Line2_to_Point_Motions(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Line2_to_Point_Motions.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%Line2_to_Point_Motions,1), UBOUND(SrcMiscData%Line2_to_Point_Motions,1) - CALL NWTC_Library_Copymeshmaptype( SrcMiscData%Line2_to_Point_Motions(i1), DstMiscData%Line2_to_Point_Motions(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE OpFM_CopyMisc - - SUBROUTINE OpFM_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(OpFM_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MiscData%ActForceMotionsPoints)) THEN -DO i1 = LBOUND(MiscData%ActForceMotionsPoints,1), UBOUND(MiscData%ActForceMotionsPoints,1) - CALL MeshDestroy( MiscData%ActForceMotionsPoints(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%ActForceMotionsPoints) -ENDIF -IF (ALLOCATED(MiscData%ActForceLoadsPoints)) THEN -DO i1 = LBOUND(MiscData%ActForceLoadsPoints,1), UBOUND(MiscData%ActForceLoadsPoints,1) - CALL MeshDestroy( MiscData%ActForceLoadsPoints(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%ActForceLoadsPoints) -ENDIF -IF (ALLOCATED(MiscData%Line2_to_Point_Loads)) THEN -DO i1 = LBOUND(MiscData%Line2_to_Point_Loads,1), UBOUND(MiscData%Line2_to_Point_Loads,1) - CALL NWTC_Library_DestroyMeshMapType( MiscData%Line2_to_Point_Loads(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%Line2_to_Point_Loads) -ENDIF -IF (ALLOCATED(MiscData%Line2_to_Point_Motions)) THEN -DO i1 = LBOUND(MiscData%Line2_to_Point_Motions,1), UBOUND(MiscData%Line2_to_Point_Motions,1) - CALL NWTC_Library_DestroyMeshMapType( MiscData%Line2_to_Point_Motions(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%Line2_to_Point_Motions) -ENDIF - END SUBROUTINE OpFM_DestroyMisc + ErrMsg = '' + if (allocated(SrcMiscData%ActForceMotionsPoints)) then + LB(1:1) = lbound(SrcMiscData%ActForceMotionsPoints) + UB(1:1) = ubound(SrcMiscData%ActForceMotionsPoints) + if (.not. allocated(DstMiscData%ActForceMotionsPoints)) then + allocate(DstMiscData%ActForceMotionsPoints(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ActForceMotionsPoints.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcMiscData%ActForceMotionsPoints(i1), DstMiscData%ActForceMotionsPoints(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstMiscData%ActForceMotionsPoints)) then + deallocate(DstMiscData%ActForceMotionsPoints) + end if + if (allocated(SrcMiscData%ActForceLoadsPoints)) then + LB(1:1) = lbound(SrcMiscData%ActForceLoadsPoints) + UB(1:1) = ubound(SrcMiscData%ActForceLoadsPoints) + if (.not. allocated(DstMiscData%ActForceLoadsPoints)) then + allocate(DstMiscData%ActForceLoadsPoints(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ActForceLoadsPoints.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcMiscData%ActForceLoadsPoints(i1), DstMiscData%ActForceLoadsPoints(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstMiscData%ActForceLoadsPoints)) then + deallocate(DstMiscData%ActForceLoadsPoints) + end if + if (allocated(SrcMiscData%Line2_to_Point_Loads)) then + LB(1:1) = lbound(SrcMiscData%Line2_to_Point_Loads) + UB(1:1) = ubound(SrcMiscData%Line2_to_Point_Loads) + if (.not. allocated(DstMiscData%Line2_to_Point_Loads)) then + allocate(DstMiscData%Line2_to_Point_Loads(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Line2_to_Point_Loads.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcMiscData%Line2_to_Point_Loads(i1), DstMiscData%Line2_to_Point_Loads(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstMiscData%Line2_to_Point_Loads)) then + deallocate(DstMiscData%Line2_to_Point_Loads) + end if + if (allocated(SrcMiscData%Line2_to_Point_Motions)) then + LB(1:1) = lbound(SrcMiscData%Line2_to_Point_Motions) + UB(1:1) = ubound(SrcMiscData%Line2_to_Point_Motions) + if (.not. allocated(DstMiscData%Line2_to_Point_Motions)) then + allocate(DstMiscData%Line2_to_Point_Motions(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Line2_to_Point_Motions.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcMiscData%Line2_to_Point_Motions(i1), DstMiscData%Line2_to_Point_Motions(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstMiscData%Line2_to_Point_Motions)) then + deallocate(DstMiscData%Line2_to_Point_Motions) + end if +end subroutine +subroutine OpFM_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(OpFM_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'OpFM_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%ActForceMotionsPoints)) then + LB(1:1) = lbound(MiscData%ActForceMotionsPoints) + UB(1:1) = ubound(MiscData%ActForceMotionsPoints) + do i1 = LB(1), UB(1) + call MeshDestroy( MiscData%ActForceMotionsPoints(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%ActForceMotionsPoints) + end if + if (allocated(MiscData%ActForceLoadsPoints)) then + LB(1:1) = lbound(MiscData%ActForceLoadsPoints) + UB(1:1) = ubound(MiscData%ActForceLoadsPoints) + do i1 = LB(1), UB(1) + call MeshDestroy( MiscData%ActForceLoadsPoints(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%ActForceLoadsPoints) + end if + if (allocated(MiscData%Line2_to_Point_Loads)) then + LB(1:1) = lbound(MiscData%Line2_to_Point_Loads) + UB(1:1) = ubound(MiscData%Line2_to_Point_Loads) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(MiscData%Line2_to_Point_Loads(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%Line2_to_Point_Loads) + end if + if (allocated(MiscData%Line2_to_Point_Motions)) then + LB(1:1) = lbound(MiscData%Line2_to_Point_Motions) + UB(1:1) = ubound(MiscData%Line2_to_Point_Motions) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(MiscData%Line2_to_Point_Motions(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%Line2_to_Point_Motions) + end if +end subroutine subroutine OpFM_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -823,7 +802,6 @@ subroutine OpFM_PackMisc(Buf, Indata) call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - ! ActForceMotionsPoints call RegPack(Buf, allocated(InData%ActForceMotionsPoints)) if (allocated(InData%ActForceMotionsPoints)) then call RegPackBounds(Buf, 1, lbound(InData%ActForceMotionsPoints), ubound(InData%ActForceMotionsPoints)) @@ -834,7 +812,6 @@ subroutine OpFM_PackMisc(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! ActForceLoadsPoints call RegPack(Buf, allocated(InData%ActForceLoadsPoints)) if (allocated(InData%ActForceLoadsPoints)) then call RegPackBounds(Buf, 1, lbound(InData%ActForceLoadsPoints), ubound(InData%ActForceLoadsPoints)) @@ -845,7 +822,6 @@ subroutine OpFM_PackMisc(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! Line2_to_Point_Loads call RegPack(Buf, allocated(InData%Line2_to_Point_Loads)) if (allocated(InData%Line2_to_Point_Loads)) then call RegPackBounds(Buf, 1, lbound(InData%Line2_to_Point_Loads), ubound(InData%Line2_to_Point_Loads)) @@ -856,7 +832,6 @@ subroutine OpFM_PackMisc(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! Line2_to_Point_Motions call RegPack(Buf, allocated(InData%Line2_to_Point_Motions)) if (allocated(InData%Line2_to_Point_Motions)) then call RegPackBounds(Buf, 1, lbound(InData%Line2_to_Point_Motions), ubound(InData%Line2_to_Point_Motions)) @@ -878,7 +853,6 @@ subroutine OpFM_UnPackMisc(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! ActForceMotionsPoints if (allocated(OutData%ActForceMotionsPoints)) deallocate(OutData%ActForceMotionsPoints) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -894,7 +868,6 @@ subroutine OpFM_UnPackMisc(Buf, OutData) call MeshUnpack(Buf, OutData%ActForceMotionsPoints(i1)) ! ActForceMotionsPoints end do end if - ! ActForceLoadsPoints if (allocated(OutData%ActForceLoadsPoints)) deallocate(OutData%ActForceLoadsPoints) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -910,7 +883,6 @@ subroutine OpFM_UnPackMisc(Buf, OutData) call MeshUnpack(Buf, OutData%ActForceLoadsPoints(i1)) ! ActForceLoadsPoints end do end if - ! Line2_to_Point_Loads if (allocated(OutData%Line2_to_Point_Loads)) deallocate(OutData%Line2_to_Point_Loads) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -926,7 +898,6 @@ subroutine OpFM_UnPackMisc(Buf, OutData) call NWTC_Library_UnpackMeshMapType(Buf, OutData%Line2_to_Point_Loads(i1)) ! Line2_to_Point_Loads end do end if - ! Line2_to_Point_Motions if (allocated(OutData%Line2_to_Point_Motions)) deallocate(OutData%Line2_to_Point_Motions) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -977,102 +948,96 @@ SUBROUTINE OpFM_F2C_CopyMisc( MiscData, ErrStat, ErrMsg, SkipPointers ) END IF END SUBROUTINE OpFM_F2C_CopyMisc - SUBROUTINE OpFM_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(OpFM_ParameterType), INTENT(IN) :: SrcParamData - TYPE(OpFM_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_CopyParam' -! + +subroutine OpFM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(OpFM_ParameterType), intent(in) :: SrcParamData + type(OpFM_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'OpFM_CopyParam' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%AirDens = SrcParamData%AirDens - DstParamData%C_obj%AirDens = SrcParamData%C_obj%AirDens - DstParamData%NumBl = SrcParamData%NumBl - DstParamData%C_obj%NumBl = SrcParamData%C_obj%NumBl - DstParamData%NMappings = SrcParamData%NMappings - DstParamData%C_obj%NMappings = SrcParamData%C_obj%NMappings - DstParamData%NnodesVel = SrcParamData%NnodesVel - DstParamData%C_obj%NnodesVel = SrcParamData%C_obj%NnodesVel - DstParamData%NnodesForce = SrcParamData%NnodesForce - DstParamData%C_obj%NnodesForce = SrcParamData%C_obj%NnodesForce - DstParamData%NnodesForceBlade = SrcParamData%NnodesForceBlade - DstParamData%C_obj%NnodesForceBlade = SrcParamData%C_obj%NnodesForceBlade - DstParamData%NnodesForceTower = SrcParamData%NnodesForceTower - DstParamData%C_obj%NnodesForceTower = SrcParamData%C_obj%NnodesForceTower -IF (ASSOCIATED(SrcParamData%forceBldRnodes)) THEN - i1_l = LBOUND(SrcParamData%forceBldRnodes,1) - i1_u = UBOUND(SrcParamData%forceBldRnodes,1) - IF (.NOT. ASSOCIATED(DstParamData%forceBldRnodes)) THEN - ALLOCATE(DstParamData%forceBldRnodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%forceBldRnodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstParamData%C_obj%forceBldRnodes_Len = SIZE(DstParamData%forceBldRnodes) - IF (DstParamData%C_obj%forceBldRnodes_Len > 0) & - DstParamData%C_obj%forceBldRnodes = C_LOC( DstParamData%forceBldRnodes( i1_l ) ) - END IF - DstParamData%forceBldRnodes = SrcParamData%forceBldRnodes -ENDIF -IF (ASSOCIATED(SrcParamData%forceTwrHnodes)) THEN - i1_l = LBOUND(SrcParamData%forceTwrHnodes,1) - i1_u = UBOUND(SrcParamData%forceTwrHnodes,1) - IF (.NOT. ASSOCIATED(DstParamData%forceTwrHnodes)) THEN - ALLOCATE(DstParamData%forceTwrHnodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%forceTwrHnodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstParamData%C_obj%forceTwrHnodes_Len = SIZE(DstParamData%forceTwrHnodes) - IF (DstParamData%C_obj%forceTwrHnodes_Len > 0) & - DstParamData%C_obj%forceTwrHnodes = C_LOC( DstParamData%forceTwrHnodes( i1_l ) ) - END IF - DstParamData%forceTwrHnodes = SrcParamData%forceTwrHnodes -ENDIF - DstParamData%BladeLength = SrcParamData%BladeLength - DstParamData%C_obj%BladeLength = SrcParamData%C_obj%BladeLength - DstParamData%TowerHeight = SrcParamData%TowerHeight - DstParamData%C_obj%TowerHeight = SrcParamData%C_obj%TowerHeight - DstParamData%TowerBaseHeight = SrcParamData%TowerBaseHeight - DstParamData%C_obj%TowerBaseHeight = SrcParamData%C_obj%TowerBaseHeight - DstParamData%NodeClusterType = SrcParamData%NodeClusterType - DstParamData%C_obj%NodeClusterType = SrcParamData%C_obj%NodeClusterType - END SUBROUTINE OpFM_CopyParam - - SUBROUTINE OpFM_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(OpFM_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ASSOCIATED(ParamData%forceBldRnodes)) THEN - DEALLOCATE(ParamData%forceBldRnodes) - ParamData%forceBldRnodes => NULL() - ParamData%C_obj%forceBldRnodes = C_NULL_PTR - ParamData%C_obj%forceBldRnodes_Len = 0 -ENDIF -IF (ASSOCIATED(ParamData%forceTwrHnodes)) THEN - DEALLOCATE(ParamData%forceTwrHnodes) - ParamData%forceTwrHnodes => NULL() - ParamData%C_obj%forceTwrHnodes = C_NULL_PTR - ParamData%C_obj%forceTwrHnodes_Len = 0 -ENDIF - END SUBROUTINE OpFM_DestroyParam + ErrMsg = '' + DstParamData%AirDens = SrcParamData%AirDens + DstParamData%C_obj%AirDens = SrcParamData%C_obj%AirDens + DstParamData%NumBl = SrcParamData%NumBl + DstParamData%C_obj%NumBl = SrcParamData%C_obj%NumBl + DstParamData%NMappings = SrcParamData%NMappings + DstParamData%C_obj%NMappings = SrcParamData%C_obj%NMappings + DstParamData%NnodesVel = SrcParamData%NnodesVel + DstParamData%C_obj%NnodesVel = SrcParamData%C_obj%NnodesVel + DstParamData%NnodesForce = SrcParamData%NnodesForce + DstParamData%C_obj%NnodesForce = SrcParamData%C_obj%NnodesForce + DstParamData%NnodesForceBlade = SrcParamData%NnodesForceBlade + DstParamData%C_obj%NnodesForceBlade = SrcParamData%C_obj%NnodesForceBlade + DstParamData%NnodesForceTower = SrcParamData%NnodesForceTower + DstParamData%C_obj%NnodesForceTower = SrcParamData%C_obj%NnodesForceTower + if (associated(SrcParamData%forceBldRnodes)) then + LB(1:1) = lbound(SrcParamData%forceBldRnodes) + UB(1:1) = ubound(SrcParamData%forceBldRnodes) + if (.not. associated(DstParamData%forceBldRnodes)) then + allocate(DstParamData%forceBldRnodes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%forceBldRnodes.', ErrStat, ErrMsg, RoutineName) + return + end if + DstParamData%C_obj%forceBldRnodes_Len = size(DstParamData%forceBldRnodes) + if (DstParamData%C_obj%forceBldRnodes_Len > 0) & + DstParamData%C_obj%forceBldRnodes = c_loc(DstParamData%forceBldRnodes(LB(1))) + end if + DstParamData%forceBldRnodes = SrcParamData%forceBldRnodes + else if (associated(DstParamData%forceBldRnodes)) then + deallocate(DstParamData%forceBldRnodes) + end if + if (associated(SrcParamData%forceTwrHnodes)) then + LB(1:1) = lbound(SrcParamData%forceTwrHnodes) + UB(1:1) = ubound(SrcParamData%forceTwrHnodes) + if (.not. associated(DstParamData%forceTwrHnodes)) then + allocate(DstParamData%forceTwrHnodes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%forceTwrHnodes.', ErrStat, ErrMsg, RoutineName) + return + end if + DstParamData%C_obj%forceTwrHnodes_Len = size(DstParamData%forceTwrHnodes) + if (DstParamData%C_obj%forceTwrHnodes_Len > 0) & + DstParamData%C_obj%forceTwrHnodes = c_loc(DstParamData%forceTwrHnodes(LB(1))) + end if + DstParamData%forceTwrHnodes = SrcParamData%forceTwrHnodes + else if (associated(DstParamData%forceTwrHnodes)) then + deallocate(DstParamData%forceTwrHnodes) + end if + DstParamData%BladeLength = SrcParamData%BladeLength + DstParamData%C_obj%BladeLength = SrcParamData%C_obj%BladeLength + DstParamData%TowerHeight = SrcParamData%TowerHeight + DstParamData%C_obj%TowerHeight = SrcParamData%C_obj%TowerHeight + DstParamData%TowerBaseHeight = SrcParamData%TowerBaseHeight + DstParamData%C_obj%TowerBaseHeight = SrcParamData%C_obj%TowerBaseHeight + DstParamData%NodeClusterType = SrcParamData%NodeClusterType + DstParamData%C_obj%NodeClusterType = SrcParamData%C_obj%NodeClusterType +end subroutine +subroutine OpFM_DestroyParam(ParamData, ErrStat, ErrMsg) + type(OpFM_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'OpFM_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(ParamData%forceBldRnodes)) then + deallocate(ParamData%forceBldRnodes) + ParamData%forceBldRnodes => null() + ParamData%C_obj%forceBldRnodes = c_null_ptr + ParamData%C_obj%forceBldRnodes_Len = 0 + end if + if (associated(ParamData%forceTwrHnodes)) then + deallocate(ParamData%forceTwrHnodes) + ParamData%forceTwrHnodes => null() + ParamData%C_obj%forceTwrHnodes = c_null_ptr + ParamData%C_obj%forceTwrHnodes_Len = 0 + end if +end subroutine subroutine OpFM_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -1084,28 +1049,20 @@ subroutine OpFM_PackParam(Buf, Indata) call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - ! AirDens call RegPack(Buf, InData%AirDens) if (RegCheckErr(Buf, RoutineName)) return - ! NumBl call RegPack(Buf, InData%NumBl) if (RegCheckErr(Buf, RoutineName)) return - ! NMappings call RegPack(Buf, InData%NMappings) if (RegCheckErr(Buf, RoutineName)) return - ! NnodesVel call RegPack(Buf, InData%NnodesVel) if (RegCheckErr(Buf, RoutineName)) return - ! NnodesForce call RegPack(Buf, InData%NnodesForce) if (RegCheckErr(Buf, RoutineName)) return - ! NnodesForceBlade call RegPack(Buf, InData%NnodesForceBlade) if (RegCheckErr(Buf, RoutineName)) return - ! NnodesForceTower call RegPack(Buf, InData%NnodesForceTower) if (RegCheckErr(Buf, RoutineName)) return - ! forceBldRnodes call RegPack(Buf, associated(InData%forceBldRnodes)) if (associated(InData%forceBldRnodes)) then call RegPackBounds(Buf, 1, lbound(InData%forceBldRnodes), ubound(InData%forceBldRnodes)) @@ -1115,7 +1072,6 @@ subroutine OpFM_PackParam(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! forceTwrHnodes call RegPack(Buf, associated(InData%forceTwrHnodes)) if (associated(InData%forceTwrHnodes)) then call RegPackBounds(Buf, 1, lbound(InData%forceTwrHnodes), ubound(InData%forceTwrHnodes)) @@ -1125,16 +1081,12 @@ subroutine OpFM_PackParam(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! BladeLength call RegPack(Buf, InData%BladeLength) if (RegCheckErr(Buf, RoutineName)) return - ! TowerHeight call RegPack(Buf, InData%TowerHeight) if (RegCheckErr(Buf, RoutineName)) return - ! TowerBaseHeight call RegPack(Buf, InData%TowerBaseHeight) if (RegCheckErr(Buf, RoutineName)) return - ! NodeClusterType call RegPack(Buf, InData%NodeClusterType) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1149,35 +1101,27 @@ subroutine OpFM_UnPackParam(Buf, OutData) integer(IntKi) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return - ! AirDens call RegUnpack(Buf, OutData%AirDens) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%AirDens = OutData%AirDens - ! NumBl call RegUnpack(Buf, OutData%NumBl) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%NumBl = OutData%NumBl - ! NMappings call RegUnpack(Buf, OutData%NMappings) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%NMappings = OutData%NMappings - ! NnodesVel call RegUnpack(Buf, OutData%NnodesVel) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%NnodesVel = OutData%NnodesVel - ! NnodesForce call RegUnpack(Buf, OutData%NnodesForce) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%NnodesForce = OutData%NnodesForce - ! NnodesForceBlade call RegUnpack(Buf, OutData%NnodesForceBlade) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%NnodesForceBlade = OutData%NnodesForceBlade - ! NnodesForceTower call RegUnpack(Buf, OutData%NnodesForceTower) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%NnodesForceTower = OutData%NnodesForceTower - ! forceBldRnodes if (associated(OutData%forceBldRnodes)) deallocate(OutData%forceBldRnodes) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1204,7 +1148,6 @@ subroutine OpFM_UnPackParam(Buf, OutData) else OutData%forceBldRnodes => null() end if - ! forceTwrHnodes if (associated(OutData%forceTwrHnodes)) deallocate(OutData%forceTwrHnodes) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1231,19 +1174,15 @@ subroutine OpFM_UnPackParam(Buf, OutData) else OutData%forceTwrHnodes => null() end if - ! BladeLength call RegUnpack(Buf, OutData%BladeLength) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%BladeLength = OutData%BladeLength - ! TowerHeight call RegUnpack(Buf, OutData%TowerHeight) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%TowerHeight = OutData%TowerHeight - ! TowerBaseHeight call RegUnpack(Buf, OutData%TowerBaseHeight) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%TowerBaseHeight = OutData%TowerBaseHeight - ! NodeClusterType call RegUnpack(Buf, OutData%NodeClusterType) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%NodeClusterType = OutData%NodeClusterType @@ -1346,395 +1285,419 @@ SUBROUTINE OpFM_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) ParamData%C_obj%NodeClusterType = ParamData%NodeClusterType END SUBROUTINE OpFM_F2C_CopyParam - SUBROUTINE OpFM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(OpFM_InputType), INTENT(IN) :: SrcInputData - TYPE(OpFM_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_CopyInput' -! + +subroutine OpFM_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(OpFM_InputType), intent(in) :: SrcInputData + type(OpFM_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'OpFM_CopyInput' ErrStat = ErrID_None - ErrMsg = "" -IF (ASSOCIATED(SrcInputData%pxVel)) THEN - i1_l = LBOUND(SrcInputData%pxVel,1) - i1_u = UBOUND(SrcInputData%pxVel,1) - IF (.NOT. ASSOCIATED(DstInputData%pxVel)) THEN - ALLOCATE(DstInputData%pxVel(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%pxVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%C_obj%pxVel_Len = SIZE(DstInputData%pxVel) - IF (DstInputData%C_obj%pxVel_Len > 0) & - DstInputData%C_obj%pxVel = C_LOC( DstInputData%pxVel( i1_l ) ) - END IF - DstInputData%pxVel = SrcInputData%pxVel -ENDIF -IF (ASSOCIATED(SrcInputData%pyVel)) THEN - i1_l = LBOUND(SrcInputData%pyVel,1) - i1_u = UBOUND(SrcInputData%pyVel,1) - IF (.NOT. ASSOCIATED(DstInputData%pyVel)) THEN - ALLOCATE(DstInputData%pyVel(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%pyVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%C_obj%pyVel_Len = SIZE(DstInputData%pyVel) - IF (DstInputData%C_obj%pyVel_Len > 0) & - DstInputData%C_obj%pyVel = C_LOC( DstInputData%pyVel( i1_l ) ) - END IF - DstInputData%pyVel = SrcInputData%pyVel -ENDIF -IF (ASSOCIATED(SrcInputData%pzVel)) THEN - i1_l = LBOUND(SrcInputData%pzVel,1) - i1_u = UBOUND(SrcInputData%pzVel,1) - IF (.NOT. ASSOCIATED(DstInputData%pzVel)) THEN - ALLOCATE(DstInputData%pzVel(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%pzVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%C_obj%pzVel_Len = SIZE(DstInputData%pzVel) - IF (DstInputData%C_obj%pzVel_Len > 0) & - DstInputData%C_obj%pzVel = C_LOC( DstInputData%pzVel( i1_l ) ) - END IF - DstInputData%pzVel = SrcInputData%pzVel -ENDIF -IF (ASSOCIATED(SrcInputData%pxForce)) THEN - i1_l = LBOUND(SrcInputData%pxForce,1) - i1_u = UBOUND(SrcInputData%pxForce,1) - IF (.NOT. ASSOCIATED(DstInputData%pxForce)) THEN - ALLOCATE(DstInputData%pxForce(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%pxForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%C_obj%pxForce_Len = SIZE(DstInputData%pxForce) - IF (DstInputData%C_obj%pxForce_Len > 0) & - DstInputData%C_obj%pxForce = C_LOC( DstInputData%pxForce( i1_l ) ) - END IF - DstInputData%pxForce = SrcInputData%pxForce -ENDIF -IF (ASSOCIATED(SrcInputData%pyForce)) THEN - i1_l = LBOUND(SrcInputData%pyForce,1) - i1_u = UBOUND(SrcInputData%pyForce,1) - IF (.NOT. ASSOCIATED(DstInputData%pyForce)) THEN - ALLOCATE(DstInputData%pyForce(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%pyForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%C_obj%pyForce_Len = SIZE(DstInputData%pyForce) - IF (DstInputData%C_obj%pyForce_Len > 0) & - DstInputData%C_obj%pyForce = C_LOC( DstInputData%pyForce( i1_l ) ) - END IF - DstInputData%pyForce = SrcInputData%pyForce -ENDIF -IF (ASSOCIATED(SrcInputData%pzForce)) THEN - i1_l = LBOUND(SrcInputData%pzForce,1) - i1_u = UBOUND(SrcInputData%pzForce,1) - IF (.NOT. ASSOCIATED(DstInputData%pzForce)) THEN - ALLOCATE(DstInputData%pzForce(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%pzForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%C_obj%pzForce_Len = SIZE(DstInputData%pzForce) - IF (DstInputData%C_obj%pzForce_Len > 0) & - DstInputData%C_obj%pzForce = C_LOC( DstInputData%pzForce( i1_l ) ) - END IF - DstInputData%pzForce = SrcInputData%pzForce -ENDIF -IF (ASSOCIATED(SrcInputData%xdotForce)) THEN - i1_l = LBOUND(SrcInputData%xdotForce,1) - i1_u = UBOUND(SrcInputData%xdotForce,1) - IF (.NOT. ASSOCIATED(DstInputData%xdotForce)) THEN - ALLOCATE(DstInputData%xdotForce(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%xdotForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%C_obj%xdotForce_Len = SIZE(DstInputData%xdotForce) - IF (DstInputData%C_obj%xdotForce_Len > 0) & - DstInputData%C_obj%xdotForce = C_LOC( DstInputData%xdotForce( i1_l ) ) - END IF - DstInputData%xdotForce = SrcInputData%xdotForce -ENDIF -IF (ASSOCIATED(SrcInputData%ydotForce)) THEN - i1_l = LBOUND(SrcInputData%ydotForce,1) - i1_u = UBOUND(SrcInputData%ydotForce,1) - IF (.NOT. ASSOCIATED(DstInputData%ydotForce)) THEN - ALLOCATE(DstInputData%ydotForce(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%ydotForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%C_obj%ydotForce_Len = SIZE(DstInputData%ydotForce) - IF (DstInputData%C_obj%ydotForce_Len > 0) & - DstInputData%C_obj%ydotForce = C_LOC( DstInputData%ydotForce( i1_l ) ) - END IF - DstInputData%ydotForce = SrcInputData%ydotForce -ENDIF -IF (ASSOCIATED(SrcInputData%zdotForce)) THEN - i1_l = LBOUND(SrcInputData%zdotForce,1) - i1_u = UBOUND(SrcInputData%zdotForce,1) - IF (.NOT. ASSOCIATED(DstInputData%zdotForce)) THEN - ALLOCATE(DstInputData%zdotForce(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%zdotForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%C_obj%zdotForce_Len = SIZE(DstInputData%zdotForce) - IF (DstInputData%C_obj%zdotForce_Len > 0) & - DstInputData%C_obj%zdotForce = C_LOC( DstInputData%zdotForce( i1_l ) ) - END IF - DstInputData%zdotForce = SrcInputData%zdotForce -ENDIF -IF (ASSOCIATED(SrcInputData%pOrientation)) THEN - i1_l = LBOUND(SrcInputData%pOrientation,1) - i1_u = UBOUND(SrcInputData%pOrientation,1) - IF (.NOT. ASSOCIATED(DstInputData%pOrientation)) THEN - ALLOCATE(DstInputData%pOrientation(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%pOrientation.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%C_obj%pOrientation_Len = SIZE(DstInputData%pOrientation) - IF (DstInputData%C_obj%pOrientation_Len > 0) & - DstInputData%C_obj%pOrientation = C_LOC( DstInputData%pOrientation( i1_l ) ) - END IF - DstInputData%pOrientation = SrcInputData%pOrientation -ENDIF -IF (ASSOCIATED(SrcInputData%fx)) THEN - i1_l = LBOUND(SrcInputData%fx,1) - i1_u = UBOUND(SrcInputData%fx,1) - IF (.NOT. ASSOCIATED(DstInputData%fx)) THEN - ALLOCATE(DstInputData%fx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%fx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%C_obj%fx_Len = SIZE(DstInputData%fx) - IF (DstInputData%C_obj%fx_Len > 0) & - DstInputData%C_obj%fx = C_LOC( DstInputData%fx( i1_l ) ) - END IF - DstInputData%fx = SrcInputData%fx -ENDIF -IF (ASSOCIATED(SrcInputData%fy)) THEN - i1_l = LBOUND(SrcInputData%fy,1) - i1_u = UBOUND(SrcInputData%fy,1) - IF (.NOT. ASSOCIATED(DstInputData%fy)) THEN - ALLOCATE(DstInputData%fy(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%fy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%C_obj%fy_Len = SIZE(DstInputData%fy) - IF (DstInputData%C_obj%fy_Len > 0) & - DstInputData%C_obj%fy = C_LOC( DstInputData%fy( i1_l ) ) - END IF - DstInputData%fy = SrcInputData%fy -ENDIF -IF (ASSOCIATED(SrcInputData%fz)) THEN - i1_l = LBOUND(SrcInputData%fz,1) - i1_u = UBOUND(SrcInputData%fz,1) - IF (.NOT. ASSOCIATED(DstInputData%fz)) THEN - ALLOCATE(DstInputData%fz(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%fz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%C_obj%fz_Len = SIZE(DstInputData%fz) - IF (DstInputData%C_obj%fz_Len > 0) & - DstInputData%C_obj%fz = C_LOC( DstInputData%fz( i1_l ) ) - END IF - DstInputData%fz = SrcInputData%fz -ENDIF -IF (ASSOCIATED(SrcInputData%momentx)) THEN - i1_l = LBOUND(SrcInputData%momentx,1) - i1_u = UBOUND(SrcInputData%momentx,1) - IF (.NOT. ASSOCIATED(DstInputData%momentx)) THEN - ALLOCATE(DstInputData%momentx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%momentx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%C_obj%momentx_Len = SIZE(DstInputData%momentx) - IF (DstInputData%C_obj%momentx_Len > 0) & - DstInputData%C_obj%momentx = C_LOC( DstInputData%momentx( i1_l ) ) - END IF - DstInputData%momentx = SrcInputData%momentx -ENDIF -IF (ASSOCIATED(SrcInputData%momenty)) THEN - i1_l = LBOUND(SrcInputData%momenty,1) - i1_u = UBOUND(SrcInputData%momenty,1) - IF (.NOT. ASSOCIATED(DstInputData%momenty)) THEN - ALLOCATE(DstInputData%momenty(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%momenty.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%C_obj%momenty_Len = SIZE(DstInputData%momenty) - IF (DstInputData%C_obj%momenty_Len > 0) & - DstInputData%C_obj%momenty = C_LOC( DstInputData%momenty( i1_l ) ) - END IF - DstInputData%momenty = SrcInputData%momenty -ENDIF -IF (ASSOCIATED(SrcInputData%momentz)) THEN - i1_l = LBOUND(SrcInputData%momentz,1) - i1_u = UBOUND(SrcInputData%momentz,1) - IF (.NOT. ASSOCIATED(DstInputData%momentz)) THEN - ALLOCATE(DstInputData%momentz(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%momentz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%C_obj%momentz_Len = SIZE(DstInputData%momentz) - IF (DstInputData%C_obj%momentz_Len > 0) & - DstInputData%C_obj%momentz = C_LOC( DstInputData%momentz( i1_l ) ) - END IF - DstInputData%momentz = SrcInputData%momentz -ENDIF -IF (ASSOCIATED(SrcInputData%forceNodesChord)) THEN - i1_l = LBOUND(SrcInputData%forceNodesChord,1) - i1_u = UBOUND(SrcInputData%forceNodesChord,1) - IF (.NOT. ASSOCIATED(DstInputData%forceNodesChord)) THEN - ALLOCATE(DstInputData%forceNodesChord(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%forceNodesChord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%C_obj%forceNodesChord_Len = SIZE(DstInputData%forceNodesChord) - IF (DstInputData%C_obj%forceNodesChord_Len > 0) & - DstInputData%C_obj%forceNodesChord = C_LOC( DstInputData%forceNodesChord( i1_l ) ) - END IF - DstInputData%forceNodesChord = SrcInputData%forceNodesChord -ENDIF - END SUBROUTINE OpFM_CopyInput - - SUBROUTINE OpFM_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(OpFM_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ASSOCIATED(InputData%pxVel)) THEN - DEALLOCATE(InputData%pxVel) - InputData%pxVel => NULL() - InputData%C_obj%pxVel = C_NULL_PTR - InputData%C_obj%pxVel_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%pyVel)) THEN - DEALLOCATE(InputData%pyVel) - InputData%pyVel => NULL() - InputData%C_obj%pyVel = C_NULL_PTR - InputData%C_obj%pyVel_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%pzVel)) THEN - DEALLOCATE(InputData%pzVel) - InputData%pzVel => NULL() - InputData%C_obj%pzVel = C_NULL_PTR - InputData%C_obj%pzVel_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%pxForce)) THEN - DEALLOCATE(InputData%pxForce) - InputData%pxForce => NULL() - InputData%C_obj%pxForce = C_NULL_PTR - InputData%C_obj%pxForce_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%pyForce)) THEN - DEALLOCATE(InputData%pyForce) - InputData%pyForce => NULL() - InputData%C_obj%pyForce = C_NULL_PTR - InputData%C_obj%pyForce_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%pzForce)) THEN - DEALLOCATE(InputData%pzForce) - InputData%pzForce => NULL() - InputData%C_obj%pzForce = C_NULL_PTR - InputData%C_obj%pzForce_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%xdotForce)) THEN - DEALLOCATE(InputData%xdotForce) - InputData%xdotForce => NULL() - InputData%C_obj%xdotForce = C_NULL_PTR - InputData%C_obj%xdotForce_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%ydotForce)) THEN - DEALLOCATE(InputData%ydotForce) - InputData%ydotForce => NULL() - InputData%C_obj%ydotForce = C_NULL_PTR - InputData%C_obj%ydotForce_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%zdotForce)) THEN - DEALLOCATE(InputData%zdotForce) - InputData%zdotForce => NULL() - InputData%C_obj%zdotForce = C_NULL_PTR - InputData%C_obj%zdotForce_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%pOrientation)) THEN - DEALLOCATE(InputData%pOrientation) - InputData%pOrientation => NULL() - InputData%C_obj%pOrientation = C_NULL_PTR - InputData%C_obj%pOrientation_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%fx)) THEN - DEALLOCATE(InputData%fx) - InputData%fx => NULL() - InputData%C_obj%fx = C_NULL_PTR - InputData%C_obj%fx_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%fy)) THEN - DEALLOCATE(InputData%fy) - InputData%fy => NULL() - InputData%C_obj%fy = C_NULL_PTR - InputData%C_obj%fy_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%fz)) THEN - DEALLOCATE(InputData%fz) - InputData%fz => NULL() - InputData%C_obj%fz = C_NULL_PTR - InputData%C_obj%fz_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%momentx)) THEN - DEALLOCATE(InputData%momentx) - InputData%momentx => NULL() - InputData%C_obj%momentx = C_NULL_PTR - InputData%C_obj%momentx_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%momenty)) THEN - DEALLOCATE(InputData%momenty) - InputData%momenty => NULL() - InputData%C_obj%momenty = C_NULL_PTR - InputData%C_obj%momenty_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%momentz)) THEN - DEALLOCATE(InputData%momentz) - InputData%momentz => NULL() - InputData%C_obj%momentz = C_NULL_PTR - InputData%C_obj%momentz_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%forceNodesChord)) THEN - DEALLOCATE(InputData%forceNodesChord) - InputData%forceNodesChord => NULL() - InputData%C_obj%forceNodesChord = C_NULL_PTR - InputData%C_obj%forceNodesChord_Len = 0 -ENDIF - END SUBROUTINE OpFM_DestroyInput + ErrMsg = '' + if (associated(SrcInputData%pxVel)) then + LB(1:1) = lbound(SrcInputData%pxVel) + UB(1:1) = ubound(SrcInputData%pxVel) + if (.not. associated(DstInputData%pxVel)) then + allocate(DstInputData%pxVel(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%pxVel.', ErrStat, ErrMsg, RoutineName) + return + end if + DstInputData%C_obj%pxVel_Len = size(DstInputData%pxVel) + if (DstInputData%C_obj%pxVel_Len > 0) & + DstInputData%C_obj%pxVel = c_loc(DstInputData%pxVel(LB(1))) + end if + DstInputData%pxVel = SrcInputData%pxVel + else if (associated(DstInputData%pxVel)) then + deallocate(DstInputData%pxVel) + end if + if (associated(SrcInputData%pyVel)) then + LB(1:1) = lbound(SrcInputData%pyVel) + UB(1:1) = ubound(SrcInputData%pyVel) + if (.not. associated(DstInputData%pyVel)) then + allocate(DstInputData%pyVel(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%pyVel.', ErrStat, ErrMsg, RoutineName) + return + end if + DstInputData%C_obj%pyVel_Len = size(DstInputData%pyVel) + if (DstInputData%C_obj%pyVel_Len > 0) & + DstInputData%C_obj%pyVel = c_loc(DstInputData%pyVel(LB(1))) + end if + DstInputData%pyVel = SrcInputData%pyVel + else if (associated(DstInputData%pyVel)) then + deallocate(DstInputData%pyVel) + end if + if (associated(SrcInputData%pzVel)) then + LB(1:1) = lbound(SrcInputData%pzVel) + UB(1:1) = ubound(SrcInputData%pzVel) + if (.not. associated(DstInputData%pzVel)) then + allocate(DstInputData%pzVel(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%pzVel.', ErrStat, ErrMsg, RoutineName) + return + end if + DstInputData%C_obj%pzVel_Len = size(DstInputData%pzVel) + if (DstInputData%C_obj%pzVel_Len > 0) & + DstInputData%C_obj%pzVel = c_loc(DstInputData%pzVel(LB(1))) + end if + DstInputData%pzVel = SrcInputData%pzVel + else if (associated(DstInputData%pzVel)) then + deallocate(DstInputData%pzVel) + end if + if (associated(SrcInputData%pxForce)) then + LB(1:1) = lbound(SrcInputData%pxForce) + UB(1:1) = ubound(SrcInputData%pxForce) + if (.not. associated(DstInputData%pxForce)) then + allocate(DstInputData%pxForce(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%pxForce.', ErrStat, ErrMsg, RoutineName) + return + end if + DstInputData%C_obj%pxForce_Len = size(DstInputData%pxForce) + if (DstInputData%C_obj%pxForce_Len > 0) & + DstInputData%C_obj%pxForce = c_loc(DstInputData%pxForce(LB(1))) + end if + DstInputData%pxForce = SrcInputData%pxForce + else if (associated(DstInputData%pxForce)) then + deallocate(DstInputData%pxForce) + end if + if (associated(SrcInputData%pyForce)) then + LB(1:1) = lbound(SrcInputData%pyForce) + UB(1:1) = ubound(SrcInputData%pyForce) + if (.not. associated(DstInputData%pyForce)) then + allocate(DstInputData%pyForce(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%pyForce.', ErrStat, ErrMsg, RoutineName) + return + end if + DstInputData%C_obj%pyForce_Len = size(DstInputData%pyForce) + if (DstInputData%C_obj%pyForce_Len > 0) & + DstInputData%C_obj%pyForce = c_loc(DstInputData%pyForce(LB(1))) + end if + DstInputData%pyForce = SrcInputData%pyForce + else if (associated(DstInputData%pyForce)) then + deallocate(DstInputData%pyForce) + end if + if (associated(SrcInputData%pzForce)) then + LB(1:1) = lbound(SrcInputData%pzForce) + UB(1:1) = ubound(SrcInputData%pzForce) + if (.not. associated(DstInputData%pzForce)) then + allocate(DstInputData%pzForce(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%pzForce.', ErrStat, ErrMsg, RoutineName) + return + end if + DstInputData%C_obj%pzForce_Len = size(DstInputData%pzForce) + if (DstInputData%C_obj%pzForce_Len > 0) & + DstInputData%C_obj%pzForce = c_loc(DstInputData%pzForce(LB(1))) + end if + DstInputData%pzForce = SrcInputData%pzForce + else if (associated(DstInputData%pzForce)) then + deallocate(DstInputData%pzForce) + end if + if (associated(SrcInputData%xdotForce)) then + LB(1:1) = lbound(SrcInputData%xdotForce) + UB(1:1) = ubound(SrcInputData%xdotForce) + if (.not. associated(DstInputData%xdotForce)) then + allocate(DstInputData%xdotForce(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%xdotForce.', ErrStat, ErrMsg, RoutineName) + return + end if + DstInputData%C_obj%xdotForce_Len = size(DstInputData%xdotForce) + if (DstInputData%C_obj%xdotForce_Len > 0) & + DstInputData%C_obj%xdotForce = c_loc(DstInputData%xdotForce(LB(1))) + end if + DstInputData%xdotForce = SrcInputData%xdotForce + else if (associated(DstInputData%xdotForce)) then + deallocate(DstInputData%xdotForce) + end if + if (associated(SrcInputData%ydotForce)) then + LB(1:1) = lbound(SrcInputData%ydotForce) + UB(1:1) = ubound(SrcInputData%ydotForce) + if (.not. associated(DstInputData%ydotForce)) then + allocate(DstInputData%ydotForce(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%ydotForce.', ErrStat, ErrMsg, RoutineName) + return + end if + DstInputData%C_obj%ydotForce_Len = size(DstInputData%ydotForce) + if (DstInputData%C_obj%ydotForce_Len > 0) & + DstInputData%C_obj%ydotForce = c_loc(DstInputData%ydotForce(LB(1))) + end if + DstInputData%ydotForce = SrcInputData%ydotForce + else if (associated(DstInputData%ydotForce)) then + deallocate(DstInputData%ydotForce) + end if + if (associated(SrcInputData%zdotForce)) then + LB(1:1) = lbound(SrcInputData%zdotForce) + UB(1:1) = ubound(SrcInputData%zdotForce) + if (.not. associated(DstInputData%zdotForce)) then + allocate(DstInputData%zdotForce(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%zdotForce.', ErrStat, ErrMsg, RoutineName) + return + end if + DstInputData%C_obj%zdotForce_Len = size(DstInputData%zdotForce) + if (DstInputData%C_obj%zdotForce_Len > 0) & + DstInputData%C_obj%zdotForce = c_loc(DstInputData%zdotForce(LB(1))) + end if + DstInputData%zdotForce = SrcInputData%zdotForce + else if (associated(DstInputData%zdotForce)) then + deallocate(DstInputData%zdotForce) + end if + if (associated(SrcInputData%pOrientation)) then + LB(1:1) = lbound(SrcInputData%pOrientation) + UB(1:1) = ubound(SrcInputData%pOrientation) + if (.not. associated(DstInputData%pOrientation)) then + allocate(DstInputData%pOrientation(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%pOrientation.', ErrStat, ErrMsg, RoutineName) + return + end if + DstInputData%C_obj%pOrientation_Len = size(DstInputData%pOrientation) + if (DstInputData%C_obj%pOrientation_Len > 0) & + DstInputData%C_obj%pOrientation = c_loc(DstInputData%pOrientation(LB(1))) + end if + DstInputData%pOrientation = SrcInputData%pOrientation + else if (associated(DstInputData%pOrientation)) then + deallocate(DstInputData%pOrientation) + end if + if (associated(SrcInputData%fx)) then + LB(1:1) = lbound(SrcInputData%fx) + UB(1:1) = ubound(SrcInputData%fx) + if (.not. associated(DstInputData%fx)) then + allocate(DstInputData%fx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%fx.', ErrStat, ErrMsg, RoutineName) + return + end if + DstInputData%C_obj%fx_Len = size(DstInputData%fx) + if (DstInputData%C_obj%fx_Len > 0) & + DstInputData%C_obj%fx = c_loc(DstInputData%fx(LB(1))) + end if + DstInputData%fx = SrcInputData%fx + else if (associated(DstInputData%fx)) then + deallocate(DstInputData%fx) + end if + if (associated(SrcInputData%fy)) then + LB(1:1) = lbound(SrcInputData%fy) + UB(1:1) = ubound(SrcInputData%fy) + if (.not. associated(DstInputData%fy)) then + allocate(DstInputData%fy(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%fy.', ErrStat, ErrMsg, RoutineName) + return + end if + DstInputData%C_obj%fy_Len = size(DstInputData%fy) + if (DstInputData%C_obj%fy_Len > 0) & + DstInputData%C_obj%fy = c_loc(DstInputData%fy(LB(1))) + end if + DstInputData%fy = SrcInputData%fy + else if (associated(DstInputData%fy)) then + deallocate(DstInputData%fy) + end if + if (associated(SrcInputData%fz)) then + LB(1:1) = lbound(SrcInputData%fz) + UB(1:1) = ubound(SrcInputData%fz) + if (.not. associated(DstInputData%fz)) then + allocate(DstInputData%fz(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%fz.', ErrStat, ErrMsg, RoutineName) + return + end if + DstInputData%C_obj%fz_Len = size(DstInputData%fz) + if (DstInputData%C_obj%fz_Len > 0) & + DstInputData%C_obj%fz = c_loc(DstInputData%fz(LB(1))) + end if + DstInputData%fz = SrcInputData%fz + else if (associated(DstInputData%fz)) then + deallocate(DstInputData%fz) + end if + if (associated(SrcInputData%momentx)) then + LB(1:1) = lbound(SrcInputData%momentx) + UB(1:1) = ubound(SrcInputData%momentx) + if (.not. associated(DstInputData%momentx)) then + allocate(DstInputData%momentx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%momentx.', ErrStat, ErrMsg, RoutineName) + return + end if + DstInputData%C_obj%momentx_Len = size(DstInputData%momentx) + if (DstInputData%C_obj%momentx_Len > 0) & + DstInputData%C_obj%momentx = c_loc(DstInputData%momentx(LB(1))) + end if + DstInputData%momentx = SrcInputData%momentx + else if (associated(DstInputData%momentx)) then + deallocate(DstInputData%momentx) + end if + if (associated(SrcInputData%momenty)) then + LB(1:1) = lbound(SrcInputData%momenty) + UB(1:1) = ubound(SrcInputData%momenty) + if (.not. associated(DstInputData%momenty)) then + allocate(DstInputData%momenty(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%momenty.', ErrStat, ErrMsg, RoutineName) + return + end if + DstInputData%C_obj%momenty_Len = size(DstInputData%momenty) + if (DstInputData%C_obj%momenty_Len > 0) & + DstInputData%C_obj%momenty = c_loc(DstInputData%momenty(LB(1))) + end if + DstInputData%momenty = SrcInputData%momenty + else if (associated(DstInputData%momenty)) then + deallocate(DstInputData%momenty) + end if + if (associated(SrcInputData%momentz)) then + LB(1:1) = lbound(SrcInputData%momentz) + UB(1:1) = ubound(SrcInputData%momentz) + if (.not. associated(DstInputData%momentz)) then + allocate(DstInputData%momentz(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%momentz.', ErrStat, ErrMsg, RoutineName) + return + end if + DstInputData%C_obj%momentz_Len = size(DstInputData%momentz) + if (DstInputData%C_obj%momentz_Len > 0) & + DstInputData%C_obj%momentz = c_loc(DstInputData%momentz(LB(1))) + end if + DstInputData%momentz = SrcInputData%momentz + else if (associated(DstInputData%momentz)) then + deallocate(DstInputData%momentz) + end if + if (associated(SrcInputData%forceNodesChord)) then + LB(1:1) = lbound(SrcInputData%forceNodesChord) + UB(1:1) = ubound(SrcInputData%forceNodesChord) + if (.not. associated(DstInputData%forceNodesChord)) then + allocate(DstInputData%forceNodesChord(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%forceNodesChord.', ErrStat, ErrMsg, RoutineName) + return + end if + DstInputData%C_obj%forceNodesChord_Len = size(DstInputData%forceNodesChord) + if (DstInputData%C_obj%forceNodesChord_Len > 0) & + DstInputData%C_obj%forceNodesChord = c_loc(DstInputData%forceNodesChord(LB(1))) + end if + DstInputData%forceNodesChord = SrcInputData%forceNodesChord + else if (associated(DstInputData%forceNodesChord)) then + deallocate(DstInputData%forceNodesChord) + end if +end subroutine +subroutine OpFM_DestroyInput(InputData, ErrStat, ErrMsg) + type(OpFM_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'OpFM_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(InputData%pxVel)) then + deallocate(InputData%pxVel) + InputData%pxVel => null() + InputData%C_obj%pxVel = c_null_ptr + InputData%C_obj%pxVel_Len = 0 + end if + if (associated(InputData%pyVel)) then + deallocate(InputData%pyVel) + InputData%pyVel => null() + InputData%C_obj%pyVel = c_null_ptr + InputData%C_obj%pyVel_Len = 0 + end if + if (associated(InputData%pzVel)) then + deallocate(InputData%pzVel) + InputData%pzVel => null() + InputData%C_obj%pzVel = c_null_ptr + InputData%C_obj%pzVel_Len = 0 + end if + if (associated(InputData%pxForce)) then + deallocate(InputData%pxForce) + InputData%pxForce => null() + InputData%C_obj%pxForce = c_null_ptr + InputData%C_obj%pxForce_Len = 0 + end if + if (associated(InputData%pyForce)) then + deallocate(InputData%pyForce) + InputData%pyForce => null() + InputData%C_obj%pyForce = c_null_ptr + InputData%C_obj%pyForce_Len = 0 + end if + if (associated(InputData%pzForce)) then + deallocate(InputData%pzForce) + InputData%pzForce => null() + InputData%C_obj%pzForce = c_null_ptr + InputData%C_obj%pzForce_Len = 0 + end if + if (associated(InputData%xdotForce)) then + deallocate(InputData%xdotForce) + InputData%xdotForce => null() + InputData%C_obj%xdotForce = c_null_ptr + InputData%C_obj%xdotForce_Len = 0 + end if + if (associated(InputData%ydotForce)) then + deallocate(InputData%ydotForce) + InputData%ydotForce => null() + InputData%C_obj%ydotForce = c_null_ptr + InputData%C_obj%ydotForce_Len = 0 + end if + if (associated(InputData%zdotForce)) then + deallocate(InputData%zdotForce) + InputData%zdotForce => null() + InputData%C_obj%zdotForce = c_null_ptr + InputData%C_obj%zdotForce_Len = 0 + end if + if (associated(InputData%pOrientation)) then + deallocate(InputData%pOrientation) + InputData%pOrientation => null() + InputData%C_obj%pOrientation = c_null_ptr + InputData%C_obj%pOrientation_Len = 0 + end if + if (associated(InputData%fx)) then + deallocate(InputData%fx) + InputData%fx => null() + InputData%C_obj%fx = c_null_ptr + InputData%C_obj%fx_Len = 0 + end if + if (associated(InputData%fy)) then + deallocate(InputData%fy) + InputData%fy => null() + InputData%C_obj%fy = c_null_ptr + InputData%C_obj%fy_Len = 0 + end if + if (associated(InputData%fz)) then + deallocate(InputData%fz) + InputData%fz => null() + InputData%C_obj%fz = c_null_ptr + InputData%C_obj%fz_Len = 0 + end if + if (associated(InputData%momentx)) then + deallocate(InputData%momentx) + InputData%momentx => null() + InputData%C_obj%momentx = c_null_ptr + InputData%C_obj%momentx_Len = 0 + end if + if (associated(InputData%momenty)) then + deallocate(InputData%momenty) + InputData%momenty => null() + InputData%C_obj%momenty = c_null_ptr + InputData%C_obj%momenty_Len = 0 + end if + if (associated(InputData%momentz)) then + deallocate(InputData%momentz) + InputData%momentz => null() + InputData%C_obj%momentz = c_null_ptr + InputData%C_obj%momentz_Len = 0 + end if + if (associated(InputData%forceNodesChord)) then + deallocate(InputData%forceNodesChord) + InputData%forceNodesChord => null() + InputData%C_obj%forceNodesChord = c_null_ptr + InputData%C_obj%forceNodesChord_Len = 0 + end if +end subroutine subroutine OpFM_PackInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -1746,7 +1709,6 @@ subroutine OpFM_PackInput(Buf, Indata) call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - ! pxVel call RegPack(Buf, associated(InData%pxVel)) if (associated(InData%pxVel)) then call RegPackBounds(Buf, 1, lbound(InData%pxVel), ubound(InData%pxVel)) @@ -1756,7 +1718,6 @@ subroutine OpFM_PackInput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! pyVel call RegPack(Buf, associated(InData%pyVel)) if (associated(InData%pyVel)) then call RegPackBounds(Buf, 1, lbound(InData%pyVel), ubound(InData%pyVel)) @@ -1766,7 +1727,6 @@ subroutine OpFM_PackInput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! pzVel call RegPack(Buf, associated(InData%pzVel)) if (associated(InData%pzVel)) then call RegPackBounds(Buf, 1, lbound(InData%pzVel), ubound(InData%pzVel)) @@ -1776,7 +1736,6 @@ subroutine OpFM_PackInput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! pxForce call RegPack(Buf, associated(InData%pxForce)) if (associated(InData%pxForce)) then call RegPackBounds(Buf, 1, lbound(InData%pxForce), ubound(InData%pxForce)) @@ -1786,7 +1745,6 @@ subroutine OpFM_PackInput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! pyForce call RegPack(Buf, associated(InData%pyForce)) if (associated(InData%pyForce)) then call RegPackBounds(Buf, 1, lbound(InData%pyForce), ubound(InData%pyForce)) @@ -1796,7 +1754,6 @@ subroutine OpFM_PackInput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! pzForce call RegPack(Buf, associated(InData%pzForce)) if (associated(InData%pzForce)) then call RegPackBounds(Buf, 1, lbound(InData%pzForce), ubound(InData%pzForce)) @@ -1806,7 +1763,6 @@ subroutine OpFM_PackInput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! xdotForce call RegPack(Buf, associated(InData%xdotForce)) if (associated(InData%xdotForce)) then call RegPackBounds(Buf, 1, lbound(InData%xdotForce), ubound(InData%xdotForce)) @@ -1816,7 +1772,6 @@ subroutine OpFM_PackInput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! ydotForce call RegPack(Buf, associated(InData%ydotForce)) if (associated(InData%ydotForce)) then call RegPackBounds(Buf, 1, lbound(InData%ydotForce), ubound(InData%ydotForce)) @@ -1826,7 +1781,6 @@ subroutine OpFM_PackInput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! zdotForce call RegPack(Buf, associated(InData%zdotForce)) if (associated(InData%zdotForce)) then call RegPackBounds(Buf, 1, lbound(InData%zdotForce), ubound(InData%zdotForce)) @@ -1836,7 +1790,6 @@ subroutine OpFM_PackInput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! pOrientation call RegPack(Buf, associated(InData%pOrientation)) if (associated(InData%pOrientation)) then call RegPackBounds(Buf, 1, lbound(InData%pOrientation), ubound(InData%pOrientation)) @@ -1846,7 +1799,6 @@ subroutine OpFM_PackInput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! fx call RegPack(Buf, associated(InData%fx)) if (associated(InData%fx)) then call RegPackBounds(Buf, 1, lbound(InData%fx), ubound(InData%fx)) @@ -1856,7 +1808,6 @@ subroutine OpFM_PackInput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! fy call RegPack(Buf, associated(InData%fy)) if (associated(InData%fy)) then call RegPackBounds(Buf, 1, lbound(InData%fy), ubound(InData%fy)) @@ -1866,7 +1817,6 @@ subroutine OpFM_PackInput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! fz call RegPack(Buf, associated(InData%fz)) if (associated(InData%fz)) then call RegPackBounds(Buf, 1, lbound(InData%fz), ubound(InData%fz)) @@ -1876,7 +1826,6 @@ subroutine OpFM_PackInput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! momentx call RegPack(Buf, associated(InData%momentx)) if (associated(InData%momentx)) then call RegPackBounds(Buf, 1, lbound(InData%momentx), ubound(InData%momentx)) @@ -1886,7 +1835,6 @@ subroutine OpFM_PackInput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! momenty call RegPack(Buf, associated(InData%momenty)) if (associated(InData%momenty)) then call RegPackBounds(Buf, 1, lbound(InData%momenty), ubound(InData%momenty)) @@ -1896,7 +1844,6 @@ subroutine OpFM_PackInput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! momentz call RegPack(Buf, associated(InData%momentz)) if (associated(InData%momentz)) then call RegPackBounds(Buf, 1, lbound(InData%momentz), ubound(InData%momentz)) @@ -1906,7 +1853,6 @@ subroutine OpFM_PackInput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! forceNodesChord call RegPack(Buf, associated(InData%forceNodesChord)) if (associated(InData%forceNodesChord)) then call RegPackBounds(Buf, 1, lbound(InData%forceNodesChord), ubound(InData%forceNodesChord)) @@ -1928,7 +1874,6 @@ subroutine OpFM_UnPackInput(Buf, OutData) integer(IntKi) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return - ! pxVel if (associated(OutData%pxVel)) deallocate(OutData%pxVel) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1955,7 +1900,6 @@ subroutine OpFM_UnPackInput(Buf, OutData) else OutData%pxVel => null() end if - ! pyVel if (associated(OutData%pyVel)) deallocate(OutData%pyVel) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1982,7 +1926,6 @@ subroutine OpFM_UnPackInput(Buf, OutData) else OutData%pyVel => null() end if - ! pzVel if (associated(OutData%pzVel)) deallocate(OutData%pzVel) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2009,7 +1952,6 @@ subroutine OpFM_UnPackInput(Buf, OutData) else OutData%pzVel => null() end if - ! pxForce if (associated(OutData%pxForce)) deallocate(OutData%pxForce) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2036,7 +1978,6 @@ subroutine OpFM_UnPackInput(Buf, OutData) else OutData%pxForce => null() end if - ! pyForce if (associated(OutData%pyForce)) deallocate(OutData%pyForce) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2063,7 +2004,6 @@ subroutine OpFM_UnPackInput(Buf, OutData) else OutData%pyForce => null() end if - ! pzForce if (associated(OutData%pzForce)) deallocate(OutData%pzForce) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2090,7 +2030,6 @@ subroutine OpFM_UnPackInput(Buf, OutData) else OutData%pzForce => null() end if - ! xdotForce if (associated(OutData%xdotForce)) deallocate(OutData%xdotForce) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2117,7 +2056,6 @@ subroutine OpFM_UnPackInput(Buf, OutData) else OutData%xdotForce => null() end if - ! ydotForce if (associated(OutData%ydotForce)) deallocate(OutData%ydotForce) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2144,7 +2082,6 @@ subroutine OpFM_UnPackInput(Buf, OutData) else OutData%ydotForce => null() end if - ! zdotForce if (associated(OutData%zdotForce)) deallocate(OutData%zdotForce) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2171,7 +2108,6 @@ subroutine OpFM_UnPackInput(Buf, OutData) else OutData%zdotForce => null() end if - ! pOrientation if (associated(OutData%pOrientation)) deallocate(OutData%pOrientation) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2198,7 +2134,6 @@ subroutine OpFM_UnPackInput(Buf, OutData) else OutData%pOrientation => null() end if - ! fx if (associated(OutData%fx)) deallocate(OutData%fx) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2225,7 +2160,6 @@ subroutine OpFM_UnPackInput(Buf, OutData) else OutData%fx => null() end if - ! fy if (associated(OutData%fy)) deallocate(OutData%fy) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2252,7 +2186,6 @@ subroutine OpFM_UnPackInput(Buf, OutData) else OutData%fy => null() end if - ! fz if (associated(OutData%fz)) deallocate(OutData%fz) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2279,7 +2212,6 @@ subroutine OpFM_UnPackInput(Buf, OutData) else OutData%fz => null() end if - ! momentx if (associated(OutData%momentx)) deallocate(OutData%momentx) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2306,7 +2238,6 @@ subroutine OpFM_UnPackInput(Buf, OutData) else OutData%momentx => null() end if - ! momenty if (associated(OutData%momenty)) deallocate(OutData%momenty) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2333,7 +2264,6 @@ subroutine OpFM_UnPackInput(Buf, OutData) else OutData%momenty => null() end if - ! momentz if (associated(OutData%momentz)) deallocate(OutData%momentz) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2360,7 +2290,6 @@ subroutine OpFM_UnPackInput(Buf, OutData) else OutData%momentz => null() end if - ! forceNodesChord if (associated(OutData%forceNodesChord)) deallocate(OutData%forceNodesChord) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2779,116 +2708,114 @@ SUBROUTINE OpFM_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) END IF END SUBROUTINE OpFM_F2C_CopyInput - SUBROUTINE OpFM_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(OpFM_OutputType), INTENT(IN) :: SrcOutputData - TYPE(OpFM_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_CopyOutput' -! + +subroutine OpFM_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(OpFM_OutputType), intent(in) :: SrcOutputData + type(OpFM_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'OpFM_CopyOutput' ErrStat = ErrID_None - ErrMsg = "" -IF (ASSOCIATED(SrcOutputData%u)) THEN - i1_l = LBOUND(SrcOutputData%u,1) - i1_u = UBOUND(SrcOutputData%u,1) - IF (.NOT. ASSOCIATED(DstOutputData%u)) THEN - ALLOCATE(DstOutputData%u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOutputData%C_obj%u_Len = SIZE(DstOutputData%u) - IF (DstOutputData%C_obj%u_Len > 0) & - DstOutputData%C_obj%u = C_LOC( DstOutputData%u( i1_l ) ) - END IF - DstOutputData%u = SrcOutputData%u -ENDIF -IF (ASSOCIATED(SrcOutputData%v)) THEN - i1_l = LBOUND(SrcOutputData%v,1) - i1_u = UBOUND(SrcOutputData%v,1) - IF (.NOT. ASSOCIATED(DstOutputData%v)) THEN - ALLOCATE(DstOutputData%v(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%v.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOutputData%C_obj%v_Len = SIZE(DstOutputData%v) - IF (DstOutputData%C_obj%v_Len > 0) & - DstOutputData%C_obj%v = C_LOC( DstOutputData%v( i1_l ) ) - END IF - DstOutputData%v = SrcOutputData%v -ENDIF -IF (ASSOCIATED(SrcOutputData%w)) THEN - i1_l = LBOUND(SrcOutputData%w,1) - i1_u = UBOUND(SrcOutputData%w,1) - IF (.NOT. ASSOCIATED(DstOutputData%w)) THEN - ALLOCATE(DstOutputData%w(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%w.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOutputData%C_obj%w_Len = SIZE(DstOutputData%w) - IF (DstOutputData%C_obj%w_Len > 0) & - DstOutputData%C_obj%w = C_LOC( DstOutputData%w( i1_l ) ) - END IF - DstOutputData%w = SrcOutputData%w -ENDIF -IF (ALLOCATED(SrcOutputData%WriteOutput)) THEN - i1_l = LBOUND(SrcOutputData%WriteOutput,1) - i1_u = UBOUND(SrcOutputData%WriteOutput,1) - IF (.NOT. ALLOCATED(DstOutputData%WriteOutput)) THEN - ALLOCATE(DstOutputData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%WriteOutput = SrcOutputData%WriteOutput -ENDIF - END SUBROUTINE OpFM_CopyOutput - - SUBROUTINE OpFM_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(OpFM_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ASSOCIATED(OutputData%u)) THEN - DEALLOCATE(OutputData%u) - OutputData%u => NULL() - OutputData%C_obj%u = C_NULL_PTR - OutputData%C_obj%u_Len = 0 -ENDIF -IF (ASSOCIATED(OutputData%v)) THEN - DEALLOCATE(OutputData%v) - OutputData%v => NULL() - OutputData%C_obj%v = C_NULL_PTR - OutputData%C_obj%v_Len = 0 -ENDIF -IF (ASSOCIATED(OutputData%w)) THEN - DEALLOCATE(OutputData%w) - OutputData%w => NULL() - OutputData%C_obj%w = C_NULL_PTR - OutputData%C_obj%w_Len = 0 -ENDIF -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - END SUBROUTINE OpFM_DestroyOutput + ErrMsg = '' + if (associated(SrcOutputData%u)) then + LB(1:1) = lbound(SrcOutputData%u) + UB(1:1) = ubound(SrcOutputData%u) + if (.not. associated(DstOutputData%u)) then + allocate(DstOutputData%u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%u.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOutputData%C_obj%u_Len = size(DstOutputData%u) + if (DstOutputData%C_obj%u_Len > 0) & + DstOutputData%C_obj%u = c_loc(DstOutputData%u(LB(1))) + end if + DstOutputData%u = SrcOutputData%u + else if (associated(DstOutputData%u)) then + deallocate(DstOutputData%u) + end if + if (associated(SrcOutputData%v)) then + LB(1:1) = lbound(SrcOutputData%v) + UB(1:1) = ubound(SrcOutputData%v) + if (.not. associated(DstOutputData%v)) then + allocate(DstOutputData%v(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%v.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOutputData%C_obj%v_Len = size(DstOutputData%v) + if (DstOutputData%C_obj%v_Len > 0) & + DstOutputData%C_obj%v = c_loc(DstOutputData%v(LB(1))) + end if + DstOutputData%v = SrcOutputData%v + else if (associated(DstOutputData%v)) then + deallocate(DstOutputData%v) + end if + if (associated(SrcOutputData%w)) then + LB(1:1) = lbound(SrcOutputData%w) + UB(1:1) = ubound(SrcOutputData%w) + if (.not. associated(DstOutputData%w)) then + allocate(DstOutputData%w(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%w.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOutputData%C_obj%w_Len = size(DstOutputData%w) + if (DstOutputData%C_obj%w_Len > 0) & + DstOutputData%C_obj%w = c_loc(DstOutputData%w(LB(1))) + end if + DstOutputData%w = SrcOutputData%w + else if (associated(DstOutputData%w)) then + deallocate(DstOutputData%w) + end if + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%WriteOutput = SrcOutputData%WriteOutput + else if (allocated(DstOutputData%WriteOutput)) then + deallocate(DstOutputData%WriteOutput) + end if +end subroutine +subroutine OpFM_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(OpFM_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'OpFM_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(OutputData%u)) then + deallocate(OutputData%u) + OutputData%u => null() + OutputData%C_obj%u = c_null_ptr + OutputData%C_obj%u_Len = 0 + end if + if (associated(OutputData%v)) then + deallocate(OutputData%v) + OutputData%v => null() + OutputData%C_obj%v = c_null_ptr + OutputData%C_obj%v_Len = 0 + end if + if (associated(OutputData%w)) then + deallocate(OutputData%w) + OutputData%w => null() + OutputData%C_obj%w = c_null_ptr + OutputData%C_obj%w_Len = 0 + end if + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine subroutine OpFM_PackOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -2900,7 +2827,6 @@ subroutine OpFM_PackOutput(Buf, Indata) call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - ! u call RegPack(Buf, associated(InData%u)) if (associated(InData%u)) then call RegPackBounds(Buf, 1, lbound(InData%u), ubound(InData%u)) @@ -2910,7 +2836,6 @@ subroutine OpFM_PackOutput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! v call RegPack(Buf, associated(InData%v)) if (associated(InData%v)) then call RegPackBounds(Buf, 1, lbound(InData%v), ubound(InData%v)) @@ -2920,7 +2845,6 @@ subroutine OpFM_PackOutput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! w call RegPack(Buf, associated(InData%w)) if (associated(InData%w)) then call RegPackBounds(Buf, 1, lbound(InData%w), ubound(InData%w)) @@ -2930,7 +2854,6 @@ subroutine OpFM_PackOutput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutput call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) @@ -2949,7 +2872,6 @@ subroutine OpFM_UnPackOutput(Buf, OutData) integer(IntKi) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return - ! u if (associated(OutData%u)) deallocate(OutData%u) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2976,7 +2898,6 @@ subroutine OpFM_UnPackOutput(Buf, OutData) else OutData%u => null() end if - ! v if (associated(OutData%v)) deallocate(OutData%v) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3003,7 +2924,6 @@ subroutine OpFM_UnPackOutput(Buf, OutData) else OutData%v => null() end if - ! w if (associated(OutData%w)) deallocate(OutData%w) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3030,7 +2950,6 @@ subroutine OpFM_UnPackOutput(Buf, OutData) else OutData%w => null() end if - ! WriteOutput if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 index 14be89415b..3fb5129ada 100644 --- a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 +++ b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 @@ -107,53 +107,39 @@ MODULE OrcaFlexInterface_Types END TYPE Orca_ConstraintStateType ! ======================= CONTAINS - SUBROUTINE Orca_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Orca_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(Orca_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFile = SrcInitInputData%InputFile - DstInitInputData%RootName = SrcInitInputData%RootName - DstInitInputData%TMax = SrcInitInputData%TMax - END SUBROUTINE Orca_CopyInitInput - - SUBROUTINE Orca_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(Orca_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE Orca_DestroyInitInput +subroutine Orca_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(Orca_InitInputType), intent(in) :: SrcInitInputData + type(Orca_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Orca_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%RootName = SrcInitInputData%RootName + DstInitInputData%TMax = SrcInitInputData%TMax +end subroutine +subroutine Orca_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(Orca_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Orca_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine Orca_PackInitInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Orca_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Orca_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return - ! InputFile call RegPack(Buf, InData%InputFile) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegPack(Buf, InData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! TMax call RegPack(Buf, InData%TMax) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -163,100 +149,89 @@ subroutine Orca_UnPackInitInput(Buf, OutData) type(Orca_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Orca_UnPackInitInput' if (Buf%ErrStat /= ErrID_None) return - ! InputFile call RegUnpack(Buf, OutData%InputFile) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegUnpack(Buf, OutData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! TMax call RegUnpack(Buf, OutData%TMax) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Orca_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Orca_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(Orca_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_CopyInitOutput' -! + +subroutine Orca_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(Orca_InitOutputType), intent(in) :: SrcInitOutputData + type(Orca_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Orca_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 Orca_CopyInitOutput - - SUBROUTINE Orca_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(Orca_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF - END SUBROUTINE Orca_DestroyInitOutput + ErrMsg = '' + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr + else if (allocated(DstInitOutputData%WriteOutputHdr)) then + deallocate(DstInitOutputData%WriteOutputHdr) + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt + else if (allocated(DstInitOutputData%WriteOutputUnt)) then + deallocate(DstInitOutputData%WriteOutputUnt) + end if +end subroutine +subroutine Orca_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(Orca_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Orca_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if +end subroutine subroutine Orca_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Orca_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Orca_PackInitOutput' if (Buf%ErrStat >= AbortErrLev) return - ! Ver call NWTC_Library_PackProgDesc(Buf, InData%Ver) if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutputHdr call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) call RegPack(Buf, InData%WriteOutputHdr) end if if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutputUnt call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) @@ -273,9 +248,7 @@ subroutine Orca_UnPackInitOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! Ver call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver - ! WriteOutputHdr if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -290,7 +263,6 @@ subroutine Orca_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutputHdr) if (RegCheckErr(Buf, RoutineName)) return end if - ! WriteOutputUnt if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -306,61 +278,45 @@ subroutine Orca_UnPackInitOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE Orca_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Orca_InputFile), INTENT(IN) :: SrcInputFileData - TYPE(Orca_InputFile), INTENT(INOUT) :: DstInputFileData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_CopyInputFile' -! + +subroutine Orca_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) + type(Orca_InputFile), intent(in) :: SrcInputFileData + type(Orca_InputFile), intent(inout) :: DstInputFileData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Orca_CopyInputFile' ErrStat = ErrID_None - ErrMsg = "" - DstInputFileData%DLL_FileName = SrcInputFileData%DLL_FileName - DstInputFileData%DLL_InitProcName = SrcInputFileData%DLL_InitProcName - DstInputFileData%DLL_CalcProcName = SrcInputFileData%DLL_CalcProcName - DstInputFileData%DLL_EndProcName = SrcInputFileData%DLL_EndProcName - DstInputFileData%DirRoot = SrcInputFileData%DirRoot - END SUBROUTINE Orca_CopyInputFile - - SUBROUTINE Orca_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) - TYPE(Orca_InputFile), INTENT(INOUT) :: InputFileData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyInputFile' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Orca_DestroyInputFile + ErrMsg = '' + DstInputFileData%DLL_FileName = SrcInputFileData%DLL_FileName + DstInputFileData%DLL_InitProcName = SrcInputFileData%DLL_InitProcName + DstInputFileData%DLL_CalcProcName = SrcInputFileData%DLL_CalcProcName + DstInputFileData%DLL_EndProcName = SrcInputFileData%DLL_EndProcName + DstInputFileData%DirRoot = SrcInputFileData%DirRoot +end subroutine +subroutine Orca_DestroyInputFile(InputFileData, ErrStat, ErrMsg) + type(Orca_InputFile), intent(inout) :: InputFileData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Orca_DestroyInputFile' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine Orca_PackInputFile(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Orca_InputFile), intent(in) :: InData character(*), parameter :: RoutineName = 'Orca_PackInputFile' if (Buf%ErrStat >= AbortErrLev) return - ! DLL_FileName call RegPack(Buf, InData%DLL_FileName) if (RegCheckErr(Buf, RoutineName)) return - ! DLL_InitProcName call RegPack(Buf, InData%DLL_InitProcName) if (RegCheckErr(Buf, RoutineName)) return - ! DLL_CalcProcName call RegPack(Buf, InData%DLL_CalcProcName) if (RegCheckErr(Buf, RoutineName)) return - ! DLL_EndProcName call RegPack(Buf, InData%DLL_EndProcName) if (RegCheckErr(Buf, RoutineName)) return - ! DirRoot call RegPack(Buf, InData%DirRoot) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -370,61 +326,44 @@ subroutine Orca_UnPackInputFile(Buf, OutData) type(Orca_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Orca_UnPackInputFile' if (Buf%ErrStat /= ErrID_None) return - ! DLL_FileName call RegUnpack(Buf, OutData%DLL_FileName) if (RegCheckErr(Buf, RoutineName)) return - ! DLL_InitProcName call RegUnpack(Buf, OutData%DLL_InitProcName) if (RegCheckErr(Buf, RoutineName)) return - ! DLL_CalcProcName call RegUnpack(Buf, OutData%DLL_CalcProcName) if (RegCheckErr(Buf, RoutineName)) return - ! DLL_EndProcName call RegUnpack(Buf, OutData%DLL_EndProcName) if (RegCheckErr(Buf, RoutineName)) return - ! DirRoot call RegUnpack(Buf, OutData%DirRoot) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Orca_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Orca_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(Orca_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState - END SUBROUTINE Orca_CopyOtherState - - SUBROUTINE Orca_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(Orca_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE Orca_DestroyOtherState +subroutine Orca_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(Orca_OtherStateType), intent(in) :: SrcOtherStateData + type(Orca_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Orca_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState +end subroutine +subroutine Orca_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(Orca_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Orca_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine Orca_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Orca_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'Orca_PackOtherState' if (Buf%ErrStat >= AbortErrLev) return - ! DummyOtherState call RegPack(Buf, InData%DummyOtherState) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -434,85 +373,70 @@ subroutine Orca_UnPackOtherState(Buf, OutData) type(Orca_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Orca_UnPackOtherState' if (Buf%ErrStat /= ErrID_None) return - ! DummyOtherState call RegUnpack(Buf, OutData%DummyOtherState) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Orca_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Orca_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(Orca_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_CopyMisc' -! + +subroutine Orca_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(Orca_MiscVarType), intent(in) :: SrcMiscData + type(Orca_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Orca_CopyMisc' ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%PtfmAM = SrcMiscData%PtfmAM - DstMiscData%PtfmFt = SrcMiscData%PtfmFt - DstMiscData%F_PtfmAM = SrcMiscData%F_PtfmAM -IF (ALLOCATED(SrcMiscData%AllOuts)) THEN - i1_l = LBOUND(SrcMiscData%AllOuts,1) - i1_u = UBOUND(SrcMiscData%AllOuts,1) - IF (.NOT. ALLOCATED(DstMiscData%AllOuts)) THEN - ALLOCATE(DstMiscData%AllOuts(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%AllOuts = SrcMiscData%AllOuts -ENDIF - DstMiscData%LastTimeStep = SrcMiscData%LastTimeStep - END SUBROUTINE Orca_CopyMisc - - SUBROUTINE Orca_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(Orca_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MiscData%AllOuts)) THEN - DEALLOCATE(MiscData%AllOuts) -ENDIF - END SUBROUTINE Orca_DestroyMisc + ErrMsg = '' + DstMiscData%PtfmAM = SrcMiscData%PtfmAM + DstMiscData%PtfmFt = SrcMiscData%PtfmFt + DstMiscData%F_PtfmAM = SrcMiscData%F_PtfmAM + if (allocated(SrcMiscData%AllOuts)) then + LB(1:1) = lbound(SrcMiscData%AllOuts) + UB(1:1) = ubound(SrcMiscData%AllOuts) + if (.not. allocated(DstMiscData%AllOuts)) then + allocate(DstMiscData%AllOuts(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%AllOuts = SrcMiscData%AllOuts + else if (allocated(DstMiscData%AllOuts)) then + deallocate(DstMiscData%AllOuts) + end if + DstMiscData%LastTimeStep = SrcMiscData%LastTimeStep +end subroutine +subroutine Orca_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(Orca_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Orca_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%AllOuts)) then + deallocate(MiscData%AllOuts) + end if +end subroutine subroutine Orca_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Orca_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'Orca_PackMisc' if (Buf%ErrStat >= AbortErrLev) return - ! PtfmAM call RegPack(Buf, InData%PtfmAM) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmFt call RegPack(Buf, InData%PtfmFt) if (RegCheckErr(Buf, RoutineName)) return - ! F_PtfmAM call RegPack(Buf, InData%F_PtfmAM) if (RegCheckErr(Buf, RoutineName)) return - ! AllOuts call RegPack(Buf, allocated(InData%AllOuts)) if (allocated(InData%AllOuts)) then call RegPackBounds(Buf, 1, lbound(InData%AllOuts), ubound(InData%AllOuts)) call RegPack(Buf, InData%AllOuts) end if if (RegCheckErr(Buf, RoutineName)) return - ! LastTimeStep call RegPack(Buf, InData%LastTimeStep) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -525,16 +449,12 @@ subroutine Orca_UnPackMisc(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! PtfmAM call RegUnpack(Buf, OutData%PtfmAM) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmFt call RegUnpack(Buf, OutData%PtfmFt) if (RegCheckErr(Buf, RoutineName)) return - ! F_PtfmAM call RegUnpack(Buf, OutData%F_PtfmAM) if (RegCheckErr(Buf, RoutineName)) return - ! AllOuts if (allocated(OutData%AllOuts)) deallocate(OutData%AllOuts) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -549,72 +469,69 @@ subroutine Orca_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%AllOuts) if (RegCheckErr(Buf, RoutineName)) return end if - ! LastTimeStep call RegUnpack(Buf, OutData%LastTimeStep) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Orca_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Orca_ParameterType), INTENT(IN) :: SrcParamData - TYPE(Orca_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_CopyParam' -! + +subroutine Orca_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(Orca_ParameterType), intent(in) :: SrcParamData + type(Orca_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Orca_CopyParam' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT - DstParamData%DLL_Orca = SrcParamData%DLL_Orca - DstParamData%SimNamePath = SrcParamData%SimNamePath - DstParamData%SimNamePathLen = SrcParamData%SimNamePathLen - DstParamData%NumOuts = SrcParamData%NumOuts -IF (ALLOCATED(SrcParamData%OutParam)) THEN - i1_l = LBOUND(SrcParamData%OutParam,1) - i1_u = UBOUND(SrcParamData%OutParam,1) - IF (.NOT. ALLOCATED(DstParamData%OutParam)) THEN - ALLOCATE(DstParamData%OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%OutParam,1), UBOUND(SrcParamData%OutParam,1) - CALL NWTC_Library_Copyoutparmtype( SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE Orca_CopyParam - - SUBROUTINE Orca_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(Orca_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL FreeDynamicLib( ParamData%DLL_Orca, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ParamData%OutParam)) THEN -DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_DestroyOutParmType( ParamData%OutParam(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%OutParam) -ENDIF - END SUBROUTINE Orca_DestroyParam + ErrMsg = '' + DstParamData%DT = SrcParamData%DT + DstParamData%DLL_Orca = SrcParamData%DLL_Orca + DstParamData%SimNamePath = SrcParamData%SimNamePath + DstParamData%SimNamePathLen = SrcParamData%SimNamePathLen + DstParamData%NumOuts = SrcParamData%NumOuts + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstParamData%OutParam)) then + deallocate(DstParamData%OutParam) + end if +end subroutine +subroutine Orca_DestroyParam(ParamData, ErrStat, ErrMsg) + type(Orca_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Orca_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%OutParam) + end if +end subroutine subroutine Orca_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -623,22 +540,16 @@ subroutine Orca_PackParam(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! DT call RegPack(Buf, InData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! DLL_Orca call DLLTypePack(Buf, InData%DLL_Orca) if (RegCheckErr(Buf, RoutineName)) return - ! SimNamePath call RegPack(Buf, InData%SimNamePath) if (RegCheckErr(Buf, RoutineName)) return - ! SimNamePathLen call RegPack(Buf, InData%SimNamePathLen) if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegPack(Buf, InData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! OutParam call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) @@ -660,21 +571,15 @@ subroutine Orca_UnPackParam(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! DT call RegUnpack(Buf, OutData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! DLL_Orca call DLLTypeUnpack(Buf, OutData%DLL_Orca) ! DLL_Orca - ! SimNamePath call RegUnpack(Buf, OutData%SimNamePath) if (RegCheckErr(Buf, RoutineName)) return - ! SimNamePathLen call RegUnpack(Buf, OutData%SimNamePathLen) if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegUnpack(Buf, OutData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! OutParam if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -691,49 +596,39 @@ subroutine Orca_UnPackParam(Buf, OutData) end do end if end subroutine - SUBROUTINE Orca_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Orca_InputType), INTENT(INOUT) :: SrcInputData - TYPE(Orca_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_CopyInput' -! + +subroutine Orca_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(Orca_InputType), intent(inout) :: SrcInputData + type(Orca_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Orca_CopyInput' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcInputData%PtfmMesh, DstInputData%PtfmMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE Orca_CopyInput - - SUBROUTINE Orca_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(Orca_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL MeshDestroy( InputData%PtfmMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE Orca_DestroyInput + ErrMsg = '' + call MeshCopy(SrcInputData%PtfmMesh, DstInputData%PtfmMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine Orca_DestroyInput(InputData, ErrStat, ErrMsg) + type(Orca_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Orca_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine Orca_PackInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Orca_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Orca_PackInput' if (Buf%ErrStat >= AbortErrLev) return - ! PtfmMesh call MeshPack(Buf, InData%PtfmMesh) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -743,71 +638,61 @@ subroutine Orca_UnPackInput(Buf, OutData) type(Orca_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Orca_UnPackInput' if (Buf%ErrStat /= ErrID_None) return - ! PtfmMesh call MeshUnpack(Buf, OutData%PtfmMesh) ! PtfmMesh end subroutine - SUBROUTINE Orca_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Orca_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(Orca_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_CopyOutput' -! + +subroutine Orca_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(Orca_OutputType), intent(inout) :: SrcOutputData + type(Orca_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Orca_CopyOutput' ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcOutputData%PtfmMesh, DstOutputData%PtfmMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcOutputData%WriteOutput)) THEN - i1_l = LBOUND(SrcOutputData%WriteOutput,1) - i1_u = UBOUND(SrcOutputData%WriteOutput,1) - IF (.NOT. ALLOCATED(DstOutputData%WriteOutput)) THEN - ALLOCATE(DstOutputData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%WriteOutput = SrcOutputData%WriteOutput -ENDIF - END SUBROUTINE Orca_CopyOutput - - SUBROUTINE Orca_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(Orca_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL MeshDestroy( OutputData%PtfmMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - END SUBROUTINE Orca_DestroyOutput + ErrMsg = '' + call MeshCopy(SrcOutputData%PtfmMesh, DstOutputData%PtfmMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%WriteOutput = SrcOutputData%WriteOutput + else if (allocated(DstOutputData%WriteOutput)) then + deallocate(DstOutputData%WriteOutput) + end if +end subroutine +subroutine Orca_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(Orca_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Orca_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine subroutine Orca_PackOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Orca_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Orca_PackOutput' if (Buf%ErrStat >= AbortErrLev) return - ! PtfmMesh call MeshPack(Buf, InData%PtfmMesh) if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutput call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) @@ -824,9 +709,7 @@ subroutine Orca_UnPackOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! PtfmMesh call MeshUnpack(Buf, OutData%PtfmMesh) ! PtfmMesh - ! WriteOutput if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -842,45 +725,33 @@ subroutine Orca_UnPackOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE Orca_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Orca_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(Orca_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%Dummy = SrcContStateData%Dummy - END SUBROUTINE Orca_CopyContState - SUBROUTINE Orca_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(Orca_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Orca_DestroyContState +subroutine Orca_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(Orca_ContinuousStateType), intent(in) :: SrcContStateData + type(Orca_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Orca_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + DstContStateData%Dummy = SrcContStateData%Dummy +end subroutine +subroutine Orca_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(Orca_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Orca_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine Orca_PackContState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Orca_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'Orca_PackContState' if (Buf%ErrStat >= AbortErrLev) return - ! Dummy call RegPack(Buf, InData%Dummy) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -890,49 +761,36 @@ subroutine Orca_UnPackContState(Buf, OutData) type(Orca_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Orca_UnPackContState' if (Buf%ErrStat /= ErrID_None) return - ! Dummy call RegUnpack(Buf, OutData%Dummy) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Orca_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Orca_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(Orca_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%Dummy = SrcDiscStateData%Dummy - END SUBROUTINE Orca_CopyDiscState - - SUBROUTINE Orca_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(Orca_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyDiscState' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Orca_DestroyDiscState +subroutine Orca_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(Orca_DiscreteStateType), intent(in) :: SrcDiscStateData + type(Orca_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Orca_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + DstDiscStateData%Dummy = SrcDiscStateData%Dummy +end subroutine +subroutine Orca_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(Orca_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Orca_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine Orca_PackDiscState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Orca_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'Orca_PackDiscState' if (Buf%ErrStat >= AbortErrLev) return - ! Dummy call RegPack(Buf, InData%Dummy) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -942,49 +800,36 @@ subroutine Orca_UnPackDiscState(Buf, OutData) type(Orca_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Orca_UnPackDiscState' if (Buf%ErrStat /= ErrID_None) return - ! Dummy call RegUnpack(Buf, OutData%Dummy) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Orca_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Orca_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(Orca_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE Orca_CopyConstrState - - SUBROUTINE Orca_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(Orca_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_DestroyConstrState' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Orca_DestroyConstrState +subroutine Orca_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(Orca_ConstraintStateType), intent(in) :: SrcConstrStateData + type(Orca_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Orca_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine +subroutine Orca_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(Orca_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Orca_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine Orca_PackConstrState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Orca_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'Orca_PackConstrState' if (Buf%ErrStat >= AbortErrLev) return - ! DummyConstrState call RegPack(Buf, InData%DummyConstrState) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -994,7 +839,6 @@ subroutine Orca_UnPackConstrState(Buf, OutData) type(Orca_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Orca_UnPackConstrState' if (Buf%ErrStat /= ErrID_None) return - ! DummyConstrState call RegUnpack(Buf, OutData%DummyConstrState) if (RegCheckErr(Buf, RoutineName)) return end subroutine diff --git a/modules/seastate/src/Current_Types.f90 b/modules/seastate/src/Current_Types.f90 index 3fcbe4cefa..9df0722284 100644 --- a/modules/seastate/src/Current_Types.f90 +++ b/modules/seastate/src/Current_Types.f90 @@ -59,112 +59,91 @@ MODULE Current_Types END TYPE Current_InitOutputType ! ======================= CONTAINS - SUBROUTINE Current_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Current_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(Current_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%CurrSSV0 = SrcInitInputData%CurrSSV0 - DstInitInputData%CurrSSDirChr = SrcInitInputData%CurrSSDirChr - DstInitInputData%CurrSSDir = SrcInitInputData%CurrSSDir - DstInitInputData%CurrNSRef = SrcInitInputData%CurrNSRef - DstInitInputData%CurrNSV0 = SrcInitInputData%CurrNSV0 - DstInitInputData%CurrNSDir = SrcInitInputData%CurrNSDir - DstInitInputData%CurrDIV = SrcInitInputData%CurrDIV - DstInitInputData%CurrDIDir = SrcInitInputData%CurrDIDir - DstInitInputData%CurrMod = SrcInitInputData%CurrMod - DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth -IF (ALLOCATED(SrcInitInputData%WaveKinGridzi)) THEN - i1_l = LBOUND(SrcInitInputData%WaveKinGridzi,1) - i1_u = UBOUND(SrcInitInputData%WaveKinGridzi,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveKinGridzi)) THEN - ALLOCATE(DstInitInputData%WaveKinGridzi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinGridzi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveKinGridzi = SrcInitInputData%WaveKinGridzi -ENDIF - DstInitInputData%NGridPts = SrcInitInputData%NGridPts - DstInitInputData%DirRoot = SrcInitInputData%DirRoot - END SUBROUTINE Current_CopyInitInput - - SUBROUTINE Current_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(Current_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(InitInputData%WaveKinGridzi)) THEN - DEALLOCATE(InitInputData%WaveKinGridzi) -ENDIF - END SUBROUTINE Current_DestroyInitInput +subroutine Current_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(Current_InitInputType), intent(in) :: SrcInitInputData + type(Current_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Current_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitInputData%CurrSSV0 = SrcInitInputData%CurrSSV0 + DstInitInputData%CurrSSDirChr = SrcInitInputData%CurrSSDirChr + DstInitInputData%CurrSSDir = SrcInitInputData%CurrSSDir + DstInitInputData%CurrNSRef = SrcInitInputData%CurrNSRef + DstInitInputData%CurrNSV0 = SrcInitInputData%CurrNSV0 + DstInitInputData%CurrNSDir = SrcInitInputData%CurrNSDir + DstInitInputData%CurrDIV = SrcInitInputData%CurrDIV + DstInitInputData%CurrDIDir = SrcInitInputData%CurrDIDir + DstInitInputData%CurrMod = SrcInitInputData%CurrMod + DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth + if (allocated(SrcInitInputData%WaveKinGridzi)) then + LB(1:1) = lbound(SrcInitInputData%WaveKinGridzi) + UB(1:1) = ubound(SrcInitInputData%WaveKinGridzi) + if (.not. allocated(DstInitInputData%WaveKinGridzi)) then + allocate(DstInitInputData%WaveKinGridzi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinGridzi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%WaveKinGridzi = SrcInitInputData%WaveKinGridzi + else if (allocated(DstInitInputData%WaveKinGridzi)) then + deallocate(DstInitInputData%WaveKinGridzi) + end if + DstInitInputData%NGridPts = SrcInitInputData%NGridPts + DstInitInputData%DirRoot = SrcInitInputData%DirRoot +end subroutine +subroutine Current_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(Current_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Current_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitInputData%WaveKinGridzi)) then + deallocate(InitInputData%WaveKinGridzi) + end if +end subroutine subroutine Current_PackInitInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Current_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Current_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return - ! CurrSSV0 call RegPack(Buf, InData%CurrSSV0) if (RegCheckErr(Buf, RoutineName)) return - ! CurrSSDirChr call RegPack(Buf, InData%CurrSSDirChr) if (RegCheckErr(Buf, RoutineName)) return - ! CurrSSDir call RegPack(Buf, InData%CurrSSDir) if (RegCheckErr(Buf, RoutineName)) return - ! CurrNSRef call RegPack(Buf, InData%CurrNSRef) if (RegCheckErr(Buf, RoutineName)) return - ! CurrNSV0 call RegPack(Buf, InData%CurrNSV0) if (RegCheckErr(Buf, RoutineName)) return - ! CurrNSDir call RegPack(Buf, InData%CurrNSDir) if (RegCheckErr(Buf, RoutineName)) return - ! CurrDIV call RegPack(Buf, InData%CurrDIV) if (RegCheckErr(Buf, RoutineName)) return - ! CurrDIDir call RegPack(Buf, InData%CurrDIDir) if (RegCheckErr(Buf, RoutineName)) return - ! CurrMod call RegPack(Buf, InData%CurrMod) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDpth call RegPack(Buf, InData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - ! WaveKinGridzi call RegPack(Buf, allocated(InData%WaveKinGridzi)) if (allocated(InData%WaveKinGridzi)) then call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridzi), ubound(InData%WaveKinGridzi)) call RegPack(Buf, InData%WaveKinGridzi) end if if (RegCheckErr(Buf, RoutineName)) return - ! NGridPts call RegPack(Buf, InData%NGridPts) if (RegCheckErr(Buf, RoutineName)) return - ! DirRoot call RegPack(Buf, InData%DirRoot) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -177,37 +156,26 @@ subroutine Current_UnPackInitInput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! CurrSSV0 call RegUnpack(Buf, OutData%CurrSSV0) if (RegCheckErr(Buf, RoutineName)) return - ! CurrSSDirChr call RegUnpack(Buf, OutData%CurrSSDirChr) if (RegCheckErr(Buf, RoutineName)) return - ! CurrSSDir call RegUnpack(Buf, OutData%CurrSSDir) if (RegCheckErr(Buf, RoutineName)) return - ! CurrNSRef call RegUnpack(Buf, OutData%CurrNSRef) if (RegCheckErr(Buf, RoutineName)) return - ! CurrNSV0 call RegUnpack(Buf, OutData%CurrNSV0) if (RegCheckErr(Buf, RoutineName)) return - ! CurrNSDir call RegUnpack(Buf, OutData%CurrNSDir) if (RegCheckErr(Buf, RoutineName)) return - ! CurrDIV call RegUnpack(Buf, OutData%CurrDIV) if (RegCheckErr(Buf, RoutineName)) return - ! CurrDIDir call RegUnpack(Buf, OutData%CurrDIDir) if (RegCheckErr(Buf, RoutineName)) return - ! CurrMod call RegUnpack(Buf, OutData%CurrMod) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDpth call RegUnpack(Buf, OutData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - ! WaveKinGridzi if (allocated(OutData%WaveKinGridzi)) deallocate(OutData%WaveKinGridzi) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -222,101 +190,89 @@ subroutine Current_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%WaveKinGridzi) if (RegCheckErr(Buf, RoutineName)) return end if - ! NGridPts call RegUnpack(Buf, OutData%NGridPts) if (RegCheckErr(Buf, RoutineName)) return - ! DirRoot call RegUnpack(Buf, OutData%DirRoot) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Current_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Current_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(Current_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_CopyInitOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInitOutputData%CurrVxi)) THEN - i1_l = LBOUND(SrcInitOutputData%CurrVxi,1) - i1_u = UBOUND(SrcInitOutputData%CurrVxi,1) - IF (.NOT. ALLOCATED(DstInitOutputData%CurrVxi)) THEN - ALLOCATE(DstInitOutputData%CurrVxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%CurrVxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%CurrVxi = SrcInitOutputData%CurrVxi -ENDIF -IF (ALLOCATED(SrcInitOutputData%CurrVyi)) THEN - i1_l = LBOUND(SrcInitOutputData%CurrVyi,1) - i1_u = UBOUND(SrcInitOutputData%CurrVyi,1) - IF (.NOT. ALLOCATED(DstInitOutputData%CurrVyi)) THEN - ALLOCATE(DstInitOutputData%CurrVyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%CurrVyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%CurrVyi = SrcInitOutputData%CurrVyi -ENDIF - DstInitOutputData%PCurrVxiPz0 = SrcInitOutputData%PCurrVxiPz0 - DstInitOutputData%PCurrVyiPz0 = SrcInitOutputData%PCurrVyiPz0 - END SUBROUTINE Current_CopyInitOutput - - SUBROUTINE Current_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(Current_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Current_DestroyInitOutput' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitOutputData%CurrVxi)) THEN - DEALLOCATE(InitOutputData%CurrVxi) -ENDIF -IF (ALLOCATED(InitOutputData%CurrVyi)) THEN - DEALLOCATE(InitOutputData%CurrVyi) -ENDIF - END SUBROUTINE Current_DestroyInitOutput +subroutine Current_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(Current_InitOutputType), intent(in) :: SrcInitOutputData + type(Current_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Current_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInitOutputData%CurrVxi)) then + LB(1:1) = lbound(SrcInitOutputData%CurrVxi) + UB(1:1) = ubound(SrcInitOutputData%CurrVxi) + if (.not. allocated(DstInitOutputData%CurrVxi)) then + allocate(DstInitOutputData%CurrVxi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%CurrVxi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%CurrVxi = SrcInitOutputData%CurrVxi + else if (allocated(DstInitOutputData%CurrVxi)) then + deallocate(DstInitOutputData%CurrVxi) + end if + if (allocated(SrcInitOutputData%CurrVyi)) then + LB(1:1) = lbound(SrcInitOutputData%CurrVyi) + UB(1:1) = ubound(SrcInitOutputData%CurrVyi) + if (.not. allocated(DstInitOutputData%CurrVyi)) then + allocate(DstInitOutputData%CurrVyi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%CurrVyi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%CurrVyi = SrcInitOutputData%CurrVyi + else if (allocated(DstInitOutputData%CurrVyi)) then + deallocate(DstInitOutputData%CurrVyi) + end if + DstInitOutputData%PCurrVxiPz0 = SrcInitOutputData%PCurrVxiPz0 + DstInitOutputData%PCurrVyiPz0 = SrcInitOutputData%PCurrVyiPz0 +end subroutine +subroutine Current_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(Current_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Current_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%CurrVxi)) then + deallocate(InitOutputData%CurrVxi) + end if + if (allocated(InitOutputData%CurrVyi)) then + deallocate(InitOutputData%CurrVyi) + end if +end subroutine subroutine Current_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Current_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Current_PackInitOutput' if (Buf%ErrStat >= AbortErrLev) return - ! CurrVxi call RegPack(Buf, allocated(InData%CurrVxi)) if (allocated(InData%CurrVxi)) then call RegPackBounds(Buf, 1, lbound(InData%CurrVxi), ubound(InData%CurrVxi)) call RegPack(Buf, InData%CurrVxi) end if if (RegCheckErr(Buf, RoutineName)) return - ! CurrVyi call RegPack(Buf, allocated(InData%CurrVyi)) if (allocated(InData%CurrVyi)) then call RegPackBounds(Buf, 1, lbound(InData%CurrVyi), ubound(InData%CurrVyi)) call RegPack(Buf, InData%CurrVyi) end if if (RegCheckErr(Buf, RoutineName)) return - ! PCurrVxiPz0 call RegPack(Buf, InData%PCurrVxiPz0) if (RegCheckErr(Buf, RoutineName)) return - ! PCurrVyiPz0 call RegPack(Buf, InData%PCurrVyiPz0) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -329,7 +285,6 @@ subroutine Current_UnPackInitOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! CurrVxi if (allocated(OutData%CurrVxi)) deallocate(OutData%CurrVxi) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -344,7 +299,6 @@ subroutine Current_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%CurrVxi) if (RegCheckErr(Buf, RoutineName)) return end if - ! CurrVyi if (allocated(OutData%CurrVyi)) deallocate(OutData%CurrVyi) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -359,10 +313,8 @@ subroutine Current_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%CurrVyi) if (RegCheckErr(Buf, RoutineName)) return end if - ! PCurrVxiPz0 call RegUnpack(Buf, OutData%PCurrVxiPz0) if (RegCheckErr(Buf, RoutineName)) return - ! PCurrVyiPz0 call RegUnpack(Buf, OutData%PCurrVyiPz0) if (RegCheckErr(Buf, RoutineName)) return end subroutine diff --git a/modules/seastate/src/SeaSt_WaveField_Types.f90 b/modules/seastate/src/SeaSt_WaveField_Types.f90 index 57c84dcbc7..b45292ec17 100644 --- a/modules/seastate/src/SeaSt_WaveField_Types.f90 +++ b/modules/seastate/src/SeaSt_WaveField_Types.f90 @@ -58,458 +58,390 @@ MODULE SeaSt_WaveField_Types END TYPE SeaSt_WaveFieldType ! ======================= CONTAINS - SUBROUTINE SeaSt_WaveField_CopySeaSt_WaveFieldType( SrcSeaSt_WaveFieldTypeData, DstSeaSt_WaveFieldTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SeaSt_WaveFieldType), INTENT(IN) :: SrcSeaSt_WaveFieldTypeData - TYPE(SeaSt_WaveFieldType), INTENT(INOUT) :: DstSeaSt_WaveFieldTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_WaveField_CopySeaSt_WaveFieldType' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcSeaSt_WaveFieldTypeData%WaveTime)) THEN - i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveTime,1) - i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveTime,1) - IF (.NOT. ALLOCATED(DstSeaSt_WaveFieldTypeData%WaveTime)) THEN - ALLOCATE(DstSeaSt_WaveFieldTypeData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstSeaSt_WaveFieldTypeData%WaveTime = SrcSeaSt_WaveFieldTypeData%WaveTime -ENDIF -IF (ALLOCATED(SrcSeaSt_WaveFieldTypeData%WaveDynP)) THEN - i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveDynP,1) - i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveDynP,1) - i2_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveDynP,2) - i2_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveDynP,2) - i3_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveDynP,3) - i3_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveDynP,3) - i4_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveDynP,4) - i4_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveDynP,4) - IF (.NOT. ALLOCATED(DstSeaSt_WaveFieldTypeData%WaveDynP)) THEN - ALLOCATE(DstSeaSt_WaveFieldTypeData%WaveDynP(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveDynP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstSeaSt_WaveFieldTypeData%WaveDynP = SrcSeaSt_WaveFieldTypeData%WaveDynP -ENDIF -IF (ALLOCATED(SrcSeaSt_WaveFieldTypeData%WaveAcc)) THEN - i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveAcc,1) - i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveAcc,1) - i2_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveAcc,2) - i2_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveAcc,2) - i3_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveAcc,3) - i3_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveAcc,3) - i4_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveAcc,4) - i4_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveAcc,4) - i5_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveAcc,5) - i5_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveAcc,5) - IF (.NOT. ALLOCATED(DstSeaSt_WaveFieldTypeData%WaveAcc)) THEN - ALLOCATE(DstSeaSt_WaveFieldTypeData%WaveAcc(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveAcc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstSeaSt_WaveFieldTypeData%WaveAcc = SrcSeaSt_WaveFieldTypeData%WaveAcc -ENDIF -IF (ALLOCATED(SrcSeaSt_WaveFieldTypeData%WaveAccMCF)) THEN - i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveAccMCF,1) - i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveAccMCF,1) - i2_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveAccMCF,2) - i2_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveAccMCF,2) - i3_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveAccMCF,3) - i3_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveAccMCF,3) - i4_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveAccMCF,4) - i4_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveAccMCF,4) - i5_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveAccMCF,5) - i5_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveAccMCF,5) - IF (.NOT. ALLOCATED(DstSeaSt_WaveFieldTypeData%WaveAccMCF)) THEN - ALLOCATE(DstSeaSt_WaveFieldTypeData%WaveAccMCF(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveAccMCF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstSeaSt_WaveFieldTypeData%WaveAccMCF = SrcSeaSt_WaveFieldTypeData%WaveAccMCF -ENDIF -IF (ALLOCATED(SrcSeaSt_WaveFieldTypeData%WaveVel)) THEN - i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveVel,1) - i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveVel,1) - i2_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveVel,2) - i2_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveVel,2) - i3_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveVel,3) - i3_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveVel,3) - i4_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveVel,4) - i4_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveVel,4) - i5_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveVel,5) - i5_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveVel,5) - IF (.NOT. ALLOCATED(DstSeaSt_WaveFieldTypeData%WaveVel)) THEN - ALLOCATE(DstSeaSt_WaveFieldTypeData%WaveVel(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstSeaSt_WaveFieldTypeData%WaveVel = SrcSeaSt_WaveFieldTypeData%WaveVel -ENDIF -IF (ALLOCATED(SrcSeaSt_WaveFieldTypeData%PWaveDynP0)) THEN - i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveDynP0,1) - i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveDynP0,1) - i2_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveDynP0,2) - i2_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveDynP0,2) - i3_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveDynP0,3) - i3_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveDynP0,3) - IF (.NOT. ALLOCATED(DstSeaSt_WaveFieldTypeData%PWaveDynP0)) THEN - ALLOCATE(DstSeaSt_WaveFieldTypeData%PWaveDynP0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%PWaveDynP0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstSeaSt_WaveFieldTypeData%PWaveDynP0 = SrcSeaSt_WaveFieldTypeData%PWaveDynP0 -ENDIF -IF (ALLOCATED(SrcSeaSt_WaveFieldTypeData%PWaveAcc0)) THEN - i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAcc0,1) - i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAcc0,1) - i2_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAcc0,2) - i2_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAcc0,2) - i3_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAcc0,3) - i3_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAcc0,3) - i4_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAcc0,4) - i4_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAcc0,4) - IF (.NOT. ALLOCATED(DstSeaSt_WaveFieldTypeData%PWaveAcc0)) THEN - ALLOCATE(DstSeaSt_WaveFieldTypeData%PWaveAcc0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%PWaveAcc0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstSeaSt_WaveFieldTypeData%PWaveAcc0 = SrcSeaSt_WaveFieldTypeData%PWaveAcc0 -ENDIF -IF (ALLOCATED(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0)) THEN - i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0,1) - i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0,1) - i2_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0,2) - i2_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0,2) - i3_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0,3) - i3_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0,3) - i4_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0,4) - i4_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0,4) - IF (.NOT. ALLOCATED(DstSeaSt_WaveFieldTypeData%PWaveAccMCF0)) THEN - ALLOCATE(DstSeaSt_WaveFieldTypeData%PWaveAccMCF0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%PWaveAccMCF0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstSeaSt_WaveFieldTypeData%PWaveAccMCF0 = SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0 -ENDIF -IF (ALLOCATED(SrcSeaSt_WaveFieldTypeData%PWaveVel0)) THEN - i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveVel0,1) - i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveVel0,1) - i2_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveVel0,2) - i2_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveVel0,2) - i3_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveVel0,3) - i3_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveVel0,3) - i4_l = LBOUND(SrcSeaSt_WaveFieldTypeData%PWaveVel0,4) - i4_u = UBOUND(SrcSeaSt_WaveFieldTypeData%PWaveVel0,4) - IF (.NOT. ALLOCATED(DstSeaSt_WaveFieldTypeData%PWaveVel0)) THEN - ALLOCATE(DstSeaSt_WaveFieldTypeData%PWaveVel0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%PWaveVel0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstSeaSt_WaveFieldTypeData%PWaveVel0 = SrcSeaSt_WaveFieldTypeData%PWaveVel0 -ENDIF -IF (ALLOCATED(SrcSeaSt_WaveFieldTypeData%WaveElev0)) THEN - i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev0,1) - i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev0,1) - IF (.NOT. ALLOCATED(DstSeaSt_WaveFieldTypeData%WaveElev0)) THEN - ALLOCATE(DstSeaSt_WaveFieldTypeData%WaveElev0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveElev0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstSeaSt_WaveFieldTypeData%WaveElev0 = SrcSeaSt_WaveFieldTypeData%WaveElev0 -ENDIF -IF (ALLOCATED(SrcSeaSt_WaveFieldTypeData%WaveElev1)) THEN - i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev1,1) - i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev1,1) - i2_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev1,2) - i2_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev1,2) - i3_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev1,3) - i3_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev1,3) - IF (.NOT. ALLOCATED(DstSeaSt_WaveFieldTypeData%WaveElev1)) THEN - ALLOCATE(DstSeaSt_WaveFieldTypeData%WaveElev1(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveElev1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstSeaSt_WaveFieldTypeData%WaveElev1 = SrcSeaSt_WaveFieldTypeData%WaveElev1 -ENDIF -IF (ALLOCATED(SrcSeaSt_WaveFieldTypeData%WaveElev2)) THEN - i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev2,1) - i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev2,1) - i2_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev2,2) - i2_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev2,2) - i3_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev2,3) - i3_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveElev2,3) - IF (.NOT. ALLOCATED(DstSeaSt_WaveFieldTypeData%WaveElev2)) THEN - ALLOCATE(DstSeaSt_WaveFieldTypeData%WaveElev2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveElev2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstSeaSt_WaveFieldTypeData%WaveElev2 = SrcSeaSt_WaveFieldTypeData%WaveElev2 -ENDIF - CALL SeaSt_Interp_CopyParam( SrcSeaSt_WaveFieldTypeData%SeaSt_Interp_p, DstSeaSt_WaveFieldTypeData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstSeaSt_WaveFieldTypeData%WaveStMod = SrcSeaSt_WaveFieldTypeData%WaveStMod - DstSeaSt_WaveFieldTypeData%EffWtrDpth = SrcSeaSt_WaveFieldTypeData%EffWtrDpth - DstSeaSt_WaveFieldTypeData%MSL2SWL = SrcSeaSt_WaveFieldTypeData%MSL2SWL -IF (ALLOCATED(SrcSeaSt_WaveFieldTypeData%WaveElevC)) THEN - i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveElevC,1) - i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveElevC,1) - i2_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveElevC,2) - i2_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveElevC,2) - i3_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveElevC,3) - i3_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveElevC,3) - IF (.NOT. ALLOCATED(DstSeaSt_WaveFieldTypeData%WaveElevC)) THEN - ALLOCATE(DstSeaSt_WaveFieldTypeData%WaveElevC(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveElevC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstSeaSt_WaveFieldTypeData%WaveElevC = SrcSeaSt_WaveFieldTypeData%WaveElevC -ENDIF -IF (ALLOCATED(SrcSeaSt_WaveFieldTypeData%WaveElevC0)) THEN - i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveElevC0,1) - i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveElevC0,1) - i2_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveElevC0,2) - i2_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveElevC0,2) - IF (.NOT. ALLOCATED(DstSeaSt_WaveFieldTypeData%WaveElevC0)) THEN - ALLOCATE(DstSeaSt_WaveFieldTypeData%WaveElevC0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveElevC0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstSeaSt_WaveFieldTypeData%WaveElevC0 = SrcSeaSt_WaveFieldTypeData%WaveElevC0 -ENDIF -IF (ALLOCATED(SrcSeaSt_WaveFieldTypeData%WaveDirArr)) THEN - i1_l = LBOUND(SrcSeaSt_WaveFieldTypeData%WaveDirArr,1) - i1_u = UBOUND(SrcSeaSt_WaveFieldTypeData%WaveDirArr,1) - IF (.NOT. ALLOCATED(DstSeaSt_WaveFieldTypeData%WaveDirArr)) THEN - ALLOCATE(DstSeaSt_WaveFieldTypeData%WaveDirArr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveDirArr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstSeaSt_WaveFieldTypeData%WaveDirArr = SrcSeaSt_WaveFieldTypeData%WaveDirArr -ENDIF - END SUBROUTINE SeaSt_WaveField_CopySeaSt_WaveFieldType - - SUBROUTINE SeaSt_WaveField_DestroySeaSt_WaveFieldType( SeaSt_WaveFieldTypeData, ErrStat, ErrMsg ) - TYPE(SeaSt_WaveFieldType), INTENT(INOUT) :: SeaSt_WaveFieldTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_WaveField_DestroySeaSt_WaveFieldType' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(SeaSt_WaveFieldTypeData%WaveTime)) THEN - DEALLOCATE(SeaSt_WaveFieldTypeData%WaveTime) -ENDIF -IF (ALLOCATED(SeaSt_WaveFieldTypeData%WaveDynP)) THEN - DEALLOCATE(SeaSt_WaveFieldTypeData%WaveDynP) -ENDIF -IF (ALLOCATED(SeaSt_WaveFieldTypeData%WaveAcc)) THEN - DEALLOCATE(SeaSt_WaveFieldTypeData%WaveAcc) -ENDIF -IF (ALLOCATED(SeaSt_WaveFieldTypeData%WaveAccMCF)) THEN - DEALLOCATE(SeaSt_WaveFieldTypeData%WaveAccMCF) -ENDIF -IF (ALLOCATED(SeaSt_WaveFieldTypeData%WaveVel)) THEN - DEALLOCATE(SeaSt_WaveFieldTypeData%WaveVel) -ENDIF -IF (ALLOCATED(SeaSt_WaveFieldTypeData%PWaveDynP0)) THEN - DEALLOCATE(SeaSt_WaveFieldTypeData%PWaveDynP0) -ENDIF -IF (ALLOCATED(SeaSt_WaveFieldTypeData%PWaveAcc0)) THEN - DEALLOCATE(SeaSt_WaveFieldTypeData%PWaveAcc0) -ENDIF -IF (ALLOCATED(SeaSt_WaveFieldTypeData%PWaveAccMCF0)) THEN - DEALLOCATE(SeaSt_WaveFieldTypeData%PWaveAccMCF0) -ENDIF -IF (ALLOCATED(SeaSt_WaveFieldTypeData%PWaveVel0)) THEN - DEALLOCATE(SeaSt_WaveFieldTypeData%PWaveVel0) -ENDIF -IF (ALLOCATED(SeaSt_WaveFieldTypeData%WaveElev0)) THEN - DEALLOCATE(SeaSt_WaveFieldTypeData%WaveElev0) -ENDIF -IF (ALLOCATED(SeaSt_WaveFieldTypeData%WaveElev1)) THEN - DEALLOCATE(SeaSt_WaveFieldTypeData%WaveElev1) -ENDIF -IF (ALLOCATED(SeaSt_WaveFieldTypeData%WaveElev2)) THEN - DEALLOCATE(SeaSt_WaveFieldTypeData%WaveElev2) -ENDIF - CALL SeaSt_Interp_DestroyParam( SeaSt_WaveFieldTypeData%SeaSt_Interp_p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(SeaSt_WaveFieldTypeData%WaveElevC)) THEN - DEALLOCATE(SeaSt_WaveFieldTypeData%WaveElevC) -ENDIF -IF (ALLOCATED(SeaSt_WaveFieldTypeData%WaveElevC0)) THEN - DEALLOCATE(SeaSt_WaveFieldTypeData%WaveElevC0) -ENDIF -IF (ALLOCATED(SeaSt_WaveFieldTypeData%WaveDirArr)) THEN - DEALLOCATE(SeaSt_WaveFieldTypeData%WaveDirArr) -ENDIF - END SUBROUTINE SeaSt_WaveField_DestroySeaSt_WaveFieldType +subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, DstSeaSt_WaveFieldTypeData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_WaveFieldType), intent(in) :: SrcSeaSt_WaveFieldTypeData + type(SeaSt_WaveFieldType), intent(inout) :: DstSeaSt_WaveFieldTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_WaveField_CopySeaSt_WaveFieldType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcSeaSt_WaveFieldTypeData%WaveTime)) then + LB(1:1) = lbound(SrcSeaSt_WaveFieldTypeData%WaveTime) + UB(1:1) = ubound(SrcSeaSt_WaveFieldTypeData%WaveTime) + if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveTime)) then + allocate(DstSeaSt_WaveFieldTypeData%WaveTime(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveTime.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveFieldTypeData%WaveTime = SrcSeaSt_WaveFieldTypeData%WaveTime + else if (allocated(DstSeaSt_WaveFieldTypeData%WaveTime)) then + deallocate(DstSeaSt_WaveFieldTypeData%WaveTime) + end if + if (allocated(SrcSeaSt_WaveFieldTypeData%WaveDynP)) then + LB(1:4) = lbound(SrcSeaSt_WaveFieldTypeData%WaveDynP) + UB(1:4) = ubound(SrcSeaSt_WaveFieldTypeData%WaveDynP) + if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveDynP)) then + allocate(DstSeaSt_WaveFieldTypeData%WaveDynP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveDynP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveFieldTypeData%WaveDynP = SrcSeaSt_WaveFieldTypeData%WaveDynP + else if (allocated(DstSeaSt_WaveFieldTypeData%WaveDynP)) then + deallocate(DstSeaSt_WaveFieldTypeData%WaveDynP) + end if + if (allocated(SrcSeaSt_WaveFieldTypeData%WaveAcc)) then + LB(1:5) = lbound(SrcSeaSt_WaveFieldTypeData%WaveAcc) + UB(1:5) = ubound(SrcSeaSt_WaveFieldTypeData%WaveAcc) + if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveAcc)) then + allocate(DstSeaSt_WaveFieldTypeData%WaveAcc(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveAcc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveFieldTypeData%WaveAcc = SrcSeaSt_WaveFieldTypeData%WaveAcc + else if (allocated(DstSeaSt_WaveFieldTypeData%WaveAcc)) then + deallocate(DstSeaSt_WaveFieldTypeData%WaveAcc) + end if + if (allocated(SrcSeaSt_WaveFieldTypeData%WaveAccMCF)) then + LB(1:5) = lbound(SrcSeaSt_WaveFieldTypeData%WaveAccMCF) + UB(1:5) = ubound(SrcSeaSt_WaveFieldTypeData%WaveAccMCF) + if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveAccMCF)) then + allocate(DstSeaSt_WaveFieldTypeData%WaveAccMCF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveAccMCF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveFieldTypeData%WaveAccMCF = SrcSeaSt_WaveFieldTypeData%WaveAccMCF + else if (allocated(DstSeaSt_WaveFieldTypeData%WaveAccMCF)) then + deallocate(DstSeaSt_WaveFieldTypeData%WaveAccMCF) + end if + if (allocated(SrcSeaSt_WaveFieldTypeData%WaveVel)) then + LB(1:5) = lbound(SrcSeaSt_WaveFieldTypeData%WaveVel) + UB(1:5) = ubound(SrcSeaSt_WaveFieldTypeData%WaveVel) + if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveVel)) then + allocate(DstSeaSt_WaveFieldTypeData%WaveVel(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveVel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveFieldTypeData%WaveVel = SrcSeaSt_WaveFieldTypeData%WaveVel + else if (allocated(DstSeaSt_WaveFieldTypeData%WaveVel)) then + deallocate(DstSeaSt_WaveFieldTypeData%WaveVel) + end if + if (allocated(SrcSeaSt_WaveFieldTypeData%PWaveDynP0)) then + LB(1:3) = lbound(SrcSeaSt_WaveFieldTypeData%PWaveDynP0) + UB(1:3) = ubound(SrcSeaSt_WaveFieldTypeData%PWaveDynP0) + if (.not. allocated(DstSeaSt_WaveFieldTypeData%PWaveDynP0)) then + allocate(DstSeaSt_WaveFieldTypeData%PWaveDynP0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%PWaveDynP0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveFieldTypeData%PWaveDynP0 = SrcSeaSt_WaveFieldTypeData%PWaveDynP0 + else if (allocated(DstSeaSt_WaveFieldTypeData%PWaveDynP0)) then + deallocate(DstSeaSt_WaveFieldTypeData%PWaveDynP0) + end if + if (allocated(SrcSeaSt_WaveFieldTypeData%PWaveAcc0)) then + LB(1:4) = lbound(SrcSeaSt_WaveFieldTypeData%PWaveAcc0) + UB(1:4) = ubound(SrcSeaSt_WaveFieldTypeData%PWaveAcc0) + if (.not. allocated(DstSeaSt_WaveFieldTypeData%PWaveAcc0)) then + allocate(DstSeaSt_WaveFieldTypeData%PWaveAcc0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%PWaveAcc0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveFieldTypeData%PWaveAcc0 = SrcSeaSt_WaveFieldTypeData%PWaveAcc0 + else if (allocated(DstSeaSt_WaveFieldTypeData%PWaveAcc0)) then + deallocate(DstSeaSt_WaveFieldTypeData%PWaveAcc0) + end if + if (allocated(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0)) then + LB(1:4) = lbound(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0) + UB(1:4) = ubound(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0) + if (.not. allocated(DstSeaSt_WaveFieldTypeData%PWaveAccMCF0)) then + allocate(DstSeaSt_WaveFieldTypeData%PWaveAccMCF0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%PWaveAccMCF0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveFieldTypeData%PWaveAccMCF0 = SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0 + else if (allocated(DstSeaSt_WaveFieldTypeData%PWaveAccMCF0)) then + deallocate(DstSeaSt_WaveFieldTypeData%PWaveAccMCF0) + end if + if (allocated(SrcSeaSt_WaveFieldTypeData%PWaveVel0)) then + LB(1:4) = lbound(SrcSeaSt_WaveFieldTypeData%PWaveVel0) + UB(1:4) = ubound(SrcSeaSt_WaveFieldTypeData%PWaveVel0) + if (.not. allocated(DstSeaSt_WaveFieldTypeData%PWaveVel0)) then + allocate(DstSeaSt_WaveFieldTypeData%PWaveVel0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%PWaveVel0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveFieldTypeData%PWaveVel0 = SrcSeaSt_WaveFieldTypeData%PWaveVel0 + else if (allocated(DstSeaSt_WaveFieldTypeData%PWaveVel0)) then + deallocate(DstSeaSt_WaveFieldTypeData%PWaveVel0) + end if + if (allocated(SrcSeaSt_WaveFieldTypeData%WaveElev0)) then + LB(1:1) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElev0) + UB(1:1) = ubound(SrcSeaSt_WaveFieldTypeData%WaveElev0) + if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveElev0)) then + allocate(DstSeaSt_WaveFieldTypeData%WaveElev0(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveElev0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveFieldTypeData%WaveElev0 = SrcSeaSt_WaveFieldTypeData%WaveElev0 + else if (allocated(DstSeaSt_WaveFieldTypeData%WaveElev0)) then + deallocate(DstSeaSt_WaveFieldTypeData%WaveElev0) + end if + if (allocated(SrcSeaSt_WaveFieldTypeData%WaveElev1)) then + LB(1:3) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElev1) + UB(1:3) = ubound(SrcSeaSt_WaveFieldTypeData%WaveElev1) + if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveElev1)) then + allocate(DstSeaSt_WaveFieldTypeData%WaveElev1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveElev1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveFieldTypeData%WaveElev1 = SrcSeaSt_WaveFieldTypeData%WaveElev1 + else if (allocated(DstSeaSt_WaveFieldTypeData%WaveElev1)) then + deallocate(DstSeaSt_WaveFieldTypeData%WaveElev1) + end if + if (allocated(SrcSeaSt_WaveFieldTypeData%WaveElev2)) then + LB(1:3) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElev2) + UB(1:3) = ubound(SrcSeaSt_WaveFieldTypeData%WaveElev2) + if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveElev2)) then + allocate(DstSeaSt_WaveFieldTypeData%WaveElev2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveElev2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveFieldTypeData%WaveElev2 = SrcSeaSt_WaveFieldTypeData%WaveElev2 + else if (allocated(DstSeaSt_WaveFieldTypeData%WaveElev2)) then + deallocate(DstSeaSt_WaveFieldTypeData%WaveElev2) + end if + call SeaSt_Interp_CopyParam(SrcSeaSt_WaveFieldTypeData%SeaSt_Interp_p, DstSeaSt_WaveFieldTypeData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstSeaSt_WaveFieldTypeData%WaveStMod = SrcSeaSt_WaveFieldTypeData%WaveStMod + DstSeaSt_WaveFieldTypeData%EffWtrDpth = SrcSeaSt_WaveFieldTypeData%EffWtrDpth + DstSeaSt_WaveFieldTypeData%MSL2SWL = SrcSeaSt_WaveFieldTypeData%MSL2SWL + if (allocated(SrcSeaSt_WaveFieldTypeData%WaveElevC)) then + LB(1:3) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElevC) + UB(1:3) = ubound(SrcSeaSt_WaveFieldTypeData%WaveElevC) + if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveElevC)) then + allocate(DstSeaSt_WaveFieldTypeData%WaveElevC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveElevC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveFieldTypeData%WaveElevC = SrcSeaSt_WaveFieldTypeData%WaveElevC + else if (allocated(DstSeaSt_WaveFieldTypeData%WaveElevC)) then + deallocate(DstSeaSt_WaveFieldTypeData%WaveElevC) + end if + if (allocated(SrcSeaSt_WaveFieldTypeData%WaveElevC0)) then + LB(1:2) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElevC0) + UB(1:2) = ubound(SrcSeaSt_WaveFieldTypeData%WaveElevC0) + if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveElevC0)) then + allocate(DstSeaSt_WaveFieldTypeData%WaveElevC0(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveElevC0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveFieldTypeData%WaveElevC0 = SrcSeaSt_WaveFieldTypeData%WaveElevC0 + else if (allocated(DstSeaSt_WaveFieldTypeData%WaveElevC0)) then + deallocate(DstSeaSt_WaveFieldTypeData%WaveElevC0) + end if + if (allocated(SrcSeaSt_WaveFieldTypeData%WaveDirArr)) then + LB(1:1) = lbound(SrcSeaSt_WaveFieldTypeData%WaveDirArr) + UB(1:1) = ubound(SrcSeaSt_WaveFieldTypeData%WaveDirArr) + if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveDirArr)) then + allocate(DstSeaSt_WaveFieldTypeData%WaveDirArr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSeaSt_WaveFieldTypeData%WaveDirArr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSeaSt_WaveFieldTypeData%WaveDirArr = SrcSeaSt_WaveFieldTypeData%WaveDirArr + else if (allocated(DstSeaSt_WaveFieldTypeData%WaveDirArr)) then + deallocate(DstSeaSt_WaveFieldTypeData%WaveDirArr) + end if +end subroutine +subroutine SeaSt_WaveField_DestroySeaSt_WaveFieldType(SeaSt_WaveFieldTypeData, ErrStat, ErrMsg) + type(SeaSt_WaveFieldType), intent(inout) :: SeaSt_WaveFieldTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_WaveField_DestroySeaSt_WaveFieldType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SeaSt_WaveFieldTypeData%WaveTime)) then + deallocate(SeaSt_WaveFieldTypeData%WaveTime) + end if + if (allocated(SeaSt_WaveFieldTypeData%WaveDynP)) then + deallocate(SeaSt_WaveFieldTypeData%WaveDynP) + end if + if (allocated(SeaSt_WaveFieldTypeData%WaveAcc)) then + deallocate(SeaSt_WaveFieldTypeData%WaveAcc) + end if + if (allocated(SeaSt_WaveFieldTypeData%WaveAccMCF)) then + deallocate(SeaSt_WaveFieldTypeData%WaveAccMCF) + end if + if (allocated(SeaSt_WaveFieldTypeData%WaveVel)) then + deallocate(SeaSt_WaveFieldTypeData%WaveVel) + end if + if (allocated(SeaSt_WaveFieldTypeData%PWaveDynP0)) then + deallocate(SeaSt_WaveFieldTypeData%PWaveDynP0) + end if + if (allocated(SeaSt_WaveFieldTypeData%PWaveAcc0)) then + deallocate(SeaSt_WaveFieldTypeData%PWaveAcc0) + end if + if (allocated(SeaSt_WaveFieldTypeData%PWaveAccMCF0)) then + deallocate(SeaSt_WaveFieldTypeData%PWaveAccMCF0) + end if + if (allocated(SeaSt_WaveFieldTypeData%PWaveVel0)) then + deallocate(SeaSt_WaveFieldTypeData%PWaveVel0) + end if + if (allocated(SeaSt_WaveFieldTypeData%WaveElev0)) then + deallocate(SeaSt_WaveFieldTypeData%WaveElev0) + end if + if (allocated(SeaSt_WaveFieldTypeData%WaveElev1)) then + deallocate(SeaSt_WaveFieldTypeData%WaveElev1) + end if + if (allocated(SeaSt_WaveFieldTypeData%WaveElev2)) then + deallocate(SeaSt_WaveFieldTypeData%WaveElev2) + end if + if (allocated(SeaSt_WaveFieldTypeData%WaveElevC)) then + deallocate(SeaSt_WaveFieldTypeData%WaveElevC) + end if + if (allocated(SeaSt_WaveFieldTypeData%WaveElevC0)) then + deallocate(SeaSt_WaveFieldTypeData%WaveElevC0) + end if + if (allocated(SeaSt_WaveFieldTypeData%WaveDirArr)) then + deallocate(SeaSt_WaveFieldTypeData%WaveDirArr) + end if +end subroutine subroutine SeaSt_WaveField_PackSeaSt_WaveFieldType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SeaSt_WaveFieldType), intent(in) :: InData character(*), parameter :: RoutineName = 'SeaSt_WaveField_PackSeaSt_WaveFieldType' if (Buf%ErrStat >= AbortErrLev) return - ! WaveTime call RegPack(Buf, allocated(InData%WaveTime)) if (allocated(InData%WaveTime)) then call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) call RegPack(Buf, InData%WaveTime) end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveDynP call RegPack(Buf, allocated(InData%WaveDynP)) if (allocated(InData%WaveDynP)) then call RegPackBounds(Buf, 4, lbound(InData%WaveDynP), ubound(InData%WaveDynP)) call RegPack(Buf, InData%WaveDynP) end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveAcc call RegPack(Buf, allocated(InData%WaveAcc)) if (allocated(InData%WaveAcc)) then call RegPackBounds(Buf, 5, lbound(InData%WaveAcc), ubound(InData%WaveAcc)) call RegPack(Buf, InData%WaveAcc) end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveAccMCF call RegPack(Buf, allocated(InData%WaveAccMCF)) if (allocated(InData%WaveAccMCF)) then call RegPackBounds(Buf, 5, lbound(InData%WaveAccMCF), ubound(InData%WaveAccMCF)) call RegPack(Buf, InData%WaveAccMCF) end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveVel call RegPack(Buf, allocated(InData%WaveVel)) if (allocated(InData%WaveVel)) then call RegPackBounds(Buf, 5, lbound(InData%WaveVel), ubound(InData%WaveVel)) call RegPack(Buf, InData%WaveVel) end if if (RegCheckErr(Buf, RoutineName)) return - ! PWaveDynP0 call RegPack(Buf, allocated(InData%PWaveDynP0)) if (allocated(InData%PWaveDynP0)) then call RegPackBounds(Buf, 3, lbound(InData%PWaveDynP0), ubound(InData%PWaveDynP0)) call RegPack(Buf, InData%PWaveDynP0) end if if (RegCheckErr(Buf, RoutineName)) return - ! PWaveAcc0 call RegPack(Buf, allocated(InData%PWaveAcc0)) if (allocated(InData%PWaveAcc0)) then call RegPackBounds(Buf, 4, lbound(InData%PWaveAcc0), ubound(InData%PWaveAcc0)) call RegPack(Buf, InData%PWaveAcc0) end if if (RegCheckErr(Buf, RoutineName)) return - ! PWaveAccMCF0 call RegPack(Buf, allocated(InData%PWaveAccMCF0)) if (allocated(InData%PWaveAccMCF0)) then call RegPackBounds(Buf, 4, lbound(InData%PWaveAccMCF0), ubound(InData%PWaveAccMCF0)) call RegPack(Buf, InData%PWaveAccMCF0) end if if (RegCheckErr(Buf, RoutineName)) return - ! PWaveVel0 call RegPack(Buf, allocated(InData%PWaveVel0)) if (allocated(InData%PWaveVel0)) then call RegPackBounds(Buf, 4, lbound(InData%PWaveVel0), ubound(InData%PWaveVel0)) call RegPack(Buf, InData%PWaveVel0) end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveElev0 call RegPack(Buf, allocated(InData%WaveElev0)) if (allocated(InData%WaveElev0)) then call RegPackBounds(Buf, 1, lbound(InData%WaveElev0), ubound(InData%WaveElev0)) call RegPack(Buf, InData%WaveElev0) end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveElev1 call RegPack(Buf, allocated(InData%WaveElev1)) if (allocated(InData%WaveElev1)) then call RegPackBounds(Buf, 3, lbound(InData%WaveElev1), ubound(InData%WaveElev1)) call RegPack(Buf, InData%WaveElev1) end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveElev2 call RegPack(Buf, allocated(InData%WaveElev2)) if (allocated(InData%WaveElev2)) then call RegPackBounds(Buf, 3, lbound(InData%WaveElev2), ubound(InData%WaveElev2)) call RegPack(Buf, InData%WaveElev2) end if if (RegCheckErr(Buf, RoutineName)) return - ! SeaSt_Interp_p call SeaSt_Interp_PackParam(Buf, InData%SeaSt_Interp_p) if (RegCheckErr(Buf, RoutineName)) return - ! WaveStMod call RegPack(Buf, InData%WaveStMod) if (RegCheckErr(Buf, RoutineName)) return - ! EffWtrDpth call RegPack(Buf, InData%EffWtrDpth) if (RegCheckErr(Buf, RoutineName)) return - ! MSL2SWL call RegPack(Buf, InData%MSL2SWL) if (RegCheckErr(Buf, RoutineName)) return - ! WaveElevC call RegPack(Buf, allocated(InData%WaveElevC)) if (allocated(InData%WaveElevC)) then call RegPackBounds(Buf, 3, lbound(InData%WaveElevC), ubound(InData%WaveElevC)) call RegPack(Buf, InData%WaveElevC) end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveElevC0 call RegPack(Buf, allocated(InData%WaveElevC0)) if (allocated(InData%WaveElevC0)) then call RegPackBounds(Buf, 2, lbound(InData%WaveElevC0), ubound(InData%WaveElevC0)) call RegPack(Buf, InData%WaveElevC0) end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveDirArr call RegPack(Buf, allocated(InData%WaveDirArr)) if (allocated(InData%WaveDirArr)) then call RegPackBounds(Buf, 1, lbound(InData%WaveDirArr), ubound(InData%WaveDirArr)) @@ -526,7 +458,6 @@ subroutine SeaSt_WaveField_UnPackSeaSt_WaveFieldType(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! WaveTime if (allocated(OutData%WaveTime)) deallocate(OutData%WaveTime) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -541,7 +472,6 @@ subroutine SeaSt_WaveField_UnPackSeaSt_WaveFieldType(Buf, OutData) call RegUnpack(Buf, OutData%WaveTime) if (RegCheckErr(Buf, RoutineName)) return end if - ! WaveDynP if (allocated(OutData%WaveDynP)) deallocate(OutData%WaveDynP) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -556,7 +486,6 @@ subroutine SeaSt_WaveField_UnPackSeaSt_WaveFieldType(Buf, OutData) call RegUnpack(Buf, OutData%WaveDynP) if (RegCheckErr(Buf, RoutineName)) return end if - ! WaveAcc if (allocated(OutData%WaveAcc)) deallocate(OutData%WaveAcc) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -571,7 +500,6 @@ subroutine SeaSt_WaveField_UnPackSeaSt_WaveFieldType(Buf, OutData) call RegUnpack(Buf, OutData%WaveAcc) if (RegCheckErr(Buf, RoutineName)) return end if - ! WaveAccMCF if (allocated(OutData%WaveAccMCF)) deallocate(OutData%WaveAccMCF) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -586,7 +514,6 @@ subroutine SeaSt_WaveField_UnPackSeaSt_WaveFieldType(Buf, OutData) call RegUnpack(Buf, OutData%WaveAccMCF) if (RegCheckErr(Buf, RoutineName)) return end if - ! WaveVel if (allocated(OutData%WaveVel)) deallocate(OutData%WaveVel) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -601,7 +528,6 @@ subroutine SeaSt_WaveField_UnPackSeaSt_WaveFieldType(Buf, OutData) call RegUnpack(Buf, OutData%WaveVel) if (RegCheckErr(Buf, RoutineName)) return end if - ! PWaveDynP0 if (allocated(OutData%PWaveDynP0)) deallocate(OutData%PWaveDynP0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -616,7 +542,6 @@ subroutine SeaSt_WaveField_UnPackSeaSt_WaveFieldType(Buf, OutData) call RegUnpack(Buf, OutData%PWaveDynP0) if (RegCheckErr(Buf, RoutineName)) return end if - ! PWaveAcc0 if (allocated(OutData%PWaveAcc0)) deallocate(OutData%PWaveAcc0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -631,7 +556,6 @@ subroutine SeaSt_WaveField_UnPackSeaSt_WaveFieldType(Buf, OutData) call RegUnpack(Buf, OutData%PWaveAcc0) if (RegCheckErr(Buf, RoutineName)) return end if - ! PWaveAccMCF0 if (allocated(OutData%PWaveAccMCF0)) deallocate(OutData%PWaveAccMCF0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -646,7 +570,6 @@ subroutine SeaSt_WaveField_UnPackSeaSt_WaveFieldType(Buf, OutData) call RegUnpack(Buf, OutData%PWaveAccMCF0) if (RegCheckErr(Buf, RoutineName)) return end if - ! PWaveVel0 if (allocated(OutData%PWaveVel0)) deallocate(OutData%PWaveVel0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -661,7 +584,6 @@ subroutine SeaSt_WaveField_UnPackSeaSt_WaveFieldType(Buf, OutData) call RegUnpack(Buf, OutData%PWaveVel0) if (RegCheckErr(Buf, RoutineName)) return end if - ! WaveElev0 if (allocated(OutData%WaveElev0)) deallocate(OutData%WaveElev0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -676,7 +598,6 @@ subroutine SeaSt_WaveField_UnPackSeaSt_WaveFieldType(Buf, OutData) call RegUnpack(Buf, OutData%WaveElev0) if (RegCheckErr(Buf, RoutineName)) return end if - ! WaveElev1 if (allocated(OutData%WaveElev1)) deallocate(OutData%WaveElev1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -691,7 +612,6 @@ subroutine SeaSt_WaveField_UnPackSeaSt_WaveFieldType(Buf, OutData) call RegUnpack(Buf, OutData%WaveElev1) if (RegCheckErr(Buf, RoutineName)) return end if - ! WaveElev2 if (allocated(OutData%WaveElev2)) deallocate(OutData%WaveElev2) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -706,18 +626,13 @@ subroutine SeaSt_WaveField_UnPackSeaSt_WaveFieldType(Buf, OutData) call RegUnpack(Buf, OutData%WaveElev2) if (RegCheckErr(Buf, RoutineName)) return end if - ! SeaSt_Interp_p call SeaSt_Interp_UnpackParam(Buf, OutData%SeaSt_Interp_p) ! SeaSt_Interp_p - ! WaveStMod call RegUnpack(Buf, OutData%WaveStMod) if (RegCheckErr(Buf, RoutineName)) return - ! EffWtrDpth call RegUnpack(Buf, OutData%EffWtrDpth) if (RegCheckErr(Buf, RoutineName)) return - ! MSL2SWL call RegUnpack(Buf, OutData%MSL2SWL) if (RegCheckErr(Buf, RoutineName)) return - ! WaveElevC if (allocated(OutData%WaveElevC)) deallocate(OutData%WaveElevC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -732,7 +647,6 @@ subroutine SeaSt_WaveField_UnPackSeaSt_WaveFieldType(Buf, OutData) call RegUnpack(Buf, OutData%WaveElevC) if (RegCheckErr(Buf, RoutineName)) return end if - ! WaveElevC0 if (allocated(OutData%WaveElevC0)) deallocate(OutData%WaveElevC0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -747,7 +661,6 @@ subroutine SeaSt_WaveField_UnPackSeaSt_WaveFieldType(Buf, OutData) call RegUnpack(Buf, OutData%WaveElevC0) if (RegCheckErr(Buf, RoutineName)) return end if - ! WaveDirArr if (allocated(OutData%WaveDirArr)) deallocate(OutData%WaveDirArr) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/seastate/src/SeaState_Interp_Types.f90 b/modules/seastate/src/SeaState_Interp_Types.f90 index 17f6469154..35de0cea57 100644 --- a/modules/seastate/src/SeaState_Interp_Types.f90 +++ b/modules/seastate/src/SeaState_Interp_Types.f90 @@ -64,58 +64,42 @@ MODULE SeaState_Interp_Types END TYPE SeaSt_Interp_ParameterType ! ======================= CONTAINS - SUBROUTINE SeaSt_Interp_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SeaSt_Interp_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(SeaSt_Interp_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_Interp_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%n = SrcInitInputData%n - DstInitInputData%delta = SrcInitInputData%delta - DstInitInputData%pZero = SrcInitInputData%pZero - DstInitInputData%Z_Depth = SrcInitInputData%Z_Depth - END SUBROUTINE SeaSt_Interp_CopyInitInput - - SUBROUTINE SeaSt_Interp_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(SeaSt_Interp_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_Interp_DestroyInitInput' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE SeaSt_Interp_DestroyInitInput +subroutine SeaSt_Interp_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_Interp_InitInputType), intent(in) :: SrcInitInputData + type(SeaSt_Interp_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_Interp_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitInputData%n = SrcInitInputData%n + DstInitInputData%delta = SrcInitInputData%delta + DstInitInputData%pZero = SrcInitInputData%pZero + DstInitInputData%Z_Depth = SrcInitInputData%Z_Depth +end subroutine +subroutine SeaSt_Interp_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(SeaSt_Interp_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_Interp_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine SeaSt_Interp_PackInitInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SeaSt_Interp_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SeaSt_Interp_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return - ! n call RegPack(Buf, InData%n) if (RegCheckErr(Buf, RoutineName)) return - ! delta call RegPack(Buf, InData%delta) if (RegCheckErr(Buf, RoutineName)) return - ! pZero call RegPack(Buf, InData%pZero) if (RegCheckErr(Buf, RoutineName)) return - ! Z_Depth call RegPack(Buf, InData%Z_Depth) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -125,62 +109,48 @@ subroutine SeaSt_Interp_UnPackInitInput(Buf, OutData) type(SeaSt_Interp_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_Interp_UnPackInitInput' if (Buf%ErrStat /= ErrID_None) return - ! n call RegUnpack(Buf, OutData%n) if (RegCheckErr(Buf, RoutineName)) return - ! delta call RegUnpack(Buf, OutData%delta) if (RegCheckErr(Buf, RoutineName)) return - ! pZero call RegUnpack(Buf, OutData%pZero) if (RegCheckErr(Buf, RoutineName)) return - ! Z_Depth call RegUnpack(Buf, OutData%Z_Depth) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE SeaSt_Interp_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SeaSt_Interp_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(SeaSt_Interp_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_Interp_CopyInitOutput' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE SeaSt_Interp_CopyInitOutput - - SUBROUTINE SeaSt_Interp_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(SeaSt_Interp_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_Interp_DestroyInitOutput' - ErrStat = ErrID_None - ErrMsg = "" - - CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE SeaSt_Interp_DestroyInitOutput +subroutine SeaSt_Interp_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_Interp_InitOutputType), intent(in) :: SrcInitOutputData + type(SeaSt_Interp_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_Interp_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine SeaSt_Interp_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(SeaSt_Interp_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_Interp_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine SeaSt_Interp_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SeaSt_Interp_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SeaSt_Interp_PackInitOutput' if (Buf%ErrStat >= AbortErrLev) return - ! Ver call NWTC_Library_PackProgDesc(Buf, InData%Ver) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -190,65 +160,47 @@ subroutine SeaSt_Interp_UnPackInitOutput(Buf, OutData) type(SeaSt_Interp_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_Interp_UnPackInitOutput' if (Buf%ErrStat /= ErrID_None) return - ! Ver call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver end subroutine - SUBROUTINE SeaSt_Interp_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SeaSt_Interp_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(SeaSt_Interp_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_Interp_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%N3D = SrcMiscData%N3D - DstMiscData%N4D = SrcMiscData%N4D - DstMiscData%Indx_Lo = SrcMiscData%Indx_Lo - DstMiscData%Indx_Hi = SrcMiscData%Indx_Hi - DstMiscData%FirstWarn_Clamp = SrcMiscData%FirstWarn_Clamp - END SUBROUTINE SeaSt_Interp_CopyMisc - - SUBROUTINE SeaSt_Interp_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(SeaSt_Interp_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_Interp_DestroyMisc' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE SeaSt_Interp_DestroyMisc +subroutine SeaSt_Interp_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_Interp_MiscVarType), intent(in) :: SrcMiscData + type(SeaSt_Interp_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_Interp_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%N3D = SrcMiscData%N3D + DstMiscData%N4D = SrcMiscData%N4D + DstMiscData%Indx_Lo = SrcMiscData%Indx_Lo + DstMiscData%Indx_Hi = SrcMiscData%Indx_Hi + DstMiscData%FirstWarn_Clamp = SrcMiscData%FirstWarn_Clamp +end subroutine +subroutine SeaSt_Interp_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(SeaSt_Interp_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_Interp_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine SeaSt_Interp_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SeaSt_Interp_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'SeaSt_Interp_PackMisc' if (Buf%ErrStat >= AbortErrLev) return - ! N3D call RegPack(Buf, InData%N3D) if (RegCheckErr(Buf, RoutineName)) return - ! N4D call RegPack(Buf, InData%N4D) if (RegCheckErr(Buf, RoutineName)) return - ! Indx_Lo call RegPack(Buf, InData%Indx_Lo) if (RegCheckErr(Buf, RoutineName)) return - ! Indx_Hi call RegPack(Buf, InData%Indx_Hi) if (RegCheckErr(Buf, RoutineName)) return - ! FirstWarn_Clamp call RegPack(Buf, InData%FirstWarn_Clamp) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -258,74 +210,53 @@ subroutine SeaSt_Interp_UnPackMisc(Buf, OutData) type(SeaSt_Interp_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_Interp_UnPackMisc' if (Buf%ErrStat /= ErrID_None) return - ! N3D call RegUnpack(Buf, OutData%N3D) if (RegCheckErr(Buf, RoutineName)) return - ! N4D call RegUnpack(Buf, OutData%N4D) if (RegCheckErr(Buf, RoutineName)) return - ! Indx_Lo call RegUnpack(Buf, OutData%Indx_Lo) if (RegCheckErr(Buf, RoutineName)) return - ! Indx_Hi call RegUnpack(Buf, OutData%Indx_Hi) if (RegCheckErr(Buf, RoutineName)) return - ! FirstWarn_Clamp call RegUnpack(Buf, OutData%FirstWarn_Clamp) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE SeaSt_Interp_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SeaSt_Interp_ParameterType), INTENT(IN) :: SrcParamData - TYPE(SeaSt_Interp_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_Interp_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%n = SrcParamData%n - DstParamData%delta = SrcParamData%delta - DstParamData%pZero = SrcParamData%pZero - DstParamData%Z_Depth = SrcParamData%Z_Depth - END SUBROUTINE SeaSt_Interp_CopyParam - - SUBROUTINE SeaSt_Interp_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(SeaSt_Interp_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_Interp_DestroyParam' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE SeaSt_Interp_DestroyParam +subroutine SeaSt_Interp_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_Interp_ParameterType), intent(in) :: SrcParamData + type(SeaSt_Interp_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_Interp_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%n = SrcParamData%n + DstParamData%delta = SrcParamData%delta + DstParamData%pZero = SrcParamData%pZero + DstParamData%Z_Depth = SrcParamData%Z_Depth +end subroutine +subroutine SeaSt_Interp_DestroyParam(ParamData, ErrStat, ErrMsg) + type(SeaSt_Interp_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_Interp_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine SeaSt_Interp_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SeaSt_Interp_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'SeaSt_Interp_PackParam' if (Buf%ErrStat >= AbortErrLev) return - ! n call RegPack(Buf, InData%n) if (RegCheckErr(Buf, RoutineName)) return - ! delta call RegPack(Buf, InData%delta) if (RegCheckErr(Buf, RoutineName)) return - ! pZero call RegPack(Buf, InData%pZero) if (RegCheckErr(Buf, RoutineName)) return - ! Z_Depth call RegPack(Buf, InData%Z_Depth) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -335,16 +266,12 @@ subroutine SeaSt_Interp_UnPackParam(Buf, OutData) type(SeaSt_Interp_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_Interp_UnPackParam' if (Buf%ErrStat /= ErrID_None) return - ! n call RegUnpack(Buf, OutData%n) if (RegCheckErr(Buf, RoutineName)) return - ! delta call RegUnpack(Buf, OutData%delta) if (RegCheckErr(Buf, RoutineName)) return - ! pZero call RegUnpack(Buf, OutData%pZero) if (RegCheckErr(Buf, RoutineName)) return - ! Z_Depth call RegUnpack(Buf, OutData%Z_Depth) if (RegCheckErr(Buf, RoutineName)) return end subroutine diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index 7258f37f9d..83946550cf 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -220,266 +220,239 @@ MODULE SeaState_Types END TYPE SeaSt_OutputType ! ======================= CONTAINS - SUBROUTINE SeaSt_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SeaSt_InputFile), INTENT(IN) :: SrcInputFileData - TYPE(SeaSt_InputFile), INTENT(INOUT) :: DstInputFileData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_CopyInputFile' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInputFileData%EchoFlag = SrcInputFileData%EchoFlag - DstInputFileData%MSL2SWL = SrcInputFileData%MSL2SWL - DstInputFileData%X_HalfWidth = SrcInputFileData%X_HalfWidth - DstInputFileData%Y_HalfWidth = SrcInputFileData%Y_HalfWidth - DstInputFileData%Z_Depth = SrcInputFileData%Z_Depth - DstInputFileData%NX = SrcInputFileData%NX - DstInputFileData%NY = SrcInputFileData%NY - DstInputFileData%NZ = SrcInputFileData%NZ - CALL Waves_CopyInitInput( SrcInputFileData%Waves, DstInputFileData%Waves, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Waves2_CopyInitInput( SrcInputFileData%Waves2, DstInputFileData%Waves2, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL Current_CopyInitInput( SrcInputFileData%Current, DstInputFileData%Current, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInputFileData%Echo = SrcInputFileData%Echo - DstInputFileData%NWaveElev = SrcInputFileData%NWaveElev -IF (ALLOCATED(SrcInputFileData%WaveElevxi)) THEN - i1_l = LBOUND(SrcInputFileData%WaveElevxi,1) - i1_u = UBOUND(SrcInputFileData%WaveElevxi,1) - IF (.NOT. ALLOCATED(DstInputFileData%WaveElevxi)) THEN - ALLOCATE(DstInputFileData%WaveElevxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WaveElevxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%WaveElevxi = SrcInputFileData%WaveElevxi -ENDIF -IF (ALLOCATED(SrcInputFileData%WaveElevyi)) THEN - i1_l = LBOUND(SrcInputFileData%WaveElevyi,1) - i1_u = UBOUND(SrcInputFileData%WaveElevyi,1) - IF (.NOT. ALLOCATED(DstInputFileData%WaveElevyi)) THEN - ALLOCATE(DstInputFileData%WaveElevyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WaveElevyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%WaveElevyi = SrcInputFileData%WaveElevyi -ENDIF - DstInputFileData%NWaveKin = SrcInputFileData%NWaveKin -IF (ALLOCATED(SrcInputFileData%WaveKinxi)) THEN - i1_l = LBOUND(SrcInputFileData%WaveKinxi,1) - i1_u = UBOUND(SrcInputFileData%WaveKinxi,1) - IF (.NOT. ALLOCATED(DstInputFileData%WaveKinxi)) THEN - ALLOCATE(DstInputFileData%WaveKinxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WaveKinxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%WaveKinxi = SrcInputFileData%WaveKinxi -ENDIF -IF (ALLOCATED(SrcInputFileData%WaveKinyi)) THEN - i1_l = LBOUND(SrcInputFileData%WaveKinyi,1) - i1_u = UBOUND(SrcInputFileData%WaveKinyi,1) - IF (.NOT. ALLOCATED(DstInputFileData%WaveKinyi)) THEN - ALLOCATE(DstInputFileData%WaveKinyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WaveKinyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%WaveKinyi = SrcInputFileData%WaveKinyi -ENDIF -IF (ALLOCATED(SrcInputFileData%WaveKinzi)) THEN - i1_l = LBOUND(SrcInputFileData%WaveKinzi,1) - i1_u = UBOUND(SrcInputFileData%WaveKinzi,1) - IF (.NOT. ALLOCATED(DstInputFileData%WaveKinzi)) THEN - ALLOCATE(DstInputFileData%WaveKinzi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WaveKinzi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%WaveKinzi = SrcInputFileData%WaveKinzi -ENDIF - DstInputFileData%OutSwtch = SrcInputFileData%OutSwtch - DstInputFileData%OutAll = SrcInputFileData%OutAll - DstInputFileData%NumOuts = SrcInputFileData%NumOuts -IF (ALLOCATED(SrcInputFileData%OutList)) THEN - i1_l = LBOUND(SrcInputFileData%OutList,1) - i1_u = UBOUND(SrcInputFileData%OutList,1) - IF (.NOT. ALLOCATED(DstInputFileData%OutList)) THEN - ALLOCATE(DstInputFileData%OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%OutList = SrcInputFileData%OutList -ENDIF - DstInputFileData%SeaStSum = SrcInputFileData%SeaStSum - DstInputFileData%OutFmt = SrcInputFileData%OutFmt - DstInputFileData%OutSFmt = SrcInputFileData%OutSFmt - END SUBROUTINE SeaSt_CopyInputFile - - SUBROUTINE SeaSt_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) - TYPE(SeaSt_InputFile), INTENT(INOUT) :: InputFileData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_DestroyInputFile' - - ErrStat = ErrID_None - ErrMsg = "" - CALL Waves_DestroyInitInput( InputFileData%Waves, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Waves2_DestroyInitInput( InputFileData%Waves2, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Current_DestroyInitInput( InputFileData%Current, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InputFileData%WaveElevxi)) THEN - DEALLOCATE(InputFileData%WaveElevxi) -ENDIF -IF (ALLOCATED(InputFileData%WaveElevyi)) THEN - DEALLOCATE(InputFileData%WaveElevyi) -ENDIF -IF (ALLOCATED(InputFileData%WaveKinxi)) THEN - DEALLOCATE(InputFileData%WaveKinxi) -ENDIF -IF (ALLOCATED(InputFileData%WaveKinyi)) THEN - DEALLOCATE(InputFileData%WaveKinyi) -ENDIF -IF (ALLOCATED(InputFileData%WaveKinzi)) THEN - DEALLOCATE(InputFileData%WaveKinzi) -ENDIF -IF (ALLOCATED(InputFileData%OutList)) THEN - DEALLOCATE(InputFileData%OutList) -ENDIF - END SUBROUTINE SeaSt_DestroyInputFile +subroutine SeaSt_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_InputFile), intent(in) :: SrcInputFileData + type(SeaSt_InputFile), intent(inout) :: DstInputFileData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_CopyInputFile' + ErrStat = ErrID_None + ErrMsg = '' + DstInputFileData%EchoFlag = SrcInputFileData%EchoFlag + DstInputFileData%MSL2SWL = SrcInputFileData%MSL2SWL + DstInputFileData%X_HalfWidth = SrcInputFileData%X_HalfWidth + DstInputFileData%Y_HalfWidth = SrcInputFileData%Y_HalfWidth + DstInputFileData%Z_Depth = SrcInputFileData%Z_Depth + DstInputFileData%NX = SrcInputFileData%NX + DstInputFileData%NY = SrcInputFileData%NY + DstInputFileData%NZ = SrcInputFileData%NZ + call Waves_CopyInitInput(SrcInputFileData%Waves, DstInputFileData%Waves, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Waves2_CopyInitInput(SrcInputFileData%Waves2, DstInputFileData%Waves2, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call Current_CopyInitInput(SrcInputFileData%Current, DstInputFileData%Current, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInputFileData%Echo = SrcInputFileData%Echo + DstInputFileData%NWaveElev = SrcInputFileData%NWaveElev + if (allocated(SrcInputFileData%WaveElevxi)) then + LB(1:1) = lbound(SrcInputFileData%WaveElevxi) + UB(1:1) = ubound(SrcInputFileData%WaveElevxi) + if (.not. allocated(DstInputFileData%WaveElevxi)) then + allocate(DstInputFileData%WaveElevxi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WaveElevxi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%WaveElevxi = SrcInputFileData%WaveElevxi + else if (allocated(DstInputFileData%WaveElevxi)) then + deallocate(DstInputFileData%WaveElevxi) + end if + if (allocated(SrcInputFileData%WaveElevyi)) then + LB(1:1) = lbound(SrcInputFileData%WaveElevyi) + UB(1:1) = ubound(SrcInputFileData%WaveElevyi) + if (.not. allocated(DstInputFileData%WaveElevyi)) then + allocate(DstInputFileData%WaveElevyi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WaveElevyi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%WaveElevyi = SrcInputFileData%WaveElevyi + else if (allocated(DstInputFileData%WaveElevyi)) then + deallocate(DstInputFileData%WaveElevyi) + end if + DstInputFileData%NWaveKin = SrcInputFileData%NWaveKin + if (allocated(SrcInputFileData%WaveKinxi)) then + LB(1:1) = lbound(SrcInputFileData%WaveKinxi) + UB(1:1) = ubound(SrcInputFileData%WaveKinxi) + if (.not. allocated(DstInputFileData%WaveKinxi)) then + allocate(DstInputFileData%WaveKinxi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WaveKinxi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%WaveKinxi = SrcInputFileData%WaveKinxi + else if (allocated(DstInputFileData%WaveKinxi)) then + deallocate(DstInputFileData%WaveKinxi) + end if + if (allocated(SrcInputFileData%WaveKinyi)) then + LB(1:1) = lbound(SrcInputFileData%WaveKinyi) + UB(1:1) = ubound(SrcInputFileData%WaveKinyi) + if (.not. allocated(DstInputFileData%WaveKinyi)) then + allocate(DstInputFileData%WaveKinyi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WaveKinyi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%WaveKinyi = SrcInputFileData%WaveKinyi + else if (allocated(DstInputFileData%WaveKinyi)) then + deallocate(DstInputFileData%WaveKinyi) + end if + if (allocated(SrcInputFileData%WaveKinzi)) then + LB(1:1) = lbound(SrcInputFileData%WaveKinzi) + UB(1:1) = ubound(SrcInputFileData%WaveKinzi) + if (.not. allocated(DstInputFileData%WaveKinzi)) then + allocate(DstInputFileData%WaveKinzi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%WaveKinzi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%WaveKinzi = SrcInputFileData%WaveKinzi + else if (allocated(DstInputFileData%WaveKinzi)) then + deallocate(DstInputFileData%WaveKinzi) + end if + DstInputFileData%OutSwtch = SrcInputFileData%OutSwtch + DstInputFileData%OutAll = SrcInputFileData%OutAll + DstInputFileData%NumOuts = SrcInputFileData%NumOuts + if (allocated(SrcInputFileData%OutList)) then + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) + if (.not. allocated(DstInputFileData%OutList)) then + allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%OutList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%OutList = SrcInputFileData%OutList + else if (allocated(DstInputFileData%OutList)) then + deallocate(DstInputFileData%OutList) + end if + DstInputFileData%SeaStSum = SrcInputFileData%SeaStSum + DstInputFileData%OutFmt = SrcInputFileData%OutFmt + DstInputFileData%OutSFmt = SrcInputFileData%OutSFmt +end subroutine +subroutine SeaSt_DestroyInputFile(InputFileData, ErrStat, ErrMsg) + type(SeaSt_InputFile), intent(inout) :: InputFileData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_DestroyInputFile' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputFileData%WaveElevxi)) then + deallocate(InputFileData%WaveElevxi) + end if + if (allocated(InputFileData%WaveElevyi)) then + deallocate(InputFileData%WaveElevyi) + end if + if (allocated(InputFileData%WaveKinxi)) then + deallocate(InputFileData%WaveKinxi) + end if + if (allocated(InputFileData%WaveKinyi)) then + deallocate(InputFileData%WaveKinyi) + end if + if (allocated(InputFileData%WaveKinzi)) then + deallocate(InputFileData%WaveKinzi) + end if + if (allocated(InputFileData%OutList)) then + deallocate(InputFileData%OutList) + end if +end subroutine subroutine SeaSt_PackInputFile(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SeaSt_InputFile), intent(in) :: InData character(*), parameter :: RoutineName = 'SeaSt_PackInputFile' if (Buf%ErrStat >= AbortErrLev) return - ! EchoFlag call RegPack(Buf, InData%EchoFlag) if (RegCheckErr(Buf, RoutineName)) return - ! MSL2SWL call RegPack(Buf, InData%MSL2SWL) if (RegCheckErr(Buf, RoutineName)) return - ! X_HalfWidth call RegPack(Buf, InData%X_HalfWidth) if (RegCheckErr(Buf, RoutineName)) return - ! Y_HalfWidth call RegPack(Buf, InData%Y_HalfWidth) if (RegCheckErr(Buf, RoutineName)) return - ! Z_Depth call RegPack(Buf, InData%Z_Depth) if (RegCheckErr(Buf, RoutineName)) return - ! NX call RegPack(Buf, InData%NX) if (RegCheckErr(Buf, RoutineName)) return - ! NY call RegPack(Buf, InData%NY) if (RegCheckErr(Buf, RoutineName)) return - ! NZ call RegPack(Buf, InData%NZ) if (RegCheckErr(Buf, RoutineName)) return - ! Waves call Waves_PackInitInput(Buf, InData%Waves) if (RegCheckErr(Buf, RoutineName)) return - ! Waves2 call Waves2_PackInitInput(Buf, InData%Waves2) if (RegCheckErr(Buf, RoutineName)) return - ! Current call Current_PackInitInput(Buf, InData%Current) if (RegCheckErr(Buf, RoutineName)) return - ! Echo call RegPack(Buf, InData%Echo) if (RegCheckErr(Buf, RoutineName)) return - ! NWaveElev call RegPack(Buf, InData%NWaveElev) if (RegCheckErr(Buf, RoutineName)) return - ! WaveElevxi call RegPack(Buf, allocated(InData%WaveElevxi)) if (allocated(InData%WaveElevxi)) then call RegPackBounds(Buf, 1, lbound(InData%WaveElevxi), ubound(InData%WaveElevxi)) call RegPack(Buf, InData%WaveElevxi) end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveElevyi call RegPack(Buf, allocated(InData%WaveElevyi)) if (allocated(InData%WaveElevyi)) then call RegPackBounds(Buf, 1, lbound(InData%WaveElevyi), ubound(InData%WaveElevyi)) call RegPack(Buf, InData%WaveElevyi) end if if (RegCheckErr(Buf, RoutineName)) return - ! NWaveKin call RegPack(Buf, InData%NWaveKin) if (RegCheckErr(Buf, RoutineName)) return - ! WaveKinxi call RegPack(Buf, allocated(InData%WaveKinxi)) if (allocated(InData%WaveKinxi)) then call RegPackBounds(Buf, 1, lbound(InData%WaveKinxi), ubound(InData%WaveKinxi)) call RegPack(Buf, InData%WaveKinxi) end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveKinyi call RegPack(Buf, allocated(InData%WaveKinyi)) if (allocated(InData%WaveKinyi)) then call RegPackBounds(Buf, 1, lbound(InData%WaveKinyi), ubound(InData%WaveKinyi)) call RegPack(Buf, InData%WaveKinyi) end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveKinzi call RegPack(Buf, allocated(InData%WaveKinzi)) if (allocated(InData%WaveKinzi)) then call RegPackBounds(Buf, 1, lbound(InData%WaveKinzi), ubound(InData%WaveKinzi)) call RegPack(Buf, InData%WaveKinzi) end if if (RegCheckErr(Buf, RoutineName)) return - ! OutSwtch call RegPack(Buf, InData%OutSwtch) if (RegCheckErr(Buf, RoutineName)) return - ! OutAll call RegPack(Buf, InData%OutAll) if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegPack(Buf, InData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! OutList call RegPack(Buf, allocated(InData%OutList)) if (allocated(InData%OutList)) then call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) call RegPack(Buf, InData%OutList) end if if (RegCheckErr(Buf, RoutineName)) return - ! SeaStSum call RegPack(Buf, InData%SeaStSum) if (RegCheckErr(Buf, RoutineName)) return - ! OutFmt call RegPack(Buf, InData%OutFmt) if (RegCheckErr(Buf, RoutineName)) return - ! OutSFmt call RegPack(Buf, InData%OutSFmt) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -492,43 +465,29 @@ subroutine SeaSt_UnPackInputFile(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! EchoFlag call RegUnpack(Buf, OutData%EchoFlag) if (RegCheckErr(Buf, RoutineName)) return - ! MSL2SWL call RegUnpack(Buf, OutData%MSL2SWL) if (RegCheckErr(Buf, RoutineName)) return - ! X_HalfWidth call RegUnpack(Buf, OutData%X_HalfWidth) if (RegCheckErr(Buf, RoutineName)) return - ! Y_HalfWidth call RegUnpack(Buf, OutData%Y_HalfWidth) if (RegCheckErr(Buf, RoutineName)) return - ! Z_Depth call RegUnpack(Buf, OutData%Z_Depth) if (RegCheckErr(Buf, RoutineName)) return - ! NX call RegUnpack(Buf, OutData%NX) if (RegCheckErr(Buf, RoutineName)) return - ! NY call RegUnpack(Buf, OutData%NY) if (RegCheckErr(Buf, RoutineName)) return - ! NZ call RegUnpack(Buf, OutData%NZ) if (RegCheckErr(Buf, RoutineName)) return - ! Waves call Waves_UnpackInitInput(Buf, OutData%Waves) ! Waves - ! Waves2 call Waves2_UnpackInitInput(Buf, OutData%Waves2) ! Waves2 - ! Current call Current_UnpackInitInput(Buf, OutData%Current) ! Current - ! Echo call RegUnpack(Buf, OutData%Echo) if (RegCheckErr(Buf, RoutineName)) return - ! NWaveElev call RegUnpack(Buf, OutData%NWaveElev) if (RegCheckErr(Buf, RoutineName)) return - ! WaveElevxi if (allocated(OutData%WaveElevxi)) deallocate(OutData%WaveElevxi) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -543,7 +502,6 @@ subroutine SeaSt_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%WaveElevxi) if (RegCheckErr(Buf, RoutineName)) return end if - ! WaveElevyi if (allocated(OutData%WaveElevyi)) deallocate(OutData%WaveElevyi) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -558,10 +516,8 @@ subroutine SeaSt_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%WaveElevyi) if (RegCheckErr(Buf, RoutineName)) return end if - ! NWaveKin call RegUnpack(Buf, OutData%NWaveKin) if (RegCheckErr(Buf, RoutineName)) return - ! WaveKinxi if (allocated(OutData%WaveKinxi)) deallocate(OutData%WaveKinxi) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -576,7 +532,6 @@ subroutine SeaSt_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%WaveKinxi) if (RegCheckErr(Buf, RoutineName)) return end if - ! WaveKinyi if (allocated(OutData%WaveKinyi)) deallocate(OutData%WaveKinyi) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -591,7 +546,6 @@ subroutine SeaSt_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%WaveKinyi) if (RegCheckErr(Buf, RoutineName)) return end if - ! WaveKinzi if (allocated(OutData%WaveKinzi)) deallocate(OutData%WaveKinzi) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -606,16 +560,12 @@ subroutine SeaSt_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%WaveKinzi) if (RegCheckErr(Buf, RoutineName)) return end if - ! OutSwtch call RegUnpack(Buf, OutData%OutSwtch) if (RegCheckErr(Buf, RoutineName)) return - ! OutAll call RegUnpack(Buf, OutData%OutAll) if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegUnpack(Buf, OutData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! OutList if (allocated(OutData%OutList)) deallocate(OutData%OutList) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -630,141 +580,112 @@ subroutine SeaSt_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%OutList) if (RegCheckErr(Buf, RoutineName)) return end if - ! SeaStSum call RegUnpack(Buf, OutData%SeaStSum) if (RegCheckErr(Buf, RoutineName)) return - ! OutFmt call RegUnpack(Buf, OutData%OutFmt) if (RegCheckErr(Buf, RoutineName)) return - ! OutSFmt call RegUnpack(Buf, OutData%OutSFmt) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE SeaSt_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SeaSt_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(SeaSt_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFile = SrcInitInputData%InputFile - DstInitInputData%UseInputFile = SrcInitInputData%UseInputFile - CALL NWTC_Library_Copyfileinfotype( SrcInitInputData%PassedFileData, DstInitInputData%PassedFileData, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitInputData%OutRootName = SrcInitInputData%OutRootName - DstInitInputData%Gravity = SrcInitInputData%Gravity - DstInitInputData%defWtrDens = SrcInitInputData%defWtrDens - DstInitInputData%defWtrDpth = SrcInitInputData%defWtrDpth - DstInitInputData%defMSL2SWL = SrcInitInputData%defMSL2SWL - DstInitInputData%TMax = SrcInitInputData%TMax -IF (ALLOCATED(SrcInitInputData%WaveElevXY)) THEN - i1_l = LBOUND(SrcInitInputData%WaveElevXY,1) - i1_u = UBOUND(SrcInitInputData%WaveElevXY,1) - i2_l = LBOUND(SrcInitInputData%WaveElevXY,2) - i2_u = UBOUND(SrcInitInputData%WaveElevXY,2) - IF (.NOT. ALLOCATED(DstInitInputData%WaveElevXY)) THEN - ALLOCATE(DstInitInputData%WaveElevXY(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElevXY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveElevXY = SrcInitInputData%WaveElevXY -ENDIF - DstInitInputData%WaveFieldMod = SrcInitInputData%WaveFieldMod - DstInitInputData%PtfmLocationX = SrcInitInputData%PtfmLocationX - DstInitInputData%PtfmLocationY = SrcInitInputData%PtfmLocationY - DstInitInputData%WrWvKinMod = SrcInitInputData%WrWvKinMod - DstInitInputData%HasIce = SrcInitInputData%HasIce - DstInitInputData%Linearize = SrcInitInputData%Linearize - END SUBROUTINE SeaSt_CopyInitInput - - SUBROUTINE SeaSt_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(SeaSt_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - CALL NWTC_Library_DestroyFileInfoType( InitInputData%PassedFileData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitInputData%WaveElevXY)) THEN - DEALLOCATE(InitInputData%WaveElevXY) -ENDIF - END SUBROUTINE SeaSt_DestroyInitInput +subroutine SeaSt_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_InitInputType), intent(in) :: SrcInitInputData + type(SeaSt_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%UseInputFile = SrcInitInputData%UseInputFile + call NWTC_Library_CopyFileInfoType(SrcInitInputData%PassedFileData, DstInitInputData%PassedFileData, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitInputData%OutRootName = SrcInitInputData%OutRootName + DstInitInputData%Gravity = SrcInitInputData%Gravity + DstInitInputData%defWtrDens = SrcInitInputData%defWtrDens + DstInitInputData%defWtrDpth = SrcInitInputData%defWtrDpth + DstInitInputData%defMSL2SWL = SrcInitInputData%defMSL2SWL + DstInitInputData%TMax = SrcInitInputData%TMax + if (allocated(SrcInitInputData%WaveElevXY)) then + LB(1:2) = lbound(SrcInitInputData%WaveElevXY) + UB(1:2) = ubound(SrcInitInputData%WaveElevXY) + if (.not. allocated(DstInitInputData%WaveElevXY)) then + allocate(DstInitInputData%WaveElevXY(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElevXY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%WaveElevXY = SrcInitInputData%WaveElevXY + else if (allocated(DstInitInputData%WaveElevXY)) then + deallocate(DstInitInputData%WaveElevXY) + end if + DstInitInputData%WaveFieldMod = SrcInitInputData%WaveFieldMod + DstInitInputData%PtfmLocationX = SrcInitInputData%PtfmLocationX + DstInitInputData%PtfmLocationY = SrcInitInputData%PtfmLocationY + DstInitInputData%WrWvKinMod = SrcInitInputData%WrWvKinMod + DstInitInputData%HasIce = SrcInitInputData%HasIce + DstInitInputData%Linearize = SrcInitInputData%Linearize +end subroutine +subroutine SeaSt_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(SeaSt_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitInputData%WaveElevXY)) then + deallocate(InitInputData%WaveElevXY) + end if +end subroutine subroutine SeaSt_PackInitInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SeaSt_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SeaSt_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return - ! InputFile call RegPack(Buf, InData%InputFile) if (RegCheckErr(Buf, RoutineName)) return - ! UseInputFile call RegPack(Buf, InData%UseInputFile) if (RegCheckErr(Buf, RoutineName)) return - ! PassedFileData call NWTC_Library_PackFileInfoType(Buf, InData%PassedFileData) if (RegCheckErr(Buf, RoutineName)) return - ! OutRootName call RegPack(Buf, InData%OutRootName) if (RegCheckErr(Buf, RoutineName)) return - ! Gravity call RegPack(Buf, InData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - ! defWtrDens call RegPack(Buf, InData%defWtrDens) if (RegCheckErr(Buf, RoutineName)) return - ! defWtrDpth call RegPack(Buf, InData%defWtrDpth) if (RegCheckErr(Buf, RoutineName)) return - ! defMSL2SWL call RegPack(Buf, InData%defMSL2SWL) if (RegCheckErr(Buf, RoutineName)) return - ! TMax call RegPack(Buf, InData%TMax) if (RegCheckErr(Buf, RoutineName)) return - ! WaveElevXY call RegPack(Buf, allocated(InData%WaveElevXY)) if (allocated(InData%WaveElevXY)) then call RegPackBounds(Buf, 2, lbound(InData%WaveElevXY), ubound(InData%WaveElevXY)) call RegPack(Buf, InData%WaveElevXY) end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveFieldMod call RegPack(Buf, InData%WaveFieldMod) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmLocationX call RegPack(Buf, InData%PtfmLocationX) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmLocationY call RegPack(Buf, InData%PtfmLocationY) if (RegCheckErr(Buf, RoutineName)) return - ! WrWvKinMod call RegPack(Buf, InData%WrWvKinMod) if (RegCheckErr(Buf, RoutineName)) return - ! HasIce call RegPack(Buf, InData%HasIce) if (RegCheckErr(Buf, RoutineName)) return - ! Linearize call RegPack(Buf, InData%Linearize) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -777,33 +698,23 @@ subroutine SeaSt_UnPackInitInput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! InputFile call RegUnpack(Buf, OutData%InputFile) if (RegCheckErr(Buf, RoutineName)) return - ! UseInputFile call RegUnpack(Buf, OutData%UseInputFile) if (RegCheckErr(Buf, RoutineName)) return - ! PassedFileData call NWTC_Library_UnpackFileInfoType(Buf, OutData%PassedFileData) ! PassedFileData - ! OutRootName call RegUnpack(Buf, OutData%OutRootName) if (RegCheckErr(Buf, RoutineName)) return - ! Gravity call RegUnpack(Buf, OutData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - ! defWtrDens call RegUnpack(Buf, OutData%defWtrDens) if (RegCheckErr(Buf, RoutineName)) return - ! defWtrDpth call RegUnpack(Buf, OutData%defWtrDpth) if (RegCheckErr(Buf, RoutineName)) return - ! defMSL2SWL call RegUnpack(Buf, OutData%defMSL2SWL) if (RegCheckErr(Buf, RoutineName)) return - ! TMax call RegUnpack(Buf, OutData%TMax) if (RegCheckErr(Buf, RoutineName)) return - ! WaveElevXY if (allocated(OutData%WaveElevXY)) deallocate(OutData%WaveElevXY) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -818,172 +729,155 @@ subroutine SeaSt_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%WaveElevXY) if (RegCheckErr(Buf, RoutineName)) return end if - ! WaveFieldMod call RegUnpack(Buf, OutData%WaveFieldMod) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmLocationX call RegUnpack(Buf, OutData%PtfmLocationX) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmLocationY call RegUnpack(Buf, OutData%PtfmLocationY) if (RegCheckErr(Buf, RoutineName)) return - ! WrWvKinMod call RegUnpack(Buf, OutData%WrWvKinMod) if (RegCheckErr(Buf, RoutineName)) return - ! HasIce call RegUnpack(Buf, OutData%HasIce) if (RegCheckErr(Buf, RoutineName)) return - ! Linearize call RegUnpack(Buf, OutData%Linearize) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE SeaSt_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SeaSt_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(SeaSt_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_CopyInitOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInitOutputData%WriteOutputHdr)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputHdr,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputHdr,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputHdr)) THEN - ALLOCATE(DstInitOutputData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr -ENDIF -IF (ALLOCATED(SrcInitOutputData%WriteOutputUnt)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputUnt,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputUnt,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputUnt)) THEN - ALLOCATE(DstInitOutputData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt -ENDIF - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitOutputData%WtrDens = SrcInitOutputData%WtrDens - DstInitOutputData%WtrDpth = SrcInitOutputData%WtrDpth - DstInitOutputData%MSL2SWL = SrcInitOutputData%MSL2SWL - DstInitOutputData%WaveElevC0 => SrcInitOutputData%WaveElevC0 - DstInitOutputData%WaveElevC => SrcInitOutputData%WaveElevC - DstInitOutputData%WaveDirArr => SrcInitOutputData%WaveDirArr - DstInitOutputData%WaveDirMin = SrcInitOutputData%WaveDirMin - DstInitOutputData%WaveDirMax = SrcInitOutputData%WaveDirMax - DstInitOutputData%WaveDir = SrcInitOutputData%WaveDir - DstInitOutputData%WaveMultiDir = SrcInitOutputData%WaveMultiDir - DstInitOutputData%WaveDOmega = SrcInitOutputData%WaveDOmega - DstInitOutputData%WaveDynP => SrcInitOutputData%WaveDynP - DstInitOutputData%WaveAcc => SrcInitOutputData%WaveAcc - DstInitOutputData%WaveAccMCF => SrcInitOutputData%WaveAccMCF - DstInitOutputData%WaveVel => SrcInitOutputData%WaveVel - DstInitOutputData%PWaveDynP0 => SrcInitOutputData%PWaveDynP0 - DstInitOutputData%PWaveAcc0 => SrcInitOutputData%PWaveAcc0 - DstInitOutputData%PWaveAccMCF0 => SrcInitOutputData%PWaveAccMCF0 - DstInitOutputData%PWaveVel0 => SrcInitOutputData%PWaveVel0 - DstInitOutputData%WaveElev1 => SrcInitOutputData%WaveElev1 - DstInitOutputData%WaveElev2 => SrcInitOutputData%WaveElev2 - DstInitOutputData%WaveElev0 => SrcInitOutputData%WaveElev0 - DstInitOutputData%WaveTime => SrcInitOutputData%WaveTime - DstInitOutputData%RhoXg = SrcInitOutputData%RhoXg - DstInitOutputData%NStepWave = SrcInitOutputData%NStepWave - DstInitOutputData%NStepWave2 = SrcInitOutputData%NStepWave2 - DstInitOutputData%WaveMod = SrcInitOutputData%WaveMod - DstInitOutputData%WaveStMod = SrcInitOutputData%WaveStMod - DstInitOutputData%WaveDirMod = SrcInitOutputData%WaveDirMod - DstInitOutputData%WvLowCOff = SrcInitOutputData%WvLowCOff - DstInitOutputData%WvHiCOff = SrcInitOutputData%WvHiCOff - DstInitOutputData%WvLowCOffD = SrcInitOutputData%WvLowCOffD - DstInitOutputData%WvHiCOffD = SrcInitOutputData%WvHiCOffD - DstInitOutputData%WvLowCOffS = SrcInitOutputData%WvLowCOffS - DstInitOutputData%WvHiCOffS = SrcInitOutputData%WvHiCOffS - DstInitOutputData%InvalidWithSSExctn = SrcInitOutputData%InvalidWithSSExctn - CALL SeaSt_Interp_CopyParam( SrcInitOutputData%SeaSt_Interp_p, DstInitOutputData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitOutputData%MCFD = SrcInitOutputData%MCFD -IF (ALLOCATED(SrcInitOutputData%WaveElevSeries)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveElevSeries,1) - i1_u = UBOUND(SrcInitOutputData%WaveElevSeries,1) - i2_l = LBOUND(SrcInitOutputData%WaveElevSeries,2) - i2_u = UBOUND(SrcInitOutputData%WaveElevSeries,2) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveElevSeries)) THEN - ALLOCATE(DstInitOutputData%WaveElevSeries(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveElevSeries.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveElevSeries = SrcInitOutputData%WaveElevSeries -ENDIF - DstInitOutputData%WaveField => SrcInitOutputData%WaveField - END SUBROUTINE SeaSt_CopyInitOutput - - SUBROUTINE SeaSt_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(SeaSt_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF - CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -NULLIFY(InitOutputData%WaveElevC0) -NULLIFY(InitOutputData%WaveElevC) -NULLIFY(InitOutputData%WaveDirArr) -NULLIFY(InitOutputData%WaveDynP) -NULLIFY(InitOutputData%WaveAcc) -NULLIFY(InitOutputData%WaveAccMCF) -NULLIFY(InitOutputData%WaveVel) -NULLIFY(InitOutputData%PWaveDynP0) -NULLIFY(InitOutputData%PWaveAcc0) -NULLIFY(InitOutputData%PWaveAccMCF0) -NULLIFY(InitOutputData%PWaveVel0) -NULLIFY(InitOutputData%WaveElev1) -NULLIFY(InitOutputData%WaveElev2) -NULLIFY(InitOutputData%WaveElev0) -NULLIFY(InitOutputData%WaveTime) - CALL SeaSt_Interp_DestroyParam( InitOutputData%SeaSt_Interp_p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitOutputData%WaveElevSeries)) THEN - DEALLOCATE(InitOutputData%WaveElevSeries) -ENDIF -NULLIFY(InitOutputData%WaveField) - END SUBROUTINE SeaSt_DestroyInitOutput +subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_InitOutputType), intent(in) :: SrcInitOutputData + type(SeaSt_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr + else if (allocated(DstInitOutputData%WriteOutputHdr)) then + deallocate(DstInitOutputData%WriteOutputHdr) + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt + else if (allocated(DstInitOutputData%WriteOutputUnt)) then + deallocate(DstInitOutputData%WriteOutputUnt) + end if + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitOutputData%WtrDens = SrcInitOutputData%WtrDens + DstInitOutputData%WtrDpth = SrcInitOutputData%WtrDpth + DstInitOutputData%MSL2SWL = SrcInitOutputData%MSL2SWL + DstInitOutputData%WaveElevC0 => SrcInitOutputData%WaveElevC0 + DstInitOutputData%WaveElevC => SrcInitOutputData%WaveElevC + DstInitOutputData%WaveDirArr => SrcInitOutputData%WaveDirArr + DstInitOutputData%WaveDirMin = SrcInitOutputData%WaveDirMin + DstInitOutputData%WaveDirMax = SrcInitOutputData%WaveDirMax + DstInitOutputData%WaveDir = SrcInitOutputData%WaveDir + DstInitOutputData%WaveMultiDir = SrcInitOutputData%WaveMultiDir + DstInitOutputData%WaveDOmega = SrcInitOutputData%WaveDOmega + DstInitOutputData%WaveDynP => SrcInitOutputData%WaveDynP + DstInitOutputData%WaveAcc => SrcInitOutputData%WaveAcc + DstInitOutputData%WaveAccMCF => SrcInitOutputData%WaveAccMCF + DstInitOutputData%WaveVel => SrcInitOutputData%WaveVel + DstInitOutputData%PWaveDynP0 => SrcInitOutputData%PWaveDynP0 + DstInitOutputData%PWaveAcc0 => SrcInitOutputData%PWaveAcc0 + DstInitOutputData%PWaveAccMCF0 => SrcInitOutputData%PWaveAccMCF0 + DstInitOutputData%PWaveVel0 => SrcInitOutputData%PWaveVel0 + DstInitOutputData%WaveElev1 => SrcInitOutputData%WaveElev1 + DstInitOutputData%WaveElev2 => SrcInitOutputData%WaveElev2 + DstInitOutputData%WaveElev0 => SrcInitOutputData%WaveElev0 + DstInitOutputData%WaveTime => SrcInitOutputData%WaveTime + DstInitOutputData%RhoXg = SrcInitOutputData%RhoXg + DstInitOutputData%NStepWave = SrcInitOutputData%NStepWave + DstInitOutputData%NStepWave2 = SrcInitOutputData%NStepWave2 + DstInitOutputData%WaveMod = SrcInitOutputData%WaveMod + DstInitOutputData%WaveStMod = SrcInitOutputData%WaveStMod + DstInitOutputData%WaveDirMod = SrcInitOutputData%WaveDirMod + DstInitOutputData%WvLowCOff = SrcInitOutputData%WvLowCOff + DstInitOutputData%WvHiCOff = SrcInitOutputData%WvHiCOff + DstInitOutputData%WvLowCOffD = SrcInitOutputData%WvLowCOffD + DstInitOutputData%WvHiCOffD = SrcInitOutputData%WvHiCOffD + DstInitOutputData%WvLowCOffS = SrcInitOutputData%WvLowCOffS + DstInitOutputData%WvHiCOffS = SrcInitOutputData%WvHiCOffS + DstInitOutputData%InvalidWithSSExctn = SrcInitOutputData%InvalidWithSSExctn + call SeaSt_Interp_CopyParam(SrcInitOutputData%SeaSt_Interp_p, DstInitOutputData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitOutputData%MCFD = SrcInitOutputData%MCFD + if (allocated(SrcInitOutputData%WaveElevSeries)) then + LB(1:2) = lbound(SrcInitOutputData%WaveElevSeries) + UB(1:2) = ubound(SrcInitOutputData%WaveElevSeries) + if (.not. allocated(DstInitOutputData%WaveElevSeries)) then + allocate(DstInitOutputData%WaveElevSeries(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveElevSeries.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WaveElevSeries = SrcInitOutputData%WaveElevSeries + else if (allocated(DstInitOutputData%WaveElevSeries)) then + deallocate(DstInitOutputData%WaveElevSeries) + end if + DstInitOutputData%WaveField => SrcInitOutputData%WaveField +end subroutine +subroutine SeaSt_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(SeaSt_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if + nullify(InitOutputData%WaveElevC0) + nullify(InitOutputData%WaveElevC) + nullify(InitOutputData%WaveDirArr) + nullify(InitOutputData%WaveDynP) + nullify(InitOutputData%WaveAcc) + nullify(InitOutputData%WaveAccMCF) + nullify(InitOutputData%WaveVel) + nullify(InitOutputData%PWaveDynP0) + nullify(InitOutputData%PWaveAcc0) + nullify(InitOutputData%PWaveAccMCF0) + nullify(InitOutputData%PWaveVel0) + nullify(InitOutputData%WaveElev1) + nullify(InitOutputData%WaveElev2) + nullify(InitOutputData%WaveElev0) + nullify(InitOutputData%WaveTime) + if (allocated(InitOutputData%WaveElevSeries)) then + deallocate(InitOutputData%WaveElevSeries) + end if + nullify(InitOutputData%WaveField) +end subroutine subroutine SeaSt_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -991,33 +885,26 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) character(*), parameter :: RoutineName = 'SeaSt_PackInitOutput' logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return - ! WriteOutputHdr call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) call RegPack(Buf, InData%WriteOutputHdr) end if if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutputUnt call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) call RegPack(Buf, InData%WriteOutputUnt) end if if (RegCheckErr(Buf, RoutineName)) return - ! Ver call NWTC_Library_PackProgDesc(Buf, InData%Ver) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDens call RegPack(Buf, InData%WtrDens) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDpth call RegPack(Buf, InData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - ! MSL2SWL call RegPack(Buf, InData%MSL2SWL) if (RegCheckErr(Buf, RoutineName)) return - ! WaveElevC0 call RegPack(Buf, associated(InData%WaveElevC0)) if (associated(InData%WaveElevC0)) then call RegPackBounds(Buf, 2, lbound(InData%WaveElevC0), ubound(InData%WaveElevC0)) @@ -1027,7 +914,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveElevC call RegPack(Buf, associated(InData%WaveElevC)) if (associated(InData%WaveElevC)) then call RegPackBounds(Buf, 3, lbound(InData%WaveElevC), ubound(InData%WaveElevC)) @@ -1037,7 +923,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveDirArr call RegPack(Buf, associated(InData%WaveDirArr)) if (associated(InData%WaveDirArr)) then call RegPackBounds(Buf, 1, lbound(InData%WaveDirArr), ubound(InData%WaveDirArr)) @@ -1047,22 +932,16 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveDirMin call RegPack(Buf, InData%WaveDirMin) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDirMax call RegPack(Buf, InData%WaveDirMax) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDir call RegPack(Buf, InData%WaveDir) if (RegCheckErr(Buf, RoutineName)) return - ! WaveMultiDir call RegPack(Buf, InData%WaveMultiDir) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDOmega call RegPack(Buf, InData%WaveDOmega) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDynP call RegPack(Buf, associated(InData%WaveDynP)) if (associated(InData%WaveDynP)) then call RegPackBounds(Buf, 4, lbound(InData%WaveDynP), ubound(InData%WaveDynP)) @@ -1072,7 +951,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveAcc call RegPack(Buf, associated(InData%WaveAcc)) if (associated(InData%WaveAcc)) then call RegPackBounds(Buf, 5, lbound(InData%WaveAcc), ubound(InData%WaveAcc)) @@ -1082,7 +960,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveAccMCF call RegPack(Buf, associated(InData%WaveAccMCF)) if (associated(InData%WaveAccMCF)) then call RegPackBounds(Buf, 5, lbound(InData%WaveAccMCF), ubound(InData%WaveAccMCF)) @@ -1092,7 +969,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveVel call RegPack(Buf, associated(InData%WaveVel)) if (associated(InData%WaveVel)) then call RegPackBounds(Buf, 5, lbound(InData%WaveVel), ubound(InData%WaveVel)) @@ -1102,7 +978,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! PWaveDynP0 call RegPack(Buf, associated(InData%PWaveDynP0)) if (associated(InData%PWaveDynP0)) then call RegPackBounds(Buf, 3, lbound(InData%PWaveDynP0), ubound(InData%PWaveDynP0)) @@ -1112,7 +987,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! PWaveAcc0 call RegPack(Buf, associated(InData%PWaveAcc0)) if (associated(InData%PWaveAcc0)) then call RegPackBounds(Buf, 4, lbound(InData%PWaveAcc0), ubound(InData%PWaveAcc0)) @@ -1122,7 +996,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! PWaveAccMCF0 call RegPack(Buf, associated(InData%PWaveAccMCF0)) if (associated(InData%PWaveAccMCF0)) then call RegPackBounds(Buf, 4, lbound(InData%PWaveAccMCF0), ubound(InData%PWaveAccMCF0)) @@ -1132,7 +1005,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! PWaveVel0 call RegPack(Buf, associated(InData%PWaveVel0)) if (associated(InData%PWaveVel0)) then call RegPackBounds(Buf, 4, lbound(InData%PWaveVel0), ubound(InData%PWaveVel0)) @@ -1142,7 +1014,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveElev1 call RegPack(Buf, associated(InData%WaveElev1)) if (associated(InData%WaveElev1)) then call RegPackBounds(Buf, 3, lbound(InData%WaveElev1), ubound(InData%WaveElev1)) @@ -1152,7 +1023,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveElev2 call RegPack(Buf, associated(InData%WaveElev2)) if (associated(InData%WaveElev2)) then call RegPackBounds(Buf, 3, lbound(InData%WaveElev2), ubound(InData%WaveElev2)) @@ -1162,7 +1032,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveElev0 call RegPack(Buf, associated(InData%WaveElev0)) if (associated(InData%WaveElev0)) then call RegPackBounds(Buf, 1, lbound(InData%WaveElev0), ubound(InData%WaveElev0)) @@ -1172,7 +1041,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveTime call RegPack(Buf, associated(InData%WaveTime)) if (associated(InData%WaveTime)) then call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) @@ -1182,59 +1050,42 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! RhoXg call RegPack(Buf, InData%RhoXg) if (RegCheckErr(Buf, RoutineName)) return - ! NStepWave call RegPack(Buf, InData%NStepWave) if (RegCheckErr(Buf, RoutineName)) return - ! NStepWave2 call RegPack(Buf, InData%NStepWave2) if (RegCheckErr(Buf, RoutineName)) return - ! WaveMod call RegPack(Buf, InData%WaveMod) if (RegCheckErr(Buf, RoutineName)) return - ! WaveStMod call RegPack(Buf, InData%WaveStMod) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDirMod call RegPack(Buf, InData%WaveDirMod) if (RegCheckErr(Buf, RoutineName)) return - ! WvLowCOff call RegPack(Buf, InData%WvLowCOff) if (RegCheckErr(Buf, RoutineName)) return - ! WvHiCOff call RegPack(Buf, InData%WvHiCOff) if (RegCheckErr(Buf, RoutineName)) return - ! WvLowCOffD call RegPack(Buf, InData%WvLowCOffD) if (RegCheckErr(Buf, RoutineName)) return - ! WvHiCOffD call RegPack(Buf, InData%WvHiCOffD) if (RegCheckErr(Buf, RoutineName)) return - ! WvLowCOffS call RegPack(Buf, InData%WvLowCOffS) if (RegCheckErr(Buf, RoutineName)) return - ! WvHiCOffS call RegPack(Buf, InData%WvHiCOffS) if (RegCheckErr(Buf, RoutineName)) return - ! InvalidWithSSExctn call RegPack(Buf, InData%InvalidWithSSExctn) if (RegCheckErr(Buf, RoutineName)) return - ! SeaSt_Interp_p call SeaSt_Interp_PackParam(Buf, InData%SeaSt_Interp_p) if (RegCheckErr(Buf, RoutineName)) return - ! MCFD call RegPack(Buf, InData%MCFD) if (RegCheckErr(Buf, RoutineName)) return - ! WaveElevSeries call RegPack(Buf, allocated(InData%WaveElevSeries)) if (allocated(InData%WaveElevSeries)) then call RegPackBounds(Buf, 2, lbound(InData%WaveElevSeries), ubound(InData%WaveElevSeries)) call RegPack(Buf, InData%WaveElevSeries) end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveField call RegPack(Buf, associated(InData%WaveField)) if (associated(InData%WaveField)) then call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) @@ -1255,7 +1106,6 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) integer(IntKi) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return - ! WriteOutputHdr if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1270,7 +1120,6 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutputHdr) if (RegCheckErr(Buf, RoutineName)) return end if - ! WriteOutputUnt if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1285,18 +1134,13 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutputUnt) if (RegCheckErr(Buf, RoutineName)) return end if - ! Ver call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver - ! WtrDens call RegUnpack(Buf, OutData%WtrDens) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDpth call RegUnpack(Buf, OutData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - ! MSL2SWL call RegUnpack(Buf, OutData%MSL2SWL) if (RegCheckErr(Buf, RoutineName)) return - ! WaveElevC0 if (associated(OutData%WaveElevC0)) deallocate(OutData%WaveElevC0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1321,7 +1165,6 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) else OutData%WaveElevC0 => null() end if - ! WaveElevC if (associated(OutData%WaveElevC)) deallocate(OutData%WaveElevC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1346,7 +1189,6 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) else OutData%WaveElevC => null() end if - ! WaveDirArr if (associated(OutData%WaveDirArr)) deallocate(OutData%WaveDirArr) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1371,22 +1213,16 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) else OutData%WaveDirArr => null() end if - ! WaveDirMin call RegUnpack(Buf, OutData%WaveDirMin) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDirMax call RegUnpack(Buf, OutData%WaveDirMax) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDir call RegUnpack(Buf, OutData%WaveDir) if (RegCheckErr(Buf, RoutineName)) return - ! WaveMultiDir call RegUnpack(Buf, OutData%WaveMultiDir) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDOmega call RegUnpack(Buf, OutData%WaveDOmega) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDynP if (associated(OutData%WaveDynP)) deallocate(OutData%WaveDynP) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1411,7 +1247,6 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) else OutData%WaveDynP => null() end if - ! WaveAcc if (associated(OutData%WaveAcc)) deallocate(OutData%WaveAcc) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1436,7 +1271,6 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) else OutData%WaveAcc => null() end if - ! WaveAccMCF if (associated(OutData%WaveAccMCF)) deallocate(OutData%WaveAccMCF) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1461,7 +1295,6 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) else OutData%WaveAccMCF => null() end if - ! WaveVel if (associated(OutData%WaveVel)) deallocate(OutData%WaveVel) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1486,7 +1319,6 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) else OutData%WaveVel => null() end if - ! PWaveDynP0 if (associated(OutData%PWaveDynP0)) deallocate(OutData%PWaveDynP0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1511,7 +1343,6 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) else OutData%PWaveDynP0 => null() end if - ! PWaveAcc0 if (associated(OutData%PWaveAcc0)) deallocate(OutData%PWaveAcc0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1536,7 +1367,6 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) else OutData%PWaveAcc0 => null() end if - ! PWaveAccMCF0 if (associated(OutData%PWaveAccMCF0)) deallocate(OutData%PWaveAccMCF0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1561,7 +1391,6 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) else OutData%PWaveAccMCF0 => null() end if - ! PWaveVel0 if (associated(OutData%PWaveVel0)) deallocate(OutData%PWaveVel0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1586,7 +1415,6 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) else OutData%PWaveVel0 => null() end if - ! WaveElev1 if (associated(OutData%WaveElev1)) deallocate(OutData%WaveElev1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1611,7 +1439,6 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) else OutData%WaveElev1 => null() end if - ! WaveElev2 if (associated(OutData%WaveElev2)) deallocate(OutData%WaveElev2) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1636,7 +1463,6 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) else OutData%WaveElev2 => null() end if - ! WaveElev0 if (associated(OutData%WaveElev0)) deallocate(OutData%WaveElev0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1661,7 +1487,6 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) else OutData%WaveElev0 => null() end if - ! WaveTime if (associated(OutData%WaveTime)) deallocate(OutData%WaveTime) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1686,51 +1511,35 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) else OutData%WaveTime => null() end if - ! RhoXg call RegUnpack(Buf, OutData%RhoXg) if (RegCheckErr(Buf, RoutineName)) return - ! NStepWave call RegUnpack(Buf, OutData%NStepWave) if (RegCheckErr(Buf, RoutineName)) return - ! NStepWave2 call RegUnpack(Buf, OutData%NStepWave2) if (RegCheckErr(Buf, RoutineName)) return - ! WaveMod call RegUnpack(Buf, OutData%WaveMod) if (RegCheckErr(Buf, RoutineName)) return - ! WaveStMod call RegUnpack(Buf, OutData%WaveStMod) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDirMod call RegUnpack(Buf, OutData%WaveDirMod) if (RegCheckErr(Buf, RoutineName)) return - ! WvLowCOff call RegUnpack(Buf, OutData%WvLowCOff) if (RegCheckErr(Buf, RoutineName)) return - ! WvHiCOff call RegUnpack(Buf, OutData%WvHiCOff) if (RegCheckErr(Buf, RoutineName)) return - ! WvLowCOffD call RegUnpack(Buf, OutData%WvLowCOffD) if (RegCheckErr(Buf, RoutineName)) return - ! WvHiCOffD call RegUnpack(Buf, OutData%WvHiCOffD) if (RegCheckErr(Buf, RoutineName)) return - ! WvLowCOffS call RegUnpack(Buf, OutData%WvLowCOffS) if (RegCheckErr(Buf, RoutineName)) return - ! WvHiCOffS call RegUnpack(Buf, OutData%WvHiCOffS) if (RegCheckErr(Buf, RoutineName)) return - ! InvalidWithSSExctn call RegUnpack(Buf, OutData%InvalidWithSSExctn) if (RegCheckErr(Buf, RoutineName)) return - ! SeaSt_Interp_p call SeaSt_Interp_UnpackParam(Buf, OutData%SeaSt_Interp_p) ! SeaSt_Interp_p - ! MCFD call RegUnpack(Buf, OutData%MCFD) if (RegCheckErr(Buf, RoutineName)) return - ! WaveElevSeries if (allocated(OutData%WaveElevSeries)) deallocate(OutData%WaveElevSeries) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1745,7 +1554,6 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WaveElevSeries) if (RegCheckErr(Buf, RoutineName)) return end if - ! WaveField if (associated(OutData%WaveField)) deallocate(OutData%WaveField) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1767,45 +1575,33 @@ subroutine SeaSt_UnPackInitOutput(Buf, OutData) OutData%WaveField => null() end if end subroutine - SUBROUTINE SeaSt_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SeaSt_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(SeaSt_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%UnusedStates = SrcContStateData%UnusedStates - END SUBROUTINE SeaSt_CopyContState - - SUBROUTINE SeaSt_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(SeaSt_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_DestroyContState' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE SeaSt_DestroyContState +subroutine SeaSt_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_ContinuousStateType), intent(in) :: SrcContStateData + type(SeaSt_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + DstContStateData%UnusedStates = SrcContStateData%UnusedStates +end subroutine +subroutine SeaSt_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(SeaSt_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine SeaSt_PackContState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SeaSt_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SeaSt_PackContState' if (Buf%ErrStat >= AbortErrLev) return - ! UnusedStates call RegPack(Buf, InData%UnusedStates) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1815,49 +1611,36 @@ subroutine SeaSt_UnPackContState(Buf, OutData) type(SeaSt_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_UnPackContState' if (Buf%ErrStat /= ErrID_None) return - ! UnusedStates call RegUnpack(Buf, OutData%UnusedStates) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE SeaSt_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SeaSt_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(SeaSt_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%UnusedStates = SrcDiscStateData%UnusedStates - END SUBROUTINE SeaSt_CopyDiscState - - SUBROUTINE SeaSt_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(SeaSt_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE SeaSt_DestroyDiscState +subroutine SeaSt_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_DiscreteStateType), intent(in) :: SrcDiscStateData + type(SeaSt_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + DstDiscStateData%UnusedStates = SrcDiscStateData%UnusedStates +end subroutine +subroutine SeaSt_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(SeaSt_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine SeaSt_PackDiscState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SeaSt_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SeaSt_PackDiscState' if (Buf%ErrStat >= AbortErrLev) return - ! UnusedStates call RegPack(Buf, InData%UnusedStates) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1867,49 +1650,36 @@ subroutine SeaSt_UnPackDiscState(Buf, OutData) type(SeaSt_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_UnPackDiscState' if (Buf%ErrStat /= ErrID_None) return - ! UnusedStates call RegUnpack(Buf, OutData%UnusedStates) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE SeaSt_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SeaSt_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(SeaSt_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%UnusedStates = SrcConstrStateData%UnusedStates - END SUBROUTINE SeaSt_CopyConstrState - - SUBROUTINE SeaSt_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(SeaSt_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_DestroyConstrState' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE SeaSt_DestroyConstrState +subroutine SeaSt_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_ConstraintStateType), intent(in) :: SrcConstrStateData + type(SeaSt_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%UnusedStates = SrcConstrStateData%UnusedStates +end subroutine +subroutine SeaSt_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(SeaSt_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine SeaSt_PackConstrState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SeaSt_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SeaSt_PackConstrState' if (Buf%ErrStat >= AbortErrLev) return - ! UnusedStates call RegPack(Buf, InData%UnusedStates) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1919,49 +1689,36 @@ subroutine SeaSt_UnPackConstrState(Buf, OutData) type(SeaSt_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_UnPackConstrState' if (Buf%ErrStat /= ErrID_None) return - ! UnusedStates call RegUnpack(Buf, OutData%UnusedStates) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE SeaSt_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SeaSt_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(SeaSt_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%UnusedStates = SrcOtherStateData%UnusedStates - END SUBROUTINE SeaSt_CopyOtherState - - SUBROUTINE SeaSt_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(SeaSt_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE SeaSt_DestroyOtherState +subroutine SeaSt_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_OtherStateType), intent(in) :: SrcOtherStateData + type(SeaSt_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%UnusedStates = SrcOtherStateData%UnusedStates +end subroutine +subroutine SeaSt_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(SeaSt_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine SeaSt_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SeaSt_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SeaSt_PackOtherState' if (Buf%ErrStat >= AbortErrLev) return - ! UnusedStates call RegPack(Buf, InData%UnusedStates) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1971,65 +1728,51 @@ subroutine SeaSt_UnPackOtherState(Buf, OutData) type(SeaSt_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_UnPackOtherState' if (Buf%ErrStat /= ErrID_None) return - ! UnusedStates call RegUnpack(Buf, OutData%UnusedStates) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE SeaSt_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SeaSt_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(SeaSt_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%Decimate = SrcMiscData%Decimate - DstMiscData%LastOutTime = SrcMiscData%LastOutTime - DstMiscData%LastIndWave = SrcMiscData%LastIndWave - CALL SeaSt_Interp_CopyMisc( SrcMiscData%SeaSt_Interp_m, DstMiscData%SeaSt_Interp_m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE SeaSt_CopyMisc - - SUBROUTINE SeaSt_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(SeaSt_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - CALL SeaSt_Interp_DestroyMisc( MiscData%SeaSt_Interp_m, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE SeaSt_DestroyMisc +subroutine SeaSt_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_MiscVarType), intent(in) :: SrcMiscData + type(SeaSt_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%Decimate = SrcMiscData%Decimate + DstMiscData%LastOutTime = SrcMiscData%LastOutTime + DstMiscData%LastIndWave = SrcMiscData%LastIndWave + call SeaSt_Interp_CopyMisc(SrcMiscData%SeaSt_Interp_m, DstMiscData%SeaSt_Interp_m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine SeaSt_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(SeaSt_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine SeaSt_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SeaSt_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'SeaSt_PackMisc' if (Buf%ErrStat >= AbortErrLev) return - ! Decimate call RegPack(Buf, InData%Decimate) if (RegCheckErr(Buf, RoutineName)) return - ! LastOutTime call RegPack(Buf, InData%LastOutTime) if (RegCheckErr(Buf, RoutineName)) return - ! LastIndWave call RegPack(Buf, InData%LastIndWave) if (RegCheckErr(Buf, RoutineName)) return - ! SeaSt_Interp_m call SeaSt_Interp_PackMisc(Buf, InData%SeaSt_Interp_m) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2039,228 +1782,226 @@ subroutine SeaSt_UnPackMisc(Buf, OutData) type(SeaSt_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_UnPackMisc' if (Buf%ErrStat /= ErrID_None) return - ! Decimate call RegUnpack(Buf, OutData%Decimate) if (RegCheckErr(Buf, RoutineName)) return - ! LastOutTime call RegUnpack(Buf, OutData%LastOutTime) if (RegCheckErr(Buf, RoutineName)) return - ! LastIndWave call RegUnpack(Buf, OutData%LastIndWave) if (RegCheckErr(Buf, RoutineName)) return - ! SeaSt_Interp_m call SeaSt_Interp_UnpackMisc(Buf, OutData%SeaSt_Interp_m) ! SeaSt_Interp_m end subroutine - SUBROUTINE SeaSt_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SeaSt_ParameterType), INTENT(IN) :: SrcParamData - TYPE(SeaSt_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL Waves2_CopyParam( SrcParamData%Waves2, DstParamData%Waves2, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstParamData%WaveTime => SrcParamData%WaveTime - DstParamData%WaveDT = SrcParamData%WaveDT - DstParamData%NGridPts = SrcParamData%NGridPts - DstParamData%NGrid = SrcParamData%NGrid - DstParamData%deltaGrid = SrcParamData%deltaGrid - DstParamData%X_HalfWidth = SrcParamData%X_HalfWidth - DstParamData%Y_HalfWidth = SrcParamData%Y_HalfWidth - DstParamData%Z_Depth = SrcParamData%Z_Depth - DstParamData%NStepWave = SrcParamData%NStepWave - DstParamData%NWaveElev = SrcParamData%NWaveElev -IF (ALLOCATED(SrcParamData%WaveElevxi)) THEN - i1_l = LBOUND(SrcParamData%WaveElevxi,1) - i1_u = UBOUND(SrcParamData%WaveElevxi,1) - IF (.NOT. ALLOCATED(DstParamData%WaveElevxi)) THEN - ALLOCATE(DstParamData%WaveElevxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveElevxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveElevxi = SrcParamData%WaveElevxi -ENDIF -IF (ALLOCATED(SrcParamData%WaveElevyi)) THEN - i1_l = LBOUND(SrcParamData%WaveElevyi,1) - i1_u = UBOUND(SrcParamData%WaveElevyi,1) - IF (.NOT. ALLOCATED(DstParamData%WaveElevyi)) THEN - ALLOCATE(DstParamData%WaveElevyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveElevyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveElevyi = SrcParamData%WaveElevyi -ENDIF - DstParamData%WaveElev1 => SrcParamData%WaveElev1 - DstParamData%WaveElev2 => SrcParamData%WaveElev2 - DstParamData%PWaveDynP0 => SrcParamData%PWaveDynP0 - DstParamData%WaveDynP => SrcParamData%WaveDynP - DstParamData%WaveAcc => SrcParamData%WaveAcc - DstParamData%PWaveAcc0 => SrcParamData%PWaveAcc0 - DstParamData%WaveVel => SrcParamData%WaveVel - DstParamData%PWaveVel0 => SrcParamData%PWaveVel0 - DstParamData%WaveAccMCF => SrcParamData%WaveAccMCF - DstParamData%WaveDirArr => SrcParamData%WaveDirArr - DstParamData%WaveElevC0 => SrcParamData%WaveElevC0 - DstParamData%PWaveAccMCF0 => SrcParamData%PWaveAccMCF0 - DstParamData%NWaveKin = SrcParamData%NWaveKin -IF (ALLOCATED(SrcParamData%WaveKinxi)) THEN - i1_l = LBOUND(SrcParamData%WaveKinxi,1) - i1_u = UBOUND(SrcParamData%WaveKinxi,1) - IF (.NOT. ALLOCATED(DstParamData%WaveKinxi)) THEN - ALLOCATE(DstParamData%WaveKinxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveKinxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveKinxi = SrcParamData%WaveKinxi -ENDIF -IF (ALLOCATED(SrcParamData%WaveKinyi)) THEN - i1_l = LBOUND(SrcParamData%WaveKinyi,1) - i1_u = UBOUND(SrcParamData%WaveKinyi,1) - IF (.NOT. ALLOCATED(DstParamData%WaveKinyi)) THEN - ALLOCATE(DstParamData%WaveKinyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveKinyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveKinyi = SrcParamData%WaveKinyi -ENDIF -IF (ALLOCATED(SrcParamData%WaveKinzi)) THEN - i1_l = LBOUND(SrcParamData%WaveKinzi,1) - i1_u = UBOUND(SrcParamData%WaveKinzi,1) - IF (.NOT. ALLOCATED(DstParamData%WaveKinzi)) THEN - ALLOCATE(DstParamData%WaveKinzi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveKinzi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveKinzi = SrcParamData%WaveKinzi -ENDIF - DstParamData%WtrDpth = SrcParamData%WtrDpth - DstParamData%DT = SrcParamData%DT - DstParamData%WaveStMod = SrcParamData%WaveStMod -IF (ALLOCATED(SrcParamData%OutParam)) THEN - i1_l = LBOUND(SrcParamData%OutParam,1) - i1_u = UBOUND(SrcParamData%OutParam,1) - IF (.NOT. ALLOCATED(DstParamData%OutParam)) THEN - ALLOCATE(DstParamData%OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%OutParam,1), UBOUND(SrcParamData%OutParam,1) - CALL NWTC_Library_Copyoutparmtype( SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%OutSwtch = SrcParamData%OutSwtch - DstParamData%OutFmt = SrcParamData%OutFmt - DstParamData%OutSFmt = SrcParamData%OutSFmt - DstParamData%Delim = SrcParamData%Delim - DstParamData%UnOutFile = SrcParamData%UnOutFile - DstParamData%OutDec = SrcParamData%OutDec - CALL SeaSt_Interp_CopyParam( SrcParamData%SeaSt_Interp_p, DstParamData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ASSOCIATED(SrcParamData%WaveField)) THEN - IF (.NOT. ASSOCIATED(DstParamData%WaveField)) THEN - ALLOCATE(DstParamData%WaveField,STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveField.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - CALL SeaSt_WaveField_Copyseast_wavefieldtype( SrcParamData%WaveField, DstParamData%WaveField, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -ENDIF - END SUBROUTINE SeaSt_CopyParam - - SUBROUTINE SeaSt_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(SeaSt_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - CALL Waves2_DestroyParam( ParamData%Waves2, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -NULLIFY(ParamData%WaveTime) -IF (ALLOCATED(ParamData%WaveElevxi)) THEN - DEALLOCATE(ParamData%WaveElevxi) -ENDIF -IF (ALLOCATED(ParamData%WaveElevyi)) THEN - DEALLOCATE(ParamData%WaveElevyi) -ENDIF -NULLIFY(ParamData%WaveElev1) -NULLIFY(ParamData%WaveElev2) -NULLIFY(ParamData%PWaveDynP0) -NULLIFY(ParamData%WaveDynP) -NULLIFY(ParamData%WaveAcc) -NULLIFY(ParamData%PWaveAcc0) -NULLIFY(ParamData%WaveVel) -NULLIFY(ParamData%PWaveVel0) -NULLIFY(ParamData%WaveAccMCF) -NULLIFY(ParamData%WaveDirArr) -NULLIFY(ParamData%WaveElevC0) -NULLIFY(ParamData%PWaveAccMCF0) -IF (ALLOCATED(ParamData%WaveKinxi)) THEN - DEALLOCATE(ParamData%WaveKinxi) -ENDIF -IF (ALLOCATED(ParamData%WaveKinyi)) THEN - DEALLOCATE(ParamData%WaveKinyi) -ENDIF -IF (ALLOCATED(ParamData%WaveKinzi)) THEN - DEALLOCATE(ParamData%WaveKinzi) -ENDIF -IF (ALLOCATED(ParamData%OutParam)) THEN -DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_DestroyOutParmType( ParamData%OutParam(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%OutParam) -ENDIF - CALL SeaSt_Interp_DestroyParam( ParamData%SeaSt_Interp_p, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ASSOCIATED(ParamData%WaveField)) THEN - IF (ASSOCIATED(ParamData%WaveField)) THEN - CALL SeaSt_WaveField_DestroySeaSt_WaveFieldType( ParamData%WaveField, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - ENDIF - DEALLOCATE(ParamData%WaveField) - ParamData%WaveField => NULL() -ENDIF - END SUBROUTINE SeaSt_DestroyParam +subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_ParameterType), intent(in) :: SrcParamData + type(SeaSt_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3, i4, i5 + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + call Waves2_CopyParam(SrcParamData%Waves2, DstParamData%Waves2, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstParamData%WaveTime => SrcParamData%WaveTime + DstParamData%WaveDT = SrcParamData%WaveDT + DstParamData%NGridPts = SrcParamData%NGridPts + DstParamData%NGrid = SrcParamData%NGrid + DstParamData%deltaGrid = SrcParamData%deltaGrid + DstParamData%X_HalfWidth = SrcParamData%X_HalfWidth + DstParamData%Y_HalfWidth = SrcParamData%Y_HalfWidth + DstParamData%Z_Depth = SrcParamData%Z_Depth + DstParamData%NStepWave = SrcParamData%NStepWave + DstParamData%NWaveElev = SrcParamData%NWaveElev + if (allocated(SrcParamData%WaveElevxi)) then + LB(1:1) = lbound(SrcParamData%WaveElevxi) + UB(1:1) = ubound(SrcParamData%WaveElevxi) + if (.not. allocated(DstParamData%WaveElevxi)) then + allocate(DstParamData%WaveElevxi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveElevxi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WaveElevxi = SrcParamData%WaveElevxi + else if (allocated(DstParamData%WaveElevxi)) then + deallocate(DstParamData%WaveElevxi) + end if + if (allocated(SrcParamData%WaveElevyi)) then + LB(1:1) = lbound(SrcParamData%WaveElevyi) + UB(1:1) = ubound(SrcParamData%WaveElevyi) + if (.not. allocated(DstParamData%WaveElevyi)) then + allocate(DstParamData%WaveElevyi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveElevyi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WaveElevyi = SrcParamData%WaveElevyi + else if (allocated(DstParamData%WaveElevyi)) then + deallocate(DstParamData%WaveElevyi) + end if + DstParamData%WaveElev1 => SrcParamData%WaveElev1 + DstParamData%WaveElev2 => SrcParamData%WaveElev2 + DstParamData%PWaveDynP0 => SrcParamData%PWaveDynP0 + DstParamData%WaveDynP => SrcParamData%WaveDynP + DstParamData%WaveAcc => SrcParamData%WaveAcc + DstParamData%PWaveAcc0 => SrcParamData%PWaveAcc0 + DstParamData%WaveVel => SrcParamData%WaveVel + DstParamData%PWaveVel0 => SrcParamData%PWaveVel0 + DstParamData%WaveAccMCF => SrcParamData%WaveAccMCF + DstParamData%WaveDirArr => SrcParamData%WaveDirArr + DstParamData%WaveElevC0 => SrcParamData%WaveElevC0 + DstParamData%PWaveAccMCF0 => SrcParamData%PWaveAccMCF0 + DstParamData%NWaveKin = SrcParamData%NWaveKin + if (allocated(SrcParamData%WaveKinxi)) then + LB(1:1) = lbound(SrcParamData%WaveKinxi) + UB(1:1) = ubound(SrcParamData%WaveKinxi) + if (.not. allocated(DstParamData%WaveKinxi)) then + allocate(DstParamData%WaveKinxi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveKinxi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WaveKinxi = SrcParamData%WaveKinxi + else if (allocated(DstParamData%WaveKinxi)) then + deallocate(DstParamData%WaveKinxi) + end if + if (allocated(SrcParamData%WaveKinyi)) then + LB(1:1) = lbound(SrcParamData%WaveKinyi) + UB(1:1) = ubound(SrcParamData%WaveKinyi) + if (.not. allocated(DstParamData%WaveKinyi)) then + allocate(DstParamData%WaveKinyi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveKinyi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WaveKinyi = SrcParamData%WaveKinyi + else if (allocated(DstParamData%WaveKinyi)) then + deallocate(DstParamData%WaveKinyi) + end if + if (allocated(SrcParamData%WaveKinzi)) then + LB(1:1) = lbound(SrcParamData%WaveKinzi) + UB(1:1) = ubound(SrcParamData%WaveKinzi) + if (.not. allocated(DstParamData%WaveKinzi)) then + allocate(DstParamData%WaveKinzi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveKinzi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%WaveKinzi = SrcParamData%WaveKinzi + else if (allocated(DstParamData%WaveKinzi)) then + deallocate(DstParamData%WaveKinzi) + end if + DstParamData%WtrDpth = SrcParamData%WtrDpth + DstParamData%DT = SrcParamData%DT + DstParamData%WaveStMod = SrcParamData%WaveStMod + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstParamData%OutParam)) then + deallocate(DstParamData%OutParam) + end if + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%OutSwtch = SrcParamData%OutSwtch + DstParamData%OutFmt = SrcParamData%OutFmt + DstParamData%OutSFmt = SrcParamData%OutSFmt + DstParamData%Delim = SrcParamData%Delim + DstParamData%UnOutFile = SrcParamData%UnOutFile + DstParamData%OutDec = SrcParamData%OutDec + call SeaSt_Interp_CopyParam(SrcParamData%SeaSt_Interp_p, DstParamData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (associated(SrcParamData%WaveField)) then + if (.not. associated(DstParamData%WaveField)) then + allocate(DstParamData%WaveField, stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveField.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + call SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcParamData%WaveField, DstParamData%WaveField, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + else if (associated(DstParamData%WaveField)) then + deallocate(DstParamData%WaveField) + end if +end subroutine +subroutine SeaSt_DestroyParam(ParamData, ErrStat, ErrMsg) + type(SeaSt_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3, i4, i5 + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + nullify(ParamData%WaveTime) + if (allocated(ParamData%WaveElevxi)) then + deallocate(ParamData%WaveElevxi) + end if + if (allocated(ParamData%WaveElevyi)) then + deallocate(ParamData%WaveElevyi) + end if + nullify(ParamData%WaveElev1) + nullify(ParamData%WaveElev2) + nullify(ParamData%PWaveDynP0) + nullify(ParamData%WaveDynP) + nullify(ParamData%WaveAcc) + nullify(ParamData%PWaveAcc0) + nullify(ParamData%WaveVel) + nullify(ParamData%PWaveVel0) + nullify(ParamData%WaveAccMCF) + nullify(ParamData%WaveDirArr) + nullify(ParamData%WaveElevC0) + nullify(ParamData%PWaveAccMCF0) + if (allocated(ParamData%WaveKinxi)) then + deallocate(ParamData%WaveKinxi) + end if + if (allocated(ParamData%WaveKinyi)) then + deallocate(ParamData%WaveKinyi) + end if + if (allocated(ParamData%WaveKinzi)) then + deallocate(ParamData%WaveKinzi) + end if + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%OutParam) + end if + if (associated(ParamData%WaveField)) then + call SeaSt_WaveField_DestroySeaSt_WaveFieldType(ParamData%WaveField, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + deallocate(ParamData%WaveField) + ParamData%WaveField => null() + end if +end subroutine subroutine SeaSt_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -2270,10 +2011,8 @@ subroutine SeaSt_PackParam(Buf, Indata) integer(IntKi) :: LB(5), UB(5) logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return - ! Waves2 call Waves2_PackParam(Buf, InData%Waves2) if (RegCheckErr(Buf, RoutineName)) return - ! WaveTime call RegPack(Buf, associated(InData%WaveTime)) if (associated(InData%WaveTime)) then call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) @@ -2283,48 +2022,36 @@ subroutine SeaSt_PackParam(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveDT call RegPack(Buf, InData%WaveDT) if (RegCheckErr(Buf, RoutineName)) return - ! NGridPts call RegPack(Buf, InData%NGridPts) if (RegCheckErr(Buf, RoutineName)) return - ! NGrid call RegPack(Buf, InData%NGrid) if (RegCheckErr(Buf, RoutineName)) return - ! deltaGrid call RegPack(Buf, InData%deltaGrid) if (RegCheckErr(Buf, RoutineName)) return - ! X_HalfWidth call RegPack(Buf, InData%X_HalfWidth) if (RegCheckErr(Buf, RoutineName)) return - ! Y_HalfWidth call RegPack(Buf, InData%Y_HalfWidth) if (RegCheckErr(Buf, RoutineName)) return - ! Z_Depth call RegPack(Buf, InData%Z_Depth) if (RegCheckErr(Buf, RoutineName)) return - ! NStepWave call RegPack(Buf, InData%NStepWave) if (RegCheckErr(Buf, RoutineName)) return - ! NWaveElev call RegPack(Buf, InData%NWaveElev) if (RegCheckErr(Buf, RoutineName)) return - ! WaveElevxi call RegPack(Buf, allocated(InData%WaveElevxi)) if (allocated(InData%WaveElevxi)) then call RegPackBounds(Buf, 1, lbound(InData%WaveElevxi), ubound(InData%WaveElevxi)) call RegPack(Buf, InData%WaveElevxi) end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveElevyi call RegPack(Buf, allocated(InData%WaveElevyi)) if (allocated(InData%WaveElevyi)) then call RegPackBounds(Buf, 1, lbound(InData%WaveElevyi), ubound(InData%WaveElevyi)) call RegPack(Buf, InData%WaveElevyi) end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveElev1 call RegPack(Buf, associated(InData%WaveElev1)) if (associated(InData%WaveElev1)) then call RegPackBounds(Buf, 3, lbound(InData%WaveElev1), ubound(InData%WaveElev1)) @@ -2334,7 +2061,6 @@ subroutine SeaSt_PackParam(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveElev2 call RegPack(Buf, associated(InData%WaveElev2)) if (associated(InData%WaveElev2)) then call RegPackBounds(Buf, 3, lbound(InData%WaveElev2), ubound(InData%WaveElev2)) @@ -2344,7 +2070,6 @@ subroutine SeaSt_PackParam(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! PWaveDynP0 call RegPack(Buf, associated(InData%PWaveDynP0)) if (associated(InData%PWaveDynP0)) then call RegPackBounds(Buf, 3, lbound(InData%PWaveDynP0), ubound(InData%PWaveDynP0)) @@ -2354,7 +2079,6 @@ subroutine SeaSt_PackParam(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveDynP call RegPack(Buf, associated(InData%WaveDynP)) if (associated(InData%WaveDynP)) then call RegPackBounds(Buf, 4, lbound(InData%WaveDynP), ubound(InData%WaveDynP)) @@ -2364,7 +2088,6 @@ subroutine SeaSt_PackParam(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveAcc call RegPack(Buf, associated(InData%WaveAcc)) if (associated(InData%WaveAcc)) then call RegPackBounds(Buf, 5, lbound(InData%WaveAcc), ubound(InData%WaveAcc)) @@ -2374,7 +2097,6 @@ subroutine SeaSt_PackParam(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! PWaveAcc0 call RegPack(Buf, associated(InData%PWaveAcc0)) if (associated(InData%PWaveAcc0)) then call RegPackBounds(Buf, 4, lbound(InData%PWaveAcc0), ubound(InData%PWaveAcc0)) @@ -2384,7 +2106,6 @@ subroutine SeaSt_PackParam(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveVel call RegPack(Buf, associated(InData%WaveVel)) if (associated(InData%WaveVel)) then call RegPackBounds(Buf, 5, lbound(InData%WaveVel), ubound(InData%WaveVel)) @@ -2394,7 +2115,6 @@ subroutine SeaSt_PackParam(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! PWaveVel0 call RegPack(Buf, associated(InData%PWaveVel0)) if (associated(InData%PWaveVel0)) then call RegPackBounds(Buf, 4, lbound(InData%PWaveVel0), ubound(InData%PWaveVel0)) @@ -2404,7 +2124,6 @@ subroutine SeaSt_PackParam(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveAccMCF call RegPack(Buf, associated(InData%WaveAccMCF)) if (associated(InData%WaveAccMCF)) then call RegPackBounds(Buf, 5, lbound(InData%WaveAccMCF), ubound(InData%WaveAccMCF)) @@ -2414,7 +2133,6 @@ subroutine SeaSt_PackParam(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveDirArr call RegPack(Buf, associated(InData%WaveDirArr)) if (associated(InData%WaveDirArr)) then call RegPackBounds(Buf, 1, lbound(InData%WaveDirArr), ubound(InData%WaveDirArr)) @@ -2424,7 +2142,6 @@ subroutine SeaSt_PackParam(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveElevC0 call RegPack(Buf, associated(InData%WaveElevC0)) if (associated(InData%WaveElevC0)) then call RegPackBounds(Buf, 2, lbound(InData%WaveElevC0), ubound(InData%WaveElevC0)) @@ -2434,7 +2151,6 @@ subroutine SeaSt_PackParam(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! PWaveAccMCF0 call RegPack(Buf, associated(InData%PWaveAccMCF0)) if (associated(InData%PWaveAccMCF0)) then call RegPackBounds(Buf, 4, lbound(InData%PWaveAccMCF0), ubound(InData%PWaveAccMCF0)) @@ -2444,40 +2160,32 @@ subroutine SeaSt_PackParam(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! NWaveKin call RegPack(Buf, InData%NWaveKin) if (RegCheckErr(Buf, RoutineName)) return - ! WaveKinxi call RegPack(Buf, allocated(InData%WaveKinxi)) if (allocated(InData%WaveKinxi)) then call RegPackBounds(Buf, 1, lbound(InData%WaveKinxi), ubound(InData%WaveKinxi)) call RegPack(Buf, InData%WaveKinxi) end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveKinyi call RegPack(Buf, allocated(InData%WaveKinyi)) if (allocated(InData%WaveKinyi)) then call RegPackBounds(Buf, 1, lbound(InData%WaveKinyi), ubound(InData%WaveKinyi)) call RegPack(Buf, InData%WaveKinyi) end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveKinzi call RegPack(Buf, allocated(InData%WaveKinzi)) if (allocated(InData%WaveKinzi)) then call RegPackBounds(Buf, 1, lbound(InData%WaveKinzi), ubound(InData%WaveKinzi)) call RegPack(Buf, InData%WaveKinzi) end if if (RegCheckErr(Buf, RoutineName)) return - ! WtrDpth call RegPack(Buf, InData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - ! DT call RegPack(Buf, InData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! WaveStMod call RegPack(Buf, InData%WaveStMod) if (RegCheckErr(Buf, RoutineName)) return - ! OutParam call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) @@ -2488,31 +2196,22 @@ subroutine SeaSt_PackParam(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegPack(Buf, InData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! OutSwtch call RegPack(Buf, InData%OutSwtch) if (RegCheckErr(Buf, RoutineName)) return - ! OutFmt call RegPack(Buf, InData%OutFmt) if (RegCheckErr(Buf, RoutineName)) return - ! OutSFmt call RegPack(Buf, InData%OutSFmt) if (RegCheckErr(Buf, RoutineName)) return - ! Delim call RegPack(Buf, InData%Delim) if (RegCheckErr(Buf, RoutineName)) return - ! UnOutFile call RegPack(Buf, InData%UnOutFile) if (RegCheckErr(Buf, RoutineName)) return - ! OutDec call RegPack(Buf, InData%OutDec) if (RegCheckErr(Buf, RoutineName)) return - ! SeaSt_Interp_p call SeaSt_Interp_PackParam(Buf, InData%SeaSt_Interp_p) if (RegCheckErr(Buf, RoutineName)) return - ! WaveField call RegPack(Buf, associated(InData%WaveField)) if (associated(InData%WaveField)) then call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) @@ -2534,9 +2233,7 @@ subroutine SeaSt_UnPackParam(Buf, OutData) integer(IntKi) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return - ! Waves2 call Waves2_UnpackParam(Buf, OutData%Waves2) ! Waves2 - ! WaveTime if (associated(OutData%WaveTime)) deallocate(OutData%WaveTime) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2561,34 +2258,24 @@ subroutine SeaSt_UnPackParam(Buf, OutData) else OutData%WaveTime => null() end if - ! WaveDT call RegUnpack(Buf, OutData%WaveDT) if (RegCheckErr(Buf, RoutineName)) return - ! NGridPts call RegUnpack(Buf, OutData%NGridPts) if (RegCheckErr(Buf, RoutineName)) return - ! NGrid call RegUnpack(Buf, OutData%NGrid) if (RegCheckErr(Buf, RoutineName)) return - ! deltaGrid call RegUnpack(Buf, OutData%deltaGrid) if (RegCheckErr(Buf, RoutineName)) return - ! X_HalfWidth call RegUnpack(Buf, OutData%X_HalfWidth) if (RegCheckErr(Buf, RoutineName)) return - ! Y_HalfWidth call RegUnpack(Buf, OutData%Y_HalfWidth) if (RegCheckErr(Buf, RoutineName)) return - ! Z_Depth call RegUnpack(Buf, OutData%Z_Depth) if (RegCheckErr(Buf, RoutineName)) return - ! NStepWave call RegUnpack(Buf, OutData%NStepWave) if (RegCheckErr(Buf, RoutineName)) return - ! NWaveElev call RegUnpack(Buf, OutData%NWaveElev) if (RegCheckErr(Buf, RoutineName)) return - ! WaveElevxi if (allocated(OutData%WaveElevxi)) deallocate(OutData%WaveElevxi) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2603,7 +2290,6 @@ subroutine SeaSt_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%WaveElevxi) if (RegCheckErr(Buf, RoutineName)) return end if - ! WaveElevyi if (allocated(OutData%WaveElevyi)) deallocate(OutData%WaveElevyi) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2618,7 +2304,6 @@ subroutine SeaSt_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%WaveElevyi) if (RegCheckErr(Buf, RoutineName)) return end if - ! WaveElev1 if (associated(OutData%WaveElev1)) deallocate(OutData%WaveElev1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2643,7 +2328,6 @@ subroutine SeaSt_UnPackParam(Buf, OutData) else OutData%WaveElev1 => null() end if - ! WaveElev2 if (associated(OutData%WaveElev2)) deallocate(OutData%WaveElev2) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2668,7 +2352,6 @@ subroutine SeaSt_UnPackParam(Buf, OutData) else OutData%WaveElev2 => null() end if - ! PWaveDynP0 if (associated(OutData%PWaveDynP0)) deallocate(OutData%PWaveDynP0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2693,7 +2376,6 @@ subroutine SeaSt_UnPackParam(Buf, OutData) else OutData%PWaveDynP0 => null() end if - ! WaveDynP if (associated(OutData%WaveDynP)) deallocate(OutData%WaveDynP) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2718,7 +2400,6 @@ subroutine SeaSt_UnPackParam(Buf, OutData) else OutData%WaveDynP => null() end if - ! WaveAcc if (associated(OutData%WaveAcc)) deallocate(OutData%WaveAcc) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2743,7 +2424,6 @@ subroutine SeaSt_UnPackParam(Buf, OutData) else OutData%WaveAcc => null() end if - ! PWaveAcc0 if (associated(OutData%PWaveAcc0)) deallocate(OutData%PWaveAcc0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2768,7 +2448,6 @@ subroutine SeaSt_UnPackParam(Buf, OutData) else OutData%PWaveAcc0 => null() end if - ! WaveVel if (associated(OutData%WaveVel)) deallocate(OutData%WaveVel) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2793,7 +2472,6 @@ subroutine SeaSt_UnPackParam(Buf, OutData) else OutData%WaveVel => null() end if - ! PWaveVel0 if (associated(OutData%PWaveVel0)) deallocate(OutData%PWaveVel0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2818,7 +2496,6 @@ subroutine SeaSt_UnPackParam(Buf, OutData) else OutData%PWaveVel0 => null() end if - ! WaveAccMCF if (associated(OutData%WaveAccMCF)) deallocate(OutData%WaveAccMCF) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2843,7 +2520,6 @@ subroutine SeaSt_UnPackParam(Buf, OutData) else OutData%WaveAccMCF => null() end if - ! WaveDirArr if (associated(OutData%WaveDirArr)) deallocate(OutData%WaveDirArr) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2868,7 +2544,6 @@ subroutine SeaSt_UnPackParam(Buf, OutData) else OutData%WaveDirArr => null() end if - ! WaveElevC0 if (associated(OutData%WaveElevC0)) deallocate(OutData%WaveElevC0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2893,7 +2568,6 @@ subroutine SeaSt_UnPackParam(Buf, OutData) else OutData%WaveElevC0 => null() end if - ! PWaveAccMCF0 if (associated(OutData%PWaveAccMCF0)) deallocate(OutData%PWaveAccMCF0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2918,10 +2592,8 @@ subroutine SeaSt_UnPackParam(Buf, OutData) else OutData%PWaveAccMCF0 => null() end if - ! NWaveKin call RegUnpack(Buf, OutData%NWaveKin) if (RegCheckErr(Buf, RoutineName)) return - ! WaveKinxi if (allocated(OutData%WaveKinxi)) deallocate(OutData%WaveKinxi) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2936,7 +2608,6 @@ subroutine SeaSt_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%WaveKinxi) if (RegCheckErr(Buf, RoutineName)) return end if - ! WaveKinyi if (allocated(OutData%WaveKinyi)) deallocate(OutData%WaveKinyi) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2951,7 +2622,6 @@ subroutine SeaSt_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%WaveKinyi) if (RegCheckErr(Buf, RoutineName)) return end if - ! WaveKinzi if (allocated(OutData%WaveKinzi)) deallocate(OutData%WaveKinzi) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2966,16 +2636,12 @@ subroutine SeaSt_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%WaveKinzi) if (RegCheckErr(Buf, RoutineName)) return end if - ! WtrDpth call RegUnpack(Buf, OutData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - ! DT call RegUnpack(Buf, OutData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! WaveStMod call RegUnpack(Buf, OutData%WaveStMod) if (RegCheckErr(Buf, RoutineName)) return - ! OutParam if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2991,30 +2657,21 @@ subroutine SeaSt_UnPackParam(Buf, OutData) call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam end do end if - ! NumOuts call RegUnpack(Buf, OutData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! OutSwtch call RegUnpack(Buf, OutData%OutSwtch) if (RegCheckErr(Buf, RoutineName)) return - ! OutFmt call RegUnpack(Buf, OutData%OutFmt) if (RegCheckErr(Buf, RoutineName)) return - ! OutSFmt call RegUnpack(Buf, OutData%OutSFmt) if (RegCheckErr(Buf, RoutineName)) return - ! Delim call RegUnpack(Buf, OutData%Delim) if (RegCheckErr(Buf, RoutineName)) return - ! UnOutFile call RegUnpack(Buf, OutData%UnOutFile) if (RegCheckErr(Buf, RoutineName)) return - ! OutDec call RegUnpack(Buf, OutData%OutDec) if (RegCheckErr(Buf, RoutineName)) return - ! SeaSt_Interp_p call SeaSt_Interp_UnpackParam(Buf, OutData%SeaSt_Interp_p) ! SeaSt_Interp_p - ! WaveField if (associated(OutData%WaveField)) deallocate(OutData%WaveField) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3036,45 +2693,33 @@ subroutine SeaSt_UnPackParam(Buf, OutData) OutData%WaveField => null() end if end subroutine - SUBROUTINE SeaSt_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SeaSt_InputType), INTENT(IN) :: SrcInputData - TYPE(SeaSt_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_CopyInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInputData%DummyInput = SrcInputData%DummyInput - END SUBROUTINE SeaSt_CopyInput - - SUBROUTINE SeaSt_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(SeaSt_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE SeaSt_DestroyInput +subroutine SeaSt_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_InputType), intent(in) :: SrcInputData + type(SeaSt_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInputData%DummyInput = SrcInputData%DummyInput +end subroutine +subroutine SeaSt_DestroyInput(InputData, ErrStat, ErrMsg) + type(SeaSt_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine SeaSt_PackInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SeaSt_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SeaSt_PackInput' if (Buf%ErrStat >= AbortErrLev) return - ! DummyInput call RegPack(Buf, InData%DummyInput) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3084,64 +2729,54 @@ subroutine SeaSt_UnPackInput(Buf, OutData) type(SeaSt_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_UnPackInput' if (Buf%ErrStat /= ErrID_None) return - ! DummyInput call RegUnpack(Buf, OutData%DummyInput) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE SeaSt_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SeaSt_OutputType), INTENT(IN) :: SrcOutputData - TYPE(SeaSt_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_CopyOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%WriteOutput)) THEN - i1_l = LBOUND(SrcOutputData%WriteOutput,1) - i1_u = UBOUND(SrcOutputData%WriteOutput,1) - IF (.NOT. ALLOCATED(DstOutputData%WriteOutput)) THEN - ALLOCATE(DstOutputData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%WriteOutput = SrcOutputData%WriteOutput -ENDIF - END SUBROUTINE SeaSt_CopyOutput - - SUBROUTINE SeaSt_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(SeaSt_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - END SUBROUTINE SeaSt_DestroyOutput +subroutine SeaSt_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_OutputType), intent(in) :: SrcOutputData + type(SeaSt_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SeaSt_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%WriteOutput = SrcOutputData%WriteOutput + else if (allocated(DstOutputData%WriteOutput)) then + deallocate(DstOutputData%WriteOutput) + end if +end subroutine +subroutine SeaSt_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(SeaSt_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine subroutine SeaSt_PackOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SeaSt_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SeaSt_PackOutput' if (Buf%ErrStat >= AbortErrLev) return - ! WriteOutput call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) @@ -3158,7 +2793,6 @@ subroutine SeaSt_UnPackOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! WriteOutput if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/seastate/src/Waves2_Types.f90 b/modules/seastate/src/Waves2_Types.f90 index 018da7718e..e8f199410e 100644 --- a/modules/seastate/src/Waves2_Types.f90 +++ b/modules/seastate/src/Waves2_Types.f90 @@ -78,107 +78,102 @@ MODULE Waves2_Types END TYPE Waves2_ParameterType ! ======================= CONTAINS - SUBROUTINE Waves2_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Waves2_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(Waves2_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%Gravity = SrcInitInputData%Gravity - DstInitInputData%WtrDens = SrcInitInputData%WtrDens - DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth - DstInitInputData%NStepWave = SrcInitInputData%NStepWave - DstInitInputData%NStepWave2 = SrcInitInputData%NStepWave2 - DstInitInputData%WaveDOmega = SrcInitInputData%WaveDOmega - DstInitInputData%WaveStMod = SrcInitInputData%WaveStMod - DstInitInputData%WaveMultiDir = SrcInitInputData%WaveMultiDir - DstInitInputData%WaveDirArr => SrcInitInputData%WaveDirArr - DstInitInputData%WaveElevC0 => SrcInitInputData%WaveElevC0 - DstInitInputData%WaveTime => SrcInitInputData%WaveTime - DstInitInputData%nGrid = SrcInitInputData%nGrid - DstInitInputData%NWaveElevGrid = SrcInitInputData%NWaveElevGrid - DstInitInputData%NWaveKinGrid = SrcInitInputData%NWaveKinGrid -IF (ALLOCATED(SrcInitInputData%WaveKinGridxi)) THEN - i1_l = LBOUND(SrcInitInputData%WaveKinGridxi,1) - i1_u = UBOUND(SrcInitInputData%WaveKinGridxi,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveKinGridxi)) THEN - ALLOCATE(DstInitInputData%WaveKinGridxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinGridxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveKinGridxi = SrcInitInputData%WaveKinGridxi -ENDIF -IF (ALLOCATED(SrcInitInputData%WaveKinGridyi)) THEN - i1_l = LBOUND(SrcInitInputData%WaveKinGridyi,1) - i1_u = UBOUND(SrcInitInputData%WaveKinGridyi,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveKinGridyi)) THEN - ALLOCATE(DstInitInputData%WaveKinGridyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinGridyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveKinGridyi = SrcInitInputData%WaveKinGridyi -ENDIF -IF (ALLOCATED(SrcInitInputData%WaveKinGridzi)) THEN - i1_l = LBOUND(SrcInitInputData%WaveKinGridzi,1) - i1_u = UBOUND(SrcInitInputData%WaveKinGridzi,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveKinGridzi)) THEN - ALLOCATE(DstInitInputData%WaveKinGridzi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinGridzi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveKinGridzi = SrcInitInputData%WaveKinGridzi -ENDIF - DstInitInputData%WvDiffQTFF = SrcInitInputData%WvDiffQTFF - DstInitInputData%WvSumQTFF = SrcInitInputData%WvSumQTFF - DstInitInputData%WvLowCOffD = SrcInitInputData%WvLowCOffD - DstInitInputData%WvHiCOffD = SrcInitInputData%WvHiCOffD - DstInitInputData%WvLowCOffS = SrcInitInputData%WvLowCOffS - DstInitInputData%WvHiCOffS = SrcInitInputData%WvHiCOffS - END SUBROUTINE Waves2_CopyInitInput - - SUBROUTINE Waves2_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(Waves2_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" -NULLIFY(InitInputData%WaveDirArr) -NULLIFY(InitInputData%WaveElevC0) -NULLIFY(InitInputData%WaveTime) -IF (ALLOCATED(InitInputData%WaveKinGridxi)) THEN - DEALLOCATE(InitInputData%WaveKinGridxi) -ENDIF -IF (ALLOCATED(InitInputData%WaveKinGridyi)) THEN - DEALLOCATE(InitInputData%WaveKinGridyi) -ENDIF -IF (ALLOCATED(InitInputData%WaveKinGridzi)) THEN - DEALLOCATE(InitInputData%WaveKinGridzi) -ENDIF - END SUBROUTINE Waves2_DestroyInitInput +subroutine Waves2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(Waves2_InitInputType), intent(in) :: SrcInitInputData + type(Waves2_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Waves2_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitInputData%Gravity = SrcInitInputData%Gravity + DstInitInputData%WtrDens = SrcInitInputData%WtrDens + DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth + DstInitInputData%NStepWave = SrcInitInputData%NStepWave + DstInitInputData%NStepWave2 = SrcInitInputData%NStepWave2 + DstInitInputData%WaveDOmega = SrcInitInputData%WaveDOmega + DstInitInputData%WaveStMod = SrcInitInputData%WaveStMod + DstInitInputData%WaveMultiDir = SrcInitInputData%WaveMultiDir + DstInitInputData%WaveDirArr => SrcInitInputData%WaveDirArr + DstInitInputData%WaveElevC0 => SrcInitInputData%WaveElevC0 + DstInitInputData%WaveTime => SrcInitInputData%WaveTime + DstInitInputData%nGrid = SrcInitInputData%nGrid + DstInitInputData%NWaveElevGrid = SrcInitInputData%NWaveElevGrid + DstInitInputData%NWaveKinGrid = SrcInitInputData%NWaveKinGrid + if (allocated(SrcInitInputData%WaveKinGridxi)) then + LB(1:1) = lbound(SrcInitInputData%WaveKinGridxi) + UB(1:1) = ubound(SrcInitInputData%WaveKinGridxi) + if (.not. allocated(DstInitInputData%WaveKinGridxi)) then + allocate(DstInitInputData%WaveKinGridxi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinGridxi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%WaveKinGridxi = SrcInitInputData%WaveKinGridxi + else if (allocated(DstInitInputData%WaveKinGridxi)) then + deallocate(DstInitInputData%WaveKinGridxi) + end if + if (allocated(SrcInitInputData%WaveKinGridyi)) then + LB(1:1) = lbound(SrcInitInputData%WaveKinGridyi) + UB(1:1) = ubound(SrcInitInputData%WaveKinGridyi) + if (.not. allocated(DstInitInputData%WaveKinGridyi)) then + allocate(DstInitInputData%WaveKinGridyi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinGridyi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%WaveKinGridyi = SrcInitInputData%WaveKinGridyi + else if (allocated(DstInitInputData%WaveKinGridyi)) then + deallocate(DstInitInputData%WaveKinGridyi) + end if + if (allocated(SrcInitInputData%WaveKinGridzi)) then + LB(1:1) = lbound(SrcInitInputData%WaveKinGridzi) + UB(1:1) = ubound(SrcInitInputData%WaveKinGridzi) + if (.not. allocated(DstInitInputData%WaveKinGridzi)) then + allocate(DstInitInputData%WaveKinGridzi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinGridzi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%WaveKinGridzi = SrcInitInputData%WaveKinGridzi + else if (allocated(DstInitInputData%WaveKinGridzi)) then + deallocate(DstInitInputData%WaveKinGridzi) + end if + DstInitInputData%WvDiffQTFF = SrcInitInputData%WvDiffQTFF + DstInitInputData%WvSumQTFF = SrcInitInputData%WvSumQTFF + DstInitInputData%WvLowCOffD = SrcInitInputData%WvLowCOffD + DstInitInputData%WvHiCOffD = SrcInitInputData%WvHiCOffD + DstInitInputData%WvLowCOffS = SrcInitInputData%WvLowCOffS + DstInitInputData%WvHiCOffS = SrcInitInputData%WvHiCOffS +end subroutine +subroutine Waves2_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(Waves2_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Waves2_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + nullify(InitInputData%WaveDirArr) + nullify(InitInputData%WaveElevC0) + nullify(InitInputData%WaveTime) + if (allocated(InitInputData%WaveKinGridxi)) then + deallocate(InitInputData%WaveKinGridxi) + end if + if (allocated(InitInputData%WaveKinGridyi)) then + deallocate(InitInputData%WaveKinGridyi) + end if + if (allocated(InitInputData%WaveKinGridzi)) then + deallocate(InitInputData%WaveKinGridzi) + end if +end subroutine subroutine Waves2_PackInitInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -186,31 +181,22 @@ subroutine Waves2_PackInitInput(Buf, Indata) character(*), parameter :: RoutineName = 'Waves2_PackInitInput' logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return - ! Gravity call RegPack(Buf, InData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDens call RegPack(Buf, InData%WtrDens) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDpth call RegPack(Buf, InData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - ! NStepWave call RegPack(Buf, InData%NStepWave) if (RegCheckErr(Buf, RoutineName)) return - ! NStepWave2 call RegPack(Buf, InData%NStepWave2) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDOmega call RegPack(Buf, InData%WaveDOmega) if (RegCheckErr(Buf, RoutineName)) return - ! WaveStMod call RegPack(Buf, InData%WaveStMod) if (RegCheckErr(Buf, RoutineName)) return - ! WaveMultiDir call RegPack(Buf, InData%WaveMultiDir) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDirArr call RegPack(Buf, associated(InData%WaveDirArr)) if (associated(InData%WaveDirArr)) then call RegPackBounds(Buf, 1, lbound(InData%WaveDirArr), ubound(InData%WaveDirArr)) @@ -220,7 +206,6 @@ subroutine Waves2_PackInitInput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveElevC0 call RegPack(Buf, associated(InData%WaveElevC0)) if (associated(InData%WaveElevC0)) then call RegPackBounds(Buf, 2, lbound(InData%WaveElevC0), ubound(InData%WaveElevC0)) @@ -230,7 +215,6 @@ subroutine Waves2_PackInitInput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveTime call RegPack(Buf, associated(InData%WaveTime)) if (associated(InData%WaveTime)) then call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) @@ -240,52 +224,40 @@ subroutine Waves2_PackInitInput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! nGrid call RegPack(Buf, InData%nGrid) if (RegCheckErr(Buf, RoutineName)) return - ! NWaveElevGrid call RegPack(Buf, InData%NWaveElevGrid) if (RegCheckErr(Buf, RoutineName)) return - ! NWaveKinGrid call RegPack(Buf, InData%NWaveKinGrid) if (RegCheckErr(Buf, RoutineName)) return - ! WaveKinGridxi call RegPack(Buf, allocated(InData%WaveKinGridxi)) if (allocated(InData%WaveKinGridxi)) then call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridxi), ubound(InData%WaveKinGridxi)) call RegPack(Buf, InData%WaveKinGridxi) end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveKinGridyi call RegPack(Buf, allocated(InData%WaveKinGridyi)) if (allocated(InData%WaveKinGridyi)) then call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridyi), ubound(InData%WaveKinGridyi)) call RegPack(Buf, InData%WaveKinGridyi) end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveKinGridzi call RegPack(Buf, allocated(InData%WaveKinGridzi)) if (allocated(InData%WaveKinGridzi)) then call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridzi), ubound(InData%WaveKinGridzi)) call RegPack(Buf, InData%WaveKinGridzi) end if if (RegCheckErr(Buf, RoutineName)) return - ! WvDiffQTFF call RegPack(Buf, InData%WvDiffQTFF) if (RegCheckErr(Buf, RoutineName)) return - ! WvSumQTFF call RegPack(Buf, InData%WvSumQTFF) if (RegCheckErr(Buf, RoutineName)) return - ! WvLowCOffD call RegPack(Buf, InData%WvLowCOffD) if (RegCheckErr(Buf, RoutineName)) return - ! WvHiCOffD call RegPack(Buf, InData%WvHiCOffD) if (RegCheckErr(Buf, RoutineName)) return - ! WvLowCOffS call RegPack(Buf, InData%WvLowCOffS) if (RegCheckErr(Buf, RoutineName)) return - ! WvHiCOffS call RegPack(Buf, InData%WvHiCOffS) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -300,31 +272,22 @@ subroutine Waves2_UnPackInitInput(Buf, OutData) integer(IntKi) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return - ! Gravity call RegUnpack(Buf, OutData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDens call RegUnpack(Buf, OutData%WtrDens) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDpth call RegUnpack(Buf, OutData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - ! NStepWave call RegUnpack(Buf, OutData%NStepWave) if (RegCheckErr(Buf, RoutineName)) return - ! NStepWave2 call RegUnpack(Buf, OutData%NStepWave2) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDOmega call RegUnpack(Buf, OutData%WaveDOmega) if (RegCheckErr(Buf, RoutineName)) return - ! WaveStMod call RegUnpack(Buf, OutData%WaveStMod) if (RegCheckErr(Buf, RoutineName)) return - ! WaveMultiDir call RegUnpack(Buf, OutData%WaveMultiDir) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDirArr if (associated(OutData%WaveDirArr)) deallocate(OutData%WaveDirArr) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -349,7 +312,6 @@ subroutine Waves2_UnPackInitInput(Buf, OutData) else OutData%WaveDirArr => null() end if - ! WaveElevC0 if (associated(OutData%WaveElevC0)) deallocate(OutData%WaveElevC0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -374,7 +336,6 @@ subroutine Waves2_UnPackInitInput(Buf, OutData) else OutData%WaveElevC0 => null() end if - ! WaveTime if (associated(OutData%WaveTime)) deallocate(OutData%WaveTime) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -399,16 +360,12 @@ subroutine Waves2_UnPackInitInput(Buf, OutData) else OutData%WaveTime => null() end if - ! nGrid call RegUnpack(Buf, OutData%nGrid) if (RegCheckErr(Buf, RoutineName)) return - ! NWaveElevGrid call RegUnpack(Buf, OutData%NWaveElevGrid) if (RegCheckErr(Buf, RoutineName)) return - ! NWaveKinGrid call RegUnpack(Buf, OutData%NWaveKinGrid) if (RegCheckErr(Buf, RoutineName)) return - ! WaveKinGridxi if (allocated(OutData%WaveKinGridxi)) deallocate(OutData%WaveKinGridxi) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -423,7 +380,6 @@ subroutine Waves2_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%WaveKinGridxi) if (RegCheckErr(Buf, RoutineName)) return end if - ! WaveKinGridyi if (allocated(OutData%WaveKinGridyi)) deallocate(OutData%WaveKinGridyi) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -438,7 +394,6 @@ subroutine Waves2_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%WaveKinGridyi) if (RegCheckErr(Buf, RoutineName)) return end if - ! WaveKinGridzi if (allocated(OutData%WaveKinGridzi)) deallocate(OutData%WaveKinGridzi) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -453,197 +408,145 @@ subroutine Waves2_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%WaveKinGridzi) if (RegCheckErr(Buf, RoutineName)) return end if - ! WvDiffQTFF call RegUnpack(Buf, OutData%WvDiffQTFF) if (RegCheckErr(Buf, RoutineName)) return - ! WvSumQTFF call RegUnpack(Buf, OutData%WvSumQTFF) if (RegCheckErr(Buf, RoutineName)) return - ! WvLowCOffD call RegUnpack(Buf, OutData%WvLowCOffD) if (RegCheckErr(Buf, RoutineName)) return - ! WvHiCOffD call RegUnpack(Buf, OutData%WvHiCOffD) if (RegCheckErr(Buf, RoutineName)) return - ! WvLowCOffS call RegUnpack(Buf, OutData%WvLowCOffS) if (RegCheckErr(Buf, RoutineName)) return - ! WvHiCOffS call RegUnpack(Buf, OutData%WvHiCOffS) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Waves2_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Waves2_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(Waves2_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_CopyInitOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInitOutputData%WaveAcc2D)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveAcc2D,1) - i1_u = UBOUND(SrcInitOutputData%WaveAcc2D,1) - i2_l = LBOUND(SrcInitOutputData%WaveAcc2D,2) - i2_u = UBOUND(SrcInitOutputData%WaveAcc2D,2) - i3_l = LBOUND(SrcInitOutputData%WaveAcc2D,3) - i3_u = UBOUND(SrcInitOutputData%WaveAcc2D,3) - i4_l = LBOUND(SrcInitOutputData%WaveAcc2D,4) - i4_u = UBOUND(SrcInitOutputData%WaveAcc2D,4) - i5_l = LBOUND(SrcInitOutputData%WaveAcc2D,5) - i5_u = UBOUND(SrcInitOutputData%WaveAcc2D,5) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveAcc2D)) THEN - ALLOCATE(DstInitOutputData%WaveAcc2D(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveAcc2D.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveAcc2D = SrcInitOutputData%WaveAcc2D -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveDynP2D)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveDynP2D,1) - i1_u = UBOUND(SrcInitOutputData%WaveDynP2D,1) - i2_l = LBOUND(SrcInitOutputData%WaveDynP2D,2) - i2_u = UBOUND(SrcInitOutputData%WaveDynP2D,2) - i3_l = LBOUND(SrcInitOutputData%WaveDynP2D,3) - i3_u = UBOUND(SrcInitOutputData%WaveDynP2D,3) - i4_l = LBOUND(SrcInitOutputData%WaveDynP2D,4) - i4_u = UBOUND(SrcInitOutputData%WaveDynP2D,4) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveDynP2D)) THEN - ALLOCATE(DstInitOutputData%WaveDynP2D(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveDynP2D.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveDynP2D = SrcInitOutputData%WaveDynP2D -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveAcc2S)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveAcc2S,1) - i1_u = UBOUND(SrcInitOutputData%WaveAcc2S,1) - i2_l = LBOUND(SrcInitOutputData%WaveAcc2S,2) - i2_u = UBOUND(SrcInitOutputData%WaveAcc2S,2) - i3_l = LBOUND(SrcInitOutputData%WaveAcc2S,3) - i3_u = UBOUND(SrcInitOutputData%WaveAcc2S,3) - i4_l = LBOUND(SrcInitOutputData%WaveAcc2S,4) - i4_u = UBOUND(SrcInitOutputData%WaveAcc2S,4) - i5_l = LBOUND(SrcInitOutputData%WaveAcc2S,5) - i5_u = UBOUND(SrcInitOutputData%WaveAcc2S,5) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveAcc2S)) THEN - ALLOCATE(DstInitOutputData%WaveAcc2S(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveAcc2S.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveAcc2S = SrcInitOutputData%WaveAcc2S -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveDynP2S)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveDynP2S,1) - i1_u = UBOUND(SrcInitOutputData%WaveDynP2S,1) - i2_l = LBOUND(SrcInitOutputData%WaveDynP2S,2) - i2_u = UBOUND(SrcInitOutputData%WaveDynP2S,2) - i3_l = LBOUND(SrcInitOutputData%WaveDynP2S,3) - i3_u = UBOUND(SrcInitOutputData%WaveDynP2S,3) - i4_l = LBOUND(SrcInitOutputData%WaveDynP2S,4) - i4_u = UBOUND(SrcInitOutputData%WaveDynP2S,4) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveDynP2S)) THEN - ALLOCATE(DstInitOutputData%WaveDynP2S(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveDynP2S.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveDynP2S = SrcInitOutputData%WaveDynP2S -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveVel2D)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveVel2D,1) - i1_u = UBOUND(SrcInitOutputData%WaveVel2D,1) - i2_l = LBOUND(SrcInitOutputData%WaveVel2D,2) - i2_u = UBOUND(SrcInitOutputData%WaveVel2D,2) - i3_l = LBOUND(SrcInitOutputData%WaveVel2D,3) - i3_u = UBOUND(SrcInitOutputData%WaveVel2D,3) - i4_l = LBOUND(SrcInitOutputData%WaveVel2D,4) - i4_u = UBOUND(SrcInitOutputData%WaveVel2D,4) - i5_l = LBOUND(SrcInitOutputData%WaveVel2D,5) - i5_u = UBOUND(SrcInitOutputData%WaveVel2D,5) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveVel2D)) THEN - ALLOCATE(DstInitOutputData%WaveVel2D(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveVel2D.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveVel2D = SrcInitOutputData%WaveVel2D -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveVel2S)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveVel2S,1) - i1_u = UBOUND(SrcInitOutputData%WaveVel2S,1) - i2_l = LBOUND(SrcInitOutputData%WaveVel2S,2) - i2_u = UBOUND(SrcInitOutputData%WaveVel2S,2) - i3_l = LBOUND(SrcInitOutputData%WaveVel2S,3) - i3_u = UBOUND(SrcInitOutputData%WaveVel2S,3) - i4_l = LBOUND(SrcInitOutputData%WaveVel2S,4) - i4_u = UBOUND(SrcInitOutputData%WaveVel2S,4) - i5_l = LBOUND(SrcInitOutputData%WaveVel2S,5) - i5_u = UBOUND(SrcInitOutputData%WaveVel2S,5) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveVel2S)) THEN - ALLOCATE(DstInitOutputData%WaveVel2S(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveVel2S.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveVel2S = SrcInitOutputData%WaveVel2S -ENDIF - DstInitOutputData%WaveElev2 => SrcInitOutputData%WaveElev2 - END SUBROUTINE Waves2_CopyInitOutput - - SUBROUTINE Waves2_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(Waves2_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(InitOutputData%WaveAcc2D)) THEN - DEALLOCATE(InitOutputData%WaveAcc2D) -ENDIF -IF (ALLOCATED(InitOutputData%WaveDynP2D)) THEN - DEALLOCATE(InitOutputData%WaveDynP2D) -ENDIF -IF (ALLOCATED(InitOutputData%WaveAcc2S)) THEN - DEALLOCATE(InitOutputData%WaveAcc2S) -ENDIF -IF (ALLOCATED(InitOutputData%WaveDynP2S)) THEN - DEALLOCATE(InitOutputData%WaveDynP2S) -ENDIF -IF (ALLOCATED(InitOutputData%WaveVel2D)) THEN - DEALLOCATE(InitOutputData%WaveVel2D) -ENDIF -IF (ALLOCATED(InitOutputData%WaveVel2S)) THEN - DEALLOCATE(InitOutputData%WaveVel2S) -ENDIF -NULLIFY(InitOutputData%WaveElev2) - END SUBROUTINE Waves2_DestroyInitOutput +subroutine Waves2_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(Waves2_InitOutputType), intent(in) :: SrcInitOutputData + type(Waves2_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Waves2_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInitOutputData%WaveAcc2D)) then + LB(1:5) = lbound(SrcInitOutputData%WaveAcc2D) + UB(1:5) = ubound(SrcInitOutputData%WaveAcc2D) + if (.not. allocated(DstInitOutputData%WaveAcc2D)) then + allocate(DstInitOutputData%WaveAcc2D(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveAcc2D.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WaveAcc2D = SrcInitOutputData%WaveAcc2D + else if (allocated(DstInitOutputData%WaveAcc2D)) then + deallocate(DstInitOutputData%WaveAcc2D) + end if + if (allocated(SrcInitOutputData%WaveDynP2D)) then + LB(1:4) = lbound(SrcInitOutputData%WaveDynP2D) + UB(1:4) = ubound(SrcInitOutputData%WaveDynP2D) + if (.not. allocated(DstInitOutputData%WaveDynP2D)) then + allocate(DstInitOutputData%WaveDynP2D(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveDynP2D.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WaveDynP2D = SrcInitOutputData%WaveDynP2D + else if (allocated(DstInitOutputData%WaveDynP2D)) then + deallocate(DstInitOutputData%WaveDynP2D) + end if + if (allocated(SrcInitOutputData%WaveAcc2S)) then + LB(1:5) = lbound(SrcInitOutputData%WaveAcc2S) + UB(1:5) = ubound(SrcInitOutputData%WaveAcc2S) + if (.not. allocated(DstInitOutputData%WaveAcc2S)) then + allocate(DstInitOutputData%WaveAcc2S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveAcc2S.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WaveAcc2S = SrcInitOutputData%WaveAcc2S + else if (allocated(DstInitOutputData%WaveAcc2S)) then + deallocate(DstInitOutputData%WaveAcc2S) + end if + if (allocated(SrcInitOutputData%WaveDynP2S)) then + LB(1:4) = lbound(SrcInitOutputData%WaveDynP2S) + UB(1:4) = ubound(SrcInitOutputData%WaveDynP2S) + if (.not. allocated(DstInitOutputData%WaveDynP2S)) then + allocate(DstInitOutputData%WaveDynP2S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveDynP2S.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WaveDynP2S = SrcInitOutputData%WaveDynP2S + else if (allocated(DstInitOutputData%WaveDynP2S)) then + deallocate(DstInitOutputData%WaveDynP2S) + end if + if (allocated(SrcInitOutputData%WaveVel2D)) then + LB(1:5) = lbound(SrcInitOutputData%WaveVel2D) + UB(1:5) = ubound(SrcInitOutputData%WaveVel2D) + if (.not. allocated(DstInitOutputData%WaveVel2D)) then + allocate(DstInitOutputData%WaveVel2D(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveVel2D.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WaveVel2D = SrcInitOutputData%WaveVel2D + else if (allocated(DstInitOutputData%WaveVel2D)) then + deallocate(DstInitOutputData%WaveVel2D) + end if + if (allocated(SrcInitOutputData%WaveVel2S)) then + LB(1:5) = lbound(SrcInitOutputData%WaveVel2S) + UB(1:5) = ubound(SrcInitOutputData%WaveVel2S) + if (.not. allocated(DstInitOutputData%WaveVel2S)) then + allocate(DstInitOutputData%WaveVel2S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveVel2S.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WaveVel2S = SrcInitOutputData%WaveVel2S + else if (allocated(DstInitOutputData%WaveVel2S)) then + deallocate(DstInitOutputData%WaveVel2S) + end if + DstInitOutputData%WaveElev2 => SrcInitOutputData%WaveElev2 +end subroutine +subroutine Waves2_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(Waves2_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Waves2_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%WaveAcc2D)) then + deallocate(InitOutputData%WaveAcc2D) + end if + if (allocated(InitOutputData%WaveDynP2D)) then + deallocate(InitOutputData%WaveDynP2D) + end if + if (allocated(InitOutputData%WaveAcc2S)) then + deallocate(InitOutputData%WaveAcc2S) + end if + if (allocated(InitOutputData%WaveDynP2S)) then + deallocate(InitOutputData%WaveDynP2S) + end if + if (allocated(InitOutputData%WaveVel2D)) then + deallocate(InitOutputData%WaveVel2D) + end if + if (allocated(InitOutputData%WaveVel2S)) then + deallocate(InitOutputData%WaveVel2S) + end if + nullify(InitOutputData%WaveElev2) +end subroutine subroutine Waves2_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -651,49 +554,42 @@ subroutine Waves2_PackInitOutput(Buf, Indata) character(*), parameter :: RoutineName = 'Waves2_PackInitOutput' logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return - ! WaveAcc2D call RegPack(Buf, allocated(InData%WaveAcc2D)) if (allocated(InData%WaveAcc2D)) then call RegPackBounds(Buf, 5, lbound(InData%WaveAcc2D), ubound(InData%WaveAcc2D)) call RegPack(Buf, InData%WaveAcc2D) end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveDynP2D call RegPack(Buf, allocated(InData%WaveDynP2D)) if (allocated(InData%WaveDynP2D)) then call RegPackBounds(Buf, 4, lbound(InData%WaveDynP2D), ubound(InData%WaveDynP2D)) call RegPack(Buf, InData%WaveDynP2D) end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveAcc2S call RegPack(Buf, allocated(InData%WaveAcc2S)) if (allocated(InData%WaveAcc2S)) then call RegPackBounds(Buf, 5, lbound(InData%WaveAcc2S), ubound(InData%WaveAcc2S)) call RegPack(Buf, InData%WaveAcc2S) end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveDynP2S call RegPack(Buf, allocated(InData%WaveDynP2S)) if (allocated(InData%WaveDynP2S)) then call RegPackBounds(Buf, 4, lbound(InData%WaveDynP2S), ubound(InData%WaveDynP2S)) call RegPack(Buf, InData%WaveDynP2S) end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveVel2D call RegPack(Buf, allocated(InData%WaveVel2D)) if (allocated(InData%WaveVel2D)) then call RegPackBounds(Buf, 5, lbound(InData%WaveVel2D), ubound(InData%WaveVel2D)) call RegPack(Buf, InData%WaveVel2D) end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveVel2S call RegPack(Buf, allocated(InData%WaveVel2S)) if (allocated(InData%WaveVel2S)) then call RegPackBounds(Buf, 5, lbound(InData%WaveVel2S), ubound(InData%WaveVel2S)) call RegPack(Buf, InData%WaveVel2S) end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveElev2 call RegPack(Buf, associated(InData%WaveElev2)) if (associated(InData%WaveElev2)) then call RegPackBounds(Buf, 3, lbound(InData%WaveElev2), ubound(InData%WaveElev2)) @@ -715,7 +611,6 @@ subroutine Waves2_UnPackInitOutput(Buf, OutData) integer(IntKi) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return - ! WaveAcc2D if (allocated(OutData%WaveAcc2D)) deallocate(OutData%WaveAcc2D) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -730,7 +625,6 @@ subroutine Waves2_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WaveAcc2D) if (RegCheckErr(Buf, RoutineName)) return end if - ! WaveDynP2D if (allocated(OutData%WaveDynP2D)) deallocate(OutData%WaveDynP2D) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -745,7 +639,6 @@ subroutine Waves2_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WaveDynP2D) if (RegCheckErr(Buf, RoutineName)) return end if - ! WaveAcc2S if (allocated(OutData%WaveAcc2S)) deallocate(OutData%WaveAcc2S) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -760,7 +653,6 @@ subroutine Waves2_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WaveAcc2S) if (RegCheckErr(Buf, RoutineName)) return end if - ! WaveDynP2S if (allocated(OutData%WaveDynP2S)) deallocate(OutData%WaveDynP2S) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -775,7 +667,6 @@ subroutine Waves2_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WaveDynP2S) if (RegCheckErr(Buf, RoutineName)) return end if - ! WaveVel2D if (allocated(OutData%WaveVel2D)) deallocate(OutData%WaveVel2D) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -790,7 +681,6 @@ subroutine Waves2_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WaveVel2D) if (RegCheckErr(Buf, RoutineName)) return end if - ! WaveVel2S if (allocated(OutData%WaveVel2S)) deallocate(OutData%WaveVel2S) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -805,7 +695,6 @@ subroutine Waves2_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WaveVel2S) if (RegCheckErr(Buf, RoutineName)) return end if - ! WaveElev2 if (associated(OutData%WaveElev2)) deallocate(OutData%WaveElev2) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -831,49 +720,36 @@ subroutine Waves2_UnPackInitOutput(Buf, OutData) OutData%WaveElev2 => null() end if end subroutine - SUBROUTINE Waves2_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Waves2_ParameterType), INTENT(IN) :: SrcParamData - TYPE(Waves2_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%WvDiffQTFF = SrcParamData%WvDiffQTFF - DstParamData%WvSumQTFF = SrcParamData%WvSumQTFF - END SUBROUTINE Waves2_CopyParam - - SUBROUTINE Waves2_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(Waves2_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE Waves2_DestroyParam +subroutine Waves2_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(Waves2_ParameterType), intent(in) :: SrcParamData + type(Waves2_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Waves2_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%WvDiffQTFF = SrcParamData%WvDiffQTFF + DstParamData%WvSumQTFF = SrcParamData%WvSumQTFF +end subroutine +subroutine Waves2_DestroyParam(ParamData, ErrStat, ErrMsg) + type(Waves2_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Waves2_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine Waves2_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Waves2_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'Waves2_PackParam' if (Buf%ErrStat >= AbortErrLev) return - ! WvDiffQTFF call RegPack(Buf, InData%WvDiffQTFF) if (RegCheckErr(Buf, RoutineName)) return - ! WvSumQTFF call RegPack(Buf, InData%WvSumQTFF) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -883,10 +759,8 @@ subroutine Waves2_UnPackParam(Buf, OutData) type(Waves2_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Waves2_UnPackParam' if (Buf%ErrStat /= ErrID_None) return - ! WvDiffQTFF call RegUnpack(Buf, OutData%WvDiffQTFF) if (RegCheckErr(Buf, RoutineName)) return - ! WvSumQTFF call RegUnpack(Buf, OutData%WvSumQTFF) if (RegCheckErr(Buf, RoutineName)) return end subroutine diff --git a/modules/seastate/src/Waves_Types.f90 b/modules/seastate/src/Waves_Types.f90 index 71e3d448c3..e001e53cd6 100644 --- a/modules/seastate/src/Waves_Types.f90 +++ b/modules/seastate/src/Waves_Types.f90 @@ -110,320 +110,275 @@ MODULE Waves_Types END TYPE Waves_InitOutputType ! ======================= CONTAINS - SUBROUTINE Waves_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Waves_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(Waves_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFile = SrcInitInputData%InputFile - DstInitInputData%DirRoot = SrcInitInputData%DirRoot - DstInitInputData%WvKinFile = SrcInitInputData%WvKinFile - DstInitInputData%Gravity = SrcInitInputData%Gravity - DstInitInputData%nGrid = SrcInitInputData%nGrid - DstInitInputData%WvLowCOff = SrcInitInputData%WvLowCOff - DstInitInputData%WvHiCOff = SrcInitInputData%WvHiCOff - DstInitInputData%WaveDir = SrcInitInputData%WaveDir - DstInitInputData%WaveNDir = SrcInitInputData%WaveNDir - DstInitInputData%WaveMultiDir = SrcInitInputData%WaveMultiDir - DstInitInputData%WaveDirMod = SrcInitInputData%WaveDirMod - DstInitInputData%WaveDirSpread = SrcInitInputData%WaveDirSpread - DstInitInputData%WaveDirRange = SrcInitInputData%WaveDirRange - DstInitInputData%WaveDT = SrcInitInputData%WaveDT - DstInitInputData%WaveHs = SrcInitInputData%WaveHs - DstInitInputData%WaveMod = SrcInitInputData%WaveMod - DstInitInputData%WaveModChr = SrcInitInputData%WaveModChr - DstInitInputData%WaveNDAmp = SrcInitInputData%WaveNDAmp - DstInitInputData%WavePhase = SrcInitInputData%WavePhase - DstInitInputData%WavePkShp = SrcInitInputData%WavePkShp - DstInitInputData%WavePkShpChr = SrcInitInputData%WavePkShpChr - DstInitInputData%WaveSeed = SrcInitInputData%WaveSeed - DstInitInputData%WaveStMod = SrcInitInputData%WaveStMod - DstInitInputData%WaveTMax = SrcInitInputData%WaveTMax - DstInitInputData%WaveTp = SrcInitInputData%WaveTp - DstInitInputData%WtrDens = SrcInitInputData%WtrDens - DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth - DstInitInputData%NWaveElevGrid = SrcInitInputData%NWaveElevGrid - DstInitInputData%NWaveKinGrid = SrcInitInputData%NWaveKinGrid -IF (ALLOCATED(SrcInitInputData%WaveKinGridxi)) THEN - i1_l = LBOUND(SrcInitInputData%WaveKinGridxi,1) - i1_u = UBOUND(SrcInitInputData%WaveKinGridxi,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveKinGridxi)) THEN - ALLOCATE(DstInitInputData%WaveKinGridxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinGridxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveKinGridxi = SrcInitInputData%WaveKinGridxi -ENDIF -IF (ALLOCATED(SrcInitInputData%WaveKinGridyi)) THEN - i1_l = LBOUND(SrcInitInputData%WaveKinGridyi,1) - i1_u = UBOUND(SrcInitInputData%WaveKinGridyi,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveKinGridyi)) THEN - ALLOCATE(DstInitInputData%WaveKinGridyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinGridyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveKinGridyi = SrcInitInputData%WaveKinGridyi -ENDIF -IF (ALLOCATED(SrcInitInputData%WaveKinGridzi)) THEN - i1_l = LBOUND(SrcInitInputData%WaveKinGridzi,1) - i1_u = UBOUND(SrcInitInputData%WaveKinGridzi,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveKinGridzi)) THEN - ALLOCATE(DstInitInputData%WaveKinGridzi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinGridzi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveKinGridzi = SrcInitInputData%WaveKinGridzi -ENDIF -IF (ALLOCATED(SrcInitInputData%CurrVxi)) THEN - i1_l = LBOUND(SrcInitInputData%CurrVxi,1) - i1_u = UBOUND(SrcInitInputData%CurrVxi,1) - IF (.NOT. ALLOCATED(DstInitInputData%CurrVxi)) THEN - ALLOCATE(DstInitInputData%CurrVxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%CurrVxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%CurrVxi = SrcInitInputData%CurrVxi -ENDIF -IF (ALLOCATED(SrcInitInputData%CurrVyi)) THEN - i1_l = LBOUND(SrcInitInputData%CurrVyi,1) - i1_u = UBOUND(SrcInitInputData%CurrVyi,1) - IF (.NOT. ALLOCATED(DstInitInputData%CurrVyi)) THEN - ALLOCATE(DstInitInputData%CurrVyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%CurrVyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%CurrVyi = SrcInitInputData%CurrVyi -ENDIF - DstInitInputData%PCurrVxiPz0 = SrcInitInputData%PCurrVxiPz0 - DstInitInputData%PCurrVyiPz0 = SrcInitInputData%PCurrVyiPz0 - CALL NWTC_Library_Copynwtc_randomnumber_parametertype( SrcInitInputData%RNG, DstInitInputData%RNG, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitInputData%ConstWaveMod = SrcInitInputData%ConstWaveMod - DstInitInputData%CrestHmax = SrcInitInputData%CrestHmax - DstInitInputData%CrestTime = SrcInitInputData%CrestTime - DstInitInputData%CrestXi = SrcInitInputData%CrestXi - DstInitInputData%CrestYi = SrcInitInputData%CrestYi - DstInitInputData%MCFD = SrcInitInputData%MCFD - DstInitInputData%WaveFieldMod = SrcInitInputData%WaveFieldMod - DstInitInputData%PtfmLocationX = SrcInitInputData%PtfmLocationX - DstInitInputData%PtfmLocationY = SrcInitInputData%PtfmLocationY - END SUBROUTINE Waves_CopyInitInput - - SUBROUTINE Waves_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(Waves_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_DestroyInitInput' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitInputData%WaveKinGridxi)) THEN - DEALLOCATE(InitInputData%WaveKinGridxi) -ENDIF -IF (ALLOCATED(InitInputData%WaveKinGridyi)) THEN - DEALLOCATE(InitInputData%WaveKinGridyi) -ENDIF -IF (ALLOCATED(InitInputData%WaveKinGridzi)) THEN - DEALLOCATE(InitInputData%WaveKinGridzi) -ENDIF -IF (ALLOCATED(InitInputData%CurrVxi)) THEN - DEALLOCATE(InitInputData%CurrVxi) -ENDIF -IF (ALLOCATED(InitInputData%CurrVyi)) THEN - DEALLOCATE(InitInputData%CurrVyi) -ENDIF - CALL NWTC_Library_DestroyNWTC_RandomNumber_ParameterType( InitInputData%RNG, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE Waves_DestroyInitInput +subroutine Waves_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(Waves_InitInputType), intent(in) :: SrcInitInputData + type(Waves_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Waves_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%DirRoot = SrcInitInputData%DirRoot + DstInitInputData%WvKinFile = SrcInitInputData%WvKinFile + DstInitInputData%Gravity = SrcInitInputData%Gravity + DstInitInputData%nGrid = SrcInitInputData%nGrid + DstInitInputData%WvLowCOff = SrcInitInputData%WvLowCOff + DstInitInputData%WvHiCOff = SrcInitInputData%WvHiCOff + DstInitInputData%WaveDir = SrcInitInputData%WaveDir + DstInitInputData%WaveNDir = SrcInitInputData%WaveNDir + DstInitInputData%WaveMultiDir = SrcInitInputData%WaveMultiDir + DstInitInputData%WaveDirMod = SrcInitInputData%WaveDirMod + DstInitInputData%WaveDirSpread = SrcInitInputData%WaveDirSpread + DstInitInputData%WaveDirRange = SrcInitInputData%WaveDirRange + DstInitInputData%WaveDT = SrcInitInputData%WaveDT + DstInitInputData%WaveHs = SrcInitInputData%WaveHs + DstInitInputData%WaveMod = SrcInitInputData%WaveMod + DstInitInputData%WaveModChr = SrcInitInputData%WaveModChr + DstInitInputData%WaveNDAmp = SrcInitInputData%WaveNDAmp + DstInitInputData%WavePhase = SrcInitInputData%WavePhase + DstInitInputData%WavePkShp = SrcInitInputData%WavePkShp + DstInitInputData%WavePkShpChr = SrcInitInputData%WavePkShpChr + DstInitInputData%WaveSeed = SrcInitInputData%WaveSeed + DstInitInputData%WaveStMod = SrcInitInputData%WaveStMod + DstInitInputData%WaveTMax = SrcInitInputData%WaveTMax + DstInitInputData%WaveTp = SrcInitInputData%WaveTp + DstInitInputData%WtrDens = SrcInitInputData%WtrDens + DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth + DstInitInputData%NWaveElevGrid = SrcInitInputData%NWaveElevGrid + DstInitInputData%NWaveKinGrid = SrcInitInputData%NWaveKinGrid + if (allocated(SrcInitInputData%WaveKinGridxi)) then + LB(1:1) = lbound(SrcInitInputData%WaveKinGridxi) + UB(1:1) = ubound(SrcInitInputData%WaveKinGridxi) + if (.not. allocated(DstInitInputData%WaveKinGridxi)) then + allocate(DstInitInputData%WaveKinGridxi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinGridxi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%WaveKinGridxi = SrcInitInputData%WaveKinGridxi + else if (allocated(DstInitInputData%WaveKinGridxi)) then + deallocate(DstInitInputData%WaveKinGridxi) + end if + if (allocated(SrcInitInputData%WaveKinGridyi)) then + LB(1:1) = lbound(SrcInitInputData%WaveKinGridyi) + UB(1:1) = ubound(SrcInitInputData%WaveKinGridyi) + if (.not. allocated(DstInitInputData%WaveKinGridyi)) then + allocate(DstInitInputData%WaveKinGridyi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinGridyi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%WaveKinGridyi = SrcInitInputData%WaveKinGridyi + else if (allocated(DstInitInputData%WaveKinGridyi)) then + deallocate(DstInitInputData%WaveKinGridyi) + end if + if (allocated(SrcInitInputData%WaveKinGridzi)) then + LB(1:1) = lbound(SrcInitInputData%WaveKinGridzi) + UB(1:1) = ubound(SrcInitInputData%WaveKinGridzi) + if (.not. allocated(DstInitInputData%WaveKinGridzi)) then + allocate(DstInitInputData%WaveKinGridzi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinGridzi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%WaveKinGridzi = SrcInitInputData%WaveKinGridzi + else if (allocated(DstInitInputData%WaveKinGridzi)) then + deallocate(DstInitInputData%WaveKinGridzi) + end if + if (allocated(SrcInitInputData%CurrVxi)) then + LB(1:1) = lbound(SrcInitInputData%CurrVxi) + UB(1:1) = ubound(SrcInitInputData%CurrVxi) + if (.not. allocated(DstInitInputData%CurrVxi)) then + allocate(DstInitInputData%CurrVxi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%CurrVxi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%CurrVxi = SrcInitInputData%CurrVxi + else if (allocated(DstInitInputData%CurrVxi)) then + deallocate(DstInitInputData%CurrVxi) + end if + if (allocated(SrcInitInputData%CurrVyi)) then + LB(1:1) = lbound(SrcInitInputData%CurrVyi) + UB(1:1) = ubound(SrcInitInputData%CurrVyi) + if (.not. allocated(DstInitInputData%CurrVyi)) then + allocate(DstInitInputData%CurrVyi(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%CurrVyi.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%CurrVyi = SrcInitInputData%CurrVyi + else if (allocated(DstInitInputData%CurrVyi)) then + deallocate(DstInitInputData%CurrVyi) + end if + DstInitInputData%PCurrVxiPz0 = SrcInitInputData%PCurrVxiPz0 + DstInitInputData%PCurrVyiPz0 = SrcInitInputData%PCurrVyiPz0 + call NWTC_Library_CopyNWTC_RandomNumber_ParameterType(SrcInitInputData%RNG, DstInitInputData%RNG, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitInputData%ConstWaveMod = SrcInitInputData%ConstWaveMod + DstInitInputData%CrestHmax = SrcInitInputData%CrestHmax + DstInitInputData%CrestTime = SrcInitInputData%CrestTime + DstInitInputData%CrestXi = SrcInitInputData%CrestXi + DstInitInputData%CrestYi = SrcInitInputData%CrestYi + DstInitInputData%MCFD = SrcInitInputData%MCFD + DstInitInputData%WaveFieldMod = SrcInitInputData%WaveFieldMod + DstInitInputData%PtfmLocationX = SrcInitInputData%PtfmLocationX + DstInitInputData%PtfmLocationY = SrcInitInputData%PtfmLocationY +end subroutine +subroutine Waves_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(Waves_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Waves_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitInputData%WaveKinGridxi)) then + deallocate(InitInputData%WaveKinGridxi) + end if + if (allocated(InitInputData%WaveKinGridyi)) then + deallocate(InitInputData%WaveKinGridyi) + end if + if (allocated(InitInputData%WaveKinGridzi)) then + deallocate(InitInputData%WaveKinGridzi) + end if + if (allocated(InitInputData%CurrVxi)) then + deallocate(InitInputData%CurrVxi) + end if + if (allocated(InitInputData%CurrVyi)) then + deallocate(InitInputData%CurrVyi) + end if +end subroutine subroutine Waves_PackInitInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(Waves_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Waves_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return - ! InputFile call RegPack(Buf, InData%InputFile) if (RegCheckErr(Buf, RoutineName)) return - ! DirRoot call RegPack(Buf, InData%DirRoot) if (RegCheckErr(Buf, RoutineName)) return - ! WvKinFile call RegPack(Buf, InData%WvKinFile) if (RegCheckErr(Buf, RoutineName)) return - ! Gravity call RegPack(Buf, InData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - ! nGrid call RegPack(Buf, InData%nGrid) if (RegCheckErr(Buf, RoutineName)) return - ! WvLowCOff call RegPack(Buf, InData%WvLowCOff) if (RegCheckErr(Buf, RoutineName)) return - ! WvHiCOff call RegPack(Buf, InData%WvHiCOff) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDir call RegPack(Buf, InData%WaveDir) if (RegCheckErr(Buf, RoutineName)) return - ! WaveNDir call RegPack(Buf, InData%WaveNDir) if (RegCheckErr(Buf, RoutineName)) return - ! WaveMultiDir call RegPack(Buf, InData%WaveMultiDir) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDirMod call RegPack(Buf, InData%WaveDirMod) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDirSpread call RegPack(Buf, InData%WaveDirSpread) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDirRange call RegPack(Buf, InData%WaveDirRange) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDT call RegPack(Buf, InData%WaveDT) if (RegCheckErr(Buf, RoutineName)) return - ! WaveHs call RegPack(Buf, InData%WaveHs) if (RegCheckErr(Buf, RoutineName)) return - ! WaveMod call RegPack(Buf, InData%WaveMod) if (RegCheckErr(Buf, RoutineName)) return - ! WaveModChr call RegPack(Buf, InData%WaveModChr) if (RegCheckErr(Buf, RoutineName)) return - ! WaveNDAmp call RegPack(Buf, InData%WaveNDAmp) if (RegCheckErr(Buf, RoutineName)) return - ! WavePhase call RegPack(Buf, InData%WavePhase) if (RegCheckErr(Buf, RoutineName)) return - ! WavePkShp call RegPack(Buf, InData%WavePkShp) if (RegCheckErr(Buf, RoutineName)) return - ! WavePkShpChr call RegPack(Buf, InData%WavePkShpChr) if (RegCheckErr(Buf, RoutineName)) return - ! WaveSeed call RegPack(Buf, InData%WaveSeed) if (RegCheckErr(Buf, RoutineName)) return - ! WaveStMod call RegPack(Buf, InData%WaveStMod) if (RegCheckErr(Buf, RoutineName)) return - ! WaveTMax call RegPack(Buf, InData%WaveTMax) if (RegCheckErr(Buf, RoutineName)) return - ! WaveTp call RegPack(Buf, InData%WaveTp) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDens call RegPack(Buf, InData%WtrDens) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDpth call RegPack(Buf, InData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - ! NWaveElevGrid call RegPack(Buf, InData%NWaveElevGrid) if (RegCheckErr(Buf, RoutineName)) return - ! NWaveKinGrid call RegPack(Buf, InData%NWaveKinGrid) if (RegCheckErr(Buf, RoutineName)) return - ! WaveKinGridxi call RegPack(Buf, allocated(InData%WaveKinGridxi)) if (allocated(InData%WaveKinGridxi)) then call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridxi), ubound(InData%WaveKinGridxi)) call RegPack(Buf, InData%WaveKinGridxi) end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveKinGridyi call RegPack(Buf, allocated(InData%WaveKinGridyi)) if (allocated(InData%WaveKinGridyi)) then call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridyi), ubound(InData%WaveKinGridyi)) call RegPack(Buf, InData%WaveKinGridyi) end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveKinGridzi call RegPack(Buf, allocated(InData%WaveKinGridzi)) if (allocated(InData%WaveKinGridzi)) then call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridzi), ubound(InData%WaveKinGridzi)) call RegPack(Buf, InData%WaveKinGridzi) end if if (RegCheckErr(Buf, RoutineName)) return - ! CurrVxi call RegPack(Buf, allocated(InData%CurrVxi)) if (allocated(InData%CurrVxi)) then call RegPackBounds(Buf, 1, lbound(InData%CurrVxi), ubound(InData%CurrVxi)) call RegPack(Buf, InData%CurrVxi) end if if (RegCheckErr(Buf, RoutineName)) return - ! CurrVyi call RegPack(Buf, allocated(InData%CurrVyi)) if (allocated(InData%CurrVyi)) then call RegPackBounds(Buf, 1, lbound(InData%CurrVyi), ubound(InData%CurrVyi)) call RegPack(Buf, InData%CurrVyi) end if if (RegCheckErr(Buf, RoutineName)) return - ! PCurrVxiPz0 call RegPack(Buf, InData%PCurrVxiPz0) if (RegCheckErr(Buf, RoutineName)) return - ! PCurrVyiPz0 call RegPack(Buf, InData%PCurrVyiPz0) if (RegCheckErr(Buf, RoutineName)) return - ! RNG call NWTC_Library_PackNWTC_RandomNumber_ParameterType(Buf, InData%RNG) if (RegCheckErr(Buf, RoutineName)) return - ! ConstWaveMod call RegPack(Buf, InData%ConstWaveMod) if (RegCheckErr(Buf, RoutineName)) return - ! CrestHmax call RegPack(Buf, InData%CrestHmax) if (RegCheckErr(Buf, RoutineName)) return - ! CrestTime call RegPack(Buf, InData%CrestTime) if (RegCheckErr(Buf, RoutineName)) return - ! CrestXi call RegPack(Buf, InData%CrestXi) if (RegCheckErr(Buf, RoutineName)) return - ! CrestYi call RegPack(Buf, InData%CrestYi) if (RegCheckErr(Buf, RoutineName)) return - ! MCFD call RegPack(Buf, InData%MCFD) if (RegCheckErr(Buf, RoutineName)) return - ! WaveFieldMod call RegPack(Buf, InData%WaveFieldMod) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmLocationX call RegPack(Buf, InData%PtfmLocationX) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmLocationY call RegPack(Buf, InData%PtfmLocationY) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -436,94 +391,64 @@ subroutine Waves_UnPackInitInput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! InputFile call RegUnpack(Buf, OutData%InputFile) if (RegCheckErr(Buf, RoutineName)) return - ! DirRoot call RegUnpack(Buf, OutData%DirRoot) if (RegCheckErr(Buf, RoutineName)) return - ! WvKinFile call RegUnpack(Buf, OutData%WvKinFile) if (RegCheckErr(Buf, RoutineName)) return - ! Gravity call RegUnpack(Buf, OutData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - ! nGrid call RegUnpack(Buf, OutData%nGrid) if (RegCheckErr(Buf, RoutineName)) return - ! WvLowCOff call RegUnpack(Buf, OutData%WvLowCOff) if (RegCheckErr(Buf, RoutineName)) return - ! WvHiCOff call RegUnpack(Buf, OutData%WvHiCOff) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDir call RegUnpack(Buf, OutData%WaveDir) if (RegCheckErr(Buf, RoutineName)) return - ! WaveNDir call RegUnpack(Buf, OutData%WaveNDir) if (RegCheckErr(Buf, RoutineName)) return - ! WaveMultiDir call RegUnpack(Buf, OutData%WaveMultiDir) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDirMod call RegUnpack(Buf, OutData%WaveDirMod) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDirSpread call RegUnpack(Buf, OutData%WaveDirSpread) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDirRange call RegUnpack(Buf, OutData%WaveDirRange) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDT call RegUnpack(Buf, OutData%WaveDT) if (RegCheckErr(Buf, RoutineName)) return - ! WaveHs call RegUnpack(Buf, OutData%WaveHs) if (RegCheckErr(Buf, RoutineName)) return - ! WaveMod call RegUnpack(Buf, OutData%WaveMod) if (RegCheckErr(Buf, RoutineName)) return - ! WaveModChr call RegUnpack(Buf, OutData%WaveModChr) if (RegCheckErr(Buf, RoutineName)) return - ! WaveNDAmp call RegUnpack(Buf, OutData%WaveNDAmp) if (RegCheckErr(Buf, RoutineName)) return - ! WavePhase call RegUnpack(Buf, OutData%WavePhase) if (RegCheckErr(Buf, RoutineName)) return - ! WavePkShp call RegUnpack(Buf, OutData%WavePkShp) if (RegCheckErr(Buf, RoutineName)) return - ! WavePkShpChr call RegUnpack(Buf, OutData%WavePkShpChr) if (RegCheckErr(Buf, RoutineName)) return - ! WaveSeed call RegUnpack(Buf, OutData%WaveSeed) if (RegCheckErr(Buf, RoutineName)) return - ! WaveStMod call RegUnpack(Buf, OutData%WaveStMod) if (RegCheckErr(Buf, RoutineName)) return - ! WaveTMax call RegUnpack(Buf, OutData%WaveTMax) if (RegCheckErr(Buf, RoutineName)) return - ! WaveTp call RegUnpack(Buf, OutData%WaveTp) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDens call RegUnpack(Buf, OutData%WtrDens) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDpth call RegUnpack(Buf, OutData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - ! NWaveElevGrid call RegUnpack(Buf, OutData%NWaveElevGrid) if (RegCheckErr(Buf, RoutineName)) return - ! NWaveKinGrid call RegUnpack(Buf, OutData%NWaveKinGrid) if (RegCheckErr(Buf, RoutineName)) return - ! WaveKinGridxi if (allocated(OutData%WaveKinGridxi)) deallocate(OutData%WaveKinGridxi) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -538,7 +463,6 @@ subroutine Waves_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%WaveKinGridxi) if (RegCheckErr(Buf, RoutineName)) return end if - ! WaveKinGridyi if (allocated(OutData%WaveKinGridyi)) deallocate(OutData%WaveKinGridyi) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -553,7 +477,6 @@ subroutine Waves_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%WaveKinGridyi) if (RegCheckErr(Buf, RoutineName)) return end if - ! WaveKinGridzi if (allocated(OutData%WaveKinGridzi)) deallocate(OutData%WaveKinGridzi) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -568,7 +491,6 @@ subroutine Waves_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%WaveKinGridzi) if (RegCheckErr(Buf, RoutineName)) return end if - ! CurrVxi if (allocated(OutData%CurrVxi)) deallocate(OutData%CurrVxi) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -583,7 +505,6 @@ subroutine Waves_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%CurrVxi) if (RegCheckErr(Buf, RoutineName)) return end if - ! CurrVyi if (allocated(OutData%CurrVyi)) deallocate(OutData%CurrVyi) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -598,144 +519,118 @@ subroutine Waves_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%CurrVyi) if (RegCheckErr(Buf, RoutineName)) return end if - ! PCurrVxiPz0 call RegUnpack(Buf, OutData%PCurrVxiPz0) if (RegCheckErr(Buf, RoutineName)) return - ! PCurrVyiPz0 call RegUnpack(Buf, OutData%PCurrVyiPz0) if (RegCheckErr(Buf, RoutineName)) return - ! RNG call NWTC_Library_UnpackNWTC_RandomNumber_ParameterType(Buf, OutData%RNG) ! RNG - ! ConstWaveMod call RegUnpack(Buf, OutData%ConstWaveMod) if (RegCheckErr(Buf, RoutineName)) return - ! CrestHmax call RegUnpack(Buf, OutData%CrestHmax) if (RegCheckErr(Buf, RoutineName)) return - ! CrestTime call RegUnpack(Buf, OutData%CrestTime) if (RegCheckErr(Buf, RoutineName)) return - ! CrestXi call RegUnpack(Buf, OutData%CrestXi) if (RegCheckErr(Buf, RoutineName)) return - ! CrestYi call RegUnpack(Buf, OutData%CrestYi) if (RegCheckErr(Buf, RoutineName)) return - ! MCFD call RegUnpack(Buf, OutData%MCFD) if (RegCheckErr(Buf, RoutineName)) return - ! WaveFieldMod call RegUnpack(Buf, OutData%WaveFieldMod) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmLocationX call RegUnpack(Buf, OutData%PtfmLocationX) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmLocationY call RegUnpack(Buf, OutData%PtfmLocationY) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Waves_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Waves_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(Waves_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_CopyInitOutput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitOutputData%WaveElevC0 => SrcInitOutputData%WaveElevC0 -IF (ALLOCATED(SrcInitOutputData%WaveElevC)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveElevC,1) - i1_u = UBOUND(SrcInitOutputData%WaveElevC,1) - i2_l = LBOUND(SrcInitOutputData%WaveElevC,2) - i2_u = UBOUND(SrcInitOutputData%WaveElevC,2) - i3_l = LBOUND(SrcInitOutputData%WaveElevC,3) - i3_u = UBOUND(SrcInitOutputData%WaveElevC,3) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveElevC)) THEN - ALLOCATE(DstInitOutputData%WaveElevC(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveElevC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveElevC = SrcInitOutputData%WaveElevC -ENDIF - DstInitOutputData%WaveDirArr => SrcInitOutputData%WaveDirArr - DstInitOutputData%WaveDirMin = SrcInitOutputData%WaveDirMin - DstInitOutputData%WaveDirMax = SrcInitOutputData%WaveDirMax - DstInitOutputData%WaveNDir = SrcInitOutputData%WaveNDir - DstInitOutputData%WaveDOmega = SrcInitOutputData%WaveDOmega - DstInitOutputData%WaveDynP => SrcInitOutputData%WaveDynP - DstInitOutputData%WaveAcc => SrcInitOutputData%WaveAcc - DstInitOutputData%WaveAccMCF => SrcInitOutputData%WaveAccMCF - DstInitOutputData%WaveVel => SrcInitOutputData%WaveVel - DstInitOutputData%PWaveDynP0 => SrcInitOutputData%PWaveDynP0 - DstInitOutputData%PWaveAcc0 => SrcInitOutputData%PWaveAcc0 - DstInitOutputData%PWaveAccMCF0 => SrcInitOutputData%PWaveAccMCF0 - DstInitOutputData%PWaveVel0 => SrcInitOutputData%PWaveVel0 - DstInitOutputData%WaveElev => SrcInitOutputData%WaveElev -IF (ALLOCATED(SrcInitOutputData%WaveElev0)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveElev0,1) - i1_u = UBOUND(SrcInitOutputData%WaveElev0,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveElev0)) THEN - ALLOCATE(DstInitOutputData%WaveElev0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveElev0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveElev0 = SrcInitOutputData%WaveElev0 -ENDIF - DstInitOutputData%WaveTime => SrcInitOutputData%WaveTime - DstInitOutputData%WaveTMax = SrcInitOutputData%WaveTMax - DstInitOutputData%RhoXg = SrcInitOutputData%RhoXg - DstInitOutputData%NStepWave = SrcInitOutputData%NStepWave - DstInitOutputData%NStepWave2 = SrcInitOutputData%NStepWave2 - END SUBROUTINE Waves_CopyInitOutput - - SUBROUTINE Waves_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(Waves_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_DestroyInitOutput' - ErrStat = ErrID_None - ErrMsg = "" - -NULLIFY(InitOutputData%WaveElevC0) -IF (ALLOCATED(InitOutputData%WaveElevC)) THEN - DEALLOCATE(InitOutputData%WaveElevC) -ENDIF -NULLIFY(InitOutputData%WaveDirArr) -NULLIFY(InitOutputData%WaveDynP) -NULLIFY(InitOutputData%WaveAcc) -NULLIFY(InitOutputData%WaveAccMCF) -NULLIFY(InitOutputData%WaveVel) -NULLIFY(InitOutputData%PWaveDynP0) -NULLIFY(InitOutputData%PWaveAcc0) -NULLIFY(InitOutputData%PWaveAccMCF0) -NULLIFY(InitOutputData%PWaveVel0) -NULLIFY(InitOutputData%WaveElev) -IF (ALLOCATED(InitOutputData%WaveElev0)) THEN - DEALLOCATE(InitOutputData%WaveElev0) -ENDIF -NULLIFY(InitOutputData%WaveTime) - END SUBROUTINE Waves_DestroyInitOutput +subroutine Waves_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(Waves_InitOutputType), intent(in) :: SrcInitOutputData + type(Waves_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(5), UB(5) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'Waves_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitOutputData%WaveElevC0 => SrcInitOutputData%WaveElevC0 + if (allocated(SrcInitOutputData%WaveElevC)) then + LB(1:3) = lbound(SrcInitOutputData%WaveElevC) + UB(1:3) = ubound(SrcInitOutputData%WaveElevC) + if (.not. allocated(DstInitOutputData%WaveElevC)) then + allocate(DstInitOutputData%WaveElevC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveElevC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WaveElevC = SrcInitOutputData%WaveElevC + else if (allocated(DstInitOutputData%WaveElevC)) then + deallocate(DstInitOutputData%WaveElevC) + end if + DstInitOutputData%WaveDirArr => SrcInitOutputData%WaveDirArr + DstInitOutputData%WaveDirMin = SrcInitOutputData%WaveDirMin + DstInitOutputData%WaveDirMax = SrcInitOutputData%WaveDirMax + DstInitOutputData%WaveNDir = SrcInitOutputData%WaveNDir + DstInitOutputData%WaveDOmega = SrcInitOutputData%WaveDOmega + DstInitOutputData%WaveDynP => SrcInitOutputData%WaveDynP + DstInitOutputData%WaveAcc => SrcInitOutputData%WaveAcc + DstInitOutputData%WaveAccMCF => SrcInitOutputData%WaveAccMCF + DstInitOutputData%WaveVel => SrcInitOutputData%WaveVel + DstInitOutputData%PWaveDynP0 => SrcInitOutputData%PWaveDynP0 + DstInitOutputData%PWaveAcc0 => SrcInitOutputData%PWaveAcc0 + DstInitOutputData%PWaveAccMCF0 => SrcInitOutputData%PWaveAccMCF0 + DstInitOutputData%PWaveVel0 => SrcInitOutputData%PWaveVel0 + DstInitOutputData%WaveElev => SrcInitOutputData%WaveElev + if (allocated(SrcInitOutputData%WaveElev0)) then + LB(1:1) = lbound(SrcInitOutputData%WaveElev0) + UB(1:1) = ubound(SrcInitOutputData%WaveElev0) + if (.not. allocated(DstInitOutputData%WaveElev0)) then + allocate(DstInitOutputData%WaveElev0(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveElev0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WaveElev0 = SrcInitOutputData%WaveElev0 + else if (allocated(DstInitOutputData%WaveElev0)) then + deallocate(DstInitOutputData%WaveElev0) + end if + DstInitOutputData%WaveTime => SrcInitOutputData%WaveTime + DstInitOutputData%WaveTMax = SrcInitOutputData%WaveTMax + DstInitOutputData%RhoXg = SrcInitOutputData%RhoXg + DstInitOutputData%NStepWave = SrcInitOutputData%NStepWave + DstInitOutputData%NStepWave2 = SrcInitOutputData%NStepWave2 +end subroutine +subroutine Waves_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(Waves_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Waves_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + nullify(InitOutputData%WaveElevC0) + if (allocated(InitOutputData%WaveElevC)) then + deallocate(InitOutputData%WaveElevC) + end if + nullify(InitOutputData%WaveDirArr) + nullify(InitOutputData%WaveDynP) + nullify(InitOutputData%WaveAcc) + nullify(InitOutputData%WaveAccMCF) + nullify(InitOutputData%WaveVel) + nullify(InitOutputData%PWaveDynP0) + nullify(InitOutputData%PWaveAcc0) + nullify(InitOutputData%PWaveAccMCF0) + nullify(InitOutputData%PWaveVel0) + nullify(InitOutputData%WaveElev) + if (allocated(InitOutputData%WaveElev0)) then + deallocate(InitOutputData%WaveElev0) + end if + nullify(InitOutputData%WaveTime) +end subroutine subroutine Waves_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -743,7 +638,6 @@ subroutine Waves_PackInitOutput(Buf, Indata) character(*), parameter :: RoutineName = 'Waves_PackInitOutput' logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return - ! WaveElevC0 call RegPack(Buf, associated(InData%WaveElevC0)) if (associated(InData%WaveElevC0)) then call RegPackBounds(Buf, 2, lbound(InData%WaveElevC0), ubound(InData%WaveElevC0)) @@ -753,14 +647,12 @@ subroutine Waves_PackInitOutput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveElevC call RegPack(Buf, allocated(InData%WaveElevC)) if (allocated(InData%WaveElevC)) then call RegPackBounds(Buf, 3, lbound(InData%WaveElevC), ubound(InData%WaveElevC)) call RegPack(Buf, InData%WaveElevC) end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveDirArr call RegPack(Buf, associated(InData%WaveDirArr)) if (associated(InData%WaveDirArr)) then call RegPackBounds(Buf, 1, lbound(InData%WaveDirArr), ubound(InData%WaveDirArr)) @@ -770,19 +662,14 @@ subroutine Waves_PackInitOutput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveDirMin call RegPack(Buf, InData%WaveDirMin) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDirMax call RegPack(Buf, InData%WaveDirMax) if (RegCheckErr(Buf, RoutineName)) return - ! WaveNDir call RegPack(Buf, InData%WaveNDir) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDOmega call RegPack(Buf, InData%WaveDOmega) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDynP call RegPack(Buf, associated(InData%WaveDynP)) if (associated(InData%WaveDynP)) then call RegPackBounds(Buf, 4, lbound(InData%WaveDynP), ubound(InData%WaveDynP)) @@ -792,7 +679,6 @@ subroutine Waves_PackInitOutput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveAcc call RegPack(Buf, associated(InData%WaveAcc)) if (associated(InData%WaveAcc)) then call RegPackBounds(Buf, 5, lbound(InData%WaveAcc), ubound(InData%WaveAcc)) @@ -802,7 +688,6 @@ subroutine Waves_PackInitOutput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveAccMCF call RegPack(Buf, associated(InData%WaveAccMCF)) if (associated(InData%WaveAccMCF)) then call RegPackBounds(Buf, 5, lbound(InData%WaveAccMCF), ubound(InData%WaveAccMCF)) @@ -812,7 +697,6 @@ subroutine Waves_PackInitOutput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveVel call RegPack(Buf, associated(InData%WaveVel)) if (associated(InData%WaveVel)) then call RegPackBounds(Buf, 5, lbound(InData%WaveVel), ubound(InData%WaveVel)) @@ -822,7 +706,6 @@ subroutine Waves_PackInitOutput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! PWaveDynP0 call RegPack(Buf, associated(InData%PWaveDynP0)) if (associated(InData%PWaveDynP0)) then call RegPackBounds(Buf, 3, lbound(InData%PWaveDynP0), ubound(InData%PWaveDynP0)) @@ -832,7 +715,6 @@ subroutine Waves_PackInitOutput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! PWaveAcc0 call RegPack(Buf, associated(InData%PWaveAcc0)) if (associated(InData%PWaveAcc0)) then call RegPackBounds(Buf, 4, lbound(InData%PWaveAcc0), ubound(InData%PWaveAcc0)) @@ -842,7 +724,6 @@ subroutine Waves_PackInitOutput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! PWaveAccMCF0 call RegPack(Buf, associated(InData%PWaveAccMCF0)) if (associated(InData%PWaveAccMCF0)) then call RegPackBounds(Buf, 4, lbound(InData%PWaveAccMCF0), ubound(InData%PWaveAccMCF0)) @@ -852,7 +733,6 @@ subroutine Waves_PackInitOutput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! PWaveVel0 call RegPack(Buf, associated(InData%PWaveVel0)) if (associated(InData%PWaveVel0)) then call RegPackBounds(Buf, 4, lbound(InData%PWaveVel0), ubound(InData%PWaveVel0)) @@ -862,7 +742,6 @@ subroutine Waves_PackInitOutput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveElev call RegPack(Buf, associated(InData%WaveElev)) if (associated(InData%WaveElev)) then call RegPackBounds(Buf, 3, lbound(InData%WaveElev), ubound(InData%WaveElev)) @@ -872,14 +751,12 @@ subroutine Waves_PackInitOutput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveElev0 call RegPack(Buf, allocated(InData%WaveElev0)) if (allocated(InData%WaveElev0)) then call RegPackBounds(Buf, 1, lbound(InData%WaveElev0), ubound(InData%WaveElev0)) call RegPack(Buf, InData%WaveElev0) end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveTime call RegPack(Buf, associated(InData%WaveTime)) if (associated(InData%WaveTime)) then call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) @@ -889,16 +766,12 @@ subroutine Waves_PackInitOutput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! WaveTMax call RegPack(Buf, InData%WaveTMax) if (RegCheckErr(Buf, RoutineName)) return - ! RhoXg call RegPack(Buf, InData%RhoXg) if (RegCheckErr(Buf, RoutineName)) return - ! NStepWave call RegPack(Buf, InData%NStepWave) if (RegCheckErr(Buf, RoutineName)) return - ! NStepWave2 call RegPack(Buf, InData%NStepWave2) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -913,7 +786,6 @@ subroutine Waves_UnPackInitOutput(Buf, OutData) integer(IntKi) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return - ! WaveElevC0 if (associated(OutData%WaveElevC0)) deallocate(OutData%WaveElevC0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -938,7 +810,6 @@ subroutine Waves_UnPackInitOutput(Buf, OutData) else OutData%WaveElevC0 => null() end if - ! WaveElevC if (allocated(OutData%WaveElevC)) deallocate(OutData%WaveElevC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -953,7 +824,6 @@ subroutine Waves_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WaveElevC) if (RegCheckErr(Buf, RoutineName)) return end if - ! WaveDirArr if (associated(OutData%WaveDirArr)) deallocate(OutData%WaveDirArr) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -978,19 +848,14 @@ subroutine Waves_UnPackInitOutput(Buf, OutData) else OutData%WaveDirArr => null() end if - ! WaveDirMin call RegUnpack(Buf, OutData%WaveDirMin) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDirMax call RegUnpack(Buf, OutData%WaveDirMax) if (RegCheckErr(Buf, RoutineName)) return - ! WaveNDir call RegUnpack(Buf, OutData%WaveNDir) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDOmega call RegUnpack(Buf, OutData%WaveDOmega) if (RegCheckErr(Buf, RoutineName)) return - ! WaveDynP if (associated(OutData%WaveDynP)) deallocate(OutData%WaveDynP) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1015,7 +880,6 @@ subroutine Waves_UnPackInitOutput(Buf, OutData) else OutData%WaveDynP => null() end if - ! WaveAcc if (associated(OutData%WaveAcc)) deallocate(OutData%WaveAcc) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1040,7 +904,6 @@ subroutine Waves_UnPackInitOutput(Buf, OutData) else OutData%WaveAcc => null() end if - ! WaveAccMCF if (associated(OutData%WaveAccMCF)) deallocate(OutData%WaveAccMCF) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1065,7 +928,6 @@ subroutine Waves_UnPackInitOutput(Buf, OutData) else OutData%WaveAccMCF => null() end if - ! WaveVel if (associated(OutData%WaveVel)) deallocate(OutData%WaveVel) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1090,7 +952,6 @@ subroutine Waves_UnPackInitOutput(Buf, OutData) else OutData%WaveVel => null() end if - ! PWaveDynP0 if (associated(OutData%PWaveDynP0)) deallocate(OutData%PWaveDynP0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1115,7 +976,6 @@ subroutine Waves_UnPackInitOutput(Buf, OutData) else OutData%PWaveDynP0 => null() end if - ! PWaveAcc0 if (associated(OutData%PWaveAcc0)) deallocate(OutData%PWaveAcc0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1140,7 +1000,6 @@ subroutine Waves_UnPackInitOutput(Buf, OutData) else OutData%PWaveAcc0 => null() end if - ! PWaveAccMCF0 if (associated(OutData%PWaveAccMCF0)) deallocate(OutData%PWaveAccMCF0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1165,7 +1024,6 @@ subroutine Waves_UnPackInitOutput(Buf, OutData) else OutData%PWaveAccMCF0 => null() end if - ! PWaveVel0 if (associated(OutData%PWaveVel0)) deallocate(OutData%PWaveVel0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1190,7 +1048,6 @@ subroutine Waves_UnPackInitOutput(Buf, OutData) else OutData%PWaveVel0 => null() end if - ! WaveElev if (associated(OutData%WaveElev)) deallocate(OutData%WaveElev) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1215,7 +1072,6 @@ subroutine Waves_UnPackInitOutput(Buf, OutData) else OutData%WaveElev => null() end if - ! WaveElev0 if (allocated(OutData%WaveElev0)) deallocate(OutData%WaveElev0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1230,7 +1086,6 @@ subroutine Waves_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WaveElev0) if (RegCheckErr(Buf, RoutineName)) return end if - ! WaveTime if (associated(OutData%WaveTime)) deallocate(OutData%WaveTime) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1255,16 +1110,12 @@ subroutine Waves_UnPackInitOutput(Buf, OutData) else OutData%WaveTime => null() end if - ! WaveTMax call RegUnpack(Buf, OutData%WaveTMax) if (RegCheckErr(Buf, RoutineName)) return - ! RhoXg call RegUnpack(Buf, OutData%RhoXg) if (RegCheckErr(Buf, RoutineName)) return - ! NStepWave call RegUnpack(Buf, OutData%NStepWave) if (RegCheckErr(Buf, RoutineName)) return - ! NStepWave2 call RegUnpack(Buf, OutData%NStepWave2) if (RegCheckErr(Buf, RoutineName)) return end subroutine diff --git a/modules/servodyn/src/ServoDyn_Types.f90 b/modules/servodyn/src/ServoDyn_Types.f90 index d999f6a2e8..8b9e660860 100644 --- a/modules/servodyn/src/ServoDyn_Types.f90 +++ b/modules/servodyn/src/ServoDyn_Types.f90 @@ -577,464 +577,418 @@ MODULE ServoDyn_Types END TYPE SrvD_OutputType ! ======================= CONTAINS - SUBROUTINE SrvD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SrvD_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(SrvD_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFile = SrcInitInputData%InputFile - DstInitInputData%Linearize = SrcInitInputData%Linearize - DstInitInputData%NumBl = SrcInitInputData%NumBl - DstInitInputData%RootName = SrcInitInputData%RootName -IF (ALLOCATED(SrcInitInputData%BlPitchInit)) THEN - i1_l = LBOUND(SrcInitInputData%BlPitchInit,1) - i1_u = UBOUND(SrcInitInputData%BlPitchInit,1) - IF (.NOT. ALLOCATED(DstInitInputData%BlPitchInit)) THEN - ALLOCATE(DstInitInputData%BlPitchInit(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BlPitchInit.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%BlPitchInit = SrcInitInputData%BlPitchInit -ENDIF - DstInitInputData%Gravity = SrcInitInputData%Gravity - DstInitInputData%NacRefPos = SrcInitInputData%NacRefPos - DstInitInputData%NacTransDisp = SrcInitInputData%NacTransDisp - DstInitInputData%NacOrient = SrcInitInputData%NacOrient - DstInitInputData%NacRefOrient = SrcInitInputData%NacRefOrient - DstInitInputData%TwrBaseRefPos = SrcInitInputData%TwrBaseRefPos - DstInitInputData%TwrBaseTransDisp = SrcInitInputData%TwrBaseTransDisp - DstInitInputData%TwrBaseOrient = SrcInitInputData%TwrBaseOrient - DstInitInputData%TwrBaseRefOrient = SrcInitInputData%TwrBaseRefOrient - DstInitInputData%PtfmRefPos = SrcInitInputData%PtfmRefPos - DstInitInputData%PtfmTransDisp = SrcInitInputData%PtfmTransDisp - DstInitInputData%PtfmOrient = SrcInitInputData%PtfmOrient - DstInitInputData%PtfmRefOrient = SrcInitInputData%PtfmRefOrient - DstInitInputData%Tmax = SrcInitInputData%Tmax - DstInitInputData%AvgWindSpeed = SrcInitInputData%AvgWindSpeed - DstInitInputData%AirDens = SrcInitInputData%AirDens - DstInitInputData%NumSC2CtrlGlob = SrcInitInputData%NumSC2CtrlGlob - DstInitInputData%NumSC2Ctrl = SrcInitInputData%NumSC2Ctrl - DstInitInputData%NumCtrl2SC = SrcInitInputData%NumCtrl2SC - DstInitInputData%TrimCase = SrcInitInputData%TrimCase - DstInitInputData%TrimGain = SrcInitInputData%TrimGain - DstInitInputData%RotSpeedRef = SrcInitInputData%RotSpeedRef -IF (ALLOCATED(SrcInitInputData%BladeRootRefPos)) THEN - i1_l = LBOUND(SrcInitInputData%BladeRootRefPos,1) - i1_u = UBOUND(SrcInitInputData%BladeRootRefPos,1) - i2_l = LBOUND(SrcInitInputData%BladeRootRefPos,2) - i2_u = UBOUND(SrcInitInputData%BladeRootRefPos,2) - IF (.NOT. ALLOCATED(DstInitInputData%BladeRootRefPos)) THEN - ALLOCATE(DstInitInputData%BladeRootRefPos(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BladeRootRefPos.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%BladeRootRefPos = SrcInitInputData%BladeRootRefPos -ENDIF -IF (ALLOCATED(SrcInitInputData%BladeRootTransDisp)) THEN - i1_l = LBOUND(SrcInitInputData%BladeRootTransDisp,1) - i1_u = UBOUND(SrcInitInputData%BladeRootTransDisp,1) - i2_l = LBOUND(SrcInitInputData%BladeRootTransDisp,2) - i2_u = UBOUND(SrcInitInputData%BladeRootTransDisp,2) - IF (.NOT. ALLOCATED(DstInitInputData%BladeRootTransDisp)) THEN - ALLOCATE(DstInitInputData%BladeRootTransDisp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BladeRootTransDisp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%BladeRootTransDisp = SrcInitInputData%BladeRootTransDisp -ENDIF -IF (ALLOCATED(SrcInitInputData%BladeRootOrient)) THEN - i1_l = LBOUND(SrcInitInputData%BladeRootOrient,1) - i1_u = UBOUND(SrcInitInputData%BladeRootOrient,1) - i2_l = LBOUND(SrcInitInputData%BladeRootOrient,2) - i2_u = UBOUND(SrcInitInputData%BladeRootOrient,2) - i3_l = LBOUND(SrcInitInputData%BladeRootOrient,3) - i3_u = UBOUND(SrcInitInputData%BladeRootOrient,3) - IF (.NOT. ALLOCATED(DstInitInputData%BladeRootOrient)) THEN - ALLOCATE(DstInitInputData%BladeRootOrient(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BladeRootOrient.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%BladeRootOrient = SrcInitInputData%BladeRootOrient -ENDIF -IF (ALLOCATED(SrcInitInputData%BladeRootRefOrient)) THEN - i1_l = LBOUND(SrcInitInputData%BladeRootRefOrient,1) - i1_u = UBOUND(SrcInitInputData%BladeRootRefOrient,1) - i2_l = LBOUND(SrcInitInputData%BladeRootRefOrient,2) - i2_u = UBOUND(SrcInitInputData%BladeRootRefOrient,2) - i3_l = LBOUND(SrcInitInputData%BladeRootRefOrient,3) - i3_u = UBOUND(SrcInitInputData%BladeRootRefOrient,3) - IF (.NOT. ALLOCATED(DstInitInputData%BladeRootRefOrient)) THEN - ALLOCATE(DstInitInputData%BladeRootRefOrient(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BladeRootRefOrient.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%BladeRootRefOrient = SrcInitInputData%BladeRootRefOrient -ENDIF - DstInitInputData%UseInputFile = SrcInitInputData%UseInputFile - CALL NWTC_Library_Copyfileinfotype( SrcInitInputData%PassedPrimaryInputData, DstInitInputData%PassedPrimaryInputData, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitInputData%NumCableControl = SrcInitInputData%NumCableControl -IF (ALLOCATED(SrcInitInputData%CableControlRequestor)) THEN - i1_l = LBOUND(SrcInitInputData%CableControlRequestor,1) - i1_u = UBOUND(SrcInitInputData%CableControlRequestor,1) - IF (.NOT. ALLOCATED(DstInitInputData%CableControlRequestor)) THEN - ALLOCATE(DstInitInputData%CableControlRequestor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%CableControlRequestor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%CableControlRequestor = SrcInitInputData%CableControlRequestor -ENDIF - DstInitInputData%InterpOrder = SrcInitInputData%InterpOrder -IF (ALLOCATED(SrcInitInputData%fromSCGlob)) THEN - i1_l = LBOUND(SrcInitInputData%fromSCGlob,1) - i1_u = UBOUND(SrcInitInputData%fromSCGlob,1) - IF (.NOT. ALLOCATED(DstInitInputData%fromSCGlob)) THEN - ALLOCATE(DstInitInputData%fromSCGlob(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%fromSCGlob.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%fromSCGlob = SrcInitInputData%fromSCGlob -ENDIF -IF (ALLOCATED(SrcInitInputData%fromSC)) THEN - i1_l = LBOUND(SrcInitInputData%fromSC,1) - i1_u = UBOUND(SrcInitInputData%fromSC,1) - IF (.NOT. ALLOCATED(DstInitInputData%fromSC)) THEN - ALLOCATE(DstInitInputData%fromSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%fromSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%fromSC = SrcInitInputData%fromSC -ENDIF -IF (ALLOCATED(SrcInitInputData%LidSpeed)) THEN - i1_l = LBOUND(SrcInitInputData%LidSpeed,1) - i1_u = UBOUND(SrcInitInputData%LidSpeed,1) - IF (.NOT. ALLOCATED(DstInitInputData%LidSpeed)) THEN - ALLOCATE(DstInitInputData%LidSpeed(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%LidSpeed.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%LidSpeed = SrcInitInputData%LidSpeed -ENDIF -IF (ALLOCATED(SrcInitInputData%MsrPositionsX)) THEN - i1_l = LBOUND(SrcInitInputData%MsrPositionsX,1) - i1_u = UBOUND(SrcInitInputData%MsrPositionsX,1) - IF (.NOT. ALLOCATED(DstInitInputData%MsrPositionsX)) THEN - ALLOCATE(DstInitInputData%MsrPositionsX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%MsrPositionsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%MsrPositionsX = SrcInitInputData%MsrPositionsX -ENDIF -IF (ALLOCATED(SrcInitInputData%MsrPositionsY)) THEN - i1_l = LBOUND(SrcInitInputData%MsrPositionsY,1) - i1_u = UBOUND(SrcInitInputData%MsrPositionsY,1) - IF (.NOT. ALLOCATED(DstInitInputData%MsrPositionsY)) THEN - ALLOCATE(DstInitInputData%MsrPositionsY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%MsrPositionsY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%MsrPositionsY = SrcInitInputData%MsrPositionsY -ENDIF -IF (ALLOCATED(SrcInitInputData%MsrPositionsZ)) THEN - i1_l = LBOUND(SrcInitInputData%MsrPositionsZ,1) - i1_u = UBOUND(SrcInitInputData%MsrPositionsZ,1) - IF (.NOT. ALLOCATED(DstInitInputData%MsrPositionsZ)) THEN - ALLOCATE(DstInitInputData%MsrPositionsZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%MsrPositionsZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%MsrPositionsZ = SrcInitInputData%MsrPositionsZ -ENDIF - DstInitInputData%SensorType = SrcInitInputData%SensorType - DstInitInputData%NumBeam = SrcInitInputData%NumBeam - DstInitInputData%NumPulseGate = SrcInitInputData%NumPulseGate - DstInitInputData%PulseSpacing = SrcInitInputData%PulseSpacing - DstInitInputData%URefLid = SrcInitInputData%URefLid - END SUBROUTINE SrvD_CopyInitInput - - SUBROUTINE SrvD_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(SrvD_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyInitInput' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitInputData%BlPitchInit)) THEN - DEALLOCATE(InitInputData%BlPitchInit) -ENDIF -IF (ALLOCATED(InitInputData%BladeRootRefPos)) THEN - DEALLOCATE(InitInputData%BladeRootRefPos) -ENDIF -IF (ALLOCATED(InitInputData%BladeRootTransDisp)) THEN - DEALLOCATE(InitInputData%BladeRootTransDisp) -ENDIF -IF (ALLOCATED(InitInputData%BladeRootOrient)) THEN - DEALLOCATE(InitInputData%BladeRootOrient) -ENDIF -IF (ALLOCATED(InitInputData%BladeRootRefOrient)) THEN - DEALLOCATE(InitInputData%BladeRootRefOrient) -ENDIF - CALL NWTC_Library_DestroyFileInfoType( InitInputData%PassedPrimaryInputData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitInputData%CableControlRequestor)) THEN - DEALLOCATE(InitInputData%CableControlRequestor) -ENDIF -IF (ALLOCATED(InitInputData%fromSCGlob)) THEN - DEALLOCATE(InitInputData%fromSCGlob) -ENDIF -IF (ALLOCATED(InitInputData%fromSC)) THEN - DEALLOCATE(InitInputData%fromSC) -ENDIF -IF (ALLOCATED(InitInputData%LidSpeed)) THEN - DEALLOCATE(InitInputData%LidSpeed) -ENDIF -IF (ALLOCATED(InitInputData%MsrPositionsX)) THEN - DEALLOCATE(InitInputData%MsrPositionsX) -ENDIF -IF (ALLOCATED(InitInputData%MsrPositionsY)) THEN - DEALLOCATE(InitInputData%MsrPositionsY) -ENDIF -IF (ALLOCATED(InitInputData%MsrPositionsZ)) THEN - DEALLOCATE(InitInputData%MsrPositionsZ) -ENDIF - END SUBROUTINE SrvD_DestroyInitInput +subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(SrvD_InitInputType), intent(in) :: SrcInitInputData + type(SrvD_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%Linearize = SrcInitInputData%Linearize + DstInitInputData%NumBl = SrcInitInputData%NumBl + DstInitInputData%RootName = SrcInitInputData%RootName + if (allocated(SrcInitInputData%BlPitchInit)) then + LB(1:1) = lbound(SrcInitInputData%BlPitchInit) + UB(1:1) = ubound(SrcInitInputData%BlPitchInit) + if (.not. allocated(DstInitInputData%BlPitchInit)) then + allocate(DstInitInputData%BlPitchInit(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BlPitchInit.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%BlPitchInit = SrcInitInputData%BlPitchInit + else if (allocated(DstInitInputData%BlPitchInit)) then + deallocate(DstInitInputData%BlPitchInit) + end if + DstInitInputData%Gravity = SrcInitInputData%Gravity + DstInitInputData%NacRefPos = SrcInitInputData%NacRefPos + DstInitInputData%NacTransDisp = SrcInitInputData%NacTransDisp + DstInitInputData%NacOrient = SrcInitInputData%NacOrient + DstInitInputData%NacRefOrient = SrcInitInputData%NacRefOrient + DstInitInputData%TwrBaseRefPos = SrcInitInputData%TwrBaseRefPos + DstInitInputData%TwrBaseTransDisp = SrcInitInputData%TwrBaseTransDisp + DstInitInputData%TwrBaseOrient = SrcInitInputData%TwrBaseOrient + DstInitInputData%TwrBaseRefOrient = SrcInitInputData%TwrBaseRefOrient + DstInitInputData%PtfmRefPos = SrcInitInputData%PtfmRefPos + DstInitInputData%PtfmTransDisp = SrcInitInputData%PtfmTransDisp + DstInitInputData%PtfmOrient = SrcInitInputData%PtfmOrient + DstInitInputData%PtfmRefOrient = SrcInitInputData%PtfmRefOrient + DstInitInputData%Tmax = SrcInitInputData%Tmax + DstInitInputData%AvgWindSpeed = SrcInitInputData%AvgWindSpeed + DstInitInputData%AirDens = SrcInitInputData%AirDens + DstInitInputData%NumSC2CtrlGlob = SrcInitInputData%NumSC2CtrlGlob + DstInitInputData%NumSC2Ctrl = SrcInitInputData%NumSC2Ctrl + DstInitInputData%NumCtrl2SC = SrcInitInputData%NumCtrl2SC + DstInitInputData%TrimCase = SrcInitInputData%TrimCase + DstInitInputData%TrimGain = SrcInitInputData%TrimGain + DstInitInputData%RotSpeedRef = SrcInitInputData%RotSpeedRef + if (allocated(SrcInitInputData%BladeRootRefPos)) then + LB(1:2) = lbound(SrcInitInputData%BladeRootRefPos) + UB(1:2) = ubound(SrcInitInputData%BladeRootRefPos) + if (.not. allocated(DstInitInputData%BladeRootRefPos)) then + allocate(DstInitInputData%BladeRootRefPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BladeRootRefPos.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%BladeRootRefPos = SrcInitInputData%BladeRootRefPos + else if (allocated(DstInitInputData%BladeRootRefPos)) then + deallocate(DstInitInputData%BladeRootRefPos) + end if + if (allocated(SrcInitInputData%BladeRootTransDisp)) then + LB(1:2) = lbound(SrcInitInputData%BladeRootTransDisp) + UB(1:2) = ubound(SrcInitInputData%BladeRootTransDisp) + if (.not. allocated(DstInitInputData%BladeRootTransDisp)) then + allocate(DstInitInputData%BladeRootTransDisp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BladeRootTransDisp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%BladeRootTransDisp = SrcInitInputData%BladeRootTransDisp + else if (allocated(DstInitInputData%BladeRootTransDisp)) then + deallocate(DstInitInputData%BladeRootTransDisp) + end if + if (allocated(SrcInitInputData%BladeRootOrient)) then + LB(1:3) = lbound(SrcInitInputData%BladeRootOrient) + UB(1:3) = ubound(SrcInitInputData%BladeRootOrient) + if (.not. allocated(DstInitInputData%BladeRootOrient)) then + allocate(DstInitInputData%BladeRootOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BladeRootOrient.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%BladeRootOrient = SrcInitInputData%BladeRootOrient + else if (allocated(DstInitInputData%BladeRootOrient)) then + deallocate(DstInitInputData%BladeRootOrient) + end if + if (allocated(SrcInitInputData%BladeRootRefOrient)) then + LB(1:3) = lbound(SrcInitInputData%BladeRootRefOrient) + UB(1:3) = ubound(SrcInitInputData%BladeRootRefOrient) + if (.not. allocated(DstInitInputData%BladeRootRefOrient)) then + allocate(DstInitInputData%BladeRootRefOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BladeRootRefOrient.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%BladeRootRefOrient = SrcInitInputData%BladeRootRefOrient + else if (allocated(DstInitInputData%BladeRootRefOrient)) then + deallocate(DstInitInputData%BladeRootRefOrient) + end if + DstInitInputData%UseInputFile = SrcInitInputData%UseInputFile + call NWTC_Library_CopyFileInfoType(SrcInitInputData%PassedPrimaryInputData, DstInitInputData%PassedPrimaryInputData, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitInputData%NumCableControl = SrcInitInputData%NumCableControl + if (allocated(SrcInitInputData%CableControlRequestor)) then + LB(1:1) = lbound(SrcInitInputData%CableControlRequestor) + UB(1:1) = ubound(SrcInitInputData%CableControlRequestor) + if (.not. allocated(DstInitInputData%CableControlRequestor)) then + allocate(DstInitInputData%CableControlRequestor(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%CableControlRequestor.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%CableControlRequestor = SrcInitInputData%CableControlRequestor + else if (allocated(DstInitInputData%CableControlRequestor)) then + deallocate(DstInitInputData%CableControlRequestor) + end if + DstInitInputData%InterpOrder = SrcInitInputData%InterpOrder + if (allocated(SrcInitInputData%fromSCGlob)) then + LB(1:1) = lbound(SrcInitInputData%fromSCGlob) + UB(1:1) = ubound(SrcInitInputData%fromSCGlob) + if (.not. allocated(DstInitInputData%fromSCGlob)) then + allocate(DstInitInputData%fromSCGlob(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%fromSCGlob.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%fromSCGlob = SrcInitInputData%fromSCGlob + else if (allocated(DstInitInputData%fromSCGlob)) then + deallocate(DstInitInputData%fromSCGlob) + end if + if (allocated(SrcInitInputData%fromSC)) then + LB(1:1) = lbound(SrcInitInputData%fromSC) + UB(1:1) = ubound(SrcInitInputData%fromSC) + if (.not. allocated(DstInitInputData%fromSC)) then + allocate(DstInitInputData%fromSC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%fromSC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%fromSC = SrcInitInputData%fromSC + else if (allocated(DstInitInputData%fromSC)) then + deallocate(DstInitInputData%fromSC) + end if + if (allocated(SrcInitInputData%LidSpeed)) then + LB(1:1) = lbound(SrcInitInputData%LidSpeed) + UB(1:1) = ubound(SrcInitInputData%LidSpeed) + if (.not. allocated(DstInitInputData%LidSpeed)) then + allocate(DstInitInputData%LidSpeed(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%LidSpeed.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%LidSpeed = SrcInitInputData%LidSpeed + else if (allocated(DstInitInputData%LidSpeed)) then + deallocate(DstInitInputData%LidSpeed) + end if + if (allocated(SrcInitInputData%MsrPositionsX)) then + LB(1:1) = lbound(SrcInitInputData%MsrPositionsX) + UB(1:1) = ubound(SrcInitInputData%MsrPositionsX) + if (.not. allocated(DstInitInputData%MsrPositionsX)) then + allocate(DstInitInputData%MsrPositionsX(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%MsrPositionsX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%MsrPositionsX = SrcInitInputData%MsrPositionsX + else if (allocated(DstInitInputData%MsrPositionsX)) then + deallocate(DstInitInputData%MsrPositionsX) + end if + if (allocated(SrcInitInputData%MsrPositionsY)) then + LB(1:1) = lbound(SrcInitInputData%MsrPositionsY) + UB(1:1) = ubound(SrcInitInputData%MsrPositionsY) + if (.not. allocated(DstInitInputData%MsrPositionsY)) then + allocate(DstInitInputData%MsrPositionsY(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%MsrPositionsY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%MsrPositionsY = SrcInitInputData%MsrPositionsY + else if (allocated(DstInitInputData%MsrPositionsY)) then + deallocate(DstInitInputData%MsrPositionsY) + end if + if (allocated(SrcInitInputData%MsrPositionsZ)) then + LB(1:1) = lbound(SrcInitInputData%MsrPositionsZ) + UB(1:1) = ubound(SrcInitInputData%MsrPositionsZ) + if (.not. allocated(DstInitInputData%MsrPositionsZ)) then + allocate(DstInitInputData%MsrPositionsZ(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%MsrPositionsZ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%MsrPositionsZ = SrcInitInputData%MsrPositionsZ + else if (allocated(DstInitInputData%MsrPositionsZ)) then + deallocate(DstInitInputData%MsrPositionsZ) + end if + DstInitInputData%SensorType = SrcInitInputData%SensorType + DstInitInputData%NumBeam = SrcInitInputData%NumBeam + DstInitInputData%NumPulseGate = SrcInitInputData%NumPulseGate + DstInitInputData%PulseSpacing = SrcInitInputData%PulseSpacing + DstInitInputData%URefLid = SrcInitInputData%URefLid +end subroutine +subroutine SrvD_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(SrvD_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitInputData%BlPitchInit)) then + deallocate(InitInputData%BlPitchInit) + end if + if (allocated(InitInputData%BladeRootRefPos)) then + deallocate(InitInputData%BladeRootRefPos) + end if + if (allocated(InitInputData%BladeRootTransDisp)) then + deallocate(InitInputData%BladeRootTransDisp) + end if + if (allocated(InitInputData%BladeRootOrient)) then + deallocate(InitInputData%BladeRootOrient) + end if + if (allocated(InitInputData%BladeRootRefOrient)) then + deallocate(InitInputData%BladeRootRefOrient) + end if + if (allocated(InitInputData%CableControlRequestor)) then + deallocate(InitInputData%CableControlRequestor) + end if + if (allocated(InitInputData%fromSCGlob)) then + deallocate(InitInputData%fromSCGlob) + end if + if (allocated(InitInputData%fromSC)) then + deallocate(InitInputData%fromSC) + end if + if (allocated(InitInputData%LidSpeed)) then + deallocate(InitInputData%LidSpeed) + end if + if (allocated(InitInputData%MsrPositionsX)) then + deallocate(InitInputData%MsrPositionsX) + end if + if (allocated(InitInputData%MsrPositionsY)) then + deallocate(InitInputData%MsrPositionsY) + end if + if (allocated(InitInputData%MsrPositionsZ)) then + deallocate(InitInputData%MsrPositionsZ) + end if +end subroutine subroutine SrvD_PackInitInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SrvD_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SrvD_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return - ! InputFile call RegPack(Buf, InData%InputFile) if (RegCheckErr(Buf, RoutineName)) return - ! Linearize call RegPack(Buf, InData%Linearize) if (RegCheckErr(Buf, RoutineName)) return - ! NumBl call RegPack(Buf, InData%NumBl) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegPack(Buf, InData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! BlPitchInit call RegPack(Buf, allocated(InData%BlPitchInit)) if (allocated(InData%BlPitchInit)) then call RegPackBounds(Buf, 1, lbound(InData%BlPitchInit), ubound(InData%BlPitchInit)) call RegPack(Buf, InData%BlPitchInit) end if if (RegCheckErr(Buf, RoutineName)) return - ! Gravity call RegPack(Buf, InData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - ! NacRefPos call RegPack(Buf, InData%NacRefPos) if (RegCheckErr(Buf, RoutineName)) return - ! NacTransDisp call RegPack(Buf, InData%NacTransDisp) if (RegCheckErr(Buf, RoutineName)) return - ! NacOrient call RegPack(Buf, InData%NacOrient) if (RegCheckErr(Buf, RoutineName)) return - ! NacRefOrient call RegPack(Buf, InData%NacRefOrient) if (RegCheckErr(Buf, RoutineName)) return - ! TwrBaseRefPos call RegPack(Buf, InData%TwrBaseRefPos) if (RegCheckErr(Buf, RoutineName)) return - ! TwrBaseTransDisp call RegPack(Buf, InData%TwrBaseTransDisp) if (RegCheckErr(Buf, RoutineName)) return - ! TwrBaseOrient call RegPack(Buf, InData%TwrBaseOrient) if (RegCheckErr(Buf, RoutineName)) return - ! TwrBaseRefOrient call RegPack(Buf, InData%TwrBaseRefOrient) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmRefPos call RegPack(Buf, InData%PtfmRefPos) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmTransDisp call RegPack(Buf, InData%PtfmTransDisp) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmOrient call RegPack(Buf, InData%PtfmOrient) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmRefOrient call RegPack(Buf, InData%PtfmRefOrient) if (RegCheckErr(Buf, RoutineName)) return - ! Tmax call RegPack(Buf, InData%Tmax) if (RegCheckErr(Buf, RoutineName)) return - ! AvgWindSpeed call RegPack(Buf, InData%AvgWindSpeed) if (RegCheckErr(Buf, RoutineName)) return - ! AirDens call RegPack(Buf, InData%AirDens) if (RegCheckErr(Buf, RoutineName)) return - ! NumSC2CtrlGlob call RegPack(Buf, InData%NumSC2CtrlGlob) if (RegCheckErr(Buf, RoutineName)) return - ! NumSC2Ctrl call RegPack(Buf, InData%NumSC2Ctrl) if (RegCheckErr(Buf, RoutineName)) return - ! NumCtrl2SC call RegPack(Buf, InData%NumCtrl2SC) if (RegCheckErr(Buf, RoutineName)) return - ! TrimCase call RegPack(Buf, InData%TrimCase) if (RegCheckErr(Buf, RoutineName)) return - ! TrimGain call RegPack(Buf, InData%TrimGain) if (RegCheckErr(Buf, RoutineName)) return - ! RotSpeedRef call RegPack(Buf, InData%RotSpeedRef) if (RegCheckErr(Buf, RoutineName)) return - ! BladeRootRefPos call RegPack(Buf, allocated(InData%BladeRootRefPos)) if (allocated(InData%BladeRootRefPos)) then call RegPackBounds(Buf, 2, lbound(InData%BladeRootRefPos), ubound(InData%BladeRootRefPos)) call RegPack(Buf, InData%BladeRootRefPos) end if if (RegCheckErr(Buf, RoutineName)) return - ! BladeRootTransDisp call RegPack(Buf, allocated(InData%BladeRootTransDisp)) if (allocated(InData%BladeRootTransDisp)) then call RegPackBounds(Buf, 2, lbound(InData%BladeRootTransDisp), ubound(InData%BladeRootTransDisp)) call RegPack(Buf, InData%BladeRootTransDisp) end if if (RegCheckErr(Buf, RoutineName)) return - ! BladeRootOrient call RegPack(Buf, allocated(InData%BladeRootOrient)) if (allocated(InData%BladeRootOrient)) then call RegPackBounds(Buf, 3, lbound(InData%BladeRootOrient), ubound(InData%BladeRootOrient)) call RegPack(Buf, InData%BladeRootOrient) end if if (RegCheckErr(Buf, RoutineName)) return - ! BladeRootRefOrient call RegPack(Buf, allocated(InData%BladeRootRefOrient)) if (allocated(InData%BladeRootRefOrient)) then call RegPackBounds(Buf, 3, lbound(InData%BladeRootRefOrient), ubound(InData%BladeRootRefOrient)) call RegPack(Buf, InData%BladeRootRefOrient) end if if (RegCheckErr(Buf, RoutineName)) return - ! UseInputFile call RegPack(Buf, InData%UseInputFile) if (RegCheckErr(Buf, RoutineName)) return - ! PassedPrimaryInputData call NWTC_Library_PackFileInfoType(Buf, InData%PassedPrimaryInputData) if (RegCheckErr(Buf, RoutineName)) return - ! NumCableControl call RegPack(Buf, InData%NumCableControl) if (RegCheckErr(Buf, RoutineName)) return - ! CableControlRequestor call RegPack(Buf, allocated(InData%CableControlRequestor)) if (allocated(InData%CableControlRequestor)) then call RegPackBounds(Buf, 1, lbound(InData%CableControlRequestor), ubound(InData%CableControlRequestor)) call RegPack(Buf, InData%CableControlRequestor) end if if (RegCheckErr(Buf, RoutineName)) return - ! InterpOrder call RegPack(Buf, InData%InterpOrder) if (RegCheckErr(Buf, RoutineName)) return - ! fromSCGlob call RegPack(Buf, allocated(InData%fromSCGlob)) if (allocated(InData%fromSCGlob)) then call RegPackBounds(Buf, 1, lbound(InData%fromSCGlob), ubound(InData%fromSCGlob)) call RegPack(Buf, InData%fromSCGlob) end if if (RegCheckErr(Buf, RoutineName)) return - ! fromSC call RegPack(Buf, allocated(InData%fromSC)) if (allocated(InData%fromSC)) then call RegPackBounds(Buf, 1, lbound(InData%fromSC), ubound(InData%fromSC)) call RegPack(Buf, InData%fromSC) end if if (RegCheckErr(Buf, RoutineName)) return - ! LidSpeed call RegPack(Buf, allocated(InData%LidSpeed)) if (allocated(InData%LidSpeed)) then call RegPackBounds(Buf, 1, lbound(InData%LidSpeed), ubound(InData%LidSpeed)) call RegPack(Buf, InData%LidSpeed) end if if (RegCheckErr(Buf, RoutineName)) return - ! MsrPositionsX call RegPack(Buf, allocated(InData%MsrPositionsX)) if (allocated(InData%MsrPositionsX)) then call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsX), ubound(InData%MsrPositionsX)) call RegPack(Buf, InData%MsrPositionsX) end if if (RegCheckErr(Buf, RoutineName)) return - ! MsrPositionsY call RegPack(Buf, allocated(InData%MsrPositionsY)) if (allocated(InData%MsrPositionsY)) then call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsY), ubound(InData%MsrPositionsY)) call RegPack(Buf, InData%MsrPositionsY) end if if (RegCheckErr(Buf, RoutineName)) return - ! MsrPositionsZ call RegPack(Buf, allocated(InData%MsrPositionsZ)) if (allocated(InData%MsrPositionsZ)) then call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsZ), ubound(InData%MsrPositionsZ)) call RegPack(Buf, InData%MsrPositionsZ) end if if (RegCheckErr(Buf, RoutineName)) return - ! SensorType call RegPack(Buf, InData%SensorType) if (RegCheckErr(Buf, RoutineName)) return - ! NumBeam call RegPack(Buf, InData%NumBeam) if (RegCheckErr(Buf, RoutineName)) return - ! NumPulseGate call RegPack(Buf, InData%NumPulseGate) if (RegCheckErr(Buf, RoutineName)) return - ! PulseSpacing call RegPack(Buf, InData%PulseSpacing) if (RegCheckErr(Buf, RoutineName)) return - ! URefLid call RegPack(Buf, InData%URefLid) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1047,19 +1001,14 @@ subroutine SrvD_UnPackInitInput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! InputFile call RegUnpack(Buf, OutData%InputFile) if (RegCheckErr(Buf, RoutineName)) return - ! Linearize call RegUnpack(Buf, OutData%Linearize) if (RegCheckErr(Buf, RoutineName)) return - ! NumBl call RegUnpack(Buf, OutData%NumBl) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegUnpack(Buf, OutData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! BlPitchInit if (allocated(OutData%BlPitchInit)) deallocate(OutData%BlPitchInit) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1074,73 +1023,50 @@ subroutine SrvD_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%BlPitchInit) if (RegCheckErr(Buf, RoutineName)) return end if - ! Gravity call RegUnpack(Buf, OutData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - ! NacRefPos call RegUnpack(Buf, OutData%NacRefPos) if (RegCheckErr(Buf, RoutineName)) return - ! NacTransDisp call RegUnpack(Buf, OutData%NacTransDisp) if (RegCheckErr(Buf, RoutineName)) return - ! NacOrient call RegUnpack(Buf, OutData%NacOrient) if (RegCheckErr(Buf, RoutineName)) return - ! NacRefOrient call RegUnpack(Buf, OutData%NacRefOrient) if (RegCheckErr(Buf, RoutineName)) return - ! TwrBaseRefPos call RegUnpack(Buf, OutData%TwrBaseRefPos) if (RegCheckErr(Buf, RoutineName)) return - ! TwrBaseTransDisp call RegUnpack(Buf, OutData%TwrBaseTransDisp) if (RegCheckErr(Buf, RoutineName)) return - ! TwrBaseOrient call RegUnpack(Buf, OutData%TwrBaseOrient) if (RegCheckErr(Buf, RoutineName)) return - ! TwrBaseRefOrient call RegUnpack(Buf, OutData%TwrBaseRefOrient) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmRefPos call RegUnpack(Buf, OutData%PtfmRefPos) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmTransDisp call RegUnpack(Buf, OutData%PtfmTransDisp) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmOrient call RegUnpack(Buf, OutData%PtfmOrient) if (RegCheckErr(Buf, RoutineName)) return - ! PtfmRefOrient call RegUnpack(Buf, OutData%PtfmRefOrient) if (RegCheckErr(Buf, RoutineName)) return - ! Tmax call RegUnpack(Buf, OutData%Tmax) if (RegCheckErr(Buf, RoutineName)) return - ! AvgWindSpeed call RegUnpack(Buf, OutData%AvgWindSpeed) if (RegCheckErr(Buf, RoutineName)) return - ! AirDens call RegUnpack(Buf, OutData%AirDens) if (RegCheckErr(Buf, RoutineName)) return - ! NumSC2CtrlGlob call RegUnpack(Buf, OutData%NumSC2CtrlGlob) if (RegCheckErr(Buf, RoutineName)) return - ! NumSC2Ctrl call RegUnpack(Buf, OutData%NumSC2Ctrl) if (RegCheckErr(Buf, RoutineName)) return - ! NumCtrl2SC call RegUnpack(Buf, OutData%NumCtrl2SC) if (RegCheckErr(Buf, RoutineName)) return - ! TrimCase call RegUnpack(Buf, OutData%TrimCase) if (RegCheckErr(Buf, RoutineName)) return - ! TrimGain call RegUnpack(Buf, OutData%TrimGain) if (RegCheckErr(Buf, RoutineName)) return - ! RotSpeedRef call RegUnpack(Buf, OutData%RotSpeedRef) if (RegCheckErr(Buf, RoutineName)) return - ! BladeRootRefPos if (allocated(OutData%BladeRootRefPos)) deallocate(OutData%BladeRootRefPos) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1155,7 +1081,6 @@ subroutine SrvD_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%BladeRootRefPos) if (RegCheckErr(Buf, RoutineName)) return end if - ! BladeRootTransDisp if (allocated(OutData%BladeRootTransDisp)) deallocate(OutData%BladeRootTransDisp) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1170,7 +1095,6 @@ subroutine SrvD_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%BladeRootTransDisp) if (RegCheckErr(Buf, RoutineName)) return end if - ! BladeRootOrient if (allocated(OutData%BladeRootOrient)) deallocate(OutData%BladeRootOrient) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1185,7 +1109,6 @@ subroutine SrvD_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%BladeRootOrient) if (RegCheckErr(Buf, RoutineName)) return end if - ! BladeRootRefOrient if (allocated(OutData%BladeRootRefOrient)) deallocate(OutData%BladeRootRefOrient) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1200,15 +1123,11 @@ subroutine SrvD_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%BladeRootRefOrient) if (RegCheckErr(Buf, RoutineName)) return end if - ! UseInputFile call RegUnpack(Buf, OutData%UseInputFile) if (RegCheckErr(Buf, RoutineName)) return - ! PassedPrimaryInputData call NWTC_Library_UnpackFileInfoType(Buf, OutData%PassedPrimaryInputData) ! PassedPrimaryInputData - ! NumCableControl call RegUnpack(Buf, OutData%NumCableControl) if (RegCheckErr(Buf, RoutineName)) return - ! CableControlRequestor if (allocated(OutData%CableControlRequestor)) deallocate(OutData%CableControlRequestor) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1223,10 +1142,8 @@ subroutine SrvD_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%CableControlRequestor) if (RegCheckErr(Buf, RoutineName)) return end if - ! InterpOrder call RegUnpack(Buf, OutData%InterpOrder) if (RegCheckErr(Buf, RoutineName)) return - ! fromSCGlob if (allocated(OutData%fromSCGlob)) deallocate(OutData%fromSCGlob) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1241,7 +1158,6 @@ subroutine SrvD_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%fromSCGlob) if (RegCheckErr(Buf, RoutineName)) return end if - ! fromSC if (allocated(OutData%fromSC)) deallocate(OutData%fromSC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1256,7 +1172,6 @@ subroutine SrvD_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%fromSC) if (RegCheckErr(Buf, RoutineName)) return end if - ! LidSpeed if (allocated(OutData%LidSpeed)) deallocate(OutData%LidSpeed) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1271,7 +1186,6 @@ subroutine SrvD_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%LidSpeed) if (RegCheckErr(Buf, RoutineName)) return end if - ! MsrPositionsX if (allocated(OutData%MsrPositionsX)) deallocate(OutData%MsrPositionsX) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1286,7 +1200,6 @@ subroutine SrvD_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%MsrPositionsX) if (RegCheckErr(Buf, RoutineName)) return end if - ! MsrPositionsY if (allocated(OutData%MsrPositionsY)) deallocate(OutData%MsrPositionsY) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1301,7 +1214,6 @@ subroutine SrvD_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%MsrPositionsY) if (RegCheckErr(Buf, RoutineName)) return end if - ! MsrPositionsZ if (allocated(OutData%MsrPositionsZ)) deallocate(OutData%MsrPositionsZ) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1316,290 +1228,283 @@ subroutine SrvD_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%MsrPositionsZ) if (RegCheckErr(Buf, RoutineName)) return end if - ! SensorType call RegUnpack(Buf, OutData%SensorType) if (RegCheckErr(Buf, RoutineName)) return - ! NumBeam call RegUnpack(Buf, OutData%NumBeam) if (RegCheckErr(Buf, RoutineName)) return - ! NumPulseGate call RegUnpack(Buf, OutData%NumPulseGate) if (RegCheckErr(Buf, RoutineName)) return - ! PulseSpacing call RegUnpack(Buf, OutData%PulseSpacing) if (RegCheckErr(Buf, RoutineName)) return - ! URefLid call RegUnpack(Buf, OutData%URefLid) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE SrvD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SrvD_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(SrvD_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_CopyInitOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInitOutputData%WriteOutputHdr)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputHdr,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputHdr,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputHdr)) THEN - ALLOCATE(DstInitOutputData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr -ENDIF -IF (ALLOCATED(SrcInitOutputData%WriteOutputUnt)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputUnt,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputUnt,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputUnt)) THEN - ALLOCATE(DstInitOutputData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt -ENDIF - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitOutputData%CouplingScheme = SrcInitOutputData%CouplingScheme - DstInitOutputData%UseHSSBrake = SrcInitOutputData%UseHSSBrake -IF (ALLOCATED(SrcInitOutputData%LinNames_y)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_y,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_y,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_y)) THEN - ALLOCATE(DstInitOutputData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y -ENDIF -IF (ALLOCATED(SrcInitOutputData%LinNames_x)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_x,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_x,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_x)) THEN - ALLOCATE(DstInitOutputData%LinNames_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x -ENDIF -IF (ALLOCATED(SrcInitOutputData%LinNames_u)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_u,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_u)) THEN - ALLOCATE(DstInitOutputData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_y)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_y,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_y,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_y)) THEN - ALLOCATE(DstInitOutputData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_x)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_x,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_x,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_x)) THEN - ALLOCATE(DstInitOutputData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_u)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_u,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_u)) THEN - ALLOCATE(DstInitOutputData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%IsLoad_u)) THEN - i1_l = LBOUND(SrcInitOutputData%IsLoad_u,1) - i1_u = UBOUND(SrcInitOutputData%IsLoad_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%IsLoad_u)) THEN - ALLOCATE(DstInitOutputData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%DerivOrder_x)) THEN - i1_l = LBOUND(SrcInitOutputData%DerivOrder_x,1) - i1_u = UBOUND(SrcInitOutputData%DerivOrder_x,1) - IF (.NOT. ALLOCATED(DstInitOutputData%DerivOrder_x)) THEN - ALLOCATE(DstInitOutputData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x -ENDIF - END SUBROUTINE SrvD_CopyInitOutput - SUBROUTINE SrvD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(SrvD_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF - CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitOutputData%LinNames_y)) THEN - DEALLOCATE(InitOutputData%LinNames_y) -ENDIF -IF (ALLOCATED(InitOutputData%LinNames_x)) THEN - DEALLOCATE(InitOutputData%LinNames_x) -ENDIF -IF (ALLOCATED(InitOutputData%LinNames_u)) THEN - DEALLOCATE(InitOutputData%LinNames_u) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_y)) THEN - DEALLOCATE(InitOutputData%RotFrame_y) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_x)) THEN - DEALLOCATE(InitOutputData%RotFrame_x) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_u)) THEN - DEALLOCATE(InitOutputData%RotFrame_u) -ENDIF -IF (ALLOCATED(InitOutputData%IsLoad_u)) THEN - DEALLOCATE(InitOutputData%IsLoad_u) -ENDIF -IF (ALLOCATED(InitOutputData%DerivOrder_x)) THEN - DEALLOCATE(InitOutputData%DerivOrder_x) -ENDIF - END SUBROUTINE SrvD_DestroyInitOutput +subroutine SrvD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(SrvD_InitOutputType), intent(in) :: SrcInitOutputData + type(SrvD_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr + else if (allocated(DstInitOutputData%WriteOutputHdr)) then + deallocate(DstInitOutputData%WriteOutputHdr) + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt + else if (allocated(DstInitOutputData%WriteOutputUnt)) then + deallocate(DstInitOutputData%WriteOutputUnt) + end if + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitOutputData%CouplingScheme = SrcInitOutputData%CouplingScheme + DstInitOutputData%UseHSSBrake = SrcInitOutputData%UseHSSBrake + if (allocated(SrcInitOutputData%LinNames_y)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_y) + UB(1:1) = ubound(SrcInitOutputData%LinNames_y) + if (.not. allocated(DstInitOutputData%LinNames_y)) then + allocate(DstInitOutputData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y + else if (allocated(DstInitOutputData%LinNames_y)) then + deallocate(DstInitOutputData%LinNames_y) + end if + if (allocated(SrcInitOutputData%LinNames_x)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_x) + UB(1:1) = ubound(SrcInitOutputData%LinNames_x) + if (.not. allocated(DstInitOutputData%LinNames_x)) then + allocate(DstInitOutputData%LinNames_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x + else if (allocated(DstInitOutputData%LinNames_x)) then + deallocate(DstInitOutputData%LinNames_x) + end if + if (allocated(SrcInitOutputData%LinNames_u)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_u) + UB(1:1) = ubound(SrcInitOutputData%LinNames_u) + if (.not. allocated(DstInitOutputData%LinNames_u)) then + allocate(DstInitOutputData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u + else if (allocated(DstInitOutputData%LinNames_u)) then + deallocate(DstInitOutputData%LinNames_u) + end if + if (allocated(SrcInitOutputData%RotFrame_y)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_y) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_y) + if (.not. allocated(DstInitOutputData%RotFrame_y)) then + allocate(DstInitOutputData%RotFrame_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y + else if (allocated(DstInitOutputData%RotFrame_y)) then + deallocate(DstInitOutputData%RotFrame_y) + end if + if (allocated(SrcInitOutputData%RotFrame_x)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_x) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_x) + if (.not. allocated(DstInitOutputData%RotFrame_x)) then + allocate(DstInitOutputData%RotFrame_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x + else if (allocated(DstInitOutputData%RotFrame_x)) then + deallocate(DstInitOutputData%RotFrame_x) + end if + if (allocated(SrcInitOutputData%RotFrame_u)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_u) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_u) + if (.not. allocated(DstInitOutputData%RotFrame_u)) then + allocate(DstInitOutputData%RotFrame_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u + else if (allocated(DstInitOutputData%RotFrame_u)) then + deallocate(DstInitOutputData%RotFrame_u) + end if + if (allocated(SrcInitOutputData%IsLoad_u)) then + LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) + UB(1:1) = ubound(SrcInitOutputData%IsLoad_u) + if (.not. allocated(DstInitOutputData%IsLoad_u)) then + allocate(DstInitOutputData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%IsLoad_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u + else if (allocated(DstInitOutputData%IsLoad_u)) then + deallocate(DstInitOutputData%IsLoad_u) + end if + if (allocated(SrcInitOutputData%DerivOrder_x)) then + LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) + UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x) + if (.not. allocated(DstInitOutputData%DerivOrder_x)) then + allocate(DstInitOutputData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%DerivOrder_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x + else if (allocated(DstInitOutputData%DerivOrder_x)) then + deallocate(DstInitOutputData%DerivOrder_x) + end if +end subroutine +subroutine SrvD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(SrvD_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if + if (allocated(InitOutputData%LinNames_y)) then + deallocate(InitOutputData%LinNames_y) + end if + if (allocated(InitOutputData%LinNames_x)) then + deallocate(InitOutputData%LinNames_x) + end if + if (allocated(InitOutputData%LinNames_u)) then + deallocate(InitOutputData%LinNames_u) + end if + if (allocated(InitOutputData%RotFrame_y)) then + deallocate(InitOutputData%RotFrame_y) + end if + if (allocated(InitOutputData%RotFrame_x)) then + deallocate(InitOutputData%RotFrame_x) + end if + if (allocated(InitOutputData%RotFrame_u)) then + deallocate(InitOutputData%RotFrame_u) + end if + if (allocated(InitOutputData%IsLoad_u)) then + deallocate(InitOutputData%IsLoad_u) + end if + if (allocated(InitOutputData%DerivOrder_x)) then + deallocate(InitOutputData%DerivOrder_x) + end if +end subroutine subroutine SrvD_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SrvD_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SrvD_PackInitOutput' if (Buf%ErrStat >= AbortErrLev) return - ! WriteOutputHdr call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) call RegPack(Buf, InData%WriteOutputHdr) end if if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutputUnt call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) call RegPack(Buf, InData%WriteOutputUnt) end if if (RegCheckErr(Buf, RoutineName)) return - ! Ver call NWTC_Library_PackProgDesc(Buf, InData%Ver) if (RegCheckErr(Buf, RoutineName)) return - ! CouplingScheme call RegPack(Buf, InData%CouplingScheme) if (RegCheckErr(Buf, RoutineName)) return - ! UseHSSBrake call RegPack(Buf, InData%UseHSSBrake) if (RegCheckErr(Buf, RoutineName)) return - ! LinNames_y call RegPack(Buf, allocated(InData%LinNames_y)) if (allocated(InData%LinNames_y)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) call RegPack(Buf, InData%LinNames_y) end if if (RegCheckErr(Buf, RoutineName)) return - ! LinNames_x call RegPack(Buf, allocated(InData%LinNames_x)) if (allocated(InData%LinNames_x)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_x), ubound(InData%LinNames_x)) call RegPack(Buf, InData%LinNames_x) end if if (RegCheckErr(Buf, RoutineName)) return - ! LinNames_u call RegPack(Buf, allocated(InData%LinNames_u)) if (allocated(InData%LinNames_u)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) call RegPack(Buf, InData%LinNames_u) end if if (RegCheckErr(Buf, RoutineName)) return - ! RotFrame_y call RegPack(Buf, allocated(InData%RotFrame_y)) if (allocated(InData%RotFrame_y)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y), ubound(InData%RotFrame_y)) call RegPack(Buf, InData%RotFrame_y) end if if (RegCheckErr(Buf, RoutineName)) return - ! RotFrame_x call RegPack(Buf, allocated(InData%RotFrame_x)) if (allocated(InData%RotFrame_x)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x), ubound(InData%RotFrame_x)) call RegPack(Buf, InData%RotFrame_x) end if if (RegCheckErr(Buf, RoutineName)) return - ! RotFrame_u call RegPack(Buf, allocated(InData%RotFrame_u)) if (allocated(InData%RotFrame_u)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u), ubound(InData%RotFrame_u)) call RegPack(Buf, InData%RotFrame_u) end if if (RegCheckErr(Buf, RoutineName)) return - ! IsLoad_u call RegPack(Buf, allocated(InData%IsLoad_u)) if (allocated(InData%IsLoad_u)) then call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) call RegPack(Buf, InData%IsLoad_u) end if if (RegCheckErr(Buf, RoutineName)) return - ! DerivOrder_x call RegPack(Buf, allocated(InData%DerivOrder_x)) if (allocated(InData%DerivOrder_x)) then call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x), ubound(InData%DerivOrder_x)) @@ -1616,7 +1521,6 @@ subroutine SrvD_UnPackInitOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! WriteOutputHdr if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1631,7 +1535,6 @@ subroutine SrvD_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutputHdr) if (RegCheckErr(Buf, RoutineName)) return end if - ! WriteOutputUnt if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1646,15 +1549,11 @@ subroutine SrvD_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutputUnt) if (RegCheckErr(Buf, RoutineName)) return end if - ! Ver call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver - ! CouplingScheme call RegUnpack(Buf, OutData%CouplingScheme) if (RegCheckErr(Buf, RoutineName)) return - ! UseHSSBrake call RegUnpack(Buf, OutData%UseHSSBrake) if (RegCheckErr(Buf, RoutineName)) return - ! LinNames_y if (allocated(OutData%LinNames_y)) deallocate(OutData%LinNames_y) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1669,7 +1568,6 @@ subroutine SrvD_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%LinNames_y) if (RegCheckErr(Buf, RoutineName)) return end if - ! LinNames_x if (allocated(OutData%LinNames_x)) deallocate(OutData%LinNames_x) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1684,7 +1582,6 @@ subroutine SrvD_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%LinNames_x) if (RegCheckErr(Buf, RoutineName)) return end if - ! LinNames_u if (allocated(OutData%LinNames_u)) deallocate(OutData%LinNames_u) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1699,7 +1596,6 @@ subroutine SrvD_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%LinNames_u) if (RegCheckErr(Buf, RoutineName)) return end if - ! RotFrame_y if (allocated(OutData%RotFrame_y)) deallocate(OutData%RotFrame_y) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1714,7 +1610,6 @@ subroutine SrvD_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%RotFrame_y) if (RegCheckErr(Buf, RoutineName)) return end if - ! RotFrame_x if (allocated(OutData%RotFrame_x)) deallocate(OutData%RotFrame_x) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1729,7 +1624,6 @@ subroutine SrvD_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%RotFrame_x) if (RegCheckErr(Buf, RoutineName)) return end if - ! RotFrame_u if (allocated(OutData%RotFrame_u)) deallocate(OutData%RotFrame_u) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1744,7 +1638,6 @@ subroutine SrvD_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%RotFrame_u) if (RegCheckErr(Buf, RoutineName)) return end if - ! IsLoad_u if (allocated(OutData%IsLoad_u)) deallocate(OutData%IsLoad_u) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1759,7 +1652,6 @@ subroutine SrvD_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%IsLoad_u) if (RegCheckErr(Buf, RoutineName)) return end if - ! DerivOrder_x if (allocated(OutData%DerivOrder_x)) deallocate(OutData%DerivOrder_x) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1775,516 +1667,433 @@ subroutine SrvD_UnPackInitOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE SrvD_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SrvD_InputFile), INTENT(IN) :: SrcInputFileData - TYPE(SrvD_InputFile), INTENT(INOUT) :: DstInputFileData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_CopyInputFile' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInputFileData%DT = SrcInputFileData%DT - DstInputFileData%Echo = SrcInputFileData%Echo - DstInputFileData%PCMode = SrcInputFileData%PCMode - DstInputFileData%TPCOn = SrcInputFileData%TPCOn - DstInputFileData%TPitManS = SrcInputFileData%TPitManS - DstInputFileData%PitManRat = SrcInputFileData%PitManRat - DstInputFileData%BlPitchF = SrcInputFileData%BlPitchF - DstInputFileData%VSContrl = SrcInputFileData%VSContrl - DstInputFileData%GenModel = SrcInputFileData%GenModel - DstInputFileData%GenEff = SrcInputFileData%GenEff - DstInputFileData%GenTiStr = SrcInputFileData%GenTiStr - DstInputFileData%GenTiStp = SrcInputFileData%GenTiStp - DstInputFileData%SpdGenOn = SrcInputFileData%SpdGenOn - DstInputFileData%TimGenOn = SrcInputFileData%TimGenOn - DstInputFileData%TimGenOf = SrcInputFileData%TimGenOf - DstInputFileData%VS_RtGnSp = SrcInputFileData%VS_RtGnSp - DstInputFileData%VS_RtTq = SrcInputFileData%VS_RtTq - DstInputFileData%VS_Rgn2K = SrcInputFileData%VS_Rgn2K - DstInputFileData%VS_SlPc = SrcInputFileData%VS_SlPc - DstInputFileData%SIG_SlPc = SrcInputFileData%SIG_SlPc - DstInputFileData%SIG_SySp = SrcInputFileData%SIG_SySp - DstInputFileData%SIG_RtTq = SrcInputFileData%SIG_RtTq - DstInputFileData%SIG_PORt = SrcInputFileData%SIG_PORt - DstInputFileData%TEC_Freq = SrcInputFileData%TEC_Freq - DstInputFileData%TEC_NPol = SrcInputFileData%TEC_NPol - DstInputFileData%TEC_SRes = SrcInputFileData%TEC_SRes - DstInputFileData%TEC_RRes = SrcInputFileData%TEC_RRes - DstInputFileData%TEC_VLL = SrcInputFileData%TEC_VLL - DstInputFileData%TEC_SLR = SrcInputFileData%TEC_SLR - DstInputFileData%TEC_RLR = SrcInputFileData%TEC_RLR - DstInputFileData%TEC_MR = SrcInputFileData%TEC_MR - DstInputFileData%HSSBrMode = SrcInputFileData%HSSBrMode - DstInputFileData%THSSBrDp = SrcInputFileData%THSSBrDp - DstInputFileData%HSSBrDT = SrcInputFileData%HSSBrDT - DstInputFileData%HSSBrTqF = SrcInputFileData%HSSBrTqF - DstInputFileData%YCMode = SrcInputFileData%YCMode - DstInputFileData%TYCOn = SrcInputFileData%TYCOn - DstInputFileData%YawNeut = SrcInputFileData%YawNeut - DstInputFileData%YawSpr = SrcInputFileData%YawSpr - DstInputFileData%YawDamp = SrcInputFileData%YawDamp - DstInputFileData%TYawManS = SrcInputFileData%TYawManS - DstInputFileData%YawManRat = SrcInputFileData%YawManRat - DstInputFileData%NacYawF = SrcInputFileData%NacYawF - DstInputFileData%SumPrint = SrcInputFileData%SumPrint - DstInputFileData%OutFile = SrcInputFileData%OutFile - DstInputFileData%TabDelim = SrcInputFileData%TabDelim - DstInputFileData%OutFmt = SrcInputFileData%OutFmt - DstInputFileData%Tstart = SrcInputFileData%Tstart - DstInputFileData%NumOuts = SrcInputFileData%NumOuts -IF (ALLOCATED(SrcInputFileData%OutList)) THEN - i1_l = LBOUND(SrcInputFileData%OutList,1) - i1_u = UBOUND(SrcInputFileData%OutList,1) - IF (.NOT. ALLOCATED(DstInputFileData%OutList)) THEN - ALLOCATE(DstInputFileData%OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%OutList = SrcInputFileData%OutList -ENDIF - DstInputFileData%DLL_FileName = SrcInputFileData%DLL_FileName - DstInputFileData%DLL_ProcName = SrcInputFileData%DLL_ProcName - DstInputFileData%DLL_InFile = SrcInputFileData%DLL_InFile - DstInputFileData%DLL_DT = SrcInputFileData%DLL_DT - DstInputFileData%DLL_Ramp = SrcInputFileData%DLL_Ramp - DstInputFileData%BPCutoff = SrcInputFileData%BPCutoff - DstInputFileData%NacYaw_North = SrcInputFileData%NacYaw_North - DstInputFileData%Ptch_Cntrl = SrcInputFileData%Ptch_Cntrl - DstInputFileData%Ptch_SetPnt = SrcInputFileData%Ptch_SetPnt - DstInputFileData%Ptch_Min = SrcInputFileData%Ptch_Min - DstInputFileData%Ptch_Max = SrcInputFileData%Ptch_Max - DstInputFileData%PtchRate_Min = SrcInputFileData%PtchRate_Min - DstInputFileData%PtchRate_Max = SrcInputFileData%PtchRate_Max - DstInputFileData%Gain_OM = SrcInputFileData%Gain_OM - DstInputFileData%GenSpd_MinOM = SrcInputFileData%GenSpd_MinOM - DstInputFileData%GenSpd_MaxOM = SrcInputFileData%GenSpd_MaxOM - DstInputFileData%GenSpd_Dem = SrcInputFileData%GenSpd_Dem - DstInputFileData%GenTrq_Dem = SrcInputFileData%GenTrq_Dem - DstInputFileData%GenPwr_Dem = SrcInputFileData%GenPwr_Dem - DstInputFileData%DLL_NumTrq = SrcInputFileData%DLL_NumTrq -IF (ALLOCATED(SrcInputFileData%GenSpd_TLU)) THEN - i1_l = LBOUND(SrcInputFileData%GenSpd_TLU,1) - i1_u = UBOUND(SrcInputFileData%GenSpd_TLU,1) - IF (.NOT. ALLOCATED(DstInputFileData%GenSpd_TLU)) THEN - ALLOCATE(DstInputFileData%GenSpd_TLU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%GenSpd_TLU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%GenSpd_TLU = SrcInputFileData%GenSpd_TLU -ENDIF -IF (ALLOCATED(SrcInputFileData%GenTrq_TLU)) THEN - i1_l = LBOUND(SrcInputFileData%GenTrq_TLU,1) - i1_u = UBOUND(SrcInputFileData%GenTrq_TLU,1) - IF (.NOT. ALLOCATED(DstInputFileData%GenTrq_TLU)) THEN - ALLOCATE(DstInputFileData%GenTrq_TLU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%GenTrq_TLU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%GenTrq_TLU = SrcInputFileData%GenTrq_TLU -ENDIF - DstInputFileData%UseLegacyInterface = SrcInputFileData%UseLegacyInterface - DstInputFileData%NumBStC = SrcInputFileData%NumBStC -IF (ALLOCATED(SrcInputFileData%BStCfiles)) THEN - i1_l = LBOUND(SrcInputFileData%BStCfiles,1) - i1_u = UBOUND(SrcInputFileData%BStCfiles,1) - IF (.NOT. ALLOCATED(DstInputFileData%BStCfiles)) THEN - ALLOCATE(DstInputFileData%BStCfiles(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BStCfiles.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%BStCfiles = SrcInputFileData%BStCfiles -ENDIF - DstInputFileData%NumNStC = SrcInputFileData%NumNStC -IF (ALLOCATED(SrcInputFileData%NStCfiles)) THEN - i1_l = LBOUND(SrcInputFileData%NStCfiles,1) - i1_u = UBOUND(SrcInputFileData%NStCfiles,1) - IF (.NOT. ALLOCATED(DstInputFileData%NStCfiles)) THEN - ALLOCATE(DstInputFileData%NStCfiles(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%NStCfiles.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%NStCfiles = SrcInputFileData%NStCfiles -ENDIF - DstInputFileData%NumTStC = SrcInputFileData%NumTStC -IF (ALLOCATED(SrcInputFileData%TStCfiles)) THEN - i1_l = LBOUND(SrcInputFileData%TStCfiles,1) - i1_u = UBOUND(SrcInputFileData%TStCfiles,1) - IF (.NOT. ALLOCATED(DstInputFileData%TStCfiles)) THEN - ALLOCATE(DstInputFileData%TStCfiles(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TStCfiles.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%TStCfiles = SrcInputFileData%TStCfiles -ENDIF - DstInputFileData%NumSStC = SrcInputFileData%NumSStC -IF (ALLOCATED(SrcInputFileData%SStCfiles)) THEN - i1_l = LBOUND(SrcInputFileData%SStCfiles,1) - i1_u = UBOUND(SrcInputFileData%SStCfiles,1) - IF (.NOT. ALLOCATED(DstInputFileData%SStCfiles)) THEN - ALLOCATE(DstInputFileData%SStCfiles(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%SStCfiles.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%SStCfiles = SrcInputFileData%SStCfiles -ENDIF - DstInputFileData%AfCmode = SrcInputFileData%AfCmode - DstInputFileData%AfC_Mean = SrcInputFileData%AfC_Mean - DstInputFileData%AfC_Amp = SrcInputFileData%AfC_Amp - DstInputFileData%AfC_Phase = SrcInputFileData%AfC_Phase - DstInputFileData%CCmode = SrcInputFileData%CCmode - DstInputFileData%EXavrSWAP = SrcInputFileData%EXavrSWAP - END SUBROUTINE SrvD_CopyInputFile - - SUBROUTINE SrvD_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) - TYPE(SrvD_InputFile), INTENT(INOUT) :: InputFileData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyInputFile' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(InputFileData%OutList)) THEN - DEALLOCATE(InputFileData%OutList) -ENDIF -IF (ALLOCATED(InputFileData%GenSpd_TLU)) THEN - DEALLOCATE(InputFileData%GenSpd_TLU) -ENDIF -IF (ALLOCATED(InputFileData%GenTrq_TLU)) THEN - DEALLOCATE(InputFileData%GenTrq_TLU) -ENDIF -IF (ALLOCATED(InputFileData%BStCfiles)) THEN - DEALLOCATE(InputFileData%BStCfiles) -ENDIF -IF (ALLOCATED(InputFileData%NStCfiles)) THEN - DEALLOCATE(InputFileData%NStCfiles) -ENDIF -IF (ALLOCATED(InputFileData%TStCfiles)) THEN - DEALLOCATE(InputFileData%TStCfiles) -ENDIF -IF (ALLOCATED(InputFileData%SStCfiles)) THEN - DEALLOCATE(InputFileData%SStCfiles) -ENDIF - END SUBROUTINE SrvD_DestroyInputFile +subroutine SrvD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) + type(SrvD_InputFile), intent(in) :: SrcInputFileData + type(SrvD_InputFile), intent(inout) :: DstInputFileData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SrvD_CopyInputFile' + ErrStat = ErrID_None + ErrMsg = '' + DstInputFileData%DT = SrcInputFileData%DT + DstInputFileData%Echo = SrcInputFileData%Echo + DstInputFileData%PCMode = SrcInputFileData%PCMode + DstInputFileData%TPCOn = SrcInputFileData%TPCOn + DstInputFileData%TPitManS = SrcInputFileData%TPitManS + DstInputFileData%PitManRat = SrcInputFileData%PitManRat + DstInputFileData%BlPitchF = SrcInputFileData%BlPitchF + DstInputFileData%VSContrl = SrcInputFileData%VSContrl + DstInputFileData%GenModel = SrcInputFileData%GenModel + DstInputFileData%GenEff = SrcInputFileData%GenEff + DstInputFileData%GenTiStr = SrcInputFileData%GenTiStr + DstInputFileData%GenTiStp = SrcInputFileData%GenTiStp + DstInputFileData%SpdGenOn = SrcInputFileData%SpdGenOn + DstInputFileData%TimGenOn = SrcInputFileData%TimGenOn + DstInputFileData%TimGenOf = SrcInputFileData%TimGenOf + DstInputFileData%VS_RtGnSp = SrcInputFileData%VS_RtGnSp + DstInputFileData%VS_RtTq = SrcInputFileData%VS_RtTq + DstInputFileData%VS_Rgn2K = SrcInputFileData%VS_Rgn2K + DstInputFileData%VS_SlPc = SrcInputFileData%VS_SlPc + DstInputFileData%SIG_SlPc = SrcInputFileData%SIG_SlPc + DstInputFileData%SIG_SySp = SrcInputFileData%SIG_SySp + DstInputFileData%SIG_RtTq = SrcInputFileData%SIG_RtTq + DstInputFileData%SIG_PORt = SrcInputFileData%SIG_PORt + DstInputFileData%TEC_Freq = SrcInputFileData%TEC_Freq + DstInputFileData%TEC_NPol = SrcInputFileData%TEC_NPol + DstInputFileData%TEC_SRes = SrcInputFileData%TEC_SRes + DstInputFileData%TEC_RRes = SrcInputFileData%TEC_RRes + DstInputFileData%TEC_VLL = SrcInputFileData%TEC_VLL + DstInputFileData%TEC_SLR = SrcInputFileData%TEC_SLR + DstInputFileData%TEC_RLR = SrcInputFileData%TEC_RLR + DstInputFileData%TEC_MR = SrcInputFileData%TEC_MR + DstInputFileData%HSSBrMode = SrcInputFileData%HSSBrMode + DstInputFileData%THSSBrDp = SrcInputFileData%THSSBrDp + DstInputFileData%HSSBrDT = SrcInputFileData%HSSBrDT + DstInputFileData%HSSBrTqF = SrcInputFileData%HSSBrTqF + DstInputFileData%YCMode = SrcInputFileData%YCMode + DstInputFileData%TYCOn = SrcInputFileData%TYCOn + DstInputFileData%YawNeut = SrcInputFileData%YawNeut + DstInputFileData%YawSpr = SrcInputFileData%YawSpr + DstInputFileData%YawDamp = SrcInputFileData%YawDamp + DstInputFileData%TYawManS = SrcInputFileData%TYawManS + DstInputFileData%YawManRat = SrcInputFileData%YawManRat + DstInputFileData%NacYawF = SrcInputFileData%NacYawF + DstInputFileData%SumPrint = SrcInputFileData%SumPrint + DstInputFileData%OutFile = SrcInputFileData%OutFile + DstInputFileData%TabDelim = SrcInputFileData%TabDelim + DstInputFileData%OutFmt = SrcInputFileData%OutFmt + DstInputFileData%Tstart = SrcInputFileData%Tstart + DstInputFileData%NumOuts = SrcInputFileData%NumOuts + if (allocated(SrcInputFileData%OutList)) then + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) + if (.not. allocated(DstInputFileData%OutList)) then + allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%OutList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%OutList = SrcInputFileData%OutList + else if (allocated(DstInputFileData%OutList)) then + deallocate(DstInputFileData%OutList) + end if + DstInputFileData%DLL_FileName = SrcInputFileData%DLL_FileName + DstInputFileData%DLL_ProcName = SrcInputFileData%DLL_ProcName + DstInputFileData%DLL_InFile = SrcInputFileData%DLL_InFile + DstInputFileData%DLL_DT = SrcInputFileData%DLL_DT + DstInputFileData%DLL_Ramp = SrcInputFileData%DLL_Ramp + DstInputFileData%BPCutoff = SrcInputFileData%BPCutoff + DstInputFileData%NacYaw_North = SrcInputFileData%NacYaw_North + DstInputFileData%Ptch_Cntrl = SrcInputFileData%Ptch_Cntrl + DstInputFileData%Ptch_SetPnt = SrcInputFileData%Ptch_SetPnt + DstInputFileData%Ptch_Min = SrcInputFileData%Ptch_Min + DstInputFileData%Ptch_Max = SrcInputFileData%Ptch_Max + DstInputFileData%PtchRate_Min = SrcInputFileData%PtchRate_Min + DstInputFileData%PtchRate_Max = SrcInputFileData%PtchRate_Max + DstInputFileData%Gain_OM = SrcInputFileData%Gain_OM + DstInputFileData%GenSpd_MinOM = SrcInputFileData%GenSpd_MinOM + DstInputFileData%GenSpd_MaxOM = SrcInputFileData%GenSpd_MaxOM + DstInputFileData%GenSpd_Dem = SrcInputFileData%GenSpd_Dem + DstInputFileData%GenTrq_Dem = SrcInputFileData%GenTrq_Dem + DstInputFileData%GenPwr_Dem = SrcInputFileData%GenPwr_Dem + DstInputFileData%DLL_NumTrq = SrcInputFileData%DLL_NumTrq + if (allocated(SrcInputFileData%GenSpd_TLU)) then + LB(1:1) = lbound(SrcInputFileData%GenSpd_TLU) + UB(1:1) = ubound(SrcInputFileData%GenSpd_TLU) + if (.not. allocated(DstInputFileData%GenSpd_TLU)) then + allocate(DstInputFileData%GenSpd_TLU(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%GenSpd_TLU.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%GenSpd_TLU = SrcInputFileData%GenSpd_TLU + else if (allocated(DstInputFileData%GenSpd_TLU)) then + deallocate(DstInputFileData%GenSpd_TLU) + end if + if (allocated(SrcInputFileData%GenTrq_TLU)) then + LB(1:1) = lbound(SrcInputFileData%GenTrq_TLU) + UB(1:1) = ubound(SrcInputFileData%GenTrq_TLU) + if (.not. allocated(DstInputFileData%GenTrq_TLU)) then + allocate(DstInputFileData%GenTrq_TLU(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%GenTrq_TLU.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%GenTrq_TLU = SrcInputFileData%GenTrq_TLU + else if (allocated(DstInputFileData%GenTrq_TLU)) then + deallocate(DstInputFileData%GenTrq_TLU) + end if + DstInputFileData%UseLegacyInterface = SrcInputFileData%UseLegacyInterface + DstInputFileData%NumBStC = SrcInputFileData%NumBStC + if (allocated(SrcInputFileData%BStCfiles)) then + LB(1:1) = lbound(SrcInputFileData%BStCfiles) + UB(1:1) = ubound(SrcInputFileData%BStCfiles) + if (.not. allocated(DstInputFileData%BStCfiles)) then + allocate(DstInputFileData%BStCfiles(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BStCfiles.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%BStCfiles = SrcInputFileData%BStCfiles + else if (allocated(DstInputFileData%BStCfiles)) then + deallocate(DstInputFileData%BStCfiles) + end if + DstInputFileData%NumNStC = SrcInputFileData%NumNStC + if (allocated(SrcInputFileData%NStCfiles)) then + LB(1:1) = lbound(SrcInputFileData%NStCfiles) + UB(1:1) = ubound(SrcInputFileData%NStCfiles) + if (.not. allocated(DstInputFileData%NStCfiles)) then + allocate(DstInputFileData%NStCfiles(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%NStCfiles.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%NStCfiles = SrcInputFileData%NStCfiles + else if (allocated(DstInputFileData%NStCfiles)) then + deallocate(DstInputFileData%NStCfiles) + end if + DstInputFileData%NumTStC = SrcInputFileData%NumTStC + if (allocated(SrcInputFileData%TStCfiles)) then + LB(1:1) = lbound(SrcInputFileData%TStCfiles) + UB(1:1) = ubound(SrcInputFileData%TStCfiles) + if (.not. allocated(DstInputFileData%TStCfiles)) then + allocate(DstInputFileData%TStCfiles(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TStCfiles.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%TStCfiles = SrcInputFileData%TStCfiles + else if (allocated(DstInputFileData%TStCfiles)) then + deallocate(DstInputFileData%TStCfiles) + end if + DstInputFileData%NumSStC = SrcInputFileData%NumSStC + if (allocated(SrcInputFileData%SStCfiles)) then + LB(1:1) = lbound(SrcInputFileData%SStCfiles) + UB(1:1) = ubound(SrcInputFileData%SStCfiles) + if (.not. allocated(DstInputFileData%SStCfiles)) then + allocate(DstInputFileData%SStCfiles(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%SStCfiles.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%SStCfiles = SrcInputFileData%SStCfiles + else if (allocated(DstInputFileData%SStCfiles)) then + deallocate(DstInputFileData%SStCfiles) + end if + DstInputFileData%AfCmode = SrcInputFileData%AfCmode + DstInputFileData%AfC_Mean = SrcInputFileData%AfC_Mean + DstInputFileData%AfC_Amp = SrcInputFileData%AfC_Amp + DstInputFileData%AfC_Phase = SrcInputFileData%AfC_Phase + DstInputFileData%CCmode = SrcInputFileData%CCmode + DstInputFileData%EXavrSWAP = SrcInputFileData%EXavrSWAP +end subroutine +subroutine SrvD_DestroyInputFile(InputFileData, ErrStat, ErrMsg) + type(SrvD_InputFile), intent(inout) :: InputFileData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SrvD_DestroyInputFile' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputFileData%OutList)) then + deallocate(InputFileData%OutList) + end if + if (allocated(InputFileData%GenSpd_TLU)) then + deallocate(InputFileData%GenSpd_TLU) + end if + if (allocated(InputFileData%GenTrq_TLU)) then + deallocate(InputFileData%GenTrq_TLU) + end if + if (allocated(InputFileData%BStCfiles)) then + deallocate(InputFileData%BStCfiles) + end if + if (allocated(InputFileData%NStCfiles)) then + deallocate(InputFileData%NStCfiles) + end if + if (allocated(InputFileData%TStCfiles)) then + deallocate(InputFileData%TStCfiles) + end if + if (allocated(InputFileData%SStCfiles)) then + deallocate(InputFileData%SStCfiles) + end if +end subroutine subroutine SrvD_PackInputFile(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SrvD_InputFile), intent(in) :: InData character(*), parameter :: RoutineName = 'SrvD_PackInputFile' if (Buf%ErrStat >= AbortErrLev) return - ! DT call RegPack(Buf, InData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! Echo call RegPack(Buf, InData%Echo) if (RegCheckErr(Buf, RoutineName)) return - ! PCMode call RegPack(Buf, InData%PCMode) if (RegCheckErr(Buf, RoutineName)) return - ! TPCOn call RegPack(Buf, InData%TPCOn) if (RegCheckErr(Buf, RoutineName)) return - ! TPitManS call RegPack(Buf, InData%TPitManS) if (RegCheckErr(Buf, RoutineName)) return - ! PitManRat call RegPack(Buf, InData%PitManRat) if (RegCheckErr(Buf, RoutineName)) return - ! BlPitchF call RegPack(Buf, InData%BlPitchF) if (RegCheckErr(Buf, RoutineName)) return - ! VSContrl call RegPack(Buf, InData%VSContrl) if (RegCheckErr(Buf, RoutineName)) return - ! GenModel call RegPack(Buf, InData%GenModel) if (RegCheckErr(Buf, RoutineName)) return - ! GenEff call RegPack(Buf, InData%GenEff) if (RegCheckErr(Buf, RoutineName)) return - ! GenTiStr call RegPack(Buf, InData%GenTiStr) if (RegCheckErr(Buf, RoutineName)) return - ! GenTiStp call RegPack(Buf, InData%GenTiStp) if (RegCheckErr(Buf, RoutineName)) return - ! SpdGenOn call RegPack(Buf, InData%SpdGenOn) if (RegCheckErr(Buf, RoutineName)) return - ! TimGenOn call RegPack(Buf, InData%TimGenOn) if (RegCheckErr(Buf, RoutineName)) return - ! TimGenOf call RegPack(Buf, InData%TimGenOf) if (RegCheckErr(Buf, RoutineName)) return - ! VS_RtGnSp call RegPack(Buf, InData%VS_RtGnSp) if (RegCheckErr(Buf, RoutineName)) return - ! VS_RtTq call RegPack(Buf, InData%VS_RtTq) if (RegCheckErr(Buf, RoutineName)) return - ! VS_Rgn2K call RegPack(Buf, InData%VS_Rgn2K) if (RegCheckErr(Buf, RoutineName)) return - ! VS_SlPc call RegPack(Buf, InData%VS_SlPc) if (RegCheckErr(Buf, RoutineName)) return - ! SIG_SlPc call RegPack(Buf, InData%SIG_SlPc) if (RegCheckErr(Buf, RoutineName)) return - ! SIG_SySp call RegPack(Buf, InData%SIG_SySp) if (RegCheckErr(Buf, RoutineName)) return - ! SIG_RtTq call RegPack(Buf, InData%SIG_RtTq) if (RegCheckErr(Buf, RoutineName)) return - ! SIG_PORt call RegPack(Buf, InData%SIG_PORt) if (RegCheckErr(Buf, RoutineName)) return - ! TEC_Freq call RegPack(Buf, InData%TEC_Freq) if (RegCheckErr(Buf, RoutineName)) return - ! TEC_NPol call RegPack(Buf, InData%TEC_NPol) if (RegCheckErr(Buf, RoutineName)) return - ! TEC_SRes call RegPack(Buf, InData%TEC_SRes) if (RegCheckErr(Buf, RoutineName)) return - ! TEC_RRes call RegPack(Buf, InData%TEC_RRes) if (RegCheckErr(Buf, RoutineName)) return - ! TEC_VLL call RegPack(Buf, InData%TEC_VLL) if (RegCheckErr(Buf, RoutineName)) return - ! TEC_SLR call RegPack(Buf, InData%TEC_SLR) if (RegCheckErr(Buf, RoutineName)) return - ! TEC_RLR call RegPack(Buf, InData%TEC_RLR) if (RegCheckErr(Buf, RoutineName)) return - ! TEC_MR call RegPack(Buf, InData%TEC_MR) if (RegCheckErr(Buf, RoutineName)) return - ! HSSBrMode call RegPack(Buf, InData%HSSBrMode) if (RegCheckErr(Buf, RoutineName)) return - ! THSSBrDp call RegPack(Buf, InData%THSSBrDp) if (RegCheckErr(Buf, RoutineName)) return - ! HSSBrDT call RegPack(Buf, InData%HSSBrDT) if (RegCheckErr(Buf, RoutineName)) return - ! HSSBrTqF call RegPack(Buf, InData%HSSBrTqF) if (RegCheckErr(Buf, RoutineName)) return - ! YCMode call RegPack(Buf, InData%YCMode) if (RegCheckErr(Buf, RoutineName)) return - ! TYCOn call RegPack(Buf, InData%TYCOn) if (RegCheckErr(Buf, RoutineName)) return - ! YawNeut call RegPack(Buf, InData%YawNeut) if (RegCheckErr(Buf, RoutineName)) return - ! YawSpr call RegPack(Buf, InData%YawSpr) if (RegCheckErr(Buf, RoutineName)) return - ! YawDamp call RegPack(Buf, InData%YawDamp) if (RegCheckErr(Buf, RoutineName)) return - ! TYawManS call RegPack(Buf, InData%TYawManS) if (RegCheckErr(Buf, RoutineName)) return - ! YawManRat call RegPack(Buf, InData%YawManRat) if (RegCheckErr(Buf, RoutineName)) return - ! NacYawF call RegPack(Buf, InData%NacYawF) if (RegCheckErr(Buf, RoutineName)) return - ! SumPrint call RegPack(Buf, InData%SumPrint) if (RegCheckErr(Buf, RoutineName)) return - ! OutFile call RegPack(Buf, InData%OutFile) if (RegCheckErr(Buf, RoutineName)) return - ! TabDelim call RegPack(Buf, InData%TabDelim) if (RegCheckErr(Buf, RoutineName)) return - ! OutFmt call RegPack(Buf, InData%OutFmt) if (RegCheckErr(Buf, RoutineName)) return - ! Tstart call RegPack(Buf, InData%Tstart) if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegPack(Buf, InData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! OutList call RegPack(Buf, allocated(InData%OutList)) if (allocated(InData%OutList)) then call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) call RegPack(Buf, InData%OutList) end if if (RegCheckErr(Buf, RoutineName)) return - ! DLL_FileName call RegPack(Buf, InData%DLL_FileName) if (RegCheckErr(Buf, RoutineName)) return - ! DLL_ProcName call RegPack(Buf, InData%DLL_ProcName) if (RegCheckErr(Buf, RoutineName)) return - ! DLL_InFile call RegPack(Buf, InData%DLL_InFile) if (RegCheckErr(Buf, RoutineName)) return - ! DLL_DT call RegPack(Buf, InData%DLL_DT) if (RegCheckErr(Buf, RoutineName)) return - ! DLL_Ramp call RegPack(Buf, InData%DLL_Ramp) if (RegCheckErr(Buf, RoutineName)) return - ! BPCutoff call RegPack(Buf, InData%BPCutoff) if (RegCheckErr(Buf, RoutineName)) return - ! NacYaw_North call RegPack(Buf, InData%NacYaw_North) if (RegCheckErr(Buf, RoutineName)) return - ! Ptch_Cntrl call RegPack(Buf, InData%Ptch_Cntrl) if (RegCheckErr(Buf, RoutineName)) return - ! Ptch_SetPnt call RegPack(Buf, InData%Ptch_SetPnt) if (RegCheckErr(Buf, RoutineName)) return - ! Ptch_Min call RegPack(Buf, InData%Ptch_Min) if (RegCheckErr(Buf, RoutineName)) return - ! Ptch_Max call RegPack(Buf, InData%Ptch_Max) if (RegCheckErr(Buf, RoutineName)) return - ! PtchRate_Min call RegPack(Buf, InData%PtchRate_Min) if (RegCheckErr(Buf, RoutineName)) return - ! PtchRate_Max call RegPack(Buf, InData%PtchRate_Max) if (RegCheckErr(Buf, RoutineName)) return - ! Gain_OM call RegPack(Buf, InData%Gain_OM) if (RegCheckErr(Buf, RoutineName)) return - ! GenSpd_MinOM call RegPack(Buf, InData%GenSpd_MinOM) if (RegCheckErr(Buf, RoutineName)) return - ! GenSpd_MaxOM call RegPack(Buf, InData%GenSpd_MaxOM) if (RegCheckErr(Buf, RoutineName)) return - ! GenSpd_Dem call RegPack(Buf, InData%GenSpd_Dem) if (RegCheckErr(Buf, RoutineName)) return - ! GenTrq_Dem call RegPack(Buf, InData%GenTrq_Dem) if (RegCheckErr(Buf, RoutineName)) return - ! GenPwr_Dem call RegPack(Buf, InData%GenPwr_Dem) if (RegCheckErr(Buf, RoutineName)) return - ! DLL_NumTrq call RegPack(Buf, InData%DLL_NumTrq) if (RegCheckErr(Buf, RoutineName)) return - ! GenSpd_TLU call RegPack(Buf, allocated(InData%GenSpd_TLU)) if (allocated(InData%GenSpd_TLU)) then call RegPackBounds(Buf, 1, lbound(InData%GenSpd_TLU), ubound(InData%GenSpd_TLU)) call RegPack(Buf, InData%GenSpd_TLU) end if if (RegCheckErr(Buf, RoutineName)) return - ! GenTrq_TLU call RegPack(Buf, allocated(InData%GenTrq_TLU)) if (allocated(InData%GenTrq_TLU)) then call RegPackBounds(Buf, 1, lbound(InData%GenTrq_TLU), ubound(InData%GenTrq_TLU)) call RegPack(Buf, InData%GenTrq_TLU) end if if (RegCheckErr(Buf, RoutineName)) return - ! UseLegacyInterface call RegPack(Buf, InData%UseLegacyInterface) if (RegCheckErr(Buf, RoutineName)) return - ! NumBStC call RegPack(Buf, InData%NumBStC) if (RegCheckErr(Buf, RoutineName)) return - ! BStCfiles call RegPack(Buf, allocated(InData%BStCfiles)) if (allocated(InData%BStCfiles)) then call RegPackBounds(Buf, 1, lbound(InData%BStCfiles), ubound(InData%BStCfiles)) call RegPack(Buf, InData%BStCfiles) end if if (RegCheckErr(Buf, RoutineName)) return - ! NumNStC call RegPack(Buf, InData%NumNStC) if (RegCheckErr(Buf, RoutineName)) return - ! NStCfiles call RegPack(Buf, allocated(InData%NStCfiles)) if (allocated(InData%NStCfiles)) then call RegPackBounds(Buf, 1, lbound(InData%NStCfiles), ubound(InData%NStCfiles)) call RegPack(Buf, InData%NStCfiles) end if if (RegCheckErr(Buf, RoutineName)) return - ! NumTStC call RegPack(Buf, InData%NumTStC) if (RegCheckErr(Buf, RoutineName)) return - ! TStCfiles call RegPack(Buf, allocated(InData%TStCfiles)) if (allocated(InData%TStCfiles)) then call RegPackBounds(Buf, 1, lbound(InData%TStCfiles), ubound(InData%TStCfiles)) call RegPack(Buf, InData%TStCfiles) end if if (RegCheckErr(Buf, RoutineName)) return - ! NumSStC call RegPack(Buf, InData%NumSStC) if (RegCheckErr(Buf, RoutineName)) return - ! SStCfiles call RegPack(Buf, allocated(InData%SStCfiles)) if (allocated(InData%SStCfiles)) then call RegPackBounds(Buf, 1, lbound(InData%SStCfiles), ubound(InData%SStCfiles)) call RegPack(Buf, InData%SStCfiles) end if if (RegCheckErr(Buf, RoutineName)) return - ! AfCmode call RegPack(Buf, InData%AfCmode) if (RegCheckErr(Buf, RoutineName)) return - ! AfC_Mean call RegPack(Buf, InData%AfC_Mean) if (RegCheckErr(Buf, RoutineName)) return - ! AfC_Amp call RegPack(Buf, InData%AfC_Amp) if (RegCheckErr(Buf, RoutineName)) return - ! AfC_Phase call RegPack(Buf, InData%AfC_Phase) if (RegCheckErr(Buf, RoutineName)) return - ! CCmode call RegPack(Buf, InData%CCmode) if (RegCheckErr(Buf, RoutineName)) return - ! EXavrSWAP call RegPack(Buf, InData%EXavrSWAP) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2297,154 +2106,104 @@ subroutine SrvD_UnPackInputFile(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! DT call RegUnpack(Buf, OutData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! Echo call RegUnpack(Buf, OutData%Echo) if (RegCheckErr(Buf, RoutineName)) return - ! PCMode call RegUnpack(Buf, OutData%PCMode) if (RegCheckErr(Buf, RoutineName)) return - ! TPCOn call RegUnpack(Buf, OutData%TPCOn) if (RegCheckErr(Buf, RoutineName)) return - ! TPitManS call RegUnpack(Buf, OutData%TPitManS) if (RegCheckErr(Buf, RoutineName)) return - ! PitManRat call RegUnpack(Buf, OutData%PitManRat) if (RegCheckErr(Buf, RoutineName)) return - ! BlPitchF call RegUnpack(Buf, OutData%BlPitchF) if (RegCheckErr(Buf, RoutineName)) return - ! VSContrl call RegUnpack(Buf, OutData%VSContrl) if (RegCheckErr(Buf, RoutineName)) return - ! GenModel call RegUnpack(Buf, OutData%GenModel) if (RegCheckErr(Buf, RoutineName)) return - ! GenEff call RegUnpack(Buf, OutData%GenEff) if (RegCheckErr(Buf, RoutineName)) return - ! GenTiStr call RegUnpack(Buf, OutData%GenTiStr) if (RegCheckErr(Buf, RoutineName)) return - ! GenTiStp call RegUnpack(Buf, OutData%GenTiStp) if (RegCheckErr(Buf, RoutineName)) return - ! SpdGenOn call RegUnpack(Buf, OutData%SpdGenOn) if (RegCheckErr(Buf, RoutineName)) return - ! TimGenOn call RegUnpack(Buf, OutData%TimGenOn) if (RegCheckErr(Buf, RoutineName)) return - ! TimGenOf call RegUnpack(Buf, OutData%TimGenOf) if (RegCheckErr(Buf, RoutineName)) return - ! VS_RtGnSp call RegUnpack(Buf, OutData%VS_RtGnSp) if (RegCheckErr(Buf, RoutineName)) return - ! VS_RtTq call RegUnpack(Buf, OutData%VS_RtTq) if (RegCheckErr(Buf, RoutineName)) return - ! VS_Rgn2K call RegUnpack(Buf, OutData%VS_Rgn2K) if (RegCheckErr(Buf, RoutineName)) return - ! VS_SlPc call RegUnpack(Buf, OutData%VS_SlPc) if (RegCheckErr(Buf, RoutineName)) return - ! SIG_SlPc call RegUnpack(Buf, OutData%SIG_SlPc) if (RegCheckErr(Buf, RoutineName)) return - ! SIG_SySp call RegUnpack(Buf, OutData%SIG_SySp) if (RegCheckErr(Buf, RoutineName)) return - ! SIG_RtTq call RegUnpack(Buf, OutData%SIG_RtTq) if (RegCheckErr(Buf, RoutineName)) return - ! SIG_PORt call RegUnpack(Buf, OutData%SIG_PORt) if (RegCheckErr(Buf, RoutineName)) return - ! TEC_Freq call RegUnpack(Buf, OutData%TEC_Freq) if (RegCheckErr(Buf, RoutineName)) return - ! TEC_NPol call RegUnpack(Buf, OutData%TEC_NPol) if (RegCheckErr(Buf, RoutineName)) return - ! TEC_SRes call RegUnpack(Buf, OutData%TEC_SRes) if (RegCheckErr(Buf, RoutineName)) return - ! TEC_RRes call RegUnpack(Buf, OutData%TEC_RRes) if (RegCheckErr(Buf, RoutineName)) return - ! TEC_VLL call RegUnpack(Buf, OutData%TEC_VLL) if (RegCheckErr(Buf, RoutineName)) return - ! TEC_SLR call RegUnpack(Buf, OutData%TEC_SLR) if (RegCheckErr(Buf, RoutineName)) return - ! TEC_RLR call RegUnpack(Buf, OutData%TEC_RLR) if (RegCheckErr(Buf, RoutineName)) return - ! TEC_MR call RegUnpack(Buf, OutData%TEC_MR) if (RegCheckErr(Buf, RoutineName)) return - ! HSSBrMode call RegUnpack(Buf, OutData%HSSBrMode) if (RegCheckErr(Buf, RoutineName)) return - ! THSSBrDp call RegUnpack(Buf, OutData%THSSBrDp) if (RegCheckErr(Buf, RoutineName)) return - ! HSSBrDT call RegUnpack(Buf, OutData%HSSBrDT) if (RegCheckErr(Buf, RoutineName)) return - ! HSSBrTqF call RegUnpack(Buf, OutData%HSSBrTqF) if (RegCheckErr(Buf, RoutineName)) return - ! YCMode call RegUnpack(Buf, OutData%YCMode) if (RegCheckErr(Buf, RoutineName)) return - ! TYCOn call RegUnpack(Buf, OutData%TYCOn) if (RegCheckErr(Buf, RoutineName)) return - ! YawNeut call RegUnpack(Buf, OutData%YawNeut) if (RegCheckErr(Buf, RoutineName)) return - ! YawSpr call RegUnpack(Buf, OutData%YawSpr) if (RegCheckErr(Buf, RoutineName)) return - ! YawDamp call RegUnpack(Buf, OutData%YawDamp) if (RegCheckErr(Buf, RoutineName)) return - ! TYawManS call RegUnpack(Buf, OutData%TYawManS) if (RegCheckErr(Buf, RoutineName)) return - ! YawManRat call RegUnpack(Buf, OutData%YawManRat) if (RegCheckErr(Buf, RoutineName)) return - ! NacYawF call RegUnpack(Buf, OutData%NacYawF) if (RegCheckErr(Buf, RoutineName)) return - ! SumPrint call RegUnpack(Buf, OutData%SumPrint) if (RegCheckErr(Buf, RoutineName)) return - ! OutFile call RegUnpack(Buf, OutData%OutFile) if (RegCheckErr(Buf, RoutineName)) return - ! TabDelim call RegUnpack(Buf, OutData%TabDelim) if (RegCheckErr(Buf, RoutineName)) return - ! OutFmt call RegUnpack(Buf, OutData%OutFmt) if (RegCheckErr(Buf, RoutineName)) return - ! Tstart call RegUnpack(Buf, OutData%Tstart) if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegUnpack(Buf, OutData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! OutList if (allocated(OutData%OutList)) deallocate(OutData%OutList) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2459,67 +2218,46 @@ subroutine SrvD_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%OutList) if (RegCheckErr(Buf, RoutineName)) return end if - ! DLL_FileName call RegUnpack(Buf, OutData%DLL_FileName) if (RegCheckErr(Buf, RoutineName)) return - ! DLL_ProcName call RegUnpack(Buf, OutData%DLL_ProcName) if (RegCheckErr(Buf, RoutineName)) return - ! DLL_InFile call RegUnpack(Buf, OutData%DLL_InFile) if (RegCheckErr(Buf, RoutineName)) return - ! DLL_DT call RegUnpack(Buf, OutData%DLL_DT) if (RegCheckErr(Buf, RoutineName)) return - ! DLL_Ramp call RegUnpack(Buf, OutData%DLL_Ramp) if (RegCheckErr(Buf, RoutineName)) return - ! BPCutoff call RegUnpack(Buf, OutData%BPCutoff) if (RegCheckErr(Buf, RoutineName)) return - ! NacYaw_North call RegUnpack(Buf, OutData%NacYaw_North) if (RegCheckErr(Buf, RoutineName)) return - ! Ptch_Cntrl call RegUnpack(Buf, OutData%Ptch_Cntrl) if (RegCheckErr(Buf, RoutineName)) return - ! Ptch_SetPnt call RegUnpack(Buf, OutData%Ptch_SetPnt) if (RegCheckErr(Buf, RoutineName)) return - ! Ptch_Min call RegUnpack(Buf, OutData%Ptch_Min) if (RegCheckErr(Buf, RoutineName)) return - ! Ptch_Max call RegUnpack(Buf, OutData%Ptch_Max) if (RegCheckErr(Buf, RoutineName)) return - ! PtchRate_Min call RegUnpack(Buf, OutData%PtchRate_Min) if (RegCheckErr(Buf, RoutineName)) return - ! PtchRate_Max call RegUnpack(Buf, OutData%PtchRate_Max) if (RegCheckErr(Buf, RoutineName)) return - ! Gain_OM call RegUnpack(Buf, OutData%Gain_OM) if (RegCheckErr(Buf, RoutineName)) return - ! GenSpd_MinOM call RegUnpack(Buf, OutData%GenSpd_MinOM) if (RegCheckErr(Buf, RoutineName)) return - ! GenSpd_MaxOM call RegUnpack(Buf, OutData%GenSpd_MaxOM) if (RegCheckErr(Buf, RoutineName)) return - ! GenSpd_Dem call RegUnpack(Buf, OutData%GenSpd_Dem) if (RegCheckErr(Buf, RoutineName)) return - ! GenTrq_Dem call RegUnpack(Buf, OutData%GenTrq_Dem) if (RegCheckErr(Buf, RoutineName)) return - ! GenPwr_Dem call RegUnpack(Buf, OutData%GenPwr_Dem) if (RegCheckErr(Buf, RoutineName)) return - ! DLL_NumTrq call RegUnpack(Buf, OutData%DLL_NumTrq) if (RegCheckErr(Buf, RoutineName)) return - ! GenSpd_TLU if (allocated(OutData%GenSpd_TLU)) deallocate(OutData%GenSpd_TLU) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2534,7 +2272,6 @@ subroutine SrvD_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%GenSpd_TLU) if (RegCheckErr(Buf, RoutineName)) return end if - ! GenTrq_TLU if (allocated(OutData%GenTrq_TLU)) deallocate(OutData%GenTrq_TLU) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2549,13 +2286,10 @@ subroutine SrvD_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%GenTrq_TLU) if (RegCheckErr(Buf, RoutineName)) return end if - ! UseLegacyInterface call RegUnpack(Buf, OutData%UseLegacyInterface) if (RegCheckErr(Buf, RoutineName)) return - ! NumBStC call RegUnpack(Buf, OutData%NumBStC) if (RegCheckErr(Buf, RoutineName)) return - ! BStCfiles if (allocated(OutData%BStCfiles)) deallocate(OutData%BStCfiles) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2570,10 +2304,8 @@ subroutine SrvD_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%BStCfiles) if (RegCheckErr(Buf, RoutineName)) return end if - ! NumNStC call RegUnpack(Buf, OutData%NumNStC) if (RegCheckErr(Buf, RoutineName)) return - ! NStCfiles if (allocated(OutData%NStCfiles)) deallocate(OutData%NStCfiles) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2588,10 +2320,8 @@ subroutine SrvD_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%NStCfiles) if (RegCheckErr(Buf, RoutineName)) return end if - ! NumTStC call RegUnpack(Buf, OutData%NumTStC) if (RegCheckErr(Buf, RoutineName)) return - ! TStCfiles if (allocated(OutData%TStCfiles)) deallocate(OutData%TStCfiles) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2606,10 +2336,8 @@ subroutine SrvD_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%TStCfiles) if (RegCheckErr(Buf, RoutineName)) return end if - ! NumSStC call RegUnpack(Buf, OutData%NumSStC) if (RegCheckErr(Buf, RoutineName)) return - ! SStCfiles if (allocated(OutData%SStCfiles)) deallocate(OutData%SStCfiles) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2624,531 +2352,552 @@ subroutine SrvD_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%SStCfiles) if (RegCheckErr(Buf, RoutineName)) return end if - ! AfCmode call RegUnpack(Buf, OutData%AfCmode) if (RegCheckErr(Buf, RoutineName)) return - ! AfC_Mean call RegUnpack(Buf, OutData%AfC_Mean) if (RegCheckErr(Buf, RoutineName)) return - ! AfC_Amp call RegUnpack(Buf, OutData%AfC_Amp) if (RegCheckErr(Buf, RoutineName)) return - ! AfC_Phase call RegUnpack(Buf, OutData%AfC_Phase) if (RegCheckErr(Buf, RoutineName)) return - ! CCmode call RegUnpack(Buf, OutData%CCmode) if (RegCheckErr(Buf, RoutineName)) return - ! EXavrSWAP call RegUnpack(Buf, OutData%EXavrSWAP) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE SrvD_CopyBladedDLLType( SrcBladedDLLTypeData, DstBladedDLLTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BladedDLLType), INTENT(IN) :: SrcBladedDLLTypeData - TYPE(BladedDLLType), INTENT(INOUT) :: DstBladedDLLTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_CopyBladedDLLType' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcBladedDLLTypeData%avrSWAP)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%avrSWAP,1) - i1_u = UBOUND(SrcBladedDLLTypeData%avrSWAP,1) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%avrSWAP)) THEN - ALLOCATE(DstBladedDLLTypeData%avrSWAP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%avrSWAP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%avrSWAP = SrcBladedDLLTypeData%avrSWAP -ENDIF - DstBladedDLLTypeData%HSSBrTrqDemand = SrcBladedDLLTypeData%HSSBrTrqDemand - DstBladedDLLTypeData%YawRateCom = SrcBladedDLLTypeData%YawRateCom - DstBladedDLLTypeData%GenTrq = SrcBladedDLLTypeData%GenTrq - DstBladedDLLTypeData%GenState = SrcBladedDLLTypeData%GenState - DstBladedDLLTypeData%BlPitchCom = SrcBladedDLLTypeData%BlPitchCom - DstBladedDLLTypeData%PrevBlPitch = SrcBladedDLLTypeData%PrevBlPitch - DstBladedDLLTypeData%BlAirfoilCom = SrcBladedDLLTypeData%BlAirfoilCom - DstBladedDLLTypeData%PrevBlAirfoilCom = SrcBladedDLLTypeData%PrevBlAirfoilCom - DstBladedDLLTypeData%ElecPwr_prev = SrcBladedDLLTypeData%ElecPwr_prev - DstBladedDLLTypeData%GenTrq_prev = SrcBladedDLLTypeData%GenTrq_prev -IF (ALLOCATED(SrcBladedDLLTypeData%toSC)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%toSC,1) - i1_u = UBOUND(SrcBladedDLLTypeData%toSC,1) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%toSC)) THEN - ALLOCATE(DstBladedDLLTypeData%toSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%toSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%toSC = SrcBladedDLLTypeData%toSC -ENDIF - DstBladedDLLTypeData%initialized = SrcBladedDLLTypeData%initialized - DstBladedDLLTypeData%NumLogChannels = SrcBladedDLLTypeData%NumLogChannels -IF (ALLOCATED(SrcBladedDLLTypeData%LogChannels_OutParam)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%LogChannels_OutParam,1) - i1_u = UBOUND(SrcBladedDLLTypeData%LogChannels_OutParam,1) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%LogChannels_OutParam)) THEN - ALLOCATE(DstBladedDLLTypeData%LogChannels_OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%LogChannels_OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcBladedDLLTypeData%LogChannels_OutParam,1), UBOUND(SrcBladedDLLTypeData%LogChannels_OutParam,1) - CALL NWTC_Library_Copyoutparmtype( SrcBladedDLLTypeData%LogChannels_OutParam(i1), DstBladedDLLTypeData%LogChannels_OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%LogChannels)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%LogChannels,1) - i1_u = UBOUND(SrcBladedDLLTypeData%LogChannels,1) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%LogChannels)) THEN - ALLOCATE(DstBladedDLLTypeData%LogChannels(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%LogChannels.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%LogChannels = SrcBladedDLLTypeData%LogChannels -ENDIF - DstBladedDLLTypeData%ErrStat = SrcBladedDLLTypeData%ErrStat - DstBladedDLLTypeData%ErrMsg = SrcBladedDLLTypeData%ErrMsg - DstBladedDLLTypeData%CurrentTime = SrcBladedDLLTypeData%CurrentTime - DstBladedDLLTypeData%SimStatus = SrcBladedDLLTypeData%SimStatus - DstBladedDLLTypeData%ShaftBrakeStatusBinaryFlag = SrcBladedDLLTypeData%ShaftBrakeStatusBinaryFlag - DstBladedDLLTypeData%HSSBrDeployed = SrcBladedDLLTypeData%HSSBrDeployed - DstBladedDLLTypeData%TimeHSSBrFullyDeployed = SrcBladedDLLTypeData%TimeHSSBrFullyDeployed - DstBladedDLLTypeData%TimeHSSBrDeployed = SrcBladedDLLTypeData%TimeHSSBrDeployed - DstBladedDLLTypeData%OverrideYawRateWithTorque = SrcBladedDLLTypeData%OverrideYawRateWithTorque - DstBladedDLLTypeData%YawTorqueDemand = SrcBladedDLLTypeData%YawTorqueDemand -IF (ALLOCATED(SrcBladedDLLTypeData%BlPitchInput)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%BlPitchInput,1) - i1_u = UBOUND(SrcBladedDLLTypeData%BlPitchInput,1) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%BlPitchInput)) THEN - ALLOCATE(DstBladedDLLTypeData%BlPitchInput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%BlPitchInput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%BlPitchInput = SrcBladedDLLTypeData%BlPitchInput -ENDIF - DstBladedDLLTypeData%YawAngleFromNorth = SrcBladedDLLTypeData%YawAngleFromNorth - DstBladedDLLTypeData%HorWindV = SrcBladedDLLTypeData%HorWindV - DstBladedDLLTypeData%HSS_Spd = SrcBladedDLLTypeData%HSS_Spd - DstBladedDLLTypeData%YawErr = SrcBladedDLLTypeData%YawErr - DstBladedDLLTypeData%RotSpeed = SrcBladedDLLTypeData%RotSpeed - DstBladedDLLTypeData%YawBrTAxp = SrcBladedDLLTypeData%YawBrTAxp - DstBladedDLLTypeData%YawBrTAyp = SrcBladedDLLTypeData%YawBrTAyp - DstBladedDLLTypeData%LSSTipMys = SrcBladedDLLTypeData%LSSTipMys - DstBladedDLLTypeData%LSSTipMzs = SrcBladedDLLTypeData%LSSTipMzs - DstBladedDLLTypeData%LSSTipMya = SrcBladedDLLTypeData%LSSTipMya - DstBladedDLLTypeData%LSSTipMza = SrcBladedDLLTypeData%LSSTipMza - DstBladedDLLTypeData%LSSTipPxa = SrcBladedDLLTypeData%LSSTipPxa - DstBladedDLLTypeData%Yaw = SrcBladedDLLTypeData%Yaw - DstBladedDLLTypeData%YawRate = SrcBladedDLLTypeData%YawRate - DstBladedDLLTypeData%YawBrMyn = SrcBladedDLLTypeData%YawBrMyn - DstBladedDLLTypeData%YawBrMzn = SrcBladedDLLTypeData%YawBrMzn - DstBladedDLLTypeData%NcIMURAxs = SrcBladedDLLTypeData%NcIMURAxs - DstBladedDLLTypeData%NcIMURAys = SrcBladedDLLTypeData%NcIMURAys - DstBladedDLLTypeData%NcIMURAzs = SrcBladedDLLTypeData%NcIMURAzs - DstBladedDLLTypeData%RotPwr = SrcBladedDLLTypeData%RotPwr - DstBladedDLLTypeData%LSSTipMxa = SrcBladedDLLTypeData%LSSTipMxa - DstBladedDLLTypeData%RootMyc = SrcBladedDLLTypeData%RootMyc - DstBladedDLLTypeData%RootMxc = SrcBladedDLLTypeData%RootMxc - DstBladedDLLTypeData%LSShftFxa = SrcBladedDLLTypeData%LSShftFxa - DstBladedDLLTypeData%LSShftFys = SrcBladedDLLTypeData%LSShftFys - DstBladedDLLTypeData%LSShftFzs = SrcBladedDLLTypeData%LSShftFzs -IF (ALLOCATED(SrcBladedDLLTypeData%LidSpeed)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%LidSpeed,1) - i1_u = UBOUND(SrcBladedDLLTypeData%LidSpeed,1) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%LidSpeed)) THEN - ALLOCATE(DstBladedDLLTypeData%LidSpeed(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%LidSpeed.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%LidSpeed = SrcBladedDLLTypeData%LidSpeed -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%MsrPositionsX)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%MsrPositionsX,1) - i1_u = UBOUND(SrcBladedDLLTypeData%MsrPositionsX,1) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%MsrPositionsX)) THEN - ALLOCATE(DstBladedDLLTypeData%MsrPositionsX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%MsrPositionsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%MsrPositionsX = SrcBladedDLLTypeData%MsrPositionsX -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%MsrPositionsY)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%MsrPositionsY,1) - i1_u = UBOUND(SrcBladedDLLTypeData%MsrPositionsY,1) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%MsrPositionsY)) THEN - ALLOCATE(DstBladedDLLTypeData%MsrPositionsY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%MsrPositionsY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%MsrPositionsY = SrcBladedDLLTypeData%MsrPositionsY -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%MsrPositionsZ)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%MsrPositionsZ,1) - i1_u = UBOUND(SrcBladedDLLTypeData%MsrPositionsZ,1) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%MsrPositionsZ)) THEN - ALLOCATE(DstBladedDLLTypeData%MsrPositionsZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%MsrPositionsZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%MsrPositionsZ = SrcBladedDLLTypeData%MsrPositionsZ -ENDIF - DstBladedDLLTypeData%SensorType = SrcBladedDLLTypeData%SensorType - DstBladedDLLTypeData%NumBeam = SrcBladedDLLTypeData%NumBeam - DstBladedDLLTypeData%NumPulseGate = SrcBladedDLLTypeData%NumPulseGate - DstBladedDLLTypeData%PulseSpacing = SrcBladedDLLTypeData%PulseSpacing - DstBladedDLLTypeData%URefLid = SrcBladedDLLTypeData%URefLid - DstBladedDLLTypeData%DLL_DT = SrcBladedDLLTypeData%DLL_DT - DstBladedDLLTypeData%DLL_InFile = SrcBladedDLLTypeData%DLL_InFile - DstBladedDLLTypeData%RootName = SrcBladedDLLTypeData%RootName - DstBladedDLLTypeData%GenTrq_Dem = SrcBladedDLLTypeData%GenTrq_Dem - DstBladedDLLTypeData%GenSpd_Dem = SrcBladedDLLTypeData%GenSpd_Dem - DstBladedDLLTypeData%Ptch_Max = SrcBladedDLLTypeData%Ptch_Max - DstBladedDLLTypeData%Ptch_Min = SrcBladedDLLTypeData%Ptch_Min - DstBladedDLLTypeData%Ptch_SetPnt = SrcBladedDLLTypeData%Ptch_SetPnt - DstBladedDLLTypeData%PtchRate_Max = SrcBladedDLLTypeData%PtchRate_Max - DstBladedDLLTypeData%PtchRate_Min = SrcBladedDLLTypeData%PtchRate_Min - DstBladedDLLTypeData%GenPwr_Dem = SrcBladedDLLTypeData%GenPwr_Dem - DstBladedDLLTypeData%Gain_OM = SrcBladedDLLTypeData%Gain_OM - DstBladedDLLTypeData%GenSpd_MaxOM = SrcBladedDLLTypeData%GenSpd_MaxOM - DstBladedDLLTypeData%GenSpd_MinOM = SrcBladedDLLTypeData%GenSpd_MinOM - DstBladedDLLTypeData%Ptch_Cntrl = SrcBladedDLLTypeData%Ptch_Cntrl - DstBladedDLLTypeData%DLL_NumTrq = SrcBladedDLLTypeData%DLL_NumTrq -IF (ALLOCATED(SrcBladedDLLTypeData%GenSpd_TLU)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%GenSpd_TLU,1) - i1_u = UBOUND(SrcBladedDLLTypeData%GenSpd_TLU,1) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%GenSpd_TLU)) THEN - ALLOCATE(DstBladedDLLTypeData%GenSpd_TLU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%GenSpd_TLU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%GenSpd_TLU = SrcBladedDLLTypeData%GenSpd_TLU -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%GenTrq_TLU)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%GenTrq_TLU,1) - i1_u = UBOUND(SrcBladedDLLTypeData%GenTrq_TLU,1) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%GenTrq_TLU)) THEN - ALLOCATE(DstBladedDLLTypeData%GenTrq_TLU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%GenTrq_TLU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%GenTrq_TLU = SrcBladedDLLTypeData%GenTrq_TLU -ENDIF - DstBladedDLLTypeData%Yaw_Cntrl = SrcBladedDLLTypeData%Yaw_Cntrl -IF (ALLOCATED(SrcBladedDLLTypeData%PrevCableDeltaL)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%PrevCableDeltaL,1) - i1_u = UBOUND(SrcBladedDLLTypeData%PrevCableDeltaL,1) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%PrevCableDeltaL)) THEN - ALLOCATE(DstBladedDLLTypeData%PrevCableDeltaL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%PrevCableDeltaL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%PrevCableDeltaL = SrcBladedDLLTypeData%PrevCableDeltaL -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%PrevCableDeltaLdot)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%PrevCableDeltaLdot,1) - i1_u = UBOUND(SrcBladedDLLTypeData%PrevCableDeltaLdot,1) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%PrevCableDeltaLdot)) THEN - ALLOCATE(DstBladedDLLTypeData%PrevCableDeltaLdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%PrevCableDeltaLdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%PrevCableDeltaLdot = SrcBladedDLLTypeData%PrevCableDeltaLdot -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%CableDeltaL)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%CableDeltaL,1) - i1_u = UBOUND(SrcBladedDLLTypeData%CableDeltaL,1) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%CableDeltaL)) THEN - ALLOCATE(DstBladedDLLTypeData%CableDeltaL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%CableDeltaL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%CableDeltaL = SrcBladedDLLTypeData%CableDeltaL -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%CableDeltaLdot)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%CableDeltaLdot,1) - i1_u = UBOUND(SrcBladedDLLTypeData%CableDeltaLdot,1) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%CableDeltaLdot)) THEN - ALLOCATE(DstBladedDLLTypeData%CableDeltaLdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%CableDeltaLdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%CableDeltaLdot = SrcBladedDLLTypeData%CableDeltaLdot -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%PrevStCCmdStiff)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%PrevStCCmdStiff,1) - i1_u = UBOUND(SrcBladedDLLTypeData%PrevStCCmdStiff,1) - i2_l = LBOUND(SrcBladedDLLTypeData%PrevStCCmdStiff,2) - i2_u = UBOUND(SrcBladedDLLTypeData%PrevStCCmdStiff,2) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%PrevStCCmdStiff)) THEN - ALLOCATE(DstBladedDLLTypeData%PrevStCCmdStiff(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%PrevStCCmdStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%PrevStCCmdStiff = SrcBladedDLLTypeData%PrevStCCmdStiff -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%PrevStCCmdDamp)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%PrevStCCmdDamp,1) - i1_u = UBOUND(SrcBladedDLLTypeData%PrevStCCmdDamp,1) - i2_l = LBOUND(SrcBladedDLLTypeData%PrevStCCmdDamp,2) - i2_u = UBOUND(SrcBladedDLLTypeData%PrevStCCmdDamp,2) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%PrevStCCmdDamp)) THEN - ALLOCATE(DstBladedDLLTypeData%PrevStCCmdDamp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%PrevStCCmdDamp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%PrevStCCmdDamp = SrcBladedDLLTypeData%PrevStCCmdDamp -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%PrevStCCmdBrake)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%PrevStCCmdBrake,1) - i1_u = UBOUND(SrcBladedDLLTypeData%PrevStCCmdBrake,1) - i2_l = LBOUND(SrcBladedDLLTypeData%PrevStCCmdBrake,2) - i2_u = UBOUND(SrcBladedDLLTypeData%PrevStCCmdBrake,2) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%PrevStCCmdBrake)) THEN - ALLOCATE(DstBladedDLLTypeData%PrevStCCmdBrake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%PrevStCCmdBrake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%PrevStCCmdBrake = SrcBladedDLLTypeData%PrevStCCmdBrake -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%PrevStCCmdForce)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%PrevStCCmdForce,1) - i1_u = UBOUND(SrcBladedDLLTypeData%PrevStCCmdForce,1) - i2_l = LBOUND(SrcBladedDLLTypeData%PrevStCCmdForce,2) - i2_u = UBOUND(SrcBladedDLLTypeData%PrevStCCmdForce,2) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%PrevStCCmdForce)) THEN - ALLOCATE(DstBladedDLLTypeData%PrevStCCmdForce(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%PrevStCCmdForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%PrevStCCmdForce = SrcBladedDLLTypeData%PrevStCCmdForce -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%StCCmdStiff)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%StCCmdStiff,1) - i1_u = UBOUND(SrcBladedDLLTypeData%StCCmdStiff,1) - i2_l = LBOUND(SrcBladedDLLTypeData%StCCmdStiff,2) - i2_u = UBOUND(SrcBladedDLLTypeData%StCCmdStiff,2) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%StCCmdStiff)) THEN - ALLOCATE(DstBladedDLLTypeData%StCCmdStiff(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%StCCmdStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%StCCmdStiff = SrcBladedDLLTypeData%StCCmdStiff -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%StCCmdDamp)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%StCCmdDamp,1) - i1_u = UBOUND(SrcBladedDLLTypeData%StCCmdDamp,1) - i2_l = LBOUND(SrcBladedDLLTypeData%StCCmdDamp,2) - i2_u = UBOUND(SrcBladedDLLTypeData%StCCmdDamp,2) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%StCCmdDamp)) THEN - ALLOCATE(DstBladedDLLTypeData%StCCmdDamp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%StCCmdDamp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%StCCmdDamp = SrcBladedDLLTypeData%StCCmdDamp -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%StCCmdBrake)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%StCCmdBrake,1) - i1_u = UBOUND(SrcBladedDLLTypeData%StCCmdBrake,1) - i2_l = LBOUND(SrcBladedDLLTypeData%StCCmdBrake,2) - i2_u = UBOUND(SrcBladedDLLTypeData%StCCmdBrake,2) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%StCCmdBrake)) THEN - ALLOCATE(DstBladedDLLTypeData%StCCmdBrake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%StCCmdBrake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%StCCmdBrake = SrcBladedDLLTypeData%StCCmdBrake -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%StCCmdForce)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%StCCmdForce,1) - i1_u = UBOUND(SrcBladedDLLTypeData%StCCmdForce,1) - i2_l = LBOUND(SrcBladedDLLTypeData%StCCmdForce,2) - i2_u = UBOUND(SrcBladedDLLTypeData%StCCmdForce,2) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%StCCmdForce)) THEN - ALLOCATE(DstBladedDLLTypeData%StCCmdForce(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%StCCmdForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%StCCmdForce = SrcBladedDLLTypeData%StCCmdForce -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%StCMeasDisp)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%StCMeasDisp,1) - i1_u = UBOUND(SrcBladedDLLTypeData%StCMeasDisp,1) - i2_l = LBOUND(SrcBladedDLLTypeData%StCMeasDisp,2) - i2_u = UBOUND(SrcBladedDLLTypeData%StCMeasDisp,2) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%StCMeasDisp)) THEN - ALLOCATE(DstBladedDLLTypeData%StCMeasDisp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%StCMeasDisp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%StCMeasDisp = SrcBladedDLLTypeData%StCMeasDisp -ENDIF -IF (ALLOCATED(SrcBladedDLLTypeData%StCMeasVel)) THEN - i1_l = LBOUND(SrcBladedDLLTypeData%StCMeasVel,1) - i1_u = UBOUND(SrcBladedDLLTypeData%StCMeasVel,1) - i2_l = LBOUND(SrcBladedDLLTypeData%StCMeasVel,2) - i2_u = UBOUND(SrcBladedDLLTypeData%StCMeasVel,2) - IF (.NOT. ALLOCATED(DstBladedDLLTypeData%StCMeasVel)) THEN - ALLOCATE(DstBladedDLLTypeData%StCMeasVel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%StCMeasVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladedDLLTypeData%StCMeasVel = SrcBladedDLLTypeData%StCMeasVel -ENDIF - END SUBROUTINE SrvD_CopyBladedDLLType - SUBROUTINE SrvD_DestroyBladedDLLType( BladedDLLTypeData, ErrStat, ErrMsg ) - TYPE(BladedDLLType), INTENT(INOUT) :: BladedDLLTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyBladedDLLType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(BladedDLLTypeData%avrSWAP)) THEN - DEALLOCATE(BladedDLLTypeData%avrSWAP) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%toSC)) THEN - DEALLOCATE(BladedDLLTypeData%toSC) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%LogChannels_OutParam)) THEN -DO i1 = LBOUND(BladedDLLTypeData%LogChannels_OutParam,1), UBOUND(BladedDLLTypeData%LogChannels_OutParam,1) - CALL NWTC_Library_DestroyOutParmType( BladedDLLTypeData%LogChannels_OutParam(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(BladedDLLTypeData%LogChannels_OutParam) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%LogChannels)) THEN - DEALLOCATE(BladedDLLTypeData%LogChannels) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%BlPitchInput)) THEN - DEALLOCATE(BladedDLLTypeData%BlPitchInput) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%LidSpeed)) THEN - DEALLOCATE(BladedDLLTypeData%LidSpeed) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%MsrPositionsX)) THEN - DEALLOCATE(BladedDLLTypeData%MsrPositionsX) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%MsrPositionsY)) THEN - DEALLOCATE(BladedDLLTypeData%MsrPositionsY) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%MsrPositionsZ)) THEN - DEALLOCATE(BladedDLLTypeData%MsrPositionsZ) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%GenSpd_TLU)) THEN - DEALLOCATE(BladedDLLTypeData%GenSpd_TLU) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%GenTrq_TLU)) THEN - DEALLOCATE(BladedDLLTypeData%GenTrq_TLU) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%PrevCableDeltaL)) THEN - DEALLOCATE(BladedDLLTypeData%PrevCableDeltaL) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%PrevCableDeltaLdot)) THEN - DEALLOCATE(BladedDLLTypeData%PrevCableDeltaLdot) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%CableDeltaL)) THEN - DEALLOCATE(BladedDLLTypeData%CableDeltaL) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%CableDeltaLdot)) THEN - DEALLOCATE(BladedDLLTypeData%CableDeltaLdot) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%PrevStCCmdStiff)) THEN - DEALLOCATE(BladedDLLTypeData%PrevStCCmdStiff) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%PrevStCCmdDamp)) THEN - DEALLOCATE(BladedDLLTypeData%PrevStCCmdDamp) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%PrevStCCmdBrake)) THEN - DEALLOCATE(BladedDLLTypeData%PrevStCCmdBrake) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%PrevStCCmdForce)) THEN - DEALLOCATE(BladedDLLTypeData%PrevStCCmdForce) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%StCCmdStiff)) THEN - DEALLOCATE(BladedDLLTypeData%StCCmdStiff) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%StCCmdDamp)) THEN - DEALLOCATE(BladedDLLTypeData%StCCmdDamp) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%StCCmdBrake)) THEN - DEALLOCATE(BladedDLLTypeData%StCCmdBrake) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%StCCmdForce)) THEN - DEALLOCATE(BladedDLLTypeData%StCCmdForce) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%StCMeasDisp)) THEN - DEALLOCATE(BladedDLLTypeData%StCMeasDisp) -ENDIF -IF (ALLOCATED(BladedDLLTypeData%StCMeasVel)) THEN - DEALLOCATE(BladedDLLTypeData%StCMeasVel) -ENDIF - END SUBROUTINE SrvD_DestroyBladedDLLType +subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, CtrlCode, ErrStat, ErrMsg) + type(BladedDLLType), intent(in) :: SrcBladedDLLTypeData + type(BladedDLLType), intent(inout) :: DstBladedDLLTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_CopyBladedDLLType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcBladedDLLTypeData%avrSWAP)) then + LB(1:1) = lbound(SrcBladedDLLTypeData%avrSWAP) + UB(1:1) = ubound(SrcBladedDLLTypeData%avrSWAP) + if (.not. allocated(DstBladedDLLTypeData%avrSWAP)) then + allocate(DstBladedDLLTypeData%avrSWAP(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%avrSWAP.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%avrSWAP = SrcBladedDLLTypeData%avrSWAP + else if (allocated(DstBladedDLLTypeData%avrSWAP)) then + deallocate(DstBladedDLLTypeData%avrSWAP) + end if + DstBladedDLLTypeData%HSSBrTrqDemand = SrcBladedDLLTypeData%HSSBrTrqDemand + DstBladedDLLTypeData%YawRateCom = SrcBladedDLLTypeData%YawRateCom + DstBladedDLLTypeData%GenTrq = SrcBladedDLLTypeData%GenTrq + DstBladedDLLTypeData%GenState = SrcBladedDLLTypeData%GenState + DstBladedDLLTypeData%BlPitchCom = SrcBladedDLLTypeData%BlPitchCom + DstBladedDLLTypeData%PrevBlPitch = SrcBladedDLLTypeData%PrevBlPitch + DstBladedDLLTypeData%BlAirfoilCom = SrcBladedDLLTypeData%BlAirfoilCom + DstBladedDLLTypeData%PrevBlAirfoilCom = SrcBladedDLLTypeData%PrevBlAirfoilCom + DstBladedDLLTypeData%ElecPwr_prev = SrcBladedDLLTypeData%ElecPwr_prev + DstBladedDLLTypeData%GenTrq_prev = SrcBladedDLLTypeData%GenTrq_prev + if (allocated(SrcBladedDLLTypeData%toSC)) then + LB(1:1) = lbound(SrcBladedDLLTypeData%toSC) + UB(1:1) = ubound(SrcBladedDLLTypeData%toSC) + if (.not. allocated(DstBladedDLLTypeData%toSC)) then + allocate(DstBladedDLLTypeData%toSC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%toSC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%toSC = SrcBladedDLLTypeData%toSC + else if (allocated(DstBladedDLLTypeData%toSC)) then + deallocate(DstBladedDLLTypeData%toSC) + end if + DstBladedDLLTypeData%initialized = SrcBladedDLLTypeData%initialized + DstBladedDLLTypeData%NumLogChannels = SrcBladedDLLTypeData%NumLogChannels + if (allocated(SrcBladedDLLTypeData%LogChannels_OutParam)) then + LB(1:1) = lbound(SrcBladedDLLTypeData%LogChannels_OutParam) + UB(1:1) = ubound(SrcBladedDLLTypeData%LogChannels_OutParam) + if (.not. allocated(DstBladedDLLTypeData%LogChannels_OutParam)) then + allocate(DstBladedDLLTypeData%LogChannels_OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%LogChannels_OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcBladedDLLTypeData%LogChannels_OutParam(i1), DstBladedDLLTypeData%LogChannels_OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstBladedDLLTypeData%LogChannels_OutParam)) then + deallocate(DstBladedDLLTypeData%LogChannels_OutParam) + end if + if (allocated(SrcBladedDLLTypeData%LogChannels)) then + LB(1:1) = lbound(SrcBladedDLLTypeData%LogChannels) + UB(1:1) = ubound(SrcBladedDLLTypeData%LogChannels) + if (.not. allocated(DstBladedDLLTypeData%LogChannels)) then + allocate(DstBladedDLLTypeData%LogChannels(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%LogChannels.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%LogChannels = SrcBladedDLLTypeData%LogChannels + else if (allocated(DstBladedDLLTypeData%LogChannels)) then + deallocate(DstBladedDLLTypeData%LogChannels) + end if + DstBladedDLLTypeData%ErrStat = SrcBladedDLLTypeData%ErrStat + DstBladedDLLTypeData%ErrMsg = SrcBladedDLLTypeData%ErrMsg + DstBladedDLLTypeData%CurrentTime = SrcBladedDLLTypeData%CurrentTime + DstBladedDLLTypeData%SimStatus = SrcBladedDLLTypeData%SimStatus + DstBladedDLLTypeData%ShaftBrakeStatusBinaryFlag = SrcBladedDLLTypeData%ShaftBrakeStatusBinaryFlag + DstBladedDLLTypeData%HSSBrDeployed = SrcBladedDLLTypeData%HSSBrDeployed + DstBladedDLLTypeData%TimeHSSBrFullyDeployed = SrcBladedDLLTypeData%TimeHSSBrFullyDeployed + DstBladedDLLTypeData%TimeHSSBrDeployed = SrcBladedDLLTypeData%TimeHSSBrDeployed + DstBladedDLLTypeData%OverrideYawRateWithTorque = SrcBladedDLLTypeData%OverrideYawRateWithTorque + DstBladedDLLTypeData%YawTorqueDemand = SrcBladedDLLTypeData%YawTorqueDemand + if (allocated(SrcBladedDLLTypeData%BlPitchInput)) then + LB(1:1) = lbound(SrcBladedDLLTypeData%BlPitchInput) + UB(1:1) = ubound(SrcBladedDLLTypeData%BlPitchInput) + if (.not. allocated(DstBladedDLLTypeData%BlPitchInput)) then + allocate(DstBladedDLLTypeData%BlPitchInput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%BlPitchInput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%BlPitchInput = SrcBladedDLLTypeData%BlPitchInput + else if (allocated(DstBladedDLLTypeData%BlPitchInput)) then + deallocate(DstBladedDLLTypeData%BlPitchInput) + end if + DstBladedDLLTypeData%YawAngleFromNorth = SrcBladedDLLTypeData%YawAngleFromNorth + DstBladedDLLTypeData%HorWindV = SrcBladedDLLTypeData%HorWindV + DstBladedDLLTypeData%HSS_Spd = SrcBladedDLLTypeData%HSS_Spd + DstBladedDLLTypeData%YawErr = SrcBladedDLLTypeData%YawErr + DstBladedDLLTypeData%RotSpeed = SrcBladedDLLTypeData%RotSpeed + DstBladedDLLTypeData%YawBrTAxp = SrcBladedDLLTypeData%YawBrTAxp + DstBladedDLLTypeData%YawBrTAyp = SrcBladedDLLTypeData%YawBrTAyp + DstBladedDLLTypeData%LSSTipMys = SrcBladedDLLTypeData%LSSTipMys + DstBladedDLLTypeData%LSSTipMzs = SrcBladedDLLTypeData%LSSTipMzs + DstBladedDLLTypeData%LSSTipMya = SrcBladedDLLTypeData%LSSTipMya + DstBladedDLLTypeData%LSSTipMza = SrcBladedDLLTypeData%LSSTipMza + DstBladedDLLTypeData%LSSTipPxa = SrcBladedDLLTypeData%LSSTipPxa + DstBladedDLLTypeData%Yaw = SrcBladedDLLTypeData%Yaw + DstBladedDLLTypeData%YawRate = SrcBladedDLLTypeData%YawRate + DstBladedDLLTypeData%YawBrMyn = SrcBladedDLLTypeData%YawBrMyn + DstBladedDLLTypeData%YawBrMzn = SrcBladedDLLTypeData%YawBrMzn + DstBladedDLLTypeData%NcIMURAxs = SrcBladedDLLTypeData%NcIMURAxs + DstBladedDLLTypeData%NcIMURAys = SrcBladedDLLTypeData%NcIMURAys + DstBladedDLLTypeData%NcIMURAzs = SrcBladedDLLTypeData%NcIMURAzs + DstBladedDLLTypeData%RotPwr = SrcBladedDLLTypeData%RotPwr + DstBladedDLLTypeData%LSSTipMxa = SrcBladedDLLTypeData%LSSTipMxa + DstBladedDLLTypeData%RootMyc = SrcBladedDLLTypeData%RootMyc + DstBladedDLLTypeData%RootMxc = SrcBladedDLLTypeData%RootMxc + DstBladedDLLTypeData%LSShftFxa = SrcBladedDLLTypeData%LSShftFxa + DstBladedDLLTypeData%LSShftFys = SrcBladedDLLTypeData%LSShftFys + DstBladedDLLTypeData%LSShftFzs = SrcBladedDLLTypeData%LSShftFzs + if (allocated(SrcBladedDLLTypeData%LidSpeed)) then + LB(1:1) = lbound(SrcBladedDLLTypeData%LidSpeed) + UB(1:1) = ubound(SrcBladedDLLTypeData%LidSpeed) + if (.not. allocated(DstBladedDLLTypeData%LidSpeed)) then + allocate(DstBladedDLLTypeData%LidSpeed(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%LidSpeed.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%LidSpeed = SrcBladedDLLTypeData%LidSpeed + else if (allocated(DstBladedDLLTypeData%LidSpeed)) then + deallocate(DstBladedDLLTypeData%LidSpeed) + end if + if (allocated(SrcBladedDLLTypeData%MsrPositionsX)) then + LB(1:1) = lbound(SrcBladedDLLTypeData%MsrPositionsX) + UB(1:1) = ubound(SrcBladedDLLTypeData%MsrPositionsX) + if (.not. allocated(DstBladedDLLTypeData%MsrPositionsX)) then + allocate(DstBladedDLLTypeData%MsrPositionsX(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%MsrPositionsX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%MsrPositionsX = SrcBladedDLLTypeData%MsrPositionsX + else if (allocated(DstBladedDLLTypeData%MsrPositionsX)) then + deallocate(DstBladedDLLTypeData%MsrPositionsX) + end if + if (allocated(SrcBladedDLLTypeData%MsrPositionsY)) then + LB(1:1) = lbound(SrcBladedDLLTypeData%MsrPositionsY) + UB(1:1) = ubound(SrcBladedDLLTypeData%MsrPositionsY) + if (.not. allocated(DstBladedDLLTypeData%MsrPositionsY)) then + allocate(DstBladedDLLTypeData%MsrPositionsY(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%MsrPositionsY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%MsrPositionsY = SrcBladedDLLTypeData%MsrPositionsY + else if (allocated(DstBladedDLLTypeData%MsrPositionsY)) then + deallocate(DstBladedDLLTypeData%MsrPositionsY) + end if + if (allocated(SrcBladedDLLTypeData%MsrPositionsZ)) then + LB(1:1) = lbound(SrcBladedDLLTypeData%MsrPositionsZ) + UB(1:1) = ubound(SrcBladedDLLTypeData%MsrPositionsZ) + if (.not. allocated(DstBladedDLLTypeData%MsrPositionsZ)) then + allocate(DstBladedDLLTypeData%MsrPositionsZ(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%MsrPositionsZ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%MsrPositionsZ = SrcBladedDLLTypeData%MsrPositionsZ + else if (allocated(DstBladedDLLTypeData%MsrPositionsZ)) then + deallocate(DstBladedDLLTypeData%MsrPositionsZ) + end if + DstBladedDLLTypeData%SensorType = SrcBladedDLLTypeData%SensorType + DstBladedDLLTypeData%NumBeam = SrcBladedDLLTypeData%NumBeam + DstBladedDLLTypeData%NumPulseGate = SrcBladedDLLTypeData%NumPulseGate + DstBladedDLLTypeData%PulseSpacing = SrcBladedDLLTypeData%PulseSpacing + DstBladedDLLTypeData%URefLid = SrcBladedDLLTypeData%URefLid + DstBladedDLLTypeData%DLL_DT = SrcBladedDLLTypeData%DLL_DT + DstBladedDLLTypeData%DLL_InFile = SrcBladedDLLTypeData%DLL_InFile + DstBladedDLLTypeData%RootName = SrcBladedDLLTypeData%RootName + DstBladedDLLTypeData%GenTrq_Dem = SrcBladedDLLTypeData%GenTrq_Dem + DstBladedDLLTypeData%GenSpd_Dem = SrcBladedDLLTypeData%GenSpd_Dem + DstBladedDLLTypeData%Ptch_Max = SrcBladedDLLTypeData%Ptch_Max + DstBladedDLLTypeData%Ptch_Min = SrcBladedDLLTypeData%Ptch_Min + DstBladedDLLTypeData%Ptch_SetPnt = SrcBladedDLLTypeData%Ptch_SetPnt + DstBladedDLLTypeData%PtchRate_Max = SrcBladedDLLTypeData%PtchRate_Max + DstBladedDLLTypeData%PtchRate_Min = SrcBladedDLLTypeData%PtchRate_Min + DstBladedDLLTypeData%GenPwr_Dem = SrcBladedDLLTypeData%GenPwr_Dem + DstBladedDLLTypeData%Gain_OM = SrcBladedDLLTypeData%Gain_OM + DstBladedDLLTypeData%GenSpd_MaxOM = SrcBladedDLLTypeData%GenSpd_MaxOM + DstBladedDLLTypeData%GenSpd_MinOM = SrcBladedDLLTypeData%GenSpd_MinOM + DstBladedDLLTypeData%Ptch_Cntrl = SrcBladedDLLTypeData%Ptch_Cntrl + DstBladedDLLTypeData%DLL_NumTrq = SrcBladedDLLTypeData%DLL_NumTrq + if (allocated(SrcBladedDLLTypeData%GenSpd_TLU)) then + LB(1:1) = lbound(SrcBladedDLLTypeData%GenSpd_TLU) + UB(1:1) = ubound(SrcBladedDLLTypeData%GenSpd_TLU) + if (.not. allocated(DstBladedDLLTypeData%GenSpd_TLU)) then + allocate(DstBladedDLLTypeData%GenSpd_TLU(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%GenSpd_TLU.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%GenSpd_TLU = SrcBladedDLLTypeData%GenSpd_TLU + else if (allocated(DstBladedDLLTypeData%GenSpd_TLU)) then + deallocate(DstBladedDLLTypeData%GenSpd_TLU) + end if + if (allocated(SrcBladedDLLTypeData%GenTrq_TLU)) then + LB(1:1) = lbound(SrcBladedDLLTypeData%GenTrq_TLU) + UB(1:1) = ubound(SrcBladedDLLTypeData%GenTrq_TLU) + if (.not. allocated(DstBladedDLLTypeData%GenTrq_TLU)) then + allocate(DstBladedDLLTypeData%GenTrq_TLU(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%GenTrq_TLU.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%GenTrq_TLU = SrcBladedDLLTypeData%GenTrq_TLU + else if (allocated(DstBladedDLLTypeData%GenTrq_TLU)) then + deallocate(DstBladedDLLTypeData%GenTrq_TLU) + end if + DstBladedDLLTypeData%Yaw_Cntrl = SrcBladedDLLTypeData%Yaw_Cntrl + if (allocated(SrcBladedDLLTypeData%PrevCableDeltaL)) then + LB(1:1) = lbound(SrcBladedDLLTypeData%PrevCableDeltaL) + UB(1:1) = ubound(SrcBladedDLLTypeData%PrevCableDeltaL) + if (.not. allocated(DstBladedDLLTypeData%PrevCableDeltaL)) then + allocate(DstBladedDLLTypeData%PrevCableDeltaL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%PrevCableDeltaL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%PrevCableDeltaL = SrcBladedDLLTypeData%PrevCableDeltaL + else if (allocated(DstBladedDLLTypeData%PrevCableDeltaL)) then + deallocate(DstBladedDLLTypeData%PrevCableDeltaL) + end if + if (allocated(SrcBladedDLLTypeData%PrevCableDeltaLdot)) then + LB(1:1) = lbound(SrcBladedDLLTypeData%PrevCableDeltaLdot) + UB(1:1) = ubound(SrcBladedDLLTypeData%PrevCableDeltaLdot) + if (.not. allocated(DstBladedDLLTypeData%PrevCableDeltaLdot)) then + allocate(DstBladedDLLTypeData%PrevCableDeltaLdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%PrevCableDeltaLdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%PrevCableDeltaLdot = SrcBladedDLLTypeData%PrevCableDeltaLdot + else if (allocated(DstBladedDLLTypeData%PrevCableDeltaLdot)) then + deallocate(DstBladedDLLTypeData%PrevCableDeltaLdot) + end if + if (allocated(SrcBladedDLLTypeData%CableDeltaL)) then + LB(1:1) = lbound(SrcBladedDLLTypeData%CableDeltaL) + UB(1:1) = ubound(SrcBladedDLLTypeData%CableDeltaL) + if (.not. allocated(DstBladedDLLTypeData%CableDeltaL)) then + allocate(DstBladedDLLTypeData%CableDeltaL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%CableDeltaL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%CableDeltaL = SrcBladedDLLTypeData%CableDeltaL + else if (allocated(DstBladedDLLTypeData%CableDeltaL)) then + deallocate(DstBladedDLLTypeData%CableDeltaL) + end if + if (allocated(SrcBladedDLLTypeData%CableDeltaLdot)) then + LB(1:1) = lbound(SrcBladedDLLTypeData%CableDeltaLdot) + UB(1:1) = ubound(SrcBladedDLLTypeData%CableDeltaLdot) + if (.not. allocated(DstBladedDLLTypeData%CableDeltaLdot)) then + allocate(DstBladedDLLTypeData%CableDeltaLdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%CableDeltaLdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%CableDeltaLdot = SrcBladedDLLTypeData%CableDeltaLdot + else if (allocated(DstBladedDLLTypeData%CableDeltaLdot)) then + deallocate(DstBladedDLLTypeData%CableDeltaLdot) + end if + if (allocated(SrcBladedDLLTypeData%PrevStCCmdStiff)) then + LB(1:2) = lbound(SrcBladedDLLTypeData%PrevStCCmdStiff) + UB(1:2) = ubound(SrcBladedDLLTypeData%PrevStCCmdStiff) + if (.not. allocated(DstBladedDLLTypeData%PrevStCCmdStiff)) then + allocate(DstBladedDLLTypeData%PrevStCCmdStiff(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%PrevStCCmdStiff.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%PrevStCCmdStiff = SrcBladedDLLTypeData%PrevStCCmdStiff + else if (allocated(DstBladedDLLTypeData%PrevStCCmdStiff)) then + deallocate(DstBladedDLLTypeData%PrevStCCmdStiff) + end if + if (allocated(SrcBladedDLLTypeData%PrevStCCmdDamp)) then + LB(1:2) = lbound(SrcBladedDLLTypeData%PrevStCCmdDamp) + UB(1:2) = ubound(SrcBladedDLLTypeData%PrevStCCmdDamp) + if (.not. allocated(DstBladedDLLTypeData%PrevStCCmdDamp)) then + allocate(DstBladedDLLTypeData%PrevStCCmdDamp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%PrevStCCmdDamp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%PrevStCCmdDamp = SrcBladedDLLTypeData%PrevStCCmdDamp + else if (allocated(DstBladedDLLTypeData%PrevStCCmdDamp)) then + deallocate(DstBladedDLLTypeData%PrevStCCmdDamp) + end if + if (allocated(SrcBladedDLLTypeData%PrevStCCmdBrake)) then + LB(1:2) = lbound(SrcBladedDLLTypeData%PrevStCCmdBrake) + UB(1:2) = ubound(SrcBladedDLLTypeData%PrevStCCmdBrake) + if (.not. allocated(DstBladedDLLTypeData%PrevStCCmdBrake)) then + allocate(DstBladedDLLTypeData%PrevStCCmdBrake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%PrevStCCmdBrake.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%PrevStCCmdBrake = SrcBladedDLLTypeData%PrevStCCmdBrake + else if (allocated(DstBladedDLLTypeData%PrevStCCmdBrake)) then + deallocate(DstBladedDLLTypeData%PrevStCCmdBrake) + end if + if (allocated(SrcBladedDLLTypeData%PrevStCCmdForce)) then + LB(1:2) = lbound(SrcBladedDLLTypeData%PrevStCCmdForce) + UB(1:2) = ubound(SrcBladedDLLTypeData%PrevStCCmdForce) + if (.not. allocated(DstBladedDLLTypeData%PrevStCCmdForce)) then + allocate(DstBladedDLLTypeData%PrevStCCmdForce(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%PrevStCCmdForce.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%PrevStCCmdForce = SrcBladedDLLTypeData%PrevStCCmdForce + else if (allocated(DstBladedDLLTypeData%PrevStCCmdForce)) then + deallocate(DstBladedDLLTypeData%PrevStCCmdForce) + end if + if (allocated(SrcBladedDLLTypeData%StCCmdStiff)) then + LB(1:2) = lbound(SrcBladedDLLTypeData%StCCmdStiff) + UB(1:2) = ubound(SrcBladedDLLTypeData%StCCmdStiff) + if (.not. allocated(DstBladedDLLTypeData%StCCmdStiff)) then + allocate(DstBladedDLLTypeData%StCCmdStiff(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%StCCmdStiff.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%StCCmdStiff = SrcBladedDLLTypeData%StCCmdStiff + else if (allocated(DstBladedDLLTypeData%StCCmdStiff)) then + deallocate(DstBladedDLLTypeData%StCCmdStiff) + end if + if (allocated(SrcBladedDLLTypeData%StCCmdDamp)) then + LB(1:2) = lbound(SrcBladedDLLTypeData%StCCmdDamp) + UB(1:2) = ubound(SrcBladedDLLTypeData%StCCmdDamp) + if (.not. allocated(DstBladedDLLTypeData%StCCmdDamp)) then + allocate(DstBladedDLLTypeData%StCCmdDamp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%StCCmdDamp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%StCCmdDamp = SrcBladedDLLTypeData%StCCmdDamp + else if (allocated(DstBladedDLLTypeData%StCCmdDamp)) then + deallocate(DstBladedDLLTypeData%StCCmdDamp) + end if + if (allocated(SrcBladedDLLTypeData%StCCmdBrake)) then + LB(1:2) = lbound(SrcBladedDLLTypeData%StCCmdBrake) + UB(1:2) = ubound(SrcBladedDLLTypeData%StCCmdBrake) + if (.not. allocated(DstBladedDLLTypeData%StCCmdBrake)) then + allocate(DstBladedDLLTypeData%StCCmdBrake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%StCCmdBrake.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%StCCmdBrake = SrcBladedDLLTypeData%StCCmdBrake + else if (allocated(DstBladedDLLTypeData%StCCmdBrake)) then + deallocate(DstBladedDLLTypeData%StCCmdBrake) + end if + if (allocated(SrcBladedDLLTypeData%StCCmdForce)) then + LB(1:2) = lbound(SrcBladedDLLTypeData%StCCmdForce) + UB(1:2) = ubound(SrcBladedDLLTypeData%StCCmdForce) + if (.not. allocated(DstBladedDLLTypeData%StCCmdForce)) then + allocate(DstBladedDLLTypeData%StCCmdForce(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%StCCmdForce.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%StCCmdForce = SrcBladedDLLTypeData%StCCmdForce + else if (allocated(DstBladedDLLTypeData%StCCmdForce)) then + deallocate(DstBladedDLLTypeData%StCCmdForce) + end if + if (allocated(SrcBladedDLLTypeData%StCMeasDisp)) then + LB(1:2) = lbound(SrcBladedDLLTypeData%StCMeasDisp) + UB(1:2) = ubound(SrcBladedDLLTypeData%StCMeasDisp) + if (.not. allocated(DstBladedDLLTypeData%StCMeasDisp)) then + allocate(DstBladedDLLTypeData%StCMeasDisp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%StCMeasDisp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%StCMeasDisp = SrcBladedDLLTypeData%StCMeasDisp + else if (allocated(DstBladedDLLTypeData%StCMeasDisp)) then + deallocate(DstBladedDLLTypeData%StCMeasDisp) + end if + if (allocated(SrcBladedDLLTypeData%StCMeasVel)) then + LB(1:2) = lbound(SrcBladedDLLTypeData%StCMeasVel) + UB(1:2) = ubound(SrcBladedDLLTypeData%StCMeasVel) + if (.not. allocated(DstBladedDLLTypeData%StCMeasVel)) then + allocate(DstBladedDLLTypeData%StCMeasVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%StCMeasVel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%StCMeasVel = SrcBladedDLLTypeData%StCMeasVel + else if (allocated(DstBladedDLLTypeData%StCMeasVel)) then + deallocate(DstBladedDLLTypeData%StCMeasVel) + end if +end subroutine +subroutine SrvD_DestroyBladedDLLType(BladedDLLTypeData, ErrStat, ErrMsg) + type(BladedDLLType), intent(inout) :: BladedDLLTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_DestroyBladedDLLType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(BladedDLLTypeData%avrSWAP)) then + deallocate(BladedDLLTypeData%avrSWAP) + end if + if (allocated(BladedDLLTypeData%toSC)) then + deallocate(BladedDLLTypeData%toSC) + end if + if (allocated(BladedDLLTypeData%LogChannels_OutParam)) then + LB(1:1) = lbound(BladedDLLTypeData%LogChannels_OutParam) + UB(1:1) = ubound(BladedDLLTypeData%LogChannels_OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(BladedDLLTypeData%LogChannels_OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(BladedDLLTypeData%LogChannels_OutParam) + end if + if (allocated(BladedDLLTypeData%LogChannels)) then + deallocate(BladedDLLTypeData%LogChannels) + end if + if (allocated(BladedDLLTypeData%BlPitchInput)) then + deallocate(BladedDLLTypeData%BlPitchInput) + end if + if (allocated(BladedDLLTypeData%LidSpeed)) then + deallocate(BladedDLLTypeData%LidSpeed) + end if + if (allocated(BladedDLLTypeData%MsrPositionsX)) then + deallocate(BladedDLLTypeData%MsrPositionsX) + end if + if (allocated(BladedDLLTypeData%MsrPositionsY)) then + deallocate(BladedDLLTypeData%MsrPositionsY) + end if + if (allocated(BladedDLLTypeData%MsrPositionsZ)) then + deallocate(BladedDLLTypeData%MsrPositionsZ) + end if + if (allocated(BladedDLLTypeData%GenSpd_TLU)) then + deallocate(BladedDLLTypeData%GenSpd_TLU) + end if + if (allocated(BladedDLLTypeData%GenTrq_TLU)) then + deallocate(BladedDLLTypeData%GenTrq_TLU) + end if + if (allocated(BladedDLLTypeData%PrevCableDeltaL)) then + deallocate(BladedDLLTypeData%PrevCableDeltaL) + end if + if (allocated(BladedDLLTypeData%PrevCableDeltaLdot)) then + deallocate(BladedDLLTypeData%PrevCableDeltaLdot) + end if + if (allocated(BladedDLLTypeData%CableDeltaL)) then + deallocate(BladedDLLTypeData%CableDeltaL) + end if + if (allocated(BladedDLLTypeData%CableDeltaLdot)) then + deallocate(BladedDLLTypeData%CableDeltaLdot) + end if + if (allocated(BladedDLLTypeData%PrevStCCmdStiff)) then + deallocate(BladedDLLTypeData%PrevStCCmdStiff) + end if + if (allocated(BladedDLLTypeData%PrevStCCmdDamp)) then + deallocate(BladedDLLTypeData%PrevStCCmdDamp) + end if + if (allocated(BladedDLLTypeData%PrevStCCmdBrake)) then + deallocate(BladedDLLTypeData%PrevStCCmdBrake) + end if + if (allocated(BladedDLLTypeData%PrevStCCmdForce)) then + deallocate(BladedDLLTypeData%PrevStCCmdForce) + end if + if (allocated(BladedDLLTypeData%StCCmdStiff)) then + deallocate(BladedDLLTypeData%StCCmdStiff) + end if + if (allocated(BladedDLLTypeData%StCCmdDamp)) then + deallocate(BladedDLLTypeData%StCCmdDamp) + end if + if (allocated(BladedDLLTypeData%StCCmdBrake)) then + deallocate(BladedDLLTypeData%StCCmdBrake) + end if + if (allocated(BladedDLLTypeData%StCCmdForce)) then + deallocate(BladedDLLTypeData%StCCmdForce) + end if + if (allocated(BladedDLLTypeData%StCMeasDisp)) then + deallocate(BladedDLLTypeData%StCMeasDisp) + end if + if (allocated(BladedDLLTypeData%StCMeasVel)) then + deallocate(BladedDLLTypeData%StCMeasVel) + end if +end subroutine subroutine SrvD_PackBladedDLLType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -3157,57 +2906,42 @@ subroutine SrvD_PackBladedDLLType(Buf, Indata) integer(IntKi) :: i1, i2 integer(IntKi) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return - ! avrSWAP call RegPack(Buf, allocated(InData%avrSWAP)) if (allocated(InData%avrSWAP)) then call RegPackBounds(Buf, 1, lbound(InData%avrSWAP), ubound(InData%avrSWAP)) call RegPack(Buf, InData%avrSWAP) end if if (RegCheckErr(Buf, RoutineName)) return - ! HSSBrTrqDemand call RegPack(Buf, InData%HSSBrTrqDemand) if (RegCheckErr(Buf, RoutineName)) return - ! YawRateCom call RegPack(Buf, InData%YawRateCom) if (RegCheckErr(Buf, RoutineName)) return - ! GenTrq call RegPack(Buf, InData%GenTrq) if (RegCheckErr(Buf, RoutineName)) return - ! GenState call RegPack(Buf, InData%GenState) if (RegCheckErr(Buf, RoutineName)) return - ! BlPitchCom call RegPack(Buf, InData%BlPitchCom) if (RegCheckErr(Buf, RoutineName)) return - ! PrevBlPitch call RegPack(Buf, InData%PrevBlPitch) if (RegCheckErr(Buf, RoutineName)) return - ! BlAirfoilCom call RegPack(Buf, InData%BlAirfoilCom) if (RegCheckErr(Buf, RoutineName)) return - ! PrevBlAirfoilCom call RegPack(Buf, InData%PrevBlAirfoilCom) if (RegCheckErr(Buf, RoutineName)) return - ! ElecPwr_prev call RegPack(Buf, InData%ElecPwr_prev) if (RegCheckErr(Buf, RoutineName)) return - ! GenTrq_prev call RegPack(Buf, InData%GenTrq_prev) if (RegCheckErr(Buf, RoutineName)) return - ! toSC call RegPack(Buf, allocated(InData%toSC)) if (allocated(InData%toSC)) then call RegPackBounds(Buf, 1, lbound(InData%toSC), ubound(InData%toSC)) call RegPack(Buf, InData%toSC) end if if (RegCheckErr(Buf, RoutineName)) return - ! initialized call RegPack(Buf, InData%initialized) if (RegCheckErr(Buf, RoutineName)) return - ! NumLogChannels call RegPack(Buf, InData%NumLogChannels) if (RegCheckErr(Buf, RoutineName)) return - ! LogChannels_OutParam call RegPack(Buf, allocated(InData%LogChannels_OutParam)) if (allocated(InData%LogChannels_OutParam)) then call RegPackBounds(Buf, 1, lbound(InData%LogChannels_OutParam), ubound(InData%LogChannels_OutParam)) @@ -3218,328 +2952,248 @@ subroutine SrvD_PackBladedDLLType(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! LogChannels call RegPack(Buf, allocated(InData%LogChannels)) if (allocated(InData%LogChannels)) then call RegPackBounds(Buf, 1, lbound(InData%LogChannels), ubound(InData%LogChannels)) call RegPack(Buf, InData%LogChannels) end if if (RegCheckErr(Buf, RoutineName)) return - ! ErrStat call RegPack(Buf, InData%ErrStat) if (RegCheckErr(Buf, RoutineName)) return - ! ErrMsg call RegPack(Buf, InData%ErrMsg) if (RegCheckErr(Buf, RoutineName)) return - ! CurrentTime call RegPack(Buf, InData%CurrentTime) if (RegCheckErr(Buf, RoutineName)) return - ! SimStatus call RegPack(Buf, InData%SimStatus) if (RegCheckErr(Buf, RoutineName)) return - ! ShaftBrakeStatusBinaryFlag call RegPack(Buf, InData%ShaftBrakeStatusBinaryFlag) if (RegCheckErr(Buf, RoutineName)) return - ! HSSBrDeployed call RegPack(Buf, InData%HSSBrDeployed) if (RegCheckErr(Buf, RoutineName)) return - ! TimeHSSBrFullyDeployed call RegPack(Buf, InData%TimeHSSBrFullyDeployed) if (RegCheckErr(Buf, RoutineName)) return - ! TimeHSSBrDeployed call RegPack(Buf, InData%TimeHSSBrDeployed) if (RegCheckErr(Buf, RoutineName)) return - ! OverrideYawRateWithTorque call RegPack(Buf, InData%OverrideYawRateWithTorque) if (RegCheckErr(Buf, RoutineName)) return - ! YawTorqueDemand call RegPack(Buf, InData%YawTorqueDemand) if (RegCheckErr(Buf, RoutineName)) return - ! BlPitchInput call RegPack(Buf, allocated(InData%BlPitchInput)) if (allocated(InData%BlPitchInput)) then call RegPackBounds(Buf, 1, lbound(InData%BlPitchInput), ubound(InData%BlPitchInput)) call RegPack(Buf, InData%BlPitchInput) end if if (RegCheckErr(Buf, RoutineName)) return - ! YawAngleFromNorth call RegPack(Buf, InData%YawAngleFromNorth) if (RegCheckErr(Buf, RoutineName)) return - ! HorWindV call RegPack(Buf, InData%HorWindV) if (RegCheckErr(Buf, RoutineName)) return - ! HSS_Spd call RegPack(Buf, InData%HSS_Spd) if (RegCheckErr(Buf, RoutineName)) return - ! YawErr call RegPack(Buf, InData%YawErr) if (RegCheckErr(Buf, RoutineName)) return - ! RotSpeed call RegPack(Buf, InData%RotSpeed) if (RegCheckErr(Buf, RoutineName)) return - ! YawBrTAxp call RegPack(Buf, InData%YawBrTAxp) if (RegCheckErr(Buf, RoutineName)) return - ! YawBrTAyp call RegPack(Buf, InData%YawBrTAyp) if (RegCheckErr(Buf, RoutineName)) return - ! LSSTipMys call RegPack(Buf, InData%LSSTipMys) if (RegCheckErr(Buf, RoutineName)) return - ! LSSTipMzs call RegPack(Buf, InData%LSSTipMzs) if (RegCheckErr(Buf, RoutineName)) return - ! LSSTipMya call RegPack(Buf, InData%LSSTipMya) if (RegCheckErr(Buf, RoutineName)) return - ! LSSTipMza call RegPack(Buf, InData%LSSTipMza) if (RegCheckErr(Buf, RoutineName)) return - ! LSSTipPxa call RegPack(Buf, InData%LSSTipPxa) if (RegCheckErr(Buf, RoutineName)) return - ! Yaw call RegPack(Buf, InData%Yaw) if (RegCheckErr(Buf, RoutineName)) return - ! YawRate call RegPack(Buf, InData%YawRate) if (RegCheckErr(Buf, RoutineName)) return - ! YawBrMyn call RegPack(Buf, InData%YawBrMyn) if (RegCheckErr(Buf, RoutineName)) return - ! YawBrMzn call RegPack(Buf, InData%YawBrMzn) if (RegCheckErr(Buf, RoutineName)) return - ! NcIMURAxs call RegPack(Buf, InData%NcIMURAxs) if (RegCheckErr(Buf, RoutineName)) return - ! NcIMURAys call RegPack(Buf, InData%NcIMURAys) if (RegCheckErr(Buf, RoutineName)) return - ! NcIMURAzs call RegPack(Buf, InData%NcIMURAzs) if (RegCheckErr(Buf, RoutineName)) return - ! RotPwr call RegPack(Buf, InData%RotPwr) if (RegCheckErr(Buf, RoutineName)) return - ! LSSTipMxa call RegPack(Buf, InData%LSSTipMxa) if (RegCheckErr(Buf, RoutineName)) return - ! RootMyc call RegPack(Buf, InData%RootMyc) if (RegCheckErr(Buf, RoutineName)) return - ! RootMxc call RegPack(Buf, InData%RootMxc) if (RegCheckErr(Buf, RoutineName)) return - ! LSShftFxa call RegPack(Buf, InData%LSShftFxa) if (RegCheckErr(Buf, RoutineName)) return - ! LSShftFys call RegPack(Buf, InData%LSShftFys) if (RegCheckErr(Buf, RoutineName)) return - ! LSShftFzs call RegPack(Buf, InData%LSShftFzs) if (RegCheckErr(Buf, RoutineName)) return - ! LidSpeed call RegPack(Buf, allocated(InData%LidSpeed)) if (allocated(InData%LidSpeed)) then call RegPackBounds(Buf, 1, lbound(InData%LidSpeed), ubound(InData%LidSpeed)) call RegPack(Buf, InData%LidSpeed) end if if (RegCheckErr(Buf, RoutineName)) return - ! MsrPositionsX call RegPack(Buf, allocated(InData%MsrPositionsX)) if (allocated(InData%MsrPositionsX)) then call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsX), ubound(InData%MsrPositionsX)) call RegPack(Buf, InData%MsrPositionsX) end if if (RegCheckErr(Buf, RoutineName)) return - ! MsrPositionsY call RegPack(Buf, allocated(InData%MsrPositionsY)) if (allocated(InData%MsrPositionsY)) then call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsY), ubound(InData%MsrPositionsY)) call RegPack(Buf, InData%MsrPositionsY) end if if (RegCheckErr(Buf, RoutineName)) return - ! MsrPositionsZ call RegPack(Buf, allocated(InData%MsrPositionsZ)) if (allocated(InData%MsrPositionsZ)) then call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsZ), ubound(InData%MsrPositionsZ)) call RegPack(Buf, InData%MsrPositionsZ) end if if (RegCheckErr(Buf, RoutineName)) return - ! SensorType call RegPack(Buf, InData%SensorType) if (RegCheckErr(Buf, RoutineName)) return - ! NumBeam call RegPack(Buf, InData%NumBeam) if (RegCheckErr(Buf, RoutineName)) return - ! NumPulseGate call RegPack(Buf, InData%NumPulseGate) if (RegCheckErr(Buf, RoutineName)) return - ! PulseSpacing call RegPack(Buf, InData%PulseSpacing) if (RegCheckErr(Buf, RoutineName)) return - ! URefLid call RegPack(Buf, InData%URefLid) if (RegCheckErr(Buf, RoutineName)) return - ! DLL_DT call RegPack(Buf, InData%DLL_DT) if (RegCheckErr(Buf, RoutineName)) return - ! DLL_InFile call RegPack(Buf, InData%DLL_InFile) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegPack(Buf, InData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! GenTrq_Dem call RegPack(Buf, InData%GenTrq_Dem) if (RegCheckErr(Buf, RoutineName)) return - ! GenSpd_Dem call RegPack(Buf, InData%GenSpd_Dem) if (RegCheckErr(Buf, RoutineName)) return - ! Ptch_Max call RegPack(Buf, InData%Ptch_Max) if (RegCheckErr(Buf, RoutineName)) return - ! Ptch_Min call RegPack(Buf, InData%Ptch_Min) if (RegCheckErr(Buf, RoutineName)) return - ! Ptch_SetPnt call RegPack(Buf, InData%Ptch_SetPnt) if (RegCheckErr(Buf, RoutineName)) return - ! PtchRate_Max call RegPack(Buf, InData%PtchRate_Max) if (RegCheckErr(Buf, RoutineName)) return - ! PtchRate_Min call RegPack(Buf, InData%PtchRate_Min) if (RegCheckErr(Buf, RoutineName)) return - ! GenPwr_Dem call RegPack(Buf, InData%GenPwr_Dem) if (RegCheckErr(Buf, RoutineName)) return - ! Gain_OM call RegPack(Buf, InData%Gain_OM) if (RegCheckErr(Buf, RoutineName)) return - ! GenSpd_MaxOM call RegPack(Buf, InData%GenSpd_MaxOM) if (RegCheckErr(Buf, RoutineName)) return - ! GenSpd_MinOM call RegPack(Buf, InData%GenSpd_MinOM) if (RegCheckErr(Buf, RoutineName)) return - ! Ptch_Cntrl call RegPack(Buf, InData%Ptch_Cntrl) if (RegCheckErr(Buf, RoutineName)) return - ! DLL_NumTrq call RegPack(Buf, InData%DLL_NumTrq) if (RegCheckErr(Buf, RoutineName)) return - ! GenSpd_TLU call RegPack(Buf, allocated(InData%GenSpd_TLU)) if (allocated(InData%GenSpd_TLU)) then call RegPackBounds(Buf, 1, lbound(InData%GenSpd_TLU), ubound(InData%GenSpd_TLU)) call RegPack(Buf, InData%GenSpd_TLU) end if if (RegCheckErr(Buf, RoutineName)) return - ! GenTrq_TLU call RegPack(Buf, allocated(InData%GenTrq_TLU)) if (allocated(InData%GenTrq_TLU)) then call RegPackBounds(Buf, 1, lbound(InData%GenTrq_TLU), ubound(InData%GenTrq_TLU)) call RegPack(Buf, InData%GenTrq_TLU) end if if (RegCheckErr(Buf, RoutineName)) return - ! Yaw_Cntrl call RegPack(Buf, InData%Yaw_Cntrl) if (RegCheckErr(Buf, RoutineName)) return - ! PrevCableDeltaL call RegPack(Buf, allocated(InData%PrevCableDeltaL)) if (allocated(InData%PrevCableDeltaL)) then call RegPackBounds(Buf, 1, lbound(InData%PrevCableDeltaL), ubound(InData%PrevCableDeltaL)) call RegPack(Buf, InData%PrevCableDeltaL) end if if (RegCheckErr(Buf, RoutineName)) return - ! PrevCableDeltaLdot call RegPack(Buf, allocated(InData%PrevCableDeltaLdot)) if (allocated(InData%PrevCableDeltaLdot)) then call RegPackBounds(Buf, 1, lbound(InData%PrevCableDeltaLdot), ubound(InData%PrevCableDeltaLdot)) call RegPack(Buf, InData%PrevCableDeltaLdot) end if if (RegCheckErr(Buf, RoutineName)) return - ! CableDeltaL call RegPack(Buf, allocated(InData%CableDeltaL)) if (allocated(InData%CableDeltaL)) then call RegPackBounds(Buf, 1, lbound(InData%CableDeltaL), ubound(InData%CableDeltaL)) call RegPack(Buf, InData%CableDeltaL) end if if (RegCheckErr(Buf, RoutineName)) return - ! CableDeltaLdot call RegPack(Buf, allocated(InData%CableDeltaLdot)) if (allocated(InData%CableDeltaLdot)) then call RegPackBounds(Buf, 1, lbound(InData%CableDeltaLdot), ubound(InData%CableDeltaLdot)) call RegPack(Buf, InData%CableDeltaLdot) end if if (RegCheckErr(Buf, RoutineName)) return - ! PrevStCCmdStiff call RegPack(Buf, allocated(InData%PrevStCCmdStiff)) if (allocated(InData%PrevStCCmdStiff)) then call RegPackBounds(Buf, 2, lbound(InData%PrevStCCmdStiff), ubound(InData%PrevStCCmdStiff)) call RegPack(Buf, InData%PrevStCCmdStiff) end if if (RegCheckErr(Buf, RoutineName)) return - ! PrevStCCmdDamp call RegPack(Buf, allocated(InData%PrevStCCmdDamp)) if (allocated(InData%PrevStCCmdDamp)) then call RegPackBounds(Buf, 2, lbound(InData%PrevStCCmdDamp), ubound(InData%PrevStCCmdDamp)) call RegPack(Buf, InData%PrevStCCmdDamp) end if if (RegCheckErr(Buf, RoutineName)) return - ! PrevStCCmdBrake call RegPack(Buf, allocated(InData%PrevStCCmdBrake)) if (allocated(InData%PrevStCCmdBrake)) then call RegPackBounds(Buf, 2, lbound(InData%PrevStCCmdBrake), ubound(InData%PrevStCCmdBrake)) call RegPack(Buf, InData%PrevStCCmdBrake) end if if (RegCheckErr(Buf, RoutineName)) return - ! PrevStCCmdForce call RegPack(Buf, allocated(InData%PrevStCCmdForce)) if (allocated(InData%PrevStCCmdForce)) then call RegPackBounds(Buf, 2, lbound(InData%PrevStCCmdForce), ubound(InData%PrevStCCmdForce)) call RegPack(Buf, InData%PrevStCCmdForce) end if if (RegCheckErr(Buf, RoutineName)) return - ! StCCmdStiff call RegPack(Buf, allocated(InData%StCCmdStiff)) if (allocated(InData%StCCmdStiff)) then call RegPackBounds(Buf, 2, lbound(InData%StCCmdStiff), ubound(InData%StCCmdStiff)) call RegPack(Buf, InData%StCCmdStiff) end if if (RegCheckErr(Buf, RoutineName)) return - ! StCCmdDamp call RegPack(Buf, allocated(InData%StCCmdDamp)) if (allocated(InData%StCCmdDamp)) then call RegPackBounds(Buf, 2, lbound(InData%StCCmdDamp), ubound(InData%StCCmdDamp)) call RegPack(Buf, InData%StCCmdDamp) end if if (RegCheckErr(Buf, RoutineName)) return - ! StCCmdBrake call RegPack(Buf, allocated(InData%StCCmdBrake)) if (allocated(InData%StCCmdBrake)) then call RegPackBounds(Buf, 2, lbound(InData%StCCmdBrake), ubound(InData%StCCmdBrake)) call RegPack(Buf, InData%StCCmdBrake) end if if (RegCheckErr(Buf, RoutineName)) return - ! StCCmdForce call RegPack(Buf, allocated(InData%StCCmdForce)) if (allocated(InData%StCCmdForce)) then call RegPackBounds(Buf, 2, lbound(InData%StCCmdForce), ubound(InData%StCCmdForce)) call RegPack(Buf, InData%StCCmdForce) end if if (RegCheckErr(Buf, RoutineName)) return - ! StCMeasDisp call RegPack(Buf, allocated(InData%StCMeasDisp)) if (allocated(InData%StCMeasDisp)) then call RegPackBounds(Buf, 2, lbound(InData%StCMeasDisp), ubound(InData%StCMeasDisp)) call RegPack(Buf, InData%StCMeasDisp) end if if (RegCheckErr(Buf, RoutineName)) return - ! StCMeasVel call RegPack(Buf, allocated(InData%StCMeasVel)) if (allocated(InData%StCMeasVel)) then call RegPackBounds(Buf, 2, lbound(InData%StCMeasVel), ubound(InData%StCMeasVel)) @@ -3557,7 +3211,6 @@ subroutine SrvD_UnPackBladedDLLType(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! avrSWAP if (allocated(OutData%avrSWAP)) deallocate(OutData%avrSWAP) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3572,37 +3225,26 @@ subroutine SrvD_UnPackBladedDLLType(Buf, OutData) call RegUnpack(Buf, OutData%avrSWAP) if (RegCheckErr(Buf, RoutineName)) return end if - ! HSSBrTrqDemand call RegUnpack(Buf, OutData%HSSBrTrqDemand) if (RegCheckErr(Buf, RoutineName)) return - ! YawRateCom call RegUnpack(Buf, OutData%YawRateCom) if (RegCheckErr(Buf, RoutineName)) return - ! GenTrq call RegUnpack(Buf, OutData%GenTrq) if (RegCheckErr(Buf, RoutineName)) return - ! GenState call RegUnpack(Buf, OutData%GenState) if (RegCheckErr(Buf, RoutineName)) return - ! BlPitchCom call RegUnpack(Buf, OutData%BlPitchCom) if (RegCheckErr(Buf, RoutineName)) return - ! PrevBlPitch call RegUnpack(Buf, OutData%PrevBlPitch) if (RegCheckErr(Buf, RoutineName)) return - ! BlAirfoilCom call RegUnpack(Buf, OutData%BlAirfoilCom) if (RegCheckErr(Buf, RoutineName)) return - ! PrevBlAirfoilCom call RegUnpack(Buf, OutData%PrevBlAirfoilCom) if (RegCheckErr(Buf, RoutineName)) return - ! ElecPwr_prev call RegUnpack(Buf, OutData%ElecPwr_prev) if (RegCheckErr(Buf, RoutineName)) return - ! GenTrq_prev call RegUnpack(Buf, OutData%GenTrq_prev) if (RegCheckErr(Buf, RoutineName)) return - ! toSC if (allocated(OutData%toSC)) deallocate(OutData%toSC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3617,13 +3259,10 @@ subroutine SrvD_UnPackBladedDLLType(Buf, OutData) call RegUnpack(Buf, OutData%toSC) if (RegCheckErr(Buf, RoutineName)) return end if - ! initialized call RegUnpack(Buf, OutData%initialized) if (RegCheckErr(Buf, RoutineName)) return - ! NumLogChannels call RegUnpack(Buf, OutData%NumLogChannels) if (RegCheckErr(Buf, RoutineName)) return - ! LogChannels_OutParam if (allocated(OutData%LogChannels_OutParam)) deallocate(OutData%LogChannels_OutParam) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3639,7 +3278,6 @@ subroutine SrvD_UnPackBladedDLLType(Buf, OutData) call NWTC_Library_UnpackOutParmType(Buf, OutData%LogChannels_OutParam(i1)) ! LogChannels_OutParam end do end if - ! LogChannels if (allocated(OutData%LogChannels)) deallocate(OutData%LogChannels) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3654,37 +3292,26 @@ subroutine SrvD_UnPackBladedDLLType(Buf, OutData) call RegUnpack(Buf, OutData%LogChannels) if (RegCheckErr(Buf, RoutineName)) return end if - ! ErrStat call RegUnpack(Buf, OutData%ErrStat) if (RegCheckErr(Buf, RoutineName)) return - ! ErrMsg call RegUnpack(Buf, OutData%ErrMsg) if (RegCheckErr(Buf, RoutineName)) return - ! CurrentTime call RegUnpack(Buf, OutData%CurrentTime) if (RegCheckErr(Buf, RoutineName)) return - ! SimStatus call RegUnpack(Buf, OutData%SimStatus) if (RegCheckErr(Buf, RoutineName)) return - ! ShaftBrakeStatusBinaryFlag call RegUnpack(Buf, OutData%ShaftBrakeStatusBinaryFlag) if (RegCheckErr(Buf, RoutineName)) return - ! HSSBrDeployed call RegUnpack(Buf, OutData%HSSBrDeployed) if (RegCheckErr(Buf, RoutineName)) return - ! TimeHSSBrFullyDeployed call RegUnpack(Buf, OutData%TimeHSSBrFullyDeployed) if (RegCheckErr(Buf, RoutineName)) return - ! TimeHSSBrDeployed call RegUnpack(Buf, OutData%TimeHSSBrDeployed) if (RegCheckErr(Buf, RoutineName)) return - ! OverrideYawRateWithTorque call RegUnpack(Buf, OutData%OverrideYawRateWithTorque) if (RegCheckErr(Buf, RoutineName)) return - ! YawTorqueDemand call RegUnpack(Buf, OutData%YawTorqueDemand) if (RegCheckErr(Buf, RoutineName)) return - ! BlPitchInput if (allocated(OutData%BlPitchInput)) deallocate(OutData%BlPitchInput) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3699,85 +3326,58 @@ subroutine SrvD_UnPackBladedDLLType(Buf, OutData) call RegUnpack(Buf, OutData%BlPitchInput) if (RegCheckErr(Buf, RoutineName)) return end if - ! YawAngleFromNorth call RegUnpack(Buf, OutData%YawAngleFromNorth) if (RegCheckErr(Buf, RoutineName)) return - ! HorWindV call RegUnpack(Buf, OutData%HorWindV) if (RegCheckErr(Buf, RoutineName)) return - ! HSS_Spd call RegUnpack(Buf, OutData%HSS_Spd) if (RegCheckErr(Buf, RoutineName)) return - ! YawErr call RegUnpack(Buf, OutData%YawErr) if (RegCheckErr(Buf, RoutineName)) return - ! RotSpeed call RegUnpack(Buf, OutData%RotSpeed) if (RegCheckErr(Buf, RoutineName)) return - ! YawBrTAxp call RegUnpack(Buf, OutData%YawBrTAxp) if (RegCheckErr(Buf, RoutineName)) return - ! YawBrTAyp call RegUnpack(Buf, OutData%YawBrTAyp) if (RegCheckErr(Buf, RoutineName)) return - ! LSSTipMys call RegUnpack(Buf, OutData%LSSTipMys) if (RegCheckErr(Buf, RoutineName)) return - ! LSSTipMzs call RegUnpack(Buf, OutData%LSSTipMzs) if (RegCheckErr(Buf, RoutineName)) return - ! LSSTipMya call RegUnpack(Buf, OutData%LSSTipMya) if (RegCheckErr(Buf, RoutineName)) return - ! LSSTipMza call RegUnpack(Buf, OutData%LSSTipMza) if (RegCheckErr(Buf, RoutineName)) return - ! LSSTipPxa call RegUnpack(Buf, OutData%LSSTipPxa) if (RegCheckErr(Buf, RoutineName)) return - ! Yaw call RegUnpack(Buf, OutData%Yaw) if (RegCheckErr(Buf, RoutineName)) return - ! YawRate call RegUnpack(Buf, OutData%YawRate) if (RegCheckErr(Buf, RoutineName)) return - ! YawBrMyn call RegUnpack(Buf, OutData%YawBrMyn) if (RegCheckErr(Buf, RoutineName)) return - ! YawBrMzn call RegUnpack(Buf, OutData%YawBrMzn) if (RegCheckErr(Buf, RoutineName)) return - ! NcIMURAxs call RegUnpack(Buf, OutData%NcIMURAxs) if (RegCheckErr(Buf, RoutineName)) return - ! NcIMURAys call RegUnpack(Buf, OutData%NcIMURAys) if (RegCheckErr(Buf, RoutineName)) return - ! NcIMURAzs call RegUnpack(Buf, OutData%NcIMURAzs) if (RegCheckErr(Buf, RoutineName)) return - ! RotPwr call RegUnpack(Buf, OutData%RotPwr) if (RegCheckErr(Buf, RoutineName)) return - ! LSSTipMxa call RegUnpack(Buf, OutData%LSSTipMxa) if (RegCheckErr(Buf, RoutineName)) return - ! RootMyc call RegUnpack(Buf, OutData%RootMyc) if (RegCheckErr(Buf, RoutineName)) return - ! RootMxc call RegUnpack(Buf, OutData%RootMxc) if (RegCheckErr(Buf, RoutineName)) return - ! LSShftFxa call RegUnpack(Buf, OutData%LSShftFxa) if (RegCheckErr(Buf, RoutineName)) return - ! LSShftFys call RegUnpack(Buf, OutData%LSShftFys) if (RegCheckErr(Buf, RoutineName)) return - ! LSShftFzs call RegUnpack(Buf, OutData%LSShftFzs) if (RegCheckErr(Buf, RoutineName)) return - ! LidSpeed if (allocated(OutData%LidSpeed)) deallocate(OutData%LidSpeed) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3792,7 +3392,6 @@ subroutine SrvD_UnPackBladedDLLType(Buf, OutData) call RegUnpack(Buf, OutData%LidSpeed) if (RegCheckErr(Buf, RoutineName)) return end if - ! MsrPositionsX if (allocated(OutData%MsrPositionsX)) deallocate(OutData%MsrPositionsX) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3807,7 +3406,6 @@ subroutine SrvD_UnPackBladedDLLType(Buf, OutData) call RegUnpack(Buf, OutData%MsrPositionsX) if (RegCheckErr(Buf, RoutineName)) return end if - ! MsrPositionsY if (allocated(OutData%MsrPositionsY)) deallocate(OutData%MsrPositionsY) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3822,7 +3420,6 @@ subroutine SrvD_UnPackBladedDLLType(Buf, OutData) call RegUnpack(Buf, OutData%MsrPositionsY) if (RegCheckErr(Buf, RoutineName)) return end if - ! MsrPositionsZ if (allocated(OutData%MsrPositionsZ)) deallocate(OutData%MsrPositionsZ) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3837,70 +3434,48 @@ subroutine SrvD_UnPackBladedDLLType(Buf, OutData) call RegUnpack(Buf, OutData%MsrPositionsZ) if (RegCheckErr(Buf, RoutineName)) return end if - ! SensorType call RegUnpack(Buf, OutData%SensorType) if (RegCheckErr(Buf, RoutineName)) return - ! NumBeam call RegUnpack(Buf, OutData%NumBeam) if (RegCheckErr(Buf, RoutineName)) return - ! NumPulseGate call RegUnpack(Buf, OutData%NumPulseGate) if (RegCheckErr(Buf, RoutineName)) return - ! PulseSpacing call RegUnpack(Buf, OutData%PulseSpacing) if (RegCheckErr(Buf, RoutineName)) return - ! URefLid call RegUnpack(Buf, OutData%URefLid) if (RegCheckErr(Buf, RoutineName)) return - ! DLL_DT call RegUnpack(Buf, OutData%DLL_DT) if (RegCheckErr(Buf, RoutineName)) return - ! DLL_InFile call RegUnpack(Buf, OutData%DLL_InFile) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegUnpack(Buf, OutData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! GenTrq_Dem call RegUnpack(Buf, OutData%GenTrq_Dem) if (RegCheckErr(Buf, RoutineName)) return - ! GenSpd_Dem call RegUnpack(Buf, OutData%GenSpd_Dem) if (RegCheckErr(Buf, RoutineName)) return - ! Ptch_Max call RegUnpack(Buf, OutData%Ptch_Max) if (RegCheckErr(Buf, RoutineName)) return - ! Ptch_Min call RegUnpack(Buf, OutData%Ptch_Min) if (RegCheckErr(Buf, RoutineName)) return - ! Ptch_SetPnt call RegUnpack(Buf, OutData%Ptch_SetPnt) if (RegCheckErr(Buf, RoutineName)) return - ! PtchRate_Max call RegUnpack(Buf, OutData%PtchRate_Max) if (RegCheckErr(Buf, RoutineName)) return - ! PtchRate_Min call RegUnpack(Buf, OutData%PtchRate_Min) if (RegCheckErr(Buf, RoutineName)) return - ! GenPwr_Dem call RegUnpack(Buf, OutData%GenPwr_Dem) if (RegCheckErr(Buf, RoutineName)) return - ! Gain_OM call RegUnpack(Buf, OutData%Gain_OM) if (RegCheckErr(Buf, RoutineName)) return - ! GenSpd_MaxOM call RegUnpack(Buf, OutData%GenSpd_MaxOM) if (RegCheckErr(Buf, RoutineName)) return - ! GenSpd_MinOM call RegUnpack(Buf, OutData%GenSpd_MinOM) if (RegCheckErr(Buf, RoutineName)) return - ! Ptch_Cntrl call RegUnpack(Buf, OutData%Ptch_Cntrl) if (RegCheckErr(Buf, RoutineName)) return - ! DLL_NumTrq call RegUnpack(Buf, OutData%DLL_NumTrq) if (RegCheckErr(Buf, RoutineName)) return - ! GenSpd_TLU if (allocated(OutData%GenSpd_TLU)) deallocate(OutData%GenSpd_TLU) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3915,7 +3490,6 @@ subroutine SrvD_UnPackBladedDLLType(Buf, OutData) call RegUnpack(Buf, OutData%GenSpd_TLU) if (RegCheckErr(Buf, RoutineName)) return end if - ! GenTrq_TLU if (allocated(OutData%GenTrq_TLU)) deallocate(OutData%GenTrq_TLU) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3930,10 +3504,8 @@ subroutine SrvD_UnPackBladedDLLType(Buf, OutData) call RegUnpack(Buf, OutData%GenTrq_TLU) if (RegCheckErr(Buf, RoutineName)) return end if - ! Yaw_Cntrl call RegUnpack(Buf, OutData%Yaw_Cntrl) if (RegCheckErr(Buf, RoutineName)) return - ! PrevCableDeltaL if (allocated(OutData%PrevCableDeltaL)) deallocate(OutData%PrevCableDeltaL) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3948,7 +3520,6 @@ subroutine SrvD_UnPackBladedDLLType(Buf, OutData) call RegUnpack(Buf, OutData%PrevCableDeltaL) if (RegCheckErr(Buf, RoutineName)) return end if - ! PrevCableDeltaLdot if (allocated(OutData%PrevCableDeltaLdot)) deallocate(OutData%PrevCableDeltaLdot) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3963,7 +3534,6 @@ subroutine SrvD_UnPackBladedDLLType(Buf, OutData) call RegUnpack(Buf, OutData%PrevCableDeltaLdot) if (RegCheckErr(Buf, RoutineName)) return end if - ! CableDeltaL if (allocated(OutData%CableDeltaL)) deallocate(OutData%CableDeltaL) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3978,7 +3548,6 @@ subroutine SrvD_UnPackBladedDLLType(Buf, OutData) call RegUnpack(Buf, OutData%CableDeltaL) if (RegCheckErr(Buf, RoutineName)) return end if - ! CableDeltaLdot if (allocated(OutData%CableDeltaLdot)) deallocate(OutData%CableDeltaLdot) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3993,7 +3562,6 @@ subroutine SrvD_UnPackBladedDLLType(Buf, OutData) call RegUnpack(Buf, OutData%CableDeltaLdot) if (RegCheckErr(Buf, RoutineName)) return end if - ! PrevStCCmdStiff if (allocated(OutData%PrevStCCmdStiff)) deallocate(OutData%PrevStCCmdStiff) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4008,7 +3576,6 @@ subroutine SrvD_UnPackBladedDLLType(Buf, OutData) call RegUnpack(Buf, OutData%PrevStCCmdStiff) if (RegCheckErr(Buf, RoutineName)) return end if - ! PrevStCCmdDamp if (allocated(OutData%PrevStCCmdDamp)) deallocate(OutData%PrevStCCmdDamp) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4023,7 +3590,6 @@ subroutine SrvD_UnPackBladedDLLType(Buf, OutData) call RegUnpack(Buf, OutData%PrevStCCmdDamp) if (RegCheckErr(Buf, RoutineName)) return end if - ! PrevStCCmdBrake if (allocated(OutData%PrevStCCmdBrake)) deallocate(OutData%PrevStCCmdBrake) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4038,7 +3604,6 @@ subroutine SrvD_UnPackBladedDLLType(Buf, OutData) call RegUnpack(Buf, OutData%PrevStCCmdBrake) if (RegCheckErr(Buf, RoutineName)) return end if - ! PrevStCCmdForce if (allocated(OutData%PrevStCCmdForce)) deallocate(OutData%PrevStCCmdForce) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4053,7 +3618,6 @@ subroutine SrvD_UnPackBladedDLLType(Buf, OutData) call RegUnpack(Buf, OutData%PrevStCCmdForce) if (RegCheckErr(Buf, RoutineName)) return end if - ! StCCmdStiff if (allocated(OutData%StCCmdStiff)) deallocate(OutData%StCCmdStiff) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4068,7 +3632,6 @@ subroutine SrvD_UnPackBladedDLLType(Buf, OutData) call RegUnpack(Buf, OutData%StCCmdStiff) if (RegCheckErr(Buf, RoutineName)) return end if - ! StCCmdDamp if (allocated(OutData%StCCmdDamp)) deallocate(OutData%StCCmdDamp) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4083,7 +3646,6 @@ subroutine SrvD_UnPackBladedDLLType(Buf, OutData) call RegUnpack(Buf, OutData%StCCmdDamp) if (RegCheckErr(Buf, RoutineName)) return end if - ! StCCmdBrake if (allocated(OutData%StCCmdBrake)) deallocate(OutData%StCCmdBrake) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4098,7 +3660,6 @@ subroutine SrvD_UnPackBladedDLLType(Buf, OutData) call RegUnpack(Buf, OutData%StCCmdBrake) if (RegCheckErr(Buf, RoutineName)) return end if - ! StCCmdForce if (allocated(OutData%StCCmdForce)) deallocate(OutData%StCCmdForce) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4113,7 +3674,6 @@ subroutine SrvD_UnPackBladedDLLType(Buf, OutData) call RegUnpack(Buf, OutData%StCCmdForce) if (RegCheckErr(Buf, RoutineName)) return end if - ! StCMeasDisp if (allocated(OutData%StCMeasDisp)) deallocate(OutData%StCMeasDisp) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4128,7 +3688,6 @@ subroutine SrvD_UnPackBladedDLLType(Buf, OutData) call RegUnpack(Buf, OutData%StCMeasDisp) if (RegCheckErr(Buf, RoutineName)) return end if - ! StCMeasVel if (allocated(OutData%StCMeasVel)) deallocate(OutData%StCMeasVel) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4144,131 +3703,143 @@ subroutine SrvD_UnPackBladedDLLType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE SrvD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SrvD_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(SrvD_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%DummyContState = SrcContStateData%DummyContState -IF (ALLOCATED(SrcContStateData%BStC)) THEN - i1_l = LBOUND(SrcContStateData%BStC,1) - i1_u = UBOUND(SrcContStateData%BStC,1) - IF (.NOT. ALLOCATED(DstContStateData%BStC)) THEN - ALLOCATE(DstContStateData%BStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcContStateData%BStC,1), UBOUND(SrcContStateData%BStC,1) - CALL StC_CopyContState( SrcContStateData%BStC(i1), DstContStateData%BStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcContStateData%NStC)) THEN - i1_l = LBOUND(SrcContStateData%NStC,1) - i1_u = UBOUND(SrcContStateData%NStC,1) - IF (.NOT. ALLOCATED(DstContStateData%NStC)) THEN - ALLOCATE(DstContStateData%NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcContStateData%NStC,1), UBOUND(SrcContStateData%NStC,1) - CALL StC_CopyContState( SrcContStateData%NStC(i1), DstContStateData%NStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcContStateData%TStC)) THEN - i1_l = LBOUND(SrcContStateData%TStC,1) - i1_u = UBOUND(SrcContStateData%TStC,1) - IF (.NOT. ALLOCATED(DstContStateData%TStC)) THEN - ALLOCATE(DstContStateData%TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcContStateData%TStC,1), UBOUND(SrcContStateData%TStC,1) - CALL StC_CopyContState( SrcContStateData%TStC(i1), DstContStateData%TStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcContStateData%SStC)) THEN - i1_l = LBOUND(SrcContStateData%SStC,1) - i1_u = UBOUND(SrcContStateData%SStC,1) - IF (.NOT. ALLOCATED(DstContStateData%SStC)) THEN - ALLOCATE(DstContStateData%SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcContStateData%SStC,1), UBOUND(SrcContStateData%SStC,1) - CALL StC_CopyContState( SrcContStateData%SStC(i1), DstContStateData%SStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE SrvD_CopyContState - - SUBROUTINE SrvD_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(SrvD_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyContState' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ContStateData%BStC)) THEN -DO i1 = LBOUND(ContStateData%BStC,1), UBOUND(ContStateData%BStC,1) - CALL StC_DestroyContState( ContStateData%BStC(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ContStateData%BStC) -ENDIF -IF (ALLOCATED(ContStateData%NStC)) THEN -DO i1 = LBOUND(ContStateData%NStC,1), UBOUND(ContStateData%NStC,1) - CALL StC_DestroyContState( ContStateData%NStC(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ContStateData%NStC) -ENDIF -IF (ALLOCATED(ContStateData%TStC)) THEN -DO i1 = LBOUND(ContStateData%TStC,1), UBOUND(ContStateData%TStC,1) - CALL StC_DestroyContState( ContStateData%TStC(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ContStateData%TStC) -ENDIF -IF (ALLOCATED(ContStateData%SStC)) THEN -DO i1 = LBOUND(ContStateData%SStC,1), UBOUND(ContStateData%SStC,1) - CALL StC_DestroyContState( ContStateData%SStC(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ContStateData%SStC) -ENDIF - END SUBROUTINE SrvD_DestroyContState +subroutine SrvD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(SrvD_ContinuousStateType), intent(in) :: SrcContStateData + type(SrvD_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + DstContStateData%DummyContState = SrcContStateData%DummyContState + if (allocated(SrcContStateData%BStC)) then + LB(1:1) = lbound(SrcContStateData%BStC) + UB(1:1) = ubound(SrcContStateData%BStC) + if (.not. allocated(DstContStateData%BStC)) then + allocate(DstContStateData%BStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%BStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyContState(SrcContStateData%BStC(i1), DstContStateData%BStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstContStateData%BStC)) then + deallocate(DstContStateData%BStC) + end if + if (allocated(SrcContStateData%NStC)) then + LB(1:1) = lbound(SrcContStateData%NStC) + UB(1:1) = ubound(SrcContStateData%NStC) + if (.not. allocated(DstContStateData%NStC)) then + allocate(DstContStateData%NStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%NStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyContState(SrcContStateData%NStC(i1), DstContStateData%NStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstContStateData%NStC)) then + deallocate(DstContStateData%NStC) + end if + if (allocated(SrcContStateData%TStC)) then + LB(1:1) = lbound(SrcContStateData%TStC) + UB(1:1) = ubound(SrcContStateData%TStC) + if (.not. allocated(DstContStateData%TStC)) then + allocate(DstContStateData%TStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%TStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyContState(SrcContStateData%TStC(i1), DstContStateData%TStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstContStateData%TStC)) then + deallocate(DstContStateData%TStC) + end if + if (allocated(SrcContStateData%SStC)) then + LB(1:1) = lbound(SrcContStateData%SStC) + UB(1:1) = ubound(SrcContStateData%SStC) + if (.not. allocated(DstContStateData%SStC)) then + allocate(DstContStateData%SStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%SStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyContState(SrcContStateData%SStC(i1), DstContStateData%SStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstContStateData%SStC)) then + deallocate(DstContStateData%SStC) + end if +end subroutine +subroutine SrvD_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(SrvD_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ContStateData%BStC)) then + LB(1:1) = lbound(ContStateData%BStC) + UB(1:1) = ubound(ContStateData%BStC) + do i1 = LB(1), UB(1) + call StC_DestroyContState(ContStateData%BStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ContStateData%BStC) + end if + if (allocated(ContStateData%NStC)) then + LB(1:1) = lbound(ContStateData%NStC) + UB(1:1) = ubound(ContStateData%NStC) + do i1 = LB(1), UB(1) + call StC_DestroyContState(ContStateData%NStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ContStateData%NStC) + end if + if (allocated(ContStateData%TStC)) then + LB(1:1) = lbound(ContStateData%TStC) + UB(1:1) = ubound(ContStateData%TStC) + do i1 = LB(1), UB(1) + call StC_DestroyContState(ContStateData%TStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ContStateData%TStC) + end if + if (allocated(ContStateData%SStC)) then + LB(1:1) = lbound(ContStateData%SStC) + UB(1:1) = ubound(ContStateData%SStC) + do i1 = LB(1), UB(1) + call StC_DestroyContState(ContStateData%SStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ContStateData%SStC) + end if +end subroutine subroutine SrvD_PackContState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -4277,10 +3848,8 @@ subroutine SrvD_PackContState(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! DummyContState call RegPack(Buf, InData%DummyContState) if (RegCheckErr(Buf, RoutineName)) return - ! BStC call RegPack(Buf, allocated(InData%BStC)) if (allocated(InData%BStC)) then call RegPackBounds(Buf, 1, lbound(InData%BStC), ubound(InData%BStC)) @@ -4291,7 +3860,6 @@ subroutine SrvD_PackContState(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! NStC call RegPack(Buf, allocated(InData%NStC)) if (allocated(InData%NStC)) then call RegPackBounds(Buf, 1, lbound(InData%NStC), ubound(InData%NStC)) @@ -4302,7 +3870,6 @@ subroutine SrvD_PackContState(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! TStC call RegPack(Buf, allocated(InData%TStC)) if (allocated(InData%TStC)) then call RegPackBounds(Buf, 1, lbound(InData%TStC), ubound(InData%TStC)) @@ -4313,7 +3880,6 @@ subroutine SrvD_PackContState(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! SStC call RegPack(Buf, allocated(InData%SStC)) if (allocated(InData%SStC)) then call RegPackBounds(Buf, 1, lbound(InData%SStC), ubound(InData%SStC)) @@ -4335,10 +3901,8 @@ subroutine SrvD_UnPackContState(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! DummyContState call RegUnpack(Buf, OutData%DummyContState) if (RegCheckErr(Buf, RoutineName)) return - ! BStC if (allocated(OutData%BStC)) deallocate(OutData%BStC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4354,7 +3918,6 @@ subroutine SrvD_UnPackContState(Buf, OutData) call StC_UnpackContState(Buf, OutData%BStC(i1)) ! BStC end do end if - ! NStC if (allocated(OutData%NStC)) deallocate(OutData%NStC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4370,7 +3933,6 @@ subroutine SrvD_UnPackContState(Buf, OutData) call StC_UnpackContState(Buf, OutData%NStC(i1)) ! NStC end do end if - ! TStC if (allocated(OutData%TStC)) deallocate(OutData%TStC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4386,7 +3948,6 @@ subroutine SrvD_UnPackContState(Buf, OutData) call StC_UnpackContState(Buf, OutData%TStC(i1)) ! TStC end do end if - ! SStC if (allocated(OutData%SStC)) deallocate(OutData%SStC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4403,131 +3964,143 @@ subroutine SrvD_UnPackContState(Buf, OutData) end do end if end subroutine - SUBROUTINE SrvD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SrvD_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(SrvD_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%CtrlOffset = SrcDiscStateData%CtrlOffset -IF (ALLOCATED(SrcDiscStateData%BStC)) THEN - i1_l = LBOUND(SrcDiscStateData%BStC,1) - i1_u = UBOUND(SrcDiscStateData%BStC,1) - IF (.NOT. ALLOCATED(DstDiscStateData%BStC)) THEN - ALLOCATE(DstDiscStateData%BStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDiscStateData%BStC,1), UBOUND(SrcDiscStateData%BStC,1) - CALL StC_CopyDiscState( SrcDiscStateData%BStC(i1), DstDiscStateData%BStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcDiscStateData%NStC)) THEN - i1_l = LBOUND(SrcDiscStateData%NStC,1) - i1_u = UBOUND(SrcDiscStateData%NStC,1) - IF (.NOT. ALLOCATED(DstDiscStateData%NStC)) THEN - ALLOCATE(DstDiscStateData%NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDiscStateData%NStC,1), UBOUND(SrcDiscStateData%NStC,1) - CALL StC_CopyDiscState( SrcDiscStateData%NStC(i1), DstDiscStateData%NStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcDiscStateData%TStC)) THEN - i1_l = LBOUND(SrcDiscStateData%TStC,1) - i1_u = UBOUND(SrcDiscStateData%TStC,1) - IF (.NOT. ALLOCATED(DstDiscStateData%TStC)) THEN - ALLOCATE(DstDiscStateData%TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDiscStateData%TStC,1), UBOUND(SrcDiscStateData%TStC,1) - CALL StC_CopyDiscState( SrcDiscStateData%TStC(i1), DstDiscStateData%TStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcDiscStateData%SStC)) THEN - i1_l = LBOUND(SrcDiscStateData%SStC,1) - i1_u = UBOUND(SrcDiscStateData%SStC,1) - IF (.NOT. ALLOCATED(DstDiscStateData%SStC)) THEN - ALLOCATE(DstDiscStateData%SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcDiscStateData%SStC,1), UBOUND(SrcDiscStateData%SStC,1) - CALL StC_CopyDiscState( SrcDiscStateData%SStC(i1), DstDiscStateData%SStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE SrvD_CopyDiscState - SUBROUTINE SrvD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(SrvD_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(DiscStateData%BStC)) THEN -DO i1 = LBOUND(DiscStateData%BStC,1), UBOUND(DiscStateData%BStC,1) - CALL StC_DestroyDiscState( DiscStateData%BStC(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(DiscStateData%BStC) -ENDIF -IF (ALLOCATED(DiscStateData%NStC)) THEN -DO i1 = LBOUND(DiscStateData%NStC,1), UBOUND(DiscStateData%NStC,1) - CALL StC_DestroyDiscState( DiscStateData%NStC(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(DiscStateData%NStC) -ENDIF -IF (ALLOCATED(DiscStateData%TStC)) THEN -DO i1 = LBOUND(DiscStateData%TStC,1), UBOUND(DiscStateData%TStC,1) - CALL StC_DestroyDiscState( DiscStateData%TStC(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(DiscStateData%TStC) -ENDIF -IF (ALLOCATED(DiscStateData%SStC)) THEN -DO i1 = LBOUND(DiscStateData%SStC,1), UBOUND(DiscStateData%SStC,1) - CALL StC_DestroyDiscState( DiscStateData%SStC(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(DiscStateData%SStC) -ENDIF - END SUBROUTINE SrvD_DestroyDiscState +subroutine SrvD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(SrvD_DiscreteStateType), intent(in) :: SrcDiscStateData + type(SrvD_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + DstDiscStateData%CtrlOffset = SrcDiscStateData%CtrlOffset + if (allocated(SrcDiscStateData%BStC)) then + LB(1:1) = lbound(SrcDiscStateData%BStC) + UB(1:1) = ubound(SrcDiscStateData%BStC) + if (.not. allocated(DstDiscStateData%BStC)) then + allocate(DstDiscStateData%BStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%BStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyDiscState(SrcDiscStateData%BStC(i1), DstDiscStateData%BStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstDiscStateData%BStC)) then + deallocate(DstDiscStateData%BStC) + end if + if (allocated(SrcDiscStateData%NStC)) then + LB(1:1) = lbound(SrcDiscStateData%NStC) + UB(1:1) = ubound(SrcDiscStateData%NStC) + if (.not. allocated(DstDiscStateData%NStC)) then + allocate(DstDiscStateData%NStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%NStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyDiscState(SrcDiscStateData%NStC(i1), DstDiscStateData%NStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstDiscStateData%NStC)) then + deallocate(DstDiscStateData%NStC) + end if + if (allocated(SrcDiscStateData%TStC)) then + LB(1:1) = lbound(SrcDiscStateData%TStC) + UB(1:1) = ubound(SrcDiscStateData%TStC) + if (.not. allocated(DstDiscStateData%TStC)) then + allocate(DstDiscStateData%TStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%TStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyDiscState(SrcDiscStateData%TStC(i1), DstDiscStateData%TStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstDiscStateData%TStC)) then + deallocate(DstDiscStateData%TStC) + end if + if (allocated(SrcDiscStateData%SStC)) then + LB(1:1) = lbound(SrcDiscStateData%SStC) + UB(1:1) = ubound(SrcDiscStateData%SStC) + if (.not. allocated(DstDiscStateData%SStC)) then + allocate(DstDiscStateData%SStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%SStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyDiscState(SrcDiscStateData%SStC(i1), DstDiscStateData%SStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstDiscStateData%SStC)) then + deallocate(DstDiscStateData%SStC) + end if +end subroutine +subroutine SrvD_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(SrvD_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(DiscStateData%BStC)) then + LB(1:1) = lbound(DiscStateData%BStC) + UB(1:1) = ubound(DiscStateData%BStC) + do i1 = LB(1), UB(1) + call StC_DestroyDiscState(DiscStateData%BStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(DiscStateData%BStC) + end if + if (allocated(DiscStateData%NStC)) then + LB(1:1) = lbound(DiscStateData%NStC) + UB(1:1) = ubound(DiscStateData%NStC) + do i1 = LB(1), UB(1) + call StC_DestroyDiscState(DiscStateData%NStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(DiscStateData%NStC) + end if + if (allocated(DiscStateData%TStC)) then + LB(1:1) = lbound(DiscStateData%TStC) + UB(1:1) = ubound(DiscStateData%TStC) + do i1 = LB(1), UB(1) + call StC_DestroyDiscState(DiscStateData%TStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(DiscStateData%TStC) + end if + if (allocated(DiscStateData%SStC)) then + LB(1:1) = lbound(DiscStateData%SStC) + UB(1:1) = ubound(DiscStateData%SStC) + do i1 = LB(1), UB(1) + call StC_DestroyDiscState(DiscStateData%SStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(DiscStateData%SStC) + end if +end subroutine subroutine SrvD_PackDiscState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -4536,10 +4109,8 @@ subroutine SrvD_PackDiscState(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! CtrlOffset call RegPack(Buf, InData%CtrlOffset) if (RegCheckErr(Buf, RoutineName)) return - ! BStC call RegPack(Buf, allocated(InData%BStC)) if (allocated(InData%BStC)) then call RegPackBounds(Buf, 1, lbound(InData%BStC), ubound(InData%BStC)) @@ -4550,7 +4121,6 @@ subroutine SrvD_PackDiscState(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! NStC call RegPack(Buf, allocated(InData%NStC)) if (allocated(InData%NStC)) then call RegPackBounds(Buf, 1, lbound(InData%NStC), ubound(InData%NStC)) @@ -4561,7 +4131,6 @@ subroutine SrvD_PackDiscState(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! TStC call RegPack(Buf, allocated(InData%TStC)) if (allocated(InData%TStC)) then call RegPackBounds(Buf, 1, lbound(InData%TStC), ubound(InData%TStC)) @@ -4572,7 +4141,6 @@ subroutine SrvD_PackDiscState(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! SStC call RegPack(Buf, allocated(InData%SStC)) if (allocated(InData%SStC)) then call RegPackBounds(Buf, 1, lbound(InData%SStC), ubound(InData%SStC)) @@ -4594,10 +4162,8 @@ subroutine SrvD_UnPackDiscState(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! CtrlOffset call RegUnpack(Buf, OutData%CtrlOffset) if (RegCheckErr(Buf, RoutineName)) return - ! BStC if (allocated(OutData%BStC)) deallocate(OutData%BStC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4613,7 +4179,6 @@ subroutine SrvD_UnPackDiscState(Buf, OutData) call StC_UnpackDiscState(Buf, OutData%BStC(i1)) ! BStC end do end if - ! NStC if (allocated(OutData%NStC)) deallocate(OutData%NStC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4629,7 +4194,6 @@ subroutine SrvD_UnPackDiscState(Buf, OutData) call StC_UnpackDiscState(Buf, OutData%NStC(i1)) ! NStC end do end if - ! TStC if (allocated(OutData%TStC)) deallocate(OutData%TStC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4645,7 +4209,6 @@ subroutine SrvD_UnPackDiscState(Buf, OutData) call StC_UnpackDiscState(Buf, OutData%TStC(i1)) ! TStC end do end if - ! SStC if (allocated(OutData%SStC)) deallocate(OutData%SStC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4662,131 +4225,143 @@ subroutine SrvD_UnPackDiscState(Buf, OutData) end do end if end subroutine - SUBROUTINE SrvD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SrvD_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(SrvD_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState -IF (ALLOCATED(SrcConstrStateData%BStC)) THEN - i1_l = LBOUND(SrcConstrStateData%BStC,1) - i1_u = UBOUND(SrcConstrStateData%BStC,1) - IF (.NOT. ALLOCATED(DstConstrStateData%BStC)) THEN - ALLOCATE(DstConstrStateData%BStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcConstrStateData%BStC,1), UBOUND(SrcConstrStateData%BStC,1) - CALL StC_CopyConstrState( SrcConstrStateData%BStC(i1), DstConstrStateData%BStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcConstrStateData%NStC)) THEN - i1_l = LBOUND(SrcConstrStateData%NStC,1) - i1_u = UBOUND(SrcConstrStateData%NStC,1) - IF (.NOT. ALLOCATED(DstConstrStateData%NStC)) THEN - ALLOCATE(DstConstrStateData%NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcConstrStateData%NStC,1), UBOUND(SrcConstrStateData%NStC,1) - CALL StC_CopyConstrState( SrcConstrStateData%NStC(i1), DstConstrStateData%NStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcConstrStateData%TStC)) THEN - i1_l = LBOUND(SrcConstrStateData%TStC,1) - i1_u = UBOUND(SrcConstrStateData%TStC,1) - IF (.NOT. ALLOCATED(DstConstrStateData%TStC)) THEN - ALLOCATE(DstConstrStateData%TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcConstrStateData%TStC,1), UBOUND(SrcConstrStateData%TStC,1) - CALL StC_CopyConstrState( SrcConstrStateData%TStC(i1), DstConstrStateData%TStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcConstrStateData%SStC)) THEN - i1_l = LBOUND(SrcConstrStateData%SStC,1) - i1_u = UBOUND(SrcConstrStateData%SStC,1) - IF (.NOT. ALLOCATED(DstConstrStateData%SStC)) THEN - ALLOCATE(DstConstrStateData%SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcConstrStateData%SStC,1), UBOUND(SrcConstrStateData%SStC,1) - CALL StC_CopyConstrState( SrcConstrStateData%SStC(i1), DstConstrStateData%SStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE SrvD_CopyConstrState - - SUBROUTINE SrvD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(SrvD_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyConstrState' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ConstrStateData%BStC)) THEN -DO i1 = LBOUND(ConstrStateData%BStC,1), UBOUND(ConstrStateData%BStC,1) - CALL StC_DestroyConstrState( ConstrStateData%BStC(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ConstrStateData%BStC) -ENDIF -IF (ALLOCATED(ConstrStateData%NStC)) THEN -DO i1 = LBOUND(ConstrStateData%NStC,1), UBOUND(ConstrStateData%NStC,1) - CALL StC_DestroyConstrState( ConstrStateData%NStC(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ConstrStateData%NStC) -ENDIF -IF (ALLOCATED(ConstrStateData%TStC)) THEN -DO i1 = LBOUND(ConstrStateData%TStC,1), UBOUND(ConstrStateData%TStC,1) - CALL StC_DestroyConstrState( ConstrStateData%TStC(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ConstrStateData%TStC) -ENDIF -IF (ALLOCATED(ConstrStateData%SStC)) THEN -DO i1 = LBOUND(ConstrStateData%SStC,1), UBOUND(ConstrStateData%SStC,1) - CALL StC_DestroyConstrState( ConstrStateData%SStC(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ConstrStateData%SStC) -ENDIF - END SUBROUTINE SrvD_DestroyConstrState +subroutine SrvD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(SrvD_ConstraintStateType), intent(in) :: SrcConstrStateData + type(SrvD_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState + if (allocated(SrcConstrStateData%BStC)) then + LB(1:1) = lbound(SrcConstrStateData%BStC) + UB(1:1) = ubound(SrcConstrStateData%BStC) + if (.not. allocated(DstConstrStateData%BStC)) then + allocate(DstConstrStateData%BStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%BStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyConstrState(SrcConstrStateData%BStC(i1), DstConstrStateData%BStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstConstrStateData%BStC)) then + deallocate(DstConstrStateData%BStC) + end if + if (allocated(SrcConstrStateData%NStC)) then + LB(1:1) = lbound(SrcConstrStateData%NStC) + UB(1:1) = ubound(SrcConstrStateData%NStC) + if (.not. allocated(DstConstrStateData%NStC)) then + allocate(DstConstrStateData%NStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%NStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyConstrState(SrcConstrStateData%NStC(i1), DstConstrStateData%NStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstConstrStateData%NStC)) then + deallocate(DstConstrStateData%NStC) + end if + if (allocated(SrcConstrStateData%TStC)) then + LB(1:1) = lbound(SrcConstrStateData%TStC) + UB(1:1) = ubound(SrcConstrStateData%TStC) + if (.not. allocated(DstConstrStateData%TStC)) then + allocate(DstConstrStateData%TStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%TStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyConstrState(SrcConstrStateData%TStC(i1), DstConstrStateData%TStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstConstrStateData%TStC)) then + deallocate(DstConstrStateData%TStC) + end if + if (allocated(SrcConstrStateData%SStC)) then + LB(1:1) = lbound(SrcConstrStateData%SStC) + UB(1:1) = ubound(SrcConstrStateData%SStC) + if (.not. allocated(DstConstrStateData%SStC)) then + allocate(DstConstrStateData%SStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstConstrStateData%SStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyConstrState(SrcConstrStateData%SStC(i1), DstConstrStateData%SStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstConstrStateData%SStC)) then + deallocate(DstConstrStateData%SStC) + end if +end subroutine +subroutine SrvD_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(SrvD_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ConstrStateData%BStC)) then + LB(1:1) = lbound(ConstrStateData%BStC) + UB(1:1) = ubound(ConstrStateData%BStC) + do i1 = LB(1), UB(1) + call StC_DestroyConstrState(ConstrStateData%BStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ConstrStateData%BStC) + end if + if (allocated(ConstrStateData%NStC)) then + LB(1:1) = lbound(ConstrStateData%NStC) + UB(1:1) = ubound(ConstrStateData%NStC) + do i1 = LB(1), UB(1) + call StC_DestroyConstrState(ConstrStateData%NStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ConstrStateData%NStC) + end if + if (allocated(ConstrStateData%TStC)) then + LB(1:1) = lbound(ConstrStateData%TStC) + UB(1:1) = ubound(ConstrStateData%TStC) + do i1 = LB(1), UB(1) + call StC_DestroyConstrState(ConstrStateData%TStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ConstrStateData%TStC) + end if + if (allocated(ConstrStateData%SStC)) then + LB(1:1) = lbound(ConstrStateData%SStC) + UB(1:1) = ubound(ConstrStateData%SStC) + do i1 = LB(1), UB(1) + call StC_DestroyConstrState(ConstrStateData%SStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ConstrStateData%SStC) + end if +end subroutine subroutine SrvD_PackConstrState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -4795,10 +4370,8 @@ subroutine SrvD_PackConstrState(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! DummyConstrState call RegPack(Buf, InData%DummyConstrState) if (RegCheckErr(Buf, RoutineName)) return - ! BStC call RegPack(Buf, allocated(InData%BStC)) if (allocated(InData%BStC)) then call RegPackBounds(Buf, 1, lbound(InData%BStC), ubound(InData%BStC)) @@ -4809,7 +4382,6 @@ subroutine SrvD_PackConstrState(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! NStC call RegPack(Buf, allocated(InData%NStC)) if (allocated(InData%NStC)) then call RegPackBounds(Buf, 1, lbound(InData%NStC), ubound(InData%NStC)) @@ -4820,7 +4392,6 @@ subroutine SrvD_PackConstrState(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! TStC call RegPack(Buf, allocated(InData%TStC)) if (allocated(InData%TStC)) then call RegPackBounds(Buf, 1, lbound(InData%TStC), ubound(InData%TStC)) @@ -4831,7 +4402,6 @@ subroutine SrvD_PackConstrState(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! SStC call RegPack(Buf, allocated(InData%SStC)) if (allocated(InData%SStC)) then call RegPackBounds(Buf, 1, lbound(InData%SStC), ubound(InData%SStC)) @@ -4853,10 +4423,8 @@ subroutine SrvD_UnPackConstrState(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! DummyConstrState call RegUnpack(Buf, OutData%DummyConstrState) if (RegCheckErr(Buf, RoutineName)) return - ! BStC if (allocated(OutData%BStC)) deallocate(OutData%BStC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4872,7 +4440,6 @@ subroutine SrvD_UnPackConstrState(Buf, OutData) call StC_UnpackConstrState(Buf, OutData%BStC(i1)) ! BStC end do end if - ! NStC if (allocated(OutData%NStC)) deallocate(OutData%NStC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4888,7 +4455,6 @@ subroutine SrvD_UnPackConstrState(Buf, OutData) call StC_UnpackConstrState(Buf, OutData%NStC(i1)) ! NStC end do end if - ! TStC if (allocated(OutData%TStC)) deallocate(OutData%TStC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4904,7 +4470,6 @@ subroutine SrvD_UnPackConstrState(Buf, OutData) call StC_UnpackConstrState(Buf, OutData%TStC(i1)) ! TStC end do end if - ! SStC if (allocated(OutData%SStC)) deallocate(OutData%SStC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4921,226 +4486,250 @@ subroutine SrvD_UnPackConstrState(Buf, OutData) end do end if end subroutine - SUBROUTINE SrvD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SrvD_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(SrvD_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOtherStateData%BegPitMan)) THEN - i1_l = LBOUND(SrcOtherStateData%BegPitMan,1) - i1_u = UBOUND(SrcOtherStateData%BegPitMan,1) - IF (.NOT. ALLOCATED(DstOtherStateData%BegPitMan)) THEN - ALLOCATE(DstOtherStateData%BegPitMan(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%BegPitMan.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%BegPitMan = SrcOtherStateData%BegPitMan -ENDIF -IF (ALLOCATED(SrcOtherStateData%BlPitchI)) THEN - i1_l = LBOUND(SrcOtherStateData%BlPitchI,1) - i1_u = UBOUND(SrcOtherStateData%BlPitchI,1) - IF (.NOT. ALLOCATED(DstOtherStateData%BlPitchI)) THEN - ALLOCATE(DstOtherStateData%BlPitchI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%BlPitchI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%BlPitchI = SrcOtherStateData%BlPitchI -ENDIF -IF (ALLOCATED(SrcOtherStateData%TPitManE)) THEN - i1_l = LBOUND(SrcOtherStateData%TPitManE,1) - i1_u = UBOUND(SrcOtherStateData%TPitManE,1) - IF (.NOT. ALLOCATED(DstOtherStateData%TPitManE)) THEN - ALLOCATE(DstOtherStateData%TPitManE(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%TPitManE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%TPitManE = SrcOtherStateData%TPitManE -ENDIF - DstOtherStateData%BegYawMan = SrcOtherStateData%BegYawMan - DstOtherStateData%NacYawI = SrcOtherStateData%NacYawI - DstOtherStateData%TYawManE = SrcOtherStateData%TYawManE - DstOtherStateData%YawPosComInt = SrcOtherStateData%YawPosComInt -IF (ALLOCATED(SrcOtherStateData%BegTpBr)) THEN - i1_l = LBOUND(SrcOtherStateData%BegTpBr,1) - i1_u = UBOUND(SrcOtherStateData%BegTpBr,1) - IF (.NOT. ALLOCATED(DstOtherStateData%BegTpBr)) THEN - ALLOCATE(DstOtherStateData%BegTpBr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%BegTpBr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%BegTpBr = SrcOtherStateData%BegTpBr -ENDIF -IF (ALLOCATED(SrcOtherStateData%TTpBrDp)) THEN - i1_l = LBOUND(SrcOtherStateData%TTpBrDp,1) - i1_u = UBOUND(SrcOtherStateData%TTpBrDp,1) - IF (.NOT. ALLOCATED(DstOtherStateData%TTpBrDp)) THEN - ALLOCATE(DstOtherStateData%TTpBrDp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%TTpBrDp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%TTpBrDp = SrcOtherStateData%TTpBrDp -ENDIF -IF (ALLOCATED(SrcOtherStateData%TTpBrFl)) THEN - i1_l = LBOUND(SrcOtherStateData%TTpBrFl,1) - i1_u = UBOUND(SrcOtherStateData%TTpBrFl,1) - IF (.NOT. ALLOCATED(DstOtherStateData%TTpBrFl)) THEN - ALLOCATE(DstOtherStateData%TTpBrFl(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%TTpBrFl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOtherStateData%TTpBrFl = SrcOtherStateData%TTpBrFl -ENDIF - DstOtherStateData%Off4Good = SrcOtherStateData%Off4Good - DstOtherStateData%GenOnLine = SrcOtherStateData%GenOnLine -IF (ALLOCATED(SrcOtherStateData%BStC)) THEN - i1_l = LBOUND(SrcOtherStateData%BStC,1) - i1_u = UBOUND(SrcOtherStateData%BStC,1) - IF (.NOT. ALLOCATED(DstOtherStateData%BStC)) THEN - ALLOCATE(DstOtherStateData%BStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOtherStateData%BStC,1), UBOUND(SrcOtherStateData%BStC,1) - CALL StC_CopyOtherState( SrcOtherStateData%BStC(i1), DstOtherStateData%BStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcOtherStateData%NStC)) THEN - i1_l = LBOUND(SrcOtherStateData%NStC,1) - i1_u = UBOUND(SrcOtherStateData%NStC,1) - IF (.NOT. ALLOCATED(DstOtherStateData%NStC)) THEN - ALLOCATE(DstOtherStateData%NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOtherStateData%NStC,1), UBOUND(SrcOtherStateData%NStC,1) - CALL StC_CopyOtherState( SrcOtherStateData%NStC(i1), DstOtherStateData%NStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcOtherStateData%TStC)) THEN - i1_l = LBOUND(SrcOtherStateData%TStC,1) - i1_u = UBOUND(SrcOtherStateData%TStC,1) - IF (.NOT. ALLOCATED(DstOtherStateData%TStC)) THEN - ALLOCATE(DstOtherStateData%TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOtherStateData%TStC,1), UBOUND(SrcOtherStateData%TStC,1) - CALL StC_CopyOtherState( SrcOtherStateData%TStC(i1), DstOtherStateData%TStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcOtherStateData%SStC)) THEN - i1_l = LBOUND(SrcOtherStateData%SStC,1) - i1_u = UBOUND(SrcOtherStateData%SStC,1) - IF (.NOT. ALLOCATED(DstOtherStateData%SStC)) THEN - ALLOCATE(DstOtherStateData%SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOtherStateData%SStC,1), UBOUND(SrcOtherStateData%SStC,1) - CALL StC_CopyOtherState( SrcOtherStateData%SStC(i1), DstOtherStateData%SStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE SrvD_CopyOtherState - - SUBROUTINE SrvD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(SrvD_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(OtherStateData%BegPitMan)) THEN - DEALLOCATE(OtherStateData%BegPitMan) -ENDIF -IF (ALLOCATED(OtherStateData%BlPitchI)) THEN - DEALLOCATE(OtherStateData%BlPitchI) -ENDIF -IF (ALLOCATED(OtherStateData%TPitManE)) THEN - DEALLOCATE(OtherStateData%TPitManE) -ENDIF -IF (ALLOCATED(OtherStateData%BegTpBr)) THEN - DEALLOCATE(OtherStateData%BegTpBr) -ENDIF -IF (ALLOCATED(OtherStateData%TTpBrDp)) THEN - DEALLOCATE(OtherStateData%TTpBrDp) -ENDIF -IF (ALLOCATED(OtherStateData%TTpBrFl)) THEN - DEALLOCATE(OtherStateData%TTpBrFl) -ENDIF -IF (ALLOCATED(OtherStateData%BStC)) THEN -DO i1 = LBOUND(OtherStateData%BStC,1), UBOUND(OtherStateData%BStC,1) - CALL StC_DestroyOtherState( OtherStateData%BStC(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OtherStateData%BStC) -ENDIF -IF (ALLOCATED(OtherStateData%NStC)) THEN -DO i1 = LBOUND(OtherStateData%NStC,1), UBOUND(OtherStateData%NStC,1) - CALL StC_DestroyOtherState( OtherStateData%NStC(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OtherStateData%NStC) -ENDIF -IF (ALLOCATED(OtherStateData%TStC)) THEN -DO i1 = LBOUND(OtherStateData%TStC,1), UBOUND(OtherStateData%TStC,1) - CALL StC_DestroyOtherState( OtherStateData%TStC(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OtherStateData%TStC) -ENDIF -IF (ALLOCATED(OtherStateData%SStC)) THEN -DO i1 = LBOUND(OtherStateData%SStC,1), UBOUND(OtherStateData%SStC,1) - CALL StC_DestroyOtherState( OtherStateData%SStC(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OtherStateData%SStC) -ENDIF - END SUBROUTINE SrvD_DestroyOtherState +subroutine SrvD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(SrvD_OtherStateType), intent(in) :: SrcOtherStateData + type(SrvD_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOtherStateData%BegPitMan)) then + LB(1:1) = lbound(SrcOtherStateData%BegPitMan) + UB(1:1) = ubound(SrcOtherStateData%BegPitMan) + if (.not. allocated(DstOtherStateData%BegPitMan)) then + allocate(DstOtherStateData%BegPitMan(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%BegPitMan.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%BegPitMan = SrcOtherStateData%BegPitMan + else if (allocated(DstOtherStateData%BegPitMan)) then + deallocate(DstOtherStateData%BegPitMan) + end if + if (allocated(SrcOtherStateData%BlPitchI)) then + LB(1:1) = lbound(SrcOtherStateData%BlPitchI) + UB(1:1) = ubound(SrcOtherStateData%BlPitchI) + if (.not. allocated(DstOtherStateData%BlPitchI)) then + allocate(DstOtherStateData%BlPitchI(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%BlPitchI.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%BlPitchI = SrcOtherStateData%BlPitchI + else if (allocated(DstOtherStateData%BlPitchI)) then + deallocate(DstOtherStateData%BlPitchI) + end if + if (allocated(SrcOtherStateData%TPitManE)) then + LB(1:1) = lbound(SrcOtherStateData%TPitManE) + UB(1:1) = ubound(SrcOtherStateData%TPitManE) + if (.not. allocated(DstOtherStateData%TPitManE)) then + allocate(DstOtherStateData%TPitManE(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%TPitManE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%TPitManE = SrcOtherStateData%TPitManE + else if (allocated(DstOtherStateData%TPitManE)) then + deallocate(DstOtherStateData%TPitManE) + end if + DstOtherStateData%BegYawMan = SrcOtherStateData%BegYawMan + DstOtherStateData%NacYawI = SrcOtherStateData%NacYawI + DstOtherStateData%TYawManE = SrcOtherStateData%TYawManE + DstOtherStateData%YawPosComInt = SrcOtherStateData%YawPosComInt + if (allocated(SrcOtherStateData%BegTpBr)) then + LB(1:1) = lbound(SrcOtherStateData%BegTpBr) + UB(1:1) = ubound(SrcOtherStateData%BegTpBr) + if (.not. allocated(DstOtherStateData%BegTpBr)) then + allocate(DstOtherStateData%BegTpBr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%BegTpBr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%BegTpBr = SrcOtherStateData%BegTpBr + else if (allocated(DstOtherStateData%BegTpBr)) then + deallocate(DstOtherStateData%BegTpBr) + end if + if (allocated(SrcOtherStateData%TTpBrDp)) then + LB(1:1) = lbound(SrcOtherStateData%TTpBrDp) + UB(1:1) = ubound(SrcOtherStateData%TTpBrDp) + if (.not. allocated(DstOtherStateData%TTpBrDp)) then + allocate(DstOtherStateData%TTpBrDp(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%TTpBrDp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%TTpBrDp = SrcOtherStateData%TTpBrDp + else if (allocated(DstOtherStateData%TTpBrDp)) then + deallocate(DstOtherStateData%TTpBrDp) + end if + if (allocated(SrcOtherStateData%TTpBrFl)) then + LB(1:1) = lbound(SrcOtherStateData%TTpBrFl) + UB(1:1) = ubound(SrcOtherStateData%TTpBrFl) + if (.not. allocated(DstOtherStateData%TTpBrFl)) then + allocate(DstOtherStateData%TTpBrFl(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%TTpBrFl.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOtherStateData%TTpBrFl = SrcOtherStateData%TTpBrFl + else if (allocated(DstOtherStateData%TTpBrFl)) then + deallocate(DstOtherStateData%TTpBrFl) + end if + DstOtherStateData%Off4Good = SrcOtherStateData%Off4Good + DstOtherStateData%GenOnLine = SrcOtherStateData%GenOnLine + if (allocated(SrcOtherStateData%BStC)) then + LB(1:1) = lbound(SrcOtherStateData%BStC) + UB(1:1) = ubound(SrcOtherStateData%BStC) + if (.not. allocated(DstOtherStateData%BStC)) then + allocate(DstOtherStateData%BStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%BStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyOtherState(SrcOtherStateData%BStC(i1), DstOtherStateData%BStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstOtherStateData%BStC)) then + deallocate(DstOtherStateData%BStC) + end if + if (allocated(SrcOtherStateData%NStC)) then + LB(1:1) = lbound(SrcOtherStateData%NStC) + UB(1:1) = ubound(SrcOtherStateData%NStC) + if (.not. allocated(DstOtherStateData%NStC)) then + allocate(DstOtherStateData%NStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%NStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyOtherState(SrcOtherStateData%NStC(i1), DstOtherStateData%NStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstOtherStateData%NStC)) then + deallocate(DstOtherStateData%NStC) + end if + if (allocated(SrcOtherStateData%TStC)) then + LB(1:1) = lbound(SrcOtherStateData%TStC) + UB(1:1) = ubound(SrcOtherStateData%TStC) + if (.not. allocated(DstOtherStateData%TStC)) then + allocate(DstOtherStateData%TStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%TStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyOtherState(SrcOtherStateData%TStC(i1), DstOtherStateData%TStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstOtherStateData%TStC)) then + deallocate(DstOtherStateData%TStC) + end if + if (allocated(SrcOtherStateData%SStC)) then + LB(1:1) = lbound(SrcOtherStateData%SStC) + UB(1:1) = ubound(SrcOtherStateData%SStC) + if (.not. allocated(DstOtherStateData%SStC)) then + allocate(DstOtherStateData%SStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%SStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyOtherState(SrcOtherStateData%SStC(i1), DstOtherStateData%SStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstOtherStateData%SStC)) then + deallocate(DstOtherStateData%SStC) + end if +end subroutine +subroutine SrvD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(SrvD_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OtherStateData%BegPitMan)) then + deallocate(OtherStateData%BegPitMan) + end if + if (allocated(OtherStateData%BlPitchI)) then + deallocate(OtherStateData%BlPitchI) + end if + if (allocated(OtherStateData%TPitManE)) then + deallocate(OtherStateData%TPitManE) + end if + if (allocated(OtherStateData%BegTpBr)) then + deallocate(OtherStateData%BegTpBr) + end if + if (allocated(OtherStateData%TTpBrDp)) then + deallocate(OtherStateData%TTpBrDp) + end if + if (allocated(OtherStateData%TTpBrFl)) then + deallocate(OtherStateData%TTpBrFl) + end if + if (allocated(OtherStateData%BStC)) then + LB(1:1) = lbound(OtherStateData%BStC) + UB(1:1) = ubound(OtherStateData%BStC) + do i1 = LB(1), UB(1) + call StC_DestroyOtherState(OtherStateData%BStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OtherStateData%BStC) + end if + if (allocated(OtherStateData%NStC)) then + LB(1:1) = lbound(OtherStateData%NStC) + UB(1:1) = ubound(OtherStateData%NStC) + do i1 = LB(1), UB(1) + call StC_DestroyOtherState(OtherStateData%NStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OtherStateData%NStC) + end if + if (allocated(OtherStateData%TStC)) then + LB(1:1) = lbound(OtherStateData%TStC) + UB(1:1) = ubound(OtherStateData%TStC) + do i1 = LB(1), UB(1) + call StC_DestroyOtherState(OtherStateData%TStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OtherStateData%TStC) + end if + if (allocated(OtherStateData%SStC)) then + LB(1:1) = lbound(OtherStateData%SStC) + UB(1:1) = ubound(OtherStateData%SStC) + do i1 = LB(1), UB(1) + call StC_DestroyOtherState(OtherStateData%SStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OtherStateData%SStC) + end if +end subroutine subroutine SrvD_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -5149,67 +4738,54 @@ subroutine SrvD_PackOtherState(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! BegPitMan call RegPack(Buf, allocated(InData%BegPitMan)) if (allocated(InData%BegPitMan)) then call RegPackBounds(Buf, 1, lbound(InData%BegPitMan), ubound(InData%BegPitMan)) call RegPack(Buf, InData%BegPitMan) end if if (RegCheckErr(Buf, RoutineName)) return - ! BlPitchI call RegPack(Buf, allocated(InData%BlPitchI)) if (allocated(InData%BlPitchI)) then call RegPackBounds(Buf, 1, lbound(InData%BlPitchI), ubound(InData%BlPitchI)) call RegPack(Buf, InData%BlPitchI) end if if (RegCheckErr(Buf, RoutineName)) return - ! TPitManE call RegPack(Buf, allocated(InData%TPitManE)) if (allocated(InData%TPitManE)) then call RegPackBounds(Buf, 1, lbound(InData%TPitManE), ubound(InData%TPitManE)) call RegPack(Buf, InData%TPitManE) end if if (RegCheckErr(Buf, RoutineName)) return - ! BegYawMan call RegPack(Buf, InData%BegYawMan) if (RegCheckErr(Buf, RoutineName)) return - ! NacYawI call RegPack(Buf, InData%NacYawI) if (RegCheckErr(Buf, RoutineName)) return - ! TYawManE call RegPack(Buf, InData%TYawManE) if (RegCheckErr(Buf, RoutineName)) return - ! YawPosComInt call RegPack(Buf, InData%YawPosComInt) if (RegCheckErr(Buf, RoutineName)) return - ! BegTpBr call RegPack(Buf, allocated(InData%BegTpBr)) if (allocated(InData%BegTpBr)) then call RegPackBounds(Buf, 1, lbound(InData%BegTpBr), ubound(InData%BegTpBr)) call RegPack(Buf, InData%BegTpBr) end if if (RegCheckErr(Buf, RoutineName)) return - ! TTpBrDp call RegPack(Buf, allocated(InData%TTpBrDp)) if (allocated(InData%TTpBrDp)) then call RegPackBounds(Buf, 1, lbound(InData%TTpBrDp), ubound(InData%TTpBrDp)) call RegPack(Buf, InData%TTpBrDp) end if if (RegCheckErr(Buf, RoutineName)) return - ! TTpBrFl call RegPack(Buf, allocated(InData%TTpBrFl)) if (allocated(InData%TTpBrFl)) then call RegPackBounds(Buf, 1, lbound(InData%TTpBrFl), ubound(InData%TTpBrFl)) call RegPack(Buf, InData%TTpBrFl) end if if (RegCheckErr(Buf, RoutineName)) return - ! Off4Good call RegPack(Buf, InData%Off4Good) if (RegCheckErr(Buf, RoutineName)) return - ! GenOnLine call RegPack(Buf, InData%GenOnLine) if (RegCheckErr(Buf, RoutineName)) return - ! BStC call RegPack(Buf, allocated(InData%BStC)) if (allocated(InData%BStC)) then call RegPackBounds(Buf, 1, lbound(InData%BStC), ubound(InData%BStC)) @@ -5220,7 +4796,6 @@ subroutine SrvD_PackOtherState(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! NStC call RegPack(Buf, allocated(InData%NStC)) if (allocated(InData%NStC)) then call RegPackBounds(Buf, 1, lbound(InData%NStC), ubound(InData%NStC)) @@ -5231,7 +4806,6 @@ subroutine SrvD_PackOtherState(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! TStC call RegPack(Buf, allocated(InData%TStC)) if (allocated(InData%TStC)) then call RegPackBounds(Buf, 1, lbound(InData%TStC), ubound(InData%TStC)) @@ -5242,7 +4816,6 @@ subroutine SrvD_PackOtherState(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! SStC call RegPack(Buf, allocated(InData%SStC)) if (allocated(InData%SStC)) then call RegPackBounds(Buf, 1, lbound(InData%SStC), ubound(InData%SStC)) @@ -5264,7 +4837,6 @@ subroutine SrvD_UnPackOtherState(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! BegPitMan if (allocated(OutData%BegPitMan)) deallocate(OutData%BegPitMan) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5279,7 +4851,6 @@ subroutine SrvD_UnPackOtherState(Buf, OutData) call RegUnpack(Buf, OutData%BegPitMan) if (RegCheckErr(Buf, RoutineName)) return end if - ! BlPitchI if (allocated(OutData%BlPitchI)) deallocate(OutData%BlPitchI) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5294,7 +4865,6 @@ subroutine SrvD_UnPackOtherState(Buf, OutData) call RegUnpack(Buf, OutData%BlPitchI) if (RegCheckErr(Buf, RoutineName)) return end if - ! TPitManE if (allocated(OutData%TPitManE)) deallocate(OutData%TPitManE) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5309,19 +4879,14 @@ subroutine SrvD_UnPackOtherState(Buf, OutData) call RegUnpack(Buf, OutData%TPitManE) if (RegCheckErr(Buf, RoutineName)) return end if - ! BegYawMan call RegUnpack(Buf, OutData%BegYawMan) if (RegCheckErr(Buf, RoutineName)) return - ! NacYawI call RegUnpack(Buf, OutData%NacYawI) if (RegCheckErr(Buf, RoutineName)) return - ! TYawManE call RegUnpack(Buf, OutData%TYawManE) if (RegCheckErr(Buf, RoutineName)) return - ! YawPosComInt call RegUnpack(Buf, OutData%YawPosComInt) if (RegCheckErr(Buf, RoutineName)) return - ! BegTpBr if (allocated(OutData%BegTpBr)) deallocate(OutData%BegTpBr) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5336,7 +4901,6 @@ subroutine SrvD_UnPackOtherState(Buf, OutData) call RegUnpack(Buf, OutData%BegTpBr) if (RegCheckErr(Buf, RoutineName)) return end if - ! TTpBrDp if (allocated(OutData%TTpBrDp)) deallocate(OutData%TTpBrDp) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5351,7 +4915,6 @@ subroutine SrvD_UnPackOtherState(Buf, OutData) call RegUnpack(Buf, OutData%TTpBrDp) if (RegCheckErr(Buf, RoutineName)) return end if - ! TTpBrFl if (allocated(OutData%TTpBrFl)) deallocate(OutData%TTpBrFl) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5366,13 +4929,10 @@ subroutine SrvD_UnPackOtherState(Buf, OutData) call RegUnpack(Buf, OutData%TTpBrFl) if (RegCheckErr(Buf, RoutineName)) return end if - ! Off4Good call RegUnpack(Buf, OutData%Off4Good) if (RegCheckErr(Buf, RoutineName)) return - ! GenOnLine call RegUnpack(Buf, OutData%GenOnLine) if (RegCheckErr(Buf, RoutineName)) return - ! BStC if (allocated(OutData%BStC)) deallocate(OutData%BStC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5388,7 +4948,6 @@ subroutine SrvD_UnPackOtherState(Buf, OutData) call StC_UnpackOtherState(Buf, OutData%BStC(i1)) ! BStC end do end if - ! NStC if (allocated(OutData%NStC)) deallocate(OutData%NStC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5404,7 +4963,6 @@ subroutine SrvD_UnPackOtherState(Buf, OutData) call StC_UnpackOtherState(Buf, OutData%NStC(i1)) ! NStC end do end if - ! TStC if (allocated(OutData%TStC)) deallocate(OutData%TStC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5420,7 +4978,6 @@ subroutine SrvD_UnPackOtherState(Buf, OutData) call StC_UnpackOtherState(Buf, OutData%TStC(i1)) ! TStC end do end if - ! SStC if (allocated(OutData%SStC)) deallocate(OutData%SStC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5437,249 +4994,271 @@ subroutine SrvD_UnPackOtherState(Buf, OutData) end do end if end subroutine - SUBROUTINE SrvD_CopyModuleMapType( SrcModuleMapTypeData, DstModuleMapTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SrvD_ModuleMapType), INTENT(INOUT) :: SrcModuleMapTypeData - TYPE(SrvD_ModuleMapType), INTENT(INOUT) :: DstModuleMapTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_CopyModuleMapType' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcModuleMapTypeData%u_BStC_Mot2_BStC)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%u_BStC_Mot2_BStC,1) - i1_u = UBOUND(SrcModuleMapTypeData%u_BStC_Mot2_BStC,1) - i2_l = LBOUND(SrcModuleMapTypeData%u_BStC_Mot2_BStC,2) - i2_u = UBOUND(SrcModuleMapTypeData%u_BStC_Mot2_BStC,2) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%u_BStC_Mot2_BStC)) THEN - ALLOCATE(DstModuleMapTypeData%u_BStC_Mot2_BStC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_BStC_Mot2_BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcModuleMapTypeData%u_BStC_Mot2_BStC,2), UBOUND(SrcModuleMapTypeData%u_BStC_Mot2_BStC,2) - DO i1 = LBOUND(SrcModuleMapTypeData%u_BStC_Mot2_BStC,1), UBOUND(SrcModuleMapTypeData%u_BStC_Mot2_BStC,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%u_BStC_Mot2_BStC(i1,i2), DstModuleMapTypeData%u_BStC_Mot2_BStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%u_NStC_Mot2_NStC)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%u_NStC_Mot2_NStC,1) - i1_u = UBOUND(SrcModuleMapTypeData%u_NStC_Mot2_NStC,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%u_NStC_Mot2_NStC)) THEN - ALLOCATE(DstModuleMapTypeData%u_NStC_Mot2_NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_NStC_Mot2_NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%u_NStC_Mot2_NStC,1), UBOUND(SrcModuleMapTypeData%u_NStC_Mot2_NStC,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%u_NStC_Mot2_NStC(i1), DstModuleMapTypeData%u_NStC_Mot2_NStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%u_TStC_Mot2_TStC)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%u_TStC_Mot2_TStC,1) - i1_u = UBOUND(SrcModuleMapTypeData%u_TStC_Mot2_TStC,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%u_TStC_Mot2_TStC)) THEN - ALLOCATE(DstModuleMapTypeData%u_TStC_Mot2_TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_TStC_Mot2_TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%u_TStC_Mot2_TStC,1), UBOUND(SrcModuleMapTypeData%u_TStC_Mot2_TStC,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%u_TStC_Mot2_TStC(i1), DstModuleMapTypeData%u_TStC_Mot2_TStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%u_SStC_Mot2_SStC)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%u_SStC_Mot2_SStC,1) - i1_u = UBOUND(SrcModuleMapTypeData%u_SStC_Mot2_SStC,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%u_SStC_Mot2_SStC)) THEN - ALLOCATE(DstModuleMapTypeData%u_SStC_Mot2_SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_SStC_Mot2_SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%u_SStC_Mot2_SStC,1), UBOUND(SrcModuleMapTypeData%u_SStC_Mot2_SStC,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%u_SStC_Mot2_SStC(i1), DstModuleMapTypeData%u_SStC_Mot2_SStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%BStC_Frc2_y_BStC)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%BStC_Frc2_y_BStC,1) - i1_u = UBOUND(SrcModuleMapTypeData%BStC_Frc2_y_BStC,1) - i2_l = LBOUND(SrcModuleMapTypeData%BStC_Frc2_y_BStC,2) - i2_u = UBOUND(SrcModuleMapTypeData%BStC_Frc2_y_BStC,2) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%BStC_Frc2_y_BStC)) THEN - ALLOCATE(DstModuleMapTypeData%BStC_Frc2_y_BStC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BStC_Frc2_y_BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcModuleMapTypeData%BStC_Frc2_y_BStC,2), UBOUND(SrcModuleMapTypeData%BStC_Frc2_y_BStC,2) - DO i1 = LBOUND(SrcModuleMapTypeData%BStC_Frc2_y_BStC,1), UBOUND(SrcModuleMapTypeData%BStC_Frc2_y_BStC,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%BStC_Frc2_y_BStC(i1,i2), DstModuleMapTypeData%BStC_Frc2_y_BStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%NStC_Frc2_y_NStC)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%NStC_Frc2_y_NStC,1) - i1_u = UBOUND(SrcModuleMapTypeData%NStC_Frc2_y_NStC,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%NStC_Frc2_y_NStC)) THEN - ALLOCATE(DstModuleMapTypeData%NStC_Frc2_y_NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%NStC_Frc2_y_NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%NStC_Frc2_y_NStC,1), UBOUND(SrcModuleMapTypeData%NStC_Frc2_y_NStC,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%NStC_Frc2_y_NStC(i1), DstModuleMapTypeData%NStC_Frc2_y_NStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%TStC_Frc2_y_TStC)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%TStC_Frc2_y_TStC,1) - i1_u = UBOUND(SrcModuleMapTypeData%TStC_Frc2_y_TStC,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%TStC_Frc2_y_TStC)) THEN - ALLOCATE(DstModuleMapTypeData%TStC_Frc2_y_TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%TStC_Frc2_y_TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%TStC_Frc2_y_TStC,1), UBOUND(SrcModuleMapTypeData%TStC_Frc2_y_TStC,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%TStC_Frc2_y_TStC(i1), DstModuleMapTypeData%TStC_Frc2_y_TStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%SStC_Frc2_y_SStC)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%SStC_Frc2_y_SStC,1) - i1_u = UBOUND(SrcModuleMapTypeData%SStC_Frc2_y_SStC,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%SStC_Frc2_y_SStC)) THEN - ALLOCATE(DstModuleMapTypeData%SStC_Frc2_y_SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%SStC_Frc2_y_SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%SStC_Frc2_y_SStC,1), UBOUND(SrcModuleMapTypeData%SStC_Frc2_y_SStC,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SStC_Frc2_y_SStC(i1), DstModuleMapTypeData%SStC_Frc2_y_SStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE SrvD_CopyModuleMapType - - SUBROUTINE SrvD_DestroyModuleMapType( ModuleMapTypeData, ErrStat, ErrMsg ) - TYPE(SrvD_ModuleMapType), INTENT(INOUT) :: ModuleMapTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyModuleMapType' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ModuleMapTypeData%u_BStC_Mot2_BStC)) THEN -DO i2 = LBOUND(ModuleMapTypeData%u_BStC_Mot2_BStC,2), UBOUND(ModuleMapTypeData%u_BStC_Mot2_BStC,2) -DO i1 = LBOUND(ModuleMapTypeData%u_BStC_Mot2_BStC,1), UBOUND(ModuleMapTypeData%u_BStC_Mot2_BStC,1) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%u_BStC_Mot2_BStC(i1,i2), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(ModuleMapTypeData%u_BStC_Mot2_BStC) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%u_NStC_Mot2_NStC)) THEN -DO i1 = LBOUND(ModuleMapTypeData%u_NStC_Mot2_NStC,1), UBOUND(ModuleMapTypeData%u_NStC_Mot2_NStC,1) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%u_NStC_Mot2_NStC(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%u_NStC_Mot2_NStC) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%u_TStC_Mot2_TStC)) THEN -DO i1 = LBOUND(ModuleMapTypeData%u_TStC_Mot2_TStC,1), UBOUND(ModuleMapTypeData%u_TStC_Mot2_TStC,1) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%u_TStC_Mot2_TStC(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%u_TStC_Mot2_TStC) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%u_SStC_Mot2_SStC)) THEN -DO i1 = LBOUND(ModuleMapTypeData%u_SStC_Mot2_SStC,1), UBOUND(ModuleMapTypeData%u_SStC_Mot2_SStC,1) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%u_SStC_Mot2_SStC(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%u_SStC_Mot2_SStC) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%BStC_Frc2_y_BStC)) THEN -DO i2 = LBOUND(ModuleMapTypeData%BStC_Frc2_y_BStC,2), UBOUND(ModuleMapTypeData%BStC_Frc2_y_BStC,2) -DO i1 = LBOUND(ModuleMapTypeData%BStC_Frc2_y_BStC,1), UBOUND(ModuleMapTypeData%BStC_Frc2_y_BStC,1) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%BStC_Frc2_y_BStC(i1,i2), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(ModuleMapTypeData%BStC_Frc2_y_BStC) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%NStC_Frc2_y_NStC)) THEN -DO i1 = LBOUND(ModuleMapTypeData%NStC_Frc2_y_NStC,1), UBOUND(ModuleMapTypeData%NStC_Frc2_y_NStC,1) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%NStC_Frc2_y_NStC(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%NStC_Frc2_y_NStC) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%TStC_Frc2_y_TStC)) THEN -DO i1 = LBOUND(ModuleMapTypeData%TStC_Frc2_y_TStC,1), UBOUND(ModuleMapTypeData%TStC_Frc2_y_TStC,1) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%TStC_Frc2_y_TStC(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%TStC_Frc2_y_TStC) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%SStC_Frc2_y_SStC)) THEN -DO i1 = LBOUND(ModuleMapTypeData%SStC_Frc2_y_SStC,1), UBOUND(ModuleMapTypeData%SStC_Frc2_y_SStC,1) - CALL NWTC_Library_DestroyMeshMapType( ModuleMapTypeData%SStC_Frc2_y_SStC(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ModuleMapTypeData%SStC_Frc2_y_SStC) -ENDIF - END SUBROUTINE SrvD_DestroyModuleMapType - - -subroutine SrvD_PackModuleMapType(Buf, Indata) - type(PackBuffer), intent(inout) :: Buf - type(SrvD_ModuleMapType), intent(in) :: InData - character(*), parameter :: RoutineName = 'SrvD_PackModuleMapType' +subroutine SrvD_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, CtrlCode, ErrStat, ErrMsg) + type(SrvD_ModuleMapType), intent(inout) :: SrcModuleMapTypeData + type(SrvD_ModuleMapType), intent(inout) :: DstModuleMapTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg integer(IntKi) :: i1, i2 - integer(IntKi) :: LB(2), UB(2) - if (Buf%ErrStat >= AbortErrLev) return - ! u_BStC_Mot2_BStC - call RegPack(Buf, allocated(InData%u_BStC_Mot2_BStC)) - if (allocated(InData%u_BStC_Mot2_BStC)) then - call RegPackBounds(Buf, 2, lbound(InData%u_BStC_Mot2_BStC), ubound(InData%u_BStC_Mot2_BStC)) - LB(1:2) = lbound(InData%u_BStC_Mot2_BStC) - UB(1:2) = ubound(InData%u_BStC_Mot2_BStC) + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_CopyModuleMapType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcModuleMapTypeData%u_BStC_Mot2_BStC)) then + LB(1:2) = lbound(SrcModuleMapTypeData%u_BStC_Mot2_BStC) + UB(1:2) = ubound(SrcModuleMapTypeData%u_BStC_Mot2_BStC) + if (.not. allocated(DstModuleMapTypeData%u_BStC_Mot2_BStC)) then + allocate(DstModuleMapTypeData%u_BStC_Mot2_BStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_BStC_Mot2_BStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%u_BStC_Mot2_BStC(i1,i2), DstModuleMapTypeData%u_BStC_Mot2_BStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + else if (allocated(DstModuleMapTypeData%u_BStC_Mot2_BStC)) then + deallocate(DstModuleMapTypeData%u_BStC_Mot2_BStC) + end if + if (allocated(SrcModuleMapTypeData%u_NStC_Mot2_NStC)) then + LB(1:1) = lbound(SrcModuleMapTypeData%u_NStC_Mot2_NStC) + UB(1:1) = ubound(SrcModuleMapTypeData%u_NStC_Mot2_NStC) + if (.not. allocated(DstModuleMapTypeData%u_NStC_Mot2_NStC)) then + allocate(DstModuleMapTypeData%u_NStC_Mot2_NStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_NStC_Mot2_NStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%u_NStC_Mot2_NStC(i1), DstModuleMapTypeData%u_NStC_Mot2_NStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstModuleMapTypeData%u_NStC_Mot2_NStC)) then + deallocate(DstModuleMapTypeData%u_NStC_Mot2_NStC) + end if + if (allocated(SrcModuleMapTypeData%u_TStC_Mot2_TStC)) then + LB(1:1) = lbound(SrcModuleMapTypeData%u_TStC_Mot2_TStC) + UB(1:1) = ubound(SrcModuleMapTypeData%u_TStC_Mot2_TStC) + if (.not. allocated(DstModuleMapTypeData%u_TStC_Mot2_TStC)) then + allocate(DstModuleMapTypeData%u_TStC_Mot2_TStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_TStC_Mot2_TStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%u_TStC_Mot2_TStC(i1), DstModuleMapTypeData%u_TStC_Mot2_TStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstModuleMapTypeData%u_TStC_Mot2_TStC)) then + deallocate(DstModuleMapTypeData%u_TStC_Mot2_TStC) + end if + if (allocated(SrcModuleMapTypeData%u_SStC_Mot2_SStC)) then + LB(1:1) = lbound(SrcModuleMapTypeData%u_SStC_Mot2_SStC) + UB(1:1) = ubound(SrcModuleMapTypeData%u_SStC_Mot2_SStC) + if (.not. allocated(DstModuleMapTypeData%u_SStC_Mot2_SStC)) then + allocate(DstModuleMapTypeData%u_SStC_Mot2_SStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_SStC_Mot2_SStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%u_SStC_Mot2_SStC(i1), DstModuleMapTypeData%u_SStC_Mot2_SStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstModuleMapTypeData%u_SStC_Mot2_SStC)) then + deallocate(DstModuleMapTypeData%u_SStC_Mot2_SStC) + end if + if (allocated(SrcModuleMapTypeData%BStC_Frc2_y_BStC)) then + LB(1:2) = lbound(SrcModuleMapTypeData%BStC_Frc2_y_BStC) + UB(1:2) = ubound(SrcModuleMapTypeData%BStC_Frc2_y_BStC) + if (.not. allocated(DstModuleMapTypeData%BStC_Frc2_y_BStC)) then + allocate(DstModuleMapTypeData%BStC_Frc2_y_BStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BStC_Frc2_y_BStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%BStC_Frc2_y_BStC(i1,i2), DstModuleMapTypeData%BStC_Frc2_y_BStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + else if (allocated(DstModuleMapTypeData%BStC_Frc2_y_BStC)) then + deallocate(DstModuleMapTypeData%BStC_Frc2_y_BStC) + end if + if (allocated(SrcModuleMapTypeData%NStC_Frc2_y_NStC)) then + LB(1:1) = lbound(SrcModuleMapTypeData%NStC_Frc2_y_NStC) + UB(1:1) = ubound(SrcModuleMapTypeData%NStC_Frc2_y_NStC) + if (.not. allocated(DstModuleMapTypeData%NStC_Frc2_y_NStC)) then + allocate(DstModuleMapTypeData%NStC_Frc2_y_NStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%NStC_Frc2_y_NStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%NStC_Frc2_y_NStC(i1), DstModuleMapTypeData%NStC_Frc2_y_NStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstModuleMapTypeData%NStC_Frc2_y_NStC)) then + deallocate(DstModuleMapTypeData%NStC_Frc2_y_NStC) + end if + if (allocated(SrcModuleMapTypeData%TStC_Frc2_y_TStC)) then + LB(1:1) = lbound(SrcModuleMapTypeData%TStC_Frc2_y_TStC) + UB(1:1) = ubound(SrcModuleMapTypeData%TStC_Frc2_y_TStC) + if (.not. allocated(DstModuleMapTypeData%TStC_Frc2_y_TStC)) then + allocate(DstModuleMapTypeData%TStC_Frc2_y_TStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%TStC_Frc2_y_TStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%TStC_Frc2_y_TStC(i1), DstModuleMapTypeData%TStC_Frc2_y_TStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstModuleMapTypeData%TStC_Frc2_y_TStC)) then + deallocate(DstModuleMapTypeData%TStC_Frc2_y_TStC) + end if + if (allocated(SrcModuleMapTypeData%SStC_Frc2_y_SStC)) then + LB(1:1) = lbound(SrcModuleMapTypeData%SStC_Frc2_y_SStC) + UB(1:1) = ubound(SrcModuleMapTypeData%SStC_Frc2_y_SStC) + if (.not. allocated(DstModuleMapTypeData%SStC_Frc2_y_SStC)) then + allocate(DstModuleMapTypeData%SStC_Frc2_y_SStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%SStC_Frc2_y_SStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%SStC_Frc2_y_SStC(i1), DstModuleMapTypeData%SStC_Frc2_y_SStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstModuleMapTypeData%SStC_Frc2_y_SStC)) then + deallocate(DstModuleMapTypeData%SStC_Frc2_y_SStC) + end if +end subroutine + +subroutine SrvD_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) + type(SrvD_ModuleMapType), intent(inout) :: ModuleMapTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_DestroyModuleMapType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ModuleMapTypeData%u_BStC_Mot2_BStC)) then + LB(1:2) = lbound(ModuleMapTypeData%u_BStC_Mot2_BStC) + UB(1:2) = ubound(ModuleMapTypeData%u_BStC_Mot2_BStC) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%u_BStC_Mot2_BStC(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(ModuleMapTypeData%u_BStC_Mot2_BStC) + end if + if (allocated(ModuleMapTypeData%u_NStC_Mot2_NStC)) then + LB(1:1) = lbound(ModuleMapTypeData%u_NStC_Mot2_NStC) + UB(1:1) = ubound(ModuleMapTypeData%u_NStC_Mot2_NStC) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%u_NStC_Mot2_NStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%u_NStC_Mot2_NStC) + end if + if (allocated(ModuleMapTypeData%u_TStC_Mot2_TStC)) then + LB(1:1) = lbound(ModuleMapTypeData%u_TStC_Mot2_TStC) + UB(1:1) = ubound(ModuleMapTypeData%u_TStC_Mot2_TStC) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%u_TStC_Mot2_TStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%u_TStC_Mot2_TStC) + end if + if (allocated(ModuleMapTypeData%u_SStC_Mot2_SStC)) then + LB(1:1) = lbound(ModuleMapTypeData%u_SStC_Mot2_SStC) + UB(1:1) = ubound(ModuleMapTypeData%u_SStC_Mot2_SStC) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%u_SStC_Mot2_SStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%u_SStC_Mot2_SStC) + end if + if (allocated(ModuleMapTypeData%BStC_Frc2_y_BStC)) then + LB(1:2) = lbound(ModuleMapTypeData%BStC_Frc2_y_BStC) + UB(1:2) = ubound(ModuleMapTypeData%BStC_Frc2_y_BStC) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%BStC_Frc2_y_BStC(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(ModuleMapTypeData%BStC_Frc2_y_BStC) + end if + if (allocated(ModuleMapTypeData%NStC_Frc2_y_NStC)) then + LB(1:1) = lbound(ModuleMapTypeData%NStC_Frc2_y_NStC) + UB(1:1) = ubound(ModuleMapTypeData%NStC_Frc2_y_NStC) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%NStC_Frc2_y_NStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%NStC_Frc2_y_NStC) + end if + if (allocated(ModuleMapTypeData%TStC_Frc2_y_TStC)) then + LB(1:1) = lbound(ModuleMapTypeData%TStC_Frc2_y_TStC) + UB(1:1) = ubound(ModuleMapTypeData%TStC_Frc2_y_TStC) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%TStC_Frc2_y_TStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%TStC_Frc2_y_TStC) + end if + if (allocated(ModuleMapTypeData%SStC_Frc2_y_SStC)) then + LB(1:1) = lbound(ModuleMapTypeData%SStC_Frc2_y_SStC) + UB(1:1) = ubound(ModuleMapTypeData%SStC_Frc2_y_SStC) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SStC_Frc2_y_SStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ModuleMapTypeData%SStC_Frc2_y_SStC) + end if +end subroutine + +subroutine SrvD_PackModuleMapType(Buf, Indata) + type(PackBuffer), intent(inout) :: Buf + type(SrvD_ModuleMapType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SrvD_PackModuleMapType' + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%u_BStC_Mot2_BStC)) + if (allocated(InData%u_BStC_Mot2_BStC)) then + call RegPackBounds(Buf, 2, lbound(InData%u_BStC_Mot2_BStC), ubound(InData%u_BStC_Mot2_BStC)) + LB(1:2) = lbound(InData%u_BStC_Mot2_BStC) + UB(1:2) = ubound(InData%u_BStC_Mot2_BStC) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(Buf, InData%u_BStC_Mot2_BStC(i1,i2)) @@ -5687,7 +5266,6 @@ subroutine SrvD_PackModuleMapType(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! u_NStC_Mot2_NStC call RegPack(Buf, allocated(InData%u_NStC_Mot2_NStC)) if (allocated(InData%u_NStC_Mot2_NStC)) then call RegPackBounds(Buf, 1, lbound(InData%u_NStC_Mot2_NStC), ubound(InData%u_NStC_Mot2_NStC)) @@ -5698,7 +5276,6 @@ subroutine SrvD_PackModuleMapType(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! u_TStC_Mot2_TStC call RegPack(Buf, allocated(InData%u_TStC_Mot2_TStC)) if (allocated(InData%u_TStC_Mot2_TStC)) then call RegPackBounds(Buf, 1, lbound(InData%u_TStC_Mot2_TStC), ubound(InData%u_TStC_Mot2_TStC)) @@ -5709,7 +5286,6 @@ subroutine SrvD_PackModuleMapType(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! u_SStC_Mot2_SStC call RegPack(Buf, allocated(InData%u_SStC_Mot2_SStC)) if (allocated(InData%u_SStC_Mot2_SStC)) then call RegPackBounds(Buf, 1, lbound(InData%u_SStC_Mot2_SStC), ubound(InData%u_SStC_Mot2_SStC)) @@ -5720,7 +5296,6 @@ subroutine SrvD_PackModuleMapType(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! BStC_Frc2_y_BStC call RegPack(Buf, allocated(InData%BStC_Frc2_y_BStC)) if (allocated(InData%BStC_Frc2_y_BStC)) then call RegPackBounds(Buf, 2, lbound(InData%BStC_Frc2_y_BStC), ubound(InData%BStC_Frc2_y_BStC)) @@ -5733,7 +5308,6 @@ subroutine SrvD_PackModuleMapType(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! NStC_Frc2_y_NStC call RegPack(Buf, allocated(InData%NStC_Frc2_y_NStC)) if (allocated(InData%NStC_Frc2_y_NStC)) then call RegPackBounds(Buf, 1, lbound(InData%NStC_Frc2_y_NStC), ubound(InData%NStC_Frc2_y_NStC)) @@ -5744,7 +5318,6 @@ subroutine SrvD_PackModuleMapType(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! TStC_Frc2_y_TStC call RegPack(Buf, allocated(InData%TStC_Frc2_y_TStC)) if (allocated(InData%TStC_Frc2_y_TStC)) then call RegPackBounds(Buf, 1, lbound(InData%TStC_Frc2_y_TStC), ubound(InData%TStC_Frc2_y_TStC)) @@ -5755,7 +5328,6 @@ subroutine SrvD_PackModuleMapType(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! SStC_Frc2_y_SStC call RegPack(Buf, allocated(InData%SStC_Frc2_y_SStC)) if (allocated(InData%SStC_Frc2_y_SStC)) then call RegPackBounds(Buf, 1, lbound(InData%SStC_Frc2_y_SStC), ubound(InData%SStC_Frc2_y_SStC)) @@ -5777,7 +5349,6 @@ subroutine SrvD_UnPackModuleMapType(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! u_BStC_Mot2_BStC if (allocated(OutData%u_BStC_Mot2_BStC)) deallocate(OutData%u_BStC_Mot2_BStC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5795,7 +5366,6 @@ subroutine SrvD_UnPackModuleMapType(Buf, OutData) end do end do end if - ! u_NStC_Mot2_NStC if (allocated(OutData%u_NStC_Mot2_NStC)) deallocate(OutData%u_NStC_Mot2_NStC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5811,7 +5381,6 @@ subroutine SrvD_UnPackModuleMapType(Buf, OutData) call NWTC_Library_UnpackMeshMapType(Buf, OutData%u_NStC_Mot2_NStC(i1)) ! u_NStC_Mot2_NStC end do end if - ! u_TStC_Mot2_TStC if (allocated(OutData%u_TStC_Mot2_TStC)) deallocate(OutData%u_TStC_Mot2_TStC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5827,7 +5396,6 @@ subroutine SrvD_UnPackModuleMapType(Buf, OutData) call NWTC_Library_UnpackMeshMapType(Buf, OutData%u_TStC_Mot2_TStC(i1)) ! u_TStC_Mot2_TStC end do end if - ! u_SStC_Mot2_SStC if (allocated(OutData%u_SStC_Mot2_SStC)) deallocate(OutData%u_SStC_Mot2_SStC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5843,7 +5411,6 @@ subroutine SrvD_UnPackModuleMapType(Buf, OutData) call NWTC_Library_UnpackMeshMapType(Buf, OutData%u_SStC_Mot2_SStC(i1)) ! u_SStC_Mot2_SStC end do end if - ! BStC_Frc2_y_BStC if (allocated(OutData%BStC_Frc2_y_BStC)) deallocate(OutData%BStC_Frc2_y_BStC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5861,7 +5428,6 @@ subroutine SrvD_UnPackModuleMapType(Buf, OutData) end do end do end if - ! NStC_Frc2_y_NStC if (allocated(OutData%NStC_Frc2_y_NStC)) deallocate(OutData%NStC_Frc2_y_NStC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5877,7 +5443,6 @@ subroutine SrvD_UnPackModuleMapType(Buf, OutData) call NWTC_Library_UnpackMeshMapType(Buf, OutData%NStC_Frc2_y_NStC(i1)) ! NStC_Frc2_y_NStC end do end if - ! TStC_Frc2_y_TStC if (allocated(OutData%TStC_Frc2_y_TStC)) deallocate(OutData%TStC_Frc2_y_TStC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5893,7 +5458,6 @@ subroutine SrvD_UnPackModuleMapType(Buf, OutData) call NWTC_Library_UnpackMeshMapType(Buf, OutData%TStC_Frc2_y_TStC(i1)) ! TStC_Frc2_y_TStC end do end if - ! SStC_Frc2_y_SStC if (allocated(OutData%SStC_Frc2_y_SStC)) deallocate(OutData%SStC_Frc2_y_SStC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -5910,368 +5474,401 @@ subroutine SrvD_UnPackModuleMapType(Buf, OutData) end do end if end subroutine - SUBROUTINE SrvD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SrvD_MiscVarType), INTENT(INOUT) :: SrcMiscData - TYPE(SrvD_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%LastTimeCalled = SrcMiscData%LastTimeCalled - CALL SrvD_Copybladeddlltype( SrcMiscData%dll_data, DstMiscData%dll_data, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstMiscData%FirstWarn = SrcMiscData%FirstWarn - DstMiscData%LastTimeFiltered = SrcMiscData%LastTimeFiltered -IF (ALLOCATED(SrcMiscData%xd_BlPitchFilter)) THEN - i1_l = LBOUND(SrcMiscData%xd_BlPitchFilter,1) - i1_u = UBOUND(SrcMiscData%xd_BlPitchFilter,1) - IF (.NOT. ALLOCATED(DstMiscData%xd_BlPitchFilter)) THEN - ALLOCATE(DstMiscData%xd_BlPitchFilter(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%xd_BlPitchFilter.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%xd_BlPitchFilter = SrcMiscData%xd_BlPitchFilter -ENDIF -IF (ALLOCATED(SrcMiscData%BStC)) THEN - i1_l = LBOUND(SrcMiscData%BStC,1) - i1_u = UBOUND(SrcMiscData%BStC,1) - IF (.NOT. ALLOCATED(DstMiscData%BStC)) THEN - ALLOCATE(DstMiscData%BStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%BStC,1), UBOUND(SrcMiscData%BStC,1) - CALL StC_CopyMisc( SrcMiscData%BStC(i1), DstMiscData%BStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%NStC)) THEN - i1_l = LBOUND(SrcMiscData%NStC,1) - i1_u = UBOUND(SrcMiscData%NStC,1) - IF (.NOT. ALLOCATED(DstMiscData%NStC)) THEN - ALLOCATE(DstMiscData%NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%NStC,1), UBOUND(SrcMiscData%NStC,1) - CALL StC_CopyMisc( SrcMiscData%NStC(i1), DstMiscData%NStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%TStC)) THEN - i1_l = LBOUND(SrcMiscData%TStC,1) - i1_u = UBOUND(SrcMiscData%TStC,1) - IF (.NOT. ALLOCATED(DstMiscData%TStC)) THEN - ALLOCATE(DstMiscData%TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%TStC,1), UBOUND(SrcMiscData%TStC,1) - CALL StC_CopyMisc( SrcMiscData%TStC(i1), DstMiscData%TStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%SStC)) THEN - i1_l = LBOUND(SrcMiscData%SStC,1) - i1_u = UBOUND(SrcMiscData%SStC,1) - IF (.NOT. ALLOCATED(DstMiscData%SStC)) THEN - ALLOCATE(DstMiscData%SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%SStC,1), UBOUND(SrcMiscData%SStC,1) - CALL StC_CopyMisc( SrcMiscData%SStC(i1), DstMiscData%SStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%u_BStC)) THEN - i1_l = LBOUND(SrcMiscData%u_BStC,1) - i1_u = UBOUND(SrcMiscData%u_BStC,1) - i2_l = LBOUND(SrcMiscData%u_BStC,2) - i2_u = UBOUND(SrcMiscData%u_BStC,2) - IF (.NOT. ALLOCATED(DstMiscData%u_BStC)) THEN - ALLOCATE(DstMiscData%u_BStC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcMiscData%u_BStC,2), UBOUND(SrcMiscData%u_BStC,2) - DO i1 = LBOUND(SrcMiscData%u_BStC,1), UBOUND(SrcMiscData%u_BStC,1) - CALL StC_CopyInput( SrcMiscData%u_BStC(i1,i2), DstMiscData%u_BStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%u_NStC)) THEN - i1_l = LBOUND(SrcMiscData%u_NStC,1) - i1_u = UBOUND(SrcMiscData%u_NStC,1) - i2_l = LBOUND(SrcMiscData%u_NStC,2) - i2_u = UBOUND(SrcMiscData%u_NStC,2) - IF (.NOT. ALLOCATED(DstMiscData%u_NStC)) THEN - ALLOCATE(DstMiscData%u_NStC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcMiscData%u_NStC,2), UBOUND(SrcMiscData%u_NStC,2) - DO i1 = LBOUND(SrcMiscData%u_NStC,1), UBOUND(SrcMiscData%u_NStC,1) - CALL StC_CopyInput( SrcMiscData%u_NStC(i1,i2), DstMiscData%u_NStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%u_TStC)) THEN - i1_l = LBOUND(SrcMiscData%u_TStC,1) - i1_u = UBOUND(SrcMiscData%u_TStC,1) - i2_l = LBOUND(SrcMiscData%u_TStC,2) - i2_u = UBOUND(SrcMiscData%u_TStC,2) - IF (.NOT. ALLOCATED(DstMiscData%u_TStC)) THEN - ALLOCATE(DstMiscData%u_TStC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcMiscData%u_TStC,2), UBOUND(SrcMiscData%u_TStC,2) - DO i1 = LBOUND(SrcMiscData%u_TStC,1), UBOUND(SrcMiscData%u_TStC,1) - CALL StC_CopyInput( SrcMiscData%u_TStC(i1,i2), DstMiscData%u_TStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%u_SStC)) THEN - i1_l = LBOUND(SrcMiscData%u_SStC,1) - i1_u = UBOUND(SrcMiscData%u_SStC,1) - i2_l = LBOUND(SrcMiscData%u_SStC,2) - i2_u = UBOUND(SrcMiscData%u_SStC,2) - IF (.NOT. ALLOCATED(DstMiscData%u_SStC)) THEN - ALLOCATE(DstMiscData%u_SStC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcMiscData%u_SStC,2), UBOUND(SrcMiscData%u_SStC,2) - DO i1 = LBOUND(SrcMiscData%u_SStC,1), UBOUND(SrcMiscData%u_SStC,1) - CALL StC_CopyInput( SrcMiscData%u_SStC(i1,i2), DstMiscData%u_SStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%y_BStC)) THEN - i1_l = LBOUND(SrcMiscData%y_BStC,1) - i1_u = UBOUND(SrcMiscData%y_BStC,1) - IF (.NOT. ALLOCATED(DstMiscData%y_BStC)) THEN - ALLOCATE(DstMiscData%y_BStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%y_BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%y_BStC,1), UBOUND(SrcMiscData%y_BStC,1) - CALL StC_CopyOutput( SrcMiscData%y_BStC(i1), DstMiscData%y_BStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%y_NStC)) THEN - i1_l = LBOUND(SrcMiscData%y_NStC,1) - i1_u = UBOUND(SrcMiscData%y_NStC,1) - IF (.NOT. ALLOCATED(DstMiscData%y_NStC)) THEN - ALLOCATE(DstMiscData%y_NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%y_NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%y_NStC,1), UBOUND(SrcMiscData%y_NStC,1) - CALL StC_CopyOutput( SrcMiscData%y_NStC(i1), DstMiscData%y_NStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%y_TStC)) THEN - i1_l = LBOUND(SrcMiscData%y_TStC,1) - i1_u = UBOUND(SrcMiscData%y_TStC,1) - IF (.NOT. ALLOCATED(DstMiscData%y_TStC)) THEN - ALLOCATE(DstMiscData%y_TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%y_TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%y_TStC,1), UBOUND(SrcMiscData%y_TStC,1) - CALL StC_CopyOutput( SrcMiscData%y_TStC(i1), DstMiscData%y_TStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%y_SStC)) THEN - i1_l = LBOUND(SrcMiscData%y_SStC,1) - i1_u = UBOUND(SrcMiscData%y_SStC,1) - IF (.NOT. ALLOCATED(DstMiscData%y_SStC)) THEN - ALLOCATE(DstMiscData%y_SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%y_SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%y_SStC,1), UBOUND(SrcMiscData%y_SStC,1) - CALL StC_CopyOutput( SrcMiscData%y_SStC(i1), DstMiscData%y_SStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL SrvD_Copymodulemaptype( SrcMiscData%SrvD_MeshMap, DstMiscData%SrvD_MeshMap, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstMiscData%PrevTstepNcall = SrcMiscData%PrevTstepNcall - END SUBROUTINE SrvD_CopyMisc - - SUBROUTINE SrvD_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(SrvD_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyMisc' - ErrStat = ErrID_None - ErrMsg = "" - - CALL SrvD_DestroyBladedDLLType( MiscData%dll_data, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(MiscData%xd_BlPitchFilter)) THEN - DEALLOCATE(MiscData%xd_BlPitchFilter) -ENDIF -IF (ALLOCATED(MiscData%BStC)) THEN -DO i1 = LBOUND(MiscData%BStC,1), UBOUND(MiscData%BStC,1) - CALL StC_DestroyMisc( MiscData%BStC(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%BStC) -ENDIF -IF (ALLOCATED(MiscData%NStC)) THEN -DO i1 = LBOUND(MiscData%NStC,1), UBOUND(MiscData%NStC,1) - CALL StC_DestroyMisc( MiscData%NStC(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%NStC) -ENDIF -IF (ALLOCATED(MiscData%TStC)) THEN -DO i1 = LBOUND(MiscData%TStC,1), UBOUND(MiscData%TStC,1) - CALL StC_DestroyMisc( MiscData%TStC(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%TStC) -ENDIF -IF (ALLOCATED(MiscData%SStC)) THEN -DO i1 = LBOUND(MiscData%SStC,1), UBOUND(MiscData%SStC,1) - CALL StC_DestroyMisc( MiscData%SStC(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%SStC) -ENDIF -IF (ALLOCATED(MiscData%u_BStC)) THEN -DO i2 = LBOUND(MiscData%u_BStC,2), UBOUND(MiscData%u_BStC,2) -DO i1 = LBOUND(MiscData%u_BStC,1), UBOUND(MiscData%u_BStC,1) - CALL StC_DestroyInput( MiscData%u_BStC(i1,i2), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(MiscData%u_BStC) -ENDIF -IF (ALLOCATED(MiscData%u_NStC)) THEN -DO i2 = LBOUND(MiscData%u_NStC,2), UBOUND(MiscData%u_NStC,2) -DO i1 = LBOUND(MiscData%u_NStC,1), UBOUND(MiscData%u_NStC,1) - CALL StC_DestroyInput( MiscData%u_NStC(i1,i2), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(MiscData%u_NStC) -ENDIF -IF (ALLOCATED(MiscData%u_TStC)) THEN -DO i2 = LBOUND(MiscData%u_TStC,2), UBOUND(MiscData%u_TStC,2) -DO i1 = LBOUND(MiscData%u_TStC,1), UBOUND(MiscData%u_TStC,1) - CALL StC_DestroyInput( MiscData%u_TStC(i1,i2), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(MiscData%u_TStC) -ENDIF -IF (ALLOCATED(MiscData%u_SStC)) THEN -DO i2 = LBOUND(MiscData%u_SStC,2), UBOUND(MiscData%u_SStC,2) -DO i1 = LBOUND(MiscData%u_SStC,1), UBOUND(MiscData%u_SStC,1) - CALL StC_DestroyInput( MiscData%u_SStC(i1,i2), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(MiscData%u_SStC) -ENDIF -IF (ALLOCATED(MiscData%y_BStC)) THEN -DO i1 = LBOUND(MiscData%y_BStC,1), UBOUND(MiscData%y_BStC,1) - CALL StC_DestroyOutput( MiscData%y_BStC(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%y_BStC) -ENDIF -IF (ALLOCATED(MiscData%y_NStC)) THEN -DO i1 = LBOUND(MiscData%y_NStC,1), UBOUND(MiscData%y_NStC,1) - CALL StC_DestroyOutput( MiscData%y_NStC(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%y_NStC) -ENDIF -IF (ALLOCATED(MiscData%y_TStC)) THEN -DO i1 = LBOUND(MiscData%y_TStC,1), UBOUND(MiscData%y_TStC,1) - CALL StC_DestroyOutput( MiscData%y_TStC(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%y_TStC) -ENDIF -IF (ALLOCATED(MiscData%y_SStC)) THEN -DO i1 = LBOUND(MiscData%y_SStC,1), UBOUND(MiscData%y_SStC,1) - CALL StC_DestroyOutput( MiscData%y_SStC(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%y_SStC) -ENDIF - CALL SrvD_DestroyModuleMapType( MiscData%SrvD_MeshMap, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE SrvD_DestroyMisc +subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(SrvD_MiscVarType), intent(inout) :: SrcMiscData + type(SrvD_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%LastTimeCalled = SrcMiscData%LastTimeCalled + call SrvD_CopyBladedDLLType(SrcMiscData%dll_data, DstMiscData%dll_data, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstMiscData%FirstWarn = SrcMiscData%FirstWarn + DstMiscData%LastTimeFiltered = SrcMiscData%LastTimeFiltered + if (allocated(SrcMiscData%xd_BlPitchFilter)) then + LB(1:1) = lbound(SrcMiscData%xd_BlPitchFilter) + UB(1:1) = ubound(SrcMiscData%xd_BlPitchFilter) + if (.not. allocated(DstMiscData%xd_BlPitchFilter)) then + allocate(DstMiscData%xd_BlPitchFilter(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%xd_BlPitchFilter.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%xd_BlPitchFilter = SrcMiscData%xd_BlPitchFilter + else if (allocated(DstMiscData%xd_BlPitchFilter)) then + deallocate(DstMiscData%xd_BlPitchFilter) + end if + if (allocated(SrcMiscData%BStC)) then + LB(1:1) = lbound(SrcMiscData%BStC) + UB(1:1) = ubound(SrcMiscData%BStC) + if (.not. allocated(DstMiscData%BStC)) then + allocate(DstMiscData%BStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyMisc(SrcMiscData%BStC(i1), DstMiscData%BStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstMiscData%BStC)) then + deallocate(DstMiscData%BStC) + end if + if (allocated(SrcMiscData%NStC)) then + LB(1:1) = lbound(SrcMiscData%NStC) + UB(1:1) = ubound(SrcMiscData%NStC) + if (.not. allocated(DstMiscData%NStC)) then + allocate(DstMiscData%NStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%NStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyMisc(SrcMiscData%NStC(i1), DstMiscData%NStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstMiscData%NStC)) then + deallocate(DstMiscData%NStC) + end if + if (allocated(SrcMiscData%TStC)) then + LB(1:1) = lbound(SrcMiscData%TStC) + UB(1:1) = ubound(SrcMiscData%TStC) + if (.not. allocated(DstMiscData%TStC)) then + allocate(DstMiscData%TStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyMisc(SrcMiscData%TStC(i1), DstMiscData%TStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstMiscData%TStC)) then + deallocate(DstMiscData%TStC) + end if + if (allocated(SrcMiscData%SStC)) then + LB(1:1) = lbound(SrcMiscData%SStC) + UB(1:1) = ubound(SrcMiscData%SStC) + if (.not. allocated(DstMiscData%SStC)) then + allocate(DstMiscData%SStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyMisc(SrcMiscData%SStC(i1), DstMiscData%SStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstMiscData%SStC)) then + deallocate(DstMiscData%SStC) + end if + if (allocated(SrcMiscData%u_BStC)) then + LB(1:2) = lbound(SrcMiscData%u_BStC) + UB(1:2) = ubound(SrcMiscData%u_BStC) + if (.not. allocated(DstMiscData%u_BStC)) then + allocate(DstMiscData%u_BStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_BStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_CopyInput(SrcMiscData%u_BStC(i1,i2), DstMiscData%u_BStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + else if (allocated(DstMiscData%u_BStC)) then + deallocate(DstMiscData%u_BStC) + end if + if (allocated(SrcMiscData%u_NStC)) then + LB(1:2) = lbound(SrcMiscData%u_NStC) + UB(1:2) = ubound(SrcMiscData%u_NStC) + if (.not. allocated(DstMiscData%u_NStC)) then + allocate(DstMiscData%u_NStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_NStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_CopyInput(SrcMiscData%u_NStC(i1,i2), DstMiscData%u_NStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + else if (allocated(DstMiscData%u_NStC)) then + deallocate(DstMiscData%u_NStC) + end if + if (allocated(SrcMiscData%u_TStC)) then + LB(1:2) = lbound(SrcMiscData%u_TStC) + UB(1:2) = ubound(SrcMiscData%u_TStC) + if (.not. allocated(DstMiscData%u_TStC)) then + allocate(DstMiscData%u_TStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_TStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_CopyInput(SrcMiscData%u_TStC(i1,i2), DstMiscData%u_TStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + else if (allocated(DstMiscData%u_TStC)) then + deallocate(DstMiscData%u_TStC) + end if + if (allocated(SrcMiscData%u_SStC)) then + LB(1:2) = lbound(SrcMiscData%u_SStC) + UB(1:2) = ubound(SrcMiscData%u_SStC) + if (.not. allocated(DstMiscData%u_SStC)) then + allocate(DstMiscData%u_SStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_SStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_CopyInput(SrcMiscData%u_SStC(i1,i2), DstMiscData%u_SStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + else if (allocated(DstMiscData%u_SStC)) then + deallocate(DstMiscData%u_SStC) + end if + if (allocated(SrcMiscData%y_BStC)) then + LB(1:1) = lbound(SrcMiscData%y_BStC) + UB(1:1) = ubound(SrcMiscData%y_BStC) + if (.not. allocated(DstMiscData%y_BStC)) then + allocate(DstMiscData%y_BStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%y_BStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyOutput(SrcMiscData%y_BStC(i1), DstMiscData%y_BStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstMiscData%y_BStC)) then + deallocate(DstMiscData%y_BStC) + end if + if (allocated(SrcMiscData%y_NStC)) then + LB(1:1) = lbound(SrcMiscData%y_NStC) + UB(1:1) = ubound(SrcMiscData%y_NStC) + if (.not. allocated(DstMiscData%y_NStC)) then + allocate(DstMiscData%y_NStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%y_NStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyOutput(SrcMiscData%y_NStC(i1), DstMiscData%y_NStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstMiscData%y_NStC)) then + deallocate(DstMiscData%y_NStC) + end if + if (allocated(SrcMiscData%y_TStC)) then + LB(1:1) = lbound(SrcMiscData%y_TStC) + UB(1:1) = ubound(SrcMiscData%y_TStC) + if (.not. allocated(DstMiscData%y_TStC)) then + allocate(DstMiscData%y_TStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%y_TStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyOutput(SrcMiscData%y_TStC(i1), DstMiscData%y_TStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstMiscData%y_TStC)) then + deallocate(DstMiscData%y_TStC) + end if + if (allocated(SrcMiscData%y_SStC)) then + LB(1:1) = lbound(SrcMiscData%y_SStC) + UB(1:1) = ubound(SrcMiscData%y_SStC) + if (.not. allocated(DstMiscData%y_SStC)) then + allocate(DstMiscData%y_SStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%y_SStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyOutput(SrcMiscData%y_SStC(i1), DstMiscData%y_SStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstMiscData%y_SStC)) then + deallocate(DstMiscData%y_SStC) + end if + call SrvD_CopyModuleMapType(SrcMiscData%SrvD_MeshMap, DstMiscData%SrvD_MeshMap, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstMiscData%PrevTstepNcall = SrcMiscData%PrevTstepNcall +end subroutine +subroutine SrvD_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(SrvD_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%xd_BlPitchFilter)) then + deallocate(MiscData%xd_BlPitchFilter) + end if + if (allocated(MiscData%BStC)) then + LB(1:1) = lbound(MiscData%BStC) + UB(1:1) = ubound(MiscData%BStC) + do i1 = LB(1), UB(1) + call StC_DestroyMisc(MiscData%BStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%BStC) + end if + if (allocated(MiscData%NStC)) then + LB(1:1) = lbound(MiscData%NStC) + UB(1:1) = ubound(MiscData%NStC) + do i1 = LB(1), UB(1) + call StC_DestroyMisc(MiscData%NStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%NStC) + end if + if (allocated(MiscData%TStC)) then + LB(1:1) = lbound(MiscData%TStC) + UB(1:1) = ubound(MiscData%TStC) + do i1 = LB(1), UB(1) + call StC_DestroyMisc(MiscData%TStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%TStC) + end if + if (allocated(MiscData%SStC)) then + LB(1:1) = lbound(MiscData%SStC) + UB(1:1) = ubound(MiscData%SStC) + do i1 = LB(1), UB(1) + call StC_DestroyMisc(MiscData%SStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%SStC) + end if + if (allocated(MiscData%u_BStC)) then + LB(1:2) = lbound(MiscData%u_BStC) + UB(1:2) = ubound(MiscData%u_BStC) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_DestroyInput(MiscData%u_BStC(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(MiscData%u_BStC) + end if + if (allocated(MiscData%u_NStC)) then + LB(1:2) = lbound(MiscData%u_NStC) + UB(1:2) = ubound(MiscData%u_NStC) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_DestroyInput(MiscData%u_NStC(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(MiscData%u_NStC) + end if + if (allocated(MiscData%u_TStC)) then + LB(1:2) = lbound(MiscData%u_TStC) + UB(1:2) = ubound(MiscData%u_TStC) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_DestroyInput(MiscData%u_TStC(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(MiscData%u_TStC) + end if + if (allocated(MiscData%u_SStC)) then + LB(1:2) = lbound(MiscData%u_SStC) + UB(1:2) = ubound(MiscData%u_SStC) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_DestroyInput(MiscData%u_SStC(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(MiscData%u_SStC) + end if + if (allocated(MiscData%y_BStC)) then + LB(1:1) = lbound(MiscData%y_BStC) + UB(1:1) = ubound(MiscData%y_BStC) + do i1 = LB(1), UB(1) + call StC_DestroyOutput(MiscData%y_BStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%y_BStC) + end if + if (allocated(MiscData%y_NStC)) then + LB(1:1) = lbound(MiscData%y_NStC) + UB(1:1) = ubound(MiscData%y_NStC) + do i1 = LB(1), UB(1) + call StC_DestroyOutput(MiscData%y_NStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%y_NStC) + end if + if (allocated(MiscData%y_TStC)) then + LB(1:1) = lbound(MiscData%y_TStC) + UB(1:1) = ubound(MiscData%y_TStC) + do i1 = LB(1), UB(1) + call StC_DestroyOutput(MiscData%y_TStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%y_TStC) + end if + if (allocated(MiscData%y_SStC)) then + LB(1:1) = lbound(MiscData%y_SStC) + UB(1:1) = ubound(MiscData%y_SStC) + do i1 = LB(1), UB(1) + call StC_DestroyOutput(MiscData%y_SStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%y_SStC) + end if +end subroutine subroutine SrvD_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -6280,26 +5877,20 @@ subroutine SrvD_PackMisc(Buf, Indata) integer(IntKi) :: i1, i2 integer(IntKi) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return - ! LastTimeCalled call RegPack(Buf, InData%LastTimeCalled) if (RegCheckErr(Buf, RoutineName)) return - ! dll_data call SrvD_PackBladedDLLType(Buf, InData%dll_data) if (RegCheckErr(Buf, RoutineName)) return - ! FirstWarn call RegPack(Buf, InData%FirstWarn) if (RegCheckErr(Buf, RoutineName)) return - ! LastTimeFiltered call RegPack(Buf, InData%LastTimeFiltered) if (RegCheckErr(Buf, RoutineName)) return - ! xd_BlPitchFilter call RegPack(Buf, allocated(InData%xd_BlPitchFilter)) if (allocated(InData%xd_BlPitchFilter)) then call RegPackBounds(Buf, 1, lbound(InData%xd_BlPitchFilter), ubound(InData%xd_BlPitchFilter)) call RegPack(Buf, InData%xd_BlPitchFilter) end if if (RegCheckErr(Buf, RoutineName)) return - ! BStC call RegPack(Buf, allocated(InData%BStC)) if (allocated(InData%BStC)) then call RegPackBounds(Buf, 1, lbound(InData%BStC), ubound(InData%BStC)) @@ -6310,7 +5901,6 @@ subroutine SrvD_PackMisc(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! NStC call RegPack(Buf, allocated(InData%NStC)) if (allocated(InData%NStC)) then call RegPackBounds(Buf, 1, lbound(InData%NStC), ubound(InData%NStC)) @@ -6321,7 +5911,6 @@ subroutine SrvD_PackMisc(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! TStC call RegPack(Buf, allocated(InData%TStC)) if (allocated(InData%TStC)) then call RegPackBounds(Buf, 1, lbound(InData%TStC), ubound(InData%TStC)) @@ -6332,7 +5921,6 @@ subroutine SrvD_PackMisc(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! SStC call RegPack(Buf, allocated(InData%SStC)) if (allocated(InData%SStC)) then call RegPackBounds(Buf, 1, lbound(InData%SStC), ubound(InData%SStC)) @@ -6343,7 +5931,6 @@ subroutine SrvD_PackMisc(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! u_BStC call RegPack(Buf, allocated(InData%u_BStC)) if (allocated(InData%u_BStC)) then call RegPackBounds(Buf, 2, lbound(InData%u_BStC), ubound(InData%u_BStC)) @@ -6356,7 +5943,6 @@ subroutine SrvD_PackMisc(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! u_NStC call RegPack(Buf, allocated(InData%u_NStC)) if (allocated(InData%u_NStC)) then call RegPackBounds(Buf, 2, lbound(InData%u_NStC), ubound(InData%u_NStC)) @@ -6369,7 +5955,6 @@ subroutine SrvD_PackMisc(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! u_TStC call RegPack(Buf, allocated(InData%u_TStC)) if (allocated(InData%u_TStC)) then call RegPackBounds(Buf, 2, lbound(InData%u_TStC), ubound(InData%u_TStC)) @@ -6382,7 +5967,6 @@ subroutine SrvD_PackMisc(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! u_SStC call RegPack(Buf, allocated(InData%u_SStC)) if (allocated(InData%u_SStC)) then call RegPackBounds(Buf, 2, lbound(InData%u_SStC), ubound(InData%u_SStC)) @@ -6395,7 +5979,6 @@ subroutine SrvD_PackMisc(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! y_BStC call RegPack(Buf, allocated(InData%y_BStC)) if (allocated(InData%y_BStC)) then call RegPackBounds(Buf, 1, lbound(InData%y_BStC), ubound(InData%y_BStC)) @@ -6406,7 +5989,6 @@ subroutine SrvD_PackMisc(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! y_NStC call RegPack(Buf, allocated(InData%y_NStC)) if (allocated(InData%y_NStC)) then call RegPackBounds(Buf, 1, lbound(InData%y_NStC), ubound(InData%y_NStC)) @@ -6417,7 +5999,6 @@ subroutine SrvD_PackMisc(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! y_TStC call RegPack(Buf, allocated(InData%y_TStC)) if (allocated(InData%y_TStC)) then call RegPackBounds(Buf, 1, lbound(InData%y_TStC), ubound(InData%y_TStC)) @@ -6428,7 +6009,6 @@ subroutine SrvD_PackMisc(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! y_SStC call RegPack(Buf, allocated(InData%y_SStC)) if (allocated(InData%y_SStC)) then call RegPackBounds(Buf, 1, lbound(InData%y_SStC), ubound(InData%y_SStC)) @@ -6439,10 +6019,8 @@ subroutine SrvD_PackMisc(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! SrvD_MeshMap call SrvD_PackModuleMapType(Buf, InData%SrvD_MeshMap) if (RegCheckErr(Buf, RoutineName)) return - ! PrevTstepNcall call RegPack(Buf, InData%PrevTstepNcall) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -6456,18 +6034,13 @@ subroutine SrvD_UnPackMisc(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! LastTimeCalled call RegUnpack(Buf, OutData%LastTimeCalled) if (RegCheckErr(Buf, RoutineName)) return - ! dll_data call SrvD_UnpackBladedDLLType(Buf, OutData%dll_data) ! dll_data - ! FirstWarn call RegUnpack(Buf, OutData%FirstWarn) if (RegCheckErr(Buf, RoutineName)) return - ! LastTimeFiltered call RegUnpack(Buf, OutData%LastTimeFiltered) if (RegCheckErr(Buf, RoutineName)) return - ! xd_BlPitchFilter if (allocated(OutData%xd_BlPitchFilter)) deallocate(OutData%xd_BlPitchFilter) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6482,7 +6055,6 @@ subroutine SrvD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%xd_BlPitchFilter) if (RegCheckErr(Buf, RoutineName)) return end if - ! BStC if (allocated(OutData%BStC)) deallocate(OutData%BStC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6498,7 +6070,6 @@ subroutine SrvD_UnPackMisc(Buf, OutData) call StC_UnpackMisc(Buf, OutData%BStC(i1)) ! BStC end do end if - ! NStC if (allocated(OutData%NStC)) deallocate(OutData%NStC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6514,7 +6085,6 @@ subroutine SrvD_UnPackMisc(Buf, OutData) call StC_UnpackMisc(Buf, OutData%NStC(i1)) ! NStC end do end if - ! TStC if (allocated(OutData%TStC)) deallocate(OutData%TStC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6530,7 +6100,6 @@ subroutine SrvD_UnPackMisc(Buf, OutData) call StC_UnpackMisc(Buf, OutData%TStC(i1)) ! TStC end do end if - ! SStC if (allocated(OutData%SStC)) deallocate(OutData%SStC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6546,7 +6115,6 @@ subroutine SrvD_UnPackMisc(Buf, OutData) call StC_UnpackMisc(Buf, OutData%SStC(i1)) ! SStC end do end if - ! u_BStC if (allocated(OutData%u_BStC)) deallocate(OutData%u_BStC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6564,7 +6132,6 @@ subroutine SrvD_UnPackMisc(Buf, OutData) end do end do end if - ! u_NStC if (allocated(OutData%u_NStC)) deallocate(OutData%u_NStC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6582,7 +6149,6 @@ subroutine SrvD_UnPackMisc(Buf, OutData) end do end do end if - ! u_TStC if (allocated(OutData%u_TStC)) deallocate(OutData%u_TStC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6600,7 +6166,6 @@ subroutine SrvD_UnPackMisc(Buf, OutData) end do end do end if - ! u_SStC if (allocated(OutData%u_SStC)) deallocate(OutData%u_SStC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6618,7 +6183,6 @@ subroutine SrvD_UnPackMisc(Buf, OutData) end do end do end if - ! y_BStC if (allocated(OutData%y_BStC)) deallocate(OutData%y_BStC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6634,7 +6198,6 @@ subroutine SrvD_UnPackMisc(Buf, OutData) call StC_UnpackOutput(Buf, OutData%y_BStC(i1)) ! y_BStC end do end if - ! y_NStC if (allocated(OutData%y_NStC)) deallocate(OutData%y_NStC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6650,7 +6213,6 @@ subroutine SrvD_UnPackMisc(Buf, OutData) call StC_UnpackOutput(Buf, OutData%y_NStC(i1)) ! y_NStC end do end if - ! y_TStC if (allocated(OutData%y_TStC)) deallocate(OutData%y_TStC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6666,7 +6228,6 @@ subroutine SrvD_UnPackMisc(Buf, OutData) call StC_UnpackOutput(Buf, OutData%y_TStC(i1)) ! y_TStC end do end if - ! y_SStC if (allocated(OutData%y_SStC)) deallocate(OutData%y_SStC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6682,623 +6243,643 @@ subroutine SrvD_UnPackMisc(Buf, OutData) call StC_UnpackOutput(Buf, OutData%y_SStC(i1)) ! y_SStC end do end if - ! SrvD_MeshMap call SrvD_UnpackModuleMapType(Buf, OutData%SrvD_MeshMap) ! SrvD_MeshMap - ! PrevTstepNcall call RegUnpack(Buf, OutData%PrevTstepNcall) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE SrvD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SrvD_ParameterType), INTENT(IN) :: SrcParamData - TYPE(SrvD_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT - DstParamData%HSSBrDT = SrcParamData%HSSBrDT - DstParamData%HSSBrTqF = SrcParamData%HSSBrTqF - DstParamData%SIG_POSl = SrcParamData%SIG_POSl - DstParamData%SIG_POTq = SrcParamData%SIG_POTq - DstParamData%SIG_SlPc = SrcParamData%SIG_SlPc - DstParamData%SIG_Slop = SrcParamData%SIG_Slop - DstParamData%SIG_SySp = SrcParamData%SIG_SySp - DstParamData%TEC_A0 = SrcParamData%TEC_A0 - DstParamData%TEC_C0 = SrcParamData%TEC_C0 - DstParamData%TEC_C1 = SrcParamData%TEC_C1 - DstParamData%TEC_C2 = SrcParamData%TEC_C2 - DstParamData%TEC_K2 = SrcParamData%TEC_K2 - DstParamData%TEC_MR = SrcParamData%TEC_MR - DstParamData%TEC_Re1 = SrcParamData%TEC_Re1 - DstParamData%TEC_RLR = SrcParamData%TEC_RLR - DstParamData%TEC_RRes = SrcParamData%TEC_RRes - DstParamData%TEC_SRes = SrcParamData%TEC_SRes - DstParamData%TEC_SySp = SrcParamData%TEC_SySp - DstParamData%TEC_V1a = SrcParamData%TEC_V1a - DstParamData%TEC_VLL = SrcParamData%TEC_VLL - DstParamData%TEC_Xe1 = SrcParamData%TEC_Xe1 - DstParamData%GenEff = SrcParamData%GenEff -IF (ALLOCATED(SrcParamData%BlPitchInit)) THEN - i1_l = LBOUND(SrcParamData%BlPitchInit,1) - i1_u = UBOUND(SrcParamData%BlPitchInit,1) - IF (.NOT. ALLOCATED(DstParamData%BlPitchInit)) THEN - ALLOCATE(DstParamData%BlPitchInit(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlPitchInit.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BlPitchInit = SrcParamData%BlPitchInit -ENDIF -IF (ALLOCATED(SrcParamData%BlPitchF)) THEN - i1_l = LBOUND(SrcParamData%BlPitchF,1) - i1_u = UBOUND(SrcParamData%BlPitchF,1) - IF (.NOT. ALLOCATED(DstParamData%BlPitchF)) THEN - ALLOCATE(DstParamData%BlPitchF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlPitchF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BlPitchF = SrcParamData%BlPitchF -ENDIF -IF (ALLOCATED(SrcParamData%PitManRat)) THEN - i1_l = LBOUND(SrcParamData%PitManRat,1) - i1_u = UBOUND(SrcParamData%PitManRat,1) - IF (.NOT. ALLOCATED(DstParamData%PitManRat)) THEN - ALLOCATE(DstParamData%PitManRat(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PitManRat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%PitManRat = SrcParamData%PitManRat -ENDIF - DstParamData%YawManRat = SrcParamData%YawManRat - DstParamData%NacYawF = SrcParamData%NacYawF - DstParamData%SpdGenOn = SrcParamData%SpdGenOn - DstParamData%THSSBrDp = SrcParamData%THSSBrDp - DstParamData%THSSBrFl = SrcParamData%THSSBrFl - DstParamData%TimGenOf = SrcParamData%TimGenOf - DstParamData%TimGenOn = SrcParamData%TimGenOn - DstParamData%TPCOn = SrcParamData%TPCOn -IF (ALLOCATED(SrcParamData%TPitManS)) THEN - i1_l = LBOUND(SrcParamData%TPitManS,1) - i1_u = UBOUND(SrcParamData%TPitManS,1) - IF (.NOT. ALLOCATED(DstParamData%TPitManS)) THEN - ALLOCATE(DstParamData%TPitManS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TPitManS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TPitManS = SrcParamData%TPitManS -ENDIF - DstParamData%TYawManS = SrcParamData%TYawManS - DstParamData%TYCOn = SrcParamData%TYCOn - DstParamData%VS_RtGnSp = SrcParamData%VS_RtGnSp - DstParamData%VS_RtTq = SrcParamData%VS_RtTq - DstParamData%VS_Slope = SrcParamData%VS_Slope - DstParamData%VS_SlPc = SrcParamData%VS_SlPc - DstParamData%VS_SySp = SrcParamData%VS_SySp - DstParamData%VS_TrGnSp = SrcParamData%VS_TrGnSp - DstParamData%YawPosCom = SrcParamData%YawPosCom - DstParamData%YawRateCom = SrcParamData%YawRateCom - DstParamData%GenModel = SrcParamData%GenModel - DstParamData%HSSBrMode = SrcParamData%HSSBrMode - DstParamData%PCMode = SrcParamData%PCMode - DstParamData%VSContrl = SrcParamData%VSContrl - DstParamData%YCMode = SrcParamData%YCMode - DstParamData%GenTiStp = SrcParamData%GenTiStp - DstParamData%GenTiStr = SrcParamData%GenTiStr - DstParamData%VS_Rgn2K = SrcParamData%VS_Rgn2K - DstParamData%YawNeut = SrcParamData%YawNeut - DstParamData%YawSpr = SrcParamData%YawSpr - DstParamData%YawDamp = SrcParamData%YawDamp - DstParamData%TpBrDT = SrcParamData%TpBrDT -IF (ALLOCATED(SrcParamData%TBDepISp)) THEN - i1_l = LBOUND(SrcParamData%TBDepISp,1) - i1_u = UBOUND(SrcParamData%TBDepISp,1) - IF (.NOT. ALLOCATED(DstParamData%TBDepISp)) THEN - ALLOCATE(DstParamData%TBDepISp(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TBDepISp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TBDepISp = SrcParamData%TBDepISp -ENDIF - DstParamData%TBDrConN = SrcParamData%TBDrConN - DstParamData%TBDrConD = SrcParamData%TBDrConD - DstParamData%NumBl = SrcParamData%NumBl - DstParamData%NumBStC = SrcParamData%NumBStC - DstParamData%NumNStC = SrcParamData%NumNStC - DstParamData%NumTStC = SrcParamData%NumTStC - DstParamData%NumSStC = SrcParamData%NumSStC - DstParamData%AfCmode = SrcParamData%AfCmode - DstParamData%AfC_Mean = SrcParamData%AfC_Mean - DstParamData%AfC_Amp = SrcParamData%AfC_Amp - DstParamData%AfC_Phase = SrcParamData%AfC_Phase - DstParamData%CCmode = SrcParamData%CCmode - DstParamData%StCCmode = SrcParamData%StCCmode - DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%NumOuts_DLL = SrcParamData%NumOuts_DLL - DstParamData%RootName = SrcParamData%RootName -IF (ALLOCATED(SrcParamData%OutParam)) THEN - i1_l = LBOUND(SrcParamData%OutParam,1) - i1_u = UBOUND(SrcParamData%OutParam,1) - IF (.NOT. ALLOCATED(DstParamData%OutParam)) THEN - ALLOCATE(DstParamData%OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%OutParam,1), UBOUND(SrcParamData%OutParam,1) - CALL NWTC_Library_Copyoutparmtype( SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstParamData%Delim = SrcParamData%Delim - DstParamData%UseBladedInterface = SrcParamData%UseBladedInterface - DstParamData%UseLegacyInterface = SrcParamData%UseLegacyInterface - DstParamData%DLL_Trgt = SrcParamData%DLL_Trgt - DstParamData%DLL_Ramp = SrcParamData%DLL_Ramp - DstParamData%BlAlpha = SrcParamData%BlAlpha - DstParamData%DLL_n = SrcParamData%DLL_n - DstParamData%avcOUTNAME_LEN = SrcParamData%avcOUTNAME_LEN - DstParamData%NacYaw_North = SrcParamData%NacYaw_North - DstParamData%AvgWindSpeed = SrcParamData%AvgWindSpeed - DstParamData%AirDens = SrcParamData%AirDens - DstParamData%TrimCase = SrcParamData%TrimCase - DstParamData%TrimGain = SrcParamData%TrimGain - DstParamData%RotSpeedRef = SrcParamData%RotSpeedRef -IF (ALLOCATED(SrcParamData%BStC)) THEN - i1_l = LBOUND(SrcParamData%BStC,1) - i1_u = UBOUND(SrcParamData%BStC,1) - IF (.NOT. ALLOCATED(DstParamData%BStC)) THEN - ALLOCATE(DstParamData%BStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%BStC,1), UBOUND(SrcParamData%BStC,1) - CALL StC_CopyParam( SrcParamData%BStC(i1), DstParamData%BStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%NStC)) THEN - i1_l = LBOUND(SrcParamData%NStC,1) - i1_u = UBOUND(SrcParamData%NStC,1) - IF (.NOT. ALLOCATED(DstParamData%NStC)) THEN - ALLOCATE(DstParamData%NStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%NStC,1), UBOUND(SrcParamData%NStC,1) - CALL StC_CopyParam( SrcParamData%NStC(i1), DstParamData%NStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%TStC)) THEN - i1_l = LBOUND(SrcParamData%TStC,1) - i1_u = UBOUND(SrcParamData%TStC,1) - IF (.NOT. ALLOCATED(DstParamData%TStC)) THEN - ALLOCATE(DstParamData%TStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%TStC,1), UBOUND(SrcParamData%TStC,1) - CALL StC_CopyParam( SrcParamData%TStC(i1), DstParamData%TStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%SStC)) THEN - i1_l = LBOUND(SrcParamData%SStC,1) - i1_u = UBOUND(SrcParamData%SStC,1) - IF (.NOT. ALLOCATED(DstParamData%SStC)) THEN - ALLOCATE(DstParamData%SStC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%SStC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%SStC,1), UBOUND(SrcParamData%SStC,1) - CALL StC_CopyParam( SrcParamData%SStC(i1), DstParamData%SStC(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstParamData%InterpOrder = SrcParamData%InterpOrder - DstParamData%EXavrSWAP = SrcParamData%EXavrSWAP - DstParamData%NumCableControl = SrcParamData%NumCableControl - DstParamData%NumStC_Control = SrcParamData%NumStC_Control -IF (ALLOCATED(SrcParamData%StCMeasNumPerChan)) THEN - i1_l = LBOUND(SrcParamData%StCMeasNumPerChan,1) - i1_u = UBOUND(SrcParamData%StCMeasNumPerChan,1) - IF (.NOT. ALLOCATED(DstParamData%StCMeasNumPerChan)) THEN - ALLOCATE(DstParamData%StCMeasNumPerChan(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StCMeasNumPerChan.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%StCMeasNumPerChan = SrcParamData%StCMeasNumPerChan -ENDIF - DstParamData%UseSC = SrcParamData%UseSC -IF (ALLOCATED(SrcParamData%Jac_u_indx)) THEN - i1_l = LBOUND(SrcParamData%Jac_u_indx,1) - i1_u = UBOUND(SrcParamData%Jac_u_indx,1) - i2_l = LBOUND(SrcParamData%Jac_u_indx,2) - i2_u = UBOUND(SrcParamData%Jac_u_indx,2) - IF (.NOT. ALLOCATED(DstParamData%Jac_u_indx)) THEN - ALLOCATE(DstParamData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx -ENDIF -IF (ALLOCATED(SrcParamData%Jac_x_indx)) THEN - i1_l = LBOUND(SrcParamData%Jac_x_indx,1) - i1_u = UBOUND(SrcParamData%Jac_x_indx,1) - i2_l = LBOUND(SrcParamData%Jac_x_indx,2) - i2_u = UBOUND(SrcParamData%Jac_x_indx,2) - IF (.NOT. ALLOCATED(DstParamData%Jac_x_indx)) THEN - ALLOCATE(DstParamData%Jac_x_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_x_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_x_indx = SrcParamData%Jac_x_indx -ENDIF -IF (ALLOCATED(SrcParamData%du)) THEN - i1_l = LBOUND(SrcParamData%du,1) - i1_u = UBOUND(SrcParamData%du,1) - IF (.NOT. ALLOCATED(DstParamData%du)) THEN - ALLOCATE(DstParamData%du(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%du = SrcParamData%du -ENDIF -IF (ALLOCATED(SrcParamData%dx)) THEN - i1_l = LBOUND(SrcParamData%dx,1) - i1_u = UBOUND(SrcParamData%dx,1) - IF (.NOT. ALLOCATED(DstParamData%dx)) THEN - ALLOCATE(DstParamData%dx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%dx = SrcParamData%dx -ENDIF - DstParamData%Jac_nu = SrcParamData%Jac_nu - DstParamData%Jac_ny = SrcParamData%Jac_ny - DstParamData%Jac_nx = SrcParamData%Jac_nx -IF (ALLOCATED(SrcParamData%Jac_Idx_BStC_u)) THEN - i1_l = LBOUND(SrcParamData%Jac_Idx_BStC_u,1) - i1_u = UBOUND(SrcParamData%Jac_Idx_BStC_u,1) - i2_l = LBOUND(SrcParamData%Jac_Idx_BStC_u,2) - i2_u = UBOUND(SrcParamData%Jac_Idx_BStC_u,2) - i3_l = LBOUND(SrcParamData%Jac_Idx_BStC_u,3) - i3_u = UBOUND(SrcParamData%Jac_Idx_BStC_u,3) - IF (.NOT. ALLOCATED(DstParamData%Jac_Idx_BStC_u)) THEN - ALLOCATE(DstParamData%Jac_Idx_BStC_u(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_BStC_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_Idx_BStC_u = SrcParamData%Jac_Idx_BStC_u -ENDIF -IF (ALLOCATED(SrcParamData%Jac_Idx_NStC_u)) THEN - i1_l = LBOUND(SrcParamData%Jac_Idx_NStC_u,1) - i1_u = UBOUND(SrcParamData%Jac_Idx_NStC_u,1) - i2_l = LBOUND(SrcParamData%Jac_Idx_NStC_u,2) - i2_u = UBOUND(SrcParamData%Jac_Idx_NStC_u,2) - IF (.NOT. ALLOCATED(DstParamData%Jac_Idx_NStC_u)) THEN - ALLOCATE(DstParamData%Jac_Idx_NStC_u(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_NStC_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_Idx_NStC_u = SrcParamData%Jac_Idx_NStC_u -ENDIF -IF (ALLOCATED(SrcParamData%Jac_Idx_TStC_u)) THEN - i1_l = LBOUND(SrcParamData%Jac_Idx_TStC_u,1) - i1_u = UBOUND(SrcParamData%Jac_Idx_TStC_u,1) - i2_l = LBOUND(SrcParamData%Jac_Idx_TStC_u,2) - i2_u = UBOUND(SrcParamData%Jac_Idx_TStC_u,2) - IF (.NOT. ALLOCATED(DstParamData%Jac_Idx_TStC_u)) THEN - ALLOCATE(DstParamData%Jac_Idx_TStC_u(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_TStC_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_Idx_TStC_u = SrcParamData%Jac_Idx_TStC_u -ENDIF -IF (ALLOCATED(SrcParamData%Jac_Idx_SStC_u)) THEN - i1_l = LBOUND(SrcParamData%Jac_Idx_SStC_u,1) - i1_u = UBOUND(SrcParamData%Jac_Idx_SStC_u,1) - i2_l = LBOUND(SrcParamData%Jac_Idx_SStC_u,2) - i2_u = UBOUND(SrcParamData%Jac_Idx_SStC_u,2) - IF (.NOT. ALLOCATED(DstParamData%Jac_Idx_SStC_u)) THEN - ALLOCATE(DstParamData%Jac_Idx_SStC_u(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_SStC_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_Idx_SStC_u = SrcParamData%Jac_Idx_SStC_u -ENDIF -IF (ALLOCATED(SrcParamData%Jac_Idx_BStC_x)) THEN - i1_l = LBOUND(SrcParamData%Jac_Idx_BStC_x,1) - i1_u = UBOUND(SrcParamData%Jac_Idx_BStC_x,1) - i2_l = LBOUND(SrcParamData%Jac_Idx_BStC_x,2) - i2_u = UBOUND(SrcParamData%Jac_Idx_BStC_x,2) - i3_l = LBOUND(SrcParamData%Jac_Idx_BStC_x,3) - i3_u = UBOUND(SrcParamData%Jac_Idx_BStC_x,3) - IF (.NOT. ALLOCATED(DstParamData%Jac_Idx_BStC_x)) THEN - ALLOCATE(DstParamData%Jac_Idx_BStC_x(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_BStC_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_Idx_BStC_x = SrcParamData%Jac_Idx_BStC_x -ENDIF -IF (ALLOCATED(SrcParamData%Jac_Idx_NStC_x)) THEN - i1_l = LBOUND(SrcParamData%Jac_Idx_NStC_x,1) - i1_u = UBOUND(SrcParamData%Jac_Idx_NStC_x,1) - i2_l = LBOUND(SrcParamData%Jac_Idx_NStC_x,2) - i2_u = UBOUND(SrcParamData%Jac_Idx_NStC_x,2) - IF (.NOT. ALLOCATED(DstParamData%Jac_Idx_NStC_x)) THEN - ALLOCATE(DstParamData%Jac_Idx_NStC_x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_NStC_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_Idx_NStC_x = SrcParamData%Jac_Idx_NStC_x -ENDIF -IF (ALLOCATED(SrcParamData%Jac_Idx_TStC_x)) THEN - i1_l = LBOUND(SrcParamData%Jac_Idx_TStC_x,1) - i1_u = UBOUND(SrcParamData%Jac_Idx_TStC_x,1) - i2_l = LBOUND(SrcParamData%Jac_Idx_TStC_x,2) - i2_u = UBOUND(SrcParamData%Jac_Idx_TStC_x,2) - IF (.NOT. ALLOCATED(DstParamData%Jac_Idx_TStC_x)) THEN - ALLOCATE(DstParamData%Jac_Idx_TStC_x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_TStC_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_Idx_TStC_x = SrcParamData%Jac_Idx_TStC_x -ENDIF -IF (ALLOCATED(SrcParamData%Jac_Idx_SStC_x)) THEN - i1_l = LBOUND(SrcParamData%Jac_Idx_SStC_x,1) - i1_u = UBOUND(SrcParamData%Jac_Idx_SStC_x,1) - i2_l = LBOUND(SrcParamData%Jac_Idx_SStC_x,2) - i2_u = UBOUND(SrcParamData%Jac_Idx_SStC_x,2) - IF (.NOT. ALLOCATED(DstParamData%Jac_Idx_SStC_x)) THEN - ALLOCATE(DstParamData%Jac_Idx_SStC_x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_SStC_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_Idx_SStC_x = SrcParamData%Jac_Idx_SStC_x -ENDIF -IF (ALLOCATED(SrcParamData%Jac_Idx_BStC_y)) THEN - i1_l = LBOUND(SrcParamData%Jac_Idx_BStC_y,1) - i1_u = UBOUND(SrcParamData%Jac_Idx_BStC_y,1) - i2_l = LBOUND(SrcParamData%Jac_Idx_BStC_y,2) - i2_u = UBOUND(SrcParamData%Jac_Idx_BStC_y,2) - i3_l = LBOUND(SrcParamData%Jac_Idx_BStC_y,3) - i3_u = UBOUND(SrcParamData%Jac_Idx_BStC_y,3) - IF (.NOT. ALLOCATED(DstParamData%Jac_Idx_BStC_y)) THEN - ALLOCATE(DstParamData%Jac_Idx_BStC_y(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_BStC_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_Idx_BStC_y = SrcParamData%Jac_Idx_BStC_y -ENDIF -IF (ALLOCATED(SrcParamData%Jac_Idx_NStC_y)) THEN - i1_l = LBOUND(SrcParamData%Jac_Idx_NStC_y,1) - i1_u = UBOUND(SrcParamData%Jac_Idx_NStC_y,1) - i2_l = LBOUND(SrcParamData%Jac_Idx_NStC_y,2) - i2_u = UBOUND(SrcParamData%Jac_Idx_NStC_y,2) - IF (.NOT. ALLOCATED(DstParamData%Jac_Idx_NStC_y)) THEN - ALLOCATE(DstParamData%Jac_Idx_NStC_y(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_NStC_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_Idx_NStC_y = SrcParamData%Jac_Idx_NStC_y -ENDIF -IF (ALLOCATED(SrcParamData%Jac_Idx_TStC_y)) THEN - i1_l = LBOUND(SrcParamData%Jac_Idx_TStC_y,1) - i1_u = UBOUND(SrcParamData%Jac_Idx_TStC_y,1) - i2_l = LBOUND(SrcParamData%Jac_Idx_TStC_y,2) - i2_u = UBOUND(SrcParamData%Jac_Idx_TStC_y,2) - IF (.NOT. ALLOCATED(DstParamData%Jac_Idx_TStC_y)) THEN - ALLOCATE(DstParamData%Jac_Idx_TStC_y(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_TStC_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_Idx_TStC_y = SrcParamData%Jac_Idx_TStC_y -ENDIF -IF (ALLOCATED(SrcParamData%Jac_Idx_SStC_y)) THEN - i1_l = LBOUND(SrcParamData%Jac_Idx_SStC_y,1) - i1_u = UBOUND(SrcParamData%Jac_Idx_SStC_y,1) - i2_l = LBOUND(SrcParamData%Jac_Idx_SStC_y,2) - i2_u = UBOUND(SrcParamData%Jac_Idx_SStC_y,2) - IF (.NOT. ALLOCATED(DstParamData%Jac_Idx_SStC_y)) THEN - ALLOCATE(DstParamData%Jac_Idx_SStC_y(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_SStC_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_Idx_SStC_y = SrcParamData%Jac_Idx_SStC_y -ENDIF - DstParamData%SensorType = SrcParamData%SensorType - DstParamData%NumBeam = SrcParamData%NumBeam - DstParamData%NumPulseGate = SrcParamData%NumPulseGate - DstParamData%PulseSpacing = SrcParamData%PulseSpacing - DstParamData%URefLid = SrcParamData%URefLid - END SUBROUTINE SrvD_CopyParam - - SUBROUTINE SrvD_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(SrvD_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyParam' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%BlPitchInit)) THEN - DEALLOCATE(ParamData%BlPitchInit) -ENDIF -IF (ALLOCATED(ParamData%BlPitchF)) THEN - DEALLOCATE(ParamData%BlPitchF) -ENDIF -IF (ALLOCATED(ParamData%PitManRat)) THEN - DEALLOCATE(ParamData%PitManRat) -ENDIF -IF (ALLOCATED(ParamData%TPitManS)) THEN - DEALLOCATE(ParamData%TPitManS) -ENDIF -IF (ALLOCATED(ParamData%TBDepISp)) THEN - DEALLOCATE(ParamData%TBDepISp) -ENDIF -IF (ALLOCATED(ParamData%OutParam)) THEN -DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_DestroyOutParmType( ParamData%OutParam(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%OutParam) -ENDIF - CALL FreeDynamicLib( ParamData%DLL_Trgt, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(ParamData%BStC)) THEN -DO i1 = LBOUND(ParamData%BStC,1), UBOUND(ParamData%BStC,1) - CALL StC_DestroyParam( ParamData%BStC(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%BStC) -ENDIF -IF (ALLOCATED(ParamData%NStC)) THEN -DO i1 = LBOUND(ParamData%NStC,1), UBOUND(ParamData%NStC,1) - CALL StC_DestroyParam( ParamData%NStC(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%NStC) -ENDIF -IF (ALLOCATED(ParamData%TStC)) THEN -DO i1 = LBOUND(ParamData%TStC,1), UBOUND(ParamData%TStC,1) - CALL StC_DestroyParam( ParamData%TStC(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%TStC) -ENDIF -IF (ALLOCATED(ParamData%SStC)) THEN -DO i1 = LBOUND(ParamData%SStC,1), UBOUND(ParamData%SStC,1) - CALL StC_DestroyParam( ParamData%SStC(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%SStC) -ENDIF -IF (ALLOCATED(ParamData%StCMeasNumPerChan)) THEN - DEALLOCATE(ParamData%StCMeasNumPerChan) -ENDIF -IF (ALLOCATED(ParamData%Jac_u_indx)) THEN - DEALLOCATE(ParamData%Jac_u_indx) -ENDIF -IF (ALLOCATED(ParamData%Jac_x_indx)) THEN - DEALLOCATE(ParamData%Jac_x_indx) -ENDIF -IF (ALLOCATED(ParamData%du)) THEN - DEALLOCATE(ParamData%du) -ENDIF -IF (ALLOCATED(ParamData%dx)) THEN - DEALLOCATE(ParamData%dx) -ENDIF -IF (ALLOCATED(ParamData%Jac_Idx_BStC_u)) THEN - DEALLOCATE(ParamData%Jac_Idx_BStC_u) -ENDIF -IF (ALLOCATED(ParamData%Jac_Idx_NStC_u)) THEN - DEALLOCATE(ParamData%Jac_Idx_NStC_u) -ENDIF -IF (ALLOCATED(ParamData%Jac_Idx_TStC_u)) THEN - DEALLOCATE(ParamData%Jac_Idx_TStC_u) -ENDIF -IF (ALLOCATED(ParamData%Jac_Idx_SStC_u)) THEN - DEALLOCATE(ParamData%Jac_Idx_SStC_u) -ENDIF -IF (ALLOCATED(ParamData%Jac_Idx_BStC_x)) THEN - DEALLOCATE(ParamData%Jac_Idx_BStC_x) -ENDIF -IF (ALLOCATED(ParamData%Jac_Idx_NStC_x)) THEN - DEALLOCATE(ParamData%Jac_Idx_NStC_x) -ENDIF -IF (ALLOCATED(ParamData%Jac_Idx_TStC_x)) THEN - DEALLOCATE(ParamData%Jac_Idx_TStC_x) -ENDIF -IF (ALLOCATED(ParamData%Jac_Idx_SStC_x)) THEN - DEALLOCATE(ParamData%Jac_Idx_SStC_x) -ENDIF -IF (ALLOCATED(ParamData%Jac_Idx_BStC_y)) THEN - DEALLOCATE(ParamData%Jac_Idx_BStC_y) -ENDIF -IF (ALLOCATED(ParamData%Jac_Idx_NStC_y)) THEN - DEALLOCATE(ParamData%Jac_Idx_NStC_y) -ENDIF -IF (ALLOCATED(ParamData%Jac_Idx_TStC_y)) THEN - DEALLOCATE(ParamData%Jac_Idx_TStC_y) -ENDIF -IF (ALLOCATED(ParamData%Jac_Idx_SStC_y)) THEN - DEALLOCATE(ParamData%Jac_Idx_SStC_y) -ENDIF - END SUBROUTINE SrvD_DestroyParam +subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(SrvD_ParameterType), intent(in) :: SrcParamData + type(SrvD_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%DT = SrcParamData%DT + DstParamData%HSSBrDT = SrcParamData%HSSBrDT + DstParamData%HSSBrTqF = SrcParamData%HSSBrTqF + DstParamData%SIG_POSl = SrcParamData%SIG_POSl + DstParamData%SIG_POTq = SrcParamData%SIG_POTq + DstParamData%SIG_SlPc = SrcParamData%SIG_SlPc + DstParamData%SIG_Slop = SrcParamData%SIG_Slop + DstParamData%SIG_SySp = SrcParamData%SIG_SySp + DstParamData%TEC_A0 = SrcParamData%TEC_A0 + DstParamData%TEC_C0 = SrcParamData%TEC_C0 + DstParamData%TEC_C1 = SrcParamData%TEC_C1 + DstParamData%TEC_C2 = SrcParamData%TEC_C2 + DstParamData%TEC_K2 = SrcParamData%TEC_K2 + DstParamData%TEC_MR = SrcParamData%TEC_MR + DstParamData%TEC_Re1 = SrcParamData%TEC_Re1 + DstParamData%TEC_RLR = SrcParamData%TEC_RLR + DstParamData%TEC_RRes = SrcParamData%TEC_RRes + DstParamData%TEC_SRes = SrcParamData%TEC_SRes + DstParamData%TEC_SySp = SrcParamData%TEC_SySp + DstParamData%TEC_V1a = SrcParamData%TEC_V1a + DstParamData%TEC_VLL = SrcParamData%TEC_VLL + DstParamData%TEC_Xe1 = SrcParamData%TEC_Xe1 + DstParamData%GenEff = SrcParamData%GenEff + if (allocated(SrcParamData%BlPitchInit)) then + LB(1:1) = lbound(SrcParamData%BlPitchInit) + UB(1:1) = ubound(SrcParamData%BlPitchInit) + if (.not. allocated(DstParamData%BlPitchInit)) then + allocate(DstParamData%BlPitchInit(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlPitchInit.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BlPitchInit = SrcParamData%BlPitchInit + else if (allocated(DstParamData%BlPitchInit)) then + deallocate(DstParamData%BlPitchInit) + end if + if (allocated(SrcParamData%BlPitchF)) then + LB(1:1) = lbound(SrcParamData%BlPitchF) + UB(1:1) = ubound(SrcParamData%BlPitchF) + if (.not. allocated(DstParamData%BlPitchF)) then + allocate(DstParamData%BlPitchF(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlPitchF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BlPitchF = SrcParamData%BlPitchF + else if (allocated(DstParamData%BlPitchF)) then + deallocate(DstParamData%BlPitchF) + end if + if (allocated(SrcParamData%PitManRat)) then + LB(1:1) = lbound(SrcParamData%PitManRat) + UB(1:1) = ubound(SrcParamData%PitManRat) + if (.not. allocated(DstParamData%PitManRat)) then + allocate(DstParamData%PitManRat(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PitManRat.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%PitManRat = SrcParamData%PitManRat + else if (allocated(DstParamData%PitManRat)) then + deallocate(DstParamData%PitManRat) + end if + DstParamData%YawManRat = SrcParamData%YawManRat + DstParamData%NacYawF = SrcParamData%NacYawF + DstParamData%SpdGenOn = SrcParamData%SpdGenOn + DstParamData%THSSBrDp = SrcParamData%THSSBrDp + DstParamData%THSSBrFl = SrcParamData%THSSBrFl + DstParamData%TimGenOf = SrcParamData%TimGenOf + DstParamData%TimGenOn = SrcParamData%TimGenOn + DstParamData%TPCOn = SrcParamData%TPCOn + if (allocated(SrcParamData%TPitManS)) then + LB(1:1) = lbound(SrcParamData%TPitManS) + UB(1:1) = ubound(SrcParamData%TPitManS) + if (.not. allocated(DstParamData%TPitManS)) then + allocate(DstParamData%TPitManS(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TPitManS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%TPitManS = SrcParamData%TPitManS + else if (allocated(DstParamData%TPitManS)) then + deallocate(DstParamData%TPitManS) + end if + DstParamData%TYawManS = SrcParamData%TYawManS + DstParamData%TYCOn = SrcParamData%TYCOn + DstParamData%VS_RtGnSp = SrcParamData%VS_RtGnSp + DstParamData%VS_RtTq = SrcParamData%VS_RtTq + DstParamData%VS_Slope = SrcParamData%VS_Slope + DstParamData%VS_SlPc = SrcParamData%VS_SlPc + DstParamData%VS_SySp = SrcParamData%VS_SySp + DstParamData%VS_TrGnSp = SrcParamData%VS_TrGnSp + DstParamData%YawPosCom = SrcParamData%YawPosCom + DstParamData%YawRateCom = SrcParamData%YawRateCom + DstParamData%GenModel = SrcParamData%GenModel + DstParamData%HSSBrMode = SrcParamData%HSSBrMode + DstParamData%PCMode = SrcParamData%PCMode + DstParamData%VSContrl = SrcParamData%VSContrl + DstParamData%YCMode = SrcParamData%YCMode + DstParamData%GenTiStp = SrcParamData%GenTiStp + DstParamData%GenTiStr = SrcParamData%GenTiStr + DstParamData%VS_Rgn2K = SrcParamData%VS_Rgn2K + DstParamData%YawNeut = SrcParamData%YawNeut + DstParamData%YawSpr = SrcParamData%YawSpr + DstParamData%YawDamp = SrcParamData%YawDamp + DstParamData%TpBrDT = SrcParamData%TpBrDT + if (allocated(SrcParamData%TBDepISp)) then + LB(1:1) = lbound(SrcParamData%TBDepISp) + UB(1:1) = ubound(SrcParamData%TBDepISp) + if (.not. allocated(DstParamData%TBDepISp)) then + allocate(DstParamData%TBDepISp(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TBDepISp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%TBDepISp = SrcParamData%TBDepISp + else if (allocated(DstParamData%TBDepISp)) then + deallocate(DstParamData%TBDepISp) + end if + DstParamData%TBDrConN = SrcParamData%TBDrConN + DstParamData%TBDrConD = SrcParamData%TBDrConD + DstParamData%NumBl = SrcParamData%NumBl + DstParamData%NumBStC = SrcParamData%NumBStC + DstParamData%NumNStC = SrcParamData%NumNStC + DstParamData%NumTStC = SrcParamData%NumTStC + DstParamData%NumSStC = SrcParamData%NumSStC + DstParamData%AfCmode = SrcParamData%AfCmode + DstParamData%AfC_Mean = SrcParamData%AfC_Mean + DstParamData%AfC_Amp = SrcParamData%AfC_Amp + DstParamData%AfC_Phase = SrcParamData%AfC_Phase + DstParamData%CCmode = SrcParamData%CCmode + DstParamData%StCCmode = SrcParamData%StCCmode + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%NumOuts_DLL = SrcParamData%NumOuts_DLL + DstParamData%RootName = SrcParamData%RootName + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstParamData%OutParam)) then + deallocate(DstParamData%OutParam) + end if + DstParamData%Delim = SrcParamData%Delim + DstParamData%UseBladedInterface = SrcParamData%UseBladedInterface + DstParamData%UseLegacyInterface = SrcParamData%UseLegacyInterface + DstParamData%DLL_Trgt = SrcParamData%DLL_Trgt + DstParamData%DLL_Ramp = SrcParamData%DLL_Ramp + DstParamData%BlAlpha = SrcParamData%BlAlpha + DstParamData%DLL_n = SrcParamData%DLL_n + DstParamData%avcOUTNAME_LEN = SrcParamData%avcOUTNAME_LEN + DstParamData%NacYaw_North = SrcParamData%NacYaw_North + DstParamData%AvgWindSpeed = SrcParamData%AvgWindSpeed + DstParamData%AirDens = SrcParamData%AirDens + DstParamData%TrimCase = SrcParamData%TrimCase + DstParamData%TrimGain = SrcParamData%TrimGain + DstParamData%RotSpeedRef = SrcParamData%RotSpeedRef + if (allocated(SrcParamData%BStC)) then + LB(1:1) = lbound(SrcParamData%BStC) + UB(1:1) = ubound(SrcParamData%BStC) + if (.not. allocated(DstParamData%BStC)) then + allocate(DstParamData%BStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyParam(SrcParamData%BStC(i1), DstParamData%BStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstParamData%BStC)) then + deallocate(DstParamData%BStC) + end if + if (allocated(SrcParamData%NStC)) then + LB(1:1) = lbound(SrcParamData%NStC) + UB(1:1) = ubound(SrcParamData%NStC) + if (.not. allocated(DstParamData%NStC)) then + allocate(DstParamData%NStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyParam(SrcParamData%NStC(i1), DstParamData%NStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstParamData%NStC)) then + deallocate(DstParamData%NStC) + end if + if (allocated(SrcParamData%TStC)) then + LB(1:1) = lbound(SrcParamData%TStC) + UB(1:1) = ubound(SrcParamData%TStC) + if (.not. allocated(DstParamData%TStC)) then + allocate(DstParamData%TStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyParam(SrcParamData%TStC(i1), DstParamData%TStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstParamData%TStC)) then + deallocate(DstParamData%TStC) + end if + if (allocated(SrcParamData%SStC)) then + LB(1:1) = lbound(SrcParamData%SStC) + UB(1:1) = ubound(SrcParamData%SStC) + if (.not. allocated(DstParamData%SStC)) then + allocate(DstParamData%SStC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%SStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call StC_CopyParam(SrcParamData%SStC(i1), DstParamData%SStC(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstParamData%SStC)) then + deallocate(DstParamData%SStC) + end if + DstParamData%InterpOrder = SrcParamData%InterpOrder + DstParamData%EXavrSWAP = SrcParamData%EXavrSWAP + DstParamData%NumCableControl = SrcParamData%NumCableControl + DstParamData%NumStC_Control = SrcParamData%NumStC_Control + if (allocated(SrcParamData%StCMeasNumPerChan)) then + LB(1:1) = lbound(SrcParamData%StCMeasNumPerChan) + UB(1:1) = ubound(SrcParamData%StCMeasNumPerChan) + if (.not. allocated(DstParamData%StCMeasNumPerChan)) then + allocate(DstParamData%StCMeasNumPerChan(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StCMeasNumPerChan.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%StCMeasNumPerChan = SrcParamData%StCMeasNumPerChan + else if (allocated(DstParamData%StCMeasNumPerChan)) then + deallocate(DstParamData%StCMeasNumPerChan) + end if + DstParamData%UseSC = SrcParamData%UseSC + if (allocated(SrcParamData%Jac_u_indx)) then + LB(1:2) = lbound(SrcParamData%Jac_u_indx) + UB(1:2) = ubound(SrcParamData%Jac_u_indx) + if (.not. allocated(DstParamData%Jac_u_indx)) then + allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx + else if (allocated(DstParamData%Jac_u_indx)) then + deallocate(DstParamData%Jac_u_indx) + end if + if (allocated(SrcParamData%Jac_x_indx)) then + LB(1:2) = lbound(SrcParamData%Jac_x_indx) + UB(1:2) = ubound(SrcParamData%Jac_x_indx) + if (.not. allocated(DstParamData%Jac_x_indx)) then + allocate(DstParamData%Jac_x_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_x_indx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_x_indx = SrcParamData%Jac_x_indx + else if (allocated(DstParamData%Jac_x_indx)) then + deallocate(DstParamData%Jac_x_indx) + end if + if (allocated(SrcParamData%du)) then + LB(1:1) = lbound(SrcParamData%du) + UB(1:1) = ubound(SrcParamData%du) + if (.not. allocated(DstParamData%du)) then + allocate(DstParamData%du(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%du = SrcParamData%du + else if (allocated(DstParamData%du)) then + deallocate(DstParamData%du) + end if + if (allocated(SrcParamData%dx)) then + LB(1:1) = lbound(SrcParamData%dx) + UB(1:1) = ubound(SrcParamData%dx) + if (.not. allocated(DstParamData%dx)) then + allocate(DstParamData%dx(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%dx = SrcParamData%dx + else if (allocated(DstParamData%dx)) then + deallocate(DstParamData%dx) + end if + DstParamData%Jac_nu = SrcParamData%Jac_nu + DstParamData%Jac_ny = SrcParamData%Jac_ny + DstParamData%Jac_nx = SrcParamData%Jac_nx + if (allocated(SrcParamData%Jac_Idx_BStC_u)) then + LB(1:3) = lbound(SrcParamData%Jac_Idx_BStC_u) + UB(1:3) = ubound(SrcParamData%Jac_Idx_BStC_u) + if (.not. allocated(DstParamData%Jac_Idx_BStC_u)) then + allocate(DstParamData%Jac_Idx_BStC_u(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_BStC_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_BStC_u = SrcParamData%Jac_Idx_BStC_u + else if (allocated(DstParamData%Jac_Idx_BStC_u)) then + deallocate(DstParamData%Jac_Idx_BStC_u) + end if + if (allocated(SrcParamData%Jac_Idx_NStC_u)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_NStC_u) + UB(1:2) = ubound(SrcParamData%Jac_Idx_NStC_u) + if (.not. allocated(DstParamData%Jac_Idx_NStC_u)) then + allocate(DstParamData%Jac_Idx_NStC_u(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_NStC_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_NStC_u = SrcParamData%Jac_Idx_NStC_u + else if (allocated(DstParamData%Jac_Idx_NStC_u)) then + deallocate(DstParamData%Jac_Idx_NStC_u) + end if + if (allocated(SrcParamData%Jac_Idx_TStC_u)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_TStC_u) + UB(1:2) = ubound(SrcParamData%Jac_Idx_TStC_u) + if (.not. allocated(DstParamData%Jac_Idx_TStC_u)) then + allocate(DstParamData%Jac_Idx_TStC_u(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_TStC_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_TStC_u = SrcParamData%Jac_Idx_TStC_u + else if (allocated(DstParamData%Jac_Idx_TStC_u)) then + deallocate(DstParamData%Jac_Idx_TStC_u) + end if + if (allocated(SrcParamData%Jac_Idx_SStC_u)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_SStC_u) + UB(1:2) = ubound(SrcParamData%Jac_Idx_SStC_u) + if (.not. allocated(DstParamData%Jac_Idx_SStC_u)) then + allocate(DstParamData%Jac_Idx_SStC_u(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_SStC_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_SStC_u = SrcParamData%Jac_Idx_SStC_u + else if (allocated(DstParamData%Jac_Idx_SStC_u)) then + deallocate(DstParamData%Jac_Idx_SStC_u) + end if + if (allocated(SrcParamData%Jac_Idx_BStC_x)) then + LB(1:3) = lbound(SrcParamData%Jac_Idx_BStC_x) + UB(1:3) = ubound(SrcParamData%Jac_Idx_BStC_x) + if (.not. allocated(DstParamData%Jac_Idx_BStC_x)) then + allocate(DstParamData%Jac_Idx_BStC_x(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_BStC_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_BStC_x = SrcParamData%Jac_Idx_BStC_x + else if (allocated(DstParamData%Jac_Idx_BStC_x)) then + deallocate(DstParamData%Jac_Idx_BStC_x) + end if + if (allocated(SrcParamData%Jac_Idx_NStC_x)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_NStC_x) + UB(1:2) = ubound(SrcParamData%Jac_Idx_NStC_x) + if (.not. allocated(DstParamData%Jac_Idx_NStC_x)) then + allocate(DstParamData%Jac_Idx_NStC_x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_NStC_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_NStC_x = SrcParamData%Jac_Idx_NStC_x + else if (allocated(DstParamData%Jac_Idx_NStC_x)) then + deallocate(DstParamData%Jac_Idx_NStC_x) + end if + if (allocated(SrcParamData%Jac_Idx_TStC_x)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_TStC_x) + UB(1:2) = ubound(SrcParamData%Jac_Idx_TStC_x) + if (.not. allocated(DstParamData%Jac_Idx_TStC_x)) then + allocate(DstParamData%Jac_Idx_TStC_x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_TStC_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_TStC_x = SrcParamData%Jac_Idx_TStC_x + else if (allocated(DstParamData%Jac_Idx_TStC_x)) then + deallocate(DstParamData%Jac_Idx_TStC_x) + end if + if (allocated(SrcParamData%Jac_Idx_SStC_x)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_SStC_x) + UB(1:2) = ubound(SrcParamData%Jac_Idx_SStC_x) + if (.not. allocated(DstParamData%Jac_Idx_SStC_x)) then + allocate(DstParamData%Jac_Idx_SStC_x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_SStC_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_SStC_x = SrcParamData%Jac_Idx_SStC_x + else if (allocated(DstParamData%Jac_Idx_SStC_x)) then + deallocate(DstParamData%Jac_Idx_SStC_x) + end if + if (allocated(SrcParamData%Jac_Idx_BStC_y)) then + LB(1:3) = lbound(SrcParamData%Jac_Idx_BStC_y) + UB(1:3) = ubound(SrcParamData%Jac_Idx_BStC_y) + if (.not. allocated(DstParamData%Jac_Idx_BStC_y)) then + allocate(DstParamData%Jac_Idx_BStC_y(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_BStC_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_BStC_y = SrcParamData%Jac_Idx_BStC_y + else if (allocated(DstParamData%Jac_Idx_BStC_y)) then + deallocate(DstParamData%Jac_Idx_BStC_y) + end if + if (allocated(SrcParamData%Jac_Idx_NStC_y)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_NStC_y) + UB(1:2) = ubound(SrcParamData%Jac_Idx_NStC_y) + if (.not. allocated(DstParamData%Jac_Idx_NStC_y)) then + allocate(DstParamData%Jac_Idx_NStC_y(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_NStC_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_NStC_y = SrcParamData%Jac_Idx_NStC_y + else if (allocated(DstParamData%Jac_Idx_NStC_y)) then + deallocate(DstParamData%Jac_Idx_NStC_y) + end if + if (allocated(SrcParamData%Jac_Idx_TStC_y)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_TStC_y) + UB(1:2) = ubound(SrcParamData%Jac_Idx_TStC_y) + if (.not. allocated(DstParamData%Jac_Idx_TStC_y)) then + allocate(DstParamData%Jac_Idx_TStC_y(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_TStC_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_TStC_y = SrcParamData%Jac_Idx_TStC_y + else if (allocated(DstParamData%Jac_Idx_TStC_y)) then + deallocate(DstParamData%Jac_Idx_TStC_y) + end if + if (allocated(SrcParamData%Jac_Idx_SStC_y)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_SStC_y) + UB(1:2) = ubound(SrcParamData%Jac_Idx_SStC_y) + if (.not. allocated(DstParamData%Jac_Idx_SStC_y)) then + allocate(DstParamData%Jac_Idx_SStC_y(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_SStC_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_SStC_y = SrcParamData%Jac_Idx_SStC_y + else if (allocated(DstParamData%Jac_Idx_SStC_y)) then + deallocate(DstParamData%Jac_Idx_SStC_y) + end if + DstParamData%SensorType = SrcParamData%SensorType + DstParamData%NumBeam = SrcParamData%NumBeam + DstParamData%NumPulseGate = SrcParamData%NumPulseGate + DstParamData%PulseSpacing = SrcParamData%PulseSpacing + DstParamData%URefLid = SrcParamData%URefLid +end subroutine +subroutine SrvD_DestroyParam(ParamData, ErrStat, ErrMsg) + type(SrvD_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2, i3 + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%BlPitchInit)) then + deallocate(ParamData%BlPitchInit) + end if + if (allocated(ParamData%BlPitchF)) then + deallocate(ParamData%BlPitchF) + end if + if (allocated(ParamData%PitManRat)) then + deallocate(ParamData%PitManRat) + end if + if (allocated(ParamData%TPitManS)) then + deallocate(ParamData%TPitManS) + end if + if (allocated(ParamData%TBDepISp)) then + deallocate(ParamData%TBDepISp) + end if + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%OutParam) + end if + if (allocated(ParamData%BStC)) then + LB(1:1) = lbound(ParamData%BStC) + UB(1:1) = ubound(ParamData%BStC) + do i1 = LB(1), UB(1) + call StC_DestroyParam(ParamData%BStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%BStC) + end if + if (allocated(ParamData%NStC)) then + LB(1:1) = lbound(ParamData%NStC) + UB(1:1) = ubound(ParamData%NStC) + do i1 = LB(1), UB(1) + call StC_DestroyParam(ParamData%NStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%NStC) + end if + if (allocated(ParamData%TStC)) then + LB(1:1) = lbound(ParamData%TStC) + UB(1:1) = ubound(ParamData%TStC) + do i1 = LB(1), UB(1) + call StC_DestroyParam(ParamData%TStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%TStC) + end if + if (allocated(ParamData%SStC)) then + LB(1:1) = lbound(ParamData%SStC) + UB(1:1) = ubound(ParamData%SStC) + do i1 = LB(1), UB(1) + call StC_DestroyParam(ParamData%SStC(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%SStC) + end if + if (allocated(ParamData%StCMeasNumPerChan)) then + deallocate(ParamData%StCMeasNumPerChan) + end if + if (allocated(ParamData%Jac_u_indx)) then + deallocate(ParamData%Jac_u_indx) + end if + if (allocated(ParamData%Jac_x_indx)) then + deallocate(ParamData%Jac_x_indx) + end if + if (allocated(ParamData%du)) then + deallocate(ParamData%du) + end if + if (allocated(ParamData%dx)) then + deallocate(ParamData%dx) + end if + if (allocated(ParamData%Jac_Idx_BStC_u)) then + deallocate(ParamData%Jac_Idx_BStC_u) + end if + if (allocated(ParamData%Jac_Idx_NStC_u)) then + deallocate(ParamData%Jac_Idx_NStC_u) + end if + if (allocated(ParamData%Jac_Idx_TStC_u)) then + deallocate(ParamData%Jac_Idx_TStC_u) + end if + if (allocated(ParamData%Jac_Idx_SStC_u)) then + deallocate(ParamData%Jac_Idx_SStC_u) + end if + if (allocated(ParamData%Jac_Idx_BStC_x)) then + deallocate(ParamData%Jac_Idx_BStC_x) + end if + if (allocated(ParamData%Jac_Idx_NStC_x)) then + deallocate(ParamData%Jac_Idx_NStC_x) + end if + if (allocated(ParamData%Jac_Idx_TStC_x)) then + deallocate(ParamData%Jac_Idx_TStC_x) + end if + if (allocated(ParamData%Jac_Idx_SStC_x)) then + deallocate(ParamData%Jac_Idx_SStC_x) + end if + if (allocated(ParamData%Jac_Idx_BStC_y)) then + deallocate(ParamData%Jac_Idx_BStC_y) + end if + if (allocated(ParamData%Jac_Idx_NStC_y)) then + deallocate(ParamData%Jac_Idx_NStC_y) + end if + if (allocated(ParamData%Jac_Idx_TStC_y)) then + deallocate(ParamData%Jac_Idx_TStC_y) + end if + if (allocated(ParamData%Jac_Idx_SStC_y)) then + deallocate(ParamData%Jac_Idx_SStC_y) + end if +end subroutine subroutine SrvD_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -7307,249 +6888,174 @@ subroutine SrvD_PackParam(Buf, Indata) integer(IntKi) :: i1, i2, i3 integer(IntKi) :: LB(3), UB(3) if (Buf%ErrStat >= AbortErrLev) return - ! DT call RegPack(Buf, InData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! HSSBrDT call RegPack(Buf, InData%HSSBrDT) if (RegCheckErr(Buf, RoutineName)) return - ! HSSBrTqF call RegPack(Buf, InData%HSSBrTqF) if (RegCheckErr(Buf, RoutineName)) return - ! SIG_POSl call RegPack(Buf, InData%SIG_POSl) if (RegCheckErr(Buf, RoutineName)) return - ! SIG_POTq call RegPack(Buf, InData%SIG_POTq) if (RegCheckErr(Buf, RoutineName)) return - ! SIG_SlPc call RegPack(Buf, InData%SIG_SlPc) if (RegCheckErr(Buf, RoutineName)) return - ! SIG_Slop call RegPack(Buf, InData%SIG_Slop) if (RegCheckErr(Buf, RoutineName)) return - ! SIG_SySp call RegPack(Buf, InData%SIG_SySp) if (RegCheckErr(Buf, RoutineName)) return - ! TEC_A0 call RegPack(Buf, InData%TEC_A0) if (RegCheckErr(Buf, RoutineName)) return - ! TEC_C0 call RegPack(Buf, InData%TEC_C0) if (RegCheckErr(Buf, RoutineName)) return - ! TEC_C1 call RegPack(Buf, InData%TEC_C1) if (RegCheckErr(Buf, RoutineName)) return - ! TEC_C2 call RegPack(Buf, InData%TEC_C2) if (RegCheckErr(Buf, RoutineName)) return - ! TEC_K2 call RegPack(Buf, InData%TEC_K2) if (RegCheckErr(Buf, RoutineName)) return - ! TEC_MR call RegPack(Buf, InData%TEC_MR) if (RegCheckErr(Buf, RoutineName)) return - ! TEC_Re1 call RegPack(Buf, InData%TEC_Re1) if (RegCheckErr(Buf, RoutineName)) return - ! TEC_RLR call RegPack(Buf, InData%TEC_RLR) if (RegCheckErr(Buf, RoutineName)) return - ! TEC_RRes call RegPack(Buf, InData%TEC_RRes) if (RegCheckErr(Buf, RoutineName)) return - ! TEC_SRes call RegPack(Buf, InData%TEC_SRes) if (RegCheckErr(Buf, RoutineName)) return - ! TEC_SySp call RegPack(Buf, InData%TEC_SySp) if (RegCheckErr(Buf, RoutineName)) return - ! TEC_V1a call RegPack(Buf, InData%TEC_V1a) if (RegCheckErr(Buf, RoutineName)) return - ! TEC_VLL call RegPack(Buf, InData%TEC_VLL) if (RegCheckErr(Buf, RoutineName)) return - ! TEC_Xe1 call RegPack(Buf, InData%TEC_Xe1) if (RegCheckErr(Buf, RoutineName)) return - ! GenEff call RegPack(Buf, InData%GenEff) if (RegCheckErr(Buf, RoutineName)) return - ! BlPitchInit call RegPack(Buf, allocated(InData%BlPitchInit)) if (allocated(InData%BlPitchInit)) then call RegPackBounds(Buf, 1, lbound(InData%BlPitchInit), ubound(InData%BlPitchInit)) call RegPack(Buf, InData%BlPitchInit) end if if (RegCheckErr(Buf, RoutineName)) return - ! BlPitchF call RegPack(Buf, allocated(InData%BlPitchF)) if (allocated(InData%BlPitchF)) then call RegPackBounds(Buf, 1, lbound(InData%BlPitchF), ubound(InData%BlPitchF)) call RegPack(Buf, InData%BlPitchF) end if if (RegCheckErr(Buf, RoutineName)) return - ! PitManRat call RegPack(Buf, allocated(InData%PitManRat)) if (allocated(InData%PitManRat)) then call RegPackBounds(Buf, 1, lbound(InData%PitManRat), ubound(InData%PitManRat)) call RegPack(Buf, InData%PitManRat) end if if (RegCheckErr(Buf, RoutineName)) return - ! YawManRat call RegPack(Buf, InData%YawManRat) if (RegCheckErr(Buf, RoutineName)) return - ! NacYawF call RegPack(Buf, InData%NacYawF) if (RegCheckErr(Buf, RoutineName)) return - ! SpdGenOn call RegPack(Buf, InData%SpdGenOn) if (RegCheckErr(Buf, RoutineName)) return - ! THSSBrDp call RegPack(Buf, InData%THSSBrDp) if (RegCheckErr(Buf, RoutineName)) return - ! THSSBrFl call RegPack(Buf, InData%THSSBrFl) if (RegCheckErr(Buf, RoutineName)) return - ! TimGenOf call RegPack(Buf, InData%TimGenOf) if (RegCheckErr(Buf, RoutineName)) return - ! TimGenOn call RegPack(Buf, InData%TimGenOn) if (RegCheckErr(Buf, RoutineName)) return - ! TPCOn call RegPack(Buf, InData%TPCOn) if (RegCheckErr(Buf, RoutineName)) return - ! TPitManS call RegPack(Buf, allocated(InData%TPitManS)) if (allocated(InData%TPitManS)) then call RegPackBounds(Buf, 1, lbound(InData%TPitManS), ubound(InData%TPitManS)) call RegPack(Buf, InData%TPitManS) end if if (RegCheckErr(Buf, RoutineName)) return - ! TYawManS call RegPack(Buf, InData%TYawManS) if (RegCheckErr(Buf, RoutineName)) return - ! TYCOn call RegPack(Buf, InData%TYCOn) if (RegCheckErr(Buf, RoutineName)) return - ! VS_RtGnSp call RegPack(Buf, InData%VS_RtGnSp) if (RegCheckErr(Buf, RoutineName)) return - ! VS_RtTq call RegPack(Buf, InData%VS_RtTq) if (RegCheckErr(Buf, RoutineName)) return - ! VS_Slope call RegPack(Buf, InData%VS_Slope) if (RegCheckErr(Buf, RoutineName)) return - ! VS_SlPc call RegPack(Buf, InData%VS_SlPc) if (RegCheckErr(Buf, RoutineName)) return - ! VS_SySp call RegPack(Buf, InData%VS_SySp) if (RegCheckErr(Buf, RoutineName)) return - ! VS_TrGnSp call RegPack(Buf, InData%VS_TrGnSp) if (RegCheckErr(Buf, RoutineName)) return - ! YawPosCom call RegPack(Buf, InData%YawPosCom) if (RegCheckErr(Buf, RoutineName)) return - ! YawRateCom call RegPack(Buf, InData%YawRateCom) if (RegCheckErr(Buf, RoutineName)) return - ! GenModel call RegPack(Buf, InData%GenModel) if (RegCheckErr(Buf, RoutineName)) return - ! HSSBrMode call RegPack(Buf, InData%HSSBrMode) if (RegCheckErr(Buf, RoutineName)) return - ! PCMode call RegPack(Buf, InData%PCMode) if (RegCheckErr(Buf, RoutineName)) return - ! VSContrl call RegPack(Buf, InData%VSContrl) if (RegCheckErr(Buf, RoutineName)) return - ! YCMode call RegPack(Buf, InData%YCMode) if (RegCheckErr(Buf, RoutineName)) return - ! GenTiStp call RegPack(Buf, InData%GenTiStp) if (RegCheckErr(Buf, RoutineName)) return - ! GenTiStr call RegPack(Buf, InData%GenTiStr) if (RegCheckErr(Buf, RoutineName)) return - ! VS_Rgn2K call RegPack(Buf, InData%VS_Rgn2K) if (RegCheckErr(Buf, RoutineName)) return - ! YawNeut call RegPack(Buf, InData%YawNeut) if (RegCheckErr(Buf, RoutineName)) return - ! YawSpr call RegPack(Buf, InData%YawSpr) if (RegCheckErr(Buf, RoutineName)) return - ! YawDamp call RegPack(Buf, InData%YawDamp) if (RegCheckErr(Buf, RoutineName)) return - ! TpBrDT call RegPack(Buf, InData%TpBrDT) if (RegCheckErr(Buf, RoutineName)) return - ! TBDepISp call RegPack(Buf, allocated(InData%TBDepISp)) if (allocated(InData%TBDepISp)) then call RegPackBounds(Buf, 1, lbound(InData%TBDepISp), ubound(InData%TBDepISp)) call RegPack(Buf, InData%TBDepISp) end if if (RegCheckErr(Buf, RoutineName)) return - ! TBDrConN call RegPack(Buf, InData%TBDrConN) if (RegCheckErr(Buf, RoutineName)) return - ! TBDrConD call RegPack(Buf, InData%TBDrConD) if (RegCheckErr(Buf, RoutineName)) return - ! NumBl call RegPack(Buf, InData%NumBl) if (RegCheckErr(Buf, RoutineName)) return - ! NumBStC call RegPack(Buf, InData%NumBStC) if (RegCheckErr(Buf, RoutineName)) return - ! NumNStC call RegPack(Buf, InData%NumNStC) if (RegCheckErr(Buf, RoutineName)) return - ! NumTStC call RegPack(Buf, InData%NumTStC) if (RegCheckErr(Buf, RoutineName)) return - ! NumSStC call RegPack(Buf, InData%NumSStC) if (RegCheckErr(Buf, RoutineName)) return - ! AfCmode call RegPack(Buf, InData%AfCmode) if (RegCheckErr(Buf, RoutineName)) return - ! AfC_Mean call RegPack(Buf, InData%AfC_Mean) if (RegCheckErr(Buf, RoutineName)) return - ! AfC_Amp call RegPack(Buf, InData%AfC_Amp) if (RegCheckErr(Buf, RoutineName)) return - ! AfC_Phase call RegPack(Buf, InData%AfC_Phase) if (RegCheckErr(Buf, RoutineName)) return - ! CCmode call RegPack(Buf, InData%CCmode) if (RegCheckErr(Buf, RoutineName)) return - ! StCCmode call RegPack(Buf, InData%StCCmode) if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegPack(Buf, InData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts_DLL call RegPack(Buf, InData%NumOuts_DLL) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegPack(Buf, InData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! OutParam call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) @@ -7560,49 +7066,34 @@ subroutine SrvD_PackParam(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! Delim call RegPack(Buf, InData%Delim) if (RegCheckErr(Buf, RoutineName)) return - ! UseBladedInterface call RegPack(Buf, InData%UseBladedInterface) if (RegCheckErr(Buf, RoutineName)) return - ! UseLegacyInterface call RegPack(Buf, InData%UseLegacyInterface) if (RegCheckErr(Buf, RoutineName)) return - ! DLL_Trgt call DLLTypePack(Buf, InData%DLL_Trgt) if (RegCheckErr(Buf, RoutineName)) return - ! DLL_Ramp call RegPack(Buf, InData%DLL_Ramp) if (RegCheckErr(Buf, RoutineName)) return - ! BlAlpha call RegPack(Buf, InData%BlAlpha) if (RegCheckErr(Buf, RoutineName)) return - ! DLL_n call RegPack(Buf, InData%DLL_n) if (RegCheckErr(Buf, RoutineName)) return - ! avcOUTNAME_LEN call RegPack(Buf, InData%avcOUTNAME_LEN) if (RegCheckErr(Buf, RoutineName)) return - ! NacYaw_North call RegPack(Buf, InData%NacYaw_North) if (RegCheckErr(Buf, RoutineName)) return - ! AvgWindSpeed call RegPack(Buf, InData%AvgWindSpeed) if (RegCheckErr(Buf, RoutineName)) return - ! AirDens call RegPack(Buf, InData%AirDens) if (RegCheckErr(Buf, RoutineName)) return - ! TrimCase call RegPack(Buf, InData%TrimCase) if (RegCheckErr(Buf, RoutineName)) return - ! TrimGain call RegPack(Buf, InData%TrimGain) if (RegCheckErr(Buf, RoutineName)) return - ! RotSpeedRef call RegPack(Buf, InData%RotSpeedRef) if (RegCheckErr(Buf, RoutineName)) return - ! BStC call RegPack(Buf, allocated(InData%BStC)) if (allocated(InData%BStC)) then call RegPackBounds(Buf, 1, lbound(InData%BStC), ubound(InData%BStC)) @@ -7613,7 +7104,6 @@ subroutine SrvD_PackParam(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! NStC call RegPack(Buf, allocated(InData%NStC)) if (allocated(InData%NStC)) then call RegPackBounds(Buf, 1, lbound(InData%NStC), ubound(InData%NStC)) @@ -7624,7 +7114,6 @@ subroutine SrvD_PackParam(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! TStC call RegPack(Buf, allocated(InData%TStC)) if (allocated(InData%TStC)) then call RegPackBounds(Buf, 1, lbound(InData%TStC), ubound(InData%TStC)) @@ -7635,7 +7124,6 @@ subroutine SrvD_PackParam(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! SStC call RegPack(Buf, allocated(InData%SStC)) if (allocated(InData%SStC)) then call RegPackBounds(Buf, 1, lbound(InData%SStC), ubound(InData%SStC)) @@ -7646,162 +7134,132 @@ subroutine SrvD_PackParam(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! InterpOrder call RegPack(Buf, InData%InterpOrder) if (RegCheckErr(Buf, RoutineName)) return - ! EXavrSWAP call RegPack(Buf, InData%EXavrSWAP) if (RegCheckErr(Buf, RoutineName)) return - ! NumCableControl call RegPack(Buf, InData%NumCableControl) if (RegCheckErr(Buf, RoutineName)) return - ! NumStC_Control call RegPack(Buf, InData%NumStC_Control) if (RegCheckErr(Buf, RoutineName)) return - ! StCMeasNumPerChan call RegPack(Buf, allocated(InData%StCMeasNumPerChan)) if (allocated(InData%StCMeasNumPerChan)) then call RegPackBounds(Buf, 1, lbound(InData%StCMeasNumPerChan), ubound(InData%StCMeasNumPerChan)) call RegPack(Buf, InData%StCMeasNumPerChan) end if if (RegCheckErr(Buf, RoutineName)) return - ! UseSC call RegPack(Buf, InData%UseSC) if (RegCheckErr(Buf, RoutineName)) return - ! Jac_u_indx call RegPack(Buf, allocated(InData%Jac_u_indx)) if (allocated(InData%Jac_u_indx)) then call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx), ubound(InData%Jac_u_indx)) call RegPack(Buf, InData%Jac_u_indx) end if if (RegCheckErr(Buf, RoutineName)) return - ! Jac_x_indx call RegPack(Buf, allocated(InData%Jac_x_indx)) if (allocated(InData%Jac_x_indx)) then call RegPackBounds(Buf, 2, lbound(InData%Jac_x_indx), ubound(InData%Jac_x_indx)) call RegPack(Buf, InData%Jac_x_indx) end if if (RegCheckErr(Buf, RoutineName)) return - ! du call RegPack(Buf, allocated(InData%du)) if (allocated(InData%du)) then call RegPackBounds(Buf, 1, lbound(InData%du), ubound(InData%du)) call RegPack(Buf, InData%du) end if if (RegCheckErr(Buf, RoutineName)) return - ! dx call RegPack(Buf, allocated(InData%dx)) if (allocated(InData%dx)) then call RegPackBounds(Buf, 1, lbound(InData%dx), ubound(InData%dx)) call RegPack(Buf, InData%dx) end if if (RegCheckErr(Buf, RoutineName)) return - ! Jac_nu call RegPack(Buf, InData%Jac_nu) if (RegCheckErr(Buf, RoutineName)) return - ! Jac_ny call RegPack(Buf, InData%Jac_ny) if (RegCheckErr(Buf, RoutineName)) return - ! Jac_nx call RegPack(Buf, InData%Jac_nx) if (RegCheckErr(Buf, RoutineName)) return - ! Jac_Idx_BStC_u call RegPack(Buf, allocated(InData%Jac_Idx_BStC_u)) if (allocated(InData%Jac_Idx_BStC_u)) then call RegPackBounds(Buf, 3, lbound(InData%Jac_Idx_BStC_u), ubound(InData%Jac_Idx_BStC_u)) call RegPack(Buf, InData%Jac_Idx_BStC_u) end if if (RegCheckErr(Buf, RoutineName)) return - ! Jac_Idx_NStC_u call RegPack(Buf, allocated(InData%Jac_Idx_NStC_u)) if (allocated(InData%Jac_Idx_NStC_u)) then call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_NStC_u), ubound(InData%Jac_Idx_NStC_u)) call RegPack(Buf, InData%Jac_Idx_NStC_u) end if if (RegCheckErr(Buf, RoutineName)) return - ! Jac_Idx_TStC_u call RegPack(Buf, allocated(InData%Jac_Idx_TStC_u)) if (allocated(InData%Jac_Idx_TStC_u)) then call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_TStC_u), ubound(InData%Jac_Idx_TStC_u)) call RegPack(Buf, InData%Jac_Idx_TStC_u) end if if (RegCheckErr(Buf, RoutineName)) return - ! Jac_Idx_SStC_u call RegPack(Buf, allocated(InData%Jac_Idx_SStC_u)) if (allocated(InData%Jac_Idx_SStC_u)) then call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_SStC_u), ubound(InData%Jac_Idx_SStC_u)) call RegPack(Buf, InData%Jac_Idx_SStC_u) end if if (RegCheckErr(Buf, RoutineName)) return - ! Jac_Idx_BStC_x call RegPack(Buf, allocated(InData%Jac_Idx_BStC_x)) if (allocated(InData%Jac_Idx_BStC_x)) then call RegPackBounds(Buf, 3, lbound(InData%Jac_Idx_BStC_x), ubound(InData%Jac_Idx_BStC_x)) call RegPack(Buf, InData%Jac_Idx_BStC_x) end if if (RegCheckErr(Buf, RoutineName)) return - ! Jac_Idx_NStC_x call RegPack(Buf, allocated(InData%Jac_Idx_NStC_x)) if (allocated(InData%Jac_Idx_NStC_x)) then call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_NStC_x), ubound(InData%Jac_Idx_NStC_x)) call RegPack(Buf, InData%Jac_Idx_NStC_x) end if if (RegCheckErr(Buf, RoutineName)) return - ! Jac_Idx_TStC_x call RegPack(Buf, allocated(InData%Jac_Idx_TStC_x)) if (allocated(InData%Jac_Idx_TStC_x)) then call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_TStC_x), ubound(InData%Jac_Idx_TStC_x)) call RegPack(Buf, InData%Jac_Idx_TStC_x) end if if (RegCheckErr(Buf, RoutineName)) return - ! Jac_Idx_SStC_x call RegPack(Buf, allocated(InData%Jac_Idx_SStC_x)) if (allocated(InData%Jac_Idx_SStC_x)) then call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_SStC_x), ubound(InData%Jac_Idx_SStC_x)) call RegPack(Buf, InData%Jac_Idx_SStC_x) end if if (RegCheckErr(Buf, RoutineName)) return - ! Jac_Idx_BStC_y call RegPack(Buf, allocated(InData%Jac_Idx_BStC_y)) if (allocated(InData%Jac_Idx_BStC_y)) then call RegPackBounds(Buf, 3, lbound(InData%Jac_Idx_BStC_y), ubound(InData%Jac_Idx_BStC_y)) call RegPack(Buf, InData%Jac_Idx_BStC_y) end if if (RegCheckErr(Buf, RoutineName)) return - ! Jac_Idx_NStC_y call RegPack(Buf, allocated(InData%Jac_Idx_NStC_y)) if (allocated(InData%Jac_Idx_NStC_y)) then call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_NStC_y), ubound(InData%Jac_Idx_NStC_y)) call RegPack(Buf, InData%Jac_Idx_NStC_y) end if if (RegCheckErr(Buf, RoutineName)) return - ! Jac_Idx_TStC_y call RegPack(Buf, allocated(InData%Jac_Idx_TStC_y)) if (allocated(InData%Jac_Idx_TStC_y)) then call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_TStC_y), ubound(InData%Jac_Idx_TStC_y)) call RegPack(Buf, InData%Jac_Idx_TStC_y) end if if (RegCheckErr(Buf, RoutineName)) return - ! Jac_Idx_SStC_y call RegPack(Buf, allocated(InData%Jac_Idx_SStC_y)) if (allocated(InData%Jac_Idx_SStC_y)) then call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_SStC_y), ubound(InData%Jac_Idx_SStC_y)) call RegPack(Buf, InData%Jac_Idx_SStC_y) end if if (RegCheckErr(Buf, RoutineName)) return - ! SensorType call RegPack(Buf, InData%SensorType) if (RegCheckErr(Buf, RoutineName)) return - ! NumBeam call RegPack(Buf, InData%NumBeam) if (RegCheckErr(Buf, RoutineName)) return - ! NumPulseGate call RegPack(Buf, InData%NumPulseGate) if (RegCheckErr(Buf, RoutineName)) return - ! PulseSpacing call RegPack(Buf, InData%PulseSpacing) if (RegCheckErr(Buf, RoutineName)) return - ! URefLid call RegPack(Buf, InData%URefLid) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -7815,76 +7273,52 @@ subroutine SrvD_UnPackParam(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! DT call RegUnpack(Buf, OutData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! HSSBrDT call RegUnpack(Buf, OutData%HSSBrDT) if (RegCheckErr(Buf, RoutineName)) return - ! HSSBrTqF call RegUnpack(Buf, OutData%HSSBrTqF) if (RegCheckErr(Buf, RoutineName)) return - ! SIG_POSl call RegUnpack(Buf, OutData%SIG_POSl) if (RegCheckErr(Buf, RoutineName)) return - ! SIG_POTq call RegUnpack(Buf, OutData%SIG_POTq) if (RegCheckErr(Buf, RoutineName)) return - ! SIG_SlPc call RegUnpack(Buf, OutData%SIG_SlPc) if (RegCheckErr(Buf, RoutineName)) return - ! SIG_Slop call RegUnpack(Buf, OutData%SIG_Slop) if (RegCheckErr(Buf, RoutineName)) return - ! SIG_SySp call RegUnpack(Buf, OutData%SIG_SySp) if (RegCheckErr(Buf, RoutineName)) return - ! TEC_A0 call RegUnpack(Buf, OutData%TEC_A0) if (RegCheckErr(Buf, RoutineName)) return - ! TEC_C0 call RegUnpack(Buf, OutData%TEC_C0) if (RegCheckErr(Buf, RoutineName)) return - ! TEC_C1 call RegUnpack(Buf, OutData%TEC_C1) if (RegCheckErr(Buf, RoutineName)) return - ! TEC_C2 call RegUnpack(Buf, OutData%TEC_C2) if (RegCheckErr(Buf, RoutineName)) return - ! TEC_K2 call RegUnpack(Buf, OutData%TEC_K2) if (RegCheckErr(Buf, RoutineName)) return - ! TEC_MR call RegUnpack(Buf, OutData%TEC_MR) if (RegCheckErr(Buf, RoutineName)) return - ! TEC_Re1 call RegUnpack(Buf, OutData%TEC_Re1) if (RegCheckErr(Buf, RoutineName)) return - ! TEC_RLR call RegUnpack(Buf, OutData%TEC_RLR) if (RegCheckErr(Buf, RoutineName)) return - ! TEC_RRes call RegUnpack(Buf, OutData%TEC_RRes) if (RegCheckErr(Buf, RoutineName)) return - ! TEC_SRes call RegUnpack(Buf, OutData%TEC_SRes) if (RegCheckErr(Buf, RoutineName)) return - ! TEC_SySp call RegUnpack(Buf, OutData%TEC_SySp) if (RegCheckErr(Buf, RoutineName)) return - ! TEC_V1a call RegUnpack(Buf, OutData%TEC_V1a) if (RegCheckErr(Buf, RoutineName)) return - ! TEC_VLL call RegUnpack(Buf, OutData%TEC_VLL) if (RegCheckErr(Buf, RoutineName)) return - ! TEC_Xe1 call RegUnpack(Buf, OutData%TEC_Xe1) if (RegCheckErr(Buf, RoutineName)) return - ! GenEff call RegUnpack(Buf, OutData%GenEff) if (RegCheckErr(Buf, RoutineName)) return - ! BlPitchInit if (allocated(OutData%BlPitchInit)) deallocate(OutData%BlPitchInit) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7899,7 +7333,6 @@ subroutine SrvD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%BlPitchInit) if (RegCheckErr(Buf, RoutineName)) return end if - ! BlPitchF if (allocated(OutData%BlPitchF)) deallocate(OutData%BlPitchF) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7914,7 +7347,6 @@ subroutine SrvD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%BlPitchF) if (RegCheckErr(Buf, RoutineName)) return end if - ! PitManRat if (allocated(OutData%PitManRat)) deallocate(OutData%PitManRat) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7929,31 +7361,22 @@ subroutine SrvD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%PitManRat) if (RegCheckErr(Buf, RoutineName)) return end if - ! YawManRat call RegUnpack(Buf, OutData%YawManRat) if (RegCheckErr(Buf, RoutineName)) return - ! NacYawF call RegUnpack(Buf, OutData%NacYawF) if (RegCheckErr(Buf, RoutineName)) return - ! SpdGenOn call RegUnpack(Buf, OutData%SpdGenOn) if (RegCheckErr(Buf, RoutineName)) return - ! THSSBrDp call RegUnpack(Buf, OutData%THSSBrDp) if (RegCheckErr(Buf, RoutineName)) return - ! THSSBrFl call RegUnpack(Buf, OutData%THSSBrFl) if (RegCheckErr(Buf, RoutineName)) return - ! TimGenOf call RegUnpack(Buf, OutData%TimGenOf) if (RegCheckErr(Buf, RoutineName)) return - ! TimGenOn call RegUnpack(Buf, OutData%TimGenOn) if (RegCheckErr(Buf, RoutineName)) return - ! TPCOn call RegUnpack(Buf, OutData%TPCOn) if (RegCheckErr(Buf, RoutineName)) return - ! TPitManS if (allocated(OutData%TPitManS)) deallocate(OutData%TPitManS) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7968,73 +7391,50 @@ subroutine SrvD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%TPitManS) if (RegCheckErr(Buf, RoutineName)) return end if - ! TYawManS call RegUnpack(Buf, OutData%TYawManS) if (RegCheckErr(Buf, RoutineName)) return - ! TYCOn call RegUnpack(Buf, OutData%TYCOn) if (RegCheckErr(Buf, RoutineName)) return - ! VS_RtGnSp call RegUnpack(Buf, OutData%VS_RtGnSp) if (RegCheckErr(Buf, RoutineName)) return - ! VS_RtTq call RegUnpack(Buf, OutData%VS_RtTq) if (RegCheckErr(Buf, RoutineName)) return - ! VS_Slope call RegUnpack(Buf, OutData%VS_Slope) if (RegCheckErr(Buf, RoutineName)) return - ! VS_SlPc call RegUnpack(Buf, OutData%VS_SlPc) if (RegCheckErr(Buf, RoutineName)) return - ! VS_SySp call RegUnpack(Buf, OutData%VS_SySp) if (RegCheckErr(Buf, RoutineName)) return - ! VS_TrGnSp call RegUnpack(Buf, OutData%VS_TrGnSp) if (RegCheckErr(Buf, RoutineName)) return - ! YawPosCom call RegUnpack(Buf, OutData%YawPosCom) if (RegCheckErr(Buf, RoutineName)) return - ! YawRateCom call RegUnpack(Buf, OutData%YawRateCom) if (RegCheckErr(Buf, RoutineName)) return - ! GenModel call RegUnpack(Buf, OutData%GenModel) if (RegCheckErr(Buf, RoutineName)) return - ! HSSBrMode call RegUnpack(Buf, OutData%HSSBrMode) if (RegCheckErr(Buf, RoutineName)) return - ! PCMode call RegUnpack(Buf, OutData%PCMode) if (RegCheckErr(Buf, RoutineName)) return - ! VSContrl call RegUnpack(Buf, OutData%VSContrl) if (RegCheckErr(Buf, RoutineName)) return - ! YCMode call RegUnpack(Buf, OutData%YCMode) if (RegCheckErr(Buf, RoutineName)) return - ! GenTiStp call RegUnpack(Buf, OutData%GenTiStp) if (RegCheckErr(Buf, RoutineName)) return - ! GenTiStr call RegUnpack(Buf, OutData%GenTiStr) if (RegCheckErr(Buf, RoutineName)) return - ! VS_Rgn2K call RegUnpack(Buf, OutData%VS_Rgn2K) if (RegCheckErr(Buf, RoutineName)) return - ! YawNeut call RegUnpack(Buf, OutData%YawNeut) if (RegCheckErr(Buf, RoutineName)) return - ! YawSpr call RegUnpack(Buf, OutData%YawSpr) if (RegCheckErr(Buf, RoutineName)) return - ! YawDamp call RegUnpack(Buf, OutData%YawDamp) if (RegCheckErr(Buf, RoutineName)) return - ! TpBrDT call RegUnpack(Buf, OutData%TpBrDT) if (RegCheckErr(Buf, RoutineName)) return - ! TBDepISp if (allocated(OutData%TBDepISp)) deallocate(OutData%TBDepISp) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8049,55 +7449,38 @@ subroutine SrvD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%TBDepISp) if (RegCheckErr(Buf, RoutineName)) return end if - ! TBDrConN call RegUnpack(Buf, OutData%TBDrConN) if (RegCheckErr(Buf, RoutineName)) return - ! TBDrConD call RegUnpack(Buf, OutData%TBDrConD) if (RegCheckErr(Buf, RoutineName)) return - ! NumBl call RegUnpack(Buf, OutData%NumBl) if (RegCheckErr(Buf, RoutineName)) return - ! NumBStC call RegUnpack(Buf, OutData%NumBStC) if (RegCheckErr(Buf, RoutineName)) return - ! NumNStC call RegUnpack(Buf, OutData%NumNStC) if (RegCheckErr(Buf, RoutineName)) return - ! NumTStC call RegUnpack(Buf, OutData%NumTStC) if (RegCheckErr(Buf, RoutineName)) return - ! NumSStC call RegUnpack(Buf, OutData%NumSStC) if (RegCheckErr(Buf, RoutineName)) return - ! AfCmode call RegUnpack(Buf, OutData%AfCmode) if (RegCheckErr(Buf, RoutineName)) return - ! AfC_Mean call RegUnpack(Buf, OutData%AfC_Mean) if (RegCheckErr(Buf, RoutineName)) return - ! AfC_Amp call RegUnpack(Buf, OutData%AfC_Amp) if (RegCheckErr(Buf, RoutineName)) return - ! AfC_Phase call RegUnpack(Buf, OutData%AfC_Phase) if (RegCheckErr(Buf, RoutineName)) return - ! CCmode call RegUnpack(Buf, OutData%CCmode) if (RegCheckErr(Buf, RoutineName)) return - ! StCCmode call RegUnpack(Buf, OutData%StCCmode) if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegUnpack(Buf, OutData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts_DLL call RegUnpack(Buf, OutData%NumOuts_DLL) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegUnpack(Buf, OutData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! OutParam if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8113,48 +7496,33 @@ subroutine SrvD_UnPackParam(Buf, OutData) call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam end do end if - ! Delim call RegUnpack(Buf, OutData%Delim) if (RegCheckErr(Buf, RoutineName)) return - ! UseBladedInterface call RegUnpack(Buf, OutData%UseBladedInterface) if (RegCheckErr(Buf, RoutineName)) return - ! UseLegacyInterface call RegUnpack(Buf, OutData%UseLegacyInterface) if (RegCheckErr(Buf, RoutineName)) return - ! DLL_Trgt call DLLTypeUnpack(Buf, OutData%DLL_Trgt) ! DLL_Trgt - ! DLL_Ramp call RegUnpack(Buf, OutData%DLL_Ramp) if (RegCheckErr(Buf, RoutineName)) return - ! BlAlpha call RegUnpack(Buf, OutData%BlAlpha) if (RegCheckErr(Buf, RoutineName)) return - ! DLL_n call RegUnpack(Buf, OutData%DLL_n) if (RegCheckErr(Buf, RoutineName)) return - ! avcOUTNAME_LEN call RegUnpack(Buf, OutData%avcOUTNAME_LEN) if (RegCheckErr(Buf, RoutineName)) return - ! NacYaw_North call RegUnpack(Buf, OutData%NacYaw_North) if (RegCheckErr(Buf, RoutineName)) return - ! AvgWindSpeed call RegUnpack(Buf, OutData%AvgWindSpeed) if (RegCheckErr(Buf, RoutineName)) return - ! AirDens call RegUnpack(Buf, OutData%AirDens) if (RegCheckErr(Buf, RoutineName)) return - ! TrimCase call RegUnpack(Buf, OutData%TrimCase) if (RegCheckErr(Buf, RoutineName)) return - ! TrimGain call RegUnpack(Buf, OutData%TrimGain) if (RegCheckErr(Buf, RoutineName)) return - ! RotSpeedRef call RegUnpack(Buf, OutData%RotSpeedRef) if (RegCheckErr(Buf, RoutineName)) return - ! BStC if (allocated(OutData%BStC)) deallocate(OutData%BStC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8170,7 +7538,6 @@ subroutine SrvD_UnPackParam(Buf, OutData) call StC_UnpackParam(Buf, OutData%BStC(i1)) ! BStC end do end if - ! NStC if (allocated(OutData%NStC)) deallocate(OutData%NStC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8186,7 +7553,6 @@ subroutine SrvD_UnPackParam(Buf, OutData) call StC_UnpackParam(Buf, OutData%NStC(i1)) ! NStC end do end if - ! TStC if (allocated(OutData%TStC)) deallocate(OutData%TStC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8202,7 +7568,6 @@ subroutine SrvD_UnPackParam(Buf, OutData) call StC_UnpackParam(Buf, OutData%TStC(i1)) ! TStC end do end if - ! SStC if (allocated(OutData%SStC)) deallocate(OutData%SStC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8218,19 +7583,14 @@ subroutine SrvD_UnPackParam(Buf, OutData) call StC_UnpackParam(Buf, OutData%SStC(i1)) ! SStC end do end if - ! InterpOrder call RegUnpack(Buf, OutData%InterpOrder) if (RegCheckErr(Buf, RoutineName)) return - ! EXavrSWAP call RegUnpack(Buf, OutData%EXavrSWAP) if (RegCheckErr(Buf, RoutineName)) return - ! NumCableControl call RegUnpack(Buf, OutData%NumCableControl) if (RegCheckErr(Buf, RoutineName)) return - ! NumStC_Control call RegUnpack(Buf, OutData%NumStC_Control) if (RegCheckErr(Buf, RoutineName)) return - ! StCMeasNumPerChan if (allocated(OutData%StCMeasNumPerChan)) deallocate(OutData%StCMeasNumPerChan) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8245,10 +7605,8 @@ subroutine SrvD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%StCMeasNumPerChan) if (RegCheckErr(Buf, RoutineName)) return end if - ! UseSC call RegUnpack(Buf, OutData%UseSC) if (RegCheckErr(Buf, RoutineName)) return - ! Jac_u_indx if (allocated(OutData%Jac_u_indx)) deallocate(OutData%Jac_u_indx) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8263,7 +7621,6 @@ subroutine SrvD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%Jac_u_indx) if (RegCheckErr(Buf, RoutineName)) return end if - ! Jac_x_indx if (allocated(OutData%Jac_x_indx)) deallocate(OutData%Jac_x_indx) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8278,7 +7635,6 @@ subroutine SrvD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%Jac_x_indx) if (RegCheckErr(Buf, RoutineName)) return end if - ! du if (allocated(OutData%du)) deallocate(OutData%du) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8293,7 +7649,6 @@ subroutine SrvD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%du) if (RegCheckErr(Buf, RoutineName)) return end if - ! dx if (allocated(OutData%dx)) deallocate(OutData%dx) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8308,16 +7663,12 @@ subroutine SrvD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%dx) if (RegCheckErr(Buf, RoutineName)) return end if - ! Jac_nu call RegUnpack(Buf, OutData%Jac_nu) if (RegCheckErr(Buf, RoutineName)) return - ! Jac_ny call RegUnpack(Buf, OutData%Jac_ny) if (RegCheckErr(Buf, RoutineName)) return - ! Jac_nx call RegUnpack(Buf, OutData%Jac_nx) if (RegCheckErr(Buf, RoutineName)) return - ! Jac_Idx_BStC_u if (allocated(OutData%Jac_Idx_BStC_u)) deallocate(OutData%Jac_Idx_BStC_u) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8332,7 +7683,6 @@ subroutine SrvD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%Jac_Idx_BStC_u) if (RegCheckErr(Buf, RoutineName)) return end if - ! Jac_Idx_NStC_u if (allocated(OutData%Jac_Idx_NStC_u)) deallocate(OutData%Jac_Idx_NStC_u) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8347,7 +7697,6 @@ subroutine SrvD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%Jac_Idx_NStC_u) if (RegCheckErr(Buf, RoutineName)) return end if - ! Jac_Idx_TStC_u if (allocated(OutData%Jac_Idx_TStC_u)) deallocate(OutData%Jac_Idx_TStC_u) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8362,7 +7711,6 @@ subroutine SrvD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%Jac_Idx_TStC_u) if (RegCheckErr(Buf, RoutineName)) return end if - ! Jac_Idx_SStC_u if (allocated(OutData%Jac_Idx_SStC_u)) deallocate(OutData%Jac_Idx_SStC_u) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8377,7 +7725,6 @@ subroutine SrvD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%Jac_Idx_SStC_u) if (RegCheckErr(Buf, RoutineName)) return end if - ! Jac_Idx_BStC_x if (allocated(OutData%Jac_Idx_BStC_x)) deallocate(OutData%Jac_Idx_BStC_x) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8392,7 +7739,6 @@ subroutine SrvD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%Jac_Idx_BStC_x) if (RegCheckErr(Buf, RoutineName)) return end if - ! Jac_Idx_NStC_x if (allocated(OutData%Jac_Idx_NStC_x)) deallocate(OutData%Jac_Idx_NStC_x) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8407,7 +7753,6 @@ subroutine SrvD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%Jac_Idx_NStC_x) if (RegCheckErr(Buf, RoutineName)) return end if - ! Jac_Idx_TStC_x if (allocated(OutData%Jac_Idx_TStC_x)) deallocate(OutData%Jac_Idx_TStC_x) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8422,7 +7767,6 @@ subroutine SrvD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%Jac_Idx_TStC_x) if (RegCheckErr(Buf, RoutineName)) return end if - ! Jac_Idx_SStC_x if (allocated(OutData%Jac_Idx_SStC_x)) deallocate(OutData%Jac_Idx_SStC_x) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8437,7 +7781,6 @@ subroutine SrvD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%Jac_Idx_SStC_x) if (RegCheckErr(Buf, RoutineName)) return end if - ! Jac_Idx_BStC_y if (allocated(OutData%Jac_Idx_BStC_y)) deallocate(OutData%Jac_Idx_BStC_y) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8452,7 +7795,6 @@ subroutine SrvD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%Jac_Idx_BStC_y) if (RegCheckErr(Buf, RoutineName)) return end if - ! Jac_Idx_NStC_y if (allocated(OutData%Jac_Idx_NStC_y)) deallocate(OutData%Jac_Idx_NStC_y) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8467,7 +7809,6 @@ subroutine SrvD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%Jac_Idx_NStC_y) if (RegCheckErr(Buf, RoutineName)) return end if - ! Jac_Idx_TStC_y if (allocated(OutData%Jac_Idx_TStC_y)) deallocate(OutData%Jac_Idx_TStC_y) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8482,7 +7823,6 @@ subroutine SrvD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%Jac_Idx_TStC_y) if (RegCheckErr(Buf, RoutineName)) return end if - ! Jac_Idx_SStC_y if (allocated(OutData%Jac_Idx_SStC_y)) deallocate(OutData%Jac_Idx_SStC_y) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -8497,372 +7837,398 @@ subroutine SrvD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%Jac_Idx_SStC_y) if (RegCheckErr(Buf, RoutineName)) return end if - ! SensorType call RegUnpack(Buf, OutData%SensorType) if (RegCheckErr(Buf, RoutineName)) return - ! NumBeam call RegUnpack(Buf, OutData%NumBeam) if (RegCheckErr(Buf, RoutineName)) return - ! NumPulseGate call RegUnpack(Buf, OutData%NumPulseGate) if (RegCheckErr(Buf, RoutineName)) return - ! PulseSpacing call RegUnpack(Buf, OutData%PulseSpacing) if (RegCheckErr(Buf, RoutineName)) return - ! URefLid call RegUnpack(Buf, OutData%URefLid) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE SrvD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SrvD_InputType), INTENT(INOUT) :: SrcInputData - TYPE(SrvD_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_CopyInput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInputData%BlPitch)) THEN - i1_l = LBOUND(SrcInputData%BlPitch,1) - i1_u = UBOUND(SrcInputData%BlPitch,1) - IF (.NOT. ALLOCATED(DstInputData%BlPitch)) THEN - ALLOCATE(DstInputData%BlPitch(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%BlPitch.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%BlPitch = SrcInputData%BlPitch -ENDIF - DstInputData%Yaw = SrcInputData%Yaw - DstInputData%YawRate = SrcInputData%YawRate - DstInputData%LSS_Spd = SrcInputData%LSS_Spd - DstInputData%HSS_Spd = SrcInputData%HSS_Spd - DstInputData%RotSpeed = SrcInputData%RotSpeed - DstInputData%ExternalYawPosCom = SrcInputData%ExternalYawPosCom - DstInputData%ExternalYawRateCom = SrcInputData%ExternalYawRateCom -IF (ALLOCATED(SrcInputData%ExternalBlPitchCom)) THEN - i1_l = LBOUND(SrcInputData%ExternalBlPitchCom,1) - i1_u = UBOUND(SrcInputData%ExternalBlPitchCom,1) - IF (.NOT. ALLOCATED(DstInputData%ExternalBlPitchCom)) THEN - ALLOCATE(DstInputData%ExternalBlPitchCom(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%ExternalBlPitchCom.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%ExternalBlPitchCom = SrcInputData%ExternalBlPitchCom -ENDIF - DstInputData%ExternalGenTrq = SrcInputData%ExternalGenTrq - DstInputData%ExternalElecPwr = SrcInputData%ExternalElecPwr - DstInputData%ExternalHSSBrFrac = SrcInputData%ExternalHSSBrFrac -IF (ALLOCATED(SrcInputData%ExternalBlAirfoilCom)) THEN - i1_l = LBOUND(SrcInputData%ExternalBlAirfoilCom,1) - i1_u = UBOUND(SrcInputData%ExternalBlAirfoilCom,1) - IF (.NOT. ALLOCATED(DstInputData%ExternalBlAirfoilCom)) THEN - ALLOCATE(DstInputData%ExternalBlAirfoilCom(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%ExternalBlAirfoilCom.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%ExternalBlAirfoilCom = SrcInputData%ExternalBlAirfoilCom -ENDIF -IF (ALLOCATED(SrcInputData%ExternalCableDeltaL)) THEN - i1_l = LBOUND(SrcInputData%ExternalCableDeltaL,1) - i1_u = UBOUND(SrcInputData%ExternalCableDeltaL,1) - IF (.NOT. ALLOCATED(DstInputData%ExternalCableDeltaL)) THEN - ALLOCATE(DstInputData%ExternalCableDeltaL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%ExternalCableDeltaL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%ExternalCableDeltaL = SrcInputData%ExternalCableDeltaL -ENDIF -IF (ALLOCATED(SrcInputData%ExternalCableDeltaLdot)) THEN - i1_l = LBOUND(SrcInputData%ExternalCableDeltaLdot,1) - i1_u = UBOUND(SrcInputData%ExternalCableDeltaLdot,1) - IF (.NOT. ALLOCATED(DstInputData%ExternalCableDeltaLdot)) THEN - ALLOCATE(DstInputData%ExternalCableDeltaLdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%ExternalCableDeltaLdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%ExternalCableDeltaLdot = SrcInputData%ExternalCableDeltaLdot -ENDIF - DstInputData%TwrAccel = SrcInputData%TwrAccel - DstInputData%YawErr = SrcInputData%YawErr - DstInputData%WindDir = SrcInputData%WindDir - DstInputData%RootMyc = SrcInputData%RootMyc - DstInputData%YawBrTAxp = SrcInputData%YawBrTAxp - DstInputData%YawBrTAyp = SrcInputData%YawBrTAyp - DstInputData%LSSTipPxa = SrcInputData%LSSTipPxa - DstInputData%RootMxc = SrcInputData%RootMxc - DstInputData%LSSTipMxa = SrcInputData%LSSTipMxa - DstInputData%LSSTipMya = SrcInputData%LSSTipMya - DstInputData%LSSTipMza = SrcInputData%LSSTipMza - DstInputData%LSSTipMys = SrcInputData%LSSTipMys - DstInputData%LSSTipMzs = SrcInputData%LSSTipMzs - DstInputData%YawBrMyn = SrcInputData%YawBrMyn - DstInputData%YawBrMzn = SrcInputData%YawBrMzn - DstInputData%NcIMURAxs = SrcInputData%NcIMURAxs - DstInputData%NcIMURAys = SrcInputData%NcIMURAys - DstInputData%NcIMURAzs = SrcInputData%NcIMURAzs - DstInputData%RotPwr = SrcInputData%RotPwr - DstInputData%HorWindV = SrcInputData%HorWindV - DstInputData%YawAngle = SrcInputData%YawAngle - DstInputData%LSShftFxa = SrcInputData%LSShftFxa - DstInputData%LSShftFys = SrcInputData%LSShftFys - DstInputData%LSShftFzs = SrcInputData%LSShftFzs -IF (ALLOCATED(SrcInputData%fromSC)) THEN - i1_l = LBOUND(SrcInputData%fromSC,1) - i1_u = UBOUND(SrcInputData%fromSC,1) - IF (.NOT. ALLOCATED(DstInputData%fromSC)) THEN - ALLOCATE(DstInputData%fromSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%fromSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%fromSC = SrcInputData%fromSC -ENDIF -IF (ALLOCATED(SrcInputData%fromSCglob)) THEN - i1_l = LBOUND(SrcInputData%fromSCglob,1) - i1_u = UBOUND(SrcInputData%fromSCglob,1) - IF (.NOT. ALLOCATED(DstInputData%fromSCglob)) THEN - ALLOCATE(DstInputData%fromSCglob(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%fromSCglob.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%fromSCglob = SrcInputData%fromSCglob -ENDIF -IF (ALLOCATED(SrcInputData%Lidar)) THEN - i1_l = LBOUND(SrcInputData%Lidar,1) - i1_u = UBOUND(SrcInputData%Lidar,1) - IF (.NOT. ALLOCATED(DstInputData%Lidar)) THEN - ALLOCATE(DstInputData%Lidar(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Lidar.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%Lidar = SrcInputData%Lidar -ENDIF - CALL MeshCopy( SrcInputData%PtfmMotionMesh, DstInputData%PtfmMotionMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInputData%BStCMotionMesh)) THEN - i1_l = LBOUND(SrcInputData%BStCMotionMesh,1) - i1_u = UBOUND(SrcInputData%BStCMotionMesh,1) - i2_l = LBOUND(SrcInputData%BStCMotionMesh,2) - i2_u = UBOUND(SrcInputData%BStCMotionMesh,2) - IF (.NOT. ALLOCATED(DstInputData%BStCMotionMesh)) THEN - ALLOCATE(DstInputData%BStCMotionMesh(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%BStCMotionMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcInputData%BStCMotionMesh,2), UBOUND(SrcInputData%BStCMotionMesh,2) - DO i1 = LBOUND(SrcInputData%BStCMotionMesh,1), UBOUND(SrcInputData%BStCMotionMesh,1) - CALL MeshCopy( SrcInputData%BStCMotionMesh(i1,i2), DstInputData%BStCMotionMesh(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcInputData%NStCMotionMesh)) THEN - i1_l = LBOUND(SrcInputData%NStCMotionMesh,1) - i1_u = UBOUND(SrcInputData%NStCMotionMesh,1) - IF (.NOT. ALLOCATED(DstInputData%NStCMotionMesh)) THEN - ALLOCATE(DstInputData%NStCMotionMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%NStCMotionMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputData%NStCMotionMesh,1), UBOUND(SrcInputData%NStCMotionMesh,1) - CALL MeshCopy( SrcInputData%NStCMotionMesh(i1), DstInputData%NStCMotionMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInputData%TStCMotionMesh)) THEN - i1_l = LBOUND(SrcInputData%TStCMotionMesh,1) - i1_u = UBOUND(SrcInputData%TStCMotionMesh,1) - IF (.NOT. ALLOCATED(DstInputData%TStCMotionMesh)) THEN - ALLOCATE(DstInputData%TStCMotionMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%TStCMotionMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputData%TStCMotionMesh,1), UBOUND(SrcInputData%TStCMotionMesh,1) - CALL MeshCopy( SrcInputData%TStCMotionMesh(i1), DstInputData%TStCMotionMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInputData%SStCMotionMesh)) THEN - i1_l = LBOUND(SrcInputData%SStCMotionMesh,1) - i1_u = UBOUND(SrcInputData%SStCMotionMesh,1) - IF (.NOT. ALLOCATED(DstInputData%SStCMotionMesh)) THEN - ALLOCATE(DstInputData%SStCMotionMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%SStCMotionMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputData%SStCMotionMesh,1), UBOUND(SrcInputData%SStCMotionMesh,1) - CALL MeshCopy( SrcInputData%SStCMotionMesh(i1), DstInputData%SStCMotionMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInputData%LidSpeed)) THEN - i1_l = LBOUND(SrcInputData%LidSpeed,1) - i1_u = UBOUND(SrcInputData%LidSpeed,1) - IF (.NOT. ALLOCATED(DstInputData%LidSpeed)) THEN - ALLOCATE(DstInputData%LidSpeed(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%LidSpeed.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%LidSpeed = SrcInputData%LidSpeed -ENDIF -IF (ALLOCATED(SrcInputData%MsrPositionsX)) THEN - i1_l = LBOUND(SrcInputData%MsrPositionsX,1) - i1_u = UBOUND(SrcInputData%MsrPositionsX,1) - IF (.NOT. ALLOCATED(DstInputData%MsrPositionsX)) THEN - ALLOCATE(DstInputData%MsrPositionsX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%MsrPositionsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%MsrPositionsX = SrcInputData%MsrPositionsX -ENDIF -IF (ALLOCATED(SrcInputData%MsrPositionsY)) THEN - i1_l = LBOUND(SrcInputData%MsrPositionsY,1) - i1_u = UBOUND(SrcInputData%MsrPositionsY,1) - IF (.NOT. ALLOCATED(DstInputData%MsrPositionsY)) THEN - ALLOCATE(DstInputData%MsrPositionsY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%MsrPositionsY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%MsrPositionsY = SrcInputData%MsrPositionsY -ENDIF -IF (ALLOCATED(SrcInputData%MsrPositionsZ)) THEN - i1_l = LBOUND(SrcInputData%MsrPositionsZ,1) - i1_u = UBOUND(SrcInputData%MsrPositionsZ,1) - IF (.NOT. ALLOCATED(DstInputData%MsrPositionsZ)) THEN - ALLOCATE(DstInputData%MsrPositionsZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%MsrPositionsZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%MsrPositionsZ = SrcInputData%MsrPositionsZ -ENDIF - END SUBROUTINE SrvD_CopyInput - - SUBROUTINE SrvD_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(SrvD_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(InputData%BlPitch)) THEN - DEALLOCATE(InputData%BlPitch) -ENDIF -IF (ALLOCATED(InputData%ExternalBlPitchCom)) THEN - DEALLOCATE(InputData%ExternalBlPitchCom) -ENDIF -IF (ALLOCATED(InputData%ExternalBlAirfoilCom)) THEN - DEALLOCATE(InputData%ExternalBlAirfoilCom) -ENDIF -IF (ALLOCATED(InputData%ExternalCableDeltaL)) THEN - DEALLOCATE(InputData%ExternalCableDeltaL) -ENDIF -IF (ALLOCATED(InputData%ExternalCableDeltaLdot)) THEN - DEALLOCATE(InputData%ExternalCableDeltaLdot) -ENDIF -IF (ALLOCATED(InputData%fromSC)) THEN - DEALLOCATE(InputData%fromSC) -ENDIF -IF (ALLOCATED(InputData%fromSCglob)) THEN - DEALLOCATE(InputData%fromSCglob) -ENDIF -IF (ALLOCATED(InputData%Lidar)) THEN - DEALLOCATE(InputData%Lidar) -ENDIF - CALL MeshDestroy( InputData%PtfmMotionMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InputData%BStCMotionMesh)) THEN -DO i2 = LBOUND(InputData%BStCMotionMesh,2), UBOUND(InputData%BStCMotionMesh,2) -DO i1 = LBOUND(InputData%BStCMotionMesh,1), UBOUND(InputData%BStCMotionMesh,1) - CALL MeshDestroy( InputData%BStCMotionMesh(i1,i2), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(InputData%BStCMotionMesh) -ENDIF -IF (ALLOCATED(InputData%NStCMotionMesh)) THEN -DO i1 = LBOUND(InputData%NStCMotionMesh,1), UBOUND(InputData%NStCMotionMesh,1) - CALL MeshDestroy( InputData%NStCMotionMesh(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InputData%NStCMotionMesh) -ENDIF -IF (ALLOCATED(InputData%TStCMotionMesh)) THEN -DO i1 = LBOUND(InputData%TStCMotionMesh,1), UBOUND(InputData%TStCMotionMesh,1) - CALL MeshDestroy( InputData%TStCMotionMesh(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InputData%TStCMotionMesh) -ENDIF -IF (ALLOCATED(InputData%SStCMotionMesh)) THEN -DO i1 = LBOUND(InputData%SStCMotionMesh,1), UBOUND(InputData%SStCMotionMesh,1) - CALL MeshDestroy( InputData%SStCMotionMesh(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InputData%SStCMotionMesh) -ENDIF -IF (ALLOCATED(InputData%LidSpeed)) THEN - DEALLOCATE(InputData%LidSpeed) -ENDIF -IF (ALLOCATED(InputData%MsrPositionsX)) THEN - DEALLOCATE(InputData%MsrPositionsX) -ENDIF -IF (ALLOCATED(InputData%MsrPositionsY)) THEN - DEALLOCATE(InputData%MsrPositionsY) -ENDIF -IF (ALLOCATED(InputData%MsrPositionsZ)) THEN - DEALLOCATE(InputData%MsrPositionsZ) -ENDIF - END SUBROUTINE SrvD_DestroyInput +subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(SrvD_InputType), intent(inout) :: SrcInputData + type(SrvD_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInputData%BlPitch)) then + LB(1:1) = lbound(SrcInputData%BlPitch) + UB(1:1) = ubound(SrcInputData%BlPitch) + if (.not. allocated(DstInputData%BlPitch)) then + allocate(DstInputData%BlPitch(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%BlPitch.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%BlPitch = SrcInputData%BlPitch + else if (allocated(DstInputData%BlPitch)) then + deallocate(DstInputData%BlPitch) + end if + DstInputData%Yaw = SrcInputData%Yaw + DstInputData%YawRate = SrcInputData%YawRate + DstInputData%LSS_Spd = SrcInputData%LSS_Spd + DstInputData%HSS_Spd = SrcInputData%HSS_Spd + DstInputData%RotSpeed = SrcInputData%RotSpeed + DstInputData%ExternalYawPosCom = SrcInputData%ExternalYawPosCom + DstInputData%ExternalYawRateCom = SrcInputData%ExternalYawRateCom + if (allocated(SrcInputData%ExternalBlPitchCom)) then + LB(1:1) = lbound(SrcInputData%ExternalBlPitchCom) + UB(1:1) = ubound(SrcInputData%ExternalBlPitchCom) + if (.not. allocated(DstInputData%ExternalBlPitchCom)) then + allocate(DstInputData%ExternalBlPitchCom(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%ExternalBlPitchCom.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%ExternalBlPitchCom = SrcInputData%ExternalBlPitchCom + else if (allocated(DstInputData%ExternalBlPitchCom)) then + deallocate(DstInputData%ExternalBlPitchCom) + end if + DstInputData%ExternalGenTrq = SrcInputData%ExternalGenTrq + DstInputData%ExternalElecPwr = SrcInputData%ExternalElecPwr + DstInputData%ExternalHSSBrFrac = SrcInputData%ExternalHSSBrFrac + if (allocated(SrcInputData%ExternalBlAirfoilCom)) then + LB(1:1) = lbound(SrcInputData%ExternalBlAirfoilCom) + UB(1:1) = ubound(SrcInputData%ExternalBlAirfoilCom) + if (.not. allocated(DstInputData%ExternalBlAirfoilCom)) then + allocate(DstInputData%ExternalBlAirfoilCom(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%ExternalBlAirfoilCom.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%ExternalBlAirfoilCom = SrcInputData%ExternalBlAirfoilCom + else if (allocated(DstInputData%ExternalBlAirfoilCom)) then + deallocate(DstInputData%ExternalBlAirfoilCom) + end if + if (allocated(SrcInputData%ExternalCableDeltaL)) then + LB(1:1) = lbound(SrcInputData%ExternalCableDeltaL) + UB(1:1) = ubound(SrcInputData%ExternalCableDeltaL) + if (.not. allocated(DstInputData%ExternalCableDeltaL)) then + allocate(DstInputData%ExternalCableDeltaL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%ExternalCableDeltaL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%ExternalCableDeltaL = SrcInputData%ExternalCableDeltaL + else if (allocated(DstInputData%ExternalCableDeltaL)) then + deallocate(DstInputData%ExternalCableDeltaL) + end if + if (allocated(SrcInputData%ExternalCableDeltaLdot)) then + LB(1:1) = lbound(SrcInputData%ExternalCableDeltaLdot) + UB(1:1) = ubound(SrcInputData%ExternalCableDeltaLdot) + if (.not. allocated(DstInputData%ExternalCableDeltaLdot)) then + allocate(DstInputData%ExternalCableDeltaLdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%ExternalCableDeltaLdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%ExternalCableDeltaLdot = SrcInputData%ExternalCableDeltaLdot + else if (allocated(DstInputData%ExternalCableDeltaLdot)) then + deallocate(DstInputData%ExternalCableDeltaLdot) + end if + DstInputData%TwrAccel = SrcInputData%TwrAccel + DstInputData%YawErr = SrcInputData%YawErr + DstInputData%WindDir = SrcInputData%WindDir + DstInputData%RootMyc = SrcInputData%RootMyc + DstInputData%YawBrTAxp = SrcInputData%YawBrTAxp + DstInputData%YawBrTAyp = SrcInputData%YawBrTAyp + DstInputData%LSSTipPxa = SrcInputData%LSSTipPxa + DstInputData%RootMxc = SrcInputData%RootMxc + DstInputData%LSSTipMxa = SrcInputData%LSSTipMxa + DstInputData%LSSTipMya = SrcInputData%LSSTipMya + DstInputData%LSSTipMza = SrcInputData%LSSTipMza + DstInputData%LSSTipMys = SrcInputData%LSSTipMys + DstInputData%LSSTipMzs = SrcInputData%LSSTipMzs + DstInputData%YawBrMyn = SrcInputData%YawBrMyn + DstInputData%YawBrMzn = SrcInputData%YawBrMzn + DstInputData%NcIMURAxs = SrcInputData%NcIMURAxs + DstInputData%NcIMURAys = SrcInputData%NcIMURAys + DstInputData%NcIMURAzs = SrcInputData%NcIMURAzs + DstInputData%RotPwr = SrcInputData%RotPwr + DstInputData%HorWindV = SrcInputData%HorWindV + DstInputData%YawAngle = SrcInputData%YawAngle + DstInputData%LSShftFxa = SrcInputData%LSShftFxa + DstInputData%LSShftFys = SrcInputData%LSShftFys + DstInputData%LSShftFzs = SrcInputData%LSShftFzs + if (allocated(SrcInputData%fromSC)) then + LB(1:1) = lbound(SrcInputData%fromSC) + UB(1:1) = ubound(SrcInputData%fromSC) + if (.not. allocated(DstInputData%fromSC)) then + allocate(DstInputData%fromSC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%fromSC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%fromSC = SrcInputData%fromSC + else if (allocated(DstInputData%fromSC)) then + deallocate(DstInputData%fromSC) + end if + if (allocated(SrcInputData%fromSCglob)) then + LB(1:1) = lbound(SrcInputData%fromSCglob) + UB(1:1) = ubound(SrcInputData%fromSCglob) + if (.not. allocated(DstInputData%fromSCglob)) then + allocate(DstInputData%fromSCglob(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%fromSCglob.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%fromSCglob = SrcInputData%fromSCglob + else if (allocated(DstInputData%fromSCglob)) then + deallocate(DstInputData%fromSCglob) + end if + if (allocated(SrcInputData%Lidar)) then + LB(1:1) = lbound(SrcInputData%Lidar) + UB(1:1) = ubound(SrcInputData%Lidar) + if (.not. allocated(DstInputData%Lidar)) then + allocate(DstInputData%Lidar(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Lidar.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%Lidar = SrcInputData%Lidar + else if (allocated(DstInputData%Lidar)) then + deallocate(DstInputData%Lidar) + end if + call MeshCopy(SrcInputData%PtfmMotionMesh, DstInputData%PtfmMotionMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInputData%BStCMotionMesh)) then + LB(1:2) = lbound(SrcInputData%BStCMotionMesh) + UB(1:2) = ubound(SrcInputData%BStCMotionMesh) + if (.not. allocated(DstInputData%BStCMotionMesh)) then + allocate(DstInputData%BStCMotionMesh(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%BStCMotionMesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call MeshCopy(SrcInputData%BStCMotionMesh(i1,i2), DstInputData%BStCMotionMesh(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + else if (allocated(DstInputData%BStCMotionMesh)) then + deallocate(DstInputData%BStCMotionMesh) + end if + if (allocated(SrcInputData%NStCMotionMesh)) then + LB(1:1) = lbound(SrcInputData%NStCMotionMesh) + UB(1:1) = ubound(SrcInputData%NStCMotionMesh) + if (.not. allocated(DstInputData%NStCMotionMesh)) then + allocate(DstInputData%NStCMotionMesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%NStCMotionMesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcInputData%NStCMotionMesh(i1), DstInputData%NStCMotionMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstInputData%NStCMotionMesh)) then + deallocate(DstInputData%NStCMotionMesh) + end if + if (allocated(SrcInputData%TStCMotionMesh)) then + LB(1:1) = lbound(SrcInputData%TStCMotionMesh) + UB(1:1) = ubound(SrcInputData%TStCMotionMesh) + if (.not. allocated(DstInputData%TStCMotionMesh)) then + allocate(DstInputData%TStCMotionMesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%TStCMotionMesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcInputData%TStCMotionMesh(i1), DstInputData%TStCMotionMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstInputData%TStCMotionMesh)) then + deallocate(DstInputData%TStCMotionMesh) + end if + if (allocated(SrcInputData%SStCMotionMesh)) then + LB(1:1) = lbound(SrcInputData%SStCMotionMesh) + UB(1:1) = ubound(SrcInputData%SStCMotionMesh) + if (.not. allocated(DstInputData%SStCMotionMesh)) then + allocate(DstInputData%SStCMotionMesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%SStCMotionMesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcInputData%SStCMotionMesh(i1), DstInputData%SStCMotionMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstInputData%SStCMotionMesh)) then + deallocate(DstInputData%SStCMotionMesh) + end if + if (allocated(SrcInputData%LidSpeed)) then + LB(1:1) = lbound(SrcInputData%LidSpeed) + UB(1:1) = ubound(SrcInputData%LidSpeed) + if (.not. allocated(DstInputData%LidSpeed)) then + allocate(DstInputData%LidSpeed(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%LidSpeed.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%LidSpeed = SrcInputData%LidSpeed + else if (allocated(DstInputData%LidSpeed)) then + deallocate(DstInputData%LidSpeed) + end if + if (allocated(SrcInputData%MsrPositionsX)) then + LB(1:1) = lbound(SrcInputData%MsrPositionsX) + UB(1:1) = ubound(SrcInputData%MsrPositionsX) + if (.not. allocated(DstInputData%MsrPositionsX)) then + allocate(DstInputData%MsrPositionsX(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%MsrPositionsX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%MsrPositionsX = SrcInputData%MsrPositionsX + else if (allocated(DstInputData%MsrPositionsX)) then + deallocate(DstInputData%MsrPositionsX) + end if + if (allocated(SrcInputData%MsrPositionsY)) then + LB(1:1) = lbound(SrcInputData%MsrPositionsY) + UB(1:1) = ubound(SrcInputData%MsrPositionsY) + if (.not. allocated(DstInputData%MsrPositionsY)) then + allocate(DstInputData%MsrPositionsY(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%MsrPositionsY.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%MsrPositionsY = SrcInputData%MsrPositionsY + else if (allocated(DstInputData%MsrPositionsY)) then + deallocate(DstInputData%MsrPositionsY) + end if + if (allocated(SrcInputData%MsrPositionsZ)) then + LB(1:1) = lbound(SrcInputData%MsrPositionsZ) + UB(1:1) = ubound(SrcInputData%MsrPositionsZ) + if (.not. allocated(DstInputData%MsrPositionsZ)) then + allocate(DstInputData%MsrPositionsZ(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%MsrPositionsZ.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%MsrPositionsZ = SrcInputData%MsrPositionsZ + else if (allocated(DstInputData%MsrPositionsZ)) then + deallocate(DstInputData%MsrPositionsZ) + end if +end subroutine +subroutine SrvD_DestroyInput(InputData, ErrStat, ErrMsg) + type(SrvD_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%BlPitch)) then + deallocate(InputData%BlPitch) + end if + if (allocated(InputData%ExternalBlPitchCom)) then + deallocate(InputData%ExternalBlPitchCom) + end if + if (allocated(InputData%ExternalBlAirfoilCom)) then + deallocate(InputData%ExternalBlAirfoilCom) + end if + if (allocated(InputData%ExternalCableDeltaL)) then + deallocate(InputData%ExternalCableDeltaL) + end if + if (allocated(InputData%ExternalCableDeltaLdot)) then + deallocate(InputData%ExternalCableDeltaLdot) + end if + if (allocated(InputData%fromSC)) then + deallocate(InputData%fromSC) + end if + if (allocated(InputData%fromSCglob)) then + deallocate(InputData%fromSCglob) + end if + if (allocated(InputData%Lidar)) then + deallocate(InputData%Lidar) + end if + if (allocated(InputData%BStCMotionMesh)) then + LB(1:2) = lbound(InputData%BStCMotionMesh) + UB(1:2) = ubound(InputData%BStCMotionMesh) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call MeshDestroy( InputData%BStCMotionMesh(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(InputData%BStCMotionMesh) + end if + if (allocated(InputData%NStCMotionMesh)) then + LB(1:1) = lbound(InputData%NStCMotionMesh) + UB(1:1) = ubound(InputData%NStCMotionMesh) + do i1 = LB(1), UB(1) + call MeshDestroy( InputData%NStCMotionMesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputData%NStCMotionMesh) + end if + if (allocated(InputData%TStCMotionMesh)) then + LB(1:1) = lbound(InputData%TStCMotionMesh) + UB(1:1) = ubound(InputData%TStCMotionMesh) + do i1 = LB(1), UB(1) + call MeshDestroy( InputData%TStCMotionMesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputData%TStCMotionMesh) + end if + if (allocated(InputData%SStCMotionMesh)) then + LB(1:1) = lbound(InputData%SStCMotionMesh) + UB(1:1) = ubound(InputData%SStCMotionMesh) + do i1 = LB(1), UB(1) + call MeshDestroy( InputData%SStCMotionMesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputData%SStCMotionMesh) + end if + if (allocated(InputData%LidSpeed)) then + deallocate(InputData%LidSpeed) + end if + if (allocated(InputData%MsrPositionsX)) then + deallocate(InputData%MsrPositionsX) + end if + if (allocated(InputData%MsrPositionsY)) then + deallocate(InputData%MsrPositionsY) + end if + if (allocated(InputData%MsrPositionsZ)) then + deallocate(InputData%MsrPositionsZ) + end if +end subroutine subroutine SrvD_PackInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -8871,168 +8237,124 @@ subroutine SrvD_PackInput(Buf, Indata) integer(IntKi) :: i1, i2 integer(IntKi) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return - ! BlPitch call RegPack(Buf, allocated(InData%BlPitch)) if (allocated(InData%BlPitch)) then call RegPackBounds(Buf, 1, lbound(InData%BlPitch), ubound(InData%BlPitch)) call RegPack(Buf, InData%BlPitch) end if if (RegCheckErr(Buf, RoutineName)) return - ! Yaw call RegPack(Buf, InData%Yaw) if (RegCheckErr(Buf, RoutineName)) return - ! YawRate call RegPack(Buf, InData%YawRate) if (RegCheckErr(Buf, RoutineName)) return - ! LSS_Spd call RegPack(Buf, InData%LSS_Spd) if (RegCheckErr(Buf, RoutineName)) return - ! HSS_Spd call RegPack(Buf, InData%HSS_Spd) if (RegCheckErr(Buf, RoutineName)) return - ! RotSpeed call RegPack(Buf, InData%RotSpeed) if (RegCheckErr(Buf, RoutineName)) return - ! ExternalYawPosCom call RegPack(Buf, InData%ExternalYawPosCom) if (RegCheckErr(Buf, RoutineName)) return - ! ExternalYawRateCom call RegPack(Buf, InData%ExternalYawRateCom) if (RegCheckErr(Buf, RoutineName)) return - ! ExternalBlPitchCom call RegPack(Buf, allocated(InData%ExternalBlPitchCom)) if (allocated(InData%ExternalBlPitchCom)) then call RegPackBounds(Buf, 1, lbound(InData%ExternalBlPitchCom), ubound(InData%ExternalBlPitchCom)) call RegPack(Buf, InData%ExternalBlPitchCom) end if if (RegCheckErr(Buf, RoutineName)) return - ! ExternalGenTrq call RegPack(Buf, InData%ExternalGenTrq) if (RegCheckErr(Buf, RoutineName)) return - ! ExternalElecPwr call RegPack(Buf, InData%ExternalElecPwr) if (RegCheckErr(Buf, RoutineName)) return - ! ExternalHSSBrFrac call RegPack(Buf, InData%ExternalHSSBrFrac) if (RegCheckErr(Buf, RoutineName)) return - ! ExternalBlAirfoilCom call RegPack(Buf, allocated(InData%ExternalBlAirfoilCom)) if (allocated(InData%ExternalBlAirfoilCom)) then call RegPackBounds(Buf, 1, lbound(InData%ExternalBlAirfoilCom), ubound(InData%ExternalBlAirfoilCom)) call RegPack(Buf, InData%ExternalBlAirfoilCom) end if if (RegCheckErr(Buf, RoutineName)) return - ! ExternalCableDeltaL call RegPack(Buf, allocated(InData%ExternalCableDeltaL)) if (allocated(InData%ExternalCableDeltaL)) then call RegPackBounds(Buf, 1, lbound(InData%ExternalCableDeltaL), ubound(InData%ExternalCableDeltaL)) call RegPack(Buf, InData%ExternalCableDeltaL) end if if (RegCheckErr(Buf, RoutineName)) return - ! ExternalCableDeltaLdot call RegPack(Buf, allocated(InData%ExternalCableDeltaLdot)) if (allocated(InData%ExternalCableDeltaLdot)) then call RegPackBounds(Buf, 1, lbound(InData%ExternalCableDeltaLdot), ubound(InData%ExternalCableDeltaLdot)) call RegPack(Buf, InData%ExternalCableDeltaLdot) end if if (RegCheckErr(Buf, RoutineName)) return - ! TwrAccel call RegPack(Buf, InData%TwrAccel) if (RegCheckErr(Buf, RoutineName)) return - ! YawErr call RegPack(Buf, InData%YawErr) if (RegCheckErr(Buf, RoutineName)) return - ! WindDir call RegPack(Buf, InData%WindDir) if (RegCheckErr(Buf, RoutineName)) return - ! RootMyc call RegPack(Buf, InData%RootMyc) if (RegCheckErr(Buf, RoutineName)) return - ! YawBrTAxp call RegPack(Buf, InData%YawBrTAxp) if (RegCheckErr(Buf, RoutineName)) return - ! YawBrTAyp call RegPack(Buf, InData%YawBrTAyp) if (RegCheckErr(Buf, RoutineName)) return - ! LSSTipPxa call RegPack(Buf, InData%LSSTipPxa) if (RegCheckErr(Buf, RoutineName)) return - ! RootMxc call RegPack(Buf, InData%RootMxc) if (RegCheckErr(Buf, RoutineName)) return - ! LSSTipMxa call RegPack(Buf, InData%LSSTipMxa) if (RegCheckErr(Buf, RoutineName)) return - ! LSSTipMya call RegPack(Buf, InData%LSSTipMya) if (RegCheckErr(Buf, RoutineName)) return - ! LSSTipMza call RegPack(Buf, InData%LSSTipMza) if (RegCheckErr(Buf, RoutineName)) return - ! LSSTipMys call RegPack(Buf, InData%LSSTipMys) if (RegCheckErr(Buf, RoutineName)) return - ! LSSTipMzs call RegPack(Buf, InData%LSSTipMzs) if (RegCheckErr(Buf, RoutineName)) return - ! YawBrMyn call RegPack(Buf, InData%YawBrMyn) if (RegCheckErr(Buf, RoutineName)) return - ! YawBrMzn call RegPack(Buf, InData%YawBrMzn) if (RegCheckErr(Buf, RoutineName)) return - ! NcIMURAxs call RegPack(Buf, InData%NcIMURAxs) if (RegCheckErr(Buf, RoutineName)) return - ! NcIMURAys call RegPack(Buf, InData%NcIMURAys) if (RegCheckErr(Buf, RoutineName)) return - ! NcIMURAzs call RegPack(Buf, InData%NcIMURAzs) if (RegCheckErr(Buf, RoutineName)) return - ! RotPwr call RegPack(Buf, InData%RotPwr) if (RegCheckErr(Buf, RoutineName)) return - ! HorWindV call RegPack(Buf, InData%HorWindV) if (RegCheckErr(Buf, RoutineName)) return - ! YawAngle call RegPack(Buf, InData%YawAngle) if (RegCheckErr(Buf, RoutineName)) return - ! LSShftFxa call RegPack(Buf, InData%LSShftFxa) if (RegCheckErr(Buf, RoutineName)) return - ! LSShftFys call RegPack(Buf, InData%LSShftFys) if (RegCheckErr(Buf, RoutineName)) return - ! LSShftFzs call RegPack(Buf, InData%LSShftFzs) if (RegCheckErr(Buf, RoutineName)) return - ! fromSC call RegPack(Buf, allocated(InData%fromSC)) if (allocated(InData%fromSC)) then call RegPackBounds(Buf, 1, lbound(InData%fromSC), ubound(InData%fromSC)) call RegPack(Buf, InData%fromSC) end if if (RegCheckErr(Buf, RoutineName)) return - ! fromSCglob call RegPack(Buf, allocated(InData%fromSCglob)) if (allocated(InData%fromSCglob)) then call RegPackBounds(Buf, 1, lbound(InData%fromSCglob), ubound(InData%fromSCglob)) call RegPack(Buf, InData%fromSCglob) end if if (RegCheckErr(Buf, RoutineName)) return - ! Lidar call RegPack(Buf, allocated(InData%Lidar)) if (allocated(InData%Lidar)) then call RegPackBounds(Buf, 1, lbound(InData%Lidar), ubound(InData%Lidar)) call RegPack(Buf, InData%Lidar) end if if (RegCheckErr(Buf, RoutineName)) return - ! PtfmMotionMesh call MeshPack(Buf, InData%PtfmMotionMesh) if (RegCheckErr(Buf, RoutineName)) return - ! BStCMotionMesh call RegPack(Buf, allocated(InData%BStCMotionMesh)) if (allocated(InData%BStCMotionMesh)) then call RegPackBounds(Buf, 2, lbound(InData%BStCMotionMesh), ubound(InData%BStCMotionMesh)) @@ -9045,7 +8367,6 @@ subroutine SrvD_PackInput(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! NStCMotionMesh call RegPack(Buf, allocated(InData%NStCMotionMesh)) if (allocated(InData%NStCMotionMesh)) then call RegPackBounds(Buf, 1, lbound(InData%NStCMotionMesh), ubound(InData%NStCMotionMesh)) @@ -9056,7 +8377,6 @@ subroutine SrvD_PackInput(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! TStCMotionMesh call RegPack(Buf, allocated(InData%TStCMotionMesh)) if (allocated(InData%TStCMotionMesh)) then call RegPackBounds(Buf, 1, lbound(InData%TStCMotionMesh), ubound(InData%TStCMotionMesh)) @@ -9067,7 +8387,6 @@ subroutine SrvD_PackInput(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! SStCMotionMesh call RegPack(Buf, allocated(InData%SStCMotionMesh)) if (allocated(InData%SStCMotionMesh)) then call RegPackBounds(Buf, 1, lbound(InData%SStCMotionMesh), ubound(InData%SStCMotionMesh)) @@ -9078,28 +8397,24 @@ subroutine SrvD_PackInput(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! LidSpeed call RegPack(Buf, allocated(InData%LidSpeed)) if (allocated(InData%LidSpeed)) then call RegPackBounds(Buf, 1, lbound(InData%LidSpeed), ubound(InData%LidSpeed)) call RegPack(Buf, InData%LidSpeed) end if if (RegCheckErr(Buf, RoutineName)) return - ! MsrPositionsX call RegPack(Buf, allocated(InData%MsrPositionsX)) if (allocated(InData%MsrPositionsX)) then call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsX), ubound(InData%MsrPositionsX)) call RegPack(Buf, InData%MsrPositionsX) end if if (RegCheckErr(Buf, RoutineName)) return - ! MsrPositionsY call RegPack(Buf, allocated(InData%MsrPositionsY)) if (allocated(InData%MsrPositionsY)) then call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsY), ubound(InData%MsrPositionsY)) call RegPack(Buf, InData%MsrPositionsY) end if if (RegCheckErr(Buf, RoutineName)) return - ! MsrPositionsZ call RegPack(Buf, allocated(InData%MsrPositionsZ)) if (allocated(InData%MsrPositionsZ)) then call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsZ), ubound(InData%MsrPositionsZ)) @@ -9117,7 +8432,6 @@ subroutine SrvD_UnPackInput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! BlPitch if (allocated(OutData%BlPitch)) deallocate(OutData%BlPitch) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -9132,28 +8446,20 @@ subroutine SrvD_UnPackInput(Buf, OutData) call RegUnpack(Buf, OutData%BlPitch) if (RegCheckErr(Buf, RoutineName)) return end if - ! Yaw call RegUnpack(Buf, OutData%Yaw) if (RegCheckErr(Buf, RoutineName)) return - ! YawRate call RegUnpack(Buf, OutData%YawRate) if (RegCheckErr(Buf, RoutineName)) return - ! LSS_Spd call RegUnpack(Buf, OutData%LSS_Spd) if (RegCheckErr(Buf, RoutineName)) return - ! HSS_Spd call RegUnpack(Buf, OutData%HSS_Spd) if (RegCheckErr(Buf, RoutineName)) return - ! RotSpeed call RegUnpack(Buf, OutData%RotSpeed) if (RegCheckErr(Buf, RoutineName)) return - ! ExternalYawPosCom call RegUnpack(Buf, OutData%ExternalYawPosCom) if (RegCheckErr(Buf, RoutineName)) return - ! ExternalYawRateCom call RegUnpack(Buf, OutData%ExternalYawRateCom) if (RegCheckErr(Buf, RoutineName)) return - ! ExternalBlPitchCom if (allocated(OutData%ExternalBlPitchCom)) deallocate(OutData%ExternalBlPitchCom) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -9168,16 +8474,12 @@ subroutine SrvD_UnPackInput(Buf, OutData) call RegUnpack(Buf, OutData%ExternalBlPitchCom) if (RegCheckErr(Buf, RoutineName)) return end if - ! ExternalGenTrq call RegUnpack(Buf, OutData%ExternalGenTrq) if (RegCheckErr(Buf, RoutineName)) return - ! ExternalElecPwr call RegUnpack(Buf, OutData%ExternalElecPwr) if (RegCheckErr(Buf, RoutineName)) return - ! ExternalHSSBrFrac call RegUnpack(Buf, OutData%ExternalHSSBrFrac) if (RegCheckErr(Buf, RoutineName)) return - ! ExternalBlAirfoilCom if (allocated(OutData%ExternalBlAirfoilCom)) deallocate(OutData%ExternalBlAirfoilCom) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -9192,7 +8494,6 @@ subroutine SrvD_UnPackInput(Buf, OutData) call RegUnpack(Buf, OutData%ExternalBlAirfoilCom) if (RegCheckErr(Buf, RoutineName)) return end if - ! ExternalCableDeltaL if (allocated(OutData%ExternalCableDeltaL)) deallocate(OutData%ExternalCableDeltaL) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -9207,7 +8508,6 @@ subroutine SrvD_UnPackInput(Buf, OutData) call RegUnpack(Buf, OutData%ExternalCableDeltaL) if (RegCheckErr(Buf, RoutineName)) return end if - ! ExternalCableDeltaLdot if (allocated(OutData%ExternalCableDeltaLdot)) deallocate(OutData%ExternalCableDeltaLdot) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -9222,79 +8522,54 @@ subroutine SrvD_UnPackInput(Buf, OutData) call RegUnpack(Buf, OutData%ExternalCableDeltaLdot) if (RegCheckErr(Buf, RoutineName)) return end if - ! TwrAccel call RegUnpack(Buf, OutData%TwrAccel) if (RegCheckErr(Buf, RoutineName)) return - ! YawErr call RegUnpack(Buf, OutData%YawErr) if (RegCheckErr(Buf, RoutineName)) return - ! WindDir call RegUnpack(Buf, OutData%WindDir) if (RegCheckErr(Buf, RoutineName)) return - ! RootMyc call RegUnpack(Buf, OutData%RootMyc) if (RegCheckErr(Buf, RoutineName)) return - ! YawBrTAxp call RegUnpack(Buf, OutData%YawBrTAxp) if (RegCheckErr(Buf, RoutineName)) return - ! YawBrTAyp call RegUnpack(Buf, OutData%YawBrTAyp) if (RegCheckErr(Buf, RoutineName)) return - ! LSSTipPxa call RegUnpack(Buf, OutData%LSSTipPxa) if (RegCheckErr(Buf, RoutineName)) return - ! RootMxc call RegUnpack(Buf, OutData%RootMxc) if (RegCheckErr(Buf, RoutineName)) return - ! LSSTipMxa call RegUnpack(Buf, OutData%LSSTipMxa) if (RegCheckErr(Buf, RoutineName)) return - ! LSSTipMya call RegUnpack(Buf, OutData%LSSTipMya) if (RegCheckErr(Buf, RoutineName)) return - ! LSSTipMza call RegUnpack(Buf, OutData%LSSTipMza) if (RegCheckErr(Buf, RoutineName)) return - ! LSSTipMys call RegUnpack(Buf, OutData%LSSTipMys) if (RegCheckErr(Buf, RoutineName)) return - ! LSSTipMzs call RegUnpack(Buf, OutData%LSSTipMzs) if (RegCheckErr(Buf, RoutineName)) return - ! YawBrMyn call RegUnpack(Buf, OutData%YawBrMyn) if (RegCheckErr(Buf, RoutineName)) return - ! YawBrMzn call RegUnpack(Buf, OutData%YawBrMzn) if (RegCheckErr(Buf, RoutineName)) return - ! NcIMURAxs call RegUnpack(Buf, OutData%NcIMURAxs) if (RegCheckErr(Buf, RoutineName)) return - ! NcIMURAys call RegUnpack(Buf, OutData%NcIMURAys) if (RegCheckErr(Buf, RoutineName)) return - ! NcIMURAzs call RegUnpack(Buf, OutData%NcIMURAzs) if (RegCheckErr(Buf, RoutineName)) return - ! RotPwr call RegUnpack(Buf, OutData%RotPwr) if (RegCheckErr(Buf, RoutineName)) return - ! HorWindV call RegUnpack(Buf, OutData%HorWindV) if (RegCheckErr(Buf, RoutineName)) return - ! YawAngle call RegUnpack(Buf, OutData%YawAngle) if (RegCheckErr(Buf, RoutineName)) return - ! LSShftFxa call RegUnpack(Buf, OutData%LSShftFxa) if (RegCheckErr(Buf, RoutineName)) return - ! LSShftFys call RegUnpack(Buf, OutData%LSShftFys) if (RegCheckErr(Buf, RoutineName)) return - ! LSShftFzs call RegUnpack(Buf, OutData%LSShftFzs) if (RegCheckErr(Buf, RoutineName)) return - ! fromSC if (allocated(OutData%fromSC)) deallocate(OutData%fromSC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -9309,7 +8584,6 @@ subroutine SrvD_UnPackInput(Buf, OutData) call RegUnpack(Buf, OutData%fromSC) if (RegCheckErr(Buf, RoutineName)) return end if - ! fromSCglob if (allocated(OutData%fromSCglob)) deallocate(OutData%fromSCglob) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -9324,7 +8598,6 @@ subroutine SrvD_UnPackInput(Buf, OutData) call RegUnpack(Buf, OutData%fromSCglob) if (RegCheckErr(Buf, RoutineName)) return end if - ! Lidar if (allocated(OutData%Lidar)) deallocate(OutData%Lidar) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -9339,9 +8612,7 @@ subroutine SrvD_UnPackInput(Buf, OutData) call RegUnpack(Buf, OutData%Lidar) if (RegCheckErr(Buf, RoutineName)) return end if - ! PtfmMotionMesh call MeshUnpack(Buf, OutData%PtfmMotionMesh) ! PtfmMotionMesh - ! BStCMotionMesh if (allocated(OutData%BStCMotionMesh)) deallocate(OutData%BStCMotionMesh) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -9359,7 +8630,6 @@ subroutine SrvD_UnPackInput(Buf, OutData) end do end do end if - ! NStCMotionMesh if (allocated(OutData%NStCMotionMesh)) deallocate(OutData%NStCMotionMesh) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -9375,7 +8645,6 @@ subroutine SrvD_UnPackInput(Buf, OutData) call MeshUnpack(Buf, OutData%NStCMotionMesh(i1)) ! NStCMotionMesh end do end if - ! TStCMotionMesh if (allocated(OutData%TStCMotionMesh)) deallocate(OutData%TStCMotionMesh) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -9391,7 +8660,6 @@ subroutine SrvD_UnPackInput(Buf, OutData) call MeshUnpack(Buf, OutData%TStCMotionMesh(i1)) ! TStCMotionMesh end do end if - ! SStCMotionMesh if (allocated(OutData%SStCMotionMesh)) deallocate(OutData%SStCMotionMesh) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -9407,7 +8675,6 @@ subroutine SrvD_UnPackInput(Buf, OutData) call MeshUnpack(Buf, OutData%SStCMotionMesh(i1)) ! SStCMotionMesh end do end if - ! LidSpeed if (allocated(OutData%LidSpeed)) deallocate(OutData%LidSpeed) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -9422,7 +8689,6 @@ subroutine SrvD_UnPackInput(Buf, OutData) call RegUnpack(Buf, OutData%LidSpeed) if (RegCheckErr(Buf, RoutineName)) return end if - ! MsrPositionsX if (allocated(OutData%MsrPositionsX)) deallocate(OutData%MsrPositionsX) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -9437,7 +8703,6 @@ subroutine SrvD_UnPackInput(Buf, OutData) call RegUnpack(Buf, OutData%MsrPositionsX) if (RegCheckErr(Buf, RoutineName)) return end if - ! MsrPositionsY if (allocated(OutData%MsrPositionsY)) deallocate(OutData%MsrPositionsY) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -9452,7 +8717,6 @@ subroutine SrvD_UnPackInput(Buf, OutData) call RegUnpack(Buf, OutData%MsrPositionsY) if (RegCheckErr(Buf, RoutineName)) return end if - ! MsrPositionsZ if (allocated(OutData%MsrPositionsZ)) deallocate(OutData%MsrPositionsZ) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -9468,261 +8732,286 @@ subroutine SrvD_UnPackInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE SrvD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SrvD_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(SrvD_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_CopyOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%WriteOutput)) THEN - i1_l = LBOUND(SrcOutputData%WriteOutput,1) - i1_u = UBOUND(SrcOutputData%WriteOutput,1) - IF (.NOT. ALLOCATED(DstOutputData%WriteOutput)) THEN - ALLOCATE(DstOutputData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%WriteOutput = SrcOutputData%WriteOutput -ENDIF -IF (ALLOCATED(SrcOutputData%BlPitchCom)) THEN - i1_l = LBOUND(SrcOutputData%BlPitchCom,1) - i1_u = UBOUND(SrcOutputData%BlPitchCom,1) - IF (.NOT. ALLOCATED(DstOutputData%BlPitchCom)) THEN - ALLOCATE(DstOutputData%BlPitchCom(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BlPitchCom.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%BlPitchCom = SrcOutputData%BlPitchCom -ENDIF -IF (ALLOCATED(SrcOutputData%BlAirfoilCom)) THEN - i1_l = LBOUND(SrcOutputData%BlAirfoilCom,1) - i1_u = UBOUND(SrcOutputData%BlAirfoilCom,1) - IF (.NOT. ALLOCATED(DstOutputData%BlAirfoilCom)) THEN - ALLOCATE(DstOutputData%BlAirfoilCom(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BlAirfoilCom.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%BlAirfoilCom = SrcOutputData%BlAirfoilCom -ENDIF - DstOutputData%YawMom = SrcOutputData%YawMom - DstOutputData%GenTrq = SrcOutputData%GenTrq - DstOutputData%HSSBrTrqC = SrcOutputData%HSSBrTrqC - DstOutputData%ElecPwr = SrcOutputData%ElecPwr -IF (ALLOCATED(SrcOutputData%TBDrCon)) THEN - i1_l = LBOUND(SrcOutputData%TBDrCon,1) - i1_u = UBOUND(SrcOutputData%TBDrCon,1) - IF (.NOT. ALLOCATED(DstOutputData%TBDrCon)) THEN - ALLOCATE(DstOutputData%TBDrCon(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%TBDrCon.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%TBDrCon = SrcOutputData%TBDrCon -ENDIF -IF (ALLOCATED(SrcOutputData%Lidar)) THEN - i1_l = LBOUND(SrcOutputData%Lidar,1) - i1_u = UBOUND(SrcOutputData%Lidar,1) - IF (.NOT. ALLOCATED(DstOutputData%Lidar)) THEN - ALLOCATE(DstOutputData%Lidar(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Lidar.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Lidar = SrcOutputData%Lidar -ENDIF -IF (ALLOCATED(SrcOutputData%CableDeltaL)) THEN - i1_l = LBOUND(SrcOutputData%CableDeltaL,1) - i1_u = UBOUND(SrcOutputData%CableDeltaL,1) - IF (.NOT. ALLOCATED(DstOutputData%CableDeltaL)) THEN - ALLOCATE(DstOutputData%CableDeltaL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%CableDeltaL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%CableDeltaL = SrcOutputData%CableDeltaL -ENDIF -IF (ALLOCATED(SrcOutputData%CableDeltaLdot)) THEN - i1_l = LBOUND(SrcOutputData%CableDeltaLdot,1) - i1_u = UBOUND(SrcOutputData%CableDeltaLdot,1) - IF (.NOT. ALLOCATED(DstOutputData%CableDeltaLdot)) THEN - ALLOCATE(DstOutputData%CableDeltaLdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%CableDeltaLdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%CableDeltaLdot = SrcOutputData%CableDeltaLdot -ENDIF -IF (ALLOCATED(SrcOutputData%BStCLoadMesh)) THEN - i1_l = LBOUND(SrcOutputData%BStCLoadMesh,1) - i1_u = UBOUND(SrcOutputData%BStCLoadMesh,1) - i2_l = LBOUND(SrcOutputData%BStCLoadMesh,2) - i2_u = UBOUND(SrcOutputData%BStCLoadMesh,2) - IF (.NOT. ALLOCATED(DstOutputData%BStCLoadMesh)) THEN - ALLOCATE(DstOutputData%BStCLoadMesh(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BStCLoadMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcOutputData%BStCLoadMesh,2), UBOUND(SrcOutputData%BStCLoadMesh,2) - DO i1 = LBOUND(SrcOutputData%BStCLoadMesh,1), UBOUND(SrcOutputData%BStCLoadMesh,1) - CALL MeshCopy( SrcOutputData%BStCLoadMesh(i1,i2), DstOutputData%BStCLoadMesh(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcOutputData%NStCLoadMesh)) THEN - i1_l = LBOUND(SrcOutputData%NStCLoadMesh,1) - i1_u = UBOUND(SrcOutputData%NStCLoadMesh,1) - IF (.NOT. ALLOCATED(DstOutputData%NStCLoadMesh)) THEN - ALLOCATE(DstOutputData%NStCLoadMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%NStCLoadMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOutputData%NStCLoadMesh,1), UBOUND(SrcOutputData%NStCLoadMesh,1) - CALL MeshCopy( SrcOutputData%NStCLoadMesh(i1), DstOutputData%NStCLoadMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcOutputData%TStCLoadMesh)) THEN - i1_l = LBOUND(SrcOutputData%TStCLoadMesh,1) - i1_u = UBOUND(SrcOutputData%TStCLoadMesh,1) - IF (.NOT. ALLOCATED(DstOutputData%TStCLoadMesh)) THEN - ALLOCATE(DstOutputData%TStCLoadMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%TStCLoadMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOutputData%TStCLoadMesh,1), UBOUND(SrcOutputData%TStCLoadMesh,1) - CALL MeshCopy( SrcOutputData%TStCLoadMesh(i1), DstOutputData%TStCLoadMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcOutputData%SStCLoadMesh)) THEN - i1_l = LBOUND(SrcOutputData%SStCLoadMesh,1) - i1_u = UBOUND(SrcOutputData%SStCLoadMesh,1) - IF (.NOT. ALLOCATED(DstOutputData%SStCLoadMesh)) THEN - ALLOCATE(DstOutputData%SStCLoadMesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%SStCLoadMesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOutputData%SStCLoadMesh,1), UBOUND(SrcOutputData%SStCLoadMesh,1) - CALL MeshCopy( SrcOutputData%SStCLoadMesh(i1), DstOutputData%SStCLoadMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcOutputData%toSC)) THEN - i1_l = LBOUND(SrcOutputData%toSC,1) - i1_u = UBOUND(SrcOutputData%toSC,1) - IF (.NOT. ALLOCATED(DstOutputData%toSC)) THEN - ALLOCATE(DstOutputData%toSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%toSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%toSC = SrcOutputData%toSC -ENDIF - END SUBROUTINE SrvD_CopyOutput - SUBROUTINE SrvD_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(SrvD_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF -IF (ALLOCATED(OutputData%BlPitchCom)) THEN - DEALLOCATE(OutputData%BlPitchCom) -ENDIF -IF (ALLOCATED(OutputData%BlAirfoilCom)) THEN - DEALLOCATE(OutputData%BlAirfoilCom) -ENDIF -IF (ALLOCATED(OutputData%TBDrCon)) THEN - DEALLOCATE(OutputData%TBDrCon) -ENDIF -IF (ALLOCATED(OutputData%Lidar)) THEN - DEALLOCATE(OutputData%Lidar) -ENDIF -IF (ALLOCATED(OutputData%CableDeltaL)) THEN - DEALLOCATE(OutputData%CableDeltaL) -ENDIF -IF (ALLOCATED(OutputData%CableDeltaLdot)) THEN - DEALLOCATE(OutputData%CableDeltaLdot) -ENDIF -IF (ALLOCATED(OutputData%BStCLoadMesh)) THEN -DO i2 = LBOUND(OutputData%BStCLoadMesh,2), UBOUND(OutputData%BStCLoadMesh,2) -DO i1 = LBOUND(OutputData%BStCLoadMesh,1), UBOUND(OutputData%BStCLoadMesh,1) - CALL MeshDestroy( OutputData%BStCLoadMesh(i1,i2), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO -ENDDO - DEALLOCATE(OutputData%BStCLoadMesh) -ENDIF -IF (ALLOCATED(OutputData%NStCLoadMesh)) THEN -DO i1 = LBOUND(OutputData%NStCLoadMesh,1), UBOUND(OutputData%NStCLoadMesh,1) - CALL MeshDestroy( OutputData%NStCLoadMesh(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OutputData%NStCLoadMesh) -ENDIF -IF (ALLOCATED(OutputData%TStCLoadMesh)) THEN -DO i1 = LBOUND(OutputData%TStCLoadMesh,1), UBOUND(OutputData%TStCLoadMesh,1) - CALL MeshDestroy( OutputData%TStCLoadMesh(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OutputData%TStCLoadMesh) -ENDIF -IF (ALLOCATED(OutputData%SStCLoadMesh)) THEN -DO i1 = LBOUND(OutputData%SStCLoadMesh,1), UBOUND(OutputData%SStCLoadMesh,1) - CALL MeshDestroy( OutputData%SStCLoadMesh(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OutputData%SStCLoadMesh) -ENDIF -IF (ALLOCATED(OutputData%toSC)) THEN - DEALLOCATE(OutputData%toSC) -ENDIF - END SUBROUTINE SrvD_DestroyOutput +subroutine SrvD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(SrvD_OutputType), intent(inout) :: SrcOutputData + type(SrvD_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%WriteOutput = SrcOutputData%WriteOutput + else if (allocated(DstOutputData%WriteOutput)) then + deallocate(DstOutputData%WriteOutput) + end if + if (allocated(SrcOutputData%BlPitchCom)) then + LB(1:1) = lbound(SrcOutputData%BlPitchCom) + UB(1:1) = ubound(SrcOutputData%BlPitchCom) + if (.not. allocated(DstOutputData%BlPitchCom)) then + allocate(DstOutputData%BlPitchCom(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BlPitchCom.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%BlPitchCom = SrcOutputData%BlPitchCom + else if (allocated(DstOutputData%BlPitchCom)) then + deallocate(DstOutputData%BlPitchCom) + end if + if (allocated(SrcOutputData%BlAirfoilCom)) then + LB(1:1) = lbound(SrcOutputData%BlAirfoilCom) + UB(1:1) = ubound(SrcOutputData%BlAirfoilCom) + if (.not. allocated(DstOutputData%BlAirfoilCom)) then + allocate(DstOutputData%BlAirfoilCom(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BlAirfoilCom.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%BlAirfoilCom = SrcOutputData%BlAirfoilCom + else if (allocated(DstOutputData%BlAirfoilCom)) then + deallocate(DstOutputData%BlAirfoilCom) + end if + DstOutputData%YawMom = SrcOutputData%YawMom + DstOutputData%GenTrq = SrcOutputData%GenTrq + DstOutputData%HSSBrTrqC = SrcOutputData%HSSBrTrqC + DstOutputData%ElecPwr = SrcOutputData%ElecPwr + if (allocated(SrcOutputData%TBDrCon)) then + LB(1:1) = lbound(SrcOutputData%TBDrCon) + UB(1:1) = ubound(SrcOutputData%TBDrCon) + if (.not. allocated(DstOutputData%TBDrCon)) then + allocate(DstOutputData%TBDrCon(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%TBDrCon.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%TBDrCon = SrcOutputData%TBDrCon + else if (allocated(DstOutputData%TBDrCon)) then + deallocate(DstOutputData%TBDrCon) + end if + if (allocated(SrcOutputData%Lidar)) then + LB(1:1) = lbound(SrcOutputData%Lidar) + UB(1:1) = ubound(SrcOutputData%Lidar) + if (.not. allocated(DstOutputData%Lidar)) then + allocate(DstOutputData%Lidar(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Lidar.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Lidar = SrcOutputData%Lidar + else if (allocated(DstOutputData%Lidar)) then + deallocate(DstOutputData%Lidar) + end if + if (allocated(SrcOutputData%CableDeltaL)) then + LB(1:1) = lbound(SrcOutputData%CableDeltaL) + UB(1:1) = ubound(SrcOutputData%CableDeltaL) + if (.not. allocated(DstOutputData%CableDeltaL)) then + allocate(DstOutputData%CableDeltaL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%CableDeltaL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%CableDeltaL = SrcOutputData%CableDeltaL + else if (allocated(DstOutputData%CableDeltaL)) then + deallocate(DstOutputData%CableDeltaL) + end if + if (allocated(SrcOutputData%CableDeltaLdot)) then + LB(1:1) = lbound(SrcOutputData%CableDeltaLdot) + UB(1:1) = ubound(SrcOutputData%CableDeltaLdot) + if (.not. allocated(DstOutputData%CableDeltaLdot)) then + allocate(DstOutputData%CableDeltaLdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%CableDeltaLdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%CableDeltaLdot = SrcOutputData%CableDeltaLdot + else if (allocated(DstOutputData%CableDeltaLdot)) then + deallocate(DstOutputData%CableDeltaLdot) + end if + if (allocated(SrcOutputData%BStCLoadMesh)) then + LB(1:2) = lbound(SrcOutputData%BStCLoadMesh) + UB(1:2) = ubound(SrcOutputData%BStCLoadMesh) + if (.not. allocated(DstOutputData%BStCLoadMesh)) then + allocate(DstOutputData%BStCLoadMesh(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BStCLoadMesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call MeshCopy(SrcOutputData%BStCLoadMesh(i1,i2), DstOutputData%BStCLoadMesh(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + else if (allocated(DstOutputData%BStCLoadMesh)) then + deallocate(DstOutputData%BStCLoadMesh) + end if + if (allocated(SrcOutputData%NStCLoadMesh)) then + LB(1:1) = lbound(SrcOutputData%NStCLoadMesh) + UB(1:1) = ubound(SrcOutputData%NStCLoadMesh) + if (.not. allocated(DstOutputData%NStCLoadMesh)) then + allocate(DstOutputData%NStCLoadMesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%NStCLoadMesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcOutputData%NStCLoadMesh(i1), DstOutputData%NStCLoadMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstOutputData%NStCLoadMesh)) then + deallocate(DstOutputData%NStCLoadMesh) + end if + if (allocated(SrcOutputData%TStCLoadMesh)) then + LB(1:1) = lbound(SrcOutputData%TStCLoadMesh) + UB(1:1) = ubound(SrcOutputData%TStCLoadMesh) + if (.not. allocated(DstOutputData%TStCLoadMesh)) then + allocate(DstOutputData%TStCLoadMesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%TStCLoadMesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcOutputData%TStCLoadMesh(i1), DstOutputData%TStCLoadMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstOutputData%TStCLoadMesh)) then + deallocate(DstOutputData%TStCLoadMesh) + end if + if (allocated(SrcOutputData%SStCLoadMesh)) then + LB(1:1) = lbound(SrcOutputData%SStCLoadMesh) + UB(1:1) = ubound(SrcOutputData%SStCLoadMesh) + if (.not. allocated(DstOutputData%SStCLoadMesh)) then + allocate(DstOutputData%SStCLoadMesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%SStCLoadMesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcOutputData%SStCLoadMesh(i1), DstOutputData%SStCLoadMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstOutputData%SStCLoadMesh)) then + deallocate(DstOutputData%SStCLoadMesh) + end if + if (allocated(SrcOutputData%toSC)) then + LB(1:1) = lbound(SrcOutputData%toSC) + UB(1:1) = ubound(SrcOutputData%toSC) + if (.not. allocated(DstOutputData%toSC)) then + allocate(DstOutputData%toSC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%toSC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%toSC = SrcOutputData%toSC + else if (allocated(DstOutputData%toSC)) then + deallocate(DstOutputData%toSC) + end if +end subroutine +subroutine SrvD_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(SrvD_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SrvD_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if + if (allocated(OutputData%BlPitchCom)) then + deallocate(OutputData%BlPitchCom) + end if + if (allocated(OutputData%BlAirfoilCom)) then + deallocate(OutputData%BlAirfoilCom) + end if + if (allocated(OutputData%TBDrCon)) then + deallocate(OutputData%TBDrCon) + end if + if (allocated(OutputData%Lidar)) then + deallocate(OutputData%Lidar) + end if + if (allocated(OutputData%CableDeltaL)) then + deallocate(OutputData%CableDeltaL) + end if + if (allocated(OutputData%CableDeltaLdot)) then + deallocate(OutputData%CableDeltaLdot) + end if + if (allocated(OutputData%BStCLoadMesh)) then + LB(1:2) = lbound(OutputData%BStCLoadMesh) + UB(1:2) = ubound(OutputData%BStCLoadMesh) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call MeshDestroy( OutputData%BStCLoadMesh(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(OutputData%BStCLoadMesh) + end if + if (allocated(OutputData%NStCLoadMesh)) then + LB(1:1) = lbound(OutputData%NStCLoadMesh) + UB(1:1) = ubound(OutputData%NStCLoadMesh) + do i1 = LB(1), UB(1) + call MeshDestroy( OutputData%NStCLoadMesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%NStCLoadMesh) + end if + if (allocated(OutputData%TStCLoadMesh)) then + LB(1:1) = lbound(OutputData%TStCLoadMesh) + UB(1:1) = ubound(OutputData%TStCLoadMesh) + do i1 = LB(1), UB(1) + call MeshDestroy( OutputData%TStCLoadMesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%TStCLoadMesh) + end if + if (allocated(OutputData%SStCLoadMesh)) then + LB(1:1) = lbound(OutputData%SStCLoadMesh) + UB(1:1) = ubound(OutputData%SStCLoadMesh) + do i1 = LB(1), UB(1) + call MeshDestroy( OutputData%SStCLoadMesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%SStCLoadMesh) + end if + if (allocated(OutputData%toSC)) then + deallocate(OutputData%toSC) + end if +end subroutine subroutine SrvD_PackOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -9731,68 +9020,56 @@ subroutine SrvD_PackOutput(Buf, Indata) integer(IntKi) :: i1, i2 integer(IntKi) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return - ! WriteOutput call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) call RegPack(Buf, InData%WriteOutput) end if if (RegCheckErr(Buf, RoutineName)) return - ! BlPitchCom call RegPack(Buf, allocated(InData%BlPitchCom)) if (allocated(InData%BlPitchCom)) then call RegPackBounds(Buf, 1, lbound(InData%BlPitchCom), ubound(InData%BlPitchCom)) call RegPack(Buf, InData%BlPitchCom) end if if (RegCheckErr(Buf, RoutineName)) return - ! BlAirfoilCom call RegPack(Buf, allocated(InData%BlAirfoilCom)) if (allocated(InData%BlAirfoilCom)) then call RegPackBounds(Buf, 1, lbound(InData%BlAirfoilCom), ubound(InData%BlAirfoilCom)) call RegPack(Buf, InData%BlAirfoilCom) end if if (RegCheckErr(Buf, RoutineName)) return - ! YawMom call RegPack(Buf, InData%YawMom) if (RegCheckErr(Buf, RoutineName)) return - ! GenTrq call RegPack(Buf, InData%GenTrq) if (RegCheckErr(Buf, RoutineName)) return - ! HSSBrTrqC call RegPack(Buf, InData%HSSBrTrqC) if (RegCheckErr(Buf, RoutineName)) return - ! ElecPwr call RegPack(Buf, InData%ElecPwr) if (RegCheckErr(Buf, RoutineName)) return - ! TBDrCon call RegPack(Buf, allocated(InData%TBDrCon)) if (allocated(InData%TBDrCon)) then call RegPackBounds(Buf, 1, lbound(InData%TBDrCon), ubound(InData%TBDrCon)) call RegPack(Buf, InData%TBDrCon) end if if (RegCheckErr(Buf, RoutineName)) return - ! Lidar call RegPack(Buf, allocated(InData%Lidar)) if (allocated(InData%Lidar)) then call RegPackBounds(Buf, 1, lbound(InData%Lidar), ubound(InData%Lidar)) call RegPack(Buf, InData%Lidar) end if if (RegCheckErr(Buf, RoutineName)) return - ! CableDeltaL call RegPack(Buf, allocated(InData%CableDeltaL)) if (allocated(InData%CableDeltaL)) then call RegPackBounds(Buf, 1, lbound(InData%CableDeltaL), ubound(InData%CableDeltaL)) call RegPack(Buf, InData%CableDeltaL) end if if (RegCheckErr(Buf, RoutineName)) return - ! CableDeltaLdot call RegPack(Buf, allocated(InData%CableDeltaLdot)) if (allocated(InData%CableDeltaLdot)) then call RegPackBounds(Buf, 1, lbound(InData%CableDeltaLdot), ubound(InData%CableDeltaLdot)) call RegPack(Buf, InData%CableDeltaLdot) end if if (RegCheckErr(Buf, RoutineName)) return - ! BStCLoadMesh call RegPack(Buf, allocated(InData%BStCLoadMesh)) if (allocated(InData%BStCLoadMesh)) then call RegPackBounds(Buf, 2, lbound(InData%BStCLoadMesh), ubound(InData%BStCLoadMesh)) @@ -9805,7 +9082,6 @@ subroutine SrvD_PackOutput(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! NStCLoadMesh call RegPack(Buf, allocated(InData%NStCLoadMesh)) if (allocated(InData%NStCLoadMesh)) then call RegPackBounds(Buf, 1, lbound(InData%NStCLoadMesh), ubound(InData%NStCLoadMesh)) @@ -9816,7 +9092,6 @@ subroutine SrvD_PackOutput(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! TStCLoadMesh call RegPack(Buf, allocated(InData%TStCLoadMesh)) if (allocated(InData%TStCLoadMesh)) then call RegPackBounds(Buf, 1, lbound(InData%TStCLoadMesh), ubound(InData%TStCLoadMesh)) @@ -9827,7 +9102,6 @@ subroutine SrvD_PackOutput(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! SStCLoadMesh call RegPack(Buf, allocated(InData%SStCLoadMesh)) if (allocated(InData%SStCLoadMesh)) then call RegPackBounds(Buf, 1, lbound(InData%SStCLoadMesh), ubound(InData%SStCLoadMesh)) @@ -9838,7 +9112,6 @@ subroutine SrvD_PackOutput(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! toSC call RegPack(Buf, allocated(InData%toSC)) if (allocated(InData%toSC)) then call RegPackBounds(Buf, 1, lbound(InData%toSC), ubound(InData%toSC)) @@ -9856,7 +9129,6 @@ subroutine SrvD_UnPackOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! WriteOutput if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -9871,7 +9143,6 @@ subroutine SrvD_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutput) if (RegCheckErr(Buf, RoutineName)) return end if - ! BlPitchCom if (allocated(OutData%BlPitchCom)) deallocate(OutData%BlPitchCom) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -9886,7 +9157,6 @@ subroutine SrvD_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%BlPitchCom) if (RegCheckErr(Buf, RoutineName)) return end if - ! BlAirfoilCom if (allocated(OutData%BlAirfoilCom)) deallocate(OutData%BlAirfoilCom) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -9901,19 +9171,14 @@ subroutine SrvD_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%BlAirfoilCom) if (RegCheckErr(Buf, RoutineName)) return end if - ! YawMom call RegUnpack(Buf, OutData%YawMom) if (RegCheckErr(Buf, RoutineName)) return - ! GenTrq call RegUnpack(Buf, OutData%GenTrq) if (RegCheckErr(Buf, RoutineName)) return - ! HSSBrTrqC call RegUnpack(Buf, OutData%HSSBrTrqC) if (RegCheckErr(Buf, RoutineName)) return - ! ElecPwr call RegUnpack(Buf, OutData%ElecPwr) if (RegCheckErr(Buf, RoutineName)) return - ! TBDrCon if (allocated(OutData%TBDrCon)) deallocate(OutData%TBDrCon) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -9928,7 +9193,6 @@ subroutine SrvD_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%TBDrCon) if (RegCheckErr(Buf, RoutineName)) return end if - ! Lidar if (allocated(OutData%Lidar)) deallocate(OutData%Lidar) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -9943,7 +9207,6 @@ subroutine SrvD_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%Lidar) if (RegCheckErr(Buf, RoutineName)) return end if - ! CableDeltaL if (allocated(OutData%CableDeltaL)) deallocate(OutData%CableDeltaL) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -9958,7 +9221,6 @@ subroutine SrvD_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%CableDeltaL) if (RegCheckErr(Buf, RoutineName)) return end if - ! CableDeltaLdot if (allocated(OutData%CableDeltaLdot)) deallocate(OutData%CableDeltaLdot) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -9973,7 +9235,6 @@ subroutine SrvD_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%CableDeltaLdot) if (RegCheckErr(Buf, RoutineName)) return end if - ! BStCLoadMesh if (allocated(OutData%BStCLoadMesh)) deallocate(OutData%BStCLoadMesh) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -9991,7 +9252,6 @@ subroutine SrvD_UnPackOutput(Buf, OutData) end do end do end if - ! NStCLoadMesh if (allocated(OutData%NStCLoadMesh)) deallocate(OutData%NStCLoadMesh) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -10007,7 +9267,6 @@ subroutine SrvD_UnPackOutput(Buf, OutData) call MeshUnpack(Buf, OutData%NStCLoadMesh(i1)) ! NStCLoadMesh end do end if - ! TStCLoadMesh if (allocated(OutData%TStCLoadMesh)) deallocate(OutData%TStCLoadMesh) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -10023,7 +9282,6 @@ subroutine SrvD_UnPackOutput(Buf, OutData) call MeshUnpack(Buf, OutData%TStCLoadMesh(i1)) ! TStCLoadMesh end do end if - ! SStCLoadMesh if (allocated(OutData%SStCLoadMesh)) deallocate(OutData%SStCLoadMesh) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -10039,7 +9297,6 @@ subroutine SrvD_UnPackOutput(Buf, OutData) call MeshUnpack(Buf, OutData%SStCLoadMesh(i1)) ! SStCLoadMesh end do end if - ! toSC if (allocated(OutData%toSC)) deallocate(OutData%toSC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/servodyn/src/StrucCtrl_Types.f90 b/modules/servodyn/src/StrucCtrl_Types.f90 index f82fb8c5d7..25481e1336 100644 --- a/modules/servodyn/src/StrucCtrl_Types.f90 +++ b/modules/servodyn/src/StrucCtrl_Types.f90 @@ -249,361 +249,286 @@ MODULE StrucCtrl_Types END TYPE StC_OutputType ! ======================= CONTAINS - SUBROUTINE StC_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) - TYPE(StC_InputFile), INTENT(IN) :: SrcInputFileData - TYPE(StC_InputFile), INTENT(INOUT) :: DstInputFileData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_CopyInputFile' -! + +subroutine StC_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg) + type(StC_InputFile), intent(in) :: SrcInputFileData + type(StC_InputFile), intent(inout) :: DstInputFileData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'StC_CopyInputFile' ErrStat = ErrID_None - ErrMsg = "" - DstInputFileData%StCFileName = SrcInputFileData%StCFileName - DstInputFileData%Echo = SrcInputFileData%Echo - DstInputFileData%StC_CMODE = SrcInputFileData%StC_CMODE - DstInputFileData%StC_SA_MODE = SrcInputFileData%StC_SA_MODE - DstInputFileData%StC_DOF_MODE = SrcInputFileData%StC_DOF_MODE - DstInputFileData%StC_X_DOF = SrcInputFileData%StC_X_DOF - DstInputFileData%StC_Y_DOF = SrcInputFileData%StC_Y_DOF - DstInputFileData%StC_Z_DOF = SrcInputFileData%StC_Z_DOF - DstInputFileData%StC_X_DSP = SrcInputFileData%StC_X_DSP - DstInputFileData%StC_Y_DSP = SrcInputFileData%StC_Y_DSP - DstInputFileData%StC_Z_DSP = SrcInputFileData%StC_Z_DSP - DstInputFileData%StC_Z_PreLdC = SrcInputFileData%StC_Z_PreLdC - DstInputFileData%StC_X_M = SrcInputFileData%StC_X_M - DstInputFileData%StC_Y_M = SrcInputFileData%StC_Y_M - DstInputFileData%StC_Z_M = SrcInputFileData%StC_Z_M - DstInputFileData%StC_XY_M = SrcInputFileData%StC_XY_M - DstInputFileData%StC_X_K = SrcInputFileData%StC_X_K - DstInputFileData%StC_Y_K = SrcInputFileData%StC_Y_K - DstInputFileData%StC_Z_K = SrcInputFileData%StC_Z_K - DstInputFileData%StC_X_C = SrcInputFileData%StC_X_C - DstInputFileData%StC_Y_C = SrcInputFileData%StC_Y_C - DstInputFileData%StC_Z_C = SrcInputFileData%StC_Z_C - DstInputFileData%StC_X_PSP = SrcInputFileData%StC_X_PSP - DstInputFileData%StC_X_NSP = SrcInputFileData%StC_X_NSP - DstInputFileData%StC_Y_PSP = SrcInputFileData%StC_Y_PSP - DstInputFileData%StC_Y_NSP = SrcInputFileData%StC_Y_NSP - DstInputFileData%StC_Z_PSP = SrcInputFileData%StC_Z_PSP - DstInputFileData%StC_Z_NSP = SrcInputFileData%StC_Z_NSP - DstInputFileData%StC_X_KS = SrcInputFileData%StC_X_KS - DstInputFileData%StC_X_CS = SrcInputFileData%StC_X_CS - DstInputFileData%StC_Y_KS = SrcInputFileData%StC_Y_KS - DstInputFileData%StC_Y_CS = SrcInputFileData%StC_Y_CS - DstInputFileData%StC_Z_KS = SrcInputFileData%StC_Z_KS - DstInputFileData%StC_Z_CS = SrcInputFileData%StC_Z_CS - DstInputFileData%StC_P_X = SrcInputFileData%StC_P_X - DstInputFileData%StC_P_Y = SrcInputFileData%StC_P_Y - DstInputFileData%StC_P_Z = SrcInputFileData%StC_P_Z - DstInputFileData%StC_X_C_HIGH = SrcInputFileData%StC_X_C_HIGH - DstInputFileData%StC_X_C_LOW = SrcInputFileData%StC_X_C_LOW - DstInputFileData%StC_Y_C_HIGH = SrcInputFileData%StC_Y_C_HIGH - DstInputFileData%StC_Y_C_LOW = SrcInputFileData%StC_Y_C_LOW - DstInputFileData%StC_Z_C_HIGH = SrcInputFileData%StC_Z_C_HIGH - DstInputFileData%StC_Z_C_LOW = SrcInputFileData%StC_Z_C_LOW - DstInputFileData%StC_X_C_BRAKE = SrcInputFileData%StC_X_C_BRAKE - DstInputFileData%StC_Y_C_BRAKE = SrcInputFileData%StC_Y_C_BRAKE - DstInputFileData%StC_Z_C_BRAKE = SrcInputFileData%StC_Z_C_BRAKE - DstInputFileData%L_X = SrcInputFileData%L_X - DstInputFileData%B_X = SrcInputFileData%B_X - DstInputFileData%area_X = SrcInputFileData%area_X - DstInputFileData%area_ratio_X = SrcInputFileData%area_ratio_X - DstInputFileData%headLossCoeff_X = SrcInputFileData%headLossCoeff_X - DstInputFileData%rho_X = SrcInputFileData%rho_X - DstInputFileData%L_Y = SrcInputFileData%L_Y - DstInputFileData%B_Y = SrcInputFileData%B_Y - DstInputFileData%area_Y = SrcInputFileData%area_Y - DstInputFileData%area_ratio_Y = SrcInputFileData%area_ratio_Y - DstInputFileData%headLossCoeff_Y = SrcInputFileData%headLossCoeff_Y - DstInputFileData%rho_Y = SrcInputFileData%rho_Y - DstInputFileData%USE_F_TBL = SrcInputFileData%USE_F_TBL - DstInputFileData%NKInpSt = SrcInputFileData%NKInpSt - DstInputFileData%StC_F_TBL_FILE = SrcInputFileData%StC_F_TBL_FILE -IF (ALLOCATED(SrcInputFileData%F_TBL)) THEN - i1_l = LBOUND(SrcInputFileData%F_TBL,1) - i1_u = UBOUND(SrcInputFileData%F_TBL,1) - i2_l = LBOUND(SrcInputFileData%F_TBL,2) - i2_u = UBOUND(SrcInputFileData%F_TBL,2) - IF (.NOT. ALLOCATED(DstInputFileData%F_TBL)) THEN - ALLOCATE(DstInputFileData%F_TBL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%F_TBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%F_TBL = SrcInputFileData%F_TBL -ENDIF - DstInputFileData%PrescribedForcesCoordSys = SrcInputFileData%PrescribedForcesCoordSys - DstInputFileData%PrescribedForcesFile = SrcInputFileData%PrescribedForcesFile -IF (ALLOCATED(SrcInputFileData%StC_PrescribedForce)) THEN - i1_l = LBOUND(SrcInputFileData%StC_PrescribedForce,1) - i1_u = UBOUND(SrcInputFileData%StC_PrescribedForce,1) - i2_l = LBOUND(SrcInputFileData%StC_PrescribedForce,2) - i2_u = UBOUND(SrcInputFileData%StC_PrescribedForce,2) - IF (.NOT. ALLOCATED(DstInputFileData%StC_PrescribedForce)) THEN - ALLOCATE(DstInputFileData%StC_PrescribedForce(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%StC_PrescribedForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%StC_PrescribedForce = SrcInputFileData%StC_PrescribedForce -ENDIF -IF (ALLOCATED(SrcInputFileData%StC_CChan)) THEN - i1_l = LBOUND(SrcInputFileData%StC_CChan,1) - i1_u = UBOUND(SrcInputFileData%StC_CChan,1) - IF (.NOT. ALLOCATED(DstInputFileData%StC_CChan)) THEN - ALLOCATE(DstInputFileData%StC_CChan(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%StC_CChan.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%StC_CChan = SrcInputFileData%StC_CChan -ENDIF - END SUBROUTINE StC_CopyInputFile - - SUBROUTINE StC_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) - TYPE(StC_InputFile), INTENT(INOUT) :: InputFileData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyInputFile' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputFileData%F_TBL)) THEN - DEALLOCATE(InputFileData%F_TBL) -ENDIF -IF (ALLOCATED(InputFileData%StC_PrescribedForce)) THEN - DEALLOCATE(InputFileData%StC_PrescribedForce) -ENDIF -IF (ALLOCATED(InputFileData%StC_CChan)) THEN - DEALLOCATE(InputFileData%StC_CChan) -ENDIF - END SUBROUTINE StC_DestroyInputFile + ErrMsg = '' + DstInputFileData%StCFileName = SrcInputFileData%StCFileName + DstInputFileData%Echo = SrcInputFileData%Echo + DstInputFileData%StC_CMODE = SrcInputFileData%StC_CMODE + DstInputFileData%StC_SA_MODE = SrcInputFileData%StC_SA_MODE + DstInputFileData%StC_DOF_MODE = SrcInputFileData%StC_DOF_MODE + DstInputFileData%StC_X_DOF = SrcInputFileData%StC_X_DOF + DstInputFileData%StC_Y_DOF = SrcInputFileData%StC_Y_DOF + DstInputFileData%StC_Z_DOF = SrcInputFileData%StC_Z_DOF + DstInputFileData%StC_X_DSP = SrcInputFileData%StC_X_DSP + DstInputFileData%StC_Y_DSP = SrcInputFileData%StC_Y_DSP + DstInputFileData%StC_Z_DSP = SrcInputFileData%StC_Z_DSP + DstInputFileData%StC_Z_PreLdC = SrcInputFileData%StC_Z_PreLdC + DstInputFileData%StC_X_M = SrcInputFileData%StC_X_M + DstInputFileData%StC_Y_M = SrcInputFileData%StC_Y_M + DstInputFileData%StC_Z_M = SrcInputFileData%StC_Z_M + DstInputFileData%StC_XY_M = SrcInputFileData%StC_XY_M + DstInputFileData%StC_X_K = SrcInputFileData%StC_X_K + DstInputFileData%StC_Y_K = SrcInputFileData%StC_Y_K + DstInputFileData%StC_Z_K = SrcInputFileData%StC_Z_K + DstInputFileData%StC_X_C = SrcInputFileData%StC_X_C + DstInputFileData%StC_Y_C = SrcInputFileData%StC_Y_C + DstInputFileData%StC_Z_C = SrcInputFileData%StC_Z_C + DstInputFileData%StC_X_PSP = SrcInputFileData%StC_X_PSP + DstInputFileData%StC_X_NSP = SrcInputFileData%StC_X_NSP + DstInputFileData%StC_Y_PSP = SrcInputFileData%StC_Y_PSP + DstInputFileData%StC_Y_NSP = SrcInputFileData%StC_Y_NSP + DstInputFileData%StC_Z_PSP = SrcInputFileData%StC_Z_PSP + DstInputFileData%StC_Z_NSP = SrcInputFileData%StC_Z_NSP + DstInputFileData%StC_X_KS = SrcInputFileData%StC_X_KS + DstInputFileData%StC_X_CS = SrcInputFileData%StC_X_CS + DstInputFileData%StC_Y_KS = SrcInputFileData%StC_Y_KS + DstInputFileData%StC_Y_CS = SrcInputFileData%StC_Y_CS + DstInputFileData%StC_Z_KS = SrcInputFileData%StC_Z_KS + DstInputFileData%StC_Z_CS = SrcInputFileData%StC_Z_CS + DstInputFileData%StC_P_X = SrcInputFileData%StC_P_X + DstInputFileData%StC_P_Y = SrcInputFileData%StC_P_Y + DstInputFileData%StC_P_Z = SrcInputFileData%StC_P_Z + DstInputFileData%StC_X_C_HIGH = SrcInputFileData%StC_X_C_HIGH + DstInputFileData%StC_X_C_LOW = SrcInputFileData%StC_X_C_LOW + DstInputFileData%StC_Y_C_HIGH = SrcInputFileData%StC_Y_C_HIGH + DstInputFileData%StC_Y_C_LOW = SrcInputFileData%StC_Y_C_LOW + DstInputFileData%StC_Z_C_HIGH = SrcInputFileData%StC_Z_C_HIGH + DstInputFileData%StC_Z_C_LOW = SrcInputFileData%StC_Z_C_LOW + DstInputFileData%StC_X_C_BRAKE = SrcInputFileData%StC_X_C_BRAKE + DstInputFileData%StC_Y_C_BRAKE = SrcInputFileData%StC_Y_C_BRAKE + DstInputFileData%StC_Z_C_BRAKE = SrcInputFileData%StC_Z_C_BRAKE + DstInputFileData%L_X = SrcInputFileData%L_X + DstInputFileData%B_X = SrcInputFileData%B_X + DstInputFileData%area_X = SrcInputFileData%area_X + DstInputFileData%area_ratio_X = SrcInputFileData%area_ratio_X + DstInputFileData%headLossCoeff_X = SrcInputFileData%headLossCoeff_X + DstInputFileData%rho_X = SrcInputFileData%rho_X + DstInputFileData%L_Y = SrcInputFileData%L_Y + DstInputFileData%B_Y = SrcInputFileData%B_Y + DstInputFileData%area_Y = SrcInputFileData%area_Y + DstInputFileData%area_ratio_Y = SrcInputFileData%area_ratio_Y + DstInputFileData%headLossCoeff_Y = SrcInputFileData%headLossCoeff_Y + DstInputFileData%rho_Y = SrcInputFileData%rho_Y + DstInputFileData%USE_F_TBL = SrcInputFileData%USE_F_TBL + DstInputFileData%NKInpSt = SrcInputFileData%NKInpSt + DstInputFileData%StC_F_TBL_FILE = SrcInputFileData%StC_F_TBL_FILE + if (allocated(SrcInputFileData%F_TBL)) then + LB(1:2) = lbound(SrcInputFileData%F_TBL) + UB(1:2) = ubound(SrcInputFileData%F_TBL) + if (.not. allocated(DstInputFileData%F_TBL)) then + allocate(DstInputFileData%F_TBL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%F_TBL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%F_TBL = SrcInputFileData%F_TBL + else if (allocated(DstInputFileData%F_TBL)) then + deallocate(DstInputFileData%F_TBL) + end if + DstInputFileData%PrescribedForcesCoordSys = SrcInputFileData%PrescribedForcesCoordSys + DstInputFileData%PrescribedForcesFile = SrcInputFileData%PrescribedForcesFile + if (allocated(SrcInputFileData%StC_PrescribedForce)) then + LB(1:2) = lbound(SrcInputFileData%StC_PrescribedForce) + UB(1:2) = ubound(SrcInputFileData%StC_PrescribedForce) + if (.not. allocated(DstInputFileData%StC_PrescribedForce)) then + allocate(DstInputFileData%StC_PrescribedForce(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%StC_PrescribedForce.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%StC_PrescribedForce = SrcInputFileData%StC_PrescribedForce + else if (allocated(DstInputFileData%StC_PrescribedForce)) then + deallocate(DstInputFileData%StC_PrescribedForce) + end if + if (allocated(SrcInputFileData%StC_CChan)) then + LB(1:1) = lbound(SrcInputFileData%StC_CChan) + UB(1:1) = ubound(SrcInputFileData%StC_CChan) + if (.not. allocated(DstInputFileData%StC_CChan)) then + allocate(DstInputFileData%StC_CChan(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%StC_CChan.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%StC_CChan = SrcInputFileData%StC_CChan + else if (allocated(DstInputFileData%StC_CChan)) then + deallocate(DstInputFileData%StC_CChan) + end if +end subroutine +subroutine StC_DestroyInputFile(InputFileData, ErrStat, ErrMsg) + type(StC_InputFile), intent(inout) :: InputFileData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'StC_DestroyInputFile' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputFileData%F_TBL)) then + deallocate(InputFileData%F_TBL) + end if + if (allocated(InputFileData%StC_PrescribedForce)) then + deallocate(InputFileData%StC_PrescribedForce) + end if + if (allocated(InputFileData%StC_CChan)) then + deallocate(InputFileData%StC_CChan) + end if +end subroutine subroutine StC_PackInputFile(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(StC_InputFile), intent(in) :: InData character(*), parameter :: RoutineName = 'StC_PackInputFile' if (Buf%ErrStat >= AbortErrLev) return - ! StCFileName call RegPack(Buf, InData%StCFileName) if (RegCheckErr(Buf, RoutineName)) return - ! Echo call RegPack(Buf, InData%Echo) if (RegCheckErr(Buf, RoutineName)) return - ! StC_CMODE call RegPack(Buf, InData%StC_CMODE) if (RegCheckErr(Buf, RoutineName)) return - ! StC_SA_MODE call RegPack(Buf, InData%StC_SA_MODE) if (RegCheckErr(Buf, RoutineName)) return - ! StC_DOF_MODE call RegPack(Buf, InData%StC_DOF_MODE) if (RegCheckErr(Buf, RoutineName)) return - ! StC_X_DOF call RegPack(Buf, InData%StC_X_DOF) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Y_DOF call RegPack(Buf, InData%StC_Y_DOF) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Z_DOF call RegPack(Buf, InData%StC_Z_DOF) if (RegCheckErr(Buf, RoutineName)) return - ! StC_X_DSP call RegPack(Buf, InData%StC_X_DSP) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Y_DSP call RegPack(Buf, InData%StC_Y_DSP) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Z_DSP call RegPack(Buf, InData%StC_Z_DSP) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Z_PreLdC call RegPack(Buf, InData%StC_Z_PreLdC) if (RegCheckErr(Buf, RoutineName)) return - ! StC_X_M call RegPack(Buf, InData%StC_X_M) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Y_M call RegPack(Buf, InData%StC_Y_M) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Z_M call RegPack(Buf, InData%StC_Z_M) if (RegCheckErr(Buf, RoutineName)) return - ! StC_XY_M call RegPack(Buf, InData%StC_XY_M) if (RegCheckErr(Buf, RoutineName)) return - ! StC_X_K call RegPack(Buf, InData%StC_X_K) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Y_K call RegPack(Buf, InData%StC_Y_K) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Z_K call RegPack(Buf, InData%StC_Z_K) if (RegCheckErr(Buf, RoutineName)) return - ! StC_X_C call RegPack(Buf, InData%StC_X_C) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Y_C call RegPack(Buf, InData%StC_Y_C) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Z_C call RegPack(Buf, InData%StC_Z_C) if (RegCheckErr(Buf, RoutineName)) return - ! StC_X_PSP call RegPack(Buf, InData%StC_X_PSP) if (RegCheckErr(Buf, RoutineName)) return - ! StC_X_NSP call RegPack(Buf, InData%StC_X_NSP) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Y_PSP call RegPack(Buf, InData%StC_Y_PSP) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Y_NSP call RegPack(Buf, InData%StC_Y_NSP) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Z_PSP call RegPack(Buf, InData%StC_Z_PSP) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Z_NSP call RegPack(Buf, InData%StC_Z_NSP) if (RegCheckErr(Buf, RoutineName)) return - ! StC_X_KS call RegPack(Buf, InData%StC_X_KS) if (RegCheckErr(Buf, RoutineName)) return - ! StC_X_CS call RegPack(Buf, InData%StC_X_CS) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Y_KS call RegPack(Buf, InData%StC_Y_KS) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Y_CS call RegPack(Buf, InData%StC_Y_CS) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Z_KS call RegPack(Buf, InData%StC_Z_KS) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Z_CS call RegPack(Buf, InData%StC_Z_CS) if (RegCheckErr(Buf, RoutineName)) return - ! StC_P_X call RegPack(Buf, InData%StC_P_X) if (RegCheckErr(Buf, RoutineName)) return - ! StC_P_Y call RegPack(Buf, InData%StC_P_Y) if (RegCheckErr(Buf, RoutineName)) return - ! StC_P_Z call RegPack(Buf, InData%StC_P_Z) if (RegCheckErr(Buf, RoutineName)) return - ! StC_X_C_HIGH call RegPack(Buf, InData%StC_X_C_HIGH) if (RegCheckErr(Buf, RoutineName)) return - ! StC_X_C_LOW call RegPack(Buf, InData%StC_X_C_LOW) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Y_C_HIGH call RegPack(Buf, InData%StC_Y_C_HIGH) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Y_C_LOW call RegPack(Buf, InData%StC_Y_C_LOW) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Z_C_HIGH call RegPack(Buf, InData%StC_Z_C_HIGH) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Z_C_LOW call RegPack(Buf, InData%StC_Z_C_LOW) if (RegCheckErr(Buf, RoutineName)) return - ! StC_X_C_BRAKE call RegPack(Buf, InData%StC_X_C_BRAKE) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Y_C_BRAKE call RegPack(Buf, InData%StC_Y_C_BRAKE) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Z_C_BRAKE call RegPack(Buf, InData%StC_Z_C_BRAKE) if (RegCheckErr(Buf, RoutineName)) return - ! L_X call RegPack(Buf, InData%L_X) if (RegCheckErr(Buf, RoutineName)) return - ! B_X call RegPack(Buf, InData%B_X) if (RegCheckErr(Buf, RoutineName)) return - ! area_X call RegPack(Buf, InData%area_X) if (RegCheckErr(Buf, RoutineName)) return - ! area_ratio_X call RegPack(Buf, InData%area_ratio_X) if (RegCheckErr(Buf, RoutineName)) return - ! headLossCoeff_X call RegPack(Buf, InData%headLossCoeff_X) if (RegCheckErr(Buf, RoutineName)) return - ! rho_X call RegPack(Buf, InData%rho_X) if (RegCheckErr(Buf, RoutineName)) return - ! L_Y call RegPack(Buf, InData%L_Y) if (RegCheckErr(Buf, RoutineName)) return - ! B_Y call RegPack(Buf, InData%B_Y) if (RegCheckErr(Buf, RoutineName)) return - ! area_Y call RegPack(Buf, InData%area_Y) if (RegCheckErr(Buf, RoutineName)) return - ! area_ratio_Y call RegPack(Buf, InData%area_ratio_Y) if (RegCheckErr(Buf, RoutineName)) return - ! headLossCoeff_Y call RegPack(Buf, InData%headLossCoeff_Y) if (RegCheckErr(Buf, RoutineName)) return - ! rho_Y call RegPack(Buf, InData%rho_Y) if (RegCheckErr(Buf, RoutineName)) return - ! USE_F_TBL call RegPack(Buf, InData%USE_F_TBL) if (RegCheckErr(Buf, RoutineName)) return - ! NKInpSt call RegPack(Buf, InData%NKInpSt) if (RegCheckErr(Buf, RoutineName)) return - ! StC_F_TBL_FILE call RegPack(Buf, InData%StC_F_TBL_FILE) if (RegCheckErr(Buf, RoutineName)) return - ! F_TBL call RegPack(Buf, allocated(InData%F_TBL)) if (allocated(InData%F_TBL)) then call RegPackBounds(Buf, 2, lbound(InData%F_TBL), ubound(InData%F_TBL)) call RegPack(Buf, InData%F_TBL) end if if (RegCheckErr(Buf, RoutineName)) return - ! PrescribedForcesCoordSys call RegPack(Buf, InData%PrescribedForcesCoordSys) if (RegCheckErr(Buf, RoutineName)) return - ! PrescribedForcesFile call RegPack(Buf, InData%PrescribedForcesFile) if (RegCheckErr(Buf, RoutineName)) return - ! StC_PrescribedForce call RegPack(Buf, allocated(InData%StC_PrescribedForce)) if (allocated(InData%StC_PrescribedForce)) then call RegPackBounds(Buf, 2, lbound(InData%StC_PrescribedForce), ubound(InData%StC_PrescribedForce)) call RegPack(Buf, InData%StC_PrescribedForce) end if if (RegCheckErr(Buf, RoutineName)) return - ! StC_CChan call RegPack(Buf, allocated(InData%StC_CChan)) if (allocated(InData%StC_CChan)) then call RegPackBounds(Buf, 1, lbound(InData%StC_CChan), ubound(InData%StC_CChan)) @@ -620,190 +545,128 @@ subroutine StC_UnPackInputFile(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! StCFileName call RegUnpack(Buf, OutData%StCFileName) if (RegCheckErr(Buf, RoutineName)) return - ! Echo call RegUnpack(Buf, OutData%Echo) if (RegCheckErr(Buf, RoutineName)) return - ! StC_CMODE call RegUnpack(Buf, OutData%StC_CMODE) if (RegCheckErr(Buf, RoutineName)) return - ! StC_SA_MODE call RegUnpack(Buf, OutData%StC_SA_MODE) if (RegCheckErr(Buf, RoutineName)) return - ! StC_DOF_MODE call RegUnpack(Buf, OutData%StC_DOF_MODE) if (RegCheckErr(Buf, RoutineName)) return - ! StC_X_DOF call RegUnpack(Buf, OutData%StC_X_DOF) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Y_DOF call RegUnpack(Buf, OutData%StC_Y_DOF) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Z_DOF call RegUnpack(Buf, OutData%StC_Z_DOF) if (RegCheckErr(Buf, RoutineName)) return - ! StC_X_DSP call RegUnpack(Buf, OutData%StC_X_DSP) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Y_DSP call RegUnpack(Buf, OutData%StC_Y_DSP) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Z_DSP call RegUnpack(Buf, OutData%StC_Z_DSP) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Z_PreLdC call RegUnpack(Buf, OutData%StC_Z_PreLdC) if (RegCheckErr(Buf, RoutineName)) return - ! StC_X_M call RegUnpack(Buf, OutData%StC_X_M) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Y_M call RegUnpack(Buf, OutData%StC_Y_M) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Z_M call RegUnpack(Buf, OutData%StC_Z_M) if (RegCheckErr(Buf, RoutineName)) return - ! StC_XY_M call RegUnpack(Buf, OutData%StC_XY_M) if (RegCheckErr(Buf, RoutineName)) return - ! StC_X_K call RegUnpack(Buf, OutData%StC_X_K) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Y_K call RegUnpack(Buf, OutData%StC_Y_K) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Z_K call RegUnpack(Buf, OutData%StC_Z_K) if (RegCheckErr(Buf, RoutineName)) return - ! StC_X_C call RegUnpack(Buf, OutData%StC_X_C) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Y_C call RegUnpack(Buf, OutData%StC_Y_C) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Z_C call RegUnpack(Buf, OutData%StC_Z_C) if (RegCheckErr(Buf, RoutineName)) return - ! StC_X_PSP call RegUnpack(Buf, OutData%StC_X_PSP) if (RegCheckErr(Buf, RoutineName)) return - ! StC_X_NSP call RegUnpack(Buf, OutData%StC_X_NSP) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Y_PSP call RegUnpack(Buf, OutData%StC_Y_PSP) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Y_NSP call RegUnpack(Buf, OutData%StC_Y_NSP) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Z_PSP call RegUnpack(Buf, OutData%StC_Z_PSP) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Z_NSP call RegUnpack(Buf, OutData%StC_Z_NSP) if (RegCheckErr(Buf, RoutineName)) return - ! StC_X_KS call RegUnpack(Buf, OutData%StC_X_KS) if (RegCheckErr(Buf, RoutineName)) return - ! StC_X_CS call RegUnpack(Buf, OutData%StC_X_CS) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Y_KS call RegUnpack(Buf, OutData%StC_Y_KS) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Y_CS call RegUnpack(Buf, OutData%StC_Y_CS) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Z_KS call RegUnpack(Buf, OutData%StC_Z_KS) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Z_CS call RegUnpack(Buf, OutData%StC_Z_CS) if (RegCheckErr(Buf, RoutineName)) return - ! StC_P_X call RegUnpack(Buf, OutData%StC_P_X) if (RegCheckErr(Buf, RoutineName)) return - ! StC_P_Y call RegUnpack(Buf, OutData%StC_P_Y) if (RegCheckErr(Buf, RoutineName)) return - ! StC_P_Z call RegUnpack(Buf, OutData%StC_P_Z) if (RegCheckErr(Buf, RoutineName)) return - ! StC_X_C_HIGH call RegUnpack(Buf, OutData%StC_X_C_HIGH) if (RegCheckErr(Buf, RoutineName)) return - ! StC_X_C_LOW call RegUnpack(Buf, OutData%StC_X_C_LOW) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Y_C_HIGH call RegUnpack(Buf, OutData%StC_Y_C_HIGH) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Y_C_LOW call RegUnpack(Buf, OutData%StC_Y_C_LOW) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Z_C_HIGH call RegUnpack(Buf, OutData%StC_Z_C_HIGH) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Z_C_LOW call RegUnpack(Buf, OutData%StC_Z_C_LOW) if (RegCheckErr(Buf, RoutineName)) return - ! StC_X_C_BRAKE call RegUnpack(Buf, OutData%StC_X_C_BRAKE) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Y_C_BRAKE call RegUnpack(Buf, OutData%StC_Y_C_BRAKE) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Z_C_BRAKE call RegUnpack(Buf, OutData%StC_Z_C_BRAKE) if (RegCheckErr(Buf, RoutineName)) return - ! L_X call RegUnpack(Buf, OutData%L_X) if (RegCheckErr(Buf, RoutineName)) return - ! B_X call RegUnpack(Buf, OutData%B_X) if (RegCheckErr(Buf, RoutineName)) return - ! area_X call RegUnpack(Buf, OutData%area_X) if (RegCheckErr(Buf, RoutineName)) return - ! area_ratio_X call RegUnpack(Buf, OutData%area_ratio_X) if (RegCheckErr(Buf, RoutineName)) return - ! headLossCoeff_X call RegUnpack(Buf, OutData%headLossCoeff_X) if (RegCheckErr(Buf, RoutineName)) return - ! rho_X call RegUnpack(Buf, OutData%rho_X) if (RegCheckErr(Buf, RoutineName)) return - ! L_Y call RegUnpack(Buf, OutData%L_Y) if (RegCheckErr(Buf, RoutineName)) return - ! B_Y call RegUnpack(Buf, OutData%B_Y) if (RegCheckErr(Buf, RoutineName)) return - ! area_Y call RegUnpack(Buf, OutData%area_Y) if (RegCheckErr(Buf, RoutineName)) return - ! area_ratio_Y call RegUnpack(Buf, OutData%area_ratio_Y) if (RegCheckErr(Buf, RoutineName)) return - ! headLossCoeff_Y call RegUnpack(Buf, OutData%headLossCoeff_Y) if (RegCheckErr(Buf, RoutineName)) return - ! rho_Y call RegUnpack(Buf, OutData%rho_Y) if (RegCheckErr(Buf, RoutineName)) return - ! USE_F_TBL call RegUnpack(Buf, OutData%USE_F_TBL) if (RegCheckErr(Buf, RoutineName)) return - ! NKInpSt call RegUnpack(Buf, OutData%NKInpSt) if (RegCheckErr(Buf, RoutineName)) return - ! StC_F_TBL_FILE call RegUnpack(Buf, OutData%StC_F_TBL_FILE) if (RegCheckErr(Buf, RoutineName)) return - ! F_TBL if (allocated(OutData%F_TBL)) deallocate(OutData%F_TBL) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -818,13 +681,10 @@ subroutine StC_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%F_TBL) if (RegCheckErr(Buf, RoutineName)) return end if - ! PrescribedForcesCoordSys call RegUnpack(Buf, OutData%PrescribedForcesCoordSys) if (RegCheckErr(Buf, RoutineName)) return - ! PrescribedForcesFile call RegUnpack(Buf, OutData%PrescribedForcesFile) if (RegCheckErr(Buf, RoutineName)) return - ! StC_PrescribedForce if (allocated(OutData%StC_PrescribedForce)) deallocate(OutData%StC_PrescribedForce) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -839,7 +699,6 @@ subroutine StC_UnPackInputFile(Buf, OutData) call RegUnpack(Buf, OutData%StC_PrescribedForce) if (RegCheckErr(Buf, RoutineName)) return end if - ! StC_CChan if (allocated(OutData%StC_CChan)) deallocate(OutData%StC_CChan) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -855,184 +714,155 @@ subroutine StC_UnPackInputFile(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE StC_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(StC_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(StC_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_CopyInitInput' -! + +subroutine StC_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(StC_InitInputType), intent(in) :: SrcInitInputData + type(StC_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'StC_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFile = SrcInitInputData%InputFile - DstInitInputData%RootName = SrcInitInputData%RootName - DstInitInputData%Gravity = SrcInitInputData%Gravity - DstInitInputData%NumMeshPts = SrcInitInputData%NumMeshPts -IF (ALLOCATED(SrcInitInputData%InitRefPos)) THEN - i1_l = LBOUND(SrcInitInputData%InitRefPos,1) - i1_u = UBOUND(SrcInitInputData%InitRefPos,1) - i2_l = LBOUND(SrcInitInputData%InitRefPos,2) - i2_u = UBOUND(SrcInitInputData%InitRefPos,2) - IF (.NOT. ALLOCATED(DstInitInputData%InitRefPos)) THEN - ALLOCATE(DstInitInputData%InitRefPos(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%InitRefPos.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%InitRefPos = SrcInitInputData%InitRefPos -ENDIF -IF (ALLOCATED(SrcInitInputData%InitTransDisp)) THEN - i1_l = LBOUND(SrcInitInputData%InitTransDisp,1) - i1_u = UBOUND(SrcInitInputData%InitTransDisp,1) - i2_l = LBOUND(SrcInitInputData%InitTransDisp,2) - i2_u = UBOUND(SrcInitInputData%InitTransDisp,2) - IF (.NOT. ALLOCATED(DstInitInputData%InitTransDisp)) THEN - ALLOCATE(DstInitInputData%InitTransDisp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%InitTransDisp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%InitTransDisp = SrcInitInputData%InitTransDisp -ENDIF -IF (ALLOCATED(SrcInitInputData%InitOrient)) THEN - i1_l = LBOUND(SrcInitInputData%InitOrient,1) - i1_u = UBOUND(SrcInitInputData%InitOrient,1) - i2_l = LBOUND(SrcInitInputData%InitOrient,2) - i2_u = UBOUND(SrcInitInputData%InitOrient,2) - i3_l = LBOUND(SrcInitInputData%InitOrient,3) - i3_u = UBOUND(SrcInitInputData%InitOrient,3) - IF (.NOT. ALLOCATED(DstInitInputData%InitOrient)) THEN - ALLOCATE(DstInitInputData%InitOrient(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%InitOrient.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%InitOrient = SrcInitInputData%InitOrient -ENDIF -IF (ALLOCATED(SrcInitInputData%InitRefOrient)) THEN - i1_l = LBOUND(SrcInitInputData%InitRefOrient,1) - i1_u = UBOUND(SrcInitInputData%InitRefOrient,1) - i2_l = LBOUND(SrcInitInputData%InitRefOrient,2) - i2_u = UBOUND(SrcInitInputData%InitRefOrient,2) - i3_l = LBOUND(SrcInitInputData%InitRefOrient,3) - i3_u = UBOUND(SrcInitInputData%InitRefOrient,3) - IF (.NOT. ALLOCATED(DstInitInputData%InitRefOrient)) THEN - ALLOCATE(DstInitInputData%InitRefOrient(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%InitRefOrient.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%InitRefOrient = SrcInitInputData%InitRefOrient -ENDIF - DstInitInputData%UseInputFile = SrcInitInputData%UseInputFile - CALL NWTC_Library_Copyfileinfotype( SrcInitInputData%PassedPrimaryInputData, DstInitInputData%PassedPrimaryInputData, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitInputData%UseInputFile_PrescribeFrc = SrcInitInputData%UseInputFile_PrescribeFrc - CALL NWTC_Library_Copyfileinfotype( SrcInitInputData%PassedPrescribeFrcData, DstInitInputData%PassedPrescribeFrcData, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE StC_CopyInitInput - - SUBROUTINE StC_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(StC_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitInputData%InitRefPos)) THEN - DEALLOCATE(InitInputData%InitRefPos) -ENDIF -IF (ALLOCATED(InitInputData%InitTransDisp)) THEN - DEALLOCATE(InitInputData%InitTransDisp) -ENDIF -IF (ALLOCATED(InitInputData%InitOrient)) THEN - DEALLOCATE(InitInputData%InitOrient) -ENDIF -IF (ALLOCATED(InitInputData%InitRefOrient)) THEN - DEALLOCATE(InitInputData%InitRefOrient) -ENDIF - CALL NWTC_Library_DestroyFileInfoType( InitInputData%PassedPrimaryInputData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL NWTC_Library_DestroyFileInfoType( InitInputData%PassedPrescribeFrcData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE StC_DestroyInitInput + ErrMsg = '' + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%RootName = SrcInitInputData%RootName + DstInitInputData%Gravity = SrcInitInputData%Gravity + DstInitInputData%NumMeshPts = SrcInitInputData%NumMeshPts + if (allocated(SrcInitInputData%InitRefPos)) then + LB(1:2) = lbound(SrcInitInputData%InitRefPos) + UB(1:2) = ubound(SrcInitInputData%InitRefPos) + if (.not. allocated(DstInitInputData%InitRefPos)) then + allocate(DstInitInputData%InitRefPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%InitRefPos.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%InitRefPos = SrcInitInputData%InitRefPos + else if (allocated(DstInitInputData%InitRefPos)) then + deallocate(DstInitInputData%InitRefPos) + end if + if (allocated(SrcInitInputData%InitTransDisp)) then + LB(1:2) = lbound(SrcInitInputData%InitTransDisp) + UB(1:2) = ubound(SrcInitInputData%InitTransDisp) + if (.not. allocated(DstInitInputData%InitTransDisp)) then + allocate(DstInitInputData%InitTransDisp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%InitTransDisp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%InitTransDisp = SrcInitInputData%InitTransDisp + else if (allocated(DstInitInputData%InitTransDisp)) then + deallocate(DstInitInputData%InitTransDisp) + end if + if (allocated(SrcInitInputData%InitOrient)) then + LB(1:3) = lbound(SrcInitInputData%InitOrient) + UB(1:3) = ubound(SrcInitInputData%InitOrient) + if (.not. allocated(DstInitInputData%InitOrient)) then + allocate(DstInitInputData%InitOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%InitOrient.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%InitOrient = SrcInitInputData%InitOrient + else if (allocated(DstInitInputData%InitOrient)) then + deallocate(DstInitInputData%InitOrient) + end if + if (allocated(SrcInitInputData%InitRefOrient)) then + LB(1:3) = lbound(SrcInitInputData%InitRefOrient) + UB(1:3) = ubound(SrcInitInputData%InitRefOrient) + if (.not. allocated(DstInitInputData%InitRefOrient)) then + allocate(DstInitInputData%InitRefOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%InitRefOrient.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%InitRefOrient = SrcInitInputData%InitRefOrient + else if (allocated(DstInitInputData%InitRefOrient)) then + deallocate(DstInitInputData%InitRefOrient) + end if + DstInitInputData%UseInputFile = SrcInitInputData%UseInputFile + call NWTC_Library_CopyFileInfoType(SrcInitInputData%PassedPrimaryInputData, DstInitInputData%PassedPrimaryInputData, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitInputData%UseInputFile_PrescribeFrc = SrcInitInputData%UseInputFile_PrescribeFrc + call NWTC_Library_CopyFileInfoType(SrcInitInputData%PassedPrescribeFrcData, DstInitInputData%PassedPrescribeFrcData, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine StC_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(StC_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'StC_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitInputData%InitRefPos)) then + deallocate(InitInputData%InitRefPos) + end if + if (allocated(InitInputData%InitTransDisp)) then + deallocate(InitInputData%InitTransDisp) + end if + if (allocated(InitInputData%InitOrient)) then + deallocate(InitInputData%InitOrient) + end if + if (allocated(InitInputData%InitRefOrient)) then + deallocate(InitInputData%InitRefOrient) + end if +end subroutine subroutine StC_PackInitInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(StC_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'StC_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return - ! InputFile call RegPack(Buf, InData%InputFile) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegPack(Buf, InData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! Gravity call RegPack(Buf, InData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - ! NumMeshPts call RegPack(Buf, InData%NumMeshPts) if (RegCheckErr(Buf, RoutineName)) return - ! InitRefPos call RegPack(Buf, allocated(InData%InitRefPos)) if (allocated(InData%InitRefPos)) then call RegPackBounds(Buf, 2, lbound(InData%InitRefPos), ubound(InData%InitRefPos)) call RegPack(Buf, InData%InitRefPos) end if if (RegCheckErr(Buf, RoutineName)) return - ! InitTransDisp call RegPack(Buf, allocated(InData%InitTransDisp)) if (allocated(InData%InitTransDisp)) then call RegPackBounds(Buf, 2, lbound(InData%InitTransDisp), ubound(InData%InitTransDisp)) call RegPack(Buf, InData%InitTransDisp) end if if (RegCheckErr(Buf, RoutineName)) return - ! InitOrient call RegPack(Buf, allocated(InData%InitOrient)) if (allocated(InData%InitOrient)) then call RegPackBounds(Buf, 3, lbound(InData%InitOrient), ubound(InData%InitOrient)) call RegPack(Buf, InData%InitOrient) end if if (RegCheckErr(Buf, RoutineName)) return - ! InitRefOrient call RegPack(Buf, allocated(InData%InitRefOrient)) if (allocated(InData%InitRefOrient)) then call RegPackBounds(Buf, 3, lbound(InData%InitRefOrient), ubound(InData%InitRefOrient)) call RegPack(Buf, InData%InitRefOrient) end if if (RegCheckErr(Buf, RoutineName)) return - ! UseInputFile call RegPack(Buf, InData%UseInputFile) if (RegCheckErr(Buf, RoutineName)) return - ! PassedPrimaryInputData call NWTC_Library_PackFileInfoType(Buf, InData%PassedPrimaryInputData) if (RegCheckErr(Buf, RoutineName)) return - ! UseInputFile_PrescribeFrc call RegPack(Buf, InData%UseInputFile_PrescribeFrc) if (RegCheckErr(Buf, RoutineName)) return - ! PassedPrescribeFrcData call NWTC_Library_PackFileInfoType(Buf, InData%PassedPrescribeFrcData) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1045,19 +875,14 @@ subroutine StC_UnPackInitInput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! InputFile call RegUnpack(Buf, OutData%InputFile) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegUnpack(Buf, OutData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! Gravity call RegUnpack(Buf, OutData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - ! NumMeshPts call RegUnpack(Buf, OutData%NumMeshPts) if (RegCheckErr(Buf, RoutineName)) return - ! InitRefPos if (allocated(OutData%InitRefPos)) deallocate(OutData%InitRefPos) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1072,7 +897,6 @@ subroutine StC_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%InitRefPos) if (RegCheckErr(Buf, RoutineName)) return end if - ! InitTransDisp if (allocated(OutData%InitTransDisp)) deallocate(OutData%InitTransDisp) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1087,7 +911,6 @@ subroutine StC_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%InitTransDisp) if (RegCheckErr(Buf, RoutineName)) return end if - ! InitOrient if (allocated(OutData%InitOrient)) deallocate(OutData%InitOrient) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1102,7 +925,6 @@ subroutine StC_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%InitOrient) if (RegCheckErr(Buf, RoutineName)) return end if - ! InitRefOrient if (allocated(OutData%InitRefOrient)) deallocate(OutData%InitRefOrient) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1117,216 +939,196 @@ subroutine StC_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%InitRefOrient) if (RegCheckErr(Buf, RoutineName)) return end if - ! UseInputFile call RegUnpack(Buf, OutData%UseInputFile) if (RegCheckErr(Buf, RoutineName)) return - ! PassedPrimaryInputData call NWTC_Library_UnpackFileInfoType(Buf, OutData%PassedPrimaryInputData) ! PassedPrimaryInputData - ! UseInputFile_PrescribeFrc call RegUnpack(Buf, OutData%UseInputFile_PrescribeFrc) if (RegCheckErr(Buf, RoutineName)) return - ! PassedPrescribeFrcData call NWTC_Library_UnpackFileInfoType(Buf, OutData%PassedPrescribeFrcData) ! PassedPrescribeFrcData end subroutine - SUBROUTINE StC_CopyCtrlChanInitInfoType( SrcCtrlChanInitInfoTypeData, DstCtrlChanInitInfoTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(StC_CtrlChanInitInfoType), INTENT(IN) :: SrcCtrlChanInitInfoTypeData - TYPE(StC_CtrlChanInitInfoType), INTENT(INOUT) :: DstCtrlChanInitInfoTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_CopyCtrlChanInitInfoType' -! + +subroutine StC_CopyCtrlChanInitInfoType(SrcCtrlChanInitInfoTypeData, DstCtrlChanInitInfoTypeData, CtrlCode, ErrStat, ErrMsg) + type(StC_CtrlChanInitInfoType), intent(in) :: SrcCtrlChanInitInfoTypeData + type(StC_CtrlChanInitInfoType), intent(inout) :: DstCtrlChanInitInfoTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'StC_CopyCtrlChanInitInfoType' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcCtrlChanInitInfoTypeData%Requestor)) THEN - i1_l = LBOUND(SrcCtrlChanInitInfoTypeData%Requestor,1) - i1_u = UBOUND(SrcCtrlChanInitInfoTypeData%Requestor,1) - IF (.NOT. ALLOCATED(DstCtrlChanInitInfoTypeData%Requestor)) THEN - ALLOCATE(DstCtrlChanInitInfoTypeData%Requestor(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCtrlChanInitInfoTypeData%Requestor.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCtrlChanInitInfoTypeData%Requestor = SrcCtrlChanInitInfoTypeData%Requestor -ENDIF -IF (ALLOCATED(SrcCtrlChanInitInfoTypeData%InitStiff)) THEN - i1_l = LBOUND(SrcCtrlChanInitInfoTypeData%InitStiff,1) - i1_u = UBOUND(SrcCtrlChanInitInfoTypeData%InitStiff,1) - i2_l = LBOUND(SrcCtrlChanInitInfoTypeData%InitStiff,2) - i2_u = UBOUND(SrcCtrlChanInitInfoTypeData%InitStiff,2) - IF (.NOT. ALLOCATED(DstCtrlChanInitInfoTypeData%InitStiff)) THEN - ALLOCATE(DstCtrlChanInitInfoTypeData%InitStiff(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCtrlChanInitInfoTypeData%InitStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCtrlChanInitInfoTypeData%InitStiff = SrcCtrlChanInitInfoTypeData%InitStiff -ENDIF -IF (ALLOCATED(SrcCtrlChanInitInfoTypeData%InitDamp)) THEN - i1_l = LBOUND(SrcCtrlChanInitInfoTypeData%InitDamp,1) - i1_u = UBOUND(SrcCtrlChanInitInfoTypeData%InitDamp,1) - i2_l = LBOUND(SrcCtrlChanInitInfoTypeData%InitDamp,2) - i2_u = UBOUND(SrcCtrlChanInitInfoTypeData%InitDamp,2) - IF (.NOT. ALLOCATED(DstCtrlChanInitInfoTypeData%InitDamp)) THEN - ALLOCATE(DstCtrlChanInitInfoTypeData%InitDamp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCtrlChanInitInfoTypeData%InitDamp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCtrlChanInitInfoTypeData%InitDamp = SrcCtrlChanInitInfoTypeData%InitDamp -ENDIF -IF (ALLOCATED(SrcCtrlChanInitInfoTypeData%InitBrake)) THEN - i1_l = LBOUND(SrcCtrlChanInitInfoTypeData%InitBrake,1) - i1_u = UBOUND(SrcCtrlChanInitInfoTypeData%InitBrake,1) - i2_l = LBOUND(SrcCtrlChanInitInfoTypeData%InitBrake,2) - i2_u = UBOUND(SrcCtrlChanInitInfoTypeData%InitBrake,2) - IF (.NOT. ALLOCATED(DstCtrlChanInitInfoTypeData%InitBrake)) THEN - ALLOCATE(DstCtrlChanInitInfoTypeData%InitBrake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCtrlChanInitInfoTypeData%InitBrake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCtrlChanInitInfoTypeData%InitBrake = SrcCtrlChanInitInfoTypeData%InitBrake -ENDIF -IF (ALLOCATED(SrcCtrlChanInitInfoTypeData%InitForce)) THEN - i1_l = LBOUND(SrcCtrlChanInitInfoTypeData%InitForce,1) - i1_u = UBOUND(SrcCtrlChanInitInfoTypeData%InitForce,1) - i2_l = LBOUND(SrcCtrlChanInitInfoTypeData%InitForce,2) - i2_u = UBOUND(SrcCtrlChanInitInfoTypeData%InitForce,2) - IF (.NOT. ALLOCATED(DstCtrlChanInitInfoTypeData%InitForce)) THEN - ALLOCATE(DstCtrlChanInitInfoTypeData%InitForce(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCtrlChanInitInfoTypeData%InitForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCtrlChanInitInfoTypeData%InitForce = SrcCtrlChanInitInfoTypeData%InitForce -ENDIF -IF (ALLOCATED(SrcCtrlChanInitInfoTypeData%InitMeasDisp)) THEN - i1_l = LBOUND(SrcCtrlChanInitInfoTypeData%InitMeasDisp,1) - i1_u = UBOUND(SrcCtrlChanInitInfoTypeData%InitMeasDisp,1) - i2_l = LBOUND(SrcCtrlChanInitInfoTypeData%InitMeasDisp,2) - i2_u = UBOUND(SrcCtrlChanInitInfoTypeData%InitMeasDisp,2) - IF (.NOT. ALLOCATED(DstCtrlChanInitInfoTypeData%InitMeasDisp)) THEN - ALLOCATE(DstCtrlChanInitInfoTypeData%InitMeasDisp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCtrlChanInitInfoTypeData%InitMeasDisp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCtrlChanInitInfoTypeData%InitMeasDisp = SrcCtrlChanInitInfoTypeData%InitMeasDisp -ENDIF -IF (ALLOCATED(SrcCtrlChanInitInfoTypeData%InitMeasVel)) THEN - i1_l = LBOUND(SrcCtrlChanInitInfoTypeData%InitMeasVel,1) - i1_u = UBOUND(SrcCtrlChanInitInfoTypeData%InitMeasVel,1) - i2_l = LBOUND(SrcCtrlChanInitInfoTypeData%InitMeasVel,2) - i2_u = UBOUND(SrcCtrlChanInitInfoTypeData%InitMeasVel,2) - IF (.NOT. ALLOCATED(DstCtrlChanInitInfoTypeData%InitMeasVel)) THEN - ALLOCATE(DstCtrlChanInitInfoTypeData%InitMeasVel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCtrlChanInitInfoTypeData%InitMeasVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCtrlChanInitInfoTypeData%InitMeasVel = SrcCtrlChanInitInfoTypeData%InitMeasVel -ENDIF - END SUBROUTINE StC_CopyCtrlChanInitInfoType - - SUBROUTINE StC_DestroyCtrlChanInitInfoType( CtrlChanInitInfoTypeData, ErrStat, ErrMsg ) - TYPE(StC_CtrlChanInitInfoType), INTENT(INOUT) :: CtrlChanInitInfoTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyCtrlChanInitInfoType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(CtrlChanInitInfoTypeData%Requestor)) THEN - DEALLOCATE(CtrlChanInitInfoTypeData%Requestor) -ENDIF -IF (ALLOCATED(CtrlChanInitInfoTypeData%InitStiff)) THEN - DEALLOCATE(CtrlChanInitInfoTypeData%InitStiff) -ENDIF -IF (ALLOCATED(CtrlChanInitInfoTypeData%InitDamp)) THEN - DEALLOCATE(CtrlChanInitInfoTypeData%InitDamp) -ENDIF -IF (ALLOCATED(CtrlChanInitInfoTypeData%InitBrake)) THEN - DEALLOCATE(CtrlChanInitInfoTypeData%InitBrake) -ENDIF -IF (ALLOCATED(CtrlChanInitInfoTypeData%InitForce)) THEN - DEALLOCATE(CtrlChanInitInfoTypeData%InitForce) -ENDIF -IF (ALLOCATED(CtrlChanInitInfoTypeData%InitMeasDisp)) THEN - DEALLOCATE(CtrlChanInitInfoTypeData%InitMeasDisp) -ENDIF -IF (ALLOCATED(CtrlChanInitInfoTypeData%InitMeasVel)) THEN - DEALLOCATE(CtrlChanInitInfoTypeData%InitMeasVel) -ENDIF - END SUBROUTINE StC_DestroyCtrlChanInitInfoType + ErrMsg = '' + if (allocated(SrcCtrlChanInitInfoTypeData%Requestor)) then + LB(1:1) = lbound(SrcCtrlChanInitInfoTypeData%Requestor) + UB(1:1) = ubound(SrcCtrlChanInitInfoTypeData%Requestor) + if (.not. allocated(DstCtrlChanInitInfoTypeData%Requestor)) then + allocate(DstCtrlChanInitInfoTypeData%Requestor(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCtrlChanInitInfoTypeData%Requestor.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCtrlChanInitInfoTypeData%Requestor = SrcCtrlChanInitInfoTypeData%Requestor + else if (allocated(DstCtrlChanInitInfoTypeData%Requestor)) then + deallocate(DstCtrlChanInitInfoTypeData%Requestor) + end if + if (allocated(SrcCtrlChanInitInfoTypeData%InitStiff)) then + LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitStiff) + UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitStiff) + if (.not. allocated(DstCtrlChanInitInfoTypeData%InitStiff)) then + allocate(DstCtrlChanInitInfoTypeData%InitStiff(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCtrlChanInitInfoTypeData%InitStiff.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCtrlChanInitInfoTypeData%InitStiff = SrcCtrlChanInitInfoTypeData%InitStiff + else if (allocated(DstCtrlChanInitInfoTypeData%InitStiff)) then + deallocate(DstCtrlChanInitInfoTypeData%InitStiff) + end if + if (allocated(SrcCtrlChanInitInfoTypeData%InitDamp)) then + LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitDamp) + UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitDamp) + if (.not. allocated(DstCtrlChanInitInfoTypeData%InitDamp)) then + allocate(DstCtrlChanInitInfoTypeData%InitDamp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCtrlChanInitInfoTypeData%InitDamp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCtrlChanInitInfoTypeData%InitDamp = SrcCtrlChanInitInfoTypeData%InitDamp + else if (allocated(DstCtrlChanInitInfoTypeData%InitDamp)) then + deallocate(DstCtrlChanInitInfoTypeData%InitDamp) + end if + if (allocated(SrcCtrlChanInitInfoTypeData%InitBrake)) then + LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitBrake) + UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitBrake) + if (.not. allocated(DstCtrlChanInitInfoTypeData%InitBrake)) then + allocate(DstCtrlChanInitInfoTypeData%InitBrake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCtrlChanInitInfoTypeData%InitBrake.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCtrlChanInitInfoTypeData%InitBrake = SrcCtrlChanInitInfoTypeData%InitBrake + else if (allocated(DstCtrlChanInitInfoTypeData%InitBrake)) then + deallocate(DstCtrlChanInitInfoTypeData%InitBrake) + end if + if (allocated(SrcCtrlChanInitInfoTypeData%InitForce)) then + LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitForce) + UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitForce) + if (.not. allocated(DstCtrlChanInitInfoTypeData%InitForce)) then + allocate(DstCtrlChanInitInfoTypeData%InitForce(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCtrlChanInitInfoTypeData%InitForce.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCtrlChanInitInfoTypeData%InitForce = SrcCtrlChanInitInfoTypeData%InitForce + else if (allocated(DstCtrlChanInitInfoTypeData%InitForce)) then + deallocate(DstCtrlChanInitInfoTypeData%InitForce) + end if + if (allocated(SrcCtrlChanInitInfoTypeData%InitMeasDisp)) then + LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitMeasDisp) + UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitMeasDisp) + if (.not. allocated(DstCtrlChanInitInfoTypeData%InitMeasDisp)) then + allocate(DstCtrlChanInitInfoTypeData%InitMeasDisp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCtrlChanInitInfoTypeData%InitMeasDisp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCtrlChanInitInfoTypeData%InitMeasDisp = SrcCtrlChanInitInfoTypeData%InitMeasDisp + else if (allocated(DstCtrlChanInitInfoTypeData%InitMeasDisp)) then + deallocate(DstCtrlChanInitInfoTypeData%InitMeasDisp) + end if + if (allocated(SrcCtrlChanInitInfoTypeData%InitMeasVel)) then + LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitMeasVel) + UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitMeasVel) + if (.not. allocated(DstCtrlChanInitInfoTypeData%InitMeasVel)) then + allocate(DstCtrlChanInitInfoTypeData%InitMeasVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCtrlChanInitInfoTypeData%InitMeasVel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCtrlChanInitInfoTypeData%InitMeasVel = SrcCtrlChanInitInfoTypeData%InitMeasVel + else if (allocated(DstCtrlChanInitInfoTypeData%InitMeasVel)) then + deallocate(DstCtrlChanInitInfoTypeData%InitMeasVel) + end if +end subroutine +subroutine StC_DestroyCtrlChanInitInfoType(CtrlChanInitInfoTypeData, ErrStat, ErrMsg) + type(StC_CtrlChanInitInfoType), intent(inout) :: CtrlChanInitInfoTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'StC_DestroyCtrlChanInitInfoType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(CtrlChanInitInfoTypeData%Requestor)) then + deallocate(CtrlChanInitInfoTypeData%Requestor) + end if + if (allocated(CtrlChanInitInfoTypeData%InitStiff)) then + deallocate(CtrlChanInitInfoTypeData%InitStiff) + end if + if (allocated(CtrlChanInitInfoTypeData%InitDamp)) then + deallocate(CtrlChanInitInfoTypeData%InitDamp) + end if + if (allocated(CtrlChanInitInfoTypeData%InitBrake)) then + deallocate(CtrlChanInitInfoTypeData%InitBrake) + end if + if (allocated(CtrlChanInitInfoTypeData%InitForce)) then + deallocate(CtrlChanInitInfoTypeData%InitForce) + end if + if (allocated(CtrlChanInitInfoTypeData%InitMeasDisp)) then + deallocate(CtrlChanInitInfoTypeData%InitMeasDisp) + end if + if (allocated(CtrlChanInitInfoTypeData%InitMeasVel)) then + deallocate(CtrlChanInitInfoTypeData%InitMeasVel) + end if +end subroutine subroutine StC_PackCtrlChanInitInfoType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(StC_CtrlChanInitInfoType), intent(in) :: InData character(*), parameter :: RoutineName = 'StC_PackCtrlChanInitInfoType' if (Buf%ErrStat >= AbortErrLev) return - ! Requestor call RegPack(Buf, allocated(InData%Requestor)) if (allocated(InData%Requestor)) then call RegPackBounds(Buf, 1, lbound(InData%Requestor), ubound(InData%Requestor)) call RegPack(Buf, InData%Requestor) end if if (RegCheckErr(Buf, RoutineName)) return - ! InitStiff call RegPack(Buf, allocated(InData%InitStiff)) if (allocated(InData%InitStiff)) then call RegPackBounds(Buf, 2, lbound(InData%InitStiff), ubound(InData%InitStiff)) call RegPack(Buf, InData%InitStiff) end if if (RegCheckErr(Buf, RoutineName)) return - ! InitDamp call RegPack(Buf, allocated(InData%InitDamp)) if (allocated(InData%InitDamp)) then call RegPackBounds(Buf, 2, lbound(InData%InitDamp), ubound(InData%InitDamp)) call RegPack(Buf, InData%InitDamp) end if if (RegCheckErr(Buf, RoutineName)) return - ! InitBrake call RegPack(Buf, allocated(InData%InitBrake)) if (allocated(InData%InitBrake)) then call RegPackBounds(Buf, 2, lbound(InData%InitBrake), ubound(InData%InitBrake)) call RegPack(Buf, InData%InitBrake) end if if (RegCheckErr(Buf, RoutineName)) return - ! InitForce call RegPack(Buf, allocated(InData%InitForce)) if (allocated(InData%InitForce)) then call RegPackBounds(Buf, 2, lbound(InData%InitForce), ubound(InData%InitForce)) call RegPack(Buf, InData%InitForce) end if if (RegCheckErr(Buf, RoutineName)) return - ! InitMeasDisp call RegPack(Buf, allocated(InData%InitMeasDisp)) if (allocated(InData%InitMeasDisp)) then call RegPackBounds(Buf, 2, lbound(InData%InitMeasDisp), ubound(InData%InitMeasDisp)) call RegPack(Buf, InData%InitMeasDisp) end if if (RegCheckErr(Buf, RoutineName)) return - ! InitMeasVel call RegPack(Buf, allocated(InData%InitMeasVel)) if (allocated(InData%InitMeasVel)) then call RegPackBounds(Buf, 2, lbound(InData%InitMeasVel), ubound(InData%InitMeasVel)) @@ -1343,7 +1145,6 @@ subroutine StC_UnPackCtrlChanInitInfoType(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! Requestor if (allocated(OutData%Requestor)) deallocate(OutData%Requestor) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1358,7 +1159,6 @@ subroutine StC_UnPackCtrlChanInitInfoType(Buf, OutData) call RegUnpack(Buf, OutData%Requestor) if (RegCheckErr(Buf, RoutineName)) return end if - ! InitStiff if (allocated(OutData%InitStiff)) deallocate(OutData%InitStiff) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1373,7 +1173,6 @@ subroutine StC_UnPackCtrlChanInitInfoType(Buf, OutData) call RegUnpack(Buf, OutData%InitStiff) if (RegCheckErr(Buf, RoutineName)) return end if - ! InitDamp if (allocated(OutData%InitDamp)) deallocate(OutData%InitDamp) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1388,7 +1187,6 @@ subroutine StC_UnPackCtrlChanInitInfoType(Buf, OutData) call RegUnpack(Buf, OutData%InitDamp) if (RegCheckErr(Buf, RoutineName)) return end if - ! InitBrake if (allocated(OutData%InitBrake)) deallocate(OutData%InitBrake) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1403,7 +1201,6 @@ subroutine StC_UnPackCtrlChanInitInfoType(Buf, OutData) call RegUnpack(Buf, OutData%InitBrake) if (RegCheckErr(Buf, RoutineName)) return end if - ! InitForce if (allocated(OutData%InitForce)) deallocate(OutData%InitForce) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1418,7 +1215,6 @@ subroutine StC_UnPackCtrlChanInitInfoType(Buf, OutData) call RegUnpack(Buf, OutData%InitForce) if (RegCheckErr(Buf, RoutineName)) return end if - ! InitMeasDisp if (allocated(OutData%InitMeasDisp)) deallocate(OutData%InitMeasDisp) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1433,7 +1229,6 @@ subroutine StC_UnPackCtrlChanInitInfoType(Buf, OutData) call RegUnpack(Buf, OutData%InitMeasDisp) if (RegCheckErr(Buf, RoutineName)) return end if - ! InitMeasVel if (allocated(OutData%InitMeasVel)) deallocate(OutData%InitMeasVel) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1449,63 +1244,51 @@ subroutine StC_UnPackCtrlChanInitInfoType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE StC_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(StC_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(StC_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_CopyInitOutput' -! + +subroutine StC_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(StC_InitOutputType), intent(in) :: SrcInitOutputData + type(StC_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'StC_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInitOutputData%RelPosition)) THEN - i1_l = LBOUND(SrcInitOutputData%RelPosition,1) - i1_u = UBOUND(SrcInitOutputData%RelPosition,1) - i2_l = LBOUND(SrcInitOutputData%RelPosition,2) - i2_u = UBOUND(SrcInitOutputData%RelPosition,2) - IF (.NOT. ALLOCATED(DstInitOutputData%RelPosition)) THEN - ALLOCATE(DstInitOutputData%RelPosition(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RelPosition.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RelPosition = SrcInitOutputData%RelPosition -ENDIF - END SUBROUTINE StC_CopyInitOutput - - SUBROUTINE StC_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(StC_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitOutputData%RelPosition)) THEN - DEALLOCATE(InitOutputData%RelPosition) -ENDIF - END SUBROUTINE StC_DestroyInitOutput + ErrMsg = '' + if (allocated(SrcInitOutputData%RelPosition)) then + LB(1:2) = lbound(SrcInitOutputData%RelPosition) + UB(1:2) = ubound(SrcInitOutputData%RelPosition) + if (.not. allocated(DstInitOutputData%RelPosition)) then + allocate(DstInitOutputData%RelPosition(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RelPosition.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%RelPosition = SrcInitOutputData%RelPosition + else if (allocated(DstInitOutputData%RelPosition)) then + deallocate(DstInitOutputData%RelPosition) + end if +end subroutine +subroutine StC_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(StC_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'StC_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%RelPosition)) then + deallocate(InitOutputData%RelPosition) + end if +end subroutine subroutine StC_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(StC_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'StC_PackInitOutput' if (Buf%ErrStat >= AbortErrLev) return - ! RelPosition call RegPack(Buf, allocated(InData%RelPosition)) if (allocated(InData%RelPosition)) then call RegPackBounds(Buf, 2, lbound(InData%RelPosition), ubound(InData%RelPosition)) @@ -1522,7 +1305,6 @@ subroutine StC_UnPackInitOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! RelPosition if (allocated(OutData%RelPosition)) deallocate(OutData%RelPosition) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1538,63 +1320,51 @@ subroutine StC_UnPackInitOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE StC_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(StC_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(StC_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_CopyContState' -! + +subroutine StC_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(StC_ContinuousStateType), intent(in) :: SrcContStateData + type(StC_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'StC_CopyContState' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcContStateData%StC_x)) THEN - i1_l = LBOUND(SrcContStateData%StC_x,1) - i1_u = UBOUND(SrcContStateData%StC_x,1) - i2_l = LBOUND(SrcContStateData%StC_x,2) - i2_u = UBOUND(SrcContStateData%StC_x,2) - IF (.NOT. ALLOCATED(DstContStateData%StC_x)) THEN - ALLOCATE(DstContStateData%StC_x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%StC_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstContStateData%StC_x = SrcContStateData%StC_x -ENDIF - END SUBROUTINE StC_CopyContState - - SUBROUTINE StC_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(StC_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ContStateData%StC_x)) THEN - DEALLOCATE(ContStateData%StC_x) -ENDIF - END SUBROUTINE StC_DestroyContState + ErrMsg = '' + if (allocated(SrcContStateData%StC_x)) then + LB(1:2) = lbound(SrcContStateData%StC_x) + UB(1:2) = ubound(SrcContStateData%StC_x) + if (.not. allocated(DstContStateData%StC_x)) then + allocate(DstContStateData%StC_x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%StC_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstContStateData%StC_x = SrcContStateData%StC_x + else if (allocated(DstContStateData%StC_x)) then + deallocate(DstContStateData%StC_x) + end if +end subroutine +subroutine StC_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(StC_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'StC_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ContStateData%StC_x)) then + deallocate(ContStateData%StC_x) + end if +end subroutine subroutine StC_PackContState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(StC_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'StC_PackContState' if (Buf%ErrStat >= AbortErrLev) return - ! StC_x call RegPack(Buf, allocated(InData%StC_x)) if (allocated(InData%StC_x)) then call RegPackBounds(Buf, 2, lbound(InData%StC_x), ubound(InData%StC_x)) @@ -1611,7 +1381,6 @@ subroutine StC_UnPackContState(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! StC_x if (allocated(OutData%StC_x)) deallocate(OutData%StC_x) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1627,45 +1396,33 @@ subroutine StC_UnPackContState(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE StC_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(StC_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(StC_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState - END SUBROUTINE StC_CopyDiscState - - SUBROUTINE StC_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(StC_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyDiscState' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE StC_DestroyDiscState +subroutine StC_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(StC_DiscreteStateType), intent(in) :: SrcDiscStateData + type(StC_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'StC_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState +end subroutine +subroutine StC_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(StC_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'StC_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine StC_PackDiscState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(StC_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'StC_PackDiscState' if (Buf%ErrStat >= AbortErrLev) return - ! DummyDiscState call RegPack(Buf, InData%DummyDiscState) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1675,49 +1432,36 @@ subroutine StC_UnPackDiscState(Buf, OutData) type(StC_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'StC_UnPackDiscState' if (Buf%ErrStat /= ErrID_None) return - ! DummyDiscState call RegUnpack(Buf, OutData%DummyDiscState) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE StC_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(StC_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(StC_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE StC_CopyConstrState - - SUBROUTINE StC_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(StC_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE StC_DestroyConstrState +subroutine StC_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(StC_ConstraintStateType), intent(in) :: SrcConstrStateData + type(StC_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'StC_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine +subroutine StC_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(StC_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'StC_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine StC_PackConstrState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(StC_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'StC_PackConstrState' if (Buf%ErrStat >= AbortErrLev) return - ! DummyConstrState call RegPack(Buf, InData%DummyConstrState) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1727,49 +1471,36 @@ subroutine StC_UnPackConstrState(Buf, OutData) type(StC_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'StC_UnPackConstrState' if (Buf%ErrStat /= ErrID_None) return - ! DummyConstrState call RegUnpack(Buf, OutData%DummyConstrState) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE StC_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(StC_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(StC_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState - END SUBROUTINE StC_CopyOtherState - - SUBROUTINE StC_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(StC_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyOtherState' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE StC_DestroyOtherState +subroutine StC_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(StC_OtherStateType), intent(in) :: SrcOtherStateData + type(StC_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'StC_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState +end subroutine +subroutine StC_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(StC_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'StC_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine StC_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(StC_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'StC_PackOtherState' if (Buf%ErrStat >= AbortErrLev) return - ! DummyOtherState call RegPack(Buf, InData%DummyOtherState) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1779,459 +1510,429 @@ subroutine StC_UnPackOtherState(Buf, OutData) type(StC_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'StC_UnPackOtherState' if (Buf%ErrStat /= ErrID_None) return - ! DummyOtherState call RegUnpack(Buf, OutData%DummyOtherState) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE StC_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(StC_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(StC_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_CopyMisc' -! + +subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(StC_MiscVarType), intent(in) :: SrcMiscData + type(StC_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'StC_CopyMisc' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscData%F_stop)) THEN - i1_l = LBOUND(SrcMiscData%F_stop,1) - i1_u = UBOUND(SrcMiscData%F_stop,1) - i2_l = LBOUND(SrcMiscData%F_stop,2) - i2_u = UBOUND(SrcMiscData%F_stop,2) - IF (.NOT. ALLOCATED(DstMiscData%F_stop)) THEN - ALLOCATE(DstMiscData%F_stop(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_stop.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_stop = SrcMiscData%F_stop -ENDIF -IF (ALLOCATED(SrcMiscData%F_ext)) THEN - i1_l = LBOUND(SrcMiscData%F_ext,1) - i1_u = UBOUND(SrcMiscData%F_ext,1) - i2_l = LBOUND(SrcMiscData%F_ext,2) - i2_u = UBOUND(SrcMiscData%F_ext,2) - IF (.NOT. ALLOCATED(DstMiscData%F_ext)) THEN - ALLOCATE(DstMiscData%F_ext(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_ext.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_ext = SrcMiscData%F_ext -ENDIF -IF (ALLOCATED(SrcMiscData%F_fr)) THEN - i1_l = LBOUND(SrcMiscData%F_fr,1) - i1_u = UBOUND(SrcMiscData%F_fr,1) - i2_l = LBOUND(SrcMiscData%F_fr,2) - i2_u = UBOUND(SrcMiscData%F_fr,2) - IF (.NOT. ALLOCATED(DstMiscData%F_fr)) THEN - ALLOCATE(DstMiscData%F_fr(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_fr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_fr = SrcMiscData%F_fr -ENDIF -IF (ALLOCATED(SrcMiscData%K)) THEN - i1_l = LBOUND(SrcMiscData%K,1) - i1_u = UBOUND(SrcMiscData%K,1) - i2_l = LBOUND(SrcMiscData%K,2) - i2_u = UBOUND(SrcMiscData%K,2) - IF (.NOT. ALLOCATED(DstMiscData%K)) THEN - ALLOCATE(DstMiscData%K(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%K.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%K = SrcMiscData%K -ENDIF -IF (ALLOCATED(SrcMiscData%C_ctrl)) THEN - i1_l = LBOUND(SrcMiscData%C_ctrl,1) - i1_u = UBOUND(SrcMiscData%C_ctrl,1) - i2_l = LBOUND(SrcMiscData%C_ctrl,2) - i2_u = UBOUND(SrcMiscData%C_ctrl,2) - IF (.NOT. ALLOCATED(DstMiscData%C_ctrl)) THEN - ALLOCATE(DstMiscData%C_ctrl(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%C_ctrl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%C_ctrl = SrcMiscData%C_ctrl -ENDIF -IF (ALLOCATED(SrcMiscData%C_Brake)) THEN - i1_l = LBOUND(SrcMiscData%C_Brake,1) - i1_u = UBOUND(SrcMiscData%C_Brake,1) - i2_l = LBOUND(SrcMiscData%C_Brake,2) - i2_u = UBOUND(SrcMiscData%C_Brake,2) - IF (.NOT. ALLOCATED(DstMiscData%C_Brake)) THEN - ALLOCATE(DstMiscData%C_Brake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%C_Brake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%C_Brake = SrcMiscData%C_Brake -ENDIF -IF (ALLOCATED(SrcMiscData%F_table)) THEN - i1_l = LBOUND(SrcMiscData%F_table,1) - i1_u = UBOUND(SrcMiscData%F_table,1) - i2_l = LBOUND(SrcMiscData%F_table,2) - i2_u = UBOUND(SrcMiscData%F_table,2) - IF (.NOT. ALLOCATED(DstMiscData%F_table)) THEN - ALLOCATE(DstMiscData%F_table(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_table.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_table = SrcMiscData%F_table -ENDIF -IF (ALLOCATED(SrcMiscData%F_k)) THEN - i1_l = LBOUND(SrcMiscData%F_k,1) - i1_u = UBOUND(SrcMiscData%F_k,1) - i2_l = LBOUND(SrcMiscData%F_k,2) - i2_u = UBOUND(SrcMiscData%F_k,2) - IF (.NOT. ALLOCATED(DstMiscData%F_k)) THEN - ALLOCATE(DstMiscData%F_k(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_k.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_k = SrcMiscData%F_k -ENDIF -IF (ALLOCATED(SrcMiscData%a_G)) THEN - i1_l = LBOUND(SrcMiscData%a_G,1) - i1_u = UBOUND(SrcMiscData%a_G,1) - i2_l = LBOUND(SrcMiscData%a_G,2) - i2_u = UBOUND(SrcMiscData%a_G,2) - IF (.NOT. ALLOCATED(DstMiscData%a_G)) THEN - ALLOCATE(DstMiscData%a_G(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%a_G.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%a_G = SrcMiscData%a_G -ENDIF -IF (ALLOCATED(SrcMiscData%rdisp_P)) THEN - i1_l = LBOUND(SrcMiscData%rdisp_P,1) - i1_u = UBOUND(SrcMiscData%rdisp_P,1) - i2_l = LBOUND(SrcMiscData%rdisp_P,2) - i2_u = UBOUND(SrcMiscData%rdisp_P,2) - IF (.NOT. ALLOCATED(DstMiscData%rdisp_P)) THEN - ALLOCATE(DstMiscData%rdisp_P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rdisp_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%rdisp_P = SrcMiscData%rdisp_P -ENDIF -IF (ALLOCATED(SrcMiscData%rdot_P)) THEN - i1_l = LBOUND(SrcMiscData%rdot_P,1) - i1_u = UBOUND(SrcMiscData%rdot_P,1) - i2_l = LBOUND(SrcMiscData%rdot_P,2) - i2_u = UBOUND(SrcMiscData%rdot_P,2) - IF (.NOT. ALLOCATED(DstMiscData%rdot_P)) THEN - ALLOCATE(DstMiscData%rdot_P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rdot_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%rdot_P = SrcMiscData%rdot_P -ENDIF -IF (ALLOCATED(SrcMiscData%rddot_P)) THEN - i1_l = LBOUND(SrcMiscData%rddot_P,1) - i1_u = UBOUND(SrcMiscData%rddot_P,1) - i2_l = LBOUND(SrcMiscData%rddot_P,2) - i2_u = UBOUND(SrcMiscData%rddot_P,2) - IF (.NOT. ALLOCATED(DstMiscData%rddot_P)) THEN - ALLOCATE(DstMiscData%rddot_P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rddot_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%rddot_P = SrcMiscData%rddot_P -ENDIF -IF (ALLOCATED(SrcMiscData%omega_P)) THEN - i1_l = LBOUND(SrcMiscData%omega_P,1) - i1_u = UBOUND(SrcMiscData%omega_P,1) - i2_l = LBOUND(SrcMiscData%omega_P,2) - i2_u = UBOUND(SrcMiscData%omega_P,2) - IF (.NOT. ALLOCATED(DstMiscData%omega_P)) THEN - ALLOCATE(DstMiscData%omega_P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%omega_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%omega_P = SrcMiscData%omega_P -ENDIF -IF (ALLOCATED(SrcMiscData%alpha_P)) THEN - i1_l = LBOUND(SrcMiscData%alpha_P,1) - i1_u = UBOUND(SrcMiscData%alpha_P,1) - i2_l = LBOUND(SrcMiscData%alpha_P,2) - i2_u = UBOUND(SrcMiscData%alpha_P,2) - IF (.NOT. ALLOCATED(DstMiscData%alpha_P)) THEN - ALLOCATE(DstMiscData%alpha_P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%alpha_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%alpha_P = SrcMiscData%alpha_P -ENDIF -IF (ALLOCATED(SrcMiscData%F_P)) THEN - i1_l = LBOUND(SrcMiscData%F_P,1) - i1_u = UBOUND(SrcMiscData%F_P,1) - i2_l = LBOUND(SrcMiscData%F_P,2) - i2_u = UBOUND(SrcMiscData%F_P,2) - IF (.NOT. ALLOCATED(DstMiscData%F_P)) THEN - ALLOCATE(DstMiscData%F_P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_P = SrcMiscData%F_P -ENDIF -IF (ALLOCATED(SrcMiscData%M_P)) THEN - i1_l = LBOUND(SrcMiscData%M_P,1) - i1_u = UBOUND(SrcMiscData%M_P,1) - i2_l = LBOUND(SrcMiscData%M_P,2) - i2_u = UBOUND(SrcMiscData%M_P,2) - IF (.NOT. ALLOCATED(DstMiscData%M_P)) THEN - ALLOCATE(DstMiscData%M_P(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%M_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%M_P = SrcMiscData%M_P -ENDIF -IF (ALLOCATED(SrcMiscData%Acc)) THEN - i1_l = LBOUND(SrcMiscData%Acc,1) - i1_u = UBOUND(SrcMiscData%Acc,1) - i2_l = LBOUND(SrcMiscData%Acc,2) - i2_u = UBOUND(SrcMiscData%Acc,2) - IF (.NOT. ALLOCATED(DstMiscData%Acc)) THEN - ALLOCATE(DstMiscData%Acc(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Acc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Acc = SrcMiscData%Acc -ENDIF - DstMiscData%PrescribedInterpIdx = SrcMiscData%PrescribedInterpIdx - END SUBROUTINE StC_CopyMisc - - SUBROUTINE StC_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(StC_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MiscData%F_stop)) THEN - DEALLOCATE(MiscData%F_stop) -ENDIF -IF (ALLOCATED(MiscData%F_ext)) THEN - DEALLOCATE(MiscData%F_ext) -ENDIF -IF (ALLOCATED(MiscData%F_fr)) THEN - DEALLOCATE(MiscData%F_fr) -ENDIF -IF (ALLOCATED(MiscData%K)) THEN - DEALLOCATE(MiscData%K) -ENDIF -IF (ALLOCATED(MiscData%C_ctrl)) THEN - DEALLOCATE(MiscData%C_ctrl) -ENDIF -IF (ALLOCATED(MiscData%C_Brake)) THEN - DEALLOCATE(MiscData%C_Brake) -ENDIF -IF (ALLOCATED(MiscData%F_table)) THEN - DEALLOCATE(MiscData%F_table) -ENDIF -IF (ALLOCATED(MiscData%F_k)) THEN - DEALLOCATE(MiscData%F_k) -ENDIF -IF (ALLOCATED(MiscData%a_G)) THEN - DEALLOCATE(MiscData%a_G) -ENDIF -IF (ALLOCATED(MiscData%rdisp_P)) THEN - DEALLOCATE(MiscData%rdisp_P) -ENDIF -IF (ALLOCATED(MiscData%rdot_P)) THEN - DEALLOCATE(MiscData%rdot_P) -ENDIF -IF (ALLOCATED(MiscData%rddot_P)) THEN - DEALLOCATE(MiscData%rddot_P) -ENDIF -IF (ALLOCATED(MiscData%omega_P)) THEN - DEALLOCATE(MiscData%omega_P) -ENDIF -IF (ALLOCATED(MiscData%alpha_P)) THEN - DEALLOCATE(MiscData%alpha_P) -ENDIF -IF (ALLOCATED(MiscData%F_P)) THEN - DEALLOCATE(MiscData%F_P) -ENDIF -IF (ALLOCATED(MiscData%M_P)) THEN - DEALLOCATE(MiscData%M_P) -ENDIF -IF (ALLOCATED(MiscData%Acc)) THEN - DEALLOCATE(MiscData%Acc) -ENDIF - END SUBROUTINE StC_DestroyMisc + ErrMsg = '' + if (allocated(SrcMiscData%F_stop)) then + LB(1:2) = lbound(SrcMiscData%F_stop) + UB(1:2) = ubound(SrcMiscData%F_stop) + if (.not. allocated(DstMiscData%F_stop)) then + allocate(DstMiscData%F_stop(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_stop.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_stop = SrcMiscData%F_stop + else if (allocated(DstMiscData%F_stop)) then + deallocate(DstMiscData%F_stop) + end if + if (allocated(SrcMiscData%F_ext)) then + LB(1:2) = lbound(SrcMiscData%F_ext) + UB(1:2) = ubound(SrcMiscData%F_ext) + if (.not. allocated(DstMiscData%F_ext)) then + allocate(DstMiscData%F_ext(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_ext.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_ext = SrcMiscData%F_ext + else if (allocated(DstMiscData%F_ext)) then + deallocate(DstMiscData%F_ext) + end if + if (allocated(SrcMiscData%F_fr)) then + LB(1:2) = lbound(SrcMiscData%F_fr) + UB(1:2) = ubound(SrcMiscData%F_fr) + if (.not. allocated(DstMiscData%F_fr)) then + allocate(DstMiscData%F_fr(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_fr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_fr = SrcMiscData%F_fr + else if (allocated(DstMiscData%F_fr)) then + deallocate(DstMiscData%F_fr) + end if + if (allocated(SrcMiscData%K)) then + LB(1:2) = lbound(SrcMiscData%K) + UB(1:2) = ubound(SrcMiscData%K) + if (.not. allocated(DstMiscData%K)) then + allocate(DstMiscData%K(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%K.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%K = SrcMiscData%K + else if (allocated(DstMiscData%K)) then + deallocate(DstMiscData%K) + end if + if (allocated(SrcMiscData%C_ctrl)) then + LB(1:2) = lbound(SrcMiscData%C_ctrl) + UB(1:2) = ubound(SrcMiscData%C_ctrl) + if (.not. allocated(DstMiscData%C_ctrl)) then + allocate(DstMiscData%C_ctrl(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%C_ctrl.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%C_ctrl = SrcMiscData%C_ctrl + else if (allocated(DstMiscData%C_ctrl)) then + deallocate(DstMiscData%C_ctrl) + end if + if (allocated(SrcMiscData%C_Brake)) then + LB(1:2) = lbound(SrcMiscData%C_Brake) + UB(1:2) = ubound(SrcMiscData%C_Brake) + if (.not. allocated(DstMiscData%C_Brake)) then + allocate(DstMiscData%C_Brake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%C_Brake.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%C_Brake = SrcMiscData%C_Brake + else if (allocated(DstMiscData%C_Brake)) then + deallocate(DstMiscData%C_Brake) + end if + if (allocated(SrcMiscData%F_table)) then + LB(1:2) = lbound(SrcMiscData%F_table) + UB(1:2) = ubound(SrcMiscData%F_table) + if (.not. allocated(DstMiscData%F_table)) then + allocate(DstMiscData%F_table(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_table.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_table = SrcMiscData%F_table + else if (allocated(DstMiscData%F_table)) then + deallocate(DstMiscData%F_table) + end if + if (allocated(SrcMiscData%F_k)) then + LB(1:2) = lbound(SrcMiscData%F_k) + UB(1:2) = ubound(SrcMiscData%F_k) + if (.not. allocated(DstMiscData%F_k)) then + allocate(DstMiscData%F_k(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_k.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_k = SrcMiscData%F_k + else if (allocated(DstMiscData%F_k)) then + deallocate(DstMiscData%F_k) + end if + if (allocated(SrcMiscData%a_G)) then + LB(1:2) = lbound(SrcMiscData%a_G) + UB(1:2) = ubound(SrcMiscData%a_G) + if (.not. allocated(DstMiscData%a_G)) then + allocate(DstMiscData%a_G(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%a_G.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%a_G = SrcMiscData%a_G + else if (allocated(DstMiscData%a_G)) then + deallocate(DstMiscData%a_G) + end if + if (allocated(SrcMiscData%rdisp_P)) then + LB(1:2) = lbound(SrcMiscData%rdisp_P) + UB(1:2) = ubound(SrcMiscData%rdisp_P) + if (.not. allocated(DstMiscData%rdisp_P)) then + allocate(DstMiscData%rdisp_P(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rdisp_P.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%rdisp_P = SrcMiscData%rdisp_P + else if (allocated(DstMiscData%rdisp_P)) then + deallocate(DstMiscData%rdisp_P) + end if + if (allocated(SrcMiscData%rdot_P)) then + LB(1:2) = lbound(SrcMiscData%rdot_P) + UB(1:2) = ubound(SrcMiscData%rdot_P) + if (.not. allocated(DstMiscData%rdot_P)) then + allocate(DstMiscData%rdot_P(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rdot_P.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%rdot_P = SrcMiscData%rdot_P + else if (allocated(DstMiscData%rdot_P)) then + deallocate(DstMiscData%rdot_P) + end if + if (allocated(SrcMiscData%rddot_P)) then + LB(1:2) = lbound(SrcMiscData%rddot_P) + UB(1:2) = ubound(SrcMiscData%rddot_P) + if (.not. allocated(DstMiscData%rddot_P)) then + allocate(DstMiscData%rddot_P(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rddot_P.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%rddot_P = SrcMiscData%rddot_P + else if (allocated(DstMiscData%rddot_P)) then + deallocate(DstMiscData%rddot_P) + end if + if (allocated(SrcMiscData%omega_P)) then + LB(1:2) = lbound(SrcMiscData%omega_P) + UB(1:2) = ubound(SrcMiscData%omega_P) + if (.not. allocated(DstMiscData%omega_P)) then + allocate(DstMiscData%omega_P(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%omega_P.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%omega_P = SrcMiscData%omega_P + else if (allocated(DstMiscData%omega_P)) then + deallocate(DstMiscData%omega_P) + end if + if (allocated(SrcMiscData%alpha_P)) then + LB(1:2) = lbound(SrcMiscData%alpha_P) + UB(1:2) = ubound(SrcMiscData%alpha_P) + if (.not. allocated(DstMiscData%alpha_P)) then + allocate(DstMiscData%alpha_P(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%alpha_P.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%alpha_P = SrcMiscData%alpha_P + else if (allocated(DstMiscData%alpha_P)) then + deallocate(DstMiscData%alpha_P) + end if + if (allocated(SrcMiscData%F_P)) then + LB(1:2) = lbound(SrcMiscData%F_P) + UB(1:2) = ubound(SrcMiscData%F_P) + if (.not. allocated(DstMiscData%F_P)) then + allocate(DstMiscData%F_P(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_P.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_P = SrcMiscData%F_P + else if (allocated(DstMiscData%F_P)) then + deallocate(DstMiscData%F_P) + end if + if (allocated(SrcMiscData%M_P)) then + LB(1:2) = lbound(SrcMiscData%M_P) + UB(1:2) = ubound(SrcMiscData%M_P) + if (.not. allocated(DstMiscData%M_P)) then + allocate(DstMiscData%M_P(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%M_P.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%M_P = SrcMiscData%M_P + else if (allocated(DstMiscData%M_P)) then + deallocate(DstMiscData%M_P) + end if + if (allocated(SrcMiscData%Acc)) then + LB(1:2) = lbound(SrcMiscData%Acc) + UB(1:2) = ubound(SrcMiscData%Acc) + if (.not. allocated(DstMiscData%Acc)) then + allocate(DstMiscData%Acc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Acc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Acc = SrcMiscData%Acc + else if (allocated(DstMiscData%Acc)) then + deallocate(DstMiscData%Acc) + end if + DstMiscData%PrescribedInterpIdx = SrcMiscData%PrescribedInterpIdx +end subroutine +subroutine StC_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(StC_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'StC_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%F_stop)) then + deallocate(MiscData%F_stop) + end if + if (allocated(MiscData%F_ext)) then + deallocate(MiscData%F_ext) + end if + if (allocated(MiscData%F_fr)) then + deallocate(MiscData%F_fr) + end if + if (allocated(MiscData%K)) then + deallocate(MiscData%K) + end if + if (allocated(MiscData%C_ctrl)) then + deallocate(MiscData%C_ctrl) + end if + if (allocated(MiscData%C_Brake)) then + deallocate(MiscData%C_Brake) + end if + if (allocated(MiscData%F_table)) then + deallocate(MiscData%F_table) + end if + if (allocated(MiscData%F_k)) then + deallocate(MiscData%F_k) + end if + if (allocated(MiscData%a_G)) then + deallocate(MiscData%a_G) + end if + if (allocated(MiscData%rdisp_P)) then + deallocate(MiscData%rdisp_P) + end if + if (allocated(MiscData%rdot_P)) then + deallocate(MiscData%rdot_P) + end if + if (allocated(MiscData%rddot_P)) then + deallocate(MiscData%rddot_P) + end if + if (allocated(MiscData%omega_P)) then + deallocate(MiscData%omega_P) + end if + if (allocated(MiscData%alpha_P)) then + deallocate(MiscData%alpha_P) + end if + if (allocated(MiscData%F_P)) then + deallocate(MiscData%F_P) + end if + if (allocated(MiscData%M_P)) then + deallocate(MiscData%M_P) + end if + if (allocated(MiscData%Acc)) then + deallocate(MiscData%Acc) + end if +end subroutine subroutine StC_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(StC_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'StC_PackMisc' if (Buf%ErrStat >= AbortErrLev) return - ! F_stop call RegPack(Buf, allocated(InData%F_stop)) if (allocated(InData%F_stop)) then call RegPackBounds(Buf, 2, lbound(InData%F_stop), ubound(InData%F_stop)) call RegPack(Buf, InData%F_stop) end if if (RegCheckErr(Buf, RoutineName)) return - ! F_ext call RegPack(Buf, allocated(InData%F_ext)) if (allocated(InData%F_ext)) then call RegPackBounds(Buf, 2, lbound(InData%F_ext), ubound(InData%F_ext)) call RegPack(Buf, InData%F_ext) end if if (RegCheckErr(Buf, RoutineName)) return - ! F_fr call RegPack(Buf, allocated(InData%F_fr)) if (allocated(InData%F_fr)) then call RegPackBounds(Buf, 2, lbound(InData%F_fr), ubound(InData%F_fr)) call RegPack(Buf, InData%F_fr) end if if (RegCheckErr(Buf, RoutineName)) return - ! K call RegPack(Buf, allocated(InData%K)) if (allocated(InData%K)) then call RegPackBounds(Buf, 2, lbound(InData%K), ubound(InData%K)) call RegPack(Buf, InData%K) end if if (RegCheckErr(Buf, RoutineName)) return - ! C_ctrl call RegPack(Buf, allocated(InData%C_ctrl)) if (allocated(InData%C_ctrl)) then call RegPackBounds(Buf, 2, lbound(InData%C_ctrl), ubound(InData%C_ctrl)) call RegPack(Buf, InData%C_ctrl) end if if (RegCheckErr(Buf, RoutineName)) return - ! C_Brake call RegPack(Buf, allocated(InData%C_Brake)) if (allocated(InData%C_Brake)) then call RegPackBounds(Buf, 2, lbound(InData%C_Brake), ubound(InData%C_Brake)) call RegPack(Buf, InData%C_Brake) end if if (RegCheckErr(Buf, RoutineName)) return - ! F_table call RegPack(Buf, allocated(InData%F_table)) if (allocated(InData%F_table)) then call RegPackBounds(Buf, 2, lbound(InData%F_table), ubound(InData%F_table)) call RegPack(Buf, InData%F_table) end if if (RegCheckErr(Buf, RoutineName)) return - ! F_k call RegPack(Buf, allocated(InData%F_k)) if (allocated(InData%F_k)) then call RegPackBounds(Buf, 2, lbound(InData%F_k), ubound(InData%F_k)) call RegPack(Buf, InData%F_k) end if if (RegCheckErr(Buf, RoutineName)) return - ! a_G call RegPack(Buf, allocated(InData%a_G)) if (allocated(InData%a_G)) then call RegPackBounds(Buf, 2, lbound(InData%a_G), ubound(InData%a_G)) call RegPack(Buf, InData%a_G) end if if (RegCheckErr(Buf, RoutineName)) return - ! rdisp_P call RegPack(Buf, allocated(InData%rdisp_P)) if (allocated(InData%rdisp_P)) then call RegPackBounds(Buf, 2, lbound(InData%rdisp_P), ubound(InData%rdisp_P)) call RegPack(Buf, InData%rdisp_P) end if if (RegCheckErr(Buf, RoutineName)) return - ! rdot_P call RegPack(Buf, allocated(InData%rdot_P)) if (allocated(InData%rdot_P)) then call RegPackBounds(Buf, 2, lbound(InData%rdot_P), ubound(InData%rdot_P)) call RegPack(Buf, InData%rdot_P) end if if (RegCheckErr(Buf, RoutineName)) return - ! rddot_P call RegPack(Buf, allocated(InData%rddot_P)) if (allocated(InData%rddot_P)) then call RegPackBounds(Buf, 2, lbound(InData%rddot_P), ubound(InData%rddot_P)) call RegPack(Buf, InData%rddot_P) end if if (RegCheckErr(Buf, RoutineName)) return - ! omega_P call RegPack(Buf, allocated(InData%omega_P)) if (allocated(InData%omega_P)) then call RegPackBounds(Buf, 2, lbound(InData%omega_P), ubound(InData%omega_P)) call RegPack(Buf, InData%omega_P) end if if (RegCheckErr(Buf, RoutineName)) return - ! alpha_P call RegPack(Buf, allocated(InData%alpha_P)) if (allocated(InData%alpha_P)) then call RegPackBounds(Buf, 2, lbound(InData%alpha_P), ubound(InData%alpha_P)) call RegPack(Buf, InData%alpha_P) end if if (RegCheckErr(Buf, RoutineName)) return - ! F_P call RegPack(Buf, allocated(InData%F_P)) if (allocated(InData%F_P)) then call RegPackBounds(Buf, 2, lbound(InData%F_P), ubound(InData%F_P)) call RegPack(Buf, InData%F_P) end if if (RegCheckErr(Buf, RoutineName)) return - ! M_P call RegPack(Buf, allocated(InData%M_P)) if (allocated(InData%M_P)) then call RegPackBounds(Buf, 2, lbound(InData%M_P), ubound(InData%M_P)) call RegPack(Buf, InData%M_P) end if if (RegCheckErr(Buf, RoutineName)) return - ! Acc call RegPack(Buf, allocated(InData%Acc)) if (allocated(InData%Acc)) then call RegPackBounds(Buf, 2, lbound(InData%Acc), ubound(InData%Acc)) call RegPack(Buf, InData%Acc) end if if (RegCheckErr(Buf, RoutineName)) return - ! PrescribedInterpIdx call RegPack(Buf, InData%PrescribedInterpIdx) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2244,7 +1945,6 @@ subroutine StC_UnPackMisc(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! F_stop if (allocated(OutData%F_stop)) deallocate(OutData%F_stop) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2259,7 +1959,6 @@ subroutine StC_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%F_stop) if (RegCheckErr(Buf, RoutineName)) return end if - ! F_ext if (allocated(OutData%F_ext)) deallocate(OutData%F_ext) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2274,7 +1973,6 @@ subroutine StC_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%F_ext) if (RegCheckErr(Buf, RoutineName)) return end if - ! F_fr if (allocated(OutData%F_fr)) deallocate(OutData%F_fr) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2289,7 +1987,6 @@ subroutine StC_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%F_fr) if (RegCheckErr(Buf, RoutineName)) return end if - ! K if (allocated(OutData%K)) deallocate(OutData%K) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2304,7 +2001,6 @@ subroutine StC_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%K) if (RegCheckErr(Buf, RoutineName)) return end if - ! C_ctrl if (allocated(OutData%C_ctrl)) deallocate(OutData%C_ctrl) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2319,7 +2015,6 @@ subroutine StC_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%C_ctrl) if (RegCheckErr(Buf, RoutineName)) return end if - ! C_Brake if (allocated(OutData%C_Brake)) deallocate(OutData%C_Brake) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2334,7 +2029,6 @@ subroutine StC_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%C_Brake) if (RegCheckErr(Buf, RoutineName)) return end if - ! F_table if (allocated(OutData%F_table)) deallocate(OutData%F_table) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2349,7 +2043,6 @@ subroutine StC_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%F_table) if (RegCheckErr(Buf, RoutineName)) return end if - ! F_k if (allocated(OutData%F_k)) deallocate(OutData%F_k) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2364,7 +2057,6 @@ subroutine StC_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%F_k) if (RegCheckErr(Buf, RoutineName)) return end if - ! a_G if (allocated(OutData%a_G)) deallocate(OutData%a_G) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2379,7 +2071,6 @@ subroutine StC_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%a_G) if (RegCheckErr(Buf, RoutineName)) return end if - ! rdisp_P if (allocated(OutData%rdisp_P)) deallocate(OutData%rdisp_P) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2394,7 +2085,6 @@ subroutine StC_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%rdisp_P) if (RegCheckErr(Buf, RoutineName)) return end if - ! rdot_P if (allocated(OutData%rdot_P)) deallocate(OutData%rdot_P) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2409,7 +2099,6 @@ subroutine StC_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%rdot_P) if (RegCheckErr(Buf, RoutineName)) return end if - ! rddot_P if (allocated(OutData%rddot_P)) deallocate(OutData%rddot_P) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2424,7 +2113,6 @@ subroutine StC_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%rddot_P) if (RegCheckErr(Buf, RoutineName)) return end if - ! omega_P if (allocated(OutData%omega_P)) deallocate(OutData%omega_P) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2439,7 +2127,6 @@ subroutine StC_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%omega_P) if (RegCheckErr(Buf, RoutineName)) return end if - ! alpha_P if (allocated(OutData%alpha_P)) deallocate(OutData%alpha_P) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2454,7 +2141,6 @@ subroutine StC_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%alpha_P) if (RegCheckErr(Buf, RoutineName)) return end if - ! F_P if (allocated(OutData%F_P)) deallocate(OutData%F_P) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2469,7 +2155,6 @@ subroutine StC_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%F_P) if (RegCheckErr(Buf, RoutineName)) return end if - ! M_P if (allocated(OutData%M_P)) deallocate(OutData%M_P) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2484,7 +2169,6 @@ subroutine StC_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%M_P) if (RegCheckErr(Buf, RoutineName)) return end if - ! Acc if (allocated(OutData%Acc)) deallocate(OutData%Acc) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2499,305 +2183,244 @@ subroutine StC_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%Acc) if (RegCheckErr(Buf, RoutineName)) return end if - ! PrescribedInterpIdx call RegUnpack(Buf, OutData%PrescribedInterpIdx) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE StC_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(StC_ParameterType), INTENT(IN) :: SrcParamData - TYPE(StC_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_CopyParam' -! + +subroutine StC_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(StC_ParameterType), intent(in) :: SrcParamData + type(StC_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'StC_CopyParam' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT - DstParamData%RootName = SrcParamData%RootName - DstParamData%StC_DOF_MODE = SrcParamData%StC_DOF_MODE - DstParamData%StC_X_DOF = SrcParamData%StC_X_DOF - DstParamData%StC_Y_DOF = SrcParamData%StC_Y_DOF - DstParamData%StC_Z_DOF = SrcParamData%StC_Z_DOF - DstParamData%StC_Z_PreLd = SrcParamData%StC_Z_PreLd - DstParamData%M_X = SrcParamData%M_X - DstParamData%M_Y = SrcParamData%M_Y - DstParamData%M_Z = SrcParamData%M_Z - DstParamData%M_XY = SrcParamData%M_XY - DstParamData%K_X = SrcParamData%K_X - DstParamData%K_Y = SrcParamData%K_Y - DstParamData%K_Z = SrcParamData%K_Z - DstParamData%C_X = SrcParamData%C_X - DstParamData%C_Y = SrcParamData%C_Y - DstParamData%C_Z = SrcParamData%C_Z - DstParamData%K_S = SrcParamData%K_S - DstParamData%C_S = SrcParamData%C_S - DstParamData%P_SP = SrcParamData%P_SP - DstParamData%N_SP = SrcParamData%N_SP - DstParamData%Gravity = SrcParamData%Gravity - DstParamData%StC_CMODE = SrcParamData%StC_CMODE - DstParamData%StC_SA_MODE = SrcParamData%StC_SA_MODE - DstParamData%StC_X_C_HIGH = SrcParamData%StC_X_C_HIGH - DstParamData%StC_X_C_LOW = SrcParamData%StC_X_C_LOW - DstParamData%StC_Y_C_HIGH = SrcParamData%StC_Y_C_HIGH - DstParamData%StC_Y_C_LOW = SrcParamData%StC_Y_C_LOW - DstParamData%StC_Z_C_HIGH = SrcParamData%StC_Z_C_HIGH - DstParamData%StC_Z_C_LOW = SrcParamData%StC_Z_C_LOW - DstParamData%StC_X_C_BRAKE = SrcParamData%StC_X_C_BRAKE - DstParamData%StC_Y_C_BRAKE = SrcParamData%StC_Y_C_BRAKE - DstParamData%StC_Z_C_BRAKE = SrcParamData%StC_Z_C_BRAKE - DstParamData%L_X = SrcParamData%L_X - DstParamData%B_X = SrcParamData%B_X - DstParamData%area_X = SrcParamData%area_X - DstParamData%area_ratio_X = SrcParamData%area_ratio_X - DstParamData%headLossCoeff_X = SrcParamData%headLossCoeff_X - DstParamData%rho_X = SrcParamData%rho_X - DstParamData%L_Y = SrcParamData%L_Y - DstParamData%B_Y = SrcParamData%B_Y - DstParamData%area_Y = SrcParamData%area_Y - DstParamData%area_ratio_Y = SrcParamData%area_ratio_Y - DstParamData%headLossCoeff_Y = SrcParamData%headLossCoeff_Y - DstParamData%rho_Y = SrcParamData%rho_Y - DstParamData%Use_F_TBL = SrcParamData%Use_F_TBL -IF (ALLOCATED(SrcParamData%F_TBL)) THEN - i1_l = LBOUND(SrcParamData%F_TBL,1) - i1_u = UBOUND(SrcParamData%F_TBL,1) - i2_l = LBOUND(SrcParamData%F_TBL,2) - i2_u = UBOUND(SrcParamData%F_TBL,2) - IF (.NOT. ALLOCATED(DstParamData%F_TBL)) THEN - ALLOCATE(DstParamData%F_TBL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%F_TBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%F_TBL = SrcParamData%F_TBL -ENDIF - DstParamData%NumMeshPts = SrcParamData%NumMeshPts - DstParamData%PrescribedForcesCoordSys = SrcParamData%PrescribedForcesCoordSys -IF (ALLOCATED(SrcParamData%StC_PrescribedForce)) THEN - i1_l = LBOUND(SrcParamData%StC_PrescribedForce,1) - i1_u = UBOUND(SrcParamData%StC_PrescribedForce,1) - i2_l = LBOUND(SrcParamData%StC_PrescribedForce,2) - i2_u = UBOUND(SrcParamData%StC_PrescribedForce,2) - IF (.NOT. ALLOCATED(DstParamData%StC_PrescribedForce)) THEN - ALLOCATE(DstParamData%StC_PrescribedForce(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StC_PrescribedForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%StC_PrescribedForce = SrcParamData%StC_PrescribedForce -ENDIF -IF (ALLOCATED(SrcParamData%StC_CChan)) THEN - i1_l = LBOUND(SrcParamData%StC_CChan,1) - i1_u = UBOUND(SrcParamData%StC_CChan,1) - IF (.NOT. ALLOCATED(DstParamData%StC_CChan)) THEN - ALLOCATE(DstParamData%StC_CChan(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StC_CChan.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%StC_CChan = SrcParamData%StC_CChan -ENDIF - END SUBROUTINE StC_CopyParam - - SUBROUTINE StC_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(StC_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%F_TBL)) THEN - DEALLOCATE(ParamData%F_TBL) -ENDIF -IF (ALLOCATED(ParamData%StC_PrescribedForce)) THEN - DEALLOCATE(ParamData%StC_PrescribedForce) -ENDIF -IF (ALLOCATED(ParamData%StC_CChan)) THEN - DEALLOCATE(ParamData%StC_CChan) -ENDIF - END SUBROUTINE StC_DestroyParam + ErrMsg = '' + DstParamData%DT = SrcParamData%DT + DstParamData%RootName = SrcParamData%RootName + DstParamData%StC_DOF_MODE = SrcParamData%StC_DOF_MODE + DstParamData%StC_X_DOF = SrcParamData%StC_X_DOF + DstParamData%StC_Y_DOF = SrcParamData%StC_Y_DOF + DstParamData%StC_Z_DOF = SrcParamData%StC_Z_DOF + DstParamData%StC_Z_PreLd = SrcParamData%StC_Z_PreLd + DstParamData%M_X = SrcParamData%M_X + DstParamData%M_Y = SrcParamData%M_Y + DstParamData%M_Z = SrcParamData%M_Z + DstParamData%M_XY = SrcParamData%M_XY + DstParamData%K_X = SrcParamData%K_X + DstParamData%K_Y = SrcParamData%K_Y + DstParamData%K_Z = SrcParamData%K_Z + DstParamData%C_X = SrcParamData%C_X + DstParamData%C_Y = SrcParamData%C_Y + DstParamData%C_Z = SrcParamData%C_Z + DstParamData%K_S = SrcParamData%K_S + DstParamData%C_S = SrcParamData%C_S + DstParamData%P_SP = SrcParamData%P_SP + DstParamData%N_SP = SrcParamData%N_SP + DstParamData%Gravity = SrcParamData%Gravity + DstParamData%StC_CMODE = SrcParamData%StC_CMODE + DstParamData%StC_SA_MODE = SrcParamData%StC_SA_MODE + DstParamData%StC_X_C_HIGH = SrcParamData%StC_X_C_HIGH + DstParamData%StC_X_C_LOW = SrcParamData%StC_X_C_LOW + DstParamData%StC_Y_C_HIGH = SrcParamData%StC_Y_C_HIGH + DstParamData%StC_Y_C_LOW = SrcParamData%StC_Y_C_LOW + DstParamData%StC_Z_C_HIGH = SrcParamData%StC_Z_C_HIGH + DstParamData%StC_Z_C_LOW = SrcParamData%StC_Z_C_LOW + DstParamData%StC_X_C_BRAKE = SrcParamData%StC_X_C_BRAKE + DstParamData%StC_Y_C_BRAKE = SrcParamData%StC_Y_C_BRAKE + DstParamData%StC_Z_C_BRAKE = SrcParamData%StC_Z_C_BRAKE + DstParamData%L_X = SrcParamData%L_X + DstParamData%B_X = SrcParamData%B_X + DstParamData%area_X = SrcParamData%area_X + DstParamData%area_ratio_X = SrcParamData%area_ratio_X + DstParamData%headLossCoeff_X = SrcParamData%headLossCoeff_X + DstParamData%rho_X = SrcParamData%rho_X + DstParamData%L_Y = SrcParamData%L_Y + DstParamData%B_Y = SrcParamData%B_Y + DstParamData%area_Y = SrcParamData%area_Y + DstParamData%area_ratio_Y = SrcParamData%area_ratio_Y + DstParamData%headLossCoeff_Y = SrcParamData%headLossCoeff_Y + DstParamData%rho_Y = SrcParamData%rho_Y + DstParamData%Use_F_TBL = SrcParamData%Use_F_TBL + if (allocated(SrcParamData%F_TBL)) then + LB(1:2) = lbound(SrcParamData%F_TBL) + UB(1:2) = ubound(SrcParamData%F_TBL) + if (.not. allocated(DstParamData%F_TBL)) then + allocate(DstParamData%F_TBL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%F_TBL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%F_TBL = SrcParamData%F_TBL + else if (allocated(DstParamData%F_TBL)) then + deallocate(DstParamData%F_TBL) + end if + DstParamData%NumMeshPts = SrcParamData%NumMeshPts + DstParamData%PrescribedForcesCoordSys = SrcParamData%PrescribedForcesCoordSys + if (allocated(SrcParamData%StC_PrescribedForce)) then + LB(1:2) = lbound(SrcParamData%StC_PrescribedForce) + UB(1:2) = ubound(SrcParamData%StC_PrescribedForce) + if (.not. allocated(DstParamData%StC_PrescribedForce)) then + allocate(DstParamData%StC_PrescribedForce(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StC_PrescribedForce.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%StC_PrescribedForce = SrcParamData%StC_PrescribedForce + else if (allocated(DstParamData%StC_PrescribedForce)) then + deallocate(DstParamData%StC_PrescribedForce) + end if + if (allocated(SrcParamData%StC_CChan)) then + LB(1:1) = lbound(SrcParamData%StC_CChan) + UB(1:1) = ubound(SrcParamData%StC_CChan) + if (.not. allocated(DstParamData%StC_CChan)) then + allocate(DstParamData%StC_CChan(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StC_CChan.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%StC_CChan = SrcParamData%StC_CChan + else if (allocated(DstParamData%StC_CChan)) then + deallocate(DstParamData%StC_CChan) + end if +end subroutine +subroutine StC_DestroyParam(ParamData, ErrStat, ErrMsg) + type(StC_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'StC_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%F_TBL)) then + deallocate(ParamData%F_TBL) + end if + if (allocated(ParamData%StC_PrescribedForce)) then + deallocate(ParamData%StC_PrescribedForce) + end if + if (allocated(ParamData%StC_CChan)) then + deallocate(ParamData%StC_CChan) + end if +end subroutine subroutine StC_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(StC_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'StC_PackParam' if (Buf%ErrStat >= AbortErrLev) return - ! DT call RegPack(Buf, InData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegPack(Buf, InData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! StC_DOF_MODE call RegPack(Buf, InData%StC_DOF_MODE) if (RegCheckErr(Buf, RoutineName)) return - ! StC_X_DOF call RegPack(Buf, InData%StC_X_DOF) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Y_DOF call RegPack(Buf, InData%StC_Y_DOF) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Z_DOF call RegPack(Buf, InData%StC_Z_DOF) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Z_PreLd call RegPack(Buf, InData%StC_Z_PreLd) if (RegCheckErr(Buf, RoutineName)) return - ! M_X call RegPack(Buf, InData%M_X) if (RegCheckErr(Buf, RoutineName)) return - ! M_Y call RegPack(Buf, InData%M_Y) if (RegCheckErr(Buf, RoutineName)) return - ! M_Z call RegPack(Buf, InData%M_Z) if (RegCheckErr(Buf, RoutineName)) return - ! M_XY call RegPack(Buf, InData%M_XY) if (RegCheckErr(Buf, RoutineName)) return - ! K_X call RegPack(Buf, InData%K_X) if (RegCheckErr(Buf, RoutineName)) return - ! K_Y call RegPack(Buf, InData%K_Y) if (RegCheckErr(Buf, RoutineName)) return - ! K_Z call RegPack(Buf, InData%K_Z) if (RegCheckErr(Buf, RoutineName)) return - ! C_X call RegPack(Buf, InData%C_X) if (RegCheckErr(Buf, RoutineName)) return - ! C_Y call RegPack(Buf, InData%C_Y) if (RegCheckErr(Buf, RoutineName)) return - ! C_Z call RegPack(Buf, InData%C_Z) if (RegCheckErr(Buf, RoutineName)) return - ! K_S call RegPack(Buf, InData%K_S) if (RegCheckErr(Buf, RoutineName)) return - ! C_S call RegPack(Buf, InData%C_S) if (RegCheckErr(Buf, RoutineName)) return - ! P_SP call RegPack(Buf, InData%P_SP) if (RegCheckErr(Buf, RoutineName)) return - ! N_SP call RegPack(Buf, InData%N_SP) if (RegCheckErr(Buf, RoutineName)) return - ! Gravity call RegPack(Buf, InData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - ! StC_CMODE call RegPack(Buf, InData%StC_CMODE) if (RegCheckErr(Buf, RoutineName)) return - ! StC_SA_MODE call RegPack(Buf, InData%StC_SA_MODE) if (RegCheckErr(Buf, RoutineName)) return - ! StC_X_C_HIGH call RegPack(Buf, InData%StC_X_C_HIGH) if (RegCheckErr(Buf, RoutineName)) return - ! StC_X_C_LOW call RegPack(Buf, InData%StC_X_C_LOW) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Y_C_HIGH call RegPack(Buf, InData%StC_Y_C_HIGH) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Y_C_LOW call RegPack(Buf, InData%StC_Y_C_LOW) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Z_C_HIGH call RegPack(Buf, InData%StC_Z_C_HIGH) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Z_C_LOW call RegPack(Buf, InData%StC_Z_C_LOW) if (RegCheckErr(Buf, RoutineName)) return - ! StC_X_C_BRAKE call RegPack(Buf, InData%StC_X_C_BRAKE) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Y_C_BRAKE call RegPack(Buf, InData%StC_Y_C_BRAKE) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Z_C_BRAKE call RegPack(Buf, InData%StC_Z_C_BRAKE) if (RegCheckErr(Buf, RoutineName)) return - ! L_X call RegPack(Buf, InData%L_X) if (RegCheckErr(Buf, RoutineName)) return - ! B_X call RegPack(Buf, InData%B_X) if (RegCheckErr(Buf, RoutineName)) return - ! area_X call RegPack(Buf, InData%area_X) if (RegCheckErr(Buf, RoutineName)) return - ! area_ratio_X call RegPack(Buf, InData%area_ratio_X) if (RegCheckErr(Buf, RoutineName)) return - ! headLossCoeff_X call RegPack(Buf, InData%headLossCoeff_X) if (RegCheckErr(Buf, RoutineName)) return - ! rho_X call RegPack(Buf, InData%rho_X) if (RegCheckErr(Buf, RoutineName)) return - ! L_Y call RegPack(Buf, InData%L_Y) if (RegCheckErr(Buf, RoutineName)) return - ! B_Y call RegPack(Buf, InData%B_Y) if (RegCheckErr(Buf, RoutineName)) return - ! area_Y call RegPack(Buf, InData%area_Y) if (RegCheckErr(Buf, RoutineName)) return - ! area_ratio_Y call RegPack(Buf, InData%area_ratio_Y) if (RegCheckErr(Buf, RoutineName)) return - ! headLossCoeff_Y call RegPack(Buf, InData%headLossCoeff_Y) if (RegCheckErr(Buf, RoutineName)) return - ! rho_Y call RegPack(Buf, InData%rho_Y) if (RegCheckErr(Buf, RoutineName)) return - ! Use_F_TBL call RegPack(Buf, InData%Use_F_TBL) if (RegCheckErr(Buf, RoutineName)) return - ! F_TBL call RegPack(Buf, allocated(InData%F_TBL)) if (allocated(InData%F_TBL)) then call RegPackBounds(Buf, 2, lbound(InData%F_TBL), ubound(InData%F_TBL)) call RegPack(Buf, InData%F_TBL) end if if (RegCheckErr(Buf, RoutineName)) return - ! NumMeshPts call RegPack(Buf, InData%NumMeshPts) if (RegCheckErr(Buf, RoutineName)) return - ! PrescribedForcesCoordSys call RegPack(Buf, InData%PrescribedForcesCoordSys) if (RegCheckErr(Buf, RoutineName)) return - ! StC_PrescribedForce call RegPack(Buf, allocated(InData%StC_PrescribedForce)) if (allocated(InData%StC_PrescribedForce)) then call RegPackBounds(Buf, 2, lbound(InData%StC_PrescribedForce), ubound(InData%StC_PrescribedForce)) call RegPack(Buf, InData%StC_PrescribedForce) end if if (RegCheckErr(Buf, RoutineName)) return - ! StC_CChan call RegPack(Buf, allocated(InData%StC_CChan)) if (allocated(InData%StC_CChan)) then call RegPackBounds(Buf, 1, lbound(InData%StC_CChan), ubound(InData%StC_CChan)) @@ -2814,145 +2437,98 @@ subroutine StC_UnPackParam(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! DT call RegUnpack(Buf, OutData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegUnpack(Buf, OutData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! StC_DOF_MODE call RegUnpack(Buf, OutData%StC_DOF_MODE) if (RegCheckErr(Buf, RoutineName)) return - ! StC_X_DOF call RegUnpack(Buf, OutData%StC_X_DOF) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Y_DOF call RegUnpack(Buf, OutData%StC_Y_DOF) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Z_DOF call RegUnpack(Buf, OutData%StC_Z_DOF) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Z_PreLd call RegUnpack(Buf, OutData%StC_Z_PreLd) if (RegCheckErr(Buf, RoutineName)) return - ! M_X call RegUnpack(Buf, OutData%M_X) if (RegCheckErr(Buf, RoutineName)) return - ! M_Y call RegUnpack(Buf, OutData%M_Y) if (RegCheckErr(Buf, RoutineName)) return - ! M_Z call RegUnpack(Buf, OutData%M_Z) if (RegCheckErr(Buf, RoutineName)) return - ! M_XY call RegUnpack(Buf, OutData%M_XY) if (RegCheckErr(Buf, RoutineName)) return - ! K_X call RegUnpack(Buf, OutData%K_X) if (RegCheckErr(Buf, RoutineName)) return - ! K_Y call RegUnpack(Buf, OutData%K_Y) if (RegCheckErr(Buf, RoutineName)) return - ! K_Z call RegUnpack(Buf, OutData%K_Z) if (RegCheckErr(Buf, RoutineName)) return - ! C_X call RegUnpack(Buf, OutData%C_X) if (RegCheckErr(Buf, RoutineName)) return - ! C_Y call RegUnpack(Buf, OutData%C_Y) if (RegCheckErr(Buf, RoutineName)) return - ! C_Z call RegUnpack(Buf, OutData%C_Z) if (RegCheckErr(Buf, RoutineName)) return - ! K_S call RegUnpack(Buf, OutData%K_S) if (RegCheckErr(Buf, RoutineName)) return - ! C_S call RegUnpack(Buf, OutData%C_S) if (RegCheckErr(Buf, RoutineName)) return - ! P_SP call RegUnpack(Buf, OutData%P_SP) if (RegCheckErr(Buf, RoutineName)) return - ! N_SP call RegUnpack(Buf, OutData%N_SP) if (RegCheckErr(Buf, RoutineName)) return - ! Gravity call RegUnpack(Buf, OutData%Gravity) if (RegCheckErr(Buf, RoutineName)) return - ! StC_CMODE call RegUnpack(Buf, OutData%StC_CMODE) if (RegCheckErr(Buf, RoutineName)) return - ! StC_SA_MODE call RegUnpack(Buf, OutData%StC_SA_MODE) if (RegCheckErr(Buf, RoutineName)) return - ! StC_X_C_HIGH call RegUnpack(Buf, OutData%StC_X_C_HIGH) if (RegCheckErr(Buf, RoutineName)) return - ! StC_X_C_LOW call RegUnpack(Buf, OutData%StC_X_C_LOW) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Y_C_HIGH call RegUnpack(Buf, OutData%StC_Y_C_HIGH) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Y_C_LOW call RegUnpack(Buf, OutData%StC_Y_C_LOW) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Z_C_HIGH call RegUnpack(Buf, OutData%StC_Z_C_HIGH) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Z_C_LOW call RegUnpack(Buf, OutData%StC_Z_C_LOW) if (RegCheckErr(Buf, RoutineName)) return - ! StC_X_C_BRAKE call RegUnpack(Buf, OutData%StC_X_C_BRAKE) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Y_C_BRAKE call RegUnpack(Buf, OutData%StC_Y_C_BRAKE) if (RegCheckErr(Buf, RoutineName)) return - ! StC_Z_C_BRAKE call RegUnpack(Buf, OutData%StC_Z_C_BRAKE) if (RegCheckErr(Buf, RoutineName)) return - ! L_X call RegUnpack(Buf, OutData%L_X) if (RegCheckErr(Buf, RoutineName)) return - ! B_X call RegUnpack(Buf, OutData%B_X) if (RegCheckErr(Buf, RoutineName)) return - ! area_X call RegUnpack(Buf, OutData%area_X) if (RegCheckErr(Buf, RoutineName)) return - ! area_ratio_X call RegUnpack(Buf, OutData%area_ratio_X) if (RegCheckErr(Buf, RoutineName)) return - ! headLossCoeff_X call RegUnpack(Buf, OutData%headLossCoeff_X) if (RegCheckErr(Buf, RoutineName)) return - ! rho_X call RegUnpack(Buf, OutData%rho_X) if (RegCheckErr(Buf, RoutineName)) return - ! L_Y call RegUnpack(Buf, OutData%L_Y) if (RegCheckErr(Buf, RoutineName)) return - ! B_Y call RegUnpack(Buf, OutData%B_Y) if (RegCheckErr(Buf, RoutineName)) return - ! area_Y call RegUnpack(Buf, OutData%area_Y) if (RegCheckErr(Buf, RoutineName)) return - ! area_ratio_Y call RegUnpack(Buf, OutData%area_ratio_Y) if (RegCheckErr(Buf, RoutineName)) return - ! headLossCoeff_Y call RegUnpack(Buf, OutData%headLossCoeff_Y) if (RegCheckErr(Buf, RoutineName)) return - ! rho_Y call RegUnpack(Buf, OutData%rho_Y) if (RegCheckErr(Buf, RoutineName)) return - ! Use_F_TBL call RegUnpack(Buf, OutData%Use_F_TBL) if (RegCheckErr(Buf, RoutineName)) return - ! F_TBL if (allocated(OutData%F_TBL)) deallocate(OutData%F_TBL) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2967,13 +2543,10 @@ subroutine StC_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%F_TBL) if (RegCheckErr(Buf, RoutineName)) return end if - ! NumMeshPts call RegUnpack(Buf, OutData%NumMeshPts) if (RegCheckErr(Buf, RoutineName)) return - ! PrescribedForcesCoordSys call RegUnpack(Buf, OutData%PrescribedForcesCoordSys) if (RegCheckErr(Buf, RoutineName)) return - ! StC_PrescribedForce if (allocated(OutData%StC_PrescribedForce)) deallocate(OutData%StC_PrescribedForce) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2988,7 +2561,6 @@ subroutine StC_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%StC_PrescribedForce) if (RegCheckErr(Buf, RoutineName)) return end if - ! StC_CChan if (allocated(OutData%StC_CChan)) deallocate(OutData%StC_CChan) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3004,130 +2576,129 @@ subroutine StC_UnPackParam(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE StC_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(StC_InputType), INTENT(INOUT) :: SrcInputData - TYPE(StC_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_CopyInput' -! + +subroutine StC_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(StC_InputType), intent(inout) :: SrcInputData + type(StC_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'StC_CopyInput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInputData%Mesh)) THEN - i1_l = LBOUND(SrcInputData%Mesh,1) - i1_u = UBOUND(SrcInputData%Mesh,1) - IF (.NOT. ALLOCATED(DstInputData%Mesh)) THEN - ALLOCATE(DstInputData%Mesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Mesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputData%Mesh,1), UBOUND(SrcInputData%Mesh,1) - CALL MeshCopy( SrcInputData%Mesh(i1), DstInputData%Mesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInputData%CmdStiff)) THEN - i1_l = LBOUND(SrcInputData%CmdStiff,1) - i1_u = UBOUND(SrcInputData%CmdStiff,1) - i2_l = LBOUND(SrcInputData%CmdStiff,2) - i2_u = UBOUND(SrcInputData%CmdStiff,2) - IF (.NOT. ALLOCATED(DstInputData%CmdStiff)) THEN - ALLOCATE(DstInputData%CmdStiff(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CmdStiff.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%CmdStiff = SrcInputData%CmdStiff -ENDIF -IF (ALLOCATED(SrcInputData%CmdDamp)) THEN - i1_l = LBOUND(SrcInputData%CmdDamp,1) - i1_u = UBOUND(SrcInputData%CmdDamp,1) - i2_l = LBOUND(SrcInputData%CmdDamp,2) - i2_u = UBOUND(SrcInputData%CmdDamp,2) - IF (.NOT. ALLOCATED(DstInputData%CmdDamp)) THEN - ALLOCATE(DstInputData%CmdDamp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CmdDamp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%CmdDamp = SrcInputData%CmdDamp -ENDIF -IF (ALLOCATED(SrcInputData%CmdBrake)) THEN - i1_l = LBOUND(SrcInputData%CmdBrake,1) - i1_u = UBOUND(SrcInputData%CmdBrake,1) - i2_l = LBOUND(SrcInputData%CmdBrake,2) - i2_u = UBOUND(SrcInputData%CmdBrake,2) - IF (.NOT. ALLOCATED(DstInputData%CmdBrake)) THEN - ALLOCATE(DstInputData%CmdBrake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CmdBrake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%CmdBrake = SrcInputData%CmdBrake -ENDIF -IF (ALLOCATED(SrcInputData%CmdForce)) THEN - i1_l = LBOUND(SrcInputData%CmdForce,1) - i1_u = UBOUND(SrcInputData%CmdForce,1) - i2_l = LBOUND(SrcInputData%CmdForce,2) - i2_u = UBOUND(SrcInputData%CmdForce,2) - IF (.NOT. ALLOCATED(DstInputData%CmdForce)) THEN - ALLOCATE(DstInputData%CmdForce(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CmdForce.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%CmdForce = SrcInputData%CmdForce -ENDIF - END SUBROUTINE StC_CopyInput - - SUBROUTINE StC_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(StC_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputData%Mesh)) THEN -DO i1 = LBOUND(InputData%Mesh,1), UBOUND(InputData%Mesh,1) - CALL MeshDestroy( InputData%Mesh(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(InputData%Mesh) -ENDIF -IF (ALLOCATED(InputData%CmdStiff)) THEN - DEALLOCATE(InputData%CmdStiff) -ENDIF -IF (ALLOCATED(InputData%CmdDamp)) THEN - DEALLOCATE(InputData%CmdDamp) -ENDIF -IF (ALLOCATED(InputData%CmdBrake)) THEN - DEALLOCATE(InputData%CmdBrake) -ENDIF -IF (ALLOCATED(InputData%CmdForce)) THEN - DEALLOCATE(InputData%CmdForce) -ENDIF - END SUBROUTINE StC_DestroyInput + ErrMsg = '' + if (allocated(SrcInputData%Mesh)) then + LB(1:1) = lbound(SrcInputData%Mesh) + UB(1:1) = ubound(SrcInputData%Mesh) + if (.not. allocated(DstInputData%Mesh)) then + allocate(DstInputData%Mesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Mesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcInputData%Mesh(i1), DstInputData%Mesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstInputData%Mesh)) then + deallocate(DstInputData%Mesh) + end if + if (allocated(SrcInputData%CmdStiff)) then + LB(1:2) = lbound(SrcInputData%CmdStiff) + UB(1:2) = ubound(SrcInputData%CmdStiff) + if (.not. allocated(DstInputData%CmdStiff)) then + allocate(DstInputData%CmdStiff(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CmdStiff.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%CmdStiff = SrcInputData%CmdStiff + else if (allocated(DstInputData%CmdStiff)) then + deallocate(DstInputData%CmdStiff) + end if + if (allocated(SrcInputData%CmdDamp)) then + LB(1:2) = lbound(SrcInputData%CmdDamp) + UB(1:2) = ubound(SrcInputData%CmdDamp) + if (.not. allocated(DstInputData%CmdDamp)) then + allocate(DstInputData%CmdDamp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CmdDamp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%CmdDamp = SrcInputData%CmdDamp + else if (allocated(DstInputData%CmdDamp)) then + deallocate(DstInputData%CmdDamp) + end if + if (allocated(SrcInputData%CmdBrake)) then + LB(1:2) = lbound(SrcInputData%CmdBrake) + UB(1:2) = ubound(SrcInputData%CmdBrake) + if (.not. allocated(DstInputData%CmdBrake)) then + allocate(DstInputData%CmdBrake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CmdBrake.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%CmdBrake = SrcInputData%CmdBrake + else if (allocated(DstInputData%CmdBrake)) then + deallocate(DstInputData%CmdBrake) + end if + if (allocated(SrcInputData%CmdForce)) then + LB(1:2) = lbound(SrcInputData%CmdForce) + UB(1:2) = ubound(SrcInputData%CmdForce) + if (.not. allocated(DstInputData%CmdForce)) then + allocate(DstInputData%CmdForce(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CmdForce.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%CmdForce = SrcInputData%CmdForce + else if (allocated(DstInputData%CmdForce)) then + deallocate(DstInputData%CmdForce) + end if +end subroutine +subroutine StC_DestroyInput(InputData, ErrStat, ErrMsg) + type(StC_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'StC_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%Mesh)) then + LB(1:1) = lbound(InputData%Mesh) + UB(1:1) = ubound(InputData%Mesh) + do i1 = LB(1), UB(1) + call MeshDestroy( InputData%Mesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(InputData%Mesh) + end if + if (allocated(InputData%CmdStiff)) then + deallocate(InputData%CmdStiff) + end if + if (allocated(InputData%CmdDamp)) then + deallocate(InputData%CmdDamp) + end if + if (allocated(InputData%CmdBrake)) then + deallocate(InputData%CmdBrake) + end if + if (allocated(InputData%CmdForce)) then + deallocate(InputData%CmdForce) + end if +end subroutine subroutine StC_PackInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -3136,7 +2707,6 @@ subroutine StC_PackInput(Buf, Indata) integer(IntKi) :: i1, i2 integer(IntKi) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return - ! Mesh call RegPack(Buf, allocated(InData%Mesh)) if (allocated(InData%Mesh)) then call RegPackBounds(Buf, 1, lbound(InData%Mesh), ubound(InData%Mesh)) @@ -3147,28 +2717,24 @@ subroutine StC_PackInput(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! CmdStiff call RegPack(Buf, allocated(InData%CmdStiff)) if (allocated(InData%CmdStiff)) then call RegPackBounds(Buf, 2, lbound(InData%CmdStiff), ubound(InData%CmdStiff)) call RegPack(Buf, InData%CmdStiff) end if if (RegCheckErr(Buf, RoutineName)) return - ! CmdDamp call RegPack(Buf, allocated(InData%CmdDamp)) if (allocated(InData%CmdDamp)) then call RegPackBounds(Buf, 2, lbound(InData%CmdDamp), ubound(InData%CmdDamp)) call RegPack(Buf, InData%CmdDamp) end if if (RegCheckErr(Buf, RoutineName)) return - ! CmdBrake call RegPack(Buf, allocated(InData%CmdBrake)) if (allocated(InData%CmdBrake)) then call RegPackBounds(Buf, 2, lbound(InData%CmdBrake), ubound(InData%CmdBrake)) call RegPack(Buf, InData%CmdBrake) end if if (RegCheckErr(Buf, RoutineName)) return - ! CmdForce call RegPack(Buf, allocated(InData%CmdForce)) if (allocated(InData%CmdForce)) then call RegPackBounds(Buf, 2, lbound(InData%CmdForce), ubound(InData%CmdForce)) @@ -3186,7 +2752,6 @@ subroutine StC_UnPackInput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! Mesh if (allocated(OutData%Mesh)) deallocate(OutData%Mesh) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3202,7 +2767,6 @@ subroutine StC_UnPackInput(Buf, OutData) call MeshUnpack(Buf, OutData%Mesh(i1)) ! Mesh end do end if - ! CmdStiff if (allocated(OutData%CmdStiff)) deallocate(OutData%CmdStiff) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3217,7 +2781,6 @@ subroutine StC_UnPackInput(Buf, OutData) call RegUnpack(Buf, OutData%CmdStiff) if (RegCheckErr(Buf, RoutineName)) return end if - ! CmdDamp if (allocated(OutData%CmdDamp)) deallocate(OutData%CmdDamp) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3232,7 +2795,6 @@ subroutine StC_UnPackInput(Buf, OutData) call RegUnpack(Buf, OutData%CmdDamp) if (RegCheckErr(Buf, RoutineName)) return end if - ! CmdBrake if (allocated(OutData%CmdBrake)) deallocate(OutData%CmdBrake) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3247,7 +2809,6 @@ subroutine StC_UnPackInput(Buf, OutData) call RegUnpack(Buf, OutData%CmdBrake) if (RegCheckErr(Buf, RoutineName)) return end if - ! CmdForce if (allocated(OutData%CmdForce)) deallocate(OutData%CmdForce) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3263,96 +2824,95 @@ subroutine StC_UnPackInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE StC_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(StC_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(StC_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_CopyOutput' -! + +subroutine StC_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(StC_OutputType), intent(inout) :: SrcOutputData + type(StC_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'StC_CopyOutput' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%Mesh)) THEN - i1_l = LBOUND(SrcOutputData%Mesh,1) - i1_u = UBOUND(SrcOutputData%Mesh,1) - IF (.NOT. ALLOCATED(DstOutputData%Mesh)) THEN - ALLOCATE(DstOutputData%Mesh(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Mesh.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOutputData%Mesh,1), UBOUND(SrcOutputData%Mesh,1) - CALL MeshCopy( SrcOutputData%Mesh(i1), DstOutputData%Mesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcOutputData%MeasDisp)) THEN - i1_l = LBOUND(SrcOutputData%MeasDisp,1) - i1_u = UBOUND(SrcOutputData%MeasDisp,1) - i2_l = LBOUND(SrcOutputData%MeasDisp,2) - i2_u = UBOUND(SrcOutputData%MeasDisp,2) - IF (.NOT. ALLOCATED(DstOutputData%MeasDisp)) THEN - ALLOCATE(DstOutputData%MeasDisp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%MeasDisp.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%MeasDisp = SrcOutputData%MeasDisp -ENDIF -IF (ALLOCATED(SrcOutputData%MeasVel)) THEN - i1_l = LBOUND(SrcOutputData%MeasVel,1) - i1_u = UBOUND(SrcOutputData%MeasVel,1) - i2_l = LBOUND(SrcOutputData%MeasVel,2) - i2_u = UBOUND(SrcOutputData%MeasVel,2) - IF (.NOT. ALLOCATED(DstOutputData%MeasVel)) THEN - ALLOCATE(DstOutputData%MeasVel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%MeasVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%MeasVel = SrcOutputData%MeasVel -ENDIF - END SUBROUTINE StC_CopyOutput - - SUBROUTINE StC_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(StC_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'StC_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OutputData%Mesh)) THEN -DO i1 = LBOUND(OutputData%Mesh,1), UBOUND(OutputData%Mesh,1) - CALL MeshDestroy( OutputData%Mesh(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OutputData%Mesh) -ENDIF -IF (ALLOCATED(OutputData%MeasDisp)) THEN - DEALLOCATE(OutputData%MeasDisp) -ENDIF -IF (ALLOCATED(OutputData%MeasVel)) THEN - DEALLOCATE(OutputData%MeasVel) -ENDIF - END SUBROUTINE StC_DestroyOutput + ErrMsg = '' + if (allocated(SrcOutputData%Mesh)) then + LB(1:1) = lbound(SrcOutputData%Mesh) + UB(1:1) = ubound(SrcOutputData%Mesh) + if (.not. allocated(DstOutputData%Mesh)) then + allocate(DstOutputData%Mesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Mesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcOutputData%Mesh(i1), DstOutputData%Mesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstOutputData%Mesh)) then + deallocate(DstOutputData%Mesh) + end if + if (allocated(SrcOutputData%MeasDisp)) then + LB(1:2) = lbound(SrcOutputData%MeasDisp) + UB(1:2) = ubound(SrcOutputData%MeasDisp) + if (.not. allocated(DstOutputData%MeasDisp)) then + allocate(DstOutputData%MeasDisp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%MeasDisp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%MeasDisp = SrcOutputData%MeasDisp + else if (allocated(DstOutputData%MeasDisp)) then + deallocate(DstOutputData%MeasDisp) + end if + if (allocated(SrcOutputData%MeasVel)) then + LB(1:2) = lbound(SrcOutputData%MeasVel) + UB(1:2) = ubound(SrcOutputData%MeasVel) + if (.not. allocated(DstOutputData%MeasVel)) then + allocate(DstOutputData%MeasVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%MeasVel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%MeasVel = SrcOutputData%MeasVel + else if (allocated(DstOutputData%MeasVel)) then + deallocate(DstOutputData%MeasVel) + end if +end subroutine +subroutine StC_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(StC_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'StC_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%Mesh)) then + LB(1:1) = lbound(OutputData%Mesh) + UB(1:1) = ubound(OutputData%Mesh) + do i1 = LB(1), UB(1) + call MeshDestroy( OutputData%Mesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%Mesh) + end if + if (allocated(OutputData%MeasDisp)) then + deallocate(OutputData%MeasDisp) + end if + if (allocated(OutputData%MeasVel)) then + deallocate(OutputData%MeasVel) + end if +end subroutine subroutine StC_PackOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -3361,7 +2921,6 @@ subroutine StC_PackOutput(Buf, Indata) integer(IntKi) :: i1, i2 integer(IntKi) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return - ! Mesh call RegPack(Buf, allocated(InData%Mesh)) if (allocated(InData%Mesh)) then call RegPackBounds(Buf, 1, lbound(InData%Mesh), ubound(InData%Mesh)) @@ -3372,14 +2931,12 @@ subroutine StC_PackOutput(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! MeasDisp call RegPack(Buf, allocated(InData%MeasDisp)) if (allocated(InData%MeasDisp)) then call RegPackBounds(Buf, 2, lbound(InData%MeasDisp), ubound(InData%MeasDisp)) call RegPack(Buf, InData%MeasDisp) end if if (RegCheckErr(Buf, RoutineName)) return - ! MeasVel call RegPack(Buf, allocated(InData%MeasVel)) if (allocated(InData%MeasVel)) then call RegPackBounds(Buf, 2, lbound(InData%MeasVel), ubound(InData%MeasVel)) @@ -3397,7 +2954,6 @@ subroutine StC_UnPackOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! Mesh if (allocated(OutData%Mesh)) deallocate(OutData%Mesh) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3413,7 +2969,6 @@ subroutine StC_UnPackOutput(Buf, OutData) call MeshUnpack(Buf, OutData%Mesh(i1)) ! Mesh end do end if - ! MeasDisp if (allocated(OutData%MeasDisp)) deallocate(OutData%MeasDisp) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3428,7 +2983,6 @@ subroutine StC_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%MeasDisp) if (RegCheckErr(Buf, RoutineName)) return end if - ! MeasVel if (allocated(OutData%MeasVel)) deallocate(OutData%MeasVel) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/subdyn/src/SubDyn_Types.f90 b/modules/subdyn/src/SubDyn_Types.f90 index f5ee30b7b9..805686b28c 100644 --- a/modules/subdyn/src/SubDyn_Types.f90 +++ b/modules/subdyn/src/SubDyn_Types.f90 @@ -342,60 +342,51 @@ MODULE SubDyn_Types END TYPE SD_OutputType ! ======================= CONTAINS - SUBROUTINE SD_CopyIList( SrcIListData, DstIListData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IList), INTENT(IN) :: SrcIListData - TYPE(IList), INTENT(INOUT) :: DstIListData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyIList' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcIListData%List)) THEN - i1_l = LBOUND(SrcIListData%List,1) - i1_u = UBOUND(SrcIListData%List,1) - IF (.NOT. ALLOCATED(DstIListData%List)) THEN - ALLOCATE(DstIListData%List(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIListData%List.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstIListData%List = SrcIListData%List -ENDIF - END SUBROUTINE SD_CopyIList - - SUBROUTINE SD_DestroyIList( IListData, ErrStat, ErrMsg ) - TYPE(IList), INTENT(INOUT) :: IListData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyIList' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(IListData%List)) THEN - DEALLOCATE(IListData%List) -ENDIF - END SUBROUTINE SD_DestroyIList +subroutine SD_CopyIList(SrcIListData, DstIListData, CtrlCode, ErrStat, ErrMsg) + type(IList), intent(in) :: SrcIListData + type(IList), intent(inout) :: DstIListData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SD_CopyIList' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcIListData%List)) then + LB(1:1) = lbound(SrcIListData%List) + UB(1:1) = ubound(SrcIListData%List) + if (.not. allocated(DstIListData%List)) then + allocate(DstIListData%List(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstIListData%List.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstIListData%List = SrcIListData%List + else if (allocated(DstIListData%List)) then + deallocate(DstIListData%List) + end if +end subroutine +subroutine SD_DestroyIList(IListData, ErrStat, ErrMsg) + type(IList), intent(inout) :: IListData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SD_DestroyIList' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(IListData%List)) then + deallocate(IListData%List) + end if +end subroutine subroutine SD_PackIList(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(IList), intent(in) :: InData character(*), parameter :: RoutineName = 'SD_PackIList' if (Buf%ErrStat >= AbortErrLev) return - ! List call RegPack(Buf, allocated(InData%List)) if (allocated(InData%List)) then call RegPackBounds(Buf, 1, lbound(InData%List), ubound(InData%List)) @@ -412,7 +403,6 @@ subroutine SD_UnPackIList(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! List if (allocated(OutData%List)) deallocate(OutData%List) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -428,223 +418,195 @@ subroutine SD_UnPackIList(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE SD_CopyMeshAuxDataType( SrcMeshAuxDataTypeData, DstMeshAuxDataTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MeshAuxDataType), INTENT(IN) :: SrcMeshAuxDataTypeData - TYPE(MeshAuxDataType), INTENT(INOUT) :: DstMeshAuxDataTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyMeshAuxDataType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstMeshAuxDataTypeData%MemberID = SrcMeshAuxDataTypeData%MemberID - DstMeshAuxDataTypeData%NOutCnt = SrcMeshAuxDataTypeData%NOutCnt -IF (ALLOCATED(SrcMeshAuxDataTypeData%NodeCnt)) THEN - i1_l = LBOUND(SrcMeshAuxDataTypeData%NodeCnt,1) - i1_u = UBOUND(SrcMeshAuxDataTypeData%NodeCnt,1) - IF (.NOT. ALLOCATED(DstMeshAuxDataTypeData%NodeCnt)) THEN - ALLOCATE(DstMeshAuxDataTypeData%NodeCnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%NodeCnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshAuxDataTypeData%NodeCnt = SrcMeshAuxDataTypeData%NodeCnt -ENDIF -IF (ALLOCATED(SrcMeshAuxDataTypeData%NodeIDs)) THEN - i1_l = LBOUND(SrcMeshAuxDataTypeData%NodeIDs,1) - i1_u = UBOUND(SrcMeshAuxDataTypeData%NodeIDs,1) - IF (.NOT. ALLOCATED(DstMeshAuxDataTypeData%NodeIDs)) THEN - ALLOCATE(DstMeshAuxDataTypeData%NodeIDs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%NodeIDs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshAuxDataTypeData%NodeIDs = SrcMeshAuxDataTypeData%NodeIDs -ENDIF -IF (ALLOCATED(SrcMeshAuxDataTypeData%ElmIDs)) THEN - i1_l = LBOUND(SrcMeshAuxDataTypeData%ElmIDs,1) - i1_u = UBOUND(SrcMeshAuxDataTypeData%ElmIDs,1) - i2_l = LBOUND(SrcMeshAuxDataTypeData%ElmIDs,2) - i2_u = UBOUND(SrcMeshAuxDataTypeData%ElmIDs,2) - IF (.NOT. ALLOCATED(DstMeshAuxDataTypeData%ElmIDs)) THEN - ALLOCATE(DstMeshAuxDataTypeData%ElmIDs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%ElmIDs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshAuxDataTypeData%ElmIDs = SrcMeshAuxDataTypeData%ElmIDs -ENDIF -IF (ALLOCATED(SrcMeshAuxDataTypeData%ElmNds)) THEN - i1_l = LBOUND(SrcMeshAuxDataTypeData%ElmNds,1) - i1_u = UBOUND(SrcMeshAuxDataTypeData%ElmNds,1) - i2_l = LBOUND(SrcMeshAuxDataTypeData%ElmNds,2) - i2_u = UBOUND(SrcMeshAuxDataTypeData%ElmNds,2) - IF (.NOT. ALLOCATED(DstMeshAuxDataTypeData%ElmNds)) THEN - ALLOCATE(DstMeshAuxDataTypeData%ElmNds(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%ElmNds.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshAuxDataTypeData%ElmNds = SrcMeshAuxDataTypeData%ElmNds -ENDIF -IF (ALLOCATED(SrcMeshAuxDataTypeData%Me)) THEN - i1_l = LBOUND(SrcMeshAuxDataTypeData%Me,1) - i1_u = UBOUND(SrcMeshAuxDataTypeData%Me,1) - i2_l = LBOUND(SrcMeshAuxDataTypeData%Me,2) - i2_u = UBOUND(SrcMeshAuxDataTypeData%Me,2) - i3_l = LBOUND(SrcMeshAuxDataTypeData%Me,3) - i3_u = UBOUND(SrcMeshAuxDataTypeData%Me,3) - i4_l = LBOUND(SrcMeshAuxDataTypeData%Me,4) - i4_u = UBOUND(SrcMeshAuxDataTypeData%Me,4) - IF (.NOT. ALLOCATED(DstMeshAuxDataTypeData%Me)) THEN - ALLOCATE(DstMeshAuxDataTypeData%Me(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%Me.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshAuxDataTypeData%Me = SrcMeshAuxDataTypeData%Me -ENDIF -IF (ALLOCATED(SrcMeshAuxDataTypeData%Ke)) THEN - i1_l = LBOUND(SrcMeshAuxDataTypeData%Ke,1) - i1_u = UBOUND(SrcMeshAuxDataTypeData%Ke,1) - i2_l = LBOUND(SrcMeshAuxDataTypeData%Ke,2) - i2_u = UBOUND(SrcMeshAuxDataTypeData%Ke,2) - i3_l = LBOUND(SrcMeshAuxDataTypeData%Ke,3) - i3_u = UBOUND(SrcMeshAuxDataTypeData%Ke,3) - i4_l = LBOUND(SrcMeshAuxDataTypeData%Ke,4) - i4_u = UBOUND(SrcMeshAuxDataTypeData%Ke,4) - IF (.NOT. ALLOCATED(DstMeshAuxDataTypeData%Ke)) THEN - ALLOCATE(DstMeshAuxDataTypeData%Ke(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%Ke.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshAuxDataTypeData%Ke = SrcMeshAuxDataTypeData%Ke -ENDIF -IF (ALLOCATED(SrcMeshAuxDataTypeData%Fg)) THEN - i1_l = LBOUND(SrcMeshAuxDataTypeData%Fg,1) - i1_u = UBOUND(SrcMeshAuxDataTypeData%Fg,1) - i2_l = LBOUND(SrcMeshAuxDataTypeData%Fg,2) - i2_u = UBOUND(SrcMeshAuxDataTypeData%Fg,2) - i3_l = LBOUND(SrcMeshAuxDataTypeData%Fg,3) - i3_u = UBOUND(SrcMeshAuxDataTypeData%Fg,3) - IF (.NOT. ALLOCATED(DstMeshAuxDataTypeData%Fg)) THEN - ALLOCATE(DstMeshAuxDataTypeData%Fg(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%Fg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshAuxDataTypeData%Fg = SrcMeshAuxDataTypeData%Fg -ENDIF - END SUBROUTINE SD_CopyMeshAuxDataType - SUBROUTINE SD_DestroyMeshAuxDataType( MeshAuxDataTypeData, ErrStat, ErrMsg ) - TYPE(MeshAuxDataType), INTENT(INOUT) :: MeshAuxDataTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyMeshAuxDataType' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MeshAuxDataTypeData%NodeCnt)) THEN - DEALLOCATE(MeshAuxDataTypeData%NodeCnt) -ENDIF -IF (ALLOCATED(MeshAuxDataTypeData%NodeIDs)) THEN - DEALLOCATE(MeshAuxDataTypeData%NodeIDs) -ENDIF -IF (ALLOCATED(MeshAuxDataTypeData%ElmIDs)) THEN - DEALLOCATE(MeshAuxDataTypeData%ElmIDs) -ENDIF -IF (ALLOCATED(MeshAuxDataTypeData%ElmNds)) THEN - DEALLOCATE(MeshAuxDataTypeData%ElmNds) -ENDIF -IF (ALLOCATED(MeshAuxDataTypeData%Me)) THEN - DEALLOCATE(MeshAuxDataTypeData%Me) -ENDIF -IF (ALLOCATED(MeshAuxDataTypeData%Ke)) THEN - DEALLOCATE(MeshAuxDataTypeData%Ke) -ENDIF -IF (ALLOCATED(MeshAuxDataTypeData%Fg)) THEN - DEALLOCATE(MeshAuxDataTypeData%Fg) -ENDIF - END SUBROUTINE SD_DestroyMeshAuxDataType +subroutine SD_CopyMeshAuxDataType(SrcMeshAuxDataTypeData, DstMeshAuxDataTypeData, CtrlCode, ErrStat, ErrMsg) + type(MeshAuxDataType), intent(in) :: SrcMeshAuxDataTypeData + type(MeshAuxDataType), intent(inout) :: DstMeshAuxDataTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(4), UB(4) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SD_CopyMeshAuxDataType' + ErrStat = ErrID_None + ErrMsg = '' + DstMeshAuxDataTypeData%MemberID = SrcMeshAuxDataTypeData%MemberID + DstMeshAuxDataTypeData%NOutCnt = SrcMeshAuxDataTypeData%NOutCnt + if (allocated(SrcMeshAuxDataTypeData%NodeCnt)) then + LB(1:1) = lbound(SrcMeshAuxDataTypeData%NodeCnt) + UB(1:1) = ubound(SrcMeshAuxDataTypeData%NodeCnt) + if (.not. allocated(DstMeshAuxDataTypeData%NodeCnt)) then + allocate(DstMeshAuxDataTypeData%NodeCnt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%NodeCnt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshAuxDataTypeData%NodeCnt = SrcMeshAuxDataTypeData%NodeCnt + else if (allocated(DstMeshAuxDataTypeData%NodeCnt)) then + deallocate(DstMeshAuxDataTypeData%NodeCnt) + end if + if (allocated(SrcMeshAuxDataTypeData%NodeIDs)) then + LB(1:1) = lbound(SrcMeshAuxDataTypeData%NodeIDs) + UB(1:1) = ubound(SrcMeshAuxDataTypeData%NodeIDs) + if (.not. allocated(DstMeshAuxDataTypeData%NodeIDs)) then + allocate(DstMeshAuxDataTypeData%NodeIDs(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%NodeIDs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshAuxDataTypeData%NodeIDs = SrcMeshAuxDataTypeData%NodeIDs + else if (allocated(DstMeshAuxDataTypeData%NodeIDs)) then + deallocate(DstMeshAuxDataTypeData%NodeIDs) + end if + if (allocated(SrcMeshAuxDataTypeData%ElmIDs)) then + LB(1:2) = lbound(SrcMeshAuxDataTypeData%ElmIDs) + UB(1:2) = ubound(SrcMeshAuxDataTypeData%ElmIDs) + if (.not. allocated(DstMeshAuxDataTypeData%ElmIDs)) then + allocate(DstMeshAuxDataTypeData%ElmIDs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%ElmIDs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshAuxDataTypeData%ElmIDs = SrcMeshAuxDataTypeData%ElmIDs + else if (allocated(DstMeshAuxDataTypeData%ElmIDs)) then + deallocate(DstMeshAuxDataTypeData%ElmIDs) + end if + if (allocated(SrcMeshAuxDataTypeData%ElmNds)) then + LB(1:2) = lbound(SrcMeshAuxDataTypeData%ElmNds) + UB(1:2) = ubound(SrcMeshAuxDataTypeData%ElmNds) + if (.not. allocated(DstMeshAuxDataTypeData%ElmNds)) then + allocate(DstMeshAuxDataTypeData%ElmNds(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%ElmNds.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshAuxDataTypeData%ElmNds = SrcMeshAuxDataTypeData%ElmNds + else if (allocated(DstMeshAuxDataTypeData%ElmNds)) then + deallocate(DstMeshAuxDataTypeData%ElmNds) + end if + if (allocated(SrcMeshAuxDataTypeData%Me)) then + LB(1:4) = lbound(SrcMeshAuxDataTypeData%Me) + UB(1:4) = ubound(SrcMeshAuxDataTypeData%Me) + if (.not. allocated(DstMeshAuxDataTypeData%Me)) then + allocate(DstMeshAuxDataTypeData%Me(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%Me.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshAuxDataTypeData%Me = SrcMeshAuxDataTypeData%Me + else if (allocated(DstMeshAuxDataTypeData%Me)) then + deallocate(DstMeshAuxDataTypeData%Me) + end if + if (allocated(SrcMeshAuxDataTypeData%Ke)) then + LB(1:4) = lbound(SrcMeshAuxDataTypeData%Ke) + UB(1:4) = ubound(SrcMeshAuxDataTypeData%Ke) + if (.not. allocated(DstMeshAuxDataTypeData%Ke)) then + allocate(DstMeshAuxDataTypeData%Ke(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%Ke.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshAuxDataTypeData%Ke = SrcMeshAuxDataTypeData%Ke + else if (allocated(DstMeshAuxDataTypeData%Ke)) then + deallocate(DstMeshAuxDataTypeData%Ke) + end if + if (allocated(SrcMeshAuxDataTypeData%Fg)) then + LB(1:3) = lbound(SrcMeshAuxDataTypeData%Fg) + UB(1:3) = ubound(SrcMeshAuxDataTypeData%Fg) + if (.not. allocated(DstMeshAuxDataTypeData%Fg)) then + allocate(DstMeshAuxDataTypeData%Fg(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMeshAuxDataTypeData%Fg.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMeshAuxDataTypeData%Fg = SrcMeshAuxDataTypeData%Fg + else if (allocated(DstMeshAuxDataTypeData%Fg)) then + deallocate(DstMeshAuxDataTypeData%Fg) + end if +end subroutine +subroutine SD_DestroyMeshAuxDataType(MeshAuxDataTypeData, ErrStat, ErrMsg) + type(MeshAuxDataType), intent(inout) :: MeshAuxDataTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SD_DestroyMeshAuxDataType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MeshAuxDataTypeData%NodeCnt)) then + deallocate(MeshAuxDataTypeData%NodeCnt) + end if + if (allocated(MeshAuxDataTypeData%NodeIDs)) then + deallocate(MeshAuxDataTypeData%NodeIDs) + end if + if (allocated(MeshAuxDataTypeData%ElmIDs)) then + deallocate(MeshAuxDataTypeData%ElmIDs) + end if + if (allocated(MeshAuxDataTypeData%ElmNds)) then + deallocate(MeshAuxDataTypeData%ElmNds) + end if + if (allocated(MeshAuxDataTypeData%Me)) then + deallocate(MeshAuxDataTypeData%Me) + end if + if (allocated(MeshAuxDataTypeData%Ke)) then + deallocate(MeshAuxDataTypeData%Ke) + end if + if (allocated(MeshAuxDataTypeData%Fg)) then + deallocate(MeshAuxDataTypeData%Fg) + end if +end subroutine subroutine SD_PackMeshAuxDataType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(MeshAuxDataType), intent(in) :: InData character(*), parameter :: RoutineName = 'SD_PackMeshAuxDataType' if (Buf%ErrStat >= AbortErrLev) return - ! MemberID call RegPack(Buf, InData%MemberID) if (RegCheckErr(Buf, RoutineName)) return - ! NOutCnt call RegPack(Buf, InData%NOutCnt) if (RegCheckErr(Buf, RoutineName)) return - ! NodeCnt call RegPack(Buf, allocated(InData%NodeCnt)) if (allocated(InData%NodeCnt)) then call RegPackBounds(Buf, 1, lbound(InData%NodeCnt), ubound(InData%NodeCnt)) call RegPack(Buf, InData%NodeCnt) end if if (RegCheckErr(Buf, RoutineName)) return - ! NodeIDs call RegPack(Buf, allocated(InData%NodeIDs)) if (allocated(InData%NodeIDs)) then call RegPackBounds(Buf, 1, lbound(InData%NodeIDs), ubound(InData%NodeIDs)) call RegPack(Buf, InData%NodeIDs) end if if (RegCheckErr(Buf, RoutineName)) return - ! ElmIDs call RegPack(Buf, allocated(InData%ElmIDs)) if (allocated(InData%ElmIDs)) then call RegPackBounds(Buf, 2, lbound(InData%ElmIDs), ubound(InData%ElmIDs)) call RegPack(Buf, InData%ElmIDs) end if if (RegCheckErr(Buf, RoutineName)) return - ! ElmNds call RegPack(Buf, allocated(InData%ElmNds)) if (allocated(InData%ElmNds)) then call RegPackBounds(Buf, 2, lbound(InData%ElmNds), ubound(InData%ElmNds)) call RegPack(Buf, InData%ElmNds) end if if (RegCheckErr(Buf, RoutineName)) return - ! Me call RegPack(Buf, allocated(InData%Me)) if (allocated(InData%Me)) then call RegPackBounds(Buf, 4, lbound(InData%Me), ubound(InData%Me)) call RegPack(Buf, InData%Me) end if if (RegCheckErr(Buf, RoutineName)) return - ! Ke call RegPack(Buf, allocated(InData%Ke)) if (allocated(InData%Ke)) then call RegPackBounds(Buf, 4, lbound(InData%Ke), ubound(InData%Ke)) call RegPack(Buf, InData%Ke) end if if (RegCheckErr(Buf, RoutineName)) return - ! Fg call RegPack(Buf, allocated(InData%Fg)) if (allocated(InData%Fg)) then call RegPackBounds(Buf, 3, lbound(InData%Fg), ubound(InData%Fg)) @@ -661,13 +623,10 @@ subroutine SD_UnPackMeshAuxDataType(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! MemberID call RegUnpack(Buf, OutData%MemberID) if (RegCheckErr(Buf, RoutineName)) return - ! NOutCnt call RegUnpack(Buf, OutData%NOutCnt) if (RegCheckErr(Buf, RoutineName)) return - ! NodeCnt if (allocated(OutData%NodeCnt)) deallocate(OutData%NodeCnt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -682,7 +641,6 @@ subroutine SD_UnPackMeshAuxDataType(Buf, OutData) call RegUnpack(Buf, OutData%NodeCnt) if (RegCheckErr(Buf, RoutineName)) return end if - ! NodeIDs if (allocated(OutData%NodeIDs)) deallocate(OutData%NodeIDs) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -697,7 +655,6 @@ subroutine SD_UnPackMeshAuxDataType(Buf, OutData) call RegUnpack(Buf, OutData%NodeIDs) if (RegCheckErr(Buf, RoutineName)) return end if - ! ElmIDs if (allocated(OutData%ElmIDs)) deallocate(OutData%ElmIDs) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -712,7 +669,6 @@ subroutine SD_UnPackMeshAuxDataType(Buf, OutData) call RegUnpack(Buf, OutData%ElmIDs) if (RegCheckErr(Buf, RoutineName)) return end if - ! ElmNds if (allocated(OutData%ElmNds)) deallocate(OutData%ElmNds) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -727,7 +683,6 @@ subroutine SD_UnPackMeshAuxDataType(Buf, OutData) call RegUnpack(Buf, OutData%ElmNds) if (RegCheckErr(Buf, RoutineName)) return end if - ! Me if (allocated(OutData%Me)) deallocate(OutData%Me) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -742,7 +697,6 @@ subroutine SD_UnPackMeshAuxDataType(Buf, OutData) call RegUnpack(Buf, OutData%Me) if (RegCheckErr(Buf, RoutineName)) return end if - ! Ke if (allocated(OutData%Ke)) deallocate(OutData%Ke) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -757,7 +711,6 @@ subroutine SD_UnPackMeshAuxDataType(Buf, OutData) call RegUnpack(Buf, OutData%Ke) if (RegCheckErr(Buf, RoutineName)) return end if - ! Fg if (allocated(OutData%Fg)) deallocate(OutData%Fg) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -773,181 +726,166 @@ subroutine SD_UnPackMeshAuxDataType(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE SD_CopyCB_MatArrays( SrcCB_MatArraysData, DstCB_MatArraysData, CtrlCode, ErrStat, ErrMsg ) - TYPE(CB_MatArrays), INTENT(IN) :: SrcCB_MatArraysData - TYPE(CB_MatArrays), INTENT(INOUT) :: DstCB_MatArraysData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyCB_MatArrays' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcCB_MatArraysData%MBB)) THEN - i1_l = LBOUND(SrcCB_MatArraysData%MBB,1) - i1_u = UBOUND(SrcCB_MatArraysData%MBB,1) - i2_l = LBOUND(SrcCB_MatArraysData%MBB,2) - i2_u = UBOUND(SrcCB_MatArraysData%MBB,2) - IF (.NOT. ALLOCATED(DstCB_MatArraysData%MBB)) THEN - ALLOCATE(DstCB_MatArraysData%MBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%MBB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCB_MatArraysData%MBB = SrcCB_MatArraysData%MBB -ENDIF -IF (ALLOCATED(SrcCB_MatArraysData%MBM)) THEN - i1_l = LBOUND(SrcCB_MatArraysData%MBM,1) - i1_u = UBOUND(SrcCB_MatArraysData%MBM,1) - i2_l = LBOUND(SrcCB_MatArraysData%MBM,2) - i2_u = UBOUND(SrcCB_MatArraysData%MBM,2) - IF (.NOT. ALLOCATED(DstCB_MatArraysData%MBM)) THEN - ALLOCATE(DstCB_MatArraysData%MBM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%MBM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCB_MatArraysData%MBM = SrcCB_MatArraysData%MBM -ENDIF -IF (ALLOCATED(SrcCB_MatArraysData%KBB)) THEN - i1_l = LBOUND(SrcCB_MatArraysData%KBB,1) - i1_u = UBOUND(SrcCB_MatArraysData%KBB,1) - i2_l = LBOUND(SrcCB_MatArraysData%KBB,2) - i2_u = UBOUND(SrcCB_MatArraysData%KBB,2) - IF (.NOT. ALLOCATED(DstCB_MatArraysData%KBB)) THEN - ALLOCATE(DstCB_MatArraysData%KBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%KBB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCB_MatArraysData%KBB = SrcCB_MatArraysData%KBB -ENDIF -IF (ALLOCATED(SrcCB_MatArraysData%PhiL)) THEN - i1_l = LBOUND(SrcCB_MatArraysData%PhiL,1) - i1_u = UBOUND(SrcCB_MatArraysData%PhiL,1) - i2_l = LBOUND(SrcCB_MatArraysData%PhiL,2) - i2_u = UBOUND(SrcCB_MatArraysData%PhiL,2) - IF (.NOT. ALLOCATED(DstCB_MatArraysData%PhiL)) THEN - ALLOCATE(DstCB_MatArraysData%PhiL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%PhiL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCB_MatArraysData%PhiL = SrcCB_MatArraysData%PhiL -ENDIF -IF (ALLOCATED(SrcCB_MatArraysData%PhiR)) THEN - i1_l = LBOUND(SrcCB_MatArraysData%PhiR,1) - i1_u = UBOUND(SrcCB_MatArraysData%PhiR,1) - i2_l = LBOUND(SrcCB_MatArraysData%PhiR,2) - i2_u = UBOUND(SrcCB_MatArraysData%PhiR,2) - IF (.NOT. ALLOCATED(DstCB_MatArraysData%PhiR)) THEN - ALLOCATE(DstCB_MatArraysData%PhiR(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%PhiR.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCB_MatArraysData%PhiR = SrcCB_MatArraysData%PhiR -ENDIF -IF (ALLOCATED(SrcCB_MatArraysData%OmegaL)) THEN - i1_l = LBOUND(SrcCB_MatArraysData%OmegaL,1) - i1_u = UBOUND(SrcCB_MatArraysData%OmegaL,1) - IF (.NOT. ALLOCATED(DstCB_MatArraysData%OmegaL)) THEN - ALLOCATE(DstCB_MatArraysData%OmegaL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%OmegaL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstCB_MatArraysData%OmegaL = SrcCB_MatArraysData%OmegaL -ENDIF - END SUBROUTINE SD_CopyCB_MatArrays - - SUBROUTINE SD_DestroyCB_MatArrays( CB_MatArraysData, ErrStat, ErrMsg ) - TYPE(CB_MatArrays), INTENT(INOUT) :: CB_MatArraysData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyCB_MatArrays' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(CB_MatArraysData%MBB)) THEN - DEALLOCATE(CB_MatArraysData%MBB) -ENDIF -IF (ALLOCATED(CB_MatArraysData%MBM)) THEN - DEALLOCATE(CB_MatArraysData%MBM) -ENDIF -IF (ALLOCATED(CB_MatArraysData%KBB)) THEN - DEALLOCATE(CB_MatArraysData%KBB) -ENDIF -IF (ALLOCATED(CB_MatArraysData%PhiL)) THEN - DEALLOCATE(CB_MatArraysData%PhiL) -ENDIF -IF (ALLOCATED(CB_MatArraysData%PhiR)) THEN - DEALLOCATE(CB_MatArraysData%PhiR) -ENDIF -IF (ALLOCATED(CB_MatArraysData%OmegaL)) THEN - DEALLOCATE(CB_MatArraysData%OmegaL) -ENDIF - END SUBROUTINE SD_DestroyCB_MatArrays +subroutine SD_CopyCB_MatArrays(SrcCB_MatArraysData, DstCB_MatArraysData, CtrlCode, ErrStat, ErrMsg) + type(CB_MatArrays), intent(in) :: SrcCB_MatArraysData + type(CB_MatArrays), intent(inout) :: DstCB_MatArraysData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SD_CopyCB_MatArrays' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcCB_MatArraysData%MBB)) then + LB(1:2) = lbound(SrcCB_MatArraysData%MBB) + UB(1:2) = ubound(SrcCB_MatArraysData%MBB) + if (.not. allocated(DstCB_MatArraysData%MBB)) then + allocate(DstCB_MatArraysData%MBB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%MBB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCB_MatArraysData%MBB = SrcCB_MatArraysData%MBB + else if (allocated(DstCB_MatArraysData%MBB)) then + deallocate(DstCB_MatArraysData%MBB) + end if + if (allocated(SrcCB_MatArraysData%MBM)) then + LB(1:2) = lbound(SrcCB_MatArraysData%MBM) + UB(1:2) = ubound(SrcCB_MatArraysData%MBM) + if (.not. allocated(DstCB_MatArraysData%MBM)) then + allocate(DstCB_MatArraysData%MBM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%MBM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCB_MatArraysData%MBM = SrcCB_MatArraysData%MBM + else if (allocated(DstCB_MatArraysData%MBM)) then + deallocate(DstCB_MatArraysData%MBM) + end if + if (allocated(SrcCB_MatArraysData%KBB)) then + LB(1:2) = lbound(SrcCB_MatArraysData%KBB) + UB(1:2) = ubound(SrcCB_MatArraysData%KBB) + if (.not. allocated(DstCB_MatArraysData%KBB)) then + allocate(DstCB_MatArraysData%KBB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%KBB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCB_MatArraysData%KBB = SrcCB_MatArraysData%KBB + else if (allocated(DstCB_MatArraysData%KBB)) then + deallocate(DstCB_MatArraysData%KBB) + end if + if (allocated(SrcCB_MatArraysData%PhiL)) then + LB(1:2) = lbound(SrcCB_MatArraysData%PhiL) + UB(1:2) = ubound(SrcCB_MatArraysData%PhiL) + if (.not. allocated(DstCB_MatArraysData%PhiL)) then + allocate(DstCB_MatArraysData%PhiL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%PhiL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCB_MatArraysData%PhiL = SrcCB_MatArraysData%PhiL + else if (allocated(DstCB_MatArraysData%PhiL)) then + deallocate(DstCB_MatArraysData%PhiL) + end if + if (allocated(SrcCB_MatArraysData%PhiR)) then + LB(1:2) = lbound(SrcCB_MatArraysData%PhiR) + UB(1:2) = ubound(SrcCB_MatArraysData%PhiR) + if (.not. allocated(DstCB_MatArraysData%PhiR)) then + allocate(DstCB_MatArraysData%PhiR(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%PhiR.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCB_MatArraysData%PhiR = SrcCB_MatArraysData%PhiR + else if (allocated(DstCB_MatArraysData%PhiR)) then + deallocate(DstCB_MatArraysData%PhiR) + end if + if (allocated(SrcCB_MatArraysData%OmegaL)) then + LB(1:1) = lbound(SrcCB_MatArraysData%OmegaL) + UB(1:1) = ubound(SrcCB_MatArraysData%OmegaL) + if (.not. allocated(DstCB_MatArraysData%OmegaL)) then + allocate(DstCB_MatArraysData%OmegaL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCB_MatArraysData%OmegaL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCB_MatArraysData%OmegaL = SrcCB_MatArraysData%OmegaL + else if (allocated(DstCB_MatArraysData%OmegaL)) then + deallocate(DstCB_MatArraysData%OmegaL) + end if +end subroutine +subroutine SD_DestroyCB_MatArrays(CB_MatArraysData, ErrStat, ErrMsg) + type(CB_MatArrays), intent(inout) :: CB_MatArraysData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SD_DestroyCB_MatArrays' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(CB_MatArraysData%MBB)) then + deallocate(CB_MatArraysData%MBB) + end if + if (allocated(CB_MatArraysData%MBM)) then + deallocate(CB_MatArraysData%MBM) + end if + if (allocated(CB_MatArraysData%KBB)) then + deallocate(CB_MatArraysData%KBB) + end if + if (allocated(CB_MatArraysData%PhiL)) then + deallocate(CB_MatArraysData%PhiL) + end if + if (allocated(CB_MatArraysData%PhiR)) then + deallocate(CB_MatArraysData%PhiR) + end if + if (allocated(CB_MatArraysData%OmegaL)) then + deallocate(CB_MatArraysData%OmegaL) + end if +end subroutine subroutine SD_PackCB_MatArrays(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(CB_MatArrays), intent(in) :: InData character(*), parameter :: RoutineName = 'SD_PackCB_MatArrays' if (Buf%ErrStat >= AbortErrLev) return - ! MBB call RegPack(Buf, allocated(InData%MBB)) if (allocated(InData%MBB)) then call RegPackBounds(Buf, 2, lbound(InData%MBB), ubound(InData%MBB)) call RegPack(Buf, InData%MBB) end if if (RegCheckErr(Buf, RoutineName)) return - ! MBM call RegPack(Buf, allocated(InData%MBM)) if (allocated(InData%MBM)) then call RegPackBounds(Buf, 2, lbound(InData%MBM), ubound(InData%MBM)) call RegPack(Buf, InData%MBM) end if if (RegCheckErr(Buf, RoutineName)) return - ! KBB call RegPack(Buf, allocated(InData%KBB)) if (allocated(InData%KBB)) then call RegPackBounds(Buf, 2, lbound(InData%KBB), ubound(InData%KBB)) call RegPack(Buf, InData%KBB) end if if (RegCheckErr(Buf, RoutineName)) return - ! PhiL call RegPack(Buf, allocated(InData%PhiL)) if (allocated(InData%PhiL)) then call RegPackBounds(Buf, 2, lbound(InData%PhiL), ubound(InData%PhiL)) call RegPack(Buf, InData%PhiL) end if if (RegCheckErr(Buf, RoutineName)) return - ! PhiR call RegPack(Buf, allocated(InData%PhiR)) if (allocated(InData%PhiR)) then call RegPackBounds(Buf, 2, lbound(InData%PhiR), ubound(InData%PhiR)) call RegPack(Buf, InData%PhiR) end if if (RegCheckErr(Buf, RoutineName)) return - ! OmegaL call RegPack(Buf, allocated(InData%OmegaL)) if (allocated(InData%OmegaL)) then call RegPackBounds(Buf, 1, lbound(InData%OmegaL), ubound(InData%OmegaL)) @@ -964,7 +902,6 @@ subroutine SD_UnPackCB_MatArrays(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! MBB if (allocated(OutData%MBB)) deallocate(OutData%MBB) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -979,7 +916,6 @@ subroutine SD_UnPackCB_MatArrays(Buf, OutData) call RegUnpack(Buf, OutData%MBB) if (RegCheckErr(Buf, RoutineName)) return end if - ! MBM if (allocated(OutData%MBM)) deallocate(OutData%MBM) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -994,7 +930,6 @@ subroutine SD_UnPackCB_MatArrays(Buf, OutData) call RegUnpack(Buf, OutData%MBM) if (RegCheckErr(Buf, RoutineName)) return end if - ! KBB if (allocated(OutData%KBB)) deallocate(OutData%KBB) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1009,7 +944,6 @@ subroutine SD_UnPackCB_MatArrays(Buf, OutData) call RegUnpack(Buf, OutData%KBB) if (RegCheckErr(Buf, RoutineName)) return end if - ! PhiL if (allocated(OutData%PhiL)) deallocate(OutData%PhiL) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1024,7 +958,6 @@ subroutine SD_UnPackCB_MatArrays(Buf, OutData) call RegUnpack(Buf, OutData%PhiL) if (RegCheckErr(Buf, RoutineName)) return end if - ! PhiR if (allocated(OutData%PhiR)) deallocate(OutData%PhiR) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1039,7 +972,6 @@ subroutine SD_UnPackCB_MatArrays(Buf, OutData) call RegUnpack(Buf, OutData%PhiR) if (RegCheckErr(Buf, RoutineName)) return end if - ! OmegaL if (allocated(OutData%OmegaL)) deallocate(OutData%OmegaL) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1055,103 +987,75 @@ subroutine SD_UnPackCB_MatArrays(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE SD_CopyElemPropType( SrcElemPropTypeData, DstElemPropTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ElemPropType), INTENT(IN) :: SrcElemPropTypeData - TYPE(ElemPropType), INTENT(INOUT) :: DstElemPropTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyElemPropType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstElemPropTypeData%eType = SrcElemPropTypeData%eType - DstElemPropTypeData%Length = SrcElemPropTypeData%Length - DstElemPropTypeData%Ixx = SrcElemPropTypeData%Ixx - DstElemPropTypeData%Iyy = SrcElemPropTypeData%Iyy - DstElemPropTypeData%Jzz = SrcElemPropTypeData%Jzz - DstElemPropTypeData%Shear = SrcElemPropTypeData%Shear - DstElemPropTypeData%Kappa_x = SrcElemPropTypeData%Kappa_x - DstElemPropTypeData%Kappa_y = SrcElemPropTypeData%Kappa_y - DstElemPropTypeData%YoungE = SrcElemPropTypeData%YoungE - DstElemPropTypeData%ShearG = SrcElemPropTypeData%ShearG - DstElemPropTypeData%D = SrcElemPropTypeData%D - DstElemPropTypeData%Area = SrcElemPropTypeData%Area - DstElemPropTypeData%Rho = SrcElemPropTypeData%Rho - DstElemPropTypeData%T0 = SrcElemPropTypeData%T0 - DstElemPropTypeData%DirCos = SrcElemPropTypeData%DirCos - END SUBROUTINE SD_CopyElemPropType - - SUBROUTINE SD_DestroyElemPropType( ElemPropTypeData, ErrStat, ErrMsg ) - TYPE(ElemPropType), INTENT(INOUT) :: ElemPropTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyElemPropType' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE SD_DestroyElemPropType +subroutine SD_CopyElemPropType(SrcElemPropTypeData, DstElemPropTypeData, CtrlCode, ErrStat, ErrMsg) + type(ElemPropType), intent(in) :: SrcElemPropTypeData + type(ElemPropType), intent(inout) :: DstElemPropTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SD_CopyElemPropType' + ErrStat = ErrID_None + ErrMsg = '' + DstElemPropTypeData%eType = SrcElemPropTypeData%eType + DstElemPropTypeData%Length = SrcElemPropTypeData%Length + DstElemPropTypeData%Ixx = SrcElemPropTypeData%Ixx + DstElemPropTypeData%Iyy = SrcElemPropTypeData%Iyy + DstElemPropTypeData%Jzz = SrcElemPropTypeData%Jzz + DstElemPropTypeData%Shear = SrcElemPropTypeData%Shear + DstElemPropTypeData%Kappa_x = SrcElemPropTypeData%Kappa_x + DstElemPropTypeData%Kappa_y = SrcElemPropTypeData%Kappa_y + DstElemPropTypeData%YoungE = SrcElemPropTypeData%YoungE + DstElemPropTypeData%ShearG = SrcElemPropTypeData%ShearG + DstElemPropTypeData%D = SrcElemPropTypeData%D + DstElemPropTypeData%Area = SrcElemPropTypeData%Area + DstElemPropTypeData%Rho = SrcElemPropTypeData%Rho + DstElemPropTypeData%T0 = SrcElemPropTypeData%T0 + DstElemPropTypeData%DirCos = SrcElemPropTypeData%DirCos +end subroutine +subroutine SD_DestroyElemPropType(ElemPropTypeData, ErrStat, ErrMsg) + type(ElemPropType), intent(inout) :: ElemPropTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SD_DestroyElemPropType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine SD_PackElemPropType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(ElemPropType), intent(in) :: InData character(*), parameter :: RoutineName = 'SD_PackElemPropType' if (Buf%ErrStat >= AbortErrLev) return - ! eType call RegPack(Buf, InData%eType) if (RegCheckErr(Buf, RoutineName)) return - ! Length call RegPack(Buf, InData%Length) if (RegCheckErr(Buf, RoutineName)) return - ! Ixx call RegPack(Buf, InData%Ixx) if (RegCheckErr(Buf, RoutineName)) return - ! Iyy call RegPack(Buf, InData%Iyy) if (RegCheckErr(Buf, RoutineName)) return - ! Jzz call RegPack(Buf, InData%Jzz) if (RegCheckErr(Buf, RoutineName)) return - ! Shear call RegPack(Buf, InData%Shear) if (RegCheckErr(Buf, RoutineName)) return - ! Kappa_x call RegPack(Buf, InData%Kappa_x) if (RegCheckErr(Buf, RoutineName)) return - ! Kappa_y call RegPack(Buf, InData%Kappa_y) if (RegCheckErr(Buf, RoutineName)) return - ! YoungE call RegPack(Buf, InData%YoungE) if (RegCheckErr(Buf, RoutineName)) return - ! ShearG call RegPack(Buf, InData%ShearG) if (RegCheckErr(Buf, RoutineName)) return - ! D call RegPack(Buf, InData%D) if (RegCheckErr(Buf, RoutineName)) return - ! Area call RegPack(Buf, InData%Area) if (RegCheckErr(Buf, RoutineName)) return - ! Rho call RegPack(Buf, InData%Rho) if (RegCheckErr(Buf, RoutineName)) return - ! T0 call RegPack(Buf, InData%T0) if (RegCheckErr(Buf, RoutineName)) return - ! DirCos call RegPack(Buf, InData%DirCos) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1161,152 +1065,115 @@ subroutine SD_UnPackElemPropType(Buf, OutData) type(ElemPropType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackElemPropType' if (Buf%ErrStat /= ErrID_None) return - ! eType call RegUnpack(Buf, OutData%eType) if (RegCheckErr(Buf, RoutineName)) return - ! Length call RegUnpack(Buf, OutData%Length) if (RegCheckErr(Buf, RoutineName)) return - ! Ixx call RegUnpack(Buf, OutData%Ixx) if (RegCheckErr(Buf, RoutineName)) return - ! Iyy call RegUnpack(Buf, OutData%Iyy) if (RegCheckErr(Buf, RoutineName)) return - ! Jzz call RegUnpack(Buf, OutData%Jzz) if (RegCheckErr(Buf, RoutineName)) return - ! Shear call RegUnpack(Buf, OutData%Shear) if (RegCheckErr(Buf, RoutineName)) return - ! Kappa_x call RegUnpack(Buf, OutData%Kappa_x) if (RegCheckErr(Buf, RoutineName)) return - ! Kappa_y call RegUnpack(Buf, OutData%Kappa_y) if (RegCheckErr(Buf, RoutineName)) return - ! YoungE call RegUnpack(Buf, OutData%YoungE) if (RegCheckErr(Buf, RoutineName)) return - ! ShearG call RegUnpack(Buf, OutData%ShearG) if (RegCheckErr(Buf, RoutineName)) return - ! D call RegUnpack(Buf, OutData%D) if (RegCheckErr(Buf, RoutineName)) return - ! Area call RegUnpack(Buf, OutData%Area) if (RegCheckErr(Buf, RoutineName)) return - ! Rho call RegUnpack(Buf, OutData%Rho) if (RegCheckErr(Buf, RoutineName)) return - ! T0 call RegUnpack(Buf, OutData%T0) if (RegCheckErr(Buf, RoutineName)) return - ! DirCos call RegUnpack(Buf, OutData%DirCos) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE SD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SD_InitInputType), INTENT(INOUT) :: SrcInitInputData - TYPE(SD_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%SDInputFile = SrcInitInputData%SDInputFile - DstInitInputData%RootName = SrcInitInputData%RootName - DstInitInputData%g = SrcInitInputData%g - DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth - DstInitInputData%TP_RefPoint = SrcInitInputData%TP_RefPoint - DstInitInputData%SubRotateZ = SrcInitInputData%SubRotateZ -IF (ALLOCATED(SrcInitInputData%SoilStiffness)) THEN - i1_l = LBOUND(SrcInitInputData%SoilStiffness,1) - i1_u = UBOUND(SrcInitInputData%SoilStiffness,1) - i2_l = LBOUND(SrcInitInputData%SoilStiffness,2) - i2_u = UBOUND(SrcInitInputData%SoilStiffness,2) - i3_l = LBOUND(SrcInitInputData%SoilStiffness,3) - i3_u = UBOUND(SrcInitInputData%SoilStiffness,3) - IF (.NOT. ALLOCATED(DstInitInputData%SoilStiffness)) THEN - ALLOCATE(DstInitInputData%SoilStiffness(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%SoilStiffness.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%SoilStiffness = SrcInitInputData%SoilStiffness -ENDIF - CALL MeshCopy( SrcInitInputData%SoilMesh, DstInitInputData%SoilMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitInputData%Linearize = SrcInitInputData%Linearize - END SUBROUTINE SD_CopyInitInput - - SUBROUTINE SD_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(SD_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(InitInputData%SoilStiffness)) THEN - DEALLOCATE(InitInputData%SoilStiffness) -ENDIF - CALL MeshDestroy( InitInputData%SoilMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE SD_DestroyInitInput +subroutine SD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(SD_InitInputType), intent(inout) :: SrcInitInputData + type(SD_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SD_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitInputData%SDInputFile = SrcInitInputData%SDInputFile + DstInitInputData%RootName = SrcInitInputData%RootName + DstInitInputData%g = SrcInitInputData%g + DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth + DstInitInputData%TP_RefPoint = SrcInitInputData%TP_RefPoint + DstInitInputData%SubRotateZ = SrcInitInputData%SubRotateZ + if (allocated(SrcInitInputData%SoilStiffness)) then + LB(1:3) = lbound(SrcInitInputData%SoilStiffness) + UB(1:3) = ubound(SrcInitInputData%SoilStiffness) + if (.not. allocated(DstInitInputData%SoilStiffness)) then + allocate(DstInitInputData%SoilStiffness(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%SoilStiffness.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitInputData%SoilStiffness = SrcInitInputData%SoilStiffness + else if (allocated(DstInitInputData%SoilStiffness)) then + deallocate(DstInitInputData%SoilStiffness) + end if + call MeshCopy(SrcInitInputData%SoilMesh, DstInitInputData%SoilMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitInputData%Linearize = SrcInitInputData%Linearize +end subroutine +subroutine SD_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(SD_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SD_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitInputData%SoilStiffness)) then + deallocate(InitInputData%SoilStiffness) + end if +end subroutine subroutine SD_PackInitInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SD_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SD_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return - ! SDInputFile call RegPack(Buf, InData%SDInputFile) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegPack(Buf, InData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! g call RegPack(Buf, InData%g) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDpth call RegPack(Buf, InData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - ! TP_RefPoint call RegPack(Buf, InData%TP_RefPoint) if (RegCheckErr(Buf, RoutineName)) return - ! SubRotateZ call RegPack(Buf, InData%SubRotateZ) if (RegCheckErr(Buf, RoutineName)) return - ! SoilStiffness call RegPack(Buf, allocated(InData%SoilStiffness)) if (allocated(InData%SoilStiffness)) then call RegPackBounds(Buf, 3, lbound(InData%SoilStiffness), ubound(InData%SoilStiffness)) call RegPack(Buf, InData%SoilStiffness) end if if (RegCheckErr(Buf, RoutineName)) return - ! SoilMesh call MeshPack(Buf, InData%SoilMesh) if (RegCheckErr(Buf, RoutineName)) return - ! Linearize call RegPack(Buf, InData%Linearize) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1319,25 +1186,18 @@ subroutine SD_UnPackInitInput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! SDInputFile call RegUnpack(Buf, OutData%SDInputFile) if (RegCheckErr(Buf, RoutineName)) return - ! RootName call RegUnpack(Buf, OutData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! g call RegUnpack(Buf, OutData%g) if (RegCheckErr(Buf, RoutineName)) return - ! WtrDpth call RegUnpack(Buf, OutData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return - ! TP_RefPoint call RegUnpack(Buf, OutData%TP_RefPoint) if (RegCheckErr(Buf, RoutineName)) return - ! SubRotateZ call RegUnpack(Buf, OutData%SubRotateZ) if (RegCheckErr(Buf, RoutineName)) return - ! SoilStiffness if (allocated(OutData%SoilStiffness)) deallocate(OutData%SoilStiffness) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1352,294 +1212,293 @@ subroutine SD_UnPackInitInput(Buf, OutData) call RegUnpack(Buf, OutData%SoilStiffness) if (RegCheckErr(Buf, RoutineName)) return end if - ! SoilMesh call MeshUnpack(Buf, OutData%SoilMesh) ! SoilMesh - ! Linearize call RegUnpack(Buf, OutData%Linearize) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE SD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SD_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(SD_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyInitOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInitOutputData%WriteOutputHdr)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputHdr,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputHdr,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputHdr)) THEN - ALLOCATE(DstInitOutputData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr -ENDIF -IF (ALLOCATED(SrcInitOutputData%WriteOutputUnt)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputUnt,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputUnt,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputUnt)) THEN - ALLOCATE(DstInitOutputData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt -ENDIF - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInitOutputData%LinNames_y)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_y,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_y,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_y)) THEN - ALLOCATE(DstInitOutputData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y -ENDIF -IF (ALLOCATED(SrcInitOutputData%LinNames_x)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_x,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_x,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_x)) THEN - ALLOCATE(DstInitOutputData%LinNames_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x -ENDIF -IF (ALLOCATED(SrcInitOutputData%LinNames_u)) THEN - i1_l = LBOUND(SrcInitOutputData%LinNames_u,1) - i1_u = UBOUND(SrcInitOutputData%LinNames_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_u)) THEN - ALLOCATE(DstInitOutputData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_y)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_y,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_y,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_y)) THEN - ALLOCATE(DstInitOutputData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_x)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_x,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_x,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_x)) THEN - ALLOCATE(DstInitOutputData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x -ENDIF -IF (ALLOCATED(SrcInitOutputData%RotFrame_u)) THEN - i1_l = LBOUND(SrcInitOutputData%RotFrame_u,1) - i1_u = UBOUND(SrcInitOutputData%RotFrame_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_u)) THEN - ALLOCATE(DstInitOutputData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%IsLoad_u)) THEN - i1_l = LBOUND(SrcInitOutputData%IsLoad_u,1) - i1_u = UBOUND(SrcInitOutputData%IsLoad_u,1) - IF (.NOT. ALLOCATED(DstInitOutputData%IsLoad_u)) THEN - ALLOCATE(DstInitOutputData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u -ENDIF -IF (ALLOCATED(SrcInitOutputData%DerivOrder_x)) THEN - i1_l = LBOUND(SrcInitOutputData%DerivOrder_x,1) - i1_u = UBOUND(SrcInitOutputData%DerivOrder_x,1) - IF (.NOT. ALLOCATED(DstInitOutputData%DerivOrder_x)) THEN - ALLOCATE(DstInitOutputData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x -ENDIF -IF (ALLOCATED(SrcInitOutputData%CableCChanRqst)) THEN - i1_l = LBOUND(SrcInitOutputData%CableCChanRqst,1) - i1_u = UBOUND(SrcInitOutputData%CableCChanRqst,1) - IF (.NOT. ALLOCATED(DstInitOutputData%CableCChanRqst)) THEN - ALLOCATE(DstInitOutputData%CableCChanRqst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%CableCChanRqst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%CableCChanRqst = SrcInitOutputData%CableCChanRqst -ENDIF - END SUBROUTINE SD_CopyInitOutput - - SUBROUTINE SD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(SD_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyInitOutput' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF - CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InitOutputData%LinNames_y)) THEN - DEALLOCATE(InitOutputData%LinNames_y) -ENDIF -IF (ALLOCATED(InitOutputData%LinNames_x)) THEN - DEALLOCATE(InitOutputData%LinNames_x) -ENDIF -IF (ALLOCATED(InitOutputData%LinNames_u)) THEN - DEALLOCATE(InitOutputData%LinNames_u) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_y)) THEN - DEALLOCATE(InitOutputData%RotFrame_y) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_x)) THEN - DEALLOCATE(InitOutputData%RotFrame_x) -ENDIF -IF (ALLOCATED(InitOutputData%RotFrame_u)) THEN - DEALLOCATE(InitOutputData%RotFrame_u) -ENDIF -IF (ALLOCATED(InitOutputData%IsLoad_u)) THEN - DEALLOCATE(InitOutputData%IsLoad_u) -ENDIF -IF (ALLOCATED(InitOutputData%DerivOrder_x)) THEN - DEALLOCATE(InitOutputData%DerivOrder_x) -ENDIF -IF (ALLOCATED(InitOutputData%CableCChanRqst)) THEN - DEALLOCATE(InitOutputData%CableCChanRqst) -ENDIF - END SUBROUTINE SD_DestroyInitOutput +subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(SD_InitOutputType), intent(in) :: SrcInitOutputData + type(SD_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SD_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr + else if (allocated(DstInitOutputData%WriteOutputHdr)) then + deallocate(DstInitOutputData%WriteOutputHdr) + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt + else if (allocated(DstInitOutputData%WriteOutputUnt)) then + deallocate(DstInitOutputData%WriteOutputUnt) + end if + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInitOutputData%LinNames_y)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_y) + UB(1:1) = ubound(SrcInitOutputData%LinNames_y) + if (.not. allocated(DstInitOutputData%LinNames_y)) then + allocate(DstInitOutputData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y + else if (allocated(DstInitOutputData%LinNames_y)) then + deallocate(DstInitOutputData%LinNames_y) + end if + if (allocated(SrcInitOutputData%LinNames_x)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_x) + UB(1:1) = ubound(SrcInitOutputData%LinNames_x) + if (.not. allocated(DstInitOutputData%LinNames_x)) then + allocate(DstInitOutputData%LinNames_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x + else if (allocated(DstInitOutputData%LinNames_x)) then + deallocate(DstInitOutputData%LinNames_x) + end if + if (allocated(SrcInitOutputData%LinNames_u)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_u) + UB(1:1) = ubound(SrcInitOutputData%LinNames_u) + if (.not. allocated(DstInitOutputData%LinNames_u)) then + allocate(DstInitOutputData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u + else if (allocated(DstInitOutputData%LinNames_u)) then + deallocate(DstInitOutputData%LinNames_u) + end if + if (allocated(SrcInitOutputData%RotFrame_y)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_y) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_y) + if (.not. allocated(DstInitOutputData%RotFrame_y)) then + allocate(DstInitOutputData%RotFrame_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y + else if (allocated(DstInitOutputData%RotFrame_y)) then + deallocate(DstInitOutputData%RotFrame_y) + end if + if (allocated(SrcInitOutputData%RotFrame_x)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_x) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_x) + if (.not. allocated(DstInitOutputData%RotFrame_x)) then + allocate(DstInitOutputData%RotFrame_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x + else if (allocated(DstInitOutputData%RotFrame_x)) then + deallocate(DstInitOutputData%RotFrame_x) + end if + if (allocated(SrcInitOutputData%RotFrame_u)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_u) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_u) + if (.not. allocated(DstInitOutputData%RotFrame_u)) then + allocate(DstInitOutputData%RotFrame_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u + else if (allocated(DstInitOutputData%RotFrame_u)) then + deallocate(DstInitOutputData%RotFrame_u) + end if + if (allocated(SrcInitOutputData%IsLoad_u)) then + LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) + UB(1:1) = ubound(SrcInitOutputData%IsLoad_u) + if (.not. allocated(DstInitOutputData%IsLoad_u)) then + allocate(DstInitOutputData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%IsLoad_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u + else if (allocated(DstInitOutputData%IsLoad_u)) then + deallocate(DstInitOutputData%IsLoad_u) + end if + if (allocated(SrcInitOutputData%DerivOrder_x)) then + LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) + UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x) + if (.not. allocated(DstInitOutputData%DerivOrder_x)) then + allocate(DstInitOutputData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%DerivOrder_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x + else if (allocated(DstInitOutputData%DerivOrder_x)) then + deallocate(DstInitOutputData%DerivOrder_x) + end if + if (allocated(SrcInitOutputData%CableCChanRqst)) then + LB(1:1) = lbound(SrcInitOutputData%CableCChanRqst) + UB(1:1) = ubound(SrcInitOutputData%CableCChanRqst) + if (.not. allocated(DstInitOutputData%CableCChanRqst)) then + allocate(DstInitOutputData%CableCChanRqst(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%CableCChanRqst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%CableCChanRqst = SrcInitOutputData%CableCChanRqst + else if (allocated(DstInitOutputData%CableCChanRqst)) then + deallocate(DstInitOutputData%CableCChanRqst) + end if +end subroutine +subroutine SD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(SD_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SD_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if + if (allocated(InitOutputData%LinNames_y)) then + deallocate(InitOutputData%LinNames_y) + end if + if (allocated(InitOutputData%LinNames_x)) then + deallocate(InitOutputData%LinNames_x) + end if + if (allocated(InitOutputData%LinNames_u)) then + deallocate(InitOutputData%LinNames_u) + end if + if (allocated(InitOutputData%RotFrame_y)) then + deallocate(InitOutputData%RotFrame_y) + end if + if (allocated(InitOutputData%RotFrame_x)) then + deallocate(InitOutputData%RotFrame_x) + end if + if (allocated(InitOutputData%RotFrame_u)) then + deallocate(InitOutputData%RotFrame_u) + end if + if (allocated(InitOutputData%IsLoad_u)) then + deallocate(InitOutputData%IsLoad_u) + end if + if (allocated(InitOutputData%DerivOrder_x)) then + deallocate(InitOutputData%DerivOrder_x) + end if + if (allocated(InitOutputData%CableCChanRqst)) then + deallocate(InitOutputData%CableCChanRqst) + end if +end subroutine subroutine SD_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SD_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SD_PackInitOutput' if (Buf%ErrStat >= AbortErrLev) return - ! WriteOutputHdr call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) call RegPack(Buf, InData%WriteOutputHdr) end if if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutputUnt call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) call RegPack(Buf, InData%WriteOutputUnt) end if if (RegCheckErr(Buf, RoutineName)) return - ! Ver call NWTC_Library_PackProgDesc(Buf, InData%Ver) if (RegCheckErr(Buf, RoutineName)) return - ! LinNames_y call RegPack(Buf, allocated(InData%LinNames_y)) if (allocated(InData%LinNames_y)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) call RegPack(Buf, InData%LinNames_y) end if if (RegCheckErr(Buf, RoutineName)) return - ! LinNames_x call RegPack(Buf, allocated(InData%LinNames_x)) if (allocated(InData%LinNames_x)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_x), ubound(InData%LinNames_x)) call RegPack(Buf, InData%LinNames_x) end if if (RegCheckErr(Buf, RoutineName)) return - ! LinNames_u call RegPack(Buf, allocated(InData%LinNames_u)) if (allocated(InData%LinNames_u)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) call RegPack(Buf, InData%LinNames_u) end if if (RegCheckErr(Buf, RoutineName)) return - ! RotFrame_y call RegPack(Buf, allocated(InData%RotFrame_y)) if (allocated(InData%RotFrame_y)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y), ubound(InData%RotFrame_y)) call RegPack(Buf, InData%RotFrame_y) end if if (RegCheckErr(Buf, RoutineName)) return - ! RotFrame_x call RegPack(Buf, allocated(InData%RotFrame_x)) if (allocated(InData%RotFrame_x)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x), ubound(InData%RotFrame_x)) call RegPack(Buf, InData%RotFrame_x) end if if (RegCheckErr(Buf, RoutineName)) return - ! RotFrame_u call RegPack(Buf, allocated(InData%RotFrame_u)) if (allocated(InData%RotFrame_u)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u), ubound(InData%RotFrame_u)) call RegPack(Buf, InData%RotFrame_u) end if if (RegCheckErr(Buf, RoutineName)) return - ! IsLoad_u call RegPack(Buf, allocated(InData%IsLoad_u)) if (allocated(InData%IsLoad_u)) then call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) call RegPack(Buf, InData%IsLoad_u) end if if (RegCheckErr(Buf, RoutineName)) return - ! DerivOrder_x call RegPack(Buf, allocated(InData%DerivOrder_x)) if (allocated(InData%DerivOrder_x)) then call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x), ubound(InData%DerivOrder_x)) call RegPack(Buf, InData%DerivOrder_x) end if if (RegCheckErr(Buf, RoutineName)) return - ! CableCChanRqst call RegPack(Buf, allocated(InData%CableCChanRqst)) if (allocated(InData%CableCChanRqst)) then call RegPackBounds(Buf, 1, lbound(InData%CableCChanRqst), ubound(InData%CableCChanRqst)) @@ -1656,7 +1515,6 @@ subroutine SD_UnPackInitOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! WriteOutputHdr if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1671,7 +1529,6 @@ subroutine SD_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutputHdr) if (RegCheckErr(Buf, RoutineName)) return end if - ! WriteOutputUnt if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1686,9 +1543,7 @@ subroutine SD_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutputUnt) if (RegCheckErr(Buf, RoutineName)) return end if - ! Ver call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver - ! LinNames_y if (allocated(OutData%LinNames_y)) deallocate(OutData%LinNames_y) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1703,7 +1558,6 @@ subroutine SD_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%LinNames_y) if (RegCheckErr(Buf, RoutineName)) return end if - ! LinNames_x if (allocated(OutData%LinNames_x)) deallocate(OutData%LinNames_x) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1718,7 +1572,6 @@ subroutine SD_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%LinNames_x) if (RegCheckErr(Buf, RoutineName)) return end if - ! LinNames_u if (allocated(OutData%LinNames_u)) deallocate(OutData%LinNames_u) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1733,7 +1586,6 @@ subroutine SD_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%LinNames_u) if (RegCheckErr(Buf, RoutineName)) return end if - ! RotFrame_y if (allocated(OutData%RotFrame_y)) deallocate(OutData%RotFrame_y) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1748,7 +1600,6 @@ subroutine SD_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%RotFrame_y) if (RegCheckErr(Buf, RoutineName)) return end if - ! RotFrame_x if (allocated(OutData%RotFrame_x)) deallocate(OutData%RotFrame_x) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1763,7 +1614,6 @@ subroutine SD_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%RotFrame_x) if (RegCheckErr(Buf, RoutineName)) return end if - ! RotFrame_u if (allocated(OutData%RotFrame_u)) deallocate(OutData%RotFrame_u) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1778,7 +1628,6 @@ subroutine SD_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%RotFrame_u) if (RegCheckErr(Buf, RoutineName)) return end if - ! IsLoad_u if (allocated(OutData%IsLoad_u)) deallocate(OutData%IsLoad_u) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1793,7 +1642,6 @@ subroutine SD_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%IsLoad_u) if (RegCheckErr(Buf, RoutineName)) return end if - ! DerivOrder_x if (allocated(OutData%DerivOrder_x)) deallocate(OutData%DerivOrder_x) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1808,7 +1656,6 @@ subroutine SD_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%DerivOrder_x) if (RegCheckErr(Buf, RoutineName)) return end if - ! CableCChanRqst if (allocated(OutData%CableCChanRqst)) deallocate(OutData%CableCChanRqst) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1824,762 +1671,705 @@ subroutine SD_UnPackInitOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE SD_CopyInitType( SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SD_InitType), INTENT(IN) :: SrcInitTypeData - TYPE(SD_InitType), INTENT(INOUT) :: DstInitTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyInitType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitTypeData%RootName = SrcInitTypeData%RootName - DstInitTypeData%TP_RefPoint = SrcInitTypeData%TP_RefPoint - DstInitTypeData%SubRotateZ = SrcInitTypeData%SubRotateZ - DstInitTypeData%g = SrcInitTypeData%g - DstInitTypeData%DT = SrcInitTypeData%DT - DstInitTypeData%NJoints = SrcInitTypeData%NJoints - DstInitTypeData%NPropSetsX = SrcInitTypeData%NPropSetsX - DstInitTypeData%NPropSetsB = SrcInitTypeData%NPropSetsB - DstInitTypeData%NPropSetsC = SrcInitTypeData%NPropSetsC - DstInitTypeData%NPropSetsR = SrcInitTypeData%NPropSetsR - DstInitTypeData%NCMass = SrcInitTypeData%NCMass - DstInitTypeData%NCOSMs = SrcInitTypeData%NCOSMs - DstInitTypeData%FEMMod = SrcInitTypeData%FEMMod - DstInitTypeData%NDiv = SrcInitTypeData%NDiv - DstInitTypeData%CBMod = SrcInitTypeData%CBMod -IF (ALLOCATED(SrcInitTypeData%Joints)) THEN - i1_l = LBOUND(SrcInitTypeData%Joints,1) - i1_u = UBOUND(SrcInitTypeData%Joints,1) - i2_l = LBOUND(SrcInitTypeData%Joints,2) - i2_u = UBOUND(SrcInitTypeData%Joints,2) - IF (.NOT. ALLOCATED(DstInitTypeData%Joints)) THEN - ALLOCATE(DstInitTypeData%Joints(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%Joints.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%Joints = SrcInitTypeData%Joints -ENDIF -IF (ALLOCATED(SrcInitTypeData%PropSetsB)) THEN - i1_l = LBOUND(SrcInitTypeData%PropSetsB,1) - i1_u = UBOUND(SrcInitTypeData%PropSetsB,1) - i2_l = LBOUND(SrcInitTypeData%PropSetsB,2) - i2_u = UBOUND(SrcInitTypeData%PropSetsB,2) - IF (.NOT. ALLOCATED(DstInitTypeData%PropSetsB)) THEN - ALLOCATE(DstInitTypeData%PropSetsB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropSetsB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%PropSetsB = SrcInitTypeData%PropSetsB -ENDIF -IF (ALLOCATED(SrcInitTypeData%PropSetsC)) THEN - i1_l = LBOUND(SrcInitTypeData%PropSetsC,1) - i1_u = UBOUND(SrcInitTypeData%PropSetsC,1) - i2_l = LBOUND(SrcInitTypeData%PropSetsC,2) - i2_u = UBOUND(SrcInitTypeData%PropSetsC,2) - IF (.NOT. ALLOCATED(DstInitTypeData%PropSetsC)) THEN - ALLOCATE(DstInitTypeData%PropSetsC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropSetsC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%PropSetsC = SrcInitTypeData%PropSetsC -ENDIF -IF (ALLOCATED(SrcInitTypeData%PropSetsR)) THEN - i1_l = LBOUND(SrcInitTypeData%PropSetsR,1) - i1_u = UBOUND(SrcInitTypeData%PropSetsR,1) - i2_l = LBOUND(SrcInitTypeData%PropSetsR,2) - i2_u = UBOUND(SrcInitTypeData%PropSetsR,2) - IF (.NOT. ALLOCATED(DstInitTypeData%PropSetsR)) THEN - ALLOCATE(DstInitTypeData%PropSetsR(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropSetsR.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%PropSetsR = SrcInitTypeData%PropSetsR -ENDIF -IF (ALLOCATED(SrcInitTypeData%PropSetsX)) THEN - i1_l = LBOUND(SrcInitTypeData%PropSetsX,1) - i1_u = UBOUND(SrcInitTypeData%PropSetsX,1) - i2_l = LBOUND(SrcInitTypeData%PropSetsX,2) - i2_u = UBOUND(SrcInitTypeData%PropSetsX,2) - IF (.NOT. ALLOCATED(DstInitTypeData%PropSetsX)) THEN - ALLOCATE(DstInitTypeData%PropSetsX(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropSetsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%PropSetsX = SrcInitTypeData%PropSetsX -ENDIF -IF (ALLOCATED(SrcInitTypeData%COSMs)) THEN - i1_l = LBOUND(SrcInitTypeData%COSMs,1) - i1_u = UBOUND(SrcInitTypeData%COSMs,1) - i2_l = LBOUND(SrcInitTypeData%COSMs,2) - i2_u = UBOUND(SrcInitTypeData%COSMs,2) - IF (.NOT. ALLOCATED(DstInitTypeData%COSMs)) THEN - ALLOCATE(DstInitTypeData%COSMs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%COSMs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%COSMs = SrcInitTypeData%COSMs -ENDIF -IF (ALLOCATED(SrcInitTypeData%CMass)) THEN - i1_l = LBOUND(SrcInitTypeData%CMass,1) - i1_u = UBOUND(SrcInitTypeData%CMass,1) - i2_l = LBOUND(SrcInitTypeData%CMass,2) - i2_u = UBOUND(SrcInitTypeData%CMass,2) - IF (.NOT. ALLOCATED(DstInitTypeData%CMass)) THEN - ALLOCATE(DstInitTypeData%CMass(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%CMass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%CMass = SrcInitTypeData%CMass -ENDIF -IF (ALLOCATED(SrcInitTypeData%JDampings)) THEN - i1_l = LBOUND(SrcInitTypeData%JDampings,1) - i1_u = UBOUND(SrcInitTypeData%JDampings,1) - IF (.NOT. ALLOCATED(DstInitTypeData%JDampings)) THEN - ALLOCATE(DstInitTypeData%JDampings(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%JDampings.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%JDampings = SrcInitTypeData%JDampings -ENDIF - DstInitTypeData%GuyanDampMod = SrcInitTypeData%GuyanDampMod - DstInitTypeData%RayleighDamp = SrcInitTypeData%RayleighDamp - DstInitTypeData%GuyanDampMat = SrcInitTypeData%GuyanDampMat -IF (ALLOCATED(SrcInitTypeData%Members)) THEN - i1_l = LBOUND(SrcInitTypeData%Members,1) - i1_u = UBOUND(SrcInitTypeData%Members,1) - i2_l = LBOUND(SrcInitTypeData%Members,2) - i2_u = UBOUND(SrcInitTypeData%Members,2) - IF (.NOT. ALLOCATED(DstInitTypeData%Members)) THEN - ALLOCATE(DstInitTypeData%Members(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%Members.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%Members = SrcInitTypeData%Members -ENDIF -IF (ALLOCATED(SrcInitTypeData%SSOutList)) THEN - i1_l = LBOUND(SrcInitTypeData%SSOutList,1) - i1_u = UBOUND(SrcInitTypeData%SSOutList,1) - IF (.NOT. ALLOCATED(DstInitTypeData%SSOutList)) THEN - ALLOCATE(DstInitTypeData%SSOutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%SSOutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%SSOutList = SrcInitTypeData%SSOutList -ENDIF - DstInitTypeData%OutCOSM = SrcInitTypeData%OutCOSM - DstInitTypeData%TabDelim = SrcInitTypeData%TabDelim -IF (ALLOCATED(SrcInitTypeData%SSIK)) THEN - i1_l = LBOUND(SrcInitTypeData%SSIK,1) - i1_u = UBOUND(SrcInitTypeData%SSIK,1) - i2_l = LBOUND(SrcInitTypeData%SSIK,2) - i2_u = UBOUND(SrcInitTypeData%SSIK,2) - IF (.NOT. ALLOCATED(DstInitTypeData%SSIK)) THEN - ALLOCATE(DstInitTypeData%SSIK(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%SSIK.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%SSIK = SrcInitTypeData%SSIK -ENDIF -IF (ALLOCATED(SrcInitTypeData%SSIM)) THEN - i1_l = LBOUND(SrcInitTypeData%SSIM,1) - i1_u = UBOUND(SrcInitTypeData%SSIM,1) - i2_l = LBOUND(SrcInitTypeData%SSIM,2) - i2_u = UBOUND(SrcInitTypeData%SSIM,2) - IF (.NOT. ALLOCATED(DstInitTypeData%SSIM)) THEN - ALLOCATE(DstInitTypeData%SSIM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%SSIM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%SSIM = SrcInitTypeData%SSIM -ENDIF -IF (ALLOCATED(SrcInitTypeData%SSIfile)) THEN - i1_l = LBOUND(SrcInitTypeData%SSIfile,1) - i1_u = UBOUND(SrcInitTypeData%SSIfile,1) - IF (.NOT. ALLOCATED(DstInitTypeData%SSIfile)) THEN - ALLOCATE(DstInitTypeData%SSIfile(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%SSIfile.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%SSIfile = SrcInitTypeData%SSIfile -ENDIF -IF (ALLOCATED(SrcInitTypeData%Soil_K)) THEN - i1_l = LBOUND(SrcInitTypeData%Soil_K,1) - i1_u = UBOUND(SrcInitTypeData%Soil_K,1) - i2_l = LBOUND(SrcInitTypeData%Soil_K,2) - i2_u = UBOUND(SrcInitTypeData%Soil_K,2) - i3_l = LBOUND(SrcInitTypeData%Soil_K,3) - i3_u = UBOUND(SrcInitTypeData%Soil_K,3) - IF (.NOT. ALLOCATED(DstInitTypeData%Soil_K)) THEN - ALLOCATE(DstInitTypeData%Soil_K(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%Soil_K.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%Soil_K = SrcInitTypeData%Soil_K -ENDIF -IF (ALLOCATED(SrcInitTypeData%Soil_Points)) THEN - i1_l = LBOUND(SrcInitTypeData%Soil_Points,1) - i1_u = UBOUND(SrcInitTypeData%Soil_Points,1) - i2_l = LBOUND(SrcInitTypeData%Soil_Points,2) - i2_u = UBOUND(SrcInitTypeData%Soil_Points,2) - IF (.NOT. ALLOCATED(DstInitTypeData%Soil_Points)) THEN - ALLOCATE(DstInitTypeData%Soil_Points(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%Soil_Points.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%Soil_Points = SrcInitTypeData%Soil_Points -ENDIF -IF (ALLOCATED(SrcInitTypeData%Soil_Nodes)) THEN - i1_l = LBOUND(SrcInitTypeData%Soil_Nodes,1) - i1_u = UBOUND(SrcInitTypeData%Soil_Nodes,1) - IF (.NOT. ALLOCATED(DstInitTypeData%Soil_Nodes)) THEN - ALLOCATE(DstInitTypeData%Soil_Nodes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%Soil_Nodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%Soil_Nodes = SrcInitTypeData%Soil_Nodes -ENDIF - DstInitTypeData%NElem = SrcInitTypeData%NElem - DstInitTypeData%NPropB = SrcInitTypeData%NPropB - DstInitTypeData%NPropC = SrcInitTypeData%NPropC - DstInitTypeData%NPropR = SrcInitTypeData%NPropR -IF (ALLOCATED(SrcInitTypeData%Nodes)) THEN - i1_l = LBOUND(SrcInitTypeData%Nodes,1) - i1_u = UBOUND(SrcInitTypeData%Nodes,1) - i2_l = LBOUND(SrcInitTypeData%Nodes,2) - i2_u = UBOUND(SrcInitTypeData%Nodes,2) - IF (.NOT. ALLOCATED(DstInitTypeData%Nodes)) THEN - ALLOCATE(DstInitTypeData%Nodes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%Nodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%Nodes = SrcInitTypeData%Nodes -ENDIF -IF (ALLOCATED(SrcInitTypeData%PropsB)) THEN - i1_l = LBOUND(SrcInitTypeData%PropsB,1) - i1_u = UBOUND(SrcInitTypeData%PropsB,1) - i2_l = LBOUND(SrcInitTypeData%PropsB,2) - i2_u = UBOUND(SrcInitTypeData%PropsB,2) - IF (.NOT. ALLOCATED(DstInitTypeData%PropsB)) THEN - ALLOCATE(DstInitTypeData%PropsB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropsB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%PropsB = SrcInitTypeData%PropsB -ENDIF -IF (ALLOCATED(SrcInitTypeData%PropsC)) THEN - i1_l = LBOUND(SrcInitTypeData%PropsC,1) - i1_u = UBOUND(SrcInitTypeData%PropsC,1) - i2_l = LBOUND(SrcInitTypeData%PropsC,2) - i2_u = UBOUND(SrcInitTypeData%PropsC,2) - IF (.NOT. ALLOCATED(DstInitTypeData%PropsC)) THEN - ALLOCATE(DstInitTypeData%PropsC(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropsC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%PropsC = SrcInitTypeData%PropsC -ENDIF -IF (ALLOCATED(SrcInitTypeData%PropsR)) THEN - i1_l = LBOUND(SrcInitTypeData%PropsR,1) - i1_u = UBOUND(SrcInitTypeData%PropsR,1) - i2_l = LBOUND(SrcInitTypeData%PropsR,2) - i2_u = UBOUND(SrcInitTypeData%PropsR,2) - IF (.NOT. ALLOCATED(DstInitTypeData%PropsR)) THEN - ALLOCATE(DstInitTypeData%PropsR(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropsR.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%PropsR = SrcInitTypeData%PropsR -ENDIF -IF (ALLOCATED(SrcInitTypeData%K)) THEN - i1_l = LBOUND(SrcInitTypeData%K,1) - i1_u = UBOUND(SrcInitTypeData%K,1) - i2_l = LBOUND(SrcInitTypeData%K,2) - i2_u = UBOUND(SrcInitTypeData%K,2) - IF (.NOT. ALLOCATED(DstInitTypeData%K)) THEN - ALLOCATE(DstInitTypeData%K(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%K.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%K = SrcInitTypeData%K -ENDIF -IF (ALLOCATED(SrcInitTypeData%M)) THEN - i1_l = LBOUND(SrcInitTypeData%M,1) - i1_u = UBOUND(SrcInitTypeData%M,1) - i2_l = LBOUND(SrcInitTypeData%M,2) - i2_u = UBOUND(SrcInitTypeData%M,2) - IF (.NOT. ALLOCATED(DstInitTypeData%M)) THEN - ALLOCATE(DstInitTypeData%M(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%M.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%M = SrcInitTypeData%M -ENDIF -IF (ALLOCATED(SrcInitTypeData%ElemProps)) THEN - i1_l = LBOUND(SrcInitTypeData%ElemProps,1) - i1_u = UBOUND(SrcInitTypeData%ElemProps,1) - i2_l = LBOUND(SrcInitTypeData%ElemProps,2) - i2_u = UBOUND(SrcInitTypeData%ElemProps,2) - IF (.NOT. ALLOCATED(DstInitTypeData%ElemProps)) THEN - ALLOCATE(DstInitTypeData%ElemProps(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%ElemProps.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%ElemProps = SrcInitTypeData%ElemProps -ENDIF -IF (ALLOCATED(SrcInitTypeData%MemberNodes)) THEN - i1_l = LBOUND(SrcInitTypeData%MemberNodes,1) - i1_u = UBOUND(SrcInitTypeData%MemberNodes,1) - i2_l = LBOUND(SrcInitTypeData%MemberNodes,2) - i2_u = UBOUND(SrcInitTypeData%MemberNodes,2) - IF (.NOT. ALLOCATED(DstInitTypeData%MemberNodes)) THEN - ALLOCATE(DstInitTypeData%MemberNodes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%MemberNodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%MemberNodes = SrcInitTypeData%MemberNodes -ENDIF -IF (ALLOCATED(SrcInitTypeData%NodesConnN)) THEN - i1_l = LBOUND(SrcInitTypeData%NodesConnN,1) - i1_u = UBOUND(SrcInitTypeData%NodesConnN,1) - i2_l = LBOUND(SrcInitTypeData%NodesConnN,2) - i2_u = UBOUND(SrcInitTypeData%NodesConnN,2) - IF (.NOT. ALLOCATED(DstInitTypeData%NodesConnN)) THEN - ALLOCATE(DstInitTypeData%NodesConnN(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%NodesConnN.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%NodesConnN = SrcInitTypeData%NodesConnN -ENDIF -IF (ALLOCATED(SrcInitTypeData%NodesConnE)) THEN - i1_l = LBOUND(SrcInitTypeData%NodesConnE,1) - i1_u = UBOUND(SrcInitTypeData%NodesConnE,1) - i2_l = LBOUND(SrcInitTypeData%NodesConnE,2) - i2_u = UBOUND(SrcInitTypeData%NodesConnE,2) - IF (.NOT. ALLOCATED(DstInitTypeData%NodesConnE)) THEN - ALLOCATE(DstInitTypeData%NodesConnE(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%NodesConnE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitTypeData%NodesConnE = SrcInitTypeData%NodesConnE -ENDIF - DstInitTypeData%SSSum = SrcInitTypeData%SSSum - END SUBROUTINE SD_CopyInitType - - SUBROUTINE SD_DestroyInitType( InitTypeData, ErrStat, ErrMsg ) - TYPE(SD_InitType), INTENT(INOUT) :: InitTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyInitType' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(InitTypeData%Joints)) THEN - DEALLOCATE(InitTypeData%Joints) -ENDIF -IF (ALLOCATED(InitTypeData%PropSetsB)) THEN - DEALLOCATE(InitTypeData%PropSetsB) -ENDIF -IF (ALLOCATED(InitTypeData%PropSetsC)) THEN - DEALLOCATE(InitTypeData%PropSetsC) -ENDIF -IF (ALLOCATED(InitTypeData%PropSetsR)) THEN - DEALLOCATE(InitTypeData%PropSetsR) -ENDIF -IF (ALLOCATED(InitTypeData%PropSetsX)) THEN - DEALLOCATE(InitTypeData%PropSetsX) -ENDIF -IF (ALLOCATED(InitTypeData%COSMs)) THEN - DEALLOCATE(InitTypeData%COSMs) -ENDIF -IF (ALLOCATED(InitTypeData%CMass)) THEN - DEALLOCATE(InitTypeData%CMass) -ENDIF -IF (ALLOCATED(InitTypeData%JDampings)) THEN - DEALLOCATE(InitTypeData%JDampings) -ENDIF -IF (ALLOCATED(InitTypeData%Members)) THEN - DEALLOCATE(InitTypeData%Members) -ENDIF -IF (ALLOCATED(InitTypeData%SSOutList)) THEN - DEALLOCATE(InitTypeData%SSOutList) -ENDIF -IF (ALLOCATED(InitTypeData%SSIK)) THEN - DEALLOCATE(InitTypeData%SSIK) -ENDIF -IF (ALLOCATED(InitTypeData%SSIM)) THEN - DEALLOCATE(InitTypeData%SSIM) -ENDIF -IF (ALLOCATED(InitTypeData%SSIfile)) THEN - DEALLOCATE(InitTypeData%SSIfile) -ENDIF -IF (ALLOCATED(InitTypeData%Soil_K)) THEN - DEALLOCATE(InitTypeData%Soil_K) -ENDIF -IF (ALLOCATED(InitTypeData%Soil_Points)) THEN - DEALLOCATE(InitTypeData%Soil_Points) -ENDIF -IF (ALLOCATED(InitTypeData%Soil_Nodes)) THEN - DEALLOCATE(InitTypeData%Soil_Nodes) -ENDIF -IF (ALLOCATED(InitTypeData%Nodes)) THEN - DEALLOCATE(InitTypeData%Nodes) -ENDIF -IF (ALLOCATED(InitTypeData%PropsB)) THEN - DEALLOCATE(InitTypeData%PropsB) -ENDIF -IF (ALLOCATED(InitTypeData%PropsC)) THEN - DEALLOCATE(InitTypeData%PropsC) -ENDIF -IF (ALLOCATED(InitTypeData%PropsR)) THEN - DEALLOCATE(InitTypeData%PropsR) -ENDIF -IF (ALLOCATED(InitTypeData%K)) THEN - DEALLOCATE(InitTypeData%K) -ENDIF -IF (ALLOCATED(InitTypeData%M)) THEN - DEALLOCATE(InitTypeData%M) -ENDIF -IF (ALLOCATED(InitTypeData%ElemProps)) THEN - DEALLOCATE(InitTypeData%ElemProps) -ENDIF -IF (ALLOCATED(InitTypeData%MemberNodes)) THEN - DEALLOCATE(InitTypeData%MemberNodes) -ENDIF -IF (ALLOCATED(InitTypeData%NodesConnN)) THEN - DEALLOCATE(InitTypeData%NodesConnN) -ENDIF -IF (ALLOCATED(InitTypeData%NodesConnE)) THEN - DEALLOCATE(InitTypeData%NodesConnE) -ENDIF - END SUBROUTINE SD_DestroyInitType +subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, ErrMsg) + type(SD_InitType), intent(in) :: SrcInitTypeData + type(SD_InitType), intent(inout) :: DstInitTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SD_CopyInitType' + ErrStat = ErrID_None + ErrMsg = '' + DstInitTypeData%RootName = SrcInitTypeData%RootName + DstInitTypeData%TP_RefPoint = SrcInitTypeData%TP_RefPoint + DstInitTypeData%SubRotateZ = SrcInitTypeData%SubRotateZ + DstInitTypeData%g = SrcInitTypeData%g + DstInitTypeData%DT = SrcInitTypeData%DT + DstInitTypeData%NJoints = SrcInitTypeData%NJoints + DstInitTypeData%NPropSetsX = SrcInitTypeData%NPropSetsX + DstInitTypeData%NPropSetsB = SrcInitTypeData%NPropSetsB + DstInitTypeData%NPropSetsC = SrcInitTypeData%NPropSetsC + DstInitTypeData%NPropSetsR = SrcInitTypeData%NPropSetsR + DstInitTypeData%NCMass = SrcInitTypeData%NCMass + DstInitTypeData%NCOSMs = SrcInitTypeData%NCOSMs + DstInitTypeData%FEMMod = SrcInitTypeData%FEMMod + DstInitTypeData%NDiv = SrcInitTypeData%NDiv + DstInitTypeData%CBMod = SrcInitTypeData%CBMod + if (allocated(SrcInitTypeData%Joints)) then + LB(1:2) = lbound(SrcInitTypeData%Joints) + UB(1:2) = ubound(SrcInitTypeData%Joints) + if (.not. allocated(DstInitTypeData%Joints)) then + allocate(DstInitTypeData%Joints(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%Joints.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%Joints = SrcInitTypeData%Joints + else if (allocated(DstInitTypeData%Joints)) then + deallocate(DstInitTypeData%Joints) + end if + if (allocated(SrcInitTypeData%PropSetsB)) then + LB(1:2) = lbound(SrcInitTypeData%PropSetsB) + UB(1:2) = ubound(SrcInitTypeData%PropSetsB) + if (.not. allocated(DstInitTypeData%PropSetsB)) then + allocate(DstInitTypeData%PropSetsB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropSetsB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%PropSetsB = SrcInitTypeData%PropSetsB + else if (allocated(DstInitTypeData%PropSetsB)) then + deallocate(DstInitTypeData%PropSetsB) + end if + if (allocated(SrcInitTypeData%PropSetsC)) then + LB(1:2) = lbound(SrcInitTypeData%PropSetsC) + UB(1:2) = ubound(SrcInitTypeData%PropSetsC) + if (.not. allocated(DstInitTypeData%PropSetsC)) then + allocate(DstInitTypeData%PropSetsC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropSetsC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%PropSetsC = SrcInitTypeData%PropSetsC + else if (allocated(DstInitTypeData%PropSetsC)) then + deallocate(DstInitTypeData%PropSetsC) + end if + if (allocated(SrcInitTypeData%PropSetsR)) then + LB(1:2) = lbound(SrcInitTypeData%PropSetsR) + UB(1:2) = ubound(SrcInitTypeData%PropSetsR) + if (.not. allocated(DstInitTypeData%PropSetsR)) then + allocate(DstInitTypeData%PropSetsR(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropSetsR.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%PropSetsR = SrcInitTypeData%PropSetsR + else if (allocated(DstInitTypeData%PropSetsR)) then + deallocate(DstInitTypeData%PropSetsR) + end if + if (allocated(SrcInitTypeData%PropSetsX)) then + LB(1:2) = lbound(SrcInitTypeData%PropSetsX) + UB(1:2) = ubound(SrcInitTypeData%PropSetsX) + if (.not. allocated(DstInitTypeData%PropSetsX)) then + allocate(DstInitTypeData%PropSetsX(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropSetsX.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%PropSetsX = SrcInitTypeData%PropSetsX + else if (allocated(DstInitTypeData%PropSetsX)) then + deallocate(DstInitTypeData%PropSetsX) + end if + if (allocated(SrcInitTypeData%COSMs)) then + LB(1:2) = lbound(SrcInitTypeData%COSMs) + UB(1:2) = ubound(SrcInitTypeData%COSMs) + if (.not. allocated(DstInitTypeData%COSMs)) then + allocate(DstInitTypeData%COSMs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%COSMs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%COSMs = SrcInitTypeData%COSMs + else if (allocated(DstInitTypeData%COSMs)) then + deallocate(DstInitTypeData%COSMs) + end if + if (allocated(SrcInitTypeData%CMass)) then + LB(1:2) = lbound(SrcInitTypeData%CMass) + UB(1:2) = ubound(SrcInitTypeData%CMass) + if (.not. allocated(DstInitTypeData%CMass)) then + allocate(DstInitTypeData%CMass(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%CMass.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%CMass = SrcInitTypeData%CMass + else if (allocated(DstInitTypeData%CMass)) then + deallocate(DstInitTypeData%CMass) + end if + if (allocated(SrcInitTypeData%JDampings)) then + LB(1:1) = lbound(SrcInitTypeData%JDampings) + UB(1:1) = ubound(SrcInitTypeData%JDampings) + if (.not. allocated(DstInitTypeData%JDampings)) then + allocate(DstInitTypeData%JDampings(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%JDampings.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%JDampings = SrcInitTypeData%JDampings + else if (allocated(DstInitTypeData%JDampings)) then + deallocate(DstInitTypeData%JDampings) + end if + DstInitTypeData%GuyanDampMod = SrcInitTypeData%GuyanDampMod + DstInitTypeData%RayleighDamp = SrcInitTypeData%RayleighDamp + DstInitTypeData%GuyanDampMat = SrcInitTypeData%GuyanDampMat + if (allocated(SrcInitTypeData%Members)) then + LB(1:2) = lbound(SrcInitTypeData%Members) + UB(1:2) = ubound(SrcInitTypeData%Members) + if (.not. allocated(DstInitTypeData%Members)) then + allocate(DstInitTypeData%Members(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%Members.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%Members = SrcInitTypeData%Members + else if (allocated(DstInitTypeData%Members)) then + deallocate(DstInitTypeData%Members) + end if + if (allocated(SrcInitTypeData%SSOutList)) then + LB(1:1) = lbound(SrcInitTypeData%SSOutList) + UB(1:1) = ubound(SrcInitTypeData%SSOutList) + if (.not. allocated(DstInitTypeData%SSOutList)) then + allocate(DstInitTypeData%SSOutList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%SSOutList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%SSOutList = SrcInitTypeData%SSOutList + else if (allocated(DstInitTypeData%SSOutList)) then + deallocate(DstInitTypeData%SSOutList) + end if + DstInitTypeData%OutCOSM = SrcInitTypeData%OutCOSM + DstInitTypeData%TabDelim = SrcInitTypeData%TabDelim + if (allocated(SrcInitTypeData%SSIK)) then + LB(1:2) = lbound(SrcInitTypeData%SSIK) + UB(1:2) = ubound(SrcInitTypeData%SSIK) + if (.not. allocated(DstInitTypeData%SSIK)) then + allocate(DstInitTypeData%SSIK(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%SSIK.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%SSIK = SrcInitTypeData%SSIK + else if (allocated(DstInitTypeData%SSIK)) then + deallocate(DstInitTypeData%SSIK) + end if + if (allocated(SrcInitTypeData%SSIM)) then + LB(1:2) = lbound(SrcInitTypeData%SSIM) + UB(1:2) = ubound(SrcInitTypeData%SSIM) + if (.not. allocated(DstInitTypeData%SSIM)) then + allocate(DstInitTypeData%SSIM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%SSIM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%SSIM = SrcInitTypeData%SSIM + else if (allocated(DstInitTypeData%SSIM)) then + deallocate(DstInitTypeData%SSIM) + end if + if (allocated(SrcInitTypeData%SSIfile)) then + LB(1:1) = lbound(SrcInitTypeData%SSIfile) + UB(1:1) = ubound(SrcInitTypeData%SSIfile) + if (.not. allocated(DstInitTypeData%SSIfile)) then + allocate(DstInitTypeData%SSIfile(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%SSIfile.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%SSIfile = SrcInitTypeData%SSIfile + else if (allocated(DstInitTypeData%SSIfile)) then + deallocate(DstInitTypeData%SSIfile) + end if + if (allocated(SrcInitTypeData%Soil_K)) then + LB(1:3) = lbound(SrcInitTypeData%Soil_K) + UB(1:3) = ubound(SrcInitTypeData%Soil_K) + if (.not. allocated(DstInitTypeData%Soil_K)) then + allocate(DstInitTypeData%Soil_K(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%Soil_K.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%Soil_K = SrcInitTypeData%Soil_K + else if (allocated(DstInitTypeData%Soil_K)) then + deallocate(DstInitTypeData%Soil_K) + end if + if (allocated(SrcInitTypeData%Soil_Points)) then + LB(1:2) = lbound(SrcInitTypeData%Soil_Points) + UB(1:2) = ubound(SrcInitTypeData%Soil_Points) + if (.not. allocated(DstInitTypeData%Soil_Points)) then + allocate(DstInitTypeData%Soil_Points(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%Soil_Points.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%Soil_Points = SrcInitTypeData%Soil_Points + else if (allocated(DstInitTypeData%Soil_Points)) then + deallocate(DstInitTypeData%Soil_Points) + end if + if (allocated(SrcInitTypeData%Soil_Nodes)) then + LB(1:1) = lbound(SrcInitTypeData%Soil_Nodes) + UB(1:1) = ubound(SrcInitTypeData%Soil_Nodes) + if (.not. allocated(DstInitTypeData%Soil_Nodes)) then + allocate(DstInitTypeData%Soil_Nodes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%Soil_Nodes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%Soil_Nodes = SrcInitTypeData%Soil_Nodes + else if (allocated(DstInitTypeData%Soil_Nodes)) then + deallocate(DstInitTypeData%Soil_Nodes) + end if + DstInitTypeData%NElem = SrcInitTypeData%NElem + DstInitTypeData%NPropB = SrcInitTypeData%NPropB + DstInitTypeData%NPropC = SrcInitTypeData%NPropC + DstInitTypeData%NPropR = SrcInitTypeData%NPropR + if (allocated(SrcInitTypeData%Nodes)) then + LB(1:2) = lbound(SrcInitTypeData%Nodes) + UB(1:2) = ubound(SrcInitTypeData%Nodes) + if (.not. allocated(DstInitTypeData%Nodes)) then + allocate(DstInitTypeData%Nodes(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%Nodes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%Nodes = SrcInitTypeData%Nodes + else if (allocated(DstInitTypeData%Nodes)) then + deallocate(DstInitTypeData%Nodes) + end if + if (allocated(SrcInitTypeData%PropsB)) then + LB(1:2) = lbound(SrcInitTypeData%PropsB) + UB(1:2) = ubound(SrcInitTypeData%PropsB) + if (.not. allocated(DstInitTypeData%PropsB)) then + allocate(DstInitTypeData%PropsB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropsB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%PropsB = SrcInitTypeData%PropsB + else if (allocated(DstInitTypeData%PropsB)) then + deallocate(DstInitTypeData%PropsB) + end if + if (allocated(SrcInitTypeData%PropsC)) then + LB(1:2) = lbound(SrcInitTypeData%PropsC) + UB(1:2) = ubound(SrcInitTypeData%PropsC) + if (.not. allocated(DstInitTypeData%PropsC)) then + allocate(DstInitTypeData%PropsC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropsC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%PropsC = SrcInitTypeData%PropsC + else if (allocated(DstInitTypeData%PropsC)) then + deallocate(DstInitTypeData%PropsC) + end if + if (allocated(SrcInitTypeData%PropsR)) then + LB(1:2) = lbound(SrcInitTypeData%PropsR) + UB(1:2) = ubound(SrcInitTypeData%PropsR) + if (.not. allocated(DstInitTypeData%PropsR)) then + allocate(DstInitTypeData%PropsR(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%PropsR.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%PropsR = SrcInitTypeData%PropsR + else if (allocated(DstInitTypeData%PropsR)) then + deallocate(DstInitTypeData%PropsR) + end if + if (allocated(SrcInitTypeData%K)) then + LB(1:2) = lbound(SrcInitTypeData%K) + UB(1:2) = ubound(SrcInitTypeData%K) + if (.not. allocated(DstInitTypeData%K)) then + allocate(DstInitTypeData%K(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%K.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%K = SrcInitTypeData%K + else if (allocated(DstInitTypeData%K)) then + deallocate(DstInitTypeData%K) + end if + if (allocated(SrcInitTypeData%M)) then + LB(1:2) = lbound(SrcInitTypeData%M) + UB(1:2) = ubound(SrcInitTypeData%M) + if (.not. allocated(DstInitTypeData%M)) then + allocate(DstInitTypeData%M(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%M.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%M = SrcInitTypeData%M + else if (allocated(DstInitTypeData%M)) then + deallocate(DstInitTypeData%M) + end if + if (allocated(SrcInitTypeData%ElemProps)) then + LB(1:2) = lbound(SrcInitTypeData%ElemProps) + UB(1:2) = ubound(SrcInitTypeData%ElemProps) + if (.not. allocated(DstInitTypeData%ElemProps)) then + allocate(DstInitTypeData%ElemProps(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%ElemProps.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%ElemProps = SrcInitTypeData%ElemProps + else if (allocated(DstInitTypeData%ElemProps)) then + deallocate(DstInitTypeData%ElemProps) + end if + if (allocated(SrcInitTypeData%MemberNodes)) then + LB(1:2) = lbound(SrcInitTypeData%MemberNodes) + UB(1:2) = ubound(SrcInitTypeData%MemberNodes) + if (.not. allocated(DstInitTypeData%MemberNodes)) then + allocate(DstInitTypeData%MemberNodes(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%MemberNodes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%MemberNodes = SrcInitTypeData%MemberNodes + else if (allocated(DstInitTypeData%MemberNodes)) then + deallocate(DstInitTypeData%MemberNodes) + end if + if (allocated(SrcInitTypeData%NodesConnN)) then + LB(1:2) = lbound(SrcInitTypeData%NodesConnN) + UB(1:2) = ubound(SrcInitTypeData%NodesConnN) + if (.not. allocated(DstInitTypeData%NodesConnN)) then + allocate(DstInitTypeData%NodesConnN(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%NodesConnN.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%NodesConnN = SrcInitTypeData%NodesConnN + else if (allocated(DstInitTypeData%NodesConnN)) then + deallocate(DstInitTypeData%NodesConnN) + end if + if (allocated(SrcInitTypeData%NodesConnE)) then + LB(1:2) = lbound(SrcInitTypeData%NodesConnE) + UB(1:2) = ubound(SrcInitTypeData%NodesConnE) + if (.not. allocated(DstInitTypeData%NodesConnE)) then + allocate(DstInitTypeData%NodesConnE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitTypeData%NodesConnE.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitTypeData%NodesConnE = SrcInitTypeData%NodesConnE + else if (allocated(DstInitTypeData%NodesConnE)) then + deallocate(DstInitTypeData%NodesConnE) + end if + DstInitTypeData%SSSum = SrcInitTypeData%SSSum +end subroutine +subroutine SD_DestroyInitType(InitTypeData, ErrStat, ErrMsg) + type(SD_InitType), intent(inout) :: InitTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SD_DestroyInitType' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitTypeData%Joints)) then + deallocate(InitTypeData%Joints) + end if + if (allocated(InitTypeData%PropSetsB)) then + deallocate(InitTypeData%PropSetsB) + end if + if (allocated(InitTypeData%PropSetsC)) then + deallocate(InitTypeData%PropSetsC) + end if + if (allocated(InitTypeData%PropSetsR)) then + deallocate(InitTypeData%PropSetsR) + end if + if (allocated(InitTypeData%PropSetsX)) then + deallocate(InitTypeData%PropSetsX) + end if + if (allocated(InitTypeData%COSMs)) then + deallocate(InitTypeData%COSMs) + end if + if (allocated(InitTypeData%CMass)) then + deallocate(InitTypeData%CMass) + end if + if (allocated(InitTypeData%JDampings)) then + deallocate(InitTypeData%JDampings) + end if + if (allocated(InitTypeData%Members)) then + deallocate(InitTypeData%Members) + end if + if (allocated(InitTypeData%SSOutList)) then + deallocate(InitTypeData%SSOutList) + end if + if (allocated(InitTypeData%SSIK)) then + deallocate(InitTypeData%SSIK) + end if + if (allocated(InitTypeData%SSIM)) then + deallocate(InitTypeData%SSIM) + end if + if (allocated(InitTypeData%SSIfile)) then + deallocate(InitTypeData%SSIfile) + end if + if (allocated(InitTypeData%Soil_K)) then + deallocate(InitTypeData%Soil_K) + end if + if (allocated(InitTypeData%Soil_Points)) then + deallocate(InitTypeData%Soil_Points) + end if + if (allocated(InitTypeData%Soil_Nodes)) then + deallocate(InitTypeData%Soil_Nodes) + end if + if (allocated(InitTypeData%Nodes)) then + deallocate(InitTypeData%Nodes) + end if + if (allocated(InitTypeData%PropsB)) then + deallocate(InitTypeData%PropsB) + end if + if (allocated(InitTypeData%PropsC)) then + deallocate(InitTypeData%PropsC) + end if + if (allocated(InitTypeData%PropsR)) then + deallocate(InitTypeData%PropsR) + end if + if (allocated(InitTypeData%K)) then + deallocate(InitTypeData%K) + end if + if (allocated(InitTypeData%M)) then + deallocate(InitTypeData%M) + end if + if (allocated(InitTypeData%ElemProps)) then + deallocate(InitTypeData%ElemProps) + end if + if (allocated(InitTypeData%MemberNodes)) then + deallocate(InitTypeData%MemberNodes) + end if + if (allocated(InitTypeData%NodesConnN)) then + deallocate(InitTypeData%NodesConnN) + end if + if (allocated(InitTypeData%NodesConnE)) then + deallocate(InitTypeData%NodesConnE) + end if +end subroutine subroutine SD_PackInitType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SD_InitType), intent(in) :: InData character(*), parameter :: RoutineName = 'SD_PackInitType' if (Buf%ErrStat >= AbortErrLev) return - ! RootName call RegPack(Buf, InData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! TP_RefPoint call RegPack(Buf, InData%TP_RefPoint) if (RegCheckErr(Buf, RoutineName)) return - ! SubRotateZ call RegPack(Buf, InData%SubRotateZ) if (RegCheckErr(Buf, RoutineName)) return - ! g call RegPack(Buf, InData%g) if (RegCheckErr(Buf, RoutineName)) return - ! DT call RegPack(Buf, InData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! NJoints call RegPack(Buf, InData%NJoints) if (RegCheckErr(Buf, RoutineName)) return - ! NPropSetsX call RegPack(Buf, InData%NPropSetsX) if (RegCheckErr(Buf, RoutineName)) return - ! NPropSetsB call RegPack(Buf, InData%NPropSetsB) if (RegCheckErr(Buf, RoutineName)) return - ! NPropSetsC call RegPack(Buf, InData%NPropSetsC) if (RegCheckErr(Buf, RoutineName)) return - ! NPropSetsR call RegPack(Buf, InData%NPropSetsR) if (RegCheckErr(Buf, RoutineName)) return - ! NCMass call RegPack(Buf, InData%NCMass) if (RegCheckErr(Buf, RoutineName)) return - ! NCOSMs call RegPack(Buf, InData%NCOSMs) if (RegCheckErr(Buf, RoutineName)) return - ! FEMMod call RegPack(Buf, InData%FEMMod) if (RegCheckErr(Buf, RoutineName)) return - ! NDiv call RegPack(Buf, InData%NDiv) if (RegCheckErr(Buf, RoutineName)) return - ! CBMod call RegPack(Buf, InData%CBMod) if (RegCheckErr(Buf, RoutineName)) return - ! Joints call RegPack(Buf, allocated(InData%Joints)) if (allocated(InData%Joints)) then call RegPackBounds(Buf, 2, lbound(InData%Joints), ubound(InData%Joints)) call RegPack(Buf, InData%Joints) end if if (RegCheckErr(Buf, RoutineName)) return - ! PropSetsB call RegPack(Buf, allocated(InData%PropSetsB)) if (allocated(InData%PropSetsB)) then call RegPackBounds(Buf, 2, lbound(InData%PropSetsB), ubound(InData%PropSetsB)) call RegPack(Buf, InData%PropSetsB) end if if (RegCheckErr(Buf, RoutineName)) return - ! PropSetsC call RegPack(Buf, allocated(InData%PropSetsC)) if (allocated(InData%PropSetsC)) then call RegPackBounds(Buf, 2, lbound(InData%PropSetsC), ubound(InData%PropSetsC)) call RegPack(Buf, InData%PropSetsC) end if if (RegCheckErr(Buf, RoutineName)) return - ! PropSetsR call RegPack(Buf, allocated(InData%PropSetsR)) if (allocated(InData%PropSetsR)) then call RegPackBounds(Buf, 2, lbound(InData%PropSetsR), ubound(InData%PropSetsR)) call RegPack(Buf, InData%PropSetsR) end if if (RegCheckErr(Buf, RoutineName)) return - ! PropSetsX call RegPack(Buf, allocated(InData%PropSetsX)) if (allocated(InData%PropSetsX)) then call RegPackBounds(Buf, 2, lbound(InData%PropSetsX), ubound(InData%PropSetsX)) call RegPack(Buf, InData%PropSetsX) end if if (RegCheckErr(Buf, RoutineName)) return - ! COSMs call RegPack(Buf, allocated(InData%COSMs)) if (allocated(InData%COSMs)) then call RegPackBounds(Buf, 2, lbound(InData%COSMs), ubound(InData%COSMs)) call RegPack(Buf, InData%COSMs) end if if (RegCheckErr(Buf, RoutineName)) return - ! CMass call RegPack(Buf, allocated(InData%CMass)) if (allocated(InData%CMass)) then call RegPackBounds(Buf, 2, lbound(InData%CMass), ubound(InData%CMass)) call RegPack(Buf, InData%CMass) end if if (RegCheckErr(Buf, RoutineName)) return - ! JDampings call RegPack(Buf, allocated(InData%JDampings)) if (allocated(InData%JDampings)) then call RegPackBounds(Buf, 1, lbound(InData%JDampings), ubound(InData%JDampings)) call RegPack(Buf, InData%JDampings) end if if (RegCheckErr(Buf, RoutineName)) return - ! GuyanDampMod call RegPack(Buf, InData%GuyanDampMod) if (RegCheckErr(Buf, RoutineName)) return - ! RayleighDamp call RegPack(Buf, InData%RayleighDamp) if (RegCheckErr(Buf, RoutineName)) return - ! GuyanDampMat call RegPack(Buf, InData%GuyanDampMat) if (RegCheckErr(Buf, RoutineName)) return - ! Members call RegPack(Buf, allocated(InData%Members)) if (allocated(InData%Members)) then call RegPackBounds(Buf, 2, lbound(InData%Members), ubound(InData%Members)) call RegPack(Buf, InData%Members) end if if (RegCheckErr(Buf, RoutineName)) return - ! SSOutList call RegPack(Buf, allocated(InData%SSOutList)) if (allocated(InData%SSOutList)) then call RegPackBounds(Buf, 1, lbound(InData%SSOutList), ubound(InData%SSOutList)) call RegPack(Buf, InData%SSOutList) end if if (RegCheckErr(Buf, RoutineName)) return - ! OutCOSM call RegPack(Buf, InData%OutCOSM) if (RegCheckErr(Buf, RoutineName)) return - ! TabDelim call RegPack(Buf, InData%TabDelim) if (RegCheckErr(Buf, RoutineName)) return - ! SSIK call RegPack(Buf, allocated(InData%SSIK)) if (allocated(InData%SSIK)) then call RegPackBounds(Buf, 2, lbound(InData%SSIK), ubound(InData%SSIK)) call RegPack(Buf, InData%SSIK) end if if (RegCheckErr(Buf, RoutineName)) return - ! SSIM call RegPack(Buf, allocated(InData%SSIM)) if (allocated(InData%SSIM)) then call RegPackBounds(Buf, 2, lbound(InData%SSIM), ubound(InData%SSIM)) call RegPack(Buf, InData%SSIM) end if if (RegCheckErr(Buf, RoutineName)) return - ! SSIfile call RegPack(Buf, allocated(InData%SSIfile)) if (allocated(InData%SSIfile)) then call RegPackBounds(Buf, 1, lbound(InData%SSIfile), ubound(InData%SSIfile)) call RegPack(Buf, InData%SSIfile) end if if (RegCheckErr(Buf, RoutineName)) return - ! Soil_K call RegPack(Buf, allocated(InData%Soil_K)) if (allocated(InData%Soil_K)) then call RegPackBounds(Buf, 3, lbound(InData%Soil_K), ubound(InData%Soil_K)) call RegPack(Buf, InData%Soil_K) end if if (RegCheckErr(Buf, RoutineName)) return - ! Soil_Points call RegPack(Buf, allocated(InData%Soil_Points)) if (allocated(InData%Soil_Points)) then call RegPackBounds(Buf, 2, lbound(InData%Soil_Points), ubound(InData%Soil_Points)) call RegPack(Buf, InData%Soil_Points) end if if (RegCheckErr(Buf, RoutineName)) return - ! Soil_Nodes call RegPack(Buf, allocated(InData%Soil_Nodes)) if (allocated(InData%Soil_Nodes)) then call RegPackBounds(Buf, 1, lbound(InData%Soil_Nodes), ubound(InData%Soil_Nodes)) call RegPack(Buf, InData%Soil_Nodes) end if if (RegCheckErr(Buf, RoutineName)) return - ! NElem call RegPack(Buf, InData%NElem) if (RegCheckErr(Buf, RoutineName)) return - ! NPropB call RegPack(Buf, InData%NPropB) if (RegCheckErr(Buf, RoutineName)) return - ! NPropC call RegPack(Buf, InData%NPropC) if (RegCheckErr(Buf, RoutineName)) return - ! NPropR call RegPack(Buf, InData%NPropR) if (RegCheckErr(Buf, RoutineName)) return - ! Nodes call RegPack(Buf, allocated(InData%Nodes)) if (allocated(InData%Nodes)) then call RegPackBounds(Buf, 2, lbound(InData%Nodes), ubound(InData%Nodes)) call RegPack(Buf, InData%Nodes) end if if (RegCheckErr(Buf, RoutineName)) return - ! PropsB call RegPack(Buf, allocated(InData%PropsB)) if (allocated(InData%PropsB)) then call RegPackBounds(Buf, 2, lbound(InData%PropsB), ubound(InData%PropsB)) call RegPack(Buf, InData%PropsB) end if if (RegCheckErr(Buf, RoutineName)) return - ! PropsC call RegPack(Buf, allocated(InData%PropsC)) if (allocated(InData%PropsC)) then call RegPackBounds(Buf, 2, lbound(InData%PropsC), ubound(InData%PropsC)) call RegPack(Buf, InData%PropsC) end if if (RegCheckErr(Buf, RoutineName)) return - ! PropsR call RegPack(Buf, allocated(InData%PropsR)) if (allocated(InData%PropsR)) then call RegPackBounds(Buf, 2, lbound(InData%PropsR), ubound(InData%PropsR)) call RegPack(Buf, InData%PropsR) end if if (RegCheckErr(Buf, RoutineName)) return - ! K call RegPack(Buf, allocated(InData%K)) if (allocated(InData%K)) then call RegPackBounds(Buf, 2, lbound(InData%K), ubound(InData%K)) call RegPack(Buf, InData%K) end if if (RegCheckErr(Buf, RoutineName)) return - ! M call RegPack(Buf, allocated(InData%M)) if (allocated(InData%M)) then call RegPackBounds(Buf, 2, lbound(InData%M), ubound(InData%M)) call RegPack(Buf, InData%M) end if if (RegCheckErr(Buf, RoutineName)) return - ! ElemProps call RegPack(Buf, allocated(InData%ElemProps)) if (allocated(InData%ElemProps)) then call RegPackBounds(Buf, 2, lbound(InData%ElemProps), ubound(InData%ElemProps)) call RegPack(Buf, InData%ElemProps) end if if (RegCheckErr(Buf, RoutineName)) return - ! MemberNodes call RegPack(Buf, allocated(InData%MemberNodes)) if (allocated(InData%MemberNodes)) then call RegPackBounds(Buf, 2, lbound(InData%MemberNodes), ubound(InData%MemberNodes)) call RegPack(Buf, InData%MemberNodes) end if if (RegCheckErr(Buf, RoutineName)) return - ! NodesConnN call RegPack(Buf, allocated(InData%NodesConnN)) if (allocated(InData%NodesConnN)) then call RegPackBounds(Buf, 2, lbound(InData%NodesConnN), ubound(InData%NodesConnN)) call RegPack(Buf, InData%NodesConnN) end if if (RegCheckErr(Buf, RoutineName)) return - ! NodesConnE call RegPack(Buf, allocated(InData%NodesConnE)) if (allocated(InData%NodesConnE)) then call RegPackBounds(Buf, 2, lbound(InData%NodesConnE), ubound(InData%NodesConnE)) call RegPack(Buf, InData%NodesConnE) end if if (RegCheckErr(Buf, RoutineName)) return - ! SSSum call RegPack(Buf, InData%SSSum) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2592,52 +2382,36 @@ subroutine SD_UnPackInitType(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! RootName call RegUnpack(Buf, OutData%RootName) if (RegCheckErr(Buf, RoutineName)) return - ! TP_RefPoint call RegUnpack(Buf, OutData%TP_RefPoint) if (RegCheckErr(Buf, RoutineName)) return - ! SubRotateZ call RegUnpack(Buf, OutData%SubRotateZ) if (RegCheckErr(Buf, RoutineName)) return - ! g call RegUnpack(Buf, OutData%g) if (RegCheckErr(Buf, RoutineName)) return - ! DT call RegUnpack(Buf, OutData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! NJoints call RegUnpack(Buf, OutData%NJoints) if (RegCheckErr(Buf, RoutineName)) return - ! NPropSetsX call RegUnpack(Buf, OutData%NPropSetsX) if (RegCheckErr(Buf, RoutineName)) return - ! NPropSetsB call RegUnpack(Buf, OutData%NPropSetsB) if (RegCheckErr(Buf, RoutineName)) return - ! NPropSetsC call RegUnpack(Buf, OutData%NPropSetsC) if (RegCheckErr(Buf, RoutineName)) return - ! NPropSetsR call RegUnpack(Buf, OutData%NPropSetsR) if (RegCheckErr(Buf, RoutineName)) return - ! NCMass call RegUnpack(Buf, OutData%NCMass) if (RegCheckErr(Buf, RoutineName)) return - ! NCOSMs call RegUnpack(Buf, OutData%NCOSMs) if (RegCheckErr(Buf, RoutineName)) return - ! FEMMod call RegUnpack(Buf, OutData%FEMMod) if (RegCheckErr(Buf, RoutineName)) return - ! NDiv call RegUnpack(Buf, OutData%NDiv) if (RegCheckErr(Buf, RoutineName)) return - ! CBMod call RegUnpack(Buf, OutData%CBMod) if (RegCheckErr(Buf, RoutineName)) return - ! Joints if (allocated(OutData%Joints)) deallocate(OutData%Joints) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2652,7 +2426,6 @@ subroutine SD_UnPackInitType(Buf, OutData) call RegUnpack(Buf, OutData%Joints) if (RegCheckErr(Buf, RoutineName)) return end if - ! PropSetsB if (allocated(OutData%PropSetsB)) deallocate(OutData%PropSetsB) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2667,7 +2440,6 @@ subroutine SD_UnPackInitType(Buf, OutData) call RegUnpack(Buf, OutData%PropSetsB) if (RegCheckErr(Buf, RoutineName)) return end if - ! PropSetsC if (allocated(OutData%PropSetsC)) deallocate(OutData%PropSetsC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2682,7 +2454,6 @@ subroutine SD_UnPackInitType(Buf, OutData) call RegUnpack(Buf, OutData%PropSetsC) if (RegCheckErr(Buf, RoutineName)) return end if - ! PropSetsR if (allocated(OutData%PropSetsR)) deallocate(OutData%PropSetsR) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2697,7 +2468,6 @@ subroutine SD_UnPackInitType(Buf, OutData) call RegUnpack(Buf, OutData%PropSetsR) if (RegCheckErr(Buf, RoutineName)) return end if - ! PropSetsX if (allocated(OutData%PropSetsX)) deallocate(OutData%PropSetsX) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2712,7 +2482,6 @@ subroutine SD_UnPackInitType(Buf, OutData) call RegUnpack(Buf, OutData%PropSetsX) if (RegCheckErr(Buf, RoutineName)) return end if - ! COSMs if (allocated(OutData%COSMs)) deallocate(OutData%COSMs) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2727,7 +2496,6 @@ subroutine SD_UnPackInitType(Buf, OutData) call RegUnpack(Buf, OutData%COSMs) if (RegCheckErr(Buf, RoutineName)) return end if - ! CMass if (allocated(OutData%CMass)) deallocate(OutData%CMass) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2742,7 +2510,6 @@ subroutine SD_UnPackInitType(Buf, OutData) call RegUnpack(Buf, OutData%CMass) if (RegCheckErr(Buf, RoutineName)) return end if - ! JDampings if (allocated(OutData%JDampings)) deallocate(OutData%JDampings) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2757,16 +2524,12 @@ subroutine SD_UnPackInitType(Buf, OutData) call RegUnpack(Buf, OutData%JDampings) if (RegCheckErr(Buf, RoutineName)) return end if - ! GuyanDampMod call RegUnpack(Buf, OutData%GuyanDampMod) if (RegCheckErr(Buf, RoutineName)) return - ! RayleighDamp call RegUnpack(Buf, OutData%RayleighDamp) if (RegCheckErr(Buf, RoutineName)) return - ! GuyanDampMat call RegUnpack(Buf, OutData%GuyanDampMat) if (RegCheckErr(Buf, RoutineName)) return - ! Members if (allocated(OutData%Members)) deallocate(OutData%Members) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2781,7 +2544,6 @@ subroutine SD_UnPackInitType(Buf, OutData) call RegUnpack(Buf, OutData%Members) if (RegCheckErr(Buf, RoutineName)) return end if - ! SSOutList if (allocated(OutData%SSOutList)) deallocate(OutData%SSOutList) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2796,13 +2558,10 @@ subroutine SD_UnPackInitType(Buf, OutData) call RegUnpack(Buf, OutData%SSOutList) if (RegCheckErr(Buf, RoutineName)) return end if - ! OutCOSM call RegUnpack(Buf, OutData%OutCOSM) if (RegCheckErr(Buf, RoutineName)) return - ! TabDelim call RegUnpack(Buf, OutData%TabDelim) if (RegCheckErr(Buf, RoutineName)) return - ! SSIK if (allocated(OutData%SSIK)) deallocate(OutData%SSIK) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2817,7 +2576,6 @@ subroutine SD_UnPackInitType(Buf, OutData) call RegUnpack(Buf, OutData%SSIK) if (RegCheckErr(Buf, RoutineName)) return end if - ! SSIM if (allocated(OutData%SSIM)) deallocate(OutData%SSIM) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2832,7 +2590,6 @@ subroutine SD_UnPackInitType(Buf, OutData) call RegUnpack(Buf, OutData%SSIM) if (RegCheckErr(Buf, RoutineName)) return end if - ! SSIfile if (allocated(OutData%SSIfile)) deallocate(OutData%SSIfile) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2847,7 +2604,6 @@ subroutine SD_UnPackInitType(Buf, OutData) call RegUnpack(Buf, OutData%SSIfile) if (RegCheckErr(Buf, RoutineName)) return end if - ! Soil_K if (allocated(OutData%Soil_K)) deallocate(OutData%Soil_K) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2862,7 +2618,6 @@ subroutine SD_UnPackInitType(Buf, OutData) call RegUnpack(Buf, OutData%Soil_K) if (RegCheckErr(Buf, RoutineName)) return end if - ! Soil_Points if (allocated(OutData%Soil_Points)) deallocate(OutData%Soil_Points) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2877,7 +2632,6 @@ subroutine SD_UnPackInitType(Buf, OutData) call RegUnpack(Buf, OutData%Soil_Points) if (RegCheckErr(Buf, RoutineName)) return end if - ! Soil_Nodes if (allocated(OutData%Soil_Nodes)) deallocate(OutData%Soil_Nodes) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2892,19 +2646,14 @@ subroutine SD_UnPackInitType(Buf, OutData) call RegUnpack(Buf, OutData%Soil_Nodes) if (RegCheckErr(Buf, RoutineName)) return end if - ! NElem call RegUnpack(Buf, OutData%NElem) if (RegCheckErr(Buf, RoutineName)) return - ! NPropB call RegUnpack(Buf, OutData%NPropB) if (RegCheckErr(Buf, RoutineName)) return - ! NPropC call RegUnpack(Buf, OutData%NPropC) if (RegCheckErr(Buf, RoutineName)) return - ! NPropR call RegUnpack(Buf, OutData%NPropR) if (RegCheckErr(Buf, RoutineName)) return - ! Nodes if (allocated(OutData%Nodes)) deallocate(OutData%Nodes) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2919,7 +2668,6 @@ subroutine SD_UnPackInitType(Buf, OutData) call RegUnpack(Buf, OutData%Nodes) if (RegCheckErr(Buf, RoutineName)) return end if - ! PropsB if (allocated(OutData%PropsB)) deallocate(OutData%PropsB) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2934,7 +2682,6 @@ subroutine SD_UnPackInitType(Buf, OutData) call RegUnpack(Buf, OutData%PropsB) if (RegCheckErr(Buf, RoutineName)) return end if - ! PropsC if (allocated(OutData%PropsC)) deallocate(OutData%PropsC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2949,7 +2696,6 @@ subroutine SD_UnPackInitType(Buf, OutData) call RegUnpack(Buf, OutData%PropsC) if (RegCheckErr(Buf, RoutineName)) return end if - ! PropsR if (allocated(OutData%PropsR)) deallocate(OutData%PropsR) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2964,7 +2710,6 @@ subroutine SD_UnPackInitType(Buf, OutData) call RegUnpack(Buf, OutData%PropsR) if (RegCheckErr(Buf, RoutineName)) return end if - ! K if (allocated(OutData%K)) deallocate(OutData%K) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2979,7 +2724,6 @@ subroutine SD_UnPackInitType(Buf, OutData) call RegUnpack(Buf, OutData%K) if (RegCheckErr(Buf, RoutineName)) return end if - ! M if (allocated(OutData%M)) deallocate(OutData%M) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2994,7 +2738,6 @@ subroutine SD_UnPackInitType(Buf, OutData) call RegUnpack(Buf, OutData%M) if (RegCheckErr(Buf, RoutineName)) return end if - ! ElemProps if (allocated(OutData%ElemProps)) deallocate(OutData%ElemProps) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3009,7 +2752,6 @@ subroutine SD_UnPackInitType(Buf, OutData) call RegUnpack(Buf, OutData%ElemProps) if (RegCheckErr(Buf, RoutineName)) return end if - ! MemberNodes if (allocated(OutData%MemberNodes)) deallocate(OutData%MemberNodes) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3024,7 +2766,6 @@ subroutine SD_UnPackInitType(Buf, OutData) call RegUnpack(Buf, OutData%MemberNodes) if (RegCheckErr(Buf, RoutineName)) return end if - ! NodesConnN if (allocated(OutData%NodesConnN)) deallocate(OutData%NodesConnN) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3039,7 +2780,6 @@ subroutine SD_UnPackInitType(Buf, OutData) call RegUnpack(Buf, OutData%NodesConnN) if (RegCheckErr(Buf, RoutineName)) return end if - ! NodesConnE if (allocated(OutData%NodesConnE)) deallocate(OutData%NodesConnE) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3054,86 +2794,77 @@ subroutine SD_UnPackInitType(Buf, OutData) call RegUnpack(Buf, OutData%NodesConnE) if (RegCheckErr(Buf, RoutineName)) return end if - ! SSSum call RegUnpack(Buf, OutData%SSSum) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE SD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SD_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(SD_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcContStateData%qm)) THEN - i1_l = LBOUND(SrcContStateData%qm,1) - i1_u = UBOUND(SrcContStateData%qm,1) - IF (.NOT. ALLOCATED(DstContStateData%qm)) THEN - ALLOCATE(DstContStateData%qm(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%qm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstContStateData%qm = SrcContStateData%qm -ENDIF -IF (ALLOCATED(SrcContStateData%qmdot)) THEN - i1_l = LBOUND(SrcContStateData%qmdot,1) - i1_u = UBOUND(SrcContStateData%qmdot,1) - IF (.NOT. ALLOCATED(DstContStateData%qmdot)) THEN - ALLOCATE(DstContStateData%qmdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%qmdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstContStateData%qmdot = SrcContStateData%qmdot -ENDIF - END SUBROUTINE SD_CopyContState - - SUBROUTINE SD_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(SD_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyContState' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ContStateData%qm)) THEN - DEALLOCATE(ContStateData%qm) -ENDIF -IF (ALLOCATED(ContStateData%qmdot)) THEN - DEALLOCATE(ContStateData%qmdot) -ENDIF - END SUBROUTINE SD_DestroyContState +subroutine SD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(SD_ContinuousStateType), intent(in) :: SrcContStateData + type(SD_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SD_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcContStateData%qm)) then + LB(1:1) = lbound(SrcContStateData%qm) + UB(1:1) = ubound(SrcContStateData%qm) + if (.not. allocated(DstContStateData%qm)) then + allocate(DstContStateData%qm(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%qm.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstContStateData%qm = SrcContStateData%qm + else if (allocated(DstContStateData%qm)) then + deallocate(DstContStateData%qm) + end if + if (allocated(SrcContStateData%qmdot)) then + LB(1:1) = lbound(SrcContStateData%qmdot) + UB(1:1) = ubound(SrcContStateData%qmdot) + if (.not. allocated(DstContStateData%qmdot)) then + allocate(DstContStateData%qmdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%qmdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstContStateData%qmdot = SrcContStateData%qmdot + else if (allocated(DstContStateData%qmdot)) then + deallocate(DstContStateData%qmdot) + end if +end subroutine +subroutine SD_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(SD_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SD_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ContStateData%qm)) then + deallocate(ContStateData%qm) + end if + if (allocated(ContStateData%qmdot)) then + deallocate(ContStateData%qmdot) + end if +end subroutine subroutine SD_PackContState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SD_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SD_PackContState' if (Buf%ErrStat >= AbortErrLev) return - ! qm call RegPack(Buf, allocated(InData%qm)) if (allocated(InData%qm)) then call RegPackBounds(Buf, 1, lbound(InData%qm), ubound(InData%qm)) call RegPack(Buf, InData%qm) end if if (RegCheckErr(Buf, RoutineName)) return - ! qmdot call RegPack(Buf, allocated(InData%qmdot)) if (allocated(InData%qmdot)) then call RegPackBounds(Buf, 1, lbound(InData%qmdot), ubound(InData%qmdot)) @@ -3150,7 +2881,6 @@ subroutine SD_UnPackContState(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! qm if (allocated(OutData%qm)) deallocate(OutData%qm) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3165,7 +2895,6 @@ subroutine SD_UnPackContState(Buf, OutData) call RegUnpack(Buf, OutData%qm) if (RegCheckErr(Buf, RoutineName)) return end if - ! qmdot if (allocated(OutData%qmdot)) deallocate(OutData%qmdot) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3181,45 +2910,33 @@ subroutine SD_UnPackContState(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE SD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SD_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(SD_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState - END SUBROUTINE SD_CopyDiscState - - SUBROUTINE SD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(SD_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE SD_DestroyDiscState +subroutine SD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(SD_DiscreteStateType), intent(in) :: SrcDiscStateData + type(SD_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SD_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState +end subroutine +subroutine SD_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(SD_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SD_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine SD_PackDiscState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SD_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SD_PackDiscState' if (Buf%ErrStat >= AbortErrLev) return - ! DummyDiscState call RegPack(Buf, InData%DummyDiscState) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3229,49 +2946,36 @@ subroutine SD_UnPackDiscState(Buf, OutData) type(SD_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackDiscState' if (Buf%ErrStat /= ErrID_None) return - ! DummyDiscState call RegUnpack(Buf, OutData%DummyDiscState) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE SD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SD_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(SD_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE SD_CopyConstrState - SUBROUTINE SD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(SD_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE SD_DestroyConstrState +subroutine SD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(SD_ConstraintStateType), intent(in) :: SrcConstrStateData + type(SD_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SD_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine +subroutine SD_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(SD_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SD_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine SD_PackConstrState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SD_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SD_PackConstrState' if (Buf%ErrStat >= AbortErrLev) return - ! DummyConstrState call RegPack(Buf, InData%DummyConstrState) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3281,66 +2985,65 @@ subroutine SD_UnPackConstrState(Buf, OutData) type(SD_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackConstrState' if (Buf%ErrStat /= ErrID_None) return - ! DummyConstrState call RegUnpack(Buf, OutData%DummyConstrState) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE SD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SD_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(SD_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOtherStateData%xdot)) THEN - i1_l = LBOUND(SrcOtherStateData%xdot,1) - i1_u = UBOUND(SrcOtherStateData%xdot,1) - IF (.NOT. ALLOCATED(DstOtherStateData%xdot)) THEN - ALLOCATE(DstOtherStateData%xdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%xdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcOtherStateData%xdot,1), UBOUND(SrcOtherStateData%xdot,1) - CALL SD_CopyContState( SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstOtherStateData%n = SrcOtherStateData%n - END SUBROUTINE SD_CopyOtherState - - SUBROUTINE SD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(SD_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(OtherStateData%xdot)) THEN -DO i1 = LBOUND(OtherStateData%xdot,1), UBOUND(OtherStateData%xdot,1) - CALL SD_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(OtherStateData%xdot) -ENDIF - END SUBROUTINE SD_DestroyOtherState +subroutine SD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(SD_OtherStateType), intent(in) :: SrcOtherStateData + type(SD_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SD_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOtherStateData%xdot)) then + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) + if (.not. allocated(DstOtherStateData%xdot)) then + allocate(DstOtherStateData%xdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOtherStateData%xdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SD_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstOtherStateData%xdot)) then + deallocate(DstOtherStateData%xdot) + end if + DstOtherStateData%n = SrcOtherStateData%n +end subroutine +subroutine SD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(SD_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1 + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SD_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OtherStateData%xdot)) then + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) + do i1 = LB(1), UB(1) + call SD_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OtherStateData%xdot) + end if +end subroutine subroutine SD_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -3349,7 +3052,6 @@ subroutine SD_PackOtherState(Buf, Indata) integer(IntKi) :: i1 integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return - ! xdot call RegPack(Buf, allocated(InData%xdot)) if (allocated(InData%xdot)) then call RegPackBounds(Buf, 1, lbound(InData%xdot), ubound(InData%xdot)) @@ -3360,7 +3062,6 @@ subroutine SD_PackOtherState(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! n call RegPack(Buf, InData%n) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3374,7 +3075,6 @@ subroutine SD_UnPackOtherState(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! xdot if (allocated(OutData%xdot)) deallocate(OutData%xdot) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3390,590 +3090,598 @@ subroutine SD_UnPackOtherState(Buf, OutData) call SD_UnpackContState(Buf, OutData%xdot(i1)) ! xdot end do end if - ! n call RegUnpack(Buf, OutData%n) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE SD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SD_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(SD_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscData%qmdotdot)) THEN - i1_l = LBOUND(SrcMiscData%qmdotdot,1) - i1_u = UBOUND(SrcMiscData%qmdotdot,1) - IF (.NOT. ALLOCATED(DstMiscData%qmdotdot)) THEN - ALLOCATE(DstMiscData%qmdotdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%qmdotdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%qmdotdot = SrcMiscData%qmdotdot -ENDIF - DstMiscData%u_TP = SrcMiscData%u_TP - DstMiscData%udot_TP = SrcMiscData%udot_TP - DstMiscData%udotdot_TP = SrcMiscData%udotdot_TP -IF (ALLOCATED(SrcMiscData%F_L)) THEN - i1_l = LBOUND(SrcMiscData%F_L,1) - i1_u = UBOUND(SrcMiscData%F_L,1) - IF (.NOT. ALLOCATED(DstMiscData%F_L)) THEN - ALLOCATE(DstMiscData%F_L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_L = SrcMiscData%F_L -ENDIF -IF (ALLOCATED(SrcMiscData%F_L2)) THEN - i1_l = LBOUND(SrcMiscData%F_L2,1) - i1_u = UBOUND(SrcMiscData%F_L2,1) - IF (.NOT. ALLOCATED(DstMiscData%F_L2)) THEN - ALLOCATE(DstMiscData%F_L2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_L2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_L2 = SrcMiscData%F_L2 -ENDIF -IF (ALLOCATED(SrcMiscData%UR_bar)) THEN - i1_l = LBOUND(SrcMiscData%UR_bar,1) - i1_u = UBOUND(SrcMiscData%UR_bar,1) - IF (.NOT. ALLOCATED(DstMiscData%UR_bar)) THEN - ALLOCATE(DstMiscData%UR_bar(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UR_bar.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%UR_bar = SrcMiscData%UR_bar -ENDIF -IF (ALLOCATED(SrcMiscData%UR_bar_dot)) THEN - i1_l = LBOUND(SrcMiscData%UR_bar_dot,1) - i1_u = UBOUND(SrcMiscData%UR_bar_dot,1) - IF (.NOT. ALLOCATED(DstMiscData%UR_bar_dot)) THEN - ALLOCATE(DstMiscData%UR_bar_dot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UR_bar_dot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%UR_bar_dot = SrcMiscData%UR_bar_dot -ENDIF -IF (ALLOCATED(SrcMiscData%UR_bar_dotdot)) THEN - i1_l = LBOUND(SrcMiscData%UR_bar_dotdot,1) - i1_u = UBOUND(SrcMiscData%UR_bar_dotdot,1) - IF (.NOT. ALLOCATED(DstMiscData%UR_bar_dotdot)) THEN - ALLOCATE(DstMiscData%UR_bar_dotdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UR_bar_dotdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%UR_bar_dotdot = SrcMiscData%UR_bar_dotdot -ENDIF -IF (ALLOCATED(SrcMiscData%UL)) THEN - i1_l = LBOUND(SrcMiscData%UL,1) - i1_u = UBOUND(SrcMiscData%UL,1) - IF (.NOT. ALLOCATED(DstMiscData%UL)) THEN - ALLOCATE(DstMiscData%UL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%UL = SrcMiscData%UL -ENDIF -IF (ALLOCATED(SrcMiscData%UL_NS)) THEN - i1_l = LBOUND(SrcMiscData%UL_NS,1) - i1_u = UBOUND(SrcMiscData%UL_NS,1) - IF (.NOT. ALLOCATED(DstMiscData%UL_NS)) THEN - ALLOCATE(DstMiscData%UL_NS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_NS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%UL_NS = SrcMiscData%UL_NS -ENDIF -IF (ALLOCATED(SrcMiscData%UL_dot)) THEN - i1_l = LBOUND(SrcMiscData%UL_dot,1) - i1_u = UBOUND(SrcMiscData%UL_dot,1) - IF (.NOT. ALLOCATED(DstMiscData%UL_dot)) THEN - ALLOCATE(DstMiscData%UL_dot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_dot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%UL_dot = SrcMiscData%UL_dot -ENDIF -IF (ALLOCATED(SrcMiscData%UL_dotdot)) THEN - i1_l = LBOUND(SrcMiscData%UL_dotdot,1) - i1_u = UBOUND(SrcMiscData%UL_dotdot,1) - IF (.NOT. ALLOCATED(DstMiscData%UL_dotdot)) THEN - ALLOCATE(DstMiscData%UL_dotdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_dotdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%UL_dotdot = SrcMiscData%UL_dotdot -ENDIF -IF (ALLOCATED(SrcMiscData%DU_full)) THEN - i1_l = LBOUND(SrcMiscData%DU_full,1) - i1_u = UBOUND(SrcMiscData%DU_full,1) - IF (.NOT. ALLOCATED(DstMiscData%DU_full)) THEN - ALLOCATE(DstMiscData%DU_full(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%DU_full.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%DU_full = SrcMiscData%DU_full -ENDIF -IF (ALLOCATED(SrcMiscData%U_full)) THEN - i1_l = LBOUND(SrcMiscData%U_full,1) - i1_u = UBOUND(SrcMiscData%U_full,1) - IF (.NOT. ALLOCATED(DstMiscData%U_full)) THEN - ALLOCATE(DstMiscData%U_full(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%U_full = SrcMiscData%U_full -ENDIF -IF (ALLOCATED(SrcMiscData%U_full_NS)) THEN - i1_l = LBOUND(SrcMiscData%U_full_NS,1) - i1_u = UBOUND(SrcMiscData%U_full_NS,1) - IF (.NOT. ALLOCATED(DstMiscData%U_full_NS)) THEN - ALLOCATE(DstMiscData%U_full_NS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_NS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%U_full_NS = SrcMiscData%U_full_NS -ENDIF -IF (ALLOCATED(SrcMiscData%U_full_dot)) THEN - i1_l = LBOUND(SrcMiscData%U_full_dot,1) - i1_u = UBOUND(SrcMiscData%U_full_dot,1) - IF (.NOT. ALLOCATED(DstMiscData%U_full_dot)) THEN - ALLOCATE(DstMiscData%U_full_dot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_dot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%U_full_dot = SrcMiscData%U_full_dot -ENDIF -IF (ALLOCATED(SrcMiscData%U_full_dotdot)) THEN - i1_l = LBOUND(SrcMiscData%U_full_dotdot,1) - i1_u = UBOUND(SrcMiscData%U_full_dotdot,1) - IF (.NOT. ALLOCATED(DstMiscData%U_full_dotdot)) THEN - ALLOCATE(DstMiscData%U_full_dotdot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_dotdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%U_full_dotdot = SrcMiscData%U_full_dotdot -ENDIF -IF (ALLOCATED(SrcMiscData%U_full_elast)) THEN - i1_l = LBOUND(SrcMiscData%U_full_elast,1) - i1_u = UBOUND(SrcMiscData%U_full_elast,1) - IF (.NOT. ALLOCATED(DstMiscData%U_full_elast)) THEN - ALLOCATE(DstMiscData%U_full_elast(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_elast.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%U_full_elast = SrcMiscData%U_full_elast -ENDIF -IF (ALLOCATED(SrcMiscData%U_red)) THEN - i1_l = LBOUND(SrcMiscData%U_red,1) - i1_u = UBOUND(SrcMiscData%U_red,1) - IF (.NOT. ALLOCATED(DstMiscData%U_red)) THEN - ALLOCATE(DstMiscData%U_red(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_red.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%U_red = SrcMiscData%U_red -ENDIF -IF (ALLOCATED(SrcMiscData%FC_unit)) THEN - i1_l = LBOUND(SrcMiscData%FC_unit,1) - i1_u = UBOUND(SrcMiscData%FC_unit,1) - IF (.NOT. ALLOCATED(DstMiscData%FC_unit)) THEN - ALLOCATE(DstMiscData%FC_unit(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FC_unit.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%FC_unit = SrcMiscData%FC_unit -ENDIF -IF (ALLOCATED(SrcMiscData%SDWrOutput)) THEN - i1_l = LBOUND(SrcMiscData%SDWrOutput,1) - i1_u = UBOUND(SrcMiscData%SDWrOutput,1) - IF (.NOT. ALLOCATED(DstMiscData%SDWrOutput)) THEN - ALLOCATE(DstMiscData%SDWrOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SDWrOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SDWrOutput = SrcMiscData%SDWrOutput -ENDIF -IF (ALLOCATED(SrcMiscData%AllOuts)) THEN - i1_l = LBOUND(SrcMiscData%AllOuts,1) - i1_u = UBOUND(SrcMiscData%AllOuts,1) - IF (.NOT. ALLOCATED(DstMiscData%AllOuts)) THEN - ALLOCATE(DstMiscData%AllOuts(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%AllOuts = SrcMiscData%AllOuts -ENDIF - DstMiscData%LastOutTime = SrcMiscData%LastOutTime - DstMiscData%Decimat = SrcMiscData%Decimat -IF (ALLOCATED(SrcMiscData%Fext)) THEN - i1_l = LBOUND(SrcMiscData%Fext,1) - i1_u = UBOUND(SrcMiscData%Fext,1) - IF (.NOT. ALLOCATED(DstMiscData%Fext)) THEN - ALLOCATE(DstMiscData%Fext(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Fext.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Fext = SrcMiscData%Fext -ENDIF -IF (ALLOCATED(SrcMiscData%Fext_red)) THEN - i1_l = LBOUND(SrcMiscData%Fext_red,1) - i1_u = UBOUND(SrcMiscData%Fext_red,1) - IF (.NOT. ALLOCATED(DstMiscData%Fext_red)) THEN - ALLOCATE(DstMiscData%Fext_red(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Fext_red.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Fext_red = SrcMiscData%Fext_red -ENDIF -IF (ALLOCATED(SrcMiscData%UL_SIM)) THEN - i1_l = LBOUND(SrcMiscData%UL_SIM,1) - i1_u = UBOUND(SrcMiscData%UL_SIM,1) - IF (.NOT. ALLOCATED(DstMiscData%UL_SIM)) THEN - ALLOCATE(DstMiscData%UL_SIM(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_SIM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%UL_SIM = SrcMiscData%UL_SIM -ENDIF -IF (ALLOCATED(SrcMiscData%UL_0m)) THEN - i1_l = LBOUND(SrcMiscData%UL_0m,1) - i1_u = UBOUND(SrcMiscData%UL_0m,1) - IF (.NOT. ALLOCATED(DstMiscData%UL_0m)) THEN - ALLOCATE(DstMiscData%UL_0m(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_0m.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%UL_0m = SrcMiscData%UL_0m -ENDIF - END SUBROUTINE SD_CopyMisc - - SUBROUTINE SD_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(SD_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyMisc' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MiscData%qmdotdot)) THEN - DEALLOCATE(MiscData%qmdotdot) -ENDIF -IF (ALLOCATED(MiscData%F_L)) THEN - DEALLOCATE(MiscData%F_L) -ENDIF -IF (ALLOCATED(MiscData%F_L2)) THEN - DEALLOCATE(MiscData%F_L2) -ENDIF -IF (ALLOCATED(MiscData%UR_bar)) THEN - DEALLOCATE(MiscData%UR_bar) -ENDIF -IF (ALLOCATED(MiscData%UR_bar_dot)) THEN - DEALLOCATE(MiscData%UR_bar_dot) -ENDIF -IF (ALLOCATED(MiscData%UR_bar_dotdot)) THEN - DEALLOCATE(MiscData%UR_bar_dotdot) -ENDIF -IF (ALLOCATED(MiscData%UL)) THEN - DEALLOCATE(MiscData%UL) -ENDIF -IF (ALLOCATED(MiscData%UL_NS)) THEN - DEALLOCATE(MiscData%UL_NS) -ENDIF -IF (ALLOCATED(MiscData%UL_dot)) THEN - DEALLOCATE(MiscData%UL_dot) -ENDIF -IF (ALLOCATED(MiscData%UL_dotdot)) THEN - DEALLOCATE(MiscData%UL_dotdot) -ENDIF -IF (ALLOCATED(MiscData%DU_full)) THEN - DEALLOCATE(MiscData%DU_full) -ENDIF -IF (ALLOCATED(MiscData%U_full)) THEN - DEALLOCATE(MiscData%U_full) -ENDIF -IF (ALLOCATED(MiscData%U_full_NS)) THEN - DEALLOCATE(MiscData%U_full_NS) -ENDIF -IF (ALLOCATED(MiscData%U_full_dot)) THEN - DEALLOCATE(MiscData%U_full_dot) -ENDIF -IF (ALLOCATED(MiscData%U_full_dotdot)) THEN - DEALLOCATE(MiscData%U_full_dotdot) -ENDIF -IF (ALLOCATED(MiscData%U_full_elast)) THEN - DEALLOCATE(MiscData%U_full_elast) -ENDIF -IF (ALLOCATED(MiscData%U_red)) THEN - DEALLOCATE(MiscData%U_red) -ENDIF -IF (ALLOCATED(MiscData%FC_unit)) THEN - DEALLOCATE(MiscData%FC_unit) -ENDIF -IF (ALLOCATED(MiscData%SDWrOutput)) THEN - DEALLOCATE(MiscData%SDWrOutput) -ENDIF -IF (ALLOCATED(MiscData%AllOuts)) THEN - DEALLOCATE(MiscData%AllOuts) -ENDIF -IF (ALLOCATED(MiscData%Fext)) THEN - DEALLOCATE(MiscData%Fext) -ENDIF -IF (ALLOCATED(MiscData%Fext_red)) THEN - DEALLOCATE(MiscData%Fext_red) -ENDIF -IF (ALLOCATED(MiscData%UL_SIM)) THEN - DEALLOCATE(MiscData%UL_SIM) -ENDIF -IF (ALLOCATED(MiscData%UL_0m)) THEN - DEALLOCATE(MiscData%UL_0m) -ENDIF - END SUBROUTINE SD_DestroyMisc +subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(SD_MiscVarType), intent(in) :: SrcMiscData + type(SD_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SD_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMiscData%qmdotdot)) then + LB(1:1) = lbound(SrcMiscData%qmdotdot) + UB(1:1) = ubound(SrcMiscData%qmdotdot) + if (.not. allocated(DstMiscData%qmdotdot)) then + allocate(DstMiscData%qmdotdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%qmdotdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%qmdotdot = SrcMiscData%qmdotdot + else if (allocated(DstMiscData%qmdotdot)) then + deallocate(DstMiscData%qmdotdot) + end if + DstMiscData%u_TP = SrcMiscData%u_TP + DstMiscData%udot_TP = SrcMiscData%udot_TP + DstMiscData%udotdot_TP = SrcMiscData%udotdot_TP + if (allocated(SrcMiscData%F_L)) then + LB(1:1) = lbound(SrcMiscData%F_L) + UB(1:1) = ubound(SrcMiscData%F_L) + if (.not. allocated(DstMiscData%F_L)) then + allocate(DstMiscData%F_L(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_L.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_L = SrcMiscData%F_L + else if (allocated(DstMiscData%F_L)) then + deallocate(DstMiscData%F_L) + end if + if (allocated(SrcMiscData%F_L2)) then + LB(1:1) = lbound(SrcMiscData%F_L2) + UB(1:1) = ubound(SrcMiscData%F_L2) + if (.not. allocated(DstMiscData%F_L2)) then + allocate(DstMiscData%F_L2(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_L2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%F_L2 = SrcMiscData%F_L2 + else if (allocated(DstMiscData%F_L2)) then + deallocate(DstMiscData%F_L2) + end if + if (allocated(SrcMiscData%UR_bar)) then + LB(1:1) = lbound(SrcMiscData%UR_bar) + UB(1:1) = ubound(SrcMiscData%UR_bar) + if (.not. allocated(DstMiscData%UR_bar)) then + allocate(DstMiscData%UR_bar(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UR_bar.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%UR_bar = SrcMiscData%UR_bar + else if (allocated(DstMiscData%UR_bar)) then + deallocate(DstMiscData%UR_bar) + end if + if (allocated(SrcMiscData%UR_bar_dot)) then + LB(1:1) = lbound(SrcMiscData%UR_bar_dot) + UB(1:1) = ubound(SrcMiscData%UR_bar_dot) + if (.not. allocated(DstMiscData%UR_bar_dot)) then + allocate(DstMiscData%UR_bar_dot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UR_bar_dot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%UR_bar_dot = SrcMiscData%UR_bar_dot + else if (allocated(DstMiscData%UR_bar_dot)) then + deallocate(DstMiscData%UR_bar_dot) + end if + if (allocated(SrcMiscData%UR_bar_dotdot)) then + LB(1:1) = lbound(SrcMiscData%UR_bar_dotdot) + UB(1:1) = ubound(SrcMiscData%UR_bar_dotdot) + if (.not. allocated(DstMiscData%UR_bar_dotdot)) then + allocate(DstMiscData%UR_bar_dotdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UR_bar_dotdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%UR_bar_dotdot = SrcMiscData%UR_bar_dotdot + else if (allocated(DstMiscData%UR_bar_dotdot)) then + deallocate(DstMiscData%UR_bar_dotdot) + end if + if (allocated(SrcMiscData%UL)) then + LB(1:1) = lbound(SrcMiscData%UL) + UB(1:1) = ubound(SrcMiscData%UL) + if (.not. allocated(DstMiscData%UL)) then + allocate(DstMiscData%UL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%UL = SrcMiscData%UL + else if (allocated(DstMiscData%UL)) then + deallocate(DstMiscData%UL) + end if + if (allocated(SrcMiscData%UL_NS)) then + LB(1:1) = lbound(SrcMiscData%UL_NS) + UB(1:1) = ubound(SrcMiscData%UL_NS) + if (.not. allocated(DstMiscData%UL_NS)) then + allocate(DstMiscData%UL_NS(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_NS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%UL_NS = SrcMiscData%UL_NS + else if (allocated(DstMiscData%UL_NS)) then + deallocate(DstMiscData%UL_NS) + end if + if (allocated(SrcMiscData%UL_dot)) then + LB(1:1) = lbound(SrcMiscData%UL_dot) + UB(1:1) = ubound(SrcMiscData%UL_dot) + if (.not. allocated(DstMiscData%UL_dot)) then + allocate(DstMiscData%UL_dot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_dot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%UL_dot = SrcMiscData%UL_dot + else if (allocated(DstMiscData%UL_dot)) then + deallocate(DstMiscData%UL_dot) + end if + if (allocated(SrcMiscData%UL_dotdot)) then + LB(1:1) = lbound(SrcMiscData%UL_dotdot) + UB(1:1) = ubound(SrcMiscData%UL_dotdot) + if (.not. allocated(DstMiscData%UL_dotdot)) then + allocate(DstMiscData%UL_dotdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_dotdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%UL_dotdot = SrcMiscData%UL_dotdot + else if (allocated(DstMiscData%UL_dotdot)) then + deallocate(DstMiscData%UL_dotdot) + end if + if (allocated(SrcMiscData%DU_full)) then + LB(1:1) = lbound(SrcMiscData%DU_full) + UB(1:1) = ubound(SrcMiscData%DU_full) + if (.not. allocated(DstMiscData%DU_full)) then + allocate(DstMiscData%DU_full(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%DU_full.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%DU_full = SrcMiscData%DU_full + else if (allocated(DstMiscData%DU_full)) then + deallocate(DstMiscData%DU_full) + end if + if (allocated(SrcMiscData%U_full)) then + LB(1:1) = lbound(SrcMiscData%U_full) + UB(1:1) = ubound(SrcMiscData%U_full) + if (.not. allocated(DstMiscData%U_full)) then + allocate(DstMiscData%U_full(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%U_full = SrcMiscData%U_full + else if (allocated(DstMiscData%U_full)) then + deallocate(DstMiscData%U_full) + end if + if (allocated(SrcMiscData%U_full_NS)) then + LB(1:1) = lbound(SrcMiscData%U_full_NS) + UB(1:1) = ubound(SrcMiscData%U_full_NS) + if (.not. allocated(DstMiscData%U_full_NS)) then + allocate(DstMiscData%U_full_NS(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_NS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%U_full_NS = SrcMiscData%U_full_NS + else if (allocated(DstMiscData%U_full_NS)) then + deallocate(DstMiscData%U_full_NS) + end if + if (allocated(SrcMiscData%U_full_dot)) then + LB(1:1) = lbound(SrcMiscData%U_full_dot) + UB(1:1) = ubound(SrcMiscData%U_full_dot) + if (.not. allocated(DstMiscData%U_full_dot)) then + allocate(DstMiscData%U_full_dot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_dot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%U_full_dot = SrcMiscData%U_full_dot + else if (allocated(DstMiscData%U_full_dot)) then + deallocate(DstMiscData%U_full_dot) + end if + if (allocated(SrcMiscData%U_full_dotdot)) then + LB(1:1) = lbound(SrcMiscData%U_full_dotdot) + UB(1:1) = ubound(SrcMiscData%U_full_dotdot) + if (.not. allocated(DstMiscData%U_full_dotdot)) then + allocate(DstMiscData%U_full_dotdot(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_dotdot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%U_full_dotdot = SrcMiscData%U_full_dotdot + else if (allocated(DstMiscData%U_full_dotdot)) then + deallocate(DstMiscData%U_full_dotdot) + end if + if (allocated(SrcMiscData%U_full_elast)) then + LB(1:1) = lbound(SrcMiscData%U_full_elast) + UB(1:1) = ubound(SrcMiscData%U_full_elast) + if (.not. allocated(DstMiscData%U_full_elast)) then + allocate(DstMiscData%U_full_elast(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_full_elast.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%U_full_elast = SrcMiscData%U_full_elast + else if (allocated(DstMiscData%U_full_elast)) then + deallocate(DstMiscData%U_full_elast) + end if + if (allocated(SrcMiscData%U_red)) then + LB(1:1) = lbound(SrcMiscData%U_red) + UB(1:1) = ubound(SrcMiscData%U_red) + if (.not. allocated(DstMiscData%U_red)) then + allocate(DstMiscData%U_red(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%U_red.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%U_red = SrcMiscData%U_red + else if (allocated(DstMiscData%U_red)) then + deallocate(DstMiscData%U_red) + end if + if (allocated(SrcMiscData%FC_unit)) then + LB(1:1) = lbound(SrcMiscData%FC_unit) + UB(1:1) = ubound(SrcMiscData%FC_unit) + if (.not. allocated(DstMiscData%FC_unit)) then + allocate(DstMiscData%FC_unit(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FC_unit.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%FC_unit = SrcMiscData%FC_unit + else if (allocated(DstMiscData%FC_unit)) then + deallocate(DstMiscData%FC_unit) + end if + if (allocated(SrcMiscData%SDWrOutput)) then + LB(1:1) = lbound(SrcMiscData%SDWrOutput) + UB(1:1) = ubound(SrcMiscData%SDWrOutput) + if (.not. allocated(DstMiscData%SDWrOutput)) then + allocate(DstMiscData%SDWrOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SDWrOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%SDWrOutput = SrcMiscData%SDWrOutput + else if (allocated(DstMiscData%SDWrOutput)) then + deallocate(DstMiscData%SDWrOutput) + end if + if (allocated(SrcMiscData%AllOuts)) then + LB(1:1) = lbound(SrcMiscData%AllOuts) + UB(1:1) = ubound(SrcMiscData%AllOuts) + if (.not. allocated(DstMiscData%AllOuts)) then + allocate(DstMiscData%AllOuts(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%AllOuts = SrcMiscData%AllOuts + else if (allocated(DstMiscData%AllOuts)) then + deallocate(DstMiscData%AllOuts) + end if + DstMiscData%LastOutTime = SrcMiscData%LastOutTime + DstMiscData%Decimat = SrcMiscData%Decimat + if (allocated(SrcMiscData%Fext)) then + LB(1:1) = lbound(SrcMiscData%Fext) + UB(1:1) = ubound(SrcMiscData%Fext) + if (.not. allocated(DstMiscData%Fext)) then + allocate(DstMiscData%Fext(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Fext.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Fext = SrcMiscData%Fext + else if (allocated(DstMiscData%Fext)) then + deallocate(DstMiscData%Fext) + end if + if (allocated(SrcMiscData%Fext_red)) then + LB(1:1) = lbound(SrcMiscData%Fext_red) + UB(1:1) = ubound(SrcMiscData%Fext_red) + if (.not. allocated(DstMiscData%Fext_red)) then + allocate(DstMiscData%Fext_red(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Fext_red.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Fext_red = SrcMiscData%Fext_red + else if (allocated(DstMiscData%Fext_red)) then + deallocate(DstMiscData%Fext_red) + end if + if (allocated(SrcMiscData%UL_SIM)) then + LB(1:1) = lbound(SrcMiscData%UL_SIM) + UB(1:1) = ubound(SrcMiscData%UL_SIM) + if (.not. allocated(DstMiscData%UL_SIM)) then + allocate(DstMiscData%UL_SIM(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_SIM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%UL_SIM = SrcMiscData%UL_SIM + else if (allocated(DstMiscData%UL_SIM)) then + deallocate(DstMiscData%UL_SIM) + end if + if (allocated(SrcMiscData%UL_0m)) then + LB(1:1) = lbound(SrcMiscData%UL_0m) + UB(1:1) = ubound(SrcMiscData%UL_0m) + if (.not. allocated(DstMiscData%UL_0m)) then + allocate(DstMiscData%UL_0m(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%UL_0m.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%UL_0m = SrcMiscData%UL_0m + else if (allocated(DstMiscData%UL_0m)) then + deallocate(DstMiscData%UL_0m) + end if +end subroutine +subroutine SD_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(SD_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SD_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%qmdotdot)) then + deallocate(MiscData%qmdotdot) + end if + if (allocated(MiscData%F_L)) then + deallocate(MiscData%F_L) + end if + if (allocated(MiscData%F_L2)) then + deallocate(MiscData%F_L2) + end if + if (allocated(MiscData%UR_bar)) then + deallocate(MiscData%UR_bar) + end if + if (allocated(MiscData%UR_bar_dot)) then + deallocate(MiscData%UR_bar_dot) + end if + if (allocated(MiscData%UR_bar_dotdot)) then + deallocate(MiscData%UR_bar_dotdot) + end if + if (allocated(MiscData%UL)) then + deallocate(MiscData%UL) + end if + if (allocated(MiscData%UL_NS)) then + deallocate(MiscData%UL_NS) + end if + if (allocated(MiscData%UL_dot)) then + deallocate(MiscData%UL_dot) + end if + if (allocated(MiscData%UL_dotdot)) then + deallocate(MiscData%UL_dotdot) + end if + if (allocated(MiscData%DU_full)) then + deallocate(MiscData%DU_full) + end if + if (allocated(MiscData%U_full)) then + deallocate(MiscData%U_full) + end if + if (allocated(MiscData%U_full_NS)) then + deallocate(MiscData%U_full_NS) + end if + if (allocated(MiscData%U_full_dot)) then + deallocate(MiscData%U_full_dot) + end if + if (allocated(MiscData%U_full_dotdot)) then + deallocate(MiscData%U_full_dotdot) + end if + if (allocated(MiscData%U_full_elast)) then + deallocate(MiscData%U_full_elast) + end if + if (allocated(MiscData%U_red)) then + deallocate(MiscData%U_red) + end if + if (allocated(MiscData%FC_unit)) then + deallocate(MiscData%FC_unit) + end if + if (allocated(MiscData%SDWrOutput)) then + deallocate(MiscData%SDWrOutput) + end if + if (allocated(MiscData%AllOuts)) then + deallocate(MiscData%AllOuts) + end if + if (allocated(MiscData%Fext)) then + deallocate(MiscData%Fext) + end if + if (allocated(MiscData%Fext_red)) then + deallocate(MiscData%Fext_red) + end if + if (allocated(MiscData%UL_SIM)) then + deallocate(MiscData%UL_SIM) + end if + if (allocated(MiscData%UL_0m)) then + deallocate(MiscData%UL_0m) + end if +end subroutine subroutine SD_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SD_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'SD_PackMisc' if (Buf%ErrStat >= AbortErrLev) return - ! qmdotdot call RegPack(Buf, allocated(InData%qmdotdot)) if (allocated(InData%qmdotdot)) then call RegPackBounds(Buf, 1, lbound(InData%qmdotdot), ubound(InData%qmdotdot)) call RegPack(Buf, InData%qmdotdot) end if if (RegCheckErr(Buf, RoutineName)) return - ! u_TP call RegPack(Buf, InData%u_TP) if (RegCheckErr(Buf, RoutineName)) return - ! udot_TP call RegPack(Buf, InData%udot_TP) if (RegCheckErr(Buf, RoutineName)) return - ! udotdot_TP call RegPack(Buf, InData%udotdot_TP) if (RegCheckErr(Buf, RoutineName)) return - ! F_L call RegPack(Buf, allocated(InData%F_L)) if (allocated(InData%F_L)) then call RegPackBounds(Buf, 1, lbound(InData%F_L), ubound(InData%F_L)) call RegPack(Buf, InData%F_L) end if if (RegCheckErr(Buf, RoutineName)) return - ! F_L2 call RegPack(Buf, allocated(InData%F_L2)) if (allocated(InData%F_L2)) then call RegPackBounds(Buf, 1, lbound(InData%F_L2), ubound(InData%F_L2)) call RegPack(Buf, InData%F_L2) end if if (RegCheckErr(Buf, RoutineName)) return - ! UR_bar call RegPack(Buf, allocated(InData%UR_bar)) if (allocated(InData%UR_bar)) then call RegPackBounds(Buf, 1, lbound(InData%UR_bar), ubound(InData%UR_bar)) call RegPack(Buf, InData%UR_bar) end if if (RegCheckErr(Buf, RoutineName)) return - ! UR_bar_dot call RegPack(Buf, allocated(InData%UR_bar_dot)) if (allocated(InData%UR_bar_dot)) then call RegPackBounds(Buf, 1, lbound(InData%UR_bar_dot), ubound(InData%UR_bar_dot)) call RegPack(Buf, InData%UR_bar_dot) end if if (RegCheckErr(Buf, RoutineName)) return - ! UR_bar_dotdot call RegPack(Buf, allocated(InData%UR_bar_dotdot)) if (allocated(InData%UR_bar_dotdot)) then call RegPackBounds(Buf, 1, lbound(InData%UR_bar_dotdot), ubound(InData%UR_bar_dotdot)) call RegPack(Buf, InData%UR_bar_dotdot) end if if (RegCheckErr(Buf, RoutineName)) return - ! UL call RegPack(Buf, allocated(InData%UL)) if (allocated(InData%UL)) then call RegPackBounds(Buf, 1, lbound(InData%UL), ubound(InData%UL)) call RegPack(Buf, InData%UL) end if if (RegCheckErr(Buf, RoutineName)) return - ! UL_NS call RegPack(Buf, allocated(InData%UL_NS)) if (allocated(InData%UL_NS)) then call RegPackBounds(Buf, 1, lbound(InData%UL_NS), ubound(InData%UL_NS)) call RegPack(Buf, InData%UL_NS) end if if (RegCheckErr(Buf, RoutineName)) return - ! UL_dot call RegPack(Buf, allocated(InData%UL_dot)) if (allocated(InData%UL_dot)) then call RegPackBounds(Buf, 1, lbound(InData%UL_dot), ubound(InData%UL_dot)) call RegPack(Buf, InData%UL_dot) end if if (RegCheckErr(Buf, RoutineName)) return - ! UL_dotdot call RegPack(Buf, allocated(InData%UL_dotdot)) if (allocated(InData%UL_dotdot)) then call RegPackBounds(Buf, 1, lbound(InData%UL_dotdot), ubound(InData%UL_dotdot)) call RegPack(Buf, InData%UL_dotdot) end if if (RegCheckErr(Buf, RoutineName)) return - ! DU_full call RegPack(Buf, allocated(InData%DU_full)) if (allocated(InData%DU_full)) then call RegPackBounds(Buf, 1, lbound(InData%DU_full), ubound(InData%DU_full)) call RegPack(Buf, InData%DU_full) end if if (RegCheckErr(Buf, RoutineName)) return - ! U_full call RegPack(Buf, allocated(InData%U_full)) if (allocated(InData%U_full)) then call RegPackBounds(Buf, 1, lbound(InData%U_full), ubound(InData%U_full)) call RegPack(Buf, InData%U_full) end if if (RegCheckErr(Buf, RoutineName)) return - ! U_full_NS call RegPack(Buf, allocated(InData%U_full_NS)) if (allocated(InData%U_full_NS)) then call RegPackBounds(Buf, 1, lbound(InData%U_full_NS), ubound(InData%U_full_NS)) call RegPack(Buf, InData%U_full_NS) end if if (RegCheckErr(Buf, RoutineName)) return - ! U_full_dot call RegPack(Buf, allocated(InData%U_full_dot)) if (allocated(InData%U_full_dot)) then call RegPackBounds(Buf, 1, lbound(InData%U_full_dot), ubound(InData%U_full_dot)) call RegPack(Buf, InData%U_full_dot) end if if (RegCheckErr(Buf, RoutineName)) return - ! U_full_dotdot call RegPack(Buf, allocated(InData%U_full_dotdot)) if (allocated(InData%U_full_dotdot)) then call RegPackBounds(Buf, 1, lbound(InData%U_full_dotdot), ubound(InData%U_full_dotdot)) call RegPack(Buf, InData%U_full_dotdot) end if if (RegCheckErr(Buf, RoutineName)) return - ! U_full_elast call RegPack(Buf, allocated(InData%U_full_elast)) if (allocated(InData%U_full_elast)) then call RegPackBounds(Buf, 1, lbound(InData%U_full_elast), ubound(InData%U_full_elast)) call RegPack(Buf, InData%U_full_elast) end if if (RegCheckErr(Buf, RoutineName)) return - ! U_red call RegPack(Buf, allocated(InData%U_red)) if (allocated(InData%U_red)) then call RegPackBounds(Buf, 1, lbound(InData%U_red), ubound(InData%U_red)) call RegPack(Buf, InData%U_red) end if if (RegCheckErr(Buf, RoutineName)) return - ! FC_unit call RegPack(Buf, allocated(InData%FC_unit)) if (allocated(InData%FC_unit)) then call RegPackBounds(Buf, 1, lbound(InData%FC_unit), ubound(InData%FC_unit)) call RegPack(Buf, InData%FC_unit) end if if (RegCheckErr(Buf, RoutineName)) return - ! SDWrOutput call RegPack(Buf, allocated(InData%SDWrOutput)) if (allocated(InData%SDWrOutput)) then call RegPackBounds(Buf, 1, lbound(InData%SDWrOutput), ubound(InData%SDWrOutput)) call RegPack(Buf, InData%SDWrOutput) end if if (RegCheckErr(Buf, RoutineName)) return - ! AllOuts call RegPack(Buf, allocated(InData%AllOuts)) if (allocated(InData%AllOuts)) then call RegPackBounds(Buf, 1, lbound(InData%AllOuts), ubound(InData%AllOuts)) call RegPack(Buf, InData%AllOuts) end if if (RegCheckErr(Buf, RoutineName)) return - ! LastOutTime call RegPack(Buf, InData%LastOutTime) if (RegCheckErr(Buf, RoutineName)) return - ! Decimat call RegPack(Buf, InData%Decimat) if (RegCheckErr(Buf, RoutineName)) return - ! Fext call RegPack(Buf, allocated(InData%Fext)) if (allocated(InData%Fext)) then call RegPackBounds(Buf, 1, lbound(InData%Fext), ubound(InData%Fext)) call RegPack(Buf, InData%Fext) end if if (RegCheckErr(Buf, RoutineName)) return - ! Fext_red call RegPack(Buf, allocated(InData%Fext_red)) if (allocated(InData%Fext_red)) then call RegPackBounds(Buf, 1, lbound(InData%Fext_red), ubound(InData%Fext_red)) call RegPack(Buf, InData%Fext_red) end if if (RegCheckErr(Buf, RoutineName)) return - ! UL_SIM call RegPack(Buf, allocated(InData%UL_SIM)) if (allocated(InData%UL_SIM)) then call RegPackBounds(Buf, 1, lbound(InData%UL_SIM), ubound(InData%UL_SIM)) call RegPack(Buf, InData%UL_SIM) end if if (RegCheckErr(Buf, RoutineName)) return - ! UL_0m call RegPack(Buf, allocated(InData%UL_0m)) if (allocated(InData%UL_0m)) then call RegPackBounds(Buf, 1, lbound(InData%UL_0m), ubound(InData%UL_0m)) @@ -3990,7 +3698,6 @@ subroutine SD_UnPackMisc(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! qmdotdot if (allocated(OutData%qmdotdot)) deallocate(OutData%qmdotdot) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4005,16 +3712,12 @@ subroutine SD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%qmdotdot) if (RegCheckErr(Buf, RoutineName)) return end if - ! u_TP call RegUnpack(Buf, OutData%u_TP) if (RegCheckErr(Buf, RoutineName)) return - ! udot_TP call RegUnpack(Buf, OutData%udot_TP) if (RegCheckErr(Buf, RoutineName)) return - ! udotdot_TP call RegUnpack(Buf, OutData%udotdot_TP) if (RegCheckErr(Buf, RoutineName)) return - ! F_L if (allocated(OutData%F_L)) deallocate(OutData%F_L) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4029,7 +3732,6 @@ subroutine SD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%F_L) if (RegCheckErr(Buf, RoutineName)) return end if - ! F_L2 if (allocated(OutData%F_L2)) deallocate(OutData%F_L2) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4044,7 +3746,6 @@ subroutine SD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%F_L2) if (RegCheckErr(Buf, RoutineName)) return end if - ! UR_bar if (allocated(OutData%UR_bar)) deallocate(OutData%UR_bar) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4059,7 +3760,6 @@ subroutine SD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%UR_bar) if (RegCheckErr(Buf, RoutineName)) return end if - ! UR_bar_dot if (allocated(OutData%UR_bar_dot)) deallocate(OutData%UR_bar_dot) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4074,7 +3774,6 @@ subroutine SD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%UR_bar_dot) if (RegCheckErr(Buf, RoutineName)) return end if - ! UR_bar_dotdot if (allocated(OutData%UR_bar_dotdot)) deallocate(OutData%UR_bar_dotdot) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4089,7 +3788,6 @@ subroutine SD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%UR_bar_dotdot) if (RegCheckErr(Buf, RoutineName)) return end if - ! UL if (allocated(OutData%UL)) deallocate(OutData%UL) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4104,7 +3802,6 @@ subroutine SD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%UL) if (RegCheckErr(Buf, RoutineName)) return end if - ! UL_NS if (allocated(OutData%UL_NS)) deallocate(OutData%UL_NS) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4119,7 +3816,6 @@ subroutine SD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%UL_NS) if (RegCheckErr(Buf, RoutineName)) return end if - ! UL_dot if (allocated(OutData%UL_dot)) deallocate(OutData%UL_dot) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4134,7 +3830,6 @@ subroutine SD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%UL_dot) if (RegCheckErr(Buf, RoutineName)) return end if - ! UL_dotdot if (allocated(OutData%UL_dotdot)) deallocate(OutData%UL_dotdot) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4149,7 +3844,6 @@ subroutine SD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%UL_dotdot) if (RegCheckErr(Buf, RoutineName)) return end if - ! DU_full if (allocated(OutData%DU_full)) deallocate(OutData%DU_full) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4164,7 +3858,6 @@ subroutine SD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%DU_full) if (RegCheckErr(Buf, RoutineName)) return end if - ! U_full if (allocated(OutData%U_full)) deallocate(OutData%U_full) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4179,7 +3872,6 @@ subroutine SD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%U_full) if (RegCheckErr(Buf, RoutineName)) return end if - ! U_full_NS if (allocated(OutData%U_full_NS)) deallocate(OutData%U_full_NS) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4194,7 +3886,6 @@ subroutine SD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%U_full_NS) if (RegCheckErr(Buf, RoutineName)) return end if - ! U_full_dot if (allocated(OutData%U_full_dot)) deallocate(OutData%U_full_dot) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4209,7 +3900,6 @@ subroutine SD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%U_full_dot) if (RegCheckErr(Buf, RoutineName)) return end if - ! U_full_dotdot if (allocated(OutData%U_full_dotdot)) deallocate(OutData%U_full_dotdot) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4224,7 +3914,6 @@ subroutine SD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%U_full_dotdot) if (RegCheckErr(Buf, RoutineName)) return end if - ! U_full_elast if (allocated(OutData%U_full_elast)) deallocate(OutData%U_full_elast) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4239,7 +3928,6 @@ subroutine SD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%U_full_elast) if (RegCheckErr(Buf, RoutineName)) return end if - ! U_red if (allocated(OutData%U_red)) deallocate(OutData%U_red) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4254,7 +3942,6 @@ subroutine SD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%U_red) if (RegCheckErr(Buf, RoutineName)) return end if - ! FC_unit if (allocated(OutData%FC_unit)) deallocate(OutData%FC_unit) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4269,7 +3956,6 @@ subroutine SD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%FC_unit) if (RegCheckErr(Buf, RoutineName)) return end if - ! SDWrOutput if (allocated(OutData%SDWrOutput)) deallocate(OutData%SDWrOutput) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4284,7 +3970,6 @@ subroutine SD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%SDWrOutput) if (RegCheckErr(Buf, RoutineName)) return end if - ! AllOuts if (allocated(OutData%AllOuts)) deallocate(OutData%AllOuts) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4299,13 +3984,10 @@ subroutine SD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%AllOuts) if (RegCheckErr(Buf, RoutineName)) return end if - ! LastOutTime call RegUnpack(Buf, OutData%LastOutTime) if (RegCheckErr(Buf, RoutineName)) return - ! Decimat call RegUnpack(Buf, OutData%Decimat) if (RegCheckErr(Buf, RoutineName)) return - ! Fext if (allocated(OutData%Fext)) deallocate(OutData%Fext) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4320,7 +4002,6 @@ subroutine SD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%Fext) if (RegCheckErr(Buf, RoutineName)) return end if - ! Fext_red if (allocated(OutData%Fext_red)) deallocate(OutData%Fext_red) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4335,7 +4016,6 @@ subroutine SD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%Fext_red) if (RegCheckErr(Buf, RoutineName)) return end if - ! UL_SIM if (allocated(OutData%UL_SIM)) deallocate(OutData%UL_SIM) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4350,7 +4030,6 @@ subroutine SD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%UL_SIM) if (RegCheckErr(Buf, RoutineName)) return end if - ! UL_0m if (allocated(OutData%UL_0m)) deallocate(OutData%UL_0m) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -4366,1092 +4045,1151 @@ subroutine SD_UnPackMisc(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE SD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SD_ParameterType), INTENT(IN) :: SrcParamData - TYPE(SD_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%SDDeltaT = SrcParamData%SDDeltaT - DstParamData%IntMethod = SrcParamData%IntMethod - DstParamData%nDOF = SrcParamData%nDOF - DstParamData%nDOF_red = SrcParamData%nDOF_red - DstParamData%Nmembers = SrcParamData%Nmembers -IF (ALLOCATED(SrcParamData%Elems)) THEN - i1_l = LBOUND(SrcParamData%Elems,1) - i1_u = UBOUND(SrcParamData%Elems,1) - i2_l = LBOUND(SrcParamData%Elems,2) - i2_u = UBOUND(SrcParamData%Elems,2) - IF (.NOT. ALLOCATED(DstParamData%Elems)) THEN - ALLOCATE(DstParamData%Elems(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Elems.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Elems = SrcParamData%Elems -ENDIF -IF (ALLOCATED(SrcParamData%ElemProps)) THEN - i1_l = LBOUND(SrcParamData%ElemProps,1) - i1_u = UBOUND(SrcParamData%ElemProps,1) - IF (.NOT. ALLOCATED(DstParamData%ElemProps)) THEN - ALLOCATE(DstParamData%ElemProps(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ElemProps.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%ElemProps,1), UBOUND(SrcParamData%ElemProps,1) - CALL SD_Copyelemproptype( SrcParamData%ElemProps(i1), DstParamData%ElemProps(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%FG)) THEN - i1_l = LBOUND(SrcParamData%FG,1) - i1_u = UBOUND(SrcParamData%FG,1) - IF (.NOT. ALLOCATED(DstParamData%FG)) THEN - ALLOCATE(DstParamData%FG(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FG = SrcParamData%FG -ENDIF -IF (ALLOCATED(SrcParamData%DP0)) THEN - i1_l = LBOUND(SrcParamData%DP0,1) - i1_u = UBOUND(SrcParamData%DP0,1) - i2_l = LBOUND(SrcParamData%DP0,2) - i2_u = UBOUND(SrcParamData%DP0,2) - IF (.NOT. ALLOCATED(DstParamData%DP0)) THEN - ALLOCATE(DstParamData%DP0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DP0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%DP0 = SrcParamData%DP0 -ENDIF -IF (ALLOCATED(SrcParamData%NodeID2JointID)) THEN - i1_l = LBOUND(SrcParamData%NodeID2JointID,1) - i1_u = UBOUND(SrcParamData%NodeID2JointID,1) - IF (.NOT. ALLOCATED(DstParamData%NodeID2JointID)) THEN - ALLOCATE(DstParamData%NodeID2JointID(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NodeID2JointID.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%NodeID2JointID = SrcParamData%NodeID2JointID -ENDIF - DstParamData%reduced = SrcParamData%reduced -IF (ALLOCATED(SrcParamData%T_red)) THEN - i1_l = LBOUND(SrcParamData%T_red,1) - i1_u = UBOUND(SrcParamData%T_red,1) - i2_l = LBOUND(SrcParamData%T_red,2) - i2_u = UBOUND(SrcParamData%T_red,2) - IF (.NOT. ALLOCATED(DstParamData%T_red)) THEN - ALLOCATE(DstParamData%T_red(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%T_red.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%T_red = SrcParamData%T_red -ENDIF -IF (ALLOCATED(SrcParamData%T_red_T)) THEN - i1_l = LBOUND(SrcParamData%T_red_T,1) - i1_u = UBOUND(SrcParamData%T_red_T,1) - i2_l = LBOUND(SrcParamData%T_red_T,2) - i2_u = UBOUND(SrcParamData%T_red_T,2) - IF (.NOT. ALLOCATED(DstParamData%T_red_T)) THEN - ALLOCATE(DstParamData%T_red_T(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%T_red_T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%T_red_T = SrcParamData%T_red_T -ENDIF -IF (ALLOCATED(SrcParamData%NodesDOF)) THEN - i1_l = LBOUND(SrcParamData%NodesDOF,1) - i1_u = UBOUND(SrcParamData%NodesDOF,1) - IF (.NOT. ALLOCATED(DstParamData%NodesDOF)) THEN - ALLOCATE(DstParamData%NodesDOF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NodesDOF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%NodesDOF,1), UBOUND(SrcParamData%NodesDOF,1) - CALL SD_Copyilist( SrcParamData%NodesDOF(i1), DstParamData%NodesDOF(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%NodesDOFred)) THEN - i1_l = LBOUND(SrcParamData%NodesDOFred,1) - i1_u = UBOUND(SrcParamData%NodesDOFred,1) - IF (.NOT. ALLOCATED(DstParamData%NodesDOFred)) THEN - ALLOCATE(DstParamData%NodesDOFred(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NodesDOFred.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%NodesDOFred,1), UBOUND(SrcParamData%NodesDOFred,1) - CALL SD_Copyilist( SrcParamData%NodesDOFred(i1), DstParamData%NodesDOFred(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%ElemsDOF)) THEN - i1_l = LBOUND(SrcParamData%ElemsDOF,1) - i1_u = UBOUND(SrcParamData%ElemsDOF,1) - i2_l = LBOUND(SrcParamData%ElemsDOF,2) - i2_u = UBOUND(SrcParamData%ElemsDOF,2) - IF (.NOT. ALLOCATED(DstParamData%ElemsDOF)) THEN - ALLOCATE(DstParamData%ElemsDOF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ElemsDOF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ElemsDOF = SrcParamData%ElemsDOF -ENDIF -IF (ALLOCATED(SrcParamData%DOFred2Nodes)) THEN - i1_l = LBOUND(SrcParamData%DOFred2Nodes,1) - i1_u = UBOUND(SrcParamData%DOFred2Nodes,1) - i2_l = LBOUND(SrcParamData%DOFred2Nodes,2) - i2_u = UBOUND(SrcParamData%DOFred2Nodes,2) - IF (.NOT. ALLOCATED(DstParamData%DOFred2Nodes)) THEN - ALLOCATE(DstParamData%DOFred2Nodes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DOFred2Nodes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%DOFred2Nodes = SrcParamData%DOFred2Nodes -ENDIF -IF (ALLOCATED(SrcParamData%CtrlElem2Channel)) THEN - i1_l = LBOUND(SrcParamData%CtrlElem2Channel,1) - i1_u = UBOUND(SrcParamData%CtrlElem2Channel,1) - i2_l = LBOUND(SrcParamData%CtrlElem2Channel,2) - i2_u = UBOUND(SrcParamData%CtrlElem2Channel,2) - IF (.NOT. ALLOCATED(DstParamData%CtrlElem2Channel)) THEN - ALLOCATE(DstParamData%CtrlElem2Channel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CtrlElem2Channel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CtrlElem2Channel = SrcParamData%CtrlElem2Channel -ENDIF - DstParamData%nDOFM = SrcParamData%nDOFM - DstParamData%SttcSolve = SrcParamData%SttcSolve - DstParamData%GuyanLoadCorrection = SrcParamData%GuyanLoadCorrection - DstParamData%Floating = SrcParamData%Floating -IF (ALLOCATED(SrcParamData%KMMDiag)) THEN - i1_l = LBOUND(SrcParamData%KMMDiag,1) - i1_u = UBOUND(SrcParamData%KMMDiag,1) - IF (.NOT. ALLOCATED(DstParamData%KMMDiag)) THEN - ALLOCATE(DstParamData%KMMDiag(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KMMDiag.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%KMMDiag = SrcParamData%KMMDiag -ENDIF -IF (ALLOCATED(SrcParamData%CMMDiag)) THEN - i1_l = LBOUND(SrcParamData%CMMDiag,1) - i1_u = UBOUND(SrcParamData%CMMDiag,1) - IF (.NOT. ALLOCATED(DstParamData%CMMDiag)) THEN - ALLOCATE(DstParamData%CMMDiag(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CMMDiag.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CMMDiag = SrcParamData%CMMDiag -ENDIF -IF (ALLOCATED(SrcParamData%MMB)) THEN - i1_l = LBOUND(SrcParamData%MMB,1) - i1_u = UBOUND(SrcParamData%MMB,1) - i2_l = LBOUND(SrcParamData%MMB,2) - i2_u = UBOUND(SrcParamData%MMB,2) - IF (.NOT. ALLOCATED(DstParamData%MMB)) THEN - ALLOCATE(DstParamData%MMB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MMB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%MMB = SrcParamData%MMB -ENDIF -IF (ALLOCATED(SrcParamData%MBmmB)) THEN - i1_l = LBOUND(SrcParamData%MBmmB,1) - i1_u = UBOUND(SrcParamData%MBmmB,1) - i2_l = LBOUND(SrcParamData%MBmmB,2) - i2_u = UBOUND(SrcParamData%MBmmB,2) - IF (.NOT. ALLOCATED(DstParamData%MBmmB)) THEN - ALLOCATE(DstParamData%MBmmB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MBmmB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%MBmmB = SrcParamData%MBmmB -ENDIF -IF (ALLOCATED(SrcParamData%C1_11)) THEN - i1_l = LBOUND(SrcParamData%C1_11,1) - i1_u = UBOUND(SrcParamData%C1_11,1) - i2_l = LBOUND(SrcParamData%C1_11,2) - i2_u = UBOUND(SrcParamData%C1_11,2) - IF (.NOT. ALLOCATED(DstParamData%C1_11)) THEN - ALLOCATE(DstParamData%C1_11(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C1_11.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%C1_11 = SrcParamData%C1_11 -ENDIF -IF (ALLOCATED(SrcParamData%C1_12)) THEN - i1_l = LBOUND(SrcParamData%C1_12,1) - i1_u = UBOUND(SrcParamData%C1_12,1) - i2_l = LBOUND(SrcParamData%C1_12,2) - i2_u = UBOUND(SrcParamData%C1_12,2) - IF (.NOT. ALLOCATED(DstParamData%C1_12)) THEN - ALLOCATE(DstParamData%C1_12(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C1_12.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%C1_12 = SrcParamData%C1_12 -ENDIF -IF (ALLOCATED(SrcParamData%D1_141)) THEN - i1_l = LBOUND(SrcParamData%D1_141,1) - i1_u = UBOUND(SrcParamData%D1_141,1) - i2_l = LBOUND(SrcParamData%D1_141,2) - i2_u = UBOUND(SrcParamData%D1_141,2) - IF (.NOT. ALLOCATED(DstParamData%D1_141)) THEN - ALLOCATE(DstParamData%D1_141(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D1_141.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%D1_141 = SrcParamData%D1_141 -ENDIF -IF (ALLOCATED(SrcParamData%D1_142)) THEN - i1_l = LBOUND(SrcParamData%D1_142,1) - i1_u = UBOUND(SrcParamData%D1_142,1) - i2_l = LBOUND(SrcParamData%D1_142,2) - i2_u = UBOUND(SrcParamData%D1_142,2) - IF (.NOT. ALLOCATED(DstParamData%D1_142)) THEN - ALLOCATE(DstParamData%D1_142(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D1_142.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%D1_142 = SrcParamData%D1_142 -ENDIF -IF (ALLOCATED(SrcParamData%PhiM)) THEN - i1_l = LBOUND(SrcParamData%PhiM,1) - i1_u = UBOUND(SrcParamData%PhiM,1) - i2_l = LBOUND(SrcParamData%PhiM,2) - i2_u = UBOUND(SrcParamData%PhiM,2) - IF (.NOT. ALLOCATED(DstParamData%PhiM)) THEN - ALLOCATE(DstParamData%PhiM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%PhiM = SrcParamData%PhiM -ENDIF -IF (ALLOCATED(SrcParamData%C2_61)) THEN - i1_l = LBOUND(SrcParamData%C2_61,1) - i1_u = UBOUND(SrcParamData%C2_61,1) - i2_l = LBOUND(SrcParamData%C2_61,2) - i2_u = UBOUND(SrcParamData%C2_61,2) - IF (.NOT. ALLOCATED(DstParamData%C2_61)) THEN - ALLOCATE(DstParamData%C2_61(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C2_61.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%C2_61 = SrcParamData%C2_61 -ENDIF -IF (ALLOCATED(SrcParamData%C2_62)) THEN - i1_l = LBOUND(SrcParamData%C2_62,1) - i1_u = UBOUND(SrcParamData%C2_62,1) - i2_l = LBOUND(SrcParamData%C2_62,2) - i2_u = UBOUND(SrcParamData%C2_62,2) - IF (.NOT. ALLOCATED(DstParamData%C2_62)) THEN - ALLOCATE(DstParamData%C2_62(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C2_62.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%C2_62 = SrcParamData%C2_62 -ENDIF -IF (ALLOCATED(SrcParamData%PhiRb_TI)) THEN - i1_l = LBOUND(SrcParamData%PhiRb_TI,1) - i1_u = UBOUND(SrcParamData%PhiRb_TI,1) - i2_l = LBOUND(SrcParamData%PhiRb_TI,2) - i2_u = UBOUND(SrcParamData%PhiRb_TI,2) - IF (.NOT. ALLOCATED(DstParamData%PhiRb_TI)) THEN - ALLOCATE(DstParamData%PhiRb_TI(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiRb_TI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%PhiRb_TI = SrcParamData%PhiRb_TI -ENDIF -IF (ALLOCATED(SrcParamData%D2_63)) THEN - i1_l = LBOUND(SrcParamData%D2_63,1) - i1_u = UBOUND(SrcParamData%D2_63,1) - i2_l = LBOUND(SrcParamData%D2_63,2) - i2_u = UBOUND(SrcParamData%D2_63,2) - IF (.NOT. ALLOCATED(DstParamData%D2_63)) THEN - ALLOCATE(DstParamData%D2_63(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D2_63.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%D2_63 = SrcParamData%D2_63 -ENDIF -IF (ALLOCATED(SrcParamData%D2_64)) THEN - i1_l = LBOUND(SrcParamData%D2_64,1) - i1_u = UBOUND(SrcParamData%D2_64,1) - i2_l = LBOUND(SrcParamData%D2_64,2) - i2_u = UBOUND(SrcParamData%D2_64,2) - IF (.NOT. ALLOCATED(DstParamData%D2_64)) THEN - ALLOCATE(DstParamData%D2_64(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D2_64.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%D2_64 = SrcParamData%D2_64 -ENDIF -IF (ALLOCATED(SrcParamData%MBB)) THEN - i1_l = LBOUND(SrcParamData%MBB,1) - i1_u = UBOUND(SrcParamData%MBB,1) - i2_l = LBOUND(SrcParamData%MBB,2) - i2_u = UBOUND(SrcParamData%MBB,2) - IF (.NOT. ALLOCATED(DstParamData%MBB)) THEN - ALLOCATE(DstParamData%MBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MBB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%MBB = SrcParamData%MBB -ENDIF -IF (ALLOCATED(SrcParamData%KBB)) THEN - i1_l = LBOUND(SrcParamData%KBB,1) - i1_u = UBOUND(SrcParamData%KBB,1) - i2_l = LBOUND(SrcParamData%KBB,2) - i2_u = UBOUND(SrcParamData%KBB,2) - IF (.NOT. ALLOCATED(DstParamData%KBB)) THEN - ALLOCATE(DstParamData%KBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KBB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%KBB = SrcParamData%KBB -ENDIF -IF (ALLOCATED(SrcParamData%CBB)) THEN - i1_l = LBOUND(SrcParamData%CBB,1) - i1_u = UBOUND(SrcParamData%CBB,1) - i2_l = LBOUND(SrcParamData%CBB,2) - i2_u = UBOUND(SrcParamData%CBB,2) - IF (.NOT. ALLOCATED(DstParamData%CBB)) THEN - ALLOCATE(DstParamData%CBB(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CBB.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CBB = SrcParamData%CBB -ENDIF -IF (ALLOCATED(SrcParamData%CMM)) THEN - i1_l = LBOUND(SrcParamData%CMM,1) - i1_u = UBOUND(SrcParamData%CMM,1) - i2_l = LBOUND(SrcParamData%CMM,2) - i2_u = UBOUND(SrcParamData%CMM,2) - IF (.NOT. ALLOCATED(DstParamData%CMM)) THEN - ALLOCATE(DstParamData%CMM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CMM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%CMM = SrcParamData%CMM -ENDIF -IF (ALLOCATED(SrcParamData%MBM)) THEN - i1_l = LBOUND(SrcParamData%MBM,1) - i1_u = UBOUND(SrcParamData%MBM,1) - i2_l = LBOUND(SrcParamData%MBM,2) - i2_u = UBOUND(SrcParamData%MBM,2) - IF (.NOT. ALLOCATED(DstParamData%MBM)) THEN - ALLOCATE(DstParamData%MBM(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MBM.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%MBM = SrcParamData%MBM -ENDIF -IF (ALLOCATED(SrcParamData%PhiL_T)) THEN - i1_l = LBOUND(SrcParamData%PhiL_T,1) - i1_u = UBOUND(SrcParamData%PhiL_T,1) - i2_l = LBOUND(SrcParamData%PhiL_T,2) - i2_u = UBOUND(SrcParamData%PhiL_T,2) - IF (.NOT. ALLOCATED(DstParamData%PhiL_T)) THEN - ALLOCATE(DstParamData%PhiL_T(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiL_T.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%PhiL_T = SrcParamData%PhiL_T -ENDIF -IF (ALLOCATED(SrcParamData%PhiLInvOmgL2)) THEN - i1_l = LBOUND(SrcParamData%PhiLInvOmgL2,1) - i1_u = UBOUND(SrcParamData%PhiLInvOmgL2,1) - i2_l = LBOUND(SrcParamData%PhiLInvOmgL2,2) - i2_u = UBOUND(SrcParamData%PhiLInvOmgL2,2) - IF (.NOT. ALLOCATED(DstParamData%PhiLInvOmgL2)) THEN - ALLOCATE(DstParamData%PhiLInvOmgL2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiLInvOmgL2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%PhiLInvOmgL2 = SrcParamData%PhiLInvOmgL2 -ENDIF -IF (ALLOCATED(SrcParamData%KLLm1)) THEN - i1_l = LBOUND(SrcParamData%KLLm1,1) - i1_u = UBOUND(SrcParamData%KLLm1,1) - i2_l = LBOUND(SrcParamData%KLLm1,2) - i2_u = UBOUND(SrcParamData%KLLm1,2) - IF (.NOT. ALLOCATED(DstParamData%KLLm1)) THEN - ALLOCATE(DstParamData%KLLm1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KLLm1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%KLLm1 = SrcParamData%KLLm1 -ENDIF -IF (ALLOCATED(SrcParamData%AM2Jac)) THEN - i1_l = LBOUND(SrcParamData%AM2Jac,1) - i1_u = UBOUND(SrcParamData%AM2Jac,1) - i2_l = LBOUND(SrcParamData%AM2Jac,2) - i2_u = UBOUND(SrcParamData%AM2Jac,2) - IF (.NOT. ALLOCATED(DstParamData%AM2Jac)) THEN - ALLOCATE(DstParamData%AM2Jac(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AM2Jac.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AM2Jac = SrcParamData%AM2Jac -ENDIF -IF (ALLOCATED(SrcParamData%AM2JacPiv)) THEN - i1_l = LBOUND(SrcParamData%AM2JacPiv,1) - i1_u = UBOUND(SrcParamData%AM2JacPiv,1) - IF (.NOT. ALLOCATED(DstParamData%AM2JacPiv)) THEN - ALLOCATE(DstParamData%AM2JacPiv(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AM2JacPiv.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AM2JacPiv = SrcParamData%AM2JacPiv -ENDIF -IF (ALLOCATED(SrcParamData%TI)) THEN - i1_l = LBOUND(SrcParamData%TI,1) - i1_u = UBOUND(SrcParamData%TI,1) - i2_l = LBOUND(SrcParamData%TI,2) - i2_u = UBOUND(SrcParamData%TI,2) - IF (.NOT. ALLOCATED(DstParamData%TI)) THEN - ALLOCATE(DstParamData%TI(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TI = SrcParamData%TI -ENDIF -IF (ALLOCATED(SrcParamData%TIreact)) THEN - i1_l = LBOUND(SrcParamData%TIreact,1) - i1_u = UBOUND(SrcParamData%TIreact,1) - i2_l = LBOUND(SrcParamData%TIreact,2) - i2_u = UBOUND(SrcParamData%TIreact,2) - IF (.NOT. ALLOCATED(DstParamData%TIreact)) THEN - ALLOCATE(DstParamData%TIreact(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TIreact.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TIreact = SrcParamData%TIreact -ENDIF - DstParamData%nNodes = SrcParamData%nNodes - DstParamData%nNodes_I = SrcParamData%nNodes_I - DstParamData%nNodes_L = SrcParamData%nNodes_L - DstParamData%nNodes_C = SrcParamData%nNodes_C -IF (ALLOCATED(SrcParamData%Nodes_I)) THEN - i1_l = LBOUND(SrcParamData%Nodes_I,1) - i1_u = UBOUND(SrcParamData%Nodes_I,1) - i2_l = LBOUND(SrcParamData%Nodes_I,2) - i2_u = UBOUND(SrcParamData%Nodes_I,2) - IF (.NOT. ALLOCATED(DstParamData%Nodes_I)) THEN - ALLOCATE(DstParamData%Nodes_I(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Nodes_I.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Nodes_I = SrcParamData%Nodes_I -ENDIF -IF (ALLOCATED(SrcParamData%Nodes_L)) THEN - i1_l = LBOUND(SrcParamData%Nodes_L,1) - i1_u = UBOUND(SrcParamData%Nodes_L,1) - i2_l = LBOUND(SrcParamData%Nodes_L,2) - i2_u = UBOUND(SrcParamData%Nodes_L,2) - IF (.NOT. ALLOCATED(DstParamData%Nodes_L)) THEN - ALLOCATE(DstParamData%Nodes_L(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Nodes_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Nodes_L = SrcParamData%Nodes_L -ENDIF -IF (ALLOCATED(SrcParamData%Nodes_C)) THEN - i1_l = LBOUND(SrcParamData%Nodes_C,1) - i1_u = UBOUND(SrcParamData%Nodes_C,1) - i2_l = LBOUND(SrcParamData%Nodes_C,2) - i2_u = UBOUND(SrcParamData%Nodes_C,2) - IF (.NOT. ALLOCATED(DstParamData%Nodes_C)) THEN - ALLOCATE(DstParamData%Nodes_C(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Nodes_C.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Nodes_C = SrcParamData%Nodes_C -ENDIF - DstParamData%nDOFI__ = SrcParamData%nDOFI__ - DstParamData%nDOFI_Rb = SrcParamData%nDOFI_Rb - DstParamData%nDOFI_F = SrcParamData%nDOFI_F - DstParamData%nDOFL_L = SrcParamData%nDOFL_L - DstParamData%nDOFC__ = SrcParamData%nDOFC__ - DstParamData%nDOFC_Rb = SrcParamData%nDOFC_Rb - DstParamData%nDOFC_L = SrcParamData%nDOFC_L - DstParamData%nDOFC_F = SrcParamData%nDOFC_F - DstParamData%nDOFR__ = SrcParamData%nDOFR__ - DstParamData%nDOF__Rb = SrcParamData%nDOF__Rb - DstParamData%nDOF__L = SrcParamData%nDOF__L - DstParamData%nDOF__F = SrcParamData%nDOF__F -IF (ALLOCATED(SrcParamData%IDI__)) THEN - i1_l = LBOUND(SrcParamData%IDI__,1) - i1_u = UBOUND(SrcParamData%IDI__,1) - IF (.NOT. ALLOCATED(DstParamData%IDI__)) THEN - ALLOCATE(DstParamData%IDI__(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDI__.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%IDI__ = SrcParamData%IDI__ -ENDIF -IF (ALLOCATED(SrcParamData%IDI_Rb)) THEN - i1_l = LBOUND(SrcParamData%IDI_Rb,1) - i1_u = UBOUND(SrcParamData%IDI_Rb,1) - IF (.NOT. ALLOCATED(DstParamData%IDI_Rb)) THEN - ALLOCATE(DstParamData%IDI_Rb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDI_Rb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%IDI_Rb = SrcParamData%IDI_Rb -ENDIF -IF (ALLOCATED(SrcParamData%IDI_F)) THEN - i1_l = LBOUND(SrcParamData%IDI_F,1) - i1_u = UBOUND(SrcParamData%IDI_F,1) - IF (.NOT. ALLOCATED(DstParamData%IDI_F)) THEN - ALLOCATE(DstParamData%IDI_F(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDI_F.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%IDI_F = SrcParamData%IDI_F -ENDIF -IF (ALLOCATED(SrcParamData%IDL_L)) THEN - i1_l = LBOUND(SrcParamData%IDL_L,1) - i1_u = UBOUND(SrcParamData%IDL_L,1) - IF (.NOT. ALLOCATED(DstParamData%IDL_L)) THEN - ALLOCATE(DstParamData%IDL_L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDL_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%IDL_L = SrcParamData%IDL_L -ENDIF -IF (ALLOCATED(SrcParamData%IDC__)) THEN - i1_l = LBOUND(SrcParamData%IDC__,1) - i1_u = UBOUND(SrcParamData%IDC__,1) - IF (.NOT. ALLOCATED(DstParamData%IDC__)) THEN - ALLOCATE(DstParamData%IDC__(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC__.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%IDC__ = SrcParamData%IDC__ -ENDIF -IF (ALLOCATED(SrcParamData%IDC_Rb)) THEN - i1_l = LBOUND(SrcParamData%IDC_Rb,1) - i1_u = UBOUND(SrcParamData%IDC_Rb,1) - IF (.NOT. ALLOCATED(DstParamData%IDC_Rb)) THEN - ALLOCATE(DstParamData%IDC_Rb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC_Rb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%IDC_Rb = SrcParamData%IDC_Rb -ENDIF -IF (ALLOCATED(SrcParamData%IDC_L)) THEN - i1_l = LBOUND(SrcParamData%IDC_L,1) - i1_u = UBOUND(SrcParamData%IDC_L,1) - IF (.NOT. ALLOCATED(DstParamData%IDC_L)) THEN - ALLOCATE(DstParamData%IDC_L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%IDC_L = SrcParamData%IDC_L -ENDIF -IF (ALLOCATED(SrcParamData%IDC_F)) THEN - i1_l = LBOUND(SrcParamData%IDC_F,1) - i1_u = UBOUND(SrcParamData%IDC_F,1) - IF (.NOT. ALLOCATED(DstParamData%IDC_F)) THEN - ALLOCATE(DstParamData%IDC_F(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC_F.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%IDC_F = SrcParamData%IDC_F -ENDIF -IF (ALLOCATED(SrcParamData%IDR__)) THEN - i1_l = LBOUND(SrcParamData%IDR__,1) - i1_u = UBOUND(SrcParamData%IDR__,1) - IF (.NOT. ALLOCATED(DstParamData%IDR__)) THEN - ALLOCATE(DstParamData%IDR__(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDR__.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%IDR__ = SrcParamData%IDR__ -ENDIF -IF (ALLOCATED(SrcParamData%ID__Rb)) THEN - i1_l = LBOUND(SrcParamData%ID__Rb,1) - i1_u = UBOUND(SrcParamData%ID__Rb,1) - IF (.NOT. ALLOCATED(DstParamData%ID__Rb)) THEN - ALLOCATE(DstParamData%ID__Rb(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ID__Rb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ID__Rb = SrcParamData%ID__Rb -ENDIF -IF (ALLOCATED(SrcParamData%ID__L)) THEN - i1_l = LBOUND(SrcParamData%ID__L,1) - i1_u = UBOUND(SrcParamData%ID__L,1) - IF (.NOT. ALLOCATED(DstParamData%ID__L)) THEN - ALLOCATE(DstParamData%ID__L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ID__L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ID__L = SrcParamData%ID__L -ENDIF -IF (ALLOCATED(SrcParamData%ID__F)) THEN - i1_l = LBOUND(SrcParamData%ID__F,1) - i1_u = UBOUND(SrcParamData%ID__F,1) - IF (.NOT. ALLOCATED(DstParamData%ID__F)) THEN - ALLOCATE(DstParamData%ID__F(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ID__F.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ID__F = SrcParamData%ID__F -ENDIF - DstParamData%NMOutputs = SrcParamData%NMOutputs - DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%OutSwtch = SrcParamData%OutSwtch - DstParamData%UnJckF = SrcParamData%UnJckF - DstParamData%Delim = SrcParamData%Delim - DstParamData%OutFmt = SrcParamData%OutFmt - DstParamData%OutSFmt = SrcParamData%OutSFmt -IF (ALLOCATED(SrcParamData%MoutLst)) THEN - i1_l = LBOUND(SrcParamData%MoutLst,1) - i1_u = UBOUND(SrcParamData%MoutLst,1) - IF (.NOT. ALLOCATED(DstParamData%MoutLst)) THEN - ALLOCATE(DstParamData%MoutLst(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MoutLst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%MoutLst,1), UBOUND(SrcParamData%MoutLst,1) - CALL SD_Copymeshauxdatatype( SrcParamData%MoutLst(i1), DstParamData%MoutLst(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%MoutLst2)) THEN - i1_l = LBOUND(SrcParamData%MoutLst2,1) - i1_u = UBOUND(SrcParamData%MoutLst2,1) - IF (.NOT. ALLOCATED(DstParamData%MoutLst2)) THEN - ALLOCATE(DstParamData%MoutLst2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MoutLst2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%MoutLst2,1), UBOUND(SrcParamData%MoutLst2,1) - CALL SD_Copymeshauxdatatype( SrcParamData%MoutLst2(i1), DstParamData%MoutLst2(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%MoutLst3)) THEN - i1_l = LBOUND(SrcParamData%MoutLst3,1) - i1_u = UBOUND(SrcParamData%MoutLst3,1) - IF (.NOT. ALLOCATED(DstParamData%MoutLst3)) THEN - ALLOCATE(DstParamData%MoutLst3(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MoutLst3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%MoutLst3,1), UBOUND(SrcParamData%MoutLst3,1) - CALL SD_Copymeshauxdatatype( SrcParamData%MoutLst3(i1), DstParamData%MoutLst3(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%OutParam)) THEN - i1_l = LBOUND(SrcParamData%OutParam,1) - i1_u = UBOUND(SrcParamData%OutParam,1) - IF (.NOT. ALLOCATED(DstParamData%OutParam)) THEN - ALLOCATE(DstParamData%OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%OutParam,1), UBOUND(SrcParamData%OutParam,1) - CALL NWTC_Library_Copyoutparmtype( SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstParamData%OutAll = SrcParamData%OutAll - DstParamData%OutCBModes = SrcParamData%OutCBModes - DstParamData%OutFEMModes = SrcParamData%OutFEMModes - DstParamData%OutReact = SrcParamData%OutReact - DstParamData%OutAllInt = SrcParamData%OutAllInt - DstParamData%OutAllDims = SrcParamData%OutAllDims - DstParamData%OutDec = SrcParamData%OutDec -IF (ALLOCATED(SrcParamData%Jac_u_indx)) THEN - i1_l = LBOUND(SrcParamData%Jac_u_indx,1) - i1_u = UBOUND(SrcParamData%Jac_u_indx,1) - i2_l = LBOUND(SrcParamData%Jac_u_indx,2) - i2_u = UBOUND(SrcParamData%Jac_u_indx,2) - IF (.NOT. ALLOCATED(DstParamData%Jac_u_indx)) THEN - ALLOCATE(DstParamData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx -ENDIF -IF (ALLOCATED(SrcParamData%du)) THEN - i1_l = LBOUND(SrcParamData%du,1) - i1_u = UBOUND(SrcParamData%du,1) - IF (.NOT. ALLOCATED(DstParamData%du)) THEN - ALLOCATE(DstParamData%du(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%du = SrcParamData%du -ENDIF - DstParamData%dx = SrcParamData%dx - DstParamData%Jac_ny = SrcParamData%Jac_ny - DstParamData%Jac_nx = SrcParamData%Jac_nx - DstParamData%RotStates = SrcParamData%RotStates - END SUBROUTINE SD_CopyParam - SUBROUTINE SD_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(SD_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%Elems)) THEN - DEALLOCATE(ParamData%Elems) -ENDIF -IF (ALLOCATED(ParamData%ElemProps)) THEN -DO i1 = LBOUND(ParamData%ElemProps,1), UBOUND(ParamData%ElemProps,1) - CALL SD_DestroyElemPropType( ParamData%ElemProps(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%ElemProps) -ENDIF -IF (ALLOCATED(ParamData%FG)) THEN - DEALLOCATE(ParamData%FG) -ENDIF -IF (ALLOCATED(ParamData%DP0)) THEN - DEALLOCATE(ParamData%DP0) -ENDIF -IF (ALLOCATED(ParamData%NodeID2JointID)) THEN - DEALLOCATE(ParamData%NodeID2JointID) -ENDIF -IF (ALLOCATED(ParamData%T_red)) THEN - DEALLOCATE(ParamData%T_red) -ENDIF -IF (ALLOCATED(ParamData%T_red_T)) THEN - DEALLOCATE(ParamData%T_red_T) -ENDIF -IF (ALLOCATED(ParamData%NodesDOF)) THEN -DO i1 = LBOUND(ParamData%NodesDOF,1), UBOUND(ParamData%NodesDOF,1) - CALL SD_DestroyIList( ParamData%NodesDOF(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%NodesDOF) -ENDIF -IF (ALLOCATED(ParamData%NodesDOFred)) THEN -DO i1 = LBOUND(ParamData%NodesDOFred,1), UBOUND(ParamData%NodesDOFred,1) - CALL SD_DestroyIList( ParamData%NodesDOFred(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%NodesDOFred) -ENDIF -IF (ALLOCATED(ParamData%ElemsDOF)) THEN - DEALLOCATE(ParamData%ElemsDOF) -ENDIF -IF (ALLOCATED(ParamData%DOFred2Nodes)) THEN - DEALLOCATE(ParamData%DOFred2Nodes) -ENDIF -IF (ALLOCATED(ParamData%CtrlElem2Channel)) THEN - DEALLOCATE(ParamData%CtrlElem2Channel) -ENDIF -IF (ALLOCATED(ParamData%KMMDiag)) THEN - DEALLOCATE(ParamData%KMMDiag) -ENDIF -IF (ALLOCATED(ParamData%CMMDiag)) THEN - DEALLOCATE(ParamData%CMMDiag) -ENDIF -IF (ALLOCATED(ParamData%MMB)) THEN - DEALLOCATE(ParamData%MMB) -ENDIF -IF (ALLOCATED(ParamData%MBmmB)) THEN - DEALLOCATE(ParamData%MBmmB) -ENDIF -IF (ALLOCATED(ParamData%C1_11)) THEN - DEALLOCATE(ParamData%C1_11) -ENDIF -IF (ALLOCATED(ParamData%C1_12)) THEN - DEALLOCATE(ParamData%C1_12) -ENDIF -IF (ALLOCATED(ParamData%D1_141)) THEN - DEALLOCATE(ParamData%D1_141) -ENDIF -IF (ALLOCATED(ParamData%D1_142)) THEN - DEALLOCATE(ParamData%D1_142) -ENDIF -IF (ALLOCATED(ParamData%PhiM)) THEN - DEALLOCATE(ParamData%PhiM) -ENDIF -IF (ALLOCATED(ParamData%C2_61)) THEN - DEALLOCATE(ParamData%C2_61) -ENDIF -IF (ALLOCATED(ParamData%C2_62)) THEN - DEALLOCATE(ParamData%C2_62) -ENDIF -IF (ALLOCATED(ParamData%PhiRb_TI)) THEN - DEALLOCATE(ParamData%PhiRb_TI) -ENDIF -IF (ALLOCATED(ParamData%D2_63)) THEN - DEALLOCATE(ParamData%D2_63) -ENDIF -IF (ALLOCATED(ParamData%D2_64)) THEN - DEALLOCATE(ParamData%D2_64) -ENDIF -IF (ALLOCATED(ParamData%MBB)) THEN - DEALLOCATE(ParamData%MBB) -ENDIF -IF (ALLOCATED(ParamData%KBB)) THEN - DEALLOCATE(ParamData%KBB) -ENDIF -IF (ALLOCATED(ParamData%CBB)) THEN - DEALLOCATE(ParamData%CBB) -ENDIF -IF (ALLOCATED(ParamData%CMM)) THEN - DEALLOCATE(ParamData%CMM) -ENDIF -IF (ALLOCATED(ParamData%MBM)) THEN - DEALLOCATE(ParamData%MBM) -ENDIF -IF (ALLOCATED(ParamData%PhiL_T)) THEN - DEALLOCATE(ParamData%PhiL_T) -ENDIF -IF (ALLOCATED(ParamData%PhiLInvOmgL2)) THEN - DEALLOCATE(ParamData%PhiLInvOmgL2) -ENDIF -IF (ALLOCATED(ParamData%KLLm1)) THEN - DEALLOCATE(ParamData%KLLm1) -ENDIF -IF (ALLOCATED(ParamData%AM2Jac)) THEN - DEALLOCATE(ParamData%AM2Jac) -ENDIF -IF (ALLOCATED(ParamData%AM2JacPiv)) THEN - DEALLOCATE(ParamData%AM2JacPiv) -ENDIF -IF (ALLOCATED(ParamData%TI)) THEN - DEALLOCATE(ParamData%TI) -ENDIF -IF (ALLOCATED(ParamData%TIreact)) THEN - DEALLOCATE(ParamData%TIreact) -ENDIF -IF (ALLOCATED(ParamData%Nodes_I)) THEN - DEALLOCATE(ParamData%Nodes_I) -ENDIF -IF (ALLOCATED(ParamData%Nodes_L)) THEN - DEALLOCATE(ParamData%Nodes_L) -ENDIF -IF (ALLOCATED(ParamData%Nodes_C)) THEN - DEALLOCATE(ParamData%Nodes_C) -ENDIF -IF (ALLOCATED(ParamData%IDI__)) THEN - DEALLOCATE(ParamData%IDI__) -ENDIF -IF (ALLOCATED(ParamData%IDI_Rb)) THEN - DEALLOCATE(ParamData%IDI_Rb) -ENDIF -IF (ALLOCATED(ParamData%IDI_F)) THEN - DEALLOCATE(ParamData%IDI_F) -ENDIF -IF (ALLOCATED(ParamData%IDL_L)) THEN - DEALLOCATE(ParamData%IDL_L) -ENDIF -IF (ALLOCATED(ParamData%IDC__)) THEN - DEALLOCATE(ParamData%IDC__) -ENDIF -IF (ALLOCATED(ParamData%IDC_Rb)) THEN - DEALLOCATE(ParamData%IDC_Rb) -ENDIF -IF (ALLOCATED(ParamData%IDC_L)) THEN - DEALLOCATE(ParamData%IDC_L) -ENDIF -IF (ALLOCATED(ParamData%IDC_F)) THEN - DEALLOCATE(ParamData%IDC_F) -ENDIF -IF (ALLOCATED(ParamData%IDR__)) THEN - DEALLOCATE(ParamData%IDR__) -ENDIF -IF (ALLOCATED(ParamData%ID__Rb)) THEN - DEALLOCATE(ParamData%ID__Rb) -ENDIF -IF (ALLOCATED(ParamData%ID__L)) THEN - DEALLOCATE(ParamData%ID__L) -ENDIF -IF (ALLOCATED(ParamData%ID__F)) THEN - DEALLOCATE(ParamData%ID__F) -ENDIF -IF (ALLOCATED(ParamData%MoutLst)) THEN -DO i1 = LBOUND(ParamData%MoutLst,1), UBOUND(ParamData%MoutLst,1) - CALL SD_DestroyMeshAuxDataType( ParamData%MoutLst(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%MoutLst) -ENDIF -IF (ALLOCATED(ParamData%MoutLst2)) THEN -DO i1 = LBOUND(ParamData%MoutLst2,1), UBOUND(ParamData%MoutLst2,1) - CALL SD_DestroyMeshAuxDataType( ParamData%MoutLst2(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%MoutLst2) -ENDIF -IF (ALLOCATED(ParamData%MoutLst3)) THEN -DO i1 = LBOUND(ParamData%MoutLst3,1), UBOUND(ParamData%MoutLst3,1) - CALL SD_DestroyMeshAuxDataType( ParamData%MoutLst3(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%MoutLst3) -ENDIF -IF (ALLOCATED(ParamData%OutParam)) THEN -DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_DestroyOutParmType( ParamData%OutParam(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%OutParam) -ENDIF -IF (ALLOCATED(ParamData%Jac_u_indx)) THEN - DEALLOCATE(ParamData%Jac_u_indx) -ENDIF -IF (ALLOCATED(ParamData%du)) THEN - DEALLOCATE(ParamData%du) -ENDIF - END SUBROUTINE SD_DestroyParam +subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(SD_ParameterType), intent(in) :: SrcParamData + type(SD_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SD_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%SDDeltaT = SrcParamData%SDDeltaT + DstParamData%IntMethod = SrcParamData%IntMethod + DstParamData%nDOF = SrcParamData%nDOF + DstParamData%nDOF_red = SrcParamData%nDOF_red + DstParamData%Nmembers = SrcParamData%Nmembers + if (allocated(SrcParamData%Elems)) then + LB(1:2) = lbound(SrcParamData%Elems) + UB(1:2) = ubound(SrcParamData%Elems) + if (.not. allocated(DstParamData%Elems)) then + allocate(DstParamData%Elems(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Elems.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Elems = SrcParamData%Elems + else if (allocated(DstParamData%Elems)) then + deallocate(DstParamData%Elems) + end if + if (allocated(SrcParamData%ElemProps)) then + LB(1:1) = lbound(SrcParamData%ElemProps) + UB(1:1) = ubound(SrcParamData%ElemProps) + if (.not. allocated(DstParamData%ElemProps)) then + allocate(DstParamData%ElemProps(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ElemProps.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SD_CopyElemPropType(SrcParamData%ElemProps(i1), DstParamData%ElemProps(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstParamData%ElemProps)) then + deallocate(DstParamData%ElemProps) + end if + if (allocated(SrcParamData%FG)) then + LB(1:1) = lbound(SrcParamData%FG) + UB(1:1) = ubound(SrcParamData%FG) + if (.not. allocated(DstParamData%FG)) then + allocate(DstParamData%FG(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FG.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%FG = SrcParamData%FG + else if (allocated(DstParamData%FG)) then + deallocate(DstParamData%FG) + end if + if (allocated(SrcParamData%DP0)) then + LB(1:2) = lbound(SrcParamData%DP0) + UB(1:2) = ubound(SrcParamData%DP0) + if (.not. allocated(DstParamData%DP0)) then + allocate(DstParamData%DP0(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DP0.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%DP0 = SrcParamData%DP0 + else if (allocated(DstParamData%DP0)) then + deallocate(DstParamData%DP0) + end if + if (allocated(SrcParamData%NodeID2JointID)) then + LB(1:1) = lbound(SrcParamData%NodeID2JointID) + UB(1:1) = ubound(SrcParamData%NodeID2JointID) + if (.not. allocated(DstParamData%NodeID2JointID)) then + allocate(DstParamData%NodeID2JointID(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NodeID2JointID.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%NodeID2JointID = SrcParamData%NodeID2JointID + else if (allocated(DstParamData%NodeID2JointID)) then + deallocate(DstParamData%NodeID2JointID) + end if + DstParamData%reduced = SrcParamData%reduced + if (allocated(SrcParamData%T_red)) then + LB(1:2) = lbound(SrcParamData%T_red) + UB(1:2) = ubound(SrcParamData%T_red) + if (.not. allocated(DstParamData%T_red)) then + allocate(DstParamData%T_red(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%T_red.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%T_red = SrcParamData%T_red + else if (allocated(DstParamData%T_red)) then + deallocate(DstParamData%T_red) + end if + if (allocated(SrcParamData%T_red_T)) then + LB(1:2) = lbound(SrcParamData%T_red_T) + UB(1:2) = ubound(SrcParamData%T_red_T) + if (.not. allocated(DstParamData%T_red_T)) then + allocate(DstParamData%T_red_T(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%T_red_T.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%T_red_T = SrcParamData%T_red_T + else if (allocated(DstParamData%T_red_T)) then + deallocate(DstParamData%T_red_T) + end if + if (allocated(SrcParamData%NodesDOF)) then + LB(1:1) = lbound(SrcParamData%NodesDOF) + UB(1:1) = ubound(SrcParamData%NodesDOF) + if (.not. allocated(DstParamData%NodesDOF)) then + allocate(DstParamData%NodesDOF(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NodesDOF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SD_CopyIList(SrcParamData%NodesDOF(i1), DstParamData%NodesDOF(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstParamData%NodesDOF)) then + deallocate(DstParamData%NodesDOF) + end if + if (allocated(SrcParamData%NodesDOFred)) then + LB(1:1) = lbound(SrcParamData%NodesDOFred) + UB(1:1) = ubound(SrcParamData%NodesDOFred) + if (.not. allocated(DstParamData%NodesDOFred)) then + allocate(DstParamData%NodesDOFred(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NodesDOFred.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SD_CopyIList(SrcParamData%NodesDOFred(i1), DstParamData%NodesDOFred(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstParamData%NodesDOFred)) then + deallocate(DstParamData%NodesDOFred) + end if + if (allocated(SrcParamData%ElemsDOF)) then + LB(1:2) = lbound(SrcParamData%ElemsDOF) + UB(1:2) = ubound(SrcParamData%ElemsDOF) + if (.not. allocated(DstParamData%ElemsDOF)) then + allocate(DstParamData%ElemsDOF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ElemsDOF.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%ElemsDOF = SrcParamData%ElemsDOF + else if (allocated(DstParamData%ElemsDOF)) then + deallocate(DstParamData%ElemsDOF) + end if + if (allocated(SrcParamData%DOFred2Nodes)) then + LB(1:2) = lbound(SrcParamData%DOFred2Nodes) + UB(1:2) = ubound(SrcParamData%DOFred2Nodes) + if (.not. allocated(DstParamData%DOFred2Nodes)) then + allocate(DstParamData%DOFred2Nodes(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DOFred2Nodes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%DOFred2Nodes = SrcParamData%DOFred2Nodes + else if (allocated(DstParamData%DOFred2Nodes)) then + deallocate(DstParamData%DOFred2Nodes) + end if + if (allocated(SrcParamData%CtrlElem2Channel)) then + LB(1:2) = lbound(SrcParamData%CtrlElem2Channel) + UB(1:2) = ubound(SrcParamData%CtrlElem2Channel) + if (.not. allocated(DstParamData%CtrlElem2Channel)) then + allocate(DstParamData%CtrlElem2Channel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CtrlElem2Channel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%CtrlElem2Channel = SrcParamData%CtrlElem2Channel + else if (allocated(DstParamData%CtrlElem2Channel)) then + deallocate(DstParamData%CtrlElem2Channel) + end if + DstParamData%nDOFM = SrcParamData%nDOFM + DstParamData%SttcSolve = SrcParamData%SttcSolve + DstParamData%GuyanLoadCorrection = SrcParamData%GuyanLoadCorrection + DstParamData%Floating = SrcParamData%Floating + if (allocated(SrcParamData%KMMDiag)) then + LB(1:1) = lbound(SrcParamData%KMMDiag) + UB(1:1) = ubound(SrcParamData%KMMDiag) + if (.not. allocated(DstParamData%KMMDiag)) then + allocate(DstParamData%KMMDiag(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KMMDiag.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%KMMDiag = SrcParamData%KMMDiag + else if (allocated(DstParamData%KMMDiag)) then + deallocate(DstParamData%KMMDiag) + end if + if (allocated(SrcParamData%CMMDiag)) then + LB(1:1) = lbound(SrcParamData%CMMDiag) + UB(1:1) = ubound(SrcParamData%CMMDiag) + if (.not. allocated(DstParamData%CMMDiag)) then + allocate(DstParamData%CMMDiag(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CMMDiag.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%CMMDiag = SrcParamData%CMMDiag + else if (allocated(DstParamData%CMMDiag)) then + deallocate(DstParamData%CMMDiag) + end if + if (allocated(SrcParamData%MMB)) then + LB(1:2) = lbound(SrcParamData%MMB) + UB(1:2) = ubound(SrcParamData%MMB) + if (.not. allocated(DstParamData%MMB)) then + allocate(DstParamData%MMB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MMB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%MMB = SrcParamData%MMB + else if (allocated(DstParamData%MMB)) then + deallocate(DstParamData%MMB) + end if + if (allocated(SrcParamData%MBmmB)) then + LB(1:2) = lbound(SrcParamData%MBmmB) + UB(1:2) = ubound(SrcParamData%MBmmB) + if (.not. allocated(DstParamData%MBmmB)) then + allocate(DstParamData%MBmmB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MBmmB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%MBmmB = SrcParamData%MBmmB + else if (allocated(DstParamData%MBmmB)) then + deallocate(DstParamData%MBmmB) + end if + if (allocated(SrcParamData%C1_11)) then + LB(1:2) = lbound(SrcParamData%C1_11) + UB(1:2) = ubound(SrcParamData%C1_11) + if (.not. allocated(DstParamData%C1_11)) then + allocate(DstParamData%C1_11(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C1_11.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%C1_11 = SrcParamData%C1_11 + else if (allocated(DstParamData%C1_11)) then + deallocate(DstParamData%C1_11) + end if + if (allocated(SrcParamData%C1_12)) then + LB(1:2) = lbound(SrcParamData%C1_12) + UB(1:2) = ubound(SrcParamData%C1_12) + if (.not. allocated(DstParamData%C1_12)) then + allocate(DstParamData%C1_12(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C1_12.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%C1_12 = SrcParamData%C1_12 + else if (allocated(DstParamData%C1_12)) then + deallocate(DstParamData%C1_12) + end if + if (allocated(SrcParamData%D1_141)) then + LB(1:2) = lbound(SrcParamData%D1_141) + UB(1:2) = ubound(SrcParamData%D1_141) + if (.not. allocated(DstParamData%D1_141)) then + allocate(DstParamData%D1_141(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D1_141.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%D1_141 = SrcParamData%D1_141 + else if (allocated(DstParamData%D1_141)) then + deallocate(DstParamData%D1_141) + end if + if (allocated(SrcParamData%D1_142)) then + LB(1:2) = lbound(SrcParamData%D1_142) + UB(1:2) = ubound(SrcParamData%D1_142) + if (.not. allocated(DstParamData%D1_142)) then + allocate(DstParamData%D1_142(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D1_142.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%D1_142 = SrcParamData%D1_142 + else if (allocated(DstParamData%D1_142)) then + deallocate(DstParamData%D1_142) + end if + if (allocated(SrcParamData%PhiM)) then + LB(1:2) = lbound(SrcParamData%PhiM) + UB(1:2) = ubound(SrcParamData%PhiM) + if (.not. allocated(DstParamData%PhiM)) then + allocate(DstParamData%PhiM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%PhiM = SrcParamData%PhiM + else if (allocated(DstParamData%PhiM)) then + deallocate(DstParamData%PhiM) + end if + if (allocated(SrcParamData%C2_61)) then + LB(1:2) = lbound(SrcParamData%C2_61) + UB(1:2) = ubound(SrcParamData%C2_61) + if (.not. allocated(DstParamData%C2_61)) then + allocate(DstParamData%C2_61(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C2_61.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%C2_61 = SrcParamData%C2_61 + else if (allocated(DstParamData%C2_61)) then + deallocate(DstParamData%C2_61) + end if + if (allocated(SrcParamData%C2_62)) then + LB(1:2) = lbound(SrcParamData%C2_62) + UB(1:2) = ubound(SrcParamData%C2_62) + if (.not. allocated(DstParamData%C2_62)) then + allocate(DstParamData%C2_62(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%C2_62.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%C2_62 = SrcParamData%C2_62 + else if (allocated(DstParamData%C2_62)) then + deallocate(DstParamData%C2_62) + end if + if (allocated(SrcParamData%PhiRb_TI)) then + LB(1:2) = lbound(SrcParamData%PhiRb_TI) + UB(1:2) = ubound(SrcParamData%PhiRb_TI) + if (.not. allocated(DstParamData%PhiRb_TI)) then + allocate(DstParamData%PhiRb_TI(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiRb_TI.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%PhiRb_TI = SrcParamData%PhiRb_TI + else if (allocated(DstParamData%PhiRb_TI)) then + deallocate(DstParamData%PhiRb_TI) + end if + if (allocated(SrcParamData%D2_63)) then + LB(1:2) = lbound(SrcParamData%D2_63) + UB(1:2) = ubound(SrcParamData%D2_63) + if (.not. allocated(DstParamData%D2_63)) then + allocate(DstParamData%D2_63(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D2_63.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%D2_63 = SrcParamData%D2_63 + else if (allocated(DstParamData%D2_63)) then + deallocate(DstParamData%D2_63) + end if + if (allocated(SrcParamData%D2_64)) then + LB(1:2) = lbound(SrcParamData%D2_64) + UB(1:2) = ubound(SrcParamData%D2_64) + if (.not. allocated(DstParamData%D2_64)) then + allocate(DstParamData%D2_64(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D2_64.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%D2_64 = SrcParamData%D2_64 + else if (allocated(DstParamData%D2_64)) then + deallocate(DstParamData%D2_64) + end if + if (allocated(SrcParamData%MBB)) then + LB(1:2) = lbound(SrcParamData%MBB) + UB(1:2) = ubound(SrcParamData%MBB) + if (.not. allocated(DstParamData%MBB)) then + allocate(DstParamData%MBB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MBB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%MBB = SrcParamData%MBB + else if (allocated(DstParamData%MBB)) then + deallocate(DstParamData%MBB) + end if + if (allocated(SrcParamData%KBB)) then + LB(1:2) = lbound(SrcParamData%KBB) + UB(1:2) = ubound(SrcParamData%KBB) + if (.not. allocated(DstParamData%KBB)) then + allocate(DstParamData%KBB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KBB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%KBB = SrcParamData%KBB + else if (allocated(DstParamData%KBB)) then + deallocate(DstParamData%KBB) + end if + if (allocated(SrcParamData%CBB)) then + LB(1:2) = lbound(SrcParamData%CBB) + UB(1:2) = ubound(SrcParamData%CBB) + if (.not. allocated(DstParamData%CBB)) then + allocate(DstParamData%CBB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CBB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%CBB = SrcParamData%CBB + else if (allocated(DstParamData%CBB)) then + deallocate(DstParamData%CBB) + end if + if (allocated(SrcParamData%CMM)) then + LB(1:2) = lbound(SrcParamData%CMM) + UB(1:2) = ubound(SrcParamData%CMM) + if (.not. allocated(DstParamData%CMM)) then + allocate(DstParamData%CMM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CMM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%CMM = SrcParamData%CMM + else if (allocated(DstParamData%CMM)) then + deallocate(DstParamData%CMM) + end if + if (allocated(SrcParamData%MBM)) then + LB(1:2) = lbound(SrcParamData%MBM) + UB(1:2) = ubound(SrcParamData%MBM) + if (.not. allocated(DstParamData%MBM)) then + allocate(DstParamData%MBM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MBM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%MBM = SrcParamData%MBM + else if (allocated(DstParamData%MBM)) then + deallocate(DstParamData%MBM) + end if + if (allocated(SrcParamData%PhiL_T)) then + LB(1:2) = lbound(SrcParamData%PhiL_T) + UB(1:2) = ubound(SrcParamData%PhiL_T) + if (.not. allocated(DstParamData%PhiL_T)) then + allocate(DstParamData%PhiL_T(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiL_T.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%PhiL_T = SrcParamData%PhiL_T + else if (allocated(DstParamData%PhiL_T)) then + deallocate(DstParamData%PhiL_T) + end if + if (allocated(SrcParamData%PhiLInvOmgL2)) then + LB(1:2) = lbound(SrcParamData%PhiLInvOmgL2) + UB(1:2) = ubound(SrcParamData%PhiLInvOmgL2) + if (.not. allocated(DstParamData%PhiLInvOmgL2)) then + allocate(DstParamData%PhiLInvOmgL2(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiLInvOmgL2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%PhiLInvOmgL2 = SrcParamData%PhiLInvOmgL2 + else if (allocated(DstParamData%PhiLInvOmgL2)) then + deallocate(DstParamData%PhiLInvOmgL2) + end if + if (allocated(SrcParamData%KLLm1)) then + LB(1:2) = lbound(SrcParamData%KLLm1) + UB(1:2) = ubound(SrcParamData%KLLm1) + if (.not. allocated(DstParamData%KLLm1)) then + allocate(DstParamData%KLLm1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KLLm1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%KLLm1 = SrcParamData%KLLm1 + else if (allocated(DstParamData%KLLm1)) then + deallocate(DstParamData%KLLm1) + end if + if (allocated(SrcParamData%AM2Jac)) then + LB(1:2) = lbound(SrcParamData%AM2Jac) + UB(1:2) = ubound(SrcParamData%AM2Jac) + if (.not. allocated(DstParamData%AM2Jac)) then + allocate(DstParamData%AM2Jac(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AM2Jac.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AM2Jac = SrcParamData%AM2Jac + else if (allocated(DstParamData%AM2Jac)) then + deallocate(DstParamData%AM2Jac) + end if + if (allocated(SrcParamData%AM2JacPiv)) then + LB(1:1) = lbound(SrcParamData%AM2JacPiv) + UB(1:1) = ubound(SrcParamData%AM2JacPiv) + if (.not. allocated(DstParamData%AM2JacPiv)) then + allocate(DstParamData%AM2JacPiv(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AM2JacPiv.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AM2JacPiv = SrcParamData%AM2JacPiv + else if (allocated(DstParamData%AM2JacPiv)) then + deallocate(DstParamData%AM2JacPiv) + end if + if (allocated(SrcParamData%TI)) then + LB(1:2) = lbound(SrcParamData%TI) + UB(1:2) = ubound(SrcParamData%TI) + if (.not. allocated(DstParamData%TI)) then + allocate(DstParamData%TI(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TI.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%TI = SrcParamData%TI + else if (allocated(DstParamData%TI)) then + deallocate(DstParamData%TI) + end if + if (allocated(SrcParamData%TIreact)) then + LB(1:2) = lbound(SrcParamData%TIreact) + UB(1:2) = ubound(SrcParamData%TIreact) + if (.not. allocated(DstParamData%TIreact)) then + allocate(DstParamData%TIreact(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TIreact.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%TIreact = SrcParamData%TIreact + else if (allocated(DstParamData%TIreact)) then + deallocate(DstParamData%TIreact) + end if + DstParamData%nNodes = SrcParamData%nNodes + DstParamData%nNodes_I = SrcParamData%nNodes_I + DstParamData%nNodes_L = SrcParamData%nNodes_L + DstParamData%nNodes_C = SrcParamData%nNodes_C + if (allocated(SrcParamData%Nodes_I)) then + LB(1:2) = lbound(SrcParamData%Nodes_I) + UB(1:2) = ubound(SrcParamData%Nodes_I) + if (.not. allocated(DstParamData%Nodes_I)) then + allocate(DstParamData%Nodes_I(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Nodes_I.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Nodes_I = SrcParamData%Nodes_I + else if (allocated(DstParamData%Nodes_I)) then + deallocate(DstParamData%Nodes_I) + end if + if (allocated(SrcParamData%Nodes_L)) then + LB(1:2) = lbound(SrcParamData%Nodes_L) + UB(1:2) = ubound(SrcParamData%Nodes_L) + if (.not. allocated(DstParamData%Nodes_L)) then + allocate(DstParamData%Nodes_L(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Nodes_L.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Nodes_L = SrcParamData%Nodes_L + else if (allocated(DstParamData%Nodes_L)) then + deallocate(DstParamData%Nodes_L) + end if + if (allocated(SrcParamData%Nodes_C)) then + LB(1:2) = lbound(SrcParamData%Nodes_C) + UB(1:2) = ubound(SrcParamData%Nodes_C) + if (.not. allocated(DstParamData%Nodes_C)) then + allocate(DstParamData%Nodes_C(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Nodes_C.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Nodes_C = SrcParamData%Nodes_C + else if (allocated(DstParamData%Nodes_C)) then + deallocate(DstParamData%Nodes_C) + end if + DstParamData%nDOFI__ = SrcParamData%nDOFI__ + DstParamData%nDOFI_Rb = SrcParamData%nDOFI_Rb + DstParamData%nDOFI_F = SrcParamData%nDOFI_F + DstParamData%nDOFL_L = SrcParamData%nDOFL_L + DstParamData%nDOFC__ = SrcParamData%nDOFC__ + DstParamData%nDOFC_Rb = SrcParamData%nDOFC_Rb + DstParamData%nDOFC_L = SrcParamData%nDOFC_L + DstParamData%nDOFC_F = SrcParamData%nDOFC_F + DstParamData%nDOFR__ = SrcParamData%nDOFR__ + DstParamData%nDOF__Rb = SrcParamData%nDOF__Rb + DstParamData%nDOF__L = SrcParamData%nDOF__L + DstParamData%nDOF__F = SrcParamData%nDOF__F + if (allocated(SrcParamData%IDI__)) then + LB(1:1) = lbound(SrcParamData%IDI__) + UB(1:1) = ubound(SrcParamData%IDI__) + if (.not. allocated(DstParamData%IDI__)) then + allocate(DstParamData%IDI__(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDI__.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%IDI__ = SrcParamData%IDI__ + else if (allocated(DstParamData%IDI__)) then + deallocate(DstParamData%IDI__) + end if + if (allocated(SrcParamData%IDI_Rb)) then + LB(1:1) = lbound(SrcParamData%IDI_Rb) + UB(1:1) = ubound(SrcParamData%IDI_Rb) + if (.not. allocated(DstParamData%IDI_Rb)) then + allocate(DstParamData%IDI_Rb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDI_Rb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%IDI_Rb = SrcParamData%IDI_Rb + else if (allocated(DstParamData%IDI_Rb)) then + deallocate(DstParamData%IDI_Rb) + end if + if (allocated(SrcParamData%IDI_F)) then + LB(1:1) = lbound(SrcParamData%IDI_F) + UB(1:1) = ubound(SrcParamData%IDI_F) + if (.not. allocated(DstParamData%IDI_F)) then + allocate(DstParamData%IDI_F(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDI_F.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%IDI_F = SrcParamData%IDI_F + else if (allocated(DstParamData%IDI_F)) then + deallocate(DstParamData%IDI_F) + end if + if (allocated(SrcParamData%IDL_L)) then + LB(1:1) = lbound(SrcParamData%IDL_L) + UB(1:1) = ubound(SrcParamData%IDL_L) + if (.not. allocated(DstParamData%IDL_L)) then + allocate(DstParamData%IDL_L(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDL_L.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%IDL_L = SrcParamData%IDL_L + else if (allocated(DstParamData%IDL_L)) then + deallocate(DstParamData%IDL_L) + end if + if (allocated(SrcParamData%IDC__)) then + LB(1:1) = lbound(SrcParamData%IDC__) + UB(1:1) = ubound(SrcParamData%IDC__) + if (.not. allocated(DstParamData%IDC__)) then + allocate(DstParamData%IDC__(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC__.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%IDC__ = SrcParamData%IDC__ + else if (allocated(DstParamData%IDC__)) then + deallocate(DstParamData%IDC__) + end if + if (allocated(SrcParamData%IDC_Rb)) then + LB(1:1) = lbound(SrcParamData%IDC_Rb) + UB(1:1) = ubound(SrcParamData%IDC_Rb) + if (.not. allocated(DstParamData%IDC_Rb)) then + allocate(DstParamData%IDC_Rb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC_Rb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%IDC_Rb = SrcParamData%IDC_Rb + else if (allocated(DstParamData%IDC_Rb)) then + deallocate(DstParamData%IDC_Rb) + end if + if (allocated(SrcParamData%IDC_L)) then + LB(1:1) = lbound(SrcParamData%IDC_L) + UB(1:1) = ubound(SrcParamData%IDC_L) + if (.not. allocated(DstParamData%IDC_L)) then + allocate(DstParamData%IDC_L(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC_L.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%IDC_L = SrcParamData%IDC_L + else if (allocated(DstParamData%IDC_L)) then + deallocate(DstParamData%IDC_L) + end if + if (allocated(SrcParamData%IDC_F)) then + LB(1:1) = lbound(SrcParamData%IDC_F) + UB(1:1) = ubound(SrcParamData%IDC_F) + if (.not. allocated(DstParamData%IDC_F)) then + allocate(DstParamData%IDC_F(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC_F.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%IDC_F = SrcParamData%IDC_F + else if (allocated(DstParamData%IDC_F)) then + deallocate(DstParamData%IDC_F) + end if + if (allocated(SrcParamData%IDR__)) then + LB(1:1) = lbound(SrcParamData%IDR__) + UB(1:1) = ubound(SrcParamData%IDR__) + if (.not. allocated(DstParamData%IDR__)) then + allocate(DstParamData%IDR__(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDR__.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%IDR__ = SrcParamData%IDR__ + else if (allocated(DstParamData%IDR__)) then + deallocate(DstParamData%IDR__) + end if + if (allocated(SrcParamData%ID__Rb)) then + LB(1:1) = lbound(SrcParamData%ID__Rb) + UB(1:1) = ubound(SrcParamData%ID__Rb) + if (.not. allocated(DstParamData%ID__Rb)) then + allocate(DstParamData%ID__Rb(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ID__Rb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%ID__Rb = SrcParamData%ID__Rb + else if (allocated(DstParamData%ID__Rb)) then + deallocate(DstParamData%ID__Rb) + end if + if (allocated(SrcParamData%ID__L)) then + LB(1:1) = lbound(SrcParamData%ID__L) + UB(1:1) = ubound(SrcParamData%ID__L) + if (.not. allocated(DstParamData%ID__L)) then + allocate(DstParamData%ID__L(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ID__L.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%ID__L = SrcParamData%ID__L + else if (allocated(DstParamData%ID__L)) then + deallocate(DstParamData%ID__L) + end if + if (allocated(SrcParamData%ID__F)) then + LB(1:1) = lbound(SrcParamData%ID__F) + UB(1:1) = ubound(SrcParamData%ID__F) + if (.not. allocated(DstParamData%ID__F)) then + allocate(DstParamData%ID__F(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ID__F.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%ID__F = SrcParamData%ID__F + else if (allocated(DstParamData%ID__F)) then + deallocate(DstParamData%ID__F) + end if + DstParamData%NMOutputs = SrcParamData%NMOutputs + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%OutSwtch = SrcParamData%OutSwtch + DstParamData%UnJckF = SrcParamData%UnJckF + DstParamData%Delim = SrcParamData%Delim + DstParamData%OutFmt = SrcParamData%OutFmt + DstParamData%OutSFmt = SrcParamData%OutSFmt + if (allocated(SrcParamData%MoutLst)) then + LB(1:1) = lbound(SrcParamData%MoutLst) + UB(1:1) = ubound(SrcParamData%MoutLst) + if (.not. allocated(DstParamData%MoutLst)) then + allocate(DstParamData%MoutLst(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MoutLst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SD_CopyMeshAuxDataType(SrcParamData%MoutLst(i1), DstParamData%MoutLst(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstParamData%MoutLst)) then + deallocate(DstParamData%MoutLst) + end if + if (allocated(SrcParamData%MoutLst2)) then + LB(1:1) = lbound(SrcParamData%MoutLst2) + UB(1:1) = ubound(SrcParamData%MoutLst2) + if (.not. allocated(DstParamData%MoutLst2)) then + allocate(DstParamData%MoutLst2(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MoutLst2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SD_CopyMeshAuxDataType(SrcParamData%MoutLst2(i1), DstParamData%MoutLst2(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstParamData%MoutLst2)) then + deallocate(DstParamData%MoutLst2) + end if + if (allocated(SrcParamData%MoutLst3)) then + LB(1:1) = lbound(SrcParamData%MoutLst3) + UB(1:1) = ubound(SrcParamData%MoutLst3) + if (.not. allocated(DstParamData%MoutLst3)) then + allocate(DstParamData%MoutLst3(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MoutLst3.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SD_CopyMeshAuxDataType(SrcParamData%MoutLst3(i1), DstParamData%MoutLst3(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstParamData%MoutLst3)) then + deallocate(DstParamData%MoutLst3) + end if + if (allocated(SrcParamData%OutParam)) then + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + else if (allocated(DstParamData%OutParam)) then + deallocate(DstParamData%OutParam) + end if + DstParamData%OutAll = SrcParamData%OutAll + DstParamData%OutCBModes = SrcParamData%OutCBModes + DstParamData%OutFEMModes = SrcParamData%OutFEMModes + DstParamData%OutReact = SrcParamData%OutReact + DstParamData%OutAllInt = SrcParamData%OutAllInt + DstParamData%OutAllDims = SrcParamData%OutAllDims + DstParamData%OutDec = SrcParamData%OutDec + if (allocated(SrcParamData%Jac_u_indx)) then + LB(1:2) = lbound(SrcParamData%Jac_u_indx) + UB(1:2) = ubound(SrcParamData%Jac_u_indx) + if (.not. allocated(DstParamData%Jac_u_indx)) then + allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx + else if (allocated(DstParamData%Jac_u_indx)) then + deallocate(DstParamData%Jac_u_indx) + end if + if (allocated(SrcParamData%du)) then + LB(1:1) = lbound(SrcParamData%du) + UB(1:1) = ubound(SrcParamData%du) + if (.not. allocated(DstParamData%du)) then + allocate(DstParamData%du(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%du = SrcParamData%du + else if (allocated(DstParamData%du)) then + deallocate(DstParamData%du) + end if + DstParamData%dx = SrcParamData%dx + DstParamData%Jac_ny = SrcParamData%Jac_ny + DstParamData%Jac_nx = SrcParamData%Jac_nx + DstParamData%RotStates = SrcParamData%RotStates +end subroutine +subroutine SD_DestroyParam(ParamData, ErrStat, ErrMsg) + type(SD_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i1, i2 + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SD_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%Elems)) then + deallocate(ParamData%Elems) + end if + if (allocated(ParamData%ElemProps)) then + LB(1:1) = lbound(ParamData%ElemProps) + UB(1:1) = ubound(ParamData%ElemProps) + do i1 = LB(1), UB(1) + call SD_DestroyElemPropType(ParamData%ElemProps(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%ElemProps) + end if + if (allocated(ParamData%FG)) then + deallocate(ParamData%FG) + end if + if (allocated(ParamData%DP0)) then + deallocate(ParamData%DP0) + end if + if (allocated(ParamData%NodeID2JointID)) then + deallocate(ParamData%NodeID2JointID) + end if + if (allocated(ParamData%T_red)) then + deallocate(ParamData%T_red) + end if + if (allocated(ParamData%T_red_T)) then + deallocate(ParamData%T_red_T) + end if + if (allocated(ParamData%NodesDOF)) then + LB(1:1) = lbound(ParamData%NodesDOF) + UB(1:1) = ubound(ParamData%NodesDOF) + do i1 = LB(1), UB(1) + call SD_DestroyIList(ParamData%NodesDOF(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%NodesDOF) + end if + if (allocated(ParamData%NodesDOFred)) then + LB(1:1) = lbound(ParamData%NodesDOFred) + UB(1:1) = ubound(ParamData%NodesDOFred) + do i1 = LB(1), UB(1) + call SD_DestroyIList(ParamData%NodesDOFred(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%NodesDOFred) + end if + if (allocated(ParamData%ElemsDOF)) then + deallocate(ParamData%ElemsDOF) + end if + if (allocated(ParamData%DOFred2Nodes)) then + deallocate(ParamData%DOFred2Nodes) + end if + if (allocated(ParamData%CtrlElem2Channel)) then + deallocate(ParamData%CtrlElem2Channel) + end if + if (allocated(ParamData%KMMDiag)) then + deallocate(ParamData%KMMDiag) + end if + if (allocated(ParamData%CMMDiag)) then + deallocate(ParamData%CMMDiag) + end if + if (allocated(ParamData%MMB)) then + deallocate(ParamData%MMB) + end if + if (allocated(ParamData%MBmmB)) then + deallocate(ParamData%MBmmB) + end if + if (allocated(ParamData%C1_11)) then + deallocate(ParamData%C1_11) + end if + if (allocated(ParamData%C1_12)) then + deallocate(ParamData%C1_12) + end if + if (allocated(ParamData%D1_141)) then + deallocate(ParamData%D1_141) + end if + if (allocated(ParamData%D1_142)) then + deallocate(ParamData%D1_142) + end if + if (allocated(ParamData%PhiM)) then + deallocate(ParamData%PhiM) + end if + if (allocated(ParamData%C2_61)) then + deallocate(ParamData%C2_61) + end if + if (allocated(ParamData%C2_62)) then + deallocate(ParamData%C2_62) + end if + if (allocated(ParamData%PhiRb_TI)) then + deallocate(ParamData%PhiRb_TI) + end if + if (allocated(ParamData%D2_63)) then + deallocate(ParamData%D2_63) + end if + if (allocated(ParamData%D2_64)) then + deallocate(ParamData%D2_64) + end if + if (allocated(ParamData%MBB)) then + deallocate(ParamData%MBB) + end if + if (allocated(ParamData%KBB)) then + deallocate(ParamData%KBB) + end if + if (allocated(ParamData%CBB)) then + deallocate(ParamData%CBB) + end if + if (allocated(ParamData%CMM)) then + deallocate(ParamData%CMM) + end if + if (allocated(ParamData%MBM)) then + deallocate(ParamData%MBM) + end if + if (allocated(ParamData%PhiL_T)) then + deallocate(ParamData%PhiL_T) + end if + if (allocated(ParamData%PhiLInvOmgL2)) then + deallocate(ParamData%PhiLInvOmgL2) + end if + if (allocated(ParamData%KLLm1)) then + deallocate(ParamData%KLLm1) + end if + if (allocated(ParamData%AM2Jac)) then + deallocate(ParamData%AM2Jac) + end if + if (allocated(ParamData%AM2JacPiv)) then + deallocate(ParamData%AM2JacPiv) + end if + if (allocated(ParamData%TI)) then + deallocate(ParamData%TI) + end if + if (allocated(ParamData%TIreact)) then + deallocate(ParamData%TIreact) + end if + if (allocated(ParamData%Nodes_I)) then + deallocate(ParamData%Nodes_I) + end if + if (allocated(ParamData%Nodes_L)) then + deallocate(ParamData%Nodes_L) + end if + if (allocated(ParamData%Nodes_C)) then + deallocate(ParamData%Nodes_C) + end if + if (allocated(ParamData%IDI__)) then + deallocate(ParamData%IDI__) + end if + if (allocated(ParamData%IDI_Rb)) then + deallocate(ParamData%IDI_Rb) + end if + if (allocated(ParamData%IDI_F)) then + deallocate(ParamData%IDI_F) + end if + if (allocated(ParamData%IDL_L)) then + deallocate(ParamData%IDL_L) + end if + if (allocated(ParamData%IDC__)) then + deallocate(ParamData%IDC__) + end if + if (allocated(ParamData%IDC_Rb)) then + deallocate(ParamData%IDC_Rb) + end if + if (allocated(ParamData%IDC_L)) then + deallocate(ParamData%IDC_L) + end if + if (allocated(ParamData%IDC_F)) then + deallocate(ParamData%IDC_F) + end if + if (allocated(ParamData%IDR__)) then + deallocate(ParamData%IDR__) + end if + if (allocated(ParamData%ID__Rb)) then + deallocate(ParamData%ID__Rb) + end if + if (allocated(ParamData%ID__L)) then + deallocate(ParamData%ID__L) + end if + if (allocated(ParamData%ID__F)) then + deallocate(ParamData%ID__F) + end if + if (allocated(ParamData%MoutLst)) then + LB(1:1) = lbound(ParamData%MoutLst) + UB(1:1) = ubound(ParamData%MoutLst) + do i1 = LB(1), UB(1) + call SD_DestroyMeshAuxDataType(ParamData%MoutLst(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%MoutLst) + end if + if (allocated(ParamData%MoutLst2)) then + LB(1:1) = lbound(ParamData%MoutLst2) + UB(1:1) = ubound(ParamData%MoutLst2) + do i1 = LB(1), UB(1) + call SD_DestroyMeshAuxDataType(ParamData%MoutLst2(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%MoutLst2) + end if + if (allocated(ParamData%MoutLst3)) then + LB(1:1) = lbound(ParamData%MoutLst3) + UB(1:1) = ubound(ParamData%MoutLst3) + do i1 = LB(1), UB(1) + call SD_DestroyMeshAuxDataType(ParamData%MoutLst3(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%MoutLst3) + end if + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%OutParam) + end if + if (allocated(ParamData%Jac_u_indx)) then + deallocate(ParamData%Jac_u_indx) + end if + if (allocated(ParamData%du)) then + deallocate(ParamData%du) + end if +end subroutine subroutine SD_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -5460,29 +5198,22 @@ subroutine SD_PackParam(Buf, Indata) integer(IntKi) :: i1, i2 integer(IntKi) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return - ! SDDeltaT call RegPack(Buf, InData%SDDeltaT) if (RegCheckErr(Buf, RoutineName)) return - ! IntMethod call RegPack(Buf, InData%IntMethod) if (RegCheckErr(Buf, RoutineName)) return - ! nDOF call RegPack(Buf, InData%nDOF) if (RegCheckErr(Buf, RoutineName)) return - ! nDOF_red call RegPack(Buf, InData%nDOF_red) if (RegCheckErr(Buf, RoutineName)) return - ! Nmembers call RegPack(Buf, InData%Nmembers) if (RegCheckErr(Buf, RoutineName)) return - ! Elems call RegPack(Buf, allocated(InData%Elems)) if (allocated(InData%Elems)) then call RegPackBounds(Buf, 2, lbound(InData%Elems), ubound(InData%Elems)) call RegPack(Buf, InData%Elems) end if if (RegCheckErr(Buf, RoutineName)) return - ! ElemProps call RegPack(Buf, allocated(InData%ElemProps)) if (allocated(InData%ElemProps)) then call RegPackBounds(Buf, 1, lbound(InData%ElemProps), ubound(InData%ElemProps)) @@ -5493,45 +5224,38 @@ subroutine SD_PackParam(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! FG call RegPack(Buf, allocated(InData%FG)) if (allocated(InData%FG)) then call RegPackBounds(Buf, 1, lbound(InData%FG), ubound(InData%FG)) call RegPack(Buf, InData%FG) end if if (RegCheckErr(Buf, RoutineName)) return - ! DP0 call RegPack(Buf, allocated(InData%DP0)) if (allocated(InData%DP0)) then call RegPackBounds(Buf, 2, lbound(InData%DP0), ubound(InData%DP0)) call RegPack(Buf, InData%DP0) end if if (RegCheckErr(Buf, RoutineName)) return - ! NodeID2JointID call RegPack(Buf, allocated(InData%NodeID2JointID)) if (allocated(InData%NodeID2JointID)) then call RegPackBounds(Buf, 1, lbound(InData%NodeID2JointID), ubound(InData%NodeID2JointID)) call RegPack(Buf, InData%NodeID2JointID) end if if (RegCheckErr(Buf, RoutineName)) return - ! reduced call RegPack(Buf, InData%reduced) if (RegCheckErr(Buf, RoutineName)) return - ! T_red call RegPack(Buf, allocated(InData%T_red)) if (allocated(InData%T_red)) then call RegPackBounds(Buf, 2, lbound(InData%T_red), ubound(InData%T_red)) call RegPack(Buf, InData%T_red) end if if (RegCheckErr(Buf, RoutineName)) return - ! T_red_T call RegPack(Buf, allocated(InData%T_red_T)) if (allocated(InData%T_red_T)) then call RegPackBounds(Buf, 2, lbound(InData%T_red_T), ubound(InData%T_red_T)) call RegPack(Buf, InData%T_red_T) end if if (RegCheckErr(Buf, RoutineName)) return - ! NodesDOF call RegPack(Buf, allocated(InData%NodesDOF)) if (allocated(InData%NodesDOF)) then call RegPackBounds(Buf, 1, lbound(InData%NodesDOF), ubound(InData%NodesDOF)) @@ -5542,7 +5266,6 @@ subroutine SD_PackParam(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! NodesDOFred call RegPack(Buf, allocated(InData%NodesDOFred)) if (allocated(InData%NodesDOFred)) then call RegPackBounds(Buf, 1, lbound(InData%NodesDOFred), ubound(InData%NodesDOFred)) @@ -5553,396 +5276,324 @@ subroutine SD_PackParam(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! ElemsDOF call RegPack(Buf, allocated(InData%ElemsDOF)) if (allocated(InData%ElemsDOF)) then call RegPackBounds(Buf, 2, lbound(InData%ElemsDOF), ubound(InData%ElemsDOF)) call RegPack(Buf, InData%ElemsDOF) end if if (RegCheckErr(Buf, RoutineName)) return - ! DOFred2Nodes call RegPack(Buf, allocated(InData%DOFred2Nodes)) if (allocated(InData%DOFred2Nodes)) then call RegPackBounds(Buf, 2, lbound(InData%DOFred2Nodes), ubound(InData%DOFred2Nodes)) call RegPack(Buf, InData%DOFred2Nodes) end if if (RegCheckErr(Buf, RoutineName)) return - ! CtrlElem2Channel call RegPack(Buf, allocated(InData%CtrlElem2Channel)) if (allocated(InData%CtrlElem2Channel)) then call RegPackBounds(Buf, 2, lbound(InData%CtrlElem2Channel), ubound(InData%CtrlElem2Channel)) call RegPack(Buf, InData%CtrlElem2Channel) end if if (RegCheckErr(Buf, RoutineName)) return - ! nDOFM call RegPack(Buf, InData%nDOFM) if (RegCheckErr(Buf, RoutineName)) return - ! SttcSolve call RegPack(Buf, InData%SttcSolve) if (RegCheckErr(Buf, RoutineName)) return - ! GuyanLoadCorrection call RegPack(Buf, InData%GuyanLoadCorrection) if (RegCheckErr(Buf, RoutineName)) return - ! Floating call RegPack(Buf, InData%Floating) if (RegCheckErr(Buf, RoutineName)) return - ! KMMDiag call RegPack(Buf, allocated(InData%KMMDiag)) if (allocated(InData%KMMDiag)) then call RegPackBounds(Buf, 1, lbound(InData%KMMDiag), ubound(InData%KMMDiag)) call RegPack(Buf, InData%KMMDiag) end if if (RegCheckErr(Buf, RoutineName)) return - ! CMMDiag call RegPack(Buf, allocated(InData%CMMDiag)) if (allocated(InData%CMMDiag)) then call RegPackBounds(Buf, 1, lbound(InData%CMMDiag), ubound(InData%CMMDiag)) call RegPack(Buf, InData%CMMDiag) end if if (RegCheckErr(Buf, RoutineName)) return - ! MMB call RegPack(Buf, allocated(InData%MMB)) if (allocated(InData%MMB)) then call RegPackBounds(Buf, 2, lbound(InData%MMB), ubound(InData%MMB)) call RegPack(Buf, InData%MMB) end if if (RegCheckErr(Buf, RoutineName)) return - ! MBmmB call RegPack(Buf, allocated(InData%MBmmB)) if (allocated(InData%MBmmB)) then call RegPackBounds(Buf, 2, lbound(InData%MBmmB), ubound(InData%MBmmB)) call RegPack(Buf, InData%MBmmB) end if if (RegCheckErr(Buf, RoutineName)) return - ! C1_11 call RegPack(Buf, allocated(InData%C1_11)) if (allocated(InData%C1_11)) then call RegPackBounds(Buf, 2, lbound(InData%C1_11), ubound(InData%C1_11)) call RegPack(Buf, InData%C1_11) end if if (RegCheckErr(Buf, RoutineName)) return - ! C1_12 call RegPack(Buf, allocated(InData%C1_12)) if (allocated(InData%C1_12)) then call RegPackBounds(Buf, 2, lbound(InData%C1_12), ubound(InData%C1_12)) call RegPack(Buf, InData%C1_12) end if if (RegCheckErr(Buf, RoutineName)) return - ! D1_141 call RegPack(Buf, allocated(InData%D1_141)) if (allocated(InData%D1_141)) then call RegPackBounds(Buf, 2, lbound(InData%D1_141), ubound(InData%D1_141)) call RegPack(Buf, InData%D1_141) end if if (RegCheckErr(Buf, RoutineName)) return - ! D1_142 call RegPack(Buf, allocated(InData%D1_142)) if (allocated(InData%D1_142)) then call RegPackBounds(Buf, 2, lbound(InData%D1_142), ubound(InData%D1_142)) call RegPack(Buf, InData%D1_142) end if if (RegCheckErr(Buf, RoutineName)) return - ! PhiM call RegPack(Buf, allocated(InData%PhiM)) if (allocated(InData%PhiM)) then call RegPackBounds(Buf, 2, lbound(InData%PhiM), ubound(InData%PhiM)) call RegPack(Buf, InData%PhiM) end if if (RegCheckErr(Buf, RoutineName)) return - ! C2_61 call RegPack(Buf, allocated(InData%C2_61)) if (allocated(InData%C2_61)) then call RegPackBounds(Buf, 2, lbound(InData%C2_61), ubound(InData%C2_61)) call RegPack(Buf, InData%C2_61) end if if (RegCheckErr(Buf, RoutineName)) return - ! C2_62 call RegPack(Buf, allocated(InData%C2_62)) if (allocated(InData%C2_62)) then call RegPackBounds(Buf, 2, lbound(InData%C2_62), ubound(InData%C2_62)) call RegPack(Buf, InData%C2_62) end if if (RegCheckErr(Buf, RoutineName)) return - ! PhiRb_TI call RegPack(Buf, allocated(InData%PhiRb_TI)) if (allocated(InData%PhiRb_TI)) then call RegPackBounds(Buf, 2, lbound(InData%PhiRb_TI), ubound(InData%PhiRb_TI)) call RegPack(Buf, InData%PhiRb_TI) end if if (RegCheckErr(Buf, RoutineName)) return - ! D2_63 call RegPack(Buf, allocated(InData%D2_63)) if (allocated(InData%D2_63)) then call RegPackBounds(Buf, 2, lbound(InData%D2_63), ubound(InData%D2_63)) call RegPack(Buf, InData%D2_63) end if if (RegCheckErr(Buf, RoutineName)) return - ! D2_64 call RegPack(Buf, allocated(InData%D2_64)) if (allocated(InData%D2_64)) then call RegPackBounds(Buf, 2, lbound(InData%D2_64), ubound(InData%D2_64)) call RegPack(Buf, InData%D2_64) end if if (RegCheckErr(Buf, RoutineName)) return - ! MBB call RegPack(Buf, allocated(InData%MBB)) if (allocated(InData%MBB)) then call RegPackBounds(Buf, 2, lbound(InData%MBB), ubound(InData%MBB)) call RegPack(Buf, InData%MBB) end if if (RegCheckErr(Buf, RoutineName)) return - ! KBB call RegPack(Buf, allocated(InData%KBB)) if (allocated(InData%KBB)) then call RegPackBounds(Buf, 2, lbound(InData%KBB), ubound(InData%KBB)) call RegPack(Buf, InData%KBB) end if if (RegCheckErr(Buf, RoutineName)) return - ! CBB call RegPack(Buf, allocated(InData%CBB)) if (allocated(InData%CBB)) then call RegPackBounds(Buf, 2, lbound(InData%CBB), ubound(InData%CBB)) call RegPack(Buf, InData%CBB) end if if (RegCheckErr(Buf, RoutineName)) return - ! CMM call RegPack(Buf, allocated(InData%CMM)) if (allocated(InData%CMM)) then call RegPackBounds(Buf, 2, lbound(InData%CMM), ubound(InData%CMM)) call RegPack(Buf, InData%CMM) end if if (RegCheckErr(Buf, RoutineName)) return - ! MBM call RegPack(Buf, allocated(InData%MBM)) if (allocated(InData%MBM)) then call RegPackBounds(Buf, 2, lbound(InData%MBM), ubound(InData%MBM)) call RegPack(Buf, InData%MBM) end if if (RegCheckErr(Buf, RoutineName)) return - ! PhiL_T call RegPack(Buf, allocated(InData%PhiL_T)) if (allocated(InData%PhiL_T)) then call RegPackBounds(Buf, 2, lbound(InData%PhiL_T), ubound(InData%PhiL_T)) call RegPack(Buf, InData%PhiL_T) end if if (RegCheckErr(Buf, RoutineName)) return - ! PhiLInvOmgL2 call RegPack(Buf, allocated(InData%PhiLInvOmgL2)) if (allocated(InData%PhiLInvOmgL2)) then call RegPackBounds(Buf, 2, lbound(InData%PhiLInvOmgL2), ubound(InData%PhiLInvOmgL2)) call RegPack(Buf, InData%PhiLInvOmgL2) end if if (RegCheckErr(Buf, RoutineName)) return - ! KLLm1 call RegPack(Buf, allocated(InData%KLLm1)) if (allocated(InData%KLLm1)) then call RegPackBounds(Buf, 2, lbound(InData%KLLm1), ubound(InData%KLLm1)) call RegPack(Buf, InData%KLLm1) end if if (RegCheckErr(Buf, RoutineName)) return - ! AM2Jac call RegPack(Buf, allocated(InData%AM2Jac)) if (allocated(InData%AM2Jac)) then call RegPackBounds(Buf, 2, lbound(InData%AM2Jac), ubound(InData%AM2Jac)) call RegPack(Buf, InData%AM2Jac) end if if (RegCheckErr(Buf, RoutineName)) return - ! AM2JacPiv call RegPack(Buf, allocated(InData%AM2JacPiv)) if (allocated(InData%AM2JacPiv)) then call RegPackBounds(Buf, 1, lbound(InData%AM2JacPiv), ubound(InData%AM2JacPiv)) call RegPack(Buf, InData%AM2JacPiv) end if if (RegCheckErr(Buf, RoutineName)) return - ! TI call RegPack(Buf, allocated(InData%TI)) if (allocated(InData%TI)) then call RegPackBounds(Buf, 2, lbound(InData%TI), ubound(InData%TI)) call RegPack(Buf, InData%TI) end if if (RegCheckErr(Buf, RoutineName)) return - ! TIreact call RegPack(Buf, allocated(InData%TIreact)) if (allocated(InData%TIreact)) then call RegPackBounds(Buf, 2, lbound(InData%TIreact), ubound(InData%TIreact)) call RegPack(Buf, InData%TIreact) end if if (RegCheckErr(Buf, RoutineName)) return - ! nNodes call RegPack(Buf, InData%nNodes) if (RegCheckErr(Buf, RoutineName)) return - ! nNodes_I call RegPack(Buf, InData%nNodes_I) if (RegCheckErr(Buf, RoutineName)) return - ! nNodes_L call RegPack(Buf, InData%nNodes_L) if (RegCheckErr(Buf, RoutineName)) return - ! nNodes_C call RegPack(Buf, InData%nNodes_C) if (RegCheckErr(Buf, RoutineName)) return - ! Nodes_I call RegPack(Buf, allocated(InData%Nodes_I)) if (allocated(InData%Nodes_I)) then call RegPackBounds(Buf, 2, lbound(InData%Nodes_I), ubound(InData%Nodes_I)) call RegPack(Buf, InData%Nodes_I) end if if (RegCheckErr(Buf, RoutineName)) return - ! Nodes_L call RegPack(Buf, allocated(InData%Nodes_L)) if (allocated(InData%Nodes_L)) then call RegPackBounds(Buf, 2, lbound(InData%Nodes_L), ubound(InData%Nodes_L)) call RegPack(Buf, InData%Nodes_L) end if if (RegCheckErr(Buf, RoutineName)) return - ! Nodes_C call RegPack(Buf, allocated(InData%Nodes_C)) if (allocated(InData%Nodes_C)) then call RegPackBounds(Buf, 2, lbound(InData%Nodes_C), ubound(InData%Nodes_C)) call RegPack(Buf, InData%Nodes_C) end if if (RegCheckErr(Buf, RoutineName)) return - ! nDOFI__ call RegPack(Buf, InData%nDOFI__) if (RegCheckErr(Buf, RoutineName)) return - ! nDOFI_Rb call RegPack(Buf, InData%nDOFI_Rb) if (RegCheckErr(Buf, RoutineName)) return - ! nDOFI_F call RegPack(Buf, InData%nDOFI_F) if (RegCheckErr(Buf, RoutineName)) return - ! nDOFL_L call RegPack(Buf, InData%nDOFL_L) if (RegCheckErr(Buf, RoutineName)) return - ! nDOFC__ call RegPack(Buf, InData%nDOFC__) if (RegCheckErr(Buf, RoutineName)) return - ! nDOFC_Rb call RegPack(Buf, InData%nDOFC_Rb) if (RegCheckErr(Buf, RoutineName)) return - ! nDOFC_L call RegPack(Buf, InData%nDOFC_L) if (RegCheckErr(Buf, RoutineName)) return - ! nDOFC_F call RegPack(Buf, InData%nDOFC_F) if (RegCheckErr(Buf, RoutineName)) return - ! nDOFR__ call RegPack(Buf, InData%nDOFR__) if (RegCheckErr(Buf, RoutineName)) return - ! nDOF__Rb call RegPack(Buf, InData%nDOF__Rb) if (RegCheckErr(Buf, RoutineName)) return - ! nDOF__L call RegPack(Buf, InData%nDOF__L) if (RegCheckErr(Buf, RoutineName)) return - ! nDOF__F call RegPack(Buf, InData%nDOF__F) if (RegCheckErr(Buf, RoutineName)) return - ! IDI__ call RegPack(Buf, allocated(InData%IDI__)) if (allocated(InData%IDI__)) then call RegPackBounds(Buf, 1, lbound(InData%IDI__), ubound(InData%IDI__)) call RegPack(Buf, InData%IDI__) end if if (RegCheckErr(Buf, RoutineName)) return - ! IDI_Rb call RegPack(Buf, allocated(InData%IDI_Rb)) if (allocated(InData%IDI_Rb)) then call RegPackBounds(Buf, 1, lbound(InData%IDI_Rb), ubound(InData%IDI_Rb)) call RegPack(Buf, InData%IDI_Rb) end if if (RegCheckErr(Buf, RoutineName)) return - ! IDI_F call RegPack(Buf, allocated(InData%IDI_F)) if (allocated(InData%IDI_F)) then call RegPackBounds(Buf, 1, lbound(InData%IDI_F), ubound(InData%IDI_F)) call RegPack(Buf, InData%IDI_F) end if if (RegCheckErr(Buf, RoutineName)) return - ! IDL_L call RegPack(Buf, allocated(InData%IDL_L)) if (allocated(InData%IDL_L)) then call RegPackBounds(Buf, 1, lbound(InData%IDL_L), ubound(InData%IDL_L)) call RegPack(Buf, InData%IDL_L) end if if (RegCheckErr(Buf, RoutineName)) return - ! IDC__ call RegPack(Buf, allocated(InData%IDC__)) if (allocated(InData%IDC__)) then call RegPackBounds(Buf, 1, lbound(InData%IDC__), ubound(InData%IDC__)) call RegPack(Buf, InData%IDC__) end if if (RegCheckErr(Buf, RoutineName)) return - ! IDC_Rb call RegPack(Buf, allocated(InData%IDC_Rb)) if (allocated(InData%IDC_Rb)) then call RegPackBounds(Buf, 1, lbound(InData%IDC_Rb), ubound(InData%IDC_Rb)) call RegPack(Buf, InData%IDC_Rb) end if if (RegCheckErr(Buf, RoutineName)) return - ! IDC_L call RegPack(Buf, allocated(InData%IDC_L)) if (allocated(InData%IDC_L)) then call RegPackBounds(Buf, 1, lbound(InData%IDC_L), ubound(InData%IDC_L)) call RegPack(Buf, InData%IDC_L) end if if (RegCheckErr(Buf, RoutineName)) return - ! IDC_F call RegPack(Buf, allocated(InData%IDC_F)) if (allocated(InData%IDC_F)) then call RegPackBounds(Buf, 1, lbound(InData%IDC_F), ubound(InData%IDC_F)) call RegPack(Buf, InData%IDC_F) end if if (RegCheckErr(Buf, RoutineName)) return - ! IDR__ call RegPack(Buf, allocated(InData%IDR__)) if (allocated(InData%IDR__)) then call RegPackBounds(Buf, 1, lbound(InData%IDR__), ubound(InData%IDR__)) call RegPack(Buf, InData%IDR__) end if if (RegCheckErr(Buf, RoutineName)) return - ! ID__Rb call RegPack(Buf, allocated(InData%ID__Rb)) if (allocated(InData%ID__Rb)) then call RegPackBounds(Buf, 1, lbound(InData%ID__Rb), ubound(InData%ID__Rb)) call RegPack(Buf, InData%ID__Rb) end if if (RegCheckErr(Buf, RoutineName)) return - ! ID__L call RegPack(Buf, allocated(InData%ID__L)) if (allocated(InData%ID__L)) then call RegPackBounds(Buf, 1, lbound(InData%ID__L), ubound(InData%ID__L)) call RegPack(Buf, InData%ID__L) end if if (RegCheckErr(Buf, RoutineName)) return - ! ID__F call RegPack(Buf, allocated(InData%ID__F)) if (allocated(InData%ID__F)) then call RegPackBounds(Buf, 1, lbound(InData%ID__F), ubound(InData%ID__F)) call RegPack(Buf, InData%ID__F) end if if (RegCheckErr(Buf, RoutineName)) return - ! NMOutputs call RegPack(Buf, InData%NMOutputs) if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegPack(Buf, InData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! OutSwtch call RegPack(Buf, InData%OutSwtch) if (RegCheckErr(Buf, RoutineName)) return - ! UnJckF call RegPack(Buf, InData%UnJckF) if (RegCheckErr(Buf, RoutineName)) return - ! Delim call RegPack(Buf, InData%Delim) if (RegCheckErr(Buf, RoutineName)) return - ! OutFmt call RegPack(Buf, InData%OutFmt) if (RegCheckErr(Buf, RoutineName)) return - ! OutSFmt call RegPack(Buf, InData%OutSFmt) if (RegCheckErr(Buf, RoutineName)) return - ! MoutLst call RegPack(Buf, allocated(InData%MoutLst)) if (allocated(InData%MoutLst)) then call RegPackBounds(Buf, 1, lbound(InData%MoutLst), ubound(InData%MoutLst)) @@ -5953,7 +5604,6 @@ subroutine SD_PackParam(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! MoutLst2 call RegPack(Buf, allocated(InData%MoutLst2)) if (allocated(InData%MoutLst2)) then call RegPackBounds(Buf, 1, lbound(InData%MoutLst2), ubound(InData%MoutLst2)) @@ -5964,7 +5614,6 @@ subroutine SD_PackParam(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! MoutLst3 call RegPack(Buf, allocated(InData%MoutLst3)) if (allocated(InData%MoutLst3)) then call RegPackBounds(Buf, 1, lbound(InData%MoutLst3), ubound(InData%MoutLst3)) @@ -5975,7 +5624,6 @@ subroutine SD_PackParam(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! OutParam call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) @@ -5986,51 +5634,38 @@ subroutine SD_PackParam(Buf, Indata) end do end if if (RegCheckErr(Buf, RoutineName)) return - ! OutAll call RegPack(Buf, InData%OutAll) if (RegCheckErr(Buf, RoutineName)) return - ! OutCBModes call RegPack(Buf, InData%OutCBModes) if (RegCheckErr(Buf, RoutineName)) return - ! OutFEMModes call RegPack(Buf, InData%OutFEMModes) if (RegCheckErr(Buf, RoutineName)) return - ! OutReact call RegPack(Buf, InData%OutReact) if (RegCheckErr(Buf, RoutineName)) return - ! OutAllInt call RegPack(Buf, InData%OutAllInt) if (RegCheckErr(Buf, RoutineName)) return - ! OutAllDims call RegPack(Buf, InData%OutAllDims) if (RegCheckErr(Buf, RoutineName)) return - ! OutDec call RegPack(Buf, InData%OutDec) if (RegCheckErr(Buf, RoutineName)) return - ! Jac_u_indx call RegPack(Buf, allocated(InData%Jac_u_indx)) if (allocated(InData%Jac_u_indx)) then call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx), ubound(InData%Jac_u_indx)) call RegPack(Buf, InData%Jac_u_indx) end if if (RegCheckErr(Buf, RoutineName)) return - ! du call RegPack(Buf, allocated(InData%du)) if (allocated(InData%du)) then call RegPackBounds(Buf, 1, lbound(InData%du), ubound(InData%du)) call RegPack(Buf, InData%du) end if if (RegCheckErr(Buf, RoutineName)) return - ! dx call RegPack(Buf, InData%dx) if (RegCheckErr(Buf, RoutineName)) return - ! Jac_ny call RegPack(Buf, InData%Jac_ny) if (RegCheckErr(Buf, RoutineName)) return - ! Jac_nx call RegPack(Buf, InData%Jac_nx) if (RegCheckErr(Buf, RoutineName)) return - ! RotStates call RegPack(Buf, InData%RotStates) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -6044,22 +5679,16 @@ subroutine SD_UnPackParam(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! SDDeltaT call RegUnpack(Buf, OutData%SDDeltaT) if (RegCheckErr(Buf, RoutineName)) return - ! IntMethod call RegUnpack(Buf, OutData%IntMethod) if (RegCheckErr(Buf, RoutineName)) return - ! nDOF call RegUnpack(Buf, OutData%nDOF) if (RegCheckErr(Buf, RoutineName)) return - ! nDOF_red call RegUnpack(Buf, OutData%nDOF_red) if (RegCheckErr(Buf, RoutineName)) return - ! Nmembers call RegUnpack(Buf, OutData%Nmembers) if (RegCheckErr(Buf, RoutineName)) return - ! Elems if (allocated(OutData%Elems)) deallocate(OutData%Elems) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6074,7 +5703,6 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%Elems) if (RegCheckErr(Buf, RoutineName)) return end if - ! ElemProps if (allocated(OutData%ElemProps)) deallocate(OutData%ElemProps) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6090,7 +5718,6 @@ subroutine SD_UnPackParam(Buf, OutData) call SD_UnpackElemPropType(Buf, OutData%ElemProps(i1)) ! ElemProps end do end if - ! FG if (allocated(OutData%FG)) deallocate(OutData%FG) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6105,7 +5732,6 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%FG) if (RegCheckErr(Buf, RoutineName)) return end if - ! DP0 if (allocated(OutData%DP0)) deallocate(OutData%DP0) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6120,7 +5746,6 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%DP0) if (RegCheckErr(Buf, RoutineName)) return end if - ! NodeID2JointID if (allocated(OutData%NodeID2JointID)) deallocate(OutData%NodeID2JointID) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6135,10 +5760,8 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%NodeID2JointID) if (RegCheckErr(Buf, RoutineName)) return end if - ! reduced call RegUnpack(Buf, OutData%reduced) if (RegCheckErr(Buf, RoutineName)) return - ! T_red if (allocated(OutData%T_red)) deallocate(OutData%T_red) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6153,7 +5776,6 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%T_red) if (RegCheckErr(Buf, RoutineName)) return end if - ! T_red_T if (allocated(OutData%T_red_T)) deallocate(OutData%T_red_T) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6168,7 +5790,6 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%T_red_T) if (RegCheckErr(Buf, RoutineName)) return end if - ! NodesDOF if (allocated(OutData%NodesDOF)) deallocate(OutData%NodesDOF) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6184,7 +5805,6 @@ subroutine SD_UnPackParam(Buf, OutData) call SD_UnpackIList(Buf, OutData%NodesDOF(i1)) ! NodesDOF end do end if - ! NodesDOFred if (allocated(OutData%NodesDOFred)) deallocate(OutData%NodesDOFred) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6200,7 +5820,6 @@ subroutine SD_UnPackParam(Buf, OutData) call SD_UnpackIList(Buf, OutData%NodesDOFred(i1)) ! NodesDOFred end do end if - ! ElemsDOF if (allocated(OutData%ElemsDOF)) deallocate(OutData%ElemsDOF) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6215,7 +5834,6 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%ElemsDOF) if (RegCheckErr(Buf, RoutineName)) return end if - ! DOFred2Nodes if (allocated(OutData%DOFred2Nodes)) deallocate(OutData%DOFred2Nodes) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6230,7 +5848,6 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%DOFred2Nodes) if (RegCheckErr(Buf, RoutineName)) return end if - ! CtrlElem2Channel if (allocated(OutData%CtrlElem2Channel)) deallocate(OutData%CtrlElem2Channel) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6245,19 +5862,14 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%CtrlElem2Channel) if (RegCheckErr(Buf, RoutineName)) return end if - ! nDOFM call RegUnpack(Buf, OutData%nDOFM) if (RegCheckErr(Buf, RoutineName)) return - ! SttcSolve call RegUnpack(Buf, OutData%SttcSolve) if (RegCheckErr(Buf, RoutineName)) return - ! GuyanLoadCorrection call RegUnpack(Buf, OutData%GuyanLoadCorrection) if (RegCheckErr(Buf, RoutineName)) return - ! Floating call RegUnpack(Buf, OutData%Floating) if (RegCheckErr(Buf, RoutineName)) return - ! KMMDiag if (allocated(OutData%KMMDiag)) deallocate(OutData%KMMDiag) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6272,7 +5884,6 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%KMMDiag) if (RegCheckErr(Buf, RoutineName)) return end if - ! CMMDiag if (allocated(OutData%CMMDiag)) deallocate(OutData%CMMDiag) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6287,7 +5898,6 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%CMMDiag) if (RegCheckErr(Buf, RoutineName)) return end if - ! MMB if (allocated(OutData%MMB)) deallocate(OutData%MMB) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6302,7 +5912,6 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%MMB) if (RegCheckErr(Buf, RoutineName)) return end if - ! MBmmB if (allocated(OutData%MBmmB)) deallocate(OutData%MBmmB) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6317,7 +5926,6 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%MBmmB) if (RegCheckErr(Buf, RoutineName)) return end if - ! C1_11 if (allocated(OutData%C1_11)) deallocate(OutData%C1_11) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6332,7 +5940,6 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%C1_11) if (RegCheckErr(Buf, RoutineName)) return end if - ! C1_12 if (allocated(OutData%C1_12)) deallocate(OutData%C1_12) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6347,7 +5954,6 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%C1_12) if (RegCheckErr(Buf, RoutineName)) return end if - ! D1_141 if (allocated(OutData%D1_141)) deallocate(OutData%D1_141) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6362,7 +5968,6 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%D1_141) if (RegCheckErr(Buf, RoutineName)) return end if - ! D1_142 if (allocated(OutData%D1_142)) deallocate(OutData%D1_142) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6377,7 +5982,6 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%D1_142) if (RegCheckErr(Buf, RoutineName)) return end if - ! PhiM if (allocated(OutData%PhiM)) deallocate(OutData%PhiM) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6392,7 +5996,6 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%PhiM) if (RegCheckErr(Buf, RoutineName)) return end if - ! C2_61 if (allocated(OutData%C2_61)) deallocate(OutData%C2_61) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6407,7 +6010,6 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%C2_61) if (RegCheckErr(Buf, RoutineName)) return end if - ! C2_62 if (allocated(OutData%C2_62)) deallocate(OutData%C2_62) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6422,7 +6024,6 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%C2_62) if (RegCheckErr(Buf, RoutineName)) return end if - ! PhiRb_TI if (allocated(OutData%PhiRb_TI)) deallocate(OutData%PhiRb_TI) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6437,7 +6038,6 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%PhiRb_TI) if (RegCheckErr(Buf, RoutineName)) return end if - ! D2_63 if (allocated(OutData%D2_63)) deallocate(OutData%D2_63) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6452,7 +6052,6 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%D2_63) if (RegCheckErr(Buf, RoutineName)) return end if - ! D2_64 if (allocated(OutData%D2_64)) deallocate(OutData%D2_64) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6467,7 +6066,6 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%D2_64) if (RegCheckErr(Buf, RoutineName)) return end if - ! MBB if (allocated(OutData%MBB)) deallocate(OutData%MBB) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6482,7 +6080,6 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%MBB) if (RegCheckErr(Buf, RoutineName)) return end if - ! KBB if (allocated(OutData%KBB)) deallocate(OutData%KBB) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6497,7 +6094,6 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%KBB) if (RegCheckErr(Buf, RoutineName)) return end if - ! CBB if (allocated(OutData%CBB)) deallocate(OutData%CBB) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6512,7 +6108,6 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%CBB) if (RegCheckErr(Buf, RoutineName)) return end if - ! CMM if (allocated(OutData%CMM)) deallocate(OutData%CMM) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6527,7 +6122,6 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%CMM) if (RegCheckErr(Buf, RoutineName)) return end if - ! MBM if (allocated(OutData%MBM)) deallocate(OutData%MBM) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6542,7 +6136,6 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%MBM) if (RegCheckErr(Buf, RoutineName)) return end if - ! PhiL_T if (allocated(OutData%PhiL_T)) deallocate(OutData%PhiL_T) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6557,7 +6150,6 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%PhiL_T) if (RegCheckErr(Buf, RoutineName)) return end if - ! PhiLInvOmgL2 if (allocated(OutData%PhiLInvOmgL2)) deallocate(OutData%PhiLInvOmgL2) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6572,7 +6164,6 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%PhiLInvOmgL2) if (RegCheckErr(Buf, RoutineName)) return end if - ! KLLm1 if (allocated(OutData%KLLm1)) deallocate(OutData%KLLm1) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6587,7 +6178,6 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%KLLm1) if (RegCheckErr(Buf, RoutineName)) return end if - ! AM2Jac if (allocated(OutData%AM2Jac)) deallocate(OutData%AM2Jac) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6602,7 +6192,6 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%AM2Jac) if (RegCheckErr(Buf, RoutineName)) return end if - ! AM2JacPiv if (allocated(OutData%AM2JacPiv)) deallocate(OutData%AM2JacPiv) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6617,7 +6206,6 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%AM2JacPiv) if (RegCheckErr(Buf, RoutineName)) return end if - ! TI if (allocated(OutData%TI)) deallocate(OutData%TI) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6632,7 +6220,6 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%TI) if (RegCheckErr(Buf, RoutineName)) return end if - ! TIreact if (allocated(OutData%TIreact)) deallocate(OutData%TIreact) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6647,19 +6234,14 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%TIreact) if (RegCheckErr(Buf, RoutineName)) return end if - ! nNodes call RegUnpack(Buf, OutData%nNodes) if (RegCheckErr(Buf, RoutineName)) return - ! nNodes_I call RegUnpack(Buf, OutData%nNodes_I) if (RegCheckErr(Buf, RoutineName)) return - ! nNodes_L call RegUnpack(Buf, OutData%nNodes_L) if (RegCheckErr(Buf, RoutineName)) return - ! nNodes_C call RegUnpack(Buf, OutData%nNodes_C) if (RegCheckErr(Buf, RoutineName)) return - ! Nodes_I if (allocated(OutData%Nodes_I)) deallocate(OutData%Nodes_I) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6674,7 +6256,6 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%Nodes_I) if (RegCheckErr(Buf, RoutineName)) return end if - ! Nodes_L if (allocated(OutData%Nodes_L)) deallocate(OutData%Nodes_L) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6689,7 +6270,6 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%Nodes_L) if (RegCheckErr(Buf, RoutineName)) return end if - ! Nodes_C if (allocated(OutData%Nodes_C)) deallocate(OutData%Nodes_C) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6704,43 +6284,30 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%Nodes_C) if (RegCheckErr(Buf, RoutineName)) return end if - ! nDOFI__ call RegUnpack(Buf, OutData%nDOFI__) if (RegCheckErr(Buf, RoutineName)) return - ! nDOFI_Rb call RegUnpack(Buf, OutData%nDOFI_Rb) if (RegCheckErr(Buf, RoutineName)) return - ! nDOFI_F call RegUnpack(Buf, OutData%nDOFI_F) if (RegCheckErr(Buf, RoutineName)) return - ! nDOFL_L call RegUnpack(Buf, OutData%nDOFL_L) if (RegCheckErr(Buf, RoutineName)) return - ! nDOFC__ call RegUnpack(Buf, OutData%nDOFC__) if (RegCheckErr(Buf, RoutineName)) return - ! nDOFC_Rb call RegUnpack(Buf, OutData%nDOFC_Rb) if (RegCheckErr(Buf, RoutineName)) return - ! nDOFC_L call RegUnpack(Buf, OutData%nDOFC_L) if (RegCheckErr(Buf, RoutineName)) return - ! nDOFC_F call RegUnpack(Buf, OutData%nDOFC_F) if (RegCheckErr(Buf, RoutineName)) return - ! nDOFR__ call RegUnpack(Buf, OutData%nDOFR__) if (RegCheckErr(Buf, RoutineName)) return - ! nDOF__Rb call RegUnpack(Buf, OutData%nDOF__Rb) if (RegCheckErr(Buf, RoutineName)) return - ! nDOF__L call RegUnpack(Buf, OutData%nDOF__L) if (RegCheckErr(Buf, RoutineName)) return - ! nDOF__F call RegUnpack(Buf, OutData%nDOF__F) if (RegCheckErr(Buf, RoutineName)) return - ! IDI__ if (allocated(OutData%IDI__)) deallocate(OutData%IDI__) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6755,7 +6322,6 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%IDI__) if (RegCheckErr(Buf, RoutineName)) return end if - ! IDI_Rb if (allocated(OutData%IDI_Rb)) deallocate(OutData%IDI_Rb) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6770,7 +6336,6 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%IDI_Rb) if (RegCheckErr(Buf, RoutineName)) return end if - ! IDI_F if (allocated(OutData%IDI_F)) deallocate(OutData%IDI_F) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6785,7 +6350,6 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%IDI_F) if (RegCheckErr(Buf, RoutineName)) return end if - ! IDL_L if (allocated(OutData%IDL_L)) deallocate(OutData%IDL_L) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6800,7 +6364,6 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%IDL_L) if (RegCheckErr(Buf, RoutineName)) return end if - ! IDC__ if (allocated(OutData%IDC__)) deallocate(OutData%IDC__) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6815,7 +6378,6 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%IDC__) if (RegCheckErr(Buf, RoutineName)) return end if - ! IDC_Rb if (allocated(OutData%IDC_Rb)) deallocate(OutData%IDC_Rb) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6830,7 +6392,6 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%IDC_Rb) if (RegCheckErr(Buf, RoutineName)) return end if - ! IDC_L if (allocated(OutData%IDC_L)) deallocate(OutData%IDC_L) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6845,7 +6406,6 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%IDC_L) if (RegCheckErr(Buf, RoutineName)) return end if - ! IDC_F if (allocated(OutData%IDC_F)) deallocate(OutData%IDC_F) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6860,7 +6420,6 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%IDC_F) if (RegCheckErr(Buf, RoutineName)) return end if - ! IDR__ if (allocated(OutData%IDR__)) deallocate(OutData%IDR__) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6875,7 +6434,6 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%IDR__) if (RegCheckErr(Buf, RoutineName)) return end if - ! ID__Rb if (allocated(OutData%ID__Rb)) deallocate(OutData%ID__Rb) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6890,7 +6448,6 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%ID__Rb) if (RegCheckErr(Buf, RoutineName)) return end if - ! ID__L if (allocated(OutData%ID__L)) deallocate(OutData%ID__L) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6905,7 +6462,6 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%ID__L) if (RegCheckErr(Buf, RoutineName)) return end if - ! ID__F if (allocated(OutData%ID__F)) deallocate(OutData%ID__F) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6920,28 +6476,20 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%ID__F) if (RegCheckErr(Buf, RoutineName)) return end if - ! NMOutputs call RegUnpack(Buf, OutData%NMOutputs) if (RegCheckErr(Buf, RoutineName)) return - ! NumOuts call RegUnpack(Buf, OutData%NumOuts) if (RegCheckErr(Buf, RoutineName)) return - ! OutSwtch call RegUnpack(Buf, OutData%OutSwtch) if (RegCheckErr(Buf, RoutineName)) return - ! UnJckF call RegUnpack(Buf, OutData%UnJckF) if (RegCheckErr(Buf, RoutineName)) return - ! Delim call RegUnpack(Buf, OutData%Delim) if (RegCheckErr(Buf, RoutineName)) return - ! OutFmt call RegUnpack(Buf, OutData%OutFmt) if (RegCheckErr(Buf, RoutineName)) return - ! OutSFmt call RegUnpack(Buf, OutData%OutSFmt) if (RegCheckErr(Buf, RoutineName)) return - ! MoutLst if (allocated(OutData%MoutLst)) deallocate(OutData%MoutLst) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6957,7 +6505,6 @@ subroutine SD_UnPackParam(Buf, OutData) call SD_UnpackMeshAuxDataType(Buf, OutData%MoutLst(i1)) ! MoutLst end do end if - ! MoutLst2 if (allocated(OutData%MoutLst2)) deallocate(OutData%MoutLst2) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6973,7 +6520,6 @@ subroutine SD_UnPackParam(Buf, OutData) call SD_UnpackMeshAuxDataType(Buf, OutData%MoutLst2(i1)) ! MoutLst2 end do end if - ! MoutLst3 if (allocated(OutData%MoutLst3)) deallocate(OutData%MoutLst3) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -6989,7 +6535,6 @@ subroutine SD_UnPackParam(Buf, OutData) call SD_UnpackMeshAuxDataType(Buf, OutData%MoutLst3(i1)) ! MoutLst3 end do end if - ! OutParam if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7005,28 +6550,20 @@ subroutine SD_UnPackParam(Buf, OutData) call NWTC_Library_UnpackOutParmType(Buf, OutData%OutParam(i1)) ! OutParam end do end if - ! OutAll call RegUnpack(Buf, OutData%OutAll) if (RegCheckErr(Buf, RoutineName)) return - ! OutCBModes call RegUnpack(Buf, OutData%OutCBModes) if (RegCheckErr(Buf, RoutineName)) return - ! OutFEMModes call RegUnpack(Buf, OutData%OutFEMModes) if (RegCheckErr(Buf, RoutineName)) return - ! OutReact call RegUnpack(Buf, OutData%OutReact) if (RegCheckErr(Buf, RoutineName)) return - ! OutAllInt call RegUnpack(Buf, OutData%OutAllInt) if (RegCheckErr(Buf, RoutineName)) return - ! OutAllDims call RegUnpack(Buf, OutData%OutAllDims) if (RegCheckErr(Buf, RoutineName)) return - ! OutDec call RegUnpack(Buf, OutData%OutDec) if (RegCheckErr(Buf, RoutineName)) return - ! Jac_u_indx if (allocated(OutData%Jac_u_indx)) deallocate(OutData%Jac_u_indx) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7041,7 +6578,6 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%Jac_u_indx) if (RegCheckErr(Buf, RoutineName)) return end if - ! du if (allocated(OutData%du)) deallocate(OutData%du) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7056,89 +6592,73 @@ subroutine SD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%du) if (RegCheckErr(Buf, RoutineName)) return end if - ! dx call RegUnpack(Buf, OutData%dx) if (RegCheckErr(Buf, RoutineName)) return - ! Jac_ny call RegUnpack(Buf, OutData%Jac_ny) if (RegCheckErr(Buf, RoutineName)) return - ! Jac_nx call RegUnpack(Buf, OutData%Jac_nx) if (RegCheckErr(Buf, RoutineName)) return - ! RotStates call RegUnpack(Buf, OutData%RotStates) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE SD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SD_InputType), INTENT(INOUT) :: SrcInputData - TYPE(SD_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyInput' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcInputData%TPMesh, DstInputData%TPMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcInputData%LMesh, DstInputData%LMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInputData%CableDeltaL)) THEN - i1_l = LBOUND(SrcInputData%CableDeltaL,1) - i1_u = UBOUND(SrcInputData%CableDeltaL,1) - IF (.NOT. ALLOCATED(DstInputData%CableDeltaL)) THEN - ALLOCATE(DstInputData%CableDeltaL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CableDeltaL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%CableDeltaL = SrcInputData%CableDeltaL -ENDIF - END SUBROUTINE SD_CopyInput - - SUBROUTINE SD_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(SD_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - CALL MeshDestroy( InputData%TPMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( InputData%LMesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(InputData%CableDeltaL)) THEN - DEALLOCATE(InputData%CableDeltaL) -ENDIF - END SUBROUTINE SD_DestroyInput +subroutine SD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(SD_InputType), intent(inout) :: SrcInputData + type(SD_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SD_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcInputData%TPMesh, DstInputData%TPMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcInputData%LMesh, DstInputData%LMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInputData%CableDeltaL)) then + LB(1:1) = lbound(SrcInputData%CableDeltaL) + UB(1:1) = ubound(SrcInputData%CableDeltaL) + if (.not. allocated(DstInputData%CableDeltaL)) then + allocate(DstInputData%CableDeltaL(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CableDeltaL.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%CableDeltaL = SrcInputData%CableDeltaL + else if (allocated(DstInputData%CableDeltaL)) then + deallocate(DstInputData%CableDeltaL) + end if +end subroutine +subroutine SD_DestroyInput(InputData, ErrStat, ErrMsg) + type(SD_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SD_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%CableDeltaL)) then + deallocate(InputData%CableDeltaL) + end if +end subroutine subroutine SD_PackInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SD_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SD_PackInput' if (Buf%ErrStat >= AbortErrLev) return - ! TPMesh call MeshPack(Buf, InData%TPMesh) if (RegCheckErr(Buf, RoutineName)) return - ! LMesh call MeshPack(Buf, InData%LMesh) if (RegCheckErr(Buf, RoutineName)) return - ! CableDeltaL call RegPack(Buf, allocated(InData%CableDeltaL)) if (allocated(InData%CableDeltaL)) then call RegPackBounds(Buf, 1, lbound(InData%CableDeltaL), ubound(InData%CableDeltaL)) @@ -7155,11 +6675,8 @@ subroutine SD_UnPackInput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! TPMesh call MeshUnpack(Buf, OutData%TPMesh) ! TPMesh - ! LMesh call MeshUnpack(Buf, OutData%LMesh) ! LMesh - ! CableDeltaL if (allocated(OutData%CableDeltaL)) deallocate(OutData%CableDeltaL) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -7175,84 +6692,69 @@ subroutine SD_UnPackInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE SD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SD_OutputType), INTENT(INOUT) :: SrcOutputData - TYPE(SD_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_CopyOutput' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL MeshCopy( SrcOutputData%Y1Mesh, DstOutputData%Y1Mesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcOutputData%Y2Mesh, DstOutputData%Y2Mesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcOutputData%Y3Mesh, DstOutputData%Y3Mesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcOutputData%WriteOutput)) THEN - i1_l = LBOUND(SrcOutputData%WriteOutput,1) - i1_u = UBOUND(SrcOutputData%WriteOutput,1) - IF (.NOT. ALLOCATED(DstOutputData%WriteOutput)) THEN - ALLOCATE(DstOutputData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%WriteOutput = SrcOutputData%WriteOutput -ENDIF - END SUBROUTINE SD_CopyOutput - - SUBROUTINE SD_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(SD_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SD_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - CALL MeshDestroy( OutputData%Y1Mesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( OutputData%Y2Mesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL MeshDestroy( OutputData%Y3Mesh, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - END SUBROUTINE SD_DestroyOutput +subroutine SD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(SD_OutputType), intent(inout) :: SrcOutputData + type(SD_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SD_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcOutputData%Y1Mesh, DstOutputData%Y1Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcOutputData%Y2Mesh, DstOutputData%Y2Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcOutputData%Y3Mesh, DstOutputData%Y3Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%WriteOutput = SrcOutputData%WriteOutput + else if (allocated(DstOutputData%WriteOutput)) then + deallocate(DstOutputData%WriteOutput) + end if +end subroutine +subroutine SD_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(SD_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SD_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine subroutine SD_PackOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(SD_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SD_PackOutput' if (Buf%ErrStat >= AbortErrLev) return - ! Y1Mesh call MeshPack(Buf, InData%Y1Mesh) if (RegCheckErr(Buf, RoutineName)) return - ! Y2Mesh call MeshPack(Buf, InData%Y2Mesh) if (RegCheckErr(Buf, RoutineName)) return - ! Y3Mesh call MeshPack(Buf, InData%Y3Mesh) if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutput call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) @@ -7269,13 +6771,9 @@ subroutine SD_UnPackOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! Y1Mesh call MeshUnpack(Buf, OutData%Y1Mesh) ! Y1Mesh - ! Y2Mesh call MeshUnpack(Buf, OutData%Y2Mesh) ! Y2Mesh - ! Y3Mesh call MeshUnpack(Buf, OutData%Y3Mesh) ! Y3Mesh - ! WriteOutput if (allocated(OutData%WriteOutput)) deallocate(OutData%WriteOutput) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/supercontroller/src/SCDataEx_Types.f90 b/modules/supercontroller/src/SCDataEx_Types.f90 index 4e899722f8..2f721eeacf 100644 --- a/modules/supercontroller/src/SCDataEx_Types.f90 +++ b/modules/supercontroller/src/SCDataEx_Types.f90 @@ -92,43 +92,32 @@ MODULE SCDataEx_Types END TYPE SC_DX_OutputType ! ======================= CONTAINS - SUBROUTINE SC_DX_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_DX_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(SC_DX_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_CopyInitInput' -! + +subroutine SC_DX_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(SC_DX_InitInputType), intent(in) :: SrcInitInputData + type(SC_DX_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SC_DX_CopyInitInput' ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%NumSC2Ctrl = SrcInitInputData%NumSC2Ctrl - DstInitInputData%C_obj%NumSC2Ctrl = SrcInitInputData%C_obj%NumSC2Ctrl - DstInitInputData%NumSC2CtrlGlob = SrcInitInputData%NumSC2CtrlGlob - DstInitInputData%C_obj%NumSC2CtrlGlob = SrcInitInputData%C_obj%NumSC2CtrlGlob - DstInitInputData%NumCtrl2SC = SrcInitInputData%NumCtrl2SC - DstInitInputData%C_obj%NumCtrl2SC = SrcInitInputData%C_obj%NumCtrl2SC - END SUBROUTINE SC_DX_CopyInitInput - - SUBROUTINE SC_DX_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(SC_DX_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE SC_DX_DestroyInitInput + ErrMsg = '' + DstInitInputData%NumSC2Ctrl = SrcInitInputData%NumSC2Ctrl + DstInitInputData%C_obj%NumSC2Ctrl = SrcInitInputData%C_obj%NumSC2Ctrl + DstInitInputData%NumSC2CtrlGlob = SrcInitInputData%NumSC2CtrlGlob + DstInitInputData%C_obj%NumSC2CtrlGlob = SrcInitInputData%C_obj%NumSC2CtrlGlob + DstInitInputData%NumCtrl2SC = SrcInitInputData%NumCtrl2SC + DstInitInputData%C_obj%NumCtrl2SC = SrcInitInputData%C_obj%NumCtrl2SC +end subroutine +subroutine SC_DX_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(SC_DX_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SC_DX_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine SC_DX_PackInitInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -139,13 +128,10 @@ subroutine SC_DX_PackInitInput(Buf, Indata) call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - ! NumSC2Ctrl call RegPack(Buf, InData%NumSC2Ctrl) if (RegCheckErr(Buf, RoutineName)) return - ! NumSC2CtrlGlob call RegPack(Buf, InData%NumSC2CtrlGlob) if (RegCheckErr(Buf, RoutineName)) return - ! NumCtrl2SC call RegPack(Buf, InData%NumCtrl2SC) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -155,15 +141,12 @@ subroutine SC_DX_UnPackInitInput(Buf, OutData) type(SC_DX_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SC_DX_UnPackInitInput' if (Buf%ErrStat /= ErrID_None) return - ! NumSC2Ctrl call RegUnpack(Buf, OutData%NumSC2Ctrl) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%NumSC2Ctrl = OutData%NumSC2Ctrl - ! NumSC2CtrlGlob call RegUnpack(Buf, OutData%NumSC2CtrlGlob) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%NumSC2CtrlGlob = OutData%NumSC2CtrlGlob - ! NumCtrl2SC call RegUnpack(Buf, OutData%NumCtrl2SC) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%NumCtrl2SC = OutData%NumCtrl2SC @@ -208,42 +191,33 @@ SUBROUTINE SC_DX_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers InitInputData%C_obj%NumCtrl2SC = InitInputData%NumCtrl2SC END SUBROUTINE SC_DX_F2C_CopyInitInput - SUBROUTINE SC_DX_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_DX_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(SC_DX_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_CopyInitOutput' -! + +subroutine SC_DX_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(SC_DX_InitOutputType), intent(in) :: SrcInitOutputData + type(SC_DX_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SC_DX_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE SC_DX_CopyInitOutput - - SUBROUTINE SC_DX_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(SC_DX_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE SC_DX_DestroyInitOutput + ErrMsg = '' + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine SC_DX_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(SC_DX_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SC_DX_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine SC_DX_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -254,7 +228,6 @@ subroutine SC_DX_PackInitOutput(Buf, Indata) call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - ! Ver call NWTC_Library_PackProgDesc(Buf, InData%Ver) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -264,7 +237,6 @@ subroutine SC_DX_UnPackInitOutput(Buf, OutData) type(SC_DX_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SC_DX_UnPackInitOutput' if (Buf%ErrStat /= ErrID_None) return - ! Ver call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver end subroutine SUBROUTINE SC_DX_C2Fary_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) @@ -301,39 +273,28 @@ SUBROUTINE SC_DX_F2C_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointe END IF END SUBROUTINE SC_DX_F2C_CopyInitOutput - SUBROUTINE SC_DX_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_DX_ParameterType), INTENT(IN) :: SrcParamData - TYPE(SC_DX_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%useSC = SrcParamData%useSC - DstParamData%C_obj%useSC = SrcParamData%C_obj%useSC - END SUBROUTINE SC_DX_CopyParam - - SUBROUTINE SC_DX_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(SC_DX_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE SC_DX_DestroyParam +subroutine SC_DX_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(SC_DX_ParameterType), intent(in) :: SrcParamData + type(SC_DX_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SC_DX_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%useSC = SrcParamData%useSC + DstParamData%C_obj%useSC = SrcParamData%C_obj%useSC +end subroutine +subroutine SC_DX_DestroyParam(ParamData, ErrStat, ErrMsg) + type(SC_DX_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SC_DX_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine SC_DX_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -344,7 +305,6 @@ subroutine SC_DX_PackParam(Buf, Indata) call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - ! useSC call RegPack(Buf, InData%useSC) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -354,7 +314,6 @@ subroutine SC_DX_UnPackParam(Buf, OutData) type(SC_DX_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SC_DX_UnPackParam' if (Buf%ErrStat /= ErrID_None) return - ! useSC call RegUnpack(Buf, OutData%useSC) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%useSC = OutData%useSC @@ -395,59 +354,51 @@ SUBROUTINE SC_DX_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) ParamData%C_obj%useSC = ParamData%useSC END SUBROUTINE SC_DX_F2C_CopyParam - SUBROUTINE SC_DX_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_DX_InputType), INTENT(IN) :: SrcInputData - TYPE(SC_DX_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_CopyInput' -! + +subroutine SC_DX_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(SC_DX_InputType), intent(in) :: SrcInputData + type(SC_DX_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SC_DX_CopyInput' ErrStat = ErrID_None - ErrMsg = "" -IF (ASSOCIATED(SrcInputData%toSC)) THEN - i1_l = LBOUND(SrcInputData%toSC,1) - i1_u = UBOUND(SrcInputData%toSC,1) - IF (.NOT. ASSOCIATED(DstInputData%toSC)) THEN - ALLOCATE(DstInputData%toSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%toSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%C_obj%toSC_Len = SIZE(DstInputData%toSC) - IF (DstInputData%C_obj%toSC_Len > 0) & - DstInputData%C_obj%toSC = C_LOC( DstInputData%toSC( i1_l ) ) - END IF - DstInputData%toSC = SrcInputData%toSC -ENDIF - END SUBROUTINE SC_DX_CopyInput - - SUBROUTINE SC_DX_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(SC_DX_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ASSOCIATED(InputData%toSC)) THEN - DEALLOCATE(InputData%toSC) - InputData%toSC => NULL() - InputData%C_obj%toSC = C_NULL_PTR - InputData%C_obj%toSC_Len = 0 -ENDIF - END SUBROUTINE SC_DX_DestroyInput + ErrMsg = '' + if (associated(SrcInputData%toSC)) then + LB(1:1) = lbound(SrcInputData%toSC) + UB(1:1) = ubound(SrcInputData%toSC) + if (.not. associated(DstInputData%toSC)) then + allocate(DstInputData%toSC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%toSC.', ErrStat, ErrMsg, RoutineName) + return + end if + DstInputData%C_obj%toSC_Len = size(DstInputData%toSC) + if (DstInputData%C_obj%toSC_Len > 0) & + DstInputData%C_obj%toSC = c_loc(DstInputData%toSC(LB(1))) + end if + DstInputData%toSC = SrcInputData%toSC + else if (associated(DstInputData%toSC)) then + deallocate(DstInputData%toSC) + end if +end subroutine +subroutine SC_DX_DestroyInput(InputData, ErrStat, ErrMsg) + type(SC_DX_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SC_DX_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(InputData%toSC)) then + deallocate(InputData%toSC) + InputData%toSC => null() + InputData%C_obj%toSC = c_null_ptr + InputData%C_obj%toSC_Len = 0 + end if +end subroutine subroutine SC_DX_PackInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -459,7 +410,6 @@ subroutine SC_DX_PackInput(Buf, Indata) call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - ! toSC call RegPack(Buf, associated(InData%toSC)) if (associated(InData%toSC)) then call RegPackBounds(Buf, 1, lbound(InData%toSC), ubound(InData%toSC)) @@ -481,7 +431,6 @@ subroutine SC_DX_UnPackInput(Buf, OutData) integer(IntKi) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return - ! toSC if (associated(OutData%toSC)) deallocate(OutData%toSC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -564,80 +513,74 @@ SUBROUTINE SC_DX_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) END IF END SUBROUTINE SC_DX_F2C_CopyInput - SUBROUTINE SC_DX_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_DX_OutputType), INTENT(IN) :: SrcOutputData - TYPE(SC_DX_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_CopyOutput' -! + +subroutine SC_DX_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(SC_DX_OutputType), intent(in) :: SrcOutputData + type(SC_DX_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SC_DX_CopyOutput' ErrStat = ErrID_None - ErrMsg = "" -IF (ASSOCIATED(SrcOutputData%fromSC)) THEN - i1_l = LBOUND(SrcOutputData%fromSC,1) - i1_u = UBOUND(SrcOutputData%fromSC,1) - IF (.NOT. ASSOCIATED(DstOutputData%fromSC)) THEN - ALLOCATE(DstOutputData%fromSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%fromSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOutputData%C_obj%fromSC_Len = SIZE(DstOutputData%fromSC) - IF (DstOutputData%C_obj%fromSC_Len > 0) & - DstOutputData%C_obj%fromSC = C_LOC( DstOutputData%fromSC( i1_l ) ) - END IF - DstOutputData%fromSC = SrcOutputData%fromSC -ENDIF -IF (ASSOCIATED(SrcOutputData%fromSCglob)) THEN - i1_l = LBOUND(SrcOutputData%fromSCglob,1) - i1_u = UBOUND(SrcOutputData%fromSCglob,1) - IF (.NOT. ASSOCIATED(DstOutputData%fromSCglob)) THEN - ALLOCATE(DstOutputData%fromSCglob(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%fromSCglob.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOutputData%C_obj%fromSCglob_Len = SIZE(DstOutputData%fromSCglob) - IF (DstOutputData%C_obj%fromSCglob_Len > 0) & - DstOutputData%C_obj%fromSCglob = C_LOC( DstOutputData%fromSCglob( i1_l ) ) - END IF - DstOutputData%fromSCglob = SrcOutputData%fromSCglob -ENDIF - END SUBROUTINE SC_DX_CopyOutput - - SUBROUTINE SC_DX_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(SC_DX_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DX_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ASSOCIATED(OutputData%fromSC)) THEN - DEALLOCATE(OutputData%fromSC) - OutputData%fromSC => NULL() - OutputData%C_obj%fromSC = C_NULL_PTR - OutputData%C_obj%fromSC_Len = 0 -ENDIF -IF (ASSOCIATED(OutputData%fromSCglob)) THEN - DEALLOCATE(OutputData%fromSCglob) - OutputData%fromSCglob => NULL() - OutputData%C_obj%fromSCglob = C_NULL_PTR - OutputData%C_obj%fromSCglob_Len = 0 -ENDIF - END SUBROUTINE SC_DX_DestroyOutput + ErrMsg = '' + if (associated(SrcOutputData%fromSC)) then + LB(1:1) = lbound(SrcOutputData%fromSC) + UB(1:1) = ubound(SrcOutputData%fromSC) + if (.not. associated(DstOutputData%fromSC)) then + allocate(DstOutputData%fromSC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%fromSC.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOutputData%C_obj%fromSC_Len = size(DstOutputData%fromSC) + if (DstOutputData%C_obj%fromSC_Len > 0) & + DstOutputData%C_obj%fromSC = c_loc(DstOutputData%fromSC(LB(1))) + end if + DstOutputData%fromSC = SrcOutputData%fromSC + else if (associated(DstOutputData%fromSC)) then + deallocate(DstOutputData%fromSC) + end if + if (associated(SrcOutputData%fromSCglob)) then + LB(1:1) = lbound(SrcOutputData%fromSCglob) + UB(1:1) = ubound(SrcOutputData%fromSCglob) + if (.not. associated(DstOutputData%fromSCglob)) then + allocate(DstOutputData%fromSCglob(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%fromSCglob.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOutputData%C_obj%fromSCglob_Len = size(DstOutputData%fromSCglob) + if (DstOutputData%C_obj%fromSCglob_Len > 0) & + DstOutputData%C_obj%fromSCglob = c_loc(DstOutputData%fromSCglob(LB(1))) + end if + DstOutputData%fromSCglob = SrcOutputData%fromSCglob + else if (associated(DstOutputData%fromSCglob)) then + deallocate(DstOutputData%fromSCglob) + end if +end subroutine +subroutine SC_DX_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(SC_DX_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SC_DX_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(OutputData%fromSC)) then + deallocate(OutputData%fromSC) + OutputData%fromSC => null() + OutputData%C_obj%fromSC = c_null_ptr + OutputData%C_obj%fromSC_Len = 0 + end if + if (associated(OutputData%fromSCglob)) then + deallocate(OutputData%fromSCglob) + OutputData%fromSCglob => null() + OutputData%C_obj%fromSCglob = c_null_ptr + OutputData%C_obj%fromSCglob_Len = 0 + end if +end subroutine subroutine SC_DX_PackOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -649,7 +592,6 @@ subroutine SC_DX_PackOutput(Buf, Indata) call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - ! fromSC call RegPack(Buf, associated(InData%fromSC)) if (associated(InData%fromSC)) then call RegPackBounds(Buf, 1, lbound(InData%fromSC), ubound(InData%fromSC)) @@ -659,7 +601,6 @@ subroutine SC_DX_PackOutput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! fromSCglob call RegPack(Buf, associated(InData%fromSCglob)) if (associated(InData%fromSCglob)) then call RegPackBounds(Buf, 1, lbound(InData%fromSCglob), ubound(InData%fromSCglob)) @@ -681,7 +622,6 @@ subroutine SC_DX_UnPackOutput(Buf, OutData) integer(IntKi) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return - ! fromSC if (associated(OutData%fromSC)) deallocate(OutData%fromSC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -708,7 +648,6 @@ subroutine SC_DX_UnPackOutput(Buf, OutData) else OutData%fromSC => null() end if - ! fromSCglob if (associated(OutData%fromSCglob)) deallocate(OutData%fromSCglob) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/supercontroller/src/SuperController_Types.f90 b/modules/supercontroller/src/SuperController_Types.f90 index 1b7ea329ce..a4a2e0f97c 100644 --- a/modules/supercontroller/src/SuperController_Types.f90 +++ b/modules/supercontroller/src/SuperController_Types.f90 @@ -180,41 +180,30 @@ MODULE SuperController_Types END TYPE SC_OutputType ! ======================= CONTAINS - SUBROUTINE SC_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(SC_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%nTurbines = SrcInitInputData%nTurbines - DstInitInputData%C_obj%nTurbines = SrcInitInputData%C_obj%nTurbines - DstInitInputData%DLL_FileName = SrcInitInputData%DLL_FileName - DstInitInputData%C_obj%DLL_FileName = SrcInitInputData%C_obj%DLL_FileName - END SUBROUTINE SC_CopyInitInput - - SUBROUTINE SC_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(SC_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyInitInput' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE SC_DestroyInitInput +subroutine SC_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(SC_InitInputType), intent(in) :: SrcInitInputData + type(SC_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SC_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInitInputData%nTurbines = SrcInitInputData%nTurbines + DstInitInputData%C_obj%nTurbines = SrcInitInputData%C_obj%nTurbines + DstInitInputData%DLL_FileName = SrcInitInputData%DLL_FileName + DstInitInputData%C_obj%DLL_FileName = SrcInitInputData%C_obj%DLL_FileName +end subroutine +subroutine SC_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(SC_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SC_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine SC_PackInitInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -225,10 +214,8 @@ subroutine SC_PackInitInput(Buf, Indata) call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - ! nTurbines call RegPack(Buf, InData%nTurbines) if (RegCheckErr(Buf, RoutineName)) return - ! DLL_FileName call RegPack(Buf, InData%DLL_FileName) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -238,11 +225,9 @@ subroutine SC_UnPackInitInput(Buf, OutData) type(SC_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SC_UnPackInitInput' if (Buf%ErrStat /= ErrID_None) return - ! nTurbines call RegUnpack(Buf, OutData%nTurbines) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%nTurbines = OutData%nTurbines - ! DLL_FileName call RegUnpack(Buf, OutData%DLL_FileName) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%DLL_FileName = transfer(OutData%DLL_FileName, OutData%C_obj%DLL_FileName ) @@ -285,50 +270,41 @@ SUBROUTINE SC_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) InitInputData%C_obj%DLL_FileName = TRANSFER(InitInputData%DLL_FileName, InitInputData%C_obj%DLL_FileName ) END SUBROUTINE SC_F2C_CopyInitInput - SUBROUTINE SC_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(SC_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_CopyInitOutput' -! + +subroutine SC_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(SC_InitOutputType), intent(in) :: SrcInitOutputData + type(SC_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SC_CopyInitOutput' ErrStat = ErrID_None - ErrMsg = "" - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitOutputData%NumCtrl2SC = SrcInitOutputData%NumCtrl2SC - DstInitOutputData%C_obj%NumCtrl2SC = SrcInitOutputData%C_obj%NumCtrl2SC - DstInitOutputData%nInpGlobal = SrcInitOutputData%nInpGlobal - DstInitOutputData%C_obj%nInpGlobal = SrcInitOutputData%C_obj%nInpGlobal - DstInitOutputData%NumSC2Ctrl = SrcInitOutputData%NumSC2Ctrl - DstInitOutputData%C_obj%NumSC2Ctrl = SrcInitOutputData%C_obj%NumSC2Ctrl - DstInitOutputData%NumSC2CtrlGlob = SrcInitOutputData%NumSC2CtrlGlob - DstInitOutputData%C_obj%NumSC2CtrlGlob = SrcInitOutputData%C_obj%NumSC2CtrlGlob - END SUBROUTINE SC_CopyInitOutput - - SUBROUTINE SC_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(SC_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE SC_DestroyInitOutput + ErrMsg = '' + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitOutputData%NumCtrl2SC = SrcInitOutputData%NumCtrl2SC + DstInitOutputData%C_obj%NumCtrl2SC = SrcInitOutputData%C_obj%NumCtrl2SC + DstInitOutputData%nInpGlobal = SrcInitOutputData%nInpGlobal + DstInitOutputData%C_obj%nInpGlobal = SrcInitOutputData%C_obj%nInpGlobal + DstInitOutputData%NumSC2Ctrl = SrcInitOutputData%NumSC2Ctrl + DstInitOutputData%C_obj%NumSC2Ctrl = SrcInitOutputData%C_obj%NumSC2Ctrl + DstInitOutputData%NumSC2CtrlGlob = SrcInitOutputData%NumSC2CtrlGlob + DstInitOutputData%C_obj%NumSC2CtrlGlob = SrcInitOutputData%C_obj%NumSC2CtrlGlob +end subroutine +subroutine SC_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(SC_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SC_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine SC_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -339,19 +315,14 @@ subroutine SC_PackInitOutput(Buf, Indata) call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - ! Ver call NWTC_Library_PackProgDesc(Buf, InData%Ver) if (RegCheckErr(Buf, RoutineName)) return - ! NumCtrl2SC call RegPack(Buf, InData%NumCtrl2SC) if (RegCheckErr(Buf, RoutineName)) return - ! nInpGlobal call RegPack(Buf, InData%nInpGlobal) if (RegCheckErr(Buf, RoutineName)) return - ! NumSC2Ctrl call RegPack(Buf, InData%NumSC2Ctrl) if (RegCheckErr(Buf, RoutineName)) return - ! NumSC2CtrlGlob call RegPack(Buf, InData%NumSC2CtrlGlob) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -361,21 +332,16 @@ subroutine SC_UnPackInitOutput(Buf, OutData) type(SC_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SC_UnPackInitOutput' if (Buf%ErrStat /= ErrID_None) return - ! Ver call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver - ! NumCtrl2SC call RegUnpack(Buf, OutData%NumCtrl2SC) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%NumCtrl2SC = OutData%NumCtrl2SC - ! nInpGlobal call RegUnpack(Buf, OutData%nInpGlobal) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%nInpGlobal = OutData%nInpGlobal - ! NumSC2Ctrl call RegUnpack(Buf, OutData%NumSC2Ctrl) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%NumSC2Ctrl = OutData%NumSC2Ctrl - ! NumSC2CtrlGlob call RegUnpack(Buf, OutData%NumSC2CtrlGlob) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%NumSC2CtrlGlob = OutData%NumSC2CtrlGlob @@ -422,103 +388,98 @@ SUBROUTINE SC_F2C_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers InitOutputData%C_obj%NumSC2CtrlGlob = InitOutputData%NumSC2CtrlGlob END SUBROUTINE SC_F2C_CopyInitOutput - SUBROUTINE SC_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_ParameterType), INTENT(IN) :: SrcParamData - TYPE(SC_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_CopyParam' -! + +subroutine SC_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(SC_ParameterType), intent(in) :: SrcParamData + type(SC_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SC_CopyParam' ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT - DstParamData%C_obj%DT = SrcParamData%C_obj%DT - DstParamData%nTurbines = SrcParamData%nTurbines - DstParamData%C_obj%nTurbines = SrcParamData%C_obj%nTurbines - DstParamData%NumCtrl2SC = SrcParamData%NumCtrl2SC - DstParamData%C_obj%NumCtrl2SC = SrcParamData%C_obj%NumCtrl2SC - DstParamData%nInpGlobal = SrcParamData%nInpGlobal - DstParamData%C_obj%nInpGlobal = SrcParamData%C_obj%nInpGlobal - DstParamData%NumSC2Ctrl = SrcParamData%NumSC2Ctrl - DstParamData%C_obj%NumSC2Ctrl = SrcParamData%C_obj%NumSC2Ctrl - DstParamData%NumSC2CtrlGlob = SrcParamData%NumSC2CtrlGlob - DstParamData%C_obj%NumSC2CtrlGlob = SrcParamData%C_obj%NumSC2CtrlGlob - DstParamData%NumStatesGlobal = SrcParamData%NumStatesGlobal - DstParamData%C_obj%NumStatesGlobal = SrcParamData%C_obj%NumStatesGlobal - DstParamData%NumStatesTurbine = SrcParamData%NumStatesTurbine - DstParamData%C_obj%NumStatesTurbine = SrcParamData%C_obj%NumStatesTurbine - DstParamData%NumParamGlobal = SrcParamData%NumParamGlobal - DstParamData%C_obj%NumParamGlobal = SrcParamData%C_obj%NumParamGlobal - DstParamData%NumParamTurbine = SrcParamData%NumParamTurbine - DstParamData%C_obj%NumParamTurbine = SrcParamData%C_obj%NumParamTurbine -IF (ASSOCIATED(SrcParamData%ParamGlobal)) THEN - i1_l = LBOUND(SrcParamData%ParamGlobal,1) - i1_u = UBOUND(SrcParamData%ParamGlobal,1) - IF (.NOT. ASSOCIATED(DstParamData%ParamGlobal)) THEN - ALLOCATE(DstParamData%ParamGlobal(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ParamGlobal.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstParamData%C_obj%ParamGlobal_Len = SIZE(DstParamData%ParamGlobal) - IF (DstParamData%C_obj%ParamGlobal_Len > 0) & - DstParamData%C_obj%ParamGlobal = C_LOC( DstParamData%ParamGlobal( i1_l ) ) - END IF - DstParamData%ParamGlobal = SrcParamData%ParamGlobal -ENDIF -IF (ASSOCIATED(SrcParamData%ParamTurbine)) THEN - i1_l = LBOUND(SrcParamData%ParamTurbine,1) - i1_u = UBOUND(SrcParamData%ParamTurbine,1) - IF (.NOT. ASSOCIATED(DstParamData%ParamTurbine)) THEN - ALLOCATE(DstParamData%ParamTurbine(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ParamTurbine.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstParamData%C_obj%ParamTurbine_Len = SIZE(DstParamData%ParamTurbine) - IF (DstParamData%C_obj%ParamTurbine_Len > 0) & - DstParamData%C_obj%ParamTurbine = C_LOC( DstParamData%ParamTurbine( i1_l ) ) - END IF - DstParamData%ParamTurbine = SrcParamData%ParamTurbine -ENDIF - DstParamData%DLL_Trgt = SrcParamData%DLL_Trgt - END SUBROUTINE SC_CopyParam - - SUBROUTINE SC_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(SC_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ASSOCIATED(ParamData%ParamGlobal)) THEN - DEALLOCATE(ParamData%ParamGlobal) - ParamData%ParamGlobal => NULL() - ParamData%C_obj%ParamGlobal = C_NULL_PTR - ParamData%C_obj%ParamGlobal_Len = 0 -ENDIF -IF (ASSOCIATED(ParamData%ParamTurbine)) THEN - DEALLOCATE(ParamData%ParamTurbine) - ParamData%ParamTurbine => NULL() - ParamData%C_obj%ParamTurbine = C_NULL_PTR - ParamData%C_obj%ParamTurbine_Len = 0 -ENDIF - CALL FreeDynamicLib( ParamData%DLL_Trgt, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE SC_DestroyParam + ErrMsg = '' + DstParamData%DT = SrcParamData%DT + DstParamData%C_obj%DT = SrcParamData%C_obj%DT + DstParamData%nTurbines = SrcParamData%nTurbines + DstParamData%C_obj%nTurbines = SrcParamData%C_obj%nTurbines + DstParamData%NumCtrl2SC = SrcParamData%NumCtrl2SC + DstParamData%C_obj%NumCtrl2SC = SrcParamData%C_obj%NumCtrl2SC + DstParamData%nInpGlobal = SrcParamData%nInpGlobal + DstParamData%C_obj%nInpGlobal = SrcParamData%C_obj%nInpGlobal + DstParamData%NumSC2Ctrl = SrcParamData%NumSC2Ctrl + DstParamData%C_obj%NumSC2Ctrl = SrcParamData%C_obj%NumSC2Ctrl + DstParamData%NumSC2CtrlGlob = SrcParamData%NumSC2CtrlGlob + DstParamData%C_obj%NumSC2CtrlGlob = SrcParamData%C_obj%NumSC2CtrlGlob + DstParamData%NumStatesGlobal = SrcParamData%NumStatesGlobal + DstParamData%C_obj%NumStatesGlobal = SrcParamData%C_obj%NumStatesGlobal + DstParamData%NumStatesTurbine = SrcParamData%NumStatesTurbine + DstParamData%C_obj%NumStatesTurbine = SrcParamData%C_obj%NumStatesTurbine + DstParamData%NumParamGlobal = SrcParamData%NumParamGlobal + DstParamData%C_obj%NumParamGlobal = SrcParamData%C_obj%NumParamGlobal + DstParamData%NumParamTurbine = SrcParamData%NumParamTurbine + DstParamData%C_obj%NumParamTurbine = SrcParamData%C_obj%NumParamTurbine + if (associated(SrcParamData%ParamGlobal)) then + LB(1:1) = lbound(SrcParamData%ParamGlobal) + UB(1:1) = ubound(SrcParamData%ParamGlobal) + if (.not. associated(DstParamData%ParamGlobal)) then + allocate(DstParamData%ParamGlobal(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ParamGlobal.', ErrStat, ErrMsg, RoutineName) + return + end if + DstParamData%C_obj%ParamGlobal_Len = size(DstParamData%ParamGlobal) + if (DstParamData%C_obj%ParamGlobal_Len > 0) & + DstParamData%C_obj%ParamGlobal = c_loc(DstParamData%ParamGlobal(LB(1))) + end if + DstParamData%ParamGlobal = SrcParamData%ParamGlobal + else if (associated(DstParamData%ParamGlobal)) then + deallocate(DstParamData%ParamGlobal) + end if + if (associated(SrcParamData%ParamTurbine)) then + LB(1:1) = lbound(SrcParamData%ParamTurbine) + UB(1:1) = ubound(SrcParamData%ParamTurbine) + if (.not. associated(DstParamData%ParamTurbine)) then + allocate(DstParamData%ParamTurbine(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ParamTurbine.', ErrStat, ErrMsg, RoutineName) + return + end if + DstParamData%C_obj%ParamTurbine_Len = size(DstParamData%ParamTurbine) + if (DstParamData%C_obj%ParamTurbine_Len > 0) & + DstParamData%C_obj%ParamTurbine = c_loc(DstParamData%ParamTurbine(LB(1))) + end if + DstParamData%ParamTurbine = SrcParamData%ParamTurbine + else if (associated(DstParamData%ParamTurbine)) then + deallocate(DstParamData%ParamTurbine) + end if + DstParamData%DLL_Trgt = SrcParamData%DLL_Trgt +end subroutine +subroutine SC_DestroyParam(ParamData, ErrStat, ErrMsg) + type(SC_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SC_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(ParamData%ParamGlobal)) then + deallocate(ParamData%ParamGlobal) + ParamData%ParamGlobal => null() + ParamData%C_obj%ParamGlobal = c_null_ptr + ParamData%C_obj%ParamGlobal_Len = 0 + end if + if (associated(ParamData%ParamTurbine)) then + deallocate(ParamData%ParamTurbine) + ParamData%ParamTurbine => null() + ParamData%C_obj%ParamTurbine = c_null_ptr + ParamData%C_obj%ParamTurbine_Len = 0 + end if +end subroutine subroutine SC_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -530,37 +491,26 @@ subroutine SC_PackParam(Buf, Indata) call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - ! DT call RegPack(Buf, InData%DT) if (RegCheckErr(Buf, RoutineName)) return - ! nTurbines call RegPack(Buf, InData%nTurbines) if (RegCheckErr(Buf, RoutineName)) return - ! NumCtrl2SC call RegPack(Buf, InData%NumCtrl2SC) if (RegCheckErr(Buf, RoutineName)) return - ! nInpGlobal call RegPack(Buf, InData%nInpGlobal) if (RegCheckErr(Buf, RoutineName)) return - ! NumSC2Ctrl call RegPack(Buf, InData%NumSC2Ctrl) if (RegCheckErr(Buf, RoutineName)) return - ! NumSC2CtrlGlob call RegPack(Buf, InData%NumSC2CtrlGlob) if (RegCheckErr(Buf, RoutineName)) return - ! NumStatesGlobal call RegPack(Buf, InData%NumStatesGlobal) if (RegCheckErr(Buf, RoutineName)) return - ! NumStatesTurbine call RegPack(Buf, InData%NumStatesTurbine) if (RegCheckErr(Buf, RoutineName)) return - ! NumParamGlobal call RegPack(Buf, InData%NumParamGlobal) if (RegCheckErr(Buf, RoutineName)) return - ! NumParamTurbine call RegPack(Buf, InData%NumParamTurbine) if (RegCheckErr(Buf, RoutineName)) return - ! ParamGlobal call RegPack(Buf, associated(InData%ParamGlobal)) if (associated(InData%ParamGlobal)) then call RegPackBounds(Buf, 1, lbound(InData%ParamGlobal), ubound(InData%ParamGlobal)) @@ -570,7 +520,6 @@ subroutine SC_PackParam(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! ParamTurbine call RegPack(Buf, associated(InData%ParamTurbine)) if (associated(InData%ParamTurbine)) then call RegPackBounds(Buf, 1, lbound(InData%ParamTurbine), ubound(InData%ParamTurbine)) @@ -580,7 +529,6 @@ subroutine SC_PackParam(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! DLL_Trgt call DLLTypePack(Buf, InData%DLL_Trgt) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -595,47 +543,36 @@ subroutine SC_UnPackParam(Buf, OutData) integer(IntKi) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return - ! DT call RegUnpack(Buf, OutData%DT) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%DT = OutData%DT - ! nTurbines call RegUnpack(Buf, OutData%nTurbines) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%nTurbines = OutData%nTurbines - ! NumCtrl2SC call RegUnpack(Buf, OutData%NumCtrl2SC) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%NumCtrl2SC = OutData%NumCtrl2SC - ! nInpGlobal call RegUnpack(Buf, OutData%nInpGlobal) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%nInpGlobal = OutData%nInpGlobal - ! NumSC2Ctrl call RegUnpack(Buf, OutData%NumSC2Ctrl) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%NumSC2Ctrl = OutData%NumSC2Ctrl - ! NumSC2CtrlGlob call RegUnpack(Buf, OutData%NumSC2CtrlGlob) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%NumSC2CtrlGlob = OutData%NumSC2CtrlGlob - ! NumStatesGlobal call RegUnpack(Buf, OutData%NumStatesGlobal) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%NumStatesGlobal = OutData%NumStatesGlobal - ! NumStatesTurbine call RegUnpack(Buf, OutData%NumStatesTurbine) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%NumStatesTurbine = OutData%NumStatesTurbine - ! NumParamGlobal call RegUnpack(Buf, OutData%NumParamGlobal) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%NumParamGlobal = OutData%NumParamGlobal - ! NumParamTurbine call RegUnpack(Buf, OutData%NumParamTurbine) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%NumParamTurbine = OutData%NumParamTurbine - ! ParamGlobal if (associated(OutData%ParamGlobal)) deallocate(OutData%ParamGlobal) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -662,7 +599,6 @@ subroutine SC_UnPackParam(Buf, OutData) else OutData%ParamGlobal => null() end if - ! ParamTurbine if (associated(OutData%ParamTurbine)) deallocate(OutData%ParamTurbine) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -689,7 +625,6 @@ subroutine SC_UnPackParam(Buf, OutData) else OutData%ParamTurbine => null() end if - ! DLL_Trgt call DLLTypeUnpack(Buf, OutData%DLL_Trgt) ! DLL_Trgt end subroutine SUBROUTINE SC_C2Fary_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) @@ -788,80 +723,74 @@ SUBROUTINE SC_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) END IF END SUBROUTINE SC_F2C_CopyParam - SUBROUTINE SC_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(SC_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_CopyDiscState' -! + +subroutine SC_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(SC_DiscreteStateType), intent(in) :: SrcDiscStateData + type(SC_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SC_CopyDiscState' ErrStat = ErrID_None - ErrMsg = "" -IF (ASSOCIATED(SrcDiscStateData%Global)) THEN - i1_l = LBOUND(SrcDiscStateData%Global,1) - i1_u = UBOUND(SrcDiscStateData%Global,1) - IF (.NOT. ASSOCIATED(DstDiscStateData%Global)) THEN - ALLOCATE(DstDiscStateData%Global(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Global.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstDiscStateData%C_obj%Global_Len = SIZE(DstDiscStateData%Global) - IF (DstDiscStateData%C_obj%Global_Len > 0) & - DstDiscStateData%C_obj%Global = C_LOC( DstDiscStateData%Global( i1_l ) ) - END IF - DstDiscStateData%Global = SrcDiscStateData%Global -ENDIF -IF (ASSOCIATED(SrcDiscStateData%Turbine)) THEN - i1_l = LBOUND(SrcDiscStateData%Turbine,1) - i1_u = UBOUND(SrcDiscStateData%Turbine,1) - IF (.NOT. ASSOCIATED(DstDiscStateData%Turbine)) THEN - ALLOCATE(DstDiscStateData%Turbine(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Turbine.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstDiscStateData%C_obj%Turbine_Len = SIZE(DstDiscStateData%Turbine) - IF (DstDiscStateData%C_obj%Turbine_Len > 0) & - DstDiscStateData%C_obj%Turbine = C_LOC( DstDiscStateData%Turbine( i1_l ) ) - END IF - DstDiscStateData%Turbine = SrcDiscStateData%Turbine -ENDIF - END SUBROUTINE SC_CopyDiscState - - SUBROUTINE SC_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(SC_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ASSOCIATED(DiscStateData%Global)) THEN - DEALLOCATE(DiscStateData%Global) - DiscStateData%Global => NULL() - DiscStateData%C_obj%Global = C_NULL_PTR - DiscStateData%C_obj%Global_Len = 0 -ENDIF -IF (ASSOCIATED(DiscStateData%Turbine)) THEN - DEALLOCATE(DiscStateData%Turbine) - DiscStateData%Turbine => NULL() - DiscStateData%C_obj%Turbine = C_NULL_PTR - DiscStateData%C_obj%Turbine_Len = 0 -ENDIF - END SUBROUTINE SC_DestroyDiscState + ErrMsg = '' + if (associated(SrcDiscStateData%Global)) then + LB(1:1) = lbound(SrcDiscStateData%Global) + UB(1:1) = ubound(SrcDiscStateData%Global) + if (.not. associated(DstDiscStateData%Global)) then + allocate(DstDiscStateData%Global(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Global.', ErrStat, ErrMsg, RoutineName) + return + end if + DstDiscStateData%C_obj%Global_Len = size(DstDiscStateData%Global) + if (DstDiscStateData%C_obj%Global_Len > 0) & + DstDiscStateData%C_obj%Global = c_loc(DstDiscStateData%Global(LB(1))) + end if + DstDiscStateData%Global = SrcDiscStateData%Global + else if (associated(DstDiscStateData%Global)) then + deallocate(DstDiscStateData%Global) + end if + if (associated(SrcDiscStateData%Turbine)) then + LB(1:1) = lbound(SrcDiscStateData%Turbine) + UB(1:1) = ubound(SrcDiscStateData%Turbine) + if (.not. associated(DstDiscStateData%Turbine)) then + allocate(DstDiscStateData%Turbine(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Turbine.', ErrStat, ErrMsg, RoutineName) + return + end if + DstDiscStateData%C_obj%Turbine_Len = size(DstDiscStateData%Turbine) + if (DstDiscStateData%C_obj%Turbine_Len > 0) & + DstDiscStateData%C_obj%Turbine = c_loc(DstDiscStateData%Turbine(LB(1))) + end if + DstDiscStateData%Turbine = SrcDiscStateData%Turbine + else if (associated(DstDiscStateData%Turbine)) then + deallocate(DstDiscStateData%Turbine) + end if +end subroutine +subroutine SC_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(SC_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SC_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(DiscStateData%Global)) then + deallocate(DiscStateData%Global) + DiscStateData%Global => null() + DiscStateData%C_obj%Global = c_null_ptr + DiscStateData%C_obj%Global_Len = 0 + end if + if (associated(DiscStateData%Turbine)) then + deallocate(DiscStateData%Turbine) + DiscStateData%Turbine => null() + DiscStateData%C_obj%Turbine = c_null_ptr + DiscStateData%C_obj%Turbine_Len = 0 + end if +end subroutine subroutine SC_PackDiscState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -873,7 +802,6 @@ subroutine SC_PackDiscState(Buf, Indata) call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - ! Global call RegPack(Buf, associated(InData%Global)) if (associated(InData%Global)) then call RegPackBounds(Buf, 1, lbound(InData%Global), ubound(InData%Global)) @@ -883,7 +811,6 @@ subroutine SC_PackDiscState(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! Turbine call RegPack(Buf, associated(InData%Turbine)) if (associated(InData%Turbine)) then call RegPackBounds(Buf, 1, lbound(InData%Turbine), ubound(InData%Turbine)) @@ -905,7 +832,6 @@ subroutine SC_UnPackDiscState(Buf, OutData) integer(IntKi) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return - ! Global if (associated(OutData%Global)) deallocate(OutData%Global) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -932,7 +858,6 @@ subroutine SC_UnPackDiscState(Buf, OutData) else OutData%Global => null() end if - ! Turbine if (associated(OutData%Turbine)) deallocate(OutData%Turbine) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1036,39 +961,28 @@ SUBROUTINE SC_F2C_CopyDiscState( DiscStateData, ErrStat, ErrMsg, SkipPointers ) END IF END SUBROUTINE SC_F2C_CopyDiscState - SUBROUTINE SC_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(SC_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%Dummy = SrcContStateData%Dummy - DstContStateData%C_obj%Dummy = SrcContStateData%C_obj%Dummy - END SUBROUTINE SC_CopyContState - - SUBROUTINE SC_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(SC_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE SC_DestroyContState +subroutine SC_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(SC_ContinuousStateType), intent(in) :: SrcContStateData + type(SC_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SC_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + DstContStateData%Dummy = SrcContStateData%Dummy + DstContStateData%C_obj%Dummy = SrcContStateData%C_obj%Dummy +end subroutine +subroutine SC_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(SC_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SC_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine SC_PackContState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -1079,7 +993,6 @@ subroutine SC_PackContState(Buf, Indata) call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - ! Dummy call RegPack(Buf, InData%Dummy) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1089,7 +1002,6 @@ subroutine SC_UnPackContState(Buf, OutData) type(SC_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SC_UnPackContState' if (Buf%ErrStat /= ErrID_None) return - ! Dummy call RegUnpack(Buf, OutData%Dummy) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%Dummy = OutData%Dummy @@ -1130,39 +1042,28 @@ SUBROUTINE SC_F2C_CopyContState( ContStateData, ErrStat, ErrMsg, SkipPointers ) ContStateData%C_obj%Dummy = ContStateData%Dummy END SUBROUTINE SC_F2C_CopyContState - SUBROUTINE SC_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(SC_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%Dummy = SrcConstrStateData%Dummy - DstConstrStateData%C_obj%Dummy = SrcConstrStateData%C_obj%Dummy - END SUBROUTINE SC_CopyConstrState - - SUBROUTINE SC_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(SC_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyConstrState' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE SC_DestroyConstrState +subroutine SC_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(SC_ConstraintStateType), intent(in) :: SrcConstrStateData + type(SC_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SC_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%Dummy = SrcConstrStateData%Dummy + DstConstrStateData%C_obj%Dummy = SrcConstrStateData%C_obj%Dummy +end subroutine +subroutine SC_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(SC_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SC_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine SC_PackConstrState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -1173,7 +1074,6 @@ subroutine SC_PackConstrState(Buf, Indata) call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - ! Dummy call RegPack(Buf, InData%Dummy) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1183,7 +1083,6 @@ subroutine SC_UnPackConstrState(Buf, OutData) type(SC_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SC_UnPackConstrState' if (Buf%ErrStat /= ErrID_None) return - ! Dummy call RegUnpack(Buf, OutData%Dummy) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%Dummy = OutData%Dummy @@ -1224,39 +1123,28 @@ SUBROUTINE SC_F2C_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointer ConstrStateData%C_obj%Dummy = ConstrStateData%Dummy END SUBROUTINE SC_F2C_CopyConstrState - SUBROUTINE SC_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(SC_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%Dummy = SrcMiscData%Dummy - DstMiscData%C_obj%Dummy = SrcMiscData%C_obj%Dummy - END SUBROUTINE SC_CopyMisc - - SUBROUTINE SC_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(SC_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyMisc' - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE SC_DestroyMisc +subroutine SC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(SC_MiscVarType), intent(in) :: SrcMiscData + type(SC_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SC_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + DstMiscData%Dummy = SrcMiscData%Dummy + DstMiscData%C_obj%Dummy = SrcMiscData%C_obj%Dummy +end subroutine +subroutine SC_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(SC_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SC_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine SC_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -1267,7 +1155,6 @@ subroutine SC_PackMisc(Buf, Indata) call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - ! Dummy call RegPack(Buf, InData%Dummy) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1277,7 +1164,6 @@ subroutine SC_UnPackMisc(Buf, OutData) type(SC_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SC_UnPackMisc' if (Buf%ErrStat /= ErrID_None) return - ! Dummy call RegUnpack(Buf, OutData%Dummy) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%Dummy = OutData%Dummy @@ -1318,39 +1204,28 @@ SUBROUTINE SC_F2C_CopyMisc( MiscData, ErrStat, ErrMsg, SkipPointers ) MiscData%C_obj%Dummy = MiscData%Dummy END SUBROUTINE SC_F2C_CopyMisc - SUBROUTINE SC_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(SC_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%Dummy = SrcOtherStateData%Dummy - DstOtherStateData%C_obj%Dummy = SrcOtherStateData%C_obj%Dummy - END SUBROUTINE SC_CopyOtherState - - SUBROUTINE SC_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(SC_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE SC_DestroyOtherState +subroutine SC_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(SC_OtherStateType), intent(in) :: SrcOtherStateData + type(SC_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SC_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%Dummy = SrcOtherStateData%Dummy + DstOtherStateData%C_obj%Dummy = SrcOtherStateData%C_obj%Dummy +end subroutine +subroutine SC_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(SC_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SC_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine SC_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -1361,7 +1236,6 @@ subroutine SC_PackOtherState(Buf, Indata) call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - ! Dummy call RegPack(Buf, InData%Dummy) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1371,7 +1245,6 @@ subroutine SC_UnPackOtherState(Buf, OutData) type(SC_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SC_UnPackOtherState' if (Buf%ErrStat /= ErrID_None) return - ! Dummy call RegUnpack(Buf, OutData%Dummy) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%Dummy = OutData%Dummy @@ -1412,80 +1285,74 @@ SUBROUTINE SC_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers OtherStateData%C_obj%Dummy = OtherStateData%Dummy END SUBROUTINE SC_F2C_CopyOtherState - SUBROUTINE SC_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_InputType), INTENT(IN) :: SrcInputData - TYPE(SC_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_CopyInput' -! + +subroutine SC_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(SC_InputType), intent(in) :: SrcInputData + type(SC_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SC_CopyInput' ErrStat = ErrID_None - ErrMsg = "" -IF (ASSOCIATED(SrcInputData%toSCglob)) THEN - i1_l = LBOUND(SrcInputData%toSCglob,1) - i1_u = UBOUND(SrcInputData%toSCglob,1) - IF (.NOT. ASSOCIATED(DstInputData%toSCglob)) THEN - ALLOCATE(DstInputData%toSCglob(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%toSCglob.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%C_obj%toSCglob_Len = SIZE(DstInputData%toSCglob) - IF (DstInputData%C_obj%toSCglob_Len > 0) & - DstInputData%C_obj%toSCglob = C_LOC( DstInputData%toSCglob( i1_l ) ) - END IF - DstInputData%toSCglob = SrcInputData%toSCglob -ENDIF -IF (ASSOCIATED(SrcInputData%toSC)) THEN - i1_l = LBOUND(SrcInputData%toSC,1) - i1_u = UBOUND(SrcInputData%toSC,1) - IF (.NOT. ASSOCIATED(DstInputData%toSC)) THEN - ALLOCATE(DstInputData%toSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%toSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstInputData%C_obj%toSC_Len = SIZE(DstInputData%toSC) - IF (DstInputData%C_obj%toSC_Len > 0) & - DstInputData%C_obj%toSC = C_LOC( DstInputData%toSC( i1_l ) ) - END IF - DstInputData%toSC = SrcInputData%toSC -ENDIF - END SUBROUTINE SC_CopyInput - - SUBROUTINE SC_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(SC_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ASSOCIATED(InputData%toSCglob)) THEN - DEALLOCATE(InputData%toSCglob) - InputData%toSCglob => NULL() - InputData%C_obj%toSCglob = C_NULL_PTR - InputData%C_obj%toSCglob_Len = 0 -ENDIF -IF (ASSOCIATED(InputData%toSC)) THEN - DEALLOCATE(InputData%toSC) - InputData%toSC => NULL() - InputData%C_obj%toSC = C_NULL_PTR - InputData%C_obj%toSC_Len = 0 -ENDIF - END SUBROUTINE SC_DestroyInput + ErrMsg = '' + if (associated(SrcInputData%toSCglob)) then + LB(1:1) = lbound(SrcInputData%toSCglob) + UB(1:1) = ubound(SrcInputData%toSCglob) + if (.not. associated(DstInputData%toSCglob)) then + allocate(DstInputData%toSCglob(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%toSCglob.', ErrStat, ErrMsg, RoutineName) + return + end if + DstInputData%C_obj%toSCglob_Len = size(DstInputData%toSCglob) + if (DstInputData%C_obj%toSCglob_Len > 0) & + DstInputData%C_obj%toSCglob = c_loc(DstInputData%toSCglob(LB(1))) + end if + DstInputData%toSCglob = SrcInputData%toSCglob + else if (associated(DstInputData%toSCglob)) then + deallocate(DstInputData%toSCglob) + end if + if (associated(SrcInputData%toSC)) then + LB(1:1) = lbound(SrcInputData%toSC) + UB(1:1) = ubound(SrcInputData%toSC) + if (.not. associated(DstInputData%toSC)) then + allocate(DstInputData%toSC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%toSC.', ErrStat, ErrMsg, RoutineName) + return + end if + DstInputData%C_obj%toSC_Len = size(DstInputData%toSC) + if (DstInputData%C_obj%toSC_Len > 0) & + DstInputData%C_obj%toSC = c_loc(DstInputData%toSC(LB(1))) + end if + DstInputData%toSC = SrcInputData%toSC + else if (associated(DstInputData%toSC)) then + deallocate(DstInputData%toSC) + end if +end subroutine +subroutine SC_DestroyInput(InputData, ErrStat, ErrMsg) + type(SC_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SC_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(InputData%toSCglob)) then + deallocate(InputData%toSCglob) + InputData%toSCglob => null() + InputData%C_obj%toSCglob = c_null_ptr + InputData%C_obj%toSCglob_Len = 0 + end if + if (associated(InputData%toSC)) then + deallocate(InputData%toSC) + InputData%toSC => null() + InputData%C_obj%toSC = c_null_ptr + InputData%C_obj%toSC_Len = 0 + end if +end subroutine subroutine SC_PackInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -1497,7 +1364,6 @@ subroutine SC_PackInput(Buf, Indata) call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - ! toSCglob call RegPack(Buf, associated(InData%toSCglob)) if (associated(InData%toSCglob)) then call RegPackBounds(Buf, 1, lbound(InData%toSCglob), ubound(InData%toSCglob)) @@ -1507,7 +1373,6 @@ subroutine SC_PackInput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! toSC call RegPack(Buf, associated(InData%toSC)) if (associated(InData%toSC)) then call RegPackBounds(Buf, 1, lbound(InData%toSC), ubound(InData%toSC)) @@ -1529,7 +1394,6 @@ subroutine SC_UnPackInput(Buf, OutData) integer(IntKi) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return - ! toSCglob if (associated(OutData%toSCglob)) deallocate(OutData%toSCglob) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1556,7 +1420,6 @@ subroutine SC_UnPackInput(Buf, OutData) else OutData%toSCglob => null() end if - ! toSC if (associated(OutData%toSC)) deallocate(OutData%toSC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1660,80 +1523,74 @@ SUBROUTINE SC_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) END IF END SUBROUTINE SC_F2C_CopyInput - SUBROUTINE SC_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SC_OutputType), INTENT(IN) :: SrcOutputData - TYPE(SC_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_CopyOutput' -! + +subroutine SC_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(SC_OutputType), intent(in) :: SrcOutputData + type(SC_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SC_CopyOutput' ErrStat = ErrID_None - ErrMsg = "" -IF (ASSOCIATED(SrcOutputData%fromSCglob)) THEN - i1_l = LBOUND(SrcOutputData%fromSCglob,1) - i1_u = UBOUND(SrcOutputData%fromSCglob,1) - IF (.NOT. ASSOCIATED(DstOutputData%fromSCglob)) THEN - ALLOCATE(DstOutputData%fromSCglob(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%fromSCglob.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOutputData%C_obj%fromSCglob_Len = SIZE(DstOutputData%fromSCglob) - IF (DstOutputData%C_obj%fromSCglob_Len > 0) & - DstOutputData%C_obj%fromSCglob = C_LOC( DstOutputData%fromSCglob( i1_l ) ) - END IF - DstOutputData%fromSCglob = SrcOutputData%fromSCglob -ENDIF -IF (ASSOCIATED(SrcOutputData%fromSC)) THEN - i1_l = LBOUND(SrcOutputData%fromSC,1) - i1_u = UBOUND(SrcOutputData%fromSC,1) - IF (.NOT. ASSOCIATED(DstOutputData%fromSC)) THEN - ALLOCATE(DstOutputData%fromSC(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%fromSC.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DstOutputData%C_obj%fromSC_Len = SIZE(DstOutputData%fromSC) - IF (DstOutputData%C_obj%fromSC_Len > 0) & - DstOutputData%C_obj%fromSC = C_LOC( DstOutputData%fromSC( i1_l ) ) - END IF - DstOutputData%fromSC = SrcOutputData%fromSC -ENDIF - END SUBROUTINE SC_CopyOutput - - SUBROUTINE SC_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(SC_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SC_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ASSOCIATED(OutputData%fromSCglob)) THEN - DEALLOCATE(OutputData%fromSCglob) - OutputData%fromSCglob => NULL() - OutputData%C_obj%fromSCglob = C_NULL_PTR - OutputData%C_obj%fromSCglob_Len = 0 -ENDIF -IF (ASSOCIATED(OutputData%fromSC)) THEN - DEALLOCATE(OutputData%fromSC) - OutputData%fromSC => NULL() - OutputData%C_obj%fromSC = C_NULL_PTR - OutputData%C_obj%fromSC_Len = 0 -ENDIF - END SUBROUTINE SC_DestroyOutput + ErrMsg = '' + if (associated(SrcOutputData%fromSCglob)) then + LB(1:1) = lbound(SrcOutputData%fromSCglob) + UB(1:1) = ubound(SrcOutputData%fromSCglob) + if (.not. associated(DstOutputData%fromSCglob)) then + allocate(DstOutputData%fromSCglob(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%fromSCglob.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOutputData%C_obj%fromSCglob_Len = size(DstOutputData%fromSCglob) + if (DstOutputData%C_obj%fromSCglob_Len > 0) & + DstOutputData%C_obj%fromSCglob = c_loc(DstOutputData%fromSCglob(LB(1))) + end if + DstOutputData%fromSCglob = SrcOutputData%fromSCglob + else if (associated(DstOutputData%fromSCglob)) then + deallocate(DstOutputData%fromSCglob) + end if + if (associated(SrcOutputData%fromSC)) then + LB(1:1) = lbound(SrcOutputData%fromSC) + UB(1:1) = ubound(SrcOutputData%fromSC) + if (.not. associated(DstOutputData%fromSC)) then + allocate(DstOutputData%fromSC(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%fromSC.', ErrStat, ErrMsg, RoutineName) + return + end if + DstOutputData%C_obj%fromSC_Len = size(DstOutputData%fromSC) + if (DstOutputData%C_obj%fromSC_Len > 0) & + DstOutputData%C_obj%fromSC = c_loc(DstOutputData%fromSC(LB(1))) + end if + DstOutputData%fromSC = SrcOutputData%fromSC + else if (associated(DstOutputData%fromSC)) then + deallocate(DstOutputData%fromSC) + end if +end subroutine +subroutine SC_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(SC_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SC_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (associated(OutputData%fromSCglob)) then + deallocate(OutputData%fromSCglob) + OutputData%fromSCglob => null() + OutputData%C_obj%fromSCglob = c_null_ptr + OutputData%C_obj%fromSCglob_Len = 0 + end if + if (associated(OutputData%fromSC)) then + deallocate(OutputData%fromSC) + OutputData%fromSC => null() + OutputData%C_obj%fromSC = c_null_ptr + OutputData%C_obj%fromSC_Len = 0 + end if +end subroutine subroutine SC_PackOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -1745,7 +1602,6 @@ subroutine SC_PackOutput(Buf, Indata) call SetErrStat(ErrID_Severe,'C_obj%object cannot be packed.', Buf%ErrStat, Buf%ErrMsg, RoutineName) return end if - ! fromSCglob call RegPack(Buf, associated(InData%fromSCglob)) if (associated(InData%fromSCglob)) then call RegPackBounds(Buf, 1, lbound(InData%fromSCglob), ubound(InData%fromSCglob)) @@ -1755,7 +1611,6 @@ subroutine SC_PackOutput(Buf, Indata) end if end if if (RegCheckErr(Buf, RoutineName)) return - ! fromSC call RegPack(Buf, associated(InData%fromSC)) if (associated(InData%fromSC)) then call RegPackBounds(Buf, 1, lbound(InData%fromSC), ubound(InData%fromSC)) @@ -1777,7 +1632,6 @@ subroutine SC_UnPackOutput(Buf, OutData) integer(IntKi) :: PtrIdx type(c_ptr) :: Ptr if (Buf%ErrStat /= ErrID_None) return - ! fromSCglob if (associated(OutData%fromSCglob)) deallocate(OutData%fromSCglob) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1804,7 +1658,6 @@ subroutine SC_UnPackOutput(Buf, OutData) else OutData%fromSCglob => null() end if - ! fromSC if (associated(OutData%fromSC)) deallocate(OutData%fromSC) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/wakedynamics/src/WakeDynamics_Types.f90 b/modules/wakedynamics/src/WakeDynamics_Types.f90 index 81ae0a415b..185cfb926b 100644 --- a/modules/wakedynamics/src/WakeDynamics_Types.f90 +++ b/modules/wakedynamics/src/WakeDynamics_Types.f90 @@ -229,169 +229,126 @@ MODULE WakeDynamics_Types END TYPE WD_OutputType ! ======================= CONTAINS - SUBROUTINE WD_CopyInputFileType( SrcInputFileTypeData, DstInputFileTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WD_InputFileType), INTENT(IN) :: SrcInputFileTypeData - TYPE(WD_InputFileType), INTENT(INOUT) :: DstInputFileTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_CopyInputFileType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInputFileTypeData%dr = SrcInputFileTypeData%dr - DstInputFileTypeData%NumRadii = SrcInputFileTypeData%NumRadii - DstInputFileTypeData%NumPlanes = SrcInputFileTypeData%NumPlanes - DstInputFileTypeData%Mod_Wake = SrcInputFileTypeData%Mod_Wake - DstInputFileTypeData%f_c = SrcInputFileTypeData%f_c - DstInputFileTypeData%C_HWkDfl_O = SrcInputFileTypeData%C_HWkDfl_O - DstInputFileTypeData%C_HWkDfl_OY = SrcInputFileTypeData%C_HWkDfl_OY - DstInputFileTypeData%C_HWkDfl_x = SrcInputFileTypeData%C_HWkDfl_x - DstInputFileTypeData%C_HWkDfl_xY = SrcInputFileTypeData%C_HWkDfl_xY - DstInputFileTypeData%C_NearWake = SrcInputFileTypeData%C_NearWake - DstInputFileTypeData%k_vAmb = SrcInputFileTypeData%k_vAmb - DstInputFileTypeData%k_vShr = SrcInputFileTypeData%k_vShr - DstInputFileTypeData%C_vAmb_DMin = SrcInputFileTypeData%C_vAmb_DMin - DstInputFileTypeData%C_vAmb_DMax = SrcInputFileTypeData%C_vAmb_DMax - DstInputFileTypeData%C_vAmb_FMin = SrcInputFileTypeData%C_vAmb_FMin - DstInputFileTypeData%C_vAmb_Exp = SrcInputFileTypeData%C_vAmb_Exp - DstInputFileTypeData%C_vShr_DMin = SrcInputFileTypeData%C_vShr_DMin - DstInputFileTypeData%C_vShr_DMax = SrcInputFileTypeData%C_vShr_DMax - DstInputFileTypeData%C_vShr_FMin = SrcInputFileTypeData%C_vShr_FMin - DstInputFileTypeData%C_vShr_Exp = SrcInputFileTypeData%C_vShr_Exp - DstInputFileTypeData%Mod_WakeDiam = SrcInputFileTypeData%Mod_WakeDiam - DstInputFileTypeData%C_WakeDiam = SrcInputFileTypeData%C_WakeDiam - DstInputFileTypeData%Swirl = SrcInputFileTypeData%Swirl - DstInputFileTypeData%k_VortexDecay = SrcInputFileTypeData%k_VortexDecay - DstInputFileTypeData%sigma_D = SrcInputFileTypeData%sigma_D - DstInputFileTypeData%NumVortices = SrcInputFileTypeData%NumVortices - DstInputFileTypeData%FilterInit = SrcInputFileTypeData%FilterInit - DstInputFileTypeData%k_vCurl = SrcInputFileTypeData%k_vCurl - DstInputFileTypeData%OutAllPlanes = SrcInputFileTypeData%OutAllPlanes - DstInputFileTypeData%WAT = SrcInputFileTypeData%WAT - DstInputFileTypeData%WAT_k_Def = SrcInputFileTypeData%WAT_k_Def - DstInputFileTypeData%WAT_k_Grad = SrcInputFileTypeData%WAT_k_Grad - END SUBROUTINE WD_CopyInputFileType - - SUBROUTINE WD_DestroyInputFileType( InputFileTypeData, ErrStat, ErrMsg ) - TYPE(WD_InputFileType), INTENT(INOUT) :: InputFileTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyInputFileType' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE WD_DestroyInputFileType +subroutine WD_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, CtrlCode, ErrStat, ErrMsg) + type(WD_InputFileType), intent(in) :: SrcInputFileTypeData + type(WD_InputFileType), intent(inout) :: DstInputFileTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WD_CopyInputFileType' + ErrStat = ErrID_None + ErrMsg = '' + DstInputFileTypeData%dr = SrcInputFileTypeData%dr + DstInputFileTypeData%NumRadii = SrcInputFileTypeData%NumRadii + DstInputFileTypeData%NumPlanes = SrcInputFileTypeData%NumPlanes + DstInputFileTypeData%Mod_Wake = SrcInputFileTypeData%Mod_Wake + DstInputFileTypeData%f_c = SrcInputFileTypeData%f_c + DstInputFileTypeData%C_HWkDfl_O = SrcInputFileTypeData%C_HWkDfl_O + DstInputFileTypeData%C_HWkDfl_OY = SrcInputFileTypeData%C_HWkDfl_OY + DstInputFileTypeData%C_HWkDfl_x = SrcInputFileTypeData%C_HWkDfl_x + DstInputFileTypeData%C_HWkDfl_xY = SrcInputFileTypeData%C_HWkDfl_xY + DstInputFileTypeData%C_NearWake = SrcInputFileTypeData%C_NearWake + DstInputFileTypeData%k_vAmb = SrcInputFileTypeData%k_vAmb + DstInputFileTypeData%k_vShr = SrcInputFileTypeData%k_vShr + DstInputFileTypeData%C_vAmb_DMin = SrcInputFileTypeData%C_vAmb_DMin + DstInputFileTypeData%C_vAmb_DMax = SrcInputFileTypeData%C_vAmb_DMax + DstInputFileTypeData%C_vAmb_FMin = SrcInputFileTypeData%C_vAmb_FMin + DstInputFileTypeData%C_vAmb_Exp = SrcInputFileTypeData%C_vAmb_Exp + DstInputFileTypeData%C_vShr_DMin = SrcInputFileTypeData%C_vShr_DMin + DstInputFileTypeData%C_vShr_DMax = SrcInputFileTypeData%C_vShr_DMax + DstInputFileTypeData%C_vShr_FMin = SrcInputFileTypeData%C_vShr_FMin + DstInputFileTypeData%C_vShr_Exp = SrcInputFileTypeData%C_vShr_Exp + DstInputFileTypeData%Mod_WakeDiam = SrcInputFileTypeData%Mod_WakeDiam + DstInputFileTypeData%C_WakeDiam = SrcInputFileTypeData%C_WakeDiam + DstInputFileTypeData%Swirl = SrcInputFileTypeData%Swirl + DstInputFileTypeData%k_VortexDecay = SrcInputFileTypeData%k_VortexDecay + DstInputFileTypeData%sigma_D = SrcInputFileTypeData%sigma_D + DstInputFileTypeData%NumVortices = SrcInputFileTypeData%NumVortices + DstInputFileTypeData%FilterInit = SrcInputFileTypeData%FilterInit + DstInputFileTypeData%k_vCurl = SrcInputFileTypeData%k_vCurl + DstInputFileTypeData%OutAllPlanes = SrcInputFileTypeData%OutAllPlanes + DstInputFileTypeData%WAT = SrcInputFileTypeData%WAT + DstInputFileTypeData%WAT_k_Def = SrcInputFileTypeData%WAT_k_Def + DstInputFileTypeData%WAT_k_Grad = SrcInputFileTypeData%WAT_k_Grad +end subroutine +subroutine WD_DestroyInputFileType(InputFileTypeData, ErrStat, ErrMsg) + type(WD_InputFileType), intent(inout) :: InputFileTypeData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WD_DestroyInputFileType' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine WD_PackInputFileType(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(WD_InputFileType), intent(in) :: InData character(*), parameter :: RoutineName = 'WD_PackInputFileType' if (Buf%ErrStat >= AbortErrLev) return - ! dr call RegPack(Buf, InData%dr) if (RegCheckErr(Buf, RoutineName)) return - ! NumRadii call RegPack(Buf, InData%NumRadii) if (RegCheckErr(Buf, RoutineName)) return - ! NumPlanes call RegPack(Buf, InData%NumPlanes) if (RegCheckErr(Buf, RoutineName)) return - ! Mod_Wake call RegPack(Buf, InData%Mod_Wake) if (RegCheckErr(Buf, RoutineName)) return - ! f_c call RegPack(Buf, InData%f_c) if (RegCheckErr(Buf, RoutineName)) return - ! C_HWkDfl_O call RegPack(Buf, InData%C_HWkDfl_O) if (RegCheckErr(Buf, RoutineName)) return - ! C_HWkDfl_OY call RegPack(Buf, InData%C_HWkDfl_OY) if (RegCheckErr(Buf, RoutineName)) return - ! C_HWkDfl_x call RegPack(Buf, InData%C_HWkDfl_x) if (RegCheckErr(Buf, RoutineName)) return - ! C_HWkDfl_xY call RegPack(Buf, InData%C_HWkDfl_xY) if (RegCheckErr(Buf, RoutineName)) return - ! C_NearWake call RegPack(Buf, InData%C_NearWake) if (RegCheckErr(Buf, RoutineName)) return - ! k_vAmb call RegPack(Buf, InData%k_vAmb) if (RegCheckErr(Buf, RoutineName)) return - ! k_vShr call RegPack(Buf, InData%k_vShr) if (RegCheckErr(Buf, RoutineName)) return - ! C_vAmb_DMin call RegPack(Buf, InData%C_vAmb_DMin) if (RegCheckErr(Buf, RoutineName)) return - ! C_vAmb_DMax call RegPack(Buf, InData%C_vAmb_DMax) if (RegCheckErr(Buf, RoutineName)) return - ! C_vAmb_FMin call RegPack(Buf, InData%C_vAmb_FMin) if (RegCheckErr(Buf, RoutineName)) return - ! C_vAmb_Exp call RegPack(Buf, InData%C_vAmb_Exp) if (RegCheckErr(Buf, RoutineName)) return - ! C_vShr_DMin call RegPack(Buf, InData%C_vShr_DMin) if (RegCheckErr(Buf, RoutineName)) return - ! C_vShr_DMax call RegPack(Buf, InData%C_vShr_DMax) if (RegCheckErr(Buf, RoutineName)) return - ! C_vShr_FMin call RegPack(Buf, InData%C_vShr_FMin) if (RegCheckErr(Buf, RoutineName)) return - ! C_vShr_Exp call RegPack(Buf, InData%C_vShr_Exp) if (RegCheckErr(Buf, RoutineName)) return - ! Mod_WakeDiam call RegPack(Buf, InData%Mod_WakeDiam) if (RegCheckErr(Buf, RoutineName)) return - ! C_WakeDiam call RegPack(Buf, InData%C_WakeDiam) if (RegCheckErr(Buf, RoutineName)) return - ! Swirl call RegPack(Buf, InData%Swirl) if (RegCheckErr(Buf, RoutineName)) return - ! k_VortexDecay call RegPack(Buf, InData%k_VortexDecay) if (RegCheckErr(Buf, RoutineName)) return - ! sigma_D call RegPack(Buf, InData%sigma_D) if (RegCheckErr(Buf, RoutineName)) return - ! NumVortices call RegPack(Buf, InData%NumVortices) if (RegCheckErr(Buf, RoutineName)) return - ! FilterInit call RegPack(Buf, InData%FilterInit) if (RegCheckErr(Buf, RoutineName)) return - ! k_vCurl call RegPack(Buf, InData%k_vCurl) if (RegCheckErr(Buf, RoutineName)) return - ! OutAllPlanes call RegPack(Buf, InData%OutAllPlanes) if (RegCheckErr(Buf, RoutineName)) return - ! WAT call RegPack(Buf, InData%WAT) if (RegCheckErr(Buf, RoutineName)) return - ! WAT_k_Def call RegPack(Buf, InData%WAT_k_Def) if (RegCheckErr(Buf, RoutineName)) return - ! WAT_k_Grad call RegPack(Buf, InData%WAT_k_Grad) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -401,154 +358,110 @@ subroutine WD_UnPackInputFileType(Buf, OutData) type(WD_InputFileType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WD_UnPackInputFileType' if (Buf%ErrStat /= ErrID_None) return - ! dr call RegUnpack(Buf, OutData%dr) if (RegCheckErr(Buf, RoutineName)) return - ! NumRadii call RegUnpack(Buf, OutData%NumRadii) if (RegCheckErr(Buf, RoutineName)) return - ! NumPlanes call RegUnpack(Buf, OutData%NumPlanes) if (RegCheckErr(Buf, RoutineName)) return - ! Mod_Wake call RegUnpack(Buf, OutData%Mod_Wake) if (RegCheckErr(Buf, RoutineName)) return - ! f_c call RegUnpack(Buf, OutData%f_c) if (RegCheckErr(Buf, RoutineName)) return - ! C_HWkDfl_O call RegUnpack(Buf, OutData%C_HWkDfl_O) if (RegCheckErr(Buf, RoutineName)) return - ! C_HWkDfl_OY call RegUnpack(Buf, OutData%C_HWkDfl_OY) if (RegCheckErr(Buf, RoutineName)) return - ! C_HWkDfl_x call RegUnpack(Buf, OutData%C_HWkDfl_x) if (RegCheckErr(Buf, RoutineName)) return - ! C_HWkDfl_xY call RegUnpack(Buf, OutData%C_HWkDfl_xY) if (RegCheckErr(Buf, RoutineName)) return - ! C_NearWake call RegUnpack(Buf, OutData%C_NearWake) if (RegCheckErr(Buf, RoutineName)) return - ! k_vAmb call RegUnpack(Buf, OutData%k_vAmb) if (RegCheckErr(Buf, RoutineName)) return - ! k_vShr call RegUnpack(Buf, OutData%k_vShr) if (RegCheckErr(Buf, RoutineName)) return - ! C_vAmb_DMin call RegUnpack(Buf, OutData%C_vAmb_DMin) if (RegCheckErr(Buf, RoutineName)) return - ! C_vAmb_DMax call RegUnpack(Buf, OutData%C_vAmb_DMax) if (RegCheckErr(Buf, RoutineName)) return - ! C_vAmb_FMin call RegUnpack(Buf, OutData%C_vAmb_FMin) if (RegCheckErr(Buf, RoutineName)) return - ! C_vAmb_Exp call RegUnpack(Buf, OutData%C_vAmb_Exp) if (RegCheckErr(Buf, RoutineName)) return - ! C_vShr_DMin call RegUnpack(Buf, OutData%C_vShr_DMin) if (RegCheckErr(Buf, RoutineName)) return - ! C_vShr_DMax call RegUnpack(Buf, OutData%C_vShr_DMax) if (RegCheckErr(Buf, RoutineName)) return - ! C_vShr_FMin call RegUnpack(Buf, OutData%C_vShr_FMin) if (RegCheckErr(Buf, RoutineName)) return - ! C_vShr_Exp call RegUnpack(Buf, OutData%C_vShr_Exp) if (RegCheckErr(Buf, RoutineName)) return - ! Mod_WakeDiam call RegUnpack(Buf, OutData%Mod_WakeDiam) if (RegCheckErr(Buf, RoutineName)) return - ! C_WakeDiam call RegUnpack(Buf, OutData%C_WakeDiam) if (RegCheckErr(Buf, RoutineName)) return - ! Swirl call RegUnpack(Buf, OutData%Swirl) if (RegCheckErr(Buf, RoutineName)) return - ! k_VortexDecay call RegUnpack(Buf, OutData%k_VortexDecay) if (RegCheckErr(Buf, RoutineName)) return - ! sigma_D call RegUnpack(Buf, OutData%sigma_D) if (RegCheckErr(Buf, RoutineName)) return - ! NumVortices call RegUnpack(Buf, OutData%NumVortices) if (RegCheckErr(Buf, RoutineName)) return - ! FilterInit call RegUnpack(Buf, OutData%FilterInit) if (RegCheckErr(Buf, RoutineName)) return - ! k_vCurl call RegUnpack(Buf, OutData%k_vCurl) if (RegCheckErr(Buf, RoutineName)) return - ! OutAllPlanes call RegUnpack(Buf, OutData%OutAllPlanes) if (RegCheckErr(Buf, RoutineName)) return - ! WAT call RegUnpack(Buf, OutData%WAT) if (RegCheckErr(Buf, RoutineName)) return - ! WAT_k_Def call RegUnpack(Buf, OutData%WAT_k_Def) if (RegCheckErr(Buf, RoutineName)) return - ! WAT_k_Grad call RegUnpack(Buf, OutData%WAT_k_Grad) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE WD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WD_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(WD_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL WD_Copyinputfiletype( SrcInitInputData%InputFileData, DstInitInputData%InputFileData, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitInputData%TurbNum = SrcInitInputData%TurbNum - DstInitInputData%OutFileRoot = SrcInitInputData%OutFileRoot - END SUBROUTINE WD_CopyInitInput - - SUBROUTINE WD_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(WD_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyInitInput' - ErrStat = ErrID_None - ErrMsg = "" - - CALL WD_DestroyInputFileType( InitInputData%InputFileData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE WD_DestroyInitInput +subroutine WD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg) + type(WD_InitInputType), intent(in) :: SrcInitInputData + type(WD_InitInputType), intent(inout) :: DstInitInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WD_CopyInitInput' + ErrStat = ErrID_None + ErrMsg = '' + call WD_CopyInputFileType(SrcInitInputData%InputFileData, DstInitInputData%InputFileData, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstInitInputData%TurbNum = SrcInitInputData%TurbNum + DstInitInputData%OutFileRoot = SrcInitInputData%OutFileRoot +end subroutine +subroutine WD_DestroyInitInput(InitInputData, ErrStat, ErrMsg) + type(WD_InitInputType), intent(inout) :: InitInputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WD_DestroyInitInput' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine WD_PackInitInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(WD_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'WD_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return - ! InputFileData call WD_PackInputFileType(Buf, InData%InputFileData) if (RegCheckErr(Buf, RoutineName)) return - ! TurbNum call RegPack(Buf, InData%TurbNum) if (RegCheckErr(Buf, RoutineName)) return - ! OutFileRoot call RegPack(Buf, InData%OutFileRoot) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -558,103 +471,92 @@ subroutine WD_UnPackInitInput(Buf, OutData) type(WD_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WD_UnPackInitInput' if (Buf%ErrStat /= ErrID_None) return - ! InputFileData call WD_UnpackInputFileType(Buf, OutData%InputFileData) ! InputFileData - ! TurbNum call RegUnpack(Buf, OutData%TurbNum) if (RegCheckErr(Buf, RoutineName)) return - ! OutFileRoot call RegUnpack(Buf, OutData%OutFileRoot) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE WD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WD_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(WD_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_CopyInitOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInitOutputData%WriteOutputHdr)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputHdr,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputHdr,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputHdr)) THEN - ALLOCATE(DstInitOutputData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr -ENDIF -IF (ALLOCATED(SrcInitOutputData%WriteOutputUnt)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputUnt,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputUnt,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputUnt)) THEN - ALLOCATE(DstInitOutputData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt -ENDIF - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE WD_CopyInitOutput - SUBROUTINE WD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(WD_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF - CALL NWTC_Library_DestroyProgDesc( InitOutputData%Ver, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE WD_DestroyInitOutput +subroutine WD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) + type(WD_InitOutputType), intent(in) :: SrcInitOutputData + type(WD_InitOutputType), intent(inout) :: DstInitOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WD_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr + else if (allocated(DstInitOutputData%WriteOutputHdr)) then + deallocate(DstInitOutputData%WriteOutputHdr) + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt + else if (allocated(DstInitOutputData%WriteOutputUnt)) then + deallocate(DstInitOutputData%WriteOutputUnt) + end if + call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine +subroutine WD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(WD_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'WD_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if +end subroutine subroutine WD_PackInitOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(WD_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'WD_PackInitOutput' if (Buf%ErrStat >= AbortErrLev) return - ! WriteOutputHdr call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) call RegPack(Buf, InData%WriteOutputHdr) end if if (RegCheckErr(Buf, RoutineName)) return - ! WriteOutputUnt call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) call RegPack(Buf, InData%WriteOutputUnt) end if if (RegCheckErr(Buf, RoutineName)) return - ! Ver call NWTC_Library_PackProgDesc(Buf, InData%Ver) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -667,7 +569,6 @@ subroutine WD_UnPackInitOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! WriteOutputHdr if (allocated(OutData%WriteOutputHdr)) deallocate(OutData%WriteOutputHdr) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -682,7 +583,6 @@ subroutine WD_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutputHdr) if (RegCheckErr(Buf, RoutineName)) return end if - ! WriteOutputUnt if (allocated(OutData%WriteOutputUnt)) deallocate(OutData%WriteOutputUnt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -697,48 +597,35 @@ subroutine WD_UnPackInitOutput(Buf, OutData) call RegUnpack(Buf, OutData%WriteOutputUnt) if (RegCheckErr(Buf, RoutineName)) return end if - ! Ver call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver end subroutine - SUBROUTINE WD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WD_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(WD_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%DummyContState = SrcContStateData%DummyContState - END SUBROUTINE WD_CopyContState - SUBROUTINE WD_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(WD_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE WD_DestroyContState +subroutine WD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) + type(WD_ContinuousStateType), intent(in) :: SrcContStateData + type(WD_ContinuousStateType), intent(inout) :: DstContStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WD_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + DstContStateData%DummyContState = SrcContStateData%DummyContState +end subroutine +subroutine WD_DestroyContState(ContStateData, ErrStat, ErrMsg) + type(WD_ContinuousStateType), intent(inout) :: ContStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WD_DestroyContState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine WD_PackContState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(WD_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'WD_PackContState' if (Buf%ErrStat >= AbortErrLev) return - ! DummyContState call RegPack(Buf, InData%DummyContState) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -748,408 +635,385 @@ subroutine WD_UnPackContState(Buf, OutData) type(WD_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WD_UnPackContState' if (Buf%ErrStat /= ErrID_None) return - ! DummyContState call RegUnpack(Buf, OutData%DummyContState) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE WD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WD_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(WD_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcDiscStateData%xhat_plane)) THEN - i1_l = LBOUND(SrcDiscStateData%xhat_plane,1) - i1_u = UBOUND(SrcDiscStateData%xhat_plane,1) - i2_l = LBOUND(SrcDiscStateData%xhat_plane,2) - i2_u = UBOUND(SrcDiscStateData%xhat_plane,2) - IF (.NOT. ALLOCATED(DstDiscStateData%xhat_plane)) THEN - ALLOCATE(DstDiscStateData%xhat_plane(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%xhat_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%xhat_plane = SrcDiscStateData%xhat_plane -ENDIF -IF (ALLOCATED(SrcDiscStateData%YawErr_filt)) THEN - i1_l = LBOUND(SrcDiscStateData%YawErr_filt,1) - i1_u = UBOUND(SrcDiscStateData%YawErr_filt,1) - IF (.NOT. ALLOCATED(DstDiscStateData%YawErr_filt)) THEN - ALLOCATE(DstDiscStateData%YawErr_filt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%YawErr_filt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%YawErr_filt = SrcDiscStateData%YawErr_filt -ENDIF - DstDiscStateData%psi_skew_filt = SrcDiscStateData%psi_skew_filt - DstDiscStateData%chi_skew_filt = SrcDiscStateData%chi_skew_filt -IF (ALLOCATED(SrcDiscStateData%V_plane_filt)) THEN - i1_l = LBOUND(SrcDiscStateData%V_plane_filt,1) - i1_u = UBOUND(SrcDiscStateData%V_plane_filt,1) - i2_l = LBOUND(SrcDiscStateData%V_plane_filt,2) - i2_u = UBOUND(SrcDiscStateData%V_plane_filt,2) - IF (.NOT. ALLOCATED(DstDiscStateData%V_plane_filt)) THEN - ALLOCATE(DstDiscStateData%V_plane_filt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%V_plane_filt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%V_plane_filt = SrcDiscStateData%V_plane_filt -ENDIF -IF (ALLOCATED(SrcDiscStateData%p_plane)) THEN - i1_l = LBOUND(SrcDiscStateData%p_plane,1) - i1_u = UBOUND(SrcDiscStateData%p_plane,1) - i2_l = LBOUND(SrcDiscStateData%p_plane,2) - i2_u = UBOUND(SrcDiscStateData%p_plane,2) - IF (.NOT. ALLOCATED(DstDiscStateData%p_plane)) THEN - ALLOCATE(DstDiscStateData%p_plane(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%p_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%p_plane = SrcDiscStateData%p_plane -ENDIF -IF (ALLOCATED(SrcDiscStateData%x_plane)) THEN - i1_l = LBOUND(SrcDiscStateData%x_plane,1) - i1_u = UBOUND(SrcDiscStateData%x_plane,1) - IF (.NOT. ALLOCATED(DstDiscStateData%x_plane)) THEN - ALLOCATE(DstDiscStateData%x_plane(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%x_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%x_plane = SrcDiscStateData%x_plane -ENDIF -IF (ALLOCATED(SrcDiscStateData%Vx_wake)) THEN - i1_l = LBOUND(SrcDiscStateData%Vx_wake,1) - i1_u = UBOUND(SrcDiscStateData%Vx_wake,1) - i2_l = LBOUND(SrcDiscStateData%Vx_wake,2) - i2_u = UBOUND(SrcDiscStateData%Vx_wake,2) - IF (.NOT. ALLOCATED(DstDiscStateData%Vx_wake)) THEN - ALLOCATE(DstDiscStateData%Vx_wake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Vx_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Vx_wake = SrcDiscStateData%Vx_wake -ENDIF -IF (ALLOCATED(SrcDiscStateData%Vr_wake)) THEN - i1_l = LBOUND(SrcDiscStateData%Vr_wake,1) - i1_u = UBOUND(SrcDiscStateData%Vr_wake,1) - i2_l = LBOUND(SrcDiscStateData%Vr_wake,2) - i2_u = UBOUND(SrcDiscStateData%Vr_wake,2) - IF (.NOT. ALLOCATED(DstDiscStateData%Vr_wake)) THEN - ALLOCATE(DstDiscStateData%Vr_wake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Vr_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Vr_wake = SrcDiscStateData%Vr_wake -ENDIF -IF (ALLOCATED(SrcDiscStateData%Vx_wake2)) THEN - i1_l = LBOUND(SrcDiscStateData%Vx_wake2,1) - i1_u = UBOUND(SrcDiscStateData%Vx_wake2,1) - i2_l = LBOUND(SrcDiscStateData%Vx_wake2,2) - i2_u = UBOUND(SrcDiscStateData%Vx_wake2,2) - i3_l = LBOUND(SrcDiscStateData%Vx_wake2,3) - i3_u = UBOUND(SrcDiscStateData%Vx_wake2,3) - IF (.NOT. ALLOCATED(DstDiscStateData%Vx_wake2)) THEN - ALLOCATE(DstDiscStateData%Vx_wake2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Vx_wake2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Vx_wake2 = SrcDiscStateData%Vx_wake2 -ENDIF -IF (ALLOCATED(SrcDiscStateData%Vy_wake2)) THEN - i1_l = LBOUND(SrcDiscStateData%Vy_wake2,1) - i1_u = UBOUND(SrcDiscStateData%Vy_wake2,1) - i2_l = LBOUND(SrcDiscStateData%Vy_wake2,2) - i2_u = UBOUND(SrcDiscStateData%Vy_wake2,2) - i3_l = LBOUND(SrcDiscStateData%Vy_wake2,3) - i3_u = UBOUND(SrcDiscStateData%Vy_wake2,3) - IF (.NOT. ALLOCATED(DstDiscStateData%Vy_wake2)) THEN - ALLOCATE(DstDiscStateData%Vy_wake2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Vy_wake2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Vy_wake2 = SrcDiscStateData%Vy_wake2 -ENDIF -IF (ALLOCATED(SrcDiscStateData%Vz_wake2)) THEN - i1_l = LBOUND(SrcDiscStateData%Vz_wake2,1) - i1_u = UBOUND(SrcDiscStateData%Vz_wake2,1) - i2_l = LBOUND(SrcDiscStateData%Vz_wake2,2) - i2_u = UBOUND(SrcDiscStateData%Vz_wake2,2) - i3_l = LBOUND(SrcDiscStateData%Vz_wake2,3) - i3_u = UBOUND(SrcDiscStateData%Vz_wake2,3) - IF (.NOT. ALLOCATED(DstDiscStateData%Vz_wake2)) THEN - ALLOCATE(DstDiscStateData%Vz_wake2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Vz_wake2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Vz_wake2 = SrcDiscStateData%Vz_wake2 -ENDIF -IF (ALLOCATED(SrcDiscStateData%Vx_wind_disk_filt)) THEN - i1_l = LBOUND(SrcDiscStateData%Vx_wind_disk_filt,1) - i1_u = UBOUND(SrcDiscStateData%Vx_wind_disk_filt,1) - IF (.NOT. ALLOCATED(DstDiscStateData%Vx_wind_disk_filt)) THEN - ALLOCATE(DstDiscStateData%Vx_wind_disk_filt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Vx_wind_disk_filt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Vx_wind_disk_filt = SrcDiscStateData%Vx_wind_disk_filt -ENDIF -IF (ALLOCATED(SrcDiscStateData%TI_amb_filt)) THEN - i1_l = LBOUND(SrcDiscStateData%TI_amb_filt,1) - i1_u = UBOUND(SrcDiscStateData%TI_amb_filt,1) - IF (.NOT. ALLOCATED(DstDiscStateData%TI_amb_filt)) THEN - ALLOCATE(DstDiscStateData%TI_amb_filt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%TI_amb_filt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%TI_amb_filt = SrcDiscStateData%TI_amb_filt -ENDIF -IF (ALLOCATED(SrcDiscStateData%D_rotor_filt)) THEN - i1_l = LBOUND(SrcDiscStateData%D_rotor_filt,1) - i1_u = UBOUND(SrcDiscStateData%D_rotor_filt,1) - IF (.NOT. ALLOCATED(DstDiscStateData%D_rotor_filt)) THEN - ALLOCATE(DstDiscStateData%D_rotor_filt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%D_rotor_filt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%D_rotor_filt = SrcDiscStateData%D_rotor_filt -ENDIF - DstDiscStateData%Vx_rel_disk_filt = SrcDiscStateData%Vx_rel_disk_filt -IF (ALLOCATED(SrcDiscStateData%Ct_azavg_filt)) THEN - i1_l = LBOUND(SrcDiscStateData%Ct_azavg_filt,1) - i1_u = UBOUND(SrcDiscStateData%Ct_azavg_filt,1) - IF (.NOT. ALLOCATED(DstDiscStateData%Ct_azavg_filt)) THEN - ALLOCATE(DstDiscStateData%Ct_azavg_filt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Ct_azavg_filt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Ct_azavg_filt = SrcDiscStateData%Ct_azavg_filt -ENDIF -IF (ALLOCATED(SrcDiscStateData%Cq_azavg_filt)) THEN - i1_l = LBOUND(SrcDiscStateData%Cq_azavg_filt,1) - i1_u = UBOUND(SrcDiscStateData%Cq_azavg_filt,1) - IF (.NOT. ALLOCATED(DstDiscStateData%Cq_azavg_filt)) THEN - ALLOCATE(DstDiscStateData%Cq_azavg_filt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Cq_azavg_filt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%Cq_azavg_filt = SrcDiscStateData%Cq_azavg_filt -ENDIF - END SUBROUTINE WD_CopyDiscState - - SUBROUTINE WD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(WD_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(DiscStateData%xhat_plane)) THEN - DEALLOCATE(DiscStateData%xhat_plane) -ENDIF -IF (ALLOCATED(DiscStateData%YawErr_filt)) THEN - DEALLOCATE(DiscStateData%YawErr_filt) -ENDIF -IF (ALLOCATED(DiscStateData%V_plane_filt)) THEN - DEALLOCATE(DiscStateData%V_plane_filt) -ENDIF -IF (ALLOCATED(DiscStateData%p_plane)) THEN - DEALLOCATE(DiscStateData%p_plane) -ENDIF -IF (ALLOCATED(DiscStateData%x_plane)) THEN - DEALLOCATE(DiscStateData%x_plane) -ENDIF -IF (ALLOCATED(DiscStateData%Vx_wake)) THEN - DEALLOCATE(DiscStateData%Vx_wake) -ENDIF -IF (ALLOCATED(DiscStateData%Vr_wake)) THEN - DEALLOCATE(DiscStateData%Vr_wake) -ENDIF -IF (ALLOCATED(DiscStateData%Vx_wake2)) THEN - DEALLOCATE(DiscStateData%Vx_wake2) -ENDIF -IF (ALLOCATED(DiscStateData%Vy_wake2)) THEN - DEALLOCATE(DiscStateData%Vy_wake2) -ENDIF -IF (ALLOCATED(DiscStateData%Vz_wake2)) THEN - DEALLOCATE(DiscStateData%Vz_wake2) -ENDIF -IF (ALLOCATED(DiscStateData%Vx_wind_disk_filt)) THEN - DEALLOCATE(DiscStateData%Vx_wind_disk_filt) -ENDIF -IF (ALLOCATED(DiscStateData%TI_amb_filt)) THEN - DEALLOCATE(DiscStateData%TI_amb_filt) -ENDIF -IF (ALLOCATED(DiscStateData%D_rotor_filt)) THEN - DEALLOCATE(DiscStateData%D_rotor_filt) -ENDIF -IF (ALLOCATED(DiscStateData%Ct_azavg_filt)) THEN - DEALLOCATE(DiscStateData%Ct_azavg_filt) -ENDIF -IF (ALLOCATED(DiscStateData%Cq_azavg_filt)) THEN - DEALLOCATE(DiscStateData%Cq_azavg_filt) -ENDIF - END SUBROUTINE WD_DestroyDiscState +subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) + type(WD_DiscreteStateType), intent(in) :: SrcDiscStateData + type(WD_DiscreteStateType), intent(inout) :: DstDiscStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'WD_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcDiscStateData%xhat_plane)) then + LB(1:2) = lbound(SrcDiscStateData%xhat_plane) + UB(1:2) = ubound(SrcDiscStateData%xhat_plane) + if (.not. allocated(DstDiscStateData%xhat_plane)) then + allocate(DstDiscStateData%xhat_plane(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%xhat_plane.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%xhat_plane = SrcDiscStateData%xhat_plane + else if (allocated(DstDiscStateData%xhat_plane)) then + deallocate(DstDiscStateData%xhat_plane) + end if + if (allocated(SrcDiscStateData%YawErr_filt)) then + LB(1:1) = lbound(SrcDiscStateData%YawErr_filt) + UB(1:1) = ubound(SrcDiscStateData%YawErr_filt) + if (.not. allocated(DstDiscStateData%YawErr_filt)) then + allocate(DstDiscStateData%YawErr_filt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%YawErr_filt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%YawErr_filt = SrcDiscStateData%YawErr_filt + else if (allocated(DstDiscStateData%YawErr_filt)) then + deallocate(DstDiscStateData%YawErr_filt) + end if + DstDiscStateData%psi_skew_filt = SrcDiscStateData%psi_skew_filt + DstDiscStateData%chi_skew_filt = SrcDiscStateData%chi_skew_filt + if (allocated(SrcDiscStateData%V_plane_filt)) then + LB(1:2) = lbound(SrcDiscStateData%V_plane_filt) + UB(1:2) = ubound(SrcDiscStateData%V_plane_filt) + if (.not. allocated(DstDiscStateData%V_plane_filt)) then + allocate(DstDiscStateData%V_plane_filt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%V_plane_filt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%V_plane_filt = SrcDiscStateData%V_plane_filt + else if (allocated(DstDiscStateData%V_plane_filt)) then + deallocate(DstDiscStateData%V_plane_filt) + end if + if (allocated(SrcDiscStateData%p_plane)) then + LB(1:2) = lbound(SrcDiscStateData%p_plane) + UB(1:2) = ubound(SrcDiscStateData%p_plane) + if (.not. allocated(DstDiscStateData%p_plane)) then + allocate(DstDiscStateData%p_plane(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%p_plane.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%p_plane = SrcDiscStateData%p_plane + else if (allocated(DstDiscStateData%p_plane)) then + deallocate(DstDiscStateData%p_plane) + end if + if (allocated(SrcDiscStateData%x_plane)) then + LB(1:1) = lbound(SrcDiscStateData%x_plane) + UB(1:1) = ubound(SrcDiscStateData%x_plane) + if (.not. allocated(DstDiscStateData%x_plane)) then + allocate(DstDiscStateData%x_plane(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%x_plane.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%x_plane = SrcDiscStateData%x_plane + else if (allocated(DstDiscStateData%x_plane)) then + deallocate(DstDiscStateData%x_plane) + end if + if (allocated(SrcDiscStateData%Vx_wake)) then + LB(1:2) = lbound(SrcDiscStateData%Vx_wake) + UB(1:2) = ubound(SrcDiscStateData%Vx_wake) + if (.not. allocated(DstDiscStateData%Vx_wake)) then + allocate(DstDiscStateData%Vx_wake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Vx_wake.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Vx_wake = SrcDiscStateData%Vx_wake + else if (allocated(DstDiscStateData%Vx_wake)) then + deallocate(DstDiscStateData%Vx_wake) + end if + if (allocated(SrcDiscStateData%Vr_wake)) then + LB(1:2) = lbound(SrcDiscStateData%Vr_wake) + UB(1:2) = ubound(SrcDiscStateData%Vr_wake) + if (.not. allocated(DstDiscStateData%Vr_wake)) then + allocate(DstDiscStateData%Vr_wake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Vr_wake.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Vr_wake = SrcDiscStateData%Vr_wake + else if (allocated(DstDiscStateData%Vr_wake)) then + deallocate(DstDiscStateData%Vr_wake) + end if + if (allocated(SrcDiscStateData%Vx_wake2)) then + LB(1:3) = lbound(SrcDiscStateData%Vx_wake2) + UB(1:3) = ubound(SrcDiscStateData%Vx_wake2) + if (.not. allocated(DstDiscStateData%Vx_wake2)) then + allocate(DstDiscStateData%Vx_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Vx_wake2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Vx_wake2 = SrcDiscStateData%Vx_wake2 + else if (allocated(DstDiscStateData%Vx_wake2)) then + deallocate(DstDiscStateData%Vx_wake2) + end if + if (allocated(SrcDiscStateData%Vy_wake2)) then + LB(1:3) = lbound(SrcDiscStateData%Vy_wake2) + UB(1:3) = ubound(SrcDiscStateData%Vy_wake2) + if (.not. allocated(DstDiscStateData%Vy_wake2)) then + allocate(DstDiscStateData%Vy_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Vy_wake2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Vy_wake2 = SrcDiscStateData%Vy_wake2 + else if (allocated(DstDiscStateData%Vy_wake2)) then + deallocate(DstDiscStateData%Vy_wake2) + end if + if (allocated(SrcDiscStateData%Vz_wake2)) then + LB(1:3) = lbound(SrcDiscStateData%Vz_wake2) + UB(1:3) = ubound(SrcDiscStateData%Vz_wake2) + if (.not. allocated(DstDiscStateData%Vz_wake2)) then + allocate(DstDiscStateData%Vz_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Vz_wake2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Vz_wake2 = SrcDiscStateData%Vz_wake2 + else if (allocated(DstDiscStateData%Vz_wake2)) then + deallocate(DstDiscStateData%Vz_wake2) + end if + if (allocated(SrcDiscStateData%Vx_wind_disk_filt)) then + LB(1:1) = lbound(SrcDiscStateData%Vx_wind_disk_filt) + UB(1:1) = ubound(SrcDiscStateData%Vx_wind_disk_filt) + if (.not. allocated(DstDiscStateData%Vx_wind_disk_filt)) then + allocate(DstDiscStateData%Vx_wind_disk_filt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Vx_wind_disk_filt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Vx_wind_disk_filt = SrcDiscStateData%Vx_wind_disk_filt + else if (allocated(DstDiscStateData%Vx_wind_disk_filt)) then + deallocate(DstDiscStateData%Vx_wind_disk_filt) + end if + if (allocated(SrcDiscStateData%TI_amb_filt)) then + LB(1:1) = lbound(SrcDiscStateData%TI_amb_filt) + UB(1:1) = ubound(SrcDiscStateData%TI_amb_filt) + if (.not. allocated(DstDiscStateData%TI_amb_filt)) then + allocate(DstDiscStateData%TI_amb_filt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%TI_amb_filt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%TI_amb_filt = SrcDiscStateData%TI_amb_filt + else if (allocated(DstDiscStateData%TI_amb_filt)) then + deallocate(DstDiscStateData%TI_amb_filt) + end if + if (allocated(SrcDiscStateData%D_rotor_filt)) then + LB(1:1) = lbound(SrcDiscStateData%D_rotor_filt) + UB(1:1) = ubound(SrcDiscStateData%D_rotor_filt) + if (.not. allocated(DstDiscStateData%D_rotor_filt)) then + allocate(DstDiscStateData%D_rotor_filt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%D_rotor_filt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%D_rotor_filt = SrcDiscStateData%D_rotor_filt + else if (allocated(DstDiscStateData%D_rotor_filt)) then + deallocate(DstDiscStateData%D_rotor_filt) + end if + DstDiscStateData%Vx_rel_disk_filt = SrcDiscStateData%Vx_rel_disk_filt + if (allocated(SrcDiscStateData%Ct_azavg_filt)) then + LB(1:1) = lbound(SrcDiscStateData%Ct_azavg_filt) + UB(1:1) = ubound(SrcDiscStateData%Ct_azavg_filt) + if (.not. allocated(DstDiscStateData%Ct_azavg_filt)) then + allocate(DstDiscStateData%Ct_azavg_filt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Ct_azavg_filt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Ct_azavg_filt = SrcDiscStateData%Ct_azavg_filt + else if (allocated(DstDiscStateData%Ct_azavg_filt)) then + deallocate(DstDiscStateData%Ct_azavg_filt) + end if + if (allocated(SrcDiscStateData%Cq_azavg_filt)) then + LB(1:1) = lbound(SrcDiscStateData%Cq_azavg_filt) + UB(1:1) = ubound(SrcDiscStateData%Cq_azavg_filt) + if (.not. allocated(DstDiscStateData%Cq_azavg_filt)) then + allocate(DstDiscStateData%Cq_azavg_filt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%Cq_azavg_filt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstDiscStateData%Cq_azavg_filt = SrcDiscStateData%Cq_azavg_filt + else if (allocated(DstDiscStateData%Cq_azavg_filt)) then + deallocate(DstDiscStateData%Cq_azavg_filt) + end if +end subroutine +subroutine WD_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(WD_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WD_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(DiscStateData%xhat_plane)) then + deallocate(DiscStateData%xhat_plane) + end if + if (allocated(DiscStateData%YawErr_filt)) then + deallocate(DiscStateData%YawErr_filt) + end if + if (allocated(DiscStateData%V_plane_filt)) then + deallocate(DiscStateData%V_plane_filt) + end if + if (allocated(DiscStateData%p_plane)) then + deallocate(DiscStateData%p_plane) + end if + if (allocated(DiscStateData%x_plane)) then + deallocate(DiscStateData%x_plane) + end if + if (allocated(DiscStateData%Vx_wake)) then + deallocate(DiscStateData%Vx_wake) + end if + if (allocated(DiscStateData%Vr_wake)) then + deallocate(DiscStateData%Vr_wake) + end if + if (allocated(DiscStateData%Vx_wake2)) then + deallocate(DiscStateData%Vx_wake2) + end if + if (allocated(DiscStateData%Vy_wake2)) then + deallocate(DiscStateData%Vy_wake2) + end if + if (allocated(DiscStateData%Vz_wake2)) then + deallocate(DiscStateData%Vz_wake2) + end if + if (allocated(DiscStateData%Vx_wind_disk_filt)) then + deallocate(DiscStateData%Vx_wind_disk_filt) + end if + if (allocated(DiscStateData%TI_amb_filt)) then + deallocate(DiscStateData%TI_amb_filt) + end if + if (allocated(DiscStateData%D_rotor_filt)) then + deallocate(DiscStateData%D_rotor_filt) + end if + if (allocated(DiscStateData%Ct_azavg_filt)) then + deallocate(DiscStateData%Ct_azavg_filt) + end if + if (allocated(DiscStateData%Cq_azavg_filt)) then + deallocate(DiscStateData%Cq_azavg_filt) + end if +end subroutine subroutine WD_PackDiscState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(WD_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'WD_PackDiscState' if (Buf%ErrStat >= AbortErrLev) return - ! xhat_plane call RegPack(Buf, allocated(InData%xhat_plane)) if (allocated(InData%xhat_plane)) then call RegPackBounds(Buf, 2, lbound(InData%xhat_plane), ubound(InData%xhat_plane)) call RegPack(Buf, InData%xhat_plane) end if if (RegCheckErr(Buf, RoutineName)) return - ! YawErr_filt call RegPack(Buf, allocated(InData%YawErr_filt)) if (allocated(InData%YawErr_filt)) then call RegPackBounds(Buf, 1, lbound(InData%YawErr_filt), ubound(InData%YawErr_filt)) call RegPack(Buf, InData%YawErr_filt) end if if (RegCheckErr(Buf, RoutineName)) return - ! psi_skew_filt call RegPack(Buf, InData%psi_skew_filt) if (RegCheckErr(Buf, RoutineName)) return - ! chi_skew_filt call RegPack(Buf, InData%chi_skew_filt) if (RegCheckErr(Buf, RoutineName)) return - ! V_plane_filt call RegPack(Buf, allocated(InData%V_plane_filt)) if (allocated(InData%V_plane_filt)) then call RegPackBounds(Buf, 2, lbound(InData%V_plane_filt), ubound(InData%V_plane_filt)) call RegPack(Buf, InData%V_plane_filt) end if if (RegCheckErr(Buf, RoutineName)) return - ! p_plane call RegPack(Buf, allocated(InData%p_plane)) if (allocated(InData%p_plane)) then call RegPackBounds(Buf, 2, lbound(InData%p_plane), ubound(InData%p_plane)) call RegPack(Buf, InData%p_plane) end if if (RegCheckErr(Buf, RoutineName)) return - ! x_plane call RegPack(Buf, allocated(InData%x_plane)) if (allocated(InData%x_plane)) then call RegPackBounds(Buf, 1, lbound(InData%x_plane), ubound(InData%x_plane)) call RegPack(Buf, InData%x_plane) end if if (RegCheckErr(Buf, RoutineName)) return - ! Vx_wake call RegPack(Buf, allocated(InData%Vx_wake)) if (allocated(InData%Vx_wake)) then call RegPackBounds(Buf, 2, lbound(InData%Vx_wake), ubound(InData%Vx_wake)) call RegPack(Buf, InData%Vx_wake) end if if (RegCheckErr(Buf, RoutineName)) return - ! Vr_wake call RegPack(Buf, allocated(InData%Vr_wake)) if (allocated(InData%Vr_wake)) then call RegPackBounds(Buf, 2, lbound(InData%Vr_wake), ubound(InData%Vr_wake)) call RegPack(Buf, InData%Vr_wake) end if if (RegCheckErr(Buf, RoutineName)) return - ! Vx_wake2 call RegPack(Buf, allocated(InData%Vx_wake2)) if (allocated(InData%Vx_wake2)) then call RegPackBounds(Buf, 3, lbound(InData%Vx_wake2), ubound(InData%Vx_wake2)) call RegPack(Buf, InData%Vx_wake2) end if if (RegCheckErr(Buf, RoutineName)) return - ! Vy_wake2 call RegPack(Buf, allocated(InData%Vy_wake2)) if (allocated(InData%Vy_wake2)) then call RegPackBounds(Buf, 3, lbound(InData%Vy_wake2), ubound(InData%Vy_wake2)) call RegPack(Buf, InData%Vy_wake2) end if if (RegCheckErr(Buf, RoutineName)) return - ! Vz_wake2 call RegPack(Buf, allocated(InData%Vz_wake2)) if (allocated(InData%Vz_wake2)) then call RegPackBounds(Buf, 3, lbound(InData%Vz_wake2), ubound(InData%Vz_wake2)) call RegPack(Buf, InData%Vz_wake2) end if if (RegCheckErr(Buf, RoutineName)) return - ! Vx_wind_disk_filt call RegPack(Buf, allocated(InData%Vx_wind_disk_filt)) if (allocated(InData%Vx_wind_disk_filt)) then call RegPackBounds(Buf, 1, lbound(InData%Vx_wind_disk_filt), ubound(InData%Vx_wind_disk_filt)) call RegPack(Buf, InData%Vx_wind_disk_filt) end if if (RegCheckErr(Buf, RoutineName)) return - ! TI_amb_filt call RegPack(Buf, allocated(InData%TI_amb_filt)) if (allocated(InData%TI_amb_filt)) then call RegPackBounds(Buf, 1, lbound(InData%TI_amb_filt), ubound(InData%TI_amb_filt)) call RegPack(Buf, InData%TI_amb_filt) end if if (RegCheckErr(Buf, RoutineName)) return - ! D_rotor_filt call RegPack(Buf, allocated(InData%D_rotor_filt)) if (allocated(InData%D_rotor_filt)) then call RegPackBounds(Buf, 1, lbound(InData%D_rotor_filt), ubound(InData%D_rotor_filt)) call RegPack(Buf, InData%D_rotor_filt) end if if (RegCheckErr(Buf, RoutineName)) return - ! Vx_rel_disk_filt call RegPack(Buf, InData%Vx_rel_disk_filt) if (RegCheckErr(Buf, RoutineName)) return - ! Ct_azavg_filt call RegPack(Buf, allocated(InData%Ct_azavg_filt)) if (allocated(InData%Ct_azavg_filt)) then call RegPackBounds(Buf, 1, lbound(InData%Ct_azavg_filt), ubound(InData%Ct_azavg_filt)) call RegPack(Buf, InData%Ct_azavg_filt) end if if (RegCheckErr(Buf, RoutineName)) return - ! Cq_azavg_filt call RegPack(Buf, allocated(InData%Cq_azavg_filt)) if (allocated(InData%Cq_azavg_filt)) then call RegPackBounds(Buf, 1, lbound(InData%Cq_azavg_filt), ubound(InData%Cq_azavg_filt)) @@ -1166,7 +1030,6 @@ subroutine WD_UnPackDiscState(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! xhat_plane if (allocated(OutData%xhat_plane)) deallocate(OutData%xhat_plane) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1181,7 +1044,6 @@ subroutine WD_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%xhat_plane) if (RegCheckErr(Buf, RoutineName)) return end if - ! YawErr_filt if (allocated(OutData%YawErr_filt)) deallocate(OutData%YawErr_filt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1196,13 +1058,10 @@ subroutine WD_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%YawErr_filt) if (RegCheckErr(Buf, RoutineName)) return end if - ! psi_skew_filt call RegUnpack(Buf, OutData%psi_skew_filt) if (RegCheckErr(Buf, RoutineName)) return - ! chi_skew_filt call RegUnpack(Buf, OutData%chi_skew_filt) if (RegCheckErr(Buf, RoutineName)) return - ! V_plane_filt if (allocated(OutData%V_plane_filt)) deallocate(OutData%V_plane_filt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1217,7 +1076,6 @@ subroutine WD_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%V_plane_filt) if (RegCheckErr(Buf, RoutineName)) return end if - ! p_plane if (allocated(OutData%p_plane)) deallocate(OutData%p_plane) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1232,7 +1090,6 @@ subroutine WD_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%p_plane) if (RegCheckErr(Buf, RoutineName)) return end if - ! x_plane if (allocated(OutData%x_plane)) deallocate(OutData%x_plane) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1247,7 +1104,6 @@ subroutine WD_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%x_plane) if (RegCheckErr(Buf, RoutineName)) return end if - ! Vx_wake if (allocated(OutData%Vx_wake)) deallocate(OutData%Vx_wake) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1262,7 +1118,6 @@ subroutine WD_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%Vx_wake) if (RegCheckErr(Buf, RoutineName)) return end if - ! Vr_wake if (allocated(OutData%Vr_wake)) deallocate(OutData%Vr_wake) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1277,7 +1132,6 @@ subroutine WD_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%Vr_wake) if (RegCheckErr(Buf, RoutineName)) return end if - ! Vx_wake2 if (allocated(OutData%Vx_wake2)) deallocate(OutData%Vx_wake2) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1292,7 +1146,6 @@ subroutine WD_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%Vx_wake2) if (RegCheckErr(Buf, RoutineName)) return end if - ! Vy_wake2 if (allocated(OutData%Vy_wake2)) deallocate(OutData%Vy_wake2) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1307,7 +1160,6 @@ subroutine WD_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%Vy_wake2) if (RegCheckErr(Buf, RoutineName)) return end if - ! Vz_wake2 if (allocated(OutData%Vz_wake2)) deallocate(OutData%Vz_wake2) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1322,7 +1174,6 @@ subroutine WD_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%Vz_wake2) if (RegCheckErr(Buf, RoutineName)) return end if - ! Vx_wind_disk_filt if (allocated(OutData%Vx_wind_disk_filt)) deallocate(OutData%Vx_wind_disk_filt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1337,7 +1188,6 @@ subroutine WD_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%Vx_wind_disk_filt) if (RegCheckErr(Buf, RoutineName)) return end if - ! TI_amb_filt if (allocated(OutData%TI_amb_filt)) deallocate(OutData%TI_amb_filt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1352,7 +1202,6 @@ subroutine WD_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%TI_amb_filt) if (RegCheckErr(Buf, RoutineName)) return end if - ! D_rotor_filt if (allocated(OutData%D_rotor_filt)) deallocate(OutData%D_rotor_filt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1367,10 +1216,8 @@ subroutine WD_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%D_rotor_filt) if (RegCheckErr(Buf, RoutineName)) return end if - ! Vx_rel_disk_filt call RegUnpack(Buf, OutData%Vx_rel_disk_filt) if (RegCheckErr(Buf, RoutineName)) return - ! Ct_azavg_filt if (allocated(OutData%Ct_azavg_filt)) deallocate(OutData%Ct_azavg_filt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1385,7 +1232,6 @@ subroutine WD_UnPackDiscState(Buf, OutData) call RegUnpack(Buf, OutData%Ct_azavg_filt) if (RegCheckErr(Buf, RoutineName)) return end if - ! Cq_azavg_filt if (allocated(OutData%Cq_azavg_filt)) deallocate(OutData%Cq_azavg_filt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -1401,45 +1247,33 @@ subroutine WD_UnPackDiscState(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE WD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WD_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(WD_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE WD_CopyConstrState - SUBROUTINE WD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(WD_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE WD_DestroyConstrState +subroutine WD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) + type(WD_ConstraintStateType), intent(in) :: SrcConstrStateData + type(WD_ConstraintStateType), intent(inout) :: DstConstrStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WD_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine +subroutine WD_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) + type(WD_ConstraintStateType), intent(inout) :: ConstrStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WD_DestroyConstrState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine WD_PackConstrState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(WD_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'WD_PackConstrState' if (Buf%ErrStat >= AbortErrLev) return - ! DummyConstrState call RegPack(Buf, InData%DummyConstrState) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1449,49 +1283,36 @@ subroutine WD_UnPackConstrState(Buf, OutData) type(WD_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WD_UnPackConstrState' if (Buf%ErrStat /= ErrID_None) return - ! DummyConstrState call RegUnpack(Buf, OutData%DummyConstrState) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE WD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WD_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(WD_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%firstPass = SrcOtherStateData%firstPass - END SUBROUTINE WD_CopyOtherState - - SUBROUTINE WD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(WD_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE WD_DestroyOtherState +subroutine WD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) + type(WD_OtherStateType), intent(in) :: SrcOtherStateData + type(WD_OtherStateType), intent(inout) :: DstOtherStateData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WD_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%firstPass = SrcOtherStateData%firstPass +end subroutine +subroutine WD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) + type(WD_OtherStateType), intent(inout) :: OtherStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WD_DestroyOtherState' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine subroutine WD_PackOtherState(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(WD_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'WD_PackOtherState' if (Buf%ErrStat >= AbortErrLev) return - ! firstPass call RegPack(Buf, InData%firstPass) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1501,552 +1322,524 @@ subroutine WD_UnPackOtherState(Buf, OutData) type(WD_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WD_UnPackOtherState' if (Buf%ErrStat /= ErrID_None) return - ! firstPass call RegUnpack(Buf, OutData%firstPass) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE WD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WD_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(WD_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscData%dvtdr)) THEN - i1_l = LBOUND(SrcMiscData%dvtdr,1) - i1_u = UBOUND(SrcMiscData%dvtdr,1) - IF (.NOT. ALLOCATED(DstMiscData%dvtdr)) THEN - ALLOCATE(DstMiscData%dvtdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dvtdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%dvtdr = SrcMiscData%dvtdr -ENDIF -IF (ALLOCATED(SrcMiscData%vt_tot)) THEN - i1_l = LBOUND(SrcMiscData%vt_tot,1) - i1_u = UBOUND(SrcMiscData%vt_tot,1) - i2_l = LBOUND(SrcMiscData%vt_tot,2) - i2_u = UBOUND(SrcMiscData%vt_tot,2) - IF (.NOT. ALLOCATED(DstMiscData%vt_tot)) THEN - ALLOCATE(DstMiscData%vt_tot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%vt_tot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%vt_tot = SrcMiscData%vt_tot -ENDIF -IF (ALLOCATED(SrcMiscData%vt_amb)) THEN - i1_l = LBOUND(SrcMiscData%vt_amb,1) - i1_u = UBOUND(SrcMiscData%vt_amb,1) - i2_l = LBOUND(SrcMiscData%vt_amb,2) - i2_u = UBOUND(SrcMiscData%vt_amb,2) - IF (.NOT. ALLOCATED(DstMiscData%vt_amb)) THEN - ALLOCATE(DstMiscData%vt_amb(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%vt_amb.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%vt_amb = SrcMiscData%vt_amb -ENDIF -IF (ALLOCATED(SrcMiscData%vt_shr)) THEN - i1_l = LBOUND(SrcMiscData%vt_shr,1) - i1_u = UBOUND(SrcMiscData%vt_shr,1) - i2_l = LBOUND(SrcMiscData%vt_shr,2) - i2_u = UBOUND(SrcMiscData%vt_shr,2) - IF (.NOT. ALLOCATED(DstMiscData%vt_shr)) THEN - ALLOCATE(DstMiscData%vt_shr(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%vt_shr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%vt_shr = SrcMiscData%vt_shr -ENDIF -IF (ALLOCATED(SrcMiscData%vt_tot2)) THEN - i1_l = LBOUND(SrcMiscData%vt_tot2,1) - i1_u = UBOUND(SrcMiscData%vt_tot2,1) - i2_l = LBOUND(SrcMiscData%vt_tot2,2) - i2_u = UBOUND(SrcMiscData%vt_tot2,2) - i3_l = LBOUND(SrcMiscData%vt_tot2,3) - i3_u = UBOUND(SrcMiscData%vt_tot2,3) - IF (.NOT. ALLOCATED(DstMiscData%vt_tot2)) THEN - ALLOCATE(DstMiscData%vt_tot2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%vt_tot2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%vt_tot2 = SrcMiscData%vt_tot2 -ENDIF -IF (ALLOCATED(SrcMiscData%vt_amb2)) THEN - i1_l = LBOUND(SrcMiscData%vt_amb2,1) - i1_u = UBOUND(SrcMiscData%vt_amb2,1) - i2_l = LBOUND(SrcMiscData%vt_amb2,2) - i2_u = UBOUND(SrcMiscData%vt_amb2,2) - i3_l = LBOUND(SrcMiscData%vt_amb2,3) - i3_u = UBOUND(SrcMiscData%vt_amb2,3) - IF (.NOT. ALLOCATED(DstMiscData%vt_amb2)) THEN - ALLOCATE(DstMiscData%vt_amb2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%vt_amb2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%vt_amb2 = SrcMiscData%vt_amb2 -ENDIF -IF (ALLOCATED(SrcMiscData%vt_shr2)) THEN - i1_l = LBOUND(SrcMiscData%vt_shr2,1) - i1_u = UBOUND(SrcMiscData%vt_shr2,1) - i2_l = LBOUND(SrcMiscData%vt_shr2,2) - i2_u = UBOUND(SrcMiscData%vt_shr2,2) - i3_l = LBOUND(SrcMiscData%vt_shr2,3) - i3_u = UBOUND(SrcMiscData%vt_shr2,3) - IF (.NOT. ALLOCATED(DstMiscData%vt_shr2)) THEN - ALLOCATE(DstMiscData%vt_shr2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%vt_shr2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%vt_shr2 = SrcMiscData%vt_shr2 -ENDIF -IF (ALLOCATED(SrcMiscData%dvx_dy)) THEN - i1_l = LBOUND(SrcMiscData%dvx_dy,1) - i1_u = UBOUND(SrcMiscData%dvx_dy,1) - i2_l = LBOUND(SrcMiscData%dvx_dy,2) - i2_u = UBOUND(SrcMiscData%dvx_dy,2) - i3_l = LBOUND(SrcMiscData%dvx_dy,3) - i3_u = UBOUND(SrcMiscData%dvx_dy,3) - IF (.NOT. ALLOCATED(DstMiscData%dvx_dy)) THEN - ALLOCATE(DstMiscData%dvx_dy(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dvx_dy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%dvx_dy = SrcMiscData%dvx_dy -ENDIF -IF (ALLOCATED(SrcMiscData%dvx_dz)) THEN - i1_l = LBOUND(SrcMiscData%dvx_dz,1) - i1_u = UBOUND(SrcMiscData%dvx_dz,1) - i2_l = LBOUND(SrcMiscData%dvx_dz,2) - i2_u = UBOUND(SrcMiscData%dvx_dz,2) - i3_l = LBOUND(SrcMiscData%dvx_dz,3) - i3_u = UBOUND(SrcMiscData%dvx_dz,3) - IF (.NOT. ALLOCATED(DstMiscData%dvx_dz)) THEN - ALLOCATE(DstMiscData%dvx_dz(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dvx_dz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%dvx_dz = SrcMiscData%dvx_dz -ENDIF -IF (ALLOCATED(SrcMiscData%nu_dvx_dy)) THEN - i1_l = LBOUND(SrcMiscData%nu_dvx_dy,1) - i1_u = UBOUND(SrcMiscData%nu_dvx_dy,1) - i2_l = LBOUND(SrcMiscData%nu_dvx_dy,2) - i2_u = UBOUND(SrcMiscData%nu_dvx_dy,2) - IF (.NOT. ALLOCATED(DstMiscData%nu_dvx_dy)) THEN - ALLOCATE(DstMiscData%nu_dvx_dy(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%nu_dvx_dy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%nu_dvx_dy = SrcMiscData%nu_dvx_dy -ENDIF -IF (ALLOCATED(SrcMiscData%nu_dvx_dz)) THEN - i1_l = LBOUND(SrcMiscData%nu_dvx_dz,1) - i1_u = UBOUND(SrcMiscData%nu_dvx_dz,1) - i2_l = LBOUND(SrcMiscData%nu_dvx_dz,2) - i2_u = UBOUND(SrcMiscData%nu_dvx_dz,2) - IF (.NOT. ALLOCATED(DstMiscData%nu_dvx_dz)) THEN - ALLOCATE(DstMiscData%nu_dvx_dz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%nu_dvx_dz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%nu_dvx_dz = SrcMiscData%nu_dvx_dz -ENDIF -IF (ALLOCATED(SrcMiscData%dnuvx_dy)) THEN - i1_l = LBOUND(SrcMiscData%dnuvx_dy,1) - i1_u = UBOUND(SrcMiscData%dnuvx_dy,1) - i2_l = LBOUND(SrcMiscData%dnuvx_dy,2) - i2_u = UBOUND(SrcMiscData%dnuvx_dy,2) - IF (.NOT. ALLOCATED(DstMiscData%dnuvx_dy)) THEN - ALLOCATE(DstMiscData%dnuvx_dy(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dnuvx_dy.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%dnuvx_dy = SrcMiscData%dnuvx_dy -ENDIF -IF (ALLOCATED(SrcMiscData%dnuvx_dz)) THEN - i1_l = LBOUND(SrcMiscData%dnuvx_dz,1) - i1_u = UBOUND(SrcMiscData%dnuvx_dz,1) - i2_l = LBOUND(SrcMiscData%dnuvx_dz,2) - i2_u = UBOUND(SrcMiscData%dnuvx_dz,2) - IF (.NOT. ALLOCATED(DstMiscData%dnuvx_dz)) THEN - ALLOCATE(DstMiscData%dnuvx_dz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dnuvx_dz.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%dnuvx_dz = SrcMiscData%dnuvx_dz -ENDIF -IF (ALLOCATED(SrcMiscData%a)) THEN - i1_l = LBOUND(SrcMiscData%a,1) - i1_u = UBOUND(SrcMiscData%a,1) - IF (.NOT. ALLOCATED(DstMiscData%a)) THEN - ALLOCATE(DstMiscData%a(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%a.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%a = SrcMiscData%a -ENDIF -IF (ALLOCATED(SrcMiscData%b)) THEN - i1_l = LBOUND(SrcMiscData%b,1) - i1_u = UBOUND(SrcMiscData%b,1) - IF (.NOT. ALLOCATED(DstMiscData%b)) THEN - ALLOCATE(DstMiscData%b(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%b.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%b = SrcMiscData%b -ENDIF -IF (ALLOCATED(SrcMiscData%c)) THEN - i1_l = LBOUND(SrcMiscData%c,1) - i1_u = UBOUND(SrcMiscData%c,1) - IF (.NOT. ALLOCATED(DstMiscData%c)) THEN - ALLOCATE(DstMiscData%c(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%c.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%c = SrcMiscData%c -ENDIF -IF (ALLOCATED(SrcMiscData%d)) THEN - i1_l = LBOUND(SrcMiscData%d,1) - i1_u = UBOUND(SrcMiscData%d,1) - IF (.NOT. ALLOCATED(DstMiscData%d)) THEN - ALLOCATE(DstMiscData%d(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%d.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%d = SrcMiscData%d -ENDIF -IF (ALLOCATED(SrcMiscData%r_wake)) THEN - i1_l = LBOUND(SrcMiscData%r_wake,1) - i1_u = UBOUND(SrcMiscData%r_wake,1) - IF (.NOT. ALLOCATED(DstMiscData%r_wake)) THEN - ALLOCATE(DstMiscData%r_wake(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%r_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%r_wake = SrcMiscData%r_wake -ENDIF -IF (ALLOCATED(SrcMiscData%Vx_high)) THEN - i1_l = LBOUND(SrcMiscData%Vx_high,1) - i1_u = UBOUND(SrcMiscData%Vx_high,1) - IF (.NOT. ALLOCATED(DstMiscData%Vx_high)) THEN - ALLOCATE(DstMiscData%Vx_high(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vx_high.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Vx_high = SrcMiscData%Vx_high -ENDIF -IF (ALLOCATED(SrcMiscData%Vx_polar)) THEN - i1_l = LBOUND(SrcMiscData%Vx_polar,1) - i1_u = UBOUND(SrcMiscData%Vx_polar,1) - IF (.NOT. ALLOCATED(DstMiscData%Vx_polar)) THEN - ALLOCATE(DstMiscData%Vx_polar(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vx_polar.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Vx_polar = SrcMiscData%Vx_polar -ENDIF -IF (ALLOCATED(SrcMiscData%Vt_wake)) THEN - i1_l = LBOUND(SrcMiscData%Vt_wake,1) - i1_u = UBOUND(SrcMiscData%Vt_wake,1) - IF (.NOT. ALLOCATED(DstMiscData%Vt_wake)) THEN - ALLOCATE(DstMiscData%Vt_wake(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vt_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Vt_wake = SrcMiscData%Vt_wake -ENDIF - DstMiscData%GammaCurl = SrcMiscData%GammaCurl - DstMiscData%Ct_avg = SrcMiscData%Ct_avg - END SUBROUTINE WD_CopyMisc - - SUBROUTINE WD_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(WD_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyMisc' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(MiscData%dvtdr)) THEN - DEALLOCATE(MiscData%dvtdr) -ENDIF -IF (ALLOCATED(MiscData%vt_tot)) THEN - DEALLOCATE(MiscData%vt_tot) -ENDIF -IF (ALLOCATED(MiscData%vt_amb)) THEN - DEALLOCATE(MiscData%vt_amb) -ENDIF -IF (ALLOCATED(MiscData%vt_shr)) THEN - DEALLOCATE(MiscData%vt_shr) -ENDIF -IF (ALLOCATED(MiscData%vt_tot2)) THEN - DEALLOCATE(MiscData%vt_tot2) -ENDIF -IF (ALLOCATED(MiscData%vt_amb2)) THEN - DEALLOCATE(MiscData%vt_amb2) -ENDIF -IF (ALLOCATED(MiscData%vt_shr2)) THEN - DEALLOCATE(MiscData%vt_shr2) -ENDIF -IF (ALLOCATED(MiscData%dvx_dy)) THEN - DEALLOCATE(MiscData%dvx_dy) -ENDIF -IF (ALLOCATED(MiscData%dvx_dz)) THEN - DEALLOCATE(MiscData%dvx_dz) -ENDIF -IF (ALLOCATED(MiscData%nu_dvx_dy)) THEN - DEALLOCATE(MiscData%nu_dvx_dy) -ENDIF -IF (ALLOCATED(MiscData%nu_dvx_dz)) THEN - DEALLOCATE(MiscData%nu_dvx_dz) -ENDIF -IF (ALLOCATED(MiscData%dnuvx_dy)) THEN - DEALLOCATE(MiscData%dnuvx_dy) -ENDIF -IF (ALLOCATED(MiscData%dnuvx_dz)) THEN - DEALLOCATE(MiscData%dnuvx_dz) -ENDIF -IF (ALLOCATED(MiscData%a)) THEN - DEALLOCATE(MiscData%a) -ENDIF -IF (ALLOCATED(MiscData%b)) THEN - DEALLOCATE(MiscData%b) -ENDIF -IF (ALLOCATED(MiscData%c)) THEN - DEALLOCATE(MiscData%c) -ENDIF -IF (ALLOCATED(MiscData%d)) THEN - DEALLOCATE(MiscData%d) -ENDIF -IF (ALLOCATED(MiscData%r_wake)) THEN - DEALLOCATE(MiscData%r_wake) -ENDIF -IF (ALLOCATED(MiscData%Vx_high)) THEN - DEALLOCATE(MiscData%Vx_high) -ENDIF -IF (ALLOCATED(MiscData%Vx_polar)) THEN - DEALLOCATE(MiscData%Vx_polar) -ENDIF -IF (ALLOCATED(MiscData%Vt_wake)) THEN - DEALLOCATE(MiscData%Vt_wake) -ENDIF - END SUBROUTINE WD_DestroyMisc +subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(WD_MiscVarType), intent(in) :: SrcMiscData + type(WD_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'WD_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMiscData%dvtdr)) then + LB(1:1) = lbound(SrcMiscData%dvtdr) + UB(1:1) = ubound(SrcMiscData%dvtdr) + if (.not. allocated(DstMiscData%dvtdr)) then + allocate(DstMiscData%dvtdr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dvtdr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%dvtdr = SrcMiscData%dvtdr + else if (allocated(DstMiscData%dvtdr)) then + deallocate(DstMiscData%dvtdr) + end if + if (allocated(SrcMiscData%vt_tot)) then + LB(1:2) = lbound(SrcMiscData%vt_tot) + UB(1:2) = ubound(SrcMiscData%vt_tot) + if (.not. allocated(DstMiscData%vt_tot)) then + allocate(DstMiscData%vt_tot(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%vt_tot.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%vt_tot = SrcMiscData%vt_tot + else if (allocated(DstMiscData%vt_tot)) then + deallocate(DstMiscData%vt_tot) + end if + if (allocated(SrcMiscData%vt_amb)) then + LB(1:2) = lbound(SrcMiscData%vt_amb) + UB(1:2) = ubound(SrcMiscData%vt_amb) + if (.not. allocated(DstMiscData%vt_amb)) then + allocate(DstMiscData%vt_amb(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%vt_amb.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%vt_amb = SrcMiscData%vt_amb + else if (allocated(DstMiscData%vt_amb)) then + deallocate(DstMiscData%vt_amb) + end if + if (allocated(SrcMiscData%vt_shr)) then + LB(1:2) = lbound(SrcMiscData%vt_shr) + UB(1:2) = ubound(SrcMiscData%vt_shr) + if (.not. allocated(DstMiscData%vt_shr)) then + allocate(DstMiscData%vt_shr(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%vt_shr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%vt_shr = SrcMiscData%vt_shr + else if (allocated(DstMiscData%vt_shr)) then + deallocate(DstMiscData%vt_shr) + end if + if (allocated(SrcMiscData%vt_tot2)) then + LB(1:3) = lbound(SrcMiscData%vt_tot2) + UB(1:3) = ubound(SrcMiscData%vt_tot2) + if (.not. allocated(DstMiscData%vt_tot2)) then + allocate(DstMiscData%vt_tot2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%vt_tot2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%vt_tot2 = SrcMiscData%vt_tot2 + else if (allocated(DstMiscData%vt_tot2)) then + deallocate(DstMiscData%vt_tot2) + end if + if (allocated(SrcMiscData%vt_amb2)) then + LB(1:3) = lbound(SrcMiscData%vt_amb2) + UB(1:3) = ubound(SrcMiscData%vt_amb2) + if (.not. allocated(DstMiscData%vt_amb2)) then + allocate(DstMiscData%vt_amb2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%vt_amb2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%vt_amb2 = SrcMiscData%vt_amb2 + else if (allocated(DstMiscData%vt_amb2)) then + deallocate(DstMiscData%vt_amb2) + end if + if (allocated(SrcMiscData%vt_shr2)) then + LB(1:3) = lbound(SrcMiscData%vt_shr2) + UB(1:3) = ubound(SrcMiscData%vt_shr2) + if (.not. allocated(DstMiscData%vt_shr2)) then + allocate(DstMiscData%vt_shr2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%vt_shr2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%vt_shr2 = SrcMiscData%vt_shr2 + else if (allocated(DstMiscData%vt_shr2)) then + deallocate(DstMiscData%vt_shr2) + end if + if (allocated(SrcMiscData%dvx_dy)) then + LB(1:3) = lbound(SrcMiscData%dvx_dy) + UB(1:3) = ubound(SrcMiscData%dvx_dy) + if (.not. allocated(DstMiscData%dvx_dy)) then + allocate(DstMiscData%dvx_dy(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dvx_dy.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%dvx_dy = SrcMiscData%dvx_dy + else if (allocated(DstMiscData%dvx_dy)) then + deallocate(DstMiscData%dvx_dy) + end if + if (allocated(SrcMiscData%dvx_dz)) then + LB(1:3) = lbound(SrcMiscData%dvx_dz) + UB(1:3) = ubound(SrcMiscData%dvx_dz) + if (.not. allocated(DstMiscData%dvx_dz)) then + allocate(DstMiscData%dvx_dz(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dvx_dz.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%dvx_dz = SrcMiscData%dvx_dz + else if (allocated(DstMiscData%dvx_dz)) then + deallocate(DstMiscData%dvx_dz) + end if + if (allocated(SrcMiscData%nu_dvx_dy)) then + LB(1:2) = lbound(SrcMiscData%nu_dvx_dy) + UB(1:2) = ubound(SrcMiscData%nu_dvx_dy) + if (.not. allocated(DstMiscData%nu_dvx_dy)) then + allocate(DstMiscData%nu_dvx_dy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%nu_dvx_dy.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%nu_dvx_dy = SrcMiscData%nu_dvx_dy + else if (allocated(DstMiscData%nu_dvx_dy)) then + deallocate(DstMiscData%nu_dvx_dy) + end if + if (allocated(SrcMiscData%nu_dvx_dz)) then + LB(1:2) = lbound(SrcMiscData%nu_dvx_dz) + UB(1:2) = ubound(SrcMiscData%nu_dvx_dz) + if (.not. allocated(DstMiscData%nu_dvx_dz)) then + allocate(DstMiscData%nu_dvx_dz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%nu_dvx_dz.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%nu_dvx_dz = SrcMiscData%nu_dvx_dz + else if (allocated(DstMiscData%nu_dvx_dz)) then + deallocate(DstMiscData%nu_dvx_dz) + end if + if (allocated(SrcMiscData%dnuvx_dy)) then + LB(1:2) = lbound(SrcMiscData%dnuvx_dy) + UB(1:2) = ubound(SrcMiscData%dnuvx_dy) + if (.not. allocated(DstMiscData%dnuvx_dy)) then + allocate(DstMiscData%dnuvx_dy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dnuvx_dy.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%dnuvx_dy = SrcMiscData%dnuvx_dy + else if (allocated(DstMiscData%dnuvx_dy)) then + deallocate(DstMiscData%dnuvx_dy) + end if + if (allocated(SrcMiscData%dnuvx_dz)) then + LB(1:2) = lbound(SrcMiscData%dnuvx_dz) + UB(1:2) = ubound(SrcMiscData%dnuvx_dz) + if (.not. allocated(DstMiscData%dnuvx_dz)) then + allocate(DstMiscData%dnuvx_dz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dnuvx_dz.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%dnuvx_dz = SrcMiscData%dnuvx_dz + else if (allocated(DstMiscData%dnuvx_dz)) then + deallocate(DstMiscData%dnuvx_dz) + end if + if (allocated(SrcMiscData%a)) then + LB(1:1) = lbound(SrcMiscData%a) + UB(1:1) = ubound(SrcMiscData%a) + if (.not. allocated(DstMiscData%a)) then + allocate(DstMiscData%a(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%a.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%a = SrcMiscData%a + else if (allocated(DstMiscData%a)) then + deallocate(DstMiscData%a) + end if + if (allocated(SrcMiscData%b)) then + LB(1:1) = lbound(SrcMiscData%b) + UB(1:1) = ubound(SrcMiscData%b) + if (.not. allocated(DstMiscData%b)) then + allocate(DstMiscData%b(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%b.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%b = SrcMiscData%b + else if (allocated(DstMiscData%b)) then + deallocate(DstMiscData%b) + end if + if (allocated(SrcMiscData%c)) then + LB(1:1) = lbound(SrcMiscData%c) + UB(1:1) = ubound(SrcMiscData%c) + if (.not. allocated(DstMiscData%c)) then + allocate(DstMiscData%c(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%c.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%c = SrcMiscData%c + else if (allocated(DstMiscData%c)) then + deallocate(DstMiscData%c) + end if + if (allocated(SrcMiscData%d)) then + LB(1:1) = lbound(SrcMiscData%d) + UB(1:1) = ubound(SrcMiscData%d) + if (.not. allocated(DstMiscData%d)) then + allocate(DstMiscData%d(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%d.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%d = SrcMiscData%d + else if (allocated(DstMiscData%d)) then + deallocate(DstMiscData%d) + end if + if (allocated(SrcMiscData%r_wake)) then + LB(1:1) = lbound(SrcMiscData%r_wake) + UB(1:1) = ubound(SrcMiscData%r_wake) + if (.not. allocated(DstMiscData%r_wake)) then + allocate(DstMiscData%r_wake(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%r_wake.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%r_wake = SrcMiscData%r_wake + else if (allocated(DstMiscData%r_wake)) then + deallocate(DstMiscData%r_wake) + end if + if (allocated(SrcMiscData%Vx_high)) then + LB(1:1) = lbound(SrcMiscData%Vx_high) + UB(1:1) = ubound(SrcMiscData%Vx_high) + if (.not. allocated(DstMiscData%Vx_high)) then + allocate(DstMiscData%Vx_high(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vx_high.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Vx_high = SrcMiscData%Vx_high + else if (allocated(DstMiscData%Vx_high)) then + deallocate(DstMiscData%Vx_high) + end if + if (allocated(SrcMiscData%Vx_polar)) then + LB(1:1) = lbound(SrcMiscData%Vx_polar) + UB(1:1) = ubound(SrcMiscData%Vx_polar) + if (.not. allocated(DstMiscData%Vx_polar)) then + allocate(DstMiscData%Vx_polar(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vx_polar.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Vx_polar = SrcMiscData%Vx_polar + else if (allocated(DstMiscData%Vx_polar)) then + deallocate(DstMiscData%Vx_polar) + end if + if (allocated(SrcMiscData%Vt_wake)) then + LB(1:1) = lbound(SrcMiscData%Vt_wake) + UB(1:1) = ubound(SrcMiscData%Vt_wake) + if (.not. allocated(DstMiscData%Vt_wake)) then + allocate(DstMiscData%Vt_wake(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Vt_wake.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%Vt_wake = SrcMiscData%Vt_wake + else if (allocated(DstMiscData%Vt_wake)) then + deallocate(DstMiscData%Vt_wake) + end if + DstMiscData%GammaCurl = SrcMiscData%GammaCurl + DstMiscData%Ct_avg = SrcMiscData%Ct_avg +end subroutine +subroutine WD_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(WD_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WD_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%dvtdr)) then + deallocate(MiscData%dvtdr) + end if + if (allocated(MiscData%vt_tot)) then + deallocate(MiscData%vt_tot) + end if + if (allocated(MiscData%vt_amb)) then + deallocate(MiscData%vt_amb) + end if + if (allocated(MiscData%vt_shr)) then + deallocate(MiscData%vt_shr) + end if + if (allocated(MiscData%vt_tot2)) then + deallocate(MiscData%vt_tot2) + end if + if (allocated(MiscData%vt_amb2)) then + deallocate(MiscData%vt_amb2) + end if + if (allocated(MiscData%vt_shr2)) then + deallocate(MiscData%vt_shr2) + end if + if (allocated(MiscData%dvx_dy)) then + deallocate(MiscData%dvx_dy) + end if + if (allocated(MiscData%dvx_dz)) then + deallocate(MiscData%dvx_dz) + end if + if (allocated(MiscData%nu_dvx_dy)) then + deallocate(MiscData%nu_dvx_dy) + end if + if (allocated(MiscData%nu_dvx_dz)) then + deallocate(MiscData%nu_dvx_dz) + end if + if (allocated(MiscData%dnuvx_dy)) then + deallocate(MiscData%dnuvx_dy) + end if + if (allocated(MiscData%dnuvx_dz)) then + deallocate(MiscData%dnuvx_dz) + end if + if (allocated(MiscData%a)) then + deallocate(MiscData%a) + end if + if (allocated(MiscData%b)) then + deallocate(MiscData%b) + end if + if (allocated(MiscData%c)) then + deallocate(MiscData%c) + end if + if (allocated(MiscData%d)) then + deallocate(MiscData%d) + end if + if (allocated(MiscData%r_wake)) then + deallocate(MiscData%r_wake) + end if + if (allocated(MiscData%Vx_high)) then + deallocate(MiscData%Vx_high) + end if + if (allocated(MiscData%Vx_polar)) then + deallocate(MiscData%Vx_polar) + end if + if (allocated(MiscData%Vt_wake)) then + deallocate(MiscData%Vt_wake) + end if +end subroutine subroutine WD_PackMisc(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(WD_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'WD_PackMisc' if (Buf%ErrStat >= AbortErrLev) return - ! dvtdr call RegPack(Buf, allocated(InData%dvtdr)) if (allocated(InData%dvtdr)) then call RegPackBounds(Buf, 1, lbound(InData%dvtdr), ubound(InData%dvtdr)) call RegPack(Buf, InData%dvtdr) end if if (RegCheckErr(Buf, RoutineName)) return - ! vt_tot call RegPack(Buf, allocated(InData%vt_tot)) if (allocated(InData%vt_tot)) then call RegPackBounds(Buf, 2, lbound(InData%vt_tot), ubound(InData%vt_tot)) call RegPack(Buf, InData%vt_tot) end if if (RegCheckErr(Buf, RoutineName)) return - ! vt_amb call RegPack(Buf, allocated(InData%vt_amb)) if (allocated(InData%vt_amb)) then call RegPackBounds(Buf, 2, lbound(InData%vt_amb), ubound(InData%vt_amb)) call RegPack(Buf, InData%vt_amb) end if if (RegCheckErr(Buf, RoutineName)) return - ! vt_shr call RegPack(Buf, allocated(InData%vt_shr)) if (allocated(InData%vt_shr)) then call RegPackBounds(Buf, 2, lbound(InData%vt_shr), ubound(InData%vt_shr)) call RegPack(Buf, InData%vt_shr) end if if (RegCheckErr(Buf, RoutineName)) return - ! vt_tot2 call RegPack(Buf, allocated(InData%vt_tot2)) if (allocated(InData%vt_tot2)) then call RegPackBounds(Buf, 3, lbound(InData%vt_tot2), ubound(InData%vt_tot2)) call RegPack(Buf, InData%vt_tot2) end if if (RegCheckErr(Buf, RoutineName)) return - ! vt_amb2 call RegPack(Buf, allocated(InData%vt_amb2)) if (allocated(InData%vt_amb2)) then call RegPackBounds(Buf, 3, lbound(InData%vt_amb2), ubound(InData%vt_amb2)) call RegPack(Buf, InData%vt_amb2) end if if (RegCheckErr(Buf, RoutineName)) return - ! vt_shr2 call RegPack(Buf, allocated(InData%vt_shr2)) if (allocated(InData%vt_shr2)) then call RegPackBounds(Buf, 3, lbound(InData%vt_shr2), ubound(InData%vt_shr2)) call RegPack(Buf, InData%vt_shr2) end if if (RegCheckErr(Buf, RoutineName)) return - ! dvx_dy call RegPack(Buf, allocated(InData%dvx_dy)) if (allocated(InData%dvx_dy)) then call RegPackBounds(Buf, 3, lbound(InData%dvx_dy), ubound(InData%dvx_dy)) call RegPack(Buf, InData%dvx_dy) end if if (RegCheckErr(Buf, RoutineName)) return - ! dvx_dz call RegPack(Buf, allocated(InData%dvx_dz)) if (allocated(InData%dvx_dz)) then call RegPackBounds(Buf, 3, lbound(InData%dvx_dz), ubound(InData%dvx_dz)) call RegPack(Buf, InData%dvx_dz) end if if (RegCheckErr(Buf, RoutineName)) return - ! nu_dvx_dy call RegPack(Buf, allocated(InData%nu_dvx_dy)) if (allocated(InData%nu_dvx_dy)) then call RegPackBounds(Buf, 2, lbound(InData%nu_dvx_dy), ubound(InData%nu_dvx_dy)) call RegPack(Buf, InData%nu_dvx_dy) end if if (RegCheckErr(Buf, RoutineName)) return - ! nu_dvx_dz call RegPack(Buf, allocated(InData%nu_dvx_dz)) if (allocated(InData%nu_dvx_dz)) then call RegPackBounds(Buf, 2, lbound(InData%nu_dvx_dz), ubound(InData%nu_dvx_dz)) call RegPack(Buf, InData%nu_dvx_dz) end if if (RegCheckErr(Buf, RoutineName)) return - ! dnuvx_dy call RegPack(Buf, allocated(InData%dnuvx_dy)) if (allocated(InData%dnuvx_dy)) then call RegPackBounds(Buf, 2, lbound(InData%dnuvx_dy), ubound(InData%dnuvx_dy)) call RegPack(Buf, InData%dnuvx_dy) end if if (RegCheckErr(Buf, RoutineName)) return - ! dnuvx_dz call RegPack(Buf, allocated(InData%dnuvx_dz)) if (allocated(InData%dnuvx_dz)) then call RegPackBounds(Buf, 2, lbound(InData%dnuvx_dz), ubound(InData%dnuvx_dz)) call RegPack(Buf, InData%dnuvx_dz) end if if (RegCheckErr(Buf, RoutineName)) return - ! a call RegPack(Buf, allocated(InData%a)) if (allocated(InData%a)) then call RegPackBounds(Buf, 1, lbound(InData%a), ubound(InData%a)) call RegPack(Buf, InData%a) end if if (RegCheckErr(Buf, RoutineName)) return - ! b call RegPack(Buf, allocated(InData%b)) if (allocated(InData%b)) then call RegPackBounds(Buf, 1, lbound(InData%b), ubound(InData%b)) call RegPack(Buf, InData%b) end if if (RegCheckErr(Buf, RoutineName)) return - ! c call RegPack(Buf, allocated(InData%c)) if (allocated(InData%c)) then call RegPackBounds(Buf, 1, lbound(InData%c), ubound(InData%c)) call RegPack(Buf, InData%c) end if if (RegCheckErr(Buf, RoutineName)) return - ! d call RegPack(Buf, allocated(InData%d)) if (allocated(InData%d)) then call RegPackBounds(Buf, 1, lbound(InData%d), ubound(InData%d)) call RegPack(Buf, InData%d) end if if (RegCheckErr(Buf, RoutineName)) return - ! r_wake call RegPack(Buf, allocated(InData%r_wake)) if (allocated(InData%r_wake)) then call RegPackBounds(Buf, 1, lbound(InData%r_wake), ubound(InData%r_wake)) call RegPack(Buf, InData%r_wake) end if if (RegCheckErr(Buf, RoutineName)) return - ! Vx_high call RegPack(Buf, allocated(InData%Vx_high)) if (allocated(InData%Vx_high)) then call RegPackBounds(Buf, 1, lbound(InData%Vx_high), ubound(InData%Vx_high)) call RegPack(Buf, InData%Vx_high) end if if (RegCheckErr(Buf, RoutineName)) return - ! Vx_polar call RegPack(Buf, allocated(InData%Vx_polar)) if (allocated(InData%Vx_polar)) then call RegPackBounds(Buf, 1, lbound(InData%Vx_polar), ubound(InData%Vx_polar)) call RegPack(Buf, InData%Vx_polar) end if if (RegCheckErr(Buf, RoutineName)) return - ! Vt_wake call RegPack(Buf, allocated(InData%Vt_wake)) if (allocated(InData%Vt_wake)) then call RegPackBounds(Buf, 1, lbound(InData%Vt_wake), ubound(InData%Vt_wake)) call RegPack(Buf, InData%Vt_wake) end if if (RegCheckErr(Buf, RoutineName)) return - ! GammaCurl call RegPack(Buf, InData%GammaCurl) if (RegCheckErr(Buf, RoutineName)) return - ! Ct_avg call RegPack(Buf, InData%Ct_avg) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2059,7 +1852,6 @@ subroutine WD_UnPackMisc(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! dvtdr if (allocated(OutData%dvtdr)) deallocate(OutData%dvtdr) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2074,7 +1866,6 @@ subroutine WD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%dvtdr) if (RegCheckErr(Buf, RoutineName)) return end if - ! vt_tot if (allocated(OutData%vt_tot)) deallocate(OutData%vt_tot) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2089,7 +1880,6 @@ subroutine WD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%vt_tot) if (RegCheckErr(Buf, RoutineName)) return end if - ! vt_amb if (allocated(OutData%vt_amb)) deallocate(OutData%vt_amb) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2104,7 +1894,6 @@ subroutine WD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%vt_amb) if (RegCheckErr(Buf, RoutineName)) return end if - ! vt_shr if (allocated(OutData%vt_shr)) deallocate(OutData%vt_shr) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2119,7 +1908,6 @@ subroutine WD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%vt_shr) if (RegCheckErr(Buf, RoutineName)) return end if - ! vt_tot2 if (allocated(OutData%vt_tot2)) deallocate(OutData%vt_tot2) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2134,7 +1922,6 @@ subroutine WD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%vt_tot2) if (RegCheckErr(Buf, RoutineName)) return end if - ! vt_amb2 if (allocated(OutData%vt_amb2)) deallocate(OutData%vt_amb2) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2149,7 +1936,6 @@ subroutine WD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%vt_amb2) if (RegCheckErr(Buf, RoutineName)) return end if - ! vt_shr2 if (allocated(OutData%vt_shr2)) deallocate(OutData%vt_shr2) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2164,7 +1950,6 @@ subroutine WD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%vt_shr2) if (RegCheckErr(Buf, RoutineName)) return end if - ! dvx_dy if (allocated(OutData%dvx_dy)) deallocate(OutData%dvx_dy) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2179,7 +1964,6 @@ subroutine WD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%dvx_dy) if (RegCheckErr(Buf, RoutineName)) return end if - ! dvx_dz if (allocated(OutData%dvx_dz)) deallocate(OutData%dvx_dz) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2194,7 +1978,6 @@ subroutine WD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%dvx_dz) if (RegCheckErr(Buf, RoutineName)) return end if - ! nu_dvx_dy if (allocated(OutData%nu_dvx_dy)) deallocate(OutData%nu_dvx_dy) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2209,7 +1992,6 @@ subroutine WD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%nu_dvx_dy) if (RegCheckErr(Buf, RoutineName)) return end if - ! nu_dvx_dz if (allocated(OutData%nu_dvx_dz)) deallocate(OutData%nu_dvx_dz) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2224,7 +2006,6 @@ subroutine WD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%nu_dvx_dz) if (RegCheckErr(Buf, RoutineName)) return end if - ! dnuvx_dy if (allocated(OutData%dnuvx_dy)) deallocate(OutData%dnuvx_dy) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2239,7 +2020,6 @@ subroutine WD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%dnuvx_dy) if (RegCheckErr(Buf, RoutineName)) return end if - ! dnuvx_dz if (allocated(OutData%dnuvx_dz)) deallocate(OutData%dnuvx_dz) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2254,7 +2034,6 @@ subroutine WD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%dnuvx_dz) if (RegCheckErr(Buf, RoutineName)) return end if - ! a if (allocated(OutData%a)) deallocate(OutData%a) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2269,7 +2048,6 @@ subroutine WD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%a) if (RegCheckErr(Buf, RoutineName)) return end if - ! b if (allocated(OutData%b)) deallocate(OutData%b) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2284,7 +2062,6 @@ subroutine WD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%b) if (RegCheckErr(Buf, RoutineName)) return end if - ! c if (allocated(OutData%c)) deallocate(OutData%c) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2299,7 +2076,6 @@ subroutine WD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%c) if (RegCheckErr(Buf, RoutineName)) return end if - ! d if (allocated(OutData%d)) deallocate(OutData%d) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2314,7 +2090,6 @@ subroutine WD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%d) if (RegCheckErr(Buf, RoutineName)) return end if - ! r_wake if (allocated(OutData%r_wake)) deallocate(OutData%r_wake) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2329,7 +2104,6 @@ subroutine WD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%r_wake) if (RegCheckErr(Buf, RoutineName)) return end if - ! Vx_high if (allocated(OutData%Vx_high)) deallocate(OutData%Vx_high) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2344,7 +2118,6 @@ subroutine WD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%Vx_high) if (RegCheckErr(Buf, RoutineName)) return end if - ! Vx_polar if (allocated(OutData%Vx_polar)) deallocate(OutData%Vx_polar) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2359,7 +2132,6 @@ subroutine WD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%Vx_polar) if (RegCheckErr(Buf, RoutineName)) return end if - ! Vt_wake if (allocated(OutData%Vt_wake)) deallocate(OutData%Vt_wake) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2374,263 +2146,217 @@ subroutine WD_UnPackMisc(Buf, OutData) call RegUnpack(Buf, OutData%Vt_wake) if (RegCheckErr(Buf, RoutineName)) return end if - ! GammaCurl call RegUnpack(Buf, OutData%GammaCurl) if (RegCheckErr(Buf, RoutineName)) return - ! Ct_avg call RegUnpack(Buf, OutData%Ct_avg) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE WD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WD_ParameterType), INTENT(IN) :: SrcParamData - TYPE(WD_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%dt_low = SrcParamData%dt_low - DstParamData%NumPlanes = SrcParamData%NumPlanes - DstParamData%NumRadii = SrcParamData%NumRadii - DstParamData%dr = SrcParamData%dr -IF (ALLOCATED(SrcParamData%r)) THEN - i1_l = LBOUND(SrcParamData%r,1) - i1_u = UBOUND(SrcParamData%r,1) - IF (.NOT. ALLOCATED(DstParamData%r)) THEN - ALLOCATE(DstParamData%r(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%r.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%r = SrcParamData%r -ENDIF -IF (ALLOCATED(SrcParamData%y)) THEN - i1_l = LBOUND(SrcParamData%y,1) - i1_u = UBOUND(SrcParamData%y,1) - IF (.NOT. ALLOCATED(DstParamData%y)) THEN - ALLOCATE(DstParamData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%y = SrcParamData%y -ENDIF -IF (ALLOCATED(SrcParamData%z)) THEN - i1_l = LBOUND(SrcParamData%z,1) - i1_u = UBOUND(SrcParamData%z,1) - IF (.NOT. ALLOCATED(DstParamData%z)) THEN - ALLOCATE(DstParamData%z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%z = SrcParamData%z -ENDIF - DstParamData%Mod_Wake = SrcParamData%Mod_Wake - DstParamData%Swirl = SrcParamData%Swirl - DstParamData%k_VortexDecay = SrcParamData%k_VortexDecay - DstParamData%sigma_D = SrcParamData%sigma_D - DstParamData%NumVortices = SrcParamData%NumVortices - DstParamData%filtParam = SrcParamData%filtParam - DstParamData%oneMinusFiltParam = SrcParamData%oneMinusFiltParam - DstParamData%C_HWkDfl_O = SrcParamData%C_HWkDfl_O - DstParamData%C_HWkDfl_OY = SrcParamData%C_HWkDfl_OY - DstParamData%C_HWkDfl_x = SrcParamData%C_HWkDfl_x - DstParamData%C_HWkDfl_xY = SrcParamData%C_HWkDfl_xY - DstParamData%C_NearWake = SrcParamData%C_NearWake - DstParamData%C_vAmb_DMin = SrcParamData%C_vAmb_DMin - DstParamData%C_vAmb_DMax = SrcParamData%C_vAmb_DMax - DstParamData%C_vAmb_FMin = SrcParamData%C_vAmb_FMin - DstParamData%C_vAmb_Exp = SrcParamData%C_vAmb_Exp - DstParamData%C_vShr_DMin = SrcParamData%C_vShr_DMin - DstParamData%C_vShr_DMax = SrcParamData%C_vShr_DMax - DstParamData%C_vShr_FMin = SrcParamData%C_vShr_FMin - DstParamData%C_vShr_Exp = SrcParamData%C_vShr_Exp - DstParamData%k_vAmb = SrcParamData%k_vAmb - DstParamData%k_vShr = SrcParamData%k_vShr - DstParamData%Mod_WakeDiam = SrcParamData%Mod_WakeDiam - DstParamData%C_WakeDiam = SrcParamData%C_WakeDiam - DstParamData%FilterInit = SrcParamData%FilterInit - DstParamData%k_vCurl = SrcParamData%k_vCurl - DstParamData%OutAllPlanes = SrcParamData%OutAllPlanes - DstParamData%OutFileRoot = SrcParamData%OutFileRoot - DstParamData%OutFileVTKDir = SrcParamData%OutFileVTKDir - DstParamData%TurbNum = SrcParamData%TurbNum - DstParamData%WAT = SrcParamData%WAT - DstParamData%WAT_k_Def = SrcParamData%WAT_k_Def - DstParamData%WAT_k_Grad = SrcParamData%WAT_k_Grad - END SUBROUTINE WD_CopyParam - - SUBROUTINE WD_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(WD_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyParam' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%r)) THEN - DEALLOCATE(ParamData%r) -ENDIF -IF (ALLOCATED(ParamData%y)) THEN - DEALLOCATE(ParamData%y) -ENDIF -IF (ALLOCATED(ParamData%z)) THEN - DEALLOCATE(ParamData%z) -ENDIF - END SUBROUTINE WD_DestroyParam +subroutine WD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) + type(WD_ParameterType), intent(in) :: SrcParamData + type(WD_ParameterType), intent(inout) :: DstParamData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'WD_CopyParam' + ErrStat = ErrID_None + ErrMsg = '' + DstParamData%dt_low = SrcParamData%dt_low + DstParamData%NumPlanes = SrcParamData%NumPlanes + DstParamData%NumRadii = SrcParamData%NumRadii + DstParamData%dr = SrcParamData%dr + if (allocated(SrcParamData%r)) then + LB(1:1) = lbound(SrcParamData%r) + UB(1:1) = ubound(SrcParamData%r) + if (.not. allocated(DstParamData%r)) then + allocate(DstParamData%r(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%r.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%r = SrcParamData%r + else if (allocated(DstParamData%r)) then + deallocate(DstParamData%r) + end if + if (allocated(SrcParamData%y)) then + LB(1:1) = lbound(SrcParamData%y) + UB(1:1) = ubound(SrcParamData%y) + if (.not. allocated(DstParamData%y)) then + allocate(DstParamData%y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%y = SrcParamData%y + else if (allocated(DstParamData%y)) then + deallocate(DstParamData%y) + end if + if (allocated(SrcParamData%z)) then + LB(1:1) = lbound(SrcParamData%z) + UB(1:1) = ubound(SrcParamData%z) + if (.not. allocated(DstParamData%z)) then + allocate(DstParamData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%z = SrcParamData%z + else if (allocated(DstParamData%z)) then + deallocate(DstParamData%z) + end if + DstParamData%Mod_Wake = SrcParamData%Mod_Wake + DstParamData%Swirl = SrcParamData%Swirl + DstParamData%k_VortexDecay = SrcParamData%k_VortexDecay + DstParamData%sigma_D = SrcParamData%sigma_D + DstParamData%NumVortices = SrcParamData%NumVortices + DstParamData%filtParam = SrcParamData%filtParam + DstParamData%oneMinusFiltParam = SrcParamData%oneMinusFiltParam + DstParamData%C_HWkDfl_O = SrcParamData%C_HWkDfl_O + DstParamData%C_HWkDfl_OY = SrcParamData%C_HWkDfl_OY + DstParamData%C_HWkDfl_x = SrcParamData%C_HWkDfl_x + DstParamData%C_HWkDfl_xY = SrcParamData%C_HWkDfl_xY + DstParamData%C_NearWake = SrcParamData%C_NearWake + DstParamData%C_vAmb_DMin = SrcParamData%C_vAmb_DMin + DstParamData%C_vAmb_DMax = SrcParamData%C_vAmb_DMax + DstParamData%C_vAmb_FMin = SrcParamData%C_vAmb_FMin + DstParamData%C_vAmb_Exp = SrcParamData%C_vAmb_Exp + DstParamData%C_vShr_DMin = SrcParamData%C_vShr_DMin + DstParamData%C_vShr_DMax = SrcParamData%C_vShr_DMax + DstParamData%C_vShr_FMin = SrcParamData%C_vShr_FMin + DstParamData%C_vShr_Exp = SrcParamData%C_vShr_Exp + DstParamData%k_vAmb = SrcParamData%k_vAmb + DstParamData%k_vShr = SrcParamData%k_vShr + DstParamData%Mod_WakeDiam = SrcParamData%Mod_WakeDiam + DstParamData%C_WakeDiam = SrcParamData%C_WakeDiam + DstParamData%FilterInit = SrcParamData%FilterInit + DstParamData%k_vCurl = SrcParamData%k_vCurl + DstParamData%OutAllPlanes = SrcParamData%OutAllPlanes + DstParamData%OutFileRoot = SrcParamData%OutFileRoot + DstParamData%OutFileVTKDir = SrcParamData%OutFileVTKDir + DstParamData%TurbNum = SrcParamData%TurbNum + DstParamData%WAT = SrcParamData%WAT + DstParamData%WAT_k_Def = SrcParamData%WAT_k_Def + DstParamData%WAT_k_Grad = SrcParamData%WAT_k_Grad +end subroutine +subroutine WD_DestroyParam(ParamData, ErrStat, ErrMsg) + type(WD_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WD_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(ParamData%r)) then + deallocate(ParamData%r) + end if + if (allocated(ParamData%y)) then + deallocate(ParamData%y) + end if + if (allocated(ParamData%z)) then + deallocate(ParamData%z) + end if +end subroutine subroutine WD_PackParam(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(WD_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'WD_PackParam' if (Buf%ErrStat >= AbortErrLev) return - ! dt_low call RegPack(Buf, InData%dt_low) if (RegCheckErr(Buf, RoutineName)) return - ! NumPlanes call RegPack(Buf, InData%NumPlanes) if (RegCheckErr(Buf, RoutineName)) return - ! NumRadii call RegPack(Buf, InData%NumRadii) if (RegCheckErr(Buf, RoutineName)) return - ! dr call RegPack(Buf, InData%dr) if (RegCheckErr(Buf, RoutineName)) return - ! r call RegPack(Buf, allocated(InData%r)) if (allocated(InData%r)) then call RegPackBounds(Buf, 1, lbound(InData%r), ubound(InData%r)) call RegPack(Buf, InData%r) end if if (RegCheckErr(Buf, RoutineName)) return - ! y call RegPack(Buf, allocated(InData%y)) if (allocated(InData%y)) then call RegPackBounds(Buf, 1, lbound(InData%y), ubound(InData%y)) call RegPack(Buf, InData%y) end if if (RegCheckErr(Buf, RoutineName)) return - ! z call RegPack(Buf, allocated(InData%z)) if (allocated(InData%z)) then call RegPackBounds(Buf, 1, lbound(InData%z), ubound(InData%z)) call RegPack(Buf, InData%z) end if if (RegCheckErr(Buf, RoutineName)) return - ! Mod_Wake call RegPack(Buf, InData%Mod_Wake) if (RegCheckErr(Buf, RoutineName)) return - ! Swirl call RegPack(Buf, InData%Swirl) if (RegCheckErr(Buf, RoutineName)) return - ! k_VortexDecay call RegPack(Buf, InData%k_VortexDecay) if (RegCheckErr(Buf, RoutineName)) return - ! sigma_D call RegPack(Buf, InData%sigma_D) if (RegCheckErr(Buf, RoutineName)) return - ! NumVortices call RegPack(Buf, InData%NumVortices) if (RegCheckErr(Buf, RoutineName)) return - ! filtParam call RegPack(Buf, InData%filtParam) if (RegCheckErr(Buf, RoutineName)) return - ! oneMinusFiltParam call RegPack(Buf, InData%oneMinusFiltParam) if (RegCheckErr(Buf, RoutineName)) return - ! C_HWkDfl_O call RegPack(Buf, InData%C_HWkDfl_O) if (RegCheckErr(Buf, RoutineName)) return - ! C_HWkDfl_OY call RegPack(Buf, InData%C_HWkDfl_OY) if (RegCheckErr(Buf, RoutineName)) return - ! C_HWkDfl_x call RegPack(Buf, InData%C_HWkDfl_x) if (RegCheckErr(Buf, RoutineName)) return - ! C_HWkDfl_xY call RegPack(Buf, InData%C_HWkDfl_xY) if (RegCheckErr(Buf, RoutineName)) return - ! C_NearWake call RegPack(Buf, InData%C_NearWake) if (RegCheckErr(Buf, RoutineName)) return - ! C_vAmb_DMin call RegPack(Buf, InData%C_vAmb_DMin) if (RegCheckErr(Buf, RoutineName)) return - ! C_vAmb_DMax call RegPack(Buf, InData%C_vAmb_DMax) if (RegCheckErr(Buf, RoutineName)) return - ! C_vAmb_FMin call RegPack(Buf, InData%C_vAmb_FMin) if (RegCheckErr(Buf, RoutineName)) return - ! C_vAmb_Exp call RegPack(Buf, InData%C_vAmb_Exp) if (RegCheckErr(Buf, RoutineName)) return - ! C_vShr_DMin call RegPack(Buf, InData%C_vShr_DMin) if (RegCheckErr(Buf, RoutineName)) return - ! C_vShr_DMax call RegPack(Buf, InData%C_vShr_DMax) if (RegCheckErr(Buf, RoutineName)) return - ! C_vShr_FMin call RegPack(Buf, InData%C_vShr_FMin) if (RegCheckErr(Buf, RoutineName)) return - ! C_vShr_Exp call RegPack(Buf, InData%C_vShr_Exp) if (RegCheckErr(Buf, RoutineName)) return - ! k_vAmb call RegPack(Buf, InData%k_vAmb) if (RegCheckErr(Buf, RoutineName)) return - ! k_vShr call RegPack(Buf, InData%k_vShr) if (RegCheckErr(Buf, RoutineName)) return - ! Mod_WakeDiam call RegPack(Buf, InData%Mod_WakeDiam) if (RegCheckErr(Buf, RoutineName)) return - ! C_WakeDiam call RegPack(Buf, InData%C_WakeDiam) if (RegCheckErr(Buf, RoutineName)) return - ! FilterInit call RegPack(Buf, InData%FilterInit) if (RegCheckErr(Buf, RoutineName)) return - ! k_vCurl call RegPack(Buf, InData%k_vCurl) if (RegCheckErr(Buf, RoutineName)) return - ! OutAllPlanes call RegPack(Buf, InData%OutAllPlanes) if (RegCheckErr(Buf, RoutineName)) return - ! OutFileRoot call RegPack(Buf, InData%OutFileRoot) if (RegCheckErr(Buf, RoutineName)) return - ! OutFileVTKDir call RegPack(Buf, InData%OutFileVTKDir) if (RegCheckErr(Buf, RoutineName)) return - ! TurbNum call RegPack(Buf, InData%TurbNum) if (RegCheckErr(Buf, RoutineName)) return - ! WAT call RegPack(Buf, InData%WAT) if (RegCheckErr(Buf, RoutineName)) return - ! WAT_k_Def call RegPack(Buf, InData%WAT_k_Def) if (RegCheckErr(Buf, RoutineName)) return - ! WAT_k_Grad call RegPack(Buf, InData%WAT_k_Grad) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2643,19 +2369,14 @@ subroutine WD_UnPackParam(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! dt_low call RegUnpack(Buf, OutData%dt_low) if (RegCheckErr(Buf, RoutineName)) return - ! NumPlanes call RegUnpack(Buf, OutData%NumPlanes) if (RegCheckErr(Buf, RoutineName)) return - ! NumRadii call RegUnpack(Buf, OutData%NumRadii) if (RegCheckErr(Buf, RoutineName)) return - ! dr call RegUnpack(Buf, OutData%dr) if (RegCheckErr(Buf, RoutineName)) return - ! r if (allocated(OutData%r)) deallocate(OutData%r) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2670,7 +2391,6 @@ subroutine WD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%r) if (RegCheckErr(Buf, RoutineName)) return end if - ! y if (allocated(OutData%y)) deallocate(OutData%y) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2685,7 +2405,6 @@ subroutine WD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%y) if (RegCheckErr(Buf, RoutineName)) return end if - ! z if (allocated(OutData%z)) deallocate(OutData%z) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2700,243 +2419,191 @@ subroutine WD_UnPackParam(Buf, OutData) call RegUnpack(Buf, OutData%z) if (RegCheckErr(Buf, RoutineName)) return end if - ! Mod_Wake call RegUnpack(Buf, OutData%Mod_Wake) if (RegCheckErr(Buf, RoutineName)) return - ! Swirl call RegUnpack(Buf, OutData%Swirl) if (RegCheckErr(Buf, RoutineName)) return - ! k_VortexDecay call RegUnpack(Buf, OutData%k_VortexDecay) if (RegCheckErr(Buf, RoutineName)) return - ! sigma_D call RegUnpack(Buf, OutData%sigma_D) if (RegCheckErr(Buf, RoutineName)) return - ! NumVortices call RegUnpack(Buf, OutData%NumVortices) if (RegCheckErr(Buf, RoutineName)) return - ! filtParam call RegUnpack(Buf, OutData%filtParam) if (RegCheckErr(Buf, RoutineName)) return - ! oneMinusFiltParam call RegUnpack(Buf, OutData%oneMinusFiltParam) if (RegCheckErr(Buf, RoutineName)) return - ! C_HWkDfl_O call RegUnpack(Buf, OutData%C_HWkDfl_O) if (RegCheckErr(Buf, RoutineName)) return - ! C_HWkDfl_OY call RegUnpack(Buf, OutData%C_HWkDfl_OY) if (RegCheckErr(Buf, RoutineName)) return - ! C_HWkDfl_x call RegUnpack(Buf, OutData%C_HWkDfl_x) if (RegCheckErr(Buf, RoutineName)) return - ! C_HWkDfl_xY call RegUnpack(Buf, OutData%C_HWkDfl_xY) if (RegCheckErr(Buf, RoutineName)) return - ! C_NearWake call RegUnpack(Buf, OutData%C_NearWake) if (RegCheckErr(Buf, RoutineName)) return - ! C_vAmb_DMin call RegUnpack(Buf, OutData%C_vAmb_DMin) if (RegCheckErr(Buf, RoutineName)) return - ! C_vAmb_DMax call RegUnpack(Buf, OutData%C_vAmb_DMax) if (RegCheckErr(Buf, RoutineName)) return - ! C_vAmb_FMin call RegUnpack(Buf, OutData%C_vAmb_FMin) if (RegCheckErr(Buf, RoutineName)) return - ! C_vAmb_Exp call RegUnpack(Buf, OutData%C_vAmb_Exp) if (RegCheckErr(Buf, RoutineName)) return - ! C_vShr_DMin call RegUnpack(Buf, OutData%C_vShr_DMin) if (RegCheckErr(Buf, RoutineName)) return - ! C_vShr_DMax call RegUnpack(Buf, OutData%C_vShr_DMax) if (RegCheckErr(Buf, RoutineName)) return - ! C_vShr_FMin call RegUnpack(Buf, OutData%C_vShr_FMin) if (RegCheckErr(Buf, RoutineName)) return - ! C_vShr_Exp call RegUnpack(Buf, OutData%C_vShr_Exp) if (RegCheckErr(Buf, RoutineName)) return - ! k_vAmb call RegUnpack(Buf, OutData%k_vAmb) if (RegCheckErr(Buf, RoutineName)) return - ! k_vShr call RegUnpack(Buf, OutData%k_vShr) if (RegCheckErr(Buf, RoutineName)) return - ! Mod_WakeDiam call RegUnpack(Buf, OutData%Mod_WakeDiam) if (RegCheckErr(Buf, RoutineName)) return - ! C_WakeDiam call RegUnpack(Buf, OutData%C_WakeDiam) if (RegCheckErr(Buf, RoutineName)) return - ! FilterInit call RegUnpack(Buf, OutData%FilterInit) if (RegCheckErr(Buf, RoutineName)) return - ! k_vCurl call RegUnpack(Buf, OutData%k_vCurl) if (RegCheckErr(Buf, RoutineName)) return - ! OutAllPlanes call RegUnpack(Buf, OutData%OutAllPlanes) if (RegCheckErr(Buf, RoutineName)) return - ! OutFileRoot call RegUnpack(Buf, OutData%OutFileRoot) if (RegCheckErr(Buf, RoutineName)) return - ! OutFileVTKDir call RegUnpack(Buf, OutData%OutFileVTKDir) if (RegCheckErr(Buf, RoutineName)) return - ! TurbNum call RegUnpack(Buf, OutData%TurbNum) if (RegCheckErr(Buf, RoutineName)) return - ! WAT call RegUnpack(Buf, OutData%WAT) if (RegCheckErr(Buf, RoutineName)) return - ! WAT_k_Def call RegUnpack(Buf, OutData%WAT_k_Def) if (RegCheckErr(Buf, RoutineName)) return - ! WAT_k_Grad call RegUnpack(Buf, OutData%WAT_k_Grad) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE WD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WD_InputType), INTENT(IN) :: SrcInputData - TYPE(WD_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_CopyInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInputData%xhat_disk = SrcInputData%xhat_disk - DstInputData%YawErr = SrcInputData%YawErr - DstInputData%psi_skew = SrcInputData%psi_skew - DstInputData%chi_skew = SrcInputData%chi_skew - DstInputData%p_hub = SrcInputData%p_hub -IF (ALLOCATED(SrcInputData%V_plane)) THEN - i1_l = LBOUND(SrcInputData%V_plane,1) - i1_u = UBOUND(SrcInputData%V_plane,1) - i2_l = LBOUND(SrcInputData%V_plane,2) - i2_u = UBOUND(SrcInputData%V_plane,2) - IF (.NOT. ALLOCATED(DstInputData%V_plane)) THEN - ALLOCATE(DstInputData%V_plane(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%V_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%V_plane = SrcInputData%V_plane -ENDIF - DstInputData%Vx_wind_disk = SrcInputData%Vx_wind_disk - DstInputData%TI_amb = SrcInputData%TI_amb - DstInputData%D_rotor = SrcInputData%D_rotor - DstInputData%Vx_rel_disk = SrcInputData%Vx_rel_disk -IF (ALLOCATED(SrcInputData%Ct_azavg)) THEN - i1_l = LBOUND(SrcInputData%Ct_azavg,1) - i1_u = UBOUND(SrcInputData%Ct_azavg,1) - IF (.NOT. ALLOCATED(DstInputData%Ct_azavg)) THEN - ALLOCATE(DstInputData%Ct_azavg(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Ct_azavg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%Ct_azavg = SrcInputData%Ct_azavg -ENDIF -IF (ALLOCATED(SrcInputData%Cq_azavg)) THEN - i1_l = LBOUND(SrcInputData%Cq_azavg,1) - i1_u = UBOUND(SrcInputData%Cq_azavg,1) - IF (.NOT. ALLOCATED(DstInputData%Cq_azavg)) THEN - ALLOCATE(DstInputData%Cq_azavg(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Cq_azavg.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%Cq_azavg = SrcInputData%Cq_azavg -ENDIF - END SUBROUTINE WD_CopyInput - SUBROUTINE WD_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(WD_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InputData%V_plane)) THEN - DEALLOCATE(InputData%V_plane) -ENDIF -IF (ALLOCATED(InputData%Ct_azavg)) THEN - DEALLOCATE(InputData%Ct_azavg) -ENDIF -IF (ALLOCATED(InputData%Cq_azavg)) THEN - DEALLOCATE(InputData%Cq_azavg) -ENDIF - END SUBROUTINE WD_DestroyInput +subroutine WD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) + type(WD_InputType), intent(in) :: SrcInputData + type(WD_InputType), intent(inout) :: DstInputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'WD_CopyInput' + ErrStat = ErrID_None + ErrMsg = '' + DstInputData%xhat_disk = SrcInputData%xhat_disk + DstInputData%YawErr = SrcInputData%YawErr + DstInputData%psi_skew = SrcInputData%psi_skew + DstInputData%chi_skew = SrcInputData%chi_skew + DstInputData%p_hub = SrcInputData%p_hub + if (allocated(SrcInputData%V_plane)) then + LB(1:2) = lbound(SrcInputData%V_plane) + UB(1:2) = ubound(SrcInputData%V_plane) + if (.not. allocated(DstInputData%V_plane)) then + allocate(DstInputData%V_plane(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%V_plane.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%V_plane = SrcInputData%V_plane + else if (allocated(DstInputData%V_plane)) then + deallocate(DstInputData%V_plane) + end if + DstInputData%Vx_wind_disk = SrcInputData%Vx_wind_disk + DstInputData%TI_amb = SrcInputData%TI_amb + DstInputData%D_rotor = SrcInputData%D_rotor + DstInputData%Vx_rel_disk = SrcInputData%Vx_rel_disk + if (allocated(SrcInputData%Ct_azavg)) then + LB(1:1) = lbound(SrcInputData%Ct_azavg) + UB(1:1) = ubound(SrcInputData%Ct_azavg) + if (.not. allocated(DstInputData%Ct_azavg)) then + allocate(DstInputData%Ct_azavg(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Ct_azavg.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%Ct_azavg = SrcInputData%Ct_azavg + else if (allocated(DstInputData%Ct_azavg)) then + deallocate(DstInputData%Ct_azavg) + end if + if (allocated(SrcInputData%Cq_azavg)) then + LB(1:1) = lbound(SrcInputData%Cq_azavg) + UB(1:1) = ubound(SrcInputData%Cq_azavg) + if (.not. allocated(DstInputData%Cq_azavg)) then + allocate(DstInputData%Cq_azavg(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Cq_azavg.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%Cq_azavg = SrcInputData%Cq_azavg + else if (allocated(DstInputData%Cq_azavg)) then + deallocate(DstInputData%Cq_azavg) + end if +end subroutine +subroutine WD_DestroyInput(InputData, ErrStat, ErrMsg) + type(WD_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WD_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputData%V_plane)) then + deallocate(InputData%V_plane) + end if + if (allocated(InputData%Ct_azavg)) then + deallocate(InputData%Ct_azavg) + end if + if (allocated(InputData%Cq_azavg)) then + deallocate(InputData%Cq_azavg) + end if +end subroutine subroutine WD_PackInput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(WD_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'WD_PackInput' if (Buf%ErrStat >= AbortErrLev) return - ! xhat_disk call RegPack(Buf, InData%xhat_disk) if (RegCheckErr(Buf, RoutineName)) return - ! YawErr call RegPack(Buf, InData%YawErr) if (RegCheckErr(Buf, RoutineName)) return - ! psi_skew call RegPack(Buf, InData%psi_skew) if (RegCheckErr(Buf, RoutineName)) return - ! chi_skew call RegPack(Buf, InData%chi_skew) if (RegCheckErr(Buf, RoutineName)) return - ! p_hub call RegPack(Buf, InData%p_hub) if (RegCheckErr(Buf, RoutineName)) return - ! V_plane call RegPack(Buf, allocated(InData%V_plane)) if (allocated(InData%V_plane)) then call RegPackBounds(Buf, 2, lbound(InData%V_plane), ubound(InData%V_plane)) call RegPack(Buf, InData%V_plane) end if if (RegCheckErr(Buf, RoutineName)) return - ! Vx_wind_disk call RegPack(Buf, InData%Vx_wind_disk) if (RegCheckErr(Buf, RoutineName)) return - ! TI_amb call RegPack(Buf, InData%TI_amb) if (RegCheckErr(Buf, RoutineName)) return - ! D_rotor call RegPack(Buf, InData%D_rotor) if (RegCheckErr(Buf, RoutineName)) return - ! Vx_rel_disk call RegPack(Buf, InData%Vx_rel_disk) if (RegCheckErr(Buf, RoutineName)) return - ! Ct_azavg call RegPack(Buf, allocated(InData%Ct_azavg)) if (allocated(InData%Ct_azavg)) then call RegPackBounds(Buf, 1, lbound(InData%Ct_azavg), ubound(InData%Ct_azavg)) call RegPack(Buf, InData%Ct_azavg) end if if (RegCheckErr(Buf, RoutineName)) return - ! Cq_azavg call RegPack(Buf, allocated(InData%Cq_azavg)) if (allocated(InData%Cq_azavg)) then call RegPackBounds(Buf, 1, lbound(InData%Cq_azavg), ubound(InData%Cq_azavg)) @@ -2953,22 +2620,16 @@ subroutine WD_UnPackInput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! xhat_disk call RegUnpack(Buf, OutData%xhat_disk) if (RegCheckErr(Buf, RoutineName)) return - ! YawErr call RegUnpack(Buf, OutData%YawErr) if (RegCheckErr(Buf, RoutineName)) return - ! psi_skew call RegUnpack(Buf, OutData%psi_skew) if (RegCheckErr(Buf, RoutineName)) return - ! chi_skew call RegUnpack(Buf, OutData%chi_skew) if (RegCheckErr(Buf, RoutineName)) return - ! p_hub call RegUnpack(Buf, OutData%p_hub) if (RegCheckErr(Buf, RoutineName)) return - ! V_plane if (allocated(OutData%V_plane)) deallocate(OutData%V_plane) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -2983,19 +2644,14 @@ subroutine WD_UnPackInput(Buf, OutData) call RegUnpack(Buf, OutData%V_plane) if (RegCheckErr(Buf, RoutineName)) return end if - ! Vx_wind_disk call RegUnpack(Buf, OutData%Vx_wind_disk) if (RegCheckErr(Buf, RoutineName)) return - ! TI_amb call RegUnpack(Buf, OutData%TI_amb) if (RegCheckErr(Buf, RoutineName)) return - ! D_rotor call RegUnpack(Buf, OutData%D_rotor) if (RegCheckErr(Buf, RoutineName)) return - ! Vx_rel_disk call RegUnpack(Buf, OutData%Vx_rel_disk) if (RegCheckErr(Buf, RoutineName)) return - ! Ct_azavg if (allocated(OutData%Ct_azavg)) deallocate(OutData%Ct_azavg) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3010,7 +2666,6 @@ subroutine WD_UnPackInput(Buf, OutData) call RegUnpack(Buf, OutData%Ct_azavg) if (RegCheckErr(Buf, RoutineName)) return end if - ! Cq_azavg if (allocated(OutData%Cq_azavg)) deallocate(OutData%Cq_azavg) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3026,284 +2681,258 @@ subroutine WD_UnPackInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE WD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(WD_OutputType), INTENT(IN) :: SrcOutputData - TYPE(WD_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_CopyOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%xhat_plane)) THEN - i1_l = LBOUND(SrcOutputData%xhat_plane,1) - i1_u = UBOUND(SrcOutputData%xhat_plane,1) - i2_l = LBOUND(SrcOutputData%xhat_plane,2) - i2_u = UBOUND(SrcOutputData%xhat_plane,2) - IF (.NOT. ALLOCATED(DstOutputData%xhat_plane)) THEN - ALLOCATE(DstOutputData%xhat_plane(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%xhat_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%xhat_plane = SrcOutputData%xhat_plane -ENDIF -IF (ALLOCATED(SrcOutputData%p_plane)) THEN - i1_l = LBOUND(SrcOutputData%p_plane,1) - i1_u = UBOUND(SrcOutputData%p_plane,1) - i2_l = LBOUND(SrcOutputData%p_plane,2) - i2_u = UBOUND(SrcOutputData%p_plane,2) - IF (.NOT. ALLOCATED(DstOutputData%p_plane)) THEN - ALLOCATE(DstOutputData%p_plane(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%p_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%p_plane = SrcOutputData%p_plane -ENDIF -IF (ALLOCATED(SrcOutputData%Vx_wake)) THEN - i1_l = LBOUND(SrcOutputData%Vx_wake,1) - i1_u = UBOUND(SrcOutputData%Vx_wake,1) - i2_l = LBOUND(SrcOutputData%Vx_wake,2) - i2_u = UBOUND(SrcOutputData%Vx_wake,2) - IF (.NOT. ALLOCATED(DstOutputData%Vx_wake)) THEN - ALLOCATE(DstOutputData%Vx_wake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vx_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Vx_wake = SrcOutputData%Vx_wake -ENDIF -IF (ALLOCATED(SrcOutputData%Vr_wake)) THEN - i1_l = LBOUND(SrcOutputData%Vr_wake,1) - i1_u = UBOUND(SrcOutputData%Vr_wake,1) - i2_l = LBOUND(SrcOutputData%Vr_wake,2) - i2_u = UBOUND(SrcOutputData%Vr_wake,2) - IF (.NOT. ALLOCATED(DstOutputData%Vr_wake)) THEN - ALLOCATE(DstOutputData%Vr_wake(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vr_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Vr_wake = SrcOutputData%Vr_wake -ENDIF -IF (ALLOCATED(SrcOutputData%Vx_wake2)) THEN - i1_l = LBOUND(SrcOutputData%Vx_wake2,1) - i1_u = UBOUND(SrcOutputData%Vx_wake2,1) - i2_l = LBOUND(SrcOutputData%Vx_wake2,2) - i2_u = UBOUND(SrcOutputData%Vx_wake2,2) - i3_l = LBOUND(SrcOutputData%Vx_wake2,3) - i3_u = UBOUND(SrcOutputData%Vx_wake2,3) - IF (.NOT. ALLOCATED(DstOutputData%Vx_wake2)) THEN - ALLOCATE(DstOutputData%Vx_wake2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vx_wake2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Vx_wake2 = SrcOutputData%Vx_wake2 -ENDIF -IF (ALLOCATED(SrcOutputData%Vy_wake2)) THEN - i1_l = LBOUND(SrcOutputData%Vy_wake2,1) - i1_u = UBOUND(SrcOutputData%Vy_wake2,1) - i2_l = LBOUND(SrcOutputData%Vy_wake2,2) - i2_u = UBOUND(SrcOutputData%Vy_wake2,2) - i3_l = LBOUND(SrcOutputData%Vy_wake2,3) - i3_u = UBOUND(SrcOutputData%Vy_wake2,3) - IF (.NOT. ALLOCATED(DstOutputData%Vy_wake2)) THEN - ALLOCATE(DstOutputData%Vy_wake2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vy_wake2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Vy_wake2 = SrcOutputData%Vy_wake2 -ENDIF -IF (ALLOCATED(SrcOutputData%Vz_wake2)) THEN - i1_l = LBOUND(SrcOutputData%Vz_wake2,1) - i1_u = UBOUND(SrcOutputData%Vz_wake2,1) - i2_l = LBOUND(SrcOutputData%Vz_wake2,2) - i2_u = UBOUND(SrcOutputData%Vz_wake2,2) - i3_l = LBOUND(SrcOutputData%Vz_wake2,3) - i3_u = UBOUND(SrcOutputData%Vz_wake2,3) - IF (.NOT. ALLOCATED(DstOutputData%Vz_wake2)) THEN - ALLOCATE(DstOutputData%Vz_wake2(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vz_wake2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Vz_wake2 = SrcOutputData%Vz_wake2 -ENDIF -IF (ALLOCATED(SrcOutputData%D_wake)) THEN - i1_l = LBOUND(SrcOutputData%D_wake,1) - i1_u = UBOUND(SrcOutputData%D_wake,1) - IF (.NOT. ALLOCATED(DstOutputData%D_wake)) THEN - ALLOCATE(DstOutputData%D_wake(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%D_wake.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%D_wake = SrcOutputData%D_wake -ENDIF -IF (ALLOCATED(SrcOutputData%x_plane)) THEN - i1_l = LBOUND(SrcOutputData%x_plane,1) - i1_u = UBOUND(SrcOutputData%x_plane,1) - IF (.NOT. ALLOCATED(DstOutputData%x_plane)) THEN - ALLOCATE(DstOutputData%x_plane(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%x_plane.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%x_plane = SrcOutputData%x_plane -ENDIF -IF (ALLOCATED(SrcOutputData%WAT_k_mt)) THEN - i1_l = LBOUND(SrcOutputData%WAT_k_mt,1) - i1_u = UBOUND(SrcOutputData%WAT_k_mt,1) - i2_l = LBOUND(SrcOutputData%WAT_k_mt,2) - i2_u = UBOUND(SrcOutputData%WAT_k_mt,2) - i3_l = LBOUND(SrcOutputData%WAT_k_mt,3) - i3_u = UBOUND(SrcOutputData%WAT_k_mt,3) - IF (.NOT. ALLOCATED(DstOutputData%WAT_k_mt)) THEN - ALLOCATE(DstOutputData%WAT_k_mt(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WAT_k_mt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%WAT_k_mt = SrcOutputData%WAT_k_mt -ENDIF - END SUBROUTINE WD_CopyOutput - - SUBROUTINE WD_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(WD_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'WD_DestroyOutput' - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OutputData%xhat_plane)) THEN - DEALLOCATE(OutputData%xhat_plane) -ENDIF -IF (ALLOCATED(OutputData%p_plane)) THEN - DEALLOCATE(OutputData%p_plane) -ENDIF -IF (ALLOCATED(OutputData%Vx_wake)) THEN - DEALLOCATE(OutputData%Vx_wake) -ENDIF -IF (ALLOCATED(OutputData%Vr_wake)) THEN - DEALLOCATE(OutputData%Vr_wake) -ENDIF -IF (ALLOCATED(OutputData%Vx_wake2)) THEN - DEALLOCATE(OutputData%Vx_wake2) -ENDIF -IF (ALLOCATED(OutputData%Vy_wake2)) THEN - DEALLOCATE(OutputData%Vy_wake2) -ENDIF -IF (ALLOCATED(OutputData%Vz_wake2)) THEN - DEALLOCATE(OutputData%Vz_wake2) -ENDIF -IF (ALLOCATED(OutputData%D_wake)) THEN - DEALLOCATE(OutputData%D_wake) -ENDIF -IF (ALLOCATED(OutputData%x_plane)) THEN - DEALLOCATE(OutputData%x_plane) -ENDIF -IF (ALLOCATED(OutputData%WAT_k_mt)) THEN - DEALLOCATE(OutputData%WAT_k_mt) -ENDIF - END SUBROUTINE WD_DestroyOutput +subroutine WD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(WD_OutputType), intent(in) :: SrcOutputData + type(WD_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'WD_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%xhat_plane)) then + LB(1:2) = lbound(SrcOutputData%xhat_plane) + UB(1:2) = ubound(SrcOutputData%xhat_plane) + if (.not. allocated(DstOutputData%xhat_plane)) then + allocate(DstOutputData%xhat_plane(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%xhat_plane.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%xhat_plane = SrcOutputData%xhat_plane + else if (allocated(DstOutputData%xhat_plane)) then + deallocate(DstOutputData%xhat_plane) + end if + if (allocated(SrcOutputData%p_plane)) then + LB(1:2) = lbound(SrcOutputData%p_plane) + UB(1:2) = ubound(SrcOutputData%p_plane) + if (.not. allocated(DstOutputData%p_plane)) then + allocate(DstOutputData%p_plane(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%p_plane.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%p_plane = SrcOutputData%p_plane + else if (allocated(DstOutputData%p_plane)) then + deallocate(DstOutputData%p_plane) + end if + if (allocated(SrcOutputData%Vx_wake)) then + LB(1:2) = lbound(SrcOutputData%Vx_wake) + UB(1:2) = ubound(SrcOutputData%Vx_wake) + if (.not. allocated(DstOutputData%Vx_wake)) then + allocate(DstOutputData%Vx_wake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vx_wake.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Vx_wake = SrcOutputData%Vx_wake + else if (allocated(DstOutputData%Vx_wake)) then + deallocate(DstOutputData%Vx_wake) + end if + if (allocated(SrcOutputData%Vr_wake)) then + LB(1:2) = lbound(SrcOutputData%Vr_wake) + UB(1:2) = ubound(SrcOutputData%Vr_wake) + if (.not. allocated(DstOutputData%Vr_wake)) then + allocate(DstOutputData%Vr_wake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vr_wake.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Vr_wake = SrcOutputData%Vr_wake + else if (allocated(DstOutputData%Vr_wake)) then + deallocate(DstOutputData%Vr_wake) + end if + if (allocated(SrcOutputData%Vx_wake2)) then + LB(1:3) = lbound(SrcOutputData%Vx_wake2) + UB(1:3) = ubound(SrcOutputData%Vx_wake2) + if (.not. allocated(DstOutputData%Vx_wake2)) then + allocate(DstOutputData%Vx_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vx_wake2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Vx_wake2 = SrcOutputData%Vx_wake2 + else if (allocated(DstOutputData%Vx_wake2)) then + deallocate(DstOutputData%Vx_wake2) + end if + if (allocated(SrcOutputData%Vy_wake2)) then + LB(1:3) = lbound(SrcOutputData%Vy_wake2) + UB(1:3) = ubound(SrcOutputData%Vy_wake2) + if (.not. allocated(DstOutputData%Vy_wake2)) then + allocate(DstOutputData%Vy_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vy_wake2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Vy_wake2 = SrcOutputData%Vy_wake2 + else if (allocated(DstOutputData%Vy_wake2)) then + deallocate(DstOutputData%Vy_wake2) + end if + if (allocated(SrcOutputData%Vz_wake2)) then + LB(1:3) = lbound(SrcOutputData%Vz_wake2) + UB(1:3) = ubound(SrcOutputData%Vz_wake2) + if (.not. allocated(DstOutputData%Vz_wake2)) then + allocate(DstOutputData%Vz_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vz_wake2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%Vz_wake2 = SrcOutputData%Vz_wake2 + else if (allocated(DstOutputData%Vz_wake2)) then + deallocate(DstOutputData%Vz_wake2) + end if + if (allocated(SrcOutputData%D_wake)) then + LB(1:1) = lbound(SrcOutputData%D_wake) + UB(1:1) = ubound(SrcOutputData%D_wake) + if (.not. allocated(DstOutputData%D_wake)) then + allocate(DstOutputData%D_wake(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%D_wake.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%D_wake = SrcOutputData%D_wake + else if (allocated(DstOutputData%D_wake)) then + deallocate(DstOutputData%D_wake) + end if + if (allocated(SrcOutputData%x_plane)) then + LB(1:1) = lbound(SrcOutputData%x_plane) + UB(1:1) = ubound(SrcOutputData%x_plane) + if (.not. allocated(DstOutputData%x_plane)) then + allocate(DstOutputData%x_plane(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%x_plane.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%x_plane = SrcOutputData%x_plane + else if (allocated(DstOutputData%x_plane)) then + deallocate(DstOutputData%x_plane) + end if + if (allocated(SrcOutputData%WAT_k_mt)) then + LB(1:3) = lbound(SrcOutputData%WAT_k_mt) + UB(1:3) = ubound(SrcOutputData%WAT_k_mt) + if (.not. allocated(DstOutputData%WAT_k_mt)) then + allocate(DstOutputData%WAT_k_mt(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WAT_k_mt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%WAT_k_mt = SrcOutputData%WAT_k_mt + else if (allocated(DstOutputData%WAT_k_mt)) then + deallocate(DstOutputData%WAT_k_mt) + end if +end subroutine +subroutine WD_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(WD_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'WD_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%xhat_plane)) then + deallocate(OutputData%xhat_plane) + end if + if (allocated(OutputData%p_plane)) then + deallocate(OutputData%p_plane) + end if + if (allocated(OutputData%Vx_wake)) then + deallocate(OutputData%Vx_wake) + end if + if (allocated(OutputData%Vr_wake)) then + deallocate(OutputData%Vr_wake) + end if + if (allocated(OutputData%Vx_wake2)) then + deallocate(OutputData%Vx_wake2) + end if + if (allocated(OutputData%Vy_wake2)) then + deallocate(OutputData%Vy_wake2) + end if + if (allocated(OutputData%Vz_wake2)) then + deallocate(OutputData%Vz_wake2) + end if + if (allocated(OutputData%D_wake)) then + deallocate(OutputData%D_wake) + end if + if (allocated(OutputData%x_plane)) then + deallocate(OutputData%x_plane) + end if + if (allocated(OutputData%WAT_k_mt)) then + deallocate(OutputData%WAT_k_mt) + end if +end subroutine subroutine WD_PackOutput(Buf, Indata) type(PackBuffer), intent(inout) :: Buf type(WD_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'WD_PackOutput' if (Buf%ErrStat >= AbortErrLev) return - ! xhat_plane call RegPack(Buf, allocated(InData%xhat_plane)) if (allocated(InData%xhat_plane)) then call RegPackBounds(Buf, 2, lbound(InData%xhat_plane), ubound(InData%xhat_plane)) call RegPack(Buf, InData%xhat_plane) end if if (RegCheckErr(Buf, RoutineName)) return - ! p_plane call RegPack(Buf, allocated(InData%p_plane)) if (allocated(InData%p_plane)) then call RegPackBounds(Buf, 2, lbound(InData%p_plane), ubound(InData%p_plane)) call RegPack(Buf, InData%p_plane) end if if (RegCheckErr(Buf, RoutineName)) return - ! Vx_wake call RegPack(Buf, allocated(InData%Vx_wake)) if (allocated(InData%Vx_wake)) then call RegPackBounds(Buf, 2, lbound(InData%Vx_wake), ubound(InData%Vx_wake)) call RegPack(Buf, InData%Vx_wake) end if if (RegCheckErr(Buf, RoutineName)) return - ! Vr_wake call RegPack(Buf, allocated(InData%Vr_wake)) if (allocated(InData%Vr_wake)) then call RegPackBounds(Buf, 2, lbound(InData%Vr_wake), ubound(InData%Vr_wake)) call RegPack(Buf, InData%Vr_wake) end if if (RegCheckErr(Buf, RoutineName)) return - ! Vx_wake2 call RegPack(Buf, allocated(InData%Vx_wake2)) if (allocated(InData%Vx_wake2)) then call RegPackBounds(Buf, 3, lbound(InData%Vx_wake2), ubound(InData%Vx_wake2)) call RegPack(Buf, InData%Vx_wake2) end if if (RegCheckErr(Buf, RoutineName)) return - ! Vy_wake2 call RegPack(Buf, allocated(InData%Vy_wake2)) if (allocated(InData%Vy_wake2)) then call RegPackBounds(Buf, 3, lbound(InData%Vy_wake2), ubound(InData%Vy_wake2)) call RegPack(Buf, InData%Vy_wake2) end if if (RegCheckErr(Buf, RoutineName)) return - ! Vz_wake2 call RegPack(Buf, allocated(InData%Vz_wake2)) if (allocated(InData%Vz_wake2)) then call RegPackBounds(Buf, 3, lbound(InData%Vz_wake2), ubound(InData%Vz_wake2)) call RegPack(Buf, InData%Vz_wake2) end if if (RegCheckErr(Buf, RoutineName)) return - ! D_wake call RegPack(Buf, allocated(InData%D_wake)) if (allocated(InData%D_wake)) then call RegPackBounds(Buf, 1, lbound(InData%D_wake), ubound(InData%D_wake)) call RegPack(Buf, InData%D_wake) end if if (RegCheckErr(Buf, RoutineName)) return - ! x_plane call RegPack(Buf, allocated(InData%x_plane)) if (allocated(InData%x_plane)) then call RegPackBounds(Buf, 1, lbound(InData%x_plane), ubound(InData%x_plane)) call RegPack(Buf, InData%x_plane) end if if (RegCheckErr(Buf, RoutineName)) return - ! WAT_k_mt call RegPack(Buf, allocated(InData%WAT_k_mt)) if (allocated(InData%WAT_k_mt)) then call RegPackBounds(Buf, 3, lbound(InData%WAT_k_mt), ubound(InData%WAT_k_mt)) @@ -3320,7 +2949,6 @@ subroutine WD_UnPackOutput(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return - ! xhat_plane if (allocated(OutData%xhat_plane)) deallocate(OutData%xhat_plane) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3335,7 +2963,6 @@ subroutine WD_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%xhat_plane) if (RegCheckErr(Buf, RoutineName)) return end if - ! p_plane if (allocated(OutData%p_plane)) deallocate(OutData%p_plane) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3350,7 +2977,6 @@ subroutine WD_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%p_plane) if (RegCheckErr(Buf, RoutineName)) return end if - ! Vx_wake if (allocated(OutData%Vx_wake)) deallocate(OutData%Vx_wake) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3365,7 +2991,6 @@ subroutine WD_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%Vx_wake) if (RegCheckErr(Buf, RoutineName)) return end if - ! Vr_wake if (allocated(OutData%Vr_wake)) deallocate(OutData%Vr_wake) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3380,7 +3005,6 @@ subroutine WD_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%Vr_wake) if (RegCheckErr(Buf, RoutineName)) return end if - ! Vx_wake2 if (allocated(OutData%Vx_wake2)) deallocate(OutData%Vx_wake2) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3395,7 +3019,6 @@ subroutine WD_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%Vx_wake2) if (RegCheckErr(Buf, RoutineName)) return end if - ! Vy_wake2 if (allocated(OutData%Vy_wake2)) deallocate(OutData%Vy_wake2) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3410,7 +3033,6 @@ subroutine WD_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%Vy_wake2) if (RegCheckErr(Buf, RoutineName)) return end if - ! Vz_wake2 if (allocated(OutData%Vz_wake2)) deallocate(OutData%Vz_wake2) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3425,7 +3047,6 @@ subroutine WD_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%Vz_wake2) if (RegCheckErr(Buf, RoutineName)) return end if - ! D_wake if (allocated(OutData%D_wake)) deallocate(OutData%D_wake) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3440,7 +3061,6 @@ subroutine WD_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%D_wake) if (RegCheckErr(Buf, RoutineName)) return end if - ! x_plane if (allocated(OutData%x_plane)) deallocate(OutData%x_plane) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return @@ -3455,7 +3075,6 @@ subroutine WD_UnPackOutput(Buf, OutData) call RegUnpack(Buf, OutData%x_plane) if (RegCheckErr(Buf, RoutineName)) return end if - ! WAT_k_mt if (allocated(OutData%WAT_k_mt)) deallocate(OutData%WAT_k_mt) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return From 82e007933cd50d1271e7c8b71371f48da8bb0734 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 15 Jun 2023 03:02:57 +0000 Subject: [PATCH 05/15] Fixed missing array bounds in Registry Copy --- glue-codes/fast-farm/src/FAST_Farm_Types.f90 | 2 + modules/aerodyn/src/AeroDyn_Types.f90 | 2 + modules/aerodyn/src/BEMT_Types.f90 | 6 + modules/aerodyn/src/DBEMT_Types.f90 | 2 + modules/aerodyn/src/UnsteadyAero_Types.f90 | 2 + modules/elastodyn/src/ElastoDyn_Types.f90 | 2 + modules/hydrodyn/src/SS_Excitation_Types.f90 | 2 + modules/hydrodyn/src/SS_Radiation_Types.f90 | 2 + modules/openfast-library/src/FAST_Types.f90 | 114 ++++++++++++++++++ .../src/registry_gen_fortran.cpp | 7 ++ 10 files changed, 141 insertions(+) diff --git a/glue-codes/fast-farm/src/FAST_Farm_Types.f90 b/glue-codes/fast-farm/src/FAST_Farm_Types.f90 index c074c8c900..05c3b29e79 100644 --- a/glue-codes/fast-farm/src/FAST_Farm_Types.f90 +++ b/glue-codes/fast-farm/src/FAST_Farm_Types.f90 @@ -353,6 +353,8 @@ subroutine Farm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NumOuts = SrcParamData%NumOuts DstParamData%NOutSteps = SrcParamData%NOutSteps DstParamData%FileDescLines = SrcParamData%FileDescLines + LB(1:1) = lbound(SrcParamData%Module_Ver) + UB(1:1) = ubound(SrcParamData%Module_Ver) do i1 = LB(1), UB(1) call NWTC_Library_CopyProgDesc(SrcParamData%Module_Ver(i1), DstParamData%Module_Ver(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index fc2f0272c6..8be4544145 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -3849,6 +3849,8 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C call BEMT_CopyOutput(SrcRotMiscVarTypeData%BEMT_y, DstRotMiscVarTypeData%BEMT_y, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return + LB(1:1) = lbound(SrcRotMiscVarTypeData%BEMT_u) + UB(1:1) = ubound(SrcRotMiscVarTypeData%BEMT_u) do i1 = LB(1), UB(1) call BEMT_CopyInput(SrcRotMiscVarTypeData%BEMT_u(i1), DstRotMiscVarTypeData%BEMT_u(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) diff --git a/modules/aerodyn/src/BEMT_Types.f90 b/modules/aerodyn/src/BEMT_Types.f90 index 79eeb10ecc..969689d393 100644 --- a/modules/aerodyn/src/BEMT_Types.f90 +++ b/modules/aerodyn/src/BEMT_Types.f90 @@ -1023,6 +1023,8 @@ subroutine BEMT_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E deallocate(DstOtherStateData%ValidPhi) end if DstOtherStateData%nodesInitialized = SrcOtherStateData%nodesInitialized + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) do i1 = LB(1), UB(1) call BEMT_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1159,11 +1161,15 @@ subroutine BEMT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) else if (allocated(DstMiscData%u_UA)) then deallocate(DstMiscData%u_UA) end if + LB(1:1) = lbound(SrcMiscData%u_DBEMT) + UB(1:1) = ubound(SrcMiscData%u_DBEMT) do i1 = LB(1), UB(1) call DBEMT_CopyInput(SrcMiscData%u_DBEMT(i1), DstMiscData%u_DBEMT(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + LB(1:1) = lbound(SrcMiscData%u_SkewWake) + UB(1:1) = ubound(SrcMiscData%u_SkewWake) do i1 = LB(1), UB(1) call BEMT_CopySkewWake_InputType(SrcMiscData%u_SkewWake(i1), DstMiscData%u_SkewWake(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) diff --git a/modules/aerodyn/src/DBEMT_Types.f90 b/modules/aerodyn/src/DBEMT_Types.f90 index 9d80c412e8..bb5b85537e 100644 --- a/modules/aerodyn/src/DBEMT_Types.f90 +++ b/modules/aerodyn/src/DBEMT_Types.f90 @@ -532,6 +532,8 @@ subroutine DBEMT_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, else if (allocated(DstOtherStateData%n)) then deallocate(DstOtherStateData%n) end if + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) do i1 = LB(1), UB(1) call DBEMT_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) diff --git a/modules/aerodyn/src/UnsteadyAero_Types.f90 b/modules/aerodyn/src/UnsteadyAero_Types.f90 index 0ab310951d..686ea41348 100644 --- a/modules/aerodyn/src/UnsteadyAero_Types.f90 +++ b/modules/aerodyn/src/UnsteadyAero_Types.f90 @@ -2431,6 +2431,8 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err else if (allocated(DstOtherStateData%n)) then deallocate(DstOtherStateData%n) end if + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) do i1 = LB(1), UB(1) call UA_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) diff --git a/modules/elastodyn/src/ElastoDyn_Types.f90 b/modules/elastodyn/src/ElastoDyn_Types.f90 index 017236a87d..43214089e1 100644 --- a/modules/elastodyn/src/ElastoDyn_Types.f90 +++ b/modules/elastodyn/src/ElastoDyn_Types.f90 @@ -8039,6 +8039,8 @@ subroutine ED_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err ErrStat = ErrID_None ErrMsg = '' DstOtherStateData%n = SrcOtherStateData%n + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) do i1 = LB(1), UB(1) call ED_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) diff --git a/modules/hydrodyn/src/SS_Excitation_Types.f90 b/modules/hydrodyn/src/SS_Excitation_Types.f90 index 1df2409362..6d40b870bc 100644 --- a/modules/hydrodyn/src/SS_Excitation_Types.f90 +++ b/modules/hydrodyn/src/SS_Excitation_Types.f90 @@ -611,6 +611,8 @@ subroutine SS_Exc_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat = ErrID_None ErrMsg = '' DstOtherStateData%n = SrcOtherStateData%n + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) do i1 = LB(1), UB(1) call SS_Exc_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) diff --git a/modules/hydrodyn/src/SS_Radiation_Types.f90 b/modules/hydrodyn/src/SS_Radiation_Types.f90 index ff99861351..f9a29e9059 100644 --- a/modules/hydrodyn/src/SS_Radiation_Types.f90 +++ b/modules/hydrodyn/src/SS_Radiation_Types.f90 @@ -501,6 +501,8 @@ subroutine SS_Rad_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat = ErrID_None ErrMsg = '' DstOtherStateData%n = SrcOtherStateData%n + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) do i1 = LB(1), UB(1) call SS_Rad_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index 8e72735bcf..f1c4e1294a 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -6622,6 +6622,8 @@ subroutine FAST_CopyLinFileType(SrcLinFileTypeData, DstLinFileTypeData, CtrlCode character(*), parameter :: RoutineName = 'FAST_CopyLinFileType' ErrStat = ErrID_None ErrMsg = '' + LB(1:1) = lbound(SrcLinFileTypeData%Modules) + UB(1:1) = ubound(SrcLinFileTypeData%Modules) do i1 = LB(1), UB(1) call FAST_CopyModLinType(SrcLinFileTypeData%Modules(i1), DstLinFileTypeData%Modules(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -7064,6 +7066,8 @@ subroutine FAST_CopyOutputFileType(SrcOutputFileTypeData, DstOutputFileTypeData, else if (allocated(DstOutputFileTypeData%ChannelUnits)) then deallocate(DstOutputFileTypeData%ChannelUnits) end if + LB(1:1) = lbound(SrcOutputFileTypeData%Module_Ver) + UB(1:1) = ubound(SrcOutputFileTypeData%Module_Ver) do i1 = LB(1), UB(1) call NWTC_Library_CopyProgDesc(SrcOutputFileTypeData%Module_Ver(i1), DstOutputFileTypeData%Module_Ver(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -8588,21 +8592,29 @@ subroutine FAST_CopyElastoDyn_Data(SrcElastoDyn_DataData, DstElastoDyn_DataData, character(*), parameter :: RoutineName = 'FAST_CopyElastoDyn_Data' ErrStat = ErrID_None ErrMsg = '' + LB(1:1) = lbound(SrcElastoDyn_DataData%x) + UB(1:1) = ubound(SrcElastoDyn_DataData%x) do i1 = LB(1), UB(1) call ED_CopyContState(SrcElastoDyn_DataData%x(i1), DstElastoDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + LB(1:1) = lbound(SrcElastoDyn_DataData%xd) + UB(1:1) = ubound(SrcElastoDyn_DataData%xd) do i1 = LB(1), UB(1) call ED_CopyDiscState(SrcElastoDyn_DataData%xd(i1), DstElastoDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + LB(1:1) = lbound(SrcElastoDyn_DataData%z) + UB(1:1) = ubound(SrcElastoDyn_DataData%z) do i1 = LB(1), UB(1) call ED_CopyConstrState(SrcElastoDyn_DataData%z(i1), DstElastoDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + LB(1:1) = lbound(SrcElastoDyn_DataData%OtherSt) + UB(1:1) = ubound(SrcElastoDyn_DataData%OtherSt) do i1 = LB(1), UB(1) call ED_CopyOtherState(SrcElastoDyn_DataData%OtherSt(i1), DstElastoDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -8871,21 +8883,29 @@ subroutine FAST_CopyServoDyn_Data(SrcServoDyn_DataData, DstServoDyn_DataData, Ct character(*), parameter :: RoutineName = 'FAST_CopyServoDyn_Data' ErrStat = ErrID_None ErrMsg = '' + LB(1:1) = lbound(SrcServoDyn_DataData%x) + UB(1:1) = ubound(SrcServoDyn_DataData%x) do i1 = LB(1), UB(1) call SrvD_CopyContState(SrcServoDyn_DataData%x(i1), DstServoDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + LB(1:1) = lbound(SrcServoDyn_DataData%xd) + UB(1:1) = ubound(SrcServoDyn_DataData%xd) do i1 = LB(1), UB(1) call SrvD_CopyDiscState(SrcServoDyn_DataData%xd(i1), DstServoDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + LB(1:1) = lbound(SrcServoDyn_DataData%z) + UB(1:1) = ubound(SrcServoDyn_DataData%z) do i1 = LB(1), UB(1) call SrvD_CopyConstrState(SrcServoDyn_DataData%z(i1), DstServoDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + LB(1:1) = lbound(SrcServoDyn_DataData%OtherSt) + UB(1:1) = ubound(SrcServoDyn_DataData%OtherSt) do i1 = LB(1), UB(1) call SrvD_CopyOtherState(SrcServoDyn_DataData%OtherSt(i1), DstServoDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -9154,21 +9174,29 @@ subroutine FAST_CopyAeroDyn14_Data(SrcAeroDyn14_DataData, DstAeroDyn14_DataData, character(*), parameter :: RoutineName = 'FAST_CopyAeroDyn14_Data' ErrStat = ErrID_None ErrMsg = '' + LB(1:1) = lbound(SrcAeroDyn14_DataData%x) + UB(1:1) = ubound(SrcAeroDyn14_DataData%x) do i1 = LB(1), UB(1) call AD14_CopyContState(SrcAeroDyn14_DataData%x(i1), DstAeroDyn14_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + LB(1:1) = lbound(SrcAeroDyn14_DataData%xd) + UB(1:1) = ubound(SrcAeroDyn14_DataData%xd) do i1 = LB(1), UB(1) call AD14_CopyDiscState(SrcAeroDyn14_DataData%xd(i1), DstAeroDyn14_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + LB(1:1) = lbound(SrcAeroDyn14_DataData%z) + UB(1:1) = ubound(SrcAeroDyn14_DataData%z) do i1 = LB(1), UB(1) call AD14_CopyConstrState(SrcAeroDyn14_DataData%z(i1), DstAeroDyn14_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + LB(1:1) = lbound(SrcAeroDyn14_DataData%OtherSt) + UB(1:1) = ubound(SrcAeroDyn14_DataData%OtherSt) do i1 = LB(1), UB(1) call AD14_CopyOtherState(SrcAeroDyn14_DataData%OtherSt(i1), DstAeroDyn14_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -9379,21 +9407,29 @@ subroutine FAST_CopyAeroDyn_Data(SrcAeroDyn_DataData, DstAeroDyn_DataData, CtrlC character(*), parameter :: RoutineName = 'FAST_CopyAeroDyn_Data' ErrStat = ErrID_None ErrMsg = '' + LB(1:1) = lbound(SrcAeroDyn_DataData%x) + UB(1:1) = ubound(SrcAeroDyn_DataData%x) do i1 = LB(1), UB(1) call AD_CopyContState(SrcAeroDyn_DataData%x(i1), DstAeroDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + LB(1:1) = lbound(SrcAeroDyn_DataData%xd) + UB(1:1) = ubound(SrcAeroDyn_DataData%xd) do i1 = LB(1), UB(1) call AD_CopyDiscState(SrcAeroDyn_DataData%xd(i1), DstAeroDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + LB(1:1) = lbound(SrcAeroDyn_DataData%z) + UB(1:1) = ubound(SrcAeroDyn_DataData%z) do i1 = LB(1), UB(1) call AD_CopyConstrState(SrcAeroDyn_DataData%z(i1), DstAeroDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + LB(1:1) = lbound(SrcAeroDyn_DataData%OtherSt) + UB(1:1) = ubound(SrcAeroDyn_DataData%OtherSt) do i1 = LB(1), UB(1) call AD_CopyOtherState(SrcAeroDyn_DataData%OtherSt(i1), DstAeroDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -9662,21 +9698,29 @@ subroutine FAST_CopyInflowWind_Data(SrcInflowWind_DataData, DstInflowWind_DataDa character(*), parameter :: RoutineName = 'FAST_CopyInflowWind_Data' ErrStat = ErrID_None ErrMsg = '' + LB(1:1) = lbound(SrcInflowWind_DataData%x) + UB(1:1) = ubound(SrcInflowWind_DataData%x) do i1 = LB(1), UB(1) call InflowWind_CopyContState(SrcInflowWind_DataData%x(i1), DstInflowWind_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + LB(1:1) = lbound(SrcInflowWind_DataData%xd) + UB(1:1) = ubound(SrcInflowWind_DataData%xd) do i1 = LB(1), UB(1) call InflowWind_CopyDiscState(SrcInflowWind_DataData%xd(i1), DstInflowWind_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + LB(1:1) = lbound(SrcInflowWind_DataData%z) + UB(1:1) = ubound(SrcInflowWind_DataData%z) do i1 = LB(1), UB(1) call InflowWind_CopyConstrState(SrcInflowWind_DataData%z(i1), DstInflowWind_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + LB(1:1) = lbound(SrcInflowWind_DataData%OtherSt) + UB(1:1) = ubound(SrcInflowWind_DataData%OtherSt) do i1 = LB(1), UB(1) call InflowWind_CopyOtherState(SrcInflowWind_DataData%OtherSt(i1), DstInflowWind_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -10063,21 +10107,29 @@ subroutine FAST_CopySubDyn_Data(SrcSubDyn_DataData, DstSubDyn_DataData, CtrlCode character(*), parameter :: RoutineName = 'FAST_CopySubDyn_Data' ErrStat = ErrID_None ErrMsg = '' + LB(1:1) = lbound(SrcSubDyn_DataData%x) + UB(1:1) = ubound(SrcSubDyn_DataData%x) do i1 = LB(1), UB(1) call SD_CopyContState(SrcSubDyn_DataData%x(i1), DstSubDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + LB(1:1) = lbound(SrcSubDyn_DataData%xd) + UB(1:1) = ubound(SrcSubDyn_DataData%xd) do i1 = LB(1), UB(1) call SD_CopyDiscState(SrcSubDyn_DataData%xd(i1), DstSubDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + LB(1:1) = lbound(SrcSubDyn_DataData%z) + UB(1:1) = ubound(SrcSubDyn_DataData%z) do i1 = LB(1), UB(1) call SD_CopyConstrState(SrcSubDyn_DataData%z(i1), DstSubDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + LB(1:1) = lbound(SrcSubDyn_DataData%OtherSt) + UB(1:1) = ubound(SrcSubDyn_DataData%OtherSt) do i1 = LB(1), UB(1) call SD_CopyOtherState(SrcSubDyn_DataData%OtherSt(i1), DstSubDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -10346,21 +10398,29 @@ subroutine FAST_CopyExtPtfm_Data(SrcExtPtfm_DataData, DstExtPtfm_DataData, CtrlC character(*), parameter :: RoutineName = 'FAST_CopyExtPtfm_Data' ErrStat = ErrID_None ErrMsg = '' + LB(1:1) = lbound(SrcExtPtfm_DataData%x) + UB(1:1) = ubound(SrcExtPtfm_DataData%x) do i1 = LB(1), UB(1) call ExtPtfm_CopyContState(SrcExtPtfm_DataData%x(i1), DstExtPtfm_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + LB(1:1) = lbound(SrcExtPtfm_DataData%xd) + UB(1:1) = ubound(SrcExtPtfm_DataData%xd) do i1 = LB(1), UB(1) call ExtPtfm_CopyDiscState(SrcExtPtfm_DataData%xd(i1), DstExtPtfm_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + LB(1:1) = lbound(SrcExtPtfm_DataData%z) + UB(1:1) = ubound(SrcExtPtfm_DataData%z) do i1 = LB(1), UB(1) call ExtPtfm_CopyConstrState(SrcExtPtfm_DataData%z(i1), DstExtPtfm_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + LB(1:1) = lbound(SrcExtPtfm_DataData%OtherSt) + UB(1:1) = ubound(SrcExtPtfm_DataData%OtherSt) do i1 = LB(1), UB(1) call ExtPtfm_CopyOtherState(SrcExtPtfm_DataData%OtherSt(i1), DstExtPtfm_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -10571,21 +10631,29 @@ subroutine FAST_CopySeaState_Data(SrcSeaState_DataData, DstSeaState_DataData, Ct character(*), parameter :: RoutineName = 'FAST_CopySeaState_Data' ErrStat = ErrID_None ErrMsg = '' + LB(1:1) = lbound(SrcSeaState_DataData%x) + UB(1:1) = ubound(SrcSeaState_DataData%x) do i1 = LB(1), UB(1) call SeaSt_CopyContState(SrcSeaState_DataData%x(i1), DstSeaState_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + LB(1:1) = lbound(SrcSeaState_DataData%xd) + UB(1:1) = ubound(SrcSeaState_DataData%xd) do i1 = LB(1), UB(1) call SeaSt_CopyDiscState(SrcSeaState_DataData%xd(i1), DstSeaState_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + LB(1:1) = lbound(SrcSeaState_DataData%z) + UB(1:1) = ubound(SrcSeaState_DataData%z) do i1 = LB(1), UB(1) call SeaSt_CopyConstrState(SrcSeaState_DataData%z(i1), DstSeaState_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + LB(1:1) = lbound(SrcSeaState_DataData%OtherSt) + UB(1:1) = ubound(SrcSeaState_DataData%OtherSt) do i1 = LB(1), UB(1) call SeaSt_CopyOtherState(SrcSeaState_DataData%OtherSt(i1), DstSeaState_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -10854,21 +10922,29 @@ subroutine FAST_CopyHydroDyn_Data(SrcHydroDyn_DataData, DstHydroDyn_DataData, Ct character(*), parameter :: RoutineName = 'FAST_CopyHydroDyn_Data' ErrStat = ErrID_None ErrMsg = '' + LB(1:1) = lbound(SrcHydroDyn_DataData%x) + UB(1:1) = ubound(SrcHydroDyn_DataData%x) do i1 = LB(1), UB(1) call HydroDyn_CopyContState(SrcHydroDyn_DataData%x(i1), DstHydroDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + LB(1:1) = lbound(SrcHydroDyn_DataData%xd) + UB(1:1) = ubound(SrcHydroDyn_DataData%xd) do i1 = LB(1), UB(1) call HydroDyn_CopyDiscState(SrcHydroDyn_DataData%xd(i1), DstHydroDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + LB(1:1) = lbound(SrcHydroDyn_DataData%z) + UB(1:1) = ubound(SrcHydroDyn_DataData%z) do i1 = LB(1), UB(1) call HydroDyn_CopyConstrState(SrcHydroDyn_DataData%z(i1), DstHydroDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + LB(1:1) = lbound(SrcHydroDyn_DataData%OtherSt) + UB(1:1) = ubound(SrcHydroDyn_DataData%OtherSt) do i1 = LB(1), UB(1) call HydroDyn_CopyOtherState(SrcHydroDyn_DataData%OtherSt(i1), DstHydroDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -11137,21 +11213,29 @@ subroutine FAST_CopyIceFloe_Data(SrcIceFloe_DataData, DstIceFloe_DataData, CtrlC character(*), parameter :: RoutineName = 'FAST_CopyIceFloe_Data' ErrStat = ErrID_None ErrMsg = '' + LB(1:1) = lbound(SrcIceFloe_DataData%x) + UB(1:1) = ubound(SrcIceFloe_DataData%x) do i1 = LB(1), UB(1) call IceFloe_CopyContState(SrcIceFloe_DataData%x(i1), DstIceFloe_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + LB(1:1) = lbound(SrcIceFloe_DataData%xd) + UB(1:1) = ubound(SrcIceFloe_DataData%xd) do i1 = LB(1), UB(1) call IceFloe_CopyDiscState(SrcIceFloe_DataData%xd(i1), DstIceFloe_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + LB(1:1) = lbound(SrcIceFloe_DataData%z) + UB(1:1) = ubound(SrcIceFloe_DataData%z) do i1 = LB(1), UB(1) call IceFloe_CopyConstrState(SrcIceFloe_DataData%z(i1), DstIceFloe_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + LB(1:1) = lbound(SrcIceFloe_DataData%OtherSt) + UB(1:1) = ubound(SrcIceFloe_DataData%OtherSt) do i1 = LB(1), UB(1) call IceFloe_CopyOtherState(SrcIceFloe_DataData%OtherSt(i1), DstIceFloe_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -11362,16 +11446,22 @@ subroutine FAST_CopyMAP_Data(SrcMAP_DataData, DstMAP_DataData, CtrlCode, ErrStat character(*), parameter :: RoutineName = 'FAST_CopyMAP_Data' ErrStat = ErrID_None ErrMsg = '' + LB(1:1) = lbound(SrcMAP_DataData%x) + UB(1:1) = ubound(SrcMAP_DataData%x) do i1 = LB(1), UB(1) call MAP_CopyContState(SrcMAP_DataData%x(i1), DstMAP_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + LB(1:1) = lbound(SrcMAP_DataData%xd) + UB(1:1) = ubound(SrcMAP_DataData%xd) do i1 = LB(1), UB(1) call MAP_CopyDiscState(SrcMAP_DataData%xd(i1), DstMAP_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + LB(1:1) = lbound(SrcMAP_DataData%z) + UB(1:1) = ubound(SrcMAP_DataData%z) do i1 = LB(1), UB(1) call MAP_CopyConstrState(SrcMAP_DataData%z(i1), DstMAP_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -11635,21 +11725,29 @@ subroutine FAST_CopyFEAMooring_Data(SrcFEAMooring_DataData, DstFEAMooring_DataDa character(*), parameter :: RoutineName = 'FAST_CopyFEAMooring_Data' ErrStat = ErrID_None ErrMsg = '' + LB(1:1) = lbound(SrcFEAMooring_DataData%x) + UB(1:1) = ubound(SrcFEAMooring_DataData%x) do i1 = LB(1), UB(1) call FEAM_CopyContState(SrcFEAMooring_DataData%x(i1), DstFEAMooring_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + LB(1:1) = lbound(SrcFEAMooring_DataData%xd) + UB(1:1) = ubound(SrcFEAMooring_DataData%xd) do i1 = LB(1), UB(1) call FEAM_CopyDiscState(SrcFEAMooring_DataData%xd(i1), DstFEAMooring_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + LB(1:1) = lbound(SrcFEAMooring_DataData%z) + UB(1:1) = ubound(SrcFEAMooring_DataData%z) do i1 = LB(1), UB(1) call FEAM_CopyConstrState(SrcFEAMooring_DataData%z(i1), DstFEAMooring_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + LB(1:1) = lbound(SrcFEAMooring_DataData%OtherSt) + UB(1:1) = ubound(SrcFEAMooring_DataData%OtherSt) do i1 = LB(1), UB(1) call FEAM_CopyOtherState(SrcFEAMooring_DataData%OtherSt(i1), DstFEAMooring_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -11860,21 +11958,29 @@ subroutine FAST_CopyMoorDyn_Data(SrcMoorDyn_DataData, DstMoorDyn_DataData, CtrlC character(*), parameter :: RoutineName = 'FAST_CopyMoorDyn_Data' ErrStat = ErrID_None ErrMsg = '' + LB(1:1) = lbound(SrcMoorDyn_DataData%x) + UB(1:1) = ubound(SrcMoorDyn_DataData%x) do i1 = LB(1), UB(1) call MD_CopyContState(SrcMoorDyn_DataData%x(i1), DstMoorDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + LB(1:1) = lbound(SrcMoorDyn_DataData%xd) + UB(1:1) = ubound(SrcMoorDyn_DataData%xd) do i1 = LB(1), UB(1) call MD_CopyDiscState(SrcMoorDyn_DataData%xd(i1), DstMoorDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + LB(1:1) = lbound(SrcMoorDyn_DataData%z) + UB(1:1) = ubound(SrcMoorDyn_DataData%z) do i1 = LB(1), UB(1) call MD_CopyConstrState(SrcMoorDyn_DataData%z(i1), DstMoorDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + LB(1:1) = lbound(SrcMoorDyn_DataData%OtherSt) + UB(1:1) = ubound(SrcMoorDyn_DataData%OtherSt) do i1 = LB(1), UB(1) call MD_CopyOtherState(SrcMoorDyn_DataData%OtherSt(i1), DstMoorDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -12143,21 +12249,29 @@ subroutine FAST_CopyOrcaFlex_Data(SrcOrcaFlex_DataData, DstOrcaFlex_DataData, Ct character(*), parameter :: RoutineName = 'FAST_CopyOrcaFlex_Data' ErrStat = ErrID_None ErrMsg = '' + LB(1:1) = lbound(SrcOrcaFlex_DataData%x) + UB(1:1) = ubound(SrcOrcaFlex_DataData%x) do i1 = LB(1), UB(1) call Orca_CopyContState(SrcOrcaFlex_DataData%x(i1), DstOrcaFlex_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + LB(1:1) = lbound(SrcOrcaFlex_DataData%xd) + UB(1:1) = ubound(SrcOrcaFlex_DataData%xd) do i1 = LB(1), UB(1) call Orca_CopyDiscState(SrcOrcaFlex_DataData%xd(i1), DstOrcaFlex_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + LB(1:1) = lbound(SrcOrcaFlex_DataData%z) + UB(1:1) = ubound(SrcOrcaFlex_DataData%z) do i1 = LB(1), UB(1) call Orca_CopyConstrState(SrcOrcaFlex_DataData%z(i1), DstOrcaFlex_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do + LB(1:1) = lbound(SrcOrcaFlex_DataData%OtherSt) + UB(1:1) = ubound(SrcOrcaFlex_DataData%OtherSt) do i1 = LB(1), UB(1) call Orca_CopyOtherState(SrcOrcaFlex_DataData%OtherSt(i1), DstOrcaFlex_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) diff --git a/modules/openfast-registry/src/registry_gen_fortran.cpp b/modules/openfast-registry/src/registry_gen_fortran.cpp index 8c6e91e5ec..1428cd4a9d 100644 --- a/modules/openfast-registry/src/registry_gen_fortran.cpp +++ b/modules/openfast-registry/src/registry_gen_fortran.cpp @@ -380,6 +380,13 @@ void gen_copy(std::ostream &w, const Module &mod, const DataType::Derived &ddt, { auto &ddt = field.data_type->derived; + // Get bounds for non-allocated field + if (field.rank > 0 && !field.is_allocatable) + { + w << indent << "LB(1:" << field.rank << ") = lbound(" << src << ")"; + w << indent << "UB(1:" << field.rank << ") = ubound(" << src << ")"; + } + for (int d = field.rank; d >= 1; d--) { w << indent << "do i" << d << " = LB(" << d << "), UB(" << d << ")"; From 665e27357c9b835b349d690142489c675af27c58 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 15 Jun 2023 12:17:39 +0000 Subject: [PATCH 06/15] Minor Registry cleanup --- .../fast-farm/src/FASTWrapper_Types.f90 | 41 - glue-codes/fast-farm/src/FAST_Farm_Types.f90 | 105 --- modules/aerodyn/src/AeroAcoustics_Types.f90 | 183 ----- modules/aerodyn/src/AeroDyn_Driver_Types.f90 | 112 --- modules/aerodyn/src/AeroDyn_Inflow_Types.f90 | 64 -- modules/aerodyn/src/AeroDyn_Types.f90 | 286 ------- modules/aerodyn/src/AirfoilInfo_Types.f90 | 122 --- modules/aerodyn/src/BEMT_Types.f90 | 124 ---- modules/aerodyn/src/DBEMT_Types.f90 | 20 - modules/aerodyn/src/FVW_Types.f90 | 207 ------ modules/aerodyn/src/UnsteadyAero_Types.f90 | 142 ---- modules/aerodyn14/src/AeroDyn14_Types.f90 | 280 ------- modules/aerodyn14/src/DWM_Types.f90 | 171 ----- modules/awae/src/AWAE_Types.f90 | 141 +--- modules/beamdyn/src/BeamDyn_Types.f90 | 224 ------ modules/elastodyn/src/ElastoDyn_Types.f90 | 699 ------------------ modules/extptfm/src/ExtPtfm_MCKF_Types.f90 | 66 -- modules/feamooring/src/FEAMooring_Types.f90 | 135 ---- modules/hydrodyn/src/Conv_Radiation_Types.f90 | 15 - modules/hydrodyn/src/HydroDyn_Types.f90 | 131 ---- modules/hydrodyn/src/Morison_Types.f90 | 285 ------- modules/hydrodyn/src/SS_Excitation_Types.f90 | 26 - modules/hydrodyn/src/SS_Radiation_Types.f90 | 12 - modules/hydrodyn/src/WAMIT2_Types.f90 | 48 -- modules/hydrodyn/src/WAMIT_Types.f90 | 75 -- modules/icedyn/src/IceDyn_Types.f90 | 136 ---- modules/icefloe/src/icefloe/IceFloe_Types.f90 | 25 - .../inflowwind/src/IfW_FlowField_Types.f90 | 91 --- .../inflowwind/src/InflowWind_IO_Types.f90 | 51 -- modules/inflowwind/src/InflowWind_Types.f90 | 99 +-- modules/inflowwind/src/Lidar_Types.f90 | 36 - modules/map/src/MAP_Fortran_Types.f90 | 4 - modules/map/src/MAP_Types.f90 | 77 +- modules/moordyn/src/MoorDyn_Types.f90 | 333 --------- .../nwtc-library/src/NWTC_Library_Types.f90 | 21 - modules/openfast-library/src/FAST_Types.f90 | 563 -------------- .../src/registry_gen_fortran.cpp | 11 +- modules/openfoam/src/OpenFOAM_Types.f90 | 67 +- .../src/OrcaFlexInterface_Types.f90 | 18 - modules/seastate/src/Current_Types.f90 | 15 - .../seastate/src/SeaSt_WaveField_Types.f90 | 18 - .../seastate/src/SeaState_Interp_Types.f90 | 10 - modules/seastate/src/SeaState_Types.f90 | 127 +--- modules/seastate/src/Waves2_Types.f90 | 29 - modules/seastate/src/Waves_Types.f90 | 66 -- modules/servodyn/src/ServoDyn_Types.f90 | 477 ------------ modules/servodyn/src/StrucCtrl_Types.f90 | 155 ---- modules/subdyn/src/SubDyn_Types.f90 | 233 ------ .../supercontroller/src/SCDataEx_Types.f90 | 6 +- .../src/SuperController_Types.f90 | 28 +- .../wakedynamics/src/WakeDynamics_Types.f90 | 133 ---- 51 files changed, 73 insertions(+), 6470 deletions(-) diff --git a/glue-codes/fast-farm/src/FASTWrapper_Types.f90 b/glue-codes/fast-farm/src/FASTWrapper_Types.f90 index e81c7c5212..eab26277e6 100644 --- a/glue-codes/fast-farm/src/FASTWrapper_Types.f90 +++ b/glue-codes/fast-farm/src/FASTWrapper_Types.f90 @@ -213,59 +213,36 @@ subroutine FWrap_PackInitInput(Buf, Indata) logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%nr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FASTInFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%tmax) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%p_ref_Turbine) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveFieldMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%n_high_low) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dt_high) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%p_ref_high) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nX_high) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nY_high) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nZ_high) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dX_high) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dY_high) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dZ_high) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TurbNum) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RootName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumSC2Ctrl) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumSC2CtrlGlob) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumCtrl2SC) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UseSC) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%fromSCGlob)) if (allocated(InData%fromSCGlob)) then call RegPackBounds(Buf, 1, lbound(InData%fromSCGlob), ubound(InData%fromSCGlob)) call RegPack(Buf, InData%fromSCGlob) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%fromSC)) if (allocated(InData%fromSC)) then call RegPackBounds(Buf, 1, lbound(InData%fromSC), ubound(InData%fromSC)) call RegPack(Buf, InData%fromSC) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%Vdist_High)) if (associated(InData%Vdist_High)) then call RegPackBounds(Buf, 5, lbound(InData%Vdist_High), ubound(InData%Vdist_High)) @@ -417,7 +394,6 @@ subroutine FWrap_PackInitOutput(Buf, Indata) character(*), parameter :: RoutineName = 'FWrap_PackInitOutput' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%PtfmInit) - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackProgDesc(Buf, InData%Ver) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -735,7 +711,6 @@ subroutine FWrap_PackMisc(Buf, Indata) integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call FAST_PackTurbineType(Buf, InData%Turbine) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TempDisp)) if (allocated(InData%TempDisp)) then call RegPackBounds(Buf, 1, lbound(InData%TempDisp), ubound(InData%TempDisp)) @@ -745,7 +720,6 @@ subroutine FWrap_PackMisc(Buf, Indata) call MeshPack(Buf, InData%TempDisp(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TempLoads)) if (allocated(InData%TempLoads)) then call RegPackBounds(Buf, 1, lbound(InData%TempLoads), ubound(InData%TempLoads)) @@ -755,7 +729,6 @@ subroutine FWrap_PackMisc(Buf, Indata) call MeshPack(Buf, InData%TempLoads(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ADRotorDisk)) if (allocated(InData%ADRotorDisk)) then call RegPackBounds(Buf, 1, lbound(InData%ADRotorDisk), ubound(InData%ADRotorDisk)) @@ -765,7 +738,6 @@ subroutine FWrap_PackMisc(Buf, Indata) call MeshPack(Buf, InData%ADRotorDisk(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AD_L2L)) if (allocated(InData%AD_L2L)) then call RegPackBounds(Buf, 1, lbound(InData%AD_L2L), ubound(InData%AD_L2L)) @@ -898,15 +870,12 @@ subroutine FWrap_PackParam(Buf, Indata) character(*), parameter :: RoutineName = 'FWrap_PackParam' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%nr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%r)) if (allocated(InData%r)) then call RegPackBounds(Buf, 1, lbound(InData%r), ubound(InData%r)) call RegPack(Buf, InData%r) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%n_FAST_low) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%p_ref_Turbine) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1007,7 +976,6 @@ subroutine FWrap_PackInput(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%fromSCglob), ubound(InData%fromSCglob)) call RegPack(Buf, InData%fromSCglob) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%fromSC)) if (allocated(InData%fromSC)) then call RegPackBounds(Buf, 1, lbound(InData%fromSC), ubound(InData%fromSC)) @@ -1144,27 +1112,18 @@ subroutine FWrap_PackOutput(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%toSC), ubound(InData%toSC)) call RegPack(Buf, InData%toSC) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%xHat_Disk) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YawErr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%psi_skew) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%chi_skew) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%p_hub) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%D_rotor) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DiskAvg_Vx_Rel) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AzimAvg_Ct)) if (allocated(InData%AzimAvg_Ct)) then call RegPackBounds(Buf, 1, lbound(InData%AzimAvg_Ct), ubound(InData%AzimAvg_Ct)) call RegPack(Buf, InData%AzimAvg_Ct) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AzimAvg_Cq)) if (allocated(InData%AzimAvg_Cq)) then call RegPackBounds(Buf, 1, lbound(InData%AzimAvg_Cq), ubound(InData%AzimAvg_Cq)) diff --git a/glue-codes/fast-farm/src/FAST_Farm_Types.f90 b/glue-codes/fast-farm/src/FAST_Farm_Types.f90 index 05c3b29e79..a3f6f0ca09 100644 --- a/glue-codes/fast-farm/src/FAST_Farm_Types.f90 +++ b/glue-codes/fast-farm/src/FAST_Farm_Types.f90 @@ -423,107 +423,70 @@ subroutine Farm_PackParam(Buf, Indata) integer(IntKi) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%DT_low) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DT_high) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TMax) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%n_high_low) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumTurbines) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WindFilePath) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SC_FileName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UseSC) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WT_Position)) if (allocated(InData%WT_Position)) then call RegPackBounds(Buf, 2, lbound(InData%WT_Position), ubound(InData%WT_Position)) call RegPack(Buf, InData%WT_Position) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveFieldMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MooringMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MD_FileName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DT_mooring) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%n_mooring) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WT_FASTInFile)) if (allocated(InData%WT_FASTInFile)) then call RegPackBounds(Buf, 1, lbound(InData%WT_FASTInFile), ubound(InData%WT_FASTInFile)) call RegPack(Buf, InData%WT_FASTInFile) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FTitle) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutFileRoot) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%n_ChkptTime) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TStart) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%n_TMax) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SumPrint) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WrBinOutFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WrTxtOutFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Delim) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutFmt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutFmt_t) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FmtWidth) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TChanLen) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NOutTurb) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NOutRadii) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OutRadii)) if (allocated(InData%OutRadii)) then call RegPackBounds(Buf, 1, lbound(InData%OutRadii), ubound(InData%OutRadii)) call RegPack(Buf, InData%OutRadii) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NOutDist) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OutDist)) if (allocated(InData%OutDist)) then call RegPackBounds(Buf, 1, lbound(InData%OutDist), ubound(InData%OutDist)) call RegPack(Buf, InData%OutDist) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NWindVel) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WindVelX)) if (allocated(InData%WindVelX)) then call RegPackBounds(Buf, 1, lbound(InData%WindVelX), ubound(InData%WindVelX)) call RegPack(Buf, InData%WindVelX) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WindVelY)) if (allocated(InData%WindVelY)) then call RegPackBounds(Buf, 1, lbound(InData%WindVelY), ubound(InData%WindVelY)) call RegPack(Buf, InData%WindVelY) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WindVelZ)) if (allocated(InData%WindVelZ)) then call RegPackBounds(Buf, 1, lbound(InData%WindVelZ), ubound(InData%WindVelZ)) call RegPack(Buf, InData%WindVelZ) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) @@ -533,37 +496,23 @@ subroutine Farm_PackParam(Buf, Indata) call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NOutSteps) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FileDescLines) - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%Module_Ver) UB(1:1) = ubound(InData%Module_Ver) do i1 = LB(1), UB(1) call NWTC_Library_PackProgDesc(Buf, InData%Module_Ver(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UnOu) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dX_low) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dY_low) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dZ_low) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nX_low) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nY_low) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nZ_low) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%X0_low) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Y0_low) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Z0_low) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -929,21 +878,17 @@ subroutine Farm_PackMisc(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%AllOuts), ubound(InData%AllOuts)) call RegPack(Buf, InData%AllOuts) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TimeData)) if (allocated(InData%TimeData)) then call RegPackBounds(Buf, 1, lbound(InData%TimeData), ubound(InData%TimeData)) call RegPack(Buf, InData%TimeData) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AllOutData)) if (allocated(InData%AllOutData)) then call RegPackBounds(Buf, 2, lbound(InData%AllOutData), ubound(InData%AllOutData)) call RegPack(Buf, InData%AllOutData) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%n_Out) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FWrap_2_MD)) if (allocated(InData%FWrap_2_MD)) then call RegPackBounds(Buf, 1, lbound(InData%FWrap_2_MD), ubound(InData%FWrap_2_MD)) @@ -953,7 +898,6 @@ subroutine Farm_PackMisc(Buf, Indata) call NWTC_Library_PackMeshMapType(Buf, InData%FWrap_2_MD(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%MD_2_FWrap)) if (allocated(InData%MD_2_FWrap)) then call RegPackBounds(Buf, 1, lbound(InData%MD_2_FWrap), ubound(InData%MD_2_FWrap)) @@ -1106,21 +1050,13 @@ subroutine Farm_PackFASTWrapper_Data(Buf, Indata) character(*), parameter :: RoutineName = 'Farm_PackFASTWrapper_Data' if (Buf%ErrStat >= AbortErrLev) return call FWrap_PackContState(Buf, InData%x) - if (RegCheckErr(Buf, RoutineName)) return call FWrap_PackDiscState(Buf, InData%xd) - if (RegCheckErr(Buf, RoutineName)) return call FWrap_PackConstrState(Buf, InData%z) - if (RegCheckErr(Buf, RoutineName)) return call FWrap_PackOtherState(Buf, InData%OtherSt) - if (RegCheckErr(Buf, RoutineName)) return call FWrap_PackParam(Buf, InData%p) - if (RegCheckErr(Buf, RoutineName)) return call FWrap_PackInput(Buf, InData%u) - if (RegCheckErr(Buf, RoutineName)) return call FWrap_PackOutput(Buf, InData%y) - if (RegCheckErr(Buf, RoutineName)) return call FWrap_PackMisc(Buf, InData%m) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%IsInitialized) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1197,21 +1133,13 @@ subroutine Farm_PackWakeDynamics_Data(Buf, Indata) character(*), parameter :: RoutineName = 'Farm_PackWakeDynamics_Data' if (Buf%ErrStat >= AbortErrLev) return call WD_PackContState(Buf, InData%x) - if (RegCheckErr(Buf, RoutineName)) return call WD_PackDiscState(Buf, InData%xd) - if (RegCheckErr(Buf, RoutineName)) return call WD_PackConstrState(Buf, InData%z) - if (RegCheckErr(Buf, RoutineName)) return call WD_PackOtherState(Buf, InData%OtherSt) - if (RegCheckErr(Buf, RoutineName)) return call WD_PackParam(Buf, InData%p) - if (RegCheckErr(Buf, RoutineName)) return call WD_PackInput(Buf, InData%u) - if (RegCheckErr(Buf, RoutineName)) return call WD_PackOutput(Buf, InData%y) - if (RegCheckErr(Buf, RoutineName)) return call WD_PackMisc(Buf, InData%m) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%IsInitialized) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1288,21 +1216,13 @@ subroutine Farm_PackAWAE_Data(Buf, Indata) character(*), parameter :: RoutineName = 'Farm_PackAWAE_Data' if (Buf%ErrStat >= AbortErrLev) return call AWAE_PackContState(Buf, InData%x) - if (RegCheckErr(Buf, RoutineName)) return call AWAE_PackDiscState(Buf, InData%xd) - if (RegCheckErr(Buf, RoutineName)) return call AWAE_PackConstrState(Buf, InData%z) - if (RegCheckErr(Buf, RoutineName)) return call AWAE_PackOtherState(Buf, InData%OtherSt) - if (RegCheckErr(Buf, RoutineName)) return call AWAE_PackParam(Buf, InData%p) - if (RegCheckErr(Buf, RoutineName)) return call AWAE_PackInput(Buf, InData%u) - if (RegCheckErr(Buf, RoutineName)) return call AWAE_PackOutput(Buf, InData%y) - if (RegCheckErr(Buf, RoutineName)) return call AWAE_PackMisc(Buf, InData%m) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%IsInitialized) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1380,23 +1300,14 @@ subroutine Farm_PackSC_Data(Buf, Indata) character(*), parameter :: RoutineName = 'Farm_PackSC_Data' if (Buf%ErrStat >= AbortErrLev) return call SC_PackContState(Buf, InData%x) - if (RegCheckErr(Buf, RoutineName)) return call SC_PackDiscState(Buf, InData%xd) - if (RegCheckErr(Buf, RoutineName)) return call SC_PackConstrState(Buf, InData%z) - if (RegCheckErr(Buf, RoutineName)) return call SC_PackOtherState(Buf, InData%OtherState) - if (RegCheckErr(Buf, RoutineName)) return call SC_PackParam(Buf, InData%p) - if (RegCheckErr(Buf, RoutineName)) return call SC_PackInput(Buf, InData%uInputs) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%utimes) - if (RegCheckErr(Buf, RoutineName)) return call SC_PackOutput(Buf, InData%y) - if (RegCheckErr(Buf, RoutineName)) return call SC_PackMisc(Buf, InData%m) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%IsInitialized) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1525,17 +1436,11 @@ subroutine Farm_PackMD_Data(Buf, Indata) integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call MD_PackContState(Buf, InData%x) - if (RegCheckErr(Buf, RoutineName)) return call MD_PackDiscState(Buf, InData%xd) - if (RegCheckErr(Buf, RoutineName)) return call MD_PackConstrState(Buf, InData%z) - if (RegCheckErr(Buf, RoutineName)) return call MD_PackOtherState(Buf, InData%OtherSt) - if (RegCheckErr(Buf, RoutineName)) return call MD_PackParam(Buf, InData%p) - if (RegCheckErr(Buf, RoutineName)) return call MD_PackInput(Buf, InData%u) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) @@ -1545,17 +1450,13 @@ subroutine Farm_PackMD_Data(Buf, Indata) call MD_PackInput(Buf, InData%Input(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) call RegPack(Buf, InData%InputTimes) end if - if (RegCheckErr(Buf, RoutineName)) return call MD_PackOutput(Buf, InData%y) - if (RegCheckErr(Buf, RoutineName)) return call MD_PackMisc(Buf, InData%m) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%IsInitialized) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1715,9 +1616,7 @@ subroutine Farm_PackAll_FastFarm_Data(Buf, Indata) integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call Farm_PackParam(Buf, InData%p) - if (RegCheckErr(Buf, RoutineName)) return call Farm_PackMisc(Buf, InData%m) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FWrap)) if (allocated(InData%FWrap)) then call RegPackBounds(Buf, 1, lbound(InData%FWrap), ubound(InData%FWrap)) @@ -1727,7 +1626,6 @@ subroutine Farm_PackAll_FastFarm_Data(Buf, Indata) call Farm_PackFASTWrapper_Data(Buf, InData%FWrap(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WD)) if (allocated(InData%WD)) then call RegPackBounds(Buf, 1, lbound(InData%WD), ubound(InData%WD)) @@ -1737,11 +1635,8 @@ subroutine Farm_PackAll_FastFarm_Data(Buf, Indata) call Farm_PackWakeDynamics_Data(Buf, InData%WD(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call Farm_PackAWAE_Data(Buf, InData%AWAE) - if (RegCheckErr(Buf, RoutineName)) return call Farm_PackSC_Data(Buf, InData%SC) - if (RegCheckErr(Buf, RoutineName)) return call Farm_PackMD_Data(Buf, InData%MD) if (RegCheckErr(Buf, RoutineName)) return end subroutine diff --git a/modules/aerodyn/src/AeroAcoustics_Types.f90 b/modules/aerodyn/src/AeroAcoustics_Types.f90 index df2487955b..22ded501c6 100644 --- a/modules/aerodyn/src/AeroAcoustics_Types.f90 +++ b/modules/aerodyn/src/AeroAcoustics_Types.f90 @@ -307,7 +307,6 @@ subroutine AA_PackBladePropsType(Buf, Indata) character(*), parameter :: RoutineName = 'AA_PackBladePropsType' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%TEThick) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TEAngle) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -445,39 +444,28 @@ subroutine AA_PackInitInput(Buf, Indata) integer(IntKi) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%InputFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumBlades) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumBlNds) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RootName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BlSpn)) if (allocated(InData%BlSpn)) then call RegPackBounds(Buf, 2, lbound(InData%BlSpn), ubound(InData%BlSpn)) call RegPack(Buf, InData%BlSpn) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BlChord)) if (allocated(InData%BlChord)) then call RegPackBounds(Buf, 2, lbound(InData%BlChord), ubound(InData%BlChord)) call RegPack(Buf, InData%BlChord) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AirDens) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%KinVisc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SpdSound) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HubHeight) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BlAFID)) if (allocated(InData%BlAFID)) then call RegPackBounds(Buf, 2, lbound(InData%BlAFID), ubound(InData%BlAFID)) call RegPack(Buf, InData%BlAFID) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AFInfo)) if (allocated(InData%AFInfo)) then call RegPackBounds(Buf, 1, lbound(InData%AFInfo), ubound(InData%AFInfo)) @@ -750,53 +738,43 @@ subroutine AA_PackInitOutput(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) call RegPack(Buf, InData%WriteOutputHdr) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) call RegPack(Buf, InData%WriteOutputUnt) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutputHdrforPE)) if (allocated(InData%WriteOutputHdrforPE)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdrforPE), ubound(InData%WriteOutputHdrforPE)) call RegPack(Buf, InData%WriteOutputHdrforPE) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutputUntforPE)) if (allocated(InData%WriteOutputUntforPE)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUntforPE), ubound(InData%WriteOutputUntforPE)) call RegPack(Buf, InData%WriteOutputUntforPE) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutputHdrSep)) if (allocated(InData%WriteOutputHdrSep)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdrSep), ubound(InData%WriteOutputHdrSep)) call RegPack(Buf, InData%WriteOutputHdrSep) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutputUntSep)) if (allocated(InData%WriteOutputUntSep)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUntSep), ubound(InData%WriteOutputUntSep)) call RegPack(Buf, InData%WriteOutputUntSep) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutputHdrNodes)) if (allocated(InData%WriteOutputHdrNodes)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdrNodes), ubound(InData%WriteOutputHdrNodes)) call RegPack(Buf, InData%WriteOutputHdrNodes) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutputUntNodes)) if (allocated(InData%WriteOutputUntNodes)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUntNodes), ubound(InData%WriteOutputUntNodes)) call RegPack(Buf, InData%WriteOutputUntNodes) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%delim) - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackProgDesc(Buf, InData%Ver) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AirDens) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1269,53 +1247,35 @@ subroutine AA_PackInputFile(Buf, Indata) integer(IntKi) :: LB(3), UB(3) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%DT_AA) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%IBLUNT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ILAM) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ITIP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ITRIP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ITURB) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%IInflow) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%X_BLMethod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TICalcMeth) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NReListBL) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%aweightflag) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ROUND) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ALPRAT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AA_Bl_Prcntge) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NrObsLoc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ObsX)) if (allocated(InData%ObsX)) then call RegPackBounds(Buf, 1, lbound(InData%ObsX), ubound(InData%ObsX)) call RegPack(Buf, InData%ObsX) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ObsY)) if (allocated(InData%ObsY)) then call RegPackBounds(Buf, 1, lbound(InData%ObsY), ubound(InData%ObsY)) call RegPack(Buf, InData%ObsY) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ObsZ)) if (allocated(InData%ObsZ)) then call RegPackBounds(Buf, 1, lbound(InData%ObsZ), ubound(InData%ObsZ)) call RegPack(Buf, InData%ObsZ) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BladeProps)) if (allocated(InData%BladeProps)) then call RegPackBounds(Buf, 1, lbound(InData%BladeProps), ubound(InData%BladeProps)) @@ -1325,93 +1285,73 @@ subroutine AA_PackInputFile(Buf, Indata) call AA_PackBladePropsType(Buf, InData%BladeProps(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NrOutFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AAoutfile)) if (allocated(InData%AAoutfile)) then call RegPackBounds(Buf, 1, lbound(InData%AAoutfile), ubound(InData%AAoutfile)) call RegPack(Buf, InData%AAoutfile) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TICalcTabFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FTitle) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AAStart) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Lturb) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AvgV) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ReListBL)) if (allocated(InData%ReListBL)) then call RegPackBounds(Buf, 1, lbound(InData%ReListBL), ubound(InData%ReListBL)) call RegPack(Buf, InData%ReListBL) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AoAListBL)) if (allocated(InData%AoAListBL)) then call RegPackBounds(Buf, 1, lbound(InData%AoAListBL), ubound(InData%AoAListBL)) call RegPack(Buf, InData%AoAListBL) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Pres_DispThick)) if (allocated(InData%Pres_DispThick)) then call RegPackBounds(Buf, 3, lbound(InData%Pres_DispThick), ubound(InData%Pres_DispThick)) call RegPack(Buf, InData%Pres_DispThick) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Suct_DispThick)) if (allocated(InData%Suct_DispThick)) then call RegPackBounds(Buf, 3, lbound(InData%Suct_DispThick), ubound(InData%Suct_DispThick)) call RegPack(Buf, InData%Suct_DispThick) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Pres_BLThick)) if (allocated(InData%Pres_BLThick)) then call RegPackBounds(Buf, 3, lbound(InData%Pres_BLThick), ubound(InData%Pres_BLThick)) call RegPack(Buf, InData%Pres_BLThick) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Suct_BLThick)) if (allocated(InData%Suct_BLThick)) then call RegPackBounds(Buf, 3, lbound(InData%Suct_BLThick), ubound(InData%Suct_BLThick)) call RegPack(Buf, InData%Suct_BLThick) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Pres_Cf)) if (allocated(InData%Pres_Cf)) then call RegPackBounds(Buf, 3, lbound(InData%Pres_Cf), ubound(InData%Pres_Cf)) call RegPack(Buf, InData%Pres_Cf) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Suct_Cf)) if (allocated(InData%Suct_Cf)) then call RegPackBounds(Buf, 3, lbound(InData%Suct_Cf), ubound(InData%Suct_Cf)) call RegPack(Buf, InData%Suct_Cf) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Pres_EdgeVelRat)) if (allocated(InData%Pres_EdgeVelRat)) then call RegPackBounds(Buf, 3, lbound(InData%Pres_EdgeVelRat), ubound(InData%Pres_EdgeVelRat)) call RegPack(Buf, InData%Pres_EdgeVelRat) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Suct_EdgeVelRat)) if (allocated(InData%Suct_EdgeVelRat)) then call RegPackBounds(Buf, 3, lbound(InData%Suct_EdgeVelRat), ubound(InData%Suct_EdgeVelRat)) call RegPack(Buf, InData%Suct_EdgeVelRat) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TI_Grid_In)) if (allocated(InData%TI_Grid_In)) then call RegPackBounds(Buf, 2, lbound(InData%TI_Grid_In), ubound(InData%TI_Grid_In)) call RegPack(Buf, InData%TI_Grid_In) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dz_turb_in) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dy_turb_in) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1956,61 +1896,51 @@ subroutine AA_PackDiscState(Buf, Indata) call RegPackBounds(Buf, 2, lbound(InData%MeanVrel), ubound(InData%MeanVrel)) call RegPack(Buf, InData%MeanVrel) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%VrelSq)) if (allocated(InData%VrelSq)) then call RegPackBounds(Buf, 2, lbound(InData%VrelSq), ubound(InData%VrelSq)) call RegPack(Buf, InData%VrelSq) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TIVrel)) if (allocated(InData%TIVrel)) then call RegPackBounds(Buf, 2, lbound(InData%TIVrel), ubound(InData%TIVrel)) call RegPack(Buf, InData%TIVrel) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%VrelStore)) if (allocated(InData%VrelStore)) then call RegPackBounds(Buf, 3, lbound(InData%VrelStore), ubound(InData%VrelStore)) call RegPack(Buf, InData%VrelStore) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TIVx)) if (allocated(InData%TIVx)) then call RegPackBounds(Buf, 2, lbound(InData%TIVx), ubound(InData%TIVx)) call RegPack(Buf, InData%TIVx) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%MeanVxVyVz)) if (allocated(InData%MeanVxVyVz)) then call RegPackBounds(Buf, 2, lbound(InData%MeanVxVyVz), ubound(InData%MeanVxVyVz)) call RegPack(Buf, InData%MeanVxVyVz) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%VxSq)) if (allocated(InData%VxSq)) then call RegPackBounds(Buf, 2, lbound(InData%VxSq), ubound(InData%VxSq)) call RegPack(Buf, InData%VxSq) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%allregcounter)) if (allocated(InData%allregcounter)) then call RegPackBounds(Buf, 2, lbound(InData%allregcounter), ubound(InData%allregcounter)) call RegPack(Buf, InData%allregcounter) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%VxSqRegion)) if (allocated(InData%VxSqRegion)) then call RegPackBounds(Buf, 2, lbound(InData%VxSqRegion), ubound(InData%VxSqRegion)) call RegPack(Buf, InData%VxSqRegion) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RegVxStor)) if (allocated(InData%RegVxStor)) then call RegPackBounds(Buf, 3, lbound(InData%RegVxStor), ubound(InData%RegVxStor)) call RegPack(Buf, InData%RegVxStor) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RegionTIDelete)) if (allocated(InData%RegionTIDelete)) then call RegPackBounds(Buf, 2, lbound(InData%RegionTIDelete), ubound(InData%RegionTIDelete)) @@ -2653,131 +2583,108 @@ subroutine AA_PackMisc(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%AllOuts), ubound(InData%AllOuts)) call RegPack(Buf, InData%AllOuts) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ChordAngleTE)) if (allocated(InData%ChordAngleTE)) then call RegPackBounds(Buf, 3, lbound(InData%ChordAngleTE), ubound(InData%ChordAngleTE)) call RegPack(Buf, InData%ChordAngleTE) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%SpanAngleTE)) if (allocated(InData%SpanAngleTE)) then call RegPackBounds(Buf, 3, lbound(InData%SpanAngleTE), ubound(InData%SpanAngleTE)) call RegPack(Buf, InData%SpanAngleTE) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ChordAngleLE)) if (allocated(InData%ChordAngleLE)) then call RegPackBounds(Buf, 3, lbound(InData%ChordAngleLE), ubound(InData%ChordAngleLE)) call RegPack(Buf, InData%ChordAngleLE) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%SpanAngleLE)) if (allocated(InData%SpanAngleLE)) then call RegPackBounds(Buf, 3, lbound(InData%SpanAngleLE), ubound(InData%SpanAngleLE)) call RegPack(Buf, InData%SpanAngleLE) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%rTEtoObserve)) if (allocated(InData%rTEtoObserve)) then call RegPackBounds(Buf, 3, lbound(InData%rTEtoObserve), ubound(InData%rTEtoObserve)) call RegPack(Buf, InData%rTEtoObserve) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%rLEtoObserve)) if (allocated(InData%rLEtoObserve)) then call RegPackBounds(Buf, 3, lbound(InData%rLEtoObserve), ubound(InData%rLEtoObserve)) call RegPack(Buf, InData%rLEtoObserve) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LE_Location)) if (allocated(InData%LE_Location)) then call RegPackBounds(Buf, 3, lbound(InData%LE_Location), ubound(InData%LE_Location)) call RegPack(Buf, InData%LE_Location) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RotSpeedAoA) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%SPLLBL)) if (allocated(InData%SPLLBL)) then call RegPackBounds(Buf, 1, lbound(InData%SPLLBL), ubound(InData%SPLLBL)) call RegPack(Buf, InData%SPLLBL) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%SPLP)) if (allocated(InData%SPLP)) then call RegPackBounds(Buf, 1, lbound(InData%SPLP), ubound(InData%SPLP)) call RegPack(Buf, InData%SPLP) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%SPLS)) if (allocated(InData%SPLS)) then call RegPackBounds(Buf, 1, lbound(InData%SPLS), ubound(InData%SPLS)) call RegPack(Buf, InData%SPLS) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%SPLALPH)) if (allocated(InData%SPLALPH)) then call RegPackBounds(Buf, 1, lbound(InData%SPLALPH), ubound(InData%SPLALPH)) call RegPack(Buf, InData%SPLALPH) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%SPLTBL)) if (allocated(InData%SPLTBL)) then call RegPackBounds(Buf, 1, lbound(InData%SPLTBL), ubound(InData%SPLTBL)) call RegPack(Buf, InData%SPLTBL) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%SPLTIP)) if (allocated(InData%SPLTIP)) then call RegPackBounds(Buf, 1, lbound(InData%SPLTIP), ubound(InData%SPLTIP)) call RegPack(Buf, InData%SPLTIP) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%SPLTI)) if (allocated(InData%SPLTI)) then call RegPackBounds(Buf, 1, lbound(InData%SPLTI), ubound(InData%SPLTI)) call RegPack(Buf, InData%SPLTI) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%SPLTIGui)) if (allocated(InData%SPLTIGui)) then call RegPackBounds(Buf, 1, lbound(InData%SPLTIGui), ubound(InData%SPLTIGui)) call RegPack(Buf, InData%SPLTIGui) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%SPLBLUNT)) if (allocated(InData%SPLBLUNT)) then call RegPackBounds(Buf, 1, lbound(InData%SPLBLUNT), ubound(InData%SPLBLUNT)) call RegPack(Buf, InData%SPLBLUNT) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CfVar)) if (allocated(InData%CfVar)) then call RegPackBounds(Buf, 1, lbound(InData%CfVar), ubound(InData%CfVar)) call RegPack(Buf, InData%CfVar) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%d99Var)) if (allocated(InData%d99Var)) then call RegPackBounds(Buf, 1, lbound(InData%d99Var), ubound(InData%d99Var)) call RegPack(Buf, InData%d99Var) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%dStarVar)) if (allocated(InData%dStarVar)) then call RegPackBounds(Buf, 1, lbound(InData%dStarVar), ubound(InData%dStarVar)) call RegPack(Buf, InData%dStarVar) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%EdgeVelVar)) if (allocated(InData%EdgeVelVar)) then call RegPackBounds(Buf, 1, lbound(InData%EdgeVelVar), ubound(InData%EdgeVelVar)) call RegPack(Buf, InData%EdgeVelVar) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%speccou) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%filesopen) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3737,155 +3644,100 @@ subroutine AA_PackParam(Buf, Indata) integer(IntKi) :: LB(3), UB(3) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%DT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%IBLUNT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ILAM) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ITIP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ITRIP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ITURB) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%IInflow) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%X_BLMethod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TICalcMeth) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ROUND) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ALPRAT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumBlades) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumBlNds) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AirDens) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%KinVisc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SpdSound) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HubHeight) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%toptip) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%bottip) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%rotorregionlimitsVert)) if (allocated(InData%rotorregionlimitsVert)) then call RegPackBounds(Buf, 1, lbound(InData%rotorregionlimitsVert), ubound(InData%rotorregionlimitsVert)) call RegPack(Buf, InData%rotorregionlimitsVert) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%rotorregionlimitsHorz)) if (allocated(InData%rotorregionlimitsHorz)) then call RegPackBounds(Buf, 1, lbound(InData%rotorregionlimitsHorz), ubound(InData%rotorregionlimitsHorz)) call RegPack(Buf, InData%rotorregionlimitsHorz) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%rotorregionlimitsalph)) if (allocated(InData%rotorregionlimitsalph)) then call RegPackBounds(Buf, 1, lbound(InData%rotorregionlimitsalph), ubound(InData%rotorregionlimitsalph)) call RegPack(Buf, InData%rotorregionlimitsalph) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%rotorregionlimitsrad)) if (allocated(InData%rotorregionlimitsrad)) then call RegPackBounds(Buf, 1, lbound(InData%rotorregionlimitsrad), ubound(InData%rotorregionlimitsrad)) call RegPack(Buf, InData%rotorregionlimitsrad) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NrObsLoc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%aweightflag) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TxtFileOutput) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AAStart) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ObsX)) if (allocated(InData%ObsX)) then call RegPackBounds(Buf, 1, lbound(InData%ObsX), ubound(InData%ObsX)) call RegPack(Buf, InData%ObsX) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ObsY)) if (allocated(InData%ObsY)) then call RegPackBounds(Buf, 1, lbound(InData%ObsY), ubound(InData%ObsY)) call RegPack(Buf, InData%ObsY) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ObsZ)) if (allocated(InData%ObsZ)) then call RegPackBounds(Buf, 1, lbound(InData%ObsZ), ubound(InData%ObsZ)) call RegPack(Buf, InData%ObsZ) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FreqList)) if (allocated(InData%FreqList)) then call RegPackBounds(Buf, 1, lbound(InData%FreqList), ubound(InData%FreqList)) call RegPack(Buf, InData%FreqList) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Aweight)) if (allocated(InData%Aweight)) then call RegPackBounds(Buf, 1, lbound(InData%Aweight), ubound(InData%Aweight)) call RegPack(Buf, InData%Aweight) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Fsample) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%total_sample) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%total_sampleTI) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AA_Bl_Prcntge) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%startnode) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Lturb) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AvgV) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dz_turb_in) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dy_turb_in) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TI_Grid_In)) if (allocated(InData%TI_Grid_In)) then call RegPackBounds(Buf, 2, lbound(InData%TI_Grid_In), ubound(InData%TI_Grid_In)) call RegPack(Buf, InData%TI_Grid_In) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FTitle) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%outFmt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NrOutFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%delim) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumOutsForPE) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumOutsForSep) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumOutsForNodes) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%unOutFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%unOutFile2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%unOutFile3) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%unOutFile4) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RootName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) @@ -3895,37 +3747,31 @@ subroutine AA_PackParam(Buf, Indata) call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%StallStart)) if (allocated(InData%StallStart)) then call RegPackBounds(Buf, 2, lbound(InData%StallStart), ubound(InData%StallStart)) call RegPack(Buf, InData%StallStart) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TEThick)) if (allocated(InData%TEThick)) then call RegPackBounds(Buf, 2, lbound(InData%TEThick), ubound(InData%TEThick)) call RegPack(Buf, InData%TEThick) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TEAngle)) if (allocated(InData%TEAngle)) then call RegPackBounds(Buf, 2, lbound(InData%TEAngle), ubound(InData%TEAngle)) call RegPack(Buf, InData%TEAngle) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AerCent)) if (allocated(InData%AerCent)) then call RegPackBounds(Buf, 3, lbound(InData%AerCent), ubound(InData%AerCent)) call RegPack(Buf, InData%AerCent) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BlAFID)) if (allocated(InData%BlAFID)) then call RegPackBounds(Buf, 2, lbound(InData%BlAFID), ubound(InData%BlAFID)) call RegPack(Buf, InData%BlAFID) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AFInfo)) if (allocated(InData%AFInfo)) then call RegPackBounds(Buf, 1, lbound(InData%AFInfo), ubound(InData%AFInfo)) @@ -3935,91 +3781,76 @@ subroutine AA_PackParam(Buf, Indata) call AFI_PackParam(Buf, InData%AFInfo(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AFLECo)) if (allocated(InData%AFLECo)) then call RegPackBounds(Buf, 3, lbound(InData%AFLECo), ubound(InData%AFLECo)) call RegPack(Buf, InData%AFLECo) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AFTECo)) if (allocated(InData%AFTECo)) then call RegPackBounds(Buf, 3, lbound(InData%AFTECo), ubound(InData%AFTECo)) call RegPack(Buf, InData%AFTECo) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BlSpn)) if (allocated(InData%BlSpn)) then call RegPackBounds(Buf, 2, lbound(InData%BlSpn), ubound(InData%BlSpn)) call RegPack(Buf, InData%BlSpn) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BlChord)) if (allocated(InData%BlChord)) then call RegPackBounds(Buf, 2, lbound(InData%BlChord), ubound(InData%BlChord)) call RegPack(Buf, InData%BlChord) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ReListBL)) if (allocated(InData%ReListBL)) then call RegPackBounds(Buf, 1, lbound(InData%ReListBL), ubound(InData%ReListBL)) call RegPack(Buf, InData%ReListBL) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AOAListBL)) if (allocated(InData%AOAListBL)) then call RegPackBounds(Buf, 1, lbound(InData%AOAListBL), ubound(InData%AOAListBL)) call RegPack(Buf, InData%AOAListBL) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%dStarAll1)) if (allocated(InData%dStarAll1)) then call RegPackBounds(Buf, 3, lbound(InData%dStarAll1), ubound(InData%dStarAll1)) call RegPack(Buf, InData%dStarAll1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%dStarAll2)) if (allocated(InData%dStarAll2)) then call RegPackBounds(Buf, 3, lbound(InData%dStarAll2), ubound(InData%dStarAll2)) call RegPack(Buf, InData%dStarAll2) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%d99All1)) if (allocated(InData%d99All1)) then call RegPackBounds(Buf, 3, lbound(InData%d99All1), ubound(InData%d99All1)) call RegPack(Buf, InData%d99All1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%d99All2)) if (allocated(InData%d99All2)) then call RegPackBounds(Buf, 3, lbound(InData%d99All2), ubound(InData%d99All2)) call RegPack(Buf, InData%d99All2) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CfAll1)) if (allocated(InData%CfAll1)) then call RegPackBounds(Buf, 3, lbound(InData%CfAll1), ubound(InData%CfAll1)) call RegPack(Buf, InData%CfAll1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CfAll2)) if (allocated(InData%CfAll2)) then call RegPackBounds(Buf, 3, lbound(InData%CfAll2), ubound(InData%CfAll2)) call RegPack(Buf, InData%CfAll2) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%EdgeVelRat1)) if (allocated(InData%EdgeVelRat1)) then call RegPackBounds(Buf, 3, lbound(InData%EdgeVelRat1), ubound(InData%EdgeVelRat1)) call RegPack(Buf, InData%EdgeVelRat1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%EdgeVelRat2)) if (allocated(InData%EdgeVelRat2)) then call RegPackBounds(Buf, 3, lbound(InData%EdgeVelRat2), ubound(InData%EdgeVelRat2)) call RegPack(Buf, InData%EdgeVelRat2) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AFThickGuida)) if (allocated(InData%AFThickGuida)) then call RegPackBounds(Buf, 2, lbound(InData%AFThickGuida), ubound(InData%AFThickGuida)) @@ -4696,25 +4527,21 @@ subroutine AA_PackInput(Buf, Indata) call RegPackBounds(Buf, 4, lbound(InData%RotGtoL), ubound(InData%RotGtoL)) call RegPack(Buf, InData%RotGtoL) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AeroCent_G)) if (allocated(InData%AeroCent_G)) then call RegPackBounds(Buf, 3, lbound(InData%AeroCent_G), ubound(InData%AeroCent_G)) call RegPack(Buf, InData%AeroCent_G) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Vrel)) if (allocated(InData%Vrel)) then call RegPackBounds(Buf, 2, lbound(InData%Vrel), ubound(InData%Vrel)) call RegPack(Buf, InData%Vrel) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AoANoise)) if (allocated(InData%AoANoise)) then call RegPackBounds(Buf, 2, lbound(InData%AoANoise), ubound(InData%AoANoise)) call RegPack(Buf, InData%AoANoise) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Inflow)) if (allocated(InData%Inflow)) then call RegPackBounds(Buf, 3, lbound(InData%Inflow), ubound(InData%Inflow)) @@ -5022,61 +4849,51 @@ subroutine AA_PackOutput(Buf, Indata) call RegPackBounds(Buf, 3, lbound(InData%SumSpecNoise), ubound(InData%SumSpecNoise)) call RegPack(Buf, InData%SumSpecNoise) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%SumSpecNoiseSep)) if (allocated(InData%SumSpecNoiseSep)) then call RegPackBounds(Buf, 3, lbound(InData%SumSpecNoiseSep), ubound(InData%SumSpecNoiseSep)) call RegPack(Buf, InData%SumSpecNoiseSep) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OASPL)) if (allocated(InData%OASPL)) then call RegPackBounds(Buf, 3, lbound(InData%OASPL), ubound(InData%OASPL)) call RegPack(Buf, InData%OASPL) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OASPL_Mech)) if (allocated(InData%OASPL_Mech)) then call RegPackBounds(Buf, 4, lbound(InData%OASPL_Mech), ubound(InData%OASPL_Mech)) call RegPack(Buf, InData%OASPL_Mech) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%DirectiviOutput)) if (allocated(InData%DirectiviOutput)) then call RegPackBounds(Buf, 1, lbound(InData%DirectiviOutput), ubound(InData%DirectiviOutput)) call RegPack(Buf, InData%DirectiviOutput) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OutLECoords)) if (allocated(InData%OutLECoords)) then call RegPackBounds(Buf, 4, lbound(InData%OutLECoords), ubound(InData%OutLECoords)) call RegPack(Buf, InData%OutLECoords) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PtotalFreq)) if (allocated(InData%PtotalFreq)) then call RegPackBounds(Buf, 2, lbound(InData%PtotalFreq), ubound(InData%PtotalFreq)) call RegPack(Buf, InData%PtotalFreq) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutputForPE)) if (allocated(InData%WriteOutputForPE)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputForPE), ubound(InData%WriteOutputForPE)) call RegPack(Buf, InData%WriteOutputForPE) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) call RegPack(Buf, InData%WriteOutput) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutputSep)) if (allocated(InData%WriteOutputSep)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputSep), ubound(InData%WriteOutputSep)) call RegPack(Buf, InData%WriteOutputSep) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutputNode)) if (allocated(InData%WriteOutputNode)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputNode), ubound(InData%WriteOutputNode)) diff --git a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 index 61f9bce0c7..cbc93b73d8 100644 --- a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 @@ -236,25 +236,15 @@ subroutine AD_Dvr_PackDvr_Case(Buf, Indata) character(*), parameter :: RoutineName = 'AD_Dvr_PackDvr_Case' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%HWindSpeed) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PLExp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rotSpeed) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%bldPitch) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nacYaw) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%tMax) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%numSteps) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DOF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%amplitude) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%frequency) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -317,9 +307,7 @@ subroutine AD_Dvr_PackDvrVTK_SurfaceType(Buf, Indata) character(*), parameter :: RoutineName = 'AD_Dvr_PackDvrVTK_SurfaceType' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%NumSectors) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NacelleBox) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BaseBox) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -506,59 +494,42 @@ subroutine AD_Dvr_PackDvr_Outputs(Buf, Indata) integer(IntKi) :: LB(3), UB(3) if (Buf%ErrStat >= AbortErrLev) return call NWTC_Library_PackProgDesc(Buf, InData%AD_ver) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%unOutFile)) if (allocated(InData%unOutFile)) then call RegPackBounds(Buf, 1, lbound(InData%unOutFile), ubound(InData%unOutFile)) call RegPack(Buf, InData%unOutFile) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ActualChanLen) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nDvrOutputs) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Fmt_t) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Fmt_a) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%delim) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%outFmt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%fileFmt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%wrVTK) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WrVTK_Type) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Root) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VTK_OutFileRoot) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) call RegPack(Buf, InData%WriteOutputHdr) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) call RegPack(Buf, InData%WriteOutputUnt) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%storage)) if (allocated(InData%storage)) then call RegPackBounds(Buf, 3, lbound(InData%storage), ubound(InData%storage)) call RegPack(Buf, InData%storage) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%outLine)) if (allocated(InData%outLine)) then call RegPackBounds(Buf, 1, lbound(InData%outLine), ubound(InData%outLine)) call RegPack(Buf, InData%outLine) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%VTK_surface)) if (allocated(InData%VTK_surface)) then call RegPackBounds(Buf, 1, lbound(InData%VTK_surface), ubound(InData%VTK_surface)) @@ -568,19 +539,12 @@ subroutine AD_Dvr_PackDvr_Outputs(Buf, Indata) call AD_Dvr_PackDvrVTK_SurfaceType(Buf, InData%VTK_surface(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VTK_tWidth) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%n_VTKTime) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VTKHubRad) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VTKNacDim) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VTKRefPoint) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DT_Outs) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%n_DT_Out) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -773,29 +737,19 @@ subroutine AD_Dvr_PackBladeData(Buf, Indata) character(*), parameter :: RoutineName = 'AD_Dvr_PackBladeData' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%pitch) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%pitchSpeed) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%pitchAcc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%origin_h) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%orientation_h) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%hubRad_bl) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Rh2bl0) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%motionType) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%iMotion) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%motion)) if (allocated(InData%motion)) then call RegPackBounds(Buf, 2, lbound(InData%motion), ubound(InData%motion)) call RegPack(Buf, InData%motion) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%motionFileName) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -897,21 +851,13 @@ subroutine AD_Dvr_PackHubData(Buf, Indata) character(*), parameter :: RoutineName = 'AD_Dvr_PackHubData' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%origin_n) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%orientation_n) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%motionType) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%iMotion) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%azimuth) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rotSpeed) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rotAcc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%motionFileName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%motion)) if (allocated(InData%motion)) then call RegPackBounds(Buf, 2, lbound(InData%motion), ubound(InData%motion)) @@ -1012,19 +958,12 @@ subroutine AD_Dvr_PackNacData(Buf, Indata) character(*), parameter :: RoutineName = 'AD_Dvr_PackNacData' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%origin_t) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%motionType) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%iMotion) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%yaw) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%yawSpeed) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%yawAcc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%motionFileName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%motion)) if (allocated(InData%motion)) then call RegPackBounds(Buf, 2, lbound(InData%motion), ubound(InData%motion)) @@ -1283,15 +1222,10 @@ subroutine AD_Dvr_PackWTData(Buf, Indata) integer(IntKi) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%originInit) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%orientationInit) - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackMeshMapType(Buf, InData%map2twrPt) - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackMeshMapType(Buf, InData%map2nacPt) - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackMeshMapType(Buf, InData%map2hubPt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%map2BldPt)) if (allocated(InData%map2BldPt)) then call RegPackBounds(Buf, 1, lbound(InData%map2BldPt), ubound(InData%map2BldPt)) @@ -1301,7 +1235,6 @@ subroutine AD_Dvr_PackWTData(Buf, Indata) call NWTC_Library_PackMeshMapType(Buf, InData%map2BldPt(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%bld)) if (allocated(InData%bld)) then call RegPackBounds(Buf, 1, lbound(InData%bld), ubound(InData%bld)) @@ -1311,49 +1244,31 @@ subroutine AD_Dvr_PackWTData(Buf, Indata) call AD_Dvr_PackBladeData(Buf, InData%bld(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call AD_Dvr_PackHubData(Buf, InData%hub) - if (RegCheckErr(Buf, RoutineName)) return call AD_Dvr_PackNacData(Buf, InData%nac) - if (RegCheckErr(Buf, RoutineName)) return call AD_Dvr_PackTwrData(Buf, InData%twr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%numBlades) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%basicHAWTFormat) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%hasTower) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%projMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BEM_Mod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HAWTprojection) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%motionType) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%motion)) if (allocated(InData%motion)) then call RegPackBounds(Buf, 2, lbound(InData%motion), ubound(InData%motion)) call RegPack(Buf, InData%motion) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%iMotion) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%degreeOfFreedom) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%amplitude) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%frequency) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%motionFileName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) call RegPack(Buf, InData%WriteOutput) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%userSwapArray)) if (allocated(InData%userSwapArray)) then call RegPackBounds(Buf, 1, lbound(InData%userSwapArray), ubound(InData%userSwapArray)) @@ -1610,27 +1525,16 @@ subroutine AD_Dvr_PackDvr_SimData(Buf, Indata) integer(IntKi) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%AD_InputFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MHK) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AnalysisType) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FldDens) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%KinVisc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SpdSound) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Patm) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Pvap) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WtrDpth) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MSL2SWL) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%numTurbines) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WT)) if (allocated(InData%WT)) then call RegPackBounds(Buf, 1, lbound(InData%WT), ubound(InData%WT)) @@ -1640,15 +1544,10 @@ subroutine AD_Dvr_PackDvr_SimData(Buf, Indata) call AD_Dvr_PackWTData(Buf, InData%WT(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%tMax) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%numSteps) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%numCases) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Cases)) if (allocated(InData%Cases)) then call RegPackBounds(Buf, 1, lbound(InData%Cases), ubound(InData%Cases)) @@ -1658,21 +1557,15 @@ subroutine AD_Dvr_PackDvr_SimData(Buf, Indata) call AD_Dvr_PackDvr_Case(Buf, InData%Cases(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%iCase) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%timeSeries)) if (allocated(InData%timeSeries)) then call RegPackBounds(Buf, 2, lbound(InData%timeSeries), ubound(InData%timeSeries)) call RegPack(Buf, InData%timeSeries) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%iTimeSeries) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%root) - if (RegCheckErr(Buf, RoutineName)) return call AD_Dvr_PackDvr_Outputs(Buf, InData%out) - if (RegCheckErr(Buf, RoutineName)) return call ADI_PackIW_InputData(Buf, InData%IW_InitInp) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1812,15 +1705,10 @@ subroutine AD_Dvr_PackAllData(Buf, Indata) character(*), parameter :: RoutineName = 'AD_Dvr_PackAllData' if (Buf%ErrStat >= AbortErrLev) return call AD_Dvr_PackDvr_SimData(Buf, InData%dvr) - if (RegCheckErr(Buf, RoutineName)) return call ADI_PackData(Buf, InData%ADI) - if (RegCheckErr(Buf, RoutineName)) return call ADI_PackFED_Data(Buf, InData%FED) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%errStat) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%errMsg) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%initialized) if (RegCheckErr(Buf, RoutineName)) return end subroutine diff --git a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 index 88c1621b50..6e6fc40db2 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 @@ -234,27 +234,16 @@ subroutine ADI_PackInflowWindData(Buf, Indata) character(*), parameter :: RoutineName = 'ADI_PackInflowWindData' if (Buf%ErrStat >= AbortErrLev) return call InflowWind_PackContState(Buf, InData%x) - if (RegCheckErr(Buf, RoutineName)) return call InflowWind_PackDiscState(Buf, InData%xd) - if (RegCheckErr(Buf, RoutineName)) return call InflowWind_PackConstrState(Buf, InData%z) - if (RegCheckErr(Buf, RoutineName)) return call InflowWind_PackOtherState(Buf, InData%OtherSt) - if (RegCheckErr(Buf, RoutineName)) return call InflowWind_PackParam(Buf, InData%p) - if (RegCheckErr(Buf, RoutineName)) return call InflowWind_PackMisc(Buf, InData%m) - if (RegCheckErr(Buf, RoutineName)) return call InflowWind_PackInput(Buf, InData%u) - if (RegCheckErr(Buf, RoutineName)) return call InflowWind_PackOutput(Buf, InData%y) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CompInflow) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HWindSpeed) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RefHt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PLExp) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -323,21 +312,13 @@ subroutine ADI_PackIW_InputData(Buf, Indata) character(*), parameter :: RoutineName = 'ADI_PackIW_InputData' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%InputFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CompInflow) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HWindSpeed) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RefHt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PLExp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MHK) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UseInputFile) - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackFileInfoType(Buf, InData%PassedFileData) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Linearize) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -407,17 +388,11 @@ subroutine ADI_PackInitInput(Buf, Indata) character(*), parameter :: RoutineName = 'ADI_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return call AD_PackInitInput(Buf, InData%AD) - if (RegCheckErr(Buf, RoutineName)) return call ADI_PackIW_InputData(Buf, InData%IW_InitInp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RootName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%storeHHVel) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WrVTK) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WrVTK_Type) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -509,13 +484,11 @@ subroutine ADI_PackInitOutput(Buf, Indata) character(*), parameter :: RoutineName = 'ADI_PackInitOutput' if (Buf%ErrStat >= AbortErrLev) return call NWTC_Library_PackProgDesc(Buf, InData%Ver) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) call RegPack(Buf, InData%WriteOutputHdr) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) @@ -808,9 +781,7 @@ subroutine ADI_PackMisc(Buf, Indata) integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call AD_PackMisc(Buf, InData%AD) - if (RegCheckErr(Buf, RoutineName)) return call ADI_PackInflowWindData(Buf, InData%IW) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%VTK_surfaces)) if (allocated(InData%VTK_surfaces)) then call RegPackBounds(Buf, 1, lbound(InData%VTK_surfaces), ubound(InData%VTK_surfaces)) @@ -891,19 +862,12 @@ subroutine ADI_PackParam(Buf, Indata) character(*), parameter :: RoutineName = 'ADI_PackParam' if (Buf%ErrStat >= AbortErrLev) return call AD_PackParam(Buf, InData%AD) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%storeHHVel) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%wrVTK) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WrVTK_Type) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MHK) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1060,21 +1024,17 @@ subroutine ADI_PackOutput(Buf, Indata) character(*), parameter :: RoutineName = 'ADI_PackOutput' if (Buf%ErrStat >= AbortErrLev) return call AD_PackOutput(Buf, InData%AD) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%HHVel)) if (allocated(InData%HHVel)) then call RegPackBounds(Buf, 2, lbound(InData%HHVel), ubound(InData%HHVel)) call RegPack(Buf, InData%HHVel) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PLExp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%IW_WriteOutput)) if (allocated(InData%IW_WriteOutput)) then call RegPackBounds(Buf, 1, lbound(InData%IW_WriteOutput), ubound(InData%IW_WriteOutput)) call RegPack(Buf, InData%IW_WriteOutput) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) @@ -1343,7 +1303,6 @@ subroutine ADI_PackData(Buf, Indata) call ADI_PackContState(Buf, InData%x(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%xd)) if (allocated(InData%xd)) then call RegPackBounds(Buf, 1, lbound(InData%xd), ubound(InData%xd)) @@ -1353,7 +1312,6 @@ subroutine ADI_PackData(Buf, Indata) call ADI_PackDiscState(Buf, InData%xd(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%z)) if (allocated(InData%z)) then call RegPackBounds(Buf, 1, lbound(InData%z), ubound(InData%z)) @@ -1363,7 +1321,6 @@ subroutine ADI_PackData(Buf, Indata) call ADI_PackConstrState(Buf, InData%z(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OtherState)) if (allocated(InData%OtherState)) then call RegPackBounds(Buf, 1, lbound(InData%OtherState), ubound(InData%OtherState)) @@ -1373,11 +1330,8 @@ subroutine ADI_PackData(Buf, Indata) call ADI_PackOtherState(Buf, InData%OtherState(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call ADI_PackParam(Buf, InData%p) - if (RegCheckErr(Buf, RoutineName)) return call ADI_PackMisc(Buf, InData%m) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%u)) if (allocated(InData%u)) then call RegPackBounds(Buf, 1, lbound(InData%u), ubound(InData%u)) @@ -1387,9 +1341,7 @@ subroutine ADI_PackData(Buf, Indata) call ADI_PackInput(Buf, InData%u(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call ADI_PackOutput(Buf, InData%y) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%inputTimes)) if (allocated(InData%inputTimes)) then call RegPackBounds(Buf, 1, lbound(InData%inputTimes), ubound(InData%inputTimes)) @@ -1678,15 +1630,10 @@ subroutine ADI_PackRotFED(Buf, Indata) integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call MeshPack(Buf, InData%PlatformPtMesh) - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%TwrPtMesh) - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%TwrPtMeshAD) - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%NacelleMotion) - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%HubPtMotion) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BladeRootMotion)) if (allocated(InData%BladeRootMotion)) then call RegPackBounds(Buf, 1, lbound(InData%BladeRootMotion), ubound(InData%BladeRootMotion)) @@ -1696,7 +1643,6 @@ subroutine ADI_PackRotFED(Buf, Indata) call MeshPack(Buf, InData%BladeRootMotion(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BladeLn2Mesh)) if (allocated(InData%BladeLn2Mesh)) then call RegPackBounds(Buf, 1, lbound(InData%BladeLn2Mesh), ubound(InData%BladeLn2Mesh)) @@ -1706,17 +1652,11 @@ subroutine ADI_PackRotFED(Buf, Indata) call MeshPack(Buf, InData%BladeLn2Mesh(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%hasTower) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rigidBlades) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%numBlades) - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_AD_P_T) - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackMeshMapType(Buf, InData%AD_P_2_AD_L_T) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AD_P_2_AD_L_B)) if (allocated(InData%AD_P_2_AD_L_B)) then call RegPackBounds(Buf, 1, lbound(InData%AD_P_2_AD_L_B), ubound(InData%AD_P_2_AD_L_B)) @@ -1726,9 +1666,7 @@ subroutine ADI_PackRotFED(Buf, Indata) call NWTC_Library_PackMeshMapType(Buf, InData%AD_P_2_AD_L_B(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_AD_P_TF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ED_P_2_AD_P_R)) if (allocated(InData%ED_P_2_AD_P_R)) then call RegPackBounds(Buf, 1, lbound(InData%ED_P_2_AD_P_R), ubound(InData%ED_P_2_AD_P_R)) @@ -1738,9 +1676,7 @@ subroutine ADI_PackRotFED(Buf, Indata) call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_AD_P_R(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_AD_P_H) - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_AD_P_N) if (RegCheckErr(Buf, RoutineName)) return end subroutine diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index 8be4544145..9de15e78f6 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -519,13 +519,9 @@ subroutine AD_PackTFinParameterType(Buf, Indata) character(*), parameter :: RoutineName = 'AD_PackTFinParameterType' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%TFinMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFinChord) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFinArea) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFinIndMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFinAFID) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -580,17 +576,11 @@ subroutine AD_PackTFinInputFileType(Buf, Indata) character(*), parameter :: RoutineName = 'AD_PackTFinInputFileType' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%TFinMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFinChord) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFinArea) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFinRefP_n) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFinAngles) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFinIndMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFinAFID) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -780,7 +770,6 @@ subroutine AD_PackVTK_RotSurfaceType(Buf, Indata) call AD_PackVTK_BLSurfaceType(Buf, InData%BladeShape(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TowerRad)) if (allocated(InData%TowerRad)) then call RegPackBounds(Buf, 1, lbound(InData%TowerRad), ubound(InData%TowerRad)) @@ -898,29 +887,21 @@ subroutine AD_PackRotInitInputType(Buf, Indata) character(*), parameter :: RoutineName = 'AD_PackRotInitInputType' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%NumBlades) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HubPosition) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HubOrientation) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BladeRootPosition)) if (allocated(InData%BladeRootPosition)) then call RegPackBounds(Buf, 2, lbound(InData%BladeRootPosition), ubound(InData%BladeRootPosition)) call RegPack(Buf, InData%BladeRootPosition) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BladeRootOrientation)) if (allocated(InData%BladeRootOrientation)) then call RegPackBounds(Buf, 3, lbound(InData%BladeRootOrientation), ubound(InData%BladeRootOrientation)) call RegPack(Buf, InData%BladeRootOrientation) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NacellePosition) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NacelleOrientation) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AeroProjMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AeroBEM_Mod) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1064,33 +1045,19 @@ subroutine AD_PackInitInput(Buf, Indata) call AD_PackRotInitInputType(Buf, InData%rotors(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%InputFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RootName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UsePrimaryInputFile) - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackFileInfoType(Buf, InData%PassedPrimaryInputData) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Linearize) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Gravity) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MHK) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%defFldDens) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%defKinVisc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%defSpdSound) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%defPatm) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%defPvap) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WtrDpth) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MSL2SWL) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1347,61 +1314,51 @@ subroutine AD_PackBladePropsType(Buf, Indata) character(*), parameter :: RoutineName = 'AD_PackBladePropsType' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%NumBlNds) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BlSpn)) if (allocated(InData%BlSpn)) then call RegPackBounds(Buf, 1, lbound(InData%BlSpn), ubound(InData%BlSpn)) call RegPack(Buf, InData%BlSpn) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BlCrvAC)) if (allocated(InData%BlCrvAC)) then call RegPackBounds(Buf, 1, lbound(InData%BlCrvAC), ubound(InData%BlCrvAC)) call RegPack(Buf, InData%BlCrvAC) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BlSwpAC)) if (allocated(InData%BlSwpAC)) then call RegPackBounds(Buf, 1, lbound(InData%BlSwpAC), ubound(InData%BlSwpAC)) call RegPack(Buf, InData%BlSwpAC) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BlCrvAng)) if (allocated(InData%BlCrvAng)) then call RegPackBounds(Buf, 1, lbound(InData%BlCrvAng), ubound(InData%BlCrvAng)) call RegPack(Buf, InData%BlCrvAng) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BlTwist)) if (allocated(InData%BlTwist)) then call RegPackBounds(Buf, 1, lbound(InData%BlTwist), ubound(InData%BlTwist)) call RegPack(Buf, InData%BlTwist) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BlChord)) if (allocated(InData%BlChord)) then call RegPackBounds(Buf, 1, lbound(InData%BlChord), ubound(InData%BlChord)) call RegPack(Buf, InData%BlChord) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BlAFID)) if (allocated(InData%BlAFID)) then call RegPackBounds(Buf, 1, lbound(InData%BlAFID), ubound(InData%BlAFID)) call RegPack(Buf, InData%BlAFID) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BlCb)) if (allocated(InData%BlCb)) then call RegPackBounds(Buf, 1, lbound(InData%BlCb), ubound(InData%BlCb)) call RegPack(Buf, InData%BlCb) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BlCenBn)) if (allocated(InData%BlCenBn)) then call RegPackBounds(Buf, 1, lbound(InData%BlCenBn), ubound(InData%BlCenBn)) call RegPack(Buf, InData%BlCenBn) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BlCenBt)) if (allocated(InData%BlCenBt)) then call RegPackBounds(Buf, 1, lbound(InData%BlCenBt), ubound(InData%BlCenBt)) @@ -1933,19 +1890,16 @@ subroutine AD_PackRotInitOutputType(Buf, Indata) integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%AirDens) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) call RegPack(Buf, InData%WriteOutputHdr) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) call RegPack(Buf, InData%WriteOutputUnt) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BladeShape)) if (allocated(InData%BladeShape)) then call RegPackBounds(Buf, 1, lbound(InData%BladeShape), ubound(InData%BladeShape)) @@ -1955,49 +1909,41 @@ subroutine AD_PackRotInitOutputType(Buf, Indata) call AD_PackBladeShape(Buf, InData%BladeShape(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LinNames_y)) if (allocated(InData%LinNames_y)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) call RegPack(Buf, InData%LinNames_y) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LinNames_x)) if (allocated(InData%LinNames_x)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_x), ubound(InData%LinNames_x)) call RegPack(Buf, InData%LinNames_x) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LinNames_u)) if (allocated(InData%LinNames_u)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) call RegPack(Buf, InData%LinNames_u) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RotFrame_y)) if (allocated(InData%RotFrame_y)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y), ubound(InData%RotFrame_y)) call RegPack(Buf, InData%RotFrame_y) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RotFrame_x)) if (allocated(InData%RotFrame_x)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x), ubound(InData%RotFrame_x)) call RegPack(Buf, InData%RotFrame_x) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RotFrame_u)) if (allocated(InData%RotFrame_u)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u), ubound(InData%RotFrame_u)) call RegPack(Buf, InData%RotFrame_u) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%IsLoad_u)) if (allocated(InData%IsLoad_u)) then call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) call RegPack(Buf, InData%IsLoad_u) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BladeProps)) if (allocated(InData%BladeProps)) then call RegPackBounds(Buf, 1, lbound(InData%BladeProps), ubound(InData%BladeProps)) @@ -2007,19 +1953,16 @@ subroutine AD_PackRotInitOutputType(Buf, Indata) call AD_PackBladePropsType(Buf, InData%BladeProps(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%DerivOrder_x)) if (allocated(InData%DerivOrder_x)) then call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x), ubound(InData%DerivOrder_x)) call RegPack(Buf, InData%DerivOrder_x) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TwrElev)) if (allocated(InData%TwrElev)) then call RegPackBounds(Buf, 1, lbound(InData%TwrElev), ubound(InData%TwrElev)) call RegPack(Buf, InData%TwrElev) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TwrDiam)) if (allocated(InData%TwrDiam)) then call RegPackBounds(Buf, 1, lbound(InData%TwrDiam), ubound(InData%TwrDiam)) @@ -2313,7 +2256,6 @@ subroutine AD_PackInitOutput(Buf, Indata) call AD_PackRotInitOutputType(Buf, InData%rotors(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackProgDesc(Buf, InData%Ver) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2511,51 +2453,38 @@ subroutine AD_PackRotInputFile(Buf, Indata) call AD_PackBladePropsType(Buf, InData%BladeProps(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumTwrNds) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TwrElev)) if (allocated(InData%TwrElev)) then call RegPackBounds(Buf, 1, lbound(InData%TwrElev), ubound(InData%TwrElev)) call RegPack(Buf, InData%TwrElev) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TwrDiam)) if (allocated(InData%TwrDiam)) then call RegPackBounds(Buf, 1, lbound(InData%TwrDiam), ubound(InData%TwrDiam)) call RegPack(Buf, InData%TwrDiam) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TwrCd)) if (allocated(InData%TwrCd)) then call RegPackBounds(Buf, 1, lbound(InData%TwrCd), ubound(InData%TwrCd)) call RegPack(Buf, InData%TwrCd) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TwrTI)) if (allocated(InData%TwrTI)) then call RegPackBounds(Buf, 1, lbound(InData%TwrTI), ubound(InData%TwrTI)) call RegPack(Buf, InData%TwrTI) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TwrCb)) if (allocated(InData%TwrCb)) then call RegPackBounds(Buf, 1, lbound(InData%TwrCb), ubound(InData%TwrCb)) call RegPack(Buf, InData%TwrCb) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VolHub) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HubCenBx) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VolNac) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NacCenB) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFinAero) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFinFile) - if (RegCheckErr(Buf, RoutineName)) return call AD_PackTFinInputFileType(Buf, InData%TFin) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2852,129 +2781,75 @@ subroutine AD_PackInputFile(Buf, Indata) integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%Echo) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DTAero) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WakeMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AFAeroMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TwrPotent) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TwrShadow) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TwrAero) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FrozenWake) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CavitCheck) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Buoyancy) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CompAA) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AA_InputFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ADBlFile)) if (allocated(InData%ADBlFile)) then call RegPackBounds(Buf, 1, lbound(InData%ADBlFile), ubound(InData%ADBlFile)) call RegPack(Buf, InData%ADBlFile) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AirDens) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%KinVisc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Patm) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Pvap) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SpdSound) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SkewMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SkewModFactor) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TipLoss) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HubLoss) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TanInd) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AIDrag) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TIDrag) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%IndToler) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MaxIter) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UAMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FLookup) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%InCol_Alfa) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%InCol_Cl) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%InCol_Cd) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%InCol_Cm) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%InCol_Cpmin) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AFTabMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumAFfiles) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FVWFileName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AFNames)) if (allocated(InData%AFNames)) then call RegPackBounds(Buf, 1, lbound(InData%AFNames), ubound(InData%AFNames)) call RegPack(Buf, InData%AFNames) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UseBlCm) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SumPrint) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NBlOuts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BlOutNd) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NTwOuts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TwOutNd) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OutList)) if (allocated(InData%OutList)) then call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) call RegPack(Buf, InData%OutList) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%tau1_const) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DBEMT_Mod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BldNd_NumOuts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BldNd_OutList)) if (allocated(InData%BldNd_OutList)) then call RegPackBounds(Buf, 1, lbound(InData%BldNd_OutList), ubound(InData%BldNd_OutList)) call RegPack(Buf, InData%BldNd_OutList) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BldNd_BlOutNd_Str) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BldNd_BladesOut) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UAStartRad) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UAEndRad) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%rotors)) if (allocated(InData%rotors)) then call RegPackBounds(Buf, 1, lbound(InData%rotors), ubound(InData%rotors)) @@ -3205,7 +3080,6 @@ subroutine AD_PackRotContinuousStateType(Buf, Indata) character(*), parameter :: RoutineName = 'AD_PackRotContinuousStateType' if (Buf%ErrStat >= AbortErrLev) return call BEMT_PackContState(Buf, InData%BEMT) - if (RegCheckErr(Buf, RoutineName)) return call AA_PackContState(Buf, InData%AA) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3293,7 +3167,6 @@ subroutine AD_PackContState(Buf, Indata) call AD_PackRotContinuousStateType(Buf, InData%rotors(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call FVW_PackContState(Buf, InData%FVW) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3361,7 +3234,6 @@ subroutine AD_PackRotDiscreteStateType(Buf, Indata) character(*), parameter :: RoutineName = 'AD_PackRotDiscreteStateType' if (Buf%ErrStat >= AbortErrLev) return call BEMT_PackDiscState(Buf, InData%BEMT) - if (RegCheckErr(Buf, RoutineName)) return call AA_PackDiscState(Buf, InData%AA) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3449,7 +3321,6 @@ subroutine AD_PackDiscState(Buf, Indata) call AD_PackRotDiscreteStateType(Buf, InData%rotors(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call FVW_PackDiscState(Buf, InData%FVW) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3517,7 +3388,6 @@ subroutine AD_PackRotConstraintStateType(Buf, Indata) character(*), parameter :: RoutineName = 'AD_PackRotConstraintStateType' if (Buf%ErrStat >= AbortErrLev) return call BEMT_PackConstrState(Buf, InData%BEMT) - if (RegCheckErr(Buf, RoutineName)) return call AA_PackConstrState(Buf, InData%AA) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3605,7 +3475,6 @@ subroutine AD_PackConstrState(Buf, Indata) call AD_PackRotConstraintStateType(Buf, InData%rotors(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call FVW_PackConstrState(Buf, InData%FVW) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3673,7 +3542,6 @@ subroutine AD_PackRotOtherStateType(Buf, Indata) character(*), parameter :: RoutineName = 'AD_PackRotOtherStateType' if (Buf%ErrStat >= AbortErrLev) return call BEMT_PackOtherState(Buf, InData%BEMT) - if (RegCheckErr(Buf, RoutineName)) return call AA_PackOtherState(Buf, InData%AA) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3778,9 +3646,7 @@ subroutine AD_PackOtherState(Buf, Indata) call AD_PackRotOtherStateType(Buf, InData%rotors(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call FVW_PackOtherState(Buf, InData%FVW) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WakeLocationPoints)) if (allocated(InData%WakeLocationPoints)) then call RegPackBounds(Buf, 2, lbound(InData%WakeLocationPoints), ubound(InData%WakeLocationPoints)) @@ -4537,127 +4403,100 @@ subroutine AD_PackRotMiscVarType(Buf, Indata) integer(IntKi) :: LB(4), UB(4) if (Buf%ErrStat >= AbortErrLev) return call BEMT_PackMisc(Buf, InData%BEMT) - if (RegCheckErr(Buf, RoutineName)) return call BEMT_PackOutput(Buf, InData%BEMT_y) - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%BEMT_u) UB(1:1) = ubound(InData%BEMT_u) do i1 = LB(1), UB(1) call BEMT_PackInput(Buf, InData%BEMT_u(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return call AA_PackMisc(Buf, InData%AA) - if (RegCheckErr(Buf, RoutineName)) return call AA_PackOutput(Buf, InData%AA_y) - if (RegCheckErr(Buf, RoutineName)) return call AA_PackInput(Buf, InData%AA_u) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%DisturbedInflow)) if (allocated(InData%DisturbedInflow)) then call RegPackBounds(Buf, 3, lbound(InData%DisturbedInflow), ubound(InData%DisturbedInflow)) call RegPack(Buf, InData%DisturbedInflow) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%orientationAnnulus)) if (allocated(InData%orientationAnnulus)) then call RegPackBounds(Buf, 4, lbound(InData%orientationAnnulus), ubound(InData%orientationAnnulus)) call RegPack(Buf, InData%orientationAnnulus) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AllOuts)) if (allocated(InData%AllOuts)) then call RegPackBounds(Buf, 1, lbound(InData%AllOuts), ubound(InData%AllOuts)) call RegPack(Buf, InData%AllOuts) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%W_Twr)) if (allocated(InData%W_Twr)) then call RegPackBounds(Buf, 1, lbound(InData%W_Twr), ubound(InData%W_Twr)) call RegPack(Buf, InData%W_Twr) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%X_Twr)) if (allocated(InData%X_Twr)) then call RegPackBounds(Buf, 1, lbound(InData%X_Twr), ubound(InData%X_Twr)) call RegPack(Buf, InData%X_Twr) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Y_Twr)) if (allocated(InData%Y_Twr)) then call RegPackBounds(Buf, 1, lbound(InData%Y_Twr), ubound(InData%Y_Twr)) call RegPack(Buf, InData%Y_Twr) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Curve)) if (allocated(InData%Curve)) then call RegPackBounds(Buf, 2, lbound(InData%Curve), ubound(InData%Curve)) call RegPack(Buf, InData%Curve) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TwrClrnc)) if (allocated(InData%TwrClrnc)) then call RegPackBounds(Buf, 2, lbound(InData%TwrClrnc), ubound(InData%TwrClrnc)) call RegPack(Buf, InData%TwrClrnc) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%X)) if (allocated(InData%X)) then call RegPackBounds(Buf, 2, lbound(InData%X), ubound(InData%X)) call RegPack(Buf, InData%X) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Y)) if (allocated(InData%Y)) then call RegPackBounds(Buf, 2, lbound(InData%Y), ubound(InData%Y)) call RegPack(Buf, InData%Y) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Z)) if (allocated(InData%Z)) then call RegPackBounds(Buf, 2, lbound(InData%Z), ubound(InData%Z)) call RegPack(Buf, InData%Z) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%M)) if (allocated(InData%M)) then call RegPackBounds(Buf, 2, lbound(InData%M), ubound(InData%M)) call RegPack(Buf, InData%M) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Mx)) if (allocated(InData%Mx)) then call RegPackBounds(Buf, 2, lbound(InData%Mx), ubound(InData%Mx)) call RegPack(Buf, InData%Mx) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%My)) if (allocated(InData%My)) then call RegPackBounds(Buf, 2, lbound(InData%My), ubound(InData%My)) call RegPack(Buf, InData%My) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Mz)) if (allocated(InData%Mz)) then call RegPackBounds(Buf, 2, lbound(InData%Mz), ubound(InData%Mz)) call RegPack(Buf, InData%Mz) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%V_DiskAvg) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%yaw) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%tilt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%hub_theta_x_root)) if (allocated(InData%hub_theta_x_root)) then call RegPackBounds(Buf, 1, lbound(InData%hub_theta_x_root), ubound(InData%hub_theta_x_root)) call RegPack(Buf, InData%hub_theta_x_root) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%V_dot_x) - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%HubLoad) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%B_L_2_H_P)) if (allocated(InData%B_L_2_H_P)) then call RegPackBounds(Buf, 1, lbound(InData%B_L_2_H_P), ubound(InData%B_L_2_H_P)) @@ -4667,73 +4506,61 @@ subroutine AD_PackRotMiscVarType(Buf, Indata) call NWTC_Library_PackMeshMapType(Buf, InData%B_L_2_H_P(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%SigmaCavitCrit)) if (allocated(InData%SigmaCavitCrit)) then call RegPackBounds(Buf, 2, lbound(InData%SigmaCavitCrit), ubound(InData%SigmaCavitCrit)) call RegPack(Buf, InData%SigmaCavitCrit) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%SigmaCavit)) if (allocated(InData%SigmaCavit)) then call RegPackBounds(Buf, 2, lbound(InData%SigmaCavit), ubound(InData%SigmaCavit)) call RegPack(Buf, InData%SigmaCavit) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CavitWarnSet)) if (allocated(InData%CavitWarnSet)) then call RegPackBounds(Buf, 2, lbound(InData%CavitWarnSet), ubound(InData%CavitWarnSet)) call RegPack(Buf, InData%CavitWarnSet) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BlFB)) if (allocated(InData%BlFB)) then call RegPackBounds(Buf, 3, lbound(InData%BlFB), ubound(InData%BlFB)) call RegPack(Buf, InData%BlFB) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BlMB)) if (allocated(InData%BlMB)) then call RegPackBounds(Buf, 3, lbound(InData%BlMB), ubound(InData%BlMB)) call RegPack(Buf, InData%BlMB) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TwrFB)) if (allocated(InData%TwrFB)) then call RegPackBounds(Buf, 2, lbound(InData%TwrFB), ubound(InData%TwrFB)) call RegPack(Buf, InData%TwrFB) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TwrMB)) if (allocated(InData%TwrMB)) then call RegPackBounds(Buf, 2, lbound(InData%TwrMB), ubound(InData%TwrMB)) call RegPack(Buf, InData%TwrMB) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%HubFB)) if (allocated(InData%HubFB)) then call RegPackBounds(Buf, 1, lbound(InData%HubFB), ubound(InData%HubFB)) call RegPack(Buf, InData%HubFB) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%HubMB)) if (allocated(InData%HubMB)) then call RegPackBounds(Buf, 1, lbound(InData%HubMB), ubound(InData%HubMB)) call RegPack(Buf, InData%HubMB) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%NacFB)) if (allocated(InData%NacFB)) then call RegPackBounds(Buf, 1, lbound(InData%NacFB), ubound(InData%NacFB)) call RegPack(Buf, InData%NacFB) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%NacMB)) if (allocated(InData%NacMB)) then call RegPackBounds(Buf, 1, lbound(InData%NacMB), ubound(InData%NacMB)) call RegPack(Buf, InData%NacMB) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BladeRootLoad)) if (allocated(InData%BladeRootLoad)) then call RegPackBounds(Buf, 1, lbound(InData%BladeRootLoad), ubound(InData%BladeRootLoad)) @@ -4743,7 +4570,6 @@ subroutine AD_PackRotMiscVarType(Buf, Indata) call MeshPack(Buf, InData%BladeRootLoad(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%B_L_2_R_P)) if (allocated(InData%B_L_2_R_P)) then call RegPackBounds(Buf, 1, lbound(InData%B_L_2_R_P), ubound(InData%B_L_2_R_P)) @@ -4753,7 +4579,6 @@ subroutine AD_PackRotMiscVarType(Buf, Indata) call NWTC_Library_PackMeshMapType(Buf, InData%B_L_2_R_P(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BladeBuoyLoadPoint)) if (allocated(InData%BladeBuoyLoadPoint)) then call RegPackBounds(Buf, 1, lbound(InData%BladeBuoyLoadPoint), ubound(InData%BladeBuoyLoadPoint)) @@ -4763,7 +4588,6 @@ subroutine AD_PackRotMiscVarType(Buf, Indata) call MeshPack(Buf, InData%BladeBuoyLoadPoint(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BladeBuoyLoad)) if (allocated(InData%BladeBuoyLoad)) then call RegPackBounds(Buf, 1, lbound(InData%BladeBuoyLoad), ubound(InData%BladeBuoyLoad)) @@ -4773,7 +4597,6 @@ subroutine AD_PackRotMiscVarType(Buf, Indata) call MeshPack(Buf, InData%BladeBuoyLoad(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%B_P_2_B_L)) if (allocated(InData%B_P_2_B_L)) then call RegPackBounds(Buf, 1, lbound(InData%B_P_2_B_L), ubound(InData%B_P_2_B_L)) @@ -4783,35 +4606,20 @@ subroutine AD_PackRotMiscVarType(Buf, Indata) call NWTC_Library_PackMeshMapType(Buf, InData%B_P_2_B_L(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%TwrBuoyLoadPoint) - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%TwrBuoyLoad) - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackMeshMapType(Buf, InData%T_P_2_T_L) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FirstWarn_TowerStrike) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AvgDiskVel) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AvgDiskVelDist) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFinAlpha) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFinRe) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFinVrel) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFinVund_i) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFinVind_i) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFinVrel_i) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFinSTV_i) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFinF_i) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFinM_i) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -5496,7 +5304,6 @@ subroutine AD_PackMisc(Buf, Indata) call AD_PackRotMiscVarType(Buf, InData%rotors(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FVW_u)) if (allocated(InData%FVW_u)) then call RegPackBounds(Buf, 1, lbound(InData%FVW_u), ubound(InData%FVW_u)) @@ -5506,23 +5313,18 @@ subroutine AD_PackMisc(Buf, Indata) call FVW_PackInput(Buf, InData%FVW_u(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call FVW_PackOutput(Buf, InData%FVW_y) - if (RegCheckErr(Buf, RoutineName)) return call FVW_PackMisc(Buf, InData%FVW) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WindPos)) if (allocated(InData%WindPos)) then call RegPackBounds(Buf, 2, lbound(InData%WindPos), ubound(InData%WindPos)) call RegPack(Buf, InData%WindPos) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WindVel)) if (allocated(InData%WindVel)) then call RegPackBounds(Buf, 2, lbound(InData%WindVel), ubound(InData%WindVel)) call RegPack(Buf, InData%WindVel) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WindAcc)) if (allocated(InData%WindAcc)) then call RegPackBounds(Buf, 2, lbound(InData%WindAcc), ubound(InData%WindAcc)) @@ -6077,179 +5879,128 @@ subroutine AD_PackRotParameterType(Buf, Indata) integer(IntKi) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%NumBlades) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumBlNds) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumTwrNds) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TwrDiam)) if (allocated(InData%TwrDiam)) then call RegPackBounds(Buf, 1, lbound(InData%TwrDiam), ubound(InData%TwrDiam)) call RegPack(Buf, InData%TwrDiam) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TwrCd)) if (allocated(InData%TwrCd)) then call RegPackBounds(Buf, 1, lbound(InData%TwrCd), ubound(InData%TwrCd)) call RegPack(Buf, InData%TwrCd) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TwrTI)) if (allocated(InData%TwrTI)) then call RegPackBounds(Buf, 1, lbound(InData%TwrTI), ubound(InData%TwrTI)) call RegPack(Buf, InData%TwrTI) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BlTwist)) if (allocated(InData%BlTwist)) then call RegPackBounds(Buf, 2, lbound(InData%BlTwist), ubound(InData%BlTwist)) call RegPack(Buf, InData%BlTwist) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TwrCb)) if (allocated(InData%TwrCb)) then call RegPackBounds(Buf, 1, lbound(InData%TwrCb), ubound(InData%TwrCb)) call RegPack(Buf, InData%TwrCb) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BlCenBn)) if (allocated(InData%BlCenBn)) then call RegPackBounds(Buf, 2, lbound(InData%BlCenBn), ubound(InData%BlCenBn)) call RegPack(Buf, InData%BlCenBn) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BlCenBt)) if (allocated(InData%BlCenBt)) then call RegPackBounds(Buf, 2, lbound(InData%BlCenBt), ubound(InData%BlCenBt)) call RegPack(Buf, InData%BlCenBt) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VolHub) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HubCenBx) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VolNac) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NacCenB) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VolBl) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VolTwr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BlRad)) if (allocated(InData%BlRad)) then call RegPackBounds(Buf, 2, lbound(InData%BlRad), ubound(InData%BlRad)) call RegPack(Buf, InData%BlRad) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BlDL)) if (allocated(InData%BlDL)) then call RegPackBounds(Buf, 2, lbound(InData%BlDL), ubound(InData%BlDL)) call RegPack(Buf, InData%BlDL) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BlTaper)) if (allocated(InData%BlTaper)) then call RegPackBounds(Buf, 2, lbound(InData%BlTaper), ubound(InData%BlTaper)) call RegPack(Buf, InData%BlTaper) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BlAxCent)) if (allocated(InData%BlAxCent)) then call RegPackBounds(Buf, 2, lbound(InData%BlAxCent), ubound(InData%BlAxCent)) call RegPack(Buf, InData%BlAxCent) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TwrRad)) if (allocated(InData%TwrRad)) then call RegPackBounds(Buf, 1, lbound(InData%TwrRad), ubound(InData%TwrRad)) call RegPack(Buf, InData%TwrRad) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TwrDL)) if (allocated(InData%TwrDL)) then call RegPackBounds(Buf, 1, lbound(InData%TwrDL), ubound(InData%TwrDL)) call RegPack(Buf, InData%TwrDL) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TwrTaper)) if (allocated(InData%TwrTaper)) then call RegPackBounds(Buf, 1, lbound(InData%TwrTaper), ubound(InData%TwrTaper)) call RegPack(Buf, InData%TwrTaper) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TwrAxCent)) if (allocated(InData%TwrAxCent)) then call RegPackBounds(Buf, 1, lbound(InData%TwrAxCent), ubound(InData%TwrAxCent)) call RegPack(Buf, InData%TwrAxCent) end if - if (RegCheckErr(Buf, RoutineName)) return call BEMT_PackParam(Buf, InData%BEMT) - if (RegCheckErr(Buf, RoutineName)) return call AA_PackParam(Buf, InData%AA) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Jac_u_indx)) if (allocated(InData%Jac_u_indx)) then call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx), ubound(InData%Jac_u_indx)) call RegPack(Buf, InData%Jac_u_indx) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%du)) if (allocated(InData%du)) then call RegPackBounds(Buf, 1, lbound(InData%du), ubound(InData%du)) call RegPack(Buf, InData%du) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%dx)) if (allocated(InData%dx)) then call RegPackBounds(Buf, 1, lbound(InData%dx), ubound(InData%dx)) call RegPack(Buf, InData%dx) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Jac_ny) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumBl_Lin) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TwrPotent) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TwrShadow) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TwrAero) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FrozenWake) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CavitCheck) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Buoyancy) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MHK) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CompAA) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AirDens) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%KinVisc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SpdSound) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Gravity) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Patm) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Pvap) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WtrDpth) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MSL2SWL) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AeroProjMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AeroBEM_Mod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RootName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) @@ -6259,19 +6010,12 @@ subroutine AD_PackRotParameterType(Buf, Indata) call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NBlOuts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BlOutNd) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NTwOuts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TwOutNd) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BldNd_NumOuts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BldNd_TotNumOuts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BldNd_OutParam)) if (allocated(InData%BldNd_OutParam)) then call RegPackBounds(Buf, 1, lbound(InData%BldNd_OutParam), ubound(InData%BldNd_OutParam)) @@ -6281,17 +6025,13 @@ subroutine AD_PackRotParameterType(Buf, Indata) call NWTC_Library_PackOutParmType(Buf, InData%BldNd_OutParam(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BldNd_BlOutNd)) if (allocated(InData%BldNd_BlOutNd)) then call RegPackBounds(Buf, 1, lbound(InData%BldNd_BlOutNd), ubound(InData%BldNd_BlOutNd)) call RegPack(Buf, InData%BldNd_BlOutNd) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BldNd_BladesOut) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFinAero) - if (RegCheckErr(Buf, RoutineName)) return call AD_PackTFinParameterType(Buf, InData%TFin) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -6794,11 +6534,8 @@ subroutine AD_PackParam(Buf, Indata) call AD_PackRotParameterType(Buf, InData%rotors(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RootName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AFI)) if (allocated(InData%AFI)) then call RegPackBounds(Buf, 1, lbound(InData%AFI), ubound(InData%AFI)) @@ -6808,17 +6545,11 @@ subroutine AD_PackParam(Buf, Indata) call AFI_PackParam(Buf, InData%AFI(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SkewMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WakeMod) - if (RegCheckErr(Buf, RoutineName)) return call FVW_PackParam(Buf, InData%FVW) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CompAeroMaps) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UA_Flag) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%FlowField)) if (associated(InData%FlowField)) then call RegPackPointer(Buf, c_loc(InData%FlowField), PtrInIndex) @@ -7061,11 +6792,8 @@ subroutine AD_PackRotInputType(Buf, Indata) integer(IntKi) :: LB(3), UB(3) if (Buf%ErrStat >= AbortErrLev) return call MeshPack(Buf, InData%NacelleMotion) - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%TowerMotion) - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%HubMotion) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BladeRootMotion)) if (allocated(InData%BladeRootMotion)) then call RegPackBounds(Buf, 1, lbound(InData%BladeRootMotion), ubound(InData%BladeRootMotion)) @@ -7075,7 +6803,6 @@ subroutine AD_PackRotInputType(Buf, Indata) call MeshPack(Buf, InData%BladeRootMotion(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BladeMotion)) if (allocated(InData%BladeMotion)) then call RegPackBounds(Buf, 1, lbound(InData%BladeMotion), ubound(InData%BladeMotion)) @@ -7085,27 +6812,20 @@ subroutine AD_PackRotInputType(Buf, Indata) call MeshPack(Buf, InData%BladeMotion(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%TFinMotion) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%InflowOnBlade)) if (allocated(InData%InflowOnBlade)) then call RegPackBounds(Buf, 3, lbound(InData%InflowOnBlade), ubound(InData%InflowOnBlade)) call RegPack(Buf, InData%InflowOnBlade) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%InflowOnTower)) if (allocated(InData%InflowOnTower)) then call RegPackBounds(Buf, 2, lbound(InData%InflowOnTower), ubound(InData%InflowOnTower)) call RegPack(Buf, InData%InflowOnTower) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%InflowOnHub) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%InflowOnNacelle) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%InflowOnTailFin) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%UserProp)) if (allocated(InData%UserProp)) then call RegPackBounds(Buf, 2, lbound(InData%UserProp), ubound(InData%UserProp)) @@ -7295,7 +7015,6 @@ subroutine AD_PackInput(Buf, Indata) call AD_PackRotInputType(Buf, InData%rotors(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%InflowWakeVel)) if (allocated(InData%InflowWakeVel)) then call RegPackBounds(Buf, 2, lbound(InData%InflowWakeVel), ubound(InData%InflowWakeVel)) @@ -7436,11 +7155,8 @@ subroutine AD_PackRotOutputType(Buf, Indata) integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call MeshPack(Buf, InData%NacelleLoad) - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%HubLoad) - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%TowerLoad) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BladeLoad)) if (allocated(InData%BladeLoad)) then call RegPackBounds(Buf, 1, lbound(InData%BladeLoad), ubound(InData%BladeLoad)) @@ -7450,9 +7166,7 @@ subroutine AD_PackRotOutputType(Buf, Indata) call MeshPack(Buf, InData%BladeLoad(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%TFinLoad) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) diff --git a/modules/aerodyn/src/AirfoilInfo_Types.f90 b/modules/aerodyn/src/AirfoilInfo_Types.f90 index 5754a34613..70bbdd3601 100644 --- a/modules/aerodyn/src/AirfoilInfo_Types.f90 +++ b/modules/aerodyn/src/AirfoilInfo_Types.f90 @@ -273,97 +273,51 @@ subroutine AFI_PackUA_BL_Type(Buf, Indata) character(*), parameter :: RoutineName = 'AFI_PackUA_BL_Type' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%alpha0) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%alpha1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%alpha2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%eta_e) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%C_nalpha) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%C_lalpha) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%T_f0) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%T_V0) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%T_p) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%T_VL) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%b1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%b2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%b5) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%A1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%A2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%A5) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%S1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%S2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%S3) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%S4) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Cn1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Cn2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%St_sh) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Cd0) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Cm0) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%k0) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%k1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%k2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%k3) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%k1_hat) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%x_cp_bar) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UACutout) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UACutout_delta) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UACutout_blend) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%filtCutOff) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%alphaUpper) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%alphaLower) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%c_Rate) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%c_RateUpper) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%c_RateLower) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%c_alphaLower) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%c_alphaUpper) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%alphaUpperWrap) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%alphaLowerWrap) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%c_RateWrap) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%c_alphaLowerWrap) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%c_alphaUpperWrap) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -531,75 +485,40 @@ subroutine AFI_PackUA_BL_Default_Type(Buf, Indata) character(*), parameter :: RoutineName = 'AFI_PackUA_BL_Default_Type' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%alpha0) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%alpha1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%alpha2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%eta_e) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%C_nalpha) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%C_lalpha) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%T_f0) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%T_V0) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%T_p) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%T_VL) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%b1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%b2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%b5) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%A1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%A2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%A5) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%S1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%S2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%S3) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%S4) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Cn1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Cn2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%St_sh) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Cd0) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Cm0) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%k0) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%k1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%k2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%k3) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%k1_hat) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%x_cp_bar) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UACutout) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UACutout_delta) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%filtCutOff) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%alphaUpper) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%alphaLower) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -777,29 +696,21 @@ subroutine AFI_PackTable_Type(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%Alpha), ubound(InData%Alpha)) call RegPack(Buf, InData%Alpha) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Coefs)) if (allocated(InData%Coefs)) then call RegPackBounds(Buf, 2, lbound(InData%Coefs), ubound(InData%Coefs)) call RegPack(Buf, InData%Coefs) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%SplineCoefs)) if (allocated(InData%SplineCoefs)) then call RegPackBounds(Buf, 3, lbound(InData%SplineCoefs), ubound(InData%SplineCoefs)) call RegPack(Buf, InData%SplineCoefs) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UserProp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Re) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumAlf) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ConstData) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%InclUAdata) - if (RegCheckErr(Buf, RoutineName)) return call AFI_PackUA_BL_Type(Buf, InData%UA_BL) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -901,19 +812,12 @@ subroutine AFI_PackInitInput(Buf, Indata) character(*), parameter :: RoutineName = 'AFI_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%FileName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AFTabMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%InCol_Alfa) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%InCol_Cl) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%InCol_Cd) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%InCol_Cm) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%InCol_Cpmin) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UA_f_cn) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1112,45 +1016,31 @@ subroutine AFI_PackParam(Buf, Indata) integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%ColCd) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ColCl) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ColCm) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ColCpmin) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ColUAf) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AFTabMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%secondVals)) if (allocated(InData%secondVals)) then call RegPackBounds(Buf, 1, lbound(InData%secondVals), ubound(InData%secondVals)) call RegPack(Buf, InData%secondVals) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%InterpOrd) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RelThickness) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NonDimArea) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumCoords) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%X_Coord)) if (allocated(InData%X_Coord)) then call RegPackBounds(Buf, 1, lbound(InData%X_Coord), ubound(InData%X_Coord)) call RegPack(Buf, InData%X_Coord) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Y_Coord)) if (allocated(InData%Y_Coord)) then call RegPackBounds(Buf, 1, lbound(InData%Y_Coord), ubound(InData%Y_Coord)) call RegPack(Buf, InData%Y_Coord) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumTabs) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Table)) if (allocated(InData%Table)) then call RegPackBounds(Buf, 1, lbound(InData%Table), ubound(InData%Table)) @@ -1160,9 +1050,7 @@ subroutine AFI_PackParam(Buf, Indata) call AFI_PackTable_Type(Buf, InData%Table(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BL_file) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FileName) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1290,9 +1178,7 @@ subroutine AFI_PackInput(Buf, Indata) character(*), parameter :: RoutineName = 'AFI_PackInput' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%AoA) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UserProp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Re) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1345,21 +1231,13 @@ subroutine AFI_PackOutput(Buf, Indata) character(*), parameter :: RoutineName = 'AFI_PackOutput' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%Cl) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Cd) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Cm) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Cpmin) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Cd0) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Cm0) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%f_st) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FullySeparate) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FullyAttached) if (RegCheckErr(Buf, RoutineName)) return end subroutine diff --git a/modules/aerodyn/src/BEMT_Types.f90 b/modules/aerodyn/src/BEMT_Types.f90 index 969689d393..1d26b39f46 100644 --- a/modules/aerodyn/src/BEMT_Types.f90 +++ b/modules/aerodyn/src/BEMT_Types.f90 @@ -434,103 +434,70 @@ subroutine BEMT_PackInitInput(Buf, Indata) call RegPackBounds(Buf, 2, lbound(InData%chord), ubound(InData%chord)) call RegPack(Buf, InData%chord) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%numBlades) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%airDens) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%kinVisc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%skewWakeMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%aTol) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%useTipLoss) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%useHubLoss) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%useInduction) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%useTanInd) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%useAIDrag) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%useTIDrag) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MomentumCorr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%numBladeNodes) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%numReIterations) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%maxIndIterations) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AFindx)) if (allocated(InData%AFindx)) then call RegPackBounds(Buf, 2, lbound(InData%AFindx), ubound(InData%AFindx)) call RegPack(Buf, InData%AFindx) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%zHub)) if (allocated(InData%zHub)) then call RegPackBounds(Buf, 1, lbound(InData%zHub), ubound(InData%zHub)) call RegPack(Buf, InData%zHub) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%zLocal)) if (allocated(InData%zLocal)) then call RegPackBounds(Buf, 2, lbound(InData%zLocal), ubound(InData%zLocal)) call RegPack(Buf, InData%zLocal) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%zTip)) if (allocated(InData%zTip)) then call RegPackBounds(Buf, 1, lbound(InData%zTip), ubound(InData%zTip)) call RegPack(Buf, InData%zTip) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%rLocal)) if (allocated(InData%rLocal)) then call RegPackBounds(Buf, 2, lbound(InData%rLocal), ubound(InData%rLocal)) call RegPack(Buf, InData%rLocal) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%rTipFix)) if (allocated(InData%rTipFix)) then call RegPackBounds(Buf, 1, lbound(InData%rTipFix), ubound(InData%rTipFix)) call RegPack(Buf, InData%rTipFix) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UAMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UA_Flag) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Flookup) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%a_s) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DBEMT_Mod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%tau1_const) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%yawCorrFactor) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%UAOff_innerNode)) if (allocated(InData%UAOff_innerNode)) then call RegPackBounds(Buf, 1, lbound(InData%UAOff_innerNode), ubound(InData%UAOff_innerNode)) call RegPack(Buf, InData%UAOff_innerNode) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%UAOff_outerNode)) if (allocated(InData%UAOff_outerNode)) then call RegPackBounds(Buf, 1, lbound(InData%UAOff_outerNode), ubound(InData%UAOff_outerNode)) call RegPack(Buf, InData%UAOff_outerNode) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RootName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SumPrint) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BEM_Mod) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -794,9 +761,7 @@ subroutine BEMT_PackSkewWake_InputType(Buf, Indata) character(*), parameter :: RoutineName = 'BEMT_PackSkewWake_InputType' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%v_qsw) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%V0) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%R) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -851,9 +816,7 @@ subroutine BEMT_PackContState(Buf, Indata) character(*), parameter :: RoutineName = 'BEMT_PackContState' if (Buf%ErrStat >= AbortErrLev) return call UA_PackContState(Buf, InData%UA) - if (RegCheckErr(Buf, RoutineName)) return call DBEMT_PackContState(Buf, InData%DBEMT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%V_w) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1057,23 +1020,18 @@ subroutine BEMT_PackOtherState(Buf, Indata) integer(IntKi) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call UA_PackOtherState(Buf, InData%UA) - if (RegCheckErr(Buf, RoutineName)) return call DBEMT_PackOtherState(Buf, InData%DBEMT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ValidPhi)) if (allocated(InData%ValidPhi)) then call RegPackBounds(Buf, 2, lbound(InData%ValidPhi), ubound(InData%ValidPhi)) call RegPack(Buf, InData%ValidPhi) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nodesInitialized) - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%xdot) UB(1:1) = ubound(InData%xdot) do i1 = LB(1), UB(1) call BEMT_PackContState(Buf, InData%xdot(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%n) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1349,17 +1307,11 @@ subroutine BEMT_PackMisc(Buf, Indata) integer(IntKi) :: LB(3), UB(3) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%FirstWarn_Skew) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FirstWarn_Phi) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FirstWarn_BEMoff) - if (RegCheckErr(Buf, RoutineName)) return call UA_PackMisc(Buf, InData%UA) - if (RegCheckErr(Buf, RoutineName)) return call DBEMT_PackMisc(Buf, InData%DBEMT) - if (RegCheckErr(Buf, RoutineName)) return call UA_PackOutput(Buf, InData%y_UA) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%u_UA)) if (allocated(InData%u_UA)) then call RegPackBounds(Buf, 3, lbound(InData%u_UA), ubound(InData%u_UA)) @@ -1373,69 +1325,57 @@ subroutine BEMT_PackMisc(Buf, Indata) end do end do end if - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%u_DBEMT) UB(1:1) = ubound(InData%u_DBEMT) do i1 = LB(1), UB(1) call DBEMT_PackInput(Buf, InData%u_DBEMT(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%u_SkewWake) UB(1:1) = ubound(InData%u_SkewWake) do i1 = LB(1), UB(1) call BEMT_PackSkewWake_InputType(Buf, InData%u_SkewWake(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TnInd_op)) if (allocated(InData%TnInd_op)) then call RegPackBounds(Buf, 2, lbound(InData%TnInd_op), ubound(InData%TnInd_op)) call RegPack(Buf, InData%TnInd_op) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AxInd_op)) if (allocated(InData%AxInd_op)) then call RegPackBounds(Buf, 2, lbound(InData%AxInd_op), ubound(InData%AxInd_op)) call RegPack(Buf, InData%AxInd_op) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AxInduction)) if (allocated(InData%AxInduction)) then call RegPackBounds(Buf, 2, lbound(InData%AxInduction), ubound(InData%AxInduction)) call RegPack(Buf, InData%AxInduction) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TanInduction)) if (allocated(InData%TanInduction)) then call RegPackBounds(Buf, 2, lbound(InData%TanInduction), ubound(InData%TanInduction)) call RegPack(Buf, InData%TanInduction) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UseFrozenWake) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Rtip)) if (allocated(InData%Rtip)) then call RegPackBounds(Buf, 1, lbound(InData%Rtip), ubound(InData%Rtip)) call RegPack(Buf, InData%Rtip) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%phi)) if (allocated(InData%phi)) then call RegPackBounds(Buf, 2, lbound(InData%phi), ubound(InData%phi)) call RegPack(Buf, InData%phi) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%chi)) if (allocated(InData%chi)) then call RegPackBounds(Buf, 2, lbound(InData%chi), ubound(InData%chi)) call RegPack(Buf, InData%chi) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ValidPhi)) if (allocated(InData%ValidPhi)) then call RegPackBounds(Buf, 2, lbound(InData%ValidPhi), ubound(InData%ValidPhi)) call RegPack(Buf, InData%ValidPhi) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BEM_weight) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1783,93 +1723,63 @@ subroutine BEMT_PackParam(Buf, Indata) character(*), parameter :: RoutineName = 'BEMT_PackParam' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%DT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%chord)) if (allocated(InData%chord)) then call RegPackBounds(Buf, 2, lbound(InData%chord), ubound(InData%chord)) call RegPack(Buf, InData%chord) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%numBlades) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%airDens) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%kinVisc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%skewWakeMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%aTol) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%useTipLoss) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%useHubLoss) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%useInduction) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%useTanInd) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%useAIDrag) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%useTIDrag) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%numBladeNodes) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%numReIterations) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%maxIndIterations) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AFindx)) if (allocated(InData%AFindx)) then call RegPackBounds(Buf, 2, lbound(InData%AFindx), ubound(InData%AFindx)) call RegPack(Buf, InData%AFindx) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%tipLossConst)) if (allocated(InData%tipLossConst)) then call RegPackBounds(Buf, 2, lbound(InData%tipLossConst), ubound(InData%tipLossConst)) call RegPack(Buf, InData%tipLossConst) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%hubLossConst)) if (allocated(InData%hubLossConst)) then call RegPackBounds(Buf, 2, lbound(InData%hubLossConst), ubound(InData%hubLossConst)) call RegPack(Buf, InData%hubLossConst) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%zHub)) if (allocated(InData%zHub)) then call RegPackBounds(Buf, 1, lbound(InData%zHub), ubound(InData%zHub)) call RegPack(Buf, InData%zHub) end if - if (RegCheckErr(Buf, RoutineName)) return call UA_PackParam(Buf, InData%UA) - if (RegCheckErr(Buf, RoutineName)) return call DBEMT_PackParam(Buf, InData%DBEMT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UA_Flag) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DBEMT_Mod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%yawCorrFactor) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FixedInductions)) if (allocated(InData%FixedInductions)) then call RegPackBounds(Buf, 2, lbound(InData%FixedInductions), ubound(InData%FixedInductions)) call RegPack(Buf, InData%FixedInductions) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MomentumCorr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rTipFixMax) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%IntegrateWeight)) if (allocated(InData%IntegrateWeight)) then call RegPackBounds(Buf, 2, lbound(InData%IntegrateWeight), ubound(InData%IntegrateWeight)) call RegPack(Buf, InData%IntegrateWeight) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%lin_nx) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BEM_Mod) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2271,81 +2181,63 @@ subroutine BEMT_PackInput(Buf, Indata) call RegPackBounds(Buf, 2, lbound(InData%theta), ubound(InData%theta)) call RegPack(Buf, InData%theta) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%chi0) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%psiSkewOffset) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%psi)) if (allocated(InData%psi)) then call RegPackBounds(Buf, 1, lbound(InData%psi), ubound(InData%psi)) call RegPack(Buf, InData%psi) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%omega) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TSR) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Vx)) if (allocated(InData%Vx)) then call RegPackBounds(Buf, 2, lbound(InData%Vx), ubound(InData%Vx)) call RegPack(Buf, InData%Vx) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Vy)) if (allocated(InData%Vy)) then call RegPackBounds(Buf, 2, lbound(InData%Vy), ubound(InData%Vy)) call RegPack(Buf, InData%Vy) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Vz)) if (allocated(InData%Vz)) then call RegPackBounds(Buf, 2, lbound(InData%Vz), ubound(InData%Vz)) call RegPack(Buf, InData%Vz) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%omega_z)) if (allocated(InData%omega_z)) then call RegPackBounds(Buf, 2, lbound(InData%omega_z), ubound(InData%omega_z)) call RegPack(Buf, InData%omega_z) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%xVelCorr)) if (allocated(InData%xVelCorr)) then call RegPackBounds(Buf, 2, lbound(InData%xVelCorr), ubound(InData%xVelCorr)) call RegPack(Buf, InData%xVelCorr) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%rLocal)) if (allocated(InData%rLocal)) then call RegPackBounds(Buf, 2, lbound(InData%rLocal), ubound(InData%rLocal)) call RegPack(Buf, InData%rLocal) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Un_disk) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%V0) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%x_hat_disk) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%UserProp)) if (allocated(InData%UserProp)) then call RegPackBounds(Buf, 2, lbound(InData%UserProp), ubound(InData%UserProp)) call RegPack(Buf, InData%UserProp) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CantAngle)) if (allocated(InData%CantAngle)) then call RegPackBounds(Buf, 2, lbound(InData%CantAngle), ubound(InData%CantAngle)) call RegPack(Buf, InData%CantAngle) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%drdz)) if (allocated(InData%drdz)) then call RegPackBounds(Buf, 2, lbound(InData%drdz), ubound(InData%drdz)) call RegPack(Buf, InData%drdz) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%toeAngle)) if (allocated(InData%toeAngle)) then call RegPackBounds(Buf, 2, lbound(InData%toeAngle), ubound(InData%toeAngle)) @@ -2867,97 +2759,81 @@ subroutine BEMT_PackOutput(Buf, Indata) call RegPackBounds(Buf, 2, lbound(InData%Vrel), ubound(InData%Vrel)) call RegPack(Buf, InData%Vrel) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%phi)) if (allocated(InData%phi)) then call RegPackBounds(Buf, 2, lbound(InData%phi), ubound(InData%phi)) call RegPack(Buf, InData%phi) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%axInduction)) if (allocated(InData%axInduction)) then call RegPackBounds(Buf, 2, lbound(InData%axInduction), ubound(InData%axInduction)) call RegPack(Buf, InData%axInduction) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%tanInduction)) if (allocated(InData%tanInduction)) then call RegPackBounds(Buf, 2, lbound(InData%tanInduction), ubound(InData%tanInduction)) call RegPack(Buf, InData%tanInduction) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Re)) if (allocated(InData%Re)) then call RegPackBounds(Buf, 2, lbound(InData%Re), ubound(InData%Re)) call RegPack(Buf, InData%Re) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AOA)) if (allocated(InData%AOA)) then call RegPackBounds(Buf, 2, lbound(InData%AOA), ubound(InData%AOA)) call RegPack(Buf, InData%AOA) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Cx)) if (allocated(InData%Cx)) then call RegPackBounds(Buf, 2, lbound(InData%Cx), ubound(InData%Cx)) call RegPack(Buf, InData%Cx) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Cy)) if (allocated(InData%Cy)) then call RegPackBounds(Buf, 2, lbound(InData%Cy), ubound(InData%Cy)) call RegPack(Buf, InData%Cy) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Cz)) if (allocated(InData%Cz)) then call RegPackBounds(Buf, 2, lbound(InData%Cz), ubound(InData%Cz)) call RegPack(Buf, InData%Cz) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Cmx)) if (allocated(InData%Cmx)) then call RegPackBounds(Buf, 2, lbound(InData%Cmx), ubound(InData%Cmx)) call RegPack(Buf, InData%Cmx) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Cmy)) if (allocated(InData%Cmy)) then call RegPackBounds(Buf, 2, lbound(InData%Cmy), ubound(InData%Cmy)) call RegPack(Buf, InData%Cmy) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Cmz)) if (allocated(InData%Cmz)) then call RegPackBounds(Buf, 2, lbound(InData%Cmz), ubound(InData%Cmz)) call RegPack(Buf, InData%Cmz) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Cm)) if (allocated(InData%Cm)) then call RegPackBounds(Buf, 2, lbound(InData%Cm), ubound(InData%Cm)) call RegPack(Buf, InData%Cm) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Cl)) if (allocated(InData%Cl)) then call RegPackBounds(Buf, 2, lbound(InData%Cl), ubound(InData%Cl)) call RegPack(Buf, InData%Cl) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Cd)) if (allocated(InData%Cd)) then call RegPackBounds(Buf, 2, lbound(InData%Cd), ubound(InData%Cd)) call RegPack(Buf, InData%Cd) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%chi)) if (allocated(InData%chi)) then call RegPackBounds(Buf, 2, lbound(InData%chi), ubound(InData%chi)) call RegPack(Buf, InData%chi) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Cpmin)) if (allocated(InData%Cpmin)) then call RegPackBounds(Buf, 2, lbound(InData%Cpmin), ubound(InData%Cpmin)) diff --git a/modules/aerodyn/src/DBEMT_Types.f90 b/modules/aerodyn/src/DBEMT_Types.f90 index bb5b85537e..87c991ed7c 100644 --- a/modules/aerodyn/src/DBEMT_Types.f90 +++ b/modules/aerodyn/src/DBEMT_Types.f90 @@ -168,13 +168,9 @@ subroutine DBEMT_PackInitInput(Buf, Indata) character(*), parameter :: RoutineName = 'DBEMT_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%NumBlades) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumNodes) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%tau1_const) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DBEMT_Mod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%rLocal)) if (allocated(InData%rLocal)) then call RegPackBounds(Buf, 2, lbound(InData%rLocal), ubound(InData%rLocal)) @@ -287,7 +283,6 @@ subroutine DBEMT_PackElementContinuousStateType(Buf, Indata) character(*), parameter :: RoutineName = 'DBEMT_PackElementContinuousStateType' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%vind) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%vind_1) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -572,17 +567,13 @@ subroutine DBEMT_PackOtherState(Buf, Indata) call RegPackBounds(Buf, 2, lbound(InData%areStatesInitialized), ubound(InData%areStatesInitialized)) call RegPack(Buf, InData%areStatesInitialized) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%tau1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%tau2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%n)) if (allocated(InData%n)) then call RegPackBounds(Buf, 2, lbound(InData%n), ubound(InData%n)) call RegPack(Buf, InData%n) end if - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%xdot) UB(1:1) = ubound(InData%xdot) do i1 = LB(1), UB(1) @@ -730,23 +721,16 @@ subroutine DBEMT_PackParam(Buf, Indata) character(*), parameter :: RoutineName = 'DBEMT_PackParam' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%DT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%lin_nx) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumBlades) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumNodes) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%k_0ye) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%tau1_const) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%spanRatio)) if (allocated(InData%spanRatio)) then call RegPackBounds(Buf, 2, lbound(InData%spanRatio), ubound(InData%spanRatio)) call RegPack(Buf, InData%spanRatio) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DBEMT_Mod) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -817,7 +801,6 @@ subroutine DBEMT_PackElementInputType(Buf, Indata) character(*), parameter :: RoutineName = 'DBEMT_PackElementInputType' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%vind_s) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%spanRatio) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -903,11 +886,8 @@ subroutine DBEMT_PackInput(Buf, Indata) integer(IntKi) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%AxInd_disk) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Un_disk) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%R_disk) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%element)) if (allocated(InData%element)) then call RegPackBounds(Buf, 2, lbound(InData%element), ubound(InData%element)) diff --git a/modules/aerodyn/src/FVW_Types.f90 b/modules/aerodyn/src/FVW_Types.f90 index a9780657b5..0070cfcbde 100644 --- a/modules/aerodyn/src/FVW_Types.f90 +++ b/modules/aerodyn/src/FVW_Types.f90 @@ -433,45 +433,29 @@ subroutine FVW_PackGridOutType(Buf, Indata) character(*), parameter :: RoutineName = 'FVW_PackGridOutType' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%name) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%type) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%tStart) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%tEnd) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DTout) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%xStart) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%yStart) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%zStart) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%xEnd) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%yEnd) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%zEnd) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nx) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ny) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nz) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%uGrid)) if (allocated(InData%uGrid)) then call RegPackBounds(Buf, 4, lbound(InData%uGrid), ubound(InData%uGrid)) call RegPack(Buf, InData%uGrid) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%omGrid)) if (allocated(InData%omGrid)) then call RegPackBounds(Buf, 4, lbound(InData%omGrid), ubound(InData%omGrid)) call RegPack(Buf, InData%omGrid) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%tLastOutput) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -647,29 +631,23 @@ subroutine FVW_PackT_Sgmt(Buf, Indata) call RegPackBounds(Buf, 2, lbound(InData%Points), ubound(InData%Points)) call RegPack(Buf, InData%Points) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Connct)) if (allocated(InData%Connct)) then call RegPackBounds(Buf, 2, lbound(InData%Connct), ubound(InData%Connct)) call RegPack(Buf, InData%Connct) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Gamma)) if (allocated(InData%Gamma)) then call RegPackBounds(Buf, 1, lbound(InData%Gamma), ubound(InData%Gamma)) call RegPack(Buf, InData%Gamma) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Epsilon)) if (allocated(InData%Epsilon)) then call RegPackBounds(Buf, 1, lbound(InData%Epsilon), ubound(InData%Epsilon)) call RegPack(Buf, InData%Epsilon) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RegFunction) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nAct) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nActP) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -831,21 +809,17 @@ subroutine FVW_PackT_Part(Buf, Indata) call RegPackBounds(Buf, 2, lbound(InData%P), ubound(InData%P)) call RegPack(Buf, InData%P) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Alpha)) if (allocated(InData%Alpha)) then call RegPackBounds(Buf, 2, lbound(InData%Alpha), ubound(InData%Alpha)) call RegPack(Buf, InData%Alpha) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RegParam)) if (allocated(InData%RegParam)) then call RegPackBounds(Buf, 1, lbound(InData%RegParam), ubound(InData%RegParam)) call RegPack(Buf, InData%RegParam) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RegFunction) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nAct) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1042,35 +1016,28 @@ subroutine FVW_PackWng_ParameterType(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%chord_LL), ubound(InData%chord_LL)) call RegPack(Buf, InData%chord_LL) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%chord_CP)) if (allocated(InData%chord_CP)) then call RegPackBounds(Buf, 1, lbound(InData%chord_CP), ubound(InData%chord_CP)) call RegPack(Buf, InData%chord_CP) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%s_LL)) if (allocated(InData%s_LL)) then call RegPackBounds(Buf, 1, lbound(InData%s_LL), ubound(InData%s_LL)) call RegPack(Buf, InData%s_LL) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%s_CP)) if (allocated(InData%s_CP)) then call RegPackBounds(Buf, 1, lbound(InData%s_CP), ubound(InData%s_CP)) call RegPack(Buf, InData%s_CP) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%iRotor) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AFindx)) if (allocated(InData%AFindx)) then call RegPackBounds(Buf, 2, lbound(InData%AFindx), ubound(InData%AFindx)) call RegPack(Buf, InData%AFindx) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nSpan) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PrescribedCirculation)) if (allocated(InData%PrescribedCirculation)) then call RegPackBounds(Buf, 1, lbound(InData%PrescribedCirculation), ubound(InData%PrescribedCirculation)) @@ -1304,9 +1271,7 @@ subroutine FVW_PackParam(Buf, Indata) integer(IntKi) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%nRotors) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nWings) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%W)) if (allocated(InData%W)) then call RegPackBounds(Buf, 1, lbound(InData%W), ubound(InData%W)) @@ -1316,101 +1281,55 @@ subroutine FVW_PackParam(Buf, Indata) call FVW_PackWng_ParameterType(Buf, InData%W(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Bld2Wings)) if (allocated(InData%Bld2Wings)) then call RegPackBounds(Buf, 2, lbound(InData%Bld2Wings), ubound(InData%Bld2Wings)) call RegPack(Buf, InData%Bld2Wings) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%iNWStart) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nNWMax) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nNWFree) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nFWMax) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nFWFree) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FWShedVorticity) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%IntMethod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FreeWakeStart) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FullCircStart) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CircSolvMethod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CircSolvMaxIter) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CircSolvConvCrit) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CircSolvRelaxation) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CircSolvPolar) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DiffusionMethod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CoreSpreadEddyVisc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RegDeterMethod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RegFunction) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WakeRegMethod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WakeRegParam) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WingRegParam) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ShearModel) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TwrShadowOnWake) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VelocityMethod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TreeBranchFactor) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PartPerSegment) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DTaero) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DTfvw) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%KinVisc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MHK) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WtrDpth) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WrVTK) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VTKBlades) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DTvtk) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VTKCoord) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RootName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VTK_OutFileRoot) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VTK_OutFileBase) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nGridOut) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%InductionAtCP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WakeAtTE) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DStallOnWake) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Induction) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%kFrozenNWStart) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%kFrozenNWEnd) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1683,31 +1602,26 @@ subroutine FVW_PackWng_ContinuousStateType(Buf, Indata) call RegPackBounds(Buf, 2, lbound(InData%Gamma_NW), ubound(InData%Gamma_NW)) call RegPack(Buf, InData%Gamma_NW) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Gamma_FW)) if (allocated(InData%Gamma_FW)) then call RegPackBounds(Buf, 2, lbound(InData%Gamma_FW), ubound(InData%Gamma_FW)) call RegPack(Buf, InData%Gamma_FW) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Eps_NW)) if (allocated(InData%Eps_NW)) then call RegPackBounds(Buf, 3, lbound(InData%Eps_NW), ubound(InData%Eps_NW)) call RegPack(Buf, InData%Eps_NW) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Eps_FW)) if (allocated(InData%Eps_FW)) then call RegPackBounds(Buf, 3, lbound(InData%Eps_FW), ubound(InData%Eps_FW)) call RegPack(Buf, InData%Eps_FW) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%r_NW)) if (allocated(InData%r_NW)) then call RegPackBounds(Buf, 3, lbound(InData%r_NW), ubound(InData%r_NW)) call RegPack(Buf, InData%r_NW) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%r_FW)) if (allocated(InData%r_FW)) then call RegPackBounds(Buf, 3, lbound(InData%r_FW), ubound(InData%r_FW)) @@ -1908,7 +1822,6 @@ subroutine FVW_PackContState(Buf, Indata) call FVW_PackWng_ContinuousStateType(Buf, InData%W(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%UA)) if (allocated(InData%UA)) then call RegPackBounds(Buf, 1, lbound(InData%UA), ubound(InData%UA)) @@ -2866,131 +2779,108 @@ subroutine FVW_PackWng_MiscVarType(Buf, Indata) call RegPackBounds(Buf, 2, lbound(InData%LE), ubound(InData%LE)) call RegPack(Buf, InData%LE) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TE)) if (allocated(InData%TE)) then call RegPackBounds(Buf, 2, lbound(InData%TE), ubound(InData%TE)) call RegPack(Buf, InData%TE) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%r_LL)) if (allocated(InData%r_LL)) then call RegPackBounds(Buf, 3, lbound(InData%r_LL), ubound(InData%r_LL)) call RegPack(Buf, InData%r_LL) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CP)) if (allocated(InData%CP)) then call RegPackBounds(Buf, 2, lbound(InData%CP), ubound(InData%CP)) call RegPack(Buf, InData%CP) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Tang)) if (allocated(InData%Tang)) then call RegPackBounds(Buf, 2, lbound(InData%Tang), ubound(InData%Tang)) call RegPack(Buf, InData%Tang) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Norm)) if (allocated(InData%Norm)) then call RegPackBounds(Buf, 2, lbound(InData%Norm), ubound(InData%Norm)) call RegPack(Buf, InData%Norm) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Orth)) if (allocated(InData%Orth)) then call RegPackBounds(Buf, 2, lbound(InData%Orth), ubound(InData%Orth)) call RegPack(Buf, InData%Orth) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%dl)) if (allocated(InData%dl)) then call RegPackBounds(Buf, 2, lbound(InData%dl), ubound(InData%dl)) call RegPack(Buf, InData%dl) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Area)) if (allocated(InData%Area)) then call RegPackBounds(Buf, 1, lbound(InData%Area), ubound(InData%Area)) call RegPack(Buf, InData%Area) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%diag_LL)) if (allocated(InData%diag_LL)) then call RegPackBounds(Buf, 1, lbound(InData%diag_LL), ubound(InData%diag_LL)) call RegPack(Buf, InData%diag_LL) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Vind_CP)) if (allocated(InData%Vind_CP)) then call RegPackBounds(Buf, 2, lbound(InData%Vind_CP), ubound(InData%Vind_CP)) call RegPack(Buf, InData%Vind_CP) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Vtot_CP)) if (allocated(InData%Vtot_CP)) then call RegPackBounds(Buf, 2, lbound(InData%Vtot_CP), ubound(InData%Vtot_CP)) call RegPack(Buf, InData%Vtot_CP) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Vstr_CP)) if (allocated(InData%Vstr_CP)) then call RegPackBounds(Buf, 2, lbound(InData%Vstr_CP), ubound(InData%Vstr_CP)) call RegPack(Buf, InData%Vstr_CP) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Vwnd_CP)) if (allocated(InData%Vwnd_CP)) then call RegPackBounds(Buf, 2, lbound(InData%Vwnd_CP), ubound(InData%Vwnd_CP)) call RegPack(Buf, InData%Vwnd_CP) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Vwnd_NW)) if (allocated(InData%Vwnd_NW)) then call RegPackBounds(Buf, 3, lbound(InData%Vwnd_NW), ubound(InData%Vwnd_NW)) call RegPack(Buf, InData%Vwnd_NW) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Vwnd_FW)) if (allocated(InData%Vwnd_FW)) then call RegPackBounds(Buf, 3, lbound(InData%Vwnd_FW), ubound(InData%Vwnd_FW)) call RegPack(Buf, InData%Vwnd_FW) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Vind_NW)) if (allocated(InData%Vind_NW)) then call RegPackBounds(Buf, 3, lbound(InData%Vind_NW), ubound(InData%Vind_NW)) call RegPack(Buf, InData%Vind_NW) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Vind_FW)) if (allocated(InData%Vind_FW)) then call RegPackBounds(Buf, 3, lbound(InData%Vind_FW), ubound(InData%Vind_FW)) call RegPack(Buf, InData%Vind_FW) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PitchAndTwist)) if (allocated(InData%PitchAndTwist)) then call RegPackBounds(Buf, 1, lbound(InData%PitchAndTwist), ubound(InData%PitchAndTwist)) call RegPack(Buf, InData%PitchAndTwist) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%iTip) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%iRoot) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%alpha_LL)) if (allocated(InData%alpha_LL)) then call RegPackBounds(Buf, 1, lbound(InData%alpha_LL), ubound(InData%alpha_LL)) call RegPack(Buf, InData%alpha_LL) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Vreln_LL)) if (allocated(InData%Vreln_LL)) then call RegPackBounds(Buf, 1, lbound(InData%Vreln_LL), ubound(InData%Vreln_LL)) call RegPack(Buf, InData%Vreln_LL) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%u_UA)) if (allocated(InData%u_UA)) then call RegPackBounds(Buf, 2, lbound(InData%u_UA), ubound(InData%u_UA)) @@ -3002,109 +2892,89 @@ subroutine FVW_PackWng_MiscVarType(Buf, Indata) end do end do end if - if (RegCheckErr(Buf, RoutineName)) return call UA_PackMisc(Buf, InData%m_UA) - if (RegCheckErr(Buf, RoutineName)) return call UA_PackOutput(Buf, InData%y_UA) - if (RegCheckErr(Buf, RoutineName)) return call UA_PackParam(Buf, InData%p_UA) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Vind_LL)) if (allocated(InData%Vind_LL)) then call RegPackBounds(Buf, 2, lbound(InData%Vind_LL), ubound(InData%Vind_LL)) call RegPack(Buf, InData%Vind_LL) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BN_AxInd)) if (allocated(InData%BN_AxInd)) then call RegPackBounds(Buf, 1, lbound(InData%BN_AxInd), ubound(InData%BN_AxInd)) call RegPack(Buf, InData%BN_AxInd) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BN_TanInd)) if (allocated(InData%BN_TanInd)) then call RegPackBounds(Buf, 1, lbound(InData%BN_TanInd), ubound(InData%BN_TanInd)) call RegPack(Buf, InData%BN_TanInd) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BN_Vrel)) if (allocated(InData%BN_Vrel)) then call RegPackBounds(Buf, 1, lbound(InData%BN_Vrel), ubound(InData%BN_Vrel)) call RegPack(Buf, InData%BN_Vrel) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BN_alpha)) if (allocated(InData%BN_alpha)) then call RegPackBounds(Buf, 1, lbound(InData%BN_alpha), ubound(InData%BN_alpha)) call RegPack(Buf, InData%BN_alpha) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BN_phi)) if (allocated(InData%BN_phi)) then call RegPackBounds(Buf, 1, lbound(InData%BN_phi), ubound(InData%BN_phi)) call RegPack(Buf, InData%BN_phi) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BN_Re)) if (allocated(InData%BN_Re)) then call RegPackBounds(Buf, 1, lbound(InData%BN_Re), ubound(InData%BN_Re)) call RegPack(Buf, InData%BN_Re) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BN_URelWind_s)) if (allocated(InData%BN_URelWind_s)) then call RegPackBounds(Buf, 2, lbound(InData%BN_URelWind_s), ubound(InData%BN_URelWind_s)) call RegPack(Buf, InData%BN_URelWind_s) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BN_Cl_Static)) if (allocated(InData%BN_Cl_Static)) then call RegPackBounds(Buf, 1, lbound(InData%BN_Cl_Static), ubound(InData%BN_Cl_Static)) call RegPack(Buf, InData%BN_Cl_Static) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BN_Cd_Static)) if (allocated(InData%BN_Cd_Static)) then call RegPackBounds(Buf, 1, lbound(InData%BN_Cd_Static), ubound(InData%BN_Cd_Static)) call RegPack(Buf, InData%BN_Cd_Static) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BN_Cm_Static)) if (allocated(InData%BN_Cm_Static)) then call RegPackBounds(Buf, 1, lbound(InData%BN_Cm_Static), ubound(InData%BN_Cm_Static)) call RegPack(Buf, InData%BN_Cm_Static) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BN_Cpmin)) if (allocated(InData%BN_Cpmin)) then call RegPackBounds(Buf, 1, lbound(InData%BN_Cpmin), ubound(InData%BN_Cpmin)) call RegPack(Buf, InData%BN_Cpmin) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BN_Cl)) if (allocated(InData%BN_Cl)) then call RegPackBounds(Buf, 1, lbound(InData%BN_Cl), ubound(InData%BN_Cl)) call RegPack(Buf, InData%BN_Cl) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BN_Cd)) if (allocated(InData%BN_Cd)) then call RegPackBounds(Buf, 1, lbound(InData%BN_Cd), ubound(InData%BN_Cd)) call RegPack(Buf, InData%BN_Cd) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BN_Cm)) if (allocated(InData%BN_Cm)) then call RegPackBounds(Buf, 1, lbound(InData%BN_Cm), ubound(InData%BN_Cm)) call RegPack(Buf, InData%BN_Cm) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BN_Cx)) if (allocated(InData%BN_Cx)) then call RegPackBounds(Buf, 1, lbound(InData%BN_Cx), ubound(InData%BN_Cx)) call RegPack(Buf, InData%BN_Cx) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BN_Cy)) if (allocated(InData%BN_Cy)) then call RegPackBounds(Buf, 1, lbound(InData%BN_Cy), ubound(InData%BN_Cy)) @@ -3855,57 +3725,37 @@ subroutine FVW_PackMisc(Buf, Indata) call FVW_PackWng_MiscVarType(Buf, InData%W(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FirstCall) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nNW) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nFW) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%iStep) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VTKstep) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VTKlastTime) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%r_wind)) if (allocated(InData%r_wind)) then call RegPackBounds(Buf, 2, lbound(InData%r_wind), ubound(InData%r_wind)) call RegPack(Buf, InData%r_wind) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ComputeWakeInduced) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OldWakeTime) - if (RegCheckErr(Buf, RoutineName)) return call FVW_PackContState(Buf, InData%dxdt) - if (RegCheckErr(Buf, RoutineName)) return call FVW_PackContState(Buf, InData%x1) - if (RegCheckErr(Buf, RoutineName)) return call FVW_PackContState(Buf, InData%x2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%t1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%t2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UA_Flag) - if (RegCheckErr(Buf, RoutineName)) return call FVW_PackT_Sgmt(Buf, InData%Sgmt) - if (RegCheckErr(Buf, RoutineName)) return call FVW_PackT_Part(Buf, InData%Part) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CPs)) if (allocated(InData%CPs)) then call RegPackBounds(Buf, 2, lbound(InData%CPs), ubound(InData%CPs)) call RegPack(Buf, InData%CPs) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Uind)) if (allocated(InData%Uind)) then call RegPackBounds(Buf, 2, lbound(InData%Uind), ubound(InData%Uind)) call RegPack(Buf, InData%Uind) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%GridOutputs)) if (allocated(InData%GridOutputs)) then call RegPackBounds(Buf, 1, lbound(InData%GridOutputs), ubound(InData%GridOutputs)) @@ -4056,7 +3906,6 @@ subroutine FVW_PackRot_InputType(Buf, Indata) character(*), parameter :: RoutineName = 'FVW_PackRot_InputType' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%HubOrientation) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HubPosition) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -4138,7 +3987,6 @@ subroutine FVW_PackWng_InputType(Buf, Indata) call RegPackBounds(Buf, 2, lbound(InData%Vwnd_LL), ubound(InData%Vwnd_LL)) call RegPack(Buf, InData%Vwnd_LL) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%omega_z)) if (allocated(InData%omega_z)) then call RegPackBounds(Buf, 1, lbound(InData%omega_z), ubound(InData%omega_z)) @@ -4327,7 +4175,6 @@ subroutine FVW_PackInput(Buf, Indata) call FVW_PackRot_InputType(Buf, InData%rotors(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%W)) if (allocated(InData%W)) then call RegPackBounds(Buf, 1, lbound(InData%W), ubound(InData%W)) @@ -4337,7 +4184,6 @@ subroutine FVW_PackInput(Buf, Indata) call FVW_PackWng_InputType(Buf, InData%W(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WingsMesh)) if (allocated(InData%WingsMesh)) then call RegPackBounds(Buf, 1, lbound(InData%WingsMesh), ubound(InData%WingsMesh)) @@ -4347,7 +4193,6 @@ subroutine FVW_PackInput(Buf, Indata) call MeshPack(Buf, InData%WingsMesh(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%V_wind)) if (allocated(InData%V_wind)) then call RegPackBounds(Buf, 2, lbound(InData%V_wind), ubound(InData%V_wind)) @@ -4490,7 +4335,6 @@ subroutine FVW_PackDiscState(Buf, Indata) integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%Dummy) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%UA)) if (allocated(InData%UA)) then call RegPackBounds(Buf, 1, lbound(InData%UA), ubound(InData%UA)) @@ -4679,7 +4523,6 @@ subroutine FVW_PackConstrState(Buf, Indata) call FVW_PackWng_ConstraintStateType(Buf, InData%W(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%residual) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -4776,7 +4619,6 @@ subroutine FVW_PackOtherState(Buf, Indata) integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%Dummy) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%UA)) if (allocated(InData%UA)) then call RegPackBounds(Buf, 1, lbound(InData%UA), ubound(InData%UA)) @@ -4903,23 +4745,18 @@ subroutine FVW_PackWng_InitInputType(Buf, Indata) call RegPackBounds(Buf, 2, lbound(InData%AFindx), ubound(InData%AFindx)) call RegPack(Buf, InData%AFindx) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%chord)) if (allocated(InData%chord)) then call RegPackBounds(Buf, 1, lbound(InData%chord), ubound(InData%chord)) call RegPack(Buf, InData%chord) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RElm)) if (allocated(InData%RElm)) then call RegPackBounds(Buf, 1, lbound(InData%RElm), ubound(InData%RElm)) call RegPack(Buf, InData%RElm) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%iRotor) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UAOff_innerNode) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UAOff_outerNode) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -5084,9 +4921,7 @@ subroutine FVW_PackInitInput(Buf, Indata) integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%FVWFileName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RootName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%W)) if (allocated(InData%W)) then call RegPackBounds(Buf, 1, lbound(InData%W), ubound(InData%W)) @@ -5096,7 +4931,6 @@ subroutine FVW_PackInitInput(Buf, Indata) call FVW_PackWng_InitInputType(Buf, InData%W(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WingsMesh)) if (allocated(InData%WingsMesh)) then call RegPackBounds(Buf, 1, lbound(InData%WingsMesh), ubound(InData%WingsMesh)) @@ -5106,25 +4940,15 @@ subroutine FVW_PackInitInput(Buf, Indata) call MeshPack(Buf, InData%WingsMesh(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%numBladeNodes) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DTaero) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%KinVisc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MHK) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WtrDpth) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UAMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UA_Flag) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Flookup) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%a_s) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SumPrint) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -5252,67 +5076,36 @@ subroutine FVW_PackInputFile(Buf, Indata) character(*), parameter :: RoutineName = 'FVW_PackInputFile' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%CircSolvMethod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CirculationFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CircSolvMaxIter) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CircSolvConvCrit) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CircSolvRelaxation) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%IntMethod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FreeWake) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FreeWakeStart) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FullCircStart) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DTfvw) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CircSolvPolar) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nNWPanels) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nNWPanelsFree) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nFWPanels) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nFWPanelsFree) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FWShedVorticity) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DiffusionMethod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CoreSpreadEddyVisc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RegDeterMethod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RegFunction) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WakeRegMethod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WakeRegParam) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WingRegParam) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ShearModel) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TwrShadowOnWake) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VelocityMethod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TreeBranchFactor) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PartPerSegment) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WrVTK) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VTKBlades) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DTvtk) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VTKCoord) if (RegCheckErr(Buf, RoutineName)) return end subroutine diff --git a/modules/aerodyn/src/UnsteadyAero_Types.f90 b/modules/aerodyn/src/UnsteadyAero_Types.f90 index 686ea41348..39c864e13f 100644 --- a/modules/aerodyn/src/UnsteadyAero_Types.f90 +++ b/modules/aerodyn/src/UnsteadyAero_Types.f90 @@ -333,35 +333,24 @@ subroutine UA_PackInitInput(Buf, Indata) character(*), parameter :: RoutineName = 'UA_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%dt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutRootName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%c)) if (allocated(InData%c)) then call RegPackBounds(Buf, 2, lbound(InData%c), ubound(InData%c)) call RegPack(Buf, InData%c) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%numBlades) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nNodesPerBlade) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UAMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%a_s) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Flookup) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ShedEffect) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WrSum) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%UAOff_innerNode)) if (allocated(InData%UAOff_innerNode)) then call RegPackBounds(Buf, 1, lbound(InData%UAOff_innerNode), ubound(InData%UAOff_innerNode)) call RegPack(Buf, InData%UAOff_innerNode) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%UAOff_outerNode)) if (allocated(InData%UAOff_outerNode)) then call RegPackBounds(Buf, 1, lbound(InData%UAOff_outerNode), ubound(InData%UAOff_outerNode)) @@ -508,13 +497,11 @@ subroutine UA_PackInitOutput(Buf, Indata) character(*), parameter :: RoutineName = 'UA_PackInitOutput' if (Buf%ErrStat >= AbortErrLev) return call NWTC_Library_PackProgDesc(Buf, InData%Version) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) call RegPack(Buf, InData%WriteOutputHdr) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) @@ -639,105 +626,55 @@ subroutine UA_PackKelvinChainType(Buf, Indata) character(*), parameter :: RoutineName = 'UA_PackKelvinChainType' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%Cn_prime) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%C_nalpha_circ) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Kalpha_f) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Kq_f) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%alpha_filt_cur) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%alpha_e) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dalpha0) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%alpha_f) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Kq) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%q_cur) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%q_f_cur) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%X1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%X2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%X3) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%X4) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Kprime_alpha) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Kprime_q) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%K3prime_q) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Kprimeprime_q) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Dp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Cn_pot) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Cc_pot) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Cn_alpha_q_circ) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Cn_alpha_q_nc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Cm_q_circ) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Cn_alpha_nc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Cn_q_circ) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Cn_q_nc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Cm_q_nc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%fprimeprime) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Df) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Df_c) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Df_m) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Dalphaf) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%fprime) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%fprime_c) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%fprimeprime_c) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%fprime_m) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%fprimeprime_m) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Cn_v) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%C_V) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Cn_FS) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%T_f) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%T_fc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%T_fm) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%T_V) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%k_alpha) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%k_q) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%T_alpha) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%T_q) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ds) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1608,199 +1545,166 @@ subroutine UA_PackDiscState(Buf, Indata) call RegPackBounds(Buf, 2, lbound(InData%alpha_minus1), ubound(InData%alpha_minus1)) call RegPack(Buf, InData%alpha_minus1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%alpha_filt_minus1)) if (allocated(InData%alpha_filt_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%alpha_filt_minus1), ubound(InData%alpha_filt_minus1)) call RegPack(Buf, InData%alpha_filt_minus1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%alpha_dot)) if (allocated(InData%alpha_dot)) then call RegPackBounds(Buf, 2, lbound(InData%alpha_dot), ubound(InData%alpha_dot)) call RegPack(Buf, InData%alpha_dot) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%alpha_dot_minus1)) if (allocated(InData%alpha_dot_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%alpha_dot_minus1), ubound(InData%alpha_dot_minus1)) call RegPack(Buf, InData%alpha_dot_minus1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%q_minus1)) if (allocated(InData%q_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%q_minus1), ubound(InData%q_minus1)) call RegPack(Buf, InData%q_minus1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Kalpha_f_minus1)) if (allocated(InData%Kalpha_f_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%Kalpha_f_minus1), ubound(InData%Kalpha_f_minus1)) call RegPack(Buf, InData%Kalpha_f_minus1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Kq_f_minus1)) if (allocated(InData%Kq_f_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%Kq_f_minus1), ubound(InData%Kq_f_minus1)) call RegPack(Buf, InData%Kq_f_minus1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%q_f_minus1)) if (allocated(InData%q_f_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%q_f_minus1), ubound(InData%q_f_minus1)) call RegPack(Buf, InData%q_f_minus1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%X1_minus1)) if (allocated(InData%X1_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%X1_minus1), ubound(InData%X1_minus1)) call RegPack(Buf, InData%X1_minus1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%X2_minus1)) if (allocated(InData%X2_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%X2_minus1), ubound(InData%X2_minus1)) call RegPack(Buf, InData%X2_minus1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%X3_minus1)) if (allocated(InData%X3_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%X3_minus1), ubound(InData%X3_minus1)) call RegPack(Buf, InData%X3_minus1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%X4_minus1)) if (allocated(InData%X4_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%X4_minus1), ubound(InData%X4_minus1)) call RegPack(Buf, InData%X4_minus1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Kprime_alpha_minus1)) if (allocated(InData%Kprime_alpha_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%Kprime_alpha_minus1), ubound(InData%Kprime_alpha_minus1)) call RegPack(Buf, InData%Kprime_alpha_minus1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Kprime_q_minus1)) if (allocated(InData%Kprime_q_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%Kprime_q_minus1), ubound(InData%Kprime_q_minus1)) call RegPack(Buf, InData%Kprime_q_minus1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Kprimeprime_q_minus1)) if (allocated(InData%Kprimeprime_q_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%Kprimeprime_q_minus1), ubound(InData%Kprimeprime_q_minus1)) call RegPack(Buf, InData%Kprimeprime_q_minus1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%K3prime_q_minus1)) if (allocated(InData%K3prime_q_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%K3prime_q_minus1), ubound(InData%K3prime_q_minus1)) call RegPack(Buf, InData%K3prime_q_minus1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Dp_minus1)) if (allocated(InData%Dp_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%Dp_minus1), ubound(InData%Dp_minus1)) call RegPack(Buf, InData%Dp_minus1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Cn_pot_minus1)) if (allocated(InData%Cn_pot_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%Cn_pot_minus1), ubound(InData%Cn_pot_minus1)) call RegPack(Buf, InData%Cn_pot_minus1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%fprimeprime_minus1)) if (allocated(InData%fprimeprime_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%fprimeprime_minus1), ubound(InData%fprimeprime_minus1)) call RegPack(Buf, InData%fprimeprime_minus1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%fprimeprime_c_minus1)) if (allocated(InData%fprimeprime_c_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%fprimeprime_c_minus1), ubound(InData%fprimeprime_c_minus1)) call RegPack(Buf, InData%fprimeprime_c_minus1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%fprimeprime_m_minus1)) if (allocated(InData%fprimeprime_m_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%fprimeprime_m_minus1), ubound(InData%fprimeprime_m_minus1)) call RegPack(Buf, InData%fprimeprime_m_minus1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Df_minus1)) if (allocated(InData%Df_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%Df_minus1), ubound(InData%Df_minus1)) call RegPack(Buf, InData%Df_minus1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Df_c_minus1)) if (allocated(InData%Df_c_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%Df_c_minus1), ubound(InData%Df_c_minus1)) call RegPack(Buf, InData%Df_c_minus1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Df_m_minus1)) if (allocated(InData%Df_m_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%Df_m_minus1), ubound(InData%Df_m_minus1)) call RegPack(Buf, InData%Df_m_minus1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Dalphaf_minus1)) if (allocated(InData%Dalphaf_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%Dalphaf_minus1), ubound(InData%Dalphaf_minus1)) call RegPack(Buf, InData%Dalphaf_minus1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%alphaf_minus1)) if (allocated(InData%alphaf_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%alphaf_minus1), ubound(InData%alphaf_minus1)) call RegPack(Buf, InData%alphaf_minus1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%fprime_minus1)) if (allocated(InData%fprime_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%fprime_minus1), ubound(InData%fprime_minus1)) call RegPack(Buf, InData%fprime_minus1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%fprime_c_minus1)) if (allocated(InData%fprime_c_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%fprime_c_minus1), ubound(InData%fprime_c_minus1)) call RegPack(Buf, InData%fprime_c_minus1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%fprime_m_minus1)) if (allocated(InData%fprime_m_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%fprime_m_minus1), ubound(InData%fprime_m_minus1)) call RegPack(Buf, InData%fprime_m_minus1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%tau_V)) if (allocated(InData%tau_V)) then call RegPackBounds(Buf, 2, lbound(InData%tau_V), ubound(InData%tau_V)) call RegPack(Buf, InData%tau_V) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%tau_V_minus1)) if (allocated(InData%tau_V_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%tau_V_minus1), ubound(InData%tau_V_minus1)) call RegPack(Buf, InData%tau_V_minus1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Cn_v_minus1)) if (allocated(InData%Cn_v_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%Cn_v_minus1), ubound(InData%Cn_v_minus1)) call RegPack(Buf, InData%Cn_v_minus1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%C_V_minus1)) if (allocated(InData%C_V_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%C_V_minus1), ubound(InData%C_V_minus1)) call RegPack(Buf, InData%C_V_minus1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Cn_prime_minus1)) if (allocated(InData%Cn_prime_minus1)) then call RegPackBounds(Buf, 2, lbound(InData%Cn_prime_minus1), ubound(InData%Cn_prime_minus1)) @@ -2602,79 +2506,66 @@ subroutine UA_PackOtherState(Buf, Indata) call RegPackBounds(Buf, 2, lbound(InData%FirstPass), ubound(InData%FirstPass)) call RegPack(Buf, InData%FirstPass) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%sigma1)) if (allocated(InData%sigma1)) then call RegPackBounds(Buf, 2, lbound(InData%sigma1), ubound(InData%sigma1)) call RegPack(Buf, InData%sigma1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%sigma1c)) if (allocated(InData%sigma1c)) then call RegPackBounds(Buf, 2, lbound(InData%sigma1c), ubound(InData%sigma1c)) call RegPack(Buf, InData%sigma1c) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%sigma1m)) if (allocated(InData%sigma1m)) then call RegPackBounds(Buf, 2, lbound(InData%sigma1m), ubound(InData%sigma1m)) call RegPack(Buf, InData%sigma1m) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%sigma3)) if (allocated(InData%sigma3)) then call RegPackBounds(Buf, 2, lbound(InData%sigma3), ubound(InData%sigma3)) call RegPack(Buf, InData%sigma3) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%n)) if (allocated(InData%n)) then call RegPackBounds(Buf, 2, lbound(InData%n), ubound(InData%n)) call RegPack(Buf, InData%n) end if - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%xdot) UB(1:1) = ubound(InData%xdot) do i1 = LB(1), UB(1) call UA_PackContState(Buf, InData%xdot(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%t_vortexBegin)) if (allocated(InData%t_vortexBegin)) then call RegPackBounds(Buf, 2, lbound(InData%t_vortexBegin), ubound(InData%t_vortexBegin)) call RegPack(Buf, InData%t_vortexBegin) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%SignOfOmega)) if (allocated(InData%SignOfOmega)) then call RegPackBounds(Buf, 2, lbound(InData%SignOfOmega), ubound(InData%SignOfOmega)) call RegPack(Buf, InData%SignOfOmega) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PositivePressure)) if (allocated(InData%PositivePressure)) then call RegPackBounds(Buf, 2, lbound(InData%PositivePressure), ubound(InData%PositivePressure)) call RegPack(Buf, InData%PositivePressure) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%vortexOn)) if (allocated(InData%vortexOn)) then call RegPackBounds(Buf, 2, lbound(InData%vortexOn), ubound(InData%vortexOn)) call RegPack(Buf, InData%vortexOn) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BelowThreshold)) if (allocated(InData%BelowThreshold)) then call RegPackBounds(Buf, 2, lbound(InData%BelowThreshold), ubound(InData%BelowThreshold)) call RegPack(Buf, InData%BelowThreshold) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%activeL)) if (allocated(InData%activeL)) then call RegPackBounds(Buf, 2, lbound(InData%activeL), ubound(InData%activeL)) call RegPack(Buf, InData%activeL) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%activeD)) if (allocated(InData%activeD)) then call RegPackBounds(Buf, 2, lbound(InData%activeD), ubound(InData%activeD)) @@ -3014,41 +2905,33 @@ subroutine UA_PackMisc(Buf, Indata) character(*), parameter :: RoutineName = 'UA_PackMisc' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%FirstWarn_M) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FirstWarn_UA) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FirstWarn_UA_off) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TESF)) if (allocated(InData%TESF)) then call RegPackBounds(Buf, 2, lbound(InData%TESF), ubound(InData%TESF)) call RegPack(Buf, InData%TESF) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LESF)) if (allocated(InData%LESF)) then call RegPackBounds(Buf, 2, lbound(InData%LESF), ubound(InData%LESF)) call RegPack(Buf, InData%LESF) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%VRTX)) if (allocated(InData%VRTX)) then call RegPackBounds(Buf, 2, lbound(InData%VRTX), ubound(InData%VRTX)) call RegPack(Buf, InData%VRTX) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%T_Sh)) if (allocated(InData%T_Sh)) then call RegPackBounds(Buf, 2, lbound(InData%T_Sh), ubound(InData%T_Sh)) call RegPack(Buf, InData%T_Sh) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BEDSEP)) if (allocated(InData%BEDSEP)) then call RegPackBounds(Buf, 2, lbound(InData%BEDSEP), ubound(InData%BEDSEP)) call RegPack(Buf, InData%BEDSEP) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%weight)) if (allocated(InData%weight)) then call RegPackBounds(Buf, 2, lbound(InData%weight), ubound(InData%weight)) @@ -3233,39 +3116,24 @@ subroutine UA_PackParam(Buf, Indata) character(*), parameter :: RoutineName = 'UA_PackParam' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%dt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%c)) if (allocated(InData%c)) then call RegPackBounds(Buf, 2, lbound(InData%c), ubound(InData%c)) call RegPack(Buf, InData%c) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%numBlades) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nNodesPerBlade) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UAMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Flookup) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%a_s) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutSwtch) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutFmt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutSFmt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Delim) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UnOutFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ShedEffect) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%lin_nx) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%UA_off_forGood)) if (allocated(InData%UA_off_forGood)) then call RegPackBounds(Buf, 2, lbound(InData%UA_off_forGood), ubound(InData%UA_off_forGood)) @@ -3372,15 +3240,10 @@ subroutine UA_PackInput(Buf, Indata) character(*), parameter :: RoutineName = 'UA_PackInput' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%U) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%alpha) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Re) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UserProp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%v_ac) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%omega) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3454,15 +3317,10 @@ subroutine UA_PackOutput(Buf, Indata) character(*), parameter :: RoutineName = 'UA_PackOutput' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%Cn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Cc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Cm) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Cl) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Cd) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) diff --git a/modules/aerodyn14/src/AeroDyn14_Types.f90 b/modules/aerodyn14/src/AeroDyn14_Types.f90 index 8fad99c412..db0ad1da7e 100644 --- a/modules/aerodyn14/src/AeroDyn14_Types.f90 +++ b/modules/aerodyn14/src/AeroDyn14_Types.f90 @@ -501,11 +501,8 @@ subroutine AD14_PackMarker(Buf, Indata) character(*), parameter :: RoutineName = 'AD14_PackMarker' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%Position) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Orientation) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TranslationVel) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RotationVel) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -618,21 +615,13 @@ subroutine AD14_PackAeroConfig(Buf, Indata) call AD14_PackMarker(Buf, InData%Blade(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call AD14_PackMarker(Buf, InData%Hub) - if (RegCheckErr(Buf, RoutineName)) return call AD14_PackMarker(Buf, InData%RotorFurl) - if (RegCheckErr(Buf, RoutineName)) return call AD14_PackMarker(Buf, InData%Nacelle) - if (RegCheckErr(Buf, RoutineName)) return call AD14_PackMarker(Buf, InData%TailFin) - if (RegCheckErr(Buf, RoutineName)) return call AD14_PackMarker(Buf, InData%Tower) - if (RegCheckErr(Buf, RoutineName)) return call AD14_PackMarker(Buf, InData%SubStructure) - if (RegCheckErr(Buf, RoutineName)) return call AD14_PackMarker(Buf, InData%Foundation) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BladeLength) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -774,27 +763,22 @@ subroutine AD14_PackAirFoil(Buf, Indata) call RegPackBounds(Buf, 2, lbound(InData%AL), ubound(InData%AL)) call RegPack(Buf, InData%AL) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CD)) if (allocated(InData%CD)) then call RegPackBounds(Buf, 3, lbound(InData%CD), ubound(InData%CD)) call RegPack(Buf, InData%CD) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CL)) if (allocated(InData%CL)) then call RegPackBounds(Buf, 3, lbound(InData%CL), ubound(InData%CL)) call RegPack(Buf, InData%CL) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CM)) if (allocated(InData%CM)) then call RegPackBounds(Buf, 3, lbound(InData%CM), ubound(InData%CM)) call RegPack(Buf, InData%CM) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PMC) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MulTabLoc) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -985,35 +969,28 @@ subroutine AD14_PackAirFoilParms(Buf, Indata) character(*), parameter :: RoutineName = 'AD14_PackAirFoilParms' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%MaxTable) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%NTables)) if (allocated(InData%NTables)) then call RegPackBounds(Buf, 1, lbound(InData%NTables), ubound(InData%NTables)) call RegPack(Buf, InData%NTables) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%NLift)) if (allocated(InData%NLift)) then call RegPackBounds(Buf, 1, lbound(InData%NLift), ubound(InData%NLift)) call RegPack(Buf, InData%NLift) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumCL) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumFoil) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%NFoil)) if (allocated(InData%NFoil)) then call RegPackBounds(Buf, 1, lbound(InData%NFoil), ubound(InData%NFoil)) call RegPack(Buf, InData%NFoil) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%MulTabMet)) if (allocated(InData%MulTabMet)) then call RegPackBounds(Buf, 2, lbound(InData%MulTabMet), ubound(InData%MulTabMet)) call RegPack(Buf, InData%MulTabMet) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FoilNm)) if (allocated(InData%FoilNm)) then call RegPackBounds(Buf, 1, lbound(InData%FoilNm), ubound(InData%FoilNm)) @@ -2037,337 +2014,273 @@ subroutine AD14_PackBeddoes(Buf, Indata) call RegPackBounds(Buf, 2, lbound(InData%ADOT), ubound(InData%ADOT)) call RegPack(Buf, InData%ADOT) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ADOT1)) if (allocated(InData%ADOT1)) then call RegPackBounds(Buf, 2, lbound(InData%ADOT1), ubound(InData%ADOT1)) call RegPack(Buf, InData%ADOT1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AFE)) if (allocated(InData%AFE)) then call RegPackBounds(Buf, 2, lbound(InData%AFE), ubound(InData%AFE)) call RegPack(Buf, InData%AFE) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AFE1)) if (allocated(InData%AFE1)) then call RegPackBounds(Buf, 2, lbound(InData%AFE1), ubound(InData%AFE1)) call RegPack(Buf, InData%AFE1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AN) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ANE)) if (allocated(InData%ANE)) then call RegPackBounds(Buf, 2, lbound(InData%ANE), ubound(InData%ANE)) call RegPack(Buf, InData%ANE) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ANE1)) if (allocated(InData%ANE1)) then call RegPackBounds(Buf, 2, lbound(InData%ANE1), ubound(InData%ANE1)) call RegPack(Buf, InData%ANE1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AOD)) if (allocated(InData%AOD)) then call RegPackBounds(Buf, 2, lbound(InData%AOD), ubound(InData%AOD)) call RegPack(Buf, InData%AOD) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AOL)) if (allocated(InData%AOL)) then call RegPackBounds(Buf, 2, lbound(InData%AOL), ubound(InData%AOL)) call RegPack(Buf, InData%AOL) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BEDSEP)) if (allocated(InData%BEDSEP)) then call RegPackBounds(Buf, 2, lbound(InData%BEDSEP), ubound(InData%BEDSEP)) call RegPack(Buf, InData%BEDSEP) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OLDSEP)) if (allocated(InData%OLDSEP)) then call RegPackBounds(Buf, 2, lbound(InData%OLDSEP), ubound(InData%OLDSEP)) call RegPack(Buf, InData%OLDSEP) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CC) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CDO)) if (allocated(InData%CDO)) then call RegPackBounds(Buf, 2, lbound(InData%CDO), ubound(InData%CDO)) call RegPack(Buf, InData%CDO) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CMI) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CMQ) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CN) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CNA)) if (allocated(InData%CNA)) then call RegPackBounds(Buf, 2, lbound(InData%CNA), ubound(InData%CNA)) call RegPack(Buf, InData%CNA) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CNCP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CNIQ) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CNP)) if (allocated(InData%CNP)) then call RegPackBounds(Buf, 2, lbound(InData%CNP), ubound(InData%CNP)) call RegPack(Buf, InData%CNP) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CNP1)) if (allocated(InData%CNP1)) then call RegPackBounds(Buf, 2, lbound(InData%CNP1), ubound(InData%CNP1)) call RegPack(Buf, InData%CNP1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CNPD)) if (allocated(InData%CNPD)) then call RegPackBounds(Buf, 2, lbound(InData%CNPD), ubound(InData%CNPD)) call RegPack(Buf, InData%CNPD) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CNPD1)) if (allocated(InData%CNPD1)) then call RegPackBounds(Buf, 2, lbound(InData%CNPD1), ubound(InData%CNPD1)) call RegPack(Buf, InData%CNPD1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CNPOT)) if (allocated(InData%CNPOT)) then call RegPackBounds(Buf, 2, lbound(InData%CNPOT), ubound(InData%CNPOT)) call RegPack(Buf, InData%CNPOT) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CNPOT1)) if (allocated(InData%CNPOT1)) then call RegPackBounds(Buf, 2, lbound(InData%CNPOT1), ubound(InData%CNPOT1)) call RegPack(Buf, InData%CNPOT1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CNS)) if (allocated(InData%CNS)) then call RegPackBounds(Buf, 2, lbound(InData%CNS), ubound(InData%CNS)) call RegPack(Buf, InData%CNS) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CNSL)) if (allocated(InData%CNSL)) then call RegPackBounds(Buf, 2, lbound(InData%CNSL), ubound(InData%CNSL)) call RegPack(Buf, InData%CNSL) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CNV)) if (allocated(InData%CNV)) then call RegPackBounds(Buf, 2, lbound(InData%CNV), ubound(InData%CNV)) call RegPack(Buf, InData%CNV) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CVN)) if (allocated(InData%CVN)) then call RegPackBounds(Buf, 2, lbound(InData%CVN), ubound(InData%CVN)) call RegPack(Buf, InData%CVN) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CVN1)) if (allocated(InData%CVN1)) then call RegPackBounds(Buf, 2, lbound(InData%CVN1), ubound(InData%CVN1)) call RegPack(Buf, InData%CVN1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%DF)) if (allocated(InData%DF)) then call RegPackBounds(Buf, 2, lbound(InData%DF), ubound(InData%DF)) call RegPack(Buf, InData%DF) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%DFAFE)) if (allocated(InData%DFAFE)) then call RegPackBounds(Buf, 2, lbound(InData%DFAFE), ubound(InData%DFAFE)) call RegPack(Buf, InData%DFAFE) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%DFAFE1)) if (allocated(InData%DFAFE1)) then call RegPackBounds(Buf, 2, lbound(InData%DFAFE1), ubound(InData%DFAFE1)) call RegPack(Buf, InData%DFAFE1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%DFC)) if (allocated(InData%DFC)) then call RegPackBounds(Buf, 2, lbound(InData%DFC), ubound(InData%DFC)) call RegPack(Buf, InData%DFC) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%DN)) if (allocated(InData%DN)) then call RegPackBounds(Buf, 2, lbound(InData%DN), ubound(InData%DN)) call RegPack(Buf, InData%DN) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%DPP)) if (allocated(InData%DPP)) then call RegPackBounds(Buf, 2, lbound(InData%DPP), ubound(InData%DPP)) call RegPack(Buf, InData%DPP) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%DQ)) if (allocated(InData%DQ)) then call RegPackBounds(Buf, 2, lbound(InData%DQ), ubound(InData%DQ)) call RegPack(Buf, InData%DQ) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%DQP)) if (allocated(InData%DQP)) then call RegPackBounds(Buf, 2, lbound(InData%DQP), ubound(InData%DQP)) call RegPack(Buf, InData%DQP) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%DQP1)) if (allocated(InData%DQP1)) then call RegPackBounds(Buf, 2, lbound(InData%DQP1), ubound(InData%DQP1)) call RegPack(Buf, InData%DQP1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DS) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FK) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FPC) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FSP)) if (allocated(InData%FSP)) then call RegPackBounds(Buf, 2, lbound(InData%FSP), ubound(InData%FSP)) call RegPack(Buf, InData%FSP) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FSP1)) if (allocated(InData%FSP1)) then call RegPackBounds(Buf, 2, lbound(InData%FSP1), ubound(InData%FSP1)) call RegPack(Buf, InData%FSP1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FSPC)) if (allocated(InData%FSPC)) then call RegPackBounds(Buf, 2, lbound(InData%FSPC), ubound(InData%FSPC)) call RegPack(Buf, InData%FSPC) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FSPC1)) if (allocated(InData%FSPC1)) then call RegPackBounds(Buf, 2, lbound(InData%FSPC1), ubound(InData%FSPC1)) call RegPack(Buf, InData%FSPC1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FTB)) if (allocated(InData%FTB)) then call RegPackBounds(Buf, 3, lbound(InData%FTB), ubound(InData%FTB)) call RegPack(Buf, InData%FTB) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FTBC)) if (allocated(InData%FTBC)) then call RegPackBounds(Buf, 3, lbound(InData%FTBC), ubound(InData%FTBC)) call RegPack(Buf, InData%FTBC) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OLDCNV)) if (allocated(InData%OLDCNV)) then call RegPackBounds(Buf, 2, lbound(InData%OLDCNV), ubound(InData%OLDCNV)) call RegPack(Buf, InData%OLDCNV) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OLDDF)) if (allocated(InData%OLDDF)) then call RegPackBounds(Buf, 2, lbound(InData%OLDDF), ubound(InData%OLDDF)) call RegPack(Buf, InData%OLDDF) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OLDDFC)) if (allocated(InData%OLDDFC)) then call RegPackBounds(Buf, 2, lbound(InData%OLDDFC), ubound(InData%OLDDFC)) call RegPack(Buf, InData%OLDDFC) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OLDDN)) if (allocated(InData%OLDDN)) then call RegPackBounds(Buf, 2, lbound(InData%OLDDN), ubound(InData%OLDDN)) call RegPack(Buf, InData%OLDDN) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OLDDPP)) if (allocated(InData%OLDDPP)) then call RegPackBounds(Buf, 2, lbound(InData%OLDDPP), ubound(InData%OLDDPP)) call RegPack(Buf, InData%OLDDPP) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OLDDQ)) if (allocated(InData%OLDDQ)) then call RegPackBounds(Buf, 2, lbound(InData%OLDDQ), ubound(InData%OLDDQ)) call RegPack(Buf, InData%OLDDQ) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OLDTAU)) if (allocated(InData%OLDTAU)) then call RegPackBounds(Buf, 2, lbound(InData%OLDTAU), ubound(InData%OLDTAU)) call RegPack(Buf, InData%OLDTAU) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OLDXN)) if (allocated(InData%OLDXN)) then call RegPackBounds(Buf, 2, lbound(InData%OLDXN), ubound(InData%OLDXN)) call RegPack(Buf, InData%OLDXN) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OLDYN)) if (allocated(InData%OLDYN)) then call RegPackBounds(Buf, 2, lbound(InData%OLDYN), ubound(InData%OLDYN)) call RegPack(Buf, InData%OLDYN) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%QX)) if (allocated(InData%QX)) then call RegPackBounds(Buf, 2, lbound(InData%QX), ubound(InData%QX)) call RegPack(Buf, InData%QX) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%QX1)) if (allocated(InData%QX1)) then call RegPackBounds(Buf, 2, lbound(InData%QX1), ubound(InData%QX1)) call RegPack(Buf, InData%QX1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TAU)) if (allocated(InData%TAU)) then call RegPackBounds(Buf, 2, lbound(InData%TAU), ubound(InData%TAU)) call RegPack(Buf, InData%TAU) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%XN)) if (allocated(InData%XN)) then call RegPackBounds(Buf, 2, lbound(InData%XN), ubound(InData%XN)) call RegPack(Buf, InData%XN) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%YN)) if (allocated(InData%YN)) then call RegPackBounds(Buf, 2, lbound(InData%YN), ubound(InData%YN)) call RegPack(Buf, InData%YN) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SHIFT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VOR) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3167,13 +3080,9 @@ subroutine AD14_PackBeddoesParms(Buf, Indata) character(*), parameter :: RoutineName = 'AD14_PackBeddoesParms' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%AS) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TV) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TVL) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3263,15 +3172,12 @@ subroutine AD14_PackBladeParms(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%C), ubound(InData%C)) call RegPack(Buf, InData%C) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%DR)) if (allocated(InData%DR)) then call RegPackBounds(Buf, 1, lbound(InData%DR), ubound(InData%DR)) call RegPack(Buf, InData%DR) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%R) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BladeLength) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3404,63 +3310,38 @@ subroutine AD14_PackDynInflow(Buf, Indata) character(*), parameter :: RoutineName = 'AD14_PackDynInflow' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%dAlph_dt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dBeta_dt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DTO) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%old_Alph) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%old_Beta) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%old_LmdM) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%oldKai) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PhiLqC) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PhiLqS) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Pzero) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RMC_SAVE)) if (allocated(InData%RMC_SAVE)) then call RegPackBounds(Buf, 3, lbound(InData%RMC_SAVE), ubound(InData%RMC_SAVE)) call RegPack(Buf, InData%RMC_SAVE) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RMS_SAVE)) if (allocated(InData%RMS_SAVE)) then call RegPackBounds(Buf, 3, lbound(InData%RMS_SAVE), ubound(InData%RMS_SAVE)) call RegPack(Buf, InData%RMS_SAVE) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TipSpeed) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%totalInf) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Vparam) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Vtotal) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%xAlpha) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%xBeta) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%xKai) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%XLAMBDA_M) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%xLcos) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%xLsin) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MminR) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MminusR) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MplusR) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%GAMMA) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3579,7 +3460,6 @@ subroutine AD14_PackDynInflowParms(Buf, Indata) character(*), parameter :: RoutineName = 'AD14_PackDynInflowParms' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%MAXINFLO) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%xMinv) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3746,37 +3626,31 @@ subroutine AD14_PackElement(Buf, Indata) call RegPackBounds(Buf, 2, lbound(InData%A), ubound(InData%A)) call RegPack(Buf, InData%A) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AP)) if (allocated(InData%AP)) then call RegPackBounds(Buf, 2, lbound(InData%AP), ubound(InData%AP)) call RegPack(Buf, InData%AP) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ALPHA)) if (allocated(InData%ALPHA)) then call RegPackBounds(Buf, 2, lbound(InData%ALPHA), ubound(InData%ALPHA)) call RegPack(Buf, InData%ALPHA) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%W2)) if (allocated(InData%W2)) then call RegPackBounds(Buf, 2, lbound(InData%W2), ubound(InData%W2)) call RegPack(Buf, InData%W2) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OLD_A_NS)) if (allocated(InData%OLD_A_NS)) then call RegPackBounds(Buf, 2, lbound(InData%OLD_A_NS), ubound(InData%OLD_A_NS)) call RegPack(Buf, InData%OLD_A_NS) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OLD_AP_NS)) if (allocated(InData%OLD_AP_NS)) then call RegPackBounds(Buf, 2, lbound(InData%OLD_AP_NS), ubound(InData%OLD_AP_NS)) call RegPack(Buf, InData%OLD_AP_NS) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PITNOW)) if (allocated(InData%PITNOW)) then call RegPackBounds(Buf, 2, lbound(InData%PITNOW), ubound(InData%PITNOW)) @@ -3990,25 +3864,21 @@ subroutine AD14_PackElementParms(Buf, Indata) character(*), parameter :: RoutineName = 'AD14_PackElementParms' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%NELM) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TWIST)) if (allocated(InData%TWIST)) then call RegPackBounds(Buf, 1, lbound(InData%TWIST), ubound(InData%TWIST)) call RegPack(Buf, InData%TWIST) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RELM)) if (allocated(InData%RELM)) then call RegPackBounds(Buf, 1, lbound(InData%RELM), ubound(InData%RELM)) call RegPack(Buf, InData%RELM) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%HLCNST)) if (allocated(InData%HLCNST)) then call RegPackBounds(Buf, 1, lbound(InData%HLCNST), ubound(InData%HLCNST)) call RegPack(Buf, InData%HLCNST) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TLCNST)) if (allocated(InData%TLCNST)) then call RegPackBounds(Buf, 1, lbound(InData%TLCNST), ubound(InData%TLCNST)) @@ -4496,141 +4366,115 @@ subroutine AD14_PackElOutParms(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%AAA), ubound(InData%AAA)) call RegPack(Buf, InData%AAA) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AAP)) if (allocated(InData%AAP)) then call RegPackBounds(Buf, 1, lbound(InData%AAP), ubound(InData%AAP)) call RegPack(Buf, InData%AAP) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ALF)) if (allocated(InData%ALF)) then call RegPackBounds(Buf, 1, lbound(InData%ALF), ubound(InData%ALF)) call RegPack(Buf, InData%ALF) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CDD)) if (allocated(InData%CDD)) then call RegPackBounds(Buf, 1, lbound(InData%CDD), ubound(InData%CDD)) call RegPack(Buf, InData%CDD) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CLL)) if (allocated(InData%CLL)) then call RegPackBounds(Buf, 1, lbound(InData%CLL), ubound(InData%CLL)) call RegPack(Buf, InData%CLL) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CMM)) if (allocated(InData%CMM)) then call RegPackBounds(Buf, 1, lbound(InData%CMM), ubound(InData%CMM)) call RegPack(Buf, InData%CMM) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CNN)) if (allocated(InData%CNN)) then call RegPackBounds(Buf, 1, lbound(InData%CNN), ubound(InData%CNN)) call RegPack(Buf, InData%CNN) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CTT)) if (allocated(InData%CTT)) then call RegPackBounds(Buf, 1, lbound(InData%CTT), ubound(InData%CTT)) call RegPack(Buf, InData%CTT) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%DFNSAV)) if (allocated(InData%DFNSAV)) then call RegPackBounds(Buf, 1, lbound(InData%DFNSAV), ubound(InData%DFNSAV)) call RegPack(Buf, InData%DFNSAV) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%DFTSAV)) if (allocated(InData%DFTSAV)) then call RegPackBounds(Buf, 1, lbound(InData%DFTSAV), ubound(InData%DFTSAV)) call RegPack(Buf, InData%DFTSAV) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%DynPres)) if (allocated(InData%DynPres)) then call RegPackBounds(Buf, 1, lbound(InData%DynPres), ubound(InData%DynPres)) call RegPack(Buf, InData%DynPres) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PMM)) if (allocated(InData%PMM)) then call RegPackBounds(Buf, 1, lbound(InData%PMM), ubound(InData%PMM)) call RegPack(Buf, InData%PMM) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PITSAV)) if (allocated(InData%PITSAV)) then call RegPackBounds(Buf, 1, lbound(InData%PITSAV), ubound(InData%PITSAV)) call RegPack(Buf, InData%PITSAV) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ReyNum)) if (allocated(InData%ReyNum)) then call RegPackBounds(Buf, 1, lbound(InData%ReyNum), ubound(InData%ReyNum)) call RegPack(Buf, InData%ReyNum) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Gamma)) if (allocated(InData%Gamma)) then call RegPackBounds(Buf, 1, lbound(InData%Gamma), ubound(InData%Gamma)) call RegPack(Buf, InData%Gamma) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%SaveVX)) if (allocated(InData%SaveVX)) then call RegPackBounds(Buf, 2, lbound(InData%SaveVX), ubound(InData%SaveVX)) call RegPack(Buf, InData%SaveVX) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%SaveVY)) if (allocated(InData%SaveVY)) then call RegPackBounds(Buf, 2, lbound(InData%SaveVY), ubound(InData%SaveVY)) call RegPack(Buf, InData%SaveVY) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%SaveVZ)) if (allocated(InData%SaveVZ)) then call RegPackBounds(Buf, 2, lbound(InData%SaveVZ), ubound(InData%SaveVZ)) call RegPack(Buf, InData%SaveVZ) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VXSAV) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VYSAV) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VZSAV) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumWndElOut) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WndElPrList)) if (allocated(InData%WndElPrList)) then call RegPackBounds(Buf, 1, lbound(InData%WndElPrList), ubound(InData%WndElPrList)) call RegPack(Buf, InData%WndElPrList) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WndElPrNum)) if (allocated(InData%WndElPrNum)) then call RegPackBounds(Buf, 1, lbound(InData%WndElPrNum), ubound(InData%WndElPrNum)) call RegPack(Buf, InData%WndElPrNum) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ElPrList)) if (allocated(InData%ElPrList)) then call RegPackBounds(Buf, 1, lbound(InData%ElPrList), ubound(InData%ElPrList)) call RegPack(Buf, InData%ElPrList) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ElPrNum)) if (allocated(InData%ElPrNum)) then call RegPackBounds(Buf, 1, lbound(InData%ElPrNum), ubound(InData%ElPrNum)) call RegPack(Buf, InData%ElPrNum) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumElOut) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -5035,17 +4879,11 @@ subroutine AD14_PackInducedVelParms(Buf, Indata) character(*), parameter :: RoutineName = 'AD14_PackInducedVelParms' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%AToler) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%EqAIDmult) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%EquilDA) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%EquilDT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TLoss) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%GTech) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HLoss) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -5106,21 +4944,13 @@ subroutine AD14_PackRotor(Buf, Indata) character(*), parameter :: RoutineName = 'AD14_PackRotor' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%AVGINFL) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CTILT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CYaw) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%REVS) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%STILT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SYaw) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TILT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YawAng) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YawVEL) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -5339,63 +5169,42 @@ subroutine AD14_PackTwrPropsParms(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%TwrHtFr), ubound(InData%TwrHtFr)) call RegPack(Buf, InData%TwrHtFr) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TwrWid)) if (allocated(InData%TwrWid)) then call RegPackBounds(Buf, 1, lbound(InData%TwrWid), ubound(InData%TwrWid)) call RegPack(Buf, InData%TwrWid) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TwrCD)) if (allocated(InData%TwrCD)) then call RegPackBounds(Buf, 2, lbound(InData%TwrCD), ubound(InData%TwrCD)) call RegPack(Buf, InData%TwrCD) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TwrRe)) if (allocated(InData%TwrRe)) then call RegPackBounds(Buf, 1, lbound(InData%TwrRe), ubound(InData%TwrRe)) call RegPack(Buf, InData%TwrRe) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VTwr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Tower_Wake_Constant) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%NTwrCDCol)) if (allocated(InData%NTwrCDCol)) then call RegPackBounds(Buf, 1, lbound(InData%NTwrCDCol), ubound(InData%NTwrCDCol)) call RegPack(Buf, InData%NTwrCDCol) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NTwrHT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NTwrRe) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NTwrCD) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TwrPotent) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TwrShadow) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ShadHWid) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TShadC1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TShadC2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TwrShad) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PJM_Version) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TwrFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%T_Shad_Refpt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CalcTwrAero) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumTwrNodes) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TwrNodeWidth)) if (allocated(InData%TwrNodeWidth)) then call RegPackBounds(Buf, 1, lbound(InData%TwrNodeWidth), ubound(InData%TwrNodeWidth)) @@ -5562,15 +5371,10 @@ subroutine AD14_PackWind(Buf, Indata) character(*), parameter :: RoutineName = 'AD14_PackWind' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%ANGFLW) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CDEL) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VROTORX) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VROTORY) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VROTORZ) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SDEL) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -5622,7 +5426,6 @@ subroutine AD14_PackWindParms(Buf, Indata) character(*), parameter :: RoutineName = 'AD14_PackWindParms' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%Rho) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%KinVisc) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -5780,33 +5583,21 @@ subroutine AD14_PackInitInput(Buf, Indata) character(*), parameter :: RoutineName = 'AD14_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%Title) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutRootName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ADFileName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WrSumFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumBl) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BladeLength) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LinearizeFlag) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UseDWM) - if (RegCheckErr(Buf, RoutineName)) return call AD14_PackAeroConfig(Buf, InData%TurbineComponents) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumTwrNodes) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TwrNodeLocs)) if (allocated(InData%TwrNodeLocs)) then call RegPackBounds(Buf, 2, lbound(InData%TwrNodeLocs), ubound(InData%TwrNodeLocs)) call RegPack(Buf, InData%TwrNodeLocs) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HubHt) - if (RegCheckErr(Buf, RoutineName)) return call DWM_PackInitInput(Buf, InData%DWM) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -5894,9 +5685,7 @@ subroutine AD14_PackInitOutput(Buf, Indata) character(*), parameter :: RoutineName = 'AD14_PackInitOutput' if (Buf%ErrStat >= AbortErrLev) return call NWTC_Library_PackProgDesc(Buf, InData%Ver) - if (RegCheckErr(Buf, RoutineName)) return call DWM_PackInitOutput(Buf, InData%DWM) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AirDens) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -6219,71 +6008,42 @@ subroutine AD14_PackMisc(Buf, Indata) character(*), parameter :: RoutineName = 'AD14_PackMisc' if (Buf%ErrStat >= AbortErrLev) return call DWM_PackMisc(Buf, InData%DWM) - if (RegCheckErr(Buf, RoutineName)) return call DWM_PackInput(Buf, InData%DWM_Inputs) - if (RegCheckErr(Buf, RoutineName)) return call DWM_PackOutput(Buf, InData%DWM_Outputs) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ElPrNum)) if (allocated(InData%ElPrNum)) then call RegPackBounds(Buf, 1, lbound(InData%ElPrNum), ubound(InData%ElPrNum)) call RegPack(Buf, InData%ElPrNum) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OldTime) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HubLoss) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Loss) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TipLoss) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TLpt7) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FirstPassGTL) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SuperSonic) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AFLAGVinderr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AFLAGTwrInflu) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OnePassDynDbg) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NoLoadsCalculated) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NERRORS) - if (RegCheckErr(Buf, RoutineName)) return call AD14_PackAirFoil(Buf, InData%AirFoil) - if (RegCheckErr(Buf, RoutineName)) return call AD14_PackBeddoes(Buf, InData%Beddoes) - if (RegCheckErr(Buf, RoutineName)) return call AD14_PackDynInflow(Buf, InData%DynInflow) - if (RegCheckErr(Buf, RoutineName)) return call AD14_PackElement(Buf, InData%Element) - if (RegCheckErr(Buf, RoutineName)) return call AD14_PackRotor(Buf, InData%Rotor) - if (RegCheckErr(Buf, RoutineName)) return call AD14_PackWind(Buf, InData%Wind) - if (RegCheckErr(Buf, RoutineName)) return call AD14_PackInducedVel(Buf, InData%InducedVel) - if (RegCheckErr(Buf, RoutineName)) return call AD14_PackElOutParms(Buf, InData%ElOut) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Skew) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DynInit) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FirstWarn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%StoredForces)) if (allocated(InData%StoredForces)) then call RegPackBounds(Buf, 3, lbound(InData%StoredForces), ubound(InData%StoredForces)) call RegPack(Buf, InData%StoredForces) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%StoredMoments)) if (allocated(InData%StoredMoments)) then call RegPackBounds(Buf, 3, lbound(InData%StoredMoments), ubound(InData%StoredMoments)) @@ -6472,73 +6232,39 @@ subroutine AD14_PackParam(Buf, Indata) character(*), parameter :: RoutineName = 'AD14_PackParam' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%Title) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SIUnit) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Echo) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MultiTab) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LinearizeFlag) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutputPlottingInfo) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UseDWM) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TwoPiNB) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumBl) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NBlInpSt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ElemPrn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DStall) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PMoment) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Reynolds) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DynInfl) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Wake) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Swirl) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DtAero) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HubRad) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UnEc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UnElem) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UnWndOut) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MAXICOUNT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WrOptFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DEFAULT_Wind) - if (RegCheckErr(Buf, RoutineName)) return call AD14_PackAirFoilParms(Buf, InData%AirFoil) - if (RegCheckErr(Buf, RoutineName)) return call AD14_PackBladeParms(Buf, InData%Blade) - if (RegCheckErr(Buf, RoutineName)) return call AD14_PackBeddoesParms(Buf, InData%Beddoes) - if (RegCheckErr(Buf, RoutineName)) return call AD14_PackDynInflowParms(Buf, InData%DynInflow) - if (RegCheckErr(Buf, RoutineName)) return call AD14_PackElementParms(Buf, InData%Element) - if (RegCheckErr(Buf, RoutineName)) return call AD14_PackTwrPropsParms(Buf, InData%TwrProps) - if (RegCheckErr(Buf, RoutineName)) return call AD14_PackInducedVelParms(Buf, InData%InducedVel) - if (RegCheckErr(Buf, RoutineName)) return call AD14_PackWindParms(Buf, InData%Wind) - if (RegCheckErr(Buf, RoutineName)) return call AD14_PackRotorParms(Buf, InData%Rotor) - if (RegCheckErr(Buf, RoutineName)) return call DWM_PackParam(Buf, InData%DWM) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -6722,23 +6448,18 @@ subroutine AD14_PackInput(Buf, Indata) call MeshPack(Buf, InData%InputMarkers(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%Twr_InputMarkers) - if (RegCheckErr(Buf, RoutineName)) return call AD14_PackAeroConfig(Buf, InData%TurbineComponents) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%MulTabLoc)) if (allocated(InData%MulTabLoc)) then call RegPackBounds(Buf, 2, lbound(InData%MulTabLoc), ubound(InData%MulTabLoc)) call RegPack(Buf, InData%MulTabLoc) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%InflowVelocity)) if (allocated(InData%InflowVelocity)) then call RegPackBounds(Buf, 2, lbound(InData%InflowVelocity), ubound(InData%InflowVelocity)) call RegPack(Buf, InData%InflowVelocity) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AvgInfVel) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -6875,7 +6596,6 @@ subroutine AD14_PackOutput(Buf, Indata) call MeshPack(Buf, InData%OutputLoads(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%Twr_OutputLoads) if (RegCheckErr(Buf, RoutineName)) return end subroutine diff --git a/modules/aerodyn14/src/DWM_Types.f90 b/modules/aerodyn14/src/DWM_Types.f90 index 68e5f0cd53..42bd209073 100644 --- a/modules/aerodyn14/src/DWM_Types.f90 +++ b/modules/aerodyn14/src/DWM_Types.f90 @@ -356,9 +356,7 @@ subroutine DWM_PackCVSD(Buf, Indata) character(*), parameter :: RoutineName = 'DWM_PackCVSD' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%counter) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Denominator) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Numerator) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -479,29 +477,23 @@ subroutine DWM_Packturbine_average_velocity_data(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%average_velocity_array_temp), ubound(InData%average_velocity_array_temp)) call RegPack(Buf, InData%average_velocity_array_temp) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%average_velocity_array)) if (allocated(InData%average_velocity_array)) then call RegPackBounds(Buf, 1, lbound(InData%average_velocity_array), ubound(InData%average_velocity_array)) call RegPack(Buf, InData%average_velocity_array) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%swept_area)) if (allocated(InData%swept_area)) then call RegPackBounds(Buf, 1, lbound(InData%swept_area), ubound(InData%swept_area)) call RegPack(Buf, InData%swept_area) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%time_step_velocity) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%time_step_velocity_array)) if (allocated(InData%time_step_velocity_array)) then call RegPackBounds(Buf, 1, lbound(InData%time_step_velocity_array), ubound(InData%time_step_velocity_array)) call RegPack(Buf, InData%time_step_velocity_array) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%time_step_pass_velocity) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%time_step_force) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -628,19 +620,14 @@ subroutine DWM_PackWake_Deficit_Data(Buf, Indata) character(*), parameter :: RoutineName = 'DWM_PackWake_Deficit_Data' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%np_x) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%X_length) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Turb_Stress_DWM)) if (allocated(InData%Turb_Stress_DWM)) then call RegPackBounds(Buf, 2, lbound(InData%Turb_Stress_DWM), ubound(InData%Turb_Stress_DWM)) call RegPack(Buf, InData%Turb_Stress_DWM) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%n_x_vector) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%n_r_vector) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ppR) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -707,7 +694,6 @@ subroutine DWM_PackMeanderData(Buf, Indata) character(*), parameter :: RoutineName = 'DWM_PackMeanderData' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%scale_factor) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%moving_time) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1027,103 +1013,84 @@ subroutine DWM_Packread_turbine_position_data(Buf, Indata) character(*), parameter :: RoutineName = 'DWM_Packread_turbine_position_data' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%SimulationOrder_index) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Turbine_sort_order)) if (allocated(InData%Turbine_sort_order)) then call RegPackBounds(Buf, 1, lbound(InData%Turbine_sort_order), ubound(InData%Turbine_sort_order)) call RegPack(Buf, InData%Turbine_sort_order) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WT_index) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TurbineInfluenceData)) if (allocated(InData%TurbineInfluenceData)) then call RegPackBounds(Buf, 2, lbound(InData%TurbineInfluenceData), ubound(InData%TurbineInfluenceData)) call RegPack(Buf, InData%TurbineInfluenceData) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%upwind_turbine_index)) if (allocated(InData%upwind_turbine_index)) then call RegPackBounds(Buf, 1, lbound(InData%upwind_turbine_index), ubound(InData%upwind_turbine_index)) call RegPack(Buf, InData%upwind_turbine_index) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%downwind_turbine_index)) if (allocated(InData%downwind_turbine_index)) then call RegPackBounds(Buf, 1, lbound(InData%downwind_turbine_index), ubound(InData%downwind_turbine_index)) call RegPack(Buf, InData%downwind_turbine_index) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%upwindturbine_number) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%downwindturbine_number) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%turbine_windorigin_length)) if (allocated(InData%turbine_windorigin_length)) then call RegPackBounds(Buf, 1, lbound(InData%turbine_windorigin_length), ubound(InData%turbine_windorigin_length)) call RegPack(Buf, InData%turbine_windorigin_length) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%upwind_turbine_projected_distance)) if (allocated(InData%upwind_turbine_projected_distance)) then call RegPackBounds(Buf, 1, lbound(InData%upwind_turbine_projected_distance), ubound(InData%upwind_turbine_projected_distance)) call RegPack(Buf, InData%upwind_turbine_projected_distance) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%downwind_turbine_projected_distance)) if (allocated(InData%downwind_turbine_projected_distance)) then call RegPackBounds(Buf, 1, lbound(InData%downwind_turbine_projected_distance), ubound(InData%downwind_turbine_projected_distance)) call RegPack(Buf, InData%downwind_turbine_projected_distance) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%turbine_angle)) if (allocated(InData%turbine_angle)) then call RegPackBounds(Buf, 2, lbound(InData%turbine_angle), ubound(InData%turbine_angle)) call RegPack(Buf, InData%turbine_angle) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%upwind_align_angle)) if (allocated(InData%upwind_align_angle)) then call RegPackBounds(Buf, 1, lbound(InData%upwind_align_angle), ubound(InData%upwind_align_angle)) call RegPack(Buf, InData%upwind_align_angle) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%downwind_align_angle)) if (allocated(InData%downwind_align_angle)) then call RegPackBounds(Buf, 1, lbound(InData%downwind_align_angle), ubound(InData%downwind_align_angle)) call RegPack(Buf, InData%downwind_align_angle) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%upwind_turbine_Xcoor)) if (allocated(InData%upwind_turbine_Xcoor)) then call RegPackBounds(Buf, 1, lbound(InData%upwind_turbine_Xcoor), ubound(InData%upwind_turbine_Xcoor)) call RegPack(Buf, InData%upwind_turbine_Xcoor) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%upwind_turbine_Ycoor)) if (allocated(InData%upwind_turbine_Ycoor)) then call RegPackBounds(Buf, 1, lbound(InData%upwind_turbine_Ycoor), ubound(InData%upwind_turbine_Ycoor)) call RegPack(Buf, InData%upwind_turbine_Ycoor) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%wind_farm_Xcoor)) if (allocated(InData%wind_farm_Xcoor)) then call RegPackBounds(Buf, 1, lbound(InData%wind_farm_Xcoor), ubound(InData%wind_farm_Xcoor)) call RegPack(Buf, InData%wind_farm_Xcoor) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%wind_farm_Ycoor)) if (allocated(InData%wind_farm_Ycoor)) then call RegPackBounds(Buf, 1, lbound(InData%wind_farm_Ycoor), ubound(InData%wind_farm_Ycoor)) call RegPack(Buf, InData%wind_farm_Ycoor) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%downwind_turbine_Xcoor)) if (allocated(InData%downwind_turbine_Xcoor)) then call RegPackBounds(Buf, 1, lbound(InData%downwind_turbine_Xcoor), ubound(InData%downwind_turbine_Xcoor)) call RegPack(Buf, InData%downwind_turbine_Xcoor) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%downwind_turbine_Ycoor)) if (allocated(InData%downwind_turbine_Ycoor)) then call RegPackBounds(Buf, 1, lbound(InData%downwind_turbine_Ycoor), ubound(InData%downwind_turbine_Ycoor)) @@ -1424,7 +1391,6 @@ subroutine DWM_PackWeiMethod(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%sweptarea), ubound(InData%sweptarea)) call RegPack(Buf, InData%sweptarea) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%weighting_denominator) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1533,63 +1499,34 @@ subroutine DWM_PackTIDownstream(Buf, Indata) call RegPackBounds(Buf, 2, lbound(InData%TI_downstream_matrix), ubound(InData%TI_downstream_matrix)) call RegPack(Buf, InData%TI_downstream_matrix) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%i) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%j) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%k) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%cross_plane_position_ds) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%cross_plane_position_TI) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%distance_index) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%counter1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%counter2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%initial_timestep) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%y_axis_turbine) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%z_axis_turbine) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%distance) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TI_downstream_node) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TI_node_temp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TI_node) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TI_accumulation) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TI_apprant_accumulation) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TI_average) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TI_apprant) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HubHt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%wake_center_y) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%wake_center_z) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Rscale) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%y) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%z) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%zero_spacing) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%temp1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%temp2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%temp3) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1709,17 +1646,11 @@ subroutine DWM_PackTurbKaimal(Buf, Indata) character(*), parameter :: RoutineName = 'DWM_PackTurbKaimal' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%fs) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%temp_n) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%i) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%low_f) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%high_f) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%lk_facor) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%STD) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1870,45 +1801,33 @@ subroutine DWM_PackShinozuka(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%f_syn), ubound(InData%f_syn)) call RegPack(Buf, InData%f_syn) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%t_syn)) if (allocated(InData%t_syn)) then call RegPackBounds(Buf, 1, lbound(InData%t_syn), ubound(InData%t_syn)) call RegPack(Buf, InData%t_syn) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%phi)) if (allocated(InData%phi)) then call RegPackBounds(Buf, 1, lbound(InData%phi), ubound(InData%phi)) call RegPack(Buf, InData%phi) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%p_k)) if (allocated(InData%p_k)) then call RegPackBounds(Buf, 1, lbound(InData%p_k), ubound(InData%p_k)) call RegPack(Buf, InData%p_k) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%a_k)) if (allocated(InData%a_k)) then call RegPackBounds(Buf, 1, lbound(InData%a_k), ubound(InData%a_k)) call RegPack(Buf, InData%a_k) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%num_points) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ILo) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%i) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%j) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%t_min) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%t_max) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%df) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2080,15 +1999,10 @@ subroutine DWM_PackSWSV(Buf, Indata) character(*), parameter :: RoutineName = 'DWM_PackSWSV' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%p1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%p2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%distance) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%y0) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%z0) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%unit) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2331,61 +2245,51 @@ subroutine DWM_Packread_upwind_result(Buf, Indata) call RegPackBounds(Buf, 2, lbound(InData%upwind_U), ubound(InData%upwind_U)) call RegPack(Buf, InData%upwind_U) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%upwind_wakecenter)) if (allocated(InData%upwind_wakecenter)) then call RegPackBounds(Buf, 4, lbound(InData%upwind_wakecenter), ubound(InData%upwind_wakecenter)) call RegPack(Buf, InData%upwind_wakecenter) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%upwind_meanU)) if (allocated(InData%upwind_meanU)) then call RegPackBounds(Buf, 1, lbound(InData%upwind_meanU), ubound(InData%upwind_meanU)) call RegPack(Buf, InData%upwind_meanU) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%upwind_TI)) if (allocated(InData%upwind_TI)) then call RegPackBounds(Buf, 1, lbound(InData%upwind_TI), ubound(InData%upwind_TI)) call RegPack(Buf, InData%upwind_TI) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%upwind_small_TI)) if (allocated(InData%upwind_small_TI)) then call RegPackBounds(Buf, 1, lbound(InData%upwind_small_TI), ubound(InData%upwind_small_TI)) call RegPack(Buf, InData%upwind_small_TI) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%upwind_smoothWake)) if (allocated(InData%upwind_smoothWake)) then call RegPackBounds(Buf, 2, lbound(InData%upwind_smoothWake), ubound(InData%upwind_smoothWake)) call RegPack(Buf, InData%upwind_smoothWake) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%velocity_aerodyn)) if (allocated(InData%velocity_aerodyn)) then call RegPackBounds(Buf, 1, lbound(InData%velocity_aerodyn), ubound(InData%velocity_aerodyn)) call RegPack(Buf, InData%velocity_aerodyn) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TI_downstream)) if (allocated(InData%TI_downstream)) then call RegPackBounds(Buf, 1, lbound(InData%TI_downstream), ubound(InData%TI_downstream)) call RegPack(Buf, InData%TI_downstream) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%small_scale_TI_downstream)) if (allocated(InData%small_scale_TI_downstream)) then call RegPackBounds(Buf, 1, lbound(InData%small_scale_TI_downstream), ubound(InData%small_scale_TI_downstream)) call RegPack(Buf, InData%small_scale_TI_downstream) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%smoothed_velocity_array)) if (allocated(InData%smoothed_velocity_array)) then call RegPackBounds(Buf, 2, lbound(InData%smoothed_velocity_array), ubound(InData%smoothed_velocity_array)) call RegPack(Buf, InData%smoothed_velocity_array) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%vel_matrix)) if (allocated(InData%vel_matrix)) then call RegPackBounds(Buf, 3, lbound(InData%vel_matrix), ubound(InData%vel_matrix)) @@ -2663,9 +2567,7 @@ subroutine DWM_Packturbine_blade(Buf, Indata) character(*), parameter :: RoutineName = 'DWM_Packturbine_blade' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%Aerodyn_turbine_num) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Blade_index) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Element_index) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2813,69 +2715,43 @@ subroutine DWM_PackParam(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%velocityU), ubound(InData%velocityU)) call RegPack(Buf, InData%velocityU) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%smoothed_wake)) if (allocated(InData%smoothed_wake)) then call RegPackBounds(Buf, 1, lbound(InData%smoothed_wake), ubound(InData%smoothed_wake)) call RegPack(Buf, InData%smoothed_wake) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WakePosition)) if (allocated(InData%WakePosition)) then call RegPackBounds(Buf, 3, lbound(InData%WakePosition), ubound(InData%WakePosition)) call RegPack(Buf, InData%WakePosition) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WakePosition_1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WakePosition_2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%smooth_flag) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%p_p_r) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumWT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Tinfluencer) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RotorR) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%r_domain) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%x_domain) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Uambient) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TI_amb) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TI_wake) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%hub_height) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%length_velocityU) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WFLowerBd) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Wind_file_Mean_u) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Winddir) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%air_density) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RR) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ElementRad)) if (allocated(InData%ElementRad)) then call RegPackBounds(Buf, 1, lbound(InData%ElementRad), ubound(InData%ElementRad)) call RegPack(Buf, InData%ElementRad) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Bnum) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ElementNum) - if (RegCheckErr(Buf, RoutineName)) return call DWM_Packread_turbine_position_data(Buf, InData%RTPD) - if (RegCheckErr(Buf, RoutineName)) return call InflowWind_PackParam(Buf, InData%IfW) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3149,63 +3025,38 @@ subroutine DWM_PackMisc(Buf, Indata) character(*), parameter :: RoutineName = 'DWM_PackMisc' if (Buf%ErrStat >= AbortErrLev) return call InflowWind_PackMisc(Buf, InData%IfW) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%position_y) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%position_z) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%velocity_wake_mean) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%shifted_velocity_Aerodyn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%U_velocity) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%V_velocity) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Nforce)) if (allocated(InData%Nforce)) then call RegPackBounds(Buf, 2, lbound(InData%Nforce), ubound(InData%Nforce)) call RegPack(Buf, InData%Nforce) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%blade_dr)) if (allocated(InData%blade_dr)) then call RegPackBounds(Buf, 1, lbound(InData%blade_dr), ubound(InData%blade_dr)) call RegPack(Buf, InData%blade_dr) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NacYaw) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TI_original) - if (RegCheckErr(Buf, RoutineName)) return call DWM_Packturbine_average_velocity_data(Buf, InData%TAVD) - if (RegCheckErr(Buf, RoutineName)) return call DWM_PackCVSD(Buf, InData%CalVelScale_data) - if (RegCheckErr(Buf, RoutineName)) return call DWM_PackMeanderData(Buf, InData%meandering_data) - if (RegCheckErr(Buf, RoutineName)) return call DWM_PackWeiMethod(Buf, InData%weighting_method) - if (RegCheckErr(Buf, RoutineName)) return call DWM_PackTIDownstream(Buf, InData%TI_downstream_data) - if (RegCheckErr(Buf, RoutineName)) return call DWM_PackTurbKaimal(Buf, InData%Turbulence_KS) - if (RegCheckErr(Buf, RoutineName)) return call DWM_PackShinozuka(Buf, InData%shinozuka_data) - if (RegCheckErr(Buf, RoutineName)) return call DWM_Packsmooth_out_wake_data(Buf, InData%SmoothOut) - if (RegCheckErr(Buf, RoutineName)) return call DWM_PackSWSV(Buf, InData%smooth_wake_shifted_velocity_data) - if (RegCheckErr(Buf, RoutineName)) return call DWM_PackWake_Deficit_Data(Buf, InData%DWDD) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ct_tilde) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FAST_Time) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SDtimestep) - if (RegCheckErr(Buf, RoutineName)) return call DWM_Packturbine_blade(Buf, InData%DWM_tb) - if (RegCheckErr(Buf, RoutineName)) return call DWM_Packwake_meandered_center(Buf, InData%WMC) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3319,7 +3170,6 @@ subroutine DWM_PackInput(Buf, Indata) character(*), parameter :: RoutineName = 'DWM_PackInput' if (Buf%ErrStat >= AbortErrLev) return call DWM_Packread_upwind_result(Buf, InData%Upwind_result) - if (RegCheckErr(Buf, RoutineName)) return call InflowWind_PackInput(Buf, InData%IfW) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3515,65 +3365,49 @@ subroutine DWM_PackOutput(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%turbine_thrust_force), ubound(InData%turbine_thrust_force)) call RegPack(Buf, InData%turbine_thrust_force) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%induction_factor)) if (allocated(InData%induction_factor)) then call RegPackBounds(Buf, 1, lbound(InData%induction_factor), ubound(InData%induction_factor)) call RegPack(Buf, InData%induction_factor) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%r_initial)) if (allocated(InData%r_initial)) then call RegPackBounds(Buf, 1, lbound(InData%r_initial), ubound(InData%r_initial)) call RegPack(Buf, InData%r_initial) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%U_initial)) if (allocated(InData%U_initial)) then call RegPackBounds(Buf, 1, lbound(InData%U_initial), ubound(InData%U_initial)) call RegPack(Buf, InData%U_initial) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Mean_FFWS_array)) if (allocated(InData%Mean_FFWS_array)) then call RegPackBounds(Buf, 1, lbound(InData%Mean_FFWS_array), ubound(InData%Mean_FFWS_array)) call RegPack(Buf, InData%Mean_FFWS_array) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Mean_FFWS) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TI) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TI_downstream) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%wake_u)) if (allocated(InData%wake_u)) then call RegPackBounds(Buf, 2, lbound(InData%wake_u), ubound(InData%wake_u)) call RegPack(Buf, InData%wake_u) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%wake_position)) if (allocated(InData%wake_position)) then call RegPackBounds(Buf, 3, lbound(InData%wake_position), ubound(InData%wake_position)) call RegPack(Buf, InData%wake_position) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%smoothed_velocity_array)) if (allocated(InData%smoothed_velocity_array)) then call RegPackBounds(Buf, 2, lbound(InData%smoothed_velocity_array), ubound(InData%smoothed_velocity_array)) call RegPack(Buf, InData%smoothed_velocity_array) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AtmUscale) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%du_dz_ABL) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%total_SDgenpwr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%mean_SDgenpwr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%avg_ct) - if (RegCheckErr(Buf, RoutineName)) return call InflowWind_PackOutput(Buf, InData%IfW) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3751,7 +3585,6 @@ subroutine DWM_PackContState(Buf, Indata) character(*), parameter :: RoutineName = 'DWM_PackContState' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%dummy) - if (RegCheckErr(Buf, RoutineName)) return call InflowWind_PackContState(Buf, InData%IfW) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3800,7 +3633,6 @@ subroutine DWM_PackDiscState(Buf, Indata) character(*), parameter :: RoutineName = 'DWM_PackDiscState' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%dummy) - if (RegCheckErr(Buf, RoutineName)) return call InflowWind_PackDiscState(Buf, InData%IfW) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3849,7 +3681,6 @@ subroutine DWM_PackConstrState(Buf, Indata) character(*), parameter :: RoutineName = 'DWM_PackConstrState' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%dummy) - if (RegCheckErr(Buf, RoutineName)) return call InflowWind_PackConstrState(Buf, InData%IfW) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3898,7 +3729,6 @@ subroutine DWM_PackInitInput(Buf, Indata) character(*), parameter :: RoutineName = 'DWM_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%dummy) - if (RegCheckErr(Buf, RoutineName)) return call InflowWind_PackInitInput(Buf, InData%IfW) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3947,7 +3777,6 @@ subroutine DWM_PackInitOutput(Buf, Indata) character(*), parameter :: RoutineName = 'DWM_PackInitOutput' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%dummy) - if (RegCheckErr(Buf, RoutineName)) return call InflowWind_PackInitOutput(Buf, InData%IfW) if (RegCheckErr(Buf, RoutineName)) return end subroutine diff --git a/modules/awae/src/AWAE_Types.f90 b/modules/awae/src/AWAE_Types.f90 index ecb1ab0b60..fb2011aeb4 100644 --- a/modules/awae/src/AWAE_Types.f90 +++ b/modules/awae/src/AWAE_Types.f90 @@ -271,6 +271,7 @@ subroutine AWAE_CopyHighWindGrid(SrcHighWindGridData, DstHighWindGridData, CtrlC DstHighWindGridData%data = SrcHighWindGridData%data else if (associated(DstHighWindGridData%data)) then deallocate(DstHighWindGridData%data) + nullify(DstHighWindGridData%data) end if end subroutine @@ -645,123 +646,84 @@ subroutine AWAE_PackInputFileType(Buf, Indata) character(*), parameter :: RoutineName = 'AWAE_PackInputFileType' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%dr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dt_low) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumTurbines) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumRadii) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumPlanes) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WindFilePath) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WrDisWind) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NOutDisWindXY) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OutDisWindZ)) if (allocated(InData%OutDisWindZ)) then call RegPackBounds(Buf, 1, lbound(InData%OutDisWindZ), ubound(InData%OutDisWindZ)) call RegPack(Buf, InData%OutDisWindZ) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NOutDisWindYZ) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OutDisWindX)) if (allocated(InData%OutDisWindX)) then call RegPackBounds(Buf, 1, lbound(InData%OutDisWindX), ubound(InData%OutDisWindX)) call RegPack(Buf, InData%OutDisWindX) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NOutDisWindXZ) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OutDisWindY)) if (allocated(InData%OutDisWindY)) then call RegPackBounds(Buf, 1, lbound(InData%OutDisWindY), ubound(InData%OutDisWindY)) call RegPack(Buf, InData%OutDisWindY) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WrDisDT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ChkWndFiles) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Mod_Meander) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%C_Meander) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Mod_AmbWind) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%InflowFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dt_high) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%X0_high)) if (allocated(InData%X0_high)) then call RegPackBounds(Buf, 1, lbound(InData%X0_high), ubound(InData%X0_high)) call RegPack(Buf, InData%X0_high) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Y0_high)) if (allocated(InData%Y0_high)) then call RegPackBounds(Buf, 1, lbound(InData%Y0_high), ubound(InData%Y0_high)) call RegPack(Buf, InData%Y0_high) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Z0_high)) if (allocated(InData%Z0_high)) then call RegPackBounds(Buf, 1, lbound(InData%Z0_high), ubound(InData%Z0_high)) call RegPack(Buf, InData%Z0_high) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%dX_high)) if (allocated(InData%dX_high)) then call RegPackBounds(Buf, 1, lbound(InData%dX_high), ubound(InData%dX_high)) call RegPack(Buf, InData%dX_high) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%dY_high)) if (allocated(InData%dY_high)) then call RegPackBounds(Buf, 1, lbound(InData%dY_high), ubound(InData%dY_high)) call RegPack(Buf, InData%dY_high) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%dZ_high)) if (allocated(InData%dZ_high)) then call RegPackBounds(Buf, 1, lbound(InData%dZ_high), ubound(InData%dZ_high)) call RegPack(Buf, InData%dZ_high) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nX_high) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nY_high) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nZ_high) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dX_low) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dY_low) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dZ_low) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nX_low) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nY_low) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nZ_low) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%X0_low) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Y0_low) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Z0_low) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WT_Position)) if (allocated(InData%WT_Position)) then call RegPackBounds(Buf, 2, lbound(InData%WT_Position), ubound(InData%WT_Position)) call RegPack(Buf, InData%WT_Position) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Mod_Projection) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1012,11 +974,8 @@ subroutine AWAE_PackInitInput(Buf, Indata) character(*), parameter :: RoutineName = 'AWAE_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return call AWAE_PackInputFileType(Buf, InData%InputFileData) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%n_high_low) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumDT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutFileRoot) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1215,67 +1174,48 @@ subroutine AWAE_PackInitOutput(Buf, Indata) integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call NWTC_Library_PackProgDesc(Buf, InData%Ver) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%X0_high)) if (allocated(InData%X0_high)) then call RegPackBounds(Buf, 1, lbound(InData%X0_high), ubound(InData%X0_high)) call RegPack(Buf, InData%X0_high) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Y0_high)) if (allocated(InData%Y0_high)) then call RegPackBounds(Buf, 1, lbound(InData%Y0_high), ubound(InData%Y0_high)) call RegPack(Buf, InData%Y0_high) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Z0_high)) if (allocated(InData%Z0_high)) then call RegPackBounds(Buf, 1, lbound(InData%Z0_high), ubound(InData%Z0_high)) call RegPack(Buf, InData%Z0_high) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%dX_high)) if (allocated(InData%dX_high)) then call RegPackBounds(Buf, 1, lbound(InData%dX_high), ubound(InData%dX_high)) call RegPack(Buf, InData%dX_high) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%dY_high)) if (allocated(InData%dY_high)) then call RegPackBounds(Buf, 1, lbound(InData%dY_high), ubound(InData%dY_high)) call RegPack(Buf, InData%dY_high) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%dZ_high)) if (allocated(InData%dZ_high)) then call RegPackBounds(Buf, 1, lbound(InData%dZ_high), ubound(InData%dZ_high)) call RegPack(Buf, InData%dZ_high) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nX_high) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nY_high) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nZ_high) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dX_low) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dY_low) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dZ_low) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nX_low) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nY_low) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nZ_low) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%X0_low) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Y0_low) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Z0_low) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Vdist_High)) if (allocated(InData%Vdist_High)) then call RegPackBounds(Buf, 1, lbound(InData%Vdist_High), ubound(InData%Vdist_High)) @@ -2167,25 +2107,21 @@ subroutine AWAE_PackMisc(Buf, Indata) call RegPackBounds(Buf, 4, lbound(InData%Vamb_low), ubound(InData%Vamb_low)) call RegPack(Buf, InData%Vamb_low) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Vamb_lowpol)) if (allocated(InData%Vamb_lowpol)) then call RegPackBounds(Buf, 2, lbound(InData%Vamb_lowpol), ubound(InData%Vamb_lowpol)) call RegPack(Buf, InData%Vamb_lowpol) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Vdist_low)) if (allocated(InData%Vdist_low)) then call RegPackBounds(Buf, 4, lbound(InData%Vdist_low), ubound(InData%Vdist_low)) call RegPack(Buf, InData%Vdist_low) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Vdist_low_full)) if (allocated(InData%Vdist_low_full)) then call RegPackBounds(Buf, 4, lbound(InData%Vdist_low_full), ubound(InData%Vdist_low_full)) call RegPack(Buf, InData%Vdist_low_full) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Vamb_High)) if (allocated(InData%Vamb_High)) then call RegPackBounds(Buf, 1, lbound(InData%Vamb_High), ubound(InData%Vamb_High)) @@ -2195,67 +2131,56 @@ subroutine AWAE_PackMisc(Buf, Indata) call AWAE_PackHighWindGrid(Buf, InData%Vamb_High(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%parallelFlag)) if (allocated(InData%parallelFlag)) then call RegPackBounds(Buf, 2, lbound(InData%parallelFlag), ubound(InData%parallelFlag)) call RegPack(Buf, InData%parallelFlag) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%r_s)) if (allocated(InData%r_s)) then call RegPackBounds(Buf, 2, lbound(InData%r_s), ubound(InData%r_s)) call RegPack(Buf, InData%r_s) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%r_e)) if (allocated(InData%r_e)) then call RegPackBounds(Buf, 2, lbound(InData%r_e), ubound(InData%r_e)) call RegPack(Buf, InData%r_e) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%rhat_s)) if (allocated(InData%rhat_s)) then call RegPackBounds(Buf, 3, lbound(InData%rhat_s), ubound(InData%rhat_s)) call RegPack(Buf, InData%rhat_s) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%rhat_e)) if (allocated(InData%rhat_e)) then call RegPackBounds(Buf, 3, lbound(InData%rhat_e), ubound(InData%rhat_e)) call RegPack(Buf, InData%rhat_e) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%pvec_cs)) if (allocated(InData%pvec_cs)) then call RegPackBounds(Buf, 3, lbound(InData%pvec_cs), ubound(InData%pvec_cs)) call RegPack(Buf, InData%pvec_cs) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%pvec_ce)) if (allocated(InData%pvec_ce)) then call RegPackBounds(Buf, 3, lbound(InData%pvec_ce), ubound(InData%pvec_ce)) call RegPack(Buf, InData%pvec_ce) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%outVizXYPlane)) if (allocated(InData%outVizXYPlane)) then call RegPackBounds(Buf, 4, lbound(InData%outVizXYPlane), ubound(InData%outVizXYPlane)) call RegPack(Buf, InData%outVizXYPlane) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%outVizYZPlane)) if (allocated(InData%outVizYZPlane)) then call RegPackBounds(Buf, 4, lbound(InData%outVizYZPlane), ubound(InData%outVizYZPlane)) call RegPack(Buf, InData%outVizYZPlane) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%outVizXZPlane)) if (allocated(InData%outVizXZPlane)) then call RegPackBounds(Buf, 4, lbound(InData%outVizXZPlane), ubound(InData%outVizXZPlane)) call RegPack(Buf, InData%outVizXZPlane) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%IfW)) if (allocated(InData%IfW)) then call RegPackBounds(Buf, 1, lbound(InData%IfW), ubound(InData%IfW)) @@ -2265,13 +2190,9 @@ subroutine AWAE_PackMisc(Buf, Indata) call InflowWind_PackMisc(Buf, InData%IfW(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call InflowWind_PackInput(Buf, InData%u_IfW_Low) - if (RegCheckErr(Buf, RoutineName)) return call InflowWind_PackInput(Buf, InData%u_IfW_High) - if (RegCheckErr(Buf, RoutineName)) return call InflowWind_PackOutput(Buf, InData%y_IfW_Low) - if (RegCheckErr(Buf, RoutineName)) return call InflowWind_PackOutput(Buf, InData%y_IfW_High) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2855,129 +2776,89 @@ subroutine AWAE_PackParam(Buf, Indata) integer(IntKi) :: LB(3), UB(3) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%WindFilePath) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumTurbines) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumRadii) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumPlanes) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%y)) if (allocated(InData%y)) then call RegPackBounds(Buf, 1, lbound(InData%y), ubound(InData%y)) call RegPack(Buf, InData%y) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%z)) if (allocated(InData%z)) then call RegPackBounds(Buf, 1, lbound(InData%z), ubound(InData%z)) call RegPack(Buf, InData%z) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Mod_AmbWind) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nX_low) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nY_low) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nZ_low) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumGrid_low) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%n_rp_max) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dpol) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dXYZ_low) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dX_low) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dY_low) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dZ_low) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%X0_low) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Y0_low) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Z0_low) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%X0_high)) if (allocated(InData%X0_high)) then call RegPackBounds(Buf, 1, lbound(InData%X0_high), ubound(InData%X0_high)) call RegPack(Buf, InData%X0_high) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Y0_high)) if (allocated(InData%Y0_high)) then call RegPackBounds(Buf, 1, lbound(InData%Y0_high), ubound(InData%Y0_high)) call RegPack(Buf, InData%Y0_high) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Z0_high)) if (allocated(InData%Z0_high)) then call RegPackBounds(Buf, 1, lbound(InData%Z0_high), ubound(InData%Z0_high)) call RegPack(Buf, InData%Z0_high) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%dX_high)) if (allocated(InData%dX_high)) then call RegPackBounds(Buf, 1, lbound(InData%dX_high), ubound(InData%dX_high)) call RegPack(Buf, InData%dX_high) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%dY_high)) if (allocated(InData%dY_high)) then call RegPackBounds(Buf, 1, lbound(InData%dY_high), ubound(InData%dY_high)) call RegPack(Buf, InData%dY_high) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%dZ_high)) if (allocated(InData%dZ_high)) then call RegPackBounds(Buf, 1, lbound(InData%dZ_high), ubound(InData%dZ_high)) call RegPack(Buf, InData%dZ_high) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nX_high) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nY_high) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nZ_high) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Grid_low)) if (allocated(InData%Grid_low)) then call RegPackBounds(Buf, 2, lbound(InData%Grid_low), ubound(InData%Grid_low)) call RegPack(Buf, InData%Grid_low) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Grid_high)) if (allocated(InData%Grid_high)) then call RegPackBounds(Buf, 3, lbound(InData%Grid_high), ubound(InData%Grid_high)) call RegPack(Buf, InData%Grid_high) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WT_Position)) if (allocated(InData%WT_Position)) then call RegPackBounds(Buf, 2, lbound(InData%WT_Position), ubound(InData%WT_Position)) call RegPack(Buf, InData%WT_Position) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%n_high_low) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dt_low) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dt_high) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumDT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Mod_Meander) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%C_Meander) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%C_ScaleDiam) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Mod_Projection) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%IfW)) if (allocated(InData%IfW)) then call RegPackBounds(Buf, 1, lbound(InData%IfW), ubound(InData%IfW)) @@ -2987,39 +2868,28 @@ subroutine AWAE_PackParam(Buf, Indata) call InflowWind_PackParam(Buf, InData%IfW(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WrDisSkp1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WrDisWind) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NOutDisWindXY) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OutDisWindZ)) if (allocated(InData%OutDisWindZ)) then call RegPackBounds(Buf, 1, lbound(InData%OutDisWindZ), ubound(InData%OutDisWindZ)) call RegPack(Buf, InData%OutDisWindZ) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NOutDisWindYZ) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OutDisWindX)) if (allocated(InData%OutDisWindX)) then call RegPackBounds(Buf, 1, lbound(InData%OutDisWindX), ubound(InData%OutDisWindX)) call RegPack(Buf, InData%OutDisWindX) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NOutDisWindXZ) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OutDisWindY)) if (allocated(InData%OutDisWindY)) then call RegPackBounds(Buf, 1, lbound(InData%OutDisWindY), ubound(InData%OutDisWindY)) call RegPack(Buf, InData%OutDisWindY) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutFileRoot) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutFileVTKRoot) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VTK_tWidth) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3442,19 +3312,16 @@ subroutine AWAE_PackOutput(Buf, Indata) call AWAE_PackHighWindGrid(Buf, InData%Vdist_High(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%V_plane)) if (allocated(InData%V_plane)) then call RegPackBounds(Buf, 3, lbound(InData%V_plane), ubound(InData%V_plane)) call RegPack(Buf, InData%V_plane) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TI_amb)) if (allocated(InData%TI_amb)) then call RegPackBounds(Buf, 1, lbound(InData%TI_amb), ubound(InData%TI_amb)) call RegPack(Buf, InData%TI_amb) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Vx_wind_disk)) if (allocated(InData%Vx_wind_disk)) then call RegPackBounds(Buf, 1, lbound(InData%Vx_wind_disk), ubound(InData%Vx_wind_disk)) @@ -3682,37 +3549,31 @@ subroutine AWAE_PackInput(Buf, Indata) call RegPackBounds(Buf, 3, lbound(InData%xhat_plane), ubound(InData%xhat_plane)) call RegPack(Buf, InData%xhat_plane) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%p_plane)) if (allocated(InData%p_plane)) then call RegPackBounds(Buf, 3, lbound(InData%p_plane), ubound(InData%p_plane)) call RegPack(Buf, InData%p_plane) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Vx_wake)) if (allocated(InData%Vx_wake)) then call RegPackBounds(Buf, 4, lbound(InData%Vx_wake), ubound(InData%Vx_wake)) call RegPack(Buf, InData%Vx_wake) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Vy_wake)) if (allocated(InData%Vy_wake)) then call RegPackBounds(Buf, 4, lbound(InData%Vy_wake), ubound(InData%Vy_wake)) call RegPack(Buf, InData%Vy_wake) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Vz_wake)) if (allocated(InData%Vz_wake)) then call RegPackBounds(Buf, 4, lbound(InData%Vz_wake), ubound(InData%Vz_wake)) call RegPack(Buf, InData%Vz_wake) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%D_wake)) if (allocated(InData%D_wake)) then call RegPackBounds(Buf, 2, lbound(InData%D_wake), ubound(InData%D_wake)) call RegPack(Buf, InData%D_wake) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WAT_k_mt)) if (allocated(InData%WAT_k_mt)) then call RegPackBounds(Buf, 3, lbound(InData%WAT_k_mt), ubound(InData%WAT_k_mt)) diff --git a/modules/beamdyn/src/BeamDyn_Types.f90 b/modules/beamdyn/src/BeamDyn_Types.f90 index 075a1ea414..0f88f483de 100644 --- a/modules/beamdyn/src/BeamDyn_Types.f90 +++ b/modules/beamdyn/src/BeamDyn_Types.f90 @@ -373,27 +373,16 @@ subroutine BD_PackInitInput(Buf, Indata) character(*), parameter :: RoutineName = 'BD_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%InputFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RootName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%gravity) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%GlbPos) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%GlbRot) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RootDisp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RootOri) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RootVel) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HubPos) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HubRot) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Linearize) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DynamicSolve) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -655,65 +644,53 @@ subroutine BD_PackInitOutput(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) call RegPack(Buf, InData%WriteOutputHdr) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) call RegPack(Buf, InData%WriteOutputUnt) end if - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackProgDesc(Buf, InData%Ver) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%kp_coordinate)) if (allocated(InData%kp_coordinate)) then call RegPackBounds(Buf, 2, lbound(InData%kp_coordinate), ubound(InData%kp_coordinate)) call RegPack(Buf, InData%kp_coordinate) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%kp_total) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LinNames_y)) if (allocated(InData%LinNames_y)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) call RegPack(Buf, InData%LinNames_y) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LinNames_x)) if (allocated(InData%LinNames_x)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_x), ubound(InData%LinNames_x)) call RegPack(Buf, InData%LinNames_x) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LinNames_u)) if (allocated(InData%LinNames_u)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) call RegPack(Buf, InData%LinNames_u) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RotFrame_y)) if (allocated(InData%RotFrame_y)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y), ubound(InData%RotFrame_y)) call RegPack(Buf, InData%RotFrame_y) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RotFrame_x)) if (allocated(InData%RotFrame_x)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x), ubound(InData%RotFrame_x)) call RegPack(Buf, InData%RotFrame_x) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RotFrame_u)) if (allocated(InData%RotFrame_u)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u), ubound(InData%RotFrame_u)) call RegPack(Buf, InData%RotFrame_u) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%IsLoad_u)) if (allocated(InData%IsLoad_u)) then call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) call RegPack(Buf, InData%IsLoad_u) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%DerivOrder_x)) if (allocated(InData%DerivOrder_x)) then call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x), ubound(InData%DerivOrder_x)) @@ -972,29 +949,23 @@ subroutine BD_PackBladeInputData(Buf, Indata) character(*), parameter :: RoutineName = 'BD_PackBladeInputData' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%station_total) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%format_index) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%station_eta)) if (allocated(InData%station_eta)) then call RegPackBounds(Buf, 1, lbound(InData%station_eta), ubound(InData%station_eta)) call RegPack(Buf, InData%station_eta) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%stiff0)) if (allocated(InData%stiff0)) then call RegPackBounds(Buf, 3, lbound(InData%stiff0), ubound(InData%stiff0)) call RegPack(Buf, InData%stiff0) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%mass0)) if (allocated(InData%mass0)) then call RegPackBounds(Buf, 3, lbound(InData%mass0), ubound(InData%mass0)) call RegPack(Buf, InData%mass0) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%beta) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%damp_flag) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1209,97 +1180,61 @@ subroutine BD_PackInputFile(Buf, Indata) character(*), parameter :: RoutineName = 'BD_PackInputFile' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%member_total) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%kp_total) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%kp_member)) if (allocated(InData%kp_member)) then call RegPackBounds(Buf, 1, lbound(InData%kp_member), ubound(InData%kp_member)) call RegPack(Buf, InData%kp_member) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%order_elem) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%load_retries) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NRMax) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%quadrature) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%n_fact) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%refine) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rhoinf) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DTBeam) - if (RegCheckErr(Buf, RoutineName)) return call BD_PackBladeInputData(Buf, InData%InpBl) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BldFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UsePitchAct) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%QuasiStaticInit) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%stop_tol) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%tngt_stf_pert) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%tngt_stf_difftol) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%kp_coordinate)) if (allocated(InData%kp_coordinate)) then call RegPackBounds(Buf, 2, lbound(InData%kp_coordinate), ubound(InData%kp_coordinate)) call RegPack(Buf, InData%kp_coordinate) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%pitchJ) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%pitchK) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%pitchC) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Echo) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RotStates) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RelStates) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%tngt_stf_fd) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%tngt_stf_comp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NNodeOuts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutNd) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OutList)) if (allocated(InData%OutList)) then call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) call RegPack(Buf, InData%OutList) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SumPrint) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutFmt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BldNd_NumOuts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BldNd_OutList)) if (allocated(InData%BldNd_OutList)) then call RegPackBounds(Buf, 1, lbound(InData%BldNd_OutList), ubound(InData%BldNd_OutList)) call RegPack(Buf, InData%BldNd_OutList) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BldNd_BlOutNd)) if (allocated(InData%BldNd_BlOutNd)) then call RegPackBounds(Buf, 1, lbound(InData%BldNd_BlOutNd), ubound(InData%BldNd_BlOutNd)) call RegPack(Buf, InData%BldNd_BlOutNd) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BldNd_BlOutNd_Str) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1513,7 +1448,6 @@ subroutine BD_PackContState(Buf, Indata) call RegPackBounds(Buf, 2, lbound(InData%q), ubound(InData%q)) call RegPack(Buf, InData%q) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%dqdt)) if (allocated(InData%dqdt)) then call RegPackBounds(Buf, 2, lbound(InData%dqdt), ubound(InData%dqdt)) @@ -1588,7 +1522,6 @@ subroutine BD_PackDiscState(Buf, Indata) character(*), parameter :: RoutineName = 'BD_PackDiscState' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%thetaP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%thetaPD) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1711,15 +1644,12 @@ subroutine BD_PackOtherState(Buf, Indata) call RegPackBounds(Buf, 2, lbound(InData%acc), ubound(InData%acc)) call RegPack(Buf, InData%acc) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%xcc)) if (allocated(InData%xcc)) then call RegPackBounds(Buf, 2, lbound(InData%xcc), ubound(InData%xcc)) call RegPack(Buf, InData%xcc) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%InitAcc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RunQuasiStaticInit) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1832,7 +1762,6 @@ subroutine BD_PackqpParam(Buf, Indata) call RegPackBounds(Buf, 2, lbound(InData%mmm), ubound(InData%mmm)) call RegPack(Buf, InData%mmm) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%mEta)) if (allocated(InData%mEta)) then call RegPackBounds(Buf, 3, lbound(InData%mEta), ubound(InData%mEta)) @@ -2465,149 +2394,105 @@ subroutine BD_PackParam(Buf, Indata) integer(IntKi) :: LB(4), UB(4) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%dt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%coef) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rhoinf) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%uuN0)) if (allocated(InData%uuN0)) then call RegPackBounds(Buf, 3, lbound(InData%uuN0), ubound(InData%uuN0)) call RegPack(Buf, InData%uuN0) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Stif0_QP)) if (allocated(InData%Stif0_QP)) then call RegPackBounds(Buf, 3, lbound(InData%Stif0_QP), ubound(InData%Stif0_QP)) call RegPack(Buf, InData%Stif0_QP) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Mass0_QP)) if (allocated(InData%Mass0_QP)) then call RegPackBounds(Buf, 3, lbound(InData%Mass0_QP), ubound(InData%Mass0_QP)) call RegPack(Buf, InData%Mass0_QP) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%gravity) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%segment_eta)) if (allocated(InData%segment_eta)) then call RegPackBounds(Buf, 1, lbound(InData%segment_eta), ubound(InData%segment_eta)) call RegPack(Buf, InData%segment_eta) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%member_eta)) if (allocated(InData%member_eta)) then call RegPackBounds(Buf, 1, lbound(InData%member_eta), ubound(InData%member_eta)) call RegPack(Buf, InData%member_eta) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%blade_length) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%blade_mass) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%blade_CG) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%blade_IN) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%beta) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%tol) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%GlbPos) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%GlbRot) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Glb_crv) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%QPtN)) if (allocated(InData%QPtN)) then call RegPackBounds(Buf, 1, lbound(InData%QPtN), ubound(InData%QPtN)) call RegPack(Buf, InData%QPtN) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%QPtWeight)) if (allocated(InData%QPtWeight)) then call RegPackBounds(Buf, 1, lbound(InData%QPtWeight), ubound(InData%QPtWeight)) call RegPack(Buf, InData%QPtWeight) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Shp)) if (allocated(InData%Shp)) then call RegPackBounds(Buf, 2, lbound(InData%Shp), ubound(InData%Shp)) call RegPack(Buf, InData%Shp) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ShpDer)) if (allocated(InData%ShpDer)) then call RegPackBounds(Buf, 2, lbound(InData%ShpDer), ubound(InData%ShpDer)) call RegPack(Buf, InData%ShpDer) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Jacobian)) if (allocated(InData%Jacobian)) then call RegPackBounds(Buf, 2, lbound(InData%Jacobian), ubound(InData%Jacobian)) call RegPack(Buf, InData%Jacobian) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%uu0)) if (allocated(InData%uu0)) then call RegPackBounds(Buf, 3, lbound(InData%uu0), ubound(InData%uu0)) call RegPack(Buf, InData%uu0) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%rrN0)) if (allocated(InData%rrN0)) then call RegPackBounds(Buf, 3, lbound(InData%rrN0), ubound(InData%rrN0)) call RegPack(Buf, InData%rrN0) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%E10)) if (allocated(InData%E10)) then call RegPackBounds(Buf, 3, lbound(InData%E10), ubound(InData%E10)) call RegPack(Buf, InData%E10) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nodes_per_elem) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%node_elem_idx)) if (allocated(InData%node_elem_idx)) then call RegPackBounds(Buf, 2, lbound(InData%node_elem_idx), ubound(InData%node_elem_idx)) call RegPack(Buf, InData%node_elem_idx) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%refine) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dof_node) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dof_elem) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rot_elem) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%elem_total) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%node_total) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dof_total) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nqp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%analysis_type) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%damp_flag) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ld_retries) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%niter) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%quadrature) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%n_fact) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutInputs) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) @@ -2617,59 +2502,38 @@ subroutine BD_PackParam(Buf, Indata) call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NNodeOuts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutNd) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%NdIndx)) if (allocated(InData%NdIndx)) then call RegPackBounds(Buf, 1, lbound(InData%NdIndx), ubound(InData%NdIndx)) call RegPack(Buf, InData%NdIndx) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%NdIndxInverse)) if (allocated(InData%NdIndxInverse)) then call RegPackBounds(Buf, 1, lbound(InData%NdIndxInverse), ubound(InData%NdIndxInverse)) call RegPack(Buf, InData%NdIndxInverse) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OutNd2NdElem)) if (allocated(InData%OutNd2NdElem)) then call RegPackBounds(Buf, 2, lbound(InData%OutNd2NdElem), ubound(InData%OutNd2NdElem)) call RegPack(Buf, InData%OutNd2NdElem) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutFmt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UsePitchAct) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%pitchJ) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%pitchK) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%pitchC) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%torqM) - if (RegCheckErr(Buf, RoutineName)) return call BD_PackqpParam(Buf, InData%qp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%qp_indx_offset) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BldMotionNodeLoc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%tngt_stf_fd) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%tngt_stf_comp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%tngt_stf_pert) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%tngt_stf_difftol) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BldNd_NumOuts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BldNd_TotNumOuts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BldNd_OutParam)) if (allocated(InData%BldNd_OutParam)) then call RegPackBounds(Buf, 1, lbound(InData%BldNd_OutParam), ubound(InData%BldNd_OutParam)) @@ -2679,69 +2543,55 @@ subroutine BD_PackParam(Buf, Indata) call NWTC_Library_PackOutParmType(Buf, InData%BldNd_OutParam(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BldNd_BlOutNd)) if (allocated(InData%BldNd_BlOutNd)) then call RegPackBounds(Buf, 1, lbound(InData%BldNd_BlOutNd), ubound(InData%BldNd_BlOutNd)) call RegPack(Buf, InData%BldNd_BlOutNd) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%QPtw_Shp_Shp_Jac)) if (allocated(InData%QPtw_Shp_Shp_Jac)) then call RegPackBounds(Buf, 4, lbound(InData%QPtw_Shp_Shp_Jac), ubound(InData%QPtw_Shp_Shp_Jac)) call RegPack(Buf, InData%QPtw_Shp_Shp_Jac) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%QPtw_Shp_ShpDer)) if (allocated(InData%QPtw_Shp_ShpDer)) then call RegPackBounds(Buf, 3, lbound(InData%QPtw_Shp_ShpDer), ubound(InData%QPtw_Shp_ShpDer)) call RegPack(Buf, InData%QPtw_Shp_ShpDer) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%QPtw_ShpDer_ShpDer_Jac)) if (allocated(InData%QPtw_ShpDer_ShpDer_Jac)) then call RegPackBounds(Buf, 4, lbound(InData%QPtw_ShpDer_ShpDer_Jac), ubound(InData%QPtw_ShpDer_ShpDer_Jac)) call RegPack(Buf, InData%QPtw_ShpDer_ShpDer_Jac) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%QPtw_Shp_Jac)) if (allocated(InData%QPtw_Shp_Jac)) then call RegPackBounds(Buf, 3, lbound(InData%QPtw_Shp_Jac), ubound(InData%QPtw_Shp_Jac)) call RegPack(Buf, InData%QPtw_Shp_Jac) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%QPtw_ShpDer)) if (allocated(InData%QPtw_ShpDer)) then call RegPackBounds(Buf, 2, lbound(InData%QPtw_ShpDer), ubound(InData%QPtw_ShpDer)) call RegPack(Buf, InData%QPtw_ShpDer) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FEweight)) if (allocated(InData%FEweight)) then call RegPackBounds(Buf, 2, lbound(InData%FEweight), ubound(InData%FEweight)) call RegPack(Buf, InData%FEweight) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Jac_u_indx)) if (allocated(InData%Jac_u_indx)) then call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx), ubound(InData%Jac_u_indx)) call RegPack(Buf, InData%Jac_u_indx) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%du)) if (allocated(InData%du)) then call RegPackBounds(Buf, 1, lbound(InData%du), ubound(InData%du)) call RegPack(Buf, InData%du) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dx) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Jac_ny) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Jac_nx) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RotStates) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RelStates) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3296,11 +3146,8 @@ subroutine BD_PackInput(Buf, Indata) character(*), parameter :: RoutineName = 'BD_PackInput' if (Buf%ErrStat >= AbortErrLev) return call MeshPack(Buf, InData%RootMotion) - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%PointLoad) - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%DistrLoad) - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%HubMotion) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3372,13 +3219,9 @@ subroutine BD_PackOutput(Buf, Indata) character(*), parameter :: RoutineName = 'BD_PackOutput' if (Buf%ErrStat >= AbortErrLev) return call MeshPack(Buf, InData%ReactionForce) - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%BldMotion) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RootMxr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RootMyr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) @@ -3976,181 +3819,151 @@ subroutine BD_PackEqMotionQP(Buf, Indata) call RegPackBounds(Buf, 3, lbound(InData%uuu), ubound(InData%uuu)) call RegPack(Buf, InData%uuu) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%uup)) if (allocated(InData%uup)) then call RegPackBounds(Buf, 3, lbound(InData%uup), ubound(InData%uup)) call RegPack(Buf, InData%uup) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%vvv)) if (allocated(InData%vvv)) then call RegPackBounds(Buf, 3, lbound(InData%vvv), ubound(InData%vvv)) call RegPack(Buf, InData%vvv) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%vvp)) if (allocated(InData%vvp)) then call RegPackBounds(Buf, 3, lbound(InData%vvp), ubound(InData%vvp)) call RegPack(Buf, InData%vvp) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%aaa)) if (allocated(InData%aaa)) then call RegPackBounds(Buf, 3, lbound(InData%aaa), ubound(InData%aaa)) call RegPack(Buf, InData%aaa) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RR0)) if (allocated(InData%RR0)) then call RegPackBounds(Buf, 4, lbound(InData%RR0), ubound(InData%RR0)) call RegPack(Buf, InData%RR0) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%kappa)) if (allocated(InData%kappa)) then call RegPackBounds(Buf, 3, lbound(InData%kappa), ubound(InData%kappa)) call RegPack(Buf, InData%kappa) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%E1)) if (allocated(InData%E1)) then call RegPackBounds(Buf, 3, lbound(InData%E1), ubound(InData%E1)) call RegPack(Buf, InData%E1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Stif)) if (allocated(InData%Stif)) then call RegPackBounds(Buf, 4, lbound(InData%Stif), ubound(InData%Stif)) call RegPack(Buf, InData%Stif) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Fb)) if (allocated(InData%Fb)) then call RegPackBounds(Buf, 3, lbound(InData%Fb), ubound(InData%Fb)) call RegPack(Buf, InData%Fb) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Fc)) if (allocated(InData%Fc)) then call RegPackBounds(Buf, 3, lbound(InData%Fc), ubound(InData%Fc)) call RegPack(Buf, InData%Fc) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Fd)) if (allocated(InData%Fd)) then call RegPackBounds(Buf, 3, lbound(InData%Fd), ubound(InData%Fd)) call RegPack(Buf, InData%Fd) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Fg)) if (allocated(InData%Fg)) then call RegPackBounds(Buf, 3, lbound(InData%Fg), ubound(InData%Fg)) call RegPack(Buf, InData%Fg) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Fi)) if (allocated(InData%Fi)) then call RegPackBounds(Buf, 3, lbound(InData%Fi), ubound(InData%Fi)) call RegPack(Buf, InData%Fi) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Ftemp)) if (allocated(InData%Ftemp)) then call RegPackBounds(Buf, 3, lbound(InData%Ftemp), ubound(InData%Ftemp)) call RegPack(Buf, InData%Ftemp) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RR0mEta)) if (allocated(InData%RR0mEta)) then call RegPackBounds(Buf, 3, lbound(InData%RR0mEta), ubound(InData%RR0mEta)) call RegPack(Buf, InData%RR0mEta) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%rho)) if (allocated(InData%rho)) then call RegPackBounds(Buf, 4, lbound(InData%rho), ubound(InData%rho)) call RegPack(Buf, InData%rho) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%betaC)) if (allocated(InData%betaC)) then call RegPackBounds(Buf, 4, lbound(InData%betaC), ubound(InData%betaC)) call RegPack(Buf, InData%betaC) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Gi)) if (allocated(InData%Gi)) then call RegPackBounds(Buf, 4, lbound(InData%Gi), ubound(InData%Gi)) call RegPack(Buf, InData%Gi) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Ki)) if (allocated(InData%Ki)) then call RegPackBounds(Buf, 4, lbound(InData%Ki), ubound(InData%Ki)) call RegPack(Buf, InData%Ki) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Mi)) if (allocated(InData%Mi)) then call RegPackBounds(Buf, 4, lbound(InData%Mi), ubound(InData%Mi)) call RegPack(Buf, InData%Mi) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Oe)) if (allocated(InData%Oe)) then call RegPackBounds(Buf, 4, lbound(InData%Oe), ubound(InData%Oe)) call RegPack(Buf, InData%Oe) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Pe)) if (allocated(InData%Pe)) then call RegPackBounds(Buf, 4, lbound(InData%Pe), ubound(InData%Pe)) call RegPack(Buf, InData%Pe) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Qe)) if (allocated(InData%Qe)) then call RegPackBounds(Buf, 4, lbound(InData%Qe), ubound(InData%Qe)) call RegPack(Buf, InData%Qe) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Gd)) if (allocated(InData%Gd)) then call RegPackBounds(Buf, 4, lbound(InData%Gd), ubound(InData%Gd)) call RegPack(Buf, InData%Gd) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Od)) if (allocated(InData%Od)) then call RegPackBounds(Buf, 4, lbound(InData%Od), ubound(InData%Od)) call RegPack(Buf, InData%Od) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Pd)) if (allocated(InData%Pd)) then call RegPackBounds(Buf, 4, lbound(InData%Pd), ubound(InData%Pd)) call RegPack(Buf, InData%Pd) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Qd)) if (allocated(InData%Qd)) then call RegPackBounds(Buf, 4, lbound(InData%Qd), ubound(InData%Qd)) call RegPack(Buf, InData%Qd) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Sd)) if (allocated(InData%Sd)) then call RegPackBounds(Buf, 4, lbound(InData%Sd), ubound(InData%Sd)) call RegPack(Buf, InData%Sd) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Xd)) if (allocated(InData%Xd)) then call RegPackBounds(Buf, 4, lbound(InData%Xd), ubound(InData%Xd)) call RegPack(Buf, InData%Xd) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Yd)) if (allocated(InData%Yd)) then call RegPackBounds(Buf, 4, lbound(InData%Yd), ubound(InData%Yd)) @@ -5166,199 +4979,162 @@ subroutine BD_PackMisc(Buf, Indata) character(*), parameter :: RoutineName = 'BD_PackMisc' if (Buf%ErrStat >= AbortErrLev) return call MeshPack(Buf, InData%u_DistrLoad_at_y) - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%y_BldMotion_at_u) - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackMeshMapType(Buf, InData%Map_u_DistrLoad_to_y) - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackMeshMapType(Buf, InData%Map_y_BldMotion_to_u) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Un_Sum) - if (RegCheckErr(Buf, RoutineName)) return call BD_PackEqMotionQP(Buf, InData%qp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%lin_A)) if (allocated(InData%lin_A)) then call RegPackBounds(Buf, 2, lbound(InData%lin_A), ubound(InData%lin_A)) call RegPack(Buf, InData%lin_A) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%lin_C)) if (allocated(InData%lin_C)) then call RegPackBounds(Buf, 2, lbound(InData%lin_C), ubound(InData%lin_C)) call RegPack(Buf, InData%lin_C) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Nrrr)) if (allocated(InData%Nrrr)) then call RegPackBounds(Buf, 3, lbound(InData%Nrrr), ubound(InData%Nrrr)) call RegPack(Buf, InData%Nrrr) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%elf)) if (allocated(InData%elf)) then call RegPackBounds(Buf, 2, lbound(InData%elf), ubound(InData%elf)) call RegPack(Buf, InData%elf) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%EFint)) if (allocated(InData%EFint)) then call RegPackBounds(Buf, 3, lbound(InData%EFint), ubound(InData%EFint)) call RegPack(Buf, InData%EFint) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%elk)) if (allocated(InData%elk)) then call RegPackBounds(Buf, 4, lbound(InData%elk), ubound(InData%elk)) call RegPack(Buf, InData%elk) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%elg)) if (allocated(InData%elg)) then call RegPackBounds(Buf, 4, lbound(InData%elg), ubound(InData%elg)) call RegPack(Buf, InData%elg) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%elm)) if (allocated(InData%elm)) then call RegPackBounds(Buf, 4, lbound(InData%elm), ubound(InData%elm)) call RegPack(Buf, InData%elm) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%DistrLoad_QP)) if (allocated(InData%DistrLoad_QP)) then call RegPackBounds(Buf, 3, lbound(InData%DistrLoad_QP), ubound(InData%DistrLoad_QP)) call RegPack(Buf, InData%DistrLoad_QP) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PointLoadLcl)) if (allocated(InData%PointLoadLcl)) then call RegPackBounds(Buf, 2, lbound(InData%PointLoadLcl), ubound(InData%PointLoadLcl)) call RegPack(Buf, InData%PointLoadLcl) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%StifK)) if (allocated(InData%StifK)) then call RegPackBounds(Buf, 4, lbound(InData%StifK), ubound(InData%StifK)) call RegPack(Buf, InData%StifK) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%MassM)) if (allocated(InData%MassM)) then call RegPackBounds(Buf, 4, lbound(InData%MassM), ubound(InData%MassM)) call RegPack(Buf, InData%MassM) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%DampG)) if (allocated(InData%DampG)) then call RegPackBounds(Buf, 4, lbound(InData%DampG), ubound(InData%DampG)) call RegPack(Buf, InData%DampG) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%StifK_fd)) if (allocated(InData%StifK_fd)) then call RegPackBounds(Buf, 4, lbound(InData%StifK_fd), ubound(InData%StifK_fd)) call RegPack(Buf, InData%StifK_fd) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%MassM_fd)) if (allocated(InData%MassM_fd)) then call RegPackBounds(Buf, 4, lbound(InData%MassM_fd), ubound(InData%MassM_fd)) call RegPack(Buf, InData%MassM_fd) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%DampG_fd)) if (allocated(InData%DampG_fd)) then call RegPackBounds(Buf, 4, lbound(InData%DampG_fd), ubound(InData%DampG_fd)) call RegPack(Buf, InData%DampG_fd) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RHS)) if (allocated(InData%RHS)) then call RegPackBounds(Buf, 2, lbound(InData%RHS), ubound(InData%RHS)) call RegPack(Buf, InData%RHS) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RHS_p)) if (allocated(InData%RHS_p)) then call RegPackBounds(Buf, 2, lbound(InData%RHS_p), ubound(InData%RHS_p)) call RegPack(Buf, InData%RHS_p) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RHS_m)) if (allocated(InData%RHS_m)) then call RegPackBounds(Buf, 2, lbound(InData%RHS_m), ubound(InData%RHS_m)) call RegPack(Buf, InData%RHS_m) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BldInternalForceFE)) if (allocated(InData%BldInternalForceFE)) then call RegPackBounds(Buf, 2, lbound(InData%BldInternalForceFE), ubound(InData%BldInternalForceFE)) call RegPack(Buf, InData%BldInternalForceFE) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BldInternalForceQP)) if (allocated(InData%BldInternalForceQP)) then call RegPackBounds(Buf, 2, lbound(InData%BldInternalForceQP), ubound(InData%BldInternalForceQP)) call RegPack(Buf, InData%BldInternalForceQP) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FirstNodeReactionLclForceMoment)) if (allocated(InData%FirstNodeReactionLclForceMoment)) then call RegPackBounds(Buf, 1, lbound(InData%FirstNodeReactionLclForceMoment), ubound(InData%FirstNodeReactionLclForceMoment)) call RegPack(Buf, InData%FirstNodeReactionLclForceMoment) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Solution)) if (allocated(InData%Solution)) then call RegPackBounds(Buf, 2, lbound(InData%Solution), ubound(InData%Solution)) call RegPack(Buf, InData%Solution) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LP_StifK)) if (allocated(InData%LP_StifK)) then call RegPackBounds(Buf, 2, lbound(InData%LP_StifK), ubound(InData%LP_StifK)) call RegPack(Buf, InData%LP_StifK) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LP_MassM)) if (allocated(InData%LP_MassM)) then call RegPackBounds(Buf, 2, lbound(InData%LP_MassM), ubound(InData%LP_MassM)) call RegPack(Buf, InData%LP_MassM) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LP_MassM_LU)) if (allocated(InData%LP_MassM_LU)) then call RegPackBounds(Buf, 2, lbound(InData%LP_MassM_LU), ubound(InData%LP_MassM_LU)) call RegPack(Buf, InData%LP_MassM_LU) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LP_RHS)) if (allocated(InData%LP_RHS)) then call RegPackBounds(Buf, 1, lbound(InData%LP_RHS), ubound(InData%LP_RHS)) call RegPack(Buf, InData%LP_RHS) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LP_StifK_LU)) if (allocated(InData%LP_StifK_LU)) then call RegPackBounds(Buf, 2, lbound(InData%LP_StifK_LU), ubound(InData%LP_StifK_LU)) call RegPack(Buf, InData%LP_StifK_LU) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LP_RHS_LU)) if (allocated(InData%LP_RHS_LU)) then call RegPackBounds(Buf, 1, lbound(InData%LP_RHS_LU), ubound(InData%LP_RHS_LU)) call RegPack(Buf, InData%LP_RHS_LU) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LP_indx)) if (allocated(InData%LP_indx)) then call RegPackBounds(Buf, 1, lbound(InData%LP_indx), ubound(InData%LP_indx)) call RegPack(Buf, InData%LP_indx) end if - if (RegCheckErr(Buf, RoutineName)) return call BD_PackInput(Buf, InData%u) - if (RegCheckErr(Buf, RoutineName)) return call BD_PackInput(Buf, InData%u2) if (RegCheckErr(Buf, RoutineName)) return end subroutine diff --git a/modules/elastodyn/src/ElastoDyn_Types.f90 b/modules/elastodyn/src/ElastoDyn_Types.f90 index 43214089e1..a92efa08d5 100644 --- a/modules/elastodyn/src/ElastoDyn_Types.f90 +++ b/modules/elastodyn/src/ElastoDyn_Types.f90 @@ -849,19 +849,12 @@ subroutine ED_PackInitInput(Buf, Indata) character(*), parameter :: RoutineName = 'ED_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%InputFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Linearize) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ADInputFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CompElast) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RootName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Gravity) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MHK) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WtrDpth) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1161,101 +1154,75 @@ subroutine ED_PackInitOutput(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) call RegPack(Buf, InData%WriteOutputHdr) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) call RegPack(Buf, InData%WriteOutputUnt) end if - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackProgDesc(Buf, InData%Ver) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumBl) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BlPitch)) if (allocated(InData%BlPitch)) then call RegPackBounds(Buf, 1, lbound(InData%BlPitch), ubound(InData%BlPitch)) call RegPack(Buf, InData%BlPitch) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BladeLength) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TowerHeight) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TowerBaseHeight) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HubHt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BldRNodes)) if (allocated(InData%BldRNodes)) then call RegPackBounds(Buf, 1, lbound(InData%BldRNodes), ubound(InData%BldRNodes)) call RegPack(Buf, InData%BldRNodes) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TwrHNodes)) if (allocated(InData%TwrHNodes)) then call RegPackBounds(Buf, 1, lbound(InData%TwrHNodes), ubound(InData%TwrHNodes)) call RegPack(Buf, InData%TwrHNodes) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PlatformPos) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TwrBaseRefPos) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TwrBaseTransDisp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TwrBaseRefOrient) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TwrBaseOrient) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HubRad) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RotSpeed) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%isFixed_GenDOF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LinNames_y)) if (allocated(InData%LinNames_y)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) call RegPack(Buf, InData%LinNames_y) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LinNames_x)) if (allocated(InData%LinNames_x)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_x), ubound(InData%LinNames_x)) call RegPack(Buf, InData%LinNames_x) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LinNames_u)) if (allocated(InData%LinNames_u)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) call RegPack(Buf, InData%LinNames_u) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RotFrame_y)) if (allocated(InData%RotFrame_y)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y), ubound(InData%RotFrame_y)) call RegPack(Buf, InData%RotFrame_y) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RotFrame_x)) if (allocated(InData%RotFrame_x)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x), ubound(InData%RotFrame_x)) call RegPack(Buf, InData%RotFrame_x) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%DerivOrder_x)) if (allocated(InData%DerivOrder_x)) then call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x), ubound(InData%DerivOrder_x)) call RegPack(Buf, InData%DerivOrder_x) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RotFrame_u)) if (allocated(InData%RotFrame_u)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u), ubound(InData%RotFrame_u)) call RegPack(Buf, InData%RotFrame_u) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%IsLoad_u)) if (allocated(InData%IsLoad_u)) then call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) @@ -1668,61 +1635,49 @@ subroutine ED_PackBladeInputData(Buf, Indata) character(*), parameter :: RoutineName = 'ED_PackBladeInputData' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%NBlInpSt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BlFract)) if (allocated(InData%BlFract)) then call RegPackBounds(Buf, 1, lbound(InData%BlFract), ubound(InData%BlFract)) call RegPack(Buf, InData%BlFract) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PitchAx)) if (allocated(InData%PitchAx)) then call RegPackBounds(Buf, 1, lbound(InData%PitchAx), ubound(InData%PitchAx)) call RegPack(Buf, InData%PitchAx) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%StrcTwst)) if (allocated(InData%StrcTwst)) then call RegPackBounds(Buf, 1, lbound(InData%StrcTwst), ubound(InData%StrcTwst)) call RegPack(Buf, InData%StrcTwst) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BMassDen)) if (allocated(InData%BMassDen)) then call RegPackBounds(Buf, 1, lbound(InData%BMassDen), ubound(InData%BMassDen)) call RegPack(Buf, InData%BMassDen) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FlpStff)) if (allocated(InData%FlpStff)) then call RegPackBounds(Buf, 1, lbound(InData%FlpStff), ubound(InData%FlpStff)) call RegPack(Buf, InData%FlpStff) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%EdgStff)) if (allocated(InData%EdgStff)) then call RegPackBounds(Buf, 1, lbound(InData%EdgStff), ubound(InData%EdgStff)) call RegPack(Buf, InData%EdgStff) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BldFlDmp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BldEdDmp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FlStTunr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BldFl1Sh)) if (allocated(InData%BldFl1Sh)) then call RegPackBounds(Buf, 1, lbound(InData%BldFl1Sh), ubound(InData%BldFl1Sh)) call RegPack(Buf, InData%BldFl1Sh) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BldFl2Sh)) if (allocated(InData%BldFl2Sh)) then call RegPackBounds(Buf, 1, lbound(InData%BldFl2Sh), ubound(InData%BldFl2Sh)) call RegPack(Buf, InData%BldFl2Sh) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BldEdgSh)) if (allocated(InData%BldEdgSh)) then call RegPackBounds(Buf, 1, lbound(InData%BldEdgSh), ubound(InData%BldEdgSh)) @@ -1955,19 +1910,16 @@ subroutine ED_PackBladeMeshInputData(Buf, Indata) character(*), parameter :: RoutineName = 'ED_PackBladeMeshInputData' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%BldNodes) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RNodes)) if (allocated(InData%RNodes)) then call RegPackBounds(Buf, 1, lbound(InData%RNodes), ubound(InData%RNodes)) call RegPack(Buf, InData%RNodes) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AeroTwst)) if (allocated(InData%AeroTwst)) then call RegPackBounds(Buf, 1, lbound(InData%AeroTwst), ubound(InData%AeroTwst)) call RegPack(Buf, InData%AeroTwst) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Chord)) if (allocated(InData%Chord)) then call RegPackBounds(Buf, 1, lbound(InData%Chord), ubound(InData%Chord)) @@ -2483,155 +2435,86 @@ subroutine ED_PackInputFile(Buf, Indata) integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%DT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FlapDOF1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FlapDOF2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%EdgeDOF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TeetDOF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DrTrDOF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%GenDOF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YawDOF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TwFADOF1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TwFADOF2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TwSSDOF1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TwSSDOF2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PtfmSgDOF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PtfmSwDOF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PtfmHvDOF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PtfmRDOF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PtfmPDOF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PtfmYDOF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OoPDefl) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%IPDefl) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BlPitch)) if (allocated(InData%BlPitch)) then call RegPackBounds(Buf, 1, lbound(InData%BlPitch), ubound(InData%BlPitch)) call RegPack(Buf, InData%BlPitch) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TeetDefl) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Azimuth) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RotSpeed) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NacYaw) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TTDspFA) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TTDspSS) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PtfmSurge) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PtfmSway) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PtfmHeave) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PtfmRoll) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PtfmPitch) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PtfmYaw) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumBl) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TipRad) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HubRad) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PreCone)) if (allocated(InData%PreCone)) then call RegPackBounds(Buf, 1, lbound(InData%PreCone), ubound(InData%PreCone)) call RegPack(Buf, InData%PreCone) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HubCM) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UndSling) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Delta3) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AzimB1Up) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OverHang) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ShftGagL) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ShftTilt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NacCMxn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NacCMyn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NacCMzn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NcIMUxn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NcIMUyn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NcIMUzn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Twr2Shft) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TowerHt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TowerBsHt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PtfmCMxt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PtfmCMyt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PtfmCMzt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PtfmRefzt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TipMass)) if (allocated(InData%TipMass)) then call RegPackBounds(Buf, 1, lbound(InData%TipMass), ubound(InData%TipMass)) call RegPack(Buf, InData%TipMass) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HubMass) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HubIner) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%GenIner) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NacMass) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NacYIner) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YawBrMass) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PtfmMass) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PtfmRIner) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PtfmPIner) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PtfmYIner) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BldNodes) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%InpBlMesh)) if (allocated(InData%InpBlMesh)) then call RegPackBounds(Buf, 1, lbound(InData%InpBlMesh), ubound(InData%InpBlMesh)) @@ -2641,7 +2524,6 @@ subroutine ED_PackInputFile(Buf, Indata) call ED_PackBladeMeshInputData(Buf, InData%InpBlMesh(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%InpBl)) if (allocated(InData%InpBl)) then call RegPackBounds(Buf, 1, lbound(InData%InpBl), ubound(InData%InpBl)) @@ -2651,217 +2533,131 @@ subroutine ED_PackInputFile(Buf, Indata) call ED_PackBladeInputData(Buf, InData%InpBl(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TeetMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TeetDmpP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TeetDmp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TeetCDmp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TeetSStP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TeetHStP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TeetSSSp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TeetHSSp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%GBoxEff) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%GBRatio) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DTTorSpr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DTTorDmp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Furling) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TwrNodes) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SumPrint) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TabDelim) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutFmt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Tstart) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DecFact) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NTwGages) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TwrGagNd) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NBlGages) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BldGagNd) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OutList)) if (allocated(InData%OutList)) then call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) call RegPack(Buf, InData%OutList) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NTwInpSt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TwrFADmp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TwrSSDmp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FAStTunr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SSStTunr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%HtFract)) if (allocated(InData%HtFract)) then call RegPackBounds(Buf, 1, lbound(InData%HtFract), ubound(InData%HtFract)) call RegPack(Buf, InData%HtFract) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TMassDen)) if (allocated(InData%TMassDen)) then call RegPackBounds(Buf, 1, lbound(InData%TMassDen), ubound(InData%TMassDen)) call RegPack(Buf, InData%TMassDen) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TwFAStif)) if (allocated(InData%TwFAStif)) then call RegPackBounds(Buf, 1, lbound(InData%TwFAStif), ubound(InData%TwFAStif)) call RegPack(Buf, InData%TwFAStif) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TwSSStif)) if (allocated(InData%TwSSStif)) then call RegPackBounds(Buf, 1, lbound(InData%TwSSStif), ubound(InData%TwSSStif)) call RegPack(Buf, InData%TwSSStif) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TwFAM1Sh)) if (allocated(InData%TwFAM1Sh)) then call RegPackBounds(Buf, 1, lbound(InData%TwFAM1Sh), ubound(InData%TwFAM1Sh)) call RegPack(Buf, InData%TwFAM1Sh) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TwFAM2Sh)) if (allocated(InData%TwFAM2Sh)) then call RegPackBounds(Buf, 1, lbound(InData%TwFAM2Sh), ubound(InData%TwFAM2Sh)) call RegPack(Buf, InData%TwFAM2Sh) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TwSSM1Sh)) if (allocated(InData%TwSSM1Sh)) then call RegPackBounds(Buf, 1, lbound(InData%TwSSM1Sh), ubound(InData%TwSSM1Sh)) call RegPack(Buf, InData%TwSSM1Sh) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TwSSM2Sh)) if (allocated(InData%TwSSM2Sh)) then call RegPackBounds(Buf, 1, lbound(InData%TwSSM2Sh), ubound(InData%TwSSM2Sh)) call RegPack(Buf, InData%TwSSM2Sh) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RFrlDOF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFrlDOF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RotFurl) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TailFurl) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Yaw2Shft) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ShftSkew) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RFrlCM_n) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BoomCM_n) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFinCM_n) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RFrlPnt_n) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RFrlSkew) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RFrlTilt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFrlPnt_n) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFrlSkew) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFrlTilt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RFrlMass) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BoomMass) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFinMass) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RFrlIner) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFrlIner) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RFrlMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RFrlSpr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RFrlDmp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RFrlUSSP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RFrlDSSP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RFrlUSSpr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RFrlDSSpr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RFrlUSDP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RFrlDSDP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RFrlUSDmp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RFrlDSDmp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFrlMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFrlSpr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFrlDmp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFrlUSSP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFrlDSSP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFrlUSSpr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFrlDSSpr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFrlUSDP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFrlDSDP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFrlUSDmp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFrlDSDmp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%method) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BldNd_NumOuts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BldNd_OutList)) if (allocated(InData%BldNd_OutList)) then call RegPackBounds(Buf, 1, lbound(InData%BldNd_OutList), ubound(InData%BldNd_OutList)) call RegPack(Buf, InData%BldNd_OutList) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BldNd_BlOutNd_Str) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BldNd_BladesOut) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3739,175 +3535,126 @@ subroutine ED_PackCoordSys(Buf, Indata) character(*), parameter :: RoutineName = 'ED_PackCoordSys' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%a1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%a2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%a3) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%b1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%b2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%b3) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%c1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%c2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%c3) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%d1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%d2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%d3) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%e1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%e2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%e3) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%f1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%f2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%f3) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%g1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%g2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%g3) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%i1)) if (allocated(InData%i1)) then call RegPackBounds(Buf, 2, lbound(InData%i1), ubound(InData%i1)) call RegPack(Buf, InData%i1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%i2)) if (allocated(InData%i2)) then call RegPackBounds(Buf, 2, lbound(InData%i2), ubound(InData%i2)) call RegPack(Buf, InData%i2) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%i3)) if (allocated(InData%i3)) then call RegPackBounds(Buf, 2, lbound(InData%i3), ubound(InData%i3)) call RegPack(Buf, InData%i3) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%j1)) if (allocated(InData%j1)) then call RegPackBounds(Buf, 2, lbound(InData%j1), ubound(InData%j1)) call RegPack(Buf, InData%j1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%j2)) if (allocated(InData%j2)) then call RegPackBounds(Buf, 2, lbound(InData%j2), ubound(InData%j2)) call RegPack(Buf, InData%j2) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%j3)) if (allocated(InData%j3)) then call RegPackBounds(Buf, 2, lbound(InData%j3), ubound(InData%j3)) call RegPack(Buf, InData%j3) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%m1)) if (allocated(InData%m1)) then call RegPackBounds(Buf, 3, lbound(InData%m1), ubound(InData%m1)) call RegPack(Buf, InData%m1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%m2)) if (allocated(InData%m2)) then call RegPackBounds(Buf, 3, lbound(InData%m2), ubound(InData%m2)) call RegPack(Buf, InData%m2) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%m3)) if (allocated(InData%m3)) then call RegPackBounds(Buf, 3, lbound(InData%m3), ubound(InData%m3)) call RegPack(Buf, InData%m3) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%n1)) if (allocated(InData%n1)) then call RegPackBounds(Buf, 3, lbound(InData%n1), ubound(InData%n1)) call RegPack(Buf, InData%n1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%n2)) if (allocated(InData%n2)) then call RegPackBounds(Buf, 3, lbound(InData%n2), ubound(InData%n2)) call RegPack(Buf, InData%n2) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%n3)) if (allocated(InData%n3)) then call RegPackBounds(Buf, 3, lbound(InData%n3), ubound(InData%n3)) call RegPack(Buf, InData%n3) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rf1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rf2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rf3) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rfa) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%t1)) if (allocated(InData%t1)) then call RegPackBounds(Buf, 2, lbound(InData%t1), ubound(InData%t1)) call RegPack(Buf, InData%t1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%t2)) if (allocated(InData%t2)) then call RegPackBounds(Buf, 2, lbound(InData%t2), ubound(InData%t2)) call RegPack(Buf, InData%t2) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%t3)) if (allocated(InData%t3)) then call RegPackBounds(Buf, 2, lbound(InData%t3), ubound(InData%t3)) call RegPack(Buf, InData%t3) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%te1)) if (allocated(InData%te1)) then call RegPackBounds(Buf, 3, lbound(InData%te1), ubound(InData%te1)) call RegPack(Buf, InData%te1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%te2)) if (allocated(InData%te2)) then call RegPackBounds(Buf, 3, lbound(InData%te2), ubound(InData%te2)) call RegPack(Buf, InData%te2) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%te3)) if (allocated(InData%te3)) then call RegPackBounds(Buf, 3, lbound(InData%te3), ubound(InData%te3)) call RegPack(Buf, InData%te3) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%tf1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%tf2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%tf3) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%tfa) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%z1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%z2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%z3) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -4529,105 +4276,83 @@ subroutine ED_PackActiveDOFs(Buf, Indata) character(*), parameter :: RoutineName = 'ED_PackActiveDOFs' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%NActvDOF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NPCE) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NPDE) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NPIE) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NPTE) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NPTTE) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%NPSBE)) if (allocated(InData%NPSBE)) then call RegPackBounds(Buf, 1, lbound(InData%NPSBE), ubound(InData%NPSBE)) call RegPack(Buf, InData%NPSBE) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%NPSE)) if (allocated(InData%NPSE)) then call RegPackBounds(Buf, 1, lbound(InData%NPSE), ubound(InData%NPSE)) call RegPack(Buf, InData%NPSE) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NPUE) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NPYE) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PCE)) if (allocated(InData%PCE)) then call RegPackBounds(Buf, 1, lbound(InData%PCE), ubound(InData%PCE)) call RegPack(Buf, InData%PCE) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PDE)) if (allocated(InData%PDE)) then call RegPackBounds(Buf, 1, lbound(InData%PDE), ubound(InData%PDE)) call RegPack(Buf, InData%PDE) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PIE)) if (allocated(InData%PIE)) then call RegPackBounds(Buf, 1, lbound(InData%PIE), ubound(InData%PIE)) call RegPack(Buf, InData%PIE) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PTE)) if (allocated(InData%PTE)) then call RegPackBounds(Buf, 1, lbound(InData%PTE), ubound(InData%PTE)) call RegPack(Buf, InData%PTE) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PTTE)) if (allocated(InData%PTTE)) then call RegPackBounds(Buf, 1, lbound(InData%PTTE), ubound(InData%PTTE)) call RegPack(Buf, InData%PTTE) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PS)) if (allocated(InData%PS)) then call RegPackBounds(Buf, 1, lbound(InData%PS), ubound(InData%PS)) call RegPack(Buf, InData%PS) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PSBE)) if (allocated(InData%PSBE)) then call RegPackBounds(Buf, 2, lbound(InData%PSBE), ubound(InData%PSBE)) call RegPack(Buf, InData%PSBE) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PSE)) if (allocated(InData%PSE)) then call RegPackBounds(Buf, 2, lbound(InData%PSE), ubound(InData%PSE)) call RegPack(Buf, InData%PSE) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PUE)) if (allocated(InData%PUE)) then call RegPackBounds(Buf, 1, lbound(InData%PUE), ubound(InData%PUE)) call RegPack(Buf, InData%PUE) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PYE)) if (allocated(InData%PYE)) then call RegPackBounds(Buf, 1, lbound(InData%PYE), ubound(InData%PYE)) call RegPack(Buf, InData%PYE) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%SrtPS)) if (allocated(InData%SrtPS)) then call RegPackBounds(Buf, 1, lbound(InData%SrtPS), ubound(InData%SrtPS)) call RegPack(Buf, InData%SrtPS) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%SrtPSNAUG)) if (allocated(InData%SrtPSNAUG)) then call RegPackBounds(Buf, 1, lbound(InData%SrtPSNAUG), ubound(InData%SrtPSNAUG)) call RegPack(Buf, InData%SrtPSNAUG) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Diag)) if (allocated(InData%Diag)) then call RegPackBounds(Buf, 1, lbound(InData%Diag), ubound(InData%Diag)) @@ -6147,561 +5872,419 @@ subroutine ED_PackRtHndSide(Buf, Indata) character(*), parameter :: RoutineName = 'ED_PackRtHndSide' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%rO) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%rQS)) if (allocated(InData%rQS)) then call RegPackBounds(Buf, 3, lbound(InData%rQS), ubound(InData%rQS)) call RegPack(Buf, InData%rQS) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%rS)) if (allocated(InData%rS)) then call RegPackBounds(Buf, 3, lbound(InData%rS), ubound(InData%rS)) call RegPack(Buf, InData%rS) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%rS0S)) if (allocated(InData%rS0S)) then call RegPackBounds(Buf, 3, lbound(InData%rS0S), ubound(InData%rS0S)) call RegPack(Buf, InData%rS0S) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%rT)) if (allocated(InData%rT)) then call RegPackBounds(Buf, 2, lbound(InData%rT), ubound(InData%rT)) call RegPack(Buf, InData%rT) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rT0O) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%rT0T)) if (allocated(InData%rT0T)) then call RegPackBounds(Buf, 2, lbound(InData%rT0T), ubound(InData%rT0T)) call RegPack(Buf, InData%rT0T) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rZ) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rZO) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%rZT)) if (allocated(InData%rZT)) then call RegPackBounds(Buf, 2, lbound(InData%rZT), ubound(InData%rZT)) call RegPack(Buf, InData%rZT) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rPQ) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rV) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rJ) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rZY) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rOU) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rOV) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rVD) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rOW) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rPC) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%rPS0)) if (allocated(InData%rPS0)) then call RegPackBounds(Buf, 2, lbound(InData%rPS0), ubound(InData%rPS0)) call RegPack(Buf, InData%rPS0) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rQ) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rQC) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rVIMU) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rVP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rWI) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rWJ) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rZT0) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AngPosEF)) if (allocated(InData%AngPosEF)) then call RegPackBounds(Buf, 2, lbound(InData%AngPosEF), ubound(InData%AngPosEF)) call RegPack(Buf, InData%AngPosEF) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AngPosXF)) if (allocated(InData%AngPosXF)) then call RegPackBounds(Buf, 2, lbound(InData%AngPosXF), ubound(InData%AngPosXF)) call RegPack(Buf, InData%AngPosXF) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AngPosHM)) if (allocated(InData%AngPosHM)) then call RegPackBounds(Buf, 3, lbound(InData%AngPosHM), ubound(InData%AngPosHM)) call RegPack(Buf, InData%AngPosHM) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AngPosXB) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AngPosEX) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PAngVelEA)) if (allocated(InData%PAngVelEA)) then call RegPackBounds(Buf, 3, lbound(InData%PAngVelEA), ubound(InData%PAngVelEA)) call RegPack(Buf, InData%PAngVelEA) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PAngVelEF)) if (allocated(InData%PAngVelEF)) then call RegPackBounds(Buf, 4, lbound(InData%PAngVelEF), ubound(InData%PAngVelEF)) call RegPack(Buf, InData%PAngVelEF) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PAngVelEG)) if (allocated(InData%PAngVelEG)) then call RegPackBounds(Buf, 3, lbound(InData%PAngVelEG), ubound(InData%PAngVelEG)) call RegPack(Buf, InData%PAngVelEG) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PAngVelEH)) if (allocated(InData%PAngVelEH)) then call RegPackBounds(Buf, 3, lbound(InData%PAngVelEH), ubound(InData%PAngVelEH)) call RegPack(Buf, InData%PAngVelEH) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PAngVelEL)) if (allocated(InData%PAngVelEL)) then call RegPackBounds(Buf, 3, lbound(InData%PAngVelEL), ubound(InData%PAngVelEL)) call RegPack(Buf, InData%PAngVelEL) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PAngVelEM)) if (allocated(InData%PAngVelEM)) then call RegPackBounds(Buf, 5, lbound(InData%PAngVelEM), ubound(InData%PAngVelEM)) call RegPack(Buf, InData%PAngVelEM) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AngVelEM)) if (allocated(InData%AngVelEM)) then call RegPackBounds(Buf, 3, lbound(InData%AngVelEM), ubound(InData%AngVelEM)) call RegPack(Buf, InData%AngVelEM) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PAngVelEN)) if (allocated(InData%PAngVelEN)) then call RegPackBounds(Buf, 3, lbound(InData%PAngVelEN), ubound(InData%PAngVelEN)) call RegPack(Buf, InData%PAngVelEN) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AngVelEA) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PAngVelEB)) if (allocated(InData%PAngVelEB)) then call RegPackBounds(Buf, 3, lbound(InData%PAngVelEB), ubound(InData%PAngVelEB)) call RegPack(Buf, InData%PAngVelEB) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PAngVelER)) if (allocated(InData%PAngVelER)) then call RegPackBounds(Buf, 3, lbound(InData%PAngVelER), ubound(InData%PAngVelER)) call RegPack(Buf, InData%PAngVelER) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PAngVelEX)) if (allocated(InData%PAngVelEX)) then call RegPackBounds(Buf, 3, lbound(InData%PAngVelEX), ubound(InData%PAngVelEX)) call RegPack(Buf, InData%PAngVelEX) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AngVelEG) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AngVelEH) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AngVelEL) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AngVelEN) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AngVelEB) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AngVelER) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AngVelEX) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TeetAngVel) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AngAccEBt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AngAccERt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AngAccEXt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AngAccEFt)) if (allocated(InData%AngAccEFt)) then call RegPackBounds(Buf, 2, lbound(InData%AngAccEFt), ubound(InData%AngAccEFt)) call RegPack(Buf, InData%AngAccEFt) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AngVelEF)) if (allocated(InData%AngVelEF)) then call RegPackBounds(Buf, 2, lbound(InData%AngVelEF), ubound(InData%AngVelEF)) call RegPack(Buf, InData%AngVelEF) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AngVelHM)) if (allocated(InData%AngVelHM)) then call RegPackBounds(Buf, 3, lbound(InData%AngVelHM), ubound(InData%AngVelHM)) call RegPack(Buf, InData%AngVelHM) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AngAccEAt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AngAccEGt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AngAccEHt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AngAccEKt)) if (allocated(InData%AngAccEKt)) then call RegPackBounds(Buf, 3, lbound(InData%AngAccEKt), ubound(InData%AngAccEKt)) call RegPack(Buf, InData%AngAccEKt) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AngAccENt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LinAccECt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LinAccEDt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LinAccEIt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LinAccEJt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LinAccEUt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LinAccEYt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LinVelES)) if (allocated(InData%LinVelES)) then call RegPackBounds(Buf, 3, lbound(InData%LinVelES), ubound(InData%LinVelES)) call RegPack(Buf, InData%LinVelES) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LinVelEQ) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LinVelET)) if (allocated(InData%LinVelET)) then call RegPackBounds(Buf, 2, lbound(InData%LinVelET), ubound(InData%LinVelET)) call RegPack(Buf, InData%LinVelET) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LinVelESm2)) if (allocated(InData%LinVelESm2)) then call RegPackBounds(Buf, 1, lbound(InData%LinVelESm2), ubound(InData%LinVelESm2)) call RegPack(Buf, InData%LinVelESm2) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PLinVelEIMU)) if (allocated(InData%PLinVelEIMU)) then call RegPackBounds(Buf, 3, lbound(InData%PLinVelEIMU), ubound(InData%PLinVelEIMU)) call RegPack(Buf, InData%PLinVelEIMU) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PLinVelEO)) if (allocated(InData%PLinVelEO)) then call RegPackBounds(Buf, 3, lbound(InData%PLinVelEO), ubound(InData%PLinVelEO)) call RegPack(Buf, InData%PLinVelEO) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PLinVelES)) if (allocated(InData%PLinVelES)) then call RegPackBounds(Buf, 5, lbound(InData%PLinVelES), ubound(InData%PLinVelES)) call RegPack(Buf, InData%PLinVelES) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PLinVelET)) if (allocated(InData%PLinVelET)) then call RegPackBounds(Buf, 4, lbound(InData%PLinVelET), ubound(InData%PLinVelET)) call RegPack(Buf, InData%PLinVelET) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PLinVelEZ)) if (allocated(InData%PLinVelEZ)) then call RegPackBounds(Buf, 3, lbound(InData%PLinVelEZ), ubound(InData%PLinVelEZ)) call RegPack(Buf, InData%PLinVelEZ) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PLinVelEC)) if (allocated(InData%PLinVelEC)) then call RegPackBounds(Buf, 3, lbound(InData%PLinVelEC), ubound(InData%PLinVelEC)) call RegPack(Buf, InData%PLinVelEC) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PLinVelED)) if (allocated(InData%PLinVelED)) then call RegPackBounds(Buf, 3, lbound(InData%PLinVelED), ubound(InData%PLinVelED)) call RegPack(Buf, InData%PLinVelED) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PLinVelEI)) if (allocated(InData%PLinVelEI)) then call RegPackBounds(Buf, 3, lbound(InData%PLinVelEI), ubound(InData%PLinVelEI)) call RegPack(Buf, InData%PLinVelEI) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PLinVelEJ)) if (allocated(InData%PLinVelEJ)) then call RegPackBounds(Buf, 3, lbound(InData%PLinVelEJ), ubound(InData%PLinVelEJ)) call RegPack(Buf, InData%PLinVelEJ) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PLinVelEP)) if (allocated(InData%PLinVelEP)) then call RegPackBounds(Buf, 3, lbound(InData%PLinVelEP), ubound(InData%PLinVelEP)) call RegPack(Buf, InData%PLinVelEP) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PLinVelEQ)) if (allocated(InData%PLinVelEQ)) then call RegPackBounds(Buf, 3, lbound(InData%PLinVelEQ), ubound(InData%PLinVelEQ)) call RegPack(Buf, InData%PLinVelEQ) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PLinVelEU)) if (allocated(InData%PLinVelEU)) then call RegPackBounds(Buf, 3, lbound(InData%PLinVelEU), ubound(InData%PLinVelEU)) call RegPack(Buf, InData%PLinVelEU) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PLinVelEV)) if (allocated(InData%PLinVelEV)) then call RegPackBounds(Buf, 3, lbound(InData%PLinVelEV), ubound(InData%PLinVelEV)) call RegPack(Buf, InData%PLinVelEV) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PLinVelEW)) if (allocated(InData%PLinVelEW)) then call RegPackBounds(Buf, 3, lbound(InData%PLinVelEW), ubound(InData%PLinVelEW)) call RegPack(Buf, InData%PLinVelEW) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PLinVelEY)) if (allocated(InData%PLinVelEY)) then call RegPackBounds(Buf, 3, lbound(InData%PLinVelEY), ubound(InData%PLinVelEY)) call RegPack(Buf, InData%PLinVelEY) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LinAccEIMUt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LinAccEOt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LinAccESt)) if (allocated(InData%LinAccESt)) then call RegPackBounds(Buf, 3, lbound(InData%LinAccESt), ubound(InData%LinAccESt)) call RegPack(Buf, InData%LinAccESt) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LinAccETt)) if (allocated(InData%LinAccETt)) then call RegPackBounds(Buf, 2, lbound(InData%LinAccETt), ubound(InData%LinAccETt)) call RegPack(Buf, InData%LinAccETt) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LinAccEZt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LinVelEIMU) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LinVelEZ) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LinVelEO) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LinVelEJ) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FrcONcRtt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FrcPRott) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FrcS0Bt)) if (allocated(InData%FrcS0Bt)) then call RegPackBounds(Buf, 2, lbound(InData%FrcS0Bt), ubound(InData%FrcS0Bt)) call RegPack(Buf, InData%FrcS0Bt) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FrcT0Trbt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FSAero)) if (allocated(InData%FSAero)) then call RegPackBounds(Buf, 3, lbound(InData%FSAero), ubound(InData%FSAero)) call RegPack(Buf, InData%FSAero) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FSTipDrag)) if (allocated(InData%FSTipDrag)) then call RegPackBounds(Buf, 2, lbound(InData%FSTipDrag), ubound(InData%FSTipDrag)) call RegPack(Buf, InData%FSTipDrag) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FTHydrot)) if (allocated(InData%FTHydrot)) then call RegPackBounds(Buf, 2, lbound(InData%FTHydrot), ubound(InData%FTHydrot)) call RegPack(Buf, InData%FTHydrot) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FZHydrot) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%MFHydrot)) if (allocated(InData%MFHydrot)) then call RegPackBounds(Buf, 2, lbound(InData%MFHydrot), ubound(InData%MFHydrot)) call RegPack(Buf, InData%MFHydrot) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MomBNcRtt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%MomH0Bt)) if (allocated(InData%MomH0Bt)) then call RegPackBounds(Buf, 2, lbound(InData%MomH0Bt), ubound(InData%MomH0Bt)) call RegPack(Buf, InData%MomH0Bt) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MomLPRott) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MomNGnRtt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MomNTailt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MomX0Trbt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%MMAero)) if (allocated(InData%MMAero)) then call RegPackBounds(Buf, 3, lbound(InData%MMAero), ubound(InData%MMAero)) call RegPack(Buf, InData%MMAero) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MXHydrot) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PFrcONcRt)) if (allocated(InData%PFrcONcRt)) then call RegPackBounds(Buf, 2, lbound(InData%PFrcONcRt), ubound(InData%PFrcONcRt)) call RegPack(Buf, InData%PFrcONcRt) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PFrcPRot)) if (allocated(InData%PFrcPRot)) then call RegPackBounds(Buf, 2, lbound(InData%PFrcPRot), ubound(InData%PFrcPRot)) call RegPack(Buf, InData%PFrcPRot) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PFrcS0B)) if (allocated(InData%PFrcS0B)) then call RegPackBounds(Buf, 3, lbound(InData%PFrcS0B), ubound(InData%PFrcS0B)) call RegPack(Buf, InData%PFrcS0B) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PFrcT0Trb)) if (allocated(InData%PFrcT0Trb)) then call RegPackBounds(Buf, 2, lbound(InData%PFrcT0Trb), ubound(InData%PFrcT0Trb)) call RegPack(Buf, InData%PFrcT0Trb) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PFTHydro)) if (allocated(InData%PFTHydro)) then call RegPackBounds(Buf, 3, lbound(InData%PFTHydro), ubound(InData%PFTHydro)) call RegPack(Buf, InData%PFTHydro) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PFZHydro) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PMFHydro)) if (allocated(InData%PMFHydro)) then call RegPackBounds(Buf, 3, lbound(InData%PMFHydro), ubound(InData%PMFHydro)) call RegPack(Buf, InData%PMFHydro) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PMomBNcRt)) if (allocated(InData%PMomBNcRt)) then call RegPackBounds(Buf, 2, lbound(InData%PMomBNcRt), ubound(InData%PMomBNcRt)) call RegPack(Buf, InData%PMomBNcRt) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PMomH0B)) if (allocated(InData%PMomH0B)) then call RegPackBounds(Buf, 3, lbound(InData%PMomH0B), ubound(InData%PMomH0B)) call RegPack(Buf, InData%PMomH0B) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PMomLPRot)) if (allocated(InData%PMomLPRot)) then call RegPackBounds(Buf, 2, lbound(InData%PMomLPRot), ubound(InData%PMomLPRot)) call RegPack(Buf, InData%PMomLPRot) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PMomNGnRt)) if (allocated(InData%PMomNGnRt)) then call RegPackBounds(Buf, 2, lbound(InData%PMomNGnRt), ubound(InData%PMomNGnRt)) call RegPack(Buf, InData%PMomNGnRt) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PMomNTail)) if (allocated(InData%PMomNTail)) then call RegPackBounds(Buf, 2, lbound(InData%PMomNTail), ubound(InData%PMomNTail)) call RegPack(Buf, InData%PMomNTail) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PMomX0Trb)) if (allocated(InData%PMomX0Trb)) then call RegPackBounds(Buf, 2, lbound(InData%PMomX0Trb), ubound(InData%PMomX0Trb)) call RegPack(Buf, InData%PMomX0Trb) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PMXHydro) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TeetAng) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FrcVGnRtt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FrcWTailt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FrcZAllt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MomXAllt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PFrcVGnRt)) if (allocated(InData%PFrcVGnRt)) then call RegPackBounds(Buf, 2, lbound(InData%PFrcVGnRt), ubound(InData%PFrcVGnRt)) call RegPack(Buf, InData%PFrcVGnRt) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PFrcWTail)) if (allocated(InData%PFrcWTail)) then call RegPackBounds(Buf, 2, lbound(InData%PFrcWTail), ubound(InData%PFrcWTail)) call RegPack(Buf, InData%PFrcWTail) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PFrcZAll)) if (allocated(InData%PFrcZAll)) then call RegPackBounds(Buf, 2, lbound(InData%PFrcZAll), ubound(InData%PFrcZAll)) call RegPack(Buf, InData%PFrcZAll) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PMomXAll)) if (allocated(InData%PMomXAll)) then call RegPackBounds(Buf, 2, lbound(InData%PMomXAll), ubound(InData%PMomXAll)) call RegPack(Buf, InData%PMomXAll) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TeetMom) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFrlMom) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RFrlMom) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%GBoxEffFac) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%rSAerCen)) if (allocated(InData%rSAerCen)) then call RegPackBounds(Buf, 3, lbound(InData%rSAerCen), ubound(InData%rSAerCen)) @@ -7900,7 +7483,6 @@ subroutine ED_PackContState(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%QT), ubound(InData%QT)) call RegPack(Buf, InData%QT) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%QDT)) if (allocated(InData%QDT)) then call RegPackBounds(Buf, 1, lbound(InData%QDT), ubound(InData%QDT)) @@ -8090,25 +7672,19 @@ subroutine ED_PackOtherState(Buf, Indata) integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%n) - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%xdot) UB(1:1) = ubound(InData%xdot) do i1 = LB(1), UB(1) call ED_PackContState(Buf, InData%xdot(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%IC)) if (allocated(InData%IC)) then call RegPackBounds(Buf, 1, lbound(InData%IC), ubound(InData%IC)) call RegPack(Buf, InData%IC) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HSSBrTrq) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HSSBrTrqC) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SgnPrvLSTQ) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SgnLSTQ) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -8310,51 +7886,42 @@ subroutine ED_PackMisc(Buf, Indata) character(*), parameter :: RoutineName = 'ED_PackMisc' if (Buf%ErrStat >= AbortErrLev) return call ED_PackCoordSys(Buf, InData%CoordSys) - if (RegCheckErr(Buf, RoutineName)) return call ED_PackRtHndSide(Buf, InData%RtHS) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AllOuts)) if (allocated(InData%AllOuts)) then call RegPackBounds(Buf, 1, lbound(InData%AllOuts), ubound(InData%AllOuts)) call RegPack(Buf, InData%AllOuts) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AugMat)) if (allocated(InData%AugMat)) then call RegPackBounds(Buf, 2, lbound(InData%AugMat), ubound(InData%AugMat)) call RegPack(Buf, InData%AugMat) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AugMat_factor)) if (allocated(InData%AugMat_factor)) then call RegPackBounds(Buf, 2, lbound(InData%AugMat_factor), ubound(InData%AugMat_factor)) call RegPack(Buf, InData%AugMat_factor) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%SolnVec)) if (allocated(InData%SolnVec)) then call RegPackBounds(Buf, 1, lbound(InData%SolnVec), ubound(InData%SolnVec)) call RegPack(Buf, InData%SolnVec) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AugMat_pivot)) if (allocated(InData%AugMat_pivot)) then call RegPackBounds(Buf, 1, lbound(InData%AugMat_pivot), ubound(InData%AugMat_pivot)) call RegPack(Buf, InData%AugMat_pivot) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OgnlGeAzRo)) if (allocated(InData%OgnlGeAzRo)) then call RegPackBounds(Buf, 1, lbound(InData%OgnlGeAzRo), ubound(InData%OgnlGeAzRo)) call RegPack(Buf, InData%OgnlGeAzRo) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%QD2T)) if (allocated(InData%QD2T)) then call RegPackBounds(Buf, 1, lbound(InData%QD2T), ubound(InData%QD2T)) call RegPack(Buf, InData%QD2T) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%IgnoreMod) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -9675,57 +9242,39 @@ subroutine ED_PackParam(Buf, Indata) integer(IntKi) :: LB(5), UB(5) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%DT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DT24) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BldNodes) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TipNode) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NDOF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TwoPiNB) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NAug) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NPH) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PH)) if (allocated(InData%PH)) then call RegPackBounds(Buf, 1, lbound(InData%PH), ubound(InData%PH)) call RegPack(Buf, InData%PH) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NPM) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PM)) if (allocated(InData%PM)) then call RegPackBounds(Buf, 2, lbound(InData%PM), ubound(InData%PM)) call RegPack(Buf, InData%PM) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%DOF_Flag)) if (allocated(InData%DOF_Flag)) then call RegPackBounds(Buf, 1, lbound(InData%DOF_Flag), ubound(InData%DOF_Flag)) call RegPack(Buf, InData%DOF_Flag) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%DOF_Desc)) if (allocated(InData%DOF_Desc)) then call RegPackBounds(Buf, 1, lbound(InData%DOF_Desc), ubound(InData%DOF_Desc)) call RegPack(Buf, InData%DOF_Desc) end if - if (RegCheckErr(Buf, RoutineName)) return call ED_PackActiveDOFs(Buf, InData%DOFs) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutFmt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NBlGages) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NTwGages) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) @@ -9735,589 +9284,395 @@ subroutine ED_PackParam(Buf, Indata) call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Delim) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AvgNrmTpRd) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AzimB1Up) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CosDel3) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CosPreC)) if (allocated(InData%CosPreC)) then call RegPackBounds(Buf, 1, lbound(InData%CosPreC), ubound(InData%CosPreC)) call RegPack(Buf, InData%CosPreC) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CRFrlSkew) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CRFrlSkw2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CRFrlTilt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CRFrlTlt2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CShftSkew) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CShftTilt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CSRFrlSkw) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CSRFrlTlt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CSTFrlSkw) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CSTFrlTlt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CTFrlSkew) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CTFrlSkw2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CTFrlTilt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CTFrlTlt2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HubHt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HubCM) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HubRad) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NacCMxn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NacCMyn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NacCMzn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OverHang) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ProjArea) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PtfmRefzt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RefTwrHt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RFrlPnt_n) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rVDxn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rVDyn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rVDzn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rVIMUxn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rVIMUyn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rVIMUzn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rVPxn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rVPyn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rVPzn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rWIxn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rWIyn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rWIzn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rWJxn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rWJyn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rWJzn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rZT0zt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rZYzt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SinDel3) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%SinPreC)) if (allocated(InData%SinPreC)) then call RegPackBounds(Buf, 1, lbound(InData%SinPreC), ubound(InData%SinPreC)) call RegPack(Buf, InData%SinPreC) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SRFrlSkew) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SRFrlSkw2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SRFrlTilt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SRFrlTlt2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SShftSkew) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SShftTilt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%STFrlSkew) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%STFrlSkw2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%STFrlTilt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%STFrlTlt2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFrlPnt_n) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TipRad) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TowerHt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TowerBsHt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UndSling) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumBl) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AxRedTFA)) if (allocated(InData%AxRedTFA)) then call RegPackBounds(Buf, 3, lbound(InData%AxRedTFA), ubound(InData%AxRedTFA)) call RegPack(Buf, InData%AxRedTFA) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AxRedTSS)) if (allocated(InData%AxRedTSS)) then call RegPackBounds(Buf, 3, lbound(InData%AxRedTSS), ubound(InData%AxRedTSS)) call RegPack(Buf, InData%AxRedTSS) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CTFA) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CTSS) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%DHNodes)) if (allocated(InData%DHNodes)) then call RegPackBounds(Buf, 1, lbound(InData%DHNodes), ubound(InData%DHNodes)) call RegPack(Buf, InData%DHNodes) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%HNodes)) if (allocated(InData%HNodes)) then call RegPackBounds(Buf, 1, lbound(InData%HNodes), ubound(InData%HNodes)) call RegPack(Buf, InData%HNodes) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%HNodesNorm)) if (allocated(InData%HNodesNorm)) then call RegPackBounds(Buf, 1, lbound(InData%HNodesNorm), ubound(InData%HNodesNorm)) call RegPack(Buf, InData%HNodesNorm) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%KTFA) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%KTSS) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%MassT)) if (allocated(InData%MassT)) then call RegPackBounds(Buf, 1, lbound(InData%MassT), ubound(InData%MassT)) call RegPack(Buf, InData%MassT) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%StiffTSS)) if (allocated(InData%StiffTSS)) then call RegPackBounds(Buf, 1, lbound(InData%StiffTSS), ubound(InData%StiffTSS)) call RegPack(Buf, InData%StiffTSS) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TwrFASF)) if (allocated(InData%TwrFASF)) then call RegPackBounds(Buf, 3, lbound(InData%TwrFASF), ubound(InData%TwrFASF)) call RegPack(Buf, InData%TwrFASF) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TwrFlexL) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TwrSSSF)) if (allocated(InData%TwrSSSF)) then call RegPackBounds(Buf, 3, lbound(InData%TwrSSSF), ubound(InData%TwrSSSF)) call RegPack(Buf, InData%TwrSSSF) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TTopNode) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TwrNodes) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MHK) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%StiffTFA)) if (allocated(InData%StiffTFA)) then call RegPackBounds(Buf, 1, lbound(InData%StiffTFA), ubound(InData%StiffTFA)) call RegPack(Buf, InData%StiffTFA) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AtfaIner) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BldCG)) if (allocated(InData%BldCG)) then call RegPackBounds(Buf, 1, lbound(InData%BldCG), ubound(InData%BldCG)) call RegPack(Buf, InData%BldCG) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BldMass)) if (allocated(InData%BldMass)) then call RegPackBounds(Buf, 1, lbound(InData%BldMass), ubound(InData%BldMass)) call RegPack(Buf, InData%BldMass) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BoomMass) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FirstMom)) if (allocated(InData%FirstMom)) then call RegPackBounds(Buf, 1, lbound(InData%FirstMom), ubound(InData%FirstMom)) call RegPack(Buf, InData%FirstMom) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%GenIner) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Hubg1Iner) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Hubg2Iner) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HubMass) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Nacd2Iner) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NacMass) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PtfmMass) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PtfmPIner) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PtfmRIner) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PtfmYIner) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RFrlMass) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RotIner) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RotMass) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RrfaIner) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%SecondMom)) if (allocated(InData%SecondMom)) then call RegPackBounds(Buf, 1, lbound(InData%SecondMom), ubound(InData%SecondMom)) call RegPack(Buf, InData%SecondMom) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFinMass) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFrlIner) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TipMass)) if (allocated(InData%TipMass)) then call RegPackBounds(Buf, 1, lbound(InData%TipMass), ubound(InData%TipMass)) call RegPack(Buf, InData%TipMass) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TurbMass) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TwrMass) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TwrTpMass) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YawBrMass) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Gravity) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PitchAxis)) if (allocated(InData%PitchAxis)) then call RegPackBounds(Buf, 2, lbound(InData%PitchAxis), ubound(InData%PitchAxis)) call RegPack(Buf, InData%PitchAxis) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AeroTwst)) if (allocated(InData%AeroTwst)) then call RegPackBounds(Buf, 1, lbound(InData%AeroTwst), ubound(InData%AeroTwst)) call RegPack(Buf, InData%AeroTwst) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AxRedBld)) if (allocated(InData%AxRedBld)) then call RegPackBounds(Buf, 4, lbound(InData%AxRedBld), ubound(InData%AxRedBld)) call RegPack(Buf, InData%AxRedBld) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BldEDamp)) if (allocated(InData%BldEDamp)) then call RegPackBounds(Buf, 2, lbound(InData%BldEDamp), ubound(InData%BldEDamp)) call RegPack(Buf, InData%BldEDamp) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BldFDamp)) if (allocated(InData%BldFDamp)) then call RegPackBounds(Buf, 2, lbound(InData%BldFDamp), ubound(InData%BldFDamp)) call RegPack(Buf, InData%BldFDamp) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BldFlexL) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CAeroTwst)) if (allocated(InData%CAeroTwst)) then call RegPackBounds(Buf, 1, lbound(InData%CAeroTwst), ubound(InData%CAeroTwst)) call RegPack(Buf, InData%CAeroTwst) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CBE)) if (allocated(InData%CBE)) then call RegPackBounds(Buf, 3, lbound(InData%CBE), ubound(InData%CBE)) call RegPack(Buf, InData%CBE) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CBF)) if (allocated(InData%CBF)) then call RegPackBounds(Buf, 3, lbound(InData%CBF), ubound(InData%CBF)) call RegPack(Buf, InData%CBF) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Chord)) if (allocated(InData%Chord)) then call RegPackBounds(Buf, 1, lbound(InData%Chord), ubound(InData%Chord)) call RegPack(Buf, InData%Chord) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CThetaS)) if (allocated(InData%CThetaS)) then call RegPackBounds(Buf, 2, lbound(InData%CThetaS), ubound(InData%CThetaS)) call RegPack(Buf, InData%CThetaS) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%DRNodes)) if (allocated(InData%DRNodes)) then call RegPackBounds(Buf, 1, lbound(InData%DRNodes), ubound(InData%DRNodes)) call RegPack(Buf, InData%DRNodes) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FStTunr)) if (allocated(InData%FStTunr)) then call RegPackBounds(Buf, 2, lbound(InData%FStTunr), ubound(InData%FStTunr)) call RegPack(Buf, InData%FStTunr) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%KBE)) if (allocated(InData%KBE)) then call RegPackBounds(Buf, 3, lbound(InData%KBE), ubound(InData%KBE)) call RegPack(Buf, InData%KBE) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%KBF)) if (allocated(InData%KBF)) then call RegPackBounds(Buf, 3, lbound(InData%KBF), ubound(InData%KBF)) call RegPack(Buf, InData%KBF) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%MassB)) if (allocated(InData%MassB)) then call RegPackBounds(Buf, 2, lbound(InData%MassB), ubound(InData%MassB)) call RegPack(Buf, InData%MassB) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RNodes)) if (allocated(InData%RNodes)) then call RegPackBounds(Buf, 1, lbound(InData%RNodes), ubound(InData%RNodes)) call RegPack(Buf, InData%RNodes) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RNodesNorm)) if (allocated(InData%RNodesNorm)) then call RegPackBounds(Buf, 1, lbound(InData%RNodesNorm), ubound(InData%RNodesNorm)) call RegPack(Buf, InData%RNodesNorm) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%rSAerCenn1)) if (allocated(InData%rSAerCenn1)) then call RegPackBounds(Buf, 2, lbound(InData%rSAerCenn1), ubound(InData%rSAerCenn1)) call RegPack(Buf, InData%rSAerCenn1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%rSAerCenn2)) if (allocated(InData%rSAerCenn2)) then call RegPackBounds(Buf, 2, lbound(InData%rSAerCenn2), ubound(InData%rSAerCenn2)) call RegPack(Buf, InData%rSAerCenn2) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%SAeroTwst)) if (allocated(InData%SAeroTwst)) then call RegPackBounds(Buf, 1, lbound(InData%SAeroTwst), ubound(InData%SAeroTwst)) call RegPack(Buf, InData%SAeroTwst) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%StiffBE)) if (allocated(InData%StiffBE)) then call RegPackBounds(Buf, 2, lbound(InData%StiffBE), ubound(InData%StiffBE)) call RegPack(Buf, InData%StiffBE) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%StiffBF)) if (allocated(InData%StiffBF)) then call RegPackBounds(Buf, 2, lbound(InData%StiffBF), ubound(InData%StiffBF)) call RegPack(Buf, InData%StiffBF) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%SThetaS)) if (allocated(InData%SThetaS)) then call RegPackBounds(Buf, 2, lbound(InData%SThetaS), ubound(InData%SThetaS)) call RegPack(Buf, InData%SThetaS) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ThetaS)) if (allocated(InData%ThetaS)) then call RegPackBounds(Buf, 2, lbound(InData%ThetaS), ubound(InData%ThetaS)) call RegPack(Buf, InData%ThetaS) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TwistedSF)) if (allocated(InData%TwistedSF)) then call RegPackBounds(Buf, 5, lbound(InData%TwistedSF), ubound(InData%TwistedSF)) call RegPack(Buf, InData%TwistedSF) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BldFl1Sh)) if (allocated(InData%BldFl1Sh)) then call RegPackBounds(Buf, 2, lbound(InData%BldFl1Sh), ubound(InData%BldFl1Sh)) call RegPack(Buf, InData%BldFl1Sh) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BldFl2Sh)) if (allocated(InData%BldFl2Sh)) then call RegPackBounds(Buf, 2, lbound(InData%BldFl2Sh), ubound(InData%BldFl2Sh)) call RegPack(Buf, InData%BldFl2Sh) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BldEdgSh)) if (allocated(InData%BldEdgSh)) then call RegPackBounds(Buf, 2, lbound(InData%BldEdgSh), ubound(InData%BldEdgSh)) call RegPack(Buf, InData%BldEdgSh) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FreqBE)) if (allocated(InData%FreqBE)) then call RegPackBounds(Buf, 3, lbound(InData%FreqBE), ubound(InData%FreqBE)) call RegPack(Buf, InData%FreqBE) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FreqBF)) if (allocated(InData%FreqBF)) then call RegPackBounds(Buf, 3, lbound(InData%FreqBF), ubound(InData%FreqBF)) call RegPack(Buf, InData%FreqBF) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FreqTFA) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FreqTSS) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TeetCDmp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TeetDmp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TeetDmpP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TeetHSSp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TeetHStP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TeetSSSp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TeetSStP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TeetMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFrlDmp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFrlDSDmp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFrlDSDP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFrlDSSP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFrlDSSpr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFrlSpr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFrlUSDmp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFrlUSDP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFrlUSSP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFrlUSSpr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TFrlMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RFrlDmp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RFrlDSDmp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RFrlDSDP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RFrlDSSP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RFrlDSSpr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RFrlSpr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RFrlUSDmp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RFrlUSDP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RFrlUSSP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RFrlUSSpr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RFrlMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ShftGagL) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BldGagNd) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TwrGagNd) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TStart) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DTTorDmp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DTTorSpr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%GBRatio) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%GBoxEff) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RotSpeed) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RootName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BElmntMass)) if (allocated(InData%BElmntMass)) then call RegPackBounds(Buf, 2, lbound(InData%BElmntMass), ubound(InData%BElmntMass)) call RegPack(Buf, InData%BElmntMass) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TElmntMass)) if (allocated(InData%TElmntMass)) then call RegPackBounds(Buf, 1, lbound(InData%TElmntMass), ubound(InData%TElmntMass)) call RegPack(Buf, InData%TElmntMass) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%method) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PtfmCMxt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PtfmCMyt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BD4Blades) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UseAD14) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BldNd_NumOuts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BldNd_TotNumOuts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BldNd_OutParam)) if (allocated(InData%BldNd_OutParam)) then call RegPackBounds(Buf, 1, lbound(InData%BldNd_OutParam), ubound(InData%BldNd_OutParam)) @@ -10327,27 +9682,22 @@ subroutine ED_PackParam(Buf, Indata) call NWTC_Library_PackOutParmType(Buf, InData%BldNd_OutParam(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BldNd_BladesOut) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Jac_u_indx)) if (allocated(InData%Jac_u_indx)) then call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx), ubound(InData%Jac_u_indx)) call RegPack(Buf, InData%Jac_u_indx) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%du)) if (allocated(InData%du)) then call RegPackBounds(Buf, 1, lbound(InData%du), ubound(InData%du)) call RegPack(Buf, InData%du) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%dx)) if (allocated(InData%dx)) then call RegPackBounds(Buf, 1, lbound(InData%dx), ubound(InData%dx)) call RegPack(Buf, InData%dx) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Jac_ny) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -11620,35 +10970,24 @@ subroutine ED_PackInput(Buf, Indata) call MeshPack(Buf, InData%BladePtLoads(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%PlatformPtMesh) - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%TowerPtLoads) - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%HubPtLoad) - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%NacelleLoads) - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%TFinCMLoads) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TwrAddedMass)) if (allocated(InData%TwrAddedMass)) then call RegPackBounds(Buf, 3, lbound(InData%TwrAddedMass), ubound(InData%TwrAddedMass)) call RegPack(Buf, InData%TwrAddedMass) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PtfmAddedMass) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BlPitchCom)) if (allocated(InData%BlPitchCom)) then call RegPackBounds(Buf, 1, lbound(InData%BlPitchCom), ubound(InData%BlPitchCom)) call RegPack(Buf, InData%BlPitchCom) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YawMom) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%GenTrq) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HSSBrTrqC) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -11905,17 +11244,11 @@ subroutine ED_PackOutput(Buf, Indata) call MeshPack(Buf, InData%BladeLn2Mesh(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%PlatformPtMesh) - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%TowerLn2Mesh) - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%HubPtMotion14) - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%HubPtMotion) - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%BladeRootMotion14) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BladeRootMotion)) if (allocated(InData%BladeRootMotion)) then call RegPackBounds(Buf, 1, lbound(InData%BladeRootMotion), ubound(InData%BladeRootMotion)) @@ -11925,77 +11258,45 @@ subroutine ED_PackOutput(Buf, Indata) call MeshPack(Buf, InData%BladeRootMotion(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%RotorFurlMotion14) - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%NacelleMotion) - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%TowerBaseMotion14) - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%TFinCMMotion) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) call RegPack(Buf, InData%WriteOutput) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BlPitch)) if (allocated(InData%BlPitch)) then call RegPackBounds(Buf, 1, lbound(InData%BlPitch), ubound(InData%BlPitch)) call RegPack(Buf, InData%BlPitch) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Yaw) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YawRate) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LSS_Spd) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HSS_Spd) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RotSpeed) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TwrAccel) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YawAngle) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RootMyc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YawBrTAxp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YawBrTAyp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LSSTipPxa) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RootMxc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LSSTipMxa) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LSSTipMya) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LSSTipMza) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LSSTipMys) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LSSTipMzs) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YawBrMyn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YawBrMzn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NcIMURAxs) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NcIMURAys) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NcIMURAzs) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RotPwr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LSShftFxa) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LSShftFys) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LSShftFzs) if (RegCheckErr(Buf, RoutineName)) return end subroutine diff --git a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 index 8831de1099..f2ae300e97 100644 --- a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 +++ b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 @@ -186,11 +186,8 @@ subroutine ExtPtfm_PackInitInput(Buf, Indata) character(*), parameter :: RoutineName = 'ExtPtfm_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%InputFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Linearize) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PtfmRefzt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RootName) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -318,47 +315,32 @@ subroutine ExtPtfm_PackInputFile(Buf, Indata) character(*), parameter :: RoutineName = 'ExtPtfm_PackInputFile' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%DT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%IntMethod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FileFormat) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RedFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RedFileCst) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%EquilStart) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ActiveCBDOF)) if (allocated(InData%ActiveCBDOF)) then call RegPackBounds(Buf, 1, lbound(InData%ActiveCBDOF), ubound(InData%ActiveCBDOF)) call RegPack(Buf, InData%ActiveCBDOF) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%InitPosList)) if (allocated(InData%InitPosList)) then call RegPackBounds(Buf, 1, lbound(InData%InitPosList), ubound(InData%InitPosList)) call RegPack(Buf, InData%InitPosList) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%InitVelList)) if (allocated(InData%InitVelList)) then call RegPackBounds(Buf, 1, lbound(InData%InitVelList), ubound(InData%InitVelList)) call RegPack(Buf, InData%InitVelList) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SumPrint) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TabDelim) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutFmt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Tstart) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OutList)) if (allocated(InData%OutList)) then call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) @@ -661,61 +643,51 @@ subroutine ExtPtfm_PackInitOutput(Buf, Indata) character(*), parameter :: RoutineName = 'ExtPtfm_PackInitOutput' if (Buf%ErrStat >= AbortErrLev) return call NWTC_Library_PackProgDesc(Buf, InData%Ver) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) call RegPack(Buf, InData%WriteOutputHdr) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) call RegPack(Buf, InData%WriteOutputUnt) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LinNames_y)) if (allocated(InData%LinNames_y)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) call RegPack(Buf, InData%LinNames_y) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LinNames_x)) if (allocated(InData%LinNames_x)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_x), ubound(InData%LinNames_x)) call RegPack(Buf, InData%LinNames_x) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LinNames_u)) if (allocated(InData%LinNames_u)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) call RegPack(Buf, InData%LinNames_u) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RotFrame_y)) if (allocated(InData%RotFrame_y)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y), ubound(InData%RotFrame_y)) call RegPack(Buf, InData%RotFrame_y) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RotFrame_x)) if (allocated(InData%RotFrame_x)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x), ubound(InData%RotFrame_x)) call RegPack(Buf, InData%RotFrame_x) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RotFrame_u)) if (allocated(InData%RotFrame_u)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u), ubound(InData%RotFrame_u)) call RegPack(Buf, InData%RotFrame_u) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%IsLoad_u)) if (allocated(InData%IsLoad_u)) then call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) call RegPack(Buf, InData%IsLoad_u) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%DerivOrder_x)) if (allocated(InData%DerivOrder_x)) then call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x), ubound(InData%DerivOrder_x)) @@ -941,7 +913,6 @@ subroutine ExtPtfm_PackContState(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%qm), ubound(InData%qm)) call RegPack(Buf, InData%qm) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%qmdot)) if (allocated(InData%qmdot)) then call RegPackBounds(Buf, 1, lbound(InData%qmdot), ubound(InData%qmdot)) @@ -1138,7 +1109,6 @@ subroutine ExtPtfm_PackOtherState(Buf, Indata) call ExtPtfm_PackContState(Buf, InData%xdot(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%n) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1257,19 +1227,14 @@ subroutine ExtPtfm_PackMisc(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%xFlat), ubound(InData%xFlat)) call RegPack(Buf, InData%xFlat) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%uFlat) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%F_at_t)) if (allocated(InData%F_at_t)) then call RegPackBounds(Buf, 1, lbound(InData%F_at_t), ubound(InData%F_at_t)) call RegPack(Buf, InData%F_at_t) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Indx) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%EquilStart) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AllOuts)) if (allocated(InData%AllOuts)) then call RegPackBounds(Buf, 1, lbound(InData%AllOuts), ubound(InData%AllOuts)) @@ -1801,147 +1766,118 @@ subroutine ExtPtfm_PackParam(Buf, Indata) call RegPackBounds(Buf, 2, lbound(InData%Mass), ubound(InData%Mass)) call RegPack(Buf, InData%Mass) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Damp)) if (allocated(InData%Damp)) then call RegPackBounds(Buf, 2, lbound(InData%Damp), ubound(InData%Damp)) call RegPack(Buf, InData%Damp) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Stff)) if (allocated(InData%Stff)) then call RegPackBounds(Buf, 2, lbound(InData%Stff), ubound(InData%Stff)) call RegPack(Buf, InData%Stff) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Forces)) if (allocated(InData%Forces)) then call RegPackBounds(Buf, 2, lbound(InData%Forces), ubound(InData%Forces)) call RegPack(Buf, InData%Forces) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%times)) if (allocated(InData%times)) then call RegPackBounds(Buf, 1, lbound(InData%times), ubound(InData%times)) call RegPack(Buf, InData%times) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AMat)) if (allocated(InData%AMat)) then call RegPackBounds(Buf, 2, lbound(InData%AMat), ubound(InData%AMat)) call RegPack(Buf, InData%AMat) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BMat)) if (allocated(InData%BMat)) then call RegPackBounds(Buf, 2, lbound(InData%BMat), ubound(InData%BMat)) call RegPack(Buf, InData%BMat) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CMat)) if (allocated(InData%CMat)) then call RegPackBounds(Buf, 2, lbound(InData%CMat), ubound(InData%CMat)) call RegPack(Buf, InData%CMat) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%DMat)) if (allocated(InData%DMat)) then call RegPackBounds(Buf, 2, lbound(InData%DMat), ubound(InData%DMat)) call RegPack(Buf, InData%DMat) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FX)) if (allocated(InData%FX)) then call RegPackBounds(Buf, 1, lbound(InData%FX), ubound(InData%FX)) call RegPack(Buf, InData%FX) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FY)) if (allocated(InData%FY)) then call RegPackBounds(Buf, 1, lbound(InData%FY), ubound(InData%FY)) call RegPack(Buf, InData%FY) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%M11)) if (allocated(InData%M11)) then call RegPackBounds(Buf, 2, lbound(InData%M11), ubound(InData%M11)) call RegPack(Buf, InData%M11) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%M12)) if (allocated(InData%M12)) then call RegPackBounds(Buf, 2, lbound(InData%M12), ubound(InData%M12)) call RegPack(Buf, InData%M12) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%M22)) if (allocated(InData%M22)) then call RegPackBounds(Buf, 2, lbound(InData%M22), ubound(InData%M22)) call RegPack(Buf, InData%M22) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%M21)) if (allocated(InData%M21)) then call RegPackBounds(Buf, 2, lbound(InData%M21), ubound(InData%M21)) call RegPack(Buf, InData%M21) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%K11)) if (allocated(InData%K11)) then call RegPackBounds(Buf, 2, lbound(InData%K11), ubound(InData%K11)) call RegPack(Buf, InData%K11) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%K22)) if (allocated(InData%K22)) then call RegPackBounds(Buf, 2, lbound(InData%K22), ubound(InData%K22)) call RegPack(Buf, InData%K22) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%C11)) if (allocated(InData%C11)) then call RegPackBounds(Buf, 2, lbound(InData%C11), ubound(InData%C11)) call RegPack(Buf, InData%C11) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%C12)) if (allocated(InData%C12)) then call RegPackBounds(Buf, 2, lbound(InData%C12), ubound(InData%C12)) call RegPack(Buf, InData%C12) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%C22)) if (allocated(InData%C22)) then call RegPackBounds(Buf, 2, lbound(InData%C22), ubound(InData%C22)) call RegPack(Buf, InData%C22) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%C21)) if (allocated(InData%C21)) then call RegPackBounds(Buf, 2, lbound(InData%C21), ubound(InData%C21)) call RegPack(Buf, InData%C21) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%EP_DeltaT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nTimeSteps) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nCB) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nCBFull) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nTot) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%IntMethod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ActiveCBDOF)) if (allocated(InData%ActiveCBDOF)) then call RegPackBounds(Buf, 1, lbound(InData%ActiveCBDOF), ubound(InData%ActiveCBDOF)) call RegPack(Buf, InData%ActiveCBDOF) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) @@ -1951,7 +1887,6 @@ subroutine ExtPtfm_PackParam(Buf, Indata) call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OutParamLinIndx)) if (allocated(InData%OutParamLinIndx)) then call RegPackBounds(Buf, 2, lbound(InData%OutParamLinIndx), ubound(InData%OutParamLinIndx)) @@ -2417,7 +2352,6 @@ subroutine ExtPtfm_PackOutput(Buf, Indata) character(*), parameter :: RoutineName = 'ExtPtfm_PackOutput' if (Buf%ErrStat >= AbortErrLev) return call MeshPack(Buf, InData%PtfmMesh) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) diff --git a/modules/feamooring/src/FEAMooring_Types.f90 b/modules/feamooring/src/FEAMooring_Types.f90 index e62c830e95..3b0a6d9f7d 100644 --- a/modules/feamooring/src/FEAMooring_Types.f90 +++ b/modules/feamooring/src/FEAMooring_Types.f90 @@ -572,133 +572,103 @@ subroutine FEAM_PackInputFile(Buf, Indata) character(*), parameter :: RoutineName = 'FEAM_PackInputFile' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%DT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LineCI)) if (allocated(InData%LineCI)) then call RegPackBounds(Buf, 1, lbound(InData%LineCI), ubound(InData%LineCI)) call RegPack(Buf, InData%LineCI) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LineCD)) if (allocated(InData%LineCD)) then call RegPackBounds(Buf, 1, lbound(InData%LineCD), ubound(InData%LineCD)) call RegPack(Buf, InData%LineCD) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LEAStiff)) if (allocated(InData%LEAStiff)) then call RegPackBounds(Buf, 1, lbound(InData%LEAStiff), ubound(InData%LEAStiff)) call RegPack(Buf, InData%LEAStiff) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LMassDen)) if (allocated(InData%LMassDen)) then call RegPackBounds(Buf, 1, lbound(InData%LMassDen), ubound(InData%LMassDen)) call RegPack(Buf, InData%LMassDen) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LDMassDen)) if (allocated(InData%LDMassDen)) then call RegPackBounds(Buf, 1, lbound(InData%LDMassDen), ubound(InData%LDMassDen)) call RegPack(Buf, InData%LDMassDen) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BottmStiff)) if (allocated(InData%BottmStiff)) then call RegPackBounds(Buf, 1, lbound(InData%BottmStiff), ubound(InData%BottmStiff)) call RegPack(Buf, InData%BottmStiff) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LRadAnch)) if (allocated(InData%LRadAnch)) then call RegPackBounds(Buf, 1, lbound(InData%LRadAnch), ubound(InData%LRadAnch)) call RegPack(Buf, InData%LRadAnch) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LAngAnch)) if (allocated(InData%LAngAnch)) then call RegPackBounds(Buf, 1, lbound(InData%LAngAnch), ubound(InData%LAngAnch)) call RegPack(Buf, InData%LAngAnch) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LDpthAnch)) if (allocated(InData%LDpthAnch)) then call RegPackBounds(Buf, 1, lbound(InData%LDpthAnch), ubound(InData%LDpthAnch)) call RegPack(Buf, InData%LDpthAnch) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LRadFair)) if (allocated(InData%LRadFair)) then call RegPackBounds(Buf, 1, lbound(InData%LRadFair), ubound(InData%LRadFair)) call RegPack(Buf, InData%LRadFair) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LAngFair)) if (allocated(InData%LAngFair)) then call RegPackBounds(Buf, 1, lbound(InData%LAngFair), ubound(InData%LAngFair)) call RegPack(Buf, InData%LAngFair) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LDrftFair)) if (allocated(InData%LDrftFair)) then call RegPackBounds(Buf, 1, lbound(InData%LDrftFair), ubound(InData%LDrftFair)) call RegPack(Buf, InData%LDrftFair) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LUnstrLen)) if (allocated(InData%LUnstrLen)) then call RegPackBounds(Buf, 1, lbound(InData%LUnstrLen), ubound(InData%LUnstrLen)) call RegPack(Buf, InData%LUnstrLen) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Tension)) if (allocated(InData%Tension)) then call RegPackBounds(Buf, 1, lbound(InData%Tension), ubound(InData%Tension)) call RegPack(Buf, InData%Tension) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%GSL)) if (allocated(InData%GSL)) then call RegPackBounds(Buf, 3, lbound(InData%GSL), ubound(InData%GSL)) call RegPack(Buf, InData%GSL) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%GSR)) if (allocated(InData%GSR)) then call RegPackBounds(Buf, 2, lbound(InData%GSR), ubound(InData%GSR)) call RegPack(Buf, InData%GSR) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%GE)) if (allocated(InData%GE)) then call RegPackBounds(Buf, 3, lbound(InData%GE), ubound(InData%GE)) call RegPack(Buf, InData%GE) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumLines) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumElems) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Eps) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Gravity) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WtrDens) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MaxIter) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SumPrint) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TabDelim) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutFmt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Tstart) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OutList)) if (allocated(InData%OutList)) then call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) @@ -1080,33 +1050,25 @@ subroutine FEAM_PackInitInput(Buf, Indata) character(*), parameter :: RoutineName = 'FEAM_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%InputFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RootName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PtfmInit) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NStepWave) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveAcc0)) if (allocated(InData%WaveAcc0)) then call RegPackBounds(Buf, 3, lbound(InData%WaveAcc0), ubound(InData%WaveAcc0)) call RegPack(Buf, InData%WaveAcc0) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveTime)) if (allocated(InData%WaveTime)) then call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) call RegPack(Buf, InData%WaveTime) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveVel0)) if (allocated(InData%WaveVel0)) then call RegPackBounds(Buf, 3, lbound(InData%WaveVel0), ubound(InData%WaveVel0)) call RegPack(Buf, InData%WaveVel0) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Gravity) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WtrDens) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1349,45 +1311,37 @@ subroutine FEAM_PackInitOutput(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) call RegPack(Buf, InData%WriteOutputHdr) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) call RegPack(Buf, InData%WriteOutputUnt) end if - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackProgDesc(Buf, InData%Ver) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LAnchxi)) if (allocated(InData%LAnchxi)) then call RegPackBounds(Buf, 1, lbound(InData%LAnchxi), ubound(InData%LAnchxi)) call RegPack(Buf, InData%LAnchxi) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LAnchyi)) if (allocated(InData%LAnchyi)) then call RegPackBounds(Buf, 1, lbound(InData%LAnchyi), ubound(InData%LAnchyi)) call RegPack(Buf, InData%LAnchyi) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LAnchzi)) if (allocated(InData%LAnchzi)) then call RegPackBounds(Buf, 1, lbound(InData%LAnchzi), ubound(InData%LAnchzi)) call RegPack(Buf, InData%LAnchzi) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LFairxt)) if (allocated(InData%LFairxt)) then call RegPackBounds(Buf, 1, lbound(InData%LFairxt), ubound(InData%LFairxt)) call RegPack(Buf, InData%LFairxt) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LFairyt)) if (allocated(InData%LFairyt)) then call RegPackBounds(Buf, 1, lbound(InData%LFairyt), ubound(InData%LFairyt)) call RegPack(Buf, InData%LFairyt) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LFairzt)) if (allocated(InData%LFairzt)) then call RegPackBounds(Buf, 1, lbound(InData%LFairzt), ubound(InData%LFairzt)) @@ -1585,7 +1539,6 @@ subroutine FEAM_PackContState(Buf, Indata) call RegPackBounds(Buf, 2, lbound(InData%GLU), ubound(InData%GLU)) call RegPack(Buf, InData%GLU) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%GLDU)) if (allocated(InData%GLDU)) then call RegPackBounds(Buf, 2, lbound(InData%GLDU), ubound(InData%GLDU)) @@ -1699,7 +1652,6 @@ subroutine FEAM_PackConstrState(Buf, Indata) character(*), parameter :: RoutineName = 'FEAM_PackConstrState' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%TSN) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TZER) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1854,45 +1806,35 @@ subroutine FEAM_PackOtherState(Buf, Indata) call RegPackBounds(Buf, 2, lbound(InData%GLU0), ubound(InData%GLU0)) call RegPack(Buf, InData%GLU0) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%GLDDU)) if (allocated(InData%GLDDU)) then call RegPackBounds(Buf, 2, lbound(InData%GLDDU), ubound(InData%GLDDU)) call RegPack(Buf, InData%GLDDU) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BottomTouch) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%GFORC0)) if (allocated(InData%GFORC0)) then call RegPackBounds(Buf, 3, lbound(InData%GFORC0), ubound(InData%GFORC0)) call RegPack(Buf, InData%GFORC0) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%GMASS0)) if (allocated(InData%GMASS0)) then call RegPackBounds(Buf, 4, lbound(InData%GMASS0), ubound(InData%GMASS0)) call RegPack(Buf, InData%GMASS0) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FAST_FPA)) if (allocated(InData%FAST_FPA)) then call RegPackBounds(Buf, 2, lbound(InData%FAST_FPA), ubound(InData%FAST_FPA)) call RegPack(Buf, InData%FAST_FPA) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FAST_RP)) if (allocated(InData%FAST_RP)) then call RegPackBounds(Buf, 2, lbound(InData%FAST_RP), ubound(InData%FAST_RP)) call RegPack(Buf, InData%FAST_RP) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%INCR) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RSDF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FORC0) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%EMAS0) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2217,87 +2159,64 @@ subroutine FEAM_PackMisc(Buf, Indata) call RegPackBounds(Buf, 2, lbound(InData%GLF), ubound(InData%GLF)) call RegPack(Buf, InData%GLF) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%GLK)) if (allocated(InData%GLK)) then call RegPackBounds(Buf, 3, lbound(InData%GLK), ubound(InData%GLK)) call RegPack(Buf, InData%GLK) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%EMASS) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ESTIF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FAST_FP)) if (allocated(InData%FAST_FP)) then call RegPackBounds(Buf, 2, lbound(InData%FAST_FP), ubound(InData%FAST_FP)) call RegPack(Buf, InData%FAST_FP) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FORCE) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%U) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%U0) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DU) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DDU) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%R) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RHSR) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SLIN) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%STIFR) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FAIR_ANG)) if (allocated(InData%FAIR_ANG)) then call RegPackBounds(Buf, 2, lbound(InData%FAIR_ANG), ubound(InData%FAIR_ANG)) call RegPack(Buf, InData%FAIR_ANG) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FAIR_T)) if (allocated(InData%FAIR_T)) then call RegPackBounds(Buf, 1, lbound(InData%FAIR_T), ubound(InData%FAIR_T)) call RegPack(Buf, InData%FAIR_T) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ANCH_ANG)) if (allocated(InData%ANCH_ANG)) then call RegPackBounds(Buf, 2, lbound(InData%ANCH_ANG), ubound(InData%ANCH_ANG)) call RegPack(Buf, InData%ANCH_ANG) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ANCH_T)) if (allocated(InData%ANCH_T)) then call RegPackBounds(Buf, 1, lbound(InData%ANCH_T), ubound(InData%ANCH_T)) call RegPack(Buf, InData%ANCH_T) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Line_Coordinate)) if (allocated(InData%Line_Coordinate)) then call RegPackBounds(Buf, 3, lbound(InData%Line_Coordinate), ubound(InData%Line_Coordinate)) call RegPack(Buf, InData%Line_Coordinate) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Line_Tangent)) if (allocated(InData%Line_Tangent)) then call RegPackBounds(Buf, 3, lbound(InData%Line_Tangent), ubound(InData%Line_Tangent)) call RegPack(Buf, InData%Line_Tangent) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%F_Lines)) if (allocated(InData%F_Lines)) then call RegPackBounds(Buf, 2, lbound(InData%F_Lines), ubound(InData%F_Lines)) call RegPack(Buf, InData%F_Lines) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LastIndWave) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2866,161 +2785,113 @@ subroutine FEAM_PackParam(Buf, Indata) integer(IntKi) :: LB(4), UB(4) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%DT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%GRAV) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Eps) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Gravity) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WtrDens) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MaxIter) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NHBD) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NDIM) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%NEQ)) if (allocated(InData%NEQ)) then call RegPackBounds(Buf, 1, lbound(InData%NEQ), ubound(InData%NEQ)) call RegPack(Buf, InData%NEQ) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NBAND) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumLines) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumElems) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumNodes) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%GSL)) if (allocated(InData%GSL)) then call RegPackBounds(Buf, 3, lbound(InData%GSL), ubound(InData%GSL)) call RegPack(Buf, InData%GSL) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%GP)) if (allocated(InData%GP)) then call RegPackBounds(Buf, 2, lbound(InData%GP), ubound(InData%GP)) call RegPack(Buf, InData%GP) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Elength)) if (allocated(InData%Elength)) then call RegPackBounds(Buf, 1, lbound(InData%Elength), ubound(InData%Elength)) call RegPack(Buf, InData%Elength) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BottmElev)) if (allocated(InData%BottmElev)) then call RegPackBounds(Buf, 1, lbound(InData%BottmElev), ubound(InData%BottmElev)) call RegPack(Buf, InData%BottmElev) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BottmStiff)) if (allocated(InData%BottmStiff)) then call RegPackBounds(Buf, 1, lbound(InData%BottmStiff), ubound(InData%BottmStiff)) call RegPack(Buf, InData%BottmStiff) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LMassDen)) if (allocated(InData%LMassDen)) then call RegPackBounds(Buf, 1, lbound(InData%LMassDen), ubound(InData%LMassDen)) call RegPack(Buf, InData%LMassDen) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LDMassDen)) if (allocated(InData%LDMassDen)) then call RegPackBounds(Buf, 1, lbound(InData%LDMassDen), ubound(InData%LDMassDen)) call RegPack(Buf, InData%LDMassDen) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LEAStiff)) if (allocated(InData%LEAStiff)) then call RegPackBounds(Buf, 1, lbound(InData%LEAStiff), ubound(InData%LEAStiff)) call RegPack(Buf, InData%LEAStiff) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LineCI)) if (allocated(InData%LineCI)) then call RegPackBounds(Buf, 1, lbound(InData%LineCI), ubound(InData%LineCI)) call RegPack(Buf, InData%LineCI) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LineCD)) if (allocated(InData%LineCD)) then call RegPackBounds(Buf, 1, lbound(InData%LineCD), ubound(InData%LineCD)) call RegPack(Buf, InData%LineCD) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Bvp)) if (allocated(InData%Bvp)) then call RegPackBounds(Buf, 2, lbound(InData%Bvp), ubound(InData%Bvp)) call RegPack(Buf, InData%Bvp) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveAcc0)) if (allocated(InData%WaveAcc0)) then call RegPackBounds(Buf, 3, lbound(InData%WaveAcc0), ubound(InData%WaveAcc0)) call RegPack(Buf, InData%WaveAcc0) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveTime)) if (allocated(InData%WaveTime)) then call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) call RegPack(Buf, InData%WaveTime) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveVel0)) if (allocated(InData%WaveVel0)) then call RegPackBounds(Buf, 3, lbound(InData%WaveVel0), ubound(InData%WaveVel0)) call RegPack(Buf, InData%WaveVel0) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NStepWave) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SHAP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SHAPS) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%GAUSSW) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NGAUSS) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SHAPT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SHAPTS) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NTRAP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SBEND) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%STEN) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RMASS) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RADDM) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PMPN) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AM) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PM) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%IDOF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%JDOF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PPA) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PtfmRefzt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RootName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) @@ -3030,15 +2901,12 @@ subroutine FEAM_PackParam(Buf, Indata) call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Delim) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%GLUZR)) if (allocated(InData%GLUZR)) then call RegPackBounds(Buf, 3, lbound(InData%GLUZR), ubound(InData%GLUZR)) call RegPack(Buf, InData%GLUZR) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%GTZER)) if (allocated(InData%GTZER)) then call RegPackBounds(Buf, 2, lbound(InData%GTZER), ubound(InData%GTZER)) @@ -3415,7 +3283,6 @@ subroutine FEAM_PackInput(Buf, Indata) character(*), parameter :: RoutineName = 'FEAM_PackInput' if (Buf%ErrStat >= AbortErrLev) return call MeshPack(Buf, InData%HydroForceLineMesh) - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%PtFairleadDisplacement) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3487,9 +3354,7 @@ subroutine FEAM_PackOutput(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) call RegPack(Buf, InData%WriteOutput) end if - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%PtFairleadLoad) - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%LineMeshPosition) if (RegCheckErr(Buf, RoutineName)) return end subroutine diff --git a/modules/hydrodyn/src/Conv_Radiation_Types.f90 b/modules/hydrodyn/src/Conv_Radiation_Types.f90 index 606d49f341..00f7a5bf3f 100644 --- a/modules/hydrodyn/src/Conv_Radiation_Types.f90 +++ b/modules/hydrodyn/src/Conv_Radiation_Types.f90 @@ -186,35 +186,26 @@ subroutine Conv_Rdtn_PackInitInput(Buf, Indata) character(*), parameter :: RoutineName = 'Conv_Rdtn_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%RdtnDT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RdtnDTChr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NBody) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HighFreq) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WAMITFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%HdroAddMs)) if (allocated(InData%HdroAddMs)) then call RegPackBounds(Buf, 3, lbound(InData%HdroAddMs), ubound(InData%HdroAddMs)) call RegPack(Buf, InData%HdroAddMs) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%HdroFreq)) if (allocated(InData%HdroFreq)) then call RegPackBounds(Buf, 1, lbound(InData%HdroFreq), ubound(InData%HdroFreq)) call RegPack(Buf, InData%HdroFreq) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%HdroDmpng)) if (allocated(InData%HdroDmpng)) then call RegPackBounds(Buf, 3, lbound(InData%HdroDmpng), ubound(InData%HdroDmpng)) call RegPack(Buf, InData%HdroDmpng) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NInpFreq) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RdtnTMax) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -413,7 +404,6 @@ subroutine Conv_Rdtn_PackDiscState(Buf, Indata) call RegPackBounds(Buf, 2, lbound(InData%XDHistory), ubound(InData%XDHistory)) call RegPack(Buf, InData%XDHistory) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LastTime) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -611,19 +601,14 @@ subroutine Conv_Rdtn_PackParam(Buf, Indata) character(*), parameter :: RoutineName = 'Conv_Rdtn_PackParam' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%DT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RdtnDT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NBody) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RdtnKrnl)) if (allocated(InData%RdtnKrnl)) then call RegPackBounds(Buf, 3, lbound(InData%RdtnKrnl), ubound(InData%RdtnKrnl)) call RegPack(Buf, InData%RdtnKrnl) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NStepRdtn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NStepRdtn1) if (RegCheckErr(Buf, RoutineName)) return end subroutine diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index 253e475695..5bf4913ee4 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -549,133 +549,99 @@ subroutine HydroDyn_PackInputFile(Buf, Indata) character(*), parameter :: RoutineName = 'HydroDyn_PackInputFile' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%EchoFlag) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AddF0)) if (allocated(InData%AddF0)) then call RegPackBounds(Buf, 2, lbound(InData%AddF0), ubound(InData%AddF0)) call RegPack(Buf, InData%AddF0) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AddCLin)) if (allocated(InData%AddCLin)) then call RegPackBounds(Buf, 3, lbound(InData%AddCLin), ubound(InData%AddCLin)) call RegPack(Buf, InData%AddCLin) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AddBLin)) if (allocated(InData%AddBLin)) then call RegPackBounds(Buf, 3, lbound(InData%AddBLin), ubound(InData%AddBLin)) call RegPack(Buf, InData%AddBLin) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AddBQuad)) if (allocated(InData%AddBQuad)) then call RegPackBounds(Buf, 3, lbound(InData%AddBQuad), ubound(InData%AddBQuad)) call RegPack(Buf, InData%AddBQuad) end if - if (RegCheckErr(Buf, RoutineName)) return call SeaSt_PackInitInput(Buf, InData%SeaState) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PotFile)) if (allocated(InData%PotFile)) then call RegPackBounds(Buf, 1, lbound(InData%PotFile), ubound(InData%PotFile)) call RegPack(Buf, InData%PotFile) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nWAMITObj) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%vecMultiplier) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NBody) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NBodyMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PtfmVol0)) if (allocated(InData%PtfmVol0)) then call RegPackBounds(Buf, 1, lbound(InData%PtfmVol0), ubound(InData%PtfmVol0)) call RegPack(Buf, InData%PtfmVol0) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HasWAMIT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WAMITULEN)) if (allocated(InData%WAMITULEN)) then call RegPackBounds(Buf, 1, lbound(InData%WAMITULEN), ubound(InData%WAMITULEN)) call RegPack(Buf, InData%WAMITULEN) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PtfmRefxt)) if (allocated(InData%PtfmRefxt)) then call RegPackBounds(Buf, 1, lbound(InData%PtfmRefxt), ubound(InData%PtfmRefxt)) call RegPack(Buf, InData%PtfmRefxt) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PtfmRefyt)) if (allocated(InData%PtfmRefyt)) then call RegPackBounds(Buf, 1, lbound(InData%PtfmRefyt), ubound(InData%PtfmRefyt)) call RegPack(Buf, InData%PtfmRefyt) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PtfmRefzt)) if (allocated(InData%PtfmRefzt)) then call RegPackBounds(Buf, 1, lbound(InData%PtfmRefzt), ubound(InData%PtfmRefzt)) call RegPack(Buf, InData%PtfmRefzt) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PtfmRefztRot)) if (allocated(InData%PtfmRefztRot)) then call RegPackBounds(Buf, 1, lbound(InData%PtfmRefztRot), ubound(InData%PtfmRefztRot)) call RegPack(Buf, InData%PtfmRefztRot) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PtfmCOBxt)) if (allocated(InData%PtfmCOBxt)) then call RegPackBounds(Buf, 1, lbound(InData%PtfmCOBxt), ubound(InData%PtfmCOBxt)) call RegPack(Buf, InData%PtfmCOBxt) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PtfmCOByt)) if (allocated(InData%PtfmCOByt)) then call RegPackBounds(Buf, 1, lbound(InData%PtfmCOByt), ubound(InData%PtfmCOByt)) call RegPack(Buf, InData%PtfmCOByt) end if - if (RegCheckErr(Buf, RoutineName)) return call WAMIT_PackInitInput(Buf, InData%WAMIT) - if (RegCheckErr(Buf, RoutineName)) return call WAMIT2_PackInitInput(Buf, InData%WAMIT2) - if (RegCheckErr(Buf, RoutineName)) return call Morison_PackInitInput(Buf, InData%Morison) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Echo) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PotMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NUserOutputs) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%UserOutputs)) if (allocated(InData%UserOutputs)) then call RegPackBounds(Buf, 1, lbound(InData%UserOutputs), ubound(InData%UserOutputs)) call RegPack(Buf, InData%UserOutputs) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutSwtch) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutAll) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OutList)) if (allocated(InData%OutList)) then call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) call RegPack(Buf, InData%OutList) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HDSum) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UnSum) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutFmt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutSFmt) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1037,79 +1003,46 @@ subroutine HydroDyn_PackInitInput(Buf, Indata) logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%InputFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UseInputFile) - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackFileInfoType(Buf, InData%PassedFileData) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutRootName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Linearize) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Gravity) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WtrDens) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WtrDpth) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MSL2SWL) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TMax) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PtfmLocationX) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PtfmLocationY) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NStepWave) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NStepWave2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RhoXg) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveStMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveDirMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WvLowCOff) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WvHiCOff) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WvLowCOffD) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WvHiCOffD) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WvLowCOffS) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WvHiCOffS) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%InvalidWithSSExctn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveElev0)) if (allocated(InData%WaveElev0)) then call RegPackBounds(Buf, 1, lbound(InData%WaveElev0), ubound(InData%WaveElev0)) call RegPack(Buf, InData%WaveElev0) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveElevC)) if (allocated(InData%WaveElevC)) then call RegPackBounds(Buf, 3, lbound(InData%WaveElevC), ubound(InData%WaveElevC)) call RegPack(Buf, InData%WaveElevC) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveDirMin) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveDirMax) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveDir) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveMultiDir) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveDOmega) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MCFD) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveField)) if (associated(InData%WaveField)) then call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) @@ -1397,45 +1330,37 @@ subroutine HydroDyn_PackInitOutput(Buf, Indata) character(*), parameter :: RoutineName = 'HydroDyn_PackInitOutput' if (Buf%ErrStat >= AbortErrLev) return call Morison_PackInitOutput(Buf, InData%Morison) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) call RegPack(Buf, InData%WriteOutputHdr) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) call RegPack(Buf, InData%WriteOutputUnt) end if - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackProgDesc(Buf, InData%Ver) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LinNames_y)) if (allocated(InData%LinNames_y)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) call RegPack(Buf, InData%LinNames_y) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LinNames_x)) if (allocated(InData%LinNames_x)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_x), ubound(InData%LinNames_x)) call RegPack(Buf, InData%LinNames_x) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LinNames_u)) if (allocated(InData%LinNames_u)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) call RegPack(Buf, InData%LinNames_u) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%DerivOrder_x)) if (allocated(InData%DerivOrder_x)) then call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x), ubound(InData%DerivOrder_x)) call RegPack(Buf, InData%DerivOrder_x) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%IsLoad_u)) if (allocated(InData%IsLoad_u)) then call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) @@ -1593,9 +1518,7 @@ subroutine HydroDyn_PackHD_ModuleMapType(Buf, Indata) character(*), parameter :: RoutineName = 'HydroDyn_PackHD_ModuleMapType' if (Buf%ErrStat >= AbortErrLev) return call NWTC_Library_PackMeshMapType(Buf, InData%uW_P_2_PRP_P) - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackMeshMapType(Buf, InData%W_P_2_PRP_P) - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackMeshMapType(Buf, InData%M_P_2_PRP_P) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1684,7 +1607,6 @@ subroutine HydroDyn_PackContState(Buf, Indata) call WAMIT_PackContState(Buf, InData%WAMIT(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call Morison_PackContState(Buf, InData%Morison) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1790,7 +1712,6 @@ subroutine HydroDyn_PackDiscState(Buf, Indata) call WAMIT_PackDiscState(Buf, InData%WAMIT(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call Morison_PackDiscState(Buf, InData%Morison) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1858,7 +1779,6 @@ subroutine HydroDyn_PackConstrState(Buf, Indata) character(*), parameter :: RoutineName = 'HydroDyn_PackConstrState' if (Buf%ErrStat >= AbortErrLev) return call WAMIT_PackConstrState(Buf, InData%WAMIT) - if (RegCheckErr(Buf, RoutineName)) return call Morison_PackConstrState(Buf, InData%Morison) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1946,7 +1866,6 @@ subroutine HydroDyn_PackOtherState(Buf, Indata) call WAMIT_PackOtherState(Buf, InData%WAMIT(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call Morison_PackOtherState(Buf, InData%Morison) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2142,29 +2061,21 @@ subroutine HydroDyn_PackMisc(Buf, Indata) integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call MeshPack(Buf, InData%AllHdroOrigin) - if (RegCheckErr(Buf, RoutineName)) return call HydroDyn_PackHD_ModuleMapType(Buf, InData%HD_MeshMap) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Decimate) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LastOutTime) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LastIndWave) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%F_PtfmAdd)) if (allocated(InData%F_PtfmAdd)) then call RegPackBounds(Buf, 1, lbound(InData%F_PtfmAdd), ubound(InData%F_PtfmAdd)) call RegPack(Buf, InData%F_PtfmAdd) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%F_Hydro) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%F_Waves)) if (allocated(InData%F_Waves)) then call RegPackBounds(Buf, 1, lbound(InData%F_Waves), ubound(InData%F_Waves)) call RegPack(Buf, InData%F_Waves) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WAMIT)) if (allocated(InData%WAMIT)) then call RegPackBounds(Buf, 1, lbound(InData%WAMIT), ubound(InData%WAMIT)) @@ -2174,7 +2085,6 @@ subroutine HydroDyn_PackMisc(Buf, Indata) call WAMIT_PackMisc(Buf, InData%WAMIT(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WAMIT2)) if (allocated(InData%WAMIT2)) then call RegPackBounds(Buf, 1, lbound(InData%WAMIT2), ubound(InData%WAMIT2)) @@ -2184,9 +2094,7 @@ subroutine HydroDyn_PackMisc(Buf, Indata) call WAMIT2_PackMisc(Buf, InData%WAMIT2(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call Morison_PackMisc(Buf, InData%Morison) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%u_WAMIT)) if (allocated(InData%u_WAMIT)) then call RegPackBounds(Buf, 1, lbound(InData%u_WAMIT), ubound(InData%u_WAMIT)) @@ -2558,9 +2466,7 @@ subroutine HydroDyn_PackParam(Buf, Indata) logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%nWAMITObj) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%vecMultiplier) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WAMIT)) if (allocated(InData%WAMIT)) then call RegPackBounds(Buf, 1, lbound(InData%WAMIT), ubound(InData%WAMIT)) @@ -2570,7 +2476,6 @@ subroutine HydroDyn_PackParam(Buf, Indata) call WAMIT_PackParam(Buf, InData%WAMIT(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WAMIT2)) if (allocated(InData%WAMIT2)) then call RegPackBounds(Buf, 1, lbound(InData%WAMIT2), ubound(InData%WAMIT2)) @@ -2580,23 +2485,14 @@ subroutine HydroDyn_PackParam(Buf, Indata) call WAMIT2_PackParam(Buf, InData%WAMIT2(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WAMIT2used) - if (RegCheckErr(Buf, RoutineName)) return call Morison_PackParam(Buf, InData%Morison) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PotMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NBody) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NBodyMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%totalStates) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%totalExctnStates) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%totalRdtnStates) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveTime)) if (associated(InData%WaveTime)) then call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) @@ -2605,37 +2501,29 @@ subroutine HydroDyn_PackParam(Buf, Indata) call RegPack(Buf, InData%WaveTime) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NStepWave) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WtrDpth) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AddF0)) if (allocated(InData%AddF0)) then call RegPackBounds(Buf, 2, lbound(InData%AddF0), ubound(InData%AddF0)) call RegPack(Buf, InData%AddF0) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AddCLin)) if (allocated(InData%AddCLin)) then call RegPackBounds(Buf, 3, lbound(InData%AddCLin), ubound(InData%AddCLin)) call RegPack(Buf, InData%AddCLin) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AddBLin)) if (allocated(InData%AddBLin)) then call RegPackBounds(Buf, 3, lbound(InData%AddBLin), ubound(InData%AddBLin)) call RegPack(Buf, InData%AddBLin) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AddBQuad)) if (allocated(InData%AddBQuad)) then call RegPackBounds(Buf, 3, lbound(InData%AddBQuad), ubound(InData%AddBQuad)) call RegPack(Buf, InData%AddBQuad) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) @@ -2645,43 +2533,30 @@ subroutine HydroDyn_PackParam(Buf, Indata) call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumTotalOuts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutSwtch) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutFmt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutSFmt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Delim) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UnOutFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutDec) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Jac_u_indx)) if (allocated(InData%Jac_u_indx)) then call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx), ubound(InData%Jac_u_indx)) call RegPack(Buf, InData%Jac_u_indx) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%du)) if (allocated(InData%du)) then call RegPackBounds(Buf, 1, lbound(InData%du), ubound(InData%du)) call RegPack(Buf, InData%du) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%dx)) if (allocated(InData%dx)) then call RegPackBounds(Buf, 1, lbound(InData%dx), ubound(InData%dx)) call RegPack(Buf, InData%dx) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Jac_ny) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PointsToSeaState) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2950,9 +2825,7 @@ subroutine HydroDyn_PackInput(Buf, Indata) character(*), parameter :: RoutineName = 'HydroDyn_PackInput' if (Buf%ErrStat >= AbortErrLev) return call Morison_PackInput(Buf, InData%Morison) - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%WAMITMesh) - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%PRPMesh) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3088,7 +2961,6 @@ subroutine HydroDyn_PackOutput(Buf, Indata) call WAMIT_PackOutput(Buf, InData%WAMIT(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WAMIT2)) if (allocated(InData%WAMIT2)) then call RegPackBounds(Buf, 1, lbound(InData%WAMIT2), ubound(InData%WAMIT2)) @@ -3098,11 +2970,8 @@ subroutine HydroDyn_PackOutput(Buf, Indata) call WAMIT2_PackOutput(Buf, InData%WAMIT2(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call Morison_PackOutput(Buf, InData%Morison) - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%WAMITMesh) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) diff --git a/modules/hydrodyn/src/Morison_Types.f90 b/modules/hydrodyn/src/Morison_Types.f90 index d574ba006c..b8788a9ac3 100644 --- a/modules/hydrodyn/src/Morison_Types.f90 +++ b/modules/hydrodyn/src/Morison_Types.f90 @@ -470,17 +470,11 @@ subroutine Morison_PackJointType(Buf, Indata) character(*), parameter :: RoutineName = 'Morison_PackJointType' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%JointID) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Position) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%JointAxID) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%JointAxIDIndx) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%JointOvrlp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NConnections) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ConnectionList) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -535,9 +529,7 @@ subroutine Morison_PackMemberPropType(Buf, Indata) character(*), parameter :: RoutineName = 'Morison_PackMemberPropType' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%PropSetID) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PropD) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PropThck) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -604,17 +596,13 @@ subroutine Morison_PackFilledGroupType(Buf, Indata) character(*), parameter :: RoutineName = 'Morison_PackFilledGroupType' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%FillNumM) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FillMList)) if (allocated(InData%FillMList)) then call RegPackBounds(Buf, 1, lbound(InData%FillMList), ubound(InData%FillMList)) call RegPack(Buf, InData%FillMList) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FillFSLoc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FillDensChr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FillDens) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -693,35 +681,20 @@ subroutine Morison_PackCoefDpths(Buf, Indata) character(*), parameter :: RoutineName = 'Morison_PackCoefDpths' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%Dpth) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DpthCd) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DpthCdMG) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DpthCa) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DpthCaMG) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DpthCp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DpthCpMG) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DpthAxCd) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DpthAxCdMG) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DpthAxCa) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DpthAxCaMG) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DpthAxCp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DpthAxCpMG) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DpthCb) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DpthCbMg) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DpthMCF) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -798,17 +771,11 @@ subroutine Morison_PackAxialCoefType(Buf, Indata) character(*), parameter :: RoutineName = 'Morison_PackAxialCoefType' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%AxCoefID) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AxCd) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AxCa) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AxCp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AxVnCOff) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AxFDLoFSc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AxFDMod) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -898,47 +865,28 @@ subroutine Morison_PackMemberInputType(Buf, Indata) character(*), parameter :: RoutineName = 'Morison_PackMemberInputType' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%MemberID) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%NodeIndx)) if (allocated(InData%NodeIndx)) then call RegPackBounds(Buf, 1, lbound(InData%NodeIndx), ubound(InData%NodeIndx)) call RegPack(Buf, InData%NodeIndx) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MJointID1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MJointID2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MJointID1Indx) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MJointID2Indx) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MPropSetID1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MPropSetID2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MPropSetID1Indx) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MPropSetID2Indx) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MDivSize) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MCoefMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MHstLMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MmbrCoefIDIndx) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MmbrFilledIDIndx) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PropPot) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PropMCF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NElements) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RefLength) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dl) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1046,33 +994,19 @@ subroutine Morison_PackNodeType(Buf, Indata) character(*), parameter :: RoutineName = 'Morison_PackNodeType' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%JointIndx) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Position) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%JointOvrlp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%JointAxIDIndx) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NConnections) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ConnectionList) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%JAxCd) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%JAxCa) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%JAxCp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%JAxVnCOff) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%JAxFDLoFSc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%JAxFDMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FillDensity) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%tMG) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MGdensity) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1856,299 +1790,230 @@ subroutine Morison_PackMemberType(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%NodeIndx), ubound(InData%NodeIndx)) call RegPack(Buf, InData%NodeIndx) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MemberID) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NElements) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RefLength) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%cosPhi_ref) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dl) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%k) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%kkt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Ak) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%R)) if (allocated(InData%R)) then call RegPackBounds(Buf, 1, lbound(InData%R), ubound(InData%R)) call RegPack(Buf, InData%R) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RMG)) if (allocated(InData%RMG)) then call RegPackBounds(Buf, 1, lbound(InData%RMG), ubound(InData%RMG)) call RegPack(Buf, InData%RMG) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RMGB)) if (allocated(InData%RMGB)) then call RegPackBounds(Buf, 1, lbound(InData%RMGB), ubound(InData%RMGB)) call RegPack(Buf, InData%RMGB) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Rin)) if (allocated(InData%Rin)) then call RegPackBounds(Buf, 1, lbound(InData%Rin), ubound(InData%Rin)) call RegPack(Buf, InData%Rin) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%tMG)) if (allocated(InData%tMG)) then call RegPackBounds(Buf, 1, lbound(InData%tMG), ubound(InData%tMG)) call RegPack(Buf, InData%tMG) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%MGdensity)) if (allocated(InData%MGdensity)) then call RegPackBounds(Buf, 1, lbound(InData%MGdensity), ubound(InData%MGdensity)) call RegPack(Buf, InData%MGdensity) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%dRdl_mg)) if (allocated(InData%dRdl_mg)) then call RegPackBounds(Buf, 1, lbound(InData%dRdl_mg), ubound(InData%dRdl_mg)) call RegPack(Buf, InData%dRdl_mg) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%dRdl_mg_b)) if (allocated(InData%dRdl_mg_b)) then call RegPackBounds(Buf, 1, lbound(InData%dRdl_mg_b), ubound(InData%dRdl_mg_b)) call RegPack(Buf, InData%dRdl_mg_b) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%dRdl_in)) if (allocated(InData%dRdl_in)) then call RegPackBounds(Buf, 1, lbound(InData%dRdl_in), ubound(InData%dRdl_in)) call RegPack(Buf, InData%dRdl_in) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Vinner) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Vouter) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Vballast) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Vsubmerged) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%l_fill) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%h_fill) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%z_overfill) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%h_floor) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%i_floor) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%doEndBuoyancy) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%memfloodstatus) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%floodstatus)) if (allocated(InData%floodstatus)) then call RegPackBounds(Buf, 1, lbound(InData%floodstatus), ubound(InData%floodstatus)) call RegPack(Buf, InData%floodstatus) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%alpha)) if (allocated(InData%alpha)) then call RegPackBounds(Buf, 1, lbound(InData%alpha), ubound(InData%alpha)) call RegPack(Buf, InData%alpha) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%alpha_fb)) if (allocated(InData%alpha_fb)) then call RegPackBounds(Buf, 1, lbound(InData%alpha_fb), ubound(InData%alpha_fb)) call RegPack(Buf, InData%alpha_fb) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%alpha_fb_star)) if (allocated(InData%alpha_fb_star)) then call RegPackBounds(Buf, 1, lbound(InData%alpha_fb_star), ubound(InData%alpha_fb_star)) call RegPack(Buf, InData%alpha_fb_star) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Cd)) if (allocated(InData%Cd)) then call RegPackBounds(Buf, 1, lbound(InData%Cd), ubound(InData%Cd)) call RegPack(Buf, InData%Cd) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Ca)) if (allocated(InData%Ca)) then call RegPackBounds(Buf, 1, lbound(InData%Ca), ubound(InData%Ca)) call RegPack(Buf, InData%Ca) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Cp)) if (allocated(InData%Cp)) then call RegPackBounds(Buf, 1, lbound(InData%Cp), ubound(InData%Cp)) call RegPack(Buf, InData%Cp) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AxCd)) if (allocated(InData%AxCd)) then call RegPackBounds(Buf, 1, lbound(InData%AxCd), ubound(InData%AxCd)) call RegPack(Buf, InData%AxCd) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AxCa)) if (allocated(InData%AxCa)) then call RegPackBounds(Buf, 1, lbound(InData%AxCa), ubound(InData%AxCa)) call RegPack(Buf, InData%AxCa) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AxCp)) if (allocated(InData%AxCp)) then call RegPackBounds(Buf, 1, lbound(InData%AxCp), ubound(InData%AxCp)) call RegPack(Buf, InData%AxCp) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Cb)) if (allocated(InData%Cb)) then call RegPackBounds(Buf, 1, lbound(InData%Cb), ubound(InData%Cb)) call RegPack(Buf, InData%Cb) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%m_fb_l)) if (allocated(InData%m_fb_l)) then call RegPackBounds(Buf, 1, lbound(InData%m_fb_l), ubound(InData%m_fb_l)) call RegPack(Buf, InData%m_fb_l) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%m_fb_u)) if (allocated(InData%m_fb_u)) then call RegPackBounds(Buf, 1, lbound(InData%m_fb_u), ubound(InData%m_fb_u)) call RegPack(Buf, InData%m_fb_u) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%h_cfb_l)) if (allocated(InData%h_cfb_l)) then call RegPackBounds(Buf, 1, lbound(InData%h_cfb_l), ubound(InData%h_cfb_l)) call RegPack(Buf, InData%h_cfb_l) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%h_cfb_u)) if (allocated(InData%h_cfb_u)) then call RegPackBounds(Buf, 1, lbound(InData%h_cfb_u), ubound(InData%h_cfb_u)) call RegPack(Buf, InData%h_cfb_u) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%I_lfb_l)) if (allocated(InData%I_lfb_l)) then call RegPackBounds(Buf, 1, lbound(InData%I_lfb_l), ubound(InData%I_lfb_l)) call RegPack(Buf, InData%I_lfb_l) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%I_lfb_u)) if (allocated(InData%I_lfb_u)) then call RegPackBounds(Buf, 1, lbound(InData%I_lfb_u), ubound(InData%I_lfb_u)) call RegPack(Buf, InData%I_lfb_u) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%I_rfb_l)) if (allocated(InData%I_rfb_l)) then call RegPackBounds(Buf, 1, lbound(InData%I_rfb_l), ubound(InData%I_rfb_l)) call RegPack(Buf, InData%I_rfb_l) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%I_rfb_u)) if (allocated(InData%I_rfb_u)) then call RegPackBounds(Buf, 1, lbound(InData%I_rfb_u), ubound(InData%I_rfb_u)) call RegPack(Buf, InData%I_rfb_u) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%m_mg_l)) if (allocated(InData%m_mg_l)) then call RegPackBounds(Buf, 1, lbound(InData%m_mg_l), ubound(InData%m_mg_l)) call RegPack(Buf, InData%m_mg_l) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%m_mg_u)) if (allocated(InData%m_mg_u)) then call RegPackBounds(Buf, 1, lbound(InData%m_mg_u), ubound(InData%m_mg_u)) call RegPack(Buf, InData%m_mg_u) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%h_cmg_l)) if (allocated(InData%h_cmg_l)) then call RegPackBounds(Buf, 1, lbound(InData%h_cmg_l), ubound(InData%h_cmg_l)) call RegPack(Buf, InData%h_cmg_l) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%h_cmg_u)) if (allocated(InData%h_cmg_u)) then call RegPackBounds(Buf, 1, lbound(InData%h_cmg_u), ubound(InData%h_cmg_u)) call RegPack(Buf, InData%h_cmg_u) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%I_lmg_l)) if (allocated(InData%I_lmg_l)) then call RegPackBounds(Buf, 1, lbound(InData%I_lmg_l), ubound(InData%I_lmg_l)) call RegPack(Buf, InData%I_lmg_l) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%I_lmg_u)) if (allocated(InData%I_lmg_u)) then call RegPackBounds(Buf, 1, lbound(InData%I_lmg_u), ubound(InData%I_lmg_u)) call RegPack(Buf, InData%I_lmg_u) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%I_rmg_l)) if (allocated(InData%I_rmg_l)) then call RegPackBounds(Buf, 1, lbound(InData%I_rmg_l), ubound(InData%I_rmg_l)) call RegPack(Buf, InData%I_rmg_l) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%I_rmg_u)) if (allocated(InData%I_rmg_u)) then call RegPackBounds(Buf, 1, lbound(InData%I_rmg_u), ubound(InData%I_rmg_u)) call RegPack(Buf, InData%I_rmg_u) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Cfl_fb)) if (allocated(InData%Cfl_fb)) then call RegPackBounds(Buf, 1, lbound(InData%Cfl_fb), ubound(InData%Cfl_fb)) call RegPack(Buf, InData%Cfl_fb) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Cfr_fb)) if (allocated(InData%Cfr_fb)) then call RegPackBounds(Buf, 1, lbound(InData%Cfr_fb), ubound(InData%Cfr_fb)) call RegPack(Buf, InData%Cfr_fb) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CM0_fb)) if (allocated(InData%CM0_fb)) then call RegPackBounds(Buf, 1, lbound(InData%CM0_fb), ubound(InData%CM0_fb)) call RegPack(Buf, InData%CM0_fb) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MGvolume) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MDivSize) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MCoefMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MmbrCoefIDIndx) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MmbrFilledIDIndx) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MHstLMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FillFSLoc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FillDens) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PropPot) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PropMCF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Flipped) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3002,61 +2867,51 @@ subroutine Morison_PackMemberLoads(Buf, Indata) call RegPackBounds(Buf, 2, lbound(InData%F_D), ubound(InData%F_D)) call RegPack(Buf, InData%F_D) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%F_I)) if (allocated(InData%F_I)) then call RegPackBounds(Buf, 2, lbound(InData%F_I), ubound(InData%F_I)) call RegPack(Buf, InData%F_I) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%F_A)) if (allocated(InData%F_A)) then call RegPackBounds(Buf, 2, lbound(InData%F_A), ubound(InData%F_A)) call RegPack(Buf, InData%F_A) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%F_B)) if (allocated(InData%F_B)) then call RegPackBounds(Buf, 2, lbound(InData%F_B), ubound(InData%F_B)) call RegPack(Buf, InData%F_B) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%F_BF)) if (allocated(InData%F_BF)) then call RegPackBounds(Buf, 2, lbound(InData%F_BF), ubound(InData%F_BF)) call RegPack(Buf, InData%F_BF) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%F_If)) if (allocated(InData%F_If)) then call RegPackBounds(Buf, 2, lbound(InData%F_If), ubound(InData%F_If)) call RegPack(Buf, InData%F_If) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%F_WMG)) if (allocated(InData%F_WMG)) then call RegPackBounds(Buf, 2, lbound(InData%F_WMG), ubound(InData%F_WMG)) call RegPack(Buf, InData%F_WMG) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%F_IMG)) if (allocated(InData%F_IMG)) then call RegPackBounds(Buf, 2, lbound(InData%F_IMG), ubound(InData%F_IMG)) call RegPack(Buf, InData%F_IMG) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FV)) if (allocated(InData%FV)) then call RegPackBounds(Buf, 2, lbound(InData%FV), ubound(InData%FV)) call RegPack(Buf, InData%FV) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FA)) if (allocated(InData%FA)) then call RegPackBounds(Buf, 2, lbound(InData%FA), ubound(InData%FA)) call RegPack(Buf, InData%FA) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%F_DP)) if (allocated(InData%F_DP)) then call RegPackBounds(Buf, 2, lbound(InData%F_DP), ubound(InData%F_DP)) @@ -3285,63 +3140,34 @@ subroutine Morison_PackCoefMembers(Buf, Indata) character(*), parameter :: RoutineName = 'Morison_PackCoefMembers' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%MemberID) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MemberCd1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MemberCd2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MemberCdMG1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MemberCdMG2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MemberCa1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MemberCa2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MemberCaMG1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MemberCaMG2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MemberCp1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MemberCp2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MemberCpMG1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MemberCpMG2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MemberAxCd1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MemberAxCd2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MemberAxCdMG1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MemberAxCdMG2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MemberAxCa1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MemberAxCa2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MemberAxCaMG1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MemberAxCaMG2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MemberAxCp1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MemberAxCp2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MemberAxCpMG1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MemberAxCpMG2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MemberCb1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MemberCb2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MemberCbMG1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MemberCbMG2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MemberMCF) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3442,9 +3268,7 @@ subroutine Morison_PackMGDepthsType(Buf, Indata) character(*), parameter :: RoutineName = 'Morison_PackMGDepthsType' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%MGDpth) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MGThck) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MGDens) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3595,41 +3419,33 @@ subroutine Morison_PackMOutput(Buf, Indata) character(*), parameter :: RoutineName = 'Morison_PackMOutput' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%MemberID) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NOutLoc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%NodeLocs)) if (allocated(InData%NodeLocs)) then call RegPackBounds(Buf, 1, lbound(InData%NodeLocs), ubound(InData%NodeLocs)) call RegPack(Buf, InData%NodeLocs) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MemberIDIndx) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%MeshIndx1)) if (allocated(InData%MeshIndx1)) then call RegPackBounds(Buf, 1, lbound(InData%MeshIndx1), ubound(InData%MeshIndx1)) call RegPack(Buf, InData%MeshIndx1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%MeshIndx2)) if (allocated(InData%MeshIndx2)) then call RegPackBounds(Buf, 1, lbound(InData%MeshIndx2), ubound(InData%MeshIndx2)) call RegPack(Buf, InData%MeshIndx2) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%MemberIndx1)) if (allocated(InData%MemberIndx1)) then call RegPackBounds(Buf, 1, lbound(InData%MemberIndx1), ubound(InData%MemberIndx1)) call RegPack(Buf, InData%MemberIndx1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%MemberIndx2)) if (allocated(InData%MemberIndx2)) then call RegPackBounds(Buf, 1, lbound(InData%MemberIndx2), ubound(InData%MemberIndx2)) call RegPack(Buf, InData%MemberIndx2) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%s)) if (allocated(InData%s)) then call RegPackBounds(Buf, 1, lbound(InData%s), ubound(InData%s)) @@ -3766,7 +3582,6 @@ subroutine Morison_PackJOutput(Buf, Indata) character(*), parameter :: RoutineName = 'Morison_PackJOutput' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%JointID) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%JointIDIndx) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -4174,21 +3989,13 @@ subroutine Morison_PackInitInput(Buf, Indata) logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%Gravity) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WtrDens) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WtrDpth) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MSL2SWL) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveDisp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AMMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NJoints) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NNodes) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%InpJoints)) if (allocated(InData%InpJoints)) then call RegPackBounds(Buf, 1, lbound(InData%InpJoints), ubound(InData%InpJoints)) @@ -4198,7 +4005,6 @@ subroutine Morison_PackInitInput(Buf, Indata) call Morison_PackJointType(Buf, InData%InpJoints(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Nodes)) if (allocated(InData%Nodes)) then call RegPackBounds(Buf, 1, lbound(InData%Nodes), ubound(InData%Nodes)) @@ -4208,9 +4014,7 @@ subroutine Morison_PackInitInput(Buf, Indata) call Morison_PackNodeType(Buf, InData%Nodes(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NAxCoefs) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AxialCoefs)) if (allocated(InData%AxialCoefs)) then call RegPackBounds(Buf, 1, lbound(InData%AxialCoefs), ubound(InData%AxialCoefs)) @@ -4220,9 +4024,7 @@ subroutine Morison_PackInitInput(Buf, Indata) call Morison_PackAxialCoefType(Buf, InData%AxialCoefs(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NPropSets) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%MPropSets)) if (allocated(InData%MPropSets)) then call RegPackBounds(Buf, 1, lbound(InData%MPropSets), ubound(InData%MPropSets)) @@ -4232,39 +4034,22 @@ subroutine Morison_PackInitInput(Buf, Indata) call Morison_PackMemberPropType(Buf, InData%MPropSets(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SimplCd) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SimplCdMG) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SimplCa) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SimplCaMG) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SimplCp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SimplCpMG) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SimplAxCd) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SimplAxCdMG) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SimplAxCa) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SimplAxCaMG) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SimplAxCp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SimplAxCpMG) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SimplCb) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SimplCbMg) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SimplMCF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NCoefDpth) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CoefDpths)) if (allocated(InData%CoefDpths)) then call RegPackBounds(Buf, 1, lbound(InData%CoefDpths), ubound(InData%CoefDpths)) @@ -4274,9 +4059,7 @@ subroutine Morison_PackInitInput(Buf, Indata) call Morison_PackCoefDpths(Buf, InData%CoefDpths(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NCoefMembers) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CoefMembers)) if (allocated(InData%CoefMembers)) then call RegPackBounds(Buf, 1, lbound(InData%CoefMembers), ubound(InData%CoefMembers)) @@ -4286,9 +4069,7 @@ subroutine Morison_PackInitInput(Buf, Indata) call Morison_PackCoefMembers(Buf, InData%CoefMembers(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NMembers) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%InpMembers)) if (allocated(InData%InpMembers)) then call RegPackBounds(Buf, 1, lbound(InData%InpMembers), ubound(InData%InpMembers)) @@ -4298,9 +4079,7 @@ subroutine Morison_PackInitInput(Buf, Indata) call Morison_PackMemberInputType(Buf, InData%InpMembers(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NFillGroups) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FilledGroups)) if (allocated(InData%FilledGroups)) then call RegPackBounds(Buf, 1, lbound(InData%FilledGroups), ubound(InData%FilledGroups)) @@ -4310,9 +4089,7 @@ subroutine Morison_PackInitInput(Buf, Indata) call Morison_PackFilledGroupType(Buf, InData%FilledGroups(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NMGDepths) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%MGDepths)) if (allocated(InData%MGDepths)) then call RegPackBounds(Buf, 1, lbound(InData%MGDepths), ubound(InData%MGDepths)) @@ -4322,13 +4099,9 @@ subroutine Morison_PackInitInput(Buf, Indata) call Morison_PackMGDepthsType(Buf, InData%MGDepths(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MGTop) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MGBottom) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NMOutputs) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%MOutLst)) if (allocated(InData%MOutLst)) then call RegPackBounds(Buf, 1, lbound(InData%MOutLst), ubound(InData%MOutLst)) @@ -4338,9 +4111,7 @@ subroutine Morison_PackInitInput(Buf, Indata) call Morison_PackMOutput(Buf, InData%MOutLst(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NJOutputs) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%JOutLst)) if (allocated(InData%JOutLst)) then call RegPackBounds(Buf, 1, lbound(InData%JOutLst), ubound(InData%JOutLst)) @@ -4350,23 +4121,16 @@ subroutine Morison_PackInitInput(Buf, Indata) call Morison_PackJOutput(Buf, InData%JOutLst(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OutList)) if (allocated(InData%OutList)) then call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) call RegPack(Buf, InData%OutList) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UnSum) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NStepWave) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveStMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MCFD) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveField)) if (associated(InData%WaveField)) then call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) @@ -4733,7 +4497,6 @@ subroutine Morison_PackInitOutput(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) call RegPack(Buf, InData%WriteOutputHdr) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) @@ -5330,55 +5093,46 @@ subroutine Morison_PackMisc(Buf, Indata) call RegPackBounds(Buf, 2, lbound(InData%FV), ubound(InData%FV)) call RegPack(Buf, InData%FV) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FA)) if (allocated(InData%FA)) then call RegPackBounds(Buf, 2, lbound(InData%FA), ubound(InData%FA)) call RegPack(Buf, InData%FA) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FAMCF)) if (allocated(InData%FAMCF)) then call RegPackBounds(Buf, 2, lbound(InData%FAMCF), ubound(InData%FAMCF)) call RegPack(Buf, InData%FAMCF) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FDynP)) if (allocated(InData%FDynP)) then call RegPackBounds(Buf, 1, lbound(InData%FDynP), ubound(InData%FDynP)) call RegPack(Buf, InData%FDynP) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveElev)) if (allocated(InData%WaveElev)) then call RegPackBounds(Buf, 1, lbound(InData%WaveElev), ubound(InData%WaveElev)) call RegPack(Buf, InData%WaveElev) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveElev1)) if (allocated(InData%WaveElev1)) then call RegPackBounds(Buf, 1, lbound(InData%WaveElev1), ubound(InData%WaveElev1)) call RegPack(Buf, InData%WaveElev1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveElev2)) if (allocated(InData%WaveElev2)) then call RegPackBounds(Buf, 1, lbound(InData%WaveElev2), ubound(InData%WaveElev2)) call RegPack(Buf, InData%WaveElev2) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%vrel)) if (allocated(InData%vrel)) then call RegPackBounds(Buf, 2, lbound(InData%vrel), ubound(InData%vrel)) call RegPack(Buf, InData%vrel) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%nodeInWater)) if (allocated(InData%nodeInWater)) then call RegPackBounds(Buf, 1, lbound(InData%nodeInWater), ubound(InData%nodeInWater)) call RegPack(Buf, InData%nodeInWater) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%memberLoads)) if (allocated(InData%memberLoads)) then call RegPackBounds(Buf, 1, lbound(InData%memberLoads), ubound(InData%memberLoads)) @@ -5388,55 +5142,46 @@ subroutine Morison_PackMisc(Buf, Indata) call Morison_PackMemberLoads(Buf, InData%memberLoads(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%F_B_End)) if (allocated(InData%F_B_End)) then call RegPackBounds(Buf, 2, lbound(InData%F_B_End), ubound(InData%F_B_End)) call RegPack(Buf, InData%F_B_End) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%F_D_End)) if (allocated(InData%F_D_End)) then call RegPackBounds(Buf, 2, lbound(InData%F_D_End), ubound(InData%F_D_End)) call RegPack(Buf, InData%F_D_End) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%F_I_End)) if (allocated(InData%F_I_End)) then call RegPackBounds(Buf, 2, lbound(InData%F_I_End), ubound(InData%F_I_End)) call RegPack(Buf, InData%F_I_End) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%F_IMG_End)) if (allocated(InData%F_IMG_End)) then call RegPackBounds(Buf, 2, lbound(InData%F_IMG_End), ubound(InData%F_IMG_End)) call RegPack(Buf, InData%F_IMG_End) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%F_A_End)) if (allocated(InData%F_A_End)) then call RegPackBounds(Buf, 2, lbound(InData%F_A_End), ubound(InData%F_A_End)) call RegPack(Buf, InData%F_A_End) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%F_BF_End)) if (allocated(InData%F_BF_End)) then call RegPackBounds(Buf, 2, lbound(InData%F_BF_End), ubound(InData%F_BF_End)) call RegPack(Buf, InData%F_BF_End) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%V_rel_n)) if (allocated(InData%V_rel_n)) then call RegPackBounds(Buf, 1, lbound(InData%V_rel_n), ubound(InData%V_rel_n)) call RegPack(Buf, InData%V_rel_n) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%V_rel_n_HiPass)) if (allocated(InData%V_rel_n_HiPass)) then call RegPackBounds(Buf, 1, lbound(InData%V_rel_n_HiPass), ubound(InData%V_rel_n_HiPass)) call RegPack(Buf, InData%V_rel_n_HiPass) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LastIndWave) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -6039,21 +5784,13 @@ subroutine Morison_PackParam(Buf, Indata) logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%DT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Gravity) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WtrDens) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WtrDpth) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MSL2SWL) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveDisp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AMMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NMembers) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Members)) if (allocated(InData%Members)) then call RegPackBounds(Buf, 1, lbound(InData%Members), ubound(InData%Members)) @@ -6063,75 +5800,60 @@ subroutine Morison_PackParam(Buf, Indata) call Morison_PackMemberType(Buf, InData%Members(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NNodes) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NJoints) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%I_MG_End)) if (allocated(InData%I_MG_End)) then call RegPackBounds(Buf, 3, lbound(InData%I_MG_End), ubound(InData%I_MG_End)) call RegPack(Buf, InData%I_MG_End) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%An_End)) if (allocated(InData%An_End)) then call RegPackBounds(Buf, 2, lbound(InData%An_End), ubound(InData%An_End)) call RegPack(Buf, InData%An_End) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%DragConst_End)) if (allocated(InData%DragConst_End)) then call RegPackBounds(Buf, 1, lbound(InData%DragConst_End), ubound(InData%DragConst_End)) call RegPack(Buf, InData%DragConst_End) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%VRelNFiltConst)) if (allocated(InData%VRelNFiltConst)) then call RegPackBounds(Buf, 1, lbound(InData%VRelNFiltConst), ubound(InData%VRelNFiltConst)) call RegPack(Buf, InData%VRelNFiltConst) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%DragMod_End)) if (allocated(InData%DragMod_End)) then call RegPackBounds(Buf, 1, lbound(InData%DragMod_End), ubound(InData%DragMod_End)) call RegPack(Buf, InData%DragMod_End) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%DragLoFSc_End)) if (allocated(InData%DragLoFSc_End)) then call RegPackBounds(Buf, 1, lbound(InData%DragLoFSc_End), ubound(InData%DragLoFSc_End)) call RegPack(Buf, InData%DragLoFSc_End) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%F_WMG_End)) if (allocated(InData%F_WMG_End)) then call RegPackBounds(Buf, 2, lbound(InData%F_WMG_End), ubound(InData%F_WMG_End)) call RegPack(Buf, InData%F_WMG_End) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%DP_Const_End)) if (allocated(InData%DP_Const_End)) then call RegPackBounds(Buf, 2, lbound(InData%DP_Const_End), ubound(InData%DP_Const_End)) call RegPack(Buf, InData%DP_Const_End) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Mass_MG_End)) if (allocated(InData%Mass_MG_End)) then call RegPackBounds(Buf, 1, lbound(InData%Mass_MG_End), ubound(InData%Mass_MG_End)) call RegPack(Buf, InData%Mass_MG_End) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AM_End)) if (allocated(InData%AM_End)) then call RegPackBounds(Buf, 3, lbound(InData%AM_End), ubound(InData%AM_End)) call RegPack(Buf, InData%AM_End) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NStepWave) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NMOutputs) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%MOutLst)) if (allocated(InData%MOutLst)) then call RegPackBounds(Buf, 1, lbound(InData%MOutLst), ubound(InData%MOutLst)) @@ -6141,9 +5863,7 @@ subroutine Morison_PackParam(Buf, Indata) call Morison_PackMOutput(Buf, InData%MOutLst(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NJOutputs) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%JOutLst)) if (allocated(InData%JOutLst)) then call RegPackBounds(Buf, 1, lbound(InData%JOutLst), ubound(InData%JOutLst)) @@ -6153,7 +5873,6 @@ subroutine Morison_PackParam(Buf, Indata) call Morison_PackJOutput(Buf, InData%JOutLst(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) @@ -6163,11 +5882,8 @@ subroutine Morison_PackParam(Buf, Indata) call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveStMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveField)) if (associated(InData%WaveField)) then call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) @@ -6536,7 +6252,6 @@ subroutine Morison_PackOutput(Buf, Indata) character(*), parameter :: RoutineName = 'Morison_PackOutput' if (Buf%ErrStat >= AbortErrLev) return call MeshPack(Buf, InData%Mesh) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) diff --git a/modules/hydrodyn/src/SS_Excitation_Types.f90 b/modules/hydrodyn/src/SS_Excitation_Types.f90 index 6d40b870bc..2b7d95f242 100644 --- a/modules/hydrodyn/src/SS_Excitation_Types.f90 +++ b/modules/hydrodyn/src/SS_Excitation_Types.f90 @@ -175,21 +175,15 @@ subroutine SS_Exc_PackInitInput(Buf, Indata) logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%InputFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NBody) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ExctnDisp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveDir) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NStepWave) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PtfmRefztRot)) if (allocated(InData%PtfmRefztRot)) then call RegPackBounds(Buf, 1, lbound(InData%PtfmRefztRot), ubound(InData%PtfmRefztRot)) call RegPack(Buf, InData%PtfmRefztRot) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveElev0)) if (associated(InData%WaveElev0)) then call RegPackBounds(Buf, 1, lbound(InData%WaveElev0), ubound(InData%WaveElev0)) @@ -198,7 +192,6 @@ subroutine SS_Exc_PackInitInput(Buf, Indata) call RegPack(Buf, InData%WaveElev0) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveElev1)) if (associated(InData%WaveElev1)) then call RegPackBounds(Buf, 3, lbound(InData%WaveElev1), ubound(InData%WaveElev1)) @@ -207,7 +200,6 @@ subroutine SS_Exc_PackInitInput(Buf, Indata) call RegPack(Buf, InData%WaveElev1) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveTime)) if (associated(InData%WaveTime)) then call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) @@ -216,7 +208,6 @@ subroutine SS_Exc_PackInitInput(Buf, Indata) call RegPack(Buf, InData%WaveTime) end if end if - if (RegCheckErr(Buf, RoutineName)) return call SeaSt_Interp_PackParam(Buf, InData%SeaSt_Interp_p) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -396,7 +387,6 @@ subroutine SS_Exc_PackInitOutput(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) call RegPack(Buf, InData%WriteOutputHdr) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) @@ -641,7 +631,6 @@ subroutine SS_Exc_PackOtherState(Buf, Indata) integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%n) - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%xdot) UB(1:1) = ubound(InData%xdot) do i1 = LB(1), UB(1) @@ -700,7 +689,6 @@ subroutine SS_Exc_PackMisc(Buf, Indata) character(*), parameter :: RoutineName = 'SS_Exc_PackMisc' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%LastIndWave) - if (RegCheckErr(Buf, RoutineName)) return call SeaSt_Interp_PackMisc(Buf, InData%SeaSt_Interp_m) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -830,41 +818,31 @@ subroutine SS_Exc_PackParam(Buf, Indata) logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%DT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NBody) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ExctnDisp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NStepWave) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%spDOF)) if (allocated(InData%spDOF)) then call RegPackBounds(Buf, 1, lbound(InData%spDOF), ubound(InData%spDOF)) call RegPack(Buf, InData%spDOF) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%A)) if (allocated(InData%A)) then call RegPackBounds(Buf, 2, lbound(InData%A), ubound(InData%A)) call RegPack(Buf, InData%A) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%B)) if (allocated(InData%B)) then call RegPackBounds(Buf, 1, lbound(InData%B), ubound(InData%B)) call RegPack(Buf, InData%B) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%C)) if (allocated(InData%C)) then call RegPackBounds(Buf, 2, lbound(InData%C), ubound(InData%C)) call RegPack(Buf, InData%C) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%numStates) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Tc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveElev0)) if (associated(InData%WaveElev0)) then call RegPackBounds(Buf, 1, lbound(InData%WaveElev0), ubound(InData%WaveElev0)) @@ -873,7 +851,6 @@ subroutine SS_Exc_PackParam(Buf, Indata) call RegPack(Buf, InData%WaveElev0) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveElev1)) if (associated(InData%WaveElev1)) then call RegPackBounds(Buf, 3, lbound(InData%WaveElev1), ubound(InData%WaveElev1)) @@ -882,7 +859,6 @@ subroutine SS_Exc_PackParam(Buf, Indata) call RegPack(Buf, InData%WaveElev1) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveTime)) if (associated(InData%WaveTime)) then call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) @@ -891,7 +867,6 @@ subroutine SS_Exc_PackParam(Buf, Indata) call RegPack(Buf, InData%WaveTime) end if end if - if (RegCheckErr(Buf, RoutineName)) return call SeaSt_Interp_PackParam(Buf, InData%SeaSt_Interp_p) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1191,7 +1166,6 @@ subroutine SS_Exc_PackOutput(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%y), ubound(InData%y)) call RegPack(Buf, InData%y) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) diff --git a/modules/hydrodyn/src/SS_Radiation_Types.f90 b/modules/hydrodyn/src/SS_Radiation_Types.f90 index f9a29e9059..39ed49eefb 100644 --- a/modules/hydrodyn/src/SS_Radiation_Types.f90 +++ b/modules/hydrodyn/src/SS_Radiation_Types.f90 @@ -161,15 +161,12 @@ subroutine SS_Rad_PackInitInput(Buf, Indata) character(*), parameter :: RoutineName = 'SS_Rad_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%InputFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%enabledDOFs)) if (allocated(InData%enabledDOFs)) then call RegPackBounds(Buf, 1, lbound(InData%enabledDOFs), ubound(InData%enabledDOFs)) call RegPack(Buf, InData%enabledDOFs) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NBody) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PtfmRefztRot)) if (allocated(InData%PtfmRefztRot)) then call RegPackBounds(Buf, 1, lbound(InData%PtfmRefztRot), ubound(InData%PtfmRefztRot)) @@ -286,7 +283,6 @@ subroutine SS_Rad_PackInitOutput(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) call RegPack(Buf, InData%WriteOutputHdr) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) @@ -531,7 +527,6 @@ subroutine SS_Rad_PackOtherState(Buf, Indata) integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%n) - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%xdot) UB(1:1) = ubound(InData%xdot) do i1 = LB(1), UB(1) @@ -694,33 +689,27 @@ subroutine SS_Rad_PackParam(Buf, Indata) character(*), parameter :: RoutineName = 'SS_Rad_PackParam' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%DT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%A)) if (allocated(InData%A)) then call RegPackBounds(Buf, 2, lbound(InData%A), ubound(InData%A)) call RegPack(Buf, InData%A) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%B)) if (allocated(InData%B)) then call RegPackBounds(Buf, 2, lbound(InData%B), ubound(InData%B)) call RegPack(Buf, InData%B) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%C)) if (allocated(InData%C)) then call RegPackBounds(Buf, 2, lbound(InData%C), ubound(InData%C)) call RegPack(Buf, InData%C) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%numStates) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%spdof)) if (allocated(InData%spdof)) then call RegPackBounds(Buf, 1, lbound(InData%spdof), ubound(InData%spdof)) call RegPack(Buf, InData%spdof) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NBody) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -939,7 +928,6 @@ subroutine SS_Rad_PackOutput(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%y), ubound(InData%y)) call RegPack(Buf, InData%y) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) diff --git a/modules/hydrodyn/src/WAMIT2_Types.f90 b/modules/hydrodyn/src/WAMIT2_Types.f90 index c63a29c26c..e9892bb6ef 100644 --- a/modules/hydrodyn/src/WAMIT2_Types.f90 +++ b/modules/hydrodyn/src/WAMIT2_Types.f90 @@ -236,53 +236,37 @@ subroutine WAMIT2_PackInitInput(Buf, Indata) logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%HasWAMIT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WAMITFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NBody) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NBodyMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PtfmRefxt)) if (allocated(InData%PtfmRefxt)) then call RegPackBounds(Buf, 1, lbound(InData%PtfmRefxt), ubound(InData%PtfmRefxt)) call RegPack(Buf, InData%PtfmRefxt) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PtfmRefyt)) if (allocated(InData%PtfmRefyt)) then call RegPackBounds(Buf, 1, lbound(InData%PtfmRefyt), ubound(InData%PtfmRefyt)) call RegPack(Buf, InData%PtfmRefyt) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PtfmRefzt)) if (allocated(InData%PtfmRefzt)) then call RegPackBounds(Buf, 1, lbound(InData%PtfmRefzt), ubound(InData%PtfmRefzt)) call RegPack(Buf, InData%PtfmRefzt) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PtfmRefztRot)) if (allocated(InData%PtfmRefztRot)) then call RegPackBounds(Buf, 1, lbound(InData%PtfmRefztRot), ubound(InData%PtfmRefztRot)) call RegPack(Buf, InData%PtfmRefztRot) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WAMITULEN) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RhoXg) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NStepWave) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NStepWave2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveDOmega) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WtrDens) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Gravity) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WtrDpth) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveElevC0)) if (associated(InData%WaveElevC0)) then call RegPackBounds(Buf, 2, lbound(InData%WaveElevC0), ubound(InData%WaveElevC0)) @@ -291,11 +275,8 @@ subroutine WAMIT2_PackInitInput(Buf, Indata) call RegPack(Buf, InData%WaveElevC0) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveDir) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveMultiDir) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveDirArr)) if (associated(InData%WaveDirArr)) then call RegPackBounds(Buf, 1, lbound(InData%WaveDirArr), ubound(InData%WaveDirArr)) @@ -304,39 +285,22 @@ subroutine WAMIT2_PackInitInput(Buf, Indata) call RegPack(Buf, InData%WaveDirArr) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveDirMin) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveDirMax) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MnDrift) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NewmanApp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DiffQTF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SumQTF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MnDriftF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NewmanAppF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DiffQTFF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SumQTFF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WvLowCOff) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WvHiCOff) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WvLowCOffD) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WvHiCOffD) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WvLowCOffS) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WvHiCOffS) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -585,7 +549,6 @@ subroutine WAMIT2_PackMisc(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%LastIndWave), ubound(InData%LastIndWave)) call RegPack(Buf, InData%LastIndWave) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%F_Waves2)) if (allocated(InData%F_Waves2)) then call RegPackBounds(Buf, 1, lbound(InData%F_Waves2), ubound(InData%F_Waves2)) @@ -688,31 +651,20 @@ subroutine WAMIT2_PackParam(Buf, Indata) character(*), parameter :: RoutineName = 'WAMIT2_PackParam' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%NStepWave) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NBody) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NBodyMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveExctn2)) if (allocated(InData%WaveExctn2)) then call RegPackBounds(Buf, 2, lbound(InData%WaveExctn2), ubound(InData%WaveExctn2)) call RegPack(Buf, InData%WaveExctn2) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MnDriftDims) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NewmanAppDims) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DiffQTFDims) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SumQTFDims) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MnDriftF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NewmanAppF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DiffQTFF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SumQTFF) if (RegCheckErr(Buf, RoutineName)) return end subroutine diff --git a/modules/hydrodyn/src/WAMIT_Types.f90 b/modules/hydrodyn/src/WAMIT_Types.f90 index 8f682ab5ea..e844016668 100644 --- a/modules/hydrodyn/src/WAMIT_Types.f90 +++ b/modules/hydrodyn/src/WAMIT_Types.f90 @@ -348,83 +348,58 @@ subroutine WAMIT_PackInitInput(Buf, Indata) logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%NBody) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NBodyMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Gravity) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WtrDpth) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PtfmVol0)) if (allocated(InData%PtfmVol0)) then call RegPackBounds(Buf, 1, lbound(InData%PtfmVol0), ubound(InData%PtfmVol0)) call RegPack(Buf, InData%PtfmVol0) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HasWAMIT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WAMITULEN) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PtfmRefxt)) if (allocated(InData%PtfmRefxt)) then call RegPackBounds(Buf, 1, lbound(InData%PtfmRefxt), ubound(InData%PtfmRefxt)) call RegPack(Buf, InData%PtfmRefxt) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PtfmRefyt)) if (allocated(InData%PtfmRefyt)) then call RegPackBounds(Buf, 1, lbound(InData%PtfmRefyt), ubound(InData%PtfmRefyt)) call RegPack(Buf, InData%PtfmRefyt) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PtfmRefzt)) if (allocated(InData%PtfmRefzt)) then call RegPackBounds(Buf, 1, lbound(InData%PtfmRefzt), ubound(InData%PtfmRefzt)) call RegPack(Buf, InData%PtfmRefzt) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PtfmRefztRot)) if (allocated(InData%PtfmRefztRot)) then call RegPackBounds(Buf, 1, lbound(InData%PtfmRefztRot), ubound(InData%PtfmRefztRot)) call RegPack(Buf, InData%PtfmRefztRot) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PtfmCOBxt)) if (allocated(InData%PtfmCOBxt)) then call RegPackBounds(Buf, 1, lbound(InData%PtfmCOBxt), ubound(InData%PtfmCOBxt)) call RegPack(Buf, InData%PtfmCOBxt) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PtfmCOByt)) if (allocated(InData%PtfmCOByt)) then call RegPackBounds(Buf, 1, lbound(InData%PtfmCOByt), ubound(InData%PtfmCOByt)) call RegPack(Buf, InData%PtfmCOByt) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RdtnMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ExctnMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ExctnDisp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ExctnCutOff) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RdtnTMax) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveDir) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WAMITFile) - if (RegCheckErr(Buf, RoutineName)) return call Conv_Rdtn_PackInitInput(Buf, InData%Conv_Rdtn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Rhoxg) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NStepWave) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NStepWave2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveDOmega) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveElev0)) if (associated(InData%WaveElev0)) then call RegPackBounds(Buf, 1, lbound(InData%WaveElev0), ubound(InData%WaveElev0)) @@ -433,7 +408,6 @@ subroutine WAMIT_PackInitInput(Buf, Indata) call RegPack(Buf, InData%WaveElev0) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveElev1)) if (associated(InData%WaveElev1)) then call RegPackBounds(Buf, 3, lbound(InData%WaveElev1), ubound(InData%WaveElev1)) @@ -442,7 +416,6 @@ subroutine WAMIT_PackInitInput(Buf, Indata) call RegPack(Buf, InData%WaveElev1) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveElevC0)) if (associated(InData%WaveElevC0)) then call RegPackBounds(Buf, 2, lbound(InData%WaveElevC0), ubound(InData%WaveElevC0)) @@ -451,7 +424,6 @@ subroutine WAMIT_PackInitInput(Buf, Indata) call RegPack(Buf, InData%WaveElevC0) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveElevC)) if (associated(InData%WaveElevC)) then call RegPackBounds(Buf, 3, lbound(InData%WaveElevC), ubound(InData%WaveElevC)) @@ -460,7 +432,6 @@ subroutine WAMIT_PackInitInput(Buf, Indata) call RegPack(Buf, InData%WaveElevC) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveTime)) if (associated(InData%WaveTime)) then call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) @@ -469,11 +440,8 @@ subroutine WAMIT_PackInitInput(Buf, Indata) call RegPack(Buf, InData%WaveTime) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WtrDens) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveDirArr)) if (associated(InData%WaveDirArr)) then call RegPackBounds(Buf, 1, lbound(InData%WaveDirArr), ubound(InData%WaveDirArr)) @@ -482,11 +450,8 @@ subroutine WAMIT_PackInitInput(Buf, Indata) call RegPack(Buf, InData%WaveDirArr) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveDirMin) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveDirMax) - if (RegCheckErr(Buf, RoutineName)) return call SeaSt_Interp_PackParam(Buf, InData%SeaSt_Interp_p) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -828,9 +793,7 @@ subroutine WAMIT_PackContState(Buf, Indata) character(*), parameter :: RoutineName = 'WAMIT_PackContState' if (Buf%ErrStat >= AbortErrLev) return call SS_Rad_PackContState(Buf, InData%SS_Rdtn) - if (RegCheckErr(Buf, RoutineName)) return call SS_Exc_PackContState(Buf, InData%SS_Exctn) - if (RegCheckErr(Buf, RoutineName)) return call Conv_Rdtn_PackContState(Buf, InData%Conv_Rdtn) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -902,11 +865,8 @@ subroutine WAMIT_PackDiscState(Buf, Indata) character(*), parameter :: RoutineName = 'WAMIT_PackDiscState' if (Buf%ErrStat >= AbortErrLev) return call Conv_Rdtn_PackDiscState(Buf, InData%Conv_Rdtn) - if (RegCheckErr(Buf, RoutineName)) return call SS_Rad_PackDiscState(Buf, InData%SS_Rdtn) - if (RegCheckErr(Buf, RoutineName)) return call SS_Exc_PackDiscState(Buf, InData%SS_Exctn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BdyPosFilt)) if (allocated(InData%BdyPosFilt)) then call RegPackBounds(Buf, 3, lbound(InData%BdyPosFilt), ubound(InData%BdyPosFilt)) @@ -981,9 +941,7 @@ subroutine WAMIT_PackConstrState(Buf, Indata) character(*), parameter :: RoutineName = 'WAMIT_PackConstrState' if (Buf%ErrStat >= AbortErrLev) return call Conv_Rdtn_PackConstrState(Buf, InData%Conv_Rdtn) - if (RegCheckErr(Buf, RoutineName)) return call SS_Rad_PackConstrState(Buf, InData%SS_Rdtn) - if (RegCheckErr(Buf, RoutineName)) return call SS_Exc_PackConstrState(Buf, InData%SS_Exctn) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1037,9 +995,7 @@ subroutine WAMIT_PackOtherState(Buf, Indata) character(*), parameter :: RoutineName = 'WAMIT_PackOtherState' if (Buf%ErrStat >= AbortErrLev) return call SS_Rad_PackOtherState(Buf, InData%SS_Rdtn) - if (RegCheckErr(Buf, RoutineName)) return call SS_Exc_PackOtherState(Buf, InData%SS_Exctn) - if (RegCheckErr(Buf, RoutineName)) return call Conv_Rdtn_PackOtherState(Buf, InData%Conv_Rdtn) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1184,49 +1140,35 @@ subroutine WAMIT_PackMisc(Buf, Indata) character(*), parameter :: RoutineName = 'WAMIT_PackMisc' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%LastIndWave) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%F_HS)) if (allocated(InData%F_HS)) then call RegPackBounds(Buf, 1, lbound(InData%F_HS), ubound(InData%F_HS)) call RegPack(Buf, InData%F_HS) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%F_Waves1)) if (allocated(InData%F_Waves1)) then call RegPackBounds(Buf, 1, lbound(InData%F_Waves1), ubound(InData%F_Waves1)) call RegPack(Buf, InData%F_Waves1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%F_Rdtn)) if (allocated(InData%F_Rdtn)) then call RegPackBounds(Buf, 1, lbound(InData%F_Rdtn), ubound(InData%F_Rdtn)) call RegPack(Buf, InData%F_Rdtn) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%F_PtfmAM)) if (allocated(InData%F_PtfmAM)) then call RegPackBounds(Buf, 1, lbound(InData%F_PtfmAM), ubound(InData%F_PtfmAM)) call RegPack(Buf, InData%F_PtfmAM) end if - if (RegCheckErr(Buf, RoutineName)) return call SS_Rad_PackMisc(Buf, InData%SS_Rdtn) - if (RegCheckErr(Buf, RoutineName)) return call SS_Rad_PackInput(Buf, InData%SS_Rdtn_u) - if (RegCheckErr(Buf, RoutineName)) return call SS_Rad_PackOutput(Buf, InData%SS_Rdtn_y) - if (RegCheckErr(Buf, RoutineName)) return call SS_Exc_PackMisc(Buf, InData%SS_Exctn) - if (RegCheckErr(Buf, RoutineName)) return call SS_Exc_PackInput(Buf, InData%SS_Exctn_u) - if (RegCheckErr(Buf, RoutineName)) return call SS_Exc_PackOutput(Buf, InData%SS_Exctn_y) - if (RegCheckErr(Buf, RoutineName)) return call Conv_Rdtn_PackMisc(Buf, InData%Conv_Rdtn) - if (RegCheckErr(Buf, RoutineName)) return call Conv_Rdtn_PackInput(Buf, InData%Conv_Rdtn_u) - if (RegCheckErr(Buf, RoutineName)) return call Conv_Rdtn_PackOutput(Buf, InData%Conv_Rdtn_y) - if (RegCheckErr(Buf, RoutineName)) return call SeaSt_Interp_PackMisc(Buf, InData%SeaSt_Interp_m) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1446,59 +1388,42 @@ subroutine WAMIT_PackParam(Buf, Indata) character(*), parameter :: RoutineName = 'WAMIT_PackParam' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%NBody) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NBodyMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%F_HS_Moment_Offset)) if (allocated(InData%F_HS_Moment_Offset)) then call RegPackBounds(Buf, 2, lbound(InData%F_HS_Moment_Offset), ubound(InData%F_HS_Moment_Offset)) call RegPack(Buf, InData%F_HS_Moment_Offset) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%HdroAdMsI)) if (allocated(InData%HdroAdMsI)) then call RegPackBounds(Buf, 2, lbound(InData%HdroAdMsI), ubound(InData%HdroAdMsI)) call RegPack(Buf, InData%HdroAdMsI) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%HdroSttc)) if (allocated(InData%HdroSttc)) then call RegPackBounds(Buf, 2, lbound(InData%HdroSttc), ubound(InData%HdroSttc)) call RegPack(Buf, InData%HdroSttc) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RdtnMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ExctnMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ExctnDisp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ExctnCutOff) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ExctnFiltConst) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveExctn)) if (allocated(InData%WaveExctn)) then call RegPackBounds(Buf, 2, lbound(InData%WaveExctn), ubound(InData%WaveExctn)) call RegPack(Buf, InData%WaveExctn) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveExctnGrid)) if (allocated(InData%WaveExctnGrid)) then call RegPackBounds(Buf, 4, lbound(InData%WaveExctnGrid), ubound(InData%WaveExctnGrid)) call RegPack(Buf, InData%WaveExctnGrid) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NStepWave) - if (RegCheckErr(Buf, RoutineName)) return call Conv_Rdtn_PackParam(Buf, InData%Conv_Rdtn) - if (RegCheckErr(Buf, RoutineName)) return call SS_Rad_PackParam(Buf, InData%SS_Rdtn) - if (RegCheckErr(Buf, RoutineName)) return call SS_Exc_PackParam(Buf, InData%SS_Exctn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DT) - if (RegCheckErr(Buf, RoutineName)) return call SeaSt_Interp_PackParam(Buf, InData%SeaSt_Interp_p) if (RegCheckErr(Buf, RoutineName)) return end subroutine diff --git a/modules/icedyn/src/IceDyn_Types.f90 b/modules/icedyn/src/IceDyn_Types.f90 index cb005cedf3..66f107fa12 100644 --- a/modules/icedyn/src/IceDyn_Types.f90 +++ b/modules/icedyn/src/IceDyn_Types.f90 @@ -362,135 +362,76 @@ subroutine IceD_PackInputFile(Buf, Indata) character(*), parameter :: RoutineName = 'IceD_PackInputFile' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%IceModel) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%IceSubModel) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%h) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%v) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%InitLoc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%t0) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rhow) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rhoi) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Seed1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Seed2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumLegs) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LegPosX)) if (allocated(InData%LegPosX)) then call RegPackBounds(Buf, 1, lbound(InData%LegPosX), ubound(InData%LegPosX)) call RegPack(Buf, InData%LegPosX) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LegPosY)) if (allocated(InData%LegPosY)) then call RegPackBounds(Buf, 1, lbound(InData%LegPosY), ubound(InData%LegPosY)) call RegPack(Buf, InData%LegPosY) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%StrWd)) if (allocated(InData%StrWd)) then call RegPackBounds(Buf, 1, lbound(InData%StrWd), ubound(InData%StrWd)) call RegPack(Buf, InData%StrWd) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Ikm) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Ag) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Qg) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Rg) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Tice) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nu) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%phi) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SigNm) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Eice) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%IceStr2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Delmax2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Pitch) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%miuh) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%varh) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%miuv) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%varv) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%miut) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%miubr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%varbr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%miuDelm) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%varDelm) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%miuP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%varP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Zn1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Zn2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ZonePitch) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PrflMean) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PrflSig) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%IceStr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Delmax) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%alpha) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Dwl) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Dtp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%hr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%mu) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%sigf) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StrLim) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StrRtLim) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UorD) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Ll) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Lw) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Cpa) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dpa) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Fdr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Kic) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FspN) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -694,17 +635,11 @@ subroutine IceD_PackInitInput(Buf, Indata) character(*), parameter :: RoutineName = 'IceD_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%InputFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RootName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MSL2SWL) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WtrDens) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%gravity) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LegNum) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TMax) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -803,15 +738,12 @@ subroutine IceD_PackInitOutput(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) call RegPack(Buf, InData%WriteOutputHdr) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) call RegPack(Buf, InData%WriteOutputUnt) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%numLegs) - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackProgDesc(Buf, InData%Ver) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -885,7 +817,6 @@ subroutine IceD_PackContState(Buf, Indata) character(*), parameter :: RoutineName = 'IceD_PackContState' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%q) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dqdt) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1099,33 +1030,25 @@ subroutine IceD_PackOtherState(Buf, Indata) integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%IceTthNo2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Nc)) if (allocated(InData%Nc)) then call RegPackBounds(Buf, 1, lbound(InData%Nc), ubound(InData%Nc)) call RegPack(Buf, InData%Nc) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Psum)) if (allocated(InData%Psum)) then call RegPackBounds(Buf, 1, lbound(InData%Psum), ubound(InData%Psum)) call RegPack(Buf, InData%Psum) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%IceTthNo)) if (allocated(InData%IceTthNo)) then call RegPackBounds(Buf, 1, lbound(InData%IceTthNo), ubound(InData%IceTthNo)) call RegPack(Buf, InData%IceTthNo) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Beta) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Tinit) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Splitf) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dxc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%xdot)) if (allocated(InData%xdot)) then call RegPackBounds(Buf, 1, lbound(InData%xdot), ubound(InData%xdot)) @@ -1135,7 +1058,6 @@ subroutine IceD_PackOtherState(Buf, Indata) call IceD_PackContState(Buf, InData%xdot(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%n) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1505,159 +1427,102 @@ subroutine IceD_PackParam(Buf, Indata) character(*), parameter :: RoutineName = 'IceD_PackParam' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%h) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%v) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%t0) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StrWd) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%InitLoc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%tolerance) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Tmax) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%verif) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ModNo) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SubModNo) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%method) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TmStep) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OutName)) if (allocated(InData%OutName)) then call RegPackBounds(Buf, 1, lbound(InData%OutName), ubound(InData%OutName)) call RegPack(Buf, InData%OutName) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OutUnit)) if (allocated(InData%OutUnit)) then call RegPackBounds(Buf, 1, lbound(InData%OutUnit), ubound(InData%OutUnit)) call RegPack(Buf, InData%OutUnit) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RootName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%tm1a) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%tm1b) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%tm1c) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Fmax1a) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Fmax1b) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Fmax1c) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Ikm) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Cstr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%EiPa) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Delmax2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Pitch) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Kice2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%rdmFm)) if (allocated(InData%rdmFm)) then call RegPackBounds(Buf, 1, lbound(InData%rdmFm), ubound(InData%rdmFm)) call RegPack(Buf, InData%rdmFm) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%rdmt0)) if (allocated(InData%rdmt0)) then call RegPackBounds(Buf, 1, lbound(InData%rdmt0), ubound(InData%rdmt0)) call RegPack(Buf, InData%rdmt0) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%rdmtm)) if (allocated(InData%rdmtm)) then call RegPackBounds(Buf, 1, lbound(InData%rdmtm), ubound(InData%rdmtm)) call RegPack(Buf, InData%rdmtm) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%rdmDm)) if (allocated(InData%rdmDm)) then call RegPackBounds(Buf, 1, lbound(InData%rdmDm), ubound(InData%rdmDm)) call RegPack(Buf, InData%rdmDm) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%rdmP)) if (allocated(InData%rdmP)) then call RegPackBounds(Buf, 1, lbound(InData%rdmP), ubound(InData%rdmP)) call RegPack(Buf, InData%rdmP) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%rdmKi)) if (allocated(InData%rdmKi)) then call RegPackBounds(Buf, 1, lbound(InData%rdmKi), ubound(InData%rdmKi)) call RegPack(Buf, InData%rdmKi) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ZonePitch) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Kice) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Delmax) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Y0)) if (allocated(InData%Y0)) then call RegPackBounds(Buf, 1, lbound(InData%Y0), ubound(InData%Y0)) call RegPack(Buf, InData%Y0) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ContPrfl)) if (allocated(InData%ContPrfl)) then call RegPackBounds(Buf, 1, lbound(InData%ContPrfl), ubound(InData%ContPrfl)) call RegPack(Buf, InData%ContPrfl) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Zn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rhoi) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rhow) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%alphaR) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Dwl) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Zr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RHbr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RVbr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Lbr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LovR) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%mu) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Wri) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WL) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Cpa) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dpa) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FdrN) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Mice) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Fsp) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2003,7 +1868,6 @@ subroutine IceD_PackOutput(Buf, Indata) character(*), parameter :: RoutineName = 'IceD_PackOutput' if (Buf%ErrStat >= AbortErrLev) return call MeshPack(Buf, InData%PointMesh) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) diff --git a/modules/icefloe/src/icefloe/IceFloe_Types.f90 b/modules/icefloe/src/icefloe/IceFloe_Types.f90 index 50ec328472..26c6a64756 100644 --- a/modules/icefloe/src/icefloe/IceFloe_Types.f90 +++ b/modules/icefloe/src/icefloe/IceFloe_Types.f90 @@ -141,13 +141,9 @@ subroutine IceFloe_PackInitInput(Buf, Indata) character(*), parameter :: RoutineName = 'IceFloe_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%InputFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%simLength) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MSL2SWL) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%gravity) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RootName) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -241,13 +237,11 @@ subroutine IceFloe_PackInitOutput(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) call RegPack(Buf, InData%WriteOutputHdr) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) call RegPack(Buf, InData%WriteOutputUnt) end if - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackProgDesc(Buf, InData%Ver) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -601,53 +595,35 @@ subroutine IceFloe_PackParam(Buf, Indata) call RegPackBounds(Buf, 2, lbound(InData%loadSeries), ubound(InData%loadSeries)) call RegPack(Buf, InData%loadSeries) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%iceVel) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%iceDirection) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%minStrength) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%minStrengthNegVel) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%defaultArea) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%crushArea) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%coeffStressRate) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%C(4)) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rampTime) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%legX)) if (allocated(InData%legX)) then call RegPackBounds(Buf, 1, lbound(InData%legX), ubound(InData%legX)) call RegPack(Buf, InData%legX) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%legY)) if (allocated(InData%legY)) then call RegPackBounds(Buf, 1, lbound(InData%legY), ubound(InData%legY)) call RegPack(Buf, InData%legY) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ks)) if (allocated(InData%ks)) then call RegPackBounds(Buf, 1, lbound(InData%ks), ubound(InData%ks)) call RegPack(Buf, InData%ks) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%numLegs) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%iceType) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%logUnitNum) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%singleLoad) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%initFlag) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -843,7 +819,6 @@ subroutine IceFloe_PackOutput(Buf, Indata) character(*), parameter :: RoutineName = 'IceFloe_PackOutput' if (Buf%ErrStat >= AbortErrLev) return call MeshPack(Buf, InData%iceMesh) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) diff --git a/modules/inflowwind/src/IfW_FlowField_Types.f90 b/modules/inflowwind/src/IfW_FlowField_Types.f90 index 87a34b2bbe..d3d523291a 100644 --- a/modules/inflowwind/src/IfW_FlowField_Types.f90 +++ b/modules/inflowwind/src/IfW_FlowField_Types.f90 @@ -487,107 +487,88 @@ subroutine IfW_FlowField_PackUniformFieldType(Buf, Indata) character(*), parameter :: RoutineName = 'IfW_FlowField_PackUniformFieldType' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%RefHeight) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RefLength) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DataSize) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Time)) if (allocated(InData%Time)) then call RegPackBounds(Buf, 1, lbound(InData%Time), ubound(InData%Time)) call RegPack(Buf, InData%Time) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%VelH)) if (allocated(InData%VelH)) then call RegPackBounds(Buf, 1, lbound(InData%VelH), ubound(InData%VelH)) call RegPack(Buf, InData%VelH) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%VelHDot)) if (allocated(InData%VelHDot)) then call RegPackBounds(Buf, 1, lbound(InData%VelHDot), ubound(InData%VelHDot)) call RegPack(Buf, InData%VelHDot) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%VelV)) if (allocated(InData%VelV)) then call RegPackBounds(Buf, 1, lbound(InData%VelV), ubound(InData%VelV)) call RegPack(Buf, InData%VelV) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%VelVDot)) if (allocated(InData%VelVDot)) then call RegPackBounds(Buf, 1, lbound(InData%VelVDot), ubound(InData%VelVDot)) call RegPack(Buf, InData%VelVDot) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%VelGust)) if (allocated(InData%VelGust)) then call RegPackBounds(Buf, 1, lbound(InData%VelGust), ubound(InData%VelGust)) call RegPack(Buf, InData%VelGust) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%VelGustDot)) if (allocated(InData%VelGustDot)) then call RegPackBounds(Buf, 1, lbound(InData%VelGustDot), ubound(InData%VelGustDot)) call RegPack(Buf, InData%VelGustDot) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AngleH)) if (allocated(InData%AngleH)) then call RegPackBounds(Buf, 1, lbound(InData%AngleH), ubound(InData%AngleH)) call RegPack(Buf, InData%AngleH) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AngleHDot)) if (allocated(InData%AngleHDot)) then call RegPackBounds(Buf, 1, lbound(InData%AngleHDot), ubound(InData%AngleHDot)) call RegPack(Buf, InData%AngleHDot) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AngleV)) if (allocated(InData%AngleV)) then call RegPackBounds(Buf, 1, lbound(InData%AngleV), ubound(InData%AngleV)) call RegPack(Buf, InData%AngleV) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AngleVDot)) if (allocated(InData%AngleVDot)) then call RegPackBounds(Buf, 1, lbound(InData%AngleVDot), ubound(InData%AngleVDot)) call RegPack(Buf, InData%AngleVDot) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ShrH)) if (allocated(InData%ShrH)) then call RegPackBounds(Buf, 1, lbound(InData%ShrH), ubound(InData%ShrH)) call RegPack(Buf, InData%ShrH) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ShrHDot)) if (allocated(InData%ShrHDot)) then call RegPackBounds(Buf, 1, lbound(InData%ShrHDot), ubound(InData%ShrHDot)) call RegPack(Buf, InData%ShrHDot) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ShrV)) if (allocated(InData%ShrV)) then call RegPackBounds(Buf, 1, lbound(InData%ShrV), ubound(InData%ShrV)) call RegPack(Buf, InData%ShrV) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ShrVDot)) if (allocated(InData%ShrVDot)) then call RegPackBounds(Buf, 1, lbound(InData%ShrVDot), ubound(InData%ShrVDot)) call RegPack(Buf, InData%ShrVDot) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LinShrV)) if (allocated(InData%LinShrV)) then call RegPackBounds(Buf, 1, lbound(InData%LinShrV), ubound(InData%LinShrV)) call RegPack(Buf, InData%LinShrV) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LinShrVDot)) if (allocated(InData%LinShrVDot)) then call RegPackBounds(Buf, 1, lbound(InData%LinShrVDot), ubound(InData%LinShrVDot)) @@ -896,43 +877,24 @@ subroutine IfW_FlowField_PackUniformField_Interp(Buf, Indata) character(*), parameter :: RoutineName = 'IfW_FlowField_PackUniformField_Interp' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%VelH) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VelHDot) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VelV) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VelVDot) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VelGust) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VelGustDot) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AngleH) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AngleHDot) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AngleV) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AngleVDot) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ShrH) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ShrHDot) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ShrV) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ShrVDot) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LinShrV) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LinShrVDot) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CosAngleH) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SinAngleH) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CosAngleV) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SinAngleV) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1144,99 +1106,64 @@ subroutine IfW_FlowField_PackGrid3DFieldType(Buf, Indata) character(*), parameter :: RoutineName = 'IfW_FlowField_PackGrid3DFieldType' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%WindFileFormat) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WindProfileType) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Periodic) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%InterpTower) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AddMeanAfterInterp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RefHeight) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RefLength) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Vel)) if (allocated(InData%Vel)) then call RegPackBounds(Buf, 4, lbound(InData%Vel), ubound(InData%Vel)) call RegPack(Buf, InData%Vel) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Acc)) if (allocated(InData%Acc)) then call RegPackBounds(Buf, 4, lbound(InData%Acc), ubound(InData%Acc)) call RegPack(Buf, InData%Acc) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%VelTower)) if (allocated(InData%VelTower)) then call RegPackBounds(Buf, 3, lbound(InData%VelTower), ubound(InData%VelTower)) call RegPack(Buf, InData%VelTower) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AccTower)) if (allocated(InData%AccTower)) then call RegPackBounds(Buf, 3, lbound(InData%AccTower), ubound(InData%AccTower)) call RegPack(Buf, InData%AccTower) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%VelAvg)) if (allocated(InData%VelAvg)) then call RegPackBounds(Buf, 3, lbound(InData%VelAvg), ubound(InData%VelAvg)) call RegPack(Buf, InData%VelAvg) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AccAvg)) if (allocated(InData%AccAvg)) then call RegPackBounds(Buf, 3, lbound(InData%AccAvg), ubound(InData%AccAvg)) call RegPack(Buf, InData%AccAvg) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DTime) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Rate) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YHWid) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ZHWid) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%GridBase) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%InitXPosition) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%InvDY) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%InvDZ) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MeanWS) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%InvMWS) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TotalTime) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NComp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NYGrids) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NZGrids) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NTGrids) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NSteps) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PLExp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Z0) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VLinShr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HLinShr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BoxExceedAllowF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BoxExceedAllowIdx) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BoxExceedWarned) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1431,11 +1358,8 @@ subroutine IfW_FlowField_PackGrid4DFieldType(Buf, Indata) logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%n) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%delta) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%pZero) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%Vel)) if (associated(InData%Vel)) then call RegPackBounds(Buf, 5, lbound(InData%Vel), ubound(InData%Vel)) @@ -1444,9 +1368,7 @@ subroutine IfW_FlowField_PackGrid4DFieldType(Buf, Indata) call RegPack(Buf, InData%Vel) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TimeStart) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RefHeight) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1666,31 +1588,18 @@ subroutine IfW_FlowField_PackFlowFieldType(Buf, Indata) character(*), parameter :: RoutineName = 'IfW_FlowField_PackFlowFieldType' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%FieldType) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RefPosition) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PropagationDir) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VFlowAngle) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VelInterpCubic) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RotateWindBox) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AccFieldValid) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RotToWind) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RotFromWind) - if (RegCheckErr(Buf, RoutineName)) return call IfW_FlowField_PackUniformFieldType(Buf, InData%Uniform) - if (RegCheckErr(Buf, RoutineName)) return call IfW_FlowField_PackGrid3DFieldType(Buf, InData%Grid3D) - if (RegCheckErr(Buf, RoutineName)) return call IfW_FlowField_PackGrid4DFieldType(Buf, InData%Grid4D) - if (RegCheckErr(Buf, RoutineName)) return call IfW_FlowField_PackPointsFieldType(Buf, InData%Points) - if (RegCheckErr(Buf, RoutineName)) return call IfW_FlowField_PackUserFieldType(Buf, InData%User) if (RegCheckErr(Buf, RoutineName)) return end subroutine diff --git a/modules/inflowwind/src/InflowWind_IO_Types.f90 b/modules/inflowwind/src/InflowWind_IO_Types.f90 index 4c6c3b59b0..d1ef0bfb76 100644 --- a/modules/inflowwind/src/InflowWind_IO_Types.f90 +++ b/modules/inflowwind/src/InflowWind_IO_Types.f90 @@ -186,39 +186,22 @@ subroutine InflowWind_IO_PackWindFileDat(Buf, Indata) character(*), parameter :: RoutineName = 'InflowWind_IO_PackWindFileDat' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%FileName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WindType) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RefHt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RefHt_Set) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumTSteps) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ConstantDT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TRange) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TRange_Limited) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YRange) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YRange_Limited) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ZRange) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ZRange_Limited) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BinaryFormat) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%IsBinary) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TI) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TI_listed) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MWS) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -295,9 +278,7 @@ subroutine InflowWind_IO_PackSteady_InitInputType(Buf, Indata) character(*), parameter :: RoutineName = 'InflowWind_IO_PackSteady_InitInputType' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%HWindSpeed) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RefHt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PLExp) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -353,15 +334,10 @@ subroutine InflowWind_IO_PackUniform_InitInputType(Buf, Indata) character(*), parameter :: RoutineName = 'InflowWind_IO_PackUniform_InitInputType' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%WindFileName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RefHt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RefLength) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PropagationDir) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UseInputFile) - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackFileInfoType(Buf, InData%PassedFileData) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -422,27 +398,16 @@ subroutine InflowWind_IO_PackGrid3D_InitInputType(Buf, Indata) character(*), parameter :: RoutineName = 'InflowWind_IO_PackGrid3D_InitInputType' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%ScaleMethod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SigmaF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WindProfileType) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RefHt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%URef) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PLExp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VLinShr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HLinShr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RefLength) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Z0) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%XOffset) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -549,15 +514,10 @@ subroutine InflowWind_IO_PackBladed_InitInputType(Buf, Indata) character(*), parameter :: RoutineName = 'InflowWind_IO_PackBladed_InitInputType' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%WindFileName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WindType) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NativeBladedFmt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TowerFileExist) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TurbineID) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FixedWindFileRootName) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -609,7 +569,6 @@ subroutine InflowWind_IO_PackBladed_InitOutputType(Buf, Indata) character(*), parameter :: RoutineName = 'InflowWind_IO_PackBladed_InitOutputType' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%PropagationDir) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VFlowAngle) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -665,19 +624,12 @@ subroutine InflowWind_IO_PackHAWC_InitInputType(Buf, Indata) character(*), parameter :: RoutineName = 'InflowWind_IO_PackHAWC_InitInputType' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%WindFileName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nx) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ny) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nz) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dx) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dy) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dz) - if (RegCheckErr(Buf, RoutineName)) return call InflowWind_IO_PackGrid3D_InitInputType(Buf, InData%G3D) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -777,11 +729,8 @@ subroutine InflowWind_IO_PackGrid4D_InitInputType(Buf, Indata) logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%n) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%delta) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%pZero) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%Vel)) if (associated(InData%Vel)) then call RegPackBounds(Buf, 5, lbound(InData%Vel), ubound(InData%Vel)) diff --git a/modules/inflowwind/src/InflowWind_Types.f90 b/modules/inflowwind/src/InflowWind_Types.f90 index 06955f09bd..9e0c3ef797 100644 --- a/modules/inflowwind/src/InflowWind_Types.f90 +++ b/modules/inflowwind/src/InflowWind_Types.f90 @@ -394,123 +394,78 @@ subroutine InflowWind_PackInputFile(Buf, Indata) character(*), parameter :: RoutineName = 'InflowWind_PackInputFile' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%EchoFlag) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WindType) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PropagationDir) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VFlowAngle) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VelInterpCubic) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NWindVel) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WindVxiList)) if (allocated(InData%WindVxiList)) then call RegPackBounds(Buf, 1, lbound(InData%WindVxiList), ubound(InData%WindVxiList)) call RegPack(Buf, InData%WindVxiList) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WindVyiList)) if (allocated(InData%WindVyiList)) then call RegPackBounds(Buf, 1, lbound(InData%WindVyiList), ubound(InData%WindVyiList)) call RegPack(Buf, InData%WindVyiList) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WindVziList)) if (allocated(InData%WindVziList)) then call RegPackBounds(Buf, 1, lbound(InData%WindVziList), ubound(InData%WindVziList)) call RegPack(Buf, InData%WindVziList) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Steady_HWindSpeed) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Steady_RefHt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Steady_PLexp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Uniform_FileName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Uniform_RefHt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Uniform_RefLength) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TSFF_FileName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BladedFF_FileName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BladedFF_TowerFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CTTS_CoherentTurb) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CTTS_FileName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CTTS_Path) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HAWC_FileName_u) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HAWC_FileName_v) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HAWC_FileName_w) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HAWC_nx) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HAWC_ny) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HAWC_nz) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HAWC_dx) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HAWC_dy) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HAWC_dz) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SumPrint) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OutList)) if (allocated(InData%OutList)) then call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) call RegPack(Buf, InData%OutList) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SensorType) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumBeam) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumPulseGate) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RotorApexOffsetPos) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FocalDistanceX)) if (allocated(InData%FocalDistanceX)) then call RegPackBounds(Buf, 1, lbound(InData%FocalDistanceX), ubound(InData%FocalDistanceX)) call RegPack(Buf, InData%FocalDistanceX) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FocalDistanceY)) if (allocated(InData%FocalDistanceY)) then call RegPackBounds(Buf, 1, lbound(InData%FocalDistanceY), ubound(InData%FocalDistanceY)) call RegPack(Buf, InData%FocalDistanceY) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FocalDistanceZ)) if (allocated(InData%FocalDistanceZ)) then call RegPackBounds(Buf, 1, lbound(InData%FocalDistanceZ), ubound(InData%FocalDistanceZ)) call RegPack(Buf, InData%FocalDistanceZ) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PulseSpacing) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MeasurementInterval) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%URefLid) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LidRadialVel) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ConsiderHubMotion) - if (RegCheckErr(Buf, RoutineName)) return call InflowWind_IO_PackGrid3D_InitInputType(Buf, InData%FF) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -758,43 +713,24 @@ subroutine InflowWind_PackInitInput(Buf, Indata) character(*), parameter :: RoutineName = 'InflowWind_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%InputFileName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Linearize) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Use4Dext) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumWindPoints) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TurbineID) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FixedWindFileRootName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UseInputFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RootName) - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackFileInfoType(Buf, InData%PassedFileData) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WindType2UseInputFile) - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackFileInfoType(Buf, InData%WindType2Data) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutputAccel) - if (RegCheckErr(Buf, RoutineName)) return call Lidar_PackInitInput(Buf, InData%lidar) - if (RegCheckErr(Buf, RoutineName)) return call InflowWind_IO_PackGrid4D_InitInputType(Buf, InData%FDext) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RadAvg) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MHK) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WtrDpth) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MSL2SWL) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BoxExceedAllowIdx) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BoxExceedAllowF) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1005,47 +941,38 @@ subroutine InflowWind_PackInitOutput(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) call RegPack(Buf, InData%WriteOutputHdr) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) call RegPack(Buf, InData%WriteOutputUnt) end if - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackProgDesc(Buf, InData%Ver) - if (RegCheckErr(Buf, RoutineName)) return call InflowWind_IO_PackWindFileDat(Buf, InData%WindFileInfo) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LinNames_y)) if (allocated(InData%LinNames_y)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) call RegPack(Buf, InData%LinNames_y) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LinNames_u)) if (allocated(InData%LinNames_u)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) call RegPack(Buf, InData%LinNames_u) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RotFrame_y)) if (allocated(InData%RotFrame_y)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y), ubound(InData%RotFrame_y)) call RegPack(Buf, InData%RotFrame_y) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RotFrame_u)) if (allocated(InData%RotFrame_u)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u), ubound(InData%RotFrame_u)) call RegPack(Buf, InData%RotFrame_u) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%IsLoad_u)) if (allocated(InData%IsLoad_u)) then call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) call RegPack(Buf, InData%IsLoad_u) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%FlowField)) if (associated(InData%FlowField)) then call RegPackPointer(Buf, c_loc(InData%FlowField), PtrInIndex) @@ -1244,6 +1171,7 @@ subroutine InflowWind_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, E if (ErrStat >= AbortErrLev) return else if (associated(DstParamData%FlowField)) then deallocate(DstParamData%FlowField) + nullify(DstParamData%FlowField) end if if (allocated(SrcParamData%PositionAvg)) then LB(1:2) = lbound(SrcParamData%PositionAvg) @@ -1348,21 +1276,17 @@ subroutine InflowWind_PackParam(Buf, Indata) logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%RootFileName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WindViXYZprime)) if (allocated(InData%WindViXYZprime)) then call RegPackBounds(Buf, 2, lbound(InData%WindViXYZprime), ubound(InData%WindViXYZprime)) call RegPack(Buf, InData%WindViXYZprime) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WindViXYZ)) if (allocated(InData%WindViXYZ)) then call RegPackBounds(Buf, 2, lbound(InData%WindViXYZ), ubound(InData%WindViXYZ)) call RegPack(Buf, InData%WindViXYZ) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%FlowField)) if (associated(InData%FlowField)) then call RegPackPointer(Buf, c_loc(InData%FlowField), PtrInIndex) @@ -1370,17 +1294,13 @@ subroutine InflowWind_PackParam(Buf, Indata) call IfW_FlowField_PackFlowFieldType(Buf, InData%FlowField) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PositionAvg)) if (allocated(InData%PositionAvg)) then call RegPackBounds(Buf, 2, lbound(InData%PositionAvg), ubound(InData%PositionAvg)) call RegPack(Buf, InData%PositionAvg) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NWindVel) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) @@ -1390,15 +1310,12 @@ subroutine InflowWind_PackParam(Buf, Indata) call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OutParamLinIndx)) if (allocated(InData%OutParamLinIndx)) then call RegPackBounds(Buf, 2, lbound(InData%OutParamLinIndx), ubound(InData%OutParamLinIndx)) call RegPack(Buf, InData%OutParamLinIndx) end if - if (RegCheckErr(Buf, RoutineName)) return call Lidar_PackParam(Buf, InData%lidar) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutputAccel) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1575,11 +1492,8 @@ subroutine InflowWind_PackInput(Buf, Indata) call RegPackBounds(Buf, 2, lbound(InData%PositionXYZ), ubound(InData%PositionXYZ)) call RegPack(Buf, InData%PositionXYZ) end if - if (RegCheckErr(Buf, RoutineName)) return call Lidar_PackInput(Buf, InData%lidar) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HubPosition) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HubOrientation) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1704,23 +1618,18 @@ subroutine InflowWind_PackOutput(Buf, Indata) call RegPackBounds(Buf, 2, lbound(InData%VelocityUVW), ubound(InData%VelocityUVW)) call RegPack(Buf, InData%VelocityUVW) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AccelUVW)) if (allocated(InData%AccelUVW)) then call RegPackBounds(Buf, 2, lbound(InData%AccelUVW), ubound(InData%AccelUVW)) call RegPack(Buf, InData%AccelUVW) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) call RegPack(Buf, InData%WriteOutput) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DiskVel) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HubVel) - if (RegCheckErr(Buf, RoutineName)) return call Lidar_PackOutput(Buf, InData%lidar) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2036,25 +1945,19 @@ subroutine InflowWind_PackMisc(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%AllOuts), ubound(InData%AllOuts)) call RegPack(Buf, InData%AllOuts) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WindViUVW)) if (allocated(InData%WindViUVW)) then call RegPackBounds(Buf, 2, lbound(InData%WindViUVW), ubound(InData%WindViUVW)) call RegPack(Buf, InData%WindViUVW) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WindAiUVW)) if (allocated(InData%WindAiUVW)) then call RegPackBounds(Buf, 2, lbound(InData%WindAiUVW), ubound(InData%WindAiUVW)) call RegPack(Buf, InData%WindAiUVW) end if - if (RegCheckErr(Buf, RoutineName)) return call InflowWind_PackInput(Buf, InData%u_Avg) - if (RegCheckErr(Buf, RoutineName)) return call InflowWind_PackOutput(Buf, InData%y_Avg) - if (RegCheckErr(Buf, RoutineName)) return call InflowWind_PackInput(Buf, InData%u_Hub) - if (RegCheckErr(Buf, RoutineName)) return call InflowWind_PackOutput(Buf, InData%y_Hub) if (RegCheckErr(Buf, RoutineName)) return end subroutine diff --git a/modules/inflowwind/src/Lidar_Types.f90 b/modules/inflowwind/src/Lidar_Types.f90 index 06c8aaeca1..96e114030e 100644 --- a/modules/inflowwind/src/Lidar_Types.f90 +++ b/modules/inflowwind/src/Lidar_Types.f90 @@ -157,15 +157,10 @@ subroutine Lidar_PackInitInput(Buf, Indata) character(*), parameter :: RoutineName = 'Lidar_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%SensorType) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Tmax) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RotorApexOffsetPos) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HubPosition) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumPulseGate) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LidRadialVel) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -344,67 +339,44 @@ subroutine Lidar_PackParam(Buf, Indata) character(*), parameter :: RoutineName = 'Lidar_PackParam' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%NumPulseGate) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RotorApexOffsetPos) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RayRangeSq) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SpatialRes) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SensorType) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WtFnTrunc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PulseRangeOne) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DeltaP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DeltaR) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%r_p) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LidRadialVel) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DisplacementLidarX) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DisplacementLidarY) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DisplacementLidarZ) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumBeam) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FocalDistanceX)) if (allocated(InData%FocalDistanceX)) then call RegPackBounds(Buf, 1, lbound(InData%FocalDistanceX), ubound(InData%FocalDistanceX)) call RegPack(Buf, InData%FocalDistanceX) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FocalDistanceY)) if (allocated(InData%FocalDistanceY)) then call RegPackBounds(Buf, 1, lbound(InData%FocalDistanceY), ubound(InData%FocalDistanceY)) call RegPack(Buf, InData%FocalDistanceY) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FocalDistanceZ)) if (allocated(InData%FocalDistanceZ)) then call RegPackBounds(Buf, 1, lbound(InData%FocalDistanceZ), ubound(InData%FocalDistanceZ)) call RegPack(Buf, InData%FocalDistanceZ) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%MsrPosition)) if (allocated(InData%MsrPosition)) then call RegPackBounds(Buf, 2, lbound(InData%MsrPosition), ubound(InData%MsrPosition)) call RegPack(Buf, InData%MsrPosition) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PulseSpacing) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%URefLid) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ConsiderHubMotion) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MeasurementInterval) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LidPosition) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -741,13 +713,9 @@ subroutine Lidar_PackInput(Buf, Indata) character(*), parameter :: RoutineName = 'Lidar_PackInput' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%PulseLidEl) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PulseLidAz) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HubDisplacementX) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HubDisplacementY) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HubDisplacementZ) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -886,25 +854,21 @@ subroutine Lidar_PackOutput(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%LidSpeed), ubound(InData%LidSpeed)) call RegPack(Buf, InData%LidSpeed) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WtTrunc)) if (allocated(InData%WtTrunc)) then call RegPackBounds(Buf, 1, lbound(InData%WtTrunc), ubound(InData%WtTrunc)) call RegPack(Buf, InData%WtTrunc) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%MsrPositionsX)) if (allocated(InData%MsrPositionsX)) then call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsX), ubound(InData%MsrPositionsX)) call RegPack(Buf, InData%MsrPositionsX) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%MsrPositionsY)) if (allocated(InData%MsrPositionsY)) then call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsY), ubound(InData%MsrPositionsY)) call RegPack(Buf, InData%MsrPositionsY) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%MsrPositionsZ)) if (allocated(InData%MsrPositionsZ)) then call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsZ), ubound(InData%MsrPositionsZ)) diff --git a/modules/map/src/MAP_Fortran_Types.f90 b/modules/map/src/MAP_Fortran_Types.f90 index 63697c7a7d..3c0d5f55f6 100644 --- a/modules/map/src/MAP_Fortran_Types.f90 +++ b/modules/map/src/MAP_Fortran_Types.f90 @@ -176,13 +176,11 @@ subroutine MAP_Fortran_PackLin_InitOutputType(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) call RegPack(Buf, InData%LinNames_y) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LinNames_u)) if (allocated(InData%LinNames_u)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) call RegPack(Buf, InData%LinNames_u) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%IsLoad_u)) if (allocated(InData%IsLoad_u)) then call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) @@ -294,9 +292,7 @@ subroutine MAP_Fortran_PackLin_ParamType(Buf, Indata) call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx), ubound(InData%Jac_u_indx)) call RegPack(Buf, InData%Jac_u_indx) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%du) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Jac_ny) if (RegCheckErr(Buf, RoutineName)) return end subroutine diff --git a/modules/map/src/MAP_Types.f90 b/modules/map/src/MAP_Types.f90 index 0d12ba647c..8cfa9b0a2a 100644 --- a/modules/map/src/MAP_Types.f90 +++ b/modules/map/src/MAP_Types.f90 @@ -302,23 +302,14 @@ subroutine MAP_PackInitInput(Buf, Indata) return end if call RegPack(Buf, InData%gravity) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%sea_density) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%depth) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%file_name) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%summary_file_name) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%library_input_str) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%node_input_str) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%line_input_str) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%option_input_str) - if (RegCheckErr(Buf, RoutineName)) return call MAP_Fortran_PackLin_InitInputType(Buf, InData%LinInitInp) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -491,25 +482,19 @@ subroutine MAP_PackInitOutput(Buf, Indata) return end if call RegPack(Buf, InData%progName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%version) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%compilingData) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%writeOutputHdr)) if (allocated(InData%writeOutputHdr)) then call RegPackBounds(Buf, 1, lbound(InData%writeOutputHdr), ubound(InData%writeOutputHdr)) call RegPack(Buf, InData%writeOutputHdr) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%writeOutputUnt)) if (allocated(InData%writeOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%writeOutputUnt), ubound(InData%writeOutputUnt)) call RegPack(Buf, InData%writeOutputUnt) end if - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackProgDesc(Buf, InData%Ver) - if (RegCheckErr(Buf, RoutineName)) return call MAP_Fortran_PackLin_InitOutputType(Buf, InData%LinInitOut) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -792,6 +777,7 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%H = SrcOtherStateData%H else if (associated(DstOtherStateData%H)) then deallocate(DstOtherStateData%H) + nullify(DstOtherStateData%H) end if if (associated(SrcOtherStateData%V)) then LB(1:1) = lbound(SrcOtherStateData%V) @@ -809,6 +795,7 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%V = SrcOtherStateData%V else if (associated(DstOtherStateData%V)) then deallocate(DstOtherStateData%V) + nullify(DstOtherStateData%V) end if if (associated(SrcOtherStateData%Ha)) then LB(1:1) = lbound(SrcOtherStateData%Ha) @@ -826,6 +813,7 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%Ha = SrcOtherStateData%Ha else if (associated(DstOtherStateData%Ha)) then deallocate(DstOtherStateData%Ha) + nullify(DstOtherStateData%Ha) end if if (associated(SrcOtherStateData%Va)) then LB(1:1) = lbound(SrcOtherStateData%Va) @@ -843,6 +831,7 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%Va = SrcOtherStateData%Va else if (associated(DstOtherStateData%Va)) then deallocate(DstOtherStateData%Va) + nullify(DstOtherStateData%Va) end if if (associated(SrcOtherStateData%x)) then LB(1:1) = lbound(SrcOtherStateData%x) @@ -860,6 +849,7 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%x = SrcOtherStateData%x else if (associated(DstOtherStateData%x)) then deallocate(DstOtherStateData%x) + nullify(DstOtherStateData%x) end if if (associated(SrcOtherStateData%y)) then LB(1:1) = lbound(SrcOtherStateData%y) @@ -877,6 +867,7 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%y = SrcOtherStateData%y else if (associated(DstOtherStateData%y)) then deallocate(DstOtherStateData%y) + nullify(DstOtherStateData%y) end if if (associated(SrcOtherStateData%z)) then LB(1:1) = lbound(SrcOtherStateData%z) @@ -894,6 +885,7 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%z = SrcOtherStateData%z else if (associated(DstOtherStateData%z)) then deallocate(DstOtherStateData%z) + nullify(DstOtherStateData%z) end if if (associated(SrcOtherStateData%xa)) then LB(1:1) = lbound(SrcOtherStateData%xa) @@ -911,6 +903,7 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%xa = SrcOtherStateData%xa else if (associated(DstOtherStateData%xa)) then deallocate(DstOtherStateData%xa) + nullify(DstOtherStateData%xa) end if if (associated(SrcOtherStateData%ya)) then LB(1:1) = lbound(SrcOtherStateData%ya) @@ -928,6 +921,7 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%ya = SrcOtherStateData%ya else if (associated(DstOtherStateData%ya)) then deallocate(DstOtherStateData%ya) + nullify(DstOtherStateData%ya) end if if (associated(SrcOtherStateData%za)) then LB(1:1) = lbound(SrcOtherStateData%za) @@ -945,6 +939,7 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%za = SrcOtherStateData%za else if (associated(DstOtherStateData%za)) then deallocate(DstOtherStateData%za) + nullify(DstOtherStateData%za) end if if (associated(SrcOtherStateData%Fx_connect)) then LB(1:1) = lbound(SrcOtherStateData%Fx_connect) @@ -962,6 +957,7 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%Fx_connect = SrcOtherStateData%Fx_connect else if (associated(DstOtherStateData%Fx_connect)) then deallocate(DstOtherStateData%Fx_connect) + nullify(DstOtherStateData%Fx_connect) end if if (associated(SrcOtherStateData%Fy_connect)) then LB(1:1) = lbound(SrcOtherStateData%Fy_connect) @@ -979,6 +975,7 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%Fy_connect = SrcOtherStateData%Fy_connect else if (associated(DstOtherStateData%Fy_connect)) then deallocate(DstOtherStateData%Fy_connect) + nullify(DstOtherStateData%Fy_connect) end if if (associated(SrcOtherStateData%Fz_connect)) then LB(1:1) = lbound(SrcOtherStateData%Fz_connect) @@ -996,6 +993,7 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%Fz_connect = SrcOtherStateData%Fz_connect else if (associated(DstOtherStateData%Fz_connect)) then deallocate(DstOtherStateData%Fz_connect) + nullify(DstOtherStateData%Fz_connect) end if if (associated(SrcOtherStateData%Fx_anchor)) then LB(1:1) = lbound(SrcOtherStateData%Fx_anchor) @@ -1013,6 +1011,7 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%Fx_anchor = SrcOtherStateData%Fx_anchor else if (associated(DstOtherStateData%Fx_anchor)) then deallocate(DstOtherStateData%Fx_anchor) + nullify(DstOtherStateData%Fx_anchor) end if if (associated(SrcOtherStateData%Fy_anchor)) then LB(1:1) = lbound(SrcOtherStateData%Fy_anchor) @@ -1030,6 +1029,7 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%Fy_anchor = SrcOtherStateData%Fy_anchor else if (associated(DstOtherStateData%Fy_anchor)) then deallocate(DstOtherStateData%Fy_anchor) + nullify(DstOtherStateData%Fy_anchor) end if if (associated(SrcOtherStateData%Fz_anchor)) then LB(1:1) = lbound(SrcOtherStateData%Fz_anchor) @@ -1047,6 +1047,7 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%Fz_anchor = SrcOtherStateData%Fz_anchor else if (associated(DstOtherStateData%Fz_anchor)) then deallocate(DstOtherStateData%Fz_anchor) + nullify(DstOtherStateData%Fz_anchor) end if end subroutine @@ -1173,7 +1174,6 @@ subroutine MAP_PackOtherState(Buf, Indata) call RegPack(Buf, InData%H) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%V)) if (associated(InData%V)) then call RegPackBounds(Buf, 1, lbound(InData%V), ubound(InData%V)) @@ -1182,7 +1182,6 @@ subroutine MAP_PackOtherState(Buf, Indata) call RegPack(Buf, InData%V) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%Ha)) if (associated(InData%Ha)) then call RegPackBounds(Buf, 1, lbound(InData%Ha), ubound(InData%Ha)) @@ -1191,7 +1190,6 @@ subroutine MAP_PackOtherState(Buf, Indata) call RegPack(Buf, InData%Ha) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%Va)) if (associated(InData%Va)) then call RegPackBounds(Buf, 1, lbound(InData%Va), ubound(InData%Va)) @@ -1200,7 +1198,6 @@ subroutine MAP_PackOtherState(Buf, Indata) call RegPack(Buf, InData%Va) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%x)) if (associated(InData%x)) then call RegPackBounds(Buf, 1, lbound(InData%x), ubound(InData%x)) @@ -1209,7 +1206,6 @@ subroutine MAP_PackOtherState(Buf, Indata) call RegPack(Buf, InData%x) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%y)) if (associated(InData%y)) then call RegPackBounds(Buf, 1, lbound(InData%y), ubound(InData%y)) @@ -1218,7 +1214,6 @@ subroutine MAP_PackOtherState(Buf, Indata) call RegPack(Buf, InData%y) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%z)) if (associated(InData%z)) then call RegPackBounds(Buf, 1, lbound(InData%z), ubound(InData%z)) @@ -1227,7 +1222,6 @@ subroutine MAP_PackOtherState(Buf, Indata) call RegPack(Buf, InData%z) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%xa)) if (associated(InData%xa)) then call RegPackBounds(Buf, 1, lbound(InData%xa), ubound(InData%xa)) @@ -1236,7 +1230,6 @@ subroutine MAP_PackOtherState(Buf, Indata) call RegPack(Buf, InData%xa) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%ya)) if (associated(InData%ya)) then call RegPackBounds(Buf, 1, lbound(InData%ya), ubound(InData%ya)) @@ -1245,7 +1238,6 @@ subroutine MAP_PackOtherState(Buf, Indata) call RegPack(Buf, InData%ya) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%za)) if (associated(InData%za)) then call RegPackBounds(Buf, 1, lbound(InData%za), ubound(InData%za)) @@ -1254,7 +1246,6 @@ subroutine MAP_PackOtherState(Buf, Indata) call RegPack(Buf, InData%za) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%Fx_connect)) if (associated(InData%Fx_connect)) then call RegPackBounds(Buf, 1, lbound(InData%Fx_connect), ubound(InData%Fx_connect)) @@ -1263,7 +1254,6 @@ subroutine MAP_PackOtherState(Buf, Indata) call RegPack(Buf, InData%Fx_connect) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%Fy_connect)) if (associated(InData%Fy_connect)) then call RegPackBounds(Buf, 1, lbound(InData%Fy_connect), ubound(InData%Fy_connect)) @@ -1272,7 +1262,6 @@ subroutine MAP_PackOtherState(Buf, Indata) call RegPack(Buf, InData%Fy_connect) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%Fz_connect)) if (associated(InData%Fz_connect)) then call RegPackBounds(Buf, 1, lbound(InData%Fz_connect), ubound(InData%Fz_connect)) @@ -1281,7 +1270,6 @@ subroutine MAP_PackOtherState(Buf, Indata) call RegPack(Buf, InData%Fz_connect) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%Fx_anchor)) if (associated(InData%Fx_anchor)) then call RegPackBounds(Buf, 1, lbound(InData%Fx_anchor), ubound(InData%Fx_anchor)) @@ -1290,7 +1278,6 @@ subroutine MAP_PackOtherState(Buf, Indata) call RegPack(Buf, InData%Fx_anchor) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%Fy_anchor)) if (associated(InData%Fy_anchor)) then call RegPackBounds(Buf, 1, lbound(InData%Fy_anchor), ubound(InData%Fy_anchor)) @@ -1299,7 +1286,6 @@ subroutine MAP_PackOtherState(Buf, Indata) call RegPack(Buf, InData%Fy_anchor) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%Fz_anchor)) if (associated(InData%Fz_anchor)) then call RegPackBounds(Buf, 1, lbound(InData%Fz_anchor), ubound(InData%Fz_anchor)) @@ -2136,6 +2122,7 @@ subroutine MAP_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, DstConstrStateData%H = SrcConstrStateData%H else if (associated(DstConstrStateData%H)) then deallocate(DstConstrStateData%H) + nullify(DstConstrStateData%H) end if if (associated(SrcConstrStateData%V)) then LB(1:1) = lbound(SrcConstrStateData%V) @@ -2153,6 +2140,7 @@ subroutine MAP_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, DstConstrStateData%V = SrcConstrStateData%V else if (associated(DstConstrStateData%V)) then deallocate(DstConstrStateData%V) + nullify(DstConstrStateData%V) end if if (associated(SrcConstrStateData%x)) then LB(1:1) = lbound(SrcConstrStateData%x) @@ -2170,6 +2158,7 @@ subroutine MAP_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, DstConstrStateData%x = SrcConstrStateData%x else if (associated(DstConstrStateData%x)) then deallocate(DstConstrStateData%x) + nullify(DstConstrStateData%x) end if if (associated(SrcConstrStateData%y)) then LB(1:1) = lbound(SrcConstrStateData%y) @@ -2187,6 +2176,7 @@ subroutine MAP_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, DstConstrStateData%y = SrcConstrStateData%y else if (associated(DstConstrStateData%y)) then deallocate(DstConstrStateData%y) + nullify(DstConstrStateData%y) end if if (associated(SrcConstrStateData%z)) then LB(1:1) = lbound(SrcConstrStateData%z) @@ -2204,6 +2194,7 @@ subroutine MAP_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, DstConstrStateData%z = SrcConstrStateData%z else if (associated(DstConstrStateData%z)) then deallocate(DstConstrStateData%z) + nullify(DstConstrStateData%z) end if end subroutine @@ -2264,7 +2255,6 @@ subroutine MAP_PackConstrState(Buf, Indata) call RegPack(Buf, InData%H) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%V)) if (associated(InData%V)) then call RegPackBounds(Buf, 1, lbound(InData%V), ubound(InData%V)) @@ -2273,7 +2263,6 @@ subroutine MAP_PackConstrState(Buf, Indata) call RegPack(Buf, InData%V) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%x)) if (associated(InData%x)) then call RegPackBounds(Buf, 1, lbound(InData%x), ubound(InData%x)) @@ -2282,7 +2271,6 @@ subroutine MAP_PackConstrState(Buf, Indata) call RegPack(Buf, InData%x) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%y)) if (associated(InData%y)) then call RegPackBounds(Buf, 1, lbound(InData%y), ubound(InData%y)) @@ -2291,7 +2279,6 @@ subroutine MAP_PackConstrState(Buf, Indata) call RegPack(Buf, InData%y) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%z)) if (associated(InData%z)) then call RegPackBounds(Buf, 1, lbound(InData%z), ubound(InData%z)) @@ -2633,19 +2620,12 @@ subroutine MAP_PackParam(Buf, Indata) return end if call RegPack(Buf, InData%g) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%depth) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rho_sea) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%InputLines) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%InputLineType) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%numOuts) - if (RegCheckErr(Buf, RoutineName)) return call MAP_Fortran_PackLin_ParamType(Buf, InData%LinParams) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2749,6 +2729,7 @@ subroutine MAP_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%x = SrcInputData%x else if (associated(DstInputData%x)) then deallocate(DstInputData%x) + nullify(DstInputData%x) end if if (associated(SrcInputData%y)) then LB(1:1) = lbound(SrcInputData%y) @@ -2766,6 +2747,7 @@ subroutine MAP_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%y = SrcInputData%y else if (associated(DstInputData%y)) then deallocate(DstInputData%y) + nullify(DstInputData%y) end if if (associated(SrcInputData%z)) then LB(1:1) = lbound(SrcInputData%z) @@ -2783,6 +2765,7 @@ subroutine MAP_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%z = SrcInputData%z else if (associated(DstInputData%z)) then deallocate(DstInputData%z) + nullify(DstInputData%z) end if call MeshCopy(SrcInputData%PtFairDisplacement, DstInputData%PtFairDisplacement, CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2836,7 +2819,6 @@ subroutine MAP_PackInput(Buf, Indata) call RegPack(Buf, InData%x) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%y)) if (associated(InData%y)) then call RegPackBounds(Buf, 1, lbound(InData%y), ubound(InData%y)) @@ -2845,7 +2827,6 @@ subroutine MAP_PackInput(Buf, Indata) call RegPack(Buf, InData%y) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%z)) if (associated(InData%z)) then call RegPackBounds(Buf, 1, lbound(InData%z), ubound(InData%z)) @@ -2854,7 +2835,6 @@ subroutine MAP_PackInput(Buf, Indata) call RegPack(Buf, InData%z) end if end if - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%PtFairDisplacement) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3075,6 +3055,7 @@ subroutine MAP_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs DstOutputData%Fx = SrcOutputData%Fx else if (associated(DstOutputData%Fx)) then deallocate(DstOutputData%Fx) + nullify(DstOutputData%Fx) end if if (associated(SrcOutputData%Fy)) then LB(1:1) = lbound(SrcOutputData%Fy) @@ -3092,6 +3073,7 @@ subroutine MAP_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs DstOutputData%Fy = SrcOutputData%Fy else if (associated(DstOutputData%Fy)) then deallocate(DstOutputData%Fy) + nullify(DstOutputData%Fy) end if if (associated(SrcOutputData%Fz)) then LB(1:1) = lbound(SrcOutputData%Fz) @@ -3109,6 +3091,7 @@ subroutine MAP_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs DstOutputData%Fz = SrcOutputData%Fz else if (associated(DstOutputData%Fz)) then deallocate(DstOutputData%Fz) + nullify(DstOutputData%Fz) end if if (allocated(SrcOutputData%WriteOutput)) then LB(1:1) = lbound(SrcOutputData%WriteOutput) @@ -3140,6 +3123,7 @@ subroutine MAP_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs DstOutputData%wrtOutput = SrcOutputData%wrtOutput else if (associated(DstOutputData%wrtOutput)) then deallocate(DstOutputData%wrtOutput) + nullify(DstOutputData%wrtOutput) end if call MeshCopy(SrcOutputData%ptFairleadLoad, DstOutputData%ptFairleadLoad, CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3202,7 +3186,6 @@ subroutine MAP_PackOutput(Buf, Indata) call RegPack(Buf, InData%Fx) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%Fy)) if (associated(InData%Fy)) then call RegPackBounds(Buf, 1, lbound(InData%Fy), ubound(InData%Fy)) @@ -3211,7 +3194,6 @@ subroutine MAP_PackOutput(Buf, Indata) call RegPack(Buf, InData%Fy) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%Fz)) if (associated(InData%Fz)) then call RegPackBounds(Buf, 1, lbound(InData%Fz), ubound(InData%Fz)) @@ -3220,13 +3202,11 @@ subroutine MAP_PackOutput(Buf, Indata) call RegPack(Buf, InData%Fz) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) call RegPack(Buf, InData%WriteOutput) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%wrtOutput)) if (associated(InData%wrtOutput)) then call RegPackBounds(Buf, 1, lbound(InData%wrtOutput), ubound(InData%wrtOutput)) @@ -3235,7 +3215,6 @@ subroutine MAP_PackOutput(Buf, Indata) call RegPack(Buf, InData%wrtOutput) end if end if - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%ptFairleadLoad) if (RegCheckErr(Buf, RoutineName)) return end subroutine diff --git a/modules/moordyn/src/MoorDyn_Types.f90 b/modules/moordyn/src/MoorDyn_Types.f90 index f5bce9d51a..36e408e60e 100644 --- a/modules/moordyn/src/MoorDyn_Types.f90 +++ b/modules/moordyn/src/MoorDyn_Types.f90 @@ -493,11 +493,8 @@ subroutine MD_PackInputFileType(Buf, Indata) character(*), parameter :: RoutineName = 'MD_PackInputFileType' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%DTIC) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TMaxIC) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CdScaleIC) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%threshIC) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -612,43 +609,30 @@ subroutine MD_PackInitInput(Buf, Indata) character(*), parameter :: RoutineName = 'MD_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%g) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rhoW) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WtrDepth) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PtfmInit)) if (allocated(InData%PtfmInit)) then call RegPackBounds(Buf, 2, lbound(InData%PtfmInit), ubound(InData%PtfmInit)) call RegPack(Buf, InData%PtfmInit) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FarmSize) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TurbineRefPos)) if (allocated(InData%TurbineRefPos)) then call RegPackBounds(Buf, 2, lbound(InData%TurbineRefPos), ubound(InData%TurbineRefPos)) call RegPack(Buf, InData%TurbineRefPos) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Tmax) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FileName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RootName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UsePrimaryInputFile) - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackFileInfoType(Buf, InData%PassedPrimaryInputData) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Echo) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OutList)) if (allocated(InData%OutList)) then call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) call RegPack(Buf, InData%OutList) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Linearize) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -775,49 +759,27 @@ subroutine MD_PackLineProp(Buf, Indata) character(*), parameter :: RoutineName = 'MD_PackLineProp' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%IdNum) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%name) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%d) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%w) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%EA) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%EA_D) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BA) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BA_D) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%EI) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Can) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Cat) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Cdn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Cdt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ElasticMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nEApoints) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%stiffXs) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%stiffYs) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nBApoints) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dampXs) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dampYs) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nEIpoints) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%bstiffXs) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%bstiffYs) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -911,23 +873,14 @@ subroutine MD_PackRodProp(Buf, Indata) character(*), parameter :: RoutineName = 'MD_PackRodProp' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%IdNum) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%name) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%d) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%w) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Can) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Cat) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Cdn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Cdt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CdEnd) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CaEnd) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1011,55 +964,30 @@ subroutine MD_PackBody(Buf, Indata) character(*), parameter :: RoutineName = 'MD_PackBody' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%IdNum) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%typeNum) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AttachedC) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AttachedR) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nAttachedC) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nAttachedR) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rConnectRel) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%r6RodRel) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%bodyM) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%bodyV) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%bodyI) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%bodyCdA) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%bodyCa) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%time) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%r6) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%v6) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%a6) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%U) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Ud) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%zeta) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%F6net) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%M6net) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%M) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%M0) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OrMat) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rCG) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1190,53 +1118,31 @@ subroutine MD_PackConnect(Buf, Indata) character(*), parameter :: RoutineName = 'MD_PackConnect' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%IdNum) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%type) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%typeNum) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Attached) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Top) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nAttached) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%conM) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%conV) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%conFX) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%conFY) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%conFZ) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%conCa) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%conCdA) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%time) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%r) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rd) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%a) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%U) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Ud) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%zeta) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PDyn)) if (allocated(InData%PDyn)) then call RegPackBounds(Buf, 1, lbound(InData%PDyn), ubound(InData%PDyn)) call RegPack(Buf, InData%PDyn) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Fnet) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%M) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1699,191 +1605,134 @@ subroutine MD_PackRod(Buf, Indata) character(*), parameter :: RoutineName = 'MD_PackRod' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%IdNum) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%type) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PropsIdNum) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%typeNum) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AttachedA) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AttachedB) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TopA) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TopB) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nAttachedA) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nAttachedB) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutFlagList) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%N) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%endTypeA) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%endTypeB) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UnstrLen) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%mass) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rho) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%d) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Can) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Cat) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Cdn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Cdt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CdEnd) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CaEnd) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%time) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%roll) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%pitch) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%h0) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%r)) if (allocated(InData%r)) then call RegPackBounds(Buf, 2, lbound(InData%r), ubound(InData%r)) call RegPack(Buf, InData%r) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%rd)) if (allocated(InData%rd)) then call RegPackBounds(Buf, 2, lbound(InData%rd), ubound(InData%rd)) call RegPack(Buf, InData%rd) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%q) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%l)) if (allocated(InData%l)) then call RegPackBounds(Buf, 1, lbound(InData%l), ubound(InData%l)) call RegPack(Buf, InData%l) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%V)) if (allocated(InData%V)) then call RegPackBounds(Buf, 1, lbound(InData%V), ubound(InData%V)) call RegPack(Buf, InData%V) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%U)) if (allocated(InData%U)) then call RegPackBounds(Buf, 2, lbound(InData%U), ubound(InData%U)) call RegPack(Buf, InData%U) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Ud)) if (allocated(InData%Ud)) then call RegPackBounds(Buf, 2, lbound(InData%Ud), ubound(InData%Ud)) call RegPack(Buf, InData%Ud) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%zeta)) if (allocated(InData%zeta)) then call RegPackBounds(Buf, 1, lbound(InData%zeta), ubound(InData%zeta)) call RegPack(Buf, InData%zeta) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PDyn)) if (allocated(InData%PDyn)) then call RegPackBounds(Buf, 1, lbound(InData%PDyn), ubound(InData%PDyn)) call RegPack(Buf, InData%PDyn) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%W)) if (allocated(InData%W)) then call RegPackBounds(Buf, 2, lbound(InData%W), ubound(InData%W)) call RegPack(Buf, InData%W) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Bo)) if (allocated(InData%Bo)) then call RegPackBounds(Buf, 2, lbound(InData%Bo), ubound(InData%Bo)) call RegPack(Buf, InData%Bo) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Pd)) if (allocated(InData%Pd)) then call RegPackBounds(Buf, 2, lbound(InData%Pd), ubound(InData%Pd)) call RegPack(Buf, InData%Pd) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Dp)) if (allocated(InData%Dp)) then call RegPackBounds(Buf, 2, lbound(InData%Dp), ubound(InData%Dp)) call RegPack(Buf, InData%Dp) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Dq)) if (allocated(InData%Dq)) then call RegPackBounds(Buf, 2, lbound(InData%Dq), ubound(InData%Dq)) call RegPack(Buf, InData%Dq) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Ap)) if (allocated(InData%Ap)) then call RegPackBounds(Buf, 2, lbound(InData%Ap), ubound(InData%Ap)) call RegPack(Buf, InData%Ap) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Aq)) if (allocated(InData%Aq)) then call RegPackBounds(Buf, 2, lbound(InData%Aq), ubound(InData%Aq)) call RegPack(Buf, InData%Aq) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%B)) if (allocated(InData%B)) then call RegPackBounds(Buf, 2, lbound(InData%B), ubound(InData%B)) call RegPack(Buf, InData%B) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Fnet)) if (allocated(InData%Fnet)) then call RegPackBounds(Buf, 2, lbound(InData%Fnet), ubound(InData%Fnet)) call RegPack(Buf, InData%Fnet) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%M)) if (allocated(InData%M)) then call RegPackBounds(Buf, 3, lbound(InData%M), ubound(InData%M)) call RegPack(Buf, InData%M) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FextA) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FextB) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Mext) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%r6) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%v6) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%a6) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%F6net) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%M6net) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OrMat) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RodUnOut) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RodWrOutput)) if (allocated(InData%RodWrOutput)) then call RegPackBounds(Buf, 1, lbound(InData%RodWrOutput), ubound(InData%RodWrOutput)) @@ -2785,237 +2634,175 @@ subroutine MD_PackLine(Buf, Indata) character(*), parameter :: RoutineName = 'MD_PackLine' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%IdNum) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PropsIdNum) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ElasticMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutFlagList) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CtrlChan) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FairConnect) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AnchConnect) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%N) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%endTypeA) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%endTypeB) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UnstrLen) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rho) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%d) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%EA) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%EA_D) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BA) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BA_D) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%EI) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Can) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Cat) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Cdn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Cdt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nEApoints) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%stiffXs) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%stiffYs) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nBApoints) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dampXs) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dampYs) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nEIpoints) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%bstiffXs) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%bstiffYs) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%time) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%r)) if (allocated(InData%r)) then call RegPackBounds(Buf, 2, lbound(InData%r), ubound(InData%r)) call RegPack(Buf, InData%r) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%rd)) if (allocated(InData%rd)) then call RegPackBounds(Buf, 2, lbound(InData%rd), ubound(InData%rd)) call RegPack(Buf, InData%rd) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%q)) if (allocated(InData%q)) then call RegPackBounds(Buf, 2, lbound(InData%q), ubound(InData%q)) call RegPack(Buf, InData%q) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%qs)) if (allocated(InData%qs)) then call RegPackBounds(Buf, 2, lbound(InData%qs), ubound(InData%qs)) call RegPack(Buf, InData%qs) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%l)) if (allocated(InData%l)) then call RegPackBounds(Buf, 1, lbound(InData%l), ubound(InData%l)) call RegPack(Buf, InData%l) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ld)) if (allocated(InData%ld)) then call RegPackBounds(Buf, 1, lbound(InData%ld), ubound(InData%ld)) call RegPack(Buf, InData%ld) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%lstr)) if (allocated(InData%lstr)) then call RegPackBounds(Buf, 1, lbound(InData%lstr), ubound(InData%lstr)) call RegPack(Buf, InData%lstr) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%lstrd)) if (allocated(InData%lstrd)) then call RegPackBounds(Buf, 1, lbound(InData%lstrd), ubound(InData%lstrd)) call RegPack(Buf, InData%lstrd) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Kurv)) if (allocated(InData%Kurv)) then call RegPackBounds(Buf, 1, lbound(InData%Kurv), ubound(InData%Kurv)) call RegPack(Buf, InData%Kurv) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%dl_1)) if (allocated(InData%dl_1)) then call RegPackBounds(Buf, 1, lbound(InData%dl_1), ubound(InData%dl_1)) call RegPack(Buf, InData%dl_1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%V)) if (allocated(InData%V)) then call RegPackBounds(Buf, 1, lbound(InData%V), ubound(InData%V)) call RegPack(Buf, InData%V) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%U)) if (allocated(InData%U)) then call RegPackBounds(Buf, 2, lbound(InData%U), ubound(InData%U)) call RegPack(Buf, InData%U) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Ud)) if (allocated(InData%Ud)) then call RegPackBounds(Buf, 2, lbound(InData%Ud), ubound(InData%Ud)) call RegPack(Buf, InData%Ud) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%zeta)) if (allocated(InData%zeta)) then call RegPackBounds(Buf, 1, lbound(InData%zeta), ubound(InData%zeta)) call RegPack(Buf, InData%zeta) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PDyn)) if (allocated(InData%PDyn)) then call RegPackBounds(Buf, 1, lbound(InData%PDyn), ubound(InData%PDyn)) call RegPack(Buf, InData%PDyn) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%T)) if (allocated(InData%T)) then call RegPackBounds(Buf, 2, lbound(InData%T), ubound(InData%T)) call RegPack(Buf, InData%T) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Td)) if (allocated(InData%Td)) then call RegPackBounds(Buf, 2, lbound(InData%Td), ubound(InData%Td)) call RegPack(Buf, InData%Td) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%W)) if (allocated(InData%W)) then call RegPackBounds(Buf, 2, lbound(InData%W), ubound(InData%W)) call RegPack(Buf, InData%W) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Dp)) if (allocated(InData%Dp)) then call RegPackBounds(Buf, 2, lbound(InData%Dp), ubound(InData%Dp)) call RegPack(Buf, InData%Dp) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Dq)) if (allocated(InData%Dq)) then call RegPackBounds(Buf, 2, lbound(InData%Dq), ubound(InData%Dq)) call RegPack(Buf, InData%Dq) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Ap)) if (allocated(InData%Ap)) then call RegPackBounds(Buf, 2, lbound(InData%Ap), ubound(InData%Ap)) call RegPack(Buf, InData%Ap) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Aq)) if (allocated(InData%Aq)) then call RegPackBounds(Buf, 2, lbound(InData%Aq), ubound(InData%Aq)) call RegPack(Buf, InData%Aq) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%B)) if (allocated(InData%B)) then call RegPackBounds(Buf, 2, lbound(InData%B), ubound(InData%B)) call RegPack(Buf, InData%B) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Bs)) if (allocated(InData%Bs)) then call RegPackBounds(Buf, 2, lbound(InData%Bs), ubound(InData%Bs)) call RegPack(Buf, InData%Bs) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Fnet)) if (allocated(InData%Fnet)) then call RegPackBounds(Buf, 2, lbound(InData%Fnet), ubound(InData%Fnet)) call RegPack(Buf, InData%Fnet) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%S)) if (allocated(InData%S)) then call RegPackBounds(Buf, 3, lbound(InData%S), ubound(InData%S)) call RegPack(Buf, InData%S) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%M)) if (allocated(InData%M)) then call RegPackBounds(Buf, 3, lbound(InData%M), ubound(InData%M)) call RegPack(Buf, InData%M) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%EndMomentA) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%EndMomentB) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LineUnOut) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LineWrOutput)) if (allocated(InData%LineWrOutput)) then call RegPackBounds(Buf, 1, lbound(InData%LineWrOutput), ubound(InData%LineWrOutput)) @@ -3567,15 +3354,10 @@ subroutine MD_PackOutParmType(Buf, Indata) character(*), parameter :: RoutineName = 'MD_PackOutParmType' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%Name) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Units) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%QType) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OType) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NodeID) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ObjID) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3824,63 +3606,52 @@ subroutine MD_PackInitOutput(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%writeOutputHdr), ubound(InData%writeOutputHdr)) call RegPack(Buf, InData%writeOutputHdr) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%writeOutputUnt)) if (allocated(InData%writeOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%writeOutputUnt), ubound(InData%writeOutputUnt)) call RegPack(Buf, InData%writeOutputUnt) end if - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackProgDesc(Buf, InData%Ver) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CableCChanRqst)) if (allocated(InData%CableCChanRqst)) then call RegPackBounds(Buf, 1, lbound(InData%CableCChanRqst), ubound(InData%CableCChanRqst)) call RegPack(Buf, InData%CableCChanRqst) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LinNames_y)) if (allocated(InData%LinNames_y)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) call RegPack(Buf, InData%LinNames_y) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LinNames_x)) if (allocated(InData%LinNames_x)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_x), ubound(InData%LinNames_x)) call RegPack(Buf, InData%LinNames_x) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LinNames_u)) if (allocated(InData%LinNames_u)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) call RegPack(Buf, InData%LinNames_u) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RotFrame_y)) if (allocated(InData%RotFrame_y)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y), ubound(InData%RotFrame_y)) call RegPack(Buf, InData%RotFrame_y) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RotFrame_x)) if (allocated(InData%RotFrame_x)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x), ubound(InData%RotFrame_x)) call RegPack(Buf, InData%RotFrame_x) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RotFrame_u)) if (allocated(InData%RotFrame_u)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u), ubound(InData%RotFrame_u)) call RegPack(Buf, InData%RotFrame_u) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%IsLoad_u)) if (allocated(InData%IsLoad_u)) then call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) call RegPack(Buf, InData%IsLoad_u) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%DerivOrder_x)) if (allocated(InData%DerivOrder_x)) then call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x), ubound(InData%DerivOrder_x)) @@ -4817,7 +4588,6 @@ subroutine MD_PackMisc(Buf, Indata) call MD_PackLineProp(Buf, InData%LineTypeList(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RodTypeList)) if (allocated(InData%RodTypeList)) then call RegPackBounds(Buf, 1, lbound(InData%RodTypeList), ubound(InData%RodTypeList)) @@ -4827,9 +4597,7 @@ subroutine MD_PackMisc(Buf, Indata) call MD_PackRodProp(Buf, InData%RodTypeList(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call MD_PackBody(Buf, InData%GroundBody) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BodyList)) if (allocated(InData%BodyList)) then call RegPackBounds(Buf, 1, lbound(InData%BodyList), ubound(InData%BodyList)) @@ -4839,7 +4607,6 @@ subroutine MD_PackMisc(Buf, Indata) call MD_PackBody(Buf, InData%BodyList(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RodList)) if (allocated(InData%RodList)) then call RegPackBounds(Buf, 1, lbound(InData%RodList), ubound(InData%RodList)) @@ -4849,7 +4616,6 @@ subroutine MD_PackMisc(Buf, Indata) call MD_PackRod(Buf, InData%RodList(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ConnectList)) if (allocated(InData%ConnectList)) then call RegPackBounds(Buf, 1, lbound(InData%ConnectList), ubound(InData%ConnectList)) @@ -4859,7 +4625,6 @@ subroutine MD_PackMisc(Buf, Indata) call MD_PackConnect(Buf, InData%ConnectList(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LineList)) if (allocated(InData%LineList)) then call RegPackBounds(Buf, 1, lbound(InData%LineList), ubound(InData%LineList)) @@ -4869,7 +4634,6 @@ subroutine MD_PackMisc(Buf, Indata) call MD_PackLine(Buf, InData%LineList(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FailList)) if (allocated(InData%FailList)) then call RegPackBounds(Buf, 1, lbound(InData%FailList), ubound(InData%FailList)) @@ -4879,129 +4643,103 @@ subroutine MD_PackMisc(Buf, Indata) call MD_PackFail(Buf, InData%FailList(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FreeConIs)) if (allocated(InData%FreeConIs)) then call RegPackBounds(Buf, 1, lbound(InData%FreeConIs), ubound(InData%FreeConIs)) call RegPack(Buf, InData%FreeConIs) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CpldConIs)) if (allocated(InData%CpldConIs)) then call RegPackBounds(Buf, 2, lbound(InData%CpldConIs), ubound(InData%CpldConIs)) call RegPack(Buf, InData%CpldConIs) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FreeRodIs)) if (allocated(InData%FreeRodIs)) then call RegPackBounds(Buf, 1, lbound(InData%FreeRodIs), ubound(InData%FreeRodIs)) call RegPack(Buf, InData%FreeRodIs) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CpldRodIs)) if (allocated(InData%CpldRodIs)) then call RegPackBounds(Buf, 2, lbound(InData%CpldRodIs), ubound(InData%CpldRodIs)) call RegPack(Buf, InData%CpldRodIs) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FreeBodyIs)) if (allocated(InData%FreeBodyIs)) then call RegPackBounds(Buf, 1, lbound(InData%FreeBodyIs), ubound(InData%FreeBodyIs)) call RegPack(Buf, InData%FreeBodyIs) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CpldBodyIs)) if (allocated(InData%CpldBodyIs)) then call RegPackBounds(Buf, 2, lbound(InData%CpldBodyIs), ubound(InData%CpldBodyIs)) call RegPack(Buf, InData%CpldBodyIs) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LineStateIs1)) if (allocated(InData%LineStateIs1)) then call RegPackBounds(Buf, 1, lbound(InData%LineStateIs1), ubound(InData%LineStateIs1)) call RegPack(Buf, InData%LineStateIs1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LineStateIsN)) if (allocated(InData%LineStateIsN)) then call RegPackBounds(Buf, 1, lbound(InData%LineStateIsN), ubound(InData%LineStateIsN)) call RegPack(Buf, InData%LineStateIsN) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ConStateIs1)) if (allocated(InData%ConStateIs1)) then call RegPackBounds(Buf, 1, lbound(InData%ConStateIs1), ubound(InData%ConStateIs1)) call RegPack(Buf, InData%ConStateIs1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ConStateIsN)) if (allocated(InData%ConStateIsN)) then call RegPackBounds(Buf, 1, lbound(InData%ConStateIsN), ubound(InData%ConStateIsN)) call RegPack(Buf, InData%ConStateIsN) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RodStateIs1)) if (allocated(InData%RodStateIs1)) then call RegPackBounds(Buf, 1, lbound(InData%RodStateIs1), ubound(InData%RodStateIs1)) call RegPack(Buf, InData%RodStateIs1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RodStateIsN)) if (allocated(InData%RodStateIsN)) then call RegPackBounds(Buf, 1, lbound(InData%RodStateIsN), ubound(InData%RodStateIsN)) call RegPack(Buf, InData%RodStateIsN) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BodyStateIs1)) if (allocated(InData%BodyStateIs1)) then call RegPackBounds(Buf, 1, lbound(InData%BodyStateIs1), ubound(InData%BodyStateIs1)) call RegPack(Buf, InData%BodyStateIs1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BodyStateIsN)) if (allocated(InData%BodyStateIsN)) then call RegPackBounds(Buf, 1, lbound(InData%BodyStateIsN), ubound(InData%BodyStateIsN)) call RegPack(Buf, InData%BodyStateIsN) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Nx) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveTi) - if (RegCheckErr(Buf, RoutineName)) return call MD_PackContState(Buf, InData%xTemp) - if (RegCheckErr(Buf, RoutineName)) return call MD_PackContState(Buf, InData%xdTemp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%zeros6) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%MDWrOutput)) if (allocated(InData%MDWrOutput)) then call RegPackBounds(Buf, 1, lbound(InData%MDWrOutput), ubound(InData%MDWrOutput)) call RegPack(Buf, InData%MDWrOutput) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LastOutTime) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PtfmInit) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BathymetryGrid)) if (allocated(InData%BathymetryGrid)) then call RegPackBounds(Buf, 2, lbound(InData%BathymetryGrid), ubound(InData%BathymetryGrid)) call RegPack(Buf, InData%BathymetryGrid) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BathGrid_Xs)) if (allocated(InData%BathGrid_Xs)) then call RegPackBounds(Buf, 1, lbound(InData%BathGrid_Xs), ubound(InData%BathGrid_Xs)) call RegPack(Buf, InData%BathGrid_Xs) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BathGrid_Ys)) if (allocated(InData%BathGrid_Ys)) then call RegPackBounds(Buf, 1, lbound(InData%BathGrid_Ys), ubound(InData%BathGrid_Ys)) call RegPack(Buf, InData%BathGrid_Ys) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BathGrid_npoints)) if (allocated(InData%BathGrid_npoints)) then call RegPackBounds(Buf, 1, lbound(InData%BathGrid_npoints), ubound(InData%BathGrid_npoints)) @@ -5888,73 +5626,45 @@ subroutine MD_PackParam(Buf, Indata) integer(IntKi) :: LB(4), UB(4) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%nLineTypes) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nRodTypes) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nConnects) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nConnectsExtra) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nBodies) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nRods) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nLines) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nCtrlChans) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nFails) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nFreeBodies) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nFreeRods) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nFreeCons) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%nCpldBodies)) if (allocated(InData%nCpldBodies)) then call RegPackBounds(Buf, 1, lbound(InData%nCpldBodies), ubound(InData%nCpldBodies)) call RegPack(Buf, InData%nCpldBodies) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%nCpldRods)) if (allocated(InData%nCpldRods)) then call RegPackBounds(Buf, 1, lbound(InData%nCpldRods), ubound(InData%nCpldRods)) call RegPack(Buf, InData%nCpldRods) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%nCpldCons)) if (allocated(InData%nCpldCons)) then call RegPackBounds(Buf, 1, lbound(InData%nCpldCons), ubound(InData%nCpldCons)) call RegPack(Buf, InData%nCpldCons) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NConns) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NAnchs) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Tmax) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%g) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rhoW) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WtrDpth) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%kBot) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%cBot) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dtM0) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dtCoupling) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dtOut) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RootName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) @@ -5964,157 +5674,117 @@ subroutine MD_PackParam(Buf, Indata) call MD_PackOutParmType(Buf, InData%OutParam(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Delim) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MDUnOut) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PriPath) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%writeLog) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UnLog) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveKin) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Current) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nTurbines) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TurbineRefPos)) if (allocated(InData%TurbineRefPos)) then call RegPackBounds(Buf, 2, lbound(InData%TurbineRefPos), ubound(InData%TurbineRefPos)) call RegPack(Buf, InData%TurbineRefPos) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%mu_kT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%mu_kA) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%mc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%cv) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nxWave) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nyWave) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nzWave) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ntWave) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%pxWave)) if (allocated(InData%pxWave)) then call RegPackBounds(Buf, 1, lbound(InData%pxWave), ubound(InData%pxWave)) call RegPack(Buf, InData%pxWave) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%pyWave)) if (allocated(InData%pyWave)) then call RegPackBounds(Buf, 1, lbound(InData%pyWave), ubound(InData%pyWave)) call RegPack(Buf, InData%pyWave) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%pzWave)) if (allocated(InData%pzWave)) then call RegPackBounds(Buf, 1, lbound(InData%pzWave), ubound(InData%pzWave)) call RegPack(Buf, InData%pzWave) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dtWave) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%uxWave)) if (allocated(InData%uxWave)) then call RegPackBounds(Buf, 4, lbound(InData%uxWave), ubound(InData%uxWave)) call RegPack(Buf, InData%uxWave) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%uyWave)) if (allocated(InData%uyWave)) then call RegPackBounds(Buf, 4, lbound(InData%uyWave), ubound(InData%uyWave)) call RegPack(Buf, InData%uyWave) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%uzWave)) if (allocated(InData%uzWave)) then call RegPackBounds(Buf, 4, lbound(InData%uzWave), ubound(InData%uzWave)) call RegPack(Buf, InData%uzWave) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%axWave)) if (allocated(InData%axWave)) then call RegPackBounds(Buf, 4, lbound(InData%axWave), ubound(InData%axWave)) call RegPack(Buf, InData%axWave) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ayWave)) if (allocated(InData%ayWave)) then call RegPackBounds(Buf, 4, lbound(InData%ayWave), ubound(InData%ayWave)) call RegPack(Buf, InData%ayWave) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%azWave)) if (allocated(InData%azWave)) then call RegPackBounds(Buf, 4, lbound(InData%azWave), ubound(InData%azWave)) call RegPack(Buf, InData%azWave) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PDyn)) if (allocated(InData%PDyn)) then call RegPackBounds(Buf, 4, lbound(InData%PDyn), ubound(InData%PDyn)) call RegPack(Buf, InData%PDyn) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%zeta)) if (allocated(InData%zeta)) then call RegPackBounds(Buf, 3, lbound(InData%zeta), ubound(InData%zeta)) call RegPack(Buf, InData%zeta) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nzCurrent) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%pzCurrent)) if (allocated(InData%pzCurrent)) then call RegPackBounds(Buf, 1, lbound(InData%pzCurrent), ubound(InData%pzCurrent)) call RegPack(Buf, InData%pzCurrent) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%uxCurrent)) if (allocated(InData%uxCurrent)) then call RegPackBounds(Buf, 1, lbound(InData%uxCurrent), ubound(InData%uxCurrent)) call RegPack(Buf, InData%uxCurrent) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%uyCurrent)) if (allocated(InData%uyCurrent)) then call RegPackBounds(Buf, 1, lbound(InData%uyCurrent), ubound(InData%uyCurrent)) call RegPack(Buf, InData%uyCurrent) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Nx0) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Jac_u_indx)) if (allocated(InData%Jac_u_indx)) then call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx), ubound(InData%Jac_u_indx)) call RegPack(Buf, InData%Jac_u_indx) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%du)) if (allocated(InData%du)) then call RegPackBounds(Buf, 1, lbound(InData%du), ubound(InData%du)) call RegPack(Buf, InData%du) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%dx)) if (allocated(InData%dx)) then call RegPackBounds(Buf, 1, lbound(InData%dx), ubound(InData%dx)) call RegPack(Buf, InData%dx) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Jac_ny) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Jac_nx) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%dxIdx_map2_xStateIdx)) if (allocated(InData%dxIdx_map2_xStateIdx)) then call RegPackBounds(Buf, 1, lbound(InData%dxIdx_map2_xStateIdx), ubound(InData%dxIdx_map2_xStateIdx)) @@ -6654,13 +6324,11 @@ subroutine MD_PackInput(Buf, Indata) call MeshPack(Buf, InData%CoupledKinematics(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%DeltaL)) if (allocated(InData%DeltaL)) then call RegPackBounds(Buf, 1, lbound(InData%DeltaL), ubound(InData%DeltaL)) call RegPack(Buf, InData%DeltaL) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%DeltaLdot)) if (allocated(InData%DeltaLdot)) then call RegPackBounds(Buf, 1, lbound(InData%DeltaLdot), ubound(InData%DeltaLdot)) @@ -6811,7 +6479,6 @@ subroutine MD_PackOutput(Buf, Indata) call MeshPack(Buf, InData%CoupledLoads(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) diff --git a/modules/nwtc-library/src/NWTC_Library_Types.f90 b/modules/nwtc-library/src/NWTC_Library_Types.f90 index 5ef255e3b7..f08bd4e953 100644 --- a/modules/nwtc-library/src/NWTC_Library_Types.f90 +++ b/modules/nwtc-library/src/NWTC_Library_Types.f90 @@ -116,9 +116,7 @@ subroutine NWTC_Library_PackProgDesc(Buf, Indata) character(*), parameter :: RoutineName = 'NWTC_Library_PackProgDesc' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%Name) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Ver) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Date) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -220,27 +218,20 @@ subroutine NWTC_Library_PackFASTdataType(Buf, Indata) character(*), parameter :: RoutineName = 'NWTC_Library_PackFASTdataType' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%File) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Descr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumChans) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumRecs) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TimeStep) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ChanNames)) if (allocated(InData%ChanNames)) then call RegPackBounds(Buf, 1, lbound(InData%ChanNames), ubound(InData%ChanNames)) call RegPack(Buf, InData%ChanNames) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ChanUnits)) if (allocated(InData%ChanUnits)) then call RegPackBounds(Buf, 1, lbound(InData%ChanUnits), ubound(InData%ChanUnits)) call RegPack(Buf, InData%ChanUnits) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Data)) if (allocated(InData%Data)) then call RegPackBounds(Buf, 2, lbound(InData%Data), ubound(InData%Data)) @@ -341,11 +332,8 @@ subroutine NWTC_Library_PackOutParmType(Buf, Indata) character(*), parameter :: RoutineName = 'NWTC_Library_PackOutParmType' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%Indx) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Name) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Units) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SignM) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -463,27 +451,22 @@ subroutine NWTC_Library_PackFileInfoType(Buf, Indata) character(*), parameter :: RoutineName = 'NWTC_Library_PackFileInfoType' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%NumLines) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumFiles) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FileLine)) if (allocated(InData%FileLine)) then call RegPackBounds(Buf, 1, lbound(InData%FileLine), ubound(InData%FileLine)) call RegPack(Buf, InData%FileLine) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FileIndx)) if (allocated(InData%FileIndx)) then call RegPackBounds(Buf, 1, lbound(InData%FileIndx), ubound(InData%FileIndx)) call RegPack(Buf, InData%FileIndx) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FileList)) if (allocated(InData%FileList)) then call RegPackBounds(Buf, 1, lbound(InData%FileList), ubound(InData%FileList)) call RegPack(Buf, InData%FileList) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Lines)) if (allocated(InData%Lines)) then call RegPackBounds(Buf, 1, lbound(InData%Lines), ubound(InData%Lines)) @@ -590,7 +573,6 @@ subroutine NWTC_Library_PackQuaternion(Buf, Indata) character(*), parameter :: RoutineName = 'NWTC_Library_PackQuaternion' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%q0) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%v) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -654,15 +636,12 @@ subroutine NWTC_Library_PackNWTC_RandomNumber_ParameterType(Buf, Indata) character(*), parameter :: RoutineName = 'NWTC_Library_PackNWTC_RandomNumber_ParameterType' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%pRNG) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RandSeed) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RandSeedAry)) if (allocated(InData%RandSeedAry)) then call RegPackBounds(Buf, 1, lbound(InData%RandSeedAry), ubound(InData%RandSeedAry)) call RegPack(Buf, InData%RandSeedAry) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RNG_type) if (RegCheckErr(Buf, RoutineName)) return end subroutine diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index f1c4e1294a..3d23b6ebaa 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -1020,33 +1020,25 @@ subroutine FAST_PackVTK_SurfaceType(Buf, Indata) integer(IntKi) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%NumSectors) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HubRad) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%GroundRad) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NacelleBox) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TowerRad)) if (allocated(InData%TowerRad)) then call RegPackBounds(Buf, 1, lbound(InData%TowerRad), ubound(InData%TowerRad)) call RegPack(Buf, InData%TowerRad) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NWaveElevPts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveElevXY)) if (allocated(InData%WaveElevXY)) then call RegPackBounds(Buf, 2, lbound(InData%WaveElevXY), ubound(InData%WaveElevXY)) call RegPack(Buf, InData%WaveElevXY) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveElev)) if (allocated(InData%WaveElev)) then call RegPackBounds(Buf, 2, lbound(InData%WaveElev), ubound(InData%WaveElev)) call RegPack(Buf, InData%WaveElev) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BladeShape)) if (allocated(InData%BladeShape)) then call RegPackBounds(Buf, 1, lbound(InData%BladeShape), ubound(InData%BladeShape)) @@ -1056,7 +1048,6 @@ subroutine FAST_PackVTK_SurfaceType(Buf, Indata) call FAST_PackVTK_BLSurfaceType(Buf, InData%BladeShape(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%MorisonRad)) if (allocated(InData%MorisonRad)) then call RegPackBounds(Buf, 1, lbound(InData%MorisonRad), ubound(InData%MorisonRad)) @@ -1294,49 +1285,37 @@ subroutine FAST_PackVTK_ModeShapeType(Buf, Indata) character(*), parameter :: RoutineName = 'FAST_PackVTK_ModeShapeType' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%CheckpointRoot) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MatlabFileName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VTKLinModes) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%VTKModes)) if (allocated(InData%VTKModes)) then call RegPackBounds(Buf, 1, lbound(InData%VTKModes), ubound(InData%VTKModes)) call RegPack(Buf, InData%VTKModes) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VTKLinTim) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VTKNLinTimes) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VTKLinScale) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VTKLinPhase) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%DampingRatio)) if (allocated(InData%DampingRatio)) then call RegPackBounds(Buf, 1, lbound(InData%DampingRatio), ubound(InData%DampingRatio)) call RegPack(Buf, InData%DampingRatio) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%NaturalFreq_Hz)) if (allocated(InData%NaturalFreq_Hz)) then call RegPackBounds(Buf, 1, lbound(InData%NaturalFreq_Hz), ubound(InData%NaturalFreq_Hz)) call RegPack(Buf, InData%NaturalFreq_Hz) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%DampedFreq_Hz)) if (allocated(InData%DampedFreq_Hz)) then call RegPackBounds(Buf, 1, lbound(InData%DampedFreq_Hz), ubound(InData%DampedFreq_Hz)) call RegPack(Buf, InData%DampedFreq_Hz) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%x_eig_magnitude)) if (allocated(InData%x_eig_magnitude)) then call RegPackBounds(Buf, 3, lbound(InData%x_eig_magnitude), ubound(InData%x_eig_magnitude)) call RegPack(Buf, InData%x_eig_magnitude) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%x_eig_phase)) if (allocated(InData%x_eig_phase)) then call RegPackBounds(Buf, 3, lbound(InData%x_eig_phase), ubound(InData%x_eig_phase)) @@ -1581,191 +1560,98 @@ subroutine FAST_PackParam(Buf, Indata) character(*), parameter :: RoutineName = 'FAST_PackParam' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%DT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DT_module) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%n_substeps) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%n_TMax_m1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TMax) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%InterpOrder) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumCrctn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%KMax) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%numIceLegs) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nBeams) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BD_OutputSibling) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ModuleInitialized) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DT_Ujac) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UJacSclFact) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SizeJac_Opt1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SolveOption) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CompElast) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CompInflow) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CompAero) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CompServo) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CompSeaSt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CompHydro) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CompSub) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CompMooring) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CompIce) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MHK) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UseDWM) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Linearize) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveFieldMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FarmIntegration) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TurbinePos) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Gravity) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AirDens) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WtrDens) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%KinVisc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SpdSound) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Patm) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Pvap) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WtrDpth) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MSL2SWL) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%EDFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BDBldFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%InflowFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AeroFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ServoFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SeaStFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HydroFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SubFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MooringFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%IceFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TStart) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DT_Out) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WrSttsTime) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%n_SttsTime) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%n_ChkptTime) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%n_DT_Out) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%n_VTKTime) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TurbineType) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WrBinOutFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WrTxtOutFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WrBinMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SumPrint) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WrVTK) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VTK_Type) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VTK_fields) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Delim) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutFmt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutFmt_t) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FmtWidth) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TChanLen) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutFileRoot) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FTitle) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VTK_OutFileRoot) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VTK_tWidth) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VTK_fps) - if (RegCheckErr(Buf, RoutineName)) return call FAST_PackVTK_SurfaceType(Buf, InData%VTK_surface) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Tdesc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CalcSteady) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TrimCase) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TrimTol) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TrimGain) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Twr_Kdmp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Bld_Kdmp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NLinTimes) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AzimDelta) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LinInputs) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LinOutputs) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LinOutJac) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LinOutMod) - if (RegCheckErr(Buf, RoutineName)) return call FAST_PackVTK_ModeShapeType(Buf, InData%VTK_modes) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UseSC) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Lin_NumMods) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Lin_ModOrder) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LinInterpOrder) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3777,7 +3663,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) end do end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%xd_IceD)) if (allocated(InData%xd_IceD)) then call RegPackBounds(Buf, 2, lbound(InData%xd_IceD), ubound(InData%xd_IceD)) @@ -3789,7 +3674,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) end do end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%z_IceD)) if (allocated(InData%z_IceD)) then call RegPackBounds(Buf, 2, lbound(InData%z_IceD), ubound(InData%z_IceD)) @@ -3801,7 +3685,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) end do end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OtherSt_IceD)) if (allocated(InData%OtherSt_IceD)) then call RegPackBounds(Buf, 2, lbound(InData%OtherSt_IceD), ubound(InData%OtherSt_IceD)) @@ -3813,7 +3696,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) end do end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%u_IceD)) if (allocated(InData%u_IceD)) then call RegPackBounds(Buf, 2, lbound(InData%u_IceD), ubound(InData%u_IceD)) @@ -3825,7 +3707,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) end do end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%x_BD)) if (allocated(InData%x_BD)) then call RegPackBounds(Buf, 2, lbound(InData%x_BD), ubound(InData%x_BD)) @@ -3837,7 +3718,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) end do end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%xd_BD)) if (allocated(InData%xd_BD)) then call RegPackBounds(Buf, 2, lbound(InData%xd_BD), ubound(InData%xd_BD)) @@ -3849,7 +3729,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) end do end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%z_BD)) if (allocated(InData%z_BD)) then call RegPackBounds(Buf, 2, lbound(InData%z_BD), ubound(InData%z_BD)) @@ -3861,7 +3740,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) end do end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OtherSt_BD)) if (allocated(InData%OtherSt_BD)) then call RegPackBounds(Buf, 2, lbound(InData%OtherSt_BD), ubound(InData%OtherSt_BD)) @@ -3873,7 +3751,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) end do end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%u_BD)) if (allocated(InData%u_BD)) then call RegPackBounds(Buf, 2, lbound(InData%u_BD), ubound(InData%u_BD)) @@ -3885,7 +3762,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) end do end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%x_ED)) if (allocated(InData%x_ED)) then call RegPackBounds(Buf, 1, lbound(InData%x_ED), ubound(InData%x_ED)) @@ -3895,7 +3771,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call ED_PackContState(Buf, InData%x_ED(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%xd_ED)) if (allocated(InData%xd_ED)) then call RegPackBounds(Buf, 1, lbound(InData%xd_ED), ubound(InData%xd_ED)) @@ -3905,7 +3780,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call ED_PackDiscState(Buf, InData%xd_ED(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%z_ED)) if (allocated(InData%z_ED)) then call RegPackBounds(Buf, 1, lbound(InData%z_ED), ubound(InData%z_ED)) @@ -3915,7 +3789,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call ED_PackConstrState(Buf, InData%z_ED(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OtherSt_ED)) if (allocated(InData%OtherSt_ED)) then call RegPackBounds(Buf, 1, lbound(InData%OtherSt_ED), ubound(InData%OtherSt_ED)) @@ -3925,7 +3798,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call ED_PackOtherState(Buf, InData%OtherSt_ED(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%u_ED)) if (allocated(InData%u_ED)) then call RegPackBounds(Buf, 1, lbound(InData%u_ED), ubound(InData%u_ED)) @@ -3935,7 +3807,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call ED_PackInput(Buf, InData%u_ED(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%x_SrvD)) if (allocated(InData%x_SrvD)) then call RegPackBounds(Buf, 1, lbound(InData%x_SrvD), ubound(InData%x_SrvD)) @@ -3945,7 +3816,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call SrvD_PackContState(Buf, InData%x_SrvD(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%xd_SrvD)) if (allocated(InData%xd_SrvD)) then call RegPackBounds(Buf, 1, lbound(InData%xd_SrvD), ubound(InData%xd_SrvD)) @@ -3955,7 +3825,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call SrvD_PackDiscState(Buf, InData%xd_SrvD(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%z_SrvD)) if (allocated(InData%z_SrvD)) then call RegPackBounds(Buf, 1, lbound(InData%z_SrvD), ubound(InData%z_SrvD)) @@ -3965,7 +3834,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call SrvD_PackConstrState(Buf, InData%z_SrvD(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OtherSt_SrvD)) if (allocated(InData%OtherSt_SrvD)) then call RegPackBounds(Buf, 1, lbound(InData%OtherSt_SrvD), ubound(InData%OtherSt_SrvD)) @@ -3975,7 +3843,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call SrvD_PackOtherState(Buf, InData%OtherSt_SrvD(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%u_SrvD)) if (allocated(InData%u_SrvD)) then call RegPackBounds(Buf, 1, lbound(InData%u_SrvD), ubound(InData%u_SrvD)) @@ -3985,7 +3852,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call SrvD_PackInput(Buf, InData%u_SrvD(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%x_AD)) if (allocated(InData%x_AD)) then call RegPackBounds(Buf, 1, lbound(InData%x_AD), ubound(InData%x_AD)) @@ -3995,7 +3861,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call AD_PackContState(Buf, InData%x_AD(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%xd_AD)) if (allocated(InData%xd_AD)) then call RegPackBounds(Buf, 1, lbound(InData%xd_AD), ubound(InData%xd_AD)) @@ -4005,7 +3870,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call AD_PackDiscState(Buf, InData%xd_AD(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%z_AD)) if (allocated(InData%z_AD)) then call RegPackBounds(Buf, 1, lbound(InData%z_AD), ubound(InData%z_AD)) @@ -4015,7 +3879,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call AD_PackConstrState(Buf, InData%z_AD(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OtherSt_AD)) if (allocated(InData%OtherSt_AD)) then call RegPackBounds(Buf, 1, lbound(InData%OtherSt_AD), ubound(InData%OtherSt_AD)) @@ -4025,7 +3888,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call AD_PackOtherState(Buf, InData%OtherSt_AD(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%u_AD)) if (allocated(InData%u_AD)) then call RegPackBounds(Buf, 1, lbound(InData%u_AD), ubound(InData%u_AD)) @@ -4035,7 +3897,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call AD_PackInput(Buf, InData%u_AD(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%x_IfW)) if (allocated(InData%x_IfW)) then call RegPackBounds(Buf, 1, lbound(InData%x_IfW), ubound(InData%x_IfW)) @@ -4045,7 +3906,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call InflowWind_PackContState(Buf, InData%x_IfW(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%xd_IfW)) if (allocated(InData%xd_IfW)) then call RegPackBounds(Buf, 1, lbound(InData%xd_IfW), ubound(InData%xd_IfW)) @@ -4055,7 +3915,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call InflowWind_PackDiscState(Buf, InData%xd_IfW(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%z_IfW)) if (allocated(InData%z_IfW)) then call RegPackBounds(Buf, 1, lbound(InData%z_IfW), ubound(InData%z_IfW)) @@ -4065,7 +3924,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call InflowWind_PackConstrState(Buf, InData%z_IfW(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OtherSt_IfW)) if (allocated(InData%OtherSt_IfW)) then call RegPackBounds(Buf, 1, lbound(InData%OtherSt_IfW), ubound(InData%OtherSt_IfW)) @@ -4075,7 +3933,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call InflowWind_PackOtherState(Buf, InData%OtherSt_IfW(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%u_IfW)) if (allocated(InData%u_IfW)) then call RegPackBounds(Buf, 1, lbound(InData%u_IfW), ubound(InData%u_IfW)) @@ -4085,7 +3942,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call InflowWind_PackInput(Buf, InData%u_IfW(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%x_SD)) if (allocated(InData%x_SD)) then call RegPackBounds(Buf, 1, lbound(InData%x_SD), ubound(InData%x_SD)) @@ -4095,7 +3951,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call SD_PackContState(Buf, InData%x_SD(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%xd_SD)) if (allocated(InData%xd_SD)) then call RegPackBounds(Buf, 1, lbound(InData%xd_SD), ubound(InData%xd_SD)) @@ -4105,7 +3960,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call SD_PackDiscState(Buf, InData%xd_SD(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%z_SD)) if (allocated(InData%z_SD)) then call RegPackBounds(Buf, 1, lbound(InData%z_SD), ubound(InData%z_SD)) @@ -4115,7 +3969,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call SD_PackConstrState(Buf, InData%z_SD(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OtherSt_SD)) if (allocated(InData%OtherSt_SD)) then call RegPackBounds(Buf, 1, lbound(InData%OtherSt_SD), ubound(InData%OtherSt_SD)) @@ -4125,7 +3978,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call SD_PackOtherState(Buf, InData%OtherSt_SD(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%u_SD)) if (allocated(InData%u_SD)) then call RegPackBounds(Buf, 1, lbound(InData%u_SD), ubound(InData%u_SD)) @@ -4135,7 +3987,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call SD_PackInput(Buf, InData%u_SD(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%x_ExtPtfm)) if (allocated(InData%x_ExtPtfm)) then call RegPackBounds(Buf, 1, lbound(InData%x_ExtPtfm), ubound(InData%x_ExtPtfm)) @@ -4145,7 +3996,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call ExtPtfm_PackContState(Buf, InData%x_ExtPtfm(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%xd_ExtPtfm)) if (allocated(InData%xd_ExtPtfm)) then call RegPackBounds(Buf, 1, lbound(InData%xd_ExtPtfm), ubound(InData%xd_ExtPtfm)) @@ -4155,7 +4005,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call ExtPtfm_PackDiscState(Buf, InData%xd_ExtPtfm(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%z_ExtPtfm)) if (allocated(InData%z_ExtPtfm)) then call RegPackBounds(Buf, 1, lbound(InData%z_ExtPtfm), ubound(InData%z_ExtPtfm)) @@ -4165,7 +4014,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call ExtPtfm_PackConstrState(Buf, InData%z_ExtPtfm(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OtherSt_ExtPtfm)) if (allocated(InData%OtherSt_ExtPtfm)) then call RegPackBounds(Buf, 1, lbound(InData%OtherSt_ExtPtfm), ubound(InData%OtherSt_ExtPtfm)) @@ -4175,7 +4023,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call ExtPtfm_PackOtherState(Buf, InData%OtherSt_ExtPtfm(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%u_ExtPtfm)) if (allocated(InData%u_ExtPtfm)) then call RegPackBounds(Buf, 1, lbound(InData%u_ExtPtfm), ubound(InData%u_ExtPtfm)) @@ -4185,7 +4032,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call ExtPtfm_PackInput(Buf, InData%u_ExtPtfm(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%x_HD)) if (allocated(InData%x_HD)) then call RegPackBounds(Buf, 1, lbound(InData%x_HD), ubound(InData%x_HD)) @@ -4195,7 +4041,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call HydroDyn_PackContState(Buf, InData%x_HD(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%xd_HD)) if (allocated(InData%xd_HD)) then call RegPackBounds(Buf, 1, lbound(InData%xd_HD), ubound(InData%xd_HD)) @@ -4205,7 +4050,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call HydroDyn_PackDiscState(Buf, InData%xd_HD(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%z_HD)) if (allocated(InData%z_HD)) then call RegPackBounds(Buf, 1, lbound(InData%z_HD), ubound(InData%z_HD)) @@ -4215,7 +4059,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call HydroDyn_PackConstrState(Buf, InData%z_HD(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OtherSt_HD)) if (allocated(InData%OtherSt_HD)) then call RegPackBounds(Buf, 1, lbound(InData%OtherSt_HD), ubound(InData%OtherSt_HD)) @@ -4225,7 +4068,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call HydroDyn_PackOtherState(Buf, InData%OtherSt_HD(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%u_HD)) if (allocated(InData%u_HD)) then call RegPackBounds(Buf, 1, lbound(InData%u_HD), ubound(InData%u_HD)) @@ -4235,7 +4077,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call HydroDyn_PackInput(Buf, InData%u_HD(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%x_IceF)) if (allocated(InData%x_IceF)) then call RegPackBounds(Buf, 1, lbound(InData%x_IceF), ubound(InData%x_IceF)) @@ -4245,7 +4086,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call IceFloe_PackContState(Buf, InData%x_IceF(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%xd_IceF)) if (allocated(InData%xd_IceF)) then call RegPackBounds(Buf, 1, lbound(InData%xd_IceF), ubound(InData%xd_IceF)) @@ -4255,7 +4095,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call IceFloe_PackDiscState(Buf, InData%xd_IceF(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%z_IceF)) if (allocated(InData%z_IceF)) then call RegPackBounds(Buf, 1, lbound(InData%z_IceF), ubound(InData%z_IceF)) @@ -4265,7 +4104,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call IceFloe_PackConstrState(Buf, InData%z_IceF(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OtherSt_IceF)) if (allocated(InData%OtherSt_IceF)) then call RegPackBounds(Buf, 1, lbound(InData%OtherSt_IceF), ubound(InData%OtherSt_IceF)) @@ -4275,7 +4113,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call IceFloe_PackOtherState(Buf, InData%OtherSt_IceF(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%u_IceF)) if (allocated(InData%u_IceF)) then call RegPackBounds(Buf, 1, lbound(InData%u_IceF), ubound(InData%u_IceF)) @@ -4285,7 +4122,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call IceFloe_PackInput(Buf, InData%u_IceF(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%x_MAP)) if (allocated(InData%x_MAP)) then call RegPackBounds(Buf, 1, lbound(InData%x_MAP), ubound(InData%x_MAP)) @@ -4295,7 +4131,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call MAP_PackContState(Buf, InData%x_MAP(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%xd_MAP)) if (allocated(InData%xd_MAP)) then call RegPackBounds(Buf, 1, lbound(InData%xd_MAP), ubound(InData%xd_MAP)) @@ -4305,7 +4140,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call MAP_PackDiscState(Buf, InData%xd_MAP(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%z_MAP)) if (allocated(InData%z_MAP)) then call RegPackBounds(Buf, 1, lbound(InData%z_MAP), ubound(InData%z_MAP)) @@ -4315,7 +4149,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call MAP_PackConstrState(Buf, InData%z_MAP(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%u_MAP)) if (allocated(InData%u_MAP)) then call RegPackBounds(Buf, 1, lbound(InData%u_MAP), ubound(InData%u_MAP)) @@ -4325,7 +4158,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call MAP_PackInput(Buf, InData%u_MAP(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%x_FEAM)) if (allocated(InData%x_FEAM)) then call RegPackBounds(Buf, 1, lbound(InData%x_FEAM), ubound(InData%x_FEAM)) @@ -4335,7 +4167,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call FEAM_PackContState(Buf, InData%x_FEAM(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%xd_FEAM)) if (allocated(InData%xd_FEAM)) then call RegPackBounds(Buf, 1, lbound(InData%xd_FEAM), ubound(InData%xd_FEAM)) @@ -4345,7 +4176,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call FEAM_PackDiscState(Buf, InData%xd_FEAM(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%z_FEAM)) if (allocated(InData%z_FEAM)) then call RegPackBounds(Buf, 1, lbound(InData%z_FEAM), ubound(InData%z_FEAM)) @@ -4355,7 +4185,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call FEAM_PackConstrState(Buf, InData%z_FEAM(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OtherSt_FEAM)) if (allocated(InData%OtherSt_FEAM)) then call RegPackBounds(Buf, 1, lbound(InData%OtherSt_FEAM), ubound(InData%OtherSt_FEAM)) @@ -4365,7 +4194,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call FEAM_PackOtherState(Buf, InData%OtherSt_FEAM(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%u_FEAM)) if (allocated(InData%u_FEAM)) then call RegPackBounds(Buf, 1, lbound(InData%u_FEAM), ubound(InData%u_FEAM)) @@ -4375,7 +4203,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call FEAM_PackInput(Buf, InData%u_FEAM(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%x_MD)) if (allocated(InData%x_MD)) then call RegPackBounds(Buf, 1, lbound(InData%x_MD), ubound(InData%x_MD)) @@ -4385,7 +4212,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call MD_PackContState(Buf, InData%x_MD(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%xd_MD)) if (allocated(InData%xd_MD)) then call RegPackBounds(Buf, 1, lbound(InData%xd_MD), ubound(InData%xd_MD)) @@ -4395,7 +4221,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call MD_PackDiscState(Buf, InData%xd_MD(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%z_MD)) if (allocated(InData%z_MD)) then call RegPackBounds(Buf, 1, lbound(InData%z_MD), ubound(InData%z_MD)) @@ -4405,7 +4230,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call MD_PackConstrState(Buf, InData%z_MD(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OtherSt_MD)) if (allocated(InData%OtherSt_MD)) then call RegPackBounds(Buf, 1, lbound(InData%OtherSt_MD), ubound(InData%OtherSt_MD)) @@ -4415,7 +4239,6 @@ subroutine FAST_PackLinStateSave(Buf, Indata) call MD_PackOtherState(Buf, InData%OtherSt_MD(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%u_MD)) if (allocated(InData%u_MD)) then call RegPackBounds(Buf, 1, lbound(InData%u_MD), ubound(InData%u_MD)) @@ -5930,173 +5753,143 @@ subroutine FAST_PackLinType(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%Names_u), ubound(InData%Names_u)) call RegPack(Buf, InData%Names_u) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Names_y)) if (allocated(InData%Names_y)) then call RegPackBounds(Buf, 1, lbound(InData%Names_y), ubound(InData%Names_y)) call RegPack(Buf, InData%Names_y) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Names_x)) if (allocated(InData%Names_x)) then call RegPackBounds(Buf, 1, lbound(InData%Names_x), ubound(InData%Names_x)) call RegPack(Buf, InData%Names_x) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Names_xd)) if (allocated(InData%Names_xd)) then call RegPackBounds(Buf, 1, lbound(InData%Names_xd), ubound(InData%Names_xd)) call RegPack(Buf, InData%Names_xd) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Names_z)) if (allocated(InData%Names_z)) then call RegPackBounds(Buf, 1, lbound(InData%Names_z), ubound(InData%Names_z)) call RegPack(Buf, InData%Names_z) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%op_u)) if (allocated(InData%op_u)) then call RegPackBounds(Buf, 1, lbound(InData%op_u), ubound(InData%op_u)) call RegPack(Buf, InData%op_u) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%op_y)) if (allocated(InData%op_y)) then call RegPackBounds(Buf, 1, lbound(InData%op_y), ubound(InData%op_y)) call RegPack(Buf, InData%op_y) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%op_x)) if (allocated(InData%op_x)) then call RegPackBounds(Buf, 1, lbound(InData%op_x), ubound(InData%op_x)) call RegPack(Buf, InData%op_x) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%op_dx)) if (allocated(InData%op_dx)) then call RegPackBounds(Buf, 1, lbound(InData%op_dx), ubound(InData%op_dx)) call RegPack(Buf, InData%op_dx) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%op_xd)) if (allocated(InData%op_xd)) then call RegPackBounds(Buf, 1, lbound(InData%op_xd), ubound(InData%op_xd)) call RegPack(Buf, InData%op_xd) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%op_z)) if (allocated(InData%op_z)) then call RegPackBounds(Buf, 1, lbound(InData%op_z), ubound(InData%op_z)) call RegPack(Buf, InData%op_z) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%op_x_eig_mag)) if (allocated(InData%op_x_eig_mag)) then call RegPackBounds(Buf, 1, lbound(InData%op_x_eig_mag), ubound(InData%op_x_eig_mag)) call RegPack(Buf, InData%op_x_eig_mag) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%op_x_eig_phase)) if (allocated(InData%op_x_eig_phase)) then call RegPackBounds(Buf, 1, lbound(InData%op_x_eig_phase), ubound(InData%op_x_eig_phase)) call RegPack(Buf, InData%op_x_eig_phase) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Use_u)) if (allocated(InData%Use_u)) then call RegPackBounds(Buf, 1, lbound(InData%Use_u), ubound(InData%Use_u)) call RegPack(Buf, InData%Use_u) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Use_y)) if (allocated(InData%Use_y)) then call RegPackBounds(Buf, 1, lbound(InData%Use_y), ubound(InData%Use_y)) call RegPack(Buf, InData%Use_y) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%A)) if (allocated(InData%A)) then call RegPackBounds(Buf, 2, lbound(InData%A), ubound(InData%A)) call RegPack(Buf, InData%A) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%B)) if (allocated(InData%B)) then call RegPackBounds(Buf, 2, lbound(InData%B), ubound(InData%B)) call RegPack(Buf, InData%B) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%C)) if (allocated(InData%C)) then call RegPackBounds(Buf, 2, lbound(InData%C), ubound(InData%C)) call RegPack(Buf, InData%C) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%D)) if (allocated(InData%D)) then call RegPackBounds(Buf, 2, lbound(InData%D), ubound(InData%D)) call RegPack(Buf, InData%D) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%StateRotation)) if (allocated(InData%StateRotation)) then call RegPackBounds(Buf, 2, lbound(InData%StateRotation), ubound(InData%StateRotation)) call RegPack(Buf, InData%StateRotation) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%StateRel_x)) if (allocated(InData%StateRel_x)) then call RegPackBounds(Buf, 2, lbound(InData%StateRel_x), ubound(InData%StateRel_x)) call RegPack(Buf, InData%StateRel_x) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%StateRel_xdot)) if (allocated(InData%StateRel_xdot)) then call RegPackBounds(Buf, 2, lbound(InData%StateRel_xdot), ubound(InData%StateRel_xdot)) call RegPack(Buf, InData%StateRel_xdot) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%IsLoad_u)) if (allocated(InData%IsLoad_u)) then call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) call RegPack(Buf, InData%IsLoad_u) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RotFrame_u)) if (allocated(InData%RotFrame_u)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u), ubound(InData%RotFrame_u)) call RegPack(Buf, InData%RotFrame_u) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RotFrame_y)) if (allocated(InData%RotFrame_y)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y), ubound(InData%RotFrame_y)) call RegPack(Buf, InData%RotFrame_y) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RotFrame_x)) if (allocated(InData%RotFrame_x)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x), ubound(InData%RotFrame_x)) call RegPack(Buf, InData%RotFrame_x) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RotFrame_z)) if (allocated(InData%RotFrame_z)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_z), ubound(InData%RotFrame_z)) call RegPack(Buf, InData%RotFrame_z) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%DerivOrder_x)) if (allocated(InData%DerivOrder_x)) then call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x), ubound(InData%DerivOrder_x)) call RegPack(Buf, InData%DerivOrder_x) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SizeLin) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LinStartIndx) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumOutputs) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -6662,13 +6455,9 @@ subroutine FAST_PackLinFileType(Buf, Indata) do i1 = LB(1), UB(1) call FAST_PackModLinType(Buf, InData%Modules(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return call FAST_PackLinType(Buf, InData%Glue) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RotSpeed) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Azimuth) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WindSpeed) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -6835,45 +6624,33 @@ subroutine FAST_PackMiscLinType(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%LinTimes), ubound(InData%LinTimes)) call RegPack(Buf, InData%LinTimes) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CopyOP_CtrlCode) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AzimTarget)) if (allocated(InData%AzimTarget)) then call RegPackBounds(Buf, 1, lbound(InData%AzimTarget), ubound(InData%AzimTarget)) call RegPack(Buf, InData%AzimTarget) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%IsConverged) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FoundSteady) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ForceLin) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%n_rot) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AzimIndx) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NextLinTimeIndx) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Psi)) if (allocated(InData%Psi)) then call RegPackBounds(Buf, 1, lbound(InData%Psi), ubound(InData%Psi)) call RegPack(Buf, InData%Psi) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%y_interp)) if (allocated(InData%y_interp)) then call RegPackBounds(Buf, 1, lbound(InData%y_interp), ubound(InData%y_interp)) call RegPack(Buf, InData%y_interp) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%y_ref)) if (allocated(InData%y_ref)) then call RegPackBounds(Buf, 1, lbound(InData%y_ref), ubound(InData%y_ref)) call RegPack(Buf, InData%y_ref) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Y_prevRot)) if (allocated(InData%Y_prevRot)) then call RegPackBounds(Buf, 2, lbound(InData%Y_prevRot), ubound(InData%Y_prevRot)) @@ -7124,59 +6901,40 @@ subroutine FAST_PackOutputFileType(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%TimeData), ubound(InData%TimeData)) call RegPack(Buf, InData%TimeData) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AllOutData)) if (allocated(InData%AllOutData)) then call RegPackBounds(Buf, 2, lbound(InData%AllOutData), ubound(InData%AllOutData)) call RegPack(Buf, InData%AllOutData) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%n_Out) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NOutSteps) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%numOuts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UnOu) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UnSum) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UnGra) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FileDescLines) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ChannelNames)) if (allocated(InData%ChannelNames)) then call RegPackBounds(Buf, 1, lbound(InData%ChannelNames), ubound(InData%ChannelNames)) call RegPack(Buf, InData%ChannelNames) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ChannelUnits)) if (allocated(InData%ChannelUnits)) then call RegPackBounds(Buf, 1, lbound(InData%ChannelUnits), ubound(InData%ChannelUnits)) call RegPack(Buf, InData%ChannelUnits) end if - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%Module_Ver) UB(1:1) = ubound(InData%Module_Ver) do i1 = LB(1), UB(1) call NWTC_Library_PackProgDesc(Buf, InData%Module_Ver(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Module_Abrev) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WriteThisStep) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VTK_count) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VTK_LastWaveIndx) - if (RegCheckErr(Buf, RoutineName)) return call FAST_PackLinFileType(Buf, InData%Lin) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ActualChanLen) - if (RegCheckErr(Buf, RoutineName)) return call FAST_PackLinStateSave(Buf, InData%op) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DriverWriteOutput) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -7607,7 +7365,6 @@ subroutine FAST_PackIceDyn_Data(Buf, Indata) end do end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%xd)) if (allocated(InData%xd)) then call RegPackBounds(Buf, 2, lbound(InData%xd), ubound(InData%xd)) @@ -7619,7 +7376,6 @@ subroutine FAST_PackIceDyn_Data(Buf, Indata) end do end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%z)) if (allocated(InData%z)) then call RegPackBounds(Buf, 2, lbound(InData%z), ubound(InData%z)) @@ -7631,7 +7387,6 @@ subroutine FAST_PackIceDyn_Data(Buf, Indata) end do end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OtherSt)) if (allocated(InData%OtherSt)) then call RegPackBounds(Buf, 2, lbound(InData%OtherSt), ubound(InData%OtherSt)) @@ -7643,7 +7398,6 @@ subroutine FAST_PackIceDyn_Data(Buf, Indata) end do end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%p)) if (allocated(InData%p)) then call RegPackBounds(Buf, 1, lbound(InData%p), ubound(InData%p)) @@ -7653,7 +7407,6 @@ subroutine FAST_PackIceDyn_Data(Buf, Indata) call IceD_PackParam(Buf, InData%p(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%u)) if (allocated(InData%u)) then call RegPackBounds(Buf, 1, lbound(InData%u), ubound(InData%u)) @@ -7663,7 +7416,6 @@ subroutine FAST_PackIceDyn_Data(Buf, Indata) call IceD_PackInput(Buf, InData%u(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%y)) if (allocated(InData%y)) then call RegPackBounds(Buf, 1, lbound(InData%y), ubound(InData%y)) @@ -7673,7 +7425,6 @@ subroutine FAST_PackIceDyn_Data(Buf, Indata) call IceD_PackOutput(Buf, InData%y(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%m)) if (allocated(InData%m)) then call RegPackBounds(Buf, 1, lbound(InData%m), ubound(InData%m)) @@ -7683,7 +7434,6 @@ subroutine FAST_PackIceDyn_Data(Buf, Indata) call IceD_PackMisc(Buf, InData%m(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(Buf, 2, lbound(InData%Input), ubound(InData%Input)) @@ -7695,7 +7445,6 @@ subroutine FAST_PackIceDyn_Data(Buf, Indata) end do end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then call RegPackBounds(Buf, 2, lbound(InData%InputTimes), ubound(InData%InputTimes)) @@ -8258,7 +8007,6 @@ subroutine FAST_PackBeamDyn_Data(Buf, Indata) end do end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%xd)) if (allocated(InData%xd)) then call RegPackBounds(Buf, 2, lbound(InData%xd), ubound(InData%xd)) @@ -8270,7 +8018,6 @@ subroutine FAST_PackBeamDyn_Data(Buf, Indata) end do end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%z)) if (allocated(InData%z)) then call RegPackBounds(Buf, 2, lbound(InData%z), ubound(InData%z)) @@ -8282,7 +8029,6 @@ subroutine FAST_PackBeamDyn_Data(Buf, Indata) end do end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OtherSt)) if (allocated(InData%OtherSt)) then call RegPackBounds(Buf, 2, lbound(InData%OtherSt), ubound(InData%OtherSt)) @@ -8294,7 +8040,6 @@ subroutine FAST_PackBeamDyn_Data(Buf, Indata) end do end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%p)) if (allocated(InData%p)) then call RegPackBounds(Buf, 1, lbound(InData%p), ubound(InData%p)) @@ -8304,7 +8049,6 @@ subroutine FAST_PackBeamDyn_Data(Buf, Indata) call BD_PackParam(Buf, InData%p(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%u)) if (allocated(InData%u)) then call RegPackBounds(Buf, 1, lbound(InData%u), ubound(InData%u)) @@ -8314,7 +8058,6 @@ subroutine FAST_PackBeamDyn_Data(Buf, Indata) call BD_PackInput(Buf, InData%u(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%y)) if (allocated(InData%y)) then call RegPackBounds(Buf, 1, lbound(InData%y), ubound(InData%y)) @@ -8324,7 +8067,6 @@ subroutine FAST_PackBeamDyn_Data(Buf, Indata) call BD_PackOutput(Buf, InData%y(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%m)) if (allocated(InData%m)) then call RegPackBounds(Buf, 1, lbound(InData%m), ubound(InData%m)) @@ -8334,7 +8076,6 @@ subroutine FAST_PackBeamDyn_Data(Buf, Indata) call BD_PackMisc(Buf, InData%m(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Output)) if (allocated(InData%Output)) then call RegPackBounds(Buf, 2, lbound(InData%Output), ubound(InData%Output)) @@ -8346,7 +8087,6 @@ subroutine FAST_PackBeamDyn_Data(Buf, Indata) end do end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%y_interp)) if (allocated(InData%y_interp)) then call RegPackBounds(Buf, 1, lbound(InData%y_interp), ubound(InData%y_interp)) @@ -8356,7 +8096,6 @@ subroutine FAST_PackBeamDyn_Data(Buf, Indata) call BD_PackOutput(Buf, InData%y_interp(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(Buf, 2, lbound(InData%Input), ubound(InData%Input)) @@ -8368,7 +8107,6 @@ subroutine FAST_PackBeamDyn_Data(Buf, Indata) end do end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then call RegPackBounds(Buf, 2, lbound(InData%InputTimes), ubound(InData%InputTimes)) @@ -8733,33 +8471,25 @@ subroutine FAST_PackElastoDyn_Data(Buf, Indata) do i1 = LB(1), UB(1) call ED_PackContState(Buf, InData%x(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%xd) UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) call ED_PackDiscState(Buf, InData%xd(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%z) UB(1:1) = ubound(InData%z) do i1 = LB(1), UB(1) call ED_PackConstrState(Buf, InData%z(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%OtherSt) UB(1:1) = ubound(InData%OtherSt) do i1 = LB(1), UB(1) call ED_PackOtherState(Buf, InData%OtherSt(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return call ED_PackParam(Buf, InData%p) - if (RegCheckErr(Buf, RoutineName)) return call ED_PackInput(Buf, InData%u) - if (RegCheckErr(Buf, RoutineName)) return call ED_PackOutput(Buf, InData%y) - if (RegCheckErr(Buf, RoutineName)) return call ED_PackMisc(Buf, InData%m) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Output)) if (allocated(InData%Output)) then call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) @@ -8769,9 +8499,7 @@ subroutine FAST_PackElastoDyn_Data(Buf, Indata) call ED_PackOutput(Buf, InData%Output(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call ED_PackOutput(Buf, InData%y_interp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) @@ -8781,7 +8509,6 @@ subroutine FAST_PackElastoDyn_Data(Buf, Indata) call ED_PackInput(Buf, InData%Input(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) @@ -9024,33 +8751,25 @@ subroutine FAST_PackServoDyn_Data(Buf, Indata) do i1 = LB(1), UB(1) call SrvD_PackContState(Buf, InData%x(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%xd) UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) call SrvD_PackDiscState(Buf, InData%xd(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%z) UB(1:1) = ubound(InData%z) do i1 = LB(1), UB(1) call SrvD_PackConstrState(Buf, InData%z(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%OtherSt) UB(1:1) = ubound(InData%OtherSt) do i1 = LB(1), UB(1) call SrvD_PackOtherState(Buf, InData%OtherSt(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return call SrvD_PackParam(Buf, InData%p) - if (RegCheckErr(Buf, RoutineName)) return call SrvD_PackInput(Buf, InData%u) - if (RegCheckErr(Buf, RoutineName)) return call SrvD_PackOutput(Buf, InData%y) - if (RegCheckErr(Buf, RoutineName)) return call SrvD_PackMisc(Buf, InData%m) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Output)) if (allocated(InData%Output)) then call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) @@ -9060,9 +8779,7 @@ subroutine FAST_PackServoDyn_Data(Buf, Indata) call SrvD_PackOutput(Buf, InData%Output(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call SrvD_PackOutput(Buf, InData%y_interp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) @@ -9072,7 +8789,6 @@ subroutine FAST_PackServoDyn_Data(Buf, Indata) call SrvD_PackInput(Buf, InData%Input(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) @@ -9285,33 +9001,25 @@ subroutine FAST_PackAeroDyn14_Data(Buf, Indata) do i1 = LB(1), UB(1) call AD14_PackContState(Buf, InData%x(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%xd) UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) call AD14_PackDiscState(Buf, InData%xd(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%z) UB(1:1) = ubound(InData%z) do i1 = LB(1), UB(1) call AD14_PackConstrState(Buf, InData%z(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%OtherSt) UB(1:1) = ubound(InData%OtherSt) do i1 = LB(1), UB(1) call AD14_PackOtherState(Buf, InData%OtherSt(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return call AD14_PackParam(Buf, InData%p) - if (RegCheckErr(Buf, RoutineName)) return call AD14_PackInput(Buf, InData%u) - if (RegCheckErr(Buf, RoutineName)) return call AD14_PackOutput(Buf, InData%y) - if (RegCheckErr(Buf, RoutineName)) return call AD14_PackMisc(Buf, InData%m) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) @@ -9321,7 +9029,6 @@ subroutine FAST_PackAeroDyn14_Data(Buf, Indata) call AD14_PackInput(Buf, InData%Input(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) @@ -9548,33 +9255,25 @@ subroutine FAST_PackAeroDyn_Data(Buf, Indata) do i1 = LB(1), UB(1) call AD_PackContState(Buf, InData%x(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%xd) UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) call AD_PackDiscState(Buf, InData%xd(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%z) UB(1:1) = ubound(InData%z) do i1 = LB(1), UB(1) call AD_PackConstrState(Buf, InData%z(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%OtherSt) UB(1:1) = ubound(InData%OtherSt) do i1 = LB(1), UB(1) call AD_PackOtherState(Buf, InData%OtherSt(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return call AD_PackParam(Buf, InData%p) - if (RegCheckErr(Buf, RoutineName)) return call AD_PackInput(Buf, InData%u) - if (RegCheckErr(Buf, RoutineName)) return call AD_PackOutput(Buf, InData%y) - if (RegCheckErr(Buf, RoutineName)) return call AD_PackMisc(Buf, InData%m) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Output)) if (allocated(InData%Output)) then call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) @@ -9584,9 +9283,7 @@ subroutine FAST_PackAeroDyn_Data(Buf, Indata) call AD_PackOutput(Buf, InData%Output(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call AD_PackOutput(Buf, InData%y_interp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) @@ -9596,7 +9293,6 @@ subroutine FAST_PackAeroDyn_Data(Buf, Indata) call AD_PackInput(Buf, InData%Input(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) @@ -9839,33 +9535,25 @@ subroutine FAST_PackInflowWind_Data(Buf, Indata) do i1 = LB(1), UB(1) call InflowWind_PackContState(Buf, InData%x(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%xd) UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) call InflowWind_PackDiscState(Buf, InData%xd(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%z) UB(1:1) = ubound(InData%z) do i1 = LB(1), UB(1) call InflowWind_PackConstrState(Buf, InData%z(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%OtherSt) UB(1:1) = ubound(InData%OtherSt) do i1 = LB(1), UB(1) call InflowWind_PackOtherState(Buf, InData%OtherSt(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return call InflowWind_PackParam(Buf, InData%p) - if (RegCheckErr(Buf, RoutineName)) return call InflowWind_PackInput(Buf, InData%u) - if (RegCheckErr(Buf, RoutineName)) return call InflowWind_PackOutput(Buf, InData%y) - if (RegCheckErr(Buf, RoutineName)) return call InflowWind_PackMisc(Buf, InData%m) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Output)) if (allocated(InData%Output)) then call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) @@ -9875,9 +9563,7 @@ subroutine FAST_PackInflowWind_Data(Buf, Indata) call InflowWind_PackOutput(Buf, InData%Output(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call InflowWind_PackOutput(Buf, InData%y_interp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) @@ -9887,7 +9573,6 @@ subroutine FAST_PackInflowWind_Data(Buf, Indata) call InflowWind_PackInput(Buf, InData%Input(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) @@ -10018,11 +9703,8 @@ subroutine FAST_PackOpenFOAM_Data(Buf, Indata) character(*), parameter :: RoutineName = 'FAST_PackOpenFOAM_Data' if (Buf%ErrStat >= AbortErrLev) return call OpFM_PackInput(Buf, InData%u) - if (RegCheckErr(Buf, RoutineName)) return call OpFM_PackOutput(Buf, InData%y) - if (RegCheckErr(Buf, RoutineName)) return call OpFM_PackParam(Buf, InData%p) - if (RegCheckErr(Buf, RoutineName)) return call OpFM_PackMisc(Buf, InData%m) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -10077,9 +9759,7 @@ subroutine FAST_PackSCDataEx_Data(Buf, Indata) character(*), parameter :: RoutineName = 'FAST_PackSCDataEx_Data' if (Buf%ErrStat >= AbortErrLev) return call SC_DX_PackInput(Buf, InData%u) - if (RegCheckErr(Buf, RoutineName)) return call SC_DX_PackOutput(Buf, InData%y) - if (RegCheckErr(Buf, RoutineName)) return call SC_DX_PackParam(Buf, InData%p) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -10248,33 +9928,25 @@ subroutine FAST_PackSubDyn_Data(Buf, Indata) do i1 = LB(1), UB(1) call SD_PackContState(Buf, InData%x(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%xd) UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) call SD_PackDiscState(Buf, InData%xd(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%z) UB(1:1) = ubound(InData%z) do i1 = LB(1), UB(1) call SD_PackConstrState(Buf, InData%z(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%OtherSt) UB(1:1) = ubound(InData%OtherSt) do i1 = LB(1), UB(1) call SD_PackOtherState(Buf, InData%OtherSt(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return call SD_PackParam(Buf, InData%p) - if (RegCheckErr(Buf, RoutineName)) return call SD_PackInput(Buf, InData%u) - if (RegCheckErr(Buf, RoutineName)) return call SD_PackOutput(Buf, InData%y) - if (RegCheckErr(Buf, RoutineName)) return call SD_PackMisc(Buf, InData%m) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) @@ -10284,7 +9956,6 @@ subroutine FAST_PackSubDyn_Data(Buf, Indata) call SD_PackInput(Buf, InData%Input(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Output)) if (allocated(InData%Output)) then call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) @@ -10294,9 +9965,7 @@ subroutine FAST_PackSubDyn_Data(Buf, Indata) call SD_PackOutput(Buf, InData%Output(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call SD_PackOutput(Buf, InData%y_interp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) @@ -10509,33 +10178,25 @@ subroutine FAST_PackExtPtfm_Data(Buf, Indata) do i1 = LB(1), UB(1) call ExtPtfm_PackContState(Buf, InData%x(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%xd) UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) call ExtPtfm_PackDiscState(Buf, InData%xd(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%z) UB(1:1) = ubound(InData%z) do i1 = LB(1), UB(1) call ExtPtfm_PackConstrState(Buf, InData%z(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%OtherSt) UB(1:1) = ubound(InData%OtherSt) do i1 = LB(1), UB(1) call ExtPtfm_PackOtherState(Buf, InData%OtherSt(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return call ExtPtfm_PackParam(Buf, InData%p) - if (RegCheckErr(Buf, RoutineName)) return call ExtPtfm_PackInput(Buf, InData%u) - if (RegCheckErr(Buf, RoutineName)) return call ExtPtfm_PackOutput(Buf, InData%y) - if (RegCheckErr(Buf, RoutineName)) return call ExtPtfm_PackMisc(Buf, InData%m) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) @@ -10545,7 +10206,6 @@ subroutine FAST_PackExtPtfm_Data(Buf, Indata) call ExtPtfm_PackInput(Buf, InData%Input(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) @@ -10772,33 +10432,25 @@ subroutine FAST_PackSeaState_Data(Buf, Indata) do i1 = LB(1), UB(1) call SeaSt_PackContState(Buf, InData%x(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%xd) UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) call SeaSt_PackDiscState(Buf, InData%xd(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%z) UB(1:1) = ubound(InData%z) do i1 = LB(1), UB(1) call SeaSt_PackConstrState(Buf, InData%z(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%OtherSt) UB(1:1) = ubound(InData%OtherSt) do i1 = LB(1), UB(1) call SeaSt_PackOtherState(Buf, InData%OtherSt(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return call SeaSt_PackParam(Buf, InData%p) - if (RegCheckErr(Buf, RoutineName)) return call SeaSt_PackInput(Buf, InData%u) - if (RegCheckErr(Buf, RoutineName)) return call SeaSt_PackOutput(Buf, InData%y) - if (RegCheckErr(Buf, RoutineName)) return call SeaSt_PackMisc(Buf, InData%m) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) @@ -10808,7 +10460,6 @@ subroutine FAST_PackSeaState_Data(Buf, Indata) call SeaSt_PackInput(Buf, InData%Input(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Output)) if (allocated(InData%Output)) then call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) @@ -10818,9 +10469,7 @@ subroutine FAST_PackSeaState_Data(Buf, Indata) call SeaSt_PackOutput(Buf, InData%Output(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call SeaSt_PackOutput(Buf, InData%y_interp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) @@ -11063,33 +10712,25 @@ subroutine FAST_PackHydroDyn_Data(Buf, Indata) do i1 = LB(1), UB(1) call HydroDyn_PackContState(Buf, InData%x(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%xd) UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) call HydroDyn_PackDiscState(Buf, InData%xd(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%z) UB(1:1) = ubound(InData%z) do i1 = LB(1), UB(1) call HydroDyn_PackConstrState(Buf, InData%z(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%OtherSt) UB(1:1) = ubound(InData%OtherSt) do i1 = LB(1), UB(1) call HydroDyn_PackOtherState(Buf, InData%OtherSt(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return call HydroDyn_PackParam(Buf, InData%p) - if (RegCheckErr(Buf, RoutineName)) return call HydroDyn_PackInput(Buf, InData%u) - if (RegCheckErr(Buf, RoutineName)) return call HydroDyn_PackOutput(Buf, InData%y) - if (RegCheckErr(Buf, RoutineName)) return call HydroDyn_PackMisc(Buf, InData%m) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Output)) if (allocated(InData%Output)) then call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) @@ -11099,9 +10740,7 @@ subroutine FAST_PackHydroDyn_Data(Buf, Indata) call HydroDyn_PackOutput(Buf, InData%Output(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call HydroDyn_PackOutput(Buf, InData%y_interp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) @@ -11111,7 +10750,6 @@ subroutine FAST_PackHydroDyn_Data(Buf, Indata) call HydroDyn_PackInput(Buf, InData%Input(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) @@ -11324,33 +10962,25 @@ subroutine FAST_PackIceFloe_Data(Buf, Indata) do i1 = LB(1), UB(1) call IceFloe_PackContState(Buf, InData%x(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%xd) UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) call IceFloe_PackDiscState(Buf, InData%xd(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%z) UB(1:1) = ubound(InData%z) do i1 = LB(1), UB(1) call IceFloe_PackConstrState(Buf, InData%z(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%OtherSt) UB(1:1) = ubound(InData%OtherSt) do i1 = LB(1), UB(1) call IceFloe_PackOtherState(Buf, InData%OtherSt(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return call IceFloe_PackParam(Buf, InData%p) - if (RegCheckErr(Buf, RoutineName)) return call IceFloe_PackInput(Buf, InData%u) - if (RegCheckErr(Buf, RoutineName)) return call IceFloe_PackOutput(Buf, InData%y) - if (RegCheckErr(Buf, RoutineName)) return call IceFloe_PackMisc(Buf, InData%m) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) @@ -11360,7 +10990,6 @@ subroutine FAST_PackIceFloe_Data(Buf, Indata) call IceFloe_PackInput(Buf, InData%Input(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) @@ -11583,29 +11212,21 @@ subroutine FAST_PackMAP_Data(Buf, Indata) do i1 = LB(1), UB(1) call MAP_PackContState(Buf, InData%x(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%xd) UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) call MAP_PackDiscState(Buf, InData%xd(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%z) UB(1:1) = ubound(InData%z) do i1 = LB(1), UB(1) call MAP_PackConstrState(Buf, InData%z(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return call MAP_PackOtherState(Buf, InData%OtherSt) - if (RegCheckErr(Buf, RoutineName)) return call MAP_PackParam(Buf, InData%p) - if (RegCheckErr(Buf, RoutineName)) return call MAP_PackInput(Buf, InData%u) - if (RegCheckErr(Buf, RoutineName)) return call MAP_PackOutput(Buf, InData%y) - if (RegCheckErr(Buf, RoutineName)) return call MAP_PackOtherState(Buf, InData%OtherSt_old) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Output)) if (allocated(InData%Output)) then call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) @@ -11615,9 +11236,7 @@ subroutine FAST_PackMAP_Data(Buf, Indata) call MAP_PackOutput(Buf, InData%Output(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call MAP_PackOutput(Buf, InData%y_interp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) @@ -11627,7 +11246,6 @@ subroutine FAST_PackMAP_Data(Buf, Indata) call MAP_PackInput(Buf, InData%Input(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) @@ -11836,33 +11454,25 @@ subroutine FAST_PackFEAMooring_Data(Buf, Indata) do i1 = LB(1), UB(1) call FEAM_PackContState(Buf, InData%x(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%xd) UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) call FEAM_PackDiscState(Buf, InData%xd(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%z) UB(1:1) = ubound(InData%z) do i1 = LB(1), UB(1) call FEAM_PackConstrState(Buf, InData%z(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%OtherSt) UB(1:1) = ubound(InData%OtherSt) do i1 = LB(1), UB(1) call FEAM_PackOtherState(Buf, InData%OtherSt(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return call FEAM_PackParam(Buf, InData%p) - if (RegCheckErr(Buf, RoutineName)) return call FEAM_PackInput(Buf, InData%u) - if (RegCheckErr(Buf, RoutineName)) return call FEAM_PackOutput(Buf, InData%y) - if (RegCheckErr(Buf, RoutineName)) return call FEAM_PackMisc(Buf, InData%m) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) @@ -11872,7 +11482,6 @@ subroutine FAST_PackFEAMooring_Data(Buf, Indata) call FEAM_PackInput(Buf, InData%Input(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) @@ -12099,33 +11708,25 @@ subroutine FAST_PackMoorDyn_Data(Buf, Indata) do i1 = LB(1), UB(1) call MD_PackContState(Buf, InData%x(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%xd) UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) call MD_PackDiscState(Buf, InData%xd(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%z) UB(1:1) = ubound(InData%z) do i1 = LB(1), UB(1) call MD_PackConstrState(Buf, InData%z(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%OtherSt) UB(1:1) = ubound(InData%OtherSt) do i1 = LB(1), UB(1) call MD_PackOtherState(Buf, InData%OtherSt(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return call MD_PackParam(Buf, InData%p) - if (RegCheckErr(Buf, RoutineName)) return call MD_PackInput(Buf, InData%u) - if (RegCheckErr(Buf, RoutineName)) return call MD_PackOutput(Buf, InData%y) - if (RegCheckErr(Buf, RoutineName)) return call MD_PackMisc(Buf, InData%m) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Output)) if (allocated(InData%Output)) then call RegPackBounds(Buf, 1, lbound(InData%Output), ubound(InData%Output)) @@ -12135,9 +11736,7 @@ subroutine FAST_PackMoorDyn_Data(Buf, Indata) call MD_PackOutput(Buf, InData%Output(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call MD_PackOutput(Buf, InData%y_interp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) @@ -12147,7 +11746,6 @@ subroutine FAST_PackMoorDyn_Data(Buf, Indata) call MD_PackInput(Buf, InData%Input(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) @@ -12360,33 +11958,25 @@ subroutine FAST_PackOrcaFlex_Data(Buf, Indata) do i1 = LB(1), UB(1) call Orca_PackContState(Buf, InData%x(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%xd) UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) call Orca_PackDiscState(Buf, InData%xd(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%z) UB(1:1) = ubound(InData%z) do i1 = LB(1), UB(1) call Orca_PackConstrState(Buf, InData%z(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return LB(1:1) = lbound(InData%OtherSt) UB(1:1) = ubound(InData%OtherSt) do i1 = LB(1), UB(1) call Orca_PackOtherState(Buf, InData%OtherSt(i1)) end do - if (RegCheckErr(Buf, RoutineName)) return call Orca_PackParam(Buf, InData%p) - if (RegCheckErr(Buf, RoutineName)) return call Orca_PackInput(Buf, InData%u) - if (RegCheckErr(Buf, RoutineName)) return call Orca_PackOutput(Buf, InData%y) - if (RegCheckErr(Buf, RoutineName)) return call Orca_PackMisc(Buf, InData%m) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Input)) if (allocated(InData%Input)) then call RegPackBounds(Buf, 1, lbound(InData%Input), ubound(InData%Input)) @@ -12396,7 +11986,6 @@ subroutine FAST_PackOrcaFlex_Data(Buf, Indata) call Orca_PackInput(Buf, InData%Input(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%InputTimes)) if (allocated(InData%InputTimes)) then call RegPackBounds(Buf, 1, lbound(InData%InputTimes), ubound(InData%InputTimes)) @@ -13303,7 +12892,6 @@ subroutine FAST_PackModuleMapType(Buf, Indata) call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_BD_P(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BD_P_2_ED_P)) if (allocated(InData%BD_P_2_ED_P)) then call RegPackBounds(Buf, 1, lbound(InData%BD_P_2_ED_P), ubound(InData%BD_P_2_ED_P)) @@ -13313,7 +12901,6 @@ subroutine FAST_PackModuleMapType(Buf, Indata) call NWTC_Library_PackMeshMapType(Buf, InData%BD_P_2_ED_P(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ED_P_2_BD_P_Hub)) if (allocated(InData%ED_P_2_BD_P_Hub)) then call RegPackBounds(Buf, 1, lbound(InData%ED_P_2_BD_P_Hub), ubound(InData%ED_P_2_BD_P_Hub)) @@ -13323,25 +12910,15 @@ subroutine FAST_PackModuleMapType(Buf, Indata) call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_BD_P_Hub(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_HD_PRP_P) - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackMeshMapType(Buf, InData%SubStructure_2_HD_W_P) - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackMeshMapType(Buf, InData%HD_W_P_2_SubStructure) - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackMeshMapType(Buf, InData%SubStructure_2_HD_M_P) - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackMeshMapType(Buf, InData%HD_M_P_2_SubStructure) - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackMeshMapType(Buf, InData%Structure_2_Mooring) - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackMeshMapType(Buf, InData%Mooring_2_Structure) - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_SD_TP) - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackMeshMapType(Buf, InData%SD_TP_2_ED_P) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ED_P_2_NStC_P_N)) if (allocated(InData%ED_P_2_NStC_P_N)) then call RegPackBounds(Buf, 1, lbound(InData%ED_P_2_NStC_P_N), ubound(InData%ED_P_2_NStC_P_N)) @@ -13351,7 +12928,6 @@ subroutine FAST_PackModuleMapType(Buf, Indata) call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_NStC_P_N(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%NStC_P_2_ED_P_N)) if (allocated(InData%NStC_P_2_ED_P_N)) then call RegPackBounds(Buf, 1, lbound(InData%NStC_P_2_ED_P_N), ubound(InData%NStC_P_2_ED_P_N)) @@ -13361,7 +12937,6 @@ subroutine FAST_PackModuleMapType(Buf, Indata) call NWTC_Library_PackMeshMapType(Buf, InData%NStC_P_2_ED_P_N(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ED_L_2_TStC_P_T)) if (allocated(InData%ED_L_2_TStC_P_T)) then call RegPackBounds(Buf, 1, lbound(InData%ED_L_2_TStC_P_T), ubound(InData%ED_L_2_TStC_P_T)) @@ -13371,7 +12946,6 @@ subroutine FAST_PackModuleMapType(Buf, Indata) call NWTC_Library_PackMeshMapType(Buf, InData%ED_L_2_TStC_P_T(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TStC_P_2_ED_P_T)) if (allocated(InData%TStC_P_2_ED_P_T)) then call RegPackBounds(Buf, 1, lbound(InData%TStC_P_2_ED_P_T), ubound(InData%TStC_P_2_ED_P_T)) @@ -13381,7 +12955,6 @@ subroutine FAST_PackModuleMapType(Buf, Indata) call NWTC_Library_PackMeshMapType(Buf, InData%TStC_P_2_ED_P_T(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ED_L_2_BStC_P_B)) if (allocated(InData%ED_L_2_BStC_P_B)) then call RegPackBounds(Buf, 2, lbound(InData%ED_L_2_BStC_P_B), ubound(InData%ED_L_2_BStC_P_B)) @@ -13393,7 +12966,6 @@ subroutine FAST_PackModuleMapType(Buf, Indata) end do end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BStC_P_2_ED_P_B)) if (allocated(InData%BStC_P_2_ED_P_B)) then call RegPackBounds(Buf, 2, lbound(InData%BStC_P_2_ED_P_B), ubound(InData%BStC_P_2_ED_P_B)) @@ -13405,7 +12977,6 @@ subroutine FAST_PackModuleMapType(Buf, Indata) end do end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BD_L_2_BStC_P_B)) if (allocated(InData%BD_L_2_BStC_P_B)) then call RegPackBounds(Buf, 2, lbound(InData%BD_L_2_BStC_P_B), ubound(InData%BD_L_2_BStC_P_B)) @@ -13417,7 +12988,6 @@ subroutine FAST_PackModuleMapType(Buf, Indata) end do end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BStC_P_2_BD_P_B)) if (allocated(InData%BStC_P_2_BD_P_B)) then call RegPackBounds(Buf, 2, lbound(InData%BStC_P_2_BD_P_B), ubound(InData%BStC_P_2_BD_P_B)) @@ -13429,7 +12999,6 @@ subroutine FAST_PackModuleMapType(Buf, Indata) end do end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%SStC_P_P_2_SubStructure)) if (allocated(InData%SStC_P_P_2_SubStructure)) then call RegPackBounds(Buf, 1, lbound(InData%SStC_P_P_2_SubStructure), ubound(InData%SStC_P_P_2_SubStructure)) @@ -13439,7 +13008,6 @@ subroutine FAST_PackModuleMapType(Buf, Indata) call NWTC_Library_PackMeshMapType(Buf, InData%SStC_P_P_2_SubStructure(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%SubStructure_2_SStC_P_P)) if (allocated(InData%SubStructure_2_SStC_P_P)) then call RegPackBounds(Buf, 1, lbound(InData%SubStructure_2_SStC_P_P), ubound(InData%SubStructure_2_SStC_P_P)) @@ -13449,9 +13017,7 @@ subroutine FAST_PackModuleMapType(Buf, Indata) call NWTC_Library_PackMeshMapType(Buf, InData%SubStructure_2_SStC_P_P(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_SrvD_P_P) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BDED_L_2_AD_L_B)) if (allocated(InData%BDED_L_2_AD_L_B)) then call RegPackBounds(Buf, 1, lbound(InData%BDED_L_2_AD_L_B), ubound(InData%BDED_L_2_AD_L_B)) @@ -13461,7 +13027,6 @@ subroutine FAST_PackModuleMapType(Buf, Indata) call NWTC_Library_PackMeshMapType(Buf, InData%BDED_L_2_AD_L_B(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AD_L_2_BDED_B)) if (allocated(InData%AD_L_2_BDED_B)) then call RegPackBounds(Buf, 1, lbound(InData%AD_L_2_BDED_B), ubound(InData%AD_L_2_BDED_B)) @@ -13471,7 +13036,6 @@ subroutine FAST_PackModuleMapType(Buf, Indata) call NWTC_Library_PackMeshMapType(Buf, InData%AD_L_2_BDED_B(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BD_L_2_BD_L)) if (allocated(InData%BD_L_2_BD_L)) then call RegPackBounds(Buf, 1, lbound(InData%BD_L_2_BD_L), ubound(InData%BD_L_2_BD_L)) @@ -13481,19 +13045,12 @@ subroutine FAST_PackModuleMapType(Buf, Indata) call NWTC_Library_PackMeshMapType(Buf, InData%BD_L_2_BD_L(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_AD_P_N) - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackMeshMapType(Buf, InData%AD_P_2_ED_P_N) - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_AD_P_TF) - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackMeshMapType(Buf, InData%AD_P_2_ED_P_TF) - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackMeshMapType(Buf, InData%ED_L_2_AD_L_T) - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackMeshMapType(Buf, InData%AD_L_2_ED_P_T) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ED_P_2_AD_P_R)) if (allocated(InData%ED_P_2_AD_P_R)) then call RegPackBounds(Buf, 1, lbound(InData%ED_P_2_AD_P_R), ubound(InData%ED_P_2_AD_P_R)) @@ -13503,15 +13060,10 @@ subroutine FAST_PackModuleMapType(Buf, Indata) call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_AD_P_R(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackMeshMapType(Buf, InData%ED_P_2_AD_P_H) - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackMeshMapType(Buf, InData%AD_P_2_ED_P_H) - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackMeshMapType(Buf, InData%IceF_P_2_SD_P) - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackMeshMapType(Buf, InData%SDy3_P_2_IceF_P) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%IceD_P_2_SD_P)) if (allocated(InData%IceD_P_2_SD_P)) then call RegPackBounds(Buf, 1, lbound(InData%IceD_P_2_SD_P), ubound(InData%IceD_P_2_SD_P)) @@ -13521,7 +13073,6 @@ subroutine FAST_PackModuleMapType(Buf, Indata) call NWTC_Library_PackMeshMapType(Buf, InData%IceD_P_2_SD_P(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%SDy3_P_2_IceD_P)) if (allocated(InData%SDy3_P_2_IceD_P)) then call RegPackBounds(Buf, 1, lbound(InData%SDy3_P_2_IceD_P), ubound(InData%SDy3_P_2_IceD_P)) @@ -13531,39 +13082,28 @@ subroutine FAST_PackModuleMapType(Buf, Indata) call NWTC_Library_PackMeshMapType(Buf, InData%SDy3_P_2_IceD_P(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Jacobian_Opt1)) if (allocated(InData%Jacobian_Opt1)) then call RegPackBounds(Buf, 2, lbound(InData%Jacobian_Opt1), ubound(InData%Jacobian_Opt1)) call RegPack(Buf, InData%Jacobian_Opt1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Jacobian_pivot)) if (allocated(InData%Jacobian_pivot)) then call RegPackBounds(Buf, 1, lbound(InData%Jacobian_pivot), ubound(InData%Jacobian_pivot)) call RegPack(Buf, InData%Jacobian_pivot) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Jac_u_indx)) if (allocated(InData%Jac_u_indx)) then call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx), ubound(InData%Jac_u_indx)) call RegPack(Buf, InData%Jac_u_indx) end if - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%u_ED_NacelleLoads) - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%SubstructureLoads_Tmp) - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%SubstructureLoads_Tmp2) - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%PlatformLoads_Tmp) - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%PlatformLoads_Tmp2) - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%SubstructureLoads_Tmp_Farm) - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%u_ED_TowerPtloads) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%u_ED_BladePtLoads)) if (allocated(InData%u_ED_BladePtLoads)) then call RegPackBounds(Buf, 1, lbound(InData%u_ED_BladePtLoads), ubound(InData%u_ED_BladePtLoads)) @@ -13573,17 +13113,11 @@ subroutine FAST_PackModuleMapType(Buf, Indata) call MeshPack(Buf, InData%u_ED_BladePtLoads(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%u_SD_TPMesh) - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%u_HD_M_Mesh) - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%u_HD_W_Mesh) - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%u_ED_HubPtLoad) - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%u_ED_HubPtLoad_2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%u_BD_RootMotion)) if (allocated(InData%u_BD_RootMotion)) then call RegPackBounds(Buf, 1, lbound(InData%u_BD_RootMotion), ubound(InData%u_BD_RootMotion)) @@ -13593,7 +13127,6 @@ subroutine FAST_PackModuleMapType(Buf, Indata) call MeshPack(Buf, InData%u_BD_RootMotion(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%y_BD_BldMotion_4Loads)) if (allocated(InData%y_BD_BldMotion_4Loads)) then call RegPackBounds(Buf, 1, lbound(InData%y_BD_BldMotion_4Loads), ubound(InData%y_BD_BldMotion_4Loads)) @@ -13603,7 +13136,6 @@ subroutine FAST_PackModuleMapType(Buf, Indata) call MeshPack(Buf, InData%y_BD_BldMotion_4Loads(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%u_BD_Distrload)) if (allocated(InData%u_BD_Distrload)) then call RegPackBounds(Buf, 1, lbound(InData%u_BD_Distrload), ubound(InData%u_BD_Distrload)) @@ -13613,9 +13145,7 @@ subroutine FAST_PackModuleMapType(Buf, Indata) call MeshPack(Buf, InData%u_BD_Distrload(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%u_Orca_PtfmMesh) - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%u_ExtPtfm_PtfmMesh) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -14096,23 +13626,14 @@ subroutine FAST_PackExternInputType(Buf, Indata) character(*), parameter :: RoutineName = 'FAST_PackExternInputType' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%GenTrq) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ElecPwr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YawPosCom) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YawRateCom) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BlPitchCom) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BlAirfoilCom) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HSSBrFrac) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LidarFocus) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CableDeltaL) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CableDeltaLdot) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -14189,25 +13710,15 @@ subroutine FAST_PackMisc(Buf, Indata) character(*), parameter :: RoutineName = 'FAST_PackMisc' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%TiLstPrn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%t_global) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NextJacCalcTime) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PrevClockTime) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UsrTime1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UsrTime2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StrtTime) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SimStrtTime) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%calcJacobian) - if (RegCheckErr(Buf, RoutineName)) return call FAST_PackExternInputType(Buf, InData%ExternInput) - if (RegCheckErr(Buf, RoutineName)) return call FAST_PackMiscLinType(Buf, InData%Lin) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -14401,11 +13912,8 @@ subroutine FAST_PackInitData(Buf, Indata) integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call ED_PackInitInput(Buf, InData%InData_ED) - if (RegCheckErr(Buf, RoutineName)) return call ED_PackInitOutput(Buf, InData%OutData_ED) - if (RegCheckErr(Buf, RoutineName)) return call BD_PackInitInput(Buf, InData%InData_BD) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OutData_BD)) if (allocated(InData%OutData_BD)) then call RegPackBounds(Buf, 1, lbound(InData%OutData_BD), ubound(InData%OutData_BD)) @@ -14415,65 +13923,35 @@ subroutine FAST_PackInitData(Buf, Indata) call BD_PackInitOutput(Buf, InData%OutData_BD(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call SrvD_PackInitInput(Buf, InData%InData_SrvD) - if (RegCheckErr(Buf, RoutineName)) return call SrvD_PackInitOutput(Buf, InData%OutData_SrvD) - if (RegCheckErr(Buf, RoutineName)) return call AD14_PackInitInput(Buf, InData%InData_AD14) - if (RegCheckErr(Buf, RoutineName)) return call AD14_PackInitOutput(Buf, InData%OutData_AD14) - if (RegCheckErr(Buf, RoutineName)) return call AD_PackInitInput(Buf, InData%InData_AD) - if (RegCheckErr(Buf, RoutineName)) return call AD_PackInitOutput(Buf, InData%OutData_AD) - if (RegCheckErr(Buf, RoutineName)) return call InflowWind_PackInitInput(Buf, InData%InData_IfW) - if (RegCheckErr(Buf, RoutineName)) return call InflowWind_PackInitOutput(Buf, InData%OutData_IfW) - if (RegCheckErr(Buf, RoutineName)) return call OpFM_PackInitInput(Buf, InData%InData_OpFM) - if (RegCheckErr(Buf, RoutineName)) return call OpFM_PackInitOutput(Buf, InData%OutData_OpFM) - if (RegCheckErr(Buf, RoutineName)) return call SeaSt_PackInitInput(Buf, InData%InData_SeaSt) - if (RegCheckErr(Buf, RoutineName)) return call SeaSt_PackInitOutput(Buf, InData%OutData_SeaSt) - if (RegCheckErr(Buf, RoutineName)) return call HydroDyn_PackInitInput(Buf, InData%InData_HD) - if (RegCheckErr(Buf, RoutineName)) return call HydroDyn_PackInitOutput(Buf, InData%OutData_HD) - if (RegCheckErr(Buf, RoutineName)) return call SD_PackInitInput(Buf, InData%InData_SD) - if (RegCheckErr(Buf, RoutineName)) return call SD_PackInitOutput(Buf, InData%OutData_SD) - if (RegCheckErr(Buf, RoutineName)) return call ExtPtfm_PackInitInput(Buf, InData%InData_ExtPtfm) - if (RegCheckErr(Buf, RoutineName)) return call ExtPtfm_PackInitOutput(Buf, InData%OutData_ExtPtfm) - if (RegCheckErr(Buf, RoutineName)) return call MAP_PackInitInput(Buf, InData%InData_MAP) - if (RegCheckErr(Buf, RoutineName)) return call MAP_PackInitOutput(Buf, InData%OutData_MAP) - if (RegCheckErr(Buf, RoutineName)) return call FEAM_PackInitInput(Buf, InData%InData_FEAM) - if (RegCheckErr(Buf, RoutineName)) return call FEAM_PackInitOutput(Buf, InData%OutData_FEAM) - if (RegCheckErr(Buf, RoutineName)) return call MD_PackInitInput(Buf, InData%InData_MD) - if (RegCheckErr(Buf, RoutineName)) return call MD_PackInitOutput(Buf, InData%OutData_MD) - if (RegCheckErr(Buf, RoutineName)) return call Orca_PackInitInput(Buf, InData%InData_Orca) - if (RegCheckErr(Buf, RoutineName)) return call Orca_PackInitOutput(Buf, InData%OutData_Orca) - if (RegCheckErr(Buf, RoutineName)) return call IceFloe_PackInitInput(Buf, InData%InData_IceF) - if (RegCheckErr(Buf, RoutineName)) return call IceFloe_PackInitOutput(Buf, InData%OutData_IceF) - if (RegCheckErr(Buf, RoutineName)) return call IceD_PackInitInput(Buf, InData%InData_IceD) - if (RegCheckErr(Buf, RoutineName)) return call IceD_PackInitOutput(Buf, InData%OutData_IceD) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -14619,43 +14097,28 @@ subroutine FAST_PackExternInitType(Buf, Indata) logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%Tmax) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SensorType) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LidRadialVel) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TurbineID) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TurbinePos) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveFieldMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumSC2CtrlGlob) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumSC2Ctrl) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumCtrl2SC) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%fromSCGlob)) if (allocated(InData%fromSCGlob)) then call RegPackBounds(Buf, 1, lbound(InData%fromSCGlob), ubound(InData%fromSCGlob)) call RegPack(Buf, InData%fromSCGlob) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%fromSC)) if (allocated(InData%fromSC)) then call RegPackBounds(Buf, 1, lbound(InData%fromSC), ubound(InData%fromSC)) call RegPack(Buf, InData%fromSC) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FarmIntegration) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%windGrid_n) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%windGrid_delta) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%windGrid_pZero) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%windGrid_data)) if (associated(InData%windGrid_data)) then call RegPackBounds(Buf, 5, lbound(InData%windGrid_data), ubound(InData%windGrid_data)) @@ -14664,13 +14127,9 @@ subroutine FAST_PackExternInitType(Buf, Indata) call RegPack(Buf, InData%windGrid_data) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RootName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumActForcePtsBlade) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumActForcePtsTower) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NodeClusterType) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -14870,49 +14329,27 @@ subroutine FAST_PackTurbineType(Buf, Indata) character(*), parameter :: RoutineName = 'FAST_PackTurbineType' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%TurbID) - if (RegCheckErr(Buf, RoutineName)) return call FAST_PackParam(Buf, InData%p_FAST) - if (RegCheckErr(Buf, RoutineName)) return call FAST_PackOutputFileType(Buf, InData%y_FAST) - if (RegCheckErr(Buf, RoutineName)) return call FAST_PackMisc(Buf, InData%m_FAST) - if (RegCheckErr(Buf, RoutineName)) return call FAST_PackModuleMapType(Buf, InData%MeshMapData) - if (RegCheckErr(Buf, RoutineName)) return call FAST_PackElastoDyn_Data(Buf, InData%ED) - if (RegCheckErr(Buf, RoutineName)) return call FAST_PackBeamDyn_Data(Buf, InData%BD) - if (RegCheckErr(Buf, RoutineName)) return call FAST_PackServoDyn_Data(Buf, InData%SrvD) - if (RegCheckErr(Buf, RoutineName)) return call FAST_PackAeroDyn_Data(Buf, InData%AD) - if (RegCheckErr(Buf, RoutineName)) return call FAST_PackAeroDyn14_Data(Buf, InData%AD14) - if (RegCheckErr(Buf, RoutineName)) return call FAST_PackInflowWind_Data(Buf, InData%IfW) - if (RegCheckErr(Buf, RoutineName)) return call FAST_PackOpenFOAM_Data(Buf, InData%OpFM) - if (RegCheckErr(Buf, RoutineName)) return call FAST_PackSCDataEx_Data(Buf, InData%SC_DX) - if (RegCheckErr(Buf, RoutineName)) return call FAST_PackSeaState_Data(Buf, InData%SeaSt) - if (RegCheckErr(Buf, RoutineName)) return call FAST_PackHydroDyn_Data(Buf, InData%HD) - if (RegCheckErr(Buf, RoutineName)) return call FAST_PackSubDyn_Data(Buf, InData%SD) - if (RegCheckErr(Buf, RoutineName)) return call FAST_PackMAP_Data(Buf, InData%MAP) - if (RegCheckErr(Buf, RoutineName)) return call FAST_PackFEAMooring_Data(Buf, InData%FEAM) - if (RegCheckErr(Buf, RoutineName)) return call FAST_PackMoorDyn_Data(Buf, InData%MD) - if (RegCheckErr(Buf, RoutineName)) return call FAST_PackOrcaFlex_Data(Buf, InData%Orca) - if (RegCheckErr(Buf, RoutineName)) return call FAST_PackIceFloe_Data(Buf, InData%IceF) - if (RegCheckErr(Buf, RoutineName)) return call FAST_PackIceDyn_Data(Buf, InData%IceD) - if (RegCheckErr(Buf, RoutineName)) return call FAST_PackExtPtfm_Data(Buf, InData%ExtPtfm) if (RegCheckErr(Buf, RoutineName)) return end subroutine diff --git a/modules/openfast-registry/src/registry_gen_fortran.cpp b/modules/openfast-registry/src/registry_gen_fortran.cpp index 1428cd4a9d..f6318f04a5 100644 --- a/modules/openfast-registry/src/registry_gen_fortran.cpp +++ b/modules/openfast-registry/src/registry_gen_fortran.cpp @@ -435,12 +435,15 @@ void gen_copy(std::ostream &w, const Module &mod, const DataType::Derived &ddt, } } - // close IF (check on allocatable array) + // End if for source is allocated/associated + // If source is not allocated/associated, but destination is allocated if (field.is_allocatable) { indent.erase(indent.size() - 3); w << indent << "else if (" << alloc_assoc << "(" << dst << ")) then"; w << indent << " deallocate(" << dst << ")"; + if (field.is_pointer) + w << indent << " nullify(" << dst << ")"; w << indent << "end if"; } } @@ -695,10 +698,10 @@ void gen_pack(std::ostream &w, const Module &mod, const DataType::Derived &ddt, indent.erase(indent.size() - 3); w << indent << "end if"; } - - // Check for errors after packing each variable - w << indent << "if (RegCheckErr(Buf, RoutineName)) return"; } + + // Check for pack errors at end of routine + w << indent << "if (RegCheckErr(Buf, RoutineName)) return"; indent.erase(indent.size() - 3); w << indent << "end subroutine"; diff --git a/modules/openfoam/src/OpenFOAM_Types.f90 b/modules/openfoam/src/OpenFOAM_Types.f90 index b6e27e5cfc..17ced255af 100644 --- a/modules/openfoam/src/OpenFOAM_Types.f90 +++ b/modules/openfoam/src/OpenFOAM_Types.f90 @@ -234,6 +234,7 @@ subroutine OpFM_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%StructBldRNodes = SrcInitInputData%StructBldRNodes else if (associated(DstInitInputData%StructBldRNodes)) then deallocate(DstInitInputData%StructBldRNodes) + nullify(DstInitInputData%StructBldRNodes) end if if (associated(SrcInitInputData%StructTwrHNodes)) then LB(1:1) = lbound(SrcInitInputData%StructTwrHNodes) @@ -251,6 +252,7 @@ subroutine OpFM_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%StructTwrHNodes = SrcInitInputData%StructTwrHNodes else if (associated(DstInitInputData%StructTwrHNodes)) then deallocate(DstInitInputData%StructTwrHNodes) + nullify(DstInitInputData%StructTwrHNodes) end if DstInitInputData%BladeLength = SrcInitInputData%BladeLength DstInitInputData%C_obj%BladeLength = SrcInitInputData%C_obj%BladeLength @@ -294,9 +296,7 @@ subroutine OpFM_PackInitInput(Buf, Indata) return end if call RegPack(Buf, InData%NumActForcePtsBlade) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumActForcePtsTower) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%StructBldRNodes)) if (associated(InData%StructBldRNodes)) then call RegPackBounds(Buf, 1, lbound(InData%StructBldRNodes), ubound(InData%StructBldRNodes)) @@ -305,7 +305,6 @@ subroutine OpFM_PackInitInput(Buf, Indata) call RegPack(Buf, InData%StructBldRNodes) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%StructTwrHNodes)) if (associated(InData%StructTwrHNodes)) then call RegPackBounds(Buf, 1, lbound(InData%StructTwrHNodes), ubound(InData%StructTwrHNodes)) @@ -314,13 +313,9 @@ subroutine OpFM_PackInitInput(Buf, Indata) call RegPack(Buf, InData%StructTwrHNodes) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BladeLength) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TowerHeight) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TowerBaseHeight) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NodeClusterType) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -571,13 +566,11 @@ subroutine OpFM_PackInitOutput(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) call RegPack(Buf, InData%WriteOutputHdr) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) call RegPack(Buf, InData%WriteOutputUnt) end if - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackProgDesc(Buf, InData%Ver) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -811,7 +804,6 @@ subroutine OpFM_PackMisc(Buf, Indata) call MeshPack(Buf, InData%ActForceMotionsPoints(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ActForceLoadsPoints)) if (allocated(InData%ActForceLoadsPoints)) then call RegPackBounds(Buf, 1, lbound(InData%ActForceLoadsPoints), ubound(InData%ActForceLoadsPoints)) @@ -821,7 +813,6 @@ subroutine OpFM_PackMisc(Buf, Indata) call MeshPack(Buf, InData%ActForceLoadsPoints(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Line2_to_Point_Loads)) if (allocated(InData%Line2_to_Point_Loads)) then call RegPackBounds(Buf, 1, lbound(InData%Line2_to_Point_Loads), ubound(InData%Line2_to_Point_Loads)) @@ -831,7 +822,6 @@ subroutine OpFM_PackMisc(Buf, Indata) call NWTC_Library_PackMeshMapType(Buf, InData%Line2_to_Point_Loads(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Line2_to_Point_Motions)) if (allocated(InData%Line2_to_Point_Motions)) then call RegPackBounds(Buf, 1, lbound(InData%Line2_to_Point_Motions), ubound(InData%Line2_to_Point_Motions)) @@ -990,6 +980,7 @@ subroutine OpFM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%forceBldRnodes = SrcParamData%forceBldRnodes else if (associated(DstParamData%forceBldRnodes)) then deallocate(DstParamData%forceBldRnodes) + nullify(DstParamData%forceBldRnodes) end if if (associated(SrcParamData%forceTwrHnodes)) then LB(1:1) = lbound(SrcParamData%forceTwrHnodes) @@ -1007,6 +998,7 @@ subroutine OpFM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%forceTwrHnodes = SrcParamData%forceTwrHnodes else if (associated(DstParamData%forceTwrHnodes)) then deallocate(DstParamData%forceTwrHnodes) + nullify(DstParamData%forceTwrHnodes) end if DstParamData%BladeLength = SrcParamData%BladeLength DstParamData%C_obj%BladeLength = SrcParamData%C_obj%BladeLength @@ -1050,19 +1042,12 @@ subroutine OpFM_PackParam(Buf, Indata) return end if call RegPack(Buf, InData%AirDens) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumBl) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NMappings) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NnodesVel) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NnodesForce) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NnodesForceBlade) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NnodesForceTower) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%forceBldRnodes)) if (associated(InData%forceBldRnodes)) then call RegPackBounds(Buf, 1, lbound(InData%forceBldRnodes), ubound(InData%forceBldRnodes)) @@ -1071,7 +1056,6 @@ subroutine OpFM_PackParam(Buf, Indata) call RegPack(Buf, InData%forceBldRnodes) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%forceTwrHnodes)) if (associated(InData%forceTwrHnodes)) then call RegPackBounds(Buf, 1, lbound(InData%forceTwrHnodes), ubound(InData%forceTwrHnodes)) @@ -1080,13 +1064,9 @@ subroutine OpFM_PackParam(Buf, Indata) call RegPack(Buf, InData%forceTwrHnodes) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BladeLength) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TowerHeight) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TowerBaseHeight) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NodeClusterType) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1313,6 +1293,7 @@ subroutine OpFM_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%pxVel = SrcInputData%pxVel else if (associated(DstInputData%pxVel)) then deallocate(DstInputData%pxVel) + nullify(DstInputData%pxVel) end if if (associated(SrcInputData%pyVel)) then LB(1:1) = lbound(SrcInputData%pyVel) @@ -1330,6 +1311,7 @@ subroutine OpFM_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%pyVel = SrcInputData%pyVel else if (associated(DstInputData%pyVel)) then deallocate(DstInputData%pyVel) + nullify(DstInputData%pyVel) end if if (associated(SrcInputData%pzVel)) then LB(1:1) = lbound(SrcInputData%pzVel) @@ -1347,6 +1329,7 @@ subroutine OpFM_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%pzVel = SrcInputData%pzVel else if (associated(DstInputData%pzVel)) then deallocate(DstInputData%pzVel) + nullify(DstInputData%pzVel) end if if (associated(SrcInputData%pxForce)) then LB(1:1) = lbound(SrcInputData%pxForce) @@ -1364,6 +1347,7 @@ subroutine OpFM_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%pxForce = SrcInputData%pxForce else if (associated(DstInputData%pxForce)) then deallocate(DstInputData%pxForce) + nullify(DstInputData%pxForce) end if if (associated(SrcInputData%pyForce)) then LB(1:1) = lbound(SrcInputData%pyForce) @@ -1381,6 +1365,7 @@ subroutine OpFM_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%pyForce = SrcInputData%pyForce else if (associated(DstInputData%pyForce)) then deallocate(DstInputData%pyForce) + nullify(DstInputData%pyForce) end if if (associated(SrcInputData%pzForce)) then LB(1:1) = lbound(SrcInputData%pzForce) @@ -1398,6 +1383,7 @@ subroutine OpFM_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%pzForce = SrcInputData%pzForce else if (associated(DstInputData%pzForce)) then deallocate(DstInputData%pzForce) + nullify(DstInputData%pzForce) end if if (associated(SrcInputData%xdotForce)) then LB(1:1) = lbound(SrcInputData%xdotForce) @@ -1415,6 +1401,7 @@ subroutine OpFM_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%xdotForce = SrcInputData%xdotForce else if (associated(DstInputData%xdotForce)) then deallocate(DstInputData%xdotForce) + nullify(DstInputData%xdotForce) end if if (associated(SrcInputData%ydotForce)) then LB(1:1) = lbound(SrcInputData%ydotForce) @@ -1432,6 +1419,7 @@ subroutine OpFM_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%ydotForce = SrcInputData%ydotForce else if (associated(DstInputData%ydotForce)) then deallocate(DstInputData%ydotForce) + nullify(DstInputData%ydotForce) end if if (associated(SrcInputData%zdotForce)) then LB(1:1) = lbound(SrcInputData%zdotForce) @@ -1449,6 +1437,7 @@ subroutine OpFM_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%zdotForce = SrcInputData%zdotForce else if (associated(DstInputData%zdotForce)) then deallocate(DstInputData%zdotForce) + nullify(DstInputData%zdotForce) end if if (associated(SrcInputData%pOrientation)) then LB(1:1) = lbound(SrcInputData%pOrientation) @@ -1466,6 +1455,7 @@ subroutine OpFM_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%pOrientation = SrcInputData%pOrientation else if (associated(DstInputData%pOrientation)) then deallocate(DstInputData%pOrientation) + nullify(DstInputData%pOrientation) end if if (associated(SrcInputData%fx)) then LB(1:1) = lbound(SrcInputData%fx) @@ -1483,6 +1473,7 @@ subroutine OpFM_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%fx = SrcInputData%fx else if (associated(DstInputData%fx)) then deallocate(DstInputData%fx) + nullify(DstInputData%fx) end if if (associated(SrcInputData%fy)) then LB(1:1) = lbound(SrcInputData%fy) @@ -1500,6 +1491,7 @@ subroutine OpFM_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%fy = SrcInputData%fy else if (associated(DstInputData%fy)) then deallocate(DstInputData%fy) + nullify(DstInputData%fy) end if if (associated(SrcInputData%fz)) then LB(1:1) = lbound(SrcInputData%fz) @@ -1517,6 +1509,7 @@ subroutine OpFM_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%fz = SrcInputData%fz else if (associated(DstInputData%fz)) then deallocate(DstInputData%fz) + nullify(DstInputData%fz) end if if (associated(SrcInputData%momentx)) then LB(1:1) = lbound(SrcInputData%momentx) @@ -1534,6 +1527,7 @@ subroutine OpFM_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%momentx = SrcInputData%momentx else if (associated(DstInputData%momentx)) then deallocate(DstInputData%momentx) + nullify(DstInputData%momentx) end if if (associated(SrcInputData%momenty)) then LB(1:1) = lbound(SrcInputData%momenty) @@ -1551,6 +1545,7 @@ subroutine OpFM_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%momenty = SrcInputData%momenty else if (associated(DstInputData%momenty)) then deallocate(DstInputData%momenty) + nullify(DstInputData%momenty) end if if (associated(SrcInputData%momentz)) then LB(1:1) = lbound(SrcInputData%momentz) @@ -1568,6 +1563,7 @@ subroutine OpFM_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%momentz = SrcInputData%momentz else if (associated(DstInputData%momentz)) then deallocate(DstInputData%momentz) + nullify(DstInputData%momentz) end if if (associated(SrcInputData%forceNodesChord)) then LB(1:1) = lbound(SrcInputData%forceNodesChord) @@ -1585,6 +1581,7 @@ subroutine OpFM_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%forceNodesChord = SrcInputData%forceNodesChord else if (associated(DstInputData%forceNodesChord)) then deallocate(DstInputData%forceNodesChord) + nullify(DstInputData%forceNodesChord) end if end subroutine @@ -1717,7 +1714,6 @@ subroutine OpFM_PackInput(Buf, Indata) call RegPack(Buf, InData%pxVel) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%pyVel)) if (associated(InData%pyVel)) then call RegPackBounds(Buf, 1, lbound(InData%pyVel), ubound(InData%pyVel)) @@ -1726,7 +1722,6 @@ subroutine OpFM_PackInput(Buf, Indata) call RegPack(Buf, InData%pyVel) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%pzVel)) if (associated(InData%pzVel)) then call RegPackBounds(Buf, 1, lbound(InData%pzVel), ubound(InData%pzVel)) @@ -1735,7 +1730,6 @@ subroutine OpFM_PackInput(Buf, Indata) call RegPack(Buf, InData%pzVel) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%pxForce)) if (associated(InData%pxForce)) then call RegPackBounds(Buf, 1, lbound(InData%pxForce), ubound(InData%pxForce)) @@ -1744,7 +1738,6 @@ subroutine OpFM_PackInput(Buf, Indata) call RegPack(Buf, InData%pxForce) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%pyForce)) if (associated(InData%pyForce)) then call RegPackBounds(Buf, 1, lbound(InData%pyForce), ubound(InData%pyForce)) @@ -1753,7 +1746,6 @@ subroutine OpFM_PackInput(Buf, Indata) call RegPack(Buf, InData%pyForce) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%pzForce)) if (associated(InData%pzForce)) then call RegPackBounds(Buf, 1, lbound(InData%pzForce), ubound(InData%pzForce)) @@ -1762,7 +1754,6 @@ subroutine OpFM_PackInput(Buf, Indata) call RegPack(Buf, InData%pzForce) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%xdotForce)) if (associated(InData%xdotForce)) then call RegPackBounds(Buf, 1, lbound(InData%xdotForce), ubound(InData%xdotForce)) @@ -1771,7 +1762,6 @@ subroutine OpFM_PackInput(Buf, Indata) call RegPack(Buf, InData%xdotForce) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%ydotForce)) if (associated(InData%ydotForce)) then call RegPackBounds(Buf, 1, lbound(InData%ydotForce), ubound(InData%ydotForce)) @@ -1780,7 +1770,6 @@ subroutine OpFM_PackInput(Buf, Indata) call RegPack(Buf, InData%ydotForce) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%zdotForce)) if (associated(InData%zdotForce)) then call RegPackBounds(Buf, 1, lbound(InData%zdotForce), ubound(InData%zdotForce)) @@ -1789,7 +1778,6 @@ subroutine OpFM_PackInput(Buf, Indata) call RegPack(Buf, InData%zdotForce) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%pOrientation)) if (associated(InData%pOrientation)) then call RegPackBounds(Buf, 1, lbound(InData%pOrientation), ubound(InData%pOrientation)) @@ -1798,7 +1786,6 @@ subroutine OpFM_PackInput(Buf, Indata) call RegPack(Buf, InData%pOrientation) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%fx)) if (associated(InData%fx)) then call RegPackBounds(Buf, 1, lbound(InData%fx), ubound(InData%fx)) @@ -1807,7 +1794,6 @@ subroutine OpFM_PackInput(Buf, Indata) call RegPack(Buf, InData%fx) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%fy)) if (associated(InData%fy)) then call RegPackBounds(Buf, 1, lbound(InData%fy), ubound(InData%fy)) @@ -1816,7 +1802,6 @@ subroutine OpFM_PackInput(Buf, Indata) call RegPack(Buf, InData%fy) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%fz)) if (associated(InData%fz)) then call RegPackBounds(Buf, 1, lbound(InData%fz), ubound(InData%fz)) @@ -1825,7 +1810,6 @@ subroutine OpFM_PackInput(Buf, Indata) call RegPack(Buf, InData%fz) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%momentx)) if (associated(InData%momentx)) then call RegPackBounds(Buf, 1, lbound(InData%momentx), ubound(InData%momentx)) @@ -1834,7 +1818,6 @@ subroutine OpFM_PackInput(Buf, Indata) call RegPack(Buf, InData%momentx) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%momenty)) if (associated(InData%momenty)) then call RegPackBounds(Buf, 1, lbound(InData%momenty), ubound(InData%momenty)) @@ -1843,7 +1826,6 @@ subroutine OpFM_PackInput(Buf, Indata) call RegPack(Buf, InData%momenty) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%momentz)) if (associated(InData%momentz)) then call RegPackBounds(Buf, 1, lbound(InData%momentz), ubound(InData%momentz)) @@ -1852,7 +1834,6 @@ subroutine OpFM_PackInput(Buf, Indata) call RegPack(Buf, InData%momentz) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%forceNodesChord)) if (associated(InData%forceNodesChord)) then call RegPackBounds(Buf, 1, lbound(InData%forceNodesChord), ubound(InData%forceNodesChord)) @@ -2736,6 +2717,7 @@ subroutine OpFM_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%u = SrcOutputData%u else if (associated(DstOutputData%u)) then deallocate(DstOutputData%u) + nullify(DstOutputData%u) end if if (associated(SrcOutputData%v)) then LB(1:1) = lbound(SrcOutputData%v) @@ -2753,6 +2735,7 @@ subroutine OpFM_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%v = SrcOutputData%v else if (associated(DstOutputData%v)) then deallocate(DstOutputData%v) + nullify(DstOutputData%v) end if if (associated(SrcOutputData%w)) then LB(1:1) = lbound(SrcOutputData%w) @@ -2770,6 +2753,7 @@ subroutine OpFM_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%w = SrcOutputData%w else if (associated(DstOutputData%w)) then deallocate(DstOutputData%w) + nullify(DstOutputData%w) end if if (allocated(SrcOutputData%WriteOutput)) then LB(1:1) = lbound(SrcOutputData%WriteOutput) @@ -2835,7 +2819,6 @@ subroutine OpFM_PackOutput(Buf, Indata) call RegPack(Buf, InData%u) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%v)) if (associated(InData%v)) then call RegPackBounds(Buf, 1, lbound(InData%v), ubound(InData%v)) @@ -2844,7 +2827,6 @@ subroutine OpFM_PackOutput(Buf, Indata) call RegPack(Buf, InData%v) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%w)) if (associated(InData%w)) then call RegPackBounds(Buf, 1, lbound(InData%w), ubound(InData%w)) @@ -2853,7 +2835,6 @@ subroutine OpFM_PackOutput(Buf, Indata) call RegPack(Buf, InData%w) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) diff --git a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 index 3fb5129ada..9af8034551 100644 --- a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 +++ b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 @@ -137,9 +137,7 @@ subroutine Orca_PackInitInput(Buf, Indata) character(*), parameter :: RoutineName = 'Orca_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%InputFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RootName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TMax) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -225,13 +223,11 @@ subroutine Orca_PackInitOutput(Buf, Indata) character(*), parameter :: RoutineName = 'Orca_PackInitOutput' if (Buf%ErrStat >= AbortErrLev) return call NWTC_Library_PackProgDesc(Buf, InData%Ver) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutputHdr)) if (allocated(InData%WriteOutputHdr)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) call RegPack(Buf, InData%WriteOutputHdr) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) @@ -310,13 +306,9 @@ subroutine Orca_PackInputFile(Buf, Indata) character(*), parameter :: RoutineName = 'Orca_PackInputFile' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%DLL_FileName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DLL_InitProcName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DLL_CalcProcName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DLL_EndProcName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DirRoot) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -426,17 +418,13 @@ subroutine Orca_PackMisc(Buf, Indata) character(*), parameter :: RoutineName = 'Orca_PackMisc' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%PtfmAM) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PtfmFt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%F_PtfmAM) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AllOuts)) if (allocated(InData%AllOuts)) then call RegPackBounds(Buf, 1, lbound(InData%AllOuts), ubound(InData%AllOuts)) call RegPack(Buf, InData%AllOuts) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LastTimeStep) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -541,15 +529,10 @@ subroutine Orca_PackParam(Buf, Indata) integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%DT) - if (RegCheckErr(Buf, RoutineName)) return call DLLTypePack(Buf, InData%DLL_Orca) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SimNamePath) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SimNamePathLen) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) @@ -692,7 +675,6 @@ subroutine Orca_PackOutput(Buf, Indata) character(*), parameter :: RoutineName = 'Orca_PackOutput' if (Buf%ErrStat >= AbortErrLev) return call MeshPack(Buf, InData%PtfmMesh) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) diff --git a/modules/seastate/src/Current_Types.f90 b/modules/seastate/src/Current_Types.f90 index 9df0722284..649f62d0e9 100644 --- a/modules/seastate/src/Current_Types.f90 +++ b/modules/seastate/src/Current_Types.f90 @@ -117,33 +117,21 @@ subroutine Current_PackInitInput(Buf, Indata) character(*), parameter :: RoutineName = 'Current_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%CurrSSV0) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CurrSSDirChr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CurrSSDir) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CurrNSRef) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CurrNSV0) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CurrNSDir) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CurrDIV) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CurrDIDir) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CurrMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WtrDpth) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveKinGridzi)) if (allocated(InData%WaveKinGridzi)) then call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridzi), ubound(InData%WaveKinGridzi)) call RegPack(Buf, InData%WaveKinGridzi) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NGridPts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DirRoot) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -264,15 +252,12 @@ subroutine Current_PackInitOutput(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%CurrVxi), ubound(InData%CurrVxi)) call RegPack(Buf, InData%CurrVxi) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CurrVyi)) if (allocated(InData%CurrVyi)) then call RegPackBounds(Buf, 1, lbound(InData%CurrVyi), ubound(InData%CurrVyi)) call RegPack(Buf, InData%CurrVyi) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PCurrVxiPz0) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PCurrVyiPz0) if (RegCheckErr(Buf, RoutineName)) return end subroutine diff --git a/modules/seastate/src/SeaSt_WaveField_Types.f90 b/modules/seastate/src/SeaSt_WaveField_Types.f90 index b45292ec17..17f37ca526 100644 --- a/modules/seastate/src/SeaSt_WaveField_Types.f90 +++ b/modules/seastate/src/SeaSt_WaveField_Types.f90 @@ -355,93 +355,75 @@ subroutine SeaSt_WaveField_PackSeaSt_WaveFieldType(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) call RegPack(Buf, InData%WaveTime) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveDynP)) if (allocated(InData%WaveDynP)) then call RegPackBounds(Buf, 4, lbound(InData%WaveDynP), ubound(InData%WaveDynP)) call RegPack(Buf, InData%WaveDynP) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveAcc)) if (allocated(InData%WaveAcc)) then call RegPackBounds(Buf, 5, lbound(InData%WaveAcc), ubound(InData%WaveAcc)) call RegPack(Buf, InData%WaveAcc) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveAccMCF)) if (allocated(InData%WaveAccMCF)) then call RegPackBounds(Buf, 5, lbound(InData%WaveAccMCF), ubound(InData%WaveAccMCF)) call RegPack(Buf, InData%WaveAccMCF) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveVel)) if (allocated(InData%WaveVel)) then call RegPackBounds(Buf, 5, lbound(InData%WaveVel), ubound(InData%WaveVel)) call RegPack(Buf, InData%WaveVel) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PWaveDynP0)) if (allocated(InData%PWaveDynP0)) then call RegPackBounds(Buf, 3, lbound(InData%PWaveDynP0), ubound(InData%PWaveDynP0)) call RegPack(Buf, InData%PWaveDynP0) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PWaveAcc0)) if (allocated(InData%PWaveAcc0)) then call RegPackBounds(Buf, 4, lbound(InData%PWaveAcc0), ubound(InData%PWaveAcc0)) call RegPack(Buf, InData%PWaveAcc0) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PWaveAccMCF0)) if (allocated(InData%PWaveAccMCF0)) then call RegPackBounds(Buf, 4, lbound(InData%PWaveAccMCF0), ubound(InData%PWaveAccMCF0)) call RegPack(Buf, InData%PWaveAccMCF0) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PWaveVel0)) if (allocated(InData%PWaveVel0)) then call RegPackBounds(Buf, 4, lbound(InData%PWaveVel0), ubound(InData%PWaveVel0)) call RegPack(Buf, InData%PWaveVel0) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveElev0)) if (allocated(InData%WaveElev0)) then call RegPackBounds(Buf, 1, lbound(InData%WaveElev0), ubound(InData%WaveElev0)) call RegPack(Buf, InData%WaveElev0) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveElev1)) if (allocated(InData%WaveElev1)) then call RegPackBounds(Buf, 3, lbound(InData%WaveElev1), ubound(InData%WaveElev1)) call RegPack(Buf, InData%WaveElev1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveElev2)) if (allocated(InData%WaveElev2)) then call RegPackBounds(Buf, 3, lbound(InData%WaveElev2), ubound(InData%WaveElev2)) call RegPack(Buf, InData%WaveElev2) end if - if (RegCheckErr(Buf, RoutineName)) return call SeaSt_Interp_PackParam(Buf, InData%SeaSt_Interp_p) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveStMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%EffWtrDpth) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MSL2SWL) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveElevC)) if (allocated(InData%WaveElevC)) then call RegPackBounds(Buf, 3, lbound(InData%WaveElevC), ubound(InData%WaveElevC)) call RegPack(Buf, InData%WaveElevC) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveElevC0)) if (allocated(InData%WaveElevC0)) then call RegPackBounds(Buf, 2, lbound(InData%WaveElevC0), ubound(InData%WaveElevC0)) call RegPack(Buf, InData%WaveElevC0) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveDirArr)) if (allocated(InData%WaveDirArr)) then call RegPackBounds(Buf, 1, lbound(InData%WaveDirArr), ubound(InData%WaveDirArr)) diff --git a/modules/seastate/src/SeaState_Interp_Types.f90 b/modules/seastate/src/SeaState_Interp_Types.f90 index 35de0cea57..5d927ac472 100644 --- a/modules/seastate/src/SeaState_Interp_Types.f90 +++ b/modules/seastate/src/SeaState_Interp_Types.f90 @@ -95,11 +95,8 @@ subroutine SeaSt_Interp_PackInitInput(Buf, Indata) character(*), parameter :: RoutineName = 'SeaSt_Interp_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%n) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%delta) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%pZero) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Z_Depth) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -194,13 +191,9 @@ subroutine SeaSt_Interp_PackMisc(Buf, Indata) character(*), parameter :: RoutineName = 'SeaSt_Interp_PackMisc' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%N3D) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%N4D) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Indx_Lo) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Indx_Hi) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FirstWarn_Clamp) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -252,11 +245,8 @@ subroutine SeaSt_Interp_PackParam(Buf, Indata) character(*), parameter :: RoutineName = 'SeaSt_Interp_PackParam' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%n) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%delta) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%pZero) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Z_Depth) if (RegCheckErr(Buf, RoutineName)) return end subroutine diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index 83946550cf..f0d60c62b6 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -380,79 +380,54 @@ subroutine SeaSt_PackInputFile(Buf, Indata) character(*), parameter :: RoutineName = 'SeaSt_PackInputFile' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%EchoFlag) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MSL2SWL) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%X_HalfWidth) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Y_HalfWidth) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Z_Depth) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NX) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NY) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NZ) - if (RegCheckErr(Buf, RoutineName)) return call Waves_PackInitInput(Buf, InData%Waves) - if (RegCheckErr(Buf, RoutineName)) return call Waves2_PackInitInput(Buf, InData%Waves2) - if (RegCheckErr(Buf, RoutineName)) return call Current_PackInitInput(Buf, InData%Current) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Echo) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NWaveElev) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveElevxi)) if (allocated(InData%WaveElevxi)) then call RegPackBounds(Buf, 1, lbound(InData%WaveElevxi), ubound(InData%WaveElevxi)) call RegPack(Buf, InData%WaveElevxi) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveElevyi)) if (allocated(InData%WaveElevyi)) then call RegPackBounds(Buf, 1, lbound(InData%WaveElevyi), ubound(InData%WaveElevyi)) call RegPack(Buf, InData%WaveElevyi) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NWaveKin) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveKinxi)) if (allocated(InData%WaveKinxi)) then call RegPackBounds(Buf, 1, lbound(InData%WaveKinxi), ubound(InData%WaveKinxi)) call RegPack(Buf, InData%WaveKinxi) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveKinyi)) if (allocated(InData%WaveKinyi)) then call RegPackBounds(Buf, 1, lbound(InData%WaveKinyi), ubound(InData%WaveKinyi)) call RegPack(Buf, InData%WaveKinyi) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveKinzi)) if (allocated(InData%WaveKinzi)) then call RegPackBounds(Buf, 1, lbound(InData%WaveKinzi), ubound(InData%WaveKinzi)) call RegPack(Buf, InData%WaveKinzi) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutSwtch) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutAll) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OutList)) if (allocated(InData%OutList)) then call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) call RegPack(Buf, InData%OutList) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SeaStSum) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutFmt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutSFmt) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -653,39 +628,24 @@ subroutine SeaSt_PackInitInput(Buf, Indata) character(*), parameter :: RoutineName = 'SeaSt_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%InputFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UseInputFile) - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackFileInfoType(Buf, InData%PassedFileData) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutRootName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Gravity) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%defWtrDens) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%defWtrDpth) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%defMSL2SWL) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TMax) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveElevXY)) if (allocated(InData%WaveElevXY)) then call RegPackBounds(Buf, 2, lbound(InData%WaveElevXY), ubound(InData%WaveElevXY)) call RegPack(Buf, InData%WaveElevXY) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveFieldMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PtfmLocationX) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PtfmLocationY) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WrWvKinMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HasIce) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Linearize) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -890,21 +850,15 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) call RegPack(Buf, InData%WriteOutputHdr) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) call RegPack(Buf, InData%WriteOutputUnt) end if - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackProgDesc(Buf, InData%Ver) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WtrDens) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WtrDpth) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MSL2SWL) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveElevC0)) if (associated(InData%WaveElevC0)) then call RegPackBounds(Buf, 2, lbound(InData%WaveElevC0), ubound(InData%WaveElevC0)) @@ -913,7 +867,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WaveElevC0) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveElevC)) if (associated(InData%WaveElevC)) then call RegPackBounds(Buf, 3, lbound(InData%WaveElevC), ubound(InData%WaveElevC)) @@ -922,7 +875,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WaveElevC) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveDirArr)) if (associated(InData%WaveDirArr)) then call RegPackBounds(Buf, 1, lbound(InData%WaveDirArr), ubound(InData%WaveDirArr)) @@ -931,17 +883,11 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WaveDirArr) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveDirMin) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveDirMax) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveDir) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveMultiDir) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveDOmega) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveDynP)) if (associated(InData%WaveDynP)) then call RegPackBounds(Buf, 4, lbound(InData%WaveDynP), ubound(InData%WaveDynP)) @@ -950,7 +896,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WaveDynP) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveAcc)) if (associated(InData%WaveAcc)) then call RegPackBounds(Buf, 5, lbound(InData%WaveAcc), ubound(InData%WaveAcc)) @@ -959,7 +904,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WaveAcc) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveAccMCF)) if (associated(InData%WaveAccMCF)) then call RegPackBounds(Buf, 5, lbound(InData%WaveAccMCF), ubound(InData%WaveAccMCF)) @@ -968,7 +912,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WaveAccMCF) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveVel)) if (associated(InData%WaveVel)) then call RegPackBounds(Buf, 5, lbound(InData%WaveVel), ubound(InData%WaveVel)) @@ -977,7 +920,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WaveVel) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%PWaveDynP0)) if (associated(InData%PWaveDynP0)) then call RegPackBounds(Buf, 3, lbound(InData%PWaveDynP0), ubound(InData%PWaveDynP0)) @@ -986,7 +928,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%PWaveDynP0) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%PWaveAcc0)) if (associated(InData%PWaveAcc0)) then call RegPackBounds(Buf, 4, lbound(InData%PWaveAcc0), ubound(InData%PWaveAcc0)) @@ -995,7 +936,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%PWaveAcc0) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%PWaveAccMCF0)) if (associated(InData%PWaveAccMCF0)) then call RegPackBounds(Buf, 4, lbound(InData%PWaveAccMCF0), ubound(InData%PWaveAccMCF0)) @@ -1004,7 +944,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%PWaveAccMCF0) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%PWaveVel0)) if (associated(InData%PWaveVel0)) then call RegPackBounds(Buf, 4, lbound(InData%PWaveVel0), ubound(InData%PWaveVel0)) @@ -1013,7 +952,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%PWaveVel0) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveElev1)) if (associated(InData%WaveElev1)) then call RegPackBounds(Buf, 3, lbound(InData%WaveElev1), ubound(InData%WaveElev1)) @@ -1022,7 +960,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WaveElev1) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveElev2)) if (associated(InData%WaveElev2)) then call RegPackBounds(Buf, 3, lbound(InData%WaveElev2), ubound(InData%WaveElev2)) @@ -1031,7 +968,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WaveElev2) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveElev0)) if (associated(InData%WaveElev0)) then call RegPackBounds(Buf, 1, lbound(InData%WaveElev0), ubound(InData%WaveElev0)) @@ -1040,7 +976,6 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WaveElev0) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveTime)) if (associated(InData%WaveTime)) then call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) @@ -1049,43 +984,26 @@ subroutine SeaSt_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WaveTime) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RhoXg) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NStepWave) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NStepWave2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveStMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveDirMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WvLowCOff) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WvHiCOff) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WvLowCOffD) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WvHiCOffD) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WvLowCOffS) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WvHiCOffS) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%InvalidWithSSExctn) - if (RegCheckErr(Buf, RoutineName)) return call SeaSt_Interp_PackParam(Buf, InData%SeaSt_Interp_p) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MCFD) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveElevSeries)) if (allocated(InData%WaveElevSeries)) then call RegPackBounds(Buf, 2, lbound(InData%WaveElevSeries), ubound(InData%WaveElevSeries)) call RegPack(Buf, InData%WaveElevSeries) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveField)) if (associated(InData%WaveField)) then call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) @@ -1768,11 +1686,8 @@ subroutine SeaSt_PackMisc(Buf, Indata) character(*), parameter :: RoutineName = 'SeaSt_PackMisc' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%Decimate) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LastOutTime) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LastIndWave) - if (RegCheckErr(Buf, RoutineName)) return call SeaSt_Interp_PackMisc(Buf, InData%SeaSt_Interp_m) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1944,6 +1859,7 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg if (ErrStat >= AbortErrLev) return else if (associated(DstParamData%WaveField)) then deallocate(DstParamData%WaveField) + nullify(DstParamData%WaveField) end if end subroutine @@ -2012,7 +1928,6 @@ subroutine SeaSt_PackParam(Buf, Indata) logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return call Waves2_PackParam(Buf, InData%Waves2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveTime)) if (associated(InData%WaveTime)) then call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) @@ -2021,37 +1936,25 @@ subroutine SeaSt_PackParam(Buf, Indata) call RegPack(Buf, InData%WaveTime) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveDT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NGridPts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NGrid) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%deltaGrid) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%X_HalfWidth) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Y_HalfWidth) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Z_Depth) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NStepWave) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NWaveElev) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveElevxi)) if (allocated(InData%WaveElevxi)) then call RegPackBounds(Buf, 1, lbound(InData%WaveElevxi), ubound(InData%WaveElevxi)) call RegPack(Buf, InData%WaveElevxi) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveElevyi)) if (allocated(InData%WaveElevyi)) then call RegPackBounds(Buf, 1, lbound(InData%WaveElevyi), ubound(InData%WaveElevyi)) call RegPack(Buf, InData%WaveElevyi) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveElev1)) if (associated(InData%WaveElev1)) then call RegPackBounds(Buf, 3, lbound(InData%WaveElev1), ubound(InData%WaveElev1)) @@ -2060,7 +1963,6 @@ subroutine SeaSt_PackParam(Buf, Indata) call RegPack(Buf, InData%WaveElev1) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveElev2)) if (associated(InData%WaveElev2)) then call RegPackBounds(Buf, 3, lbound(InData%WaveElev2), ubound(InData%WaveElev2)) @@ -2069,7 +1971,6 @@ subroutine SeaSt_PackParam(Buf, Indata) call RegPack(Buf, InData%WaveElev2) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%PWaveDynP0)) if (associated(InData%PWaveDynP0)) then call RegPackBounds(Buf, 3, lbound(InData%PWaveDynP0), ubound(InData%PWaveDynP0)) @@ -2078,7 +1979,6 @@ subroutine SeaSt_PackParam(Buf, Indata) call RegPack(Buf, InData%PWaveDynP0) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveDynP)) if (associated(InData%WaveDynP)) then call RegPackBounds(Buf, 4, lbound(InData%WaveDynP), ubound(InData%WaveDynP)) @@ -2087,7 +1987,6 @@ subroutine SeaSt_PackParam(Buf, Indata) call RegPack(Buf, InData%WaveDynP) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveAcc)) if (associated(InData%WaveAcc)) then call RegPackBounds(Buf, 5, lbound(InData%WaveAcc), ubound(InData%WaveAcc)) @@ -2096,7 +1995,6 @@ subroutine SeaSt_PackParam(Buf, Indata) call RegPack(Buf, InData%WaveAcc) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%PWaveAcc0)) if (associated(InData%PWaveAcc0)) then call RegPackBounds(Buf, 4, lbound(InData%PWaveAcc0), ubound(InData%PWaveAcc0)) @@ -2105,7 +2003,6 @@ subroutine SeaSt_PackParam(Buf, Indata) call RegPack(Buf, InData%PWaveAcc0) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveVel)) if (associated(InData%WaveVel)) then call RegPackBounds(Buf, 5, lbound(InData%WaveVel), ubound(InData%WaveVel)) @@ -2114,7 +2011,6 @@ subroutine SeaSt_PackParam(Buf, Indata) call RegPack(Buf, InData%WaveVel) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%PWaveVel0)) if (associated(InData%PWaveVel0)) then call RegPackBounds(Buf, 4, lbound(InData%PWaveVel0), ubound(InData%PWaveVel0)) @@ -2123,7 +2019,6 @@ subroutine SeaSt_PackParam(Buf, Indata) call RegPack(Buf, InData%PWaveVel0) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveAccMCF)) if (associated(InData%WaveAccMCF)) then call RegPackBounds(Buf, 5, lbound(InData%WaveAccMCF), ubound(InData%WaveAccMCF)) @@ -2132,7 +2027,6 @@ subroutine SeaSt_PackParam(Buf, Indata) call RegPack(Buf, InData%WaveAccMCF) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveDirArr)) if (associated(InData%WaveDirArr)) then call RegPackBounds(Buf, 1, lbound(InData%WaveDirArr), ubound(InData%WaveDirArr)) @@ -2141,7 +2035,6 @@ subroutine SeaSt_PackParam(Buf, Indata) call RegPack(Buf, InData%WaveDirArr) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveElevC0)) if (associated(InData%WaveElevC0)) then call RegPackBounds(Buf, 2, lbound(InData%WaveElevC0), ubound(InData%WaveElevC0)) @@ -2150,7 +2043,6 @@ subroutine SeaSt_PackParam(Buf, Indata) call RegPack(Buf, InData%WaveElevC0) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%PWaveAccMCF0)) if (associated(InData%PWaveAccMCF0)) then call RegPackBounds(Buf, 4, lbound(InData%PWaveAccMCF0), ubound(InData%PWaveAccMCF0)) @@ -2159,33 +2051,25 @@ subroutine SeaSt_PackParam(Buf, Indata) call RegPack(Buf, InData%PWaveAccMCF0) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NWaveKin) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveKinxi)) if (allocated(InData%WaveKinxi)) then call RegPackBounds(Buf, 1, lbound(InData%WaveKinxi), ubound(InData%WaveKinxi)) call RegPack(Buf, InData%WaveKinxi) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveKinyi)) if (allocated(InData%WaveKinyi)) then call RegPackBounds(Buf, 1, lbound(InData%WaveKinyi), ubound(InData%WaveKinyi)) call RegPack(Buf, InData%WaveKinyi) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveKinzi)) if (allocated(InData%WaveKinzi)) then call RegPackBounds(Buf, 1, lbound(InData%WaveKinzi), ubound(InData%WaveKinzi)) call RegPack(Buf, InData%WaveKinzi) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WtrDpth) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveStMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) @@ -2195,23 +2079,14 @@ subroutine SeaSt_PackParam(Buf, Indata) call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutSwtch) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutFmt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutSFmt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Delim) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UnOutFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutDec) - if (RegCheckErr(Buf, RoutineName)) return call SeaSt_Interp_PackParam(Buf, InData%SeaSt_Interp_p) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveField)) if (associated(InData%WaveField)) then call RegPackPointer(Buf, c_loc(InData%WaveField), PtrInIndex) diff --git a/modules/seastate/src/Waves2_Types.f90 b/modules/seastate/src/Waves2_Types.f90 index e8f199410e..de152e3551 100644 --- a/modules/seastate/src/Waves2_Types.f90 +++ b/modules/seastate/src/Waves2_Types.f90 @@ -182,21 +182,13 @@ subroutine Waves2_PackInitInput(Buf, Indata) logical :: PtrInIndex if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%Gravity) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WtrDens) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WtrDpth) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NStepWave) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NStepWave2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveDOmega) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveStMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveMultiDir) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveDirArr)) if (associated(InData%WaveDirArr)) then call RegPackBounds(Buf, 1, lbound(InData%WaveDirArr), ubound(InData%WaveDirArr)) @@ -205,7 +197,6 @@ subroutine Waves2_PackInitInput(Buf, Indata) call RegPack(Buf, InData%WaveDirArr) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveElevC0)) if (associated(InData%WaveElevC0)) then call RegPackBounds(Buf, 2, lbound(InData%WaveElevC0), ubound(InData%WaveElevC0)) @@ -214,7 +205,6 @@ subroutine Waves2_PackInitInput(Buf, Indata) call RegPack(Buf, InData%WaveElevC0) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveTime)) if (associated(InData%WaveTime)) then call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) @@ -223,41 +213,29 @@ subroutine Waves2_PackInitInput(Buf, Indata) call RegPack(Buf, InData%WaveTime) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nGrid) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NWaveElevGrid) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NWaveKinGrid) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveKinGridxi)) if (allocated(InData%WaveKinGridxi)) then call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridxi), ubound(InData%WaveKinGridxi)) call RegPack(Buf, InData%WaveKinGridxi) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveKinGridyi)) if (allocated(InData%WaveKinGridyi)) then call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridyi), ubound(InData%WaveKinGridyi)) call RegPack(Buf, InData%WaveKinGridyi) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveKinGridzi)) if (allocated(InData%WaveKinGridzi)) then call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridzi), ubound(InData%WaveKinGridzi)) call RegPack(Buf, InData%WaveKinGridzi) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WvDiffQTFF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WvSumQTFF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WvLowCOffD) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WvHiCOffD) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WvLowCOffS) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WvHiCOffS) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -559,37 +537,31 @@ subroutine Waves2_PackInitOutput(Buf, Indata) call RegPackBounds(Buf, 5, lbound(InData%WaveAcc2D), ubound(InData%WaveAcc2D)) call RegPack(Buf, InData%WaveAcc2D) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveDynP2D)) if (allocated(InData%WaveDynP2D)) then call RegPackBounds(Buf, 4, lbound(InData%WaveDynP2D), ubound(InData%WaveDynP2D)) call RegPack(Buf, InData%WaveDynP2D) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveAcc2S)) if (allocated(InData%WaveAcc2S)) then call RegPackBounds(Buf, 5, lbound(InData%WaveAcc2S), ubound(InData%WaveAcc2S)) call RegPack(Buf, InData%WaveAcc2S) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveDynP2S)) if (allocated(InData%WaveDynP2S)) then call RegPackBounds(Buf, 4, lbound(InData%WaveDynP2S), ubound(InData%WaveDynP2S)) call RegPack(Buf, InData%WaveDynP2S) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveVel2D)) if (allocated(InData%WaveVel2D)) then call RegPackBounds(Buf, 5, lbound(InData%WaveVel2D), ubound(InData%WaveVel2D)) call RegPack(Buf, InData%WaveVel2D) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveVel2S)) if (allocated(InData%WaveVel2S)) then call RegPackBounds(Buf, 5, lbound(InData%WaveVel2S), ubound(InData%WaveVel2S)) call RegPack(Buf, InData%WaveVel2S) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveElev2)) if (associated(InData%WaveElev2)) then call RegPackBounds(Buf, 3, lbound(InData%WaveElev2), ubound(InData%WaveElev2)) @@ -749,7 +721,6 @@ subroutine Waves2_PackParam(Buf, Indata) character(*), parameter :: RoutineName = 'Waves2_PackParam' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%WvDiffQTFF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WvSumQTFF) if (RegCheckErr(Buf, RoutineName)) return end subroutine diff --git a/modules/seastate/src/Waves_Types.f90 b/modules/seastate/src/Waves_Types.f90 index e001e53cd6..52cc2839aa 100644 --- a/modules/seastate/src/Waves_Types.f90 +++ b/modules/seastate/src/Waves_Types.f90 @@ -270,115 +270,70 @@ subroutine Waves_PackInitInput(Buf, Indata) character(*), parameter :: RoutineName = 'Waves_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%InputFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DirRoot) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WvKinFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Gravity) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nGrid) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WvLowCOff) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WvHiCOff) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveDir) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveNDir) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveMultiDir) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveDirMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveDirSpread) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveDirRange) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveDT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveHs) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveModChr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveNDAmp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WavePhase) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WavePkShp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WavePkShpChr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveSeed) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveStMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveTMax) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveTp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WtrDens) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WtrDpth) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NWaveElevGrid) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NWaveKinGrid) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveKinGridxi)) if (allocated(InData%WaveKinGridxi)) then call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridxi), ubound(InData%WaveKinGridxi)) call RegPack(Buf, InData%WaveKinGridxi) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveKinGridyi)) if (allocated(InData%WaveKinGridyi)) then call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridyi), ubound(InData%WaveKinGridyi)) call RegPack(Buf, InData%WaveKinGridyi) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveKinGridzi)) if (allocated(InData%WaveKinGridzi)) then call RegPackBounds(Buf, 1, lbound(InData%WaveKinGridzi), ubound(InData%WaveKinGridzi)) call RegPack(Buf, InData%WaveKinGridzi) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CurrVxi)) if (allocated(InData%CurrVxi)) then call RegPackBounds(Buf, 1, lbound(InData%CurrVxi), ubound(InData%CurrVxi)) call RegPack(Buf, InData%CurrVxi) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CurrVyi)) if (allocated(InData%CurrVyi)) then call RegPackBounds(Buf, 1, lbound(InData%CurrVyi), ubound(InData%CurrVyi)) call RegPack(Buf, InData%CurrVyi) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PCurrVxiPz0) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PCurrVyiPz0) - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackNWTC_RandomNumber_ParameterType(Buf, InData%RNG) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ConstWaveMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CrestHmax) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CrestTime) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CrestXi) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CrestYi) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%MCFD) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveFieldMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PtfmLocationX) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PtfmLocationY) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -646,13 +601,11 @@ subroutine Waves_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WaveElevC0) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveElevC)) if (allocated(InData%WaveElevC)) then call RegPackBounds(Buf, 3, lbound(InData%WaveElevC), ubound(InData%WaveElevC)) call RegPack(Buf, InData%WaveElevC) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveDirArr)) if (associated(InData%WaveDirArr)) then call RegPackBounds(Buf, 1, lbound(InData%WaveDirArr), ubound(InData%WaveDirArr)) @@ -661,15 +614,10 @@ subroutine Waves_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WaveDirArr) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveDirMin) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveDirMax) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveNDir) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveDOmega) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveDynP)) if (associated(InData%WaveDynP)) then call RegPackBounds(Buf, 4, lbound(InData%WaveDynP), ubound(InData%WaveDynP)) @@ -678,7 +626,6 @@ subroutine Waves_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WaveDynP) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveAcc)) if (associated(InData%WaveAcc)) then call RegPackBounds(Buf, 5, lbound(InData%WaveAcc), ubound(InData%WaveAcc)) @@ -687,7 +634,6 @@ subroutine Waves_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WaveAcc) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveAccMCF)) if (associated(InData%WaveAccMCF)) then call RegPackBounds(Buf, 5, lbound(InData%WaveAccMCF), ubound(InData%WaveAccMCF)) @@ -696,7 +642,6 @@ subroutine Waves_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WaveAccMCF) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveVel)) if (associated(InData%WaveVel)) then call RegPackBounds(Buf, 5, lbound(InData%WaveVel), ubound(InData%WaveVel)) @@ -705,7 +650,6 @@ subroutine Waves_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WaveVel) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%PWaveDynP0)) if (associated(InData%PWaveDynP0)) then call RegPackBounds(Buf, 3, lbound(InData%PWaveDynP0), ubound(InData%PWaveDynP0)) @@ -714,7 +658,6 @@ subroutine Waves_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%PWaveDynP0) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%PWaveAcc0)) if (associated(InData%PWaveAcc0)) then call RegPackBounds(Buf, 4, lbound(InData%PWaveAcc0), ubound(InData%PWaveAcc0)) @@ -723,7 +666,6 @@ subroutine Waves_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%PWaveAcc0) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%PWaveAccMCF0)) if (associated(InData%PWaveAccMCF0)) then call RegPackBounds(Buf, 4, lbound(InData%PWaveAccMCF0), ubound(InData%PWaveAccMCF0)) @@ -732,7 +674,6 @@ subroutine Waves_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%PWaveAccMCF0) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%PWaveVel0)) if (associated(InData%PWaveVel0)) then call RegPackBounds(Buf, 4, lbound(InData%PWaveVel0), ubound(InData%PWaveVel0)) @@ -741,7 +682,6 @@ subroutine Waves_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%PWaveVel0) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveElev)) if (associated(InData%WaveElev)) then call RegPackBounds(Buf, 3, lbound(InData%WaveElev), ubound(InData%WaveElev)) @@ -750,13 +690,11 @@ subroutine Waves_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WaveElev) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WaveElev0)) if (allocated(InData%WaveElev0)) then call RegPackBounds(Buf, 1, lbound(InData%WaveElev0), ubound(InData%WaveElev0)) call RegPack(Buf, InData%WaveElev0) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%WaveTime)) if (associated(InData%WaveTime)) then call RegPackBounds(Buf, 1, lbound(InData%WaveTime), ubound(InData%WaveTime)) @@ -765,13 +703,9 @@ subroutine Waves_PackInitOutput(Buf, Indata) call RegPack(Buf, InData%WaveTime) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WaveTMax) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RhoXg) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NStepWave) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NStepWave2) if (RegCheckErr(Buf, RoutineName)) return end subroutine diff --git a/modules/servodyn/src/ServoDyn_Types.f90 b/modules/servodyn/src/ServoDyn_Types.f90 index 8b9e660860..d29061831d 100644 --- a/modules/servodyn/src/ServoDyn_Types.f90 +++ b/modules/servodyn/src/ServoDyn_Types.f90 @@ -850,145 +850,99 @@ subroutine SrvD_PackInitInput(Buf, Indata) character(*), parameter :: RoutineName = 'SrvD_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%InputFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Linearize) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumBl) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RootName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BlPitchInit)) if (allocated(InData%BlPitchInit)) then call RegPackBounds(Buf, 1, lbound(InData%BlPitchInit), ubound(InData%BlPitchInit)) call RegPack(Buf, InData%BlPitchInit) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Gravity) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NacRefPos) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NacTransDisp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NacOrient) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NacRefOrient) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TwrBaseRefPos) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TwrBaseTransDisp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TwrBaseOrient) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TwrBaseRefOrient) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PtfmRefPos) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PtfmTransDisp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PtfmOrient) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PtfmRefOrient) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Tmax) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AvgWindSpeed) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AirDens) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumSC2CtrlGlob) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumSC2Ctrl) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumCtrl2SC) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TrimCase) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TrimGain) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RotSpeedRef) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BladeRootRefPos)) if (allocated(InData%BladeRootRefPos)) then call RegPackBounds(Buf, 2, lbound(InData%BladeRootRefPos), ubound(InData%BladeRootRefPos)) call RegPack(Buf, InData%BladeRootRefPos) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BladeRootTransDisp)) if (allocated(InData%BladeRootTransDisp)) then call RegPackBounds(Buf, 2, lbound(InData%BladeRootTransDisp), ubound(InData%BladeRootTransDisp)) call RegPack(Buf, InData%BladeRootTransDisp) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BladeRootOrient)) if (allocated(InData%BladeRootOrient)) then call RegPackBounds(Buf, 3, lbound(InData%BladeRootOrient), ubound(InData%BladeRootOrient)) call RegPack(Buf, InData%BladeRootOrient) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BladeRootRefOrient)) if (allocated(InData%BladeRootRefOrient)) then call RegPackBounds(Buf, 3, lbound(InData%BladeRootRefOrient), ubound(InData%BladeRootRefOrient)) call RegPack(Buf, InData%BladeRootRefOrient) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UseInputFile) - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackFileInfoType(Buf, InData%PassedPrimaryInputData) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumCableControl) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CableControlRequestor)) if (allocated(InData%CableControlRequestor)) then call RegPackBounds(Buf, 1, lbound(InData%CableControlRequestor), ubound(InData%CableControlRequestor)) call RegPack(Buf, InData%CableControlRequestor) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%InterpOrder) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%fromSCGlob)) if (allocated(InData%fromSCGlob)) then call RegPackBounds(Buf, 1, lbound(InData%fromSCGlob), ubound(InData%fromSCGlob)) call RegPack(Buf, InData%fromSCGlob) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%fromSC)) if (allocated(InData%fromSC)) then call RegPackBounds(Buf, 1, lbound(InData%fromSC), ubound(InData%fromSC)) call RegPack(Buf, InData%fromSC) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LidSpeed)) if (allocated(InData%LidSpeed)) then call RegPackBounds(Buf, 1, lbound(InData%LidSpeed), ubound(InData%LidSpeed)) call RegPack(Buf, InData%LidSpeed) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%MsrPositionsX)) if (allocated(InData%MsrPositionsX)) then call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsX), ubound(InData%MsrPositionsX)) call RegPack(Buf, InData%MsrPositionsX) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%MsrPositionsY)) if (allocated(InData%MsrPositionsY)) then call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsY), ubound(InData%MsrPositionsY)) call RegPack(Buf, InData%MsrPositionsY) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%MsrPositionsZ)) if (allocated(InData%MsrPositionsZ)) then call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsZ), ubound(InData%MsrPositionsZ)) call RegPack(Buf, InData%MsrPositionsZ) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SensorType) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumBeam) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumPulseGate) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PulseSpacing) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%URefLid) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1450,61 +1404,49 @@ subroutine SrvD_PackInitOutput(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) call RegPack(Buf, InData%WriteOutputHdr) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) call RegPack(Buf, InData%WriteOutputUnt) end if - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackProgDesc(Buf, InData%Ver) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CouplingScheme) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UseHSSBrake) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LinNames_y)) if (allocated(InData%LinNames_y)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) call RegPack(Buf, InData%LinNames_y) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LinNames_x)) if (allocated(InData%LinNames_x)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_x), ubound(InData%LinNames_x)) call RegPack(Buf, InData%LinNames_x) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LinNames_u)) if (allocated(InData%LinNames_u)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) call RegPack(Buf, InData%LinNames_u) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RotFrame_y)) if (allocated(InData%RotFrame_y)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y), ubound(InData%RotFrame_y)) call RegPack(Buf, InData%RotFrame_y) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RotFrame_x)) if (allocated(InData%RotFrame_x)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x), ubound(InData%RotFrame_x)) call RegPack(Buf, InData%RotFrame_x) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RotFrame_u)) if (allocated(InData%RotFrame_u)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u), ubound(InData%RotFrame_u)) call RegPack(Buf, InData%RotFrame_u) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%IsLoad_u)) if (allocated(InData%IsLoad_u)) then call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) call RegPack(Buf, InData%IsLoad_u) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%DerivOrder_x)) if (allocated(InData%DerivOrder_x)) then call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x), ubound(InData%DerivOrder_x)) @@ -1895,205 +1837,119 @@ subroutine SrvD_PackInputFile(Buf, Indata) character(*), parameter :: RoutineName = 'SrvD_PackInputFile' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%DT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Echo) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PCMode) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TPCOn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TPitManS) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PitManRat) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BlPitchF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VSContrl) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%GenModel) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%GenEff) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%GenTiStr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%GenTiStp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SpdGenOn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TimGenOn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TimGenOf) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VS_RtGnSp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VS_RtTq) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VS_Rgn2K) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VS_SlPc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SIG_SlPc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SIG_SySp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SIG_RtTq) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SIG_PORt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TEC_Freq) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TEC_NPol) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TEC_SRes) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TEC_RRes) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TEC_VLL) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TEC_SLR) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TEC_RLR) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TEC_MR) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HSSBrMode) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%THSSBrDp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HSSBrDT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HSSBrTqF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YCMode) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TYCOn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YawNeut) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YawSpr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YawDamp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TYawManS) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YawManRat) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NacYawF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SumPrint) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TabDelim) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutFmt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Tstart) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OutList)) if (allocated(InData%OutList)) then call RegPackBounds(Buf, 1, lbound(InData%OutList), ubound(InData%OutList)) call RegPack(Buf, InData%OutList) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DLL_FileName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DLL_ProcName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DLL_InFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DLL_DT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DLL_Ramp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BPCutoff) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NacYaw_North) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Ptch_Cntrl) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Ptch_SetPnt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Ptch_Min) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Ptch_Max) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PtchRate_Min) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PtchRate_Max) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Gain_OM) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%GenSpd_MinOM) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%GenSpd_MaxOM) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%GenSpd_Dem) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%GenTrq_Dem) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%GenPwr_Dem) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DLL_NumTrq) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%GenSpd_TLU)) if (allocated(InData%GenSpd_TLU)) then call RegPackBounds(Buf, 1, lbound(InData%GenSpd_TLU), ubound(InData%GenSpd_TLU)) call RegPack(Buf, InData%GenSpd_TLU) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%GenTrq_TLU)) if (allocated(InData%GenTrq_TLU)) then call RegPackBounds(Buf, 1, lbound(InData%GenTrq_TLU), ubound(InData%GenTrq_TLU)) call RegPack(Buf, InData%GenTrq_TLU) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UseLegacyInterface) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumBStC) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BStCfiles)) if (allocated(InData%BStCfiles)) then call RegPackBounds(Buf, 1, lbound(InData%BStCfiles), ubound(InData%BStCfiles)) call RegPack(Buf, InData%BStCfiles) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumNStC) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%NStCfiles)) if (allocated(InData%NStCfiles)) then call RegPackBounds(Buf, 1, lbound(InData%NStCfiles), ubound(InData%NStCfiles)) call RegPack(Buf, InData%NStCfiles) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumTStC) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TStCfiles)) if (allocated(InData%TStCfiles)) then call RegPackBounds(Buf, 1, lbound(InData%TStCfiles), ubound(InData%TStCfiles)) call RegPack(Buf, InData%TStCfiles) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumSStC) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%SStCfiles)) if (allocated(InData%SStCfiles)) then call RegPackBounds(Buf, 1, lbound(InData%SStCfiles), ubound(InData%SStCfiles)) call RegPack(Buf, InData%SStCfiles) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AfCmode) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AfC_Mean) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AfC_Amp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AfC_Phase) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CCmode) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%EXavrSWAP) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2911,37 +2767,23 @@ subroutine SrvD_PackBladedDLLType(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%avrSWAP), ubound(InData%avrSWAP)) call RegPack(Buf, InData%avrSWAP) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HSSBrTrqDemand) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YawRateCom) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%GenTrq) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%GenState) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BlPitchCom) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PrevBlPitch) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BlAirfoilCom) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PrevBlAirfoilCom) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ElecPwr_prev) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%GenTrq_prev) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%toSC)) if (allocated(InData%toSC)) then call RegPackBounds(Buf, 1, lbound(InData%toSC), ubound(InData%toSC)) call RegPack(Buf, InData%toSC) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%initialized) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumLogChannels) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LogChannels_OutParam)) if (allocated(InData%LogChannels_OutParam)) then call RegPackBounds(Buf, 1, lbound(InData%LogChannels_OutParam), ubound(InData%LogChannels_OutParam)) @@ -2951,249 +2793,169 @@ subroutine SrvD_PackBladedDLLType(Buf, Indata) call NWTC_Library_PackOutParmType(Buf, InData%LogChannels_OutParam(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LogChannels)) if (allocated(InData%LogChannels)) then call RegPackBounds(Buf, 1, lbound(InData%LogChannels), ubound(InData%LogChannels)) call RegPack(Buf, InData%LogChannels) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ErrStat) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ErrMsg) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CurrentTime) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SimStatus) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ShaftBrakeStatusBinaryFlag) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HSSBrDeployed) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TimeHSSBrFullyDeployed) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TimeHSSBrDeployed) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OverrideYawRateWithTorque) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YawTorqueDemand) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BlPitchInput)) if (allocated(InData%BlPitchInput)) then call RegPackBounds(Buf, 1, lbound(InData%BlPitchInput), ubound(InData%BlPitchInput)) call RegPack(Buf, InData%BlPitchInput) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YawAngleFromNorth) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HorWindV) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HSS_Spd) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YawErr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RotSpeed) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YawBrTAxp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YawBrTAyp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LSSTipMys) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LSSTipMzs) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LSSTipMya) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LSSTipMza) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LSSTipPxa) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Yaw) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YawRate) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YawBrMyn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YawBrMzn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NcIMURAxs) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NcIMURAys) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NcIMURAzs) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RotPwr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LSSTipMxa) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RootMyc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RootMxc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LSShftFxa) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LSShftFys) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LSShftFzs) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LidSpeed)) if (allocated(InData%LidSpeed)) then call RegPackBounds(Buf, 1, lbound(InData%LidSpeed), ubound(InData%LidSpeed)) call RegPack(Buf, InData%LidSpeed) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%MsrPositionsX)) if (allocated(InData%MsrPositionsX)) then call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsX), ubound(InData%MsrPositionsX)) call RegPack(Buf, InData%MsrPositionsX) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%MsrPositionsY)) if (allocated(InData%MsrPositionsY)) then call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsY), ubound(InData%MsrPositionsY)) call RegPack(Buf, InData%MsrPositionsY) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%MsrPositionsZ)) if (allocated(InData%MsrPositionsZ)) then call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsZ), ubound(InData%MsrPositionsZ)) call RegPack(Buf, InData%MsrPositionsZ) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SensorType) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumBeam) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumPulseGate) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PulseSpacing) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%URefLid) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DLL_DT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DLL_InFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RootName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%GenTrq_Dem) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%GenSpd_Dem) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Ptch_Max) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Ptch_Min) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Ptch_SetPnt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PtchRate_Max) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PtchRate_Min) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%GenPwr_Dem) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Gain_OM) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%GenSpd_MaxOM) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%GenSpd_MinOM) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Ptch_Cntrl) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DLL_NumTrq) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%GenSpd_TLU)) if (allocated(InData%GenSpd_TLU)) then call RegPackBounds(Buf, 1, lbound(InData%GenSpd_TLU), ubound(InData%GenSpd_TLU)) call RegPack(Buf, InData%GenSpd_TLU) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%GenTrq_TLU)) if (allocated(InData%GenTrq_TLU)) then call RegPackBounds(Buf, 1, lbound(InData%GenTrq_TLU), ubound(InData%GenTrq_TLU)) call RegPack(Buf, InData%GenTrq_TLU) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Yaw_Cntrl) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PrevCableDeltaL)) if (allocated(InData%PrevCableDeltaL)) then call RegPackBounds(Buf, 1, lbound(InData%PrevCableDeltaL), ubound(InData%PrevCableDeltaL)) call RegPack(Buf, InData%PrevCableDeltaL) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PrevCableDeltaLdot)) if (allocated(InData%PrevCableDeltaLdot)) then call RegPackBounds(Buf, 1, lbound(InData%PrevCableDeltaLdot), ubound(InData%PrevCableDeltaLdot)) call RegPack(Buf, InData%PrevCableDeltaLdot) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CableDeltaL)) if (allocated(InData%CableDeltaL)) then call RegPackBounds(Buf, 1, lbound(InData%CableDeltaL), ubound(InData%CableDeltaL)) call RegPack(Buf, InData%CableDeltaL) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CableDeltaLdot)) if (allocated(InData%CableDeltaLdot)) then call RegPackBounds(Buf, 1, lbound(InData%CableDeltaLdot), ubound(InData%CableDeltaLdot)) call RegPack(Buf, InData%CableDeltaLdot) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PrevStCCmdStiff)) if (allocated(InData%PrevStCCmdStiff)) then call RegPackBounds(Buf, 2, lbound(InData%PrevStCCmdStiff), ubound(InData%PrevStCCmdStiff)) call RegPack(Buf, InData%PrevStCCmdStiff) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PrevStCCmdDamp)) if (allocated(InData%PrevStCCmdDamp)) then call RegPackBounds(Buf, 2, lbound(InData%PrevStCCmdDamp), ubound(InData%PrevStCCmdDamp)) call RegPack(Buf, InData%PrevStCCmdDamp) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PrevStCCmdBrake)) if (allocated(InData%PrevStCCmdBrake)) then call RegPackBounds(Buf, 2, lbound(InData%PrevStCCmdBrake), ubound(InData%PrevStCCmdBrake)) call RegPack(Buf, InData%PrevStCCmdBrake) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PrevStCCmdForce)) if (allocated(InData%PrevStCCmdForce)) then call RegPackBounds(Buf, 2, lbound(InData%PrevStCCmdForce), ubound(InData%PrevStCCmdForce)) call RegPack(Buf, InData%PrevStCCmdForce) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%StCCmdStiff)) if (allocated(InData%StCCmdStiff)) then call RegPackBounds(Buf, 2, lbound(InData%StCCmdStiff), ubound(InData%StCCmdStiff)) call RegPack(Buf, InData%StCCmdStiff) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%StCCmdDamp)) if (allocated(InData%StCCmdDamp)) then call RegPackBounds(Buf, 2, lbound(InData%StCCmdDamp), ubound(InData%StCCmdDamp)) call RegPack(Buf, InData%StCCmdDamp) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%StCCmdBrake)) if (allocated(InData%StCCmdBrake)) then call RegPackBounds(Buf, 2, lbound(InData%StCCmdBrake), ubound(InData%StCCmdBrake)) call RegPack(Buf, InData%StCCmdBrake) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%StCCmdForce)) if (allocated(InData%StCCmdForce)) then call RegPackBounds(Buf, 2, lbound(InData%StCCmdForce), ubound(InData%StCCmdForce)) call RegPack(Buf, InData%StCCmdForce) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%StCMeasDisp)) if (allocated(InData%StCMeasDisp)) then call RegPackBounds(Buf, 2, lbound(InData%StCMeasDisp), ubound(InData%StCMeasDisp)) call RegPack(Buf, InData%StCMeasDisp) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%StCMeasVel)) if (allocated(InData%StCMeasVel)) then call RegPackBounds(Buf, 2, lbound(InData%StCMeasVel), ubound(InData%StCMeasVel)) @@ -3849,7 +3611,6 @@ subroutine SrvD_PackContState(Buf, Indata) integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%DummyContState) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BStC)) if (allocated(InData%BStC)) then call RegPackBounds(Buf, 1, lbound(InData%BStC), ubound(InData%BStC)) @@ -3859,7 +3620,6 @@ subroutine SrvD_PackContState(Buf, Indata) call StC_PackContState(Buf, InData%BStC(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%NStC)) if (allocated(InData%NStC)) then call RegPackBounds(Buf, 1, lbound(InData%NStC), ubound(InData%NStC)) @@ -3869,7 +3629,6 @@ subroutine SrvD_PackContState(Buf, Indata) call StC_PackContState(Buf, InData%NStC(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TStC)) if (allocated(InData%TStC)) then call RegPackBounds(Buf, 1, lbound(InData%TStC), ubound(InData%TStC)) @@ -3879,7 +3638,6 @@ subroutine SrvD_PackContState(Buf, Indata) call StC_PackContState(Buf, InData%TStC(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%SStC)) if (allocated(InData%SStC)) then call RegPackBounds(Buf, 1, lbound(InData%SStC), ubound(InData%SStC)) @@ -4110,7 +3868,6 @@ subroutine SrvD_PackDiscState(Buf, Indata) integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%CtrlOffset) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BStC)) if (allocated(InData%BStC)) then call RegPackBounds(Buf, 1, lbound(InData%BStC), ubound(InData%BStC)) @@ -4120,7 +3877,6 @@ subroutine SrvD_PackDiscState(Buf, Indata) call StC_PackDiscState(Buf, InData%BStC(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%NStC)) if (allocated(InData%NStC)) then call RegPackBounds(Buf, 1, lbound(InData%NStC), ubound(InData%NStC)) @@ -4130,7 +3886,6 @@ subroutine SrvD_PackDiscState(Buf, Indata) call StC_PackDiscState(Buf, InData%NStC(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TStC)) if (allocated(InData%TStC)) then call RegPackBounds(Buf, 1, lbound(InData%TStC), ubound(InData%TStC)) @@ -4140,7 +3895,6 @@ subroutine SrvD_PackDiscState(Buf, Indata) call StC_PackDiscState(Buf, InData%TStC(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%SStC)) if (allocated(InData%SStC)) then call RegPackBounds(Buf, 1, lbound(InData%SStC), ubound(InData%SStC)) @@ -4371,7 +4125,6 @@ subroutine SrvD_PackConstrState(Buf, Indata) integer(IntKi) :: LB(1), UB(1) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%DummyConstrState) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BStC)) if (allocated(InData%BStC)) then call RegPackBounds(Buf, 1, lbound(InData%BStC), ubound(InData%BStC)) @@ -4381,7 +4134,6 @@ subroutine SrvD_PackConstrState(Buf, Indata) call StC_PackConstrState(Buf, InData%BStC(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%NStC)) if (allocated(InData%NStC)) then call RegPackBounds(Buf, 1, lbound(InData%NStC), ubound(InData%NStC)) @@ -4391,7 +4143,6 @@ subroutine SrvD_PackConstrState(Buf, Indata) call StC_PackConstrState(Buf, InData%NStC(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TStC)) if (allocated(InData%TStC)) then call RegPackBounds(Buf, 1, lbound(InData%TStC), ubound(InData%TStC)) @@ -4401,7 +4152,6 @@ subroutine SrvD_PackConstrState(Buf, Indata) call StC_PackConstrState(Buf, InData%TStC(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%SStC)) if (allocated(InData%SStC)) then call RegPackBounds(Buf, 1, lbound(InData%SStC), ubound(InData%SStC)) @@ -4743,49 +4493,37 @@ subroutine SrvD_PackOtherState(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%BegPitMan), ubound(InData%BegPitMan)) call RegPack(Buf, InData%BegPitMan) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BlPitchI)) if (allocated(InData%BlPitchI)) then call RegPackBounds(Buf, 1, lbound(InData%BlPitchI), ubound(InData%BlPitchI)) call RegPack(Buf, InData%BlPitchI) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TPitManE)) if (allocated(InData%TPitManE)) then call RegPackBounds(Buf, 1, lbound(InData%TPitManE), ubound(InData%TPitManE)) call RegPack(Buf, InData%TPitManE) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BegYawMan) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NacYawI) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TYawManE) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YawPosComInt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BegTpBr)) if (allocated(InData%BegTpBr)) then call RegPackBounds(Buf, 1, lbound(InData%BegTpBr), ubound(InData%BegTpBr)) call RegPack(Buf, InData%BegTpBr) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TTpBrDp)) if (allocated(InData%TTpBrDp)) then call RegPackBounds(Buf, 1, lbound(InData%TTpBrDp), ubound(InData%TTpBrDp)) call RegPack(Buf, InData%TTpBrDp) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TTpBrFl)) if (allocated(InData%TTpBrFl)) then call RegPackBounds(Buf, 1, lbound(InData%TTpBrFl), ubound(InData%TTpBrFl)) call RegPack(Buf, InData%TTpBrFl) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Off4Good) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%GenOnLine) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BStC)) if (allocated(InData%BStC)) then call RegPackBounds(Buf, 1, lbound(InData%BStC), ubound(InData%BStC)) @@ -4795,7 +4533,6 @@ subroutine SrvD_PackOtherState(Buf, Indata) call StC_PackOtherState(Buf, InData%BStC(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%NStC)) if (allocated(InData%NStC)) then call RegPackBounds(Buf, 1, lbound(InData%NStC), ubound(InData%NStC)) @@ -4805,7 +4542,6 @@ subroutine SrvD_PackOtherState(Buf, Indata) call StC_PackOtherState(Buf, InData%NStC(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TStC)) if (allocated(InData%TStC)) then call RegPackBounds(Buf, 1, lbound(InData%TStC), ubound(InData%TStC)) @@ -4815,7 +4551,6 @@ subroutine SrvD_PackOtherState(Buf, Indata) call StC_PackOtherState(Buf, InData%TStC(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%SStC)) if (allocated(InData%SStC)) then call RegPackBounds(Buf, 1, lbound(InData%SStC), ubound(InData%SStC)) @@ -5265,7 +5000,6 @@ subroutine SrvD_PackModuleMapType(Buf, Indata) end do end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%u_NStC_Mot2_NStC)) if (allocated(InData%u_NStC_Mot2_NStC)) then call RegPackBounds(Buf, 1, lbound(InData%u_NStC_Mot2_NStC), ubound(InData%u_NStC_Mot2_NStC)) @@ -5275,7 +5009,6 @@ subroutine SrvD_PackModuleMapType(Buf, Indata) call NWTC_Library_PackMeshMapType(Buf, InData%u_NStC_Mot2_NStC(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%u_TStC_Mot2_TStC)) if (allocated(InData%u_TStC_Mot2_TStC)) then call RegPackBounds(Buf, 1, lbound(InData%u_TStC_Mot2_TStC), ubound(InData%u_TStC_Mot2_TStC)) @@ -5285,7 +5018,6 @@ subroutine SrvD_PackModuleMapType(Buf, Indata) call NWTC_Library_PackMeshMapType(Buf, InData%u_TStC_Mot2_TStC(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%u_SStC_Mot2_SStC)) if (allocated(InData%u_SStC_Mot2_SStC)) then call RegPackBounds(Buf, 1, lbound(InData%u_SStC_Mot2_SStC), ubound(InData%u_SStC_Mot2_SStC)) @@ -5295,7 +5027,6 @@ subroutine SrvD_PackModuleMapType(Buf, Indata) call NWTC_Library_PackMeshMapType(Buf, InData%u_SStC_Mot2_SStC(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BStC_Frc2_y_BStC)) if (allocated(InData%BStC_Frc2_y_BStC)) then call RegPackBounds(Buf, 2, lbound(InData%BStC_Frc2_y_BStC), ubound(InData%BStC_Frc2_y_BStC)) @@ -5307,7 +5038,6 @@ subroutine SrvD_PackModuleMapType(Buf, Indata) end do end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%NStC_Frc2_y_NStC)) if (allocated(InData%NStC_Frc2_y_NStC)) then call RegPackBounds(Buf, 1, lbound(InData%NStC_Frc2_y_NStC), ubound(InData%NStC_Frc2_y_NStC)) @@ -5317,7 +5047,6 @@ subroutine SrvD_PackModuleMapType(Buf, Indata) call NWTC_Library_PackMeshMapType(Buf, InData%NStC_Frc2_y_NStC(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TStC_Frc2_y_TStC)) if (allocated(InData%TStC_Frc2_y_TStC)) then call RegPackBounds(Buf, 1, lbound(InData%TStC_Frc2_y_TStC), ubound(InData%TStC_Frc2_y_TStC)) @@ -5327,7 +5056,6 @@ subroutine SrvD_PackModuleMapType(Buf, Indata) call NWTC_Library_PackMeshMapType(Buf, InData%TStC_Frc2_y_TStC(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%SStC_Frc2_y_SStC)) if (allocated(InData%SStC_Frc2_y_SStC)) then call RegPackBounds(Buf, 1, lbound(InData%SStC_Frc2_y_SStC), ubound(InData%SStC_Frc2_y_SStC)) @@ -5878,19 +5606,14 @@ subroutine SrvD_PackMisc(Buf, Indata) integer(IntKi) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%LastTimeCalled) - if (RegCheckErr(Buf, RoutineName)) return call SrvD_PackBladedDLLType(Buf, InData%dll_data) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FirstWarn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LastTimeFiltered) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%xd_BlPitchFilter)) if (allocated(InData%xd_BlPitchFilter)) then call RegPackBounds(Buf, 1, lbound(InData%xd_BlPitchFilter), ubound(InData%xd_BlPitchFilter)) call RegPack(Buf, InData%xd_BlPitchFilter) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BStC)) if (allocated(InData%BStC)) then call RegPackBounds(Buf, 1, lbound(InData%BStC), ubound(InData%BStC)) @@ -5900,7 +5623,6 @@ subroutine SrvD_PackMisc(Buf, Indata) call StC_PackMisc(Buf, InData%BStC(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%NStC)) if (allocated(InData%NStC)) then call RegPackBounds(Buf, 1, lbound(InData%NStC), ubound(InData%NStC)) @@ -5910,7 +5632,6 @@ subroutine SrvD_PackMisc(Buf, Indata) call StC_PackMisc(Buf, InData%NStC(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TStC)) if (allocated(InData%TStC)) then call RegPackBounds(Buf, 1, lbound(InData%TStC), ubound(InData%TStC)) @@ -5920,7 +5641,6 @@ subroutine SrvD_PackMisc(Buf, Indata) call StC_PackMisc(Buf, InData%TStC(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%SStC)) if (allocated(InData%SStC)) then call RegPackBounds(Buf, 1, lbound(InData%SStC), ubound(InData%SStC)) @@ -5930,7 +5650,6 @@ subroutine SrvD_PackMisc(Buf, Indata) call StC_PackMisc(Buf, InData%SStC(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%u_BStC)) if (allocated(InData%u_BStC)) then call RegPackBounds(Buf, 2, lbound(InData%u_BStC), ubound(InData%u_BStC)) @@ -5942,7 +5661,6 @@ subroutine SrvD_PackMisc(Buf, Indata) end do end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%u_NStC)) if (allocated(InData%u_NStC)) then call RegPackBounds(Buf, 2, lbound(InData%u_NStC), ubound(InData%u_NStC)) @@ -5954,7 +5672,6 @@ subroutine SrvD_PackMisc(Buf, Indata) end do end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%u_TStC)) if (allocated(InData%u_TStC)) then call RegPackBounds(Buf, 2, lbound(InData%u_TStC), ubound(InData%u_TStC)) @@ -5966,7 +5683,6 @@ subroutine SrvD_PackMisc(Buf, Indata) end do end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%u_SStC)) if (allocated(InData%u_SStC)) then call RegPackBounds(Buf, 2, lbound(InData%u_SStC), ubound(InData%u_SStC)) @@ -5978,7 +5694,6 @@ subroutine SrvD_PackMisc(Buf, Indata) end do end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%y_BStC)) if (allocated(InData%y_BStC)) then call RegPackBounds(Buf, 1, lbound(InData%y_BStC), ubound(InData%y_BStC)) @@ -5988,7 +5703,6 @@ subroutine SrvD_PackMisc(Buf, Indata) call StC_PackOutput(Buf, InData%y_BStC(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%y_NStC)) if (allocated(InData%y_NStC)) then call RegPackBounds(Buf, 1, lbound(InData%y_NStC), ubound(InData%y_NStC)) @@ -5998,7 +5712,6 @@ subroutine SrvD_PackMisc(Buf, Indata) call StC_PackOutput(Buf, InData%y_NStC(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%y_TStC)) if (allocated(InData%y_TStC)) then call RegPackBounds(Buf, 1, lbound(InData%y_TStC), ubound(InData%y_TStC)) @@ -6008,7 +5721,6 @@ subroutine SrvD_PackMisc(Buf, Indata) call StC_PackOutput(Buf, InData%y_TStC(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%y_SStC)) if (allocated(InData%y_SStC)) then call RegPackBounds(Buf, 1, lbound(InData%y_SStC), ubound(InData%y_SStC)) @@ -6018,9 +5730,7 @@ subroutine SrvD_PackMisc(Buf, Indata) call StC_PackOutput(Buf, InData%y_SStC(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call SrvD_PackModuleMapType(Buf, InData%SrvD_MeshMap) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PrevTstepNcall) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -6889,173 +6599,99 @@ subroutine SrvD_PackParam(Buf, Indata) integer(IntKi) :: LB(3), UB(3) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%DT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HSSBrDT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HSSBrTqF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SIG_POSl) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SIG_POTq) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SIG_SlPc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SIG_Slop) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SIG_SySp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TEC_A0) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TEC_C0) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TEC_C1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TEC_C2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TEC_K2) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TEC_MR) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TEC_Re1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TEC_RLR) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TEC_RRes) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TEC_SRes) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TEC_SySp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TEC_V1a) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TEC_VLL) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TEC_Xe1) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%GenEff) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BlPitchInit)) if (allocated(InData%BlPitchInit)) then call RegPackBounds(Buf, 1, lbound(InData%BlPitchInit), ubound(InData%BlPitchInit)) call RegPack(Buf, InData%BlPitchInit) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BlPitchF)) if (allocated(InData%BlPitchF)) then call RegPackBounds(Buf, 1, lbound(InData%BlPitchF), ubound(InData%BlPitchF)) call RegPack(Buf, InData%BlPitchF) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PitManRat)) if (allocated(InData%PitManRat)) then call RegPackBounds(Buf, 1, lbound(InData%PitManRat), ubound(InData%PitManRat)) call RegPack(Buf, InData%PitManRat) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YawManRat) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NacYawF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SpdGenOn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%THSSBrDp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%THSSBrFl) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TimGenOf) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TimGenOn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TPCOn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TPitManS)) if (allocated(InData%TPitManS)) then call RegPackBounds(Buf, 1, lbound(InData%TPitManS), ubound(InData%TPitManS)) call RegPack(Buf, InData%TPitManS) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TYawManS) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TYCOn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VS_RtGnSp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VS_RtTq) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VS_Slope) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VS_SlPc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VS_SySp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VS_TrGnSp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YawPosCom) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YawRateCom) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%GenModel) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HSSBrMode) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PCMode) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VSContrl) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YCMode) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%GenTiStp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%GenTiStr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%VS_Rgn2K) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YawNeut) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YawSpr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YawDamp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TpBrDT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TBDepISp)) if (allocated(InData%TBDepISp)) then call RegPackBounds(Buf, 1, lbound(InData%TBDepISp), ubound(InData%TBDepISp)) call RegPack(Buf, InData%TBDepISp) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TBDrConN) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TBDrConD) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumBl) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumBStC) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumNStC) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumTStC) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumSStC) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AfCmode) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AfC_Mean) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AfC_Amp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AfC_Phase) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CCmode) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StCCmode) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumOuts_DLL) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RootName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) @@ -7065,35 +6701,20 @@ subroutine SrvD_PackParam(Buf, Indata) call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Delim) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UseBladedInterface) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UseLegacyInterface) - if (RegCheckErr(Buf, RoutineName)) return call DLLTypePack(Buf, InData%DLL_Trgt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DLL_Ramp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%BlAlpha) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DLL_n) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%avcOUTNAME_LEN) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NacYaw_North) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AvgWindSpeed) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%AirDens) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TrimCase) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TrimGain) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RotSpeedRef) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BStC)) if (allocated(InData%BStC)) then call RegPackBounds(Buf, 1, lbound(InData%BStC), ubound(InData%BStC)) @@ -7103,7 +6724,6 @@ subroutine SrvD_PackParam(Buf, Indata) call StC_PackParam(Buf, InData%BStC(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%NStC)) if (allocated(InData%NStC)) then call RegPackBounds(Buf, 1, lbound(InData%NStC), ubound(InData%NStC)) @@ -7113,7 +6733,6 @@ subroutine SrvD_PackParam(Buf, Indata) call StC_PackParam(Buf, InData%NStC(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TStC)) if (allocated(InData%TStC)) then call RegPackBounds(Buf, 1, lbound(InData%TStC), ubound(InData%TStC)) @@ -7123,7 +6742,6 @@ subroutine SrvD_PackParam(Buf, Indata) call StC_PackParam(Buf, InData%TStC(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%SStC)) if (allocated(InData%SStC)) then call RegPackBounds(Buf, 1, lbound(InData%SStC), ubound(InData%SStC)) @@ -7133,133 +6751,103 @@ subroutine SrvD_PackParam(Buf, Indata) call StC_PackParam(Buf, InData%SStC(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%InterpOrder) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%EXavrSWAP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumCableControl) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumStC_Control) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%StCMeasNumPerChan)) if (allocated(InData%StCMeasNumPerChan)) then call RegPackBounds(Buf, 1, lbound(InData%StCMeasNumPerChan), ubound(InData%StCMeasNumPerChan)) call RegPack(Buf, InData%StCMeasNumPerChan) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UseSC) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Jac_u_indx)) if (allocated(InData%Jac_u_indx)) then call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx), ubound(InData%Jac_u_indx)) call RegPack(Buf, InData%Jac_u_indx) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Jac_x_indx)) if (allocated(InData%Jac_x_indx)) then call RegPackBounds(Buf, 2, lbound(InData%Jac_x_indx), ubound(InData%Jac_x_indx)) call RegPack(Buf, InData%Jac_x_indx) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%du)) if (allocated(InData%du)) then call RegPackBounds(Buf, 1, lbound(InData%du), ubound(InData%du)) call RegPack(Buf, InData%du) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%dx)) if (allocated(InData%dx)) then call RegPackBounds(Buf, 1, lbound(InData%dx), ubound(InData%dx)) call RegPack(Buf, InData%dx) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Jac_nu) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Jac_ny) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Jac_nx) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Jac_Idx_BStC_u)) if (allocated(InData%Jac_Idx_BStC_u)) then call RegPackBounds(Buf, 3, lbound(InData%Jac_Idx_BStC_u), ubound(InData%Jac_Idx_BStC_u)) call RegPack(Buf, InData%Jac_Idx_BStC_u) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Jac_Idx_NStC_u)) if (allocated(InData%Jac_Idx_NStC_u)) then call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_NStC_u), ubound(InData%Jac_Idx_NStC_u)) call RegPack(Buf, InData%Jac_Idx_NStC_u) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Jac_Idx_TStC_u)) if (allocated(InData%Jac_Idx_TStC_u)) then call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_TStC_u), ubound(InData%Jac_Idx_TStC_u)) call RegPack(Buf, InData%Jac_Idx_TStC_u) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Jac_Idx_SStC_u)) if (allocated(InData%Jac_Idx_SStC_u)) then call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_SStC_u), ubound(InData%Jac_Idx_SStC_u)) call RegPack(Buf, InData%Jac_Idx_SStC_u) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Jac_Idx_BStC_x)) if (allocated(InData%Jac_Idx_BStC_x)) then call RegPackBounds(Buf, 3, lbound(InData%Jac_Idx_BStC_x), ubound(InData%Jac_Idx_BStC_x)) call RegPack(Buf, InData%Jac_Idx_BStC_x) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Jac_Idx_NStC_x)) if (allocated(InData%Jac_Idx_NStC_x)) then call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_NStC_x), ubound(InData%Jac_Idx_NStC_x)) call RegPack(Buf, InData%Jac_Idx_NStC_x) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Jac_Idx_TStC_x)) if (allocated(InData%Jac_Idx_TStC_x)) then call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_TStC_x), ubound(InData%Jac_Idx_TStC_x)) call RegPack(Buf, InData%Jac_Idx_TStC_x) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Jac_Idx_SStC_x)) if (allocated(InData%Jac_Idx_SStC_x)) then call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_SStC_x), ubound(InData%Jac_Idx_SStC_x)) call RegPack(Buf, InData%Jac_Idx_SStC_x) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Jac_Idx_BStC_y)) if (allocated(InData%Jac_Idx_BStC_y)) then call RegPackBounds(Buf, 3, lbound(InData%Jac_Idx_BStC_y), ubound(InData%Jac_Idx_BStC_y)) call RegPack(Buf, InData%Jac_Idx_BStC_y) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Jac_Idx_NStC_y)) if (allocated(InData%Jac_Idx_NStC_y)) then call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_NStC_y), ubound(InData%Jac_Idx_NStC_y)) call RegPack(Buf, InData%Jac_Idx_NStC_y) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Jac_Idx_TStC_y)) if (allocated(InData%Jac_Idx_TStC_y)) then call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_TStC_y), ubound(InData%Jac_Idx_TStC_y)) call RegPack(Buf, InData%Jac_Idx_TStC_y) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Jac_Idx_SStC_y)) if (allocated(InData%Jac_Idx_SStC_y)) then call RegPackBounds(Buf, 2, lbound(InData%Jac_Idx_SStC_y), ubound(InData%Jac_Idx_SStC_y)) call RegPack(Buf, InData%Jac_Idx_SStC_y) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SensorType) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumBeam) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumPulseGate) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PulseSpacing) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%URefLid) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -8242,119 +7830,76 @@ subroutine SrvD_PackInput(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%BlPitch), ubound(InData%BlPitch)) call RegPack(Buf, InData%BlPitch) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Yaw) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YawRate) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LSS_Spd) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HSS_Spd) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RotSpeed) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ExternalYawPosCom) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ExternalYawRateCom) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ExternalBlPitchCom)) if (allocated(InData%ExternalBlPitchCom)) then call RegPackBounds(Buf, 1, lbound(InData%ExternalBlPitchCom), ubound(InData%ExternalBlPitchCom)) call RegPack(Buf, InData%ExternalBlPitchCom) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ExternalGenTrq) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ExternalElecPwr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ExternalHSSBrFrac) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ExternalBlAirfoilCom)) if (allocated(InData%ExternalBlAirfoilCom)) then call RegPackBounds(Buf, 1, lbound(InData%ExternalBlAirfoilCom), ubound(InData%ExternalBlAirfoilCom)) call RegPack(Buf, InData%ExternalBlAirfoilCom) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ExternalCableDeltaL)) if (allocated(InData%ExternalCableDeltaL)) then call RegPackBounds(Buf, 1, lbound(InData%ExternalCableDeltaL), ubound(InData%ExternalCableDeltaL)) call RegPack(Buf, InData%ExternalCableDeltaL) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ExternalCableDeltaLdot)) if (allocated(InData%ExternalCableDeltaLdot)) then call RegPackBounds(Buf, 1, lbound(InData%ExternalCableDeltaLdot), ubound(InData%ExternalCableDeltaLdot)) call RegPack(Buf, InData%ExternalCableDeltaLdot) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TwrAccel) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YawErr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WindDir) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RootMyc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YawBrTAxp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YawBrTAyp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LSSTipPxa) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RootMxc) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LSSTipMxa) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LSSTipMya) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LSSTipMza) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LSSTipMys) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LSSTipMzs) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YawBrMyn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YawBrMzn) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NcIMURAxs) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NcIMURAys) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NcIMURAzs) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RotPwr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HorWindV) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YawAngle) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LSShftFxa) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LSShftFys) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LSShftFzs) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%fromSC)) if (allocated(InData%fromSC)) then call RegPackBounds(Buf, 1, lbound(InData%fromSC), ubound(InData%fromSC)) call RegPack(Buf, InData%fromSC) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%fromSCglob)) if (allocated(InData%fromSCglob)) then call RegPackBounds(Buf, 1, lbound(InData%fromSCglob), ubound(InData%fromSCglob)) call RegPack(Buf, InData%fromSCglob) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Lidar)) if (allocated(InData%Lidar)) then call RegPackBounds(Buf, 1, lbound(InData%Lidar), ubound(InData%Lidar)) call RegPack(Buf, InData%Lidar) end if - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%PtfmMotionMesh) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BStCMotionMesh)) if (allocated(InData%BStCMotionMesh)) then call RegPackBounds(Buf, 2, lbound(InData%BStCMotionMesh), ubound(InData%BStCMotionMesh)) @@ -8366,7 +7911,6 @@ subroutine SrvD_PackInput(Buf, Indata) end do end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%NStCMotionMesh)) if (allocated(InData%NStCMotionMesh)) then call RegPackBounds(Buf, 1, lbound(InData%NStCMotionMesh), ubound(InData%NStCMotionMesh)) @@ -8376,7 +7920,6 @@ subroutine SrvD_PackInput(Buf, Indata) call MeshPack(Buf, InData%NStCMotionMesh(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TStCMotionMesh)) if (allocated(InData%TStCMotionMesh)) then call RegPackBounds(Buf, 1, lbound(InData%TStCMotionMesh), ubound(InData%TStCMotionMesh)) @@ -8386,7 +7929,6 @@ subroutine SrvD_PackInput(Buf, Indata) call MeshPack(Buf, InData%TStCMotionMesh(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%SStCMotionMesh)) if (allocated(InData%SStCMotionMesh)) then call RegPackBounds(Buf, 1, lbound(InData%SStCMotionMesh), ubound(InData%SStCMotionMesh)) @@ -8396,25 +7938,21 @@ subroutine SrvD_PackInput(Buf, Indata) call MeshPack(Buf, InData%SStCMotionMesh(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LidSpeed)) if (allocated(InData%LidSpeed)) then call RegPackBounds(Buf, 1, lbound(InData%LidSpeed), ubound(InData%LidSpeed)) call RegPack(Buf, InData%LidSpeed) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%MsrPositionsX)) if (allocated(InData%MsrPositionsX)) then call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsX), ubound(InData%MsrPositionsX)) call RegPack(Buf, InData%MsrPositionsX) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%MsrPositionsY)) if (allocated(InData%MsrPositionsY)) then call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsY), ubound(InData%MsrPositionsY)) call RegPack(Buf, InData%MsrPositionsY) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%MsrPositionsZ)) if (allocated(InData%MsrPositionsZ)) then call RegPackBounds(Buf, 1, lbound(InData%MsrPositionsZ), ubound(InData%MsrPositionsZ)) @@ -9025,51 +8563,40 @@ subroutine SrvD_PackOutput(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) call RegPack(Buf, InData%WriteOutput) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BlPitchCom)) if (allocated(InData%BlPitchCom)) then call RegPackBounds(Buf, 1, lbound(InData%BlPitchCom), ubound(InData%BlPitchCom)) call RegPack(Buf, InData%BlPitchCom) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BlAirfoilCom)) if (allocated(InData%BlAirfoilCom)) then call RegPackBounds(Buf, 1, lbound(InData%BlAirfoilCom), ubound(InData%BlAirfoilCom)) call RegPack(Buf, InData%BlAirfoilCom) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YawMom) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%GenTrq) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%HSSBrTrqC) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ElecPwr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TBDrCon)) if (allocated(InData%TBDrCon)) then call RegPackBounds(Buf, 1, lbound(InData%TBDrCon), ubound(InData%TBDrCon)) call RegPack(Buf, InData%TBDrCon) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Lidar)) if (allocated(InData%Lidar)) then call RegPackBounds(Buf, 1, lbound(InData%Lidar), ubound(InData%Lidar)) call RegPack(Buf, InData%Lidar) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CableDeltaL)) if (allocated(InData%CableDeltaL)) then call RegPackBounds(Buf, 1, lbound(InData%CableDeltaL), ubound(InData%CableDeltaL)) call RegPack(Buf, InData%CableDeltaL) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CableDeltaLdot)) if (allocated(InData%CableDeltaLdot)) then call RegPackBounds(Buf, 1, lbound(InData%CableDeltaLdot), ubound(InData%CableDeltaLdot)) call RegPack(Buf, InData%CableDeltaLdot) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%BStCLoadMesh)) if (allocated(InData%BStCLoadMesh)) then call RegPackBounds(Buf, 2, lbound(InData%BStCLoadMesh), ubound(InData%BStCLoadMesh)) @@ -9081,7 +8608,6 @@ subroutine SrvD_PackOutput(Buf, Indata) end do end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%NStCLoadMesh)) if (allocated(InData%NStCLoadMesh)) then call RegPackBounds(Buf, 1, lbound(InData%NStCLoadMesh), ubound(InData%NStCLoadMesh)) @@ -9091,7 +8617,6 @@ subroutine SrvD_PackOutput(Buf, Indata) call MeshPack(Buf, InData%NStCLoadMesh(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TStCLoadMesh)) if (allocated(InData%TStCLoadMesh)) then call RegPackBounds(Buf, 1, lbound(InData%TStCLoadMesh), ubound(InData%TStCLoadMesh)) @@ -9101,7 +8626,6 @@ subroutine SrvD_PackOutput(Buf, Indata) call MeshPack(Buf, InData%TStCLoadMesh(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%SStCLoadMesh)) if (allocated(InData%SStCLoadMesh)) then call RegPackBounds(Buf, 1, lbound(InData%SStCLoadMesh), ubound(InData%SStCLoadMesh)) @@ -9111,7 +8635,6 @@ subroutine SrvD_PackOutput(Buf, Indata) call MeshPack(Buf, InData%SStCLoadMesh(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%toSC)) if (allocated(InData%toSC)) then call RegPackBounds(Buf, 1, lbound(InData%toSC), ubound(InData%toSC)) diff --git a/modules/servodyn/src/StrucCtrl_Types.f90 b/modules/servodyn/src/StrucCtrl_Types.f90 index 25481e1336..beb9d8f8fe 100644 --- a/modules/servodyn/src/StrucCtrl_Types.f90 +++ b/modules/servodyn/src/StrucCtrl_Types.f90 @@ -392,143 +392,78 @@ subroutine StC_PackInputFile(Buf, Indata) character(*), parameter :: RoutineName = 'StC_PackInputFile' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%StCFileName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Echo) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_CMODE) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_SA_MODE) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_DOF_MODE) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_X_DOF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_Y_DOF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_Z_DOF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_X_DSP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_Y_DSP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_Z_DSP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_Z_PreLdC) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_X_M) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_Y_M) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_Z_M) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_XY_M) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_X_K) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_Y_K) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_Z_K) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_X_C) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_Y_C) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_Z_C) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_X_PSP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_X_NSP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_Y_PSP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_Y_NSP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_Z_PSP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_Z_NSP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_X_KS) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_X_CS) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_Y_KS) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_Y_CS) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_Z_KS) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_Z_CS) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_P_X) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_P_Y) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_P_Z) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_X_C_HIGH) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_X_C_LOW) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_Y_C_HIGH) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_Y_C_LOW) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_Z_C_HIGH) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_Z_C_LOW) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_X_C_BRAKE) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_Y_C_BRAKE) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_Z_C_BRAKE) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%L_X) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%B_X) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%area_X) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%area_ratio_X) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%headLossCoeff_X) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rho_X) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%L_Y) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%B_Y) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%area_Y) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%area_ratio_Y) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%headLossCoeff_Y) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rho_Y) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%USE_F_TBL) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NKInpSt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_F_TBL_FILE) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%F_TBL)) if (allocated(InData%F_TBL)) then call RegPackBounds(Buf, 2, lbound(InData%F_TBL), ubound(InData%F_TBL)) call RegPack(Buf, InData%F_TBL) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PrescribedForcesCoordSys) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PrescribedForcesFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%StC_PrescribedForce)) if (allocated(InData%StC_PrescribedForce)) then call RegPackBounds(Buf, 2, lbound(InData%StC_PrescribedForce), ubound(InData%StC_PrescribedForce)) call RegPack(Buf, InData%StC_PrescribedForce) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%StC_CChan)) if (allocated(InData%StC_CChan)) then call RegPackBounds(Buf, 1, lbound(InData%StC_CChan), ubound(InData%StC_CChan)) @@ -826,43 +761,32 @@ subroutine StC_PackInitInput(Buf, Indata) character(*), parameter :: RoutineName = 'StC_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%InputFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RootName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Gravity) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumMeshPts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%InitRefPos)) if (allocated(InData%InitRefPos)) then call RegPackBounds(Buf, 2, lbound(InData%InitRefPos), ubound(InData%InitRefPos)) call RegPack(Buf, InData%InitRefPos) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%InitTransDisp)) if (allocated(InData%InitTransDisp)) then call RegPackBounds(Buf, 2, lbound(InData%InitTransDisp), ubound(InData%InitTransDisp)) call RegPack(Buf, InData%InitTransDisp) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%InitOrient)) if (allocated(InData%InitOrient)) then call RegPackBounds(Buf, 3, lbound(InData%InitOrient), ubound(InData%InitOrient)) call RegPack(Buf, InData%InitOrient) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%InitRefOrient)) if (allocated(InData%InitRefOrient)) then call RegPackBounds(Buf, 3, lbound(InData%InitRefOrient), ubound(InData%InitRefOrient)) call RegPack(Buf, InData%InitRefOrient) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UseInputFile) - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackFileInfoType(Buf, InData%PassedPrimaryInputData) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UseInputFile_PrescribeFrc) - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackFileInfoType(Buf, InData%PassedPrescribeFrcData) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1098,37 +1022,31 @@ subroutine StC_PackCtrlChanInitInfoType(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%Requestor), ubound(InData%Requestor)) call RegPack(Buf, InData%Requestor) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%InitStiff)) if (allocated(InData%InitStiff)) then call RegPackBounds(Buf, 2, lbound(InData%InitStiff), ubound(InData%InitStiff)) call RegPack(Buf, InData%InitStiff) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%InitDamp)) if (allocated(InData%InitDamp)) then call RegPackBounds(Buf, 2, lbound(InData%InitDamp), ubound(InData%InitDamp)) call RegPack(Buf, InData%InitDamp) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%InitBrake)) if (allocated(InData%InitBrake)) then call RegPackBounds(Buf, 2, lbound(InData%InitBrake), ubound(InData%InitBrake)) call RegPack(Buf, InData%InitBrake) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%InitForce)) if (allocated(InData%InitForce)) then call RegPackBounds(Buf, 2, lbound(InData%InitForce), ubound(InData%InitForce)) call RegPack(Buf, InData%InitForce) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%InitMeasDisp)) if (allocated(InData%InitMeasDisp)) then call RegPackBounds(Buf, 2, lbound(InData%InitMeasDisp), ubound(InData%InitMeasDisp)) call RegPack(Buf, InData%InitMeasDisp) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%InitMeasVel)) if (allocated(InData%InitMeasVel)) then call RegPackBounds(Buf, 2, lbound(InData%InitMeasVel), ubound(InData%InitMeasVel)) @@ -1836,103 +1754,86 @@ subroutine StC_PackMisc(Buf, Indata) call RegPackBounds(Buf, 2, lbound(InData%F_stop), ubound(InData%F_stop)) call RegPack(Buf, InData%F_stop) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%F_ext)) if (allocated(InData%F_ext)) then call RegPackBounds(Buf, 2, lbound(InData%F_ext), ubound(InData%F_ext)) call RegPack(Buf, InData%F_ext) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%F_fr)) if (allocated(InData%F_fr)) then call RegPackBounds(Buf, 2, lbound(InData%F_fr), ubound(InData%F_fr)) call RegPack(Buf, InData%F_fr) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%K)) if (allocated(InData%K)) then call RegPackBounds(Buf, 2, lbound(InData%K), ubound(InData%K)) call RegPack(Buf, InData%K) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%C_ctrl)) if (allocated(InData%C_ctrl)) then call RegPackBounds(Buf, 2, lbound(InData%C_ctrl), ubound(InData%C_ctrl)) call RegPack(Buf, InData%C_ctrl) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%C_Brake)) if (allocated(InData%C_Brake)) then call RegPackBounds(Buf, 2, lbound(InData%C_Brake), ubound(InData%C_Brake)) call RegPack(Buf, InData%C_Brake) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%F_table)) if (allocated(InData%F_table)) then call RegPackBounds(Buf, 2, lbound(InData%F_table), ubound(InData%F_table)) call RegPack(Buf, InData%F_table) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%F_k)) if (allocated(InData%F_k)) then call RegPackBounds(Buf, 2, lbound(InData%F_k), ubound(InData%F_k)) call RegPack(Buf, InData%F_k) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%a_G)) if (allocated(InData%a_G)) then call RegPackBounds(Buf, 2, lbound(InData%a_G), ubound(InData%a_G)) call RegPack(Buf, InData%a_G) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%rdisp_P)) if (allocated(InData%rdisp_P)) then call RegPackBounds(Buf, 2, lbound(InData%rdisp_P), ubound(InData%rdisp_P)) call RegPack(Buf, InData%rdisp_P) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%rdot_P)) if (allocated(InData%rdot_P)) then call RegPackBounds(Buf, 2, lbound(InData%rdot_P), ubound(InData%rdot_P)) call RegPack(Buf, InData%rdot_P) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%rddot_P)) if (allocated(InData%rddot_P)) then call RegPackBounds(Buf, 2, lbound(InData%rddot_P), ubound(InData%rddot_P)) call RegPack(Buf, InData%rddot_P) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%omega_P)) if (allocated(InData%omega_P)) then call RegPackBounds(Buf, 2, lbound(InData%omega_P), ubound(InData%omega_P)) call RegPack(Buf, InData%omega_P) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%alpha_P)) if (allocated(InData%alpha_P)) then call RegPackBounds(Buf, 2, lbound(InData%alpha_P), ubound(InData%alpha_P)) call RegPack(Buf, InData%alpha_P) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%F_P)) if (allocated(InData%F_P)) then call RegPackBounds(Buf, 2, lbound(InData%F_P), ubound(InData%F_P)) call RegPack(Buf, InData%F_P) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%M_P)) if (allocated(InData%M_P)) then call RegPackBounds(Buf, 2, lbound(InData%M_P), ubound(InData%M_P)) call RegPack(Buf, InData%M_P) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Acc)) if (allocated(InData%Acc)) then call RegPackBounds(Buf, 2, lbound(InData%Acc), ubound(InData%Acc)) call RegPack(Buf, InData%Acc) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PrescribedInterpIdx) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2314,113 +2215,63 @@ subroutine StC_PackParam(Buf, Indata) character(*), parameter :: RoutineName = 'StC_PackParam' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%DT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RootName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_DOF_MODE) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_X_DOF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_Y_DOF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_Z_DOF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_Z_PreLd) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%M_X) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%M_Y) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%M_Z) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%M_XY) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%K_X) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%K_Y) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%K_Z) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%C_X) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%C_Y) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%C_Z) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%K_S) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%C_S) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%P_SP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%N_SP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Gravity) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_CMODE) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_SA_MODE) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_X_C_HIGH) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_X_C_LOW) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_Y_C_HIGH) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_Y_C_LOW) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_Z_C_HIGH) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_Z_C_LOW) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_X_C_BRAKE) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_Y_C_BRAKE) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%StC_Z_C_BRAKE) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%L_X) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%B_X) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%area_X) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%area_ratio_X) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%headLossCoeff_X) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rho_X) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%L_Y) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%B_Y) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%area_Y) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%area_ratio_Y) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%headLossCoeff_Y) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%rho_Y) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Use_F_TBL) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%F_TBL)) if (allocated(InData%F_TBL)) then call RegPackBounds(Buf, 2, lbound(InData%F_TBL), ubound(InData%F_TBL)) call RegPack(Buf, InData%F_TBL) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumMeshPts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%PrescribedForcesCoordSys) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%StC_PrescribedForce)) if (allocated(InData%StC_PrescribedForce)) then call RegPackBounds(Buf, 2, lbound(InData%StC_PrescribedForce), ubound(InData%StC_PrescribedForce)) call RegPack(Buf, InData%StC_PrescribedForce) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%StC_CChan)) if (allocated(InData%StC_CChan)) then call RegPackBounds(Buf, 1, lbound(InData%StC_CChan), ubound(InData%StC_CChan)) @@ -2716,25 +2567,21 @@ subroutine StC_PackInput(Buf, Indata) call MeshPack(Buf, InData%Mesh(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CmdStiff)) if (allocated(InData%CmdStiff)) then call RegPackBounds(Buf, 2, lbound(InData%CmdStiff), ubound(InData%CmdStiff)) call RegPack(Buf, InData%CmdStiff) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CmdDamp)) if (allocated(InData%CmdDamp)) then call RegPackBounds(Buf, 2, lbound(InData%CmdDamp), ubound(InData%CmdDamp)) call RegPack(Buf, InData%CmdDamp) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CmdBrake)) if (allocated(InData%CmdBrake)) then call RegPackBounds(Buf, 2, lbound(InData%CmdBrake), ubound(InData%CmdBrake)) call RegPack(Buf, InData%CmdBrake) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CmdForce)) if (allocated(InData%CmdForce)) then call RegPackBounds(Buf, 2, lbound(InData%CmdForce), ubound(InData%CmdForce)) @@ -2930,13 +2777,11 @@ subroutine StC_PackOutput(Buf, Indata) call MeshPack(Buf, InData%Mesh(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%MeasDisp)) if (allocated(InData%MeasDisp)) then call RegPackBounds(Buf, 2, lbound(InData%MeasDisp), ubound(InData%MeasDisp)) call RegPack(Buf, InData%MeasDisp) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%MeasVel)) if (allocated(InData%MeasVel)) then call RegPackBounds(Buf, 2, lbound(InData%MeasVel), ubound(InData%MeasVel)) diff --git a/modules/subdyn/src/SubDyn_Types.f90 b/modules/subdyn/src/SubDyn_Types.f90 index 805686b28c..f4ff433473 100644 --- a/modules/subdyn/src/SubDyn_Types.f90 +++ b/modules/subdyn/src/SubDyn_Types.f90 @@ -568,45 +568,37 @@ subroutine SD_PackMeshAuxDataType(Buf, Indata) character(*), parameter :: RoutineName = 'SD_PackMeshAuxDataType' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%MemberID) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NOutCnt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%NodeCnt)) if (allocated(InData%NodeCnt)) then call RegPackBounds(Buf, 1, lbound(InData%NodeCnt), ubound(InData%NodeCnt)) call RegPack(Buf, InData%NodeCnt) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%NodeIDs)) if (allocated(InData%NodeIDs)) then call RegPackBounds(Buf, 1, lbound(InData%NodeIDs), ubound(InData%NodeIDs)) call RegPack(Buf, InData%NodeIDs) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ElmIDs)) if (allocated(InData%ElmIDs)) then call RegPackBounds(Buf, 2, lbound(InData%ElmIDs), ubound(InData%ElmIDs)) call RegPack(Buf, InData%ElmIDs) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ElmNds)) if (allocated(InData%ElmNds)) then call RegPackBounds(Buf, 2, lbound(InData%ElmNds), ubound(InData%ElmNds)) call RegPack(Buf, InData%ElmNds) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Me)) if (allocated(InData%Me)) then call RegPackBounds(Buf, 4, lbound(InData%Me), ubound(InData%Me)) call RegPack(Buf, InData%Me) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Ke)) if (allocated(InData%Ke)) then call RegPackBounds(Buf, 4, lbound(InData%Ke), ubound(InData%Ke)) call RegPack(Buf, InData%Ke) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Fg)) if (allocated(InData%Fg)) then call RegPackBounds(Buf, 3, lbound(InData%Fg), ubound(InData%Fg)) @@ -861,31 +853,26 @@ subroutine SD_PackCB_MatArrays(Buf, Indata) call RegPackBounds(Buf, 2, lbound(InData%MBB), ubound(InData%MBB)) call RegPack(Buf, InData%MBB) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%MBM)) if (allocated(InData%MBM)) then call RegPackBounds(Buf, 2, lbound(InData%MBM), ubound(InData%MBM)) call RegPack(Buf, InData%MBM) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%KBB)) if (allocated(InData%KBB)) then call RegPackBounds(Buf, 2, lbound(InData%KBB), ubound(InData%KBB)) call RegPack(Buf, InData%KBB) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PhiL)) if (allocated(InData%PhiL)) then call RegPackBounds(Buf, 2, lbound(InData%PhiL), ubound(InData%PhiL)) call RegPack(Buf, InData%PhiL) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PhiR)) if (allocated(InData%PhiR)) then call RegPackBounds(Buf, 2, lbound(InData%PhiR), ubound(InData%PhiR)) call RegPack(Buf, InData%PhiR) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OmegaL)) if (allocated(InData%OmegaL)) then call RegPackBounds(Buf, 1, lbound(InData%OmegaL), ubound(InData%OmegaL)) @@ -1029,33 +1016,19 @@ subroutine SD_PackElemPropType(Buf, Indata) character(*), parameter :: RoutineName = 'SD_PackElemPropType' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%eType) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Length) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Ixx) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Iyy) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Jzz) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Shear) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Kappa_x) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Kappa_y) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YoungE) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%ShearG) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%D) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Area) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Rho) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%T0) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DirCos) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1155,25 +1128,17 @@ subroutine SD_PackInitInput(Buf, Indata) character(*), parameter :: RoutineName = 'SD_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%SDInputFile) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RootName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%g) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WtrDpth) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TP_RefPoint) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SubRotateZ) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%SoilStiffness)) if (allocated(InData%SoilStiffness)) then call RegPackBounds(Buf, 3, lbound(InData%SoilStiffness), ubound(InData%SoilStiffness)) call RegPack(Buf, InData%SoilStiffness) end if - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%SoilMesh) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Linearize) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -1442,63 +1407,52 @@ subroutine SD_PackInitOutput(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) call RegPack(Buf, InData%WriteOutputHdr) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) call RegPack(Buf, InData%WriteOutputUnt) end if - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackProgDesc(Buf, InData%Ver) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LinNames_y)) if (allocated(InData%LinNames_y)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_y), ubound(InData%LinNames_y)) call RegPack(Buf, InData%LinNames_y) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LinNames_x)) if (allocated(InData%LinNames_x)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_x), ubound(InData%LinNames_x)) call RegPack(Buf, InData%LinNames_x) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%LinNames_u)) if (allocated(InData%LinNames_u)) then call RegPackBounds(Buf, 1, lbound(InData%LinNames_u), ubound(InData%LinNames_u)) call RegPack(Buf, InData%LinNames_u) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RotFrame_y)) if (allocated(InData%RotFrame_y)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_y), ubound(InData%RotFrame_y)) call RegPack(Buf, InData%RotFrame_y) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RotFrame_x)) if (allocated(InData%RotFrame_x)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_x), ubound(InData%RotFrame_x)) call RegPack(Buf, InData%RotFrame_x) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%RotFrame_u)) if (allocated(InData%RotFrame_u)) then call RegPackBounds(Buf, 1, lbound(InData%RotFrame_u), ubound(InData%RotFrame_u)) call RegPack(Buf, InData%RotFrame_u) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%IsLoad_u)) if (allocated(InData%IsLoad_u)) then call RegPackBounds(Buf, 1, lbound(InData%IsLoad_u), ubound(InData%IsLoad_u)) call RegPack(Buf, InData%IsLoad_u) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%DerivOrder_x)) if (allocated(InData%DerivOrder_x)) then call RegPackBounds(Buf, 1, lbound(InData%DerivOrder_x), ubound(InData%DerivOrder_x)) call RegPack(Buf, InData%DerivOrder_x) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CableCChanRqst)) if (allocated(InData%CableCChanRqst)) then call RegPackBounds(Buf, 1, lbound(InData%CableCChanRqst), ubound(InData%CableCChanRqst)) @@ -2167,209 +2121,159 @@ subroutine SD_PackInitType(Buf, Indata) character(*), parameter :: RoutineName = 'SD_PackInitType' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%RootName) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TP_RefPoint) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SubRotateZ) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%g) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NJoints) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NPropSetsX) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NPropSetsB) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NPropSetsC) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NPropSetsR) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NCMass) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NCOSMs) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FEMMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NDiv) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%CBMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Joints)) if (allocated(InData%Joints)) then call RegPackBounds(Buf, 2, lbound(InData%Joints), ubound(InData%Joints)) call RegPack(Buf, InData%Joints) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PropSetsB)) if (allocated(InData%PropSetsB)) then call RegPackBounds(Buf, 2, lbound(InData%PropSetsB), ubound(InData%PropSetsB)) call RegPack(Buf, InData%PropSetsB) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PropSetsC)) if (allocated(InData%PropSetsC)) then call RegPackBounds(Buf, 2, lbound(InData%PropSetsC), ubound(InData%PropSetsC)) call RegPack(Buf, InData%PropSetsC) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PropSetsR)) if (allocated(InData%PropSetsR)) then call RegPackBounds(Buf, 2, lbound(InData%PropSetsR), ubound(InData%PropSetsR)) call RegPack(Buf, InData%PropSetsR) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PropSetsX)) if (allocated(InData%PropSetsX)) then call RegPackBounds(Buf, 2, lbound(InData%PropSetsX), ubound(InData%PropSetsX)) call RegPack(Buf, InData%PropSetsX) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%COSMs)) if (allocated(InData%COSMs)) then call RegPackBounds(Buf, 2, lbound(InData%COSMs), ubound(InData%COSMs)) call RegPack(Buf, InData%COSMs) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CMass)) if (allocated(InData%CMass)) then call RegPackBounds(Buf, 2, lbound(InData%CMass), ubound(InData%CMass)) call RegPack(Buf, InData%CMass) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%JDampings)) if (allocated(InData%JDampings)) then call RegPackBounds(Buf, 1, lbound(InData%JDampings), ubound(InData%JDampings)) call RegPack(Buf, InData%JDampings) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%GuyanDampMod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RayleighDamp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%GuyanDampMat) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Members)) if (allocated(InData%Members)) then call RegPackBounds(Buf, 2, lbound(InData%Members), ubound(InData%Members)) call RegPack(Buf, InData%Members) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%SSOutList)) if (allocated(InData%SSOutList)) then call RegPackBounds(Buf, 1, lbound(InData%SSOutList), ubound(InData%SSOutList)) call RegPack(Buf, InData%SSOutList) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutCOSM) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TabDelim) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%SSIK)) if (allocated(InData%SSIK)) then call RegPackBounds(Buf, 2, lbound(InData%SSIK), ubound(InData%SSIK)) call RegPack(Buf, InData%SSIK) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%SSIM)) if (allocated(InData%SSIM)) then call RegPackBounds(Buf, 2, lbound(InData%SSIM), ubound(InData%SSIM)) call RegPack(Buf, InData%SSIM) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%SSIfile)) if (allocated(InData%SSIfile)) then call RegPackBounds(Buf, 1, lbound(InData%SSIfile), ubound(InData%SSIfile)) call RegPack(Buf, InData%SSIfile) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Soil_K)) if (allocated(InData%Soil_K)) then call RegPackBounds(Buf, 3, lbound(InData%Soil_K), ubound(InData%Soil_K)) call RegPack(Buf, InData%Soil_K) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Soil_Points)) if (allocated(InData%Soil_Points)) then call RegPackBounds(Buf, 2, lbound(InData%Soil_Points), ubound(InData%Soil_Points)) call RegPack(Buf, InData%Soil_Points) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Soil_Nodes)) if (allocated(InData%Soil_Nodes)) then call RegPackBounds(Buf, 1, lbound(InData%Soil_Nodes), ubound(InData%Soil_Nodes)) call RegPack(Buf, InData%Soil_Nodes) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NElem) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NPropB) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NPropC) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NPropR) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Nodes)) if (allocated(InData%Nodes)) then call RegPackBounds(Buf, 2, lbound(InData%Nodes), ubound(InData%Nodes)) call RegPack(Buf, InData%Nodes) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PropsB)) if (allocated(InData%PropsB)) then call RegPackBounds(Buf, 2, lbound(InData%PropsB), ubound(InData%PropsB)) call RegPack(Buf, InData%PropsB) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PropsC)) if (allocated(InData%PropsC)) then call RegPackBounds(Buf, 2, lbound(InData%PropsC), ubound(InData%PropsC)) call RegPack(Buf, InData%PropsC) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PropsR)) if (allocated(InData%PropsR)) then call RegPackBounds(Buf, 2, lbound(InData%PropsR), ubound(InData%PropsR)) call RegPack(Buf, InData%PropsR) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%K)) if (allocated(InData%K)) then call RegPackBounds(Buf, 2, lbound(InData%K), ubound(InData%K)) call RegPack(Buf, InData%K) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%M)) if (allocated(InData%M)) then call RegPackBounds(Buf, 2, lbound(InData%M), ubound(InData%M)) call RegPack(Buf, InData%M) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ElemProps)) if (allocated(InData%ElemProps)) then call RegPackBounds(Buf, 2, lbound(InData%ElemProps), ubound(InData%ElemProps)) call RegPack(Buf, InData%ElemProps) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%MemberNodes)) if (allocated(InData%MemberNodes)) then call RegPackBounds(Buf, 2, lbound(InData%MemberNodes), ubound(InData%MemberNodes)) call RegPack(Buf, InData%MemberNodes) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%NodesConnN)) if (allocated(InData%NodesConnN)) then call RegPackBounds(Buf, 2, lbound(InData%NodesConnN), ubound(InData%NodesConnN)) call RegPack(Buf, InData%NodesConnN) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%NodesConnE)) if (allocated(InData%NodesConnE)) then call RegPackBounds(Buf, 2, lbound(InData%NodesConnE), ubound(InData%NodesConnE)) call RegPack(Buf, InData%NodesConnE) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SSSum) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2864,7 +2768,6 @@ subroutine SD_PackContState(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%qm), ubound(InData%qm)) call RegPack(Buf, InData%qm) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%qmdot)) if (allocated(InData%qmdot)) then call RegPackBounds(Buf, 1, lbound(InData%qmdot), ubound(InData%qmdot)) @@ -3061,7 +2964,6 @@ subroutine SD_PackOtherState(Buf, Indata) call SD_PackContState(Buf, InData%xdot(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%n) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -3539,149 +3441,121 @@ subroutine SD_PackMisc(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%qmdotdot), ubound(InData%qmdotdot)) call RegPack(Buf, InData%qmdotdot) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%u_TP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%udot_TP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%udotdot_TP) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%F_L)) if (allocated(InData%F_L)) then call RegPackBounds(Buf, 1, lbound(InData%F_L), ubound(InData%F_L)) call RegPack(Buf, InData%F_L) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%F_L2)) if (allocated(InData%F_L2)) then call RegPackBounds(Buf, 1, lbound(InData%F_L2), ubound(InData%F_L2)) call RegPack(Buf, InData%F_L2) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%UR_bar)) if (allocated(InData%UR_bar)) then call RegPackBounds(Buf, 1, lbound(InData%UR_bar), ubound(InData%UR_bar)) call RegPack(Buf, InData%UR_bar) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%UR_bar_dot)) if (allocated(InData%UR_bar_dot)) then call RegPackBounds(Buf, 1, lbound(InData%UR_bar_dot), ubound(InData%UR_bar_dot)) call RegPack(Buf, InData%UR_bar_dot) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%UR_bar_dotdot)) if (allocated(InData%UR_bar_dotdot)) then call RegPackBounds(Buf, 1, lbound(InData%UR_bar_dotdot), ubound(InData%UR_bar_dotdot)) call RegPack(Buf, InData%UR_bar_dotdot) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%UL)) if (allocated(InData%UL)) then call RegPackBounds(Buf, 1, lbound(InData%UL), ubound(InData%UL)) call RegPack(Buf, InData%UL) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%UL_NS)) if (allocated(InData%UL_NS)) then call RegPackBounds(Buf, 1, lbound(InData%UL_NS), ubound(InData%UL_NS)) call RegPack(Buf, InData%UL_NS) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%UL_dot)) if (allocated(InData%UL_dot)) then call RegPackBounds(Buf, 1, lbound(InData%UL_dot), ubound(InData%UL_dot)) call RegPack(Buf, InData%UL_dot) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%UL_dotdot)) if (allocated(InData%UL_dotdot)) then call RegPackBounds(Buf, 1, lbound(InData%UL_dotdot), ubound(InData%UL_dotdot)) call RegPack(Buf, InData%UL_dotdot) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%DU_full)) if (allocated(InData%DU_full)) then call RegPackBounds(Buf, 1, lbound(InData%DU_full), ubound(InData%DU_full)) call RegPack(Buf, InData%DU_full) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%U_full)) if (allocated(InData%U_full)) then call RegPackBounds(Buf, 1, lbound(InData%U_full), ubound(InData%U_full)) call RegPack(Buf, InData%U_full) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%U_full_NS)) if (allocated(InData%U_full_NS)) then call RegPackBounds(Buf, 1, lbound(InData%U_full_NS), ubound(InData%U_full_NS)) call RegPack(Buf, InData%U_full_NS) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%U_full_dot)) if (allocated(InData%U_full_dot)) then call RegPackBounds(Buf, 1, lbound(InData%U_full_dot), ubound(InData%U_full_dot)) call RegPack(Buf, InData%U_full_dot) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%U_full_dotdot)) if (allocated(InData%U_full_dotdot)) then call RegPackBounds(Buf, 1, lbound(InData%U_full_dotdot), ubound(InData%U_full_dotdot)) call RegPack(Buf, InData%U_full_dotdot) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%U_full_elast)) if (allocated(InData%U_full_elast)) then call RegPackBounds(Buf, 1, lbound(InData%U_full_elast), ubound(InData%U_full_elast)) call RegPack(Buf, InData%U_full_elast) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%U_red)) if (allocated(InData%U_red)) then call RegPackBounds(Buf, 1, lbound(InData%U_red), ubound(InData%U_red)) call RegPack(Buf, InData%U_red) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FC_unit)) if (allocated(InData%FC_unit)) then call RegPackBounds(Buf, 1, lbound(InData%FC_unit), ubound(InData%FC_unit)) call RegPack(Buf, InData%FC_unit) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%SDWrOutput)) if (allocated(InData%SDWrOutput)) then call RegPackBounds(Buf, 1, lbound(InData%SDWrOutput), ubound(InData%SDWrOutput)) call RegPack(Buf, InData%SDWrOutput) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AllOuts)) if (allocated(InData%AllOuts)) then call RegPackBounds(Buf, 1, lbound(InData%AllOuts), ubound(InData%AllOuts)) call RegPack(Buf, InData%AllOuts) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%LastOutTime) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Decimat) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Fext)) if (allocated(InData%Fext)) then call RegPackBounds(Buf, 1, lbound(InData%Fext), ubound(InData%Fext)) call RegPack(Buf, InData%Fext) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Fext_red)) if (allocated(InData%Fext_red)) then call RegPackBounds(Buf, 1, lbound(InData%Fext_red), ubound(InData%Fext_red)) call RegPack(Buf, InData%Fext_red) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%UL_SIM)) if (allocated(InData%UL_SIM)) then call RegPackBounds(Buf, 1, lbound(InData%UL_SIM), ubound(InData%UL_SIM)) call RegPack(Buf, InData%UL_SIM) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%UL_0m)) if (allocated(InData%UL_0m)) then call RegPackBounds(Buf, 1, lbound(InData%UL_0m), ubound(InData%UL_0m)) @@ -5199,21 +5073,15 @@ subroutine SD_PackParam(Buf, Indata) integer(IntKi) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%SDDeltaT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%IntMethod) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nDOF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nDOF_red) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Nmembers) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Elems)) if (allocated(InData%Elems)) then call RegPackBounds(Buf, 2, lbound(InData%Elems), ubound(InData%Elems)) call RegPack(Buf, InData%Elems) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ElemProps)) if (allocated(InData%ElemProps)) then call RegPackBounds(Buf, 1, lbound(InData%ElemProps), ubound(InData%ElemProps)) @@ -5223,39 +5091,32 @@ subroutine SD_PackParam(Buf, Indata) call SD_PackElemPropType(Buf, InData%ElemProps(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%FG)) if (allocated(InData%FG)) then call RegPackBounds(Buf, 1, lbound(InData%FG), ubound(InData%FG)) call RegPack(Buf, InData%FG) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%DP0)) if (allocated(InData%DP0)) then call RegPackBounds(Buf, 2, lbound(InData%DP0), ubound(InData%DP0)) call RegPack(Buf, InData%DP0) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%NodeID2JointID)) if (allocated(InData%NodeID2JointID)) then call RegPackBounds(Buf, 1, lbound(InData%NodeID2JointID), ubound(InData%NodeID2JointID)) call RegPack(Buf, InData%NodeID2JointID) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%reduced) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%T_red)) if (allocated(InData%T_red)) then call RegPackBounds(Buf, 2, lbound(InData%T_red), ubound(InData%T_red)) call RegPack(Buf, InData%T_red) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%T_red_T)) if (allocated(InData%T_red_T)) then call RegPackBounds(Buf, 2, lbound(InData%T_red_T), ubound(InData%T_red_T)) call RegPack(Buf, InData%T_red_T) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%NodesDOF)) if (allocated(InData%NodesDOF)) then call RegPackBounds(Buf, 1, lbound(InData%NodesDOF), ubound(InData%NodesDOF)) @@ -5265,7 +5126,6 @@ subroutine SD_PackParam(Buf, Indata) call SD_PackIList(Buf, InData%NodesDOF(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%NodesDOFred)) if (allocated(InData%NodesDOFred)) then call RegPackBounds(Buf, 1, lbound(InData%NodesDOFred), ubound(InData%NodesDOFred)) @@ -5275,325 +5135,253 @@ subroutine SD_PackParam(Buf, Indata) call SD_PackIList(Buf, InData%NodesDOFred(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ElemsDOF)) if (allocated(InData%ElemsDOF)) then call RegPackBounds(Buf, 2, lbound(InData%ElemsDOF), ubound(InData%ElemsDOF)) call RegPack(Buf, InData%ElemsDOF) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%DOFred2Nodes)) if (allocated(InData%DOFred2Nodes)) then call RegPackBounds(Buf, 2, lbound(InData%DOFred2Nodes), ubound(InData%DOFred2Nodes)) call RegPack(Buf, InData%DOFred2Nodes) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CtrlElem2Channel)) if (allocated(InData%CtrlElem2Channel)) then call RegPackBounds(Buf, 2, lbound(InData%CtrlElem2Channel), ubound(InData%CtrlElem2Channel)) call RegPack(Buf, InData%CtrlElem2Channel) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nDOFM) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%SttcSolve) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%GuyanLoadCorrection) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Floating) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%KMMDiag)) if (allocated(InData%KMMDiag)) then call RegPackBounds(Buf, 1, lbound(InData%KMMDiag), ubound(InData%KMMDiag)) call RegPack(Buf, InData%KMMDiag) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CMMDiag)) if (allocated(InData%CMMDiag)) then call RegPackBounds(Buf, 1, lbound(InData%CMMDiag), ubound(InData%CMMDiag)) call RegPack(Buf, InData%CMMDiag) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%MMB)) if (allocated(InData%MMB)) then call RegPackBounds(Buf, 2, lbound(InData%MMB), ubound(InData%MMB)) call RegPack(Buf, InData%MMB) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%MBmmB)) if (allocated(InData%MBmmB)) then call RegPackBounds(Buf, 2, lbound(InData%MBmmB), ubound(InData%MBmmB)) call RegPack(Buf, InData%MBmmB) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%C1_11)) if (allocated(InData%C1_11)) then call RegPackBounds(Buf, 2, lbound(InData%C1_11), ubound(InData%C1_11)) call RegPack(Buf, InData%C1_11) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%C1_12)) if (allocated(InData%C1_12)) then call RegPackBounds(Buf, 2, lbound(InData%C1_12), ubound(InData%C1_12)) call RegPack(Buf, InData%C1_12) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%D1_141)) if (allocated(InData%D1_141)) then call RegPackBounds(Buf, 2, lbound(InData%D1_141), ubound(InData%D1_141)) call RegPack(Buf, InData%D1_141) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%D1_142)) if (allocated(InData%D1_142)) then call RegPackBounds(Buf, 2, lbound(InData%D1_142), ubound(InData%D1_142)) call RegPack(Buf, InData%D1_142) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PhiM)) if (allocated(InData%PhiM)) then call RegPackBounds(Buf, 2, lbound(InData%PhiM), ubound(InData%PhiM)) call RegPack(Buf, InData%PhiM) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%C2_61)) if (allocated(InData%C2_61)) then call RegPackBounds(Buf, 2, lbound(InData%C2_61), ubound(InData%C2_61)) call RegPack(Buf, InData%C2_61) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%C2_62)) if (allocated(InData%C2_62)) then call RegPackBounds(Buf, 2, lbound(InData%C2_62), ubound(InData%C2_62)) call RegPack(Buf, InData%C2_62) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PhiRb_TI)) if (allocated(InData%PhiRb_TI)) then call RegPackBounds(Buf, 2, lbound(InData%PhiRb_TI), ubound(InData%PhiRb_TI)) call RegPack(Buf, InData%PhiRb_TI) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%D2_63)) if (allocated(InData%D2_63)) then call RegPackBounds(Buf, 2, lbound(InData%D2_63), ubound(InData%D2_63)) call RegPack(Buf, InData%D2_63) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%D2_64)) if (allocated(InData%D2_64)) then call RegPackBounds(Buf, 2, lbound(InData%D2_64), ubound(InData%D2_64)) call RegPack(Buf, InData%D2_64) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%MBB)) if (allocated(InData%MBB)) then call RegPackBounds(Buf, 2, lbound(InData%MBB), ubound(InData%MBB)) call RegPack(Buf, InData%MBB) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%KBB)) if (allocated(InData%KBB)) then call RegPackBounds(Buf, 2, lbound(InData%KBB), ubound(InData%KBB)) call RegPack(Buf, InData%KBB) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CBB)) if (allocated(InData%CBB)) then call RegPackBounds(Buf, 2, lbound(InData%CBB), ubound(InData%CBB)) call RegPack(Buf, InData%CBB) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CMM)) if (allocated(InData%CMM)) then call RegPackBounds(Buf, 2, lbound(InData%CMM), ubound(InData%CMM)) call RegPack(Buf, InData%CMM) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%MBM)) if (allocated(InData%MBM)) then call RegPackBounds(Buf, 2, lbound(InData%MBM), ubound(InData%MBM)) call RegPack(Buf, InData%MBM) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PhiL_T)) if (allocated(InData%PhiL_T)) then call RegPackBounds(Buf, 2, lbound(InData%PhiL_T), ubound(InData%PhiL_T)) call RegPack(Buf, InData%PhiL_T) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%PhiLInvOmgL2)) if (allocated(InData%PhiLInvOmgL2)) then call RegPackBounds(Buf, 2, lbound(InData%PhiLInvOmgL2), ubound(InData%PhiLInvOmgL2)) call RegPack(Buf, InData%PhiLInvOmgL2) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%KLLm1)) if (allocated(InData%KLLm1)) then call RegPackBounds(Buf, 2, lbound(InData%KLLm1), ubound(InData%KLLm1)) call RegPack(Buf, InData%KLLm1) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AM2Jac)) if (allocated(InData%AM2Jac)) then call RegPackBounds(Buf, 2, lbound(InData%AM2Jac), ubound(InData%AM2Jac)) call RegPack(Buf, InData%AM2Jac) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%AM2JacPiv)) if (allocated(InData%AM2JacPiv)) then call RegPackBounds(Buf, 1, lbound(InData%AM2JacPiv), ubound(InData%AM2JacPiv)) call RegPack(Buf, InData%AM2JacPiv) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TI)) if (allocated(InData%TI)) then call RegPackBounds(Buf, 2, lbound(InData%TI), ubound(InData%TI)) call RegPack(Buf, InData%TI) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TIreact)) if (allocated(InData%TIreact)) then call RegPackBounds(Buf, 2, lbound(InData%TIreact), ubound(InData%TIreact)) call RegPack(Buf, InData%TIreact) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nNodes) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nNodes_I) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nNodes_L) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nNodes_C) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Nodes_I)) if (allocated(InData%Nodes_I)) then call RegPackBounds(Buf, 2, lbound(InData%Nodes_I), ubound(InData%Nodes_I)) call RegPack(Buf, InData%Nodes_I) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Nodes_L)) if (allocated(InData%Nodes_L)) then call RegPackBounds(Buf, 2, lbound(InData%Nodes_L), ubound(InData%Nodes_L)) call RegPack(Buf, InData%Nodes_L) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Nodes_C)) if (allocated(InData%Nodes_C)) then call RegPackBounds(Buf, 2, lbound(InData%Nodes_C), ubound(InData%Nodes_C)) call RegPack(Buf, InData%Nodes_C) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nDOFI__) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nDOFI_Rb) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nDOFI_F) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nDOFL_L) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nDOFC__) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nDOFC_Rb) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nDOFC_L) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nDOFC_F) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nDOFR__) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nDOF__Rb) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nDOF__L) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nDOF__F) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%IDI__)) if (allocated(InData%IDI__)) then call RegPackBounds(Buf, 1, lbound(InData%IDI__), ubound(InData%IDI__)) call RegPack(Buf, InData%IDI__) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%IDI_Rb)) if (allocated(InData%IDI_Rb)) then call RegPackBounds(Buf, 1, lbound(InData%IDI_Rb), ubound(InData%IDI_Rb)) call RegPack(Buf, InData%IDI_Rb) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%IDI_F)) if (allocated(InData%IDI_F)) then call RegPackBounds(Buf, 1, lbound(InData%IDI_F), ubound(InData%IDI_F)) call RegPack(Buf, InData%IDI_F) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%IDL_L)) if (allocated(InData%IDL_L)) then call RegPackBounds(Buf, 1, lbound(InData%IDL_L), ubound(InData%IDL_L)) call RegPack(Buf, InData%IDL_L) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%IDC__)) if (allocated(InData%IDC__)) then call RegPackBounds(Buf, 1, lbound(InData%IDC__), ubound(InData%IDC__)) call RegPack(Buf, InData%IDC__) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%IDC_Rb)) if (allocated(InData%IDC_Rb)) then call RegPackBounds(Buf, 1, lbound(InData%IDC_Rb), ubound(InData%IDC_Rb)) call RegPack(Buf, InData%IDC_Rb) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%IDC_L)) if (allocated(InData%IDC_L)) then call RegPackBounds(Buf, 1, lbound(InData%IDC_L), ubound(InData%IDC_L)) call RegPack(Buf, InData%IDC_L) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%IDC_F)) if (allocated(InData%IDC_F)) then call RegPackBounds(Buf, 1, lbound(InData%IDC_F), ubound(InData%IDC_F)) call RegPack(Buf, InData%IDC_F) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%IDR__)) if (allocated(InData%IDR__)) then call RegPackBounds(Buf, 1, lbound(InData%IDR__), ubound(InData%IDR__)) call RegPack(Buf, InData%IDR__) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ID__Rb)) if (allocated(InData%ID__Rb)) then call RegPackBounds(Buf, 1, lbound(InData%ID__Rb), ubound(InData%ID__Rb)) call RegPack(Buf, InData%ID__Rb) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ID__L)) if (allocated(InData%ID__L)) then call RegPackBounds(Buf, 1, lbound(InData%ID__L), ubound(InData%ID__L)) call RegPack(Buf, InData%ID__L) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%ID__F)) if (allocated(InData%ID__F)) then call RegPackBounds(Buf, 1, lbound(InData%ID__F), ubound(InData%ID__F)) call RegPack(Buf, InData%ID__F) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NMOutputs) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumOuts) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutSwtch) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%UnJckF) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Delim) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutFmt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutSFmt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%MoutLst)) if (allocated(InData%MoutLst)) then call RegPackBounds(Buf, 1, lbound(InData%MoutLst), ubound(InData%MoutLst)) @@ -5603,7 +5391,6 @@ subroutine SD_PackParam(Buf, Indata) call SD_PackMeshAuxDataType(Buf, InData%MoutLst(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%MoutLst2)) if (allocated(InData%MoutLst2)) then call RegPackBounds(Buf, 1, lbound(InData%MoutLst2), ubound(InData%MoutLst2)) @@ -5613,7 +5400,6 @@ subroutine SD_PackParam(Buf, Indata) call SD_PackMeshAuxDataType(Buf, InData%MoutLst2(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%MoutLst3)) if (allocated(InData%MoutLst3)) then call RegPackBounds(Buf, 1, lbound(InData%MoutLst3), ubound(InData%MoutLst3)) @@ -5623,7 +5409,6 @@ subroutine SD_PackParam(Buf, Indata) call SD_PackMeshAuxDataType(Buf, InData%MoutLst3(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then call RegPackBounds(Buf, 1, lbound(InData%OutParam), ubound(InData%OutParam)) @@ -5633,39 +5418,26 @@ subroutine SD_PackParam(Buf, Indata) call NWTC_Library_PackOutParmType(Buf, InData%OutParam(i1)) end do end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutAll) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutCBModes) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutFEMModes) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutReact) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutAllInt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutAllDims) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutDec) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Jac_u_indx)) if (allocated(InData%Jac_u_indx)) then call RegPackBounds(Buf, 2, lbound(InData%Jac_u_indx), ubound(InData%Jac_u_indx)) call RegPack(Buf, InData%Jac_u_indx) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%du)) if (allocated(InData%du)) then call RegPackBounds(Buf, 1, lbound(InData%du), ubound(InData%du)) call RegPack(Buf, InData%du) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dx) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Jac_ny) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Jac_nx) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%RotStates) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -6656,9 +6428,7 @@ subroutine SD_PackInput(Buf, Indata) character(*), parameter :: RoutineName = 'SD_PackInput' if (Buf%ErrStat >= AbortErrLev) return call MeshPack(Buf, InData%TPMesh) - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%LMesh) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%CableDeltaL)) if (allocated(InData%CableDeltaL)) then call RegPackBounds(Buf, 1, lbound(InData%CableDeltaL), ubound(InData%CableDeltaL)) @@ -6750,11 +6520,8 @@ subroutine SD_PackOutput(Buf, Indata) character(*), parameter :: RoutineName = 'SD_PackOutput' if (Buf%ErrStat >= AbortErrLev) return call MeshPack(Buf, InData%Y1Mesh) - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%Y2Mesh) - if (RegCheckErr(Buf, RoutineName)) return call MeshPack(Buf, InData%Y3Mesh) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutput)) if (allocated(InData%WriteOutput)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutput), ubound(InData%WriteOutput)) diff --git a/modules/supercontroller/src/SCDataEx_Types.f90 b/modules/supercontroller/src/SCDataEx_Types.f90 index 2f721eeacf..fd404597b7 100644 --- a/modules/supercontroller/src/SCDataEx_Types.f90 +++ b/modules/supercontroller/src/SCDataEx_Types.f90 @@ -129,9 +129,7 @@ subroutine SC_DX_PackInitInput(Buf, Indata) return end if call RegPack(Buf, InData%NumSC2Ctrl) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumSC2CtrlGlob) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumCtrl2SC) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -382,6 +380,7 @@ subroutine SC_DX_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg DstInputData%toSC = SrcInputData%toSC else if (associated(DstInputData%toSC)) then deallocate(DstInputData%toSC) + nullify(DstInputData%toSC) end if end subroutine @@ -541,6 +540,7 @@ subroutine SC_DX_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err DstOutputData%fromSC = SrcOutputData%fromSC else if (associated(DstOutputData%fromSC)) then deallocate(DstOutputData%fromSC) + nullify(DstOutputData%fromSC) end if if (associated(SrcOutputData%fromSCglob)) then LB(1:1) = lbound(SrcOutputData%fromSCglob) @@ -558,6 +558,7 @@ subroutine SC_DX_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err DstOutputData%fromSCglob = SrcOutputData%fromSCglob else if (associated(DstOutputData%fromSCglob)) then deallocate(DstOutputData%fromSCglob) + nullify(DstOutputData%fromSCglob) end if end subroutine @@ -600,7 +601,6 @@ subroutine SC_DX_PackOutput(Buf, Indata) call RegPack(Buf, InData%fromSC) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%fromSCglob)) if (associated(InData%fromSCglob)) then call RegPackBounds(Buf, 1, lbound(InData%fromSCglob), ubound(InData%fromSCglob)) diff --git a/modules/supercontroller/src/SuperController_Types.f90 b/modules/supercontroller/src/SuperController_Types.f90 index a4a2e0f97c..8547edcc29 100644 --- a/modules/supercontroller/src/SuperController_Types.f90 +++ b/modules/supercontroller/src/SuperController_Types.f90 @@ -215,7 +215,6 @@ subroutine SC_PackInitInput(Buf, Indata) return end if call RegPack(Buf, InData%nTurbines) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%DLL_FileName) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -316,13 +315,9 @@ subroutine SC_PackInitOutput(Buf, Indata) return end if call NWTC_Library_PackProgDesc(Buf, InData%Ver) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumCtrl2SC) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nInpGlobal) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumSC2Ctrl) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumSC2CtrlGlob) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -437,6 +432,7 @@ subroutine SC_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%ParamGlobal = SrcParamData%ParamGlobal else if (associated(DstParamData%ParamGlobal)) then deallocate(DstParamData%ParamGlobal) + nullify(DstParamData%ParamGlobal) end if if (associated(SrcParamData%ParamTurbine)) then LB(1:1) = lbound(SrcParamData%ParamTurbine) @@ -454,6 +450,7 @@ subroutine SC_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%ParamTurbine = SrcParamData%ParamTurbine else if (associated(DstParamData%ParamTurbine)) then deallocate(DstParamData%ParamTurbine) + nullify(DstParamData%ParamTurbine) end if DstParamData%DLL_Trgt = SrcParamData%DLL_Trgt end subroutine @@ -492,25 +489,15 @@ subroutine SC_PackParam(Buf, Indata) return end if call RegPack(Buf, InData%DT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nTurbines) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumCtrl2SC) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%nInpGlobal) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumSC2Ctrl) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumSC2CtrlGlob) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumStatesGlobal) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumStatesTurbine) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumParamGlobal) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumParamTurbine) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%ParamGlobal)) if (associated(InData%ParamGlobal)) then call RegPackBounds(Buf, 1, lbound(InData%ParamGlobal), ubound(InData%ParamGlobal)) @@ -519,7 +506,6 @@ subroutine SC_PackParam(Buf, Indata) call RegPack(Buf, InData%ParamGlobal) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%ParamTurbine)) if (associated(InData%ParamTurbine)) then call RegPackBounds(Buf, 1, lbound(InData%ParamTurbine), ubound(InData%ParamTurbine)) @@ -528,7 +514,6 @@ subroutine SC_PackParam(Buf, Indata) call RegPack(Buf, InData%ParamTurbine) end if end if - if (RegCheckErr(Buf, RoutineName)) return call DLLTypePack(Buf, InData%DLL_Trgt) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -751,6 +736,7 @@ subroutine SC_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Global = SrcDiscStateData%Global else if (associated(DstDiscStateData%Global)) then deallocate(DstDiscStateData%Global) + nullify(DstDiscStateData%Global) end if if (associated(SrcDiscStateData%Turbine)) then LB(1:1) = lbound(SrcDiscStateData%Turbine) @@ -768,6 +754,7 @@ subroutine SC_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Turbine = SrcDiscStateData%Turbine else if (associated(DstDiscStateData%Turbine)) then deallocate(DstDiscStateData%Turbine) + nullify(DstDiscStateData%Turbine) end if end subroutine @@ -810,7 +797,6 @@ subroutine SC_PackDiscState(Buf, Indata) call RegPack(Buf, InData%Global) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%Turbine)) if (associated(InData%Turbine)) then call RegPackBounds(Buf, 1, lbound(InData%Turbine), ubound(InData%Turbine)) @@ -1313,6 +1299,7 @@ subroutine SC_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%toSCglob = SrcInputData%toSCglob else if (associated(DstInputData%toSCglob)) then deallocate(DstInputData%toSCglob) + nullify(DstInputData%toSCglob) end if if (associated(SrcInputData%toSC)) then LB(1:1) = lbound(SrcInputData%toSC) @@ -1330,6 +1317,7 @@ subroutine SC_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%toSC = SrcInputData%toSC else if (associated(DstInputData%toSC)) then deallocate(DstInputData%toSC) + nullify(DstInputData%toSC) end if end subroutine @@ -1372,7 +1360,6 @@ subroutine SC_PackInput(Buf, Indata) call RegPack(Buf, InData%toSCglob) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%toSC)) if (associated(InData%toSC)) then call RegPackBounds(Buf, 1, lbound(InData%toSC), ubound(InData%toSC)) @@ -1551,6 +1538,7 @@ subroutine SC_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%fromSCglob = SrcOutputData%fromSCglob else if (associated(DstOutputData%fromSCglob)) then deallocate(DstOutputData%fromSCglob) + nullify(DstOutputData%fromSCglob) end if if (associated(SrcOutputData%fromSC)) then LB(1:1) = lbound(SrcOutputData%fromSC) @@ -1568,6 +1556,7 @@ subroutine SC_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%fromSC = SrcOutputData%fromSC else if (associated(DstOutputData%fromSC)) then deallocate(DstOutputData%fromSC) + nullify(DstOutputData%fromSC) end if end subroutine @@ -1610,7 +1599,6 @@ subroutine SC_PackOutput(Buf, Indata) call RegPack(Buf, InData%fromSCglob) end if end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, associated(InData%fromSC)) if (associated(InData%fromSC)) then call RegPackBounds(Buf, 1, lbound(InData%fromSC), ubound(InData%fromSC)) diff --git a/modules/wakedynamics/src/WakeDynamics_Types.f90 b/modules/wakedynamics/src/WakeDynamics_Types.f90 index 185cfb926b..4a3d8d93ae 100644 --- a/modules/wakedynamics/src/WakeDynamics_Types.f90 +++ b/modules/wakedynamics/src/WakeDynamics_Types.f90 @@ -288,67 +288,36 @@ subroutine WD_PackInputFileType(Buf, Indata) character(*), parameter :: RoutineName = 'WD_PackInputFileType' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%dr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumRadii) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumPlanes) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Mod_Wake) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%f_c) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%C_HWkDfl_O) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%C_HWkDfl_OY) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%C_HWkDfl_x) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%C_HWkDfl_xY) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%C_NearWake) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%k_vAmb) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%k_vShr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%C_vAmb_DMin) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%C_vAmb_DMax) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%C_vAmb_FMin) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%C_vAmb_Exp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%C_vShr_DMin) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%C_vShr_DMax) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%C_vShr_FMin) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%C_vShr_Exp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Mod_WakeDiam) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%C_WakeDiam) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Swirl) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%k_VortexDecay) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%sigma_D) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumVortices) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FilterInit) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%k_vCurl) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutAllPlanes) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WAT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WAT_k_Def) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WAT_k_Grad) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -459,9 +428,7 @@ subroutine WD_PackInitInput(Buf, Indata) character(*), parameter :: RoutineName = 'WD_PackInitInput' if (Buf%ErrStat >= AbortErrLev) return call WD_PackInputFileType(Buf, InData%InputFileData) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TurbNum) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutFileRoot) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -550,13 +517,11 @@ subroutine WD_PackInitOutput(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%WriteOutputHdr), ubound(InData%WriteOutputHdr)) call RegPack(Buf, InData%WriteOutputHdr) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WriteOutputUnt)) if (allocated(InData%WriteOutputUnt)) then call RegPackBounds(Buf, 1, lbound(InData%WriteOutputUnt), ubound(InData%WriteOutputUnt)) call RegPack(Buf, InData%WriteOutputUnt) end if - if (RegCheckErr(Buf, RoutineName)) return call NWTC_Library_PackProgDesc(Buf, InData%Ver) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -929,91 +894,74 @@ subroutine WD_PackDiscState(Buf, Indata) call RegPackBounds(Buf, 2, lbound(InData%xhat_plane), ubound(InData%xhat_plane)) call RegPack(Buf, InData%xhat_plane) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%YawErr_filt)) if (allocated(InData%YawErr_filt)) then call RegPackBounds(Buf, 1, lbound(InData%YawErr_filt), ubound(InData%YawErr_filt)) call RegPack(Buf, InData%YawErr_filt) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%psi_skew_filt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%chi_skew_filt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%V_plane_filt)) if (allocated(InData%V_plane_filt)) then call RegPackBounds(Buf, 2, lbound(InData%V_plane_filt), ubound(InData%V_plane_filt)) call RegPack(Buf, InData%V_plane_filt) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%p_plane)) if (allocated(InData%p_plane)) then call RegPackBounds(Buf, 2, lbound(InData%p_plane), ubound(InData%p_plane)) call RegPack(Buf, InData%p_plane) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%x_plane)) if (allocated(InData%x_plane)) then call RegPackBounds(Buf, 1, lbound(InData%x_plane), ubound(InData%x_plane)) call RegPack(Buf, InData%x_plane) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Vx_wake)) if (allocated(InData%Vx_wake)) then call RegPackBounds(Buf, 2, lbound(InData%Vx_wake), ubound(InData%Vx_wake)) call RegPack(Buf, InData%Vx_wake) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Vr_wake)) if (allocated(InData%Vr_wake)) then call RegPackBounds(Buf, 2, lbound(InData%Vr_wake), ubound(InData%Vr_wake)) call RegPack(Buf, InData%Vr_wake) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Vx_wake2)) if (allocated(InData%Vx_wake2)) then call RegPackBounds(Buf, 3, lbound(InData%Vx_wake2), ubound(InData%Vx_wake2)) call RegPack(Buf, InData%Vx_wake2) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Vy_wake2)) if (allocated(InData%Vy_wake2)) then call RegPackBounds(Buf, 3, lbound(InData%Vy_wake2), ubound(InData%Vy_wake2)) call RegPack(Buf, InData%Vy_wake2) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Vz_wake2)) if (allocated(InData%Vz_wake2)) then call RegPackBounds(Buf, 3, lbound(InData%Vz_wake2), ubound(InData%Vz_wake2)) call RegPack(Buf, InData%Vz_wake2) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Vx_wind_disk_filt)) if (allocated(InData%Vx_wind_disk_filt)) then call RegPackBounds(Buf, 1, lbound(InData%Vx_wind_disk_filt), ubound(InData%Vx_wind_disk_filt)) call RegPack(Buf, InData%Vx_wind_disk_filt) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%TI_amb_filt)) if (allocated(InData%TI_amb_filt)) then call RegPackBounds(Buf, 1, lbound(InData%TI_amb_filt), ubound(InData%TI_amb_filt)) call RegPack(Buf, InData%TI_amb_filt) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%D_rotor_filt)) if (allocated(InData%D_rotor_filt)) then call RegPackBounds(Buf, 1, lbound(InData%D_rotor_filt), ubound(InData%D_rotor_filt)) call RegPack(Buf, InData%D_rotor_filt) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Vx_rel_disk_filt) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Ct_azavg_filt)) if (allocated(InData%Ct_azavg_filt)) then call RegPackBounds(Buf, 1, lbound(InData%Ct_azavg_filt), ubound(InData%Ct_azavg_filt)) call RegPack(Buf, InData%Ct_azavg_filt) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Cq_azavg_filt)) if (allocated(InData%Cq_azavg_filt)) then call RegPackBounds(Buf, 1, lbound(InData%Cq_azavg_filt), ubound(InData%Cq_azavg_filt)) @@ -1717,129 +1665,107 @@ subroutine WD_PackMisc(Buf, Indata) call RegPackBounds(Buf, 1, lbound(InData%dvtdr), ubound(InData%dvtdr)) call RegPack(Buf, InData%dvtdr) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%vt_tot)) if (allocated(InData%vt_tot)) then call RegPackBounds(Buf, 2, lbound(InData%vt_tot), ubound(InData%vt_tot)) call RegPack(Buf, InData%vt_tot) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%vt_amb)) if (allocated(InData%vt_amb)) then call RegPackBounds(Buf, 2, lbound(InData%vt_amb), ubound(InData%vt_amb)) call RegPack(Buf, InData%vt_amb) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%vt_shr)) if (allocated(InData%vt_shr)) then call RegPackBounds(Buf, 2, lbound(InData%vt_shr), ubound(InData%vt_shr)) call RegPack(Buf, InData%vt_shr) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%vt_tot2)) if (allocated(InData%vt_tot2)) then call RegPackBounds(Buf, 3, lbound(InData%vt_tot2), ubound(InData%vt_tot2)) call RegPack(Buf, InData%vt_tot2) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%vt_amb2)) if (allocated(InData%vt_amb2)) then call RegPackBounds(Buf, 3, lbound(InData%vt_amb2), ubound(InData%vt_amb2)) call RegPack(Buf, InData%vt_amb2) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%vt_shr2)) if (allocated(InData%vt_shr2)) then call RegPackBounds(Buf, 3, lbound(InData%vt_shr2), ubound(InData%vt_shr2)) call RegPack(Buf, InData%vt_shr2) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%dvx_dy)) if (allocated(InData%dvx_dy)) then call RegPackBounds(Buf, 3, lbound(InData%dvx_dy), ubound(InData%dvx_dy)) call RegPack(Buf, InData%dvx_dy) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%dvx_dz)) if (allocated(InData%dvx_dz)) then call RegPackBounds(Buf, 3, lbound(InData%dvx_dz), ubound(InData%dvx_dz)) call RegPack(Buf, InData%dvx_dz) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%nu_dvx_dy)) if (allocated(InData%nu_dvx_dy)) then call RegPackBounds(Buf, 2, lbound(InData%nu_dvx_dy), ubound(InData%nu_dvx_dy)) call RegPack(Buf, InData%nu_dvx_dy) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%nu_dvx_dz)) if (allocated(InData%nu_dvx_dz)) then call RegPackBounds(Buf, 2, lbound(InData%nu_dvx_dz), ubound(InData%nu_dvx_dz)) call RegPack(Buf, InData%nu_dvx_dz) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%dnuvx_dy)) if (allocated(InData%dnuvx_dy)) then call RegPackBounds(Buf, 2, lbound(InData%dnuvx_dy), ubound(InData%dnuvx_dy)) call RegPack(Buf, InData%dnuvx_dy) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%dnuvx_dz)) if (allocated(InData%dnuvx_dz)) then call RegPackBounds(Buf, 2, lbound(InData%dnuvx_dz), ubound(InData%dnuvx_dz)) call RegPack(Buf, InData%dnuvx_dz) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%a)) if (allocated(InData%a)) then call RegPackBounds(Buf, 1, lbound(InData%a), ubound(InData%a)) call RegPack(Buf, InData%a) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%b)) if (allocated(InData%b)) then call RegPackBounds(Buf, 1, lbound(InData%b), ubound(InData%b)) call RegPack(Buf, InData%b) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%c)) if (allocated(InData%c)) then call RegPackBounds(Buf, 1, lbound(InData%c), ubound(InData%c)) call RegPack(Buf, InData%c) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%d)) if (allocated(InData%d)) then call RegPackBounds(Buf, 1, lbound(InData%d), ubound(InData%d)) call RegPack(Buf, InData%d) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%r_wake)) if (allocated(InData%r_wake)) then call RegPackBounds(Buf, 1, lbound(InData%r_wake), ubound(InData%r_wake)) call RegPack(Buf, InData%r_wake) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Vx_high)) if (allocated(InData%Vx_high)) then call RegPackBounds(Buf, 1, lbound(InData%Vx_high), ubound(InData%Vx_high)) call RegPack(Buf, InData%Vx_high) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Vx_polar)) if (allocated(InData%Vx_polar)) then call RegPackBounds(Buf, 1, lbound(InData%Vx_polar), ubound(InData%Vx_polar)) call RegPack(Buf, InData%Vx_polar) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Vt_wake)) if (allocated(InData%Vt_wake)) then call RegPackBounds(Buf, 1, lbound(InData%Vt_wake), ubound(InData%Vt_wake)) call RegPack(Buf, InData%Vt_wake) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%GammaCurl) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Ct_avg) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2268,95 +2194,56 @@ subroutine WD_PackParam(Buf, Indata) character(*), parameter :: RoutineName = 'WD_PackParam' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%dt_low) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumPlanes) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumRadii) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%dr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%r)) if (allocated(InData%r)) then call RegPackBounds(Buf, 1, lbound(InData%r), ubound(InData%r)) call RegPack(Buf, InData%r) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%y)) if (allocated(InData%y)) then call RegPackBounds(Buf, 1, lbound(InData%y), ubound(InData%y)) call RegPack(Buf, InData%y) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%z)) if (allocated(InData%z)) then call RegPackBounds(Buf, 1, lbound(InData%z), ubound(InData%z)) call RegPack(Buf, InData%z) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Mod_Wake) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Swirl) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%k_VortexDecay) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%sigma_D) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%NumVortices) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%filtParam) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%oneMinusFiltParam) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%C_HWkDfl_O) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%C_HWkDfl_OY) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%C_HWkDfl_x) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%C_HWkDfl_xY) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%C_NearWake) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%C_vAmb_DMin) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%C_vAmb_DMax) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%C_vAmb_FMin) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%C_vAmb_Exp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%C_vShr_DMin) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%C_vShr_DMax) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%C_vShr_FMin) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%C_vShr_Exp) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%k_vAmb) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%k_vShr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Mod_WakeDiam) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%C_WakeDiam) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%FilterInit) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%k_vCurl) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutAllPlanes) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutFileRoot) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%OutFileVTKDir) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TurbNum) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WAT) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WAT_k_Def) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%WAT_k_Grad) if (RegCheckErr(Buf, RoutineName)) return end subroutine @@ -2575,35 +2462,24 @@ subroutine WD_PackInput(Buf, Indata) character(*), parameter :: RoutineName = 'WD_PackInput' if (Buf%ErrStat >= AbortErrLev) return call RegPack(Buf, InData%xhat_disk) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%YawErr) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%psi_skew) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%chi_skew) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%p_hub) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%V_plane)) if (allocated(InData%V_plane)) then call RegPackBounds(Buf, 2, lbound(InData%V_plane), ubound(InData%V_plane)) call RegPack(Buf, InData%V_plane) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Vx_wind_disk) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%TI_amb) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%D_rotor) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, InData%Vx_rel_disk) - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Ct_azavg)) if (allocated(InData%Ct_azavg)) then call RegPackBounds(Buf, 1, lbound(InData%Ct_azavg), ubound(InData%Ct_azavg)) call RegPack(Buf, InData%Ct_azavg) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Cq_azavg)) if (allocated(InData%Cq_azavg)) then call RegPackBounds(Buf, 1, lbound(InData%Cq_azavg), ubound(InData%Cq_azavg)) @@ -2884,55 +2760,46 @@ subroutine WD_PackOutput(Buf, Indata) call RegPackBounds(Buf, 2, lbound(InData%xhat_plane), ubound(InData%xhat_plane)) call RegPack(Buf, InData%xhat_plane) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%p_plane)) if (allocated(InData%p_plane)) then call RegPackBounds(Buf, 2, lbound(InData%p_plane), ubound(InData%p_plane)) call RegPack(Buf, InData%p_plane) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Vx_wake)) if (allocated(InData%Vx_wake)) then call RegPackBounds(Buf, 2, lbound(InData%Vx_wake), ubound(InData%Vx_wake)) call RegPack(Buf, InData%Vx_wake) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Vr_wake)) if (allocated(InData%Vr_wake)) then call RegPackBounds(Buf, 2, lbound(InData%Vr_wake), ubound(InData%Vr_wake)) call RegPack(Buf, InData%Vr_wake) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Vx_wake2)) if (allocated(InData%Vx_wake2)) then call RegPackBounds(Buf, 3, lbound(InData%Vx_wake2), ubound(InData%Vx_wake2)) call RegPack(Buf, InData%Vx_wake2) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Vy_wake2)) if (allocated(InData%Vy_wake2)) then call RegPackBounds(Buf, 3, lbound(InData%Vy_wake2), ubound(InData%Vy_wake2)) call RegPack(Buf, InData%Vy_wake2) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%Vz_wake2)) if (allocated(InData%Vz_wake2)) then call RegPackBounds(Buf, 3, lbound(InData%Vz_wake2), ubound(InData%Vz_wake2)) call RegPack(Buf, InData%Vz_wake2) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%D_wake)) if (allocated(InData%D_wake)) then call RegPackBounds(Buf, 1, lbound(InData%D_wake), ubound(InData%D_wake)) call RegPack(Buf, InData%D_wake) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%x_plane)) if (allocated(InData%x_plane)) then call RegPackBounds(Buf, 1, lbound(InData%x_plane), ubound(InData%x_plane)) call RegPack(Buf, InData%x_plane) end if - if (RegCheckErr(Buf, RoutineName)) return call RegPack(Buf, allocated(InData%WAT_k_mt)) if (allocated(InData%WAT_k_mt)) then call RegPackBounds(Buf, 3, lbound(InData%WAT_k_mt), ubound(InData%WAT_k_mt)) From 75d1e9d03e273e7a17c5c372abff2faddffb44a3 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 15 Jun 2023 12:48:46 +0000 Subject: [PATCH 07/15] Use next version of setup-python in GH actions Also reduce number of simultaneous tests in rtest-OF --- .github/workflows/automated-dev-tests.yml | 38 +++++++++++------------ 1 file changed, 19 insertions(+), 19 deletions(-) diff --git a/.github/workflows/automated-dev-tests.yml b/.github/workflows/automated-dev-tests.yml index 36b2419769..2cf5fba926 100644 --- a/.github/workflows/automated-dev-tests.yml +++ b/.github/workflows/automated-dev-tests.yml @@ -39,7 +39,7 @@ jobs: with: submodules: recursive - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v4 with: python-version: '3.10' cache: 'pip' @@ -115,7 +115,7 @@ jobs: with: submodules: recursive - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v4 with: python-version: '3.10' cache: 'pip' @@ -157,7 +157,7 @@ jobs: with: submodules: recursive - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v4 with: python-version: '3.10' cache: 'pip' @@ -207,7 +207,7 @@ jobs: path: ${{runner.workspace}} key: build-postlib-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v4 with: python-version: '3.10' cache: 'pip' @@ -238,7 +238,7 @@ jobs: path: ${{runner.workspace}} key: build-postlib-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v4 with: python-version: '3.10' cache: 'pip' @@ -269,7 +269,7 @@ jobs: path: ${{runner.workspace}} key: build-postlib-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v4 with: python-version: '3.10' cache: 'pip' @@ -302,7 +302,7 @@ jobs: with: submodules: recursive - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v4 with: python-version: '3.10' cache: 'pip' @@ -361,7 +361,7 @@ jobs: path: ${{runner.workspace}} key: build-drivers-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v4 with: python-version: '3.10' cache: 'pip' @@ -410,7 +410,7 @@ jobs: path: ${{runner.workspace}} key: build-all-debug-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v4 with: python-version: '3.10' cache: 'pip' @@ -469,7 +469,7 @@ jobs: path: ${{runner.workspace}} key: build-interfaces-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v4 with: python-version: '3.10' cache: 'pip' @@ -508,7 +508,7 @@ jobs: path: ${{runner.workspace}} key: build-openfast-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v4 with: python-version: '3.10' cache: 'pip' @@ -525,7 +525,7 @@ jobs: - name: Run 5MW tests working-directory: ${{runner.workspace}}/openfast/build run: | - ctest -VV -j8 \ + ctest -VV -j6 \ -L openfast \ -LE "cpp|linear|python|fastlib" \ -E "5MW_OC4Semi_WSt_WavesWN|5MW_OC3Mnpl_DLL_WTurb_WavesIrr|5MW_OC4Jckt_DLL_WTurb_WavesIrr_MGrowth|5MW_OC3Trpd_DLL_WSt_WavesReg|5MW_Land_BD_DLL_WTurb" @@ -555,7 +555,7 @@ jobs: path: ${{runner.workspace}} key: build-openfast-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v4 with: python-version: '3.10' cache: 'pip' @@ -599,7 +599,7 @@ jobs: path: ${{runner.workspace}} key: build-openfast-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v4 with: python-version: '3.10' cache: 'pip' @@ -643,7 +643,7 @@ jobs: path: ${{runner.workspace}} key: build-openfast-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v4 with: python-version: '3.10' cache: 'pip' @@ -687,7 +687,7 @@ jobs: path: ${{runner.workspace}} key: build-openfast-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v4 with: python-version: '3.10' cache: 'pip' @@ -731,7 +731,7 @@ jobs: path: ${{runner.workspace}} key: build-openfast-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v4 with: python-version: '3.10' cache: 'pip' @@ -775,7 +775,7 @@ jobs: path: ${{runner.workspace}} key: build-openfast-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v4 with: python-version: '3.10' cache: 'pip' @@ -819,7 +819,7 @@ jobs: path: ${{runner.workspace}} key: build-fastfarm-release-${{ github.sha }} - name: Setup Python - uses: actions/setup-python@v3 + uses: actions/setup-python@v4 with: python-version: '3.10' cache: 'pip' From 7a19921363db1fc440beae740c55855d35d3c988 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 15 Jun 2023 14:42:35 +0000 Subject: [PATCH 08/15] Reduce parallel tests in GH Actions rtest-OF --- .github/workflows/automated-dev-tests.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/automated-dev-tests.yml b/.github/workflows/automated-dev-tests.yml index 2cf5fba926..2321e0b8f9 100644 --- a/.github/workflows/automated-dev-tests.yml +++ b/.github/workflows/automated-dev-tests.yml @@ -525,7 +525,7 @@ jobs: - name: Run 5MW tests working-directory: ${{runner.workspace}}/openfast/build run: | - ctest -VV -j6 \ + ctest -VV -j4 \ -L openfast \ -LE "cpp|linear|python|fastlib" \ -E "5MW_OC4Semi_WSt_WavesWN|5MW_OC3Mnpl_DLL_WTurb_WavesIrr|5MW_OC4Jckt_DLL_WTurb_WavesIrr_MGrowth|5MW_OC3Trpd_DLL_WSt_WavesReg|5MW_Land_BD_DLL_WTurb" From 806841de0227dd9fbc5df4c284aa72f5ae029b63 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 15 Jun 2023 15:53:17 +0000 Subject: [PATCH 09/15] Fix bug in Registry Destroy, undo GH Actions mods --- .github/workflows/automated-dev-tests.yml | 2 +- .../fast-farm/src/FASTWrapper_Types.f90 | 4 + glue-codes/fast-farm/src/FAST_Farm_Types.f90 | 96 +++ modules/aerodyn/src/AeroAcoustics_Types.f90 | 2 + modules/aerodyn/src/AeroDyn_Driver_Types.f90 | 24 + modules/aerodyn/src/AeroDyn_Inflow_Types.f90 | 68 ++ modules/aerodyn/src/AeroDyn_Types.f90 | 82 +++ modules/aerodyn/src/AirfoilInfo_Types.f90 | 4 + modules/aerodyn/src/BEMT_Types.f90 | 40 ++ modules/aerodyn/src/DBEMT_Types.f90 | 8 + modules/aerodyn/src/FVW_Types.f90 | 16 + modules/aerodyn/src/UnsteadyAero_Types.f90 | 8 + modules/aerodyn14/src/AeroDyn14_Types.f90 | 78 ++ modules/aerodyn14/src/DWM_Types.f90 | 48 ++ modules/awae/src/AWAE_Types.f90 | 12 + modules/beamdyn/src/BeamDyn_Types.f90 | 32 + modules/elastodyn/src/ElastoDyn_Types.f90 | 42 ++ modules/extptfm/src/ExtPtfm_MCKF_Types.f90 | 6 + modules/feamooring/src/FEAMooring_Types.f90 | 10 + modules/hydrodyn/src/HydroDyn_Types.f90 | 48 ++ modules/hydrodyn/src/Morison_Types.f90 | 4 + modules/hydrodyn/src/SS_Excitation_Types.f90 | 12 + modules/hydrodyn/src/SS_Radiation_Types.f90 | 6 + modules/hydrodyn/src/WAMIT2_Types.f90 | 2 + modules/hydrodyn/src/WAMIT_Types.f90 | 60 ++ modules/icedyn/src/IceDyn_Types.f90 | 6 + modules/icefloe/src/icefloe/IceFloe_Types.f90 | 6 + .../inflowwind/src/IfW_FlowField_Types.f90 | 10 + .../inflowwind/src/InflowWind_IO_Types.f90 | 4 + modules/inflowwind/src/InflowWind_Types.f90 | 28 + modules/map/src/MAP_Types.f90 | 12 + modules/moordyn/src/MoorDyn_Types.f90 | 10 + modules/openfast-library/src/FAST_Types.f90 | 680 ++++++++++++++++++ .../src/registry_gen_fortran.cpp | 4 - modules/openfoam/src/OpenFOAM_Types.f90 | 2 + .../src/OrcaFlexInterface_Types.f90 | 8 + .../seastate/src/SeaSt_WaveField_Types.f90 | 2 + .../seastate/src/SeaState_Interp_Types.f90 | 2 + modules/seastate/src/SeaState_Types.f90 | 18 + modules/seastate/src/Waves_Types.f90 | 2 + modules/servodyn/src/ServoDyn_Types.f90 | 12 + modules/servodyn/src/StrucCtrl_Types.f90 | 4 + modules/subdyn/src/SubDyn_Types.f90 | 14 + .../supercontroller/src/SCDataEx_Types.f90 | 2 + .../src/SuperController_Types.f90 | 4 + .../wakedynamics/src/WakeDynamics_Types.f90 | 4 + 46 files changed, 1543 insertions(+), 5 deletions(-) diff --git a/.github/workflows/automated-dev-tests.yml b/.github/workflows/automated-dev-tests.yml index 2321e0b8f9..ad8507476f 100644 --- a/.github/workflows/automated-dev-tests.yml +++ b/.github/workflows/automated-dev-tests.yml @@ -525,7 +525,7 @@ jobs: - name: Run 5MW tests working-directory: ${{runner.workspace}}/openfast/build run: | - ctest -VV -j4 \ + ctest -VV -j8 \ -L openfast \ -LE "cpp|linear|python|fastlib" \ -E "5MW_OC4Semi_WSt_WavesWN|5MW_OC3Mnpl_DLL_WTurb_WavesIrr|5MW_OC4Jckt_DLL_WTurb_WavesIrr_MGrowth|5MW_OC3Trpd_DLL_WSt_WavesReg|5MW_Land_BD_DLL_WTurb" diff --git a/glue-codes/fast-farm/src/FASTWrapper_Types.f90 b/glue-codes/fast-farm/src/FASTWrapper_Types.f90 index eab26277e6..b1912f0fe9 100644 --- a/glue-codes/fast-farm/src/FASTWrapper_Types.f90 +++ b/glue-codes/fast-farm/src/FASTWrapper_Types.f90 @@ -386,6 +386,8 @@ subroutine FWrap_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FWrap_DestroyInitOutput' ErrStat = ErrID_None ErrMsg = '' + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine FWrap_PackInitOutput(Buf, Indata) @@ -665,6 +667,8 @@ subroutine FWrap_DestroyMisc(MiscData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FWrap_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' + call FAST_DestroyTurbineType(MiscData%Turbine, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MiscData%TempDisp)) then LB(1:1) = lbound(MiscData%TempDisp) UB(1:1) = ubound(MiscData%TempDisp) diff --git a/glue-codes/fast-farm/src/FAST_Farm_Types.f90 b/glue-codes/fast-farm/src/FAST_Farm_Types.f90 index a3f6f0ca09..f5dbd1dc67 100644 --- a/glue-codes/fast-farm/src/FAST_Farm_Types.f90 +++ b/glue-codes/fast-farm/src/FAST_Farm_Types.f90 @@ -413,6 +413,12 @@ subroutine Farm_DestroyParam(ParamData, ErrStat, ErrMsg) end do deallocate(ParamData%OutParam) end if + LB(1:1) = lbound(ParamData%Module_Ver) + UB(1:1) = ubound(ParamData%Module_Ver) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyProgDesc(ParamData%Module_Ver(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do end subroutine subroutine Farm_PackParam(Buf, Indata) @@ -1042,6 +1048,22 @@ subroutine Farm_DestroyFASTWrapper_Data(FASTWrapper_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'Farm_DestroyFASTWrapper_Data' ErrStat = ErrID_None ErrMsg = '' + call FWrap_DestroyContState(FASTWrapper_DataData%x, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FWrap_DestroyDiscState(FASTWrapper_DataData%xd, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FWrap_DestroyConstrState(FASTWrapper_DataData%z, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FWrap_DestroyOtherState(FASTWrapper_DataData%OtherSt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FWrap_DestroyParam(FASTWrapper_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FWrap_DestroyInput(FASTWrapper_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FWrap_DestroyOutput(FASTWrapper_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FWrap_DestroyMisc(FASTWrapper_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine Farm_PackFASTWrapper_Data(Buf, Indata) @@ -1125,6 +1147,22 @@ subroutine Farm_DestroyWakeDynamics_Data(WakeDynamics_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'Farm_DestroyWakeDynamics_Data' ErrStat = ErrID_None ErrMsg = '' + call WD_DestroyContState(WakeDynamics_DataData%x, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call WD_DestroyDiscState(WakeDynamics_DataData%xd, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call WD_DestroyConstrState(WakeDynamics_DataData%z, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call WD_DestroyOtherState(WakeDynamics_DataData%OtherSt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call WD_DestroyParam(WakeDynamics_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call WD_DestroyInput(WakeDynamics_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call WD_DestroyOutput(WakeDynamics_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call WD_DestroyMisc(WakeDynamics_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine Farm_PackWakeDynamics_Data(Buf, Indata) @@ -1208,6 +1246,22 @@ subroutine Farm_DestroyAWAE_Data(AWAE_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'Farm_DestroyAWAE_Data' ErrStat = ErrID_None ErrMsg = '' + call AWAE_DestroyContState(AWAE_DataData%x, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AWAE_DestroyDiscState(AWAE_DataData%xd, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AWAE_DestroyConstrState(AWAE_DataData%z, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AWAE_DestroyOtherState(AWAE_DataData%OtherSt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AWAE_DestroyParam(AWAE_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AWAE_DestroyInput(AWAE_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AWAE_DestroyOutput(AWAE_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AWAE_DestroyMisc(AWAE_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine Farm_PackAWAE_Data(Buf, Indata) @@ -1292,6 +1346,22 @@ subroutine Farm_DestroySC_Data(SC_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'Farm_DestroySC_Data' ErrStat = ErrID_None ErrMsg = '' + call SC_DestroyContState(SC_DataData%x, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SC_DestroyDiscState(SC_DataData%xd, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SC_DestroyConstrState(SC_DataData%z, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SC_DestroyOtherState(SC_DataData%OtherState, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SC_DestroyParam(SC_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SC_DestroyInput(SC_DataData%uInputs, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SC_DestroyOutput(SC_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SC_DestroyMisc(SC_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine Farm_PackSC_Data(Buf, Indata) @@ -1414,6 +1484,18 @@ subroutine Farm_DestroyMD_Data(MD_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'Farm_DestroyMD_Data' ErrStat = ErrID_None ErrMsg = '' + call MD_DestroyContState(MD_DataData%x, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_DestroyDiscState(MD_DataData%xd, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_DestroyConstrState(MD_DataData%z, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_DestroyOtherState(MD_DataData%OtherSt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_DestroyParam(MD_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_DestroyInput(MD_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MD_DataData%Input)) then LB(1:1) = lbound(MD_DataData%Input) UB(1:1) = ubound(MD_DataData%Input) @@ -1426,6 +1508,10 @@ subroutine Farm_DestroyMD_Data(MD_DataData, ErrStat, ErrMsg) if (allocated(MD_DataData%InputTimes)) then deallocate(MD_DataData%InputTimes) end if + call MD_DestroyOutput(MD_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_DestroyMisc(MD_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine Farm_PackMD_Data(Buf, Indata) @@ -1588,6 +1674,10 @@ subroutine Farm_DestroyAll_FastFarm_Data(All_FastFarm_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'Farm_DestroyAll_FastFarm_Data' ErrStat = ErrID_None ErrMsg = '' + call Farm_DestroyParam(All_FastFarm_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Farm_DestroyMisc(All_FastFarm_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(All_FastFarm_DataData%FWrap)) then LB(1:1) = lbound(All_FastFarm_DataData%FWrap) UB(1:1) = ubound(All_FastFarm_DataData%FWrap) @@ -1606,6 +1696,12 @@ subroutine Farm_DestroyAll_FastFarm_Data(All_FastFarm_DataData, ErrStat, ErrMsg) end do deallocate(All_FastFarm_DataData%WD) end if + call Farm_DestroyAWAE_Data(All_FastFarm_DataData%AWAE, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Farm_DestroySC_Data(All_FastFarm_DataData%SC, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Farm_DestroyMD_Data(All_FastFarm_DataData%MD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine Farm_PackAll_FastFarm_Data(Buf, Indata) diff --git a/modules/aerodyn/src/AeroAcoustics_Types.f90 b/modules/aerodyn/src/AeroAcoustics_Types.f90 index 22ded501c6..ed449b3151 100644 --- a/modules/aerodyn/src/AeroAcoustics_Types.f90 +++ b/modules/aerodyn/src/AeroAcoustics_Types.f90 @@ -726,6 +726,8 @@ subroutine AA_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) if (allocated(InitOutputData%WriteOutputUntNodes)) then deallocate(InitOutputData%WriteOutputUntNodes) end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine AA_PackInitOutput(Buf, Indata) diff --git a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 index cbc93b73d8..6191838405 100644 --- a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 @@ -460,6 +460,8 @@ subroutine AD_Dvr_DestroyDvr_Outputs(Dvr_OutputsData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'AD_Dvr_DestroyDvr_Outputs' ErrStat = ErrID_None ErrMsg = '' + call NWTC_Library_DestroyProgDesc(Dvr_OutputsData%AD_ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(Dvr_OutputsData%unOutFile)) then deallocate(Dvr_OutputsData%unOutFile) end if @@ -1185,6 +1187,12 @@ subroutine AD_Dvr_DestroyWTData(WTDataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'AD_Dvr_DestroyWTData' ErrStat = ErrID_None ErrMsg = '' + call NWTC_Library_DestroyMeshMapType(WTDataData%map2twrPt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(WTDataData%map2nacPt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(WTDataData%map2hubPt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(WTDataData%map2BldPt)) then LB(1:1) = lbound(WTDataData%map2BldPt) UB(1:1) = ubound(WTDataData%map2BldPt) @@ -1203,6 +1211,12 @@ subroutine AD_Dvr_DestroyWTData(WTDataData, ErrStat, ErrMsg) end do deallocate(WTDataData%bld) end if + call AD_Dvr_DestroyHubData(WTDataData%hub, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD_Dvr_DestroyNacData(WTDataData%nac, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD_Dvr_DestroyTwrData(WTDataData%twr, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(WTDataData%motion)) then deallocate(WTDataData%motion) end if @@ -1515,6 +1529,10 @@ subroutine AD_Dvr_DestroyDvr_SimData(Dvr_SimDataData, ErrStat, ErrMsg) if (allocated(Dvr_SimDataData%timeSeries)) then deallocate(Dvr_SimDataData%timeSeries) end if + call AD_Dvr_DestroyDvr_Outputs(Dvr_SimDataData%out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ADI_DestroyIW_InputData(Dvr_SimDataData%IW_InitInp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine AD_Dvr_PackDvr_SimData(Buf, Indata) @@ -1697,6 +1715,12 @@ subroutine AD_Dvr_DestroyAllData(AllDataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'AD_Dvr_DestroyAllData' ErrStat = ErrID_None ErrMsg = '' + call AD_Dvr_DestroyDvr_SimData(AllDataData%dvr, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ADI_DestroyData(AllDataData%ADI, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ADI_DestroyFED_Data(AllDataData%FED, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine AD_Dvr_PackAllData(Buf, Indata) diff --git a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 index 6e6fc40db2..4aa3c34ab4 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 @@ -226,6 +226,22 @@ subroutine ADI_DestroyInflowWindData(InflowWindDataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'ADI_DestroyInflowWindData' ErrStat = ErrID_None ErrMsg = '' + call InflowWind_DestroyContState(InflowWindDataData%x, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyDiscState(InflowWindDataData%xd, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyConstrState(InflowWindDataData%z, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyOtherState(InflowWindDataData%OtherSt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyParam(InflowWindDataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyMisc(InflowWindDataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyInput(InflowWindDataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyOutput(InflowWindDataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine ADI_PackInflowWindData(Buf, Indata) @@ -304,6 +320,8 @@ subroutine ADI_DestroyIW_InputData(IW_InputDataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'ADI_DestroyIW_InputData' ErrStat = ErrID_None ErrMsg = '' + call NWTC_Library_DestroyFileInfoType(IW_InputDataData%PassedFileData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine ADI_PackIW_InputData(Buf, Indata) @@ -380,6 +398,10 @@ subroutine ADI_DestroyInitInput(InitInputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'ADI_DestroyInitInput' ErrStat = ErrID_None ErrMsg = '' + call AD_DestroyInitInput(InitInputData%AD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ADI_DestroyIW_InputData(InitInputData%IW_InitInp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine ADI_PackInitInput(Buf, Indata) @@ -470,6 +492,8 @@ subroutine ADI_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'ADI_DestroyInitOutput' ErrStat = ErrID_None ErrMsg = '' + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InitOutputData%WriteOutputHdr)) then deallocate(InitOutputData%WriteOutputHdr) end if @@ -561,6 +585,8 @@ subroutine ADI_DestroyContState(ContStateData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'ADI_DestroyContState' ErrStat = ErrID_None ErrMsg = '' + call AD_DestroyContState(ContStateData%AD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine ADI_PackContState(Buf, Indata) @@ -605,6 +631,8 @@ subroutine ADI_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'ADI_DestroyDiscState' ErrStat = ErrID_None ErrMsg = '' + call AD_DestroyDiscState(DiscStateData%AD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine ADI_PackDiscState(Buf, Indata) @@ -649,6 +677,8 @@ subroutine ADI_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'ADI_DestroyConstrState' ErrStat = ErrID_None ErrMsg = '' + call AD_DestroyConstrState(ConstrStateData%AD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine ADI_PackConstrState(Buf, Indata) @@ -693,6 +723,8 @@ subroutine ADI_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'ADI_DestroyOtherState' ErrStat = ErrID_None ErrMsg = '' + call AD_DestroyOtherState(OtherStateData%AD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine ADI_PackOtherState(Buf, Indata) @@ -762,6 +794,10 @@ subroutine ADI_DestroyMisc(MiscData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'ADI_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' + call AD_DestroyMisc(MiscData%AD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ADI_DestroyInflowWindData(MiscData%IW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MiscData%VTK_surfaces)) then LB(1:1) = lbound(MiscData%VTK_surfaces) UB(1:1) = ubound(MiscData%VTK_surfaces) @@ -854,6 +890,8 @@ subroutine ADI_DestroyParam(ParamData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'ADI_DestroyParam' ErrStat = ErrID_None ErrMsg = '' + call AD_DestroyParam(ParamData%AD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine ADI_PackParam(Buf, Indata) @@ -919,6 +957,8 @@ subroutine ADI_DestroyInput(InputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'ADI_DestroyInput' ErrStat = ErrID_None ErrMsg = '' + call AD_DestroyInput(InputData%AD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine ADI_PackInput(Buf, Indata) @@ -1007,6 +1047,8 @@ subroutine ADI_DestroyOutput(OutputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'ADI_DestroyOutput' ErrStat = ErrID_None ErrMsg = '' + call AD_DestroyOutput(OutputData%AD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(OutputData%HHVel)) then deallocate(OutputData%HHVel) end if @@ -1273,6 +1315,10 @@ subroutine ADI_DestroyData(DataData, ErrStat, ErrMsg) end do deallocate(DataData%OtherState) end if + call ADI_DestroyParam(DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ADI_DestroyMisc(DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(DataData%u)) then LB(1:1) = lbound(DataData%u) UB(1:1) = ubound(DataData%u) @@ -1282,6 +1328,8 @@ subroutine ADI_DestroyData(DataData, ErrStat, ErrMsg) end do deallocate(DataData%u) end if + call ADI_DestroyOutput(DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(DataData%inputTimes)) then deallocate(DataData%inputTimes) end if @@ -1584,6 +1632,16 @@ subroutine ADI_DestroyRotFED(RotFEDData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'ADI_DestroyRotFED' ErrStat = ErrID_None ErrMsg = '' + call MeshDestroy( RotFEDData%PlatformPtMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( RotFEDData%TwrPtMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( RotFEDData%TwrPtMeshAD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( RotFEDData%NacelleMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( RotFEDData%HubPtMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(RotFEDData%BladeRootMotion)) then LB(1:1) = lbound(RotFEDData%BladeRootMotion) UB(1:1) = ubound(RotFEDData%BladeRootMotion) @@ -1602,6 +1660,10 @@ subroutine ADI_DestroyRotFED(RotFEDData, ErrStat, ErrMsg) end do deallocate(RotFEDData%BladeLn2Mesh) end if + call NWTC_Library_DestroyMeshMapType(RotFEDData%ED_P_2_AD_P_T, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(RotFEDData%AD_P_2_AD_L_T, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(RotFEDData%AD_P_2_AD_L_B)) then LB(1:1) = lbound(RotFEDData%AD_P_2_AD_L_B) UB(1:1) = ubound(RotFEDData%AD_P_2_AD_L_B) @@ -1611,6 +1673,8 @@ subroutine ADI_DestroyRotFED(RotFEDData, ErrStat, ErrMsg) end do deallocate(RotFEDData%AD_P_2_AD_L_B) end if + call NWTC_Library_DestroyMeshMapType(RotFEDData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(RotFEDData%ED_P_2_AD_P_R)) then LB(1:1) = lbound(RotFEDData%ED_P_2_AD_P_R) UB(1:1) = ubound(RotFEDData%ED_P_2_AD_P_R) @@ -1620,6 +1684,10 @@ subroutine ADI_DestroyRotFED(RotFEDData, ErrStat, ErrMsg) end do deallocate(RotFEDData%ED_P_2_AD_P_R) end if + call NWTC_Library_DestroyMeshMapType(RotFEDData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(RotFEDData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine ADI_PackRotFED(Buf, Indata) diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index 9de15e78f6..f760332580 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -1027,6 +1027,8 @@ subroutine AD_DestroyInitInput(InitInputData, ErrStat, ErrMsg) end do deallocate(InitInputData%rotors) end if + call NWTC_Library_DestroyFileInfoType(InitInputData%PassedPrimaryInputData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine AD_PackInitInput(Buf, Indata) @@ -2238,6 +2240,8 @@ subroutine AD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) end do deallocate(InitOutputData%rotors) end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine AD_PackInitOutput(Buf, Indata) @@ -2435,6 +2439,8 @@ subroutine AD_DestroyRotInputFile(RotInputFileData, ErrStat, ErrMsg) if (allocated(RotInputFileData%TwrCb)) then deallocate(RotInputFileData%TwrCb) end if + call AD_DestroyTFinInputFileType(RotInputFileData%TFin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine AD_PackRotInputFile(Buf, Indata) @@ -3072,6 +3078,10 @@ subroutine AD_DestroyRotContinuousStateType(RotContinuousStateTypeData, ErrStat, character(*), parameter :: RoutineName = 'AD_DestroyRotContinuousStateType' ErrStat = ErrID_None ErrMsg = '' + call BEMT_DestroyContState(RotContinuousStateTypeData%BEMT, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AA_DestroyContState(RotContinuousStateTypeData%AA, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine AD_PackRotContinuousStateType(Buf, Indata) @@ -3149,6 +3159,8 @@ subroutine AD_DestroyContState(ContStateData, ErrStat, ErrMsg) end do deallocate(ContStateData%rotors) end if + call FVW_DestroyContState(ContStateData%FVW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine AD_PackContState(Buf, Indata) @@ -3226,6 +3238,10 @@ subroutine AD_DestroyRotDiscreteStateType(RotDiscreteStateTypeData, ErrStat, Err character(*), parameter :: RoutineName = 'AD_DestroyRotDiscreteStateType' ErrStat = ErrID_None ErrMsg = '' + call BEMT_DestroyDiscState(RotDiscreteStateTypeData%BEMT, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AA_DestroyDiscState(RotDiscreteStateTypeData%AA, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine AD_PackRotDiscreteStateType(Buf, Indata) @@ -3303,6 +3319,8 @@ subroutine AD_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) end do deallocate(DiscStateData%rotors) end if + call FVW_DestroyDiscState(DiscStateData%FVW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine AD_PackDiscState(Buf, Indata) @@ -3380,6 +3398,10 @@ subroutine AD_DestroyRotConstraintStateType(RotConstraintStateTypeData, ErrStat, character(*), parameter :: RoutineName = 'AD_DestroyRotConstraintStateType' ErrStat = ErrID_None ErrMsg = '' + call BEMT_DestroyConstrState(RotConstraintStateTypeData%BEMT, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AA_DestroyConstrState(RotConstraintStateTypeData%AA, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine AD_PackRotConstraintStateType(Buf, Indata) @@ -3457,6 +3479,8 @@ subroutine AD_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) end do deallocate(ConstrStateData%rotors) end if + call FVW_DestroyConstrState(ConstrStateData%FVW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine AD_PackConstrState(Buf, Indata) @@ -3534,6 +3558,10 @@ subroutine AD_DestroyRotOtherStateType(RotOtherStateTypeData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'AD_DestroyRotOtherStateType' ErrStat = ErrID_None ErrMsg = '' + call BEMT_DestroyOtherState(RotOtherStateTypeData%BEMT, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AA_DestroyOtherState(RotOtherStateTypeData%AA, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine AD_PackRotOtherStateType(Buf, Indata) @@ -3625,6 +3653,8 @@ subroutine AD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) end do deallocate(OtherStateData%rotors) end if + call FVW_DestroyOtherState(OtherStateData%FVW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(OtherStateData%WakeLocationPoints)) then deallocate(OtherStateData%WakeLocationPoints) end if @@ -4258,6 +4288,22 @@ subroutine AD_DestroyRotMiscVarType(RotMiscVarTypeData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'AD_DestroyRotMiscVarType' ErrStat = ErrID_None ErrMsg = '' + call BEMT_DestroyMisc(RotMiscVarTypeData%BEMT, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call BEMT_DestroyOutput(RotMiscVarTypeData%BEMT_y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + LB(1:1) = lbound(RotMiscVarTypeData%BEMT_u) + UB(1:1) = ubound(RotMiscVarTypeData%BEMT_u) + do i1 = LB(1), UB(1) + call BEMT_DestroyInput(RotMiscVarTypeData%BEMT_u(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call AA_DestroyMisc(RotMiscVarTypeData%AA, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AA_DestroyOutput(RotMiscVarTypeData%AA_y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AA_DestroyInput(RotMiscVarTypeData%AA_u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(RotMiscVarTypeData%DisturbedInflow)) then deallocate(RotMiscVarTypeData%DisturbedInflow) end if @@ -4306,6 +4352,8 @@ subroutine AD_DestroyRotMiscVarType(RotMiscVarTypeData, ErrStat, ErrMsg) if (allocated(RotMiscVarTypeData%hub_theta_x_root)) then deallocate(RotMiscVarTypeData%hub_theta_x_root) end if + call MeshDestroy( RotMiscVarTypeData%HubLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(RotMiscVarTypeData%B_L_2_H_P)) then LB(1:1) = lbound(RotMiscVarTypeData%B_L_2_H_P) UB(1:1) = ubound(RotMiscVarTypeData%B_L_2_H_P) @@ -4393,6 +4441,12 @@ subroutine AD_DestroyRotMiscVarType(RotMiscVarTypeData, ErrStat, ErrMsg) end do deallocate(RotMiscVarTypeData%B_P_2_B_L) end if + call MeshDestroy( RotMiscVarTypeData%TwrBuoyLoadPoint, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( RotMiscVarTypeData%TwrBuoyLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(RotMiscVarTypeData%T_P_2_T_L, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine AD_PackRotMiscVarType(Buf, Indata) @@ -5277,6 +5331,10 @@ subroutine AD_DestroyMisc(MiscData, ErrStat, ErrMsg) end do deallocate(MiscData%FVW_u) end if + call FVW_DestroyOutput(MiscData%FVW_y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FVW_DestroyMisc(MiscData%FVW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MiscData%WindPos)) then deallocate(MiscData%WindPos) end if @@ -5839,6 +5897,10 @@ subroutine AD_DestroyRotParameterType(RotParameterTypeData, ErrStat, ErrMsg) if (allocated(RotParameterTypeData%TwrAxCent)) then deallocate(RotParameterTypeData%TwrAxCent) end if + call BEMT_DestroyParam(RotParameterTypeData%BEMT, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AA_DestroyParam(RotParameterTypeData%AA, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(RotParameterTypeData%Jac_u_indx)) then deallocate(RotParameterTypeData%Jac_u_indx) end if @@ -5869,6 +5931,8 @@ subroutine AD_DestroyRotParameterType(RotParameterTypeData, ErrStat, ErrMsg) if (allocated(RotParameterTypeData%BldNd_BlOutNd)) then deallocate(RotParameterTypeData%BldNd_BlOutNd) end if + call AD_DestroyTFinParameterType(RotParameterTypeData%TFin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine AD_PackRotParameterType(Buf, Indata) @@ -6514,6 +6578,8 @@ subroutine AD_DestroyParam(ParamData, ErrStat, ErrMsg) end do deallocate(ParamData%AFI) end if + call FVW_DestroyParam(ParamData%FVW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) nullify(ParamData%FlowField) end subroutine @@ -6755,6 +6821,12 @@ subroutine AD_DestroyRotInputType(RotInputTypeData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'AD_DestroyRotInputType' ErrStat = ErrID_None ErrMsg = '' + call MeshDestroy( RotInputTypeData%NacelleMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( RotInputTypeData%TowerMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( RotInputTypeData%HubMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(RotInputTypeData%BladeRootMotion)) then LB(1:1) = lbound(RotInputTypeData%BladeRootMotion) UB(1:1) = ubound(RotInputTypeData%BladeRootMotion) @@ -6773,6 +6845,8 @@ subroutine AD_DestroyRotInputType(RotInputTypeData, ErrStat, ErrMsg) end do deallocate(RotInputTypeData%BladeMotion) end if + call MeshDestroy( RotInputTypeData%TFinMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(RotInputTypeData%InflowOnBlade)) then deallocate(RotInputTypeData%InflowOnBlade) end if @@ -7133,6 +7207,12 @@ subroutine AD_DestroyRotOutputType(RotOutputTypeData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'AD_DestroyRotOutputType' ErrStat = ErrID_None ErrMsg = '' + call MeshDestroy( RotOutputTypeData%NacelleLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( RotOutputTypeData%HubLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( RotOutputTypeData%TowerLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(RotOutputTypeData%BladeLoad)) then LB(1:1) = lbound(RotOutputTypeData%BladeLoad) UB(1:1) = ubound(RotOutputTypeData%BladeLoad) @@ -7142,6 +7222,8 @@ subroutine AD_DestroyRotOutputType(RotOutputTypeData, ErrStat, ErrMsg) end do deallocate(RotOutputTypeData%BladeLoad) end if + call MeshDestroy( RotOutputTypeData%TFinLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(RotOutputTypeData%WriteOutput)) then deallocate(RotOutputTypeData%WriteOutput) end if diff --git a/modules/aerodyn/src/AirfoilInfo_Types.f90 b/modules/aerodyn/src/AirfoilInfo_Types.f90 index 70bbdd3601..9ff2f1abe8 100644 --- a/modules/aerodyn/src/AirfoilInfo_Types.f90 +++ b/modules/aerodyn/src/AirfoilInfo_Types.f90 @@ -684,6 +684,8 @@ subroutine AFI_DestroyTable_Type(Table_TypeData, ErrStat, ErrMsg) if (allocated(Table_TypeData%SplineCoefs)) then deallocate(Table_TypeData%SplineCoefs) end if + call AFI_DestroyUA_BL_Type(Table_TypeData%UA_BL, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine AFI_PackTable_Type(Buf, Indata) @@ -870,6 +872,8 @@ subroutine AFI_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'AFI_DestroyInitOutput' ErrStat = ErrID_None ErrMsg = '' + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine AFI_PackInitOutput(Buf, Indata) diff --git a/modules/aerodyn/src/BEMT_Types.f90 b/modules/aerodyn/src/BEMT_Types.f90 index 1d26b39f46..39c78f8d5f 100644 --- a/modules/aerodyn/src/BEMT_Types.f90 +++ b/modules/aerodyn/src/BEMT_Types.f90 @@ -713,6 +713,8 @@ subroutine BEMT_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'BEMT_DestroyInitOutput' ErrStat = ErrID_None ErrMsg = '' + call NWTC_Library_DestroyProgDesc(InitOutputData%Version, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine BEMT_PackInitOutput(Buf, Indata) @@ -808,6 +810,10 @@ subroutine BEMT_DestroyContState(ContStateData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'BEMT_DestroyContState' ErrStat = ErrID_None ErrMsg = '' + call UA_DestroyContState(ContStateData%UA, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call DBEMT_DestroyContState(ContStateData%DBEMT, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine BEMT_PackContState(Buf, Indata) @@ -857,6 +863,8 @@ subroutine BEMT_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'BEMT_DestroyDiscState' ErrStat = ErrID_None ErrMsg = '' + call UA_DestroyDiscState(DiscStateData%UA, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine BEMT_PackDiscState(Buf, Indata) @@ -1007,9 +1015,19 @@ subroutine BEMT_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'BEMT_DestroyOtherState' ErrStat = ErrID_None ErrMsg = '' + call UA_DestroyOtherState(OtherStateData%UA, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call DBEMT_DestroyOtherState(OtherStateData%DBEMT, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(OtherStateData%ValidPhi)) then deallocate(OtherStateData%ValidPhi) end if + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) + do i1 = LB(1), UB(1) + call BEMT_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do end subroutine subroutine BEMT_PackOtherState(Buf, Indata) @@ -1260,6 +1278,12 @@ subroutine BEMT_DestroyMisc(MiscData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'BEMT_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' + call UA_DestroyMisc(MiscData%UA, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call DBEMT_DestroyMisc(MiscData%DBEMT, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call UA_DestroyOutput(MiscData%y_UA, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MiscData%u_UA)) then LB(1:3) = lbound(MiscData%u_UA) UB(1:3) = ubound(MiscData%u_UA) @@ -1273,6 +1297,18 @@ subroutine BEMT_DestroyMisc(MiscData, ErrStat, ErrMsg) end do deallocate(MiscData%u_UA) end if + LB(1:1) = lbound(MiscData%u_DBEMT) + UB(1:1) = ubound(MiscData%u_DBEMT) + do i1 = LB(1), UB(1) + call DBEMT_DestroyInput(MiscData%u_DBEMT(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(MiscData%u_SkewWake) + UB(1:1) = ubound(MiscData%u_SkewWake) + do i1 = LB(1), UB(1) + call BEMT_DestroySkewWake_InputType(MiscData%u_SkewWake(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do if (allocated(MiscData%TnInd_op)) then deallocate(MiscData%TnInd_op) end if @@ -1709,6 +1745,10 @@ subroutine BEMT_DestroyParam(ParamData, ErrStat, ErrMsg) if (allocated(ParamData%zHub)) then deallocate(ParamData%zHub) end if + call UA_DestroyParam(ParamData%UA, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call DBEMT_DestroyParam(ParamData%DBEMT, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ParamData%FixedInductions)) then deallocate(ParamData%FixedInductions) end if diff --git a/modules/aerodyn/src/DBEMT_Types.f90 b/modules/aerodyn/src/DBEMT_Types.f90 index 87c991ed7c..25254a8edb 100644 --- a/modules/aerodyn/src/DBEMT_Types.f90 +++ b/modules/aerodyn/src/DBEMT_Types.f90 @@ -236,6 +236,8 @@ subroutine DBEMT_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'DBEMT_DestroyInitOutput' ErrStat = ErrID_None ErrMsg = '' + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine DBEMT_PackInitOutput(Buf, Indata) @@ -553,6 +555,12 @@ subroutine DBEMT_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) if (allocated(OtherStateData%n)) then deallocate(OtherStateData%n) end if + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) + do i1 = LB(1), UB(1) + call DBEMT_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do end subroutine subroutine DBEMT_PackOtherState(Buf, Indata) diff --git a/modules/aerodyn/src/FVW_Types.f90 b/modules/aerodyn/src/FVW_Types.f90 index 0070cfcbde..f8c3b8cff5 100644 --- a/modules/aerodyn/src/FVW_Types.f90 +++ b/modules/aerodyn/src/FVW_Types.f90 @@ -2714,6 +2714,12 @@ subroutine FVW_DestroyWng_MiscVarType(Wng_MiscVarTypeData, ErrStat, ErrMsg) end do deallocate(Wng_MiscVarTypeData%u_UA) end if + call UA_DestroyMisc(Wng_MiscVarTypeData%m_UA, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call UA_DestroyOutput(Wng_MiscVarTypeData%y_UA, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call UA_DestroyParam(Wng_MiscVarTypeData%p_UA, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(Wng_MiscVarTypeData%Vind_LL)) then deallocate(Wng_MiscVarTypeData%Vind_LL) end if @@ -3692,6 +3698,16 @@ subroutine FVW_DestroyMisc(MiscData, ErrStat, ErrMsg) if (allocated(MiscData%r_wind)) then deallocate(MiscData%r_wind) end if + call FVW_DestroyContState(MiscData%dxdt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FVW_DestroyContState(MiscData%x1, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FVW_DestroyContState(MiscData%x2, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FVW_DestroyT_Sgmt(MiscData%Sgmt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FVW_DestroyT_Part(MiscData%Part, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MiscData%CPs)) then deallocate(MiscData%CPs) end if diff --git a/modules/aerodyn/src/UnsteadyAero_Types.f90 b/modules/aerodyn/src/UnsteadyAero_Types.f90 index 39c864e13f..a458cb4a69 100644 --- a/modules/aerodyn/src/UnsteadyAero_Types.f90 +++ b/modules/aerodyn/src/UnsteadyAero_Types.f90 @@ -483,6 +483,8 @@ subroutine UA_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'UA_DestroyInitOutput' ErrStat = ErrID_None ErrMsg = '' + call NWTC_Library_DestroyProgDesc(InitOutputData%Version, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InitOutputData%WriteOutputHdr)) then deallocate(InitOutputData%WriteOutputHdr) end if @@ -2471,6 +2473,12 @@ subroutine UA_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) if (allocated(OtherStateData%n)) then deallocate(OtherStateData%n) end if + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) + do i1 = LB(1), UB(1) + call UA_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do if (allocated(OtherStateData%t_vortexBegin)) then deallocate(OtherStateData%t_vortexBegin) end if diff --git a/modules/aerodyn14/src/AeroDyn14_Types.f90 b/modules/aerodyn14/src/AeroDyn14_Types.f90 index db0ad1da7e..9dd29d844f 100644 --- a/modules/aerodyn14/src/AeroDyn14_Types.f90 +++ b/modules/aerodyn14/src/AeroDyn14_Types.f90 @@ -597,6 +597,20 @@ subroutine AD14_DestroyAeroConfig(AeroConfigData, ErrStat, ErrMsg) end do deallocate(AeroConfigData%Blade) end if + call AD14_DestroyMarker(AeroConfigData%Hub, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyMarker(AeroConfigData%RotorFurl, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyMarker(AeroConfigData%Nacelle, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyMarker(AeroConfigData%TailFin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyMarker(AeroConfigData%Tower, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyMarker(AeroConfigData%SubStructure, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyMarker(AeroConfigData%Foundation, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine AD14_PackAeroConfig(Buf, Indata) @@ -5572,9 +5586,13 @@ subroutine AD14_DestroyInitInput(InitInputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'AD14_DestroyInitInput' ErrStat = ErrID_None ErrMsg = '' + call AD14_DestroyAeroConfig(InitInputData%TurbineComponents, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InitInputData%TwrNodeLocs)) then deallocate(InitInputData%TwrNodeLocs) end if + call DWM_DestroyInitInput(InitInputData%DWM, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine AD14_PackInitInput(Buf, Indata) @@ -5677,6 +5695,10 @@ subroutine AD14_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'AD14_DestroyInitOutput' ErrStat = ErrID_None ErrMsg = '' + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call DWM_DestroyInitOutput(InitOutputData%DWM, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine AD14_PackInitOutput(Buf, Indata) @@ -5726,6 +5748,8 @@ subroutine AD14_DestroyContState(ContStateData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'AD14_DestroyContState' ErrStat = ErrID_None ErrMsg = '' + call DWM_DestroyContState(ContStateData%DWM, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine AD14_PackContState(Buf, Indata) @@ -5770,6 +5794,8 @@ subroutine AD14_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'AD14_DestroyDiscState' ErrStat = ErrID_None ErrMsg = '' + call DWM_DestroyDiscState(DiscStateData%DWM, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine AD14_PackDiscState(Buf, Indata) @@ -5814,6 +5840,8 @@ subroutine AD14_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'AD14_DestroyConstrState' ErrStat = ErrID_None ErrMsg = '' + call DWM_DestroyConstrState(ConstrStateData%DWM, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine AD14_PackConstrState(Buf, Indata) @@ -5858,6 +5886,8 @@ subroutine AD14_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'AD14_DestroyOtherState' ErrStat = ErrID_None ErrMsg = '' + call DWM_DestroyOtherState(OtherStateData%DWM, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine AD14_PackOtherState(Buf, Indata) @@ -5991,9 +6021,31 @@ subroutine AD14_DestroyMisc(MiscData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'AD14_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' + call DWM_DestroyMisc(MiscData%DWM, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call DWM_DestroyInput(MiscData%DWM_Inputs, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call DWM_DestroyOutput(MiscData%DWM_Outputs, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MiscData%ElPrNum)) then deallocate(MiscData%ElPrNum) end if + call AD14_DestroyAirFoil(MiscData%AirFoil, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyBeddoes(MiscData%Beddoes, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyDynInflow(MiscData%DynInflow, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyElement(MiscData%Element, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyRotor(MiscData%Rotor, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyWind(MiscData%Wind, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyInducedVel(MiscData%InducedVel, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyElOutParms(MiscData%ElOut, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MiscData%StoredForces)) then deallocate(MiscData%StoredForces) end if @@ -6224,6 +6276,26 @@ subroutine AD14_DestroyParam(ParamData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'AD14_DestroyParam' ErrStat = ErrID_None ErrMsg = '' + call AD14_DestroyAirFoilParms(ParamData%AirFoil, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyBladeParms(ParamData%Blade, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyBeddoesParms(ParamData%Beddoes, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyDynInflowParms(ParamData%DynInflow, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyElementParms(ParamData%Element, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyTwrPropsParms(ParamData%TwrProps, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyInducedVelParms(ParamData%InducedVel, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyWindParms(ParamData%Wind, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyRotorParms(ParamData%Rotor, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call DWM_DestroyParam(ParamData%DWM, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine AD14_PackParam(Buf, Indata) @@ -6424,6 +6496,10 @@ subroutine AD14_DestroyInput(InputData, ErrStat, ErrMsg) end do deallocate(InputData%InputMarkers) end if + call MeshDestroy( InputData%Twr_InputMarkers, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyAeroConfig(InputData%TurbineComponents, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InputData%MulTabLoc)) then deallocate(InputData%MulTabLoc) end if @@ -6578,6 +6654,8 @@ subroutine AD14_DestroyOutput(OutputData, ErrStat, ErrMsg) end do deallocate(OutputData%OutputLoads) end if + call MeshDestroy( OutputData%Twr_OutputLoads, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine AD14_PackOutput(Buf, Indata) diff --git a/modules/aerodyn14/src/DWM_Types.f90 b/modules/aerodyn14/src/DWM_Types.f90 index 42bd209073..c1e3d87061 100644 --- a/modules/aerodyn14/src/DWM_Types.f90 +++ b/modules/aerodyn14/src/DWM_Types.f90 @@ -2703,6 +2703,10 @@ subroutine DWM_DestroyParam(ParamData, ErrStat, ErrMsg) if (allocated(ParamData%ElementRad)) then deallocate(ParamData%ElementRad) end if + call DWM_Destroyread_turbine_position_data(ParamData%RTPD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyParam(ParamData%IfW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine DWM_PackParam(Buf, Indata) @@ -2891,6 +2895,8 @@ subroutine DWM_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'DWM_DestroyOtherState' ErrStat = ErrID_None ErrMsg = '' + call InflowWind_DestroyOtherState(OtherStateData%IfW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine DWM_PackOtherState(Buf, Indata) @@ -3011,12 +3017,38 @@ subroutine DWM_DestroyMisc(MiscData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'DWM_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' + call InflowWind_DestroyMisc(MiscData%IfW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MiscData%Nforce)) then deallocate(MiscData%Nforce) end if if (allocated(MiscData%blade_dr)) then deallocate(MiscData%blade_dr) end if + call DWM_Destroyturbine_average_velocity_data(MiscData%TAVD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call DWM_DestroyCVSD(MiscData%CalVelScale_data, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call DWM_DestroyMeanderData(MiscData%meandering_data, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call DWM_DestroyWeiMethod(MiscData%weighting_method, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call DWM_DestroyTIDownstream(MiscData%TI_downstream_data, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call DWM_DestroyTurbKaimal(MiscData%Turbulence_KS, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call DWM_DestroyShinozuka(MiscData%shinozuka_data, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call DWM_Destroysmooth_out_wake_data(MiscData%SmoothOut, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call DWM_DestroySWSV(MiscData%smooth_wake_shifted_velocity_data, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call DWM_DestroyWake_Deficit_Data(MiscData%DWDD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call DWM_Destroyturbine_blade(MiscData%DWM_tb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call DWM_Destroywake_meandered_center(MiscData%WMC, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine DWM_PackMisc(Buf, Indata) @@ -3162,6 +3194,10 @@ subroutine DWM_DestroyInput(InputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'DWM_DestroyInput' ErrStat = ErrID_None ErrMsg = '' + call DWM_Destroyread_upwind_result(InputData%Upwind_result, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyInput(InputData%IfW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine DWM_PackInput(Buf, Indata) @@ -3353,6 +3389,8 @@ subroutine DWM_DestroyOutput(OutputData, ErrStat, ErrMsg) if (allocated(OutputData%smoothed_velocity_array)) then deallocate(OutputData%smoothed_velocity_array) end if + call InflowWind_DestroyOutput(OutputData%IfW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine DWM_PackOutput(Buf, Indata) @@ -3577,6 +3615,8 @@ subroutine DWM_DestroyContState(ContStateData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'DWM_DestroyContState' ErrStat = ErrID_None ErrMsg = '' + call InflowWind_DestroyContState(ContStateData%IfW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine DWM_PackContState(Buf, Indata) @@ -3625,6 +3665,8 @@ subroutine DWM_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'DWM_DestroyDiscState' ErrStat = ErrID_None ErrMsg = '' + call InflowWind_DestroyDiscState(DiscStateData%IfW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine DWM_PackDiscState(Buf, Indata) @@ -3673,6 +3715,8 @@ subroutine DWM_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'DWM_DestroyConstrState' ErrStat = ErrID_None ErrMsg = '' + call InflowWind_DestroyConstrState(ConstrStateData%IfW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine DWM_PackConstrState(Buf, Indata) @@ -3721,6 +3765,8 @@ subroutine DWM_DestroyInitInput(InitInputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'DWM_DestroyInitInput' ErrStat = ErrID_None ErrMsg = '' + call InflowWind_DestroyInitInput(InitInputData%IfW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine DWM_PackInitInput(Buf, Indata) @@ -3769,6 +3815,8 @@ subroutine DWM_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'DWM_DestroyInitOutput' ErrStat = ErrID_None ErrMsg = '' + call InflowWind_DestroyInitOutput(InitOutputData%IfW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine DWM_PackInitOutput(Buf, Indata) diff --git a/modules/awae/src/AWAE_Types.f90 b/modules/awae/src/AWAE_Types.f90 index fb2011aeb4..faf6e87c5e 100644 --- a/modules/awae/src/AWAE_Types.f90 +++ b/modules/awae/src/AWAE_Types.f90 @@ -966,6 +966,8 @@ subroutine AWAE_DestroyInitInput(InitInputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'AWAE_DestroyInitInput' ErrStat = ErrID_None ErrMsg = '' + call AWAE_DestroyInputFileType(InitInputData%InputFileData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine AWAE_PackInitInput(Buf, Indata) @@ -1137,6 +1139,8 @@ subroutine AWAE_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'AWAE_DestroyInitOutput' ErrStat = ErrID_None ErrMsg = '' + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InitOutputData%X0_high)) then deallocate(InitOutputData%X0_high) end if @@ -2093,6 +2097,14 @@ subroutine AWAE_DestroyMisc(MiscData, ErrStat, ErrMsg) end do deallocate(MiscData%IfW) end if + call InflowWind_DestroyInput(MiscData%u_IfW_Low, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyInput(MiscData%u_IfW_High, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyOutput(MiscData%y_IfW_Low, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyOutput(MiscData%y_IfW_High, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine AWAE_PackMisc(Buf, Indata) diff --git a/modules/beamdyn/src/BeamDyn_Types.f90 b/modules/beamdyn/src/BeamDyn_Types.f90 index 0f88f483de..945aa6d01c 100644 --- a/modules/beamdyn/src/BeamDyn_Types.f90 +++ b/modules/beamdyn/src/BeamDyn_Types.f90 @@ -605,6 +605,8 @@ subroutine BD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) if (allocated(InitOutputData%WriteOutputUnt)) then deallocate(InitOutputData%WriteOutputUnt) end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InitOutputData%kp_coordinate)) then deallocate(InitOutputData%kp_coordinate) end if @@ -1160,6 +1162,8 @@ subroutine BD_DestroyInputFile(InputFileData, ErrStat, ErrMsg) if (allocated(InputFileData%kp_member)) then deallocate(InputFileData%kp_member) end if + call BD_DestroyBladeInputData(InputFileData%InpBl, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InputFileData%kp_coordinate)) then deallocate(InputFileData%kp_coordinate) end if @@ -2348,6 +2352,8 @@ subroutine BD_DestroyParam(ParamData, ErrStat, ErrMsg) if (allocated(ParamData%OutNd2NdElem)) then deallocate(ParamData%OutNd2NdElem) end if + call BD_DestroyqpParam(ParamData%qp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ParamData%BldNd_OutParam)) then LB(1:1) = lbound(ParamData%BldNd_OutParam) UB(1:1) = ubound(ParamData%BldNd_OutParam) @@ -3138,6 +3144,14 @@ subroutine BD_DestroyInput(InputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'BD_DestroyInput' ErrStat = ErrID_None ErrMsg = '' + call MeshDestroy( InputData%RootMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( InputData%PointLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( InputData%DistrLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( InputData%HubMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine BD_PackInput(Buf, Indata) @@ -3208,6 +3222,10 @@ subroutine BD_DestroyOutput(OutputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'BD_DestroyOutput' ErrStat = ErrID_None ErrMsg = '' + call MeshDestroy( OutputData%ReactionForce, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( OutputData%BldMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(OutputData%WriteOutput)) then deallocate(OutputData%WriteOutput) end if @@ -4881,6 +4899,16 @@ subroutine BD_DestroyMisc(MiscData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'BD_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' + call MeshDestroy( MiscData%u_DistrLoad_at_y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( MiscData%y_BldMotion_at_u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(MiscData%Map_u_DistrLoad_to_y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(MiscData%Map_y_BldMotion_to_u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call BD_DestroyEqMotionQP(MiscData%qp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MiscData%lin_A)) then deallocate(MiscData%lin_A) end if @@ -4971,6 +4999,10 @@ subroutine BD_DestroyMisc(MiscData, ErrStat, ErrMsg) if (allocated(MiscData%LP_indx)) then deallocate(MiscData%LP_indx) end if + call BD_DestroyInput(MiscData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call BD_DestroyInput(MiscData%u2, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine BD_PackMisc(Buf, Indata) diff --git a/modules/elastodyn/src/ElastoDyn_Types.f90 b/modules/elastodyn/src/ElastoDyn_Types.f90 index a92efa08d5..381a1f12a8 100644 --- a/modules/elastodyn/src/ElastoDyn_Types.f90 +++ b/modules/elastodyn/src/ElastoDyn_Types.f90 @@ -1109,6 +1109,8 @@ subroutine ED_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) if (allocated(InitOutputData%WriteOutputUnt)) then deallocate(InitOutputData%WriteOutputUnt) end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InitOutputData%BlPitch)) then deallocate(InitOutputData%BlPitch) end if @@ -7659,6 +7661,12 @@ subroutine ED_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'ED_DestroyOtherState' ErrStat = ErrID_None ErrMsg = '' + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) + do i1 = LB(1), UB(1) + call ED_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do if (allocated(OtherStateData%IC)) then deallocate(OtherStateData%IC) end if @@ -7857,6 +7865,10 @@ subroutine ED_DestroyMisc(MiscData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'ED_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' + call ED_DestroyCoordSys(MiscData%CoordSys, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ED_DestroyRtHndSide(MiscData%RtHS, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MiscData%AllOuts)) then deallocate(MiscData%AllOuts) end if @@ -9058,6 +9070,8 @@ subroutine ED_DestroyParam(ParamData, ErrStat, ErrMsg) if (allocated(ParamData%DOF_Desc)) then deallocate(ParamData%DOF_Desc) end if + call ED_DestroyActiveDOFs(ParamData%DOFs, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ParamData%OutParam)) then LB(1:1) = lbound(ParamData%OutParam) UB(1:1) = ubound(ParamData%OutParam) @@ -10946,6 +10960,16 @@ subroutine ED_DestroyInput(InputData, ErrStat, ErrMsg) end do deallocate(InputData%BladePtLoads) end if + call MeshDestroy( InputData%PlatformPtMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( InputData%TowerPtLoads, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( InputData%HubPtLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( InputData%NacelleLoads, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( InputData%TFinCMLoads, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InputData%TwrAddedMass)) then deallocate(InputData%TwrAddedMass) end if @@ -11211,6 +11235,16 @@ subroutine ED_DestroyOutput(OutputData, ErrStat, ErrMsg) end do deallocate(OutputData%BladeLn2Mesh) end if + call MeshDestroy( OutputData%PlatformPtMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( OutputData%TowerLn2Mesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( OutputData%HubPtMotion14, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( OutputData%HubPtMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( OutputData%BladeRootMotion14, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(OutputData%BladeRootMotion)) then LB(1:1) = lbound(OutputData%BladeRootMotion) UB(1:1) = ubound(OutputData%BladeRootMotion) @@ -11220,6 +11254,14 @@ subroutine ED_DestroyOutput(OutputData, ErrStat, ErrMsg) end do deallocate(OutputData%BladeRootMotion) end if + call MeshDestroy( OutputData%RotorFurlMotion14, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( OutputData%NacelleMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( OutputData%TowerBaseMotion14, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( OutputData%TFinCMMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(OutputData%WriteOutput)) then deallocate(OutputData%WriteOutput) end if diff --git a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 index f2ae300e97..76aff6b65c 100644 --- a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 +++ b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 @@ -605,6 +605,8 @@ subroutine ExtPtfm_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'ExtPtfm_DestroyInitOutput' ErrStat = ErrID_None ErrMsg = '' + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InitOutputData%WriteOutputHdr)) then deallocate(InitOutputData%WriteOutputHdr) end if @@ -2282,6 +2284,8 @@ subroutine ExtPtfm_DestroyInput(InputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'ExtPtfm_DestroyInput' ErrStat = ErrID_None ErrMsg = '' + call MeshDestroy( InputData%PtfmMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine ExtPtfm_PackInput(Buf, Indata) @@ -2341,6 +2345,8 @@ subroutine ExtPtfm_DestroyOutput(OutputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'ExtPtfm_DestroyOutput' ErrStat = ErrID_None ErrMsg = '' + call MeshDestroy( OutputData%PtfmMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(OutputData%WriteOutput)) then deallocate(OutputData%WriteOutput) end if diff --git a/modules/feamooring/src/FEAMooring_Types.f90 b/modules/feamooring/src/FEAMooring_Types.f90 index 3b0a6d9f7d..461ba0382c 100644 --- a/modules/feamooring/src/FEAMooring_Types.f90 +++ b/modules/feamooring/src/FEAMooring_Types.f90 @@ -1281,6 +1281,8 @@ subroutine FEAM_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) if (allocated(InitOutputData%WriteOutputUnt)) then deallocate(InitOutputData%WriteOutputUnt) end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InitOutputData%LAnchxi)) then deallocate(InitOutputData%LAnchxi) end if @@ -3275,6 +3277,10 @@ subroutine FEAM_DestroyInput(InputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FEAM_DestroyInput' ErrStat = ErrID_None ErrMsg = '' + call MeshDestroy( InputData%HydroForceLineMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( InputData%PtFairleadDisplacement, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine FEAM_PackInput(Buf, Indata) @@ -3342,6 +3348,10 @@ subroutine FEAM_DestroyOutput(OutputData, ErrStat, ErrMsg) if (allocated(OutputData%WriteOutput)) then deallocate(OutputData%WriteOutput) end if + call MeshDestroy( OutputData%PtFairleadLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( OutputData%LineMeshPosition, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine FEAM_PackOutput(Buf, Indata) diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index 5bf4913ee4..a93f309412 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -508,6 +508,8 @@ subroutine HydroDyn_DestroyInputFile(InputFileData, ErrStat, ErrMsg) if (allocated(InputFileData%AddBQuad)) then deallocate(InputFileData%AddBQuad) end if + call SeaSt_DestroyInitInput(InputFileData%SeaState, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InputFileData%PotFile)) then deallocate(InputFileData%PotFile) end if @@ -535,6 +537,12 @@ subroutine HydroDyn_DestroyInputFile(InputFileData, ErrStat, ErrMsg) if (allocated(InputFileData%PtfmCOByt)) then deallocate(InputFileData%PtfmCOByt) end if + call WAMIT_DestroyInitInput(InputFileData%WAMIT, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call WAMIT2_DestroyInitInput(InputFileData%WAMIT2, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Morison_DestroyInitInput(InputFileData%Morison, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InputFileData%UserOutputs)) then deallocate(InputFileData%UserOutputs) end if @@ -987,6 +995,8 @@ subroutine HydroDyn_DestroyInitInput(InitInputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'HydroDyn_DestroyInitInput' ErrStat = ErrID_None ErrMsg = '' + call NWTC_Library_DestroyFileInfoType(InitInputData%PassedFileData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InitInputData%WaveElev0)) then deallocate(InitInputData%WaveElev0) end if @@ -1301,12 +1311,16 @@ subroutine HydroDyn_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'HydroDyn_DestroyInitOutput' ErrStat = ErrID_None ErrMsg = '' + call Morison_DestroyInitOutput(InitOutputData%Morison, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InitOutputData%WriteOutputHdr)) then deallocate(InitOutputData%WriteOutputHdr) end if if (allocated(InitOutputData%WriteOutputUnt)) then deallocate(InitOutputData%WriteOutputUnt) end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InitOutputData%LinNames_y)) then deallocate(InitOutputData%LinNames_y) end if @@ -1510,6 +1524,12 @@ subroutine HydroDyn_DestroyHD_ModuleMapType(HD_ModuleMapTypeData, ErrStat, ErrMs character(*), parameter :: RoutineName = 'HydroDyn_DestroyHD_ModuleMapType' ErrStat = ErrID_None ErrMsg = '' + call NWTC_Library_DestroyMeshMapType(HD_ModuleMapTypeData%uW_P_2_PRP_P, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(HD_ModuleMapTypeData%W_P_2_PRP_P, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(HD_ModuleMapTypeData%M_P_2_PRP_P, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine HydroDyn_PackHD_ModuleMapType(Buf, Indata) @@ -1589,6 +1609,8 @@ subroutine HydroDyn_DestroyContState(ContStateData, ErrStat, ErrMsg) end do deallocate(ContStateData%WAMIT) end if + call Morison_DestroyContState(ContStateData%Morison, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine HydroDyn_PackContState(Buf, Indata) @@ -1694,6 +1716,8 @@ subroutine HydroDyn_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) end do deallocate(DiscStateData%WAMIT) end if + call Morison_DestroyDiscState(DiscStateData%Morison, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine HydroDyn_PackDiscState(Buf, Indata) @@ -1771,6 +1795,10 @@ subroutine HydroDyn_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'HydroDyn_DestroyConstrState' ErrStat = ErrID_None ErrMsg = '' + call WAMIT_DestroyConstrState(ConstrStateData%WAMIT, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Morison_DestroyConstrState(ConstrStateData%Morison, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine HydroDyn_PackConstrState(Buf, Indata) @@ -1848,6 +1876,8 @@ subroutine HydroDyn_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) end do deallocate(OtherStateData%WAMIT) end if + call Morison_DestroyOtherState(OtherStateData%Morison, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine HydroDyn_PackOtherState(Buf, Indata) @@ -2018,6 +2048,10 @@ subroutine HydroDyn_DestroyMisc(MiscData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'HydroDyn_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' + call MeshDestroy( MiscData%AllHdroOrigin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call HydroDyn_DestroyHD_ModuleMapType(MiscData%HD_MeshMap, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MiscData%F_PtfmAdd)) then deallocate(MiscData%F_PtfmAdd) end if @@ -2042,6 +2076,8 @@ subroutine HydroDyn_DestroyMisc(MiscData, ErrStat, ErrMsg) end do deallocate(MiscData%WAMIT2) end if + call Morison_DestroyMisc(MiscData%Morison, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MiscData%u_WAMIT)) then LB(1:1) = lbound(MiscData%u_WAMIT) UB(1:1) = ubound(MiscData%u_WAMIT) @@ -2424,6 +2460,8 @@ subroutine HydroDyn_DestroyParam(ParamData, ErrStat, ErrMsg) end do deallocate(ParamData%WAMIT2) end if + call Morison_DestroyParam(ParamData%Morison, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) nullify(ParamData%WaveTime) if (allocated(ParamData%AddF0)) then deallocate(ParamData%AddF0) @@ -2817,6 +2855,12 @@ subroutine HydroDyn_DestroyInput(InputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'HydroDyn_DestroyInput' ErrStat = ErrID_None ErrMsg = '' + call Morison_DestroyInput(InputData%Morison, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( InputData%WAMITMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( InputData%PRPMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine HydroDyn_PackInput(Buf, Indata) @@ -2940,6 +2984,10 @@ subroutine HydroDyn_DestroyOutput(OutputData, ErrStat, ErrMsg) end do deallocate(OutputData%WAMIT2) end if + call Morison_DestroyOutput(OutputData%Morison, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( OutputData%WAMITMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(OutputData%WriteOutput)) then deallocate(OutputData%WriteOutput) end if diff --git a/modules/hydrodyn/src/Morison_Types.f90 b/modules/hydrodyn/src/Morison_Types.f90 index b8788a9ac3..914d244527 100644 --- a/modules/hydrodyn/src/Morison_Types.f90 +++ b/modules/hydrodyn/src/Morison_Types.f90 @@ -6182,6 +6182,8 @@ subroutine Morison_DestroyInput(InputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'Morison_DestroyInput' ErrStat = ErrID_None ErrMsg = '' + call MeshDestroy( InputData%Mesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine Morison_PackInput(Buf, Indata) @@ -6241,6 +6243,8 @@ subroutine Morison_DestroyOutput(OutputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'Morison_DestroyOutput' ErrStat = ErrID_None ErrMsg = '' + call MeshDestroy( OutputData%Mesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(OutputData%WriteOutput)) then deallocate(OutputData%WriteOutput) end if diff --git a/modules/hydrodyn/src/SS_Excitation_Types.f90 b/modules/hydrodyn/src/SS_Excitation_Types.f90 index 2b7d95f242..4c77b9f8ea 100644 --- a/modules/hydrodyn/src/SS_Excitation_Types.f90 +++ b/modules/hydrodyn/src/SS_Excitation_Types.f90 @@ -166,6 +166,8 @@ subroutine SS_Exc_DestroyInitInput(InitInputData, ErrStat, ErrMsg) nullify(InitInputData%WaveElev0) nullify(InitInputData%WaveElev1) nullify(InitInputData%WaveTime) + call SeaSt_Interp_DestroyParam(InitInputData%SeaSt_Interp_p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine SS_Exc_PackInitInput(Buf, Indata) @@ -621,6 +623,12 @@ subroutine SS_Exc_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'SS_Exc_DestroyOtherState' ErrStat = ErrID_None ErrMsg = '' + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) + do i1 = LB(1), UB(1) + call SS_Exc_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do end subroutine subroutine SS_Exc_PackOtherState(Buf, Indata) @@ -681,6 +689,8 @@ subroutine SS_Exc_DestroyMisc(MiscData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'SS_Exc_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' + call SeaSt_Interp_DestroyMisc(MiscData%SeaSt_Interp_m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine SS_Exc_PackMisc(Buf, Indata) @@ -809,6 +819,8 @@ subroutine SS_Exc_DestroyParam(ParamData, ErrStat, ErrMsg) nullify(ParamData%WaveElev0) nullify(ParamData%WaveElev1) nullify(ParamData%WaveTime) + call SeaSt_Interp_DestroyParam(ParamData%SeaSt_Interp_p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine SS_Exc_PackParam(Buf, Indata) diff --git a/modules/hydrodyn/src/SS_Radiation_Types.f90 b/modules/hydrodyn/src/SS_Radiation_Types.f90 index 39ed49eefb..13c2115bdc 100644 --- a/modules/hydrodyn/src/SS_Radiation_Types.f90 +++ b/modules/hydrodyn/src/SS_Radiation_Types.f90 @@ -517,6 +517,12 @@ subroutine SS_Rad_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'SS_Rad_DestroyOtherState' ErrStat = ErrID_None ErrMsg = '' + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) + do i1 = LB(1), UB(1) + call SS_Rad_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do end subroutine subroutine SS_Rad_PackOtherState(Buf, Indata) diff --git a/modules/hydrodyn/src/WAMIT2_Types.f90 b/modules/hydrodyn/src/WAMIT2_Types.f90 index e9892bb6ef..5b60d16902 100644 --- a/modules/hydrodyn/src/WAMIT2_Types.f90 +++ b/modules/hydrodyn/src/WAMIT2_Types.f90 @@ -740,6 +740,8 @@ subroutine WAMIT2_DestroyOutput(OutputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'WAMIT2_DestroyOutput' ErrStat = ErrID_None ErrMsg = '' + call MeshDestroy( OutputData%Mesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine WAMIT2_PackOutput(Buf, Indata) diff --git a/modules/hydrodyn/src/WAMIT_Types.f90 b/modules/hydrodyn/src/WAMIT_Types.f90 index e844016668..729dc43f47 100644 --- a/modules/hydrodyn/src/WAMIT_Types.f90 +++ b/modules/hydrodyn/src/WAMIT_Types.f90 @@ -333,12 +333,16 @@ subroutine WAMIT_DestroyInitInput(InitInputData, ErrStat, ErrMsg) if (allocated(InitInputData%PtfmCOByt)) then deallocate(InitInputData%PtfmCOByt) end if + call Conv_Rdtn_DestroyInitInput(InitInputData%Conv_Rdtn, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) nullify(InitInputData%WaveElev0) nullify(InitInputData%WaveElev1) nullify(InitInputData%WaveElevC0) nullify(InitInputData%WaveElevC) nullify(InitInputData%WaveTime) nullify(InitInputData%WaveDirArr) + call SeaSt_Interp_DestroyParam(InitInputData%SeaSt_Interp_p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine WAMIT_PackInitInput(Buf, Indata) @@ -785,6 +789,12 @@ subroutine WAMIT_DestroyContState(ContStateData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'WAMIT_DestroyContState' ErrStat = ErrID_None ErrMsg = '' + call SS_Rad_DestroyContState(ContStateData%SS_Rdtn, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SS_Exc_DestroyContState(ContStateData%SS_Exctn, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Conv_Rdtn_DestroyContState(ContStateData%Conv_Rdtn, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine WAMIT_PackContState(Buf, Indata) @@ -854,6 +864,12 @@ subroutine WAMIT_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'WAMIT_DestroyDiscState' ErrStat = ErrID_None ErrMsg = '' + call Conv_Rdtn_DestroyDiscState(DiscStateData%Conv_Rdtn, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SS_Rad_DestroyDiscState(DiscStateData%SS_Rdtn, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SS_Exc_DestroyDiscState(DiscStateData%SS_Exctn, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(DiscStateData%BdyPosFilt)) then deallocate(DiscStateData%BdyPosFilt) end if @@ -933,6 +949,12 @@ subroutine WAMIT_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'WAMIT_DestroyConstrState' ErrStat = ErrID_None ErrMsg = '' + call Conv_Rdtn_DestroyConstrState(ConstrStateData%Conv_Rdtn, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SS_Rad_DestroyConstrState(ConstrStateData%SS_Rdtn, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SS_Exc_DestroyConstrState(ConstrStateData%SS_Exctn, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine WAMIT_PackConstrState(Buf, Indata) @@ -987,6 +1009,12 @@ subroutine WAMIT_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'WAMIT_DestroyOtherState' ErrStat = ErrID_None ErrMsg = '' + call SS_Rad_DestroyOtherState(OtherStateData%SS_Rdtn, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SS_Exc_DestroyOtherState(OtherStateData%SS_Exctn, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Conv_Rdtn_DestroyOtherState(OtherStateData%Conv_Rdtn, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine WAMIT_PackOtherState(Buf, Indata) @@ -1132,6 +1160,26 @@ subroutine WAMIT_DestroyMisc(MiscData, ErrStat, ErrMsg) if (allocated(MiscData%F_PtfmAM)) then deallocate(MiscData%F_PtfmAM) end if + call SS_Rad_DestroyMisc(MiscData%SS_Rdtn, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SS_Rad_DestroyInput(MiscData%SS_Rdtn_u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SS_Rad_DestroyOutput(MiscData%SS_Rdtn_y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SS_Exc_DestroyMisc(MiscData%SS_Exctn, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SS_Exc_DestroyInput(MiscData%SS_Exctn_u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SS_Exc_DestroyOutput(MiscData%SS_Exctn_y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Conv_Rdtn_DestroyMisc(MiscData%Conv_Rdtn, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Conv_Rdtn_DestroyInput(MiscData%Conv_Rdtn_u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Conv_Rdtn_DestroyOutput(MiscData%Conv_Rdtn_y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_Interp_DestroyMisc(MiscData%SeaSt_Interp_m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine WAMIT_PackMisc(Buf, Indata) @@ -1380,6 +1428,14 @@ subroutine WAMIT_DestroyParam(ParamData, ErrStat, ErrMsg) if (allocated(ParamData%WaveExctnGrid)) then deallocate(ParamData%WaveExctnGrid) end if + call Conv_Rdtn_DestroyParam(ParamData%Conv_Rdtn, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SS_Rad_DestroyParam(ParamData%SS_Rdtn, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SS_Exc_DestroyParam(ParamData%SS_Exctn, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_Interp_DestroyParam(ParamData%SeaSt_Interp_p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine WAMIT_PackParam(Buf, Indata) @@ -1555,6 +1611,8 @@ subroutine WAMIT_DestroyInput(InputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'WAMIT_DestroyInput' ErrStat = ErrID_None ErrMsg = '' + call MeshDestroy( InputData%Mesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine WAMIT_PackInput(Buf, Indata) @@ -1599,6 +1657,8 @@ subroutine WAMIT_DestroyOutput(OutputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'WAMIT_DestroyOutput' ErrStat = ErrID_None ErrMsg = '' + call MeshDestroy( OutputData%Mesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine WAMIT_PackOutput(Buf, Indata) diff --git a/modules/icedyn/src/IceDyn_Types.f90 b/modules/icedyn/src/IceDyn_Types.f90 index 66f107fa12..242a9431cc 100644 --- a/modules/icedyn/src/IceDyn_Types.f90 +++ b/modules/icedyn/src/IceDyn_Types.f90 @@ -726,6 +726,8 @@ subroutine IceD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) if (allocated(InitOutputData%WriteOutputUnt)) then deallocate(InitOutputData%WriteOutputUnt) end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine IceD_PackInitOutput(Buf, Indata) @@ -1798,6 +1800,8 @@ subroutine IceD_DestroyInput(InputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'IceD_DestroyInput' ErrStat = ErrID_None ErrMsg = '' + call MeshDestroy( InputData%PointMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine IceD_PackInput(Buf, Indata) @@ -1857,6 +1861,8 @@ subroutine IceD_DestroyOutput(OutputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'IceD_DestroyOutput' ErrStat = ErrID_None ErrMsg = '' + call MeshDestroy( OutputData%PointMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(OutputData%WriteOutput)) then deallocate(OutputData%WriteOutput) end if diff --git a/modules/icefloe/src/icefloe/IceFloe_Types.f90 b/modules/icefloe/src/icefloe/IceFloe_Types.f90 index 26c6a64756..64f3deffe5 100644 --- a/modules/icefloe/src/icefloe/IceFloe_Types.f90 +++ b/modules/icefloe/src/icefloe/IceFloe_Types.f90 @@ -225,6 +225,8 @@ subroutine IceFloe_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) if (allocated(InitOutputData%WriteOutputUnt)) then deallocate(InitOutputData%WriteOutputUnt) end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine IceFloe_PackInitOutput(Buf, Indata) @@ -749,6 +751,8 @@ subroutine IceFloe_DestroyInput(InputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'IceFloe_DestroyInput' ErrStat = ErrID_None ErrMsg = '' + call MeshDestroy( InputData%iceMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine IceFloe_PackInput(Buf, Indata) @@ -808,6 +812,8 @@ subroutine IceFloe_DestroyOutput(OutputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'IceFloe_DestroyOutput' ErrStat = ErrID_None ErrMsg = '' + call MeshDestroy( OutputData%iceMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(OutputData%WriteOutput)) then deallocate(OutputData%WriteOutput) end if diff --git a/modules/inflowwind/src/IfW_FlowField_Types.f90 b/modules/inflowwind/src/IfW_FlowField_Types.f90 index d3d523291a..49ef03af3f 100644 --- a/modules/inflowwind/src/IfW_FlowField_Types.f90 +++ b/modules/inflowwind/src/IfW_FlowField_Types.f90 @@ -1580,6 +1580,16 @@ subroutine IfW_FlowField_DestroyFlowFieldType(FlowFieldTypeData, ErrStat, ErrMsg character(*), parameter :: RoutineName = 'IfW_FlowField_DestroyFlowFieldType' ErrStat = ErrID_None ErrMsg = '' + call IfW_FlowField_DestroyUniformFieldType(FlowFieldTypeData%Uniform, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IfW_FlowField_DestroyGrid3DFieldType(FlowFieldTypeData%Grid3D, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IfW_FlowField_DestroyGrid4DFieldType(FlowFieldTypeData%Grid4D, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IfW_FlowField_DestroyPointsFieldType(FlowFieldTypeData%Points, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IfW_FlowField_DestroyUserFieldType(FlowFieldTypeData%User, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine IfW_FlowField_PackFlowFieldType(Buf, Indata) diff --git a/modules/inflowwind/src/InflowWind_IO_Types.f90 b/modules/inflowwind/src/InflowWind_IO_Types.f90 index d1ef0bfb76..70eb7c313a 100644 --- a/modules/inflowwind/src/InflowWind_IO_Types.f90 +++ b/modules/inflowwind/src/InflowWind_IO_Types.f90 @@ -326,6 +326,8 @@ subroutine InflowWind_IO_DestroyUniform_InitInputType(Uniform_InitInputTypeData, character(*), parameter :: RoutineName = 'InflowWind_IO_DestroyUniform_InitInputType' ErrStat = ErrID_None ErrMsg = '' + call NWTC_Library_DestroyFileInfoType(Uniform_InitInputTypeData%PassedFileData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine InflowWind_IO_PackUniform_InitInputType(Buf, Indata) @@ -616,6 +618,8 @@ subroutine InflowWind_IO_DestroyHAWC_InitInputType(HAWC_InitInputTypeData, ErrSt character(*), parameter :: RoutineName = 'InflowWind_IO_DestroyHAWC_InitInputType' ErrStat = ErrID_None ErrMsg = '' + call InflowWind_IO_DestroyGrid3D_InitInputType(HAWC_InitInputTypeData%G3D, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine InflowWind_IO_PackHAWC_InitInputType(Buf, Indata) diff --git a/modules/inflowwind/src/InflowWind_Types.f90 b/modules/inflowwind/src/InflowWind_Types.f90 index 9e0c3ef797..c22315ff27 100644 --- a/modules/inflowwind/src/InflowWind_Types.f90 +++ b/modules/inflowwind/src/InflowWind_Types.f90 @@ -386,6 +386,8 @@ subroutine InflowWind_DestroyInputFile(InputFileData, ErrStat, ErrMsg) if (allocated(InputFileData%FocalDistanceZ)) then deallocate(InputFileData%FocalDistanceZ) end if + call InflowWind_IO_DestroyGrid3D_InitInputType(InputFileData%FF, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine InflowWind_PackInputFile(Buf, Indata) @@ -705,6 +707,14 @@ subroutine InflowWind_DestroyInitInput(InitInputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'InflowWind_DestroyInitInput' ErrStat = ErrID_None ErrMsg = '' + call NWTC_Library_DestroyFileInfoType(InitInputData%PassedFileData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyFileInfoType(InitInputData%WindType2Data, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Lidar_DestroyInitInput(InitInputData%lidar, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_IO_DestroyGrid4D_InitInputType(InitInputData%FDext, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine InflowWind_PackInitInput(Buf, Indata) @@ -912,6 +922,10 @@ subroutine InflowWind_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) if (allocated(InitOutputData%WriteOutputUnt)) then deallocate(InitOutputData%WriteOutputUnt) end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_IO_DestroyWindFileDat(InitOutputData%WindFileInfo, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InitOutputData%LinNames_y)) then deallocate(InitOutputData%LinNames_y) end if @@ -1265,6 +1279,8 @@ subroutine InflowWind_DestroyParam(ParamData, ErrStat, ErrMsg) if (allocated(ParamData%OutParamLinIndx)) then deallocate(ParamData%OutParamLinIndx) end if + call Lidar_DestroyParam(ParamData%lidar, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine InflowWind_PackParam(Buf, Indata) @@ -1480,6 +1496,8 @@ subroutine InflowWind_DestroyInput(InputData, ErrStat, ErrMsg) if (allocated(InputData%PositionXYZ)) then deallocate(InputData%PositionXYZ) end if + call Lidar_DestroyInput(InputData%lidar, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine InflowWind_PackInput(Buf, Indata) @@ -1606,6 +1624,8 @@ subroutine InflowWind_DestroyOutput(OutputData, ErrStat, ErrMsg) if (allocated(OutputData%WriteOutput)) then deallocate(OutputData%WriteOutput) end if + call Lidar_DestroyOutput(OutputData%lidar, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine InflowWind_PackOutput(Buf, Indata) @@ -1933,6 +1953,14 @@ subroutine InflowWind_DestroyMisc(MiscData, ErrStat, ErrMsg) if (allocated(MiscData%WindAiUVW)) then deallocate(MiscData%WindAiUVW) end if + call InflowWind_DestroyInput(MiscData%u_Avg, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyOutput(MiscData%y_Avg, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyInput(MiscData%u_Hub, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyOutput(MiscData%y_Hub, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine InflowWind_PackMisc(Buf, Indata) diff --git a/modules/map/src/MAP_Types.f90 b/modules/map/src/MAP_Types.f90 index 8cfa9b0a2a..0097d1fe5f 100644 --- a/modules/map/src/MAP_Types.f90 +++ b/modules/map/src/MAP_Types.f90 @@ -290,6 +290,8 @@ subroutine MAP_DestroyInitInput(InitInputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'MAP_DestroyInitInput' ErrStat = ErrID_None ErrMsg = '' + call MAP_Fortran_DestroyLin_InitInputType(InitInputData%LinInitInp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine MAP_PackInitInput(Buf, Indata) @@ -470,6 +472,10 @@ subroutine MAP_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) if (allocated(InitOutputData%writeOutputUnt)) then deallocate(InitOutputData%writeOutputUnt) end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MAP_Fortran_DestroyLin_InitOutputType(InitOutputData%LinInitOut, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine MAP_PackInitOutput(Buf, Indata) @@ -2608,6 +2614,8 @@ subroutine MAP_DestroyParam(ParamData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'MAP_DestroyParam' ErrStat = ErrID_None ErrMsg = '' + call MAP_Fortran_DestroyLin_ParamType(ParamData%LinParams, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine MAP_PackParam(Buf, Indata) @@ -2799,6 +2807,8 @@ subroutine MAP_DestroyInput(InputData, ErrStat, ErrMsg) InputData%C_obj%z = c_null_ptr InputData%C_obj%z_Len = 0 end if + call MeshDestroy( InputData%PtFairDisplacement, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine MAP_PackInput(Buf, Indata) @@ -3166,6 +3176,8 @@ subroutine MAP_DestroyOutput(OutputData, ErrStat, ErrMsg) OutputData%C_obj%wrtOutput = c_null_ptr OutputData%C_obj%wrtOutput_Len = 0 end if + call MeshDestroy( OutputData%ptFairleadLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine MAP_PackOutput(Buf, Indata) diff --git a/modules/moordyn/src/MoorDyn_Types.f90 b/modules/moordyn/src/MoorDyn_Types.f90 index 36e408e60e..b18e0bc6f0 100644 --- a/modules/moordyn/src/MoorDyn_Types.f90 +++ b/modules/moordyn/src/MoorDyn_Types.f90 @@ -598,6 +598,8 @@ subroutine MD_DestroyInitInput(InitInputData, ErrStat, ErrMsg) if (allocated(InitInputData%TurbineRefPos)) then deallocate(InitInputData%TurbineRefPos) end if + call NWTC_Library_DestroyFileInfoType(InitInputData%PassedPrimaryInputData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InitInputData%OutList)) then deallocate(InitInputData%OutList) end if @@ -3567,6 +3569,8 @@ subroutine MD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) if (allocated(InitOutputData%writeOutputUnt)) then deallocate(InitOutputData%writeOutputUnt) end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InitOutputData%CableCChanRqst)) then deallocate(InitOutputData%CableCChanRqst) end if @@ -4468,6 +4472,8 @@ subroutine MD_DestroyMisc(MiscData, ErrStat, ErrMsg) end do deallocate(MiscData%RodTypeList) end if + call MD_DestroyBody(MiscData%GroundBody, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MiscData%BodyList)) then LB(1:1) = lbound(MiscData%BodyList) UB(1:1) = ubound(MiscData%BodyList) @@ -4555,6 +4561,10 @@ subroutine MD_DestroyMisc(MiscData, ErrStat, ErrMsg) if (allocated(MiscData%BodyStateIsN)) then deallocate(MiscData%BodyStateIsN) end if + call MD_DestroyContState(MiscData%xTemp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_DestroyContState(MiscData%xdTemp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MiscData%MDWrOutput)) then deallocate(MiscData%MDWrOutput) end if diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index 3d23b6ebaa..d63d1fba03 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -1552,6 +1552,10 @@ subroutine FAST_DestroyParam(ParamData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroyParam' ErrStat = ErrID_None ErrMsg = '' + call FAST_DestroyVTK_SurfaceType(ParamData%VTK_surface, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyVTK_ModeShapeType(ParamData%VTK_modes, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine FAST_PackParam(Buf, Indata) @@ -6441,6 +6445,14 @@ subroutine FAST_DestroyLinFileType(LinFileTypeData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroyLinFileType' ErrStat = ErrID_None ErrMsg = '' + LB(1:1) = lbound(LinFileTypeData%Modules) + UB(1:1) = ubound(LinFileTypeData%Modules) + do i1 = LB(1), UB(1) + call FAST_DestroyModLinType(LinFileTypeData%Modules(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call FAST_DestroyLinType(LinFileTypeData%Glue, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine FAST_PackLinFileType(Buf, Indata) @@ -6887,6 +6899,16 @@ subroutine FAST_DestroyOutputFileType(OutputFileTypeData, ErrStat, ErrMsg) if (allocated(OutputFileTypeData%ChannelUnits)) then deallocate(OutputFileTypeData%ChannelUnits) end if + LB(1:1) = lbound(OutputFileTypeData%Module_Ver) + UB(1:1) = ubound(OutputFileTypeData%Module_Ver) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyProgDesc(OutputFileTypeData%Module_Ver(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call FAST_DestroyLinFileType(OutputFileTypeData%Lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyLinStateSave(OutputFileTypeData%op, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine FAST_PackOutputFileType(Buf, Indata) @@ -8436,6 +8458,38 @@ subroutine FAST_DestroyElastoDyn_Data(ElastoDyn_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroyElastoDyn_Data' ErrStat = ErrID_None ErrMsg = '' + LB(1:1) = lbound(ElastoDyn_DataData%x) + UB(1:1) = ubound(ElastoDyn_DataData%x) + do i1 = LB(1), UB(1) + call ED_DestroyContState(ElastoDyn_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(ElastoDyn_DataData%xd) + UB(1:1) = ubound(ElastoDyn_DataData%xd) + do i1 = LB(1), UB(1) + call ED_DestroyDiscState(ElastoDyn_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(ElastoDyn_DataData%z) + UB(1:1) = ubound(ElastoDyn_DataData%z) + do i1 = LB(1), UB(1) + call ED_DestroyConstrState(ElastoDyn_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(ElastoDyn_DataData%OtherSt) + UB(1:1) = ubound(ElastoDyn_DataData%OtherSt) + do i1 = LB(1), UB(1) + call ED_DestroyOtherState(ElastoDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call ED_DestroyParam(ElastoDyn_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ED_DestroyInput(ElastoDyn_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ED_DestroyOutput(ElastoDyn_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ED_DestroyMisc(ElastoDyn_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ElastoDyn_DataData%Output)) then LB(1:1) = lbound(ElastoDyn_DataData%Output) UB(1:1) = ubound(ElastoDyn_DataData%Output) @@ -8445,6 +8499,8 @@ subroutine FAST_DestroyElastoDyn_Data(ElastoDyn_DataData, ErrStat, ErrMsg) end do deallocate(ElastoDyn_DataData%Output) end if + call ED_DestroyOutput(ElastoDyn_DataData%y_interp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ElastoDyn_DataData%Input)) then LB(1:1) = lbound(ElastoDyn_DataData%Input) UB(1:1) = ubound(ElastoDyn_DataData%Input) @@ -8716,6 +8772,38 @@ subroutine FAST_DestroyServoDyn_Data(ServoDyn_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroyServoDyn_Data' ErrStat = ErrID_None ErrMsg = '' + LB(1:1) = lbound(ServoDyn_DataData%x) + UB(1:1) = ubound(ServoDyn_DataData%x) + do i1 = LB(1), UB(1) + call SrvD_DestroyContState(ServoDyn_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(ServoDyn_DataData%xd) + UB(1:1) = ubound(ServoDyn_DataData%xd) + do i1 = LB(1), UB(1) + call SrvD_DestroyDiscState(ServoDyn_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(ServoDyn_DataData%z) + UB(1:1) = ubound(ServoDyn_DataData%z) + do i1 = LB(1), UB(1) + call SrvD_DestroyConstrState(ServoDyn_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(ServoDyn_DataData%OtherSt) + UB(1:1) = ubound(ServoDyn_DataData%OtherSt) + do i1 = LB(1), UB(1) + call SrvD_DestroyOtherState(ServoDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call SrvD_DestroyParam(ServoDyn_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SrvD_DestroyInput(ServoDyn_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SrvD_DestroyOutput(ServoDyn_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SrvD_DestroyMisc(ServoDyn_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ServoDyn_DataData%Output)) then LB(1:1) = lbound(ServoDyn_DataData%Output) UB(1:1) = ubound(ServoDyn_DataData%Output) @@ -8725,6 +8813,8 @@ subroutine FAST_DestroyServoDyn_Data(ServoDyn_DataData, ErrStat, ErrMsg) end do deallocate(ServoDyn_DataData%Output) end if + call SrvD_DestroyOutput(ServoDyn_DataData%y_interp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ServoDyn_DataData%Input)) then LB(1:1) = lbound(ServoDyn_DataData%Input) UB(1:1) = ubound(ServoDyn_DataData%Input) @@ -8975,6 +9065,38 @@ subroutine FAST_DestroyAeroDyn14_Data(AeroDyn14_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroyAeroDyn14_Data' ErrStat = ErrID_None ErrMsg = '' + LB(1:1) = lbound(AeroDyn14_DataData%x) + UB(1:1) = ubound(AeroDyn14_DataData%x) + do i1 = LB(1), UB(1) + call AD14_DestroyContState(AeroDyn14_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(AeroDyn14_DataData%xd) + UB(1:1) = ubound(AeroDyn14_DataData%xd) + do i1 = LB(1), UB(1) + call AD14_DestroyDiscState(AeroDyn14_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(AeroDyn14_DataData%z) + UB(1:1) = ubound(AeroDyn14_DataData%z) + do i1 = LB(1), UB(1) + call AD14_DestroyConstrState(AeroDyn14_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(AeroDyn14_DataData%OtherSt) + UB(1:1) = ubound(AeroDyn14_DataData%OtherSt) + do i1 = LB(1), UB(1) + call AD14_DestroyOtherState(AeroDyn14_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call AD14_DestroyParam(AeroDyn14_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyInput(AeroDyn14_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyOutput(AeroDyn14_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyMisc(AeroDyn14_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(AeroDyn14_DataData%Input)) then LB(1:1) = lbound(AeroDyn14_DataData%Input) UB(1:1) = ubound(AeroDyn14_DataData%Input) @@ -9220,6 +9342,38 @@ subroutine FAST_DestroyAeroDyn_Data(AeroDyn_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroyAeroDyn_Data' ErrStat = ErrID_None ErrMsg = '' + LB(1:1) = lbound(AeroDyn_DataData%x) + UB(1:1) = ubound(AeroDyn_DataData%x) + do i1 = LB(1), UB(1) + call AD_DestroyContState(AeroDyn_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(AeroDyn_DataData%xd) + UB(1:1) = ubound(AeroDyn_DataData%xd) + do i1 = LB(1), UB(1) + call AD_DestroyDiscState(AeroDyn_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(AeroDyn_DataData%z) + UB(1:1) = ubound(AeroDyn_DataData%z) + do i1 = LB(1), UB(1) + call AD_DestroyConstrState(AeroDyn_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(AeroDyn_DataData%OtherSt) + UB(1:1) = ubound(AeroDyn_DataData%OtherSt) + do i1 = LB(1), UB(1) + call AD_DestroyOtherState(AeroDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call AD_DestroyParam(AeroDyn_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD_DestroyInput(AeroDyn_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD_DestroyOutput(AeroDyn_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD_DestroyMisc(AeroDyn_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(AeroDyn_DataData%Output)) then LB(1:1) = lbound(AeroDyn_DataData%Output) UB(1:1) = ubound(AeroDyn_DataData%Output) @@ -9229,6 +9383,8 @@ subroutine FAST_DestroyAeroDyn_Data(AeroDyn_DataData, ErrStat, ErrMsg) end do deallocate(AeroDyn_DataData%Output) end if + call AD_DestroyOutput(AeroDyn_DataData%y_interp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(AeroDyn_DataData%Input)) then LB(1:1) = lbound(AeroDyn_DataData%Input) UB(1:1) = ubound(AeroDyn_DataData%Input) @@ -9500,6 +9656,38 @@ subroutine FAST_DestroyInflowWind_Data(InflowWind_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroyInflowWind_Data' ErrStat = ErrID_None ErrMsg = '' + LB(1:1) = lbound(InflowWind_DataData%x) + UB(1:1) = ubound(InflowWind_DataData%x) + do i1 = LB(1), UB(1) + call InflowWind_DestroyContState(InflowWind_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(InflowWind_DataData%xd) + UB(1:1) = ubound(InflowWind_DataData%xd) + do i1 = LB(1), UB(1) + call InflowWind_DestroyDiscState(InflowWind_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(InflowWind_DataData%z) + UB(1:1) = ubound(InflowWind_DataData%z) + do i1 = LB(1), UB(1) + call InflowWind_DestroyConstrState(InflowWind_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(InflowWind_DataData%OtherSt) + UB(1:1) = ubound(InflowWind_DataData%OtherSt) + do i1 = LB(1), UB(1) + call InflowWind_DestroyOtherState(InflowWind_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call InflowWind_DestroyParam(InflowWind_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyInput(InflowWind_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyOutput(InflowWind_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyMisc(InflowWind_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InflowWind_DataData%Output)) then LB(1:1) = lbound(InflowWind_DataData%Output) UB(1:1) = ubound(InflowWind_DataData%Output) @@ -9509,6 +9697,8 @@ subroutine FAST_DestroyInflowWind_Data(InflowWind_DataData, ErrStat, ErrMsg) end do deallocate(InflowWind_DataData%Output) end if + call InflowWind_DestroyOutput(InflowWind_DataData%y_interp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InflowWind_DataData%Input)) then LB(1:1) = lbound(InflowWind_DataData%Input) UB(1:1) = ubound(InflowWind_DataData%Input) @@ -9695,6 +9885,14 @@ subroutine FAST_DestroyOpenFOAM_Data(OpenFOAM_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroyOpenFOAM_Data' ErrStat = ErrID_None ErrMsg = '' + call OpFM_DestroyInput(OpenFOAM_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call OpFM_DestroyOutput(OpenFOAM_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call OpFM_DestroyParam(OpenFOAM_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call OpFM_DestroyMisc(OpenFOAM_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine FAST_PackOpenFOAM_Data(Buf, Indata) @@ -9751,6 +9949,12 @@ subroutine FAST_DestroySCDataEx_Data(SCDataEx_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroySCDataEx_Data' ErrStat = ErrID_None ErrMsg = '' + call SC_DX_DestroyInput(SCDataEx_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SC_DX_DestroyOutput(SCDataEx_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SC_DX_DestroyParam(SCDataEx_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine FAST_PackSCDataEx_Data(Buf, Indata) @@ -9893,6 +10097,38 @@ subroutine FAST_DestroySubDyn_Data(SubDyn_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroySubDyn_Data' ErrStat = ErrID_None ErrMsg = '' + LB(1:1) = lbound(SubDyn_DataData%x) + UB(1:1) = ubound(SubDyn_DataData%x) + do i1 = LB(1), UB(1) + call SD_DestroyContState(SubDyn_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(SubDyn_DataData%xd) + UB(1:1) = ubound(SubDyn_DataData%xd) + do i1 = LB(1), UB(1) + call SD_DestroyDiscState(SubDyn_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(SubDyn_DataData%z) + UB(1:1) = ubound(SubDyn_DataData%z) + do i1 = LB(1), UB(1) + call SD_DestroyConstrState(SubDyn_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(SubDyn_DataData%OtherSt) + UB(1:1) = ubound(SubDyn_DataData%OtherSt) + do i1 = LB(1), UB(1) + call SD_DestroyOtherState(SubDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call SD_DestroyParam(SubDyn_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SD_DestroyInput(SubDyn_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SD_DestroyOutput(SubDyn_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SD_DestroyMisc(SubDyn_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(SubDyn_DataData%Input)) then LB(1:1) = lbound(SubDyn_DataData%Input) UB(1:1) = ubound(SubDyn_DataData%Input) @@ -9911,6 +10147,8 @@ subroutine FAST_DestroySubDyn_Data(SubDyn_DataData, ErrStat, ErrMsg) end do deallocate(SubDyn_DataData%Output) end if + call SD_DestroyOutput(SubDyn_DataData%y_interp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(SubDyn_DataData%InputTimes)) then deallocate(SubDyn_DataData%InputTimes) end if @@ -10152,6 +10390,38 @@ subroutine FAST_DestroyExtPtfm_Data(ExtPtfm_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroyExtPtfm_Data' ErrStat = ErrID_None ErrMsg = '' + LB(1:1) = lbound(ExtPtfm_DataData%x) + UB(1:1) = ubound(ExtPtfm_DataData%x) + do i1 = LB(1), UB(1) + call ExtPtfm_DestroyContState(ExtPtfm_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(ExtPtfm_DataData%xd) + UB(1:1) = ubound(ExtPtfm_DataData%xd) + do i1 = LB(1), UB(1) + call ExtPtfm_DestroyDiscState(ExtPtfm_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(ExtPtfm_DataData%z) + UB(1:1) = ubound(ExtPtfm_DataData%z) + do i1 = LB(1), UB(1) + call ExtPtfm_DestroyConstrState(ExtPtfm_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(ExtPtfm_DataData%OtherSt) + UB(1:1) = ubound(ExtPtfm_DataData%OtherSt) + do i1 = LB(1), UB(1) + call ExtPtfm_DestroyOtherState(ExtPtfm_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call ExtPtfm_DestroyParam(ExtPtfm_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ExtPtfm_DestroyInput(ExtPtfm_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ExtPtfm_DestroyOutput(ExtPtfm_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ExtPtfm_DestroyMisc(ExtPtfm_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ExtPtfm_DataData%Input)) then LB(1:1) = lbound(ExtPtfm_DataData%Input) UB(1:1) = ubound(ExtPtfm_DataData%Input) @@ -10397,6 +10667,38 @@ subroutine FAST_DestroySeaState_Data(SeaState_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroySeaState_Data' ErrStat = ErrID_None ErrMsg = '' + LB(1:1) = lbound(SeaState_DataData%x) + UB(1:1) = ubound(SeaState_DataData%x) + do i1 = LB(1), UB(1) + call SeaSt_DestroyContState(SeaState_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(SeaState_DataData%xd) + UB(1:1) = ubound(SeaState_DataData%xd) + do i1 = LB(1), UB(1) + call SeaSt_DestroyDiscState(SeaState_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(SeaState_DataData%z) + UB(1:1) = ubound(SeaState_DataData%z) + do i1 = LB(1), UB(1) + call SeaSt_DestroyConstrState(SeaState_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(SeaState_DataData%OtherSt) + UB(1:1) = ubound(SeaState_DataData%OtherSt) + do i1 = LB(1), UB(1) + call SeaSt_DestroyOtherState(SeaState_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call SeaSt_DestroyParam(SeaState_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyInput(SeaState_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyOutput(SeaState_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyMisc(SeaState_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(SeaState_DataData%Input)) then LB(1:1) = lbound(SeaState_DataData%Input) UB(1:1) = ubound(SeaState_DataData%Input) @@ -10415,6 +10717,8 @@ subroutine FAST_DestroySeaState_Data(SeaState_DataData, ErrStat, ErrMsg) end do deallocate(SeaState_DataData%Output) end if + call SeaSt_DestroyOutput(SeaState_DataData%y_interp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(SeaState_DataData%InputTimes)) then deallocate(SeaState_DataData%InputTimes) end if @@ -10677,6 +10981,38 @@ subroutine FAST_DestroyHydroDyn_Data(HydroDyn_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroyHydroDyn_Data' ErrStat = ErrID_None ErrMsg = '' + LB(1:1) = lbound(HydroDyn_DataData%x) + UB(1:1) = ubound(HydroDyn_DataData%x) + do i1 = LB(1), UB(1) + call HydroDyn_DestroyContState(HydroDyn_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(HydroDyn_DataData%xd) + UB(1:1) = ubound(HydroDyn_DataData%xd) + do i1 = LB(1), UB(1) + call HydroDyn_DestroyDiscState(HydroDyn_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(HydroDyn_DataData%z) + UB(1:1) = ubound(HydroDyn_DataData%z) + do i1 = LB(1), UB(1) + call HydroDyn_DestroyConstrState(HydroDyn_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(HydroDyn_DataData%OtherSt) + UB(1:1) = ubound(HydroDyn_DataData%OtherSt) + do i1 = LB(1), UB(1) + call HydroDyn_DestroyOtherState(HydroDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call HydroDyn_DestroyParam(HydroDyn_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call HydroDyn_DestroyInput(HydroDyn_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call HydroDyn_DestroyOutput(HydroDyn_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call HydroDyn_DestroyMisc(HydroDyn_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(HydroDyn_DataData%Output)) then LB(1:1) = lbound(HydroDyn_DataData%Output) UB(1:1) = ubound(HydroDyn_DataData%Output) @@ -10686,6 +11022,8 @@ subroutine FAST_DestroyHydroDyn_Data(HydroDyn_DataData, ErrStat, ErrMsg) end do deallocate(HydroDyn_DataData%Output) end if + call HydroDyn_DestroyOutput(HydroDyn_DataData%y_interp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(HydroDyn_DataData%Input)) then LB(1:1) = lbound(HydroDyn_DataData%Input) UB(1:1) = ubound(HydroDyn_DataData%Input) @@ -10936,6 +11274,38 @@ subroutine FAST_DestroyIceFloe_Data(IceFloe_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroyIceFloe_Data' ErrStat = ErrID_None ErrMsg = '' + LB(1:1) = lbound(IceFloe_DataData%x) + UB(1:1) = ubound(IceFloe_DataData%x) + do i1 = LB(1), UB(1) + call IceFloe_DestroyContState(IceFloe_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(IceFloe_DataData%xd) + UB(1:1) = ubound(IceFloe_DataData%xd) + do i1 = LB(1), UB(1) + call IceFloe_DestroyDiscState(IceFloe_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(IceFloe_DataData%z) + UB(1:1) = ubound(IceFloe_DataData%z) + do i1 = LB(1), UB(1) + call IceFloe_DestroyConstrState(IceFloe_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(IceFloe_DataData%OtherSt) + UB(1:1) = ubound(IceFloe_DataData%OtherSt) + do i1 = LB(1), UB(1) + call IceFloe_DestroyOtherState(IceFloe_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call IceFloe_DestroyParam(IceFloe_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IceFloe_DestroyInput(IceFloe_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IceFloe_DestroyOutput(IceFloe_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IceFloe_DestroyMisc(IceFloe_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(IceFloe_DataData%Input)) then LB(1:1) = lbound(IceFloe_DataData%Input) UB(1:1) = ubound(IceFloe_DataData%Input) @@ -11177,6 +11547,34 @@ subroutine FAST_DestroyMAP_Data(MAP_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroyMAP_Data' ErrStat = ErrID_None ErrMsg = '' + LB(1:1) = lbound(MAP_DataData%x) + UB(1:1) = ubound(MAP_DataData%x) + do i1 = LB(1), UB(1) + call MAP_DestroyContState(MAP_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(MAP_DataData%xd) + UB(1:1) = ubound(MAP_DataData%xd) + do i1 = LB(1), UB(1) + call MAP_DestroyDiscState(MAP_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(MAP_DataData%z) + UB(1:1) = ubound(MAP_DataData%z) + do i1 = LB(1), UB(1) + call MAP_DestroyConstrState(MAP_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call MAP_DestroyOtherState(MAP_DataData%OtherSt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MAP_DestroyParam(MAP_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MAP_DestroyInput(MAP_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MAP_DestroyOutput(MAP_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MAP_DestroyOtherState(MAP_DataData%OtherSt_old, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MAP_DataData%Output)) then LB(1:1) = lbound(MAP_DataData%Output) UB(1:1) = ubound(MAP_DataData%Output) @@ -11186,6 +11584,8 @@ subroutine FAST_DestroyMAP_Data(MAP_DataData, ErrStat, ErrMsg) end do deallocate(MAP_DataData%Output) end if + call MAP_DestroyOutput(MAP_DataData%y_interp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MAP_DataData%Input)) then LB(1:1) = lbound(MAP_DataData%Input) UB(1:1) = ubound(MAP_DataData%Input) @@ -11428,6 +11828,38 @@ subroutine FAST_DestroyFEAMooring_Data(FEAMooring_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroyFEAMooring_Data' ErrStat = ErrID_None ErrMsg = '' + LB(1:1) = lbound(FEAMooring_DataData%x) + UB(1:1) = ubound(FEAMooring_DataData%x) + do i1 = LB(1), UB(1) + call FEAM_DestroyContState(FEAMooring_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(FEAMooring_DataData%xd) + UB(1:1) = ubound(FEAMooring_DataData%xd) + do i1 = LB(1), UB(1) + call FEAM_DestroyDiscState(FEAMooring_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(FEAMooring_DataData%z) + UB(1:1) = ubound(FEAMooring_DataData%z) + do i1 = LB(1), UB(1) + call FEAM_DestroyConstrState(FEAMooring_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(FEAMooring_DataData%OtherSt) + UB(1:1) = ubound(FEAMooring_DataData%OtherSt) + do i1 = LB(1), UB(1) + call FEAM_DestroyOtherState(FEAMooring_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call FEAM_DestroyParam(FEAMooring_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FEAM_DestroyInput(FEAMooring_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FEAM_DestroyOutput(FEAMooring_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FEAM_DestroyMisc(FEAMooring_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(FEAMooring_DataData%Input)) then LB(1:1) = lbound(FEAMooring_DataData%Input) UB(1:1) = ubound(FEAMooring_DataData%Input) @@ -11673,6 +12105,38 @@ subroutine FAST_DestroyMoorDyn_Data(MoorDyn_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroyMoorDyn_Data' ErrStat = ErrID_None ErrMsg = '' + LB(1:1) = lbound(MoorDyn_DataData%x) + UB(1:1) = ubound(MoorDyn_DataData%x) + do i1 = LB(1), UB(1) + call MD_DestroyContState(MoorDyn_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(MoorDyn_DataData%xd) + UB(1:1) = ubound(MoorDyn_DataData%xd) + do i1 = LB(1), UB(1) + call MD_DestroyDiscState(MoorDyn_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(MoorDyn_DataData%z) + UB(1:1) = ubound(MoorDyn_DataData%z) + do i1 = LB(1), UB(1) + call MD_DestroyConstrState(MoorDyn_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(MoorDyn_DataData%OtherSt) + UB(1:1) = ubound(MoorDyn_DataData%OtherSt) + do i1 = LB(1), UB(1) + call MD_DestroyOtherState(MoorDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call MD_DestroyParam(MoorDyn_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_DestroyInput(MoorDyn_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_DestroyOutput(MoorDyn_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_DestroyMisc(MoorDyn_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MoorDyn_DataData%Output)) then LB(1:1) = lbound(MoorDyn_DataData%Output) UB(1:1) = ubound(MoorDyn_DataData%Output) @@ -11682,6 +12146,8 @@ subroutine FAST_DestroyMoorDyn_Data(MoorDyn_DataData, ErrStat, ErrMsg) end do deallocate(MoorDyn_DataData%Output) end if + call MD_DestroyOutput(MoorDyn_DataData%y_interp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MoorDyn_DataData%Input)) then LB(1:1) = lbound(MoorDyn_DataData%Input) UB(1:1) = ubound(MoorDyn_DataData%Input) @@ -11932,6 +12398,38 @@ subroutine FAST_DestroyOrcaFlex_Data(OrcaFlex_DataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroyOrcaFlex_Data' ErrStat = ErrID_None ErrMsg = '' + LB(1:1) = lbound(OrcaFlex_DataData%x) + UB(1:1) = ubound(OrcaFlex_DataData%x) + do i1 = LB(1), UB(1) + call Orca_DestroyContState(OrcaFlex_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(OrcaFlex_DataData%xd) + UB(1:1) = ubound(OrcaFlex_DataData%xd) + do i1 = LB(1), UB(1) + call Orca_DestroyDiscState(OrcaFlex_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(OrcaFlex_DataData%z) + UB(1:1) = ubound(OrcaFlex_DataData%z) + do i1 = LB(1), UB(1) + call Orca_DestroyConstrState(OrcaFlex_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + LB(1:1) = lbound(OrcaFlex_DataData%OtherSt) + UB(1:1) = ubound(OrcaFlex_DataData%OtherSt) + do i1 = LB(1), UB(1) + call Orca_DestroyOtherState(OrcaFlex_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + call Orca_DestroyParam(OrcaFlex_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Orca_DestroyInput(OrcaFlex_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Orca_DestroyOutput(OrcaFlex_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Orca_DestroyMisc(OrcaFlex_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(OrcaFlex_DataData%Input)) then LB(1:1) = lbound(OrcaFlex_DataData%Input) UB(1:1) = ubound(OrcaFlex_DataData%Input) @@ -12677,6 +13175,24 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) end do deallocate(ModuleMapTypeData%ED_P_2_BD_P_Hub) end if + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_P_2_HD_PRP_P, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SubStructure_2_HD_W_P, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%HD_W_P_2_SubStructure, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SubStructure_2_HD_M_P, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%HD_M_P_2_SubStructure, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%Structure_2_Mooring, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%Mooring_2_Structure, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_P_2_SD_TP, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SD_TP_2_ED_P, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ModuleMapTypeData%ED_P_2_NStC_P_N)) then LB(1:1) = lbound(ModuleMapTypeData%ED_P_2_NStC_P_N) UB(1:1) = ubound(ModuleMapTypeData%ED_P_2_NStC_P_N) @@ -12775,6 +13291,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) end do deallocate(ModuleMapTypeData%SubStructure_2_SStC_P_P) end if + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_P_2_SrvD_P_P, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ModuleMapTypeData%BDED_L_2_AD_L_B)) then LB(1:1) = lbound(ModuleMapTypeData%BDED_L_2_AD_L_B) UB(1:1) = ubound(ModuleMapTypeData%BDED_L_2_AD_L_B) @@ -12802,6 +13320,18 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) end do deallocate(ModuleMapTypeData%BD_L_2_BD_L) end if + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%AD_P_2_ED_P_N, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%AD_P_2_ED_P_TF, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ModuleMapTypeData%ED_P_2_AD_P_R)) then LB(1:1) = lbound(ModuleMapTypeData%ED_P_2_AD_P_R) UB(1:1) = ubound(ModuleMapTypeData%ED_P_2_AD_P_R) @@ -12811,6 +13341,14 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) end do deallocate(ModuleMapTypeData%ED_P_2_AD_P_R) end if + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%AD_P_2_ED_P_H, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%IceF_P_2_SD_P, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SDy3_P_2_IceF_P, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ModuleMapTypeData%IceD_P_2_SD_P)) then LB(1:1) = lbound(ModuleMapTypeData%IceD_P_2_SD_P) UB(1:1) = ubound(ModuleMapTypeData%IceD_P_2_SD_P) @@ -12838,6 +13376,20 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) if (allocated(ModuleMapTypeData%Jac_u_indx)) then deallocate(ModuleMapTypeData%Jac_u_indx) end if + call MeshDestroy( ModuleMapTypeData%u_ED_NacelleLoads, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( ModuleMapTypeData%SubstructureLoads_Tmp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( ModuleMapTypeData%SubstructureLoads_Tmp2, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( ModuleMapTypeData%PlatformLoads_Tmp, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( ModuleMapTypeData%PlatformLoads_Tmp2, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( ModuleMapTypeData%SubstructureLoads_Tmp_Farm, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( ModuleMapTypeData%u_ED_TowerPtloads, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ModuleMapTypeData%u_ED_BladePtLoads)) then LB(1:1) = lbound(ModuleMapTypeData%u_ED_BladePtLoads) UB(1:1) = ubound(ModuleMapTypeData%u_ED_BladePtLoads) @@ -12847,6 +13399,16 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) end do deallocate(ModuleMapTypeData%u_ED_BladePtLoads) end if + call MeshDestroy( ModuleMapTypeData%u_SD_TPMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( ModuleMapTypeData%u_HD_M_Mesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( ModuleMapTypeData%u_HD_W_Mesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( ModuleMapTypeData%u_ED_HubPtLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( ModuleMapTypeData%u_ED_HubPtLoad_2, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ModuleMapTypeData%u_BD_RootMotion)) then LB(1:1) = lbound(ModuleMapTypeData%u_BD_RootMotion) UB(1:1) = ubound(ModuleMapTypeData%u_BD_RootMotion) @@ -12874,6 +13436,10 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) end do deallocate(ModuleMapTypeData%u_BD_Distrload) end if + call MeshDestroy( ModuleMapTypeData%u_Orca_PtfmMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( ModuleMapTypeData%u_ExtPtfm_PtfmMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine FAST_PackModuleMapType(Buf, Indata) @@ -13702,6 +14268,10 @@ subroutine FAST_DestroyMisc(MiscData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' + call FAST_DestroyExternInputType(MiscData%ExternInput, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyMiscLinType(MiscData%Lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine FAST_PackMisc(Buf, Indata) @@ -13893,6 +14463,12 @@ subroutine FAST_DestroyInitData(InitDataData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroyInitData' ErrStat = ErrID_None ErrMsg = '' + call ED_DestroyInitInput(InitDataData%InData_ED, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ED_DestroyInitOutput(InitDataData%OutData_ED, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call BD_DestroyInitInput(InitDataData%InData_BD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InitDataData%OutData_BD)) then LB(1:1) = lbound(InitDataData%OutData_BD) UB(1:1) = ubound(InitDataData%OutData_BD) @@ -13902,6 +14478,66 @@ subroutine FAST_DestroyInitData(InitDataData, ErrStat, ErrMsg) end do deallocate(InitDataData%OutData_BD) end if + call SrvD_DestroyInitInput(InitDataData%InData_SrvD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SrvD_DestroyInitOutput(InitDataData%OutData_SrvD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyInitInput(InitDataData%InData_AD14, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD14_DestroyInitOutput(InitDataData%OutData_AD14, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD_DestroyInitInput(InitDataData%InData_AD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD_DestroyInitOutput(InitDataData%OutData_AD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyInitInput(InitDataData%InData_IfW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_DestroyInitOutput(InitDataData%OutData_IfW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call OpFM_DestroyInitInput(InitDataData%InData_OpFM, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call OpFM_DestroyInitOutput(InitDataData%OutData_OpFM, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyInitInput(InitDataData%InData_SeaSt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyInitOutput(InitDataData%OutData_SeaSt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call HydroDyn_DestroyInitInput(InitDataData%InData_HD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call HydroDyn_DestroyInitOutput(InitDataData%OutData_HD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SD_DestroyInitInput(InitDataData%InData_SD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SD_DestroyInitOutput(InitDataData%OutData_SD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ExtPtfm_DestroyInitInput(InitDataData%InData_ExtPtfm, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ExtPtfm_DestroyInitOutput(InitDataData%OutData_ExtPtfm, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MAP_DestroyInitInput(InitDataData%InData_MAP, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MAP_DestroyInitOutput(InitDataData%OutData_MAP, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FEAM_DestroyInitInput(InitDataData%InData_FEAM, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FEAM_DestroyInitOutput(InitDataData%OutData_FEAM, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_DestroyInitInput(InitDataData%InData_MD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MD_DestroyInitOutput(InitDataData%OutData_MD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Orca_DestroyInitInput(InitDataData%InData_Orca, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Orca_DestroyInitOutput(InitDataData%OutData_Orca, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IceFloe_DestroyInitInput(InitDataData%InData_IceF, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IceFloe_DestroyInitOutput(InitDataData%OutData_IceF, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IceD_DestroyInitInput(InitDataData%InData_IceD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call IceD_DestroyInitOutput(InitDataData%OutData_IceD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine FAST_PackInitData(Buf, Indata) @@ -14321,6 +14957,50 @@ subroutine FAST_DestroyTurbineType(TurbineTypeData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'FAST_DestroyTurbineType' ErrStat = ErrID_None ErrMsg = '' + call FAST_DestroyParam(TurbineTypeData%p_FAST, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyOutputFileType(TurbineTypeData%y_FAST, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyMisc(TurbineTypeData%m_FAST, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyModuleMapType(TurbineTypeData%MeshMapData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyElastoDyn_Data(TurbineTypeData%ED, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyBeamDyn_Data(TurbineTypeData%BD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyServoDyn_Data(TurbineTypeData%SrvD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyAeroDyn_Data(TurbineTypeData%AD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyAeroDyn14_Data(TurbineTypeData%AD14, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyInflowWind_Data(TurbineTypeData%IfW, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyOpenFOAM_Data(TurbineTypeData%OpFM, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroySCDataEx_Data(TurbineTypeData%SC_DX, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroySeaState_Data(TurbineTypeData%SeaSt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyHydroDyn_Data(TurbineTypeData%HD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroySubDyn_Data(TurbineTypeData%SD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyMAP_Data(TurbineTypeData%MAP, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyFEAMooring_Data(TurbineTypeData%FEAM, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyMoorDyn_Data(TurbineTypeData%MD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyOrcaFlex_Data(TurbineTypeData%Orca, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyIceFloe_Data(TurbineTypeData%IceF, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyIceDyn_Data(TurbineTypeData%IceD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroyExtPtfm_Data(TurbineTypeData%ExtPtfm, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine FAST_PackTurbineType(Buf, Indata) diff --git a/modules/openfast-registry/src/registry_gen_fortran.cpp b/modules/openfast-registry/src/registry_gen_fortran.cpp index f6318f04a5..5e84e7ebc4 100644 --- a/modules/openfast-registry/src/registry_gen_fortran.cpp +++ b/modules/openfast-registry/src/registry_gen_fortran.cpp @@ -492,10 +492,6 @@ void gen_destroy(std::ostream &w, const Module &mod, const DataType::Derived &dd auto var = ddt_data + "%" + field.name; std::string alloc_assoc = field.is_pointer ? "associated" : "allocated"; - // If field is not allocatable, skip it - if (!field.is_allocatable) - continue; - // w << indent << "! " << field.name; // If non-target pointer field, just nullify pointer diff --git a/modules/openfoam/src/OpenFOAM_Types.f90 b/modules/openfoam/src/OpenFOAM_Types.f90 index 17ced255af..67a12ebb63 100644 --- a/modules/openfoam/src/OpenFOAM_Types.f90 +++ b/modules/openfoam/src/OpenFOAM_Types.f90 @@ -550,6 +550,8 @@ subroutine OpFM_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) if (allocated(InitOutputData%WriteOutputUnt)) then deallocate(InitOutputData%WriteOutputUnt) end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine OpFM_PackInitOutput(Buf, Indata) diff --git a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 index 9af8034551..d9604e243e 100644 --- a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 +++ b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 @@ -209,6 +209,8 @@ subroutine Orca_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'Orca_DestroyInitOutput' ErrStat = ErrID_None ErrMsg = '' + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InitOutputData%WriteOutputHdr)) then deallocate(InitOutputData%WriteOutputHdr) end if @@ -510,6 +512,8 @@ subroutine Orca_DestroyParam(ParamData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'Orca_DestroyParam' ErrStat = ErrID_None ErrMsg = '' + call FreeDynamicLib( ParamData%DLL_Orca, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ParamData%OutParam)) then LB(1:1) = lbound(ParamData%OutParam) UB(1:1) = ubound(ParamData%OutParam) @@ -605,6 +609,8 @@ subroutine Orca_DestroyInput(InputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'Orca_DestroyInput' ErrStat = ErrID_None ErrMsg = '' + call MeshDestroy( InputData%PtfmMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine Orca_PackInput(Buf, Indata) @@ -664,6 +670,8 @@ subroutine Orca_DestroyOutput(OutputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'Orca_DestroyOutput' ErrStat = ErrID_None ErrMsg = '' + call MeshDestroy( OutputData%PtfmMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(OutputData%WriteOutput)) then deallocate(OutputData%WriteOutput) end if diff --git a/modules/seastate/src/SeaSt_WaveField_Types.f90 b/modules/seastate/src/SeaSt_WaveField_Types.f90 index 17f37ca526..fb21696029 100644 --- a/modules/seastate/src/SeaSt_WaveField_Types.f90 +++ b/modules/seastate/src/SeaSt_WaveField_Types.f90 @@ -334,6 +334,8 @@ subroutine SeaSt_WaveField_DestroySeaSt_WaveFieldType(SeaSt_WaveFieldTypeData, E if (allocated(SeaSt_WaveFieldTypeData%WaveElev2)) then deallocate(SeaSt_WaveFieldTypeData%WaveElev2) end if + call SeaSt_Interp_DestroyParam(SeaSt_WaveFieldTypeData%SeaSt_Interp_p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(SeaSt_WaveFieldTypeData%WaveElevC)) then deallocate(SeaSt_WaveFieldTypeData%WaveElevC) end if diff --git a/modules/seastate/src/SeaState_Interp_Types.f90 b/modules/seastate/src/SeaState_Interp_Types.f90 index 5d927ac472..b2189b5bae 100644 --- a/modules/seastate/src/SeaState_Interp_Types.f90 +++ b/modules/seastate/src/SeaState_Interp_Types.f90 @@ -141,6 +141,8 @@ subroutine SeaSt_Interp_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'SeaSt_Interp_DestroyInitOutput' ErrStat = ErrID_None ErrMsg = '' + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine SeaSt_Interp_PackInitOutput(Buf, Indata) diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index f0d60c62b6..acac04923f 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -354,6 +354,12 @@ subroutine SeaSt_DestroyInputFile(InputFileData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'SeaSt_DestroyInputFile' ErrStat = ErrID_None ErrMsg = '' + call Waves_DestroyInitInput(InputFileData%Waves, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Waves2_DestroyInitInput(InputFileData%Waves2, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Current_DestroyInitInput(InputFileData%Current, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InputFileData%WaveElevxi)) then deallocate(InputFileData%WaveElevxi) end if @@ -617,6 +623,8 @@ subroutine SeaSt_DestroyInitInput(InitInputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'SeaSt_DestroyInitInput' ErrStat = ErrID_None ErrMsg = '' + call NWTC_Library_DestroyFileInfoType(InitInputData%PassedFileData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InitInputData%WaveElevXY)) then deallocate(InitInputData%WaveElevXY) end if @@ -818,6 +826,8 @@ subroutine SeaSt_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) if (allocated(InitOutputData%WriteOutputUnt)) then deallocate(InitOutputData%WriteOutputUnt) end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) nullify(InitOutputData%WaveElevC0) nullify(InitOutputData%WaveElevC) nullify(InitOutputData%WaveDirArr) @@ -833,6 +843,8 @@ subroutine SeaSt_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) nullify(InitOutputData%WaveElev2) nullify(InitOutputData%WaveElev0) nullify(InitOutputData%WaveTime) + call SeaSt_Interp_DestroyParam(InitOutputData%SeaSt_Interp_p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InitOutputData%WaveElevSeries)) then deallocate(InitOutputData%WaveElevSeries) end if @@ -1678,6 +1690,8 @@ subroutine SeaSt_DestroyMisc(MiscData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'SeaSt_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' + call SeaSt_Interp_DestroyMisc(MiscData%SeaSt_Interp_m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine SeaSt_PackMisc(Buf, Indata) @@ -1874,6 +1888,8 @@ subroutine SeaSt_DestroyParam(ParamData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'SeaSt_DestroyParam' ErrStat = ErrID_None ErrMsg = '' + call Waves2_DestroyParam(ParamData%Waves2, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) nullify(ParamData%WaveTime) if (allocated(ParamData%WaveElevxi)) then deallocate(ParamData%WaveElevxi) @@ -1911,6 +1927,8 @@ subroutine SeaSt_DestroyParam(ParamData, ErrStat, ErrMsg) end do deallocate(ParamData%OutParam) end if + call SeaSt_Interp_DestroyParam(ParamData%SeaSt_Interp_p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (associated(ParamData%WaveField)) then call SeaSt_WaveField_DestroySeaSt_WaveFieldType(ParamData%WaveField, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) diff --git a/modules/seastate/src/Waves_Types.f90 b/modules/seastate/src/Waves_Types.f90 index 52cc2839aa..3a7d52e00b 100644 --- a/modules/seastate/src/Waves_Types.f90 +++ b/modules/seastate/src/Waves_Types.f90 @@ -262,6 +262,8 @@ subroutine Waves_DestroyInitInput(InitInputData, ErrStat, ErrMsg) if (allocated(InitInputData%CurrVyi)) then deallocate(InitInputData%CurrVyi) end if + call NWTC_Library_DestroyNWTC_RandomNumber_ParameterType(InitInputData%RNG, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine Waves_PackInitInput(Buf, Indata) diff --git a/modules/servodyn/src/ServoDyn_Types.f90 b/modules/servodyn/src/ServoDyn_Types.f90 index d29061831d..8fe7095f2e 100644 --- a/modules/servodyn/src/ServoDyn_Types.f90 +++ b/modules/servodyn/src/ServoDyn_Types.f90 @@ -821,6 +821,8 @@ subroutine SrvD_DestroyInitInput(InitInputData, ErrStat, ErrMsg) if (allocated(InitInputData%BladeRootRefOrient)) then deallocate(InitInputData%BladeRootRefOrient) end if + call NWTC_Library_DestroyFileInfoType(InitInputData%PassedPrimaryInputData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InitInputData%CableControlRequestor)) then deallocate(InitInputData%CableControlRequestor) end if @@ -1368,6 +1370,8 @@ subroutine SrvD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) if (allocated(InitOutputData%WriteOutputUnt)) then deallocate(InitOutputData%WriteOutputUnt) end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InitOutputData%LinNames_y)) then deallocate(InitOutputData%LinNames_y) end if @@ -5477,6 +5481,8 @@ subroutine SrvD_DestroyMisc(MiscData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'SrvD_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' + call SrvD_DestroyBladedDLLType(MiscData%dll_data, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MiscData%xd_BlPitchFilter)) then deallocate(MiscData%xd_BlPitchFilter) end if @@ -5596,6 +5602,8 @@ subroutine SrvD_DestroyMisc(MiscData, ErrStat, ErrMsg) end do deallocate(MiscData%y_SStC) end if + call SrvD_DestroyModuleMapType(MiscData%SrvD_MeshMap, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine SrvD_PackMisc(Buf, Indata) @@ -6502,6 +6510,8 @@ subroutine SrvD_DestroyParam(ParamData, ErrStat, ErrMsg) end do deallocate(ParamData%OutParam) end if + call FreeDynamicLib( ParamData%DLL_Trgt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ParamData%BStC)) then LB(1:1) = lbound(ParamData%BStC) UB(1:1) = ubound(ParamData%BStC) @@ -7766,6 +7776,8 @@ subroutine SrvD_DestroyInput(InputData, ErrStat, ErrMsg) if (allocated(InputData%Lidar)) then deallocate(InputData%Lidar) end if + call MeshDestroy( InputData%PtfmMotionMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InputData%BStCMotionMesh)) then LB(1:2) = lbound(InputData%BStCMotionMesh) UB(1:2) = ubound(InputData%BStCMotionMesh) diff --git a/modules/servodyn/src/StrucCtrl_Types.f90 b/modules/servodyn/src/StrucCtrl_Types.f90 index beb9d8f8fe..84dca770ea 100644 --- a/modules/servodyn/src/StrucCtrl_Types.f90 +++ b/modules/servodyn/src/StrucCtrl_Types.f90 @@ -753,6 +753,10 @@ subroutine StC_DestroyInitInput(InitInputData, ErrStat, ErrMsg) if (allocated(InitInputData%InitRefOrient)) then deallocate(InitInputData%InitRefOrient) end if + call NWTC_Library_DestroyFileInfoType(InitInputData%PassedPrimaryInputData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyFileInfoType(InitInputData%PassedPrescribeFrcData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine StC_PackInitInput(Buf, Indata) diff --git a/modules/subdyn/src/SubDyn_Types.f90 b/modules/subdyn/src/SubDyn_Types.f90 index f4ff433473..f4550aba01 100644 --- a/modules/subdyn/src/SubDyn_Types.f90 +++ b/modules/subdyn/src/SubDyn_Types.f90 @@ -1120,6 +1120,8 @@ subroutine SD_DestroyInitInput(InitInputData, ErrStat, ErrMsg) if (allocated(InitInputData%SoilStiffness)) then deallocate(InitInputData%SoilStiffness) end if + call MeshDestroy( InitInputData%SoilMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine SD_PackInitInput(Buf, Indata) @@ -1368,6 +1370,8 @@ subroutine SD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) if (allocated(InitOutputData%WriteOutputUnt)) then deallocate(InitOutputData%WriteOutputUnt) end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InitOutputData%LinNames_y)) then deallocate(InitOutputData%LinNames_y) end if @@ -6417,6 +6421,10 @@ subroutine SD_DestroyInput(InputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'SD_DestroyInput' ErrStat = ErrID_None ErrMsg = '' + call MeshDestroy( InputData%TPMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( InputData%LMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InputData%CableDeltaL)) then deallocate(InputData%CableDeltaL) end if @@ -6509,6 +6517,12 @@ subroutine SD_DestroyOutput(OutputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'SD_DestroyOutput' ErrStat = ErrID_None ErrMsg = '' + call MeshDestroy( OutputData%Y1Mesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( OutputData%Y2Mesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( OutputData%Y3Mesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(OutputData%WriteOutput)) then deallocate(OutputData%WriteOutput) end if diff --git a/modules/supercontroller/src/SCDataEx_Types.f90 b/modules/supercontroller/src/SCDataEx_Types.f90 index fd404597b7..3f9d7b7ac4 100644 --- a/modules/supercontroller/src/SCDataEx_Types.f90 +++ b/modules/supercontroller/src/SCDataEx_Types.f90 @@ -215,6 +215,8 @@ subroutine SC_DX_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'SC_DX_DestroyInitOutput' ErrStat = ErrID_None ErrMsg = '' + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine SC_DX_PackInitOutput(Buf, Indata) diff --git a/modules/supercontroller/src/SuperController_Types.f90 b/modules/supercontroller/src/SuperController_Types.f90 index 8547edcc29..49a8e234c1 100644 --- a/modules/supercontroller/src/SuperController_Types.f90 +++ b/modules/supercontroller/src/SuperController_Types.f90 @@ -303,6 +303,8 @@ subroutine SC_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'SC_DestroyInitOutput' ErrStat = ErrID_None ErrMsg = '' + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine SC_PackInitOutput(Buf, Indata) @@ -476,6 +478,8 @@ subroutine SC_DestroyParam(ParamData, ErrStat, ErrMsg) ParamData%C_obj%ParamTurbine = c_null_ptr ParamData%C_obj%ParamTurbine_Len = 0 end if + call FreeDynamicLib( ParamData%DLL_Trgt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine SC_PackParam(Buf, Indata) diff --git a/modules/wakedynamics/src/WakeDynamics_Types.f90 b/modules/wakedynamics/src/WakeDynamics_Types.f90 index 4a3d8d93ae..12bf28779b 100644 --- a/modules/wakedynamics/src/WakeDynamics_Types.f90 +++ b/modules/wakedynamics/src/WakeDynamics_Types.f90 @@ -420,6 +420,8 @@ subroutine WD_DestroyInitInput(InitInputData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'WD_DestroyInitInput' ErrStat = ErrID_None ErrMsg = '' + call WD_DestroyInputFileType(InitInputData%InputFileData, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine WD_PackInitInput(Buf, Indata) @@ -505,6 +507,8 @@ subroutine WD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) if (allocated(InitOutputData%WriteOutputUnt)) then deallocate(InitOutputData%WriteOutputUnt) end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine WD_PackInitOutput(Buf, Indata) From 9e141549b1ee804305336e5c933dce0167c40414 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 15 Jun 2023 15:24:29 -0400 Subject: [PATCH 10/15] Updated Visual Studio files for new Registry --- modules/hydrodyn/src/Waves2_Types.f90 | 3841 ----------------- modules/hydrodyn/src/Waves_Types.f90 | 3586 --------------- modules/inflowwind/src/IfW_FlowField.f90 | 4 - modules/nwtc-library/ModRegGen.py | 2 +- modules/nwtc-library/src/ModReg.f90 | 4 +- modules/openfast-registry/src/registry.hpp | 4 +- vs-build/AeroDyn/AeroDyn_Driver.vfproj | 306 +- .../AeroDyn_Inflow_c_binding.vfproj | 109 +- vs-build/BeamDyn/BeamDyn.vfproj | 106 +- vs-build/FASTlib/FASTlib.vfproj | 1095 ++--- vs-build/HydroDyn/HydroDynDriver.vfproj | 237 +- .../HydroDyn_c_binding.vfproj | 178 +- vs-build/InflowWind/InflowWind_driver.vfproj | 76 +- .../InflowWind_c_binding.vfproj | 76 +- vs-build/MAPlib/MAP_dll.vcxproj | 10 +- vs-build/MoorDyn/MoorDynDriver.vfproj | 24 +- .../MoorDyn_c_binding.vfproj | 26 +- vs-build/Registry/FAST_Registry.vcxproj | 2 +- vs-build/RunRegistry.bat | 9 +- vs-build/SeaState/SeaStateDriver.vfproj | 36 +- vs-build/SubDyn/SubDyn.vfproj | 74 +- vs-build/TurbSim/TurbSim.vfproj | 1 + vs-build/UnsteadyAero/UnsteadyAero.vfproj | 108 +- 23 files changed, 1358 insertions(+), 8556 deletions(-) delete mode 100644 modules/hydrodyn/src/Waves2_Types.f90 delete mode 100644 modules/hydrodyn/src/Waves_Types.f90 diff --git a/modules/hydrodyn/src/Waves2_Types.f90 b/modules/hydrodyn/src/Waves2_Types.f90 deleted file mode 100644 index 1a50ae31dd..0000000000 --- a/modules/hydrodyn/src/Waves2_Types.f90 +++ /dev/null @@ -1,3841 +0,0 @@ -!STARTOFREGISTRYGENERATEDFILE 'Waves2_Types.f90' -! -! WARNING This file is generated automatically by the FAST registry. -! Do not edit. Your changes to this file will be lost. -! -! FAST Registry -!********************************************************************************************************************************* -! Waves2_Types -!................................................................................................................................. -! This file is part of Waves2. -! -! Copyright (C) 2012-2016 National Renewable Energy Laboratory -! -! Licensed under the Apache License, Version 2.0 (the "License"); -! you may not use this file except in compliance with the License. -! You may obtain a copy of the License at -! -! http://www.apache.org/licenses/LICENSE-2.0 -! -! Unless required by applicable law or agreed to in writing, software -! distributed under the License is distributed on an "AS IS" BASIS, -! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -! See the License for the specific language governing permissions and -! limitations under the License. -! -! -! W A R N I N G : This file was automatically generated from the FAST registry. Changes made to this file may be lost. -! -!********************************************************************************************************************************* -!> This module contains the user-defined types needed in Waves2. It also contains copy, destroy, pack, and -!! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. -MODULE Waves2_Types -!--------------------------------------------------------------------------------------------------------------------------------- -USE NWTC_Library -IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: MaxWaves2Outputs = 9 ! [-] -! ========= Waves2_InitInputType ======= - TYPE, PUBLIC :: Waves2_InitInputType - INTEGER(IntKi) :: UnSum !< The unit number for the HydroDyn summary file [-] - REAL(ReKi) :: Gravity !< Gravitational acceleration [(m/s^2)] - REAL(ReKi) :: WtrDens !< Water density [(kg/m^3)] - REAL(SiKi) :: WtrDpth !< Water depth [(meters)] - INTEGER(IntKi) :: NStepWave !< Total number of frequency components = total number of time steps in the incident wave [-] - INTEGER(IntKi) :: NStepWave2 !< NStepWave / 2 [-] - REAL(SiKi) :: WaveDOmega !< Frequency step for incident wave calculations [(rad/s)] - INTEGER(IntKi) :: WaveStMod !< Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching} [-] - LOGICAL :: WaveMultiDir !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveDirArr !< Wave direction array. Each frequency has a unique direction of WaveNDir > 1 [(degrees)] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevC0 !< Discrete Fourier transform of the instantaneous elevation of incident waves at the platform reference point. First column is real part, second column is imaginary part [(meters)] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveTime !< Simulation times at which the instantaneous second order loads associated with the incident waves are determined [sec] - INTEGER(IntKi) :: NWaveElev !< Number of points where the incident wave elevations can be output [-] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevxi !< xi-coordinates for points where the incident wave elevations can be output [(meters)] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevyi !< yi-coordinates for points where the incident wave elevations can be output [(meters)] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevXY !< Supplied by Driver: X-Y locations for WaveElevation output (for visualization). Index 1 corresponds to X or Y coordinate. Index 2 corresponds to point number. [-] - INTEGER(IntKi) :: NWaveKin !< Number of points where the incident wave kinematics will be computed [-] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinxi !< xi-coordinates for points where the incident wave kinematics will be computed; these are relative to the mean sea level [(meters)] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinyi !< yi-coordinates for points where the incident wave kinematics will be computed; these are relative to the mean sea level [(meters)] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinzi !< zi-coordinates for points where the incident wave kinematics will be computed; these are relative to the mean sea level [(meters)] - LOGICAL :: WvDiffQTFF !< Full difference QTF second order forces flag [(-)] - LOGICAL :: WvSumQTFF !< Full sum QTF second order forces flag [(-)] - REAL(SiKi) :: WvLowCOffD !< Minimum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] - REAL(SiKi) :: WvHiCOffD !< Maximum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] - REAL(SiKi) :: WvLowCOffS !< Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] - REAL(SiKi) :: WvHiCOffS !< Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] - CHARACTER(ChanLen) , DIMENSION(1:18) :: OutList !< This should really be dimensioned with MaxOutPts [-] - LOGICAL :: OutAll !< [-] - INTEGER(IntKi) :: NumOuts !< [-] - INTEGER(IntKi) :: NumOutAll !< [-] - END TYPE Waves2_InitInputType -! ======================= -! ========= Waves2_InitOutputType ======= - TYPE, PUBLIC :: Waves2_InitOutputType - CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< [-] - CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< [-] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevSeries2 !< [(m)] - REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveAcc2D !< [(m/s^2)] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveDynP2D !< [(N/m^2)] - REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveAcc2S !< [(m/s^2)] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveDynP2S !< [(N/m^2)] - REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveVel2D !< [(m/s)] - REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveVel2S !< [(m/s)] - REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveAcc2D0 !< [(m/s^2)] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveDynP2D0 !< [(N/m^2)] - REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveAcc2S0 !< [(m/s^2)] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveDynP2S0 !< [(N/m^2)] - REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveVel2D0 !< [(m/s)] - REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveVel2S0 !< [(m/s)] - END TYPE Waves2_InitOutputType -! ======================= -! ========= Waves2_ContinuousStateType ======= - TYPE, PUBLIC :: Waves2_ContinuousStateType - REAL(SiKi) :: DummyContState !< Remove this variable if you have continuous states [-] - END TYPE Waves2_ContinuousStateType -! ======================= -! ========= Waves2_DiscreteStateType ======= - TYPE, PUBLIC :: Waves2_DiscreteStateType - REAL(SiKi) :: DummyDiscState !< Remove this variable if you have discrete states [-] - END TYPE Waves2_DiscreteStateType -! ======================= -! ========= Waves2_ConstraintStateType ======= - TYPE, PUBLIC :: Waves2_ConstraintStateType - REAL(SiKi) :: DummyConstrState !< Remove this variable if you have constraint states [-] - END TYPE Waves2_ConstraintStateType -! ======================= -! ========= Waves2_OtherStateType ======= - TYPE, PUBLIC :: Waves2_OtherStateType - INTEGER(IntKi) :: DummyOtherState !< Remove this variable if you have other states [-] - END TYPE Waves2_OtherStateType -! ======================= -! ========= Waves2_MiscVarType ======= - TYPE, PUBLIC :: Waves2_MiscVarType - INTEGER(IntKi) :: LastIndWave !< Index for last interpolation step of 2nd order forces [-] - END TYPE Waves2_MiscVarType -! ======================= -! ========= Waves2_ParameterType ======= - TYPE, PUBLIC :: Waves2_ParameterType - REAL(DbKi) :: DT !< Time step for continuous state integration & discrete state update [seconds] - LOGICAL :: WvDiffQTFF !< Full difference QTF second order forces flag [(-)] - LOGICAL :: WvSumQTFF !< Full sum QTF second order forces flag [(-)] - INTEGER(IntKi) :: NWaveElev !< Number of points where the incident wave elevations can be output [-] - INTEGER(IntKi) :: NStepWave !< Total number of frequency components = total number of time steps in the incident wave [-] - INTEGER(IntKi) :: NStepWave2 !< NStepWave / 2 [-] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveTime !< Simulation times at which the instantaneous second order loads associated with the incident waves are determined [sec] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElev2 !< Instantaneous elevation time-series of incident waves at each of the NWaveElev points where the incident wave elevations can be output [(meters)] - TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< [-] - INTEGER(IntKi) :: NumOuts !< [-] - INTEGER(IntKi) :: NumOutAll !< [-] - CHARACTER(20) :: OutFmt !< [-] - CHARACTER(20) :: OutSFmt !< [-] - CHARACTER(ChanLen) :: Delim !< [-] - INTEGER(IntKi) :: UnOutFile !< [-] - END TYPE Waves2_ParameterType -! ======================= -! ========= Waves2_InputType ======= - TYPE, PUBLIC :: Waves2_InputType - REAL(SiKi) :: DummyInput !< Remove this variable if you have input data [-] - END TYPE Waves2_InputType -! ======================= -! ========= Waves2_OutputType ======= - TYPE, PUBLIC :: Waves2_OutputType - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< [-] - END TYPE Waves2_OutputType -! ======================= -CONTAINS - SUBROUTINE Waves2_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Waves2_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(Waves2_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%UnSum = SrcInitInputData%UnSum - DstInitInputData%Gravity = SrcInitInputData%Gravity - DstInitInputData%WtrDens = SrcInitInputData%WtrDens - DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth - DstInitInputData%NStepWave = SrcInitInputData%NStepWave - DstInitInputData%NStepWave2 = SrcInitInputData%NStepWave2 - DstInitInputData%WaveDOmega = SrcInitInputData%WaveDOmega - DstInitInputData%WaveStMod = SrcInitInputData%WaveStMod - DstInitInputData%WaveMultiDir = SrcInitInputData%WaveMultiDir -IF (ALLOCATED(SrcInitInputData%WaveDirArr)) THEN - i1_l = LBOUND(SrcInitInputData%WaveDirArr,1) - i1_u = UBOUND(SrcInitInputData%WaveDirArr,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveDirArr)) THEN - ALLOCATE(DstInitInputData%WaveDirArr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveDirArr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveDirArr = SrcInitInputData%WaveDirArr -ENDIF -IF (ALLOCATED(SrcInitInputData%WaveElevC0)) THEN - i1_l = LBOUND(SrcInitInputData%WaveElevC0,1) - i1_u = UBOUND(SrcInitInputData%WaveElevC0,1) - i2_l = LBOUND(SrcInitInputData%WaveElevC0,2) - i2_u = UBOUND(SrcInitInputData%WaveElevC0,2) - IF (.NOT. ALLOCATED(DstInitInputData%WaveElevC0)) THEN - ALLOCATE(DstInitInputData%WaveElevC0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElevC0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveElevC0 = SrcInitInputData%WaveElevC0 -ENDIF -IF (ALLOCATED(SrcInitInputData%WaveTime)) THEN - i1_l = LBOUND(SrcInitInputData%WaveTime,1) - i1_u = UBOUND(SrcInitInputData%WaveTime,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveTime)) THEN - ALLOCATE(DstInitInputData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveTime = SrcInitInputData%WaveTime -ENDIF - DstInitInputData%NWaveElev = SrcInitInputData%NWaveElev -IF (ALLOCATED(SrcInitInputData%WaveElevxi)) THEN - i1_l = LBOUND(SrcInitInputData%WaveElevxi,1) - i1_u = UBOUND(SrcInitInputData%WaveElevxi,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveElevxi)) THEN - ALLOCATE(DstInitInputData%WaveElevxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElevxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveElevxi = SrcInitInputData%WaveElevxi -ENDIF -IF (ALLOCATED(SrcInitInputData%WaveElevyi)) THEN - i1_l = LBOUND(SrcInitInputData%WaveElevyi,1) - i1_u = UBOUND(SrcInitInputData%WaveElevyi,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveElevyi)) THEN - ALLOCATE(DstInitInputData%WaveElevyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElevyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveElevyi = SrcInitInputData%WaveElevyi -ENDIF -IF (ALLOCATED(SrcInitInputData%WaveElevXY)) THEN - i1_l = LBOUND(SrcInitInputData%WaveElevXY,1) - i1_u = UBOUND(SrcInitInputData%WaveElevXY,1) - i2_l = LBOUND(SrcInitInputData%WaveElevXY,2) - i2_u = UBOUND(SrcInitInputData%WaveElevXY,2) - IF (.NOT. ALLOCATED(DstInitInputData%WaveElevXY)) THEN - ALLOCATE(DstInitInputData%WaveElevXY(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElevXY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveElevXY = SrcInitInputData%WaveElevXY -ENDIF - DstInitInputData%NWaveKin = SrcInitInputData%NWaveKin -IF (ALLOCATED(SrcInitInputData%WaveKinxi)) THEN - i1_l = LBOUND(SrcInitInputData%WaveKinxi,1) - i1_u = UBOUND(SrcInitInputData%WaveKinxi,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveKinxi)) THEN - ALLOCATE(DstInitInputData%WaveKinxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveKinxi = SrcInitInputData%WaveKinxi -ENDIF -IF (ALLOCATED(SrcInitInputData%WaveKinyi)) THEN - i1_l = LBOUND(SrcInitInputData%WaveKinyi,1) - i1_u = UBOUND(SrcInitInputData%WaveKinyi,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveKinyi)) THEN - ALLOCATE(DstInitInputData%WaveKinyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveKinyi = SrcInitInputData%WaveKinyi -ENDIF -IF (ALLOCATED(SrcInitInputData%WaveKinzi)) THEN - i1_l = LBOUND(SrcInitInputData%WaveKinzi,1) - i1_u = UBOUND(SrcInitInputData%WaveKinzi,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveKinzi)) THEN - ALLOCATE(DstInitInputData%WaveKinzi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinzi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveKinzi = SrcInitInputData%WaveKinzi -ENDIF - DstInitInputData%WvDiffQTFF = SrcInitInputData%WvDiffQTFF - DstInitInputData%WvSumQTFF = SrcInitInputData%WvSumQTFF - DstInitInputData%WvLowCOffD = SrcInitInputData%WvLowCOffD - DstInitInputData%WvHiCOffD = SrcInitInputData%WvHiCOffD - DstInitInputData%WvLowCOffS = SrcInitInputData%WvLowCOffS - DstInitInputData%WvHiCOffS = SrcInitInputData%WvHiCOffS - DstInitInputData%OutList = SrcInitInputData%OutList - DstInitInputData%OutAll = SrcInitInputData%OutAll - DstInitInputData%NumOuts = SrcInitInputData%NumOuts - DstInitInputData%NumOutAll = SrcInitInputData%NumOutAll - END SUBROUTINE Waves2_CopyInitInput - - SUBROUTINE Waves2_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(Waves2_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitInputData%WaveDirArr)) THEN - DEALLOCATE(InitInputData%WaveDirArr) -ENDIF -IF (ALLOCATED(InitInputData%WaveElevC0)) THEN - DEALLOCATE(InitInputData%WaveElevC0) -ENDIF -IF (ALLOCATED(InitInputData%WaveTime)) THEN - DEALLOCATE(InitInputData%WaveTime) -ENDIF -IF (ALLOCATED(InitInputData%WaveElevxi)) THEN - DEALLOCATE(InitInputData%WaveElevxi) -ENDIF -IF (ALLOCATED(InitInputData%WaveElevyi)) THEN - DEALLOCATE(InitInputData%WaveElevyi) -ENDIF -IF (ALLOCATED(InitInputData%WaveElevXY)) THEN - DEALLOCATE(InitInputData%WaveElevXY) -ENDIF -IF (ALLOCATED(InitInputData%WaveKinxi)) THEN - DEALLOCATE(InitInputData%WaveKinxi) -ENDIF -IF (ALLOCATED(InitInputData%WaveKinyi)) THEN - DEALLOCATE(InitInputData%WaveKinyi) -ENDIF -IF (ALLOCATED(InitInputData%WaveKinzi)) THEN - DEALLOCATE(InitInputData%WaveKinzi) -ENDIF - END SUBROUTINE Waves2_DestroyInitInput - - SUBROUTINE Waves2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Waves2_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! UnSum - Re_BufSz = Re_BufSz + 1 ! Gravity - Re_BufSz = Re_BufSz + 1 ! WtrDens - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Int_BufSz = Int_BufSz + 1 ! NStepWave - Int_BufSz = Int_BufSz + 1 ! NStepWave2 - Re_BufSz = Re_BufSz + 1 ! WaveDOmega - Int_BufSz = Int_BufSz + 1 ! WaveStMod - Int_BufSz = Int_BufSz + 1 ! WaveMultiDir - Int_BufSz = Int_BufSz + 1 ! WaveDirArr allocated yes/no - IF ( ALLOCATED(InData%WaveDirArr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveDirArr upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveDirArr) ! WaveDirArr - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElevC0 allocated yes/no - IF ( ALLOCATED(InData%WaveElevC0) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveElevC0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElevC0) ! WaveElevC0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveTime allocated yes/no - IF ( ALLOCATED(InData%WaveTime) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveTime upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveTime) ! WaveTime - END IF - Int_BufSz = Int_BufSz + 1 ! NWaveElev - Int_BufSz = Int_BufSz + 1 ! WaveElevxi allocated yes/no - IF ( ALLOCATED(InData%WaveElevxi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveElevxi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElevxi) ! WaveElevxi - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElevyi allocated yes/no - IF ( ALLOCATED(InData%WaveElevyi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveElevyi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElevyi) ! WaveElevyi - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElevXY allocated yes/no - IF ( ALLOCATED(InData%WaveElevXY) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveElevXY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElevXY) ! WaveElevXY - END IF - Int_BufSz = Int_BufSz + 1 ! NWaveKin - Int_BufSz = Int_BufSz + 1 ! WaveKinxi allocated yes/no - IF ( ALLOCATED(InData%WaveKinxi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveKinxi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveKinxi) ! WaveKinxi - END IF - Int_BufSz = Int_BufSz + 1 ! WaveKinyi allocated yes/no - IF ( ALLOCATED(InData%WaveKinyi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveKinyi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveKinyi) ! WaveKinyi - END IF - Int_BufSz = Int_BufSz + 1 ! WaveKinzi allocated yes/no - IF ( ALLOCATED(InData%WaveKinzi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveKinzi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveKinzi) ! WaveKinzi - END IF - Int_BufSz = Int_BufSz + 1 ! WvDiffQTFF - Int_BufSz = Int_BufSz + 1 ! WvSumQTFF - Re_BufSz = Re_BufSz + 1 ! WvLowCOffD - Re_BufSz = Re_BufSz + 1 ! WvHiCOffD - Re_BufSz = Re_BufSz + 1 ! WvLowCOffS - Re_BufSz = Re_BufSz + 1 ! WvHiCOffS - Int_BufSz = Int_BufSz + SIZE(InData%OutList)*LEN(InData%OutList) ! OutList - Int_BufSz = Int_BufSz + 1 ! OutAll - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! NumOutAll - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%UnSum - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepWave2 - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDOmega - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveStMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WaveMultiDir, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveDirArr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDirArr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDirArr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveDirArr,1), UBOUND(InData%WaveDirArr,1) - ReKiBuf(Re_Xferred) = InData%WaveDirArr(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveElevC0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC0,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveElevC0,2), UBOUND(InData%WaveElevC0,2) - DO i1 = LBOUND(InData%WaveElevC0,1), UBOUND(InData%WaveElevC0,1) - ReKiBuf(Re_Xferred) = InData%WaveElevC0(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveTime,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) - ReKiBuf(Re_Xferred) = InData%WaveTime(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NWaveElev - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveElevxi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevxi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevxi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveElevxi,1), UBOUND(InData%WaveElevxi,1) - ReKiBuf(Re_Xferred) = InData%WaveElevxi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveElevyi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevyi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevyi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveElevyi,1), UBOUND(InData%WaveElevyi,1) - ReKiBuf(Re_Xferred) = InData%WaveElevyi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveElevXY) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevXY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevXY,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevXY,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevXY,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveElevXY,2), UBOUND(InData%WaveElevXY,2) - DO i1 = LBOUND(InData%WaveElevXY,1), UBOUND(InData%WaveElevXY,1) - ReKiBuf(Re_Xferred) = InData%WaveElevXY(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NWaveKin - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveKinxi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveKinxi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinxi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveKinxi,1), UBOUND(InData%WaveKinxi,1) - ReKiBuf(Re_Xferred) = InData%WaveKinxi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveKinyi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveKinyi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinyi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveKinyi,1), UBOUND(InData%WaveKinyi,1) - ReKiBuf(Re_Xferred) = InData%WaveKinyi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveKinzi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveKinzi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinzi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveKinzi,1), UBOUND(InData%WaveKinzi,1) - ReKiBuf(Re_Xferred) = InData%WaveKinzi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%WvDiffQTFF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WvSumQTFF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WvLowCOffD - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WvHiCOffD - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WvLowCOffS - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WvHiCOffS - Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) - DO I = 1, LEN(InData%OutList) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - IntKiBuf(Int_Xferred) = TRANSFER(InData%OutAll, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOutAll - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Waves2_PackInitInput - - SUBROUTINE Waves2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Waves2_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%UnSum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%NStepWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NStepWave2 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WaveDOmega = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveStMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WaveMultiDir = TRANSFER(IntKiBuf(Int_Xferred), OutData%WaveMultiDir) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDirArr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveDirArr)) DEALLOCATE(OutData%WaveDirArr) - ALLOCATE(OutData%WaveDirArr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveDirArr,1), UBOUND(OutData%WaveDirArr,1) - OutData%WaveDirArr(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevC0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveElevC0)) DEALLOCATE(OutData%WaveElevC0) - ALLOCATE(OutData%WaveElevC0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveElevC0,2), UBOUND(OutData%WaveElevC0,2) - DO i1 = LBOUND(OutData%WaveElevC0,1), UBOUND(OutData%WaveElevC0,1) - OutData%WaveElevC0(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveTime)) DEALLOCATE(OutData%WaveTime) - ALLOCATE(OutData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) - OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%NWaveElev = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevxi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveElevxi)) DEALLOCATE(OutData%WaveElevxi) - ALLOCATE(OutData%WaveElevxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveElevxi,1), UBOUND(OutData%WaveElevxi,1) - OutData%WaveElevxi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevyi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveElevyi)) DEALLOCATE(OutData%WaveElevyi) - ALLOCATE(OutData%WaveElevyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveElevyi,1), UBOUND(OutData%WaveElevyi,1) - OutData%WaveElevyi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevXY not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveElevXY)) DEALLOCATE(OutData%WaveElevXY) - ALLOCATE(OutData%WaveElevXY(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevXY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveElevXY,2), UBOUND(OutData%WaveElevXY,2) - DO i1 = LBOUND(OutData%WaveElevXY,1), UBOUND(OutData%WaveElevXY,1) - OutData%WaveElevXY(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%NWaveKin = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinxi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveKinxi)) DEALLOCATE(OutData%WaveKinxi) - ALLOCATE(OutData%WaveKinxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveKinxi,1), UBOUND(OutData%WaveKinxi,1) - OutData%WaveKinxi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinyi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveKinyi)) DEALLOCATE(OutData%WaveKinyi) - ALLOCATE(OutData%WaveKinyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveKinyi,1), UBOUND(OutData%WaveKinyi,1) - OutData%WaveKinyi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinzi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveKinzi)) DEALLOCATE(OutData%WaveKinzi) - ALLOCATE(OutData%WaveKinzi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinzi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveKinzi,1), UBOUND(OutData%WaveKinzi,1) - OutData%WaveKinzi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%WvDiffQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%WvDiffQTFF) - Int_Xferred = Int_Xferred + 1 - OutData%WvSumQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%WvSumQTFF) - Int_Xferred = Int_Xferred + 1 - OutData%WvLowCOffD = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WvHiCOffD = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WvLowCOffS = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WvHiCOffS = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%OutList,1) - i1_u = UBOUND(OutData%OutList,1) - DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) - DO I = 1, LEN(OutData%OutList) - OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - OutData%OutAll = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutAll) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumOutAll = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Waves2_UnPackInitInput - - SUBROUTINE Waves2_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Waves2_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(Waves2_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_CopyInitOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInitOutputData%WriteOutputHdr)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputHdr,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputHdr,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputHdr)) THEN - ALLOCATE(DstInitOutputData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr -ENDIF -IF (ALLOCATED(SrcInitOutputData%WriteOutputUnt)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputUnt,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputUnt,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputUnt)) THEN - ALLOCATE(DstInitOutputData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveElevSeries2)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveElevSeries2,1) - i1_u = UBOUND(SrcInitOutputData%WaveElevSeries2,1) - i2_l = LBOUND(SrcInitOutputData%WaveElevSeries2,2) - i2_u = UBOUND(SrcInitOutputData%WaveElevSeries2,2) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveElevSeries2)) THEN - ALLOCATE(DstInitOutputData%WaveElevSeries2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveElevSeries2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveElevSeries2 = SrcInitOutputData%WaveElevSeries2 -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveAcc2D)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveAcc2D,1) - i1_u = UBOUND(SrcInitOutputData%WaveAcc2D,1) - i2_l = LBOUND(SrcInitOutputData%WaveAcc2D,2) - i2_u = UBOUND(SrcInitOutputData%WaveAcc2D,2) - i3_l = LBOUND(SrcInitOutputData%WaveAcc2D,3) - i3_u = UBOUND(SrcInitOutputData%WaveAcc2D,3) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveAcc2D)) THEN - ALLOCATE(DstInitOutputData%WaveAcc2D(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveAcc2D.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveAcc2D = SrcInitOutputData%WaveAcc2D -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveDynP2D)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveDynP2D,1) - i1_u = UBOUND(SrcInitOutputData%WaveDynP2D,1) - i2_l = LBOUND(SrcInitOutputData%WaveDynP2D,2) - i2_u = UBOUND(SrcInitOutputData%WaveDynP2D,2) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveDynP2D)) THEN - ALLOCATE(DstInitOutputData%WaveDynP2D(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveDynP2D.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveDynP2D = SrcInitOutputData%WaveDynP2D -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveAcc2S)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveAcc2S,1) - i1_u = UBOUND(SrcInitOutputData%WaveAcc2S,1) - i2_l = LBOUND(SrcInitOutputData%WaveAcc2S,2) - i2_u = UBOUND(SrcInitOutputData%WaveAcc2S,2) - i3_l = LBOUND(SrcInitOutputData%WaveAcc2S,3) - i3_u = UBOUND(SrcInitOutputData%WaveAcc2S,3) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveAcc2S)) THEN - ALLOCATE(DstInitOutputData%WaveAcc2S(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveAcc2S.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveAcc2S = SrcInitOutputData%WaveAcc2S -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveDynP2S)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveDynP2S,1) - i1_u = UBOUND(SrcInitOutputData%WaveDynP2S,1) - i2_l = LBOUND(SrcInitOutputData%WaveDynP2S,2) - i2_u = UBOUND(SrcInitOutputData%WaveDynP2S,2) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveDynP2S)) THEN - ALLOCATE(DstInitOutputData%WaveDynP2S(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveDynP2S.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveDynP2S = SrcInitOutputData%WaveDynP2S -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveVel2D)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveVel2D,1) - i1_u = UBOUND(SrcInitOutputData%WaveVel2D,1) - i2_l = LBOUND(SrcInitOutputData%WaveVel2D,2) - i2_u = UBOUND(SrcInitOutputData%WaveVel2D,2) - i3_l = LBOUND(SrcInitOutputData%WaveVel2D,3) - i3_u = UBOUND(SrcInitOutputData%WaveVel2D,3) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveVel2D)) THEN - ALLOCATE(DstInitOutputData%WaveVel2D(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveVel2D.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveVel2D = SrcInitOutputData%WaveVel2D -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveVel2S)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveVel2S,1) - i1_u = UBOUND(SrcInitOutputData%WaveVel2S,1) - i2_l = LBOUND(SrcInitOutputData%WaveVel2S,2) - i2_u = UBOUND(SrcInitOutputData%WaveVel2S,2) - i3_l = LBOUND(SrcInitOutputData%WaveVel2S,3) - i3_u = UBOUND(SrcInitOutputData%WaveVel2S,3) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveVel2S)) THEN - ALLOCATE(DstInitOutputData%WaveVel2S(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveVel2S.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveVel2S = SrcInitOutputData%WaveVel2S -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveAcc2D0)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveAcc2D0,1) - i1_u = UBOUND(SrcInitOutputData%WaveAcc2D0,1) - i2_l = LBOUND(SrcInitOutputData%WaveAcc2D0,2) - i2_u = UBOUND(SrcInitOutputData%WaveAcc2D0,2) - i3_l = LBOUND(SrcInitOutputData%WaveAcc2D0,3) - i3_u = UBOUND(SrcInitOutputData%WaveAcc2D0,3) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveAcc2D0)) THEN - ALLOCATE(DstInitOutputData%WaveAcc2D0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveAcc2D0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveAcc2D0 = SrcInitOutputData%WaveAcc2D0 -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveDynP2D0)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveDynP2D0,1) - i1_u = UBOUND(SrcInitOutputData%WaveDynP2D0,1) - i2_l = LBOUND(SrcInitOutputData%WaveDynP2D0,2) - i2_u = UBOUND(SrcInitOutputData%WaveDynP2D0,2) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveDynP2D0)) THEN - ALLOCATE(DstInitOutputData%WaveDynP2D0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveDynP2D0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveDynP2D0 = SrcInitOutputData%WaveDynP2D0 -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveAcc2S0)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveAcc2S0,1) - i1_u = UBOUND(SrcInitOutputData%WaveAcc2S0,1) - i2_l = LBOUND(SrcInitOutputData%WaveAcc2S0,2) - i2_u = UBOUND(SrcInitOutputData%WaveAcc2S0,2) - i3_l = LBOUND(SrcInitOutputData%WaveAcc2S0,3) - i3_u = UBOUND(SrcInitOutputData%WaveAcc2S0,3) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveAcc2S0)) THEN - ALLOCATE(DstInitOutputData%WaveAcc2S0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveAcc2S0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveAcc2S0 = SrcInitOutputData%WaveAcc2S0 -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveDynP2S0)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveDynP2S0,1) - i1_u = UBOUND(SrcInitOutputData%WaveDynP2S0,1) - i2_l = LBOUND(SrcInitOutputData%WaveDynP2S0,2) - i2_u = UBOUND(SrcInitOutputData%WaveDynP2S0,2) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveDynP2S0)) THEN - ALLOCATE(DstInitOutputData%WaveDynP2S0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveDynP2S0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveDynP2S0 = SrcInitOutputData%WaveDynP2S0 -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveVel2D0)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveVel2D0,1) - i1_u = UBOUND(SrcInitOutputData%WaveVel2D0,1) - i2_l = LBOUND(SrcInitOutputData%WaveVel2D0,2) - i2_u = UBOUND(SrcInitOutputData%WaveVel2D0,2) - i3_l = LBOUND(SrcInitOutputData%WaveVel2D0,3) - i3_u = UBOUND(SrcInitOutputData%WaveVel2D0,3) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveVel2D0)) THEN - ALLOCATE(DstInitOutputData%WaveVel2D0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveVel2D0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveVel2D0 = SrcInitOutputData%WaveVel2D0 -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveVel2S0)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveVel2S0,1) - i1_u = UBOUND(SrcInitOutputData%WaveVel2S0,1) - i2_l = LBOUND(SrcInitOutputData%WaveVel2S0,2) - i2_u = UBOUND(SrcInitOutputData%WaveVel2S0,2) - i3_l = LBOUND(SrcInitOutputData%WaveVel2S0,3) - i3_u = UBOUND(SrcInitOutputData%WaveVel2S0,3) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveVel2S0)) THEN - ALLOCATE(DstInitOutputData%WaveVel2S0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveVel2S0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveVel2S0 = SrcInitOutputData%WaveVel2S0 -ENDIF - END SUBROUTINE Waves2_CopyInitOutput - - SUBROUTINE Waves2_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(Waves2_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF -IF (ALLOCATED(InitOutputData%WaveElevSeries2)) THEN - DEALLOCATE(InitOutputData%WaveElevSeries2) -ENDIF -IF (ALLOCATED(InitOutputData%WaveAcc2D)) THEN - DEALLOCATE(InitOutputData%WaveAcc2D) -ENDIF -IF (ALLOCATED(InitOutputData%WaveDynP2D)) THEN - DEALLOCATE(InitOutputData%WaveDynP2D) -ENDIF -IF (ALLOCATED(InitOutputData%WaveAcc2S)) THEN - DEALLOCATE(InitOutputData%WaveAcc2S) -ENDIF -IF (ALLOCATED(InitOutputData%WaveDynP2S)) THEN - DEALLOCATE(InitOutputData%WaveDynP2S) -ENDIF -IF (ALLOCATED(InitOutputData%WaveVel2D)) THEN - DEALLOCATE(InitOutputData%WaveVel2D) -ENDIF -IF (ALLOCATED(InitOutputData%WaveVel2S)) THEN - DEALLOCATE(InitOutputData%WaveVel2S) -ENDIF -IF (ALLOCATED(InitOutputData%WaveAcc2D0)) THEN - DEALLOCATE(InitOutputData%WaveAcc2D0) -ENDIF -IF (ALLOCATED(InitOutputData%WaveDynP2D0)) THEN - DEALLOCATE(InitOutputData%WaveDynP2D0) -ENDIF -IF (ALLOCATED(InitOutputData%WaveAcc2S0)) THEN - DEALLOCATE(InitOutputData%WaveAcc2S0) -ENDIF -IF (ALLOCATED(InitOutputData%WaveDynP2S0)) THEN - DEALLOCATE(InitOutputData%WaveDynP2S0) -ENDIF -IF (ALLOCATED(InitOutputData%WaveVel2D0)) THEN - DEALLOCATE(InitOutputData%WaveVel2D0) -ENDIF -IF (ALLOCATED(InitOutputData%WaveVel2S0)) THEN - DEALLOCATE(InitOutputData%WaveVel2S0) -ENDIF - END SUBROUTINE Waves2_DestroyInitOutput - - SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Waves2_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! WriteOutputHdr allocated yes/no - IF ( ALLOCATED(InData%WriteOutputHdr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdr upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdr)*LEN(InData%WriteOutputHdr) ! WriteOutputHdr - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputUnt allocated yes/no - IF ( ALLOCATED(InData%WriteOutputUnt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUnt upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUnt)*LEN(InData%WriteOutputUnt) ! WriteOutputUnt - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElevSeries2 allocated yes/no - IF ( ALLOCATED(InData%WaveElevSeries2) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveElevSeries2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElevSeries2) ! WaveElevSeries2 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveAcc2D allocated yes/no - IF ( ALLOCATED(InData%WaveAcc2D) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveAcc2D upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveAcc2D) ! WaveAcc2D - END IF - Int_BufSz = Int_BufSz + 1 ! WaveDynP2D allocated yes/no - IF ( ALLOCATED(InData%WaveDynP2D) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveDynP2D upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveDynP2D) ! WaveDynP2D - END IF - Int_BufSz = Int_BufSz + 1 ! WaveAcc2S allocated yes/no - IF ( ALLOCATED(InData%WaveAcc2S) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveAcc2S upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveAcc2S) ! WaveAcc2S - END IF - Int_BufSz = Int_BufSz + 1 ! WaveDynP2S allocated yes/no - IF ( ALLOCATED(InData%WaveDynP2S) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveDynP2S upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveDynP2S) ! WaveDynP2S - END IF - Int_BufSz = Int_BufSz + 1 ! WaveVel2D allocated yes/no - IF ( ALLOCATED(InData%WaveVel2D) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveVel2D upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveVel2D) ! WaveVel2D - END IF - Int_BufSz = Int_BufSz + 1 ! WaveVel2S allocated yes/no - IF ( ALLOCATED(InData%WaveVel2S) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveVel2S upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveVel2S) ! WaveVel2S - END IF - Int_BufSz = Int_BufSz + 1 ! WaveAcc2D0 allocated yes/no - IF ( ALLOCATED(InData%WaveAcc2D0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveAcc2D0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveAcc2D0) ! WaveAcc2D0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveDynP2D0 allocated yes/no - IF ( ALLOCATED(InData%WaveDynP2D0) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveDynP2D0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveDynP2D0) ! WaveDynP2D0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveAcc2S0 allocated yes/no - IF ( ALLOCATED(InData%WaveAcc2S0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveAcc2S0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveAcc2S0) ! WaveAcc2S0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveDynP2S0 allocated yes/no - IF ( ALLOCATED(InData%WaveDynP2S0) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveDynP2S0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveDynP2S0) ! WaveDynP2S0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveVel2D0 allocated yes/no - IF ( ALLOCATED(InData%WaveVel2D0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveVel2D0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveVel2D0) ! WaveVel2D0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveVel2S0 allocated yes/no - IF ( ALLOCATED(InData%WaveVel2S0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveVel2S0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveVel2S0) ! WaveVel2S0 - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%WriteOutputHdr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) - DO I = 1, LEN(InData%WriteOutputHdr) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputUnt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) - DO I = 1, LEN(InData%WriteOutputUnt) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveElevSeries2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevSeries2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevSeries2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevSeries2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevSeries2,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveElevSeries2,2), UBOUND(InData%WaveElevSeries2,2) - DO i1 = LBOUND(InData%WaveElevSeries2,1), UBOUND(InData%WaveElevSeries2,1) - ReKiBuf(Re_Xferred) = InData%WaveElevSeries2(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveAcc2D) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2D,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2D,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2D,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2D,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2D,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2D,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveAcc2D,3), UBOUND(InData%WaveAcc2D,3) - DO i2 = LBOUND(InData%WaveAcc2D,2), UBOUND(InData%WaveAcc2D,2) - DO i1 = LBOUND(InData%WaveAcc2D,1), UBOUND(InData%WaveAcc2D,1) - ReKiBuf(Re_Xferred) = InData%WaveAcc2D(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveDynP2D) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP2D,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2D,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP2D,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2D,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveDynP2D,2), UBOUND(InData%WaveDynP2D,2) - DO i1 = LBOUND(InData%WaveDynP2D,1), UBOUND(InData%WaveDynP2D,1) - ReKiBuf(Re_Xferred) = InData%WaveDynP2D(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveAcc2S) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2S,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2S,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2S,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2S,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2S,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2S,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveAcc2S,3), UBOUND(InData%WaveAcc2S,3) - DO i2 = LBOUND(InData%WaveAcc2S,2), UBOUND(InData%WaveAcc2S,2) - DO i1 = LBOUND(InData%WaveAcc2S,1), UBOUND(InData%WaveAcc2S,1) - ReKiBuf(Re_Xferred) = InData%WaveAcc2S(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveDynP2S) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP2S,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2S,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP2S,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2S,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveDynP2S,2), UBOUND(InData%WaveDynP2S,2) - DO i1 = LBOUND(InData%WaveDynP2S,1), UBOUND(InData%WaveDynP2S,1) - ReKiBuf(Re_Xferred) = InData%WaveDynP2S(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveVel2D) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2D,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2D,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2D,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2D,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2D,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2D,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveVel2D,3), UBOUND(InData%WaveVel2D,3) - DO i2 = LBOUND(InData%WaveVel2D,2), UBOUND(InData%WaveVel2D,2) - DO i1 = LBOUND(InData%WaveVel2D,1), UBOUND(InData%WaveVel2D,1) - ReKiBuf(Re_Xferred) = InData%WaveVel2D(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveVel2S) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2S,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2S,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2S,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2S,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2S,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2S,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveVel2S,3), UBOUND(InData%WaveVel2S,3) - DO i2 = LBOUND(InData%WaveVel2S,2), UBOUND(InData%WaveVel2S,2) - DO i1 = LBOUND(InData%WaveVel2S,1), UBOUND(InData%WaveVel2S,1) - ReKiBuf(Re_Xferred) = InData%WaveVel2S(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveAcc2D0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2D0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2D0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2D0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2D0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2D0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2D0,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveAcc2D0,3), UBOUND(InData%WaveAcc2D0,3) - DO i2 = LBOUND(InData%WaveAcc2D0,2), UBOUND(InData%WaveAcc2D0,2) - DO i1 = LBOUND(InData%WaveAcc2D0,1), UBOUND(InData%WaveAcc2D0,1) - ReKiBuf(Re_Xferred) = InData%WaveAcc2D0(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveDynP2D0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP2D0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2D0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP2D0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2D0,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveDynP2D0,2), UBOUND(InData%WaveDynP2D0,2) - DO i1 = LBOUND(InData%WaveDynP2D0,1), UBOUND(InData%WaveDynP2D0,1) - ReKiBuf(Re_Xferred) = InData%WaveDynP2D0(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveAcc2S0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2S0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2S0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2S0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2S0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc2S0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2S0,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveAcc2S0,3), UBOUND(InData%WaveAcc2S0,3) - DO i2 = LBOUND(InData%WaveAcc2S0,2), UBOUND(InData%WaveAcc2S0,2) - DO i1 = LBOUND(InData%WaveAcc2S0,1), UBOUND(InData%WaveAcc2S0,1) - ReKiBuf(Re_Xferred) = InData%WaveAcc2S0(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveDynP2S0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP2S0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2S0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP2S0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2S0,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveDynP2S0,2), UBOUND(InData%WaveDynP2S0,2) - DO i1 = LBOUND(InData%WaveDynP2S0,1), UBOUND(InData%WaveDynP2S0,1) - ReKiBuf(Re_Xferred) = InData%WaveDynP2S0(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveVel2D0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2D0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2D0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2D0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2D0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2D0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2D0,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveVel2D0,3), UBOUND(InData%WaveVel2D0,3) - DO i2 = LBOUND(InData%WaveVel2D0,2), UBOUND(InData%WaveVel2D0,2) - DO i1 = LBOUND(InData%WaveVel2D0,1), UBOUND(InData%WaveVel2D0,1) - ReKiBuf(Re_Xferred) = InData%WaveVel2D0(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveVel2S0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2S0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2S0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2S0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2S0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel2S0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2S0,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveVel2S0,3), UBOUND(InData%WaveVel2S0,3) - DO i2 = LBOUND(InData%WaveVel2S0,2), UBOUND(InData%WaveVel2S0,2) - DO i1 = LBOUND(InData%WaveVel2S0,1), UBOUND(InData%WaveVel2S0,1) - ReKiBuf(Re_Xferred) = InData%WaveVel2S0(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE Waves2_PackInitOutput - - SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Waves2_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputHdr)) DEALLOCATE(OutData%WriteOutputHdr) - ALLOCATE(OutData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) - DO I = 1, LEN(OutData%WriteOutputHdr) - OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutputUnt)) DEALLOCATE(OutData%WriteOutputUnt) - ALLOCATE(OutData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) - DO I = 1, LEN(OutData%WriteOutputUnt) - OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevSeries2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveElevSeries2)) DEALLOCATE(OutData%WaveElevSeries2) - ALLOCATE(OutData%WaveElevSeries2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevSeries2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveElevSeries2,2), UBOUND(OutData%WaveElevSeries2,2) - DO i1 = LBOUND(OutData%WaveElevSeries2,1), UBOUND(OutData%WaveElevSeries2,1) - OutData%WaveElevSeries2(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc2D not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveAcc2D)) DEALLOCATE(OutData%WaveAcc2D) - ALLOCATE(OutData%WaveAcc2D(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc2D.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveAcc2D,3), UBOUND(OutData%WaveAcc2D,3) - DO i2 = LBOUND(OutData%WaveAcc2D,2), UBOUND(OutData%WaveAcc2D,2) - DO i1 = LBOUND(OutData%WaveAcc2D,1), UBOUND(OutData%WaveAcc2D,1) - OutData%WaveAcc2D(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP2D not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveDynP2D)) DEALLOCATE(OutData%WaveDynP2D) - ALLOCATE(OutData%WaveDynP2D(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP2D.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveDynP2D,2), UBOUND(OutData%WaveDynP2D,2) - DO i1 = LBOUND(OutData%WaveDynP2D,1), UBOUND(OutData%WaveDynP2D,1) - OutData%WaveDynP2D(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc2S not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveAcc2S)) DEALLOCATE(OutData%WaveAcc2S) - ALLOCATE(OutData%WaveAcc2S(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc2S.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveAcc2S,3), UBOUND(OutData%WaveAcc2S,3) - DO i2 = LBOUND(OutData%WaveAcc2S,2), UBOUND(OutData%WaveAcc2S,2) - DO i1 = LBOUND(OutData%WaveAcc2S,1), UBOUND(OutData%WaveAcc2S,1) - OutData%WaveAcc2S(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP2S not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveDynP2S)) DEALLOCATE(OutData%WaveDynP2S) - ALLOCATE(OutData%WaveDynP2S(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP2S.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveDynP2S,2), UBOUND(OutData%WaveDynP2S,2) - DO i1 = LBOUND(OutData%WaveDynP2S,1), UBOUND(OutData%WaveDynP2S,1) - OutData%WaveDynP2S(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel2D not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveVel2D)) DEALLOCATE(OutData%WaveVel2D) - ALLOCATE(OutData%WaveVel2D(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel2D.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveVel2D,3), UBOUND(OutData%WaveVel2D,3) - DO i2 = LBOUND(OutData%WaveVel2D,2), UBOUND(OutData%WaveVel2D,2) - DO i1 = LBOUND(OutData%WaveVel2D,1), UBOUND(OutData%WaveVel2D,1) - OutData%WaveVel2D(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel2S not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveVel2S)) DEALLOCATE(OutData%WaveVel2S) - ALLOCATE(OutData%WaveVel2S(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel2S.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveVel2S,3), UBOUND(OutData%WaveVel2S,3) - DO i2 = LBOUND(OutData%WaveVel2S,2), UBOUND(OutData%WaveVel2S,2) - DO i1 = LBOUND(OutData%WaveVel2S,1), UBOUND(OutData%WaveVel2S,1) - OutData%WaveVel2S(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc2D0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveAcc2D0)) DEALLOCATE(OutData%WaveAcc2D0) - ALLOCATE(OutData%WaveAcc2D0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc2D0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveAcc2D0,3), UBOUND(OutData%WaveAcc2D0,3) - DO i2 = LBOUND(OutData%WaveAcc2D0,2), UBOUND(OutData%WaveAcc2D0,2) - DO i1 = LBOUND(OutData%WaveAcc2D0,1), UBOUND(OutData%WaveAcc2D0,1) - OutData%WaveAcc2D0(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP2D0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveDynP2D0)) DEALLOCATE(OutData%WaveDynP2D0) - ALLOCATE(OutData%WaveDynP2D0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP2D0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveDynP2D0,2), UBOUND(OutData%WaveDynP2D0,2) - DO i1 = LBOUND(OutData%WaveDynP2D0,1), UBOUND(OutData%WaveDynP2D0,1) - OutData%WaveDynP2D0(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc2S0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveAcc2S0)) DEALLOCATE(OutData%WaveAcc2S0) - ALLOCATE(OutData%WaveAcc2S0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc2S0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveAcc2S0,3), UBOUND(OutData%WaveAcc2S0,3) - DO i2 = LBOUND(OutData%WaveAcc2S0,2), UBOUND(OutData%WaveAcc2S0,2) - DO i1 = LBOUND(OutData%WaveAcc2S0,1), UBOUND(OutData%WaveAcc2S0,1) - OutData%WaveAcc2S0(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP2S0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveDynP2S0)) DEALLOCATE(OutData%WaveDynP2S0) - ALLOCATE(OutData%WaveDynP2S0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP2S0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveDynP2S0,2), UBOUND(OutData%WaveDynP2S0,2) - DO i1 = LBOUND(OutData%WaveDynP2S0,1), UBOUND(OutData%WaveDynP2S0,1) - OutData%WaveDynP2S0(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel2D0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveVel2D0)) DEALLOCATE(OutData%WaveVel2D0) - ALLOCATE(OutData%WaveVel2D0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel2D0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveVel2D0,3), UBOUND(OutData%WaveVel2D0,3) - DO i2 = LBOUND(OutData%WaveVel2D0,2), UBOUND(OutData%WaveVel2D0,2) - DO i1 = LBOUND(OutData%WaveVel2D0,1), UBOUND(OutData%WaveVel2D0,1) - OutData%WaveVel2D0(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel2S0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveVel2S0)) DEALLOCATE(OutData%WaveVel2S0) - ALLOCATE(OutData%WaveVel2S0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel2S0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveVel2S0,3), UBOUND(OutData%WaveVel2S0,3) - DO i2 = LBOUND(OutData%WaveVel2S0,2), UBOUND(OutData%WaveVel2S0,2) - DO i1 = LBOUND(OutData%WaveVel2S0,1), UBOUND(OutData%WaveVel2S0,1) - OutData%WaveVel2S0(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - END SUBROUTINE Waves2_UnPackInitOutput - - SUBROUTINE Waves2_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Waves2_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(Waves2_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%DummyContState = SrcContStateData%DummyContState - END SUBROUTINE Waves2_CopyContState - - SUBROUTINE Waves2_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(Waves2_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Waves2_DestroyContState - - SUBROUTINE Waves2_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Waves2_ContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_PackContState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyContState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Waves2_PackContState - - SUBROUTINE Waves2_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Waves2_ContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_UnPackContState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyContState = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Waves2_UnPackContState - - SUBROUTINE Waves2_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Waves2_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(Waves2_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState - END SUBROUTINE Waves2_CopyDiscState - - SUBROUTINE Waves2_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(Waves2_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Waves2_DestroyDiscState - - SUBROUTINE Waves2_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Waves2_DiscreteStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_PackDiscState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyDiscState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Waves2_PackDiscState - - SUBROUTINE Waves2_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Waves2_DiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_UnPackDiscState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyDiscState = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Waves2_UnPackDiscState - - SUBROUTINE Waves2_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Waves2_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(Waves2_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE Waves2_CopyConstrState - - SUBROUTINE Waves2_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(Waves2_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Waves2_DestroyConstrState - - SUBROUTINE Waves2_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Waves2_ConstraintStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_PackConstrState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyConstrState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Waves2_PackConstrState - - SUBROUTINE Waves2_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Waves2_ConstraintStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_UnPackConstrState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyConstrState = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Waves2_UnPackConstrState - - SUBROUTINE Waves2_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Waves2_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(Waves2_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState - END SUBROUTINE Waves2_CopyOtherState - - SUBROUTINE Waves2_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(Waves2_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Waves2_DestroyOtherState - - SUBROUTINE Waves2_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Waves2_OtherStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_PackOtherState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! DummyOtherState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%DummyOtherState - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Waves2_PackOtherState - - SUBROUTINE Waves2_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Waves2_OtherStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_UnPackOtherState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyOtherState = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Waves2_UnPackOtherState - - SUBROUTINE Waves2_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Waves2_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(Waves2_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%LastIndWave = SrcMiscData%LastIndWave - END SUBROUTINE Waves2_CopyMisc - - SUBROUTINE Waves2_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(Waves2_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Waves2_DestroyMisc - - SUBROUTINE Waves2_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Waves2_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! LastIndWave - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%LastIndWave - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Waves2_PackMisc - - SUBROUTINE Waves2_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Waves2_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%LastIndWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Waves2_UnPackMisc - - SUBROUTINE Waves2_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Waves2_ParameterType), INTENT(IN) :: SrcParamData - TYPE(Waves2_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT - DstParamData%WvDiffQTFF = SrcParamData%WvDiffQTFF - DstParamData%WvSumQTFF = SrcParamData%WvSumQTFF - DstParamData%NWaveElev = SrcParamData%NWaveElev - DstParamData%NStepWave = SrcParamData%NStepWave - DstParamData%NStepWave2 = SrcParamData%NStepWave2 -IF (ALLOCATED(SrcParamData%WaveTime)) THEN - i1_l = LBOUND(SrcParamData%WaveTime,1) - i1_u = UBOUND(SrcParamData%WaveTime,1) - IF (.NOT. ALLOCATED(DstParamData%WaveTime)) THEN - ALLOCATE(DstParamData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveTime = SrcParamData%WaveTime -ENDIF -IF (ALLOCATED(SrcParamData%WaveElev2)) THEN - i1_l = LBOUND(SrcParamData%WaveElev2,1) - i1_u = UBOUND(SrcParamData%WaveElev2,1) - i2_l = LBOUND(SrcParamData%WaveElev2,2) - i2_u = UBOUND(SrcParamData%WaveElev2,2) - IF (.NOT. ALLOCATED(DstParamData%WaveElev2)) THEN - ALLOCATE(DstParamData%WaveElev2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%WaveElev2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%WaveElev2 = SrcParamData%WaveElev2 -ENDIF -IF (ALLOCATED(SrcParamData%OutParam)) THEN - i1_l = LBOUND(SrcParamData%OutParam,1) - i1_u = UBOUND(SrcParamData%OutParam,1) - IF (.NOT. ALLOCATED(DstParamData%OutParam)) THEN - ALLOCATE(DstParamData%OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%OutParam,1), UBOUND(SrcParamData%OutParam,1) - CALL NWTC_Library_Copyoutparmtype( SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%NumOutAll = SrcParamData%NumOutAll - DstParamData%OutFmt = SrcParamData%OutFmt - DstParamData%OutSFmt = SrcParamData%OutSFmt - DstParamData%Delim = SrcParamData%Delim - DstParamData%UnOutFile = SrcParamData%UnOutFile - END SUBROUTINE Waves2_CopyParam - - SUBROUTINE Waves2_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(Waves2_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(ParamData%WaveTime)) THEN - DEALLOCATE(ParamData%WaveTime) -ENDIF -IF (ALLOCATED(ParamData%WaveElev2)) THEN - DEALLOCATE(ParamData%WaveElev2) -ENDIF -IF (ALLOCATED(ParamData%OutParam)) THEN -DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_DestroyOutParmType( ParamData%OutParam(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(ParamData%OutParam) -ENDIF - END SUBROUTINE Waves2_DestroyParam - - SUBROUTINE Waves2_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Waves2_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! DT - Int_BufSz = Int_BufSz + 1 ! WvDiffQTFF - Int_BufSz = Int_BufSz + 1 ! WvSumQTFF - Int_BufSz = Int_BufSz + 1 ! NWaveElev - Int_BufSz = Int_BufSz + 1 ! NStepWave - Int_BufSz = Int_BufSz + 1 ! NStepWave2 - Int_BufSz = Int_BufSz + 1 ! WaveTime allocated yes/no - IF ( ALLOCATED(InData%WaveTime) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveTime upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveTime) ! WaveTime - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElev2 allocated yes/no - IF ( ALLOCATED(InData%WaveElev2) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveElev2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev2) ! WaveElev2 - END IF - Int_BufSz = Int_BufSz + 1 ! OutParam allocated yes/no - IF ( ALLOCATED(InData%OutParam) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutParam upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - Int_BufSz = Int_BufSz + 3 ! OutParam: size of buffers for each call to pack subtype - CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutParam - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutParam - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutParam - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1 ! NumOutAll - Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt - Int_BufSz = Int_BufSz + 1*LEN(InData%OutSFmt) ! OutSFmt - Int_BufSz = Int_BufSz + 1*LEN(InData%Delim) ! Delim - Int_BufSz = Int_BufSz + 1 ! UnOutFile - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WvDiffQTFF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WvSumQTFF, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NWaveElev - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepWave2 - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveTime,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) - ReKiBuf(Re_Xferred) = InData%WaveTime(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveElev2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev2,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev2,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev2,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveElev2,2), UBOUND(InData%WaveElev2,2) - DO i1 = LBOUND(InData%WaveElev2,1), UBOUND(InData%WaveElev2,1) - ReKiBuf(Re_Xferred) = InData%WaveElev2(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutParam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParam,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - CALL NWTC_Library_PackOutParmType( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IntKiBuf(Int_Xferred) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOutAll - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutSFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%UnOutFile - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Waves2_PackParam - - SUBROUTINE Waves2_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Waves2_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%WvDiffQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%WvDiffQTFF) - Int_Xferred = Int_Xferred + 1 - OutData%WvSumQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%WvSumQTFF) - Int_Xferred = Int_Xferred + 1 - OutData%NWaveElev = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NStepWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NStepWave2 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveTime)) DEALLOCATE(OutData%WaveTime) - ALLOCATE(OutData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) - OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveElev2)) DEALLOCATE(OutData%WaveElev2) - ALLOCATE(OutData%WaveElev2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveElev2,2), UBOUND(OutData%WaveElev2,2) - DO i1 = LBOUND(OutData%WaveElev2,1), UBOUND(OutData%WaveElev2,1) - OutData%WaveElev2(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutParam)) DEALLOCATE(OutData%OutParam) - ALLOCATE(OutData%OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutParam,1), UBOUND(OutData%OutParam,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackOutParmType( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - OutData%NumOuts = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NumOutAll = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutSFmt) - OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UnOutFile = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Waves2_UnPackParam - - SUBROUTINE Waves2_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Waves2_InputType), INTENT(IN) :: SrcInputData - TYPE(Waves2_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_CopyInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInputData%DummyInput = SrcInputData%DummyInput - END SUBROUTINE Waves2_CopyInput - - SUBROUTINE Waves2_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(Waves2_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Waves2_DestroyInput - - SUBROUTINE Waves2_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Waves2_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyInput - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyInput - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Waves2_PackInput - - SUBROUTINE Waves2_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Waves2_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyInput = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Waves2_UnPackInput - - SUBROUTINE Waves2_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Waves2_OutputType), INTENT(IN) :: SrcOutputData - TYPE(Waves2_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_CopyOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%WriteOutput)) THEN - i1_l = LBOUND(SrcOutputData%WriteOutput,1) - i1_u = UBOUND(SrcOutputData%WriteOutput,1) - IF (.NOT. ALLOCATED(DstOutputData%WriteOutput)) THEN - ALLOCATE(DstOutputData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%WriteOutput = SrcOutputData%WriteOutput -ENDIF - END SUBROUTINE Waves2_CopyOutput - - SUBROUTINE Waves2_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(Waves2_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - END SUBROUTINE Waves2_DestroyOutput - - SUBROUTINE Waves2_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Waves2_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! WriteOutput allocated yes/no - IF ( ALLOCATED(InData%WriteOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutput upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WriteOutput) ! WriteOutput - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) - ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE Waves2_PackOutput - - SUBROUTINE Waves2_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Waves2_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WriteOutput)) DEALLOCATE(OutData%WriteOutput) - ALLOCATE(OutData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) - OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE Waves2_UnPackOutput - - - SUBROUTINE Waves2_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(Waves2_InputType), INTENT(IN) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(Waves2_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_Input_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(u)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(u) - 1 - IF ( order .eq. 0 ) THEN - CALL Waves2_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL Waves2_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL Waves2_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE Waves2_Input_ExtrapInterp - - - SUBROUTINE Waves2_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is 1. -! -! f(t) = a + b * t, or -! -! where a and b are determined as the solution to -! f(t1) = u1, f(t2) = u2 -! -!.................................................................................................................................. - - TYPE(Waves2_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 - TYPE(Waves2_InputType), INTENT(IN) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(Waves2_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_Input_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - - ScaleFactor = t_out / t(2) - b = -(u1%DummyInput - u2%DummyInput) - u_out%DummyInput = u1%DummyInput + b * ScaleFactor - END SUBROUTINE Waves2_Input_ExtrapInterp1 - - - SUBROUTINE Waves2_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is 2. -! -! expressions below based on either -! -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 -! -!.................................................................................................................................. - - TYPE(Waves2_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 - TYPE(Waves2_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 - TYPE(Waves2_InputType), INTENT(IN) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(Waves2_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_Input_ExtrapInterp2' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) - b = (t(3)**2*(u1%DummyInput - u2%DummyInput) + t(2)**2*(-u1%DummyInput + u3%DummyInput))* scaleFactor - c = ( (t(2)-t(3))*u1%DummyInput + t(3)*u2%DummyInput - t(2)*u3%DummyInput ) * scaleFactor - u_out%DummyInput = u1%DummyInput + b + c * t_out - END SUBROUTINE Waves2_Input_ExtrapInterp2 - - - SUBROUTINE Waves2_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(Waves2_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(Waves2_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_Output_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(y)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(y) - 1 - IF ( order .eq. 0 ) THEN - CALL Waves2_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL Waves2_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL Waves2_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE Waves2_Output_ExtrapInterp - - - SUBROUTINE Waves2_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is 1. -! -! f(t) = a + b * t, or -! -! where a and b are determined as the solution to -! f(t1) = y1, f(t2) = y2 -! -!.................................................................................................................................. - - TYPE(Waves2_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 - TYPE(Waves2_OutputType), INTENT(IN) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(Waves2_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_Output_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - - ScaleFactor = t_out / t(2) -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE Waves2_Output_ExtrapInterp1 - - - SUBROUTINE Waves2_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is 2. -! -! expressions below based on either -! -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 -! -!.................................................................................................................................. - - TYPE(Waves2_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 - TYPE(Waves2_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 - TYPE(Waves2_OutputType), INTENT(IN) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(Waves2_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE Waves2_Output_ExtrapInterp2 - -END MODULE Waves2_Types -!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/Waves_Types.f90 b/modules/hydrodyn/src/Waves_Types.f90 deleted file mode 100644 index 6207cb31d2..0000000000 --- a/modules/hydrodyn/src/Waves_Types.f90 +++ /dev/null @@ -1,3586 +0,0 @@ -!STARTOFREGISTRYGENERATEDFILE 'Waves_Types.f90' -! -! WARNING This file is generated automatically by the FAST registry. -! Do not edit. Your changes to this file will be lost. -! -! FAST Registry -!********************************************************************************************************************************* -! Waves_Types -!................................................................................................................................. -! This file is part of Waves. -! -! Copyright (C) 2012-2016 National Renewable Energy Laboratory -! -! Licensed under the Apache License, Version 2.0 (the "License"); -! you may not use this file except in compliance with the License. -! You may obtain a copy of the License at -! -! http://www.apache.org/licenses/LICENSE-2.0 -! -! Unless required by applicable law or agreed to in writing, software -! distributed under the License is distributed on an "AS IS" BASIS, -! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -! See the License for the specific language governing permissions and -! limitations under the License. -! -! -! W A R N I N G : This file was automatically generated from the FAST registry. Changes made to this file may be lost. -! -!********************************************************************************************************************************* -!> This module contains the user-defined types needed in Waves. It also contains copy, destroy, pack, and -!! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. -MODULE Waves_Types -!--------------------------------------------------------------------------------------------------------------------------------- -USE NWTC_Library -IMPLICIT NONE -! ========= Waves_InitInputType ======= - TYPE, PUBLIC :: Waves_InitInputType - CHARACTER(1024) :: InputFile !< Name of the input file [-] - CHARACTER(1024) :: DirRoot !< The name of the root file including the full path. This may be useful if you want this routine to write a permanent record of what it does to be stored with the simulation results: the results should be stored in a file whose name (including path) is generated by appending any suitable extension to DirRoot. [-] - CHARACTER(1024) :: WvKinFile !< The root name of user input wave kinematics files [-] - LOGICAL :: WriteWvKin !< Flag indicating whether we are going to write out kinematics files. [Must be FALSE if WaveMod = 5 or 6, if TRUE then WvKinFile must have a string value and this is the rootname for all the output files] [-] - INTEGER(IntKi) :: UnSum !< The unit number for the HydroDyn summary file [-] - REAL(ReKi) :: Gravity !< Gravitational acceleration [(m/s^2)] - REAL(ReKi) :: MSL2SWL !< Offset between still-water level and mean sea level [positive upward; must be zero if using WAMIT] [(meters)] - REAL(SiKi) :: WvLowCOff !< Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] - REAL(SiKi) :: WvHiCOff !< High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] - REAL(SiKi) :: WaveDir !< Mean incident wave propagation heading direction [(degrees)] - INTEGER(IntKi) :: WaveNDir !< Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module] [(-)] - LOGICAL :: WaveMultiDir !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] - INTEGER(IntKi) :: WaveDirMod !< Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6] [-] - REAL(SiKi) :: WaveDirSpread !< Spreading coefficient [WaveMod=2,3,4 and WaveDirMod=1] [-] - REAL(SiKi) :: WaveDirRange !< Range of wave directions (full range: WaveDir +/- WaveDirRange/2) [only used if WaveMod=6] [(degrees)] - REAL(DbKi) :: WaveDT !< Time step for incident wave calculations [(sec)] - REAL(SiKi) :: WaveHs !< Significant wave height of incident waves [(meters)] - INTEGER(IntKi) :: WaveMod !< Incident wave kinematics model {0: none=still water, 1: plane progressive (regular), 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: white-noise spectrum, 4: user-defind spectrum from routine UserWaveSpctrm (irregular), 5: GH BLADED } [-] - CHARACTER(80) :: WaveModChr !< String to temporarially hold the value of the wave kinematics input line [-] - LOGICAL :: WaveNDAmp !< Flag for normally-distributed amplitudes in incident waves spectrum [flag] [-] - REAL(SiKi) :: WavePhase !< Specified phase for regular waves [(radians)] - REAL(SiKi) :: WavePkShp !< Peak shape parameter of incident wave spectrum [1.0 for Pierson-Moskowitz] [-] - CHARACTER(80) :: WavePkShpChr !< String to temporarially hold value of peak shape parameter input line [-] - INTEGER(IntKi) , DIMENSION(1:2) :: WaveSeed !< Random seeds of incident waves [-2147483648 to 2147483647] [-] - INTEGER(IntKi) :: WaveStMod !< Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching} [-] - REAL(DbKi) :: WaveTMax !< Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT [(sec)] - REAL(SiKi) :: WaveTp !< Peak spectral period of incident waves [(sec)] - REAL(SiKi) :: WtrDens !< Water density [(kg/m^3)] - REAL(SiKi) :: WtrDpth !< Water depth [(meters)] - INTEGER(IntKi) :: NWaveElev !< Number of points where the incident wave elevations can be output [-] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevxi !< xi-coordinates for points where the incident wave elevations can be output [(meters)] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevyi !< yi-coordinates for points where the incident wave elevations can be output [(meters)] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevXY !< Supplied by Driver: X-Y locations for WaveElevation output (for visualization). Index 1 corresponds to X or Y coordinate. Index 2 corresponds to point number. [-] - REAL(ReKi) :: PtfmLocationX !< Copy of X coordinate of platform location in the wave field, used to offset/phase-shift all wave kinematics to account for location in the farm [m] - REAL(ReKi) :: PtfmLocationY !< Copy of Y coordinate of platform location in the wave field, used to offset/phase-shift all wave kinematics to account for location in the farm [m] - INTEGER(IntKi) :: WaveFieldMod !< Wave field handling (-) (switch) 0: use individual HydroDyn inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin [-] - INTEGER(IntKi) :: NWaveKin !< Number of points where the incident wave kinematics will be computed [-] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinxi !< xi-coordinates for points where the incident wave kinematics will be computed; these are relative to the mean sea level [(meters)] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinyi !< yi-coordinates for points where the incident wave kinematics will be computed; these are relative to the mean sea level [(meters)] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinzi !< zi-coordinates for points where the incident wave kinematics will be computed; these are relative to the mean sea level [(meters)] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: CurrVxi !< xi-component of the current velocity at elevation i [(m/s)] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: CurrVyi !< yi-component of the current velocity at elevation i [(m/s)] - REAL(SiKi) :: PCurrVxiPz0 !< xi-component of the partial derivative of the current velocity at elevation near mean sea level [(m/s)] - REAL(SiKi) :: PCurrVyiPz0 !< yi-component of the partial derivative of the current velocity at elevation near mean sea level [(m/s)] - TYPE(NWTC_RandomNumber_ParameterType) :: RNG !< Parameters for the pseudo random number generator [-] - END TYPE Waves_InitInputType -! ======================= -! ========= Waves_InitOutputType ======= - TYPE, PUBLIC :: Waves_InitOutputType - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevC0 !< Discrete Fourier transform of the instantaneous elevation of incident waves at the platform reference point. First column is real part, second column is imaginary part [(meters)] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveDirArr !< Wave direction array. Each frequency has a unique direction of WaveNDir > 1 [(degrees)] - REAL(SiKi) :: WaveDirMin !< Minimum wave direction. [(degrees)] - REAL(SiKi) :: WaveDirMax !< Maximum wave direction. [(degrees)] - REAL(SiKi) :: WaveDir !< Incident wave propagation heading direction [(degrees)] - INTEGER(IntKi) :: WaveNDir !< Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module] [(-)] - LOGICAL :: WaveMultiDir !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] - REAL(SiKi) :: WaveDOmega !< Frequency step for incident wave calculations [(rad/s)] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinzi !< zi-coordinates for points where the incident wave kinematics will be computed; these are relative to the mean see level [(meters)] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: PWaveDynP0 !< Instantaneous dynamic pressure of incident waves , at the location (xi,yi,0), at each of the NWaveKin points where the incident wave kinematics will be computed [(N/m^2)] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveDynP !< Instantaneous dynamic pressure of incident waves , accounting for stretching, at each of the NWaveKin points where the incident wave kinematics will be computed [(N/m^2)] - REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveAcc !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin points where the incident wave kinematics will be computed [(m/s^2)] - REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: PWaveAcc0 !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKin points where the incident wave kinematics will be computed [(m/s^2)] - REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveVel !< Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.) [(m/s)] - REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: PWaveVel0 !< Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKin points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.) [(m/s)] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElev !< Instantaneous elevation time-series of incident waves at each of the NWaveElev points where the incident wave elevations can be output [(meters)] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElev0 !< Instantaneous elevation time-series of incident waves at the platform reference point [(meters)] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevMD !< Instantaneous elevation time-series of incident waves at hard coded grid for temporary use in MoorDyn [(m)] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevSeries !< Instantaneous elevation time-series at each of the points given by WaveElevXY. Used for making movies of the waves. First index is the timestep. Second index is XY point number corresponding to second index of WaveElevXY. [(m)] - REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveTime !< Simulation times at which the instantaneous elevation of, velocity of, acceleration of, and loads associated with the incident waves are determined [(sec)] - REAL(DbKi) :: WaveTMax !< Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT [(sec)] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: nodeInWater !< Logical flag indicating if the node at the given time step is in the water, and hence needs to have hydrodynamic forces calculated [-] - REAL(SiKi) :: RhoXg !< = WtrDens*Gravity [-] - INTEGER(IntKi) :: NStepWave !< Total number of frequency components = total number of time steps in the incident wave [-] - INTEGER(IntKi) :: NStepWave2 !< NStepWave / 2 [-] - END TYPE Waves_InitOutputType -! ======================= -! ========= Waves_ContinuousStateType ======= - TYPE, PUBLIC :: Waves_ContinuousStateType - REAL(SiKi) :: DummyContState !< Remove this variable if you have continuous states [-] - END TYPE Waves_ContinuousStateType -! ======================= -! ========= Waves_DiscreteStateType ======= - TYPE, PUBLIC :: Waves_DiscreteStateType - REAL(SiKi) :: DummyDiscState !< Remove this variable if you have discrete states [-] - END TYPE Waves_DiscreteStateType -! ======================= -! ========= Waves_ConstraintStateType ======= - TYPE, PUBLIC :: Waves_ConstraintStateType - REAL(SiKi) :: DummyConstrState !< Remove this variable if you have constraint states [-] - END TYPE Waves_ConstraintStateType -! ======================= -! ========= Waves_OtherStateType ======= - TYPE, PUBLIC :: Waves_OtherStateType - INTEGER(IntKi) :: DummyOtherState !< Remove this variable if you have other states [-] - END TYPE Waves_OtherStateType -! ======================= -! ========= Waves_MiscVarType ======= - TYPE, PUBLIC :: Waves_MiscVarType - INTEGER(IntKi) :: DummyMiscVar !< Remove this variable if you have misc/optimization variables [-] - END TYPE Waves_MiscVarType -! ======================= -! ========= Waves_ParameterType ======= - TYPE, PUBLIC :: Waves_ParameterType - REAL(DbKi) :: DT !< Time step for continuous state integration & discrete state update [seconds] - REAL(DbKi) :: WaveTMax !< Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT [(sec)] - INTEGER(IntKi) :: NStepWave !< Total number of frequency components = total number of time steps in the incident wave [-] - INTEGER(IntKi) :: WaveNDir !< Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module] [(-)] - LOGICAL :: WaveMultiDir !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] - END TYPE Waves_ParameterType -! ======================= -! ========= Waves_InputType ======= - TYPE, PUBLIC :: Waves_InputType - REAL(SiKi) :: DummyInput !< Remove this variable if you have input data [-] - END TYPE Waves_InputType -! ======================= -! ========= Waves_OutputType ======= - TYPE, PUBLIC :: Waves_OutputType - REAL(SiKi) :: DummyOutput !< Remove this variable if you have output data [-] - END TYPE Waves_OutputType -! ======================= -CONTAINS - SUBROUTINE Waves_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Waves_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(Waves_InitInputType), INTENT(INOUT) :: DstInitInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFile = SrcInitInputData%InputFile - DstInitInputData%DirRoot = SrcInitInputData%DirRoot - DstInitInputData%WvKinFile = SrcInitInputData%WvKinFile - DstInitInputData%WriteWvKin = SrcInitInputData%WriteWvKin - DstInitInputData%UnSum = SrcInitInputData%UnSum - DstInitInputData%Gravity = SrcInitInputData%Gravity - DstInitInputData%MSL2SWL = SrcInitInputData%MSL2SWL - DstInitInputData%WvLowCOff = SrcInitInputData%WvLowCOff - DstInitInputData%WvHiCOff = SrcInitInputData%WvHiCOff - DstInitInputData%WaveDir = SrcInitInputData%WaveDir - DstInitInputData%WaveNDir = SrcInitInputData%WaveNDir - DstInitInputData%WaveMultiDir = SrcInitInputData%WaveMultiDir - DstInitInputData%WaveDirMod = SrcInitInputData%WaveDirMod - DstInitInputData%WaveDirSpread = SrcInitInputData%WaveDirSpread - DstInitInputData%WaveDirRange = SrcInitInputData%WaveDirRange - DstInitInputData%WaveDT = SrcInitInputData%WaveDT - DstInitInputData%WaveHs = SrcInitInputData%WaveHs - DstInitInputData%WaveMod = SrcInitInputData%WaveMod - DstInitInputData%WaveModChr = SrcInitInputData%WaveModChr - DstInitInputData%WaveNDAmp = SrcInitInputData%WaveNDAmp - DstInitInputData%WavePhase = SrcInitInputData%WavePhase - DstInitInputData%WavePkShp = SrcInitInputData%WavePkShp - DstInitInputData%WavePkShpChr = SrcInitInputData%WavePkShpChr - DstInitInputData%WaveSeed = SrcInitInputData%WaveSeed - DstInitInputData%WaveStMod = SrcInitInputData%WaveStMod - DstInitInputData%WaveTMax = SrcInitInputData%WaveTMax - DstInitInputData%WaveTp = SrcInitInputData%WaveTp - DstInitInputData%WtrDens = SrcInitInputData%WtrDens - DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth - DstInitInputData%NWaveElev = SrcInitInputData%NWaveElev -IF (ALLOCATED(SrcInitInputData%WaveElevxi)) THEN - i1_l = LBOUND(SrcInitInputData%WaveElevxi,1) - i1_u = UBOUND(SrcInitInputData%WaveElevxi,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveElevxi)) THEN - ALLOCATE(DstInitInputData%WaveElevxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElevxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveElevxi = SrcInitInputData%WaveElevxi -ENDIF -IF (ALLOCATED(SrcInitInputData%WaveElevyi)) THEN - i1_l = LBOUND(SrcInitInputData%WaveElevyi,1) - i1_u = UBOUND(SrcInitInputData%WaveElevyi,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveElevyi)) THEN - ALLOCATE(DstInitInputData%WaveElevyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElevyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveElevyi = SrcInitInputData%WaveElevyi -ENDIF -IF (ALLOCATED(SrcInitInputData%WaveElevXY)) THEN - i1_l = LBOUND(SrcInitInputData%WaveElevXY,1) - i1_u = UBOUND(SrcInitInputData%WaveElevXY,1) - i2_l = LBOUND(SrcInitInputData%WaveElevXY,2) - i2_u = UBOUND(SrcInitInputData%WaveElevXY,2) - IF (.NOT. ALLOCATED(DstInitInputData%WaveElevXY)) THEN - ALLOCATE(DstInitInputData%WaveElevXY(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElevXY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveElevXY = SrcInitInputData%WaveElevXY -ENDIF - DstInitInputData%PtfmLocationX = SrcInitInputData%PtfmLocationX - DstInitInputData%PtfmLocationY = SrcInitInputData%PtfmLocationY - DstInitInputData%WaveFieldMod = SrcInitInputData%WaveFieldMod - DstInitInputData%NWaveKin = SrcInitInputData%NWaveKin -IF (ALLOCATED(SrcInitInputData%WaveKinxi)) THEN - i1_l = LBOUND(SrcInitInputData%WaveKinxi,1) - i1_u = UBOUND(SrcInitInputData%WaveKinxi,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveKinxi)) THEN - ALLOCATE(DstInitInputData%WaveKinxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveKinxi = SrcInitInputData%WaveKinxi -ENDIF -IF (ALLOCATED(SrcInitInputData%WaveKinyi)) THEN - i1_l = LBOUND(SrcInitInputData%WaveKinyi,1) - i1_u = UBOUND(SrcInitInputData%WaveKinyi,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveKinyi)) THEN - ALLOCATE(DstInitInputData%WaveKinyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveKinyi = SrcInitInputData%WaveKinyi -ENDIF -IF (ALLOCATED(SrcInitInputData%WaveKinzi)) THEN - i1_l = LBOUND(SrcInitInputData%WaveKinzi,1) - i1_u = UBOUND(SrcInitInputData%WaveKinzi,1) - IF (.NOT. ALLOCATED(DstInitInputData%WaveKinzi)) THEN - ALLOCATE(DstInitInputData%WaveKinzi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveKinzi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%WaveKinzi = SrcInitInputData%WaveKinzi -ENDIF -IF (ALLOCATED(SrcInitInputData%CurrVxi)) THEN - i1_l = LBOUND(SrcInitInputData%CurrVxi,1) - i1_u = UBOUND(SrcInitInputData%CurrVxi,1) - IF (.NOT. ALLOCATED(DstInitInputData%CurrVxi)) THEN - ALLOCATE(DstInitInputData%CurrVxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%CurrVxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%CurrVxi = SrcInitInputData%CurrVxi -ENDIF -IF (ALLOCATED(SrcInitInputData%CurrVyi)) THEN - i1_l = LBOUND(SrcInitInputData%CurrVyi,1) - i1_u = UBOUND(SrcInitInputData%CurrVyi,1) - IF (.NOT. ALLOCATED(DstInitInputData%CurrVyi)) THEN - ALLOCATE(DstInitInputData%CurrVyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%CurrVyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%CurrVyi = SrcInitInputData%CurrVyi -ENDIF - DstInitInputData%PCurrVxiPz0 = SrcInitInputData%PCurrVxiPz0 - DstInitInputData%PCurrVyiPz0 = SrcInitInputData%PCurrVyiPz0 - CALL NWTC_Library_Copynwtc_randomnumber_parametertype( SrcInitInputData%RNG, DstInitInputData%RNG, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE Waves_CopyInitInput - - SUBROUTINE Waves_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(Waves_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_DestroyInitInput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitInputData%WaveElevxi)) THEN - DEALLOCATE(InitInputData%WaveElevxi) -ENDIF -IF (ALLOCATED(InitInputData%WaveElevyi)) THEN - DEALLOCATE(InitInputData%WaveElevyi) -ENDIF -IF (ALLOCATED(InitInputData%WaveElevXY)) THEN - DEALLOCATE(InitInputData%WaveElevXY) -ENDIF -IF (ALLOCATED(InitInputData%WaveKinxi)) THEN - DEALLOCATE(InitInputData%WaveKinxi) -ENDIF -IF (ALLOCATED(InitInputData%WaveKinyi)) THEN - DEALLOCATE(InitInputData%WaveKinyi) -ENDIF -IF (ALLOCATED(InitInputData%WaveKinzi)) THEN - DEALLOCATE(InitInputData%WaveKinzi) -ENDIF -IF (ALLOCATED(InitInputData%CurrVxi)) THEN - DEALLOCATE(InitInputData%CurrVxi) -ENDIF -IF (ALLOCATED(InitInputData%CurrVyi)) THEN - DEALLOCATE(InitInputData%CurrVyi) -ENDIF - CALL NWTC_Library_DestroyNWTC_RandomNumber_ParameterType( InitInputData%RNG, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE Waves_DestroyInitInput - - SUBROUTINE Waves_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Waves_InitInputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_PackInitInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%InputFile) ! InputFile - Int_BufSz = Int_BufSz + 1*LEN(InData%DirRoot) ! DirRoot - Int_BufSz = Int_BufSz + 1*LEN(InData%WvKinFile) ! WvKinFile - Int_BufSz = Int_BufSz + 1 ! WriteWvKin - Int_BufSz = Int_BufSz + 1 ! UnSum - Re_BufSz = Re_BufSz + 1 ! Gravity - Re_BufSz = Re_BufSz + 1 ! MSL2SWL - Re_BufSz = Re_BufSz + 1 ! WvLowCOff - Re_BufSz = Re_BufSz + 1 ! WvHiCOff - Re_BufSz = Re_BufSz + 1 ! WaveDir - Int_BufSz = Int_BufSz + 1 ! WaveNDir - Int_BufSz = Int_BufSz + 1 ! WaveMultiDir - Int_BufSz = Int_BufSz + 1 ! WaveDirMod - Re_BufSz = Re_BufSz + 1 ! WaveDirSpread - Re_BufSz = Re_BufSz + 1 ! WaveDirRange - Db_BufSz = Db_BufSz + 1 ! WaveDT - Re_BufSz = Re_BufSz + 1 ! WaveHs - Int_BufSz = Int_BufSz + 1 ! WaveMod - Int_BufSz = Int_BufSz + 1*LEN(InData%WaveModChr) ! WaveModChr - Int_BufSz = Int_BufSz + 1 ! WaveNDAmp - Re_BufSz = Re_BufSz + 1 ! WavePhase - Re_BufSz = Re_BufSz + 1 ! WavePkShp - Int_BufSz = Int_BufSz + 1*LEN(InData%WavePkShpChr) ! WavePkShpChr - Int_BufSz = Int_BufSz + SIZE(InData%WaveSeed) ! WaveSeed - Int_BufSz = Int_BufSz + 1 ! WaveStMod - Db_BufSz = Db_BufSz + 1 ! WaveTMax - Re_BufSz = Re_BufSz + 1 ! WaveTp - Re_BufSz = Re_BufSz + 1 ! WtrDens - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Int_BufSz = Int_BufSz + 1 ! NWaveElev - Int_BufSz = Int_BufSz + 1 ! WaveElevxi allocated yes/no - IF ( ALLOCATED(InData%WaveElevxi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveElevxi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElevxi) ! WaveElevxi - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElevyi allocated yes/no - IF ( ALLOCATED(InData%WaveElevyi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveElevyi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElevyi) ! WaveElevyi - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElevXY allocated yes/no - IF ( ALLOCATED(InData%WaveElevXY) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveElevXY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElevXY) ! WaveElevXY - END IF - Re_BufSz = Re_BufSz + 1 ! PtfmLocationX - Re_BufSz = Re_BufSz + 1 ! PtfmLocationY - Int_BufSz = Int_BufSz + 1 ! WaveFieldMod - Int_BufSz = Int_BufSz + 1 ! NWaveKin - Int_BufSz = Int_BufSz + 1 ! WaveKinxi allocated yes/no - IF ( ALLOCATED(InData%WaveKinxi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveKinxi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveKinxi) ! WaveKinxi - END IF - Int_BufSz = Int_BufSz + 1 ! WaveKinyi allocated yes/no - IF ( ALLOCATED(InData%WaveKinyi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveKinyi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveKinyi) ! WaveKinyi - END IF - Int_BufSz = Int_BufSz + 1 ! WaveKinzi allocated yes/no - IF ( ALLOCATED(InData%WaveKinzi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveKinzi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveKinzi) ! WaveKinzi - END IF - Int_BufSz = Int_BufSz + 1 ! CurrVxi allocated yes/no - IF ( ALLOCATED(InData%CurrVxi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CurrVxi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CurrVxi) ! CurrVxi - END IF - Int_BufSz = Int_BufSz + 1 ! CurrVyi allocated yes/no - IF ( ALLOCATED(InData%CurrVyi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CurrVyi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CurrVyi) ! CurrVyi - END IF - Re_BufSz = Re_BufSz + 1 ! PCurrVxiPz0 - Re_BufSz = Re_BufSz + 1 ! PCurrVyiPz0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! RNG: size of buffers for each call to pack subtype - CALL NWTC_Library_PackNWTC_RandomNumber_ParameterType( Re_Buf, Db_Buf, Int_Buf, InData%RNG, ErrStat2, ErrMsg2, .TRUE. ) ! RNG - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! RNG - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! RNG - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! RNG - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%DirRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%DirRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%WvKinFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%WvKinFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%WriteWvKin, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%UnSum - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WvLowCOff - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WvHiCOff - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDir - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveNDir - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WaveMultiDir, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveDirMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDirSpread - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDirRange - Re_Xferred = Re_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%WaveDT - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveHs - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveMod - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%WaveModChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%WaveModChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%WaveNDAmp, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WavePhase - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WavePkShp - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%WavePkShpChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%WavePkShpChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO i1 = LBOUND(InData%WaveSeed,1), UBOUND(InData%WaveSeed,1) - IntKiBuf(Int_Xferred) = InData%WaveSeed(i1) - Int_Xferred = Int_Xferred + 1 - END DO - IntKiBuf(Int_Xferred) = InData%WaveStMod - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%WaveTMax - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveTp - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NWaveElev - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveElevxi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevxi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevxi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveElevxi,1), UBOUND(InData%WaveElevxi,1) - ReKiBuf(Re_Xferred) = InData%WaveElevxi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveElevyi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevyi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevyi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveElevyi,1), UBOUND(InData%WaveElevyi,1) - ReKiBuf(Re_Xferred) = InData%WaveElevyi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveElevXY) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevXY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevXY,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevXY,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevXY,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveElevXY,2), UBOUND(InData%WaveElevXY,2) - DO i1 = LBOUND(InData%WaveElevXY,1), UBOUND(InData%WaveElevXY,1) - ReKiBuf(Re_Xferred) = InData%WaveElevXY(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%PtfmLocationX - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PtfmLocationY - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveFieldMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NWaveKin - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveKinxi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveKinxi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinxi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveKinxi,1), UBOUND(InData%WaveKinxi,1) - ReKiBuf(Re_Xferred) = InData%WaveKinxi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveKinyi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveKinyi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinyi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveKinyi,1), UBOUND(InData%WaveKinyi,1) - ReKiBuf(Re_Xferred) = InData%WaveKinyi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveKinzi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveKinzi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinzi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveKinzi,1), UBOUND(InData%WaveKinzi,1) - ReKiBuf(Re_Xferred) = InData%WaveKinzi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CurrVxi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CurrVxi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CurrVxi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CurrVxi,1), UBOUND(InData%CurrVxi,1) - ReKiBuf(Re_Xferred) = InData%CurrVxi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%CurrVyi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CurrVyi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CurrVyi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CurrVyi,1), UBOUND(InData%CurrVyi,1) - ReKiBuf(Re_Xferred) = InData%CurrVyi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%PCurrVxiPz0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%PCurrVyiPz0 - Re_Xferred = Re_Xferred + 1 - CALL NWTC_Library_PackNWTC_RandomNumber_ParameterType( Re_Buf, Db_Buf, Int_Buf, InData%RNG, ErrStat2, ErrMsg2, OnlySize ) ! RNG - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE Waves_PackInitInput - - SUBROUTINE Waves_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Waves_InitInputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_UnPackInitInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%DirRoot) - OutData%DirRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%WvKinFile) - OutData%WvKinFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%WriteWvKin = TRANSFER(IntKiBuf(Int_Xferred), OutData%WriteWvKin) - Int_Xferred = Int_Xferred + 1 - OutData%UnSum = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%Gravity = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%MSL2SWL = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WvLowCOff = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WvHiCOff = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDir = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveNDir = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WaveMultiDir = TRANSFER(IntKiBuf(Int_Xferred), OutData%WaveMultiDir) - Int_Xferred = Int_Xferred + 1 - OutData%WaveDirMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WaveDirSpread = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDirRange = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%WaveHs = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%WaveModChr) - OutData%WaveModChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%WaveNDAmp = TRANSFER(IntKiBuf(Int_Xferred), OutData%WaveNDAmp) - Int_Xferred = Int_Xferred + 1 - OutData%WavePhase = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WavePkShp = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%WavePkShpChr) - OutData%WavePkShpChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - i1_l = LBOUND(OutData%WaveSeed,1) - i1_u = UBOUND(OutData%WaveSeed,1) - DO i1 = LBOUND(OutData%WaveSeed,1), UBOUND(OutData%WaveSeed,1) - OutData%WaveSeed(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - OutData%WaveStMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WaveTMax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%WaveTp = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%NWaveElev = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevxi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveElevxi)) DEALLOCATE(OutData%WaveElevxi) - ALLOCATE(OutData%WaveElevxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveElevxi,1), UBOUND(OutData%WaveElevxi,1) - OutData%WaveElevxi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevyi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveElevyi)) DEALLOCATE(OutData%WaveElevyi) - ALLOCATE(OutData%WaveElevyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveElevyi,1), UBOUND(OutData%WaveElevyi,1) - OutData%WaveElevyi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevXY not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveElevXY)) DEALLOCATE(OutData%WaveElevXY) - ALLOCATE(OutData%WaveElevXY(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevXY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveElevXY,2), UBOUND(OutData%WaveElevXY,2) - DO i1 = LBOUND(OutData%WaveElevXY,1), UBOUND(OutData%WaveElevXY,1) - OutData%WaveElevXY(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - OutData%PtfmLocationX = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmLocationY = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WaveFieldMod = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NWaveKin = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinxi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveKinxi)) DEALLOCATE(OutData%WaveKinxi) - ALLOCATE(OutData%WaveKinxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveKinxi,1), UBOUND(OutData%WaveKinxi,1) - OutData%WaveKinxi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinyi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveKinyi)) DEALLOCATE(OutData%WaveKinyi) - ALLOCATE(OutData%WaveKinyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveKinyi,1), UBOUND(OutData%WaveKinyi,1) - OutData%WaveKinyi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinzi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveKinzi)) DEALLOCATE(OutData%WaveKinzi) - ALLOCATE(OutData%WaveKinzi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinzi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveKinzi,1), UBOUND(OutData%WaveKinzi,1) - OutData%WaveKinzi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CurrVxi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CurrVxi)) DEALLOCATE(OutData%CurrVxi) - ALLOCATE(OutData%CurrVxi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CurrVxi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CurrVxi,1), UBOUND(OutData%CurrVxi,1) - OutData%CurrVxi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CurrVyi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CurrVyi)) DEALLOCATE(OutData%CurrVyi) - ALLOCATE(OutData%CurrVyi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CurrVyi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%CurrVyi,1), UBOUND(OutData%CurrVyi,1) - OutData%CurrVyi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%PCurrVxiPz0 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%PCurrVyiPz0 = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_UnpackNWTC_RandomNumber_ParameterType( Re_Buf, Db_Buf, Int_Buf, OutData%RNG, ErrStat2, ErrMsg2 ) ! RNG - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE Waves_UnPackInitInput - - SUBROUTINE Waves_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Waves_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(Waves_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_CopyInitOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInitOutputData%WaveElevC0)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveElevC0,1) - i1_u = UBOUND(SrcInitOutputData%WaveElevC0,1) - i2_l = LBOUND(SrcInitOutputData%WaveElevC0,2) - i2_u = UBOUND(SrcInitOutputData%WaveElevC0,2) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveElevC0)) THEN - ALLOCATE(DstInitOutputData%WaveElevC0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveElevC0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveElevC0 = SrcInitOutputData%WaveElevC0 -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveDirArr)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveDirArr,1) - i1_u = UBOUND(SrcInitOutputData%WaveDirArr,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveDirArr)) THEN - ALLOCATE(DstInitOutputData%WaveDirArr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveDirArr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveDirArr = SrcInitOutputData%WaveDirArr -ENDIF - DstInitOutputData%WaveDirMin = SrcInitOutputData%WaveDirMin - DstInitOutputData%WaveDirMax = SrcInitOutputData%WaveDirMax - DstInitOutputData%WaveDir = SrcInitOutputData%WaveDir - DstInitOutputData%WaveNDir = SrcInitOutputData%WaveNDir - DstInitOutputData%WaveMultiDir = SrcInitOutputData%WaveMultiDir - DstInitOutputData%WaveDOmega = SrcInitOutputData%WaveDOmega -IF (ALLOCATED(SrcInitOutputData%WaveKinzi)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveKinzi,1) - i1_u = UBOUND(SrcInitOutputData%WaveKinzi,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveKinzi)) THEN - ALLOCATE(DstInitOutputData%WaveKinzi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveKinzi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveKinzi = SrcInitOutputData%WaveKinzi -ENDIF -IF (ALLOCATED(SrcInitOutputData%PWaveDynP0)) THEN - i1_l = LBOUND(SrcInitOutputData%PWaveDynP0,1) - i1_u = UBOUND(SrcInitOutputData%PWaveDynP0,1) - i2_l = LBOUND(SrcInitOutputData%PWaveDynP0,2) - i2_u = UBOUND(SrcInitOutputData%PWaveDynP0,2) - IF (.NOT. ALLOCATED(DstInitOutputData%PWaveDynP0)) THEN - ALLOCATE(DstInitOutputData%PWaveDynP0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%PWaveDynP0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%PWaveDynP0 = SrcInitOutputData%PWaveDynP0 -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveDynP)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveDynP,1) - i1_u = UBOUND(SrcInitOutputData%WaveDynP,1) - i2_l = LBOUND(SrcInitOutputData%WaveDynP,2) - i2_u = UBOUND(SrcInitOutputData%WaveDynP,2) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveDynP)) THEN - ALLOCATE(DstInitOutputData%WaveDynP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveDynP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveDynP = SrcInitOutputData%WaveDynP -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveAcc)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveAcc,1) - i1_u = UBOUND(SrcInitOutputData%WaveAcc,1) - i2_l = LBOUND(SrcInitOutputData%WaveAcc,2) - i2_u = UBOUND(SrcInitOutputData%WaveAcc,2) - i3_l = LBOUND(SrcInitOutputData%WaveAcc,3) - i3_u = UBOUND(SrcInitOutputData%WaveAcc,3) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveAcc)) THEN - ALLOCATE(DstInitOutputData%WaveAcc(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveAcc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveAcc = SrcInitOutputData%WaveAcc -ENDIF -IF (ALLOCATED(SrcInitOutputData%PWaveAcc0)) THEN - i1_l = LBOUND(SrcInitOutputData%PWaveAcc0,1) - i1_u = UBOUND(SrcInitOutputData%PWaveAcc0,1) - i2_l = LBOUND(SrcInitOutputData%PWaveAcc0,2) - i2_u = UBOUND(SrcInitOutputData%PWaveAcc0,2) - i3_l = LBOUND(SrcInitOutputData%PWaveAcc0,3) - i3_u = UBOUND(SrcInitOutputData%PWaveAcc0,3) - IF (.NOT. ALLOCATED(DstInitOutputData%PWaveAcc0)) THEN - ALLOCATE(DstInitOutputData%PWaveAcc0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%PWaveAcc0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%PWaveAcc0 = SrcInitOutputData%PWaveAcc0 -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveVel)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveVel,1) - i1_u = UBOUND(SrcInitOutputData%WaveVel,1) - i2_l = LBOUND(SrcInitOutputData%WaveVel,2) - i2_u = UBOUND(SrcInitOutputData%WaveVel,2) - i3_l = LBOUND(SrcInitOutputData%WaveVel,3) - i3_u = UBOUND(SrcInitOutputData%WaveVel,3) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveVel)) THEN - ALLOCATE(DstInitOutputData%WaveVel(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveVel = SrcInitOutputData%WaveVel -ENDIF -IF (ALLOCATED(SrcInitOutputData%PWaveVel0)) THEN - i1_l = LBOUND(SrcInitOutputData%PWaveVel0,1) - i1_u = UBOUND(SrcInitOutputData%PWaveVel0,1) - i2_l = LBOUND(SrcInitOutputData%PWaveVel0,2) - i2_u = UBOUND(SrcInitOutputData%PWaveVel0,2) - i3_l = LBOUND(SrcInitOutputData%PWaveVel0,3) - i3_u = UBOUND(SrcInitOutputData%PWaveVel0,3) - IF (.NOT. ALLOCATED(DstInitOutputData%PWaveVel0)) THEN - ALLOCATE(DstInitOutputData%PWaveVel0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%PWaveVel0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%PWaveVel0 = SrcInitOutputData%PWaveVel0 -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveElev)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveElev,1) - i1_u = UBOUND(SrcInitOutputData%WaveElev,1) - i2_l = LBOUND(SrcInitOutputData%WaveElev,2) - i2_u = UBOUND(SrcInitOutputData%WaveElev,2) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveElev)) THEN - ALLOCATE(DstInitOutputData%WaveElev(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveElev.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveElev = SrcInitOutputData%WaveElev -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveElev0)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveElev0,1) - i1_u = UBOUND(SrcInitOutputData%WaveElev0,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveElev0)) THEN - ALLOCATE(DstInitOutputData%WaveElev0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveElev0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveElev0 = SrcInitOutputData%WaveElev0 -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveElevMD)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveElevMD,1) - i1_u = UBOUND(SrcInitOutputData%WaveElevMD,1) - i2_l = LBOUND(SrcInitOutputData%WaveElevMD,2) - i2_u = UBOUND(SrcInitOutputData%WaveElevMD,2) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveElevMD)) THEN - ALLOCATE(DstInitOutputData%WaveElevMD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveElevMD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveElevMD = SrcInitOutputData%WaveElevMD -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveElevSeries)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveElevSeries,1) - i1_u = UBOUND(SrcInitOutputData%WaveElevSeries,1) - i2_l = LBOUND(SrcInitOutputData%WaveElevSeries,2) - i2_u = UBOUND(SrcInitOutputData%WaveElevSeries,2) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveElevSeries)) THEN - ALLOCATE(DstInitOutputData%WaveElevSeries(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveElevSeries.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveElevSeries = SrcInitOutputData%WaveElevSeries -ENDIF -IF (ALLOCATED(SrcInitOutputData%WaveTime)) THEN - i1_l = LBOUND(SrcInitOutputData%WaveTime,1) - i1_u = UBOUND(SrcInitOutputData%WaveTime,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WaveTime)) THEN - ALLOCATE(DstInitOutputData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WaveTime = SrcInitOutputData%WaveTime -ENDIF - DstInitOutputData%WaveTMax = SrcInitOutputData%WaveTMax -IF (ALLOCATED(SrcInitOutputData%nodeInWater)) THEN - i1_l = LBOUND(SrcInitOutputData%nodeInWater,1) - i1_u = UBOUND(SrcInitOutputData%nodeInWater,1) - i2_l = LBOUND(SrcInitOutputData%nodeInWater,2) - i2_u = UBOUND(SrcInitOutputData%nodeInWater,2) - IF (.NOT. ALLOCATED(DstInitOutputData%nodeInWater)) THEN - ALLOCATE(DstInitOutputData%nodeInWater(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%nodeInWater.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%nodeInWater = SrcInitOutputData%nodeInWater -ENDIF - DstInitOutputData%RhoXg = SrcInitOutputData%RhoXg - DstInitOutputData%NStepWave = SrcInitOutputData%NStepWave - DstInitOutputData%NStepWave2 = SrcInitOutputData%NStepWave2 - END SUBROUTINE Waves_CopyInitOutput - - SUBROUTINE Waves_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(Waves_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_DestroyInitOutput' - - ErrStat = ErrID_None - ErrMsg = "" - -IF (ALLOCATED(InitOutputData%WaveElevC0)) THEN - DEALLOCATE(InitOutputData%WaveElevC0) -ENDIF -IF (ALLOCATED(InitOutputData%WaveDirArr)) THEN - DEALLOCATE(InitOutputData%WaveDirArr) -ENDIF -IF (ALLOCATED(InitOutputData%WaveKinzi)) THEN - DEALLOCATE(InitOutputData%WaveKinzi) -ENDIF -IF (ALLOCATED(InitOutputData%PWaveDynP0)) THEN - DEALLOCATE(InitOutputData%PWaveDynP0) -ENDIF -IF (ALLOCATED(InitOutputData%WaveDynP)) THEN - DEALLOCATE(InitOutputData%WaveDynP) -ENDIF -IF (ALLOCATED(InitOutputData%WaveAcc)) THEN - DEALLOCATE(InitOutputData%WaveAcc) -ENDIF -IF (ALLOCATED(InitOutputData%PWaveAcc0)) THEN - DEALLOCATE(InitOutputData%PWaveAcc0) -ENDIF -IF (ALLOCATED(InitOutputData%WaveVel)) THEN - DEALLOCATE(InitOutputData%WaveVel) -ENDIF -IF (ALLOCATED(InitOutputData%PWaveVel0)) THEN - DEALLOCATE(InitOutputData%PWaveVel0) -ENDIF -IF (ALLOCATED(InitOutputData%WaveElev)) THEN - DEALLOCATE(InitOutputData%WaveElev) -ENDIF -IF (ALLOCATED(InitOutputData%WaveElev0)) THEN - DEALLOCATE(InitOutputData%WaveElev0) -ENDIF -IF (ALLOCATED(InitOutputData%WaveElevMD)) THEN - DEALLOCATE(InitOutputData%WaveElevMD) -ENDIF -IF (ALLOCATED(InitOutputData%WaveElevSeries)) THEN - DEALLOCATE(InitOutputData%WaveElevSeries) -ENDIF -IF (ALLOCATED(InitOutputData%WaveTime)) THEN - DEALLOCATE(InitOutputData%WaveTime) -ENDIF -IF (ALLOCATED(InitOutputData%nodeInWater)) THEN - DEALLOCATE(InitOutputData%nodeInWater) -ENDIF - END SUBROUTINE Waves_DestroyInitOutput - - SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Waves_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! WaveElevC0 allocated yes/no - IF ( ALLOCATED(InData%WaveElevC0) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveElevC0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElevC0) ! WaveElevC0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveDirArr allocated yes/no - IF ( ALLOCATED(InData%WaveDirArr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveDirArr upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveDirArr) ! WaveDirArr - END IF - Re_BufSz = Re_BufSz + 1 ! WaveDirMin - Re_BufSz = Re_BufSz + 1 ! WaveDirMax - Re_BufSz = Re_BufSz + 1 ! WaveDir - Int_BufSz = Int_BufSz + 1 ! WaveNDir - Int_BufSz = Int_BufSz + 1 ! WaveMultiDir - Re_BufSz = Re_BufSz + 1 ! WaveDOmega - Int_BufSz = Int_BufSz + 1 ! WaveKinzi allocated yes/no - IF ( ALLOCATED(InData%WaveKinzi) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveKinzi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveKinzi) ! WaveKinzi - END IF - Int_BufSz = Int_BufSz + 1 ! PWaveDynP0 allocated yes/no - IF ( ALLOCATED(InData%PWaveDynP0) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PWaveDynP0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PWaveDynP0) ! PWaveDynP0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveDynP allocated yes/no - IF ( ALLOCATED(InData%WaveDynP) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveDynP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveDynP) ! WaveDynP - END IF - Int_BufSz = Int_BufSz + 1 ! WaveAcc allocated yes/no - IF ( ALLOCATED(InData%WaveAcc) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveAcc upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveAcc) ! WaveAcc - END IF - Int_BufSz = Int_BufSz + 1 ! PWaveAcc0 allocated yes/no - IF ( ALLOCATED(InData%PWaveAcc0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PWaveAcc0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PWaveAcc0) ! PWaveAcc0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveVel allocated yes/no - IF ( ALLOCATED(InData%WaveVel) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! WaveVel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveVel) ! WaveVel - END IF - Int_BufSz = Int_BufSz + 1 ! PWaveVel0 allocated yes/no - IF ( ALLOCATED(InData%PWaveVel0) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! PWaveVel0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PWaveVel0) ! PWaveVel0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElev allocated yes/no - IF ( ALLOCATED(InData%WaveElev) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveElev upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev) ! WaveElev - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElev0 allocated yes/no - IF ( ALLOCATED(InData%WaveElev0) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveElev0 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev0) ! WaveElev0 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElevMD allocated yes/no - IF ( ALLOCATED(InData%WaveElevMD) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveElevMD upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElevMD) ! WaveElevMD - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElevSeries allocated yes/no - IF ( ALLOCATED(InData%WaveElevSeries) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! WaveElevSeries upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElevSeries) ! WaveElevSeries - END IF - Int_BufSz = Int_BufSz + 1 ! WaveTime allocated yes/no - IF ( ALLOCATED(InData%WaveTime) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveTime upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveTime) ! WaveTime - END IF - Db_BufSz = Db_BufSz + 1 ! WaveTMax - Int_BufSz = Int_BufSz + 1 ! nodeInWater allocated yes/no - IF ( ALLOCATED(InData%nodeInWater) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! nodeInWater upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%nodeInWater) ! nodeInWater - END IF - Re_BufSz = Re_BufSz + 1 ! RhoXg - Int_BufSz = Int_BufSz + 1 ! NStepWave - Int_BufSz = Int_BufSz + 1 ! NStepWave2 - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%WaveElevC0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevC0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC0,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveElevC0,2), UBOUND(InData%WaveElevC0,2) - DO i1 = LBOUND(InData%WaveElevC0,1), UBOUND(InData%WaveElevC0,1) - ReKiBuf(Re_Xferred) = InData%WaveElevC0(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveDirArr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDirArr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDirArr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveDirArr,1), UBOUND(InData%WaveDirArr,1) - ReKiBuf(Re_Xferred) = InData%WaveDirArr(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - ReKiBuf(Re_Xferred) = InData%WaveDirMin - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDirMax - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDir - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveNDir - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WaveMultiDir, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WaveDOmega - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%WaveKinzi) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveKinzi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinzi,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveKinzi,1), UBOUND(InData%WaveKinzi,1) - ReKiBuf(Re_Xferred) = InData%WaveKinzi(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PWaveDynP0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveDynP0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveDynP0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveDynP0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveDynP0,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%PWaveDynP0,2), UBOUND(InData%PWaveDynP0,2) - DO i1 = LBOUND(InData%PWaveDynP0,1), UBOUND(InData%PWaveDynP0,1) - ReKiBuf(Re_Xferred) = InData%PWaveDynP0(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveDynP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveDynP,2), UBOUND(InData%WaveDynP,2) - DO i1 = LBOUND(InData%WaveDynP,1), UBOUND(InData%WaveDynP,1) - ReKiBuf(Re_Xferred) = InData%WaveDynP(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveAcc) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveAcc,3), UBOUND(InData%WaveAcc,3) - DO i2 = LBOUND(InData%WaveAcc,2), UBOUND(InData%WaveAcc,2) - DO i1 = LBOUND(InData%WaveAcc,1), UBOUND(InData%WaveAcc,1) - ReKiBuf(Re_Xferred) = InData%WaveAcc(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PWaveAcc0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveAcc0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PWaveAcc0,3), UBOUND(InData%PWaveAcc0,3) - DO i2 = LBOUND(InData%PWaveAcc0,2), UBOUND(InData%PWaveAcc0,2) - DO i1 = LBOUND(InData%PWaveAcc0,1), UBOUND(InData%PWaveAcc0,1) - ReKiBuf(Re_Xferred) = InData%PWaveAcc0(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveVel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%WaveVel,3), UBOUND(InData%WaveVel,3) - DO i2 = LBOUND(InData%WaveVel,2), UBOUND(InData%WaveVel,2) - DO i1 = LBOUND(InData%WaveVel,1), UBOUND(InData%WaveVel,1) - ReKiBuf(Re_Xferred) = InData%WaveVel(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PWaveVel0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PWaveVel0,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%PWaveVel0,3), UBOUND(InData%PWaveVel0,3) - DO i2 = LBOUND(InData%PWaveVel0,2), UBOUND(InData%PWaveVel0,2) - DO i1 = LBOUND(InData%PWaveVel0,1), UBOUND(InData%PWaveVel0,1) - ReKiBuf(Re_Xferred) = InData%PWaveVel0(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveElev) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveElev,2), UBOUND(InData%WaveElev,2) - DO i1 = LBOUND(InData%WaveElev,1), UBOUND(InData%WaveElev,1) - ReKiBuf(Re_Xferred) = InData%WaveElev(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveElev0) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev0,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev0,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveElev0,1), UBOUND(InData%WaveElev0,1) - ReKiBuf(Re_Xferred) = InData%WaveElev0(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveElevMD) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevMD,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevMD,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevMD,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevMD,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveElevMD,2), UBOUND(InData%WaveElevMD,2) - DO i1 = LBOUND(InData%WaveElevMD,1), UBOUND(InData%WaveElevMD,1) - ReKiBuf(Re_Xferred) = InData%WaveElevMD(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveElevSeries) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevSeries,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevSeries,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevSeries,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevSeries,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%WaveElevSeries,2), UBOUND(InData%WaveElevSeries,2) - DO i1 = LBOUND(InData%WaveElevSeries,1), UBOUND(InData%WaveElevSeries,1) - ReKiBuf(Re_Xferred) = InData%WaveElevSeries(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveTime,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) - ReKiBuf(Re_Xferred) = InData%WaveTime(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - DbKiBuf(Db_Xferred) = InData%WaveTMax - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%nodeInWater) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%nodeInWater,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nodeInWater,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%nodeInWater,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nodeInWater,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%nodeInWater,2), UBOUND(InData%nodeInWater,2) - DO i1 = LBOUND(InData%nodeInWater,1), UBOUND(InData%nodeInWater,1) - IntKiBuf(Int_Xferred) = InData%nodeInWater(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - ReKiBuf(Re_Xferred) = InData%RhoXg - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepWave2 - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Waves_PackInitOutput - - SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Waves_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevC0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveElevC0)) DEALLOCATE(OutData%WaveElevC0) - ALLOCATE(OutData%WaveElevC0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveElevC0,2), UBOUND(OutData%WaveElevC0,2) - DO i1 = LBOUND(OutData%WaveElevC0,1), UBOUND(OutData%WaveElevC0,1) - OutData%WaveElevC0(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDirArr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveDirArr)) DEALLOCATE(OutData%WaveDirArr) - ALLOCATE(OutData%WaveDirArr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveDirArr,1), UBOUND(OutData%WaveDirArr,1) - OutData%WaveDirArr(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%WaveDirMin = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDirMax = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDir = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveNDir = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WaveMultiDir = TRANSFER(IntKiBuf(Int_Xferred), OutData%WaveMultiDir) - Int_Xferred = Int_Xferred + 1 - OutData%WaveDOmega = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinzi not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveKinzi)) DEALLOCATE(OutData%WaveKinzi) - ALLOCATE(OutData%WaveKinzi(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinzi.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveKinzi,1), UBOUND(OutData%WaveKinzi,1) - OutData%WaveKinzi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveDynP0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PWaveDynP0)) DEALLOCATE(OutData%PWaveDynP0) - ALLOCATE(OutData%PWaveDynP0(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveDynP0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%PWaveDynP0,2), UBOUND(OutData%PWaveDynP0,2) - DO i1 = LBOUND(OutData%PWaveDynP0,1), UBOUND(OutData%PWaveDynP0,1) - OutData%PWaveDynP0(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveDynP)) DEALLOCATE(OutData%WaveDynP) - ALLOCATE(OutData%WaveDynP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveDynP,2), UBOUND(OutData%WaveDynP,2) - DO i1 = LBOUND(OutData%WaveDynP,1), UBOUND(OutData%WaveDynP,1) - OutData%WaveDynP(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveAcc)) DEALLOCATE(OutData%WaveAcc) - ALLOCATE(OutData%WaveAcc(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveAcc,3), UBOUND(OutData%WaveAcc,3) - DO i2 = LBOUND(OutData%WaveAcc,2), UBOUND(OutData%WaveAcc,2) - DO i1 = LBOUND(OutData%WaveAcc,1), UBOUND(OutData%WaveAcc,1) - OutData%WaveAcc(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveAcc0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PWaveAcc0)) DEALLOCATE(OutData%PWaveAcc0) - ALLOCATE(OutData%PWaveAcc0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAcc0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PWaveAcc0,3), UBOUND(OutData%PWaveAcc0,3) - DO i2 = LBOUND(OutData%PWaveAcc0,2), UBOUND(OutData%PWaveAcc0,2) - DO i1 = LBOUND(OutData%PWaveAcc0,1), UBOUND(OutData%PWaveAcc0,1) - OutData%PWaveAcc0(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveVel)) DEALLOCATE(OutData%WaveVel) - ALLOCATE(OutData%WaveVel(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%WaveVel,3), UBOUND(OutData%WaveVel,3) - DO i2 = LBOUND(OutData%WaveVel,2), UBOUND(OutData%WaveVel,2) - DO i1 = LBOUND(OutData%WaveVel,1), UBOUND(OutData%WaveVel,1) - OutData%WaveVel(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveVel0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PWaveVel0)) DEALLOCATE(OutData%PWaveVel0) - ALLOCATE(OutData%PWaveVel0(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveVel0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%PWaveVel0,3), UBOUND(OutData%PWaveVel0,3) - DO i2 = LBOUND(OutData%PWaveVel0,2), UBOUND(OutData%PWaveVel0,2) - DO i1 = LBOUND(OutData%PWaveVel0,1), UBOUND(OutData%PWaveVel0,1) - OutData%PWaveVel0(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveElev)) DEALLOCATE(OutData%WaveElev) - ALLOCATE(OutData%WaveElev(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveElev,2), UBOUND(OutData%WaveElev,2) - DO i1 = LBOUND(OutData%WaveElev,1), UBOUND(OutData%WaveElev,1) - OutData%WaveElev(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev0 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveElev0)) DEALLOCATE(OutData%WaveElev0) - ALLOCATE(OutData%WaveElev0(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveElev0,1), UBOUND(OutData%WaveElev0,1) - OutData%WaveElev0(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevMD not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveElevMD)) DEALLOCATE(OutData%WaveElevMD) - ALLOCATE(OutData%WaveElevMD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevMD.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveElevMD,2), UBOUND(OutData%WaveElevMD,2) - DO i1 = LBOUND(OutData%WaveElevMD,1), UBOUND(OutData%WaveElevMD,1) - OutData%WaveElevMD(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevSeries not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveElevSeries)) DEALLOCATE(OutData%WaveElevSeries) - ALLOCATE(OutData%WaveElevSeries(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevSeries.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%WaveElevSeries,2), UBOUND(OutData%WaveElevSeries,2) - DO i1 = LBOUND(OutData%WaveElevSeries,1), UBOUND(OutData%WaveElevSeries,1) - OutData%WaveElevSeries(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveTime)) DEALLOCATE(OutData%WaveTime) - ALLOCATE(OutData%WaveTime(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) - OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%WaveTMax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nodeInWater not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%nodeInWater)) DEALLOCATE(OutData%nodeInWater) - ALLOCATE(OutData%nodeInWater(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nodeInWater.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%nodeInWater,2), UBOUND(OutData%nodeInWater,2) - DO i1 = LBOUND(OutData%nodeInWater,1), UBOUND(OutData%nodeInWater,1) - OutData%nodeInWater(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - OutData%RhoXg = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%NStepWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NStepWave2 = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Waves_UnPackInitOutput - - SUBROUTINE Waves_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Waves_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(Waves_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%DummyContState = SrcContStateData%DummyContState - END SUBROUTINE Waves_CopyContState - - SUBROUTINE Waves_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(Waves_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_DestroyContState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Waves_DestroyContState - - SUBROUTINE Waves_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Waves_ContinuousStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_PackContState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyContState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Waves_PackContState - - SUBROUTINE Waves_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Waves_ContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_UnPackContState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyContState = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Waves_UnPackContState - - SUBROUTINE Waves_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Waves_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(Waves_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%DummyDiscState = SrcDiscStateData%DummyDiscState - END SUBROUTINE Waves_CopyDiscState - - SUBROUTINE Waves_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(Waves_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_DestroyDiscState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Waves_DestroyDiscState - - SUBROUTINE Waves_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Waves_DiscreteStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_PackDiscState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyDiscState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Waves_PackDiscState - - SUBROUTINE Waves_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Waves_DiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_UnPackDiscState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyDiscState = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Waves_UnPackDiscState - - SUBROUTINE Waves_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Waves_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(Waves_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE Waves_CopyConstrState - - SUBROUTINE Waves_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(Waves_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_DestroyConstrState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Waves_DestroyConstrState - - SUBROUTINE Waves_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Waves_ConstraintStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_PackConstrState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyConstrState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Waves_PackConstrState - - SUBROUTINE Waves_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Waves_ConstraintStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_UnPackConstrState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyConstrState = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Waves_UnPackConstrState - - SUBROUTINE Waves_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Waves_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(Waves_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState - END SUBROUTINE Waves_CopyOtherState - - SUBROUTINE Waves_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(Waves_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_DestroyOtherState' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Waves_DestroyOtherState - - SUBROUTINE Waves_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Waves_OtherStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_PackOtherState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! DummyOtherState - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%DummyOtherState - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Waves_PackOtherState - - SUBROUTINE Waves_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Waves_OtherStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_UnPackOtherState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyOtherState = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Waves_UnPackOtherState - - SUBROUTINE Waves_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Waves_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(Waves_MiscVarType), INTENT(INOUT) :: DstMiscData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" - DstMiscData%DummyMiscVar = SrcMiscData%DummyMiscVar - END SUBROUTINE Waves_CopyMisc - - SUBROUTINE Waves_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(Waves_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_DestroyMisc' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Waves_DestroyMisc - - SUBROUTINE Waves_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Waves_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! DummyMiscVar - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%DummyMiscVar - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Waves_PackMisc - - SUBROUTINE Waves_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Waves_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyMiscVar = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Waves_UnPackMisc - - SUBROUTINE Waves_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Waves_ParameterType), INTENT(IN) :: SrcParamData - TYPE(Waves_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT - DstParamData%WaveTMax = SrcParamData%WaveTMax - DstParamData%NStepWave = SrcParamData%NStepWave - DstParamData%WaveNDir = SrcParamData%WaveNDir - DstParamData%WaveMultiDir = SrcParamData%WaveMultiDir - END SUBROUTINE Waves_CopyParam - - SUBROUTINE Waves_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(Waves_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_DestroyParam' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Waves_DestroyParam - - SUBROUTINE Waves_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Waves_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! DT - Db_BufSz = Db_BufSz + 1 ! WaveTMax - Int_BufSz = Int_BufSz + 1 ! NStepWave - Int_BufSz = Int_BufSz + 1 ! WaveNDir - Int_BufSz = Int_BufSz + 1 ! WaveMultiDir - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf(Db_Xferred) = InData%DT - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%WaveTMax - Db_Xferred = Db_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%WaveNDir - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = TRANSFER(InData%WaveMultiDir, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Waves_PackParam - - SUBROUTINE Waves_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Waves_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DT = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%WaveTMax = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%NStepWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WaveNDir = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%WaveMultiDir = TRANSFER(IntKiBuf(Int_Xferred), OutData%WaveMultiDir) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Waves_UnPackParam - - SUBROUTINE Waves_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Waves_InputType), INTENT(IN) :: SrcInputData - TYPE(Waves_InputType), INTENT(INOUT) :: DstInputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_CopyInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInputData%DummyInput = SrcInputData%DummyInput - END SUBROUTINE Waves_CopyInput - - SUBROUTINE Waves_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(Waves_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_DestroyInput' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Waves_DestroyInput - - SUBROUTINE Waves_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Waves_InputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_PackInput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyInput - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyInput - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Waves_PackInput - - SUBROUTINE Waves_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Waves_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_UnPackInput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyInput = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Waves_UnPackInput - - SUBROUTINE Waves_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Waves_OutputType), INTENT(IN) :: SrcOutputData - TYPE(Waves_OutputType), INTENT(INOUT) :: DstOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_CopyOutput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOutputData%DummyOutput = SrcOutputData%DummyOutput - END SUBROUTINE Waves_CopyOutput - - SUBROUTINE Waves_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(Waves_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_DestroyOutput' - - ErrStat = ErrID_None - ErrMsg = "" - - END SUBROUTINE Waves_DestroyOutput - - SUBROUTINE Waves_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Waves_OutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_PackOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! DummyOutput - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%DummyOutput - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Waves_PackOutput - - SUBROUTINE Waves_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Waves_OutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_UnPackOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%DummyOutput = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE Waves_UnPackOutput - - - SUBROUTINE Waves_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(Waves_InputType), INTENT(IN) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(Waves_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_Input_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(u)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(u) - 1 - IF ( order .eq. 0 ) THEN - CALL Waves_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL Waves_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL Waves_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE Waves_Input_ExtrapInterp - - - SUBROUTINE Waves_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is 1. -! -! f(t) = a + b * t, or -! -! where a and b are determined as the solution to -! f(t1) = u1, f(t2) = u2 -! -!.................................................................................................................................. - - TYPE(Waves_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 - TYPE(Waves_InputType), INTENT(IN) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(Waves_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_Input_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - - ScaleFactor = t_out / t(2) - b = -(u1%DummyInput - u2%DummyInput) - u_out%DummyInput = u1%DummyInput + b * ScaleFactor - END SUBROUTINE Waves_Input_ExtrapInterp1 - - - SUBROUTINE Waves_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is 2. -! -! expressions below based on either -! -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 -! -!.................................................................................................................................. - - TYPE(Waves_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 - TYPE(Waves_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 - TYPE(Waves_InputType), INTENT(IN) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(Waves_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_Input_ExtrapInterp2' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) - b = (t(3)**2*(u1%DummyInput - u2%DummyInput) + t(2)**2*(-u1%DummyInput + u3%DummyInput))* scaleFactor - c = ( (t(2)-t(3))*u1%DummyInput + t(3)*u2%DummyInput - t(2)*u3%DummyInput ) * scaleFactor - u_out%DummyInput = u1%DummyInput + b + c * t_out - END SUBROUTINE Waves_Input_ExtrapInterp2 - - - SUBROUTINE Waves_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(Waves_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(Waves_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_Output_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(y)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(y) - 1 - IF ( order .eq. 0 ) THEN - CALL Waves_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL Waves_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL Waves_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE Waves_Output_ExtrapInterp - - - SUBROUTINE Waves_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is 1. -! -! f(t) = a + b * t, or -! -! where a and b are determined as the solution to -! f(t1) = y1, f(t2) = y2 -! -!.................................................................................................................................. - - TYPE(Waves_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 - TYPE(Waves_OutputType), INTENT(IN) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(Waves_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_Output_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - - ScaleFactor = t_out / t(2) - b = -(y1%DummyOutput - y2%DummyOutput) - y_out%DummyOutput = y1%DummyOutput + b * ScaleFactor - END SUBROUTINE Waves_Output_ExtrapInterp1 - - - SUBROUTINE Waves_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is 2. -! -! expressions below based on either -! -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 -! -!.................................................................................................................................. - - TYPE(Waves_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 - TYPE(Waves_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 - TYPE(Waves_OutputType), INTENT(IN) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(Waves_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'Waves_Output_ExtrapInterp2' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) - b = (t(3)**2*(y1%DummyOutput - y2%DummyOutput) + t(2)**2*(-y1%DummyOutput + y3%DummyOutput))* scaleFactor - c = ( (t(2)-t(3))*y1%DummyOutput + t(3)*y2%DummyOutput - t(2)*y3%DummyOutput ) * scaleFactor - y_out%DummyOutput = y1%DummyOutput + b + c * t_out - END SUBROUTINE Waves_Output_ExtrapInterp2 - -END MODULE Waves_Types -!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/inflowwind/src/IfW_FlowField.f90 b/modules/inflowwind/src/IfW_FlowField.f90 index e74b7a14f4..5a377cb28a 100644 --- a/modules/inflowwind/src/IfW_FlowField.f90 +++ b/modules/inflowwind/src/IfW_FlowField.f90 @@ -146,7 +146,6 @@ subroutine IfW_FlowField_GetVelAcc(FF, IStart, Time, PositionXYZ, VelocityUVW, A end if ! Loop throuh points and calcualate velocity and acceleration - !$OMP PARALLEL DO SCHEDULE(RUNTIME) do i = 1, NumPoints if (Position(3, i) > 0.0_ReKi) then VelocityUVW(:, i) = UniformField_GetVel(FF%Uniform, UFopVel, Position(:, i)) @@ -160,7 +159,6 @@ subroutine IfW_FlowField_GetVelAcc(FF, IStart, Time, PositionXYZ, VelocityUVW, A else ! Otherwise, only velocity requested ! Loop throuh points and calcualate velocity - !$OMP PARALLEL DO SCHEDULE(RUNTIME) do i = 1, NumPoints if (Position(3, i) > 0.0_ReKi) then VelocityUVW(:, i) = UniformField_GetVel(FF%Uniform, UFopVel, Position(:, i)) @@ -197,7 +195,6 @@ subroutine IfW_FlowField_GetVelAcc(FF, IStart, Time, PositionXYZ, VelocityUVW, A AddMeanAfterInterp = FF%Grid3D%AddMeanAfterInterp ! Loop through points - !$OMP PARALLEL DO SCHEDULE(RUNTIME) do i = 1, NumPoints ! If height < zero, set velocity/acceleration to zero, continue @@ -257,7 +254,6 @@ subroutine IfW_FlowField_GetVelAcc(FF, IStart, Time, PositionXYZ, VelocityUVW, A end if ! Loop through points - !$OMP PARALLEL DO SCHEDULE(RUNTIME) do i = 1, NumPoints ! If height greater than zero, calculate velocity, otherwise zero diff --git a/modules/nwtc-library/ModRegGen.py b/modules/nwtc-library/ModRegGen.py index fe014a2e97..82ee7d3feb 100644 --- a/modules/nwtc-library/ModRegGen.py +++ b/modules/nwtc-library/ModRegGen.py @@ -581,7 +581,7 @@ def gen_unpack_ptr(w, dt, decl, rank): for attr, punp in product([''], ['Pack', 'Unpack']): ifc_lines += f'\n\n interface Reg{punp}{attr}' funcs = [f'{punp}{attr}_{dt}{rank}'for dt, rank in product(type_map.keys(), ranks)] - lines = textwrap.wrap('module procedure :: ' + ', '.join(funcs), 80, + lines = textwrap.wrap('module procedure ' + ', '.join(funcs), 80, initial_indent=" "*6, subsequent_indent=' '*9,break_long_words=False) ifc_lines += '\n' + ' &\n'.join(lines) ifc_lines += '\n end interface' diff --git a/modules/nwtc-library/src/ModReg.f90 b/modules/nwtc-library/src/ModReg.f90 index 7d46e0b600..2dd0fd829d 100644 --- a/modules/nwtc-library/src/ModReg.f90 +++ b/modules/nwtc-library/src/ModReg.f90 @@ -20,7 +20,7 @@ module ModReg interface RegPack - module procedure :: Pack_C1, Pack_C1_Rank1, Pack_C1_Rank2, Pack_C1_Rank3, & + module procedure Pack_C1, Pack_C1_Rank1, Pack_C1_Rank2, Pack_C1_Rank3, & Pack_C1_Rank4, Pack_C1_Rank5, Pack_L1, Pack_L1_Rank1, Pack_L1_Rank2, & Pack_L1_Rank3, Pack_L1_Rank4, Pack_L1_Rank5, Pack_I4, Pack_I4_Rank1, & Pack_I4_Rank2, Pack_I4_Rank3, Pack_I4_Rank4, Pack_I4_Rank5, Pack_R4, & @@ -30,7 +30,7 @@ module ModReg end interface interface RegUnpack - module procedure :: Unpack_C1, Unpack_C1_Rank1, Unpack_C1_Rank2, & + module procedure Unpack_C1, Unpack_C1_Rank1, Unpack_C1_Rank2, & Unpack_C1_Rank3, Unpack_C1_Rank4, Unpack_C1_Rank5, Unpack_L1, & Unpack_L1_Rank1, Unpack_L1_Rank2, Unpack_L1_Rank3, Unpack_L1_Rank4, & Unpack_L1_Rank5, Unpack_I4, Unpack_I4_Rank1, Unpack_I4_Rank2, & diff --git a/modules/openfast-registry/src/registry.hpp b/modules/openfast-registry/src/registry.hpp index 53f3de5d5c..8229622d75 100644 --- a/modules/openfast-registry/src/registry.hpp +++ b/modules/openfast-registry/src/registry.hpp @@ -54,7 +54,7 @@ struct InterfaceData struct DimSpec { - size_t i; + size_t i = 0; bool is_deferred = false; bool is_pointer = false; std::string lower_bound = "1"; @@ -161,7 +161,7 @@ struct Field } // Get field rank (number of dimensions) - this->rank = this->dims.size(); + this->rank = static_cast(this->dims.size()); // Field is a pointer if any dim is a pointer this->is_pointer |= std::any_of(this->dims.begin(), this->dims.end(), diff --git a/vs-build/AeroDyn/AeroDyn_Driver.vfproj b/vs-build/AeroDyn/AeroDyn_Driver.vfproj index e4b75a5c98..8b22a773b2 100644 --- a/vs-build/AeroDyn/AeroDyn_Driver.vfproj +++ b/vs-build/AeroDyn/AeroDyn_Driver.vfproj @@ -88,6 +88,37 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -130,19 +161,19 @@ - - + + - - + + @@ -170,19 +201,19 @@ - - + + - - + + @@ -195,55 +226,24 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + - - + + @@ -262,19 +262,19 @@ - - + + - - + + @@ -299,19 +299,19 @@ - - + + - - + + @@ -379,27 +379,19 @@ - - + + - - - - - - - - - + @@ -410,30 +402,39 @@ - + - + + + + + + + + + + + + + + + + + + - - - - - - - - - + @@ -444,31 +445,6 @@ - - - - - - - - - - - - - - - - - - - - - - - - - @@ -481,27 +457,19 @@ - - + + - - - - - - - - - + @@ -513,8 +481,8 @@ - + @@ -523,8 +491,6 @@ - - @@ -535,9 +501,9 @@ - - + + @@ -545,8 +511,6 @@ - - @@ -557,15 +521,13 @@ - - + + - - @@ -576,16 +538,14 @@ - - + + - - @@ -596,15 +556,13 @@ - - + + - - @@ -615,15 +573,13 @@ - - + + - - @@ -634,15 +590,13 @@ - - + + - - @@ -653,15 +607,13 @@ - - + + - - @@ -672,15 +624,13 @@ - - + + - - @@ -691,15 +641,13 @@ - - + + - - @@ -710,15 +658,13 @@ - - + + - - @@ -729,15 +675,13 @@ - - + + - - @@ -748,15 +692,13 @@ - - + + - - @@ -767,15 +709,13 @@ - - + + - - @@ -793,8 +733,6 @@ - - @@ -812,8 +750,6 @@ - - @@ -835,13 +771,6 @@ - - - - - - - @@ -851,29 +780,46 @@ + + + + + + + + + + + + + + + + + - + - - + + - - + + diff --git a/vs-build/AeroDyn_Inflow_c_binding/AeroDyn_Inflow_c_binding.vfproj b/vs-build/AeroDyn_Inflow_c_binding/AeroDyn_Inflow_c_binding.vfproj index 5084481ecd..e1b544cdf7 100644 --- a/vs-build/AeroDyn_Inflow_c_binding/AeroDyn_Inflow_c_binding.vfproj +++ b/vs-build/AeroDyn_Inflow_c_binding/AeroDyn_Inflow_c_binding.vfproj @@ -130,31 +130,19 @@ - - - - - + - - - - - + - + - - - + - - - + - + - + @@ -476,6 +464,31 @@ + + + + + + + + + + + + + + + + + + + + + + + + + @@ -510,31 +523,6 @@ - - - - - - - - - - - - - - - - - - - - - - - - - @@ -579,10 +567,13 @@ - + + + + @@ -997,13 +988,6 @@ - - - - - - - @@ -1013,11 +997,28 @@ + + + + + + + + + + + + + + + + + - - + + diff --git a/vs-build/BeamDyn/BeamDyn.vfproj b/vs-build/BeamDyn/BeamDyn.vfproj index 97290b0f39..e5a72c25eb 100644 --- a/vs-build/BeamDyn/BeamDyn.vfproj +++ b/vs-build/BeamDyn/BeamDyn.vfproj @@ -121,175 +121,187 @@ - + + - - + + - - + + - + + + + + + + + + + + - - + + - - + + - + - - + + - - + + - + - - + + - - + + - + + - - + + - - + + - + - - + + - - + + - + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + diff --git a/vs-build/FASTlib/FASTlib.vfproj b/vs-build/FASTlib/FASTlib.vfproj index 9a91d76b80..b62392c0f7 100644 --- a/vs-build/FASTlib/FASTlib.vfproj +++ b/vs-build/FASTlib/FASTlib.vfproj @@ -157,27 +157,27 @@ - - + + - + - - - + - + - + + + @@ -186,36 +186,36 @@ - + - + - - - + - + + + - + - - - - - + - - - - - - - + + + + + - + + + + + + + - - + + @@ -224,36 +224,36 @@ - + - + - - - + - + + + - + - - - - - + - - - - - - - + + + + + - + + + + + + + - - + + @@ -267,27 +267,27 @@ - - + + - + - - - + - + - + + + @@ -305,27 +305,27 @@ - - + + - + - - - + - + - + + + @@ -343,27 +343,27 @@ - - + + - + - - - + - + - + + + @@ -381,27 +381,27 @@ - - + + - + - - - + - + - + + + @@ -419,27 +419,27 @@ - - + + - + - - - + - + - + + + @@ -480,27 +480,27 @@ - - + + - + - - - + - + - + + + @@ -521,27 +521,27 @@ - - + + - + - - - + - + - + + + @@ -564,27 +564,27 @@ - - + + - + - - - + - + - + + + @@ -599,27 +599,27 @@ - - + + - + - - - + - + - + + + @@ -643,27 +643,27 @@ - - + + - + - - - + - + - + + + @@ -685,27 +685,27 @@ - - + + - + - - - + - + - + + + @@ -729,27 +729,27 @@ - - + + - + - - - + - + - + + + @@ -763,33 +763,31 @@ - - - - + + - + - - - + - + - + + + @@ -807,27 +805,27 @@ - - + + - + - - - + - + - + + + @@ -845,27 +843,27 @@ - - + + - + - - - + - + - + + + @@ -883,27 +881,27 @@ - - + + - + - - - + - + - + + + @@ -921,27 +919,27 @@ - - + + - + - - - + - + - + + + @@ -950,27 +948,27 @@ - - + + - + - - - + - + - + + + @@ -1020,27 +1018,27 @@ - - + + - + - - - + - + - + + + @@ -1052,27 +1050,27 @@ - - + + - + - - - + - + - + + + @@ -1105,27 +1103,27 @@ - - + + - + - - - + - + - + + + @@ -1138,32 +1136,61 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - + + - + - - - + - + - + + + @@ -1176,35 +1203,6 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -1219,27 +1217,27 @@ - - + + - + - - - + - + - + + + @@ -1253,8 +1251,8 @@ - + @@ -1265,27 +1263,27 @@ - - + + - + - - - + - + - + + + @@ -1306,27 +1304,27 @@ - - + + - + - - - + - + - + + + @@ -1344,27 +1342,27 @@ - - + + - + - - - + - + - + + + @@ -1385,27 +1383,27 @@ - - + + - + - - - + - + - + + + @@ -1432,27 +1430,27 @@ - - + + - + - - - + - + - + + + @@ -1474,27 +1472,27 @@ - - + + - - - - - + - + + + - + + + @@ -1506,27 +1504,27 @@ - - + + - + - - - + - + - + + + @@ -1535,27 +1533,27 @@ - - + + - + - - - + - + - + + + @@ -1565,27 +1563,27 @@ - - + + - + - - - + - + - + + + @@ -1594,27 +1592,27 @@ - - + + - + - - - + - + - + + + @@ -1623,27 +1621,27 @@ - - + + - - - - - + - + + + - + + + @@ -1652,27 +1650,27 @@ - - + + - + - - - + - + - + + + @@ -1681,27 +1679,27 @@ - - + + - + - - - + - + - + + + @@ -1710,27 +1708,27 @@ - - + + - + - - - + - + - + + + @@ -1739,27 +1737,27 @@ - - + + - + - - - + - + - + + + @@ -1768,27 +1766,27 @@ - - + + - - - - - + - + + + - + + + @@ -1797,27 +1795,27 @@ - - + + - + - - - + - + - + + + @@ -1826,27 +1824,27 @@ - - + + - + - - - + - + - + + + @@ -1855,27 +1853,27 @@ - - + + - + - - - + - + - + + + @@ -1884,27 +1882,27 @@ - - + + - + - - - + - + - + + + @@ -1913,27 +1911,27 @@ - - + + - + - - - + - + - + + + @@ -1944,14 +1942,6 @@ - - - - - - - - @@ -1961,25 +1951,49 @@ + + + + + + + + + + + + + + + + + + + + + + + + - + - + - - - + + + @@ -1989,27 +2003,27 @@ - - + + - + - - - + - + - + + + @@ -2030,27 +2044,27 @@ - - + + - + - - - + - + - + + + @@ -2063,32 +2077,48 @@ + + + + + + + + + + + + + + + + - - + + - + - - - + - + - + + + @@ -2097,27 +2127,27 @@ - - + + - + - - - + - + - + + + @@ -2144,27 +2174,27 @@ - - + + - + - - - + - + - + + + @@ -2173,27 +2203,27 @@ - - + + - + - - - + - + - + + + @@ -2216,6 +2246,7 @@ + @@ -2230,27 +2261,27 @@ - - + + - + - - - + - + - + + + @@ -2268,27 +2299,27 @@ - - + + - + - - - + - + - + + + @@ -2316,27 +2347,27 @@ - - + + - + - - - + - + - + + + @@ -2363,27 +2394,27 @@ - - + + - + - - - + - + - + + + diff --git a/vs-build/HydroDyn/HydroDynDriver.vfproj b/vs-build/HydroDyn/HydroDynDriver.vfproj index db64d67385..961854b6bb 100644 --- a/vs-build/HydroDyn/HydroDynDriver.vfproj +++ b/vs-build/HydroDyn/HydroDynDriver.vfproj @@ -93,19 +93,19 @@ - - + + - - + + @@ -117,19 +117,19 @@ - - + + - - + + @@ -141,19 +141,19 @@ - - + + - - + + @@ -165,19 +165,19 @@ - - + + - - + + @@ -187,19 +187,19 @@ - - + + - - + + @@ -211,36 +211,36 @@ - - + + - - + + - - + + - - + + @@ -271,227 +271,239 @@ - - + + - - + + - + + - - + + - - + + - + + + + + + + + + + + - - + + - - + + - + - - + + - - + + - + - - + + - - + + - + + - - + + - - + + - + - - + + - - + + - + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + @@ -499,58 +511,68 @@ - - + + - - + + + + + + + + + + + + - - + + - - + + - - + + - - + + @@ -569,36 +591,36 @@ - - + + - - + + - - + + - - + + @@ -615,6 +637,7 @@ + diff --git a/vs-build/HydroDyn_c_binding/HydroDyn_c_binding.vfproj b/vs-build/HydroDyn_c_binding/HydroDyn_c_binding.vfproj index 5735fbeb4f..e7464b083b 100644 --- a/vs-build/HydroDyn_c_binding/HydroDyn_c_binding.vfproj +++ b/vs-build/HydroDyn_c_binding/HydroDyn_c_binding.vfproj @@ -108,24 +108,6 @@ - - - - - - - - - - - - - - - - - - @@ -267,7 +249,6 @@ - @@ -276,13 +257,9 @@ - - - - - + @@ -301,19 +278,168 @@ - + + + + + + + + + + + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build/InflowWind/InflowWind_driver.vfproj b/vs-build/InflowWind/InflowWind_driver.vfproj index 1db3ff0694..ceb7f5b44f 100644 --- a/vs-build/InflowWind/InflowWind_driver.vfproj +++ b/vs-build/InflowWind/InflowWind_driver.vfproj @@ -93,77 +93,77 @@ - - + + - - + + - + - + + + + + + + + + + + + + + + + + + - - + + - - - - - - - - - - - - - - - - - - - + + - - + + - + @@ -172,7 +172,7 @@ - + @@ -207,14 +207,24 @@ - + + + + + + + + + + + + - diff --git a/vs-build/InflowWind_c_binding/InflowWind_c_binding.vfproj b/vs-build/InflowWind_c_binding/InflowWind_c_binding.vfproj index b9d050e14d..49bd328500 100644 --- a/vs-build/InflowWind_c_binding/InflowWind_c_binding.vfproj +++ b/vs-build/InflowWind_c_binding/InflowWind_c_binding.vfproj @@ -93,77 +93,77 @@ - - + + - - + + - + - + + + + + + + + + + + + + + + + + + - - + + - - - - - - - - - - - - - - - - - - - + + - - + + - + @@ -172,7 +172,7 @@ - + @@ -203,14 +203,24 @@ - + + + + + + + + + + + + - diff --git a/vs-build/MAPlib/MAP_dll.vcxproj b/vs-build/MAPlib/MAP_dll.vcxproj index a6035ed653..3d09cd2bc3 100644 --- a/vs-build/MAPlib/MAP_dll.vcxproj +++ b/vs-build/MAPlib/MAP_dll.vcxproj @@ -27,28 +27,28 @@ StaticLibrary true - v140 Unicode + v140 StaticLibrary true - v140 Unicode + v140 StaticLibrary false - v140 true Unicode + v140 StaticLibrary false - v140 true Unicode + v140 @@ -213,4 +213,4 @@ - + \ No newline at end of file diff --git a/vs-build/MoorDyn/MoorDynDriver.vfproj b/vs-build/MoorDyn/MoorDynDriver.vfproj index 40e2ca66b1..42279628c3 100644 --- a/vs-build/MoorDyn/MoorDynDriver.vfproj +++ b/vs-build/MoorDyn/MoorDynDriver.vfproj @@ -109,7 +109,8 @@ - + + @@ -122,7 +123,15 @@ - + + + + + + + + + @@ -135,7 +144,7 @@ - + @@ -148,7 +157,7 @@ - + @@ -161,7 +170,8 @@ - + + @@ -174,7 +184,7 @@ - + @@ -187,7 +197,7 @@ - + diff --git a/vs-build/MoorDyn_c_binding/MoorDyn_c_binding.vfproj b/vs-build/MoorDyn_c_binding/MoorDyn_c_binding.vfproj index 0318c645e5..6d2f237551 100644 --- a/vs-build/MoorDyn_c_binding/MoorDyn_c_binding.vfproj +++ b/vs-build/MoorDyn_c_binding/MoorDyn_c_binding.vfproj @@ -129,7 +129,8 @@ - + + @@ -142,7 +143,17 @@ - + + + + + + + + + + + @@ -155,7 +166,7 @@ - + @@ -168,7 +179,7 @@ - + @@ -181,7 +192,8 @@ - + + @@ -194,7 +206,7 @@ - + @@ -207,7 +219,7 @@ - + diff --git a/vs-build/Registry/FAST_Registry.vcxproj b/vs-build/Registry/FAST_Registry.vcxproj index fbc6bded9a..209e8451f4 100644 --- a/vs-build/Registry/FAST_Registry.vcxproj +++ b/vs-build/Registry/FAST_Registry.vcxproj @@ -168,4 +168,4 @@ - + \ No newline at end of file diff --git a/vs-build/RunRegistry.bat b/vs-build/RunRegistry.bat index 7bda895acb..f7d9623019 100644 --- a/vs-build/RunRegistry.bat +++ b/vs-build/RunRegistry.bat @@ -61,6 +61,12 @@ GOTO %ModuleName% REM ---------------------------------------------------------------------------- REM ---------------- RUN THE REGISTRY TO AUTO-GENERATE FILES ------------------- REM ---------------------------------------------------------------------------- +:NWTC_Lib +SET CURR_LOC=%NWTC_Lib_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\Registry_NWTC_Library_typedef_nomesh.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" -noextrap +GOTO checkError + :MAP SET CURR_LOC=%MAP_Loc% SET Output_Loc=%CURR_LOC% @@ -137,7 +143,7 @@ GOTO checkError :DBEMT SET CURR_LOC=%AD_Loc% SET Output_Loc=%CURR_LOC% -%REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" +%REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%IfW_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" GOTO checkError :AeroDyn_Driver @@ -206,6 +212,7 @@ GOTO checkError :Waves :Waves2 :SeaState_Interp +:SeaSt_WaveField SET CURR_LOC=%SEAST_Loc% SET Output_Loc=%CURR_LOC% diff --git a/vs-build/SeaState/SeaStateDriver.vfproj b/vs-build/SeaState/SeaStateDriver.vfproj index a02ff5fdb5..0de503b1af 100644 --- a/vs-build/SeaState/SeaStateDriver.vfproj +++ b/vs-build/SeaState/SeaStateDriver.vfproj @@ -85,7 +85,8 @@ - + + @@ -98,7 +99,15 @@ - + + + + + + + + + @@ -111,7 +120,7 @@ - + @@ -124,7 +133,7 @@ - + @@ -137,7 +146,8 @@ - + + @@ -150,7 +160,7 @@ - + @@ -163,7 +173,7 @@ - + @@ -227,7 +237,8 @@ - + + @@ -262,6 +273,14 @@ + + + + + + + + @@ -335,6 +354,7 @@ + diff --git a/vs-build/SubDyn/SubDyn.vfproj b/vs-build/SubDyn/SubDyn.vfproj index 2f3257b6aa..188f4cca03 100644 --- a/vs-build/SubDyn/SubDyn.vfproj +++ b/vs-build/SubDyn/SubDyn.vfproj @@ -94,54 +94,48 @@ - - + + + + - + + + + + + + + - + - - + + - - - - - - - - - - - - + + + - - - - - - - + @@ -151,6 +145,24 @@ + + + + + + + + + + + + + + + + + + @@ -161,19 +173,19 @@ - - + + - - + + @@ -181,8 +193,8 @@ - - + + diff --git a/vs-build/TurbSim/TurbSim.vfproj b/vs-build/TurbSim/TurbSim.vfproj index 99c411e229..1f07d1efd5 100644 --- a/vs-build/TurbSim/TurbSim.vfproj +++ b/vs-build/TurbSim/TurbSim.vfproj @@ -54,6 +54,7 @@ + diff --git a/vs-build/UnsteadyAero/UnsteadyAero.vfproj b/vs-build/UnsteadyAero/UnsteadyAero.vfproj index 321fd8c587..afc6eb7f96 100644 --- a/vs-build/UnsteadyAero/UnsteadyAero.vfproj +++ b/vs-build/UnsteadyAero/UnsteadyAero.vfproj @@ -97,19 +97,19 @@ - - + + - - + + @@ -123,175 +123,187 @@ + + + + + + + + + + + - - + + - - + + - - + + - - + + - - + + - - + + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + @@ -299,19 +311,19 @@ - - + + - - + + From 0838e5fc690160e3603e82de4910af14ab4fe229 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Thu, 15 Jun 2023 21:26:05 +0000 Subject: [PATCH 11/15] Debugging FAST.Farm build time --- .../fast-farm/src/FASTWrapper_Types.f90 | 24 - glue-codes/fast-farm/src/FAST_Farm_Types.f90 | 34 -- modules/aerodyn/src/AeroAcoustics_Types.f90 | 216 --------- modules/aerodyn/src/AeroDyn_Driver_Types.f90 | 34 -- modules/aerodyn/src/AeroDyn_Inflow_Types.f90 | 34 -- modules/aerodyn/src/AeroDyn_Types.f90 | 238 ---------- modules/aerodyn/src/AirfoilInfo_Types.f90 | 14 - modules/aerodyn/src/BEMT_Types.f90 | 112 ----- modules/aerodyn/src/DBEMT_Types.f90 | 14 - modules/aerodyn/src/FVW_Types.f90 | 172 ------- modules/aerodyn/src/UnsteadyAero_Types.f90 | 124 ----- modules/aerodyn14/src/AeroDyn14_Types.f90 | 226 --------- modules/aerodyn14/src/DWM_Types.f90 | 108 ----- modules/awae/src/AWAE_Types.f90 | 129 ------ modules/beamdyn/src/BeamDyn_Types.f90 | 230 ---------- modules/elastodyn/src/ElastoDyn_Types.f90 | 434 ------------------ modules/extptfm/src/ExtPtfm_MCKF_Types.f90 | 90 ---- modules/feamooring/src/FEAMooring_Types.f90 | 132 ------ modules/hydrodyn/src/Conv_Radiation_Types.f90 | 14 - modules/hydrodyn/src/HydroDyn_Types.f90 | 90 ---- modules/hydrodyn/src/Morison_Types.f90 | 214 --------- modules/hydrodyn/src/SS_Excitation_Types.f90 | 22 - modules/hydrodyn/src/SS_Radiation_Types.f90 | 24 - modules/hydrodyn/src/WAMIT2_Types.f90 | 14 - modules/hydrodyn/src/WAMIT_Types.f90 | 34 -- modules/icedyn/src/IceDyn_Types.f90 | 40 -- modules/icefloe/src/icefloe/IceFloe_Types.f90 | 14 - .../inflowwind/src/IfW_FlowField_Types.f90 | 48 -- modules/inflowwind/src/InflowWind_Types.f90 | 55 --- modules/inflowwind/src/Lidar_Types.f90 | 18 - modules/map/src/MAP_Fortran_Types.f90 | 8 - modules/map/src/MAP_Types.f90 | 90 ---- modules/moordyn/src/MoorDyn_Types.f90 | 234 ---------- .../nwtc-library/src/NWTC_Library_Types.f90 | 16 - modules/openfast-library/src/FAST_Types.f90 | 406 ---------------- .../src/registry_gen_fortran.cpp | 4 - modules/openfoam/src/OpenFOAM_Types.f90 | 86 ---- .../src/OrcaFlexInterface_Types.f90 | 10 - modules/seastate/src/Current_Types.f90 | 6 - .../seastate/src/SeaSt_WaveField_Types.f90 | 30 -- modules/seastate/src/SeaState_Types.f90 | 37 -- modules/seastate/src/Waves2_Types.f90 | 18 - modules/seastate/src/Waves_Types.f90 | 14 - modules/servodyn/src/ServoDyn_Types.f90 | 304 ------------ modules/servodyn/src/StrucCtrl_Types.f90 | 88 ---- modules/subdyn/src/SubDyn_Types.f90 | 280 ----------- .../supercontroller/src/SCDataEx_Types.f90 | 9 - .../src/SuperController_Types.f90 | 24 - .../wakedynamics/src/WakeDynamics_Types.f90 | 108 ----- 49 files changed, 4724 deletions(-) diff --git a/glue-codes/fast-farm/src/FASTWrapper_Types.f90 b/glue-codes/fast-farm/src/FASTWrapper_Types.f90 index b1912f0fe9..0c98305606 100644 --- a/glue-codes/fast-farm/src/FASTWrapper_Types.f90 +++ b/glue-codes/fast-farm/src/FASTWrapper_Types.f90 @@ -170,8 +170,6 @@ subroutine FWrap_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err end if end if DstInitInputData%fromSCGlob = SrcInitInputData%fromSCGlob - else if (allocated(DstInitInputData%fromSCGlob)) then - deallocate(DstInitInputData%fromSCGlob) end if if (allocated(SrcInitInputData%fromSC)) then LB(1:1) = lbound(SrcInitInputData%fromSC) @@ -184,8 +182,6 @@ subroutine FWrap_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err end if end if DstInitInputData%fromSC = SrcInitInputData%fromSC - else if (allocated(DstInitInputData%fromSC)) then - deallocate(DstInitInputData%fromSC) end if DstInitInputData%Vdist_High => SrcInitInputData%Vdist_High end subroutine @@ -597,8 +593,6 @@ subroutine FWrap_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstMiscData%TempDisp)) then - deallocate(DstMiscData%TempDisp) end if if (allocated(SrcMiscData%TempLoads)) then LB(1:1) = lbound(SrcMiscData%TempLoads) @@ -615,8 +609,6 @@ subroutine FWrap_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstMiscData%TempLoads)) then - deallocate(DstMiscData%TempLoads) end if if (allocated(SrcMiscData%ADRotorDisk)) then LB(1:1) = lbound(SrcMiscData%ADRotorDisk) @@ -633,8 +625,6 @@ subroutine FWrap_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstMiscData%ADRotorDisk)) then - deallocate(DstMiscData%ADRotorDisk) end if if (allocated(SrcMiscData%AD_L2L)) then LB(1:1) = lbound(SrcMiscData%AD_L2L) @@ -651,8 +641,6 @@ subroutine FWrap_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstMiscData%AD_L2L)) then - deallocate(DstMiscData%AD_L2L) end if end subroutine @@ -849,8 +837,6 @@ subroutine FWrap_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg end if end if DstParamData%r = SrcParamData%r - else if (allocated(DstParamData%r)) then - deallocate(DstParamData%r) end if DstParamData%n_FAST_low = SrcParamData%n_FAST_low DstParamData%p_ref_Turbine = SrcParamData%p_ref_Turbine @@ -936,8 +922,6 @@ subroutine FWrap_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg end if end if DstInputData%fromSCglob = SrcInputData%fromSCglob - else if (allocated(DstInputData%fromSCglob)) then - deallocate(DstInputData%fromSCglob) end if if (allocated(SrcInputData%fromSC)) then LB(1:1) = lbound(SrcInputData%fromSC) @@ -950,8 +934,6 @@ subroutine FWrap_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg end if end if DstInputData%fromSC = SrcInputData%fromSC - else if (allocated(DstInputData%fromSC)) then - deallocate(DstInputData%fromSC) end if end subroutine @@ -1048,8 +1030,6 @@ subroutine FWrap_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err end if end if DstOutputData%toSC = SrcOutputData%toSC - else if (allocated(DstOutputData%toSC)) then - deallocate(DstOutputData%toSC) end if DstOutputData%xHat_Disk = SrcOutputData%xHat_Disk DstOutputData%YawErr = SrcOutputData%YawErr @@ -1069,8 +1049,6 @@ subroutine FWrap_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err end if end if DstOutputData%AzimAvg_Ct = SrcOutputData%AzimAvg_Ct - else if (allocated(DstOutputData%AzimAvg_Ct)) then - deallocate(DstOutputData%AzimAvg_Ct) end if if (allocated(SrcOutputData%AzimAvg_Cq)) then LB(1:1) = lbound(SrcOutputData%AzimAvg_Cq) @@ -1083,8 +1061,6 @@ subroutine FWrap_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err end if end if DstOutputData%AzimAvg_Cq = SrcOutputData%AzimAvg_Cq - else if (allocated(DstOutputData%AzimAvg_Cq)) then - deallocate(DstOutputData%AzimAvg_Cq) end if end subroutine diff --git a/glue-codes/fast-farm/src/FAST_Farm_Types.f90 b/glue-codes/fast-farm/src/FAST_Farm_Types.f90 index f5dbd1dc67..24944a649d 100644 --- a/glue-codes/fast-farm/src/FAST_Farm_Types.f90 +++ b/glue-codes/fast-farm/src/FAST_Farm_Types.f90 @@ -223,8 +223,6 @@ subroutine Farm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%WT_Position = SrcParamData%WT_Position - else if (allocated(DstParamData%WT_Position)) then - deallocate(DstParamData%WT_Position) end if DstParamData%WaveFieldMod = SrcParamData%WaveFieldMod DstParamData%MooringMod = SrcParamData%MooringMod @@ -242,8 +240,6 @@ subroutine Farm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%WT_FASTInFile = SrcParamData%WT_FASTInFile - else if (allocated(DstParamData%WT_FASTInFile)) then - deallocate(DstParamData%WT_FASTInFile) end if DstParamData%FTitle = SrcParamData%FTitle DstParamData%OutFileRoot = SrcParamData%OutFileRoot @@ -271,8 +267,6 @@ subroutine Farm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%OutRadii = SrcParamData%OutRadii - else if (allocated(DstParamData%OutRadii)) then - deallocate(DstParamData%OutRadii) end if DstParamData%NOutDist = SrcParamData%NOutDist if (allocated(SrcParamData%OutDist)) then @@ -286,8 +280,6 @@ subroutine Farm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%OutDist = SrcParamData%OutDist - else if (allocated(DstParamData%OutDist)) then - deallocate(DstParamData%OutDist) end if DstParamData%NWindVel = SrcParamData%NWindVel if (allocated(SrcParamData%WindVelX)) then @@ -301,8 +293,6 @@ subroutine Farm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%WindVelX = SrcParamData%WindVelX - else if (allocated(DstParamData%WindVelX)) then - deallocate(DstParamData%WindVelX) end if if (allocated(SrcParamData%WindVelY)) then LB(1:1) = lbound(SrcParamData%WindVelY) @@ -315,8 +305,6 @@ subroutine Farm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%WindVelY = SrcParamData%WindVelY - else if (allocated(DstParamData%WindVelY)) then - deallocate(DstParamData%WindVelY) end if if (allocated(SrcParamData%WindVelZ)) then LB(1:1) = lbound(SrcParamData%WindVelZ) @@ -329,8 +317,6 @@ subroutine Farm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%WindVelZ = SrcParamData%WindVelZ - else if (allocated(DstParamData%WindVelZ)) then - deallocate(DstParamData%WindVelZ) end if if (allocated(SrcParamData%OutParam)) then LB(1:1) = lbound(SrcParamData%OutParam) @@ -347,8 +333,6 @@ subroutine Farm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstParamData%OutParam)) then - deallocate(DstParamData%OutParam) end if DstParamData%NumOuts = SrcParamData%NumOuts DstParamData%NOutSteps = SrcParamData%NOutSteps @@ -762,8 +746,6 @@ subroutine Farm_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%AllOuts = SrcMiscData%AllOuts - else if (allocated(DstMiscData%AllOuts)) then - deallocate(DstMiscData%AllOuts) end if if (allocated(SrcMiscData%TimeData)) then LB(1:1) = lbound(SrcMiscData%TimeData) @@ -776,8 +758,6 @@ subroutine Farm_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%TimeData = SrcMiscData%TimeData - else if (allocated(DstMiscData%TimeData)) then - deallocate(DstMiscData%TimeData) end if if (allocated(SrcMiscData%AllOutData)) then LB(1:2) = lbound(SrcMiscData%AllOutData) @@ -790,8 +770,6 @@ subroutine Farm_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%AllOutData = SrcMiscData%AllOutData - else if (allocated(DstMiscData%AllOutData)) then - deallocate(DstMiscData%AllOutData) end if DstMiscData%n_Out = SrcMiscData%n_Out if (allocated(SrcMiscData%FWrap_2_MD)) then @@ -809,8 +787,6 @@ subroutine Farm_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstMiscData%FWrap_2_MD)) then - deallocate(DstMiscData%FWrap_2_MD) end if if (allocated(SrcMiscData%MD_2_FWrap)) then LB(1:1) = lbound(SrcMiscData%MD_2_FWrap) @@ -827,8 +803,6 @@ subroutine Farm_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstMiscData%MD_2_FWrap)) then - deallocate(DstMiscData%MD_2_FWrap) end if end subroutine @@ -1447,8 +1421,6 @@ subroutine Farm_CopyMD_Data(SrcMD_DataData, DstMD_DataData, CtrlCode, ErrStat, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstMD_DataData%Input)) then - deallocate(DstMD_DataData%Input) end if if (allocated(SrcMD_DataData%InputTimes)) then LB(1:1) = lbound(SrcMD_DataData%InputTimes) @@ -1461,8 +1433,6 @@ subroutine Farm_CopyMD_Data(SrcMD_DataData, DstMD_DataData, CtrlCode, ErrStat, E end if end if DstMD_DataData%InputTimes = SrcMD_DataData%InputTimes - else if (allocated(DstMD_DataData%InputTimes)) then - deallocate(DstMD_DataData%InputTimes) end if call MD_CopyOutput(SrcMD_DataData%y, DstMD_DataData%y, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1631,8 +1601,6 @@ subroutine Farm_CopyAll_FastFarm_Data(SrcAll_FastFarm_DataData, DstAll_FastFarm_ call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstAll_FastFarm_DataData%FWrap)) then - deallocate(DstAll_FastFarm_DataData%FWrap) end if if (allocated(SrcAll_FastFarm_DataData%WD)) then LB(1:1) = lbound(SrcAll_FastFarm_DataData%WD) @@ -1649,8 +1617,6 @@ subroutine Farm_CopyAll_FastFarm_Data(SrcAll_FastFarm_DataData, DstAll_FastFarm_ call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstAll_FastFarm_DataData%WD)) then - deallocate(DstAll_FastFarm_DataData%WD) end if call Farm_CopyAWAE_Data(SrcAll_FastFarm_DataData%AWAE, DstAll_FastFarm_DataData%AWAE, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) diff --git a/modules/aerodyn/src/AeroAcoustics_Types.f90 b/modules/aerodyn/src/AeroAcoustics_Types.f90 index ed449b3151..01c385f93b 100644 --- a/modules/aerodyn/src/AeroAcoustics_Types.f90 +++ b/modules/aerodyn/src/AeroAcoustics_Types.f90 @@ -350,8 +350,6 @@ subroutine AA_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta end if end if DstInitInputData%BlSpn = SrcInitInputData%BlSpn - else if (allocated(DstInitInputData%BlSpn)) then - deallocate(DstInitInputData%BlSpn) end if if (allocated(SrcInitInputData%BlChord)) then LB(1:2) = lbound(SrcInitInputData%BlChord) @@ -364,8 +362,6 @@ subroutine AA_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta end if end if DstInitInputData%BlChord = SrcInitInputData%BlChord - else if (allocated(DstInitInputData%BlChord)) then - deallocate(DstInitInputData%BlChord) end if DstInitInputData%AirDens = SrcInitInputData%AirDens DstInitInputData%KinVisc = SrcInitInputData%KinVisc @@ -382,8 +378,6 @@ subroutine AA_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta end if end if DstInitInputData%BlAFID = SrcInitInputData%BlAFID - else if (allocated(DstInitInputData%BlAFID)) then - deallocate(DstInitInputData%BlAFID) end if if (allocated(SrcInitInputData%AFInfo)) then LB(1:1) = lbound(SrcInitInputData%AFInfo) @@ -400,8 +394,6 @@ subroutine AA_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstInitInputData%AFInfo)) then - deallocate(DstInitInputData%AFInfo) end if end subroutine @@ -585,8 +577,6 @@ subroutine AA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr - else if (allocated(DstInitOutputData%WriteOutputHdr)) then - deallocate(DstInitOutputData%WriteOutputHdr) end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) @@ -599,8 +589,6 @@ subroutine AA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt - else if (allocated(DstInitOutputData%WriteOutputUnt)) then - deallocate(DstInitOutputData%WriteOutputUnt) end if if (allocated(SrcInitOutputData%WriteOutputHdrforPE)) then LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdrforPE) @@ -613,8 +601,6 @@ subroutine AA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%WriteOutputHdrforPE = SrcInitOutputData%WriteOutputHdrforPE - else if (allocated(DstInitOutputData%WriteOutputHdrforPE)) then - deallocate(DstInitOutputData%WriteOutputHdrforPE) end if if (allocated(SrcInitOutputData%WriteOutputUntforPE)) then LB(1:1) = lbound(SrcInitOutputData%WriteOutputUntforPE) @@ -627,8 +613,6 @@ subroutine AA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%WriteOutputUntforPE = SrcInitOutputData%WriteOutputUntforPE - else if (allocated(DstInitOutputData%WriteOutputUntforPE)) then - deallocate(DstInitOutputData%WriteOutputUntforPE) end if if (allocated(SrcInitOutputData%WriteOutputHdrSep)) then LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdrSep) @@ -641,8 +625,6 @@ subroutine AA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%WriteOutputHdrSep = SrcInitOutputData%WriteOutputHdrSep - else if (allocated(DstInitOutputData%WriteOutputHdrSep)) then - deallocate(DstInitOutputData%WriteOutputHdrSep) end if if (allocated(SrcInitOutputData%WriteOutputUntSep)) then LB(1:1) = lbound(SrcInitOutputData%WriteOutputUntSep) @@ -655,8 +637,6 @@ subroutine AA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%WriteOutputUntSep = SrcInitOutputData%WriteOutputUntSep - else if (allocated(DstInitOutputData%WriteOutputUntSep)) then - deallocate(DstInitOutputData%WriteOutputUntSep) end if if (allocated(SrcInitOutputData%WriteOutputHdrNodes)) then LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdrNodes) @@ -669,8 +649,6 @@ subroutine AA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%WriteOutputHdrNodes = SrcInitOutputData%WriteOutputHdrNodes - else if (allocated(DstInitOutputData%WriteOutputHdrNodes)) then - deallocate(DstInitOutputData%WriteOutputHdrNodes) end if if (allocated(SrcInitOutputData%WriteOutputUntNodes)) then LB(1:1) = lbound(SrcInitOutputData%WriteOutputUntNodes) @@ -683,8 +661,6 @@ subroutine AA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%WriteOutputUntNodes = SrcInitOutputData%WriteOutputUntNodes - else if (allocated(DstInitOutputData%WriteOutputUntNodes)) then - deallocate(DstInitOutputData%WriteOutputUntNodes) end if DstInitOutputData%delim = SrcInitOutputData%delim call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) @@ -947,8 +923,6 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end if end if DstInputFileData%ObsX = SrcInputFileData%ObsX - else if (allocated(DstInputFileData%ObsX)) then - deallocate(DstInputFileData%ObsX) end if if (allocated(SrcInputFileData%ObsY)) then LB(1:1) = lbound(SrcInputFileData%ObsY) @@ -961,8 +935,6 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end if end if DstInputFileData%ObsY = SrcInputFileData%ObsY - else if (allocated(DstInputFileData%ObsY)) then - deallocate(DstInputFileData%ObsY) end if if (allocated(SrcInputFileData%ObsZ)) then LB(1:1) = lbound(SrcInputFileData%ObsZ) @@ -975,8 +947,6 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end if end if DstInputFileData%ObsZ = SrcInputFileData%ObsZ - else if (allocated(DstInputFileData%ObsZ)) then - deallocate(DstInputFileData%ObsZ) end if if (allocated(SrcInputFileData%BladeProps)) then LB(1:1) = lbound(SrcInputFileData%BladeProps) @@ -993,8 +963,6 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstInputFileData%BladeProps)) then - deallocate(DstInputFileData%BladeProps) end if DstInputFileData%NrOutFile = SrcInputFileData%NrOutFile if (allocated(SrcInputFileData%AAoutfile)) then @@ -1008,8 +976,6 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end if end if DstInputFileData%AAoutfile = SrcInputFileData%AAoutfile - else if (allocated(DstInputFileData%AAoutfile)) then - deallocate(DstInputFileData%AAoutfile) end if DstInputFileData%TICalcTabFile = SrcInputFileData%TICalcTabFile DstInputFileData%FTitle = SrcInputFileData%FTitle @@ -1027,8 +993,6 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end if end if DstInputFileData%ReListBL = SrcInputFileData%ReListBL - else if (allocated(DstInputFileData%ReListBL)) then - deallocate(DstInputFileData%ReListBL) end if if (allocated(SrcInputFileData%AoAListBL)) then LB(1:1) = lbound(SrcInputFileData%AoAListBL) @@ -1041,8 +1005,6 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end if end if DstInputFileData%AoAListBL = SrcInputFileData%AoAListBL - else if (allocated(DstInputFileData%AoAListBL)) then - deallocate(DstInputFileData%AoAListBL) end if if (allocated(SrcInputFileData%Pres_DispThick)) then LB(1:3) = lbound(SrcInputFileData%Pres_DispThick) @@ -1055,8 +1017,6 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end if end if DstInputFileData%Pres_DispThick = SrcInputFileData%Pres_DispThick - else if (allocated(DstInputFileData%Pres_DispThick)) then - deallocate(DstInputFileData%Pres_DispThick) end if if (allocated(SrcInputFileData%Suct_DispThick)) then LB(1:3) = lbound(SrcInputFileData%Suct_DispThick) @@ -1069,8 +1029,6 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end if end if DstInputFileData%Suct_DispThick = SrcInputFileData%Suct_DispThick - else if (allocated(DstInputFileData%Suct_DispThick)) then - deallocate(DstInputFileData%Suct_DispThick) end if if (allocated(SrcInputFileData%Pres_BLThick)) then LB(1:3) = lbound(SrcInputFileData%Pres_BLThick) @@ -1083,8 +1041,6 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end if end if DstInputFileData%Pres_BLThick = SrcInputFileData%Pres_BLThick - else if (allocated(DstInputFileData%Pres_BLThick)) then - deallocate(DstInputFileData%Pres_BLThick) end if if (allocated(SrcInputFileData%Suct_BLThick)) then LB(1:3) = lbound(SrcInputFileData%Suct_BLThick) @@ -1097,8 +1053,6 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end if end if DstInputFileData%Suct_BLThick = SrcInputFileData%Suct_BLThick - else if (allocated(DstInputFileData%Suct_BLThick)) then - deallocate(DstInputFileData%Suct_BLThick) end if if (allocated(SrcInputFileData%Pres_Cf)) then LB(1:3) = lbound(SrcInputFileData%Pres_Cf) @@ -1111,8 +1065,6 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end if end if DstInputFileData%Pres_Cf = SrcInputFileData%Pres_Cf - else if (allocated(DstInputFileData%Pres_Cf)) then - deallocate(DstInputFileData%Pres_Cf) end if if (allocated(SrcInputFileData%Suct_Cf)) then LB(1:3) = lbound(SrcInputFileData%Suct_Cf) @@ -1125,8 +1077,6 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end if end if DstInputFileData%Suct_Cf = SrcInputFileData%Suct_Cf - else if (allocated(DstInputFileData%Suct_Cf)) then - deallocate(DstInputFileData%Suct_Cf) end if if (allocated(SrcInputFileData%Pres_EdgeVelRat)) then LB(1:3) = lbound(SrcInputFileData%Pres_EdgeVelRat) @@ -1139,8 +1089,6 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end if end if DstInputFileData%Pres_EdgeVelRat = SrcInputFileData%Pres_EdgeVelRat - else if (allocated(DstInputFileData%Pres_EdgeVelRat)) then - deallocate(DstInputFileData%Pres_EdgeVelRat) end if if (allocated(SrcInputFileData%Suct_EdgeVelRat)) then LB(1:3) = lbound(SrcInputFileData%Suct_EdgeVelRat) @@ -1153,8 +1101,6 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end if end if DstInputFileData%Suct_EdgeVelRat = SrcInputFileData%Suct_EdgeVelRat - else if (allocated(DstInputFileData%Suct_EdgeVelRat)) then - deallocate(DstInputFileData%Suct_EdgeVelRat) end if if (allocated(SrcInputFileData%TI_Grid_In)) then LB(1:2) = lbound(SrcInputFileData%TI_Grid_In) @@ -1167,8 +1113,6 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end if end if DstInputFileData%TI_Grid_In = SrcInputFileData%TI_Grid_In - else if (allocated(DstInputFileData%TI_Grid_In)) then - deallocate(DstInputFileData%TI_Grid_In) end if DstInputFileData%dz_turb_in = SrcInputFileData%dz_turb_in DstInputFileData%dy_turb_in = SrcInputFileData%dy_turb_in @@ -1701,8 +1645,6 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%MeanVrel = SrcDiscStateData%MeanVrel - else if (allocated(DstDiscStateData%MeanVrel)) then - deallocate(DstDiscStateData%MeanVrel) end if if (allocated(SrcDiscStateData%VrelSq)) then LB(1:2) = lbound(SrcDiscStateData%VrelSq) @@ -1715,8 +1657,6 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%VrelSq = SrcDiscStateData%VrelSq - else if (allocated(DstDiscStateData%VrelSq)) then - deallocate(DstDiscStateData%VrelSq) end if if (allocated(SrcDiscStateData%TIVrel)) then LB(1:2) = lbound(SrcDiscStateData%TIVrel) @@ -1729,8 +1669,6 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%TIVrel = SrcDiscStateData%TIVrel - else if (allocated(DstDiscStateData%TIVrel)) then - deallocate(DstDiscStateData%TIVrel) end if if (allocated(SrcDiscStateData%VrelStore)) then LB(1:3) = lbound(SrcDiscStateData%VrelStore) @@ -1743,8 +1681,6 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%VrelStore = SrcDiscStateData%VrelStore - else if (allocated(DstDiscStateData%VrelStore)) then - deallocate(DstDiscStateData%VrelStore) end if if (allocated(SrcDiscStateData%TIVx)) then LB(1:2) = lbound(SrcDiscStateData%TIVx) @@ -1757,8 +1693,6 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%TIVx = SrcDiscStateData%TIVx - else if (allocated(DstDiscStateData%TIVx)) then - deallocate(DstDiscStateData%TIVx) end if if (allocated(SrcDiscStateData%MeanVxVyVz)) then LB(1:2) = lbound(SrcDiscStateData%MeanVxVyVz) @@ -1771,8 +1705,6 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%MeanVxVyVz = SrcDiscStateData%MeanVxVyVz - else if (allocated(DstDiscStateData%MeanVxVyVz)) then - deallocate(DstDiscStateData%MeanVxVyVz) end if if (allocated(SrcDiscStateData%VxSq)) then LB(1:2) = lbound(SrcDiscStateData%VxSq) @@ -1785,8 +1717,6 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%VxSq = SrcDiscStateData%VxSq - else if (allocated(DstDiscStateData%VxSq)) then - deallocate(DstDiscStateData%VxSq) end if if (allocated(SrcDiscStateData%allregcounter)) then LB(1:2) = lbound(SrcDiscStateData%allregcounter) @@ -1799,8 +1729,6 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%allregcounter = SrcDiscStateData%allregcounter - else if (allocated(DstDiscStateData%allregcounter)) then - deallocate(DstDiscStateData%allregcounter) end if if (allocated(SrcDiscStateData%VxSqRegion)) then LB(1:2) = lbound(SrcDiscStateData%VxSqRegion) @@ -1813,8 +1741,6 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%VxSqRegion = SrcDiscStateData%VxSqRegion - else if (allocated(DstDiscStateData%VxSqRegion)) then - deallocate(DstDiscStateData%VxSqRegion) end if if (allocated(SrcDiscStateData%RegVxStor)) then LB(1:3) = lbound(SrcDiscStateData%RegVxStor) @@ -1827,8 +1753,6 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%RegVxStor = SrcDiscStateData%RegVxStor - else if (allocated(DstDiscStateData%RegVxStor)) then - deallocate(DstDiscStateData%RegVxStor) end if if (allocated(SrcDiscStateData%RegionTIDelete)) then LB(1:2) = lbound(SrcDiscStateData%RegionTIDelete) @@ -1841,8 +1765,6 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%RegionTIDelete = SrcDiscStateData%RegionTIDelete - else if (allocated(DstDiscStateData%RegionTIDelete)) then - deallocate(DstDiscStateData%RegionTIDelete) end if end subroutine @@ -2215,8 +2137,6 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%AllOuts = SrcMiscData%AllOuts - else if (allocated(DstMiscData%AllOuts)) then - deallocate(DstMiscData%AllOuts) end if if (allocated(SrcMiscData%ChordAngleTE)) then LB(1:3) = lbound(SrcMiscData%ChordAngleTE) @@ -2229,8 +2149,6 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%ChordAngleTE = SrcMiscData%ChordAngleTE - else if (allocated(DstMiscData%ChordAngleTE)) then - deallocate(DstMiscData%ChordAngleTE) end if if (allocated(SrcMiscData%SpanAngleTE)) then LB(1:3) = lbound(SrcMiscData%SpanAngleTE) @@ -2243,8 +2161,6 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%SpanAngleTE = SrcMiscData%SpanAngleTE - else if (allocated(DstMiscData%SpanAngleTE)) then - deallocate(DstMiscData%SpanAngleTE) end if if (allocated(SrcMiscData%ChordAngleLE)) then LB(1:3) = lbound(SrcMiscData%ChordAngleLE) @@ -2257,8 +2173,6 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%ChordAngleLE = SrcMiscData%ChordAngleLE - else if (allocated(DstMiscData%ChordAngleLE)) then - deallocate(DstMiscData%ChordAngleLE) end if if (allocated(SrcMiscData%SpanAngleLE)) then LB(1:3) = lbound(SrcMiscData%SpanAngleLE) @@ -2271,8 +2185,6 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%SpanAngleLE = SrcMiscData%SpanAngleLE - else if (allocated(DstMiscData%SpanAngleLE)) then - deallocate(DstMiscData%SpanAngleLE) end if if (allocated(SrcMiscData%rTEtoObserve)) then LB(1:3) = lbound(SrcMiscData%rTEtoObserve) @@ -2285,8 +2197,6 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%rTEtoObserve = SrcMiscData%rTEtoObserve - else if (allocated(DstMiscData%rTEtoObserve)) then - deallocate(DstMiscData%rTEtoObserve) end if if (allocated(SrcMiscData%rLEtoObserve)) then LB(1:3) = lbound(SrcMiscData%rLEtoObserve) @@ -2299,8 +2209,6 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%rLEtoObserve = SrcMiscData%rLEtoObserve - else if (allocated(DstMiscData%rLEtoObserve)) then - deallocate(DstMiscData%rLEtoObserve) end if if (allocated(SrcMiscData%LE_Location)) then LB(1:3) = lbound(SrcMiscData%LE_Location) @@ -2313,8 +2221,6 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%LE_Location = SrcMiscData%LE_Location - else if (allocated(DstMiscData%LE_Location)) then - deallocate(DstMiscData%LE_Location) end if DstMiscData%RotSpeedAoA = SrcMiscData%RotSpeedAoA if (allocated(SrcMiscData%SPLLBL)) then @@ -2328,8 +2234,6 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%SPLLBL = SrcMiscData%SPLLBL - else if (allocated(DstMiscData%SPLLBL)) then - deallocate(DstMiscData%SPLLBL) end if if (allocated(SrcMiscData%SPLP)) then LB(1:1) = lbound(SrcMiscData%SPLP) @@ -2342,8 +2246,6 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%SPLP = SrcMiscData%SPLP - else if (allocated(DstMiscData%SPLP)) then - deallocate(DstMiscData%SPLP) end if if (allocated(SrcMiscData%SPLS)) then LB(1:1) = lbound(SrcMiscData%SPLS) @@ -2356,8 +2258,6 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%SPLS = SrcMiscData%SPLS - else if (allocated(DstMiscData%SPLS)) then - deallocate(DstMiscData%SPLS) end if if (allocated(SrcMiscData%SPLALPH)) then LB(1:1) = lbound(SrcMiscData%SPLALPH) @@ -2370,8 +2270,6 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%SPLALPH = SrcMiscData%SPLALPH - else if (allocated(DstMiscData%SPLALPH)) then - deallocate(DstMiscData%SPLALPH) end if if (allocated(SrcMiscData%SPLTBL)) then LB(1:1) = lbound(SrcMiscData%SPLTBL) @@ -2384,8 +2282,6 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%SPLTBL = SrcMiscData%SPLTBL - else if (allocated(DstMiscData%SPLTBL)) then - deallocate(DstMiscData%SPLTBL) end if if (allocated(SrcMiscData%SPLTIP)) then LB(1:1) = lbound(SrcMiscData%SPLTIP) @@ -2398,8 +2294,6 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%SPLTIP = SrcMiscData%SPLTIP - else if (allocated(DstMiscData%SPLTIP)) then - deallocate(DstMiscData%SPLTIP) end if if (allocated(SrcMiscData%SPLTI)) then LB(1:1) = lbound(SrcMiscData%SPLTI) @@ -2412,8 +2306,6 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%SPLTI = SrcMiscData%SPLTI - else if (allocated(DstMiscData%SPLTI)) then - deallocate(DstMiscData%SPLTI) end if if (allocated(SrcMiscData%SPLTIGui)) then LB(1:1) = lbound(SrcMiscData%SPLTIGui) @@ -2426,8 +2318,6 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%SPLTIGui = SrcMiscData%SPLTIGui - else if (allocated(DstMiscData%SPLTIGui)) then - deallocate(DstMiscData%SPLTIGui) end if if (allocated(SrcMiscData%SPLBLUNT)) then LB(1:1) = lbound(SrcMiscData%SPLBLUNT) @@ -2440,8 +2330,6 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%SPLBLUNT = SrcMiscData%SPLBLUNT - else if (allocated(DstMiscData%SPLBLUNT)) then - deallocate(DstMiscData%SPLBLUNT) end if if (allocated(SrcMiscData%CfVar)) then LB(1:1) = lbound(SrcMiscData%CfVar) @@ -2454,8 +2342,6 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%CfVar = SrcMiscData%CfVar - else if (allocated(DstMiscData%CfVar)) then - deallocate(DstMiscData%CfVar) end if if (allocated(SrcMiscData%d99Var)) then LB(1:1) = lbound(SrcMiscData%d99Var) @@ -2468,8 +2354,6 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%d99Var = SrcMiscData%d99Var - else if (allocated(DstMiscData%d99Var)) then - deallocate(DstMiscData%d99Var) end if if (allocated(SrcMiscData%dStarVar)) then LB(1:1) = lbound(SrcMiscData%dStarVar) @@ -2482,8 +2366,6 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%dStarVar = SrcMiscData%dStarVar - else if (allocated(DstMiscData%dStarVar)) then - deallocate(DstMiscData%dStarVar) end if if (allocated(SrcMiscData%EdgeVelVar)) then LB(1:1) = lbound(SrcMiscData%EdgeVelVar) @@ -2496,8 +2378,6 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%EdgeVelVar = SrcMiscData%EdgeVelVar - else if (allocated(DstMiscData%EdgeVelVar)) then - deallocate(DstMiscData%EdgeVelVar) end if DstMiscData%speccou = SrcMiscData%speccou DstMiscData%filesopen = SrcMiscData%filesopen @@ -3044,8 +2924,6 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%rotorregionlimitsVert = SrcParamData%rotorregionlimitsVert - else if (allocated(DstParamData%rotorregionlimitsVert)) then - deallocate(DstParamData%rotorregionlimitsVert) end if if (allocated(SrcParamData%rotorregionlimitsHorz)) then LB(1:1) = lbound(SrcParamData%rotorregionlimitsHorz) @@ -3058,8 +2936,6 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%rotorregionlimitsHorz = SrcParamData%rotorregionlimitsHorz - else if (allocated(DstParamData%rotorregionlimitsHorz)) then - deallocate(DstParamData%rotorregionlimitsHorz) end if if (allocated(SrcParamData%rotorregionlimitsalph)) then LB(1:1) = lbound(SrcParamData%rotorregionlimitsalph) @@ -3072,8 +2948,6 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%rotorregionlimitsalph = SrcParamData%rotorregionlimitsalph - else if (allocated(DstParamData%rotorregionlimitsalph)) then - deallocate(DstParamData%rotorregionlimitsalph) end if if (allocated(SrcParamData%rotorregionlimitsrad)) then LB(1:1) = lbound(SrcParamData%rotorregionlimitsrad) @@ -3086,8 +2960,6 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%rotorregionlimitsrad = SrcParamData%rotorregionlimitsrad - else if (allocated(DstParamData%rotorregionlimitsrad)) then - deallocate(DstParamData%rotorregionlimitsrad) end if DstParamData%NrObsLoc = SrcParamData%NrObsLoc DstParamData%aweightflag = SrcParamData%aweightflag @@ -3104,8 +2976,6 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%ObsX = SrcParamData%ObsX - else if (allocated(DstParamData%ObsX)) then - deallocate(DstParamData%ObsX) end if if (allocated(SrcParamData%ObsY)) then LB(1:1) = lbound(SrcParamData%ObsY) @@ -3118,8 +2988,6 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%ObsY = SrcParamData%ObsY - else if (allocated(DstParamData%ObsY)) then - deallocate(DstParamData%ObsY) end if if (allocated(SrcParamData%ObsZ)) then LB(1:1) = lbound(SrcParamData%ObsZ) @@ -3132,8 +3000,6 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%ObsZ = SrcParamData%ObsZ - else if (allocated(DstParamData%ObsZ)) then - deallocate(DstParamData%ObsZ) end if if (allocated(SrcParamData%FreqList)) then LB(1:1) = lbound(SrcParamData%FreqList) @@ -3146,8 +3012,6 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%FreqList = SrcParamData%FreqList - else if (allocated(DstParamData%FreqList)) then - deallocate(DstParamData%FreqList) end if if (allocated(SrcParamData%Aweight)) then LB(1:1) = lbound(SrcParamData%Aweight) @@ -3160,8 +3024,6 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%Aweight = SrcParamData%Aweight - else if (allocated(DstParamData%Aweight)) then - deallocate(DstParamData%Aweight) end if DstParamData%Fsample = SrcParamData%Fsample DstParamData%total_sample = SrcParamData%total_sample @@ -3183,8 +3045,6 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%TI_Grid_In = SrcParamData%TI_Grid_In - else if (allocated(DstParamData%TI_Grid_In)) then - deallocate(DstParamData%TI_Grid_In) end if DstParamData%FTitle = SrcParamData%FTitle DstParamData%outFmt = SrcParamData%outFmt @@ -3214,8 +3074,6 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstParamData%OutParam)) then - deallocate(DstParamData%OutParam) end if if (allocated(SrcParamData%StallStart)) then LB(1:2) = lbound(SrcParamData%StallStart) @@ -3228,8 +3086,6 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%StallStart = SrcParamData%StallStart - else if (allocated(DstParamData%StallStart)) then - deallocate(DstParamData%StallStart) end if if (allocated(SrcParamData%TEThick)) then LB(1:2) = lbound(SrcParamData%TEThick) @@ -3242,8 +3098,6 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%TEThick = SrcParamData%TEThick - else if (allocated(DstParamData%TEThick)) then - deallocate(DstParamData%TEThick) end if if (allocated(SrcParamData%TEAngle)) then LB(1:2) = lbound(SrcParamData%TEAngle) @@ -3256,8 +3110,6 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%TEAngle = SrcParamData%TEAngle - else if (allocated(DstParamData%TEAngle)) then - deallocate(DstParamData%TEAngle) end if if (allocated(SrcParamData%AerCent)) then LB(1:3) = lbound(SrcParamData%AerCent) @@ -3270,8 +3122,6 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%AerCent = SrcParamData%AerCent - else if (allocated(DstParamData%AerCent)) then - deallocate(DstParamData%AerCent) end if if (allocated(SrcParamData%BlAFID)) then LB(1:2) = lbound(SrcParamData%BlAFID) @@ -3284,8 +3134,6 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%BlAFID = SrcParamData%BlAFID - else if (allocated(DstParamData%BlAFID)) then - deallocate(DstParamData%BlAFID) end if if (allocated(SrcParamData%AFInfo)) then LB(1:1) = lbound(SrcParamData%AFInfo) @@ -3302,8 +3150,6 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstParamData%AFInfo)) then - deallocate(DstParamData%AFInfo) end if if (allocated(SrcParamData%AFLECo)) then LB(1:3) = lbound(SrcParamData%AFLECo) @@ -3316,8 +3162,6 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%AFLECo = SrcParamData%AFLECo - else if (allocated(DstParamData%AFLECo)) then - deallocate(DstParamData%AFLECo) end if if (allocated(SrcParamData%AFTECo)) then LB(1:3) = lbound(SrcParamData%AFTECo) @@ -3330,8 +3174,6 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%AFTECo = SrcParamData%AFTECo - else if (allocated(DstParamData%AFTECo)) then - deallocate(DstParamData%AFTECo) end if if (allocated(SrcParamData%BlSpn)) then LB(1:2) = lbound(SrcParamData%BlSpn) @@ -3344,8 +3186,6 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%BlSpn = SrcParamData%BlSpn - else if (allocated(DstParamData%BlSpn)) then - deallocate(DstParamData%BlSpn) end if if (allocated(SrcParamData%BlChord)) then LB(1:2) = lbound(SrcParamData%BlChord) @@ -3358,8 +3198,6 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%BlChord = SrcParamData%BlChord - else if (allocated(DstParamData%BlChord)) then - deallocate(DstParamData%BlChord) end if if (allocated(SrcParamData%ReListBL)) then LB(1:1) = lbound(SrcParamData%ReListBL) @@ -3372,8 +3210,6 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%ReListBL = SrcParamData%ReListBL - else if (allocated(DstParamData%ReListBL)) then - deallocate(DstParamData%ReListBL) end if if (allocated(SrcParamData%AOAListBL)) then LB(1:1) = lbound(SrcParamData%AOAListBL) @@ -3386,8 +3222,6 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%AOAListBL = SrcParamData%AOAListBL - else if (allocated(DstParamData%AOAListBL)) then - deallocate(DstParamData%AOAListBL) end if if (allocated(SrcParamData%dStarAll1)) then LB(1:3) = lbound(SrcParamData%dStarAll1) @@ -3400,8 +3234,6 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%dStarAll1 = SrcParamData%dStarAll1 - else if (allocated(DstParamData%dStarAll1)) then - deallocate(DstParamData%dStarAll1) end if if (allocated(SrcParamData%dStarAll2)) then LB(1:3) = lbound(SrcParamData%dStarAll2) @@ -3414,8 +3246,6 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%dStarAll2 = SrcParamData%dStarAll2 - else if (allocated(DstParamData%dStarAll2)) then - deallocate(DstParamData%dStarAll2) end if if (allocated(SrcParamData%d99All1)) then LB(1:3) = lbound(SrcParamData%d99All1) @@ -3428,8 +3258,6 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%d99All1 = SrcParamData%d99All1 - else if (allocated(DstParamData%d99All1)) then - deallocate(DstParamData%d99All1) end if if (allocated(SrcParamData%d99All2)) then LB(1:3) = lbound(SrcParamData%d99All2) @@ -3442,8 +3270,6 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%d99All2 = SrcParamData%d99All2 - else if (allocated(DstParamData%d99All2)) then - deallocate(DstParamData%d99All2) end if if (allocated(SrcParamData%CfAll1)) then LB(1:3) = lbound(SrcParamData%CfAll1) @@ -3456,8 +3282,6 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%CfAll1 = SrcParamData%CfAll1 - else if (allocated(DstParamData%CfAll1)) then - deallocate(DstParamData%CfAll1) end if if (allocated(SrcParamData%CfAll2)) then LB(1:3) = lbound(SrcParamData%CfAll2) @@ -3470,8 +3294,6 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%CfAll2 = SrcParamData%CfAll2 - else if (allocated(DstParamData%CfAll2)) then - deallocate(DstParamData%CfAll2) end if if (allocated(SrcParamData%EdgeVelRat1)) then LB(1:3) = lbound(SrcParamData%EdgeVelRat1) @@ -3484,8 +3306,6 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%EdgeVelRat1 = SrcParamData%EdgeVelRat1 - else if (allocated(DstParamData%EdgeVelRat1)) then - deallocate(DstParamData%EdgeVelRat1) end if if (allocated(SrcParamData%EdgeVelRat2)) then LB(1:3) = lbound(SrcParamData%EdgeVelRat2) @@ -3498,8 +3318,6 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%EdgeVelRat2 = SrcParamData%EdgeVelRat2 - else if (allocated(DstParamData%EdgeVelRat2)) then - deallocate(DstParamData%EdgeVelRat2) end if if (allocated(SrcParamData%AFThickGuida)) then LB(1:2) = lbound(SrcParamData%AFThickGuida) @@ -3512,8 +3330,6 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%AFThickGuida = SrcParamData%AFThickGuida - else if (allocated(DstParamData%AFThickGuida)) then - deallocate(DstParamData%AFThickGuida) end if end subroutine @@ -4434,8 +4250,6 @@ subroutine AA_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%RotGtoL = SrcInputData%RotGtoL - else if (allocated(DstInputData%RotGtoL)) then - deallocate(DstInputData%RotGtoL) end if if (allocated(SrcInputData%AeroCent_G)) then LB(1:3) = lbound(SrcInputData%AeroCent_G) @@ -4448,8 +4262,6 @@ subroutine AA_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%AeroCent_G = SrcInputData%AeroCent_G - else if (allocated(DstInputData%AeroCent_G)) then - deallocate(DstInputData%AeroCent_G) end if if (allocated(SrcInputData%Vrel)) then LB(1:2) = lbound(SrcInputData%Vrel) @@ -4462,8 +4274,6 @@ subroutine AA_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%Vrel = SrcInputData%Vrel - else if (allocated(DstInputData%Vrel)) then - deallocate(DstInputData%Vrel) end if if (allocated(SrcInputData%AoANoise)) then LB(1:2) = lbound(SrcInputData%AoANoise) @@ -4476,8 +4286,6 @@ subroutine AA_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%AoANoise = SrcInputData%AoANoise - else if (allocated(DstInputData%AoANoise)) then - deallocate(DstInputData%AoANoise) end if if (allocated(SrcInputData%Inflow)) then LB(1:3) = lbound(SrcInputData%Inflow) @@ -4490,8 +4298,6 @@ subroutine AA_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%Inflow = SrcInputData%Inflow - else if (allocated(DstInputData%Inflow)) then - deallocate(DstInputData%Inflow) end if end subroutine @@ -4654,8 +4460,6 @@ subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg end if end if DstOutputData%SumSpecNoise = SrcOutputData%SumSpecNoise - else if (allocated(DstOutputData%SumSpecNoise)) then - deallocate(DstOutputData%SumSpecNoise) end if if (allocated(SrcOutputData%SumSpecNoiseSep)) then LB(1:3) = lbound(SrcOutputData%SumSpecNoiseSep) @@ -4668,8 +4472,6 @@ subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg end if end if DstOutputData%SumSpecNoiseSep = SrcOutputData%SumSpecNoiseSep - else if (allocated(DstOutputData%SumSpecNoiseSep)) then - deallocate(DstOutputData%SumSpecNoiseSep) end if if (allocated(SrcOutputData%OASPL)) then LB(1:3) = lbound(SrcOutputData%OASPL) @@ -4682,8 +4484,6 @@ subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg end if end if DstOutputData%OASPL = SrcOutputData%OASPL - else if (allocated(DstOutputData%OASPL)) then - deallocate(DstOutputData%OASPL) end if if (allocated(SrcOutputData%OASPL_Mech)) then LB(1:4) = lbound(SrcOutputData%OASPL_Mech) @@ -4696,8 +4496,6 @@ subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg end if end if DstOutputData%OASPL_Mech = SrcOutputData%OASPL_Mech - else if (allocated(DstOutputData%OASPL_Mech)) then - deallocate(DstOutputData%OASPL_Mech) end if if (allocated(SrcOutputData%DirectiviOutput)) then LB(1:1) = lbound(SrcOutputData%DirectiviOutput) @@ -4710,8 +4508,6 @@ subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg end if end if DstOutputData%DirectiviOutput = SrcOutputData%DirectiviOutput - else if (allocated(DstOutputData%DirectiviOutput)) then - deallocate(DstOutputData%DirectiviOutput) end if if (allocated(SrcOutputData%OutLECoords)) then LB(1:4) = lbound(SrcOutputData%OutLECoords) @@ -4724,8 +4520,6 @@ subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg end if end if DstOutputData%OutLECoords = SrcOutputData%OutLECoords - else if (allocated(DstOutputData%OutLECoords)) then - deallocate(DstOutputData%OutLECoords) end if if (allocated(SrcOutputData%PtotalFreq)) then LB(1:2) = lbound(SrcOutputData%PtotalFreq) @@ -4738,8 +4532,6 @@ subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg end if end if DstOutputData%PtotalFreq = SrcOutputData%PtotalFreq - else if (allocated(DstOutputData%PtotalFreq)) then - deallocate(DstOutputData%PtotalFreq) end if if (allocated(SrcOutputData%WriteOutputForPE)) then LB(1:1) = lbound(SrcOutputData%WriteOutputForPE) @@ -4752,8 +4544,6 @@ subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg end if end if DstOutputData%WriteOutputForPE = SrcOutputData%WriteOutputForPE - else if (allocated(DstOutputData%WriteOutputForPE)) then - deallocate(DstOutputData%WriteOutputForPE) end if if (allocated(SrcOutputData%WriteOutput)) then LB(1:1) = lbound(SrcOutputData%WriteOutput) @@ -4766,8 +4556,6 @@ subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg end if end if DstOutputData%WriteOutput = SrcOutputData%WriteOutput - else if (allocated(DstOutputData%WriteOutput)) then - deallocate(DstOutputData%WriteOutput) end if if (allocated(SrcOutputData%WriteOutputSep)) then LB(1:1) = lbound(SrcOutputData%WriteOutputSep) @@ -4780,8 +4568,6 @@ subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg end if end if DstOutputData%WriteOutputSep = SrcOutputData%WriteOutputSep - else if (allocated(DstOutputData%WriteOutputSep)) then - deallocate(DstOutputData%WriteOutputSep) end if if (allocated(SrcOutputData%WriteOutputNode)) then LB(1:1) = lbound(SrcOutputData%WriteOutputNode) @@ -4794,8 +4580,6 @@ subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg end if end if DstOutputData%WriteOutputNode = SrcOutputData%WriteOutputNode - else if (allocated(DstOutputData%WriteOutputNode)) then - deallocate(DstOutputData%WriteOutputNode) end if end subroutine diff --git a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 index 6191838405..38e6e53df1 100644 --- a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 @@ -352,8 +352,6 @@ subroutine AD_Dvr_CopyDvr_Outputs(SrcDvr_OutputsData, DstDvr_OutputsData, CtrlCo end if end if DstDvr_OutputsData%unOutFile = SrcDvr_OutputsData%unOutFile - else if (allocated(DstDvr_OutputsData%unOutFile)) then - deallocate(DstDvr_OutputsData%unOutFile) end if DstDvr_OutputsData%ActualChanLen = SrcDvr_OutputsData%ActualChanLen DstDvr_OutputsData%nDvrOutputs = SrcDvr_OutputsData%nDvrOutputs @@ -377,8 +375,6 @@ subroutine AD_Dvr_CopyDvr_Outputs(SrcDvr_OutputsData, DstDvr_OutputsData, CtrlCo end if end if DstDvr_OutputsData%WriteOutputHdr = SrcDvr_OutputsData%WriteOutputHdr - else if (allocated(DstDvr_OutputsData%WriteOutputHdr)) then - deallocate(DstDvr_OutputsData%WriteOutputHdr) end if if (allocated(SrcDvr_OutputsData%WriteOutputUnt)) then LB(1:1) = lbound(SrcDvr_OutputsData%WriteOutputUnt) @@ -391,8 +387,6 @@ subroutine AD_Dvr_CopyDvr_Outputs(SrcDvr_OutputsData, DstDvr_OutputsData, CtrlCo end if end if DstDvr_OutputsData%WriteOutputUnt = SrcDvr_OutputsData%WriteOutputUnt - else if (allocated(DstDvr_OutputsData%WriteOutputUnt)) then - deallocate(DstDvr_OutputsData%WriteOutputUnt) end if if (allocated(SrcDvr_OutputsData%storage)) then LB(1:3) = lbound(SrcDvr_OutputsData%storage) @@ -405,8 +399,6 @@ subroutine AD_Dvr_CopyDvr_Outputs(SrcDvr_OutputsData, DstDvr_OutputsData, CtrlCo end if end if DstDvr_OutputsData%storage = SrcDvr_OutputsData%storage - else if (allocated(DstDvr_OutputsData%storage)) then - deallocate(DstDvr_OutputsData%storage) end if if (allocated(SrcDvr_OutputsData%outLine)) then LB(1:1) = lbound(SrcDvr_OutputsData%outLine) @@ -419,8 +411,6 @@ subroutine AD_Dvr_CopyDvr_Outputs(SrcDvr_OutputsData, DstDvr_OutputsData, CtrlCo end if end if DstDvr_OutputsData%outLine = SrcDvr_OutputsData%outLine - else if (allocated(DstDvr_OutputsData%outLine)) then - deallocate(DstDvr_OutputsData%outLine) end if if (allocated(SrcDvr_OutputsData%VTK_surface)) then LB(1:1) = lbound(SrcDvr_OutputsData%VTK_surface) @@ -437,8 +427,6 @@ subroutine AD_Dvr_CopyDvr_Outputs(SrcDvr_OutputsData, DstDvr_OutputsData, CtrlCo call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstDvr_OutputsData%VTK_surface)) then - deallocate(DstDvr_OutputsData%VTK_surface) end if DstDvr_OutputsData%VTK_tWidth = SrcDvr_OutputsData%VTK_tWidth DstDvr_OutputsData%n_VTKTime = SrcDvr_OutputsData%n_VTKTime @@ -715,8 +703,6 @@ subroutine AD_Dvr_CopyBladeData(SrcBladeDataData, DstBladeDataData, CtrlCode, Er end if end if DstBladeDataData%motion = SrcBladeDataData%motion - else if (allocated(DstBladeDataData%motion)) then - deallocate(DstBladeDataData%motion) end if DstBladeDataData%motionFileName = SrcBladeDataData%motionFileName end subroutine @@ -830,8 +816,6 @@ subroutine AD_Dvr_CopyHubData(SrcHubDataData, DstHubDataData, CtrlCode, ErrStat, end if end if DstHubDataData%motion = SrcHubDataData%motion - else if (allocated(DstHubDataData%motion)) then - deallocate(DstHubDataData%motion) end if end subroutine @@ -937,8 +921,6 @@ subroutine AD_Dvr_CopyNacData(SrcNacDataData, DstNacDataData, CtrlCode, ErrStat, end if end if DstNacDataData%motion = SrcNacDataData%motion - else if (allocated(DstNacDataData%motion)) then - deallocate(DstNacDataData%motion) end if end subroutine @@ -1090,8 +1072,6 @@ subroutine AD_Dvr_CopyWTData(SrcWTDataData, DstWTDataData, CtrlCode, ErrStat, Er call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstWTDataData%map2BldPt)) then - deallocate(DstWTDataData%map2BldPt) end if if (allocated(SrcWTDataData%bld)) then LB(1:1) = lbound(SrcWTDataData%bld) @@ -1108,8 +1088,6 @@ subroutine AD_Dvr_CopyWTData(SrcWTDataData, DstWTDataData, CtrlCode, ErrStat, Er call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstWTDataData%bld)) then - deallocate(DstWTDataData%bld) end if call AD_Dvr_CopyHubData(SrcWTDataData%hub, DstWTDataData%hub, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1138,8 +1116,6 @@ subroutine AD_Dvr_CopyWTData(SrcWTDataData, DstWTDataData, CtrlCode, ErrStat, Er end if end if DstWTDataData%motion = SrcWTDataData%motion - else if (allocated(DstWTDataData%motion)) then - deallocate(DstWTDataData%motion) end if DstWTDataData%iMotion = SrcWTDataData%iMotion DstWTDataData%degreeOfFreedom = SrcWTDataData%degreeOfFreedom @@ -1157,8 +1133,6 @@ subroutine AD_Dvr_CopyWTData(SrcWTDataData, DstWTDataData, CtrlCode, ErrStat, Er end if end if DstWTDataData%WriteOutput = SrcWTDataData%WriteOutput - else if (allocated(DstWTDataData%WriteOutput)) then - deallocate(DstWTDataData%WriteOutput) end if if (allocated(SrcWTDataData%userSwapArray)) then LB(1:1) = lbound(SrcWTDataData%userSwapArray) @@ -1171,8 +1145,6 @@ subroutine AD_Dvr_CopyWTData(SrcWTDataData, DstWTDataData, CtrlCode, ErrStat, Er end if end if DstWTDataData%userSwapArray = SrcWTDataData%userSwapArray - else if (allocated(DstWTDataData%userSwapArray)) then - deallocate(DstWTDataData%userSwapArray) end if end subroutine @@ -1447,8 +1419,6 @@ subroutine AD_Dvr_CopyDvr_SimData(SrcDvr_SimDataData, DstDvr_SimDataData, CtrlCo call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstDvr_SimDataData%WT)) then - deallocate(DstDvr_SimDataData%WT) end if DstDvr_SimDataData%dT = SrcDvr_SimDataData%dT DstDvr_SimDataData%tMax = SrcDvr_SimDataData%tMax @@ -1469,8 +1439,6 @@ subroutine AD_Dvr_CopyDvr_SimData(SrcDvr_SimDataData, DstDvr_SimDataData, CtrlCo call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstDvr_SimDataData%Cases)) then - deallocate(DstDvr_SimDataData%Cases) end if DstDvr_SimDataData%iCase = SrcDvr_SimDataData%iCase if (allocated(SrcDvr_SimDataData%timeSeries)) then @@ -1484,8 +1452,6 @@ subroutine AD_Dvr_CopyDvr_SimData(SrcDvr_SimDataData, DstDvr_SimDataData, CtrlCo end if end if DstDvr_SimDataData%timeSeries = SrcDvr_SimDataData%timeSeries - else if (allocated(DstDvr_SimDataData%timeSeries)) then - deallocate(DstDvr_SimDataData%timeSeries) end if DstDvr_SimDataData%iTimeSeries = SrcDvr_SimDataData%iTimeSeries DstDvr_SimDataData%root = SrcDvr_SimDataData%root diff --git a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 index 4aa3c34ab4..c05eed0040 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 @@ -464,8 +464,6 @@ subroutine ADI_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Er end if end if DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr - else if (allocated(DstInitOutputData%WriteOutputHdr)) then - deallocate(DstInitOutputData%WriteOutputHdr) end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) @@ -478,8 +476,6 @@ subroutine ADI_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Er end if end if DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt - else if (allocated(DstInitOutputData%WriteOutputUnt)) then - deallocate(DstInitOutputData%WriteOutputUnt) end if end subroutine @@ -778,8 +774,6 @@ subroutine ADI_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstMiscData%VTK_surfaces)) then - deallocate(DstMiscData%VTK_surfaces) end if end subroutine @@ -1004,8 +998,6 @@ subroutine ADI_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs end if end if DstOutputData%HHVel = SrcOutputData%HHVel - else if (allocated(DstOutputData%HHVel)) then - deallocate(DstOutputData%HHVel) end if DstOutputData%PLExp = SrcOutputData%PLExp if (allocated(SrcOutputData%IW_WriteOutput)) then @@ -1019,8 +1011,6 @@ subroutine ADI_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs end if end if DstOutputData%IW_WriteOutput = SrcOutputData%IW_WriteOutput - else if (allocated(DstOutputData%IW_WriteOutput)) then - deallocate(DstOutputData%IW_WriteOutput) end if if (allocated(SrcOutputData%WriteOutput)) then LB(1:1) = lbound(SrcOutputData%WriteOutput) @@ -1033,8 +1023,6 @@ subroutine ADI_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs end if end if DstOutputData%WriteOutput = SrcOutputData%WriteOutput - else if (allocated(DstOutputData%WriteOutput)) then - deallocate(DstOutputData%WriteOutput) end if end subroutine @@ -1168,8 +1156,6 @@ subroutine ADI_CopyData(SrcDataData, DstDataData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstDataData%x)) then - deallocate(DstDataData%x) end if if (allocated(SrcDataData%xd)) then LB(1:1) = lbound(SrcDataData%xd) @@ -1186,8 +1172,6 @@ subroutine ADI_CopyData(SrcDataData, DstDataData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstDataData%xd)) then - deallocate(DstDataData%xd) end if if (allocated(SrcDataData%z)) then LB(1:1) = lbound(SrcDataData%z) @@ -1204,8 +1188,6 @@ subroutine ADI_CopyData(SrcDataData, DstDataData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstDataData%z)) then - deallocate(DstDataData%z) end if if (allocated(SrcDataData%OtherState)) then LB(1:1) = lbound(SrcDataData%OtherState) @@ -1222,8 +1204,6 @@ subroutine ADI_CopyData(SrcDataData, DstDataData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstDataData%OtherState)) then - deallocate(DstDataData%OtherState) end if call ADI_CopyParam(SrcDataData%p, DstDataData%p, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1246,8 +1226,6 @@ subroutine ADI_CopyData(SrcDataData, DstDataData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstDataData%u)) then - deallocate(DstDataData%u) end if call ADI_CopyOutput(SrcDataData%y, DstDataData%y, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1263,8 +1241,6 @@ subroutine ADI_CopyData(SrcDataData, DstDataData, CtrlCode, ErrStat, ErrMsg) end if end if DstDataData%inputTimes = SrcDataData%inputTimes - else if (allocated(DstDataData%inputTimes)) then - deallocate(DstDataData%inputTimes) end if end subroutine @@ -1544,8 +1520,6 @@ subroutine ADI_CopyRotFED(SrcRotFEDData, DstRotFEDData, CtrlCode, ErrStat, ErrMs call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstRotFEDData%BladeRootMotion)) then - deallocate(DstRotFEDData%BladeRootMotion) end if if (allocated(SrcRotFEDData%BladeLn2Mesh)) then LB(1:1) = lbound(SrcRotFEDData%BladeLn2Mesh) @@ -1562,8 +1536,6 @@ subroutine ADI_CopyRotFED(SrcRotFEDData, DstRotFEDData, CtrlCode, ErrStat, ErrMs call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstRotFEDData%BladeLn2Mesh)) then - deallocate(DstRotFEDData%BladeLn2Mesh) end if DstRotFEDData%hasTower = SrcRotFEDData%hasTower DstRotFEDData%rigidBlades = SrcRotFEDData%rigidBlades @@ -1589,8 +1561,6 @@ subroutine ADI_CopyRotFED(SrcRotFEDData, DstRotFEDData, CtrlCode, ErrStat, ErrMs call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstRotFEDData%AD_P_2_AD_L_B)) then - deallocate(DstRotFEDData%AD_P_2_AD_L_B) end if call NWTC_Library_CopyMeshMapType(SrcRotFEDData%ED_P_2_AD_P_TF, DstRotFEDData%ED_P_2_AD_P_TF, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1610,8 +1580,6 @@ subroutine ADI_CopyRotFED(SrcRotFEDData, DstRotFEDData, CtrlCode, ErrStat, ErrMs call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstRotFEDData%ED_P_2_AD_P_R)) then - deallocate(DstRotFEDData%ED_P_2_AD_P_R) end if call NWTC_Library_CopyMeshMapType(SrcRotFEDData%ED_P_2_AD_P_H, DstRotFEDData%ED_P_2_AD_P_H, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1864,8 +1832,6 @@ subroutine ADI_CopyFED_Data(SrcFED_DataData, DstFED_DataData, CtrlCode, ErrStat, call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstFED_DataData%WT)) then - deallocate(DstFED_DataData%WT) end if end subroutine diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index f760332580..20a83313f5 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -628,8 +628,6 @@ subroutine AD_CopyVTK_BLSurfaceType(SrcVTK_BLSurfaceTypeData, DstVTK_BLSurfaceTy end if end if DstVTK_BLSurfaceTypeData%AirfoilCoords = SrcVTK_BLSurfaceTypeData%AirfoilCoords - else if (allocated(DstVTK_BLSurfaceTypeData%AirfoilCoords)) then - deallocate(DstVTK_BLSurfaceTypeData%AirfoilCoords) end if end subroutine @@ -710,8 +708,6 @@ subroutine AD_CopyVTK_RotSurfaceType(SrcVTK_RotSurfaceTypeData, DstVTK_RotSurfac call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstVTK_RotSurfaceTypeData%BladeShape)) then - deallocate(DstVTK_RotSurfaceTypeData%BladeShape) end if if (allocated(SrcVTK_RotSurfaceTypeData%TowerRad)) then LB(1:1) = lbound(SrcVTK_RotSurfaceTypeData%TowerRad) @@ -724,8 +720,6 @@ subroutine AD_CopyVTK_RotSurfaceType(SrcVTK_RotSurfaceTypeData, DstVTK_RotSurfac end if end if DstVTK_RotSurfaceTypeData%TowerRad = SrcVTK_RotSurfaceTypeData%TowerRad - else if (allocated(DstVTK_RotSurfaceTypeData%TowerRad)) then - deallocate(DstVTK_RotSurfaceTypeData%TowerRad) end if end subroutine @@ -843,8 +837,6 @@ subroutine AD_CopyRotInitInputType(SrcRotInitInputTypeData, DstRotInitInputTypeD end if end if DstRotInitInputTypeData%BladeRootPosition = SrcRotInitInputTypeData%BladeRootPosition - else if (allocated(DstRotInitInputTypeData%BladeRootPosition)) then - deallocate(DstRotInitInputTypeData%BladeRootPosition) end if if (allocated(SrcRotInitInputTypeData%BladeRootOrientation)) then LB(1:3) = lbound(SrcRotInitInputTypeData%BladeRootOrientation) @@ -857,8 +849,6 @@ subroutine AD_CopyRotInitInputType(SrcRotInitInputTypeData, DstRotInitInputTypeD end if end if DstRotInitInputTypeData%BladeRootOrientation = SrcRotInitInputTypeData%BladeRootOrientation - else if (allocated(DstRotInitInputTypeData%BladeRootOrientation)) then - deallocate(DstRotInitInputTypeData%BladeRootOrientation) end if DstRotInitInputTypeData%NacellePosition = SrcRotInitInputTypeData%NacellePosition DstRotInitInputTypeData%NacelleOrientation = SrcRotInitInputTypeData%NacelleOrientation @@ -986,8 +976,6 @@ subroutine AD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstInitInputData%rotors)) then - deallocate(DstInitInputData%rotors) end if DstInitInputData%InputFile = SrcInitInputData%InputFile DstInitInputData%RootName = SrcInitInputData%RootName @@ -1140,8 +1128,6 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C end if end if DstBladePropsTypeData%BlSpn = SrcBladePropsTypeData%BlSpn - else if (allocated(DstBladePropsTypeData%BlSpn)) then - deallocate(DstBladePropsTypeData%BlSpn) end if if (allocated(SrcBladePropsTypeData%BlCrvAC)) then LB(1:1) = lbound(SrcBladePropsTypeData%BlCrvAC) @@ -1154,8 +1140,6 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C end if end if DstBladePropsTypeData%BlCrvAC = SrcBladePropsTypeData%BlCrvAC - else if (allocated(DstBladePropsTypeData%BlCrvAC)) then - deallocate(DstBladePropsTypeData%BlCrvAC) end if if (allocated(SrcBladePropsTypeData%BlSwpAC)) then LB(1:1) = lbound(SrcBladePropsTypeData%BlSwpAC) @@ -1168,8 +1152,6 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C end if end if DstBladePropsTypeData%BlSwpAC = SrcBladePropsTypeData%BlSwpAC - else if (allocated(DstBladePropsTypeData%BlSwpAC)) then - deallocate(DstBladePropsTypeData%BlSwpAC) end if if (allocated(SrcBladePropsTypeData%BlCrvAng)) then LB(1:1) = lbound(SrcBladePropsTypeData%BlCrvAng) @@ -1182,8 +1164,6 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C end if end if DstBladePropsTypeData%BlCrvAng = SrcBladePropsTypeData%BlCrvAng - else if (allocated(DstBladePropsTypeData%BlCrvAng)) then - deallocate(DstBladePropsTypeData%BlCrvAng) end if if (allocated(SrcBladePropsTypeData%BlTwist)) then LB(1:1) = lbound(SrcBladePropsTypeData%BlTwist) @@ -1196,8 +1176,6 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C end if end if DstBladePropsTypeData%BlTwist = SrcBladePropsTypeData%BlTwist - else if (allocated(DstBladePropsTypeData%BlTwist)) then - deallocate(DstBladePropsTypeData%BlTwist) end if if (allocated(SrcBladePropsTypeData%BlChord)) then LB(1:1) = lbound(SrcBladePropsTypeData%BlChord) @@ -1210,8 +1188,6 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C end if end if DstBladePropsTypeData%BlChord = SrcBladePropsTypeData%BlChord - else if (allocated(DstBladePropsTypeData%BlChord)) then - deallocate(DstBladePropsTypeData%BlChord) end if if (allocated(SrcBladePropsTypeData%BlAFID)) then LB(1:1) = lbound(SrcBladePropsTypeData%BlAFID) @@ -1224,8 +1200,6 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C end if end if DstBladePropsTypeData%BlAFID = SrcBladePropsTypeData%BlAFID - else if (allocated(DstBladePropsTypeData%BlAFID)) then - deallocate(DstBladePropsTypeData%BlAFID) end if if (allocated(SrcBladePropsTypeData%BlCb)) then LB(1:1) = lbound(SrcBladePropsTypeData%BlCb) @@ -1238,8 +1212,6 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C end if end if DstBladePropsTypeData%BlCb = SrcBladePropsTypeData%BlCb - else if (allocated(DstBladePropsTypeData%BlCb)) then - deallocate(DstBladePropsTypeData%BlCb) end if if (allocated(SrcBladePropsTypeData%BlCenBn)) then LB(1:1) = lbound(SrcBladePropsTypeData%BlCenBn) @@ -1252,8 +1224,6 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C end if end if DstBladePropsTypeData%BlCenBn = SrcBladePropsTypeData%BlCenBn - else if (allocated(DstBladePropsTypeData%BlCenBn)) then - deallocate(DstBladePropsTypeData%BlCenBn) end if if (allocated(SrcBladePropsTypeData%BlCenBt)) then LB(1:1) = lbound(SrcBladePropsTypeData%BlCenBt) @@ -1266,8 +1236,6 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C end if end if DstBladePropsTypeData%BlCenBt = SrcBladePropsTypeData%BlCenBt - else if (allocated(DstBladePropsTypeData%BlCenBt)) then - deallocate(DstBladePropsTypeData%BlCenBt) end if end subroutine @@ -1543,8 +1511,6 @@ subroutine AD_CopyBladeShape(SrcBladeShapeData, DstBladeShapeData, CtrlCode, Err end if end if DstBladeShapeData%AirfoilCoords = SrcBladeShapeData%AirfoilCoords - else if (allocated(DstBladeShapeData%AirfoilCoords)) then - deallocate(DstBladeShapeData%AirfoilCoords) end if end subroutine @@ -1622,8 +1588,6 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy end if end if DstRotInitOutputTypeData%WriteOutputHdr = SrcRotInitOutputTypeData%WriteOutputHdr - else if (allocated(DstRotInitOutputTypeData%WriteOutputHdr)) then - deallocate(DstRotInitOutputTypeData%WriteOutputHdr) end if if (allocated(SrcRotInitOutputTypeData%WriteOutputUnt)) then LB(1:1) = lbound(SrcRotInitOutputTypeData%WriteOutputUnt) @@ -1636,8 +1600,6 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy end if end if DstRotInitOutputTypeData%WriteOutputUnt = SrcRotInitOutputTypeData%WriteOutputUnt - else if (allocated(DstRotInitOutputTypeData%WriteOutputUnt)) then - deallocate(DstRotInitOutputTypeData%WriteOutputUnt) end if if (allocated(SrcRotInitOutputTypeData%BladeShape)) then LB(1:1) = lbound(SrcRotInitOutputTypeData%BladeShape) @@ -1654,8 +1616,6 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstRotInitOutputTypeData%BladeShape)) then - deallocate(DstRotInitOutputTypeData%BladeShape) end if if (allocated(SrcRotInitOutputTypeData%LinNames_y)) then LB(1:1) = lbound(SrcRotInitOutputTypeData%LinNames_y) @@ -1668,8 +1628,6 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy end if end if DstRotInitOutputTypeData%LinNames_y = SrcRotInitOutputTypeData%LinNames_y - else if (allocated(DstRotInitOutputTypeData%LinNames_y)) then - deallocate(DstRotInitOutputTypeData%LinNames_y) end if if (allocated(SrcRotInitOutputTypeData%LinNames_x)) then LB(1:1) = lbound(SrcRotInitOutputTypeData%LinNames_x) @@ -1682,8 +1640,6 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy end if end if DstRotInitOutputTypeData%LinNames_x = SrcRotInitOutputTypeData%LinNames_x - else if (allocated(DstRotInitOutputTypeData%LinNames_x)) then - deallocate(DstRotInitOutputTypeData%LinNames_x) end if if (allocated(SrcRotInitOutputTypeData%LinNames_u)) then LB(1:1) = lbound(SrcRotInitOutputTypeData%LinNames_u) @@ -1696,8 +1652,6 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy end if end if DstRotInitOutputTypeData%LinNames_u = SrcRotInitOutputTypeData%LinNames_u - else if (allocated(DstRotInitOutputTypeData%LinNames_u)) then - deallocate(DstRotInitOutputTypeData%LinNames_u) end if if (allocated(SrcRotInitOutputTypeData%RotFrame_y)) then LB(1:1) = lbound(SrcRotInitOutputTypeData%RotFrame_y) @@ -1710,8 +1664,6 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy end if end if DstRotInitOutputTypeData%RotFrame_y = SrcRotInitOutputTypeData%RotFrame_y - else if (allocated(DstRotInitOutputTypeData%RotFrame_y)) then - deallocate(DstRotInitOutputTypeData%RotFrame_y) end if if (allocated(SrcRotInitOutputTypeData%RotFrame_x)) then LB(1:1) = lbound(SrcRotInitOutputTypeData%RotFrame_x) @@ -1724,8 +1676,6 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy end if end if DstRotInitOutputTypeData%RotFrame_x = SrcRotInitOutputTypeData%RotFrame_x - else if (allocated(DstRotInitOutputTypeData%RotFrame_x)) then - deallocate(DstRotInitOutputTypeData%RotFrame_x) end if if (allocated(SrcRotInitOutputTypeData%RotFrame_u)) then LB(1:1) = lbound(SrcRotInitOutputTypeData%RotFrame_u) @@ -1738,8 +1688,6 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy end if end if DstRotInitOutputTypeData%RotFrame_u = SrcRotInitOutputTypeData%RotFrame_u - else if (allocated(DstRotInitOutputTypeData%RotFrame_u)) then - deallocate(DstRotInitOutputTypeData%RotFrame_u) end if if (allocated(SrcRotInitOutputTypeData%IsLoad_u)) then LB(1:1) = lbound(SrcRotInitOutputTypeData%IsLoad_u) @@ -1752,8 +1700,6 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy end if end if DstRotInitOutputTypeData%IsLoad_u = SrcRotInitOutputTypeData%IsLoad_u - else if (allocated(DstRotInitOutputTypeData%IsLoad_u)) then - deallocate(DstRotInitOutputTypeData%IsLoad_u) end if if (allocated(SrcRotInitOutputTypeData%BladeProps)) then LB(1:1) = lbound(SrcRotInitOutputTypeData%BladeProps) @@ -1770,8 +1716,6 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstRotInitOutputTypeData%BladeProps)) then - deallocate(DstRotInitOutputTypeData%BladeProps) end if if (allocated(SrcRotInitOutputTypeData%DerivOrder_x)) then LB(1:1) = lbound(SrcRotInitOutputTypeData%DerivOrder_x) @@ -1784,8 +1728,6 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy end if end if DstRotInitOutputTypeData%DerivOrder_x = SrcRotInitOutputTypeData%DerivOrder_x - else if (allocated(DstRotInitOutputTypeData%DerivOrder_x)) then - deallocate(DstRotInitOutputTypeData%DerivOrder_x) end if if (allocated(SrcRotInitOutputTypeData%TwrElev)) then LB(1:1) = lbound(SrcRotInitOutputTypeData%TwrElev) @@ -1798,8 +1740,6 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy end if end if DstRotInitOutputTypeData%TwrElev = SrcRotInitOutputTypeData%TwrElev - else if (allocated(DstRotInitOutputTypeData%TwrElev)) then - deallocate(DstRotInitOutputTypeData%TwrElev) end if if (allocated(SrcRotInitOutputTypeData%TwrDiam)) then LB(1:1) = lbound(SrcRotInitOutputTypeData%TwrDiam) @@ -1812,8 +1752,6 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy end if end if DstRotInitOutputTypeData%TwrDiam = SrcRotInitOutputTypeData%TwrDiam - else if (allocated(DstRotInitOutputTypeData%TwrDiam)) then - deallocate(DstRotInitOutputTypeData%TwrDiam) end if end subroutine @@ -2212,8 +2150,6 @@ subroutine AD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstInitOutputData%rotors)) then - deallocate(DstInitOutputData%rotors) end if call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2319,8 +2255,6 @@ subroutine AD_CopyRotInputFile(SrcRotInputFileData, DstRotInputFileData, CtrlCod call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstRotInputFileData%BladeProps)) then - deallocate(DstRotInputFileData%BladeProps) end if DstRotInputFileData%NumTwrNds = SrcRotInputFileData%NumTwrNds if (allocated(SrcRotInputFileData%TwrElev)) then @@ -2334,8 +2268,6 @@ subroutine AD_CopyRotInputFile(SrcRotInputFileData, DstRotInputFileData, CtrlCod end if end if DstRotInputFileData%TwrElev = SrcRotInputFileData%TwrElev - else if (allocated(DstRotInputFileData%TwrElev)) then - deallocate(DstRotInputFileData%TwrElev) end if if (allocated(SrcRotInputFileData%TwrDiam)) then LB(1:1) = lbound(SrcRotInputFileData%TwrDiam) @@ -2348,8 +2280,6 @@ subroutine AD_CopyRotInputFile(SrcRotInputFileData, DstRotInputFileData, CtrlCod end if end if DstRotInputFileData%TwrDiam = SrcRotInputFileData%TwrDiam - else if (allocated(DstRotInputFileData%TwrDiam)) then - deallocate(DstRotInputFileData%TwrDiam) end if if (allocated(SrcRotInputFileData%TwrCd)) then LB(1:1) = lbound(SrcRotInputFileData%TwrCd) @@ -2362,8 +2292,6 @@ subroutine AD_CopyRotInputFile(SrcRotInputFileData, DstRotInputFileData, CtrlCod end if end if DstRotInputFileData%TwrCd = SrcRotInputFileData%TwrCd - else if (allocated(DstRotInputFileData%TwrCd)) then - deallocate(DstRotInputFileData%TwrCd) end if if (allocated(SrcRotInputFileData%TwrTI)) then LB(1:1) = lbound(SrcRotInputFileData%TwrTI) @@ -2376,8 +2304,6 @@ subroutine AD_CopyRotInputFile(SrcRotInputFileData, DstRotInputFileData, CtrlCod end if end if DstRotInputFileData%TwrTI = SrcRotInputFileData%TwrTI - else if (allocated(DstRotInputFileData%TwrTI)) then - deallocate(DstRotInputFileData%TwrTI) end if if (allocated(SrcRotInputFileData%TwrCb)) then LB(1:1) = lbound(SrcRotInputFileData%TwrCb) @@ -2390,8 +2316,6 @@ subroutine AD_CopyRotInputFile(SrcRotInputFileData, DstRotInputFileData, CtrlCod end if end if DstRotInputFileData%TwrCb = SrcRotInputFileData%TwrCb - else if (allocated(DstRotInputFileData%TwrCb)) then - deallocate(DstRotInputFileData%TwrCb) end if DstRotInputFileData%VolHub = SrcRotInputFileData%VolHub DstRotInputFileData%HubCenBx = SrcRotInputFileData%HubCenBx @@ -2642,8 +2566,6 @@ subroutine AD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end if end if DstInputFileData%ADBlFile = SrcInputFileData%ADBlFile - else if (allocated(DstInputFileData%ADBlFile)) then - deallocate(DstInputFileData%ADBlFile) end if DstInputFileData%AirDens = SrcInputFileData%AirDens DstInputFileData%KinVisc = SrcInputFileData%KinVisc @@ -2680,8 +2602,6 @@ subroutine AD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end if end if DstInputFileData%AFNames = SrcInputFileData%AFNames - else if (allocated(DstInputFileData%AFNames)) then - deallocate(DstInputFileData%AFNames) end if DstInputFileData%UseBlCm = SrcInputFileData%UseBlCm DstInputFileData%SumPrint = SrcInputFileData%SumPrint @@ -2701,8 +2621,6 @@ subroutine AD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end if end if DstInputFileData%OutList = SrcInputFileData%OutList - else if (allocated(DstInputFileData%OutList)) then - deallocate(DstInputFileData%OutList) end if DstInputFileData%tau1_const = SrcInputFileData%tau1_const DstInputFileData%DBEMT_Mod = SrcInputFileData%DBEMT_Mod @@ -2718,8 +2636,6 @@ subroutine AD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end if end if DstInputFileData%BldNd_OutList = SrcInputFileData%BldNd_OutList - else if (allocated(DstInputFileData%BldNd_OutList)) then - deallocate(DstInputFileData%BldNd_OutList) end if DstInputFileData%BldNd_BlOutNd_Str = SrcInputFileData%BldNd_BlOutNd_Str DstInputFileData%BldNd_BladesOut = SrcInputFileData%BldNd_BladesOut @@ -2740,8 +2656,6 @@ subroutine AD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstInputFileData%rotors)) then - deallocate(DstInputFileData%rotors) end if end subroutine @@ -3131,8 +3045,6 @@ subroutine AD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSta call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstContStateData%rotors)) then - deallocate(DstContStateData%rotors) end if call FVW_CopyContState(SrcContStateData%FVW, DstContStateData%FVW, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3291,8 +3203,6 @@ subroutine AD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstDiscStateData%rotors)) then - deallocate(DstDiscStateData%rotors) end if call FVW_CopyDiscState(SrcDiscStateData%FVW, DstDiscStateData%FVW, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3451,8 +3361,6 @@ subroutine AD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstConstrStateData%rotors)) then - deallocate(DstConstrStateData%rotors) end if call FVW_CopyConstrState(SrcConstrStateData%FVW, DstConstrStateData%FVW, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3611,8 +3519,6 @@ subroutine AD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstOtherStateData%rotors)) then - deallocate(DstOtherStateData%rotors) end if call FVW_CopyOtherState(SrcOtherStateData%FVW, DstOtherStateData%FVW, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3628,8 +3534,6 @@ subroutine AD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err end if end if DstOtherStateData%WakeLocationPoints = SrcOtherStateData%WakeLocationPoints - else if (allocated(DstOtherStateData%WakeLocationPoints)) then - deallocate(DstOtherStateData%WakeLocationPoints) end if end subroutine @@ -3772,8 +3676,6 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C end if end if DstRotMiscVarTypeData%DisturbedInflow = SrcRotMiscVarTypeData%DisturbedInflow - else if (allocated(DstRotMiscVarTypeData%DisturbedInflow)) then - deallocate(DstRotMiscVarTypeData%DisturbedInflow) end if if (allocated(SrcRotMiscVarTypeData%orientationAnnulus)) then LB(1:4) = lbound(SrcRotMiscVarTypeData%orientationAnnulus) @@ -3786,8 +3688,6 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C end if end if DstRotMiscVarTypeData%orientationAnnulus = SrcRotMiscVarTypeData%orientationAnnulus - else if (allocated(DstRotMiscVarTypeData%orientationAnnulus)) then - deallocate(DstRotMiscVarTypeData%orientationAnnulus) end if if (allocated(SrcRotMiscVarTypeData%AllOuts)) then LB(1:1) = lbound(SrcRotMiscVarTypeData%AllOuts) @@ -3800,8 +3700,6 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C end if end if DstRotMiscVarTypeData%AllOuts = SrcRotMiscVarTypeData%AllOuts - else if (allocated(DstRotMiscVarTypeData%AllOuts)) then - deallocate(DstRotMiscVarTypeData%AllOuts) end if if (allocated(SrcRotMiscVarTypeData%W_Twr)) then LB(1:1) = lbound(SrcRotMiscVarTypeData%W_Twr) @@ -3814,8 +3712,6 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C end if end if DstRotMiscVarTypeData%W_Twr = SrcRotMiscVarTypeData%W_Twr - else if (allocated(DstRotMiscVarTypeData%W_Twr)) then - deallocate(DstRotMiscVarTypeData%W_Twr) end if if (allocated(SrcRotMiscVarTypeData%X_Twr)) then LB(1:1) = lbound(SrcRotMiscVarTypeData%X_Twr) @@ -3828,8 +3724,6 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C end if end if DstRotMiscVarTypeData%X_Twr = SrcRotMiscVarTypeData%X_Twr - else if (allocated(DstRotMiscVarTypeData%X_Twr)) then - deallocate(DstRotMiscVarTypeData%X_Twr) end if if (allocated(SrcRotMiscVarTypeData%Y_Twr)) then LB(1:1) = lbound(SrcRotMiscVarTypeData%Y_Twr) @@ -3842,8 +3736,6 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C end if end if DstRotMiscVarTypeData%Y_Twr = SrcRotMiscVarTypeData%Y_Twr - else if (allocated(DstRotMiscVarTypeData%Y_Twr)) then - deallocate(DstRotMiscVarTypeData%Y_Twr) end if if (allocated(SrcRotMiscVarTypeData%Curve)) then LB(1:2) = lbound(SrcRotMiscVarTypeData%Curve) @@ -3856,8 +3748,6 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C end if end if DstRotMiscVarTypeData%Curve = SrcRotMiscVarTypeData%Curve - else if (allocated(DstRotMiscVarTypeData%Curve)) then - deallocate(DstRotMiscVarTypeData%Curve) end if if (allocated(SrcRotMiscVarTypeData%TwrClrnc)) then LB(1:2) = lbound(SrcRotMiscVarTypeData%TwrClrnc) @@ -3870,8 +3760,6 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C end if end if DstRotMiscVarTypeData%TwrClrnc = SrcRotMiscVarTypeData%TwrClrnc - else if (allocated(DstRotMiscVarTypeData%TwrClrnc)) then - deallocate(DstRotMiscVarTypeData%TwrClrnc) end if if (allocated(SrcRotMiscVarTypeData%X)) then LB(1:2) = lbound(SrcRotMiscVarTypeData%X) @@ -3884,8 +3772,6 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C end if end if DstRotMiscVarTypeData%X = SrcRotMiscVarTypeData%X - else if (allocated(DstRotMiscVarTypeData%X)) then - deallocate(DstRotMiscVarTypeData%X) end if if (allocated(SrcRotMiscVarTypeData%Y)) then LB(1:2) = lbound(SrcRotMiscVarTypeData%Y) @@ -3898,8 +3784,6 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C end if end if DstRotMiscVarTypeData%Y = SrcRotMiscVarTypeData%Y - else if (allocated(DstRotMiscVarTypeData%Y)) then - deallocate(DstRotMiscVarTypeData%Y) end if if (allocated(SrcRotMiscVarTypeData%Z)) then LB(1:2) = lbound(SrcRotMiscVarTypeData%Z) @@ -3912,8 +3796,6 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C end if end if DstRotMiscVarTypeData%Z = SrcRotMiscVarTypeData%Z - else if (allocated(DstRotMiscVarTypeData%Z)) then - deallocate(DstRotMiscVarTypeData%Z) end if if (allocated(SrcRotMiscVarTypeData%M)) then LB(1:2) = lbound(SrcRotMiscVarTypeData%M) @@ -3926,8 +3808,6 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C end if end if DstRotMiscVarTypeData%M = SrcRotMiscVarTypeData%M - else if (allocated(DstRotMiscVarTypeData%M)) then - deallocate(DstRotMiscVarTypeData%M) end if if (allocated(SrcRotMiscVarTypeData%Mx)) then LB(1:2) = lbound(SrcRotMiscVarTypeData%Mx) @@ -3940,8 +3820,6 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C end if end if DstRotMiscVarTypeData%Mx = SrcRotMiscVarTypeData%Mx - else if (allocated(DstRotMiscVarTypeData%Mx)) then - deallocate(DstRotMiscVarTypeData%Mx) end if if (allocated(SrcRotMiscVarTypeData%My)) then LB(1:2) = lbound(SrcRotMiscVarTypeData%My) @@ -3954,8 +3832,6 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C end if end if DstRotMiscVarTypeData%My = SrcRotMiscVarTypeData%My - else if (allocated(DstRotMiscVarTypeData%My)) then - deallocate(DstRotMiscVarTypeData%My) end if if (allocated(SrcRotMiscVarTypeData%Mz)) then LB(1:2) = lbound(SrcRotMiscVarTypeData%Mz) @@ -3968,8 +3844,6 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C end if end if DstRotMiscVarTypeData%Mz = SrcRotMiscVarTypeData%Mz - else if (allocated(DstRotMiscVarTypeData%Mz)) then - deallocate(DstRotMiscVarTypeData%Mz) end if DstRotMiscVarTypeData%V_DiskAvg = SrcRotMiscVarTypeData%V_DiskAvg DstRotMiscVarTypeData%yaw = SrcRotMiscVarTypeData%yaw @@ -3985,8 +3859,6 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C end if end if DstRotMiscVarTypeData%hub_theta_x_root = SrcRotMiscVarTypeData%hub_theta_x_root - else if (allocated(DstRotMiscVarTypeData%hub_theta_x_root)) then - deallocate(DstRotMiscVarTypeData%hub_theta_x_root) end if DstRotMiscVarTypeData%V_dot_x = SrcRotMiscVarTypeData%V_dot_x call MeshCopy(SrcRotMiscVarTypeData%HubLoad, DstRotMiscVarTypeData%HubLoad, CtrlCode, ErrStat2, ErrMsg2 ) @@ -4007,8 +3879,6 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstRotMiscVarTypeData%B_L_2_H_P)) then - deallocate(DstRotMiscVarTypeData%B_L_2_H_P) end if if (allocated(SrcRotMiscVarTypeData%SigmaCavitCrit)) then LB(1:2) = lbound(SrcRotMiscVarTypeData%SigmaCavitCrit) @@ -4021,8 +3891,6 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C end if end if DstRotMiscVarTypeData%SigmaCavitCrit = SrcRotMiscVarTypeData%SigmaCavitCrit - else if (allocated(DstRotMiscVarTypeData%SigmaCavitCrit)) then - deallocate(DstRotMiscVarTypeData%SigmaCavitCrit) end if if (allocated(SrcRotMiscVarTypeData%SigmaCavit)) then LB(1:2) = lbound(SrcRotMiscVarTypeData%SigmaCavit) @@ -4035,8 +3903,6 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C end if end if DstRotMiscVarTypeData%SigmaCavit = SrcRotMiscVarTypeData%SigmaCavit - else if (allocated(DstRotMiscVarTypeData%SigmaCavit)) then - deallocate(DstRotMiscVarTypeData%SigmaCavit) end if if (allocated(SrcRotMiscVarTypeData%CavitWarnSet)) then LB(1:2) = lbound(SrcRotMiscVarTypeData%CavitWarnSet) @@ -4049,8 +3915,6 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C end if end if DstRotMiscVarTypeData%CavitWarnSet = SrcRotMiscVarTypeData%CavitWarnSet - else if (allocated(DstRotMiscVarTypeData%CavitWarnSet)) then - deallocate(DstRotMiscVarTypeData%CavitWarnSet) end if if (allocated(SrcRotMiscVarTypeData%BlFB)) then LB(1:3) = lbound(SrcRotMiscVarTypeData%BlFB) @@ -4063,8 +3927,6 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C end if end if DstRotMiscVarTypeData%BlFB = SrcRotMiscVarTypeData%BlFB - else if (allocated(DstRotMiscVarTypeData%BlFB)) then - deallocate(DstRotMiscVarTypeData%BlFB) end if if (allocated(SrcRotMiscVarTypeData%BlMB)) then LB(1:3) = lbound(SrcRotMiscVarTypeData%BlMB) @@ -4077,8 +3939,6 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C end if end if DstRotMiscVarTypeData%BlMB = SrcRotMiscVarTypeData%BlMB - else if (allocated(DstRotMiscVarTypeData%BlMB)) then - deallocate(DstRotMiscVarTypeData%BlMB) end if if (allocated(SrcRotMiscVarTypeData%TwrFB)) then LB(1:2) = lbound(SrcRotMiscVarTypeData%TwrFB) @@ -4091,8 +3951,6 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C end if end if DstRotMiscVarTypeData%TwrFB = SrcRotMiscVarTypeData%TwrFB - else if (allocated(DstRotMiscVarTypeData%TwrFB)) then - deallocate(DstRotMiscVarTypeData%TwrFB) end if if (allocated(SrcRotMiscVarTypeData%TwrMB)) then LB(1:2) = lbound(SrcRotMiscVarTypeData%TwrMB) @@ -4105,8 +3963,6 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C end if end if DstRotMiscVarTypeData%TwrMB = SrcRotMiscVarTypeData%TwrMB - else if (allocated(DstRotMiscVarTypeData%TwrMB)) then - deallocate(DstRotMiscVarTypeData%TwrMB) end if if (allocated(SrcRotMiscVarTypeData%HubFB)) then LB(1:1) = lbound(SrcRotMiscVarTypeData%HubFB) @@ -4119,8 +3975,6 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C end if end if DstRotMiscVarTypeData%HubFB = SrcRotMiscVarTypeData%HubFB - else if (allocated(DstRotMiscVarTypeData%HubFB)) then - deallocate(DstRotMiscVarTypeData%HubFB) end if if (allocated(SrcRotMiscVarTypeData%HubMB)) then LB(1:1) = lbound(SrcRotMiscVarTypeData%HubMB) @@ -4133,8 +3987,6 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C end if end if DstRotMiscVarTypeData%HubMB = SrcRotMiscVarTypeData%HubMB - else if (allocated(DstRotMiscVarTypeData%HubMB)) then - deallocate(DstRotMiscVarTypeData%HubMB) end if if (allocated(SrcRotMiscVarTypeData%NacFB)) then LB(1:1) = lbound(SrcRotMiscVarTypeData%NacFB) @@ -4147,8 +3999,6 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C end if end if DstRotMiscVarTypeData%NacFB = SrcRotMiscVarTypeData%NacFB - else if (allocated(DstRotMiscVarTypeData%NacFB)) then - deallocate(DstRotMiscVarTypeData%NacFB) end if if (allocated(SrcRotMiscVarTypeData%NacMB)) then LB(1:1) = lbound(SrcRotMiscVarTypeData%NacMB) @@ -4161,8 +4011,6 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C end if end if DstRotMiscVarTypeData%NacMB = SrcRotMiscVarTypeData%NacMB - else if (allocated(DstRotMiscVarTypeData%NacMB)) then - deallocate(DstRotMiscVarTypeData%NacMB) end if if (allocated(SrcRotMiscVarTypeData%BladeRootLoad)) then LB(1:1) = lbound(SrcRotMiscVarTypeData%BladeRootLoad) @@ -4179,8 +4027,6 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstRotMiscVarTypeData%BladeRootLoad)) then - deallocate(DstRotMiscVarTypeData%BladeRootLoad) end if if (allocated(SrcRotMiscVarTypeData%B_L_2_R_P)) then LB(1:1) = lbound(SrcRotMiscVarTypeData%B_L_2_R_P) @@ -4197,8 +4043,6 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstRotMiscVarTypeData%B_L_2_R_P)) then - deallocate(DstRotMiscVarTypeData%B_L_2_R_P) end if if (allocated(SrcRotMiscVarTypeData%BladeBuoyLoadPoint)) then LB(1:1) = lbound(SrcRotMiscVarTypeData%BladeBuoyLoadPoint) @@ -4215,8 +4059,6 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstRotMiscVarTypeData%BladeBuoyLoadPoint)) then - deallocate(DstRotMiscVarTypeData%BladeBuoyLoadPoint) end if if (allocated(SrcRotMiscVarTypeData%BladeBuoyLoad)) then LB(1:1) = lbound(SrcRotMiscVarTypeData%BladeBuoyLoad) @@ -4233,8 +4075,6 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstRotMiscVarTypeData%BladeBuoyLoad)) then - deallocate(DstRotMiscVarTypeData%BladeBuoyLoad) end if if (allocated(SrcRotMiscVarTypeData%B_P_2_B_L)) then LB(1:1) = lbound(SrcRotMiscVarTypeData%B_P_2_B_L) @@ -4251,8 +4091,6 @@ subroutine AD_CopyRotMiscVarType(SrcRotMiscVarTypeData, DstRotMiscVarTypeData, C call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstRotMiscVarTypeData%B_P_2_B_L)) then - deallocate(DstRotMiscVarTypeData%B_P_2_B_L) end if call MeshCopy(SrcRotMiscVarTypeData%TwrBuoyLoadPoint, DstRotMiscVarTypeData%TwrBuoyLoadPoint, CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5231,8 +5069,6 @@ subroutine AD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstMiscData%rotors)) then - deallocate(DstMiscData%rotors) end if if (allocated(SrcMiscData%FVW_u)) then LB(1:1) = lbound(SrcMiscData%FVW_u) @@ -5249,8 +5085,6 @@ subroutine AD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstMiscData%FVW_u)) then - deallocate(DstMiscData%FVW_u) end if call FVW_CopyOutput(SrcMiscData%FVW_y, DstMiscData%FVW_y, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5269,8 +5103,6 @@ subroutine AD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%WindPos = SrcMiscData%WindPos - else if (allocated(DstMiscData%WindPos)) then - deallocate(DstMiscData%WindPos) end if if (allocated(SrcMiscData%WindVel)) then LB(1:2) = lbound(SrcMiscData%WindVel) @@ -5283,8 +5115,6 @@ subroutine AD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%WindVel = SrcMiscData%WindVel - else if (allocated(DstMiscData%WindVel)) then - deallocate(DstMiscData%WindVel) end if if (allocated(SrcMiscData%WindAcc)) then LB(1:2) = lbound(SrcMiscData%WindAcc) @@ -5297,8 +5127,6 @@ subroutine AD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%WindAcc = SrcMiscData%WindAcc - else if (allocated(DstMiscData%WindAcc)) then - deallocate(DstMiscData%WindAcc) end if end subroutine @@ -5503,8 +5331,6 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD end if end if DstRotParameterTypeData%TwrDiam = SrcRotParameterTypeData%TwrDiam - else if (allocated(DstRotParameterTypeData%TwrDiam)) then - deallocate(DstRotParameterTypeData%TwrDiam) end if if (allocated(SrcRotParameterTypeData%TwrCd)) then LB(1:1) = lbound(SrcRotParameterTypeData%TwrCd) @@ -5517,8 +5343,6 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD end if end if DstRotParameterTypeData%TwrCd = SrcRotParameterTypeData%TwrCd - else if (allocated(DstRotParameterTypeData%TwrCd)) then - deallocate(DstRotParameterTypeData%TwrCd) end if if (allocated(SrcRotParameterTypeData%TwrTI)) then LB(1:1) = lbound(SrcRotParameterTypeData%TwrTI) @@ -5531,8 +5355,6 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD end if end if DstRotParameterTypeData%TwrTI = SrcRotParameterTypeData%TwrTI - else if (allocated(DstRotParameterTypeData%TwrTI)) then - deallocate(DstRotParameterTypeData%TwrTI) end if if (allocated(SrcRotParameterTypeData%BlTwist)) then LB(1:2) = lbound(SrcRotParameterTypeData%BlTwist) @@ -5545,8 +5367,6 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD end if end if DstRotParameterTypeData%BlTwist = SrcRotParameterTypeData%BlTwist - else if (allocated(DstRotParameterTypeData%BlTwist)) then - deallocate(DstRotParameterTypeData%BlTwist) end if if (allocated(SrcRotParameterTypeData%TwrCb)) then LB(1:1) = lbound(SrcRotParameterTypeData%TwrCb) @@ -5559,8 +5379,6 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD end if end if DstRotParameterTypeData%TwrCb = SrcRotParameterTypeData%TwrCb - else if (allocated(DstRotParameterTypeData%TwrCb)) then - deallocate(DstRotParameterTypeData%TwrCb) end if if (allocated(SrcRotParameterTypeData%BlCenBn)) then LB(1:2) = lbound(SrcRotParameterTypeData%BlCenBn) @@ -5573,8 +5391,6 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD end if end if DstRotParameterTypeData%BlCenBn = SrcRotParameterTypeData%BlCenBn - else if (allocated(DstRotParameterTypeData%BlCenBn)) then - deallocate(DstRotParameterTypeData%BlCenBn) end if if (allocated(SrcRotParameterTypeData%BlCenBt)) then LB(1:2) = lbound(SrcRotParameterTypeData%BlCenBt) @@ -5587,8 +5403,6 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD end if end if DstRotParameterTypeData%BlCenBt = SrcRotParameterTypeData%BlCenBt - else if (allocated(DstRotParameterTypeData%BlCenBt)) then - deallocate(DstRotParameterTypeData%BlCenBt) end if DstRotParameterTypeData%VolHub = SrcRotParameterTypeData%VolHub DstRotParameterTypeData%HubCenBx = SrcRotParameterTypeData%HubCenBx @@ -5607,8 +5421,6 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD end if end if DstRotParameterTypeData%BlRad = SrcRotParameterTypeData%BlRad - else if (allocated(DstRotParameterTypeData%BlRad)) then - deallocate(DstRotParameterTypeData%BlRad) end if if (allocated(SrcRotParameterTypeData%BlDL)) then LB(1:2) = lbound(SrcRotParameterTypeData%BlDL) @@ -5621,8 +5433,6 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD end if end if DstRotParameterTypeData%BlDL = SrcRotParameterTypeData%BlDL - else if (allocated(DstRotParameterTypeData%BlDL)) then - deallocate(DstRotParameterTypeData%BlDL) end if if (allocated(SrcRotParameterTypeData%BlTaper)) then LB(1:2) = lbound(SrcRotParameterTypeData%BlTaper) @@ -5635,8 +5445,6 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD end if end if DstRotParameterTypeData%BlTaper = SrcRotParameterTypeData%BlTaper - else if (allocated(DstRotParameterTypeData%BlTaper)) then - deallocate(DstRotParameterTypeData%BlTaper) end if if (allocated(SrcRotParameterTypeData%BlAxCent)) then LB(1:2) = lbound(SrcRotParameterTypeData%BlAxCent) @@ -5649,8 +5457,6 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD end if end if DstRotParameterTypeData%BlAxCent = SrcRotParameterTypeData%BlAxCent - else if (allocated(DstRotParameterTypeData%BlAxCent)) then - deallocate(DstRotParameterTypeData%BlAxCent) end if if (allocated(SrcRotParameterTypeData%TwrRad)) then LB(1:1) = lbound(SrcRotParameterTypeData%TwrRad) @@ -5663,8 +5469,6 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD end if end if DstRotParameterTypeData%TwrRad = SrcRotParameterTypeData%TwrRad - else if (allocated(DstRotParameterTypeData%TwrRad)) then - deallocate(DstRotParameterTypeData%TwrRad) end if if (allocated(SrcRotParameterTypeData%TwrDL)) then LB(1:1) = lbound(SrcRotParameterTypeData%TwrDL) @@ -5677,8 +5481,6 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD end if end if DstRotParameterTypeData%TwrDL = SrcRotParameterTypeData%TwrDL - else if (allocated(DstRotParameterTypeData%TwrDL)) then - deallocate(DstRotParameterTypeData%TwrDL) end if if (allocated(SrcRotParameterTypeData%TwrTaper)) then LB(1:1) = lbound(SrcRotParameterTypeData%TwrTaper) @@ -5691,8 +5493,6 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD end if end if DstRotParameterTypeData%TwrTaper = SrcRotParameterTypeData%TwrTaper - else if (allocated(DstRotParameterTypeData%TwrTaper)) then - deallocate(DstRotParameterTypeData%TwrTaper) end if if (allocated(SrcRotParameterTypeData%TwrAxCent)) then LB(1:1) = lbound(SrcRotParameterTypeData%TwrAxCent) @@ -5705,8 +5505,6 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD end if end if DstRotParameterTypeData%TwrAxCent = SrcRotParameterTypeData%TwrAxCent - else if (allocated(DstRotParameterTypeData%TwrAxCent)) then - deallocate(DstRotParameterTypeData%TwrAxCent) end if call BEMT_CopyParam(SrcRotParameterTypeData%BEMT, DstRotParameterTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5725,8 +5523,6 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD end if end if DstRotParameterTypeData%Jac_u_indx = SrcRotParameterTypeData%Jac_u_indx - else if (allocated(DstRotParameterTypeData%Jac_u_indx)) then - deallocate(DstRotParameterTypeData%Jac_u_indx) end if if (allocated(SrcRotParameterTypeData%du)) then LB(1:1) = lbound(SrcRotParameterTypeData%du) @@ -5739,8 +5535,6 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD end if end if DstRotParameterTypeData%du = SrcRotParameterTypeData%du - else if (allocated(DstRotParameterTypeData%du)) then - deallocate(DstRotParameterTypeData%du) end if if (allocated(SrcRotParameterTypeData%dx)) then LB(1:1) = lbound(SrcRotParameterTypeData%dx) @@ -5753,8 +5547,6 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD end if end if DstRotParameterTypeData%dx = SrcRotParameterTypeData%dx - else if (allocated(DstRotParameterTypeData%dx)) then - deallocate(DstRotParameterTypeData%dx) end if DstRotParameterTypeData%Jac_ny = SrcRotParameterTypeData%Jac_ny DstRotParameterTypeData%NumBl_Lin = SrcRotParameterTypeData%NumBl_Lin @@ -5793,8 +5585,6 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstRotParameterTypeData%OutParam)) then - deallocate(DstRotParameterTypeData%OutParam) end if DstRotParameterTypeData%NBlOuts = SrcRotParameterTypeData%NBlOuts DstRotParameterTypeData%BlOutNd = SrcRotParameterTypeData%BlOutNd @@ -5817,8 +5607,6 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstRotParameterTypeData%BldNd_OutParam)) then - deallocate(DstRotParameterTypeData%BldNd_OutParam) end if if (allocated(SrcRotParameterTypeData%BldNd_BlOutNd)) then LB(1:1) = lbound(SrcRotParameterTypeData%BldNd_BlOutNd) @@ -5831,8 +5619,6 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD end if end if DstRotParameterTypeData%BldNd_BlOutNd = SrcRotParameterTypeData%BldNd_BlOutNd - else if (allocated(DstRotParameterTypeData%BldNd_BlOutNd)) then - deallocate(DstRotParameterTypeData%BldNd_BlOutNd) end if DstRotParameterTypeData%BldNd_BladesOut = SrcRotParameterTypeData%BldNd_BladesOut DstRotParameterTypeData%TFinAero = SrcRotParameterTypeData%TFinAero @@ -6516,8 +6302,6 @@ subroutine AD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstParamData%rotors)) then - deallocate(DstParamData%rotors) end if DstParamData%DT = SrcParamData%DT DstParamData%RootName = SrcParamData%RootName @@ -6536,8 +6320,6 @@ subroutine AD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstParamData%AFI)) then - deallocate(DstParamData%AFI) end if DstParamData%SkewMod = SrcParamData%SkewMod DstParamData%WakeMod = SrcParamData%WakeMod @@ -6739,8 +6521,6 @@ subroutine AD_CopyRotInputType(SrcRotInputTypeData, DstRotInputTypeData, CtrlCod call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstRotInputTypeData%BladeRootMotion)) then - deallocate(DstRotInputTypeData%BladeRootMotion) end if if (allocated(SrcRotInputTypeData%BladeMotion)) then LB(1:1) = lbound(SrcRotInputTypeData%BladeMotion) @@ -6757,8 +6537,6 @@ subroutine AD_CopyRotInputType(SrcRotInputTypeData, DstRotInputTypeData, CtrlCod call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstRotInputTypeData%BladeMotion)) then - deallocate(DstRotInputTypeData%BladeMotion) end if call MeshCopy(SrcRotInputTypeData%TFinMotion, DstRotInputTypeData%TFinMotion, CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6774,8 +6552,6 @@ subroutine AD_CopyRotInputType(SrcRotInputTypeData, DstRotInputTypeData, CtrlCod end if end if DstRotInputTypeData%InflowOnBlade = SrcRotInputTypeData%InflowOnBlade - else if (allocated(DstRotInputTypeData%InflowOnBlade)) then - deallocate(DstRotInputTypeData%InflowOnBlade) end if if (allocated(SrcRotInputTypeData%InflowOnTower)) then LB(1:2) = lbound(SrcRotInputTypeData%InflowOnTower) @@ -6788,8 +6564,6 @@ subroutine AD_CopyRotInputType(SrcRotInputTypeData, DstRotInputTypeData, CtrlCod end if end if DstRotInputTypeData%InflowOnTower = SrcRotInputTypeData%InflowOnTower - else if (allocated(DstRotInputTypeData%InflowOnTower)) then - deallocate(DstRotInputTypeData%InflowOnTower) end if DstRotInputTypeData%InflowOnHub = SrcRotInputTypeData%InflowOnHub DstRotInputTypeData%InflowOnNacelle = SrcRotInputTypeData%InflowOnNacelle @@ -6805,8 +6579,6 @@ subroutine AD_CopyRotInputType(SrcRotInputTypeData, DstRotInputTypeData, CtrlCod end if end if DstRotInputTypeData%UserProp = SrcRotInputTypeData%UserProp - else if (allocated(DstRotInputTypeData%UserProp)) then - deallocate(DstRotInputTypeData%UserProp) end if end subroutine @@ -7029,8 +6801,6 @@ subroutine AD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstInputData%rotors)) then - deallocate(DstInputData%rotors) end if if (allocated(SrcInputData%InflowWakeVel)) then LB(1:2) = lbound(SrcInputData%InflowWakeVel) @@ -7043,8 +6813,6 @@ subroutine AD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%InflowWakeVel = SrcInputData%InflowWakeVel - else if (allocated(DstInputData%InflowWakeVel)) then - deallocate(DstInputData%InflowWakeVel) end if end subroutine @@ -7174,8 +6942,6 @@ subroutine AD_CopyRotOutputType(SrcRotOutputTypeData, DstRotOutputTypeData, Ctrl call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstRotOutputTypeData%BladeLoad)) then - deallocate(DstRotOutputTypeData%BladeLoad) end if call MeshCopy(SrcRotOutputTypeData%TFinLoad, DstRotOutputTypeData%TFinLoad, CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -7191,8 +6957,6 @@ subroutine AD_CopyRotOutputType(SrcRotOutputTypeData, DstRotOutputTypeData, Ctrl end if end if DstRotOutputTypeData%WriteOutput = SrcRotOutputTypeData%WriteOutput - else if (allocated(DstRotOutputTypeData%WriteOutput)) then - deallocate(DstRotOutputTypeData%WriteOutput) end if end subroutine @@ -7329,8 +7093,6 @@ subroutine AD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstOutputData%rotors)) then - deallocate(DstOutputData%rotors) end if end subroutine diff --git a/modules/aerodyn/src/AirfoilInfo_Types.f90 b/modules/aerodyn/src/AirfoilInfo_Types.f90 index 9ff2f1abe8..b8cd29debd 100644 --- a/modules/aerodyn/src/AirfoilInfo_Types.f90 +++ b/modules/aerodyn/src/AirfoilInfo_Types.f90 @@ -625,8 +625,6 @@ subroutine AFI_CopyTable_Type(SrcTable_TypeData, DstTable_TypeData, CtrlCode, Er end if end if DstTable_TypeData%Alpha = SrcTable_TypeData%Alpha - else if (allocated(DstTable_TypeData%Alpha)) then - deallocate(DstTable_TypeData%Alpha) end if if (allocated(SrcTable_TypeData%Coefs)) then LB(1:2) = lbound(SrcTable_TypeData%Coefs) @@ -639,8 +637,6 @@ subroutine AFI_CopyTable_Type(SrcTable_TypeData, DstTable_TypeData, CtrlCode, Er end if end if DstTable_TypeData%Coefs = SrcTable_TypeData%Coefs - else if (allocated(DstTable_TypeData%Coefs)) then - deallocate(DstTable_TypeData%Coefs) end if if (allocated(SrcTable_TypeData%SplineCoefs)) then LB(1:3) = lbound(SrcTable_TypeData%SplineCoefs) @@ -653,8 +649,6 @@ subroutine AFI_CopyTable_Type(SrcTable_TypeData, DstTable_TypeData, CtrlCode, Er end if end if DstTable_TypeData%SplineCoefs = SrcTable_TypeData%SplineCoefs - else if (allocated(DstTable_TypeData%SplineCoefs)) then - deallocate(DstTable_TypeData%SplineCoefs) end if DstTable_TypeData%UserProp = SrcTable_TypeData%UserProp DstTable_TypeData%Re = SrcTable_TypeData%Re @@ -923,8 +917,6 @@ subroutine AFI_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%secondVals = SrcParamData%secondVals - else if (allocated(DstParamData%secondVals)) then - deallocate(DstParamData%secondVals) end if DstParamData%InterpOrd = SrcParamData%InterpOrd DstParamData%RelThickness = SrcParamData%RelThickness @@ -941,8 +933,6 @@ subroutine AFI_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%X_Coord = SrcParamData%X_Coord - else if (allocated(DstParamData%X_Coord)) then - deallocate(DstParamData%X_Coord) end if if (allocated(SrcParamData%Y_Coord)) then LB(1:1) = lbound(SrcParamData%Y_Coord) @@ -955,8 +945,6 @@ subroutine AFI_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%Y_Coord = SrcParamData%Y_Coord - else if (allocated(DstParamData%Y_Coord)) then - deallocate(DstParamData%Y_Coord) end if DstParamData%NumTabs = SrcParamData%NumTabs if (allocated(SrcParamData%Table)) then @@ -974,8 +962,6 @@ subroutine AFI_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstParamData%Table)) then - deallocate(DstParamData%Table) end if DstParamData%BL_file = SrcParamData%BL_file DstParamData%FileName = SrcParamData%FileName diff --git a/modules/aerodyn/src/BEMT_Types.f90 b/modules/aerodyn/src/BEMT_Types.f90 index 39c78f8d5f..055e1071f1 100644 --- a/modules/aerodyn/src/BEMT_Types.f90 +++ b/modules/aerodyn/src/BEMT_Types.f90 @@ -246,8 +246,6 @@ subroutine BEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS end if end if DstInitInputData%chord = SrcInitInputData%chord - else if (allocated(DstInitInputData%chord)) then - deallocate(DstInitInputData%chord) end if DstInitInputData%numBlades = SrcInitInputData%numBlades DstInitInputData%airDens = SrcInitInputData%airDens @@ -275,8 +273,6 @@ subroutine BEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS end if end if DstInitInputData%AFindx = SrcInitInputData%AFindx - else if (allocated(DstInitInputData%AFindx)) then - deallocate(DstInitInputData%AFindx) end if if (allocated(SrcInitInputData%zHub)) then LB(1:1) = lbound(SrcInitInputData%zHub) @@ -289,8 +285,6 @@ subroutine BEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS end if end if DstInitInputData%zHub = SrcInitInputData%zHub - else if (allocated(DstInitInputData%zHub)) then - deallocate(DstInitInputData%zHub) end if if (allocated(SrcInitInputData%zLocal)) then LB(1:2) = lbound(SrcInitInputData%zLocal) @@ -303,8 +297,6 @@ subroutine BEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS end if end if DstInitInputData%zLocal = SrcInitInputData%zLocal - else if (allocated(DstInitInputData%zLocal)) then - deallocate(DstInitInputData%zLocal) end if if (allocated(SrcInitInputData%zTip)) then LB(1:1) = lbound(SrcInitInputData%zTip) @@ -317,8 +309,6 @@ subroutine BEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS end if end if DstInitInputData%zTip = SrcInitInputData%zTip - else if (allocated(DstInitInputData%zTip)) then - deallocate(DstInitInputData%zTip) end if if (allocated(SrcInitInputData%rLocal)) then LB(1:2) = lbound(SrcInitInputData%rLocal) @@ -331,8 +321,6 @@ subroutine BEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS end if end if DstInitInputData%rLocal = SrcInitInputData%rLocal - else if (allocated(DstInitInputData%rLocal)) then - deallocate(DstInitInputData%rLocal) end if if (allocated(SrcInitInputData%rTipFix)) then LB(1:1) = lbound(SrcInitInputData%rTipFix) @@ -345,8 +333,6 @@ subroutine BEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS end if end if DstInitInputData%rTipFix = SrcInitInputData%rTipFix - else if (allocated(DstInitInputData%rTipFix)) then - deallocate(DstInitInputData%rTipFix) end if DstInitInputData%UAMod = SrcInitInputData%UAMod DstInitInputData%UA_Flag = SrcInitInputData%UA_Flag @@ -366,8 +352,6 @@ subroutine BEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS end if end if DstInitInputData%UAOff_innerNode = SrcInitInputData%UAOff_innerNode - else if (allocated(DstInitInputData%UAOff_innerNode)) then - deallocate(DstInitInputData%UAOff_innerNode) end if if (allocated(SrcInitInputData%UAOff_outerNode)) then LB(1:1) = lbound(SrcInitInputData%UAOff_outerNode) @@ -380,8 +364,6 @@ subroutine BEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS end if end if DstInitInputData%UAOff_outerNode = SrcInitInputData%UAOff_outerNode - else if (allocated(DstInitInputData%UAOff_outerNode)) then - deallocate(DstInitInputData%UAOff_outerNode) end if DstInitInputData%RootName = SrcInitInputData%RootName DstInitInputData%SumPrint = SrcInitInputData%SumPrint @@ -906,8 +888,6 @@ subroutine BEMT_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode end if end if DstConstrStateData%phi = SrcConstrStateData%phi - else if (allocated(DstConstrStateData%phi)) then - deallocate(DstConstrStateData%phi) end if end subroutine @@ -990,8 +970,6 @@ subroutine BEMT_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E end if end if DstOtherStateData%ValidPhi = SrcOtherStateData%ValidPhi - else if (allocated(DstOtherStateData%ValidPhi)) then - deallocate(DstOtherStateData%ValidPhi) end if DstOtherStateData%nodesInitialized = SrcOtherStateData%nodesInitialized LB(1:1) = lbound(SrcOtherStateData%xdot) @@ -1134,8 +1112,6 @@ subroutine BEMT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end do end do - else if (allocated(DstMiscData%u_UA)) then - deallocate(DstMiscData%u_UA) end if LB(1:1) = lbound(SrcMiscData%u_DBEMT) UB(1:1) = ubound(SrcMiscData%u_DBEMT) @@ -1162,8 +1138,6 @@ subroutine BEMT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%TnInd_op = SrcMiscData%TnInd_op - else if (allocated(DstMiscData%TnInd_op)) then - deallocate(DstMiscData%TnInd_op) end if if (allocated(SrcMiscData%AxInd_op)) then LB(1:2) = lbound(SrcMiscData%AxInd_op) @@ -1176,8 +1150,6 @@ subroutine BEMT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%AxInd_op = SrcMiscData%AxInd_op - else if (allocated(DstMiscData%AxInd_op)) then - deallocate(DstMiscData%AxInd_op) end if if (allocated(SrcMiscData%AxInduction)) then LB(1:2) = lbound(SrcMiscData%AxInduction) @@ -1190,8 +1162,6 @@ subroutine BEMT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%AxInduction = SrcMiscData%AxInduction - else if (allocated(DstMiscData%AxInduction)) then - deallocate(DstMiscData%AxInduction) end if if (allocated(SrcMiscData%TanInduction)) then LB(1:2) = lbound(SrcMiscData%TanInduction) @@ -1204,8 +1174,6 @@ subroutine BEMT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%TanInduction = SrcMiscData%TanInduction - else if (allocated(DstMiscData%TanInduction)) then - deallocate(DstMiscData%TanInduction) end if DstMiscData%UseFrozenWake = SrcMiscData%UseFrozenWake if (allocated(SrcMiscData%Rtip)) then @@ -1219,8 +1187,6 @@ subroutine BEMT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%Rtip = SrcMiscData%Rtip - else if (allocated(DstMiscData%Rtip)) then - deallocate(DstMiscData%Rtip) end if if (allocated(SrcMiscData%phi)) then LB(1:2) = lbound(SrcMiscData%phi) @@ -1233,8 +1199,6 @@ subroutine BEMT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%phi = SrcMiscData%phi - else if (allocated(DstMiscData%phi)) then - deallocate(DstMiscData%phi) end if if (allocated(SrcMiscData%chi)) then LB(1:2) = lbound(SrcMiscData%chi) @@ -1247,8 +1211,6 @@ subroutine BEMT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%chi = SrcMiscData%chi - else if (allocated(DstMiscData%chi)) then - deallocate(DstMiscData%chi) end if if (allocated(SrcMiscData%ValidPhi)) then LB(1:2) = lbound(SrcMiscData%ValidPhi) @@ -1261,8 +1223,6 @@ subroutine BEMT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%ValidPhi = SrcMiscData%ValidPhi - else if (allocated(DstMiscData%ValidPhi)) then - deallocate(DstMiscData%ValidPhi) end if DstMiscData%BEM_weight = SrcMiscData%BEM_weight end subroutine @@ -1605,8 +1565,6 @@ subroutine BEMT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%chord = SrcParamData%chord - else if (allocated(DstParamData%chord)) then - deallocate(DstParamData%chord) end if DstParamData%numBlades = SrcParamData%numBlades DstParamData%airDens = SrcParamData%airDens @@ -1633,8 +1591,6 @@ subroutine BEMT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%AFindx = SrcParamData%AFindx - else if (allocated(DstParamData%AFindx)) then - deallocate(DstParamData%AFindx) end if if (allocated(SrcParamData%tipLossConst)) then LB(1:2) = lbound(SrcParamData%tipLossConst) @@ -1647,8 +1603,6 @@ subroutine BEMT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%tipLossConst = SrcParamData%tipLossConst - else if (allocated(DstParamData%tipLossConst)) then - deallocate(DstParamData%tipLossConst) end if if (allocated(SrcParamData%hubLossConst)) then LB(1:2) = lbound(SrcParamData%hubLossConst) @@ -1661,8 +1615,6 @@ subroutine BEMT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%hubLossConst = SrcParamData%hubLossConst - else if (allocated(DstParamData%hubLossConst)) then - deallocate(DstParamData%hubLossConst) end if if (allocated(SrcParamData%zHub)) then LB(1:1) = lbound(SrcParamData%zHub) @@ -1675,8 +1627,6 @@ subroutine BEMT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%zHub = SrcParamData%zHub - else if (allocated(DstParamData%zHub)) then - deallocate(DstParamData%zHub) end if call UA_CopyParam(SrcParamData%UA, DstParamData%UA, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1698,8 +1648,6 @@ subroutine BEMT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%FixedInductions = SrcParamData%FixedInductions - else if (allocated(DstParamData%FixedInductions)) then - deallocate(DstParamData%FixedInductions) end if DstParamData%MomentumCorr = SrcParamData%MomentumCorr DstParamData%rTipFixMax = SrcParamData%rTipFixMax @@ -1714,8 +1662,6 @@ subroutine BEMT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%IntegrateWeight = SrcParamData%IntegrateWeight - else if (allocated(DstParamData%IntegrateWeight)) then - deallocate(DstParamData%IntegrateWeight) end if DstParamData%lin_nx = SrcParamData%lin_nx DstParamData%BEM_Mod = SrcParamData%BEM_Mod @@ -2000,8 +1946,6 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%theta = SrcInputData%theta - else if (allocated(DstInputData%theta)) then - deallocate(DstInputData%theta) end if DstInputData%chi0 = SrcInputData%chi0 DstInputData%psiSkewOffset = SrcInputData%psiSkewOffset @@ -2016,8 +1960,6 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%psi = SrcInputData%psi - else if (allocated(DstInputData%psi)) then - deallocate(DstInputData%psi) end if DstInputData%omega = SrcInputData%omega DstInputData%TSR = SrcInputData%TSR @@ -2032,8 +1974,6 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%Vx = SrcInputData%Vx - else if (allocated(DstInputData%Vx)) then - deallocate(DstInputData%Vx) end if if (allocated(SrcInputData%Vy)) then LB(1:2) = lbound(SrcInputData%Vy) @@ -2046,8 +1986,6 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%Vy = SrcInputData%Vy - else if (allocated(DstInputData%Vy)) then - deallocate(DstInputData%Vy) end if if (allocated(SrcInputData%Vz)) then LB(1:2) = lbound(SrcInputData%Vz) @@ -2060,8 +1998,6 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%Vz = SrcInputData%Vz - else if (allocated(DstInputData%Vz)) then - deallocate(DstInputData%Vz) end if if (allocated(SrcInputData%omega_z)) then LB(1:2) = lbound(SrcInputData%omega_z) @@ -2074,8 +2010,6 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%omega_z = SrcInputData%omega_z - else if (allocated(DstInputData%omega_z)) then - deallocate(DstInputData%omega_z) end if if (allocated(SrcInputData%xVelCorr)) then LB(1:2) = lbound(SrcInputData%xVelCorr) @@ -2088,8 +2022,6 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%xVelCorr = SrcInputData%xVelCorr - else if (allocated(DstInputData%xVelCorr)) then - deallocate(DstInputData%xVelCorr) end if if (allocated(SrcInputData%rLocal)) then LB(1:2) = lbound(SrcInputData%rLocal) @@ -2102,8 +2034,6 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%rLocal = SrcInputData%rLocal - else if (allocated(DstInputData%rLocal)) then - deallocate(DstInputData%rLocal) end if DstInputData%Un_disk = SrcInputData%Un_disk DstInputData%V0 = SrcInputData%V0 @@ -2119,8 +2049,6 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%UserProp = SrcInputData%UserProp - else if (allocated(DstInputData%UserProp)) then - deallocate(DstInputData%UserProp) end if if (allocated(SrcInputData%CantAngle)) then LB(1:2) = lbound(SrcInputData%CantAngle) @@ -2133,8 +2061,6 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%CantAngle = SrcInputData%CantAngle - else if (allocated(DstInputData%CantAngle)) then - deallocate(DstInputData%CantAngle) end if if (allocated(SrcInputData%drdz)) then LB(1:2) = lbound(SrcInputData%drdz) @@ -2147,8 +2073,6 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%drdz = SrcInputData%drdz - else if (allocated(DstInputData%drdz)) then - deallocate(DstInputData%drdz) end if if (allocated(SrcInputData%toeAngle)) then LB(1:2) = lbound(SrcInputData%toeAngle) @@ -2161,8 +2085,6 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%toeAngle = SrcInputData%toeAngle - else if (allocated(DstInputData%toeAngle)) then - deallocate(DstInputData%toeAngle) end if end subroutine @@ -2500,8 +2422,6 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM end if end if DstOutputData%Vrel = SrcOutputData%Vrel - else if (allocated(DstOutputData%Vrel)) then - deallocate(DstOutputData%Vrel) end if if (allocated(SrcOutputData%phi)) then LB(1:2) = lbound(SrcOutputData%phi) @@ -2514,8 +2434,6 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM end if end if DstOutputData%phi = SrcOutputData%phi - else if (allocated(DstOutputData%phi)) then - deallocate(DstOutputData%phi) end if if (allocated(SrcOutputData%axInduction)) then LB(1:2) = lbound(SrcOutputData%axInduction) @@ -2528,8 +2446,6 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM end if end if DstOutputData%axInduction = SrcOutputData%axInduction - else if (allocated(DstOutputData%axInduction)) then - deallocate(DstOutputData%axInduction) end if if (allocated(SrcOutputData%tanInduction)) then LB(1:2) = lbound(SrcOutputData%tanInduction) @@ -2542,8 +2458,6 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM end if end if DstOutputData%tanInduction = SrcOutputData%tanInduction - else if (allocated(DstOutputData%tanInduction)) then - deallocate(DstOutputData%tanInduction) end if if (allocated(SrcOutputData%Re)) then LB(1:2) = lbound(SrcOutputData%Re) @@ -2556,8 +2470,6 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM end if end if DstOutputData%Re = SrcOutputData%Re - else if (allocated(DstOutputData%Re)) then - deallocate(DstOutputData%Re) end if if (allocated(SrcOutputData%AOA)) then LB(1:2) = lbound(SrcOutputData%AOA) @@ -2570,8 +2482,6 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM end if end if DstOutputData%AOA = SrcOutputData%AOA - else if (allocated(DstOutputData%AOA)) then - deallocate(DstOutputData%AOA) end if if (allocated(SrcOutputData%Cx)) then LB(1:2) = lbound(SrcOutputData%Cx) @@ -2584,8 +2494,6 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM end if end if DstOutputData%Cx = SrcOutputData%Cx - else if (allocated(DstOutputData%Cx)) then - deallocate(DstOutputData%Cx) end if if (allocated(SrcOutputData%Cy)) then LB(1:2) = lbound(SrcOutputData%Cy) @@ -2598,8 +2506,6 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM end if end if DstOutputData%Cy = SrcOutputData%Cy - else if (allocated(DstOutputData%Cy)) then - deallocate(DstOutputData%Cy) end if if (allocated(SrcOutputData%Cz)) then LB(1:2) = lbound(SrcOutputData%Cz) @@ -2612,8 +2518,6 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM end if end if DstOutputData%Cz = SrcOutputData%Cz - else if (allocated(DstOutputData%Cz)) then - deallocate(DstOutputData%Cz) end if if (allocated(SrcOutputData%Cmx)) then LB(1:2) = lbound(SrcOutputData%Cmx) @@ -2626,8 +2530,6 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM end if end if DstOutputData%Cmx = SrcOutputData%Cmx - else if (allocated(DstOutputData%Cmx)) then - deallocate(DstOutputData%Cmx) end if if (allocated(SrcOutputData%Cmy)) then LB(1:2) = lbound(SrcOutputData%Cmy) @@ -2640,8 +2542,6 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM end if end if DstOutputData%Cmy = SrcOutputData%Cmy - else if (allocated(DstOutputData%Cmy)) then - deallocate(DstOutputData%Cmy) end if if (allocated(SrcOutputData%Cmz)) then LB(1:2) = lbound(SrcOutputData%Cmz) @@ -2654,8 +2554,6 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM end if end if DstOutputData%Cmz = SrcOutputData%Cmz - else if (allocated(DstOutputData%Cmz)) then - deallocate(DstOutputData%Cmz) end if if (allocated(SrcOutputData%Cm)) then LB(1:2) = lbound(SrcOutputData%Cm) @@ -2668,8 +2566,6 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM end if end if DstOutputData%Cm = SrcOutputData%Cm - else if (allocated(DstOutputData%Cm)) then - deallocate(DstOutputData%Cm) end if if (allocated(SrcOutputData%Cl)) then LB(1:2) = lbound(SrcOutputData%Cl) @@ -2682,8 +2578,6 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM end if end if DstOutputData%Cl = SrcOutputData%Cl - else if (allocated(DstOutputData%Cl)) then - deallocate(DstOutputData%Cl) end if if (allocated(SrcOutputData%Cd)) then LB(1:2) = lbound(SrcOutputData%Cd) @@ -2696,8 +2590,6 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM end if end if DstOutputData%Cd = SrcOutputData%Cd - else if (allocated(DstOutputData%Cd)) then - deallocate(DstOutputData%Cd) end if if (allocated(SrcOutputData%chi)) then LB(1:2) = lbound(SrcOutputData%chi) @@ -2710,8 +2602,6 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM end if end if DstOutputData%chi = SrcOutputData%chi - else if (allocated(DstOutputData%chi)) then - deallocate(DstOutputData%chi) end if if (allocated(SrcOutputData%Cpmin)) then LB(1:2) = lbound(SrcOutputData%Cpmin) @@ -2724,8 +2614,6 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM end if end if DstOutputData%Cpmin = SrcOutputData%Cpmin - else if (allocated(DstOutputData%Cpmin)) then - deallocate(DstOutputData%Cpmin) end if end subroutine diff --git a/modules/aerodyn/src/DBEMT_Types.f90 b/modules/aerodyn/src/DBEMT_Types.f90 index 25254a8edb..abf09196c8 100644 --- a/modules/aerodyn/src/DBEMT_Types.f90 +++ b/modules/aerodyn/src/DBEMT_Types.f90 @@ -145,8 +145,6 @@ subroutine DBEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err end if end if DstInitInputData%rLocal = SrcInitInputData%rLocal - else if (allocated(DstInitInputData%rLocal)) then - deallocate(DstInitInputData%rLocal) end if end subroutine @@ -330,8 +328,6 @@ subroutine DBEMT_CopyContState(SrcContStateData, DstContStateData, CtrlCode, Err if (ErrStat >= AbortErrLev) return end do end do - else if (allocated(DstContStateData%element)) then - deallocate(DstContStateData%element) end if end subroutine @@ -510,8 +506,6 @@ subroutine DBEMT_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, end if end if DstOtherStateData%areStatesInitialized = SrcOtherStateData%areStatesInitialized - else if (allocated(DstOtherStateData%areStatesInitialized)) then - deallocate(DstOtherStateData%areStatesInitialized) end if DstOtherStateData%tau1 = SrcOtherStateData%tau1 DstOtherStateData%tau2 = SrcOtherStateData%tau2 @@ -526,8 +520,6 @@ subroutine DBEMT_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, end if end if DstOtherStateData%n = SrcOtherStateData%n - else if (allocated(DstOtherStateData%n)) then - deallocate(DstOtherStateData%n) end if LB(1:1) = lbound(SrcOtherStateData%xdot) UB(1:1) = ubound(SrcOtherStateData%xdot) @@ -705,8 +697,6 @@ subroutine DBEMT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg end if end if DstParamData%spanRatio = SrcParamData%spanRatio - else if (allocated(DstParamData%spanRatio)) then - deallocate(DstParamData%spanRatio) end if DstParamData%DBEMT_Mod = SrcParamData%DBEMT_Mod end subroutine @@ -857,8 +847,6 @@ subroutine DBEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg if (ErrStat >= AbortErrLev) return end do end do - else if (allocated(DstInputData%element)) then - deallocate(DstInputData%element) end if end subroutine @@ -966,8 +954,6 @@ subroutine DBEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err end if end if DstOutputData%vind = SrcOutputData%vind - else if (allocated(DstOutputData%vind)) then - deallocate(DstOutputData%vind) end if end subroutine diff --git a/modules/aerodyn/src/FVW_Types.f90 b/modules/aerodyn/src/FVW_Types.f90 index f8c3b8cff5..b4d28be2f9 100644 --- a/modules/aerodyn/src/FVW_Types.f90 +++ b/modules/aerodyn/src/FVW_Types.f90 @@ -392,8 +392,6 @@ subroutine FVW_CopyGridOutType(SrcGridOutTypeData, DstGridOutTypeData, CtrlCode, end if end if DstGridOutTypeData%uGrid = SrcGridOutTypeData%uGrid - else if (allocated(DstGridOutTypeData%uGrid)) then - deallocate(DstGridOutTypeData%uGrid) end if if (allocated(SrcGridOutTypeData%omGrid)) then LB(1:4) = lbound(SrcGridOutTypeData%omGrid) @@ -406,8 +404,6 @@ subroutine FVW_CopyGridOutType(SrcGridOutTypeData, DstGridOutTypeData, CtrlCode, end if end if DstGridOutTypeData%omGrid = SrcGridOutTypeData%omGrid - else if (allocated(DstGridOutTypeData%omGrid)) then - deallocate(DstGridOutTypeData%omGrid) end if DstGridOutTypeData%tLastOutput = SrcGridOutTypeData%tLastOutput end subroutine @@ -550,8 +546,6 @@ subroutine FVW_CopyT_Sgmt(SrcT_SgmtData, DstT_SgmtData, CtrlCode, ErrStat, ErrMs end if end if DstT_SgmtData%Points = SrcT_SgmtData%Points - else if (allocated(DstT_SgmtData%Points)) then - deallocate(DstT_SgmtData%Points) end if if (allocated(SrcT_SgmtData%Connct)) then LB(1:2) = lbound(SrcT_SgmtData%Connct) @@ -564,8 +558,6 @@ subroutine FVW_CopyT_Sgmt(SrcT_SgmtData, DstT_SgmtData, CtrlCode, ErrStat, ErrMs end if end if DstT_SgmtData%Connct = SrcT_SgmtData%Connct - else if (allocated(DstT_SgmtData%Connct)) then - deallocate(DstT_SgmtData%Connct) end if if (allocated(SrcT_SgmtData%Gamma)) then LB(1:1) = lbound(SrcT_SgmtData%Gamma) @@ -578,8 +570,6 @@ subroutine FVW_CopyT_Sgmt(SrcT_SgmtData, DstT_SgmtData, CtrlCode, ErrStat, ErrMs end if end if DstT_SgmtData%Gamma = SrcT_SgmtData%Gamma - else if (allocated(DstT_SgmtData%Gamma)) then - deallocate(DstT_SgmtData%Gamma) end if if (allocated(SrcT_SgmtData%Epsilon)) then LB(1:1) = lbound(SrcT_SgmtData%Epsilon) @@ -592,8 +582,6 @@ subroutine FVW_CopyT_Sgmt(SrcT_SgmtData, DstT_SgmtData, CtrlCode, ErrStat, ErrMs end if end if DstT_SgmtData%Epsilon = SrcT_SgmtData%Epsilon - else if (allocated(DstT_SgmtData%Epsilon)) then - deallocate(DstT_SgmtData%Epsilon) end if DstT_SgmtData%RegFunction = SrcT_SgmtData%RegFunction DstT_SgmtData%nAct = SrcT_SgmtData%nAct @@ -746,8 +734,6 @@ subroutine FVW_CopyT_Part(SrcT_PartData, DstT_PartData, CtrlCode, ErrStat, ErrMs end if end if DstT_PartData%P = SrcT_PartData%P - else if (allocated(DstT_PartData%P)) then - deallocate(DstT_PartData%P) end if if (allocated(SrcT_PartData%Alpha)) then LB(1:2) = lbound(SrcT_PartData%Alpha) @@ -760,8 +746,6 @@ subroutine FVW_CopyT_Part(SrcT_PartData, DstT_PartData, CtrlCode, ErrStat, ErrMs end if end if DstT_PartData%Alpha = SrcT_PartData%Alpha - else if (allocated(DstT_PartData%Alpha)) then - deallocate(DstT_PartData%Alpha) end if if (allocated(SrcT_PartData%RegParam)) then LB(1:1) = lbound(SrcT_PartData%RegParam) @@ -774,8 +758,6 @@ subroutine FVW_CopyT_Part(SrcT_PartData, DstT_PartData, CtrlCode, ErrStat, ErrMs end if end if DstT_PartData%RegParam = SrcT_PartData%RegParam - else if (allocated(DstT_PartData%RegParam)) then - deallocate(DstT_PartData%RegParam) end if DstT_PartData%RegFunction = SrcT_PartData%RegFunction DstT_PartData%nAct = SrcT_PartData%nAct @@ -902,8 +884,6 @@ subroutine FVW_CopyWng_ParameterType(SrcWng_ParameterTypeData, DstWng_ParameterT end if end if DstWng_ParameterTypeData%chord_LL = SrcWng_ParameterTypeData%chord_LL - else if (allocated(DstWng_ParameterTypeData%chord_LL)) then - deallocate(DstWng_ParameterTypeData%chord_LL) end if if (allocated(SrcWng_ParameterTypeData%chord_CP)) then LB(1:1) = lbound(SrcWng_ParameterTypeData%chord_CP) @@ -916,8 +896,6 @@ subroutine FVW_CopyWng_ParameterType(SrcWng_ParameterTypeData, DstWng_ParameterT end if end if DstWng_ParameterTypeData%chord_CP = SrcWng_ParameterTypeData%chord_CP - else if (allocated(DstWng_ParameterTypeData%chord_CP)) then - deallocate(DstWng_ParameterTypeData%chord_CP) end if if (allocated(SrcWng_ParameterTypeData%s_LL)) then LB(1:1) = lbound(SrcWng_ParameterTypeData%s_LL) @@ -930,8 +908,6 @@ subroutine FVW_CopyWng_ParameterType(SrcWng_ParameterTypeData, DstWng_ParameterT end if end if DstWng_ParameterTypeData%s_LL = SrcWng_ParameterTypeData%s_LL - else if (allocated(DstWng_ParameterTypeData%s_LL)) then - deallocate(DstWng_ParameterTypeData%s_LL) end if if (allocated(SrcWng_ParameterTypeData%s_CP)) then LB(1:1) = lbound(SrcWng_ParameterTypeData%s_CP) @@ -944,8 +920,6 @@ subroutine FVW_CopyWng_ParameterType(SrcWng_ParameterTypeData, DstWng_ParameterT end if end if DstWng_ParameterTypeData%s_CP = SrcWng_ParameterTypeData%s_CP - else if (allocated(DstWng_ParameterTypeData%s_CP)) then - deallocate(DstWng_ParameterTypeData%s_CP) end if DstWng_ParameterTypeData%iRotor = SrcWng_ParameterTypeData%iRotor if (allocated(SrcWng_ParameterTypeData%AFindx)) then @@ -959,8 +933,6 @@ subroutine FVW_CopyWng_ParameterType(SrcWng_ParameterTypeData, DstWng_ParameterT end if end if DstWng_ParameterTypeData%AFindx = SrcWng_ParameterTypeData%AFindx - else if (allocated(DstWng_ParameterTypeData%AFindx)) then - deallocate(DstWng_ParameterTypeData%AFindx) end if DstWng_ParameterTypeData%nSpan = SrcWng_ParameterTypeData%nSpan if (allocated(SrcWng_ParameterTypeData%PrescribedCirculation)) then @@ -974,8 +946,6 @@ subroutine FVW_CopyWng_ParameterType(SrcWng_ParameterTypeData, DstWng_ParameterT end if end if DstWng_ParameterTypeData%PrescribedCirculation = SrcWng_ParameterTypeData%PrescribedCirculation - else if (allocated(DstWng_ParameterTypeData%PrescribedCirculation)) then - deallocate(DstWng_ParameterTypeData%PrescribedCirculation) end if end subroutine @@ -1174,8 +1144,6 @@ subroutine FVW_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstParamData%W)) then - deallocate(DstParamData%W) end if if (allocated(SrcParamData%Bld2Wings)) then LB(1:2) = lbound(SrcParamData%Bld2Wings) @@ -1188,8 +1156,6 @@ subroutine FVW_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%Bld2Wings = SrcParamData%Bld2Wings - else if (allocated(DstParamData%Bld2Wings)) then - deallocate(DstParamData%Bld2Wings) end if DstParamData%iNWStart = SrcParamData%iNWStart DstParamData%nNWMax = SrcParamData%nNWMax @@ -1490,8 +1456,6 @@ subroutine FVW_CopyWng_ContinuousStateType(SrcWng_ContinuousStateTypeData, DstWn end if end if DstWng_ContinuousStateTypeData%Gamma_NW = SrcWng_ContinuousStateTypeData%Gamma_NW - else if (allocated(DstWng_ContinuousStateTypeData%Gamma_NW)) then - deallocate(DstWng_ContinuousStateTypeData%Gamma_NW) end if if (allocated(SrcWng_ContinuousStateTypeData%Gamma_FW)) then LB(1:2) = lbound(SrcWng_ContinuousStateTypeData%Gamma_FW) @@ -1504,8 +1468,6 @@ subroutine FVW_CopyWng_ContinuousStateType(SrcWng_ContinuousStateTypeData, DstWn end if end if DstWng_ContinuousStateTypeData%Gamma_FW = SrcWng_ContinuousStateTypeData%Gamma_FW - else if (allocated(DstWng_ContinuousStateTypeData%Gamma_FW)) then - deallocate(DstWng_ContinuousStateTypeData%Gamma_FW) end if if (allocated(SrcWng_ContinuousStateTypeData%Eps_NW)) then LB(1:3) = lbound(SrcWng_ContinuousStateTypeData%Eps_NW) @@ -1518,8 +1480,6 @@ subroutine FVW_CopyWng_ContinuousStateType(SrcWng_ContinuousStateTypeData, DstWn end if end if DstWng_ContinuousStateTypeData%Eps_NW = SrcWng_ContinuousStateTypeData%Eps_NW - else if (allocated(DstWng_ContinuousStateTypeData%Eps_NW)) then - deallocate(DstWng_ContinuousStateTypeData%Eps_NW) end if if (allocated(SrcWng_ContinuousStateTypeData%Eps_FW)) then LB(1:3) = lbound(SrcWng_ContinuousStateTypeData%Eps_FW) @@ -1532,8 +1492,6 @@ subroutine FVW_CopyWng_ContinuousStateType(SrcWng_ContinuousStateTypeData, DstWn end if end if DstWng_ContinuousStateTypeData%Eps_FW = SrcWng_ContinuousStateTypeData%Eps_FW - else if (allocated(DstWng_ContinuousStateTypeData%Eps_FW)) then - deallocate(DstWng_ContinuousStateTypeData%Eps_FW) end if if (allocated(SrcWng_ContinuousStateTypeData%r_NW)) then LB(1:3) = lbound(SrcWng_ContinuousStateTypeData%r_NW) @@ -1546,8 +1504,6 @@ subroutine FVW_CopyWng_ContinuousStateType(SrcWng_ContinuousStateTypeData, DstWn end if end if DstWng_ContinuousStateTypeData%r_NW = SrcWng_ContinuousStateTypeData%r_NW - else if (allocated(DstWng_ContinuousStateTypeData%r_NW)) then - deallocate(DstWng_ContinuousStateTypeData%r_NW) end if if (allocated(SrcWng_ContinuousStateTypeData%r_FW)) then LB(1:3) = lbound(SrcWng_ContinuousStateTypeData%r_FW) @@ -1560,8 +1516,6 @@ subroutine FVW_CopyWng_ContinuousStateType(SrcWng_ContinuousStateTypeData, DstWn end if end if DstWng_ContinuousStateTypeData%r_FW = SrcWng_ContinuousStateTypeData%r_FW - else if (allocated(DstWng_ContinuousStateTypeData%r_FW)) then - deallocate(DstWng_ContinuousStateTypeData%r_FW) end if end subroutine @@ -1752,8 +1706,6 @@ subroutine FVW_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSt call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstContStateData%W)) then - deallocate(DstContStateData%W) end if if (allocated(SrcContStateData%UA)) then LB(1:1) = lbound(SrcContStateData%UA) @@ -1770,8 +1722,6 @@ subroutine FVW_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSt call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstContStateData%UA)) then - deallocate(DstContStateData%UA) end if end subroutine @@ -1897,8 +1847,6 @@ subroutine FVW_CopyWng_OutputType(SrcWng_OutputTypeData, DstWng_OutputTypeData, end if end if DstWng_OutputTypeData%Vind = SrcWng_OutputTypeData%Vind - else if (allocated(DstWng_OutputTypeData%Vind)) then - deallocate(DstWng_OutputTypeData%Vind) end if end subroutine @@ -1979,8 +1927,6 @@ subroutine FVW_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstOutputData%W)) then - deallocate(DstOutputData%W) end if end subroutine @@ -2075,8 +2021,6 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat end if end if DstWng_MiscVarTypeData%LE = SrcWng_MiscVarTypeData%LE - else if (allocated(DstWng_MiscVarTypeData%LE)) then - deallocate(DstWng_MiscVarTypeData%LE) end if if (allocated(SrcWng_MiscVarTypeData%TE)) then LB(1:2) = lbound(SrcWng_MiscVarTypeData%TE) @@ -2089,8 +2033,6 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat end if end if DstWng_MiscVarTypeData%TE = SrcWng_MiscVarTypeData%TE - else if (allocated(DstWng_MiscVarTypeData%TE)) then - deallocate(DstWng_MiscVarTypeData%TE) end if if (allocated(SrcWng_MiscVarTypeData%r_LL)) then LB(1:3) = lbound(SrcWng_MiscVarTypeData%r_LL) @@ -2103,8 +2045,6 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat end if end if DstWng_MiscVarTypeData%r_LL = SrcWng_MiscVarTypeData%r_LL - else if (allocated(DstWng_MiscVarTypeData%r_LL)) then - deallocate(DstWng_MiscVarTypeData%r_LL) end if if (allocated(SrcWng_MiscVarTypeData%CP)) then LB(1:2) = lbound(SrcWng_MiscVarTypeData%CP) @@ -2117,8 +2057,6 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat end if end if DstWng_MiscVarTypeData%CP = SrcWng_MiscVarTypeData%CP - else if (allocated(DstWng_MiscVarTypeData%CP)) then - deallocate(DstWng_MiscVarTypeData%CP) end if if (allocated(SrcWng_MiscVarTypeData%Tang)) then LB(1:2) = lbound(SrcWng_MiscVarTypeData%Tang) @@ -2131,8 +2069,6 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat end if end if DstWng_MiscVarTypeData%Tang = SrcWng_MiscVarTypeData%Tang - else if (allocated(DstWng_MiscVarTypeData%Tang)) then - deallocate(DstWng_MiscVarTypeData%Tang) end if if (allocated(SrcWng_MiscVarTypeData%Norm)) then LB(1:2) = lbound(SrcWng_MiscVarTypeData%Norm) @@ -2145,8 +2081,6 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat end if end if DstWng_MiscVarTypeData%Norm = SrcWng_MiscVarTypeData%Norm - else if (allocated(DstWng_MiscVarTypeData%Norm)) then - deallocate(DstWng_MiscVarTypeData%Norm) end if if (allocated(SrcWng_MiscVarTypeData%Orth)) then LB(1:2) = lbound(SrcWng_MiscVarTypeData%Orth) @@ -2159,8 +2093,6 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat end if end if DstWng_MiscVarTypeData%Orth = SrcWng_MiscVarTypeData%Orth - else if (allocated(DstWng_MiscVarTypeData%Orth)) then - deallocate(DstWng_MiscVarTypeData%Orth) end if if (allocated(SrcWng_MiscVarTypeData%dl)) then LB(1:2) = lbound(SrcWng_MiscVarTypeData%dl) @@ -2173,8 +2105,6 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat end if end if DstWng_MiscVarTypeData%dl = SrcWng_MiscVarTypeData%dl - else if (allocated(DstWng_MiscVarTypeData%dl)) then - deallocate(DstWng_MiscVarTypeData%dl) end if if (allocated(SrcWng_MiscVarTypeData%Area)) then LB(1:1) = lbound(SrcWng_MiscVarTypeData%Area) @@ -2187,8 +2117,6 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat end if end if DstWng_MiscVarTypeData%Area = SrcWng_MiscVarTypeData%Area - else if (allocated(DstWng_MiscVarTypeData%Area)) then - deallocate(DstWng_MiscVarTypeData%Area) end if if (allocated(SrcWng_MiscVarTypeData%diag_LL)) then LB(1:1) = lbound(SrcWng_MiscVarTypeData%diag_LL) @@ -2201,8 +2129,6 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat end if end if DstWng_MiscVarTypeData%diag_LL = SrcWng_MiscVarTypeData%diag_LL - else if (allocated(DstWng_MiscVarTypeData%diag_LL)) then - deallocate(DstWng_MiscVarTypeData%diag_LL) end if if (allocated(SrcWng_MiscVarTypeData%Vind_CP)) then LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vind_CP) @@ -2215,8 +2141,6 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat end if end if DstWng_MiscVarTypeData%Vind_CP = SrcWng_MiscVarTypeData%Vind_CP - else if (allocated(DstWng_MiscVarTypeData%Vind_CP)) then - deallocate(DstWng_MiscVarTypeData%Vind_CP) end if if (allocated(SrcWng_MiscVarTypeData%Vtot_CP)) then LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vtot_CP) @@ -2229,8 +2153,6 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat end if end if DstWng_MiscVarTypeData%Vtot_CP = SrcWng_MiscVarTypeData%Vtot_CP - else if (allocated(DstWng_MiscVarTypeData%Vtot_CP)) then - deallocate(DstWng_MiscVarTypeData%Vtot_CP) end if if (allocated(SrcWng_MiscVarTypeData%Vstr_CP)) then LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vstr_CP) @@ -2243,8 +2165,6 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat end if end if DstWng_MiscVarTypeData%Vstr_CP = SrcWng_MiscVarTypeData%Vstr_CP - else if (allocated(DstWng_MiscVarTypeData%Vstr_CP)) then - deallocate(DstWng_MiscVarTypeData%Vstr_CP) end if if (allocated(SrcWng_MiscVarTypeData%Vwnd_CP)) then LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vwnd_CP) @@ -2257,8 +2177,6 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat end if end if DstWng_MiscVarTypeData%Vwnd_CP = SrcWng_MiscVarTypeData%Vwnd_CP - else if (allocated(DstWng_MiscVarTypeData%Vwnd_CP)) then - deallocate(DstWng_MiscVarTypeData%Vwnd_CP) end if if (allocated(SrcWng_MiscVarTypeData%Vwnd_NW)) then LB(1:3) = lbound(SrcWng_MiscVarTypeData%Vwnd_NW) @@ -2271,8 +2189,6 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat end if end if DstWng_MiscVarTypeData%Vwnd_NW = SrcWng_MiscVarTypeData%Vwnd_NW - else if (allocated(DstWng_MiscVarTypeData%Vwnd_NW)) then - deallocate(DstWng_MiscVarTypeData%Vwnd_NW) end if if (allocated(SrcWng_MiscVarTypeData%Vwnd_FW)) then LB(1:3) = lbound(SrcWng_MiscVarTypeData%Vwnd_FW) @@ -2285,8 +2201,6 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat end if end if DstWng_MiscVarTypeData%Vwnd_FW = SrcWng_MiscVarTypeData%Vwnd_FW - else if (allocated(DstWng_MiscVarTypeData%Vwnd_FW)) then - deallocate(DstWng_MiscVarTypeData%Vwnd_FW) end if if (allocated(SrcWng_MiscVarTypeData%Vind_NW)) then LB(1:3) = lbound(SrcWng_MiscVarTypeData%Vind_NW) @@ -2299,8 +2213,6 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat end if end if DstWng_MiscVarTypeData%Vind_NW = SrcWng_MiscVarTypeData%Vind_NW - else if (allocated(DstWng_MiscVarTypeData%Vind_NW)) then - deallocate(DstWng_MiscVarTypeData%Vind_NW) end if if (allocated(SrcWng_MiscVarTypeData%Vind_FW)) then LB(1:3) = lbound(SrcWng_MiscVarTypeData%Vind_FW) @@ -2313,8 +2225,6 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat end if end if DstWng_MiscVarTypeData%Vind_FW = SrcWng_MiscVarTypeData%Vind_FW - else if (allocated(DstWng_MiscVarTypeData%Vind_FW)) then - deallocate(DstWng_MiscVarTypeData%Vind_FW) end if if (allocated(SrcWng_MiscVarTypeData%PitchAndTwist)) then LB(1:1) = lbound(SrcWng_MiscVarTypeData%PitchAndTwist) @@ -2327,8 +2237,6 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat end if end if DstWng_MiscVarTypeData%PitchAndTwist = SrcWng_MiscVarTypeData%PitchAndTwist - else if (allocated(DstWng_MiscVarTypeData%PitchAndTwist)) then - deallocate(DstWng_MiscVarTypeData%PitchAndTwist) end if DstWng_MiscVarTypeData%iTip = SrcWng_MiscVarTypeData%iTip DstWng_MiscVarTypeData%iRoot = SrcWng_MiscVarTypeData%iRoot @@ -2343,8 +2251,6 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat end if end if DstWng_MiscVarTypeData%alpha_LL = SrcWng_MiscVarTypeData%alpha_LL - else if (allocated(DstWng_MiscVarTypeData%alpha_LL)) then - deallocate(DstWng_MiscVarTypeData%alpha_LL) end if if (allocated(SrcWng_MiscVarTypeData%Vreln_LL)) then LB(1:1) = lbound(SrcWng_MiscVarTypeData%Vreln_LL) @@ -2357,8 +2263,6 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat end if end if DstWng_MiscVarTypeData%Vreln_LL = SrcWng_MiscVarTypeData%Vreln_LL - else if (allocated(DstWng_MiscVarTypeData%Vreln_LL)) then - deallocate(DstWng_MiscVarTypeData%Vreln_LL) end if if (allocated(SrcWng_MiscVarTypeData%u_UA)) then LB(1:2) = lbound(SrcWng_MiscVarTypeData%u_UA) @@ -2377,8 +2281,6 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat if (ErrStat >= AbortErrLev) return end do end do - else if (allocated(DstWng_MiscVarTypeData%u_UA)) then - deallocate(DstWng_MiscVarTypeData%u_UA) end if call UA_CopyMisc(SrcWng_MiscVarTypeData%m_UA, DstWng_MiscVarTypeData%m_UA, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2400,8 +2302,6 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat end if end if DstWng_MiscVarTypeData%Vind_LL = SrcWng_MiscVarTypeData%Vind_LL - else if (allocated(DstWng_MiscVarTypeData%Vind_LL)) then - deallocate(DstWng_MiscVarTypeData%Vind_LL) end if if (allocated(SrcWng_MiscVarTypeData%BN_AxInd)) then LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_AxInd) @@ -2414,8 +2314,6 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat end if end if DstWng_MiscVarTypeData%BN_AxInd = SrcWng_MiscVarTypeData%BN_AxInd - else if (allocated(DstWng_MiscVarTypeData%BN_AxInd)) then - deallocate(DstWng_MiscVarTypeData%BN_AxInd) end if if (allocated(SrcWng_MiscVarTypeData%BN_TanInd)) then LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_TanInd) @@ -2428,8 +2326,6 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat end if end if DstWng_MiscVarTypeData%BN_TanInd = SrcWng_MiscVarTypeData%BN_TanInd - else if (allocated(DstWng_MiscVarTypeData%BN_TanInd)) then - deallocate(DstWng_MiscVarTypeData%BN_TanInd) end if if (allocated(SrcWng_MiscVarTypeData%BN_Vrel)) then LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Vrel) @@ -2442,8 +2338,6 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat end if end if DstWng_MiscVarTypeData%BN_Vrel = SrcWng_MiscVarTypeData%BN_Vrel - else if (allocated(DstWng_MiscVarTypeData%BN_Vrel)) then - deallocate(DstWng_MiscVarTypeData%BN_Vrel) end if if (allocated(SrcWng_MiscVarTypeData%BN_alpha)) then LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_alpha) @@ -2456,8 +2350,6 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat end if end if DstWng_MiscVarTypeData%BN_alpha = SrcWng_MiscVarTypeData%BN_alpha - else if (allocated(DstWng_MiscVarTypeData%BN_alpha)) then - deallocate(DstWng_MiscVarTypeData%BN_alpha) end if if (allocated(SrcWng_MiscVarTypeData%BN_phi)) then LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_phi) @@ -2470,8 +2362,6 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat end if end if DstWng_MiscVarTypeData%BN_phi = SrcWng_MiscVarTypeData%BN_phi - else if (allocated(DstWng_MiscVarTypeData%BN_phi)) then - deallocate(DstWng_MiscVarTypeData%BN_phi) end if if (allocated(SrcWng_MiscVarTypeData%BN_Re)) then LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Re) @@ -2484,8 +2374,6 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat end if end if DstWng_MiscVarTypeData%BN_Re = SrcWng_MiscVarTypeData%BN_Re - else if (allocated(DstWng_MiscVarTypeData%BN_Re)) then - deallocate(DstWng_MiscVarTypeData%BN_Re) end if if (allocated(SrcWng_MiscVarTypeData%BN_URelWind_s)) then LB(1:2) = lbound(SrcWng_MiscVarTypeData%BN_URelWind_s) @@ -2498,8 +2386,6 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat end if end if DstWng_MiscVarTypeData%BN_URelWind_s = SrcWng_MiscVarTypeData%BN_URelWind_s - else if (allocated(DstWng_MiscVarTypeData%BN_URelWind_s)) then - deallocate(DstWng_MiscVarTypeData%BN_URelWind_s) end if if (allocated(SrcWng_MiscVarTypeData%BN_Cl_Static)) then LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cl_Static) @@ -2512,8 +2398,6 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat end if end if DstWng_MiscVarTypeData%BN_Cl_Static = SrcWng_MiscVarTypeData%BN_Cl_Static - else if (allocated(DstWng_MiscVarTypeData%BN_Cl_Static)) then - deallocate(DstWng_MiscVarTypeData%BN_Cl_Static) end if if (allocated(SrcWng_MiscVarTypeData%BN_Cd_Static)) then LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cd_Static) @@ -2526,8 +2410,6 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat end if end if DstWng_MiscVarTypeData%BN_Cd_Static = SrcWng_MiscVarTypeData%BN_Cd_Static - else if (allocated(DstWng_MiscVarTypeData%BN_Cd_Static)) then - deallocate(DstWng_MiscVarTypeData%BN_Cd_Static) end if if (allocated(SrcWng_MiscVarTypeData%BN_Cm_Static)) then LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cm_Static) @@ -2540,8 +2422,6 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat end if end if DstWng_MiscVarTypeData%BN_Cm_Static = SrcWng_MiscVarTypeData%BN_Cm_Static - else if (allocated(DstWng_MiscVarTypeData%BN_Cm_Static)) then - deallocate(DstWng_MiscVarTypeData%BN_Cm_Static) end if if (allocated(SrcWng_MiscVarTypeData%BN_Cpmin)) then LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cpmin) @@ -2554,8 +2434,6 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat end if end if DstWng_MiscVarTypeData%BN_Cpmin = SrcWng_MiscVarTypeData%BN_Cpmin - else if (allocated(DstWng_MiscVarTypeData%BN_Cpmin)) then - deallocate(DstWng_MiscVarTypeData%BN_Cpmin) end if if (allocated(SrcWng_MiscVarTypeData%BN_Cl)) then LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cl) @@ -2568,8 +2446,6 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat end if end if DstWng_MiscVarTypeData%BN_Cl = SrcWng_MiscVarTypeData%BN_Cl - else if (allocated(DstWng_MiscVarTypeData%BN_Cl)) then - deallocate(DstWng_MiscVarTypeData%BN_Cl) end if if (allocated(SrcWng_MiscVarTypeData%BN_Cd)) then LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cd) @@ -2582,8 +2458,6 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat end if end if DstWng_MiscVarTypeData%BN_Cd = SrcWng_MiscVarTypeData%BN_Cd - else if (allocated(DstWng_MiscVarTypeData%BN_Cd)) then - deallocate(DstWng_MiscVarTypeData%BN_Cd) end if if (allocated(SrcWng_MiscVarTypeData%BN_Cm)) then LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cm) @@ -2596,8 +2470,6 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat end if end if DstWng_MiscVarTypeData%BN_Cm = SrcWng_MiscVarTypeData%BN_Cm - else if (allocated(DstWng_MiscVarTypeData%BN_Cm)) then - deallocate(DstWng_MiscVarTypeData%BN_Cm) end if if (allocated(SrcWng_MiscVarTypeData%BN_Cx)) then LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cx) @@ -2610,8 +2482,6 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat end if end if DstWng_MiscVarTypeData%BN_Cx = SrcWng_MiscVarTypeData%BN_Cx - else if (allocated(DstWng_MiscVarTypeData%BN_Cx)) then - deallocate(DstWng_MiscVarTypeData%BN_Cx) end if if (allocated(SrcWng_MiscVarTypeData%BN_Cy)) then LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cy) @@ -2624,8 +2494,6 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat end if end if DstWng_MiscVarTypeData%BN_Cy = SrcWng_MiscVarTypeData%BN_Cy - else if (allocated(DstWng_MiscVarTypeData%BN_Cy)) then - deallocate(DstWng_MiscVarTypeData%BN_Cy) end if end subroutine @@ -3584,8 +3452,6 @@ subroutine FVW_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstMiscData%W)) then - deallocate(DstMiscData%W) end if DstMiscData%FirstCall = SrcMiscData%FirstCall DstMiscData%nNW = SrcMiscData%nNW @@ -3604,8 +3470,6 @@ subroutine FVW_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%r_wind = SrcMiscData%r_wind - else if (allocated(DstMiscData%r_wind)) then - deallocate(DstMiscData%r_wind) end if DstMiscData%ComputeWakeInduced = SrcMiscData%ComputeWakeInduced DstMiscData%OldWakeTime = SrcMiscData%OldWakeTime @@ -3638,8 +3502,6 @@ subroutine FVW_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%CPs = SrcMiscData%CPs - else if (allocated(DstMiscData%CPs)) then - deallocate(DstMiscData%CPs) end if if (allocated(SrcMiscData%Uind)) then LB(1:2) = lbound(SrcMiscData%Uind) @@ -3652,8 +3514,6 @@ subroutine FVW_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%Uind = SrcMiscData%Uind - else if (allocated(DstMiscData%Uind)) then - deallocate(DstMiscData%Uind) end if if (allocated(SrcMiscData%GridOutputs)) then LB(1:1) = lbound(SrcMiscData%GridOutputs) @@ -3670,8 +3530,6 @@ subroutine FVW_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstMiscData%GridOutputs)) then - deallocate(DstMiscData%GridOutputs) end if end subroutine @@ -3959,8 +3817,6 @@ subroutine FVW_CopyWng_InputType(SrcWng_InputTypeData, DstWng_InputTypeData, Ctr end if end if DstWng_InputTypeData%Vwnd_LL = SrcWng_InputTypeData%Vwnd_LL - else if (allocated(DstWng_InputTypeData%Vwnd_LL)) then - deallocate(DstWng_InputTypeData%Vwnd_LL) end if if (allocated(SrcWng_InputTypeData%omega_z)) then LB(1:1) = lbound(SrcWng_InputTypeData%omega_z) @@ -3973,8 +3829,6 @@ subroutine FVW_CopyWng_InputType(SrcWng_InputTypeData, DstWng_InputTypeData, Ctr end if end if DstWng_InputTypeData%omega_z = SrcWng_InputTypeData%omega_z - else if (allocated(DstWng_InputTypeData%omega_z)) then - deallocate(DstWng_InputTypeData%omega_z) end if end subroutine @@ -4077,8 +3931,6 @@ subroutine FVW_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstInputData%rotors)) then - deallocate(DstInputData%rotors) end if if (allocated(SrcInputData%W)) then LB(1:1) = lbound(SrcInputData%W) @@ -4095,8 +3947,6 @@ subroutine FVW_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstInputData%W)) then - deallocate(DstInputData%W) end if if (allocated(SrcInputData%WingsMesh)) then LB(1:1) = lbound(SrcInputData%WingsMesh) @@ -4113,8 +3963,6 @@ subroutine FVW_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstInputData%WingsMesh)) then - deallocate(DstInputData%WingsMesh) end if if (allocated(SrcInputData%V_wind)) then LB(1:2) = lbound(SrcInputData%V_wind) @@ -4127,8 +3975,6 @@ subroutine FVW_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%V_wind = SrcInputData%V_wind - else if (allocated(DstInputData%V_wind)) then - deallocate(DstInputData%V_wind) end if end subroutine @@ -4316,8 +4162,6 @@ subroutine FVW_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSt call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstDiscStateData%UA)) then - deallocate(DstDiscStateData%UA) end if end subroutine @@ -4413,8 +4257,6 @@ subroutine FVW_CopyWng_ConstraintStateType(SrcWng_ConstraintStateTypeData, DstWn end if end if DstWng_ConstraintStateTypeData%Gamma_LL = SrcWng_ConstraintStateTypeData%Gamma_LL - else if (allocated(DstWng_ConstraintStateTypeData%Gamma_LL)) then - deallocate(DstWng_ConstraintStateTypeData%Gamma_LL) end if end subroutine @@ -4495,8 +4337,6 @@ subroutine FVW_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstConstrStateData%W)) then - deallocate(DstConstrStateData%W) end if DstConstrStateData%residual = SrcConstrStateData%residual end subroutine @@ -4600,8 +4440,6 @@ subroutine FVW_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstOtherStateData%UA)) then - deallocate(DstOtherStateData%UA) end if end subroutine @@ -4697,8 +4535,6 @@ subroutine FVW_CopyWng_InitInputType(SrcWng_InitInputTypeData, DstWng_InitInputT end if end if DstWng_InitInputTypeData%AFindx = SrcWng_InitInputTypeData%AFindx - else if (allocated(DstWng_InitInputTypeData%AFindx)) then - deallocate(DstWng_InitInputTypeData%AFindx) end if if (allocated(SrcWng_InitInputTypeData%chord)) then LB(1:1) = lbound(SrcWng_InitInputTypeData%chord) @@ -4711,8 +4547,6 @@ subroutine FVW_CopyWng_InitInputType(SrcWng_InitInputTypeData, DstWng_InitInputT end if end if DstWng_InitInputTypeData%chord = SrcWng_InitInputTypeData%chord - else if (allocated(DstWng_InitInputTypeData%chord)) then - deallocate(DstWng_InitInputTypeData%chord) end if if (allocated(SrcWng_InitInputTypeData%RElm)) then LB(1:1) = lbound(SrcWng_InitInputTypeData%RElm) @@ -4725,8 +4559,6 @@ subroutine FVW_CopyWng_InitInputType(SrcWng_InitInputTypeData, DstWng_InitInputT end if end if DstWng_InitInputTypeData%RElm = SrcWng_InitInputTypeData%RElm - else if (allocated(DstWng_InitInputTypeData%RElm)) then - deallocate(DstWng_InitInputTypeData%RElm) end if DstWng_InitInputTypeData%iRotor = SrcWng_InitInputTypeData%iRotor DstWng_InitInputTypeData%UAOff_innerNode = SrcWng_InitInputTypeData%UAOff_innerNode @@ -4865,8 +4697,6 @@ subroutine FVW_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSt call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstInitInputData%W)) then - deallocate(DstInitInputData%W) end if if (allocated(SrcInitInputData%WingsMesh)) then LB(1:1) = lbound(SrcInitInputData%WingsMesh) @@ -4883,8 +4713,6 @@ subroutine FVW_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSt call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstInitInputData%WingsMesh)) then - deallocate(DstInitInputData%WingsMesh) end if DstInitInputData%numBladeNodes = SrcInitInputData%numBladeNodes DstInitInputData%DTaero = SrcInitInputData%DTaero diff --git a/modules/aerodyn/src/UnsteadyAero_Types.f90 b/modules/aerodyn/src/UnsteadyAero_Types.f90 index a458cb4a69..3e337e98a1 100644 --- a/modules/aerodyn/src/UnsteadyAero_Types.f90 +++ b/modules/aerodyn/src/UnsteadyAero_Types.f90 @@ -269,8 +269,6 @@ subroutine UA_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta end if end if DstInitInputData%c = SrcInitInputData%c - else if (allocated(DstInitInputData%c)) then - deallocate(DstInitInputData%c) end if DstInitInputData%numBlades = SrcInitInputData%numBlades DstInitInputData%nNodesPerBlade = SrcInitInputData%nNodesPerBlade @@ -290,8 +288,6 @@ subroutine UA_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta end if end if DstInitInputData%UAOff_innerNode = SrcInitInputData%UAOff_innerNode - else if (allocated(DstInitInputData%UAOff_innerNode)) then - deallocate(DstInitInputData%UAOff_innerNode) end if if (allocated(SrcInitInputData%UAOff_outerNode)) then LB(1:1) = lbound(SrcInitInputData%UAOff_outerNode) @@ -304,8 +300,6 @@ subroutine UA_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta end if end if DstInitInputData%UAOff_outerNode = SrcInitInputData%UAOff_outerNode - else if (allocated(DstInitInputData%UAOff_outerNode)) then - deallocate(DstInitInputData%UAOff_outerNode) end if end subroutine @@ -455,8 +449,6 @@ subroutine UA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr - else if (allocated(DstInitOutputData%WriteOutputHdr)) then - deallocate(DstInitOutputData%WriteOutputHdr) end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) @@ -469,8 +461,6 @@ subroutine UA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt - else if (allocated(DstInitOutputData%WriteOutputUnt)) then - deallocate(DstInitOutputData%WriteOutputUnt) end if end subroutine @@ -859,8 +849,6 @@ subroutine UA_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSta if (ErrStat >= AbortErrLev) return end do end do - else if (allocated(DstContStateData%element)) then - deallocate(DstContStateData%element) end if end subroutine @@ -959,8 +947,6 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%alpha_minus1 = SrcDiscStateData%alpha_minus1 - else if (allocated(DstDiscStateData%alpha_minus1)) then - deallocate(DstDiscStateData%alpha_minus1) end if if (allocated(SrcDiscStateData%alpha_filt_minus1)) then LB(1:2) = lbound(SrcDiscStateData%alpha_filt_minus1) @@ -973,8 +959,6 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%alpha_filt_minus1 = SrcDiscStateData%alpha_filt_minus1 - else if (allocated(DstDiscStateData%alpha_filt_minus1)) then - deallocate(DstDiscStateData%alpha_filt_minus1) end if if (allocated(SrcDiscStateData%alpha_dot)) then LB(1:2) = lbound(SrcDiscStateData%alpha_dot) @@ -987,8 +971,6 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%alpha_dot = SrcDiscStateData%alpha_dot - else if (allocated(DstDiscStateData%alpha_dot)) then - deallocate(DstDiscStateData%alpha_dot) end if if (allocated(SrcDiscStateData%alpha_dot_minus1)) then LB(1:2) = lbound(SrcDiscStateData%alpha_dot_minus1) @@ -1001,8 +983,6 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%alpha_dot_minus1 = SrcDiscStateData%alpha_dot_minus1 - else if (allocated(DstDiscStateData%alpha_dot_minus1)) then - deallocate(DstDiscStateData%alpha_dot_minus1) end if if (allocated(SrcDiscStateData%q_minus1)) then LB(1:2) = lbound(SrcDiscStateData%q_minus1) @@ -1015,8 +995,6 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%q_minus1 = SrcDiscStateData%q_minus1 - else if (allocated(DstDiscStateData%q_minus1)) then - deallocate(DstDiscStateData%q_minus1) end if if (allocated(SrcDiscStateData%Kalpha_f_minus1)) then LB(1:2) = lbound(SrcDiscStateData%Kalpha_f_minus1) @@ -1029,8 +1007,6 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%Kalpha_f_minus1 = SrcDiscStateData%Kalpha_f_minus1 - else if (allocated(DstDiscStateData%Kalpha_f_minus1)) then - deallocate(DstDiscStateData%Kalpha_f_minus1) end if if (allocated(SrcDiscStateData%Kq_f_minus1)) then LB(1:2) = lbound(SrcDiscStateData%Kq_f_minus1) @@ -1043,8 +1019,6 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%Kq_f_minus1 = SrcDiscStateData%Kq_f_minus1 - else if (allocated(DstDiscStateData%Kq_f_minus1)) then - deallocate(DstDiscStateData%Kq_f_minus1) end if if (allocated(SrcDiscStateData%q_f_minus1)) then LB(1:2) = lbound(SrcDiscStateData%q_f_minus1) @@ -1057,8 +1031,6 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%q_f_minus1 = SrcDiscStateData%q_f_minus1 - else if (allocated(DstDiscStateData%q_f_minus1)) then - deallocate(DstDiscStateData%q_f_minus1) end if if (allocated(SrcDiscStateData%X1_minus1)) then LB(1:2) = lbound(SrcDiscStateData%X1_minus1) @@ -1071,8 +1043,6 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%X1_minus1 = SrcDiscStateData%X1_minus1 - else if (allocated(DstDiscStateData%X1_minus1)) then - deallocate(DstDiscStateData%X1_minus1) end if if (allocated(SrcDiscStateData%X2_minus1)) then LB(1:2) = lbound(SrcDiscStateData%X2_minus1) @@ -1085,8 +1055,6 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%X2_minus1 = SrcDiscStateData%X2_minus1 - else if (allocated(DstDiscStateData%X2_minus1)) then - deallocate(DstDiscStateData%X2_minus1) end if if (allocated(SrcDiscStateData%X3_minus1)) then LB(1:2) = lbound(SrcDiscStateData%X3_minus1) @@ -1099,8 +1067,6 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%X3_minus1 = SrcDiscStateData%X3_minus1 - else if (allocated(DstDiscStateData%X3_minus1)) then - deallocate(DstDiscStateData%X3_minus1) end if if (allocated(SrcDiscStateData%X4_minus1)) then LB(1:2) = lbound(SrcDiscStateData%X4_minus1) @@ -1113,8 +1079,6 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%X4_minus1 = SrcDiscStateData%X4_minus1 - else if (allocated(DstDiscStateData%X4_minus1)) then - deallocate(DstDiscStateData%X4_minus1) end if if (allocated(SrcDiscStateData%Kprime_alpha_minus1)) then LB(1:2) = lbound(SrcDiscStateData%Kprime_alpha_minus1) @@ -1127,8 +1091,6 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%Kprime_alpha_minus1 = SrcDiscStateData%Kprime_alpha_minus1 - else if (allocated(DstDiscStateData%Kprime_alpha_minus1)) then - deallocate(DstDiscStateData%Kprime_alpha_minus1) end if if (allocated(SrcDiscStateData%Kprime_q_minus1)) then LB(1:2) = lbound(SrcDiscStateData%Kprime_q_minus1) @@ -1141,8 +1103,6 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%Kprime_q_minus1 = SrcDiscStateData%Kprime_q_minus1 - else if (allocated(DstDiscStateData%Kprime_q_minus1)) then - deallocate(DstDiscStateData%Kprime_q_minus1) end if if (allocated(SrcDiscStateData%Kprimeprime_q_minus1)) then LB(1:2) = lbound(SrcDiscStateData%Kprimeprime_q_minus1) @@ -1155,8 +1115,6 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%Kprimeprime_q_minus1 = SrcDiscStateData%Kprimeprime_q_minus1 - else if (allocated(DstDiscStateData%Kprimeprime_q_minus1)) then - deallocate(DstDiscStateData%Kprimeprime_q_minus1) end if if (allocated(SrcDiscStateData%K3prime_q_minus1)) then LB(1:2) = lbound(SrcDiscStateData%K3prime_q_minus1) @@ -1169,8 +1127,6 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%K3prime_q_minus1 = SrcDiscStateData%K3prime_q_minus1 - else if (allocated(DstDiscStateData%K3prime_q_minus1)) then - deallocate(DstDiscStateData%K3prime_q_minus1) end if if (allocated(SrcDiscStateData%Dp_minus1)) then LB(1:2) = lbound(SrcDiscStateData%Dp_minus1) @@ -1183,8 +1139,6 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%Dp_minus1 = SrcDiscStateData%Dp_minus1 - else if (allocated(DstDiscStateData%Dp_minus1)) then - deallocate(DstDiscStateData%Dp_minus1) end if if (allocated(SrcDiscStateData%Cn_pot_minus1)) then LB(1:2) = lbound(SrcDiscStateData%Cn_pot_minus1) @@ -1197,8 +1151,6 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%Cn_pot_minus1 = SrcDiscStateData%Cn_pot_minus1 - else if (allocated(DstDiscStateData%Cn_pot_minus1)) then - deallocate(DstDiscStateData%Cn_pot_minus1) end if if (allocated(SrcDiscStateData%fprimeprime_minus1)) then LB(1:2) = lbound(SrcDiscStateData%fprimeprime_minus1) @@ -1211,8 +1163,6 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%fprimeprime_minus1 = SrcDiscStateData%fprimeprime_minus1 - else if (allocated(DstDiscStateData%fprimeprime_minus1)) then - deallocate(DstDiscStateData%fprimeprime_minus1) end if if (allocated(SrcDiscStateData%fprimeprime_c_minus1)) then LB(1:2) = lbound(SrcDiscStateData%fprimeprime_c_minus1) @@ -1225,8 +1175,6 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%fprimeprime_c_minus1 = SrcDiscStateData%fprimeprime_c_minus1 - else if (allocated(DstDiscStateData%fprimeprime_c_minus1)) then - deallocate(DstDiscStateData%fprimeprime_c_minus1) end if if (allocated(SrcDiscStateData%fprimeprime_m_minus1)) then LB(1:2) = lbound(SrcDiscStateData%fprimeprime_m_minus1) @@ -1239,8 +1187,6 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%fprimeprime_m_minus1 = SrcDiscStateData%fprimeprime_m_minus1 - else if (allocated(DstDiscStateData%fprimeprime_m_minus1)) then - deallocate(DstDiscStateData%fprimeprime_m_minus1) end if if (allocated(SrcDiscStateData%Df_minus1)) then LB(1:2) = lbound(SrcDiscStateData%Df_minus1) @@ -1253,8 +1199,6 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%Df_minus1 = SrcDiscStateData%Df_minus1 - else if (allocated(DstDiscStateData%Df_minus1)) then - deallocate(DstDiscStateData%Df_minus1) end if if (allocated(SrcDiscStateData%Df_c_minus1)) then LB(1:2) = lbound(SrcDiscStateData%Df_c_minus1) @@ -1267,8 +1211,6 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%Df_c_minus1 = SrcDiscStateData%Df_c_minus1 - else if (allocated(DstDiscStateData%Df_c_minus1)) then - deallocate(DstDiscStateData%Df_c_minus1) end if if (allocated(SrcDiscStateData%Df_m_minus1)) then LB(1:2) = lbound(SrcDiscStateData%Df_m_minus1) @@ -1281,8 +1223,6 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%Df_m_minus1 = SrcDiscStateData%Df_m_minus1 - else if (allocated(DstDiscStateData%Df_m_minus1)) then - deallocate(DstDiscStateData%Df_m_minus1) end if if (allocated(SrcDiscStateData%Dalphaf_minus1)) then LB(1:2) = lbound(SrcDiscStateData%Dalphaf_minus1) @@ -1295,8 +1235,6 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%Dalphaf_minus1 = SrcDiscStateData%Dalphaf_minus1 - else if (allocated(DstDiscStateData%Dalphaf_minus1)) then - deallocate(DstDiscStateData%Dalphaf_minus1) end if if (allocated(SrcDiscStateData%alphaf_minus1)) then LB(1:2) = lbound(SrcDiscStateData%alphaf_minus1) @@ -1309,8 +1247,6 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%alphaf_minus1 = SrcDiscStateData%alphaf_minus1 - else if (allocated(DstDiscStateData%alphaf_minus1)) then - deallocate(DstDiscStateData%alphaf_minus1) end if if (allocated(SrcDiscStateData%fprime_minus1)) then LB(1:2) = lbound(SrcDiscStateData%fprime_minus1) @@ -1323,8 +1259,6 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%fprime_minus1 = SrcDiscStateData%fprime_minus1 - else if (allocated(DstDiscStateData%fprime_minus1)) then - deallocate(DstDiscStateData%fprime_minus1) end if if (allocated(SrcDiscStateData%fprime_c_minus1)) then LB(1:2) = lbound(SrcDiscStateData%fprime_c_minus1) @@ -1337,8 +1271,6 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%fprime_c_minus1 = SrcDiscStateData%fprime_c_minus1 - else if (allocated(DstDiscStateData%fprime_c_minus1)) then - deallocate(DstDiscStateData%fprime_c_minus1) end if if (allocated(SrcDiscStateData%fprime_m_minus1)) then LB(1:2) = lbound(SrcDiscStateData%fprime_m_minus1) @@ -1351,8 +1283,6 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%fprime_m_minus1 = SrcDiscStateData%fprime_m_minus1 - else if (allocated(DstDiscStateData%fprime_m_minus1)) then - deallocate(DstDiscStateData%fprime_m_minus1) end if if (allocated(SrcDiscStateData%tau_V)) then LB(1:2) = lbound(SrcDiscStateData%tau_V) @@ -1365,8 +1295,6 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%tau_V = SrcDiscStateData%tau_V - else if (allocated(DstDiscStateData%tau_V)) then - deallocate(DstDiscStateData%tau_V) end if if (allocated(SrcDiscStateData%tau_V_minus1)) then LB(1:2) = lbound(SrcDiscStateData%tau_V_minus1) @@ -1379,8 +1307,6 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%tau_V_minus1 = SrcDiscStateData%tau_V_minus1 - else if (allocated(DstDiscStateData%tau_V_minus1)) then - deallocate(DstDiscStateData%tau_V_minus1) end if if (allocated(SrcDiscStateData%Cn_v_minus1)) then LB(1:2) = lbound(SrcDiscStateData%Cn_v_minus1) @@ -1393,8 +1319,6 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%Cn_v_minus1 = SrcDiscStateData%Cn_v_minus1 - else if (allocated(DstDiscStateData%Cn_v_minus1)) then - deallocate(DstDiscStateData%Cn_v_minus1) end if if (allocated(SrcDiscStateData%C_V_minus1)) then LB(1:2) = lbound(SrcDiscStateData%C_V_minus1) @@ -1407,8 +1331,6 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%C_V_minus1 = SrcDiscStateData%C_V_minus1 - else if (allocated(DstDiscStateData%C_V_minus1)) then - deallocate(DstDiscStateData%C_V_minus1) end if if (allocated(SrcDiscStateData%Cn_prime_minus1)) then LB(1:2) = lbound(SrcDiscStateData%Cn_prime_minus1) @@ -1421,8 +1343,6 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%Cn_prime_minus1 = SrcDiscStateData%Cn_prime_minus1 - else if (allocated(DstDiscStateData%Cn_prime_minus1)) then - deallocate(DstDiscStateData%Cn_prime_minus1) end if end subroutine @@ -2264,8 +2184,6 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err end if end if DstOtherStateData%FirstPass = SrcOtherStateData%FirstPass - else if (allocated(DstOtherStateData%FirstPass)) then - deallocate(DstOtherStateData%FirstPass) end if if (allocated(SrcOtherStateData%sigma1)) then LB(1:2) = lbound(SrcOtherStateData%sigma1) @@ -2278,8 +2196,6 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err end if end if DstOtherStateData%sigma1 = SrcOtherStateData%sigma1 - else if (allocated(DstOtherStateData%sigma1)) then - deallocate(DstOtherStateData%sigma1) end if if (allocated(SrcOtherStateData%sigma1c)) then LB(1:2) = lbound(SrcOtherStateData%sigma1c) @@ -2292,8 +2208,6 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err end if end if DstOtherStateData%sigma1c = SrcOtherStateData%sigma1c - else if (allocated(DstOtherStateData%sigma1c)) then - deallocate(DstOtherStateData%sigma1c) end if if (allocated(SrcOtherStateData%sigma1m)) then LB(1:2) = lbound(SrcOtherStateData%sigma1m) @@ -2306,8 +2220,6 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err end if end if DstOtherStateData%sigma1m = SrcOtherStateData%sigma1m - else if (allocated(DstOtherStateData%sigma1m)) then - deallocate(DstOtherStateData%sigma1m) end if if (allocated(SrcOtherStateData%sigma3)) then LB(1:2) = lbound(SrcOtherStateData%sigma3) @@ -2320,8 +2232,6 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err end if end if DstOtherStateData%sigma3 = SrcOtherStateData%sigma3 - else if (allocated(DstOtherStateData%sigma3)) then - deallocate(DstOtherStateData%sigma3) end if if (allocated(SrcOtherStateData%n)) then LB(1:2) = lbound(SrcOtherStateData%n) @@ -2334,8 +2244,6 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err end if end if DstOtherStateData%n = SrcOtherStateData%n - else if (allocated(DstOtherStateData%n)) then - deallocate(DstOtherStateData%n) end if LB(1:1) = lbound(SrcOtherStateData%xdot) UB(1:1) = ubound(SrcOtherStateData%xdot) @@ -2355,8 +2263,6 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err end if end if DstOtherStateData%t_vortexBegin = SrcOtherStateData%t_vortexBegin - else if (allocated(DstOtherStateData%t_vortexBegin)) then - deallocate(DstOtherStateData%t_vortexBegin) end if if (allocated(SrcOtherStateData%SignOfOmega)) then LB(1:2) = lbound(SrcOtherStateData%SignOfOmega) @@ -2369,8 +2275,6 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err end if end if DstOtherStateData%SignOfOmega = SrcOtherStateData%SignOfOmega - else if (allocated(DstOtherStateData%SignOfOmega)) then - deallocate(DstOtherStateData%SignOfOmega) end if if (allocated(SrcOtherStateData%PositivePressure)) then LB(1:2) = lbound(SrcOtherStateData%PositivePressure) @@ -2383,8 +2287,6 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err end if end if DstOtherStateData%PositivePressure = SrcOtherStateData%PositivePressure - else if (allocated(DstOtherStateData%PositivePressure)) then - deallocate(DstOtherStateData%PositivePressure) end if if (allocated(SrcOtherStateData%vortexOn)) then LB(1:2) = lbound(SrcOtherStateData%vortexOn) @@ -2397,8 +2299,6 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err end if end if DstOtherStateData%vortexOn = SrcOtherStateData%vortexOn - else if (allocated(DstOtherStateData%vortexOn)) then - deallocate(DstOtherStateData%vortexOn) end if if (allocated(SrcOtherStateData%BelowThreshold)) then LB(1:2) = lbound(SrcOtherStateData%BelowThreshold) @@ -2411,8 +2311,6 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err end if end if DstOtherStateData%BelowThreshold = SrcOtherStateData%BelowThreshold - else if (allocated(DstOtherStateData%BelowThreshold)) then - deallocate(DstOtherStateData%BelowThreshold) end if if (allocated(SrcOtherStateData%activeL)) then LB(1:2) = lbound(SrcOtherStateData%activeL) @@ -2425,8 +2323,6 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err end if end if DstOtherStateData%activeL = SrcOtherStateData%activeL - else if (allocated(DstOtherStateData%activeL)) then - deallocate(DstOtherStateData%activeL) end if if (allocated(SrcOtherStateData%activeD)) then LB(1:2) = lbound(SrcOtherStateData%activeD) @@ -2439,8 +2335,6 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err end if end if DstOtherStateData%activeD = SrcOtherStateData%activeD - else if (allocated(DstOtherStateData%activeD)) then - deallocate(DstOtherStateData%activeD) end if end subroutine @@ -2805,8 +2699,6 @@ subroutine UA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%TESF = SrcMiscData%TESF - else if (allocated(DstMiscData%TESF)) then - deallocate(DstMiscData%TESF) end if if (allocated(SrcMiscData%LESF)) then LB(1:2) = lbound(SrcMiscData%LESF) @@ -2819,8 +2711,6 @@ subroutine UA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%LESF = SrcMiscData%LESF - else if (allocated(DstMiscData%LESF)) then - deallocate(DstMiscData%LESF) end if if (allocated(SrcMiscData%VRTX)) then LB(1:2) = lbound(SrcMiscData%VRTX) @@ -2833,8 +2723,6 @@ subroutine UA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%VRTX = SrcMiscData%VRTX - else if (allocated(DstMiscData%VRTX)) then - deallocate(DstMiscData%VRTX) end if if (allocated(SrcMiscData%T_Sh)) then LB(1:2) = lbound(SrcMiscData%T_Sh) @@ -2847,8 +2735,6 @@ subroutine UA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%T_Sh = SrcMiscData%T_Sh - else if (allocated(DstMiscData%T_Sh)) then - deallocate(DstMiscData%T_Sh) end if if (allocated(SrcMiscData%BEDSEP)) then LB(1:2) = lbound(SrcMiscData%BEDSEP) @@ -2861,8 +2747,6 @@ subroutine UA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%BEDSEP = SrcMiscData%BEDSEP - else if (allocated(DstMiscData%BEDSEP)) then - deallocate(DstMiscData%BEDSEP) end if if (allocated(SrcMiscData%weight)) then LB(1:2) = lbound(SrcMiscData%weight) @@ -2875,8 +2759,6 @@ subroutine UA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%weight = SrcMiscData%weight - else if (allocated(DstMiscData%weight)) then - deallocate(DstMiscData%weight) end if end subroutine @@ -3071,8 +2953,6 @@ subroutine UA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%c = SrcParamData%c - else if (allocated(DstParamData%c)) then - deallocate(DstParamData%c) end if DstParamData%numBlades = SrcParamData%numBlades DstParamData%nNodesPerBlade = SrcParamData%nNodesPerBlade @@ -3098,8 +2978,6 @@ subroutine UA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%UA_off_forGood = SrcParamData%UA_off_forGood - else if (allocated(DstParamData%UA_off_forGood)) then - deallocate(DstParamData%UA_off_forGood) end if end subroutine @@ -3302,8 +3180,6 @@ subroutine UA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg end if end if DstOutputData%WriteOutput = SrcOutputData%WriteOutput - else if (allocated(DstOutputData%WriteOutput)) then - deallocate(DstOutputData%WriteOutput) end if end subroutine diff --git a/modules/aerodyn14/src/AeroDyn14_Types.f90 b/modules/aerodyn14/src/AeroDyn14_Types.f90 index 9dd29d844f..e6b5a7a188 100644 --- a/modules/aerodyn14/src/AeroDyn14_Types.f90 +++ b/modules/aerodyn14/src/AeroDyn14_Types.f90 @@ -550,8 +550,6 @@ subroutine AD14_CopyAeroConfig(SrcAeroConfigData, DstAeroConfigData, CtrlCode, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstAeroConfigData%Blade)) then - deallocate(DstAeroConfigData%Blade) end if call AD14_CopyMarker(SrcAeroConfigData%Hub, DstAeroConfigData%Hub, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -697,8 +695,6 @@ subroutine AD14_CopyAirFoil(SrcAirFoilData, DstAirFoilData, CtrlCode, ErrStat, E end if end if DstAirFoilData%AL = SrcAirFoilData%AL - else if (allocated(DstAirFoilData%AL)) then - deallocate(DstAirFoilData%AL) end if if (allocated(SrcAirFoilData%CD)) then LB(1:3) = lbound(SrcAirFoilData%CD) @@ -711,8 +707,6 @@ subroutine AD14_CopyAirFoil(SrcAirFoilData, DstAirFoilData, CtrlCode, ErrStat, E end if end if DstAirFoilData%CD = SrcAirFoilData%CD - else if (allocated(DstAirFoilData%CD)) then - deallocate(DstAirFoilData%CD) end if if (allocated(SrcAirFoilData%CL)) then LB(1:3) = lbound(SrcAirFoilData%CL) @@ -725,8 +719,6 @@ subroutine AD14_CopyAirFoil(SrcAirFoilData, DstAirFoilData, CtrlCode, ErrStat, E end if end if DstAirFoilData%CL = SrcAirFoilData%CL - else if (allocated(DstAirFoilData%CL)) then - deallocate(DstAirFoilData%CL) end if if (allocated(SrcAirFoilData%CM)) then LB(1:3) = lbound(SrcAirFoilData%CM) @@ -739,8 +731,6 @@ subroutine AD14_CopyAirFoil(SrcAirFoilData, DstAirFoilData, CtrlCode, ErrStat, E end if end if DstAirFoilData%CM = SrcAirFoilData%CM - else if (allocated(DstAirFoilData%CM)) then - deallocate(DstAirFoilData%CM) end if DstAirFoilData%PMC = SrcAirFoilData%PMC DstAirFoilData%MulTabLoc = SrcAirFoilData%MulTabLoc @@ -890,8 +880,6 @@ subroutine AD14_CopyAirFoilParms(SrcAirFoilParmsData, DstAirFoilParmsData, CtrlC end if end if DstAirFoilParmsData%NTables = SrcAirFoilParmsData%NTables - else if (allocated(DstAirFoilParmsData%NTables)) then - deallocate(DstAirFoilParmsData%NTables) end if if (allocated(SrcAirFoilParmsData%NLift)) then LB(1:1) = lbound(SrcAirFoilParmsData%NLift) @@ -904,8 +892,6 @@ subroutine AD14_CopyAirFoilParms(SrcAirFoilParmsData, DstAirFoilParmsData, CtrlC end if end if DstAirFoilParmsData%NLift = SrcAirFoilParmsData%NLift - else if (allocated(DstAirFoilParmsData%NLift)) then - deallocate(DstAirFoilParmsData%NLift) end if DstAirFoilParmsData%NumCL = SrcAirFoilParmsData%NumCL DstAirFoilParmsData%NumFoil = SrcAirFoilParmsData%NumFoil @@ -920,8 +906,6 @@ subroutine AD14_CopyAirFoilParms(SrcAirFoilParmsData, DstAirFoilParmsData, CtrlC end if end if DstAirFoilParmsData%NFoil = SrcAirFoilParmsData%NFoil - else if (allocated(DstAirFoilParmsData%NFoil)) then - deallocate(DstAirFoilParmsData%NFoil) end if if (allocated(SrcAirFoilParmsData%MulTabMet)) then LB(1:2) = lbound(SrcAirFoilParmsData%MulTabMet) @@ -934,8 +918,6 @@ subroutine AD14_CopyAirFoilParms(SrcAirFoilParmsData, DstAirFoilParmsData, CtrlC end if end if DstAirFoilParmsData%MulTabMet = SrcAirFoilParmsData%MulTabMet - else if (allocated(DstAirFoilParmsData%MulTabMet)) then - deallocate(DstAirFoilParmsData%MulTabMet) end if if (allocated(SrcAirFoilParmsData%FoilNm)) then LB(1:1) = lbound(SrcAirFoilParmsData%FoilNm) @@ -948,8 +930,6 @@ subroutine AD14_CopyAirFoilParms(SrcAirFoilParmsData, DstAirFoilParmsData, CtrlC end if end if DstAirFoilParmsData%FoilNm = SrcAirFoilParmsData%FoilNm - else if (allocated(DstAirFoilParmsData%FoilNm)) then - deallocate(DstAirFoilParmsData%FoilNm) end if end subroutine @@ -1121,8 +1101,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%ADOT = SrcBeddoesData%ADOT - else if (allocated(DstBeddoesData%ADOT)) then - deallocate(DstBeddoesData%ADOT) end if if (allocated(SrcBeddoesData%ADOT1)) then LB(1:2) = lbound(SrcBeddoesData%ADOT1) @@ -1135,8 +1113,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%ADOT1 = SrcBeddoesData%ADOT1 - else if (allocated(DstBeddoesData%ADOT1)) then - deallocate(DstBeddoesData%ADOT1) end if if (allocated(SrcBeddoesData%AFE)) then LB(1:2) = lbound(SrcBeddoesData%AFE) @@ -1149,8 +1125,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%AFE = SrcBeddoesData%AFE - else if (allocated(DstBeddoesData%AFE)) then - deallocate(DstBeddoesData%AFE) end if if (allocated(SrcBeddoesData%AFE1)) then LB(1:2) = lbound(SrcBeddoesData%AFE1) @@ -1163,8 +1137,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%AFE1 = SrcBeddoesData%AFE1 - else if (allocated(DstBeddoesData%AFE1)) then - deallocate(DstBeddoesData%AFE1) end if DstBeddoesData%AN = SrcBeddoesData%AN if (allocated(SrcBeddoesData%ANE)) then @@ -1178,8 +1150,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%ANE = SrcBeddoesData%ANE - else if (allocated(DstBeddoesData%ANE)) then - deallocate(DstBeddoesData%ANE) end if if (allocated(SrcBeddoesData%ANE1)) then LB(1:2) = lbound(SrcBeddoesData%ANE1) @@ -1192,8 +1162,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%ANE1 = SrcBeddoesData%ANE1 - else if (allocated(DstBeddoesData%ANE1)) then - deallocate(DstBeddoesData%ANE1) end if if (allocated(SrcBeddoesData%AOD)) then LB(1:2) = lbound(SrcBeddoesData%AOD) @@ -1206,8 +1174,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%AOD = SrcBeddoesData%AOD - else if (allocated(DstBeddoesData%AOD)) then - deallocate(DstBeddoesData%AOD) end if if (allocated(SrcBeddoesData%AOL)) then LB(1:2) = lbound(SrcBeddoesData%AOL) @@ -1220,8 +1186,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%AOL = SrcBeddoesData%AOL - else if (allocated(DstBeddoesData%AOL)) then - deallocate(DstBeddoesData%AOL) end if if (allocated(SrcBeddoesData%BEDSEP)) then LB(1:2) = lbound(SrcBeddoesData%BEDSEP) @@ -1234,8 +1198,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%BEDSEP = SrcBeddoesData%BEDSEP - else if (allocated(DstBeddoesData%BEDSEP)) then - deallocate(DstBeddoesData%BEDSEP) end if if (allocated(SrcBeddoesData%OLDSEP)) then LB(1:2) = lbound(SrcBeddoesData%OLDSEP) @@ -1248,8 +1210,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%OLDSEP = SrcBeddoesData%OLDSEP - else if (allocated(DstBeddoesData%OLDSEP)) then - deallocate(DstBeddoesData%OLDSEP) end if DstBeddoesData%CC = SrcBeddoesData%CC if (allocated(SrcBeddoesData%CDO)) then @@ -1263,8 +1223,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%CDO = SrcBeddoesData%CDO - else if (allocated(DstBeddoesData%CDO)) then - deallocate(DstBeddoesData%CDO) end if DstBeddoesData%CMI = SrcBeddoesData%CMI DstBeddoesData%CMQ = SrcBeddoesData%CMQ @@ -1280,8 +1238,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%CNA = SrcBeddoesData%CNA - else if (allocated(DstBeddoesData%CNA)) then - deallocate(DstBeddoesData%CNA) end if DstBeddoesData%CNCP = SrcBeddoesData%CNCP DstBeddoesData%CNIQ = SrcBeddoesData%CNIQ @@ -1296,8 +1252,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%CNP = SrcBeddoesData%CNP - else if (allocated(DstBeddoesData%CNP)) then - deallocate(DstBeddoesData%CNP) end if if (allocated(SrcBeddoesData%CNP1)) then LB(1:2) = lbound(SrcBeddoesData%CNP1) @@ -1310,8 +1264,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%CNP1 = SrcBeddoesData%CNP1 - else if (allocated(DstBeddoesData%CNP1)) then - deallocate(DstBeddoesData%CNP1) end if if (allocated(SrcBeddoesData%CNPD)) then LB(1:2) = lbound(SrcBeddoesData%CNPD) @@ -1324,8 +1276,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%CNPD = SrcBeddoesData%CNPD - else if (allocated(DstBeddoesData%CNPD)) then - deallocate(DstBeddoesData%CNPD) end if if (allocated(SrcBeddoesData%CNPD1)) then LB(1:2) = lbound(SrcBeddoesData%CNPD1) @@ -1338,8 +1288,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%CNPD1 = SrcBeddoesData%CNPD1 - else if (allocated(DstBeddoesData%CNPD1)) then - deallocate(DstBeddoesData%CNPD1) end if if (allocated(SrcBeddoesData%CNPOT)) then LB(1:2) = lbound(SrcBeddoesData%CNPOT) @@ -1352,8 +1300,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%CNPOT = SrcBeddoesData%CNPOT - else if (allocated(DstBeddoesData%CNPOT)) then - deallocate(DstBeddoesData%CNPOT) end if if (allocated(SrcBeddoesData%CNPOT1)) then LB(1:2) = lbound(SrcBeddoesData%CNPOT1) @@ -1366,8 +1312,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%CNPOT1 = SrcBeddoesData%CNPOT1 - else if (allocated(DstBeddoesData%CNPOT1)) then - deallocate(DstBeddoesData%CNPOT1) end if if (allocated(SrcBeddoesData%CNS)) then LB(1:2) = lbound(SrcBeddoesData%CNS) @@ -1380,8 +1324,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%CNS = SrcBeddoesData%CNS - else if (allocated(DstBeddoesData%CNS)) then - deallocate(DstBeddoesData%CNS) end if if (allocated(SrcBeddoesData%CNSL)) then LB(1:2) = lbound(SrcBeddoesData%CNSL) @@ -1394,8 +1336,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%CNSL = SrcBeddoesData%CNSL - else if (allocated(DstBeddoesData%CNSL)) then - deallocate(DstBeddoesData%CNSL) end if if (allocated(SrcBeddoesData%CNV)) then LB(1:2) = lbound(SrcBeddoesData%CNV) @@ -1408,8 +1348,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%CNV = SrcBeddoesData%CNV - else if (allocated(DstBeddoesData%CNV)) then - deallocate(DstBeddoesData%CNV) end if if (allocated(SrcBeddoesData%CVN)) then LB(1:2) = lbound(SrcBeddoesData%CVN) @@ -1422,8 +1360,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%CVN = SrcBeddoesData%CVN - else if (allocated(DstBeddoesData%CVN)) then - deallocate(DstBeddoesData%CVN) end if if (allocated(SrcBeddoesData%CVN1)) then LB(1:2) = lbound(SrcBeddoesData%CVN1) @@ -1436,8 +1372,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%CVN1 = SrcBeddoesData%CVN1 - else if (allocated(DstBeddoesData%CVN1)) then - deallocate(DstBeddoesData%CVN1) end if if (allocated(SrcBeddoesData%DF)) then LB(1:2) = lbound(SrcBeddoesData%DF) @@ -1450,8 +1384,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%DF = SrcBeddoesData%DF - else if (allocated(DstBeddoesData%DF)) then - deallocate(DstBeddoesData%DF) end if if (allocated(SrcBeddoesData%DFAFE)) then LB(1:2) = lbound(SrcBeddoesData%DFAFE) @@ -1464,8 +1396,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%DFAFE = SrcBeddoesData%DFAFE - else if (allocated(DstBeddoesData%DFAFE)) then - deallocate(DstBeddoesData%DFAFE) end if if (allocated(SrcBeddoesData%DFAFE1)) then LB(1:2) = lbound(SrcBeddoesData%DFAFE1) @@ -1478,8 +1408,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%DFAFE1 = SrcBeddoesData%DFAFE1 - else if (allocated(DstBeddoesData%DFAFE1)) then - deallocate(DstBeddoesData%DFAFE1) end if if (allocated(SrcBeddoesData%DFC)) then LB(1:2) = lbound(SrcBeddoesData%DFC) @@ -1492,8 +1420,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%DFC = SrcBeddoesData%DFC - else if (allocated(DstBeddoesData%DFC)) then - deallocate(DstBeddoesData%DFC) end if if (allocated(SrcBeddoesData%DN)) then LB(1:2) = lbound(SrcBeddoesData%DN) @@ -1506,8 +1432,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%DN = SrcBeddoesData%DN - else if (allocated(DstBeddoesData%DN)) then - deallocate(DstBeddoesData%DN) end if if (allocated(SrcBeddoesData%DPP)) then LB(1:2) = lbound(SrcBeddoesData%DPP) @@ -1520,8 +1444,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%DPP = SrcBeddoesData%DPP - else if (allocated(DstBeddoesData%DPP)) then - deallocate(DstBeddoesData%DPP) end if if (allocated(SrcBeddoesData%DQ)) then LB(1:2) = lbound(SrcBeddoesData%DQ) @@ -1534,8 +1456,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%DQ = SrcBeddoesData%DQ - else if (allocated(DstBeddoesData%DQ)) then - deallocate(DstBeddoesData%DQ) end if if (allocated(SrcBeddoesData%DQP)) then LB(1:2) = lbound(SrcBeddoesData%DQP) @@ -1548,8 +1468,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%DQP = SrcBeddoesData%DQP - else if (allocated(DstBeddoesData%DQP)) then - deallocate(DstBeddoesData%DQP) end if if (allocated(SrcBeddoesData%DQP1)) then LB(1:2) = lbound(SrcBeddoesData%DQP1) @@ -1562,8 +1480,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%DQP1 = SrcBeddoesData%DQP1 - else if (allocated(DstBeddoesData%DQP1)) then - deallocate(DstBeddoesData%DQP1) end if DstBeddoesData%DS = SrcBeddoesData%DS DstBeddoesData%FK = SrcBeddoesData%FK @@ -1580,8 +1496,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%FSP = SrcBeddoesData%FSP - else if (allocated(DstBeddoesData%FSP)) then - deallocate(DstBeddoesData%FSP) end if if (allocated(SrcBeddoesData%FSP1)) then LB(1:2) = lbound(SrcBeddoesData%FSP1) @@ -1594,8 +1508,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%FSP1 = SrcBeddoesData%FSP1 - else if (allocated(DstBeddoesData%FSP1)) then - deallocate(DstBeddoesData%FSP1) end if if (allocated(SrcBeddoesData%FSPC)) then LB(1:2) = lbound(SrcBeddoesData%FSPC) @@ -1608,8 +1520,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%FSPC = SrcBeddoesData%FSPC - else if (allocated(DstBeddoesData%FSPC)) then - deallocate(DstBeddoesData%FSPC) end if if (allocated(SrcBeddoesData%FSPC1)) then LB(1:2) = lbound(SrcBeddoesData%FSPC1) @@ -1622,8 +1532,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%FSPC1 = SrcBeddoesData%FSPC1 - else if (allocated(DstBeddoesData%FSPC1)) then - deallocate(DstBeddoesData%FSPC1) end if if (allocated(SrcBeddoesData%FTB)) then LB(1:3) = lbound(SrcBeddoesData%FTB) @@ -1636,8 +1544,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%FTB = SrcBeddoesData%FTB - else if (allocated(DstBeddoesData%FTB)) then - deallocate(DstBeddoesData%FTB) end if if (allocated(SrcBeddoesData%FTBC)) then LB(1:3) = lbound(SrcBeddoesData%FTBC) @@ -1650,8 +1556,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%FTBC = SrcBeddoesData%FTBC - else if (allocated(DstBeddoesData%FTBC)) then - deallocate(DstBeddoesData%FTBC) end if if (allocated(SrcBeddoesData%OLDCNV)) then LB(1:2) = lbound(SrcBeddoesData%OLDCNV) @@ -1664,8 +1568,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%OLDCNV = SrcBeddoesData%OLDCNV - else if (allocated(DstBeddoesData%OLDCNV)) then - deallocate(DstBeddoesData%OLDCNV) end if if (allocated(SrcBeddoesData%OLDDF)) then LB(1:2) = lbound(SrcBeddoesData%OLDDF) @@ -1678,8 +1580,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%OLDDF = SrcBeddoesData%OLDDF - else if (allocated(DstBeddoesData%OLDDF)) then - deallocate(DstBeddoesData%OLDDF) end if if (allocated(SrcBeddoesData%OLDDFC)) then LB(1:2) = lbound(SrcBeddoesData%OLDDFC) @@ -1692,8 +1592,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%OLDDFC = SrcBeddoesData%OLDDFC - else if (allocated(DstBeddoesData%OLDDFC)) then - deallocate(DstBeddoesData%OLDDFC) end if if (allocated(SrcBeddoesData%OLDDN)) then LB(1:2) = lbound(SrcBeddoesData%OLDDN) @@ -1706,8 +1604,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%OLDDN = SrcBeddoesData%OLDDN - else if (allocated(DstBeddoesData%OLDDN)) then - deallocate(DstBeddoesData%OLDDN) end if if (allocated(SrcBeddoesData%OLDDPP)) then LB(1:2) = lbound(SrcBeddoesData%OLDDPP) @@ -1720,8 +1616,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%OLDDPP = SrcBeddoesData%OLDDPP - else if (allocated(DstBeddoesData%OLDDPP)) then - deallocate(DstBeddoesData%OLDDPP) end if if (allocated(SrcBeddoesData%OLDDQ)) then LB(1:2) = lbound(SrcBeddoesData%OLDDQ) @@ -1734,8 +1628,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%OLDDQ = SrcBeddoesData%OLDDQ - else if (allocated(DstBeddoesData%OLDDQ)) then - deallocate(DstBeddoesData%OLDDQ) end if if (allocated(SrcBeddoesData%OLDTAU)) then LB(1:2) = lbound(SrcBeddoesData%OLDTAU) @@ -1748,8 +1640,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%OLDTAU = SrcBeddoesData%OLDTAU - else if (allocated(DstBeddoesData%OLDTAU)) then - deallocate(DstBeddoesData%OLDTAU) end if if (allocated(SrcBeddoesData%OLDXN)) then LB(1:2) = lbound(SrcBeddoesData%OLDXN) @@ -1762,8 +1652,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%OLDXN = SrcBeddoesData%OLDXN - else if (allocated(DstBeddoesData%OLDXN)) then - deallocate(DstBeddoesData%OLDXN) end if if (allocated(SrcBeddoesData%OLDYN)) then LB(1:2) = lbound(SrcBeddoesData%OLDYN) @@ -1776,8 +1664,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%OLDYN = SrcBeddoesData%OLDYN - else if (allocated(DstBeddoesData%OLDYN)) then - deallocate(DstBeddoesData%OLDYN) end if if (allocated(SrcBeddoesData%QX)) then LB(1:2) = lbound(SrcBeddoesData%QX) @@ -1790,8 +1676,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%QX = SrcBeddoesData%QX - else if (allocated(DstBeddoesData%QX)) then - deallocate(DstBeddoesData%QX) end if if (allocated(SrcBeddoesData%QX1)) then LB(1:2) = lbound(SrcBeddoesData%QX1) @@ -1804,8 +1688,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%QX1 = SrcBeddoesData%QX1 - else if (allocated(DstBeddoesData%QX1)) then - deallocate(DstBeddoesData%QX1) end if if (allocated(SrcBeddoesData%TAU)) then LB(1:2) = lbound(SrcBeddoesData%TAU) @@ -1818,8 +1700,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%TAU = SrcBeddoesData%TAU - else if (allocated(DstBeddoesData%TAU)) then - deallocate(DstBeddoesData%TAU) end if if (allocated(SrcBeddoesData%XN)) then LB(1:2) = lbound(SrcBeddoesData%XN) @@ -1832,8 +1712,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%XN = SrcBeddoesData%XN - else if (allocated(DstBeddoesData%XN)) then - deallocate(DstBeddoesData%XN) end if if (allocated(SrcBeddoesData%YN)) then LB(1:2) = lbound(SrcBeddoesData%YN) @@ -1846,8 +1724,6 @@ subroutine AD14_CopyBeddoes(SrcBeddoesData, DstBeddoesData, CtrlCode, ErrStat, E end if end if DstBeddoesData%YN = SrcBeddoesData%YN - else if (allocated(DstBeddoesData%YN)) then - deallocate(DstBeddoesData%YN) end if DstBeddoesData%SHIFT = SrcBeddoesData%SHIFT DstBeddoesData%VOR = SrcBeddoesData%VOR @@ -3140,8 +3016,6 @@ subroutine AD14_CopyBladeParms(SrcBladeParmsData, DstBladeParmsData, CtrlCode, E end if end if DstBladeParmsData%C = SrcBladeParmsData%C - else if (allocated(DstBladeParmsData%C)) then - deallocate(DstBladeParmsData%C) end if if (allocated(SrcBladeParmsData%DR)) then LB(1:1) = lbound(SrcBladeParmsData%DR) @@ -3154,8 +3028,6 @@ subroutine AD14_CopyBladeParms(SrcBladeParmsData, DstBladeParmsData, CtrlCode, E end if end if DstBladeParmsData%DR = SrcBladeParmsData%DR - else if (allocated(DstBladeParmsData%DR)) then - deallocate(DstBladeParmsData%DR) end if DstBladeParmsData%R = SrcBladeParmsData%R DstBladeParmsData%BladeLength = SrcBladeParmsData%BladeLength @@ -3270,8 +3142,6 @@ subroutine AD14_CopyDynInflow(SrcDynInflowData, DstDynInflowData, CtrlCode, ErrS end if end if DstDynInflowData%RMC_SAVE = SrcDynInflowData%RMC_SAVE - else if (allocated(DstDynInflowData%RMC_SAVE)) then - deallocate(DstDynInflowData%RMC_SAVE) end if if (allocated(SrcDynInflowData%RMS_SAVE)) then LB(1:3) = lbound(SrcDynInflowData%RMS_SAVE) @@ -3284,8 +3154,6 @@ subroutine AD14_CopyDynInflow(SrcDynInflowData, DstDynInflowData, CtrlCode, ErrS end if end if DstDynInflowData%RMS_SAVE = SrcDynInflowData%RMS_SAVE - else if (allocated(DstDynInflowData%RMS_SAVE)) then - deallocate(DstDynInflowData%RMS_SAVE) end if DstDynInflowData%TipSpeed = SrcDynInflowData%TipSpeed DstDynInflowData%totalInf = SrcDynInflowData%totalInf @@ -3511,8 +3379,6 @@ subroutine AD14_CopyElement(SrcElementData, DstElementData, CtrlCode, ErrStat, E end if end if DstElementData%A = SrcElementData%A - else if (allocated(DstElementData%A)) then - deallocate(DstElementData%A) end if if (allocated(SrcElementData%AP)) then LB(1:2) = lbound(SrcElementData%AP) @@ -3525,8 +3391,6 @@ subroutine AD14_CopyElement(SrcElementData, DstElementData, CtrlCode, ErrStat, E end if end if DstElementData%AP = SrcElementData%AP - else if (allocated(DstElementData%AP)) then - deallocate(DstElementData%AP) end if if (allocated(SrcElementData%ALPHA)) then LB(1:2) = lbound(SrcElementData%ALPHA) @@ -3539,8 +3403,6 @@ subroutine AD14_CopyElement(SrcElementData, DstElementData, CtrlCode, ErrStat, E end if end if DstElementData%ALPHA = SrcElementData%ALPHA - else if (allocated(DstElementData%ALPHA)) then - deallocate(DstElementData%ALPHA) end if if (allocated(SrcElementData%W2)) then LB(1:2) = lbound(SrcElementData%W2) @@ -3553,8 +3415,6 @@ subroutine AD14_CopyElement(SrcElementData, DstElementData, CtrlCode, ErrStat, E end if end if DstElementData%W2 = SrcElementData%W2 - else if (allocated(DstElementData%W2)) then - deallocate(DstElementData%W2) end if if (allocated(SrcElementData%OLD_A_NS)) then LB(1:2) = lbound(SrcElementData%OLD_A_NS) @@ -3567,8 +3427,6 @@ subroutine AD14_CopyElement(SrcElementData, DstElementData, CtrlCode, ErrStat, E end if end if DstElementData%OLD_A_NS = SrcElementData%OLD_A_NS - else if (allocated(DstElementData%OLD_A_NS)) then - deallocate(DstElementData%OLD_A_NS) end if if (allocated(SrcElementData%OLD_AP_NS)) then LB(1:2) = lbound(SrcElementData%OLD_AP_NS) @@ -3581,8 +3439,6 @@ subroutine AD14_CopyElement(SrcElementData, DstElementData, CtrlCode, ErrStat, E end if end if DstElementData%OLD_AP_NS = SrcElementData%OLD_AP_NS - else if (allocated(DstElementData%OLD_AP_NS)) then - deallocate(DstElementData%OLD_AP_NS) end if if (allocated(SrcElementData%PITNOW)) then LB(1:2) = lbound(SrcElementData%PITNOW) @@ -3595,8 +3451,6 @@ subroutine AD14_CopyElement(SrcElementData, DstElementData, CtrlCode, ErrStat, E end if end if DstElementData%PITNOW = SrcElementData%PITNOW - else if (allocated(DstElementData%PITNOW)) then - deallocate(DstElementData%PITNOW) end if end subroutine @@ -3804,8 +3658,6 @@ subroutine AD14_CopyElementParms(SrcElementParmsData, DstElementParmsData, CtrlC end if end if DstElementParmsData%TWIST = SrcElementParmsData%TWIST - else if (allocated(DstElementParmsData%TWIST)) then - deallocate(DstElementParmsData%TWIST) end if if (allocated(SrcElementParmsData%RELM)) then LB(1:1) = lbound(SrcElementParmsData%RELM) @@ -3818,8 +3670,6 @@ subroutine AD14_CopyElementParms(SrcElementParmsData, DstElementParmsData, CtrlC end if end if DstElementParmsData%RELM = SrcElementParmsData%RELM - else if (allocated(DstElementParmsData%RELM)) then - deallocate(DstElementParmsData%RELM) end if if (allocated(SrcElementParmsData%HLCNST)) then LB(1:1) = lbound(SrcElementParmsData%HLCNST) @@ -3832,8 +3682,6 @@ subroutine AD14_CopyElementParms(SrcElementParmsData, DstElementParmsData, CtrlC end if end if DstElementParmsData%HLCNST = SrcElementParmsData%HLCNST - else if (allocated(DstElementParmsData%HLCNST)) then - deallocate(DstElementParmsData%HLCNST) end if if (allocated(SrcElementParmsData%TLCNST)) then LB(1:1) = lbound(SrcElementParmsData%TLCNST) @@ -3846,8 +3694,6 @@ subroutine AD14_CopyElementParms(SrcElementParmsData, DstElementParmsData, CtrlC end if end if DstElementParmsData%TLCNST = SrcElementParmsData%TLCNST - else if (allocated(DstElementParmsData%TLCNST)) then - deallocate(DstElementParmsData%TLCNST) end if end subroutine @@ -3991,8 +3837,6 @@ subroutine AD14_CopyElOutParms(SrcElOutParmsData, DstElOutParmsData, CtrlCode, E end if end if DstElOutParmsData%AAA = SrcElOutParmsData%AAA - else if (allocated(DstElOutParmsData%AAA)) then - deallocate(DstElOutParmsData%AAA) end if if (allocated(SrcElOutParmsData%AAP)) then LB(1:1) = lbound(SrcElOutParmsData%AAP) @@ -4005,8 +3849,6 @@ subroutine AD14_CopyElOutParms(SrcElOutParmsData, DstElOutParmsData, CtrlCode, E end if end if DstElOutParmsData%AAP = SrcElOutParmsData%AAP - else if (allocated(DstElOutParmsData%AAP)) then - deallocate(DstElOutParmsData%AAP) end if if (allocated(SrcElOutParmsData%ALF)) then LB(1:1) = lbound(SrcElOutParmsData%ALF) @@ -4019,8 +3861,6 @@ subroutine AD14_CopyElOutParms(SrcElOutParmsData, DstElOutParmsData, CtrlCode, E end if end if DstElOutParmsData%ALF = SrcElOutParmsData%ALF - else if (allocated(DstElOutParmsData%ALF)) then - deallocate(DstElOutParmsData%ALF) end if if (allocated(SrcElOutParmsData%CDD)) then LB(1:1) = lbound(SrcElOutParmsData%CDD) @@ -4033,8 +3873,6 @@ subroutine AD14_CopyElOutParms(SrcElOutParmsData, DstElOutParmsData, CtrlCode, E end if end if DstElOutParmsData%CDD = SrcElOutParmsData%CDD - else if (allocated(DstElOutParmsData%CDD)) then - deallocate(DstElOutParmsData%CDD) end if if (allocated(SrcElOutParmsData%CLL)) then LB(1:1) = lbound(SrcElOutParmsData%CLL) @@ -4047,8 +3885,6 @@ subroutine AD14_CopyElOutParms(SrcElOutParmsData, DstElOutParmsData, CtrlCode, E end if end if DstElOutParmsData%CLL = SrcElOutParmsData%CLL - else if (allocated(DstElOutParmsData%CLL)) then - deallocate(DstElOutParmsData%CLL) end if if (allocated(SrcElOutParmsData%CMM)) then LB(1:1) = lbound(SrcElOutParmsData%CMM) @@ -4061,8 +3897,6 @@ subroutine AD14_CopyElOutParms(SrcElOutParmsData, DstElOutParmsData, CtrlCode, E end if end if DstElOutParmsData%CMM = SrcElOutParmsData%CMM - else if (allocated(DstElOutParmsData%CMM)) then - deallocate(DstElOutParmsData%CMM) end if if (allocated(SrcElOutParmsData%CNN)) then LB(1:1) = lbound(SrcElOutParmsData%CNN) @@ -4075,8 +3909,6 @@ subroutine AD14_CopyElOutParms(SrcElOutParmsData, DstElOutParmsData, CtrlCode, E end if end if DstElOutParmsData%CNN = SrcElOutParmsData%CNN - else if (allocated(DstElOutParmsData%CNN)) then - deallocate(DstElOutParmsData%CNN) end if if (allocated(SrcElOutParmsData%CTT)) then LB(1:1) = lbound(SrcElOutParmsData%CTT) @@ -4089,8 +3921,6 @@ subroutine AD14_CopyElOutParms(SrcElOutParmsData, DstElOutParmsData, CtrlCode, E end if end if DstElOutParmsData%CTT = SrcElOutParmsData%CTT - else if (allocated(DstElOutParmsData%CTT)) then - deallocate(DstElOutParmsData%CTT) end if if (allocated(SrcElOutParmsData%DFNSAV)) then LB(1:1) = lbound(SrcElOutParmsData%DFNSAV) @@ -4103,8 +3933,6 @@ subroutine AD14_CopyElOutParms(SrcElOutParmsData, DstElOutParmsData, CtrlCode, E end if end if DstElOutParmsData%DFNSAV = SrcElOutParmsData%DFNSAV - else if (allocated(DstElOutParmsData%DFNSAV)) then - deallocate(DstElOutParmsData%DFNSAV) end if if (allocated(SrcElOutParmsData%DFTSAV)) then LB(1:1) = lbound(SrcElOutParmsData%DFTSAV) @@ -4117,8 +3945,6 @@ subroutine AD14_CopyElOutParms(SrcElOutParmsData, DstElOutParmsData, CtrlCode, E end if end if DstElOutParmsData%DFTSAV = SrcElOutParmsData%DFTSAV - else if (allocated(DstElOutParmsData%DFTSAV)) then - deallocate(DstElOutParmsData%DFTSAV) end if if (allocated(SrcElOutParmsData%DynPres)) then LB(1:1) = lbound(SrcElOutParmsData%DynPres) @@ -4131,8 +3957,6 @@ subroutine AD14_CopyElOutParms(SrcElOutParmsData, DstElOutParmsData, CtrlCode, E end if end if DstElOutParmsData%DynPres = SrcElOutParmsData%DynPres - else if (allocated(DstElOutParmsData%DynPres)) then - deallocate(DstElOutParmsData%DynPres) end if if (allocated(SrcElOutParmsData%PMM)) then LB(1:1) = lbound(SrcElOutParmsData%PMM) @@ -4145,8 +3969,6 @@ subroutine AD14_CopyElOutParms(SrcElOutParmsData, DstElOutParmsData, CtrlCode, E end if end if DstElOutParmsData%PMM = SrcElOutParmsData%PMM - else if (allocated(DstElOutParmsData%PMM)) then - deallocate(DstElOutParmsData%PMM) end if if (allocated(SrcElOutParmsData%PITSAV)) then LB(1:1) = lbound(SrcElOutParmsData%PITSAV) @@ -4159,8 +3981,6 @@ subroutine AD14_CopyElOutParms(SrcElOutParmsData, DstElOutParmsData, CtrlCode, E end if end if DstElOutParmsData%PITSAV = SrcElOutParmsData%PITSAV - else if (allocated(DstElOutParmsData%PITSAV)) then - deallocate(DstElOutParmsData%PITSAV) end if if (allocated(SrcElOutParmsData%ReyNum)) then LB(1:1) = lbound(SrcElOutParmsData%ReyNum) @@ -4173,8 +3993,6 @@ subroutine AD14_CopyElOutParms(SrcElOutParmsData, DstElOutParmsData, CtrlCode, E end if end if DstElOutParmsData%ReyNum = SrcElOutParmsData%ReyNum - else if (allocated(DstElOutParmsData%ReyNum)) then - deallocate(DstElOutParmsData%ReyNum) end if if (allocated(SrcElOutParmsData%Gamma)) then LB(1:1) = lbound(SrcElOutParmsData%Gamma) @@ -4187,8 +4005,6 @@ subroutine AD14_CopyElOutParms(SrcElOutParmsData, DstElOutParmsData, CtrlCode, E end if end if DstElOutParmsData%Gamma = SrcElOutParmsData%Gamma - else if (allocated(DstElOutParmsData%Gamma)) then - deallocate(DstElOutParmsData%Gamma) end if if (allocated(SrcElOutParmsData%SaveVX)) then LB(1:2) = lbound(SrcElOutParmsData%SaveVX) @@ -4201,8 +4017,6 @@ subroutine AD14_CopyElOutParms(SrcElOutParmsData, DstElOutParmsData, CtrlCode, E end if end if DstElOutParmsData%SaveVX = SrcElOutParmsData%SaveVX - else if (allocated(DstElOutParmsData%SaveVX)) then - deallocate(DstElOutParmsData%SaveVX) end if if (allocated(SrcElOutParmsData%SaveVY)) then LB(1:2) = lbound(SrcElOutParmsData%SaveVY) @@ -4215,8 +4029,6 @@ subroutine AD14_CopyElOutParms(SrcElOutParmsData, DstElOutParmsData, CtrlCode, E end if end if DstElOutParmsData%SaveVY = SrcElOutParmsData%SaveVY - else if (allocated(DstElOutParmsData%SaveVY)) then - deallocate(DstElOutParmsData%SaveVY) end if if (allocated(SrcElOutParmsData%SaveVZ)) then LB(1:2) = lbound(SrcElOutParmsData%SaveVZ) @@ -4229,8 +4041,6 @@ subroutine AD14_CopyElOutParms(SrcElOutParmsData, DstElOutParmsData, CtrlCode, E end if end if DstElOutParmsData%SaveVZ = SrcElOutParmsData%SaveVZ - else if (allocated(DstElOutParmsData%SaveVZ)) then - deallocate(DstElOutParmsData%SaveVZ) end if DstElOutParmsData%VXSAV = SrcElOutParmsData%VXSAV DstElOutParmsData%VYSAV = SrcElOutParmsData%VYSAV @@ -4247,8 +4057,6 @@ subroutine AD14_CopyElOutParms(SrcElOutParmsData, DstElOutParmsData, CtrlCode, E end if end if DstElOutParmsData%WndElPrList = SrcElOutParmsData%WndElPrList - else if (allocated(DstElOutParmsData%WndElPrList)) then - deallocate(DstElOutParmsData%WndElPrList) end if if (allocated(SrcElOutParmsData%WndElPrNum)) then LB(1:1) = lbound(SrcElOutParmsData%WndElPrNum) @@ -4261,8 +4069,6 @@ subroutine AD14_CopyElOutParms(SrcElOutParmsData, DstElOutParmsData, CtrlCode, E end if end if DstElOutParmsData%WndElPrNum = SrcElOutParmsData%WndElPrNum - else if (allocated(DstElOutParmsData%WndElPrNum)) then - deallocate(DstElOutParmsData%WndElPrNum) end if if (allocated(SrcElOutParmsData%ElPrList)) then LB(1:1) = lbound(SrcElOutParmsData%ElPrList) @@ -4275,8 +4081,6 @@ subroutine AD14_CopyElOutParms(SrcElOutParmsData, DstElOutParmsData, CtrlCode, E end if end if DstElOutParmsData%ElPrList = SrcElOutParmsData%ElPrList - else if (allocated(DstElOutParmsData%ElPrList)) then - deallocate(DstElOutParmsData%ElPrList) end if if (allocated(SrcElOutParmsData%ElPrNum)) then LB(1:1) = lbound(SrcElOutParmsData%ElPrNum) @@ -4289,8 +4093,6 @@ subroutine AD14_CopyElOutParms(SrcElOutParmsData, DstElOutParmsData, CtrlCode, E end if end if DstElOutParmsData%ElPrNum = SrcElOutParmsData%ElPrNum - else if (allocated(DstElOutParmsData%ElPrNum)) then - deallocate(DstElOutParmsData%ElPrNum) end if DstElOutParmsData%NumElOut = SrcElOutParmsData%NumElOut end subroutine @@ -5055,8 +4857,6 @@ subroutine AD14_CopyTwrPropsParms(SrcTwrPropsParmsData, DstTwrPropsParmsData, Ct end if end if DstTwrPropsParmsData%TwrHtFr = SrcTwrPropsParmsData%TwrHtFr - else if (allocated(DstTwrPropsParmsData%TwrHtFr)) then - deallocate(DstTwrPropsParmsData%TwrHtFr) end if if (allocated(SrcTwrPropsParmsData%TwrWid)) then LB(1:1) = lbound(SrcTwrPropsParmsData%TwrWid) @@ -5069,8 +4869,6 @@ subroutine AD14_CopyTwrPropsParms(SrcTwrPropsParmsData, DstTwrPropsParmsData, Ct end if end if DstTwrPropsParmsData%TwrWid = SrcTwrPropsParmsData%TwrWid - else if (allocated(DstTwrPropsParmsData%TwrWid)) then - deallocate(DstTwrPropsParmsData%TwrWid) end if if (allocated(SrcTwrPropsParmsData%TwrCD)) then LB(1:2) = lbound(SrcTwrPropsParmsData%TwrCD) @@ -5083,8 +4881,6 @@ subroutine AD14_CopyTwrPropsParms(SrcTwrPropsParmsData, DstTwrPropsParmsData, Ct end if end if DstTwrPropsParmsData%TwrCD = SrcTwrPropsParmsData%TwrCD - else if (allocated(DstTwrPropsParmsData%TwrCD)) then - deallocate(DstTwrPropsParmsData%TwrCD) end if if (allocated(SrcTwrPropsParmsData%TwrRe)) then LB(1:1) = lbound(SrcTwrPropsParmsData%TwrRe) @@ -5097,8 +4893,6 @@ subroutine AD14_CopyTwrPropsParms(SrcTwrPropsParmsData, DstTwrPropsParmsData, Ct end if end if DstTwrPropsParmsData%TwrRe = SrcTwrPropsParmsData%TwrRe - else if (allocated(DstTwrPropsParmsData%TwrRe)) then - deallocate(DstTwrPropsParmsData%TwrRe) end if DstTwrPropsParmsData%VTwr = SrcTwrPropsParmsData%VTwr DstTwrPropsParmsData%Tower_Wake_Constant = SrcTwrPropsParmsData%Tower_Wake_Constant @@ -5113,8 +4907,6 @@ subroutine AD14_CopyTwrPropsParms(SrcTwrPropsParmsData, DstTwrPropsParmsData, Ct end if end if DstTwrPropsParmsData%NTwrCDCol = SrcTwrPropsParmsData%NTwrCDCol - else if (allocated(DstTwrPropsParmsData%NTwrCDCol)) then - deallocate(DstTwrPropsParmsData%NTwrCDCol) end if DstTwrPropsParmsData%NTwrHT = SrcTwrPropsParmsData%NTwrHT DstTwrPropsParmsData%NTwrRe = SrcTwrPropsParmsData%NTwrRe @@ -5141,8 +4933,6 @@ subroutine AD14_CopyTwrPropsParms(SrcTwrPropsParmsData, DstTwrPropsParmsData, Ct end if end if DstTwrPropsParmsData%TwrNodeWidth = SrcTwrPropsParmsData%TwrNodeWidth - else if (allocated(DstTwrPropsParmsData%TwrNodeWidth)) then - deallocate(DstTwrPropsParmsData%TwrNodeWidth) end if end subroutine @@ -5568,8 +5358,6 @@ subroutine AD14_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS end if end if DstInitInputData%TwrNodeLocs = SrcInitInputData%TwrNodeLocs - else if (allocated(DstInitInputData%TwrNodeLocs)) then - deallocate(DstInitInputData%TwrNodeLocs) end if DstInitInputData%HubHt = SrcInitInputData%HubHt call DWM_CopyInitInput(SrcInitInputData%DWM, DstInitInputData%DWM, CtrlCode, ErrStat2, ErrMsg2) @@ -5940,8 +5728,6 @@ subroutine AD14_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%ElPrNum = SrcMiscData%ElPrNum - else if (allocated(DstMiscData%ElPrNum)) then - deallocate(DstMiscData%ElPrNum) end if DstMiscData%OldTime = SrcMiscData%OldTime DstMiscData%HubLoss = SrcMiscData%HubLoss @@ -5993,8 +5779,6 @@ subroutine AD14_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%StoredForces = SrcMiscData%StoredForces - else if (allocated(DstMiscData%StoredForces)) then - deallocate(DstMiscData%StoredForces) end if if (allocated(SrcMiscData%StoredMoments)) then LB(1:3) = lbound(SrcMiscData%StoredMoments) @@ -6007,8 +5791,6 @@ subroutine AD14_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%StoredMoments = SrcMiscData%StoredMoments - else if (allocated(DstMiscData%StoredMoments)) then - deallocate(DstMiscData%StoredMoments) end if end subroutine @@ -6436,8 +6218,6 @@ subroutine AD14_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstInputData%InputMarkers)) then - deallocate(DstInputData%InputMarkers) end if call MeshCopy(SrcInputData%Twr_InputMarkers, DstInputData%Twr_InputMarkers, CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6456,8 +6236,6 @@ subroutine AD14_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%MulTabLoc = SrcInputData%MulTabLoc - else if (allocated(DstInputData%MulTabLoc)) then - deallocate(DstInputData%MulTabLoc) end if if (allocated(SrcInputData%InflowVelocity)) then LB(1:2) = lbound(SrcInputData%InflowVelocity) @@ -6470,8 +6248,6 @@ subroutine AD14_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%InflowVelocity = SrcInputData%InflowVelocity - else if (allocated(DstInputData%InflowVelocity)) then - deallocate(DstInputData%InflowVelocity) end if DstInputData%AvgInfVel = SrcInputData%AvgInfVel end subroutine @@ -6626,8 +6402,6 @@ subroutine AD14_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstOutputData%OutputLoads)) then - deallocate(DstOutputData%OutputLoads) end if call MeshCopy(SrcOutputData%Twr_OutputLoads, DstOutputData%Twr_OutputLoads, CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) diff --git a/modules/aerodyn14/src/DWM_Types.f90 b/modules/aerodyn14/src/DWM_Types.f90 index c1e3d87061..4924f00a1b 100644 --- a/modules/aerodyn14/src/DWM_Types.f90 +++ b/modules/aerodyn14/src/DWM_Types.f90 @@ -396,8 +396,6 @@ subroutine DWM_Copyturbine_average_velocity_data(Srcturbine_average_velocity_dat end if end if Dstturbine_average_velocity_dataData%average_velocity_array_temp = Srcturbine_average_velocity_dataData%average_velocity_array_temp - else if (allocated(Dstturbine_average_velocity_dataData%average_velocity_array_temp)) then - deallocate(Dstturbine_average_velocity_dataData%average_velocity_array_temp) end if if (allocated(Srcturbine_average_velocity_dataData%average_velocity_array)) then LB(1:1) = lbound(Srcturbine_average_velocity_dataData%average_velocity_array) @@ -410,8 +408,6 @@ subroutine DWM_Copyturbine_average_velocity_data(Srcturbine_average_velocity_dat end if end if Dstturbine_average_velocity_dataData%average_velocity_array = Srcturbine_average_velocity_dataData%average_velocity_array - else if (allocated(Dstturbine_average_velocity_dataData%average_velocity_array)) then - deallocate(Dstturbine_average_velocity_dataData%average_velocity_array) end if if (allocated(Srcturbine_average_velocity_dataData%swept_area)) then LB(1:1) = lbound(Srcturbine_average_velocity_dataData%swept_area) @@ -424,8 +420,6 @@ subroutine DWM_Copyturbine_average_velocity_data(Srcturbine_average_velocity_dat end if end if Dstturbine_average_velocity_dataData%swept_area = Srcturbine_average_velocity_dataData%swept_area - else if (allocated(Dstturbine_average_velocity_dataData%swept_area)) then - deallocate(Dstturbine_average_velocity_dataData%swept_area) end if Dstturbine_average_velocity_dataData%time_step_velocity = Srcturbine_average_velocity_dataData%time_step_velocity if (allocated(Srcturbine_average_velocity_dataData%time_step_velocity_array)) then @@ -439,8 +433,6 @@ subroutine DWM_Copyturbine_average_velocity_data(Srcturbine_average_velocity_dat end if end if Dstturbine_average_velocity_dataData%time_step_velocity_array = Srcturbine_average_velocity_dataData%time_step_velocity_array - else if (allocated(Dstturbine_average_velocity_dataData%time_step_velocity_array)) then - deallocate(Dstturbine_average_velocity_dataData%time_step_velocity_array) end if Dstturbine_average_velocity_dataData%time_step_pass_velocity = Srcturbine_average_velocity_dataData%time_step_pass_velocity Dstturbine_average_velocity_dataData%time_step_force = Srcturbine_average_velocity_dataData%time_step_force @@ -594,8 +586,6 @@ subroutine DWM_CopyWake_Deficit_Data(SrcWake_Deficit_DataData, DstWake_Deficit_D end if end if DstWake_Deficit_DataData%Turb_Stress_DWM = SrcWake_Deficit_DataData%Turb_Stress_DWM - else if (allocated(DstWake_Deficit_DataData%Turb_Stress_DWM)) then - deallocate(DstWake_Deficit_DataData%Turb_Stress_DWM) end if DstWake_Deficit_DataData%n_x_vector = SrcWake_Deficit_DataData%n_x_vector DstWake_Deficit_DataData%n_r_vector = SrcWake_Deficit_DataData%n_r_vector @@ -732,8 +722,6 @@ subroutine DWM_Copyread_turbine_position_data(Srcread_turbine_position_dataData, end if end if Dstread_turbine_position_dataData%Turbine_sort_order = Srcread_turbine_position_dataData%Turbine_sort_order - else if (allocated(Dstread_turbine_position_dataData%Turbine_sort_order)) then - deallocate(Dstread_turbine_position_dataData%Turbine_sort_order) end if Dstread_turbine_position_dataData%WT_index = Srcread_turbine_position_dataData%WT_index if (allocated(Srcread_turbine_position_dataData%TurbineInfluenceData)) then @@ -747,8 +735,6 @@ subroutine DWM_Copyread_turbine_position_data(Srcread_turbine_position_dataData, end if end if Dstread_turbine_position_dataData%TurbineInfluenceData = Srcread_turbine_position_dataData%TurbineInfluenceData - else if (allocated(Dstread_turbine_position_dataData%TurbineInfluenceData)) then - deallocate(Dstread_turbine_position_dataData%TurbineInfluenceData) end if if (allocated(Srcread_turbine_position_dataData%upwind_turbine_index)) then LB(1:1) = lbound(Srcread_turbine_position_dataData%upwind_turbine_index) @@ -761,8 +747,6 @@ subroutine DWM_Copyread_turbine_position_data(Srcread_turbine_position_dataData, end if end if Dstread_turbine_position_dataData%upwind_turbine_index = Srcread_turbine_position_dataData%upwind_turbine_index - else if (allocated(Dstread_turbine_position_dataData%upwind_turbine_index)) then - deallocate(Dstread_turbine_position_dataData%upwind_turbine_index) end if if (allocated(Srcread_turbine_position_dataData%downwind_turbine_index)) then LB(1:1) = lbound(Srcread_turbine_position_dataData%downwind_turbine_index) @@ -775,8 +759,6 @@ subroutine DWM_Copyread_turbine_position_data(Srcread_turbine_position_dataData, end if end if Dstread_turbine_position_dataData%downwind_turbine_index = Srcread_turbine_position_dataData%downwind_turbine_index - else if (allocated(Dstread_turbine_position_dataData%downwind_turbine_index)) then - deallocate(Dstread_turbine_position_dataData%downwind_turbine_index) end if Dstread_turbine_position_dataData%upwindturbine_number = Srcread_turbine_position_dataData%upwindturbine_number Dstread_turbine_position_dataData%downwindturbine_number = Srcread_turbine_position_dataData%downwindturbine_number @@ -791,8 +773,6 @@ subroutine DWM_Copyread_turbine_position_data(Srcread_turbine_position_dataData, end if end if Dstread_turbine_position_dataData%turbine_windorigin_length = Srcread_turbine_position_dataData%turbine_windorigin_length - else if (allocated(Dstread_turbine_position_dataData%turbine_windorigin_length)) then - deallocate(Dstread_turbine_position_dataData%turbine_windorigin_length) end if if (allocated(Srcread_turbine_position_dataData%upwind_turbine_projected_distance)) then LB(1:1) = lbound(Srcread_turbine_position_dataData%upwind_turbine_projected_distance) @@ -805,8 +785,6 @@ subroutine DWM_Copyread_turbine_position_data(Srcread_turbine_position_dataData, end if end if Dstread_turbine_position_dataData%upwind_turbine_projected_distance = Srcread_turbine_position_dataData%upwind_turbine_projected_distance - else if (allocated(Dstread_turbine_position_dataData%upwind_turbine_projected_distance)) then - deallocate(Dstread_turbine_position_dataData%upwind_turbine_projected_distance) end if if (allocated(Srcread_turbine_position_dataData%downwind_turbine_projected_distance)) then LB(1:1) = lbound(Srcread_turbine_position_dataData%downwind_turbine_projected_distance) @@ -819,8 +797,6 @@ subroutine DWM_Copyread_turbine_position_data(Srcread_turbine_position_dataData, end if end if Dstread_turbine_position_dataData%downwind_turbine_projected_distance = Srcread_turbine_position_dataData%downwind_turbine_projected_distance - else if (allocated(Dstread_turbine_position_dataData%downwind_turbine_projected_distance)) then - deallocate(Dstread_turbine_position_dataData%downwind_turbine_projected_distance) end if if (allocated(Srcread_turbine_position_dataData%turbine_angle)) then LB(1:2) = lbound(Srcread_turbine_position_dataData%turbine_angle) @@ -833,8 +809,6 @@ subroutine DWM_Copyread_turbine_position_data(Srcread_turbine_position_dataData, end if end if Dstread_turbine_position_dataData%turbine_angle = Srcread_turbine_position_dataData%turbine_angle - else if (allocated(Dstread_turbine_position_dataData%turbine_angle)) then - deallocate(Dstread_turbine_position_dataData%turbine_angle) end if if (allocated(Srcread_turbine_position_dataData%upwind_align_angle)) then LB(1:1) = lbound(Srcread_turbine_position_dataData%upwind_align_angle) @@ -847,8 +821,6 @@ subroutine DWM_Copyread_turbine_position_data(Srcread_turbine_position_dataData, end if end if Dstread_turbine_position_dataData%upwind_align_angle = Srcread_turbine_position_dataData%upwind_align_angle - else if (allocated(Dstread_turbine_position_dataData%upwind_align_angle)) then - deallocate(Dstread_turbine_position_dataData%upwind_align_angle) end if if (allocated(Srcread_turbine_position_dataData%downwind_align_angle)) then LB(1:1) = lbound(Srcread_turbine_position_dataData%downwind_align_angle) @@ -861,8 +833,6 @@ subroutine DWM_Copyread_turbine_position_data(Srcread_turbine_position_dataData, end if end if Dstread_turbine_position_dataData%downwind_align_angle = Srcread_turbine_position_dataData%downwind_align_angle - else if (allocated(Dstread_turbine_position_dataData%downwind_align_angle)) then - deallocate(Dstread_turbine_position_dataData%downwind_align_angle) end if if (allocated(Srcread_turbine_position_dataData%upwind_turbine_Xcoor)) then LB(1:1) = lbound(Srcread_turbine_position_dataData%upwind_turbine_Xcoor) @@ -875,8 +845,6 @@ subroutine DWM_Copyread_turbine_position_data(Srcread_turbine_position_dataData, end if end if Dstread_turbine_position_dataData%upwind_turbine_Xcoor = Srcread_turbine_position_dataData%upwind_turbine_Xcoor - else if (allocated(Dstread_turbine_position_dataData%upwind_turbine_Xcoor)) then - deallocate(Dstread_turbine_position_dataData%upwind_turbine_Xcoor) end if if (allocated(Srcread_turbine_position_dataData%upwind_turbine_Ycoor)) then LB(1:1) = lbound(Srcread_turbine_position_dataData%upwind_turbine_Ycoor) @@ -889,8 +857,6 @@ subroutine DWM_Copyread_turbine_position_data(Srcread_turbine_position_dataData, end if end if Dstread_turbine_position_dataData%upwind_turbine_Ycoor = Srcread_turbine_position_dataData%upwind_turbine_Ycoor - else if (allocated(Dstread_turbine_position_dataData%upwind_turbine_Ycoor)) then - deallocate(Dstread_turbine_position_dataData%upwind_turbine_Ycoor) end if if (allocated(Srcread_turbine_position_dataData%wind_farm_Xcoor)) then LB(1:1) = lbound(Srcread_turbine_position_dataData%wind_farm_Xcoor) @@ -903,8 +869,6 @@ subroutine DWM_Copyread_turbine_position_data(Srcread_turbine_position_dataData, end if end if Dstread_turbine_position_dataData%wind_farm_Xcoor = Srcread_turbine_position_dataData%wind_farm_Xcoor - else if (allocated(Dstread_turbine_position_dataData%wind_farm_Xcoor)) then - deallocate(Dstread_turbine_position_dataData%wind_farm_Xcoor) end if if (allocated(Srcread_turbine_position_dataData%wind_farm_Ycoor)) then LB(1:1) = lbound(Srcread_turbine_position_dataData%wind_farm_Ycoor) @@ -917,8 +881,6 @@ subroutine DWM_Copyread_turbine_position_data(Srcread_turbine_position_dataData, end if end if Dstread_turbine_position_dataData%wind_farm_Ycoor = Srcread_turbine_position_dataData%wind_farm_Ycoor - else if (allocated(Dstread_turbine_position_dataData%wind_farm_Ycoor)) then - deallocate(Dstread_turbine_position_dataData%wind_farm_Ycoor) end if if (allocated(Srcread_turbine_position_dataData%downwind_turbine_Xcoor)) then LB(1:1) = lbound(Srcread_turbine_position_dataData%downwind_turbine_Xcoor) @@ -931,8 +893,6 @@ subroutine DWM_Copyread_turbine_position_data(Srcread_turbine_position_dataData, end if end if Dstread_turbine_position_dataData%downwind_turbine_Xcoor = Srcread_turbine_position_dataData%downwind_turbine_Xcoor - else if (allocated(Dstread_turbine_position_dataData%downwind_turbine_Xcoor)) then - deallocate(Dstread_turbine_position_dataData%downwind_turbine_Xcoor) end if if (allocated(Srcread_turbine_position_dataData%downwind_turbine_Ycoor)) then LB(1:1) = lbound(Srcread_turbine_position_dataData%downwind_turbine_Ycoor) @@ -945,8 +905,6 @@ subroutine DWM_Copyread_turbine_position_data(Srcread_turbine_position_dataData, end if end if Dstread_turbine_position_dataData%downwind_turbine_Ycoor = Srcread_turbine_position_dataData%downwind_turbine_Ycoor - else if (allocated(Dstread_turbine_position_dataData%downwind_turbine_Ycoor)) then - deallocate(Dstread_turbine_position_dataData%downwind_turbine_Ycoor) end if end subroutine @@ -1363,8 +1321,6 @@ subroutine DWM_CopyWeiMethod(SrcWeiMethodData, DstWeiMethodData, CtrlCode, ErrSt end if end if DstWeiMethodData%sweptarea = SrcWeiMethodData%sweptarea - else if (allocated(DstWeiMethodData%sweptarea)) then - deallocate(DstWeiMethodData%sweptarea) end if DstWeiMethodData%weighting_denominator = SrcWeiMethodData%weighting_denominator end subroutine @@ -1443,8 +1399,6 @@ subroutine DWM_CopyTIDownstream(SrcTIDownstreamData, DstTIDownstreamData, CtrlCo end if end if DstTIDownstreamData%TI_downstream_matrix = SrcTIDownstreamData%TI_downstream_matrix - else if (allocated(DstTIDownstreamData%TI_downstream_matrix)) then - deallocate(DstTIDownstreamData%TI_downstream_matrix) end if DstTIDownstreamData%i = SrcTIDownstreamData%i DstTIDownstreamData%j = SrcTIDownstreamData%j @@ -1698,8 +1652,6 @@ subroutine DWM_CopyShinozuka(SrcShinozukaData, DstShinozukaData, CtrlCode, ErrSt end if end if DstShinozukaData%f_syn = SrcShinozukaData%f_syn - else if (allocated(DstShinozukaData%f_syn)) then - deallocate(DstShinozukaData%f_syn) end if if (allocated(SrcShinozukaData%t_syn)) then LB(1:1) = lbound(SrcShinozukaData%t_syn) @@ -1712,8 +1664,6 @@ subroutine DWM_CopyShinozuka(SrcShinozukaData, DstShinozukaData, CtrlCode, ErrSt end if end if DstShinozukaData%t_syn = SrcShinozukaData%t_syn - else if (allocated(DstShinozukaData%t_syn)) then - deallocate(DstShinozukaData%t_syn) end if if (allocated(SrcShinozukaData%phi)) then LB(1:1) = lbound(SrcShinozukaData%phi) @@ -1726,8 +1676,6 @@ subroutine DWM_CopyShinozuka(SrcShinozukaData, DstShinozukaData, CtrlCode, ErrSt end if end if DstShinozukaData%phi = SrcShinozukaData%phi - else if (allocated(DstShinozukaData%phi)) then - deallocate(DstShinozukaData%phi) end if if (allocated(SrcShinozukaData%p_k)) then LB(1:1) = lbound(SrcShinozukaData%p_k) @@ -1740,8 +1688,6 @@ subroutine DWM_CopyShinozuka(SrcShinozukaData, DstShinozukaData, CtrlCode, ErrSt end if end if DstShinozukaData%p_k = SrcShinozukaData%p_k - else if (allocated(DstShinozukaData%p_k)) then - deallocate(DstShinozukaData%p_k) end if if (allocated(SrcShinozukaData%a_k)) then LB(1:1) = lbound(SrcShinozukaData%a_k) @@ -1754,8 +1700,6 @@ subroutine DWM_CopyShinozuka(SrcShinozukaData, DstShinozukaData, CtrlCode, ErrSt end if end if DstShinozukaData%a_k = SrcShinozukaData%a_k - else if (allocated(DstShinozukaData%a_k)) then - deallocate(DstShinozukaData%a_k) end if DstShinozukaData%num_points = SrcShinozukaData%num_points DstShinozukaData%ILo = SrcShinozukaData%ILo @@ -2048,8 +1992,6 @@ subroutine DWM_Copyread_upwind_result(Srcread_upwind_resultData, Dstread_upwind_ end if end if Dstread_upwind_resultData%upwind_U = Srcread_upwind_resultData%upwind_U - else if (allocated(Dstread_upwind_resultData%upwind_U)) then - deallocate(Dstread_upwind_resultData%upwind_U) end if if (allocated(Srcread_upwind_resultData%upwind_wakecenter)) then LB(1:4) = lbound(Srcread_upwind_resultData%upwind_wakecenter) @@ -2062,8 +2004,6 @@ subroutine DWM_Copyread_upwind_result(Srcread_upwind_resultData, Dstread_upwind_ end if end if Dstread_upwind_resultData%upwind_wakecenter = Srcread_upwind_resultData%upwind_wakecenter - else if (allocated(Dstread_upwind_resultData%upwind_wakecenter)) then - deallocate(Dstread_upwind_resultData%upwind_wakecenter) end if if (allocated(Srcread_upwind_resultData%upwind_meanU)) then LB(1:1) = lbound(Srcread_upwind_resultData%upwind_meanU) @@ -2076,8 +2016,6 @@ subroutine DWM_Copyread_upwind_result(Srcread_upwind_resultData, Dstread_upwind_ end if end if Dstread_upwind_resultData%upwind_meanU = Srcread_upwind_resultData%upwind_meanU - else if (allocated(Dstread_upwind_resultData%upwind_meanU)) then - deallocate(Dstread_upwind_resultData%upwind_meanU) end if if (allocated(Srcread_upwind_resultData%upwind_TI)) then LB(1:1) = lbound(Srcread_upwind_resultData%upwind_TI) @@ -2090,8 +2028,6 @@ subroutine DWM_Copyread_upwind_result(Srcread_upwind_resultData, Dstread_upwind_ end if end if Dstread_upwind_resultData%upwind_TI = Srcread_upwind_resultData%upwind_TI - else if (allocated(Dstread_upwind_resultData%upwind_TI)) then - deallocate(Dstread_upwind_resultData%upwind_TI) end if if (allocated(Srcread_upwind_resultData%upwind_small_TI)) then LB(1:1) = lbound(Srcread_upwind_resultData%upwind_small_TI) @@ -2104,8 +2040,6 @@ subroutine DWM_Copyread_upwind_result(Srcread_upwind_resultData, Dstread_upwind_ end if end if Dstread_upwind_resultData%upwind_small_TI = Srcread_upwind_resultData%upwind_small_TI - else if (allocated(Dstread_upwind_resultData%upwind_small_TI)) then - deallocate(Dstread_upwind_resultData%upwind_small_TI) end if if (allocated(Srcread_upwind_resultData%upwind_smoothWake)) then LB(1:2) = lbound(Srcread_upwind_resultData%upwind_smoothWake) @@ -2118,8 +2052,6 @@ subroutine DWM_Copyread_upwind_result(Srcread_upwind_resultData, Dstread_upwind_ end if end if Dstread_upwind_resultData%upwind_smoothWake = Srcread_upwind_resultData%upwind_smoothWake - else if (allocated(Dstread_upwind_resultData%upwind_smoothWake)) then - deallocate(Dstread_upwind_resultData%upwind_smoothWake) end if if (allocated(Srcread_upwind_resultData%velocity_aerodyn)) then LB(1:1) = lbound(Srcread_upwind_resultData%velocity_aerodyn) @@ -2132,8 +2064,6 @@ subroutine DWM_Copyread_upwind_result(Srcread_upwind_resultData, Dstread_upwind_ end if end if Dstread_upwind_resultData%velocity_aerodyn = Srcread_upwind_resultData%velocity_aerodyn - else if (allocated(Dstread_upwind_resultData%velocity_aerodyn)) then - deallocate(Dstread_upwind_resultData%velocity_aerodyn) end if if (allocated(Srcread_upwind_resultData%TI_downstream)) then LB(1:1) = lbound(Srcread_upwind_resultData%TI_downstream) @@ -2146,8 +2076,6 @@ subroutine DWM_Copyread_upwind_result(Srcread_upwind_resultData, Dstread_upwind_ end if end if Dstread_upwind_resultData%TI_downstream = Srcread_upwind_resultData%TI_downstream - else if (allocated(Dstread_upwind_resultData%TI_downstream)) then - deallocate(Dstread_upwind_resultData%TI_downstream) end if if (allocated(Srcread_upwind_resultData%small_scale_TI_downstream)) then LB(1:1) = lbound(Srcread_upwind_resultData%small_scale_TI_downstream) @@ -2160,8 +2088,6 @@ subroutine DWM_Copyread_upwind_result(Srcread_upwind_resultData, Dstread_upwind_ end if end if Dstread_upwind_resultData%small_scale_TI_downstream = Srcread_upwind_resultData%small_scale_TI_downstream - else if (allocated(Dstread_upwind_resultData%small_scale_TI_downstream)) then - deallocate(Dstread_upwind_resultData%small_scale_TI_downstream) end if if (allocated(Srcread_upwind_resultData%smoothed_velocity_array)) then LB(1:2) = lbound(Srcread_upwind_resultData%smoothed_velocity_array) @@ -2174,8 +2100,6 @@ subroutine DWM_Copyread_upwind_result(Srcread_upwind_resultData, Dstread_upwind_ end if end if Dstread_upwind_resultData%smoothed_velocity_array = Srcread_upwind_resultData%smoothed_velocity_array - else if (allocated(Dstread_upwind_resultData%smoothed_velocity_array)) then - deallocate(Dstread_upwind_resultData%smoothed_velocity_array) end if if (allocated(Srcread_upwind_resultData%vel_matrix)) then LB(1:3) = lbound(Srcread_upwind_resultData%vel_matrix) @@ -2188,8 +2112,6 @@ subroutine DWM_Copyread_upwind_result(Srcread_upwind_resultData, Dstread_upwind_ end if end if Dstread_upwind_resultData%vel_matrix = Srcread_upwind_resultData%vel_matrix - else if (allocated(Dstread_upwind_resultData%vel_matrix)) then - deallocate(Dstread_upwind_resultData%vel_matrix) end if end subroutine @@ -2484,8 +2406,6 @@ subroutine DWM_Copywake_meandered_center(Srcwake_meandered_centerData, Dstwake_m end if end if Dstwake_meandered_centerData%wake_width = Srcwake_meandered_centerData%wake_width - else if (allocated(Dstwake_meandered_centerData%wake_width)) then - deallocate(Dstwake_meandered_centerData%wake_width) end if end subroutine @@ -2608,8 +2528,6 @@ subroutine DWM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%velocityU = SrcParamData%velocityU - else if (allocated(DstParamData%velocityU)) then - deallocate(DstParamData%velocityU) end if if (allocated(SrcParamData%smoothed_wake)) then LB(1:1) = lbound(SrcParamData%smoothed_wake) @@ -2622,8 +2540,6 @@ subroutine DWM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%smoothed_wake = SrcParamData%smoothed_wake - else if (allocated(DstParamData%smoothed_wake)) then - deallocate(DstParamData%smoothed_wake) end if if (allocated(SrcParamData%WakePosition)) then LB(1:3) = lbound(SrcParamData%WakePosition) @@ -2636,8 +2552,6 @@ subroutine DWM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%WakePosition = SrcParamData%WakePosition - else if (allocated(DstParamData%WakePosition)) then - deallocate(DstParamData%WakePosition) end if DstParamData%WakePosition_1 = SrcParamData%WakePosition_1 DstParamData%WakePosition_2 = SrcParamData%WakePosition_2 @@ -2669,8 +2583,6 @@ subroutine DWM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%ElementRad = SrcParamData%ElementRad - else if (allocated(DstParamData%ElementRad)) then - deallocate(DstParamData%ElementRad) end if DstParamData%Bnum = SrcParamData%Bnum DstParamData%ElementNum = SrcParamData%ElementNum @@ -2948,8 +2860,6 @@ subroutine DWM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%Nforce = SrcMiscData%Nforce - else if (allocated(DstMiscData%Nforce)) then - deallocate(DstMiscData%Nforce) end if if (allocated(SrcMiscData%blade_dr)) then LB(1:1) = lbound(SrcMiscData%blade_dr) @@ -2962,8 +2872,6 @@ subroutine DWM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%blade_dr = SrcMiscData%blade_dr - else if (allocated(DstMiscData%blade_dr)) then - deallocate(DstMiscData%blade_dr) end if DstMiscData%NacYaw = SrcMiscData%NacYaw DstMiscData%TI_original = SrcMiscData%TI_original @@ -3242,8 +3150,6 @@ subroutine DWM_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs end if end if DstOutputData%turbine_thrust_force = SrcOutputData%turbine_thrust_force - else if (allocated(DstOutputData%turbine_thrust_force)) then - deallocate(DstOutputData%turbine_thrust_force) end if if (allocated(SrcOutputData%induction_factor)) then LB(1:1) = lbound(SrcOutputData%induction_factor) @@ -3256,8 +3162,6 @@ subroutine DWM_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs end if end if DstOutputData%induction_factor = SrcOutputData%induction_factor - else if (allocated(DstOutputData%induction_factor)) then - deallocate(DstOutputData%induction_factor) end if if (allocated(SrcOutputData%r_initial)) then LB(1:1) = lbound(SrcOutputData%r_initial) @@ -3270,8 +3174,6 @@ subroutine DWM_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs end if end if DstOutputData%r_initial = SrcOutputData%r_initial - else if (allocated(DstOutputData%r_initial)) then - deallocate(DstOutputData%r_initial) end if if (allocated(SrcOutputData%U_initial)) then LB(1:1) = lbound(SrcOutputData%U_initial) @@ -3284,8 +3186,6 @@ subroutine DWM_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs end if end if DstOutputData%U_initial = SrcOutputData%U_initial - else if (allocated(DstOutputData%U_initial)) then - deallocate(DstOutputData%U_initial) end if if (allocated(SrcOutputData%Mean_FFWS_array)) then LB(1:1) = lbound(SrcOutputData%Mean_FFWS_array) @@ -3298,8 +3198,6 @@ subroutine DWM_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs end if end if DstOutputData%Mean_FFWS_array = SrcOutputData%Mean_FFWS_array - else if (allocated(DstOutputData%Mean_FFWS_array)) then - deallocate(DstOutputData%Mean_FFWS_array) end if DstOutputData%Mean_FFWS = SrcOutputData%Mean_FFWS DstOutputData%TI = SrcOutputData%TI @@ -3315,8 +3213,6 @@ subroutine DWM_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs end if end if DstOutputData%wake_u = SrcOutputData%wake_u - else if (allocated(DstOutputData%wake_u)) then - deallocate(DstOutputData%wake_u) end if if (allocated(SrcOutputData%wake_position)) then LB(1:3) = lbound(SrcOutputData%wake_position) @@ -3329,8 +3225,6 @@ subroutine DWM_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs end if end if DstOutputData%wake_position = SrcOutputData%wake_position - else if (allocated(DstOutputData%wake_position)) then - deallocate(DstOutputData%wake_position) end if if (allocated(SrcOutputData%smoothed_velocity_array)) then LB(1:2) = lbound(SrcOutputData%smoothed_velocity_array) @@ -3343,8 +3237,6 @@ subroutine DWM_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs end if end if DstOutputData%smoothed_velocity_array = SrcOutputData%smoothed_velocity_array - else if (allocated(DstOutputData%smoothed_velocity_array)) then - deallocate(DstOutputData%smoothed_velocity_array) end if DstOutputData%AtmUscale = SrcOutputData%AtmUscale DstOutputData%du_dz_ABL = SrcOutputData%du_dz_ABL diff --git a/modules/awae/src/AWAE_Types.f90 b/modules/awae/src/AWAE_Types.f90 index faf6e87c5e..7fe486a67a 100644 --- a/modules/awae/src/AWAE_Types.f90 +++ b/modules/awae/src/AWAE_Types.f90 @@ -269,9 +269,6 @@ subroutine AWAE_CopyHighWindGrid(SrcHighWindGridData, DstHighWindGridData, CtrlC end if end if DstHighWindGridData%data = SrcHighWindGridData%data - else if (associated(DstHighWindGridData%data)) then - deallocate(DstHighWindGridData%data) - nullify(DstHighWindGridData%data) end if end subroutine @@ -448,8 +445,6 @@ subroutine AWAE_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, Ct end if end if DstInputFileTypeData%OutDisWindZ = SrcInputFileTypeData%OutDisWindZ - else if (allocated(DstInputFileTypeData%OutDisWindZ)) then - deallocate(DstInputFileTypeData%OutDisWindZ) end if DstInputFileTypeData%NOutDisWindYZ = SrcInputFileTypeData%NOutDisWindYZ if (allocated(SrcInputFileTypeData%OutDisWindX)) then @@ -463,8 +458,6 @@ subroutine AWAE_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, Ct end if end if DstInputFileTypeData%OutDisWindX = SrcInputFileTypeData%OutDisWindX - else if (allocated(DstInputFileTypeData%OutDisWindX)) then - deallocate(DstInputFileTypeData%OutDisWindX) end if DstInputFileTypeData%NOutDisWindXZ = SrcInputFileTypeData%NOutDisWindXZ if (allocated(SrcInputFileTypeData%OutDisWindY)) then @@ -478,8 +471,6 @@ subroutine AWAE_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, Ct end if end if DstInputFileTypeData%OutDisWindY = SrcInputFileTypeData%OutDisWindY - else if (allocated(DstInputFileTypeData%OutDisWindY)) then - deallocate(DstInputFileTypeData%OutDisWindY) end if DstInputFileTypeData%WrDisDT = SrcInputFileTypeData%WrDisDT DstInputFileTypeData%ChkWndFiles = SrcInputFileTypeData%ChkWndFiles @@ -499,8 +490,6 @@ subroutine AWAE_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, Ct end if end if DstInputFileTypeData%X0_high = SrcInputFileTypeData%X0_high - else if (allocated(DstInputFileTypeData%X0_high)) then - deallocate(DstInputFileTypeData%X0_high) end if if (allocated(SrcInputFileTypeData%Y0_high)) then LB(1:1) = lbound(SrcInputFileTypeData%Y0_high) @@ -513,8 +502,6 @@ subroutine AWAE_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, Ct end if end if DstInputFileTypeData%Y0_high = SrcInputFileTypeData%Y0_high - else if (allocated(DstInputFileTypeData%Y0_high)) then - deallocate(DstInputFileTypeData%Y0_high) end if if (allocated(SrcInputFileTypeData%Z0_high)) then LB(1:1) = lbound(SrcInputFileTypeData%Z0_high) @@ -527,8 +514,6 @@ subroutine AWAE_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, Ct end if end if DstInputFileTypeData%Z0_high = SrcInputFileTypeData%Z0_high - else if (allocated(DstInputFileTypeData%Z0_high)) then - deallocate(DstInputFileTypeData%Z0_high) end if if (allocated(SrcInputFileTypeData%dX_high)) then LB(1:1) = lbound(SrcInputFileTypeData%dX_high) @@ -541,8 +526,6 @@ subroutine AWAE_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, Ct end if end if DstInputFileTypeData%dX_high = SrcInputFileTypeData%dX_high - else if (allocated(DstInputFileTypeData%dX_high)) then - deallocate(DstInputFileTypeData%dX_high) end if if (allocated(SrcInputFileTypeData%dY_high)) then LB(1:1) = lbound(SrcInputFileTypeData%dY_high) @@ -555,8 +538,6 @@ subroutine AWAE_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, Ct end if end if DstInputFileTypeData%dY_high = SrcInputFileTypeData%dY_high - else if (allocated(DstInputFileTypeData%dY_high)) then - deallocate(DstInputFileTypeData%dY_high) end if if (allocated(SrcInputFileTypeData%dZ_high)) then LB(1:1) = lbound(SrcInputFileTypeData%dZ_high) @@ -569,8 +550,6 @@ subroutine AWAE_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, Ct end if end if DstInputFileTypeData%dZ_high = SrcInputFileTypeData%dZ_high - else if (allocated(DstInputFileTypeData%dZ_high)) then - deallocate(DstInputFileTypeData%dZ_high) end if DstInputFileTypeData%nX_high = SrcInputFileTypeData%nX_high DstInputFileTypeData%nY_high = SrcInputFileTypeData%nY_high @@ -595,8 +574,6 @@ subroutine AWAE_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, Ct end if end if DstInputFileTypeData%WT_Position = SrcInputFileTypeData%WT_Position - else if (allocated(DstInputFileTypeData%WT_Position)) then - deallocate(DstInputFileTypeData%WT_Position) end if DstInputFileTypeData%Mod_Projection = SrcInputFileTypeData%Mod_Projection end subroutine @@ -1023,8 +1000,6 @@ subroutine AWAE_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E end if end if DstInitOutputData%X0_high = SrcInitOutputData%X0_high - else if (allocated(DstInitOutputData%X0_high)) then - deallocate(DstInitOutputData%X0_high) end if if (allocated(SrcInitOutputData%Y0_high)) then LB(1:1) = lbound(SrcInitOutputData%Y0_high) @@ -1037,8 +1012,6 @@ subroutine AWAE_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E end if end if DstInitOutputData%Y0_high = SrcInitOutputData%Y0_high - else if (allocated(DstInitOutputData%Y0_high)) then - deallocate(DstInitOutputData%Y0_high) end if if (allocated(SrcInitOutputData%Z0_high)) then LB(1:1) = lbound(SrcInitOutputData%Z0_high) @@ -1051,8 +1024,6 @@ subroutine AWAE_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E end if end if DstInitOutputData%Z0_high = SrcInitOutputData%Z0_high - else if (allocated(DstInitOutputData%Z0_high)) then - deallocate(DstInitOutputData%Z0_high) end if if (allocated(SrcInitOutputData%dX_high)) then LB(1:1) = lbound(SrcInitOutputData%dX_high) @@ -1065,8 +1036,6 @@ subroutine AWAE_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E end if end if DstInitOutputData%dX_high = SrcInitOutputData%dX_high - else if (allocated(DstInitOutputData%dX_high)) then - deallocate(DstInitOutputData%dX_high) end if if (allocated(SrcInitOutputData%dY_high)) then LB(1:1) = lbound(SrcInitOutputData%dY_high) @@ -1079,8 +1048,6 @@ subroutine AWAE_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E end if end if DstInitOutputData%dY_high = SrcInitOutputData%dY_high - else if (allocated(DstInitOutputData%dY_high)) then - deallocate(DstInitOutputData%dY_high) end if if (allocated(SrcInitOutputData%dZ_high)) then LB(1:1) = lbound(SrcInitOutputData%dZ_high) @@ -1093,8 +1060,6 @@ subroutine AWAE_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E end if end if DstInitOutputData%dZ_high = SrcInitOutputData%dZ_high - else if (allocated(DstInitOutputData%dZ_high)) then - deallocate(DstInitOutputData%dZ_high) end if DstInitOutputData%nX_high = SrcInitOutputData%nX_high DstInitOutputData%nY_high = SrcInitOutputData%nY_high @@ -1123,8 +1088,6 @@ subroutine AWAE_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstInitOutputData%Vdist_High)) then - deallocate(DstInitOutputData%Vdist_High) end if end subroutine @@ -1395,8 +1358,6 @@ subroutine AWAE_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrS call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstContStateData%IfW)) then - deallocate(DstContStateData%IfW) end if end subroutine @@ -1495,8 +1456,6 @@ subroutine AWAE_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrS call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstDiscStateData%IfW)) then - deallocate(DstDiscStateData%IfW) end if end subroutine @@ -1595,8 +1554,6 @@ subroutine AWAE_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstConstrStateData%IfW)) then - deallocate(DstConstrStateData%IfW) end if end subroutine @@ -1695,8 +1652,6 @@ subroutine AWAE_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstOtherStateData%IfW)) then - deallocate(DstOtherStateData%IfW) end if end subroutine @@ -1791,8 +1746,6 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%Vamb_low = SrcMiscData%Vamb_low - else if (allocated(DstMiscData%Vamb_low)) then - deallocate(DstMiscData%Vamb_low) end if if (allocated(SrcMiscData%Vamb_lowpol)) then LB(1:2) = lbound(SrcMiscData%Vamb_lowpol) @@ -1805,8 +1758,6 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%Vamb_lowpol = SrcMiscData%Vamb_lowpol - else if (allocated(DstMiscData%Vamb_lowpol)) then - deallocate(DstMiscData%Vamb_lowpol) end if if (allocated(SrcMiscData%Vdist_low)) then LB(1:4) = lbound(SrcMiscData%Vdist_low) @@ -1819,8 +1770,6 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%Vdist_low = SrcMiscData%Vdist_low - else if (allocated(DstMiscData%Vdist_low)) then - deallocate(DstMiscData%Vdist_low) end if if (allocated(SrcMiscData%Vdist_low_full)) then LB(1:4) = lbound(SrcMiscData%Vdist_low_full) @@ -1833,8 +1782,6 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%Vdist_low_full = SrcMiscData%Vdist_low_full - else if (allocated(DstMiscData%Vdist_low_full)) then - deallocate(DstMiscData%Vdist_low_full) end if if (allocated(SrcMiscData%Vamb_High)) then LB(1:1) = lbound(SrcMiscData%Vamb_High) @@ -1851,8 +1798,6 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstMiscData%Vamb_High)) then - deallocate(DstMiscData%Vamb_High) end if if (allocated(SrcMiscData%parallelFlag)) then LB(1:2) = lbound(SrcMiscData%parallelFlag) @@ -1865,8 +1810,6 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%parallelFlag = SrcMiscData%parallelFlag - else if (allocated(DstMiscData%parallelFlag)) then - deallocate(DstMiscData%parallelFlag) end if if (allocated(SrcMiscData%r_s)) then LB(1:2) = lbound(SrcMiscData%r_s) @@ -1879,8 +1822,6 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%r_s = SrcMiscData%r_s - else if (allocated(DstMiscData%r_s)) then - deallocate(DstMiscData%r_s) end if if (allocated(SrcMiscData%r_e)) then LB(1:2) = lbound(SrcMiscData%r_e) @@ -1893,8 +1834,6 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%r_e = SrcMiscData%r_e - else if (allocated(DstMiscData%r_e)) then - deallocate(DstMiscData%r_e) end if if (allocated(SrcMiscData%rhat_s)) then LB(1:3) = lbound(SrcMiscData%rhat_s) @@ -1907,8 +1846,6 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%rhat_s = SrcMiscData%rhat_s - else if (allocated(DstMiscData%rhat_s)) then - deallocate(DstMiscData%rhat_s) end if if (allocated(SrcMiscData%rhat_e)) then LB(1:3) = lbound(SrcMiscData%rhat_e) @@ -1921,8 +1858,6 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%rhat_e = SrcMiscData%rhat_e - else if (allocated(DstMiscData%rhat_e)) then - deallocate(DstMiscData%rhat_e) end if if (allocated(SrcMiscData%pvec_cs)) then LB(1:3) = lbound(SrcMiscData%pvec_cs) @@ -1935,8 +1870,6 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%pvec_cs = SrcMiscData%pvec_cs - else if (allocated(DstMiscData%pvec_cs)) then - deallocate(DstMiscData%pvec_cs) end if if (allocated(SrcMiscData%pvec_ce)) then LB(1:3) = lbound(SrcMiscData%pvec_ce) @@ -1949,8 +1882,6 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%pvec_ce = SrcMiscData%pvec_ce - else if (allocated(DstMiscData%pvec_ce)) then - deallocate(DstMiscData%pvec_ce) end if if (allocated(SrcMiscData%outVizXYPlane)) then LB(1:4) = lbound(SrcMiscData%outVizXYPlane) @@ -1963,8 +1894,6 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%outVizXYPlane = SrcMiscData%outVizXYPlane - else if (allocated(DstMiscData%outVizXYPlane)) then - deallocate(DstMiscData%outVizXYPlane) end if if (allocated(SrcMiscData%outVizYZPlane)) then LB(1:4) = lbound(SrcMiscData%outVizYZPlane) @@ -1977,8 +1906,6 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%outVizYZPlane = SrcMiscData%outVizYZPlane - else if (allocated(DstMiscData%outVizYZPlane)) then - deallocate(DstMiscData%outVizYZPlane) end if if (allocated(SrcMiscData%outVizXZPlane)) then LB(1:4) = lbound(SrcMiscData%outVizXZPlane) @@ -1991,8 +1918,6 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%outVizXZPlane = SrcMiscData%outVizXZPlane - else if (allocated(DstMiscData%outVizXZPlane)) then - deallocate(DstMiscData%outVizXZPlane) end if if (allocated(SrcMiscData%IfW)) then LB(1:1) = lbound(SrcMiscData%IfW) @@ -2009,8 +1934,6 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstMiscData%IfW)) then - deallocate(DstMiscData%IfW) end if call InflowWind_CopyInput(SrcMiscData%u_IfW_Low, DstMiscData%u_IfW_Low, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2478,8 +2401,6 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%y = SrcParamData%y - else if (allocated(DstParamData%y)) then - deallocate(DstParamData%y) end if if (allocated(SrcParamData%z)) then LB(1:1) = lbound(SrcParamData%z) @@ -2492,8 +2413,6 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%z = SrcParamData%z - else if (allocated(DstParamData%z)) then - deallocate(DstParamData%z) end if DstParamData%Mod_AmbWind = SrcParamData%Mod_AmbWind DstParamData%nX_low = SrcParamData%nX_low @@ -2520,8 +2439,6 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%X0_high = SrcParamData%X0_high - else if (allocated(DstParamData%X0_high)) then - deallocate(DstParamData%X0_high) end if if (allocated(SrcParamData%Y0_high)) then LB(1:1) = lbound(SrcParamData%Y0_high) @@ -2534,8 +2451,6 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%Y0_high = SrcParamData%Y0_high - else if (allocated(DstParamData%Y0_high)) then - deallocate(DstParamData%Y0_high) end if if (allocated(SrcParamData%Z0_high)) then LB(1:1) = lbound(SrcParamData%Z0_high) @@ -2548,8 +2463,6 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%Z0_high = SrcParamData%Z0_high - else if (allocated(DstParamData%Z0_high)) then - deallocate(DstParamData%Z0_high) end if if (allocated(SrcParamData%dX_high)) then LB(1:1) = lbound(SrcParamData%dX_high) @@ -2562,8 +2475,6 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%dX_high = SrcParamData%dX_high - else if (allocated(DstParamData%dX_high)) then - deallocate(DstParamData%dX_high) end if if (allocated(SrcParamData%dY_high)) then LB(1:1) = lbound(SrcParamData%dY_high) @@ -2576,8 +2487,6 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%dY_high = SrcParamData%dY_high - else if (allocated(DstParamData%dY_high)) then - deallocate(DstParamData%dY_high) end if if (allocated(SrcParamData%dZ_high)) then LB(1:1) = lbound(SrcParamData%dZ_high) @@ -2590,8 +2499,6 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%dZ_high = SrcParamData%dZ_high - else if (allocated(DstParamData%dZ_high)) then - deallocate(DstParamData%dZ_high) end if DstParamData%nX_high = SrcParamData%nX_high DstParamData%nY_high = SrcParamData%nY_high @@ -2607,8 +2514,6 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%Grid_low = SrcParamData%Grid_low - else if (allocated(DstParamData%Grid_low)) then - deallocate(DstParamData%Grid_low) end if if (allocated(SrcParamData%Grid_high)) then LB(1:3) = lbound(SrcParamData%Grid_high) @@ -2621,8 +2526,6 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%Grid_high = SrcParamData%Grid_high - else if (allocated(DstParamData%Grid_high)) then - deallocate(DstParamData%Grid_high) end if if (allocated(SrcParamData%WT_Position)) then LB(1:2) = lbound(SrcParamData%WT_Position) @@ -2635,8 +2538,6 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%WT_Position = SrcParamData%WT_Position - else if (allocated(DstParamData%WT_Position)) then - deallocate(DstParamData%WT_Position) end if DstParamData%n_high_low = SrcParamData%n_high_low DstParamData%dt_low = SrcParamData%dt_low @@ -2661,8 +2562,6 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstParamData%IfW)) then - deallocate(DstParamData%IfW) end if DstParamData%WrDisSkp1 = SrcParamData%WrDisSkp1 DstParamData%WrDisWind = SrcParamData%WrDisWind @@ -2678,8 +2577,6 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%OutDisWindZ = SrcParamData%OutDisWindZ - else if (allocated(DstParamData%OutDisWindZ)) then - deallocate(DstParamData%OutDisWindZ) end if DstParamData%NOutDisWindYZ = SrcParamData%NOutDisWindYZ if (allocated(SrcParamData%OutDisWindX)) then @@ -2693,8 +2590,6 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%OutDisWindX = SrcParamData%OutDisWindX - else if (allocated(DstParamData%OutDisWindX)) then - deallocate(DstParamData%OutDisWindX) end if DstParamData%NOutDisWindXZ = SrcParamData%NOutDisWindXZ if (allocated(SrcParamData%OutDisWindY)) then @@ -2708,8 +2603,6 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%OutDisWindY = SrcParamData%OutDisWindY - else if (allocated(DstParamData%OutDisWindY)) then - deallocate(DstParamData%OutDisWindY) end if DstParamData%OutFileRoot = SrcParamData%OutFileRoot DstParamData%OutFileVTKRoot = SrcParamData%OutFileVTKRoot @@ -3230,8 +3123,6 @@ subroutine AWAE_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstOutputData%Vdist_High)) then - deallocate(DstOutputData%Vdist_High) end if if (allocated(SrcOutputData%V_plane)) then LB(1:3) = lbound(SrcOutputData%V_plane) @@ -3244,8 +3135,6 @@ subroutine AWAE_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM end if end if DstOutputData%V_plane = SrcOutputData%V_plane - else if (allocated(DstOutputData%V_plane)) then - deallocate(DstOutputData%V_plane) end if if (allocated(SrcOutputData%TI_amb)) then LB(1:1) = lbound(SrcOutputData%TI_amb) @@ -3258,8 +3147,6 @@ subroutine AWAE_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM end if end if DstOutputData%TI_amb = SrcOutputData%TI_amb - else if (allocated(DstOutputData%TI_amb)) then - deallocate(DstOutputData%TI_amb) end if if (allocated(SrcOutputData%Vx_wind_disk)) then LB(1:1) = lbound(SrcOutputData%Vx_wind_disk) @@ -3272,8 +3159,6 @@ subroutine AWAE_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM end if end if DstOutputData%Vx_wind_disk = SrcOutputData%Vx_wind_disk - else if (allocated(DstOutputData%Vx_wind_disk)) then - deallocate(DstOutputData%Vx_wind_disk) end if end subroutine @@ -3432,8 +3317,6 @@ subroutine AWAE_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%xhat_plane = SrcInputData%xhat_plane - else if (allocated(DstInputData%xhat_plane)) then - deallocate(DstInputData%xhat_plane) end if if (allocated(SrcInputData%p_plane)) then LB(1:3) = lbound(SrcInputData%p_plane) @@ -3446,8 +3329,6 @@ subroutine AWAE_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%p_plane = SrcInputData%p_plane - else if (allocated(DstInputData%p_plane)) then - deallocate(DstInputData%p_plane) end if if (allocated(SrcInputData%Vx_wake)) then LB(1:4) = lbound(SrcInputData%Vx_wake) @@ -3460,8 +3341,6 @@ subroutine AWAE_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%Vx_wake = SrcInputData%Vx_wake - else if (allocated(DstInputData%Vx_wake)) then - deallocate(DstInputData%Vx_wake) end if if (allocated(SrcInputData%Vy_wake)) then LB(1:4) = lbound(SrcInputData%Vy_wake) @@ -3474,8 +3353,6 @@ subroutine AWAE_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%Vy_wake = SrcInputData%Vy_wake - else if (allocated(DstInputData%Vy_wake)) then - deallocate(DstInputData%Vy_wake) end if if (allocated(SrcInputData%Vz_wake)) then LB(1:4) = lbound(SrcInputData%Vz_wake) @@ -3488,8 +3365,6 @@ subroutine AWAE_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%Vz_wake = SrcInputData%Vz_wake - else if (allocated(DstInputData%Vz_wake)) then - deallocate(DstInputData%Vz_wake) end if if (allocated(SrcInputData%D_wake)) then LB(1:2) = lbound(SrcInputData%D_wake) @@ -3502,8 +3377,6 @@ subroutine AWAE_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%D_wake = SrcInputData%D_wake - else if (allocated(DstInputData%D_wake)) then - deallocate(DstInputData%D_wake) end if if (allocated(SrcInputData%WAT_k_mt)) then LB(1:3) = lbound(SrcInputData%WAT_k_mt) @@ -3516,8 +3389,6 @@ subroutine AWAE_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%WAT_k_mt = SrcInputData%WAT_k_mt - else if (allocated(DstInputData%WAT_k_mt)) then - deallocate(DstInputData%WAT_k_mt) end if end subroutine diff --git a/modules/beamdyn/src/BeamDyn_Types.f90 b/modules/beamdyn/src/BeamDyn_Types.f90 index 945aa6d01c..826860d790 100644 --- a/modules/beamdyn/src/BeamDyn_Types.f90 +++ b/modules/beamdyn/src/BeamDyn_Types.f90 @@ -441,8 +441,6 @@ subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr - else if (allocated(DstInitOutputData%WriteOutputHdr)) then - deallocate(DstInitOutputData%WriteOutputHdr) end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) @@ -455,8 +453,6 @@ subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt - else if (allocated(DstInitOutputData%WriteOutputUnt)) then - deallocate(DstInitOutputData%WriteOutputUnt) end if call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -472,8 +468,6 @@ subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%kp_coordinate = SrcInitOutputData%kp_coordinate - else if (allocated(DstInitOutputData%kp_coordinate)) then - deallocate(DstInitOutputData%kp_coordinate) end if DstInitOutputData%kp_total = SrcInitOutputData%kp_total if (allocated(SrcInitOutputData%LinNames_y)) then @@ -487,8 +481,6 @@ subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y - else if (allocated(DstInitOutputData%LinNames_y)) then - deallocate(DstInitOutputData%LinNames_y) end if if (allocated(SrcInitOutputData%LinNames_x)) then LB(1:1) = lbound(SrcInitOutputData%LinNames_x) @@ -501,8 +493,6 @@ subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x - else if (allocated(DstInitOutputData%LinNames_x)) then - deallocate(DstInitOutputData%LinNames_x) end if if (allocated(SrcInitOutputData%LinNames_u)) then LB(1:1) = lbound(SrcInitOutputData%LinNames_u) @@ -515,8 +505,6 @@ subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u - else if (allocated(DstInitOutputData%LinNames_u)) then - deallocate(DstInitOutputData%LinNames_u) end if if (allocated(SrcInitOutputData%RotFrame_y)) then LB(1:1) = lbound(SrcInitOutputData%RotFrame_y) @@ -529,8 +517,6 @@ subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y - else if (allocated(DstInitOutputData%RotFrame_y)) then - deallocate(DstInitOutputData%RotFrame_y) end if if (allocated(SrcInitOutputData%RotFrame_x)) then LB(1:1) = lbound(SrcInitOutputData%RotFrame_x) @@ -543,8 +529,6 @@ subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x - else if (allocated(DstInitOutputData%RotFrame_x)) then - deallocate(DstInitOutputData%RotFrame_x) end if if (allocated(SrcInitOutputData%RotFrame_u)) then LB(1:1) = lbound(SrcInitOutputData%RotFrame_u) @@ -557,8 +541,6 @@ subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u - else if (allocated(DstInitOutputData%RotFrame_u)) then - deallocate(DstInitOutputData%RotFrame_u) end if if (allocated(SrcInitOutputData%IsLoad_u)) then LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) @@ -571,8 +553,6 @@ subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u - else if (allocated(DstInitOutputData%IsLoad_u)) then - deallocate(DstInitOutputData%IsLoad_u) end if if (allocated(SrcInitOutputData%DerivOrder_x)) then LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) @@ -585,8 +565,6 @@ subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x - else if (allocated(DstInitOutputData%DerivOrder_x)) then - deallocate(DstInitOutputData%DerivOrder_x) end if end subroutine @@ -892,8 +870,6 @@ subroutine BD_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C end if end if DstBladeInputDataData%station_eta = SrcBladeInputDataData%station_eta - else if (allocated(DstBladeInputDataData%station_eta)) then - deallocate(DstBladeInputDataData%station_eta) end if if (allocated(SrcBladeInputDataData%stiff0)) then LB(1:3) = lbound(SrcBladeInputDataData%stiff0) @@ -906,8 +882,6 @@ subroutine BD_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C end if end if DstBladeInputDataData%stiff0 = SrcBladeInputDataData%stiff0 - else if (allocated(DstBladeInputDataData%stiff0)) then - deallocate(DstBladeInputDataData%stiff0) end if if (allocated(SrcBladeInputDataData%mass0)) then LB(1:3) = lbound(SrcBladeInputDataData%mass0) @@ -920,8 +894,6 @@ subroutine BD_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C end if end if DstBladeInputDataData%mass0 = SrcBladeInputDataData%mass0 - else if (allocated(DstBladeInputDataData%mass0)) then - deallocate(DstBladeInputDataData%mass0) end if DstBladeInputDataData%beta = SrcBladeInputDataData%beta DstBladeInputDataData%damp_flag = SrcBladeInputDataData%damp_flag @@ -1057,8 +1029,6 @@ subroutine BD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end if end if DstInputFileData%kp_member = SrcInputFileData%kp_member - else if (allocated(DstInputFileData%kp_member)) then - deallocate(DstInputFileData%kp_member) end if DstInputFileData%order_elem = SrcInputFileData%order_elem DstInputFileData%load_retries = SrcInputFileData%load_retries @@ -1088,8 +1058,6 @@ subroutine BD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end if end if DstInputFileData%kp_coordinate = SrcInputFileData%kp_coordinate - else if (allocated(DstInputFileData%kp_coordinate)) then - deallocate(DstInputFileData%kp_coordinate) end if DstInputFileData%pitchJ = SrcInputFileData%pitchJ DstInputFileData%pitchK = SrcInputFileData%pitchK @@ -1113,8 +1081,6 @@ subroutine BD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end if end if DstInputFileData%OutList = SrcInputFileData%OutList - else if (allocated(DstInputFileData%OutList)) then - deallocate(DstInputFileData%OutList) end if DstInputFileData%SumPrint = SrcInputFileData%SumPrint DstInputFileData%OutFmt = SrcInputFileData%OutFmt @@ -1130,8 +1096,6 @@ subroutine BD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end if end if DstInputFileData%BldNd_OutList = SrcInputFileData%BldNd_OutList - else if (allocated(DstInputFileData%BldNd_OutList)) then - deallocate(DstInputFileData%BldNd_OutList) end if if (allocated(SrcInputFileData%BldNd_BlOutNd)) then LB(1:1) = lbound(SrcInputFileData%BldNd_BlOutNd) @@ -1144,8 +1108,6 @@ subroutine BD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end if end if DstInputFileData%BldNd_BlOutNd = SrcInputFileData%BldNd_BlOutNd - else if (allocated(DstInputFileData%BldNd_BlOutNd)) then - deallocate(DstInputFileData%BldNd_BlOutNd) end if DstInputFileData%BldNd_BlOutNd_Str = SrcInputFileData%BldNd_BlOutNd_Str end subroutine @@ -1408,8 +1370,6 @@ subroutine BD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSta end if end if DstContStateData%q = SrcContStateData%q - else if (allocated(DstContStateData%q)) then - deallocate(DstContStateData%q) end if if (allocated(SrcContStateData%dqdt)) then LB(1:2) = lbound(SrcContStateData%dqdt) @@ -1422,8 +1382,6 @@ subroutine BD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSta end if end if DstContStateData%dqdt = SrcContStateData%dqdt - else if (allocated(DstContStateData%dqdt)) then - deallocate(DstContStateData%dqdt) end if end subroutine @@ -1602,8 +1560,6 @@ subroutine BD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err end if end if DstOtherStateData%acc = SrcOtherStateData%acc - else if (allocated(DstOtherStateData%acc)) then - deallocate(DstOtherStateData%acc) end if if (allocated(SrcOtherStateData%xcc)) then LB(1:2) = lbound(SrcOtherStateData%xcc) @@ -1616,8 +1572,6 @@ subroutine BD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err end if end if DstOtherStateData%xcc = SrcOtherStateData%xcc - else if (allocated(DstOtherStateData%xcc)) then - deallocate(DstOtherStateData%xcc) end if DstOtherStateData%InitAcc = SrcOtherStateData%InitAcc DstOtherStateData%RunQuasiStaticInit = SrcOtherStateData%RunQuasiStaticInit @@ -1722,8 +1676,6 @@ subroutine BD_CopyqpParam(SrcqpParamData, DstqpParamData, CtrlCode, ErrStat, Err end if end if DstqpParamData%mmm = SrcqpParamData%mmm - else if (allocated(DstqpParamData%mmm)) then - deallocate(DstqpParamData%mmm) end if if (allocated(SrcqpParamData%mEta)) then LB(1:3) = lbound(SrcqpParamData%mEta) @@ -1736,8 +1688,6 @@ subroutine BD_CopyqpParam(SrcqpParamData, DstqpParamData, CtrlCode, ErrStat, Err end if end if DstqpParamData%mEta = SrcqpParamData%mEta - else if (allocated(DstqpParamData%mEta)) then - deallocate(DstqpParamData%mEta) end if end subroutine @@ -1839,8 +1789,6 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%uuN0 = SrcParamData%uuN0 - else if (allocated(DstParamData%uuN0)) then - deallocate(DstParamData%uuN0) end if if (allocated(SrcParamData%Stif0_QP)) then LB(1:3) = lbound(SrcParamData%Stif0_QP) @@ -1853,8 +1801,6 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%Stif0_QP = SrcParamData%Stif0_QP - else if (allocated(DstParamData%Stif0_QP)) then - deallocate(DstParamData%Stif0_QP) end if if (allocated(SrcParamData%Mass0_QP)) then LB(1:3) = lbound(SrcParamData%Mass0_QP) @@ -1867,8 +1813,6 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%Mass0_QP = SrcParamData%Mass0_QP - else if (allocated(DstParamData%Mass0_QP)) then - deallocate(DstParamData%Mass0_QP) end if DstParamData%gravity = SrcParamData%gravity if (allocated(SrcParamData%segment_eta)) then @@ -1882,8 +1826,6 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%segment_eta = SrcParamData%segment_eta - else if (allocated(DstParamData%segment_eta)) then - deallocate(DstParamData%segment_eta) end if if (allocated(SrcParamData%member_eta)) then LB(1:1) = lbound(SrcParamData%member_eta) @@ -1896,8 +1838,6 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%member_eta = SrcParamData%member_eta - else if (allocated(DstParamData%member_eta)) then - deallocate(DstParamData%member_eta) end if DstParamData%blade_length = SrcParamData%blade_length DstParamData%blade_mass = SrcParamData%blade_mass @@ -1919,8 +1859,6 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%QPtN = SrcParamData%QPtN - else if (allocated(DstParamData%QPtN)) then - deallocate(DstParamData%QPtN) end if if (allocated(SrcParamData%QPtWeight)) then LB(1:1) = lbound(SrcParamData%QPtWeight) @@ -1933,8 +1871,6 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%QPtWeight = SrcParamData%QPtWeight - else if (allocated(DstParamData%QPtWeight)) then - deallocate(DstParamData%QPtWeight) end if if (allocated(SrcParamData%Shp)) then LB(1:2) = lbound(SrcParamData%Shp) @@ -1947,8 +1883,6 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%Shp = SrcParamData%Shp - else if (allocated(DstParamData%Shp)) then - deallocate(DstParamData%Shp) end if if (allocated(SrcParamData%ShpDer)) then LB(1:2) = lbound(SrcParamData%ShpDer) @@ -1961,8 +1895,6 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%ShpDer = SrcParamData%ShpDer - else if (allocated(DstParamData%ShpDer)) then - deallocate(DstParamData%ShpDer) end if if (allocated(SrcParamData%Jacobian)) then LB(1:2) = lbound(SrcParamData%Jacobian) @@ -1975,8 +1907,6 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%Jacobian = SrcParamData%Jacobian - else if (allocated(DstParamData%Jacobian)) then - deallocate(DstParamData%Jacobian) end if if (allocated(SrcParamData%uu0)) then LB(1:3) = lbound(SrcParamData%uu0) @@ -1989,8 +1919,6 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%uu0 = SrcParamData%uu0 - else if (allocated(DstParamData%uu0)) then - deallocate(DstParamData%uu0) end if if (allocated(SrcParamData%rrN0)) then LB(1:3) = lbound(SrcParamData%rrN0) @@ -2003,8 +1931,6 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%rrN0 = SrcParamData%rrN0 - else if (allocated(DstParamData%rrN0)) then - deallocate(DstParamData%rrN0) end if if (allocated(SrcParamData%E10)) then LB(1:3) = lbound(SrcParamData%E10) @@ -2017,8 +1943,6 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%E10 = SrcParamData%E10 - else if (allocated(DstParamData%E10)) then - deallocate(DstParamData%E10) end if DstParamData%nodes_per_elem = SrcParamData%nodes_per_elem if (allocated(SrcParamData%node_elem_idx)) then @@ -2032,8 +1956,6 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%node_elem_idx = SrcParamData%node_elem_idx - else if (allocated(DstParamData%node_elem_idx)) then - deallocate(DstParamData%node_elem_idx) end if DstParamData%refine = SrcParamData%refine DstParamData%dof_node = SrcParamData%dof_node @@ -2066,8 +1988,6 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstParamData%OutParam)) then - deallocate(DstParamData%OutParam) end if DstParamData%NNodeOuts = SrcParamData%NNodeOuts DstParamData%OutNd = SrcParamData%OutNd @@ -2082,8 +2002,6 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%NdIndx = SrcParamData%NdIndx - else if (allocated(DstParamData%NdIndx)) then - deallocate(DstParamData%NdIndx) end if if (allocated(SrcParamData%NdIndxInverse)) then LB(1:1) = lbound(SrcParamData%NdIndxInverse) @@ -2096,8 +2014,6 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%NdIndxInverse = SrcParamData%NdIndxInverse - else if (allocated(DstParamData%NdIndxInverse)) then - deallocate(DstParamData%NdIndxInverse) end if if (allocated(SrcParamData%OutNd2NdElem)) then LB(1:2) = lbound(SrcParamData%OutNd2NdElem) @@ -2110,8 +2026,6 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%OutNd2NdElem = SrcParamData%OutNd2NdElem - else if (allocated(DstParamData%OutNd2NdElem)) then - deallocate(DstParamData%OutNd2NdElem) end if DstParamData%OutFmt = SrcParamData%OutFmt DstParamData%UsePitchAct = SrcParamData%UsePitchAct @@ -2145,8 +2059,6 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstParamData%BldNd_OutParam)) then - deallocate(DstParamData%BldNd_OutParam) end if if (allocated(SrcParamData%BldNd_BlOutNd)) then LB(1:1) = lbound(SrcParamData%BldNd_BlOutNd) @@ -2159,8 +2071,6 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%BldNd_BlOutNd = SrcParamData%BldNd_BlOutNd - else if (allocated(DstParamData%BldNd_BlOutNd)) then - deallocate(DstParamData%BldNd_BlOutNd) end if if (allocated(SrcParamData%QPtw_Shp_Shp_Jac)) then LB(1:4) = lbound(SrcParamData%QPtw_Shp_Shp_Jac) @@ -2173,8 +2083,6 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%QPtw_Shp_Shp_Jac = SrcParamData%QPtw_Shp_Shp_Jac - else if (allocated(DstParamData%QPtw_Shp_Shp_Jac)) then - deallocate(DstParamData%QPtw_Shp_Shp_Jac) end if if (allocated(SrcParamData%QPtw_Shp_ShpDer)) then LB(1:3) = lbound(SrcParamData%QPtw_Shp_ShpDer) @@ -2187,8 +2095,6 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%QPtw_Shp_ShpDer = SrcParamData%QPtw_Shp_ShpDer - else if (allocated(DstParamData%QPtw_Shp_ShpDer)) then - deallocate(DstParamData%QPtw_Shp_ShpDer) end if if (allocated(SrcParamData%QPtw_ShpDer_ShpDer_Jac)) then LB(1:4) = lbound(SrcParamData%QPtw_ShpDer_ShpDer_Jac) @@ -2201,8 +2107,6 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%QPtw_ShpDer_ShpDer_Jac = SrcParamData%QPtw_ShpDer_ShpDer_Jac - else if (allocated(DstParamData%QPtw_ShpDer_ShpDer_Jac)) then - deallocate(DstParamData%QPtw_ShpDer_ShpDer_Jac) end if if (allocated(SrcParamData%QPtw_Shp_Jac)) then LB(1:3) = lbound(SrcParamData%QPtw_Shp_Jac) @@ -2215,8 +2119,6 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%QPtw_Shp_Jac = SrcParamData%QPtw_Shp_Jac - else if (allocated(DstParamData%QPtw_Shp_Jac)) then - deallocate(DstParamData%QPtw_Shp_Jac) end if if (allocated(SrcParamData%QPtw_ShpDer)) then LB(1:2) = lbound(SrcParamData%QPtw_ShpDer) @@ -2229,8 +2131,6 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%QPtw_ShpDer = SrcParamData%QPtw_ShpDer - else if (allocated(DstParamData%QPtw_ShpDer)) then - deallocate(DstParamData%QPtw_ShpDer) end if if (allocated(SrcParamData%FEweight)) then LB(1:2) = lbound(SrcParamData%FEweight) @@ -2243,8 +2143,6 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%FEweight = SrcParamData%FEweight - else if (allocated(DstParamData%FEweight)) then - deallocate(DstParamData%FEweight) end if if (allocated(SrcParamData%Jac_u_indx)) then LB(1:2) = lbound(SrcParamData%Jac_u_indx) @@ -2257,8 +2155,6 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx - else if (allocated(DstParamData%Jac_u_indx)) then - deallocate(DstParamData%Jac_u_indx) end if if (allocated(SrcParamData%du)) then LB(1:1) = lbound(SrcParamData%du) @@ -2271,8 +2167,6 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%du = SrcParamData%du - else if (allocated(DstParamData%du)) then - deallocate(DstParamData%du) end if DstParamData%dx = SrcParamData%dx DstParamData%Jac_ny = SrcParamData%Jac_ny @@ -3208,8 +3102,6 @@ subroutine BD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg end if end if DstOutputData%WriteOutput = SrcOutputData%WriteOutput - else if (allocated(DstOutputData%WriteOutput)) then - deallocate(DstOutputData%WriteOutput) end if end subroutine @@ -3300,8 +3192,6 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err end if end if DstEqMotionQPData%uuu = SrcEqMotionQPData%uuu - else if (allocated(DstEqMotionQPData%uuu)) then - deallocate(DstEqMotionQPData%uuu) end if if (allocated(SrcEqMotionQPData%uup)) then LB(1:3) = lbound(SrcEqMotionQPData%uup) @@ -3314,8 +3204,6 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err end if end if DstEqMotionQPData%uup = SrcEqMotionQPData%uup - else if (allocated(DstEqMotionQPData%uup)) then - deallocate(DstEqMotionQPData%uup) end if if (allocated(SrcEqMotionQPData%vvv)) then LB(1:3) = lbound(SrcEqMotionQPData%vvv) @@ -3328,8 +3216,6 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err end if end if DstEqMotionQPData%vvv = SrcEqMotionQPData%vvv - else if (allocated(DstEqMotionQPData%vvv)) then - deallocate(DstEqMotionQPData%vvv) end if if (allocated(SrcEqMotionQPData%vvp)) then LB(1:3) = lbound(SrcEqMotionQPData%vvp) @@ -3342,8 +3228,6 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err end if end if DstEqMotionQPData%vvp = SrcEqMotionQPData%vvp - else if (allocated(DstEqMotionQPData%vvp)) then - deallocate(DstEqMotionQPData%vvp) end if if (allocated(SrcEqMotionQPData%aaa)) then LB(1:3) = lbound(SrcEqMotionQPData%aaa) @@ -3356,8 +3240,6 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err end if end if DstEqMotionQPData%aaa = SrcEqMotionQPData%aaa - else if (allocated(DstEqMotionQPData%aaa)) then - deallocate(DstEqMotionQPData%aaa) end if if (allocated(SrcEqMotionQPData%RR0)) then LB(1:4) = lbound(SrcEqMotionQPData%RR0) @@ -3370,8 +3252,6 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err end if end if DstEqMotionQPData%RR0 = SrcEqMotionQPData%RR0 - else if (allocated(DstEqMotionQPData%RR0)) then - deallocate(DstEqMotionQPData%RR0) end if if (allocated(SrcEqMotionQPData%kappa)) then LB(1:3) = lbound(SrcEqMotionQPData%kappa) @@ -3384,8 +3264,6 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err end if end if DstEqMotionQPData%kappa = SrcEqMotionQPData%kappa - else if (allocated(DstEqMotionQPData%kappa)) then - deallocate(DstEqMotionQPData%kappa) end if if (allocated(SrcEqMotionQPData%E1)) then LB(1:3) = lbound(SrcEqMotionQPData%E1) @@ -3398,8 +3276,6 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err end if end if DstEqMotionQPData%E1 = SrcEqMotionQPData%E1 - else if (allocated(DstEqMotionQPData%E1)) then - deallocate(DstEqMotionQPData%E1) end if if (allocated(SrcEqMotionQPData%Stif)) then LB(1:4) = lbound(SrcEqMotionQPData%Stif) @@ -3412,8 +3288,6 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err end if end if DstEqMotionQPData%Stif = SrcEqMotionQPData%Stif - else if (allocated(DstEqMotionQPData%Stif)) then - deallocate(DstEqMotionQPData%Stif) end if if (allocated(SrcEqMotionQPData%Fb)) then LB(1:3) = lbound(SrcEqMotionQPData%Fb) @@ -3426,8 +3300,6 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err end if end if DstEqMotionQPData%Fb = SrcEqMotionQPData%Fb - else if (allocated(DstEqMotionQPData%Fb)) then - deallocate(DstEqMotionQPData%Fb) end if if (allocated(SrcEqMotionQPData%Fc)) then LB(1:3) = lbound(SrcEqMotionQPData%Fc) @@ -3440,8 +3312,6 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err end if end if DstEqMotionQPData%Fc = SrcEqMotionQPData%Fc - else if (allocated(DstEqMotionQPData%Fc)) then - deallocate(DstEqMotionQPData%Fc) end if if (allocated(SrcEqMotionQPData%Fd)) then LB(1:3) = lbound(SrcEqMotionQPData%Fd) @@ -3454,8 +3324,6 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err end if end if DstEqMotionQPData%Fd = SrcEqMotionQPData%Fd - else if (allocated(DstEqMotionQPData%Fd)) then - deallocate(DstEqMotionQPData%Fd) end if if (allocated(SrcEqMotionQPData%Fg)) then LB(1:3) = lbound(SrcEqMotionQPData%Fg) @@ -3468,8 +3336,6 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err end if end if DstEqMotionQPData%Fg = SrcEqMotionQPData%Fg - else if (allocated(DstEqMotionQPData%Fg)) then - deallocate(DstEqMotionQPData%Fg) end if if (allocated(SrcEqMotionQPData%Fi)) then LB(1:3) = lbound(SrcEqMotionQPData%Fi) @@ -3482,8 +3348,6 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err end if end if DstEqMotionQPData%Fi = SrcEqMotionQPData%Fi - else if (allocated(DstEqMotionQPData%Fi)) then - deallocate(DstEqMotionQPData%Fi) end if if (allocated(SrcEqMotionQPData%Ftemp)) then LB(1:3) = lbound(SrcEqMotionQPData%Ftemp) @@ -3496,8 +3360,6 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err end if end if DstEqMotionQPData%Ftemp = SrcEqMotionQPData%Ftemp - else if (allocated(DstEqMotionQPData%Ftemp)) then - deallocate(DstEqMotionQPData%Ftemp) end if if (allocated(SrcEqMotionQPData%RR0mEta)) then LB(1:3) = lbound(SrcEqMotionQPData%RR0mEta) @@ -3510,8 +3372,6 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err end if end if DstEqMotionQPData%RR0mEta = SrcEqMotionQPData%RR0mEta - else if (allocated(DstEqMotionQPData%RR0mEta)) then - deallocate(DstEqMotionQPData%RR0mEta) end if if (allocated(SrcEqMotionQPData%rho)) then LB(1:4) = lbound(SrcEqMotionQPData%rho) @@ -3524,8 +3384,6 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err end if end if DstEqMotionQPData%rho = SrcEqMotionQPData%rho - else if (allocated(DstEqMotionQPData%rho)) then - deallocate(DstEqMotionQPData%rho) end if if (allocated(SrcEqMotionQPData%betaC)) then LB(1:4) = lbound(SrcEqMotionQPData%betaC) @@ -3538,8 +3396,6 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err end if end if DstEqMotionQPData%betaC = SrcEqMotionQPData%betaC - else if (allocated(DstEqMotionQPData%betaC)) then - deallocate(DstEqMotionQPData%betaC) end if if (allocated(SrcEqMotionQPData%Gi)) then LB(1:4) = lbound(SrcEqMotionQPData%Gi) @@ -3552,8 +3408,6 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err end if end if DstEqMotionQPData%Gi = SrcEqMotionQPData%Gi - else if (allocated(DstEqMotionQPData%Gi)) then - deallocate(DstEqMotionQPData%Gi) end if if (allocated(SrcEqMotionQPData%Ki)) then LB(1:4) = lbound(SrcEqMotionQPData%Ki) @@ -3566,8 +3420,6 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err end if end if DstEqMotionQPData%Ki = SrcEqMotionQPData%Ki - else if (allocated(DstEqMotionQPData%Ki)) then - deallocate(DstEqMotionQPData%Ki) end if if (allocated(SrcEqMotionQPData%Mi)) then LB(1:4) = lbound(SrcEqMotionQPData%Mi) @@ -3580,8 +3432,6 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err end if end if DstEqMotionQPData%Mi = SrcEqMotionQPData%Mi - else if (allocated(DstEqMotionQPData%Mi)) then - deallocate(DstEqMotionQPData%Mi) end if if (allocated(SrcEqMotionQPData%Oe)) then LB(1:4) = lbound(SrcEqMotionQPData%Oe) @@ -3594,8 +3444,6 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err end if end if DstEqMotionQPData%Oe = SrcEqMotionQPData%Oe - else if (allocated(DstEqMotionQPData%Oe)) then - deallocate(DstEqMotionQPData%Oe) end if if (allocated(SrcEqMotionQPData%Pe)) then LB(1:4) = lbound(SrcEqMotionQPData%Pe) @@ -3608,8 +3456,6 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err end if end if DstEqMotionQPData%Pe = SrcEqMotionQPData%Pe - else if (allocated(DstEqMotionQPData%Pe)) then - deallocate(DstEqMotionQPData%Pe) end if if (allocated(SrcEqMotionQPData%Qe)) then LB(1:4) = lbound(SrcEqMotionQPData%Qe) @@ -3622,8 +3468,6 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err end if end if DstEqMotionQPData%Qe = SrcEqMotionQPData%Qe - else if (allocated(DstEqMotionQPData%Qe)) then - deallocate(DstEqMotionQPData%Qe) end if if (allocated(SrcEqMotionQPData%Gd)) then LB(1:4) = lbound(SrcEqMotionQPData%Gd) @@ -3636,8 +3480,6 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err end if end if DstEqMotionQPData%Gd = SrcEqMotionQPData%Gd - else if (allocated(DstEqMotionQPData%Gd)) then - deallocate(DstEqMotionQPData%Gd) end if if (allocated(SrcEqMotionQPData%Od)) then LB(1:4) = lbound(SrcEqMotionQPData%Od) @@ -3650,8 +3492,6 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err end if end if DstEqMotionQPData%Od = SrcEqMotionQPData%Od - else if (allocated(DstEqMotionQPData%Od)) then - deallocate(DstEqMotionQPData%Od) end if if (allocated(SrcEqMotionQPData%Pd)) then LB(1:4) = lbound(SrcEqMotionQPData%Pd) @@ -3664,8 +3504,6 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err end if end if DstEqMotionQPData%Pd = SrcEqMotionQPData%Pd - else if (allocated(DstEqMotionQPData%Pd)) then - deallocate(DstEqMotionQPData%Pd) end if if (allocated(SrcEqMotionQPData%Qd)) then LB(1:4) = lbound(SrcEqMotionQPData%Qd) @@ -3678,8 +3516,6 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err end if end if DstEqMotionQPData%Qd = SrcEqMotionQPData%Qd - else if (allocated(DstEqMotionQPData%Qd)) then - deallocate(DstEqMotionQPData%Qd) end if if (allocated(SrcEqMotionQPData%Sd)) then LB(1:4) = lbound(SrcEqMotionQPData%Sd) @@ -3692,8 +3528,6 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err end if end if DstEqMotionQPData%Sd = SrcEqMotionQPData%Sd - else if (allocated(DstEqMotionQPData%Sd)) then - deallocate(DstEqMotionQPData%Sd) end if if (allocated(SrcEqMotionQPData%Xd)) then LB(1:4) = lbound(SrcEqMotionQPData%Xd) @@ -3706,8 +3540,6 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err end if end if DstEqMotionQPData%Xd = SrcEqMotionQPData%Xd - else if (allocated(DstEqMotionQPData%Xd)) then - deallocate(DstEqMotionQPData%Xd) end if if (allocated(SrcEqMotionQPData%Yd)) then LB(1:4) = lbound(SrcEqMotionQPData%Yd) @@ -3720,8 +3552,6 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err end if end if DstEqMotionQPData%Yd = SrcEqMotionQPData%Yd - else if (allocated(DstEqMotionQPData%Yd)) then - deallocate(DstEqMotionQPData%Yd) end if end subroutine @@ -4473,8 +4303,6 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%lin_A = SrcMiscData%lin_A - else if (allocated(DstMiscData%lin_A)) then - deallocate(DstMiscData%lin_A) end if if (allocated(SrcMiscData%lin_C)) then LB(1:2) = lbound(SrcMiscData%lin_C) @@ -4487,8 +4315,6 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%lin_C = SrcMiscData%lin_C - else if (allocated(DstMiscData%lin_C)) then - deallocate(DstMiscData%lin_C) end if if (allocated(SrcMiscData%Nrrr)) then LB(1:3) = lbound(SrcMiscData%Nrrr) @@ -4501,8 +4327,6 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%Nrrr = SrcMiscData%Nrrr - else if (allocated(DstMiscData%Nrrr)) then - deallocate(DstMiscData%Nrrr) end if if (allocated(SrcMiscData%elf)) then LB(1:2) = lbound(SrcMiscData%elf) @@ -4515,8 +4339,6 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%elf = SrcMiscData%elf - else if (allocated(DstMiscData%elf)) then - deallocate(DstMiscData%elf) end if if (allocated(SrcMiscData%EFint)) then LB(1:3) = lbound(SrcMiscData%EFint) @@ -4529,8 +4351,6 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%EFint = SrcMiscData%EFint - else if (allocated(DstMiscData%EFint)) then - deallocate(DstMiscData%EFint) end if if (allocated(SrcMiscData%elk)) then LB(1:4) = lbound(SrcMiscData%elk) @@ -4543,8 +4363,6 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%elk = SrcMiscData%elk - else if (allocated(DstMiscData%elk)) then - deallocate(DstMiscData%elk) end if if (allocated(SrcMiscData%elg)) then LB(1:4) = lbound(SrcMiscData%elg) @@ -4557,8 +4375,6 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%elg = SrcMiscData%elg - else if (allocated(DstMiscData%elg)) then - deallocate(DstMiscData%elg) end if if (allocated(SrcMiscData%elm)) then LB(1:4) = lbound(SrcMiscData%elm) @@ -4571,8 +4387,6 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%elm = SrcMiscData%elm - else if (allocated(DstMiscData%elm)) then - deallocate(DstMiscData%elm) end if if (allocated(SrcMiscData%DistrLoad_QP)) then LB(1:3) = lbound(SrcMiscData%DistrLoad_QP) @@ -4585,8 +4399,6 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%DistrLoad_QP = SrcMiscData%DistrLoad_QP - else if (allocated(DstMiscData%DistrLoad_QP)) then - deallocate(DstMiscData%DistrLoad_QP) end if if (allocated(SrcMiscData%PointLoadLcl)) then LB(1:2) = lbound(SrcMiscData%PointLoadLcl) @@ -4599,8 +4411,6 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%PointLoadLcl = SrcMiscData%PointLoadLcl - else if (allocated(DstMiscData%PointLoadLcl)) then - deallocate(DstMiscData%PointLoadLcl) end if if (allocated(SrcMiscData%StifK)) then LB(1:4) = lbound(SrcMiscData%StifK) @@ -4613,8 +4423,6 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%StifK = SrcMiscData%StifK - else if (allocated(DstMiscData%StifK)) then - deallocate(DstMiscData%StifK) end if if (allocated(SrcMiscData%MassM)) then LB(1:4) = lbound(SrcMiscData%MassM) @@ -4627,8 +4435,6 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%MassM = SrcMiscData%MassM - else if (allocated(DstMiscData%MassM)) then - deallocate(DstMiscData%MassM) end if if (allocated(SrcMiscData%DampG)) then LB(1:4) = lbound(SrcMiscData%DampG) @@ -4641,8 +4447,6 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%DampG = SrcMiscData%DampG - else if (allocated(DstMiscData%DampG)) then - deallocate(DstMiscData%DampG) end if if (allocated(SrcMiscData%StifK_fd)) then LB(1:4) = lbound(SrcMiscData%StifK_fd) @@ -4655,8 +4459,6 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%StifK_fd = SrcMiscData%StifK_fd - else if (allocated(DstMiscData%StifK_fd)) then - deallocate(DstMiscData%StifK_fd) end if if (allocated(SrcMiscData%MassM_fd)) then LB(1:4) = lbound(SrcMiscData%MassM_fd) @@ -4669,8 +4471,6 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%MassM_fd = SrcMiscData%MassM_fd - else if (allocated(DstMiscData%MassM_fd)) then - deallocate(DstMiscData%MassM_fd) end if if (allocated(SrcMiscData%DampG_fd)) then LB(1:4) = lbound(SrcMiscData%DampG_fd) @@ -4683,8 +4483,6 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%DampG_fd = SrcMiscData%DampG_fd - else if (allocated(DstMiscData%DampG_fd)) then - deallocate(DstMiscData%DampG_fd) end if if (allocated(SrcMiscData%RHS)) then LB(1:2) = lbound(SrcMiscData%RHS) @@ -4697,8 +4495,6 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%RHS = SrcMiscData%RHS - else if (allocated(DstMiscData%RHS)) then - deallocate(DstMiscData%RHS) end if if (allocated(SrcMiscData%RHS_p)) then LB(1:2) = lbound(SrcMiscData%RHS_p) @@ -4711,8 +4507,6 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%RHS_p = SrcMiscData%RHS_p - else if (allocated(DstMiscData%RHS_p)) then - deallocate(DstMiscData%RHS_p) end if if (allocated(SrcMiscData%RHS_m)) then LB(1:2) = lbound(SrcMiscData%RHS_m) @@ -4725,8 +4519,6 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%RHS_m = SrcMiscData%RHS_m - else if (allocated(DstMiscData%RHS_m)) then - deallocate(DstMiscData%RHS_m) end if if (allocated(SrcMiscData%BldInternalForceFE)) then LB(1:2) = lbound(SrcMiscData%BldInternalForceFE) @@ -4739,8 +4531,6 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%BldInternalForceFE = SrcMiscData%BldInternalForceFE - else if (allocated(DstMiscData%BldInternalForceFE)) then - deallocate(DstMiscData%BldInternalForceFE) end if if (allocated(SrcMiscData%BldInternalForceQP)) then LB(1:2) = lbound(SrcMiscData%BldInternalForceQP) @@ -4753,8 +4543,6 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%BldInternalForceQP = SrcMiscData%BldInternalForceQP - else if (allocated(DstMiscData%BldInternalForceQP)) then - deallocate(DstMiscData%BldInternalForceQP) end if if (allocated(SrcMiscData%FirstNodeReactionLclForceMoment)) then LB(1:1) = lbound(SrcMiscData%FirstNodeReactionLclForceMoment) @@ -4767,8 +4555,6 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%FirstNodeReactionLclForceMoment = SrcMiscData%FirstNodeReactionLclForceMoment - else if (allocated(DstMiscData%FirstNodeReactionLclForceMoment)) then - deallocate(DstMiscData%FirstNodeReactionLclForceMoment) end if if (allocated(SrcMiscData%Solution)) then LB(1:2) = lbound(SrcMiscData%Solution) @@ -4781,8 +4567,6 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%Solution = SrcMiscData%Solution - else if (allocated(DstMiscData%Solution)) then - deallocate(DstMiscData%Solution) end if if (allocated(SrcMiscData%LP_StifK)) then LB(1:2) = lbound(SrcMiscData%LP_StifK) @@ -4795,8 +4579,6 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%LP_StifK = SrcMiscData%LP_StifK - else if (allocated(DstMiscData%LP_StifK)) then - deallocate(DstMiscData%LP_StifK) end if if (allocated(SrcMiscData%LP_MassM)) then LB(1:2) = lbound(SrcMiscData%LP_MassM) @@ -4809,8 +4591,6 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%LP_MassM = SrcMiscData%LP_MassM - else if (allocated(DstMiscData%LP_MassM)) then - deallocate(DstMiscData%LP_MassM) end if if (allocated(SrcMiscData%LP_MassM_LU)) then LB(1:2) = lbound(SrcMiscData%LP_MassM_LU) @@ -4823,8 +4603,6 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%LP_MassM_LU = SrcMiscData%LP_MassM_LU - else if (allocated(DstMiscData%LP_MassM_LU)) then - deallocate(DstMiscData%LP_MassM_LU) end if if (allocated(SrcMiscData%LP_RHS)) then LB(1:1) = lbound(SrcMiscData%LP_RHS) @@ -4837,8 +4615,6 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%LP_RHS = SrcMiscData%LP_RHS - else if (allocated(DstMiscData%LP_RHS)) then - deallocate(DstMiscData%LP_RHS) end if if (allocated(SrcMiscData%LP_StifK_LU)) then LB(1:2) = lbound(SrcMiscData%LP_StifK_LU) @@ -4851,8 +4627,6 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%LP_StifK_LU = SrcMiscData%LP_StifK_LU - else if (allocated(DstMiscData%LP_StifK_LU)) then - deallocate(DstMiscData%LP_StifK_LU) end if if (allocated(SrcMiscData%LP_RHS_LU)) then LB(1:1) = lbound(SrcMiscData%LP_RHS_LU) @@ -4865,8 +4639,6 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%LP_RHS_LU = SrcMiscData%LP_RHS_LU - else if (allocated(DstMiscData%LP_RHS_LU)) then - deallocate(DstMiscData%LP_RHS_LU) end if if (allocated(SrcMiscData%LP_indx)) then LB(1:1) = lbound(SrcMiscData%LP_indx) @@ -4879,8 +4651,6 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%LP_indx = SrcMiscData%LP_indx - else if (allocated(DstMiscData%LP_indx)) then - deallocate(DstMiscData%LP_indx) end if call BD_CopyInput(SrcMiscData%u, DstMiscData%u, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) diff --git a/modules/elastodyn/src/ElastoDyn_Types.f90 b/modules/elastodyn/src/ElastoDyn_Types.f90 index 381a1f12a8..40e43811a1 100644 --- a/modules/elastodyn/src/ElastoDyn_Types.f90 +++ b/modules/elastodyn/src/ElastoDyn_Types.f90 @@ -905,8 +905,6 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr - else if (allocated(DstInitOutputData%WriteOutputHdr)) then - deallocate(DstInitOutputData%WriteOutputHdr) end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) @@ -919,8 +917,6 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt - else if (allocated(DstInitOutputData%WriteOutputUnt)) then - deallocate(DstInitOutputData%WriteOutputUnt) end if call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -937,8 +933,6 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%BlPitch = SrcInitOutputData%BlPitch - else if (allocated(DstInitOutputData%BlPitch)) then - deallocate(DstInitOutputData%BlPitch) end if DstInitOutputData%BladeLength = SrcInitOutputData%BladeLength DstInitOutputData%TowerHeight = SrcInitOutputData%TowerHeight @@ -955,8 +949,6 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%BldRNodes = SrcInitOutputData%BldRNodes - else if (allocated(DstInitOutputData%BldRNodes)) then - deallocate(DstInitOutputData%BldRNodes) end if if (allocated(SrcInitOutputData%TwrHNodes)) then LB(1:1) = lbound(SrcInitOutputData%TwrHNodes) @@ -969,8 +961,6 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%TwrHNodes = SrcInitOutputData%TwrHNodes - else if (allocated(DstInitOutputData%TwrHNodes)) then - deallocate(DstInitOutputData%TwrHNodes) end if DstInitOutputData%PlatformPos = SrcInitOutputData%PlatformPos DstInitOutputData%TwrBaseRefPos = SrcInitOutputData%TwrBaseRefPos @@ -991,8 +981,6 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y - else if (allocated(DstInitOutputData%LinNames_y)) then - deallocate(DstInitOutputData%LinNames_y) end if if (allocated(SrcInitOutputData%LinNames_x)) then LB(1:1) = lbound(SrcInitOutputData%LinNames_x) @@ -1005,8 +993,6 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x - else if (allocated(DstInitOutputData%LinNames_x)) then - deallocate(DstInitOutputData%LinNames_x) end if if (allocated(SrcInitOutputData%LinNames_u)) then LB(1:1) = lbound(SrcInitOutputData%LinNames_u) @@ -1019,8 +1005,6 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u - else if (allocated(DstInitOutputData%LinNames_u)) then - deallocate(DstInitOutputData%LinNames_u) end if if (allocated(SrcInitOutputData%RotFrame_y)) then LB(1:1) = lbound(SrcInitOutputData%RotFrame_y) @@ -1033,8 +1017,6 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y - else if (allocated(DstInitOutputData%RotFrame_y)) then - deallocate(DstInitOutputData%RotFrame_y) end if if (allocated(SrcInitOutputData%RotFrame_x)) then LB(1:1) = lbound(SrcInitOutputData%RotFrame_x) @@ -1047,8 +1029,6 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x - else if (allocated(DstInitOutputData%RotFrame_x)) then - deallocate(DstInitOutputData%RotFrame_x) end if if (allocated(SrcInitOutputData%DerivOrder_x)) then LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) @@ -1061,8 +1041,6 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x - else if (allocated(DstInitOutputData%DerivOrder_x)) then - deallocate(DstInitOutputData%DerivOrder_x) end if if (allocated(SrcInitOutputData%RotFrame_u)) then LB(1:1) = lbound(SrcInitOutputData%RotFrame_u) @@ -1075,8 +1053,6 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u - else if (allocated(DstInitOutputData%RotFrame_u)) then - deallocate(DstInitOutputData%RotFrame_u) end if if (allocated(SrcInitOutputData%IsLoad_u)) then LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) @@ -1089,8 +1065,6 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u - else if (allocated(DstInitOutputData%IsLoad_u)) then - deallocate(DstInitOutputData%IsLoad_u) end if end subroutine @@ -1475,8 +1449,6 @@ subroutine ED_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C end if end if DstBladeInputDataData%BlFract = SrcBladeInputDataData%BlFract - else if (allocated(DstBladeInputDataData%BlFract)) then - deallocate(DstBladeInputDataData%BlFract) end if if (allocated(SrcBladeInputDataData%PitchAx)) then LB(1:1) = lbound(SrcBladeInputDataData%PitchAx) @@ -1489,8 +1461,6 @@ subroutine ED_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C end if end if DstBladeInputDataData%PitchAx = SrcBladeInputDataData%PitchAx - else if (allocated(DstBladeInputDataData%PitchAx)) then - deallocate(DstBladeInputDataData%PitchAx) end if if (allocated(SrcBladeInputDataData%StrcTwst)) then LB(1:1) = lbound(SrcBladeInputDataData%StrcTwst) @@ -1503,8 +1473,6 @@ subroutine ED_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C end if end if DstBladeInputDataData%StrcTwst = SrcBladeInputDataData%StrcTwst - else if (allocated(DstBladeInputDataData%StrcTwst)) then - deallocate(DstBladeInputDataData%StrcTwst) end if if (allocated(SrcBladeInputDataData%BMassDen)) then LB(1:1) = lbound(SrcBladeInputDataData%BMassDen) @@ -1517,8 +1485,6 @@ subroutine ED_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C end if end if DstBladeInputDataData%BMassDen = SrcBladeInputDataData%BMassDen - else if (allocated(DstBladeInputDataData%BMassDen)) then - deallocate(DstBladeInputDataData%BMassDen) end if if (allocated(SrcBladeInputDataData%FlpStff)) then LB(1:1) = lbound(SrcBladeInputDataData%FlpStff) @@ -1531,8 +1497,6 @@ subroutine ED_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C end if end if DstBladeInputDataData%FlpStff = SrcBladeInputDataData%FlpStff - else if (allocated(DstBladeInputDataData%FlpStff)) then - deallocate(DstBladeInputDataData%FlpStff) end if if (allocated(SrcBladeInputDataData%EdgStff)) then LB(1:1) = lbound(SrcBladeInputDataData%EdgStff) @@ -1545,8 +1509,6 @@ subroutine ED_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C end if end if DstBladeInputDataData%EdgStff = SrcBladeInputDataData%EdgStff - else if (allocated(DstBladeInputDataData%EdgStff)) then - deallocate(DstBladeInputDataData%EdgStff) end if DstBladeInputDataData%BldFlDmp = SrcBladeInputDataData%BldFlDmp DstBladeInputDataData%BldEdDmp = SrcBladeInputDataData%BldEdDmp @@ -1562,8 +1524,6 @@ subroutine ED_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C end if end if DstBladeInputDataData%BldFl1Sh = SrcBladeInputDataData%BldFl1Sh - else if (allocated(DstBladeInputDataData%BldFl1Sh)) then - deallocate(DstBladeInputDataData%BldFl1Sh) end if if (allocated(SrcBladeInputDataData%BldFl2Sh)) then LB(1:1) = lbound(SrcBladeInputDataData%BldFl2Sh) @@ -1576,8 +1536,6 @@ subroutine ED_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C end if end if DstBladeInputDataData%BldFl2Sh = SrcBladeInputDataData%BldFl2Sh - else if (allocated(DstBladeInputDataData%BldFl2Sh)) then - deallocate(DstBladeInputDataData%BldFl2Sh) end if if (allocated(SrcBladeInputDataData%BldEdgSh)) then LB(1:1) = lbound(SrcBladeInputDataData%BldEdgSh) @@ -1590,8 +1548,6 @@ subroutine ED_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C end if end if DstBladeInputDataData%BldEdgSh = SrcBladeInputDataData%BldEdgSh - else if (allocated(DstBladeInputDataData%BldEdgSh)) then - deallocate(DstBladeInputDataData%BldEdgSh) end if end subroutine @@ -1855,8 +1811,6 @@ subroutine ED_CopyBladeMeshInputData(SrcBladeMeshInputDataData, DstBladeMeshInpu end if end if DstBladeMeshInputDataData%RNodes = SrcBladeMeshInputDataData%RNodes - else if (allocated(DstBladeMeshInputDataData%RNodes)) then - deallocate(DstBladeMeshInputDataData%RNodes) end if if (allocated(SrcBladeMeshInputDataData%AeroTwst)) then LB(1:1) = lbound(SrcBladeMeshInputDataData%AeroTwst) @@ -1869,8 +1823,6 @@ subroutine ED_CopyBladeMeshInputData(SrcBladeMeshInputDataData, DstBladeMeshInpu end if end if DstBladeMeshInputDataData%AeroTwst = SrcBladeMeshInputDataData%AeroTwst - else if (allocated(DstBladeMeshInputDataData%AeroTwst)) then - deallocate(DstBladeMeshInputDataData%AeroTwst) end if if (allocated(SrcBladeMeshInputDataData%Chord)) then LB(1:1) = lbound(SrcBladeMeshInputDataData%Chord) @@ -1883,8 +1835,6 @@ subroutine ED_CopyBladeMeshInputData(SrcBladeMeshInputDataData, DstBladeMeshInpu end if end if DstBladeMeshInputDataData%Chord = SrcBladeMeshInputDataData%Chord - else if (allocated(DstBladeMeshInputDataData%Chord)) then - deallocate(DstBladeMeshInputDataData%Chord) end if end subroutine @@ -2028,8 +1978,6 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end if end if DstInputFileData%BlPitch = SrcInputFileData%BlPitch - else if (allocated(DstInputFileData%BlPitch)) then - deallocate(DstInputFileData%BlPitch) end if DstInputFileData%TeetDefl = SrcInputFileData%TeetDefl DstInputFileData%Azimuth = SrcInputFileData%Azimuth @@ -2057,8 +2005,6 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end if end if DstInputFileData%PreCone = SrcInputFileData%PreCone - else if (allocated(DstInputFileData%PreCone)) then - deallocate(DstInputFileData%PreCone) end if DstInputFileData%HubCM = SrcInputFileData%HubCM DstInputFileData%UndSling = SrcInputFileData%UndSling @@ -2091,8 +2037,6 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end if end if DstInputFileData%TipMass = SrcInputFileData%TipMass - else if (allocated(DstInputFileData%TipMass)) then - deallocate(DstInputFileData%TipMass) end if DstInputFileData%HubMass = SrcInputFileData%HubMass DstInputFileData%HubIner = SrcInputFileData%HubIner @@ -2120,8 +2064,6 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstInputFileData%InpBlMesh)) then - deallocate(DstInputFileData%InpBlMesh) end if if (allocated(SrcInputFileData%InpBl)) then LB(1:1) = lbound(SrcInputFileData%InpBl) @@ -2138,8 +2080,6 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstInputFileData%InpBl)) then - deallocate(DstInputFileData%InpBl) end if DstInputFileData%TeetMod = SrcInputFileData%TeetMod DstInputFileData%TeetDmpP = SrcInputFileData%TeetDmpP @@ -2177,8 +2117,6 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end if end if DstInputFileData%OutList = SrcInputFileData%OutList - else if (allocated(DstInputFileData%OutList)) then - deallocate(DstInputFileData%OutList) end if DstInputFileData%NTwInpSt = SrcInputFileData%NTwInpSt DstInputFileData%TwrFADmp = SrcInputFileData%TwrFADmp @@ -2196,8 +2134,6 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end if end if DstInputFileData%HtFract = SrcInputFileData%HtFract - else if (allocated(DstInputFileData%HtFract)) then - deallocate(DstInputFileData%HtFract) end if if (allocated(SrcInputFileData%TMassDen)) then LB(1:1) = lbound(SrcInputFileData%TMassDen) @@ -2210,8 +2146,6 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end if end if DstInputFileData%TMassDen = SrcInputFileData%TMassDen - else if (allocated(DstInputFileData%TMassDen)) then - deallocate(DstInputFileData%TMassDen) end if if (allocated(SrcInputFileData%TwFAStif)) then LB(1:1) = lbound(SrcInputFileData%TwFAStif) @@ -2224,8 +2158,6 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end if end if DstInputFileData%TwFAStif = SrcInputFileData%TwFAStif - else if (allocated(DstInputFileData%TwFAStif)) then - deallocate(DstInputFileData%TwFAStif) end if if (allocated(SrcInputFileData%TwSSStif)) then LB(1:1) = lbound(SrcInputFileData%TwSSStif) @@ -2238,8 +2170,6 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end if end if DstInputFileData%TwSSStif = SrcInputFileData%TwSSStif - else if (allocated(DstInputFileData%TwSSStif)) then - deallocate(DstInputFileData%TwSSStif) end if if (allocated(SrcInputFileData%TwFAM1Sh)) then LB(1:1) = lbound(SrcInputFileData%TwFAM1Sh) @@ -2252,8 +2182,6 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end if end if DstInputFileData%TwFAM1Sh = SrcInputFileData%TwFAM1Sh - else if (allocated(DstInputFileData%TwFAM1Sh)) then - deallocate(DstInputFileData%TwFAM1Sh) end if if (allocated(SrcInputFileData%TwFAM2Sh)) then LB(1:1) = lbound(SrcInputFileData%TwFAM2Sh) @@ -2266,8 +2194,6 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end if end if DstInputFileData%TwFAM2Sh = SrcInputFileData%TwFAM2Sh - else if (allocated(DstInputFileData%TwFAM2Sh)) then - deallocate(DstInputFileData%TwFAM2Sh) end if if (allocated(SrcInputFileData%TwSSM1Sh)) then LB(1:1) = lbound(SrcInputFileData%TwSSM1Sh) @@ -2280,8 +2206,6 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end if end if DstInputFileData%TwSSM1Sh = SrcInputFileData%TwSSM1Sh - else if (allocated(DstInputFileData%TwSSM1Sh)) then - deallocate(DstInputFileData%TwSSM1Sh) end if if (allocated(SrcInputFileData%TwSSM2Sh)) then LB(1:1) = lbound(SrcInputFileData%TwSSM2Sh) @@ -2294,8 +2218,6 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end if end if DstInputFileData%TwSSM2Sh = SrcInputFileData%TwSSM2Sh - else if (allocated(DstInputFileData%TwSSM2Sh)) then - deallocate(DstInputFileData%TwSSM2Sh) end if DstInputFileData%RFrlDOF = SrcInputFileData%RFrlDOF DstInputFileData%TFrlDOF = SrcInputFileData%TFrlDOF @@ -2352,8 +2274,6 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end if end if DstInputFileData%BldNd_OutList = SrcInputFileData%BldNd_OutList - else if (allocated(DstInputFileData%BldNd_OutList)) then - deallocate(DstInputFileData%BldNd_OutList) end if DstInputFileData%BldNd_BlOutNd_Str = SrcInputFileData%BldNd_BlOutNd_Str DstInputFileData%BldNd_BladesOut = SrcInputFileData%BldNd_BladesOut @@ -3214,8 +3134,6 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, end if end if DstCoordSysData%i1 = SrcCoordSysData%i1 - else if (allocated(DstCoordSysData%i1)) then - deallocate(DstCoordSysData%i1) end if if (allocated(SrcCoordSysData%i2)) then LB(1:2) = lbound(SrcCoordSysData%i2) @@ -3228,8 +3146,6 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, end if end if DstCoordSysData%i2 = SrcCoordSysData%i2 - else if (allocated(DstCoordSysData%i2)) then - deallocate(DstCoordSysData%i2) end if if (allocated(SrcCoordSysData%i3)) then LB(1:2) = lbound(SrcCoordSysData%i3) @@ -3242,8 +3158,6 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, end if end if DstCoordSysData%i3 = SrcCoordSysData%i3 - else if (allocated(DstCoordSysData%i3)) then - deallocate(DstCoordSysData%i3) end if if (allocated(SrcCoordSysData%j1)) then LB(1:2) = lbound(SrcCoordSysData%j1) @@ -3256,8 +3170,6 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, end if end if DstCoordSysData%j1 = SrcCoordSysData%j1 - else if (allocated(DstCoordSysData%j1)) then - deallocate(DstCoordSysData%j1) end if if (allocated(SrcCoordSysData%j2)) then LB(1:2) = lbound(SrcCoordSysData%j2) @@ -3270,8 +3182,6 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, end if end if DstCoordSysData%j2 = SrcCoordSysData%j2 - else if (allocated(DstCoordSysData%j2)) then - deallocate(DstCoordSysData%j2) end if if (allocated(SrcCoordSysData%j3)) then LB(1:2) = lbound(SrcCoordSysData%j3) @@ -3284,8 +3194,6 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, end if end if DstCoordSysData%j3 = SrcCoordSysData%j3 - else if (allocated(DstCoordSysData%j3)) then - deallocate(DstCoordSysData%j3) end if if (allocated(SrcCoordSysData%m1)) then LB(1:3) = lbound(SrcCoordSysData%m1) @@ -3298,8 +3206,6 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, end if end if DstCoordSysData%m1 = SrcCoordSysData%m1 - else if (allocated(DstCoordSysData%m1)) then - deallocate(DstCoordSysData%m1) end if if (allocated(SrcCoordSysData%m2)) then LB(1:3) = lbound(SrcCoordSysData%m2) @@ -3312,8 +3218,6 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, end if end if DstCoordSysData%m2 = SrcCoordSysData%m2 - else if (allocated(DstCoordSysData%m2)) then - deallocate(DstCoordSysData%m2) end if if (allocated(SrcCoordSysData%m3)) then LB(1:3) = lbound(SrcCoordSysData%m3) @@ -3326,8 +3230,6 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, end if end if DstCoordSysData%m3 = SrcCoordSysData%m3 - else if (allocated(DstCoordSysData%m3)) then - deallocate(DstCoordSysData%m3) end if if (allocated(SrcCoordSysData%n1)) then LB(1:3) = lbound(SrcCoordSysData%n1) @@ -3340,8 +3242,6 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, end if end if DstCoordSysData%n1 = SrcCoordSysData%n1 - else if (allocated(DstCoordSysData%n1)) then - deallocate(DstCoordSysData%n1) end if if (allocated(SrcCoordSysData%n2)) then LB(1:3) = lbound(SrcCoordSysData%n2) @@ -3354,8 +3254,6 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, end if end if DstCoordSysData%n2 = SrcCoordSysData%n2 - else if (allocated(DstCoordSysData%n2)) then - deallocate(DstCoordSysData%n2) end if if (allocated(SrcCoordSysData%n3)) then LB(1:3) = lbound(SrcCoordSysData%n3) @@ -3368,8 +3266,6 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, end if end if DstCoordSysData%n3 = SrcCoordSysData%n3 - else if (allocated(DstCoordSysData%n3)) then - deallocate(DstCoordSysData%n3) end if DstCoordSysData%rf1 = SrcCoordSysData%rf1 DstCoordSysData%rf2 = SrcCoordSysData%rf2 @@ -3386,8 +3282,6 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, end if end if DstCoordSysData%t1 = SrcCoordSysData%t1 - else if (allocated(DstCoordSysData%t1)) then - deallocate(DstCoordSysData%t1) end if if (allocated(SrcCoordSysData%t2)) then LB(1:2) = lbound(SrcCoordSysData%t2) @@ -3400,8 +3294,6 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, end if end if DstCoordSysData%t2 = SrcCoordSysData%t2 - else if (allocated(DstCoordSysData%t2)) then - deallocate(DstCoordSysData%t2) end if if (allocated(SrcCoordSysData%t3)) then LB(1:2) = lbound(SrcCoordSysData%t3) @@ -3414,8 +3306,6 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, end if end if DstCoordSysData%t3 = SrcCoordSysData%t3 - else if (allocated(DstCoordSysData%t3)) then - deallocate(DstCoordSysData%t3) end if if (allocated(SrcCoordSysData%te1)) then LB(1:3) = lbound(SrcCoordSysData%te1) @@ -3428,8 +3318,6 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, end if end if DstCoordSysData%te1 = SrcCoordSysData%te1 - else if (allocated(DstCoordSysData%te1)) then - deallocate(DstCoordSysData%te1) end if if (allocated(SrcCoordSysData%te2)) then LB(1:3) = lbound(SrcCoordSysData%te2) @@ -3442,8 +3330,6 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, end if end if DstCoordSysData%te2 = SrcCoordSysData%te2 - else if (allocated(DstCoordSysData%te2)) then - deallocate(DstCoordSysData%te2) end if if (allocated(SrcCoordSysData%te3)) then LB(1:3) = lbound(SrcCoordSysData%te3) @@ -3456,8 +3342,6 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, end if end if DstCoordSysData%te3 = SrcCoordSysData%te3 - else if (allocated(DstCoordSysData%te3)) then - deallocate(DstCoordSysData%te3) end if DstCoordSysData%tf1 = SrcCoordSysData%tf1 DstCoordSysData%tf2 = SrcCoordSysData%tf2 @@ -4015,8 +3899,6 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err end if end if DstActiveDOFsData%NPSBE = SrcActiveDOFsData%NPSBE - else if (allocated(DstActiveDOFsData%NPSBE)) then - deallocate(DstActiveDOFsData%NPSBE) end if if (allocated(SrcActiveDOFsData%NPSE)) then LB(1:1) = lbound(SrcActiveDOFsData%NPSE) @@ -4029,8 +3911,6 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err end if end if DstActiveDOFsData%NPSE = SrcActiveDOFsData%NPSE - else if (allocated(DstActiveDOFsData%NPSE)) then - deallocate(DstActiveDOFsData%NPSE) end if DstActiveDOFsData%NPUE = SrcActiveDOFsData%NPUE DstActiveDOFsData%NPYE = SrcActiveDOFsData%NPYE @@ -4045,8 +3925,6 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err end if end if DstActiveDOFsData%PCE = SrcActiveDOFsData%PCE - else if (allocated(DstActiveDOFsData%PCE)) then - deallocate(DstActiveDOFsData%PCE) end if if (allocated(SrcActiveDOFsData%PDE)) then LB(1:1) = lbound(SrcActiveDOFsData%PDE) @@ -4059,8 +3937,6 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err end if end if DstActiveDOFsData%PDE = SrcActiveDOFsData%PDE - else if (allocated(DstActiveDOFsData%PDE)) then - deallocate(DstActiveDOFsData%PDE) end if if (allocated(SrcActiveDOFsData%PIE)) then LB(1:1) = lbound(SrcActiveDOFsData%PIE) @@ -4073,8 +3949,6 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err end if end if DstActiveDOFsData%PIE = SrcActiveDOFsData%PIE - else if (allocated(DstActiveDOFsData%PIE)) then - deallocate(DstActiveDOFsData%PIE) end if if (allocated(SrcActiveDOFsData%PTE)) then LB(1:1) = lbound(SrcActiveDOFsData%PTE) @@ -4087,8 +3961,6 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err end if end if DstActiveDOFsData%PTE = SrcActiveDOFsData%PTE - else if (allocated(DstActiveDOFsData%PTE)) then - deallocate(DstActiveDOFsData%PTE) end if if (allocated(SrcActiveDOFsData%PTTE)) then LB(1:1) = lbound(SrcActiveDOFsData%PTTE) @@ -4101,8 +3973,6 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err end if end if DstActiveDOFsData%PTTE = SrcActiveDOFsData%PTTE - else if (allocated(DstActiveDOFsData%PTTE)) then - deallocate(DstActiveDOFsData%PTTE) end if if (allocated(SrcActiveDOFsData%PS)) then LB(1:1) = lbound(SrcActiveDOFsData%PS) @@ -4115,8 +3985,6 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err end if end if DstActiveDOFsData%PS = SrcActiveDOFsData%PS - else if (allocated(DstActiveDOFsData%PS)) then - deallocate(DstActiveDOFsData%PS) end if if (allocated(SrcActiveDOFsData%PSBE)) then LB(1:2) = lbound(SrcActiveDOFsData%PSBE) @@ -4129,8 +3997,6 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err end if end if DstActiveDOFsData%PSBE = SrcActiveDOFsData%PSBE - else if (allocated(DstActiveDOFsData%PSBE)) then - deallocate(DstActiveDOFsData%PSBE) end if if (allocated(SrcActiveDOFsData%PSE)) then LB(1:2) = lbound(SrcActiveDOFsData%PSE) @@ -4143,8 +4009,6 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err end if end if DstActiveDOFsData%PSE = SrcActiveDOFsData%PSE - else if (allocated(DstActiveDOFsData%PSE)) then - deallocate(DstActiveDOFsData%PSE) end if if (allocated(SrcActiveDOFsData%PUE)) then LB(1:1) = lbound(SrcActiveDOFsData%PUE) @@ -4157,8 +4021,6 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err end if end if DstActiveDOFsData%PUE = SrcActiveDOFsData%PUE - else if (allocated(DstActiveDOFsData%PUE)) then - deallocate(DstActiveDOFsData%PUE) end if if (allocated(SrcActiveDOFsData%PYE)) then LB(1:1) = lbound(SrcActiveDOFsData%PYE) @@ -4171,8 +4033,6 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err end if end if DstActiveDOFsData%PYE = SrcActiveDOFsData%PYE - else if (allocated(DstActiveDOFsData%PYE)) then - deallocate(DstActiveDOFsData%PYE) end if if (allocated(SrcActiveDOFsData%SrtPS)) then LB(1:1) = lbound(SrcActiveDOFsData%SrtPS) @@ -4185,8 +4045,6 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err end if end if DstActiveDOFsData%SrtPS = SrcActiveDOFsData%SrtPS - else if (allocated(DstActiveDOFsData%SrtPS)) then - deallocate(DstActiveDOFsData%SrtPS) end if if (allocated(SrcActiveDOFsData%SrtPSNAUG)) then LB(1:1) = lbound(SrcActiveDOFsData%SrtPSNAUG) @@ -4199,8 +4057,6 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err end if end if DstActiveDOFsData%SrtPSNAUG = SrcActiveDOFsData%SrtPSNAUG - else if (allocated(DstActiveDOFsData%SrtPSNAUG)) then - deallocate(DstActiveDOFsData%SrtPSNAUG) end if if (allocated(SrcActiveDOFsData%Diag)) then LB(1:1) = lbound(SrcActiveDOFsData%Diag) @@ -4213,8 +4069,6 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err end if end if DstActiveDOFsData%Diag = SrcActiveDOFsData%Diag - else if (allocated(DstActiveDOFsData%Diag)) then - deallocate(DstActiveDOFsData%Diag) end if end subroutine @@ -4622,8 +4476,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%rQS = SrcRtHndSideData%rQS - else if (allocated(DstRtHndSideData%rQS)) then - deallocate(DstRtHndSideData%rQS) end if if (allocated(SrcRtHndSideData%rS)) then LB(1:3) = lbound(SrcRtHndSideData%rS) @@ -4636,8 +4488,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%rS = SrcRtHndSideData%rS - else if (allocated(DstRtHndSideData%rS)) then - deallocate(DstRtHndSideData%rS) end if if (allocated(SrcRtHndSideData%rS0S)) then LB(1:3) = lbound(SrcRtHndSideData%rS0S) @@ -4650,8 +4500,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%rS0S = SrcRtHndSideData%rS0S - else if (allocated(DstRtHndSideData%rS0S)) then - deallocate(DstRtHndSideData%rS0S) end if if (allocated(SrcRtHndSideData%rT)) then LB(1:2) = lbound(SrcRtHndSideData%rT) @@ -4664,8 +4512,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%rT = SrcRtHndSideData%rT - else if (allocated(DstRtHndSideData%rT)) then - deallocate(DstRtHndSideData%rT) end if DstRtHndSideData%rT0O = SrcRtHndSideData%rT0O if (allocated(SrcRtHndSideData%rT0T)) then @@ -4679,8 +4525,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%rT0T = SrcRtHndSideData%rT0T - else if (allocated(DstRtHndSideData%rT0T)) then - deallocate(DstRtHndSideData%rT0T) end if DstRtHndSideData%rZ = SrcRtHndSideData%rZ DstRtHndSideData%rZO = SrcRtHndSideData%rZO @@ -4695,8 +4539,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%rZT = SrcRtHndSideData%rZT - else if (allocated(DstRtHndSideData%rZT)) then - deallocate(DstRtHndSideData%rZT) end if DstRtHndSideData%rPQ = SrcRtHndSideData%rPQ DstRtHndSideData%rP = SrcRtHndSideData%rP @@ -4719,8 +4561,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%rPS0 = SrcRtHndSideData%rPS0 - else if (allocated(DstRtHndSideData%rPS0)) then - deallocate(DstRtHndSideData%rPS0) end if DstRtHndSideData%rQ = SrcRtHndSideData%rQ DstRtHndSideData%rQC = SrcRtHndSideData%rQC @@ -4740,8 +4580,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%AngPosEF = SrcRtHndSideData%AngPosEF - else if (allocated(DstRtHndSideData%AngPosEF)) then - deallocate(DstRtHndSideData%AngPosEF) end if if (allocated(SrcRtHndSideData%AngPosXF)) then LB(1:2) = lbound(SrcRtHndSideData%AngPosXF) @@ -4754,8 +4592,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%AngPosXF = SrcRtHndSideData%AngPosXF - else if (allocated(DstRtHndSideData%AngPosXF)) then - deallocate(DstRtHndSideData%AngPosXF) end if if (allocated(SrcRtHndSideData%AngPosHM)) then LB(1:3) = lbound(SrcRtHndSideData%AngPosHM) @@ -4768,8 +4604,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%AngPosHM = SrcRtHndSideData%AngPosHM - else if (allocated(DstRtHndSideData%AngPosHM)) then - deallocate(DstRtHndSideData%AngPosHM) end if DstRtHndSideData%AngPosXB = SrcRtHndSideData%AngPosXB DstRtHndSideData%AngPosEX = SrcRtHndSideData%AngPosEX @@ -4784,8 +4618,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%PAngVelEA = SrcRtHndSideData%PAngVelEA - else if (allocated(DstRtHndSideData%PAngVelEA)) then - deallocate(DstRtHndSideData%PAngVelEA) end if if (allocated(SrcRtHndSideData%PAngVelEF)) then LB(1:4) = lbound(SrcRtHndSideData%PAngVelEF) @@ -4798,8 +4630,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%PAngVelEF = SrcRtHndSideData%PAngVelEF - else if (allocated(DstRtHndSideData%PAngVelEF)) then - deallocate(DstRtHndSideData%PAngVelEF) end if if (allocated(SrcRtHndSideData%PAngVelEG)) then LB(1:3) = lbound(SrcRtHndSideData%PAngVelEG) @@ -4812,8 +4642,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%PAngVelEG = SrcRtHndSideData%PAngVelEG - else if (allocated(DstRtHndSideData%PAngVelEG)) then - deallocate(DstRtHndSideData%PAngVelEG) end if if (allocated(SrcRtHndSideData%PAngVelEH)) then LB(1:3) = lbound(SrcRtHndSideData%PAngVelEH) @@ -4826,8 +4654,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%PAngVelEH = SrcRtHndSideData%PAngVelEH - else if (allocated(DstRtHndSideData%PAngVelEH)) then - deallocate(DstRtHndSideData%PAngVelEH) end if if (allocated(SrcRtHndSideData%PAngVelEL)) then LB(1:3) = lbound(SrcRtHndSideData%PAngVelEL) @@ -4840,8 +4666,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%PAngVelEL = SrcRtHndSideData%PAngVelEL - else if (allocated(DstRtHndSideData%PAngVelEL)) then - deallocate(DstRtHndSideData%PAngVelEL) end if if (allocated(SrcRtHndSideData%PAngVelEM)) then LB(1:5) = lbound(SrcRtHndSideData%PAngVelEM) @@ -4854,8 +4678,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%PAngVelEM = SrcRtHndSideData%PAngVelEM - else if (allocated(DstRtHndSideData%PAngVelEM)) then - deallocate(DstRtHndSideData%PAngVelEM) end if if (allocated(SrcRtHndSideData%AngVelEM)) then LB(1:3) = lbound(SrcRtHndSideData%AngVelEM) @@ -4868,8 +4690,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%AngVelEM = SrcRtHndSideData%AngVelEM - else if (allocated(DstRtHndSideData%AngVelEM)) then - deallocate(DstRtHndSideData%AngVelEM) end if if (allocated(SrcRtHndSideData%PAngVelEN)) then LB(1:3) = lbound(SrcRtHndSideData%PAngVelEN) @@ -4882,8 +4702,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%PAngVelEN = SrcRtHndSideData%PAngVelEN - else if (allocated(DstRtHndSideData%PAngVelEN)) then - deallocate(DstRtHndSideData%PAngVelEN) end if DstRtHndSideData%AngVelEA = SrcRtHndSideData%AngVelEA if (allocated(SrcRtHndSideData%PAngVelEB)) then @@ -4897,8 +4715,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%PAngVelEB = SrcRtHndSideData%PAngVelEB - else if (allocated(DstRtHndSideData%PAngVelEB)) then - deallocate(DstRtHndSideData%PAngVelEB) end if if (allocated(SrcRtHndSideData%PAngVelER)) then LB(1:3) = lbound(SrcRtHndSideData%PAngVelER) @@ -4911,8 +4727,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%PAngVelER = SrcRtHndSideData%PAngVelER - else if (allocated(DstRtHndSideData%PAngVelER)) then - deallocate(DstRtHndSideData%PAngVelER) end if if (allocated(SrcRtHndSideData%PAngVelEX)) then LB(1:3) = lbound(SrcRtHndSideData%PAngVelEX) @@ -4925,8 +4739,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%PAngVelEX = SrcRtHndSideData%PAngVelEX - else if (allocated(DstRtHndSideData%PAngVelEX)) then - deallocate(DstRtHndSideData%PAngVelEX) end if DstRtHndSideData%AngVelEG = SrcRtHndSideData%AngVelEG DstRtHndSideData%AngVelEH = SrcRtHndSideData%AngVelEH @@ -4950,8 +4762,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%AngAccEFt = SrcRtHndSideData%AngAccEFt - else if (allocated(DstRtHndSideData%AngAccEFt)) then - deallocate(DstRtHndSideData%AngAccEFt) end if if (allocated(SrcRtHndSideData%AngVelEF)) then LB(1:2) = lbound(SrcRtHndSideData%AngVelEF) @@ -4964,8 +4774,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%AngVelEF = SrcRtHndSideData%AngVelEF - else if (allocated(DstRtHndSideData%AngVelEF)) then - deallocate(DstRtHndSideData%AngVelEF) end if if (allocated(SrcRtHndSideData%AngVelHM)) then LB(1:3) = lbound(SrcRtHndSideData%AngVelHM) @@ -4978,8 +4786,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%AngVelHM = SrcRtHndSideData%AngVelHM - else if (allocated(DstRtHndSideData%AngVelHM)) then - deallocate(DstRtHndSideData%AngVelHM) end if DstRtHndSideData%AngAccEAt = SrcRtHndSideData%AngAccEAt DstRtHndSideData%AngAccEGt = SrcRtHndSideData%AngAccEGt @@ -4995,8 +4801,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%AngAccEKt = SrcRtHndSideData%AngAccEKt - else if (allocated(DstRtHndSideData%AngAccEKt)) then - deallocate(DstRtHndSideData%AngAccEKt) end if DstRtHndSideData%AngAccENt = SrcRtHndSideData%AngAccENt DstRtHndSideData%LinAccECt = SrcRtHndSideData%LinAccECt @@ -5016,8 +4820,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%LinVelES = SrcRtHndSideData%LinVelES - else if (allocated(DstRtHndSideData%LinVelES)) then - deallocate(DstRtHndSideData%LinVelES) end if DstRtHndSideData%LinVelEQ = SrcRtHndSideData%LinVelEQ if (allocated(SrcRtHndSideData%LinVelET)) then @@ -5031,8 +4833,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%LinVelET = SrcRtHndSideData%LinVelET - else if (allocated(DstRtHndSideData%LinVelET)) then - deallocate(DstRtHndSideData%LinVelET) end if if (allocated(SrcRtHndSideData%LinVelESm2)) then LB(1:1) = lbound(SrcRtHndSideData%LinVelESm2) @@ -5045,8 +4845,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%LinVelESm2 = SrcRtHndSideData%LinVelESm2 - else if (allocated(DstRtHndSideData%LinVelESm2)) then - deallocate(DstRtHndSideData%LinVelESm2) end if if (allocated(SrcRtHndSideData%PLinVelEIMU)) then LB(1:3) = lbound(SrcRtHndSideData%PLinVelEIMU) @@ -5059,8 +4857,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%PLinVelEIMU = SrcRtHndSideData%PLinVelEIMU - else if (allocated(DstRtHndSideData%PLinVelEIMU)) then - deallocate(DstRtHndSideData%PLinVelEIMU) end if if (allocated(SrcRtHndSideData%PLinVelEO)) then LB(1:3) = lbound(SrcRtHndSideData%PLinVelEO) @@ -5073,8 +4869,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%PLinVelEO = SrcRtHndSideData%PLinVelEO - else if (allocated(DstRtHndSideData%PLinVelEO)) then - deallocate(DstRtHndSideData%PLinVelEO) end if if (allocated(SrcRtHndSideData%PLinVelES)) then LB(1:5) = lbound(SrcRtHndSideData%PLinVelES) @@ -5087,8 +4881,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%PLinVelES = SrcRtHndSideData%PLinVelES - else if (allocated(DstRtHndSideData%PLinVelES)) then - deallocate(DstRtHndSideData%PLinVelES) end if if (allocated(SrcRtHndSideData%PLinVelET)) then LB(1:4) = lbound(SrcRtHndSideData%PLinVelET) @@ -5101,8 +4893,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%PLinVelET = SrcRtHndSideData%PLinVelET - else if (allocated(DstRtHndSideData%PLinVelET)) then - deallocate(DstRtHndSideData%PLinVelET) end if if (allocated(SrcRtHndSideData%PLinVelEZ)) then LB(1:3) = lbound(SrcRtHndSideData%PLinVelEZ) @@ -5115,8 +4905,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%PLinVelEZ = SrcRtHndSideData%PLinVelEZ - else if (allocated(DstRtHndSideData%PLinVelEZ)) then - deallocate(DstRtHndSideData%PLinVelEZ) end if if (allocated(SrcRtHndSideData%PLinVelEC)) then LB(1:3) = lbound(SrcRtHndSideData%PLinVelEC) @@ -5129,8 +4917,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%PLinVelEC = SrcRtHndSideData%PLinVelEC - else if (allocated(DstRtHndSideData%PLinVelEC)) then - deallocate(DstRtHndSideData%PLinVelEC) end if if (allocated(SrcRtHndSideData%PLinVelED)) then LB(1:3) = lbound(SrcRtHndSideData%PLinVelED) @@ -5143,8 +4929,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%PLinVelED = SrcRtHndSideData%PLinVelED - else if (allocated(DstRtHndSideData%PLinVelED)) then - deallocate(DstRtHndSideData%PLinVelED) end if if (allocated(SrcRtHndSideData%PLinVelEI)) then LB(1:3) = lbound(SrcRtHndSideData%PLinVelEI) @@ -5157,8 +4941,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%PLinVelEI = SrcRtHndSideData%PLinVelEI - else if (allocated(DstRtHndSideData%PLinVelEI)) then - deallocate(DstRtHndSideData%PLinVelEI) end if if (allocated(SrcRtHndSideData%PLinVelEJ)) then LB(1:3) = lbound(SrcRtHndSideData%PLinVelEJ) @@ -5171,8 +4953,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%PLinVelEJ = SrcRtHndSideData%PLinVelEJ - else if (allocated(DstRtHndSideData%PLinVelEJ)) then - deallocate(DstRtHndSideData%PLinVelEJ) end if if (allocated(SrcRtHndSideData%PLinVelEP)) then LB(1:3) = lbound(SrcRtHndSideData%PLinVelEP) @@ -5185,8 +4965,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%PLinVelEP = SrcRtHndSideData%PLinVelEP - else if (allocated(DstRtHndSideData%PLinVelEP)) then - deallocate(DstRtHndSideData%PLinVelEP) end if if (allocated(SrcRtHndSideData%PLinVelEQ)) then LB(1:3) = lbound(SrcRtHndSideData%PLinVelEQ) @@ -5199,8 +4977,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%PLinVelEQ = SrcRtHndSideData%PLinVelEQ - else if (allocated(DstRtHndSideData%PLinVelEQ)) then - deallocate(DstRtHndSideData%PLinVelEQ) end if if (allocated(SrcRtHndSideData%PLinVelEU)) then LB(1:3) = lbound(SrcRtHndSideData%PLinVelEU) @@ -5213,8 +4989,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%PLinVelEU = SrcRtHndSideData%PLinVelEU - else if (allocated(DstRtHndSideData%PLinVelEU)) then - deallocate(DstRtHndSideData%PLinVelEU) end if if (allocated(SrcRtHndSideData%PLinVelEV)) then LB(1:3) = lbound(SrcRtHndSideData%PLinVelEV) @@ -5227,8 +5001,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%PLinVelEV = SrcRtHndSideData%PLinVelEV - else if (allocated(DstRtHndSideData%PLinVelEV)) then - deallocate(DstRtHndSideData%PLinVelEV) end if if (allocated(SrcRtHndSideData%PLinVelEW)) then LB(1:3) = lbound(SrcRtHndSideData%PLinVelEW) @@ -5241,8 +5013,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%PLinVelEW = SrcRtHndSideData%PLinVelEW - else if (allocated(DstRtHndSideData%PLinVelEW)) then - deallocate(DstRtHndSideData%PLinVelEW) end if if (allocated(SrcRtHndSideData%PLinVelEY)) then LB(1:3) = lbound(SrcRtHndSideData%PLinVelEY) @@ -5255,8 +5025,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%PLinVelEY = SrcRtHndSideData%PLinVelEY - else if (allocated(DstRtHndSideData%PLinVelEY)) then - deallocate(DstRtHndSideData%PLinVelEY) end if DstRtHndSideData%LinAccEIMUt = SrcRtHndSideData%LinAccEIMUt DstRtHndSideData%LinAccEOt = SrcRtHndSideData%LinAccEOt @@ -5271,8 +5039,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%LinAccESt = SrcRtHndSideData%LinAccESt - else if (allocated(DstRtHndSideData%LinAccESt)) then - deallocate(DstRtHndSideData%LinAccESt) end if if (allocated(SrcRtHndSideData%LinAccETt)) then LB(1:2) = lbound(SrcRtHndSideData%LinAccETt) @@ -5285,8 +5051,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%LinAccETt = SrcRtHndSideData%LinAccETt - else if (allocated(DstRtHndSideData%LinAccETt)) then - deallocate(DstRtHndSideData%LinAccETt) end if DstRtHndSideData%LinAccEZt = SrcRtHndSideData%LinAccEZt DstRtHndSideData%LinVelEIMU = SrcRtHndSideData%LinVelEIMU @@ -5306,8 +5070,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%FrcS0Bt = SrcRtHndSideData%FrcS0Bt - else if (allocated(DstRtHndSideData%FrcS0Bt)) then - deallocate(DstRtHndSideData%FrcS0Bt) end if DstRtHndSideData%FrcT0Trbt = SrcRtHndSideData%FrcT0Trbt if (allocated(SrcRtHndSideData%FSAero)) then @@ -5321,8 +5083,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%FSAero = SrcRtHndSideData%FSAero - else if (allocated(DstRtHndSideData%FSAero)) then - deallocate(DstRtHndSideData%FSAero) end if if (allocated(SrcRtHndSideData%FSTipDrag)) then LB(1:2) = lbound(SrcRtHndSideData%FSTipDrag) @@ -5335,8 +5095,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%FSTipDrag = SrcRtHndSideData%FSTipDrag - else if (allocated(DstRtHndSideData%FSTipDrag)) then - deallocate(DstRtHndSideData%FSTipDrag) end if if (allocated(SrcRtHndSideData%FTHydrot)) then LB(1:2) = lbound(SrcRtHndSideData%FTHydrot) @@ -5349,8 +5107,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%FTHydrot = SrcRtHndSideData%FTHydrot - else if (allocated(DstRtHndSideData%FTHydrot)) then - deallocate(DstRtHndSideData%FTHydrot) end if DstRtHndSideData%FZHydrot = SrcRtHndSideData%FZHydrot if (allocated(SrcRtHndSideData%MFHydrot)) then @@ -5364,8 +5120,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%MFHydrot = SrcRtHndSideData%MFHydrot - else if (allocated(DstRtHndSideData%MFHydrot)) then - deallocate(DstRtHndSideData%MFHydrot) end if DstRtHndSideData%MomBNcRtt = SrcRtHndSideData%MomBNcRtt if (allocated(SrcRtHndSideData%MomH0Bt)) then @@ -5379,8 +5133,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%MomH0Bt = SrcRtHndSideData%MomH0Bt - else if (allocated(DstRtHndSideData%MomH0Bt)) then - deallocate(DstRtHndSideData%MomH0Bt) end if DstRtHndSideData%MomLPRott = SrcRtHndSideData%MomLPRott DstRtHndSideData%MomNGnRtt = SrcRtHndSideData%MomNGnRtt @@ -5397,8 +5149,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%MMAero = SrcRtHndSideData%MMAero - else if (allocated(DstRtHndSideData%MMAero)) then - deallocate(DstRtHndSideData%MMAero) end if DstRtHndSideData%MXHydrot = SrcRtHndSideData%MXHydrot if (allocated(SrcRtHndSideData%PFrcONcRt)) then @@ -5412,8 +5162,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%PFrcONcRt = SrcRtHndSideData%PFrcONcRt - else if (allocated(DstRtHndSideData%PFrcONcRt)) then - deallocate(DstRtHndSideData%PFrcONcRt) end if if (allocated(SrcRtHndSideData%PFrcPRot)) then LB(1:2) = lbound(SrcRtHndSideData%PFrcPRot) @@ -5426,8 +5174,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%PFrcPRot = SrcRtHndSideData%PFrcPRot - else if (allocated(DstRtHndSideData%PFrcPRot)) then - deallocate(DstRtHndSideData%PFrcPRot) end if if (allocated(SrcRtHndSideData%PFrcS0B)) then LB(1:3) = lbound(SrcRtHndSideData%PFrcS0B) @@ -5440,8 +5186,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%PFrcS0B = SrcRtHndSideData%PFrcS0B - else if (allocated(DstRtHndSideData%PFrcS0B)) then - deallocate(DstRtHndSideData%PFrcS0B) end if if (allocated(SrcRtHndSideData%PFrcT0Trb)) then LB(1:2) = lbound(SrcRtHndSideData%PFrcT0Trb) @@ -5454,8 +5198,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%PFrcT0Trb = SrcRtHndSideData%PFrcT0Trb - else if (allocated(DstRtHndSideData%PFrcT0Trb)) then - deallocate(DstRtHndSideData%PFrcT0Trb) end if if (allocated(SrcRtHndSideData%PFTHydro)) then LB(1:3) = lbound(SrcRtHndSideData%PFTHydro) @@ -5468,8 +5210,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%PFTHydro = SrcRtHndSideData%PFTHydro - else if (allocated(DstRtHndSideData%PFTHydro)) then - deallocate(DstRtHndSideData%PFTHydro) end if DstRtHndSideData%PFZHydro = SrcRtHndSideData%PFZHydro if (allocated(SrcRtHndSideData%PMFHydro)) then @@ -5483,8 +5223,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%PMFHydro = SrcRtHndSideData%PMFHydro - else if (allocated(DstRtHndSideData%PMFHydro)) then - deallocate(DstRtHndSideData%PMFHydro) end if if (allocated(SrcRtHndSideData%PMomBNcRt)) then LB(1:2) = lbound(SrcRtHndSideData%PMomBNcRt) @@ -5497,8 +5235,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%PMomBNcRt = SrcRtHndSideData%PMomBNcRt - else if (allocated(DstRtHndSideData%PMomBNcRt)) then - deallocate(DstRtHndSideData%PMomBNcRt) end if if (allocated(SrcRtHndSideData%PMomH0B)) then LB(1:3) = lbound(SrcRtHndSideData%PMomH0B) @@ -5511,8 +5247,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%PMomH0B = SrcRtHndSideData%PMomH0B - else if (allocated(DstRtHndSideData%PMomH0B)) then - deallocate(DstRtHndSideData%PMomH0B) end if if (allocated(SrcRtHndSideData%PMomLPRot)) then LB(1:2) = lbound(SrcRtHndSideData%PMomLPRot) @@ -5525,8 +5259,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%PMomLPRot = SrcRtHndSideData%PMomLPRot - else if (allocated(DstRtHndSideData%PMomLPRot)) then - deallocate(DstRtHndSideData%PMomLPRot) end if if (allocated(SrcRtHndSideData%PMomNGnRt)) then LB(1:2) = lbound(SrcRtHndSideData%PMomNGnRt) @@ -5539,8 +5271,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%PMomNGnRt = SrcRtHndSideData%PMomNGnRt - else if (allocated(DstRtHndSideData%PMomNGnRt)) then - deallocate(DstRtHndSideData%PMomNGnRt) end if if (allocated(SrcRtHndSideData%PMomNTail)) then LB(1:2) = lbound(SrcRtHndSideData%PMomNTail) @@ -5553,8 +5283,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%PMomNTail = SrcRtHndSideData%PMomNTail - else if (allocated(DstRtHndSideData%PMomNTail)) then - deallocate(DstRtHndSideData%PMomNTail) end if if (allocated(SrcRtHndSideData%PMomX0Trb)) then LB(1:2) = lbound(SrcRtHndSideData%PMomX0Trb) @@ -5567,8 +5295,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%PMomX0Trb = SrcRtHndSideData%PMomX0Trb - else if (allocated(DstRtHndSideData%PMomX0Trb)) then - deallocate(DstRtHndSideData%PMomX0Trb) end if DstRtHndSideData%PMXHydro = SrcRtHndSideData%PMXHydro DstRtHndSideData%TeetAng = SrcRtHndSideData%TeetAng @@ -5587,8 +5313,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%PFrcVGnRt = SrcRtHndSideData%PFrcVGnRt - else if (allocated(DstRtHndSideData%PFrcVGnRt)) then - deallocate(DstRtHndSideData%PFrcVGnRt) end if if (allocated(SrcRtHndSideData%PFrcWTail)) then LB(1:2) = lbound(SrcRtHndSideData%PFrcWTail) @@ -5601,8 +5325,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%PFrcWTail = SrcRtHndSideData%PFrcWTail - else if (allocated(DstRtHndSideData%PFrcWTail)) then - deallocate(DstRtHndSideData%PFrcWTail) end if if (allocated(SrcRtHndSideData%PFrcZAll)) then LB(1:2) = lbound(SrcRtHndSideData%PFrcZAll) @@ -5615,8 +5337,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%PFrcZAll = SrcRtHndSideData%PFrcZAll - else if (allocated(DstRtHndSideData%PFrcZAll)) then - deallocate(DstRtHndSideData%PFrcZAll) end if if (allocated(SrcRtHndSideData%PMomXAll)) then LB(1:2) = lbound(SrcRtHndSideData%PMomXAll) @@ -5629,8 +5349,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%PMomXAll = SrcRtHndSideData%PMomXAll - else if (allocated(DstRtHndSideData%PMomXAll)) then - deallocate(DstRtHndSideData%PMomXAll) end if DstRtHndSideData%TeetMom = SrcRtHndSideData%TeetMom DstRtHndSideData%TFrlMom = SrcRtHndSideData%TFrlMom @@ -5647,8 +5365,6 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if end if DstRtHndSideData%rSAerCen = SrcRtHndSideData%rSAerCen - else if (allocated(DstRtHndSideData%rSAerCen)) then - deallocate(DstRtHndSideData%rSAerCen) end if end subroutine @@ -7441,8 +7157,6 @@ subroutine ED_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSta end if end if DstContStateData%QT = SrcContStateData%QT - else if (allocated(DstContStateData%QT)) then - deallocate(DstContStateData%QT) end if if (allocated(SrcContStateData%QDT)) then LB(1:1) = lbound(SrcContStateData%QDT) @@ -7455,8 +7169,6 @@ subroutine ED_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSta end if end if DstContStateData%QDT = SrcContStateData%QDT - else if (allocated(DstContStateData%QDT)) then - deallocate(DstContStateData%QDT) end if end subroutine @@ -7641,8 +7353,6 @@ subroutine ED_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err end if end if DstOtherStateData%IC = SrcOtherStateData%IC - else if (allocated(DstOtherStateData%IC)) then - deallocate(DstOtherStateData%IC) end if DstOtherStateData%HSSBrTrq = SrcOtherStateData%HSSBrTrq DstOtherStateData%HSSBrTrqC = SrcOtherStateData%HSSBrTrqC @@ -7766,8 +7476,6 @@ subroutine ED_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%AllOuts = SrcMiscData%AllOuts - else if (allocated(DstMiscData%AllOuts)) then - deallocate(DstMiscData%AllOuts) end if if (allocated(SrcMiscData%AugMat)) then LB(1:2) = lbound(SrcMiscData%AugMat) @@ -7780,8 +7488,6 @@ subroutine ED_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%AugMat = SrcMiscData%AugMat - else if (allocated(DstMiscData%AugMat)) then - deallocate(DstMiscData%AugMat) end if if (allocated(SrcMiscData%AugMat_factor)) then LB(1:2) = lbound(SrcMiscData%AugMat_factor) @@ -7794,8 +7500,6 @@ subroutine ED_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%AugMat_factor = SrcMiscData%AugMat_factor - else if (allocated(DstMiscData%AugMat_factor)) then - deallocate(DstMiscData%AugMat_factor) end if if (allocated(SrcMiscData%SolnVec)) then LB(1:1) = lbound(SrcMiscData%SolnVec) @@ -7808,8 +7512,6 @@ subroutine ED_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%SolnVec = SrcMiscData%SolnVec - else if (allocated(DstMiscData%SolnVec)) then - deallocate(DstMiscData%SolnVec) end if if (allocated(SrcMiscData%AugMat_pivot)) then LB(1:1) = lbound(SrcMiscData%AugMat_pivot) @@ -7822,8 +7524,6 @@ subroutine ED_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%AugMat_pivot = SrcMiscData%AugMat_pivot - else if (allocated(DstMiscData%AugMat_pivot)) then - deallocate(DstMiscData%AugMat_pivot) end if if (allocated(SrcMiscData%OgnlGeAzRo)) then LB(1:1) = lbound(SrcMiscData%OgnlGeAzRo) @@ -7836,8 +7536,6 @@ subroutine ED_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%OgnlGeAzRo = SrcMiscData%OgnlGeAzRo - else if (allocated(DstMiscData%OgnlGeAzRo)) then - deallocate(DstMiscData%OgnlGeAzRo) end if if (allocated(SrcMiscData%QD2T)) then LB(1:1) = lbound(SrcMiscData%QD2T) @@ -7850,8 +7548,6 @@ subroutine ED_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%QD2T = SrcMiscData%QD2T - else if (allocated(DstMiscData%QD2T)) then - deallocate(DstMiscData%QD2T) end if DstMiscData%IgnoreMod = SrcMiscData%IgnoreMod end subroutine @@ -8082,8 +7778,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%PH = SrcParamData%PH - else if (allocated(DstParamData%PH)) then - deallocate(DstParamData%PH) end if DstParamData%NPM = SrcParamData%NPM if (allocated(SrcParamData%PM)) then @@ -8097,8 +7791,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%PM = SrcParamData%PM - else if (allocated(DstParamData%PM)) then - deallocate(DstParamData%PM) end if if (allocated(SrcParamData%DOF_Flag)) then LB(1:1) = lbound(SrcParamData%DOF_Flag) @@ -8111,8 +7803,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%DOF_Flag = SrcParamData%DOF_Flag - else if (allocated(DstParamData%DOF_Flag)) then - deallocate(DstParamData%DOF_Flag) end if if (allocated(SrcParamData%DOF_Desc)) then LB(1:1) = lbound(SrcParamData%DOF_Desc) @@ -8125,8 +7815,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%DOF_Desc = SrcParamData%DOF_Desc - else if (allocated(DstParamData%DOF_Desc)) then - deallocate(DstParamData%DOF_Desc) end if call ED_CopyActiveDOFs(SrcParamData%DOFs, DstParamData%DOFs, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -8150,8 +7838,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstParamData%OutParam)) then - deallocate(DstParamData%OutParam) end if DstParamData%Delim = SrcParamData%Delim DstParamData%AvgNrmTpRd = SrcParamData%AvgNrmTpRd @@ -8168,8 +7854,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%CosPreC = SrcParamData%CosPreC - else if (allocated(DstParamData%CosPreC)) then - deallocate(DstParamData%CosPreC) end if DstParamData%CRFrlSkew = SrcParamData%CRFrlSkew DstParamData%CRFrlSkw2 = SrcParamData%CRFrlSkw2 @@ -8225,8 +7909,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%SinPreC = SrcParamData%SinPreC - else if (allocated(DstParamData%SinPreC)) then - deallocate(DstParamData%SinPreC) end if DstParamData%SRFrlSkew = SrcParamData%SRFrlSkew DstParamData%SRFrlSkw2 = SrcParamData%SRFrlSkw2 @@ -8255,8 +7937,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%AxRedTFA = SrcParamData%AxRedTFA - else if (allocated(DstParamData%AxRedTFA)) then - deallocate(DstParamData%AxRedTFA) end if if (allocated(SrcParamData%AxRedTSS)) then LB(1:3) = lbound(SrcParamData%AxRedTSS) @@ -8269,8 +7949,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%AxRedTSS = SrcParamData%AxRedTSS - else if (allocated(DstParamData%AxRedTSS)) then - deallocate(DstParamData%AxRedTSS) end if DstParamData%CTFA = SrcParamData%CTFA DstParamData%CTSS = SrcParamData%CTSS @@ -8285,8 +7963,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%DHNodes = SrcParamData%DHNodes - else if (allocated(DstParamData%DHNodes)) then - deallocate(DstParamData%DHNodes) end if if (allocated(SrcParamData%HNodes)) then LB(1:1) = lbound(SrcParamData%HNodes) @@ -8299,8 +7975,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%HNodes = SrcParamData%HNodes - else if (allocated(DstParamData%HNodes)) then - deallocate(DstParamData%HNodes) end if if (allocated(SrcParamData%HNodesNorm)) then LB(1:1) = lbound(SrcParamData%HNodesNorm) @@ -8313,8 +7987,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%HNodesNorm = SrcParamData%HNodesNorm - else if (allocated(DstParamData%HNodesNorm)) then - deallocate(DstParamData%HNodesNorm) end if DstParamData%KTFA = SrcParamData%KTFA DstParamData%KTSS = SrcParamData%KTSS @@ -8329,8 +8001,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%MassT = SrcParamData%MassT - else if (allocated(DstParamData%MassT)) then - deallocate(DstParamData%MassT) end if if (allocated(SrcParamData%StiffTSS)) then LB(1:1) = lbound(SrcParamData%StiffTSS) @@ -8343,8 +8013,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%StiffTSS = SrcParamData%StiffTSS - else if (allocated(DstParamData%StiffTSS)) then - deallocate(DstParamData%StiffTSS) end if if (allocated(SrcParamData%TwrFASF)) then LB(1:3) = lbound(SrcParamData%TwrFASF) @@ -8357,8 +8025,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%TwrFASF = SrcParamData%TwrFASF - else if (allocated(DstParamData%TwrFASF)) then - deallocate(DstParamData%TwrFASF) end if DstParamData%TwrFlexL = SrcParamData%TwrFlexL if (allocated(SrcParamData%TwrSSSF)) then @@ -8372,8 +8038,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%TwrSSSF = SrcParamData%TwrSSSF - else if (allocated(DstParamData%TwrSSSF)) then - deallocate(DstParamData%TwrSSSF) end if DstParamData%TTopNode = SrcParamData%TTopNode DstParamData%TwrNodes = SrcParamData%TwrNodes @@ -8389,8 +8053,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%StiffTFA = SrcParamData%StiffTFA - else if (allocated(DstParamData%StiffTFA)) then - deallocate(DstParamData%StiffTFA) end if DstParamData%AtfaIner = SrcParamData%AtfaIner if (allocated(SrcParamData%BldCG)) then @@ -8404,8 +8066,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%BldCG = SrcParamData%BldCG - else if (allocated(DstParamData%BldCG)) then - deallocate(DstParamData%BldCG) end if if (allocated(SrcParamData%BldMass)) then LB(1:1) = lbound(SrcParamData%BldMass) @@ -8418,8 +8078,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%BldMass = SrcParamData%BldMass - else if (allocated(DstParamData%BldMass)) then - deallocate(DstParamData%BldMass) end if DstParamData%BoomMass = SrcParamData%BoomMass if (allocated(SrcParamData%FirstMom)) then @@ -8433,8 +8091,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%FirstMom = SrcParamData%FirstMom - else if (allocated(DstParamData%FirstMom)) then - deallocate(DstParamData%FirstMom) end if DstParamData%GenIner = SrcParamData%GenIner DstParamData%Hubg1Iner = SrcParamData%Hubg1Iner @@ -8461,8 +8117,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%SecondMom = SrcParamData%SecondMom - else if (allocated(DstParamData%SecondMom)) then - deallocate(DstParamData%SecondMom) end if DstParamData%TFinMass = SrcParamData%TFinMass DstParamData%TFrlIner = SrcParamData%TFrlIner @@ -8477,8 +8131,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%TipMass = SrcParamData%TipMass - else if (allocated(DstParamData%TipMass)) then - deallocate(DstParamData%TipMass) end if DstParamData%TurbMass = SrcParamData%TurbMass DstParamData%TwrMass = SrcParamData%TwrMass @@ -8496,8 +8148,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%PitchAxis = SrcParamData%PitchAxis - else if (allocated(DstParamData%PitchAxis)) then - deallocate(DstParamData%PitchAxis) end if if (allocated(SrcParamData%AeroTwst)) then LB(1:1) = lbound(SrcParamData%AeroTwst) @@ -8510,8 +8160,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%AeroTwst = SrcParamData%AeroTwst - else if (allocated(DstParamData%AeroTwst)) then - deallocate(DstParamData%AeroTwst) end if if (allocated(SrcParamData%AxRedBld)) then LB(1:4) = lbound(SrcParamData%AxRedBld) @@ -8524,8 +8172,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%AxRedBld = SrcParamData%AxRedBld - else if (allocated(DstParamData%AxRedBld)) then - deallocate(DstParamData%AxRedBld) end if if (allocated(SrcParamData%BldEDamp)) then LB(1:2) = lbound(SrcParamData%BldEDamp) @@ -8538,8 +8184,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%BldEDamp = SrcParamData%BldEDamp - else if (allocated(DstParamData%BldEDamp)) then - deallocate(DstParamData%BldEDamp) end if if (allocated(SrcParamData%BldFDamp)) then LB(1:2) = lbound(SrcParamData%BldFDamp) @@ -8552,8 +8196,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%BldFDamp = SrcParamData%BldFDamp - else if (allocated(DstParamData%BldFDamp)) then - deallocate(DstParamData%BldFDamp) end if DstParamData%BldFlexL = SrcParamData%BldFlexL if (allocated(SrcParamData%CAeroTwst)) then @@ -8567,8 +8209,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%CAeroTwst = SrcParamData%CAeroTwst - else if (allocated(DstParamData%CAeroTwst)) then - deallocate(DstParamData%CAeroTwst) end if if (allocated(SrcParamData%CBE)) then LB(1:3) = lbound(SrcParamData%CBE) @@ -8581,8 +8221,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%CBE = SrcParamData%CBE - else if (allocated(DstParamData%CBE)) then - deallocate(DstParamData%CBE) end if if (allocated(SrcParamData%CBF)) then LB(1:3) = lbound(SrcParamData%CBF) @@ -8595,8 +8233,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%CBF = SrcParamData%CBF - else if (allocated(DstParamData%CBF)) then - deallocate(DstParamData%CBF) end if if (allocated(SrcParamData%Chord)) then LB(1:1) = lbound(SrcParamData%Chord) @@ -8609,8 +8245,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%Chord = SrcParamData%Chord - else if (allocated(DstParamData%Chord)) then - deallocate(DstParamData%Chord) end if if (allocated(SrcParamData%CThetaS)) then LB(1:2) = lbound(SrcParamData%CThetaS) @@ -8623,8 +8257,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%CThetaS = SrcParamData%CThetaS - else if (allocated(DstParamData%CThetaS)) then - deallocate(DstParamData%CThetaS) end if if (allocated(SrcParamData%DRNodes)) then LB(1:1) = lbound(SrcParamData%DRNodes) @@ -8637,8 +8269,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%DRNodes = SrcParamData%DRNodes - else if (allocated(DstParamData%DRNodes)) then - deallocate(DstParamData%DRNodes) end if if (allocated(SrcParamData%FStTunr)) then LB(1:2) = lbound(SrcParamData%FStTunr) @@ -8651,8 +8281,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%FStTunr = SrcParamData%FStTunr - else if (allocated(DstParamData%FStTunr)) then - deallocate(DstParamData%FStTunr) end if if (allocated(SrcParamData%KBE)) then LB(1:3) = lbound(SrcParamData%KBE) @@ -8665,8 +8293,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%KBE = SrcParamData%KBE - else if (allocated(DstParamData%KBE)) then - deallocate(DstParamData%KBE) end if if (allocated(SrcParamData%KBF)) then LB(1:3) = lbound(SrcParamData%KBF) @@ -8679,8 +8305,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%KBF = SrcParamData%KBF - else if (allocated(DstParamData%KBF)) then - deallocate(DstParamData%KBF) end if if (allocated(SrcParamData%MassB)) then LB(1:2) = lbound(SrcParamData%MassB) @@ -8693,8 +8317,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%MassB = SrcParamData%MassB - else if (allocated(DstParamData%MassB)) then - deallocate(DstParamData%MassB) end if if (allocated(SrcParamData%RNodes)) then LB(1:1) = lbound(SrcParamData%RNodes) @@ -8707,8 +8329,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%RNodes = SrcParamData%RNodes - else if (allocated(DstParamData%RNodes)) then - deallocate(DstParamData%RNodes) end if if (allocated(SrcParamData%RNodesNorm)) then LB(1:1) = lbound(SrcParamData%RNodesNorm) @@ -8721,8 +8341,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%RNodesNorm = SrcParamData%RNodesNorm - else if (allocated(DstParamData%RNodesNorm)) then - deallocate(DstParamData%RNodesNorm) end if if (allocated(SrcParamData%rSAerCenn1)) then LB(1:2) = lbound(SrcParamData%rSAerCenn1) @@ -8735,8 +8353,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%rSAerCenn1 = SrcParamData%rSAerCenn1 - else if (allocated(DstParamData%rSAerCenn1)) then - deallocate(DstParamData%rSAerCenn1) end if if (allocated(SrcParamData%rSAerCenn2)) then LB(1:2) = lbound(SrcParamData%rSAerCenn2) @@ -8749,8 +8365,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%rSAerCenn2 = SrcParamData%rSAerCenn2 - else if (allocated(DstParamData%rSAerCenn2)) then - deallocate(DstParamData%rSAerCenn2) end if if (allocated(SrcParamData%SAeroTwst)) then LB(1:1) = lbound(SrcParamData%SAeroTwst) @@ -8763,8 +8377,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%SAeroTwst = SrcParamData%SAeroTwst - else if (allocated(DstParamData%SAeroTwst)) then - deallocate(DstParamData%SAeroTwst) end if if (allocated(SrcParamData%StiffBE)) then LB(1:2) = lbound(SrcParamData%StiffBE) @@ -8777,8 +8389,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%StiffBE = SrcParamData%StiffBE - else if (allocated(DstParamData%StiffBE)) then - deallocate(DstParamData%StiffBE) end if if (allocated(SrcParamData%StiffBF)) then LB(1:2) = lbound(SrcParamData%StiffBF) @@ -8791,8 +8401,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%StiffBF = SrcParamData%StiffBF - else if (allocated(DstParamData%StiffBF)) then - deallocate(DstParamData%StiffBF) end if if (allocated(SrcParamData%SThetaS)) then LB(1:2) = lbound(SrcParamData%SThetaS) @@ -8805,8 +8413,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%SThetaS = SrcParamData%SThetaS - else if (allocated(DstParamData%SThetaS)) then - deallocate(DstParamData%SThetaS) end if if (allocated(SrcParamData%ThetaS)) then LB(1:2) = lbound(SrcParamData%ThetaS) @@ -8819,8 +8425,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%ThetaS = SrcParamData%ThetaS - else if (allocated(DstParamData%ThetaS)) then - deallocate(DstParamData%ThetaS) end if if (allocated(SrcParamData%TwistedSF)) then LB(1:5) = lbound(SrcParamData%TwistedSF) @@ -8833,8 +8437,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%TwistedSF = SrcParamData%TwistedSF - else if (allocated(DstParamData%TwistedSF)) then - deallocate(DstParamData%TwistedSF) end if if (allocated(SrcParamData%BldFl1Sh)) then LB(1:2) = lbound(SrcParamData%BldFl1Sh) @@ -8847,8 +8449,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%BldFl1Sh = SrcParamData%BldFl1Sh - else if (allocated(DstParamData%BldFl1Sh)) then - deallocate(DstParamData%BldFl1Sh) end if if (allocated(SrcParamData%BldFl2Sh)) then LB(1:2) = lbound(SrcParamData%BldFl2Sh) @@ -8861,8 +8461,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%BldFl2Sh = SrcParamData%BldFl2Sh - else if (allocated(DstParamData%BldFl2Sh)) then - deallocate(DstParamData%BldFl2Sh) end if if (allocated(SrcParamData%BldEdgSh)) then LB(1:2) = lbound(SrcParamData%BldEdgSh) @@ -8875,8 +8473,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%BldEdgSh = SrcParamData%BldEdgSh - else if (allocated(DstParamData%BldEdgSh)) then - deallocate(DstParamData%BldEdgSh) end if if (allocated(SrcParamData%FreqBE)) then LB(1:3) = lbound(SrcParamData%FreqBE) @@ -8889,8 +8485,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%FreqBE = SrcParamData%FreqBE - else if (allocated(DstParamData%FreqBE)) then - deallocate(DstParamData%FreqBE) end if if (allocated(SrcParamData%FreqBF)) then LB(1:3) = lbound(SrcParamData%FreqBF) @@ -8903,8 +8497,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%FreqBF = SrcParamData%FreqBF - else if (allocated(DstParamData%FreqBF)) then - deallocate(DstParamData%FreqBF) end if DstParamData%FreqTFA = SrcParamData%FreqTFA DstParamData%FreqTSS = SrcParamData%FreqTSS @@ -8959,8 +8551,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%BElmntMass = SrcParamData%BElmntMass - else if (allocated(DstParamData%BElmntMass)) then - deallocate(DstParamData%BElmntMass) end if if (allocated(SrcParamData%TElmntMass)) then LB(1:1) = lbound(SrcParamData%TElmntMass) @@ -8973,8 +8563,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%TElmntMass = SrcParamData%TElmntMass - else if (allocated(DstParamData%TElmntMass)) then - deallocate(DstParamData%TElmntMass) end if DstParamData%method = SrcParamData%method DstParamData%PtfmCMxt = SrcParamData%PtfmCMxt @@ -8998,8 +8586,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstParamData%BldNd_OutParam)) then - deallocate(DstParamData%BldNd_OutParam) end if DstParamData%BldNd_BladesOut = SrcParamData%BldNd_BladesOut if (allocated(SrcParamData%Jac_u_indx)) then @@ -9013,8 +8599,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx - else if (allocated(DstParamData%Jac_u_indx)) then - deallocate(DstParamData%Jac_u_indx) end if if (allocated(SrcParamData%du)) then LB(1:1) = lbound(SrcParamData%du) @@ -9027,8 +8611,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%du = SrcParamData%du - else if (allocated(DstParamData%du)) then - deallocate(DstParamData%du) end if if (allocated(SrcParamData%dx)) then LB(1:1) = lbound(SrcParamData%dx) @@ -9041,8 +8623,6 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%dx = SrcParamData%dx - else if (allocated(DstParamData%dx)) then - deallocate(DstParamData%dx) end if DstParamData%Jac_ny = SrcParamData%Jac_ny end subroutine @@ -10888,8 +10468,6 @@ subroutine ED_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstInputData%BladePtLoads)) then - deallocate(DstInputData%BladePtLoads) end if call MeshCopy(SrcInputData%PlatformPtMesh, DstInputData%PlatformPtMesh, CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -10917,8 +10495,6 @@ subroutine ED_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%TwrAddedMass = SrcInputData%TwrAddedMass - else if (allocated(DstInputData%TwrAddedMass)) then - deallocate(DstInputData%TwrAddedMass) end if DstInputData%PtfmAddedMass = SrcInputData%PtfmAddedMass if (allocated(SrcInputData%BlPitchCom)) then @@ -10932,8 +10508,6 @@ subroutine ED_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%BlPitchCom = SrcInputData%BlPitchCom - else if (allocated(DstInputData%BlPitchCom)) then - deallocate(DstInputData%BlPitchCom) end if DstInputData%YawMom = SrcInputData%YawMom DstInputData%GenTrq = SrcInputData%GenTrq @@ -11111,8 +10685,6 @@ subroutine ED_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstOutputData%BladeLn2Mesh)) then - deallocate(DstOutputData%BladeLn2Mesh) end if call MeshCopy(SrcOutputData%PlatformPtMesh, DstOutputData%PlatformPtMesh, CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -11144,8 +10716,6 @@ subroutine ED_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstOutputData%BladeRootMotion)) then - deallocate(DstOutputData%BladeRootMotion) end if call MeshCopy(SrcOutputData%RotorFurlMotion14, DstOutputData%RotorFurlMotion14, CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -11170,8 +10740,6 @@ subroutine ED_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg end if end if DstOutputData%WriteOutput = SrcOutputData%WriteOutput - else if (allocated(DstOutputData%WriteOutput)) then - deallocate(DstOutputData%WriteOutput) end if if (allocated(SrcOutputData%BlPitch)) then LB(1:1) = lbound(SrcOutputData%BlPitch) @@ -11184,8 +10752,6 @@ subroutine ED_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg end if end if DstOutputData%BlPitch = SrcOutputData%BlPitch - else if (allocated(DstOutputData%BlPitch)) then - deallocate(DstOutputData%BlPitch) end if DstOutputData%Yaw = SrcOutputData%Yaw DstOutputData%YawRate = SrcOutputData%YawRate diff --git a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 index 76aff6b65c..e6f1f705a6 100644 --- a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 +++ b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 @@ -235,8 +235,6 @@ subroutine ExtPtfm_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, E end if end if DstInputFileData%ActiveCBDOF = SrcInputFileData%ActiveCBDOF - else if (allocated(DstInputFileData%ActiveCBDOF)) then - deallocate(DstInputFileData%ActiveCBDOF) end if if (allocated(SrcInputFileData%InitPosList)) then LB(1:1) = lbound(SrcInputFileData%InitPosList) @@ -249,8 +247,6 @@ subroutine ExtPtfm_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, E end if end if DstInputFileData%InitPosList = SrcInputFileData%InitPosList - else if (allocated(DstInputFileData%InitPosList)) then - deallocate(DstInputFileData%InitPosList) end if if (allocated(SrcInputFileData%InitVelList)) then LB(1:1) = lbound(SrcInputFileData%InitVelList) @@ -263,8 +259,6 @@ subroutine ExtPtfm_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, E end if end if DstInputFileData%InitVelList = SrcInputFileData%InitVelList - else if (allocated(DstInputFileData%InitVelList)) then - deallocate(DstInputFileData%InitVelList) end if DstInputFileData%SumPrint = SrcInputFileData%SumPrint DstInputFileData%OutFile = SrcInputFileData%OutFile @@ -283,8 +277,6 @@ subroutine ExtPtfm_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, E end if end if DstInputFileData%OutList = SrcInputFileData%OutList - else if (allocated(DstInputFileData%OutList)) then - deallocate(DstInputFileData%OutList) end if end subroutine @@ -465,8 +457,6 @@ subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode end if end if DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr - else if (allocated(DstInitOutputData%WriteOutputHdr)) then - deallocate(DstInitOutputData%WriteOutputHdr) end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) @@ -479,8 +469,6 @@ subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode end if end if DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt - else if (allocated(DstInitOutputData%WriteOutputUnt)) then - deallocate(DstInitOutputData%WriteOutputUnt) end if if (allocated(SrcInitOutputData%LinNames_y)) then LB(1:1) = lbound(SrcInitOutputData%LinNames_y) @@ -493,8 +481,6 @@ subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode end if end if DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y - else if (allocated(DstInitOutputData%LinNames_y)) then - deallocate(DstInitOutputData%LinNames_y) end if if (allocated(SrcInitOutputData%LinNames_x)) then LB(1:1) = lbound(SrcInitOutputData%LinNames_x) @@ -507,8 +493,6 @@ subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode end if end if DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x - else if (allocated(DstInitOutputData%LinNames_x)) then - deallocate(DstInitOutputData%LinNames_x) end if if (allocated(SrcInitOutputData%LinNames_u)) then LB(1:1) = lbound(SrcInitOutputData%LinNames_u) @@ -521,8 +505,6 @@ subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode end if end if DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u - else if (allocated(DstInitOutputData%LinNames_u)) then - deallocate(DstInitOutputData%LinNames_u) end if if (allocated(SrcInitOutputData%RotFrame_y)) then LB(1:1) = lbound(SrcInitOutputData%RotFrame_y) @@ -535,8 +517,6 @@ subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode end if end if DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y - else if (allocated(DstInitOutputData%RotFrame_y)) then - deallocate(DstInitOutputData%RotFrame_y) end if if (allocated(SrcInitOutputData%RotFrame_x)) then LB(1:1) = lbound(SrcInitOutputData%RotFrame_x) @@ -549,8 +529,6 @@ subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode end if end if DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x - else if (allocated(DstInitOutputData%RotFrame_x)) then - deallocate(DstInitOutputData%RotFrame_x) end if if (allocated(SrcInitOutputData%RotFrame_u)) then LB(1:1) = lbound(SrcInitOutputData%RotFrame_u) @@ -563,8 +541,6 @@ subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode end if end if DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u - else if (allocated(DstInitOutputData%RotFrame_u)) then - deallocate(DstInitOutputData%RotFrame_u) end if if (allocated(SrcInitOutputData%IsLoad_u)) then LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) @@ -577,8 +553,6 @@ subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode end if end if DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u - else if (allocated(DstInitOutputData%IsLoad_u)) then - deallocate(DstInitOutputData%IsLoad_u) end if if (allocated(SrcInitOutputData%DerivOrder_x)) then LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) @@ -591,8 +565,6 @@ subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode end if end if DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x - else if (allocated(DstInitOutputData%DerivOrder_x)) then - deallocate(DstInitOutputData%DerivOrder_x) end if end subroutine @@ -871,8 +843,6 @@ subroutine ExtPtfm_CopyContState(SrcContStateData, DstContStateData, CtrlCode, E end if end if DstContStateData%qm = SrcContStateData%qm - else if (allocated(DstContStateData%qm)) then - deallocate(DstContStateData%qm) end if if (allocated(SrcContStateData%qmdot)) then LB(1:1) = lbound(SrcContStateData%qmdot) @@ -885,8 +855,6 @@ subroutine ExtPtfm_CopyContState(SrcContStateData, DstContStateData, CtrlCode, E end if end if DstContStateData%qmdot = SrcContStateData%qmdot - else if (allocated(DstContStateData%qmdot)) then - deallocate(DstContStateData%qmdot) end if end subroutine @@ -1067,8 +1035,6 @@ subroutine ExtPtfm_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstOtherStateData%xdot)) then - deallocate(DstOtherStateData%xdot) end if DstOtherStateData%n = SrcOtherStateData%n end subroutine @@ -1165,8 +1131,6 @@ subroutine ExtPtfm_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%xFlat = SrcMiscData%xFlat - else if (allocated(DstMiscData%xFlat)) then - deallocate(DstMiscData%xFlat) end if DstMiscData%uFlat = SrcMiscData%uFlat if (allocated(SrcMiscData%F_at_t)) then @@ -1180,8 +1144,6 @@ subroutine ExtPtfm_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%F_at_t = SrcMiscData%F_at_t - else if (allocated(DstMiscData%F_at_t)) then - deallocate(DstMiscData%F_at_t) end if DstMiscData%Indx = SrcMiscData%Indx DstMiscData%EquilStart = SrcMiscData%EquilStart @@ -1196,8 +1158,6 @@ subroutine ExtPtfm_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%AllOuts = SrcMiscData%AllOuts - else if (allocated(DstMiscData%AllOuts)) then - deallocate(DstMiscData%AllOuts) end if end subroutine @@ -1327,8 +1287,6 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end if end if DstParamData%Mass = SrcParamData%Mass - else if (allocated(DstParamData%Mass)) then - deallocate(DstParamData%Mass) end if if (allocated(SrcParamData%Damp)) then LB(1:2) = lbound(SrcParamData%Damp) @@ -1341,8 +1299,6 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end if end if DstParamData%Damp = SrcParamData%Damp - else if (allocated(DstParamData%Damp)) then - deallocate(DstParamData%Damp) end if if (allocated(SrcParamData%Stff)) then LB(1:2) = lbound(SrcParamData%Stff) @@ -1355,8 +1311,6 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end if end if DstParamData%Stff = SrcParamData%Stff - else if (allocated(DstParamData%Stff)) then - deallocate(DstParamData%Stff) end if if (allocated(SrcParamData%Forces)) then LB(1:2) = lbound(SrcParamData%Forces) @@ -1369,8 +1323,6 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end if end if DstParamData%Forces = SrcParamData%Forces - else if (allocated(DstParamData%Forces)) then - deallocate(DstParamData%Forces) end if if (allocated(SrcParamData%times)) then LB(1:1) = lbound(SrcParamData%times) @@ -1383,8 +1335,6 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end if end if DstParamData%times = SrcParamData%times - else if (allocated(DstParamData%times)) then - deallocate(DstParamData%times) end if if (allocated(SrcParamData%AMat)) then LB(1:2) = lbound(SrcParamData%AMat) @@ -1397,8 +1347,6 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end if end if DstParamData%AMat = SrcParamData%AMat - else if (allocated(DstParamData%AMat)) then - deallocate(DstParamData%AMat) end if if (allocated(SrcParamData%BMat)) then LB(1:2) = lbound(SrcParamData%BMat) @@ -1411,8 +1359,6 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end if end if DstParamData%BMat = SrcParamData%BMat - else if (allocated(DstParamData%BMat)) then - deallocate(DstParamData%BMat) end if if (allocated(SrcParamData%CMat)) then LB(1:2) = lbound(SrcParamData%CMat) @@ -1425,8 +1371,6 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end if end if DstParamData%CMat = SrcParamData%CMat - else if (allocated(DstParamData%CMat)) then - deallocate(DstParamData%CMat) end if if (allocated(SrcParamData%DMat)) then LB(1:2) = lbound(SrcParamData%DMat) @@ -1439,8 +1383,6 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end if end if DstParamData%DMat = SrcParamData%DMat - else if (allocated(DstParamData%DMat)) then - deallocate(DstParamData%DMat) end if if (allocated(SrcParamData%FX)) then LB(1:1) = lbound(SrcParamData%FX) @@ -1453,8 +1395,6 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end if end if DstParamData%FX = SrcParamData%FX - else if (allocated(DstParamData%FX)) then - deallocate(DstParamData%FX) end if if (allocated(SrcParamData%FY)) then LB(1:1) = lbound(SrcParamData%FY) @@ -1467,8 +1407,6 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end if end if DstParamData%FY = SrcParamData%FY - else if (allocated(DstParamData%FY)) then - deallocate(DstParamData%FY) end if if (allocated(SrcParamData%M11)) then LB(1:2) = lbound(SrcParamData%M11) @@ -1481,8 +1419,6 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end if end if DstParamData%M11 = SrcParamData%M11 - else if (allocated(DstParamData%M11)) then - deallocate(DstParamData%M11) end if if (allocated(SrcParamData%M12)) then LB(1:2) = lbound(SrcParamData%M12) @@ -1495,8 +1431,6 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end if end if DstParamData%M12 = SrcParamData%M12 - else if (allocated(DstParamData%M12)) then - deallocate(DstParamData%M12) end if if (allocated(SrcParamData%M22)) then LB(1:2) = lbound(SrcParamData%M22) @@ -1509,8 +1443,6 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end if end if DstParamData%M22 = SrcParamData%M22 - else if (allocated(DstParamData%M22)) then - deallocate(DstParamData%M22) end if if (allocated(SrcParamData%M21)) then LB(1:2) = lbound(SrcParamData%M21) @@ -1523,8 +1455,6 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end if end if DstParamData%M21 = SrcParamData%M21 - else if (allocated(DstParamData%M21)) then - deallocate(DstParamData%M21) end if if (allocated(SrcParamData%K11)) then LB(1:2) = lbound(SrcParamData%K11) @@ -1537,8 +1467,6 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end if end if DstParamData%K11 = SrcParamData%K11 - else if (allocated(DstParamData%K11)) then - deallocate(DstParamData%K11) end if if (allocated(SrcParamData%K22)) then LB(1:2) = lbound(SrcParamData%K22) @@ -1551,8 +1479,6 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end if end if DstParamData%K22 = SrcParamData%K22 - else if (allocated(DstParamData%K22)) then - deallocate(DstParamData%K22) end if if (allocated(SrcParamData%C11)) then LB(1:2) = lbound(SrcParamData%C11) @@ -1565,8 +1491,6 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end if end if DstParamData%C11 = SrcParamData%C11 - else if (allocated(DstParamData%C11)) then - deallocate(DstParamData%C11) end if if (allocated(SrcParamData%C12)) then LB(1:2) = lbound(SrcParamData%C12) @@ -1579,8 +1503,6 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end if end if DstParamData%C12 = SrcParamData%C12 - else if (allocated(DstParamData%C12)) then - deallocate(DstParamData%C12) end if if (allocated(SrcParamData%C22)) then LB(1:2) = lbound(SrcParamData%C22) @@ -1593,8 +1515,6 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end if end if DstParamData%C22 = SrcParamData%C22 - else if (allocated(DstParamData%C22)) then - deallocate(DstParamData%C22) end if if (allocated(SrcParamData%C21)) then LB(1:2) = lbound(SrcParamData%C21) @@ -1607,8 +1527,6 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end if end if DstParamData%C21 = SrcParamData%C21 - else if (allocated(DstParamData%C21)) then - deallocate(DstParamData%C21) end if DstParamData%EP_DeltaT = SrcParamData%EP_DeltaT DstParamData%nTimeSteps = SrcParamData%nTimeSteps @@ -1628,8 +1546,6 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end if end if DstParamData%ActiveCBDOF = SrcParamData%ActiveCBDOF - else if (allocated(DstParamData%ActiveCBDOF)) then - deallocate(DstParamData%ActiveCBDOF) end if if (allocated(SrcParamData%OutParam)) then LB(1:1) = lbound(SrcParamData%OutParam) @@ -1646,8 +1562,6 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstParamData%OutParam)) then - deallocate(DstParamData%OutParam) end if if (allocated(SrcParamData%OutParamLinIndx)) then LB(1:2) = lbound(SrcParamData%OutParamLinIndx) @@ -1660,8 +1574,6 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end if end if DstParamData%OutParamLinIndx = SrcParamData%OutParamLinIndx - else if (allocated(DstParamData%OutParamLinIndx)) then - deallocate(DstParamData%OutParamLinIndx) end if end subroutine @@ -2331,8 +2243,6 @@ subroutine ExtPtfm_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, E end if end if DstOutputData%WriteOutput = SrcOutputData%WriteOutput - else if (allocated(DstOutputData%WriteOutput)) then - deallocate(DstOutputData%WriteOutput) end if end subroutine diff --git a/modules/feamooring/src/FEAMooring_Types.f90 b/modules/feamooring/src/FEAMooring_Types.f90 index 461ba0382c..bc963debe8 100644 --- a/modules/feamooring/src/FEAMooring_Types.f90 +++ b/modules/feamooring/src/FEAMooring_Types.f90 @@ -248,8 +248,6 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS end if end if DstInputFileData%LineCI = SrcInputFileData%LineCI - else if (allocated(DstInputFileData%LineCI)) then - deallocate(DstInputFileData%LineCI) end if if (allocated(SrcInputFileData%LineCD)) then LB(1:1) = lbound(SrcInputFileData%LineCD) @@ -262,8 +260,6 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS end if end if DstInputFileData%LineCD = SrcInputFileData%LineCD - else if (allocated(DstInputFileData%LineCD)) then - deallocate(DstInputFileData%LineCD) end if if (allocated(SrcInputFileData%LEAStiff)) then LB(1:1) = lbound(SrcInputFileData%LEAStiff) @@ -276,8 +272,6 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS end if end if DstInputFileData%LEAStiff = SrcInputFileData%LEAStiff - else if (allocated(DstInputFileData%LEAStiff)) then - deallocate(DstInputFileData%LEAStiff) end if if (allocated(SrcInputFileData%LMassDen)) then LB(1:1) = lbound(SrcInputFileData%LMassDen) @@ -290,8 +284,6 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS end if end if DstInputFileData%LMassDen = SrcInputFileData%LMassDen - else if (allocated(DstInputFileData%LMassDen)) then - deallocate(DstInputFileData%LMassDen) end if if (allocated(SrcInputFileData%LDMassDen)) then LB(1:1) = lbound(SrcInputFileData%LDMassDen) @@ -304,8 +296,6 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS end if end if DstInputFileData%LDMassDen = SrcInputFileData%LDMassDen - else if (allocated(DstInputFileData%LDMassDen)) then - deallocate(DstInputFileData%LDMassDen) end if if (allocated(SrcInputFileData%BottmStiff)) then LB(1:1) = lbound(SrcInputFileData%BottmStiff) @@ -318,8 +308,6 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS end if end if DstInputFileData%BottmStiff = SrcInputFileData%BottmStiff - else if (allocated(DstInputFileData%BottmStiff)) then - deallocate(DstInputFileData%BottmStiff) end if if (allocated(SrcInputFileData%LRadAnch)) then LB(1:1) = lbound(SrcInputFileData%LRadAnch) @@ -332,8 +320,6 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS end if end if DstInputFileData%LRadAnch = SrcInputFileData%LRadAnch - else if (allocated(DstInputFileData%LRadAnch)) then - deallocate(DstInputFileData%LRadAnch) end if if (allocated(SrcInputFileData%LAngAnch)) then LB(1:1) = lbound(SrcInputFileData%LAngAnch) @@ -346,8 +332,6 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS end if end if DstInputFileData%LAngAnch = SrcInputFileData%LAngAnch - else if (allocated(DstInputFileData%LAngAnch)) then - deallocate(DstInputFileData%LAngAnch) end if if (allocated(SrcInputFileData%LDpthAnch)) then LB(1:1) = lbound(SrcInputFileData%LDpthAnch) @@ -360,8 +344,6 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS end if end if DstInputFileData%LDpthAnch = SrcInputFileData%LDpthAnch - else if (allocated(DstInputFileData%LDpthAnch)) then - deallocate(DstInputFileData%LDpthAnch) end if if (allocated(SrcInputFileData%LRadFair)) then LB(1:1) = lbound(SrcInputFileData%LRadFair) @@ -374,8 +356,6 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS end if end if DstInputFileData%LRadFair = SrcInputFileData%LRadFair - else if (allocated(DstInputFileData%LRadFair)) then - deallocate(DstInputFileData%LRadFair) end if if (allocated(SrcInputFileData%LAngFair)) then LB(1:1) = lbound(SrcInputFileData%LAngFair) @@ -388,8 +368,6 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS end if end if DstInputFileData%LAngFair = SrcInputFileData%LAngFair - else if (allocated(DstInputFileData%LAngFair)) then - deallocate(DstInputFileData%LAngFair) end if if (allocated(SrcInputFileData%LDrftFair)) then LB(1:1) = lbound(SrcInputFileData%LDrftFair) @@ -402,8 +380,6 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS end if end if DstInputFileData%LDrftFair = SrcInputFileData%LDrftFair - else if (allocated(DstInputFileData%LDrftFair)) then - deallocate(DstInputFileData%LDrftFair) end if if (allocated(SrcInputFileData%LUnstrLen)) then LB(1:1) = lbound(SrcInputFileData%LUnstrLen) @@ -416,8 +392,6 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS end if end if DstInputFileData%LUnstrLen = SrcInputFileData%LUnstrLen - else if (allocated(DstInputFileData%LUnstrLen)) then - deallocate(DstInputFileData%LUnstrLen) end if if (allocated(SrcInputFileData%Tension)) then LB(1:1) = lbound(SrcInputFileData%Tension) @@ -430,8 +404,6 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS end if end if DstInputFileData%Tension = SrcInputFileData%Tension - else if (allocated(DstInputFileData%Tension)) then - deallocate(DstInputFileData%Tension) end if if (allocated(SrcInputFileData%GSL)) then LB(1:3) = lbound(SrcInputFileData%GSL) @@ -444,8 +416,6 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS end if end if DstInputFileData%GSL = SrcInputFileData%GSL - else if (allocated(DstInputFileData%GSL)) then - deallocate(DstInputFileData%GSL) end if if (allocated(SrcInputFileData%GSR)) then LB(1:2) = lbound(SrcInputFileData%GSR) @@ -458,8 +428,6 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS end if end if DstInputFileData%GSR = SrcInputFileData%GSR - else if (allocated(DstInputFileData%GSR)) then - deallocate(DstInputFileData%GSR) end if if (allocated(SrcInputFileData%GE)) then LB(1:3) = lbound(SrcInputFileData%GE) @@ -472,8 +440,6 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS end if end if DstInputFileData%GE = SrcInputFileData%GE - else if (allocated(DstInputFileData%GE)) then - deallocate(DstInputFileData%GE) end if DstInputFileData%NumLines = SrcInputFileData%NumLines DstInputFileData%NumElems = SrcInputFileData%NumElems @@ -498,8 +464,6 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS end if end if DstInputFileData%OutList = SrcInputFileData%OutList - else if (allocated(DstInputFileData%OutList)) then - deallocate(DstInputFileData%OutList) end if end subroutine @@ -991,8 +955,6 @@ subroutine FEAM_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS end if end if DstInitInputData%WaveAcc0 = SrcInitInputData%WaveAcc0 - else if (allocated(DstInitInputData%WaveAcc0)) then - deallocate(DstInitInputData%WaveAcc0) end if if (allocated(SrcInitInputData%WaveTime)) then LB(1:1) = lbound(SrcInitInputData%WaveTime) @@ -1005,8 +967,6 @@ subroutine FEAM_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS end if end if DstInitInputData%WaveTime = SrcInitInputData%WaveTime - else if (allocated(DstInitInputData%WaveTime)) then - deallocate(DstInitInputData%WaveTime) end if if (allocated(SrcInitInputData%WaveVel0)) then LB(1:3) = lbound(SrcInitInputData%WaveVel0) @@ -1019,8 +979,6 @@ subroutine FEAM_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS end if end if DstInitInputData%WaveVel0 = SrcInitInputData%WaveVel0 - else if (allocated(DstInitInputData%WaveVel0)) then - deallocate(DstInitInputData%WaveVel0) end if DstInitInputData%Gravity = SrcInitInputData%Gravity DstInitInputData%WtrDens = SrcInitInputData%WtrDens @@ -1160,8 +1118,6 @@ subroutine FEAM_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E end if end if DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr - else if (allocated(DstInitOutputData%WriteOutputHdr)) then - deallocate(DstInitOutputData%WriteOutputHdr) end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) @@ -1174,8 +1130,6 @@ subroutine FEAM_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E end if end if DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt - else if (allocated(DstInitOutputData%WriteOutputUnt)) then - deallocate(DstInitOutputData%WriteOutputUnt) end if call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1191,8 +1145,6 @@ subroutine FEAM_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E end if end if DstInitOutputData%LAnchxi = SrcInitOutputData%LAnchxi - else if (allocated(DstInitOutputData%LAnchxi)) then - deallocate(DstInitOutputData%LAnchxi) end if if (allocated(SrcInitOutputData%LAnchyi)) then LB(1:1) = lbound(SrcInitOutputData%LAnchyi) @@ -1205,8 +1157,6 @@ subroutine FEAM_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E end if end if DstInitOutputData%LAnchyi = SrcInitOutputData%LAnchyi - else if (allocated(DstInitOutputData%LAnchyi)) then - deallocate(DstInitOutputData%LAnchyi) end if if (allocated(SrcInitOutputData%LAnchzi)) then LB(1:1) = lbound(SrcInitOutputData%LAnchzi) @@ -1219,8 +1169,6 @@ subroutine FEAM_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E end if end if DstInitOutputData%LAnchzi = SrcInitOutputData%LAnchzi - else if (allocated(DstInitOutputData%LAnchzi)) then - deallocate(DstInitOutputData%LAnchzi) end if if (allocated(SrcInitOutputData%LFairxt)) then LB(1:1) = lbound(SrcInitOutputData%LFairxt) @@ -1233,8 +1181,6 @@ subroutine FEAM_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E end if end if DstInitOutputData%LFairxt = SrcInitOutputData%LFairxt - else if (allocated(DstInitOutputData%LFairxt)) then - deallocate(DstInitOutputData%LFairxt) end if if (allocated(SrcInitOutputData%LFairyt)) then LB(1:1) = lbound(SrcInitOutputData%LFairyt) @@ -1247,8 +1193,6 @@ subroutine FEAM_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E end if end if DstInitOutputData%LFairyt = SrcInitOutputData%LFairyt - else if (allocated(DstInitOutputData%LFairyt)) then - deallocate(DstInitOutputData%LFairyt) end if if (allocated(SrcInitOutputData%LFairzt)) then LB(1:1) = lbound(SrcInitOutputData%LFairzt) @@ -1261,8 +1205,6 @@ subroutine FEAM_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E end if end if DstInitOutputData%LFairzt = SrcInitOutputData%LFairzt - else if (allocated(DstInitOutputData%LFairzt)) then - deallocate(DstInitOutputData%LFairzt) end if end subroutine @@ -1497,8 +1439,6 @@ subroutine FEAM_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrS end if end if DstContStateData%GLU = SrcContStateData%GLU - else if (allocated(DstContStateData%GLU)) then - deallocate(DstContStateData%GLU) end if if (allocated(SrcContStateData%GLDU)) then LB(1:2) = lbound(SrcContStateData%GLDU) @@ -1511,8 +1451,6 @@ subroutine FEAM_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrS end if end if DstContStateData%GLDU = SrcContStateData%GLDU - else if (allocated(DstContStateData%GLDU)) then - deallocate(DstContStateData%GLDU) end if end subroutine @@ -1691,8 +1629,6 @@ subroutine FEAM_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E end if end if DstOtherStateData%GLU0 = SrcOtherStateData%GLU0 - else if (allocated(DstOtherStateData%GLU0)) then - deallocate(DstOtherStateData%GLU0) end if if (allocated(SrcOtherStateData%GLDDU)) then LB(1:2) = lbound(SrcOtherStateData%GLDDU) @@ -1705,8 +1641,6 @@ subroutine FEAM_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E end if end if DstOtherStateData%GLDDU = SrcOtherStateData%GLDDU - else if (allocated(DstOtherStateData%GLDDU)) then - deallocate(DstOtherStateData%GLDDU) end if DstOtherStateData%BottomTouch = SrcOtherStateData%BottomTouch if (allocated(SrcOtherStateData%GFORC0)) then @@ -1720,8 +1654,6 @@ subroutine FEAM_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E end if end if DstOtherStateData%GFORC0 = SrcOtherStateData%GFORC0 - else if (allocated(DstOtherStateData%GFORC0)) then - deallocate(DstOtherStateData%GFORC0) end if if (allocated(SrcOtherStateData%GMASS0)) then LB(1:4) = lbound(SrcOtherStateData%GMASS0) @@ -1734,8 +1666,6 @@ subroutine FEAM_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E end if end if DstOtherStateData%GMASS0 = SrcOtherStateData%GMASS0 - else if (allocated(DstOtherStateData%GMASS0)) then - deallocate(DstOtherStateData%GMASS0) end if if (allocated(SrcOtherStateData%FAST_FPA)) then LB(1:2) = lbound(SrcOtherStateData%FAST_FPA) @@ -1748,8 +1678,6 @@ subroutine FEAM_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E end if end if DstOtherStateData%FAST_FPA = SrcOtherStateData%FAST_FPA - else if (allocated(DstOtherStateData%FAST_FPA)) then - deallocate(DstOtherStateData%FAST_FPA) end if if (allocated(SrcOtherStateData%FAST_RP)) then LB(1:2) = lbound(SrcOtherStateData%FAST_RP) @@ -1762,8 +1690,6 @@ subroutine FEAM_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E end if end if DstOtherStateData%FAST_RP = SrcOtherStateData%FAST_RP - else if (allocated(DstOtherStateData%FAST_RP)) then - deallocate(DstOtherStateData%FAST_RP) end if DstOtherStateData%INCR = SrcOtherStateData%INCR DstOtherStateData%RSDF = SrcOtherStateData%RSDF @@ -1967,8 +1893,6 @@ subroutine FEAM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%GLF = SrcMiscData%GLF - else if (allocated(DstMiscData%GLF)) then - deallocate(DstMiscData%GLF) end if if (allocated(SrcMiscData%GLK)) then LB(1:3) = lbound(SrcMiscData%GLK) @@ -1981,8 +1905,6 @@ subroutine FEAM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%GLK = SrcMiscData%GLK - else if (allocated(DstMiscData%GLK)) then - deallocate(DstMiscData%GLK) end if DstMiscData%EMASS = SrcMiscData%EMASS DstMiscData%ESTIF = SrcMiscData%ESTIF @@ -1997,8 +1919,6 @@ subroutine FEAM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%FAST_FP = SrcMiscData%FAST_FP - else if (allocated(DstMiscData%FAST_FP)) then - deallocate(DstMiscData%FAST_FP) end if DstMiscData%FORCE = SrcMiscData%FORCE DstMiscData%FP = SrcMiscData%FP @@ -2022,8 +1942,6 @@ subroutine FEAM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%FAIR_ANG = SrcMiscData%FAIR_ANG - else if (allocated(DstMiscData%FAIR_ANG)) then - deallocate(DstMiscData%FAIR_ANG) end if if (allocated(SrcMiscData%FAIR_T)) then LB(1:1) = lbound(SrcMiscData%FAIR_T) @@ -2036,8 +1954,6 @@ subroutine FEAM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%FAIR_T = SrcMiscData%FAIR_T - else if (allocated(DstMiscData%FAIR_T)) then - deallocate(DstMiscData%FAIR_T) end if if (allocated(SrcMiscData%ANCH_ANG)) then LB(1:2) = lbound(SrcMiscData%ANCH_ANG) @@ -2050,8 +1966,6 @@ subroutine FEAM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%ANCH_ANG = SrcMiscData%ANCH_ANG - else if (allocated(DstMiscData%ANCH_ANG)) then - deallocate(DstMiscData%ANCH_ANG) end if if (allocated(SrcMiscData%ANCH_T)) then LB(1:1) = lbound(SrcMiscData%ANCH_T) @@ -2064,8 +1978,6 @@ subroutine FEAM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%ANCH_T = SrcMiscData%ANCH_T - else if (allocated(DstMiscData%ANCH_T)) then - deallocate(DstMiscData%ANCH_T) end if if (allocated(SrcMiscData%Line_Coordinate)) then LB(1:3) = lbound(SrcMiscData%Line_Coordinate) @@ -2078,8 +1990,6 @@ subroutine FEAM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%Line_Coordinate = SrcMiscData%Line_Coordinate - else if (allocated(DstMiscData%Line_Coordinate)) then - deallocate(DstMiscData%Line_Coordinate) end if if (allocated(SrcMiscData%Line_Tangent)) then LB(1:3) = lbound(SrcMiscData%Line_Tangent) @@ -2092,8 +2002,6 @@ subroutine FEAM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%Line_Tangent = SrcMiscData%Line_Tangent - else if (allocated(DstMiscData%Line_Tangent)) then - deallocate(DstMiscData%Line_Tangent) end if if (allocated(SrcMiscData%F_Lines)) then LB(1:2) = lbound(SrcMiscData%F_Lines) @@ -2106,8 +2014,6 @@ subroutine FEAM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%F_Lines = SrcMiscData%F_Lines - else if (allocated(DstMiscData%F_Lines)) then - deallocate(DstMiscData%F_Lines) end if DstMiscData%LastIndWave = SrcMiscData%LastIndWave end subroutine @@ -2433,8 +2339,6 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%NEQ = SrcParamData%NEQ - else if (allocated(DstParamData%NEQ)) then - deallocate(DstParamData%NEQ) end if DstParamData%NBAND = SrcParamData%NBAND DstParamData%NumLines = SrcParamData%NumLines @@ -2451,8 +2355,6 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%GSL = SrcParamData%GSL - else if (allocated(DstParamData%GSL)) then - deallocate(DstParamData%GSL) end if if (allocated(SrcParamData%GP)) then LB(1:2) = lbound(SrcParamData%GP) @@ -2465,8 +2367,6 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%GP = SrcParamData%GP - else if (allocated(DstParamData%GP)) then - deallocate(DstParamData%GP) end if if (allocated(SrcParamData%Elength)) then LB(1:1) = lbound(SrcParamData%Elength) @@ -2479,8 +2379,6 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%Elength = SrcParamData%Elength - else if (allocated(DstParamData%Elength)) then - deallocate(DstParamData%Elength) end if if (allocated(SrcParamData%BottmElev)) then LB(1:1) = lbound(SrcParamData%BottmElev) @@ -2493,8 +2391,6 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%BottmElev = SrcParamData%BottmElev - else if (allocated(DstParamData%BottmElev)) then - deallocate(DstParamData%BottmElev) end if if (allocated(SrcParamData%BottmStiff)) then LB(1:1) = lbound(SrcParamData%BottmStiff) @@ -2507,8 +2403,6 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%BottmStiff = SrcParamData%BottmStiff - else if (allocated(DstParamData%BottmStiff)) then - deallocate(DstParamData%BottmStiff) end if if (allocated(SrcParamData%LMassDen)) then LB(1:1) = lbound(SrcParamData%LMassDen) @@ -2521,8 +2415,6 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%LMassDen = SrcParamData%LMassDen - else if (allocated(DstParamData%LMassDen)) then - deallocate(DstParamData%LMassDen) end if if (allocated(SrcParamData%LDMassDen)) then LB(1:1) = lbound(SrcParamData%LDMassDen) @@ -2535,8 +2427,6 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%LDMassDen = SrcParamData%LDMassDen - else if (allocated(DstParamData%LDMassDen)) then - deallocate(DstParamData%LDMassDen) end if if (allocated(SrcParamData%LEAStiff)) then LB(1:1) = lbound(SrcParamData%LEAStiff) @@ -2549,8 +2439,6 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%LEAStiff = SrcParamData%LEAStiff - else if (allocated(DstParamData%LEAStiff)) then - deallocate(DstParamData%LEAStiff) end if if (allocated(SrcParamData%LineCI)) then LB(1:1) = lbound(SrcParamData%LineCI) @@ -2563,8 +2451,6 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%LineCI = SrcParamData%LineCI - else if (allocated(DstParamData%LineCI)) then - deallocate(DstParamData%LineCI) end if if (allocated(SrcParamData%LineCD)) then LB(1:1) = lbound(SrcParamData%LineCD) @@ -2577,8 +2463,6 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%LineCD = SrcParamData%LineCD - else if (allocated(DstParamData%LineCD)) then - deallocate(DstParamData%LineCD) end if if (allocated(SrcParamData%Bvp)) then LB(1:2) = lbound(SrcParamData%Bvp) @@ -2591,8 +2475,6 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%Bvp = SrcParamData%Bvp - else if (allocated(DstParamData%Bvp)) then - deallocate(DstParamData%Bvp) end if if (allocated(SrcParamData%WaveAcc0)) then LB(1:3) = lbound(SrcParamData%WaveAcc0) @@ -2605,8 +2487,6 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%WaveAcc0 = SrcParamData%WaveAcc0 - else if (allocated(DstParamData%WaveAcc0)) then - deallocate(DstParamData%WaveAcc0) end if if (allocated(SrcParamData%WaveTime)) then LB(1:1) = lbound(SrcParamData%WaveTime) @@ -2619,8 +2499,6 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%WaveTime = SrcParamData%WaveTime - else if (allocated(DstParamData%WaveTime)) then - deallocate(DstParamData%WaveTime) end if if (allocated(SrcParamData%WaveVel0)) then LB(1:3) = lbound(SrcParamData%WaveVel0) @@ -2633,8 +2511,6 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%WaveVel0 = SrcParamData%WaveVel0 - else if (allocated(DstParamData%WaveVel0)) then - deallocate(DstParamData%WaveVel0) end if DstParamData%NStepWave = SrcParamData%NStepWave DstParamData%SHAP = SrcParamData%SHAP @@ -2672,8 +2548,6 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstParamData%OutParam)) then - deallocate(DstParamData%OutParam) end if DstParamData%Delim = SrcParamData%Delim if (allocated(SrcParamData%GLUZR)) then @@ -2687,8 +2561,6 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%GLUZR = SrcParamData%GLUZR - else if (allocated(DstParamData%GLUZR)) then - deallocate(DstParamData%GLUZR) end if if (allocated(SrcParamData%GTZER)) then LB(1:2) = lbound(SrcParamData%GTZER) @@ -2701,8 +2573,6 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%GTZER = SrcParamData%GTZER - else if (allocated(DstParamData%GTZER)) then - deallocate(DstParamData%GTZER) end if end subroutine @@ -3325,8 +3195,6 @@ subroutine FEAM_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM end if end if DstOutputData%WriteOutput = SrcOutputData%WriteOutput - else if (allocated(DstOutputData%WriteOutput)) then - deallocate(DstOutputData%WriteOutput) end if call MeshCopy(SrcOutputData%PtFairleadLoad, DstOutputData%PtFairleadLoad, CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) diff --git a/modules/hydrodyn/src/Conv_Radiation_Types.f90 b/modules/hydrodyn/src/Conv_Radiation_Types.f90 index 00f7a5bf3f..c0669665e7 100644 --- a/modules/hydrodyn/src/Conv_Radiation_Types.f90 +++ b/modules/hydrodyn/src/Conv_Radiation_Types.f90 @@ -127,8 +127,6 @@ subroutine Conv_Rdtn_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, end if end if DstInitInputData%HdroAddMs = SrcInitInputData%HdroAddMs - else if (allocated(DstInitInputData%HdroAddMs)) then - deallocate(DstInitInputData%HdroAddMs) end if if (allocated(SrcInitInputData%HdroFreq)) then LB(1:1) = lbound(SrcInitInputData%HdroFreq) @@ -141,8 +139,6 @@ subroutine Conv_Rdtn_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, end if end if DstInitInputData%HdroFreq = SrcInitInputData%HdroFreq - else if (allocated(DstInitInputData%HdroFreq)) then - deallocate(DstInitInputData%HdroFreq) end if if (allocated(SrcInitInputData%HdroDmpng)) then LB(1:3) = lbound(SrcInitInputData%HdroDmpng) @@ -155,8 +151,6 @@ subroutine Conv_Rdtn_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, end if end if DstInitInputData%HdroDmpng = SrcInitInputData%HdroDmpng - else if (allocated(DstInitInputData%HdroDmpng)) then - deallocate(DstInitInputData%HdroDmpng) end if DstInitInputData%NInpFreq = SrcInitInputData%NInpFreq DstInitInputData%RdtnTMax = SrcInitInputData%RdtnTMax @@ -376,8 +370,6 @@ subroutine Conv_Rdtn_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, end if end if DstDiscStateData%XDHistory = SrcDiscStateData%XDHistory - else if (allocated(DstDiscStateData%XDHistory)) then - deallocate(DstDiscStateData%XDHistory) end if DstDiscStateData%LastTime = SrcDiscStateData%LastTime end subroutine @@ -576,8 +568,6 @@ subroutine Conv_Rdtn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Er end if end if DstParamData%RdtnKrnl = SrcParamData%RdtnKrnl - else if (allocated(DstParamData%RdtnKrnl)) then - deallocate(DstParamData%RdtnKrnl) end if DstParamData%NStepRdtn = SrcParamData%NStepRdtn DstParamData%NStepRdtn1 = SrcParamData%NStepRdtn1 @@ -669,8 +659,6 @@ subroutine Conv_Rdtn_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, Er end if end if DstInputData%Velocity = SrcInputData%Velocity - else if (allocated(DstInputData%Velocity)) then - deallocate(DstInputData%Velocity) end if end subroutine @@ -745,8 +733,6 @@ subroutine Conv_Rdtn_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, end if end if DstOutputData%F_Rdtn = SrcOutputData%F_Rdtn - else if (allocated(DstOutputData%F_Rdtn)) then - deallocate(DstOutputData%F_Rdtn) end if end subroutine diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index a93f309412..c704189183 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -259,8 +259,6 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, end if end if DstInputFileData%AddF0 = SrcInputFileData%AddF0 - else if (allocated(DstInputFileData%AddF0)) then - deallocate(DstInputFileData%AddF0) end if if (allocated(SrcInputFileData%AddCLin)) then LB(1:3) = lbound(SrcInputFileData%AddCLin) @@ -273,8 +271,6 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, end if end if DstInputFileData%AddCLin = SrcInputFileData%AddCLin - else if (allocated(DstInputFileData%AddCLin)) then - deallocate(DstInputFileData%AddCLin) end if if (allocated(SrcInputFileData%AddBLin)) then LB(1:3) = lbound(SrcInputFileData%AddBLin) @@ -287,8 +283,6 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, end if end if DstInputFileData%AddBLin = SrcInputFileData%AddBLin - else if (allocated(DstInputFileData%AddBLin)) then - deallocate(DstInputFileData%AddBLin) end if if (allocated(SrcInputFileData%AddBQuad)) then LB(1:3) = lbound(SrcInputFileData%AddBQuad) @@ -301,8 +295,6 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, end if end if DstInputFileData%AddBQuad = SrcInputFileData%AddBQuad - else if (allocated(DstInputFileData%AddBQuad)) then - deallocate(DstInputFileData%AddBQuad) end if call SeaSt_CopyInitInput(SrcInputFileData%SeaState, DstInputFileData%SeaState, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -318,8 +310,6 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, end if end if DstInputFileData%PotFile = SrcInputFileData%PotFile - else if (allocated(DstInputFileData%PotFile)) then - deallocate(DstInputFileData%PotFile) end if DstInputFileData%nWAMITObj = SrcInputFileData%nWAMITObj DstInputFileData%vecMultiplier = SrcInputFileData%vecMultiplier @@ -336,8 +326,6 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, end if end if DstInputFileData%PtfmVol0 = SrcInputFileData%PtfmVol0 - else if (allocated(DstInputFileData%PtfmVol0)) then - deallocate(DstInputFileData%PtfmVol0) end if DstInputFileData%HasWAMIT = SrcInputFileData%HasWAMIT if (allocated(SrcInputFileData%WAMITULEN)) then @@ -351,8 +339,6 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, end if end if DstInputFileData%WAMITULEN = SrcInputFileData%WAMITULEN - else if (allocated(DstInputFileData%WAMITULEN)) then - deallocate(DstInputFileData%WAMITULEN) end if if (allocated(SrcInputFileData%PtfmRefxt)) then LB(1:1) = lbound(SrcInputFileData%PtfmRefxt) @@ -365,8 +351,6 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, end if end if DstInputFileData%PtfmRefxt = SrcInputFileData%PtfmRefxt - else if (allocated(DstInputFileData%PtfmRefxt)) then - deallocate(DstInputFileData%PtfmRefxt) end if if (allocated(SrcInputFileData%PtfmRefyt)) then LB(1:1) = lbound(SrcInputFileData%PtfmRefyt) @@ -379,8 +363,6 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, end if end if DstInputFileData%PtfmRefyt = SrcInputFileData%PtfmRefyt - else if (allocated(DstInputFileData%PtfmRefyt)) then - deallocate(DstInputFileData%PtfmRefyt) end if if (allocated(SrcInputFileData%PtfmRefzt)) then LB(1:1) = lbound(SrcInputFileData%PtfmRefzt) @@ -393,8 +375,6 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, end if end if DstInputFileData%PtfmRefzt = SrcInputFileData%PtfmRefzt - else if (allocated(DstInputFileData%PtfmRefzt)) then - deallocate(DstInputFileData%PtfmRefzt) end if if (allocated(SrcInputFileData%PtfmRefztRot)) then LB(1:1) = lbound(SrcInputFileData%PtfmRefztRot) @@ -407,8 +387,6 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, end if end if DstInputFileData%PtfmRefztRot = SrcInputFileData%PtfmRefztRot - else if (allocated(DstInputFileData%PtfmRefztRot)) then - deallocate(DstInputFileData%PtfmRefztRot) end if if (allocated(SrcInputFileData%PtfmCOBxt)) then LB(1:1) = lbound(SrcInputFileData%PtfmCOBxt) @@ -421,8 +399,6 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, end if end if DstInputFileData%PtfmCOBxt = SrcInputFileData%PtfmCOBxt - else if (allocated(DstInputFileData%PtfmCOBxt)) then - deallocate(DstInputFileData%PtfmCOBxt) end if if (allocated(SrcInputFileData%PtfmCOByt)) then LB(1:1) = lbound(SrcInputFileData%PtfmCOByt) @@ -435,8 +411,6 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, end if end if DstInputFileData%PtfmCOByt = SrcInputFileData%PtfmCOByt - else if (allocated(DstInputFileData%PtfmCOByt)) then - deallocate(DstInputFileData%PtfmCOByt) end if call WAMIT_CopyInitInput(SrcInputFileData%WAMIT, DstInputFileData%WAMIT, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -461,8 +435,6 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, end if end if DstInputFileData%UserOutputs = SrcInputFileData%UserOutputs - else if (allocated(DstInputFileData%UserOutputs)) then - deallocate(DstInputFileData%UserOutputs) end if DstInputFileData%OutSwtch = SrcInputFileData%OutSwtch DstInputFileData%OutAll = SrcInputFileData%OutAll @@ -478,8 +450,6 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, end if end if DstInputFileData%OutList = SrcInputFileData%OutList - else if (allocated(DstInputFileData%OutList)) then - deallocate(DstInputFileData%OutList) end if DstInputFileData%HDSum = SrcInputFileData%HDSum DstInputFileData%UnSum = SrcInputFileData%UnSum @@ -960,8 +930,6 @@ subroutine HydroDyn_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, end if end if DstInitInputData%WaveElev0 = SrcInitInputData%WaveElev0 - else if (allocated(DstInitInputData%WaveElev0)) then - deallocate(DstInitInputData%WaveElev0) end if if (allocated(SrcInitInputData%WaveElevC)) then LB(1:3) = lbound(SrcInitInputData%WaveElevC) @@ -974,8 +942,6 @@ subroutine HydroDyn_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, end if end if DstInitInputData%WaveElevC = SrcInitInputData%WaveElevC - else if (allocated(DstInitInputData%WaveElevC)) then - deallocate(DstInitInputData%WaveElevC) end if DstInitInputData%WaveDirMin = SrcInitInputData%WaveDirMin DstInitInputData%WaveDirMax = SrcInitInputData%WaveDirMax @@ -1210,8 +1176,6 @@ subroutine HydroDyn_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCod end if end if DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr - else if (allocated(DstInitOutputData%WriteOutputHdr)) then - deallocate(DstInitOutputData%WriteOutputHdr) end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) @@ -1224,8 +1188,6 @@ subroutine HydroDyn_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCod end if end if DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt - else if (allocated(DstInitOutputData%WriteOutputUnt)) then - deallocate(DstInitOutputData%WriteOutputUnt) end if call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1241,8 +1203,6 @@ subroutine HydroDyn_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCod end if end if DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y - else if (allocated(DstInitOutputData%LinNames_y)) then - deallocate(DstInitOutputData%LinNames_y) end if if (allocated(SrcInitOutputData%LinNames_x)) then LB(1:1) = lbound(SrcInitOutputData%LinNames_x) @@ -1255,8 +1215,6 @@ subroutine HydroDyn_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCod end if end if DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x - else if (allocated(DstInitOutputData%LinNames_x)) then - deallocate(DstInitOutputData%LinNames_x) end if if (allocated(SrcInitOutputData%LinNames_u)) then LB(1:1) = lbound(SrcInitOutputData%LinNames_u) @@ -1269,8 +1227,6 @@ subroutine HydroDyn_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCod end if end if DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u - else if (allocated(DstInitOutputData%LinNames_u)) then - deallocate(DstInitOutputData%LinNames_u) end if if (allocated(SrcInitOutputData%DerivOrder_x)) then LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) @@ -1283,8 +1239,6 @@ subroutine HydroDyn_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCod end if end if DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x - else if (allocated(DstInitOutputData%DerivOrder_x)) then - deallocate(DstInitOutputData%DerivOrder_x) end if if (allocated(SrcInitOutputData%IsLoad_u)) then LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) @@ -1297,8 +1251,6 @@ subroutine HydroDyn_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCod end if end if DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u - else if (allocated(DstInitOutputData%IsLoad_u)) then - deallocate(DstInitOutputData%IsLoad_u) end if end subroutine @@ -1581,8 +1533,6 @@ subroutine HydroDyn_CopyContState(SrcContStateData, DstContStateData, CtrlCode, call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstContStateData%WAMIT)) then - deallocate(DstContStateData%WAMIT) end if call Morison_CopyContState(SrcContStateData%Morison, DstContStateData%Morison, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1688,8 +1638,6 @@ subroutine HydroDyn_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstDiscStateData%WAMIT)) then - deallocate(DstDiscStateData%WAMIT) end if call Morison_CopyDiscState(SrcDiscStateData%Morison, DstDiscStateData%Morison, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1848,8 +1796,6 @@ subroutine HydroDyn_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCod call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstOtherStateData%WAMIT)) then - deallocate(DstOtherStateData%WAMIT) end if call Morison_CopyOtherState(SrcOtherStateData%Morison, DstOtherStateData%Morison, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1960,8 +1906,6 @@ subroutine HydroDyn_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg end if end if DstMiscData%F_PtfmAdd = SrcMiscData%F_PtfmAdd - else if (allocated(DstMiscData%F_PtfmAdd)) then - deallocate(DstMiscData%F_PtfmAdd) end if DstMiscData%F_Hydro = SrcMiscData%F_Hydro if (allocated(SrcMiscData%F_Waves)) then @@ -1975,8 +1919,6 @@ subroutine HydroDyn_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg end if end if DstMiscData%F_Waves = SrcMiscData%F_Waves - else if (allocated(DstMiscData%F_Waves)) then - deallocate(DstMiscData%F_Waves) end if if (allocated(SrcMiscData%WAMIT)) then LB(1:1) = lbound(SrcMiscData%WAMIT) @@ -1993,8 +1935,6 @@ subroutine HydroDyn_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstMiscData%WAMIT)) then - deallocate(DstMiscData%WAMIT) end if if (allocated(SrcMiscData%WAMIT2)) then LB(1:1) = lbound(SrcMiscData%WAMIT2) @@ -2011,8 +1951,6 @@ subroutine HydroDyn_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstMiscData%WAMIT2)) then - deallocate(DstMiscData%WAMIT2) end if call Morison_CopyMisc(SrcMiscData%Morison, DstMiscData%Morison, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2032,8 +1970,6 @@ subroutine HydroDyn_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstMiscData%u_WAMIT)) then - deallocate(DstMiscData%u_WAMIT) end if end subroutine @@ -2268,8 +2204,6 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstParamData%WAMIT)) then - deallocate(DstParamData%WAMIT) end if if (allocated(SrcParamData%WAMIT2)) then LB(1:1) = lbound(SrcParamData%WAMIT2) @@ -2286,8 +2220,6 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstParamData%WAMIT2)) then - deallocate(DstParamData%WAMIT2) end if DstParamData%WAMIT2used = SrcParamData%WAMIT2used call Morison_CopyParam(SrcParamData%Morison, DstParamData%Morison, CtrlCode, ErrStat2, ErrMsg2) @@ -2313,8 +2245,6 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err end if end if DstParamData%AddF0 = SrcParamData%AddF0 - else if (allocated(DstParamData%AddF0)) then - deallocate(DstParamData%AddF0) end if if (allocated(SrcParamData%AddCLin)) then LB(1:3) = lbound(SrcParamData%AddCLin) @@ -2327,8 +2257,6 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err end if end if DstParamData%AddCLin = SrcParamData%AddCLin - else if (allocated(DstParamData%AddCLin)) then - deallocate(DstParamData%AddCLin) end if if (allocated(SrcParamData%AddBLin)) then LB(1:3) = lbound(SrcParamData%AddBLin) @@ -2341,8 +2269,6 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err end if end if DstParamData%AddBLin = SrcParamData%AddBLin - else if (allocated(DstParamData%AddBLin)) then - deallocate(DstParamData%AddBLin) end if if (allocated(SrcParamData%AddBQuad)) then LB(1:3) = lbound(SrcParamData%AddBQuad) @@ -2355,8 +2281,6 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err end if end if DstParamData%AddBQuad = SrcParamData%AddBQuad - else if (allocated(DstParamData%AddBQuad)) then - deallocate(DstParamData%AddBQuad) end if DstParamData%DT = SrcParamData%DT if (allocated(SrcParamData%OutParam)) then @@ -2374,8 +2298,6 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstParamData%OutParam)) then - deallocate(DstParamData%OutParam) end if DstParamData%NumOuts = SrcParamData%NumOuts DstParamData%NumTotalOuts = SrcParamData%NumTotalOuts @@ -2396,8 +2318,6 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err end if end if DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx - else if (allocated(DstParamData%Jac_u_indx)) then - deallocate(DstParamData%Jac_u_indx) end if if (allocated(SrcParamData%du)) then LB(1:1) = lbound(SrcParamData%du) @@ -2410,8 +2330,6 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err end if end if DstParamData%du = SrcParamData%du - else if (allocated(DstParamData%du)) then - deallocate(DstParamData%du) end if if (allocated(SrcParamData%dx)) then LB(1:1) = lbound(SrcParamData%dx) @@ -2424,8 +2342,6 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err end if end if DstParamData%dx = SrcParamData%dx - else if (allocated(DstParamData%dx)) then - deallocate(DstParamData%dx) end if DstParamData%Jac_ny = SrcParamData%Jac_ny DstParamData%PointsToSeaState = SrcParamData%PointsToSeaState @@ -2912,8 +2828,6 @@ subroutine HydroDyn_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstOutputData%WAMIT)) then - deallocate(DstOutputData%WAMIT) end if if (allocated(SrcOutputData%WAMIT2)) then LB(1:1) = lbound(SrcOutputData%WAMIT2) @@ -2930,8 +2844,6 @@ subroutine HydroDyn_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstOutputData%WAMIT2)) then - deallocate(DstOutputData%WAMIT2) end if call Morison_CopyOutput(SrcOutputData%Morison, DstOutputData%Morison, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2950,8 +2862,6 @@ subroutine HydroDyn_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, end if end if DstOutputData%WriteOutput = SrcOutputData%WriteOutput - else if (allocated(DstOutputData%WriteOutput)) then - deallocate(DstOutputData%WriteOutput) end if end subroutine diff --git a/modules/hydrodyn/src/Morison_Types.f90 b/modules/hydrodyn/src/Morison_Types.f90 index 914d244527..a420bd55ec 100644 --- a/modules/hydrodyn/src/Morison_Types.f90 +++ b/modules/hydrodyn/src/Morison_Types.f90 @@ -570,8 +570,6 @@ subroutine Morison_CopyFilledGroupType(SrcFilledGroupTypeData, DstFilledGroupTyp end if end if DstFilledGroupTypeData%FillMList = SrcFilledGroupTypeData%FillMList - else if (allocated(DstFilledGroupTypeData%FillMList)) then - deallocate(DstFilledGroupTypeData%FillMList) end if DstFilledGroupTypeData%FillFSLoc = SrcFilledGroupTypeData%FillFSLoc DstFilledGroupTypeData%FillDensChr = SrcFilledGroupTypeData%FillDensChr @@ -824,8 +822,6 @@ subroutine Morison_CopyMemberInputType(SrcMemberInputTypeData, DstMemberInputTyp end if end if DstMemberInputTypeData%NodeIndx = SrcMemberInputTypeData%NodeIndx - else if (allocated(DstMemberInputTypeData%NodeIndx)) then - deallocate(DstMemberInputTypeData%NodeIndx) end if DstMemberInputTypeData%MJointID1 = SrcMemberInputTypeData%MJointID1 DstMemberInputTypeData%MJointID2 = SrcMemberInputTypeData%MJointID2 @@ -1070,8 +1066,6 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode end if end if DstMemberTypeData%NodeIndx = SrcMemberTypeData%NodeIndx - else if (allocated(DstMemberTypeData%NodeIndx)) then - deallocate(DstMemberTypeData%NodeIndx) end if DstMemberTypeData%MemberID = SrcMemberTypeData%MemberID DstMemberTypeData%NElements = SrcMemberTypeData%NElements @@ -1092,8 +1086,6 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode end if end if DstMemberTypeData%R = SrcMemberTypeData%R - else if (allocated(DstMemberTypeData%R)) then - deallocate(DstMemberTypeData%R) end if if (allocated(SrcMemberTypeData%RMG)) then LB(1:1) = lbound(SrcMemberTypeData%RMG) @@ -1106,8 +1098,6 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode end if end if DstMemberTypeData%RMG = SrcMemberTypeData%RMG - else if (allocated(DstMemberTypeData%RMG)) then - deallocate(DstMemberTypeData%RMG) end if if (allocated(SrcMemberTypeData%RMGB)) then LB(1:1) = lbound(SrcMemberTypeData%RMGB) @@ -1120,8 +1110,6 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode end if end if DstMemberTypeData%RMGB = SrcMemberTypeData%RMGB - else if (allocated(DstMemberTypeData%RMGB)) then - deallocate(DstMemberTypeData%RMGB) end if if (allocated(SrcMemberTypeData%Rin)) then LB(1:1) = lbound(SrcMemberTypeData%Rin) @@ -1134,8 +1122,6 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode end if end if DstMemberTypeData%Rin = SrcMemberTypeData%Rin - else if (allocated(DstMemberTypeData%Rin)) then - deallocate(DstMemberTypeData%Rin) end if if (allocated(SrcMemberTypeData%tMG)) then LB(1:1) = lbound(SrcMemberTypeData%tMG) @@ -1148,8 +1134,6 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode end if end if DstMemberTypeData%tMG = SrcMemberTypeData%tMG - else if (allocated(DstMemberTypeData%tMG)) then - deallocate(DstMemberTypeData%tMG) end if if (allocated(SrcMemberTypeData%MGdensity)) then LB(1:1) = lbound(SrcMemberTypeData%MGdensity) @@ -1162,8 +1146,6 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode end if end if DstMemberTypeData%MGdensity = SrcMemberTypeData%MGdensity - else if (allocated(DstMemberTypeData%MGdensity)) then - deallocate(DstMemberTypeData%MGdensity) end if if (allocated(SrcMemberTypeData%dRdl_mg)) then LB(1:1) = lbound(SrcMemberTypeData%dRdl_mg) @@ -1176,8 +1158,6 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode end if end if DstMemberTypeData%dRdl_mg = SrcMemberTypeData%dRdl_mg - else if (allocated(DstMemberTypeData%dRdl_mg)) then - deallocate(DstMemberTypeData%dRdl_mg) end if if (allocated(SrcMemberTypeData%dRdl_mg_b)) then LB(1:1) = lbound(SrcMemberTypeData%dRdl_mg_b) @@ -1190,8 +1170,6 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode end if end if DstMemberTypeData%dRdl_mg_b = SrcMemberTypeData%dRdl_mg_b - else if (allocated(DstMemberTypeData%dRdl_mg_b)) then - deallocate(DstMemberTypeData%dRdl_mg_b) end if if (allocated(SrcMemberTypeData%dRdl_in)) then LB(1:1) = lbound(SrcMemberTypeData%dRdl_in) @@ -1204,8 +1182,6 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode end if end if DstMemberTypeData%dRdl_in = SrcMemberTypeData%dRdl_in - else if (allocated(DstMemberTypeData%dRdl_in)) then - deallocate(DstMemberTypeData%dRdl_in) end if DstMemberTypeData%Vinner = SrcMemberTypeData%Vinner DstMemberTypeData%Vouter = SrcMemberTypeData%Vouter @@ -1229,8 +1205,6 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode end if end if DstMemberTypeData%floodstatus = SrcMemberTypeData%floodstatus - else if (allocated(DstMemberTypeData%floodstatus)) then - deallocate(DstMemberTypeData%floodstatus) end if if (allocated(SrcMemberTypeData%alpha)) then LB(1:1) = lbound(SrcMemberTypeData%alpha) @@ -1243,8 +1217,6 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode end if end if DstMemberTypeData%alpha = SrcMemberTypeData%alpha - else if (allocated(DstMemberTypeData%alpha)) then - deallocate(DstMemberTypeData%alpha) end if if (allocated(SrcMemberTypeData%alpha_fb)) then LB(1:1) = lbound(SrcMemberTypeData%alpha_fb) @@ -1257,8 +1229,6 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode end if end if DstMemberTypeData%alpha_fb = SrcMemberTypeData%alpha_fb - else if (allocated(DstMemberTypeData%alpha_fb)) then - deallocate(DstMemberTypeData%alpha_fb) end if if (allocated(SrcMemberTypeData%alpha_fb_star)) then LB(1:1) = lbound(SrcMemberTypeData%alpha_fb_star) @@ -1271,8 +1241,6 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode end if end if DstMemberTypeData%alpha_fb_star = SrcMemberTypeData%alpha_fb_star - else if (allocated(DstMemberTypeData%alpha_fb_star)) then - deallocate(DstMemberTypeData%alpha_fb_star) end if if (allocated(SrcMemberTypeData%Cd)) then LB(1:1) = lbound(SrcMemberTypeData%Cd) @@ -1285,8 +1253,6 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode end if end if DstMemberTypeData%Cd = SrcMemberTypeData%Cd - else if (allocated(DstMemberTypeData%Cd)) then - deallocate(DstMemberTypeData%Cd) end if if (allocated(SrcMemberTypeData%Ca)) then LB(1:1) = lbound(SrcMemberTypeData%Ca) @@ -1299,8 +1265,6 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode end if end if DstMemberTypeData%Ca = SrcMemberTypeData%Ca - else if (allocated(DstMemberTypeData%Ca)) then - deallocate(DstMemberTypeData%Ca) end if if (allocated(SrcMemberTypeData%Cp)) then LB(1:1) = lbound(SrcMemberTypeData%Cp) @@ -1313,8 +1277,6 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode end if end if DstMemberTypeData%Cp = SrcMemberTypeData%Cp - else if (allocated(DstMemberTypeData%Cp)) then - deallocate(DstMemberTypeData%Cp) end if if (allocated(SrcMemberTypeData%AxCd)) then LB(1:1) = lbound(SrcMemberTypeData%AxCd) @@ -1327,8 +1289,6 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode end if end if DstMemberTypeData%AxCd = SrcMemberTypeData%AxCd - else if (allocated(DstMemberTypeData%AxCd)) then - deallocate(DstMemberTypeData%AxCd) end if if (allocated(SrcMemberTypeData%AxCa)) then LB(1:1) = lbound(SrcMemberTypeData%AxCa) @@ -1341,8 +1301,6 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode end if end if DstMemberTypeData%AxCa = SrcMemberTypeData%AxCa - else if (allocated(DstMemberTypeData%AxCa)) then - deallocate(DstMemberTypeData%AxCa) end if if (allocated(SrcMemberTypeData%AxCp)) then LB(1:1) = lbound(SrcMemberTypeData%AxCp) @@ -1355,8 +1313,6 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode end if end if DstMemberTypeData%AxCp = SrcMemberTypeData%AxCp - else if (allocated(DstMemberTypeData%AxCp)) then - deallocate(DstMemberTypeData%AxCp) end if if (allocated(SrcMemberTypeData%Cb)) then LB(1:1) = lbound(SrcMemberTypeData%Cb) @@ -1369,8 +1325,6 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode end if end if DstMemberTypeData%Cb = SrcMemberTypeData%Cb - else if (allocated(DstMemberTypeData%Cb)) then - deallocate(DstMemberTypeData%Cb) end if if (allocated(SrcMemberTypeData%m_fb_l)) then LB(1:1) = lbound(SrcMemberTypeData%m_fb_l) @@ -1383,8 +1337,6 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode end if end if DstMemberTypeData%m_fb_l = SrcMemberTypeData%m_fb_l - else if (allocated(DstMemberTypeData%m_fb_l)) then - deallocate(DstMemberTypeData%m_fb_l) end if if (allocated(SrcMemberTypeData%m_fb_u)) then LB(1:1) = lbound(SrcMemberTypeData%m_fb_u) @@ -1397,8 +1349,6 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode end if end if DstMemberTypeData%m_fb_u = SrcMemberTypeData%m_fb_u - else if (allocated(DstMemberTypeData%m_fb_u)) then - deallocate(DstMemberTypeData%m_fb_u) end if if (allocated(SrcMemberTypeData%h_cfb_l)) then LB(1:1) = lbound(SrcMemberTypeData%h_cfb_l) @@ -1411,8 +1361,6 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode end if end if DstMemberTypeData%h_cfb_l = SrcMemberTypeData%h_cfb_l - else if (allocated(DstMemberTypeData%h_cfb_l)) then - deallocate(DstMemberTypeData%h_cfb_l) end if if (allocated(SrcMemberTypeData%h_cfb_u)) then LB(1:1) = lbound(SrcMemberTypeData%h_cfb_u) @@ -1425,8 +1373,6 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode end if end if DstMemberTypeData%h_cfb_u = SrcMemberTypeData%h_cfb_u - else if (allocated(DstMemberTypeData%h_cfb_u)) then - deallocate(DstMemberTypeData%h_cfb_u) end if if (allocated(SrcMemberTypeData%I_lfb_l)) then LB(1:1) = lbound(SrcMemberTypeData%I_lfb_l) @@ -1439,8 +1385,6 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode end if end if DstMemberTypeData%I_lfb_l = SrcMemberTypeData%I_lfb_l - else if (allocated(DstMemberTypeData%I_lfb_l)) then - deallocate(DstMemberTypeData%I_lfb_l) end if if (allocated(SrcMemberTypeData%I_lfb_u)) then LB(1:1) = lbound(SrcMemberTypeData%I_lfb_u) @@ -1453,8 +1397,6 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode end if end if DstMemberTypeData%I_lfb_u = SrcMemberTypeData%I_lfb_u - else if (allocated(DstMemberTypeData%I_lfb_u)) then - deallocate(DstMemberTypeData%I_lfb_u) end if if (allocated(SrcMemberTypeData%I_rfb_l)) then LB(1:1) = lbound(SrcMemberTypeData%I_rfb_l) @@ -1467,8 +1409,6 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode end if end if DstMemberTypeData%I_rfb_l = SrcMemberTypeData%I_rfb_l - else if (allocated(DstMemberTypeData%I_rfb_l)) then - deallocate(DstMemberTypeData%I_rfb_l) end if if (allocated(SrcMemberTypeData%I_rfb_u)) then LB(1:1) = lbound(SrcMemberTypeData%I_rfb_u) @@ -1481,8 +1421,6 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode end if end if DstMemberTypeData%I_rfb_u = SrcMemberTypeData%I_rfb_u - else if (allocated(DstMemberTypeData%I_rfb_u)) then - deallocate(DstMemberTypeData%I_rfb_u) end if if (allocated(SrcMemberTypeData%m_mg_l)) then LB(1:1) = lbound(SrcMemberTypeData%m_mg_l) @@ -1495,8 +1433,6 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode end if end if DstMemberTypeData%m_mg_l = SrcMemberTypeData%m_mg_l - else if (allocated(DstMemberTypeData%m_mg_l)) then - deallocate(DstMemberTypeData%m_mg_l) end if if (allocated(SrcMemberTypeData%m_mg_u)) then LB(1:1) = lbound(SrcMemberTypeData%m_mg_u) @@ -1509,8 +1445,6 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode end if end if DstMemberTypeData%m_mg_u = SrcMemberTypeData%m_mg_u - else if (allocated(DstMemberTypeData%m_mg_u)) then - deallocate(DstMemberTypeData%m_mg_u) end if if (allocated(SrcMemberTypeData%h_cmg_l)) then LB(1:1) = lbound(SrcMemberTypeData%h_cmg_l) @@ -1523,8 +1457,6 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode end if end if DstMemberTypeData%h_cmg_l = SrcMemberTypeData%h_cmg_l - else if (allocated(DstMemberTypeData%h_cmg_l)) then - deallocate(DstMemberTypeData%h_cmg_l) end if if (allocated(SrcMemberTypeData%h_cmg_u)) then LB(1:1) = lbound(SrcMemberTypeData%h_cmg_u) @@ -1537,8 +1469,6 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode end if end if DstMemberTypeData%h_cmg_u = SrcMemberTypeData%h_cmg_u - else if (allocated(DstMemberTypeData%h_cmg_u)) then - deallocate(DstMemberTypeData%h_cmg_u) end if if (allocated(SrcMemberTypeData%I_lmg_l)) then LB(1:1) = lbound(SrcMemberTypeData%I_lmg_l) @@ -1551,8 +1481,6 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode end if end if DstMemberTypeData%I_lmg_l = SrcMemberTypeData%I_lmg_l - else if (allocated(DstMemberTypeData%I_lmg_l)) then - deallocate(DstMemberTypeData%I_lmg_l) end if if (allocated(SrcMemberTypeData%I_lmg_u)) then LB(1:1) = lbound(SrcMemberTypeData%I_lmg_u) @@ -1565,8 +1493,6 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode end if end if DstMemberTypeData%I_lmg_u = SrcMemberTypeData%I_lmg_u - else if (allocated(DstMemberTypeData%I_lmg_u)) then - deallocate(DstMemberTypeData%I_lmg_u) end if if (allocated(SrcMemberTypeData%I_rmg_l)) then LB(1:1) = lbound(SrcMemberTypeData%I_rmg_l) @@ -1579,8 +1505,6 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode end if end if DstMemberTypeData%I_rmg_l = SrcMemberTypeData%I_rmg_l - else if (allocated(DstMemberTypeData%I_rmg_l)) then - deallocate(DstMemberTypeData%I_rmg_l) end if if (allocated(SrcMemberTypeData%I_rmg_u)) then LB(1:1) = lbound(SrcMemberTypeData%I_rmg_u) @@ -1593,8 +1517,6 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode end if end if DstMemberTypeData%I_rmg_u = SrcMemberTypeData%I_rmg_u - else if (allocated(DstMemberTypeData%I_rmg_u)) then - deallocate(DstMemberTypeData%I_rmg_u) end if if (allocated(SrcMemberTypeData%Cfl_fb)) then LB(1:1) = lbound(SrcMemberTypeData%Cfl_fb) @@ -1607,8 +1529,6 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode end if end if DstMemberTypeData%Cfl_fb = SrcMemberTypeData%Cfl_fb - else if (allocated(DstMemberTypeData%Cfl_fb)) then - deallocate(DstMemberTypeData%Cfl_fb) end if if (allocated(SrcMemberTypeData%Cfr_fb)) then LB(1:1) = lbound(SrcMemberTypeData%Cfr_fb) @@ -1621,8 +1541,6 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode end if end if DstMemberTypeData%Cfr_fb = SrcMemberTypeData%Cfr_fb - else if (allocated(DstMemberTypeData%Cfr_fb)) then - deallocate(DstMemberTypeData%Cfr_fb) end if if (allocated(SrcMemberTypeData%CM0_fb)) then LB(1:1) = lbound(SrcMemberTypeData%CM0_fb) @@ -1635,8 +1553,6 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode end if end if DstMemberTypeData%CM0_fb = SrcMemberTypeData%CM0_fb - else if (allocated(DstMemberTypeData%CM0_fb)) then - deallocate(DstMemberTypeData%CM0_fb) end if DstMemberTypeData%MGvolume = SrcMemberTypeData%MGvolume DstMemberTypeData%MDivSize = SrcMemberTypeData%MDivSize @@ -2670,8 +2586,6 @@ subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlC end if end if DstMemberLoadsData%F_D = SrcMemberLoadsData%F_D - else if (allocated(DstMemberLoadsData%F_D)) then - deallocate(DstMemberLoadsData%F_D) end if if (allocated(SrcMemberLoadsData%F_I)) then LB(1:2) = lbound(SrcMemberLoadsData%F_I) @@ -2684,8 +2598,6 @@ subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlC end if end if DstMemberLoadsData%F_I = SrcMemberLoadsData%F_I - else if (allocated(DstMemberLoadsData%F_I)) then - deallocate(DstMemberLoadsData%F_I) end if if (allocated(SrcMemberLoadsData%F_A)) then LB(1:2) = lbound(SrcMemberLoadsData%F_A) @@ -2698,8 +2610,6 @@ subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlC end if end if DstMemberLoadsData%F_A = SrcMemberLoadsData%F_A - else if (allocated(DstMemberLoadsData%F_A)) then - deallocate(DstMemberLoadsData%F_A) end if if (allocated(SrcMemberLoadsData%F_B)) then LB(1:2) = lbound(SrcMemberLoadsData%F_B) @@ -2712,8 +2622,6 @@ subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlC end if end if DstMemberLoadsData%F_B = SrcMemberLoadsData%F_B - else if (allocated(DstMemberLoadsData%F_B)) then - deallocate(DstMemberLoadsData%F_B) end if if (allocated(SrcMemberLoadsData%F_BF)) then LB(1:2) = lbound(SrcMemberLoadsData%F_BF) @@ -2726,8 +2634,6 @@ subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlC end if end if DstMemberLoadsData%F_BF = SrcMemberLoadsData%F_BF - else if (allocated(DstMemberLoadsData%F_BF)) then - deallocate(DstMemberLoadsData%F_BF) end if if (allocated(SrcMemberLoadsData%F_If)) then LB(1:2) = lbound(SrcMemberLoadsData%F_If) @@ -2740,8 +2646,6 @@ subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlC end if end if DstMemberLoadsData%F_If = SrcMemberLoadsData%F_If - else if (allocated(DstMemberLoadsData%F_If)) then - deallocate(DstMemberLoadsData%F_If) end if if (allocated(SrcMemberLoadsData%F_WMG)) then LB(1:2) = lbound(SrcMemberLoadsData%F_WMG) @@ -2754,8 +2658,6 @@ subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlC end if end if DstMemberLoadsData%F_WMG = SrcMemberLoadsData%F_WMG - else if (allocated(DstMemberLoadsData%F_WMG)) then - deallocate(DstMemberLoadsData%F_WMG) end if if (allocated(SrcMemberLoadsData%F_IMG)) then LB(1:2) = lbound(SrcMemberLoadsData%F_IMG) @@ -2768,8 +2670,6 @@ subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlC end if end if DstMemberLoadsData%F_IMG = SrcMemberLoadsData%F_IMG - else if (allocated(DstMemberLoadsData%F_IMG)) then - deallocate(DstMemberLoadsData%F_IMG) end if if (allocated(SrcMemberLoadsData%FV)) then LB(1:2) = lbound(SrcMemberLoadsData%FV) @@ -2782,8 +2682,6 @@ subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlC end if end if DstMemberLoadsData%FV = SrcMemberLoadsData%FV - else if (allocated(DstMemberLoadsData%FV)) then - deallocate(DstMemberLoadsData%FV) end if if (allocated(SrcMemberLoadsData%FA)) then LB(1:2) = lbound(SrcMemberLoadsData%FA) @@ -2796,8 +2694,6 @@ subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlC end if end if DstMemberLoadsData%FA = SrcMemberLoadsData%FA - else if (allocated(DstMemberLoadsData%FA)) then - deallocate(DstMemberLoadsData%FA) end if if (allocated(SrcMemberLoadsData%F_DP)) then LB(1:2) = lbound(SrcMemberLoadsData%F_DP) @@ -2810,8 +2706,6 @@ subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlC end if end if DstMemberLoadsData%F_DP = SrcMemberLoadsData%F_DP - else if (allocated(DstMemberLoadsData%F_DP)) then - deallocate(DstMemberLoadsData%F_DP) end if end subroutine @@ -3310,8 +3204,6 @@ subroutine Morison_CopyMOutput(SrcMOutputData, DstMOutputData, CtrlCode, ErrStat end if end if DstMOutputData%NodeLocs = SrcMOutputData%NodeLocs - else if (allocated(DstMOutputData%NodeLocs)) then - deallocate(DstMOutputData%NodeLocs) end if DstMOutputData%MemberIDIndx = SrcMOutputData%MemberIDIndx if (allocated(SrcMOutputData%MeshIndx1)) then @@ -3325,8 +3217,6 @@ subroutine Morison_CopyMOutput(SrcMOutputData, DstMOutputData, CtrlCode, ErrStat end if end if DstMOutputData%MeshIndx1 = SrcMOutputData%MeshIndx1 - else if (allocated(DstMOutputData%MeshIndx1)) then - deallocate(DstMOutputData%MeshIndx1) end if if (allocated(SrcMOutputData%MeshIndx2)) then LB(1:1) = lbound(SrcMOutputData%MeshIndx2) @@ -3339,8 +3229,6 @@ subroutine Morison_CopyMOutput(SrcMOutputData, DstMOutputData, CtrlCode, ErrStat end if end if DstMOutputData%MeshIndx2 = SrcMOutputData%MeshIndx2 - else if (allocated(DstMOutputData%MeshIndx2)) then - deallocate(DstMOutputData%MeshIndx2) end if if (allocated(SrcMOutputData%MemberIndx1)) then LB(1:1) = lbound(SrcMOutputData%MemberIndx1) @@ -3353,8 +3241,6 @@ subroutine Morison_CopyMOutput(SrcMOutputData, DstMOutputData, CtrlCode, ErrStat end if end if DstMOutputData%MemberIndx1 = SrcMOutputData%MemberIndx1 - else if (allocated(DstMOutputData%MemberIndx1)) then - deallocate(DstMOutputData%MemberIndx1) end if if (allocated(SrcMOutputData%MemberIndx2)) then LB(1:1) = lbound(SrcMOutputData%MemberIndx2) @@ -3367,8 +3253,6 @@ subroutine Morison_CopyMOutput(SrcMOutputData, DstMOutputData, CtrlCode, ErrStat end if end if DstMOutputData%MemberIndx2 = SrcMOutputData%MemberIndx2 - else if (allocated(DstMOutputData%MemberIndx2)) then - deallocate(DstMOutputData%MemberIndx2) end if if (allocated(SrcMOutputData%s)) then LB(1:1) = lbound(SrcMOutputData%s) @@ -3381,8 +3265,6 @@ subroutine Morison_CopyMOutput(SrcMOutputData, DstMOutputData, CtrlCode, ErrStat end if end if DstMOutputData%s = SrcMOutputData%s - else if (allocated(DstMOutputData%s)) then - deallocate(DstMOutputData%s) end if end subroutine @@ -3633,8 +3515,6 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstInitInputData%InpJoints)) then - deallocate(DstInitInputData%InpJoints) end if if (allocated(SrcInitInputData%Nodes)) then LB(1:1) = lbound(SrcInitInputData%Nodes) @@ -3651,8 +3531,6 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstInitInputData%Nodes)) then - deallocate(DstInitInputData%Nodes) end if DstInitInputData%NAxCoefs = SrcInitInputData%NAxCoefs if (allocated(SrcInitInputData%AxialCoefs)) then @@ -3670,8 +3548,6 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstInitInputData%AxialCoefs)) then - deallocate(DstInitInputData%AxialCoefs) end if DstInitInputData%NPropSets = SrcInitInputData%NPropSets if (allocated(SrcInitInputData%MPropSets)) then @@ -3689,8 +3565,6 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstInitInputData%MPropSets)) then - deallocate(DstInitInputData%MPropSets) end if DstInitInputData%SimplCd = SrcInitInputData%SimplCd DstInitInputData%SimplCdMG = SrcInitInputData%SimplCdMG @@ -3723,8 +3597,6 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstInitInputData%CoefDpths)) then - deallocate(DstInitInputData%CoefDpths) end if DstInitInputData%NCoefMembers = SrcInitInputData%NCoefMembers if (allocated(SrcInitInputData%CoefMembers)) then @@ -3742,8 +3614,6 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstInitInputData%CoefMembers)) then - deallocate(DstInitInputData%CoefMembers) end if DstInitInputData%NMembers = SrcInitInputData%NMembers if (allocated(SrcInitInputData%InpMembers)) then @@ -3761,8 +3631,6 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstInitInputData%InpMembers)) then - deallocate(DstInitInputData%InpMembers) end if DstInitInputData%NFillGroups = SrcInitInputData%NFillGroups if (allocated(SrcInitInputData%FilledGroups)) then @@ -3780,8 +3648,6 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstInitInputData%FilledGroups)) then - deallocate(DstInitInputData%FilledGroups) end if DstInitInputData%NMGDepths = SrcInitInputData%NMGDepths if (allocated(SrcInitInputData%MGDepths)) then @@ -3799,8 +3665,6 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstInitInputData%MGDepths)) then - deallocate(DstInitInputData%MGDepths) end if DstInitInputData%MGTop = SrcInitInputData%MGTop DstInitInputData%MGBottom = SrcInitInputData%MGBottom @@ -3820,8 +3684,6 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstInitInputData%MOutLst)) then - deallocate(DstInitInputData%MOutLst) end if DstInitInputData%NJOutputs = SrcInitInputData%NJOutputs if (allocated(SrcInitInputData%JOutLst)) then @@ -3839,8 +3701,6 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstInitInputData%JOutLst)) then - deallocate(DstInitInputData%JOutLst) end if if (allocated(SrcInitInputData%OutList)) then LB(1:1) = lbound(SrcInitInputData%OutList) @@ -3853,8 +3713,6 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E end if end if DstInitInputData%OutList = SrcInitInputData%OutList - else if (allocated(DstInitInputData%OutList)) then - deallocate(DstInitInputData%OutList) end if DstInitInputData%NumOuts = SrcInitInputData%NumOuts DstInitInputData%UnSum = SrcInitInputData%UnSum @@ -4453,8 +4311,6 @@ subroutine Morison_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode end if end if DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr - else if (allocated(DstInitOutputData%WriteOutputHdr)) then - deallocate(DstInitOutputData%WriteOutputHdr) end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) @@ -4467,8 +4323,6 @@ subroutine Morison_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode end if end if DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt - else if (allocated(DstInitOutputData%WriteOutputUnt)) then - deallocate(DstInitOutputData%WriteOutputUnt) end if end subroutine @@ -4604,8 +4458,6 @@ subroutine Morison_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, E end if end if DstDiscStateData%V_rel_n_FiltStat = SrcDiscStateData%V_rel_n_FiltStat - else if (allocated(DstDiscStateData%V_rel_n_FiltStat)) then - deallocate(DstDiscStateData%V_rel_n_FiltStat) end if end subroutine @@ -4760,8 +4612,6 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%FV = SrcMiscData%FV - else if (allocated(DstMiscData%FV)) then - deallocate(DstMiscData%FV) end if if (allocated(SrcMiscData%FA)) then LB(1:2) = lbound(SrcMiscData%FA) @@ -4774,8 +4624,6 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%FA = SrcMiscData%FA - else if (allocated(DstMiscData%FA)) then - deallocate(DstMiscData%FA) end if if (allocated(SrcMiscData%FAMCF)) then LB(1:2) = lbound(SrcMiscData%FAMCF) @@ -4788,8 +4636,6 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%FAMCF = SrcMiscData%FAMCF - else if (allocated(DstMiscData%FAMCF)) then - deallocate(DstMiscData%FAMCF) end if if (allocated(SrcMiscData%FDynP)) then LB(1:1) = lbound(SrcMiscData%FDynP) @@ -4802,8 +4648,6 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%FDynP = SrcMiscData%FDynP - else if (allocated(DstMiscData%FDynP)) then - deallocate(DstMiscData%FDynP) end if if (allocated(SrcMiscData%WaveElev)) then LB(1:1) = lbound(SrcMiscData%WaveElev) @@ -4816,8 +4660,6 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%WaveElev = SrcMiscData%WaveElev - else if (allocated(DstMiscData%WaveElev)) then - deallocate(DstMiscData%WaveElev) end if if (allocated(SrcMiscData%WaveElev1)) then LB(1:1) = lbound(SrcMiscData%WaveElev1) @@ -4830,8 +4672,6 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%WaveElev1 = SrcMiscData%WaveElev1 - else if (allocated(DstMiscData%WaveElev1)) then - deallocate(DstMiscData%WaveElev1) end if if (allocated(SrcMiscData%WaveElev2)) then LB(1:1) = lbound(SrcMiscData%WaveElev2) @@ -4844,8 +4684,6 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%WaveElev2 = SrcMiscData%WaveElev2 - else if (allocated(DstMiscData%WaveElev2)) then - deallocate(DstMiscData%WaveElev2) end if if (allocated(SrcMiscData%vrel)) then LB(1:2) = lbound(SrcMiscData%vrel) @@ -4858,8 +4696,6 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%vrel = SrcMiscData%vrel - else if (allocated(DstMiscData%vrel)) then - deallocate(DstMiscData%vrel) end if if (allocated(SrcMiscData%nodeInWater)) then LB(1:1) = lbound(SrcMiscData%nodeInWater) @@ -4872,8 +4708,6 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%nodeInWater = SrcMiscData%nodeInWater - else if (allocated(DstMiscData%nodeInWater)) then - deallocate(DstMiscData%nodeInWater) end if if (allocated(SrcMiscData%memberLoads)) then LB(1:1) = lbound(SrcMiscData%memberLoads) @@ -4890,8 +4724,6 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstMiscData%memberLoads)) then - deallocate(DstMiscData%memberLoads) end if if (allocated(SrcMiscData%F_B_End)) then LB(1:2) = lbound(SrcMiscData%F_B_End) @@ -4904,8 +4736,6 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%F_B_End = SrcMiscData%F_B_End - else if (allocated(DstMiscData%F_B_End)) then - deallocate(DstMiscData%F_B_End) end if if (allocated(SrcMiscData%F_D_End)) then LB(1:2) = lbound(SrcMiscData%F_D_End) @@ -4918,8 +4748,6 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%F_D_End = SrcMiscData%F_D_End - else if (allocated(DstMiscData%F_D_End)) then - deallocate(DstMiscData%F_D_End) end if if (allocated(SrcMiscData%F_I_End)) then LB(1:2) = lbound(SrcMiscData%F_I_End) @@ -4932,8 +4760,6 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%F_I_End = SrcMiscData%F_I_End - else if (allocated(DstMiscData%F_I_End)) then - deallocate(DstMiscData%F_I_End) end if if (allocated(SrcMiscData%F_IMG_End)) then LB(1:2) = lbound(SrcMiscData%F_IMG_End) @@ -4946,8 +4772,6 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%F_IMG_End = SrcMiscData%F_IMG_End - else if (allocated(DstMiscData%F_IMG_End)) then - deallocate(DstMiscData%F_IMG_End) end if if (allocated(SrcMiscData%F_A_End)) then LB(1:2) = lbound(SrcMiscData%F_A_End) @@ -4960,8 +4784,6 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%F_A_End = SrcMiscData%F_A_End - else if (allocated(DstMiscData%F_A_End)) then - deallocate(DstMiscData%F_A_End) end if if (allocated(SrcMiscData%F_BF_End)) then LB(1:2) = lbound(SrcMiscData%F_BF_End) @@ -4974,8 +4796,6 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%F_BF_End = SrcMiscData%F_BF_End - else if (allocated(DstMiscData%F_BF_End)) then - deallocate(DstMiscData%F_BF_End) end if if (allocated(SrcMiscData%V_rel_n)) then LB(1:1) = lbound(SrcMiscData%V_rel_n) @@ -4988,8 +4808,6 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%V_rel_n = SrcMiscData%V_rel_n - else if (allocated(DstMiscData%V_rel_n)) then - deallocate(DstMiscData%V_rel_n) end if if (allocated(SrcMiscData%V_rel_n_HiPass)) then LB(1:1) = lbound(SrcMiscData%V_rel_n_HiPass) @@ -5002,8 +4820,6 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%V_rel_n_HiPass = SrcMiscData%V_rel_n_HiPass - else if (allocated(DstMiscData%V_rel_n_HiPass)) then - deallocate(DstMiscData%V_rel_n_HiPass) end if DstMiscData%LastIndWave = SrcMiscData%LastIndWave end subroutine @@ -5488,8 +5304,6 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstParamData%Members)) then - deallocate(DstParamData%Members) end if DstParamData%NNodes = SrcParamData%NNodes DstParamData%NJoints = SrcParamData%NJoints @@ -5504,8 +5318,6 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end if end if DstParamData%I_MG_End = SrcParamData%I_MG_End - else if (allocated(DstParamData%I_MG_End)) then - deallocate(DstParamData%I_MG_End) end if if (allocated(SrcParamData%An_End)) then LB(1:2) = lbound(SrcParamData%An_End) @@ -5518,8 +5330,6 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end if end if DstParamData%An_End = SrcParamData%An_End - else if (allocated(DstParamData%An_End)) then - deallocate(DstParamData%An_End) end if if (allocated(SrcParamData%DragConst_End)) then LB(1:1) = lbound(SrcParamData%DragConst_End) @@ -5532,8 +5342,6 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end if end if DstParamData%DragConst_End = SrcParamData%DragConst_End - else if (allocated(DstParamData%DragConst_End)) then - deallocate(DstParamData%DragConst_End) end if if (allocated(SrcParamData%VRelNFiltConst)) then LB(1:1) = lbound(SrcParamData%VRelNFiltConst) @@ -5546,8 +5354,6 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end if end if DstParamData%VRelNFiltConst = SrcParamData%VRelNFiltConst - else if (allocated(DstParamData%VRelNFiltConst)) then - deallocate(DstParamData%VRelNFiltConst) end if if (allocated(SrcParamData%DragMod_End)) then LB(1:1) = lbound(SrcParamData%DragMod_End) @@ -5560,8 +5366,6 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end if end if DstParamData%DragMod_End = SrcParamData%DragMod_End - else if (allocated(DstParamData%DragMod_End)) then - deallocate(DstParamData%DragMod_End) end if if (allocated(SrcParamData%DragLoFSc_End)) then LB(1:1) = lbound(SrcParamData%DragLoFSc_End) @@ -5574,8 +5378,6 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end if end if DstParamData%DragLoFSc_End = SrcParamData%DragLoFSc_End - else if (allocated(DstParamData%DragLoFSc_End)) then - deallocate(DstParamData%DragLoFSc_End) end if if (allocated(SrcParamData%F_WMG_End)) then LB(1:2) = lbound(SrcParamData%F_WMG_End) @@ -5588,8 +5390,6 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end if end if DstParamData%F_WMG_End = SrcParamData%F_WMG_End - else if (allocated(DstParamData%F_WMG_End)) then - deallocate(DstParamData%F_WMG_End) end if if (allocated(SrcParamData%DP_Const_End)) then LB(1:2) = lbound(SrcParamData%DP_Const_End) @@ -5602,8 +5402,6 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end if end if DstParamData%DP_Const_End = SrcParamData%DP_Const_End - else if (allocated(DstParamData%DP_Const_End)) then - deallocate(DstParamData%DP_Const_End) end if if (allocated(SrcParamData%Mass_MG_End)) then LB(1:1) = lbound(SrcParamData%Mass_MG_End) @@ -5616,8 +5414,6 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end if end if DstParamData%Mass_MG_End = SrcParamData%Mass_MG_End - else if (allocated(DstParamData%Mass_MG_End)) then - deallocate(DstParamData%Mass_MG_End) end if if (allocated(SrcParamData%AM_End)) then LB(1:3) = lbound(SrcParamData%AM_End) @@ -5630,8 +5426,6 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end if end if DstParamData%AM_End = SrcParamData%AM_End - else if (allocated(DstParamData%AM_End)) then - deallocate(DstParamData%AM_End) end if DstParamData%NStepWave = SrcParamData%NStepWave DstParamData%NMOutputs = SrcParamData%NMOutputs @@ -5650,8 +5444,6 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstParamData%MOutLst)) then - deallocate(DstParamData%MOutLst) end if DstParamData%NJOutputs = SrcParamData%NJOutputs if (allocated(SrcParamData%JOutLst)) then @@ -5669,8 +5461,6 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstParamData%JOutLst)) then - deallocate(DstParamData%JOutLst) end if if (allocated(SrcParamData%OutParam)) then LB(1:1) = lbound(SrcParamData%OutParam) @@ -5687,8 +5477,6 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstParamData%OutParam)) then - deallocate(DstParamData%OutParam) end if DstParamData%NumOuts = SrcParamData%NumOuts DstParamData%WaveStMod = SrcParamData%WaveStMod @@ -6229,8 +6017,6 @@ subroutine Morison_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, E end if end if DstOutputData%WriteOutput = SrcOutputData%WriteOutput - else if (allocated(DstOutputData%WriteOutput)) then - deallocate(DstOutputData%WriteOutput) end if end subroutine diff --git a/modules/hydrodyn/src/SS_Excitation_Types.f90 b/modules/hydrodyn/src/SS_Excitation_Types.f90 index 4c77b9f8ea..7483a4f7ec 100644 --- a/modules/hydrodyn/src/SS_Excitation_Types.f90 +++ b/modules/hydrodyn/src/SS_Excitation_Types.f90 @@ -140,8 +140,6 @@ subroutine SS_Exc_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er end if end if DstInitInputData%PtfmRefztRot = SrcInitInputData%PtfmRefztRot - else if (allocated(DstInitInputData%PtfmRefztRot)) then - deallocate(DstInitInputData%PtfmRefztRot) end if DstInitInputData%WaveElev0 => SrcInitInputData%WaveElev0 DstInitInputData%WaveElev1 => SrcInitInputData%WaveElev1 @@ -345,8 +343,6 @@ subroutine SS_Exc_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, end if end if DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr - else if (allocated(DstInitOutputData%WriteOutputHdr)) then - deallocate(DstInitOutputData%WriteOutputHdr) end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) @@ -359,8 +355,6 @@ subroutine SS_Exc_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, end if end if DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt - else if (allocated(DstInitOutputData%WriteOutputUnt)) then - deallocate(DstInitOutputData%WriteOutputUnt) end if end subroutine @@ -457,8 +451,6 @@ subroutine SS_Exc_CopyContState(SrcContStateData, DstContStateData, CtrlCode, Er end if end if DstContStateData%x = SrcContStateData%x - else if (allocated(DstContStateData%x)) then - deallocate(DstContStateData%x) end if end subroutine @@ -740,8 +732,6 @@ subroutine SS_Exc_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs end if end if DstParamData%spDOF = SrcParamData%spDOF - else if (allocated(DstParamData%spDOF)) then - deallocate(DstParamData%spDOF) end if if (allocated(SrcParamData%A)) then LB(1:2) = lbound(SrcParamData%A) @@ -754,8 +744,6 @@ subroutine SS_Exc_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs end if end if DstParamData%A = SrcParamData%A - else if (allocated(DstParamData%A)) then - deallocate(DstParamData%A) end if if (allocated(SrcParamData%B)) then LB(1:1) = lbound(SrcParamData%B) @@ -768,8 +756,6 @@ subroutine SS_Exc_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs end if end if DstParamData%B = SrcParamData%B - else if (allocated(DstParamData%B)) then - deallocate(DstParamData%B) end if if (allocated(SrcParamData%C)) then LB(1:2) = lbound(SrcParamData%C) @@ -782,8 +768,6 @@ subroutine SS_Exc_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs end if end if DstParamData%C = SrcParamData%C - else if (allocated(DstParamData%C)) then - deallocate(DstParamData%C) end if DstParamData%numStates = SrcParamData%numStates DstParamData%Tc = SrcParamData%Tc @@ -1058,8 +1042,6 @@ subroutine SS_Exc_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMs end if end if DstInputData%PtfmPos = SrcInputData%PtfmPos - else if (allocated(DstInputData%PtfmPos)) then - deallocate(DstInputData%PtfmPos) end if end subroutine @@ -1134,8 +1116,6 @@ subroutine SS_Exc_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Er end if end if DstOutputData%y = SrcOutputData%y - else if (allocated(DstOutputData%y)) then - deallocate(DstOutputData%y) end if if (allocated(SrcOutputData%WriteOutput)) then LB(1:1) = lbound(SrcOutputData%WriteOutput) @@ -1148,8 +1128,6 @@ subroutine SS_Exc_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Er end if end if DstOutputData%WriteOutput = SrcOutputData%WriteOutput - else if (allocated(DstOutputData%WriteOutput)) then - deallocate(DstOutputData%WriteOutput) end if end subroutine diff --git a/modules/hydrodyn/src/SS_Radiation_Types.f90 b/modules/hydrodyn/src/SS_Radiation_Types.f90 index 13c2115bdc..949691c7bb 100644 --- a/modules/hydrodyn/src/SS_Radiation_Types.f90 +++ b/modules/hydrodyn/src/SS_Radiation_Types.f90 @@ -120,8 +120,6 @@ subroutine SS_Rad_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er end if end if DstInitInputData%enabledDOFs = SrcInitInputData%enabledDOFs - else if (allocated(DstInitInputData%enabledDOFs)) then - deallocate(DstInitInputData%enabledDOFs) end if DstInitInputData%NBody = SrcInitInputData%NBody if (allocated(SrcInitInputData%PtfmRefztRot)) then @@ -135,8 +133,6 @@ subroutine SS_Rad_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er end if end if DstInitInputData%PtfmRefztRot = SrcInitInputData%PtfmRefztRot - else if (allocated(DstInitInputData%PtfmRefztRot)) then - deallocate(DstInitInputData%PtfmRefztRot) end if end subroutine @@ -239,8 +235,6 @@ subroutine SS_Rad_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, end if end if DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr - else if (allocated(DstInitOutputData%WriteOutputHdr)) then - deallocate(DstInitOutputData%WriteOutputHdr) end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) @@ -253,8 +247,6 @@ subroutine SS_Rad_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, end if end if DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt - else if (allocated(DstInitOutputData%WriteOutputUnt)) then - deallocate(DstInitOutputData%WriteOutputUnt) end if end subroutine @@ -351,8 +343,6 @@ subroutine SS_Rad_CopyContState(SrcContStateData, DstContStateData, CtrlCode, Er end if end if DstContStateData%x = SrcContStateData%x - else if (allocated(DstContStateData%x)) then - deallocate(DstContStateData%x) end if end subroutine @@ -619,8 +609,6 @@ subroutine SS_Rad_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs end if end if DstParamData%A = SrcParamData%A - else if (allocated(DstParamData%A)) then - deallocate(DstParamData%A) end if if (allocated(SrcParamData%B)) then LB(1:2) = lbound(SrcParamData%B) @@ -633,8 +621,6 @@ subroutine SS_Rad_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs end if end if DstParamData%B = SrcParamData%B - else if (allocated(DstParamData%B)) then - deallocate(DstParamData%B) end if if (allocated(SrcParamData%C)) then LB(1:2) = lbound(SrcParamData%C) @@ -647,8 +633,6 @@ subroutine SS_Rad_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs end if end if DstParamData%C = SrcParamData%C - else if (allocated(DstParamData%C)) then - deallocate(DstParamData%C) end if DstParamData%numStates = SrcParamData%numStates if (allocated(SrcParamData%spdof)) then @@ -662,8 +646,6 @@ subroutine SS_Rad_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs end if end if DstParamData%spdof = SrcParamData%spdof - else if (allocated(DstParamData%spdof)) then - deallocate(DstParamData%spdof) end if DstParamData%NBody = SrcParamData%NBody end subroutine @@ -814,8 +796,6 @@ subroutine SS_Rad_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMs end if end if DstInputData%dq = SrcInputData%dq - else if (allocated(DstInputData%dq)) then - deallocate(DstInputData%dq) end if end subroutine @@ -890,8 +870,6 @@ subroutine SS_Rad_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Er end if end if DstOutputData%y = SrcOutputData%y - else if (allocated(DstOutputData%y)) then - deallocate(DstOutputData%y) end if if (allocated(SrcOutputData%WriteOutput)) then LB(1:1) = lbound(SrcOutputData%WriteOutput) @@ -904,8 +882,6 @@ subroutine SS_Rad_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Er end if end if DstOutputData%WriteOutput = SrcOutputData%WriteOutput - else if (allocated(DstOutputData%WriteOutput)) then - deallocate(DstOutputData%WriteOutput) end if end subroutine diff --git a/modules/hydrodyn/src/WAMIT2_Types.f90 b/modules/hydrodyn/src/WAMIT2_Types.f90 index 5b60d16902..0896dc4bd9 100644 --- a/modules/hydrodyn/src/WAMIT2_Types.f90 +++ b/modules/hydrodyn/src/WAMIT2_Types.f90 @@ -130,8 +130,6 @@ subroutine WAMIT2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er end if end if DstInitInputData%PtfmRefxt = SrcInitInputData%PtfmRefxt - else if (allocated(DstInitInputData%PtfmRefxt)) then - deallocate(DstInitInputData%PtfmRefxt) end if if (allocated(SrcInitInputData%PtfmRefyt)) then LB(1:1) = lbound(SrcInitInputData%PtfmRefyt) @@ -144,8 +142,6 @@ subroutine WAMIT2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er end if end if DstInitInputData%PtfmRefyt = SrcInitInputData%PtfmRefyt - else if (allocated(DstInitInputData%PtfmRefyt)) then - deallocate(DstInitInputData%PtfmRefyt) end if if (allocated(SrcInitInputData%PtfmRefzt)) then LB(1:1) = lbound(SrcInitInputData%PtfmRefzt) @@ -158,8 +154,6 @@ subroutine WAMIT2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er end if end if DstInitInputData%PtfmRefzt = SrcInitInputData%PtfmRefzt - else if (allocated(DstInitInputData%PtfmRefzt)) then - deallocate(DstInitInputData%PtfmRefzt) end if if (allocated(SrcInitInputData%PtfmRefztRot)) then LB(1:1) = lbound(SrcInitInputData%PtfmRefztRot) @@ -172,8 +166,6 @@ subroutine WAMIT2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er end if end if DstInitInputData%PtfmRefztRot = SrcInitInputData%PtfmRefztRot - else if (allocated(DstInitInputData%PtfmRefztRot)) then - deallocate(DstInitInputData%PtfmRefztRot) end if DstInitInputData%WAMITULEN = SrcInitInputData%WAMITULEN DstInitInputData%RhoXg = SrcInitInputData%RhoXg @@ -505,8 +497,6 @@ subroutine WAMIT2_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%LastIndWave = SrcMiscData%LastIndWave - else if (allocated(DstMiscData%LastIndWave)) then - deallocate(DstMiscData%LastIndWave) end if if (allocated(SrcMiscData%F_Waves2)) then LB(1:1) = lbound(SrcMiscData%F_Waves2) @@ -519,8 +509,6 @@ subroutine WAMIT2_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%F_Waves2 = SrcMiscData%F_Waves2 - else if (allocated(DstMiscData%F_Waves2)) then - deallocate(DstMiscData%F_Waves2) end if end subroutine @@ -620,8 +608,6 @@ subroutine WAMIT2_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs end if end if DstParamData%WaveExctn2 = SrcParamData%WaveExctn2 - else if (allocated(DstParamData%WaveExctn2)) then - deallocate(DstParamData%WaveExctn2) end if DstParamData%MnDriftDims = SrcParamData%MnDriftDims DstParamData%NewmanAppDims = SrcParamData%NewmanAppDims diff --git a/modules/hydrodyn/src/WAMIT_Types.f90 b/modules/hydrodyn/src/WAMIT_Types.f90 index 729dc43f47..be9b4d4e76 100644 --- a/modules/hydrodyn/src/WAMIT_Types.f90 +++ b/modules/hydrodyn/src/WAMIT_Types.f90 @@ -185,8 +185,6 @@ subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err end if end if DstInitInputData%PtfmVol0 = SrcInitInputData%PtfmVol0 - else if (allocated(DstInitInputData%PtfmVol0)) then - deallocate(DstInitInputData%PtfmVol0) end if DstInitInputData%HasWAMIT = SrcInitInputData%HasWAMIT DstInitInputData%WAMITULEN = SrcInitInputData%WAMITULEN @@ -201,8 +199,6 @@ subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err end if end if DstInitInputData%PtfmRefxt = SrcInitInputData%PtfmRefxt - else if (allocated(DstInitInputData%PtfmRefxt)) then - deallocate(DstInitInputData%PtfmRefxt) end if if (allocated(SrcInitInputData%PtfmRefyt)) then LB(1:1) = lbound(SrcInitInputData%PtfmRefyt) @@ -215,8 +211,6 @@ subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err end if end if DstInitInputData%PtfmRefyt = SrcInitInputData%PtfmRefyt - else if (allocated(DstInitInputData%PtfmRefyt)) then - deallocate(DstInitInputData%PtfmRefyt) end if if (allocated(SrcInitInputData%PtfmRefzt)) then LB(1:1) = lbound(SrcInitInputData%PtfmRefzt) @@ -229,8 +223,6 @@ subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err end if end if DstInitInputData%PtfmRefzt = SrcInitInputData%PtfmRefzt - else if (allocated(DstInitInputData%PtfmRefzt)) then - deallocate(DstInitInputData%PtfmRefzt) end if if (allocated(SrcInitInputData%PtfmRefztRot)) then LB(1:1) = lbound(SrcInitInputData%PtfmRefztRot) @@ -243,8 +235,6 @@ subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err end if end if DstInitInputData%PtfmRefztRot = SrcInitInputData%PtfmRefztRot - else if (allocated(DstInitInputData%PtfmRefztRot)) then - deallocate(DstInitInputData%PtfmRefztRot) end if if (allocated(SrcInitInputData%PtfmCOBxt)) then LB(1:1) = lbound(SrcInitInputData%PtfmCOBxt) @@ -257,8 +247,6 @@ subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err end if end if DstInitInputData%PtfmCOBxt = SrcInitInputData%PtfmCOBxt - else if (allocated(DstInitInputData%PtfmCOBxt)) then - deallocate(DstInitInputData%PtfmCOBxt) end if if (allocated(SrcInitInputData%PtfmCOByt)) then LB(1:1) = lbound(SrcInitInputData%PtfmCOByt) @@ -271,8 +259,6 @@ subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err end if end if DstInitInputData%PtfmCOByt = SrcInitInputData%PtfmCOByt - else if (allocated(DstInitInputData%PtfmCOByt)) then - deallocate(DstInitInputData%PtfmCOByt) end if DstInitInputData%RdtnMod = SrcInitInputData%RdtnMod DstInitInputData%ExctnMod = SrcInitInputData%ExctnMod @@ -850,8 +836,6 @@ subroutine WAMIT_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, Err end if end if DstDiscStateData%BdyPosFilt = SrcDiscStateData%BdyPosFilt - else if (allocated(DstDiscStateData%BdyPosFilt)) then - deallocate(DstDiscStateData%BdyPosFilt) end if end subroutine @@ -1062,8 +1046,6 @@ subroutine WAMIT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%F_HS = SrcMiscData%F_HS - else if (allocated(DstMiscData%F_HS)) then - deallocate(DstMiscData%F_HS) end if if (allocated(SrcMiscData%F_Waves1)) then LB(1:1) = lbound(SrcMiscData%F_Waves1) @@ -1076,8 +1058,6 @@ subroutine WAMIT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%F_Waves1 = SrcMiscData%F_Waves1 - else if (allocated(DstMiscData%F_Waves1)) then - deallocate(DstMiscData%F_Waves1) end if if (allocated(SrcMiscData%F_Rdtn)) then LB(1:1) = lbound(SrcMiscData%F_Rdtn) @@ -1090,8 +1070,6 @@ subroutine WAMIT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%F_Rdtn = SrcMiscData%F_Rdtn - else if (allocated(DstMiscData%F_Rdtn)) then - deallocate(DstMiscData%F_Rdtn) end if if (allocated(SrcMiscData%F_PtfmAM)) then LB(1:1) = lbound(SrcMiscData%F_PtfmAM) @@ -1104,8 +1082,6 @@ subroutine WAMIT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%F_PtfmAM = SrcMiscData%F_PtfmAM - else if (allocated(DstMiscData%F_PtfmAM)) then - deallocate(DstMiscData%F_PtfmAM) end if call SS_Rad_CopyMisc(SrcMiscData%SS_Rdtn, DstMiscData%SS_Rdtn, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1324,8 +1300,6 @@ subroutine WAMIT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg end if end if DstParamData%F_HS_Moment_Offset = SrcParamData%F_HS_Moment_Offset - else if (allocated(DstParamData%F_HS_Moment_Offset)) then - deallocate(DstParamData%F_HS_Moment_Offset) end if if (allocated(SrcParamData%HdroAdMsI)) then LB(1:2) = lbound(SrcParamData%HdroAdMsI) @@ -1338,8 +1312,6 @@ subroutine WAMIT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg end if end if DstParamData%HdroAdMsI = SrcParamData%HdroAdMsI - else if (allocated(DstParamData%HdroAdMsI)) then - deallocate(DstParamData%HdroAdMsI) end if if (allocated(SrcParamData%HdroSttc)) then LB(1:2) = lbound(SrcParamData%HdroSttc) @@ -1352,8 +1324,6 @@ subroutine WAMIT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg end if end if DstParamData%HdroSttc = SrcParamData%HdroSttc - else if (allocated(DstParamData%HdroSttc)) then - deallocate(DstParamData%HdroSttc) end if DstParamData%RdtnMod = SrcParamData%RdtnMod DstParamData%ExctnMod = SrcParamData%ExctnMod @@ -1371,8 +1341,6 @@ subroutine WAMIT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg end if end if DstParamData%WaveExctn = SrcParamData%WaveExctn - else if (allocated(DstParamData%WaveExctn)) then - deallocate(DstParamData%WaveExctn) end if if (allocated(SrcParamData%WaveExctnGrid)) then LB(1:4) = lbound(SrcParamData%WaveExctnGrid) @@ -1385,8 +1353,6 @@ subroutine WAMIT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg end if end if DstParamData%WaveExctnGrid = SrcParamData%WaveExctnGrid - else if (allocated(DstParamData%WaveExctnGrid)) then - deallocate(DstParamData%WaveExctnGrid) end if DstParamData%NStepWave = SrcParamData%NStepWave call Conv_Rdtn_CopyParam(SrcParamData%Conv_Rdtn, DstParamData%Conv_Rdtn, CtrlCode, ErrStat2, ErrMsg2) diff --git a/modules/icedyn/src/IceDyn_Types.f90 b/modules/icedyn/src/IceDyn_Types.f90 index 242a9431cc..9379abb975 100644 --- a/modules/icedyn/src/IceDyn_Types.f90 +++ b/modules/icedyn/src/IceDyn_Types.f90 @@ -259,8 +259,6 @@ subroutine IceD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS end if end if DstInputFileData%LegPosX = SrcInputFileData%LegPosX - else if (allocated(DstInputFileData%LegPosX)) then - deallocate(DstInputFileData%LegPosX) end if if (allocated(SrcInputFileData%LegPosY)) then LB(1:1) = lbound(SrcInputFileData%LegPosY) @@ -273,8 +271,6 @@ subroutine IceD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS end if end if DstInputFileData%LegPosY = SrcInputFileData%LegPosY - else if (allocated(DstInputFileData%LegPosY)) then - deallocate(DstInputFileData%LegPosY) end if if (allocated(SrcInputFileData%StrWd)) then LB(1:1) = lbound(SrcInputFileData%StrWd) @@ -287,8 +283,6 @@ subroutine IceD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS end if end if DstInputFileData%StrWd = SrcInputFileData%StrWd - else if (allocated(DstInputFileData%StrWd)) then - deallocate(DstInputFileData%StrWd) end if DstInputFileData%Ikm = SrcInputFileData%Ikm DstInputFileData%Ag = SrcInputFileData%Ag @@ -688,8 +682,6 @@ subroutine IceD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E end if end if DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr - else if (allocated(DstInitOutputData%WriteOutputHdr)) then - deallocate(DstInitOutputData%WriteOutputHdr) end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) @@ -702,8 +694,6 @@ subroutine IceD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E end if end if DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt - else if (allocated(DstInitOutputData%WriteOutputUnt)) then - deallocate(DstInitOutputData%WriteOutputUnt) end if DstInitOutputData%numLegs = SrcInitOutputData%numLegs call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) @@ -937,8 +927,6 @@ subroutine IceD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E end if end if DstOtherStateData%Nc = SrcOtherStateData%Nc - else if (allocated(DstOtherStateData%Nc)) then - deallocate(DstOtherStateData%Nc) end if if (allocated(SrcOtherStateData%Psum)) then LB(1:1) = lbound(SrcOtherStateData%Psum) @@ -951,8 +939,6 @@ subroutine IceD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E end if end if DstOtherStateData%Psum = SrcOtherStateData%Psum - else if (allocated(DstOtherStateData%Psum)) then - deallocate(DstOtherStateData%Psum) end if if (allocated(SrcOtherStateData%IceTthNo)) then LB(1:1) = lbound(SrcOtherStateData%IceTthNo) @@ -965,8 +951,6 @@ subroutine IceD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E end if end if DstOtherStateData%IceTthNo = SrcOtherStateData%IceTthNo - else if (allocated(DstOtherStateData%IceTthNo)) then - deallocate(DstOtherStateData%IceTthNo) end if DstOtherStateData%Beta = SrcOtherStateData%Beta DstOtherStateData%Tinit = SrcOtherStateData%Tinit @@ -987,8 +971,6 @@ subroutine IceD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstOtherStateData%xdot)) then - deallocate(DstOtherStateData%xdot) end if DstOtherStateData%n = SrcOtherStateData%n end subroutine @@ -1219,8 +1201,6 @@ subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%OutName = SrcParamData%OutName - else if (allocated(DstParamData%OutName)) then - deallocate(DstParamData%OutName) end if if (allocated(SrcParamData%OutUnit)) then LB(1:1) = lbound(SrcParamData%OutUnit) @@ -1233,8 +1213,6 @@ subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%OutUnit = SrcParamData%OutUnit - else if (allocated(DstParamData%OutUnit)) then - deallocate(DstParamData%OutUnit) end if DstParamData%RootName = SrcParamData%RootName DstParamData%tm1a = SrcParamData%tm1a @@ -1260,8 +1238,6 @@ subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%rdmFm = SrcParamData%rdmFm - else if (allocated(DstParamData%rdmFm)) then - deallocate(DstParamData%rdmFm) end if if (allocated(SrcParamData%rdmt0)) then LB(1:1) = lbound(SrcParamData%rdmt0) @@ -1274,8 +1250,6 @@ subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%rdmt0 = SrcParamData%rdmt0 - else if (allocated(DstParamData%rdmt0)) then - deallocate(DstParamData%rdmt0) end if if (allocated(SrcParamData%rdmtm)) then LB(1:1) = lbound(SrcParamData%rdmtm) @@ -1288,8 +1262,6 @@ subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%rdmtm = SrcParamData%rdmtm - else if (allocated(DstParamData%rdmtm)) then - deallocate(DstParamData%rdmtm) end if if (allocated(SrcParamData%rdmDm)) then LB(1:1) = lbound(SrcParamData%rdmDm) @@ -1302,8 +1274,6 @@ subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%rdmDm = SrcParamData%rdmDm - else if (allocated(DstParamData%rdmDm)) then - deallocate(DstParamData%rdmDm) end if if (allocated(SrcParamData%rdmP)) then LB(1:1) = lbound(SrcParamData%rdmP) @@ -1316,8 +1286,6 @@ subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%rdmP = SrcParamData%rdmP - else if (allocated(DstParamData%rdmP)) then - deallocate(DstParamData%rdmP) end if if (allocated(SrcParamData%rdmKi)) then LB(1:1) = lbound(SrcParamData%rdmKi) @@ -1330,8 +1298,6 @@ subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%rdmKi = SrcParamData%rdmKi - else if (allocated(DstParamData%rdmKi)) then - deallocate(DstParamData%rdmKi) end if DstParamData%ZonePitch = SrcParamData%ZonePitch DstParamData%Kice = SrcParamData%Kice @@ -1347,8 +1313,6 @@ subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%Y0 = SrcParamData%Y0 - else if (allocated(DstParamData%Y0)) then - deallocate(DstParamData%Y0) end if if (allocated(SrcParamData%ContPrfl)) then LB(1:1) = lbound(SrcParamData%ContPrfl) @@ -1361,8 +1325,6 @@ subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%ContPrfl = SrcParamData%ContPrfl - else if (allocated(DstParamData%ContPrfl)) then - deallocate(DstParamData%ContPrfl) end if DstParamData%Zn = SrcParamData%Zn DstParamData%rhoi = SrcParamData%rhoi @@ -1847,8 +1809,6 @@ subroutine IceD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM end if end if DstOutputData%WriteOutput = SrcOutputData%WriteOutput - else if (allocated(DstOutputData%WriteOutput)) then - deallocate(DstOutputData%WriteOutput) end if end subroutine diff --git a/modules/icefloe/src/icefloe/IceFloe_Types.f90 b/modules/icefloe/src/icefloe/IceFloe_Types.f90 index 64f3deffe5..aec91404d5 100644 --- a/modules/icefloe/src/icefloe/IceFloe_Types.f90 +++ b/modules/icefloe/src/icefloe/IceFloe_Types.f90 @@ -188,8 +188,6 @@ subroutine IceFloe_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode end if end if DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr - else if (allocated(DstInitOutputData%WriteOutputHdr)) then - deallocate(DstInitOutputData%WriteOutputHdr) end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) @@ -202,8 +200,6 @@ subroutine IceFloe_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode end if end if DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt - else if (allocated(DstInitOutputData%WriteOutputUnt)) then - deallocate(DstInitOutputData%WriteOutputUnt) end if call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -504,8 +500,6 @@ subroutine IceFloe_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end if end if DstParamData%loadSeries = SrcParamData%loadSeries - else if (allocated(DstParamData%loadSeries)) then - deallocate(DstParamData%loadSeries) end if DstParamData%iceVel = SrcParamData%iceVel DstParamData%iceDirection = SrcParamData%iceDirection @@ -528,8 +522,6 @@ subroutine IceFloe_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end if end if DstParamData%legX = SrcParamData%legX - else if (allocated(DstParamData%legX)) then - deallocate(DstParamData%legX) end if if (allocated(SrcParamData%legY)) then LB(1:1) = lbound(SrcParamData%legY) @@ -542,8 +534,6 @@ subroutine IceFloe_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end if end if DstParamData%legY = SrcParamData%legY - else if (allocated(DstParamData%legY)) then - deallocate(DstParamData%legY) end if if (allocated(SrcParamData%ks)) then LB(1:1) = lbound(SrcParamData%ks) @@ -556,8 +546,6 @@ subroutine IceFloe_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end if end if DstParamData%ks = SrcParamData%ks - else if (allocated(DstParamData%ks)) then - deallocate(DstParamData%ks) end if DstParamData%numLegs = SrcParamData%numLegs DstParamData%iceType = SrcParamData%iceType @@ -798,8 +786,6 @@ subroutine IceFloe_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, E end if end if DstOutputData%WriteOutput = SrcOutputData%WriteOutput - else if (allocated(DstOutputData%WriteOutput)) then - deallocate(DstOutputData%WriteOutput) end if end subroutine diff --git a/modules/inflowwind/src/IfW_FlowField_Types.f90 b/modules/inflowwind/src/IfW_FlowField_Types.f90 index 49ef03af3f..68ef3eef0b 100644 --- a/modules/inflowwind/src/IfW_FlowField_Types.f90 +++ b/modules/inflowwind/src/IfW_FlowField_Types.f90 @@ -192,8 +192,6 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor end if end if DstUniformFieldTypeData%Time = SrcUniformFieldTypeData%Time - else if (allocated(DstUniformFieldTypeData%Time)) then - deallocate(DstUniformFieldTypeData%Time) end if if (allocated(SrcUniformFieldTypeData%VelH)) then LB(1:1) = lbound(SrcUniformFieldTypeData%VelH) @@ -206,8 +204,6 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor end if end if DstUniformFieldTypeData%VelH = SrcUniformFieldTypeData%VelH - else if (allocated(DstUniformFieldTypeData%VelH)) then - deallocate(DstUniformFieldTypeData%VelH) end if if (allocated(SrcUniformFieldTypeData%VelHDot)) then LB(1:1) = lbound(SrcUniformFieldTypeData%VelHDot) @@ -220,8 +216,6 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor end if end if DstUniformFieldTypeData%VelHDot = SrcUniformFieldTypeData%VelHDot - else if (allocated(DstUniformFieldTypeData%VelHDot)) then - deallocate(DstUniformFieldTypeData%VelHDot) end if if (allocated(SrcUniformFieldTypeData%VelV)) then LB(1:1) = lbound(SrcUniformFieldTypeData%VelV) @@ -234,8 +228,6 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor end if end if DstUniformFieldTypeData%VelV = SrcUniformFieldTypeData%VelV - else if (allocated(DstUniformFieldTypeData%VelV)) then - deallocate(DstUniformFieldTypeData%VelV) end if if (allocated(SrcUniformFieldTypeData%VelVDot)) then LB(1:1) = lbound(SrcUniformFieldTypeData%VelVDot) @@ -248,8 +240,6 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor end if end if DstUniformFieldTypeData%VelVDot = SrcUniformFieldTypeData%VelVDot - else if (allocated(DstUniformFieldTypeData%VelVDot)) then - deallocate(DstUniformFieldTypeData%VelVDot) end if if (allocated(SrcUniformFieldTypeData%VelGust)) then LB(1:1) = lbound(SrcUniformFieldTypeData%VelGust) @@ -262,8 +252,6 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor end if end if DstUniformFieldTypeData%VelGust = SrcUniformFieldTypeData%VelGust - else if (allocated(DstUniformFieldTypeData%VelGust)) then - deallocate(DstUniformFieldTypeData%VelGust) end if if (allocated(SrcUniformFieldTypeData%VelGustDot)) then LB(1:1) = lbound(SrcUniformFieldTypeData%VelGustDot) @@ -276,8 +264,6 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor end if end if DstUniformFieldTypeData%VelGustDot = SrcUniformFieldTypeData%VelGustDot - else if (allocated(DstUniformFieldTypeData%VelGustDot)) then - deallocate(DstUniformFieldTypeData%VelGustDot) end if if (allocated(SrcUniformFieldTypeData%AngleH)) then LB(1:1) = lbound(SrcUniformFieldTypeData%AngleH) @@ -290,8 +276,6 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor end if end if DstUniformFieldTypeData%AngleH = SrcUniformFieldTypeData%AngleH - else if (allocated(DstUniformFieldTypeData%AngleH)) then - deallocate(DstUniformFieldTypeData%AngleH) end if if (allocated(SrcUniformFieldTypeData%AngleHDot)) then LB(1:1) = lbound(SrcUniformFieldTypeData%AngleHDot) @@ -304,8 +288,6 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor end if end if DstUniformFieldTypeData%AngleHDot = SrcUniformFieldTypeData%AngleHDot - else if (allocated(DstUniformFieldTypeData%AngleHDot)) then - deallocate(DstUniformFieldTypeData%AngleHDot) end if if (allocated(SrcUniformFieldTypeData%AngleV)) then LB(1:1) = lbound(SrcUniformFieldTypeData%AngleV) @@ -318,8 +300,6 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor end if end if DstUniformFieldTypeData%AngleV = SrcUniformFieldTypeData%AngleV - else if (allocated(DstUniformFieldTypeData%AngleV)) then - deallocate(DstUniformFieldTypeData%AngleV) end if if (allocated(SrcUniformFieldTypeData%AngleVDot)) then LB(1:1) = lbound(SrcUniformFieldTypeData%AngleVDot) @@ -332,8 +312,6 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor end if end if DstUniformFieldTypeData%AngleVDot = SrcUniformFieldTypeData%AngleVDot - else if (allocated(DstUniformFieldTypeData%AngleVDot)) then - deallocate(DstUniformFieldTypeData%AngleVDot) end if if (allocated(SrcUniformFieldTypeData%ShrH)) then LB(1:1) = lbound(SrcUniformFieldTypeData%ShrH) @@ -346,8 +324,6 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor end if end if DstUniformFieldTypeData%ShrH = SrcUniformFieldTypeData%ShrH - else if (allocated(DstUniformFieldTypeData%ShrH)) then - deallocate(DstUniformFieldTypeData%ShrH) end if if (allocated(SrcUniformFieldTypeData%ShrHDot)) then LB(1:1) = lbound(SrcUniformFieldTypeData%ShrHDot) @@ -360,8 +336,6 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor end if end if DstUniformFieldTypeData%ShrHDot = SrcUniformFieldTypeData%ShrHDot - else if (allocated(DstUniformFieldTypeData%ShrHDot)) then - deallocate(DstUniformFieldTypeData%ShrHDot) end if if (allocated(SrcUniformFieldTypeData%ShrV)) then LB(1:1) = lbound(SrcUniformFieldTypeData%ShrV) @@ -374,8 +348,6 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor end if end if DstUniformFieldTypeData%ShrV = SrcUniformFieldTypeData%ShrV - else if (allocated(DstUniformFieldTypeData%ShrV)) then - deallocate(DstUniformFieldTypeData%ShrV) end if if (allocated(SrcUniformFieldTypeData%ShrVDot)) then LB(1:1) = lbound(SrcUniformFieldTypeData%ShrVDot) @@ -388,8 +360,6 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor end if end if DstUniformFieldTypeData%ShrVDot = SrcUniformFieldTypeData%ShrVDot - else if (allocated(DstUniformFieldTypeData%ShrVDot)) then - deallocate(DstUniformFieldTypeData%ShrVDot) end if if (allocated(SrcUniformFieldTypeData%LinShrV)) then LB(1:1) = lbound(SrcUniformFieldTypeData%LinShrV) @@ -402,8 +372,6 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor end if end if DstUniformFieldTypeData%LinShrV = SrcUniformFieldTypeData%LinShrV - else if (allocated(DstUniformFieldTypeData%LinShrV)) then - deallocate(DstUniformFieldTypeData%LinShrV) end if if (allocated(SrcUniformFieldTypeData%LinShrVDot)) then LB(1:1) = lbound(SrcUniformFieldTypeData%LinShrVDot) @@ -416,8 +384,6 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor end if end if DstUniformFieldTypeData%LinShrVDot = SrcUniformFieldTypeData%LinShrVDot - else if (allocated(DstUniformFieldTypeData%LinShrVDot)) then - deallocate(DstUniformFieldTypeData%LinShrVDot) end if end subroutine @@ -975,8 +941,6 @@ subroutine IfW_FlowField_CopyGrid3DFieldType(SrcGrid3DFieldTypeData, DstGrid3DFi end if end if DstGrid3DFieldTypeData%Vel = SrcGrid3DFieldTypeData%Vel - else if (allocated(DstGrid3DFieldTypeData%Vel)) then - deallocate(DstGrid3DFieldTypeData%Vel) end if if (allocated(SrcGrid3DFieldTypeData%Acc)) then LB(1:4) = lbound(SrcGrid3DFieldTypeData%Acc) @@ -989,8 +953,6 @@ subroutine IfW_FlowField_CopyGrid3DFieldType(SrcGrid3DFieldTypeData, DstGrid3DFi end if end if DstGrid3DFieldTypeData%Acc = SrcGrid3DFieldTypeData%Acc - else if (allocated(DstGrid3DFieldTypeData%Acc)) then - deallocate(DstGrid3DFieldTypeData%Acc) end if if (allocated(SrcGrid3DFieldTypeData%VelTower)) then LB(1:3) = lbound(SrcGrid3DFieldTypeData%VelTower) @@ -1003,8 +965,6 @@ subroutine IfW_FlowField_CopyGrid3DFieldType(SrcGrid3DFieldTypeData, DstGrid3DFi end if end if DstGrid3DFieldTypeData%VelTower = SrcGrid3DFieldTypeData%VelTower - else if (allocated(DstGrid3DFieldTypeData%VelTower)) then - deallocate(DstGrid3DFieldTypeData%VelTower) end if if (allocated(SrcGrid3DFieldTypeData%AccTower)) then LB(1:3) = lbound(SrcGrid3DFieldTypeData%AccTower) @@ -1017,8 +977,6 @@ subroutine IfW_FlowField_CopyGrid3DFieldType(SrcGrid3DFieldTypeData, DstGrid3DFi end if end if DstGrid3DFieldTypeData%AccTower = SrcGrid3DFieldTypeData%AccTower - else if (allocated(DstGrid3DFieldTypeData%AccTower)) then - deallocate(DstGrid3DFieldTypeData%AccTower) end if if (allocated(SrcGrid3DFieldTypeData%VelAvg)) then LB(1:3) = lbound(SrcGrid3DFieldTypeData%VelAvg) @@ -1031,8 +989,6 @@ subroutine IfW_FlowField_CopyGrid3DFieldType(SrcGrid3DFieldTypeData, DstGrid3DFi end if end if DstGrid3DFieldTypeData%VelAvg = SrcGrid3DFieldTypeData%VelAvg - else if (allocated(DstGrid3DFieldTypeData%VelAvg)) then - deallocate(DstGrid3DFieldTypeData%VelAvg) end if if (allocated(SrcGrid3DFieldTypeData%AccAvg)) then LB(1:3) = lbound(SrcGrid3DFieldTypeData%AccAvg) @@ -1045,8 +1001,6 @@ subroutine IfW_FlowField_CopyGrid3DFieldType(SrcGrid3DFieldTypeData, DstGrid3DFi end if end if DstGrid3DFieldTypeData%AccAvg = SrcGrid3DFieldTypeData%AccAvg - else if (allocated(DstGrid3DFieldTypeData%AccAvg)) then - deallocate(DstGrid3DFieldTypeData%AccAvg) end if DstGrid3DFieldTypeData%DTime = SrcGrid3DFieldTypeData%DTime DstGrid3DFieldTypeData%Rate = SrcGrid3DFieldTypeData%Rate @@ -1441,8 +1395,6 @@ subroutine IfW_FlowField_CopyPointsFieldType(SrcPointsFieldTypeData, DstPointsFi end if end if DstPointsFieldTypeData%Vel = SrcPointsFieldTypeData%Vel - else if (allocated(DstPointsFieldTypeData%Vel)) then - deallocate(DstPointsFieldTypeData%Vel) end if end subroutine diff --git a/modules/inflowwind/src/InflowWind_Types.f90 b/modules/inflowwind/src/InflowWind_Types.f90 index c22315ff27..8fc1f4586e 100644 --- a/modules/inflowwind/src/InflowWind_Types.f90 +++ b/modules/inflowwind/src/InflowWind_Types.f90 @@ -232,8 +232,6 @@ subroutine InflowWind_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode end if end if DstInputFileData%WindVxiList = SrcInputFileData%WindVxiList - else if (allocated(DstInputFileData%WindVxiList)) then - deallocate(DstInputFileData%WindVxiList) end if if (allocated(SrcInputFileData%WindVyiList)) then LB(1:1) = lbound(SrcInputFileData%WindVyiList) @@ -246,8 +244,6 @@ subroutine InflowWind_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode end if end if DstInputFileData%WindVyiList = SrcInputFileData%WindVyiList - else if (allocated(DstInputFileData%WindVyiList)) then - deallocate(DstInputFileData%WindVyiList) end if if (allocated(SrcInputFileData%WindVziList)) then LB(1:1) = lbound(SrcInputFileData%WindVziList) @@ -260,8 +256,6 @@ subroutine InflowWind_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode end if end if DstInputFileData%WindVziList = SrcInputFileData%WindVziList - else if (allocated(DstInputFileData%WindVziList)) then - deallocate(DstInputFileData%WindVziList) end if DstInputFileData%Steady_HWindSpeed = SrcInputFileData%Steady_HWindSpeed DstInputFileData%Steady_RefHt = SrcInputFileData%Steady_RefHt @@ -297,8 +291,6 @@ subroutine InflowWind_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode end if end if DstInputFileData%OutList = SrcInputFileData%OutList - else if (allocated(DstInputFileData%OutList)) then - deallocate(DstInputFileData%OutList) end if DstInputFileData%SensorType = SrcInputFileData%SensorType DstInputFileData%NumBeam = SrcInputFileData%NumBeam @@ -315,8 +307,6 @@ subroutine InflowWind_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode end if end if DstInputFileData%FocalDistanceX = SrcInputFileData%FocalDistanceX - else if (allocated(DstInputFileData%FocalDistanceX)) then - deallocate(DstInputFileData%FocalDistanceX) end if if (allocated(SrcInputFileData%FocalDistanceY)) then LB(1:1) = lbound(SrcInputFileData%FocalDistanceY) @@ -329,8 +319,6 @@ subroutine InflowWind_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode end if end if DstInputFileData%FocalDistanceY = SrcInputFileData%FocalDistanceY - else if (allocated(DstInputFileData%FocalDistanceY)) then - deallocate(DstInputFileData%FocalDistanceY) end if if (allocated(SrcInputFileData%FocalDistanceZ)) then LB(1:1) = lbound(SrcInputFileData%FocalDistanceZ) @@ -343,8 +331,6 @@ subroutine InflowWind_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode end if end if DstInputFileData%FocalDistanceZ = SrcInputFileData%FocalDistanceZ - else if (allocated(DstInputFileData%FocalDistanceZ)) then - deallocate(DstInputFileData%FocalDistanceZ) end if DstInputFileData%PulseSpacing = SrcInputFileData%PulseSpacing DstInputFileData%MeasurementInterval = SrcInputFileData%MeasurementInterval @@ -811,8 +797,6 @@ subroutine InflowWind_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlC end if end if DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr - else if (allocated(DstInitOutputData%WriteOutputHdr)) then - deallocate(DstInitOutputData%WriteOutputHdr) end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) @@ -825,8 +809,6 @@ subroutine InflowWind_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlC end if end if DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt - else if (allocated(DstInitOutputData%WriteOutputUnt)) then - deallocate(DstInitOutputData%WriteOutputUnt) end if call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -845,8 +827,6 @@ subroutine InflowWind_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlC end if end if DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y - else if (allocated(DstInitOutputData%LinNames_y)) then - deallocate(DstInitOutputData%LinNames_y) end if if (allocated(SrcInitOutputData%LinNames_u)) then LB(1:1) = lbound(SrcInitOutputData%LinNames_u) @@ -859,8 +839,6 @@ subroutine InflowWind_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlC end if end if DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u - else if (allocated(DstInitOutputData%LinNames_u)) then - deallocate(DstInitOutputData%LinNames_u) end if if (allocated(SrcInitOutputData%RotFrame_y)) then LB(1:1) = lbound(SrcInitOutputData%RotFrame_y) @@ -873,8 +851,6 @@ subroutine InflowWind_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlC end if end if DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y - else if (allocated(DstInitOutputData%RotFrame_y)) then - deallocate(DstInitOutputData%RotFrame_y) end if if (allocated(SrcInitOutputData%RotFrame_u)) then LB(1:1) = lbound(SrcInitOutputData%RotFrame_u) @@ -887,8 +863,6 @@ subroutine InflowWind_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlC end if end if DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u - else if (allocated(DstInitOutputData%RotFrame_u)) then - deallocate(DstInitOutputData%RotFrame_u) end if if (allocated(SrcInitOutputData%IsLoad_u)) then LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) @@ -901,8 +875,6 @@ subroutine InflowWind_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlC end if end if DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u - else if (allocated(DstInitOutputData%IsLoad_u)) then - deallocate(DstInitOutputData%IsLoad_u) end if DstInitOutputData%FlowField => SrcInitOutputData%FlowField end subroutine @@ -1155,8 +1127,6 @@ subroutine InflowWind_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, E end if end if DstParamData%WindViXYZprime = SrcParamData%WindViXYZprime - else if (allocated(DstParamData%WindViXYZprime)) then - deallocate(DstParamData%WindViXYZprime) end if if (allocated(SrcParamData%WindViXYZ)) then LB(1:2) = lbound(SrcParamData%WindViXYZ) @@ -1169,8 +1139,6 @@ subroutine InflowWind_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, E end if end if DstParamData%WindViXYZ = SrcParamData%WindViXYZ - else if (allocated(DstParamData%WindViXYZ)) then - deallocate(DstParamData%WindViXYZ) end if if (associated(SrcParamData%FlowField)) then if (.not. associated(DstParamData%FlowField)) then @@ -1183,9 +1151,6 @@ subroutine InflowWind_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, E call IfW_FlowField_CopyFlowFieldType(SrcParamData%FlowField, DstParamData%FlowField, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - else if (associated(DstParamData%FlowField)) then - deallocate(DstParamData%FlowField) - nullify(DstParamData%FlowField) end if if (allocated(SrcParamData%PositionAvg)) then LB(1:2) = lbound(SrcParamData%PositionAvg) @@ -1198,8 +1163,6 @@ subroutine InflowWind_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, E end if end if DstParamData%PositionAvg = SrcParamData%PositionAvg - else if (allocated(DstParamData%PositionAvg)) then - deallocate(DstParamData%PositionAvg) end if DstParamData%NWindVel = SrcParamData%NWindVel DstParamData%NumOuts = SrcParamData%NumOuts @@ -1218,8 +1181,6 @@ subroutine InflowWind_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstParamData%OutParam)) then - deallocate(DstParamData%OutParam) end if if (allocated(SrcParamData%OutParamLinIndx)) then LB(1:2) = lbound(SrcParamData%OutParamLinIndx) @@ -1232,8 +1193,6 @@ subroutine InflowWind_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, E end if end if DstParamData%OutParamLinIndx = SrcParamData%OutParamLinIndx - else if (allocated(DstParamData%OutParamLinIndx)) then - deallocate(DstParamData%OutParamLinIndx) end if call Lidar_CopyParam(SrcParamData%lidar, DstParamData%lidar, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1474,8 +1433,6 @@ subroutine InflowWind_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, E end if end if DstInputData%PositionXYZ = SrcInputData%PositionXYZ - else if (allocated(DstInputData%PositionXYZ)) then - deallocate(DstInputData%PositionXYZ) end if call Lidar_CopyInput(SrcInputData%lidar, DstInputData%lidar, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1568,8 +1525,6 @@ subroutine InflowWind_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat end if end if DstOutputData%VelocityUVW = SrcOutputData%VelocityUVW - else if (allocated(DstOutputData%VelocityUVW)) then - deallocate(DstOutputData%VelocityUVW) end if if (allocated(SrcOutputData%AccelUVW)) then LB(1:2) = lbound(SrcOutputData%AccelUVW) @@ -1582,8 +1537,6 @@ subroutine InflowWind_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat end if end if DstOutputData%AccelUVW = SrcOutputData%AccelUVW - else if (allocated(DstOutputData%AccelUVW)) then - deallocate(DstOutputData%AccelUVW) end if if (allocated(SrcOutputData%WriteOutput)) then LB(1:1) = lbound(SrcOutputData%WriteOutput) @@ -1596,8 +1549,6 @@ subroutine InflowWind_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat end if end if DstOutputData%WriteOutput = SrcOutputData%WriteOutput - else if (allocated(DstOutputData%WriteOutput)) then - deallocate(DstOutputData%WriteOutput) end if DstOutputData%DiskVel = SrcOutputData%DiskVel DstOutputData%HubVel = SrcOutputData%HubVel @@ -1890,8 +1841,6 @@ subroutine InflowWind_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrM end if end if DstMiscData%AllOuts = SrcMiscData%AllOuts - else if (allocated(DstMiscData%AllOuts)) then - deallocate(DstMiscData%AllOuts) end if if (allocated(SrcMiscData%WindViUVW)) then LB(1:2) = lbound(SrcMiscData%WindViUVW) @@ -1904,8 +1853,6 @@ subroutine InflowWind_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrM end if end if DstMiscData%WindViUVW = SrcMiscData%WindViUVW - else if (allocated(DstMiscData%WindViUVW)) then - deallocate(DstMiscData%WindViUVW) end if if (allocated(SrcMiscData%WindAiUVW)) then LB(1:2) = lbound(SrcMiscData%WindAiUVW) @@ -1918,8 +1865,6 @@ subroutine InflowWind_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrM end if end if DstMiscData%WindAiUVW = SrcMiscData%WindAiUVW - else if (allocated(DstMiscData%WindAiUVW)) then - deallocate(DstMiscData%WindAiUVW) end if call InflowWind_CopyInput(SrcMiscData%u_Avg, DstMiscData%u_Avg, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) diff --git a/modules/inflowwind/src/Lidar_Types.f90 b/modules/inflowwind/src/Lidar_Types.f90 index 96e114030e..c7f6f7ec1d 100644 --- a/modules/inflowwind/src/Lidar_Types.f90 +++ b/modules/inflowwind/src/Lidar_Types.f90 @@ -260,8 +260,6 @@ subroutine Lidar_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg end if end if DstParamData%FocalDistanceX = SrcParamData%FocalDistanceX - else if (allocated(DstParamData%FocalDistanceX)) then - deallocate(DstParamData%FocalDistanceX) end if if (allocated(SrcParamData%FocalDistanceY)) then LB(1:1) = lbound(SrcParamData%FocalDistanceY) @@ -274,8 +272,6 @@ subroutine Lidar_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg end if end if DstParamData%FocalDistanceY = SrcParamData%FocalDistanceY - else if (allocated(DstParamData%FocalDistanceY)) then - deallocate(DstParamData%FocalDistanceY) end if if (allocated(SrcParamData%FocalDistanceZ)) then LB(1:1) = lbound(SrcParamData%FocalDistanceZ) @@ -288,8 +284,6 @@ subroutine Lidar_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg end if end if DstParamData%FocalDistanceZ = SrcParamData%FocalDistanceZ - else if (allocated(DstParamData%FocalDistanceZ)) then - deallocate(DstParamData%FocalDistanceZ) end if if (allocated(SrcParamData%MsrPosition)) then LB(1:2) = lbound(SrcParamData%MsrPosition) @@ -302,8 +296,6 @@ subroutine Lidar_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg end if end if DstParamData%MsrPosition = SrcParamData%MsrPosition - else if (allocated(DstParamData%MsrPosition)) then - deallocate(DstParamData%MsrPosition) end if DstParamData%PulseSpacing = SrcParamData%PulseSpacing DstParamData%URefLid = SrcParamData%URefLid @@ -759,8 +751,6 @@ subroutine Lidar_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err end if end if DstOutputData%LidSpeed = SrcOutputData%LidSpeed - else if (allocated(DstOutputData%LidSpeed)) then - deallocate(DstOutputData%LidSpeed) end if if (allocated(SrcOutputData%WtTrunc)) then LB(1:1) = lbound(SrcOutputData%WtTrunc) @@ -773,8 +763,6 @@ subroutine Lidar_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err end if end if DstOutputData%WtTrunc = SrcOutputData%WtTrunc - else if (allocated(DstOutputData%WtTrunc)) then - deallocate(DstOutputData%WtTrunc) end if if (allocated(SrcOutputData%MsrPositionsX)) then LB(1:1) = lbound(SrcOutputData%MsrPositionsX) @@ -787,8 +775,6 @@ subroutine Lidar_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err end if end if DstOutputData%MsrPositionsX = SrcOutputData%MsrPositionsX - else if (allocated(DstOutputData%MsrPositionsX)) then - deallocate(DstOutputData%MsrPositionsX) end if if (allocated(SrcOutputData%MsrPositionsY)) then LB(1:1) = lbound(SrcOutputData%MsrPositionsY) @@ -801,8 +787,6 @@ subroutine Lidar_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err end if end if DstOutputData%MsrPositionsY = SrcOutputData%MsrPositionsY - else if (allocated(DstOutputData%MsrPositionsY)) then - deallocate(DstOutputData%MsrPositionsY) end if if (allocated(SrcOutputData%MsrPositionsZ)) then LB(1:1) = lbound(SrcOutputData%MsrPositionsZ) @@ -815,8 +799,6 @@ subroutine Lidar_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err end if end if DstOutputData%MsrPositionsZ = SrcOutputData%MsrPositionsZ - else if (allocated(DstOutputData%MsrPositionsZ)) then - deallocate(DstOutputData%MsrPositionsZ) end if end subroutine diff --git a/modules/map/src/MAP_Fortran_Types.f90 b/modules/map/src/MAP_Fortran_Types.f90 index 3c0d5f55f6..9282de9f92 100644 --- a/modules/map/src/MAP_Fortran_Types.f90 +++ b/modules/map/src/MAP_Fortran_Types.f90 @@ -115,8 +115,6 @@ subroutine MAP_Fortran_CopyLin_InitOutputType(SrcLin_InitOutputTypeData, DstLin_ end if end if DstLin_InitOutputTypeData%LinNames_y = SrcLin_InitOutputTypeData%LinNames_y - else if (allocated(DstLin_InitOutputTypeData%LinNames_y)) then - deallocate(DstLin_InitOutputTypeData%LinNames_y) end if if (allocated(SrcLin_InitOutputTypeData%LinNames_u)) then LB(1:1) = lbound(SrcLin_InitOutputTypeData%LinNames_u) @@ -129,8 +127,6 @@ subroutine MAP_Fortran_CopyLin_InitOutputType(SrcLin_InitOutputTypeData, DstLin_ end if end if DstLin_InitOutputTypeData%LinNames_u = SrcLin_InitOutputTypeData%LinNames_u - else if (allocated(DstLin_InitOutputTypeData%LinNames_u)) then - deallocate(DstLin_InitOutputTypeData%LinNames_u) end if if (allocated(SrcLin_InitOutputTypeData%IsLoad_u)) then LB(1:1) = lbound(SrcLin_InitOutputTypeData%IsLoad_u) @@ -143,8 +139,6 @@ subroutine MAP_Fortran_CopyLin_InitOutputType(SrcLin_InitOutputTypeData, DstLin_ end if end if DstLin_InitOutputTypeData%IsLoad_u = SrcLin_InitOutputTypeData%IsLoad_u - else if (allocated(DstLin_InitOutputTypeData%IsLoad_u)) then - deallocate(DstLin_InitOutputTypeData%IsLoad_u) end if end subroutine @@ -263,8 +257,6 @@ subroutine MAP_Fortran_CopyLin_ParamType(SrcLin_ParamTypeData, DstLin_ParamTypeD end if end if DstLin_ParamTypeData%Jac_u_indx = SrcLin_ParamTypeData%Jac_u_indx - else if (allocated(DstLin_ParamTypeData%Jac_u_indx)) then - deallocate(DstLin_ParamTypeData%Jac_u_indx) end if DstLin_ParamTypeData%du = SrcLin_ParamTypeData%du DstLin_ParamTypeData%Jac_ny = SrcLin_ParamTypeData%Jac_ny diff --git a/modules/map/src/MAP_Types.f90 b/modules/map/src/MAP_Types.f90 index 0097d1fe5f..2a7cbac24e 100644 --- a/modules/map/src/MAP_Types.f90 +++ b/modules/map/src/MAP_Types.f90 @@ -432,8 +432,6 @@ subroutine MAP_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Er end if end if DstInitOutputData%writeOutputHdr = SrcInitOutputData%writeOutputHdr - else if (allocated(DstInitOutputData%writeOutputHdr)) then - deallocate(DstInitOutputData%writeOutputHdr) end if if (allocated(SrcInitOutputData%writeOutputUnt)) then LB(1:1) = lbound(SrcInitOutputData%writeOutputUnt) @@ -446,8 +444,6 @@ subroutine MAP_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Er end if end if DstInitOutputData%writeOutputUnt = SrcInitOutputData%writeOutputUnt - else if (allocated(DstInitOutputData%writeOutputUnt)) then - deallocate(DstInitOutputData%writeOutputUnt) end if call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -781,9 +777,6 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%C_obj%H = c_loc(DstOtherStateData%H(LB(1))) end if DstOtherStateData%H = SrcOtherStateData%H - else if (associated(DstOtherStateData%H)) then - deallocate(DstOtherStateData%H) - nullify(DstOtherStateData%H) end if if (associated(SrcOtherStateData%V)) then LB(1:1) = lbound(SrcOtherStateData%V) @@ -799,9 +792,6 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%C_obj%V = c_loc(DstOtherStateData%V(LB(1))) end if DstOtherStateData%V = SrcOtherStateData%V - else if (associated(DstOtherStateData%V)) then - deallocate(DstOtherStateData%V) - nullify(DstOtherStateData%V) end if if (associated(SrcOtherStateData%Ha)) then LB(1:1) = lbound(SrcOtherStateData%Ha) @@ -817,9 +807,6 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%C_obj%Ha = c_loc(DstOtherStateData%Ha(LB(1))) end if DstOtherStateData%Ha = SrcOtherStateData%Ha - else if (associated(DstOtherStateData%Ha)) then - deallocate(DstOtherStateData%Ha) - nullify(DstOtherStateData%Ha) end if if (associated(SrcOtherStateData%Va)) then LB(1:1) = lbound(SrcOtherStateData%Va) @@ -835,9 +822,6 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%C_obj%Va = c_loc(DstOtherStateData%Va(LB(1))) end if DstOtherStateData%Va = SrcOtherStateData%Va - else if (associated(DstOtherStateData%Va)) then - deallocate(DstOtherStateData%Va) - nullify(DstOtherStateData%Va) end if if (associated(SrcOtherStateData%x)) then LB(1:1) = lbound(SrcOtherStateData%x) @@ -853,9 +837,6 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%C_obj%x = c_loc(DstOtherStateData%x(LB(1))) end if DstOtherStateData%x = SrcOtherStateData%x - else if (associated(DstOtherStateData%x)) then - deallocate(DstOtherStateData%x) - nullify(DstOtherStateData%x) end if if (associated(SrcOtherStateData%y)) then LB(1:1) = lbound(SrcOtherStateData%y) @@ -871,9 +852,6 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%C_obj%y = c_loc(DstOtherStateData%y(LB(1))) end if DstOtherStateData%y = SrcOtherStateData%y - else if (associated(DstOtherStateData%y)) then - deallocate(DstOtherStateData%y) - nullify(DstOtherStateData%y) end if if (associated(SrcOtherStateData%z)) then LB(1:1) = lbound(SrcOtherStateData%z) @@ -889,9 +867,6 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%C_obj%z = c_loc(DstOtherStateData%z(LB(1))) end if DstOtherStateData%z = SrcOtherStateData%z - else if (associated(DstOtherStateData%z)) then - deallocate(DstOtherStateData%z) - nullify(DstOtherStateData%z) end if if (associated(SrcOtherStateData%xa)) then LB(1:1) = lbound(SrcOtherStateData%xa) @@ -907,9 +882,6 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%C_obj%xa = c_loc(DstOtherStateData%xa(LB(1))) end if DstOtherStateData%xa = SrcOtherStateData%xa - else if (associated(DstOtherStateData%xa)) then - deallocate(DstOtherStateData%xa) - nullify(DstOtherStateData%xa) end if if (associated(SrcOtherStateData%ya)) then LB(1:1) = lbound(SrcOtherStateData%ya) @@ -925,9 +897,6 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%C_obj%ya = c_loc(DstOtherStateData%ya(LB(1))) end if DstOtherStateData%ya = SrcOtherStateData%ya - else if (associated(DstOtherStateData%ya)) then - deallocate(DstOtherStateData%ya) - nullify(DstOtherStateData%ya) end if if (associated(SrcOtherStateData%za)) then LB(1:1) = lbound(SrcOtherStateData%za) @@ -943,9 +912,6 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%C_obj%za = c_loc(DstOtherStateData%za(LB(1))) end if DstOtherStateData%za = SrcOtherStateData%za - else if (associated(DstOtherStateData%za)) then - deallocate(DstOtherStateData%za) - nullify(DstOtherStateData%za) end if if (associated(SrcOtherStateData%Fx_connect)) then LB(1:1) = lbound(SrcOtherStateData%Fx_connect) @@ -961,9 +927,6 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%C_obj%Fx_connect = c_loc(DstOtherStateData%Fx_connect(LB(1))) end if DstOtherStateData%Fx_connect = SrcOtherStateData%Fx_connect - else if (associated(DstOtherStateData%Fx_connect)) then - deallocate(DstOtherStateData%Fx_connect) - nullify(DstOtherStateData%Fx_connect) end if if (associated(SrcOtherStateData%Fy_connect)) then LB(1:1) = lbound(SrcOtherStateData%Fy_connect) @@ -979,9 +942,6 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%C_obj%Fy_connect = c_loc(DstOtherStateData%Fy_connect(LB(1))) end if DstOtherStateData%Fy_connect = SrcOtherStateData%Fy_connect - else if (associated(DstOtherStateData%Fy_connect)) then - deallocate(DstOtherStateData%Fy_connect) - nullify(DstOtherStateData%Fy_connect) end if if (associated(SrcOtherStateData%Fz_connect)) then LB(1:1) = lbound(SrcOtherStateData%Fz_connect) @@ -997,9 +957,6 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%C_obj%Fz_connect = c_loc(DstOtherStateData%Fz_connect(LB(1))) end if DstOtherStateData%Fz_connect = SrcOtherStateData%Fz_connect - else if (associated(DstOtherStateData%Fz_connect)) then - deallocate(DstOtherStateData%Fz_connect) - nullify(DstOtherStateData%Fz_connect) end if if (associated(SrcOtherStateData%Fx_anchor)) then LB(1:1) = lbound(SrcOtherStateData%Fx_anchor) @@ -1015,9 +972,6 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%C_obj%Fx_anchor = c_loc(DstOtherStateData%Fx_anchor(LB(1))) end if DstOtherStateData%Fx_anchor = SrcOtherStateData%Fx_anchor - else if (associated(DstOtherStateData%Fx_anchor)) then - deallocate(DstOtherStateData%Fx_anchor) - nullify(DstOtherStateData%Fx_anchor) end if if (associated(SrcOtherStateData%Fy_anchor)) then LB(1:1) = lbound(SrcOtherStateData%Fy_anchor) @@ -1033,9 +987,6 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%C_obj%Fy_anchor = c_loc(DstOtherStateData%Fy_anchor(LB(1))) end if DstOtherStateData%Fy_anchor = SrcOtherStateData%Fy_anchor - else if (associated(DstOtherStateData%Fy_anchor)) then - deallocate(DstOtherStateData%Fy_anchor) - nullify(DstOtherStateData%Fy_anchor) end if if (associated(SrcOtherStateData%Fz_anchor)) then LB(1:1) = lbound(SrcOtherStateData%Fz_anchor) @@ -1051,9 +1002,6 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%C_obj%Fz_anchor = c_loc(DstOtherStateData%Fz_anchor(LB(1))) end if DstOtherStateData%Fz_anchor = SrcOtherStateData%Fz_anchor - else if (associated(DstOtherStateData%Fz_anchor)) then - deallocate(DstOtherStateData%Fz_anchor) - nullify(DstOtherStateData%Fz_anchor) end if end subroutine @@ -2126,9 +2074,6 @@ subroutine MAP_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, DstConstrStateData%C_obj%H = c_loc(DstConstrStateData%H(LB(1))) end if DstConstrStateData%H = SrcConstrStateData%H - else if (associated(DstConstrStateData%H)) then - deallocate(DstConstrStateData%H) - nullify(DstConstrStateData%H) end if if (associated(SrcConstrStateData%V)) then LB(1:1) = lbound(SrcConstrStateData%V) @@ -2144,9 +2089,6 @@ subroutine MAP_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, DstConstrStateData%C_obj%V = c_loc(DstConstrStateData%V(LB(1))) end if DstConstrStateData%V = SrcConstrStateData%V - else if (associated(DstConstrStateData%V)) then - deallocate(DstConstrStateData%V) - nullify(DstConstrStateData%V) end if if (associated(SrcConstrStateData%x)) then LB(1:1) = lbound(SrcConstrStateData%x) @@ -2162,9 +2104,6 @@ subroutine MAP_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, DstConstrStateData%C_obj%x = c_loc(DstConstrStateData%x(LB(1))) end if DstConstrStateData%x = SrcConstrStateData%x - else if (associated(DstConstrStateData%x)) then - deallocate(DstConstrStateData%x) - nullify(DstConstrStateData%x) end if if (associated(SrcConstrStateData%y)) then LB(1:1) = lbound(SrcConstrStateData%y) @@ -2180,9 +2119,6 @@ subroutine MAP_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, DstConstrStateData%C_obj%y = c_loc(DstConstrStateData%y(LB(1))) end if DstConstrStateData%y = SrcConstrStateData%y - else if (associated(DstConstrStateData%y)) then - deallocate(DstConstrStateData%y) - nullify(DstConstrStateData%y) end if if (associated(SrcConstrStateData%z)) then LB(1:1) = lbound(SrcConstrStateData%z) @@ -2198,9 +2134,6 @@ subroutine MAP_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, DstConstrStateData%C_obj%z = c_loc(DstConstrStateData%z(LB(1))) end if DstConstrStateData%z = SrcConstrStateData%z - else if (associated(DstConstrStateData%z)) then - deallocate(DstConstrStateData%z) - nullify(DstConstrStateData%z) end if end subroutine @@ -2735,9 +2668,6 @@ subroutine MAP_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%C_obj%x = c_loc(DstInputData%x(LB(1))) end if DstInputData%x = SrcInputData%x - else if (associated(DstInputData%x)) then - deallocate(DstInputData%x) - nullify(DstInputData%x) end if if (associated(SrcInputData%y)) then LB(1:1) = lbound(SrcInputData%y) @@ -2753,9 +2683,6 @@ subroutine MAP_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%C_obj%y = c_loc(DstInputData%y(LB(1))) end if DstInputData%y = SrcInputData%y - else if (associated(DstInputData%y)) then - deallocate(DstInputData%y) - nullify(DstInputData%y) end if if (associated(SrcInputData%z)) then LB(1:1) = lbound(SrcInputData%z) @@ -2771,9 +2698,6 @@ subroutine MAP_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%C_obj%z = c_loc(DstInputData%z(LB(1))) end if DstInputData%z = SrcInputData%z - else if (associated(DstInputData%z)) then - deallocate(DstInputData%z) - nullify(DstInputData%z) end if call MeshCopy(SrcInputData%PtFairDisplacement, DstInputData%PtFairDisplacement, CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3063,9 +2987,6 @@ subroutine MAP_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs DstOutputData%C_obj%Fx = c_loc(DstOutputData%Fx(LB(1))) end if DstOutputData%Fx = SrcOutputData%Fx - else if (associated(DstOutputData%Fx)) then - deallocate(DstOutputData%Fx) - nullify(DstOutputData%Fx) end if if (associated(SrcOutputData%Fy)) then LB(1:1) = lbound(SrcOutputData%Fy) @@ -3081,9 +3002,6 @@ subroutine MAP_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs DstOutputData%C_obj%Fy = c_loc(DstOutputData%Fy(LB(1))) end if DstOutputData%Fy = SrcOutputData%Fy - else if (associated(DstOutputData%Fy)) then - deallocate(DstOutputData%Fy) - nullify(DstOutputData%Fy) end if if (associated(SrcOutputData%Fz)) then LB(1:1) = lbound(SrcOutputData%Fz) @@ -3099,9 +3017,6 @@ subroutine MAP_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs DstOutputData%C_obj%Fz = c_loc(DstOutputData%Fz(LB(1))) end if DstOutputData%Fz = SrcOutputData%Fz - else if (associated(DstOutputData%Fz)) then - deallocate(DstOutputData%Fz) - nullify(DstOutputData%Fz) end if if (allocated(SrcOutputData%WriteOutput)) then LB(1:1) = lbound(SrcOutputData%WriteOutput) @@ -3114,8 +3029,6 @@ subroutine MAP_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs end if end if DstOutputData%WriteOutput = SrcOutputData%WriteOutput - else if (allocated(DstOutputData%WriteOutput)) then - deallocate(DstOutputData%WriteOutput) end if if (associated(SrcOutputData%wrtOutput)) then LB(1:1) = lbound(SrcOutputData%wrtOutput) @@ -3131,9 +3044,6 @@ subroutine MAP_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs DstOutputData%C_obj%wrtOutput = c_loc(DstOutputData%wrtOutput(LB(1))) end if DstOutputData%wrtOutput = SrcOutputData%wrtOutput - else if (associated(DstOutputData%wrtOutput)) then - deallocate(DstOutputData%wrtOutput) - nullify(DstOutputData%wrtOutput) end if call MeshCopy(SrcOutputData%ptFairleadLoad, DstOutputData%ptFairleadLoad, CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) diff --git a/modules/moordyn/src/MoorDyn_Types.f90 b/modules/moordyn/src/MoorDyn_Types.f90 index b18e0bc6f0..0e3188fbd8 100644 --- a/modules/moordyn/src/MoorDyn_Types.f90 +++ b/modules/moordyn/src/MoorDyn_Types.f90 @@ -540,8 +540,6 @@ subroutine MD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta end if end if DstInitInputData%PtfmInit = SrcInitInputData%PtfmInit - else if (allocated(DstInitInputData%PtfmInit)) then - deallocate(DstInitInputData%PtfmInit) end if DstInitInputData%FarmSize = SrcInitInputData%FarmSize if (allocated(SrcInitInputData%TurbineRefPos)) then @@ -555,8 +553,6 @@ subroutine MD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta end if end if DstInitInputData%TurbineRefPos = SrcInitInputData%TurbineRefPos - else if (allocated(DstInitInputData%TurbineRefPos)) then - deallocate(DstInitInputData%TurbineRefPos) end if DstInitInputData%Tmax = SrcInitInputData%Tmax DstInitInputData%FileName = SrcInitInputData%FileName @@ -577,8 +573,6 @@ subroutine MD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta end if end if DstInitInputData%OutList = SrcInitInputData%OutList - else if (allocated(DstInitInputData%OutList)) then - deallocate(DstInitInputData%OutList) end if DstInitInputData%Linearize = SrcInitInputData%Linearize end subroutine @@ -1095,8 +1089,6 @@ subroutine MD_CopyConnect(SrcConnectData, DstConnectData, CtrlCode, ErrStat, Err end if end if DstConnectData%PDyn = SrcConnectData%PDyn - else if (allocated(DstConnectData%PDyn)) then - deallocate(DstConnectData%PDyn) end if DstConnectData%Fnet = SrcConnectData%Fnet DstConnectData%M = SrcConnectData%M @@ -1267,8 +1259,6 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) end if end if DstRodData%r = SrcRodData%r - else if (allocated(DstRodData%r)) then - deallocate(DstRodData%r) end if if (allocated(SrcRodData%rd)) then LB(1:2) = lbound(SrcRodData%rd) @@ -1281,8 +1271,6 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) end if end if DstRodData%rd = SrcRodData%rd - else if (allocated(DstRodData%rd)) then - deallocate(DstRodData%rd) end if DstRodData%q = SrcRodData%q if (allocated(SrcRodData%l)) then @@ -1296,8 +1284,6 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) end if end if DstRodData%l = SrcRodData%l - else if (allocated(DstRodData%l)) then - deallocate(DstRodData%l) end if if (allocated(SrcRodData%V)) then LB(1:1) = lbound(SrcRodData%V) @@ -1310,8 +1296,6 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) end if end if DstRodData%V = SrcRodData%V - else if (allocated(DstRodData%V)) then - deallocate(DstRodData%V) end if if (allocated(SrcRodData%U)) then LB(1:2) = lbound(SrcRodData%U) @@ -1324,8 +1308,6 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) end if end if DstRodData%U = SrcRodData%U - else if (allocated(DstRodData%U)) then - deallocate(DstRodData%U) end if if (allocated(SrcRodData%Ud)) then LB(1:2) = lbound(SrcRodData%Ud) @@ -1338,8 +1320,6 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) end if end if DstRodData%Ud = SrcRodData%Ud - else if (allocated(DstRodData%Ud)) then - deallocate(DstRodData%Ud) end if if (allocated(SrcRodData%zeta)) then LB(1:1) = lbound(SrcRodData%zeta) @@ -1352,8 +1332,6 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) end if end if DstRodData%zeta = SrcRodData%zeta - else if (allocated(DstRodData%zeta)) then - deallocate(DstRodData%zeta) end if if (allocated(SrcRodData%PDyn)) then LB(1:1) = lbound(SrcRodData%PDyn) @@ -1366,8 +1344,6 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) end if end if DstRodData%PDyn = SrcRodData%PDyn - else if (allocated(DstRodData%PDyn)) then - deallocate(DstRodData%PDyn) end if if (allocated(SrcRodData%W)) then LB(1:2) = lbound(SrcRodData%W) @@ -1380,8 +1356,6 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) end if end if DstRodData%W = SrcRodData%W - else if (allocated(DstRodData%W)) then - deallocate(DstRodData%W) end if if (allocated(SrcRodData%Bo)) then LB(1:2) = lbound(SrcRodData%Bo) @@ -1394,8 +1368,6 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) end if end if DstRodData%Bo = SrcRodData%Bo - else if (allocated(DstRodData%Bo)) then - deallocate(DstRodData%Bo) end if if (allocated(SrcRodData%Pd)) then LB(1:2) = lbound(SrcRodData%Pd) @@ -1408,8 +1380,6 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) end if end if DstRodData%Pd = SrcRodData%Pd - else if (allocated(DstRodData%Pd)) then - deallocate(DstRodData%Pd) end if if (allocated(SrcRodData%Dp)) then LB(1:2) = lbound(SrcRodData%Dp) @@ -1422,8 +1392,6 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) end if end if DstRodData%Dp = SrcRodData%Dp - else if (allocated(DstRodData%Dp)) then - deallocate(DstRodData%Dp) end if if (allocated(SrcRodData%Dq)) then LB(1:2) = lbound(SrcRodData%Dq) @@ -1436,8 +1404,6 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) end if end if DstRodData%Dq = SrcRodData%Dq - else if (allocated(DstRodData%Dq)) then - deallocate(DstRodData%Dq) end if if (allocated(SrcRodData%Ap)) then LB(1:2) = lbound(SrcRodData%Ap) @@ -1450,8 +1416,6 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) end if end if DstRodData%Ap = SrcRodData%Ap - else if (allocated(DstRodData%Ap)) then - deallocate(DstRodData%Ap) end if if (allocated(SrcRodData%Aq)) then LB(1:2) = lbound(SrcRodData%Aq) @@ -1464,8 +1428,6 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) end if end if DstRodData%Aq = SrcRodData%Aq - else if (allocated(DstRodData%Aq)) then - deallocate(DstRodData%Aq) end if if (allocated(SrcRodData%B)) then LB(1:2) = lbound(SrcRodData%B) @@ -1478,8 +1440,6 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) end if end if DstRodData%B = SrcRodData%B - else if (allocated(DstRodData%B)) then - deallocate(DstRodData%B) end if if (allocated(SrcRodData%Fnet)) then LB(1:2) = lbound(SrcRodData%Fnet) @@ -1492,8 +1452,6 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) end if end if DstRodData%Fnet = SrcRodData%Fnet - else if (allocated(DstRodData%Fnet)) then - deallocate(DstRodData%Fnet) end if if (allocated(SrcRodData%M)) then LB(1:3) = lbound(SrcRodData%M) @@ -1506,8 +1464,6 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) end if end if DstRodData%M = SrcRodData%M - else if (allocated(DstRodData%M)) then - deallocate(DstRodData%M) end if DstRodData%FextA = SrcRodData%FextA DstRodData%FextB = SrcRodData%FextB @@ -1530,8 +1486,6 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) end if end if DstRodData%RodWrOutput = SrcRodData%RodWrOutput - else if (allocated(DstRodData%RodWrOutput)) then - deallocate(DstRodData%RodWrOutput) end if end subroutine @@ -2151,8 +2105,6 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) end if end if DstLineData%r = SrcLineData%r - else if (allocated(DstLineData%r)) then - deallocate(DstLineData%r) end if if (allocated(SrcLineData%rd)) then LB(1:2) = lbound(SrcLineData%rd) @@ -2165,8 +2117,6 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) end if end if DstLineData%rd = SrcLineData%rd - else if (allocated(DstLineData%rd)) then - deallocate(DstLineData%rd) end if if (allocated(SrcLineData%q)) then LB(1:2) = lbound(SrcLineData%q) @@ -2179,8 +2129,6 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) end if end if DstLineData%q = SrcLineData%q - else if (allocated(DstLineData%q)) then - deallocate(DstLineData%q) end if if (allocated(SrcLineData%qs)) then LB(1:2) = lbound(SrcLineData%qs) @@ -2193,8 +2141,6 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) end if end if DstLineData%qs = SrcLineData%qs - else if (allocated(DstLineData%qs)) then - deallocate(DstLineData%qs) end if if (allocated(SrcLineData%l)) then LB(1:1) = lbound(SrcLineData%l) @@ -2207,8 +2153,6 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) end if end if DstLineData%l = SrcLineData%l - else if (allocated(DstLineData%l)) then - deallocate(DstLineData%l) end if if (allocated(SrcLineData%ld)) then LB(1:1) = lbound(SrcLineData%ld) @@ -2221,8 +2165,6 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) end if end if DstLineData%ld = SrcLineData%ld - else if (allocated(DstLineData%ld)) then - deallocate(DstLineData%ld) end if if (allocated(SrcLineData%lstr)) then LB(1:1) = lbound(SrcLineData%lstr) @@ -2235,8 +2177,6 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) end if end if DstLineData%lstr = SrcLineData%lstr - else if (allocated(DstLineData%lstr)) then - deallocate(DstLineData%lstr) end if if (allocated(SrcLineData%lstrd)) then LB(1:1) = lbound(SrcLineData%lstrd) @@ -2249,8 +2189,6 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) end if end if DstLineData%lstrd = SrcLineData%lstrd - else if (allocated(DstLineData%lstrd)) then - deallocate(DstLineData%lstrd) end if if (allocated(SrcLineData%Kurv)) then LB(1:1) = lbound(SrcLineData%Kurv) @@ -2263,8 +2201,6 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) end if end if DstLineData%Kurv = SrcLineData%Kurv - else if (allocated(DstLineData%Kurv)) then - deallocate(DstLineData%Kurv) end if if (allocated(SrcLineData%dl_1)) then LB(1:1) = lbound(SrcLineData%dl_1) @@ -2277,8 +2213,6 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) end if end if DstLineData%dl_1 = SrcLineData%dl_1 - else if (allocated(DstLineData%dl_1)) then - deallocate(DstLineData%dl_1) end if if (allocated(SrcLineData%V)) then LB(1:1) = lbound(SrcLineData%V) @@ -2291,8 +2225,6 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) end if end if DstLineData%V = SrcLineData%V - else if (allocated(DstLineData%V)) then - deallocate(DstLineData%V) end if if (allocated(SrcLineData%U)) then LB(1:2) = lbound(SrcLineData%U) @@ -2305,8 +2237,6 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) end if end if DstLineData%U = SrcLineData%U - else if (allocated(DstLineData%U)) then - deallocate(DstLineData%U) end if if (allocated(SrcLineData%Ud)) then LB(1:2) = lbound(SrcLineData%Ud) @@ -2319,8 +2249,6 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) end if end if DstLineData%Ud = SrcLineData%Ud - else if (allocated(DstLineData%Ud)) then - deallocate(DstLineData%Ud) end if if (allocated(SrcLineData%zeta)) then LB(1:1) = lbound(SrcLineData%zeta) @@ -2333,8 +2261,6 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) end if end if DstLineData%zeta = SrcLineData%zeta - else if (allocated(DstLineData%zeta)) then - deallocate(DstLineData%zeta) end if if (allocated(SrcLineData%PDyn)) then LB(1:1) = lbound(SrcLineData%PDyn) @@ -2347,8 +2273,6 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) end if end if DstLineData%PDyn = SrcLineData%PDyn - else if (allocated(DstLineData%PDyn)) then - deallocate(DstLineData%PDyn) end if if (allocated(SrcLineData%T)) then LB(1:2) = lbound(SrcLineData%T) @@ -2361,8 +2285,6 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) end if end if DstLineData%T = SrcLineData%T - else if (allocated(DstLineData%T)) then - deallocate(DstLineData%T) end if if (allocated(SrcLineData%Td)) then LB(1:2) = lbound(SrcLineData%Td) @@ -2375,8 +2297,6 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) end if end if DstLineData%Td = SrcLineData%Td - else if (allocated(DstLineData%Td)) then - deallocate(DstLineData%Td) end if if (allocated(SrcLineData%W)) then LB(1:2) = lbound(SrcLineData%W) @@ -2389,8 +2309,6 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) end if end if DstLineData%W = SrcLineData%W - else if (allocated(DstLineData%W)) then - deallocate(DstLineData%W) end if if (allocated(SrcLineData%Dp)) then LB(1:2) = lbound(SrcLineData%Dp) @@ -2403,8 +2321,6 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) end if end if DstLineData%Dp = SrcLineData%Dp - else if (allocated(DstLineData%Dp)) then - deallocate(DstLineData%Dp) end if if (allocated(SrcLineData%Dq)) then LB(1:2) = lbound(SrcLineData%Dq) @@ -2417,8 +2333,6 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) end if end if DstLineData%Dq = SrcLineData%Dq - else if (allocated(DstLineData%Dq)) then - deallocate(DstLineData%Dq) end if if (allocated(SrcLineData%Ap)) then LB(1:2) = lbound(SrcLineData%Ap) @@ -2431,8 +2345,6 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) end if end if DstLineData%Ap = SrcLineData%Ap - else if (allocated(DstLineData%Ap)) then - deallocate(DstLineData%Ap) end if if (allocated(SrcLineData%Aq)) then LB(1:2) = lbound(SrcLineData%Aq) @@ -2445,8 +2357,6 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) end if end if DstLineData%Aq = SrcLineData%Aq - else if (allocated(DstLineData%Aq)) then - deallocate(DstLineData%Aq) end if if (allocated(SrcLineData%B)) then LB(1:2) = lbound(SrcLineData%B) @@ -2459,8 +2369,6 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) end if end if DstLineData%B = SrcLineData%B - else if (allocated(DstLineData%B)) then - deallocate(DstLineData%B) end if if (allocated(SrcLineData%Bs)) then LB(1:2) = lbound(SrcLineData%Bs) @@ -2473,8 +2381,6 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) end if end if DstLineData%Bs = SrcLineData%Bs - else if (allocated(DstLineData%Bs)) then - deallocate(DstLineData%Bs) end if if (allocated(SrcLineData%Fnet)) then LB(1:2) = lbound(SrcLineData%Fnet) @@ -2487,8 +2393,6 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) end if end if DstLineData%Fnet = SrcLineData%Fnet - else if (allocated(DstLineData%Fnet)) then - deallocate(DstLineData%Fnet) end if if (allocated(SrcLineData%S)) then LB(1:3) = lbound(SrcLineData%S) @@ -2501,8 +2405,6 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) end if end if DstLineData%S = SrcLineData%S - else if (allocated(DstLineData%S)) then - deallocate(DstLineData%S) end if if (allocated(SrcLineData%M)) then LB(1:3) = lbound(SrcLineData%M) @@ -2515,8 +2417,6 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) end if end if DstLineData%M = SrcLineData%M - else if (allocated(DstLineData%M)) then - deallocate(DstLineData%M) end if DstLineData%EndMomentA = SrcLineData%EndMomentA DstLineData%EndMomentB = SrcLineData%EndMomentB @@ -2532,8 +2432,6 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) end if end if DstLineData%LineWrOutput = SrcLineData%LineWrOutput - else if (allocated(DstLineData%LineWrOutput)) then - deallocate(DstLineData%LineWrOutput) end if end subroutine @@ -3406,8 +3304,6 @@ subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%writeOutputHdr = SrcInitOutputData%writeOutputHdr - else if (allocated(DstInitOutputData%writeOutputHdr)) then - deallocate(DstInitOutputData%writeOutputHdr) end if if (allocated(SrcInitOutputData%writeOutputUnt)) then LB(1:1) = lbound(SrcInitOutputData%writeOutputUnt) @@ -3420,8 +3316,6 @@ subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%writeOutputUnt = SrcInitOutputData%writeOutputUnt - else if (allocated(DstInitOutputData%writeOutputUnt)) then - deallocate(DstInitOutputData%writeOutputUnt) end if call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3437,8 +3331,6 @@ subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%CableCChanRqst = SrcInitOutputData%CableCChanRqst - else if (allocated(DstInitOutputData%CableCChanRqst)) then - deallocate(DstInitOutputData%CableCChanRqst) end if if (allocated(SrcInitOutputData%LinNames_y)) then LB(1:1) = lbound(SrcInitOutputData%LinNames_y) @@ -3451,8 +3343,6 @@ subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y - else if (allocated(DstInitOutputData%LinNames_y)) then - deallocate(DstInitOutputData%LinNames_y) end if if (allocated(SrcInitOutputData%LinNames_x)) then LB(1:1) = lbound(SrcInitOutputData%LinNames_x) @@ -3465,8 +3355,6 @@ subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x - else if (allocated(DstInitOutputData%LinNames_x)) then - deallocate(DstInitOutputData%LinNames_x) end if if (allocated(SrcInitOutputData%LinNames_u)) then LB(1:1) = lbound(SrcInitOutputData%LinNames_u) @@ -3479,8 +3367,6 @@ subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u - else if (allocated(DstInitOutputData%LinNames_u)) then - deallocate(DstInitOutputData%LinNames_u) end if if (allocated(SrcInitOutputData%RotFrame_y)) then LB(1:1) = lbound(SrcInitOutputData%RotFrame_y) @@ -3493,8 +3379,6 @@ subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y - else if (allocated(DstInitOutputData%RotFrame_y)) then - deallocate(DstInitOutputData%RotFrame_y) end if if (allocated(SrcInitOutputData%RotFrame_x)) then LB(1:1) = lbound(SrcInitOutputData%RotFrame_x) @@ -3507,8 +3391,6 @@ subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x - else if (allocated(DstInitOutputData%RotFrame_x)) then - deallocate(DstInitOutputData%RotFrame_x) end if if (allocated(SrcInitOutputData%RotFrame_u)) then LB(1:1) = lbound(SrcInitOutputData%RotFrame_u) @@ -3521,8 +3403,6 @@ subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u - else if (allocated(DstInitOutputData%RotFrame_u)) then - deallocate(DstInitOutputData%RotFrame_u) end if if (allocated(SrcInitOutputData%IsLoad_u)) then LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) @@ -3535,8 +3415,6 @@ subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u - else if (allocated(DstInitOutputData%IsLoad_u)) then - deallocate(DstInitOutputData%IsLoad_u) end if if (allocated(SrcInitOutputData%DerivOrder_x)) then LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) @@ -3549,8 +3427,6 @@ subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x - else if (allocated(DstInitOutputData%DerivOrder_x)) then - deallocate(DstInitOutputData%DerivOrder_x) end if end subroutine @@ -3851,8 +3727,6 @@ subroutine MD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSta end if end if DstContStateData%states = SrcContStateData%states - else if (allocated(DstContStateData%states)) then - deallocate(DstContStateData%states) end if end subroutine @@ -4050,8 +3924,6 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstMiscData%LineTypeList)) then - deallocate(DstMiscData%LineTypeList) end if if (allocated(SrcMiscData%RodTypeList)) then LB(1:1) = lbound(SrcMiscData%RodTypeList) @@ -4068,8 +3940,6 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstMiscData%RodTypeList)) then - deallocate(DstMiscData%RodTypeList) end if call MD_CopyBody(SrcMiscData%GroundBody, DstMiscData%GroundBody, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4089,8 +3959,6 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstMiscData%BodyList)) then - deallocate(DstMiscData%BodyList) end if if (allocated(SrcMiscData%RodList)) then LB(1:1) = lbound(SrcMiscData%RodList) @@ -4107,8 +3975,6 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstMiscData%RodList)) then - deallocate(DstMiscData%RodList) end if if (allocated(SrcMiscData%ConnectList)) then LB(1:1) = lbound(SrcMiscData%ConnectList) @@ -4125,8 +3991,6 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstMiscData%ConnectList)) then - deallocate(DstMiscData%ConnectList) end if if (allocated(SrcMiscData%LineList)) then LB(1:1) = lbound(SrcMiscData%LineList) @@ -4143,8 +4007,6 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstMiscData%LineList)) then - deallocate(DstMiscData%LineList) end if if (allocated(SrcMiscData%FailList)) then LB(1:1) = lbound(SrcMiscData%FailList) @@ -4161,8 +4023,6 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstMiscData%FailList)) then - deallocate(DstMiscData%FailList) end if if (allocated(SrcMiscData%FreeConIs)) then LB(1:1) = lbound(SrcMiscData%FreeConIs) @@ -4175,8 +4035,6 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%FreeConIs = SrcMiscData%FreeConIs - else if (allocated(DstMiscData%FreeConIs)) then - deallocate(DstMiscData%FreeConIs) end if if (allocated(SrcMiscData%CpldConIs)) then LB(1:2) = lbound(SrcMiscData%CpldConIs) @@ -4189,8 +4047,6 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%CpldConIs = SrcMiscData%CpldConIs - else if (allocated(DstMiscData%CpldConIs)) then - deallocate(DstMiscData%CpldConIs) end if if (allocated(SrcMiscData%FreeRodIs)) then LB(1:1) = lbound(SrcMiscData%FreeRodIs) @@ -4203,8 +4059,6 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%FreeRodIs = SrcMiscData%FreeRodIs - else if (allocated(DstMiscData%FreeRodIs)) then - deallocate(DstMiscData%FreeRodIs) end if if (allocated(SrcMiscData%CpldRodIs)) then LB(1:2) = lbound(SrcMiscData%CpldRodIs) @@ -4217,8 +4071,6 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%CpldRodIs = SrcMiscData%CpldRodIs - else if (allocated(DstMiscData%CpldRodIs)) then - deallocate(DstMiscData%CpldRodIs) end if if (allocated(SrcMiscData%FreeBodyIs)) then LB(1:1) = lbound(SrcMiscData%FreeBodyIs) @@ -4231,8 +4083,6 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%FreeBodyIs = SrcMiscData%FreeBodyIs - else if (allocated(DstMiscData%FreeBodyIs)) then - deallocate(DstMiscData%FreeBodyIs) end if if (allocated(SrcMiscData%CpldBodyIs)) then LB(1:2) = lbound(SrcMiscData%CpldBodyIs) @@ -4245,8 +4095,6 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%CpldBodyIs = SrcMiscData%CpldBodyIs - else if (allocated(DstMiscData%CpldBodyIs)) then - deallocate(DstMiscData%CpldBodyIs) end if if (allocated(SrcMiscData%LineStateIs1)) then LB(1:1) = lbound(SrcMiscData%LineStateIs1) @@ -4259,8 +4107,6 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%LineStateIs1 = SrcMiscData%LineStateIs1 - else if (allocated(DstMiscData%LineStateIs1)) then - deallocate(DstMiscData%LineStateIs1) end if if (allocated(SrcMiscData%LineStateIsN)) then LB(1:1) = lbound(SrcMiscData%LineStateIsN) @@ -4273,8 +4119,6 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%LineStateIsN = SrcMiscData%LineStateIsN - else if (allocated(DstMiscData%LineStateIsN)) then - deallocate(DstMiscData%LineStateIsN) end if if (allocated(SrcMiscData%ConStateIs1)) then LB(1:1) = lbound(SrcMiscData%ConStateIs1) @@ -4287,8 +4131,6 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%ConStateIs1 = SrcMiscData%ConStateIs1 - else if (allocated(DstMiscData%ConStateIs1)) then - deallocate(DstMiscData%ConStateIs1) end if if (allocated(SrcMiscData%ConStateIsN)) then LB(1:1) = lbound(SrcMiscData%ConStateIsN) @@ -4301,8 +4143,6 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%ConStateIsN = SrcMiscData%ConStateIsN - else if (allocated(DstMiscData%ConStateIsN)) then - deallocate(DstMiscData%ConStateIsN) end if if (allocated(SrcMiscData%RodStateIs1)) then LB(1:1) = lbound(SrcMiscData%RodStateIs1) @@ -4315,8 +4155,6 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%RodStateIs1 = SrcMiscData%RodStateIs1 - else if (allocated(DstMiscData%RodStateIs1)) then - deallocate(DstMiscData%RodStateIs1) end if if (allocated(SrcMiscData%RodStateIsN)) then LB(1:1) = lbound(SrcMiscData%RodStateIsN) @@ -4329,8 +4167,6 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%RodStateIsN = SrcMiscData%RodStateIsN - else if (allocated(DstMiscData%RodStateIsN)) then - deallocate(DstMiscData%RodStateIsN) end if if (allocated(SrcMiscData%BodyStateIs1)) then LB(1:1) = lbound(SrcMiscData%BodyStateIs1) @@ -4343,8 +4179,6 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%BodyStateIs1 = SrcMiscData%BodyStateIs1 - else if (allocated(DstMiscData%BodyStateIs1)) then - deallocate(DstMiscData%BodyStateIs1) end if if (allocated(SrcMiscData%BodyStateIsN)) then LB(1:1) = lbound(SrcMiscData%BodyStateIsN) @@ -4357,8 +4191,6 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%BodyStateIsN = SrcMiscData%BodyStateIsN - else if (allocated(DstMiscData%BodyStateIsN)) then - deallocate(DstMiscData%BodyStateIsN) end if DstMiscData%Nx = SrcMiscData%Nx DstMiscData%WaveTi = SrcMiscData%WaveTi @@ -4380,8 +4212,6 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%MDWrOutput = SrcMiscData%MDWrOutput - else if (allocated(DstMiscData%MDWrOutput)) then - deallocate(DstMiscData%MDWrOutput) end if DstMiscData%LastOutTime = SrcMiscData%LastOutTime DstMiscData%PtfmInit = SrcMiscData%PtfmInit @@ -4396,8 +4226,6 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%BathymetryGrid = SrcMiscData%BathymetryGrid - else if (allocated(DstMiscData%BathymetryGrid)) then - deallocate(DstMiscData%BathymetryGrid) end if if (allocated(SrcMiscData%BathGrid_Xs)) then LB(1:1) = lbound(SrcMiscData%BathGrid_Xs) @@ -4410,8 +4238,6 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%BathGrid_Xs = SrcMiscData%BathGrid_Xs - else if (allocated(DstMiscData%BathGrid_Xs)) then - deallocate(DstMiscData%BathGrid_Xs) end if if (allocated(SrcMiscData%BathGrid_Ys)) then LB(1:1) = lbound(SrcMiscData%BathGrid_Ys) @@ -4424,8 +4250,6 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%BathGrid_Ys = SrcMiscData%BathGrid_Ys - else if (allocated(DstMiscData%BathGrid_Ys)) then - deallocate(DstMiscData%BathGrid_Ys) end if if (allocated(SrcMiscData%BathGrid_npoints)) then LB(1:1) = lbound(SrcMiscData%BathGrid_npoints) @@ -4438,8 +4262,6 @@ subroutine MD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%BathGrid_npoints = SrcMiscData%BathGrid_npoints - else if (allocated(DstMiscData%BathGrid_npoints)) then - deallocate(DstMiscData%BathGrid_npoints) end if end subroutine @@ -5189,8 +5011,6 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%nCpldBodies = SrcParamData%nCpldBodies - else if (allocated(DstParamData%nCpldBodies)) then - deallocate(DstParamData%nCpldBodies) end if if (allocated(SrcParamData%nCpldRods)) then LB(1:1) = lbound(SrcParamData%nCpldRods) @@ -5203,8 +5023,6 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%nCpldRods = SrcParamData%nCpldRods - else if (allocated(DstParamData%nCpldRods)) then - deallocate(DstParamData%nCpldRods) end if if (allocated(SrcParamData%nCpldCons)) then LB(1:1) = lbound(SrcParamData%nCpldCons) @@ -5217,8 +5035,6 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%nCpldCons = SrcParamData%nCpldCons - else if (allocated(DstParamData%nCpldCons)) then - deallocate(DstParamData%nCpldCons) end if DstParamData%NConns = SrcParamData%NConns DstParamData%NAnchs = SrcParamData%NAnchs @@ -5248,8 +5064,6 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstParamData%OutParam)) then - deallocate(DstParamData%OutParam) end if DstParamData%Delim = SrcParamData%Delim DstParamData%MDUnOut = SrcParamData%MDUnOut @@ -5270,8 +5084,6 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%TurbineRefPos = SrcParamData%TurbineRefPos - else if (allocated(DstParamData%TurbineRefPos)) then - deallocate(DstParamData%TurbineRefPos) end if DstParamData%mu_kT = SrcParamData%mu_kT DstParamData%mu_kA = SrcParamData%mu_kA @@ -5292,8 +5104,6 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%pxWave = SrcParamData%pxWave - else if (allocated(DstParamData%pxWave)) then - deallocate(DstParamData%pxWave) end if if (allocated(SrcParamData%pyWave)) then LB(1:1) = lbound(SrcParamData%pyWave) @@ -5306,8 +5116,6 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%pyWave = SrcParamData%pyWave - else if (allocated(DstParamData%pyWave)) then - deallocate(DstParamData%pyWave) end if if (allocated(SrcParamData%pzWave)) then LB(1:1) = lbound(SrcParamData%pzWave) @@ -5320,8 +5128,6 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%pzWave = SrcParamData%pzWave - else if (allocated(DstParamData%pzWave)) then - deallocate(DstParamData%pzWave) end if DstParamData%dtWave = SrcParamData%dtWave if (allocated(SrcParamData%uxWave)) then @@ -5335,8 +5141,6 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%uxWave = SrcParamData%uxWave - else if (allocated(DstParamData%uxWave)) then - deallocate(DstParamData%uxWave) end if if (allocated(SrcParamData%uyWave)) then LB(1:4) = lbound(SrcParamData%uyWave) @@ -5349,8 +5153,6 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%uyWave = SrcParamData%uyWave - else if (allocated(DstParamData%uyWave)) then - deallocate(DstParamData%uyWave) end if if (allocated(SrcParamData%uzWave)) then LB(1:4) = lbound(SrcParamData%uzWave) @@ -5363,8 +5165,6 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%uzWave = SrcParamData%uzWave - else if (allocated(DstParamData%uzWave)) then - deallocate(DstParamData%uzWave) end if if (allocated(SrcParamData%axWave)) then LB(1:4) = lbound(SrcParamData%axWave) @@ -5377,8 +5177,6 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%axWave = SrcParamData%axWave - else if (allocated(DstParamData%axWave)) then - deallocate(DstParamData%axWave) end if if (allocated(SrcParamData%ayWave)) then LB(1:4) = lbound(SrcParamData%ayWave) @@ -5391,8 +5189,6 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%ayWave = SrcParamData%ayWave - else if (allocated(DstParamData%ayWave)) then - deallocate(DstParamData%ayWave) end if if (allocated(SrcParamData%azWave)) then LB(1:4) = lbound(SrcParamData%azWave) @@ -5405,8 +5201,6 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%azWave = SrcParamData%azWave - else if (allocated(DstParamData%azWave)) then - deallocate(DstParamData%azWave) end if if (allocated(SrcParamData%PDyn)) then LB(1:4) = lbound(SrcParamData%PDyn) @@ -5419,8 +5213,6 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%PDyn = SrcParamData%PDyn - else if (allocated(DstParamData%PDyn)) then - deallocate(DstParamData%PDyn) end if if (allocated(SrcParamData%zeta)) then LB(1:3) = lbound(SrcParamData%zeta) @@ -5433,8 +5225,6 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%zeta = SrcParamData%zeta - else if (allocated(DstParamData%zeta)) then - deallocate(DstParamData%zeta) end if DstParamData%nzCurrent = SrcParamData%nzCurrent if (allocated(SrcParamData%pzCurrent)) then @@ -5448,8 +5238,6 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%pzCurrent = SrcParamData%pzCurrent - else if (allocated(DstParamData%pzCurrent)) then - deallocate(DstParamData%pzCurrent) end if if (allocated(SrcParamData%uxCurrent)) then LB(1:1) = lbound(SrcParamData%uxCurrent) @@ -5462,8 +5250,6 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%uxCurrent = SrcParamData%uxCurrent - else if (allocated(DstParamData%uxCurrent)) then - deallocate(DstParamData%uxCurrent) end if if (allocated(SrcParamData%uyCurrent)) then LB(1:1) = lbound(SrcParamData%uyCurrent) @@ -5476,8 +5262,6 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%uyCurrent = SrcParamData%uyCurrent - else if (allocated(DstParamData%uyCurrent)) then - deallocate(DstParamData%uyCurrent) end if DstParamData%Nx0 = SrcParamData%Nx0 if (allocated(SrcParamData%Jac_u_indx)) then @@ -5491,8 +5275,6 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx - else if (allocated(DstParamData%Jac_u_indx)) then - deallocate(DstParamData%Jac_u_indx) end if if (allocated(SrcParamData%du)) then LB(1:1) = lbound(SrcParamData%du) @@ -5505,8 +5287,6 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%du = SrcParamData%du - else if (allocated(DstParamData%du)) then - deallocate(DstParamData%du) end if if (allocated(SrcParamData%dx)) then LB(1:1) = lbound(SrcParamData%dx) @@ -5519,8 +5299,6 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%dx = SrcParamData%dx - else if (allocated(DstParamData%dx)) then - deallocate(DstParamData%dx) end if DstParamData%Jac_ny = SrcParamData%Jac_ny DstParamData%Jac_nx = SrcParamData%Jac_nx @@ -5535,8 +5313,6 @@ subroutine MD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%dxIdx_map2_xStateIdx = SrcParamData%dxIdx_map2_xStateIdx - else if (allocated(DstParamData%dxIdx_map2_xStateIdx)) then - deallocate(DstParamData%dxIdx_map2_xStateIdx) end if end subroutine @@ -6257,8 +6033,6 @@ subroutine MD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstInputData%CoupledKinematics)) then - deallocate(DstInputData%CoupledKinematics) end if if (allocated(SrcInputData%DeltaL)) then LB(1:1) = lbound(SrcInputData%DeltaL) @@ -6271,8 +6045,6 @@ subroutine MD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%DeltaL = SrcInputData%DeltaL - else if (allocated(DstInputData%DeltaL)) then - deallocate(DstInputData%DeltaL) end if if (allocated(SrcInputData%DeltaLdot)) then LB(1:1) = lbound(SrcInputData%DeltaLdot) @@ -6285,8 +6057,6 @@ subroutine MD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%DeltaLdot = SrcInputData%DeltaLdot - else if (allocated(DstInputData%DeltaLdot)) then - deallocate(DstInputData%DeltaLdot) end if end subroutine @@ -6429,8 +6199,6 @@ subroutine MD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstOutputData%CoupledLoads)) then - deallocate(DstOutputData%CoupledLoads) end if if (allocated(SrcOutputData%WriteOutput)) then LB(1:1) = lbound(SrcOutputData%WriteOutput) @@ -6443,8 +6211,6 @@ subroutine MD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg end if end if DstOutputData%WriteOutput = SrcOutputData%WriteOutput - else if (allocated(DstOutputData%WriteOutput)) then - deallocate(DstOutputData%WriteOutput) end if end subroutine diff --git a/modules/nwtc-library/src/NWTC_Library_Types.f90 b/modules/nwtc-library/src/NWTC_Library_Types.f90 index f08bd4e953..2c35e2c5e7 100644 --- a/modules/nwtc-library/src/NWTC_Library_Types.f90 +++ b/modules/nwtc-library/src/NWTC_Library_Types.f90 @@ -161,8 +161,6 @@ subroutine NWTC_Library_CopyFASTdataType(SrcFASTdataTypeData, DstFASTdataTypeDat end if end if DstFASTdataTypeData%ChanNames = SrcFASTdataTypeData%ChanNames - else if (allocated(DstFASTdataTypeData%ChanNames)) then - deallocate(DstFASTdataTypeData%ChanNames) end if if (allocated(SrcFASTdataTypeData%ChanUnits)) then LB(1:1) = lbound(SrcFASTdataTypeData%ChanUnits) @@ -175,8 +173,6 @@ subroutine NWTC_Library_CopyFASTdataType(SrcFASTdataTypeData, DstFASTdataTypeDat end if end if DstFASTdataTypeData%ChanUnits = SrcFASTdataTypeData%ChanUnits - else if (allocated(DstFASTdataTypeData%ChanUnits)) then - deallocate(DstFASTdataTypeData%ChanUnits) end if if (allocated(SrcFASTdataTypeData%Data)) then LB(1:2) = lbound(SrcFASTdataTypeData%Data) @@ -189,8 +185,6 @@ subroutine NWTC_Library_CopyFASTdataType(SrcFASTdataTypeData, DstFASTdataTypeDat end if end if DstFASTdataTypeData%Data = SrcFASTdataTypeData%Data - else if (allocated(DstFASTdataTypeData%Data)) then - deallocate(DstFASTdataTypeData%Data) end if end subroutine @@ -377,8 +371,6 @@ subroutine NWTC_Library_CopyFileInfoType(SrcFileInfoTypeData, DstFileInfoTypeDat end if end if DstFileInfoTypeData%FileLine = SrcFileInfoTypeData%FileLine - else if (allocated(DstFileInfoTypeData%FileLine)) then - deallocate(DstFileInfoTypeData%FileLine) end if if (allocated(SrcFileInfoTypeData%FileIndx)) then LB(1:1) = lbound(SrcFileInfoTypeData%FileIndx) @@ -391,8 +383,6 @@ subroutine NWTC_Library_CopyFileInfoType(SrcFileInfoTypeData, DstFileInfoTypeDat end if end if DstFileInfoTypeData%FileIndx = SrcFileInfoTypeData%FileIndx - else if (allocated(DstFileInfoTypeData%FileIndx)) then - deallocate(DstFileInfoTypeData%FileIndx) end if if (allocated(SrcFileInfoTypeData%FileList)) then LB(1:1) = lbound(SrcFileInfoTypeData%FileList) @@ -405,8 +395,6 @@ subroutine NWTC_Library_CopyFileInfoType(SrcFileInfoTypeData, DstFileInfoTypeDat end if end if DstFileInfoTypeData%FileList = SrcFileInfoTypeData%FileList - else if (allocated(DstFileInfoTypeData%FileList)) then - deallocate(DstFileInfoTypeData%FileList) end if if (allocated(SrcFileInfoTypeData%Lines)) then LB(1:1) = lbound(SrcFileInfoTypeData%Lines) @@ -419,8 +407,6 @@ subroutine NWTC_Library_CopyFileInfoType(SrcFileInfoTypeData, DstFileInfoTypeDat end if end if DstFileInfoTypeData%Lines = SrcFileInfoTypeData%Lines - else if (allocated(DstFileInfoTypeData%Lines)) then - deallocate(DstFileInfoTypeData%Lines) end if end subroutine @@ -612,8 +598,6 @@ subroutine NWTC_Library_CopyNWTC_RandomNumber_ParameterType(SrcNWTC_RandomNumber end if end if DstNWTC_RandomNumber_ParameterTypeData%RandSeedAry = SrcNWTC_RandomNumber_ParameterTypeData%RandSeedAry - else if (allocated(DstNWTC_RandomNumber_ParameterTypeData%RandSeedAry)) then - deallocate(DstNWTC_RandomNumber_ParameterTypeData%RandSeedAry) end if DstNWTC_RandomNumber_ParameterTypeData%RNG_type = SrcNWTC_RandomNumber_ParameterTypeData%RNG_type end subroutine diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index d63d1fba03..6ac3842ba1 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -830,8 +830,6 @@ subroutine FAST_CopyVTK_BLSurfaceType(SrcVTK_BLSurfaceTypeData, DstVTK_BLSurface end if end if DstVTK_BLSurfaceTypeData%AirfoilCoords = SrcVTK_BLSurfaceTypeData%AirfoilCoords - else if (allocated(DstVTK_BLSurfaceTypeData%AirfoilCoords)) then - deallocate(DstVTK_BLSurfaceTypeData%AirfoilCoords) end if end subroutine @@ -912,8 +910,6 @@ subroutine FAST_CopyVTK_SurfaceType(SrcVTK_SurfaceTypeData, DstVTK_SurfaceTypeDa end if end if DstVTK_SurfaceTypeData%TowerRad = SrcVTK_SurfaceTypeData%TowerRad - else if (allocated(DstVTK_SurfaceTypeData%TowerRad)) then - deallocate(DstVTK_SurfaceTypeData%TowerRad) end if DstVTK_SurfaceTypeData%NWaveElevPts = SrcVTK_SurfaceTypeData%NWaveElevPts if (allocated(SrcVTK_SurfaceTypeData%WaveElevXY)) then @@ -927,8 +923,6 @@ subroutine FAST_CopyVTK_SurfaceType(SrcVTK_SurfaceTypeData, DstVTK_SurfaceTypeDa end if end if DstVTK_SurfaceTypeData%WaveElevXY = SrcVTK_SurfaceTypeData%WaveElevXY - else if (allocated(DstVTK_SurfaceTypeData%WaveElevXY)) then - deallocate(DstVTK_SurfaceTypeData%WaveElevXY) end if if (allocated(SrcVTK_SurfaceTypeData%WaveElev)) then LB(1:2) = lbound(SrcVTK_SurfaceTypeData%WaveElev) @@ -941,8 +935,6 @@ subroutine FAST_CopyVTK_SurfaceType(SrcVTK_SurfaceTypeData, DstVTK_SurfaceTypeDa end if end if DstVTK_SurfaceTypeData%WaveElev = SrcVTK_SurfaceTypeData%WaveElev - else if (allocated(DstVTK_SurfaceTypeData%WaveElev)) then - deallocate(DstVTK_SurfaceTypeData%WaveElev) end if if (allocated(SrcVTK_SurfaceTypeData%BladeShape)) then LB(1:1) = lbound(SrcVTK_SurfaceTypeData%BladeShape) @@ -959,8 +951,6 @@ subroutine FAST_CopyVTK_SurfaceType(SrcVTK_SurfaceTypeData, DstVTK_SurfaceTypeDa call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstVTK_SurfaceTypeData%BladeShape)) then - deallocate(DstVTK_SurfaceTypeData%BladeShape) end if if (allocated(SrcVTK_SurfaceTypeData%MorisonRad)) then LB(1:1) = lbound(SrcVTK_SurfaceTypeData%MorisonRad) @@ -973,8 +963,6 @@ subroutine FAST_CopyVTK_SurfaceType(SrcVTK_SurfaceTypeData, DstVTK_SurfaceTypeDa end if end if DstVTK_SurfaceTypeData%MorisonRad = SrcVTK_SurfaceTypeData%MorisonRad - else if (allocated(DstVTK_SurfaceTypeData%MorisonRad)) then - deallocate(DstVTK_SurfaceTypeData%MorisonRad) end if end subroutine @@ -1173,8 +1161,6 @@ subroutine FAST_CopyVTK_ModeShapeType(SrcVTK_ModeShapeTypeData, DstVTK_ModeShape end if end if DstVTK_ModeShapeTypeData%VTKModes = SrcVTK_ModeShapeTypeData%VTKModes - else if (allocated(DstVTK_ModeShapeTypeData%VTKModes)) then - deallocate(DstVTK_ModeShapeTypeData%VTKModes) end if DstVTK_ModeShapeTypeData%VTKLinTim = SrcVTK_ModeShapeTypeData%VTKLinTim DstVTK_ModeShapeTypeData%VTKNLinTimes = SrcVTK_ModeShapeTypeData%VTKNLinTimes @@ -1191,8 +1177,6 @@ subroutine FAST_CopyVTK_ModeShapeType(SrcVTK_ModeShapeTypeData, DstVTK_ModeShape end if end if DstVTK_ModeShapeTypeData%DampingRatio = SrcVTK_ModeShapeTypeData%DampingRatio - else if (allocated(DstVTK_ModeShapeTypeData%DampingRatio)) then - deallocate(DstVTK_ModeShapeTypeData%DampingRatio) end if if (allocated(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz)) then LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz) @@ -1205,8 +1189,6 @@ subroutine FAST_CopyVTK_ModeShapeType(SrcVTK_ModeShapeTypeData, DstVTK_ModeShape end if end if DstVTK_ModeShapeTypeData%NaturalFreq_Hz = SrcVTK_ModeShapeTypeData%NaturalFreq_Hz - else if (allocated(DstVTK_ModeShapeTypeData%NaturalFreq_Hz)) then - deallocate(DstVTK_ModeShapeTypeData%NaturalFreq_Hz) end if if (allocated(SrcVTK_ModeShapeTypeData%DampedFreq_Hz)) then LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%DampedFreq_Hz) @@ -1219,8 +1201,6 @@ subroutine FAST_CopyVTK_ModeShapeType(SrcVTK_ModeShapeTypeData, DstVTK_ModeShape end if end if DstVTK_ModeShapeTypeData%DampedFreq_Hz = SrcVTK_ModeShapeTypeData%DampedFreq_Hz - else if (allocated(DstVTK_ModeShapeTypeData%DampedFreq_Hz)) then - deallocate(DstVTK_ModeShapeTypeData%DampedFreq_Hz) end if if (allocated(SrcVTK_ModeShapeTypeData%x_eig_magnitude)) then LB(1:3) = lbound(SrcVTK_ModeShapeTypeData%x_eig_magnitude) @@ -1233,8 +1213,6 @@ subroutine FAST_CopyVTK_ModeShapeType(SrcVTK_ModeShapeTypeData, DstVTK_ModeShape end if end if DstVTK_ModeShapeTypeData%x_eig_magnitude = SrcVTK_ModeShapeTypeData%x_eig_magnitude - else if (allocated(DstVTK_ModeShapeTypeData%x_eig_magnitude)) then - deallocate(DstVTK_ModeShapeTypeData%x_eig_magnitude) end if if (allocated(SrcVTK_ModeShapeTypeData%x_eig_phase)) then LB(1:3) = lbound(SrcVTK_ModeShapeTypeData%x_eig_phase) @@ -1247,8 +1225,6 @@ subroutine FAST_CopyVTK_ModeShapeType(SrcVTK_ModeShapeTypeData, DstVTK_ModeShape end if end if DstVTK_ModeShapeTypeData%x_eig_phase = SrcVTK_ModeShapeTypeData%x_eig_phase - else if (allocated(DstVTK_ModeShapeTypeData%x_eig_phase)) then - deallocate(DstVTK_ModeShapeTypeData%x_eig_phase) end if end subroutine @@ -1883,8 +1859,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC if (ErrStat >= AbortErrLev) return end do end do - else if (allocated(DstLinStateSaveData%x_IceD)) then - deallocate(DstLinStateSaveData%x_IceD) end if if (allocated(SrcLinStateSaveData%xd_IceD)) then LB(1:2) = lbound(SrcLinStateSaveData%xd_IceD) @@ -1903,8 +1877,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC if (ErrStat >= AbortErrLev) return end do end do - else if (allocated(DstLinStateSaveData%xd_IceD)) then - deallocate(DstLinStateSaveData%xd_IceD) end if if (allocated(SrcLinStateSaveData%z_IceD)) then LB(1:2) = lbound(SrcLinStateSaveData%z_IceD) @@ -1923,8 +1895,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC if (ErrStat >= AbortErrLev) return end do end do - else if (allocated(DstLinStateSaveData%z_IceD)) then - deallocate(DstLinStateSaveData%z_IceD) end if if (allocated(SrcLinStateSaveData%OtherSt_IceD)) then LB(1:2) = lbound(SrcLinStateSaveData%OtherSt_IceD) @@ -1943,8 +1913,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC if (ErrStat >= AbortErrLev) return end do end do - else if (allocated(DstLinStateSaveData%OtherSt_IceD)) then - deallocate(DstLinStateSaveData%OtherSt_IceD) end if if (allocated(SrcLinStateSaveData%u_IceD)) then LB(1:2) = lbound(SrcLinStateSaveData%u_IceD) @@ -1963,8 +1931,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC if (ErrStat >= AbortErrLev) return end do end do - else if (allocated(DstLinStateSaveData%u_IceD)) then - deallocate(DstLinStateSaveData%u_IceD) end if if (allocated(SrcLinStateSaveData%x_BD)) then LB(1:2) = lbound(SrcLinStateSaveData%x_BD) @@ -1983,8 +1949,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC if (ErrStat >= AbortErrLev) return end do end do - else if (allocated(DstLinStateSaveData%x_BD)) then - deallocate(DstLinStateSaveData%x_BD) end if if (allocated(SrcLinStateSaveData%xd_BD)) then LB(1:2) = lbound(SrcLinStateSaveData%xd_BD) @@ -2003,8 +1967,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC if (ErrStat >= AbortErrLev) return end do end do - else if (allocated(DstLinStateSaveData%xd_BD)) then - deallocate(DstLinStateSaveData%xd_BD) end if if (allocated(SrcLinStateSaveData%z_BD)) then LB(1:2) = lbound(SrcLinStateSaveData%z_BD) @@ -2023,8 +1985,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC if (ErrStat >= AbortErrLev) return end do end do - else if (allocated(DstLinStateSaveData%z_BD)) then - deallocate(DstLinStateSaveData%z_BD) end if if (allocated(SrcLinStateSaveData%OtherSt_BD)) then LB(1:2) = lbound(SrcLinStateSaveData%OtherSt_BD) @@ -2043,8 +2003,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC if (ErrStat >= AbortErrLev) return end do end do - else if (allocated(DstLinStateSaveData%OtherSt_BD)) then - deallocate(DstLinStateSaveData%OtherSt_BD) end if if (allocated(SrcLinStateSaveData%u_BD)) then LB(1:2) = lbound(SrcLinStateSaveData%u_BD) @@ -2063,8 +2021,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC if (ErrStat >= AbortErrLev) return end do end do - else if (allocated(DstLinStateSaveData%u_BD)) then - deallocate(DstLinStateSaveData%u_BD) end if if (allocated(SrcLinStateSaveData%x_ED)) then LB(1:1) = lbound(SrcLinStateSaveData%x_ED) @@ -2081,8 +2037,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%x_ED)) then - deallocate(DstLinStateSaveData%x_ED) end if if (allocated(SrcLinStateSaveData%xd_ED)) then LB(1:1) = lbound(SrcLinStateSaveData%xd_ED) @@ -2099,8 +2053,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%xd_ED)) then - deallocate(DstLinStateSaveData%xd_ED) end if if (allocated(SrcLinStateSaveData%z_ED)) then LB(1:1) = lbound(SrcLinStateSaveData%z_ED) @@ -2117,8 +2069,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%z_ED)) then - deallocate(DstLinStateSaveData%z_ED) end if if (allocated(SrcLinStateSaveData%OtherSt_ED)) then LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_ED) @@ -2135,8 +2085,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%OtherSt_ED)) then - deallocate(DstLinStateSaveData%OtherSt_ED) end if if (allocated(SrcLinStateSaveData%u_ED)) then LB(1:1) = lbound(SrcLinStateSaveData%u_ED) @@ -2153,8 +2101,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%u_ED)) then - deallocate(DstLinStateSaveData%u_ED) end if if (allocated(SrcLinStateSaveData%x_SrvD)) then LB(1:1) = lbound(SrcLinStateSaveData%x_SrvD) @@ -2171,8 +2117,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%x_SrvD)) then - deallocate(DstLinStateSaveData%x_SrvD) end if if (allocated(SrcLinStateSaveData%xd_SrvD)) then LB(1:1) = lbound(SrcLinStateSaveData%xd_SrvD) @@ -2189,8 +2133,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%xd_SrvD)) then - deallocate(DstLinStateSaveData%xd_SrvD) end if if (allocated(SrcLinStateSaveData%z_SrvD)) then LB(1:1) = lbound(SrcLinStateSaveData%z_SrvD) @@ -2207,8 +2149,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%z_SrvD)) then - deallocate(DstLinStateSaveData%z_SrvD) end if if (allocated(SrcLinStateSaveData%OtherSt_SrvD)) then LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_SrvD) @@ -2225,8 +2165,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%OtherSt_SrvD)) then - deallocate(DstLinStateSaveData%OtherSt_SrvD) end if if (allocated(SrcLinStateSaveData%u_SrvD)) then LB(1:1) = lbound(SrcLinStateSaveData%u_SrvD) @@ -2243,8 +2181,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%u_SrvD)) then - deallocate(DstLinStateSaveData%u_SrvD) end if if (allocated(SrcLinStateSaveData%x_AD)) then LB(1:1) = lbound(SrcLinStateSaveData%x_AD) @@ -2261,8 +2197,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%x_AD)) then - deallocate(DstLinStateSaveData%x_AD) end if if (allocated(SrcLinStateSaveData%xd_AD)) then LB(1:1) = lbound(SrcLinStateSaveData%xd_AD) @@ -2279,8 +2213,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%xd_AD)) then - deallocate(DstLinStateSaveData%xd_AD) end if if (allocated(SrcLinStateSaveData%z_AD)) then LB(1:1) = lbound(SrcLinStateSaveData%z_AD) @@ -2297,8 +2229,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%z_AD)) then - deallocate(DstLinStateSaveData%z_AD) end if if (allocated(SrcLinStateSaveData%OtherSt_AD)) then LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_AD) @@ -2315,8 +2245,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%OtherSt_AD)) then - deallocate(DstLinStateSaveData%OtherSt_AD) end if if (allocated(SrcLinStateSaveData%u_AD)) then LB(1:1) = lbound(SrcLinStateSaveData%u_AD) @@ -2333,8 +2261,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%u_AD)) then - deallocate(DstLinStateSaveData%u_AD) end if if (allocated(SrcLinStateSaveData%x_IfW)) then LB(1:1) = lbound(SrcLinStateSaveData%x_IfW) @@ -2351,8 +2277,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%x_IfW)) then - deallocate(DstLinStateSaveData%x_IfW) end if if (allocated(SrcLinStateSaveData%xd_IfW)) then LB(1:1) = lbound(SrcLinStateSaveData%xd_IfW) @@ -2369,8 +2293,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%xd_IfW)) then - deallocate(DstLinStateSaveData%xd_IfW) end if if (allocated(SrcLinStateSaveData%z_IfW)) then LB(1:1) = lbound(SrcLinStateSaveData%z_IfW) @@ -2387,8 +2309,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%z_IfW)) then - deallocate(DstLinStateSaveData%z_IfW) end if if (allocated(SrcLinStateSaveData%OtherSt_IfW)) then LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_IfW) @@ -2405,8 +2325,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%OtherSt_IfW)) then - deallocate(DstLinStateSaveData%OtherSt_IfW) end if if (allocated(SrcLinStateSaveData%u_IfW)) then LB(1:1) = lbound(SrcLinStateSaveData%u_IfW) @@ -2423,8 +2341,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%u_IfW)) then - deallocate(DstLinStateSaveData%u_IfW) end if if (allocated(SrcLinStateSaveData%x_SD)) then LB(1:1) = lbound(SrcLinStateSaveData%x_SD) @@ -2441,8 +2357,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%x_SD)) then - deallocate(DstLinStateSaveData%x_SD) end if if (allocated(SrcLinStateSaveData%xd_SD)) then LB(1:1) = lbound(SrcLinStateSaveData%xd_SD) @@ -2459,8 +2373,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%xd_SD)) then - deallocate(DstLinStateSaveData%xd_SD) end if if (allocated(SrcLinStateSaveData%z_SD)) then LB(1:1) = lbound(SrcLinStateSaveData%z_SD) @@ -2477,8 +2389,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%z_SD)) then - deallocate(DstLinStateSaveData%z_SD) end if if (allocated(SrcLinStateSaveData%OtherSt_SD)) then LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_SD) @@ -2495,8 +2405,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%OtherSt_SD)) then - deallocate(DstLinStateSaveData%OtherSt_SD) end if if (allocated(SrcLinStateSaveData%u_SD)) then LB(1:1) = lbound(SrcLinStateSaveData%u_SD) @@ -2513,8 +2421,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%u_SD)) then - deallocate(DstLinStateSaveData%u_SD) end if if (allocated(SrcLinStateSaveData%x_ExtPtfm)) then LB(1:1) = lbound(SrcLinStateSaveData%x_ExtPtfm) @@ -2531,8 +2437,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%x_ExtPtfm)) then - deallocate(DstLinStateSaveData%x_ExtPtfm) end if if (allocated(SrcLinStateSaveData%xd_ExtPtfm)) then LB(1:1) = lbound(SrcLinStateSaveData%xd_ExtPtfm) @@ -2549,8 +2453,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%xd_ExtPtfm)) then - deallocate(DstLinStateSaveData%xd_ExtPtfm) end if if (allocated(SrcLinStateSaveData%z_ExtPtfm)) then LB(1:1) = lbound(SrcLinStateSaveData%z_ExtPtfm) @@ -2567,8 +2469,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%z_ExtPtfm)) then - deallocate(DstLinStateSaveData%z_ExtPtfm) end if if (allocated(SrcLinStateSaveData%OtherSt_ExtPtfm)) then LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_ExtPtfm) @@ -2585,8 +2485,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%OtherSt_ExtPtfm)) then - deallocate(DstLinStateSaveData%OtherSt_ExtPtfm) end if if (allocated(SrcLinStateSaveData%u_ExtPtfm)) then LB(1:1) = lbound(SrcLinStateSaveData%u_ExtPtfm) @@ -2603,8 +2501,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%u_ExtPtfm)) then - deallocate(DstLinStateSaveData%u_ExtPtfm) end if if (allocated(SrcLinStateSaveData%x_HD)) then LB(1:1) = lbound(SrcLinStateSaveData%x_HD) @@ -2621,8 +2517,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%x_HD)) then - deallocate(DstLinStateSaveData%x_HD) end if if (allocated(SrcLinStateSaveData%xd_HD)) then LB(1:1) = lbound(SrcLinStateSaveData%xd_HD) @@ -2639,8 +2533,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%xd_HD)) then - deallocate(DstLinStateSaveData%xd_HD) end if if (allocated(SrcLinStateSaveData%z_HD)) then LB(1:1) = lbound(SrcLinStateSaveData%z_HD) @@ -2657,8 +2549,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%z_HD)) then - deallocate(DstLinStateSaveData%z_HD) end if if (allocated(SrcLinStateSaveData%OtherSt_HD)) then LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_HD) @@ -2675,8 +2565,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%OtherSt_HD)) then - deallocate(DstLinStateSaveData%OtherSt_HD) end if if (allocated(SrcLinStateSaveData%u_HD)) then LB(1:1) = lbound(SrcLinStateSaveData%u_HD) @@ -2693,8 +2581,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%u_HD)) then - deallocate(DstLinStateSaveData%u_HD) end if if (allocated(SrcLinStateSaveData%x_IceF)) then LB(1:1) = lbound(SrcLinStateSaveData%x_IceF) @@ -2711,8 +2597,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%x_IceF)) then - deallocate(DstLinStateSaveData%x_IceF) end if if (allocated(SrcLinStateSaveData%xd_IceF)) then LB(1:1) = lbound(SrcLinStateSaveData%xd_IceF) @@ -2729,8 +2613,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%xd_IceF)) then - deallocate(DstLinStateSaveData%xd_IceF) end if if (allocated(SrcLinStateSaveData%z_IceF)) then LB(1:1) = lbound(SrcLinStateSaveData%z_IceF) @@ -2747,8 +2629,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%z_IceF)) then - deallocate(DstLinStateSaveData%z_IceF) end if if (allocated(SrcLinStateSaveData%OtherSt_IceF)) then LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_IceF) @@ -2765,8 +2645,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%OtherSt_IceF)) then - deallocate(DstLinStateSaveData%OtherSt_IceF) end if if (allocated(SrcLinStateSaveData%u_IceF)) then LB(1:1) = lbound(SrcLinStateSaveData%u_IceF) @@ -2783,8 +2661,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%u_IceF)) then - deallocate(DstLinStateSaveData%u_IceF) end if if (allocated(SrcLinStateSaveData%x_MAP)) then LB(1:1) = lbound(SrcLinStateSaveData%x_MAP) @@ -2801,8 +2677,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%x_MAP)) then - deallocate(DstLinStateSaveData%x_MAP) end if if (allocated(SrcLinStateSaveData%xd_MAP)) then LB(1:1) = lbound(SrcLinStateSaveData%xd_MAP) @@ -2819,8 +2693,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%xd_MAP)) then - deallocate(DstLinStateSaveData%xd_MAP) end if if (allocated(SrcLinStateSaveData%z_MAP)) then LB(1:1) = lbound(SrcLinStateSaveData%z_MAP) @@ -2837,8 +2709,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%z_MAP)) then - deallocate(DstLinStateSaveData%z_MAP) end if if (allocated(SrcLinStateSaveData%u_MAP)) then LB(1:1) = lbound(SrcLinStateSaveData%u_MAP) @@ -2855,8 +2725,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%u_MAP)) then - deallocate(DstLinStateSaveData%u_MAP) end if if (allocated(SrcLinStateSaveData%x_FEAM)) then LB(1:1) = lbound(SrcLinStateSaveData%x_FEAM) @@ -2873,8 +2741,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%x_FEAM)) then - deallocate(DstLinStateSaveData%x_FEAM) end if if (allocated(SrcLinStateSaveData%xd_FEAM)) then LB(1:1) = lbound(SrcLinStateSaveData%xd_FEAM) @@ -2891,8 +2757,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%xd_FEAM)) then - deallocate(DstLinStateSaveData%xd_FEAM) end if if (allocated(SrcLinStateSaveData%z_FEAM)) then LB(1:1) = lbound(SrcLinStateSaveData%z_FEAM) @@ -2909,8 +2773,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%z_FEAM)) then - deallocate(DstLinStateSaveData%z_FEAM) end if if (allocated(SrcLinStateSaveData%OtherSt_FEAM)) then LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_FEAM) @@ -2927,8 +2789,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%OtherSt_FEAM)) then - deallocate(DstLinStateSaveData%OtherSt_FEAM) end if if (allocated(SrcLinStateSaveData%u_FEAM)) then LB(1:1) = lbound(SrcLinStateSaveData%u_FEAM) @@ -2945,8 +2805,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%u_FEAM)) then - deallocate(DstLinStateSaveData%u_FEAM) end if if (allocated(SrcLinStateSaveData%x_MD)) then LB(1:1) = lbound(SrcLinStateSaveData%x_MD) @@ -2963,8 +2821,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%x_MD)) then - deallocate(DstLinStateSaveData%x_MD) end if if (allocated(SrcLinStateSaveData%xd_MD)) then LB(1:1) = lbound(SrcLinStateSaveData%xd_MD) @@ -2981,8 +2837,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%xd_MD)) then - deallocate(DstLinStateSaveData%xd_MD) end if if (allocated(SrcLinStateSaveData%z_MD)) then LB(1:1) = lbound(SrcLinStateSaveData%z_MD) @@ -2999,8 +2853,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%z_MD)) then - deallocate(DstLinStateSaveData%z_MD) end if if (allocated(SrcLinStateSaveData%OtherSt_MD)) then LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_MD) @@ -3017,8 +2869,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%OtherSt_MD)) then - deallocate(DstLinStateSaveData%OtherSt_MD) end if if (allocated(SrcLinStateSaveData%u_MD)) then LB(1:1) = lbound(SrcLinStateSaveData%u_MD) @@ -3035,8 +2885,6 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstLinStateSaveData%u_MD)) then - deallocate(DstLinStateSaveData%u_MD) end if end subroutine @@ -5268,8 +5116,6 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E end if end if DstLinTypeData%Names_u = SrcLinTypeData%Names_u - else if (allocated(DstLinTypeData%Names_u)) then - deallocate(DstLinTypeData%Names_u) end if if (allocated(SrcLinTypeData%Names_y)) then LB(1:1) = lbound(SrcLinTypeData%Names_y) @@ -5282,8 +5128,6 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E end if end if DstLinTypeData%Names_y = SrcLinTypeData%Names_y - else if (allocated(DstLinTypeData%Names_y)) then - deallocate(DstLinTypeData%Names_y) end if if (allocated(SrcLinTypeData%Names_x)) then LB(1:1) = lbound(SrcLinTypeData%Names_x) @@ -5296,8 +5140,6 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E end if end if DstLinTypeData%Names_x = SrcLinTypeData%Names_x - else if (allocated(DstLinTypeData%Names_x)) then - deallocate(DstLinTypeData%Names_x) end if if (allocated(SrcLinTypeData%Names_xd)) then LB(1:1) = lbound(SrcLinTypeData%Names_xd) @@ -5310,8 +5152,6 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E end if end if DstLinTypeData%Names_xd = SrcLinTypeData%Names_xd - else if (allocated(DstLinTypeData%Names_xd)) then - deallocate(DstLinTypeData%Names_xd) end if if (allocated(SrcLinTypeData%Names_z)) then LB(1:1) = lbound(SrcLinTypeData%Names_z) @@ -5324,8 +5164,6 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E end if end if DstLinTypeData%Names_z = SrcLinTypeData%Names_z - else if (allocated(DstLinTypeData%Names_z)) then - deallocate(DstLinTypeData%Names_z) end if if (allocated(SrcLinTypeData%op_u)) then LB(1:1) = lbound(SrcLinTypeData%op_u) @@ -5338,8 +5176,6 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E end if end if DstLinTypeData%op_u = SrcLinTypeData%op_u - else if (allocated(DstLinTypeData%op_u)) then - deallocate(DstLinTypeData%op_u) end if if (allocated(SrcLinTypeData%op_y)) then LB(1:1) = lbound(SrcLinTypeData%op_y) @@ -5352,8 +5188,6 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E end if end if DstLinTypeData%op_y = SrcLinTypeData%op_y - else if (allocated(DstLinTypeData%op_y)) then - deallocate(DstLinTypeData%op_y) end if if (allocated(SrcLinTypeData%op_x)) then LB(1:1) = lbound(SrcLinTypeData%op_x) @@ -5366,8 +5200,6 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E end if end if DstLinTypeData%op_x = SrcLinTypeData%op_x - else if (allocated(DstLinTypeData%op_x)) then - deallocate(DstLinTypeData%op_x) end if if (allocated(SrcLinTypeData%op_dx)) then LB(1:1) = lbound(SrcLinTypeData%op_dx) @@ -5380,8 +5212,6 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E end if end if DstLinTypeData%op_dx = SrcLinTypeData%op_dx - else if (allocated(DstLinTypeData%op_dx)) then - deallocate(DstLinTypeData%op_dx) end if if (allocated(SrcLinTypeData%op_xd)) then LB(1:1) = lbound(SrcLinTypeData%op_xd) @@ -5394,8 +5224,6 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E end if end if DstLinTypeData%op_xd = SrcLinTypeData%op_xd - else if (allocated(DstLinTypeData%op_xd)) then - deallocate(DstLinTypeData%op_xd) end if if (allocated(SrcLinTypeData%op_z)) then LB(1:1) = lbound(SrcLinTypeData%op_z) @@ -5408,8 +5236,6 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E end if end if DstLinTypeData%op_z = SrcLinTypeData%op_z - else if (allocated(DstLinTypeData%op_z)) then - deallocate(DstLinTypeData%op_z) end if if (allocated(SrcLinTypeData%op_x_eig_mag)) then LB(1:1) = lbound(SrcLinTypeData%op_x_eig_mag) @@ -5422,8 +5248,6 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E end if end if DstLinTypeData%op_x_eig_mag = SrcLinTypeData%op_x_eig_mag - else if (allocated(DstLinTypeData%op_x_eig_mag)) then - deallocate(DstLinTypeData%op_x_eig_mag) end if if (allocated(SrcLinTypeData%op_x_eig_phase)) then LB(1:1) = lbound(SrcLinTypeData%op_x_eig_phase) @@ -5436,8 +5260,6 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E end if end if DstLinTypeData%op_x_eig_phase = SrcLinTypeData%op_x_eig_phase - else if (allocated(DstLinTypeData%op_x_eig_phase)) then - deallocate(DstLinTypeData%op_x_eig_phase) end if if (allocated(SrcLinTypeData%Use_u)) then LB(1:1) = lbound(SrcLinTypeData%Use_u) @@ -5450,8 +5272,6 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E end if end if DstLinTypeData%Use_u = SrcLinTypeData%Use_u - else if (allocated(DstLinTypeData%Use_u)) then - deallocate(DstLinTypeData%Use_u) end if if (allocated(SrcLinTypeData%Use_y)) then LB(1:1) = lbound(SrcLinTypeData%Use_y) @@ -5464,8 +5284,6 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E end if end if DstLinTypeData%Use_y = SrcLinTypeData%Use_y - else if (allocated(DstLinTypeData%Use_y)) then - deallocate(DstLinTypeData%Use_y) end if if (allocated(SrcLinTypeData%A)) then LB(1:2) = lbound(SrcLinTypeData%A) @@ -5478,8 +5296,6 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E end if end if DstLinTypeData%A = SrcLinTypeData%A - else if (allocated(DstLinTypeData%A)) then - deallocate(DstLinTypeData%A) end if if (allocated(SrcLinTypeData%B)) then LB(1:2) = lbound(SrcLinTypeData%B) @@ -5492,8 +5308,6 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E end if end if DstLinTypeData%B = SrcLinTypeData%B - else if (allocated(DstLinTypeData%B)) then - deallocate(DstLinTypeData%B) end if if (allocated(SrcLinTypeData%C)) then LB(1:2) = lbound(SrcLinTypeData%C) @@ -5506,8 +5320,6 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E end if end if DstLinTypeData%C = SrcLinTypeData%C - else if (allocated(DstLinTypeData%C)) then - deallocate(DstLinTypeData%C) end if if (allocated(SrcLinTypeData%D)) then LB(1:2) = lbound(SrcLinTypeData%D) @@ -5520,8 +5332,6 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E end if end if DstLinTypeData%D = SrcLinTypeData%D - else if (allocated(DstLinTypeData%D)) then - deallocate(DstLinTypeData%D) end if if (allocated(SrcLinTypeData%StateRotation)) then LB(1:2) = lbound(SrcLinTypeData%StateRotation) @@ -5534,8 +5344,6 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E end if end if DstLinTypeData%StateRotation = SrcLinTypeData%StateRotation - else if (allocated(DstLinTypeData%StateRotation)) then - deallocate(DstLinTypeData%StateRotation) end if if (allocated(SrcLinTypeData%StateRel_x)) then LB(1:2) = lbound(SrcLinTypeData%StateRel_x) @@ -5548,8 +5356,6 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E end if end if DstLinTypeData%StateRel_x = SrcLinTypeData%StateRel_x - else if (allocated(DstLinTypeData%StateRel_x)) then - deallocate(DstLinTypeData%StateRel_x) end if if (allocated(SrcLinTypeData%StateRel_xdot)) then LB(1:2) = lbound(SrcLinTypeData%StateRel_xdot) @@ -5562,8 +5368,6 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E end if end if DstLinTypeData%StateRel_xdot = SrcLinTypeData%StateRel_xdot - else if (allocated(DstLinTypeData%StateRel_xdot)) then - deallocate(DstLinTypeData%StateRel_xdot) end if if (allocated(SrcLinTypeData%IsLoad_u)) then LB(1:1) = lbound(SrcLinTypeData%IsLoad_u) @@ -5576,8 +5380,6 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E end if end if DstLinTypeData%IsLoad_u = SrcLinTypeData%IsLoad_u - else if (allocated(DstLinTypeData%IsLoad_u)) then - deallocate(DstLinTypeData%IsLoad_u) end if if (allocated(SrcLinTypeData%RotFrame_u)) then LB(1:1) = lbound(SrcLinTypeData%RotFrame_u) @@ -5590,8 +5392,6 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E end if end if DstLinTypeData%RotFrame_u = SrcLinTypeData%RotFrame_u - else if (allocated(DstLinTypeData%RotFrame_u)) then - deallocate(DstLinTypeData%RotFrame_u) end if if (allocated(SrcLinTypeData%RotFrame_y)) then LB(1:1) = lbound(SrcLinTypeData%RotFrame_y) @@ -5604,8 +5404,6 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E end if end if DstLinTypeData%RotFrame_y = SrcLinTypeData%RotFrame_y - else if (allocated(DstLinTypeData%RotFrame_y)) then - deallocate(DstLinTypeData%RotFrame_y) end if if (allocated(SrcLinTypeData%RotFrame_x)) then LB(1:1) = lbound(SrcLinTypeData%RotFrame_x) @@ -5618,8 +5416,6 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E end if end if DstLinTypeData%RotFrame_x = SrcLinTypeData%RotFrame_x - else if (allocated(DstLinTypeData%RotFrame_x)) then - deallocate(DstLinTypeData%RotFrame_x) end if if (allocated(SrcLinTypeData%RotFrame_z)) then LB(1:1) = lbound(SrcLinTypeData%RotFrame_z) @@ -5632,8 +5428,6 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E end if end if DstLinTypeData%RotFrame_z = SrcLinTypeData%RotFrame_z - else if (allocated(DstLinTypeData%RotFrame_z)) then - deallocate(DstLinTypeData%RotFrame_z) end if if (allocated(SrcLinTypeData%DerivOrder_x)) then LB(1:1) = lbound(SrcLinTypeData%DerivOrder_x) @@ -5646,8 +5440,6 @@ subroutine FAST_CopyLinType(SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, E end if end if DstLinTypeData%DerivOrder_x = SrcLinTypeData%DerivOrder_x - else if (allocated(DstLinTypeData%DerivOrder_x)) then - deallocate(DstLinTypeData%DerivOrder_x) end if DstLinTypeData%SizeLin = SrcLinTypeData%SizeLin DstLinTypeData%LinStartIndx = SrcLinTypeData%LinStartIndx @@ -6334,8 +6126,6 @@ subroutine FAST_CopyModLinType(SrcModLinTypeData, DstModLinTypeData, CtrlCode, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstModLinTypeData%Instance)) then - deallocate(DstModLinTypeData%Instance) end if end subroutine @@ -6517,8 +6307,6 @@ subroutine FAST_CopyMiscLinType(SrcMiscLinTypeData, DstMiscLinTypeData, CtrlCode end if end if DstMiscLinTypeData%LinTimes = SrcMiscLinTypeData%LinTimes - else if (allocated(DstMiscLinTypeData%LinTimes)) then - deallocate(DstMiscLinTypeData%LinTimes) end if DstMiscLinTypeData%CopyOP_CtrlCode = SrcMiscLinTypeData%CopyOP_CtrlCode if (allocated(SrcMiscLinTypeData%AzimTarget)) then @@ -6532,8 +6320,6 @@ subroutine FAST_CopyMiscLinType(SrcMiscLinTypeData, DstMiscLinTypeData, CtrlCode end if end if DstMiscLinTypeData%AzimTarget = SrcMiscLinTypeData%AzimTarget - else if (allocated(DstMiscLinTypeData%AzimTarget)) then - deallocate(DstMiscLinTypeData%AzimTarget) end if DstMiscLinTypeData%IsConverged = SrcMiscLinTypeData%IsConverged DstMiscLinTypeData%FoundSteady = SrcMiscLinTypeData%FoundSteady @@ -6552,8 +6338,6 @@ subroutine FAST_CopyMiscLinType(SrcMiscLinTypeData, DstMiscLinTypeData, CtrlCode end if end if DstMiscLinTypeData%Psi = SrcMiscLinTypeData%Psi - else if (allocated(DstMiscLinTypeData%Psi)) then - deallocate(DstMiscLinTypeData%Psi) end if if (allocated(SrcMiscLinTypeData%y_interp)) then LB(1:1) = lbound(SrcMiscLinTypeData%y_interp) @@ -6566,8 +6350,6 @@ subroutine FAST_CopyMiscLinType(SrcMiscLinTypeData, DstMiscLinTypeData, CtrlCode end if end if DstMiscLinTypeData%y_interp = SrcMiscLinTypeData%y_interp - else if (allocated(DstMiscLinTypeData%y_interp)) then - deallocate(DstMiscLinTypeData%y_interp) end if if (allocated(SrcMiscLinTypeData%y_ref)) then LB(1:1) = lbound(SrcMiscLinTypeData%y_ref) @@ -6580,8 +6362,6 @@ subroutine FAST_CopyMiscLinType(SrcMiscLinTypeData, DstMiscLinTypeData, CtrlCode end if end if DstMiscLinTypeData%y_ref = SrcMiscLinTypeData%y_ref - else if (allocated(DstMiscLinTypeData%y_ref)) then - deallocate(DstMiscLinTypeData%y_ref) end if if (allocated(SrcMiscLinTypeData%Y_prevRot)) then LB(1:2) = lbound(SrcMiscLinTypeData%Y_prevRot) @@ -6594,8 +6374,6 @@ subroutine FAST_CopyMiscLinType(SrcMiscLinTypeData, DstMiscLinTypeData, CtrlCode end if end if DstMiscLinTypeData%Y_prevRot = SrcMiscLinTypeData%Y_prevRot - else if (allocated(DstMiscLinTypeData%Y_prevRot)) then - deallocate(DstMiscLinTypeData%Y_prevRot) end if end subroutine @@ -6803,8 +6581,6 @@ subroutine FAST_CopyOutputFileType(SrcOutputFileTypeData, DstOutputFileTypeData, end if end if DstOutputFileTypeData%TimeData = SrcOutputFileTypeData%TimeData - else if (allocated(DstOutputFileTypeData%TimeData)) then - deallocate(DstOutputFileTypeData%TimeData) end if if (allocated(SrcOutputFileTypeData%AllOutData)) then LB(1:2) = lbound(SrcOutputFileTypeData%AllOutData) @@ -6817,8 +6593,6 @@ subroutine FAST_CopyOutputFileType(SrcOutputFileTypeData, DstOutputFileTypeData, end if end if DstOutputFileTypeData%AllOutData = SrcOutputFileTypeData%AllOutData - else if (allocated(DstOutputFileTypeData%AllOutData)) then - deallocate(DstOutputFileTypeData%AllOutData) end if DstOutputFileTypeData%n_Out = SrcOutputFileTypeData%n_Out DstOutputFileTypeData%NOutSteps = SrcOutputFileTypeData%NOutSteps @@ -6838,8 +6612,6 @@ subroutine FAST_CopyOutputFileType(SrcOutputFileTypeData, DstOutputFileTypeData, end if end if DstOutputFileTypeData%ChannelNames = SrcOutputFileTypeData%ChannelNames - else if (allocated(DstOutputFileTypeData%ChannelNames)) then - deallocate(DstOutputFileTypeData%ChannelNames) end if if (allocated(SrcOutputFileTypeData%ChannelUnits)) then LB(1:1) = lbound(SrcOutputFileTypeData%ChannelUnits) @@ -6852,8 +6624,6 @@ subroutine FAST_CopyOutputFileType(SrcOutputFileTypeData, DstOutputFileTypeData, end if end if DstOutputFileTypeData%ChannelUnits = SrcOutputFileTypeData%ChannelUnits - else if (allocated(DstOutputFileTypeData%ChannelUnits)) then - deallocate(DstOutputFileTypeData%ChannelUnits) end if LB(1:1) = lbound(SrcOutputFileTypeData%Module_Ver) UB(1:1) = ubound(SrcOutputFileTypeData%Module_Ver) @@ -7091,8 +6861,6 @@ subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode if (ErrStat >= AbortErrLev) return end do end do - else if (allocated(DstIceDyn_DataData%x)) then - deallocate(DstIceDyn_DataData%x) end if if (allocated(SrcIceDyn_DataData%xd)) then LB(1:2) = lbound(SrcIceDyn_DataData%xd) @@ -7111,8 +6879,6 @@ subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode if (ErrStat >= AbortErrLev) return end do end do - else if (allocated(DstIceDyn_DataData%xd)) then - deallocate(DstIceDyn_DataData%xd) end if if (allocated(SrcIceDyn_DataData%z)) then LB(1:2) = lbound(SrcIceDyn_DataData%z) @@ -7131,8 +6897,6 @@ subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode if (ErrStat >= AbortErrLev) return end do end do - else if (allocated(DstIceDyn_DataData%z)) then - deallocate(DstIceDyn_DataData%z) end if if (allocated(SrcIceDyn_DataData%OtherSt)) then LB(1:2) = lbound(SrcIceDyn_DataData%OtherSt) @@ -7151,8 +6915,6 @@ subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode if (ErrStat >= AbortErrLev) return end do end do - else if (allocated(DstIceDyn_DataData%OtherSt)) then - deallocate(DstIceDyn_DataData%OtherSt) end if if (allocated(SrcIceDyn_DataData%p)) then LB(1:1) = lbound(SrcIceDyn_DataData%p) @@ -7169,8 +6931,6 @@ subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstIceDyn_DataData%p)) then - deallocate(DstIceDyn_DataData%p) end if if (allocated(SrcIceDyn_DataData%u)) then LB(1:1) = lbound(SrcIceDyn_DataData%u) @@ -7187,8 +6947,6 @@ subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstIceDyn_DataData%u)) then - deallocate(DstIceDyn_DataData%u) end if if (allocated(SrcIceDyn_DataData%y)) then LB(1:1) = lbound(SrcIceDyn_DataData%y) @@ -7205,8 +6963,6 @@ subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstIceDyn_DataData%y)) then - deallocate(DstIceDyn_DataData%y) end if if (allocated(SrcIceDyn_DataData%m)) then LB(1:1) = lbound(SrcIceDyn_DataData%m) @@ -7223,8 +6979,6 @@ subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstIceDyn_DataData%m)) then - deallocate(DstIceDyn_DataData%m) end if if (allocated(SrcIceDyn_DataData%Input)) then LB(1:2) = lbound(SrcIceDyn_DataData%Input) @@ -7243,8 +6997,6 @@ subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode if (ErrStat >= AbortErrLev) return end do end do - else if (allocated(DstIceDyn_DataData%Input)) then - deallocate(DstIceDyn_DataData%Input) end if if (allocated(SrcIceDyn_DataData%InputTimes)) then LB(1:2) = lbound(SrcIceDyn_DataData%InputTimes) @@ -7257,8 +7009,6 @@ subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode end if end if DstIceDyn_DataData%InputTimes = SrcIceDyn_DataData%InputTimes - else if (allocated(DstIceDyn_DataData%InputTimes)) then - deallocate(DstIceDyn_DataData%InputTimes) end if end subroutine @@ -7675,8 +7425,6 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC if (ErrStat >= AbortErrLev) return end do end do - else if (allocated(DstBeamDyn_DataData%x)) then - deallocate(DstBeamDyn_DataData%x) end if if (allocated(SrcBeamDyn_DataData%xd)) then LB(1:2) = lbound(SrcBeamDyn_DataData%xd) @@ -7695,8 +7443,6 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC if (ErrStat >= AbortErrLev) return end do end do - else if (allocated(DstBeamDyn_DataData%xd)) then - deallocate(DstBeamDyn_DataData%xd) end if if (allocated(SrcBeamDyn_DataData%z)) then LB(1:2) = lbound(SrcBeamDyn_DataData%z) @@ -7715,8 +7461,6 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC if (ErrStat >= AbortErrLev) return end do end do - else if (allocated(DstBeamDyn_DataData%z)) then - deallocate(DstBeamDyn_DataData%z) end if if (allocated(SrcBeamDyn_DataData%OtherSt)) then LB(1:2) = lbound(SrcBeamDyn_DataData%OtherSt) @@ -7735,8 +7479,6 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC if (ErrStat >= AbortErrLev) return end do end do - else if (allocated(DstBeamDyn_DataData%OtherSt)) then - deallocate(DstBeamDyn_DataData%OtherSt) end if if (allocated(SrcBeamDyn_DataData%p)) then LB(1:1) = lbound(SrcBeamDyn_DataData%p) @@ -7753,8 +7495,6 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstBeamDyn_DataData%p)) then - deallocate(DstBeamDyn_DataData%p) end if if (allocated(SrcBeamDyn_DataData%u)) then LB(1:1) = lbound(SrcBeamDyn_DataData%u) @@ -7771,8 +7511,6 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstBeamDyn_DataData%u)) then - deallocate(DstBeamDyn_DataData%u) end if if (allocated(SrcBeamDyn_DataData%y)) then LB(1:1) = lbound(SrcBeamDyn_DataData%y) @@ -7789,8 +7527,6 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstBeamDyn_DataData%y)) then - deallocate(DstBeamDyn_DataData%y) end if if (allocated(SrcBeamDyn_DataData%m)) then LB(1:1) = lbound(SrcBeamDyn_DataData%m) @@ -7807,8 +7543,6 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstBeamDyn_DataData%m)) then - deallocate(DstBeamDyn_DataData%m) end if if (allocated(SrcBeamDyn_DataData%Output)) then LB(1:2) = lbound(SrcBeamDyn_DataData%Output) @@ -7827,8 +7561,6 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC if (ErrStat >= AbortErrLev) return end do end do - else if (allocated(DstBeamDyn_DataData%Output)) then - deallocate(DstBeamDyn_DataData%Output) end if if (allocated(SrcBeamDyn_DataData%y_interp)) then LB(1:1) = lbound(SrcBeamDyn_DataData%y_interp) @@ -7845,8 +7577,6 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstBeamDyn_DataData%y_interp)) then - deallocate(DstBeamDyn_DataData%y_interp) end if if (allocated(SrcBeamDyn_DataData%Input)) then LB(1:2) = lbound(SrcBeamDyn_DataData%Input) @@ -7865,8 +7595,6 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC if (ErrStat >= AbortErrLev) return end do end do - else if (allocated(DstBeamDyn_DataData%Input)) then - deallocate(DstBeamDyn_DataData%Input) end if if (allocated(SrcBeamDyn_DataData%InputTimes)) then LB(1:2) = lbound(SrcBeamDyn_DataData%InputTimes) @@ -7879,8 +7607,6 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC end if end if DstBeamDyn_DataData%InputTimes = SrcBeamDyn_DataData%InputTimes - else if (allocated(DstBeamDyn_DataData%InputTimes)) then - deallocate(DstBeamDyn_DataData%InputTimes) end if end subroutine @@ -8407,8 +8133,6 @@ subroutine FAST_CopyElastoDyn_Data(SrcElastoDyn_DataData, DstElastoDyn_DataData, call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstElastoDyn_DataData%Output)) then - deallocate(DstElastoDyn_DataData%Output) end if call ED_CopyOutput(SrcElastoDyn_DataData%y_interp, DstElastoDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -8428,8 +8152,6 @@ subroutine FAST_CopyElastoDyn_Data(SrcElastoDyn_DataData, DstElastoDyn_DataData, call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstElastoDyn_DataData%Input)) then - deallocate(DstElastoDyn_DataData%Input) end if if (allocated(SrcElastoDyn_DataData%InputTimes)) then LB(1:1) = lbound(SrcElastoDyn_DataData%InputTimes) @@ -8442,8 +8164,6 @@ subroutine FAST_CopyElastoDyn_Data(SrcElastoDyn_DataData, DstElastoDyn_DataData, end if end if DstElastoDyn_DataData%InputTimes = SrcElastoDyn_DataData%InputTimes - else if (allocated(DstElastoDyn_DataData%InputTimes)) then - deallocate(DstElastoDyn_DataData%InputTimes) end if end subroutine @@ -8721,8 +8441,6 @@ subroutine FAST_CopyServoDyn_Data(SrcServoDyn_DataData, DstServoDyn_DataData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstServoDyn_DataData%Output)) then - deallocate(DstServoDyn_DataData%Output) end if call SrvD_CopyOutput(SrcServoDyn_DataData%y_interp, DstServoDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -8742,8 +8460,6 @@ subroutine FAST_CopyServoDyn_Data(SrcServoDyn_DataData, DstServoDyn_DataData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstServoDyn_DataData%Input)) then - deallocate(DstServoDyn_DataData%Input) end if if (allocated(SrcServoDyn_DataData%InputTimes)) then LB(1:1) = lbound(SrcServoDyn_DataData%InputTimes) @@ -8756,8 +8472,6 @@ subroutine FAST_CopyServoDyn_Data(SrcServoDyn_DataData, DstServoDyn_DataData, Ct end if end if DstServoDyn_DataData%InputTimes = SrcServoDyn_DataData%InputTimes - else if (allocated(DstServoDyn_DataData%InputTimes)) then - deallocate(DstServoDyn_DataData%InputTimes) end if end subroutine @@ -9035,8 +8749,6 @@ subroutine FAST_CopyAeroDyn14_Data(SrcAeroDyn14_DataData, DstAeroDyn14_DataData, call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstAeroDyn14_DataData%Input)) then - deallocate(DstAeroDyn14_DataData%Input) end if if (allocated(SrcAeroDyn14_DataData%InputTimes)) then LB(1:1) = lbound(SrcAeroDyn14_DataData%InputTimes) @@ -9049,8 +8761,6 @@ subroutine FAST_CopyAeroDyn14_Data(SrcAeroDyn14_DataData, DstAeroDyn14_DataData, end if end if DstAeroDyn14_DataData%InputTimes = SrcAeroDyn14_DataData%InputTimes - else if (allocated(DstAeroDyn14_DataData%InputTimes)) then - deallocate(DstAeroDyn14_DataData%InputTimes) end if end subroutine @@ -9291,8 +9001,6 @@ subroutine FAST_CopyAeroDyn_Data(SrcAeroDyn_DataData, DstAeroDyn_DataData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstAeroDyn_DataData%Output)) then - deallocate(DstAeroDyn_DataData%Output) end if call AD_CopyOutput(SrcAeroDyn_DataData%y_interp, DstAeroDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -9312,8 +9020,6 @@ subroutine FAST_CopyAeroDyn_Data(SrcAeroDyn_DataData, DstAeroDyn_DataData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstAeroDyn_DataData%Input)) then - deallocate(DstAeroDyn_DataData%Input) end if if (allocated(SrcAeroDyn_DataData%InputTimes)) then LB(1:1) = lbound(SrcAeroDyn_DataData%InputTimes) @@ -9326,8 +9032,6 @@ subroutine FAST_CopyAeroDyn_Data(SrcAeroDyn_DataData, DstAeroDyn_DataData, CtrlC end if end if DstAeroDyn_DataData%InputTimes = SrcAeroDyn_DataData%InputTimes - else if (allocated(DstAeroDyn_DataData%InputTimes)) then - deallocate(DstAeroDyn_DataData%InputTimes) end if end subroutine @@ -9605,8 +9309,6 @@ subroutine FAST_CopyInflowWind_Data(SrcInflowWind_DataData, DstInflowWind_DataDa call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstInflowWind_DataData%Output)) then - deallocate(DstInflowWind_DataData%Output) end if call InflowWind_CopyOutput(SrcInflowWind_DataData%y_interp, DstInflowWind_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -9626,8 +9328,6 @@ subroutine FAST_CopyInflowWind_Data(SrcInflowWind_DataData, DstInflowWind_DataDa call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstInflowWind_DataData%Input)) then - deallocate(DstInflowWind_DataData%Input) end if if (allocated(SrcInflowWind_DataData%InputTimes)) then LB(1:1) = lbound(SrcInflowWind_DataData%InputTimes) @@ -9640,8 +9340,6 @@ subroutine FAST_CopyInflowWind_Data(SrcInflowWind_DataData, DstInflowWind_DataDa end if end if DstInflowWind_DataData%InputTimes = SrcInflowWind_DataData%InputTimes - else if (allocated(DstInflowWind_DataData%InputTimes)) then - deallocate(DstInflowWind_DataData%InputTimes) end if end subroutine @@ -10046,8 +9744,6 @@ subroutine FAST_CopySubDyn_Data(SrcSubDyn_DataData, DstSubDyn_DataData, CtrlCode call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstSubDyn_DataData%Input)) then - deallocate(DstSubDyn_DataData%Input) end if if (allocated(SrcSubDyn_DataData%Output)) then LB(1:1) = lbound(SrcSubDyn_DataData%Output) @@ -10064,8 +9760,6 @@ subroutine FAST_CopySubDyn_Data(SrcSubDyn_DataData, DstSubDyn_DataData, CtrlCode call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstSubDyn_DataData%Output)) then - deallocate(DstSubDyn_DataData%Output) end if call SD_CopyOutput(SrcSubDyn_DataData%y_interp, DstSubDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -10081,8 +9775,6 @@ subroutine FAST_CopySubDyn_Data(SrcSubDyn_DataData, DstSubDyn_DataData, CtrlCode end if end if DstSubDyn_DataData%InputTimes = SrcSubDyn_DataData%InputTimes - else if (allocated(DstSubDyn_DataData%InputTimes)) then - deallocate(DstSubDyn_DataData%InputTimes) end if end subroutine @@ -10360,8 +10052,6 @@ subroutine FAST_CopyExtPtfm_Data(SrcExtPtfm_DataData, DstExtPtfm_DataData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstExtPtfm_DataData%Input)) then - deallocate(DstExtPtfm_DataData%Input) end if if (allocated(SrcExtPtfm_DataData%InputTimes)) then LB(1:1) = lbound(SrcExtPtfm_DataData%InputTimes) @@ -10374,8 +10064,6 @@ subroutine FAST_CopyExtPtfm_Data(SrcExtPtfm_DataData, DstExtPtfm_DataData, CtrlC end if end if DstExtPtfm_DataData%InputTimes = SrcExtPtfm_DataData%InputTimes - else if (allocated(DstExtPtfm_DataData%InputTimes)) then - deallocate(DstExtPtfm_DataData%InputTimes) end if end subroutine @@ -10616,8 +10304,6 @@ subroutine FAST_CopySeaState_Data(SrcSeaState_DataData, DstSeaState_DataData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstSeaState_DataData%Input)) then - deallocate(DstSeaState_DataData%Input) end if if (allocated(SrcSeaState_DataData%Output)) then LB(1:1) = lbound(SrcSeaState_DataData%Output) @@ -10634,8 +10320,6 @@ subroutine FAST_CopySeaState_Data(SrcSeaState_DataData, DstSeaState_DataData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstSeaState_DataData%Output)) then - deallocate(DstSeaState_DataData%Output) end if call SeaSt_CopyOutput(SrcSeaState_DataData%y_interp, DstSeaState_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -10651,8 +10335,6 @@ subroutine FAST_CopySeaState_Data(SrcSeaState_DataData, DstSeaState_DataData, Ct end if end if DstSeaState_DataData%InputTimes = SrcSeaState_DataData%InputTimes - else if (allocated(DstSeaState_DataData%InputTimes)) then - deallocate(DstSeaState_DataData%InputTimes) end if end subroutine @@ -10930,8 +10612,6 @@ subroutine FAST_CopyHydroDyn_Data(SrcHydroDyn_DataData, DstHydroDyn_DataData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstHydroDyn_DataData%Output)) then - deallocate(DstHydroDyn_DataData%Output) end if call HydroDyn_CopyOutput(SrcHydroDyn_DataData%y_interp, DstHydroDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -10951,8 +10631,6 @@ subroutine FAST_CopyHydroDyn_Data(SrcHydroDyn_DataData, DstHydroDyn_DataData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstHydroDyn_DataData%Input)) then - deallocate(DstHydroDyn_DataData%Input) end if if (allocated(SrcHydroDyn_DataData%InputTimes)) then LB(1:1) = lbound(SrcHydroDyn_DataData%InputTimes) @@ -10965,8 +10643,6 @@ subroutine FAST_CopyHydroDyn_Data(SrcHydroDyn_DataData, DstHydroDyn_DataData, Ct end if end if DstHydroDyn_DataData%InputTimes = SrcHydroDyn_DataData%InputTimes - else if (allocated(DstHydroDyn_DataData%InputTimes)) then - deallocate(DstHydroDyn_DataData%InputTimes) end if end subroutine @@ -11244,8 +10920,6 @@ subroutine FAST_CopyIceFloe_Data(SrcIceFloe_DataData, DstIceFloe_DataData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstIceFloe_DataData%Input)) then - deallocate(DstIceFloe_DataData%Input) end if if (allocated(SrcIceFloe_DataData%InputTimes)) then LB(1:1) = lbound(SrcIceFloe_DataData%InputTimes) @@ -11258,8 +10932,6 @@ subroutine FAST_CopyIceFloe_Data(SrcIceFloe_DataData, DstIceFloe_DataData, CtrlC end if end if DstIceFloe_DataData%InputTimes = SrcIceFloe_DataData%InputTimes - else if (allocated(DstIceFloe_DataData%InputTimes)) then - deallocate(DstIceFloe_DataData%InputTimes) end if end subroutine @@ -11496,8 +11168,6 @@ subroutine FAST_CopyMAP_Data(SrcMAP_DataData, DstMAP_DataData, CtrlCode, ErrStat call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstMAP_DataData%Output)) then - deallocate(DstMAP_DataData%Output) end if call MAP_CopyOutput(SrcMAP_DataData%y_interp, DstMAP_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -11517,8 +11187,6 @@ subroutine FAST_CopyMAP_Data(SrcMAP_DataData, DstMAP_DataData, CtrlCode, ErrStat call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstMAP_DataData%Input)) then - deallocate(DstMAP_DataData%Input) end if if (allocated(SrcMAP_DataData%InputTimes)) then LB(1:1) = lbound(SrcMAP_DataData%InputTimes) @@ -11531,8 +11199,6 @@ subroutine FAST_CopyMAP_Data(SrcMAP_DataData, DstMAP_DataData, CtrlCode, ErrStat end if end if DstMAP_DataData%InputTimes = SrcMAP_DataData%InputTimes - else if (allocated(DstMAP_DataData%InputTimes)) then - deallocate(DstMAP_DataData%InputTimes) end if end subroutine @@ -11798,8 +11464,6 @@ subroutine FAST_CopyFEAMooring_Data(SrcFEAMooring_DataData, DstFEAMooring_DataDa call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstFEAMooring_DataData%Input)) then - deallocate(DstFEAMooring_DataData%Input) end if if (allocated(SrcFEAMooring_DataData%InputTimes)) then LB(1:1) = lbound(SrcFEAMooring_DataData%InputTimes) @@ -11812,8 +11476,6 @@ subroutine FAST_CopyFEAMooring_Data(SrcFEAMooring_DataData, DstFEAMooring_DataDa end if end if DstFEAMooring_DataData%InputTimes = SrcFEAMooring_DataData%InputTimes - else if (allocated(DstFEAMooring_DataData%InputTimes)) then - deallocate(DstFEAMooring_DataData%InputTimes) end if end subroutine @@ -12054,8 +11716,6 @@ subroutine FAST_CopyMoorDyn_Data(SrcMoorDyn_DataData, DstMoorDyn_DataData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstMoorDyn_DataData%Output)) then - deallocate(DstMoorDyn_DataData%Output) end if call MD_CopyOutput(SrcMoorDyn_DataData%y_interp, DstMoorDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -12075,8 +11735,6 @@ subroutine FAST_CopyMoorDyn_Data(SrcMoorDyn_DataData, DstMoorDyn_DataData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstMoorDyn_DataData%Input)) then - deallocate(DstMoorDyn_DataData%Input) end if if (allocated(SrcMoorDyn_DataData%InputTimes)) then LB(1:1) = lbound(SrcMoorDyn_DataData%InputTimes) @@ -12089,8 +11747,6 @@ subroutine FAST_CopyMoorDyn_Data(SrcMoorDyn_DataData, DstMoorDyn_DataData, CtrlC end if end if DstMoorDyn_DataData%InputTimes = SrcMoorDyn_DataData%InputTimes - else if (allocated(DstMoorDyn_DataData%InputTimes)) then - deallocate(DstMoorDyn_DataData%InputTimes) end if end subroutine @@ -12368,8 +12024,6 @@ subroutine FAST_CopyOrcaFlex_Data(SrcOrcaFlex_DataData, DstOrcaFlex_DataData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstOrcaFlex_DataData%Input)) then - deallocate(DstOrcaFlex_DataData%Input) end if if (allocated(SrcOrcaFlex_DataData%InputTimes)) then LB(1:1) = lbound(SrcOrcaFlex_DataData%InputTimes) @@ -12382,8 +12036,6 @@ subroutine FAST_CopyOrcaFlex_Data(SrcOrcaFlex_DataData, DstOrcaFlex_DataData, Ct end if end if DstOrcaFlex_DataData%InputTimes = SrcOrcaFlex_DataData%InputTimes - else if (allocated(DstOrcaFlex_DataData%InputTimes)) then - deallocate(DstOrcaFlex_DataData%InputTimes) end if end subroutine @@ -12584,8 +12236,6 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstModuleMapTypeData%ED_P_2_BD_P)) then - deallocate(DstModuleMapTypeData%ED_P_2_BD_P) end if if (allocated(SrcModuleMapTypeData%BD_P_2_ED_P)) then LB(1:1) = lbound(SrcModuleMapTypeData%BD_P_2_ED_P) @@ -12602,8 +12252,6 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstModuleMapTypeData%BD_P_2_ED_P)) then - deallocate(DstModuleMapTypeData%BD_P_2_ED_P) end if if (allocated(SrcModuleMapTypeData%ED_P_2_BD_P_Hub)) then LB(1:1) = lbound(SrcModuleMapTypeData%ED_P_2_BD_P_Hub) @@ -12620,8 +12268,6 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstModuleMapTypeData%ED_P_2_BD_P_Hub)) then - deallocate(DstModuleMapTypeData%ED_P_2_BD_P_Hub) end if call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ED_P_2_HD_PRP_P, DstModuleMapTypeData%ED_P_2_HD_PRP_P, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -12665,8 +12311,6 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstModuleMapTypeData%ED_P_2_NStC_P_N)) then - deallocate(DstModuleMapTypeData%ED_P_2_NStC_P_N) end if if (allocated(SrcModuleMapTypeData%NStC_P_2_ED_P_N)) then LB(1:1) = lbound(SrcModuleMapTypeData%NStC_P_2_ED_P_N) @@ -12683,8 +12327,6 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstModuleMapTypeData%NStC_P_2_ED_P_N)) then - deallocate(DstModuleMapTypeData%NStC_P_2_ED_P_N) end if if (allocated(SrcModuleMapTypeData%ED_L_2_TStC_P_T)) then LB(1:1) = lbound(SrcModuleMapTypeData%ED_L_2_TStC_P_T) @@ -12701,8 +12343,6 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstModuleMapTypeData%ED_L_2_TStC_P_T)) then - deallocate(DstModuleMapTypeData%ED_L_2_TStC_P_T) end if if (allocated(SrcModuleMapTypeData%TStC_P_2_ED_P_T)) then LB(1:1) = lbound(SrcModuleMapTypeData%TStC_P_2_ED_P_T) @@ -12719,8 +12359,6 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstModuleMapTypeData%TStC_P_2_ED_P_T)) then - deallocate(DstModuleMapTypeData%TStC_P_2_ED_P_T) end if if (allocated(SrcModuleMapTypeData%ED_L_2_BStC_P_B)) then LB(1:2) = lbound(SrcModuleMapTypeData%ED_L_2_BStC_P_B) @@ -12739,8 +12377,6 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct if (ErrStat >= AbortErrLev) return end do end do - else if (allocated(DstModuleMapTypeData%ED_L_2_BStC_P_B)) then - deallocate(DstModuleMapTypeData%ED_L_2_BStC_P_B) end if if (allocated(SrcModuleMapTypeData%BStC_P_2_ED_P_B)) then LB(1:2) = lbound(SrcModuleMapTypeData%BStC_P_2_ED_P_B) @@ -12759,8 +12395,6 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct if (ErrStat >= AbortErrLev) return end do end do - else if (allocated(DstModuleMapTypeData%BStC_P_2_ED_P_B)) then - deallocate(DstModuleMapTypeData%BStC_P_2_ED_P_B) end if if (allocated(SrcModuleMapTypeData%BD_L_2_BStC_P_B)) then LB(1:2) = lbound(SrcModuleMapTypeData%BD_L_2_BStC_P_B) @@ -12779,8 +12413,6 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct if (ErrStat >= AbortErrLev) return end do end do - else if (allocated(DstModuleMapTypeData%BD_L_2_BStC_P_B)) then - deallocate(DstModuleMapTypeData%BD_L_2_BStC_P_B) end if if (allocated(SrcModuleMapTypeData%BStC_P_2_BD_P_B)) then LB(1:2) = lbound(SrcModuleMapTypeData%BStC_P_2_BD_P_B) @@ -12799,8 +12431,6 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct if (ErrStat >= AbortErrLev) return end do end do - else if (allocated(DstModuleMapTypeData%BStC_P_2_BD_P_B)) then - deallocate(DstModuleMapTypeData%BStC_P_2_BD_P_B) end if if (allocated(SrcModuleMapTypeData%SStC_P_P_2_SubStructure)) then LB(1:1) = lbound(SrcModuleMapTypeData%SStC_P_P_2_SubStructure) @@ -12817,8 +12447,6 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstModuleMapTypeData%SStC_P_P_2_SubStructure)) then - deallocate(DstModuleMapTypeData%SStC_P_P_2_SubStructure) end if if (allocated(SrcModuleMapTypeData%SubStructure_2_SStC_P_P)) then LB(1:1) = lbound(SrcModuleMapTypeData%SubStructure_2_SStC_P_P) @@ -12835,8 +12463,6 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstModuleMapTypeData%SubStructure_2_SStC_P_P)) then - deallocate(DstModuleMapTypeData%SubStructure_2_SStC_P_P) end if call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ED_P_2_SrvD_P_P, DstModuleMapTypeData%ED_P_2_SrvD_P_P, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -12856,8 +12482,6 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstModuleMapTypeData%BDED_L_2_AD_L_B)) then - deallocate(DstModuleMapTypeData%BDED_L_2_AD_L_B) end if if (allocated(SrcModuleMapTypeData%AD_L_2_BDED_B)) then LB(1:1) = lbound(SrcModuleMapTypeData%AD_L_2_BDED_B) @@ -12874,8 +12498,6 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstModuleMapTypeData%AD_L_2_BDED_B)) then - deallocate(DstModuleMapTypeData%AD_L_2_BDED_B) end if if (allocated(SrcModuleMapTypeData%BD_L_2_BD_L)) then LB(1:1) = lbound(SrcModuleMapTypeData%BD_L_2_BD_L) @@ -12892,8 +12514,6 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstModuleMapTypeData%BD_L_2_BD_L)) then - deallocate(DstModuleMapTypeData%BD_L_2_BD_L) end if call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ED_P_2_AD_P_N, DstModuleMapTypeData%ED_P_2_AD_P_N, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -12928,8 +12548,6 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstModuleMapTypeData%ED_P_2_AD_P_R)) then - deallocate(DstModuleMapTypeData%ED_P_2_AD_P_R) end if call NWTC_Library_CopyMeshMapType(SrcModuleMapTypeData%ED_P_2_AD_P_H, DstModuleMapTypeData%ED_P_2_AD_P_H, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -12958,8 +12576,6 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstModuleMapTypeData%IceD_P_2_SD_P)) then - deallocate(DstModuleMapTypeData%IceD_P_2_SD_P) end if if (allocated(SrcModuleMapTypeData%SDy3_P_2_IceD_P)) then LB(1:1) = lbound(SrcModuleMapTypeData%SDy3_P_2_IceD_P) @@ -12976,8 +12592,6 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstModuleMapTypeData%SDy3_P_2_IceD_P)) then - deallocate(DstModuleMapTypeData%SDy3_P_2_IceD_P) end if if (allocated(SrcModuleMapTypeData%Jacobian_Opt1)) then LB(1:2) = lbound(SrcModuleMapTypeData%Jacobian_Opt1) @@ -12990,8 +12604,6 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end if end if DstModuleMapTypeData%Jacobian_Opt1 = SrcModuleMapTypeData%Jacobian_Opt1 - else if (allocated(DstModuleMapTypeData%Jacobian_Opt1)) then - deallocate(DstModuleMapTypeData%Jacobian_Opt1) end if if (allocated(SrcModuleMapTypeData%Jacobian_pivot)) then LB(1:1) = lbound(SrcModuleMapTypeData%Jacobian_pivot) @@ -13004,8 +12616,6 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end if end if DstModuleMapTypeData%Jacobian_pivot = SrcModuleMapTypeData%Jacobian_pivot - else if (allocated(DstModuleMapTypeData%Jacobian_pivot)) then - deallocate(DstModuleMapTypeData%Jacobian_pivot) end if if (allocated(SrcModuleMapTypeData%Jac_u_indx)) then LB(1:2) = lbound(SrcModuleMapTypeData%Jac_u_indx) @@ -13018,8 +12628,6 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end if end if DstModuleMapTypeData%Jac_u_indx = SrcModuleMapTypeData%Jac_u_indx - else if (allocated(DstModuleMapTypeData%Jac_u_indx)) then - deallocate(DstModuleMapTypeData%Jac_u_indx) end if call MeshCopy(SrcModuleMapTypeData%u_ED_NacelleLoads, DstModuleMapTypeData%u_ED_NacelleLoads, CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -13057,8 +12665,6 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstModuleMapTypeData%u_ED_BladePtLoads)) then - deallocate(DstModuleMapTypeData%u_ED_BladePtLoads) end if call MeshCopy(SrcModuleMapTypeData%u_SD_TPMesh, DstModuleMapTypeData%u_SD_TPMesh, CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -13090,8 +12696,6 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstModuleMapTypeData%u_BD_RootMotion)) then - deallocate(DstModuleMapTypeData%u_BD_RootMotion) end if if (allocated(SrcModuleMapTypeData%y_BD_BldMotion_4Loads)) then LB(1:1) = lbound(SrcModuleMapTypeData%y_BD_BldMotion_4Loads) @@ -13108,8 +12712,6 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstModuleMapTypeData%y_BD_BldMotion_4Loads)) then - deallocate(DstModuleMapTypeData%y_BD_BldMotion_4Loads) end if if (allocated(SrcModuleMapTypeData%u_BD_Distrload)) then LB(1:1) = lbound(SrcModuleMapTypeData%u_BD_Distrload) @@ -13126,8 +12728,6 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstModuleMapTypeData%u_BD_Distrload)) then - deallocate(DstModuleMapTypeData%u_BD_Distrload) end if call MeshCopy(SrcModuleMapTypeData%u_Orca_PtfmMesh, DstModuleMapTypeData%u_Orca_PtfmMesh, CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -14357,8 +13957,6 @@ subroutine FAST_CopyInitData(SrcInitDataData, DstInitDataData, CtrlCode, ErrStat call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstInitDataData%OutData_BD)) then - deallocate(DstInitDataData%OutData_BD) end if call SrvD_CopyInitInput(SrcInitDataData%InData_SrvD, DstInitDataData%InData_SrvD, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -14682,8 +14280,6 @@ subroutine FAST_CopyExternInitType(SrcExternInitTypeData, DstExternInitTypeData, end if end if DstExternInitTypeData%fromSCGlob = SrcExternInitTypeData%fromSCGlob - else if (allocated(DstExternInitTypeData%fromSCGlob)) then - deallocate(DstExternInitTypeData%fromSCGlob) end if if (allocated(SrcExternInitTypeData%fromSC)) then LB(1:1) = lbound(SrcExternInitTypeData%fromSC) @@ -14696,8 +14292,6 @@ subroutine FAST_CopyExternInitType(SrcExternInitTypeData, DstExternInitTypeData, end if end if DstExternInitTypeData%fromSC = SrcExternInitTypeData%fromSC - else if (allocated(DstExternInitTypeData%fromSC)) then - deallocate(DstExternInitTypeData%fromSC) end if DstExternInitTypeData%FarmIntegration = SrcExternInitTypeData%FarmIntegration DstExternInitTypeData%windGrid_n = SrcExternInitTypeData%windGrid_n diff --git a/modules/openfast-registry/src/registry_gen_fortran.cpp b/modules/openfast-registry/src/registry_gen_fortran.cpp index 5e84e7ebc4..beab6104d3 100644 --- a/modules/openfast-registry/src/registry_gen_fortran.cpp +++ b/modules/openfast-registry/src/registry_gen_fortran.cpp @@ -440,10 +440,6 @@ void gen_copy(std::ostream &w, const Module &mod, const DataType::Derived &ddt, if (field.is_allocatable) { indent.erase(indent.size() - 3); - w << indent << "else if (" << alloc_assoc << "(" << dst << ")) then"; - w << indent << " deallocate(" << dst << ")"; - if (field.is_pointer) - w << indent << " nullify(" << dst << ")"; w << indent << "end if"; } } diff --git a/modules/openfoam/src/OpenFOAM_Types.f90 b/modules/openfoam/src/OpenFOAM_Types.f90 index 67a12ebb63..adfb08e281 100644 --- a/modules/openfoam/src/OpenFOAM_Types.f90 +++ b/modules/openfoam/src/OpenFOAM_Types.f90 @@ -232,9 +232,6 @@ subroutine OpFM_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%C_obj%StructBldRNodes = c_loc(DstInitInputData%StructBldRNodes(LB(1))) end if DstInitInputData%StructBldRNodes = SrcInitInputData%StructBldRNodes - else if (associated(DstInitInputData%StructBldRNodes)) then - deallocate(DstInitInputData%StructBldRNodes) - nullify(DstInitInputData%StructBldRNodes) end if if (associated(SrcInitInputData%StructTwrHNodes)) then LB(1:1) = lbound(SrcInitInputData%StructTwrHNodes) @@ -250,9 +247,6 @@ subroutine OpFM_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%C_obj%StructTwrHNodes = c_loc(DstInitInputData%StructTwrHNodes(LB(1))) end if DstInitInputData%StructTwrHNodes = SrcInitInputData%StructTwrHNodes - else if (associated(DstInitInputData%StructTwrHNodes)) then - deallocate(DstInitInputData%StructTwrHNodes) - nullify(DstInitInputData%StructTwrHNodes) end if DstInitInputData%BladeLength = SrcInitInputData%BladeLength DstInitInputData%C_obj%BladeLength = SrcInitInputData%C_obj%BladeLength @@ -513,8 +507,6 @@ subroutine OpFM_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E end if end if DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr - else if (allocated(DstInitOutputData%WriteOutputHdr)) then - deallocate(DstInitOutputData%WriteOutputHdr) end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) @@ -527,8 +519,6 @@ subroutine OpFM_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E end if end if DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt - else if (allocated(DstInitOutputData%WriteOutputUnt)) then - deallocate(DstInitOutputData%WriteOutputUnt) end if call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -678,8 +668,6 @@ subroutine OpFM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstMiscData%ActForceMotionsPoints)) then - deallocate(DstMiscData%ActForceMotionsPoints) end if if (allocated(SrcMiscData%ActForceLoadsPoints)) then LB(1:1) = lbound(SrcMiscData%ActForceLoadsPoints) @@ -696,8 +684,6 @@ subroutine OpFM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstMiscData%ActForceLoadsPoints)) then - deallocate(DstMiscData%ActForceLoadsPoints) end if if (allocated(SrcMiscData%Line2_to_Point_Loads)) then LB(1:1) = lbound(SrcMiscData%Line2_to_Point_Loads) @@ -714,8 +700,6 @@ subroutine OpFM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstMiscData%Line2_to_Point_Loads)) then - deallocate(DstMiscData%Line2_to_Point_Loads) end if if (allocated(SrcMiscData%Line2_to_Point_Motions)) then LB(1:1) = lbound(SrcMiscData%Line2_to_Point_Motions) @@ -732,8 +716,6 @@ subroutine OpFM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstMiscData%Line2_to_Point_Motions)) then - deallocate(DstMiscData%Line2_to_Point_Motions) end if end subroutine @@ -980,9 +962,6 @@ subroutine OpFM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%C_obj%forceBldRnodes = c_loc(DstParamData%forceBldRnodes(LB(1))) end if DstParamData%forceBldRnodes = SrcParamData%forceBldRnodes - else if (associated(DstParamData%forceBldRnodes)) then - deallocate(DstParamData%forceBldRnodes) - nullify(DstParamData%forceBldRnodes) end if if (associated(SrcParamData%forceTwrHnodes)) then LB(1:1) = lbound(SrcParamData%forceTwrHnodes) @@ -998,9 +977,6 @@ subroutine OpFM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%C_obj%forceTwrHnodes = c_loc(DstParamData%forceTwrHnodes(LB(1))) end if DstParamData%forceTwrHnodes = SrcParamData%forceTwrHnodes - else if (associated(DstParamData%forceTwrHnodes)) then - deallocate(DstParamData%forceTwrHnodes) - nullify(DstParamData%forceTwrHnodes) end if DstParamData%BladeLength = SrcParamData%BladeLength DstParamData%C_obj%BladeLength = SrcParamData%C_obj%BladeLength @@ -1293,9 +1269,6 @@ subroutine OpFM_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%C_obj%pxVel = c_loc(DstInputData%pxVel(LB(1))) end if DstInputData%pxVel = SrcInputData%pxVel - else if (associated(DstInputData%pxVel)) then - deallocate(DstInputData%pxVel) - nullify(DstInputData%pxVel) end if if (associated(SrcInputData%pyVel)) then LB(1:1) = lbound(SrcInputData%pyVel) @@ -1311,9 +1284,6 @@ subroutine OpFM_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%C_obj%pyVel = c_loc(DstInputData%pyVel(LB(1))) end if DstInputData%pyVel = SrcInputData%pyVel - else if (associated(DstInputData%pyVel)) then - deallocate(DstInputData%pyVel) - nullify(DstInputData%pyVel) end if if (associated(SrcInputData%pzVel)) then LB(1:1) = lbound(SrcInputData%pzVel) @@ -1329,9 +1299,6 @@ subroutine OpFM_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%C_obj%pzVel = c_loc(DstInputData%pzVel(LB(1))) end if DstInputData%pzVel = SrcInputData%pzVel - else if (associated(DstInputData%pzVel)) then - deallocate(DstInputData%pzVel) - nullify(DstInputData%pzVel) end if if (associated(SrcInputData%pxForce)) then LB(1:1) = lbound(SrcInputData%pxForce) @@ -1347,9 +1314,6 @@ subroutine OpFM_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%C_obj%pxForce = c_loc(DstInputData%pxForce(LB(1))) end if DstInputData%pxForce = SrcInputData%pxForce - else if (associated(DstInputData%pxForce)) then - deallocate(DstInputData%pxForce) - nullify(DstInputData%pxForce) end if if (associated(SrcInputData%pyForce)) then LB(1:1) = lbound(SrcInputData%pyForce) @@ -1365,9 +1329,6 @@ subroutine OpFM_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%C_obj%pyForce = c_loc(DstInputData%pyForce(LB(1))) end if DstInputData%pyForce = SrcInputData%pyForce - else if (associated(DstInputData%pyForce)) then - deallocate(DstInputData%pyForce) - nullify(DstInputData%pyForce) end if if (associated(SrcInputData%pzForce)) then LB(1:1) = lbound(SrcInputData%pzForce) @@ -1383,9 +1344,6 @@ subroutine OpFM_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%C_obj%pzForce = c_loc(DstInputData%pzForce(LB(1))) end if DstInputData%pzForce = SrcInputData%pzForce - else if (associated(DstInputData%pzForce)) then - deallocate(DstInputData%pzForce) - nullify(DstInputData%pzForce) end if if (associated(SrcInputData%xdotForce)) then LB(1:1) = lbound(SrcInputData%xdotForce) @@ -1401,9 +1359,6 @@ subroutine OpFM_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%C_obj%xdotForce = c_loc(DstInputData%xdotForce(LB(1))) end if DstInputData%xdotForce = SrcInputData%xdotForce - else if (associated(DstInputData%xdotForce)) then - deallocate(DstInputData%xdotForce) - nullify(DstInputData%xdotForce) end if if (associated(SrcInputData%ydotForce)) then LB(1:1) = lbound(SrcInputData%ydotForce) @@ -1419,9 +1374,6 @@ subroutine OpFM_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%C_obj%ydotForce = c_loc(DstInputData%ydotForce(LB(1))) end if DstInputData%ydotForce = SrcInputData%ydotForce - else if (associated(DstInputData%ydotForce)) then - deallocate(DstInputData%ydotForce) - nullify(DstInputData%ydotForce) end if if (associated(SrcInputData%zdotForce)) then LB(1:1) = lbound(SrcInputData%zdotForce) @@ -1437,9 +1389,6 @@ subroutine OpFM_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%C_obj%zdotForce = c_loc(DstInputData%zdotForce(LB(1))) end if DstInputData%zdotForce = SrcInputData%zdotForce - else if (associated(DstInputData%zdotForce)) then - deallocate(DstInputData%zdotForce) - nullify(DstInputData%zdotForce) end if if (associated(SrcInputData%pOrientation)) then LB(1:1) = lbound(SrcInputData%pOrientation) @@ -1455,9 +1404,6 @@ subroutine OpFM_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%C_obj%pOrientation = c_loc(DstInputData%pOrientation(LB(1))) end if DstInputData%pOrientation = SrcInputData%pOrientation - else if (associated(DstInputData%pOrientation)) then - deallocate(DstInputData%pOrientation) - nullify(DstInputData%pOrientation) end if if (associated(SrcInputData%fx)) then LB(1:1) = lbound(SrcInputData%fx) @@ -1473,9 +1419,6 @@ subroutine OpFM_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%C_obj%fx = c_loc(DstInputData%fx(LB(1))) end if DstInputData%fx = SrcInputData%fx - else if (associated(DstInputData%fx)) then - deallocate(DstInputData%fx) - nullify(DstInputData%fx) end if if (associated(SrcInputData%fy)) then LB(1:1) = lbound(SrcInputData%fy) @@ -1491,9 +1434,6 @@ subroutine OpFM_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%C_obj%fy = c_loc(DstInputData%fy(LB(1))) end if DstInputData%fy = SrcInputData%fy - else if (associated(DstInputData%fy)) then - deallocate(DstInputData%fy) - nullify(DstInputData%fy) end if if (associated(SrcInputData%fz)) then LB(1:1) = lbound(SrcInputData%fz) @@ -1509,9 +1449,6 @@ subroutine OpFM_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%C_obj%fz = c_loc(DstInputData%fz(LB(1))) end if DstInputData%fz = SrcInputData%fz - else if (associated(DstInputData%fz)) then - deallocate(DstInputData%fz) - nullify(DstInputData%fz) end if if (associated(SrcInputData%momentx)) then LB(1:1) = lbound(SrcInputData%momentx) @@ -1527,9 +1464,6 @@ subroutine OpFM_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%C_obj%momentx = c_loc(DstInputData%momentx(LB(1))) end if DstInputData%momentx = SrcInputData%momentx - else if (associated(DstInputData%momentx)) then - deallocate(DstInputData%momentx) - nullify(DstInputData%momentx) end if if (associated(SrcInputData%momenty)) then LB(1:1) = lbound(SrcInputData%momenty) @@ -1545,9 +1479,6 @@ subroutine OpFM_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%C_obj%momenty = c_loc(DstInputData%momenty(LB(1))) end if DstInputData%momenty = SrcInputData%momenty - else if (associated(DstInputData%momenty)) then - deallocate(DstInputData%momenty) - nullify(DstInputData%momenty) end if if (associated(SrcInputData%momentz)) then LB(1:1) = lbound(SrcInputData%momentz) @@ -1563,9 +1494,6 @@ subroutine OpFM_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%C_obj%momentz = c_loc(DstInputData%momentz(LB(1))) end if DstInputData%momentz = SrcInputData%momentz - else if (associated(DstInputData%momentz)) then - deallocate(DstInputData%momentz) - nullify(DstInputData%momentz) end if if (associated(SrcInputData%forceNodesChord)) then LB(1:1) = lbound(SrcInputData%forceNodesChord) @@ -1581,9 +1509,6 @@ subroutine OpFM_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%C_obj%forceNodesChord = c_loc(DstInputData%forceNodesChord(LB(1))) end if DstInputData%forceNodesChord = SrcInputData%forceNodesChord - else if (associated(DstInputData%forceNodesChord)) then - deallocate(DstInputData%forceNodesChord) - nullify(DstInputData%forceNodesChord) end if end subroutine @@ -2717,9 +2642,6 @@ subroutine OpFM_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%C_obj%u = c_loc(DstOutputData%u(LB(1))) end if DstOutputData%u = SrcOutputData%u - else if (associated(DstOutputData%u)) then - deallocate(DstOutputData%u) - nullify(DstOutputData%u) end if if (associated(SrcOutputData%v)) then LB(1:1) = lbound(SrcOutputData%v) @@ -2735,9 +2657,6 @@ subroutine OpFM_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%C_obj%v = c_loc(DstOutputData%v(LB(1))) end if DstOutputData%v = SrcOutputData%v - else if (associated(DstOutputData%v)) then - deallocate(DstOutputData%v) - nullify(DstOutputData%v) end if if (associated(SrcOutputData%w)) then LB(1:1) = lbound(SrcOutputData%w) @@ -2753,9 +2672,6 @@ subroutine OpFM_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%C_obj%w = c_loc(DstOutputData%w(LB(1))) end if DstOutputData%w = SrcOutputData%w - else if (associated(DstOutputData%w)) then - deallocate(DstOutputData%w) - nullify(DstOutputData%w) end if if (allocated(SrcOutputData%WriteOutput)) then LB(1:1) = lbound(SrcOutputData%WriteOutput) @@ -2768,8 +2684,6 @@ subroutine OpFM_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM end if end if DstOutputData%WriteOutput = SrcOutputData%WriteOutput - else if (allocated(DstOutputData%WriteOutput)) then - deallocate(DstOutputData%WriteOutput) end if end subroutine diff --git a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 index d9604e243e..b068168808 100644 --- a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 +++ b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 @@ -181,8 +181,6 @@ subroutine Orca_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E end if end if DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr - else if (allocated(DstInitOutputData%WriteOutputHdr)) then - deallocate(DstInitOutputData%WriteOutputHdr) end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) @@ -195,8 +193,6 @@ subroutine Orca_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E end if end if DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt - else if (allocated(DstInitOutputData%WriteOutputUnt)) then - deallocate(DstInitOutputData%WriteOutputUnt) end if end subroutine @@ -396,8 +392,6 @@ subroutine Orca_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%AllOuts = SrcMiscData%AllOuts - else if (allocated(DstMiscData%AllOuts)) then - deallocate(DstMiscData%AllOuts) end if DstMiscData%LastTimeStep = SrcMiscData%LastTimeStep end subroutine @@ -496,8 +490,6 @@ subroutine Orca_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstParamData%OutParam)) then - deallocate(DstParamData%OutParam) end if end subroutine @@ -656,8 +648,6 @@ subroutine Orca_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM end if end if DstOutputData%WriteOutput = SrcOutputData%WriteOutput - else if (allocated(DstOutputData%WriteOutput)) then - deallocate(DstOutputData%WriteOutput) end if end subroutine diff --git a/modules/seastate/src/Current_Types.f90 b/modules/seastate/src/Current_Types.f90 index 649f62d0e9..f4c04d84a1 100644 --- a/modules/seastate/src/Current_Types.f90 +++ b/modules/seastate/src/Current_Types.f90 @@ -92,8 +92,6 @@ subroutine Current_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E end if end if DstInitInputData%WaveKinGridzi = SrcInitInputData%WaveKinGridzi - else if (allocated(DstInitInputData%WaveKinGridzi)) then - deallocate(DstInitInputData%WaveKinGridzi) end if DstInitInputData%NGridPts = SrcInitInputData%NGridPts DstInitInputData%DirRoot = SrcInitInputData%DirRoot @@ -206,8 +204,6 @@ subroutine Current_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode end if end if DstInitOutputData%CurrVxi = SrcInitOutputData%CurrVxi - else if (allocated(DstInitOutputData%CurrVxi)) then - deallocate(DstInitOutputData%CurrVxi) end if if (allocated(SrcInitOutputData%CurrVyi)) then LB(1:1) = lbound(SrcInitOutputData%CurrVyi) @@ -220,8 +216,6 @@ subroutine Current_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode end if end if DstInitOutputData%CurrVyi = SrcInitOutputData%CurrVyi - else if (allocated(DstInitOutputData%CurrVyi)) then - deallocate(DstInitOutputData%CurrVyi) end if DstInitOutputData%PCurrVxiPz0 = SrcInitOutputData%PCurrVxiPz0 DstInitOutputData%PCurrVyiPz0 = SrcInitOutputData%PCurrVyiPz0 diff --git a/modules/seastate/src/SeaSt_WaveField_Types.f90 b/modules/seastate/src/SeaSt_WaveField_Types.f90 index fb21696029..5a53da1f8a 100644 --- a/modules/seastate/src/SeaSt_WaveField_Types.f90 +++ b/modules/seastate/src/SeaSt_WaveField_Types.f90 @@ -82,8 +82,6 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D end if end if DstSeaSt_WaveFieldTypeData%WaveTime = SrcSeaSt_WaveFieldTypeData%WaveTime - else if (allocated(DstSeaSt_WaveFieldTypeData%WaveTime)) then - deallocate(DstSeaSt_WaveFieldTypeData%WaveTime) end if if (allocated(SrcSeaSt_WaveFieldTypeData%WaveDynP)) then LB(1:4) = lbound(SrcSeaSt_WaveFieldTypeData%WaveDynP) @@ -96,8 +94,6 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D end if end if DstSeaSt_WaveFieldTypeData%WaveDynP = SrcSeaSt_WaveFieldTypeData%WaveDynP - else if (allocated(DstSeaSt_WaveFieldTypeData%WaveDynP)) then - deallocate(DstSeaSt_WaveFieldTypeData%WaveDynP) end if if (allocated(SrcSeaSt_WaveFieldTypeData%WaveAcc)) then LB(1:5) = lbound(SrcSeaSt_WaveFieldTypeData%WaveAcc) @@ -110,8 +106,6 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D end if end if DstSeaSt_WaveFieldTypeData%WaveAcc = SrcSeaSt_WaveFieldTypeData%WaveAcc - else if (allocated(DstSeaSt_WaveFieldTypeData%WaveAcc)) then - deallocate(DstSeaSt_WaveFieldTypeData%WaveAcc) end if if (allocated(SrcSeaSt_WaveFieldTypeData%WaveAccMCF)) then LB(1:5) = lbound(SrcSeaSt_WaveFieldTypeData%WaveAccMCF) @@ -124,8 +118,6 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D end if end if DstSeaSt_WaveFieldTypeData%WaveAccMCF = SrcSeaSt_WaveFieldTypeData%WaveAccMCF - else if (allocated(DstSeaSt_WaveFieldTypeData%WaveAccMCF)) then - deallocate(DstSeaSt_WaveFieldTypeData%WaveAccMCF) end if if (allocated(SrcSeaSt_WaveFieldTypeData%WaveVel)) then LB(1:5) = lbound(SrcSeaSt_WaveFieldTypeData%WaveVel) @@ -138,8 +130,6 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D end if end if DstSeaSt_WaveFieldTypeData%WaveVel = SrcSeaSt_WaveFieldTypeData%WaveVel - else if (allocated(DstSeaSt_WaveFieldTypeData%WaveVel)) then - deallocate(DstSeaSt_WaveFieldTypeData%WaveVel) end if if (allocated(SrcSeaSt_WaveFieldTypeData%PWaveDynP0)) then LB(1:3) = lbound(SrcSeaSt_WaveFieldTypeData%PWaveDynP0) @@ -152,8 +142,6 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D end if end if DstSeaSt_WaveFieldTypeData%PWaveDynP0 = SrcSeaSt_WaveFieldTypeData%PWaveDynP0 - else if (allocated(DstSeaSt_WaveFieldTypeData%PWaveDynP0)) then - deallocate(DstSeaSt_WaveFieldTypeData%PWaveDynP0) end if if (allocated(SrcSeaSt_WaveFieldTypeData%PWaveAcc0)) then LB(1:4) = lbound(SrcSeaSt_WaveFieldTypeData%PWaveAcc0) @@ -166,8 +154,6 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D end if end if DstSeaSt_WaveFieldTypeData%PWaveAcc0 = SrcSeaSt_WaveFieldTypeData%PWaveAcc0 - else if (allocated(DstSeaSt_WaveFieldTypeData%PWaveAcc0)) then - deallocate(DstSeaSt_WaveFieldTypeData%PWaveAcc0) end if if (allocated(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0)) then LB(1:4) = lbound(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0) @@ -180,8 +166,6 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D end if end if DstSeaSt_WaveFieldTypeData%PWaveAccMCF0 = SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0 - else if (allocated(DstSeaSt_WaveFieldTypeData%PWaveAccMCF0)) then - deallocate(DstSeaSt_WaveFieldTypeData%PWaveAccMCF0) end if if (allocated(SrcSeaSt_WaveFieldTypeData%PWaveVel0)) then LB(1:4) = lbound(SrcSeaSt_WaveFieldTypeData%PWaveVel0) @@ -194,8 +178,6 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D end if end if DstSeaSt_WaveFieldTypeData%PWaveVel0 = SrcSeaSt_WaveFieldTypeData%PWaveVel0 - else if (allocated(DstSeaSt_WaveFieldTypeData%PWaveVel0)) then - deallocate(DstSeaSt_WaveFieldTypeData%PWaveVel0) end if if (allocated(SrcSeaSt_WaveFieldTypeData%WaveElev0)) then LB(1:1) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElev0) @@ -208,8 +190,6 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D end if end if DstSeaSt_WaveFieldTypeData%WaveElev0 = SrcSeaSt_WaveFieldTypeData%WaveElev0 - else if (allocated(DstSeaSt_WaveFieldTypeData%WaveElev0)) then - deallocate(DstSeaSt_WaveFieldTypeData%WaveElev0) end if if (allocated(SrcSeaSt_WaveFieldTypeData%WaveElev1)) then LB(1:3) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElev1) @@ -222,8 +202,6 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D end if end if DstSeaSt_WaveFieldTypeData%WaveElev1 = SrcSeaSt_WaveFieldTypeData%WaveElev1 - else if (allocated(DstSeaSt_WaveFieldTypeData%WaveElev1)) then - deallocate(DstSeaSt_WaveFieldTypeData%WaveElev1) end if if (allocated(SrcSeaSt_WaveFieldTypeData%WaveElev2)) then LB(1:3) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElev2) @@ -236,8 +214,6 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D end if end if DstSeaSt_WaveFieldTypeData%WaveElev2 = SrcSeaSt_WaveFieldTypeData%WaveElev2 - else if (allocated(DstSeaSt_WaveFieldTypeData%WaveElev2)) then - deallocate(DstSeaSt_WaveFieldTypeData%WaveElev2) end if call SeaSt_Interp_CopyParam(SrcSeaSt_WaveFieldTypeData%SeaSt_Interp_p, DstSeaSt_WaveFieldTypeData%SeaSt_Interp_p, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -256,8 +232,6 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D end if end if DstSeaSt_WaveFieldTypeData%WaveElevC = SrcSeaSt_WaveFieldTypeData%WaveElevC - else if (allocated(DstSeaSt_WaveFieldTypeData%WaveElevC)) then - deallocate(DstSeaSt_WaveFieldTypeData%WaveElevC) end if if (allocated(SrcSeaSt_WaveFieldTypeData%WaveElevC0)) then LB(1:2) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElevC0) @@ -270,8 +244,6 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D end if end if DstSeaSt_WaveFieldTypeData%WaveElevC0 = SrcSeaSt_WaveFieldTypeData%WaveElevC0 - else if (allocated(DstSeaSt_WaveFieldTypeData%WaveElevC0)) then - deallocate(DstSeaSt_WaveFieldTypeData%WaveElevC0) end if if (allocated(SrcSeaSt_WaveFieldTypeData%WaveDirArr)) then LB(1:1) = lbound(SrcSeaSt_WaveFieldTypeData%WaveDirArr) @@ -284,8 +256,6 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D end if end if DstSeaSt_WaveFieldTypeData%WaveDirArr = SrcSeaSt_WaveFieldTypeData%WaveDirArr - else if (allocated(DstSeaSt_WaveFieldTypeData%WaveDirArr)) then - deallocate(DstSeaSt_WaveFieldTypeData%WaveDirArr) end if end subroutine diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index acac04923f..5b8b490410 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -263,8 +263,6 @@ subroutine SeaSt_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, Err end if end if DstInputFileData%WaveElevxi = SrcInputFileData%WaveElevxi - else if (allocated(DstInputFileData%WaveElevxi)) then - deallocate(DstInputFileData%WaveElevxi) end if if (allocated(SrcInputFileData%WaveElevyi)) then LB(1:1) = lbound(SrcInputFileData%WaveElevyi) @@ -277,8 +275,6 @@ subroutine SeaSt_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, Err end if end if DstInputFileData%WaveElevyi = SrcInputFileData%WaveElevyi - else if (allocated(DstInputFileData%WaveElevyi)) then - deallocate(DstInputFileData%WaveElevyi) end if DstInputFileData%NWaveKin = SrcInputFileData%NWaveKin if (allocated(SrcInputFileData%WaveKinxi)) then @@ -292,8 +288,6 @@ subroutine SeaSt_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, Err end if end if DstInputFileData%WaveKinxi = SrcInputFileData%WaveKinxi - else if (allocated(DstInputFileData%WaveKinxi)) then - deallocate(DstInputFileData%WaveKinxi) end if if (allocated(SrcInputFileData%WaveKinyi)) then LB(1:1) = lbound(SrcInputFileData%WaveKinyi) @@ -306,8 +300,6 @@ subroutine SeaSt_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, Err end if end if DstInputFileData%WaveKinyi = SrcInputFileData%WaveKinyi - else if (allocated(DstInputFileData%WaveKinyi)) then - deallocate(DstInputFileData%WaveKinyi) end if if (allocated(SrcInputFileData%WaveKinzi)) then LB(1:1) = lbound(SrcInputFileData%WaveKinzi) @@ -320,8 +312,6 @@ subroutine SeaSt_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, Err end if end if DstInputFileData%WaveKinzi = SrcInputFileData%WaveKinzi - else if (allocated(DstInputFileData%WaveKinzi)) then - deallocate(DstInputFileData%WaveKinzi) end if DstInputFileData%OutSwtch = SrcInputFileData%OutSwtch DstInputFileData%OutAll = SrcInputFileData%OutAll @@ -337,8 +327,6 @@ subroutine SeaSt_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, Err end if end if DstInputFileData%OutList = SrcInputFileData%OutList - else if (allocated(DstInputFileData%OutList)) then - deallocate(DstInputFileData%OutList) end if DstInputFileData%SeaStSum = SrcInputFileData%SeaStSum DstInputFileData%OutFmt = SrcInputFileData%OutFmt @@ -603,8 +591,6 @@ subroutine SeaSt_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err end if end if DstInitInputData%WaveElevXY = SrcInitInputData%WaveElevXY - else if (allocated(DstInitInputData%WaveElevXY)) then - deallocate(DstInitInputData%WaveElevXY) end if DstInitInputData%WaveFieldMod = SrcInitInputData%WaveFieldMod DstInitInputData%PtfmLocationX = SrcInitInputData%PtfmLocationX @@ -734,8 +720,6 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, end if end if DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr - else if (allocated(DstInitOutputData%WriteOutputHdr)) then - deallocate(DstInitOutputData%WriteOutputHdr) end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) @@ -748,8 +732,6 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, end if end if DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt - else if (allocated(DstInitOutputData%WriteOutputUnt)) then - deallocate(DstInitOutputData%WriteOutputUnt) end if call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -805,8 +787,6 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, end if end if DstInitOutputData%WaveElevSeries = SrcInitOutputData%WaveElevSeries - else if (allocated(DstInitOutputData%WaveElevSeries)) then - deallocate(DstInitOutputData%WaveElevSeries) end if DstInitOutputData%WaveField => SrcInitOutputData%WaveField end subroutine @@ -1757,8 +1737,6 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg end if end if DstParamData%WaveElevxi = SrcParamData%WaveElevxi - else if (allocated(DstParamData%WaveElevxi)) then - deallocate(DstParamData%WaveElevxi) end if if (allocated(SrcParamData%WaveElevyi)) then LB(1:1) = lbound(SrcParamData%WaveElevyi) @@ -1771,8 +1749,6 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg end if end if DstParamData%WaveElevyi = SrcParamData%WaveElevyi - else if (allocated(DstParamData%WaveElevyi)) then - deallocate(DstParamData%WaveElevyi) end if DstParamData%WaveElev1 => SrcParamData%WaveElev1 DstParamData%WaveElev2 => SrcParamData%WaveElev2 @@ -1798,8 +1774,6 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg end if end if DstParamData%WaveKinxi = SrcParamData%WaveKinxi - else if (allocated(DstParamData%WaveKinxi)) then - deallocate(DstParamData%WaveKinxi) end if if (allocated(SrcParamData%WaveKinyi)) then LB(1:1) = lbound(SrcParamData%WaveKinyi) @@ -1812,8 +1786,6 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg end if end if DstParamData%WaveKinyi = SrcParamData%WaveKinyi - else if (allocated(DstParamData%WaveKinyi)) then - deallocate(DstParamData%WaveKinyi) end if if (allocated(SrcParamData%WaveKinzi)) then LB(1:1) = lbound(SrcParamData%WaveKinzi) @@ -1826,8 +1798,6 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg end if end if DstParamData%WaveKinzi = SrcParamData%WaveKinzi - else if (allocated(DstParamData%WaveKinzi)) then - deallocate(DstParamData%WaveKinzi) end if DstParamData%WtrDpth = SrcParamData%WtrDpth DstParamData%DT = SrcParamData%DT @@ -1847,8 +1817,6 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstParamData%OutParam)) then - deallocate(DstParamData%OutParam) end if DstParamData%NumOuts = SrcParamData%NumOuts DstParamData%OutSwtch = SrcParamData%OutSwtch @@ -1871,9 +1839,6 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg call SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcParamData%WaveField, DstParamData%WaveField, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - else if (associated(DstParamData%WaveField)) then - deallocate(DstParamData%WaveField) - nullify(DstParamData%WaveField) end if end subroutine @@ -2648,8 +2613,6 @@ subroutine SeaSt_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err end if end if DstOutputData%WriteOutput = SrcOutputData%WriteOutput - else if (allocated(DstOutputData%WriteOutput)) then - deallocate(DstOutputData%WriteOutput) end if end subroutine diff --git a/modules/seastate/src/Waves2_Types.f90 b/modules/seastate/src/Waves2_Types.f90 index de152e3551..d7c4748a14 100644 --- a/modules/seastate/src/Waves2_Types.f90 +++ b/modules/seastate/src/Waves2_Types.f90 @@ -115,8 +115,6 @@ subroutine Waves2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er end if end if DstInitInputData%WaveKinGridxi = SrcInitInputData%WaveKinGridxi - else if (allocated(DstInitInputData%WaveKinGridxi)) then - deallocate(DstInitInputData%WaveKinGridxi) end if if (allocated(SrcInitInputData%WaveKinGridyi)) then LB(1:1) = lbound(SrcInitInputData%WaveKinGridyi) @@ -129,8 +127,6 @@ subroutine Waves2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er end if end if DstInitInputData%WaveKinGridyi = SrcInitInputData%WaveKinGridyi - else if (allocated(DstInitInputData%WaveKinGridyi)) then - deallocate(DstInitInputData%WaveKinGridyi) end if if (allocated(SrcInitInputData%WaveKinGridzi)) then LB(1:1) = lbound(SrcInitInputData%WaveKinGridzi) @@ -143,8 +139,6 @@ subroutine Waves2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er end if end if DstInitInputData%WaveKinGridzi = SrcInitInputData%WaveKinGridzi - else if (allocated(DstInitInputData%WaveKinGridzi)) then - deallocate(DstInitInputData%WaveKinGridzi) end if DstInitInputData%WvDiffQTFF = SrcInitInputData%WvDiffQTFF DstInitInputData%WvSumQTFF = SrcInitInputData%WvSumQTFF @@ -422,8 +416,6 @@ subroutine Waves2_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, end if end if DstInitOutputData%WaveAcc2D = SrcInitOutputData%WaveAcc2D - else if (allocated(DstInitOutputData%WaveAcc2D)) then - deallocate(DstInitOutputData%WaveAcc2D) end if if (allocated(SrcInitOutputData%WaveDynP2D)) then LB(1:4) = lbound(SrcInitOutputData%WaveDynP2D) @@ -436,8 +428,6 @@ subroutine Waves2_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, end if end if DstInitOutputData%WaveDynP2D = SrcInitOutputData%WaveDynP2D - else if (allocated(DstInitOutputData%WaveDynP2D)) then - deallocate(DstInitOutputData%WaveDynP2D) end if if (allocated(SrcInitOutputData%WaveAcc2S)) then LB(1:5) = lbound(SrcInitOutputData%WaveAcc2S) @@ -450,8 +440,6 @@ subroutine Waves2_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, end if end if DstInitOutputData%WaveAcc2S = SrcInitOutputData%WaveAcc2S - else if (allocated(DstInitOutputData%WaveAcc2S)) then - deallocate(DstInitOutputData%WaveAcc2S) end if if (allocated(SrcInitOutputData%WaveDynP2S)) then LB(1:4) = lbound(SrcInitOutputData%WaveDynP2S) @@ -464,8 +452,6 @@ subroutine Waves2_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, end if end if DstInitOutputData%WaveDynP2S = SrcInitOutputData%WaveDynP2S - else if (allocated(DstInitOutputData%WaveDynP2S)) then - deallocate(DstInitOutputData%WaveDynP2S) end if if (allocated(SrcInitOutputData%WaveVel2D)) then LB(1:5) = lbound(SrcInitOutputData%WaveVel2D) @@ -478,8 +464,6 @@ subroutine Waves2_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, end if end if DstInitOutputData%WaveVel2D = SrcInitOutputData%WaveVel2D - else if (allocated(DstInitOutputData%WaveVel2D)) then - deallocate(DstInitOutputData%WaveVel2D) end if if (allocated(SrcInitOutputData%WaveVel2S)) then LB(1:5) = lbound(SrcInitOutputData%WaveVel2S) @@ -492,8 +476,6 @@ subroutine Waves2_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, end if end if DstInitOutputData%WaveVel2S = SrcInitOutputData%WaveVel2S - else if (allocated(DstInitOutputData%WaveVel2S)) then - deallocate(DstInitOutputData%WaveVel2S) end if DstInitOutputData%WaveElev2 => SrcInitOutputData%WaveElev2 end subroutine diff --git a/modules/seastate/src/Waves_Types.f90 b/modules/seastate/src/Waves_Types.f90 index 3a7d52e00b..a4753d2f2f 100644 --- a/modules/seastate/src/Waves_Types.f90 +++ b/modules/seastate/src/Waves_Types.f90 @@ -163,8 +163,6 @@ subroutine Waves_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err end if end if DstInitInputData%WaveKinGridxi = SrcInitInputData%WaveKinGridxi - else if (allocated(DstInitInputData%WaveKinGridxi)) then - deallocate(DstInitInputData%WaveKinGridxi) end if if (allocated(SrcInitInputData%WaveKinGridyi)) then LB(1:1) = lbound(SrcInitInputData%WaveKinGridyi) @@ -177,8 +175,6 @@ subroutine Waves_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err end if end if DstInitInputData%WaveKinGridyi = SrcInitInputData%WaveKinGridyi - else if (allocated(DstInitInputData%WaveKinGridyi)) then - deallocate(DstInitInputData%WaveKinGridyi) end if if (allocated(SrcInitInputData%WaveKinGridzi)) then LB(1:1) = lbound(SrcInitInputData%WaveKinGridzi) @@ -191,8 +187,6 @@ subroutine Waves_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err end if end if DstInitInputData%WaveKinGridzi = SrcInitInputData%WaveKinGridzi - else if (allocated(DstInitInputData%WaveKinGridzi)) then - deallocate(DstInitInputData%WaveKinGridzi) end if if (allocated(SrcInitInputData%CurrVxi)) then LB(1:1) = lbound(SrcInitInputData%CurrVxi) @@ -205,8 +199,6 @@ subroutine Waves_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err end if end if DstInitInputData%CurrVxi = SrcInitInputData%CurrVxi - else if (allocated(DstInitInputData%CurrVxi)) then - deallocate(DstInitInputData%CurrVxi) end if if (allocated(SrcInitInputData%CurrVyi)) then LB(1:1) = lbound(SrcInitInputData%CurrVyi) @@ -219,8 +211,6 @@ subroutine Waves_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err end if end if DstInitInputData%CurrVyi = SrcInitInputData%CurrVyi - else if (allocated(DstInitInputData%CurrVyi)) then - deallocate(DstInitInputData%CurrVyi) end if DstInitInputData%PCurrVxiPz0 = SrcInitInputData%PCurrVxiPz0 DstInitInputData%PCurrVyiPz0 = SrcInitInputData%PCurrVyiPz0 @@ -524,8 +514,6 @@ subroutine Waves_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, end if end if DstInitOutputData%WaveElevC = SrcInitOutputData%WaveElevC - else if (allocated(DstInitOutputData%WaveElevC)) then - deallocate(DstInitOutputData%WaveElevC) end if DstInitOutputData%WaveDirArr => SrcInitOutputData%WaveDirArr DstInitOutputData%WaveDirMin = SrcInitOutputData%WaveDirMin @@ -552,8 +540,6 @@ subroutine Waves_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, end if end if DstInitOutputData%WaveElev0 = SrcInitOutputData%WaveElev0 - else if (allocated(DstInitOutputData%WaveElev0)) then - deallocate(DstInitOutputData%WaveElev0) end if DstInitOutputData%WaveTime => SrcInitOutputData%WaveTime DstInitOutputData%WaveTMax = SrcInitOutputData%WaveTMax diff --git a/modules/servodyn/src/ServoDyn_Types.f90 b/modules/servodyn/src/ServoDyn_Types.f90 index 8fe7095f2e..5ecc46252a 100644 --- a/modules/servodyn/src/ServoDyn_Types.f90 +++ b/modules/servodyn/src/ServoDyn_Types.f90 @@ -605,8 +605,6 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS end if end if DstInitInputData%BlPitchInit = SrcInitInputData%BlPitchInit - else if (allocated(DstInitInputData%BlPitchInit)) then - deallocate(DstInitInputData%BlPitchInit) end if DstInitInputData%Gravity = SrcInitInputData%Gravity DstInitInputData%NacRefPos = SrcInitInputData%NacRefPos @@ -641,8 +639,6 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS end if end if DstInitInputData%BladeRootRefPos = SrcInitInputData%BladeRootRefPos - else if (allocated(DstInitInputData%BladeRootRefPos)) then - deallocate(DstInitInputData%BladeRootRefPos) end if if (allocated(SrcInitInputData%BladeRootTransDisp)) then LB(1:2) = lbound(SrcInitInputData%BladeRootTransDisp) @@ -655,8 +651,6 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS end if end if DstInitInputData%BladeRootTransDisp = SrcInitInputData%BladeRootTransDisp - else if (allocated(DstInitInputData%BladeRootTransDisp)) then - deallocate(DstInitInputData%BladeRootTransDisp) end if if (allocated(SrcInitInputData%BladeRootOrient)) then LB(1:3) = lbound(SrcInitInputData%BladeRootOrient) @@ -669,8 +663,6 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS end if end if DstInitInputData%BladeRootOrient = SrcInitInputData%BladeRootOrient - else if (allocated(DstInitInputData%BladeRootOrient)) then - deallocate(DstInitInputData%BladeRootOrient) end if if (allocated(SrcInitInputData%BladeRootRefOrient)) then LB(1:3) = lbound(SrcInitInputData%BladeRootRefOrient) @@ -683,8 +675,6 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS end if end if DstInitInputData%BladeRootRefOrient = SrcInitInputData%BladeRootRefOrient - else if (allocated(DstInitInputData%BladeRootRefOrient)) then - deallocate(DstInitInputData%BladeRootRefOrient) end if DstInitInputData%UseInputFile = SrcInitInputData%UseInputFile call NWTC_Library_CopyFileInfoType(SrcInitInputData%PassedPrimaryInputData, DstInitInputData%PassedPrimaryInputData, CtrlCode, ErrStat2, ErrMsg2) @@ -702,8 +692,6 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS end if end if DstInitInputData%CableControlRequestor = SrcInitInputData%CableControlRequestor - else if (allocated(DstInitInputData%CableControlRequestor)) then - deallocate(DstInitInputData%CableControlRequestor) end if DstInitInputData%InterpOrder = SrcInitInputData%InterpOrder if (allocated(SrcInitInputData%fromSCGlob)) then @@ -717,8 +705,6 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS end if end if DstInitInputData%fromSCGlob = SrcInitInputData%fromSCGlob - else if (allocated(DstInitInputData%fromSCGlob)) then - deallocate(DstInitInputData%fromSCGlob) end if if (allocated(SrcInitInputData%fromSC)) then LB(1:1) = lbound(SrcInitInputData%fromSC) @@ -731,8 +717,6 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS end if end if DstInitInputData%fromSC = SrcInitInputData%fromSC - else if (allocated(DstInitInputData%fromSC)) then - deallocate(DstInitInputData%fromSC) end if if (allocated(SrcInitInputData%LidSpeed)) then LB(1:1) = lbound(SrcInitInputData%LidSpeed) @@ -745,8 +729,6 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS end if end if DstInitInputData%LidSpeed = SrcInitInputData%LidSpeed - else if (allocated(DstInitInputData%LidSpeed)) then - deallocate(DstInitInputData%LidSpeed) end if if (allocated(SrcInitInputData%MsrPositionsX)) then LB(1:1) = lbound(SrcInitInputData%MsrPositionsX) @@ -759,8 +741,6 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS end if end if DstInitInputData%MsrPositionsX = SrcInitInputData%MsrPositionsX - else if (allocated(DstInitInputData%MsrPositionsX)) then - deallocate(DstInitInputData%MsrPositionsX) end if if (allocated(SrcInitInputData%MsrPositionsY)) then LB(1:1) = lbound(SrcInitInputData%MsrPositionsY) @@ -773,8 +753,6 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS end if end if DstInitInputData%MsrPositionsY = SrcInitInputData%MsrPositionsY - else if (allocated(DstInitInputData%MsrPositionsY)) then - deallocate(DstInitInputData%MsrPositionsY) end if if (allocated(SrcInitInputData%MsrPositionsZ)) then LB(1:1) = lbound(SrcInitInputData%MsrPositionsZ) @@ -787,8 +765,6 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS end if end if DstInitInputData%MsrPositionsZ = SrcInitInputData%MsrPositionsZ - else if (allocated(DstInitInputData%MsrPositionsZ)) then - deallocate(DstInitInputData%MsrPositionsZ) end if DstInitInputData%SensorType = SrcInitInputData%SensorType DstInitInputData%NumBeam = SrcInitInputData%NumBeam @@ -1219,8 +1195,6 @@ subroutine SrvD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E end if end if DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr - else if (allocated(DstInitOutputData%WriteOutputHdr)) then - deallocate(DstInitOutputData%WriteOutputHdr) end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) @@ -1233,8 +1207,6 @@ subroutine SrvD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E end if end if DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt - else if (allocated(DstInitOutputData%WriteOutputUnt)) then - deallocate(DstInitOutputData%WriteOutputUnt) end if call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1252,8 +1224,6 @@ subroutine SrvD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E end if end if DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y - else if (allocated(DstInitOutputData%LinNames_y)) then - deallocate(DstInitOutputData%LinNames_y) end if if (allocated(SrcInitOutputData%LinNames_x)) then LB(1:1) = lbound(SrcInitOutputData%LinNames_x) @@ -1266,8 +1236,6 @@ subroutine SrvD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E end if end if DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x - else if (allocated(DstInitOutputData%LinNames_x)) then - deallocate(DstInitOutputData%LinNames_x) end if if (allocated(SrcInitOutputData%LinNames_u)) then LB(1:1) = lbound(SrcInitOutputData%LinNames_u) @@ -1280,8 +1248,6 @@ subroutine SrvD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E end if end if DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u - else if (allocated(DstInitOutputData%LinNames_u)) then - deallocate(DstInitOutputData%LinNames_u) end if if (allocated(SrcInitOutputData%RotFrame_y)) then LB(1:1) = lbound(SrcInitOutputData%RotFrame_y) @@ -1294,8 +1260,6 @@ subroutine SrvD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E end if end if DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y - else if (allocated(DstInitOutputData%RotFrame_y)) then - deallocate(DstInitOutputData%RotFrame_y) end if if (allocated(SrcInitOutputData%RotFrame_x)) then LB(1:1) = lbound(SrcInitOutputData%RotFrame_x) @@ -1308,8 +1272,6 @@ subroutine SrvD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E end if end if DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x - else if (allocated(DstInitOutputData%RotFrame_x)) then - deallocate(DstInitOutputData%RotFrame_x) end if if (allocated(SrcInitOutputData%RotFrame_u)) then LB(1:1) = lbound(SrcInitOutputData%RotFrame_u) @@ -1322,8 +1284,6 @@ subroutine SrvD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E end if end if DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u - else if (allocated(DstInitOutputData%RotFrame_u)) then - deallocate(DstInitOutputData%RotFrame_u) end if if (allocated(SrcInitOutputData%IsLoad_u)) then LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) @@ -1336,8 +1296,6 @@ subroutine SrvD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E end if end if DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u - else if (allocated(DstInitOutputData%IsLoad_u)) then - deallocate(DstInitOutputData%IsLoad_u) end if if (allocated(SrcInitOutputData%DerivOrder_x)) then LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) @@ -1350,8 +1308,6 @@ subroutine SrvD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E end if end if DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x - else if (allocated(DstInitOutputData%DerivOrder_x)) then - deallocate(DstInitOutputData%DerivOrder_x) end if end subroutine @@ -1685,8 +1641,6 @@ subroutine SrvD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS end if end if DstInputFileData%OutList = SrcInputFileData%OutList - else if (allocated(DstInputFileData%OutList)) then - deallocate(DstInputFileData%OutList) end if DstInputFileData%DLL_FileName = SrcInputFileData%DLL_FileName DstInputFileData%DLL_ProcName = SrcInputFileData%DLL_ProcName @@ -1719,8 +1673,6 @@ subroutine SrvD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS end if end if DstInputFileData%GenSpd_TLU = SrcInputFileData%GenSpd_TLU - else if (allocated(DstInputFileData%GenSpd_TLU)) then - deallocate(DstInputFileData%GenSpd_TLU) end if if (allocated(SrcInputFileData%GenTrq_TLU)) then LB(1:1) = lbound(SrcInputFileData%GenTrq_TLU) @@ -1733,8 +1685,6 @@ subroutine SrvD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS end if end if DstInputFileData%GenTrq_TLU = SrcInputFileData%GenTrq_TLU - else if (allocated(DstInputFileData%GenTrq_TLU)) then - deallocate(DstInputFileData%GenTrq_TLU) end if DstInputFileData%UseLegacyInterface = SrcInputFileData%UseLegacyInterface DstInputFileData%NumBStC = SrcInputFileData%NumBStC @@ -1749,8 +1699,6 @@ subroutine SrvD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS end if end if DstInputFileData%BStCfiles = SrcInputFileData%BStCfiles - else if (allocated(DstInputFileData%BStCfiles)) then - deallocate(DstInputFileData%BStCfiles) end if DstInputFileData%NumNStC = SrcInputFileData%NumNStC if (allocated(SrcInputFileData%NStCfiles)) then @@ -1764,8 +1712,6 @@ subroutine SrvD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS end if end if DstInputFileData%NStCfiles = SrcInputFileData%NStCfiles - else if (allocated(DstInputFileData%NStCfiles)) then - deallocate(DstInputFileData%NStCfiles) end if DstInputFileData%NumTStC = SrcInputFileData%NumTStC if (allocated(SrcInputFileData%TStCfiles)) then @@ -1779,8 +1725,6 @@ subroutine SrvD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS end if end if DstInputFileData%TStCfiles = SrcInputFileData%TStCfiles - else if (allocated(DstInputFileData%TStCfiles)) then - deallocate(DstInputFileData%TStCfiles) end if DstInputFileData%NumSStC = SrcInputFileData%NumSStC if (allocated(SrcInputFileData%SStCfiles)) then @@ -1794,8 +1738,6 @@ subroutine SrvD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS end if end if DstInputFileData%SStCfiles = SrcInputFileData%SStCfiles - else if (allocated(DstInputFileData%SStCfiles)) then - deallocate(DstInputFileData%SStCfiles) end if DstInputFileData%AfCmode = SrcInputFileData%AfCmode DstInputFileData%AfC_Mean = SrcInputFileData%AfC_Mean @@ -2250,8 +2192,6 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct end if end if DstBladedDLLTypeData%avrSWAP = SrcBladedDLLTypeData%avrSWAP - else if (allocated(DstBladedDLLTypeData%avrSWAP)) then - deallocate(DstBladedDLLTypeData%avrSWAP) end if DstBladedDLLTypeData%HSSBrTrqDemand = SrcBladedDLLTypeData%HSSBrTrqDemand DstBladedDLLTypeData%YawRateCom = SrcBladedDLLTypeData%YawRateCom @@ -2274,8 +2214,6 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct end if end if DstBladedDLLTypeData%toSC = SrcBladedDLLTypeData%toSC - else if (allocated(DstBladedDLLTypeData%toSC)) then - deallocate(DstBladedDLLTypeData%toSC) end if DstBladedDLLTypeData%initialized = SrcBladedDLLTypeData%initialized DstBladedDLLTypeData%NumLogChannels = SrcBladedDLLTypeData%NumLogChannels @@ -2294,8 +2232,6 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstBladedDLLTypeData%LogChannels_OutParam)) then - deallocate(DstBladedDLLTypeData%LogChannels_OutParam) end if if (allocated(SrcBladedDLLTypeData%LogChannels)) then LB(1:1) = lbound(SrcBladedDLLTypeData%LogChannels) @@ -2308,8 +2244,6 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct end if end if DstBladedDLLTypeData%LogChannels = SrcBladedDLLTypeData%LogChannels - else if (allocated(DstBladedDLLTypeData%LogChannels)) then - deallocate(DstBladedDLLTypeData%LogChannels) end if DstBladedDLLTypeData%ErrStat = SrcBladedDLLTypeData%ErrStat DstBladedDLLTypeData%ErrMsg = SrcBladedDLLTypeData%ErrMsg @@ -2332,8 +2266,6 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct end if end if DstBladedDLLTypeData%BlPitchInput = SrcBladedDLLTypeData%BlPitchInput - else if (allocated(DstBladedDLLTypeData%BlPitchInput)) then - deallocate(DstBladedDLLTypeData%BlPitchInput) end if DstBladedDLLTypeData%YawAngleFromNorth = SrcBladedDLLTypeData%YawAngleFromNorth DstBladedDLLTypeData%HorWindV = SrcBladedDLLTypeData%HorWindV @@ -2372,8 +2304,6 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct end if end if DstBladedDLLTypeData%LidSpeed = SrcBladedDLLTypeData%LidSpeed - else if (allocated(DstBladedDLLTypeData%LidSpeed)) then - deallocate(DstBladedDLLTypeData%LidSpeed) end if if (allocated(SrcBladedDLLTypeData%MsrPositionsX)) then LB(1:1) = lbound(SrcBladedDLLTypeData%MsrPositionsX) @@ -2386,8 +2316,6 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct end if end if DstBladedDLLTypeData%MsrPositionsX = SrcBladedDLLTypeData%MsrPositionsX - else if (allocated(DstBladedDLLTypeData%MsrPositionsX)) then - deallocate(DstBladedDLLTypeData%MsrPositionsX) end if if (allocated(SrcBladedDLLTypeData%MsrPositionsY)) then LB(1:1) = lbound(SrcBladedDLLTypeData%MsrPositionsY) @@ -2400,8 +2328,6 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct end if end if DstBladedDLLTypeData%MsrPositionsY = SrcBladedDLLTypeData%MsrPositionsY - else if (allocated(DstBladedDLLTypeData%MsrPositionsY)) then - deallocate(DstBladedDLLTypeData%MsrPositionsY) end if if (allocated(SrcBladedDLLTypeData%MsrPositionsZ)) then LB(1:1) = lbound(SrcBladedDLLTypeData%MsrPositionsZ) @@ -2414,8 +2340,6 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct end if end if DstBladedDLLTypeData%MsrPositionsZ = SrcBladedDLLTypeData%MsrPositionsZ - else if (allocated(DstBladedDLLTypeData%MsrPositionsZ)) then - deallocate(DstBladedDLLTypeData%MsrPositionsZ) end if DstBladedDLLTypeData%SensorType = SrcBladedDLLTypeData%SensorType DstBladedDLLTypeData%NumBeam = SrcBladedDLLTypeData%NumBeam @@ -2449,8 +2373,6 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct end if end if DstBladedDLLTypeData%GenSpd_TLU = SrcBladedDLLTypeData%GenSpd_TLU - else if (allocated(DstBladedDLLTypeData%GenSpd_TLU)) then - deallocate(DstBladedDLLTypeData%GenSpd_TLU) end if if (allocated(SrcBladedDLLTypeData%GenTrq_TLU)) then LB(1:1) = lbound(SrcBladedDLLTypeData%GenTrq_TLU) @@ -2463,8 +2385,6 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct end if end if DstBladedDLLTypeData%GenTrq_TLU = SrcBladedDLLTypeData%GenTrq_TLU - else if (allocated(DstBladedDLLTypeData%GenTrq_TLU)) then - deallocate(DstBladedDLLTypeData%GenTrq_TLU) end if DstBladedDLLTypeData%Yaw_Cntrl = SrcBladedDLLTypeData%Yaw_Cntrl if (allocated(SrcBladedDLLTypeData%PrevCableDeltaL)) then @@ -2478,8 +2398,6 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct end if end if DstBladedDLLTypeData%PrevCableDeltaL = SrcBladedDLLTypeData%PrevCableDeltaL - else if (allocated(DstBladedDLLTypeData%PrevCableDeltaL)) then - deallocate(DstBladedDLLTypeData%PrevCableDeltaL) end if if (allocated(SrcBladedDLLTypeData%PrevCableDeltaLdot)) then LB(1:1) = lbound(SrcBladedDLLTypeData%PrevCableDeltaLdot) @@ -2492,8 +2410,6 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct end if end if DstBladedDLLTypeData%PrevCableDeltaLdot = SrcBladedDLLTypeData%PrevCableDeltaLdot - else if (allocated(DstBladedDLLTypeData%PrevCableDeltaLdot)) then - deallocate(DstBladedDLLTypeData%PrevCableDeltaLdot) end if if (allocated(SrcBladedDLLTypeData%CableDeltaL)) then LB(1:1) = lbound(SrcBladedDLLTypeData%CableDeltaL) @@ -2506,8 +2422,6 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct end if end if DstBladedDLLTypeData%CableDeltaL = SrcBladedDLLTypeData%CableDeltaL - else if (allocated(DstBladedDLLTypeData%CableDeltaL)) then - deallocate(DstBladedDLLTypeData%CableDeltaL) end if if (allocated(SrcBladedDLLTypeData%CableDeltaLdot)) then LB(1:1) = lbound(SrcBladedDLLTypeData%CableDeltaLdot) @@ -2520,8 +2434,6 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct end if end if DstBladedDLLTypeData%CableDeltaLdot = SrcBladedDLLTypeData%CableDeltaLdot - else if (allocated(DstBladedDLLTypeData%CableDeltaLdot)) then - deallocate(DstBladedDLLTypeData%CableDeltaLdot) end if if (allocated(SrcBladedDLLTypeData%PrevStCCmdStiff)) then LB(1:2) = lbound(SrcBladedDLLTypeData%PrevStCCmdStiff) @@ -2534,8 +2446,6 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct end if end if DstBladedDLLTypeData%PrevStCCmdStiff = SrcBladedDLLTypeData%PrevStCCmdStiff - else if (allocated(DstBladedDLLTypeData%PrevStCCmdStiff)) then - deallocate(DstBladedDLLTypeData%PrevStCCmdStiff) end if if (allocated(SrcBladedDLLTypeData%PrevStCCmdDamp)) then LB(1:2) = lbound(SrcBladedDLLTypeData%PrevStCCmdDamp) @@ -2548,8 +2458,6 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct end if end if DstBladedDLLTypeData%PrevStCCmdDamp = SrcBladedDLLTypeData%PrevStCCmdDamp - else if (allocated(DstBladedDLLTypeData%PrevStCCmdDamp)) then - deallocate(DstBladedDLLTypeData%PrevStCCmdDamp) end if if (allocated(SrcBladedDLLTypeData%PrevStCCmdBrake)) then LB(1:2) = lbound(SrcBladedDLLTypeData%PrevStCCmdBrake) @@ -2562,8 +2470,6 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct end if end if DstBladedDLLTypeData%PrevStCCmdBrake = SrcBladedDLLTypeData%PrevStCCmdBrake - else if (allocated(DstBladedDLLTypeData%PrevStCCmdBrake)) then - deallocate(DstBladedDLLTypeData%PrevStCCmdBrake) end if if (allocated(SrcBladedDLLTypeData%PrevStCCmdForce)) then LB(1:2) = lbound(SrcBladedDLLTypeData%PrevStCCmdForce) @@ -2576,8 +2482,6 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct end if end if DstBladedDLLTypeData%PrevStCCmdForce = SrcBladedDLLTypeData%PrevStCCmdForce - else if (allocated(DstBladedDLLTypeData%PrevStCCmdForce)) then - deallocate(DstBladedDLLTypeData%PrevStCCmdForce) end if if (allocated(SrcBladedDLLTypeData%StCCmdStiff)) then LB(1:2) = lbound(SrcBladedDLLTypeData%StCCmdStiff) @@ -2590,8 +2494,6 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct end if end if DstBladedDLLTypeData%StCCmdStiff = SrcBladedDLLTypeData%StCCmdStiff - else if (allocated(DstBladedDLLTypeData%StCCmdStiff)) then - deallocate(DstBladedDLLTypeData%StCCmdStiff) end if if (allocated(SrcBladedDLLTypeData%StCCmdDamp)) then LB(1:2) = lbound(SrcBladedDLLTypeData%StCCmdDamp) @@ -2604,8 +2506,6 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct end if end if DstBladedDLLTypeData%StCCmdDamp = SrcBladedDLLTypeData%StCCmdDamp - else if (allocated(DstBladedDLLTypeData%StCCmdDamp)) then - deallocate(DstBladedDLLTypeData%StCCmdDamp) end if if (allocated(SrcBladedDLLTypeData%StCCmdBrake)) then LB(1:2) = lbound(SrcBladedDLLTypeData%StCCmdBrake) @@ -2618,8 +2518,6 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct end if end if DstBladedDLLTypeData%StCCmdBrake = SrcBladedDLLTypeData%StCCmdBrake - else if (allocated(DstBladedDLLTypeData%StCCmdBrake)) then - deallocate(DstBladedDLLTypeData%StCCmdBrake) end if if (allocated(SrcBladedDLLTypeData%StCCmdForce)) then LB(1:2) = lbound(SrcBladedDLLTypeData%StCCmdForce) @@ -2632,8 +2530,6 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct end if end if DstBladedDLLTypeData%StCCmdForce = SrcBladedDLLTypeData%StCCmdForce - else if (allocated(DstBladedDLLTypeData%StCCmdForce)) then - deallocate(DstBladedDLLTypeData%StCCmdForce) end if if (allocated(SrcBladedDLLTypeData%StCMeasDisp)) then LB(1:2) = lbound(SrcBladedDLLTypeData%StCMeasDisp) @@ -2646,8 +2542,6 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct end if end if DstBladedDLLTypeData%StCMeasDisp = SrcBladedDLLTypeData%StCMeasDisp - else if (allocated(DstBladedDLLTypeData%StCMeasDisp)) then - deallocate(DstBladedDLLTypeData%StCMeasDisp) end if if (allocated(SrcBladedDLLTypeData%StCMeasVel)) then LB(1:2) = lbound(SrcBladedDLLTypeData%StCMeasVel) @@ -2660,8 +2554,6 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct end if end if DstBladedDLLTypeData%StCMeasVel = SrcBladedDLLTypeData%StCMeasVel - else if (allocated(DstBladedDLLTypeData%StCMeasVel)) then - deallocate(DstBladedDLLTypeData%StCMeasVel) end if end subroutine @@ -3499,8 +3391,6 @@ subroutine SrvD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrS call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstContStateData%BStC)) then - deallocate(DstContStateData%BStC) end if if (allocated(SrcContStateData%NStC)) then LB(1:1) = lbound(SrcContStateData%NStC) @@ -3517,8 +3407,6 @@ subroutine SrvD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrS call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstContStateData%NStC)) then - deallocate(DstContStateData%NStC) end if if (allocated(SrcContStateData%TStC)) then LB(1:1) = lbound(SrcContStateData%TStC) @@ -3535,8 +3423,6 @@ subroutine SrvD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrS call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstContStateData%TStC)) then - deallocate(DstContStateData%TStC) end if if (allocated(SrcContStateData%SStC)) then LB(1:1) = lbound(SrcContStateData%SStC) @@ -3553,8 +3439,6 @@ subroutine SrvD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrS call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstContStateData%SStC)) then - deallocate(DstContStateData%SStC) end if end subroutine @@ -3756,8 +3640,6 @@ subroutine SrvD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrS call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstDiscStateData%BStC)) then - deallocate(DstDiscStateData%BStC) end if if (allocated(SrcDiscStateData%NStC)) then LB(1:1) = lbound(SrcDiscStateData%NStC) @@ -3774,8 +3656,6 @@ subroutine SrvD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrS call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstDiscStateData%NStC)) then - deallocate(DstDiscStateData%NStC) end if if (allocated(SrcDiscStateData%TStC)) then LB(1:1) = lbound(SrcDiscStateData%TStC) @@ -3792,8 +3672,6 @@ subroutine SrvD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrS call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstDiscStateData%TStC)) then - deallocate(DstDiscStateData%TStC) end if if (allocated(SrcDiscStateData%SStC)) then LB(1:1) = lbound(SrcDiscStateData%SStC) @@ -3810,8 +3688,6 @@ subroutine SrvD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrS call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstDiscStateData%SStC)) then - deallocate(DstDiscStateData%SStC) end if end subroutine @@ -4013,8 +3889,6 @@ subroutine SrvD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstConstrStateData%BStC)) then - deallocate(DstConstrStateData%BStC) end if if (allocated(SrcConstrStateData%NStC)) then LB(1:1) = lbound(SrcConstrStateData%NStC) @@ -4031,8 +3905,6 @@ subroutine SrvD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstConstrStateData%NStC)) then - deallocate(DstConstrStateData%NStC) end if if (allocated(SrcConstrStateData%TStC)) then LB(1:1) = lbound(SrcConstrStateData%TStC) @@ -4049,8 +3921,6 @@ subroutine SrvD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstConstrStateData%TStC)) then - deallocate(DstConstrStateData%TStC) end if if (allocated(SrcConstrStateData%SStC)) then LB(1:1) = lbound(SrcConstrStateData%SStC) @@ -4067,8 +3937,6 @@ subroutine SrvD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstConstrStateData%SStC)) then - deallocate(DstConstrStateData%SStC) end if end subroutine @@ -4265,8 +4133,6 @@ subroutine SrvD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E end if end if DstOtherStateData%BegPitMan = SrcOtherStateData%BegPitMan - else if (allocated(DstOtherStateData%BegPitMan)) then - deallocate(DstOtherStateData%BegPitMan) end if if (allocated(SrcOtherStateData%BlPitchI)) then LB(1:1) = lbound(SrcOtherStateData%BlPitchI) @@ -4279,8 +4145,6 @@ subroutine SrvD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E end if end if DstOtherStateData%BlPitchI = SrcOtherStateData%BlPitchI - else if (allocated(DstOtherStateData%BlPitchI)) then - deallocate(DstOtherStateData%BlPitchI) end if if (allocated(SrcOtherStateData%TPitManE)) then LB(1:1) = lbound(SrcOtherStateData%TPitManE) @@ -4293,8 +4157,6 @@ subroutine SrvD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E end if end if DstOtherStateData%TPitManE = SrcOtherStateData%TPitManE - else if (allocated(DstOtherStateData%TPitManE)) then - deallocate(DstOtherStateData%TPitManE) end if DstOtherStateData%BegYawMan = SrcOtherStateData%BegYawMan DstOtherStateData%NacYawI = SrcOtherStateData%NacYawI @@ -4311,8 +4173,6 @@ subroutine SrvD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E end if end if DstOtherStateData%BegTpBr = SrcOtherStateData%BegTpBr - else if (allocated(DstOtherStateData%BegTpBr)) then - deallocate(DstOtherStateData%BegTpBr) end if if (allocated(SrcOtherStateData%TTpBrDp)) then LB(1:1) = lbound(SrcOtherStateData%TTpBrDp) @@ -4325,8 +4185,6 @@ subroutine SrvD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E end if end if DstOtherStateData%TTpBrDp = SrcOtherStateData%TTpBrDp - else if (allocated(DstOtherStateData%TTpBrDp)) then - deallocate(DstOtherStateData%TTpBrDp) end if if (allocated(SrcOtherStateData%TTpBrFl)) then LB(1:1) = lbound(SrcOtherStateData%TTpBrFl) @@ -4339,8 +4197,6 @@ subroutine SrvD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E end if end if DstOtherStateData%TTpBrFl = SrcOtherStateData%TTpBrFl - else if (allocated(DstOtherStateData%TTpBrFl)) then - deallocate(DstOtherStateData%TTpBrFl) end if DstOtherStateData%Off4Good = SrcOtherStateData%Off4Good DstOtherStateData%GenOnLine = SrcOtherStateData%GenOnLine @@ -4359,8 +4215,6 @@ subroutine SrvD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstOtherStateData%BStC)) then - deallocate(DstOtherStateData%BStC) end if if (allocated(SrcOtherStateData%NStC)) then LB(1:1) = lbound(SrcOtherStateData%NStC) @@ -4377,8 +4231,6 @@ subroutine SrvD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstOtherStateData%NStC)) then - deallocate(DstOtherStateData%NStC) end if if (allocated(SrcOtherStateData%TStC)) then LB(1:1) = lbound(SrcOtherStateData%TStC) @@ -4395,8 +4247,6 @@ subroutine SrvD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstOtherStateData%TStC)) then - deallocate(DstOtherStateData%TStC) end if if (allocated(SrcOtherStateData%SStC)) then LB(1:1) = lbound(SrcOtherStateData%SStC) @@ -4413,8 +4263,6 @@ subroutine SrvD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstOtherStateData%SStC)) then - deallocate(DstOtherStateData%SStC) end if end subroutine @@ -4764,8 +4612,6 @@ subroutine SrvD_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct if (ErrStat >= AbortErrLev) return end do end do - else if (allocated(DstModuleMapTypeData%u_BStC_Mot2_BStC)) then - deallocate(DstModuleMapTypeData%u_BStC_Mot2_BStC) end if if (allocated(SrcModuleMapTypeData%u_NStC_Mot2_NStC)) then LB(1:1) = lbound(SrcModuleMapTypeData%u_NStC_Mot2_NStC) @@ -4782,8 +4628,6 @@ subroutine SrvD_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstModuleMapTypeData%u_NStC_Mot2_NStC)) then - deallocate(DstModuleMapTypeData%u_NStC_Mot2_NStC) end if if (allocated(SrcModuleMapTypeData%u_TStC_Mot2_TStC)) then LB(1:1) = lbound(SrcModuleMapTypeData%u_TStC_Mot2_TStC) @@ -4800,8 +4644,6 @@ subroutine SrvD_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstModuleMapTypeData%u_TStC_Mot2_TStC)) then - deallocate(DstModuleMapTypeData%u_TStC_Mot2_TStC) end if if (allocated(SrcModuleMapTypeData%u_SStC_Mot2_SStC)) then LB(1:1) = lbound(SrcModuleMapTypeData%u_SStC_Mot2_SStC) @@ -4818,8 +4660,6 @@ subroutine SrvD_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstModuleMapTypeData%u_SStC_Mot2_SStC)) then - deallocate(DstModuleMapTypeData%u_SStC_Mot2_SStC) end if if (allocated(SrcModuleMapTypeData%BStC_Frc2_y_BStC)) then LB(1:2) = lbound(SrcModuleMapTypeData%BStC_Frc2_y_BStC) @@ -4838,8 +4678,6 @@ subroutine SrvD_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct if (ErrStat >= AbortErrLev) return end do end do - else if (allocated(DstModuleMapTypeData%BStC_Frc2_y_BStC)) then - deallocate(DstModuleMapTypeData%BStC_Frc2_y_BStC) end if if (allocated(SrcModuleMapTypeData%NStC_Frc2_y_NStC)) then LB(1:1) = lbound(SrcModuleMapTypeData%NStC_Frc2_y_NStC) @@ -4856,8 +4694,6 @@ subroutine SrvD_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstModuleMapTypeData%NStC_Frc2_y_NStC)) then - deallocate(DstModuleMapTypeData%NStC_Frc2_y_NStC) end if if (allocated(SrcModuleMapTypeData%TStC_Frc2_y_TStC)) then LB(1:1) = lbound(SrcModuleMapTypeData%TStC_Frc2_y_TStC) @@ -4874,8 +4710,6 @@ subroutine SrvD_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstModuleMapTypeData%TStC_Frc2_y_TStC)) then - deallocate(DstModuleMapTypeData%TStC_Frc2_y_TStC) end if if (allocated(SrcModuleMapTypeData%SStC_Frc2_y_SStC)) then LB(1:1) = lbound(SrcModuleMapTypeData%SStC_Frc2_y_SStC) @@ -4892,8 +4726,6 @@ subroutine SrvD_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstModuleMapTypeData%SStC_Frc2_y_SStC)) then - deallocate(DstModuleMapTypeData%SStC_Frc2_y_SStC) end if end subroutine @@ -5237,8 +5069,6 @@ subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%xd_BlPitchFilter = SrcMiscData%xd_BlPitchFilter - else if (allocated(DstMiscData%xd_BlPitchFilter)) then - deallocate(DstMiscData%xd_BlPitchFilter) end if if (allocated(SrcMiscData%BStC)) then LB(1:1) = lbound(SrcMiscData%BStC) @@ -5255,8 +5085,6 @@ subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstMiscData%BStC)) then - deallocate(DstMiscData%BStC) end if if (allocated(SrcMiscData%NStC)) then LB(1:1) = lbound(SrcMiscData%NStC) @@ -5273,8 +5101,6 @@ subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstMiscData%NStC)) then - deallocate(DstMiscData%NStC) end if if (allocated(SrcMiscData%TStC)) then LB(1:1) = lbound(SrcMiscData%TStC) @@ -5291,8 +5117,6 @@ subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstMiscData%TStC)) then - deallocate(DstMiscData%TStC) end if if (allocated(SrcMiscData%SStC)) then LB(1:1) = lbound(SrcMiscData%SStC) @@ -5309,8 +5133,6 @@ subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstMiscData%SStC)) then - deallocate(DstMiscData%SStC) end if if (allocated(SrcMiscData%u_BStC)) then LB(1:2) = lbound(SrcMiscData%u_BStC) @@ -5329,8 +5151,6 @@ subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) if (ErrStat >= AbortErrLev) return end do end do - else if (allocated(DstMiscData%u_BStC)) then - deallocate(DstMiscData%u_BStC) end if if (allocated(SrcMiscData%u_NStC)) then LB(1:2) = lbound(SrcMiscData%u_NStC) @@ -5349,8 +5169,6 @@ subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) if (ErrStat >= AbortErrLev) return end do end do - else if (allocated(DstMiscData%u_NStC)) then - deallocate(DstMiscData%u_NStC) end if if (allocated(SrcMiscData%u_TStC)) then LB(1:2) = lbound(SrcMiscData%u_TStC) @@ -5369,8 +5187,6 @@ subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) if (ErrStat >= AbortErrLev) return end do end do - else if (allocated(DstMiscData%u_TStC)) then - deallocate(DstMiscData%u_TStC) end if if (allocated(SrcMiscData%u_SStC)) then LB(1:2) = lbound(SrcMiscData%u_SStC) @@ -5389,8 +5205,6 @@ subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) if (ErrStat >= AbortErrLev) return end do end do - else if (allocated(DstMiscData%u_SStC)) then - deallocate(DstMiscData%u_SStC) end if if (allocated(SrcMiscData%y_BStC)) then LB(1:1) = lbound(SrcMiscData%y_BStC) @@ -5407,8 +5221,6 @@ subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstMiscData%y_BStC)) then - deallocate(DstMiscData%y_BStC) end if if (allocated(SrcMiscData%y_NStC)) then LB(1:1) = lbound(SrcMiscData%y_NStC) @@ -5425,8 +5237,6 @@ subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstMiscData%y_NStC)) then - deallocate(DstMiscData%y_NStC) end if if (allocated(SrcMiscData%y_TStC)) then LB(1:1) = lbound(SrcMiscData%y_TStC) @@ -5443,8 +5253,6 @@ subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstMiscData%y_TStC)) then - deallocate(DstMiscData%y_TStC) end if if (allocated(SrcMiscData%y_SStC)) then LB(1:1) = lbound(SrcMiscData%y_SStC) @@ -5461,8 +5269,6 @@ subroutine SrvD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstMiscData%y_SStC)) then - deallocate(DstMiscData%y_SStC) end if call SrvD_CopyModuleMapType(SrcMiscData%SrvD_MeshMap, DstMiscData%SrvD_MeshMap, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6013,8 +5819,6 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%BlPitchInit = SrcParamData%BlPitchInit - else if (allocated(DstParamData%BlPitchInit)) then - deallocate(DstParamData%BlPitchInit) end if if (allocated(SrcParamData%BlPitchF)) then LB(1:1) = lbound(SrcParamData%BlPitchF) @@ -6027,8 +5831,6 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%BlPitchF = SrcParamData%BlPitchF - else if (allocated(DstParamData%BlPitchF)) then - deallocate(DstParamData%BlPitchF) end if if (allocated(SrcParamData%PitManRat)) then LB(1:1) = lbound(SrcParamData%PitManRat) @@ -6041,8 +5843,6 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%PitManRat = SrcParamData%PitManRat - else if (allocated(DstParamData%PitManRat)) then - deallocate(DstParamData%PitManRat) end if DstParamData%YawManRat = SrcParamData%YawManRat DstParamData%NacYawF = SrcParamData%NacYawF @@ -6063,8 +5863,6 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%TPitManS = SrcParamData%TPitManS - else if (allocated(DstParamData%TPitManS)) then - deallocate(DstParamData%TPitManS) end if DstParamData%TYawManS = SrcParamData%TYawManS DstParamData%TYCOn = SrcParamData%TYCOn @@ -6099,8 +5897,6 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%TBDepISp = SrcParamData%TBDepISp - else if (allocated(DstParamData%TBDepISp)) then - deallocate(DstParamData%TBDepISp) end if DstParamData%TBDrConN = SrcParamData%TBDrConN DstParamData%TBDrConD = SrcParamData%TBDrConD @@ -6133,8 +5929,6 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstParamData%OutParam)) then - deallocate(DstParamData%OutParam) end if DstParamData%Delim = SrcParamData%Delim DstParamData%UseBladedInterface = SrcParamData%UseBladedInterface @@ -6165,8 +5959,6 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstParamData%BStC)) then - deallocate(DstParamData%BStC) end if if (allocated(SrcParamData%NStC)) then LB(1:1) = lbound(SrcParamData%NStC) @@ -6183,8 +5975,6 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstParamData%NStC)) then - deallocate(DstParamData%NStC) end if if (allocated(SrcParamData%TStC)) then LB(1:1) = lbound(SrcParamData%TStC) @@ -6201,8 +5991,6 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstParamData%TStC)) then - deallocate(DstParamData%TStC) end if if (allocated(SrcParamData%SStC)) then LB(1:1) = lbound(SrcParamData%SStC) @@ -6219,8 +6007,6 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstParamData%SStC)) then - deallocate(DstParamData%SStC) end if DstParamData%InterpOrder = SrcParamData%InterpOrder DstParamData%EXavrSWAP = SrcParamData%EXavrSWAP @@ -6237,8 +6023,6 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%StCMeasNumPerChan = SrcParamData%StCMeasNumPerChan - else if (allocated(DstParamData%StCMeasNumPerChan)) then - deallocate(DstParamData%StCMeasNumPerChan) end if DstParamData%UseSC = SrcParamData%UseSC if (allocated(SrcParamData%Jac_u_indx)) then @@ -6252,8 +6036,6 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx - else if (allocated(DstParamData%Jac_u_indx)) then - deallocate(DstParamData%Jac_u_indx) end if if (allocated(SrcParamData%Jac_x_indx)) then LB(1:2) = lbound(SrcParamData%Jac_x_indx) @@ -6266,8 +6048,6 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%Jac_x_indx = SrcParamData%Jac_x_indx - else if (allocated(DstParamData%Jac_x_indx)) then - deallocate(DstParamData%Jac_x_indx) end if if (allocated(SrcParamData%du)) then LB(1:1) = lbound(SrcParamData%du) @@ -6280,8 +6060,6 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%du = SrcParamData%du - else if (allocated(DstParamData%du)) then - deallocate(DstParamData%du) end if if (allocated(SrcParamData%dx)) then LB(1:1) = lbound(SrcParamData%dx) @@ -6294,8 +6072,6 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%dx = SrcParamData%dx - else if (allocated(DstParamData%dx)) then - deallocate(DstParamData%dx) end if DstParamData%Jac_nu = SrcParamData%Jac_nu DstParamData%Jac_ny = SrcParamData%Jac_ny @@ -6311,8 +6087,6 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%Jac_Idx_BStC_u = SrcParamData%Jac_Idx_BStC_u - else if (allocated(DstParamData%Jac_Idx_BStC_u)) then - deallocate(DstParamData%Jac_Idx_BStC_u) end if if (allocated(SrcParamData%Jac_Idx_NStC_u)) then LB(1:2) = lbound(SrcParamData%Jac_Idx_NStC_u) @@ -6325,8 +6099,6 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%Jac_Idx_NStC_u = SrcParamData%Jac_Idx_NStC_u - else if (allocated(DstParamData%Jac_Idx_NStC_u)) then - deallocate(DstParamData%Jac_Idx_NStC_u) end if if (allocated(SrcParamData%Jac_Idx_TStC_u)) then LB(1:2) = lbound(SrcParamData%Jac_Idx_TStC_u) @@ -6339,8 +6111,6 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%Jac_Idx_TStC_u = SrcParamData%Jac_Idx_TStC_u - else if (allocated(DstParamData%Jac_Idx_TStC_u)) then - deallocate(DstParamData%Jac_Idx_TStC_u) end if if (allocated(SrcParamData%Jac_Idx_SStC_u)) then LB(1:2) = lbound(SrcParamData%Jac_Idx_SStC_u) @@ -6353,8 +6123,6 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%Jac_Idx_SStC_u = SrcParamData%Jac_Idx_SStC_u - else if (allocated(DstParamData%Jac_Idx_SStC_u)) then - deallocate(DstParamData%Jac_Idx_SStC_u) end if if (allocated(SrcParamData%Jac_Idx_BStC_x)) then LB(1:3) = lbound(SrcParamData%Jac_Idx_BStC_x) @@ -6367,8 +6135,6 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%Jac_Idx_BStC_x = SrcParamData%Jac_Idx_BStC_x - else if (allocated(DstParamData%Jac_Idx_BStC_x)) then - deallocate(DstParamData%Jac_Idx_BStC_x) end if if (allocated(SrcParamData%Jac_Idx_NStC_x)) then LB(1:2) = lbound(SrcParamData%Jac_Idx_NStC_x) @@ -6381,8 +6147,6 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%Jac_Idx_NStC_x = SrcParamData%Jac_Idx_NStC_x - else if (allocated(DstParamData%Jac_Idx_NStC_x)) then - deallocate(DstParamData%Jac_Idx_NStC_x) end if if (allocated(SrcParamData%Jac_Idx_TStC_x)) then LB(1:2) = lbound(SrcParamData%Jac_Idx_TStC_x) @@ -6395,8 +6159,6 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%Jac_Idx_TStC_x = SrcParamData%Jac_Idx_TStC_x - else if (allocated(DstParamData%Jac_Idx_TStC_x)) then - deallocate(DstParamData%Jac_Idx_TStC_x) end if if (allocated(SrcParamData%Jac_Idx_SStC_x)) then LB(1:2) = lbound(SrcParamData%Jac_Idx_SStC_x) @@ -6409,8 +6171,6 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%Jac_Idx_SStC_x = SrcParamData%Jac_Idx_SStC_x - else if (allocated(DstParamData%Jac_Idx_SStC_x)) then - deallocate(DstParamData%Jac_Idx_SStC_x) end if if (allocated(SrcParamData%Jac_Idx_BStC_y)) then LB(1:3) = lbound(SrcParamData%Jac_Idx_BStC_y) @@ -6423,8 +6183,6 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%Jac_Idx_BStC_y = SrcParamData%Jac_Idx_BStC_y - else if (allocated(DstParamData%Jac_Idx_BStC_y)) then - deallocate(DstParamData%Jac_Idx_BStC_y) end if if (allocated(SrcParamData%Jac_Idx_NStC_y)) then LB(1:2) = lbound(SrcParamData%Jac_Idx_NStC_y) @@ -6437,8 +6195,6 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%Jac_Idx_NStC_y = SrcParamData%Jac_Idx_NStC_y - else if (allocated(DstParamData%Jac_Idx_NStC_y)) then - deallocate(DstParamData%Jac_Idx_NStC_y) end if if (allocated(SrcParamData%Jac_Idx_TStC_y)) then LB(1:2) = lbound(SrcParamData%Jac_Idx_TStC_y) @@ -6451,8 +6207,6 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%Jac_Idx_TStC_y = SrcParamData%Jac_Idx_TStC_y - else if (allocated(DstParamData%Jac_Idx_TStC_y)) then - deallocate(DstParamData%Jac_Idx_TStC_y) end if if (allocated(SrcParamData%Jac_Idx_SStC_y)) then LB(1:2) = lbound(SrcParamData%Jac_Idx_SStC_y) @@ -6465,8 +6219,6 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%Jac_Idx_SStC_y = SrcParamData%Jac_Idx_SStC_y - else if (allocated(DstParamData%Jac_Idx_SStC_y)) then - deallocate(DstParamData%Jac_Idx_SStC_y) end if DstParamData%SensorType = SrcParamData%SensorType DstParamData%NumBeam = SrcParamData%NumBeam @@ -7471,8 +7223,6 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%BlPitch = SrcInputData%BlPitch - else if (allocated(DstInputData%BlPitch)) then - deallocate(DstInputData%BlPitch) end if DstInputData%Yaw = SrcInputData%Yaw DstInputData%YawRate = SrcInputData%YawRate @@ -7492,8 +7242,6 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%ExternalBlPitchCom = SrcInputData%ExternalBlPitchCom - else if (allocated(DstInputData%ExternalBlPitchCom)) then - deallocate(DstInputData%ExternalBlPitchCom) end if DstInputData%ExternalGenTrq = SrcInputData%ExternalGenTrq DstInputData%ExternalElecPwr = SrcInputData%ExternalElecPwr @@ -7509,8 +7257,6 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%ExternalBlAirfoilCom = SrcInputData%ExternalBlAirfoilCom - else if (allocated(DstInputData%ExternalBlAirfoilCom)) then - deallocate(DstInputData%ExternalBlAirfoilCom) end if if (allocated(SrcInputData%ExternalCableDeltaL)) then LB(1:1) = lbound(SrcInputData%ExternalCableDeltaL) @@ -7523,8 +7269,6 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%ExternalCableDeltaL = SrcInputData%ExternalCableDeltaL - else if (allocated(DstInputData%ExternalCableDeltaL)) then - deallocate(DstInputData%ExternalCableDeltaL) end if if (allocated(SrcInputData%ExternalCableDeltaLdot)) then LB(1:1) = lbound(SrcInputData%ExternalCableDeltaLdot) @@ -7537,8 +7281,6 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%ExternalCableDeltaLdot = SrcInputData%ExternalCableDeltaLdot - else if (allocated(DstInputData%ExternalCableDeltaLdot)) then - deallocate(DstInputData%ExternalCableDeltaLdot) end if DstInputData%TwrAccel = SrcInputData%TwrAccel DstInputData%YawErr = SrcInputData%YawErr @@ -7575,8 +7317,6 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%fromSC = SrcInputData%fromSC - else if (allocated(DstInputData%fromSC)) then - deallocate(DstInputData%fromSC) end if if (allocated(SrcInputData%fromSCglob)) then LB(1:1) = lbound(SrcInputData%fromSCglob) @@ -7589,8 +7329,6 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%fromSCglob = SrcInputData%fromSCglob - else if (allocated(DstInputData%fromSCglob)) then - deallocate(DstInputData%fromSCglob) end if if (allocated(SrcInputData%Lidar)) then LB(1:1) = lbound(SrcInputData%Lidar) @@ -7603,8 +7341,6 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%Lidar = SrcInputData%Lidar - else if (allocated(DstInputData%Lidar)) then - deallocate(DstInputData%Lidar) end if call MeshCopy(SrcInputData%PtfmMotionMesh, DstInputData%PtfmMotionMesh, CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -7626,8 +7362,6 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) if (ErrStat >= AbortErrLev) return end do end do - else if (allocated(DstInputData%BStCMotionMesh)) then - deallocate(DstInputData%BStCMotionMesh) end if if (allocated(SrcInputData%NStCMotionMesh)) then LB(1:1) = lbound(SrcInputData%NStCMotionMesh) @@ -7644,8 +7378,6 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstInputData%NStCMotionMesh)) then - deallocate(DstInputData%NStCMotionMesh) end if if (allocated(SrcInputData%TStCMotionMesh)) then LB(1:1) = lbound(SrcInputData%TStCMotionMesh) @@ -7662,8 +7394,6 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstInputData%TStCMotionMesh)) then - deallocate(DstInputData%TStCMotionMesh) end if if (allocated(SrcInputData%SStCMotionMesh)) then LB(1:1) = lbound(SrcInputData%SStCMotionMesh) @@ -7680,8 +7410,6 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstInputData%SStCMotionMesh)) then - deallocate(DstInputData%SStCMotionMesh) end if if (allocated(SrcInputData%LidSpeed)) then LB(1:1) = lbound(SrcInputData%LidSpeed) @@ -7694,8 +7422,6 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%LidSpeed = SrcInputData%LidSpeed - else if (allocated(DstInputData%LidSpeed)) then - deallocate(DstInputData%LidSpeed) end if if (allocated(SrcInputData%MsrPositionsX)) then LB(1:1) = lbound(SrcInputData%MsrPositionsX) @@ -7708,8 +7434,6 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%MsrPositionsX = SrcInputData%MsrPositionsX - else if (allocated(DstInputData%MsrPositionsX)) then - deallocate(DstInputData%MsrPositionsX) end if if (allocated(SrcInputData%MsrPositionsY)) then LB(1:1) = lbound(SrcInputData%MsrPositionsY) @@ -7722,8 +7446,6 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%MsrPositionsY = SrcInputData%MsrPositionsY - else if (allocated(DstInputData%MsrPositionsY)) then - deallocate(DstInputData%MsrPositionsY) end if if (allocated(SrcInputData%MsrPositionsZ)) then LB(1:1) = lbound(SrcInputData%MsrPositionsZ) @@ -7736,8 +7458,6 @@ subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%MsrPositionsZ = SrcInputData%MsrPositionsZ - else if (allocated(DstInputData%MsrPositionsZ)) then - deallocate(DstInputData%MsrPositionsZ) end if end subroutine @@ -8307,8 +8027,6 @@ subroutine SrvD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM end if end if DstOutputData%WriteOutput = SrcOutputData%WriteOutput - else if (allocated(DstOutputData%WriteOutput)) then - deallocate(DstOutputData%WriteOutput) end if if (allocated(SrcOutputData%BlPitchCom)) then LB(1:1) = lbound(SrcOutputData%BlPitchCom) @@ -8321,8 +8039,6 @@ subroutine SrvD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM end if end if DstOutputData%BlPitchCom = SrcOutputData%BlPitchCom - else if (allocated(DstOutputData%BlPitchCom)) then - deallocate(DstOutputData%BlPitchCom) end if if (allocated(SrcOutputData%BlAirfoilCom)) then LB(1:1) = lbound(SrcOutputData%BlAirfoilCom) @@ -8335,8 +8051,6 @@ subroutine SrvD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM end if end if DstOutputData%BlAirfoilCom = SrcOutputData%BlAirfoilCom - else if (allocated(DstOutputData%BlAirfoilCom)) then - deallocate(DstOutputData%BlAirfoilCom) end if DstOutputData%YawMom = SrcOutputData%YawMom DstOutputData%GenTrq = SrcOutputData%GenTrq @@ -8353,8 +8067,6 @@ subroutine SrvD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM end if end if DstOutputData%TBDrCon = SrcOutputData%TBDrCon - else if (allocated(DstOutputData%TBDrCon)) then - deallocate(DstOutputData%TBDrCon) end if if (allocated(SrcOutputData%Lidar)) then LB(1:1) = lbound(SrcOutputData%Lidar) @@ -8367,8 +8079,6 @@ subroutine SrvD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM end if end if DstOutputData%Lidar = SrcOutputData%Lidar - else if (allocated(DstOutputData%Lidar)) then - deallocate(DstOutputData%Lidar) end if if (allocated(SrcOutputData%CableDeltaL)) then LB(1:1) = lbound(SrcOutputData%CableDeltaL) @@ -8381,8 +8091,6 @@ subroutine SrvD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM end if end if DstOutputData%CableDeltaL = SrcOutputData%CableDeltaL - else if (allocated(DstOutputData%CableDeltaL)) then - deallocate(DstOutputData%CableDeltaL) end if if (allocated(SrcOutputData%CableDeltaLdot)) then LB(1:1) = lbound(SrcOutputData%CableDeltaLdot) @@ -8395,8 +8103,6 @@ subroutine SrvD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM end if end if DstOutputData%CableDeltaLdot = SrcOutputData%CableDeltaLdot - else if (allocated(DstOutputData%CableDeltaLdot)) then - deallocate(DstOutputData%CableDeltaLdot) end if if (allocated(SrcOutputData%BStCLoadMesh)) then LB(1:2) = lbound(SrcOutputData%BStCLoadMesh) @@ -8415,8 +8121,6 @@ subroutine SrvD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM if (ErrStat >= AbortErrLev) return end do end do - else if (allocated(DstOutputData%BStCLoadMesh)) then - deallocate(DstOutputData%BStCLoadMesh) end if if (allocated(SrcOutputData%NStCLoadMesh)) then LB(1:1) = lbound(SrcOutputData%NStCLoadMesh) @@ -8433,8 +8137,6 @@ subroutine SrvD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstOutputData%NStCLoadMesh)) then - deallocate(DstOutputData%NStCLoadMesh) end if if (allocated(SrcOutputData%TStCLoadMesh)) then LB(1:1) = lbound(SrcOutputData%TStCLoadMesh) @@ -8451,8 +8153,6 @@ subroutine SrvD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstOutputData%TStCLoadMesh)) then - deallocate(DstOutputData%TStCLoadMesh) end if if (allocated(SrcOutputData%SStCLoadMesh)) then LB(1:1) = lbound(SrcOutputData%SStCLoadMesh) @@ -8469,8 +8169,6 @@ subroutine SrvD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstOutputData%SStCLoadMesh)) then - deallocate(DstOutputData%SStCLoadMesh) end if if (allocated(SrcOutputData%toSC)) then LB(1:1) = lbound(SrcOutputData%toSC) @@ -8483,8 +8181,6 @@ subroutine SrvD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM end if end if DstOutputData%toSC = SrcOutputData%toSC - else if (allocated(DstOutputData%toSC)) then - deallocate(DstOutputData%toSC) end if end subroutine diff --git a/modules/servodyn/src/StrucCtrl_Types.f90 b/modules/servodyn/src/StrucCtrl_Types.f90 index 84dca770ea..3f63d2428e 100644 --- a/modules/servodyn/src/StrucCtrl_Types.f90 +++ b/modules/servodyn/src/StrucCtrl_Types.f90 @@ -333,8 +333,6 @@ subroutine StC_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSt end if end if DstInputFileData%F_TBL = SrcInputFileData%F_TBL - else if (allocated(DstInputFileData%F_TBL)) then - deallocate(DstInputFileData%F_TBL) end if DstInputFileData%PrescribedForcesCoordSys = SrcInputFileData%PrescribedForcesCoordSys DstInputFileData%PrescribedForcesFile = SrcInputFileData%PrescribedForcesFile @@ -349,8 +347,6 @@ subroutine StC_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSt end if end if DstInputFileData%StC_PrescribedForce = SrcInputFileData%StC_PrescribedForce - else if (allocated(DstInputFileData%StC_PrescribedForce)) then - deallocate(DstInputFileData%StC_PrescribedForce) end if if (allocated(SrcInputFileData%StC_CChan)) then LB(1:1) = lbound(SrcInputFileData%StC_CChan) @@ -363,8 +359,6 @@ subroutine StC_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSt end if end if DstInputFileData%StC_CChan = SrcInputFileData%StC_CChan - else if (allocated(DstInputFileData%StC_CChan)) then - deallocate(DstInputFileData%StC_CChan) end if end subroutine @@ -677,8 +671,6 @@ subroutine StC_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSt end if end if DstInitInputData%InitRefPos = SrcInitInputData%InitRefPos - else if (allocated(DstInitInputData%InitRefPos)) then - deallocate(DstInitInputData%InitRefPos) end if if (allocated(SrcInitInputData%InitTransDisp)) then LB(1:2) = lbound(SrcInitInputData%InitTransDisp) @@ -691,8 +683,6 @@ subroutine StC_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSt end if end if DstInitInputData%InitTransDisp = SrcInitInputData%InitTransDisp - else if (allocated(DstInitInputData%InitTransDisp)) then - deallocate(DstInitInputData%InitTransDisp) end if if (allocated(SrcInitInputData%InitOrient)) then LB(1:3) = lbound(SrcInitInputData%InitOrient) @@ -705,8 +695,6 @@ subroutine StC_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSt end if end if DstInitInputData%InitOrient = SrcInitInputData%InitOrient - else if (allocated(DstInitInputData%InitOrient)) then - deallocate(DstInitInputData%InitOrient) end if if (allocated(SrcInitInputData%InitRefOrient)) then LB(1:3) = lbound(SrcInitInputData%InitRefOrient) @@ -719,8 +707,6 @@ subroutine StC_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSt end if end if DstInitInputData%InitRefOrient = SrcInitInputData%InitRefOrient - else if (allocated(DstInitInputData%InitRefOrient)) then - deallocate(DstInitInputData%InitRefOrient) end if DstInitInputData%UseInputFile = SrcInitInputData%UseInputFile call NWTC_Library_CopyFileInfoType(SrcInitInputData%PassedPrimaryInputData, DstInitInputData%PassedPrimaryInputData, CtrlCode, ErrStat2, ErrMsg2) @@ -897,8 +883,6 @@ subroutine StC_CopyCtrlChanInitInfoType(SrcCtrlChanInitInfoTypeData, DstCtrlChan end if end if DstCtrlChanInitInfoTypeData%Requestor = SrcCtrlChanInitInfoTypeData%Requestor - else if (allocated(DstCtrlChanInitInfoTypeData%Requestor)) then - deallocate(DstCtrlChanInitInfoTypeData%Requestor) end if if (allocated(SrcCtrlChanInitInfoTypeData%InitStiff)) then LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitStiff) @@ -911,8 +895,6 @@ subroutine StC_CopyCtrlChanInitInfoType(SrcCtrlChanInitInfoTypeData, DstCtrlChan end if end if DstCtrlChanInitInfoTypeData%InitStiff = SrcCtrlChanInitInfoTypeData%InitStiff - else if (allocated(DstCtrlChanInitInfoTypeData%InitStiff)) then - deallocate(DstCtrlChanInitInfoTypeData%InitStiff) end if if (allocated(SrcCtrlChanInitInfoTypeData%InitDamp)) then LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitDamp) @@ -925,8 +907,6 @@ subroutine StC_CopyCtrlChanInitInfoType(SrcCtrlChanInitInfoTypeData, DstCtrlChan end if end if DstCtrlChanInitInfoTypeData%InitDamp = SrcCtrlChanInitInfoTypeData%InitDamp - else if (allocated(DstCtrlChanInitInfoTypeData%InitDamp)) then - deallocate(DstCtrlChanInitInfoTypeData%InitDamp) end if if (allocated(SrcCtrlChanInitInfoTypeData%InitBrake)) then LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitBrake) @@ -939,8 +919,6 @@ subroutine StC_CopyCtrlChanInitInfoType(SrcCtrlChanInitInfoTypeData, DstCtrlChan end if end if DstCtrlChanInitInfoTypeData%InitBrake = SrcCtrlChanInitInfoTypeData%InitBrake - else if (allocated(DstCtrlChanInitInfoTypeData%InitBrake)) then - deallocate(DstCtrlChanInitInfoTypeData%InitBrake) end if if (allocated(SrcCtrlChanInitInfoTypeData%InitForce)) then LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitForce) @@ -953,8 +931,6 @@ subroutine StC_CopyCtrlChanInitInfoType(SrcCtrlChanInitInfoTypeData, DstCtrlChan end if end if DstCtrlChanInitInfoTypeData%InitForce = SrcCtrlChanInitInfoTypeData%InitForce - else if (allocated(DstCtrlChanInitInfoTypeData%InitForce)) then - deallocate(DstCtrlChanInitInfoTypeData%InitForce) end if if (allocated(SrcCtrlChanInitInfoTypeData%InitMeasDisp)) then LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitMeasDisp) @@ -967,8 +943,6 @@ subroutine StC_CopyCtrlChanInitInfoType(SrcCtrlChanInitInfoTypeData, DstCtrlChan end if end if DstCtrlChanInitInfoTypeData%InitMeasDisp = SrcCtrlChanInitInfoTypeData%InitMeasDisp - else if (allocated(DstCtrlChanInitInfoTypeData%InitMeasDisp)) then - deallocate(DstCtrlChanInitInfoTypeData%InitMeasDisp) end if if (allocated(SrcCtrlChanInitInfoTypeData%InitMeasVel)) then LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitMeasVel) @@ -981,8 +955,6 @@ subroutine StC_CopyCtrlChanInitInfoType(SrcCtrlChanInitInfoTypeData, DstCtrlChan end if end if DstCtrlChanInitInfoTypeData%InitMeasVel = SrcCtrlChanInitInfoTypeData%InitMeasVel - else if (allocated(DstCtrlChanInitInfoTypeData%InitMeasVel)) then - deallocate(DstCtrlChanInitInfoTypeData%InitMeasVel) end if end subroutine @@ -1189,8 +1161,6 @@ subroutine StC_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Er end if end if DstInitOutputData%RelPosition = SrcInitOutputData%RelPosition - else if (allocated(DstInitOutputData%RelPosition)) then - deallocate(DstInitOutputData%RelPosition) end if end subroutine @@ -1265,8 +1235,6 @@ subroutine StC_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSt end if end if DstContStateData%StC_x = SrcContStateData%StC_x - else if (allocated(DstContStateData%StC_x)) then - deallocate(DstContStateData%StC_x) end if end subroutine @@ -1458,8 +1426,6 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%F_stop = SrcMiscData%F_stop - else if (allocated(DstMiscData%F_stop)) then - deallocate(DstMiscData%F_stop) end if if (allocated(SrcMiscData%F_ext)) then LB(1:2) = lbound(SrcMiscData%F_ext) @@ -1472,8 +1438,6 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%F_ext = SrcMiscData%F_ext - else if (allocated(DstMiscData%F_ext)) then - deallocate(DstMiscData%F_ext) end if if (allocated(SrcMiscData%F_fr)) then LB(1:2) = lbound(SrcMiscData%F_fr) @@ -1486,8 +1450,6 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%F_fr = SrcMiscData%F_fr - else if (allocated(DstMiscData%F_fr)) then - deallocate(DstMiscData%F_fr) end if if (allocated(SrcMiscData%K)) then LB(1:2) = lbound(SrcMiscData%K) @@ -1500,8 +1462,6 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%K = SrcMiscData%K - else if (allocated(DstMiscData%K)) then - deallocate(DstMiscData%K) end if if (allocated(SrcMiscData%C_ctrl)) then LB(1:2) = lbound(SrcMiscData%C_ctrl) @@ -1514,8 +1474,6 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%C_ctrl = SrcMiscData%C_ctrl - else if (allocated(DstMiscData%C_ctrl)) then - deallocate(DstMiscData%C_ctrl) end if if (allocated(SrcMiscData%C_Brake)) then LB(1:2) = lbound(SrcMiscData%C_Brake) @@ -1528,8 +1486,6 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%C_Brake = SrcMiscData%C_Brake - else if (allocated(DstMiscData%C_Brake)) then - deallocate(DstMiscData%C_Brake) end if if (allocated(SrcMiscData%F_table)) then LB(1:2) = lbound(SrcMiscData%F_table) @@ -1542,8 +1498,6 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%F_table = SrcMiscData%F_table - else if (allocated(DstMiscData%F_table)) then - deallocate(DstMiscData%F_table) end if if (allocated(SrcMiscData%F_k)) then LB(1:2) = lbound(SrcMiscData%F_k) @@ -1556,8 +1510,6 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%F_k = SrcMiscData%F_k - else if (allocated(DstMiscData%F_k)) then - deallocate(DstMiscData%F_k) end if if (allocated(SrcMiscData%a_G)) then LB(1:2) = lbound(SrcMiscData%a_G) @@ -1570,8 +1522,6 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%a_G = SrcMiscData%a_G - else if (allocated(DstMiscData%a_G)) then - deallocate(DstMiscData%a_G) end if if (allocated(SrcMiscData%rdisp_P)) then LB(1:2) = lbound(SrcMiscData%rdisp_P) @@ -1584,8 +1534,6 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%rdisp_P = SrcMiscData%rdisp_P - else if (allocated(DstMiscData%rdisp_P)) then - deallocate(DstMiscData%rdisp_P) end if if (allocated(SrcMiscData%rdot_P)) then LB(1:2) = lbound(SrcMiscData%rdot_P) @@ -1598,8 +1546,6 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%rdot_P = SrcMiscData%rdot_P - else if (allocated(DstMiscData%rdot_P)) then - deallocate(DstMiscData%rdot_P) end if if (allocated(SrcMiscData%rddot_P)) then LB(1:2) = lbound(SrcMiscData%rddot_P) @@ -1612,8 +1558,6 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%rddot_P = SrcMiscData%rddot_P - else if (allocated(DstMiscData%rddot_P)) then - deallocate(DstMiscData%rddot_P) end if if (allocated(SrcMiscData%omega_P)) then LB(1:2) = lbound(SrcMiscData%omega_P) @@ -1626,8 +1570,6 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%omega_P = SrcMiscData%omega_P - else if (allocated(DstMiscData%omega_P)) then - deallocate(DstMiscData%omega_P) end if if (allocated(SrcMiscData%alpha_P)) then LB(1:2) = lbound(SrcMiscData%alpha_P) @@ -1640,8 +1582,6 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%alpha_P = SrcMiscData%alpha_P - else if (allocated(DstMiscData%alpha_P)) then - deallocate(DstMiscData%alpha_P) end if if (allocated(SrcMiscData%F_P)) then LB(1:2) = lbound(SrcMiscData%F_P) @@ -1654,8 +1594,6 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%F_P = SrcMiscData%F_P - else if (allocated(DstMiscData%F_P)) then - deallocate(DstMiscData%F_P) end if if (allocated(SrcMiscData%M_P)) then LB(1:2) = lbound(SrcMiscData%M_P) @@ -1668,8 +1606,6 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%M_P = SrcMiscData%M_P - else if (allocated(DstMiscData%M_P)) then - deallocate(DstMiscData%M_P) end if if (allocated(SrcMiscData%Acc)) then LB(1:2) = lbound(SrcMiscData%Acc) @@ -1682,8 +1618,6 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%Acc = SrcMiscData%Acc - else if (allocated(DstMiscData%Acc)) then - deallocate(DstMiscData%Acc) end if DstMiscData%PrescribedInterpIdx = SrcMiscData%PrescribedInterpIdx end subroutine @@ -2160,8 +2094,6 @@ subroutine StC_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%F_TBL = SrcParamData%F_TBL - else if (allocated(DstParamData%F_TBL)) then - deallocate(DstParamData%F_TBL) end if DstParamData%NumMeshPts = SrcParamData%NumMeshPts DstParamData%PrescribedForcesCoordSys = SrcParamData%PrescribedForcesCoordSys @@ -2176,8 +2108,6 @@ subroutine StC_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%StC_PrescribedForce = SrcParamData%StC_PrescribedForce - else if (allocated(DstParamData%StC_PrescribedForce)) then - deallocate(DstParamData%StC_PrescribedForce) end if if (allocated(SrcParamData%StC_CChan)) then LB(1:1) = lbound(SrcParamData%StC_CChan) @@ -2190,8 +2120,6 @@ subroutine StC_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%StC_CChan = SrcParamData%StC_CChan - else if (allocated(DstParamData%StC_CChan)) then - deallocate(DstParamData%StC_CChan) end if end subroutine @@ -2460,8 +2388,6 @@ subroutine StC_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstInputData%Mesh)) then - deallocate(DstInputData%Mesh) end if if (allocated(SrcInputData%CmdStiff)) then LB(1:2) = lbound(SrcInputData%CmdStiff) @@ -2474,8 +2400,6 @@ subroutine StC_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%CmdStiff = SrcInputData%CmdStiff - else if (allocated(DstInputData%CmdStiff)) then - deallocate(DstInputData%CmdStiff) end if if (allocated(SrcInputData%CmdDamp)) then LB(1:2) = lbound(SrcInputData%CmdDamp) @@ -2488,8 +2412,6 @@ subroutine StC_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%CmdDamp = SrcInputData%CmdDamp - else if (allocated(DstInputData%CmdDamp)) then - deallocate(DstInputData%CmdDamp) end if if (allocated(SrcInputData%CmdBrake)) then LB(1:2) = lbound(SrcInputData%CmdBrake) @@ -2502,8 +2424,6 @@ subroutine StC_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%CmdBrake = SrcInputData%CmdBrake - else if (allocated(DstInputData%CmdBrake)) then - deallocate(DstInputData%CmdBrake) end if if (allocated(SrcInputData%CmdForce)) then LB(1:2) = lbound(SrcInputData%CmdForce) @@ -2516,8 +2436,6 @@ subroutine StC_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%CmdForce = SrcInputData%CmdForce - else if (allocated(DstInputData%CmdForce)) then - deallocate(DstInputData%CmdForce) end if end subroutine @@ -2704,8 +2622,6 @@ subroutine StC_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstOutputData%Mesh)) then - deallocate(DstOutputData%Mesh) end if if (allocated(SrcOutputData%MeasDisp)) then LB(1:2) = lbound(SrcOutputData%MeasDisp) @@ -2718,8 +2634,6 @@ subroutine StC_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs end if end if DstOutputData%MeasDisp = SrcOutputData%MeasDisp - else if (allocated(DstOutputData%MeasDisp)) then - deallocate(DstOutputData%MeasDisp) end if if (allocated(SrcOutputData%MeasVel)) then LB(1:2) = lbound(SrcOutputData%MeasVel) @@ -2732,8 +2646,6 @@ subroutine StC_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs end if end if DstOutputData%MeasVel = SrcOutputData%MeasVel - else if (allocated(DstOutputData%MeasVel)) then - deallocate(DstOutputData%MeasVel) end if end subroutine diff --git a/modules/subdyn/src/SubDyn_Types.f90 b/modules/subdyn/src/SubDyn_Types.f90 index f4550aba01..6fc2a930a0 100644 --- a/modules/subdyn/src/SubDyn_Types.f90 +++ b/modules/subdyn/src/SubDyn_Types.f90 @@ -365,8 +365,6 @@ subroutine SD_CopyIList(SrcIListData, DstIListData, CtrlCode, ErrStat, ErrMsg) end if end if DstIListData%List = SrcIListData%List - else if (allocated(DstIListData%List)) then - deallocate(DstIListData%List) end if end subroutine @@ -443,8 +441,6 @@ subroutine SD_CopyMeshAuxDataType(SrcMeshAuxDataTypeData, DstMeshAuxDataTypeData end if end if DstMeshAuxDataTypeData%NodeCnt = SrcMeshAuxDataTypeData%NodeCnt - else if (allocated(DstMeshAuxDataTypeData%NodeCnt)) then - deallocate(DstMeshAuxDataTypeData%NodeCnt) end if if (allocated(SrcMeshAuxDataTypeData%NodeIDs)) then LB(1:1) = lbound(SrcMeshAuxDataTypeData%NodeIDs) @@ -457,8 +453,6 @@ subroutine SD_CopyMeshAuxDataType(SrcMeshAuxDataTypeData, DstMeshAuxDataTypeData end if end if DstMeshAuxDataTypeData%NodeIDs = SrcMeshAuxDataTypeData%NodeIDs - else if (allocated(DstMeshAuxDataTypeData%NodeIDs)) then - deallocate(DstMeshAuxDataTypeData%NodeIDs) end if if (allocated(SrcMeshAuxDataTypeData%ElmIDs)) then LB(1:2) = lbound(SrcMeshAuxDataTypeData%ElmIDs) @@ -471,8 +465,6 @@ subroutine SD_CopyMeshAuxDataType(SrcMeshAuxDataTypeData, DstMeshAuxDataTypeData end if end if DstMeshAuxDataTypeData%ElmIDs = SrcMeshAuxDataTypeData%ElmIDs - else if (allocated(DstMeshAuxDataTypeData%ElmIDs)) then - deallocate(DstMeshAuxDataTypeData%ElmIDs) end if if (allocated(SrcMeshAuxDataTypeData%ElmNds)) then LB(1:2) = lbound(SrcMeshAuxDataTypeData%ElmNds) @@ -485,8 +477,6 @@ subroutine SD_CopyMeshAuxDataType(SrcMeshAuxDataTypeData, DstMeshAuxDataTypeData end if end if DstMeshAuxDataTypeData%ElmNds = SrcMeshAuxDataTypeData%ElmNds - else if (allocated(DstMeshAuxDataTypeData%ElmNds)) then - deallocate(DstMeshAuxDataTypeData%ElmNds) end if if (allocated(SrcMeshAuxDataTypeData%Me)) then LB(1:4) = lbound(SrcMeshAuxDataTypeData%Me) @@ -499,8 +489,6 @@ subroutine SD_CopyMeshAuxDataType(SrcMeshAuxDataTypeData, DstMeshAuxDataTypeData end if end if DstMeshAuxDataTypeData%Me = SrcMeshAuxDataTypeData%Me - else if (allocated(DstMeshAuxDataTypeData%Me)) then - deallocate(DstMeshAuxDataTypeData%Me) end if if (allocated(SrcMeshAuxDataTypeData%Ke)) then LB(1:4) = lbound(SrcMeshAuxDataTypeData%Ke) @@ -513,8 +501,6 @@ subroutine SD_CopyMeshAuxDataType(SrcMeshAuxDataTypeData, DstMeshAuxDataTypeData end if end if DstMeshAuxDataTypeData%Ke = SrcMeshAuxDataTypeData%Ke - else if (allocated(DstMeshAuxDataTypeData%Ke)) then - deallocate(DstMeshAuxDataTypeData%Ke) end if if (allocated(SrcMeshAuxDataTypeData%Fg)) then LB(1:3) = lbound(SrcMeshAuxDataTypeData%Fg) @@ -527,8 +513,6 @@ subroutine SD_CopyMeshAuxDataType(SrcMeshAuxDataTypeData, DstMeshAuxDataTypeData end if end if DstMeshAuxDataTypeData%Fg = SrcMeshAuxDataTypeData%Fg - else if (allocated(DstMeshAuxDataTypeData%Fg)) then - deallocate(DstMeshAuxDataTypeData%Fg) end if end subroutine @@ -741,8 +725,6 @@ subroutine SD_CopyCB_MatArrays(SrcCB_MatArraysData, DstCB_MatArraysData, CtrlCod end if end if DstCB_MatArraysData%MBB = SrcCB_MatArraysData%MBB - else if (allocated(DstCB_MatArraysData%MBB)) then - deallocate(DstCB_MatArraysData%MBB) end if if (allocated(SrcCB_MatArraysData%MBM)) then LB(1:2) = lbound(SrcCB_MatArraysData%MBM) @@ -755,8 +737,6 @@ subroutine SD_CopyCB_MatArrays(SrcCB_MatArraysData, DstCB_MatArraysData, CtrlCod end if end if DstCB_MatArraysData%MBM = SrcCB_MatArraysData%MBM - else if (allocated(DstCB_MatArraysData%MBM)) then - deallocate(DstCB_MatArraysData%MBM) end if if (allocated(SrcCB_MatArraysData%KBB)) then LB(1:2) = lbound(SrcCB_MatArraysData%KBB) @@ -769,8 +749,6 @@ subroutine SD_CopyCB_MatArrays(SrcCB_MatArraysData, DstCB_MatArraysData, CtrlCod end if end if DstCB_MatArraysData%KBB = SrcCB_MatArraysData%KBB - else if (allocated(DstCB_MatArraysData%KBB)) then - deallocate(DstCB_MatArraysData%KBB) end if if (allocated(SrcCB_MatArraysData%PhiL)) then LB(1:2) = lbound(SrcCB_MatArraysData%PhiL) @@ -783,8 +761,6 @@ subroutine SD_CopyCB_MatArrays(SrcCB_MatArraysData, DstCB_MatArraysData, CtrlCod end if end if DstCB_MatArraysData%PhiL = SrcCB_MatArraysData%PhiL - else if (allocated(DstCB_MatArraysData%PhiL)) then - deallocate(DstCB_MatArraysData%PhiL) end if if (allocated(SrcCB_MatArraysData%PhiR)) then LB(1:2) = lbound(SrcCB_MatArraysData%PhiR) @@ -797,8 +773,6 @@ subroutine SD_CopyCB_MatArrays(SrcCB_MatArraysData, DstCB_MatArraysData, CtrlCod end if end if DstCB_MatArraysData%PhiR = SrcCB_MatArraysData%PhiR - else if (allocated(DstCB_MatArraysData%PhiR)) then - deallocate(DstCB_MatArraysData%PhiR) end if if (allocated(SrcCB_MatArraysData%OmegaL)) then LB(1:1) = lbound(SrcCB_MatArraysData%OmegaL) @@ -811,8 +785,6 @@ subroutine SD_CopyCB_MatArrays(SrcCB_MatArraysData, DstCB_MatArraysData, CtrlCod end if end if DstCB_MatArraysData%OmegaL = SrcCB_MatArraysData%OmegaL - else if (allocated(DstCB_MatArraysData%OmegaL)) then - deallocate(DstCB_MatArraysData%OmegaL) end if end subroutine @@ -1099,8 +1071,6 @@ subroutine SD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta end if end if DstInitInputData%SoilStiffness = SrcInitInputData%SoilStiffness - else if (allocated(DstInitInputData%SoilStiffness)) then - deallocate(DstInitInputData%SoilStiffness) end if call MeshCopy(SrcInitInputData%SoilMesh, DstInitInputData%SoilMesh, CtrlCode, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1207,8 +1177,6 @@ subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr - else if (allocated(DstInitOutputData%WriteOutputHdr)) then - deallocate(DstInitOutputData%WriteOutputHdr) end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) @@ -1221,8 +1189,6 @@ subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt - else if (allocated(DstInitOutputData%WriteOutputUnt)) then - deallocate(DstInitOutputData%WriteOutputUnt) end if call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1238,8 +1204,6 @@ subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y - else if (allocated(DstInitOutputData%LinNames_y)) then - deallocate(DstInitOutputData%LinNames_y) end if if (allocated(SrcInitOutputData%LinNames_x)) then LB(1:1) = lbound(SrcInitOutputData%LinNames_x) @@ -1252,8 +1216,6 @@ subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x - else if (allocated(DstInitOutputData%LinNames_x)) then - deallocate(DstInitOutputData%LinNames_x) end if if (allocated(SrcInitOutputData%LinNames_u)) then LB(1:1) = lbound(SrcInitOutputData%LinNames_u) @@ -1266,8 +1228,6 @@ subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u - else if (allocated(DstInitOutputData%LinNames_u)) then - deallocate(DstInitOutputData%LinNames_u) end if if (allocated(SrcInitOutputData%RotFrame_y)) then LB(1:1) = lbound(SrcInitOutputData%RotFrame_y) @@ -1280,8 +1240,6 @@ subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y - else if (allocated(DstInitOutputData%RotFrame_y)) then - deallocate(DstInitOutputData%RotFrame_y) end if if (allocated(SrcInitOutputData%RotFrame_x)) then LB(1:1) = lbound(SrcInitOutputData%RotFrame_x) @@ -1294,8 +1252,6 @@ subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x - else if (allocated(DstInitOutputData%RotFrame_x)) then - deallocate(DstInitOutputData%RotFrame_x) end if if (allocated(SrcInitOutputData%RotFrame_u)) then LB(1:1) = lbound(SrcInitOutputData%RotFrame_u) @@ -1308,8 +1264,6 @@ subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u - else if (allocated(DstInitOutputData%RotFrame_u)) then - deallocate(DstInitOutputData%RotFrame_u) end if if (allocated(SrcInitOutputData%IsLoad_u)) then LB(1:1) = lbound(SrcInitOutputData%IsLoad_u) @@ -1322,8 +1276,6 @@ subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u - else if (allocated(DstInitOutputData%IsLoad_u)) then - deallocate(DstInitOutputData%IsLoad_u) end if if (allocated(SrcInitOutputData%DerivOrder_x)) then LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) @@ -1336,8 +1288,6 @@ subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x - else if (allocated(DstInitOutputData%DerivOrder_x)) then - deallocate(DstInitOutputData%DerivOrder_x) end if if (allocated(SrcInitOutputData%CableCChanRqst)) then LB(1:1) = lbound(SrcInitOutputData%CableCChanRqst) @@ -1350,8 +1300,6 @@ subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%CableCChanRqst = SrcInitOutputData%CableCChanRqst - else if (allocated(DstInitOutputData%CableCChanRqst)) then - deallocate(DstInitOutputData%CableCChanRqst) end if end subroutine @@ -1667,8 +1615,6 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, end if end if DstInitTypeData%Joints = SrcInitTypeData%Joints - else if (allocated(DstInitTypeData%Joints)) then - deallocate(DstInitTypeData%Joints) end if if (allocated(SrcInitTypeData%PropSetsB)) then LB(1:2) = lbound(SrcInitTypeData%PropSetsB) @@ -1681,8 +1627,6 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, end if end if DstInitTypeData%PropSetsB = SrcInitTypeData%PropSetsB - else if (allocated(DstInitTypeData%PropSetsB)) then - deallocate(DstInitTypeData%PropSetsB) end if if (allocated(SrcInitTypeData%PropSetsC)) then LB(1:2) = lbound(SrcInitTypeData%PropSetsC) @@ -1695,8 +1639,6 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, end if end if DstInitTypeData%PropSetsC = SrcInitTypeData%PropSetsC - else if (allocated(DstInitTypeData%PropSetsC)) then - deallocate(DstInitTypeData%PropSetsC) end if if (allocated(SrcInitTypeData%PropSetsR)) then LB(1:2) = lbound(SrcInitTypeData%PropSetsR) @@ -1709,8 +1651,6 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, end if end if DstInitTypeData%PropSetsR = SrcInitTypeData%PropSetsR - else if (allocated(DstInitTypeData%PropSetsR)) then - deallocate(DstInitTypeData%PropSetsR) end if if (allocated(SrcInitTypeData%PropSetsX)) then LB(1:2) = lbound(SrcInitTypeData%PropSetsX) @@ -1723,8 +1663,6 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, end if end if DstInitTypeData%PropSetsX = SrcInitTypeData%PropSetsX - else if (allocated(DstInitTypeData%PropSetsX)) then - deallocate(DstInitTypeData%PropSetsX) end if if (allocated(SrcInitTypeData%COSMs)) then LB(1:2) = lbound(SrcInitTypeData%COSMs) @@ -1737,8 +1675,6 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, end if end if DstInitTypeData%COSMs = SrcInitTypeData%COSMs - else if (allocated(DstInitTypeData%COSMs)) then - deallocate(DstInitTypeData%COSMs) end if if (allocated(SrcInitTypeData%CMass)) then LB(1:2) = lbound(SrcInitTypeData%CMass) @@ -1751,8 +1687,6 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, end if end if DstInitTypeData%CMass = SrcInitTypeData%CMass - else if (allocated(DstInitTypeData%CMass)) then - deallocate(DstInitTypeData%CMass) end if if (allocated(SrcInitTypeData%JDampings)) then LB(1:1) = lbound(SrcInitTypeData%JDampings) @@ -1765,8 +1699,6 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, end if end if DstInitTypeData%JDampings = SrcInitTypeData%JDampings - else if (allocated(DstInitTypeData%JDampings)) then - deallocate(DstInitTypeData%JDampings) end if DstInitTypeData%GuyanDampMod = SrcInitTypeData%GuyanDampMod DstInitTypeData%RayleighDamp = SrcInitTypeData%RayleighDamp @@ -1782,8 +1714,6 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, end if end if DstInitTypeData%Members = SrcInitTypeData%Members - else if (allocated(DstInitTypeData%Members)) then - deallocate(DstInitTypeData%Members) end if if (allocated(SrcInitTypeData%SSOutList)) then LB(1:1) = lbound(SrcInitTypeData%SSOutList) @@ -1796,8 +1726,6 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, end if end if DstInitTypeData%SSOutList = SrcInitTypeData%SSOutList - else if (allocated(DstInitTypeData%SSOutList)) then - deallocate(DstInitTypeData%SSOutList) end if DstInitTypeData%OutCOSM = SrcInitTypeData%OutCOSM DstInitTypeData%TabDelim = SrcInitTypeData%TabDelim @@ -1812,8 +1740,6 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, end if end if DstInitTypeData%SSIK = SrcInitTypeData%SSIK - else if (allocated(DstInitTypeData%SSIK)) then - deallocate(DstInitTypeData%SSIK) end if if (allocated(SrcInitTypeData%SSIM)) then LB(1:2) = lbound(SrcInitTypeData%SSIM) @@ -1826,8 +1752,6 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, end if end if DstInitTypeData%SSIM = SrcInitTypeData%SSIM - else if (allocated(DstInitTypeData%SSIM)) then - deallocate(DstInitTypeData%SSIM) end if if (allocated(SrcInitTypeData%SSIfile)) then LB(1:1) = lbound(SrcInitTypeData%SSIfile) @@ -1840,8 +1764,6 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, end if end if DstInitTypeData%SSIfile = SrcInitTypeData%SSIfile - else if (allocated(DstInitTypeData%SSIfile)) then - deallocate(DstInitTypeData%SSIfile) end if if (allocated(SrcInitTypeData%Soil_K)) then LB(1:3) = lbound(SrcInitTypeData%Soil_K) @@ -1854,8 +1776,6 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, end if end if DstInitTypeData%Soil_K = SrcInitTypeData%Soil_K - else if (allocated(DstInitTypeData%Soil_K)) then - deallocate(DstInitTypeData%Soil_K) end if if (allocated(SrcInitTypeData%Soil_Points)) then LB(1:2) = lbound(SrcInitTypeData%Soil_Points) @@ -1868,8 +1788,6 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, end if end if DstInitTypeData%Soil_Points = SrcInitTypeData%Soil_Points - else if (allocated(DstInitTypeData%Soil_Points)) then - deallocate(DstInitTypeData%Soil_Points) end if if (allocated(SrcInitTypeData%Soil_Nodes)) then LB(1:1) = lbound(SrcInitTypeData%Soil_Nodes) @@ -1882,8 +1800,6 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, end if end if DstInitTypeData%Soil_Nodes = SrcInitTypeData%Soil_Nodes - else if (allocated(DstInitTypeData%Soil_Nodes)) then - deallocate(DstInitTypeData%Soil_Nodes) end if DstInitTypeData%NElem = SrcInitTypeData%NElem DstInitTypeData%NPropB = SrcInitTypeData%NPropB @@ -1900,8 +1816,6 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, end if end if DstInitTypeData%Nodes = SrcInitTypeData%Nodes - else if (allocated(DstInitTypeData%Nodes)) then - deallocate(DstInitTypeData%Nodes) end if if (allocated(SrcInitTypeData%PropsB)) then LB(1:2) = lbound(SrcInitTypeData%PropsB) @@ -1914,8 +1828,6 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, end if end if DstInitTypeData%PropsB = SrcInitTypeData%PropsB - else if (allocated(DstInitTypeData%PropsB)) then - deallocate(DstInitTypeData%PropsB) end if if (allocated(SrcInitTypeData%PropsC)) then LB(1:2) = lbound(SrcInitTypeData%PropsC) @@ -1928,8 +1840,6 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, end if end if DstInitTypeData%PropsC = SrcInitTypeData%PropsC - else if (allocated(DstInitTypeData%PropsC)) then - deallocate(DstInitTypeData%PropsC) end if if (allocated(SrcInitTypeData%PropsR)) then LB(1:2) = lbound(SrcInitTypeData%PropsR) @@ -1942,8 +1852,6 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, end if end if DstInitTypeData%PropsR = SrcInitTypeData%PropsR - else if (allocated(DstInitTypeData%PropsR)) then - deallocate(DstInitTypeData%PropsR) end if if (allocated(SrcInitTypeData%K)) then LB(1:2) = lbound(SrcInitTypeData%K) @@ -1956,8 +1864,6 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, end if end if DstInitTypeData%K = SrcInitTypeData%K - else if (allocated(DstInitTypeData%K)) then - deallocate(DstInitTypeData%K) end if if (allocated(SrcInitTypeData%M)) then LB(1:2) = lbound(SrcInitTypeData%M) @@ -1970,8 +1876,6 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, end if end if DstInitTypeData%M = SrcInitTypeData%M - else if (allocated(DstInitTypeData%M)) then - deallocate(DstInitTypeData%M) end if if (allocated(SrcInitTypeData%ElemProps)) then LB(1:2) = lbound(SrcInitTypeData%ElemProps) @@ -1984,8 +1888,6 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, end if end if DstInitTypeData%ElemProps = SrcInitTypeData%ElemProps - else if (allocated(DstInitTypeData%ElemProps)) then - deallocate(DstInitTypeData%ElemProps) end if if (allocated(SrcInitTypeData%MemberNodes)) then LB(1:2) = lbound(SrcInitTypeData%MemberNodes) @@ -1998,8 +1900,6 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, end if end if DstInitTypeData%MemberNodes = SrcInitTypeData%MemberNodes - else if (allocated(DstInitTypeData%MemberNodes)) then - deallocate(DstInitTypeData%MemberNodes) end if if (allocated(SrcInitTypeData%NodesConnN)) then LB(1:2) = lbound(SrcInitTypeData%NodesConnN) @@ -2012,8 +1912,6 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, end if end if DstInitTypeData%NodesConnN = SrcInitTypeData%NodesConnN - else if (allocated(DstInitTypeData%NodesConnN)) then - deallocate(DstInitTypeData%NodesConnN) end if if (allocated(SrcInitTypeData%NodesConnE)) then LB(1:2) = lbound(SrcInitTypeData%NodesConnE) @@ -2026,8 +1924,6 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, end if end if DstInitTypeData%NodesConnE = SrcInitTypeData%NodesConnE - else if (allocated(DstInitTypeData%NodesConnE)) then - deallocate(DstInitTypeData%NodesConnE) end if DstInitTypeData%SSSum = SrcInitTypeData%SSSum end subroutine @@ -2728,8 +2624,6 @@ subroutine SD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSta end if end if DstContStateData%qm = SrcContStateData%qm - else if (allocated(DstContStateData%qm)) then - deallocate(DstContStateData%qm) end if if (allocated(SrcContStateData%qmdot)) then LB(1:1) = lbound(SrcContStateData%qmdot) @@ -2742,8 +2636,6 @@ subroutine SD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSta end if end if DstContStateData%qmdot = SrcContStateData%qmdot - else if (allocated(DstContStateData%qmdot)) then - deallocate(DstContStateData%qmdot) end if end subroutine @@ -2924,8 +2816,6 @@ subroutine SD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstOtherStateData%xdot)) then - deallocate(DstOtherStateData%xdot) end if DstOtherStateData%n = SrcOtherStateData%n end subroutine @@ -3022,8 +2912,6 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%qmdotdot = SrcMiscData%qmdotdot - else if (allocated(DstMiscData%qmdotdot)) then - deallocate(DstMiscData%qmdotdot) end if DstMiscData%u_TP = SrcMiscData%u_TP DstMiscData%udot_TP = SrcMiscData%udot_TP @@ -3039,8 +2927,6 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%F_L = SrcMiscData%F_L - else if (allocated(DstMiscData%F_L)) then - deallocate(DstMiscData%F_L) end if if (allocated(SrcMiscData%F_L2)) then LB(1:1) = lbound(SrcMiscData%F_L2) @@ -3053,8 +2939,6 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%F_L2 = SrcMiscData%F_L2 - else if (allocated(DstMiscData%F_L2)) then - deallocate(DstMiscData%F_L2) end if if (allocated(SrcMiscData%UR_bar)) then LB(1:1) = lbound(SrcMiscData%UR_bar) @@ -3067,8 +2951,6 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%UR_bar = SrcMiscData%UR_bar - else if (allocated(DstMiscData%UR_bar)) then - deallocate(DstMiscData%UR_bar) end if if (allocated(SrcMiscData%UR_bar_dot)) then LB(1:1) = lbound(SrcMiscData%UR_bar_dot) @@ -3081,8 +2963,6 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%UR_bar_dot = SrcMiscData%UR_bar_dot - else if (allocated(DstMiscData%UR_bar_dot)) then - deallocate(DstMiscData%UR_bar_dot) end if if (allocated(SrcMiscData%UR_bar_dotdot)) then LB(1:1) = lbound(SrcMiscData%UR_bar_dotdot) @@ -3095,8 +2975,6 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%UR_bar_dotdot = SrcMiscData%UR_bar_dotdot - else if (allocated(DstMiscData%UR_bar_dotdot)) then - deallocate(DstMiscData%UR_bar_dotdot) end if if (allocated(SrcMiscData%UL)) then LB(1:1) = lbound(SrcMiscData%UL) @@ -3109,8 +2987,6 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%UL = SrcMiscData%UL - else if (allocated(DstMiscData%UL)) then - deallocate(DstMiscData%UL) end if if (allocated(SrcMiscData%UL_NS)) then LB(1:1) = lbound(SrcMiscData%UL_NS) @@ -3123,8 +2999,6 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%UL_NS = SrcMiscData%UL_NS - else if (allocated(DstMiscData%UL_NS)) then - deallocate(DstMiscData%UL_NS) end if if (allocated(SrcMiscData%UL_dot)) then LB(1:1) = lbound(SrcMiscData%UL_dot) @@ -3137,8 +3011,6 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%UL_dot = SrcMiscData%UL_dot - else if (allocated(DstMiscData%UL_dot)) then - deallocate(DstMiscData%UL_dot) end if if (allocated(SrcMiscData%UL_dotdot)) then LB(1:1) = lbound(SrcMiscData%UL_dotdot) @@ -3151,8 +3023,6 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%UL_dotdot = SrcMiscData%UL_dotdot - else if (allocated(DstMiscData%UL_dotdot)) then - deallocate(DstMiscData%UL_dotdot) end if if (allocated(SrcMiscData%DU_full)) then LB(1:1) = lbound(SrcMiscData%DU_full) @@ -3165,8 +3035,6 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%DU_full = SrcMiscData%DU_full - else if (allocated(DstMiscData%DU_full)) then - deallocate(DstMiscData%DU_full) end if if (allocated(SrcMiscData%U_full)) then LB(1:1) = lbound(SrcMiscData%U_full) @@ -3179,8 +3047,6 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%U_full = SrcMiscData%U_full - else if (allocated(DstMiscData%U_full)) then - deallocate(DstMiscData%U_full) end if if (allocated(SrcMiscData%U_full_NS)) then LB(1:1) = lbound(SrcMiscData%U_full_NS) @@ -3193,8 +3059,6 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%U_full_NS = SrcMiscData%U_full_NS - else if (allocated(DstMiscData%U_full_NS)) then - deallocate(DstMiscData%U_full_NS) end if if (allocated(SrcMiscData%U_full_dot)) then LB(1:1) = lbound(SrcMiscData%U_full_dot) @@ -3207,8 +3071,6 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%U_full_dot = SrcMiscData%U_full_dot - else if (allocated(DstMiscData%U_full_dot)) then - deallocate(DstMiscData%U_full_dot) end if if (allocated(SrcMiscData%U_full_dotdot)) then LB(1:1) = lbound(SrcMiscData%U_full_dotdot) @@ -3221,8 +3083,6 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%U_full_dotdot = SrcMiscData%U_full_dotdot - else if (allocated(DstMiscData%U_full_dotdot)) then - deallocate(DstMiscData%U_full_dotdot) end if if (allocated(SrcMiscData%U_full_elast)) then LB(1:1) = lbound(SrcMiscData%U_full_elast) @@ -3235,8 +3095,6 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%U_full_elast = SrcMiscData%U_full_elast - else if (allocated(DstMiscData%U_full_elast)) then - deallocate(DstMiscData%U_full_elast) end if if (allocated(SrcMiscData%U_red)) then LB(1:1) = lbound(SrcMiscData%U_red) @@ -3249,8 +3107,6 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%U_red = SrcMiscData%U_red - else if (allocated(DstMiscData%U_red)) then - deallocate(DstMiscData%U_red) end if if (allocated(SrcMiscData%FC_unit)) then LB(1:1) = lbound(SrcMiscData%FC_unit) @@ -3263,8 +3119,6 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%FC_unit = SrcMiscData%FC_unit - else if (allocated(DstMiscData%FC_unit)) then - deallocate(DstMiscData%FC_unit) end if if (allocated(SrcMiscData%SDWrOutput)) then LB(1:1) = lbound(SrcMiscData%SDWrOutput) @@ -3277,8 +3131,6 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%SDWrOutput = SrcMiscData%SDWrOutput - else if (allocated(DstMiscData%SDWrOutput)) then - deallocate(DstMiscData%SDWrOutput) end if if (allocated(SrcMiscData%AllOuts)) then LB(1:1) = lbound(SrcMiscData%AllOuts) @@ -3291,8 +3143,6 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%AllOuts = SrcMiscData%AllOuts - else if (allocated(DstMiscData%AllOuts)) then - deallocate(DstMiscData%AllOuts) end if DstMiscData%LastOutTime = SrcMiscData%LastOutTime DstMiscData%Decimat = SrcMiscData%Decimat @@ -3307,8 +3157,6 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%Fext = SrcMiscData%Fext - else if (allocated(DstMiscData%Fext)) then - deallocate(DstMiscData%Fext) end if if (allocated(SrcMiscData%Fext_red)) then LB(1:1) = lbound(SrcMiscData%Fext_red) @@ -3321,8 +3169,6 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%Fext_red = SrcMiscData%Fext_red - else if (allocated(DstMiscData%Fext_red)) then - deallocate(DstMiscData%Fext_red) end if if (allocated(SrcMiscData%UL_SIM)) then LB(1:1) = lbound(SrcMiscData%UL_SIM) @@ -3335,8 +3181,6 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%UL_SIM = SrcMiscData%UL_SIM - else if (allocated(DstMiscData%UL_SIM)) then - deallocate(DstMiscData%UL_SIM) end if if (allocated(SrcMiscData%UL_0m)) then LB(1:1) = lbound(SrcMiscData%UL_0m) @@ -3349,8 +3193,6 @@ subroutine SD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%UL_0m = SrcMiscData%UL_0m - else if (allocated(DstMiscData%UL_0m)) then - deallocate(DstMiscData%UL_0m) end if end subroutine @@ -3953,8 +3795,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%Elems = SrcParamData%Elems - else if (allocated(DstParamData%Elems)) then - deallocate(DstParamData%Elems) end if if (allocated(SrcParamData%ElemProps)) then LB(1:1) = lbound(SrcParamData%ElemProps) @@ -3971,8 +3811,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstParamData%ElemProps)) then - deallocate(DstParamData%ElemProps) end if if (allocated(SrcParamData%FG)) then LB(1:1) = lbound(SrcParamData%FG) @@ -3985,8 +3823,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%FG = SrcParamData%FG - else if (allocated(DstParamData%FG)) then - deallocate(DstParamData%FG) end if if (allocated(SrcParamData%DP0)) then LB(1:2) = lbound(SrcParamData%DP0) @@ -3999,8 +3835,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%DP0 = SrcParamData%DP0 - else if (allocated(DstParamData%DP0)) then - deallocate(DstParamData%DP0) end if if (allocated(SrcParamData%NodeID2JointID)) then LB(1:1) = lbound(SrcParamData%NodeID2JointID) @@ -4013,8 +3847,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%NodeID2JointID = SrcParamData%NodeID2JointID - else if (allocated(DstParamData%NodeID2JointID)) then - deallocate(DstParamData%NodeID2JointID) end if DstParamData%reduced = SrcParamData%reduced if (allocated(SrcParamData%T_red)) then @@ -4028,8 +3860,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%T_red = SrcParamData%T_red - else if (allocated(DstParamData%T_red)) then - deallocate(DstParamData%T_red) end if if (allocated(SrcParamData%T_red_T)) then LB(1:2) = lbound(SrcParamData%T_red_T) @@ -4042,8 +3872,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%T_red_T = SrcParamData%T_red_T - else if (allocated(DstParamData%T_red_T)) then - deallocate(DstParamData%T_red_T) end if if (allocated(SrcParamData%NodesDOF)) then LB(1:1) = lbound(SrcParamData%NodesDOF) @@ -4060,8 +3888,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstParamData%NodesDOF)) then - deallocate(DstParamData%NodesDOF) end if if (allocated(SrcParamData%NodesDOFred)) then LB(1:1) = lbound(SrcParamData%NodesDOFred) @@ -4078,8 +3904,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstParamData%NodesDOFred)) then - deallocate(DstParamData%NodesDOFred) end if if (allocated(SrcParamData%ElemsDOF)) then LB(1:2) = lbound(SrcParamData%ElemsDOF) @@ -4092,8 +3916,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%ElemsDOF = SrcParamData%ElemsDOF - else if (allocated(DstParamData%ElemsDOF)) then - deallocate(DstParamData%ElemsDOF) end if if (allocated(SrcParamData%DOFred2Nodes)) then LB(1:2) = lbound(SrcParamData%DOFred2Nodes) @@ -4106,8 +3928,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%DOFred2Nodes = SrcParamData%DOFred2Nodes - else if (allocated(DstParamData%DOFred2Nodes)) then - deallocate(DstParamData%DOFred2Nodes) end if if (allocated(SrcParamData%CtrlElem2Channel)) then LB(1:2) = lbound(SrcParamData%CtrlElem2Channel) @@ -4120,8 +3940,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%CtrlElem2Channel = SrcParamData%CtrlElem2Channel - else if (allocated(DstParamData%CtrlElem2Channel)) then - deallocate(DstParamData%CtrlElem2Channel) end if DstParamData%nDOFM = SrcParamData%nDOFM DstParamData%SttcSolve = SrcParamData%SttcSolve @@ -4138,8 +3956,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%KMMDiag = SrcParamData%KMMDiag - else if (allocated(DstParamData%KMMDiag)) then - deallocate(DstParamData%KMMDiag) end if if (allocated(SrcParamData%CMMDiag)) then LB(1:1) = lbound(SrcParamData%CMMDiag) @@ -4152,8 +3968,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%CMMDiag = SrcParamData%CMMDiag - else if (allocated(DstParamData%CMMDiag)) then - deallocate(DstParamData%CMMDiag) end if if (allocated(SrcParamData%MMB)) then LB(1:2) = lbound(SrcParamData%MMB) @@ -4166,8 +3980,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%MMB = SrcParamData%MMB - else if (allocated(DstParamData%MMB)) then - deallocate(DstParamData%MMB) end if if (allocated(SrcParamData%MBmmB)) then LB(1:2) = lbound(SrcParamData%MBmmB) @@ -4180,8 +3992,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%MBmmB = SrcParamData%MBmmB - else if (allocated(DstParamData%MBmmB)) then - deallocate(DstParamData%MBmmB) end if if (allocated(SrcParamData%C1_11)) then LB(1:2) = lbound(SrcParamData%C1_11) @@ -4194,8 +4004,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%C1_11 = SrcParamData%C1_11 - else if (allocated(DstParamData%C1_11)) then - deallocate(DstParamData%C1_11) end if if (allocated(SrcParamData%C1_12)) then LB(1:2) = lbound(SrcParamData%C1_12) @@ -4208,8 +4016,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%C1_12 = SrcParamData%C1_12 - else if (allocated(DstParamData%C1_12)) then - deallocate(DstParamData%C1_12) end if if (allocated(SrcParamData%D1_141)) then LB(1:2) = lbound(SrcParamData%D1_141) @@ -4222,8 +4028,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%D1_141 = SrcParamData%D1_141 - else if (allocated(DstParamData%D1_141)) then - deallocate(DstParamData%D1_141) end if if (allocated(SrcParamData%D1_142)) then LB(1:2) = lbound(SrcParamData%D1_142) @@ -4236,8 +4040,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%D1_142 = SrcParamData%D1_142 - else if (allocated(DstParamData%D1_142)) then - deallocate(DstParamData%D1_142) end if if (allocated(SrcParamData%PhiM)) then LB(1:2) = lbound(SrcParamData%PhiM) @@ -4250,8 +4052,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%PhiM = SrcParamData%PhiM - else if (allocated(DstParamData%PhiM)) then - deallocate(DstParamData%PhiM) end if if (allocated(SrcParamData%C2_61)) then LB(1:2) = lbound(SrcParamData%C2_61) @@ -4264,8 +4064,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%C2_61 = SrcParamData%C2_61 - else if (allocated(DstParamData%C2_61)) then - deallocate(DstParamData%C2_61) end if if (allocated(SrcParamData%C2_62)) then LB(1:2) = lbound(SrcParamData%C2_62) @@ -4278,8 +4076,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%C2_62 = SrcParamData%C2_62 - else if (allocated(DstParamData%C2_62)) then - deallocate(DstParamData%C2_62) end if if (allocated(SrcParamData%PhiRb_TI)) then LB(1:2) = lbound(SrcParamData%PhiRb_TI) @@ -4292,8 +4088,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%PhiRb_TI = SrcParamData%PhiRb_TI - else if (allocated(DstParamData%PhiRb_TI)) then - deallocate(DstParamData%PhiRb_TI) end if if (allocated(SrcParamData%D2_63)) then LB(1:2) = lbound(SrcParamData%D2_63) @@ -4306,8 +4100,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%D2_63 = SrcParamData%D2_63 - else if (allocated(DstParamData%D2_63)) then - deallocate(DstParamData%D2_63) end if if (allocated(SrcParamData%D2_64)) then LB(1:2) = lbound(SrcParamData%D2_64) @@ -4320,8 +4112,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%D2_64 = SrcParamData%D2_64 - else if (allocated(DstParamData%D2_64)) then - deallocate(DstParamData%D2_64) end if if (allocated(SrcParamData%MBB)) then LB(1:2) = lbound(SrcParamData%MBB) @@ -4334,8 +4124,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%MBB = SrcParamData%MBB - else if (allocated(DstParamData%MBB)) then - deallocate(DstParamData%MBB) end if if (allocated(SrcParamData%KBB)) then LB(1:2) = lbound(SrcParamData%KBB) @@ -4348,8 +4136,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%KBB = SrcParamData%KBB - else if (allocated(DstParamData%KBB)) then - deallocate(DstParamData%KBB) end if if (allocated(SrcParamData%CBB)) then LB(1:2) = lbound(SrcParamData%CBB) @@ -4362,8 +4148,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%CBB = SrcParamData%CBB - else if (allocated(DstParamData%CBB)) then - deallocate(DstParamData%CBB) end if if (allocated(SrcParamData%CMM)) then LB(1:2) = lbound(SrcParamData%CMM) @@ -4376,8 +4160,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%CMM = SrcParamData%CMM - else if (allocated(DstParamData%CMM)) then - deallocate(DstParamData%CMM) end if if (allocated(SrcParamData%MBM)) then LB(1:2) = lbound(SrcParamData%MBM) @@ -4390,8 +4172,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%MBM = SrcParamData%MBM - else if (allocated(DstParamData%MBM)) then - deallocate(DstParamData%MBM) end if if (allocated(SrcParamData%PhiL_T)) then LB(1:2) = lbound(SrcParamData%PhiL_T) @@ -4404,8 +4184,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%PhiL_T = SrcParamData%PhiL_T - else if (allocated(DstParamData%PhiL_T)) then - deallocate(DstParamData%PhiL_T) end if if (allocated(SrcParamData%PhiLInvOmgL2)) then LB(1:2) = lbound(SrcParamData%PhiLInvOmgL2) @@ -4418,8 +4196,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%PhiLInvOmgL2 = SrcParamData%PhiLInvOmgL2 - else if (allocated(DstParamData%PhiLInvOmgL2)) then - deallocate(DstParamData%PhiLInvOmgL2) end if if (allocated(SrcParamData%KLLm1)) then LB(1:2) = lbound(SrcParamData%KLLm1) @@ -4432,8 +4208,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%KLLm1 = SrcParamData%KLLm1 - else if (allocated(DstParamData%KLLm1)) then - deallocate(DstParamData%KLLm1) end if if (allocated(SrcParamData%AM2Jac)) then LB(1:2) = lbound(SrcParamData%AM2Jac) @@ -4446,8 +4220,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%AM2Jac = SrcParamData%AM2Jac - else if (allocated(DstParamData%AM2Jac)) then - deallocate(DstParamData%AM2Jac) end if if (allocated(SrcParamData%AM2JacPiv)) then LB(1:1) = lbound(SrcParamData%AM2JacPiv) @@ -4460,8 +4232,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%AM2JacPiv = SrcParamData%AM2JacPiv - else if (allocated(DstParamData%AM2JacPiv)) then - deallocate(DstParamData%AM2JacPiv) end if if (allocated(SrcParamData%TI)) then LB(1:2) = lbound(SrcParamData%TI) @@ -4474,8 +4244,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%TI = SrcParamData%TI - else if (allocated(DstParamData%TI)) then - deallocate(DstParamData%TI) end if if (allocated(SrcParamData%TIreact)) then LB(1:2) = lbound(SrcParamData%TIreact) @@ -4488,8 +4256,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%TIreact = SrcParamData%TIreact - else if (allocated(DstParamData%TIreact)) then - deallocate(DstParamData%TIreact) end if DstParamData%nNodes = SrcParamData%nNodes DstParamData%nNodes_I = SrcParamData%nNodes_I @@ -4506,8 +4272,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%Nodes_I = SrcParamData%Nodes_I - else if (allocated(DstParamData%Nodes_I)) then - deallocate(DstParamData%Nodes_I) end if if (allocated(SrcParamData%Nodes_L)) then LB(1:2) = lbound(SrcParamData%Nodes_L) @@ -4520,8 +4284,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%Nodes_L = SrcParamData%Nodes_L - else if (allocated(DstParamData%Nodes_L)) then - deallocate(DstParamData%Nodes_L) end if if (allocated(SrcParamData%Nodes_C)) then LB(1:2) = lbound(SrcParamData%Nodes_C) @@ -4534,8 +4296,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%Nodes_C = SrcParamData%Nodes_C - else if (allocated(DstParamData%Nodes_C)) then - deallocate(DstParamData%Nodes_C) end if DstParamData%nDOFI__ = SrcParamData%nDOFI__ DstParamData%nDOFI_Rb = SrcParamData%nDOFI_Rb @@ -4560,8 +4320,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%IDI__ = SrcParamData%IDI__ - else if (allocated(DstParamData%IDI__)) then - deallocate(DstParamData%IDI__) end if if (allocated(SrcParamData%IDI_Rb)) then LB(1:1) = lbound(SrcParamData%IDI_Rb) @@ -4574,8 +4332,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%IDI_Rb = SrcParamData%IDI_Rb - else if (allocated(DstParamData%IDI_Rb)) then - deallocate(DstParamData%IDI_Rb) end if if (allocated(SrcParamData%IDI_F)) then LB(1:1) = lbound(SrcParamData%IDI_F) @@ -4588,8 +4344,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%IDI_F = SrcParamData%IDI_F - else if (allocated(DstParamData%IDI_F)) then - deallocate(DstParamData%IDI_F) end if if (allocated(SrcParamData%IDL_L)) then LB(1:1) = lbound(SrcParamData%IDL_L) @@ -4602,8 +4356,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%IDL_L = SrcParamData%IDL_L - else if (allocated(DstParamData%IDL_L)) then - deallocate(DstParamData%IDL_L) end if if (allocated(SrcParamData%IDC__)) then LB(1:1) = lbound(SrcParamData%IDC__) @@ -4616,8 +4368,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%IDC__ = SrcParamData%IDC__ - else if (allocated(DstParamData%IDC__)) then - deallocate(DstParamData%IDC__) end if if (allocated(SrcParamData%IDC_Rb)) then LB(1:1) = lbound(SrcParamData%IDC_Rb) @@ -4630,8 +4380,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%IDC_Rb = SrcParamData%IDC_Rb - else if (allocated(DstParamData%IDC_Rb)) then - deallocate(DstParamData%IDC_Rb) end if if (allocated(SrcParamData%IDC_L)) then LB(1:1) = lbound(SrcParamData%IDC_L) @@ -4644,8 +4392,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%IDC_L = SrcParamData%IDC_L - else if (allocated(DstParamData%IDC_L)) then - deallocate(DstParamData%IDC_L) end if if (allocated(SrcParamData%IDC_F)) then LB(1:1) = lbound(SrcParamData%IDC_F) @@ -4658,8 +4404,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%IDC_F = SrcParamData%IDC_F - else if (allocated(DstParamData%IDC_F)) then - deallocate(DstParamData%IDC_F) end if if (allocated(SrcParamData%IDR__)) then LB(1:1) = lbound(SrcParamData%IDR__) @@ -4672,8 +4416,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%IDR__ = SrcParamData%IDR__ - else if (allocated(DstParamData%IDR__)) then - deallocate(DstParamData%IDR__) end if if (allocated(SrcParamData%ID__Rb)) then LB(1:1) = lbound(SrcParamData%ID__Rb) @@ -4686,8 +4428,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%ID__Rb = SrcParamData%ID__Rb - else if (allocated(DstParamData%ID__Rb)) then - deallocate(DstParamData%ID__Rb) end if if (allocated(SrcParamData%ID__L)) then LB(1:1) = lbound(SrcParamData%ID__L) @@ -4700,8 +4440,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%ID__L = SrcParamData%ID__L - else if (allocated(DstParamData%ID__L)) then - deallocate(DstParamData%ID__L) end if if (allocated(SrcParamData%ID__F)) then LB(1:1) = lbound(SrcParamData%ID__F) @@ -4714,8 +4452,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%ID__F = SrcParamData%ID__F - else if (allocated(DstParamData%ID__F)) then - deallocate(DstParamData%ID__F) end if DstParamData%NMOutputs = SrcParamData%NMOutputs DstParamData%NumOuts = SrcParamData%NumOuts @@ -4739,8 +4475,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstParamData%MoutLst)) then - deallocate(DstParamData%MoutLst) end if if (allocated(SrcParamData%MoutLst2)) then LB(1:1) = lbound(SrcParamData%MoutLst2) @@ -4757,8 +4491,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstParamData%MoutLst2)) then - deallocate(DstParamData%MoutLst2) end if if (allocated(SrcParamData%MoutLst3)) then LB(1:1) = lbound(SrcParamData%MoutLst3) @@ -4775,8 +4507,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstParamData%MoutLst3)) then - deallocate(DstParamData%MoutLst3) end if if (allocated(SrcParamData%OutParam)) then LB(1:1) = lbound(SrcParamData%OutParam) @@ -4793,8 +4523,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - else if (allocated(DstParamData%OutParam)) then - deallocate(DstParamData%OutParam) end if DstParamData%OutAll = SrcParamData%OutAll DstParamData%OutCBModes = SrcParamData%OutCBModes @@ -4814,8 +4542,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx - else if (allocated(DstParamData%Jac_u_indx)) then - deallocate(DstParamData%Jac_u_indx) end if if (allocated(SrcParamData%du)) then LB(1:1) = lbound(SrcParamData%du) @@ -4828,8 +4554,6 @@ subroutine SD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%du = SrcParamData%du - else if (allocated(DstParamData%du)) then - deallocate(DstParamData%du) end if DstParamData%dx = SrcParamData%dx DstParamData%Jac_ny = SrcParamData%Jac_ny @@ -6407,8 +6131,6 @@ subroutine SD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%CableDeltaL = SrcInputData%CableDeltaL - else if (allocated(DstInputData%CableDeltaL)) then - deallocate(DstInputData%CableDeltaL) end if end subroutine @@ -6503,8 +6225,6 @@ subroutine SD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg end if end if DstOutputData%WriteOutput = SrcOutputData%WriteOutput - else if (allocated(DstOutputData%WriteOutput)) then - deallocate(DstOutputData%WriteOutput) end if end subroutine diff --git a/modules/supercontroller/src/SCDataEx_Types.f90 b/modules/supercontroller/src/SCDataEx_Types.f90 index 3f9d7b7ac4..b7339226dd 100644 --- a/modules/supercontroller/src/SCDataEx_Types.f90 +++ b/modules/supercontroller/src/SCDataEx_Types.f90 @@ -380,9 +380,6 @@ subroutine SC_DX_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg DstInputData%C_obj%toSC = c_loc(DstInputData%toSC(LB(1))) end if DstInputData%toSC = SrcInputData%toSC - else if (associated(DstInputData%toSC)) then - deallocate(DstInputData%toSC) - nullify(DstInputData%toSC) end if end subroutine @@ -540,9 +537,6 @@ subroutine SC_DX_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err DstOutputData%C_obj%fromSC = c_loc(DstOutputData%fromSC(LB(1))) end if DstOutputData%fromSC = SrcOutputData%fromSC - else if (associated(DstOutputData%fromSC)) then - deallocate(DstOutputData%fromSC) - nullify(DstOutputData%fromSC) end if if (associated(SrcOutputData%fromSCglob)) then LB(1:1) = lbound(SrcOutputData%fromSCglob) @@ -558,9 +552,6 @@ subroutine SC_DX_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err DstOutputData%C_obj%fromSCglob = c_loc(DstOutputData%fromSCglob(LB(1))) end if DstOutputData%fromSCglob = SrcOutputData%fromSCglob - else if (associated(DstOutputData%fromSCglob)) then - deallocate(DstOutputData%fromSCglob) - nullify(DstOutputData%fromSCglob) end if end subroutine diff --git a/modules/supercontroller/src/SuperController_Types.f90 b/modules/supercontroller/src/SuperController_Types.f90 index 49a8e234c1..79c445e2a4 100644 --- a/modules/supercontroller/src/SuperController_Types.f90 +++ b/modules/supercontroller/src/SuperController_Types.f90 @@ -432,9 +432,6 @@ subroutine SC_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%C_obj%ParamGlobal = c_loc(DstParamData%ParamGlobal(LB(1))) end if DstParamData%ParamGlobal = SrcParamData%ParamGlobal - else if (associated(DstParamData%ParamGlobal)) then - deallocate(DstParamData%ParamGlobal) - nullify(DstParamData%ParamGlobal) end if if (associated(SrcParamData%ParamTurbine)) then LB(1:1) = lbound(SrcParamData%ParamTurbine) @@ -450,9 +447,6 @@ subroutine SC_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%C_obj%ParamTurbine = c_loc(DstParamData%ParamTurbine(LB(1))) end if DstParamData%ParamTurbine = SrcParamData%ParamTurbine - else if (associated(DstParamData%ParamTurbine)) then - deallocate(DstParamData%ParamTurbine) - nullify(DstParamData%ParamTurbine) end if DstParamData%DLL_Trgt = SrcParamData%DLL_Trgt end subroutine @@ -738,9 +732,6 @@ subroutine SC_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%C_obj%Global = c_loc(DstDiscStateData%Global(LB(1))) end if DstDiscStateData%Global = SrcDiscStateData%Global - else if (associated(DstDiscStateData%Global)) then - deallocate(DstDiscStateData%Global) - nullify(DstDiscStateData%Global) end if if (associated(SrcDiscStateData%Turbine)) then LB(1:1) = lbound(SrcDiscStateData%Turbine) @@ -756,9 +747,6 @@ subroutine SC_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%C_obj%Turbine = c_loc(DstDiscStateData%Turbine(LB(1))) end if DstDiscStateData%Turbine = SrcDiscStateData%Turbine - else if (associated(DstDiscStateData%Turbine)) then - deallocate(DstDiscStateData%Turbine) - nullify(DstDiscStateData%Turbine) end if end subroutine @@ -1301,9 +1289,6 @@ subroutine SC_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%C_obj%toSCglob = c_loc(DstInputData%toSCglob(LB(1))) end if DstInputData%toSCglob = SrcInputData%toSCglob - else if (associated(DstInputData%toSCglob)) then - deallocate(DstInputData%toSCglob) - nullify(DstInputData%toSCglob) end if if (associated(SrcInputData%toSC)) then LB(1:1) = lbound(SrcInputData%toSC) @@ -1319,9 +1304,6 @@ subroutine SC_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%C_obj%toSC = c_loc(DstInputData%toSC(LB(1))) end if DstInputData%toSC = SrcInputData%toSC - else if (associated(DstInputData%toSC)) then - deallocate(DstInputData%toSC) - nullify(DstInputData%toSC) end if end subroutine @@ -1540,9 +1522,6 @@ subroutine SC_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%C_obj%fromSCglob = c_loc(DstOutputData%fromSCglob(LB(1))) end if DstOutputData%fromSCglob = SrcOutputData%fromSCglob - else if (associated(DstOutputData%fromSCglob)) then - deallocate(DstOutputData%fromSCglob) - nullify(DstOutputData%fromSCglob) end if if (associated(SrcOutputData%fromSC)) then LB(1:1) = lbound(SrcOutputData%fromSC) @@ -1558,9 +1537,6 @@ subroutine SC_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%C_obj%fromSC = c_loc(DstOutputData%fromSC(LB(1))) end if DstOutputData%fromSC = SrcOutputData%fromSC - else if (associated(DstOutputData%fromSC)) then - deallocate(DstOutputData%fromSC) - nullify(DstOutputData%fromSC) end if end subroutine diff --git a/modules/wakedynamics/src/WakeDynamics_Types.f90 b/modules/wakedynamics/src/WakeDynamics_Types.f90 index 12bf28779b..9383cea9b4 100644 --- a/modules/wakedynamics/src/WakeDynamics_Types.f90 +++ b/modules/wakedynamics/src/WakeDynamics_Types.f90 @@ -470,8 +470,6 @@ subroutine WD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr - else if (allocated(DstInitOutputData%WriteOutputHdr)) then - deallocate(DstInitOutputData%WriteOutputHdr) end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) @@ -484,8 +482,6 @@ subroutine WD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err end if end if DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt - else if (allocated(DstInitOutputData%WriteOutputUnt)) then - deallocate(DstInitOutputData%WriteOutputUnt) end if call NWTC_Library_CopyProgDesc(SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -630,8 +626,6 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%xhat_plane = SrcDiscStateData%xhat_plane - else if (allocated(DstDiscStateData%xhat_plane)) then - deallocate(DstDiscStateData%xhat_plane) end if if (allocated(SrcDiscStateData%YawErr_filt)) then LB(1:1) = lbound(SrcDiscStateData%YawErr_filt) @@ -644,8 +638,6 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%YawErr_filt = SrcDiscStateData%YawErr_filt - else if (allocated(DstDiscStateData%YawErr_filt)) then - deallocate(DstDiscStateData%YawErr_filt) end if DstDiscStateData%psi_skew_filt = SrcDiscStateData%psi_skew_filt DstDiscStateData%chi_skew_filt = SrcDiscStateData%chi_skew_filt @@ -660,8 +652,6 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%V_plane_filt = SrcDiscStateData%V_plane_filt - else if (allocated(DstDiscStateData%V_plane_filt)) then - deallocate(DstDiscStateData%V_plane_filt) end if if (allocated(SrcDiscStateData%p_plane)) then LB(1:2) = lbound(SrcDiscStateData%p_plane) @@ -674,8 +664,6 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%p_plane = SrcDiscStateData%p_plane - else if (allocated(DstDiscStateData%p_plane)) then - deallocate(DstDiscStateData%p_plane) end if if (allocated(SrcDiscStateData%x_plane)) then LB(1:1) = lbound(SrcDiscStateData%x_plane) @@ -688,8 +676,6 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%x_plane = SrcDiscStateData%x_plane - else if (allocated(DstDiscStateData%x_plane)) then - deallocate(DstDiscStateData%x_plane) end if if (allocated(SrcDiscStateData%Vx_wake)) then LB(1:2) = lbound(SrcDiscStateData%Vx_wake) @@ -702,8 +688,6 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%Vx_wake = SrcDiscStateData%Vx_wake - else if (allocated(DstDiscStateData%Vx_wake)) then - deallocate(DstDiscStateData%Vx_wake) end if if (allocated(SrcDiscStateData%Vr_wake)) then LB(1:2) = lbound(SrcDiscStateData%Vr_wake) @@ -716,8 +700,6 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%Vr_wake = SrcDiscStateData%Vr_wake - else if (allocated(DstDiscStateData%Vr_wake)) then - deallocate(DstDiscStateData%Vr_wake) end if if (allocated(SrcDiscStateData%Vx_wake2)) then LB(1:3) = lbound(SrcDiscStateData%Vx_wake2) @@ -730,8 +712,6 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%Vx_wake2 = SrcDiscStateData%Vx_wake2 - else if (allocated(DstDiscStateData%Vx_wake2)) then - deallocate(DstDiscStateData%Vx_wake2) end if if (allocated(SrcDiscStateData%Vy_wake2)) then LB(1:3) = lbound(SrcDiscStateData%Vy_wake2) @@ -744,8 +724,6 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%Vy_wake2 = SrcDiscStateData%Vy_wake2 - else if (allocated(DstDiscStateData%Vy_wake2)) then - deallocate(DstDiscStateData%Vy_wake2) end if if (allocated(SrcDiscStateData%Vz_wake2)) then LB(1:3) = lbound(SrcDiscStateData%Vz_wake2) @@ -758,8 +736,6 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%Vz_wake2 = SrcDiscStateData%Vz_wake2 - else if (allocated(DstDiscStateData%Vz_wake2)) then - deallocate(DstDiscStateData%Vz_wake2) end if if (allocated(SrcDiscStateData%Vx_wind_disk_filt)) then LB(1:1) = lbound(SrcDiscStateData%Vx_wind_disk_filt) @@ -772,8 +748,6 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%Vx_wind_disk_filt = SrcDiscStateData%Vx_wind_disk_filt - else if (allocated(DstDiscStateData%Vx_wind_disk_filt)) then - deallocate(DstDiscStateData%Vx_wind_disk_filt) end if if (allocated(SrcDiscStateData%TI_amb_filt)) then LB(1:1) = lbound(SrcDiscStateData%TI_amb_filt) @@ -786,8 +760,6 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%TI_amb_filt = SrcDiscStateData%TI_amb_filt - else if (allocated(DstDiscStateData%TI_amb_filt)) then - deallocate(DstDiscStateData%TI_amb_filt) end if if (allocated(SrcDiscStateData%D_rotor_filt)) then LB(1:1) = lbound(SrcDiscStateData%D_rotor_filt) @@ -800,8 +772,6 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%D_rotor_filt = SrcDiscStateData%D_rotor_filt - else if (allocated(DstDiscStateData%D_rotor_filt)) then - deallocate(DstDiscStateData%D_rotor_filt) end if DstDiscStateData%Vx_rel_disk_filt = SrcDiscStateData%Vx_rel_disk_filt if (allocated(SrcDiscStateData%Ct_azavg_filt)) then @@ -815,8 +785,6 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%Ct_azavg_filt = SrcDiscStateData%Ct_azavg_filt - else if (allocated(DstDiscStateData%Ct_azavg_filt)) then - deallocate(DstDiscStateData%Ct_azavg_filt) end if if (allocated(SrcDiscStateData%Cq_azavg_filt)) then LB(1:1) = lbound(SrcDiscStateData%Cq_azavg_filt) @@ -829,8 +797,6 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if end if DstDiscStateData%Cq_azavg_filt = SrcDiscStateData%Cq_azavg_filt - else if (allocated(DstDiscStateData%Cq_azavg_filt)) then - deallocate(DstDiscStateData%Cq_azavg_filt) end if end subroutine @@ -1300,8 +1266,6 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%dvtdr = SrcMiscData%dvtdr - else if (allocated(DstMiscData%dvtdr)) then - deallocate(DstMiscData%dvtdr) end if if (allocated(SrcMiscData%vt_tot)) then LB(1:2) = lbound(SrcMiscData%vt_tot) @@ -1314,8 +1278,6 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%vt_tot = SrcMiscData%vt_tot - else if (allocated(DstMiscData%vt_tot)) then - deallocate(DstMiscData%vt_tot) end if if (allocated(SrcMiscData%vt_amb)) then LB(1:2) = lbound(SrcMiscData%vt_amb) @@ -1328,8 +1290,6 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%vt_amb = SrcMiscData%vt_amb - else if (allocated(DstMiscData%vt_amb)) then - deallocate(DstMiscData%vt_amb) end if if (allocated(SrcMiscData%vt_shr)) then LB(1:2) = lbound(SrcMiscData%vt_shr) @@ -1342,8 +1302,6 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%vt_shr = SrcMiscData%vt_shr - else if (allocated(DstMiscData%vt_shr)) then - deallocate(DstMiscData%vt_shr) end if if (allocated(SrcMiscData%vt_tot2)) then LB(1:3) = lbound(SrcMiscData%vt_tot2) @@ -1356,8 +1314,6 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%vt_tot2 = SrcMiscData%vt_tot2 - else if (allocated(DstMiscData%vt_tot2)) then - deallocate(DstMiscData%vt_tot2) end if if (allocated(SrcMiscData%vt_amb2)) then LB(1:3) = lbound(SrcMiscData%vt_amb2) @@ -1370,8 +1326,6 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%vt_amb2 = SrcMiscData%vt_amb2 - else if (allocated(DstMiscData%vt_amb2)) then - deallocate(DstMiscData%vt_amb2) end if if (allocated(SrcMiscData%vt_shr2)) then LB(1:3) = lbound(SrcMiscData%vt_shr2) @@ -1384,8 +1338,6 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%vt_shr2 = SrcMiscData%vt_shr2 - else if (allocated(DstMiscData%vt_shr2)) then - deallocate(DstMiscData%vt_shr2) end if if (allocated(SrcMiscData%dvx_dy)) then LB(1:3) = lbound(SrcMiscData%dvx_dy) @@ -1398,8 +1350,6 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%dvx_dy = SrcMiscData%dvx_dy - else if (allocated(DstMiscData%dvx_dy)) then - deallocate(DstMiscData%dvx_dy) end if if (allocated(SrcMiscData%dvx_dz)) then LB(1:3) = lbound(SrcMiscData%dvx_dz) @@ -1412,8 +1362,6 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%dvx_dz = SrcMiscData%dvx_dz - else if (allocated(DstMiscData%dvx_dz)) then - deallocate(DstMiscData%dvx_dz) end if if (allocated(SrcMiscData%nu_dvx_dy)) then LB(1:2) = lbound(SrcMiscData%nu_dvx_dy) @@ -1426,8 +1374,6 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%nu_dvx_dy = SrcMiscData%nu_dvx_dy - else if (allocated(DstMiscData%nu_dvx_dy)) then - deallocate(DstMiscData%nu_dvx_dy) end if if (allocated(SrcMiscData%nu_dvx_dz)) then LB(1:2) = lbound(SrcMiscData%nu_dvx_dz) @@ -1440,8 +1386,6 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%nu_dvx_dz = SrcMiscData%nu_dvx_dz - else if (allocated(DstMiscData%nu_dvx_dz)) then - deallocate(DstMiscData%nu_dvx_dz) end if if (allocated(SrcMiscData%dnuvx_dy)) then LB(1:2) = lbound(SrcMiscData%dnuvx_dy) @@ -1454,8 +1398,6 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%dnuvx_dy = SrcMiscData%dnuvx_dy - else if (allocated(DstMiscData%dnuvx_dy)) then - deallocate(DstMiscData%dnuvx_dy) end if if (allocated(SrcMiscData%dnuvx_dz)) then LB(1:2) = lbound(SrcMiscData%dnuvx_dz) @@ -1468,8 +1410,6 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%dnuvx_dz = SrcMiscData%dnuvx_dz - else if (allocated(DstMiscData%dnuvx_dz)) then - deallocate(DstMiscData%dnuvx_dz) end if if (allocated(SrcMiscData%a)) then LB(1:1) = lbound(SrcMiscData%a) @@ -1482,8 +1422,6 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%a = SrcMiscData%a - else if (allocated(DstMiscData%a)) then - deallocate(DstMiscData%a) end if if (allocated(SrcMiscData%b)) then LB(1:1) = lbound(SrcMiscData%b) @@ -1496,8 +1434,6 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%b = SrcMiscData%b - else if (allocated(DstMiscData%b)) then - deallocate(DstMiscData%b) end if if (allocated(SrcMiscData%c)) then LB(1:1) = lbound(SrcMiscData%c) @@ -1510,8 +1446,6 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%c = SrcMiscData%c - else if (allocated(DstMiscData%c)) then - deallocate(DstMiscData%c) end if if (allocated(SrcMiscData%d)) then LB(1:1) = lbound(SrcMiscData%d) @@ -1524,8 +1458,6 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%d = SrcMiscData%d - else if (allocated(DstMiscData%d)) then - deallocate(DstMiscData%d) end if if (allocated(SrcMiscData%r_wake)) then LB(1:1) = lbound(SrcMiscData%r_wake) @@ -1538,8 +1470,6 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%r_wake = SrcMiscData%r_wake - else if (allocated(DstMiscData%r_wake)) then - deallocate(DstMiscData%r_wake) end if if (allocated(SrcMiscData%Vx_high)) then LB(1:1) = lbound(SrcMiscData%Vx_high) @@ -1552,8 +1482,6 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%Vx_high = SrcMiscData%Vx_high - else if (allocated(DstMiscData%Vx_high)) then - deallocate(DstMiscData%Vx_high) end if if (allocated(SrcMiscData%Vx_polar)) then LB(1:1) = lbound(SrcMiscData%Vx_polar) @@ -1566,8 +1494,6 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%Vx_polar = SrcMiscData%Vx_polar - else if (allocated(DstMiscData%Vx_polar)) then - deallocate(DstMiscData%Vx_polar) end if if (allocated(SrcMiscData%Vt_wake)) then LB(1:1) = lbound(SrcMiscData%Vt_wake) @@ -1580,8 +1506,6 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if end if DstMiscData%Vt_wake = SrcMiscData%Vt_wake - else if (allocated(DstMiscData%Vt_wake)) then - deallocate(DstMiscData%Vt_wake) end if DstMiscData%GammaCurl = SrcMiscData%GammaCurl DstMiscData%Ct_avg = SrcMiscData%Ct_avg @@ -2108,8 +2032,6 @@ subroutine WD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%r = SrcParamData%r - else if (allocated(DstParamData%r)) then - deallocate(DstParamData%r) end if if (allocated(SrcParamData%y)) then LB(1:1) = lbound(SrcParamData%y) @@ -2122,8 +2044,6 @@ subroutine WD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%y = SrcParamData%y - else if (allocated(DstParamData%y)) then - deallocate(DstParamData%y) end if if (allocated(SrcParamData%z)) then LB(1:1) = lbound(SrcParamData%z) @@ -2136,8 +2056,6 @@ subroutine WD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if end if DstParamData%z = SrcParamData%z - else if (allocated(DstParamData%z)) then - deallocate(DstParamData%z) end if DstParamData%Mod_Wake = SrcParamData%Mod_Wake DstParamData%Swirl = SrcParamData%Swirl @@ -2405,8 +2323,6 @@ subroutine WD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%V_plane = SrcInputData%V_plane - else if (allocated(DstInputData%V_plane)) then - deallocate(DstInputData%V_plane) end if DstInputData%Vx_wind_disk = SrcInputData%Vx_wind_disk DstInputData%TI_amb = SrcInputData%TI_amb @@ -2423,8 +2339,6 @@ subroutine WD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%Ct_azavg = SrcInputData%Ct_azavg - else if (allocated(DstInputData%Ct_azavg)) then - deallocate(DstInputData%Ct_azavg) end if if (allocated(SrcInputData%Cq_azavg)) then LB(1:1) = lbound(SrcInputData%Cq_azavg) @@ -2437,8 +2351,6 @@ subroutine WD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if end if DstInputData%Cq_azavg = SrcInputData%Cq_azavg - else if (allocated(DstInputData%Cq_azavg)) then - deallocate(DstInputData%Cq_azavg) end if end subroutine @@ -2584,8 +2496,6 @@ subroutine WD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg end if end if DstOutputData%xhat_plane = SrcOutputData%xhat_plane - else if (allocated(DstOutputData%xhat_plane)) then - deallocate(DstOutputData%xhat_plane) end if if (allocated(SrcOutputData%p_plane)) then LB(1:2) = lbound(SrcOutputData%p_plane) @@ -2598,8 +2508,6 @@ subroutine WD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg end if end if DstOutputData%p_plane = SrcOutputData%p_plane - else if (allocated(DstOutputData%p_plane)) then - deallocate(DstOutputData%p_plane) end if if (allocated(SrcOutputData%Vx_wake)) then LB(1:2) = lbound(SrcOutputData%Vx_wake) @@ -2612,8 +2520,6 @@ subroutine WD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg end if end if DstOutputData%Vx_wake = SrcOutputData%Vx_wake - else if (allocated(DstOutputData%Vx_wake)) then - deallocate(DstOutputData%Vx_wake) end if if (allocated(SrcOutputData%Vr_wake)) then LB(1:2) = lbound(SrcOutputData%Vr_wake) @@ -2626,8 +2532,6 @@ subroutine WD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg end if end if DstOutputData%Vr_wake = SrcOutputData%Vr_wake - else if (allocated(DstOutputData%Vr_wake)) then - deallocate(DstOutputData%Vr_wake) end if if (allocated(SrcOutputData%Vx_wake2)) then LB(1:3) = lbound(SrcOutputData%Vx_wake2) @@ -2640,8 +2544,6 @@ subroutine WD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg end if end if DstOutputData%Vx_wake2 = SrcOutputData%Vx_wake2 - else if (allocated(DstOutputData%Vx_wake2)) then - deallocate(DstOutputData%Vx_wake2) end if if (allocated(SrcOutputData%Vy_wake2)) then LB(1:3) = lbound(SrcOutputData%Vy_wake2) @@ -2654,8 +2556,6 @@ subroutine WD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg end if end if DstOutputData%Vy_wake2 = SrcOutputData%Vy_wake2 - else if (allocated(DstOutputData%Vy_wake2)) then - deallocate(DstOutputData%Vy_wake2) end if if (allocated(SrcOutputData%Vz_wake2)) then LB(1:3) = lbound(SrcOutputData%Vz_wake2) @@ -2668,8 +2568,6 @@ subroutine WD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg end if end if DstOutputData%Vz_wake2 = SrcOutputData%Vz_wake2 - else if (allocated(DstOutputData%Vz_wake2)) then - deallocate(DstOutputData%Vz_wake2) end if if (allocated(SrcOutputData%D_wake)) then LB(1:1) = lbound(SrcOutputData%D_wake) @@ -2682,8 +2580,6 @@ subroutine WD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg end if end if DstOutputData%D_wake = SrcOutputData%D_wake - else if (allocated(DstOutputData%D_wake)) then - deallocate(DstOutputData%D_wake) end if if (allocated(SrcOutputData%x_plane)) then LB(1:1) = lbound(SrcOutputData%x_plane) @@ -2696,8 +2592,6 @@ subroutine WD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg end if end if DstOutputData%x_plane = SrcOutputData%x_plane - else if (allocated(DstOutputData%x_plane)) then - deallocate(DstOutputData%x_plane) end if if (allocated(SrcOutputData%WAT_k_mt)) then LB(1:3) = lbound(SrcOutputData%WAT_k_mt) @@ -2710,8 +2604,6 @@ subroutine WD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg end if end if DstOutputData%WAT_k_mt = SrcOutputData%WAT_k_mt - else if (allocated(DstOutputData%WAT_k_mt)) then - deallocate(DstOutputData%WAT_k_mt) end if end subroutine From fc696588a4244ab011ec507d8cfb8003cfecae21 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 16 Jun 2023 16:57:19 +0000 Subject: [PATCH 12/15] Add default initialization to Registry This may be a good idea to initialize fields to default values where possible. --- .../fast-farm/src/FASTWrapper_Types.f90 | 72 +- glue-codes/fast-farm/src/FAST_Farm_Types.f90 | 90 +- modules/aerodyn/src/AeroAcoustics_Types.f90 | 172 ++-- modules/aerodyn/src/AeroDyn_Driver_Types.f90 | 186 ++-- modules/aerodyn/src/AeroDyn_Inflow_Types.f90 | 40 +- modules/aerodyn/src/AirfoilInfo_Types.f90 | 152 +-- modules/aerodyn/src/BEMT_Types.f90 | 128 +-- modules/aerodyn/src/DBEMT_Types.f90 | 44 +- modules/aerodyn/src/FVW_Types.f90 | 258 ++--- modules/aerodyn/src/UnsteadyAero_Types.f90 | 66 +- modules/aerodyn14/src/AeroDyn14_Types.f90 | 272 ++--- modules/aerodyn14/src/DWM_Types.f90 | 218 ++-- modules/awae/src/AWAE_Types.f90 | 164 +-- modules/beamdyn/src/BeamDyn_Types.f90 | 206 ++-- modules/elastodyn/src/ElastoDyn_Types.f90 | 948 +++++++++--------- modules/extptfm/src/ExtPtfm_MCKF_Types.f90 | 56 +- modules/feamooring/src/FEAMooring_Types.f90 | 150 +-- modules/hydrodyn/src/Conv_Radiation_Types.f90 | 36 +- modules/hydrodyn/src/HydroDyn_Types.f90 | 132 +-- modules/hydrodyn/src/Morison_Types.f90 | 394 ++++---- modules/hydrodyn/src/SS_Excitation_Types.f90 | 26 +- modules/hydrodyn/src/SS_Radiation_Types.f90 | 16 +- modules/hydrodyn/src/WAMIT2_Types.f90 | 84 +- modules/hydrodyn/src/WAMIT_Types.f90 | 62 +- modules/icedyn/src/IceDyn_Types.f90 | 248 ++--- modules/icefloe/src/icefloe/IceFloe_Types.f90 | 50 +- .../inflowwind/src/InflowWind_IO_Types.f90 | 78 +- modules/inflowwind/src/InflowWind_Types.f90 | 106 +- modules/inflowwind/src/Lidar_Types.f90 | 72 +- modules/map/src/MAP_Fortran_Types.f90 | 4 +- modules/map/src/MAP_Types.f90 | 34 +- modules/moordyn/src/MoorDyn_Types.f90 | 370 +++---- .../nwtc-library/src/NWTC_Library_Types.f90 | 38 +- modules/openfast-library/src/FAST_Types.f90 | 312 +++--- .../src/registry_gen_fortran.cpp | 58 +- .../src/OrcaFlexInterface_Types.f90 | 38 +- modules/seastate/src/Current_Types.f90 | 28 +- .../seastate/src/SeaSt_WaveField_Types.f90 | 6 +- .../seastate/src/SeaState_Interp_Types.f90 | 24 +- modules/seastate/src/SeaState_Types.f90 | 156 +-- modules/seastate/src/Waves2_Types.f90 | 38 +- modules/seastate/src/Waves_Types.f90 | 96 +- modules/servodyn/src/ServoDyn_Types.f90 | 658 ++++++------ modules/servodyn/src/StrucCtrl_Types.f90 | 238 ++--- modules/subdyn/src/SubDyn_Types.f90 | 200 ++-- .../supercontroller/src/SCDataEx_Types.f90 | 6 +- .../src/SuperController_Types.f90 | 40 +- .../wakedynamics/src/WakeDynamics_Types.f90 | 172 ++-- 48 files changed, 3540 insertions(+), 3502 deletions(-) diff --git a/glue-codes/fast-farm/src/FASTWrapper_Types.f90 b/glue-codes/fast-farm/src/FASTWrapper_Types.f90 index 0c98305606..7c99c9c1fc 100644 --- a/glue-codes/fast-farm/src/FASTWrapper_Types.f90 +++ b/glue-codes/fast-farm/src/FASTWrapper_Types.f90 @@ -36,27 +36,27 @@ MODULE FASTWrapper_Types IMPLICIT NONE ! ========= FWrap_InitInputType ======= TYPE, PUBLIC :: FWrap_InitInputType - INTEGER(IntKi) :: nr !< Number of radii in the radial finite-difference grid [-] - CHARACTER(1024) :: FASTInFile !< Filename of primary FAST input file of this turbine [-] - REAL(ReKi) :: dr !< Radial increment of radial finite-difference grid [m] - REAL(DbKi) :: tmax !< Simulation length [s] - REAL(ReKi) , DIMENSION(1:3) :: p_ref_Turbine !< Undisplaced global coordinates of this turbine [m] - INTEGER(IntKi) :: WaveFieldMod !< Wave field handling (-) (switch) 0: use individual HydroDyn inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin [-] - INTEGER(IntKi) :: n_high_low !< Number of high-resolution time steps per low-resolution time step [-] - REAL(DbKi) :: dt_high !< High-resolution time step [s] - REAL(ReKi) , DIMENSION(1:3) :: p_ref_high !< Position of the origin of the high-resolution spatial domain for this turbine [m] - INTEGER(IntKi) :: nX_high !< Number of high-resolution spatial nodes in X direction [-] - INTEGER(IntKi) :: nY_high !< Number of high-resolution spatial nodes in Y direction [-] - INTEGER(IntKi) :: nZ_high !< Number of high-resolution spatial nodes in Z direction [-] - REAL(ReKi) :: dX_high !< X-component of the spatial increment of the high-resolution spatial domain for this turbine [m] - REAL(ReKi) :: dY_high !< Y-component of the spatial increment of the high-resolution spatial domain for this turbine [m] - REAL(ReKi) :: dZ_high !< Z-component of the spatial increment of the high-resolution spatial domain for this turbine [m] - INTEGER(IntKi) :: TurbNum !< Turbine ID number (start with 1; end with number of turbines) [-] - CHARACTER(1024) :: RootName !< The root name derived from the primary FAST.Farm input file [For output reporting in this module we need to have Rootname include the turbine number] [-] - INTEGER(IntKi) :: NumSC2Ctrl !< Number of turbine-specific controller inputs [from supercontroller] [-] - INTEGER(IntKi) :: NumSC2CtrlGlob !< Number of global controller inputs [from supercontroller] [-] - INTEGER(IntKi) :: NumCtrl2SC !< Number of turbine-specific controller outputs [to supercontroller] [-] - LOGICAL :: UseSC !< Use the SuperController? (flag) [-] + INTEGER(IntKi) :: nr = 0_IntKi !< Number of radii in the radial finite-difference grid [-] + CHARACTER(1024) :: FASTInFile = '' !< Filename of primary FAST input file of this turbine [-] + REAL(ReKi) :: dr = 0.0_ReKi !< Radial increment of radial finite-difference grid [m] + REAL(DbKi) :: tmax = 0.0_R8Ki !< Simulation length [s] + REAL(ReKi) , DIMENSION(1:3) :: p_ref_Turbine = 0.0_ReKi !< Undisplaced global coordinates of this turbine [m] + INTEGER(IntKi) :: WaveFieldMod = 0_IntKi !< Wave field handling (-) (switch) 0: use individual HydroDyn inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin [-] + INTEGER(IntKi) :: n_high_low = 0_IntKi !< Number of high-resolution time steps per low-resolution time step [-] + REAL(DbKi) :: dt_high = 0.0_R8Ki !< High-resolution time step [s] + REAL(ReKi) , DIMENSION(1:3) :: p_ref_high = 0.0_ReKi !< Position of the origin of the high-resolution spatial domain for this turbine [m] + INTEGER(IntKi) :: nX_high = 0_IntKi !< Number of high-resolution spatial nodes in X direction [-] + INTEGER(IntKi) :: nY_high = 0_IntKi !< Number of high-resolution spatial nodes in Y direction [-] + INTEGER(IntKi) :: nZ_high = 0_IntKi !< Number of high-resolution spatial nodes in Z direction [-] + REAL(ReKi) :: dX_high = 0.0_ReKi !< X-component of the spatial increment of the high-resolution spatial domain for this turbine [m] + REAL(ReKi) :: dY_high = 0.0_ReKi !< Y-component of the spatial increment of the high-resolution spatial domain for this turbine [m] + REAL(ReKi) :: dZ_high = 0.0_ReKi !< Z-component of the spatial increment of the high-resolution spatial domain for this turbine [m] + INTEGER(IntKi) :: TurbNum = 0_IntKi !< Turbine ID number (start with 1; end with number of turbines) [-] + CHARACTER(1024) :: RootName = '' !< The root name derived from the primary FAST.Farm input file [For output reporting in this module we need to have Rootname include the turbine number] [-] + INTEGER(IntKi) :: NumSC2Ctrl = 0_IntKi !< Number of turbine-specific controller inputs [from supercontroller] [-] + INTEGER(IntKi) :: NumSC2CtrlGlob = 0_IntKi !< Number of global controller inputs [from supercontroller] [-] + INTEGER(IntKi) :: NumCtrl2SC = 0_IntKi !< Number of turbine-specific controller outputs [to supercontroller] [-] + LOGICAL :: UseSC = .false. !< Use the SuperController? (flag) [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: fromSCGlob !< Global outputs from SuperController [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: fromSC !< Turbine-specific outputs from SuperController [-] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: Vdist_High => NULL() !< Pointer to UVW components of disturbed wind [nx^high, ny^high, nz^high, n^high/low] (ambient + deficits) across the high-resolution domain around the turbine for each high-resolution time step within a low-resolution time step [(m/s)] @@ -64,28 +64,28 @@ MODULE FASTWrapper_Types ! ======================= ! ========= FWrap_InitOutputType ======= TYPE, PUBLIC :: FWrap_InitOutputType - REAL(DbKi) , DIMENSION(1:6) :: PtfmInit !< Initial platform position/rotation vector - surge,sway,heave,roll,pitch,yaw - needed for mooring module initInp [-] + REAL(DbKi) , DIMENSION(1:6) :: PtfmInit = 0.0_R8Ki !< Initial platform position/rotation vector - surge,sway,heave,roll,pitch,yaw - needed for mooring module initInp [-] TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] END TYPE FWrap_InitOutputType ! ======================= ! ========= FWrap_ContinuousStateType ======= TYPE, PUBLIC :: FWrap_ContinuousStateType - REAL(ReKi) :: dummy !< Remove this variable if you have continuous states [-] + REAL(ReKi) :: dummy = 0.0_ReKi !< Remove this variable if you have continuous states [-] END TYPE FWrap_ContinuousStateType ! ======================= ! ========= FWrap_DiscreteStateType ======= TYPE, PUBLIC :: FWrap_DiscreteStateType - REAL(ReKi) :: dummy !< Remove this variable if you have continuous states [-] + REAL(ReKi) :: dummy = 0.0_ReKi !< Remove this variable if you have continuous states [-] END TYPE FWrap_DiscreteStateType ! ======================= ! ========= FWrap_ConstraintStateType ======= TYPE, PUBLIC :: FWrap_ConstraintStateType - REAL(ReKi) :: dummy !< Remove this variable if you have constraint states [-] + REAL(ReKi) :: dummy = 0.0_ReKi !< Remove this variable if you have constraint states [-] END TYPE FWrap_ConstraintStateType ! ======================= ! ========= FWrap_OtherStateType ======= TYPE, PUBLIC :: FWrap_OtherStateType - INTEGER(IntKi) :: dummy !< Remove this variable if you have other states [-] + INTEGER(IntKi) :: dummy = 0_IntKi !< Remove this variable if you have other states [-] END TYPE FWrap_OtherStateType ! ======================= ! ========= FWrap_MiscVarType ======= @@ -99,10 +99,10 @@ MODULE FASTWrapper_Types ! ======================= ! ========= FWrap_ParameterType ======= TYPE, PUBLIC :: FWrap_ParameterType - INTEGER(IntKi) :: nr !< Number of radii in the radial finite-difference grid [-] + INTEGER(IntKi) :: nr = 0_IntKi !< Number of radii in the radial finite-difference grid [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: r !< Discretization of radial finite-difference grid [m] - INTEGER(IntKi) :: n_FAST_low !< Number of FAST time steps per low-resolution time step [-] - REAL(ReKi) , DIMENSION(1:3) :: p_ref_Turbine !< Undisplaced global position of this turbine [m] + INTEGER(IntKi) :: n_FAST_low = 0_IntKi !< Number of FAST time steps per low-resolution time step [-] + REAL(ReKi) , DIMENSION(1:3) :: p_ref_Turbine = 0.0_ReKi !< Undisplaced global position of this turbine [m] END TYPE FWrap_ParameterType ! ======================= ! ========= FWrap_InputType ======= @@ -114,13 +114,13 @@ MODULE FASTWrapper_Types ! ========= FWrap_OutputType ======= TYPE, PUBLIC :: FWrap_OutputType REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: toSC !< Turbine-dependent commands to the super controller [(various units)] - REAL(ReKi) , DIMENSION(1:3) :: xHat_Disk !< Orientation of rotor centerline, normal to disk [-] - REAL(ReKi) :: YawErr !< Nacelle-yaw error i.e. the angle about positive Z^ from the rotor centerline to the rotor-disk-averaged relative wind velocity (ambients + deficits + motion), both projected onto the horizontal plane [rad] - REAL(ReKi) :: psi_skew !< Azimuth angle from the nominally vertical axis in the disk plane to the vector about which the inflow skew angle is defined [rad] - REAL(ReKi) :: chi_skew !< Inflow skew angle [rad] - REAL(ReKi) , DIMENSION(1:3) :: p_hub !< Center position of hub [m] - REAL(ReKi) :: D_rotor !< Rotor diameter [m] - REAL(ReKi) :: DiskAvg_Vx_Rel !< Rotor-disk-averaged relative wind speed (ambient + deficits + motion), normal to disk [m/s] + REAL(ReKi) , DIMENSION(1:3) :: xHat_Disk = 0.0_ReKi !< Orientation of rotor centerline, normal to disk [-] + REAL(ReKi) :: YawErr = 0.0_ReKi !< Nacelle-yaw error i.e. the angle about positive Z^ from the rotor centerline to the rotor-disk-averaged relative wind velocity (ambients + deficits + motion), both projected onto the horizontal plane [rad] + REAL(ReKi) :: psi_skew = 0.0_ReKi !< Azimuth angle from the nominally vertical axis in the disk plane to the vector about which the inflow skew angle is defined [rad] + REAL(ReKi) :: chi_skew = 0.0_ReKi !< Inflow skew angle [rad] + REAL(ReKi) , DIMENSION(1:3) :: p_hub = 0.0_ReKi !< Center position of hub [m] + REAL(ReKi) :: D_rotor = 0.0_ReKi !< Rotor diameter [m] + REAL(ReKi) :: DiskAvg_Vx_Rel = 0.0_ReKi !< Rotor-disk-averaged relative wind speed (ambient + deficits + motion), normal to disk [m/s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AzimAvg_Ct !< Azimuthally averaged thrust force coefficient (normal to disk), distributed radially [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AzimAvg_Cq !< Azimuthally averaged torque coefficient (normal to disk), distributed radially [-] END TYPE FWrap_OutputType diff --git a/glue-codes/fast-farm/src/FAST_Farm_Types.f90 b/glue-codes/fast-farm/src/FAST_Farm_Types.f90 index 24944a649d..24f92e9651 100644 --- a/glue-codes/fast-farm/src/FAST_Farm_Types.f90 +++ b/glue-codes/fast-farm/src/FAST_Farm_Types.f90 @@ -46,58 +46,58 @@ MODULE FAST_Farm_Types INTEGER(IntKi), PUBLIC, PARAMETER :: ModuleFF_MD = 5 ! Farm-level MoorDyn [-] ! ========= Farm_ParameterType ======= TYPE, PUBLIC :: Farm_ParameterType - REAL(DbKi) :: DT_low !< Time step for low-resolution wind data input files; will be used as the global FAST.Farm time step [seconds] - REAL(DbKi) :: DT_high !< High-resolution time step [seconds] - REAL(DbKi) :: TMax !< Total run time [seconds] - INTEGER(IntKi) :: n_high_low !< Number of high-resolution time steps per low-resolution time step [-] - INTEGER(IntKi) :: NumTurbines !< Number of turbines in the simulation [-] - CHARACTER(1024) :: WindFilePath !< Path name of wind data files from ABLSolver precursor [-] - CHARACTER(1024) :: SC_FileName !< Name/location of the dynamic library {.dll [Windows] or .so [Linux]} containing the Super Controller algorithms [-] - LOGICAL :: UseSC !< Use a super controller? [-] + REAL(DbKi) :: DT_low = 0.0_R8Ki !< Time step for low-resolution wind data input files; will be used as the global FAST.Farm time step [seconds] + REAL(DbKi) :: DT_high = 0.0_R8Ki !< High-resolution time step [seconds] + REAL(DbKi) :: TMax = 0.0_R8Ki !< Total run time [seconds] + INTEGER(IntKi) :: n_high_low = 0_IntKi !< Number of high-resolution time steps per low-resolution time step [-] + INTEGER(IntKi) :: NumTurbines = 0_IntKi !< Number of turbines in the simulation [-] + CHARACTER(1024) :: WindFilePath = '' !< Path name of wind data files from ABLSolver precursor [-] + CHARACTER(1024) :: SC_FileName = '' !< Name/location of the dynamic library {.dll [Windows] or .so [Linux]} containing the Super Controller algorithms [-] + LOGICAL :: UseSC = .false. !< Use a super controller? [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WT_Position !< X-Y-Z position of each wind turbine; index 1 = XYZ; index 2 = turbine number [meters] - INTEGER(IntKi) :: WaveFieldMod !< Wave field handling (-) (switch) {0: use individual HydroDyn inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin} [-] - INTEGER(IntKi) :: MooringMod !< Mod_SharedMooring is a flag for array-level mooring. (switch) {0: none, 3: yes/MoorDyn} [-] - CHARACTER(1024) :: MD_FileName !< Name/location of the farm-level MoorDyn input file [-] - REAL(DbKi) :: DT_mooring !< Time step for farm-levem mooring coupling with each turbine [used only when Mod_SharedMooring > 0] [seconds] - INTEGER(IntKi) :: n_mooring !< Number of FAST and MoorDyn time steps per FAST.Farm timestep when mooring > 0 [-] + INTEGER(IntKi) :: WaveFieldMod = 0_IntKi !< Wave field handling (-) (switch) {0: use individual HydroDyn inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin} [-] + INTEGER(IntKi) :: MooringMod = 0_IntKi !< Mod_SharedMooring is a flag for array-level mooring. (switch) {0: none, 3: yes/MoorDyn} [-] + CHARACTER(1024) :: MD_FileName = '' !< Name/location of the farm-level MoorDyn input file [-] + REAL(DbKi) :: DT_mooring = 0.0_R8Ki !< Time step for farm-levem mooring coupling with each turbine [used only when Mod_SharedMooring > 0] [seconds] + INTEGER(IntKi) :: n_mooring = 0_IntKi !< Number of FAST and MoorDyn time steps per FAST.Farm timestep when mooring > 0 [-] CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: WT_FASTInFile !< Name of input file for each turbine [-] - CHARACTER(1024) :: FTitle !< The description line from the primary FAST.Farm input file [-] - CHARACTER(1024) :: OutFileRoot !< The root name derived from the primary FAST.Farm input file [-] - INTEGER(IntKi) :: n_ChkptTime !< Number of time steps between writing checkpoint files [-] - REAL(DbKi) :: TStart !< Time to begin tabular output [s] - INTEGER(IntKi) :: n_TMax !< Number of the time step of TMax (the end time of the simulation) [-] - LOGICAL :: SumPrint !< Print summary data to file? (.sum) [-] - LOGICAL :: WrBinOutFile !< Write a binary output file? (.outb) [-] - LOGICAL :: WrTxtOutFile !< Write a text (formatted) output file? (.out) [-] - CHARACTER(1) :: Delim !< Delimiter between columns of text output file (.out): space or tab [-] - CHARACTER(20) :: OutFmt !< Format used for text tabular output (except time); resulting field should be 10 characters [-] - CHARACTER(20) :: OutFmt_t !< Format used for time channel in text tabular output; resulting field should be 10 characters [-] - INTEGER(IntKi) :: FmtWidth !< width of the time OutFmt specifier [-] - INTEGER(IntKi) :: TChanLen !< width of the time channel [-] - INTEGER(IntKi) :: NOutTurb !< Number of turbines for write output [1 to 9] [-] - INTEGER(IntKi) :: NOutRadii !< Number of radial nodes for wake output for an individual rotor [0 to 20] [-] + CHARACTER(1024) :: FTitle = '' !< The description line from the primary FAST.Farm input file [-] + CHARACTER(1024) :: OutFileRoot = '' !< The root name derived from the primary FAST.Farm input file [-] + INTEGER(IntKi) :: n_ChkptTime = 0_IntKi !< Number of time steps between writing checkpoint files [-] + REAL(DbKi) :: TStart = 0.0_R8Ki !< Time to begin tabular output [s] + INTEGER(IntKi) :: n_TMax = 0_IntKi !< Number of the time step of TMax (the end time of the simulation) [-] + LOGICAL :: SumPrint = .false. !< Print summary data to file? (.sum) [-] + LOGICAL :: WrBinOutFile = .false. !< Write a binary output file? (.outb) [-] + LOGICAL :: WrTxtOutFile = .false. !< Write a text (formatted) output file? (.out) [-] + CHARACTER(1) :: Delim = '' !< Delimiter between columns of text output file (.out): space or tab [-] + CHARACTER(20) :: OutFmt = '' !< Format used for text tabular output (except time); resulting field should be 10 characters [-] + CHARACTER(20) :: OutFmt_t = '' !< Format used for time channel in text tabular output; resulting field should be 10 characters [-] + INTEGER(IntKi) :: FmtWidth = 0_IntKi !< width of the time OutFmt specifier [-] + INTEGER(IntKi) :: TChanLen = 0_IntKi !< width of the time channel [-] + INTEGER(IntKi) :: NOutTurb = 0_IntKi !< Number of turbines for write output [1 to 9] [-] + INTEGER(IntKi) :: NOutRadii = 0_IntKi !< Number of radial nodes for wake output for an individual rotor [0 to 20] [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: OutRadii !< List of radial nodes for wake output for an individual rotor [1 to NOutRadii] [-] - INTEGER(IntKi) :: NOutDist !< Number of downstream distances for wake output for an individual rotor [0 to 9] [-] + INTEGER(IntKi) :: NOutDist = 0_IntKi !< Number of downstream distances for wake output for an individual rotor [0 to 9] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: OutDist !< List of downstream distances for wake output for an individual rotor [1 to NOutDist] [meters] - INTEGER(IntKi) :: NWindVel !< Number of points for wind output [0 to 9] [-] + INTEGER(IntKi) :: NWindVel = 0_IntKi !< Number of points for wind output [0 to 9] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WindVelX !< List of coordinates in the X direction for wind output [1 to NWindVel] [meters] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WindVelY !< List of coordinates in the Y direction for wind output [1 to NWindVel] [meters] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WindVelZ !< List of coordinates in the Z direction for wind output [1 to NWindVel] [meters] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] - INTEGER(IntKi) :: NumOuts !< Number of user-requested outputs [-] - INTEGER(IntKi) :: NOutSteps !< Maximum number of output steps [-] - CHARACTER(1024) , DIMENSION(1:3) :: FileDescLines !< File Description lines [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of user-requested outputs [-] + INTEGER(IntKi) :: NOutSteps = 0_IntKi !< Maximum number of output steps [-] + CHARACTER(1024) , DIMENSION(1:3) :: FileDescLines = '' !< File Description lines [-] TYPE(ProgDesc) , DIMENSION(1:NumModules) :: Module_Ver !< Version information from all modules [-] - INTEGER(IntKi) :: UnOu !< File unit for Fast.Farm output data [-] - REAL(ReKi) :: dX_low !< The spacing of the low-resolution nodes in X direction [m] - REAL(ReKi) :: dY_low !< The spacing of the low-resolution nodes in Y direction [m] - REAL(ReKi) :: dZ_low !< The spacing of the low-resolution nodes in Z direction [m] - INTEGER(IntKi) :: nX_low !< Number of low-resolution spatial nodes in X direction [-] - INTEGER(IntKi) :: nY_low !< Number of low-resolution spatial nodes in Y direction [-] - INTEGER(IntKi) :: nZ_low !< Number of low-resolution spatial nodes in Z direction [-] - REAL(ReKi) :: X0_low !< X-component of the origin of the low-resolution spatial domain [m] - REAL(ReKi) :: Y0_low !< Y-component of the origin of the low-resolution spatial domain [m] - REAL(ReKi) :: Z0_low !< Z-component of the origin of the low-resolution spatial domain [m] + INTEGER(IntKi) :: UnOu = 0_IntKi !< File unit for Fast.Farm output data [-] + REAL(ReKi) :: dX_low = 0.0_ReKi !< The spacing of the low-resolution nodes in X direction [m] + REAL(ReKi) :: dY_low = 0.0_ReKi !< The spacing of the low-resolution nodes in Y direction [m] + REAL(ReKi) :: dZ_low = 0.0_ReKi !< The spacing of the low-resolution nodes in Z direction [m] + INTEGER(IntKi) :: nX_low = 0_IntKi !< Number of low-resolution spatial nodes in X direction [-] + INTEGER(IntKi) :: nY_low = 0_IntKi !< Number of low-resolution spatial nodes in Y direction [-] + INTEGER(IntKi) :: nZ_low = 0_IntKi !< Number of low-resolution spatial nodes in Z direction [-] + REAL(ReKi) :: X0_low = 0.0_ReKi !< X-component of the origin of the low-resolution spatial domain [m] + REAL(ReKi) :: Y0_low = 0.0_ReKi !< Y-component of the origin of the low-resolution spatial domain [m] + REAL(ReKi) :: Z0_low = 0.0_ReKi !< Z-component of the origin of the low-resolution spatial domain [m] END TYPE Farm_ParameterType ! ======================= ! ========= Farm_MiscVarType ======= @@ -105,7 +105,7 @@ MODULE FAST_Farm_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AllOuts !< An array holding the value of all of the calculated (not only selected) output channels [see OutListParameters.xlsx spreadsheet] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: TimeData !< Array to contain the time output data for the binary file (first output time and a time [fixed] increment) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AllOutData !< Array to contain all the output data (time history of all outputs); Index 1 is NumOuts, Index 2 is Time step [-] - INTEGER(IntKi) :: n_Out !< Time index into the AllOutData array [-] + INTEGER(IntKi) :: n_Out = 0_IntKi !< Time index into the AllOutData array [-] TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: FWrap_2_MD !< Map platform kinematics from each FAST instance to MD [-] TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: MD_2_FWrap !< Map MD loads at the array level to each FAST instance [-] END TYPE Farm_MiscVarType @@ -157,7 +157,7 @@ MODULE FAST_Farm_Types TYPE(SC_OtherStateType) :: OtherState !< Other states [-] TYPE(SC_ParameterType) :: p !< Parameters [-] TYPE(SC_InputType) :: uInputs !< System inputs [-] - REAL(DbKi) , DIMENSION(1:1) :: utimes !< Current time [s] + REAL(DbKi) , DIMENSION(1:1) :: utimes = 0.0_R8Ki !< Current time [s] TYPE(SC_OutputType) :: y !< System outputs [-] TYPE(SC_MiscVarType) :: m !< Misc/optimization variables [-] LOGICAL :: IsInitialized = .FALSE. !< Has SC_Init been called [-] diff --git a/modules/aerodyn/src/AeroAcoustics_Types.f90 b/modules/aerodyn/src/AeroAcoustics_Types.f90 index 01c385f93b..a68c9e3fcd 100644 --- a/modules/aerodyn/src/AeroAcoustics_Types.f90 +++ b/modules/aerodyn/src/AeroAcoustics_Types.f90 @@ -36,22 +36,22 @@ MODULE AeroAcoustics_Types IMPLICIT NONE ! ========= AA_BladePropsType ======= TYPE, PUBLIC :: AA_BladePropsType - REAL(ReKi) :: TEThick !< [-] - REAL(ReKi) :: TEAngle !< [-] + REAL(ReKi) :: TEThick = 0.0_ReKi !< [-] + REAL(ReKi) :: TEAngle = 0.0_ReKi !< [-] END TYPE AA_BladePropsType ! ======================= ! ========= AA_InitInputType ======= TYPE, PUBLIC :: AA_InitInputType - CHARACTER(1024) :: InputFile !< Name of the input file [-] - INTEGER(IntKi) :: NumBlades !< Number of blades on the turbine [-] - INTEGER(IntKi) :: NumBlNds !< Number of blade nodes [-] - CHARACTER(1024) :: RootName !< RootName for writing output files [-] + CHARACTER(1024) :: InputFile = '' !< Name of the input file [-] + INTEGER(IntKi) :: NumBlades = 0_IntKi !< Number of blades on the turbine [-] + INTEGER(IntKi) :: NumBlNds = 0_IntKi !< Number of blade nodes [-] + CHARACTER(1024) :: RootName = '' !< RootName for writing output files [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlSpn !< Span at blade node [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlChord !< Chord at blade node [m] - REAL(ReKi) :: AirDens !< Air density [kg/m^3] - REAL(ReKi) :: KinVisc !< Kinematic air viscosity [m^2/s] - REAL(ReKi) :: SpdSound !< Speed of sound [m/s] - REAL(ReKi) :: HubHeight !< Hub Height [m] + REAL(ReKi) :: AirDens = 0.0_ReKi !< Air density [kg/m^3] + REAL(ReKi) :: KinVisc = 0.0_ReKi !< Kinematic air viscosity [m^2/s] + REAL(ReKi) :: SpdSound = 0.0_ReKi !< Speed of sound [m/s] + REAL(ReKi) :: HubHeight = 0.0_ReKi !< Hub Height [m] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: BlAFID !< Index of airfoil data file for blade node location [array of numBladeNodes by numBlades] [-] TYPE(AFI_ParameterType) , DIMENSION(:), ALLOCATABLE :: AFInfo !< Airfoil information structure containing the aerodynamic center and airfoil shape coordinates [-] END TYPE AA_InitInputType @@ -66,39 +66,39 @@ MODULE AeroAcoustics_Types CHARACTER(25) , DIMENSION(:), ALLOCATABLE :: WriteOutputUntSep !< Units of the output-to-file channels [-] CHARACTER(25) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdrNodes !< Names of the output-to-file channels [-] CHARACTER(25) , DIMENSION(:), ALLOCATABLE :: WriteOutputUntNodes !< Units of the output-to-file channels [-] - character(1) :: delim !< column delimiter [-] + character(1) :: delim = '' !< column delimiter [-] TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] - REAL(ReKi) :: AirDens !< Air density [kg/m^3] + REAL(ReKi) :: AirDens = 0.0_ReKi !< Air density [kg/m^3] END TYPE AA_InitOutputType ! ======================= ! ========= AA_InputFile ======= TYPE, PUBLIC :: AA_InputFile - REAL(DbKi) :: DT_AA !< Time interval for aerodynamic calculations {or "default"} [s] - INTEGER(IntKi) :: IBLUNT !< FLAG TO COMPUTE BLUNTNESS NOISE [-] - INTEGER(IntKi) :: ILAM !< FLAG TO COMPUTE LBL NOISE {1=steady model, 2=Beddoes-Leishman unsteady model} [-] - INTEGER(IntKi) :: ITIP !< FLAG TO COMPUTE TIP NOISE {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] - INTEGER(IntKi) :: ITRIP !< FLAG TO TRIP BOUNDARY LAYER {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] - INTEGER(IntKi) :: ITURB !< FLAG TO COMPUTE TBLTE NOISE {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] - INTEGER(IntKi) :: IInflow !< FLAG TO COMPUTE Turbulent Inflow NOISE {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] - INTEGER(IntKi) :: X_BLMethod !< Integer describing calculation method for boundary layer properties, = 1 BPM = 2 Pretabulated [-] - INTEGER(IntKi) :: TICalcMeth !< TICalcMeth [-] - INTEGER(IntKi) :: NReListBL !< Number of values of ReListBL [-] - LOGICAL :: aweightflag !< Integer a weighting call [-] - LOGICAL :: ROUND !< LOGICAL INDICATING ROUNDED TIP [-] - REAL(ReKi) :: ALPRAT !< TIP LIFT CURVE SLOPE [-] - INTEGER(IntKi) :: AA_Bl_Prcntge !< see the AeroAcoustics input file for description [-] - INTEGER(IntKi) :: NrObsLoc !< Number of observer locations [-] + REAL(DbKi) :: DT_AA = 0.0_R8Ki !< Time interval for aerodynamic calculations {or "default"} [s] + INTEGER(IntKi) :: IBLUNT = 0_IntKi !< FLAG TO COMPUTE BLUNTNESS NOISE [-] + INTEGER(IntKi) :: ILAM = 0_IntKi !< FLAG TO COMPUTE LBL NOISE {1=steady model, 2=Beddoes-Leishman unsteady model} [-] + INTEGER(IntKi) :: ITIP = 0_IntKi !< FLAG TO COMPUTE TIP NOISE {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] + INTEGER(IntKi) :: ITRIP = 0_IntKi !< FLAG TO TRIP BOUNDARY LAYER {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] + INTEGER(IntKi) :: ITURB = 0_IntKi !< FLAG TO COMPUTE TBLTE NOISE {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] + INTEGER(IntKi) :: IInflow = 0_IntKi !< FLAG TO COMPUTE Turbulent Inflow NOISE {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] + INTEGER(IntKi) :: X_BLMethod = 0_IntKi !< Integer describing calculation method for boundary layer properties, = 1 BPM = 2 Pretabulated [-] + INTEGER(IntKi) :: TICalcMeth = 0_IntKi !< TICalcMeth [-] + INTEGER(IntKi) :: NReListBL = 0_IntKi !< Number of values of ReListBL [-] + LOGICAL :: aweightflag = .false. !< Integer a weighting call [-] + LOGICAL :: ROUND = .false. !< LOGICAL INDICATING ROUNDED TIP [-] + REAL(ReKi) :: ALPRAT = 0.0_ReKi !< TIP LIFT CURVE SLOPE [-] + INTEGER(IntKi) :: AA_Bl_Prcntge = 0_IntKi !< see the AeroAcoustics input file for description [-] + INTEGER(IntKi) :: NrObsLoc = 0_IntKi !< Number of observer locations [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ObsX !< Observer location in tower-base coordinate X horizontal [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ObsY !< Observer location in tower-base coordinate Y lateral [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ObsZ !< Observer location in tower-base coordinate Z vertical [m] TYPE(AA_BladePropsType) , DIMENSION(:), ALLOCATABLE :: BladeProps !< blade property information from blade input files [-] - INTEGER(IntKi) :: NrOutFile !< Nr of output files [-] + INTEGER(IntKi) :: NrOutFile = 0_IntKi !< Nr of output files [-] CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: AAoutfile !< AAoutfile for writing output files [-] - CHARACTER(1024) :: TICalcTabFile !< Name of the file containing the table for incident turbulence intensity [-] - CHARACTER(1024) :: FTitle !< File Title: the 2nd line of the input file, which contains a description of its contents [-] - REAL(DbKi) :: AAStart !< Time after which to calculate AA [s] - REAL(ReKi) :: Lturb !< Turbulent lengthscale in Amiet model [-] - REAL(ReKi) :: AvgV !< Average wind speed to compute incident turbulence intensity [m] + CHARACTER(1024) :: TICalcTabFile = '' !< Name of the file containing the table for incident turbulence intensity [-] + CHARACTER(1024) :: FTitle = '' !< File Title: the 2nd line of the input file, which contains a description of its contents [-] + REAL(DbKi) :: AAStart = 0.0_R8Ki !< Time after which to calculate AA [s] + REAL(ReKi) :: Lturb = 0.0_ReKi !< Turbulent lengthscale in Amiet model [-] + REAL(ReKi) :: AvgV = 0.0_ReKi !< Average wind speed to compute incident turbulence intensity [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ReListBL !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AoAListBL !< [deg] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Pres_DispThick !< [-] @@ -110,13 +110,13 @@ MODULE AeroAcoustics_Types REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Pres_EdgeVelRat !< [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Suct_EdgeVelRat !< [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TI_Grid_In !< [-] - REAL(ReKi) :: dz_turb_in !< [m] - REAL(ReKi) :: dy_turb_in !< [m] + REAL(ReKi) :: dz_turb_in = 0.0_ReKi !< [m] + REAL(ReKi) :: dy_turb_in = 0.0_ReKi !< [m] END TYPE AA_InputFile ! ======================= ! ========= AA_ContinuousStateType ======= TYPE, PUBLIC :: AA_ContinuousStateType - REAL(SiKi) :: DummyContState !< Remove this variable if you have continuous states [-] + REAL(SiKi) :: DummyContState = 0.0_R4Ki !< Remove this variable if you have continuous states [-] END TYPE AA_ContinuousStateType ! ======================= ! ========= AA_DiscreteStateType ======= @@ -136,12 +136,12 @@ MODULE AeroAcoustics_Types ! ======================= ! ========= AA_ConstraintStateType ======= TYPE, PUBLIC :: AA_ConstraintStateType - REAL(SiKi) :: DummyConstrState !< Remove this variable if you have states [-] + REAL(SiKi) :: DummyConstrState = 0.0_R4Ki !< Remove this variable if you have states [-] END TYPE AA_ConstraintStateType ! ======================= ! ========= AA_OtherStateType ======= TYPE, PUBLIC :: AA_OtherStateType - REAL(SiKi) :: DummyOtherState !< Remove this variable if you have states [-] + REAL(SiKi) :: DummyOtherState = 0.0_R4Ki !< Remove this variable if you have states [-] END TYPE AA_OtherStateType ! ======================= ! ========= AA_MiscVarType ======= @@ -154,7 +154,7 @@ MODULE AeroAcoustics_Types REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: rTEtoObserve !< C [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: rLEtoObserve !< C [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: LE_Location !< Height of Leading Edge for calculation of TI and Scales if needed [-] - REAL(ReKi) :: RotSpeedAoA !< C [-] + REAL(ReKi) :: RotSpeedAoA = 0.0_ReKi !< C [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SPLLBL !< C [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SPLP !< C [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SPLS !< C [-] @@ -168,67 +168,67 @@ MODULE AeroAcoustics_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: d99Var !< BL Output [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dStarVar !< BL Output [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: EdgeVelVar !< BL Output [-] - INTEGER(IntKi) :: speccou !< Secptrum counter every XX seconds new spectrum [-] - INTEGER(IntKi) :: filesopen !< check if file is open [-] + INTEGER(IntKi) :: speccou = 0_IntKi !< Secptrum counter every XX seconds new spectrum [-] + INTEGER(IntKi) :: filesopen = 0_IntKi !< check if file is open [-] END TYPE AA_MiscVarType ! ======================= ! ========= AA_ParameterType ======= TYPE, PUBLIC :: AA_ParameterType - REAL(DbKi) :: DT !< Time step for continuous state integration & discrete state update [seconds] - INTEGER(IntKi) :: IBLUNT !< Bluntness noise model [-] - INTEGER(IntKi) :: ILAM !< LBL noise model [-] - INTEGER(IntKi) :: ITIP !< Tip noise model [-] - INTEGER(IntKi) :: ITRIP !< Trip boundary layer [-] - INTEGER(IntKi) :: ITURB !< Tblte noise model [-] - INTEGER(IntKi) :: IInflow !< Turbulent inflow noise model [-] - INTEGER(IntKi) :: X_BLMethod !< Integer describing calculation method for boundary layer properties, = 1 BPM = 2 Pretabulated [-] - INTEGER(IntKi) :: TICalcMeth !< [-] - LOGICAL :: ROUND !< Logical indicating rounded tip [-] - REAL(ReKi) :: ALPRAT !< TIP LIFT CURVE SLOPE [-] - INTEGER(IntKi) :: NumBlades !< Number of blades on the turbine [-] - INTEGER(IntKi) :: NumBlNds !< Number of nodes on each blade [-] - REAL(ReKi) :: AirDens !< Air density [kg/m^3] - REAL(ReKi) :: KinVisc !< Kinematic air viscosity [m^2/s] - REAL(ReKi) :: SpdSound !< Speed of sound [m/s] - REAL(ReKi) :: HubHeight !< Hub height [m] - REAL(ReKi) :: toptip !< Top Tip Height = Hub height plus radius [m] - REAL(ReKi) :: bottip !< Bottom Tip Height = Hub height minus radius [m] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for continuous state integration & discrete state update [seconds] + INTEGER(IntKi) :: IBLUNT = 0_IntKi !< Bluntness noise model [-] + INTEGER(IntKi) :: ILAM = 0_IntKi !< LBL noise model [-] + INTEGER(IntKi) :: ITIP = 0_IntKi !< Tip noise model [-] + INTEGER(IntKi) :: ITRIP = 0_IntKi !< Trip boundary layer [-] + INTEGER(IntKi) :: ITURB = 0_IntKi !< Tblte noise model [-] + INTEGER(IntKi) :: IInflow = 0_IntKi !< Turbulent inflow noise model [-] + INTEGER(IntKi) :: X_BLMethod = 0_IntKi !< Integer describing calculation method for boundary layer properties, = 1 BPM = 2 Pretabulated [-] + INTEGER(IntKi) :: TICalcMeth = 0_IntKi !< [-] + LOGICAL :: ROUND = .false. !< Logical indicating rounded tip [-] + REAL(ReKi) :: ALPRAT = 0.0_ReKi !< TIP LIFT CURVE SLOPE [-] + INTEGER(IntKi) :: NumBlades = 0_IntKi !< Number of blades on the turbine [-] + INTEGER(IntKi) :: NumBlNds = 0_IntKi !< Number of nodes on each blade [-] + REAL(ReKi) :: AirDens = 0.0_ReKi !< Air density [kg/m^3] + REAL(ReKi) :: KinVisc = 0.0_ReKi !< Kinematic air viscosity [m^2/s] + REAL(ReKi) :: SpdSound = 0.0_ReKi !< Speed of sound [m/s] + REAL(ReKi) :: HubHeight = 0.0_ReKi !< Hub height [m] + REAL(ReKi) :: toptip = 0.0_ReKi !< Top Tip Height = Hub height plus radius [m] + REAL(ReKi) :: bottip = 0.0_ReKi !< Bottom Tip Height = Hub height minus radius [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rotorregionlimitsVert !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rotorregionlimitsHorz !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rotorregionlimitsalph !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rotorregionlimitsrad !< [-] - INTEGER(IntKi) :: NrObsLoc !< Number of observer locations [-] - LOGICAL :: aweightflag !< [-] - LOGICAL :: TxtFileOutput !< [-] - REAL(DbKi) :: AAStart !< Time after which to calculate AA [s] + INTEGER(IntKi) :: NrObsLoc = 0_IntKi !< Number of observer locations [-] + LOGICAL :: aweightflag = .false. !< [-] + LOGICAL :: TxtFileOutput = .false. !< [-] + REAL(DbKi) :: AAStart = 0.0_R8Ki !< Time after which to calculate AA [s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ObsX !< Observer location in tower-base coordinate X horizontal [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ObsY !< Observer location in tower-base coordinate Y lateral [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ObsZ !< Observer location in tower-base coordinate Z vertical [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FreqList !< List of Acoustic Frequencies to Calculate [Hz] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Aweight !< List of Acoustic Frequencies a weighting [dB] - REAL(ReKi) :: Fsample !< Sampling Frequency 1/delta(t) - 1/(simulation time step) [Hz] - INTEGER(IntKi) :: total_sample !< Total FFT Sample amount for dissipation calculation [-] - INTEGER(IntKi) :: total_sampleTI !< Total FFT Sample amount for dissipation calculation [-] - INTEGER(IntKi) :: AA_Bl_Prcntge !< The Percentage of the Blade which the noise is calculated [%] - INTEGER(IntKi) :: startnode !< Corersponding node to the noise calculation percentage of the blade [-] - REAL(ReKi) :: Lturb !< Turbulent lengthscale in Amiet model [m] - REAL(ReKi) :: AvgV !< Average wind speed to compute incident turbulence intensity [m] - REAL(ReKi) :: dz_turb_in !< [m] - REAL(ReKi) :: dy_turb_in !< [m] + REAL(ReKi) :: Fsample = 0.0_ReKi !< Sampling Frequency 1/delta(t) - 1/(simulation time step) [Hz] + INTEGER(IntKi) :: total_sample = 0_IntKi !< Total FFT Sample amount for dissipation calculation [-] + INTEGER(IntKi) :: total_sampleTI = 0_IntKi !< Total FFT Sample amount for dissipation calculation [-] + INTEGER(IntKi) :: AA_Bl_Prcntge = 0_IntKi !< The Percentage of the Blade which the noise is calculated [%] + INTEGER(IntKi) :: startnode = 0_IntKi !< Corersponding node to the noise calculation percentage of the blade [-] + REAL(ReKi) :: Lturb = 0.0_ReKi !< Turbulent lengthscale in Amiet model [m] + REAL(ReKi) :: AvgV = 0.0_ReKi !< Average wind speed to compute incident turbulence intensity [m] + REAL(ReKi) :: dz_turb_in = 0.0_ReKi !< [m] + REAL(ReKi) :: dy_turb_in = 0.0_ReKi !< [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TI_Grid_In !< [-] - CHARACTER(1024) :: FTitle !< File Title: the 2nd line of the input file, which contains a description of its contents [-] - character(20) :: outFmt !< Format specifier [-] - INTEGER(IntKi) :: NrOutFile !< Nr of output files [-] - character(1) :: delim !< column delimiter [-] - INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] - INTEGER(IntKi) :: NumOutsForPE !< Number of parameters in the output list (number of outputs requested) [-] - INTEGER(IntKi) :: NumOutsForSep !< Number of parameters in the output list (number of outputs requested) [-] - INTEGER(IntKi) :: NumOutsForNodes !< Number of parameters in the output list (number of outputs requested) [-] - INTEGER(IntKi) :: unOutFile !< unit number for writing output file [-] - INTEGER(IntKi) :: unOutFile2 !< unit number for writing output file [-] - INTEGER(IntKi) :: unOutFile3 !< unit number for writing output file [-] - INTEGER(IntKi) :: unOutFile4 !< unit number for writing output file [-] - CHARACTER(1024) :: RootName !< RootName for writing output files [-] + CHARACTER(1024) :: FTitle = '' !< File Title: the 2nd line of the input file, which contains a description of its contents [-] + character(20) :: outFmt = '' !< Format specifier [-] + INTEGER(IntKi) :: NrOutFile = 0_IntKi !< Nr of output files [-] + character(1) :: delim = '' !< column delimiter [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] + INTEGER(IntKi) :: NumOutsForPE = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] + INTEGER(IntKi) :: NumOutsForSep = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] + INTEGER(IntKi) :: NumOutsForNodes = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] + INTEGER(IntKi) :: unOutFile = 0_IntKi !< unit number for writing output file [-] + INTEGER(IntKi) :: unOutFile2 = 0_IntKi !< unit number for writing output file [-] + INTEGER(IntKi) :: unOutFile3 = 0_IntKi !< unit number for writing output file [-] + INTEGER(IntKi) :: unOutFile4 = 0_IntKi !< unit number for writing output file [-] + CHARACTER(1024) :: RootName = '' !< RootName for writing output files [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: StallStart !< ation [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TEThick !< ation [-] diff --git a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 index 38e6e53df1..f31f069dc6 100644 --- a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 @@ -37,104 +37,104 @@ MODULE AeroDyn_Driver_Types IMPLICIT NONE ! ========= Dvr_Case ======= TYPE, PUBLIC :: Dvr_Case - REAL(ReKi) :: HWindSpeed !< Hub wind speed [m/s] - REAL(ReKi) :: PLExp !< Power law wind-shear exponent [-] - REAL(ReKi) :: rotSpeed !< Rotor speed [rad/s] - REAL(ReKi) :: bldPitch !< Pitch angle [rad] - REAL(ReKi) :: nacYaw !< Yaw angle [rad] - REAL(DbKi) :: tMax !< Max time [s] - REAL(DbKi) :: dT !< time increment [s] - INTEGER(IntKi) :: numSteps !< number of steps in this case [-] - INTEGER(IntKi) :: DOF !< Degree of freedom for sinusoidal motion [-] - REAL(ReKi) :: amplitude !< Amplitude for sinusoidal motion (when DOF>0) [-] - REAL(ReKi) :: frequency !< Frequency for sinusoidal motion (when DOF>0) [-] + REAL(ReKi) :: HWindSpeed = 0.0_ReKi !< Hub wind speed [m/s] + REAL(ReKi) :: PLExp = 0.0_ReKi !< Power law wind-shear exponent [-] + REAL(ReKi) :: rotSpeed = 0.0_ReKi !< Rotor speed [rad/s] + REAL(ReKi) :: bldPitch = 0.0_ReKi !< Pitch angle [rad] + REAL(ReKi) :: nacYaw = 0.0_ReKi !< Yaw angle [rad] + REAL(DbKi) :: tMax = 0.0_R8Ki !< Max time [s] + REAL(DbKi) :: dT = 0.0_R8Ki !< time increment [s] + INTEGER(IntKi) :: numSteps = 0_IntKi !< number of steps in this case [-] + INTEGER(IntKi) :: DOF = 0_IntKi !< Degree of freedom for sinusoidal motion [-] + REAL(ReKi) :: amplitude = 0.0_ReKi !< Amplitude for sinusoidal motion (when DOF>0) [-] + REAL(ReKi) :: frequency = 0.0_ReKi !< Frequency for sinusoidal motion (when DOF>0) [-] END TYPE Dvr_Case ! ======================= ! ========= DvrVTK_SurfaceType ======= TYPE, PUBLIC :: DvrVTK_SurfaceType - INTEGER(IntKi) :: NumSectors !< number of sectors in which to split circles (higher number gives smoother surface) [-] - REAL(SiKi) , DIMENSION(1:3,1:8) :: NacelleBox !< X-Y-Z locations of 8 points that define the nacelle box, relative to the nacelle position [m] - REAL(SiKi) , DIMENSION(1:3,1:8) :: BaseBox !< X-Y-Z locations of 8 points that define the base box [m] + INTEGER(IntKi) :: NumSectors = 0_IntKi !< number of sectors in which to split circles (higher number gives smoother surface) [-] + REAL(SiKi) , DIMENSION(1:3,1:8) :: NacelleBox = 0.0_R4Ki !< X-Y-Z locations of 8 points that define the nacelle box, relative to the nacelle position [m] + REAL(SiKi) , DIMENSION(1:3,1:8) :: BaseBox = 0.0_R4Ki !< X-Y-Z locations of 8 points that define the base box [m] END TYPE DvrVTK_SurfaceType ! ======================= ! ========= Dvr_Outputs ======= TYPE, PUBLIC :: Dvr_Outputs TYPE(ProgDesc) :: AD_ver !< AeroDyn version information [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: unOutFile !< unit number for writing output file for each rotor [-] - INTEGER(IntKi) :: ActualChanLen !< Actual length of channels written to text file (less than or equal to ChanLen) [-] - INTEGER(IntKi) :: nDvrOutputs !< Number of outputs for the driver (without AD and IW) [-] - 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 [-] + INTEGER(IntKi) :: ActualChanLen = 0_IntKi !< Actual length of channels written to text file (less than or equal to ChanLen) [-] + INTEGER(IntKi) :: nDvrOutputs = 0_IntKi !< Number of outputs for the driver (without AD and IW) [-] + character(20) :: Fmt_t = '' !< Format specifier for time channel [-] + character(25) :: Fmt_a = '' !< Format specifier for each column (including delimiter) [-] + character(1) :: delim = '' !< column delimiter [-] + character(20) :: outFmt = '' !< Format specifier [-] + INTEGER(IntKi) :: fileFmt = 0_IntKi !< Output format 1=Text, 2=Binary, 3=Both [-] + INTEGER(IntKi) :: wrVTK = 0_IntKi !< 0= no vtk, 1=init only, 2=animation [-] + INTEGER(IntKi) :: WrVTK_Type = 0_IntKi !< Flag for VTK output type (1=surface, 2=line, 3=both) [-] + character(1024) :: Root = '' !< Output file rootname [-] + character(1024) :: VTK_OutFileRoot = '' !< Output file rootname for vtk [-] character(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Channel headers [-] character(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Channel units [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: storage !< nTurbines x nChannel x nTime [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: outLine !< Output line to be written to disk [-] TYPE(DvrVTK_SurfaceType) , DIMENSION(:), ALLOCATABLE :: VTK_surface !< Data for VTK surface visualization [-] - INTEGER(IntKi) :: VTK_tWidth !< Width of number of files for leading zeros in file name format [-] - INTEGER(IntKi) :: n_VTKTime !< Number of time steps between writing VTK files [-] - REAL(SiKi) :: VTKHubRad !< Hub radius for visualization [m] - REAL(ReKi) , DIMENSION(1:6) :: VTKNacDim !< Nacelle dimensions for visualization [m] - REAL(SiKi) , DIMENSION(1:3) :: VTKRefPoint !< RefPoint for VTK outputs [-] - REAL(DbKi) :: DT_Outs !< Output time resolution [s] - INTEGER(IntKi) :: n_DT_Out !< Number of time steps between writing a line in the time-marching output files [-] + INTEGER(IntKi) :: VTK_tWidth = 0_IntKi !< Width of number of files for leading zeros in file name format [-] + INTEGER(IntKi) :: n_VTKTime = 0_IntKi !< Number of time steps between writing VTK files [-] + REAL(SiKi) :: VTKHubRad = 0.0_R4Ki !< Hub radius for visualization [m] + REAL(ReKi) , DIMENSION(1:6) :: VTKNacDim = 0.0_ReKi !< Nacelle dimensions for visualization [m] + REAL(SiKi) , DIMENSION(1:3) :: VTKRefPoint = 0.0_R4Ki !< RefPoint for VTK outputs [-] + REAL(DbKi) :: DT_Outs = 0.0_R8Ki !< Output time resolution [s] + INTEGER(IntKi) :: n_DT_Out = 0_IntKi !< Number of time steps between writing a line in the time-marching output files [-] END TYPE Dvr_Outputs ! ======================= ! ========= BladeData ======= TYPE, PUBLIC :: BladeData - REAL(ReKi) :: pitch !< rad [-] - REAL(ReKi) :: pitchSpeed !< rad/s [-] - REAL(ReKi) :: pitchAcc !< rad/s/s [-] - REAL(ReKi) , DIMENSION(1:3) :: origin_h !< [-] - REAL(ReKi) , DIMENSION(1:3) :: orientation_h !< [-] - REAL(ReKi) :: hubRad_bl !< [-] - REAL(DbKi) , DIMENSION(1:3,1:3) :: Rh2bl0 !< Rotation matrix blade 2 hub [-] - INTEGER(IntKi) :: motionType !< [-] - INTEGER(IntKi) :: iMotion !< Stored index to optimize time interpolation [-] + REAL(ReKi) :: pitch = 0.0_ReKi !< rad [-] + REAL(ReKi) :: pitchSpeed = 0.0_ReKi !< rad/s [-] + REAL(ReKi) :: pitchAcc = 0.0_ReKi !< rad/s/s [-] + REAL(ReKi) , DIMENSION(1:3) :: origin_h = 0.0_ReKi !< [-] + REAL(ReKi) , DIMENSION(1:3) :: orientation_h = 0.0_ReKi !< [-] + REAL(ReKi) :: hubRad_bl = 0.0_ReKi !< [-] + REAL(DbKi) , DIMENSION(1:3,1:3) :: Rh2bl0 = 0.0_R8Ki !< Rotation matrix blade 2 hub [-] + INTEGER(IntKi) :: motionType = 0_IntKi !< [-] + INTEGER(IntKi) :: iMotion = 0_IntKi !< Stored index to optimize time interpolation [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: motion !< [-] - character(1024) :: motionFileName !< [-] + 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(1:3) :: origin_n = 0.0_ReKi !< [-] + REAL(ReKi) , DIMENSION(1:3) :: orientation_n = 0.0_ReKi !< [-] + INTEGER(IntKi) :: motionType = 0_IntKi !< [-] + INTEGER(IntKi) :: iMotion = 0_IntKi !< Stored index to optimize time interpolation [-] + REAL(ReKi) :: azimuth = 0.0_ReKi !< rotor position [rad] + REAL(ReKi) :: rotSpeed = 0.0_ReKi !< rotor speed [rad/s] + REAL(ReKi) :: rotAcc = 0.0_ReKi !< rotor acceleration [rad/s/s] + character(1024) :: motionFileName = '' !< [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: motion !< [-] END TYPE HubData ! ======================= ! ========= NacData ======= TYPE, PUBLIC :: NacData - REAL(ReKi) , DIMENSION(1:3) :: origin_t !< [-] - INTEGER(IntKi) :: motionType !< [-] - INTEGER(IntKi) :: iMotion !< Stored index to optimize time interpolation [-] - REAL(ReKi) :: yaw !< rad [rad] - REAL(ReKi) :: yawSpeed !< yawspeed [rad/s] - REAL(ReKi) :: yawAcc !< yawAcceleration [rad/s^2] - character(1024) :: motionFileName !< [-] + REAL(ReKi) , DIMENSION(1:3) :: origin_t = 0.0_ReKi !< [-] + INTEGER(IntKi) :: motionType = 0_IntKi !< [-] + INTEGER(IntKi) :: iMotion = 0_IntKi !< Stored index to optimize time interpolation [-] + REAL(ReKi) :: yaw = 0.0_ReKi !< rad [rad] + REAL(ReKi) :: yawSpeed = 0.0_ReKi !< yawspeed [rad/s] + REAL(ReKi) :: yawAcc = 0.0_ReKi !< yawAcceleration [rad/s^2] + character(1024) :: motionFileName = '' !< [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: motion !< [-] END TYPE NacData ! ======================= ! ========= TwrData ======= TYPE, PUBLIC :: TwrData - REAL(ReKi) , DIMENSION(1:3) :: origin_t !< [-] + REAL(ReKi) , DIMENSION(1:3) :: origin_t = 0.0_ReKi !< [-] END TYPE TwrData ! ======================= ! ========= WTData ======= TYPE, PUBLIC :: WTData - REAL(ReKi) , DIMENSION(1:3) :: originInit !< [-] - REAL(ReKi) , DIMENSION(1:3) :: orientationInit !< [-] + REAL(ReKi) , DIMENSION(1:3) :: originInit = 0.0_ReKi !< [-] + REAL(ReKi) , DIMENSION(1:3) :: orientationInit = 0.0_ReKi !< [-] TYPE(MeshMapType) :: map2twrPt !< Mesh mapping from base to tower [-] TYPE(MeshMapType) :: map2nacPt !< Mesh mapping from base to nacelle [-] TYPE(MeshMapType) :: map2hubPt !< Mesh mapping from Nacelle to hub [-] @@ -143,46 +143,46 @@ MODULE AeroDyn_Driver_Types TYPE(HubData) :: hub !< [-] TYPE(NacData) :: nac !< [-] TYPE(TwrData) :: twr !< [-] - INTEGER(IntKi) :: numBlades !< [-] - LOGICAL :: basicHAWTFormat !< If true simply input HubRad/Pitch/Overhang/Cone, otherwise all turbine inputs [-] - LOGICAL :: hasTower !< [-] - INTEGER(IntKi) :: projMod !< If true simply input HubRad/Pitch/Overhang/Cone, otherwise all turbine inputs [-] - INTEGER(IntKi) :: BEM_Mod !< Switch for different BEM implementations [-] - LOGICAL :: HAWTprojection !< [-] - INTEGER(IntKi) :: motionType !< [-] + INTEGER(IntKi) :: numBlades = 0_IntKi !< [-] + LOGICAL :: basicHAWTFormat = .false. !< If true simply input HubRad/Pitch/Overhang/Cone, otherwise all turbine inputs [-] + LOGICAL :: hasTower = .false. !< [-] + INTEGER(IntKi) :: projMod = 0_IntKi !< If true simply input HubRad/Pitch/Overhang/Cone, otherwise all turbine inputs [-] + INTEGER(IntKi) :: BEM_Mod = 0_IntKi !< Switch for different BEM implementations [-] + LOGICAL :: HAWTprojection = .false. !< [-] + INTEGER(IntKi) :: motionType = 0_IntKi !< [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: motion !< [-] - INTEGER(IntKi) :: iMotion !< Stored index to optimize time interpolation [-] - INTEGER(IntKi) :: degreeOfFreedom !< [-] - REAL(ReKi) :: amplitude !< [-] - REAL(ReKi) :: frequency !< [-] - character(1024) :: motionFileName !< [-] + INTEGER(IntKi) :: iMotion = 0_IntKi !< Stored index to optimize time interpolation [-] + INTEGER(IntKi) :: degreeOfFreedom = 0_IntKi !< [-] + REAL(ReKi) :: amplitude = 0.0_ReKi !< [-] + REAL(ReKi) :: frequency = 0.0_ReKi !< [-] + character(1024) :: motionFileName = '' !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< WriteOutputs of the driver only [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: userSwapArray !< Array to store user data for user-defined functions [-] 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 [-] + character(1024) :: AD_InputFile = '' !< Name of AeroDyn input file [-] + INTEGER(IntKi) :: MHK = 0_IntKi !< MHK turbine type (switch) {0: not an MHK turbine, 1: fixed MHK turbine, 2: floating MHK turbine} [-] + INTEGER(IntKi) :: AnalysisType = 0_IntKi !< 0=Steady Wind, 1=InflowWind [-] + REAL(ReKi) :: FldDens = 0.0_ReKi !< Density of working fluid [kg/m^3] + REAL(ReKi) :: KinVisc = 0.0_ReKi !< Kinematic viscosity of working fluid [m^2/s] + REAL(ReKi) :: SpdSound = 0.0_ReKi !< Speed of sound in working fluid [m/s] + REAL(ReKi) :: Patm = 0.0_ReKi !< Atmospheric pressure [Pa] + REAL(ReKi) :: Pvap = 0.0_ReKi !< Vapour pressure of working fluid [Pa] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [m] + REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Offset between still-water level and mean sea level [m] + INTEGER(IntKi) :: numTurbines = 0_IntKi !< 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 [-] + REAL(DbKi) :: dT = 0.0_R8Ki !< time increment [s] + REAL(DbKi) :: tMax = 0.0_R8Ki !< time increment [s] + INTEGER(IntKi) :: numSteps = 0_IntKi !< number of steps in this case [-] + INTEGER(IntKi) :: numCases = 0_IntKi !< number of steps in this case [-] TYPE(Dvr_Case) , DIMENSION(:), ALLOCATABLE :: Cases !< table of cases to run when AnalysisType=2 [-] - INTEGER(IntKi) :: iCase !< Current Case being run [-] + INTEGER(IntKi) :: iCase = 0_IntKi !< Current Case being run [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: timeSeries !< Times series inputs when AnalysisType=1, 6 columns, Time, WndSpeed, ShearExp, RotSpd, Pitch, Yaw [-] - INTEGER(IntKi) :: iTimeSeries !< Stored index to optimize time interpolation [-] - character(1024) :: root !< Output file rootname [-] + INTEGER(IntKi) :: iTimeSeries = 0_IntKi !< Stored index to optimize time interpolation [-] + character(1024) :: root = '' !< Output file rootname [-] TYPE(Dvr_Outputs) :: out !< data for driver output file [-] TYPE(ADI_IW_InputData) :: IW_InitInp !< [-] END TYPE Dvr_SimData @@ -192,9 +192,9 @@ MODULE AeroDyn_Driver_Types TYPE(Dvr_SimData) :: dvr !< Driver data [-] TYPE(ADI_Data) :: ADI !< AeroDyn InflowWind Data [-] TYPE(FED_Data) :: FED !< Elastic wind turbine data (Fake ElastoDyn) [-] - INTEGER(IntKi) :: errStat !< [-] - character(ErrMsgLen) :: errMsg !< [-] - LOGICAL :: initialized !< [-] + INTEGER(IntKi) :: errStat = 0_IntKi !< [-] + character(ErrMsgLen) :: errMsg = '' !< [-] + LOGICAL :: initialized = .false. !< [-] END TYPE AllData ! ======================= CONTAINS diff --git a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 index c05eed0040..9065873875 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 @@ -45,20 +45,20 @@ MODULE AeroDyn_Inflow_Types TYPE(InflowWind_MiscVarType) :: m !< Misc/optimization variables [-] TYPE(InflowWind_InputType) :: u !< Array of inputs associated with InputTimes [-] TYPE(InflowWind_OutputType) :: y !< System outputs [-] - INTEGER(IntKi) :: CompInflow !< 0=Steady Wind, 1=InflowWind [-] - REAL(ReKi) :: HWindSpeed !< RefHeight Wind speed [-] - REAL(ReKi) :: RefHt !< RefHeight [-] - REAL(ReKi) :: PLExp !< PLExp [-] + INTEGER(IntKi) :: CompInflow = 0_IntKi !< 0=Steady Wind, 1=InflowWind [-] + REAL(ReKi) :: HWindSpeed = 0.0_ReKi !< RefHeight Wind speed [-] + REAL(ReKi) :: RefHt = 0.0_ReKi !< RefHeight [-] + REAL(ReKi) :: PLExp = 0.0_ReKi !< PLExp [-] END TYPE ADI_InflowWindData ! ======================= ! ========= ADI_IW_InputData ======= TYPE, PUBLIC :: ADI_IW_InputData - Character(1024) :: InputFile !< Name of InfloWind input file [-] - INTEGER(IntKi) :: CompInflow !< 0=Steady Wind, 1=InflowWind [-] - REAL(ReKi) :: HWindSpeed !< RefHeight Wind speed [-] - REAL(ReKi) :: RefHt !< RefHeight [-] - REAL(ReKi) :: PLExp !< PLExp [-] - INTEGER(IntKi) :: MHK !< MHK turbine type switch [-] + Character(1024) :: InputFile = '' !< Name of InfloWind input file [-] + INTEGER(IntKi) :: CompInflow = 0_IntKi !< 0=Steady Wind, 1=InflowWind [-] + REAL(ReKi) :: HWindSpeed = 0.0_ReKi !< RefHeight Wind speed [-] + REAL(ReKi) :: RefHt = 0.0_ReKi !< RefHeight [-] + REAL(ReKi) :: PLExp = 0.0_ReKi !< PLExp [-] + INTEGER(IntKi) :: MHK = 0_IntKi !< MHK turbine type switch [-] 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. [-] @@ -68,11 +68,11 @@ MODULE AeroDyn_Inflow_Types 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 [-] + 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) [-] - REAL(ReKi) :: WtrDpth !< Water depth [m] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [m] END TYPE ADI_InitInputType ! ======================= ! ========= ADI_InitOutputType ======= @@ -112,13 +112,13 @@ MODULE AeroDyn_Inflow_Types ! ========= ADI_ParameterType ======= TYPE, PUBLIC :: ADI_ParameterType TYPE(AD_ParameterType) :: AD !< Parameters [-] - REAL(DbKi) :: dt !< time increment [s] - LOGICAL :: storeHHVel !< If True, hub height velocity will be computed by infow wind [-] - INTEGER(IntKi) :: wrVTK !< 0= no vtk, 1=init only, 2=animation [-] - INTEGER(IntKi) :: WrVTK_Type !< Flag for VTK output type (1=surface, 2=line, 3=both) [-] + REAL(DbKi) :: dt = 0.0_R8Ki !< time increment [s] + LOGICAL :: storeHHVel = .false. !< If True, hub height velocity will be computed by infow wind [-] + INTEGER(IntKi) :: wrVTK = 0_IntKi !< 0= no vtk, 1=init only, 2=animation [-] + INTEGER(IntKi) :: WrVTK_Type = 0_IntKi !< Flag for VTK output type (1=surface, 2=line, 3=both) [-] INTEGER(IntKi) :: NumOuts = 0 !< Total number of WriteOutput outputs [-] - INTEGER(IntKi) :: MHK !< MHK turbine type switch [-] - REAL(ReKi) :: WtrDpth !< Water depth [m] + INTEGER(IntKi) :: MHK = 0_IntKi !< MHK turbine type switch [-] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [m] END TYPE ADI_ParameterType ! ======================= ! ========= ADI_InputType ======= @@ -130,7 +130,7 @@ MODULE AeroDyn_Inflow_Types TYPE, PUBLIC :: ADI_OutputType TYPE(AD_OutputType) :: AD !< System outputs [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: HHVel !< Hub Height velocities for each rotors [-] - REAL(ReKi) :: PLExp !< Power law exponents (for outputs only) [-] + REAL(ReKi) :: PLExp = 0.0_ReKi !< Power law exponents (for outputs only) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: IW_WriteOutput !< WriteOutputs for inflow wind [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< System outputs [-] END TYPE ADI_OutputType @@ -159,7 +159,7 @@ MODULE AeroDyn_Inflow_Types TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: BladeLn2Mesh !< (only if elastic blades) BladeLn2Mesh Line mesh along blade [-] LOGICAL :: hasTower = .true. !< True if a tower is present [-] LOGICAL :: rigidBlades = .true. !< True if blades are rigid (using BladeRootMotion) or not (Useing BldeLn2Mesh) [-] - INTEGER(IntKi) :: numBlades !< Number of blades [-] + INTEGER(IntKi) :: numBlades = 0_IntKi !< Number of blades [-] TYPE(MeshMapType) :: ED_P_2_AD_P_T !< (only if hasTower) Mesh mapping from tower base to AD tower base [-] TYPE(MeshMapType) :: AD_P_2_AD_L_T !< (only if hasTower) Mesh mapping from tower base to AD tower line [-] TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: AD_P_2_AD_L_B !< (only for rigid blades) Mesh mapping from AD blade root to AD line mesh [-] diff --git a/modules/aerodyn/src/AirfoilInfo_Types.f90 b/modules/aerodyn/src/AirfoilInfo_Types.f90 index b8cd29debd..905bf50529 100644 --- a/modules/aerodyn/src/AirfoilInfo_Types.f90 +++ b/modules/aerodyn/src/AirfoilInfo_Types.f90 @@ -38,53 +38,53 @@ MODULE AirfoilInfo_Types INTEGER(IntKi), PUBLIC, PARAMETER :: AFITable_2User = 3 ! 2D interpolation on AoA and UserProp [-] ! ========= AFI_UA_BL_Type ======= TYPE, PUBLIC :: AFI_UA_BL_Type - REAL(ReKi) :: alpha0 !< Angle of attack for zero lift (also used in HGM) [input in degrees; stored as radians] - REAL(ReKi) :: alpha1 !< angle of attack at f = 0.7, approximately the stall angle; for alpha >= alpha0 [input in degrees; stored as radians] - REAL(ReKi) :: alpha2 !< angle of attack at f = 0.7, approximately the stall angle; for alpha < alpha0 [input in degrees; stored as radians] - REAL(ReKi) :: eta_e !< Recovery factor in the range [0.85 - 0.95] [-] - REAL(ReKi) :: C_nalpha !< Cn slope for zero lift (used for Beddoes-Leishman unsteady aero) [1/rad] - REAL(ReKi) :: C_lalpha !< Cl slope for zero lift (used for HGM unsteady aero only) -> calculated [1/rad] - REAL(ReKi) :: T_f0 !< initial value of T_f, airfoil specific, used to compute D_f and fprimeprime (also used in HGM) [-] - REAL(ReKi) :: T_V0 !< initial value of T_V, airfoil specific, time parameter associated with the vortex lift decay process, used in Cn_v [-] - REAL(ReKi) :: T_p !< boundary-layer, leading edge pressure gradient time parameter; used in D_p; airfoil specific (also used in HGM) [-] - REAL(ReKi) :: T_VL !< Initial value of the time constant associated with the vortex advection process; it represents the non-dimensional time in semi-chords, needed for a vortex to travel from LE to trailing edge (TE); it is used in the expression of Cvn. It depends on Re, M (weakly), and airfoil. [valid range = 6 - 13] [-] - REAL(ReKi) :: b1 !< airfoil constant derived from experimental results (also used in HGM), usually 0.14 [-] - REAL(ReKi) :: b2 !< airfoil constant derived from experimental results (also used in HGM), usually 0.53 [-] - REAL(ReKi) :: b5 !< airfoil constant derived from experimental results, usually 5.0 [-] - REAL(ReKi) :: A1 !< airfoil constant derived from experimental results (also used in HGM), usually 0.3 [-] - REAL(ReKi) :: A2 !< airfoil constant derived from experimental results (also used in HGM), usually 0.7 [-] - REAL(ReKi) :: A5 !< airfoil constant derived from experimental results, usually 1.0 [-] - REAL(ReKi) :: S1 !< Constant in the f curve best-fit for alpha0<=AOA<=alpha1 [-] - REAL(ReKi) :: S2 !< Constant in the f curve best-fit for AOA> alpha1 [-] - REAL(ReKi) :: S3 !< Constant in the f curve best-fit for alpha2<=AOA< alpha0 [-] - REAL(ReKi) :: S4 !< Constant in the f curve best-fit for AOA< alpha2 [-] - REAL(ReKi) :: Cn1 !< Cn at stall value for positive angle of attack [or critical value of Cn_prime at LE separation for alpha >= alpha0] [-] - REAL(ReKi) :: Cn2 !< Cn at stall value for negative angle of attack [or critical value of Cn_prime at LE separation for alpha < alpha0] [-] - REAL(ReKi) :: St_sh !< Strouhal's shedding frequency constant. [-] - REAL(ReKi) :: Cd0 !< Minimum Cd value [-] - REAL(ReKi) :: Cm0 !< 2D pitching moment coefficient at zero lift, positive if nose is up [-] - REAL(ReKi) :: k0 !< airfoil parameter in the x_cp_hat curve best-fit [ignored if UAMod<>1] [-] - REAL(ReKi) :: k1 !< airfoil parameter in the x_cp_hat curve best-fit [ignored if UAMod<>1] [-] - REAL(ReKi) :: k2 !< airfoil parameter in the x_cp_hat curve best-fit [ignored if UAMod<>1] [-] - REAL(ReKi) :: k3 !< airfoil parameter in the x_cp_hat curve best-fit [ignored if UAMod<>1] [-] - REAL(ReKi) :: k1_hat !< Constant in the expression of Cc due to leading edge vortex effects. [ignored if UAMod<>1] [-] - REAL(ReKi) :: x_cp_bar !< Constant in the expression of \hat(x)_cp^v [ignored if UAMod<>1, default = 0.2] [-] - REAL(ReKi) :: UACutout !< Angle of attack above which unsteady aerodynamics are disabled [input in degrees; stored as radians] - REAL(ReKi) :: UACutout_delta !< Number of angles-of-attack below UACutout where unsteady aerodynamics begin to be disabled [input in degrees; stored as radians] - REAL(ReKi) :: UACutout_blend !< Angle of attack above which unsteady aerodynamics begins to be disabled [stored as radians] - REAL(ReKi) :: filtCutOff !< Reduced frequency cutoff used to calculate the dynamic low pass filter cut-off frequency for the pitching rate and accelerations [default = 0.5] [-] - REAL(ReKi) :: alphaUpper !< (input) upper angle of attack defining fully attached region [input in degrees; stored as radians] - REAL(ReKi) :: alphaLower !< (input) lower angle of attack defining fully attached region [input in degrees; stored as radians] - REAL(ReKi) :: c_Rate !< (calculated) linear slope in the fully attached region of cn or cl [1/rad] - REAL(ReKi) :: c_RateUpper !< (calculated) linear slope in the upper fully attached region of cn or cl [1/rad] - REAL(ReKi) :: c_RateLower !< (calculated) linear slope in the lower fully attached region of cn or cl [1/rad] - REAL(ReKi) :: c_alphaLower !< (calculated) value of cn or cl at alphaLower [-] - REAL(ReKi) :: c_alphaUpper !< (calculated) value of cn or cl at alphaUpper [-] - REAL(ReKi) :: alphaUpperWrap !< (calculated) upper angle of attack defining fully attached wrap-around region [stored as radians] - REAL(ReKi) :: alphaLowerWrap !< (calculated) lower angle of attack defining fully attached wrap-around region [stored as radians] - REAL(ReKi) :: c_RateWrap !< (calculated) linear slope in the fully attached wrap-around region of cn or cl (will be negative) [1/rad] - REAL(ReKi) :: c_alphaLowerWrap !< (calculated) value of cn or cl at alphaLowerWrap [-] - REAL(ReKi) :: c_alphaUpperWrap !< (calculated) value of cn or cl at alphaUpperWrap [-] + REAL(ReKi) :: alpha0 = 0.0_ReKi !< Angle of attack for zero lift (also used in HGM) [input in degrees; stored as radians] + REAL(ReKi) :: alpha1 = 0.0_ReKi !< angle of attack at f = 0.7, approximately the stall angle; for alpha >= alpha0 [input in degrees; stored as radians] + REAL(ReKi) :: alpha2 = 0.0_ReKi !< angle of attack at f = 0.7, approximately the stall angle; for alpha < alpha0 [input in degrees; stored as radians] + REAL(ReKi) :: eta_e = 0.0_ReKi !< Recovery factor in the range [0.85 - 0.95] [-] + REAL(ReKi) :: C_nalpha = 0.0_ReKi !< Cn slope for zero lift (used for Beddoes-Leishman unsteady aero) [1/rad] + REAL(ReKi) :: C_lalpha = 0.0_ReKi !< Cl slope for zero lift (used for HGM unsteady aero only) -> calculated [1/rad] + REAL(ReKi) :: T_f0 = 0.0_ReKi !< initial value of T_f, airfoil specific, used to compute D_f and fprimeprime (also used in HGM) [-] + REAL(ReKi) :: T_V0 = 0.0_ReKi !< initial value of T_V, airfoil specific, time parameter associated with the vortex lift decay process, used in Cn_v [-] + REAL(ReKi) :: T_p = 0.0_ReKi !< boundary-layer, leading edge pressure gradient time parameter; used in D_p; airfoil specific (also used in HGM) [-] + REAL(ReKi) :: T_VL = 0.0_ReKi !< Initial value of the time constant associated with the vortex advection process; it represents the non-dimensional time in semi-chords, needed for a vortex to travel from LE to trailing edge (TE); it is used in the expression of Cvn. It depends on Re, M (weakly), and airfoil. [valid range = 6 - 13] [-] + REAL(ReKi) :: b1 = 0.0_ReKi !< airfoil constant derived from experimental results (also used in HGM), usually 0.14 [-] + REAL(ReKi) :: b2 = 0.0_ReKi !< airfoil constant derived from experimental results (also used in HGM), usually 0.53 [-] + REAL(ReKi) :: b5 = 0.0_ReKi !< airfoil constant derived from experimental results, usually 5.0 [-] + REAL(ReKi) :: A1 = 0.0_ReKi !< airfoil constant derived from experimental results (also used in HGM), usually 0.3 [-] + REAL(ReKi) :: A2 = 0.0_ReKi !< airfoil constant derived from experimental results (also used in HGM), usually 0.7 [-] + REAL(ReKi) :: A5 = 0.0_ReKi !< airfoil constant derived from experimental results, usually 1.0 [-] + REAL(ReKi) :: S1 = 0.0_ReKi !< Constant in the f curve best-fit for alpha0<=AOA<=alpha1 [-] + REAL(ReKi) :: S2 = 0.0_ReKi !< Constant in the f curve best-fit for AOA> alpha1 [-] + REAL(ReKi) :: S3 = 0.0_ReKi !< Constant in the f curve best-fit for alpha2<=AOA< alpha0 [-] + REAL(ReKi) :: S4 = 0.0_ReKi !< Constant in the f curve best-fit for AOA< alpha2 [-] + REAL(ReKi) :: Cn1 = 0.0_ReKi !< Cn at stall value for positive angle of attack [or critical value of Cn_prime at LE separation for alpha >= alpha0] [-] + REAL(ReKi) :: Cn2 = 0.0_ReKi !< Cn at stall value for negative angle of attack [or critical value of Cn_prime at LE separation for alpha < alpha0] [-] + REAL(ReKi) :: St_sh = 0.0_ReKi !< Strouhal's shedding frequency constant. [-] + REAL(ReKi) :: Cd0 = 0.0_ReKi !< Minimum Cd value [-] + REAL(ReKi) :: Cm0 = 0.0_ReKi !< 2D pitching moment coefficient at zero lift, positive if nose is up [-] + REAL(ReKi) :: k0 = 0.0_ReKi !< airfoil parameter in the x_cp_hat curve best-fit [ignored if UAMod<>1] [-] + REAL(ReKi) :: k1 = 0.0_ReKi !< airfoil parameter in the x_cp_hat curve best-fit [ignored if UAMod<>1] [-] + REAL(ReKi) :: k2 = 0.0_ReKi !< airfoil parameter in the x_cp_hat curve best-fit [ignored if UAMod<>1] [-] + REAL(ReKi) :: k3 = 0.0_ReKi !< airfoil parameter in the x_cp_hat curve best-fit [ignored if UAMod<>1] [-] + REAL(ReKi) :: k1_hat = 0.0_ReKi !< Constant in the expression of Cc due to leading edge vortex effects. [ignored if UAMod<>1] [-] + REAL(ReKi) :: x_cp_bar = 0.0_ReKi !< Constant in the expression of \hat(x)_cp^v [ignored if UAMod<>1, default = 0.2] [-] + REAL(ReKi) :: UACutout = 0.0_ReKi !< Angle of attack above which unsteady aerodynamics are disabled [input in degrees; stored as radians] + REAL(ReKi) :: UACutout_delta = 0.0_ReKi !< Number of angles-of-attack below UACutout where unsteady aerodynamics begin to be disabled [input in degrees; stored as radians] + REAL(ReKi) :: UACutout_blend = 0.0_ReKi !< Angle of attack above which unsteady aerodynamics begins to be disabled [stored as radians] + REAL(ReKi) :: filtCutOff = 0.0_ReKi !< Reduced frequency cutoff used to calculate the dynamic low pass filter cut-off frequency for the pitching rate and accelerations [default = 0.5] [-] + REAL(ReKi) :: alphaUpper = 0.0_ReKi !< (input) upper angle of attack defining fully attached region [input in degrees; stored as radians] + REAL(ReKi) :: alphaLower = 0.0_ReKi !< (input) lower angle of attack defining fully attached region [input in degrees; stored as radians] + REAL(ReKi) :: c_Rate = 0.0_ReKi !< (calculated) linear slope in the fully attached region of cn or cl [1/rad] + REAL(ReKi) :: c_RateUpper = 0.0_ReKi !< (calculated) linear slope in the upper fully attached region of cn or cl [1/rad] + REAL(ReKi) :: c_RateLower = 0.0_ReKi !< (calculated) linear slope in the lower fully attached region of cn or cl [1/rad] + REAL(ReKi) :: c_alphaLower = 0.0_ReKi !< (calculated) value of cn or cl at alphaLower [-] + REAL(ReKi) :: c_alphaUpper = 0.0_ReKi !< (calculated) value of cn or cl at alphaUpper [-] + REAL(ReKi) :: alphaUpperWrap = 0.0_ReKi !< (calculated) upper angle of attack defining fully attached wrap-around region [stored as radians] + REAL(ReKi) :: alphaLowerWrap = 0.0_ReKi !< (calculated) lower angle of attack defining fully attached wrap-around region [stored as radians] + REAL(ReKi) :: c_RateWrap = 0.0_ReKi !< (calculated) linear slope in the fully attached wrap-around region of cn or cl (will be negative) [1/rad] + REAL(ReKi) :: c_alphaLowerWrap = 0.0_ReKi !< (calculated) value of cn or cl at alphaLowerWrap [-] + REAL(ReKi) :: c_alphaUpperWrap = 0.0_ReKi !< (calculated) value of cn or cl at alphaUpperWrap [-] END TYPE AFI_UA_BL_Type ! ======================= ! ========= AFI_UA_BL_Default_Type ======= @@ -132,24 +132,24 @@ MODULE AirfoilInfo_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Alpha !< Angle-of-attack vector that matches the Coefs matrix [rad] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Coefs !< Airfoil coefficients for Cd, Cl, and maybe Cm and/or Cpmin [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: SplineCoefs !< Spline coefficients for Cd, Cl, and maybe Cm and/or Cpmin [-] - REAL(ReKi) :: UserProp !< User Property for a table, for example a Control setting [-] - REAL(ReKi) :: Re !< Reynolds number [-] - INTEGER(IntKi) :: NumAlf !< Length of the Alpha and Coefs arrays [-] - LOGICAL :: ConstData !< Flag that tells if aerodynamic coefficients are the same for all alphas [-] - LOGICAL :: InclUAdata !< Flag that tells if UA data is included in the input file [-] + REAL(ReKi) :: UserProp = 0.0_ReKi !< User Property for a table, for example a Control setting [-] + REAL(ReKi) :: Re = 0.0_ReKi !< Reynolds number [-] + INTEGER(IntKi) :: NumAlf = 0_IntKi !< Length of the Alpha and Coefs arrays [-] + LOGICAL :: ConstData = .false. !< Flag that tells if aerodynamic coefficients are the same for all alphas [-] + LOGICAL :: InclUAdata = .false. !< Flag that tells if UA data is included in the input file [-] TYPE(AFI_UA_BL_Type) :: UA_BL !< The tables of Leishman-Beddoes unsteady-aero data for given Re and control setting [-] END TYPE AFI_Table_Type ! ======================= ! ========= AFI_InitInputType ======= TYPE, PUBLIC :: AFI_InitInputType - CHARACTER(1024) :: FileName !< The name of the file the data is read from [-] - INTEGER(IntKi) :: AFTabMod !< Interpolation method for multiple airfoil tables {1 = 1D on AoA (only first table is used); 2 = 2D on AoA and Re; 3 = 2D on AoA and UserProp} [-] - INTEGER(IntKi) :: InCol_Alfa !< The column of the coefficient tables that holds the angle of attack [-] - INTEGER(IntKi) :: InCol_Cl !< The column of the coefficient tables that holds the lift coefficient [-] - INTEGER(IntKi) :: InCol_Cd !< The column of the coefficient tables that holds the minimum pressure coefficient [-] - INTEGER(IntKi) :: InCol_Cm !< The column of the coefficient tables that holds the pitching-moment coefficient [-] - INTEGER(IntKi) :: InCol_Cpmin !< The column of the coefficient tables that holds the minimum pressure coefficient [-] - LOGICAL :: UA_f_cn !< Whether any UA separation functions should be calculated on cn (true) or cl (false) [-] + CHARACTER(1024) :: FileName = '' !< The name of the file the data is read from [-] + INTEGER(IntKi) :: AFTabMod = 0_IntKi !< Interpolation method for multiple airfoil tables {1 = 1D on AoA (only first table is used); 2 = 2D on AoA and Re; 3 = 2D on AoA and UserProp} [-] + INTEGER(IntKi) :: InCol_Alfa = 0_IntKi !< The column of the coefficient tables that holds the angle of attack [-] + INTEGER(IntKi) :: InCol_Cl = 0_IntKi !< The column of the coefficient tables that holds the lift coefficient [-] + INTEGER(IntKi) :: InCol_Cd = 0_IntKi !< The column of the coefficient tables that holds the minimum pressure coefficient [-] + INTEGER(IntKi) :: InCol_Cm = 0_IntKi !< The column of the coefficient tables that holds the pitching-moment coefficient [-] + INTEGER(IntKi) :: InCol_Cpmin = 0_IntKi !< The column of the coefficient tables that holds the minimum pressure coefficient [-] + LOGICAL :: UA_f_cn = .false. !< Whether any UA separation functions should be calculated on cn (true) or cl (false) [-] END TYPE AFI_InitInputType ! ======================= ! ========= AFI_InitOutputType ======= @@ -159,30 +159,30 @@ MODULE AirfoilInfo_Types ! ======================= ! ========= AFI_ParameterType ======= TYPE, PUBLIC :: AFI_ParameterType - INTEGER(IntKi) :: ColCd !< The column in the p%Coefs arrays that contains Cd data [-] - INTEGER(IntKi) :: ColCl !< The column in the p%Coefs arrays that contains Cl data [-] - INTEGER(IntKi) :: ColCm !< The column in the p%Coefs arrays that contains Cm data [-] - INTEGER(IntKi) :: ColCpmin !< The column in the p%Coefs arrays that contains Cpmin data [-] - INTEGER(IntKi) :: ColUAf !< The column in the p%Coefs arrays that contains f_st data (on cl or cn) for UA [-] - INTEGER(IntKi) :: AFTabMod !< Interpolation method for multiple airfoil tables {1 = 1D on AoA (only first table is used); 2 = 2D on AoA and Re; 3 = 2D on AoA and UserProp} [-] + INTEGER(IntKi) :: ColCd = 0_IntKi !< The column in the p%Coefs arrays that contains Cd data [-] + INTEGER(IntKi) :: ColCl = 0_IntKi !< The column in the p%Coefs arrays that contains Cl data [-] + INTEGER(IntKi) :: ColCm = 0_IntKi !< The column in the p%Coefs arrays that contains Cm data [-] + INTEGER(IntKi) :: ColCpmin = 0_IntKi !< The column in the p%Coefs arrays that contains Cpmin data [-] + INTEGER(IntKi) :: ColUAf = 0_IntKi !< The column in the p%Coefs arrays that contains f_st data (on cl or cn) for UA [-] + INTEGER(IntKi) :: AFTabMod = 0_IntKi !< Interpolation method for multiple airfoil tables {1 = 1D on AoA (only first table is used); 2 = 2D on AoA and Re; 3 = 2D on AoA and UserProp} [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: secondVals !< The values of the 2nd dependent variable when using multiple airfoil tables (Re or UserProp, saved in an array so that the logic in the interpolation scheme is cleaner) [-] - INTEGER(IntKi) :: InterpOrd !< Interpolation order [-] - REAL(ReKi) :: RelThickness !< Relative thickness of airfoil thickness/chord [-] - REAL(ReKi) :: NonDimArea !< The non-dimensional area of the airfoil (area/chord^2) [unused] [-] - INTEGER(IntKi) :: NumCoords !< The number of coordinates which define the airfoil shape [-] + INTEGER(IntKi) :: InterpOrd = 0_IntKi !< Interpolation order [-] + REAL(ReKi) :: RelThickness = 0.0_ReKi !< Relative thickness of airfoil thickness/chord [-] + REAL(ReKi) :: NonDimArea = 0.0_ReKi !< The non-dimensional area of the airfoil (area/chord^2) [unused] [-] + INTEGER(IntKi) :: NumCoords = 0_IntKi !< The number of coordinates which define the airfoil shape [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: X_Coord !< X-coordinate for the airfoil shape [unused] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Y_Coord !< Y-coordinate for the airfoil shape [unused] [-] - INTEGER(IntKi) :: NumTabs !< The number of airfoil tables in the airfoil file [-] + INTEGER(IntKi) :: NumTabs = 0_IntKi !< The number of airfoil tables in the airfoil file [-] TYPE(AFI_Table_Type) , DIMENSION(:), ALLOCATABLE :: Table !< The tables of airfoil data for given Re and control setting [-] - CHARACTER(1024) :: BL_file !< The name of the file with the boundary layer data [-] - CHARACTER(1024) :: FileName !< The name of the file that stored this information. [-] + CHARACTER(1024) :: BL_file = '' !< The name of the file with the boundary layer data [-] + CHARACTER(1024) :: FileName = '' !< The name of the file that stored this information. [-] END TYPE AFI_ParameterType ! ======================= ! ========= AFI_InputType ======= TYPE, PUBLIC :: AFI_InputType - REAL(ReKi) :: AoA !< The angle of attack [radians] - REAL(ReKi) :: UserProp !< The user-defined control setting [-] - REAL(ReKi) :: Re !< Reynolds number [-] + REAL(ReKi) :: AoA = 0.0_ReKi !< The angle of attack [radians] + REAL(ReKi) :: UserProp = 0.0_ReKi !< The user-defined control setting [-] + REAL(ReKi) :: Re = 0.0_ReKi !< Reynolds number [-] END TYPE AFI_InputType ! ======================= ! ========= AFI_OutputType ======= diff --git a/modules/aerodyn/src/BEMT_Types.f90 b/modules/aerodyn/src/BEMT_Types.f90 index 055e1071f1..aef0e5b109 100644 --- a/modules/aerodyn/src/BEMT_Types.f90 +++ b/modules/aerodyn/src/BEMT_Types.f90 @@ -46,39 +46,39 @@ MODULE BEMT_Types ! ========= BEMT_InitInputType ======= TYPE, PUBLIC :: BEMT_InitInputType REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: chord !< Chord length at node [m] - INTEGER(IntKi) :: numBlades !< Number of blades [-] - REAL(ReKi) :: airDens !< Air density [kg/m^3] - REAL(ReKi) :: kinVisc !< Kinematic air viscosity [m^2/s] - INTEGER(IntKi) :: skewWakeMod !< Type of skewed-wake correction model [switch] {1=uncoupled, 2=Pitt/Peters, 3=coupled} [-] - REAL(ReKi) :: aTol !< Tolerance for the induction solution [-] - LOGICAL :: useTipLoss !< Use the Prandtl tip-loss model? [flag] [-] - LOGICAL :: useHubLoss !< Use the Prandtl hub-loss model? [flag] [-] - LOGICAL :: useInduction !< Include induction in BEMT calculations [flag] { If FALSE then useTanInd will be set to FALSE} [-] - LOGICAL :: useTanInd !< Include tangential induction in BEMT calculations [flag] [-] - LOGICAL :: useAIDrag !< Include the drag term in the axial-induction calculation? [flag] [-] - LOGICAL :: useTIDrag !< Include the drag term in the tangential-induction calculation? Ignored if TanInd is False. [flag] [-] - LOGICAL :: MomentumCorr !< Momentum Correction {0=Axial Theory, 1 = Glauert Momentum Theory} [-] - INTEGER(IntKi) :: numBladeNodes !< Number of blade nodes used in the analysis [-] - INTEGER(IntKi) :: numReIterations !< Number of iterations for finding the Reynolds number [-] - INTEGER(IntKi) :: maxIndIterations !< Maximum number of iterations of induction factor solve [-] + INTEGER(IntKi) :: numBlades = 0_IntKi !< Number of blades [-] + REAL(ReKi) :: airDens = 0.0_ReKi !< Air density [kg/m^3] + REAL(ReKi) :: kinVisc = 0.0_ReKi !< Kinematic air viscosity [m^2/s] + INTEGER(IntKi) :: skewWakeMod = 0_IntKi !< Type of skewed-wake correction model [switch] {1=uncoupled, 2=Pitt/Peters, 3=coupled} [-] + REAL(ReKi) :: aTol = 0.0_ReKi !< Tolerance for the induction solution [-] + LOGICAL :: useTipLoss = .false. !< Use the Prandtl tip-loss model? [flag] [-] + LOGICAL :: useHubLoss = .false. !< Use the Prandtl hub-loss model? [flag] [-] + LOGICAL :: useInduction = .false. !< Include induction in BEMT calculations [flag] { If FALSE then useTanInd will be set to FALSE} [-] + LOGICAL :: useTanInd = .false. !< Include tangential induction in BEMT calculations [flag] [-] + LOGICAL :: useAIDrag = .false. !< Include the drag term in the axial-induction calculation? [flag] [-] + LOGICAL :: useTIDrag = .false. !< Include the drag term in the tangential-induction calculation? Ignored if TanInd is False. [flag] [-] + LOGICAL :: MomentumCorr = .false. !< Momentum Correction {0=Axial Theory, 1 = Glauert Momentum Theory} [-] + INTEGER(IntKi) :: numBladeNodes = 0_IntKi !< Number of blade nodes used in the analysis [-] + INTEGER(IntKi) :: numReIterations = 0_IntKi !< Number of iterations for finding the Reynolds number [-] + INTEGER(IntKi) :: maxIndIterations = 0_IntKi !< Maximum number of iterations of induction factor solve [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: AFindx !< Index of airfoil data file for blade node location [array of numBladeNodes] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: zHub !< Distance to hub for each blade [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: zLocal !< Distance to blade node, measured along the blade [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: zTip !< Distance to blade tip, measured along the blade [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: rLocal !< Radial distance to blade node from the center of rotation, measured in the rotor plane, needed for DBEMT [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rTipFix !< Nominally the coned rotor diameter (without prebend), used to align with Bladed calculations [m] - INTEGER(IntKi) :: UAMod !< Model for the dynamic stall equations [1 = Leishman/Beddoes, 2 = Gonzalez, 3 = Minnema] [-] - LOGICAL :: UA_Flag !< logical flag indicating whether to use UnsteadyAero [-] - LOGICAL :: Flookup !< Use table lookup for f' and f'' [-] - REAL(ReKi) :: a_s !< speed of sound [m/s] - INTEGER(IntKi) :: DBEMT_Mod !< DBEMT model. 1 = constant tau1, 2 = time dependent tau1 [-] - REAL(ReKi) :: tau1_const !< DBEMT time constant (when DBEMT_Mod=1) [s] - REAL(ReKi) :: yawCorrFactor !< constant used in Pitt/Peters skewed wake model (default is 15*pi/32) [-] + INTEGER(IntKi) :: UAMod = 0_IntKi !< Model for the dynamic stall equations [1 = Leishman/Beddoes, 2 = Gonzalez, 3 = Minnema] [-] + LOGICAL :: UA_Flag = .false. !< logical flag indicating whether to use UnsteadyAero [-] + LOGICAL :: Flookup = .false. !< Use table lookup for f' and f'' [-] + REAL(ReKi) :: a_s = 0.0_ReKi !< speed of sound [m/s] + INTEGER(IntKi) :: DBEMT_Mod = 0_IntKi !< DBEMT model. 1 = constant tau1, 2 = time dependent tau1 [-] + REAL(ReKi) :: tau1_const = 0.0_ReKi !< DBEMT time constant (when DBEMT_Mod=1) [s] + REAL(ReKi) :: yawCorrFactor = 0.0_ReKi !< constant used in Pitt/Peters skewed wake model (default is 15*pi/32) [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: UAOff_innerNode !< Last node on each blade where UA should be turned off based on span location from blade root (0 if always on) [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: UAOff_outerNode !< First node on each blade where UA should be turned off based on span location from blade tip (>nNodesPerBlade if always on) [-] - CHARACTER(1024) :: RootName !< RootName for writing output files [-] - LOGICAL :: SumPrint !< logical flag indicating whether to use UnsteadyAero [-] - INTEGER(IntKi) :: BEM_Mod !< BEM Model 0=OpenFAST 2=Envision [-] + CHARACTER(1024) :: RootName = '' !< RootName for writing output files [-] + LOGICAL :: SumPrint = .false. !< logical flag indicating whether to use UnsteadyAero [-] + INTEGER(IntKi) :: BEM_Mod = 0_IntKi !< BEM Model 0=OpenFAST 2=Envision [-] END TYPE BEMT_InitInputType ! ======================= ! ========= BEMT_InitOutputType ======= @@ -88,16 +88,16 @@ MODULE BEMT_Types ! ======================= ! ========= BEMT_SkewWake_InputType ======= TYPE, PUBLIC :: BEMT_SkewWake_InputType - REAL(ReKi) , DIMENSION(1:3) :: v_qsw !< quasi-steady instantaneous wake velocity (value to be filtered in Skewed Wake model) [m/s] - REAL(ReKi) :: V0 !< magnitude of disk-averaged velocity (for input to SkewWake) [m/s] - REAL(ReKi) :: R !< rotor radius (for input to SkewWake) [m] + REAL(ReKi) , DIMENSION(1:3) :: v_qsw = 0.0_ReKi !< quasi-steady instantaneous wake velocity (value to be filtered in Skewed Wake model) [m/s] + REAL(ReKi) :: V0 = 0.0_ReKi !< magnitude of disk-averaged velocity (for input to SkewWake) [m/s] + REAL(ReKi) :: R = 0.0_ReKi !< rotor radius (for input to SkewWake) [m] END TYPE BEMT_SkewWake_InputType ! ======================= ! ========= BEMT_ContinuousStateType ======= TYPE, PUBLIC :: BEMT_ContinuousStateType TYPE(UA_ContinuousStateType) :: UA !< UA module continuous states [-] TYPE(DBEMT_ContinuousStateType) :: DBEMT !< DBEMT module continuous states [-] - REAL(R8Ki) , DIMENSION(1:3) :: V_w !< continuous state for filtering wake velocity [-] + REAL(R8Ki) , DIMENSION(1:3) :: V_w = 0.0_R8Ki !< continuous state for filtering wake velocity [-] END TYPE BEMT_ContinuousStateType ! ======================= ! ========= BEMT_DiscreteStateType ======= @@ -115,16 +115,16 @@ MODULE BEMT_Types TYPE(UA_OtherStateType) :: UA !< other states for UnsteadyAero [-] TYPE(DBEMT_OtherStateType) :: DBEMT !< other states for DBEMT [-] LOGICAL , DIMENSION(:,:), ALLOCATABLE :: ValidPhi !< set to indicate when there is no valid Phi for this node at this time (temporarially turn off induction when this is false) [-] - LOGICAL :: nodesInitialized !< the node states have been initialized properly [-] + LOGICAL :: nodesInitialized = .false. !< the node states have been initialized properly [-] TYPE(BEMT_ContinuousStateType) , DIMENSION(1:4) :: xdot !< history states for continuous state integration [-] - INTEGER(IntKi) :: n !< time step # value used for continuous state integrator [-] + INTEGER(IntKi) :: n = 0_IntKi !< time step # value used for continuous state integrator [-] END TYPE BEMT_OtherStateType ! ======================= ! ========= BEMT_MiscVarType ======= TYPE, PUBLIC :: BEMT_MiscVarType - LOGICAL :: FirstWarn_Skew !< flag so invalid skew warning doesn't get repeated forever [-] - LOGICAL :: FirstWarn_Phi !< flag so Invalid Phi warning doesn't get repeated forever [-] - LOGICAL :: FirstWarn_BEMoff !< flag to warn the BEM was turned off [-] + LOGICAL :: FirstWarn_Skew = .false. !< flag so invalid skew warning doesn't get repeated forever [-] + LOGICAL :: FirstWarn_Phi = .false. !< flag so Invalid Phi warning doesn't get repeated forever [-] + LOGICAL :: FirstWarn_BEMoff = .false. !< flag to warn the BEM was turned off [-] TYPE(UA_MiscVarType) :: UA !< misc vars for UnsteadyAero [-] TYPE(DBEMT_MiscVarType) :: DBEMT !< misc vars for DBEMT [-] TYPE(UA_OutputType) :: y_UA !< outputs from UnsteadyAero [-] @@ -135,66 +135,66 @@ MODULE BEMT_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AxInd_op !< axial induction at the operating point (for linearization) with frozen wake assumption [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AxInduction !< axial induction used for code run-time optimization [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TanInduction !< tangential induction used for code run-time optimization [-] - LOGICAL :: UseFrozenWake !< flag set to determine if frozen values of TnInd_op and AxInd_op should be used for this calculation in the linearization process [-] + LOGICAL :: UseFrozenWake = .false. !< flag set to determine if frozen values of TnInd_op and AxInd_op should be used for this calculation in the linearization process [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Rtip !< maximum rlocal value for each blade (typically the value at the tip) [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: phi !< temp variable used in update states for returning phi (to allow computing inputs and states at multiple times) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: chi !< temp variable used in update states for returning chi (to allow calling same routine from CalcOutput and UpdateStates) [-] LOGICAL , DIMENSION(:,:), ALLOCATABLE :: ValidPhi !< temp variable used in calcOutput for ValidPhi (to allow calling same routine from CalcOutput and UpdateStates) [-] - REAL(ReKi) :: BEM_weight + REAL(ReKi) :: BEM_weight = 0.0_ReKi END TYPE BEMT_MiscVarType ! ======================= ! ========= BEMT_ParameterType ======= TYPE, PUBLIC :: BEMT_ParameterType - REAL(DbKi) :: DT !< time step [s] + REAL(DbKi) :: DT = 0.0_R8Ki !< time step [s] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: chord !< Chord length at node [m] - INTEGER(IntKi) :: numBlades !< Number of blades [-] - REAL(ReKi) :: airDens !< Air density [kg/m^3] - REAL(ReKi) :: kinVisc !< Kinematic air viscosity [m^2/s] - INTEGER(IntKi) :: skewWakeMod !< Type of skewed-wake correction model [switch] {1=uncoupled, 2=Pitt/Peters, 3=coupled} [-] - REAL(ReKi) :: aTol !< Tolerance for the induction solution [-] - LOGICAL :: useTipLoss !< Use the Prandtl tip-loss model? [flag] [-] - LOGICAL :: useHubLoss !< Use the Prandtl hub-loss model? [flag] [-] - LOGICAL :: useInduction !< Include induction in BEMT calculations [flag] { If FALSE then useTanInd will be set to FALSE} [-] - LOGICAL :: useTanInd !< Include tangential induction in BEMT calculations [flag] [-] - LOGICAL :: useAIDrag !< Include the drag term in the axial-induction calculation? [flag] [-] - LOGICAL :: useTIDrag !< Include the drag term in the tangential-induction calculation? Ignored if TanInd is False. [flag] [-] - INTEGER(IntKi) :: numBladeNodes !< Number of blade nodes used in the analysis [-] - INTEGER(IntKi) :: numReIterations !< Number of iterations for finding the Reynolds number [-] - INTEGER(IntKi) :: maxIndIterations !< Maximum number of iterations of induction factor solve [-] + INTEGER(IntKi) :: numBlades = 0_IntKi !< Number of blades [-] + REAL(ReKi) :: airDens = 0.0_ReKi !< Air density [kg/m^3] + REAL(ReKi) :: kinVisc = 0.0_ReKi !< Kinematic air viscosity [m^2/s] + INTEGER(IntKi) :: skewWakeMod = 0_IntKi !< Type of skewed-wake correction model [switch] {1=uncoupled, 2=Pitt/Peters, 3=coupled} [-] + REAL(ReKi) :: aTol = 0.0_ReKi !< Tolerance for the induction solution [-] + LOGICAL :: useTipLoss = .false. !< Use the Prandtl tip-loss model? [flag] [-] + LOGICAL :: useHubLoss = .false. !< Use the Prandtl hub-loss model? [flag] [-] + LOGICAL :: useInduction = .false. !< Include induction in BEMT calculations [flag] { If FALSE then useTanInd will be set to FALSE} [-] + LOGICAL :: useTanInd = .false. !< Include tangential induction in BEMT calculations [flag] [-] + LOGICAL :: useAIDrag = .false. !< Include the drag term in the axial-induction calculation? [flag] [-] + LOGICAL :: useTIDrag = .false. !< Include the drag term in the tangential-induction calculation? Ignored if TanInd is False. [flag] [-] + INTEGER(IntKi) :: numBladeNodes = 0_IntKi !< Number of blade nodes used in the analysis [-] + INTEGER(IntKi) :: numReIterations = 0_IntKi !< Number of iterations for finding the Reynolds number [-] + INTEGER(IntKi) :: maxIndIterations = 0_IntKi !< Maximum number of iterations of induction factor solve [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: AFindx !< Index of airfoil data file for blade node location [array of numBladeNodes] [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: tipLossConst !< A constant computed during initialization based on B*(zTip-zLocal)/(2*zLocal) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: hubLossConst !< A constant computed during initialization based on B*(zLocal-zHub)/(2*zHub) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: zHub !< Distance to hub for each blade [m] TYPE(UA_ParameterType) :: UA !< parameters for UnsteadyAero [-] TYPE(DBEMT_ParameterType) :: DBEMT !< parameters for DBEMT [-] - LOGICAL :: UA_Flag !< logical flag indicating whether to use UnsteadyAero [-] - INTEGER(IntKi) :: DBEMT_Mod !< DBEMT Model. 0 = constant tau1, 1 = time dependent tau1 [-] - REAL(ReKi) :: yawCorrFactor !< constant used in Pitt/Peters skewed wake model (default is 15*pi/32) [-] + LOGICAL :: UA_Flag = .false. !< logical flag indicating whether to use UnsteadyAero [-] + INTEGER(IntKi) :: DBEMT_Mod = 0_IntKi !< DBEMT Model. 0 = constant tau1, 1 = time dependent tau1 [-] + REAL(ReKi) :: yawCorrFactor = 0.0_ReKi !< constant used in Pitt/Peters skewed wake model (default is 15*pi/32) [-] LOGICAL , DIMENSION(:,:), ALLOCATABLE :: FixedInductions !< flag to determine if BEM inductions should be fixed and not modified by dbemt or skewed wake [-] - LOGICAL :: MomentumCorr !< Momentum Correction {0=Axial Theory, 1 = Glauert Momentum Theory} [-] - REAL(ReKi) :: rTipFixMax !< Nominally the coned rotor diameter (without prebend), used to align with Bladed calculations [m] + LOGICAL :: MomentumCorr = .false. !< Momentum Correction {0=Axial Theory, 1 = Glauert Momentum Theory} [-] + REAL(ReKi) :: rTipFixMax = 0.0_ReKi !< Nominally the coned rotor diameter (without prebend), used to align with Bladed calculations [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: IntegrateWeight !< A weighting factor for calculating rotor-averaged values (e.g., AxInd) [-] INTEGER(IntKi) :: lin_nx = 0 !< Number of continuous states for linearization [-] - INTEGER(IntKi) :: BEM_Mod !< BEM Model 0=OpenFAST 2=Envision [-] + INTEGER(IntKi) :: BEM_Mod = 0_IntKi !< BEM Model 0=OpenFAST 2=Envision [-] END TYPE BEMT_ParameterType ! ======================= ! ========= BEMT_InputType ======= TYPE, PUBLIC :: BEMT_InputType REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: theta !< Twist angle (includes all sources of twist) [Array of size (NumBlNds,numBlades)] [rad] - REAL(ReKi) :: chi0 !< Angle between the vector normal to the rotor plane and the wind vector (e.g., the yaw angle in the case of no tilt) [rad] - REAL(ReKi) :: psiSkewOffset !< Azimuth angle offset (relative to 90 deg) of the most downwind blade when chi0 is non-zero [rad] + REAL(ReKi) :: chi0 = 0.0_ReKi !< Angle between the vector normal to the rotor plane and the wind vector (e.g., the yaw angle in the case of no tilt) [rad] + REAL(ReKi) :: psiSkewOffset = 0.0_ReKi !< Azimuth angle offset (relative to 90 deg) of the most downwind blade when chi0 is non-zero [rad] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: psi !< Azimuth angle [rad] - REAL(ReKi) :: omega !< Angular velocity of rotor [rad/s] - REAL(ReKi) :: TSR !< Tip-speed ratio (to check if BEM should be turned off) [-] + REAL(ReKi) :: omega = 0.0_ReKi !< Angular velocity of rotor [rad/s] + REAL(ReKi) :: TSR = 0.0_ReKi !< Tip-speed ratio (to check if BEM should be turned off) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Vx !< Local axial velocity at node [m/s] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Vy !< Local tangential velocity at node [m/s] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Vz !< Local radial velocity at node [m/s] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: omega_z !< rotation of no-sweep-pitch-twist coordinate system around z (for CDBEMT and CUA) [rad/s] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: xVelCorr !< projection of velocity when yawed + prebend [m/s] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: rLocal !< Radial distance from center-of-rotation to node [m] - REAL(ReKi) :: Un_disk !< disk-averaged velocity normal to the rotor disk (for input to DBEMT) [m/s] - REAL(ReKi) , DIMENSION(1:3) :: V0 !< disk-averaged velocity (for input to SkewWake) [m/s] - REAL(R8Ki) , DIMENSION(1:3) :: x_hat_disk !< Hub Orientation vector: normal to rotor disk [-] + REAL(ReKi) :: Un_disk = 0.0_ReKi !< disk-averaged velocity normal to the rotor disk (for input to DBEMT) [m/s] + REAL(ReKi) , DIMENSION(1:3) :: V0 = 0.0_ReKi !< disk-averaged velocity (for input to SkewWake) [m/s] + REAL(R8Ki) , DIMENSION(1:3) :: x_hat_disk = 0.0_R8Ki !< Hub Orientation vector: normal to rotor disk [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: UserProp !< Optional user property for interpolating airfoils (per element per blade) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CantAngle !< Cant angle [Array of size (NumBlNds,numBlades)] [rad] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: drdz !< dr/dz geometric parameter [-] diff --git a/modules/aerodyn/src/DBEMT_Types.f90 b/modules/aerodyn/src/DBEMT_Types.f90 index abf09196c8..be37923804 100644 --- a/modules/aerodyn/src/DBEMT_Types.f90 +++ b/modules/aerodyn/src/DBEMT_Types.f90 @@ -39,10 +39,10 @@ MODULE DBEMT_Types INTEGER(IntKi), PUBLIC, PARAMETER :: DBEMT_cont_tauConst = 3 ! use continuous formulation with constant tau1 [-] ! ========= DBEMT_InitInputType ======= TYPE, PUBLIC :: DBEMT_InitInputType - INTEGER(IntKi) :: NumBlades !< Number of blades on the turbine [-] - INTEGER(IntKi) :: NumNodes !< Number of nodes on each blade [-] - REAL(ReKi) :: tau1_const !< delay value based on disk-averaged quantities [-] - INTEGER(IntKi) :: DBEMT_Mod !< DBEMT Model. 1 = constant tau1, 2 = time dependent tau1, 3=continuous form with constant tau1 [-] + INTEGER(IntKi) :: NumBlades = 0_IntKi !< Number of blades on the turbine [-] + INTEGER(IntKi) :: NumNodes = 0_IntKi !< Number of nodes on each blade [-] + REAL(ReKi) :: tau1_const = 0.0_ReKi !< delay value based on disk-averaged quantities [-] + INTEGER(IntKi) :: DBEMT_Mod = 0_IntKi !< DBEMT Model. 1 = constant tau1, 2 = time dependent tau1, 3=continuous form with constant tau1 [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: rLocal !< Radial distance to blade node from the center of rotation, measured in the rotor plane, needed for DBEMT [m] END TYPE DBEMT_InitInputType ! ======================= @@ -53,8 +53,8 @@ MODULE DBEMT_Types ! ======================= ! ========= DBEMT_ElementContinuousStateType ======= TYPE, PUBLIC :: DBEMT_ElementContinuousStateType - REAL(R8Ki) , DIMENSION(1:2) :: vind !< The filtered induced velocity, [1,i,j] is the axial induced velocity (-Vx*a) at node i on blade j and [2,i,j] is the tantential induced velocity (Vy*a') [m/s] - REAL(R8Ki) , DIMENSION(1:2) :: vind_1 !< The filtered reduced or intermediate induced velocity [m/s] + REAL(R8Ki) , DIMENSION(1:2) :: vind = 0.0_R8Ki !< The filtered induced velocity, [1,i,j] is the axial induced velocity (-Vx*a) at node i on blade j and [2,i,j] is the tantential induced velocity (Vy*a') [m/s] + REAL(R8Ki) , DIMENSION(1:2) :: vind_1 = 0.0_R8Ki !< The filtered reduced or intermediate induced velocity [m/s] END TYPE DBEMT_ElementContinuousStateType ! ======================= ! ========= DBEMT_ContinuousStateType ======= @@ -64,51 +64,51 @@ MODULE DBEMT_Types ! ======================= ! ========= DBEMT_DiscreteStateType ======= TYPE, PUBLIC :: DBEMT_DiscreteStateType - REAL(SiKi) :: DummyState !< Remove this variable if you have continuous states [-] + REAL(SiKi) :: DummyState = 0.0_R4Ki !< Remove this variable if you have continuous states [-] END TYPE DBEMT_DiscreteStateType ! ======================= ! ========= DBEMT_ConstraintStateType ======= TYPE, PUBLIC :: DBEMT_ConstraintStateType - REAL(SiKi) :: DummyState !< Remove this variable if you have constraint states [-] + REAL(SiKi) :: DummyState = 0.0_R4Ki !< Remove this variable if you have constraint states [-] END TYPE DBEMT_ConstraintStateType ! ======================= ! ========= DBEMT_OtherStateType ======= TYPE, PUBLIC :: DBEMT_OtherStateType LOGICAL , DIMENSION(:,:), ALLOCATABLE :: areStatesInitialized !< Flag indicating whether the module's states have been initialized properly [-] - REAL(ReKi) :: tau1 !< value of tau1 used in updateStates (for output-to-file only) [-] - REAL(ReKi) :: tau2 !< value of tau2 used in updateStates (equal to k_tau * tau1, not used between time steps) [-] + REAL(ReKi) :: tau1 = 0.0_ReKi !< value of tau1 used in updateStates (for output-to-file only) [-] + REAL(ReKi) :: tau2 = 0.0_ReKi !< value of tau2 used in updateStates (equal to k_tau * tau1, not used between time steps) [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: n !< time step # value used for continuous state integrator [-] TYPE(DBEMT_ContinuousStateType) , DIMENSION(1:4) :: xdot !< derivative history for continuous state integrators [-] END TYPE DBEMT_OtherStateType ! ======================= ! ========= DBEMT_MiscVarType ======= TYPE, PUBLIC :: DBEMT_MiscVarType - LOGICAL :: FirstWarn_tau1 !< flag so tau1 limit warning doesn't get repeated forever [-] + LOGICAL :: FirstWarn_tau1 = .false. !< flag so tau1 limit warning doesn't get repeated forever [-] END TYPE DBEMT_MiscVarType ! ======================= ! ========= DBEMT_ParameterType ======= TYPE, PUBLIC :: DBEMT_ParameterType - REAL(DbKi) :: DT !< Time step for continuous state integration & discrete state update [seconds] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for continuous state integration & discrete state update [seconds] INTEGER(IntKi) :: lin_nx = 0 !< Number of continuous states for linearization [-] - INTEGER(IntKi) :: NumBlades !< Number of blades on the turbine [-] - INTEGER(IntKi) :: NumNodes !< Number of nodes on each blade [-] - REAL(ReKi) :: k_0ye !< Filter dynamics constant [default = 0.6 ] [-] - REAL(ReKi) :: tau1_const !< constant version of the delay value [-] + INTEGER(IntKi) :: NumBlades = 0_IntKi !< Number of blades on the turbine [-] + INTEGER(IntKi) :: NumNodes = 0_IntKi !< Number of nodes on each blade [-] + REAL(ReKi) :: k_0ye = 0.0_ReKi !< Filter dynamics constant [default = 0.6 ] [-] + REAL(ReKi) :: tau1_const = 0.0_ReKi !< constant version of the delay value [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: spanRatio !< static span ratio of each blade node [-] - INTEGER(IntKi) :: DBEMT_Mod !< DBEMT Model. 1 = constant tau1, 2 = time dependent tau1, 3=continuous form of constant tau1 [-] + INTEGER(IntKi) :: DBEMT_Mod = 0_IntKi !< DBEMT Model. 1 = constant tau1, 2 = time dependent tau1, 3=continuous form of constant tau1 [-] END TYPE DBEMT_ParameterType ! ======================= ! ========= DBEMT_ElementInputType ======= TYPE, PUBLIC :: DBEMT_ElementInputType - REAL(ReKi) , DIMENSION(1:2) :: vind_s !< The unfiltered induced velocity, [1] is the axial induced velocity (-Vx*a) and [2] is the tangential induced velocity (Vy*a') at node i on blade j. Note that the inputs are used only operated on at a particular node and blade, so we don't store all elements [m/s] - REAL(ReKi) :: spanRatio !< Normalized span location of blade node [-] + REAL(ReKi) , DIMENSION(1:2) :: vind_s = 0.0_ReKi !< The unfiltered induced velocity, [1] is the axial induced velocity (-Vx*a) and [2] is the tangential induced velocity (Vy*a') at node i on blade j. Note that the inputs are used only operated on at a particular node and blade, so we don't store all elements [m/s] + REAL(ReKi) :: spanRatio = 0.0_ReKi !< Normalized span location of blade node [-] END TYPE DBEMT_ElementInputType ! ======================= ! ========= DBEMT_InputType ======= TYPE, PUBLIC :: DBEMT_InputType - REAL(ReKi) :: AxInd_disk !< Disk-averaged axial induction (for time-varying tau) [-] - REAL(ReKi) :: Un_disk !< Disk-averaged normal relative inflow velocity (for time-varying tau) [m/s] - REAL(ReKi) :: R_disk !< Disk-averaged rotor radius (for time-varying tau) [m] + REAL(ReKi) :: AxInd_disk = 0.0_ReKi !< Disk-averaged axial induction (for time-varying tau) [-] + REAL(ReKi) :: Un_disk = 0.0_ReKi !< Disk-averaged normal relative inflow velocity (for time-varying tau) [m/s] + REAL(ReKi) :: R_disk = 0.0_ReKi !< Disk-averaged rotor radius (for time-varying tau) [m] TYPE(DBEMT_ElementInputType) , DIMENSION(:,:), ALLOCATABLE :: element !< The element-level inputs at each blade node [-] END TYPE DBEMT_InputType ! ======================= diff --git a/modules/aerodyn/src/FVW_Types.f90 b/modules/aerodyn/src/FVW_Types.f90 index b4d28be2f9..e0172c5512 100644 --- a/modules/aerodyn/src/FVW_Types.f90 +++ b/modules/aerodyn/src/FVW_Types.f90 @@ -39,23 +39,23 @@ MODULE FVW_Types INTEGER(IntKi), PUBLIC, PARAMETER :: idGridVelVorticity = 2 ! Grid stores velocity and vorticity [-] ! ========= GridOutType ======= TYPE, PUBLIC :: GridOutType - CHARACTER(100) :: name !< Grid name [-] - INTEGER(IntKi) :: type !< Grid type [-] - REAL(ReKi) :: tStart !< Time at which outputs starts [-] - REAL(ReKi) :: tEnd !< Time at which outputs ends [-] - REAL(ReKi) :: DTout !< Output frequency of grid [-] - REAL(ReKi) :: xStart !< xStart [-] - REAL(ReKi) :: yStart !< yStart [-] - REAL(ReKi) :: zStart !< zStart [-] - REAL(ReKi) :: xEnd !< xEnd [-] - REAL(ReKi) :: yEnd !< yEnd [-] - REAL(ReKi) :: zEnd !< zEnd [-] - INTEGER(IntKi) :: nx !< nx [-] - INTEGER(IntKi) :: ny !< ny [-] - INTEGER(IntKi) :: nz !< nz [-] + CHARACTER(100) :: name = '' !< Grid name [-] + INTEGER(IntKi) :: type = 0_IntKi !< Grid type [-] + REAL(ReKi) :: tStart = 0.0_ReKi !< Time at which outputs starts [-] + REAL(ReKi) :: tEnd = 0.0_ReKi !< Time at which outputs ends [-] + REAL(ReKi) :: DTout = 0.0_ReKi !< Output frequency of grid [-] + REAL(ReKi) :: xStart = 0.0_ReKi !< xStart [-] + REAL(ReKi) :: yStart = 0.0_ReKi !< yStart [-] + REAL(ReKi) :: zStart = 0.0_ReKi !< zStart [-] + REAL(ReKi) :: xEnd = 0.0_ReKi !< xEnd [-] + REAL(ReKi) :: yEnd = 0.0_ReKi !< yEnd [-] + REAL(ReKi) :: zEnd = 0.0_ReKi !< zEnd [-] + INTEGER(IntKi) :: nx = 0_IntKi !< nx [-] + INTEGER(IntKi) :: ny = 0_IntKi !< ny [-] + INTEGER(IntKi) :: nz = 0_IntKi !< nz [-] REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: uGrid !< Grid velocity 3 x nz x ny x nx [-] REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: omGrid !< Grid vorticity 3 x nz x ny x nx [-] - REAL(DbKi) :: tLastOutput !< Last output time [-] + REAL(DbKi) :: tLastOutput = 0.0_R8Ki !< Last output time [-] END TYPE GridOutType ! ======================= ! ========= T_Sgmt ======= @@ -64,9 +64,9 @@ MODULE FVW_Types INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Connct !< Connectivity of segments [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Gamma !< Segment circulations [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Epsilon !< Segment regularization parameter [-] - INTEGER(IntKi) :: RegFunction !< Type of regularizaion function (LambOseen, Vatistas, see FVW_BiotSavart) [-] - INTEGER(IntKi) :: nAct !< Number of active segments [-] - INTEGER(IntKi) :: nActP !< Number of active segment points [-] + INTEGER(IntKi) :: RegFunction = 0_IntKi !< Type of regularizaion function (LambOseen, Vatistas, see FVW_BiotSavart) [-] + INTEGER(IntKi) :: nAct = 0_IntKi !< Number of active segments [-] + INTEGER(IntKi) :: nActP = 0_IntKi !< Number of active segment points [-] END TYPE T_Sgmt ! ======================= ! ========= T_Part ======= @@ -74,8 +74,8 @@ MODULE FVW_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: P !< Particle Points [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Alpha !< Particle intensity 3 x nP [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: RegParam !< Particle regularization parameter [-] - INTEGER(IntKi) :: RegFunction !< Type of regularizaion function (FVW_BiotSavart) [-] - INTEGER(IntKi) :: nAct !< Number of active particles <=nP [-] + INTEGER(IntKi) :: RegFunction = 0_IntKi !< Type of regularizaion function (FVW_BiotSavart) [-] + INTEGER(IntKi) :: nAct = 0_IntKi !< Number of active particles <=nP [-] END TYPE T_Part ! ======================= ! ========= Wng_ParameterType ======= @@ -84,57 +84,57 @@ MODULE FVW_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: chord_CP !< Chord on LL cp [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: s_LL !< Spanwise coordinate of LL elements [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: s_CP !< Spanwise coordinate of LL CP [m] - INTEGER(IntKi) :: iRotor !< Index of rotor the wing belong to [-] + INTEGER(IntKi) :: iRotor = 0_IntKi !< Index of rotor the wing belong to [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: AFindx !< Index to the airfoils from AD15 [BladeNode,BladeIndex=1] [-] - INTEGER(IntKi) :: nSpan !< TODO, should be defined per wing. Number of spanwise element [-] + INTEGER(IntKi) :: nSpan = 0_IntKi !< TODO, should be defined per wing. Number of spanwise element [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PrescribedCirculation !< Prescribed circulation on all lifting lines [m/s] END TYPE Wng_ParameterType ! ======================= ! ========= FVW_ParameterType ======= TYPE, PUBLIC :: FVW_ParameterType - INTEGER(IntKi) :: nRotors !< Number of Wings [-] - INTEGER(IntKi) :: nWings !< Number of Wings [-] + INTEGER(IntKi) :: nRotors = 0_IntKi !< Number of Wings [-] + INTEGER(IntKi) :: nWings = 0_IntKi !< Number of Wings [-] TYPE(Wng_ParameterType) , DIMENSION(:), ALLOCATABLE :: W !< Wings parameters [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Bld2Wings !< Index mapping from blades to wings [-] - INTEGER(IntKi) :: iNWStart !< Index where NW start in r_NW. (iNWStart=2, the first panel contains the lifting line panel, otherwise, start at 1) [-] - INTEGER(IntKi) :: nNWMax !< Maximum number of nw panels, per wing [-] - INTEGER(IntKi) :: nNWFree !< Number of nw panels that are free, per wing [-] - INTEGER(IntKi) :: nFWMax !< Maximum number of fw panels, per wing [-] - INTEGER(IntKi) :: nFWFree !< Number of fw panels that are free, per wing [-] - LOGICAL :: FWShedVorticity !< Include shed vorticity in the far wake [-] - INTEGER(IntKi) :: IntMethod !< Integration Method (1=RK4, 2=AB4, 3=ABM4, 5=Euler1) [-] - REAL(ReKi) :: FreeWakeStart !< Time when wake starts convecting (rolling up) [s] - REAL(ReKi) :: FullCircStart !< Time when the circulation is full [s] - INTEGER(IntKi) :: CircSolvMethod !< Method to determine the circulation [-] - INTEGER(IntKi) :: CircSolvMaxIter !< Maximum number of iterations for circulation solving [-] - REAL(ReKi) :: CircSolvConvCrit !< Convergence criterion for circulation solving [-] - REAL(ReKi) :: CircSolvRelaxation !< Relaxation factor for circulation solving [-] - INTEGER(IntKi) :: CircSolvPolar !< (0=Use AD polars, 1=2PiAlpha, 2=sin(2pialpha) [-] - INTEGER(IntKi) :: DiffusionMethod !< Diffusion method (None, CoreSpreading, PSE) [-] - REAL(ReKi) :: CoreSpreadEddyVisc !< Eddy viscosity used in the core spreading method [-] - INTEGER(IntKi) :: RegDeterMethod !< Regularization determinatino method (manual, automatic) [-] - INTEGER(IntKi) :: RegFunction !< Type of regularizaion function (LambOseen, Vatistas, see FVW_BiotSavart) [-] - INTEGER(IntKi) :: WakeRegMethod !< Method for regularization (constant, stretching, age, etc.) [-] - REAL(ReKi) :: WakeRegParam !< Initial value of the regularization parameter [-] - REAL(ReKi) :: WingRegParam !< Regularization parameter of the wing [-] - INTEGER(IntKi) :: ShearModel !< Option for shear modelling [-] - LOGICAL :: TwrShadowOnWake !< Include tower shadow effects on wake [-] - INTEGER(IntKi) , DIMENSION(1:2) :: VelocityMethod !< Velocity calculation method for Full Wake and for LiftingLine [-] - REAL(ReKi) , DIMENSION(1:2) :: TreeBranchFactor !< Factor used to determine if a point is far enough, for full wake and lifting line [-] - INTEGER(IntKi) , DIMENSION(1:2) :: PartPerSegment !< Number of particles per segment, e.g. for tree method, for full wake and lifting line [-] - REAL(DbKi) :: DTaero !< Time interval for calls calculations [s] - REAL(DbKi) :: DTfvw !< Time interval for calculating wake induced velocities [s] - REAL(ReKi) :: KinVisc !< Kinematic air viscosity [m^2/s] - INTEGER(IntKi) :: MHK !< MHK flag [-] - REAL(ReKi) :: WtrDpth !< Water depth [m] - INTEGER(IntKi) :: WrVTK !< Outputs VTK at each calcoutput call, even if main fst doesnt do it [-] - INTEGER(IntKi) :: VTKBlades !< Outputs VTk for each blade 0=no blade, 1=Bld 1 [-] - REAL(DbKi) :: DTvtk !< DT between vtk writes [s] - INTEGER(IntKi) :: VTKCoord !< Switch for VTK outputs coordinate system [-] - CHARACTER(1024) :: RootName !< RootName for writing output files [-] - CHARACTER(1024) :: VTK_OutFileRoot !< Rootdirectory for writing VTK files [-] - CHARACTER(1024) :: VTK_OutFileBase !< Basename for writing VTK files [-] - INTEGER(IntKi) :: nGridOut !< Number of VTK grid to output [-] + INTEGER(IntKi) :: iNWStart = 0_IntKi !< Index where NW start in r_NW. (iNWStart=2, the first panel contains the lifting line panel, otherwise, start at 1) [-] + INTEGER(IntKi) :: nNWMax = 0_IntKi !< Maximum number of nw panels, per wing [-] + INTEGER(IntKi) :: nNWFree = 0_IntKi !< Number of nw panels that are free, per wing [-] + INTEGER(IntKi) :: nFWMax = 0_IntKi !< Maximum number of fw panels, per wing [-] + INTEGER(IntKi) :: nFWFree = 0_IntKi !< Number of fw panels that are free, per wing [-] + LOGICAL :: FWShedVorticity = .false. !< Include shed vorticity in the far wake [-] + INTEGER(IntKi) :: IntMethod = 0_IntKi !< Integration Method (1=RK4, 2=AB4, 3=ABM4, 5=Euler1) [-] + REAL(ReKi) :: FreeWakeStart = 0.0_ReKi !< Time when wake starts convecting (rolling up) [s] + REAL(ReKi) :: FullCircStart = 0.0_ReKi !< Time when the circulation is full [s] + INTEGER(IntKi) :: CircSolvMethod = 0_IntKi !< Method to determine the circulation [-] + INTEGER(IntKi) :: CircSolvMaxIter = 0_IntKi !< Maximum number of iterations for circulation solving [-] + REAL(ReKi) :: CircSolvConvCrit = 0.0_ReKi !< Convergence criterion for circulation solving [-] + REAL(ReKi) :: CircSolvRelaxation = 0.0_ReKi !< Relaxation factor for circulation solving [-] + INTEGER(IntKi) :: CircSolvPolar = 0_IntKi !< (0=Use AD polars, 1=2PiAlpha, 2=sin(2pialpha) [-] + INTEGER(IntKi) :: DiffusionMethod = 0_IntKi !< Diffusion method (None, CoreSpreading, PSE) [-] + REAL(ReKi) :: CoreSpreadEddyVisc = 0.0_ReKi !< Eddy viscosity used in the core spreading method [-] + INTEGER(IntKi) :: RegDeterMethod = 0_IntKi !< Regularization determinatino method (manual, automatic) [-] + INTEGER(IntKi) :: RegFunction = 0_IntKi !< Type of regularizaion function (LambOseen, Vatistas, see FVW_BiotSavart) [-] + INTEGER(IntKi) :: WakeRegMethod = 0_IntKi !< Method for regularization (constant, stretching, age, etc.) [-] + REAL(ReKi) :: WakeRegParam = 0.0_ReKi !< Initial value of the regularization parameter [-] + REAL(ReKi) :: WingRegParam = 0.0_ReKi !< Regularization parameter of the wing [-] + INTEGER(IntKi) :: ShearModel = 0_IntKi !< Option for shear modelling [-] + LOGICAL :: TwrShadowOnWake = .false. !< Include tower shadow effects on wake [-] + INTEGER(IntKi) , DIMENSION(1:2) :: VelocityMethod = 0_IntKi !< Velocity calculation method for Full Wake and for LiftingLine [-] + REAL(ReKi) , DIMENSION(1:2) :: TreeBranchFactor = 0.0_ReKi !< Factor used to determine if a point is far enough, for full wake and lifting line [-] + INTEGER(IntKi) , DIMENSION(1:2) :: PartPerSegment = 0_IntKi !< Number of particles per segment, e.g. for tree method, for full wake and lifting line [-] + REAL(DbKi) :: DTaero = 0.0_R8Ki !< Time interval for calls calculations [s] + REAL(DbKi) :: DTfvw = 0.0_R8Ki !< Time interval for calculating wake induced velocities [s] + REAL(ReKi) :: KinVisc = 0.0_ReKi !< Kinematic air viscosity [m^2/s] + INTEGER(IntKi) :: MHK = 0_IntKi !< MHK flag [-] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [m] + INTEGER(IntKi) :: WrVTK = 0_IntKi !< Outputs VTK at each calcoutput call, even if main fst doesnt do it [-] + INTEGER(IntKi) :: VTKBlades = 0_IntKi !< Outputs VTk for each blade 0=no blade, 1=Bld 1 [-] + REAL(DbKi) :: DTvtk = 0.0_R8Ki !< DT between vtk writes [s] + INTEGER(IntKi) :: VTKCoord = 0_IntKi !< Switch for VTK outputs coordinate system [-] + CHARACTER(1024) :: RootName = '' !< RootName for writing output files [-] + CHARACTER(1024) :: VTK_OutFileRoot = '' !< Rootdirectory for writing VTK files [-] + CHARACTER(1024) :: VTK_OutFileBase = '' !< Basename for writing VTK files [-] + INTEGER(IntKi) :: nGridOut = 0_IntKi !< Number of VTK grid to output [-] LOGICAL :: InductionAtCP = .true. !< Compute induced velocities at nodes or CP [-] LOGICAL :: WakeAtTE = .true. !< Start the wake at the trailing edge, or at the LL [-] LOGICAL :: DStallOnWake = .false. !< Dynamic stall has influence on wake [-] @@ -190,8 +190,8 @@ MODULE FVW_Types REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Vind_NW !< Induced velocity on near wake panels [m/s] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Vind_FW !< Induced velocity on far wake panels [m/s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PitchAndTwist !< Twist angle (includes all sources of twist) [Array of size (NumBlNds,numBlades)] [rad] - INTEGER(IntKi) :: iTip !< Index where tip vorticity will be placed. TODO, per blade [-] - INTEGER(IntKi) :: iRoot !< Index where root vorticity will be placed [-] + INTEGER(IntKi) :: iTip = 0_IntKi !< Index where tip vorticity will be placed. TODO, per blade [-] + INTEGER(IntKi) :: iRoot = 0_IntKi !< Index where root vorticity will be placed [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: alpha_LL !< Angle of attack at lifting line CP, only computed with CircPolarData method [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Vreln_LL !< Norm of Vrel on the lifting line [-] TYPE(UA_InputType) , DIMENSION(:,:), ALLOCATABLE :: u_UA !< inputs to UnsteadyAero numNode x 2 (t and t+dt) [-] @@ -220,21 +220,21 @@ MODULE FVW_Types ! ========= FVW_MiscVarType ======= TYPE, PUBLIC :: FVW_MiscVarType TYPE(Wng_MiscVarType) , DIMENSION(:), ALLOCATABLE :: W !< Misc for all wings [-] - LOGICAL :: FirstCall !< True if this is the first call to update state (used in CalcOutput) [-] - INTEGER(IntKi) :: nNW !< Number of active near wake panels [-] - INTEGER(IntKi) :: nFW !< Number of active far wake panels [-] - INTEGER(IntKi) :: iStep !< Current step number used for update state [-] - INTEGER(IntKi) :: VTKstep !< Current vtk output step number [-] - REAL(DbKi) :: VTKlastTime !< Time the last VTK file set was written out [s] + LOGICAL :: FirstCall = .false. !< True if this is the first call to update state (used in CalcOutput) [-] + INTEGER(IntKi) :: nNW = 0_IntKi !< Number of active near wake panels [-] + INTEGER(IntKi) :: nFW = 0_IntKi !< Number of active far wake panels [-] + INTEGER(IntKi) :: iStep = 0_IntKi !< Current step number used for update state [-] + INTEGER(IntKi) :: VTKstep = 0_IntKi !< Current vtk output step number [-] + REAL(DbKi) :: VTKlastTime = 0.0_R8Ki !< Time the last VTK file set was written out [s] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: r_wind !< List of points where wind is requested for next time step [-] - LOGICAL :: ComputeWakeInduced !< Compute induced velocities on this timestep [-] - REAL(DbKi) :: OldWakeTime !< Time the wake induction velocities were last calculated [s] + LOGICAL :: ComputeWakeInduced = .false. !< Compute induced velocities on this timestep [-] + REAL(DbKi) :: OldWakeTime = 0.0_R8Ki !< Time the wake induction velocities were last calculated [s] TYPE(FVW_ContinuousStateType) :: dxdt !< State time derivatie, stored for overcycling and convenience [-] TYPE(FVW_ContinuousStateType) :: x1 !< States at t (for overcycling) [-] TYPE(FVW_ContinuousStateType) :: x2 !< States at t+DTFVW (for overcycling) [-] - REAL(DbKi) :: t1 !< Time of x1 (for overcycling) [-] - REAL(DbKi) :: t2 !< Time of x2 t+DTFVW (for overcycling) [-] - LOGICAL :: UA_Flag !< logical flag indicating whether to use UnsteadyAero [-] + REAL(DbKi) :: t1 = 0.0_R8Ki !< Time of x1 (for overcycling) [-] + REAL(DbKi) :: t2 = 0.0_R8Ki !< Time of x2 t+DTFVW (for overcycling) [-] + LOGICAL :: UA_Flag = .false. !< logical flag indicating whether to use UnsteadyAero [-] TYPE(T_Sgmt) :: Sgmt !< Segments storage [-] TYPE(T_Part) :: Part !< Particle storage [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CPs !< Control points used for wake rollup computation [-] @@ -244,8 +244,8 @@ MODULE FVW_Types ! ======================= ! ========= Rot_InputType ======= TYPE, PUBLIC :: Rot_InputType - REAL(ReKi) , DIMENSION(1:3,1:3) :: HubOrientation !< Orientation of hub coordinate system (for output only) [-] - REAL(ReKi) , DIMENSION(1:3) :: HubPosition !< Origin of hub (for output only) [-] + REAL(ReKi) , DIMENSION(1:3,1:3) :: HubOrientation = 0.0_ReKi !< Orientation of hub coordinate system (for output only) [-] + REAL(ReKi) , DIMENSION(1:3) :: HubPosition = 0.0_ReKi !< Origin of hub (for output only) [-] END TYPE Rot_InputType ! ======================= ! ========= Wng_InputType ======= @@ -264,7 +264,7 @@ MODULE FVW_Types ! ======================= ! ========= FVW_DiscreteStateType ======= TYPE, PUBLIC :: FVW_DiscreteStateType - REAL(ReKi) :: Dummy !< Empty to satisfy framework [-] + REAL(ReKi) :: Dummy = 0.0_ReKi !< Empty to satisfy framework [-] TYPE(UA_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: UA !< states for UnsteadyAero for each Wing [-] END TYPE FVW_DiscreteStateType ! ======================= @@ -276,12 +276,12 @@ MODULE FVW_Types ! ========= FVW_ConstraintStateType ======= TYPE, PUBLIC :: FVW_ConstraintStateType TYPE(Wng_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: W !< rotors constr. states [-] - REAL(ReKi) :: residual !< Residual [-] + REAL(ReKi) :: residual = 0.0_ReKi !< Residual [-] END TYPE FVW_ConstraintStateType ! ======================= ! ========= FVW_OtherStateType ======= TYPE, PUBLIC :: FVW_OtherStateType - INTEGER(IntKi) :: Dummy !< Empty to satisfy framework [-] + INTEGER(IntKi) :: Dummy = 0_IntKi !< Empty to satisfy framework [-] TYPE(UA_OtherStateType) , DIMENSION(:), ALLOCATABLE :: UA !< other states for UnsteadyAero for each wing [-] END TYPE FVW_OtherStateType ! ======================= @@ -290,68 +290,68 @@ MODULE FVW_Types INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: AFindx !< Index to the airfoils from AD15 [idx1=BladeNode, idx2=Blade number=1] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: chord !< Chord of each blade element from input file [idx1=BladeNode, idx2=Blade number] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: RElm !< radius of center of each element [-] - INTEGER(IntKi) :: iRotor !< Index of rotor the wing belong to [-] - INTEGER(IntKi) :: UAOff_innerNode !< Last node on each blade where UA should be turned off based on span location from blade root (0 if always on) [-] - INTEGER(IntKi) :: UAOff_outerNode !< First node on each blade where UA should be turned off based on span location from blade tip (>nNodesPerBlade if always on) [-] + INTEGER(IntKi) :: iRotor = 0_IntKi !< Index of rotor the wing belong to [-] + INTEGER(IntKi) :: UAOff_innerNode = 0_IntKi !< Last node on each blade where UA should be turned off based on span location from blade root (0 if always on) [-] + INTEGER(IntKi) :: UAOff_outerNode = 0_IntKi !< First node on each blade where UA should be turned off based on span location from blade tip (>nNodesPerBlade if always on) [-] END TYPE Wng_InitInputType ! ======================= ! ========= FVW_InitInputType ======= TYPE, PUBLIC :: FVW_InitInputType - CHARACTER(1024) :: FVWFileName !< Main FVW input file name [-] - CHARACTER(1024) :: RootName !< RootName for writing output files [-] + CHARACTER(1024) :: FVWFileName = '' !< Main FVW input file name [-] + CHARACTER(1024) :: RootName = '' !< RootName for writing output files [-] TYPE(Wng_InitInputType) , DIMENSION(:), ALLOCATABLE :: W !< Number of blades [-] TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: WingsMesh !< Input Mesh defining position and orientation of wings (nSpan+1) [-] - INTEGER(IntKi) :: numBladeNodes !< Number of nodes on each blade [-] - REAL(DbKi) :: DTaero !< Time interval for calls (from AD15) [s] - REAL(ReKi) :: KinVisc !< Kinematic air viscosity [m^2/s] - INTEGER(IntKi) :: MHK !< MHK flag [-] - REAL(ReKi) :: WtrDpth !< Water depth [m] - INTEGER(IntKi) :: UAMod !< Model for the dynamic stall equations [1 = Leishman/Beddoes, 2 = Gonzalez, 3 = Minnema] [-] - LOGICAL :: UA_Flag !< logical flag indicating whether to use UnsteadyAero [-] - LOGICAL :: Flookup !< Use table lookup for f' and f'' [-] - REAL(ReKi) :: a_s !< speed of sound [m/s] - LOGICAL :: SumPrint !< Whether to print summary file (primarially in in UA) [-] + INTEGER(IntKi) :: numBladeNodes = 0_IntKi !< Number of nodes on each blade [-] + REAL(DbKi) :: DTaero = 0.0_R8Ki !< Time interval for calls (from AD15) [s] + REAL(ReKi) :: KinVisc = 0.0_ReKi !< Kinematic air viscosity [m^2/s] + INTEGER(IntKi) :: MHK = 0_IntKi !< MHK flag [-] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [m] + INTEGER(IntKi) :: UAMod = 0_IntKi !< Model for the dynamic stall equations [1 = Leishman/Beddoes, 2 = Gonzalez, 3 = Minnema] [-] + LOGICAL :: UA_Flag = .false. !< logical flag indicating whether to use UnsteadyAero [-] + LOGICAL :: Flookup = .false. !< Use table lookup for f' and f'' [-] + REAL(ReKi) :: a_s = 0.0_ReKi !< speed of sound [m/s] + LOGICAL :: SumPrint = .false. !< Whether to print summary file (primarially in in UA) [-] END TYPE FVW_InitInputType ! ======================= ! ========= FVW_InputFile ======= TYPE, PUBLIC :: FVW_InputFile - INTEGER(IntKi) :: CircSolvMethod !< Method to determine the circulation [-] - CHARACTER(1024) :: CirculationFile !< Prescribed circulation file [-] - INTEGER(IntKi) :: CircSolvMaxIter !< Maximum number of iterations for circulation solving [-] - REAL(ReKi) :: CircSolvConvCrit !< Convergence criterion for circulation solving [-] - REAL(ReKi) :: CircSolvRelaxation !< Relaxation factor for circulation solving [-] - INTEGER(IntKi) :: IntMethod !< Integration Method (1=RK4, 2=AB4, 3=ABM4, 5=Euler1, 7=Corrector/Predictor) [-] - LOGICAL :: FreeWake !< Disable roll up, wake convects with wind only (flag) [-] - REAL(ReKi) :: FreeWakeStart !< Time when wake starts convecting (rolling up) [s] - REAL(ReKi) :: FullCircStart !< Time when the circulation is full [s] - REAL(DbKi) :: DTfvw !< Time interval for calculating wake induced velocities [s] - INTEGER(IntKi) :: CircSolvPolar !< (0=Use AD polars, 1=2PiAlpha, 2=sin(2pialpha) [-] - INTEGER(IntKi) :: nNWPanels !< Number of nw panels [-] - INTEGER(IntKi) :: nNWPanelsFree !< Number of nw panels [-] - INTEGER(IntKi) :: nFWPanels !< Number of fw panels [-] - INTEGER(IntKi) :: nFWPanelsFree !< Number of fw panels that are free [-] - LOGICAL :: FWShedVorticity !< Include shed vorticity in the far wake [-] - INTEGER(IntKi) :: DiffusionMethod !< Diffusion method (None, CoreSpreading, PSE) [-] - REAL(ReKi) :: CoreSpreadEddyVisc !< Eddy viscosity used in the core spreading method [-] - INTEGER(IntKi) :: RegDeterMethod !< Regularization determinatino method (manual, automatic) [-] - INTEGER(IntKi) :: RegFunction !< Type of regularizaion function (LambOseen, Vatistas, see FVW_BiotSavart) [-] - INTEGER(IntKi) :: WakeRegMethod !< Method for regularization (constant, stretching, age, etc.) [-] - REAL(ReKi) :: WakeRegParam !< Factor used in the regularization [-] - REAL(ReKi) :: WingRegParam !< Factor used in the regularization [-] - INTEGER(IntKi) :: ShearModel !< Option for shear modelling [-] - LOGICAL :: TwrShadowOnWake !< Include tower shadow effects on wake [-] - INTEGER(IntKi) , DIMENSION(1:2) :: VelocityMethod !< Velocity calculation method for Full Wake and for LiftingLine [-] - REAL(ReKi) , DIMENSION(1:2) :: TreeBranchFactor !< Factor used to determine if a point is far enough, for full wake and lifting line [-] - INTEGER(IntKi) , DIMENSION(1:2) :: PartPerSegment !< Number of particles per segment, e.g. for tree method, for full wake and lifting line [-] - INTEGER(IntKi) :: WrVTK !< Outputs VTK at each calcoutput call, even if main fst doesnt do it [-] - INTEGER(IntKi) :: VTKBlades !< Outputs VTk for each blade 0=no blade, 1=Bld 1 [-] - REAL(DbKi) :: DTvtk !< Requested timestep between VTK outputs (calculated from the VTK_fps read in) [s] - INTEGER(IntKi) :: VTKCoord !< Switch for VTK outputs coordinate system [-] + INTEGER(IntKi) :: CircSolvMethod = 0_IntKi !< Method to determine the circulation [-] + CHARACTER(1024) :: CirculationFile = '' !< Prescribed circulation file [-] + INTEGER(IntKi) :: CircSolvMaxIter = 0_IntKi !< Maximum number of iterations for circulation solving [-] + REAL(ReKi) :: CircSolvConvCrit = 0.0_ReKi !< Convergence criterion for circulation solving [-] + REAL(ReKi) :: CircSolvRelaxation = 0.0_ReKi !< Relaxation factor for circulation solving [-] + INTEGER(IntKi) :: IntMethod = 0_IntKi !< Integration Method (1=RK4, 2=AB4, 3=ABM4, 5=Euler1, 7=Corrector/Predictor) [-] + LOGICAL :: FreeWake = .false. !< Disable roll up, wake convects with wind only (flag) [-] + REAL(ReKi) :: FreeWakeStart = 0.0_ReKi !< Time when wake starts convecting (rolling up) [s] + REAL(ReKi) :: FullCircStart = 0.0_ReKi !< Time when the circulation is full [s] + REAL(DbKi) :: DTfvw = 0.0_R8Ki !< Time interval for calculating wake induced velocities [s] + INTEGER(IntKi) :: CircSolvPolar = 0_IntKi !< (0=Use AD polars, 1=2PiAlpha, 2=sin(2pialpha) [-] + INTEGER(IntKi) :: nNWPanels = 0_IntKi !< Number of nw panels [-] + INTEGER(IntKi) :: nNWPanelsFree = 0_IntKi !< Number of nw panels [-] + INTEGER(IntKi) :: nFWPanels = 0_IntKi !< Number of fw panels [-] + INTEGER(IntKi) :: nFWPanelsFree = 0_IntKi !< Number of fw panels that are free [-] + LOGICAL :: FWShedVorticity = .false. !< Include shed vorticity in the far wake [-] + INTEGER(IntKi) :: DiffusionMethod = 0_IntKi !< Diffusion method (None, CoreSpreading, PSE) [-] + REAL(ReKi) :: CoreSpreadEddyVisc = 0.0_ReKi !< Eddy viscosity used in the core spreading method [-] + INTEGER(IntKi) :: RegDeterMethod = 0_IntKi !< Regularization determinatino method (manual, automatic) [-] + INTEGER(IntKi) :: RegFunction = 0_IntKi !< Type of regularizaion function (LambOseen, Vatistas, see FVW_BiotSavart) [-] + INTEGER(IntKi) :: WakeRegMethod = 0_IntKi !< Method for regularization (constant, stretching, age, etc.) [-] + REAL(ReKi) :: WakeRegParam = 0.0_ReKi !< Factor used in the regularization [-] + REAL(ReKi) :: WingRegParam = 0.0_ReKi !< Factor used in the regularization [-] + INTEGER(IntKi) :: ShearModel = 0_IntKi !< Option for shear modelling [-] + LOGICAL :: TwrShadowOnWake = .false. !< Include tower shadow effects on wake [-] + INTEGER(IntKi) , DIMENSION(1:2) :: VelocityMethod = 0_IntKi !< Velocity calculation method for Full Wake and for LiftingLine [-] + REAL(ReKi) , DIMENSION(1:2) :: TreeBranchFactor = 0.0_ReKi !< Factor used to determine if a point is far enough, for full wake and lifting line [-] + INTEGER(IntKi) , DIMENSION(1:2) :: PartPerSegment = 0_IntKi !< Number of particles per segment, e.g. for tree method, for full wake and lifting line [-] + INTEGER(IntKi) :: WrVTK = 0_IntKi !< Outputs VTK at each calcoutput call, even if main fst doesnt do it [-] + INTEGER(IntKi) :: VTKBlades = 0_IntKi !< Outputs VTk for each blade 0=no blade, 1=Bld 1 [-] + REAL(DbKi) :: DTvtk = 0.0_R8Ki !< Requested timestep between VTK outputs (calculated from the VTK_fps read in) [s] + INTEGER(IntKi) :: VTKCoord = 0_IntKi !< Switch for VTK outputs coordinate system [-] END TYPE FVW_InputFile ! ======================= ! ========= FVW_InitOutputType ======= TYPE, PUBLIC :: FVW_InitOutputType - INTEGER(IntKi) :: Dummy !< Empty parameter to satisfy framework [-] + INTEGER(IntKi) :: Dummy = 0_IntKi !< Empty parameter to satisfy framework [-] END TYPE FVW_InitOutputType ! ======================= CONTAINS diff --git a/modules/aerodyn/src/UnsteadyAero_Types.f90 b/modules/aerodyn/src/UnsteadyAero_Types.f90 index 3e337e98a1..1fe00c76c3 100644 --- a/modules/aerodyn/src/UnsteadyAero_Types.f90 +++ b/modules/aerodyn/src/UnsteadyAero_Types.f90 @@ -43,14 +43,14 @@ MODULE UnsteadyAero_Types INTEGER(IntKi), PUBLIC, PARAMETER :: UA_BV = 7 ! Boeing-Vertol dynamic stall model (e.g. used in CACTUS) [-] ! ========= UA_InitInputType ======= TYPE, PUBLIC :: UA_InitInputType - REAL(DbKi) :: dt !< time step [s] - CHARACTER(1024) :: OutRootName !< Supplied by Driver: The name of the root file (without extension) including the full path [-] + REAL(DbKi) :: dt = 0.0_R8Ki !< time step [s] + CHARACTER(1024) :: OutRootName = '' !< Supplied by Driver: The name of the root file (without extension) including the full path [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: c !< Chord length at node [m] - INTEGER(IntKi) :: numBlades !< Number nodes of all blades [-] - INTEGER(IntKi) :: nNodesPerBlade !< Number nodes per blades [-] - INTEGER(IntKi) :: UAMod !< Model for the dynamic stall equations [1 = Leishman/Beddoes, 2 = Gonzalez, 3 = Minnema] [-] - REAL(ReKi) :: a_s !< speed of sound [m/s] - LOGICAL :: Flookup !< Use table lookup for f' and f'' [-] + INTEGER(IntKi) :: numBlades = 0_IntKi !< Number nodes of all blades [-] + INTEGER(IntKi) :: nNodesPerBlade = 0_IntKi !< Number nodes per blades [-] + INTEGER(IntKi) :: UAMod = 0_IntKi !< Model for the dynamic stall equations [1 = Leishman/Beddoes, 2 = Gonzalez, 3 = Minnema] [-] + REAL(ReKi) :: a_s = 0.0_ReKi !< speed of sound [m/s] + LOGICAL :: Flookup = .false. !< Use table lookup for f' and f'' [-] LOGICAL :: ShedEffect = .True. !< Include the effect of shed vorticity. If False, the input alpha is assumed to already contain this effect (e.g. vortex methods) [-] LOGICAL :: WrSum = .false. !< Write UA AFI parameters to summary file? [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: UAOff_innerNode !< Last node on each blade where UA should be turned off based on span location from blade root (0 if always on) [-] @@ -121,7 +121,7 @@ MODULE UnsteadyAero_Types ! ======================= ! ========= UA_ElementContinuousStateType ======= TYPE, PUBLIC :: UA_ElementContinuousStateType - REAL(R8Ki) , DIMENSION(1:5) :: x !< continuous states when UA_Mod=4 (x1 and x2:Downwash memory terms; x3:Clp', Lift coefficient with a time lag to the attached lift coeff; x4: f'' , Final separation point function) [{rad, rad, - -}] + REAL(R8Ki) , DIMENSION(1:5) :: x = 0.0_R8Ki !< continuous states when UA_Mod=4 (x1 and x2:Downwash memory terms; x3:Clp', Lift coefficient with a time lag to the attached lift coeff; x4: f'' , Final separation point function) [{rad, rad, - -}] END TYPE UA_ElementContinuousStateType ! ======================= ! ========= UA_ContinuousStateType ======= @@ -169,7 +169,7 @@ MODULE UnsteadyAero_Types ! ======================= ! ========= UA_ConstraintStateType ======= TYPE, PUBLIC :: UA_ConstraintStateType - REAL(ReKi) :: DummyConstraintState !< [-] + REAL(ReKi) :: DummyConstraintState = 0.0_ReKi !< [-] END TYPE UA_ConstraintStateType ! ======================= ! ========= UA_OtherStateType ======= @@ -192,9 +192,9 @@ MODULE UnsteadyAero_Types ! ======================= ! ========= UA_MiscVarType ======= TYPE, PUBLIC :: UA_MiscVarType - LOGICAL :: FirstWarn_M !< flag so Mach number warning doesn't get repeated forever [-] - LOGICAL :: FirstWarn_UA !< flag so UA state warning doesn't get repeated forever [-] - LOGICAL :: FirstWarn_UA_off !< flag so UA state warning doesn't get repeated forever [-] + LOGICAL :: FirstWarn_M = .false. !< flag so Mach number warning doesn't get repeated forever [-] + LOGICAL :: FirstWarn_UA = .false. !< flag so UA state warning doesn't get repeated forever [-] + LOGICAL :: FirstWarn_UA_off = .false. !< flag so UA state warning doesn't get repeated forever [-] LOGICAL , DIMENSION(:,:), ALLOCATABLE :: TESF !< logical flag indicating if trailing edge separation is possible [-] LOGICAL , DIMENSION(:,:), ALLOCATABLE :: LESF !< logical flag indicating if leading edge separation is possible [-] LOGICAL , DIMENSION(:,:), ALLOCATABLE :: VRTX !< logical flag indicating if a vortex is being processed [-] @@ -205,41 +205,41 @@ MODULE UnsteadyAero_Types ! ======================= ! ========= UA_ParameterType ======= TYPE, PUBLIC :: UA_ParameterType - REAL(DbKi) :: dt !< time step [s] + REAL(DbKi) :: dt = 0.0_R8Ki !< time step [s] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: c !< Chord length at node [m] - INTEGER(IntKi) :: numBlades !< Number nodes of all blades [-] - INTEGER(IntKi) :: nNodesPerBlade !< Number nodes per blades [-] - INTEGER(IntKi) :: UAMod !< Model for the dynamic stall equations [1 = Leishman/Beddoes, 2 = Gonzalez, 3 = Minnema] [-] - LOGICAL :: Flookup !< Use table lookup for f' and f'' [-] - REAL(ReKi) :: a_s !< speed of sound [m/s] + INTEGER(IntKi) :: numBlades = 0_IntKi !< Number nodes of all blades [-] + INTEGER(IntKi) :: nNodesPerBlade = 0_IntKi !< Number nodes per blades [-] + INTEGER(IntKi) :: UAMod = 0_IntKi !< Model for the dynamic stall equations [1 = Leishman/Beddoes, 2 = Gonzalez, 3 = Minnema] [-] + LOGICAL :: Flookup = .false. !< Use table lookup for f' and f'' [-] + REAL(ReKi) :: a_s = 0.0_ReKi !< speed of sound [m/s] INTEGER(IntKi) :: NumOuts = 0 !< Number of outputs [-] - INTEGER(IntKi) :: OutSwtch !< Output requested channels to: [1=Unsteady.out 2=GlueCode.out 3=both files] [-] - CHARACTER(20) :: OutFmt !< Output format for numerical results [-] - CHARACTER(20) :: OutSFmt !< Output format for header strings [-] - CHARACTER(1) :: Delim !< Delimiter string for outputs, defaults to tab-delimiters [-] + INTEGER(IntKi) :: OutSwtch = 0_IntKi !< Output requested channels to: [1=Unsteady.out 2=GlueCode.out 3=both files] [-] + CHARACTER(20) :: OutFmt = '' !< Output format for numerical results [-] + CHARACTER(20) :: OutSFmt = '' !< Output format for header strings [-] + CHARACTER(1) :: Delim = '' !< Delimiter string for outputs, defaults to tab-delimiters [-] INTEGER(IntKi) :: UnOutFile = 0 !< File unit for the UnsteadyAero outputs [-] - LOGICAL :: ShedEffect !< Include the effect of shed vorticity. If False, the input alpha is assumed to already contain this effect (e.g. vortex methods) [-] + LOGICAL :: ShedEffect = .false. !< Include the effect of shed vorticity. If False, the input alpha is assumed to already contain this effect (e.g. vortex methods) [-] INTEGER(IntKi) :: lin_nx = 0 !< Number of continuous states for linearization [-] LOGICAL , DIMENSION(:,:), ALLOCATABLE :: UA_off_forGood !< logical flag indicating if UA is off for good [-] END TYPE UA_ParameterType ! ======================= ! ========= UA_InputType ======= TYPE, PUBLIC :: UA_InputType - REAL(ReKi) :: U !< air velocity magnitude relative to the airfoil [m/s] - REAL(ReKi) :: alpha !< angle of attack [rad] - REAL(ReKi) :: Re !< Reynold's number [-] + REAL(ReKi) :: U = 0.0_ReKi !< air velocity magnitude relative to the airfoil [m/s] + REAL(ReKi) :: alpha = 0.0_ReKi !< angle of attack [rad] + REAL(ReKi) :: Re = 0.0_ReKi !< Reynold's number [-] REAL(ReKi) :: UserProp = 0.0 !< UserProp value for interpolating airfoil tables [-] - REAL(ReKi) , DIMENSION(1:2) :: v_ac !< Relative fluid velocity at the aerodynamic center (UAMod=4) [m/s] - REAL(ReKi) :: omega !< pitching/twisting rate of the airfoil section (UAMod=4) [rad/s] + REAL(ReKi) , DIMENSION(1:2) :: v_ac = 0.0_ReKi !< Relative fluid velocity at the aerodynamic center (UAMod=4) [m/s] + REAL(ReKi) :: omega = 0.0_ReKi !< pitching/twisting rate of the airfoil section (UAMod=4) [rad/s] END TYPE UA_InputType ! ======================= ! ========= UA_OutputType ======= TYPE, PUBLIC :: UA_OutputType - REAL(ReKi) :: Cn !< 2D, normal to chord, force coefficient [-] - REAL(ReKi) :: Cc !< 2D, tangent to chord, force coefficient [-] - REAL(ReKi) :: Cm !< 2D pitching moment coefficient about the 1/4 chord, positive when nose is up [-] - REAL(ReKi) :: Cl !< 2D lift coefficient [-] - REAL(ReKi) :: Cd !< 2D drag coefficient [-] + REAL(ReKi) :: Cn = 0.0_ReKi !< 2D, normal to chord, force coefficient [-] + REAL(ReKi) :: Cc = 0.0_ReKi !< 2D, tangent to chord, force coefficient [-] + REAL(ReKi) :: Cm = 0.0_ReKi !< 2D pitching moment coefficient about the 1/4 chord, positive when nose is up [-] + REAL(ReKi) :: Cl = 0.0_ReKi !< 2D lift coefficient [-] + REAL(ReKi) :: Cd = 0.0_ReKi !< 2D drag coefficient [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< outputs to be written to a file [-] END TYPE UA_OutputType ! ======================= diff --git a/modules/aerodyn14/src/AeroDyn14_Types.f90 b/modules/aerodyn14/src/AeroDyn14_Types.f90 index e6b5a7a188..f1d4f0caf2 100644 --- a/modules/aerodyn14/src/AeroDyn14_Types.f90 +++ b/modules/aerodyn14/src/AeroDyn14_Types.f90 @@ -36,10 +36,10 @@ MODULE AeroDyn14_Types IMPLICIT NONE ! ========= Marker ======= TYPE, PUBLIC :: Marker - REAL(ReKi) , DIMENSION(1:3) :: Position - REAL(ReKi) , DIMENSION(1:3,1:3) :: Orientation - REAL(ReKi) , DIMENSION(1:3) :: TranslationVel - REAL(ReKi) , DIMENSION(1:3) :: RotationVel + REAL(ReKi) , DIMENSION(1:3) :: Position = 0.0 + REAL(ReKi) , DIMENSION(1:3,1:3) :: Orientation = 0.0 + REAL(ReKi) , DIMENSION(1:3) :: TranslationVel = 0.0 + REAL(ReKi) , DIMENSION(1:3) :: RotationVel = 0.0 END TYPE Marker ! ======================= ! ========= AeroConfig ======= @@ -52,7 +52,7 @@ MODULE AeroDyn14_Types TYPE(Marker) :: Tower TYPE(Marker) :: SubStructure TYPE(Marker) :: Foundation - REAL(ReKi) :: BladeLength + REAL(ReKi) :: BladeLength = 0.0_ReKi END TYPE AeroConfig ! ======================= ! ========= AirFoil ======= @@ -61,8 +61,8 @@ MODULE AeroDyn14_Types REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: CD REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: CL REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: CM - REAL(ReKi) :: PMC - REAL(ReKi) :: MulTabLoc + REAL(ReKi) :: PMC = 0.0_ReKi + REAL(ReKi) :: MulTabLoc = 0.0_ReKi END TYPE AirFoil ! ======================= ! ========= AirFoilParms ======= @@ -70,8 +70,8 @@ MODULE AeroDyn14_Types INTEGER(IntKi) :: MaxTable = 20 INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NTables INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NLift - INTEGER(IntKi) :: NumCL - INTEGER(IntKi) :: NumFoil + INTEGER(IntKi) :: NumCL = 0_IntKi + INTEGER(IntKi) :: NumFoil = 0_IntKi INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NFoil REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: MulTabMet CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: FoilNm @@ -83,21 +83,21 @@ MODULE AeroDyn14_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: ADOT1 REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AFE REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AFE1 - REAL(ReKi) :: AN + REAL(ReKi) :: AN = 0.0_ReKi REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: ANE REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: ANE1 REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AOD REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AOL LOGICAL , DIMENSION(:,:), ALLOCATABLE :: BEDSEP LOGICAL , DIMENSION(:,:), ALLOCATABLE :: OLDSEP - REAL(ReKi) :: CC + REAL(ReKi) :: CC = 0.0_ReKi REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CDO - REAL(ReKi) :: CMI - REAL(ReKi) :: CMQ - REAL(ReKi) :: CN + REAL(ReKi) :: CMI = 0.0_ReKi + REAL(ReKi) :: CMQ = 0.0_ReKi + REAL(ReKi) :: CN = 0.0_ReKi REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CNA - REAL(ReKi) :: CNCP - REAL(ReKi) :: CNIQ + REAL(ReKi) :: CNCP = 0.0_ReKi + REAL(ReKi) :: CNIQ = 0.0_ReKi REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CNP REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CNP1 REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CNPD @@ -118,10 +118,10 @@ MODULE AeroDyn14_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: DQ REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: DQP REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: DQP1 - REAL(ReKi) :: DS - REAL(ReKi) :: FK - REAL(ReKi) :: FP - REAL(ReKi) :: FPC + REAL(ReKi) :: DS = 0.0_ReKi + REAL(ReKi) :: FK = 0.0_ReKi + REAL(ReKi) :: FP = 0.0_ReKi + REAL(ReKi) :: FPC = 0.0_ReKi REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: FSP REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: FSP1 REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: FSPC @@ -142,61 +142,61 @@ MODULE AeroDyn14_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TAU REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: XN REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: YN - LOGICAL :: SHIFT - LOGICAL :: VOR + LOGICAL :: SHIFT = .false. + LOGICAL :: VOR = .false. END TYPE Beddoes ! ======================= ! ========= BeddoesParms ======= TYPE, PUBLIC :: BeddoesParms - REAL(ReKi) :: AS !< Speed of sound for mach num calc [-] - REAL(ReKi) :: TF !< Time constant applied to loc of separation pt [-] - REAL(ReKi) :: TP !< Time constant for pressure lag [-] - REAL(ReKi) :: TV !< Time constant for strength and shed of vortex [-] - REAL(ReKi) :: TVL !< Nondim time of transit of vort moving across airfoil surf [-] + REAL(ReKi) :: AS = 0.0_ReKi !< Speed of sound for mach num calc [-] + REAL(ReKi) :: TF = 0.0_ReKi !< Time constant applied to loc of separation pt [-] + REAL(ReKi) :: TP = 0.0_ReKi !< Time constant for pressure lag [-] + REAL(ReKi) :: TV = 0.0_ReKi !< Time constant for strength and shed of vortex [-] + REAL(ReKi) :: TVL = 0.0_ReKi !< Nondim time of transit of vort moving across airfoil surf [-] END TYPE BeddoesParms ! ======================= ! ========= BladeParms ======= TYPE, PUBLIC :: BladeParms REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: C !< Chord of each blade element from input file [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: DR !< Span-wise width of elem (len of elem ctred at RELM(i) [-] - REAL(ReKi) :: R !< Rotor radius [-] - REAL(ReKi) :: BladeLength !< Blade Length [-] + REAL(ReKi) :: R = 0.0_ReKi !< Rotor radius [-] + REAL(ReKi) :: BladeLength = 0.0_ReKi !< Blade Length [-] END TYPE BladeParms ! ======================= ! ========= DynInflow ======= TYPE, PUBLIC :: DynInflow - REAL(ReKi) , DIMENSION(1:6,1:4) :: dAlph_dt - REAL(ReKi) , DIMENSION(3:6,1:4) :: dBeta_dt - REAL(ReKi) :: DTO - REAL(ReKi) , DIMENSION(1:6) :: old_Alph - REAL(ReKi) , DIMENSION(3:6) :: old_Beta - REAL(ReKi) :: old_LmdM - REAL(ReKi) :: oldKai - REAL(ReKi) , DIMENSION(1:6) :: PhiLqC - REAL(ReKi) , DIMENSION(3:6) :: PhiLqS - REAL(ReKi) :: Pzero + REAL(ReKi) , DIMENSION(1:6,1:4) :: dAlph_dt = 0.0_ReKi + REAL(ReKi) , DIMENSION(3:6,1:4) :: dBeta_dt = 0.0_ReKi + REAL(ReKi) :: DTO = 0.0_ReKi + REAL(ReKi) , DIMENSION(1:6) :: old_Alph = 0.0_ReKi + REAL(ReKi) , DIMENSION(3:6) :: old_Beta = 0.0_ReKi + REAL(ReKi) :: old_LmdM = 0.0_ReKi + REAL(ReKi) :: oldKai = 0.0_ReKi + REAL(ReKi) , DIMENSION(1:6) :: PhiLqC = 0.0_ReKi + REAL(ReKi) , DIMENSION(3:6) :: PhiLqS = 0.0_ReKi + REAL(ReKi) :: Pzero = 0.0_ReKi REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: RMC_SAVE REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: RMS_SAVE - REAL(ReKi) :: TipSpeed - REAL(ReKi) :: totalInf - REAL(ReKi) :: Vparam - REAL(ReKi) :: Vtotal - REAL(ReKi) , DIMENSION(1:6) :: xAlpha - REAL(ReKi) , DIMENSION(3:6) :: xBeta - REAL(ReKi) :: xKai - REAL(ReKi) :: XLAMBDA_M - REAL(ReKi) , DIMENSION(1:6,1:6) :: xLcos - REAL(ReKi) , DIMENSION(3:6,3:6) :: xLsin - INTEGER(IntKi) , DIMENSION(1:6,1:6) :: MminR - INTEGER(IntKi) , DIMENSION(1:6,1:6) :: MminusR - INTEGER(IntKi) , DIMENSION(1:6,1:6) :: MplusR - REAL(ReKi) , DIMENSION(1:6,1:6) :: GAMMA + REAL(ReKi) :: TipSpeed = 0.0_ReKi + REAL(ReKi) :: totalInf = 0.0_ReKi + REAL(ReKi) :: Vparam = 0.0_ReKi + REAL(ReKi) :: Vtotal = 0.0_ReKi + REAL(ReKi) , DIMENSION(1:6) :: xAlpha = 0.0_ReKi + REAL(ReKi) , DIMENSION(3:6) :: xBeta = 0.0_ReKi + REAL(ReKi) :: xKai = 0.0_ReKi + REAL(ReKi) :: XLAMBDA_M = 0.0_ReKi + REAL(ReKi) , DIMENSION(1:6,1:6) :: xLcos = 0.0_ReKi + REAL(ReKi) , DIMENSION(3:6,3:6) :: xLsin = 0.0_ReKi + INTEGER(IntKi) , DIMENSION(1:6,1:6) :: MminR = 0_IntKi + INTEGER(IntKi) , DIMENSION(1:6,1:6) :: MminusR = 0_IntKi + INTEGER(IntKi) , DIMENSION(1:6,1:6) :: MplusR = 0_IntKi + REAL(ReKi) , DIMENSION(1:6,1:6) :: GAMMA = 0.0_ReKi END TYPE DynInflow ! ======================= ! ========= DynInflowParms ======= TYPE, PUBLIC :: DynInflowParms INTEGER(IntKi) :: MAXINFLO = 2 - REAL(ReKi) , DIMENSION(1:6) :: xMinv + REAL(ReKi) , DIMENSION(1:6) :: xMinv = 0.0_ReKi END TYPE DynInflowParms ! ======================= ! ========= Element ======= @@ -212,7 +212,7 @@ MODULE AeroDyn14_Types ! ======================= ! ========= ElementParms ======= TYPE, PUBLIC :: ElementParms - INTEGER(IntKi) :: NELM !< - [Number of elements (constant)] + INTEGER(IntKi) :: NELM = 0_IntKi !< - [Number of elements (constant)] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TWIST !< - [Airfoil twist angle (constant)] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: RELM !< - [Radius of element (constant)] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: HLCNST !< - [Hub loss constant B/2*(r-rh)/rh (constant)] @@ -239,15 +239,15 @@ MODULE AeroDyn14_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: SaveVX REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: SaveVY REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: SaveVZ - REAL(ReKi) :: VXSAV - REAL(ReKi) :: VYSAV - REAL(ReKi) :: VZSAV - INTEGER(IntKi) :: NumWndElOut !< Number of Blade Elements [-] + REAL(ReKi) :: VXSAV = 0.0_ReKi + REAL(ReKi) :: VYSAV = 0.0_ReKi + REAL(ReKi) :: VZSAV = 0.0_ReKi + INTEGER(IntKi) :: NumWndElOut = 0_IntKi !< Number of Blade Elements [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: WndElPrList INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: WndElPrNum INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ElPrList INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ElPrNum - INTEGER(IntKi) :: NumElOut !< Number of Blade Elements [-] + INTEGER(IntKi) :: NumElOut = 0_IntKi !< Number of Blade Elements [-] END TYPE ElOutParms ! ======================= ! ========= InducedVel ======= @@ -257,31 +257,31 @@ MODULE AeroDyn14_Types ! ======================= ! ========= InducedVelParms ======= TYPE, PUBLIC :: InducedVelParms - REAL(ReKi) :: AToler !< Convergence tolerance for induction factor [-] - REAL(ReKi) :: EqAIDmult !< Multiplier for drag term in axial-induction equation. [-] - LOGICAL :: EquilDA !< False unless DB or DA appended to EQUIL [-] - LOGICAL :: EquilDT !< False unless DB or DT appended to EQUIL [-] - LOGICAL :: TLoss !< Tip-loss model (EQUIL only) [PRANDtl, GTECH, or NONE] [-] - LOGICAL :: GTech !< Tip-loss model (EQUIL only) [PRANDtl, GTECH, or NONE] [-] - LOGICAL :: HLoss !< Hub-loss model (EQUIL only) [PRANDtl or NONE] [-] + REAL(ReKi) :: AToler = 0.0_ReKi !< Convergence tolerance for induction factor [-] + REAL(ReKi) :: EqAIDmult = 0.0_ReKi !< Multiplier for drag term in axial-induction equation. [-] + LOGICAL :: EquilDA = .false. !< False unless DB or DA appended to EQUIL [-] + LOGICAL :: EquilDT = .false. !< False unless DB or DT appended to EQUIL [-] + LOGICAL :: TLoss = .false. !< Tip-loss model (EQUIL only) [PRANDtl, GTECH, or NONE] [-] + LOGICAL :: GTech = .false. !< Tip-loss model (EQUIL only) [PRANDtl, GTECH, or NONE] [-] + LOGICAL :: HLoss = .false. !< Hub-loss model (EQUIL only) [PRANDtl or NONE] [-] END TYPE InducedVelParms ! ======================= ! ========= Rotor ======= TYPE, PUBLIC :: Rotor - REAL(ReKi) :: AVGINFL !< average induced velocity at the previous time [-] - REAL(ReKi) :: CTILT - REAL(ReKi) :: CYaw - REAL(ReKi) :: REVS - REAL(ReKi) :: STILT - REAL(ReKi) :: SYaw - REAL(ReKi) :: TILT - REAL(ReKi) :: YawAng - REAL(ReKi) :: YawVEL + REAL(ReKi) :: AVGINFL = 0.0_ReKi !< average induced velocity at the previous time [-] + REAL(ReKi) :: CTILT = 0.0_ReKi + REAL(ReKi) :: CYaw = 0.0_ReKi + REAL(ReKi) :: REVS = 0.0_ReKi + REAL(ReKi) :: STILT = 0.0_ReKi + REAL(ReKi) :: SYaw = 0.0_ReKi + REAL(ReKi) :: TILT = 0.0_ReKi + REAL(ReKi) :: YawAng = 0.0_ReKi + REAL(ReKi) :: YawVEL = 0.0_ReKi END TYPE Rotor ! ======================= ! ========= RotorParms ======= TYPE, PUBLIC :: RotorParms - REAL(ReKi) :: HH + REAL(ReKi) :: HH = 0.0_ReKi END TYPE RotorParms ! ======================= ! ========= TwrPropsParms ======= @@ -290,66 +290,66 @@ MODULE AeroDyn14_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrWid REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TwrCD REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrRe - REAL(ReKi) , DIMENSION(1:3) :: VTwr - REAL(ReKi) :: Tower_Wake_Constant + REAL(ReKi) , DIMENSION(1:3) :: VTwr = 0.0_ReKi + REAL(ReKi) :: Tower_Wake_Constant = 0.0_ReKi INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NTwrCDCol !< The tower CD column that represents a particular twr ht [-] - INTEGER(IntKi) :: NTwrHT !< The number of tower height rows in the table [-] - INTEGER(IntKi) :: NTwrRe !< The number of tower Re entry rows in the table [-] - INTEGER(IntKi) :: NTwrCD !< The number of tower CD columns in the table [-] - LOGICAL :: TwrPotent !< Tower influence model [-] - LOGICAL :: TwrShadow !< Tower shadow model [-] - REAL(ReKi) :: ShadHWid !< Tower-shadow half width [m] - REAL(ReKi) :: TShadC1 !< Tower-shadow constant [-] - REAL(ReKi) :: TShadC2 !< Tower-shadow constant [-] - REAL(ReKi) :: TwrShad !< Tower-shadow velocity deficit [-] - LOGICAL :: PJM_Version !< Only true if new tower influence model, by PJM [-] - CHARACTER(1024) :: TwrFile !< Tower data file name [-] - REAL(ReKi) :: T_Shad_Refpt !< Tower-shadow reference point [m] - LOGICAL :: CalcTwrAero !< Flag to tell AeroDyn to calculate drag on the tower [m] - INTEGER(IntKi) :: NumTwrNodes !< Number of ElastoDyn tower nodes. Tower drag will be computed at those points. [-] + INTEGER(IntKi) :: NTwrHT = 0_IntKi !< The number of tower height rows in the table [-] + INTEGER(IntKi) :: NTwrRe = 0_IntKi !< The number of tower Re entry rows in the table [-] + INTEGER(IntKi) :: NTwrCD = 0_IntKi !< The number of tower CD columns in the table [-] + LOGICAL :: TwrPotent = .false. !< Tower influence model [-] + LOGICAL :: TwrShadow = .false. !< Tower shadow model [-] + REAL(ReKi) :: ShadHWid = 0.0_ReKi !< Tower-shadow half width [m] + REAL(ReKi) :: TShadC1 = 0.0_ReKi !< Tower-shadow constant [-] + REAL(ReKi) :: TShadC2 = 0.0_ReKi !< Tower-shadow constant [-] + REAL(ReKi) :: TwrShad = 0.0_ReKi !< Tower-shadow velocity deficit [-] + LOGICAL :: PJM_Version = .false. !< Only true if new tower influence model, by PJM [-] + CHARACTER(1024) :: TwrFile = '' !< Tower data file name [-] + REAL(ReKi) :: T_Shad_Refpt = 0.0_ReKi !< Tower-shadow reference point [m] + LOGICAL :: CalcTwrAero = .false. !< Flag to tell AeroDyn to calculate drag on the tower [m] + INTEGER(IntKi) :: NumTwrNodes = 0_IntKi !< Number of ElastoDyn tower nodes. Tower drag will be computed at those points. [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrNodeWidth !< The width (diameter) of the tower at the ElastoDyn node locations. [-] END TYPE TwrPropsParms ! ======================= ! ========= Wind ======= TYPE, PUBLIC :: Wind - REAL(ReKi) :: ANGFLW - REAL(ReKi) :: CDEL - REAL(ReKi) :: VROTORX - REAL(ReKi) :: VROTORY - REAL(ReKi) :: VROTORZ - REAL(ReKi) :: SDEL + REAL(ReKi) :: ANGFLW = 0.0_ReKi + REAL(ReKi) :: CDEL = 0.0_ReKi + REAL(ReKi) :: VROTORX = 0.0_ReKi + REAL(ReKi) :: VROTORY = 0.0_ReKi + REAL(ReKi) :: VROTORZ = 0.0_ReKi + REAL(ReKi) :: SDEL = 0.0_ReKi END TYPE Wind ! ======================= ! ========= WindParms ======= TYPE, PUBLIC :: WindParms - REAL(ReKi) :: Rho !< Air density [kg/m^3] - REAL(ReKi) :: KinVisc !< Kinematic air viscosity [(m^2/sec)] + REAL(ReKi) :: Rho = 0.0_ReKi !< Air density [kg/m^3] + REAL(ReKi) :: KinVisc = 0.0_ReKi !< Kinematic air viscosity [(m^2/sec)] END TYPE WindParms ! ======================= ! ========= PositionType ======= TYPE, PUBLIC :: PositionType - REAL(ReKi) , DIMENSION(1:3) :: Pos !< X,Y,Z coordinate of a point [-] + REAL(ReKi) , DIMENSION(1:3) :: Pos = 0.0_ReKi !< X,Y,Z coordinate of a point [-] END TYPE PositionType ! ======================= ! ========= OrientationType ======= TYPE, PUBLIC :: OrientationType - REAL(ReKi) , DIMENSION(1:3,1:3) :: Orient !< Direction Cosine Matrix [-] + REAL(ReKi) , DIMENSION(1:3,1:3) :: Orient = 0.0_ReKi !< Direction Cosine Matrix [-] END TYPE OrientationType ! ======================= ! ========= AD14_InitInputType ======= TYPE, PUBLIC :: AD14_InitInputType - CHARACTER(1024) :: Title !< Title [-] - CHARACTER(1024) :: OutRootName - CHARACTER(1024) :: ADFileName !< AeroDyn file name [-] - LOGICAL :: WrSumFile !< T/F: Write an AeroDyn summary [-] - INTEGER(IntKi) :: NumBl !< Number of Blades [-] - REAL(ReKi) :: BladeLength !< Blade Length [-] - LOGICAL :: LinearizeFlag + CHARACTER(1024) :: Title = '' !< Title [-] + CHARACTER(1024) :: OutRootName = '' + CHARACTER(1024) :: ADFileName = '' !< AeroDyn file name [-] + LOGICAL :: WrSumFile = .false. !< T/F: Write an AeroDyn summary [-] + INTEGER(IntKi) :: NumBl = 0_IntKi !< Number of Blades [-] + REAL(ReKi) :: BladeLength = 0.0_ReKi !< Blade Length [-] + LOGICAL :: LinearizeFlag = .false. LOGICAL :: UseDWM = .FALSE. !< flag to determine if DWM module should be used [-] TYPE(AeroConfig) :: TurbineComponents - INTEGER(IntKi) :: NumTwrNodes !< Number of ElastoDyn tower nodes. Tower drag will be computed at those points. [-] + INTEGER(IntKi) :: NumTwrNodes = 0_IntKi !< Number of ElastoDyn tower nodes. Tower drag will be computed at those points. [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TwrNodeLocs !< Location of ElastoDyn tower nodes with respect to the inertial origin. [-] - REAL(ReKi) :: HubHt !< hub height wrt inertial origin [m] + REAL(ReKi) :: HubHt = 0.0_ReKi !< hub height wrt inertial origin [m] TYPE(DWM_InitInputType) :: DWM END TYPE AD14_InitInputType ! ======================= @@ -357,7 +357,7 @@ MODULE AeroDyn14_Types TYPE, PUBLIC :: AD14_InitOutputType TYPE(ProgDesc) :: Ver !< version information [-] TYPE(DWM_InitOutputType) :: DWM - REAL(ReKi) :: AirDens !< Air density [kg/m^3] + REAL(ReKi) :: AirDens = 0.0_ReKi !< Air density [kg/m^3] END TYPE AD14_InitOutputType ! ======================= ! ========= AD14_ContinuousStateType ======= @@ -385,13 +385,13 @@ MODULE AeroDyn14_Types TYPE(DWM_MiscVarType) :: DWM !< variables for DWM module [-] TYPE(DWM_InputType) :: DWM_Inputs TYPE(DWM_OutputType) :: DWM_Outputs - REAL(DbKi) :: DT !< actual Time step [seconds] + REAL(DbKi) :: DT = 0.0_R8Ki !< actual Time step [seconds] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ElPrNum - REAL(DbKi) :: OldTime + REAL(DbKi) :: OldTime = 0.0_R8Ki REAL(ReKi) :: HubLoss = 1 REAL(ReKi) :: Loss = 1 REAL(ReKi) :: TipLoss = 1 - REAL(ReKi) :: TLpt7 + REAL(ReKi) :: TLpt7 = 0.0_ReKi LOGICAL :: FirstPassGTL = .TRUE. LOGICAL :: SuperSonic = .FALSE. LOGICAL :: AFLAGVinderr = .FALSE. @@ -407,34 +407,34 @@ MODULE AeroDyn14_Types TYPE(Wind) :: Wind TYPE(InducedVel) :: InducedVel TYPE(ElOutParms) :: ElOut - LOGICAL :: Skew - LOGICAL :: DynInit !< FALSE=EQUIL, TRUE=DYNIN [-] - LOGICAL :: FirstWarn !< If it's the first warning about AeroDyn not recalculating loads [-] + LOGICAL :: Skew = .false. + LOGICAL :: DynInit = .false. !< FALSE=EQUIL, TRUE=DYNIN [-] + LOGICAL :: FirstWarn = .false. !< If it's the first warning about AeroDyn not recalculating loads [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: StoredForces REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: StoredMoments END TYPE AD14_MiscVarType ! ======================= ! ========= AD14_ParameterType ======= TYPE, PUBLIC :: AD14_ParameterType - CHARACTER(1024) :: Title !< Title [-] - LOGICAL :: SIUnit + CHARACTER(1024) :: Title = '' !< Title [-] + LOGICAL :: SIUnit = .false. LOGICAL :: Echo = .FALSE. - LOGICAL :: MultiTab - LOGICAL :: LinearizeFlag + LOGICAL :: MultiTab = .false. + LOGICAL :: LinearizeFlag = .false. LOGICAL :: OutputPlottingInfo = .FALSE. LOGICAL :: UseDWM = .FALSE. !< flag to determine if DWM module should be used [-] - REAL(ReKi) :: TwoPiNB !< 2*pi/num of blades [-] - INTEGER(IntKi) :: NumBl !< Number of Blades [-] - INTEGER(IntKi) :: NBlInpSt !< Number of Blade Input Stations [-] - LOGICAL :: ElemPrn - LOGICAL :: DStall !< FALSE=Steady, TRUE=BEDDOES [-] - LOGICAL :: PMoment !< FALSE=NO_CM, TRUE=USE_CM [-] - LOGICAL :: Reynolds - LOGICAL :: DynInfl !< FALSE=EQUIL, TRUE=DYNIN [-] - LOGICAL :: Wake !< False unless WAKE or SWIRL [-] - LOGICAL :: Swirl !< False unless WAKE or SWIRL [-] - REAL(DbKi) :: DtAero !< Time interval for aerodynamic calculations [-] - REAL(ReKi) :: HubRad !< Hub radius [m] + REAL(ReKi) :: TwoPiNB = 0.0_ReKi !< 2*pi/num of blades [-] + INTEGER(IntKi) :: NumBl = 0_IntKi !< Number of Blades [-] + INTEGER(IntKi) :: NBlInpSt = 0_IntKi !< Number of Blade Input Stations [-] + LOGICAL :: ElemPrn = .false. + LOGICAL :: DStall = .false. !< FALSE=Steady, TRUE=BEDDOES [-] + LOGICAL :: PMoment = .false. !< FALSE=NO_CM, TRUE=USE_CM [-] + LOGICAL :: Reynolds = .false. + LOGICAL :: DynInfl = .false. !< FALSE=EQUIL, TRUE=DYNIN [-] + LOGICAL :: Wake = .false. !< False unless WAKE or SWIRL [-] + LOGICAL :: Swirl = .false. !< False unless WAKE or SWIRL [-] + REAL(DbKi) :: DtAero = 0.0_R8Ki !< Time interval for aerodynamic calculations [-] + REAL(ReKi) :: HubRad = 0.0_ReKi !< Hub radius [m] INTEGER(IntKi) :: UnEc = -1 INTEGER(IntKi) :: UnElem = -1 INTEGER(IntKi) :: UnWndOut = -1 @@ -460,7 +460,7 @@ MODULE AeroDyn14_Types TYPE(AeroConfig) :: TurbineComponents !< Current locations of components [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: MulTabLoc REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: InflowVelocity !< U,V,W wind inflow speeds at all locations on the Inputmarker and Twr_InputMarker meshes [m/s] - REAL(ReKi) , DIMENSION(1:3) :: AvgInfVel !< an average disk velocity (depends on wind type and should be removed) [m/s] + REAL(ReKi) , DIMENSION(1:3) :: AvgInfVel = 0.0_ReKi !< an average disk velocity (depends on wind type and should be removed) [m/s] END TYPE AD14_InputType ! ======================= ! ========= AD14_OutputType ======= diff --git a/modules/aerodyn14/src/DWM_Types.f90 b/modules/aerodyn14/src/DWM_Types.f90 index 4924f00a1b..67b3d06f31 100644 --- a/modules/aerodyn14/src/DWM_Types.f90 +++ b/modules/aerodyn14/src/DWM_Types.f90 @@ -54,30 +54,30 @@ MODULE DWM_Types ! ======================= ! ========= DWM_Wake_Deficit_Data ======= TYPE, PUBLIC :: DWM_Wake_Deficit_Data - INTEGER(IntKi) :: np_x !< point per axial distance [-] - REAL(ReKi) :: X_length !< normalized length in axial direction [-] + INTEGER(IntKi) :: np_x = 0_IntKi !< point per axial distance [-] + REAL(ReKi) :: X_length = 0.0_ReKi !< normalized length in axial direction [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Turb_Stress_DWM !< [-] - INTEGER(IntKi) :: n_x_vector !< [-] - INTEGER(IntKi) :: n_r_vector !< [-] - REAL(ReKi) :: ppR !< Point_per_R_resoulution [-] + INTEGER(IntKi) :: n_x_vector = 0_IntKi !< [-] + INTEGER(IntKi) :: n_r_vector = 0_IntKi !< [-] + REAL(ReKi) :: ppR = 0.0_ReKi !< Point_per_R_resoulution [-] END TYPE DWM_Wake_Deficit_Data ! ======================= ! ========= MeanderData ======= TYPE, PUBLIC :: MeanderData - INTEGER(IntKi) :: scale_factor !< [-] - INTEGER(IntKi) :: moving_time !< [-] + INTEGER(IntKi) :: scale_factor = 0_IntKi !< [-] + INTEGER(IntKi) :: moving_time = 0_IntKi !< [-] END TYPE MeanderData ! ======================= ! ========= read_turbine_position_data ======= TYPE, PUBLIC :: read_turbine_position_data - INTEGER(IntKi) :: SimulationOrder_index !< [-] + INTEGER(IntKi) :: SimulationOrder_index = 0_IntKi !< [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: Turbine_sort_order !< [-] - INTEGER(IntKi) :: WT_index !< wind turbine index in the wind farm [-] + INTEGER(IntKi) :: WT_index = 0_IntKi !< wind turbine index in the wind farm [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: TurbineInfluenceData !< [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: upwind_turbine_index !< the upwind turbines that affecting this turbine [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: downwind_turbine_index !< [-] - INTEGER(IntKi) :: upwindturbine_number !< the number of upwind turbines affecting the downwind turbine [-] - INTEGER(IntKi) :: downwindturbine_number !< [-] + INTEGER(IntKi) :: upwindturbine_number = 0_IntKi !< the number of upwind turbines affecting the downwind turbine [-] + INTEGER(IntKi) :: downwindturbine_number = 0_IntKi !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: turbine_windorigin_length !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: upwind_turbine_projected_distance !< the projected distance between two turbines [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: downwind_turbine_projected_distance !< [-] @@ -95,52 +95,52 @@ MODULE DWM_Types ! ========= WeiMethod ======= TYPE, PUBLIC :: WeiMethod REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: sweptarea !< [-] - REAL(ReKi) :: weighting_denominator !< [-] + REAL(ReKi) :: weighting_denominator = 0.0_ReKi !< [-] END TYPE WeiMethod ! ======================= ! ========= TIDownstream ======= TYPE, PUBLIC :: TIDownstream REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TI_downstream_matrix !< [-] - INTEGER(IntKi) :: i !< [-] - INTEGER(IntKi) :: j !< [-] - INTEGER(IntKi) :: k !< [-] - INTEGER(IntKi) :: cross_plane_position_ds !< the cross plane position which to be investigated in term of the flying time [-] - INTEGER(IntKi) :: cross_plane_position_TI !< the cross plane position which to be investigated in term of the n_x_vector [-] - INTEGER(IntKi) :: distance_index !< the index of the distance in the TI axisymmetric array [-] - INTEGER(IntKi) :: counter1 !< [-] - INTEGER(IntKi) :: counter2 !< [-] - INTEGER(IntKi) :: initial_timestep !< [-] - REAL(ReKi) :: y_axis_turbine !< [-] - REAL(ReKi) :: z_axis_turbine !< [-] - REAL(ReKi) :: distance !< the distance between one point to the meandered wake center [-] - REAL(ReKi) :: TI_downstream_node !< the TI at a specfic point in the inbestigated cross plane [-] - REAL(ReKi) :: TI_node_temp !< [-] - REAL(ReKi) :: TI_node !< [-] - REAL(ReKi) :: TI_accumulation !< [-] - REAL(ReKi) :: TI_apprant_accumulation !< [-] - REAL(ReKi) :: TI_average !< THE AVERAGE TI OF THE CROSS PLANE [-] - REAL(ReKi) :: TI_apprant !< The TI due to the meadering [-] - REAL(ReKi) :: HubHt !< [-] - REAL(ReKi) :: wake_center_y !< [-] - REAL(ReKi) :: wake_center_z !< [-] - REAL(ReKi) :: Rscale !< [-] - REAL(ReKi) :: y !< [-] - REAL(ReKi) :: z !< [-] - REAL(ReKi) :: zero_spacing !< [-] - REAL(ReKi) :: temp1 !< [-] - REAL(ReKi) :: temp2 !< [-] - REAL(ReKi) :: temp3 !< [-] + INTEGER(IntKi) :: i = 0_IntKi !< [-] + INTEGER(IntKi) :: j = 0_IntKi !< [-] + INTEGER(IntKi) :: k = 0_IntKi !< [-] + INTEGER(IntKi) :: cross_plane_position_ds = 0_IntKi !< the cross plane position which to be investigated in term of the flying time [-] + INTEGER(IntKi) :: cross_plane_position_TI = 0_IntKi !< the cross plane position which to be investigated in term of the n_x_vector [-] + INTEGER(IntKi) :: distance_index = 0_IntKi !< the index of the distance in the TI axisymmetric array [-] + INTEGER(IntKi) :: counter1 = 0_IntKi !< [-] + INTEGER(IntKi) :: counter2 = 0_IntKi !< [-] + INTEGER(IntKi) :: initial_timestep = 0_IntKi !< [-] + REAL(ReKi) :: y_axis_turbine = 0.0_ReKi !< [-] + REAL(ReKi) :: z_axis_turbine = 0.0_ReKi !< [-] + REAL(ReKi) :: distance = 0.0_ReKi !< the distance between one point to the meandered wake center [-] + REAL(ReKi) :: TI_downstream_node = 0.0_ReKi !< the TI at a specfic point in the inbestigated cross plane [-] + REAL(ReKi) :: TI_node_temp = 0.0_ReKi !< [-] + REAL(ReKi) :: TI_node = 0.0_ReKi !< [-] + REAL(ReKi) :: TI_accumulation = 0.0_ReKi !< [-] + REAL(ReKi) :: TI_apprant_accumulation = 0.0_ReKi !< [-] + REAL(ReKi) :: TI_average = 0.0_ReKi !< THE AVERAGE TI OF THE CROSS PLANE [-] + REAL(ReKi) :: TI_apprant = 0.0_ReKi !< The TI due to the meadering [-] + REAL(ReKi) :: HubHt = 0.0_ReKi !< [-] + REAL(ReKi) :: wake_center_y = 0.0_ReKi !< [-] + REAL(ReKi) :: wake_center_z = 0.0_ReKi !< [-] + REAL(ReKi) :: Rscale = 0.0_ReKi !< [-] + REAL(ReKi) :: y = 0.0_ReKi !< [-] + REAL(ReKi) :: z = 0.0_ReKi !< [-] + REAL(ReKi) :: zero_spacing = 0.0_ReKi !< [-] + REAL(ReKi) :: temp1 = 0.0_ReKi !< [-] + REAL(ReKi) :: temp2 = 0.0_ReKi !< [-] + REAL(ReKi) :: temp3 = 0.0_ReKi !< [-] END TYPE TIDownstream ! ======================= ! ========= TurbKaimal ======= TYPE, PUBLIC :: TurbKaimal - INTEGER(IntKi) :: fs !< sample frequency [-] - INTEGER(IntKi) :: temp_n !< [-] - INTEGER(IntKi) :: i !< [-] - REAL(ReKi) :: low_f !< lower bound of frequency range [-] - REAL(ReKi) :: high_f !< upper bound of frequency range [-] - REAL(ReKi) :: lk_facor !< turbulence length-scale [-] - REAL(ReKi) :: STD !< standard deviation of the turbulence [-] + INTEGER(IntKi) :: fs = 0_IntKi !< sample frequency [-] + INTEGER(IntKi) :: temp_n = 0_IntKi !< [-] + INTEGER(IntKi) :: i = 0_IntKi !< [-] + REAL(ReKi) :: low_f = 0.0_ReKi !< lower bound of frequency range [-] + REAL(ReKi) :: high_f = 0.0_ReKi !< upper bound of frequency range [-] + REAL(ReKi) :: lk_facor = 0.0_ReKi !< turbulence length-scale [-] + REAL(ReKi) :: STD = 0.0_ReKi !< standard deviation of the turbulence [-] END TYPE TurbKaimal ! ======================= ! ========= Shinozuka ======= @@ -150,29 +150,29 @@ MODULE DWM_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: phi !< random phase angle [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: p_k !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: a_k !< [-] - INTEGER(IntKi) :: num_points !< total number of points [-] - INTEGER(IntKi) :: ILo !< [-] - INTEGER(IntKi) :: i !< [-] - INTEGER(IntKi) :: j !< [-] - REAL(ReKi) :: dt !< time step [-] - REAL(ReKi) :: t_min !< [-] - REAL(ReKi) :: t_max !< [-] - REAL(ReKi) :: df !< frequency step [-] + INTEGER(IntKi) :: num_points = 0_IntKi !< total number of points [-] + INTEGER(IntKi) :: ILo = 0_IntKi !< [-] + INTEGER(IntKi) :: i = 0_IntKi !< [-] + INTEGER(IntKi) :: j = 0_IntKi !< [-] + REAL(ReKi) :: dt = 0.0_ReKi !< time step [-] + REAL(ReKi) :: t_min = 0.0_ReKi !< [-] + REAL(ReKi) :: t_max = 0.0_ReKi !< [-] + REAL(ReKi) :: df = 0.0_ReKi !< frequency step [-] END TYPE Shinozuka ! ======================= ! ========= smooth_out_wake_data ======= TYPE, PUBLIC :: smooth_out_wake_data - INTEGER(IntKi) :: length_velocity_array !< the length of velocity_array [-] + INTEGER(IntKi) :: length_velocity_array = 0_IntKi !< the length of velocity_array [-] END TYPE smooth_out_wake_data ! ======================= ! ========= SWSV ======= TYPE, PUBLIC :: SWSV - INTEGER(IntKi) :: p1 !< [-] - INTEGER(IntKi) :: p2 !< [-] - REAL(ReKi) :: distance !< the distance from the point to the meandered wake center [-] - REAL(ReKi) :: y0 !< wake center position on y axis [-] - REAL(ReKi) :: z0 !< wake center position on z axis [-] - REAL(ReKi) :: unit !< single unit length R/ppR [-] + INTEGER(IntKi) :: p1 = 0_IntKi !< [-] + INTEGER(IntKi) :: p2 = 0_IntKi !< [-] + REAL(ReKi) :: distance = 0.0_ReKi !< the distance from the point to the meandered wake center [-] + REAL(ReKi) :: y0 = 0.0_ReKi !< wake center position on y axis [-] + REAL(ReKi) :: z0 = 0.0_ReKi !< wake center position on z axis [-] + REAL(ReKi) :: unit = 0.0_ReKi !< single unit length R/ppR [-] END TYPE SWSV ! ======================= ! ========= read_upwind_result ======= @@ -197,9 +197,9 @@ MODULE DWM_Types ! ======================= ! ========= DWM_turbine_blade ======= TYPE, PUBLIC :: DWM_turbine_blade - INTEGER(IntKi) :: Aerodyn_turbine_num !< [-] - INTEGER(IntKi) :: Blade_index !< the index of Aerodyn Blade [-] - INTEGER(IntKi) :: Element_index !< the index of Aerodyn Element [-] + INTEGER(IntKi) :: Aerodyn_turbine_num = 0_IntKi !< [-] + INTEGER(IntKi) :: Blade_index = 0_IntKi !< the index of Aerodyn Blade [-] + INTEGER(IntKi) :: Element_index = 0_IntKi !< the index of Aerodyn Element [-] END TYPE DWM_turbine_blade ! ======================= ! ========= DWM_ParameterType ======= @@ -207,28 +207,28 @@ MODULE DWM_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: velocityU !< the wake velocity profile @ the downstream turbine plane [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: smoothed_wake !< [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: WakePosition !< meandered wake center [-] - INTEGER(IntKi) :: WakePosition_1 !< size of the WakePosition [-] - INTEGER(IntKi) :: WakePosition_2 !< size of the WakePosition [-] - INTEGER(IntKi) :: smooth_flag !< Whether or not use the smoothed out upstream wake profile (1-yes, 0-no) [-] - INTEGER(IntKi) :: p_p_r !< [-] - INTEGER(IntKi) :: NumWT !< Number of wind turbines [-] - INTEGER(IntKi) :: Tinfluencer !< [-] - REAL(ReKi) :: RotorR !< Rotor radius [-] - REAL(ReKi) :: r_domain !< [-] - REAL(ReKi) :: x_domain !< [-] - REAL(ReKi) :: Uambient !< The ambient wind velocity [-] - REAL(ReKi) :: TI_amb !< Ambient turbulence intensity [%] - REAL(ReKi) :: TI_wake !< [-] - REAL(ReKi) :: hub_height !< [-] - REAL(ReKi) :: length_velocityU !< [-] - REAL(ReKi) :: WFLowerBd !< The lower bound height of the wind file [-] - REAL(ReKi) :: Wind_file_Mean_u !< The mean velocity of the first turbine [-] - REAL(ReKi) :: Winddir !< [-] - REAL(ReKi) :: air_density !< air density [-] - REAL(ReKi) :: RR !< [-] + INTEGER(IntKi) :: WakePosition_1 = 0_IntKi !< size of the WakePosition [-] + INTEGER(IntKi) :: WakePosition_2 = 0_IntKi !< size of the WakePosition [-] + INTEGER(IntKi) :: smooth_flag = 0_IntKi !< Whether or not use the smoothed out upstream wake profile (1-yes, 0-no) [-] + INTEGER(IntKi) :: p_p_r = 0_IntKi !< [-] + INTEGER(IntKi) :: NumWT = 0_IntKi !< Number of wind turbines [-] + INTEGER(IntKi) :: Tinfluencer = 0_IntKi !< [-] + REAL(ReKi) :: RotorR = 0.0_ReKi !< Rotor radius [-] + REAL(ReKi) :: r_domain = 0.0_ReKi !< [-] + REAL(ReKi) :: x_domain = 0.0_ReKi !< [-] + REAL(ReKi) :: Uambient = 0.0_ReKi !< The ambient wind velocity [-] + REAL(ReKi) :: TI_amb = 0.0_ReKi !< Ambient turbulence intensity [%] + REAL(ReKi) :: TI_wake = 0.0_ReKi !< [-] + REAL(ReKi) :: hub_height = 0.0_ReKi !< [-] + REAL(ReKi) :: length_velocityU = 0.0_ReKi !< [-] + REAL(ReKi) :: WFLowerBd = 0.0_ReKi !< The lower bound height of the wind file [-] + REAL(ReKi) :: Wind_file_Mean_u = 0.0_ReKi !< The mean velocity of the first turbine [-] + REAL(ReKi) :: Winddir = 0.0_ReKi !< [-] + REAL(ReKi) :: air_density = 0.0_ReKi !< air density [-] + REAL(ReKi) :: RR = 0.0_ReKi !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ElementRad !< the element node radius [-] - INTEGER(IntKi) :: Bnum !< the number of blade [-] - INTEGER(IntKi) :: ElementNum !< the number of element [-] + INTEGER(IntKi) :: Bnum = 0_IntKi !< the number of blade [-] + INTEGER(IntKi) :: ElementNum = 0_IntKi !< the number of element [-] TYPE(read_turbine_position_data) :: RTPD TYPE(InflowWind_ParameterType) :: IfW END TYPE DWM_ParameterType @@ -241,16 +241,16 @@ MODULE DWM_Types ! ========= DWM_MiscVarType ======= TYPE, PUBLIC :: DWM_MiscVarType TYPE(InflowWind_MiscVarType) :: IfW - REAL(ReKi) :: position_y !< the y position of the blade node [-] - REAL(ReKi) :: position_z !< the z position of the blade node [-] - REAL(ReKi) :: velocity_wake_mean !< [-] - REAL(ReKi) :: shifted_velocity_Aerodyn !< [-] - REAL(ReKi) :: U_velocity !< the u component velocity of blade [-] - REAL(ReKi) :: V_velocity !< the v component velocity of blade [-] + REAL(ReKi) :: position_y = 0.0_ReKi !< the y position of the blade node [-] + REAL(ReKi) :: position_z = 0.0_ReKi !< the z position of the blade node [-] + REAL(ReKi) :: velocity_wake_mean = 0.0_ReKi !< [-] + REAL(ReKi) :: shifted_velocity_Aerodyn = 0.0_ReKi !< [-] + REAL(ReKi) :: U_velocity = 0.0_ReKi !< the u component velocity of blade [-] + REAL(ReKi) :: V_velocity = 0.0_ReKi !< the v component velocity of blade [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Nforce !< the normal force [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: blade_dr !< blade dr [-] - REAL(ReKi) :: NacYaw !< [-] - REAL(ReKi) :: TI_original !< [-] + REAL(ReKi) :: NacYaw = 0.0_ReKi !< [-] + REAL(ReKi) :: TI_original = 0.0_ReKi !< [-] TYPE(turbine_average_velocity_data) :: TAVD TYPE(CVSD) :: CalVelScale_data TYPE(MeanderData) :: meandering_data @@ -261,8 +261,8 @@ MODULE DWM_Types TYPE(smooth_out_wake_data) :: SmoothOut TYPE(SWSV) :: smooth_wake_shifted_velocity_data TYPE(DWM_Wake_Deficit_Data) :: DWDD - REAL(ReKi) :: ct_tilde !< the tilde Ct [-] - REAL(ReKi) :: FAST_Time !< FAST simulation time [-] + REAL(ReKi) :: ct_tilde = 0.0_ReKi !< the tilde Ct [-] + REAL(ReKi) :: FAST_Time = 0.0_ReKi !< FAST simulation time [-] INTEGER(IntKi) :: SDtimestep = 0 !< [-] TYPE(DWM_turbine_blade) :: DWM_tb TYPE(wake_meandered_center) :: WMC @@ -281,47 +281,47 @@ MODULE DWM_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: r_initial !< scaled rotor radius [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: U_initial !< scaled velocity at the rotor [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Mean_FFWS_array !< Mean velocity of each section on the blade [-] - REAL(ReKi) :: Mean_FFWS !< Mean (total) wind speed at the hub height [m/s] - REAL(ReKi) :: TI !< the turbulence intensity of the turbine [-] - REAL(ReKi) :: TI_downstream !< the TI of a downstream turbine before normalization [-] + REAL(ReKi) :: Mean_FFWS = 0.0_ReKi !< Mean (total) wind speed at the hub height [m/s] + REAL(ReKi) :: TI = 0.0_ReKi !< the turbulence intensity of the turbine [-] + REAL(ReKi) :: TI_downstream = 0.0_ReKi !< the TI of a downstream turbine before normalization [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: wake_u !< wake velocity [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: wake_position !< wake center position [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: smoothed_velocity_array !< smoothed out upstream axisymetric wake profile [-] - REAL(ReKi) :: AtmUscale !< atmospheric velocity scale before introducing TI [-] - REAL(ReKi) :: du_dz_ABL !< atmosperic shear gradient [-] + REAL(ReKi) :: AtmUscale = 0.0_ReKi !< atmospheric velocity scale before introducing TI [-] + REAL(ReKi) :: du_dz_ABL = 0.0_ReKi !< atmosperic shear gradient [-] REAL(ReKi) :: total_SDgenpwr = 0.0 !< [-] - REAL(ReKi) :: mean_SDgenpwr !< [-] - REAL(ReKi) :: avg_ct !< average Ct over the rotor [-] + REAL(ReKi) :: mean_SDgenpwr = 0.0_ReKi !< [-] + REAL(ReKi) :: avg_ct = 0.0_ReKi !< average Ct over the rotor [-] TYPE(InflowWind_OutputType) :: IfW END TYPE DWM_OutputType ! ======================= ! ========= DWM_ContinuousStateType ======= TYPE, PUBLIC :: DWM_ContinuousStateType - REAL(ReKi) :: dummy !< [-] + REAL(ReKi) :: dummy = 0.0_ReKi !< [-] TYPE(InflowWind_ContinuousStateType) :: IfW END TYPE DWM_ContinuousStateType ! ======================= ! ========= DWM_DiscreteStateType ======= TYPE, PUBLIC :: DWM_DiscreteStateType - REAL(ReKi) :: dummy !< [-] + REAL(ReKi) :: dummy = 0.0_ReKi !< [-] TYPE(InflowWind_DiscreteStateType) :: IfW END TYPE DWM_DiscreteStateType ! ======================= ! ========= DWM_ConstraintStateType ======= TYPE, PUBLIC :: DWM_ConstraintStateType - REAL(ReKi) :: dummy !< [-] + REAL(ReKi) :: dummy = 0.0_ReKi !< [-] TYPE(InflowWind_ConstraintStateType) :: IfW END TYPE DWM_ConstraintStateType ! ======================= ! ========= DWM_InitInputType ======= TYPE, PUBLIC :: DWM_InitInputType - REAL(ReKi) :: dummy !< [-] + REAL(ReKi) :: dummy = 0.0_ReKi !< [-] TYPE(InflowWind_InitInputType) :: IfW END TYPE DWM_InitInputType ! ======================= ! ========= DWM_InitOutputType ======= TYPE, PUBLIC :: DWM_InitOutputType - REAL(ReKi) :: dummy !< [-] + REAL(ReKi) :: dummy = 0.0_ReKi !< [-] TYPE(InflowWind_InitOutputType) :: IfW END TYPE DWM_InitOutputType ! ======================= diff --git a/modules/awae/src/AWAE_Types.f90 b/modules/awae/src/AWAE_Types.f90 index 7fe486a67a..a10126308d 100644 --- a/modules/awae/src/AWAE_Types.f90 +++ b/modules/awae/src/AWAE_Types.f90 @@ -52,54 +52,54 @@ MODULE AWAE_Types ! ======================= ! ========= AWAE_InputFileType ======= TYPE, PUBLIC :: AWAE_InputFileType - REAL(ReKi) :: dr !< Radial increment of radial finite-difference grid [>0.0] [m] - REAL(DbKi) :: dt_low !< Low-resolution (FAST.Farm driver/glue code) time step [s] - INTEGER(IntKi) :: NumTurbines !< Number of wind turbines in the farm [>=1] [-] - INTEGER(IntKi) :: NumRadii !< Number of radii in the radial finite-difference grid [>=2] [-] - INTEGER(IntKi) :: NumPlanes !< Number of wake planes downwind of the rotor where the wake is propagated [>=2] [-] - CHARACTER(1024) :: WindFilePath !< Path name to the Root folder containing the wind data files from ABLSolver precursor [-] - LOGICAL :: WrDisWind !< Write disturbed wind data to /Low/Dis.t.vtk etc.? [-] - INTEGER(IntKi) :: NOutDisWindXY !< Number of XY planes for output of disturbed wind data across the low-resolution domain to /Low/DisXY..t.vtk [0 to 9] [-] + REAL(ReKi) :: dr = 0.0_ReKi !< Radial increment of radial finite-difference grid [>0.0] [m] + REAL(DbKi) :: dt_low = 0.0_R8Ki !< Low-resolution (FAST.Farm driver/glue code) time step [s] + INTEGER(IntKi) :: NumTurbines = 0_IntKi !< Number of wind turbines in the farm [>=1] [-] + INTEGER(IntKi) :: NumRadii = 0_IntKi !< Number of radii in the radial finite-difference grid [>=2] [-] + INTEGER(IntKi) :: NumPlanes = 0_IntKi !< Number of wake planes downwind of the rotor where the wake is propagated [>=2] [-] + CHARACTER(1024) :: WindFilePath = '' !< Path name to the Root folder containing the wind data files from ABLSolver precursor [-] + LOGICAL :: WrDisWind = .false. !< Write disturbed wind data to /Low/Dis.t.vtk etc.? [-] + INTEGER(IntKi) :: NOutDisWindXY = 0_IntKi !< Number of XY planes for output of disturbed wind data across the low-resolution domain to /Low/DisXY..t.vtk [0 to 9] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: OutDisWindZ !< Z coordinates of XY planes for output of disturbed wind data across the low-resolution domain [1 to NOutDisWindXY] [meters] - INTEGER(IntKi) :: NOutDisWindYZ !< Number of YZ planes for output of disturbed wind data across the low-resolution domain to /Low/DisYZ..t.vtk [0 to 9] [-] + INTEGER(IntKi) :: NOutDisWindYZ = 0_IntKi !< Number of YZ planes for output of disturbed wind data across the low-resolution domain to /Low/DisYZ..t.vtk [0 to 9] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: OutDisWindX !< X coordinates of YZ planes for output of disturbed wind data across the low-resolution domain [1 to NOutDisWindYZ] [meters] - INTEGER(IntKi) :: NOutDisWindXZ !< Number of XZ planes for output of disturbed wind data across the low-resolution domain to /Low/DisXZ..t.vtk [0 to 9] [-] + INTEGER(IntKi) :: NOutDisWindXZ = 0_IntKi !< Number of XZ planes for output of disturbed wind data across the low-resolution domain to /Low/DisXZ..t.vtk [0 to 9] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: OutDisWindY !< Y coordinates of XZ planes for output of disturbed wind data across the low-resolution domain [1 to NOutDisWindXZ] [meters] - REAL(DbKi) :: WrDisDT !< The time between vtk outputs [must be a multiple of the low resolution time step] [s] - LOGICAL :: ChkWndFiles !< Check all the ambient wind files for data consistency (flag) [-] - INTEGER(IntKi) :: Mod_Meander !< Spatial filter model for wake meandering {1: uniform, 2: truncated jinc, 3: windowed jinc} [DEFAULT=2] [-] - REAL(ReKi) :: C_Meander !< Calibrated parameter for wake meandering [>=1.0] [DEFAULT=1.9] [-] - INTEGER(IntKi) :: Mod_AmbWind !< Ambient wind model {1: high-fidelity precursor in VTK format, 2: InflowWind module} [-] - CHARACTER(1024) :: InflowFile !< Name of file containing InflowWind module input parameters [-] - REAL(DbKi) :: dt_high !< High-resolution (FAST) time step [s] + REAL(DbKi) :: WrDisDT = 0.0_R8Ki !< The time between vtk outputs [must be a multiple of the low resolution time step] [s] + LOGICAL :: ChkWndFiles = .false. !< Check all the ambient wind files for data consistency (flag) [-] + INTEGER(IntKi) :: Mod_Meander = 0_IntKi !< Spatial filter model for wake meandering {1: uniform, 2: truncated jinc, 3: windowed jinc} [DEFAULT=2] [-] + REAL(ReKi) :: C_Meander = 0.0_ReKi !< Calibrated parameter for wake meandering [>=1.0] [DEFAULT=1.9] [-] + INTEGER(IntKi) :: Mod_AmbWind = 0_IntKi !< Ambient wind model {1: high-fidelity precursor in VTK format, 2: InflowWind module} [-] + CHARACTER(1024) :: InflowFile = '' !< Name of file containing InflowWind module input parameters [-] + REAL(DbKi) :: dt_high = 0.0_R8Ki !< High-resolution (FAST) time step [s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: X0_high !< X-component of the origin of the high-resolution spatial domain for each turbine [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Y0_high !< Y-component of the origin of the high-resolution spatial domain for each turbine [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Z0_high !< Z-component of the origin of the high-resolution spatial domain for each turbine [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dX_high !< X-component of the spatial increment of the high-resolution spatial domain for each turbine [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dY_high !< Y-component of the spatial increment of the high-resolution spatial domain for each turbine [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dZ_high !< Z-component of the spatial increment of the high-resolution spatial domain for each turbine [m] - INTEGER(IntKi) :: nX_high !< Number of high-resolution spatial nodes in X direction [-] - INTEGER(IntKi) :: nY_high !< Number of high-resolution spatial nodes in Y direction [-] - INTEGER(IntKi) :: nZ_high !< Number of high-resolution spatial nodes in Z direction [-] - REAL(ReKi) :: dX_low !< The spacing of the low-resolution nodes in X direction [m] - REAL(ReKi) :: dY_low !< The spacing of the low-resolution nodes in Y direction [m] - REAL(ReKi) :: dZ_low !< The spacing of the low-resolution nodes in Z direction [m] - INTEGER(IntKi) :: nX_low !< Number of low-resolution spatial nodes in X direction [-] - INTEGER(IntKi) :: nY_low !< Number of low-resolution spatial nodes in Y direction [-] - INTEGER(IntKi) :: nZ_low !< Number of low-resolution spatial nodes in Z direction [-] - REAL(ReKi) :: X0_low !< X-component of the origin of the low-resolution spatial domain [m] - REAL(ReKi) :: Y0_low !< Y-component of the origin of the low-resolution spatial domain [m] - REAL(ReKi) :: Z0_low !< Z-component of the origin of the low-resolution spatial domain [m] + INTEGER(IntKi) :: nX_high = 0_IntKi !< Number of high-resolution spatial nodes in X direction [-] + INTEGER(IntKi) :: nY_high = 0_IntKi !< Number of high-resolution spatial nodes in Y direction [-] + INTEGER(IntKi) :: nZ_high = 0_IntKi !< Number of high-resolution spatial nodes in Z direction [-] + REAL(ReKi) :: dX_low = 0.0_ReKi !< The spacing of the low-resolution nodes in X direction [m] + REAL(ReKi) :: dY_low = 0.0_ReKi !< The spacing of the low-resolution nodes in Y direction [m] + REAL(ReKi) :: dZ_low = 0.0_ReKi !< The spacing of the low-resolution nodes in Z direction [m] + INTEGER(IntKi) :: nX_low = 0_IntKi !< Number of low-resolution spatial nodes in X direction [-] + INTEGER(IntKi) :: nY_low = 0_IntKi !< Number of low-resolution spatial nodes in Y direction [-] + INTEGER(IntKi) :: nZ_low = 0_IntKi !< Number of low-resolution spatial nodes in Z direction [-] + REAL(ReKi) :: X0_low = 0.0_ReKi !< X-component of the origin of the low-resolution spatial domain [m] + REAL(ReKi) :: Y0_low = 0.0_ReKi !< Y-component of the origin of the low-resolution spatial domain [m] + REAL(ReKi) :: Z0_low = 0.0_ReKi !< Z-component of the origin of the low-resolution spatial domain [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WT_Position !< X-Y-Z position of each wind turbine; index 1 = XYZ; index 2 = turbine number [meters] - INTEGER(IntKi) :: Mod_Projection !< Switch to select how the wake plane velocity is projected in AWAE {1: keep all components, 2: project against plane normal} or DEFAULT [DEFAULT=1: if Mod_Wake is 1 or 3, or DEFAULT=2: if Mod_Wake is 2] [-] + INTEGER(IntKi) :: Mod_Projection = 0_IntKi !< Switch to select how the wake plane velocity is projected in AWAE {1: keep all components, 2: project against plane normal} or DEFAULT [DEFAULT=1: if Mod_Wake is 1 or 3, or DEFAULT=2: if Mod_Wake is 2] [-] END TYPE AWAE_InputFileType ! ======================= ! ========= AWAE_InitInputType ======= TYPE, PUBLIC :: AWAE_InitInputType TYPE(AWAE_InputFileType) :: InputFileData !< FAST.Farm input-file data for AWAE module [-] - INTEGER(IntKi) :: n_high_low !< Number of high-resolution time steps per low [-] - INTEGER(IntKi) :: NumDT !< Number of low-resolution (FAST.Farm driver/glue code) time steps [-] - CHARACTER(1024) :: OutFileRoot !< The root name derived from the primary FAST.Farm input file [-] + INTEGER(IntKi) :: n_high_low = 0_IntKi !< Number of high-resolution time steps per low [-] + INTEGER(IntKi) :: NumDT = 0_IntKi !< Number of low-resolution (FAST.Farm driver/glue code) time steps [-] + CHARACTER(1024) :: OutFileRoot = '' !< The root name derived from the primary FAST.Farm input file [-] END TYPE AWAE_InitInputType ! ======================= ! ========= AWAE_InitOutputType ======= @@ -111,18 +111,18 @@ MODULE AWAE_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dX_high !< X-component of the spatial increment of the high-resolution spatial domain for each turbine [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dY_high !< Y-component of the spatial increment of the high-resolution spatial domain for each turbine [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dZ_high !< Z-component of the spatial increment of the high-resolution spatial domain for each turbine [m] - INTEGER(IntKi) :: nX_high !< Number of high-resolution spatial nodes in X direction [-] - INTEGER(IntKi) :: nY_high !< Number of high-resolution spatial nodes in Y direction [-] - INTEGER(IntKi) :: nZ_high !< Number of high-resolution spatial nodes in Z direction [-] - REAL(ReKi) :: dX_low !< The spacing of the low-resolution nodes in X direction [m] - REAL(ReKi) :: dY_low !< The spacing of the low-resolution nodes in Y direction [m] - REAL(ReKi) :: dZ_low !< The spacing of the low-resolution nodes in Z direction [m] - INTEGER(IntKi) :: nX_low !< Number of low-resolution spatial nodes in X direction [-] - INTEGER(IntKi) :: nY_low !< Number of low-resolution spatial nodes in Y direction [-] - INTEGER(IntKi) :: nZ_low !< Number of low-resolution spatial nodes in Z direction [-] - REAL(ReKi) :: X0_low !< X-component of the origin of the low-resolution spatial domain [m] - REAL(ReKi) :: Y0_low !< Y-component of the origin of the low-resolution spatial domain [m] - REAL(ReKi) :: Z0_low !< Z-component of the origin of the low-resolution spatial domain [m] + INTEGER(IntKi) :: nX_high = 0_IntKi !< Number of high-resolution spatial nodes in X direction [-] + INTEGER(IntKi) :: nY_high = 0_IntKi !< Number of high-resolution spatial nodes in Y direction [-] + INTEGER(IntKi) :: nZ_high = 0_IntKi !< Number of high-resolution spatial nodes in Z direction [-] + REAL(ReKi) :: dX_low = 0.0_ReKi !< The spacing of the low-resolution nodes in X direction [m] + REAL(ReKi) :: dY_low = 0.0_ReKi !< The spacing of the low-resolution nodes in Y direction [m] + REAL(ReKi) :: dZ_low = 0.0_ReKi !< The spacing of the low-resolution nodes in Z direction [m] + INTEGER(IntKi) :: nX_low = 0_IntKi !< Number of low-resolution spatial nodes in X direction [-] + INTEGER(IntKi) :: nY_low = 0_IntKi !< Number of low-resolution spatial nodes in Y direction [-] + INTEGER(IntKi) :: nZ_low = 0_IntKi !< Number of low-resolution spatial nodes in Z direction [-] + REAL(ReKi) :: X0_low = 0.0_ReKi !< X-component of the origin of the low-resolution spatial domain [m] + REAL(ReKi) :: Y0_low = 0.0_ReKi !< Y-component of the origin of the low-resolution spatial domain [m] + REAL(ReKi) :: Z0_low = 0.0_ReKi !< Z-component of the origin of the low-resolution spatial domain [m] TYPE(AWAE_HighWindGridPtr) , DIMENSION(:), ALLOCATABLE :: Vdist_High !< Pointers to Wind velocity of disturbed wind (ambient + wakes) across each high-resolution domain around a turbine for each high-resolution step within a low-resolution step [m/s] END TYPE AWAE_InitOutputType ! ======================= @@ -172,58 +172,58 @@ MODULE AWAE_Types ! ======================= ! ========= AWAE_ParameterType ======= TYPE, PUBLIC :: AWAE_ParameterType - CHARACTER(1024) :: WindFilePath !< Path name to the Root folder containing the wind data files from ABLSolver precursor [-] - INTEGER(IntKi) :: NumTurbines !< Number of wind turbines in the farm [>=1] [-] - INTEGER(IntKi) :: NumRadii !< Number of radii in the radial finite-difference grid [>=2] [-] - INTEGER(IntKi) :: NumPlanes !< Number of wake planes downwind of the rotor where the wake is propagated [>=2] [-] + CHARACTER(1024) :: WindFilePath = '' !< Path name to the Root folder containing the wind data files from ABLSolver precursor [-] + INTEGER(IntKi) :: NumTurbines = 0_IntKi !< Number of wind turbines in the farm [>=1] [-] + INTEGER(IntKi) :: NumRadii = 0_IntKi !< Number of radii in the radial finite-difference grid [>=2] [-] + INTEGER(IntKi) :: NumPlanes = 0_IntKi !< Number of wake planes downwind of the rotor where the wake is propagated [>=2] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: y !< Horizontal discretization of the wake planes [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: z !< Vertical discretization of the wake planes [m] - INTEGER(IntKi) :: Mod_AmbWind !< Ambient wind model {1: high-fidelity precursor in VTK format, 2: InflowWind module} [-] - INTEGER(IntKi) :: nX_low !< Number of low-resolution spatial nodes in X direction [-] - INTEGER(IntKi) :: nY_low !< Number of low-resolution spatial nodes in Y direction [-] - INTEGER(IntKi) :: nZ_low !< Number of low-resolution spatial nodes in Z direction [-] - INTEGER(IntKi) :: NumGrid_low !< Total number of low-resolution spatial nodes [-] - INTEGER(IntKi) :: n_rp_max !< Maximum possible number of points in the polar grid for the wake plane at each rotor [-] - REAL(ReKi) :: dpol !< Spatial resolution of the polar grid for each wake plane of each turbine [m] - REAL(ReKi) , DIMENSION(1:3) :: dXYZ_low !< XYZ-components of the spatial increment of the low-resolution domain [m] - REAL(ReKi) :: dX_low !< The spacing of the low-resolution nodes in X direction [m] - REAL(ReKi) :: dY_low !< The spacing of the low-resolution nodes in Y direction [m] - REAL(ReKi) :: dZ_low !< The spacing of the low-resolution nodes in Z direction [m] - REAL(ReKi) :: X0_low !< X-component of the origin of the low-resolution spatial domain [m] - REAL(ReKi) :: Y0_low !< Y-component of the origin of the low-resolution spatial domain [m] - REAL(ReKi) :: Z0_low !< Z-component of the origin of the low-resolution spatial domain [m] + INTEGER(IntKi) :: Mod_AmbWind = 0_IntKi !< Ambient wind model {1: high-fidelity precursor in VTK format, 2: InflowWind module} [-] + INTEGER(IntKi) :: nX_low = 0_IntKi !< Number of low-resolution spatial nodes in X direction [-] + INTEGER(IntKi) :: nY_low = 0_IntKi !< Number of low-resolution spatial nodes in Y direction [-] + INTEGER(IntKi) :: nZ_low = 0_IntKi !< Number of low-resolution spatial nodes in Z direction [-] + INTEGER(IntKi) :: NumGrid_low = 0_IntKi !< Total number of low-resolution spatial nodes [-] + INTEGER(IntKi) :: n_rp_max = 0_IntKi !< Maximum possible number of points in the polar grid for the wake plane at each rotor [-] + REAL(ReKi) :: dpol = 0.0_ReKi !< Spatial resolution of the polar grid for each wake plane of each turbine [m] + REAL(ReKi) , DIMENSION(1:3) :: dXYZ_low = 0.0_ReKi !< XYZ-components of the spatial increment of the low-resolution domain [m] + REAL(ReKi) :: dX_low = 0.0_ReKi !< The spacing of the low-resolution nodes in X direction [m] + REAL(ReKi) :: dY_low = 0.0_ReKi !< The spacing of the low-resolution nodes in Y direction [m] + REAL(ReKi) :: dZ_low = 0.0_ReKi !< The spacing of the low-resolution nodes in Z direction [m] + REAL(ReKi) :: X0_low = 0.0_ReKi !< X-component of the origin of the low-resolution spatial domain [m] + REAL(ReKi) :: Y0_low = 0.0_ReKi !< Y-component of the origin of the low-resolution spatial domain [m] + REAL(ReKi) :: Z0_low = 0.0_ReKi !< Z-component of the origin of the low-resolution spatial domain [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: X0_high !< X-component of the origin of the high-resolution spatial domain for each turbine [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Y0_high !< Y-component of the origin of the high-resolution spatial domain for each turbine [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Z0_high !< Z-component of the origin of the high-resolution spatial domain for each turbine [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dX_high !< X-component of the spatial increment of the high-resolution spatial domain for each turbine [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dY_high !< Y-component of the spatial increment of the high-resolution spatial domain for each turbine [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dZ_high !< Z-component of the spatial increment of the high-resolution spatial domain for each turbine [m] - INTEGER(IntKi) :: nX_high !< Number of high-resolution spatial nodes in X direction [-] - INTEGER(IntKi) :: nY_high !< Number of high-resolution spatial nodes in Y direction [-] - INTEGER(IntKi) :: nZ_high !< Number of high-resolution spatial nodes in Z direction [-] + INTEGER(IntKi) :: nX_high = 0_IntKi !< Number of high-resolution spatial nodes in X direction [-] + INTEGER(IntKi) :: nY_high = 0_IntKi !< Number of high-resolution spatial nodes in Y direction [-] + INTEGER(IntKi) :: nZ_high = 0_IntKi !< Number of high-resolution spatial nodes in Z direction [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Grid_low !< XYZ components (global positions) of the spatial discretization of the low-resolution spatial domain [m] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Grid_high !< XYZ components (global positions) of the spatial discretization of the high-resolution spatial domain for each turbine [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WT_Position !< X-Y-Z position of each wind turbine; index 1 = XYZ; index 2 = turbine number [meters] - INTEGER(IntKi) :: n_high_low !< Number of high-resolution time steps per low [-] - REAL(DbKi) :: dt_low !< Low-resolution (FAST.Farm driver/glue code) time step [s] - REAL(DbKi) :: dt_high !< High-resolution (FAST) time step [s] - INTEGER(IntKi) :: NumDT !< Number of low-resolution (FAST.Farm driver/glue code) time steps [-] - INTEGER(IntKi) :: Mod_Meander !< Spatial filter model for wake meandering [-] - REAL(ReKi) :: C_Meander !< Calibrated parameter for wake meandering [-] - REAL(ReKi) :: C_ScaleDiam !< Normalized wake volume radius for wake meandering (normalized by the wake diameter) [-] - INTEGER(IntKi) :: Mod_Projection !< Switch to select how the wake plane velocity is projected in AWAE {1: keep all components, 2: project against plane normal} or DEFAULT [DEFAULT=1: if Mod_Wake is 1 or 3, or DEFAULT=2: if Mod_Wake is 2] [-] + INTEGER(IntKi) :: n_high_low = 0_IntKi !< Number of high-resolution time steps per low [-] + REAL(DbKi) :: dt_low = 0.0_R8Ki !< Low-resolution (FAST.Farm driver/glue code) time step [s] + REAL(DbKi) :: dt_high = 0.0_R8Ki !< High-resolution (FAST) time step [s] + INTEGER(IntKi) :: NumDT = 0_IntKi !< Number of low-resolution (FAST.Farm driver/glue code) time steps [-] + INTEGER(IntKi) :: Mod_Meander = 0_IntKi !< Spatial filter model for wake meandering [-] + REAL(ReKi) :: C_Meander = 0.0_ReKi !< Calibrated parameter for wake meandering [-] + REAL(ReKi) :: C_ScaleDiam = 0.0_ReKi !< Normalized wake volume radius for wake meandering (normalized by the wake diameter) [-] + INTEGER(IntKi) :: Mod_Projection = 0_IntKi !< Switch to select how the wake plane velocity is projected in AWAE {1: keep all components, 2: project against plane normal} or DEFAULT [DEFAULT=1: if Mod_Wake is 1 or 3, or DEFAULT=2: if Mod_Wake is 2] [-] TYPE(InflowWind_ParameterType) , DIMENSION(:), ALLOCATABLE :: IfW !< InflowWind module parameters [-] - INTEGER(IntKi) :: WrDisSkp1 !< Number of time steps to skip plus one [-] - LOGICAL :: WrDisWind !< Write disturbed wind data to /Low/Dis.t.vtk etc.? [-] - INTEGER(IntKi) :: NOutDisWindXY !< Number of XY planes for output of disturbed wind data across the low-resolution domain to /Low/DisXY..t.vtk [0 to 9] [-] + INTEGER(IntKi) :: WrDisSkp1 = 0_IntKi !< Number of time steps to skip plus one [-] + LOGICAL :: WrDisWind = .false. !< Write disturbed wind data to /Low/Dis.t.vtk etc.? [-] + INTEGER(IntKi) :: NOutDisWindXY = 0_IntKi !< Number of XY planes for output of disturbed wind data across the low-resolution domain to /Low/DisXY..t.vtk [0 to 9] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: OutDisWindZ !< Z coordinates of XY planes for output of disturbed wind data across the low-resolution domain [1 to NOutDisWindXY] [meters] - INTEGER(IntKi) :: NOutDisWindYZ !< Number of YZ planes for output of disturbed wind data across the low-resolution domain to /Low/DisYZ..t.vtk [0 to 9] [-] + INTEGER(IntKi) :: NOutDisWindYZ = 0_IntKi !< Number of YZ planes for output of disturbed wind data across the low-resolution domain to /Low/DisYZ..t.vtk [0 to 9] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: OutDisWindX !< X coordinates of YZ planes for output of disturbed wind data across the low-resolution domain [1 to NOutDisWindYZ] [meters] - INTEGER(IntKi) :: NOutDisWindXZ !< Number of XZ planes for output of disturbed wind data across the low-resolution domain to /Low/DisXZ..t.vtk [0 to 9] [-] + INTEGER(IntKi) :: NOutDisWindXZ = 0_IntKi !< Number of XZ planes for output of disturbed wind data across the low-resolution domain to /Low/DisXZ..t.vtk [0 to 9] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: OutDisWindY !< Y coordinates of XZ planes for output of disturbed wind data across the low-resolution domain [1 to NOutDisWindXZ] [meters] - CHARACTER(1024) :: OutFileRoot !< The root name derived from the primary FAST.Farm input file [-] - CHARACTER(1024) :: OutFileVTKRoot !< The root name for VTK outputs [-] - INTEGER(IntKi) :: VTK_tWidth !< Number of characters for VTK timestamp outputs [-] + CHARACTER(1024) :: OutFileRoot = '' !< The root name derived from the primary FAST.Farm input file [-] + CHARACTER(1024) :: OutFileVTKRoot = '' !< The root name for VTK outputs [-] + INTEGER(IntKi) :: VTK_tWidth = 0_IntKi !< Number of characters for VTK timestamp outputs [-] END TYPE AWAE_ParameterType ! ======================= ! ========= AWAE_OutputType ======= diff --git a/modules/beamdyn/src/BeamDyn_Types.f90 b/modules/beamdyn/src/BeamDyn_Types.f90 index 826860d790..18ea9b0a96 100644 --- a/modules/beamdyn/src/BeamDyn_Types.f90 +++ b/modules/beamdyn/src/BeamDyn_Types.f90 @@ -41,16 +41,16 @@ MODULE BeamDyn_Types INTEGER(IntKi), PUBLIC, PARAMETER :: BD_MESH_STATIONS = 3 ! Constant for creating y%BldMotion at the blade property input stations [-] ! ========= BD_InitInputType ======= TYPE, PUBLIC :: BD_InitInputType - CHARACTER(1024) :: InputFile !< Name of the input file; remove if there is no file [-] - CHARACTER(1024) :: RootName !< RootName for writing output files [-] - REAL(ReKi) , DIMENSION(1:3) :: gravity !< Gravitational acceleration [m/s^2] - REAL(ReKi) , DIMENSION(1:3) :: GlbPos !< Initial Position Vector of the local blade coordinate system [-] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: GlbRot !< Initial direction cosine matrix of the local blade coordinate system -- in BD coords [-] - REAL(R8Ki) , DIMENSION(1:3) :: RootDisp !< Initial root displacement [-] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: RootOri !< Initial root orientation [-] - REAL(ReKi) , DIMENSION(1:6) :: RootVel !< Initial root velocities and angular veolcities [-] - REAL(ReKi) , DIMENSION(1:3) :: HubPos !< Initial Hub position vector [-] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: HubRot !< Initial Hub direction cosine matrix [-] + CHARACTER(1024) :: InputFile = '' !< Name of the input file; remove if there is no file [-] + CHARACTER(1024) :: RootName = '' !< RootName for writing output files [-] + REAL(ReKi) , DIMENSION(1:3) :: gravity = 0.0_ReKi !< Gravitational acceleration [m/s^2] + REAL(ReKi) , DIMENSION(1:3) :: GlbPos = 0.0_ReKi !< Initial Position Vector of the local blade coordinate system [-] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: GlbRot = 0.0_R8Ki !< Initial direction cosine matrix of the local blade coordinate system -- in BD coords [-] + REAL(R8Ki) , DIMENSION(1:3) :: RootDisp = 0.0_R8Ki !< Initial root displacement [-] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: RootOri = 0.0_R8Ki !< Initial root orientation [-] + REAL(ReKi) , DIMENSION(1:6) :: RootVel = 0.0_ReKi !< Initial root velocities and angular veolcities [-] + REAL(ReKi) , DIMENSION(1:3) :: HubPos = 0.0_ReKi !< Initial Hub position vector [-] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: HubRot = 0.0_R8Ki !< Initial Hub direction cosine matrix [-] LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] LOGICAL :: DynamicSolve = .TRUE. !< Use dynamic solve option. Set to False for static solving (handled by glue code or driver code). [-] END TYPE BD_InitInputType @@ -61,7 +61,7 @@ MODULE BeamDyn_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: kp_coordinate !< Key point coordinates array [-] - INTEGER(IntKi) :: kp_total !< Total number of key points [-] + INTEGER(IntKi) :: kp_total = 0_IntKi !< Total number of key points [-] CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_y !< Names of the outputs used in linearization [-] CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_x !< Names of the continuous states used in linearization [-] CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_u !< Names of the inputs used in linearization [-] @@ -74,54 +74,54 @@ MODULE BeamDyn_Types ! ======================= ! ========= BladeInputData ======= TYPE, PUBLIC :: BladeInputData - INTEGER(IntKi) :: station_total !< Number of blade input stations [-] - INTEGER(IntKi) :: format_index !< Number of blade input stations [-] + INTEGER(IntKi) :: station_total = 0_IntKi !< Number of blade input stations [-] + INTEGER(IntKi) :: format_index = 0_IntKi !< Number of blade input stations [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: station_eta !< Station location in eta [0,1] [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: stiff0 !< C/S stiffness matrix arrays [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: mass0 !< C/S mass matrix arrays [-] - REAL(R8Ki) , DIMENSION(1:6) :: beta !< Damping Coefficient [-] - INTEGER(IntKi) :: damp_flag !< Damping Flag: 0-No Damping, 1-Damped [-] + REAL(R8Ki) , DIMENSION(1:6) :: beta = 0.0_R8Ki !< Damping Coefficient [-] + INTEGER(IntKi) :: damp_flag = 0_IntKi !< Damping Flag: 0-No Damping, 1-Damped [-] END TYPE BladeInputData ! ======================= ! ========= BD_InputFile ======= TYPE, PUBLIC :: BD_InputFile - INTEGER(IntKi) :: member_total !< Total number of members [-] - INTEGER(IntKi) :: kp_total !< Total number of key point [-] + INTEGER(IntKi) :: member_total = 0_IntKi !< Total number of members [-] + INTEGER(IntKi) :: kp_total = 0_IntKi !< Total number of key point [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: kp_member !< Number of key points in each member [-] - INTEGER(IntKi) :: order_elem !< Order of interpolation (basis) function [-] - INTEGER(IntKi) :: load_retries !< Maximum Number of factored load retries [-] - INTEGER(IntKi) :: NRMax !< Max number of iterations in Newton Raphson algorithm [-] - INTEGER(IntKi) :: quadrature !< Quadrature: 1: Gauss; 2: Trapezoidal [-] - INTEGER(IntKi) :: n_fact !< Factorization frequency [-] - INTEGER(IntKi) :: refine !< FE mesh refinement factor for trapezoidal quadrature [-] - REAL(DbKi) :: rhoinf !< Numerical damping parameter for generalized-alpha integrator [-] - REAL(DbKi) :: DTBeam !< Time interval for BeamDyn calculations {or default} (s) [-] + INTEGER(IntKi) :: order_elem = 0_IntKi !< Order of interpolation (basis) function [-] + INTEGER(IntKi) :: load_retries = 0_IntKi !< Maximum Number of factored load retries [-] + INTEGER(IntKi) :: NRMax = 0_IntKi !< Max number of iterations in Newton Raphson algorithm [-] + INTEGER(IntKi) :: quadrature = 0_IntKi !< Quadrature: 1: Gauss; 2: Trapezoidal [-] + INTEGER(IntKi) :: n_fact = 0_IntKi !< Factorization frequency [-] + INTEGER(IntKi) :: refine = 0_IntKi !< FE mesh refinement factor for trapezoidal quadrature [-] + REAL(DbKi) :: rhoinf = 0.0_R8Ki !< Numerical damping parameter for generalized-alpha integrator [-] + REAL(DbKi) :: DTBeam = 0.0_R8Ki !< Time interval for BeamDyn calculations {or default} (s) [-] TYPE(BladeInputData) :: InpBl !< Input data for individual blades [see BladeInputData Type] - CHARACTER(1024) :: BldFile !< Name of blade input file [-] - LOGICAL :: UsePitchAct !< Whether to use a pitch actuator inside BeamDyn [(flag)] - LOGICAL :: QuasiStaticInit !< Use quasistatic pre-conditioning with centripetal accelerations in initialization (flag) [dynamic solve and enFAST only] [-] - REAL(R8Ki) :: stop_tol !< Tolerance for stopping criterion [-] - REAL(R8Ki) :: tngt_stf_pert !< Perturbation size for computing finite differenced tangent stiffness [-] - REAL(R8Ki) :: tngt_stf_difftol !< When comparing tangent stiffness matrix, stop simulation if error greater than this [-] + CHARACTER(1024) :: BldFile = '' !< Name of blade input file [-] + LOGICAL :: UsePitchAct = .false. !< Whether to use a pitch actuator inside BeamDyn [(flag)] + LOGICAL :: QuasiStaticInit = .false. !< Use quasistatic pre-conditioning with centripetal accelerations in initialization (flag) [dynamic solve and enFAST only] [-] + REAL(R8Ki) :: stop_tol = 0.0_R8Ki !< Tolerance for stopping criterion [-] + REAL(R8Ki) :: tngt_stf_pert = 0.0_R8Ki !< Perturbation size for computing finite differenced tangent stiffness [-] + REAL(R8Ki) :: tngt_stf_difftol = 0.0_R8Ki !< When comparing tangent stiffness matrix, stop simulation if error greater than this [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: kp_coordinate !< Key point coordinates array [-] - REAL(R8Ki) :: pitchJ !< Pitch actuator inertia [(kg-m^2)] - REAL(R8Ki) :: pitchK !< Pitch actuator stiffness [(kg-m^2/s^2)] - REAL(R8Ki) :: pitchC !< Pitch actuator damping [-] - LOGICAL :: Echo !< Echo [-] + REAL(R8Ki) :: pitchJ = 0.0_R8Ki !< Pitch actuator inertia [(kg-m^2)] + REAL(R8Ki) :: pitchK = 0.0_R8Ki !< Pitch actuator stiffness [(kg-m^2/s^2)] + REAL(R8Ki) :: pitchC = 0.0_R8Ki !< Pitch actuator damping [-] + LOGICAL :: Echo = .false. !< Echo [-] LOGICAL :: RotStates = .TRUE. !< Orient states in rotating frame during linearization? (flag) [-] LOGICAL :: RelStates = .FALSE. !< Define states relative to root motion during linearization? (flag) [-] - LOGICAL :: tngt_stf_fd !< Flag to compute tangent stifness matrix via finite difference [-] - LOGICAL :: tngt_stf_comp !< Flag to compare finite differenced and analytical tangent stifness [-] - INTEGER(IntKi) :: NNodeOuts !< Number of node outputs [0 - 9] [-] - INTEGER(IntKi) , DIMENSION(1:9) :: OutNd !< Nodes whose values will be output [-] - INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] + LOGICAL :: tngt_stf_fd = .false. !< Flag to compute tangent stifness matrix via finite difference [-] + LOGICAL :: tngt_stf_comp = .false. !< Flag to compare finite differenced and analytical tangent stifness [-] + INTEGER(IntKi) :: NNodeOuts = 0_IntKi !< Number of node outputs [0 - 9] [-] + INTEGER(IntKi) , DIMENSION(1:9) :: OutNd = 0_IntKi !< Nodes whose values will be output [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< List of user-requested output channels [-] - LOGICAL :: SumPrint !< Print summary data to file? (.sum) [-] - CHARACTER(20) :: OutFmt !< Format specifier [-] - INTEGER(IntKi) :: BldNd_NumOuts !< Number of requested output channels per blade node (BD_BldNdOuts) [-] + LOGICAL :: SumPrint = .false. !< Print summary data to file? (.sum) [-] + CHARACTER(20) :: OutFmt = '' !< Format specifier [-] + INTEGER(IntKi) :: BldNd_NumOuts = 0_IntKi !< Number of requested output channels per blade node (BD_BldNdOuts) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: BldNd_OutList !< List of user-requested output channels (BD_BldNdOuts) [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: BldNd_BlOutNd !< The blade nodes to actually output (BD_BldNdOuts) [-] - CHARACTER(1024) :: BldNd_BlOutNd_Str !< String to parse for the blade nodes to actually output (BD_BldNdOuts) [-] + CHARACTER(1024) :: BldNd_BlOutNd_Str = '' !< String to parse for the blade nodes to actually output (BD_BldNdOuts) [-] END TYPE BD_InputFile ! ======================= ! ========= BD_ContinuousStateType ======= @@ -132,21 +132,21 @@ MODULE BeamDyn_Types ! ======================= ! ========= BD_DiscreteStateType ======= TYPE, PUBLIC :: BD_DiscreteStateType - REAL(ReKi) :: thetaP !< Pitch angle state [-] - REAL(ReKi) :: thetaPD !< Pitch rate state [-] + REAL(ReKi) :: thetaP = 0.0_ReKi !< Pitch angle state [-] + REAL(ReKi) :: thetaPD = 0.0_ReKi !< Pitch rate state [-] END TYPE BD_DiscreteStateType ! ======================= ! ========= BD_ConstraintStateType ======= TYPE, PUBLIC :: BD_ConstraintStateType - REAL(ReKi) :: DummyConstrState !< A variable, Replace if you have constraint states [-] + REAL(ReKi) :: DummyConstrState = 0.0_ReKi !< A variable, Replace if you have constraint states [-] END TYPE BD_ConstraintStateType ! ======================= ! ========= BD_OtherStateType ======= TYPE, PUBLIC :: BD_OtherStateType REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: acc !< Acceleration (dqdtdt) [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: xcc !< Algorithm acceleration in GA2: (1-alpha_m)*xcc_(n+1) = (1-alpha_f)*Acc_(n+1) + alpha_f*Acc_n - alpha_m*xcc_n [-] - LOGICAL :: InitAcc !< flag to determine if accerlerations have been initialized in updateStates [-] - LOGICAL :: RunQuasiStaticInit !< flag to determine if quasi-static solution initialization should be run again (with load inputs) [-] + LOGICAL :: InitAcc = .false. !< flag to determine if accerlerations have been initialized in updateStates [-] + LOGICAL :: RunQuasiStaticInit = .false. !< flag to determine if quasi-static solution initialization should be run again (with load inputs) [-] END TYPE BD_OtherStateType ! ======================= ! ========= qpParam ======= @@ -157,24 +157,24 @@ MODULE BeamDyn_Types ! ======================= ! ========= BD_ParameterType ======= TYPE, PUBLIC :: BD_ParameterType - REAL(DbKi) :: dt !< module dt [s] - REAL(DbKi) , DIMENSION(1:9) :: coef !< GA2 Coefficient [-] - REAL(DbKi) :: rhoinf !< Numerical Damping Coefficient for GA2 [-] + REAL(DbKi) :: dt = 0.0_R8Ki !< module dt [s] + REAL(DbKi) , DIMENSION(1:9) :: coef = 0.0_R8Ki !< GA2 Coefficient [-] + REAL(DbKi) :: rhoinf = 0.0_R8Ki !< Numerical Damping Coefficient for GA2 [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: uuN0 !< Initial Postion Vector of GLL (FE) nodes (index 1=DOF; index 2=FE nodes; index 3=element) [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: Stif0_QP !< Sectional Stiffness Properties at quadrature points (6x6xqp) [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: Mass0_QP !< Sectional Mass Properties at quadrature points (6x6xqp) [-] - REAL(R8Ki) , DIMENSION(1:3) :: gravity !< Gravitational acceleration [m/s^2] + REAL(R8Ki) , DIMENSION(1:3) :: gravity = 0.0_R8Ki !< Gravitational acceleration [m/s^2] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: segment_eta !< Array stored length ratio of each segment w.r.t. member it lies in [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: member_eta !< Array stored length ratio of each member w.r.t. entire blade [-] - REAL(R8Ki) :: blade_length !< Blade Length [-] - REAL(R8Ki) :: blade_mass !< Blade mass [-] - REAL(R8Ki) , DIMENSION(1:3) :: blade_CG !< Blade center of gravity [-] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: blade_IN !< Blade Length [-] - REAL(R8Ki) , DIMENSION(1:6) :: beta !< Damping Coefficient [-] - REAL(R8Ki) :: tol !< Tolerance used in stopping criterion [-] - REAL(R8Ki) , DIMENSION(1:3) :: GlbPos !< Initial Position Vector between origins of Global and blade frames (BD coordinates) [-] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: GlbRot !< Initial Rotation Tensor between Global and Blade frames (BD coordinates; transfers local to global) [-] - REAL(R8Ki) , DIMENSION(1:3) :: Glb_crv !< CRV parameters of GlbRot [-] + REAL(R8Ki) :: blade_length = 0.0_R8Ki !< Blade Length [-] + REAL(R8Ki) :: blade_mass = 0.0_R8Ki !< Blade mass [-] + REAL(R8Ki) , DIMENSION(1:3) :: blade_CG = 0.0_R8Ki !< Blade center of gravity [-] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: blade_IN = 0.0_R8Ki !< Blade Length [-] + REAL(R8Ki) , DIMENSION(1:6) :: beta = 0.0_R8Ki !< Damping Coefficient [-] + REAL(R8Ki) :: tol = 0.0_R8Ki !< Tolerance used in stopping criterion [-] + REAL(R8Ki) , DIMENSION(1:3) :: GlbPos = 0.0_R8Ki !< Initial Position Vector between origins of Global and blade frames (BD coordinates) [-] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: GlbRot = 0.0_R8Ki !< Initial Rotation Tensor between Global and Blade frames (BD coordinates; transfers local to global) [-] + REAL(R8Ki) , DIMENSION(1:3) :: Glb_crv = 0.0_R8Ki !< CRV parameters of GlbRot [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: QPtN !< Quadrature (QuadPt) point locations in natural frame [-1, 1] [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: QPtWeight !< Weights at each quadrature point (QuadPt) [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: Shp !< Shape function matrix (index 1 = FE nodes; index 2=quadrature points) [-] @@ -183,45 +183,45 @@ MODULE BeamDyn_Types REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: uu0 !< Initial Disp/Rot value at quadrature point (at T=0) [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: rrN0 !< Initial relative rotation array, relative to root (at T=0) (index 1=rot DOF; index 2=FE nodes; index 3=element) [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: E10 !< Initial E10 at quadrature point [-] - INTEGER(IntKi) :: nodes_per_elem !< Finite element (GLL) nodes per element [-] + INTEGER(IntKi) :: nodes_per_elem = 0_IntKi !< Finite element (GLL) nodes per element [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: node_elem_idx !< Index to first and last nodes of element in p%node_total sized arrays [-] - INTEGER(IntKi) :: refine !< FE mesh refinement factor for trapezoidal quadrature [-] - INTEGER(IntKi) :: dof_node !< dof per node [-] - INTEGER(IntKi) :: dof_elem !< dof per element [-] - INTEGER(IntKi) :: rot_elem !< rotational dof per element [-] - INTEGER(IntKi) :: elem_total !< Total number of elements [-] - INTEGER(IntKi) :: node_total !< Total number of finite element (GLL) nodes [-] - INTEGER(IntKi) :: dof_total !< Total number of dofs [-] - INTEGER(IntKi) :: nqp !< Number of quadrature points (per element) [-] - INTEGER(IntKi) :: analysis_type !< analysis_type flag [-] - INTEGER(IntKi) :: damp_flag !< damping flag [-] - INTEGER(IntKi) :: ld_retries !< Maximum Number of factored load retries [-] - INTEGER(IntKi) :: niter !< Maximum number of iterations in Newton-Raphson algorithm [-] - INTEGER(IntKi) :: quadrature !< Quadrature method: 1 Gauss 2 Trapezoidal [-] - INTEGER(IntKi) :: n_fact !< Factorization frequency [-] - LOGICAL :: OutInputs !< Determines if we've asked to output the inputs (do we need mesh transfer?) [-] - INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] + INTEGER(IntKi) :: refine = 0_IntKi !< FE mesh refinement factor for trapezoidal quadrature [-] + INTEGER(IntKi) :: dof_node = 0_IntKi !< dof per node [-] + INTEGER(IntKi) :: dof_elem = 0_IntKi !< dof per element [-] + INTEGER(IntKi) :: rot_elem = 0_IntKi !< rotational dof per element [-] + INTEGER(IntKi) :: elem_total = 0_IntKi !< Total number of elements [-] + INTEGER(IntKi) :: node_total = 0_IntKi !< Total number of finite element (GLL) nodes [-] + INTEGER(IntKi) :: dof_total = 0_IntKi !< Total number of dofs [-] + INTEGER(IntKi) :: nqp = 0_IntKi !< Number of quadrature points (per element) [-] + INTEGER(IntKi) :: analysis_type = 0_IntKi !< analysis_type flag [-] + INTEGER(IntKi) :: damp_flag = 0_IntKi !< damping flag [-] + INTEGER(IntKi) :: ld_retries = 0_IntKi !< Maximum Number of factored load retries [-] + INTEGER(IntKi) :: niter = 0_IntKi !< Maximum number of iterations in Newton-Raphson algorithm [-] + INTEGER(IntKi) :: quadrature = 0_IntKi !< Quadrature method: 1 Gauss 2 Trapezoidal [-] + INTEGER(IntKi) :: n_fact = 0_IntKi !< Factorization frequency [-] + LOGICAL :: OutInputs = .false. !< Determines if we've asked to output the inputs (do we need mesh transfer?) [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] - INTEGER(IntKi) :: NNodeOuts !< Number of nodes to output data to a file[0 - 9] [-] - INTEGER(IntKi) , DIMENSION(1:9) :: OutNd !< Nodes whose values will be output [-] + INTEGER(IntKi) :: NNodeOuts = 0_IntKi !< Number of nodes to output data to a file[0 - 9] [-] + INTEGER(IntKi) , DIMENSION(1:9) :: OutNd = 0_IntKi !< Nodes whose values will be output [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NdIndx !< Index into BldMotion mesh (to number the nodes for output without using collocated nodes) [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NdIndxInverse !< Index from BldMotion mesh to unique nodes (to number the nodes for output without using collocated nodes) [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: OutNd2NdElem !< To go from an output node number to a node/elem pair [-] - CHARACTER(20) :: OutFmt !< Format specifier [-] - LOGICAL :: UsePitchAct !< Whether to use a pitch actuator inside BeamDyn [(flag)] - REAL(ReKi) :: pitchJ !< Pitch actuator inertia [(kg-m^2)] - REAL(ReKi) :: pitchK !< Pitch actuator stiffness [(kg-m^2/s^2)] - REAL(ReKi) :: pitchC !< Pitch actuator damping [-] - REAL(ReKi) , DIMENSION(1:2,1:2) :: torqM !< Pitch actuator matrix: (I-hA)^-1 [-] + CHARACTER(20) :: OutFmt = '' !< Format specifier [-] + LOGICAL :: UsePitchAct = .false. !< Whether to use a pitch actuator inside BeamDyn [(flag)] + REAL(ReKi) :: pitchJ = 0.0_ReKi !< Pitch actuator inertia [(kg-m^2)] + REAL(ReKi) :: pitchK = 0.0_ReKi !< Pitch actuator stiffness [(kg-m^2/s^2)] + REAL(ReKi) :: pitchC = 0.0_ReKi !< Pitch actuator damping [-] + REAL(ReKi) , DIMENSION(1:2,1:2) :: torqM = 0.0_ReKi !< Pitch actuator matrix: (I-hA)^-1 [-] TYPE(qpParam) :: qp !< Quadrature point info that does not change during simulation [-] - INTEGER(IntKi) :: qp_indx_offset !< Offset for computing index of the quadrature arrays (gauss skips the first [end-point] node) [-] - INTEGER(IntKi) :: BldMotionNodeLoc !< switch to determine where the nodes on the blade motion mesh should be located 1=FE (GLL) nodes; 2=quadrature nodes; 3=blade input stations [-] - LOGICAL :: tngt_stf_fd !< Flag to compute tangent stifness matrix via finite difference [-] - LOGICAL :: tngt_stf_comp !< Flag to compare finite differenced and analytical tangent stifness [-] - REAL(R8Ki) :: tngt_stf_pert !< Perturbation size for computing finite differenced tangent stiffness [-] - REAL(R8Ki) :: tngt_stf_difftol !< When comparing tangent stiffness matrix, stop simulation if error greater than this [-] - INTEGER(IntKi) :: BldNd_NumOuts !< [BD_BldNdOuts] Number of requested output channels per blade node [-] - INTEGER(IntKi) :: BldNd_TotNumOuts !< [BD_BldNdOuts] Total number of requested output channels of blade node information (equal to BldNd_NumOuts * BldNd_BlOutNd) [-] + INTEGER(IntKi) :: qp_indx_offset = 0_IntKi !< Offset for computing index of the quadrature arrays (gauss skips the first [end-point] node) [-] + INTEGER(IntKi) :: BldMotionNodeLoc = 0_IntKi !< switch to determine where the nodes on the blade motion mesh should be located 1=FE (GLL) nodes; 2=quadrature nodes; 3=blade input stations [-] + LOGICAL :: tngt_stf_fd = .false. !< Flag to compute tangent stifness matrix via finite difference [-] + LOGICAL :: tngt_stf_comp = .false. !< Flag to compare finite differenced and analytical tangent stifness [-] + REAL(R8Ki) :: tngt_stf_pert = 0.0_R8Ki !< Perturbation size for computing finite differenced tangent stiffness [-] + REAL(R8Ki) :: tngt_stf_difftol = 0.0_R8Ki !< When comparing tangent stiffness matrix, stop simulation if error greater than this [-] + INTEGER(IntKi) :: BldNd_NumOuts = 0_IntKi !< [BD_BldNdOuts] Number of requested output channels per blade node [-] + INTEGER(IntKi) :: BldNd_TotNumOuts = 0_IntKi !< [BD_BldNdOuts] Total number of requested output channels of blade node information (equal to BldNd_NumOuts * BldNd_BlOutNd) [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: BldNd_OutParam !< [BD_BldNdOuts] Names and units (and other characteristics) of all requested output parameters [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: BldNd_BlOutNd !< [BD_BldNdOuts] The blade nodes to actually output [-] REAL(R8Ki) , DIMENSION(:,:,:,:), ALLOCATABLE :: QPtw_Shp_Shp_Jac !< optimization variable: QPtw_Shp_Shp_Jac(idx_qp,i,j,nelem) = p%Shp(i,idx_qp)*p%Shp(j,idx_qp)*p%QPtWeight(idx_qp)*p%Jacobian(idx_qp,nelem) [-] @@ -232,11 +232,11 @@ MODULE BeamDyn_Types REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: FEweight !< weighting factors for integrating local sectional loads [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: du !< vector that determines size of perturbation for u (inputs) [-] - REAL(R8Ki) , DIMENSION(1:6) :: dx !< vector that determines size of perturbation for x (continuous states) [-] - INTEGER(IntKi) :: Jac_ny !< number of outputs in jacobian matrix [-] - INTEGER(IntKi) :: Jac_nx !< half the number of continuous states in jacobian matrix [-] - LOGICAL :: RotStates !< Orient states in rotating frame during linearization? (flag) [-] - LOGICAL :: RelStates !< Define states relative to root motion during linearization? (flag) [-] + REAL(R8Ki) , DIMENSION(1:6) :: dx = 0.0_R8Ki !< vector that determines size of perturbation for x (continuous states) [-] + INTEGER(IntKi) :: Jac_ny = 0_IntKi !< number of outputs in jacobian matrix [-] + INTEGER(IntKi) :: Jac_nx = 0_IntKi !< half the number of continuous states in jacobian matrix [-] + LOGICAL :: RotStates = .false. !< Orient states in rotating frame during linearization? (flag) [-] + LOGICAL :: RelStates = .false. !< Define states relative to root motion during linearization? (flag) [-] END TYPE BD_ParameterType ! ======================= ! ========= BD_InputType ======= @@ -251,8 +251,8 @@ MODULE BeamDyn_Types TYPE, PUBLIC :: BD_OutputType TYPE(MeshType) :: ReactionForce !< contains force and moments [-] TYPE(MeshType) :: BldMotion !< Motion (disp,rot,vel, acc) along beam axis [-] - REAL(ReKi) :: RootMxr !< x-component of the root reaction moment expressed in r (used for ServoDyn Bladed DLL Interface) [Nm] - REAL(ReKi) :: RootMyr !< y-component of the root reaction moment expressed in r (used for ServoDyn Bladed DLL Interface) [Nm] + REAL(ReKi) :: RootMxr = 0.0_ReKi !< x-component of the root reaction moment expressed in r (used for ServoDyn Bladed DLL Interface) [Nm] + REAL(ReKi) :: RootMyr = 0.0_ReKi !< y-component of the root reaction moment expressed in r (used for ServoDyn Bladed DLL Interface) [Nm] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< Data to be written to an output file: see WriteOutputHdr for names of each variable [see WriteOutputUnt] END TYPE BD_OutputType ! ======================= @@ -297,7 +297,7 @@ MODULE BeamDyn_Types TYPE(MeshType) :: y_BldMotion_at_u !< output motions at input node locations (displacements necessary for mapping loads) [-] TYPE(MeshMapType) :: Map_u_DistrLoad_to_y !< mapping of input loads to output node locations [-] TYPE(MeshMapType) :: Map_y_BldMotion_to_u !< mapping of output motions to input node locations (for load transfer) [-] - INTEGER(IntKi) :: Un_Sum !< unit number of summary file [-] + INTEGER(IntKi) :: Un_Sum = 0_IntKi !< unit number of summary file [-] TYPE(EqMotionQP) :: qp !< Quadrature point calculation info [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: lin_A !< A (dXdx) matrix used in linearization (before RotState is applied) [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: lin_C !< C (dYdx) matrix used in linearization (before RotState is applied) [-] diff --git a/modules/elastodyn/src/ElastoDyn_Types.f90 b/modules/elastodyn/src/ElastoDyn_Types.f90 index 40e43811a1..b525619ad9 100644 --- a/modules/elastodyn/src/ElastoDyn_Types.f90 +++ b/modules/elastodyn/src/ElastoDyn_Types.f90 @@ -36,14 +36,14 @@ MODULE ElastoDyn_Types INTEGER(IntKi), PUBLIC, PARAMETER :: ED_NMX = 4 ! Used in updating predictor-corrector values (size of state history) [-] ! ========= ED_InitInputType ======= TYPE, PUBLIC :: ED_InitInputType - CHARACTER(1024) :: InputFile !< Name of the input file [-] + CHARACTER(1024) :: InputFile = '' !< Name of the input file [-] LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] - CHARACTER(1024) :: ADInputFile !< Name of the AeroDyn input file (in this verison, that is where we'll get the blade mesh info [-] - LOGICAL :: CompElast !< flag to determine if ElastoDyn is computing blade loads (true) or BeamDyn is (false) [-] - CHARACTER(1024) :: RootName !< RootName for writing output files [-] - REAL(ReKi) :: Gravity !< Gravitational acceleration [m/s^2] - INTEGER(IntKi) :: MHK !< MHK turbine type switch [-] - REAL(ReKi) :: WtrDpth !< Water depth [m] + CHARACTER(1024) :: ADInputFile = '' !< Name of the AeroDyn input file (in this verison, that is where we'll get the blade mesh info [-] + LOGICAL :: CompElast = .false. !< flag to determine if ElastoDyn is computing blade loads (true) or BeamDyn is (false) [-] + CHARACTER(1024) :: RootName = '' !< RootName for writing output files [-] + REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravitational acceleration [m/s^2] + INTEGER(IntKi) :: MHK = 0_IntKi !< MHK turbine type switch [-] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [m] END TYPE ED_InitInputType ! ======================= ! ========= ED_InitOutputType ======= @@ -51,22 +51,22 @@ MODULE ElastoDyn_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Names of the output-to-file channels [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] - INTEGER(IntKi) :: NumBl !< Number of blades on the turbine [-] + INTEGER(IntKi) :: NumBl = 0_IntKi !< Number of blades on the turbine [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlPitch !< Initial blade pitch angles [radians] - REAL(ReKi) :: BladeLength !< Blade length (for AeroDyn) [meters] - REAL(ReKi) :: TowerHeight !< Tower Height [meters] - REAL(ReKi) :: TowerBaseHeight !< Tower Base Height [meters] - REAL(ReKi) :: HubHt !< Height of the hub [meters] + REAL(ReKi) :: BladeLength = 0.0_ReKi !< Blade length (for AeroDyn) [meters] + REAL(ReKi) :: TowerHeight = 0.0_ReKi !< Tower Height [meters] + REAL(ReKi) :: TowerBaseHeight = 0.0_ReKi !< Tower Base Height [meters] + REAL(ReKi) :: HubHt = 0.0_ReKi !< Height of the hub [meters] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BldRNodes !< Radius to analysis nodes relative to hub ( 0 < RNodes(:) < BldFlexL ) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrHNodes !< Location of variable-spaced tower nodes (relative to the tower rigid base height [-] - REAL(ReKi) , DIMENSION(1:6) :: PlatformPos !< Initial platform position (6 DOFs) [-] - REAL(ReKi) , DIMENSION(1:3) :: TwrBaseRefPos !< initial position of the tower base (for SrvD) [m] - REAL(R8Ki) , DIMENSION(1:3) :: TwrBaseTransDisp !< initial displacement of the tower base (for SrvD) [m] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: TwrBaseRefOrient !< reference orientation of the tower base (for SrvD) [-] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: TwrBaseOrient !< initial orientation of the tower base (for SrvD) [-] - REAL(ReKi) :: HubRad !< Preconed hub radius (distance from the rotor apex to the blade root) [m] - REAL(ReKi) :: RotSpeed !< Initial or fixed rotor speed [rad/s] - LOGICAL :: isFixed_GenDOF !< whether the generator is fixed or free [-] + REAL(ReKi) , DIMENSION(1:6) :: PlatformPos = 0.0_ReKi !< Initial platform position (6 DOFs) [-] + REAL(ReKi) , DIMENSION(1:3) :: TwrBaseRefPos = 0.0_ReKi !< initial position of the tower base (for SrvD) [m] + REAL(R8Ki) , DIMENSION(1:3) :: TwrBaseTransDisp = 0.0_R8Ki !< initial displacement of the tower base (for SrvD) [m] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: TwrBaseRefOrient = 0.0_R8Ki !< reference orientation of the tower base (for SrvD) [-] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: TwrBaseOrient = 0.0_R8Ki !< initial orientation of the tower base (for SrvD) [-] + REAL(ReKi) :: HubRad = 0.0_ReKi !< Preconed hub radius (distance from the rotor apex to the blade root) [m] + REAL(ReKi) :: RotSpeed = 0.0_ReKi !< Initial or fixed rotor speed [rad/s] + LOGICAL :: isFixed_GenDOF = .false. !< whether the generator is fixed or free [-] CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_y !< Names of the outputs used in linearization [-] CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_x !< Names of the continuous states used in linearization [-] CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_u !< Names of the inputs used in linearization [-] @@ -79,16 +79,16 @@ MODULE ElastoDyn_Types ! ======================= ! ========= BladeInputData ======= TYPE, PUBLIC :: BladeInputData - INTEGER(IntKi) :: NBlInpSt !< Number of blade input stations [-] + INTEGER(IntKi) :: NBlInpSt = 0_IntKi !< Number of blade input stations [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlFract !< Blade fractional radius for distributed input data [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PitchAx !< Pitch axis for distributed input data [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: StrcTwst !< Structural twist for distributed input data [radians] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BMassDen !< Blade mass density for distributed input data [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FlpStff !< Blade flap stiffness for distributed input data [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: EdgStff !< Blade edge stiffness for distributed input data [-] - REAL(ReKi) , DIMENSION(1:2) :: BldFlDmp !< Blade structural damping ratios in flapwise direction [-] - REAL(ReKi) , DIMENSION(1:1) :: BldEdDmp !< Blade structural damping ratios in edgewise direction [-] - REAL(ReKi) , DIMENSION(1:2) :: FlStTunr !< Blade flapwise modal stiffness tuners (input) [-] + REAL(ReKi) , DIMENSION(1:2) :: BldFlDmp = 0.0_ReKi !< Blade structural damping ratios in flapwise direction [-] + REAL(ReKi) , DIMENSION(1:1) :: BldEdDmp = 0.0_ReKi !< Blade structural damping ratios in edgewise direction [-] + REAL(ReKi) , DIMENSION(1:2) :: FlStTunr = 0.0_ReKi !< Blade flapwise modal stiffness tuners (input) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BldFl1Sh !< Blade-flap-mode-1 shape coefficients [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BldFl2Sh !< Blade-flap-mode-2 shape coefficients [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BldEdgSh !< Blade-edge-mode shape coefficients [-] @@ -96,7 +96,7 @@ MODULE ElastoDyn_Types ! ======================= ! ========= ED_BladeMeshInputData ======= TYPE, PUBLIC :: ED_BladeMeshInputData - INTEGER(IntKi) :: BldNodes !< Number of blade nodes used for analysis [-] + INTEGER(IntKi) :: BldNodes = 0_IntKi !< Number of blade nodes used for analysis [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: RNodes !< Radius to analysis nodes relative to hub ( 0 < RNodes(:) < BldFlexL ) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AeroTwst !< Aerodynamic twist of the blade at the analysis nodes [radians] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Chord !< Chord of the blade at the analysis nodes [-] @@ -104,108 +104,108 @@ MODULE ElastoDyn_Types ! ======================= ! ========= ED_InputFile ======= TYPE, PUBLIC :: ED_InputFile - REAL(DbKi) :: DT !< Requested integration time for ElastoDyn [seconds] - LOGICAL :: FlapDOF1 !< First flapwise blade mode DOF [-] - LOGICAL :: FlapDOF2 !< Second flapwise blade mode DOF [-] - LOGICAL :: EdgeDOF !< Edgewise blade mode DOF [-] - LOGICAL :: TeetDOF !< Rotor-teeter DOF [-] - LOGICAL :: DrTrDOF !< Drivetrain rotational-flexibility DOF [-] - LOGICAL :: GenDOF !< Generator DOF [-] - LOGICAL :: YawDOF !< Nacelle-yaw DOF [-] - LOGICAL :: TwFADOF1 !< First tower fore-aft bending-mode DOF [-] - LOGICAL :: TwFADOF2 !< Second tower fore-aft bending-mode DOF [-] - LOGICAL :: TwSSDOF1 !< First tower side-to-side bending-mode DOF [-] - LOGICAL :: TwSSDOF2 !< Second tower side-to-side bending-mode DOF [-] - LOGICAL :: PtfmSgDOF !< Platform horizontal surge translation DOF [-] - LOGICAL :: PtfmSwDOF !< Platform horizontal sway translation DOF [-] - LOGICAL :: PtfmHvDOF !< Platform vertical heave translation DOF [-] - LOGICAL :: PtfmRDOF !< Platform roll tilt rotation DOF [-] - LOGICAL :: PtfmPDOF !< Platform pitch tilt rotation DOF [-] - LOGICAL :: PtfmYDOF !< Platform yaw rotation DOF [-] - REAL(ReKi) :: OoPDefl !< Initial out-of-plane blade-tip displacement [meters] - REAL(ReKi) :: IPDefl !< Initial in-plane blade-tip deflection [meters] + REAL(DbKi) :: DT = 0.0_R8Ki !< Requested integration time for ElastoDyn [seconds] + LOGICAL :: FlapDOF1 = .false. !< First flapwise blade mode DOF [-] + LOGICAL :: FlapDOF2 = .false. !< Second flapwise blade mode DOF [-] + LOGICAL :: EdgeDOF = .false. !< Edgewise blade mode DOF [-] + LOGICAL :: TeetDOF = .false. !< Rotor-teeter DOF [-] + LOGICAL :: DrTrDOF = .false. !< Drivetrain rotational-flexibility DOF [-] + LOGICAL :: GenDOF = .false. !< Generator DOF [-] + LOGICAL :: YawDOF = .false. !< Nacelle-yaw DOF [-] + LOGICAL :: TwFADOF1 = .false. !< First tower fore-aft bending-mode DOF [-] + LOGICAL :: TwFADOF2 = .false. !< Second tower fore-aft bending-mode DOF [-] + LOGICAL :: TwSSDOF1 = .false. !< First tower side-to-side bending-mode DOF [-] + LOGICAL :: TwSSDOF2 = .false. !< Second tower side-to-side bending-mode DOF [-] + LOGICAL :: PtfmSgDOF = .false. !< Platform horizontal surge translation DOF [-] + LOGICAL :: PtfmSwDOF = .false. !< Platform horizontal sway translation DOF [-] + LOGICAL :: PtfmHvDOF = .false. !< Platform vertical heave translation DOF [-] + LOGICAL :: PtfmRDOF = .false. !< Platform roll tilt rotation DOF [-] + LOGICAL :: PtfmPDOF = .false. !< Platform pitch tilt rotation DOF [-] + LOGICAL :: PtfmYDOF = .false. !< Platform yaw rotation DOF [-] + REAL(ReKi) :: OoPDefl = 0.0_ReKi !< Initial out-of-plane blade-tip displacement [meters] + REAL(ReKi) :: IPDefl = 0.0_ReKi !< Initial in-plane blade-tip deflection [meters] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlPitch !< Initial blade pitch angles [radians] - REAL(ReKi) :: TeetDefl !< Initial teeter angle [radians] - REAL(R8Ki) :: Azimuth !< Initial azimuth angle for blade 1 [radians] - REAL(ReKi) :: RotSpeed !< Initial rotor speed [rad/s] - REAL(ReKi) :: NacYaw !< Initial nacelle-yaw angle [radians] - REAL(ReKi) :: TTDspFA !< Initial fore-aft tower-top displacement [meters] - REAL(ReKi) :: TTDspSS !< Initial side-to-side tower-top displacement [meters] - REAL(ReKi) :: PtfmSurge !< Initial horizontal surge translational displacement of platform [meters] - REAL(ReKi) :: PtfmSway !< Initial horizontal sway translational displacement of platform [meters] - REAL(ReKi) :: PtfmHeave !< Initial vertical heave translational displacement of platform [meters] - REAL(ReKi) :: PtfmRoll !< Initial roll tilt rotational displacement of platform [radians] - REAL(ReKi) :: PtfmPitch !< Initial pitch tilt rotational displacement of platform [radians] - REAL(ReKi) :: PtfmYaw !< Initial yaw rotational displacement of platform [radians] - INTEGER(IntKi) :: NumBl !< Number of blades [-] - REAL(ReKi) :: TipRad !< Preconed blade-tip radius (distance from the rotor apex to the blade tip) [meters] - REAL(ReKi) :: HubRad !< Preconed hub radius (distance from the rotor apex to the blade root) [meters] + REAL(ReKi) :: TeetDefl = 0.0_ReKi !< Initial teeter angle [radians] + REAL(R8Ki) :: Azimuth = 0.0_R8Ki !< Initial azimuth angle for blade 1 [radians] + REAL(ReKi) :: RotSpeed = 0.0_ReKi !< Initial rotor speed [rad/s] + REAL(ReKi) :: NacYaw = 0.0_ReKi !< Initial nacelle-yaw angle [radians] + REAL(ReKi) :: TTDspFA = 0.0_ReKi !< Initial fore-aft tower-top displacement [meters] + REAL(ReKi) :: TTDspSS = 0.0_ReKi !< Initial side-to-side tower-top displacement [meters] + REAL(ReKi) :: PtfmSurge = 0.0_ReKi !< Initial horizontal surge translational displacement of platform [meters] + REAL(ReKi) :: PtfmSway = 0.0_ReKi !< Initial horizontal sway translational displacement of platform [meters] + REAL(ReKi) :: PtfmHeave = 0.0_ReKi !< Initial vertical heave translational displacement of platform [meters] + REAL(ReKi) :: PtfmRoll = 0.0_ReKi !< Initial roll tilt rotational displacement of platform [radians] + REAL(ReKi) :: PtfmPitch = 0.0_ReKi !< Initial pitch tilt rotational displacement of platform [radians] + REAL(ReKi) :: PtfmYaw = 0.0_ReKi !< Initial yaw rotational displacement of platform [radians] + INTEGER(IntKi) :: NumBl = 0_IntKi !< Number of blades [-] + REAL(ReKi) :: TipRad = 0.0_ReKi !< Preconed blade-tip radius (distance from the rotor apex to the blade tip) [meters] + REAL(ReKi) :: HubRad = 0.0_ReKi !< Preconed hub radius (distance from the rotor apex to the blade root) [meters] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PreCone !< Rotor precone angles [radians] - REAL(ReKi) :: HubCM !< Distance from rotor apex to hub mass [meters] - REAL(ReKi) :: UndSling !< Undersling length [meters] - REAL(ReKi) :: Delta3 !< Delta-3 angle for teetering rotors [radians] - REAL(R8Ki) :: AzimB1Up !< Azimuth value to use for I/O when blade 1 points up [radians] - REAL(ReKi) :: OverHang !< Distance from yaw axis to rotor apex or teeter pin [meters] - REAL(ReKi) :: ShftGagL !< Distance from hub or teeter pin to shaft strain gages [meters] - REAL(ReKi) :: ShftTilt !< Rotor shaft tilt angle [radians] - REAL(ReKi) :: NacCMxn !< Downwind distance from tower-top to nacelle CM [meters] - REAL(ReKi) :: NacCMyn !< Lateral distance from tower-top to nacelle CM [meters] - REAL(ReKi) :: NacCMzn !< Vertical distance from tower-top to nacelle CM [meters] - REAL(ReKi) :: NcIMUxn !< Downwind distance from the tower-top to the nacelle IMU [meters] - REAL(ReKi) :: NcIMUyn !< Lateral distance from the tower-top to the nacelle IMU [meters] - REAL(ReKi) :: NcIMUzn !< Vertical distance from the tower-top to the nacelle IMU [meters] - REAL(ReKi) :: Twr2Shft !< Vertical distance from the tower-top to the rotor shaft [meters] - REAL(ReKi) :: TowerHt !< Height of tower relative to ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] [meters] - REAL(ReKi) :: TowerBsHt !< Height of tower base relative to ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] [meters] - REAL(ReKi) :: PtfmCMxt !< Downwind distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform CM [meters] - REAL(ReKi) :: PtfmCMyt !< Lateral distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform CM [meters] - REAL(ReKi) :: PtfmCMzt !< Vertical distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform CM [meters] - REAL(ReKi) :: PtfmRefzt !< Vertical distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform reference point [meters] + REAL(ReKi) :: HubCM = 0.0_ReKi !< Distance from rotor apex to hub mass [meters] + REAL(ReKi) :: UndSling = 0.0_ReKi !< Undersling length [meters] + REAL(ReKi) :: Delta3 = 0.0_ReKi !< Delta-3 angle for teetering rotors [radians] + REAL(R8Ki) :: AzimB1Up = 0.0_R8Ki !< Azimuth value to use for I/O when blade 1 points up [radians] + REAL(ReKi) :: OverHang = 0.0_ReKi !< Distance from yaw axis to rotor apex or teeter pin [meters] + REAL(ReKi) :: ShftGagL = 0.0_ReKi !< Distance from hub or teeter pin to shaft strain gages [meters] + REAL(ReKi) :: ShftTilt = 0.0_ReKi !< Rotor shaft tilt angle [radians] + REAL(ReKi) :: NacCMxn = 0.0_ReKi !< Downwind distance from tower-top to nacelle CM [meters] + REAL(ReKi) :: NacCMyn = 0.0_ReKi !< Lateral distance from tower-top to nacelle CM [meters] + REAL(ReKi) :: NacCMzn = 0.0_ReKi !< Vertical distance from tower-top to nacelle CM [meters] + REAL(ReKi) :: NcIMUxn = 0.0_ReKi !< Downwind distance from the tower-top to the nacelle IMU [meters] + REAL(ReKi) :: NcIMUyn = 0.0_ReKi !< Lateral distance from the tower-top to the nacelle IMU [meters] + REAL(ReKi) :: NcIMUzn = 0.0_ReKi !< Vertical distance from the tower-top to the nacelle IMU [meters] + REAL(ReKi) :: Twr2Shft = 0.0_ReKi !< Vertical distance from the tower-top to the rotor shaft [meters] + REAL(ReKi) :: TowerHt = 0.0_ReKi !< Height of tower relative to ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] [meters] + REAL(ReKi) :: TowerBsHt = 0.0_ReKi !< Height of tower base relative to ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] [meters] + REAL(ReKi) :: PtfmCMxt = 0.0_ReKi !< Downwind distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform CM [meters] + REAL(ReKi) :: PtfmCMyt = 0.0_ReKi !< Lateral distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform CM [meters] + REAL(ReKi) :: PtfmCMzt = 0.0_ReKi !< Vertical distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform CM [meters] + REAL(ReKi) :: PtfmRefzt = 0.0_ReKi !< Vertical distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform reference point [meters] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TipMass !< Tip-brake masses [kg] - REAL(ReKi) :: HubMass !< Hub mass [kg] - REAL(ReKi) :: HubIner !< Hub inertia about teeter axis (2-blader) or rotor axis (3-blader) [kg m^2] - REAL(ReKi) :: GenIner !< Generator inertia about HSS [kg m^2] - REAL(ReKi) :: NacMass !< Nacelle mass [kg] - REAL(ReKi) :: NacYIner !< Nacelle yaw inertia [kg m^2] - REAL(ReKi) :: YawBrMass !< Yaw bearing mass [kg] - REAL(ReKi) :: PtfmMass !< Platform mass [kg] - REAL(ReKi) :: PtfmRIner !< Platform inertia for roll tilt rotation about the platform CM [kg m^2] - REAL(ReKi) :: PtfmPIner !< Platform inertia for pitch tilt rotation about the platform CM [kg m^2] - REAL(ReKi) :: PtfmYIner !< Platform inertia for yaw rotation about the platform CM [kg m^2] - REAL(ReKi) :: BldNodes !< Number of blade nodes (per blade) used for analysis [-] + REAL(ReKi) :: HubMass = 0.0_ReKi !< Hub mass [kg] + REAL(ReKi) :: HubIner = 0.0_ReKi !< Hub inertia about teeter axis (2-blader) or rotor axis (3-blader) [kg m^2] + REAL(ReKi) :: GenIner = 0.0_ReKi !< Generator inertia about HSS [kg m^2] + REAL(ReKi) :: NacMass = 0.0_ReKi !< Nacelle mass [kg] + REAL(ReKi) :: NacYIner = 0.0_ReKi !< Nacelle yaw inertia [kg m^2] + REAL(ReKi) :: YawBrMass = 0.0_ReKi !< Yaw bearing mass [kg] + REAL(ReKi) :: PtfmMass = 0.0_ReKi !< Platform mass [kg] + REAL(ReKi) :: PtfmRIner = 0.0_ReKi !< Platform inertia for roll tilt rotation about the platform CM [kg m^2] + REAL(ReKi) :: PtfmPIner = 0.0_ReKi !< Platform inertia for pitch tilt rotation about the platform CM [kg m^2] + REAL(ReKi) :: PtfmYIner = 0.0_ReKi !< Platform inertia for yaw rotation about the platform CM [kg m^2] + REAL(ReKi) :: BldNodes = 0.0_ReKi !< Number of blade nodes (per blade) used for analysis [-] TYPE(ED_BladeMeshInputData) , DIMENSION(:), ALLOCATABLE :: InpBlMesh !< Input data for blade discretizations (could be on each blade) [see BladeMeshInputData] TYPE(BladeInputData) , DIMENSION(:), ALLOCATABLE :: InpBl !< Input data for individual blades [see BladeInputData type] - INTEGER(IntKi) :: TeetMod !< Rotor-teeter spring/damper model switch [-] - REAL(ReKi) :: TeetDmpP !< Rotor-teeter damper position [radians] - REAL(ReKi) :: TeetDmp !< Rotor-teeter damping constant [N-m/(rad/s)] - REAL(ReKi) :: TeetCDmp !< Rotor-teeter rate-independent Coulomb-damping [N-m] - REAL(ReKi) :: TeetSStP !< Rotor-teeter soft-stop position [radians] - REAL(ReKi) :: TeetHStP !< Rotor-teeter hard-stop position [radians] - REAL(ReKi) :: TeetSSSp !< Rotor-teeter soft-stop linear-spring constant [N-m/rad] - REAL(ReKi) :: TeetHSSp !< Rotor-teeter hard-stop linear-spring constant [N-m/rad] - REAL(ReKi) :: GBoxEff !< Gearbox efficiency [%] - REAL(ReKi) :: GBRatio !< Gearbox ratio [-] - REAL(ReKi) :: DTTorSpr !< Drivetrain torsional spring [N-m/rad] - REAL(ReKi) :: DTTorDmp !< Drivetrain torsional damper [N-m/(rad/s)] - LOGICAL :: Furling !< Use Additional Furling parameters? [-] - INTEGER(IntKi) :: TwrNodes !< Number of tower nodes used in the analysis [-] - LOGICAL :: SumPrint !< Print summary data to .sum [-] - INTEGER(IntKi) :: OutFile !< Switch to determine where output will be placed: (1: in module output file only; 2: in glue code output file only; 3: both) [-] - LOGICAL :: TabDelim !< Flag to cause tab-delimited text output (delimited by space otherwise) [-] - CHARACTER(20) :: OutFmt !< Format used for module's text tabular output (except time); resulting field should be 10 characters [-] - REAL(DbKi) :: Tstart !< Time to start module's tabular output [seconds] - INTEGER(IntKi) :: DecFact !< Decimation factor for module's tabular output (1=output every step) [-] - INTEGER(IntKi) :: NTwGages !< Number of tower strain gages [-] - INTEGER(IntKi) , DIMENSION(1:9) :: TwrGagNd !< Nodes closest to the tower strain gages [-] - INTEGER(IntKi) :: NBlGages !< Number of blade strain gages [-] - INTEGER(IntKi) , DIMENSION(1:9) :: BldGagNd !< Nodes closest to the blade strain gages [-] - INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] + INTEGER(IntKi) :: TeetMod = 0_IntKi !< Rotor-teeter spring/damper model switch [-] + REAL(ReKi) :: TeetDmpP = 0.0_ReKi !< Rotor-teeter damper position [radians] + REAL(ReKi) :: TeetDmp = 0.0_ReKi !< Rotor-teeter damping constant [N-m/(rad/s)] + REAL(ReKi) :: TeetCDmp = 0.0_ReKi !< Rotor-teeter rate-independent Coulomb-damping [N-m] + REAL(ReKi) :: TeetSStP = 0.0_ReKi !< Rotor-teeter soft-stop position [radians] + REAL(ReKi) :: TeetHStP = 0.0_ReKi !< Rotor-teeter hard-stop position [radians] + REAL(ReKi) :: TeetSSSp = 0.0_ReKi !< Rotor-teeter soft-stop linear-spring constant [N-m/rad] + REAL(ReKi) :: TeetHSSp = 0.0_ReKi !< Rotor-teeter hard-stop linear-spring constant [N-m/rad] + REAL(ReKi) :: GBoxEff = 0.0_ReKi !< Gearbox efficiency [%] + REAL(ReKi) :: GBRatio = 0.0_ReKi !< Gearbox ratio [-] + REAL(ReKi) :: DTTorSpr = 0.0_ReKi !< Drivetrain torsional spring [N-m/rad] + REAL(ReKi) :: DTTorDmp = 0.0_ReKi !< Drivetrain torsional damper [N-m/(rad/s)] + LOGICAL :: Furling = .false. !< Use Additional Furling parameters? [-] + INTEGER(IntKi) :: TwrNodes = 0_IntKi !< Number of tower nodes used in the analysis [-] + LOGICAL :: SumPrint = .false. !< Print summary data to .sum [-] + INTEGER(IntKi) :: OutFile = 0_IntKi !< Switch to determine where output will be placed: (1: in module output file only; 2: in glue code output file only; 3: both) [-] + LOGICAL :: TabDelim = .false. !< Flag to cause tab-delimited text output (delimited by space otherwise) [-] + CHARACTER(20) :: OutFmt = '' !< Format used for module's text tabular output (except time); resulting field should be 10 characters [-] + REAL(DbKi) :: Tstart = 0.0_R8Ki !< Time to start module's tabular output [seconds] + INTEGER(IntKi) :: DecFact = 0_IntKi !< Decimation factor for module's tabular output (1=output every step) [-] + INTEGER(IntKi) :: NTwGages = 0_IntKi !< Number of tower strain gages [-] + INTEGER(IntKi) , DIMENSION(1:9) :: TwrGagNd = 0_IntKi !< Nodes closest to the tower strain gages [-] + INTEGER(IntKi) :: NBlGages = 0_IntKi !< Number of blade strain gages [-] + INTEGER(IntKi) , DIMENSION(1:9) :: BldGagNd = 0_IntKi !< Nodes closest to the blade strain gages [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< List of user-requested output channels [-] - INTEGER(IntKi) :: NTwInpSt !< Number of tower input stations [-] - REAL(ReKi) , DIMENSION(1:2) :: TwrFADmp !< Tower fore-aft structural damping ratios [%] - REAL(ReKi) , DIMENSION(1:2) :: TwrSSDmp !< Tower side-to-side structural damping ratios [%] - REAL(ReKi) , DIMENSION(1:2) :: FAStTunr !< Tower fore-aft modal stiffness tuners [-] - REAL(ReKi) , DIMENSION(1:2) :: SSStTunr !< Tower side-to-side modal stiffness tuners [-] + INTEGER(IntKi) :: NTwInpSt = 0_IntKi !< Number of tower input stations [-] + REAL(ReKi) , DIMENSION(1:2) :: TwrFADmp = 0.0_ReKi !< Tower fore-aft structural damping ratios [%] + REAL(ReKi) , DIMENSION(1:2) :: TwrSSDmp = 0.0_ReKi !< Tower side-to-side structural damping ratios [%] + REAL(ReKi) , DIMENSION(1:2) :: FAStTunr = 0.0_ReKi !< Tower fore-aft modal stiffness tuners [-] + REAL(ReKi) , DIMENSION(1:2) :: SSStTunr = 0.0_ReKi !< Tower side-to-side modal stiffness tuners [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: HtFract !< Fractional height of the flexible portion of tower for a given input station [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TMassDen !< Tower mass density for a given input station [kg/m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwFAStif !< Tower fore-aft stiffness for a given input station [Nm^2] @@ -214,78 +214,78 @@ MODULE ElastoDyn_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwFAM2Sh !< Tower fore-aft mode-2 shape coefficients [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwSSM1Sh !< Tower side-to-side mode-1 shape coefficients [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwSSM2Sh !< Tower side-to-side mode-2 shape coefficients [-] - LOGICAL :: RFrlDOF !< Rotor-furl DOF [-] - LOGICAL :: TFrlDOF !< Tail-furl DOF [-] - REAL(ReKi) :: RotFurl !< Initial or fixed rotor-furl angle [radians] - REAL(ReKi) :: TailFurl !< Initial or fixed tail-furl angle [radians] - REAL(ReKi) :: Yaw2Shft !< Lateral distance from the yaw axis to the rotor shaft [meters] - REAL(ReKi) :: ShftSkew !< Rotor shaft skew angle [radians] - REAL(ReKi) , DIMENSION(1:3) :: RFrlCM_n !< Vector from tower-top to rotor-furl CM [meters] - REAL(ReKi) , DIMENSION(1:3) :: BoomCM_n !< Vector from tower-top to tail boom CM [meters] - REAL(ReKi) , DIMENSION(1:3) :: TFinCM_n !< Vector from tower-top to tail fin CM [meters] - REAL(ReKi) , DIMENSION(1:3) :: RFrlPnt_n !< Vector from tower-top to arbitrary point on rotor-furl axis [meters] - REAL(ReKi) :: RFrlSkew !< Rotor-furl axis skew angle [radians] - REAL(ReKi) :: RFrlTilt !< Rotor-furl axis tilt angle [radians] - REAL(ReKi) , DIMENSION(1:3) :: TFrlPnt_n !< Vector from tower-top to arbitrary point on tail-furl axis [meters] - REAL(ReKi) :: TFrlSkew !< Rotor-furl axis skew angle [radians] - REAL(ReKi) :: TFrlTilt !< Rotor-furl axis tilt angle [radians] - REAL(ReKi) :: RFrlMass !< Rotor-furl mass [kg] - REAL(ReKi) :: BoomMass !< Tail boom mass [kg] - REAL(ReKi) :: TFinMass !< Tail fin mass [kg] - REAL(ReKi) :: RFrlIner !< Rotor-furl inertia about rotor-furl axis [kg m^2] - REAL(ReKi) :: TFrlIner !< Tail boom inertia about tail-furl axis [kg m^2] - INTEGER(IntKi) :: RFrlMod !< Rotor-furl spring/damper model switch [-] - REAL(ReKi) :: RFrlSpr !< Rotor-furl spring constant [N-m/rad] - REAL(ReKi) :: RFrlDmp !< Rotor-furl damping constant [N-m/(rad/s)] - REAL(ReKi) :: RFrlUSSP !< Rotor-furl up-stop spring position [radians] - REAL(ReKi) :: RFrlDSSP !< Rotor-furl down-stop spring position [radians] - REAL(ReKi) :: RFrlUSSpr !< Rotor-furl up-stop spring constant [N-m/rad] - REAL(ReKi) :: RFrlDSSpr !< Rotor-furl down-stop spring constant [N-m/rad] - REAL(ReKi) :: RFrlUSDP !< Rotor-furl up-stop damper position [radians] - REAL(ReKi) :: RFrlDSDP !< Rotor-furl down-stop damper position [radians] - REAL(ReKi) :: RFrlUSDmp !< Rotor-furl up-stop damping constant [N-m/(rad/s)] - REAL(ReKi) :: RFrlDSDmp !< Rotor-furl down-stop damping constant [N-m/(rad/s)] - INTEGER(IntKi) :: TFrlMod !< Tail-furl spring/damper model switch [-] - REAL(ReKi) :: TFrlSpr !< Tail-furl spring constant [N-m/rad] - REAL(ReKi) :: TFrlDmp !< Tail-furl damping constant [N-m/(rad/s)] - REAL(ReKi) :: TFrlUSSP !< Tail-furl up-stop spring position [radians] - REAL(ReKi) :: TFrlDSSP !< Tail-furl down-stop spring position [radians] - REAL(ReKi) :: TFrlUSSpr !< Tail-furl up-stop spring constant [N-m/rad] - REAL(ReKi) :: TFrlDSSpr !< Tail-furl down-stop spring constant [N-m/rad] - REAL(ReKi) :: TFrlUSDP !< Tail-furl up-stop damper position [radians] - REAL(ReKi) :: TFrlDSDP !< Tail-furl down-stop damper position [radians] - REAL(ReKi) :: TFrlUSDmp !< Tail-furl up-stop damping constant [N-m/(rad/s)] - REAL(ReKi) :: TFrlDSDmp !< Tail-furl down-stop damping constant [N-m/(rad/s)] - INTEGER(IntKi) :: method !< Identifier for integration method (1 [RK4], 2 [AB4], or 3 [ABM4]) [-] - INTEGER(IntKi) :: BldNd_NumOuts !< Number of requested output channels per blade node (ED_AllBldNdOuts) [-] + LOGICAL :: RFrlDOF = .false. !< Rotor-furl DOF [-] + LOGICAL :: TFrlDOF = .false. !< Tail-furl DOF [-] + REAL(ReKi) :: RotFurl = 0.0_ReKi !< Initial or fixed rotor-furl angle [radians] + REAL(ReKi) :: TailFurl = 0.0_ReKi !< Initial or fixed tail-furl angle [radians] + REAL(ReKi) :: Yaw2Shft = 0.0_ReKi !< Lateral distance from the yaw axis to the rotor shaft [meters] + REAL(ReKi) :: ShftSkew = 0.0_ReKi !< Rotor shaft skew angle [radians] + REAL(ReKi) , DIMENSION(1:3) :: RFrlCM_n = 0.0_ReKi !< Vector from tower-top to rotor-furl CM [meters] + REAL(ReKi) , DIMENSION(1:3) :: BoomCM_n = 0.0_ReKi !< Vector from tower-top to tail boom CM [meters] + REAL(ReKi) , DIMENSION(1:3) :: TFinCM_n = 0.0_ReKi !< Vector from tower-top to tail fin CM [meters] + REAL(ReKi) , DIMENSION(1:3) :: RFrlPnt_n = 0.0_ReKi !< Vector from tower-top to arbitrary point on rotor-furl axis [meters] + REAL(ReKi) :: RFrlSkew = 0.0_ReKi !< Rotor-furl axis skew angle [radians] + REAL(ReKi) :: RFrlTilt = 0.0_ReKi !< Rotor-furl axis tilt angle [radians] + REAL(ReKi) , DIMENSION(1:3) :: TFrlPnt_n = 0.0_ReKi !< Vector from tower-top to arbitrary point on tail-furl axis [meters] + REAL(ReKi) :: TFrlSkew = 0.0_ReKi !< Rotor-furl axis skew angle [radians] + REAL(ReKi) :: TFrlTilt = 0.0_ReKi !< Rotor-furl axis tilt angle [radians] + REAL(ReKi) :: RFrlMass = 0.0_ReKi !< Rotor-furl mass [kg] + REAL(ReKi) :: BoomMass = 0.0_ReKi !< Tail boom mass [kg] + REAL(ReKi) :: TFinMass = 0.0_ReKi !< Tail fin mass [kg] + REAL(ReKi) :: RFrlIner = 0.0_ReKi !< Rotor-furl inertia about rotor-furl axis [kg m^2] + REAL(ReKi) :: TFrlIner = 0.0_ReKi !< Tail boom inertia about tail-furl axis [kg m^2] + INTEGER(IntKi) :: RFrlMod = 0_IntKi !< Rotor-furl spring/damper model switch [-] + REAL(ReKi) :: RFrlSpr = 0.0_ReKi !< Rotor-furl spring constant [N-m/rad] + REAL(ReKi) :: RFrlDmp = 0.0_ReKi !< Rotor-furl damping constant [N-m/(rad/s)] + REAL(ReKi) :: RFrlUSSP = 0.0_ReKi !< Rotor-furl up-stop spring position [radians] + REAL(ReKi) :: RFrlDSSP = 0.0_ReKi !< Rotor-furl down-stop spring position [radians] + REAL(ReKi) :: RFrlUSSpr = 0.0_ReKi !< Rotor-furl up-stop spring constant [N-m/rad] + REAL(ReKi) :: RFrlDSSpr = 0.0_ReKi !< Rotor-furl down-stop spring constant [N-m/rad] + REAL(ReKi) :: RFrlUSDP = 0.0_ReKi !< Rotor-furl up-stop damper position [radians] + REAL(ReKi) :: RFrlDSDP = 0.0_ReKi !< Rotor-furl down-stop damper position [radians] + REAL(ReKi) :: RFrlUSDmp = 0.0_ReKi !< Rotor-furl up-stop damping constant [N-m/(rad/s)] + REAL(ReKi) :: RFrlDSDmp = 0.0_ReKi !< Rotor-furl down-stop damping constant [N-m/(rad/s)] + INTEGER(IntKi) :: TFrlMod = 0_IntKi !< Tail-furl spring/damper model switch [-] + REAL(ReKi) :: TFrlSpr = 0.0_ReKi !< Tail-furl spring constant [N-m/rad] + REAL(ReKi) :: TFrlDmp = 0.0_ReKi !< Tail-furl damping constant [N-m/(rad/s)] + REAL(ReKi) :: TFrlUSSP = 0.0_ReKi !< Tail-furl up-stop spring position [radians] + REAL(ReKi) :: TFrlDSSP = 0.0_ReKi !< Tail-furl down-stop spring position [radians] + REAL(ReKi) :: TFrlUSSpr = 0.0_ReKi !< Tail-furl up-stop spring constant [N-m/rad] + REAL(ReKi) :: TFrlDSSpr = 0.0_ReKi !< Tail-furl down-stop spring constant [N-m/rad] + REAL(ReKi) :: TFrlUSDP = 0.0_ReKi !< Tail-furl up-stop damper position [radians] + REAL(ReKi) :: TFrlDSDP = 0.0_ReKi !< Tail-furl down-stop damper position [radians] + REAL(ReKi) :: TFrlUSDmp = 0.0_ReKi !< Tail-furl up-stop damping constant [N-m/(rad/s)] + REAL(ReKi) :: TFrlDSDmp = 0.0_ReKi !< Tail-furl down-stop damping constant [N-m/(rad/s)] + INTEGER(IntKi) :: method = 0_IntKi !< Identifier for integration method (1 [RK4], 2 [AB4], or 3 [ABM4]) [-] + INTEGER(IntKi) :: BldNd_NumOuts = 0_IntKi !< Number of requested output channels per blade node (ED_AllBldNdOuts) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: BldNd_OutList !< List of user-requested output channels (ED_AllBldNdOuts) [-] - CHARACTER(1024) :: BldNd_BlOutNd_Str !< String to parse for the blade nodes to actually output (ED_AllBldNdOuts) [-] - INTEGER(IntKi) :: BldNd_BladesOut !< The blades to output (ED_AllBldNdOuts) [-] + CHARACTER(1024) :: BldNd_BlOutNd_Str = '' !< String to parse for the blade nodes to actually output (ED_AllBldNdOuts) [-] + INTEGER(IntKi) :: BldNd_BladesOut = 0_IntKi !< The blades to output (ED_AllBldNdOuts) [-] END TYPE ED_InputFile ! ======================= ! ========= ED_CoordSys ======= TYPE, PUBLIC :: ED_CoordSys - REAL(R8Ki) , DIMENSION(1:3) :: a1 !< Vector / direction a1 (= xt from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: a2 !< Vector / direction a2 (= zt from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: a3 !< Vector / direction a3 (= -yt from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: b1 !< Vector / direction b1 (= xp from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: b2 !< Vector / direction b2 (= zp from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: b3 !< Vector / direction b3 (= -yp from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: c1 !< Vector / direction c1 (= xs from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: c2 !< Vector / direction c2 (= zs from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: c3 !< Vector / direction c3 (= -ys from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: d1 !< Vector / direction d1 (= xn from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: d2 !< Vector / direction d2 (= zn from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: d3 !< Vector / direction d3 (= -yn from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: e1 !< Vector / direction e1 (= xa from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: e2 !< Vector / direction e2 (= ya from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: e3 !< Vector / direction e3 (= za from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: f1 !< Vector / direction f1 [-] - REAL(R8Ki) , DIMENSION(1:3) :: f2 !< Vector / direction f2 [-] - REAL(R8Ki) , DIMENSION(1:3) :: f3 !< Vector / direction f3 [-] - REAL(R8Ki) , DIMENSION(1:3) :: g1 !< Vector / direction g1 (= xh from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: g2 !< Vector / direction g2 (= yh from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: g3 !< Vector / direction g3 (= zh from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: a1 = 0.0_R8Ki !< Vector / direction a1 (= xt from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: a2 = 0.0_R8Ki !< Vector / direction a2 (= zt from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: a3 = 0.0_R8Ki !< Vector / direction a3 (= -yt from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: b1 = 0.0_R8Ki !< Vector / direction b1 (= xp from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: b2 = 0.0_R8Ki !< Vector / direction b2 (= zp from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: b3 = 0.0_R8Ki !< Vector / direction b3 (= -yp from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: c1 = 0.0_R8Ki !< Vector / direction c1 (= xs from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: c2 = 0.0_R8Ki !< Vector / direction c2 (= zs from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: c3 = 0.0_R8Ki !< Vector / direction c3 (= -ys from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: d1 = 0.0_R8Ki !< Vector / direction d1 (= xn from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: d2 = 0.0_R8Ki !< Vector / direction d2 (= zn from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: d3 = 0.0_R8Ki !< Vector / direction d3 (= -yn from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: e1 = 0.0_R8Ki !< Vector / direction e1 (= xa from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: e2 = 0.0_R8Ki !< Vector / direction e2 (= ya from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: e3 = 0.0_R8Ki !< Vector / direction e3 (= za from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: f1 = 0.0_R8Ki !< Vector / direction f1 [-] + REAL(R8Ki) , DIMENSION(1:3) :: f2 = 0.0_R8Ki !< Vector / direction f2 [-] + REAL(R8Ki) , DIMENSION(1:3) :: f3 = 0.0_R8Ki !< Vector / direction f3 [-] + REAL(R8Ki) , DIMENSION(1:3) :: g1 = 0.0_R8Ki !< Vector / direction g1 (= xh from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: g2 = 0.0_R8Ki !< Vector / direction g2 (= yh from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: g3 = 0.0_R8Ki !< Vector / direction g3 (= zh from the IEC coord. system) [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: i1 !< i1(K,:) = vector / direction i1 for blade K (= xcK from the IEC coord. system) [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: i2 !< i2(K,:) = vector / direction i2 for blade K (= ycK from the IEC coord. system) [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: i3 !< i3(K,:) = vector / direction i3 for blade K (= zcK from the IEC coord. system) [-] @@ -298,37 +298,37 @@ MODULE ElastoDyn_Types REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: n1 !< n1(K,J,:) = vector / direction n1 for node J of blade K (= LxbK from the IEC coord. system) [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: n2 !< n2(K,J,:) = vector / direction n2 for node J of blade K (= LybK from the IEC coord. system) [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: n3 !< n3(K,J,:) = vector / direction n3 for node J of blade K (= LzbK from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: rf1 !< Vector / direction rf1 (rotor-furl coordinate system = d1 when rotor-furl angle = 0) [-] - REAL(R8Ki) , DIMENSION(1:3) :: rf2 !< Vector / direction rf2 (rotor-furl coordinate system = d2 when rotor-furl angle = 0) [-] - REAL(R8Ki) , DIMENSION(1:3) :: rf3 !< Vector / direction rf3 (rotor-furl coordinate system = d3 when rotor-furl angle = 0) [-] - REAL(R8Ki) , DIMENSION(1:3) :: rfa !< Vector / direction of the rotor-furl axis [-] + REAL(R8Ki) , DIMENSION(1:3) :: rf1 = 0.0_R8Ki !< Vector / direction rf1 (rotor-furl coordinate system = d1 when rotor-furl angle = 0) [-] + REAL(R8Ki) , DIMENSION(1:3) :: rf2 = 0.0_R8Ki !< Vector / direction rf2 (rotor-furl coordinate system = d2 when rotor-furl angle = 0) [-] + REAL(R8Ki) , DIMENSION(1:3) :: rf3 = 0.0_R8Ki !< Vector / direction rf3 (rotor-furl coordinate system = d3 when rotor-furl angle = 0) [-] + REAL(R8Ki) , DIMENSION(1:3) :: rfa = 0.0_R8Ki !< Vector / direction of the rotor-furl axis [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: t1 !< Vector / direction t1 for tower node J (= Lxt from the IEC coord. system) [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: t2 !< Vector / direction t2 for tower node J (= Lzt from the IEC coord. system) [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: t3 !< Vector / direction t3 for tower node J (= -Lyt from the IEC coord. system) [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: te1 !< te1(K,J,:) = vector / direction te1 for node J of blade K (used to calc. noise) [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: te2 !< te2(K,J,:) = vector / direction te2 for node J of blade K (used to calc. noise) [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: te3 !< te3(K,J,:) = vector / direction te3 for node J of blade K (used to calc. noise) [-] - REAL(R8Ki) , DIMENSION(1:3) :: tf1 !< Vector / direction tf1 (tail-furl coordinate system = d1 when rotor-furl angle = 0) [-] - REAL(R8Ki) , DIMENSION(1:3) :: tf2 !< Vector / direction tf2 (tail-furl coordinate system = d2 when rotor-furl angle = 0) [-] - REAL(R8Ki) , DIMENSION(1:3) :: tf3 !< Vector / direction tf3 (tail-furl coordinate system = d3 when rotor-furl angle = 0) [-] - REAL(R8Ki) , DIMENSION(1:3) :: tfa !< Vector / direction of the tail-furl axis [-] - REAL(R8Ki) , DIMENSION(1:3) :: z1 !< Vector / direction z1 (= xi from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: z2 !< Vector / direction z2 (= zi from the IEC coord. system) [-] - REAL(R8Ki) , DIMENSION(1:3) :: z3 !< Vector / direction z3 (= -yi from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: tf1 = 0.0_R8Ki !< Vector / direction tf1 (tail-furl coordinate system = d1 when rotor-furl angle = 0) [-] + REAL(R8Ki) , DIMENSION(1:3) :: tf2 = 0.0_R8Ki !< Vector / direction tf2 (tail-furl coordinate system = d2 when rotor-furl angle = 0) [-] + REAL(R8Ki) , DIMENSION(1:3) :: tf3 = 0.0_R8Ki !< Vector / direction tf3 (tail-furl coordinate system = d3 when rotor-furl angle = 0) [-] + REAL(R8Ki) , DIMENSION(1:3) :: tfa = 0.0_R8Ki !< Vector / direction of the tail-furl axis [-] + REAL(R8Ki) , DIMENSION(1:3) :: z1 = 0.0_R8Ki !< Vector / direction z1 (= xi from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: z2 = 0.0_R8Ki !< Vector / direction z2 (= zi from the IEC coord. system) [-] + REAL(R8Ki) , DIMENSION(1:3) :: z3 = 0.0_R8Ki !< Vector / direction z3 (= -yi from the IEC coord. system) [-] END TYPE ED_CoordSys ! ======================= ! ========= ED_ActiveDOFs ======= TYPE, PUBLIC :: ED_ActiveDOFs - INTEGER(IntKi) :: NActvDOF !< The number of active (enabled) DOFs in the model [-] - INTEGER(IntKi) :: NPCE !< Number of DOFs that contribute to the QD2T-related linear accelerations of the hub center of mass (point C) in the inertia frame, based on which DOFs are presently enabled [-] - INTEGER(IntKi) :: NPDE !< Number of DOFs that contribute to the QD2T-related linear accelerations of the center of mass of the structure that furls with the rotor (not including rotor) (point D) in the inertia frame, based on which DOFs are presently enabled [-] - INTEGER(IntKi) :: NPIE !< Number of DOFs that contribute to the QD2T-related linear accelerations of the tail boom center of mass (point I) in the inertia frame, based on which DOFs are presently enabled [-] - INTEGER(IntKi) :: NPTE !< Number of DOFs that contribute to the QD2T-related linear accelerations of the tower nodes (point T) in the inertia frame, based on which DOFs are presently enabled [-] - INTEGER(IntKi) :: NPTTE !< Number of tower DOFs that contribute to the QD2T-related linear accelerations of the tower nodes (point T) in the inertia frame, based on which DOFs are presently enabled [-] + INTEGER(IntKi) :: NActvDOF = 0_IntKi !< The number of active (enabled) DOFs in the model [-] + INTEGER(IntKi) :: NPCE = 0_IntKi !< Number of DOFs that contribute to the QD2T-related linear accelerations of the hub center of mass (point C) in the inertia frame, based on which DOFs are presently enabled [-] + INTEGER(IntKi) :: NPDE = 0_IntKi !< Number of DOFs that contribute to the QD2T-related linear accelerations of the center of mass of the structure that furls with the rotor (not including rotor) (point D) in the inertia frame, based on which DOFs are presently enabled [-] + INTEGER(IntKi) :: NPIE = 0_IntKi !< Number of DOFs that contribute to the QD2T-related linear accelerations of the tail boom center of mass (point I) in the inertia frame, based on which DOFs are presently enabled [-] + INTEGER(IntKi) :: NPTE = 0_IntKi !< Number of DOFs that contribute to the QD2T-related linear accelerations of the tower nodes (point T) in the inertia frame, based on which DOFs are presently enabled [-] + INTEGER(IntKi) :: NPTTE = 0_IntKi !< Number of tower DOFs that contribute to the QD2T-related linear accelerations of the tower nodes (point T) in the inertia frame, based on which DOFs are presently enabled [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NPSBE !< Number of blade DOFs that contribute to the QD2T-related linear accelerations of the blade nodes (point S) in the inertia frame, based on which DOFs are presently enabled [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NPSE !< Number of DOFs that contribute to the QD2T-related linear accelerations of the blade nodes (point S) in the inertia frame, based on which DOFs are presently enabled [-] - INTEGER(IntKi) :: NPUE !< Number of DOFs that contribute to the QD2T-related linear accelerations of the nacelle center of mass (point U) in the inertia frame, based on which DOFs are presently enabled [-] - INTEGER(IntKi) :: NPYE !< Number of DOFs that contribute to the QD2T-related linear accelerations of the platform center of mass (point Y) in the inertia frame, based on which DOFs are presently enabled [-] + INTEGER(IntKi) :: NPUE = 0_IntKi !< Number of DOFs that contribute to the QD2T-related linear accelerations of the nacelle center of mass (point U) in the inertia frame, based on which DOFs are presently enabled [-] + INTEGER(IntKi) :: NPYE = 0_IntKi !< Number of DOFs that contribute to the QD2T-related linear accelerations of the platform center of mass (point Y) in the inertia frame, based on which DOFs are presently enabled [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: PCE !< Array of DOF indices (pointers) that contribute to the QD2T-related linear accelerations of the hub center of mass (point C) in the inertia frame, based on which DOFs are presently enabled [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: PDE !< Array of DOF indices (pointers) that contribute to the QD2T-related linear accelerations of the center of mass of the structure that furls with the rotor (not including rotor) (point D) in the inertia frame, based on which DOFs are presently enabled [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: PIE !< Array of DOF indices (pointers) that contribute to the QD2T-related linear accelerations of the tail boom center of mass (point I) in the inertia frame, based on which DOFs are presently enabled [-] @@ -346,39 +346,39 @@ MODULE ElastoDyn_Types ! ======================= ! ========= ED_RtHndSide ======= TYPE, PUBLIC :: ED_RtHndSide - REAL(R8Ki) , DIMENSION(1:3) :: rO !< Position vector from inertial frame origin to tower-top / base plate (point O) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rO = 0.0_R8Ki !< Position vector from inertial frame origin to tower-top / base plate (point O) [m] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: rQS !< Position vector from the apex of rotation (point Q) to a point on a blade (point S) [m] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: rS !< Position vector from inertial frame origin to a point on a blade (point S) [m] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: rS0S !< Position vector from the blade root (point S(0)) to a point on a blade (point S) [m] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: rT !< Position vector from inertial frame origin to the current node (point T(HNodes(J)) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rT0O !< Position vector from the tower base (point T(0)) to tower-top / base plate (point O) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rT0O = 0.0_R8Ki !< Position vector from the tower base (point T(0)) to tower-top / base plate (point O) [m] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: rT0T !< Position vector from a height of TowerBsHt (base of flexible portion of tower) (point T(0)) to a point on the tower (point T) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rZ !< Position vector from inertia frame origin to platform reference (point Z) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rZO !< Position vector from platform reference (point Z) to tower-top / base plate (point O) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rZ = 0.0_R8Ki !< Position vector from inertia frame origin to platform reference (point Z) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rZO = 0.0_R8Ki !< Position vector from platform reference (point Z) to tower-top / base plate (point O) [m] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: rZT !< Position vector from platform reference (point Z) to a point on a tower (point T) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rPQ !< Position vector from teeter pin (point P) to apex of rotation (point Q) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rP !< Position vector from inertial frame origin to teeter pin (point P) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rV !< Position vector from inertial frame origin to specified point on rotor-furl axis (point V) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rJ !< Position vector from inertial frame origin to tail fin center of mass (point J) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rZY !< Position vector from platform reference (point Z) to platform mass center (point Y) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rOU !< Position vector from tower-top / base plate (point O) to nacelle center of mass (point U). [m] - REAL(R8Ki) , DIMENSION(1:3) :: rOV !< Position vector from tower-top / base plate (point O) to specified point on rotor-furl axis (point V) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rVD !< Position vector from specified point on rotor-furl axis (point V) to center of mass of structure that furls with the rotor (not including rotor) (point D) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rOW !< Position vector from tower-top / base plate (point O) to specified point on tail-furl axis (point W) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rPC !< Position vector from teeter pin (point P) to hub center of mass (point C) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rPQ = 0.0_R8Ki !< Position vector from teeter pin (point P) to apex of rotation (point Q) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rP = 0.0_R8Ki !< Position vector from inertial frame origin to teeter pin (point P) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rV = 0.0_R8Ki !< Position vector from inertial frame origin to specified point on rotor-furl axis (point V) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rJ = 0.0_R8Ki !< Position vector from inertial frame origin to tail fin center of mass (point J) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rZY = 0.0_R8Ki !< Position vector from platform reference (point Z) to platform mass center (point Y) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rOU = 0.0_R8Ki !< Position vector from tower-top / base plate (point O) to nacelle center of mass (point U). [m] + REAL(R8Ki) , DIMENSION(1:3) :: rOV = 0.0_R8Ki !< Position vector from tower-top / base plate (point O) to specified point on rotor-furl axis (point V) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rVD = 0.0_R8Ki !< Position vector from specified point on rotor-furl axis (point V) to center of mass of structure that furls with the rotor (not including rotor) (point D) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rOW = 0.0_R8Ki !< Position vector from tower-top / base plate (point O) to specified point on tail-furl axis (point W) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rPC = 0.0_R8Ki !< Position vector from teeter pin (point P) to hub center of mass (point C) [m] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: rPS0 !< Position vector from teeter pin (point P) to blade root (point S(0)) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rQ !< Position vector from inertial frame origin to apex of rotation (point Q) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rQC !< Position vector from apex of rotation (point Q) to hub center of mass (point C) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rVIMU !< Position vector from specified point on rotor-furl axis (point V) to nacelle IMU (point IMU) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rVP !< Position vector from specified point on rotor-furl axis (point V) to teeter pin (point P) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rWI !< Position vector from specified point on tail-furl axis (point W) to tail boom center of mass (point I) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rWJ !< Position vector from specified point on tail-furl axis (point W) to tail fin center of mass (point J) [m] - REAL(R8Ki) , DIMENSION(1:3) :: rZT0 !< Position vector from platform reference (point Z) to tower base (point T(0)) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rQ = 0.0_R8Ki !< Position vector from inertial frame origin to apex of rotation (point Q) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rQC = 0.0_R8Ki !< Position vector from apex of rotation (point Q) to hub center of mass (point C) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rVIMU = 0.0_R8Ki !< Position vector from specified point on rotor-furl axis (point V) to nacelle IMU (point IMU) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rVP = 0.0_R8Ki !< Position vector from specified point on rotor-furl axis (point V) to teeter pin (point P) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rWI = 0.0_R8Ki !< Position vector from specified point on tail-furl axis (point W) to tail boom center of mass (point I) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rWJ = 0.0_R8Ki !< Position vector from specified point on tail-furl axis (point W) to tail fin center of mass (point J) [m] + REAL(R8Ki) , DIMENSION(1:3) :: rZT0 = 0.0_R8Ki !< Position vector from platform reference (point Z) to tower base (point T(0)) [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AngPosEF !< Angular position of the current point on the tower (body F) in the inertial frame (body E for earth) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AngPosXF !< Angular position of the current point on the tower (body F) in the platform (body X) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AngPosHM !< Angular position of eleMent J of blade K (body M) in the hub (body H) [-] - REAL(ReKi) , DIMENSION(1:3) :: AngPosXB !< Angular position of the base plate (body B) in the platform (body X) [-] - REAL(ReKi) , DIMENSION(1:3) :: AngPosEX !< Angular position of the platform (body X) in the inertial frame (body E for earth) [-] + REAL(ReKi) , DIMENSION(1:3) :: AngPosXB = 0.0_ReKi !< Angular position of the base plate (body B) in the platform (body X) [-] + REAL(ReKi) , DIMENSION(1:3) :: AngPosEX = 0.0_ReKi !< Angular position of the platform (body X) in the inertial frame (body E for earth) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: PAngVelEA !< Partial angular velocity (and its 1st time derivative) of the tail (body A) in the inertia frame (body E for earth) [-] REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: PAngVelEF !< Partial angular velocity (and its 1st time derivative) of tower element J (body F) in the inertia frame (body E for earth) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: PAngVelEG !< Partial angular velocity (and its 1st time derivative) of the generator (body G) in the inertia frame (body E for earth) [-] @@ -387,37 +387,37 @@ MODULE ElastoDyn_Types REAL(ReKi) , DIMENSION(:,:,:,:,:), ALLOCATABLE :: PAngVelEM !< Partial angular velocity (and its 1st time derivative) of eleMent J of blade K (body M) in the inertia frame (body E for earth) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AngVelEM !< Angular velocity of of eleMent J of blade K (body M) in the inertia frame (body E for earth) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: PAngVelEN !< Partial angular velocity (and its 1st time derivative) of the nacelle (body N) in the inertia frame (body E for earth) [-] - REAL(ReKi) , DIMENSION(1:3) :: AngVelEA !< Angular velocity of the tail (body A) in the inertia frame (body E for earth) [-] + REAL(ReKi) , DIMENSION(1:3) :: AngVelEA = 0.0_ReKi !< Angular velocity of the tail (body A) in the inertia frame (body E for earth) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: PAngVelEB !< Partial angular velocity (and its 1st time derivative) of the base plate (body B) in the inertia frame (body E for earth) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: PAngVelER !< Partial angular velocity (and its 1st time derivative) of the structure that furls with the rotor (not including rotor) (body R) in the inertia frame (body E for earth) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: PAngVelEX !< Partial angular velocity (and its 1st time derivative) of the platform (body B) in the inertia frame (body E for earth) [-] - REAL(ReKi) , DIMENSION(1:3) :: AngVelEG !< Angular velocity of the generator (body G) in the inertia frame (body E for earth) [-] - REAL(ReKi) , DIMENSION(1:3) :: AngVelEH !< Angular velocity of the hub (body H) in the inertia frame (body E for earth) [-] - REAL(ReKi) , DIMENSION(1:3) :: AngVelEL !< Angular velocity of the low-speed shaft (body L) in the inertia frame (body E for earth) [-] - REAL(ReKi) , DIMENSION(1:3) :: AngVelEN !< Angular velocity of the nacelle (body N) in the inertia frame (body E for earth) [-] - REAL(ReKi) , DIMENSION(1:3) :: AngVelEB !< Angular velocity of the base plate (body B) in the inertia frame (body E for earth) [-] - REAL(ReKi) , DIMENSION(1:3) :: AngVelER !< Angular velocity of the structure that furls with the rotor (not including rotor) (body R) in the inertia frame (body E for earth) [-] - REAL(ReKi) , DIMENSION(1:3) :: AngVelEX !< Angular velocity of the platform (body X) in the inertia frame (body E for earth) [-] - REAL(R8Ki) :: TeetAngVel !< Angular velocity of the teeter motion [-] - REAL(ReKi) , DIMENSION(1:3) :: AngAccEBt !< Portion of the angular acceleration of the base plate (body B) in the inertia frame (body E for earth) associated with everything but the QD2T()s [-] - REAL(ReKi) , DIMENSION(1:3) :: AngAccERt !< Portion of the angular acceleration of the structure that furls with the rotor (not including rotor) (body R) in the inertia frame (body E for earth) associated with everything but the QD2T()s [-] - REAL(ReKi) , DIMENSION(1:3) :: AngAccEXt !< Portion of the angular acceleration of the platform (body X) in the inertia frame (body E for earth) associated with everything but the QD2T()s [-] + REAL(ReKi) , DIMENSION(1:3) :: AngVelEG = 0.0_ReKi !< Angular velocity of the generator (body G) in the inertia frame (body E for earth) [-] + REAL(ReKi) , DIMENSION(1:3) :: AngVelEH = 0.0_ReKi !< Angular velocity of the hub (body H) in the inertia frame (body E for earth) [-] + REAL(ReKi) , DIMENSION(1:3) :: AngVelEL = 0.0_ReKi !< Angular velocity of the low-speed shaft (body L) in the inertia frame (body E for earth) [-] + REAL(ReKi) , DIMENSION(1:3) :: AngVelEN = 0.0_ReKi !< Angular velocity of the nacelle (body N) in the inertia frame (body E for earth) [-] + REAL(ReKi) , DIMENSION(1:3) :: AngVelEB = 0.0_ReKi !< Angular velocity of the base plate (body B) in the inertia frame (body E for earth) [-] + REAL(ReKi) , DIMENSION(1:3) :: AngVelER = 0.0_ReKi !< Angular velocity of the structure that furls with the rotor (not including rotor) (body R) in the inertia frame (body E for earth) [-] + REAL(ReKi) , DIMENSION(1:3) :: AngVelEX = 0.0_ReKi !< Angular velocity of the platform (body X) in the inertia frame (body E for earth) [-] + REAL(R8Ki) :: TeetAngVel = 0.0_R8Ki !< Angular velocity of the teeter motion [-] + REAL(ReKi) , DIMENSION(1:3) :: AngAccEBt = 0.0_ReKi !< Portion of the angular acceleration of the base plate (body B) in the inertia frame (body E for earth) associated with everything but the QD2T()s [-] + REAL(ReKi) , DIMENSION(1:3) :: AngAccERt = 0.0_ReKi !< Portion of the angular acceleration of the structure that furls with the rotor (not including rotor) (body R) in the inertia frame (body E for earth) associated with everything but the QD2T()s [-] + REAL(ReKi) , DIMENSION(1:3) :: AngAccEXt = 0.0_ReKi !< Portion of the angular acceleration of the platform (body X) in the inertia frame (body E for earth) associated with everything but the QD2T()s [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AngAccEFt !< Portion of the angular acceleration of tower element J (body F) in the inertia frame (body E for earth) associated with everything but the QD2T()s [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AngVelEF !< Angular velocity of the current point on the tower (body F) in the inertia frame (body E for earth) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AngVelHM !< Angular velocity of the current point on the blade in the inertia frame [-] - REAL(ReKi) , DIMENSION(1:3) :: AngAccEAt !< Portion of the angular acceleration of the tail (body A) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: AngAccEGt !< Portion of the angular acceleration of the generator (body G) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: AngAccEHt !< Portion of the angular acceleration of the hub (body H) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: AngAccEAt = 0.0_ReKi !< Portion of the angular acceleration of the tail (body A) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: AngAccEGt = 0.0_ReKi !< Portion of the angular acceleration of the generator (body G) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: AngAccEHt = 0.0_ReKi !< Portion of the angular acceleration of the hub (body H) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AngAccEKt !< Portion of the angular acceleration of the blade in the inertia frame associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: AngAccENt !< Portion of the angular acceleration of the nacelle (body N) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: LinAccECt !< Portion of the linear acceleration of the hub center of mass (point C) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: LinAccEDt !< Portion of the linear acceleration of the center of mass of the structure that furls with the rotor (not including rotor) (point D) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: LinAccEIt !< Portion of the linear acceleration of the tail boom center of mass (point I) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: LinAccEJt !< Portion of the linear acceleration of the tail fin center of mass (point J) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: LinAccEUt !< Portion of the linear acceleration of the nacelle center of mass (point U) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: LinAccEYt !< Portion of the linear acceleration of the platform center of mass (point Y) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: AngAccENt = 0.0_ReKi !< Portion of the angular acceleration of the nacelle (body N) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: LinAccECt = 0.0_ReKi !< Portion of the linear acceleration of the hub center of mass (point C) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: LinAccEDt = 0.0_ReKi !< Portion of the linear acceleration of the center of mass of the structure that furls with the rotor (not including rotor) (point D) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: LinAccEIt = 0.0_ReKi !< Portion of the linear acceleration of the tail boom center of mass (point I) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: LinAccEJt = 0.0_ReKi !< Portion of the linear acceleration of the tail fin center of mass (point J) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: LinAccEUt = 0.0_ReKi !< Portion of the linear acceleration of the nacelle center of mass (point U) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: LinAccEYt = 0.0_ReKi !< Portion of the linear acceleration of the platform center of mass (point Y) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: LinVelES !< Linear velocity of current point on the current blade (point S) in the inertia frame [-] - REAL(ReKi) , DIMENSION(1:3) :: LinVelEQ !< Linear velocity of of the apex of rotation (point Q) in the inertia frame (body E for earth) [-] + REAL(ReKi) , DIMENSION(1:3) :: LinVelEQ = 0.0_ReKi !< Linear velocity of of the apex of rotation (point Q) in the inertia frame (body E for earth) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: LinVelET !< Linear velocity of current point on the tower (point T) in the inertia frame [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: LinVelESm2 !< The m2-component (closest to tip) of LinVelES [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: PLinVelEIMU !< Partial linear velocity (and its 1st time derivative) of the nacelle IMU (point IMU) in the inertia frame (body E for earth) [-] @@ -435,38 +435,38 @@ MODULE ElastoDyn_Types REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: PLinVelEV !< Partial linear velocity (and its 1st time derivative) of the selected point on the rotor-furl axis (point V) in the inertia frame (body E for earth) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: PLinVelEW !< Partial linear velocity (and its 1st time derivative) of the selected point on the tail-furl axis (point W) in the inertia frame (body E for earth) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: PLinVelEY !< Partial linear velocity (and its 1st time derivative) of the platform mass center (point Y) in the inertia frame (body E for earth) [-] - REAL(ReKi) , DIMENSION(1:3) :: LinAccEIMUt !< Portion of the linear acceleration of the nacelle IMU (point IMU) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: LinAccEOt !< Portion of the linear acceleration of the base plate (point O) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: LinAccEIMUt = 0.0_ReKi !< Portion of the linear acceleration of the nacelle IMU (point IMU) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: LinAccEOt = 0.0_ReKi !< Portion of the linear acceleration of the base plate (point O) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: LinAccESt !< Portion of the linear acceleration of a point on a blade (point S) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: LinAccETt !< Portion of the linear acceleration of a point on the tower (point T) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: LinAccEZt !< Portion of the linear acceleration of the platform reference (point Z) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: LinVelEIMU !< Linear velocity of the nacelle IMU (point IMU) in the inertia frame [-] - REAL(ReKi) , DIMENSION(1:3) :: LinVelEZ !< Linear velocity of platform reference (point Z) in the inertia frame [-] - REAL(ReKi) , DIMENSION(1:3) :: LinVelEO !< Linear velocity of the base plate (point O) in the inertia frame (body E for earth) [-] - REAL(ReKi) , DIMENSION(1:3) :: LinVelEJ !< Linear velocity of the tail fin CM (point J) in the inertia frame (body E for earth) [-] - REAL(ReKi) , DIMENSION(1:3) :: FrcONcRtt !< Portion of the force at yaw bearing (point O) due to the nacelle, generator, and rotor associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: FrcPRott !< Portion of the force at the teeter pin (point P) due to the rotor associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: LinAccEZt = 0.0_ReKi !< Portion of the linear acceleration of the platform reference (point Z) in the inertia frame (body E for earth) associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: LinVelEIMU = 0.0_ReKi !< Linear velocity of the nacelle IMU (point IMU) in the inertia frame [-] + REAL(ReKi) , DIMENSION(1:3) :: LinVelEZ = 0.0_ReKi !< Linear velocity of platform reference (point Z) in the inertia frame [-] + REAL(ReKi) , DIMENSION(1:3) :: LinVelEO = 0.0_ReKi !< Linear velocity of the base plate (point O) in the inertia frame (body E for earth) [-] + REAL(ReKi) , DIMENSION(1:3) :: LinVelEJ = 0.0_ReKi !< Linear velocity of the tail fin CM (point J) in the inertia frame (body E for earth) [-] + REAL(ReKi) , DIMENSION(1:3) :: FrcONcRtt = 0.0_ReKi !< Portion of the force at yaw bearing (point O) due to the nacelle, generator, and rotor associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: FrcPRott = 0.0_ReKi !< Portion of the force at the teeter pin (point P) due to the rotor associated with everything but the QD2T()'s [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: FrcS0Bt !< Portion of the force at the blade root (point S(0)) due to the blade associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: FrcT0Trbt !< Portion of the force at tower base (point T(0)) due to the turbine associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: FrcT0Trbt = 0.0_ReKi !< Portion of the force at tower base (point T(0)) due to the turbine associated with everything but the QD2T()'s [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: FSAero !< The aerodynamic force per unit span acting on a blade at point S [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: FSTipDrag !< The aerodynamic force at a blade tip resulting from tip drag [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: FTHydrot !< Portion of the hydrodynamic force (& all other external forces, including aerodynamic) per unit length acting on the tower at point T associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: FZHydrot !< Portion of the platform hydrodynamic force at the platform reference (point Z) associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: FZHydrot = 0.0_ReKi !< Portion of the platform hydrodynamic force at the platform reference (point Z) associated with everything but the QD2T()'s [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: MFHydrot !< Portion of the hydrodynamic moment (and all other external moments, including aerodynamic) per unit length acting on a tower element (body F) at point T associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: MomBNcRtt !< Portion of the moment at the base plate (body B) / yaw bearing (point O) due to the nacelle, generator, and rotor associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: MomBNcRtt = 0.0_ReKi !< Portion of the moment at the base plate (body B) / yaw bearing (point O) due to the nacelle, generator, and rotor associated with everything but the QD2T()'s [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: MomH0Bt !< Portion of the moment at the hub (body H) / blade root (point S(0)) due to the blade associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: MomLPRott !< Portion of the moment at the teeter pin (point P) on the low-speed shaft (body L) due to the rotor associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: MomNGnRtt !< Portion of the moment at the nacelle (body N) / selected point on rotor-furl axis (point V) due the structure that furls with the rotor, generator, and rotor associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: MomNTailt !< Portion of the moment at the nacelle (body N) / selected point on tail-furl axis (point W) due the tail associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: MomX0Trbt !< Portion of the moment at the platform (body X) / tower base (point T(0)) due to the turbine associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: MomLPRott = 0.0_ReKi !< Portion of the moment at the teeter pin (point P) on the low-speed shaft (body L) due to the rotor associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: MomNGnRtt = 0.0_ReKi !< Portion of the moment at the nacelle (body N) / selected point on rotor-furl axis (point V) due the structure that furls with the rotor, generator, and rotor associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: MomNTailt = 0.0_ReKi !< Portion of the moment at the nacelle (body N) / selected point on tail-furl axis (point W) due the tail associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: MomX0Trbt = 0.0_ReKi !< Portion of the moment at the platform (body X) / tower base (point T(0)) due to the turbine associated with everything but the QD2T()'s [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: MMAero !< The aerodynamic moment per unit span acting on a blade at point S [-] - REAL(ReKi) , DIMENSION(1:3) :: MXHydrot !< Portion of the platform hydrodynamic moment acting at the platform (body X) / platform reference (point Z) associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: MXHydrot = 0.0_ReKi !< Portion of the platform hydrodynamic moment acting at the platform (body X) / platform reference (point Z) associated with everything but the QD2T()'s [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PFrcONcRt !< Partial force at the yaw bearing (point O) due to the nacelle, generator, and rotor [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PFrcPRot !< Partial force at the teeter pin (point P) due to the rotor [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: PFrcS0B !< Partial force at the blade root (point S(0)) due to the blade [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PFrcT0Trb !< Partial force at the tower base (point T(0)) due to the turbine [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: PFTHydro !< Partial hydrodynamic force per unit length acting on the tower at point T [-] - REAL(ReKi) , DIMENSION(1:6,1:3) :: PFZHydro !< Partial platform hydrodynamic force at the platform reference (point Z) [-] + REAL(ReKi) , DIMENSION(1:6,1:3) :: PFZHydro = 0.0_ReKi !< Partial platform hydrodynamic force at the platform reference (point Z) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: PMFHydro !< Partial hydrodynamic moment per unit length acting on a tower element (body F) at point T [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PMomBNcRt !< Partial moment at the base plate (body B) / yaw bearing (point O) due the nacelle, generator, and rotor [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: PMomH0B !< Partial moment at the hub (body H) / blade root (point S(0)) due to the blade [-] @@ -474,20 +474,20 @@ MODULE ElastoDyn_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PMomNGnRt !< Partial moment at the nacelle (body N) / selected point on rotor-furl axis (point V) due the structure that furls with the rotor, generator, and rotor [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PMomNTail !< Partial moment at the nacelle (body N) / selected point on tail-furl axis (point W) due the tail [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PMomX0Trb !< Partial moment at the platform (body X) / tower base (point T(0)) due to the turbine [-] - REAL(ReKi) , DIMENSION(1:6,1:3) :: PMXHydro !< Partial platform hydrodynamic moment at the platform (body X) / platform reference (point Z) [-] - REAL(R8Ki) :: TeetAng !< Current teeter angle = QT(DOF_Teet) for 2-blader or 0 for 3-blader (this is used in place of QT(DOF_Teet) throughout RtHS() [-] - REAL(ReKi) , DIMENSION(1:3) :: FrcVGnRtt !< Portion of the force at the rotor-furl axis (point V) due to the structure that furls with the rotor, generator, and rotor associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: FrcWTailt !< Portion of the force at the tail-furl axis (point W) due to the tail associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: FrcZAllt !< Portion of the force at platform reference (point Z) due to everything associated with everything but the QD2T()'s [-] - REAL(ReKi) , DIMENSION(1:3) :: MomXAllt !< Portion of the moment at the platform (body X) / platform reference (point Z) due to everything associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:6,1:3) :: PMXHydro = 0.0_ReKi !< Partial platform hydrodynamic moment at the platform (body X) / platform reference (point Z) [-] + REAL(R8Ki) :: TeetAng = 0.0_R8Ki !< Current teeter angle = QT(DOF_Teet) for 2-blader or 0 for 3-blader (this is used in place of QT(DOF_Teet) throughout RtHS() [-] + REAL(ReKi) , DIMENSION(1:3) :: FrcVGnRtt = 0.0_ReKi !< Portion of the force at the rotor-furl axis (point V) due to the structure that furls with the rotor, generator, and rotor associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: FrcWTailt = 0.0_ReKi !< Portion of the force at the tail-furl axis (point W) due to the tail associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: FrcZAllt = 0.0_ReKi !< Portion of the force at platform reference (point Z) due to everything associated with everything but the QD2T()'s [-] + REAL(ReKi) , DIMENSION(1:3) :: MomXAllt = 0.0_ReKi !< Portion of the moment at the platform (body X) / platform reference (point Z) due to everything associated with everything but the QD2T()'s [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PFrcVGnRt !< Partial force at the rotor-furl axis (point V) due to the structure that furls with the rotor, generator, and rotor [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PFrcWTail !< Partial force at the tail-furl axis (point W) due to the tail [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PFrcZAll !< Partial force at the platform reference (point Z) due to everything [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PMomXAll !< Partial moment at the platform (body X) / platform reference (point Z) due to the everything [-] - REAL(ReKi) :: TeetMom !< The total moment supplied by the stop, spring, and damper of the teeter mechanism [-] - REAL(ReKi) :: TFrlMom !< The total tail-furl spring and damper moment [-] - REAL(ReKi) :: RFrlMom !< The total rotor-furl spring and damper moment [-] - REAL(ReKi) :: GBoxEffFac !< The factor used to apply the gearbox efficiency effects to the equation associated with the generator DOF [-] + REAL(ReKi) :: TeetMom = 0.0_ReKi !< The total moment supplied by the stop, spring, and damper of the teeter mechanism [-] + REAL(ReKi) :: TFrlMom = 0.0_ReKi !< The total tail-furl spring and damper moment [-] + REAL(ReKi) :: RFrlMom = 0.0_ReKi !< The total rotor-furl spring and damper moment [-] + REAL(ReKi) :: GBoxEffFac = 0.0_ReKi !< The factor used to apply the gearbox efficiency effects to the equation associated with the generator DOF [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: rSAerCen !< aerodynamic pitching moment arm (i.e., the position vector from point S on the blade to the aerodynamic center of the element) [-] END TYPE ED_RtHndSide ! ======================= @@ -499,23 +499,23 @@ MODULE ElastoDyn_Types ! ======================= ! ========= ED_DiscreteStateType ======= TYPE, PUBLIC :: ED_DiscreteStateType - REAL(ReKi) :: DummyDiscState !< Remove this variable if you have discrete states [-] + REAL(ReKi) :: DummyDiscState = 0.0_ReKi !< Remove this variable if you have discrete states [-] END TYPE ED_DiscreteStateType ! ======================= ! ========= ED_ConstraintStateType ======= TYPE, PUBLIC :: ED_ConstraintStateType - REAL(ReKi) :: DummyConstrState !< Remove this variable if you have constraint states [-] + REAL(ReKi) :: DummyConstrState = 0.0_ReKi !< Remove this variable if you have constraint states [-] END TYPE ED_ConstraintStateType ! ======================= ! ========= ED_OtherStateType ======= TYPE, PUBLIC :: ED_OtherStateType - INTEGER(IntKi) :: n !< tracks time step for which OtherState was updated [-] + INTEGER(IntKi) :: n = 0_IntKi !< tracks time step for which OtherState was updated [-] TYPE(ED_ContinuousStateType) , DIMENSION(1:ED_NMX) :: xdot !< previous state deriv for multi-step [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IC !< Array which stores pointers to predictor-corrector results [-] - REAL(ReKi) :: HSSBrTrq !< HSSBrTrq from update states; a hack to get this working with a single integrator [-] - REAL(ReKi) :: HSSBrTrqC !< Commanded HSS brake torque (adjusted for sign) [N-m] - INTEGER(IntKi) :: SgnPrvLSTQ !< The sign of the low-speed shaft torque from the previous call to RtHS(). This is calculated at the end of RtHS(). NOTE: The low-speed shaft torque is assumed to be positive at the beginning of the run! [-] - INTEGER(IntKi) , DIMENSION(1:ED_NMX) :: SgnLSTQ !< history of sign of LSTQ [-] + REAL(ReKi) :: HSSBrTrq = 0.0_ReKi !< HSSBrTrq from update states; a hack to get this working with a single integrator [-] + REAL(ReKi) :: HSSBrTrqC = 0.0_ReKi !< Commanded HSS brake torque (adjusted for sign) [N-m] + INTEGER(IntKi) :: SgnPrvLSTQ = 0_IntKi !< The sign of the low-speed shaft torque from the previous call to RtHS(). This is calculated at the end of RtHS(). NOTE: The low-speed shaft torque is assumed to be positive at the beginning of the run! [-] + INTEGER(IntKi) , DIMENSION(1:ED_NMX) :: SgnLSTQ = 0_IntKi !< history of sign of LSTQ [-] END TYPE ED_OtherStateType ! ======================= ! ========= ED_MiscVarType ======= @@ -529,147 +529,147 @@ MODULE ElastoDyn_Types INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: AugMat_pivot !< Pivot column for AugMat in LAPACK factorization [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: OgnlGeAzRo !< Original DOF_GeAz row in AugMat [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: QD2T !< Solution (acceleration) vector; the first time derivative of QDT [-] - LOGICAL :: IgnoreMod !< whether to ignore the modulo in ED outputs (necessary for linearization perturbations) [-] + LOGICAL :: IgnoreMod = .false. !< whether to ignore the modulo in ED outputs (necessary for linearization perturbations) [-] END TYPE ED_MiscVarType ! ======================= ! ========= ED_ParameterType ======= TYPE, PUBLIC :: ED_ParameterType - REAL(DbKi) :: DT !< Time step for continuous state integration & discrete state update [seconds] - REAL(DbKi) :: DT24 !< =DT/24 (used in loose coupling) [seconds] - INTEGER(IntKi) :: BldNodes !< Number of blade nodes used in the analysis [-] - INTEGER(IntKi) :: TipNode !< Index of the additional node located at the blade tip = BldNodes + 1 [-] - INTEGER(IntKi) :: NDOF !< Number of total degrees of freedom (DOFs) [-] - REAL(R8Ki) :: TwoPiNB !< Two pi divided by the number of blades [radians] - INTEGER(IntKi) :: NAug !< Dimension of augmented solution matrix [-] - INTEGER(IntKi) :: NPH !< Number of DOFs that contribute to the angular velocity of the hub (body H) in the inertia frame [-] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for continuous state integration & discrete state update [seconds] + REAL(DbKi) :: DT24 = 0.0_R8Ki !< =DT/24 (used in loose coupling) [seconds] + INTEGER(IntKi) :: BldNodes = 0_IntKi !< Number of blade nodes used in the analysis [-] + INTEGER(IntKi) :: TipNode = 0_IntKi !< Index of the additional node located at the blade tip = BldNodes + 1 [-] + INTEGER(IntKi) :: NDOF = 0_IntKi !< Number of total degrees of freedom (DOFs) [-] + REAL(R8Ki) :: TwoPiNB = 0.0_R8Ki !< Two pi divided by the number of blades [radians] + INTEGER(IntKi) :: NAug = 0_IntKi !< Dimension of augmented solution matrix [-] + INTEGER(IntKi) :: NPH = 0_IntKi !< Number of DOFs that contribute to the angular velocity of the hub (body H) in the inertia frame [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: PH !< Array of DOF indices (pointers) that contribute to the angular velocity of the hub (body H) in the inertia frame [-] - INTEGER(IntKi) :: NPM !< Number of DOFs that contribute to the angular velocity of the blade elements (body M) in the inertia frame [-] + INTEGER(IntKi) :: NPM = 0_IntKi !< Number of DOFs that contribute to the angular velocity of the blade elements (body M) in the inertia frame [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: PM !< Array of DOF indices (pointers) that contribute to the angular velocity of the blade elements (body M) in the inertia frame [-] LOGICAL , DIMENSION(:), ALLOCATABLE :: DOF_Flag !< Array which stores values of the feature flags for each DOF [-] CHARACTER(99) , DIMENSION(:), ALLOCATABLE :: DOF_Desc !< Array which stores descriptions of each DOF [-] TYPE(ED_ActiveDOFs) :: DOFs !< Active degrees of freedom in the model [-] INTEGER(IntKi) :: NumOuts = 0 !< Number of parameters in the output list (number of outputs requested) [-] - CHARACTER(20) :: OutFmt !< Output format for tabular data [-] + CHARACTER(20) :: OutFmt = '' !< Output format for tabular data [-] INTEGER(IntKi) :: NBlGages = 0 !< Number of blade strain gages [-] INTEGER(IntKi) :: NTwGages = 0 !< Number of tower strain gages [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] - CHARACTER(1) :: Delim !< Column delimiter for output text files [-] - REAL(ReKi) :: AvgNrmTpRd !< Average tip radius normal to the shaft [meters] - REAL(R8Ki) :: AzimB1Up !< Azimuth value to use for I/O when blade 1 points up [radians] + CHARACTER(1) :: Delim = '' !< Column delimiter for output text files [-] + REAL(ReKi) :: AvgNrmTpRd = 0.0_ReKi !< Average tip radius normal to the shaft [meters] + REAL(R8Ki) :: AzimB1Up = 0.0_R8Ki !< Azimuth value to use for I/O when blade 1 points up [radians] REAL(R8Ki) :: CosDel3 = 1.0 !< Cosine of the Delta-3 angle for teetering rotors [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: CosPreC !< Cosines of the precone angles [-] - REAL(R8Ki) :: CRFrlSkew !< Cosine of the rotor-furl axis skew angle [-] - REAL(R8Ki) :: CRFrlSkw2 !< Cosine-squared of the rotor-furl axis skew angle [-] - REAL(R8Ki) :: CRFrlTilt !< Cosine of the rotor-furl axis tilt angle [-] - REAL(R8Ki) :: CRFrlTlt2 !< Cosine-squared of the rotor-furl axis tilt angle [-] - REAL(R8Ki) :: CShftSkew !< Cosine of the shaft skew angle [-] - REAL(R8Ki) :: CShftTilt !< Cosine of the shaft tilt angle [-] - REAL(R8Ki) :: CSRFrlSkw !< Cosine*Sine of the rotor-furl axis skew angle [-] - REAL(R8Ki) :: CSRFrlTlt !< Cosine*Sine of the rotor-furl axis tilt angle [-] - REAL(R8Ki) :: CSTFrlSkw !< Cosine*Sine of the tail-furl axis skew angle [-] - REAL(R8Ki) :: CSTFrlTlt !< Cosine*Sine of the tail-furl axis tilt angle [-] - REAL(R8Ki) :: CTFrlSkew !< Cosine of the tail-furl axis skew angle [-] - REAL(R8Ki) :: CTFrlSkw2 !< Cosine-squared of the tail-furl axis skew angle [-] - REAL(R8Ki) :: CTFrlTilt !< Cosine of the tail-furl axis tilt angle [-] - REAL(R8Ki) :: CTFrlTlt2 !< Cosine-squared of the tail-furl axis tilt angle [-] - REAL(ReKi) :: HubHt !< Hub-height as computed using FAST inputs [= TowerHt + Twr2Shft + OverHang*SIN( ShftTilt ) ] (was FASTHH) [-] - REAL(ReKi) :: HubCM !< Distance from rotor apex to hub mass [-] - REAL(ReKi) :: HubRad !< Preconed hub radius [-] - REAL(ReKi) :: NacCMxn !< Downwind distance from tower-top to nacelle CM [-] - REAL(ReKi) :: NacCMyn !< Lateral distance from tower-top to nacelle CM [-] - REAL(ReKi) :: NacCMzn !< Vertical distance from tower-top to nacelle CM [-] - REAL(ReKi) :: OverHang !< Distance from yaw axis to rotor apex or teeter pin [-] - REAL(ReKi) :: ProjArea !< Swept area of the rotor projected onto the rotor plane (the plane normal to the low-speed shaft) [-] - REAL(ReKi) :: PtfmRefzt !< Vertical distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform reference point [-] - REAL(ReKi) :: RefTwrHt !< Vertical distance between FAST's undisplaced tower height (variable TowerHt) and FAST's inertia frame reference point (variable PtfmRef); that is, RefTwrHt = TowerHt - PtfmRefzt [-] - REAL(ReKi) , DIMENSION(1:3) :: RFrlPnt_n !< Vector from tower-top to arbitrary point on rotor-furl axis [-] - REAL(ReKi) :: rVDxn !< xn-component of position vector Rvd [-] - REAL(ReKi) :: rVDyn !< yn-component of position vector rVD [-] - REAL(ReKi) :: rVDzn !< zn-component of position vector rVD [-] - REAL(ReKi) :: rVIMUxn !< xn-component of position vector rVIMU [-] - REAL(ReKi) :: rVIMUyn !< yn-component of position vector rVIMU [-] - REAL(ReKi) :: rVIMUzn !< zn-component of position vector rVIMU [-] - REAL(ReKi) :: rVPxn !< xn-component of position vector rVP [-] - REAL(ReKi) :: rVPyn !< yn-component of position vector rVP [-] - REAL(ReKi) :: rVPzn !< zn-component of position vector rVP [-] - REAL(ReKi) :: rWIxn !< xn-component of position vector rWI [-] - REAL(ReKi) :: rWIyn !< yn-component of position vector rWI [-] - REAL(ReKi) :: rWIzn !< zn-component of position vector rWI [-] - REAL(ReKi) :: rWJxn !< xn-component of position vector rWJ [-] - REAL(ReKi) :: rWJyn !< yn-component of position vector rWJ [-] - REAL(ReKi) :: rWJzn !< zn-component of position vector rWJ [-] - REAL(ReKi) :: rZT0zt !< zt-component of position vector rZT0 [-] - REAL(ReKi) :: rZYzt !< zt-component of position vector rZY [-] - REAL(R8Ki) :: SinDel3 !< Sine of the Delta-3 angle for teetering rotors [-] + REAL(R8Ki) :: CRFrlSkew = 0.0_R8Ki !< Cosine of the rotor-furl axis skew angle [-] + REAL(R8Ki) :: CRFrlSkw2 = 0.0_R8Ki !< Cosine-squared of the rotor-furl axis skew angle [-] + REAL(R8Ki) :: CRFrlTilt = 0.0_R8Ki !< Cosine of the rotor-furl axis tilt angle [-] + REAL(R8Ki) :: CRFrlTlt2 = 0.0_R8Ki !< Cosine-squared of the rotor-furl axis tilt angle [-] + REAL(R8Ki) :: CShftSkew = 0.0_R8Ki !< Cosine of the shaft skew angle [-] + REAL(R8Ki) :: CShftTilt = 0.0_R8Ki !< Cosine of the shaft tilt angle [-] + REAL(R8Ki) :: CSRFrlSkw = 0.0_R8Ki !< Cosine*Sine of the rotor-furl axis skew angle [-] + REAL(R8Ki) :: CSRFrlTlt = 0.0_R8Ki !< Cosine*Sine of the rotor-furl axis tilt angle [-] + REAL(R8Ki) :: CSTFrlSkw = 0.0_R8Ki !< Cosine*Sine of the tail-furl axis skew angle [-] + REAL(R8Ki) :: CSTFrlTlt = 0.0_R8Ki !< Cosine*Sine of the tail-furl axis tilt angle [-] + REAL(R8Ki) :: CTFrlSkew = 0.0_R8Ki !< Cosine of the tail-furl axis skew angle [-] + REAL(R8Ki) :: CTFrlSkw2 = 0.0_R8Ki !< Cosine-squared of the tail-furl axis skew angle [-] + REAL(R8Ki) :: CTFrlTilt = 0.0_R8Ki !< Cosine of the tail-furl axis tilt angle [-] + REAL(R8Ki) :: CTFrlTlt2 = 0.0_R8Ki !< Cosine-squared of the tail-furl axis tilt angle [-] + REAL(ReKi) :: HubHt = 0.0_ReKi !< Hub-height as computed using FAST inputs [= TowerHt + Twr2Shft + OverHang*SIN( ShftTilt ) ] (was FASTHH) [-] + REAL(ReKi) :: HubCM = 0.0_ReKi !< Distance from rotor apex to hub mass [-] + REAL(ReKi) :: HubRad = 0.0_ReKi !< Preconed hub radius [-] + REAL(ReKi) :: NacCMxn = 0.0_ReKi !< Downwind distance from tower-top to nacelle CM [-] + REAL(ReKi) :: NacCMyn = 0.0_ReKi !< Lateral distance from tower-top to nacelle CM [-] + REAL(ReKi) :: NacCMzn = 0.0_ReKi !< Vertical distance from tower-top to nacelle CM [-] + REAL(ReKi) :: OverHang = 0.0_ReKi !< Distance from yaw axis to rotor apex or teeter pin [-] + REAL(ReKi) :: ProjArea = 0.0_ReKi !< Swept area of the rotor projected onto the rotor plane (the plane normal to the low-speed shaft) [-] + REAL(ReKi) :: PtfmRefzt = 0.0_ReKi !< Vertical distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform reference point [-] + REAL(ReKi) :: RefTwrHt = 0.0_ReKi !< Vertical distance between FAST's undisplaced tower height (variable TowerHt) and FAST's inertia frame reference point (variable PtfmRef); that is, RefTwrHt = TowerHt - PtfmRefzt [-] + REAL(ReKi) , DIMENSION(1:3) :: RFrlPnt_n = 0.0_ReKi !< Vector from tower-top to arbitrary point on rotor-furl axis [-] + REAL(ReKi) :: rVDxn = 0.0_ReKi !< xn-component of position vector Rvd [-] + REAL(ReKi) :: rVDyn = 0.0_ReKi !< yn-component of position vector rVD [-] + REAL(ReKi) :: rVDzn = 0.0_ReKi !< zn-component of position vector rVD [-] + REAL(ReKi) :: rVIMUxn = 0.0_ReKi !< xn-component of position vector rVIMU [-] + REAL(ReKi) :: rVIMUyn = 0.0_ReKi !< yn-component of position vector rVIMU [-] + REAL(ReKi) :: rVIMUzn = 0.0_ReKi !< zn-component of position vector rVIMU [-] + REAL(ReKi) :: rVPxn = 0.0_ReKi !< xn-component of position vector rVP [-] + REAL(ReKi) :: rVPyn = 0.0_ReKi !< yn-component of position vector rVP [-] + REAL(ReKi) :: rVPzn = 0.0_ReKi !< zn-component of position vector rVP [-] + REAL(ReKi) :: rWIxn = 0.0_ReKi !< xn-component of position vector rWI [-] + REAL(ReKi) :: rWIyn = 0.0_ReKi !< yn-component of position vector rWI [-] + REAL(ReKi) :: rWIzn = 0.0_ReKi !< zn-component of position vector rWI [-] + REAL(ReKi) :: rWJxn = 0.0_ReKi !< xn-component of position vector rWJ [-] + REAL(ReKi) :: rWJyn = 0.0_ReKi !< yn-component of position vector rWJ [-] + REAL(ReKi) :: rWJzn = 0.0_ReKi !< zn-component of position vector rWJ [-] + REAL(ReKi) :: rZT0zt = 0.0_ReKi !< zt-component of position vector rZT0 [-] + REAL(ReKi) :: rZYzt = 0.0_ReKi !< zt-component of position vector rZY [-] + REAL(R8Ki) :: SinDel3 = 0.0_R8Ki !< Sine of the Delta-3 angle for teetering rotors [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: SinPreC !< Sines of the precone angles [-] - REAL(R8Ki) :: SRFrlSkew !< Sine of the rotor-furl axis skew angle [-] - REAL(R8Ki) :: SRFrlSkw2 !< Sine-squared of the rotor-furl axis skew angle [-] - REAL(R8Ki) :: SRFrlTilt !< Sine of the rotor-furl axis tilt angle [-] - REAL(R8Ki) :: SRFrlTlt2 !< Sine-squared of the rotor-furl axis tilt angle [-] - REAL(R8Ki) :: SShftSkew !< Sine of the shaft skew angle [-] - REAL(R8Ki) :: SShftTilt !< Sine of the shaft tilt angle [-] - REAL(R8Ki) :: STFrlSkew !< Sine of the tail-furl axis skew angle [-] - REAL(R8Ki) :: STFrlSkw2 !< Sine-squared of the tail-furl axis skew angle [-] - REAL(R8Ki) :: STFrlTilt !< Sine of the tail-furl axis tilt angle [-] - REAL(R8Ki) :: STFrlTlt2 !< Sine-squared of the tail-furl axis tilt angle [-] - REAL(ReKi) , DIMENSION(1:3) :: TFrlPnt_n !< Vector from tower-top to arbitrary point on tail-furl axis [-] - REAL(ReKi) :: TipRad !< Preconed blade-tip radius [-] - REAL(ReKi) :: TowerHt !< Height of tower relative to ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] [meters] - REAL(ReKi) :: TowerBsHt !< Height of tower base relative to ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] [meters] - REAL(ReKi) :: UndSling !< Undersling length [-] - INTEGER(IntKi) :: NumBl !< Number of turbine blades [-] + REAL(R8Ki) :: SRFrlSkew = 0.0_R8Ki !< Sine of the rotor-furl axis skew angle [-] + REAL(R8Ki) :: SRFrlSkw2 = 0.0_R8Ki !< Sine-squared of the rotor-furl axis skew angle [-] + REAL(R8Ki) :: SRFrlTilt = 0.0_R8Ki !< Sine of the rotor-furl axis tilt angle [-] + REAL(R8Ki) :: SRFrlTlt2 = 0.0_R8Ki !< Sine-squared of the rotor-furl axis tilt angle [-] + REAL(R8Ki) :: SShftSkew = 0.0_R8Ki !< Sine of the shaft skew angle [-] + REAL(R8Ki) :: SShftTilt = 0.0_R8Ki !< Sine of the shaft tilt angle [-] + REAL(R8Ki) :: STFrlSkew = 0.0_R8Ki !< Sine of the tail-furl axis skew angle [-] + REAL(R8Ki) :: STFrlSkw2 = 0.0_R8Ki !< Sine-squared of the tail-furl axis skew angle [-] + REAL(R8Ki) :: STFrlTilt = 0.0_R8Ki !< Sine of the tail-furl axis tilt angle [-] + REAL(R8Ki) :: STFrlTlt2 = 0.0_R8Ki !< Sine-squared of the tail-furl axis tilt angle [-] + REAL(ReKi) , DIMENSION(1:3) :: TFrlPnt_n = 0.0_ReKi !< Vector from tower-top to arbitrary point on tail-furl axis [-] + REAL(ReKi) :: TipRad = 0.0_ReKi !< Preconed blade-tip radius [-] + REAL(ReKi) :: TowerHt = 0.0_ReKi !< Height of tower relative to ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] [meters] + REAL(ReKi) :: TowerBsHt = 0.0_ReKi !< Height of tower base relative to ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] [meters] + REAL(ReKi) :: UndSling = 0.0_ReKi !< Undersling length [-] + INTEGER(IntKi) :: NumBl = 0_IntKi !< Number of turbine blades [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AxRedTFA !< The axial-reduction terms for the fore-aft tower mode shapes [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AxRedTSS !< The axial-reduction terms for the side-to-side tower mode shapes [-] - REAL(ReKi) , DIMENSION(1:2,1:2) :: CTFA !< Generalized damping of tower in fore-aft direction [-] - REAL(ReKi) , DIMENSION(1:2,1:2) :: CTSS !< Generalized damping of tower in side-to-side direction [-] + REAL(ReKi) , DIMENSION(1:2,1:2) :: CTFA = 0.0_ReKi !< Generalized damping of tower in fore-aft direction [-] + REAL(ReKi) , DIMENSION(1:2,1:2) :: CTSS = 0.0_ReKi !< Generalized damping of tower in side-to-side direction [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: DHNodes !< Length of variable-length tower elements [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: HNodes !< Location of variable-spaced tower nodes (relative to the tower rigid base height [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: HNodesNorm !< Normalized location of variable-spaced tower nodes (relative to the tower rigid base height) (0 < HNodesNorm(:) < 1) [-] - REAL(ReKi) , DIMENSION(1:2,1:2) :: KTFA !< Generalized stiffness of tower in fore-aft direction [-] - REAL(ReKi) , DIMENSION(1:2,1:2) :: KTSS !< Generalized stiffness of tower in side-to-side direction [-] + REAL(ReKi) , DIMENSION(1:2,1:2) :: KTFA = 0.0_ReKi !< Generalized stiffness of tower in fore-aft direction [-] + REAL(ReKi) , DIMENSION(1:2,1:2) :: KTSS = 0.0_ReKi !< Generalized stiffness of tower in side-to-side direction [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: MassT !< Interpolated lineal mass density of tower [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: StiffTSS !< Interpolated side-side tower stiffness [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: TwrFASF !< Tower fore-aft shape functions [-] - REAL(ReKi) :: TwrFlexL !< Height / length of the flexible portion of the tower [-] + REAL(ReKi) :: TwrFlexL = 0.0_ReKi !< Height / length of the flexible portion of the tower [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: TwrSSSF !< Tower side-to-side shape functions [-] - INTEGER(IntKi) :: TTopNode !< Index of the additional node located at the tower-top = TwrNodes + 1 [-] - INTEGER(IntKi) :: TwrNodes !< Number of tower nodes used in the analysis [-] - INTEGER(IntKi) :: MHK !< MHK turbine type switch [-] + INTEGER(IntKi) :: TTopNode = 0_IntKi !< Index of the additional node located at the tower-top = TwrNodes + 1 [-] + INTEGER(IntKi) :: TwrNodes = 0_IntKi !< Number of tower nodes used in the analysis [-] + INTEGER(IntKi) :: MHK = 0_IntKi !< MHK turbine type switch [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: StiffTFA !< Interpolated fore-aft tower stiffness [-] - REAL(ReKi) :: AtfaIner !< Inertia of tail boom about the tail-furl axis whose origin is the tail boom center of mass [-] + REAL(ReKi) :: AtfaIner = 0.0_ReKi !< Inertia of tail boom about the tail-furl axis whose origin is the tail boom center of mass [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BldCG !< Blade center of mass wrt the blade root [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BldMass !< Blade masses [-] - REAL(ReKi) :: BoomMass !< Tail boom mass [-] + REAL(ReKi) :: BoomMass = 0.0_ReKi !< Tail boom mass [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FirstMom !< First mass moment of inertia of blades wrt the root [-] - REAL(ReKi) :: GenIner !< Generator inertia about HSS [-] - REAL(ReKi) :: Hubg1Iner !< Inertia of hub about g1-axis (rotor centerline) [-] - REAL(ReKi) :: Hubg2Iner !< Inertia of hub about g2-axis (transverse to the cyclinder and passing through its c.g.) [-] - REAL(ReKi) :: HubMass !< Hub mass [-] - REAL(ReKi) :: Nacd2Iner !< Inertia of nacelle about the d2-axis whose origin is the nacelle center of mass [-] - REAL(ReKi) :: NacMass !< Nacelle mass [-] - REAL(ReKi) :: PtfmMass !< Platform mass [-] - REAL(ReKi) :: PtfmPIner !< Platform inertia for pitch tilt rotation about the platform CM. [-] - REAL(ReKi) :: PtfmRIner !< Platform inertia for roll tilt rotation about the platform CM. [-] - REAL(ReKi) :: PtfmYIner !< Platform inertia for yaw rotation about the platform CM. [-] - REAL(ReKi) :: RFrlMass !< Rotor-furl mass [-] - REAL(ReKi) :: RotIner !< Inertia of rotor about its centerline [-] - REAL(ReKi) :: RotMass !< Rotor mass (blades, tips, and hub) [-] - REAL(ReKi) :: RrfaIner !< Inertia of structure that furls with the rotor (not including rotor) about the rotor-furl axis whose origin is the center of mass of the structure that furls with the rotor (not including rotor) [-] + REAL(ReKi) :: GenIner = 0.0_ReKi !< Generator inertia about HSS [-] + REAL(ReKi) :: Hubg1Iner = 0.0_ReKi !< Inertia of hub about g1-axis (rotor centerline) [-] + REAL(ReKi) :: Hubg2Iner = 0.0_ReKi !< Inertia of hub about g2-axis (transverse to the cyclinder and passing through its c.g.) [-] + REAL(ReKi) :: HubMass = 0.0_ReKi !< Hub mass [-] + REAL(ReKi) :: Nacd2Iner = 0.0_ReKi !< Inertia of nacelle about the d2-axis whose origin is the nacelle center of mass [-] + REAL(ReKi) :: NacMass = 0.0_ReKi !< Nacelle mass [-] + REAL(ReKi) :: PtfmMass = 0.0_ReKi !< Platform mass [-] + REAL(ReKi) :: PtfmPIner = 0.0_ReKi !< Platform inertia for pitch tilt rotation about the platform CM. [-] + REAL(ReKi) :: PtfmRIner = 0.0_ReKi !< Platform inertia for roll tilt rotation about the platform CM. [-] + REAL(ReKi) :: PtfmYIner = 0.0_ReKi !< Platform inertia for yaw rotation about the platform CM. [-] + REAL(ReKi) :: RFrlMass = 0.0_ReKi !< Rotor-furl mass [-] + REAL(ReKi) :: RotIner = 0.0_ReKi !< Inertia of rotor about its centerline [-] + REAL(ReKi) :: RotMass = 0.0_ReKi !< Rotor mass (blades, tips, and hub) [-] + REAL(ReKi) :: RrfaIner = 0.0_ReKi !< Inertia of structure that furls with the rotor (not including rotor) about the rotor-furl axis whose origin is the center of mass of the structure that furls with the rotor (not including rotor) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SecondMom !< Second mass moment of inertia of blades wrt the root [-] - REAL(ReKi) :: TFinMass !< Tail fin mass [-] - REAL(ReKi) :: TFrlIner !< Tail boom inertia about tail-furl axis [-] + REAL(ReKi) :: TFinMass = 0.0_ReKi !< Tail fin mass [-] + REAL(ReKi) :: TFrlIner = 0.0_ReKi !< Tail boom inertia about tail-furl axis [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TipMass !< Tip-brake masses [-] - REAL(ReKi) :: TurbMass !< Mass of turbine (tower + rotor + nacelle) [-] - REAL(ReKi) :: TwrMass !< Mass of tower [-] - REAL(ReKi) :: TwrTpMass !< Tower-top mass (rotor + nacelle) [-] - REAL(ReKi) :: YawBrMass !< Yaw bearing mass [-] - REAL(ReKi) :: Gravity !< Gravitational acceleration [m/s^2] + REAL(ReKi) :: TurbMass = 0.0_ReKi !< Mass of turbine (tower + rotor + nacelle) [-] + REAL(ReKi) :: TwrMass = 0.0_ReKi !< Mass of tower [-] + REAL(ReKi) :: TwrTpMass = 0.0_ReKi !< Tower-top mass (rotor + nacelle) [-] + REAL(ReKi) :: YawBrMass = 0.0_ReKi !< Yaw bearing mass [-] + REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravitational acceleration [m/s^2] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PitchAxis !< Pitch axis for analysis nodes [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AeroTwst !< Aerodynamic twist of the blade at the analysis nodes [-] REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: AxRedBld !< The axial-reduction terms of the blade shape function [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BldEDamp !< Blade edgewise damping coefficients [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BldFDamp !< Blade flapwise damping coefficients [-] - REAL(ReKi) :: BldFlexL !< Flexible blade length [-] + REAL(ReKi) :: BldFlexL = 0.0_ReKi !< Flexible blade length [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: CAeroTwst !< Cosine of the aerodynamic twist of the blade at the analysis nodes [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: CBE !< Generalized edgewise damping of the blades [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: CBF !< Generalized flapwise damping of the blades [-] @@ -695,63 +695,63 @@ MODULE ElastoDyn_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BldEdgSh !< Blade-edge-mode shape coefficients [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: FreqBE !< Blade edgewise natural frequencies (both w/ and w/o centrifugal stiffening) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: FreqBF !< Blade flapwise natural frequencies (both w/ and w/o centrifugal stiffening) [-] - REAL(ReKi) , DIMENSION(1:2,1:2) :: FreqTFA !< Computed fore-aft tower natural frequencies [-] - REAL(ReKi) , DIMENSION(1:2,1:2) :: FreqTSS !< Computed side-to-side tower natural frequencies [-] - REAL(ReKi) :: TeetCDmp !< Rotor-teeter rate-independent Coulomb-damping [-] - REAL(ReKi) :: TeetDmp !< Rotor-teeter damping constant [-] - REAL(ReKi) :: TeetDmpP !< Rotor-teeter damper position [-] - REAL(ReKi) :: TeetHSSp !< Rotor-teeter hard-stop linear-spring constant [-] - REAL(ReKi) :: TeetHStP !< Rotor-teeter hard-stop position [-] - REAL(ReKi) :: TeetSSSp !< Rotor-teeter soft-stop linear-spring constant [-] - REAL(ReKi) :: TeetSStP !< Rotor-teeter soft-stop position [-] - INTEGER(IntKi) :: TeetMod !< Rotor-teeter spring/damper model switch [-] - REAL(ReKi) :: TFrlDmp !< Tail-furl damping constant [-] - REAL(ReKi) :: TFrlDSDmp !< Tail-furl down-stop damping constant [-] - REAL(ReKi) :: TFrlDSDP !< Tail-furl down-stop damper position [-] - REAL(ReKi) :: TFrlDSSP !< Tail-furl down-stop spring position [-] - REAL(ReKi) :: TFrlDSSpr !< Tail-furl down-stop spring constant [-] - REAL(ReKi) :: TFrlSpr !< Tail-furl spring constant [-] - REAL(ReKi) :: TFrlUSDmp !< Tail-furl up-stop damping constant [-] - REAL(ReKi) :: TFrlUSDP !< Tail-furl up-stop damper position [-] - REAL(ReKi) :: TFrlUSSP !< Tail-furl up-stop spring position [-] - REAL(ReKi) :: TFrlUSSpr !< Tail-furl up-stop spring constant [-] - INTEGER(IntKi) :: TFrlMod !< Tail-furl spring/damper model switch [-] - REAL(ReKi) :: RFrlDmp !< Rotor-furl damping constant [-] - REAL(ReKi) :: RFrlDSDmp !< Rotor-furl down-stop damping constant [-] - REAL(ReKi) :: RFrlDSDP !< Rotor-furl down-stop damper position [-] - REAL(ReKi) :: RFrlDSSP !< Rotor-furl down-stop spring position [-] - REAL(ReKi) :: RFrlDSSpr !< Rotor-furl down-stop spring constant [-] - REAL(ReKi) :: RFrlSpr !< Rotor-furl spring constant [-] - REAL(ReKi) :: RFrlUSDmp !< Rotor-furl up-stop damping constant [-] - REAL(ReKi) :: RFrlUSDP !< Rotor-furl up-stop damper position [-] - REAL(ReKi) :: RFrlUSSP !< Rotor-furl up-stop spring position [-] - REAL(ReKi) :: RFrlUSSpr !< Rotor-furl up-stop spring constant [-] - INTEGER(IntKi) :: RFrlMod !< Rotor-furl spring/damper model switch [-] - REAL(ReKi) :: ShftGagL !< Distance from hub or teeter pin to shaft strain gages [-] - INTEGER(IntKi) , DIMENSION(1:9) :: BldGagNd !< Nodes closest to the blade strain gages [-] - INTEGER(IntKi) , DIMENSION(1:9) :: TwrGagNd !< Nodes closest to the tower strain gages [-] - REAL(DbKi) :: TStart !< Time to begin tabular output [-] - REAL(ReKi) :: DTTorDmp !< Drivetrain torsional damper [-] - REAL(ReKi) :: DTTorSpr !< Drivetrain torsional spring [-] - REAL(ReKi) :: GBRatio !< Gearbox ratio [-] - REAL(ReKi) :: GBoxEff !< Gearbox efficiency [-] - REAL(ReKi) :: RotSpeed !< Initial or fixed rotor speed [rad/s] - CHARACTER(1024) :: RootName !< RootName for writing output files [-] + REAL(ReKi) , DIMENSION(1:2,1:2) :: FreqTFA = 0.0_ReKi !< Computed fore-aft tower natural frequencies [-] + REAL(ReKi) , DIMENSION(1:2,1:2) :: FreqTSS = 0.0_ReKi !< Computed side-to-side tower natural frequencies [-] + REAL(ReKi) :: TeetCDmp = 0.0_ReKi !< Rotor-teeter rate-independent Coulomb-damping [-] + REAL(ReKi) :: TeetDmp = 0.0_ReKi !< Rotor-teeter damping constant [-] + REAL(ReKi) :: TeetDmpP = 0.0_ReKi !< Rotor-teeter damper position [-] + REAL(ReKi) :: TeetHSSp = 0.0_ReKi !< Rotor-teeter hard-stop linear-spring constant [-] + REAL(ReKi) :: TeetHStP = 0.0_ReKi !< Rotor-teeter hard-stop position [-] + REAL(ReKi) :: TeetSSSp = 0.0_ReKi !< Rotor-teeter soft-stop linear-spring constant [-] + REAL(ReKi) :: TeetSStP = 0.0_ReKi !< Rotor-teeter soft-stop position [-] + INTEGER(IntKi) :: TeetMod = 0_IntKi !< Rotor-teeter spring/damper model switch [-] + REAL(ReKi) :: TFrlDmp = 0.0_ReKi !< Tail-furl damping constant [-] + REAL(ReKi) :: TFrlDSDmp = 0.0_ReKi !< Tail-furl down-stop damping constant [-] + REAL(ReKi) :: TFrlDSDP = 0.0_ReKi !< Tail-furl down-stop damper position [-] + REAL(ReKi) :: TFrlDSSP = 0.0_ReKi !< Tail-furl down-stop spring position [-] + REAL(ReKi) :: TFrlDSSpr = 0.0_ReKi !< Tail-furl down-stop spring constant [-] + REAL(ReKi) :: TFrlSpr = 0.0_ReKi !< Tail-furl spring constant [-] + REAL(ReKi) :: TFrlUSDmp = 0.0_ReKi !< Tail-furl up-stop damping constant [-] + REAL(ReKi) :: TFrlUSDP = 0.0_ReKi !< Tail-furl up-stop damper position [-] + REAL(ReKi) :: TFrlUSSP = 0.0_ReKi !< Tail-furl up-stop spring position [-] + REAL(ReKi) :: TFrlUSSpr = 0.0_ReKi !< Tail-furl up-stop spring constant [-] + INTEGER(IntKi) :: TFrlMod = 0_IntKi !< Tail-furl spring/damper model switch [-] + REAL(ReKi) :: RFrlDmp = 0.0_ReKi !< Rotor-furl damping constant [-] + REAL(ReKi) :: RFrlDSDmp = 0.0_ReKi !< Rotor-furl down-stop damping constant [-] + REAL(ReKi) :: RFrlDSDP = 0.0_ReKi !< Rotor-furl down-stop damper position [-] + REAL(ReKi) :: RFrlDSSP = 0.0_ReKi !< Rotor-furl down-stop spring position [-] + REAL(ReKi) :: RFrlDSSpr = 0.0_ReKi !< Rotor-furl down-stop spring constant [-] + REAL(ReKi) :: RFrlSpr = 0.0_ReKi !< Rotor-furl spring constant [-] + REAL(ReKi) :: RFrlUSDmp = 0.0_ReKi !< Rotor-furl up-stop damping constant [-] + REAL(ReKi) :: RFrlUSDP = 0.0_ReKi !< Rotor-furl up-stop damper position [-] + REAL(ReKi) :: RFrlUSSP = 0.0_ReKi !< Rotor-furl up-stop spring position [-] + REAL(ReKi) :: RFrlUSSpr = 0.0_ReKi !< Rotor-furl up-stop spring constant [-] + INTEGER(IntKi) :: RFrlMod = 0_IntKi !< Rotor-furl spring/damper model switch [-] + REAL(ReKi) :: ShftGagL = 0.0_ReKi !< Distance from hub or teeter pin to shaft strain gages [-] + INTEGER(IntKi) , DIMENSION(1:9) :: BldGagNd = 0_IntKi !< Nodes closest to the blade strain gages [-] + INTEGER(IntKi) , DIMENSION(1:9) :: TwrGagNd = 0_IntKi !< Nodes closest to the tower strain gages [-] + REAL(DbKi) :: TStart = 0.0_R8Ki !< Time to begin tabular output [-] + REAL(ReKi) :: DTTorDmp = 0.0_ReKi !< Drivetrain torsional damper [-] + REAL(ReKi) :: DTTorSpr = 0.0_ReKi !< Drivetrain torsional spring [-] + REAL(ReKi) :: GBRatio = 0.0_ReKi !< Gearbox ratio [-] + REAL(ReKi) :: GBoxEff = 0.0_ReKi !< Gearbox efficiency [-] + REAL(ReKi) :: RotSpeed = 0.0_ReKi !< Initial or fixed rotor speed [rad/s] + CHARACTER(1024) :: RootName = '' !< RootName for writing output files [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BElmntMass !< Mass of the blade elements [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TElmntMass !< Mass of the tower elements [-] - INTEGER(IntKi) :: method !< Identifier for integration method (1 [RK4], 2 [AB4], or 3 [ABM4]) [-] - REAL(ReKi) :: PtfmCMxt !< Downwind distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform CM [meters] - REAL(ReKi) :: PtfmCMyt !< Lateral distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform CM [meters] - LOGICAL :: BD4Blades !< flag to determine if BeamDyn is computing blade loads (true) or ElastoDyn is (false) [-] - LOGICAL :: UseAD14 !< flag to determine if AeroDyn14 is being used. Will remove this later when we've replaced AD14. [-] - INTEGER(IntKi) :: BldNd_NumOuts !< Number of requested output channels per blade node (ED_AllBldNdOuts) [-] - INTEGER(IntKi) :: BldNd_TotNumOuts !< Total number of requested output channels of blade node information (BldNd_NumOuts * BldNd_BlOutNd * BldNd_BladesOut -- ED_AllBldNdOuts) [-] + INTEGER(IntKi) :: method = 0_IntKi !< Identifier for integration method (1 [RK4], 2 [AB4], or 3 [ABM4]) [-] + REAL(ReKi) :: PtfmCMxt = 0.0_ReKi !< Downwind distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform CM [meters] + REAL(ReKi) :: PtfmCMyt = 0.0_ReKi !< Lateral distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform CM [meters] + LOGICAL :: BD4Blades = .false. !< flag to determine if BeamDyn is computing blade loads (true) or ElastoDyn is (false) [-] + LOGICAL :: UseAD14 = .false. !< flag to determine if AeroDyn14 is being used. Will remove this later when we've replaced AD14. [-] + INTEGER(IntKi) :: BldNd_NumOuts = 0_IntKi !< Number of requested output channels per blade node (ED_AllBldNdOuts) [-] + INTEGER(IntKi) :: BldNd_TotNumOuts = 0_IntKi !< Total number of requested output channels of blade node information (BldNd_NumOuts * BldNd_BlOutNd * BldNd_BladesOut -- ED_AllBldNdOuts) [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: BldNd_OutParam !< Names and units (and other characteristics) of all requested output parameters [-] - INTEGER(IntKi) :: BldNd_BladesOut !< The blades to output (ED_AllBldNdOuts) [-] + INTEGER(IntKi) :: BldNd_BladesOut = 0_IntKi !< The blades to output (ED_AllBldNdOuts) [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: du !< vector that determines size of perturbation for u (inputs) [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: dx !< vector that determines size of perturbation for x (continuous states) [-] - INTEGER(IntKi) :: Jac_ny !< number of outputs in jacobian matrix [-] + INTEGER(IntKi) :: Jac_ny = 0_IntKi !< number of outputs in jacobian matrix [-] END TYPE ED_ParameterType ! ======================= ! ========= ED_InputType ======= @@ -763,11 +763,11 @@ MODULE ElastoDyn_Types TYPE(MeshType) :: NacelleLoads !< From ServoDyn/TMD: loads on the nacelle. [-] TYPE(MeshType) :: TFinCMLoads !< Aerodynamic forces and moments at the tail-fin center of mass point (point J) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: TwrAddedMass !< 6-by-6 added mass matrix of the tower elements, per unit length-bjj: place on a mesh [per unit length] - REAL(ReKi) , DIMENSION(1:6,1:6) :: PtfmAddedMass !< Platform added mass matrix [kg, kg-m, kg-m^2] + REAL(ReKi) , DIMENSION(1:6,1:6) :: PtfmAddedMass = 0.0_ReKi !< Platform added mass matrix [kg, kg-m, kg-m^2] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlPitchCom !< Commanded blade pitch angles [radians] - REAL(ReKi) :: YawMom !< Torque transmitted through the yaw bearing [N-m] - REAL(ReKi) :: GenTrq !< Electrical generator torque [N-m] - REAL(ReKi) :: HSSBrTrqC !< Commanded HSS brake torque [N-m] + REAL(ReKi) :: YawMom = 0.0_ReKi !< Torque transmitted through the yaw bearing [N-m] + REAL(ReKi) :: GenTrq = 0.0_ReKi !< Electrical generator torque [N-m] + REAL(ReKi) :: HSSBrTrqC = 0.0_ReKi !< Commanded HSS brake torque [N-m] END TYPE ED_InputType ! ======================= ! ========= ED_OutputType ======= @@ -785,32 +785,32 @@ MODULE ElastoDyn_Types TYPE(MeshType) :: TFinCMMotion !< For AeroDyn: motions of the tail find CM point (point J) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< Data to be written to an output file: see WriteOutputHdr for names of each variable [see WriteOutputUnt] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlPitch !< Current blade pitch angles [radians] - REAL(ReKi) :: Yaw !< Current nacelle yaw [radians] - REAL(ReKi) :: YawRate !< Current nacelle yaw rate [rad/s] - REAL(ReKi) :: LSS_Spd !< Low-speed shaft (LSS) speed at entrance to gearbox [rad/s] - REAL(ReKi) :: HSS_Spd !< High-speed shaft (HSS) speed [rad/s] - REAL(ReKi) :: RotSpeed !< Rotor azimuth angular speed [rad/s] - REAL(ReKi) :: TwrAccel !< Tower acceleration for tower feedback control (user routine only) [m/s^2] - REAL(ReKi) :: YawAngle !< Yaw angle to be used for yaw error calculations [radians] - REAL(ReKi) , DIMENSION(1:3) :: RootMyc !< Out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root for each of the blades (max 3) [N-m] - REAL(ReKi) :: YawBrTAxp !< Tower-top / yaw bearing fore-aft (translational) acceleration (absolute) [m/s^2] - REAL(ReKi) :: YawBrTAyp !< Tower-top / yaw bearing side-to-side (translational) acceleration (absolute) [m/s^2] - REAL(ReKi) :: LSSTipPxa !< Rotor azimuth angle (position) [radians] - REAL(ReKi) , DIMENSION(1:3) :: RootMxc !< In-plane moment (i.e., the moment caused by in-plane forces) at the blade root [N-m] - REAL(ReKi) :: LSSTipMxa !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] - REAL(ReKi) :: LSSTipMya !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] - REAL(ReKi) :: LSSTipMza !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] - REAL(ReKi) :: LSSTipMys !< Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] - REAL(ReKi) :: LSSTipMzs !< Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] - REAL(ReKi) :: YawBrMyn !< Rotating (with nacelle) tower-top / yaw bearing pitch moment [N-m] - REAL(ReKi) :: YawBrMzn !< Tower-top / yaw bearing yaw moment [N-m] - REAL(ReKi) :: NcIMURAxs !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] - REAL(ReKi) :: NcIMURAys !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] - REAL(ReKi) :: NcIMURAzs !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] - REAL(ReKi) :: RotPwr !< Rotor power (this is equivalent to the low-speed shaft power) [W] - REAL(ReKi) :: LSShftFxa !< Rotating low-speed shaft force x [N] - REAL(ReKi) :: LSShftFys !< Nonrotating low-speed shaft force y [N] - REAL(ReKi) :: LSShftFzs !< Nonrotating low-speed shaft force z [N] + REAL(ReKi) :: Yaw = 0.0_ReKi !< Current nacelle yaw [radians] + REAL(ReKi) :: YawRate = 0.0_ReKi !< Current nacelle yaw rate [rad/s] + REAL(ReKi) :: LSS_Spd = 0.0_ReKi !< Low-speed shaft (LSS) speed at entrance to gearbox [rad/s] + REAL(ReKi) :: HSS_Spd = 0.0_ReKi !< High-speed shaft (HSS) speed [rad/s] + REAL(ReKi) :: RotSpeed = 0.0_ReKi !< Rotor azimuth angular speed [rad/s] + REAL(ReKi) :: TwrAccel = 0.0_ReKi !< Tower acceleration for tower feedback control (user routine only) [m/s^2] + REAL(ReKi) :: YawAngle = 0.0_ReKi !< Yaw angle to be used for yaw error calculations [radians] + REAL(ReKi) , DIMENSION(1:3) :: RootMyc = 0.0_ReKi !< Out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root for each of the blades (max 3) [N-m] + REAL(ReKi) :: YawBrTAxp = 0.0_ReKi !< Tower-top / yaw bearing fore-aft (translational) acceleration (absolute) [m/s^2] + REAL(ReKi) :: YawBrTAyp = 0.0_ReKi !< Tower-top / yaw bearing side-to-side (translational) acceleration (absolute) [m/s^2] + REAL(ReKi) :: LSSTipPxa = 0.0_ReKi !< Rotor azimuth angle (position) [radians] + REAL(ReKi) , DIMENSION(1:3) :: RootMxc = 0.0_ReKi !< In-plane moment (i.e., the moment caused by in-plane forces) at the blade root [N-m] + REAL(ReKi) :: LSSTipMxa = 0.0_ReKi !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] + REAL(ReKi) :: LSSTipMya = 0.0_ReKi !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] + REAL(ReKi) :: LSSTipMza = 0.0_ReKi !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] + REAL(ReKi) :: LSSTipMys = 0.0_ReKi !< Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] + REAL(ReKi) :: LSSTipMzs = 0.0_ReKi !< Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] + REAL(ReKi) :: YawBrMyn = 0.0_ReKi !< Rotating (with nacelle) tower-top / yaw bearing pitch moment [N-m] + REAL(ReKi) :: YawBrMzn = 0.0_ReKi !< Tower-top / yaw bearing yaw moment [N-m] + REAL(ReKi) :: NcIMURAxs = 0.0_ReKi !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] + REAL(ReKi) :: NcIMURAys = 0.0_ReKi !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] + REAL(ReKi) :: NcIMURAzs = 0.0_ReKi !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] + REAL(ReKi) :: RotPwr = 0.0_ReKi !< Rotor power (this is equivalent to the low-speed shaft power) [W] + REAL(ReKi) :: LSShftFxa = 0.0_ReKi !< Rotating low-speed shaft force x [N] + REAL(ReKi) :: LSShftFys = 0.0_ReKi !< Nonrotating low-speed shaft force y [N] + REAL(ReKi) :: LSShftFzs = 0.0_ReKi !< Nonrotating low-speed shaft force z [N] END TYPE ED_OutputType ! ======================= CONTAINS diff --git a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 index e6f1f705a6..2d83def2e1 100644 --- a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 +++ b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 @@ -35,29 +35,29 @@ MODULE ExtPtfm_MCKF_Types IMPLICIT NONE ! ========= ExtPtfm_InitInputType ======= TYPE, PUBLIC :: ExtPtfm_InitInputType - CHARACTER(1024) :: InputFile !< Name of the input file; remove if there is no file [-] + CHARACTER(1024) :: InputFile = '' !< Name of the input file; remove if there is no file [-] LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] - REAL(ReKi) :: PtfmRefzt !< Vertical distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform reference point [meters] - CHARACTER(1024) :: RootName !< RootName for writing output files [-] + REAL(ReKi) :: PtfmRefzt = 0.0_ReKi !< Vertical distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform reference point [meters] + CHARACTER(1024) :: RootName = '' !< RootName for writing output files [-] END TYPE ExtPtfm_InitInputType ! ======================= ! ========= ExtPtfm_InputFile ======= TYPE, PUBLIC :: ExtPtfm_InputFile - REAL(DbKi) :: DT !< Requested integration time for ElastoDyn [seconds] - INTEGER(IntKi) :: IntMethod !< Integration Method (1=RK4, 2=AB4, 3=ABM4) [-] - INTEGER(IntKi) :: FileFormat !< File format switch [-] - CHARACTER(1024) :: RedFile !< File containing reduction inputs [-] - CHARACTER(1024) :: RedFileCst !< File containing constant reduction inputs [-] - LOGICAL :: EquilStart !< Flag to determine the equilibrium positions of the CB modes at initialization (first call) [-] + REAL(DbKi) :: DT = 0.0_R8Ki !< Requested integration time for ElastoDyn [seconds] + INTEGER(IntKi) :: IntMethod = 0_IntKi !< Integration Method (1=RK4, 2=AB4, 3=ABM4) [-] + INTEGER(IntKi) :: FileFormat = 0_IntKi !< File format switch [-] + CHARACTER(1024) :: RedFile = '' !< File containing reduction inputs [-] + CHARACTER(1024) :: RedFileCst = '' !< File containing constant reduction inputs [-] + LOGICAL :: EquilStart = .false. !< Flag to determine the equilibrium positions of the CB modes at initialization (first call) [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ActiveCBDOF !< List of active CB DOF [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: InitPosList !< Initial positions of the CB DOFs [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: InitVelList !< Initial velocities of the CB DOFs [-] - LOGICAL :: SumPrint !< Print summary data to .sum [-] - INTEGER(IntKi) :: OutFile !< Switch to determine where output will be placed: (1: in module output file only; 2: in glue code output file only; 3: both) [-] - LOGICAL :: TabDelim !< Flag to cause tab-delimited text output (delimited by space otherwise) [-] - CHARACTER(20) :: OutFmt !< Format used for module's text tabular output (except time); resulting field should be 10 characters [-] - REAL(DbKi) :: Tstart !< Time to start module's tabular output [seconds] - INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] + LOGICAL :: SumPrint = .false. !< Print summary data to .sum [-] + INTEGER(IntKi) :: OutFile = 0_IntKi !< Switch to determine where output will be placed: (1: in module output file only; 2: in glue code output file only; 3: both) [-] + LOGICAL :: TabDelim = .false. !< Flag to cause tab-delimited text output (delimited by space otherwise) [-] + CHARACTER(20) :: OutFmt = '' !< Format used for module's text tabular output (except time); resulting field should be 10 characters [-] + REAL(DbKi) :: Tstart = 0.0_R8Ki !< Time to start module's tabular output [seconds] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< List of user-requested output channels [-] END TYPE ExtPtfm_InputFile ! ======================= @@ -84,27 +84,27 @@ MODULE ExtPtfm_MCKF_Types ! ======================= ! ========= ExtPtfm_DiscreteStateType ======= TYPE, PUBLIC :: ExtPtfm_DiscreteStateType - REAL(ReKi) :: DummyDiscState !< Remove this variable if you have discrete states [-] + REAL(ReKi) :: DummyDiscState = 0.0_ReKi !< Remove this variable if you have discrete states [-] END TYPE ExtPtfm_DiscreteStateType ! ======================= ! ========= ExtPtfm_ConstraintStateType ======= TYPE, PUBLIC :: ExtPtfm_ConstraintStateType - REAL(ReKi) :: DummyConstrState !< Remove this variable if you have constraint states [-] + REAL(ReKi) :: DummyConstrState = 0.0_ReKi !< Remove this variable if you have constraint states [-] END TYPE ExtPtfm_ConstraintStateType ! ======================= ! ========= ExtPtfm_OtherStateType ======= TYPE, PUBLIC :: ExtPtfm_OtherStateType TYPE(ExtPtfm_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: xdot !< Previous state derivs for m-step time integrator [-] - INTEGER(IntKi) :: n !< Tracks time step for which OtherState was updated last [-] + INTEGER(IntKi) :: n = 0_IntKi !< Tracks time step for which OtherState was updated last [-] END TYPE ExtPtfm_OtherStateType ! ======================= ! ========= ExtPtfm_MiscVarType ======= TYPE, PUBLIC :: ExtPtfm_MiscVarType REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: xFlat !< Flattened vector of states [-] - REAL(ReKi) , DIMENSION(1:18) :: uFlat !< Flattened vector of inputs [-] + REAL(ReKi) , DIMENSION(1:18) :: uFlat = 0.0_ReKi !< Flattened vector of inputs [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_at_t !< The 6 interface loads and Craig-Bampton loads at t (force and moment acting at the platform reference (no added-mass effects); positive forces are in the direction of motion). [N, N-m] - INTEGER(IntKi) :: Indx !< Index into times, to speed up interpolation [-] - LOGICAL :: EquilStart !< Flag to determine the equilibrium position of the CB DOF at initialization (first call) [-] + INTEGER(IntKi) :: Indx = 0_IntKi !< Index into times, to speed up interpolation [-] + LOGICAL :: EquilStart = .false. !< Flag to determine the equilibrium position of the CB DOF at initialization (first call) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AllOuts !< An array holding the value of all of the calculated (not only selected) output channels [see OutListParameters.xlsx spreadsheet] END TYPE ExtPtfm_MiscVarType ! ======================= @@ -131,13 +131,13 @@ MODULE ExtPtfm_MCKF_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: C12 !< Matrix C12 [] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: C22 !< Matrix C22 [] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: C21 !< Matrix C21 [] - REAL(DbKi) :: EP_DeltaT !< Time step (for integration of continuous states) [seconds] - INTEGER(IntKi) :: nTimeSteps !< Number of values of Forces and times [-] - INTEGER(IntKi) :: nCB !< Number of CraigBampton modes active [-] - INTEGER(IntKi) :: nCBFull !< Totla number of CraigBampton modes given as input [-] - INTEGER(IntKi) :: nTot !< Total number of debrees of freedom (CB + interface) [-] - INTEGER(IntKi) :: NumOuts !< Number of values in WriteOutput [-] - INTEGER(IntKi) :: IntMethod !< Integration Method (1=RK4, 2=AB4, 3=ABM4) [-] + REAL(DbKi) :: EP_DeltaT = 0.0_R8Ki !< Time step (for integration of continuous states) [seconds] + INTEGER(IntKi) :: nTimeSteps = 0_IntKi !< Number of values of Forces and times [-] + INTEGER(IntKi) :: nCB = 0_IntKi !< Number of CraigBampton modes active [-] + INTEGER(IntKi) :: nCBFull = 0_IntKi !< Totla number of CraigBampton modes given as input [-] + INTEGER(IntKi) :: nTot = 0_IntKi !< Total number of debrees of freedom (CB + interface) [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of values in WriteOutput [-] + INTEGER(IntKi) :: IntMethod = 0_IntKi !< Integration Method (1=RK4, 2=AB4, 3=ABM4) [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ActiveCBDOF !< List of active CB DOF [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: OutParamLinIndx !< Index into WriteOutput for linearization analysis [-] diff --git a/modules/feamooring/src/FEAMooring_Types.f90 b/modules/feamooring/src/FEAMooring_Types.f90 index bc963debe8..a61bba814e 100644 --- a/modules/feamooring/src/FEAMooring_Types.f90 +++ b/modules/feamooring/src/FEAMooring_Types.f90 @@ -35,7 +35,7 @@ MODULE FEAMooring_Types IMPLICIT NONE ! ========= FEAM_InputFile ======= TYPE, PUBLIC :: FEAM_InputFile - REAL(DbKi) :: DT !< Communication interval for mooring dynamics [s] + REAL(DbKi) :: DT = 0.0_R8Ki !< Communication interval for mooring dynamics [s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: LineCI !< Mooring line inertia coefficient [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: LineCD !< Mooring line drag coefficient [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: LEAStiff !< Mooring line axial stiffness [-] @@ -53,32 +53,32 @@ MODULE FEAMooring_Types REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: GSL !< Linear spring stiffness at fairlead [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: GSR !< Rotational spring stiffness at fairlead [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: GE !< Reference tangent vector at fairlead [-] - INTEGER(IntKi) :: NumLines !< Number of lines [-] - INTEGER(IntKi) :: NumElems !< Number of elements [-] - REAL(ReKi) :: Eps !< Tolerance for static iteration [-] - REAL(ReKi) :: Gravity !< Gravity [-] - REAL(ReKi) :: WtrDens !< Water density [-] - INTEGER(IntKi) :: MaxIter !< Maximum number of iteration step for static analysis [-] - LOGICAL :: SumPrint !< Print summary data to .fsm? [-] - INTEGER(IntKi) :: OutFile !< Switch to determine where output will be placed: (1: in module output file only; 2: in glue code output file only; 3: both) [-] - LOGICAL :: TabDelim !< Use tab delimiters in text tabular output file? [-] - CHARACTER(20) :: OutFmt !< Format used for text tabular output (except time) [-] - REAL(DbKi) :: Tstart !< Time to start module's tabular output [s] - INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] + INTEGER(IntKi) :: NumLines = 0_IntKi !< Number of lines [-] + INTEGER(IntKi) :: NumElems = 0_IntKi !< Number of elements [-] + REAL(ReKi) :: Eps = 0.0_ReKi !< Tolerance for static iteration [-] + REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravity [-] + REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density [-] + INTEGER(IntKi) :: MaxIter = 0_IntKi !< Maximum number of iteration step for static analysis [-] + LOGICAL :: SumPrint = .false. !< Print summary data to .fsm? [-] + INTEGER(IntKi) :: OutFile = 0_IntKi !< Switch to determine where output will be placed: (1: in module output file only; 2: in glue code output file only; 3: both) [-] + LOGICAL :: TabDelim = .false. !< Use tab delimiters in text tabular output file? [-] + CHARACTER(20) :: OutFmt = '' !< Format used for text tabular output (except time) [-] + REAL(DbKi) :: Tstart = 0.0_R8Ki !< Time to start module's tabular output [s] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< List of user-requested output channels [-] END TYPE FEAM_InputFile ! ======================= ! ========= FEAM_InitInputType ======= TYPE, PUBLIC :: FEAM_InitInputType - CHARACTER(1024) :: InputFile !< Name of the input file [-] - CHARACTER(1024) :: RootName !< RootName for writing output files [-] - REAL(ReKi) , DIMENSION(1:6) :: PtfmInit !< Platform Initial Position [-] - INTEGER(IntKi) :: NStepWave !< [-] + CHARACTER(1024) :: InputFile = '' !< Name of the input file [-] + CHARACTER(1024) :: RootName = '' !< RootName for writing output files [-] + REAL(ReKi) , DIMENSION(1:6) :: PtfmInit = 0.0_ReKi !< Platform Initial Position [-] + INTEGER(IntKi) :: NStepWave = 0_IntKi !< [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveAcc0 !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WaveTime !< [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveVel0 !< [-] - REAL(ReKi) :: Gravity !< Gravity [-] - REAL(ReKi) :: WtrDens !< Water density [-] + REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravity [-] + REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density [-] END TYPE FEAM_InitInputType ! ======================= ! ========= FEAM_InitOutputType ======= @@ -102,48 +102,48 @@ MODULE FEAMooring_Types ! ======================= ! ========= FEAM_DiscreteStateType ======= TYPE, PUBLIC :: FEAM_DiscreteStateType - REAL(ReKi) :: DummyDiscState !< Remove this variable if you have discrete states [-] + REAL(ReKi) :: DummyDiscState = 0.0_ReKi !< Remove this variable if you have discrete states [-] END TYPE FEAM_DiscreteStateType ! ======================= ! ========= FEAM_ConstraintStateType ======= TYPE, PUBLIC :: FEAM_ConstraintStateType - REAL(ReKi) , DIMENSION(1:3) :: TSN !< Lagrangian multiplier [-] - REAL(ReKi) , DIMENSION(1:3) :: TZER !< Lagrangian multiplier [-] + REAL(ReKi) , DIMENSION(1:3) :: TSN = 0.0_ReKi !< Lagrangian multiplier [-] + REAL(ReKi) , DIMENSION(1:3) :: TZER = 0.0_ReKi !< Lagrangian multiplier [-] END TYPE FEAM_ConstraintStateType ! ======================= ! ========= FEAM_OtherStateType ======= TYPE, PUBLIC :: FEAM_OtherStateType REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: GLU0 !< Global matrix U0 (previous state) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: GLDDU !< Global matrix DDU (accleration) -- other state [-] - LOGICAL :: BottomTouch !< Bottom touch flag [-] + LOGICAL :: BottomTouch = .false. !< Bottom touch flag [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: GFORC0 !< Old element force matrix [-] REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: GMASS0 !< Old element mass matrix [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: FAST_FPA !< Fairlead position - inputs from previous time step (we should replace this with a call to extrap-interp) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: FAST_RP !< Fairlead tangent - part of output computation that was calculated in UpdateStates [-] - INTEGER(IntKi) :: INCR !< FEAM step [-] - REAL(ReKi) , DIMENSION(1:15) :: RSDF !< Line residue force - modifies values from previous call to FEAM_Solve [-] - REAL(ReKi) , DIMENSION(1:15) :: FORC0 !< - [Local old element force matrix] - REAL(ReKi) , DIMENSION(1:15,1:15) :: EMAS0 !< Local old element mass matrix [-] + INTEGER(IntKi) :: INCR = 0_IntKi !< FEAM step [-] + REAL(ReKi) , DIMENSION(1:15) :: RSDF = 0.0_ReKi !< Line residue force - modifies values from previous call to FEAM_Solve [-] + REAL(ReKi) , DIMENSION(1:15) :: FORC0 = 0.0_ReKi !< - [Local old element force matrix] + REAL(ReKi) , DIMENSION(1:15,1:15) :: EMAS0 = 0.0_ReKi !< Local old element mass matrix [-] END TYPE FEAM_OtherStateType ! ======================= ! ========= FEAM_MiscVarType ======= TYPE, PUBLIC :: FEAM_MiscVarType REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: GLF !< Global forcing matrix [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: GLK !< Global stiffness matrix [-] - REAL(ReKi) , DIMENSION(1:15,1:15) :: EMASS !< Line element mass [-] - REAL(ReKi) , DIMENSION(1:15,1:15) :: ESTIF !< Line element stiffness [-] + REAL(ReKi) , DIMENSION(1:15,1:15) :: EMASS = 0.0_ReKi !< Line element mass [-] + REAL(ReKi) , DIMENSION(1:15,1:15) :: ESTIF = 0.0_ReKi !< Line element stiffness [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: FAST_FP !< Fairlead position at t+dt [-] - REAL(ReKi) , DIMENSION(1:15) :: FORCE !< Line external force [-] - REAL(ReKi) , DIMENSION(1:3) :: FP !< Fairlead position - used in Couple routine [-] - REAL(ReKi) , DIMENSION(1:3,1:4) :: U !< Local matrix U [-] - REAL(ReKi) , DIMENSION(1:3,1:4) :: U0 !< Local matrix U0 [-] - REAL(ReKi) , DIMENSION(1:3,1:4) :: DU !< Local matrix DU [-] - REAL(ReKi) , DIMENSION(1:3,1:4) :: DDU !< Local matrix DDU [-] - REAL(ReKi) , DIMENSION(1:3) :: R !< POSITION VECTOR OF NODE OF ROD ELEMENT [-] - REAL(ReKi) , DIMENSION(1:3) :: RP !< DR/DS AT R (TANGENT - NEED NOT BE UNIT VECTOR) [-] - REAL(ReKi) , DIMENSION(1:6) :: RHSR !< RIGHT HAND SIDE CONTRIBUTION TO 6 DEGREES OF FREEDOM OF ROD NODE [-] - REAL(ReKi) , DIMENSION(1:3) :: SLIN !< LINEAR SPRING CONSTANT - portion of p%GSL [(UNITS OF FORCE/LENGTH)] - REAL(ReKi) , DIMENSION(1:6,1:6) :: STIFR !< STIFFNESS COEFFICIENTS FOR 6 DEGREES OF FREEDOM OF ROD NODE (X,DX/DS,Y,DY/DS,Z,DZ/DS) [-] + REAL(ReKi) , DIMENSION(1:15) :: FORCE = 0.0_ReKi !< Line external force [-] + REAL(ReKi) , DIMENSION(1:3) :: FP = 0.0_ReKi !< Fairlead position - used in Couple routine [-] + REAL(ReKi) , DIMENSION(1:3,1:4) :: U = 0.0_ReKi !< Local matrix U [-] + REAL(ReKi) , DIMENSION(1:3,1:4) :: U0 = 0.0_ReKi !< Local matrix U0 [-] + REAL(ReKi) , DIMENSION(1:3,1:4) :: DU = 0.0_ReKi !< Local matrix DU [-] + REAL(ReKi) , DIMENSION(1:3,1:4) :: DDU = 0.0_ReKi !< Local matrix DDU [-] + REAL(ReKi) , DIMENSION(1:3) :: R = 0.0_ReKi !< POSITION VECTOR OF NODE OF ROD ELEMENT [-] + REAL(ReKi) , DIMENSION(1:3) :: RP = 0.0_ReKi !< DR/DS AT R (TANGENT - NEED NOT BE UNIT VECTOR) [-] + REAL(ReKi) , DIMENSION(1:6) :: RHSR = 0.0_ReKi !< RIGHT HAND SIDE CONTRIBUTION TO 6 DEGREES OF FREEDOM OF ROD NODE [-] + REAL(ReKi) , DIMENSION(1:3) :: SLIN = 0.0_ReKi !< LINEAR SPRING CONSTANT - portion of p%GSL [(UNITS OF FORCE/LENGTH)] + REAL(ReKi) , DIMENSION(1:6,1:6) :: STIFR = 0.0_ReKi !< STIFFNESS COEFFICIENTS FOR 6 DEGREES OF FREEDOM OF ROD NODE (X,DX/DS,Y,DY/DS,Z,DZ/DS) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: FAIR_ANG !< Fairlead angle [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FAIR_T !< Fairlead tension [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: ANCH_ANG !< Anchor angle [-] @@ -151,24 +151,24 @@ MODULE FEAMooring_Types REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Line_Coordinate !< Mooring line coordinate [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Line_Tangent !< Mooring line tangent vector [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: F_Lines !< Mooring restoring force [-] - INTEGER(IntKi) :: LastIndWave !< FEAM step [-] + INTEGER(IntKi) :: LastIndWave = 0_IntKi !< FEAM step [-] END TYPE FEAM_MiscVarType ! ======================= ! ========= FEAM_ParameterType ======= TYPE, PUBLIC :: FEAM_ParameterType - REAL(DbKi) :: DT !< Time step for continuous state integration & discrete state update [seconds] - REAL(ReKi) , DIMENSION(1:3) :: GRAV !< Gravity [-] - REAL(ReKi) :: Eps !< Tolerance for static iteration [-] - REAL(ReKi) :: Gravity !< Gravity [-] - REAL(ReKi) :: WtrDens !< Water density [-] - INTEGER(IntKi) :: MaxIter !< Maximum number of iteration step for static analysis [-] - INTEGER(IntKi) :: NHBD !< Bandwidth = (NBAND+1)/2 [-] - INTEGER(IntKi) :: NDIM !< Dimension = 3 [-] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for continuous state integration & discrete state update [seconds] + REAL(ReKi) , DIMENSION(1:3) :: GRAV = 0.0_ReKi !< Gravity [-] + REAL(ReKi) :: Eps = 0.0_ReKi !< Tolerance for static iteration [-] + REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravity [-] + REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density [-] + INTEGER(IntKi) :: MaxIter = 0_IntKi !< Maximum number of iteration step for static analysis [-] + INTEGER(IntKi) :: NHBD = 0_IntKi !< Bandwidth = (NBAND+1)/2 [-] + INTEGER(IntKi) :: NDIM = 0_IntKi !< Dimension = 3 [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NEQ !< Number of equation [-] - INTEGER(IntKi) :: NBAND !< Bandwidth [-] - INTEGER(IntKi) :: NumLines !< Number of lines [-] - INTEGER(IntKi) :: NumElems !< Number of elements [-] - INTEGER(IntKi) :: NumNodes !< Number of nodes [-] + INTEGER(IntKi) :: NBAND = 0_IntKi !< Bandwidth [-] + INTEGER(IntKi) :: NumLines = 0_IntKi !< Number of lines [-] + INTEGER(IntKi) :: NumElems = 0_IntKi !< Number of elements [-] + INTEGER(IntKi) :: NumNodes = 0_IntKi !< Number of nodes [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: GSL !< Linear spring stiffness at fairlead [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: GP !< Fairlead position [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Elength !< Element length [-] @@ -183,29 +183,29 @@ MODULE FEAMooring_Types REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveAcc0 !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WaveTime !< [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveVel0 !< [-] - INTEGER(IntKi) :: NStepWave !< Number of wave steps [-] - REAL(ReKi) , DIMENSION(1:6,1:4) :: SHAP !< Shape function [-] - REAL(ReKi) , DIMENSION(1:6,1:4) :: SHAPS !< Shape function [-] - REAL(ReKi) , DIMENSION(1:6) :: GAUSSW !< Shape function [-] - INTEGER(IntKi) :: NGAUSS !< 6 POINT GAUSSIAN QUADRATURE INTEGRATION [-] - REAL(ReKi) , DIMENSION(1:10,1:4) :: SHAPT !< Shape function [-] - REAL(ReKi) , DIMENSION(1:10,1:4) :: SHAPTS !< Shape function [-] - INTEGER(IntKi) :: NTRAP !< 10 TRANPEZOIDE INTEGRATION point [-] - REAL(ReKi) , DIMENSION(1:4,1:4) :: SBEND !< Internal [-] - REAL(ReKi) , DIMENSION(1:3,1:4,1:4) :: STEN !< Internal [-] - REAL(ReKi) , DIMENSION(1:4,1:4) :: RMASS !< Internal [-] - REAL(ReKi) , DIMENSION(1:4,1:4,1:4,1:4) :: RADDM !< Internal [-] - REAL(ReKi) , DIMENSION(1:3,1:3) :: PMPN !< Internal [-] - REAL(ReKi) , DIMENSION(1:4) :: AM !< Internal [-] - REAL(ReKi) , DIMENSION(1:3) :: PM !< Internal [-] - INTEGER(IntKi) , DIMENSION(1:3,1:4) :: IDOF !< Internal [-] - INTEGER(IntKi) , DIMENSION(1:3) :: JDOF !< Internal [-] - REAL(ReKi) , DIMENSION(1:3,1:3,1:4) :: PPA !< Internal [-] - REAL(ReKi) :: PtfmRefzt !< Platform reference [-] - INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] - CHARACTER(1024) :: RootName !< RootName for writing output files [-] + INTEGER(IntKi) :: NStepWave = 0_IntKi !< Number of wave steps [-] + REAL(ReKi) , DIMENSION(1:6,1:4) :: SHAP = 0.0_ReKi !< Shape function [-] + REAL(ReKi) , DIMENSION(1:6,1:4) :: SHAPS = 0.0_ReKi !< Shape function [-] + REAL(ReKi) , DIMENSION(1:6) :: GAUSSW = 0.0_ReKi !< Shape function [-] + INTEGER(IntKi) :: NGAUSS = 0_IntKi !< 6 POINT GAUSSIAN QUADRATURE INTEGRATION [-] + REAL(ReKi) , DIMENSION(1:10,1:4) :: SHAPT = 0.0_ReKi !< Shape function [-] + REAL(ReKi) , DIMENSION(1:10,1:4) :: SHAPTS = 0.0_ReKi !< Shape function [-] + INTEGER(IntKi) :: NTRAP = 0_IntKi !< 10 TRANPEZOIDE INTEGRATION point [-] + REAL(ReKi) , DIMENSION(1:4,1:4) :: SBEND = 0.0_ReKi !< Internal [-] + REAL(ReKi) , DIMENSION(1:3,1:4,1:4) :: STEN = 0.0_ReKi !< Internal [-] + REAL(ReKi) , DIMENSION(1:4,1:4) :: RMASS = 0.0_ReKi !< Internal [-] + REAL(ReKi) , DIMENSION(1:4,1:4,1:4,1:4) :: RADDM = 0.0_ReKi !< Internal [-] + REAL(ReKi) , DIMENSION(1:3,1:3) :: PMPN = 0.0_ReKi !< Internal [-] + REAL(ReKi) , DIMENSION(1:4) :: AM = 0.0_ReKi !< Internal [-] + REAL(ReKi) , DIMENSION(1:3) :: PM = 0.0_ReKi !< Internal [-] + INTEGER(IntKi) , DIMENSION(1:3,1:4) :: IDOF = 0_IntKi !< Internal [-] + INTEGER(IntKi) , DIMENSION(1:3) :: JDOF = 0_IntKi !< Internal [-] + REAL(ReKi) , DIMENSION(1:3,1:3,1:4) :: PPA = 0.0_ReKi !< Internal [-] + REAL(ReKi) :: PtfmRefzt = 0.0_ReKi !< Platform reference [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] + CHARACTER(1024) :: RootName = '' !< RootName for writing output files [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] - CHARACTER(1) :: Delim !< Column delimiter for output text files [-] + CHARACTER(1) :: Delim = '' !< Column delimiter for output text files [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: GLUZR !< Line coordinate & direction cosine [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: GTZER !< Line tension [-] END TYPE FEAM_ParameterType diff --git a/modules/hydrodyn/src/Conv_Radiation_Types.f90 b/modules/hydrodyn/src/Conv_Radiation_Types.f90 index c0669665e7..709450ebf9 100644 --- a/modules/hydrodyn/src/Conv_Radiation_Types.f90 +++ b/modules/hydrodyn/src/Conv_Radiation_Types.f90 @@ -35,57 +35,57 @@ MODULE Conv_Radiation_Types IMPLICIT NONE ! ========= Conv_Rdtn_InitInputType ======= TYPE, PUBLIC :: Conv_Rdtn_InitInputType - REAL(DbKi) :: RdtnDT !< [-] - CHARACTER(80) :: RdtnDTChr - INTEGER(IntKi) :: NBody !< [>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6] [-] - REAL(ReKi) :: HighFreq !< [-] - CHARACTER(1024) :: WAMITFile !< [-] + REAL(DbKi) :: RdtnDT = 0.0_R8Ki !< [-] + CHARACTER(80) :: RdtnDTChr = '' + INTEGER(IntKi) :: NBody = 0_IntKi !< [>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6] [-] + REAL(ReKi) :: HighFreq = 0.0_ReKi !< [-] + CHARACTER(1024) :: WAMITFile = '' !< [-] REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: HdroAddMs !< [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: HdroFreq !< [-] REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: HdroDmpng !< [-] - INTEGER(IntKi) :: NInpFreq !< [-] - REAL(DbKi) :: RdtnTMax !< [-] + INTEGER(IntKi) :: NInpFreq = 0_IntKi !< [-] + REAL(DbKi) :: RdtnTMax = 0.0_R8Ki !< [-] END TYPE Conv_Rdtn_InitInputType ! ======================= ! ========= Conv_Rdtn_InitOutputType ======= TYPE, PUBLIC :: Conv_Rdtn_InitOutputType - INTEGER(IntKi) :: DummyInitOut !< [-] + INTEGER(IntKi) :: DummyInitOut = 0_IntKi !< [-] END TYPE Conv_Rdtn_InitOutputType ! ======================= ! ========= Conv_Rdtn_ContinuousStateType ======= TYPE, PUBLIC :: Conv_Rdtn_ContinuousStateType - REAL(SiKi) :: DummyContState !< Remove this variable if you have continuous states [-] + REAL(SiKi) :: DummyContState = 0.0_R4Ki !< Remove this variable if you have continuous states [-] END TYPE Conv_Rdtn_ContinuousStateType ! ======================= ! ========= Conv_Rdtn_DiscreteStateType ======= TYPE, PUBLIC :: Conv_Rdtn_DiscreteStateType REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: XDHistory !< [-] - REAL(DbKi) :: LastTime !< [-] + REAL(DbKi) :: LastTime = 0.0_R8Ki !< [-] END TYPE Conv_Rdtn_DiscreteStateType ! ======================= ! ========= Conv_Rdtn_ConstraintStateType ======= TYPE, PUBLIC :: Conv_Rdtn_ConstraintStateType - REAL(SiKi) :: DummyConstrState !< Remove this variable if you have constraint states [-] + REAL(SiKi) :: DummyConstrState = 0.0_R4Ki !< Remove this variable if you have constraint states [-] END TYPE Conv_Rdtn_ConstraintStateType ! ======================= ! ========= Conv_Rdtn_OtherStateType ======= TYPE, PUBLIC :: Conv_Rdtn_OtherStateType - INTEGER(IntKi) :: IndRdtn !< [-] + INTEGER(IntKi) :: IndRdtn = 0_IntKi !< [-] END TYPE Conv_Rdtn_OtherStateType ! ======================= ! ========= Conv_Rdtn_MiscVarType ======= TYPE, PUBLIC :: Conv_Rdtn_MiscVarType - INTEGER(IntKi) :: LastIndRdtn !< [-] + INTEGER(IntKi) :: LastIndRdtn = 0_IntKi !< [-] END TYPE Conv_Rdtn_MiscVarType ! ======================= ! ========= Conv_Rdtn_ParameterType ======= TYPE, PUBLIC :: Conv_Rdtn_ParameterType - REAL(DbKi) :: DT !< Time step for continuous state integration & discrete state update [seconds] - REAL(DbKi) :: RdtnDT !< [-] - INTEGER(IntKi) :: NBody !< [>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6] [-] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for continuous state integration & discrete state update [seconds] + REAL(DbKi) :: RdtnDT = 0.0_R8Ki !< [-] + INTEGER(IntKi) :: NBody = 0_IntKi !< [>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6] [-] REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: RdtnKrnl !< [-] - INTEGER(IntKi) :: NStepRdtn !< [-] - INTEGER(IntKi) :: NStepRdtn1 !< [-] + INTEGER(IntKi) :: NStepRdtn = 0_IntKi !< [-] + INTEGER(IntKi) :: NStepRdtn1 = 0_IntKi !< [-] END TYPE Conv_Rdtn_ParameterType ! ======================= ! ========= Conv_Rdtn_InputType ======= diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index c704189183..b70c7c877e 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -44,19 +44,19 @@ MODULE HydroDyn_Types INTEGER(IntKi), PUBLIC, PARAMETER :: MaxUserOutputs = 5150 ! Total possible number of output channels: SS_Excitation = 7 + SS_Radiation = 7 + Morison= 4626 + HydroDyn=510 = 5150 [-] ! ========= HydroDyn_InputFile ======= TYPE, PUBLIC :: HydroDyn_InputFile - LOGICAL :: EchoFlag !< Echo the input file [-] + LOGICAL :: EchoFlag = .false. !< Echo the input file [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AddF0 !< Additional pre-load forces and moments (N,N,N,N-m,N-m,N-m) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AddCLin !< Additional stiffness matrix [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AddBLin !< Additional linear damping matrix [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AddBQuad !< Additional quadratic damping (drag) matrix [-] TYPE(SeaSt_InitInputType) :: SeaState !< Initialization data for SeaState module [-] CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: PotFile !< The name of the root potential flow file (without extension for WAMIT, complete name for FIT) [-] - INTEGER(IntKi) :: nWAMITObj !< number of WAMIT input files. If NBodyMod = 1 then nPotFiles will be 1 even if NBody > 1 [-] - INTEGER(IntKi) :: vecMultiplier !< multiplier for the WAMIT vectors and matrices. If NBodyMod=1 then this = NBody, else 1 [-] - INTEGER(IntKi) :: NBody !< [>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6] [-] - INTEGER(IntKi) :: NBodyMod !< Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1] [-] + INTEGER(IntKi) :: nWAMITObj = 0_IntKi !< number of WAMIT input files. If NBodyMod = 1 then nPotFiles will be 1 even if NBody > 1 [-] + INTEGER(IntKi) :: vecMultiplier = 0_IntKi !< multiplier for the WAMIT vectors and matrices. If NBodyMod=1 then this = NBody, else 1 [-] + INTEGER(IntKi) :: NBody = 0_IntKi !< [>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6] [-] + INTEGER(IntKi) :: NBodyMod = 0_IntKi !< Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PtfmVol0 !< [-] - LOGICAL :: HasWAMIT !< .TRUE. if using WAMIT model, .FALSE. otherwise [-] + LOGICAL :: HasWAMIT = .false. !< .TRUE. if using WAMIT model, .FALSE. otherwise [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WAMITULEN !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PtfmRefxt !< The xt offset of the body reference point(s) from (0,0,0) [1 to NBody; only used when PotMod=1; must be 0.0 if NBodyMod=2 ] [(m)] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PtfmRefyt !< The yt offset of the body reference point(s) from (0,0,0) [1 to NBody; only used when PotMod=1; must be 0.0 if NBodyMod=2 ] [(m)] @@ -67,55 +67,55 @@ MODULE HydroDyn_Types TYPE(WAMIT_InitInputType) :: WAMIT !< Initialization data for WAMIT module [-] TYPE(WAMIT2_InitInputType) :: WAMIT2 !< Initialization data for WAMIT2 module [-] TYPE(Morison_InitInputType) :: Morison !< Initialization data for Morison module [-] - LOGICAL :: Echo !< Echo the input files to a file with the same name as the input but with a .echo extension [T/F] [-] - INTEGER(IntKi) :: PotMod !< 1 if using WAMIT model, 0 if no potential flow model, or 2 if FIT model [-] - INTEGER(IntKi) :: NUserOutputs !< Number of Hydrodyn-level requested output channels [-] + LOGICAL :: Echo = .false. !< Echo the input files to a file with the same name as the input but with a .echo extension [T/F] [-] + INTEGER(IntKi) :: PotMod = 0_IntKi !< 1 if using WAMIT model, 0 if no potential flow model, or 2 if FIT model [-] + INTEGER(IntKi) :: NUserOutputs = 0_IntKi !< Number of Hydrodyn-level requested output channels [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: UserOutputs !< This should really be dimensioned with MaxOutPts [-] - INTEGER(IntKi) :: OutSwtch !< Output requested channels to: [1=Hydrodyn.out 2=GlueCode.out 3=both files] [-] - LOGICAL :: OutAll !< Output all user-specified member and joint loads (only at each member end, not interior locations) [T/F] [-] - INTEGER(IntKi) :: NumOuts !< The number of outputs for this module as requested in the input file [-] + INTEGER(IntKi) :: OutSwtch = 0_IntKi !< Output requested channels to: [1=Hydrodyn.out 2=GlueCode.out 3=both files] [-] + LOGICAL :: OutAll = .false. !< Output all user-specified member and joint loads (only at each member end, not interior locations) [T/F] [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< The number of outputs for this module as requested in the input file [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< The user-requested output channel labels for this modules. This should really be dimensioned with MaxOutPts [-] - LOGICAL :: HDSum !< Generate a HydroDyn summary file [T/F] [-] - INTEGER(IntKi) :: UnSum !< File unit for the HydroDyn summary file [-1 = no summary file] [-] - CHARACTER(20) :: OutFmt !< Output format for numerical results [-] - CHARACTER(20) :: OutSFmt !< Output format for header strings [-] + LOGICAL :: HDSum = .false. !< Generate a HydroDyn summary file [T/F] [-] + INTEGER(IntKi) :: UnSum = 0_IntKi !< File unit for the HydroDyn summary file [-1 = no summary file] [-] + CHARACTER(20) :: OutFmt = '' !< Output format for numerical results [-] + CHARACTER(20) :: OutSFmt = '' !< Output format for header strings [-] END TYPE HydroDyn_InputFile ! ======================= ! ========= HydroDyn_InitInputType ======= TYPE, PUBLIC :: HydroDyn_InitInputType - CHARACTER(1024) :: InputFile !< Supplied by Driver: full path and filename for the HydroDyn module [-] + CHARACTER(1024) :: InputFile = '' !< Supplied by Driver: full path and filename for the HydroDyn module [-] LOGICAL :: UseInputFile = .TRUE. !< Supplied by Driver: .TRUE. if using a input file, .FALSE. if all inputs are being passed in by the caller [-] TYPE(FileInfoType) :: PassedFileData !< If we don't use the input file, pass everything through this [-] - CHARACTER(1024) :: OutRootName !< Supplied by Driver: The name of the root file (without extension) including the full path [-] + CHARACTER(1024) :: OutRootName = '' !< Supplied by Driver: The name of the root file (without extension) including the full path [-] LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] - REAL(ReKi) :: Gravity !< Supplied by Driver: Gravitational acceleration [(m/s^2)] - REAL(ReKi) :: WtrDens !< Water density from the driver; may be overwritten [(kg/m^3)] - REAL(ReKi) :: WtrDpth !< Water depth from the driver; may be overwritten [m] - REAL(ReKi) :: MSL2SWL !< Mean sea level to still water level from the driver; may be overwritten [m] - REAL(DbKi) :: TMax !< Supplied by Driver: The total simulation time [(sec)] - REAL(ReKi) :: PtfmLocationX !< Supplied by Driver: X coordinate of platform location in the wave field [m] - REAL(ReKi) :: PtfmLocationY !< Supplied by Driver: Y coordinate of platform location in the wave field [m] + REAL(ReKi) :: Gravity = 0.0_ReKi !< Supplied by Driver: Gravitational acceleration [(m/s^2)] + REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density from the driver; may be overwritten [(kg/m^3)] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth from the driver; may be overwritten [m] + REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Mean sea level to still water level from the driver; may be overwritten [m] + REAL(DbKi) :: TMax = 0.0_R8Ki !< Supplied by Driver: The total simulation time [(sec)] + REAL(ReKi) :: PtfmLocationX = 0.0_ReKi !< Supplied by Driver: X coordinate of platform location in the wave field [m] + REAL(ReKi) :: PtfmLocationY = 0.0_ReKi !< Supplied by Driver: Y coordinate of platform location in the wave field [m] INTEGER(IntKi) :: NStepWave = 0 !< Total number of frequency components = total number of time steps in the incident wave [-] INTEGER(IntKi) :: NStepWave2 = 0 !< NStepWave / 2 [-] - REAL(SiKi) :: RhoXg !< = WtrDens*Gravity [-] - INTEGER(IntKi) :: WaveMod !< Incident wave kinematics model {0: none=still water, 1: plane progressive (regular), 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: white-noise spectrum, 4: user-defind spectrum from routine UserWaveSpctrm (irregular), 5: GH BLADED } [-] - INTEGER(IntKi) :: WaveStMod !< Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching} [-] - INTEGER(IntKi) :: WaveDirMod !< Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6] [-] - REAL(SiKi) :: WvLowCOff !< Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] - REAL(SiKi) :: WvHiCOff !< High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] - REAL(SiKi) :: WvLowCOffD !< Minimum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] - REAL(SiKi) :: WvHiCOffD !< Maximum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] - REAL(SiKi) :: WvLowCOffS !< Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] - REAL(SiKi) :: WvHiCOffS !< Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] - LOGICAL :: InvalidWithSSExctn !< Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2) [(-)] + REAL(SiKi) :: RhoXg = 0.0_R4Ki !< = WtrDens*Gravity [-] + INTEGER(IntKi) :: WaveMod = 0_IntKi !< Incident wave kinematics model {0: none=still water, 1: plane progressive (regular), 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: white-noise spectrum, 4: user-defind spectrum from routine UserWaveSpctrm (irregular), 5: GH BLADED } [-] + INTEGER(IntKi) :: WaveStMod = 0_IntKi !< Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching} [-] + INTEGER(IntKi) :: WaveDirMod = 0_IntKi !< Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6] [-] + REAL(SiKi) :: WvLowCOff = 0.0_R4Ki !< Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] + REAL(SiKi) :: WvHiCOff = 0.0_R4Ki !< High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] + REAL(SiKi) :: WvLowCOffD = 0.0_R4Ki !< Minimum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] + REAL(SiKi) :: WvHiCOffD = 0.0_R4Ki !< Maximum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] + REAL(SiKi) :: WvLowCOffS = 0.0_R4Ki !< Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] + REAL(SiKi) :: WvHiCOffS = 0.0_R4Ki !< Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] + LOGICAL :: InvalidWithSSExctn = .false. !< Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2) [(-)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElev0 !< Instantaneous elevation time-series of incident waves at the platform reference point [(meters)] REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveElevC !< Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part [(meters)] - REAL(SiKi) :: WaveDirMin !< Minimum wave direction. [(degrees)] - REAL(SiKi) :: WaveDirMax !< Maximum wave direction. [(degrees)] - REAL(SiKi) :: WaveDir !< Incident wave propagation heading direction [(degrees)] - LOGICAL :: WaveMultiDir !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] - REAL(SiKi) :: WaveDOmega !< Frequency step for incident wave calculations [(rad/s)] - REAL(SiKi) :: MCFD !< Diameter of MacCamy-Fuchs members [(meters)] + REAL(SiKi) :: WaveDirMin = 0.0_R4Ki !< Minimum wave direction. [(degrees)] + REAL(SiKi) :: WaveDirMax = 0.0_R4Ki !< Maximum wave direction. [(degrees)] + REAL(SiKi) :: WaveDir = 0.0_R4Ki !< Incident wave propagation heading direction [(degrees)] + LOGICAL :: WaveMultiDir = .false. !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] + REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] + REAL(SiKi) :: MCFD = 0.0_R4Ki !< Diameter of MacCamy-Fuchs members [(meters)] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to SeaState wave field [-] END TYPE HydroDyn_InitInputType ! ======================= @@ -167,11 +167,11 @@ MODULE HydroDyn_Types TYPE, PUBLIC :: HydroDyn_MiscVarType TYPE(MeshType) :: AllHdroOrigin !< An intermediate mesh used to transfer hydrodynamic loads from the various HD-related meshes to the AllHdroOrigin mesh [-] TYPE(HD_ModuleMapType) :: HD_MeshMap - INTEGER(IntKi) :: Decimate !< The output decimation counter [-] - REAL(DbKi) :: LastOutTime !< Last time step which was written to the output file (sec) [-] - INTEGER(IntKi) :: LastIndWave !< The last index used in the wave kinematics arrays, used to optimize interpolation [-] + INTEGER(IntKi) :: Decimate = 0_IntKi !< The output decimation counter [-] + REAL(DbKi) :: LastOutTime = 0.0_R8Ki !< Last time step which was written to the output file (sec) [-] + INTEGER(IntKi) :: LastIndWave = 0_IntKi !< The last index used in the wave kinematics arrays, used to optimize interpolation [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_PtfmAdd !< The total forces and moments due to additional pre-load, stiffness, and damping [-] - REAL(ReKi) , DIMENSION(1:6) :: F_Hydro !< The total hydrodynamic forces and moments integrated about the (0,0,0) platform reference point [-] + REAL(ReKi) , DIMENSION(1:6) :: F_Hydro = 0.0_ReKi !< The total hydrodynamic forces and moments integrated about the (0,0,0) platform reference point [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_Waves !< The total waves forces on a WAMIT body calculated by first and second order methods (WAMIT and WAMIT2 modules) [-] TYPE(WAMIT_MiscVarType) , DIMENSION(:), ALLOCATABLE :: WAMIT !< misc var information from the WAMIT module [-] TYPE(WAMIT2_MiscVarType) , DIMENSION(:), ALLOCATABLE :: WAMIT2 !< misc var information from the WAMIT2 module [-] @@ -181,39 +181,39 @@ MODULE HydroDyn_Types ! ======================= ! ========= HydroDyn_ParameterType ======= TYPE, PUBLIC :: HydroDyn_ParameterType - INTEGER(IntKi) :: nWAMITObj !< number of WAMIT input files and matrices. If NBodyMod = 1 then nPotFiles will be 1 even if NBody > 1 [-] - INTEGER(IntKi) :: vecMultiplier !< multiplier for the WAMIT vectors and matrices. If NBodyMod=1 then this = NBody, else 1 [-] + INTEGER(IntKi) :: nWAMITObj = 0_IntKi !< number of WAMIT input files and matrices. If NBodyMod = 1 then nPotFiles will be 1 even if NBody > 1 [-] + INTEGER(IntKi) :: vecMultiplier = 0_IntKi !< multiplier for the WAMIT vectors and matrices. If NBodyMod=1 then this = NBody, else 1 [-] TYPE(WAMIT_ParameterType) , DIMENSION(:), ALLOCATABLE :: WAMIT !< Parameter data for the WAMIT module [-] TYPE(WAMIT2_ParameterType) , DIMENSION(:), ALLOCATABLE :: WAMIT2 !< Parameter data for the WAMIT2 module [-] LOGICAL :: WAMIT2used = .FALSE. !< Indicates when WAMIT2 is used. Shortcuts some calculations [-] TYPE(Morison_ParameterType) :: Morison !< Parameter data for the Morison module [-] - INTEGER(IntKi) :: PotMod !< 1 if using WAMIT model, 0 if no potential flow model, or 2 if FIT model [-] - INTEGER(IntKi) :: NBody !< [>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6] [-] - INTEGER(IntKi) :: NBodyMod !< Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1] [-] - INTEGER(IntKi) :: totalStates !< Number of excitation and radiation states for all WAMIT bodies [-] - INTEGER(IntKi) :: totalExctnStates !< Number of excitation states for all WAMIT bodies [-] - INTEGER(IntKi) :: totalRdtnStates !< Number of radiation states for all WAMIT bodies [-] + INTEGER(IntKi) :: PotMod = 0_IntKi !< 1 if using WAMIT model, 0 if no potential flow model, or 2 if FIT model [-] + INTEGER(IntKi) :: NBody = 0_IntKi !< [>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6] [-] + INTEGER(IntKi) :: NBodyMod = 0_IntKi !< Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1] [-] + INTEGER(IntKi) :: totalStates = 0_IntKi !< Number of excitation and radiation states for all WAMIT bodies [-] + INTEGER(IntKi) :: totalExctnStates = 0_IntKi !< Number of excitation states for all WAMIT bodies [-] + INTEGER(IntKi) :: totalRdtnStates = 0_IntKi !< Number of radiation states for all WAMIT bodies [-] REAL(SiKi) , DIMENSION(:), POINTER :: WaveTime => NULL() !< Array of time samples, (sec) [-] - INTEGER(IntKi) :: NStepWave !< Number of data points in the wave kinematics arrays [-] - REAL(ReKi) :: WtrDpth !< Water depth [(m)] + INTEGER(IntKi) :: NStepWave = 0_IntKi !< Number of data points in the wave kinematics arrays [-] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [(m)] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AddF0 !< Additional pre-load forces and moments (N,N,N,N-m,N-m,N-m) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AddCLin !< Additional stiffness matrix [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AddBLin !< Additional linear damping matrix [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AddBQuad !< Additional quadratic damping (drag) matrix [-] - REAL(DbKi) :: DT !< Time step in seconds for integration of continuous states (if a fixed-step integrator is used) and update of discrete states [-] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step in seconds for integration of continuous states (if a fixed-step integrator is used) and update of discrete states [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< [-] - INTEGER(IntKi) :: NumOuts !< Number of HydroDyn module-level outputs (not the total number including sub-modules [-] - INTEGER(IntKi) :: NumTotalOuts !< Number of all requested outputs including sub-modules [-] - INTEGER(IntKi) :: OutSwtch !< Output requested channels to: [1=Hydrodyn.out 2=GlueCode.out 3=both files] [-] - CHARACTER(20) :: OutFmt !< Output format for numerical results [-] - CHARACTER(20) :: OutSFmt !< Output format for header strings [-] - CHARACTER(ChanLen) :: Delim !< Delimiter string for outputs, defaults to tab-delimiters [-] - INTEGER(IntKi) :: UnOutFile !< File unit for the HydroDyn outputs [-] - INTEGER(IntKi) :: OutDec !< Write every OutDec time steps [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of HydroDyn module-level outputs (not the total number including sub-modules [-] + INTEGER(IntKi) :: NumTotalOuts = 0_IntKi !< Number of all requested outputs including sub-modules [-] + INTEGER(IntKi) :: OutSwtch = 0_IntKi !< Output requested channels to: [1=Hydrodyn.out 2=GlueCode.out 3=both files] [-] + CHARACTER(20) :: OutFmt = '' !< Output format for numerical results [-] + CHARACTER(20) :: OutSFmt = '' !< Output format for header strings [-] + CHARACTER(ChanLen) :: Delim = '' !< Delimiter string for outputs, defaults to tab-delimiters [-] + INTEGER(IntKi) :: UnOutFile = 0_IntKi !< File unit for the HydroDyn outputs [-] + INTEGER(IntKi) :: OutDec = 0_IntKi !< Write every OutDec time steps [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: du !< vector that determines size of perturbation for u (inputs) [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: dx !< vector that determines size of perturbation for x (continuous states) [-] - INTEGER(IntKi) :: Jac_ny !< number of outputs in jacobian matrix [-] + INTEGER(IntKi) :: Jac_ny = 0_IntKi !< number of outputs in jacobian matrix [-] LOGICAL :: PointsToSeaState = .TRUE. !< Flag that determines if the data contains pointers to SeaState module or if new copies (from restart) [-] END TYPE HydroDyn_ParameterType ! ======================= diff --git a/modules/hydrodyn/src/Morison_Types.f90 b/modules/hydrodyn/src/Morison_Types.f90 index a420bd55ec..e6c493c76c 100644 --- a/modules/hydrodyn/src/Morison_Types.f90 +++ b/modules/hydrodyn/src/Morison_Types.f90 @@ -37,116 +37,116 @@ MODULE Morison_Types IMPLICIT NONE ! ========= Morison_JointType ======= TYPE, PUBLIC :: Morison_JointType - INTEGER(IntKi) :: JointID !< User-specified integer ID for the given joint [-] - REAL(ReKi) , DIMENSION(1:3) :: Position !< Undisplaced location of the joint in the platform coordinate system [m] - INTEGER(IntKi) :: JointAxID !< Axial ID (found in the user-supplied Axial Coefficients Table) for this joint: used to determine axial coefs [-] - INTEGER(IntKi) :: JointAxIDIndx !< The index into the Axial Coefs arrays corresponding to the above Axial ID [-] - INTEGER(IntKi) :: JointOvrlp !< Joint overlap code [Unused [-] - INTEGER(IntKi) :: NConnections !< Number of members connecting to this joint [-] - INTEGER(IntKi) , DIMENSION(1:50) :: ConnectionList !< List of Members connected to this joint. The member index is what is stored, not the Member ID [-] + INTEGER(IntKi) :: JointID = 0_IntKi !< User-specified integer ID for the given joint [-] + REAL(ReKi) , DIMENSION(1:3) :: Position = 0.0_ReKi !< Undisplaced location of the joint in the platform coordinate system [m] + INTEGER(IntKi) :: JointAxID = 0_IntKi !< Axial ID (found in the user-supplied Axial Coefficients Table) for this joint: used to determine axial coefs [-] + INTEGER(IntKi) :: JointAxIDIndx = 0_IntKi !< The index into the Axial Coefs arrays corresponding to the above Axial ID [-] + INTEGER(IntKi) :: JointOvrlp = 0_IntKi !< Joint overlap code [Unused [-] + INTEGER(IntKi) :: NConnections = 0_IntKi !< Number of members connecting to this joint [-] + INTEGER(IntKi) , DIMENSION(1:50) :: ConnectionList = 0_IntKi !< List of Members connected to this joint. The member index is what is stored, not the Member ID [-] END TYPE Morison_JointType ! ======================= ! ========= Morison_MemberPropType ======= TYPE, PUBLIC :: Morison_MemberPropType - INTEGER(IntKi) :: PropSetID !< User-specified integer ID for this group of properties [-] - REAL(ReKi) :: PropD !< Diameter [m] - REAL(ReKi) :: PropThck !< Wall thickness [m] + INTEGER(IntKi) :: PropSetID = 0_IntKi !< User-specified integer ID for this group of properties [-] + REAL(ReKi) :: PropD = 0.0_ReKi !< Diameter [m] + REAL(ReKi) :: PropThck = 0.0_ReKi !< Wall thickness [m] END TYPE Morison_MemberPropType ! ======================= ! ========= Morison_FilledGroupType ======= TYPE, PUBLIC :: Morison_FilledGroupType - INTEGER(IntKi) :: FillNumM !< Number of members in the Fill Group [-] + INTEGER(IntKi) :: FillNumM = 0_IntKi !< Number of members in the Fill Group [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: FillMList !< List of Member IDs for the members in this fill group [-] - REAL(ReKi) :: FillFSLoc !< The free-surface location (in Z) for this fill group [m] - CHARACTER(80) :: FillDensChr !< String version of the Fill density [can be DEFAULT which sets the fill density to WtrDens] [kg/m^3] - REAL(ReKi) :: FillDens !< Numerical fill density [kg/m^3] + REAL(ReKi) :: FillFSLoc = 0.0_ReKi !< The free-surface location (in Z) for this fill group [m] + CHARACTER(80) :: FillDensChr = '' !< String version of the Fill density [can be DEFAULT which sets the fill density to WtrDens] [kg/m^3] + REAL(ReKi) :: FillDens = 0.0_ReKi !< Numerical fill density [kg/m^3] END TYPE Morison_FilledGroupType ! ======================= ! ========= Morison_CoefDpths ======= TYPE, PUBLIC :: Morison_CoefDpths - REAL(ReKi) :: Dpth !< Depth location for these depth-based hydrodynamic coefs [m] - REAL(ReKi) :: DpthCd !< Depth-based drag coef [-] - REAL(ReKi) :: DpthCdMG !< Depth-based drag coef for marine growth [-] - REAL(ReKi) :: DpthCa !< Depth-based Ca [-] - REAL(ReKi) :: DpthCaMG !< Depth-based Ca for marine growth [-] - REAL(ReKi) :: DpthCp !< Depth-based Cp [-] - REAL(ReKi) :: DpthCpMG !< Depth-based Cp for marine growth [-] - REAL(ReKi) :: DpthAxCd !< Depth-based Axial Cd [-] - REAL(ReKi) :: DpthAxCdMG !< Depth-based Axial Cd for marine growth [-] - REAL(ReKi) :: DpthAxCa !< Depth-based Axial Ca [-] - REAL(ReKi) :: DpthAxCaMG !< Depth-based Axial Ca for marine growth [-] - REAL(ReKi) :: DpthAxCp !< Depth-based Axial Cp [-] - REAL(ReKi) :: DpthAxCpMG !< Depth-based Axial Cp for marine growth [-] - REAL(ReKi) :: DpthCb !< Simple model hydrostatic/buoyancy load coefficient [-] - REAL(ReKi) :: DpthCbMg !< Simple model hydrostatic/buoyancy load coefficient for marine growth [-] - LOGICAL :: DpthMCF !< Flag T/F for whether the member is modeled with the MacCamy-Fuchs diffraction model [-] + REAL(ReKi) :: Dpth = 0.0_ReKi !< Depth location for these depth-based hydrodynamic coefs [m] + REAL(ReKi) :: DpthCd = 0.0_ReKi !< Depth-based drag coef [-] + REAL(ReKi) :: DpthCdMG = 0.0_ReKi !< Depth-based drag coef for marine growth [-] + REAL(ReKi) :: DpthCa = 0.0_ReKi !< Depth-based Ca [-] + REAL(ReKi) :: DpthCaMG = 0.0_ReKi !< Depth-based Ca for marine growth [-] + REAL(ReKi) :: DpthCp = 0.0_ReKi !< Depth-based Cp [-] + REAL(ReKi) :: DpthCpMG = 0.0_ReKi !< Depth-based Cp for marine growth [-] + REAL(ReKi) :: DpthAxCd = 0.0_ReKi !< Depth-based Axial Cd [-] + REAL(ReKi) :: DpthAxCdMG = 0.0_ReKi !< Depth-based Axial Cd for marine growth [-] + REAL(ReKi) :: DpthAxCa = 0.0_ReKi !< Depth-based Axial Ca [-] + REAL(ReKi) :: DpthAxCaMG = 0.0_ReKi !< Depth-based Axial Ca for marine growth [-] + REAL(ReKi) :: DpthAxCp = 0.0_ReKi !< Depth-based Axial Cp [-] + REAL(ReKi) :: DpthAxCpMG = 0.0_ReKi !< Depth-based Axial Cp for marine growth [-] + REAL(ReKi) :: DpthCb = 0.0_ReKi !< Simple model hydrostatic/buoyancy load coefficient [-] + REAL(ReKi) :: DpthCbMg = 0.0_ReKi !< Simple model hydrostatic/buoyancy load coefficient for marine growth [-] + LOGICAL :: DpthMCF = .false. !< Flag T/F for whether the member is modeled with the MacCamy-Fuchs diffraction model [-] END TYPE Morison_CoefDpths ! ======================= ! ========= Morison_AxialCoefType ======= TYPE, PUBLIC :: Morison_AxialCoefType - INTEGER(IntKi) :: AxCoefID !< User-supplied integer ID for this set of Axial coefs [-] - REAL(ReKi) :: AxCd !< Axial Cd [-] - REAL(ReKi) :: AxCa !< Axial Ca [-] - REAL(ReKi) :: AxCp !< Axial Cp [-] - REAL(ReKi) :: AxVnCOff !< High-pass cut-off frequency for normal velocity when computing axial drag force [-] - REAL(ReKi) :: AxFDLoFSc !< Scaling factor for low frequency axial drag force [-] - INTEGER(IntKi) :: AxFDMod !< Switch for the axial drag formulation {0: original formulation, 1: Away from member only} [-] + INTEGER(IntKi) :: AxCoefID = 0_IntKi !< User-supplied integer ID for this set of Axial coefs [-] + REAL(ReKi) :: AxCd = 0.0_ReKi !< Axial Cd [-] + REAL(ReKi) :: AxCa = 0.0_ReKi !< Axial Ca [-] + REAL(ReKi) :: AxCp = 0.0_ReKi !< Axial Cp [-] + REAL(ReKi) :: AxVnCOff = 0.0_ReKi !< High-pass cut-off frequency for normal velocity when computing axial drag force [-] + REAL(ReKi) :: AxFDLoFSc = 0.0_ReKi !< Scaling factor for low frequency axial drag force [-] + INTEGER(IntKi) :: AxFDMod = 0_IntKi !< Switch for the axial drag formulation {0: original formulation, 1: Away from member only} [-] END TYPE Morison_AxialCoefType ! ======================= ! ========= Morison_MemberInputType ======= TYPE, PUBLIC :: Morison_MemberInputType - INTEGER(IntKi) :: MemberID !< User-supplied integer ID for this member [-] + INTEGER(IntKi) :: MemberID = 0_IntKi !< User-supplied integer ID for this member [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NodeIndx !< Index of each of the member's nodes in the master node list [-] - INTEGER(IntKi) :: MJointID1 !< Joint ID for start of member [-] - INTEGER(IntKi) :: MJointID2 !< Joint ID for end of member [-] - INTEGER(IntKi) :: MJointID1Indx !< Index into the joint table for the start of this member [-] - INTEGER(IntKi) :: MJointID2Indx !< Index into the joint table for the end of this member [-] - INTEGER(IntKi) :: MPropSetID1 !< Property set ID for the start of this member [-] - INTEGER(IntKi) :: MPropSetID2 !< Property set ID for the end of this member [-] - INTEGER(IntKi) :: MPropSetID1Indx !< Index into the Property table for the start of this member [-] - INTEGER(IntKi) :: MPropSetID2Indx !< Index into the Property table for the end of this member [-] - REAL(ReKi) :: MDivSize !< User-specified desired member discretization size for the final element [m] - INTEGER(IntKi) :: MCoefMod !< Which coef. model is being used for this member [1=simple, 2=depth-based, 3=member-based] [-] - INTEGER(IntKi) :: MHstLMod !< Which hydrostatic model is being used for this member [1=column-type, 2=ship-type] [-] - INTEGER(IntKi) :: MmbrCoefIDIndx !< Index into the appropriate coefs table for this member's properties [-] - INTEGER(IntKi) :: MmbrFilledIDIndx !< Index into the filled group table if this is a filled member [-] - LOGICAL :: PropPot !< Flag T/F for whether the member is modeled with potential flow theory [-] - LOGICAL :: PropMCF !< Flag T/F for whether the member is modeled with the MacCamy-Fuchs diffraction model [-] - INTEGER(IntKi) :: NElements !< number of elements in this member [-] - REAL(ReKi) :: RefLength !< the reference total length for this member [m] - REAL(ReKi) :: dl !< the reference element length for this member (may be less than MDivSize to achieve uniform element lengths) [m] + INTEGER(IntKi) :: MJointID1 = 0_IntKi !< Joint ID for start of member [-] + INTEGER(IntKi) :: MJointID2 = 0_IntKi !< Joint ID for end of member [-] + INTEGER(IntKi) :: MJointID1Indx = 0_IntKi !< Index into the joint table for the start of this member [-] + INTEGER(IntKi) :: MJointID2Indx = 0_IntKi !< Index into the joint table for the end of this member [-] + INTEGER(IntKi) :: MPropSetID1 = 0_IntKi !< Property set ID for the start of this member [-] + INTEGER(IntKi) :: MPropSetID2 = 0_IntKi !< Property set ID for the end of this member [-] + INTEGER(IntKi) :: MPropSetID1Indx = 0_IntKi !< Index into the Property table for the start of this member [-] + INTEGER(IntKi) :: MPropSetID2Indx = 0_IntKi !< Index into the Property table for the end of this member [-] + REAL(ReKi) :: MDivSize = 0.0_ReKi !< User-specified desired member discretization size for the final element [m] + INTEGER(IntKi) :: MCoefMod = 0_IntKi !< Which coef. model is being used for this member [1=simple, 2=depth-based, 3=member-based] [-] + INTEGER(IntKi) :: MHstLMod = 0_IntKi !< Which hydrostatic model is being used for this member [1=column-type, 2=ship-type] [-] + INTEGER(IntKi) :: MmbrCoefIDIndx = 0_IntKi !< Index into the appropriate coefs table for this member's properties [-] + INTEGER(IntKi) :: MmbrFilledIDIndx = 0_IntKi !< Index into the filled group table if this is a filled member [-] + LOGICAL :: PropPot = .false. !< Flag T/F for whether the member is modeled with potential flow theory [-] + LOGICAL :: PropMCF = .false. !< Flag T/F for whether the member is modeled with the MacCamy-Fuchs diffraction model [-] + INTEGER(IntKi) :: NElements = 0_IntKi !< number of elements in this member [-] + REAL(ReKi) :: RefLength = 0.0_ReKi !< the reference total length for this member [m] + REAL(ReKi) :: dl = 0.0_ReKi !< the reference element length for this member (may be less than MDivSize to achieve uniform element lengths) [m] END TYPE Morison_MemberInputType ! ======================= ! ========= Morison_NodeType ======= TYPE, PUBLIC :: Morison_NodeType - INTEGER(IntKi) :: JointIndx !< Joint index from the user joint table that this node corresponds to. If the software created this node, index is set to -1 [-] - REAL(ReKi) , DIMENSION(1:3) :: Position !< Position of the node in global coordinates [m] - INTEGER(IntKi) :: JointOvrlp !< [-] - INTEGER(IntKi) :: JointAxIDIndx !< [-] - INTEGER(IntKi) :: NConnections !< Number of elements connecting to this node [-] - INTEGER(IntKi) , DIMENSION(1:50) :: ConnectionList !< Indices of all the members connected to this node (positive if end 1, negative if end 2) [-] - REAL(ReKi) :: JAxCd !< Nodal lumped (joint) axial Cd [-] - REAL(ReKi) :: JAxCa !< Nodal lumped (joint) axial Cp [-] - REAL(ReKi) :: JAxCp !< Nodal lumped (joint) axial Ca [-] - REAL(ReKi) :: JAxVnCOff !< High-pass cut-off frequency for normal velocity when computing axial drag force [-] - REAL(ReKi) :: JAxFDLoFSc !< Scaling factor for low frequency axial drag force [-] - INTEGER(IntKi) :: JAxFDMod !< Switch for the axial drag formulation {0: original formulation, 1: Away from member only} [-] - REAL(ReKi) :: FillDensity !< Fill fluid density [kg/m^3] - REAL(ReKi) :: tMG !< Nodal thickness with marine growth [m] - REAL(ReKi) :: MGdensity !< Nodal density of marine growth [kg/m^3] + INTEGER(IntKi) :: JointIndx = 0_IntKi !< Joint index from the user joint table that this node corresponds to. If the software created this node, index is set to -1 [-] + REAL(ReKi) , DIMENSION(1:3) :: Position = 0.0_ReKi !< Position of the node in global coordinates [m] + INTEGER(IntKi) :: JointOvrlp = 0_IntKi !< [-] + INTEGER(IntKi) :: JointAxIDIndx = 0_IntKi !< [-] + INTEGER(IntKi) :: NConnections = 0_IntKi !< Number of elements connecting to this node [-] + INTEGER(IntKi) , DIMENSION(1:50) :: ConnectionList = 0_IntKi !< Indices of all the members connected to this node (positive if end 1, negative if end 2) [-] + REAL(ReKi) :: JAxCd = 0.0_ReKi !< Nodal lumped (joint) axial Cd [-] + REAL(ReKi) :: JAxCa = 0.0_ReKi !< Nodal lumped (joint) axial Cp [-] + REAL(ReKi) :: JAxCp = 0.0_ReKi !< Nodal lumped (joint) axial Ca [-] + REAL(ReKi) :: JAxVnCOff = 0.0_ReKi !< High-pass cut-off frequency for normal velocity when computing axial drag force [-] + REAL(ReKi) :: JAxFDLoFSc = 0.0_ReKi !< Scaling factor for low frequency axial drag force [-] + INTEGER(IntKi) :: JAxFDMod = 0_IntKi !< Switch for the axial drag formulation {0: original formulation, 1: Away from member only} [-] + REAL(ReKi) :: FillDensity = 0.0_ReKi !< Fill fluid density [kg/m^3] + REAL(ReKi) :: tMG = 0.0_ReKi !< Nodal thickness with marine growth [m] + REAL(ReKi) :: MGdensity = 0.0_ReKi !< Nodal density of marine growth [kg/m^3] END TYPE Morison_NodeType ! ======================= ! ========= Morison_MemberType ======= TYPE, PUBLIC :: Morison_MemberType INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NodeIndx !< Index of each of the member's nodes in the master node list [-] - INTEGER(IntKi) :: MemberID !< User-supplied integer ID for this member [-] - INTEGER(IntKi) :: NElements !< number of elements in this member [-] - REAL(ReKi) :: RefLength !< the reference total length for this member [m] - REAL(ReKi) :: cosPhi_ref !< the reference cosine of the inclination angle of the member [-] - REAL(ReKi) :: dl !< the reference element length for this member (may be less than MDivSize to achieve uniform element lengths) [m] - REAL(ReKi) , DIMENSION(1:3) :: k !< unit vector of the member's orientation (may be changed to per-element once additional flexibility is accounted for in HydroDyn) [m] - REAL(ReKi) , DIMENSION(1:3,1:3) :: kkt !< matrix of matmul(k_hat, transpose(k_hat) [-] - REAL(ReKi) , DIMENSION(1:3,1:3) :: Ak !< matrix of I - kkt [-] + INTEGER(IntKi) :: MemberID = 0_IntKi !< User-supplied integer ID for this member [-] + INTEGER(IntKi) :: NElements = 0_IntKi !< number of elements in this member [-] + REAL(ReKi) :: RefLength = 0.0_ReKi !< the reference total length for this member [m] + REAL(ReKi) :: cosPhi_ref = 0.0_ReKi !< the reference cosine of the inclination angle of the member [-] + REAL(ReKi) :: dl = 0.0_ReKi !< the reference element length for this member (may be less than MDivSize to achieve uniform element lengths) [m] + REAL(ReKi) , DIMENSION(1:3) :: k = 0.0_ReKi !< unit vector of the member's orientation (may be changed to per-element once additional flexibility is accounted for in HydroDyn) [m] + REAL(ReKi) , DIMENSION(1:3,1:3) :: kkt = 0.0_ReKi !< matrix of matmul(k_hat, transpose(k_hat) [-] + REAL(ReKi) , DIMENSION(1:3,1:3) :: Ak = 0.0_ReKi !< matrix of I - kkt [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: R !< outer member radius at each node [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: RMG !< radius at each node including marine growth [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: RMGB !< radius at each node including marine growth scaled by sqrt(Cb) [m] @@ -156,17 +156,17 @@ MODULE Morison_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dRdl_mg !< taper dr/dl of outer surface including marine growth of each element [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dRdl_mg_b !< taper dr/dl of outer surface including marine growth of each element with scaling of sqrt(Cb) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dRdl_in !< taper dr/dl of interior surface of each element [-] - REAL(ReKi) :: Vinner !< Member volume without marine growth [m^3] - REAL(ReKi) :: Vouter !< Member volume including marine growth [m^3] - REAL(ReKi) :: Vballast !< Member ballast volume [m^3] - REAL(ReKi) :: Vsubmerged !< Submerged volume corresponding to portion of Member in the water [m^3] - REAL(ReKi) :: l_fill !< fill length along member axis from start node 1 [m] - REAL(ReKi) :: h_fill !< fill length of partially flooded element [m] - REAL(ReKi) :: z_overfill !< if member is fully filled, the head height of the fill pressure at the end node N+1. Zero if member is partially filled. [m] - REAL(ReKi) :: h_floor !< the distance from the node to the seabed along the member axis (negative value) [m] - INTEGER(IntKi) :: i_floor !< the number of the element that pierces the seabed (zero if the member doesn't pierce it) [-] - LOGICAL :: doEndBuoyancy !< compute the end plate effect for the hightest node of this member [-] - INTEGER(IntKi) :: memfloodstatus !< Member-level flooded status for each elemen: 0 unflooded or fully below seabed, 2 partially flooded, 1 fully flooded [-] + REAL(ReKi) :: Vinner = 0.0_ReKi !< Member volume without marine growth [m^3] + REAL(ReKi) :: Vouter = 0.0_ReKi !< Member volume including marine growth [m^3] + REAL(ReKi) :: Vballast = 0.0_ReKi !< Member ballast volume [m^3] + REAL(ReKi) :: Vsubmerged = 0.0_ReKi !< Submerged volume corresponding to portion of Member in the water [m^3] + REAL(ReKi) :: l_fill = 0.0_ReKi !< fill length along member axis from start node 1 [m] + REAL(ReKi) :: h_fill = 0.0_ReKi !< fill length of partially flooded element [m] + REAL(ReKi) :: z_overfill = 0.0_ReKi !< if member is fully filled, the head height of the fill pressure at the end node N+1. Zero if member is partially filled. [m] + REAL(ReKi) :: h_floor = 0.0_ReKi !< the distance from the node to the seabed along the member axis (negative value) [m] + INTEGER(IntKi) :: i_floor = 0_IntKi !< the number of the element that pierces the seabed (zero if the member doesn't pierce it) [-] + LOGICAL :: doEndBuoyancy = .false. !< compute the end plate effect for the hightest node of this member [-] + INTEGER(IntKi) :: memfloodstatus = 0_IntKi !< Member-level flooded status for each elemen: 0 unflooded or fully below seabed, 2 partially flooded, 1 fully flooded [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: floodstatus !< flooded status for each element: 0 unflooded or fully below seabed, 1 fully flooded, 2 partially flooded [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: alpha !< relative volume centroid of each element including marine growth, from node i to node i+1 [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: alpha_fb !< relative volume centroid of each element's flooded ballast, from node i to node i+1 [-] @@ -197,17 +197,17 @@ MODULE Morison_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Cfl_fb !< axial force constant due to flooded ballast, for each element [N] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Cfr_fb !< radial force constant due to flooded ballast, for each element [N] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: CM0_fb !< moment constant due to flooded ballast, for each element about lower node [Nm] - REAL(ReKi) :: MGvolume !< Volume of marine growth material for this member/element [m^3] - REAL(ReKi) :: MDivSize !< User-requested final element length (actual length may vary from this request) [m] - INTEGER(IntKi) :: MCoefMod !< Coefs model for member: 1 = simple, 2 =depth, 3 = member-based [-] - INTEGER(IntKi) :: MmbrCoefIDIndx !< If MCoefMod=3, then this is the index for the member's coefs in the master Member Coefs Table [-] - INTEGER(IntKi) :: MmbrFilledIDIndx !< If this member is part of a fill group, this is the index into the master fill group table, if not = -1 [-] - INTEGER(IntKi) :: MHstLMod !< Hydrostatic model for member [1=column-type, 2=ship-type] [-] - REAL(ReKi) :: FillFSLoc !< Z-location of the filled free-surface [m] - REAL(ReKi) :: FillDens !< Filled fluid density [kg/m^3] - LOGICAL :: PropPot !< Is this element/member modeled with potential flow theory T/F [-] - LOGICAL :: PropMCF !< Flag T/F for whether the member is modeled with the MacCamy-Fuchs diffraction model [-] - LOGICAL :: Flipped !< Was the member flipped in a reordering event? Need to know this to get the correct normal vector to the ends [-] + REAL(ReKi) :: MGvolume = 0.0_ReKi !< Volume of marine growth material for this member/element [m^3] + REAL(ReKi) :: MDivSize = 0.0_ReKi !< User-requested final element length (actual length may vary from this request) [m] + INTEGER(IntKi) :: MCoefMod = 0_IntKi !< Coefs model for member: 1 = simple, 2 =depth, 3 = member-based [-] + INTEGER(IntKi) :: MmbrCoefIDIndx = 0_IntKi !< If MCoefMod=3, then this is the index for the member's coefs in the master Member Coefs Table [-] + INTEGER(IntKi) :: MmbrFilledIDIndx = 0_IntKi !< If this member is part of a fill group, this is the index into the master fill group table, if not = -1 [-] + INTEGER(IntKi) :: MHstLMod = 0_IntKi !< Hydrostatic model for member [1=column-type, 2=ship-type] [-] + REAL(ReKi) :: FillFSLoc = 0.0_ReKi !< Z-location of the filled free-surface [m] + REAL(ReKi) :: FillDens = 0.0_ReKi !< Filled fluid density [kg/m^3] + LOGICAL :: PropPot = .false. !< Is this element/member modeled with potential flow theory T/F [-] + LOGICAL :: PropMCF = .false. !< Flag T/F for whether the member is modeled with the MacCamy-Fuchs diffraction model [-] + LOGICAL :: Flipped = .false. !< Was the member flipped in a reordering event? Need to know this to get the correct normal vector to the ends [-] END TYPE Morison_MemberType ! ======================= ! ========= Morison_MemberLoads ======= @@ -227,51 +227,51 @@ MODULE Morison_Types ! ======================= ! ========= Morison_CoefMembers ======= TYPE, PUBLIC :: Morison_CoefMembers - INTEGER(IntKi) :: MemberID !< User-specified integer id for the Member-based coefs [-] - REAL(ReKi) :: MemberCd1 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberCd2 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberCdMG1 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberCdMG2 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberCa1 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberCa2 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberCaMG1 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberCaMG2 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberCp1 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberCp2 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberCpMG1 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberCpMG2 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberAxCd1 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberAxCd2 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberAxCdMG1 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberAxCdMG2 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberAxCa1 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberAxCa2 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberAxCaMG1 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberAxCaMG2 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberAxCp1 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberAxCp2 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberAxCpMG1 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberAxCpMG2 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberCb1 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberCb2 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberCbMG1 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - REAL(ReKi) :: MemberCbMG2 !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] - LOGICAL :: MemberMCF !< Flag T/F for whether the member is modeled with the MacCamy-Fuchs diffraction model [-] + INTEGER(IntKi) :: MemberID = 0_IntKi !< User-specified integer id for the Member-based coefs [-] + REAL(ReKi) :: MemberCd1 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberCd2 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberCdMG1 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberCdMG2 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberCa1 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberCa2 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberCaMG1 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberCaMG2 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberCp1 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberCp2 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberCpMG1 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberCpMG2 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberAxCd1 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberAxCd2 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberAxCdMG1 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberAxCdMG2 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberAxCa1 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberAxCa2 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberAxCaMG1 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberAxCaMG2 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberAxCp1 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberAxCp2 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberAxCpMG1 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberAxCpMG2 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberCb1 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberCb2 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberCbMG1 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + REAL(ReKi) :: MemberCbMG2 = 0.0_ReKi !< Member-based coefs, see above descriptions for meanings (1 = start, 2=end) [-] + LOGICAL :: MemberMCF = .false. !< Flag T/F for whether the member is modeled with the MacCamy-Fuchs diffraction model [-] END TYPE Morison_CoefMembers ! ======================= ! ========= Morison_MGDepthsType ======= TYPE, PUBLIC :: Morison_MGDepthsType - REAL(ReKi) :: MGDpth !< Marine growth depth location for these properties [m] - REAL(ReKi) :: MGThck !< Marine growth thickness [m] - REAL(ReKi) :: MGDens !< Marine growth density [kg/m^3] + REAL(ReKi) :: MGDpth = 0.0_ReKi !< Marine growth depth location for these properties [m] + REAL(ReKi) :: MGThck = 0.0_ReKi !< Marine growth thickness [m] + REAL(ReKi) :: MGDens = 0.0_ReKi !< Marine growth density [kg/m^3] END TYPE Morison_MGDepthsType ! ======================= ! ========= Morison_MOutput ======= TYPE, PUBLIC :: Morison_MOutput - INTEGER(IntKi) :: MemberID !< Member ID for requested output [-] - INTEGER(IntKi) :: NOutLoc !< The number of requested output locations [-] + INTEGER(IntKi) :: MemberID = 0_IntKi !< Member ID for requested output [-] + INTEGER(IntKi) :: NOutLoc = 0_IntKi !< The number of requested output locations [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: NodeLocs !< Normalized locations along user-specified member for the outputs [-] - INTEGER(IntKi) :: MemberIDIndx !< Index for member in the master list [-] + INTEGER(IntKi) :: MemberIDIndx = 0_IntKi !< Index for member in the master list [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: MeshIndx1 !< Index of node in Mesh for the start of the member element [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: MeshIndx2 !< Index of node in Mesh for the end of the member element [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: MemberIndx1 !< Index of Member nodes for the start of the member element [-] @@ -281,63 +281,63 @@ MODULE Morison_Types ! ======================= ! ========= Morison_JOutput ======= TYPE, PUBLIC :: Morison_JOutput - INTEGER(IntKi) :: JointID !< Joint ID for the requested output [-] - INTEGER(IntKi) :: JointIDIndx !< Joint index in the master list [-] + INTEGER(IntKi) :: JointID = 0_IntKi !< Joint ID for the requested output [-] + INTEGER(IntKi) :: JointIDIndx = 0_IntKi !< Joint index in the master list [-] END TYPE Morison_JOutput ! ======================= ! ========= Morison_InitInputType ======= TYPE, PUBLIC :: Morison_InitInputType - REAL(ReKi) :: Gravity !< Gravity (scalar, positive-valued) [m/s^2] - REAL(ReKi) :: WtrDens !< Water density [kg/m^3] - REAL(ReKi) :: WtrDpth !< Water depth (positive-valued) [m] - REAL(ReKi) :: MSL2SWL !< Mean Sea Level to Still Water Level offset [m] - INTEGER(IntKi) :: WaveDisp !< Method of computing Wave Kinematics. (0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [-] - INTEGER(IntKi) :: AMMod !< Method of computing distributed added-mass force. (0: Only and always on nodes below SWL at the undisplaced position. 1: Up to the instantaneous free surface) [overwrite to 0 when WaveMod = 0 or 6 or when WaveStMod = 0 in SeaState] [-] - INTEGER(IntKi) :: NJoints !< Number of user-specified joints [-] - INTEGER(IntKi) :: NNodes !< Total number of nodes in the final software model [-] + REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravity (scalar, positive-valued) [m/s^2] + REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density [kg/m^3] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth (positive-valued) [m] + REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Mean Sea Level to Still Water Level offset [m] + INTEGER(IntKi) :: WaveDisp = 0_IntKi !< Method of computing Wave Kinematics. (0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [-] + INTEGER(IntKi) :: AMMod = 0_IntKi !< Method of computing distributed added-mass force. (0: Only and always on nodes below SWL at the undisplaced position. 1: Up to the instantaneous free surface) [overwrite to 0 when WaveMod = 0 or 6 or when WaveStMod = 0 in SeaState] [-] + INTEGER(IntKi) :: NJoints = 0_IntKi !< Number of user-specified joints [-] + INTEGER(IntKi) :: NNodes = 0_IntKi !< Total number of nodes in the final software model [-] TYPE(Morison_JointType) , DIMENSION(:), ALLOCATABLE :: InpJoints !< Array of user-specified joints [-] TYPE(Morison_NodeType) , DIMENSION(:), ALLOCATABLE :: Nodes !< Array of simulation node (some correspond to user-specified joints, others are created by software) [-] - INTEGER(IntKi) :: NAxCoefs !< Number of axial Coefs entries in input file table [-] + INTEGER(IntKi) :: NAxCoefs = 0_IntKi !< Number of axial Coefs entries in input file table [-] TYPE(Morison_AxialCoefType) , DIMENSION(:), ALLOCATABLE :: AxialCoefs !< List of axial coefs [-] - INTEGER(IntKi) :: NPropSets !< Number of member property sets [-] + INTEGER(IntKi) :: NPropSets = 0_IntKi !< Number of member property sets [-] TYPE(Morison_MemberPropType) , DIMENSION(:), ALLOCATABLE :: MPropSets !< List of Member property sets [-] - REAL(ReKi) :: SimplCd !< Simple model drag coef [-] - REAL(ReKi) :: SimplCdMG !< Simple model drag coef for marine growth [-] - REAL(ReKi) :: SimplCa !< Simple model Ca [-] - REAL(ReKi) :: SimplCaMG !< Simple model Ca for marine growth [-] - REAL(ReKi) :: SimplCp !< Simple model Cp [-] - REAL(ReKi) :: SimplCpMG !< Simple model Cp for marine growth [-] - REAL(ReKi) :: SimplAxCd !< Simple model Axial Cd [-] - REAL(ReKi) :: SimplAxCdMG !< Simple model Axial Cd for marine growth [-] - REAL(ReKi) :: SimplAxCa !< Simple model Axial Ca [-] - REAL(ReKi) :: SimplAxCaMG !< Simple model Axial Ca for marine growth [-] - REAL(ReKi) :: SimplAxCp !< Simple model Axial Cp [-] - REAL(ReKi) :: SimplAxCpMG !< Simple model Axial Cp for marine growth [-] - REAL(ReKi) :: SimplCb !< Simple model hydrostatic/buoyancy load coefficient [-] - REAL(ReKi) :: SimplCbMg !< Simple model hydrostatic/buoyancy load coefficient for marine growth [-] - LOGICAL :: SimplMCF !< Flag T/F for whether the member is modeled with the MacCamy-Fuchs diffraction model [-] - INTEGER(IntKi) :: NCoefDpth !< [-] + REAL(ReKi) :: SimplCd = 0.0_ReKi !< Simple model drag coef [-] + REAL(ReKi) :: SimplCdMG = 0.0_ReKi !< Simple model drag coef for marine growth [-] + REAL(ReKi) :: SimplCa = 0.0_ReKi !< Simple model Ca [-] + REAL(ReKi) :: SimplCaMG = 0.0_ReKi !< Simple model Ca for marine growth [-] + REAL(ReKi) :: SimplCp = 0.0_ReKi !< Simple model Cp [-] + REAL(ReKi) :: SimplCpMG = 0.0_ReKi !< Simple model Cp for marine growth [-] + REAL(ReKi) :: SimplAxCd = 0.0_ReKi !< Simple model Axial Cd [-] + REAL(ReKi) :: SimplAxCdMG = 0.0_ReKi !< Simple model Axial Cd for marine growth [-] + REAL(ReKi) :: SimplAxCa = 0.0_ReKi !< Simple model Axial Ca [-] + REAL(ReKi) :: SimplAxCaMG = 0.0_ReKi !< Simple model Axial Ca for marine growth [-] + REAL(ReKi) :: SimplAxCp = 0.0_ReKi !< Simple model Axial Cp [-] + REAL(ReKi) :: SimplAxCpMG = 0.0_ReKi !< Simple model Axial Cp for marine growth [-] + REAL(ReKi) :: SimplCb = 0.0_ReKi !< Simple model hydrostatic/buoyancy load coefficient [-] + REAL(ReKi) :: SimplCbMg = 0.0_ReKi !< Simple model hydrostatic/buoyancy load coefficient for marine growth [-] + LOGICAL :: SimplMCF = .false. !< Flag T/F for whether the member is modeled with the MacCamy-Fuchs diffraction model [-] + INTEGER(IntKi) :: NCoefDpth = 0_IntKi !< [-] TYPE(Morison_CoefDpths) , DIMENSION(:), ALLOCATABLE :: CoefDpths !< [-] - INTEGER(IntKi) :: NCoefMembers !< [-] + INTEGER(IntKi) :: NCoefMembers = 0_IntKi !< [-] TYPE(Morison_CoefMembers) , DIMENSION(:), ALLOCATABLE :: CoefMembers !< [-] - INTEGER(IntKi) :: NMembers !< Number of user-specified members in the input file [-] + INTEGER(IntKi) :: NMembers = 0_IntKi !< Number of user-specified members in the input file [-] TYPE(Morison_MemberInputType) , DIMENSION(:), ALLOCATABLE :: InpMembers !< Array of user-specified members [-] - INTEGER(IntKi) :: NFillGroups !< [-] + INTEGER(IntKi) :: NFillGroups = 0_IntKi !< [-] TYPE(Morison_FilledGroupType) , DIMENSION(:), ALLOCATABLE :: FilledGroups !< [-] - INTEGER(IntKi) :: NMGDepths !< [-] + INTEGER(IntKi) :: NMGDepths = 0_IntKi !< [-] TYPE(Morison_MGDepthsType) , DIMENSION(:), ALLOCATABLE :: MGDepths !< [-] - REAL(ReKi) :: MGTop !< [-] - REAL(ReKi) :: MGBottom !< [-] - INTEGER(IntKi) :: NMOutputs !< [-] + REAL(ReKi) :: MGTop = 0.0_ReKi !< [-] + REAL(ReKi) :: MGBottom = 0.0_ReKi !< [-] + INTEGER(IntKi) :: NMOutputs = 0_IntKi !< [-] TYPE(Morison_MOutput) , DIMENSION(:), ALLOCATABLE :: MOutLst !< [-] - INTEGER(IntKi) :: NJOutputs !< [-] + INTEGER(IntKi) :: NJOutputs = 0_IntKi !< [-] TYPE(Morison_JOutput) , DIMENSION(:), ALLOCATABLE :: JOutLst !< [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< This list size needs to be the maximum # of possible outputs because of the use of ReadAry(). Use MaxMrsnOutputs [-] - INTEGER(IntKi) :: NumOuts !< [-] - INTEGER(IntKi) :: UnSum !< [-] - INTEGER(IntKi) :: NStepWave !< [-] - INTEGER(IntKi) :: WaveStMod !< [-] - REAL(SiKi) :: MCFD !< Diameter of the MacCamy-Fuchs member. [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< [-] + INTEGER(IntKi) :: UnSum = 0_IntKi !< [-] + INTEGER(IntKi) :: NStepWave = 0_IntKi !< [-] + INTEGER(IntKi) :: WaveStMod = 0_IntKi !< [-] + REAL(SiKi) :: MCFD = 0.0_R4Ki !< Diameter of the MacCamy-Fuchs member. [-] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to SeaState wave field [-] END TYPE Morison_InitInputType ! ======================= @@ -349,7 +349,7 @@ MODULE Morison_Types ! ======================= ! ========= Morison_ContinuousStateType ======= TYPE, PUBLIC :: Morison_ContinuousStateType - REAL(SiKi) :: DummyContState !< Remove this variable if you have continuous states [-] + REAL(SiKi) :: DummyContState = 0.0_R4Ki !< Remove this variable if you have continuous states [-] END TYPE Morison_ContinuousStateType ! ======================= ! ========= Morison_DiscreteStateType ======= @@ -359,12 +359,12 @@ MODULE Morison_Types ! ======================= ! ========= Morison_ConstraintStateType ======= TYPE, PUBLIC :: Morison_ConstraintStateType - REAL(SiKi) :: DummyConstrState !< Remove this variable if you have constraint states [-] + REAL(SiKi) :: DummyConstrState = 0.0_R4Ki !< Remove this variable if you have constraint states [-] END TYPE Morison_ConstraintStateType ! ======================= ! ========= Morison_OtherStateType ======= TYPE, PUBLIC :: Morison_OtherStateType - INTEGER(IntKi) :: DummyOtherState !< Remove this variable if you have other states [-] + INTEGER(IntKi) :: DummyOtherState = 0_IntKi !< Remove this variable if you have other states [-] END TYPE Morison_OtherStateType ! ======================= ! ========= Morison_MiscVarType ======= @@ -387,22 +387,22 @@ MODULE Morison_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: F_BF_End !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: V_rel_n !< Normal relative flow velocity at joints [m/s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: V_rel_n_HiPass !< High-pass filtered normal relative flow velocity at joints [m/s] - INTEGER(IntKi) :: LastIndWave !< Last time index used in the wave kinematics arrays [-] + INTEGER(IntKi) :: LastIndWave = 0_IntKi !< Last time index used in the wave kinematics arrays [-] END TYPE Morison_MiscVarType ! ======================= ! ========= Morison_ParameterType ======= TYPE, PUBLIC :: Morison_ParameterType - REAL(DbKi) :: DT !< Time step for continuous state integration & discrete state update [(sec)] - REAL(ReKi) :: Gravity !< Gravity (scalar, positive-valued) [m/s^2] - REAL(ReKi) :: WtrDens !< Water density [kg/m^3] - REAL(ReKi) :: WtrDpth !< Water depth (positive-valued) [m] - REAL(ReKi) :: MSL2SWL !< Mean Sea Level to Still Water Level offset [m] - INTEGER(IntKi) :: WaveDisp !< Method of computing Wave Kinematics. (0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [-] - INTEGER(IntKi) :: AMMod !< Method of computing distributed added-mass force. (0: Only and always on nodes below SWL at the undisplaced position. 1: Up to the instantaneous free surface) [overwrite to 0 when WaveMod = 0 or 6 or when WaveStMod = 0 in SeaState] [-] - INTEGER(IntKi) :: NMembers !< number of members [-] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for continuous state integration & discrete state update [(sec)] + REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravity (scalar, positive-valued) [m/s^2] + REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density [kg/m^3] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth (positive-valued) [m] + REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Mean Sea Level to Still Water Level offset [m] + INTEGER(IntKi) :: WaveDisp = 0_IntKi !< Method of computing Wave Kinematics. (0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [-] + INTEGER(IntKi) :: AMMod = 0_IntKi !< Method of computing distributed added-mass force. (0: Only and always on nodes below SWL at the undisplaced position. 1: Up to the instantaneous free surface) [overwrite to 0 when WaveMod = 0 or 6 or when WaveStMod = 0 in SeaState] [-] + INTEGER(IntKi) :: NMembers = 0_IntKi !< number of members [-] TYPE(Morison_MemberType) , DIMENSION(:), ALLOCATABLE :: Members !< Array of Morison members used during simulation [-] - INTEGER(IntKi) :: NNodes !< [-] - INTEGER(IntKi) :: NJoints !< Number of user-specified joints [-] + INTEGER(IntKi) :: NNodes = 0_IntKi !< [-] + INTEGER(IntKi) :: NJoints = 0_IntKi !< Number of user-specified joints [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: I_MG_End !< Inertial matrix associated with marine growth mass at joint [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: An_End !< directional area vector of each joint [m^2] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: DragConst_End !< [-] @@ -413,14 +413,14 @@ MODULE Morison_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: DP_Const_End !< Constant part of Joint dynamic pressure term [N] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Mass_MG_End !< Joint marine growth mass [kg] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AM_End !< 3x3 Joint added mass matrix, constant for all t [N] - INTEGER(IntKi) :: NStepWave !< [-] - INTEGER(IntKi) :: NMOutputs !< [-] + INTEGER(IntKi) :: NStepWave = 0_IntKi !< [-] + INTEGER(IntKi) :: NMOutputs = 0_IntKi !< [-] TYPE(Morison_MOutput) , DIMENSION(:), ALLOCATABLE :: MOutLst !< [-] - INTEGER(IntKi) :: NJOutputs !< [-] + INTEGER(IntKi) :: NJOutputs = 0_IntKi !< [-] TYPE(Morison_JOutput) , DIMENSION(:), ALLOCATABLE :: JOutLst !< [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< [-] - INTEGER(IntKi) :: NumOuts !< [-] - INTEGER(IntKi) :: WaveStMod !< [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< [-] + INTEGER(IntKi) :: WaveStMod = 0_IntKi !< [-] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< SeaState wave field [-] END TYPE Morison_ParameterType ! ======================= diff --git a/modules/hydrodyn/src/SS_Excitation_Types.f90 b/modules/hydrodyn/src/SS_Excitation_Types.f90 index 7483a4f7ec..57958a45a1 100644 --- a/modules/hydrodyn/src/SS_Excitation_Types.f90 +++ b/modules/hydrodyn/src/SS_Excitation_Types.f90 @@ -36,11 +36,11 @@ MODULE SS_Excitation_Types IMPLICIT NONE ! ========= SS_Exc_InitInputType ======= TYPE, PUBLIC :: SS_Exc_InitInputType - CHARACTER(1024) :: InputFile !< Name of the input file [-] - INTEGER(IntKi) :: NBody !< Number of WAMIT bodies for this State Space model [-] - INTEGER(IntKi) :: ExctnDisp !< 0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0] [-] - REAL(ReKi) :: WaveDir !< Wave direction [rad] - INTEGER(IntKi) :: NStepWave !< Number of timesteps in the WaveTime array [-] + CHARACTER(1024) :: InputFile = '' !< Name of the input file [-] + INTEGER(IntKi) :: NBody = 0_IntKi !< Number of WAMIT bodies for this State Space model [-] + INTEGER(IntKi) :: ExctnDisp = 0_IntKi !< 0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0] [-] + REAL(ReKi) :: WaveDir = 0.0_ReKi !< Wave direction [rad] + INTEGER(IntKi) :: NStepWave = 0_IntKi !< Number of timesteps in the WaveTime array [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: PtfmRefztRot !< The rotation about zt of the body reference frame(s) from xt/yt [radians] REAL(SiKi) , DIMENSION(:), POINTER :: WaveElev0 => NULL() !< Wave elevation time history at origin [m] REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev1 => NULL() !< First order wave elevation (points to SeaState module data) [-] @@ -61,17 +61,17 @@ MODULE SS_Excitation_Types ! ======================= ! ========= SS_Exc_DiscreteStateType ======= TYPE, PUBLIC :: SS_Exc_DiscreteStateType - REAL(SiKi) :: DummyDiscState !< [-] + REAL(SiKi) :: DummyDiscState = 0.0_R4Ki !< [-] END TYPE SS_Exc_DiscreteStateType ! ======================= ! ========= SS_Exc_ConstraintStateType ======= TYPE, PUBLIC :: SS_Exc_ConstraintStateType - REAL(SiKi) :: DummyConstrState !< [-] + REAL(SiKi) :: DummyConstrState = 0.0_R4Ki !< [-] END TYPE SS_Exc_ConstraintStateType ! ======================= ! ========= SS_Exc_OtherStateType ======= TYPE, PUBLIC :: SS_Exc_OtherStateType - INTEGER(IntKi) :: n !< Current Time step [-] + INTEGER(IntKi) :: n = 0_IntKi !< Current Time step [-] TYPE(SS_Exc_ContinuousStateType) , DIMENSION(1:4) :: xdot !< Old Values of dxdt to used by the solver (multistep method) [-] END TYPE SS_Exc_OtherStateType ! ======================= @@ -83,16 +83,16 @@ MODULE SS_Excitation_Types ! ======================= ! ========= SS_Exc_ParameterType ======= TYPE, PUBLIC :: SS_Exc_ParameterType - REAL(DbKi) :: DT !< Time step [s] - INTEGER(IntKi) :: NBody !< Number of WAMIT bodies for this State Space model [-] - INTEGER(IntKi) :: ExctnDisp !< 0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0] [-] - INTEGER(IntKi) :: NStepWave !< Number of timesteps in the WaveTime array [-] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step [s] + INTEGER(IntKi) :: NBody = 0_IntKi !< Number of WAMIT bodies for this State Space model [-] + INTEGER(IntKi) :: ExctnDisp = 0_IntKi !< 0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0] [-] + INTEGER(IntKi) :: NStepWave = 0_IntKi !< Number of timesteps in the WaveTime array [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: spDOF !< States per DOF [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: A !< A matrix [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: B !< B matrix [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: C !< C matrix [-] INTEGER(IntKi) :: numStates = 0 !< Number of states [-] - REAL(DbKi) :: Tc !< Time shift [s] + REAL(DbKi) :: Tc = 0.0_R8Ki !< Time shift [s] REAL(SiKi) , DIMENSION(:), POINTER :: WaveElev0 => NULL() !< Wave elevation time history at origin [m] REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev1 => NULL() !< First order wave elevation (points to SeaState module data) [-] REAL(SiKi) , DIMENSION(:), POINTER :: WaveTime => NULL() !< Times where wave elevation is known (points to SeaState module data) [s] diff --git a/modules/hydrodyn/src/SS_Radiation_Types.f90 b/modules/hydrodyn/src/SS_Radiation_Types.f90 index 949691c7bb..1fc725ce4e 100644 --- a/modules/hydrodyn/src/SS_Radiation_Types.f90 +++ b/modules/hydrodyn/src/SS_Radiation_Types.f90 @@ -35,9 +35,9 @@ MODULE SS_Radiation_Types IMPLICIT NONE ! ========= SS_Rad_InitInputType ======= TYPE, PUBLIC :: SS_Rad_InitInputType - CHARACTER(1024) :: InputFile !< Name of the input file [-] + CHARACTER(1024) :: InputFile = '' !< Name of the input file [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: enabledDOFs !< Vector with enable platf. DOFs [(m/s] - INTEGER(IntKi) :: NBody !< Number of WAMIT bodies for this State Space model [-] + INTEGER(IntKi) :: NBody = 0_IntKi !< Number of WAMIT bodies for this State Space model [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: PtfmRefztRot !< The rotation about zt of the body reference frame(s) from xt/yt [radians] END TYPE SS_Rad_InitInputType ! ======================= @@ -54,34 +54,34 @@ MODULE SS_Radiation_Types ! ======================= ! ========= SS_Rad_DiscreteStateType ======= TYPE, PUBLIC :: SS_Rad_DiscreteStateType - REAL(SiKi) :: DummyDiscState !< [-] + REAL(SiKi) :: DummyDiscState = 0.0_R4Ki !< [-] END TYPE SS_Rad_DiscreteStateType ! ======================= ! ========= SS_Rad_ConstraintStateType ======= TYPE, PUBLIC :: SS_Rad_ConstraintStateType - REAL(SiKi) :: DummyConstrState !< [-] + REAL(SiKi) :: DummyConstrState = 0.0_R4Ki !< [-] END TYPE SS_Rad_ConstraintStateType ! ======================= ! ========= SS_Rad_OtherStateType ======= TYPE, PUBLIC :: SS_Rad_OtherStateType - INTEGER(IntKi) :: n !< Current Time step [-] + INTEGER(IntKi) :: n = 0_IntKi !< Current Time step [-] TYPE(SS_Rad_ContinuousStateType) , DIMENSION(1:4) :: xdot !< Old Values of dxdt to used by the solver (multistep method) [-] END TYPE SS_Rad_OtherStateType ! ======================= ! ========= SS_Rad_MiscVarType ======= TYPE, PUBLIC :: SS_Rad_MiscVarType - REAL(SiKi) :: DummyMiscVar !< Remove this variable if you have misc/optimization variables [-] + REAL(SiKi) :: DummyMiscVar = 0.0_R4Ki !< Remove this variable if you have misc/optimization variables [-] END TYPE SS_Rad_MiscVarType ! ======================= ! ========= SS_Rad_ParameterType ======= TYPE, PUBLIC :: SS_Rad_ParameterType - REAL(DbKi) :: DT !< Time step [(s)] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step [(s)] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: A !< A matrix [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: B !< B matrix [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: C !< C matrix [-] INTEGER(IntKi) :: numStates = 0 !< Number of states [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: spdof !< States per dof [-] - INTEGER(IntKi) :: NBody !< Number of WAMIT bodies for this State Space model [-] + INTEGER(IntKi) :: NBody = 0_IntKi !< Number of WAMIT bodies for this State Space model [-] END TYPE SS_Rad_ParameterType ! ======================= ! ========= SS_Rad_InputType ======= diff --git a/modules/hydrodyn/src/WAMIT2_Types.f90 b/modules/hydrodyn/src/WAMIT2_Types.f90 index 0896dc4bd9..e1ddcaf797 100644 --- a/modules/hydrodyn/src/WAMIT2_Types.f90 +++ b/modules/hydrodyn/src/WAMIT2_Types.f90 @@ -36,43 +36,43 @@ MODULE WAMIT2_Types INTEGER(IntKi), PUBLIC, PARAMETER :: MaxWAMIT2Outputs = 6 ! [-] ! ========= WAMIT2_InitInputType ======= TYPE, PUBLIC :: WAMIT2_InitInputType - LOGICAL :: HasWAMIT !< .TRUE. if using WAMIT model, .FALSE. otherwise [-] - CHARACTER(1024) :: WAMITFile !< Root of the filename for WAMIT2 outputs [-] - INTEGER(IntKi) :: NBody !< [>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6] [-] - INTEGER(IntKi) :: NBodyMod !< Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1] [-] + LOGICAL :: HasWAMIT = .false. !< .TRUE. if using WAMIT model, .FALSE. otherwise [-] + CHARACTER(1024) :: WAMITFile = '' !< Root of the filename for WAMIT2 outputs [-] + INTEGER(IntKi) :: NBody = 0_IntKi !< [>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6] [-] + INTEGER(IntKi) :: NBodyMod = 0_IntKi !< Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PtfmRefxt !< The xt offset of the body reference point(s) from (0,0,0) [1 to NBody; only used when PotMod=1; must be 0.0 if NBodyMod=2 ] [(m)] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PtfmRefyt !< The yt offset of the body reference point(s) from (0,0,0) [1 to NBody; only used when PotMod=1; must be 0.0 if NBodyMod=2 ] [(m)] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PtfmRefzt !< The zt offset of the body reference point(s) from (0,0,0) [1 to NBody; only used when PotMod=1; must be 0.0 if NBodyMod=2 ] [(m)] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: PtfmRefztRot !< The rotation about zt of the body reference frame(s) from xt/yt [radians] - REAL(ReKi) :: WAMITULEN !< WAMIT unit length scale [-] - REAL(ReKi) :: RhoXg !< Density * Gravity -- from the Waves module. [-] - INTEGER(IntKi) :: NStepWave !< Total number of frequency components = total number of time steps in the incident wave [-] - INTEGER(IntKi) :: NStepWave2 !< NStepWave / 2 [-] - REAL(ReKi) :: WaveDOmega !< Frequency step for incident wave calculations [(rad/s)] - REAL(ReKi) :: WtrDens !< Water density [(kg/m^3)] - REAL(ReKi) :: Gravity !< Supplied by Driver: Gravitational acceleration [(m/s^2)] - REAL(ReKi) :: WtrDpth !< Water depth (positive-valued) [(m)] + REAL(ReKi) :: WAMITULEN = 0.0_ReKi !< WAMIT unit length scale [-] + REAL(ReKi) :: RhoXg = 0.0_ReKi !< Density * Gravity -- from the Waves module. [-] + INTEGER(IntKi) :: NStepWave = 0_IntKi !< Total number of frequency components = total number of time steps in the incident wave [-] + INTEGER(IntKi) :: NStepWave2 = 0_IntKi !< NStepWave / 2 [-] + REAL(ReKi) :: WaveDOmega = 0.0_ReKi !< Frequency step for incident wave calculations [(rad/s)] + REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density [(kg/m^3)] + REAL(ReKi) :: Gravity = 0.0_ReKi !< Supplied by Driver: Gravitational acceleration [(m/s^2)] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth (positive-valued) [(m)] REAL(SiKi) , DIMENSION(:,:), POINTER :: WaveElevC0 => NULL() !< Discrete Fourier transform of the instantaneous elevation of incident waves at the platform reference point. First column is real part, second column is imaginary part (points to SeaState module data) [(meters)] - REAL(SiKi) :: WaveDir !< Mean incident wave propagation heading direction [(degrees)] - LOGICAL :: WaveMultiDir !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] + REAL(SiKi) :: WaveDir = 0.0_R4Ki !< Mean incident wave propagation heading direction [(degrees)] + LOGICAL :: WaveMultiDir = .false. !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] REAL(SiKi) , DIMENSION(:), POINTER :: WaveDirArr => NULL() !< Wave direction assigned to each frequency (points to SeaState module data) [(degrees)] - REAL(SiKi) :: WaveDirMin !< Minimum wave direction from Waves module [-] - REAL(SiKi) :: WaveDirMax !< Maximum wave direction from Waves module [-] - INTEGER(IntKi) :: WaveMod !< The wave model to use. This is for error checking -- ideally this would be done in the main calling routine, not here. [-] - INTEGER(IntKi) :: MnDrift !< Calculate the mean drift force {0: no mean drift; [7,8,9,10,11, or 12]: WAMIT file to use} [-] - INTEGER(IntKi) :: NewmanApp !< Slow drift forces computed with Newman approximation from WAMIT file:{0: No slow drift; [7,8,9,10,11, or 12]: WAMIT file to use} [-] - INTEGER(IntKi) :: DiffQTF !< Full Difference-Frequency forces computed with full QTF's from WAMIT file: {0: No diff-QTF; [10,11, or 12]: WAMIT file to use} [-] - INTEGER(IntKi) :: SumQTF !< Full Sum-Frequency forces computed with full QTF's from WAMIT file: {0: No sum-QTF; [10,11, or 12]: WAMIT file to use} [-] - LOGICAL :: MnDriftF !< Flag indicating mean drift force should be calculated [-] - LOGICAL :: NewmanAppF !< Flag indicating Newman approximation should be calculated [-] - LOGICAL :: DiffQTFF !< Flag indicating the full difference QTF should be calculated [-] - LOGICAL :: SumQTFF !< Flag indicating the full sum QTF should be calculated [-] - REAL(ReKi) :: WvLowCOff !< Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] - REAL(ReKi) :: WvHiCOff !< High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] - REAL(ReKi) :: WvLowCOffD !< Minimum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] - REAL(ReKi) :: WvHiCOffD !< Maximum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] - REAL(ReKi) :: WvLowCOffS !< Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] - REAL(ReKi) :: WvHiCOffS !< Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] + REAL(SiKi) :: WaveDirMin = 0.0_R4Ki !< Minimum wave direction from Waves module [-] + REAL(SiKi) :: WaveDirMax = 0.0_R4Ki !< Maximum wave direction from Waves module [-] + INTEGER(IntKi) :: WaveMod = 0_IntKi !< The wave model to use. This is for error checking -- ideally this would be done in the main calling routine, not here. [-] + INTEGER(IntKi) :: MnDrift = 0_IntKi !< Calculate the mean drift force {0: no mean drift; [7,8,9,10,11, or 12]: WAMIT file to use} [-] + INTEGER(IntKi) :: NewmanApp = 0_IntKi !< Slow drift forces computed with Newman approximation from WAMIT file:{0: No slow drift; [7,8,9,10,11, or 12]: WAMIT file to use} [-] + INTEGER(IntKi) :: DiffQTF = 0_IntKi !< Full Difference-Frequency forces computed with full QTF's from WAMIT file: {0: No diff-QTF; [10,11, or 12]: WAMIT file to use} [-] + INTEGER(IntKi) :: SumQTF = 0_IntKi !< Full Sum-Frequency forces computed with full QTF's from WAMIT file: {0: No sum-QTF; [10,11, or 12]: WAMIT file to use} [-] + LOGICAL :: MnDriftF = .false. !< Flag indicating mean drift force should be calculated [-] + LOGICAL :: NewmanAppF = .false. !< Flag indicating Newman approximation should be calculated [-] + LOGICAL :: DiffQTFF = .false. !< Flag indicating the full difference QTF should be calculated [-] + LOGICAL :: SumQTFF = .false. !< Flag indicating the full sum QTF should be calculated [-] + REAL(ReKi) :: WvLowCOff = 0.0_ReKi !< Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] + REAL(ReKi) :: WvHiCOff = 0.0_ReKi !< High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] + REAL(ReKi) :: WvLowCOffD = 0.0_ReKi !< Minimum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] + REAL(ReKi) :: WvHiCOffD = 0.0_ReKi !< Maximum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] + REAL(ReKi) :: WvLowCOffS = 0.0_ReKi !< Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] + REAL(ReKi) :: WvHiCOffS = 0.0_ReKi !< Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] END TYPE WAMIT2_InitInputType ! ======================= ! ========= WAMIT2_MiscVarType ======= @@ -83,18 +83,18 @@ MODULE WAMIT2_Types ! ======================= ! ========= WAMIT2_ParameterType ======= TYPE, PUBLIC :: WAMIT2_ParameterType - INTEGER(IntKi) :: NStepWave !< Number of wave time steps [-] - INTEGER(IntKi) :: NBody !< [>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6] [-] - INTEGER(IntKi) :: NBodyMod !< Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1] [-] + INTEGER(IntKi) :: NStepWave = 0_IntKi !< Number of wave time steps [-] + INTEGER(IntKi) :: NBody = 0_IntKi !< [>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6] [-] + INTEGER(IntKi) :: NBodyMod = 0_IntKi !< Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1] [-] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveExctn2 !< Time series of the resulting 2nd order force (first index is timestep, second index is load component) [(N)] - LOGICAL , DIMENSION(1:6) :: MnDriftDims !< Flags for which dimensions to calculate in MnDrift calculations [-] - LOGICAL , DIMENSION(1:6) :: NewmanAppDims !< Flags for which dimensions to calculate in NewmanApp calculations [-] - LOGICAL , DIMENSION(1:6) :: DiffQTFDims !< Flags for which dimensions to calculate in DiffQTF calculations [-] - LOGICAL , DIMENSION(1:6) :: SumQTFDims !< Flags for which dimensions to calculate in SumQTF calculations [-] - LOGICAL :: MnDriftF !< Flag indicating mean drift force should be calculated [-] - LOGICAL :: NewmanAppF !< Flag indicating Newman approximation should be calculated [-] - LOGICAL :: DiffQTFF !< Flag indicating the full difference QTF should be calculated [-] - LOGICAL :: SumQTFF !< Flag indicating the full sum QTF should be calculated [-] + LOGICAL , DIMENSION(1:6) :: MnDriftDims = .false. !< Flags for which dimensions to calculate in MnDrift calculations [-] + LOGICAL , DIMENSION(1:6) :: NewmanAppDims = .false. !< Flags for which dimensions to calculate in NewmanApp calculations [-] + LOGICAL , DIMENSION(1:6) :: DiffQTFDims = .false. !< Flags for which dimensions to calculate in DiffQTF calculations [-] + LOGICAL , DIMENSION(1:6) :: SumQTFDims = .false. !< Flags for which dimensions to calculate in SumQTF calculations [-] + LOGICAL :: MnDriftF = .false. !< Flag indicating mean drift force should be calculated [-] + LOGICAL :: NewmanAppF = .false. !< Flag indicating Newman approximation should be calculated [-] + LOGICAL :: DiffQTFF = .false. !< Flag indicating the full difference QTF should be calculated [-] + LOGICAL :: SumQTFF = .false. !< Flag indicating the full sum QTF should be calculated [-] END TYPE WAMIT2_ParameterType ! ======================= ! ========= WAMIT2_OutputType ======= diff --git a/modules/hydrodyn/src/WAMIT_Types.f90 b/modules/hydrodyn/src/WAMIT_Types.f90 index be9b4d4e76..40f98a7669 100644 --- a/modules/hydrodyn/src/WAMIT_Types.f90 +++ b/modules/hydrodyn/src/WAMIT_Types.f90 @@ -38,41 +38,41 @@ MODULE WAMIT_Types IMPLICIT NONE ! ========= WAMIT_InitInputType ======= TYPE, PUBLIC :: WAMIT_InitInputType - INTEGER(IntKi) :: NBody !< [>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6] [-] - INTEGER(IntKi) :: NBodyMod !< Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1] [-] - REAL(ReKi) :: Gravity !< Supplied by Driver: Gravitational acceleration [(m/s^2)] - REAL(ReKi) :: WtrDpth !< Water depth (positive-valued) [m] + INTEGER(IntKi) :: NBody = 0_IntKi !< [>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6] [-] + INTEGER(IntKi) :: NBodyMod = 0_IntKi !< Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1] [-] + REAL(ReKi) :: Gravity = 0.0_ReKi !< Supplied by Driver: Gravitational acceleration [(m/s^2)] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth (positive-valued) [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PtfmVol0 !< [-] - LOGICAL :: HasWAMIT !< .TRUE. if using WAMIT model, .FALSE. otherwise [-] - REAL(ReKi) :: WAMITULEN !< [-] + LOGICAL :: HasWAMIT = .false. !< .TRUE. if using WAMIT model, .FALSE. otherwise [-] + REAL(ReKi) :: WAMITULEN = 0.0_ReKi !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PtfmRefxt !< The xt offset of the body reference point(s) from (0,0,0) [1 to NBody; only used when PotMod=1 ] [(m)] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PtfmRefyt !< The yt offset of the body reference point(s) from (0,0,0) [1 to NBody; only used when PotMod=1 ] [(m)] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PtfmRefzt !< The zt offset of the body reference point(s) from (0,0,0) [1 to NBody; only used when PotMod=1; must be 0.0 if NBodyMod=2 ] [(m)] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: PtfmRefztRot !< The rotation about zt of the body reference frame(s) from xt/yt [radians] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PtfmCOBxt !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PtfmCOByt !< [-] - INTEGER(IntKi) :: RdtnMod !< [-] - INTEGER(IntKi) :: ExctnMod !< [-] - INTEGER(IntKi) :: ExctnDisp !< 0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0] [-] - REAL(ReKi) :: ExctnCutOff !< Cutoff (corner) frequency of the low-pass time-filtered displaced position (Hz) [>0.0] [Hz] - REAL(DbKi) :: RdtnTMax !< [-] - REAL(ReKi) :: WaveDir !< [-] - CHARACTER(1024) :: WAMITFile !< [-] + INTEGER(IntKi) :: RdtnMod = 0_IntKi !< [-] + INTEGER(IntKi) :: ExctnMod = 0_IntKi !< [-] + INTEGER(IntKi) :: ExctnDisp = 0_IntKi !< 0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0] [-] + REAL(ReKi) :: ExctnCutOff = 0.0_ReKi !< Cutoff (corner) frequency of the low-pass time-filtered displaced position (Hz) [>0.0] [Hz] + REAL(DbKi) :: RdtnTMax = 0.0_R8Ki !< [-] + REAL(ReKi) :: WaveDir = 0.0_ReKi !< [-] + CHARACTER(1024) :: WAMITFile = '' !< [-] TYPE(Conv_Rdtn_InitInputType) :: Conv_Rdtn !< [-] - REAL(ReKi) :: Rhoxg !< [-] - INTEGER(IntKi) :: NStepWave !< [-] - INTEGER(IntKi) :: NStepWave2 !< [-] - REAL(ReKi) :: WaveDOmega !< [-] + REAL(ReKi) :: Rhoxg = 0.0_ReKi !< [-] + INTEGER(IntKi) :: NStepWave = 0_IntKi !< [-] + INTEGER(IntKi) :: NStepWave2 = 0_IntKi !< [-] + REAL(ReKi) :: WaveDOmega = 0.0_ReKi !< [-] REAL(SiKi) , DIMENSION(:), POINTER :: WaveElev0 => NULL() !< Wave elevation time history at origin (needed for SS_Excitation module) [m] REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev1 => NULL() !< First order wave elevation (points to SeaState module data) [-] REAL(SiKi) , DIMENSION(:,:), POINTER :: WaveElevC0 => NULL() !< Discrete Fourier transform of the instantaneous elevation of incident waves at the platform reference point. First column is real part, second column is imaginary part (points to SeaState module data) [(meters)] REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElevC => NULL() !< Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part [(meters)] REAL(SiKi) , DIMENSION(:), POINTER :: WaveTime => NULL() !< (points to SeaState module data) [-] - INTEGER(IntKi) :: WaveMod !< [-] - REAL(ReKi) :: WtrDens !< [-] + INTEGER(IntKi) :: WaveMod = 0_IntKi !< [-] + REAL(ReKi) :: WtrDens = 0.0_ReKi !< [-] REAL(SiKi) , DIMENSION(:), POINTER :: WaveDirArr => NULL() !< Array of wave directions (one per frequency) from the Waves module (points to SeaState module data) [-] - REAL(SiKi) :: WaveDirMin !< Minimum wave direction from Waves module [-] - REAL(SiKi) :: WaveDirMax !< Maximum wave direction from Waves module [-] + REAL(SiKi) :: WaveDirMin = 0.0_R4Ki !< Minimum wave direction from Waves module [-] + REAL(SiKi) :: WaveDirMax = 0.0_R4Ki !< Maximum wave direction from Waves module [-] TYPE(SeaSt_Interp_ParameterType) :: SeaSt_Interp_p !< parameter information from the SeaState Interpolation module [-] END TYPE WAMIT_InitInputType ! ======================= @@ -107,7 +107,7 @@ MODULE WAMIT_Types ! ======================= ! ========= WAMIT_MiscVarType ======= TYPE, PUBLIC :: WAMIT_MiscVarType - INTEGER(IntKi) :: LastIndWave !< [-] + INTEGER(IntKi) :: LastIndWave = 0_IntKi !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_HS !< local variable in CalcOutput:Total load contribution from hydrostatics, including the effects of waterplane area and the center of buoyancy [(N, N-m)] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_Waves1 !< local variable in CalcOutput:Total load contribution from incident waves (i.e., the diffraction problem) [(N, N-m)] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_Rdtn !< local variable in CalcOutput:Total load contribution from wave radiation damping (i.e., the diffraction problem) [(N, N-m)] @@ -126,23 +126,23 @@ MODULE WAMIT_Types ! ======================= ! ========= WAMIT_ParameterType ======= TYPE, PUBLIC :: WAMIT_ParameterType - INTEGER(IntKi) :: NBody !< [>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6] [-] - INTEGER(IntKi) :: NBodyMod !< Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1] [-] + INTEGER(IntKi) :: NBody = 0_IntKi !< [>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6] [-] + INTEGER(IntKi) :: NBodyMod = 0_IntKi !< Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1] [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: F_HS_Moment_Offset !< The offset moment due to the COB being offset from the WAMIT body's local location {matrix 3xNBody} [N-m] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: HdroAdMsI !< [(sec)] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: HdroSttc !< [-] - INTEGER(IntKi) :: RdtnMod !< [-] - INTEGER(IntKi) :: ExctnMod !< [-] - INTEGER(IntKi) :: ExctnDisp !< 0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0] [-] - REAL(ReKi) :: ExctnCutOff !< Cutoff (corner) frequency of the low-pass time-filtered displaced position (Hz) [>0.0] [Hz] - REAL(ReKi) :: ExctnFiltConst !< Low-pass time filter constant computed from ExctnCutOff [-] + INTEGER(IntKi) :: RdtnMod = 0_IntKi !< [-] + INTEGER(IntKi) :: ExctnMod = 0_IntKi !< [-] + INTEGER(IntKi) :: ExctnDisp = 0_IntKi !< 0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0] [-] + REAL(ReKi) :: ExctnCutOff = 0.0_ReKi !< Cutoff (corner) frequency of the low-pass time-filtered displaced position (Hz) [>0.0] [Hz] + REAL(ReKi) :: ExctnFiltConst = 0.0_ReKi !< Low-pass time filter constant computed from ExctnCutOff [-] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveExctn !< [-] REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: WaveExctnGrid !< WaveExctnGrid dimensions are: 1st: wavetime, 2nd: X, 3rd: Y, 4th: Force component for eac WAMIT Body [-] - INTEGER(IntKi) :: NStepWave !< [-] + INTEGER(IntKi) :: NStepWave = 0_IntKi !< [-] TYPE(Conv_Rdtn_ParameterType) :: Conv_Rdtn !< [-] TYPE(SS_Rad_ParameterType) :: SS_Rdtn !< [-] TYPE(SS_Exc_ParameterType) :: SS_Exctn !< [-] - REAL(DbKi) :: DT !< [-] + REAL(DbKi) :: DT = 0.0_R8Ki !< [-] TYPE(SeaSt_Interp_ParameterType) :: SeaSt_Interp_p !< parameter information from the SeaState Interpolation module [-] END TYPE WAMIT_ParameterType ! ======================= diff --git a/modules/icedyn/src/IceDyn_Types.f90 b/modules/icedyn/src/IceDyn_Types.f90 index 9379abb975..f7b00967b2 100644 --- a/modules/icedyn/src/IceDyn_Types.f90 +++ b/modules/icedyn/src/IceDyn_Types.f90 @@ -35,182 +35,182 @@ MODULE IceDyn_Types IMPLICIT NONE ! ========= IceD_InputFile ======= TYPE, PUBLIC :: IceD_InputFile - INTEGER(IntKi) :: IceModel !< The current ice model number [-] - INTEGER(IntKi) :: IceSubModel !< The current ice sub-model number [-] - REAL(ReKi) :: h !< Ice thickness [m] - REAL(ReKi) :: v !< Ice velocity [m/s] - REAL(ReKi) :: InitLoc !< Ice sheet initial location [m] - REAL(ReKi) :: t0 !< Ice load starting time [s] - REAL(ReKi) :: rhow !< Water mass density [kg/m^3] - REAL(ReKi) :: rhoi !< Ice mass density [kg/m^3] - INTEGER(IntKi) :: Seed1 !< Random seed 1 [-] - INTEGER(IntKi) :: Seed2 !< Random seed 2 [-] - INTEGER(IntKi) :: NumLegs !< Number of support structure legs in ice [-] + INTEGER(IntKi) :: IceModel = 0_IntKi !< The current ice model number [-] + INTEGER(IntKi) :: IceSubModel = 0_IntKi !< The current ice sub-model number [-] + REAL(ReKi) :: h = 0.0_ReKi !< Ice thickness [m] + REAL(ReKi) :: v = 0.0_ReKi !< Ice velocity [m/s] + REAL(ReKi) :: InitLoc = 0.0_ReKi !< Ice sheet initial location [m] + REAL(ReKi) :: t0 = 0.0_ReKi !< Ice load starting time [s] + REAL(ReKi) :: rhow = 0.0_ReKi !< Water mass density [kg/m^3] + REAL(ReKi) :: rhoi = 0.0_ReKi !< Ice mass density [kg/m^3] + INTEGER(IntKi) :: Seed1 = 0_IntKi !< Random seed 1 [-] + INTEGER(IntKi) :: Seed2 = 0_IntKi !< Random seed 2 [-] + INTEGER(IntKi) :: NumLegs = 0_IntKi !< Number of support structure legs in ice [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: LegPosX !< global X position of legs 1-NumLegs [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: LegPosY !< global Y position of legs 1-NumLegs [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: StrWd !< The width of the leg (structure) [m] - REAL(ReKi) :: Ikm !< Indentation factor [-] - REAL(ReKi) :: Ag !< Ice crystal type factor [MPa^-3s^-1] - REAL(ReKi) :: Qg !< Activation energy [kJ] - REAL(ReKi) :: Rg !< Universal gas constant [J] - REAL(ReKi) :: Tice !< Ice temperature [K] - REAL(ReKi) :: nu !< Poison ratio of ice [-] - REAL(ReKi) :: phi !< Ice wedge angle [degree] - REAL(ReKi) :: SigNm !< Nominal ice strength [MPa] - REAL(ReKi) :: Eice !< Elastic modulus of ice [GPa] - REAL(ReKi) :: IceStr2 !< Ice tooth brittle strength [MPa] - REAL(ReKi) :: Delmax2 !< Ice tooth maximum elastic deformation for model 2 [m] - REAL(ReKi) :: Pitch !< Distance between sequential ice teeth for model 2 [m] - REAL(ReKi) :: miuh !< Mean value of random ice thickness [m] - REAL(ReKi) :: varh !< Variance of random ice thicknesss [m^2] - REAL(ReKi) :: miuv !< Mean value of random ice velocity [m/s] - REAL(ReKi) :: varv !< Variance of random ice velocity [m^2/s^2] - REAL(ReKi) :: miut !< Mean value of ice loading event duration time [s] - REAL(ReKi) :: miubr !< Mean value of random ice brittle strength [MPa] - REAL(ReKi) :: varbr !< Variance of random ice brittle strength [MPa^2] - REAL(ReKi) :: miuDelm !< Mean value of random random maximum ice tooth tip displacement [MPa] - REAL(ReKi) :: varDelm !< Variance of random random maximum ice tooth tip displacement [MPa^2] - REAL(ReKi) :: miuP !< Mean value of random distance between sequential ice teeth [m] - REAL(ReKi) :: varP !< Variance of random distance between sequential ice teeth [m^2] - INTEGER(IntKi) :: Zn1 !< Number of failure zones along contact width [-] - INTEGER(IntKi) :: Zn2 !< Number of failure zones along contact height/thickness [-] - REAL(ReKi) :: ZonePitch !< Distance between sequential ice teeth [m] - REAL(ReKi) :: PrflMean !< Ice structure contact profile mean value [m] - REAL(ReKi) :: PrflSig !< Ice structure contact profile standard deviation [m] - REAL(ReKi) :: IceStr !< Ice failure strength [MPa] - REAL(ReKi) :: Delmax !< Ice teeth maximum elastic deformation [m] - REAL(ReKi) :: alpha !< slope angle of the cone [degree] - REAL(ReKi) :: Dwl !< cone waterline diameter [m] - REAL(ReKi) :: Dtp !< cone top diameter [m] - REAL(ReKi) :: hr !< ride-up ice thickness [m] - REAL(ReKi) :: mu !< friction coefficient between structure and ice [-] - REAL(ReKi) :: sigf !< flexural strength of ice [MPa] - REAL(ReKi) :: StrLim !< limit strain [-] - REAL(ReKi) :: StrRtLim !< limit strain rate [s^-1] - INTEGER(IntKi) :: UorD !< flag that indicates upward or downward breaking cone: 0,upward, 1,downward. [-] - REAL(ReKi) :: Ll !< Ice floe length [m] - REAL(ReKi) :: Lw !< Ice floe width [m] - REAL(ReKi) :: Cpa !< ice crushing strength pressure-area relation constant [-] - REAL(ReKi) :: dpa !< ice crushing strength pressure-area relation order [-] - REAL(ReKi) :: Fdr !< Constant external driving force [MN] - REAL(ReKi) :: Kic !< Fracture toughness of ice [kNm^(-3/2)] - REAL(ReKi) :: FspN !< Non-dimensional splitting load [-] + REAL(ReKi) :: Ikm = 0.0_ReKi !< Indentation factor [-] + REAL(ReKi) :: Ag = 0.0_ReKi !< Ice crystal type factor [MPa^-3s^-1] + REAL(ReKi) :: Qg = 0.0_ReKi !< Activation energy [kJ] + REAL(ReKi) :: Rg = 0.0_ReKi !< Universal gas constant [J] + REAL(ReKi) :: Tice = 0.0_ReKi !< Ice temperature [K] + REAL(ReKi) :: nu = 0.0_ReKi !< Poison ratio of ice [-] + REAL(ReKi) :: phi = 0.0_ReKi !< Ice wedge angle [degree] + REAL(ReKi) :: SigNm = 0.0_ReKi !< Nominal ice strength [MPa] + REAL(ReKi) :: Eice = 0.0_ReKi !< Elastic modulus of ice [GPa] + REAL(ReKi) :: IceStr2 = 0.0_ReKi !< Ice tooth brittle strength [MPa] + REAL(ReKi) :: Delmax2 = 0.0_ReKi !< Ice tooth maximum elastic deformation for model 2 [m] + REAL(ReKi) :: Pitch = 0.0_ReKi !< Distance between sequential ice teeth for model 2 [m] + REAL(ReKi) :: miuh = 0.0_ReKi !< Mean value of random ice thickness [m] + REAL(ReKi) :: varh = 0.0_ReKi !< Variance of random ice thicknesss [m^2] + REAL(ReKi) :: miuv = 0.0_ReKi !< Mean value of random ice velocity [m/s] + REAL(ReKi) :: varv = 0.0_ReKi !< Variance of random ice velocity [m^2/s^2] + REAL(ReKi) :: miut = 0.0_ReKi !< Mean value of ice loading event duration time [s] + REAL(ReKi) :: miubr = 0.0_ReKi !< Mean value of random ice brittle strength [MPa] + REAL(ReKi) :: varbr = 0.0_ReKi !< Variance of random ice brittle strength [MPa^2] + REAL(ReKi) :: miuDelm = 0.0_ReKi !< Mean value of random random maximum ice tooth tip displacement [MPa] + REAL(ReKi) :: varDelm = 0.0_ReKi !< Variance of random random maximum ice tooth tip displacement [MPa^2] + REAL(ReKi) :: miuP = 0.0_ReKi !< Mean value of random distance between sequential ice teeth [m] + REAL(ReKi) :: varP = 0.0_ReKi !< Variance of random distance between sequential ice teeth [m^2] + INTEGER(IntKi) :: Zn1 = 0_IntKi !< Number of failure zones along contact width [-] + INTEGER(IntKi) :: Zn2 = 0_IntKi !< Number of failure zones along contact height/thickness [-] + REAL(ReKi) :: ZonePitch = 0.0_ReKi !< Distance between sequential ice teeth [m] + REAL(ReKi) :: PrflMean = 0.0_ReKi !< Ice structure contact profile mean value [m] + REAL(ReKi) :: PrflSig = 0.0_ReKi !< Ice structure contact profile standard deviation [m] + REAL(ReKi) :: IceStr = 0.0_ReKi !< Ice failure strength [MPa] + REAL(ReKi) :: Delmax = 0.0_ReKi !< Ice teeth maximum elastic deformation [m] + REAL(ReKi) :: alpha = 0.0_ReKi !< slope angle of the cone [degree] + REAL(ReKi) :: Dwl = 0.0_ReKi !< cone waterline diameter [m] + REAL(ReKi) :: Dtp = 0.0_ReKi !< cone top diameter [m] + REAL(ReKi) :: hr = 0.0_ReKi !< ride-up ice thickness [m] + REAL(ReKi) :: mu = 0.0_ReKi !< friction coefficient between structure and ice [-] + REAL(ReKi) :: sigf = 0.0_ReKi !< flexural strength of ice [MPa] + REAL(ReKi) :: StrLim = 0.0_ReKi !< limit strain [-] + REAL(ReKi) :: StrRtLim = 0.0_ReKi !< limit strain rate [s^-1] + INTEGER(IntKi) :: UorD = 0_IntKi !< flag that indicates upward or downward breaking cone: 0,upward, 1,downward. [-] + REAL(ReKi) :: Ll = 0.0_ReKi !< Ice floe length [m] + REAL(ReKi) :: Lw = 0.0_ReKi !< Ice floe width [m] + REAL(ReKi) :: Cpa = 0.0_ReKi !< ice crushing strength pressure-area relation constant [-] + REAL(ReKi) :: dpa = 0.0_ReKi !< ice crushing strength pressure-area relation order [-] + REAL(ReKi) :: Fdr = 0.0_ReKi !< Constant external driving force [MN] + REAL(ReKi) :: Kic = 0.0_ReKi !< Fracture toughness of ice [kNm^(-3/2)] + REAL(ReKi) :: FspN = 0.0_ReKi !< Non-dimensional splitting load [-] END TYPE IceD_InputFile ! ======================= ! ========= IceD_InitInputType ======= TYPE, PUBLIC :: IceD_InitInputType - CHARACTER(1024) :: InputFile !< Name of the input file; remove if there is no file [-] - CHARACTER(1024) :: RootName !< Root name of the output file [-] - REAL(ReKi) :: MSL2SWL !< Offset between still-water level and mean sea level [m] - REAL(ReKi) :: WtrDens !< Density of water [kg/m^3] - REAL(ReKi) :: gravity !< Gravitational acceleration [m/s^2] - INTEGER(IntKi) :: LegNum !< Which number of legs on the turbine this is being initialized for [m] - REAL(DbKi) :: TMax !< Total simulation time [s] + CHARACTER(1024) :: InputFile = '' !< Name of the input file; remove if there is no file [-] + CHARACTER(1024) :: RootName = '' !< Root name of the output file [-] + REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Offset between still-water level and mean sea level [m] + REAL(ReKi) :: WtrDens = 0.0_ReKi !< Density of water [kg/m^3] + REAL(ReKi) :: gravity = 0.0_ReKi !< Gravitational acceleration [m/s^2] + INTEGER(IntKi) :: LegNum = 0_IntKi !< Which number of legs on the turbine this is being initialized for [m] + REAL(DbKi) :: TMax = 0.0_R8Ki !< Total simulation time [s] END TYPE IceD_InitInputType ! ======================= ! ========= IceD_InitOutputType ======= TYPE, PUBLIC :: IceD_InitOutputType CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Names of the output-to-file channels [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] - INTEGER(IntKi) :: numLegs !< Number of legs on the structure [-] + INTEGER(IntKi) :: numLegs = 0_IntKi !< Number of legs on the structure [-] TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] END TYPE IceD_InitOutputType ! ======================= ! ========= IceD_ContinuousStateType ======= TYPE, PUBLIC :: IceD_ContinuousStateType - REAL(ReKi) :: q !< q - displacement of ice mass [m] - REAL(ReKi) :: dqdt !< dqdt - velocity of ice mass [m/s] + REAL(ReKi) :: q = 0.0_ReKi !< q - displacement of ice mass [m] + REAL(ReKi) :: dqdt = 0.0_ReKi !< dqdt - velocity of ice mass [m/s] END TYPE IceD_ContinuousStateType ! ======================= ! ========= IceD_DiscreteStateType ======= TYPE, PUBLIC :: IceD_DiscreteStateType - REAL(SiKi) :: DummyDiscState !< A variable, Replace if you have discrete states [-] + REAL(SiKi) :: DummyDiscState = 0.0_R4Ki !< A variable, Replace if you have discrete states [-] END TYPE IceD_DiscreteStateType ! ======================= ! ========= IceD_ConstraintStateType ======= TYPE, PUBLIC :: IceD_ConstraintStateType - REAL(SiKi) :: DummyConstrState !< A variable, Replace if you have constraint states [-] + REAL(SiKi) :: DummyConstrState = 0.0_R4Ki !< A variable, Replace if you have constraint states [-] END TYPE IceD_ConstraintStateType ! ======================= ! ========= IceD_OtherStateType ======= TYPE, PUBLIC :: IceD_OtherStateType - INTEGER(IntKi) :: IceTthNo2 !< Ice tooth number of the current ice tooth, for model 2 (updated in UpdateStates; used in CalcOutput) [-] + INTEGER(IntKi) :: IceTthNo2 = 0_IntKi !< Ice tooth number of the current ice tooth, for model 2 (updated in UpdateStates; used in CalcOutput) [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: Nc !< Number of the current ice tooths number (time series) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Psum !< The sum of pitches of all broken ice teeth (time series) [m] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IceTthNo !< IceTthNo - the current numbers of ice teeth of each zone [-] - REAL(ReKi) :: Beta !< angle between broken ice sheet and level waterline [rad] - REAL(DbKi) :: Tinit !< Initial time of the current load cycle [s] - INTEGER(IntKi) :: Splitf !< flag to indicate if the ice floe has split (0 not splitted, 1 splitted) [-] - REAL(ReKi) :: dxc !< crushed depth of ice [m] + REAL(ReKi) :: Beta = 0.0_ReKi !< angle between broken ice sheet and level waterline [rad] + REAL(DbKi) :: Tinit = 0.0_R8Ki !< Initial time of the current load cycle [s] + INTEGER(IntKi) :: Splitf = 0_IntKi !< flag to indicate if the ice floe has split (0 not splitted, 1 splitted) [-] + REAL(ReKi) :: dxc = 0.0_ReKi !< crushed depth of ice [m] TYPE(IceD_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: xdot !< previous state deriv for multi-step [m] - INTEGER(IntKi) :: n !< tracks time step for which OtherState was updated [-] + INTEGER(IntKi) :: n = 0_IntKi !< tracks time step for which OtherState was updated [-] END TYPE IceD_OtherStateType ! ======================= ! ========= IceD_MiscVarType ======= TYPE, PUBLIC :: IceD_MiscVarType - INTEGER(IntKi) :: DummyMiscVar !< Remove this variable if you have misc/optimization variables [-] + INTEGER(IntKi) :: DummyMiscVar = 0_IntKi !< Remove this variable if you have misc/optimization variables [-] END TYPE IceD_MiscVarType ! ======================= ! ========= IceD_ParameterType ======= TYPE, PUBLIC :: IceD_ParameterType - REAL(ReKi) :: h !< Ice thickness [m] - REAL(ReKi) :: v !< Ice velocity [m/s] - REAL(ReKi) :: t0 !< Ice load starting time [s] - REAL(ReKi) :: StrWd !< The width of the structure [m] - REAL(ReKi) :: dt !< Time interval for integration within the module [s] - REAL(ReKi) :: InitLoc !< Ice sheet initial location [m] - REAL(ReKi) :: tolerance !< Tolerance when calculating ice breaking force, etc. [-] - REAL(ReKi) :: Tmax !< Total simulation time [s] - INTEGER(IntKi) :: verif !< flag to indicate if verification is being peformed [-] - INTEGER(IntKi) :: ModNo !< The current ice model number [-] - INTEGER(IntKi) :: SubModNo !< The current ice sub-model number [-] - INTEGER(IntKi) :: NumOuts !< The number of output channels [-] - INTEGER(IntKi) :: method !< integration method: 1-RK4, 2-AB4, 3-ABM4 [-] - INTEGER(IntKi) :: TmStep !< Total time step [-] + REAL(ReKi) :: h = 0.0_ReKi !< Ice thickness [m] + REAL(ReKi) :: v = 0.0_ReKi !< Ice velocity [m/s] + REAL(ReKi) :: t0 = 0.0_ReKi !< Ice load starting time [s] + REAL(ReKi) :: StrWd = 0.0_ReKi !< The width of the structure [m] + REAL(ReKi) :: dt = 0.0_ReKi !< Time interval for integration within the module [s] + REAL(ReKi) :: InitLoc = 0.0_ReKi !< Ice sheet initial location [m] + REAL(ReKi) :: tolerance = 0.0_ReKi !< Tolerance when calculating ice breaking force, etc. [-] + REAL(ReKi) :: Tmax = 0.0_ReKi !< Total simulation time [s] + INTEGER(IntKi) :: verif = 0_IntKi !< flag to indicate if verification is being peformed [-] + INTEGER(IntKi) :: ModNo = 0_IntKi !< The current ice model number [-] + INTEGER(IntKi) :: SubModNo = 0_IntKi !< The current ice sub-model number [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< The number of output channels [-] + INTEGER(IntKi) :: method = 0_IntKi !< integration method: 1-RK4, 2-AB4, 3-ABM4 [-] + INTEGER(IntKi) :: TmStep = 0_IntKi !< Total time step [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutName !< Names of all requested output parameters [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutUnit !< Units of all requested output parameters [-] - CHARACTER(1024) :: RootName !< Rootname [-] - REAL(ReKi) :: tm1a !< Time for the maximum force to be reached for model 1a [s] - REAL(ReKi) :: tm1b !< Time for the maximum force to be reached for model 1b [s] - REAL(ReKi) :: tm1c !< Time for the maximum force to be reached for model 1c [s] - REAL(ReKi) :: Fmax1a !< Maximum ice force of model 1a [N] - REAL(ReKi) :: Fmax1b !< Maximum ice force of model 1b [N] - REAL(ReKi) :: Fmax1c !< Maximum ice force of model 1c [N] - REAL(ReKi) :: Ikm !< Indentation factor [-] - REAL(ReKi) :: Cstr !< Constant when calculating creeping stresss [Pa*s^(-1/3)] - REAL(ReKi) :: EiPa !< Elastic modulus of ice [Pa] - REAL(ReKi) :: Delmax2 !< Ice tooth maximum elastic deformation for model 2 [m] - REAL(ReKi) :: Pitch !< Distance between sequential ice teeth [m] - REAL(ReKi) :: Kice2 !< Stiffness of ice teeth for model 2 [N/m] + CHARACTER(1024) :: RootName = '' !< Rootname [-] + REAL(ReKi) :: tm1a = 0.0_ReKi !< Time for the maximum force to be reached for model 1a [s] + REAL(ReKi) :: tm1b = 0.0_ReKi !< Time for the maximum force to be reached for model 1b [s] + REAL(ReKi) :: tm1c = 0.0_ReKi !< Time for the maximum force to be reached for model 1c [s] + REAL(ReKi) :: Fmax1a = 0.0_ReKi !< Maximum ice force of model 1a [N] + REAL(ReKi) :: Fmax1b = 0.0_ReKi !< Maximum ice force of model 1b [N] + REAL(ReKi) :: Fmax1c = 0.0_ReKi !< Maximum ice force of model 1c [N] + REAL(ReKi) :: Ikm = 0.0_ReKi !< Indentation factor [-] + REAL(ReKi) :: Cstr = 0.0_ReKi !< Constant when calculating creeping stresss [Pa*s^(-1/3)] + REAL(ReKi) :: EiPa = 0.0_ReKi !< Elastic modulus of ice [Pa] + REAL(ReKi) :: Delmax2 = 0.0_ReKi !< Ice tooth maximum elastic deformation for model 2 [m] + REAL(ReKi) :: Pitch = 0.0_ReKi !< Distance between sequential ice teeth [m] + REAL(ReKi) :: Kice2 = 0.0_ReKi !< Stiffness of ice teeth for model 2 [N/m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rdmFm !< Random maximum ice force time series [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rdmt0 !< Random ice loading event starting time [s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rdmtm !< Random time when the maximum force is reached [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rdmDm !< Random maximum ice tooth tip displacement time series [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rdmP !< Random distance between sequential ice teeth [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rdmKi !< Random ice teeth stiffness [N/m] - REAL(ReKi) :: ZonePitch !< Distance between sequential ice teeth [m] - REAL(ReKi) :: Kice !< Stiffness of ice teeth [N/m] - REAL(ReKi) :: Delmax !< Ice teeth maximum elastic deformation [m] + REAL(ReKi) :: ZonePitch = 0.0_ReKi !< Distance between sequential ice teeth [m] + REAL(ReKi) :: Kice = 0.0_ReKi !< Stiffness of ice teeth [N/m] + REAL(ReKi) :: Delmax = 0.0_ReKi !< Ice teeth maximum elastic deformation [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Y0 !< Ice structure contact profile initial location [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ContPrfl !< Ice structure contact profile [m] - INTEGER(IntKi) :: Zn !< Number of failure zones [-] - REAL(ReKi) :: rhoi !< Ice mass density [kg/m^3] - REAL(ReKi) :: rhow !< Water mass density [kg/m^3] - REAL(ReKi) :: alphaR !< Slope angle of the cone [rad] - REAL(ReKi) :: Dwl !< Cone waterline diameter [m] - REAL(ReKi) :: Zr !< Ice ride-up height [m] - REAL(ReKi) :: RHbr !< Horizontal breaking force [N] - REAL(ReKi) :: RVbr !< Vertical breaking force [N] - REAL(ReKi) :: Lbr !< Ice sheet breaking length [m] - REAL(ReKi) :: LovR !< Ratio of ice breaking length over cone radius [-] - REAL(ReKi) :: mu !< Friction coefficient between structure and ice [-] - REAL(ReKi) :: Wri !< Initial ride-up ice weight [kg] - REAL(ReKi) :: WL !< Broken ice piece weight [kg] - REAL(ReKi) :: Cpa !< ice crushing strength pressure-area relation constant [-] - REAL(ReKi) :: dpa !< ice crushing strength pressure-area relation order [-] - REAL(ReKi) :: FdrN !< Constant external driving force [N] - REAL(ReKi) :: Mice !< Ice floe mass [kg] - REAL(ReKi) :: Fsp !< Ice floe splitting force [N] + INTEGER(IntKi) :: Zn = 0_IntKi !< Number of failure zones [-] + REAL(ReKi) :: rhoi = 0.0_ReKi !< Ice mass density [kg/m^3] + REAL(ReKi) :: rhow = 0.0_ReKi !< Water mass density [kg/m^3] + REAL(ReKi) :: alphaR = 0.0_ReKi !< Slope angle of the cone [rad] + REAL(ReKi) :: Dwl = 0.0_ReKi !< Cone waterline diameter [m] + REAL(ReKi) :: Zr = 0.0_ReKi !< Ice ride-up height [m] + REAL(ReKi) :: RHbr = 0.0_ReKi !< Horizontal breaking force [N] + REAL(ReKi) :: RVbr = 0.0_ReKi !< Vertical breaking force [N] + REAL(ReKi) :: Lbr = 0.0_ReKi !< Ice sheet breaking length [m] + REAL(ReKi) :: LovR = 0.0_ReKi !< Ratio of ice breaking length over cone radius [-] + REAL(ReKi) :: mu = 0.0_ReKi !< Friction coefficient between structure and ice [-] + REAL(ReKi) :: Wri = 0.0_ReKi !< Initial ride-up ice weight [kg] + REAL(ReKi) :: WL = 0.0_ReKi !< Broken ice piece weight [kg] + REAL(ReKi) :: Cpa = 0.0_ReKi !< ice crushing strength pressure-area relation constant [-] + REAL(ReKi) :: dpa = 0.0_ReKi !< ice crushing strength pressure-area relation order [-] + REAL(ReKi) :: FdrN = 0.0_ReKi !< Constant external driving force [N] + REAL(ReKi) :: Mice = 0.0_ReKi !< Ice floe mass [kg] + REAL(ReKi) :: Fsp = 0.0_ReKi !< Ice floe splitting force [N] END TYPE IceD_ParameterType ! ======================= ! ========= IceD_InputType ======= diff --git a/modules/icefloe/src/icefloe/IceFloe_Types.f90 b/modules/icefloe/src/icefloe/IceFloe_Types.f90 index aec91404d5..5ececda879 100644 --- a/modules/icefloe/src/icefloe/IceFloe_Types.f90 +++ b/modules/icefloe/src/icefloe/IceFloe_Types.f90 @@ -35,11 +35,11 @@ MODULE IceFloe_Types IMPLICIT NONE ! ========= IceFloe_InitInputType ======= TYPE, PUBLIC :: IceFloe_InitInputType - CHARACTER(1024) :: InputFile !< Name of the input file [-] - REAL(ReKi) :: simLength !< Duration of simulation [sec] - REAL(ReKi) :: MSL2SWL !< Offset between still-water level and mean sea level [m] - REAL(ReKi) :: gravity !< Gravitational acceleration [m/s^2] - character(1024) :: RootName !< Output file root name [-] + CHARACTER(1024) :: InputFile = '' !< Name of the input file [-] + REAL(ReKi) :: simLength = 0.0_ReKi !< Duration of simulation [sec] + REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Offset between still-water level and mean sea level [m] + REAL(ReKi) :: gravity = 0.0_ReKi !< Gravitational acceleration [m/s^2] + character(1024) :: RootName = '' !< Output file root name [-] END TYPE IceFloe_InitInputType ! ======================= ! ========= IceFloe_InitOutputType ======= @@ -51,50 +51,50 @@ MODULE IceFloe_Types ! ======================= ! ========= IceFloe_ContinuousStateType ======= TYPE, PUBLIC :: IceFloe_ContinuousStateType - REAL(SiKi) :: DummyContStateVar !< None currently used [-] + REAL(SiKi) :: DummyContStateVar = 0.0_R4Ki !< None currently used [-] END TYPE IceFloe_ContinuousStateType ! ======================= ! ========= IceFloe_DiscreteStateType ======= TYPE, PUBLIC :: IceFloe_DiscreteStateType - REAL(SiKi) :: DummyDiscStateVar !< None currently used [-] + REAL(SiKi) :: DummyDiscStateVar = 0.0_R4Ki !< None currently used [-] END TYPE IceFloe_DiscreteStateType ! ======================= ! ========= IceFloe_ConstraintStateType ======= TYPE, PUBLIC :: IceFloe_ConstraintStateType - REAL(SiKi) :: DummyConstrStateVar !< None currently used [-] + REAL(SiKi) :: DummyConstrStateVar = 0.0_R4Ki !< None currently used [-] END TYPE IceFloe_ConstraintStateType ! ======================= ! ========= IceFloe_OtherStateType ======= TYPE, PUBLIC :: IceFloe_OtherStateType - INTEGER(IntKi) :: DummyOtherState !< Remove this variable if you have other states [-] + INTEGER(IntKi) :: DummyOtherState = 0_IntKi !< Remove this variable if you have other states [-] END TYPE IceFloe_OtherStateType ! ======================= ! ========= IceFloe_MiscVarType ======= TYPE, PUBLIC :: IceFloe_MiscVarType - INTEGER(IntKi) :: DummyMiscVar !< Remove this variable if you have misc/optimization variables [-] + INTEGER(IntKi) :: DummyMiscVar = 0_IntKi !< Remove this variable if you have misc/optimization variables [-] END TYPE IceFloe_MiscVarType ! ======================= ! ========= IceFloe_ParameterType ======= TYPE, PUBLIC :: IceFloe_ParameterType REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: loadSeries !< - [precalculated time series of ice loads for each leg] - REAL(ReKi) :: iceVel !< ice floe velocity [m/s] - REAL(ReKi) :: iceDirection !< ice floe direction [degrees] - REAL(ReKi) :: minStrength !< minimum dynamic ice strength [Pa] - REAL(ReKi) :: minStrengthNegVel !< minimum dynamic ice strength for negative velocity [Pa] - REAL(ReKi) :: defaultArea !< structure width to use in cpld crushin [m] - REAL(ReKi) :: crushArea !< cross sectional area of ice against tower [m^2] - REAL(ReKi) :: coeffStressRate !< coefficient to calc stress rate from relative vellocity [Pa/m] - REAL(ReKi) :: C(4) !< coefficient of cubic transition curve for negative stress rates [-] - REAL(ReKi) :: dt !< time step [sec] - REAL(ReKi) :: rampTime !< load ramp up time [sec] + REAL(ReKi) :: iceVel = 0.0_ReKi !< ice floe velocity [m/s] + REAL(ReKi) :: iceDirection = 0.0_ReKi !< ice floe direction [degrees] + REAL(ReKi) :: minStrength = 0.0_ReKi !< minimum dynamic ice strength [Pa] + REAL(ReKi) :: minStrengthNegVel = 0.0_ReKi !< minimum dynamic ice strength for negative velocity [Pa] + REAL(ReKi) :: defaultArea = 0.0_ReKi !< structure width to use in cpld crushin [m] + REAL(ReKi) :: crushArea = 0.0_ReKi !< cross sectional area of ice against tower [m^2] + REAL(ReKi) :: coeffStressRate = 0.0_ReKi !< coefficient to calc stress rate from relative vellocity [Pa/m] + REAL(ReKi) :: C(4) = 0.0_ReKi !< coefficient of cubic transition curve for negative stress rates [-] + REAL(ReKi) :: dt = 0.0_ReKi !< time step [sec] + REAL(ReKi) :: rampTime = 0.0_ReKi !< load ramp up time [sec] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: legX !< - [x position of each leg relative to structure center] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: legY !< - [y position of each leg relative to structure center] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ks !< - [shelter factor due to upstream leg] - INTEGER(IntKi) :: numLegs !< Number of tower legs (=1 for monopile) [-] - INTEGER(IntKi) :: iceType !< Type of ice Floe: flex, crush, etc. [-] - INTEGER(IntKi) :: logUnitNum !< Unit number for log file [-] - LOGICAL :: singleLoad !< Flag for load application at single point vs multiple legs [-] - LOGICAL :: initFlag !< Flag for successful initialization [-] + INTEGER(IntKi) :: numLegs = 0_IntKi !< Number of tower legs (=1 for monopile) [-] + INTEGER(IntKi) :: iceType = 0_IntKi !< Type of ice Floe: flex, crush, etc. [-] + INTEGER(IntKi) :: logUnitNum = 0_IntKi !< Unit number for log file [-] + LOGICAL :: singleLoad = .false. !< Flag for load application at single point vs multiple legs [-] + LOGICAL :: initFlag = .false. !< Flag for successful initialization [-] END TYPE IceFloe_ParameterType ! ======================= ! ========= IceFloe_InputType ======= diff --git a/modules/inflowwind/src/InflowWind_IO_Types.f90 b/modules/inflowwind/src/InflowWind_IO_Types.f90 index 70eb7c313a..ab6885156a 100644 --- a/modules/inflowwind/src/InflowWind_IO_Types.f90 +++ b/modules/inflowwind/src/InflowWind_IO_Types.f90 @@ -36,39 +36,39 @@ MODULE InflowWind_IO_Types IMPLICIT NONE ! ========= WindFileDat ======= TYPE, PUBLIC :: WindFileDat - character(1024) :: FileName !< Name of the windfile retrieved [-] + character(1024) :: FileName = '' !< Name of the windfile retrieved [-] INTEGER(IntKi) :: WindType = 0 !< Type of the windfile [-] - REAL(ReKi) :: RefHt !< Reference height given in file [meters] - LOGICAL :: RefHt_Set !< Reference height was given in file [-] - REAL(DbKi) :: DT !< TimeStep of the wind file -- zero value for none [seconds] - INTEGER(IntKi) :: NumTSteps !< Number of timesteps in the time range of wind file [-] - LOGICAL :: ConstantDT !< Timesteps are the same throughout file [-] - REAL(ReKi) , DIMENSION(1:2) :: TRange !< Time range of the wind file [seconds] - LOGICAL :: TRange_Limited !< TRange limits strictly enforced [-] - REAL(ReKi) , DIMENSION(1:2) :: YRange !< Range in y direction [meters] - LOGICAL :: YRange_Limited !< YRange limits strictly enforced [-] - REAL(ReKi) , DIMENSION(1:2) :: ZRange !< Range in z direction [meters] - LOGICAL :: ZRange_Limited !< ZRange limits strictly enforced [-] - INTEGER(IntKi) :: BinaryFormat !< Binary format identifier [-] - LOGICAL :: IsBinary !< Windfile is a binary file [-] - REAL(ReKi) , DIMENSION(1:3) :: TI !< Turbulence intensity (U,V,W) [-] - LOGICAL :: TI_listed !< Turbulence intesity given in file [-] - REAL(ReKi) :: MWS !< Approximate mean wind speed [-] + REAL(ReKi) :: RefHt = 0.0_ReKi !< Reference height given in file [meters] + LOGICAL :: RefHt_Set = .false. !< Reference height was given in file [-] + REAL(DbKi) :: DT = 0.0_R8Ki !< TimeStep of the wind file -- zero value for none [seconds] + INTEGER(IntKi) :: NumTSteps = 0_IntKi !< Number of timesteps in the time range of wind file [-] + LOGICAL :: ConstantDT = .false. !< Timesteps are the same throughout file [-] + REAL(ReKi) , DIMENSION(1:2) :: TRange = 0.0_ReKi !< Time range of the wind file [seconds] + LOGICAL :: TRange_Limited = .false. !< TRange limits strictly enforced [-] + REAL(ReKi) , DIMENSION(1:2) :: YRange = 0.0_ReKi !< Range in y direction [meters] + LOGICAL :: YRange_Limited = .false. !< YRange limits strictly enforced [-] + REAL(ReKi) , DIMENSION(1:2) :: ZRange = 0.0_ReKi !< Range in z direction [meters] + LOGICAL :: ZRange_Limited = .false. !< ZRange limits strictly enforced [-] + INTEGER(IntKi) :: BinaryFormat = 0_IntKi !< Binary format identifier [-] + LOGICAL :: IsBinary = .false. !< Windfile is a binary file [-] + REAL(ReKi) , DIMENSION(1:3) :: TI = 0.0_ReKi !< Turbulence intensity (U,V,W) [-] + LOGICAL :: TI_listed = .false. !< Turbulence intesity given in file [-] + REAL(ReKi) :: MWS = 0.0_ReKi !< Approximate mean wind speed [-] END TYPE WindFileDat ! ======================= ! ========= Steady_InitInputType ======= TYPE, PUBLIC :: Steady_InitInputType - REAL(ReKi) :: HWindSpeed !< Horizontal wind speed [m/s] - REAL(ReKi) :: RefHt !< Reference height for horizontal wind speed [meters] - REAL(ReKi) :: PLExp !< Power law exponent [-] + REAL(ReKi) :: HWindSpeed = 0.0_ReKi !< Horizontal wind speed [m/s] + REAL(ReKi) :: RefHt = 0.0_ReKi !< Reference height for horizontal wind speed [meters] + REAL(ReKi) :: PLExp = 0.0_ReKi !< Power law exponent [-] END TYPE Steady_InitInputType ! ======================= ! ========= Uniform_InitInputType ======= TYPE, PUBLIC :: Uniform_InitInputType - character(1024) :: WindFileName !< Name of the wind file to use [-] - REAL(ReKi) :: RefHt !< Reference height for horizontal wind speed [meters] - REAL(ReKi) :: RefLength !< Reference length for linear horizontal and vertical sheer [-] - REAL(ReKi) :: PropagationDir !< Direction of wind propagation [radians] + character(1024) :: WindFileName = '' !< Name of the wind file to use [-] + REAL(ReKi) :: RefHt = 0.0_ReKi !< Reference height for horizontal wind speed [meters] + REAL(ReKi) :: RefLength = 0.0_ReKi !< Reference length for linear horizontal and vertical sheer [-] + REAL(ReKi) :: PropagationDir = 0.0_ReKi !< Direction of wind propagation [radians] LOGICAL :: UseInputFile = .true. !< Flag for toggling file based IO in wind type 2. [-] TYPE(FileInfoType) :: PassedFileData !< Optional slot for wind type 2 data if file IO is not used. [-] END TYPE Uniform_InitInputType @@ -76,8 +76,8 @@ MODULE InflowWind_IO_Types ! ========= Grid3D_InitInputType ======= TYPE, PUBLIC :: Grid3D_InitInputType INTEGER(IntKi) :: ScaleMethod = 0 !< Turbulence scaling method [0=none, 1=direct scaling, 2= calculate scaling factor based on a desired standard deviation] [-] - REAL(ReKi) , DIMENSION(1:3) :: SF !< Turbulence scaling factor for each direction [ScaleMethod=1] [-] - REAL(ReKi) , DIMENSION(1:3) :: SigmaF !< Turbulence standard deviation to calculate scaling from in each direction [ScaleMethod=2] [-] + REAL(ReKi) , DIMENSION(1:3) :: SF = 0 !< Turbulence scaling factor for each direction [ScaleMethod=1] [-] + REAL(ReKi) , DIMENSION(1:3) :: SigmaF = 0 !< Turbulence standard deviation to calculate scaling from in each direction [ScaleMethod=2] [-] INTEGER(IntKi) :: WindProfileType = -1 !< Wind profile type (0=constant;1=logarithmic;2=power law) [-] REAL(ReKi) :: RefHt = 0 !< Reference (hub) height of the grid [meters] REAL(ReKi) :: URef = 0 !< Mean u-component wind speed at the reference height [meters] @@ -91,28 +91,28 @@ MODULE InflowWind_IO_Types ! ======================= ! ========= TurbSim_InitInputType ======= TYPE, PUBLIC :: TurbSim_InitInputType - character(1024) :: WindFileName !< Name of the wind file to use [-] + character(1024) :: WindFileName = '' !< Name of the wind file to use [-] END TYPE TurbSim_InitInputType ! ======================= ! ========= Bladed_InitInputType ======= TYPE, PUBLIC :: Bladed_InitInputType - character(1024) :: WindFileName !< Root filename [-] - INTEGER(IntKi) :: WindType !< Whether this is native Bladed (needs wind profile and TI scaling) or not [-] - LOGICAL :: NativeBladedFmt !< Whether this is native Bladed (needs wind profile and TI scaling) or not [-] - LOGICAL :: TowerFileExist !< Tower file exists [-] + character(1024) :: WindFileName = '' !< Root filename [-] + INTEGER(IntKi) :: WindType = 0_IntKi !< Whether this is native Bladed (needs wind profile and TI scaling) or not [-] + LOGICAL :: NativeBladedFmt = .false. !< Whether this is native Bladed (needs wind profile and TI scaling) or not [-] + LOGICAL :: TowerFileExist = .false. !< Tower file exists [-] INTEGER(IntKi) :: TurbineID = 0 !< Wind turbine ID number in the fixed (DEFAULT) file name when FixedWindFileRootName = .TRUE. (used by FAST.Farm) [-] LOGICAL :: FixedWindFileRootName = .false. !< Do the wind data files have a fixed (DEFAULT) file name? (used by FAST.Farm) [-] END TYPE Bladed_InitInputType ! ======================= ! ========= Bladed_InitOutputType ======= TYPE, PUBLIC :: Bladed_InitOutputType - REAL(ReKi) :: PropagationDir !< Propogation direction from native Bladed format [degrees] - REAL(ReKi) :: VFlowAngle !< Vertical flow angle from native Bladed format [degrees] + REAL(ReKi) :: PropagationDir = 0.0_ReKi !< Propogation direction from native Bladed format [degrees] + REAL(ReKi) :: VFlowAngle = 0.0_ReKi !< Vertical flow angle from native Bladed format [degrees] END TYPE Bladed_InitOutputType ! ======================= ! ========= HAWC_InitInputType ======= TYPE, PUBLIC :: HAWC_InitInputType - character(1024) , DIMENSION(1:3) :: WindFileName !< Name of the wind file to use [-] + character(1024) , DIMENSION(1:3) :: WindFileName = '' !< Name of the wind file to use [-] INTEGER(IntKi) :: nx = 0 !< Number of grids in the x direction (in the 3 files above) [-] INTEGER(IntKi) :: ny = 0 !< Number of grids in the y direction (in the 3 files above) [-] INTEGER(IntKi) :: nz = 0 !< Number of grids in the z direction (in the 3 files above) [-] @@ -124,20 +124,20 @@ MODULE InflowWind_IO_Types ! ======================= ! ========= User_InitInputType ======= TYPE, PUBLIC :: User_InitInputType - REAL(SiKi) :: Dummy !< User field initialization input dummy value [-] + REAL(SiKi) :: Dummy = 0.0_R4Ki !< User field initialization input dummy value [-] END TYPE User_InitInputType ! ======================= ! ========= Grid4D_InitInputType ======= TYPE, PUBLIC :: Grid4D_InitInputType - INTEGER(IntKi) , DIMENSION(1:4) :: n !< number of grid points in the x, y, z, and t directions [-] - REAL(ReKi) , DIMENSION(1:4) :: delta !< size between 2 consecutive grid points in each grid direction [m,m,m,s] - REAL(ReKi) , DIMENSION(1:3) :: pZero !< fixed position of the XYZ grid (i.e., XYZ coordinates of m%V(:,1,1,1,:)) [m] + INTEGER(IntKi) , DIMENSION(1:4) :: n = 0_IntKi !< number of grid points in the x, y, z, and t directions [-] + REAL(ReKi) , DIMENSION(1:4) :: delta = 0.0_ReKi !< size between 2 consecutive grid points in each grid direction [m,m,m,s] + REAL(ReKi) , DIMENSION(1:3) :: pZero = 0.0_ReKi !< fixed position of the XYZ grid (i.e., XYZ coordinates of m%V(:,1,1,1,:)) [m] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: Vel => NULL() !< pointer to 4D grid velocity data [m/s] END TYPE Grid4D_InitInputType ! ======================= ! ========= Points_InitInputType ======= TYPE, PUBLIC :: Points_InitInputType - INTEGER(IntKi) :: NumWindPoints !< Number of points where wind components will be provided [-] + INTEGER(IntKi) :: NumWindPoints = 0_IntKi !< Number of points where wind components will be provided [-] END TYPE Points_InitInputType ! ======================= CONTAINS diff --git a/modules/inflowwind/src/InflowWind_Types.f90 b/modules/inflowwind/src/InflowWind_Types.f90 index 8fc1f4586e..e49791a51f 100644 --- a/modules/inflowwind/src/InflowWind_Types.f90 +++ b/modules/inflowwind/src/InflowWind_Types.f90 @@ -50,74 +50,74 @@ MODULE InflowWind_Types INTEGER(IntKi), PUBLIC, PARAMETER :: IfW_NumPtsAvg = 144 ! Number of points averaged for rotor-average wind speed [-] ! ========= InflowWind_InputFile ======= TYPE, PUBLIC :: InflowWind_InputFile - LOGICAL :: EchoFlag !< Echo the input file [-] + LOGICAL :: EchoFlag = .false. !< Echo the input file [-] INTEGER(IntKi) :: WindType = 0 !< Type of windfile [-] - REAL(ReKi) :: PropagationDir !< Direction of wind propagation (meteorological direction) [(degrees)] - REAL(ReKi) :: VFlowAngle !< Vertical (upflow) angle [degrees] + REAL(ReKi) :: PropagationDir = 0.0_ReKi !< Direction of wind propagation (meteorological direction) [(degrees)] + REAL(ReKi) :: VFlowAngle = 0.0_ReKi !< Vertical (upflow) angle [degrees] LOGICAL :: VelInterpCubic = .FALSE. !< Use cubic interpolation for velocity in time (false=linear, true=cubic) [Used with WindType=2,3,4,5,7] [-] - INTEGER(IntKi) :: NWindVel !< Number of points to output the wind velocity (0 to 9) [-] + INTEGER(IntKi) :: NWindVel = 0_IntKi !< Number of points to output the wind velocity (0 to 9) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WindVxiList !< List of X coordinates for wind velocity measurements [meters] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WindVyiList !< List of Y coordinates for wind velocity measurements [meters] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WindVziList !< List of Z coordinates for wind velocity measurements [meters] - REAL(ReKi) :: Steady_HWindSpeed !< Steady wind -- horizontal windspeed [meters/s] - REAL(ReKi) :: Steady_RefHt !< Steady wind -- reference height [meters] - REAL(ReKi) :: Steady_PLexp !< Steady wind -- power law exponent [-] - CHARACTER(1024) :: Uniform_FileName !< Uniform wind -- filename [-] - REAL(ReKi) :: Uniform_RefHt !< Uniform wind -- reference height [meters] - REAL(ReKi) :: Uniform_RefLength !< Uniform wind -- reference length [meters] - CHARACTER(1024) :: TSFF_FileName !< TurbSim Full-Field -- filename [-] - CHARACTER(1024) :: BladedFF_FileName !< Bladed-style Full-Field -- filename [-] - LOGICAL :: BladedFF_TowerFile !< Bladed-style Full-Field -- tower file exists [-] + REAL(ReKi) :: Steady_HWindSpeed = 0.0_ReKi !< Steady wind -- horizontal windspeed [meters/s] + REAL(ReKi) :: Steady_RefHt = 0.0_ReKi !< Steady wind -- reference height [meters] + REAL(ReKi) :: Steady_PLexp = 0.0_ReKi !< Steady wind -- power law exponent [-] + CHARACTER(1024) :: Uniform_FileName = '' !< Uniform wind -- filename [-] + REAL(ReKi) :: Uniform_RefHt = 0.0_ReKi !< Uniform wind -- reference height [meters] + REAL(ReKi) :: Uniform_RefLength = 0.0_ReKi !< Uniform wind -- reference length [meters] + CHARACTER(1024) :: TSFF_FileName = '' !< TurbSim Full-Field -- filename [-] + CHARACTER(1024) :: BladedFF_FileName = '' !< Bladed-style Full-Field -- filename [-] + LOGICAL :: BladedFF_TowerFile = .false. !< Bladed-style Full-Field -- tower file exists [-] LOGICAL :: CTTS_CoherentTurb = .FALSE. !< Coherent turbulence data exists [-] - CHARACTER(1024) :: CTTS_FileName !< Name of coherent turbulence file [-] - CHARACTER(1024) :: CTTS_Path !< Path to coherent turbulence binary data files [-] - CHARACTER(1024) :: HAWC_FileName_u !< HAWC -- u component binary data file name [-] - CHARACTER(1024) :: HAWC_FileName_v !< HAWC -- v component binary data file name [-] - CHARACTER(1024) :: HAWC_FileName_w !< HAWC -- w component binary data file name [-] - INTEGER(IntKi) :: HAWC_nx !< HAWC -- number of grids in x direction [-] - INTEGER(IntKi) :: HAWC_ny !< HAWC -- number of grids in y direction [-] - INTEGER(IntKi) :: HAWC_nz !< HAWC -- number of grids in z direction [-] - REAL(ReKi) :: HAWC_dx !< HAWC -- distance between points in x direction [meters] - REAL(ReKi) :: HAWC_dy !< HAWC -- distance between points in y direction [meters] - REAL(ReKi) :: HAWC_dz !< HAWC -- distance between points in z direction [meters] - LOGICAL :: SumPrint !< Write summary info to a file .IfW.Sum [-] - INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] + CHARACTER(1024) :: CTTS_FileName = '' !< Name of coherent turbulence file [-] + CHARACTER(1024) :: CTTS_Path = '' !< Path to coherent turbulence binary data files [-] + CHARACTER(1024) :: HAWC_FileName_u = '' !< HAWC -- u component binary data file name [-] + CHARACTER(1024) :: HAWC_FileName_v = '' !< HAWC -- v component binary data file name [-] + CHARACTER(1024) :: HAWC_FileName_w = '' !< HAWC -- w component binary data file name [-] + INTEGER(IntKi) :: HAWC_nx = 0_IntKi !< HAWC -- number of grids in x direction [-] + INTEGER(IntKi) :: HAWC_ny = 0_IntKi !< HAWC -- number of grids in y direction [-] + INTEGER(IntKi) :: HAWC_nz = 0_IntKi !< HAWC -- number of grids in z direction [-] + REAL(ReKi) :: HAWC_dx = 0.0_ReKi !< HAWC -- distance between points in x direction [meters] + REAL(ReKi) :: HAWC_dy = 0.0_ReKi !< HAWC -- distance between points in y direction [meters] + REAL(ReKi) :: HAWC_dz = 0.0_ReKi !< HAWC -- distance between points in z direction [meters] + LOGICAL :: SumPrint = .false. !< Write summary info to a file .IfW.Sum [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< List of user-requested output channels [-] - INTEGER(IntKi) :: SensorType !< Sensor type (for lidar/sensor module) [-] - INTEGER(IntKi) :: NumBeam !< Number of lidar beams [-] - INTEGER(IntKi) :: NumPulseGate !< The number of range gates to return wind speeds at [-] - REAL(ReKi) , DIMENSION(1:3) :: RotorApexOffsetPos !< Position of the lidar unit relative to the rotor apex of rotation [m] + INTEGER(IntKi) :: SensorType = 0_IntKi !< Sensor type (for lidar/sensor module) [-] + INTEGER(IntKi) :: NumBeam = 0_IntKi !< Number of lidar beams [-] + INTEGER(IntKi) :: NumPulseGate = 0_IntKi !< The number of range gates to return wind speeds at [-] + REAL(ReKi) , DIMENSION(1:3) :: RotorApexOffsetPos = 0.0_ReKi !< Position of the lidar unit relative to the rotor apex of rotation [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FocalDistanceX !< LIDAR LOS focal distance co-ordinates in the x direction [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FocalDistanceY !< LIDAR LOS focal distance co-ordinates in the y direction [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FocalDistanceZ !< LIDAR LOS focal distance co-ordinates in the z direction [m] - REAL(ReKi) :: PulseSpacing !< Distance between range gates [m] - REAL(ReKi) :: MeasurementInterval !< Time between each measurement [s] - REAL(ReKi) :: URefLid !< Reference average wind speed for the lidar [m/s] - LOGICAL :: LidRadialVel !< TRUE => return radial component, FALSE => return 'x' direction estimate [-] - INTEGER(IntKi) :: ConsiderHubMotion !< Flag whether or not the hub motion's impact on the Lidar measurement will be considered [0 for no, 1 for yes] [-] + REAL(ReKi) :: PulseSpacing = 0.0_ReKi !< Distance between range gates [m] + REAL(ReKi) :: MeasurementInterval = 0.0_ReKi !< Time between each measurement [s] + REAL(ReKi) :: URefLid = 0.0_ReKi !< Reference average wind speed for the lidar [m/s] + LOGICAL :: LidRadialVel = .false. !< TRUE => return radial component, FALSE => return 'x' direction estimate [-] + INTEGER(IntKi) :: ConsiderHubMotion = 0_IntKi !< Flag whether or not the hub motion's impact on the Lidar measurement will be considered [0 for no, 1 for yes] [-] TYPE(Grid3D_InitInputType) :: FF !< scaling data [-] END TYPE InflowWind_InputFile ! ======================= ! ========= InflowWind_InitInputType ======= TYPE, PUBLIC :: InflowWind_InitInputType - CHARACTER(1024) :: InputFileName !< Name of the InflowWind input file to use [-] + CHARACTER(1024) :: InputFileName = '' !< Name of the InflowWind input file to use [-] LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] LOGICAL :: Use4Dext = .FALSE. !< Flag that tells this module if an external module will pass it 4-D velocity grids. [-] - INTEGER(IntKi) :: NumWindPoints !< Number of wind velocity points expected [-] + INTEGER(IntKi) :: NumWindPoints = 0_IntKi !< Number of wind velocity points expected [-] INTEGER(IntKi) :: TurbineID = 0 !< Wind turbine ID number in the fixed (DEFAULT) file name when FixedWindFileRootName = .TRUE. (used by FAST.Farm) [-] LOGICAL :: FixedWindFileRootName = .FALSE. !< Do the wind data files have a fixed (DEFAULT) file name? (used by FAST.Farm) [-] LOGICAL :: UseInputFile = .TRUE. !< Should we read everthing from an input file, or do we get it some other way [-] - CHARACTER(1024) :: RootName !< RootName for writing output files [-] + CHARACTER(1024) :: RootName = '' !< RootName for writing output files [-] TYPE(FileInfoType) :: PassedFileData !< If we don't use the input file, pass everything through this [-] LOGICAL :: WindType2UseInputFile = .TRUE. !< Flag for toggling file based IO in wind type 2. [-] TYPE(FileInfoType) :: WindType2Data !< Optional slot for wind type 2 data if file IO is not used. [-] LOGICAL :: OutputAccel = .FALSE. !< Flag to output wind acceleration [-] TYPE(Lidar_InitInputType) :: lidar !< InitInput for lidar data [-] TYPE(Grid4D_InitInputType) :: FDext !< InitInput for 4D external wind data [-] - REAL(ReKi) :: RadAvg !< Radius (from hub) used for averaging wind speed [-] - INTEGER(IntKi) :: MHK !< MHK turbine type switch [-] - REAL(ReKi) :: WtrDpth !< Water depth [m] - REAL(ReKi) :: MSL2SWL !< Mean sea level to still water level [m] + REAL(ReKi) :: RadAvg = 0.0_ReKi !< Radius (from hub) used for averaging wind speed [-] + INTEGER(IntKi) :: MHK = 0_IntKi !< MHK turbine type switch [-] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [m] + REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Mean sea level to still water level [m] INTEGER(IntKi) :: BoxExceedAllowIdx = -1 !< Extrapolate winds outside box starting at this index (for OLAF wakes and LidarSim) [-] LOGICAL :: BoxExceedAllowF = .FALSE. !< Flag to allow Extrapolation winds outside box starting at this index (for OLAF wakes and LidarSim) [-] END TYPE InflowWind_InitInputType @@ -138,13 +138,13 @@ MODULE InflowWind_Types ! ======================= ! ========= InflowWind_ParameterType ======= TYPE, PUBLIC :: InflowWind_ParameterType - CHARACTER(1024) :: RootFileName !< Root of the InflowWind input filename [-] - REAL(DbKi) :: DT !< Time step for cont. state integration & disc. state update [seconds] + CHARACTER(1024) :: RootFileName = '' !< Root of the InflowWind input filename [-] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for cont. state integration & disc. state update [seconds] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WindViXYZprime !< List of XYZ coordinates for velocity measurements, translated to the wind coordinate system (prime coordinates). This equals MATMUL( RotToWind, ParamData%WindViXYZ ) [meters] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WindViXYZ !< List of XYZ coordinates for wind velocity measurements, 3xNWindVel [meters] TYPE(FlowFieldType) , POINTER :: FlowField => NULL() !< Flow field data to represent all wind types [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PositionAvg !< (non-rotated) positions of points used for averaging wind speed [meters] - INTEGER(IntKi) :: NWindVel !< Number of points in the wind velocity list [-] + INTEGER(IntKi) :: NWindVel = 0_IntKi !< Number of points in the wind velocity list [-] INTEGER(IntKi) :: NumOuts = 0 !< Number of parameters in the output list (number of outputs requested) [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: OutParamLinIndx !< Index into WriteOutput for WindViXYZ in linearization analysis [-] @@ -156,8 +156,8 @@ MODULE InflowWind_Types TYPE, PUBLIC :: InflowWind_InputType REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PositionXYZ !< Array holding the input positions at a given timestep [meters] TYPE(Lidar_InputType) :: lidar !< Lidar data [-] - REAL(ReKi) , DIMENSION(1:3) :: HubPosition !< position of the hub (inertial frame) [m] - REAL(ReKi) , DIMENSION(1:3,1:3) :: HubOrientation !< orientation of the hub (direction cosine matrix) [-] + REAL(ReKi) , DIMENSION(1:3) :: HubPosition = 0.0_ReKi !< position of the hub (inertial frame) [m] + REAL(ReKi) , DIMENSION(1:3,1:3) :: HubOrientation = 0.0_ReKi !< orientation of the hub (direction cosine matrix) [-] END TYPE InflowWind_InputType ! ======================= ! ========= InflowWind_OutputType ======= @@ -165,29 +165,29 @@ MODULE InflowWind_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: VelocityUVW !< Array holding the U,V,W velocity for a given timestep [meters/sec] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AccelUVW !< Array holding the U,V,W acceleration for a given timestep [meters/sec] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< Array with values to output to file [-] - REAL(ReKi) , DIMENSION(1:3) :: DiskVel !< Vector holding the U,V,W average velocity of the disk [meters/sec] - REAL(ReKi) , DIMENSION(1:3) :: HubVel !< Vector holding the U,V,W velocity at the hub [meters/sec] + REAL(ReKi) , DIMENSION(1:3) :: DiskVel = 0.0_ReKi !< Vector holding the U,V,W average velocity of the disk [meters/sec] + REAL(ReKi) , DIMENSION(1:3) :: HubVel = 0.0_ReKi !< Vector holding the U,V,W velocity at the hub [meters/sec] TYPE(Lidar_OutputType) :: lidar !< Lidar data [-] END TYPE InflowWind_OutputType ! ======================= ! ========= InflowWind_ContinuousStateType ======= TYPE, PUBLIC :: InflowWind_ContinuousStateType - REAL(ReKi) :: DummyContState !< Remove this variable if you have continuous states [-] + REAL(ReKi) :: DummyContState = 0.0_ReKi !< Remove this variable if you have continuous states [-] END TYPE InflowWind_ContinuousStateType ! ======================= ! ========= InflowWind_DiscreteStateType ======= TYPE, PUBLIC :: InflowWind_DiscreteStateType - REAL(ReKi) :: DummyDiscState !< Remove this variable if you have discrete states [-] + REAL(ReKi) :: DummyDiscState = 0.0_ReKi !< Remove this variable if you have discrete states [-] END TYPE InflowWind_DiscreteStateType ! ======================= ! ========= InflowWind_ConstraintStateType ======= TYPE, PUBLIC :: InflowWind_ConstraintStateType - REAL(ReKi) :: DummyConstrState !< Remove this variable if you have constraint states [-] + REAL(ReKi) :: DummyConstrState = 0.0_ReKi !< Remove this variable if you have constraint states [-] END TYPE InflowWind_ConstraintStateType ! ======================= ! ========= InflowWind_OtherStateType ======= TYPE, PUBLIC :: InflowWind_OtherStateType - REAL(ReKi) :: DummyOtherState !< Remove this variable if you have other states [-] + REAL(ReKi) :: DummyOtherState = 0.0_ReKi !< Remove this variable if you have other states [-] END TYPE InflowWind_OtherStateType ! ======================= ! ========= InflowWind_MiscVarType ======= diff --git a/modules/inflowwind/src/Lidar_Types.f90 b/modules/inflowwind/src/Lidar_Types.f90 index c7f6f7ec1d..df6cfa8402 100644 --- a/modules/inflowwind/src/Lidar_Types.f90 +++ b/modules/inflowwind/src/Lidar_Types.f90 @@ -40,78 +40,78 @@ MODULE Lidar_Types ! ========= Lidar_InitInputType ======= TYPE, PUBLIC :: Lidar_InitInputType INTEGER(IntKi) :: SensorType = SensorType_None !< SensorType_* parameter [-] - REAL(DbKi) :: Tmax !< the length of the simulation [s] - REAL(ReKi) , DIMENSION(1:3) :: RotorApexOffsetPos !< position of the lidar unit relative to the rotor apex of rotation [m] - REAL(ReKi) , DIMENSION(1:3) :: HubPosition !< initial position of the hub (lidar mounted on hub) [0,0,HubHeight] [m] - INTEGER(IntKi) :: NumPulseGate !< the number of range gates to return wind speeds at [-] - LOGICAL :: LidRadialVel !< TRUE => return radial component, FALSE => return 'x' direction estimate [-] + REAL(DbKi) :: Tmax = 0.0_R8Ki !< the length of the simulation [s] + REAL(ReKi) , DIMENSION(1:3) :: RotorApexOffsetPos = 0.0_ReKi !< position of the lidar unit relative to the rotor apex of rotation [m] + REAL(ReKi) , DIMENSION(1:3) :: HubPosition = 0.0_ReKi !< initial position of the hub (lidar mounted on hub) [0,0,HubHeight] [m] + INTEGER(IntKi) :: NumPulseGate = 0_IntKi !< the number of range gates to return wind speeds at [-] + LOGICAL :: LidRadialVel = .false. !< TRUE => return radial component, FALSE => return 'x' direction estimate [-] END TYPE Lidar_InitInputType ! ======================= ! ========= Lidar_InitOutputType ======= TYPE, PUBLIC :: Lidar_InitOutputType - REAL(ReKi) :: DummyInitOut + REAL(ReKi) :: DummyInitOut = 0.0_ReKi END TYPE Lidar_InitOutputType ! ======================= ! ========= Lidar_ParameterType ======= TYPE, PUBLIC :: Lidar_ParameterType - INTEGER(IntKi) :: NumPulseGate !< the number of range gates to return wind speeds at; pulsed lidar only [-] - REAL(ReKi) , DIMENSION(1:3) :: RotorApexOffsetPos !< position of the lidar unit relative to the rotor apex of rotation [m] - REAL(ReKi) :: RayRangeSq !< Rayleigh Range Squared [-] - REAL(ReKi) :: SpatialRes !< spatial sampling distance of weighting function (1/2)*(avg ws)*dt [-] - INTEGER(IntKi) :: SensorType !< SensorType_* parameter [-] - REAL(ReKi) :: WtFnTrunc !< Percentage of the peak value at which to truncate weighting function [-] - REAL(ReKi) :: PulseRangeOne !< the range to the closest range gate [m] - REAL(ReKi) :: DeltaP !< the distance between range gates [m] - REAL(ReKi) :: DeltaR !< the FWHM width of the pulse [-] - REAL(ReKi) :: r_p - LOGICAL :: LidRadialVel !< TRUE => return radial component, FALSE => return 'x' direction estimate [-] - REAL(ReKi) :: DisplacementLidarX !< Displacement of the lidar system from the focal measurement point [m] - REAL(ReKi) :: DisplacementLidarY !< Displacement of the lidar system from the focal measurement point [m] - REAL(ReKi) :: DisplacementLidarZ !< Displacement of the lidar system from the focal measurement point [m] - INTEGER(IntKi) :: NumBeam !< Number of lidar beams [-] + INTEGER(IntKi) :: NumPulseGate = 0_IntKi !< the number of range gates to return wind speeds at; pulsed lidar only [-] + REAL(ReKi) , DIMENSION(1:3) :: RotorApexOffsetPos = 0.0_ReKi !< position of the lidar unit relative to the rotor apex of rotation [m] + REAL(ReKi) :: RayRangeSq = 0.0_ReKi !< Rayleigh Range Squared [-] + REAL(ReKi) :: SpatialRes = 0.0_ReKi !< spatial sampling distance of weighting function (1/2)*(avg ws)*dt [-] + INTEGER(IntKi) :: SensorType = 0_IntKi !< SensorType_* parameter [-] + REAL(ReKi) :: WtFnTrunc = 0.0_ReKi !< Percentage of the peak value at which to truncate weighting function [-] + REAL(ReKi) :: PulseRangeOne = 0.0_ReKi !< the range to the closest range gate [m] + REAL(ReKi) :: DeltaP = 0.0_ReKi !< the distance between range gates [m] + REAL(ReKi) :: DeltaR = 0.0_ReKi !< the FWHM width of the pulse [-] + REAL(ReKi) :: r_p = 0.0_ReKi + LOGICAL :: LidRadialVel = .false. !< TRUE => return radial component, FALSE => return 'x' direction estimate [-] + REAL(ReKi) :: DisplacementLidarX = 0.0_ReKi !< Displacement of the lidar system from the focal measurement point [m] + REAL(ReKi) :: DisplacementLidarY = 0.0_ReKi !< Displacement of the lidar system from the focal measurement point [m] + REAL(ReKi) :: DisplacementLidarZ = 0.0_ReKi !< Displacement of the lidar system from the focal measurement point [m] + INTEGER(IntKi) :: NumBeam = 0_IntKi !< Number of lidar beams [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FocalDistanceX !< LIDAR LOS focal distance co-ordinates in the x direction [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FocalDistanceY !< LIDAR LOS focal distance co-ordinates in the y direction [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FocalDistanceZ !< LIDAR LOS focal distance co-ordinates in the z direction [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: MsrPosition !< Position of the desired wind measurement (was XMsrPt, YMsrPt, ZMsrPt) [m] - REAL(ReKi) :: PulseSpacing !< Distance between range gates [m] - REAL(ReKi) :: URefLid !< Reference average wind speed for the lidar [m/s] - INTEGER(IntKi) :: ConsiderHubMotion !< Flag whether to consider the hub motion's impact on the Lidar measurement [-] - REAL(ReKi) :: MeasurementInterval !< Time steps between lidar measurements [s] - REAL(ReKi) , DIMENSION(1:3) :: LidPosition !< Position of the Lidar unit (was XLidPt, YLidPt, ZLidPt) [m] + REAL(ReKi) :: PulseSpacing = 0.0_ReKi !< Distance between range gates [m] + REAL(ReKi) :: URefLid = 0.0_ReKi !< Reference average wind speed for the lidar [m/s] + INTEGER(IntKi) :: ConsiderHubMotion = 0_IntKi !< Flag whether to consider the hub motion's impact on the Lidar measurement [-] + REAL(ReKi) :: MeasurementInterval = 0.0_ReKi !< Time steps between lidar measurements [s] + REAL(ReKi) , DIMENSION(1:3) :: LidPosition = 0.0_ReKi !< Position of the Lidar unit (was XLidPt, YLidPt, ZLidPt) [m] END TYPE Lidar_ParameterType ! ======================= ! ========= Lidar_ContinuousStateType ======= TYPE, PUBLIC :: Lidar_ContinuousStateType - REAL(ReKi) :: DummyContState !< Remove this variable if you have continuous states [-] + REAL(ReKi) :: DummyContState = 0.0_ReKi !< Remove this variable if you have continuous states [-] END TYPE Lidar_ContinuousStateType ! ======================= ! ========= Lidar_DiscreteStateType ======= TYPE, PUBLIC :: Lidar_DiscreteStateType - REAL(ReKi) :: DummyDiscState !< Remove this variable if you have discrete states [-] + REAL(ReKi) :: DummyDiscState = 0.0_ReKi !< Remove this variable if you have discrete states [-] END TYPE Lidar_DiscreteStateType ! ======================= ! ========= Lidar_ConstraintStateType ======= TYPE, PUBLIC :: Lidar_ConstraintStateType - REAL(ReKi) :: DummyConstrState !< Remove this variable if you have constraint states [-] + REAL(ReKi) :: DummyConstrState = 0.0_ReKi !< Remove this variable if you have constraint states [-] END TYPE Lidar_ConstraintStateType ! ======================= ! ========= Lidar_OtherStateType ======= TYPE, PUBLIC :: Lidar_OtherStateType - REAL(ReKi) :: DummyOtherState + REAL(ReKi) :: DummyOtherState = 0.0_ReKi END TYPE Lidar_OtherStateType ! ======================= ! ========= Lidar_MiscVarType ======= TYPE, PUBLIC :: Lidar_MiscVarType - REAL(ReKi) :: DummyMiscVar !< Remove this variable if you have misc variables [-] + REAL(ReKi) :: DummyMiscVar = 0.0_ReKi !< Remove this variable if you have misc variables [-] END TYPE Lidar_MiscVarType ! ======================= ! ========= Lidar_InputType ======= TYPE, PUBLIC :: Lidar_InputType - REAL(ReKi) :: PulseLidEl !< the angle off of the x axis that the lidar is aimed (0 would be staring directly upwind, pi/2 would be staring perpendicular to the x axis) [-] - REAL(ReKi) :: PulseLidAz !< the angle in the YZ plane that the lidar is staring (if PulseLidEl is set to pi/2, then 0 would be aligned with the positive z axis, pi/2 would be aligned with the positive y axis) [-] - REAL(ReKi) :: HubDisplacementX !< X direction hub displacement of the lidar (from ElastoDyn) [m] - REAL(ReKi) :: HubDisplacementY !< Y direction hub displacement of the lidar (from ElastoDyn) [m] - REAL(ReKi) :: HubDisplacementZ !< Z direction hub displacement of the lidar (from ElastoDyn) [m] + REAL(ReKi) :: PulseLidEl = 0.0_ReKi !< the angle off of the x axis that the lidar is aimed (0 would be staring directly upwind, pi/2 would be staring perpendicular to the x axis) [-] + REAL(ReKi) :: PulseLidAz = 0.0_ReKi !< the angle in the YZ plane that the lidar is staring (if PulseLidEl is set to pi/2, then 0 would be aligned with the positive z axis, pi/2 would be aligned with the positive y axis) [-] + REAL(ReKi) :: HubDisplacementX = 0.0_ReKi !< X direction hub displacement of the lidar (from ElastoDyn) [m] + REAL(ReKi) :: HubDisplacementY = 0.0_ReKi !< Y direction hub displacement of the lidar (from ElastoDyn) [m] + REAL(ReKi) :: HubDisplacementZ = 0.0_ReKi !< Z direction hub displacement of the lidar (from ElastoDyn) [m] END TYPE Lidar_InputType ! ======================= ! ========= Lidar_OutputType ======= diff --git a/modules/map/src/MAP_Fortran_Types.f90 b/modules/map/src/MAP_Fortran_Types.f90 index 9282de9f92..ac349c062b 100644 --- a/modules/map/src/MAP_Fortran_Types.f90 +++ b/modules/map/src/MAP_Fortran_Types.f90 @@ -48,8 +48,8 @@ MODULE MAP_Fortran_Types ! ========= Lin_ParamType ======= TYPE, PUBLIC :: Lin_ParamType INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian (fortran-only) [-] - REAL(R8Ki) :: du !< determines size of the translational displacement perturbation for u (inputs) (fortran-only) [-] - INTEGER(IntKi) :: Jac_ny !< number of outputs in jacobian matrix (fortran-only) [-] + REAL(R8Ki) :: du = 0.0_R8Ki !< determines size of the translational displacement perturbation for u (inputs) (fortran-only) [-] + INTEGER(IntKi) :: Jac_ny = 0_IntKi !< number of outputs in jacobian matrix (fortran-only) [-] END TYPE Lin_ParamType ! ======================= CONTAINS diff --git a/modules/map/src/MAP_Types.f90 b/modules/map/src/MAP_Types.f90 index 2a7cbac24e..26be3ddba4 100644 --- a/modules/map/src/MAP_Types.f90 +++ b/modules/map/src/MAP_Types.f90 @@ -52,12 +52,12 @@ MODULE MAP_Types REAL(R8Ki) :: gravity = -999.9 !< gravity constant [[m/s^2]] REAL(R8Ki) :: sea_density = -999.9 !< sea density [[kg/m^3]] REAL(R8Ki) :: depth = -999.9 !< depth of water [[m]] - CHARACTER(255) :: file_name !< MAP input file [-] - CHARACTER(255) :: summary_file_name !< MAP summary file name [-] - CHARACTER(255) :: library_input_str !< cable library string information (from input file) [-] - CHARACTER(255) :: node_input_str !< node string information (from input file) [-] - CHARACTER(255) :: line_input_str !< element library string information (from input file) [-] - CHARACTER(255) :: option_input_str !< solver options library string information (from input file) [-] + CHARACTER(255) :: file_name = '' !< MAP input file [-] + CHARACTER(255) :: summary_file_name = '' !< MAP summary file name [-] + CHARACTER(255) :: library_input_str = '' !< cable library string information (from input file) [-] + CHARACTER(255) :: node_input_str = '' !< node string information (from input file) [-] + CHARACTER(255) :: line_input_str = '' !< element library string information (from input file) [-] + CHARACTER(255) :: option_input_str = '' !< solver options library string information (from input file) [-] TYPE(Lin_InitInputType) :: LinInitInp !< [-] END TYPE MAP_InitInputType ! ======================= @@ -74,9 +74,9 @@ MODULE MAP_Types END TYPE MAP_InitOutputType_C TYPE, PUBLIC :: MAP_InitOutputType TYPE( MAP_InitOutputType_C ) :: C_obj - CHARACTER(99) :: progName !< program name [-] - CHARACTER(99) :: version !< version numnber [-] - CHARACTER(24) :: compilingData !< compiling data [-] + CHARACTER(99) :: progName = '' !< program name [-] + CHARACTER(99) :: version = '' !< version numnber [-] + CHARACTER(24) :: compilingData = '' !< compiling data [-] CHARACTER(15) , DIMENSION(:), ALLOCATABLE :: writeOutputHdr !< first line output file contents: output variable names [-] CHARACTER(15) , DIMENSION(:), ALLOCATABLE :: writeOutputUnt !< second line of output file contents: units [-] TYPE(ProgDesc) :: Ver !< this module's name, version, and date [-] @@ -90,7 +90,7 @@ MODULE MAP_Types END TYPE MAP_ContinuousStateType_C TYPE, PUBLIC :: MAP_ContinuousStateType TYPE( MAP_ContinuousStateType_C ) :: C_obj - REAL(R8Ki) :: dummy !< Remove this variable if you have continuous states [-] + REAL(R8Ki) :: dummy = 0.0_R8Ki !< Remove this variable if you have continuous states [-] END TYPE MAP_ContinuousStateType ! ======================= ! ========= MAP_DiscreteStateType_C ======= @@ -100,7 +100,7 @@ MODULE MAP_Types END TYPE MAP_DiscreteStateType_C TYPE, PUBLIC :: MAP_DiscreteStateType TYPE( MAP_DiscreteStateType_C ) :: C_obj - REAL(R8Ki) :: dummy !< Remove this variable if you have discrete states [-] + REAL(R8Ki) :: dummy = 0.0_R8Ki !< Remove this variable if you have discrete states [-] END TYPE MAP_DiscreteStateType ! ======================= ! ========= MAP_OtherStateType_C ======= @@ -193,12 +193,12 @@ MODULE MAP_Types END TYPE MAP_ParameterType_C TYPE, PUBLIC :: MAP_ParameterType TYPE( MAP_ParameterType_C ) :: C_obj - REAL(R8Ki) :: g !< gravitational constant [[kg/m^2]] - REAL(R8Ki) :: depth !< distance to seabed [[m]] - REAL(R8Ki) :: rho_sea !< density of seawater [[m]] - REAL(R8Ki) :: dt !< time step coupling interval [[sec]] - CHARACTER(255) , DIMENSION(1:500) :: InputLines !< input file line for restart [-] - CHARACTER(1) , DIMENSION(1:500) :: InputLineType !< input file line type for restart [-] + REAL(R8Ki) :: g = 0.0_R8Ki !< gravitational constant [[kg/m^2]] + REAL(R8Ki) :: depth = 0.0_R8Ki !< distance to seabed [[m]] + REAL(R8Ki) :: rho_sea = 0.0_R8Ki !< density of seawater [[m]] + REAL(R8Ki) :: dt = 0.0_R8Ki !< time step coupling interval [[sec]] + CHARACTER(255) , DIMENSION(1:500) :: InputLines = '' !< input file line for restart [-] + CHARACTER(1) , DIMENSION(1:500) :: InputLineType = '' !< input file line type for restart [-] INTEGER(IntKi) :: numOuts = 0 !< Number of write outputs [-] TYPE(Lin_ParamType) :: LinParams !< Parameter linearization data (fortran-only) [-] END TYPE MAP_ParameterType diff --git a/modules/moordyn/src/MoorDyn_Types.f90 b/modules/moordyn/src/MoorDyn_Types.f90 index 0e3188fbd8..1c05f4a030 100644 --- a/modules/moordyn/src/MoorDyn_Types.f90 +++ b/modules/moordyn/src/MoorDyn_Types.f90 @@ -49,147 +49,147 @@ MODULE MoorDyn_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PtfmInit !< initial position of platform(s) shape: 6, nTurbines [-] INTEGER(IntKi) :: FarmSize = 0 !< Indicates normal FAST module mode if 0, FAST.Farm coupled mode and =nTurbines if >0 [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TurbineRefPos !< reference position of turbines in farm, shape: 3, nTurbines [-] - REAL(ReKi) :: Tmax !< simulation duration [[s]] - CHARACTER(1024) :: FileName !< MoorDyn input file [-] - CHARACTER(1024) :: RootName !< RootName for writing output files [-] + REAL(ReKi) :: Tmax = 0.0_ReKi !< simulation duration [[s]] + CHARACTER(1024) :: FileName = '' !< MoorDyn input file [-] + CHARACTER(1024) :: RootName = '' !< RootName for writing output files [-] LOGICAL :: UsePrimaryInputFile = .TRUE. !< Read input file instead of passed data [-] TYPE(FileInfoType) :: PassedPrimaryInputData !< Primary input file as FileInfoType (set by driver/glue code) -- String array with metadata [-] - LOGICAL :: Echo !< echo parameter - do we want to echo the header line describing the input file? [-] + LOGICAL :: Echo = .false. !< echo parameter - do we want to echo the header line describing the input file? [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< string containing list of output channels requested in input file [-] LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] END TYPE MD_InitInputType ! ======================= ! ========= MD_LineProp ======= TYPE, PUBLIC :: MD_LineProp - INTEGER(IntKi) :: IdNum !< integer identifier of this set of line properties [-] - CHARACTER(20) :: name !< name/identifier of this set of line properties [-] - REAL(DbKi) :: d !< volume-equivalent diameter [[m]] - REAL(DbKi) :: w !< per-length weight in air [[kg/m]] - REAL(DbKi) :: EA !< axial stiffness [[N]] - REAL(DbKi) :: EA_D !< axial stiffness [[N]] - REAL(DbKi) :: BA !< internal damping coefficient times area [[N-s]] - REAL(DbKi) :: BA_D !< internal damping coefficient times area [[N-s]] - REAL(DbKi) :: EI !< bending stiffness [[N-m]] - REAL(DbKi) :: Can !< transverse added mass coefficient [-] - REAL(DbKi) :: Cat !< tangential added mass coefficient [-] - REAL(DbKi) :: Cdn !< transverse drag coefficient [-] - REAL(DbKi) :: Cdt !< tangential drag coefficient [-] - INTEGER(IntKi) :: ElasticMod !< Which elasticity model to use: {0 basic, 1 viscoelastic, 2 future SYCOM} [-] + INTEGER(IntKi) :: IdNum = 0_IntKi !< integer identifier of this set of line properties [-] + CHARACTER(20) :: name = '' !< name/identifier of this set of line properties [-] + REAL(DbKi) :: d = 0.0_R8Ki !< volume-equivalent diameter [[m]] + REAL(DbKi) :: w = 0.0_R8Ki !< per-length weight in air [[kg/m]] + REAL(DbKi) :: EA = 0.0_R8Ki !< axial stiffness [[N]] + REAL(DbKi) :: EA_D = 0.0_R8Ki !< axial stiffness [[N]] + REAL(DbKi) :: BA = 0.0_R8Ki !< internal damping coefficient times area [[N-s]] + REAL(DbKi) :: BA_D = 0.0_R8Ki !< internal damping coefficient times area [[N-s]] + REAL(DbKi) :: EI = 0.0_R8Ki !< bending stiffness [[N-m]] + REAL(DbKi) :: Can = 0.0_R8Ki !< transverse added mass coefficient [-] + REAL(DbKi) :: Cat = 0.0_R8Ki !< tangential added mass coefficient [-] + REAL(DbKi) :: Cdn = 0.0_R8Ki !< transverse drag coefficient [-] + REAL(DbKi) :: Cdt = 0.0_R8Ki !< tangential drag coefficient [-] + INTEGER(IntKi) :: ElasticMod = 0_IntKi !< Which elasticity model to use: {0 basic, 1 viscoelastic, 2 future SYCOM} [-] INTEGER(IntKi) :: nEApoints = 0 !< number of values in stress-strain lookup table (0 means using constant E) [-] - REAL(DbKi) , DIMENSION(1:30) :: stiffXs !< x array for stress-strain lookup table (up to nCoef) [-] - REAL(DbKi) , DIMENSION(1:30) :: stiffYs !< y array for stress-strain lookup table [-] + REAL(DbKi) , DIMENSION(1:30) :: stiffXs = 0.0_R8Ki !< x array for stress-strain lookup table (up to nCoef) [-] + REAL(DbKi) , DIMENSION(1:30) :: stiffYs = 0.0_R8Ki !< y array for stress-strain lookup table [-] INTEGER(IntKi) :: nBApoints = 0 !< number of values in stress-strainrate lookup table (0 means using constant c) [-] - REAL(DbKi) , DIMENSION(1:30) :: dampXs !< x array for stress-strainrate lookup table (up to nCoef) [-] - REAL(DbKi) , DIMENSION(1:30) :: dampYs !< y array for stress-strainrate lookup table [-] + REAL(DbKi) , DIMENSION(1:30) :: dampXs = 0.0_R8Ki !< x array for stress-strainrate lookup table (up to nCoef) [-] + REAL(DbKi) , DIMENSION(1:30) :: dampYs = 0.0_R8Ki !< y array for stress-strainrate lookup table [-] INTEGER(IntKi) :: nEIpoints = 0 !< number of values in bending stress-strain lookup table (0 means using constant E) [-] - REAL(DbKi) , DIMENSION(1:30) :: bstiffXs !< x array for stress-strain lookup table (up to nCoef) [-] - REAL(DbKi) , DIMENSION(1:30) :: bstiffYs !< y array for stress-strain lookup table [-] + REAL(DbKi) , DIMENSION(1:30) :: bstiffXs = 0.0_R8Ki !< x array for stress-strain lookup table (up to nCoef) [-] + REAL(DbKi) , DIMENSION(1:30) :: bstiffYs = 0.0_R8Ki !< y array for stress-strain lookup table [-] END TYPE MD_LineProp ! ======================= ! ========= MD_RodProp ======= TYPE, PUBLIC :: MD_RodProp - INTEGER(IntKi) :: IdNum !< integer identifier of this set of rod properties [-] - CHARACTER(10) :: name !< name/identifier of this set of rod properties [-] - REAL(DbKi) :: d !< volume-equivalent diameter [[m]] - REAL(DbKi) :: w !< per-length weight in air [[kg/m]] - REAL(DbKi) :: Can !< transverse added mass coefficient [-] - REAL(DbKi) :: Cat !< tangential added mass coefficient [-] - REAL(DbKi) :: Cdn !< transverse drag coefficient [-] - REAL(DbKi) :: Cdt !< tangential drag coefficient [-] - REAL(DbKi) :: CdEnd !< drag coefficient for rod end [[-]] - REAL(DbKi) :: CaEnd !< added mass coefficient for rod end [[-]] + INTEGER(IntKi) :: IdNum = 0_IntKi !< integer identifier of this set of rod properties [-] + CHARACTER(10) :: name = '' !< name/identifier of this set of rod properties [-] + REAL(DbKi) :: d = 0.0_R8Ki !< volume-equivalent diameter [[m]] + REAL(DbKi) :: w = 0.0_R8Ki !< per-length weight in air [[kg/m]] + REAL(DbKi) :: Can = 0.0_R8Ki !< transverse added mass coefficient [-] + REAL(DbKi) :: Cat = 0.0_R8Ki !< tangential added mass coefficient [-] + REAL(DbKi) :: Cdn = 0.0_R8Ki !< transverse drag coefficient [-] + REAL(DbKi) :: Cdt = 0.0_R8Ki !< tangential drag coefficient [-] + REAL(DbKi) :: CdEnd = 0.0_R8Ki !< drag coefficient for rod end [[-]] + REAL(DbKi) :: CaEnd = 0.0_R8Ki !< added mass coefficient for rod end [[-]] END TYPE MD_RodProp ! ======================= ! ========= MD_Body ======= TYPE, PUBLIC :: MD_Body - INTEGER(IntKi) :: IdNum !< integer identifier of this Connection [-] - INTEGER(IntKi) :: typeNum !< integer identifying the type. 0=fixed, 1=vessel, 2=connect [-] - INTEGER(IntKi) , DIMENSION(1:30) :: AttachedC !< list of IdNums of connections attached to this body [-] - INTEGER(IntKi) , DIMENSION(1:30) :: AttachedR !< list of IdNums of rods attached to this body [-] + INTEGER(IntKi) :: IdNum = 0_IntKi !< integer identifier of this Connection [-] + INTEGER(IntKi) :: typeNum = 0_IntKi !< integer identifying the type. 0=fixed, 1=vessel, 2=connect [-] + INTEGER(IntKi) , DIMENSION(1:30) :: AttachedC = 0_IntKi !< list of IdNums of connections attached to this body [-] + INTEGER(IntKi) , DIMENSION(1:30) :: AttachedR = 0_IntKi !< list of IdNums of rods attached to this body [-] INTEGER(IntKi) :: nAttachedC = 0 !< number of attached connections [-] INTEGER(IntKi) :: nAttachedR = 0 !< number of attached rods [-] - REAL(DbKi) , DIMENSION(1:3,1:30) :: rConnectRel !< relative position of connection on body [-] - REAL(DbKi) , DIMENSION(1:6,1:30) :: r6RodRel !< relative position and orientation of rod on body [-] - REAL(DbKi) :: bodyM !< [-] - REAL(DbKi) :: bodyV !< [-] - REAL(DbKi) , DIMENSION(1:3) :: bodyI !< [-] - REAL(DbKi) , DIMENSION(1:6) :: bodyCdA !< product of drag force and frontal area of connection point [[m^2]] - REAL(DbKi) , DIMENSION(1:6) :: bodyCa !< added mass coefficient of connection point [-] - REAL(DbKi) :: time !< current time [[s]] - REAL(DbKi) , DIMENSION(1:6) :: r6 !< position [-] - REAL(DbKi) , DIMENSION(1:6) :: v6 !< velocity [-] - REAL(DbKi) , DIMENSION(1:6) :: a6 !< acceleration (only used for coupled bodies) [-] - REAL(DbKi) , DIMENSION(1:3) :: U !< water velocity at ref point [[m/s]] - REAL(DbKi) , DIMENSION(1:3) :: Ud !< water acceleration at ref point [[m/s^2]] - REAL(DbKi) :: zeta !< water surface elevation above ref point [[m]] - REAL(DbKi) , DIMENSION(1:6) :: F6net !< total force and moment on body (excluding inertial loads) [-] - REAL(DbKi) , DIMENSION(1:6,1:6) :: M6net !< total mass matrix of Body and any attached objects [-] - REAL(DbKi) , DIMENSION(1:6,1:6) :: M !< rotated body 6-dof mass and inertia matrix in global orientation [-] - REAL(DbKi) , DIMENSION(1:6,1:6) :: M0 !< body 6-dof mass and inertia matrix in its own frame [-] - REAL(DbKi) , DIMENSION(1:3,1:3) :: OrMat !< DCM for body orientation [-] - REAL(DbKi) , DIMENSION(1:3) :: rCG !< vector in body frame from ref point to CG (before rods etc..) [-] + REAL(DbKi) , DIMENSION(1:3,1:30) :: rConnectRel = 0.0_R8Ki !< relative position of connection on body [-] + REAL(DbKi) , DIMENSION(1:6,1:30) :: r6RodRel = 0.0_R8Ki !< relative position and orientation of rod on body [-] + REAL(DbKi) :: bodyM = 0.0_R8Ki !< [-] + REAL(DbKi) :: bodyV = 0.0_R8Ki !< [-] + REAL(DbKi) , DIMENSION(1:3) :: bodyI = 0.0_R8Ki !< [-] + REAL(DbKi) , DIMENSION(1:6) :: bodyCdA = 0.0_R8Ki !< product of drag force and frontal area of connection point [[m^2]] + REAL(DbKi) , DIMENSION(1:6) :: bodyCa = 0.0_R8Ki !< added mass coefficient of connection point [-] + REAL(DbKi) :: time = 0.0_R8Ki !< current time [[s]] + REAL(DbKi) , DIMENSION(1:6) :: r6 = 0.0_R8Ki !< position [-] + REAL(DbKi) , DIMENSION(1:6) :: v6 = 0.0_R8Ki !< velocity [-] + REAL(DbKi) , DIMENSION(1:6) :: a6 = 0.0_R8Ki !< acceleration (only used for coupled bodies) [-] + REAL(DbKi) , DIMENSION(1:3) :: U = 0.0_R8Ki !< water velocity at ref point [[m/s]] + REAL(DbKi) , DIMENSION(1:3) :: Ud = 0.0_R8Ki !< water acceleration at ref point [[m/s^2]] + REAL(DbKi) :: zeta = 0.0_R8Ki !< water surface elevation above ref point [[m]] + REAL(DbKi) , DIMENSION(1:6) :: F6net = 0.0_R8Ki !< total force and moment on body (excluding inertial loads) [-] + REAL(DbKi) , DIMENSION(1:6,1:6) :: M6net = 0.0_R8Ki !< total mass matrix of Body and any attached objects [-] + REAL(DbKi) , DIMENSION(1:6,1:6) :: M = 0.0_R8Ki !< rotated body 6-dof mass and inertia matrix in global orientation [-] + REAL(DbKi) , DIMENSION(1:6,1:6) :: M0 = 0.0_R8Ki !< body 6-dof mass and inertia matrix in its own frame [-] + REAL(DbKi) , DIMENSION(1:3,1:3) :: OrMat = 0.0_R8Ki !< DCM for body orientation [-] + REAL(DbKi) , DIMENSION(1:3) :: rCG = 0.0_R8Ki !< vector in body frame from ref point to CG (before rods etc..) [-] END TYPE MD_Body ! ======================= ! ========= MD_Connect ======= TYPE, PUBLIC :: MD_Connect - INTEGER(IntKi) :: IdNum !< integer identifier of this Connection [-] - CHARACTER(10) :: type !< type of Connect: fix, vessel, connect [-] - INTEGER(IntKi) :: typeNum !< integer identifying the type. 0=fixed, 1=vessel, 2=connect [-] - INTEGER(IntKi) , DIMENSION(1:10) :: Attached !< list of IdNums of lines attached to this connection node [-] - INTEGER(IntKi) , DIMENSION(1:10) :: Top !< list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] + INTEGER(IntKi) :: IdNum = 0_IntKi !< integer identifier of this Connection [-] + CHARACTER(10) :: type = '' !< type of Connect: fix, vessel, connect [-] + INTEGER(IntKi) :: typeNum = 0_IntKi !< integer identifying the type. 0=fixed, 1=vessel, 2=connect [-] + INTEGER(IntKi) , DIMENSION(1:10) :: Attached = 0_IntKi !< list of IdNums of lines attached to this connection node [-] + INTEGER(IntKi) , DIMENSION(1:10) :: Top = 0_IntKi !< list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] INTEGER(IntKi) :: nAttached = 0 !< number of attached lines [-] - REAL(DbKi) :: conM !< [-] - REAL(DbKi) :: conV !< [-] - REAL(DbKi) :: conFX !< [-] - REAL(DbKi) :: conFY !< [-] - REAL(DbKi) :: conFZ !< [-] - REAL(DbKi) :: conCa !< added mass coefficient of connection point [-] - REAL(DbKi) :: conCdA !< product of drag force and frontal area of connection point [[m^2]] - REAL(DbKi) :: time !< current time [[s]] - REAL(DbKi) , DIMENSION(1:3) :: r !< position [-] - REAL(DbKi) , DIMENSION(1:3) :: rd !< velocity [-] - REAL(DbKi) , DIMENSION(1:3) :: a !< acceleration (only used for coupled points) [-] - REAL(DbKi) , DIMENSION(1:3) :: U !< water velocity at node [[m/s]] - REAL(DbKi) , DIMENSION(1:3) :: Ud !< water acceleration at node [[m/s^2]] - REAL(DbKi) :: zeta !< water surface elevation above node [[m]] + REAL(DbKi) :: conM = 0.0_R8Ki !< [-] + REAL(DbKi) :: conV = 0.0_R8Ki !< [-] + REAL(DbKi) :: conFX = 0.0_R8Ki !< [-] + REAL(DbKi) :: conFY = 0.0_R8Ki !< [-] + REAL(DbKi) :: conFZ = 0.0_R8Ki !< [-] + REAL(DbKi) :: conCa = 0.0_R8Ki !< added mass coefficient of connection point [-] + REAL(DbKi) :: conCdA = 0.0_R8Ki !< product of drag force and frontal area of connection point [[m^2]] + REAL(DbKi) :: time = 0.0_R8Ki !< current time [[s]] + REAL(DbKi) , DIMENSION(1:3) :: r = 0.0_R8Ki !< position [-] + REAL(DbKi) , DIMENSION(1:3) :: rd = 0.0_R8Ki !< velocity [-] + REAL(DbKi) , DIMENSION(1:3) :: a = 0.0_R8Ki !< acceleration (only used for coupled points) [-] + REAL(DbKi) , DIMENSION(1:3) :: U = 0.0_R8Ki !< water velocity at node [[m/s]] + REAL(DbKi) , DIMENSION(1:3) :: Ud = 0.0_R8Ki !< water acceleration at node [[m/s^2]] + REAL(DbKi) :: zeta = 0.0_R8Ki !< water surface elevation above node [[m]] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: PDyn !< water dynamic pressure at node [[Pa]] - REAL(DbKi) , DIMENSION(1:3) :: Fnet !< total force on node (excluding inertial loads) [-] - REAL(DbKi) , DIMENSION(1:3,1:3) :: M !< node mass matrix, from attached lines [-] + REAL(DbKi) , DIMENSION(1:3) :: Fnet = 0.0_R8Ki !< total force on node (excluding inertial loads) [-] + REAL(DbKi) , DIMENSION(1:3,1:3) :: M = 0.0_R8Ki !< node mass matrix, from attached lines [-] END TYPE MD_Connect ! ======================= ! ========= MD_Rod ======= TYPE, PUBLIC :: MD_Rod - INTEGER(IntKi) :: IdNum !< integer identifier of this Line [-] - CHARACTER(10) :: type !< type of Rod. should match one of RodProp names [-] - INTEGER(IntKi) :: PropsIdNum !< the IdNum of the associated rod properties [-] - INTEGER(IntKi) :: typeNum !< integer identifying the type. 0=fixed, 1=vessel, 2=connect [-] - INTEGER(IntKi) , DIMENSION(1:10) :: AttachedA !< list of IdNums of lines attached to end A [-] - INTEGER(IntKi) , DIMENSION(1:10) :: AttachedB !< list of IdNums of lines attached to end B [-] - INTEGER(IntKi) , DIMENSION(1:10) :: TopA !< list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] - INTEGER(IntKi) , DIMENSION(1:10) :: TopB !< list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] + INTEGER(IntKi) :: IdNum = 0_IntKi !< integer identifier of this Line [-] + CHARACTER(10) :: type = '' !< type of Rod. should match one of RodProp names [-] + INTEGER(IntKi) :: PropsIdNum = 0_IntKi !< the IdNum of the associated rod properties [-] + INTEGER(IntKi) :: typeNum = 0_IntKi !< integer identifying the type. 0=fixed, 1=vessel, 2=connect [-] + INTEGER(IntKi) , DIMENSION(1:10) :: AttachedA = 0_IntKi !< list of IdNums of lines attached to end A [-] + INTEGER(IntKi) , DIMENSION(1:10) :: AttachedB = 0_IntKi !< list of IdNums of lines attached to end B [-] + INTEGER(IntKi) , DIMENSION(1:10) :: TopA = 0_IntKi !< list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] + INTEGER(IntKi) , DIMENSION(1:10) :: TopB = 0_IntKi !< list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] INTEGER(IntKi) :: nAttachedA = 0 !< number of attached lines to Rod end A [-] INTEGER(IntKi) :: nAttachedB = 0 !< number of attached lines to Rod end B [-] - INTEGER(IntKi) , DIMENSION(1:20) :: OutFlagList !< array specifying what line quantities should be output (1 vs 0) [-] - INTEGER(IntKi) :: N !< The number of elements in the line [-] - INTEGER(IntKi) :: endTypeA !< type of connection at end A: 0=pinned to Connection, 1=cantilevered to Rod. [-] - INTEGER(IntKi) :: endTypeB !< type of connection at end B: 0=pinned to Connection, 1=cantilevered to Rod. [-] - REAL(DbKi) :: UnstrLen !< length of the rod [[m]] - REAL(DbKi) :: mass !< mass of the rod [[kg]] - REAL(DbKi) :: rho !< density [[kg/m3]] - REAL(DbKi) :: d !< volume-equivalent diameter [[m]] - REAL(DbKi) :: Can !< [[-]] - REAL(DbKi) :: Cat !< [[-]] - REAL(DbKi) :: Cdn !< [[-]] - REAL(DbKi) :: Cdt !< [[-]] - REAL(DbKi) :: CdEnd !< drag coefficient for rod end [[-]] - REAL(DbKi) :: CaEnd !< added mass coefficient for rod end [[-]] - REAL(DbKi) :: time !< current time [[s]] - REAL(DbKi) :: roll !< roll relative to vertical [deg] - REAL(DbKi) :: pitch !< pitch relative to vertical [deg] - REAL(DbKi) :: h0 !< submerged length of rod axis, distance along rod centerline from end A to the waterplane (0 <= h0 <= L) [m] + INTEGER(IntKi) , DIMENSION(1:20) :: OutFlagList = 0_IntKi !< array specifying what line quantities should be output (1 vs 0) [-] + INTEGER(IntKi) :: N = 0_IntKi !< The number of elements in the line [-] + INTEGER(IntKi) :: endTypeA = 0_IntKi !< type of connection at end A: 0=pinned to Connection, 1=cantilevered to Rod. [-] + INTEGER(IntKi) :: endTypeB = 0_IntKi !< type of connection at end B: 0=pinned to Connection, 1=cantilevered to Rod. [-] + REAL(DbKi) :: UnstrLen = 0.0_R8Ki !< length of the rod [[m]] + REAL(DbKi) :: mass = 0.0_R8Ki !< mass of the rod [[kg]] + REAL(DbKi) :: rho = 0.0_R8Ki !< density [[kg/m3]] + REAL(DbKi) :: d = 0.0_R8Ki !< volume-equivalent diameter [[m]] + REAL(DbKi) :: Can = 0.0_R8Ki !< [[-]] + REAL(DbKi) :: Cat = 0.0_R8Ki !< [[-]] + REAL(DbKi) :: Cdn = 0.0_R8Ki !< [[-]] + REAL(DbKi) :: Cdt = 0.0_R8Ki !< [[-]] + REAL(DbKi) :: CdEnd = 0.0_R8Ki !< drag coefficient for rod end [[-]] + REAL(DbKi) :: CaEnd = 0.0_R8Ki !< added mass coefficient for rod end [[-]] + REAL(DbKi) :: time = 0.0_R8Ki !< current time [[s]] + REAL(DbKi) :: roll = 0.0_R8Ki !< roll relative to vertical [deg] + REAL(DbKi) :: pitch = 0.0_R8Ki !< pitch relative to vertical [deg] + REAL(DbKi) :: h0 = 0.0_R8Ki !< submerged length of rod axis, distance along rod centerline from end A to the waterplane (0 <= h0 <= L) [m] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: r !< node positions [-] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: rd !< node velocities [-] - REAL(DbKi) , DIMENSION(1:3) :: q !< tangent vector for rod as a whole [-] + REAL(DbKi) , DIMENSION(1:3) :: q = 0.0_R8Ki !< tangent vector for rod as a whole [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: l !< segment unstretched length [[m]] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: V !< segment volume [[m^3]] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: U !< water velocity at node [[m/s]] @@ -206,53 +206,53 @@ MODULE MoorDyn_Types REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: B !< node bottom contact force [[N]] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: Fnet !< total force on node [[N]] REAL(DbKi) , DIMENSION(:,:,:), ALLOCATABLE :: M !< node mass matrix [[kg]] - REAL(DbKi) , DIMENSION(1:3) :: FextA !< external forces from attached lines on/about end A [-] - REAL(DbKi) , DIMENSION(1:3) :: FextB !< external forces from attached lines on/about end A [-] - REAL(DbKi) , DIMENSION(1:3) :: Mext !< external moment vector holding sum of any externally applied moments i.e. bending lines [-] - REAL(DbKi) , DIMENSION(1:6) :: r6 !< 6 DOF position vector [-] - REAL(DbKi) , DIMENSION(1:6) :: v6 !< 6 DOF velocity vector [-] - REAL(DbKi) , DIMENSION(1:6) :: a6 !< 6 DOF acceleration vector (only used for coupled Rods) [-] - REAL(DbKi) , DIMENSION(1:6) :: F6net !< total force and moment about end A (excluding inertial loads) that Rod may exert on whatever it's attached to [-] - REAL(DbKi) , DIMENSION(1:6,1:6) :: M6net !< total mass matrix about end A of Rod and any attached Points [-] - REAL(DbKi) , DIMENSION(1:3,1:3) :: OrMat !< DCM for body orientation [-] - INTEGER(IntKi) :: RodUnOut !< unit number of rod output file [-] + REAL(DbKi) , DIMENSION(1:3) :: FextA = 0.0_R8Ki !< external forces from attached lines on/about end A [-] + REAL(DbKi) , DIMENSION(1:3) :: FextB = 0.0_R8Ki !< external forces from attached lines on/about end A [-] + REAL(DbKi) , DIMENSION(1:3) :: Mext = 0.0_R8Ki !< external moment vector holding sum of any externally applied moments i.e. bending lines [-] + REAL(DbKi) , DIMENSION(1:6) :: r6 = 0.0_R8Ki !< 6 DOF position vector [-] + REAL(DbKi) , DIMENSION(1:6) :: v6 = 0.0_R8Ki !< 6 DOF velocity vector [-] + REAL(DbKi) , DIMENSION(1:6) :: a6 = 0.0_R8Ki !< 6 DOF acceleration vector (only used for coupled Rods) [-] + REAL(DbKi) , DIMENSION(1:6) :: F6net = 0.0_R8Ki !< total force and moment about end A (excluding inertial loads) that Rod may exert on whatever it's attached to [-] + REAL(DbKi) , DIMENSION(1:6,1:6) :: M6net = 0.0_R8Ki !< total mass matrix about end A of Rod and any attached Points [-] + REAL(DbKi) , DIMENSION(1:3,1:3) :: OrMat = 0.0_R8Ki !< DCM for body orientation [-] + INTEGER(IntKi) :: RodUnOut = 0_IntKi !< unit number of rod output file [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: RodWrOutput !< one row of output data for this rod [-] END TYPE MD_Rod ! ======================= ! ========= MD_Line ======= TYPE, PUBLIC :: MD_Line - INTEGER(IntKi) :: IdNum !< integer identifier of this Line [-] - INTEGER(IntKi) :: PropsIdNum !< the IdNum of the associated line properties [-] - INTEGER(IntKi) :: ElasticMod !< Which elasticity model to use: {0 basic, 1 viscoelastic, 2 future SYCOM} [-] - INTEGER(IntKi) , DIMENSION(1:20) :: OutFlagList !< array specifying what line quantities should be output (1 vs 0) [-] + INTEGER(IntKi) :: IdNum = 0_IntKi !< integer identifier of this Line [-] + INTEGER(IntKi) :: PropsIdNum = 0_IntKi !< the IdNum of the associated line properties [-] + INTEGER(IntKi) :: ElasticMod = 0_IntKi !< Which elasticity model to use: {0 basic, 1 viscoelastic, 2 future SYCOM} [-] + INTEGER(IntKi) , DIMENSION(1:20) :: OutFlagList = 0_IntKi !< array specifying what line quantities should be output (1 vs 0) [-] INTEGER(IntKi) :: CtrlChan = 0 !< index of control channel that will drive line active tensioning (0 for none) [-] - INTEGER(IntKi) :: FairConnect !< IdNum of Connection at fairlead [-] - INTEGER(IntKi) :: AnchConnect !< IdNum of Connection at anchor [-] - INTEGER(IntKi) :: N !< The number of elements in the line [-] - INTEGER(IntKi) :: endTypeA !< type of connection at end A: 0=pinned to Connection, 1=cantilevered to Rod. [-] - INTEGER(IntKi) :: endTypeB !< type of connection at end B: 0=pinned to Connection, 1=cantilevered to Rod. [-] - REAL(DbKi) :: UnstrLen !< unstretched length of the line [-] - REAL(DbKi) :: rho !< density [[kg/m3]] - REAL(DbKi) :: d !< volume-equivalent diameter [[m]] + INTEGER(IntKi) :: FairConnect = 0_IntKi !< IdNum of Connection at fairlead [-] + INTEGER(IntKi) :: AnchConnect = 0_IntKi !< IdNum of Connection at anchor [-] + INTEGER(IntKi) :: N = 0_IntKi !< The number of elements in the line [-] + INTEGER(IntKi) :: endTypeA = 0_IntKi !< type of connection at end A: 0=pinned to Connection, 1=cantilevered to Rod. [-] + INTEGER(IntKi) :: endTypeB = 0_IntKi !< type of connection at end B: 0=pinned to Connection, 1=cantilevered to Rod. [-] + REAL(DbKi) :: UnstrLen = 0.0_R8Ki !< unstretched length of the line [-] + REAL(DbKi) :: rho = 0.0_R8Ki !< density [[kg/m3]] + REAL(DbKi) :: d = 0.0_R8Ki !< volume-equivalent diameter [[m]] REAL(DbKi) :: EA = 0 !< stiffness [[N]] REAL(DbKi) :: EA_D = 0 !< dynamic stiffness when using viscoelastic model [[N]] REAL(DbKi) :: BA = 0 !< internal damping coefficient times area for this line only [[N-s]] REAL(DbKi) :: BA_D = 0 !< dynamic internal damping coefficient times area when using viscoelastic model [[N-s]] REAL(DbKi) :: EI = 0 !< bending stiffness [[N-m]] - REAL(DbKi) :: Can !< [[-]] - REAL(DbKi) :: Cat !< [[-]] - REAL(DbKi) :: Cdn !< [[-]] - REAL(DbKi) :: Cdt !< [[-]] + REAL(DbKi) :: Can = 0.0_R8Ki !< [[-]] + REAL(DbKi) :: Cat = 0.0_R8Ki !< [[-]] + REAL(DbKi) :: Cdn = 0.0_R8Ki !< [[-]] + REAL(DbKi) :: Cdt = 0.0_R8Ki !< [[-]] INTEGER(IntKi) :: nEApoints = 0 !< number of values in stress-strain lookup table (0 means using constant E) [-] - REAL(DbKi) , DIMENSION(1:30) :: stiffXs !< x array for stress-strain lookup table (up to nCoef) [-] - REAL(DbKi) , DIMENSION(1:30) :: stiffYs !< y array for stress-strain lookup table [-] + REAL(DbKi) , DIMENSION(1:30) :: stiffXs = 0.0_R8Ki !< x array for stress-strain lookup table (up to nCoef) [-] + REAL(DbKi) , DIMENSION(1:30) :: stiffYs = 0.0_R8Ki !< y array for stress-strain lookup table [-] INTEGER(IntKi) :: nBApoints = 0 !< number of values in stress-strainrate lookup table (0 means using constant c) [-] - REAL(DbKi) , DIMENSION(1:30) :: dampXs !< x array for stress-strainrate lookup table (up to nCoef) [-] - REAL(DbKi) , DIMENSION(1:30) :: dampYs !< y array for stress-strainrate lookup table [-] + REAL(DbKi) , DIMENSION(1:30) :: dampXs = 0.0_R8Ki !< x array for stress-strainrate lookup table (up to nCoef) [-] + REAL(DbKi) , DIMENSION(1:30) :: dampYs = 0.0_R8Ki !< y array for stress-strainrate lookup table [-] INTEGER(IntKi) :: nEIpoints = 0 !< number of values in bending stress-strain lookup table (0 means using constant E) [-] - REAL(DbKi) , DIMENSION(1:30) :: bstiffXs !< x array for stress-strain lookup table (up to nCoef) [-] - REAL(DbKi) , DIMENSION(1:30) :: bstiffYs !< y array for stress-strain lookup table [-] - REAL(DbKi) :: time !< current time [[s]] + REAL(DbKi) , DIMENSION(1:30) :: bstiffXs = 0.0_R8Ki !< x array for stress-strain lookup table (up to nCoef) [-] + REAL(DbKi) , DIMENSION(1:30) :: bstiffYs = 0.0_R8Ki !< y array for stress-strain lookup table [-] + REAL(DbKi) :: time = 0.0_R8Ki !< current time [[s]] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: r !< node positions [-] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: rd !< node velocities [-] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: q !< node tangent vectors [-] @@ -280,25 +280,25 @@ MODULE MoorDyn_Types REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: Fnet !< total force on node [[N]] REAL(DbKi) , DIMENSION(:,:,:), ALLOCATABLE :: S !< node inverse mass matrix [[kg]] REAL(DbKi) , DIMENSION(:,:,:), ALLOCATABLE :: M !< node mass matrix [[kg]] - REAL(DbKi) , DIMENSION(1:3) :: EndMomentA !< vector of end moments due to bending at line end A [[N-m]] - REAL(DbKi) , DIMENSION(1:3) :: EndMomentB !< vector of end moments due to bending at line end B [[N-m]] - INTEGER(IntKi) :: LineUnOut !< unit number of line output file [-] + REAL(DbKi) , DIMENSION(1:3) :: EndMomentA = 0.0_R8Ki !< vector of end moments due to bending at line end A [[N-m]] + REAL(DbKi) , DIMENSION(1:3) :: EndMomentB = 0.0_R8Ki !< vector of end moments due to bending at line end B [[N-m]] + INTEGER(IntKi) :: LineUnOut = 0_IntKi !< unit number of line output file [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: LineWrOutput !< one row of output data for this line [-] END TYPE MD_Line ! ======================= ! ========= MD_Fail ======= TYPE, PUBLIC :: MD_Fail - INTEGER(IntKi) :: IdNum !< integer identifier of this failure [-] + INTEGER(IntKi) :: IdNum = 0_IntKi !< integer identifier of this failure [-] END TYPE MD_Fail ! ======================= ! ========= MD_OutParmType ======= TYPE, PUBLIC :: MD_OutParmType - CHARACTER(10) :: Name !< name of output channel [-] - CHARACTER(10) :: Units !< units string [-] - INTEGER(IntKi) :: QType !< type of quantity - 0=tension, 1=x, 2=y, 3=z... [-] - INTEGER(IntKi) :: OType !< type of object - 0=line, 1=connect [-] - INTEGER(IntKi) :: NodeID !< node number if OType=0. 0=anchor, -1=N=Fairlead [-] - INTEGER(IntKi) :: ObjID !< number of Connect or Line object [-] + CHARACTER(10) :: Name = '' !< name of output channel [-] + CHARACTER(10) :: Units = '' !< units string [-] + INTEGER(IntKi) :: QType = 0_IntKi !< type of quantity - 0=tension, 1=x, 2=y, 3=z... [-] + INTEGER(IntKi) :: OType = 0_IntKi !< type of object - 0=line, 1=connect [-] + INTEGER(IntKi) :: NodeID = 0_IntKi !< node number if OType=0. 0=anchor, -1=N=Fairlead [-] + INTEGER(IntKi) :: ObjID = 0_IntKi !< number of Connect or Line object [-] END TYPE MD_OutParmType ! ======================= ! ========= MD_InitOutputType ======= @@ -324,17 +324,17 @@ MODULE MoorDyn_Types ! ======================= ! ========= MD_DiscreteStateType ======= TYPE, PUBLIC :: MD_DiscreteStateType - REAL(SiKi) :: dummy !< Remove this variable if you have discrete states [-] + REAL(SiKi) :: dummy = 0.0_R4Ki !< Remove this variable if you have discrete states [-] END TYPE MD_DiscreteStateType ! ======================= ! ========= MD_ConstraintStateType ======= TYPE, PUBLIC :: MD_ConstraintStateType - REAL(SiKi) :: dummy !< Remove this variable if you have constraint states [-] + REAL(SiKi) :: dummy = 0.0_R4Ki !< Remove this variable if you have constraint states [-] END TYPE MD_ConstraintStateType ! ======================= ! ========= MD_OtherStateType ======= TYPE, PUBLIC :: MD_OtherStateType - REAL(SiKi) :: dummy !< Remove this variable if you have other states [-] + REAL(SiKi) :: dummy = 0.0_R4Ki !< Remove this variable if you have other states [-] END TYPE MD_OtherStateType ! ======================= ! ========= MD_MiscVarType ======= @@ -361,14 +361,14 @@ MODULE MoorDyn_Types INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: RodStateIsN !< ending index of each rod's states in state vector [] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: BodyStateIs1 !< starting index of each body's states in state vector [] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: BodyStateIsN !< ending index of each body's states in state vector [] - INTEGER(IntKi) :: Nx !< number of states and size of state vector [] - INTEGER(IntKi) :: WaveTi !< current interpolation index for wave time series data [] + INTEGER(IntKi) :: Nx = 0_IntKi !< number of states and size of state vector [] + INTEGER(IntKi) :: WaveTi = 0_IntKi !< current interpolation index for wave time series data [] TYPE(MD_ContinuousStateType) :: xTemp !< contains temporary state vector used in integration (put here so it's only allocated once) [-] TYPE(MD_ContinuousStateType) :: xdTemp !< contains temporary state derivative vector used in integration (put here so it's only allocated once) [-] - REAL(DbKi) , DIMENSION(1:6) :: zeros6 !< array of zeros for convenience [-] + REAL(DbKi) , DIMENSION(1:6) :: zeros6 = 0.0_R8Ki !< array of zeros for convenience [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: MDWrOutput !< Data from time step to be written to a MoorDyn output file [-] - REAL(DbKi) :: LastOutTime !< Time of last writing to MD output files [-] - REAL(ReKi) , DIMENSION(1:6) :: PtfmInit !< initial position of platform for an individual (non-farm) MD instance [-] + REAL(DbKi) :: LastOutTime = 0.0_R8Ki !< Time of last writing to MD output files [-] + REAL(ReKi) , DIMENSION(1:6) :: PtfmInit = 0.0_ReKi !< initial position of platform for an individual (non-farm) MD instance [-] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: BathymetryGrid !< matrix describing the bathymetry in a grid of x's and y's [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: BathGrid_Xs !< array of x-coordinates in the bathymetry grid [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: BathGrid_Ys !< array of y-coordinates in the bathymetry grid [-] @@ -394,39 +394,39 @@ MODULE MoorDyn_Types INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: nCpldCons !< number of coupled points (for FAST.Farm, size>1 with an entry for each turbine) [] INTEGER(IntKi) :: NConns = 0 !< number of Connect type Connections - not to be confused with NConnects [] INTEGER(IntKi) :: NAnchs = 0 !< number of Anchor type Connections [] - REAL(DbKi) :: Tmax !< simulation duration [[s]] + REAL(DbKi) :: Tmax = 0.0_R8Ki !< simulation duration [[s]] REAL(DbKi) :: g = 9.81 !< gravitational constant (positive) [[m/s^2]] REAL(DbKi) :: rhoW = 1025 !< density of seawater [[kg/m^3]] - REAL(DbKi) :: WtrDpth !< water depth [[m]] - REAL(DbKi) :: kBot !< bottom stiffness [[Pa/m]] - REAL(DbKi) :: cBot !< bottom damping [[Pa-s/m]] - REAL(DbKi) :: dtM0 !< desired mooring model time step [[s]] - REAL(DbKi) :: dtCoupling !< coupling time step that MoorDyn should expect [[s]] - INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] - REAL(DbKi) :: dtOut !< interval for writing output file lines [[s]] - CHARACTER(1024) :: RootName !< RootName for writing output files [-] + REAL(DbKi) :: WtrDpth = 0.0_R8Ki !< water depth [[m]] + REAL(DbKi) :: kBot = 0.0_R8Ki !< bottom stiffness [[Pa/m]] + REAL(DbKi) :: cBot = 0.0_R8Ki !< bottom damping [[Pa-s/m]] + REAL(DbKi) :: dtM0 = 0.0_R8Ki !< desired mooring model time step [[s]] + REAL(DbKi) :: dtCoupling = 0.0_R8Ki !< coupling time step that MoorDyn should expect [[s]] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] + REAL(DbKi) :: dtOut = 0.0_R8Ki !< interval for writing output file lines [[s]] + CHARACTER(1024) :: RootName = '' !< RootName for writing output files [-] TYPE(MD_OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] - CHARACTER(1) :: Delim !< Column delimiter for output text files [-] - INTEGER(IntKi) :: MDUnOut !< Unit number of main output file [-] - CHARACTER(1024) :: PriPath !< The path to the primary MoorDyn input file, used if looking for additional input files [-] + CHARACTER(1) :: Delim = '' !< Column delimiter for output text files [-] + INTEGER(IntKi) :: MDUnOut = 0_IntKi !< Unit number of main output file [-] + CHARACTER(1024) :: PriPath = '' !< The path to the primary MoorDyn input file, used if looking for additional input files [-] INTEGER(IntKi) :: writeLog = -1 !< Switch for level of log file output [-] INTEGER(IntKi) :: UnLog = -1 !< Unit number of log file [-] - INTEGER(IntKi) :: WaveKin !< Flag for whether or how to consider water kinematics [-] - INTEGER(IntKi) :: Current !< Flag for whether or how to consider water kinematics [-] - INTEGER(IntKi) :: nTurbines !< Number of turbines if MoorDyn is performing an array-level simulation with FAST.Farm, otherwise 0 [-] + INTEGER(IntKi) :: WaveKin = 0_IntKi !< Flag for whether or how to consider water kinematics [-] + INTEGER(IntKi) :: Current = 0_IntKi !< Flag for whether or how to consider water kinematics [-] + INTEGER(IntKi) :: nTurbines = 0_IntKi !< Number of turbines if MoorDyn is performing an array-level simulation with FAST.Farm, otherwise 0 [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TurbineRefPos !< reference position of turbines in farm, shape: 3, nTurbines [-] - REAL(DbKi) :: mu_kT !< transverse kinetic friction coefficient [(-)] - REAL(DbKi) :: mu_kA !< axial kinetic friction coefficient [(-)] - REAL(DbKi) :: mc !< ratio of the static friction coefficient to the kinetic friction coefficient [(-)] - REAL(DbKi) :: cv !< saturated damping coefficient [(-)] - INTEGER(IntKi) :: nxWave !< number of x wave grid points [-] - INTEGER(IntKi) :: nyWave !< number of y wave grid points [-] - INTEGER(IntKi) :: nzWave !< number of z wave grid points [-] - INTEGER(IntKi) :: ntWave !< number of wave time steps [-] + REAL(DbKi) :: mu_kT = 0.0_R8Ki !< transverse kinetic friction coefficient [(-)] + REAL(DbKi) :: mu_kA = 0.0_R8Ki !< axial kinetic friction coefficient [(-)] + REAL(DbKi) :: mc = 0.0_R8Ki !< ratio of the static friction coefficient to the kinetic friction coefficient [(-)] + REAL(DbKi) :: cv = 0.0_R8Ki !< saturated damping coefficient [(-)] + INTEGER(IntKi) :: nxWave = 0_IntKi !< number of x wave grid points [-] + INTEGER(IntKi) :: nyWave = 0_IntKi !< number of y wave grid points [-] + INTEGER(IntKi) :: nzWave = 0_IntKi !< number of z wave grid points [-] + INTEGER(IntKi) :: ntWave = 0_IntKi !< number of wave time steps [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: pxWave !< x location of wave grid points [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: pyWave !< y location of wave grid points [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: pzWave !< z location of wave grid points [-] - REAL(SiKi) :: dtWave !< wave data time step [-] + REAL(SiKi) :: dtWave = 0.0_R4Ki !< wave data time step [-] REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: uxWave !< wave velocities time series at each grid point [-] REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: uyWave !< wave velocities time series at each grid point [-] REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: uzWave !< wave velocities time series at each grid point [-] @@ -435,16 +435,16 @@ MODULE MoorDyn_Types REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: azWave !< wave accelerations time series at each grid point [-] REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: PDyn !< wave dynamic pressure time series at each grid point [-] REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: zeta !< wave surface elevations time series at each surface grid point [-] - INTEGER(IntKi) :: nzCurrent !< number of z current grid points [-] + INTEGER(IntKi) :: nzCurrent = 0_IntKi !< number of z current grid points [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: pzCurrent !< z location of current grid points [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: uxCurrent !< current velocities time series at each grid point [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: uyCurrent !< current velocities time series at each grid point [-] - INTEGER(IntKi) :: Nx0 !< copy of initial size of system state vector, for linearization routines [-] + INTEGER(IntKi) :: Nx0 = 0_IntKi !< copy of initial size of system state vector, for linearization routines [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: du !< vector that determines size of perturbation for u (inputs) [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: dx !< vector that determines size of perturbation for x (continuous states) [-] - INTEGER(IntKi) :: Jac_ny !< number of outputs in jacobian matrix [-] - INTEGER(IntKi) :: Jac_nx !< number of continuous states in jacobian matrix [-] + INTEGER(IntKi) :: Jac_ny = 0_IntKi !< number of outputs in jacobian matrix [-] + INTEGER(IntKi) :: Jac_nx = 0_IntKi !< number of continuous states in jacobian matrix [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: dxIdx_map2_xStateIdx !< Mapping array from index of dX array to corresponding state index [-] END TYPE MD_ParameterType ! ======================= diff --git a/modules/nwtc-library/src/NWTC_Library_Types.f90 b/modules/nwtc-library/src/NWTC_Library_Types.f90 index 2c35e2c5e7..b38725239f 100644 --- a/modules/nwtc-library/src/NWTC_Library_Types.f90 +++ b/modules/nwtc-library/src/NWTC_Library_Types.f90 @@ -36,18 +36,18 @@ MODULE NWTC_Library_Types IMPLICIT NONE ! ========= ProgDesc ======= TYPE, PUBLIC :: ProgDesc - CHARACTER(99) :: Name !< Name of the program or module [-] - CHARACTER(99) :: Ver !< Version number of the program or module [-] - CHARACTER(24) :: Date !< String containing date module was last updated [-] + CHARACTER(99) :: Name = '' !< Name of the program or module [-] + CHARACTER(99) :: Ver = '' !< Version number of the program or module [-] + CHARACTER(24) :: Date = '' !< String containing date module was last updated [-] END TYPE ProgDesc ! ======================= ! ========= FASTdataType ======= TYPE, PUBLIC :: FASTdataType - CHARACTER(1024) :: File !< Name of the FAST-style binary file [-] - CHARACTER(1024) :: Descr !< String describing file [-] - INTEGER(IntKi) :: NumChans !< Number of output channels in this binary file (not including the time channel) [-] - INTEGER(IntKi) :: NumRecs !< Number of records (rows) of data in the file [-] - REAL(DbKi) :: TimeStep !< Time step for evenly-spaced data in the output file (when NumRecs is not allo [-] + CHARACTER(1024) :: File = '' !< Name of the FAST-style binary file [-] + CHARACTER(1024) :: Descr = '' !< String describing file [-] + INTEGER(IntKi) :: NumChans = 0_IntKi !< Number of output channels in this binary file (not including the time channel) [-] + INTEGER(IntKi) :: NumRecs = 0_IntKi !< Number of records (rows) of data in the file [-] + REAL(DbKi) :: TimeStep = 0.0_R8Ki !< Time step for evenly-spaced data in the output file (when NumRecs is not allo [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: ChanNames !< Strings describing the names of the channels from the binary file (including the time channel) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: ChanUnits !< Strings describing the units of the channels from the binary file (including the time channel) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Data !< numeric data (rows and columns) from the binary file, including the time channel [-] @@ -55,16 +55,16 @@ MODULE NWTC_Library_Types ! ======================= ! ========= OutParmType ======= TYPE, PUBLIC :: OutParmType - INTEGER(IntKi) :: Indx !< An index into AllOuts array where this channel is computed/stored [-] - CHARACTER(ChanLen) :: Name !< Name of the output channel [-] - CHARACTER(ChanLen) :: Units !< Units this channel is specified in [-] - INTEGER(IntKi) :: SignM !< Multiplier for output channel; usually -1 (minus) or 0 (invalid channel) [-] + INTEGER(IntKi) :: Indx = 0_IntKi !< An index into AllOuts array where this channel is computed/stored [-] + CHARACTER(ChanLen) :: Name = '' !< Name of the output channel [-] + CHARACTER(ChanLen) :: Units = '' !< Units this channel is specified in [-] + INTEGER(IntKi) :: SignM = 0_IntKi !< Multiplier for output channel; usually -1 (minus) or 0 (invalid channel) [-] END TYPE OutParmType ! ======================= ! ========= FileInfoType ======= TYPE, PUBLIC :: FileInfoType - INTEGER(IntKi) :: NumLines - INTEGER(IntKi) :: NumFiles + INTEGER(IntKi) :: NumLines = 0_IntKi + INTEGER(IntKi) :: NumFiles = 0_IntKi INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: FileLine INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: FileIndx CHARACTER(MaxFileInfoLineLen) , DIMENSION(:), ALLOCATABLE :: FileList @@ -73,16 +73,16 @@ MODULE NWTC_Library_Types ! ======================= ! ========= Quaternion ======= TYPE, PUBLIC :: Quaternion - REAL(ReKi) :: q0 - REAL(ReKi) , DIMENSION(1:3) :: v + REAL(ReKi) :: q0 = 0.0_ReKi + REAL(ReKi) , DIMENSION(1:3) :: v = 0.0_ReKi END TYPE Quaternion ! ======================= ! ========= NWTC_RandomNumber_ParameterType ======= TYPE, PUBLIC :: NWTC_RandomNumber_ParameterType - INTEGER(IntKi) :: pRNG - INTEGER(IntKi) , DIMENSION(1:3) :: RandSeed + INTEGER(IntKi) :: pRNG = 0_IntKi + INTEGER(IntKi) , DIMENSION(1:3) :: RandSeed = 0_IntKi INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: RandSeedAry - CHARACTER(6) :: RNG_type + CHARACTER(6) :: RNG_type = '' END TYPE NWTC_RandomNumber_ParameterType ! ======================= CONTAINS diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index 6ac3842ba1..61a656fee7 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -80,12 +80,12 @@ MODULE FAST_Types ! ======================= ! ========= FAST_VTK_SurfaceType ======= TYPE, PUBLIC :: FAST_VTK_SurfaceType - INTEGER(IntKi) :: NumSectors !< number of sectors in which to split circles (higher number gives smoother surface) [-] - REAL(SiKi) :: HubRad !< Preconed hub radius (distance from the rotor apex to the blade root) [m] - REAL(SiKi) :: GroundRad !< radius for plotting circle on ground [m] - REAL(SiKi) , DIMENSION(1:3,1:8) :: NacelleBox !< X-Y-Z locations of 8 points that define the nacelle box, relative to the nacelle position [m] + INTEGER(IntKi) :: NumSectors = 0_IntKi !< number of sectors in which to split circles (higher number gives smoother surface) [-] + REAL(SiKi) :: HubRad = 0.0_R4Ki !< Preconed hub radius (distance from the rotor apex to the blade root) [m] + REAL(SiKi) :: GroundRad = 0.0_R4Ki !< radius for plotting circle on ground [m] + REAL(SiKi) , DIMENSION(1:3,1:8) :: NacelleBox = 0.0_R4Ki !< X-Y-Z locations of 8 points that define the nacelle box, relative to the nacelle position [m] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: TowerRad !< radius of each ED tower node [m] - INTEGER(IntKi) , DIMENSION(1:2) :: NWaveElevPts !< number of points for wave elevation visualization [-] + INTEGER(IntKi) , DIMENSION(1:2) :: NWaveElevPts = 0_IntKi !< number of points for wave elevation visualization [-] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevXY !< X-Y locations for WaveElev output (for visualization). First dimension is the X (1) and Y (2) coordinate. Second dimension is the point number. [m,-] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElev !< wave elevation at WaveElevXY; first dimension is time step; second dimension is point number [m,-] TYPE(FAST_VTK_BLSurfaceType) , DIMENSION(:), ALLOCATABLE :: BladeShape !< AirfoilCoords for each blade [m] @@ -94,14 +94,14 @@ MODULE FAST_Types ! ======================= ! ========= FAST_VTK_ModeShapeType ======= TYPE, PUBLIC :: FAST_VTK_ModeShapeType - CHARACTER(1024) :: CheckpointRoot !< name of the checkpoint file written by FAST when linearization data was produced [-] - CHARACTER(1024) :: MatlabFileName !< name of the file with eigenvectors written by Matlab [-] - INTEGER(IntKi) :: VTKLinModes !< Number of modes to visualize [-] + CHARACTER(1024) :: CheckpointRoot = '' !< name of the checkpoint file written by FAST when linearization data was produced [-] + CHARACTER(1024) :: MatlabFileName = '' !< name of the file with eigenvectors written by Matlab [-] + INTEGER(IntKi) :: VTKLinModes = 0_IntKi !< Number of modes to visualize [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: VTKModes !< Which modes to visualize [-] - INTEGER(IntKi) :: VTKLinTim !< Switch to make one animation for all LinTimes together (1) or separate animations for each LinTimes(2) [-] - INTEGER(IntKi) :: VTKNLinTimes !< number of linearization times to use when VTKLinTim==2 [-] - REAL(ReKi) :: VTKLinScale !< Mode shape visualization scaling factor [-] - REAL(ReKi) :: VTKLinPhase !< Phase when making one animation for all LinTimes together (used only when VTKLinTim=1) [-] + INTEGER(IntKi) :: VTKLinTim = 0_IntKi !< Switch to make one animation for all LinTimes together (1) or separate animations for each LinTimes(2) [-] + INTEGER(IntKi) :: VTKNLinTimes = 0_IntKi !< number of linearization times to use when VTKLinTim==2 [-] + REAL(ReKi) :: VTKLinScale = 0.0_ReKi !< Mode shape visualization scaling factor [-] + REAL(ReKi) :: VTKLinPhase = 0.0_ReKi !< Phase when making one animation for all LinTimes together (used only when VTKLinTim=1) [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: DampingRatio !< damping ratios from mbc3 analysis [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: NaturalFreq_Hz !< natural frequency from mbc3 analysis [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: DampedFreq_Hz !< damped frequency from mbc3 analysis [-] @@ -111,100 +111,100 @@ MODULE FAST_Types ! ======================= ! ========= FAST_ParameterType ======= TYPE, PUBLIC :: FAST_ParameterType - REAL(DbKi) :: DT !< Integration time step [global time] [s] - REAL(DbKi) , DIMENSION(1:NumModules) :: DT_module !< Integration time step [global time] [s] - INTEGER(IntKi) , DIMENSION(1:NumModules) :: n_substeps !< The number of module substeps for advancing states from t_global to t_global_next [-] - INTEGER(IntKi) :: n_TMax_m1 !< The time step of TMax - dt (the end time of the simulation) [(-)] - REAL(DbKi) :: TMax !< Total run time [s] - INTEGER(IntKi) :: InterpOrder !< Interpolation order {0,1,2} [-] - INTEGER(IntKi) :: NumCrctn !< Number of correction iterations [-] - INTEGER(IntKi) :: KMax !< Maximum number of input-output-solve iterations (KMax >= 1) [-] - INTEGER(IntKi) :: numIceLegs !< number of suport-structure legs in contact with ice (IceDyn coupling) [-] - INTEGER(IntKi) :: nBeams !< number of BeamDyn instances [-] - LOGICAL :: BD_OutputSibling !< flag to determine if BD input is sibling of output mesh [-] - LOGICAL , DIMENSION(1:NumModules) :: ModuleInitialized !< An array determining if the module has been initialized [-] - REAL(DbKi) :: DT_Ujac !< Time between when we need to re-calculate these Jacobians [s] - REAL(ReKi) :: UJacSclFact !< Scaling factor used to get similar magnitudes between accelerations, forces, and moments in Jacobians [-] - INTEGER(IntKi) , DIMENSION(1:9) :: SizeJac_Opt1 !< (1)=size of matrix; (2)=size of ED portion; (3)=size of SD portion [2 meshes]; (4)=size of HD portion; (5)=size of BD portion blade 1; (6)=size of BD portion blade 2; (7)=size of BD portion blade 3; (8)=size of Orca portion; (9)=size of ExtPtfm portion; [-] - INTEGER(IntKi) :: SolveOption !< Switch to determine which solve option we are going to use (see Solve_FullOpt1, etc) [-] - INTEGER(IntKi) :: CompElast !< Compute blade loads (switch) {Module_ED; Module_BD} [-] - INTEGER(IntKi) :: CompInflow !< Compute inflow wind conditions (switch) {Module_None; Module_IfW; Module_OpFM} [-] - INTEGER(IntKi) :: CompAero !< Compute aerodynamic loads (switch) {Module_None; Module_AD14; Module_AD} [-] - INTEGER(IntKi) :: CompServo !< Compute control and electrical-drive dynamics (switch) {Module_None; Module_SrvD} [-] - INTEGER(IntKi) :: CompSeaSt !< Compute sea states; wave kinematics (switch) {Module_None; Module_SeaSt} [-] - INTEGER(IntKi) :: CompHydro !< Compute hydrodynamic loads (switch) {Module_None; Module_HD} [-] - INTEGER(IntKi) :: CompSub !< Compute sub-structural dynamics (switch) {Module_None; Module_HD} [-] - INTEGER(IntKi) :: CompMooring !< Compute mooring system (switch) {Module_None; Module_MAP; Module_FEAM; Module_MD; Module_Orca} [-] - INTEGER(IntKi) :: CompIce !< Compute ice loading (switch) {Module_None; Module_IceF, Module_IceD} [-] - INTEGER(IntKi) :: MHK !< MHK turbine type (switch) {0=Not an MHK turbine; 1=Fixed MHK turbine; 2=Floating MHK turbine} [-] - LOGICAL :: UseDWM !< Use the DWM module in AeroDyn [-] - LOGICAL :: Linearize !< Linearization analysis (flag) [-] - INTEGER(IntKi) :: WaveFieldMod !< Wave field handling (-) (switch) 0: use individual HydroDyn inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin [-] + REAL(DbKi) :: DT = 0.0_R8Ki !< Integration time step [global time] [s] + REAL(DbKi) , DIMENSION(1:NumModules) :: DT_module = 0.0_R8Ki !< Integration time step [global time] [s] + INTEGER(IntKi) , DIMENSION(1:NumModules) :: n_substeps = 0_IntKi !< The number of module substeps for advancing states from t_global to t_global_next [-] + INTEGER(IntKi) :: n_TMax_m1 = 0_IntKi !< The time step of TMax - dt (the end time of the simulation) [(-)] + REAL(DbKi) :: TMax = 0.0_R8Ki !< Total run time [s] + INTEGER(IntKi) :: InterpOrder = 0_IntKi !< Interpolation order {0,1,2} [-] + INTEGER(IntKi) :: NumCrctn = 0_IntKi !< Number of correction iterations [-] + INTEGER(IntKi) :: KMax = 0_IntKi !< Maximum number of input-output-solve iterations (KMax >= 1) [-] + INTEGER(IntKi) :: numIceLegs = 0_IntKi !< number of suport-structure legs in contact with ice (IceDyn coupling) [-] + INTEGER(IntKi) :: nBeams = 0_IntKi !< number of BeamDyn instances [-] + LOGICAL :: BD_OutputSibling = .false. !< flag to determine if BD input is sibling of output mesh [-] + LOGICAL , DIMENSION(1:NumModules) :: ModuleInitialized = .false. !< An array determining if the module has been initialized [-] + REAL(DbKi) :: DT_Ujac = 0.0_R8Ki !< Time between when we need to re-calculate these Jacobians [s] + REAL(ReKi) :: UJacSclFact = 0.0_ReKi !< Scaling factor used to get similar magnitudes between accelerations, forces, and moments in Jacobians [-] + INTEGER(IntKi) , DIMENSION(1:9) :: SizeJac_Opt1 = 0_IntKi !< (1)=size of matrix; (2)=size of ED portion; (3)=size of SD portion [2 meshes]; (4)=size of HD portion; (5)=size of BD portion blade 1; (6)=size of BD portion blade 2; (7)=size of BD portion blade 3; (8)=size of Orca portion; (9)=size of ExtPtfm portion; [-] + INTEGER(IntKi) :: SolveOption = 0_IntKi !< Switch to determine which solve option we are going to use (see Solve_FullOpt1, etc) [-] + INTEGER(IntKi) :: CompElast = 0_IntKi !< Compute blade loads (switch) {Module_ED; Module_BD} [-] + INTEGER(IntKi) :: CompInflow = 0_IntKi !< Compute inflow wind conditions (switch) {Module_None; Module_IfW; Module_OpFM} [-] + INTEGER(IntKi) :: CompAero = 0_IntKi !< Compute aerodynamic loads (switch) {Module_None; Module_AD14; Module_AD} [-] + INTEGER(IntKi) :: CompServo = 0_IntKi !< Compute control and electrical-drive dynamics (switch) {Module_None; Module_SrvD} [-] + INTEGER(IntKi) :: CompSeaSt = 0_IntKi !< Compute sea states; wave kinematics (switch) {Module_None; Module_SeaSt} [-] + INTEGER(IntKi) :: CompHydro = 0_IntKi !< Compute hydrodynamic loads (switch) {Module_None; Module_HD} [-] + INTEGER(IntKi) :: CompSub = 0_IntKi !< Compute sub-structural dynamics (switch) {Module_None; Module_HD} [-] + INTEGER(IntKi) :: CompMooring = 0_IntKi !< Compute mooring system (switch) {Module_None; Module_MAP; Module_FEAM; Module_MD; Module_Orca} [-] + INTEGER(IntKi) :: CompIce = 0_IntKi !< Compute ice loading (switch) {Module_None; Module_IceF, Module_IceD} [-] + INTEGER(IntKi) :: MHK = 0_IntKi !< MHK turbine type (switch) {0=Not an MHK turbine; 1=Fixed MHK turbine; 2=Floating MHK turbine} [-] + LOGICAL :: UseDWM = .false. !< Use the DWM module in AeroDyn [-] + LOGICAL :: Linearize = .false. !< Linearization analysis (flag) [-] + INTEGER(IntKi) :: WaveFieldMod = 0_IntKi !< Wave field handling (-) (switch) 0: use individual HydroDyn inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin [-] LOGICAL :: FarmIntegration = .false. !< whether this is called from FAST.Farm (or another program that doesn't want FAST to call all of the init stuff first) [-] - REAL(SiKi) , DIMENSION(1:3) :: TurbinePos !< Initial position of turbine base (origin used for graphics) [m] - REAL(ReKi) :: Gravity !< Gravitational acceleration [m/s^2] - REAL(ReKi) :: AirDens !< Air density [kg/m^3] - REAL(ReKi) :: WtrDens !< Water density [kg/m^3] - REAL(ReKi) :: KinVisc !< Kinematic viscosity of working fluid [m^2/s] - REAL(ReKi) :: SpdSound !< Speed of sound in working fluid [m/s] - REAL(ReKi) :: Patm !< Atmospheric pressure [Pa] - REAL(ReKi) :: Pvap !< Vapour pressure of working fluid [Pa] - REAL(ReKi) :: WtrDpth !< Water depth [m] - REAL(ReKi) :: MSL2SWL !< Offset between still-water level and mean sea level [m] - CHARACTER(1024) :: EDFile !< The name of the ElastoDyn input file [-] - CHARACTER(1024) , DIMENSION(1:MaxNBlades) :: BDBldFile !< Name of files containing BeamDyn inputs for each blade [-] - CHARACTER(1024) :: InflowFile !< Name of file containing inflow wind input parameters [-] - CHARACTER(1024) :: AeroFile !< Name of file containing aerodynamic input parameters [-] - CHARACTER(1024) :: ServoFile !< Name of file containing control and electrical-drive input parameters [-] - CHARACTER(1024) :: SeaStFile !< Name of file containing sea state input parameters [-] - CHARACTER(1024) :: HydroFile !< Name of file containing hydrodynamic input parameters [-] - CHARACTER(1024) :: SubFile !< Name of file containing sub-structural input parameters [-] - CHARACTER(1024) :: MooringFile !< Name of file containing mooring system input parameters [-] - CHARACTER(1024) :: IceFile !< Name of file containing ice loading input parameters [-] - REAL(DbKi) :: TStart !< Time to begin tabular output [s] - REAL(DbKi) :: DT_Out !< Time step for tabular output [s] - LOGICAL :: WrSttsTime !< Whether we should write the status times to the screen [-] - INTEGER(IntKi) :: n_SttsTime !< Number of time steps between screen status messages [-] - INTEGER(IntKi) :: n_ChkptTime !< Number of time steps between writing checkpoint files [-] - INTEGER(IntKi) :: n_DT_Out !< Number of time steps between writing a line in the time-marching output files [-] - INTEGER(IntKi) :: n_VTKTime !< Number of time steps between writing VTK files [-] - INTEGER(IntKi) :: TurbineType !< Type_LandBased, Type_Offshore_Fixed, Type_Offshore_Floating, Type_MHK_Fixed, or Type_MHK_Floating [-] - LOGICAL :: WrBinOutFile !< Write a binary output file? (.outb) [-] - LOGICAL :: WrTxtOutFile !< Write a text (formatted) output file? (.out) [-] - INTEGER(IntKi) :: WrBinMod !< If writing binary, which file format is to be written [1, 2, or 3] [-] - LOGICAL :: SumPrint !< Print summary data to file? (.sum) [-] + REAL(SiKi) , DIMENSION(1:3) :: TurbinePos = 0.0_R4Ki !< Initial position of turbine base (origin used for graphics) [m] + REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravitational acceleration [m/s^2] + REAL(ReKi) :: AirDens = 0.0_ReKi !< Air density [kg/m^3] + REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density [kg/m^3] + REAL(ReKi) :: KinVisc = 0.0_ReKi !< Kinematic viscosity of working fluid [m^2/s] + REAL(ReKi) :: SpdSound = 0.0_ReKi !< Speed of sound in working fluid [m/s] + REAL(ReKi) :: Patm = 0.0_ReKi !< Atmospheric pressure [Pa] + REAL(ReKi) :: Pvap = 0.0_ReKi !< Vapour pressure of working fluid [Pa] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [m] + REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Offset between still-water level and mean sea level [m] + CHARACTER(1024) :: EDFile = '' !< The name of the ElastoDyn input file [-] + CHARACTER(1024) , DIMENSION(1:MaxNBlades) :: BDBldFile = '' !< Name of files containing BeamDyn inputs for each blade [-] + CHARACTER(1024) :: InflowFile = '' !< Name of file containing inflow wind input parameters [-] + CHARACTER(1024) :: AeroFile = '' !< Name of file containing aerodynamic input parameters [-] + CHARACTER(1024) :: ServoFile = '' !< Name of file containing control and electrical-drive input parameters [-] + CHARACTER(1024) :: SeaStFile = '' !< Name of file containing sea state input parameters [-] + CHARACTER(1024) :: HydroFile = '' !< Name of file containing hydrodynamic input parameters [-] + CHARACTER(1024) :: SubFile = '' !< Name of file containing sub-structural input parameters [-] + CHARACTER(1024) :: MooringFile = '' !< Name of file containing mooring system input parameters [-] + CHARACTER(1024) :: IceFile = '' !< Name of file containing ice loading input parameters [-] + REAL(DbKi) :: TStart = 0.0_R8Ki !< Time to begin tabular output [s] + REAL(DbKi) :: DT_Out = 0.0_R8Ki !< Time step for tabular output [s] + LOGICAL :: WrSttsTime = .false. !< Whether we should write the status times to the screen [-] + INTEGER(IntKi) :: n_SttsTime = 0_IntKi !< Number of time steps between screen status messages [-] + INTEGER(IntKi) :: n_ChkptTime = 0_IntKi !< Number of time steps between writing checkpoint files [-] + INTEGER(IntKi) :: n_DT_Out = 0_IntKi !< Number of time steps between writing a line in the time-marching output files [-] + INTEGER(IntKi) :: n_VTKTime = 0_IntKi !< Number of time steps between writing VTK files [-] + INTEGER(IntKi) :: TurbineType = 0_IntKi !< Type_LandBased, Type_Offshore_Fixed, Type_Offshore_Floating, Type_MHK_Fixed, or Type_MHK_Floating [-] + LOGICAL :: WrBinOutFile = .false. !< Write a binary output file? (.outb) [-] + LOGICAL :: WrTxtOutFile = .false. !< Write a text (formatted) output file? (.out) [-] + INTEGER(IntKi) :: WrBinMod = 0_IntKi !< If writing binary, which file format is to be written [1, 2, or 3] [-] + LOGICAL :: SumPrint = .false. !< Print summary data to file? (.sum) [-] INTEGER(IntKi) :: WrVTK = 0 !< VTK Visualization data output: (switch) {0=none; 1=initialization data only; 2=animation} [-] - INTEGER(IntKi) :: VTK_Type !< Type of VTK visualization data: (switch) {1=surfaces; 2=basic meshes (lines/points); 3=all meshes (debug)} [-] - LOGICAL :: VTK_fields !< Write mesh fields to VTK data files? (flag) {true/false} [-] - CHARACTER(1) :: Delim !< Delimiter between columns of text output file (.out): space or tab [-] - CHARACTER(20) :: OutFmt !< Format used for text tabular output (except time); resulting field should be 10 characters [-] - CHARACTER(20) :: OutFmt_t !< Format used for time channel in text tabular output; resulting field should be 10 characters [-] - INTEGER(IntKi) :: FmtWidth !< width of the time OutFmt specifier [-] - INTEGER(IntKi) :: TChanLen !< width of the time channel [-] - CHARACTER(1024) :: OutFileRoot !< The rootname of the output files [-] - CHARACTER(1024) :: FTitle !< The description line from the FAST (glue-code) input file [-] + INTEGER(IntKi) :: VTK_Type = 0_IntKi !< Type of VTK visualization data: (switch) {1=surfaces; 2=basic meshes (lines/points); 3=all meshes (debug)} [-] + LOGICAL :: VTK_fields = .false. !< Write mesh fields to VTK data files? (flag) {true/false} [-] + CHARACTER(1) :: Delim = '' !< Delimiter between columns of text output file (.out): space or tab [-] + CHARACTER(20) :: OutFmt = '' !< Format used for text tabular output (except time); resulting field should be 10 characters [-] + CHARACTER(20) :: OutFmt_t = '' !< Format used for time channel in text tabular output; resulting field should be 10 characters [-] + INTEGER(IntKi) :: FmtWidth = 0_IntKi !< width of the time OutFmt specifier [-] + INTEGER(IntKi) :: TChanLen = 0_IntKi !< width of the time channel [-] + CHARACTER(1024) :: OutFileRoot = '' !< The rootname of the output files [-] + CHARACTER(1024) :: FTitle = '' !< The description line from the FAST (glue-code) input file [-] CHARACTER(1024) :: VTK_OutFileRoot = '' !< The rootname of the VTK output files [-] - INTEGER(IntKi) :: VTK_tWidth !< Width of number of files for leading zeros in file name format [-] - REAL(DbKi) :: VTK_fps !< number of frames per second to output VTK data [-] + INTEGER(IntKi) :: VTK_tWidth = 0_IntKi !< Width of number of files for leading zeros in file name format [-] + REAL(DbKi) :: VTK_fps = 0.0_R8Ki !< number of frames per second to output VTK data [-] TYPE(FAST_VTK_SurfaceType) :: VTK_surface !< Data for VTK surface visualization [-] - CHARACTER(4) :: Tdesc !< description of turbine ID (for FAST.Farm) screen printing [-] - LOGICAL :: CalcSteady !< Calculate a steady-state periodic operating point before linearization [unused if Linearize=False] [-] - INTEGER(IntKi) :: TrimCase !< Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} [unused if Linearize=False; used only if CalcSteady=True] [-] - REAL(ReKi) :: TrimTol !< Tolerance for the rotational speed convergence (>0) [unused if Linearize=False; used only if CalcSteady=True] [-] - REAL(ReKi) :: TrimGain !< Proportional gain for the rotational speed error (>0) [unused if Linearize=False; used only if CalcSteady=True] [rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque] - REAL(ReKi) :: Twr_Kdmp !< Damping factor for the tower [unused if Linearize=False; used only if CalcSteady=True] [N/(m/s)] - REAL(ReKi) :: Bld_Kdmp !< Damping factor for the blades [unused if Linearize=False; used only if CalcSteady=True] [N/(m/s)] - INTEGER(IntKi) :: NLinTimes !< Number of LinTimes, or equally-spaced azimuth steps in periodic linearized model (>0)[unused if Linearize=False] [-] - REAL(DbKi) :: AzimDelta !< difference between two consecutive azimuth positions in CalcSteady algorithm [rad] - INTEGER(IntKi) :: LinInputs !< Inputs included in linearization (switch) {0=none; 1=standard; 2=all module inputs (debug)} [unused if Linearize=False] [-] - INTEGER(IntKi) :: LinOutputs !< Outputs included in linearization (switch) {0=none; 1=from OutList(s); 2=all module outputs (debug)} [unused if Linearize=False] [-] - LOGICAL :: LinOutJac !< Include full Jacabians in linearization output (for debug) (flag) [unused if Linearize=False; used only if LinInputs=LinOutputs=2] [-] - LOGICAL :: LinOutMod !< Write module-level linearization output files in addition to output for full system? (flag) [unused if Linearize=False] [-] + CHARACTER(4) :: Tdesc = '' !< description of turbine ID (for FAST.Farm) screen printing [-] + LOGICAL :: CalcSteady = .false. !< Calculate a steady-state periodic operating point before linearization [unused if Linearize=False] [-] + INTEGER(IntKi) :: TrimCase = 0_IntKi !< Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} [unused if Linearize=False; used only if CalcSteady=True] [-] + REAL(ReKi) :: TrimTol = 0.0_ReKi !< Tolerance for the rotational speed convergence (>0) [unused if Linearize=False; used only if CalcSteady=True] [-] + REAL(ReKi) :: TrimGain = 0.0_ReKi !< Proportional gain for the rotational speed error (>0) [unused if Linearize=False; used only if CalcSteady=True] [rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque] + REAL(ReKi) :: Twr_Kdmp = 0.0_ReKi !< Damping factor for the tower [unused if Linearize=False; used only if CalcSteady=True] [N/(m/s)] + REAL(ReKi) :: Bld_Kdmp = 0.0_ReKi !< Damping factor for the blades [unused if Linearize=False; used only if CalcSteady=True] [N/(m/s)] + INTEGER(IntKi) :: NLinTimes = 0_IntKi !< Number of LinTimes, or equally-spaced azimuth steps in periodic linearized model (>0)[unused if Linearize=False] [-] + REAL(DbKi) :: AzimDelta = 0.0_R8Ki !< difference between two consecutive azimuth positions in CalcSteady algorithm [rad] + INTEGER(IntKi) :: LinInputs = 0_IntKi !< Inputs included in linearization (switch) {0=none; 1=standard; 2=all module inputs (debug)} [unused if Linearize=False] [-] + INTEGER(IntKi) :: LinOutputs = 0_IntKi !< Outputs included in linearization (switch) {0=none; 1=from OutList(s); 2=all module outputs (debug)} [unused if Linearize=False] [-] + LOGICAL :: LinOutJac = .false. !< Include full Jacabians in linearization output (for debug) (flag) [unused if Linearize=False; used only if LinInputs=LinOutputs=2] [-] + LOGICAL :: LinOutMod = .false. !< Write module-level linearization output files in addition to output for full system? (flag) [unused if Linearize=False] [-] TYPE(FAST_VTK_ModeShapeType) :: VTK_modes !< Data for VTK mode-shape visualization [-] - LOGICAL :: UseSC !< Use Supercontroller [-] - INTEGER(IntKi) :: Lin_NumMods !< number of modules in the linearization [-] - INTEGER(IntKi) , DIMENSION(1:NumModules) :: Lin_ModOrder !< indices that determine which order the modules are in the glue-code linearization matrix [-] - INTEGER(IntKi) :: LinInterpOrder !< Interpolation order for CalcSteady solution [-] + LOGICAL :: UseSC = .false. !< Use Supercontroller [-] + INTEGER(IntKi) :: Lin_NumMods = 0_IntKi !< number of modules in the linearization [-] + INTEGER(IntKi) , DIMENSION(1:NumModules) :: Lin_ModOrder = 0_IntKi !< indices that determine which order the modules are in the glue-code linearization matrix [-] + INTEGER(IntKi) :: LinInterpOrder = 0_IntKi !< Interpolation order for CalcSteady solution [-] END TYPE FAST_ParameterType ! ======================= ! ========= FAST_LinStateSave ======= @@ -305,9 +305,9 @@ MODULE FAST_Types LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_x !< Whether corresponding continuous state is in rotating frame [-] LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_z !< Whether corresponding constraint state is in rotating frame [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: DerivOrder_x !< Derivative order for continuous states [-] - INTEGER(IntKi) , DIMENSION(1:3) :: SizeLin !< sizes of (1) the module's inputs, (2) the module's linearized outputs, and (3) the module's continuous states [-] - INTEGER(IntKi) , DIMENSION(1:3) :: LinStartIndx !< the starting index in combined matrices of (1) the module's inputs, (2) the module's linearized outputs, and (3) the module's continuous states [-] - INTEGER(IntKi) :: NumOutputs !< number of WriteOutputs in each linearized module [-] + INTEGER(IntKi) , DIMENSION(1:3) :: SizeLin = 0_IntKi !< sizes of (1) the module's inputs, (2) the module's linearized outputs, and (3) the module's continuous states [-] + INTEGER(IntKi) , DIMENSION(1:3) :: LinStartIndx = 0_IntKi !< the starting index in combined matrices of (1) the module's inputs, (2) the module's linearized outputs, and (3) the module's continuous states [-] + INTEGER(IntKi) :: NumOutputs = 0_IntKi !< number of WriteOutputs in each linearized module [-] END TYPE FAST_LinType ! ======================= ! ========= FAST_ModLinType ======= @@ -319,22 +319,22 @@ MODULE FAST_Types TYPE, PUBLIC :: FAST_LinFileType TYPE(FAST_ModLinType) , DIMENSION(1:NumModules) :: Modules !< Linearization data for each module [-] TYPE(FAST_LinType) :: Glue !< Linearization data for the glue code (coupled system) [-] - REAL(ReKi) :: RotSpeed !< Rotor azimuth angular speed [rad/s] - REAL(ReKi) :: Azimuth !< Rotor azimuth position [rad] - REAL(ReKi) :: WindSpeed !< Wind speed at reference height [m/s] + REAL(ReKi) :: RotSpeed = 0.0_ReKi !< Rotor azimuth angular speed [rad/s] + REAL(ReKi) :: Azimuth = 0.0_ReKi !< Rotor azimuth position [rad] + REAL(ReKi) :: WindSpeed = 0.0_ReKi !< Wind speed at reference height [m/s] END TYPE FAST_LinFileType ! ======================= ! ========= FAST_MiscLinType ======= TYPE, PUBLIC :: FAST_MiscLinType REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: LinTimes !< List of times at which to linearize [s] - INTEGER(IntKi) :: CopyOP_CtrlCode !< mesh control code for copy type (new on first call; update otherwise) [-] + INTEGER(IntKi) :: CopyOP_CtrlCode = 0_IntKi !< mesh control code for copy type (new on first call; update otherwise) [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: AzimTarget !< target azimuth positions in CalcSteady algorithm [rad] - LOGICAL :: IsConverged !< whether the error calculation in the CalcSteady algorithm is converged [-] - LOGICAL :: FoundSteady !< whether the CalcSteady algorithm found a steady-state solution [-] - LOGICAL :: ForceLin !< whether the CalcSteady algorithm found a steady-state solution [-] - INTEGER(IntKi) :: n_rot !< number of rotations completed in CalcSteady algorithm [-] - INTEGER(IntKi) :: AzimIndx !< index into target azimuth array in CalcSteady algorithm [-] - INTEGER(IntKi) :: NextLinTimeIndx !< index for next time in LinTimes where linearization should occur [-] + LOGICAL :: IsConverged = .false. !< whether the error calculation in the CalcSteady algorithm is converged [-] + LOGICAL :: FoundSteady = .false. !< whether the CalcSteady algorithm found a steady-state solution [-] + LOGICAL :: ForceLin = .false. !< whether the CalcSteady algorithm found a steady-state solution [-] + INTEGER(IntKi) :: n_rot = 0_IntKi !< number of rotations completed in CalcSteady algorithm [-] + INTEGER(IntKi) :: AzimIndx = 0_IntKi !< index into target azimuth array in CalcSteady algorithm [-] + INTEGER(IntKi) :: NextLinTimeIndx = 0_IntKi !< index for next time in LinTimes where linearization should occur [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: Psi !< Azimuth angle at the current and previous time steps (uses LinInterpOrder); DbKi so that we can use registry-generated extrap/interp routines [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: y_interp !< Interpolated outputs packed into an array [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: y_ref !< Reference output range for CalcSteady error calculation [-] @@ -345,24 +345,24 @@ MODULE FAST_Types TYPE, PUBLIC :: FAST_OutputFileType REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: TimeData !< Array to contain the time output data for the binary file (first output time and a time [fixed] increment) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AllOutData !< Array to contain all the output data (time history of all outputs); Index 1 is NumOuts, Index 2 is Time step [-] - INTEGER(IntKi) :: n_Out !< Time index into the AllOutData array [-] - INTEGER(IntKi) :: NOutSteps !< Maximum number of output steps [-] - INTEGER(IntKi) , DIMENSION(1:NumModules) :: numOuts !< number of outputs to print from each module [-] + INTEGER(IntKi) :: n_Out = 0_IntKi !< Time index into the AllOutData array [-] + INTEGER(IntKi) :: NOutSteps = 0_IntKi !< Maximum number of output steps [-] + INTEGER(IntKi) , DIMENSION(1:NumModules) :: numOuts = 0_IntKi !< number of outputs to print from each module [-] INTEGER(IntKi) :: UnOu = -1 !< I/O unit number for the tabular output file [-] INTEGER(IntKi) :: UnSum = -1 !< I/O unit number for the summary file [-] INTEGER(IntKi) :: UnGra = -1 !< I/O unit number for mesh graphics [-] - CHARACTER(1024) , DIMENSION(1:3) :: FileDescLines !< Description lines to include in output files (header, time run, plus module names/versions) [-] + CHARACTER(1024) , DIMENSION(1:3) :: FileDescLines = '' !< Description lines to include in output files (header, time run, plus module names/versions) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: ChannelNames !< Names of the output channels [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: ChannelUnits !< Units for the output channels [-] TYPE(ProgDesc) , DIMENSION(1:NumModules) :: Module_Ver !< version information from all modules [-] - CHARACTER(ChanLen) , DIMENSION(1:NumModules) :: Module_Abrev !< abbreviation for module (used in file output naming conventions) [-] - LOGICAL :: WriteThisStep !< Whether this step will be written in the FAST output files [-] - INTEGER(IntKi) :: VTK_count !< Number of VTK files written (for naming output files) [-] - INTEGER(IntKi) :: VTK_LastWaveIndx !< last index into wave array [-] + CHARACTER(ChanLen) , DIMENSION(1:NumModules) :: Module_Abrev = '' !< abbreviation for module (used in file output naming conventions) [-] + LOGICAL :: WriteThisStep = .false. !< Whether this step will be written in the FAST output files [-] + INTEGER(IntKi) :: VTK_count = 0_IntKi !< Number of VTK files written (for naming output files) [-] + INTEGER(IntKi) :: VTK_LastWaveIndx = 0_IntKi !< last index into wave array [-] TYPE(FAST_LinFileType) :: Lin !< linearization data for output [-] - INTEGER(IntKi) :: ActualChanLen !< width of the column headers output in the text and/or binary file [-] + INTEGER(IntKi) :: ActualChanLen = 0_IntKi !< width of the column headers output in the text and/or binary file [-] TYPE(FAST_LinStateSave) :: op !< operating points of states and inputs for VTK output of mode shapes [-] - REAL(ReKi) , DIMENSION(1:5) :: DriverWriteOutput !< pitch and tsr for current aero map case, plus error, number of iterations, wind speed [-] + REAL(ReKi) , DIMENSION(1:5) :: DriverWriteOutput = 0.0_ReKi !< pitch and tsr for current aero map case, plus error, number of iterations, wind speed [-] END TYPE FAST_OutputFileType ! ======================= ! ========= IceDyn_Data ======= @@ -690,29 +690,29 @@ MODULE FAST_Types ! ======================= ! ========= FAST_ExternInputType ======= TYPE, PUBLIC :: FAST_ExternInputType - REAL(ReKi) :: GenTrq !< generator torque input from Simulink/Labview [-] - REAL(ReKi) :: ElecPwr !< electric power input from Simulink/Labview [-] - REAL(ReKi) :: YawPosCom !< yaw position command from Simulink/Labview [-] - REAL(ReKi) :: YawRateCom !< yaw rate command from Simulink/Labview [-] - REAL(ReKi) , DIMENSION(1:3) :: BlPitchCom !< blade pitch commands from Simulink/Labview [rad] - REAL(ReKi) , DIMENSION(1:3) :: BlAirfoilCom !< blade airfoil commands from Simulink/Labview [-] - REAL(ReKi) :: HSSBrFrac !< Fraction of full braking torque: 0 (off) <= HSSBrFrac <= 1 (full) from Simulink or LabVIEW [-] - REAL(ReKi) , DIMENSION(1:3) :: LidarFocus !< lidar focus (relative to lidar location) [m] - REAL(ReKi) , DIMENSION(1:20) :: CableDeltaL !< Cable control DeltaL [m] - REAL(ReKi) , DIMENSION(1:20) :: CableDeltaLdot !< Cable control DeltaLdot [m/s] + REAL(ReKi) :: GenTrq = 0.0_ReKi !< generator torque input from Simulink/Labview [-] + REAL(ReKi) :: ElecPwr = 0.0_ReKi !< electric power input from Simulink/Labview [-] + REAL(ReKi) :: YawPosCom = 0.0_ReKi !< yaw position command from Simulink/Labview [-] + REAL(ReKi) :: YawRateCom = 0.0_ReKi !< yaw rate command from Simulink/Labview [-] + REAL(ReKi) , DIMENSION(1:3) :: BlPitchCom = 0.0_ReKi !< blade pitch commands from Simulink/Labview [rad] + REAL(ReKi) , DIMENSION(1:3) :: BlAirfoilCom = 0.0_ReKi !< blade airfoil commands from Simulink/Labview [-] + REAL(ReKi) :: HSSBrFrac = 0.0_ReKi !< Fraction of full braking torque: 0 (off) <= HSSBrFrac <= 1 (full) from Simulink or LabVIEW [-] + REAL(ReKi) , DIMENSION(1:3) :: LidarFocus = 0.0_ReKi !< lidar focus (relative to lidar location) [m] + REAL(ReKi) , DIMENSION(1:20) :: CableDeltaL = 0.0_ReKi !< Cable control DeltaL [m] + REAL(ReKi) , DIMENSION(1:20) :: CableDeltaLdot = 0.0_ReKi !< Cable control DeltaLdot [m/s] END TYPE FAST_ExternInputType ! ======================= ! ========= FAST_MiscVarType ======= TYPE, PUBLIC :: FAST_MiscVarType - REAL(DbKi) :: TiLstPrn !< The simulation time of the last print (to file) [(s)] - REAL(DbKi) :: t_global !< Current simulation time (for global/FAST simulation) [(s)] - REAL(DbKi) :: NextJacCalcTime !< Time between calculating Jacobians in the HD-ED and SD-ED simulations [(s)] - REAL(ReKi) :: PrevClockTime !< Clock time at start of simulation in seconds [(s)] - REAL(ReKi) :: UsrTime1 !< User CPU time for simulation initialization [(s)] - REAL(ReKi) :: UsrTime2 !< User CPU time for simulation (without intialization) [(s)] - INTEGER(IntKi) , DIMENSION(1:8) :: StrtTime !< Start time of simulation (including intialization) [-] - INTEGER(IntKi) , DIMENSION(1:8) :: SimStrtTime !< Start time of simulation (after initialization) [-] - LOGICAL :: calcJacobian !< Should we calculate Jacobians in Option 1? [(flag)] + REAL(DbKi) :: TiLstPrn = 0.0_R8Ki !< The simulation time of the last print (to file) [(s)] + REAL(DbKi) :: t_global = 0.0_R8Ki !< Current simulation time (for global/FAST simulation) [(s)] + REAL(DbKi) :: NextJacCalcTime = 0.0_R8Ki !< Time between calculating Jacobians in the HD-ED and SD-ED simulations [(s)] + REAL(ReKi) :: PrevClockTime = 0.0_ReKi !< Clock time at start of simulation in seconds [(s)] + REAL(ReKi) :: UsrTime1 = 0.0_ReKi !< User CPU time for simulation initialization [(s)] + REAL(ReKi) :: UsrTime2 = 0.0_ReKi !< User CPU time for simulation (without intialization) [(s)] + INTEGER(IntKi) , DIMENSION(1:8) :: StrtTime = 0_IntKi !< Start time of simulation (including intialization) [-] + INTEGER(IntKi) , DIMENSION(1:8) :: SimStrtTime = 0_IntKi !< Start time of simulation (after initialization) [-] + LOGICAL :: calcJacobian = .false. !< Should we calculate Jacobians in Option 1? [(flag)] TYPE(FAST_ExternInputType) :: ExternInput !< external input values [-] TYPE(FAST_MiscLinType) :: Lin !< misc data for linearization analysis [-] END TYPE FAST_MiscVarType @@ -759,24 +759,24 @@ MODULE FAST_Types TYPE, PUBLIC :: FAST_ExternInitType REAL(DbKi) :: Tmax = -1 !< External code specified Tmax [s] INTEGER(IntKi) :: SensorType = SensorType_None !< lidar sensor type, which should not be pulsed at the moment; this input should be replaced with a section in the InflowWind input file [-] - LOGICAL :: LidRadialVel !< TRUE => return radial component, FALSE => return 'x' direction estimate [-] + LOGICAL :: LidRadialVel = .false. !< TRUE => return radial component, FALSE => return 'x' direction estimate [-] INTEGER(IntKi) :: TurbineID = 0 !< ID number for turbine (used to create output file naming convention) [-] - REAL(ReKi) , DIMENSION(1:3) :: TurbinePos !< Initial position of turbine base (origin used for graphics or in FAST.Farm) [m] - INTEGER(IntKi) :: WaveFieldMod !< Wave field handling (-) (switch) 0: use individual HydroDyn inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin [-] - INTEGER(IntKi) :: NumSC2CtrlGlob !< number of global controller inputs [from supercontroller] [-] - INTEGER(IntKi) :: NumSC2Ctrl !< number of turbine specific controller inputs [from supercontroller] [-] - INTEGER(IntKi) :: NumCtrl2SC !< number of controller outputs [to supercontroller] [-] + REAL(ReKi) , DIMENSION(1:3) :: TurbinePos = 0.0_ReKi !< Initial position of turbine base (origin used for graphics or in FAST.Farm) [m] + INTEGER(IntKi) :: WaveFieldMod = 0_IntKi !< Wave field handling (-) (switch) 0: use individual HydroDyn inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin [-] + INTEGER(IntKi) :: NumSC2CtrlGlob = 0_IntKi !< number of global controller inputs [from supercontroller] [-] + INTEGER(IntKi) :: NumSC2Ctrl = 0_IntKi !< number of turbine specific controller inputs [from supercontroller] [-] + INTEGER(IntKi) :: NumCtrl2SC = 0_IntKi !< number of controller outputs [to supercontroller] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: fromSCGlob !< Initial global inputs to the controller [from the supercontroller] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: fromSC !< Initial turbine specific inputs to the controller [from the supercontroller] [-] LOGICAL :: FarmIntegration = .false. !< whether this is called from FAST.Farm (or another program that doesn't want FAST to call all of the init stuff first) [-] - INTEGER(IntKi) , DIMENSION(1:4) :: windGrid_n !< number of grid points in the x, y, z, and t directions for IfW [-] - REAL(ReKi) , DIMENSION(1:4) :: windGrid_delta !< size between 2 consecutive grid points in each grid direction for IfW [m,m,m,s] - REAL(ReKi) , DIMENSION(1:3) :: windGrid_pZero !< fixed position of the XYZ grid (i.e., XYZ coordinates of IfW m%V(:,1,1,1,:)) [m] + INTEGER(IntKi) , DIMENSION(1:4) :: windGrid_n = 0_IntKi !< number of grid points in the x, y, z, and t directions for IfW [-] + REAL(ReKi) , DIMENSION(1:4) :: windGrid_delta = 0.0_ReKi !< size between 2 consecutive grid points in each grid direction for IfW [m,m,m,s] + REAL(ReKi) , DIMENSION(1:3) :: windGrid_pZero = 0.0_ReKi !< fixed position of the XYZ grid (i.e., XYZ coordinates of IfW m%V(:,1,1,1,:)) [m] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: windGrid_data => NULL() !< Pointers to Wind velocity of disturbed wind (ambient + wakes) across each high-resolution domain around a turbine for each high-resolution step within a low-resolution step [m/s] - CHARACTER(1024) :: RootName !< Root name of FAST output files (overrides normal operation) [-] - INTEGER(IntKi) :: NumActForcePtsBlade !< number of actuator line force points in blade [-] - INTEGER(IntKi) :: NumActForcePtsTower !< number of actuator line force points in tower [-] - INTEGER(IntKi) :: NodeClusterType !< Node clustering for actuator line (0 - Uniform, 1 - Non-uniform clustered towards tip) [-] + CHARACTER(1024) :: RootName = '' !< Root name of FAST output files (overrides normal operation) [-] + INTEGER(IntKi) :: NumActForcePtsBlade = 0_IntKi !< number of actuator line force points in blade [-] + INTEGER(IntKi) :: NumActForcePtsTower = 0_IntKi !< number of actuator line force points in tower [-] + INTEGER(IntKi) :: NodeClusterType = 0_IntKi !< Node clustering for actuator line (0 - Uniform, 1 - Non-uniform clustered towards tip) [-] END TYPE FAST_ExternInitType ! ======================= ! ========= FAST_TurbineType ======= diff --git a/modules/openfast-registry/src/registry_gen_fortran.cpp b/modules/openfast-registry/src/registry_gen_fortran.cpp index beab6104d3..79a481c5e0 100644 --- a/modules/openfast-registry/src/registry_gen_fortran.cpp +++ b/modules/openfast-registry/src/registry_gen_fortran.cpp @@ -213,14 +213,50 @@ void Registry::gen_fortran_module(const Module &mod, const std::string &out_dir) w << " :: " << field.name << " "; + // Add field initialization if (field.is_pointer) { w << "=> NULL() "; } - else if (field.rank == 0 && !field.init_value.empty()) + else if (field.is_allocatable) + { + // No initialization + } + else if (!field.init_value.empty()) { w << "= " << field.init_value << " "; } + else + { + switch (field.data_type->tag) + { + case DataType::Tag::Real: + switch (field.data_type->basic.bit_size) + { + case 0: + w << "= 0.0_ReKi "; + break; + case 32: + w << "= 0.0_R4Ki "; + break; + case 64: + w << "= 0.0_R8Ki "; + break; + } + break; + case DataType::Tag::Integer: + w << "= 0_IntKi "; + break; + case DataType::Tag::Logical: + w << "= .false. "; + break; + case DataType::Tag::Character: + w << "= '' "; + break; + case DataType::Tag::Derived: + break; + } + } if (field.desc.compare("-") != 0 || field.units.compare("-") != 0) { @@ -359,7 +395,8 @@ void gen_copy(std::ostream &w, const Module &mod, const DataType::Derived &ddt, w << indent << "end if"; // bjj: this needs to be updated if we've got multidimensional arrays - if (gen_c_code && field.is_pointer) + if (gen_c_code && field.is_pointer && + (field.data_type->tag != DataType::Tag::Derived)) { std::string dst_c = "Dst" + ddt.name_short + "Data%C_obj%" + field.name; w << indent << dst_c << "_Len = size(" << dst << ")"; @@ -551,13 +588,13 @@ void gen_destroy(std::ostream &w, const Module &mod, const DataType::Derived &dd if (field.is_pointer) { w << indent << var << " => null()"; - } - if (gen_c_code && field.is_pointer) - { - auto var_c = ddt_data + "%C_obj%" + field.name; - w << indent << var_c << " = c_null_ptr"; - w << indent << var_c << "_Len = 0"; + if (gen_c_code && (field.data_type->tag != DataType::Tag::Derived)) + { + auto var_c = ddt_data + "%C_obj%" + field.name; + w << indent << var_c << " = c_null_ptr"; + w << indent << var_c << "_Len = 0"; + } } indent.erase(indent.size() - 3); @@ -691,7 +728,7 @@ void gen_pack(std::ostream &w, const Module &mod, const DataType::Derived &ddt, w << indent << "end if"; } } - + // Check for pack errors at end of routine w << indent << "if (RegCheckErr(Buf, RoutineName)) return"; @@ -809,7 +846,8 @@ void gen_unpack(std::ostream &w, const Module &mod, const DataType::Derived &ddt } // bjj: this needs to be updated if we've got multiple dimension arrays - if (gen_c_code && field.is_pointer) + if (gen_c_code && field.is_pointer && + (field.data_type->tag != DataType::Tag::Derived)) { w << indent << var_c << "_Len = size(" << var << ")"; w << indent << "if (" << var_c << "_Len > 0) " << var_c << " = c_loc(" << var << "("; diff --git a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 index b068168808..030d1433e3 100644 --- a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 +++ b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 @@ -35,9 +35,9 @@ MODULE OrcaFlexInterface_Types IMPLICIT NONE ! ========= Orca_InitInputType ======= TYPE, PUBLIC :: Orca_InitInputType - CHARACTER(1024) :: InputFile !< Name of the input file; remove if there is no file [-] - CHARACTER(1024) :: RootName !< RootName for writing output files (echo file) [-] - REAL(ReKi) :: TMax !< Maximum Time [seconds] + CHARACTER(1024) :: InputFile = '' !< Name of the input file; remove if there is no file [-] + CHARACTER(1024) :: RootName = '' !< RootName for writing output files (echo file) [-] + REAL(ReKi) :: TMax = 0.0_ReKi !< Maximum Time [seconds] END TYPE Orca_InitInputType ! ======================= ! ========= Orca_InitOutputType ======= @@ -49,33 +49,33 @@ MODULE OrcaFlexInterface_Types ! ======================= ! ========= Orca_InputFile ======= TYPE, PUBLIC :: Orca_InputFile - CHARACTER(1024) :: DLL_FileName !< Name of the DLL file [-] - CHARACTER(1024) :: DLL_InitProcName !< Name of the DLL procedure to call during initialisation [-] - CHARACTER(1024) :: DLL_CalcProcName !< Name of the DLL procedure to call during CalcOutput [-] - CHARACTER(1024) :: DLL_EndProcName !< Name of the DLL procedure to call during End [-] - CHARACTER(1024) :: DirRoot !< Directory and rootname of simulation input file [-] + CHARACTER(1024) :: DLL_FileName = '' !< Name of the DLL file [-] + CHARACTER(1024) :: DLL_InitProcName = '' !< Name of the DLL procedure to call during initialisation [-] + CHARACTER(1024) :: DLL_CalcProcName = '' !< Name of the DLL procedure to call during CalcOutput [-] + CHARACTER(1024) :: DLL_EndProcName = '' !< Name of the DLL procedure to call during End [-] + CHARACTER(1024) :: DirRoot = '' !< Directory and rootname of simulation input file [-] END TYPE Orca_InputFile ! ======================= ! ========= Orca_OtherStateType ======= TYPE, PUBLIC :: Orca_OtherStateType - REAL(SiKi) :: DummyOtherState !< Remove if you have OtherStates [-] + REAL(SiKi) :: DummyOtherState = 0.0_R4Ki !< Remove if you have OtherStates [-] END TYPE Orca_OtherStateType ! ======================= ! ========= Orca_MiscVarType ======= TYPE, PUBLIC :: Orca_MiscVarType - REAL(ReKi) , DIMENSION(1:6,1:6) :: PtfmAM !< Added mass matrix results from OrcaFlex [-] - REAL(ReKi) , DIMENSION(1:6) :: PtfmFt !< Force/moment results from OrcaFlex [-] - REAL(ReKi) , DIMENSION(1:6) :: F_PtfmAM !< Force/moment results calculated from the added mass and accel [-] + REAL(ReKi) , DIMENSION(1:6,1:6) :: PtfmAM = 0.0_ReKi !< Added mass matrix results from OrcaFlex [-] + REAL(ReKi) , DIMENSION(1:6) :: PtfmFt = 0.0_ReKi !< Force/moment results from OrcaFlex [-] + REAL(ReKi) , DIMENSION(1:6) :: F_PtfmAM = 0.0_ReKi !< Force/moment results calculated from the added mass and accel [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AllOuts !< An array holding the value of all of the calculated (not only selected) output channels [see OutListParameters.xlsx spreadsheet] - REAL(DbKi) :: LastTimeStep !< The last timestep called [-] + REAL(DbKi) :: LastTimeStep = 0.0_R8Ki !< The last timestep called [-] END TYPE Orca_MiscVarType ! ======================= ! ========= Orca_ParameterType ======= TYPE, PUBLIC :: Orca_ParameterType - REAL(DbKi) :: DT !< Time step for continuous state integration & discrete state update [seconds] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for continuous state integration & discrete state update [seconds] TYPE(DLL_Type) :: DLL_Orca !< Info for the OrcaFlex DLL [-] - CHARACTER(1024) :: SimNamePath !< Path with simulation rootname with null end character for passing to C [-] - INTEGER(IntKi) :: SimNamePathLen !< Length of SimNamePath (including null char) [-] + CHARACTER(1024) :: SimNamePath = '' !< Path with simulation rootname with null end character for passing to C [-] + INTEGER(IntKi) :: SimNamePathLen = 0_IntKi !< Length of SimNamePath (including null char) [-] INTEGER(IntKi) :: NumOuts = 0 !< Number of parameters in the output list (number of outputs requested) [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] END TYPE Orca_ParameterType @@ -93,17 +93,17 @@ MODULE OrcaFlexInterface_Types ! ======================= ! ========= Orca_ContinuousStateType ======= TYPE, PUBLIC :: Orca_ContinuousStateType - REAL(ReKi) :: Dummy !< Dummy placeholder [-] + REAL(ReKi) :: Dummy = 0.0_ReKi !< Dummy placeholder [-] END TYPE Orca_ContinuousStateType ! ======================= ! ========= Orca_DiscreteStateType ======= TYPE, PUBLIC :: Orca_DiscreteStateType - REAL(ReKi) :: Dummy !< Dummy placeholder [-] + REAL(ReKi) :: Dummy = 0.0_ReKi !< Dummy placeholder [-] END TYPE Orca_DiscreteStateType ! ======================= ! ========= Orca_ConstraintStateType ======= TYPE, PUBLIC :: Orca_ConstraintStateType - REAL(ReKi) :: DummyConstrState !< Dummy placeholder [-] + REAL(ReKi) :: DummyConstrState = 0.0_ReKi !< Dummy placeholder [-] END TYPE Orca_ConstraintStateType ! ======================= CONTAINS diff --git a/modules/seastate/src/Current_Types.f90 b/modules/seastate/src/Current_Types.f90 index f4c04d84a1..e57202ef0d 100644 --- a/modules/seastate/src/Current_Types.f90 +++ b/modules/seastate/src/Current_Types.f90 @@ -35,27 +35,27 @@ MODULE Current_Types IMPLICIT NONE ! ========= Current_InitInputType ======= TYPE, PUBLIC :: Current_InitInputType - REAL(SiKi) :: CurrSSV0 !< [-] - CHARACTER(80) :: CurrSSDirChr !< [-] - REAL(SiKi) :: CurrSSDir !< [-] - REAL(SiKi) :: CurrNSRef !< [-] - REAL(SiKi) :: CurrNSV0 !< [-] - REAL(SiKi) :: CurrNSDir !< [-] - REAL(SiKi) :: CurrDIV !< [-] - REAL(SiKi) :: CurrDIDir !< [-] - INTEGER(IntKi) :: CurrMod !< [-] - REAL(SiKi) :: WtrDpth !< [-] + REAL(SiKi) :: CurrSSV0 = 0.0_R4Ki !< [-] + CHARACTER(80) :: CurrSSDirChr = '' !< [-] + REAL(SiKi) :: CurrSSDir = 0.0_R4Ki !< [-] + REAL(SiKi) :: CurrNSRef = 0.0_R4Ki !< [-] + REAL(SiKi) :: CurrNSV0 = 0.0_R4Ki !< [-] + REAL(SiKi) :: CurrNSDir = 0.0_R4Ki !< [-] + REAL(SiKi) :: CurrDIV = 0.0_R4Ki !< [-] + REAL(SiKi) :: CurrDIDir = 0.0_R4Ki !< [-] + INTEGER(IntKi) :: CurrMod = 0_IntKi !< [-] + REAL(SiKi) :: WtrDpth = 0.0_R4Ki !< [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinGridzi !< [-] - INTEGER(IntKi) :: NGridPts !< [-] - CHARACTER(1024) :: DirRoot !< [-] + INTEGER(IntKi) :: NGridPts = 0_IntKi !< [-] + CHARACTER(1024) :: DirRoot = '' !< [-] END TYPE Current_InitInputType ! ======================= ! ========= Current_InitOutputType ======= TYPE, PUBLIC :: Current_InitOutputType REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: CurrVxi !< [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: CurrVyi !< [-] - REAL(SiKi) :: PCurrVxiPz0 !< [-] - REAL(SiKi) :: PCurrVyiPz0 !< [-] + REAL(SiKi) :: PCurrVxiPz0 = 0.0_R4Ki !< [-] + REAL(SiKi) :: PCurrVyiPz0 = 0.0_R4Ki !< [-] END TYPE Current_InitOutputType ! ======================= CONTAINS diff --git a/modules/seastate/src/SeaSt_WaveField_Types.f90 b/modules/seastate/src/SeaSt_WaveField_Types.f90 index 5a53da1f8a..c0626b5641 100644 --- a/modules/seastate/src/SeaSt_WaveField_Types.f90 +++ b/modules/seastate/src/SeaSt_WaveField_Types.f90 @@ -49,9 +49,9 @@ MODULE SeaSt_WaveField_Types REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveElev1 !< First order wave elevation [(m)] REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveElev2 !< Second order wave elevation [(m)] TYPE(SeaSt_Interp_ParameterType) :: SeaSt_Interp_p !< Parameter information from the SeaState Interpolation module [(-)] - INTEGER(IntKi) :: WaveStMod !< Wave stretching model [-] - REAL(ReKi) :: EffWtrDpth !< Water depth [(-)] - REAL(ReKi) :: MSL2SWL !< Vertical distance from mean sea level to still water level [(m)] + INTEGER(IntKi) :: WaveStMod = 0_IntKi !< Wave stretching model [-] + REAL(ReKi) :: EffWtrDpth = 0.0_ReKi !< Water depth [(-)] + REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Vertical distance from mean sea level to still water level [(m)] REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveElevC !< Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part [(m)] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevC0 !< Fourier components of the incident wave elevation at the platform reference point. First column is the real part; second column is the imaginary part [(m)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveDirArr !< Wave direction array. Each frequency has a unique direction of WaveNDir > 1 [(degrees)] diff --git a/modules/seastate/src/SeaState_Interp_Types.f90 b/modules/seastate/src/SeaState_Interp_Types.f90 index b2189b5bae..bc0ca2fcfd 100644 --- a/modules/seastate/src/SeaState_Interp_Types.f90 +++ b/modules/seastate/src/SeaState_Interp_Types.f90 @@ -35,10 +35,10 @@ MODULE SeaState_Interp_Types IMPLICIT NONE ! ========= SeaSt_Interp_InitInputType ======= TYPE, PUBLIC :: SeaSt_Interp_InitInputType - INTEGER(IntKi) , DIMENSION(1:4) :: n !< number of grid points in the t, x, y, and z directions [-] - REAL(ReKi) , DIMENSION(1:4) :: delta !< size between 2 consecutive grid points in each grid direction (time, x, y, z) [s,m,m,m] - REAL(ReKi) , DIMENSION(1:4) :: pZero !< fixed position of the time-X-Y-Z grid (i.e., XYZ coordinates of m%V(:,1,1,1,:)) [m] - REAL(ReKi) :: Z_Depth !< grid depth [m] + INTEGER(IntKi) , DIMENSION(1:4) :: n = 0_IntKi !< number of grid points in the t, x, y, and z directions [-] + REAL(ReKi) , DIMENSION(1:4) :: delta = 0.0_ReKi !< size between 2 consecutive grid points in each grid direction (time, x, y, z) [s,m,m,m] + REAL(ReKi) , DIMENSION(1:4) :: pZero = 0.0_ReKi !< fixed position of the time-X-Y-Z grid (i.e., XYZ coordinates of m%V(:,1,1,1,:)) [m] + REAL(ReKi) :: Z_Depth = 0.0_ReKi !< grid depth [m] END TYPE SeaSt_Interp_InitInputType ! ======================= ! ========= SeaSt_Interp_InitOutputType ======= @@ -48,19 +48,19 @@ MODULE SeaState_Interp_Types ! ======================= ! ========= SeaSt_Interp_MiscVarType ======= TYPE, PUBLIC :: SeaSt_Interp_MiscVarType - REAL(SiKi) , DIMENSION(1:8) :: N3D !< this is the 3-d velocity field for each wind component [{uvw},nx,ny,nz,nt]; it is stored as a miscVar instead of an input so that we don't have 4 copies of a very large field [-] - REAL(SiKi) , DIMENSION(1:16) :: N4D !< this is the 4-d velocity field for each wind component [{uvw},nx,ny,nz,nt]; it is stored as a miscVar instead of an input so that we don't have 4 copies of a very large field [-] - INTEGER(IntKi) , DIMENSION(1:4) :: Indx_Lo !< this is the 4-d velocity field for each wind component [{uvw},nx,ny,nz,nt]; it is stored as a miscVar instead of an input so that we don't have 4 copies of a very large field [-] - INTEGER(IntKi) , DIMENSION(1:4) :: Indx_Hi !< this is the 4-d velocity field for each wind component [{uvw},nx,ny,nz,nt]; it is stored as a miscVar instead of an input so that we don't have 4 copies of a very large field [-] + REAL(SiKi) , DIMENSION(1:8) :: N3D = 0.0_R4Ki !< this is the 3-d velocity field for each wind component [{uvw},nx,ny,nz,nt]; it is stored as a miscVar instead of an input so that we don't have 4 copies of a very large field [-] + REAL(SiKi) , DIMENSION(1:16) :: N4D = 0.0_R4Ki !< this is the 4-d velocity field for each wind component [{uvw},nx,ny,nz,nt]; it is stored as a miscVar instead of an input so that we don't have 4 copies of a very large field [-] + INTEGER(IntKi) , DIMENSION(1:4) :: Indx_Lo = 0_IntKi !< this is the 4-d velocity field for each wind component [{uvw},nx,ny,nz,nt]; it is stored as a miscVar instead of an input so that we don't have 4 copies of a very large field [-] + INTEGER(IntKi) , DIMENSION(1:4) :: Indx_Hi = 0_IntKi !< this is the 4-d velocity field for each wind component [{uvw},nx,ny,nz,nt]; it is stored as a miscVar instead of an input so that we don't have 4 copies of a very large field [-] LOGICAL :: FirstWarn_Clamp = .true. !< used to avoid too many 'Position has been clamped to the grid boundary' warning messages [-] END TYPE SeaSt_Interp_MiscVarType ! ======================= ! ========= SeaSt_Interp_ParameterType ======= TYPE, PUBLIC :: SeaSt_Interp_ParameterType - INTEGER(IntKi) , DIMENSION(1:4) :: n !< number of evenly-spaced grid points in the t, x, y, and z directions [-] - REAL(ReKi) , DIMENSION(1:4) :: delta !< size between 2 consecutive grid points in each grid direction [s,m,m,m] - REAL(ReKi) , DIMENSION(1:4) :: pZero !< fixed position of the XYZ grid (i.e., XYZ coordinates of m%V(:,1,1,1,:)) [m] - REAL(ReKi) :: Z_Depth !< grid depth [m] + INTEGER(IntKi) , DIMENSION(1:4) :: n = 0_IntKi !< number of evenly-spaced grid points in the t, x, y, and z directions [-] + REAL(ReKi) , DIMENSION(1:4) :: delta = 0.0_ReKi !< size between 2 consecutive grid points in each grid direction [s,m,m,m] + REAL(ReKi) , DIMENSION(1:4) :: pZero = 0.0_ReKi !< fixed position of the XYZ grid (i.e., XYZ coordinates of m%V(:,1,1,1,:)) [m] + REAL(ReKi) :: Z_Depth = 0.0_ReKi !< grid depth [m] END TYPE SeaSt_Interp_ParameterType ! ======================= CONTAINS diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index 5b8b490410..d07eb1710b 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -40,51 +40,51 @@ MODULE SeaState_Types IMPLICIT NONE ! ========= SeaSt_InputFile ======= TYPE, PUBLIC :: SeaSt_InputFile - LOGICAL :: EchoFlag !< Echo the input file [-] - REAL(ReKi) :: MSL2SWL !< Mean Sea Level to Still Water Level offset [m] - REAL(ReKi) :: X_HalfWidth !< Half-width of the domain in the X direction [m] - REAL(ReKi) :: Y_HalfWidth !< Half-width of the domain in the Y direction [m] - REAL(ReKi) :: Z_Depth !< Depth of the domain the Z direction [m] - INTEGER(IntKi) :: NX !< Number of nodes in half of the X-direction domain [-] - INTEGER(IntKi) :: NY !< Number of nodes in half of the Y-direction domain [-] - INTEGER(IntKi) :: NZ !< Number of nodes in half of the Z-direction domain [-] + LOGICAL :: EchoFlag = .false. !< Echo the input file [-] + REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Mean Sea Level to Still Water Level offset [m] + REAL(ReKi) :: X_HalfWidth = 0.0_ReKi !< Half-width of the domain in the X direction [m] + REAL(ReKi) :: Y_HalfWidth = 0.0_ReKi !< Half-width of the domain in the Y direction [m] + REAL(ReKi) :: Z_Depth = 0.0_ReKi !< Depth of the domain the Z direction [m] + INTEGER(IntKi) :: NX = 0_IntKi !< Number of nodes in half of the X-direction domain [-] + INTEGER(IntKi) :: NY = 0_IntKi !< Number of nodes in half of the Y-direction domain [-] + INTEGER(IntKi) :: NZ = 0_IntKi !< Number of nodes in half of the Z-direction domain [-] TYPE(Waves_InitInputType) :: Waves !< Initialization data for Waves module [-] TYPE(Waves2_InitInputType) :: Waves2 !< Initialization data for Waves2 module [-] TYPE(Current_InitInputType) :: Current !< Initialization data for Current module [-] - LOGICAL :: Echo !< Echo the input files to a file with the same name as the input but with a .echo extension [T/F] [-] - INTEGER(IntKi) :: NWaveElev !< Number of user-requested points where the incident wave elevations can be output [-] + LOGICAL :: Echo = .false. !< Echo the input files to a file with the same name as the input but with a .echo extension [T/F] [-] + INTEGER(IntKi) :: NWaveElev = 0_IntKi !< Number of user-requested points where the incident wave elevations can be output [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevxi !< xi-coordinates for points where the incident wave elevations can be output [(meters)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevyi !< yi-coordinates for points where the incident wave elevations can be output [(meters)] - INTEGER(IntKi) :: NWaveKin !< Number of points where the incident wave kinematics will be computed [-] + INTEGER(IntKi) :: NWaveKin = 0_IntKi !< Number of points where the incident wave kinematics will be computed [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinxi !< xi-coordinates for points where the incident wave kinematics will be computed; these are relative to the mean sea level [(meters)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinyi !< yi-coordinates for points where the incident wave kinematics will be computed; these are relative to the mean sea level [(meters)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinzi !< zi-coordinates for points where the incident wave kinematics will be computed; these are relative to the mean sea level [(meters)] - INTEGER(IntKi) :: OutSwtch !< Output requested channels to: [1=SeaState.out 2=GlueCode.out 3=both files] [-] - LOGICAL :: OutAll !< Output all user-specified member and joint loads (only at each member end, not interior locations) [T/F] [-] - INTEGER(IntKi) :: NumOuts !< The number of outputs for this module as requested in the input file [-] + INTEGER(IntKi) :: OutSwtch = 0_IntKi !< Output requested channels to: [1=SeaState.out 2=GlueCode.out 3=both files] [-] + LOGICAL :: OutAll = .false. !< Output all user-specified member and joint loads (only at each member end, not interior locations) [T/F] [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< The number of outputs for this module as requested in the input file [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< The user-requested output channel labels for this modules. This should really be dimensioned with MaxOutPts [-] - LOGICAL :: SeaStSum !< Generate a SeaState summary file [T/F] [-] - CHARACTER(20) :: OutFmt !< Output format for numerical results [-] - CHARACTER(20) :: OutSFmt !< Output format for header strings [-] + LOGICAL :: SeaStSum = .false. !< Generate a SeaState summary file [T/F] [-] + CHARACTER(20) :: OutFmt = '' !< Output format for numerical results [-] + CHARACTER(20) :: OutSFmt = '' !< Output format for header strings [-] END TYPE SeaSt_InputFile ! ======================= ! ========= SeaSt_InitInputType ======= TYPE, PUBLIC :: SeaSt_InitInputType - CHARACTER(1024) :: InputFile !< Supplied by Driver: full path and filename for the SeaState module [-] + CHARACTER(1024) :: InputFile = '' !< Supplied by Driver: full path and filename for the SeaState module [-] LOGICAL :: UseInputFile = .TRUE. !< Supplied by Driver: .TRUE. if using a input file, .FALSE. if all inputs are being passed in by the caller [-] TYPE(FileInfoType) :: PassedFileData !< If we don't use the input file, pass everything through this [-] - CHARACTER(1024) :: OutRootName !< Supplied by Driver: The name of the root file (without extension) including the full path [-] - REAL(ReKi) :: Gravity !< Supplied by Driver: Gravitational acceleration [(m/s^2)] - REAL(ReKi) :: defWtrDens !< Default water density from the driver; may be overwritten [(kg/m^3)] - REAL(ReKi) :: defWtrDpth !< Default water depth from the driver; may be overwritten [m] - REAL(ReKi) :: defMSL2SWL !< Default mean sea level to still water level from the driver; may be overwritten [m] - REAL(DbKi) :: TMax !< Supplied by Driver: The total simulation time [(sec)] + CHARACTER(1024) :: OutRootName = '' !< Supplied by Driver: The name of the root file (without extension) including the full path [-] + REAL(ReKi) :: Gravity = 0.0_ReKi !< Supplied by Driver: Gravitational acceleration [(m/s^2)] + REAL(ReKi) :: defWtrDens = 0.0_ReKi !< Default water density from the driver; may be overwritten [(kg/m^3)] + REAL(ReKi) :: defWtrDpth = 0.0_ReKi !< Default water depth from the driver; may be overwritten [m] + REAL(ReKi) :: defMSL2SWL = 0.0_ReKi !< Default mean sea level to still water level from the driver; may be overwritten [m] + REAL(DbKi) :: TMax = 0.0_R8Ki !< Supplied by Driver: The total simulation time [(sec)] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevXY !< Supplied by Driver: X-Y locations for WaveElevation output (for visualization). First dimension is the X (1) and Y (2) coordinate. Second dimension is the point number. [m,-] - INTEGER(IntKi) :: WaveFieldMod !< Wave field handling (-) (switch) 0: use individual SeaState inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin [-] - REAL(ReKi) :: PtfmLocationX !< Supplied by Driver: X coordinate of platform location in the wave field [m] - REAL(ReKi) :: PtfmLocationY !< Supplied by Driver: Y coordinate of platform location in the wave field [m] + INTEGER(IntKi) :: WaveFieldMod = 0_IntKi !< Wave field handling (-) (switch) 0: use individual SeaState inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin [-] + REAL(ReKi) :: PtfmLocationX = 0.0_ReKi !< Supplied by Driver: X coordinate of platform location in the wave field [m] + REAL(ReKi) :: PtfmLocationY = 0.0_ReKi !< Supplied by Driver: Y coordinate of platform location in the wave field [m] INTEGER(IntKi) :: WrWvKinMod = 0 !< 0,1, or 2 indicating whether we are going to write out kinematics files. [ignored if WaveMod = 6, if 1 or 2 then files are written using the outrootname] [-] - LOGICAL :: HasIce !< Supplied by Driver: Whether this simulation has ice loading (flag) [-] + LOGICAL :: HasIce = .false. !< Supplied by Driver: Whether this simulation has ice loading (flag) [-] LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] END TYPE SeaSt_InitInputType ! ======================= @@ -93,17 +93,17 @@ MODULE SeaState_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< The is the list of all HD-related output channel header strings (includes all sub-module channels) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< The is the list of all HD-related output channel unit strings (includes all sub-module channels) [-] TYPE(ProgDesc) :: Ver !< Version of SeaState [-] - REAL(ReKi) :: WtrDens !< Water density, this is necessary to inform glue-code what the module is using for WtrDens (may not be the glue-code's default) [(kg/m^3)] - REAL(ReKi) :: WtrDpth !< Water depth, this is necessary to inform glue-code what the module is using for WtrDpth (may not be the glue-code's default) [(m)] - REAL(ReKi) :: MSL2SWL !< Offset between still-water level and mean sea level, this is necessary to inform glue-code what the module is using for MSL2SWL (may not be the glue-code's default) [(m)] + REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density, this is necessary to inform glue-code what the module is using for WtrDens (may not be the glue-code's default) [(kg/m^3)] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth, this is necessary to inform glue-code what the module is using for WtrDpth (may not be the glue-code's default) [(m)] + REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Offset between still-water level and mean sea level, this is necessary to inform glue-code what the module is using for MSL2SWL (may not be the glue-code's default) [(m)] REAL(SiKi) , DIMENSION(:,:), POINTER :: WaveElevC0 => NULL() !< Discrete Fourier transform of the instantaneous elevation of incident waves at the platform reference point. First column is real part, second column is imaginary part [(meters)] REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElevC => NULL() !< Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part [(meters)] REAL(SiKi) , DIMENSION(:), POINTER :: WaveDirArr => NULL() !< Wave direction array. Each frequency has a unique direction of WaveNDir > 1 [(degrees)] - REAL(SiKi) :: WaveDirMin !< Minimum wave direction. [(degrees)] - REAL(SiKi) :: WaveDirMax !< Maximum wave direction. [(degrees)] - REAL(SiKi) :: WaveDir !< Incident wave propagation heading direction [(degrees)] - LOGICAL :: WaveMultiDir !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] - REAL(SiKi) :: WaveDOmega !< Frequency step for incident wave calculations [(rad/s)] + REAL(SiKi) :: WaveDirMin = 0.0_R4Ki !< Minimum wave direction. [(degrees)] + REAL(SiKi) :: WaveDirMax = 0.0_R4Ki !< Maximum wave direction. [(degrees)] + REAL(SiKi) :: WaveDir = 0.0_R4Ki !< Incident wave propagation heading direction [(degrees)] + LOGICAL :: WaveMultiDir = .false. !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] + REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: WaveDynP => NULL() !< Instantaneous dynamic pressure of incident waves , accounting for stretching, at each of the NWaveKin (grid) points where the incident wave kinematics will be computed [(N/m^2)] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveAcc => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin (grid) points where the incident wave kinematics will be computed [(m/s^2)] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveAccMCF => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKin (grid) points where the incident wave kinematics will be computed [(m/s^2)] @@ -116,50 +116,50 @@ MODULE SeaState_Types REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev2 => NULL() !< Second order wave elevation [-] REAL(SiKi) , DIMENSION(:), POINTER :: WaveElev0 => NULL() !< Instantaneous elevation time-series of incident waves at the platform reference point [(meters)] REAL(SiKi) , DIMENSION(:), POINTER :: WaveTime => NULL() !< Simulation times at which the instantaneous elevation of, velocity of, acceleration of, and loads associated with the incident waves are determined [(sec)] - REAL(SiKi) :: RhoXg !< = WtrDens*Gravity [-] - INTEGER(IntKi) :: NStepWave !< Total number of frequency components = total number of time steps in the incident wave [-] - INTEGER(IntKi) :: NStepWave2 !< NStepWave / 2 [-] - INTEGER(IntKi) :: WaveMod !< Incident wave kinematics model {0: none=still water, 1: plane progressive (regular), 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: white-noise spectrum, 4: user-defind spectrum from routine UserWaveSpctrm (irregular), 5: GH BLADED } [-] - INTEGER(IntKi) :: WaveStMod !< Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching} [-] - INTEGER(IntKi) :: WaveDirMod !< Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6] [-] - REAL(SiKi) :: WvLowCOff !< Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] - REAL(SiKi) :: WvHiCOff !< High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] - REAL(SiKi) :: WvLowCOffD !< Minimum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] - REAL(SiKi) :: WvHiCOffD !< Maximum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] - REAL(SiKi) :: WvLowCOffS !< Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] - REAL(SiKi) :: WvHiCOffS !< Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] - LOGICAL :: InvalidWithSSExctn !< Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2) [(-)] + REAL(SiKi) :: RhoXg = 0.0_R4Ki !< = WtrDens*Gravity [-] + INTEGER(IntKi) :: NStepWave = 0_IntKi !< Total number of frequency components = total number of time steps in the incident wave [-] + INTEGER(IntKi) :: NStepWave2 = 0_IntKi !< NStepWave / 2 [-] + INTEGER(IntKi) :: WaveMod = 0_IntKi !< Incident wave kinematics model {0: none=still water, 1: plane progressive (regular), 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: white-noise spectrum, 4: user-defind spectrum from routine UserWaveSpctrm (irregular), 5: GH BLADED } [-] + INTEGER(IntKi) :: WaveStMod = 0_IntKi !< Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching} [-] + INTEGER(IntKi) :: WaveDirMod = 0_IntKi !< Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6] [-] + REAL(SiKi) :: WvLowCOff = 0.0_R4Ki !< Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] + REAL(SiKi) :: WvHiCOff = 0.0_R4Ki !< High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] + REAL(SiKi) :: WvLowCOffD = 0.0_R4Ki !< Minimum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] + REAL(SiKi) :: WvHiCOffD = 0.0_R4Ki !< Maximum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] + REAL(SiKi) :: WvLowCOffS = 0.0_R4Ki !< Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] + REAL(SiKi) :: WvHiCOffS = 0.0_R4Ki !< Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] + LOGICAL :: InvalidWithSSExctn = .false. !< Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2) [(-)] TYPE(SeaSt_Interp_ParameterType) :: SeaSt_Interp_p !< parameter information from the SeaState Interpolation module [-] - REAL(SiKi) :: MCFD !< Diameter of MacCamy-Fuchs member [(meters)] + REAL(SiKi) :: MCFD = 0.0_R4Ki !< Diameter of MacCamy-Fuchs member [(meters)] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevSeries !< Wave elevation time-series at each of the points given by WaveElevXY. First dimension is the timestep. Second dimension is XY point number corresponding to second dimension of WaveElevXY. [(m)] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to wave field [-] END TYPE SeaSt_InitOutputType ! ======================= ! ========= SeaSt_ContinuousStateType ======= TYPE, PUBLIC :: SeaSt_ContinuousStateType - REAL(R8Ki) :: UnusedStates !< placeholder for states [-] + REAL(R8Ki) :: UnusedStates = 0.0_R8Ki !< placeholder for states [-] END TYPE SeaSt_ContinuousStateType ! ======================= ! ========= SeaSt_DiscreteStateType ======= TYPE, PUBLIC :: SeaSt_DiscreteStateType - REAL(R8Ki) :: UnusedStates !< placeholder for states [-] + REAL(R8Ki) :: UnusedStates = 0.0_R8Ki !< placeholder for states [-] END TYPE SeaSt_DiscreteStateType ! ======================= ! ========= SeaSt_ConstraintStateType ======= TYPE, PUBLIC :: SeaSt_ConstraintStateType - REAL(R8Ki) :: UnusedStates !< placeholder for states [-] + REAL(R8Ki) :: UnusedStates = 0.0_R8Ki !< placeholder for states [-] END TYPE SeaSt_ConstraintStateType ! ======================= ! ========= SeaSt_OtherStateType ======= TYPE, PUBLIC :: SeaSt_OtherStateType - REAL(R8Ki) :: UnusedStates !< placeholder for states [-] + REAL(R8Ki) :: UnusedStates = 0.0_R8Ki !< placeholder for states [-] END TYPE SeaSt_OtherStateType ! ======================= ! ========= SeaSt_MiscVarType ======= TYPE, PUBLIC :: SeaSt_MiscVarType - INTEGER(IntKi) :: Decimate !< The output decimation counter [-] - REAL(DbKi) :: LastOutTime !< Last time step which was written to the output file (sec) [-] - INTEGER(IntKi) :: LastIndWave !< The last index used in the wave kinematics arrays, used to optimize interpolation [-] + INTEGER(IntKi) :: Decimate = 0_IntKi !< The output decimation counter [-] + REAL(DbKi) :: LastOutTime = 0.0_R8Ki !< Last time step which was written to the output file (sec) [-] + INTEGER(IntKi) :: LastIndWave = 0_IntKi !< The last index used in the wave kinematics arrays, used to optimize interpolation [-] TYPE(SeaSt_Interp_MiscVarType) :: SeaSt_Interp_m !< misc var information from the SeaState Interpolation module [-] END TYPE SeaSt_MiscVarType ! ======================= @@ -167,15 +167,15 @@ MODULE SeaState_Types TYPE, PUBLIC :: SeaSt_ParameterType TYPE(Waves2_ParameterType) :: Waves2 !< Parameter data for the Waves2 module [-] REAL(SiKi) , DIMENSION(:), POINTER :: WaveTime => NULL() !< Array of time samples, (sec) [-] - REAL(DbKi) :: WaveDT !< Wave DT [sec] - INTEGER(IntKi) :: NGridPts !< Number of data points in the wave kinematics grid [-] - INTEGER(IntKi) , DIMENSION(1:3) :: NGrid !< Number of grid entries in x, y, and z [-] - REAL(ReKi) , DIMENSION(1:3) :: deltaGrid !< delta between grid points in x, y, and theta (for z) [m,m,rad] - REAL(ReKi) :: X_HalfWidth !< Half-width of the domain in the X direction [m] - REAL(ReKi) :: Y_HalfWidth !< Half-width of the domain in the Y direction [m] - REAL(ReKi) :: Z_Depth !< Depth of the domain the Z direction [m] - INTEGER(IntKi) :: NStepWave !< Number of user-requested data points in the wave kinematics arrays [-] - INTEGER(IntKi) :: NWaveElev !< Number of wave elevation outputs [-] + REAL(DbKi) :: WaveDT = 0.0_R8Ki !< Wave DT [sec] + INTEGER(IntKi) :: NGridPts = 0_IntKi !< Number of data points in the wave kinematics grid [-] + INTEGER(IntKi) , DIMENSION(1:3) :: NGrid = 0_IntKi !< Number of grid entries in x, y, and z [-] + REAL(ReKi) , DIMENSION(1:3) :: deltaGrid = 0.0_ReKi !< delta between grid points in x, y, and theta (for z) [m,m,rad] + REAL(ReKi) :: X_HalfWidth = 0.0_ReKi !< Half-width of the domain in the X direction [m] + REAL(ReKi) :: Y_HalfWidth = 0.0_ReKi !< Half-width of the domain in the Y direction [m] + REAL(ReKi) :: Z_Depth = 0.0_ReKi !< Depth of the domain the Z direction [m] + INTEGER(IntKi) :: NStepWave = 0_IntKi !< Number of user-requested data points in the wave kinematics arrays [-] + INTEGER(IntKi) :: NWaveElev = 0_IntKi !< Number of wave elevation outputs [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevxi !< xi-coordinates for points where the incident wave elevations can be output [(meters)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevyi !< yi-coordinates for points where the incident wave elevations can be output [(meters)] REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev1 => NULL() !< First order wave elevation [-] @@ -190,28 +190,28 @@ MODULE SeaState_Types REAL(SiKi) , DIMENSION(:), POINTER :: WaveDirArr => NULL() !< Wave direction array. Each frequency has a unique direction of WaveNDir > 1 [(degrees)] REAL(SiKi) , DIMENSION(:,:), POINTER :: WaveElevC0 => NULL() !< Discrete Fourier transform of the instantaneous elevation of incident waves at the platform reference point. First column is real part, second column is imaginary part [(meters)] REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: PWaveAccMCF0 => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKin (grid) points where the incident wave kinematics will be computed [(m/s^2)] - INTEGER(IntKi) :: NWaveKin !< Number of points where the incident wave kinematics can be output [-] + INTEGER(IntKi) :: NWaveKin = 0_IntKi !< Number of points where the incident wave kinematics can be output [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinxi !< xi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level [(meters)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinyi !< yi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level [(meters)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinzi !< zi-coordinates for points where the incident wave kinematics can be output; these are relative to the mean sea level [(meters)] - REAL(ReKi) :: WtrDpth !< Water depth [(m)] - REAL(DbKi) :: DT !< Time step in seconds for integration of continuous states (if a fixed-step integrator is used) and update of discrete states [-] - INTEGER(IntKi) :: WaveStMod !< Wave stretching model [-] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [(m)] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step in seconds for integration of continuous states (if a fixed-step integrator is used) and update of discrete states [-] + INTEGER(IntKi) :: WaveStMod = 0_IntKi !< Wave stretching model [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< [-] - INTEGER(IntKi) :: NumOuts !< Number of SeaState module-level outputs (not the total number including sub-modules [-] - INTEGER(IntKi) :: OutSwtch !< Output requested channels to: [1=SeaState.out 2=GlueCode.out 3=both files] [-] - CHARACTER(20) :: OutFmt !< Output format for numerical results [-] - CHARACTER(20) :: OutSFmt !< Output format for header strings [-] - CHARACTER(1) :: Delim !< Delimiter string for outputs, defaults to space [-] - INTEGER(IntKi) :: UnOutFile !< File unit for the SeaState outputs [-] - INTEGER(IntKi) :: OutDec !< Write every OutDec time steps [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of SeaState module-level outputs (not the total number including sub-modules [-] + INTEGER(IntKi) :: OutSwtch = 0_IntKi !< Output requested channels to: [1=SeaState.out 2=GlueCode.out 3=both files] [-] + CHARACTER(20) :: OutFmt = '' !< Output format for numerical results [-] + CHARACTER(20) :: OutSFmt = '' !< Output format for header strings [-] + CHARACTER(1) :: Delim = '' !< Delimiter string for outputs, defaults to space [-] + INTEGER(IntKi) :: UnOutFile = 0_IntKi !< File unit for the SeaState outputs [-] + INTEGER(IntKi) :: OutDec = 0_IntKi !< Write every OutDec time steps [-] TYPE(SeaSt_Interp_ParameterType) :: SeaSt_Interp_p !< parameter information from the SeaState Interpolation module [-] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Wave field [-] END TYPE SeaSt_ParameterType ! ======================= ! ========= SeaSt_InputType ======= TYPE, PUBLIC :: SeaSt_InputType - REAL(SiKi) :: DummyInput !< Remove this variable if you have inputs [-] + REAL(SiKi) :: DummyInput = 0.0_R4Ki !< Remove this variable if you have inputs [-] END TYPE SeaSt_InputType ! ======================= ! ========= SeaSt_OutputType ======= diff --git a/modules/seastate/src/Waves2_Types.f90 b/modules/seastate/src/Waves2_Types.f90 index d7c4748a14..2bdcf55998 100644 --- a/modules/seastate/src/Waves2_Types.f90 +++ b/modules/seastate/src/Waves2_Types.f90 @@ -35,29 +35,29 @@ MODULE Waves2_Types IMPLICIT NONE ! ========= Waves2_InitInputType ======= TYPE, PUBLIC :: Waves2_InitInputType - REAL(ReKi) :: Gravity !< Gravitational acceleration [(m/s^2)] - REAL(ReKi) :: WtrDens !< Water density [(kg/m^3)] - REAL(ReKi) :: WtrDpth !< Water depth [(meters)] - INTEGER(IntKi) :: NStepWave !< Total number of frequency components = total number of time steps in the incident wave [-] - INTEGER(IntKi) :: NStepWave2 !< NStepWave / 2 [-] - REAL(SiKi) :: WaveDOmega !< Frequency step for incident wave calculations [(rad/s)] - INTEGER(IntKi) :: WaveStMod !< Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching} [-] - LOGICAL :: WaveMultiDir !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] + REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravitational acceleration [(m/s^2)] + REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density [(kg/m^3)] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [(meters)] + INTEGER(IntKi) :: NStepWave = 0_IntKi !< Total number of frequency components = total number of time steps in the incident wave [-] + INTEGER(IntKi) :: NStepWave2 = 0_IntKi !< NStepWave / 2 [-] + REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] + INTEGER(IntKi) :: WaveStMod = 0_IntKi !< Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching} [-] + LOGICAL :: WaveMultiDir = .false. !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] REAL(SiKi) , DIMENSION(:), POINTER :: WaveDirArr => NULL() !< Wave direction array. Each frequency has a unique direction of WaveNDir > 1 [(degrees)] REAL(SiKi) , DIMENSION(:,:), POINTER :: WaveElevC0 => NULL() !< Discrete Fourier transform of the instantaneous elevation of incident waves at the platform reference point. First column is real part, second column is imaginary part [(meters)] REAL(SiKi) , DIMENSION(:), POINTER :: WaveTime => NULL() !< Simulation times at which the instantaneous second order loads associated with the incident waves are determined [sec] - INTEGER(IntKi) , DIMENSION(1:3) :: nGrid !< Grid dimensions [-] - INTEGER(IntKi) :: NWaveElevGrid !< Number of grid points where the incident wave elevations can be output [-] - INTEGER(IntKi) :: NWaveKinGrid !< Number of grid points where the incident wave kinematics will be computed [-] + INTEGER(IntKi) , DIMENSION(1:3) :: nGrid = 0_IntKi !< Grid dimensions [-] + INTEGER(IntKi) :: NWaveElevGrid = 0_IntKi !< Number of grid points where the incident wave elevations can be output [-] + INTEGER(IntKi) :: NWaveKinGrid = 0_IntKi !< Number of grid points where the incident wave kinematics will be computed [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinGridxi !< xi-coordinates for grid points where the incident wave kinematics will be computed; these are relative to the mean sea level [(meters)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinGridyi !< yi-coordinates for grid points where the incident wave kinematics will be computed; these are relative to the mean sea level [(meters)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinGridzi !< zi-coordinates for grid points where the incident wave kinematics will be computed; these are relative to the mean sea level [(meters)] - LOGICAL :: WvDiffQTFF !< Full difference QTF second order forces flag [(-)] - LOGICAL :: WvSumQTFF !< Full sum QTF second order forces flag [(-)] - REAL(SiKi) :: WvLowCOffD !< Minimum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] - REAL(SiKi) :: WvHiCOffD !< Maximum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] - REAL(SiKi) :: WvLowCOffS !< Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] - REAL(SiKi) :: WvHiCOffS !< Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] + LOGICAL :: WvDiffQTFF = .false. !< Full difference QTF second order forces flag [(-)] + LOGICAL :: WvSumQTFF = .false. !< Full sum QTF second order forces flag [(-)] + REAL(SiKi) :: WvLowCOffD = 0.0_R4Ki !< Minimum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] + REAL(SiKi) :: WvHiCOffD = 0.0_R4Ki !< Maximum frequency used in the difference methods [Ignored if all difference methods = 0] [(rad/s)] + REAL(SiKi) :: WvLowCOffS = 0.0_R4Ki !< Minimum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] + REAL(SiKi) :: WvHiCOffS = 0.0_R4Ki !< Maximum frequency used in the sum-QTF method [Ignored if SumQTF = 0] [(rad/s)] END TYPE Waves2_InitInputType ! ======================= ! ========= Waves2_InitOutputType ======= @@ -73,8 +73,8 @@ MODULE Waves2_Types ! ======================= ! ========= Waves2_ParameterType ======= TYPE, PUBLIC :: Waves2_ParameterType - LOGICAL :: WvDiffQTFF !< Full difference QTF second order forces flag [(-)] - LOGICAL :: WvSumQTFF !< Full sum QTF second order forces flag [(-)] + LOGICAL :: WvDiffQTFF = .false. !< Full difference QTF second order forces flag [(-)] + LOGICAL :: WvSumQTFF = .false. !< Full sum QTF second order forces flag [(-)] END TYPE Waves2_ParameterType ! ======================= CONTAINS diff --git a/modules/seastate/src/Waves_Types.f90 b/modules/seastate/src/Waves_Types.f90 index a4753d2f2f..57123bced3 100644 --- a/modules/seastate/src/Waves_Types.f90 +++ b/modules/seastate/src/Waves_Types.f90 @@ -35,52 +35,52 @@ MODULE Waves_Types IMPLICIT NONE ! ========= Waves_InitInputType ======= TYPE, PUBLIC :: Waves_InitInputType - CHARACTER(1024) :: InputFile !< Name of the input file [-] - CHARACTER(1024) :: DirRoot !< The name of the root file including the full path. This may be useful if you want this routine to write a permanent record of what it does to be stored with the simulation results: the results should be stored in a file whose name (including path) is generated by appending any suitable extension to DirRoot. [-] - CHARACTER(1024) :: WvKinFile !< The root name of user input wave kinematics files [-] - REAL(ReKi) :: Gravity !< Gravitational acceleration [(m/s^2)] - INTEGER(IntKi) , DIMENSION(1:3) :: nGrid !< Grid dimensions [-] - REAL(SiKi) :: WvLowCOff !< Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] - REAL(SiKi) :: WvHiCOff !< High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] - REAL(SiKi) :: WaveDir !< Mean incident wave propagation heading direction [(degrees)] - INTEGER(IntKi) :: WaveNDir !< Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module] [(-)] - LOGICAL :: WaveMultiDir !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] - INTEGER(IntKi) :: WaveDirMod !< Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6] [-] - REAL(SiKi) :: WaveDirSpread !< Spreading coefficient [WaveMod=2,3,4 and WaveDirMod=1] [-] - REAL(SiKi) :: WaveDirRange !< Range of wave directions (full range: WaveDir +/- WaveDirRange/2) [only used if WaveMod=6] [(degrees)] - REAL(DbKi) :: WaveDT !< Time step for incident wave calculations [(sec)] - REAL(SiKi) :: WaveHs !< Significant wave height of incident waves [(meters)] - INTEGER(IntKi) :: WaveMod !< Incident wave kinematics model {0: none=still water, 1: plane progressive (regular), 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: white-noise spectrum, 4: user-defind spectrum from routine UserWaveSpctrm (irregular), 5: GH BLADED } [-] - CHARACTER(80) :: WaveModChr !< String to temporarially hold the value of the wave kinematics input line [-] - LOGICAL :: WaveNDAmp !< Flag for normally-distributed amplitudes in incident waves spectrum [flag] [-] - REAL(SiKi) :: WavePhase !< Specified phase for regular waves [(radians)] - REAL(SiKi) :: WavePkShp !< Peak shape parameter of incident wave spectrum [1.0 for Pierson-Moskowitz] [-] - CHARACTER(80) :: WavePkShpChr !< String to temporarially hold value of peak shape parameter input line [-] - INTEGER(IntKi) , DIMENSION(1:2) :: WaveSeed !< Random seeds of incident waves [-2147483648 to 2147483647] [-] - INTEGER(IntKi) :: WaveStMod !< Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching} [-] - REAL(DbKi) :: WaveTMax !< Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT [(sec)] - REAL(SiKi) :: WaveTp !< Peak spectral period of incident waves [(sec)] - REAL(ReKi) :: WtrDens !< Water density [(kg/m^3)] - REAL(ReKi) :: WtrDpth !< Water depth [(meters)] - INTEGER(IntKi) :: NWaveElevGrid !< Number of grid points where the incident wave elevations are computed (the XY grid point locations) [-] - INTEGER(IntKi) :: NWaveKinGrid !< Number of grid points where the incident wave kinematics will be computed [-] + CHARACTER(1024) :: InputFile = '' !< Name of the input file [-] + CHARACTER(1024) :: DirRoot = '' !< The name of the root file including the full path. This may be useful if you want this routine to write a permanent record of what it does to be stored with the simulation results: the results should be stored in a file whose name (including path) is generated by appending any suitable extension to DirRoot. [-] + CHARACTER(1024) :: WvKinFile = '' !< The root name of user input wave kinematics files [-] + REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravitational acceleration [(m/s^2)] + INTEGER(IntKi) , DIMENSION(1:3) :: nGrid = 0_IntKi !< Grid dimensions [-] + REAL(SiKi) :: WvLowCOff = 0.0_R4Ki !< Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] + REAL(SiKi) :: WvHiCOff = 0.0_R4Ki !< High cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] + REAL(SiKi) :: WaveDir = 0.0_R4Ki !< Mean incident wave propagation heading direction [(degrees)] + INTEGER(IntKi) :: WaveNDir = 0_IntKi !< Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module] [(-)] + LOGICAL :: WaveMultiDir = .false. !< Indicates the waves are multidirectional -- set by HydroDyn_Input [-] + INTEGER(IntKi) :: WaveDirMod = 0_IntKi !< Directional wave spreading function {0: none, 1: COS2S} [only used if WaveMod=6] [-] + REAL(SiKi) :: WaveDirSpread = 0.0_R4Ki !< Spreading coefficient [WaveMod=2,3,4 and WaveDirMod=1] [-] + REAL(SiKi) :: WaveDirRange = 0.0_R4Ki !< Range of wave directions (full range: WaveDir +/- WaveDirRange/2) [only used if WaveMod=6] [(degrees)] + REAL(DbKi) :: WaveDT = 0.0_R8Ki !< Time step for incident wave calculations [(sec)] + REAL(SiKi) :: WaveHs = 0.0_R4Ki !< Significant wave height of incident waves [(meters)] + INTEGER(IntKi) :: WaveMod = 0_IntKi !< Incident wave kinematics model {0: none=still water, 1: plane progressive (regular), 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: white-noise spectrum, 4: user-defind spectrum from routine UserWaveSpctrm (irregular), 5: GH BLADED } [-] + CHARACTER(80) :: WaveModChr = '' !< String to temporarially hold the value of the wave kinematics input line [-] + LOGICAL :: WaveNDAmp = .false. !< Flag for normally-distributed amplitudes in incident waves spectrum [flag] [-] + REAL(SiKi) :: WavePhase = 0.0_R4Ki !< Specified phase for regular waves [(radians)] + REAL(SiKi) :: WavePkShp = 0.0_R4Ki !< Peak shape parameter of incident wave spectrum [1.0 for Pierson-Moskowitz] [-] + CHARACTER(80) :: WavePkShpChr = '' !< String to temporarially hold value of peak shape parameter input line [-] + INTEGER(IntKi) , DIMENSION(1:2) :: WaveSeed = 0_IntKi !< Random seeds of incident waves [-2147483648 to 2147483647] [-] + INTEGER(IntKi) :: WaveStMod = 0_IntKi !< Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching} [-] + REAL(DbKi) :: WaveTMax = 0.0_R8Ki !< Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT [(sec)] + REAL(SiKi) :: WaveTp = 0.0_R4Ki !< Peak spectral period of incident waves [(sec)] + REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density [(kg/m^3)] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [(meters)] + INTEGER(IntKi) :: NWaveElevGrid = 0_IntKi !< Number of grid points where the incident wave elevations are computed (the XY grid point locations) [-] + INTEGER(IntKi) :: NWaveKinGrid = 0_IntKi !< Number of grid points where the incident wave kinematics will be computed [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinGridxi !< xi-coordinates for grid points where the incident wave kinematics will be computed (grid points); these are relative to the mean sea level [(meters)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinGridyi !< yi-coordinates for grid points where the incident wave kinematics will be computed (grid points); these are relative to the mean sea level [(meters)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinGridzi !< zi-coordinates for grid points where the incident wave kinematics will be computed (grid points); these are relative to the mean sea level [(meters)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: CurrVxi !< xi-component of the current velocity at elevation i [(m/s)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: CurrVyi !< yi-component of the current velocity at elevation i [(m/s)] - REAL(SiKi) :: PCurrVxiPz0 !< xi-component of the partial derivative of the current velocity at elevation near mean sea level [(m/s)] - REAL(SiKi) :: PCurrVyiPz0 !< yi-component of the partial derivative of the current velocity at elevation near mean sea level [(m/s)] + REAL(SiKi) :: PCurrVxiPz0 = 0.0_R4Ki !< xi-component of the partial derivative of the current velocity at elevation near mean sea level [(m/s)] + REAL(SiKi) :: PCurrVyiPz0 = 0.0_R4Ki !< yi-component of the partial derivative of the current velocity at elevation near mean sea level [(m/s)] TYPE(NWTC_RandomNumber_ParameterType) :: RNG !< Parameters for the pseudo random number generator [-] - INTEGER(IntKi) :: ConstWaveMod !< Mode of the constrained wave [-] - REAL(SiKi) :: CrestHmax !< crest height or double the crest elevation [m] - REAL(SiKi) :: CrestTime !< time of the wave crest [sec] - REAL(SiKi) :: CrestXi !< xi-coordinate for the wave crest [m] - REAL(SiKi) :: CrestYi !< yi-coordinate for the wave crest [m] - REAL(SiKi) :: MCFD !< Diameter of members that will use the MacCamy-Fuchs diffraction model [-] - INTEGER(IntKi) :: WaveFieldMod !< Wave field handling (-) (switch) 0: use individual SeaState inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin [-] - REAL(ReKi) :: PtfmLocationX !< Supplied by Driver: X coordinate of platform location in the wave field [m] - REAL(ReKi) :: PtfmLocationY !< Supplied by Driver: Y coordinate of platform location in the wave field [m] + INTEGER(IntKi) :: ConstWaveMod = 0_IntKi !< Mode of the constrained wave [-] + REAL(SiKi) :: CrestHmax = 0.0_R4Ki !< crest height or double the crest elevation [m] + REAL(SiKi) :: CrestTime = 0.0_R4Ki !< time of the wave crest [sec] + REAL(SiKi) :: CrestXi = 0.0_R4Ki !< xi-coordinate for the wave crest [m] + REAL(SiKi) :: CrestYi = 0.0_R4Ki !< yi-coordinate for the wave crest [m] + REAL(SiKi) :: MCFD = 0.0_R4Ki !< Diameter of members that will use the MacCamy-Fuchs diffraction model [-] + INTEGER(IntKi) :: WaveFieldMod = 0_IntKi !< Wave field handling (-) (switch) 0: use individual SeaState inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin [-] + REAL(ReKi) :: PtfmLocationX = 0.0_ReKi !< Supplied by Driver: X coordinate of platform location in the wave field [m] + REAL(ReKi) :: PtfmLocationY = 0.0_ReKi !< Supplied by Driver: Y coordinate of platform location in the wave field [m] END TYPE Waves_InitInputType ! ======================= ! ========= Waves_InitOutputType ======= @@ -88,10 +88,10 @@ MODULE Waves_Types REAL(SiKi) , DIMENSION(:,:), POINTER :: WaveElevC0 => NULL() !< Discrete Fourier transform of the instantaneous elevation of incident waves at the platform reference point. First column is real part, second column is imaginary part [(meters)] REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveElevC !< Discrete Fourier transform of the instantaneous elevation of incident waves at all grid points. First column is real part, second column is imaginary part [(meters)] REAL(SiKi) , DIMENSION(:), POINTER :: WaveDirArr => NULL() !< Wave direction array. Each frequency has a unique direction of WaveNDir > 1 [(degrees)] - REAL(SiKi) :: WaveDirMin !< Minimum wave direction. [(degrees)] - REAL(SiKi) :: WaveDirMax !< Maximum wave direction. [(degrees)] - INTEGER(IntKi) :: WaveNDir !< Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module] [(-)] - REAL(SiKi) :: WaveDOmega !< Frequency step for incident wave calculations [(rad/s)] + REAL(SiKi) :: WaveDirMin = 0.0_R4Ki !< Minimum wave direction. [(degrees)] + REAL(SiKi) :: WaveDirMax = 0.0_R4Ki !< Maximum wave direction. [(degrees)] + INTEGER(IntKi) :: WaveNDir = 0_IntKi !< Number of wave directions [only used if WaveDirMod = 1] [Must be an odd number -- will be adjusted within the waves module] [(-)] + REAL(SiKi) :: WaveDOmega = 0.0_R4Ki !< Frequency step for incident wave calculations [(rad/s)] REAL(SiKi) , DIMENSION(:,:,:,:), POINTER :: WaveDynP => NULL() !< Instantaneous dynamic pressure of incident waves , accounting for stretching, at each of the NWaveKinGrid points where the incident wave kinematics will be computed [(N/m^2)] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveAcc => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKinGrid points where the incident wave kinematics will be computed [(m/s^2)] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: WaveAccMCF => NULL() !< Instantaneous acceleration of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, accounting for stretching, at each of the NWaveKinGrid points where the incident wave kinematics will be computed [(m/s^2)] @@ -103,10 +103,10 @@ MODULE Waves_Types REAL(SiKi) , DIMENSION(:,:,:), POINTER :: WaveElev => NULL() !< Instantaneous elevation time-series of incident waves at each of the XY grid points [(meters)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElev0 !< Instantaneous elevation time-series of incident waves at the platform reference point [(meters)] REAL(SiKi) , DIMENSION(:), POINTER :: WaveTime => NULL() !< Simulation times at which the instantaneous elevation of, velocity of, acceleration of, and loads associated with the incident waves are determined [(sec)] - REAL(DbKi) :: WaveTMax !< Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT [(sec)] - REAL(SiKi) :: RhoXg !< = WtrDens*Gravity [-] - INTEGER(IntKi) :: NStepWave !< Total number of frequency components = total number of time steps in the incident wave [-] - INTEGER(IntKi) :: NStepWave2 !< NStepWave / 2 [-] + REAL(DbKi) :: WaveTMax = 0.0_R8Ki !< Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT [(sec)] + REAL(SiKi) :: RhoXg = 0.0_R4Ki !< = WtrDens*Gravity [-] + INTEGER(IntKi) :: NStepWave = 0_IntKi !< Total number of frequency components = total number of time steps in the incident wave [-] + INTEGER(IntKi) :: NStepWave2 = 0_IntKi !< NStepWave / 2 [-] END TYPE Waves_InitOutputType ! ======================= CONTAINS diff --git a/modules/servodyn/src/ServoDyn_Types.f90 b/modules/servodyn/src/ServoDyn_Types.f90 index 5ecc46252a..eda511649c 100644 --- a/modules/servodyn/src/ServoDyn_Types.f90 +++ b/modules/servodyn/src/ServoDyn_Types.f90 @@ -36,53 +36,53 @@ MODULE ServoDyn_Types IMPLICIT NONE ! ========= SrvD_InitInputType ======= TYPE, PUBLIC :: SrvD_InitInputType - CHARACTER(1024) :: InputFile !< Name of the input file [-] + CHARACTER(1024) :: InputFile = '' !< Name of the input file [-] LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] - INTEGER(IntKi) :: NumBl !< Number of blades on the turbine [-] - CHARACTER(1024) :: RootName !< RootName for writing output files [-] + INTEGER(IntKi) :: NumBl = 0_IntKi !< Number of blades on the turbine [-] + CHARACTER(1024) :: RootName = '' !< RootName for writing output files [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlPitchInit !< Initial blade pitch [-] - REAL(ReKi) , DIMENSION(1:3) :: Gravity !< Gravitational acceleration vector [m/s^2] - REAL(ReKi) , DIMENSION(1:3) :: NacRefPos !< nacelle origin for setting up mesh [m] - REAL(R8Ki) , DIMENSION(1:3) :: NacTransDisp !< nacelle displacement from origin at init for setting up mesh [m] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: NacOrient !< nacelle orientation for setting up mesh [-] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: NacRefOrient !< nacelle reference orientation for setting up mesh [-] - REAL(ReKi) , DIMENSION(1:3) :: TwrBaseRefPos !< tower base origin for setting up mesh [m] - REAL(R8Ki) , DIMENSION(1:3) :: TwrBaseTransDisp !< tower base translation from origin at init for setting up mesh [m] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: TwrBaseOrient !< tower base orientation for setting up mesh [m] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: TwrBaseRefOrient !< tower reference orientation for setting up mesh [m] - REAL(ReKi) , DIMENSION(1:3) :: PtfmRefPos !< platform origin for setting up mesh [m] - REAL(R8Ki) , DIMENSION(1:3) :: PtfmTransDisp !< platform displacement from origin for setting up mesh [m] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: PtfmOrient !< platform orientation for setting up mesh [m] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: PtfmRefOrient !< platform reference orientation for setting up mesh [m] - REAL(DbKi) :: Tmax !< max time from glue code [s] - REAL(ReKi) :: AvgWindSpeed !< average wind speed for the simulation [m/s] - REAL(ReKi) :: AirDens !< air density [kg/m^3] - INTEGER(IntKi) :: NumSC2CtrlGlob !< number of global controller inputs [from supercontroller] [-] - INTEGER(IntKi) :: NumSC2Ctrl !< number of turbine specific controller inputs [from supercontroller] [-] - INTEGER(IntKi) :: NumCtrl2SC !< number of controller outputs [to supercontroller] [-] - INTEGER(IntKi) :: TrimCase !< Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} [used only if CalcSteady=True] [-] - REAL(ReKi) :: TrimGain !< Proportional gain for the rotational speed error (>0) [used only if TrimCase>0] [rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque] - REAL(ReKi) :: RotSpeedRef !< Reference rotor speed [rad/s] + REAL(ReKi) , DIMENSION(1:3) :: Gravity = 0.0_ReKi !< Gravitational acceleration vector [m/s^2] + REAL(ReKi) , DIMENSION(1:3) :: NacRefPos = 0.0_ReKi !< nacelle origin for setting up mesh [m] + REAL(R8Ki) , DIMENSION(1:3) :: NacTransDisp = 0.0_R8Ki !< nacelle displacement from origin at init for setting up mesh [m] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: NacOrient = 0.0_R8Ki !< nacelle orientation for setting up mesh [-] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: NacRefOrient = 0.0_R8Ki !< nacelle reference orientation for setting up mesh [-] + REAL(ReKi) , DIMENSION(1:3) :: TwrBaseRefPos = 0.0_ReKi !< tower base origin for setting up mesh [m] + REAL(R8Ki) , DIMENSION(1:3) :: TwrBaseTransDisp = 0.0_R8Ki !< tower base translation from origin at init for setting up mesh [m] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: TwrBaseOrient = 0.0_R8Ki !< tower base orientation for setting up mesh [m] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: TwrBaseRefOrient = 0.0_R8Ki !< tower reference orientation for setting up mesh [m] + REAL(ReKi) , DIMENSION(1:3) :: PtfmRefPos = 0.0_ReKi !< platform origin for setting up mesh [m] + REAL(R8Ki) , DIMENSION(1:3) :: PtfmTransDisp = 0.0_R8Ki !< platform displacement from origin for setting up mesh [m] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: PtfmOrient = 0.0_R8Ki !< platform orientation for setting up mesh [m] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: PtfmRefOrient = 0.0_R8Ki !< platform reference orientation for setting up mesh [m] + REAL(DbKi) :: Tmax = 0.0_R8Ki !< max time from glue code [s] + REAL(ReKi) :: AvgWindSpeed = 0.0_ReKi !< average wind speed for the simulation [m/s] + REAL(ReKi) :: AirDens = 0.0_ReKi !< air density [kg/m^3] + INTEGER(IntKi) :: NumSC2CtrlGlob = 0_IntKi !< number of global controller inputs [from supercontroller] [-] + INTEGER(IntKi) :: NumSC2Ctrl = 0_IntKi !< number of turbine specific controller inputs [from supercontroller] [-] + INTEGER(IntKi) :: NumCtrl2SC = 0_IntKi !< number of controller outputs [to supercontroller] [-] + INTEGER(IntKi) :: TrimCase = 0_IntKi !< Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} [used only if CalcSteady=True] [-] + REAL(ReKi) :: TrimGain = 0.0_ReKi !< Proportional gain for the rotational speed error (>0) [used only if TrimCase>0] [rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque] + REAL(ReKi) :: RotSpeedRef = 0.0_ReKi !< Reference rotor speed [rad/s] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BladeRootRefPos !< X-Y-Z reference position of each blade root (3 x NumBlades) [m] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: BladeRootTransDisp !< X-Y-Z translation from reference position at init of each blade root (3 x NumBlades) [m] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: BladeRootOrient !< DCM reference orientation of blade roots (3x3 x NumBlades) [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: BladeRootRefOrient !< DCM reference orientation of blade roots (3x3 x NumBlades) [-] LOGICAL :: UseInputFile = .TRUE. !< read input from input file [-] TYPE(FileInfoType) :: PassedPrimaryInputData !< Primary input file as FileInfoType (set by driver/glue code) [-] - INTEGER(IntKi) :: NumCableControl !< Number of cable control channels requested [-] + INTEGER(IntKi) :: NumCableControl = 0_IntKi !< Number of cable control channels requested [-] CHARACTER(64) , DIMENSION(:), ALLOCATABLE :: CableControlRequestor !< Array with text info about which module requested the cable control channel (size of NumCableControl). This is just for diagnostics. [-] - INTEGER(IntKi) :: InterpOrder !< Interpolation order from glue code -- required to set m%u_xStC sizes [-] + INTEGER(IntKi) :: InterpOrder = 0_IntKi !< Interpolation order from glue code -- required to set m%u_xStC sizes [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: fromSCGlob !< Initial global inputs to the controller [from the supercontroller] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: fromSC !< Initial turbine specific inputs to the controller [from the supercontroller] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: LidSpeed !< Number of Lidar measurement distances [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: MsrPositionsX !< Lidar X direction measurement points [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: MsrPositionsY !< Lidar Y direction measurement points [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: MsrPositionsZ !< Lidar Z direction measurement points [m] - INTEGER(IntKi) :: SensorType !< Lidar sensor type [-] - INTEGER(IntKi) :: NumBeam !< Number of beams [-] - INTEGER(IntKi) :: NumPulseGate !< Number of pulse gates [-] - REAL(ReKi) :: PulseSpacing !< Distance between range gates [-] - REAL(ReKi) :: URefLid !< Reference average wind speed for the lidar [m/s] + INTEGER(IntKi) :: SensorType = 0_IntKi !< Lidar sensor type [-] + INTEGER(IntKi) :: NumBeam = 0_IntKi !< Number of beams [-] + INTEGER(IntKi) :: NumPulseGate = 0_IntKi !< Number of pulse gates [-] + REAL(ReKi) :: PulseSpacing = 0.0_ReKi !< Distance between range gates [-] + REAL(ReKi) :: URefLid = 0.0_ReKi !< Reference average wind speed for the lidar [m/s] END TYPE SrvD_InitInputType ! ======================= ! ========= SrvD_InitOutputType ======= @@ -90,8 +90,8 @@ MODULE ServoDyn_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Names of the output-to-file channels [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] - INTEGER(IntKi) :: CouplingScheme !< Switch that indicates if a particular coupling scheme is required [-] - LOGICAL :: UseHSSBrake !< flag to determine if high-speed shaft brake is potentially used (true=yes) [-] + INTEGER(IntKi) :: CouplingScheme = 0_IntKi !< Switch that indicates if a particular coupling scheme is required [-] + LOGICAL :: UseHSSBrake = .false. !< flag to determine if high-speed shaft brake is potentially used (true=yes) [-] CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_y !< Names of the outputs used in linearization [-] CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_x !< Names of the states used in linearization [-] CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_u !< Names of the inputs used in linearization [-] @@ -104,178 +104,178 @@ MODULE ServoDyn_Types ! ======================= ! ========= SrvD_InputFile ======= TYPE, PUBLIC :: SrvD_InputFile - REAL(DbKi) :: DT !< Communication interval for controllers [s] - LOGICAL :: Echo !< Echo the input file out [-] - INTEGER(IntKi) :: PCMode !< Pitch control mode [-] - REAL(DbKi) :: TPCOn !< Time to enable active pitch control [unused when PCMode=0] [s] - REAL(DbKi) , DIMENSION(1:3) :: TPitManS !< Time to start override pitch maneuver for blade (K) and end standard pitch control [s] - REAL(ReKi) , DIMENSION(1:3) :: PitManRat !< Pitch rates at which override pitch maneuvers head toward final pitch angles [rad/s] - REAL(ReKi) , DIMENSION(1:3) :: BlPitchF !< Blade (K) final pitch for pitch maneuvers [radians] - INTEGER(IntKi) :: VSContrl !< Variable-speed control mode [-] - INTEGER(IntKi) :: GenModel !< Generator model [used only when VSContrl=0] [-] - REAL(ReKi) :: GenEff !< Generator efficiency [ignored by the Thevenin and user-defined generator models] [-] - LOGICAL :: GenTiStr !< Method to start the generator {T: timed using TimGenOn, F: generator speed using SpdGenOn} [-] - LOGICAL :: GenTiStp !< Method to stop the generator {T: timed using TimGenOf, F: when generator power = 0} [-] - REAL(ReKi) :: SpdGenOn !< Generator speed to turn on the generator for a startup (HSS speed) [used only when GenTiStr=False] [rad/s] - REAL(DbKi) :: TimGenOn !< Time to turn on the generator for a startup [used only when GenTiStr=True] [s] - REAL(DbKi) :: TimGenOf !< Time to turn off the generator [used only when GenTiStp=True] [s] - REAL(ReKi) :: VS_RtGnSp !< Rated generator speed for simple variable-speed generator control (HSS side) [used only when VSContrl=1] [rad/s] - REAL(ReKi) :: VS_RtTq !< Rated generator torque/constant generator torque in Region 3 for simple variable-speed generator control (HSS side) [used only when VSContrl=1] [N-m] - REAL(ReKi) :: VS_Rgn2K !< Generator torque constant in Region 2 for simple variable-speed generator control (HSS side) [used only when VSContrl=1] [N-m/(rad/s)^2] - REAL(ReKi) :: VS_SlPc !< Rated generator slip percentage in Region 2 1/2 for simple variable-speed generator control [used only when VSContrl=1] [-] - REAL(ReKi) :: SIG_SlPc !< Rated generator slip percentage [used only when VSContrl=0 and GenModel=1] [-] - REAL(ReKi) :: SIG_SySp !< Synchronous (zero-torque) generator speed [used only when VSContrl=0 and GenModel=1] [rad/s] - REAL(ReKi) :: SIG_RtTq !< Rated torque [used only when VSContrl=0 and GenModel=1] [N-m] - REAL(ReKi) :: SIG_PORt !< Pull-out ratio (Tpullout/Trated) [used only when VSContrl=0 and GenModel=1] [-] - REAL(ReKi) :: TEC_Freq !< Line frequency [50 or 60] [used only when VSContrl=0 and GenModel=2] [Hz] - INTEGER(IntKi) :: TEC_NPol !< Number of poles [even integer > 0] [used only when VSContrl=0 and GenModel=2] [-] - REAL(ReKi) :: TEC_SRes !< Stator resistance [used only when VSContrl=0 and GenModel=2] [ohms] - REAL(ReKi) :: TEC_RRes !< Rotor resistance [used only when VSContrl=0 and GenModel=2] [ohms] - REAL(ReKi) :: TEC_VLL !< Line-to-line RMS voltage [used only when VSContrl=0 and GenModel=2] [volts] - REAL(ReKi) :: TEC_SLR !< Stator leakage reactance [used only when VSContrl=0 and GenModel=2] [ohms] - REAL(ReKi) :: TEC_RLR !< Rotor leakage reactance [used only when VSContrl=0 and GenModel=2] [ohms] - REAL(ReKi) :: TEC_MR !< Magnetizing reactance [used only when VSContrl=0 and GenModel=2] [ohms] - INTEGER(IntKi) :: HSSBrMode !< HSS brake model [-] - REAL(DbKi) :: THSSBrDp !< Time to initiate deployment of the HSS brake [s] - REAL(DbKi) :: HSSBrDT !< Time for HSS-brake to reach full deployment once initiated [used only when HSSBrMode=1] [s] - REAL(ReKi) :: HSSBrTqF !< Fully deployed HSS-brake torque [N-m] - INTEGER(IntKi) :: YCMode !< Yaw control mode [-] - REAL(DbKi) :: TYCOn !< Time to enable active yaw control [unused when YCMode=0] [s] - REAL(ReKi) :: YawNeut !< Neutral yaw position--yaw spring force is zero at this yaw [radians] - REAL(ReKi) :: YawSpr !< Nacelle-yaw spring constant [N-m/rad] - REAL(ReKi) :: YawDamp !< Nacelle-yaw constant [N-m/(rad/s)] - REAL(DbKi) :: TYawManS !< Time to start override yaw maneuver and end standard yaw control [s] - REAL(ReKi) :: YawManRat !< Yaw maneuver rate (in absolute value) [rad/s] - REAL(ReKi) :: NacYawF !< Final yaw angle for override yaw maneuvers [radians] - LOGICAL :: SumPrint !< Print summary data to .sum [-] - INTEGER(IntKi) :: OutFile !< Switch to determine where output will be placed: (1: in module output file only; 2: in glue code output file only; 3: both) [-] - LOGICAL :: TabDelim !< Use tab delimiters in text tabular output file? [-] - CHARACTER(20) :: OutFmt !< Format used for text tabular output (except time) [-] - REAL(DbKi) :: Tstart !< Time to start module's tabular output [s] - INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] + REAL(DbKi) :: DT = 0.0_R8Ki !< Communication interval for controllers [s] + LOGICAL :: Echo = .false. !< Echo the input file out [-] + INTEGER(IntKi) :: PCMode = 0_IntKi !< Pitch control mode [-] + REAL(DbKi) :: TPCOn = 0.0_R8Ki !< Time to enable active pitch control [unused when PCMode=0] [s] + REAL(DbKi) , DIMENSION(1:3) :: TPitManS = 0.0_R8Ki !< Time to start override pitch maneuver for blade (K) and end standard pitch control [s] + REAL(ReKi) , DIMENSION(1:3) :: PitManRat = 0.0_ReKi !< Pitch rates at which override pitch maneuvers head toward final pitch angles [rad/s] + REAL(ReKi) , DIMENSION(1:3) :: BlPitchF = 0.0_ReKi !< Blade (K) final pitch for pitch maneuvers [radians] + INTEGER(IntKi) :: VSContrl = 0_IntKi !< Variable-speed control mode [-] + INTEGER(IntKi) :: GenModel = 0_IntKi !< Generator model [used only when VSContrl=0] [-] + REAL(ReKi) :: GenEff = 0.0_ReKi !< Generator efficiency [ignored by the Thevenin and user-defined generator models] [-] + LOGICAL :: GenTiStr = .false. !< Method to start the generator {T: timed using TimGenOn, F: generator speed using SpdGenOn} [-] + LOGICAL :: GenTiStp = .false. !< Method to stop the generator {T: timed using TimGenOf, F: when generator power = 0} [-] + REAL(ReKi) :: SpdGenOn = 0.0_ReKi !< Generator speed to turn on the generator for a startup (HSS speed) [used only when GenTiStr=False] [rad/s] + REAL(DbKi) :: TimGenOn = 0.0_R8Ki !< Time to turn on the generator for a startup [used only when GenTiStr=True] [s] + REAL(DbKi) :: TimGenOf = 0.0_R8Ki !< Time to turn off the generator [used only when GenTiStp=True] [s] + REAL(ReKi) :: VS_RtGnSp = 0.0_ReKi !< Rated generator speed for simple variable-speed generator control (HSS side) [used only when VSContrl=1] [rad/s] + REAL(ReKi) :: VS_RtTq = 0.0_ReKi !< Rated generator torque/constant generator torque in Region 3 for simple variable-speed generator control (HSS side) [used only when VSContrl=1] [N-m] + REAL(ReKi) :: VS_Rgn2K = 0.0_ReKi !< Generator torque constant in Region 2 for simple variable-speed generator control (HSS side) [used only when VSContrl=1] [N-m/(rad/s)^2] + REAL(ReKi) :: VS_SlPc = 0.0_ReKi !< Rated generator slip percentage in Region 2 1/2 for simple variable-speed generator control [used only when VSContrl=1] [-] + REAL(ReKi) :: SIG_SlPc = 0.0_ReKi !< Rated generator slip percentage [used only when VSContrl=0 and GenModel=1] [-] + REAL(ReKi) :: SIG_SySp = 0.0_ReKi !< Synchronous (zero-torque) generator speed [used only when VSContrl=0 and GenModel=1] [rad/s] + REAL(ReKi) :: SIG_RtTq = 0.0_ReKi !< Rated torque [used only when VSContrl=0 and GenModel=1] [N-m] + REAL(ReKi) :: SIG_PORt = 0.0_ReKi !< Pull-out ratio (Tpullout/Trated) [used only when VSContrl=0 and GenModel=1] [-] + REAL(ReKi) :: TEC_Freq = 0.0_ReKi !< Line frequency [50 or 60] [used only when VSContrl=0 and GenModel=2] [Hz] + INTEGER(IntKi) :: TEC_NPol = 0_IntKi !< Number of poles [even integer > 0] [used only when VSContrl=0 and GenModel=2] [-] + REAL(ReKi) :: TEC_SRes = 0.0_ReKi !< Stator resistance [used only when VSContrl=0 and GenModel=2] [ohms] + REAL(ReKi) :: TEC_RRes = 0.0_ReKi !< Rotor resistance [used only when VSContrl=0 and GenModel=2] [ohms] + REAL(ReKi) :: TEC_VLL = 0.0_ReKi !< Line-to-line RMS voltage [used only when VSContrl=0 and GenModel=2] [volts] + REAL(ReKi) :: TEC_SLR = 0.0_ReKi !< Stator leakage reactance [used only when VSContrl=0 and GenModel=2] [ohms] + REAL(ReKi) :: TEC_RLR = 0.0_ReKi !< Rotor leakage reactance [used only when VSContrl=0 and GenModel=2] [ohms] + REAL(ReKi) :: TEC_MR = 0.0_ReKi !< Magnetizing reactance [used only when VSContrl=0 and GenModel=2] [ohms] + INTEGER(IntKi) :: HSSBrMode = 0_IntKi !< HSS brake model [-] + REAL(DbKi) :: THSSBrDp = 0.0_R8Ki !< Time to initiate deployment of the HSS brake [s] + REAL(DbKi) :: HSSBrDT = 0.0_R8Ki !< Time for HSS-brake to reach full deployment once initiated [used only when HSSBrMode=1] [s] + REAL(ReKi) :: HSSBrTqF = 0.0_ReKi !< Fully deployed HSS-brake torque [N-m] + INTEGER(IntKi) :: YCMode = 0_IntKi !< Yaw control mode [-] + REAL(DbKi) :: TYCOn = 0.0_R8Ki !< Time to enable active yaw control [unused when YCMode=0] [s] + REAL(ReKi) :: YawNeut = 0.0_ReKi !< Neutral yaw position--yaw spring force is zero at this yaw [radians] + REAL(ReKi) :: YawSpr = 0.0_ReKi !< Nacelle-yaw spring constant [N-m/rad] + REAL(ReKi) :: YawDamp = 0.0_ReKi !< Nacelle-yaw constant [N-m/(rad/s)] + REAL(DbKi) :: TYawManS = 0.0_R8Ki !< Time to start override yaw maneuver and end standard yaw control [s] + REAL(ReKi) :: YawManRat = 0.0_ReKi !< Yaw maneuver rate (in absolute value) [rad/s] + REAL(ReKi) :: NacYawF = 0.0_ReKi !< Final yaw angle for override yaw maneuvers [radians] + LOGICAL :: SumPrint = .false. !< Print summary data to .sum [-] + INTEGER(IntKi) :: OutFile = 0_IntKi !< Switch to determine where output will be placed: (1: in module output file only; 2: in glue code output file only; 3: both) [-] + LOGICAL :: TabDelim = .false. !< Use tab delimiters in text tabular output file? [-] + CHARACTER(20) :: OutFmt = '' !< Format used for text tabular output (except time) [-] + REAL(DbKi) :: Tstart = 0.0_R8Ki !< Time to start module's tabular output [s] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< List of user-requested output channels [-] - CHARACTER(1024) :: DLL_FileName !< Name of the DLL file including the full path [-] - CHARACTER(1024) :: DLL_ProcName !< Name of the procedure in the DLL that will be called [-] - CHARACTER(1024) :: DLL_InFile !< Name of input file used in DLL [-] - REAL(DbKi) :: DLL_DT !< interval for calling DLL (must be integer multiple number of DT steps) [s] - LOGICAL :: DLL_Ramp !< whether the DLL pitch should be a ramp (true) or step change (false) when DLL_DT <> DT. If true, introduces a time delay. [-] - REAL(ReKi) :: BPCutoff !< The cutoff frequency for the blade pitch low-pass filter. Large values => no filter. [Hz] - REAL(ReKi) :: NacYaw_North !< Reference yaw angle of the nacelle when the upwind end points due North [used only with DLL Interface] [radians] - INTEGER(IntKi) :: Ptch_Cntrl !< Record 28: Use individual pitch control {0: collective pitch; 1: individual pitch control} [used only with DLL Interface] [-] - REAL(ReKi) :: Ptch_SetPnt !< Record 5: Below-rated pitch angle set-point [used only with DLL Interface] [radians] - REAL(ReKi) :: Ptch_Min !< Record 6: Minimum pitch angle [used only with DLL Interface] [radians] - REAL(ReKi) :: Ptch_Max !< Record 7: Maximum pitch angle [used only with DLL Interface] [radians] - REAL(ReKi) :: PtchRate_Min !< Record 8: Minimum pitch rate (most negative value allowed) [used only with DLL Interface] [rad/s] - REAL(ReKi) :: PtchRate_Max !< Record 9: Maximum pitch rate [used only with DLL Interface] [rad/s] - REAL(ReKi) :: Gain_OM !< Record 16: Optimal mode gain [used only with DLL Interface] [Nm/(rad/s)^2] - REAL(ReKi) :: GenSpd_MinOM !< Record 17: Minimum generator speed [used only with DLL Interface] [rad/s] - REAL(ReKi) :: GenSpd_MaxOM !< Record 18: Optimal mode maximum speed [used only with DLL Interface] [rad/s] - REAL(ReKi) :: GenSpd_Dem !< Record 19: Demanded generator speed above rated [used only with DLL Interface] [rad/s] - REAL(ReKi) :: GenTrq_Dem !< Record 22: Demanded generator torque above rated [used only with DLL Interface] [Nm] - REAL(ReKi) :: GenPwr_Dem !< Record 13: Demanded power [used only with DLL Interface] [W] - INTEGER(IntKi) :: DLL_NumTrq !< Record 26: No. of points in torque-speed look-up table {0 = none and use the optimal mode PARAMETERs instead, nonzero = ignore the optimal mode PARAMETERs by setting Gain_OM (Record 16) to 0.0} [used only with DLL Interface] [-] + CHARACTER(1024) :: DLL_FileName = '' !< Name of the DLL file including the full path [-] + CHARACTER(1024) :: DLL_ProcName = '' !< Name of the procedure in the DLL that will be called [-] + CHARACTER(1024) :: DLL_InFile = '' !< Name of input file used in DLL [-] + REAL(DbKi) :: DLL_DT = 0.0_R8Ki !< interval for calling DLL (must be integer multiple number of DT steps) [s] + LOGICAL :: DLL_Ramp = .false. !< whether the DLL pitch should be a ramp (true) or step change (false) when DLL_DT <> DT. If true, introduces a time delay. [-] + REAL(ReKi) :: BPCutoff = 0.0_ReKi !< The cutoff frequency for the blade pitch low-pass filter. Large values => no filter. [Hz] + REAL(ReKi) :: NacYaw_North = 0.0_ReKi !< Reference yaw angle of the nacelle when the upwind end points due North [used only with DLL Interface] [radians] + INTEGER(IntKi) :: Ptch_Cntrl = 0_IntKi !< Record 28: Use individual pitch control {0: collective pitch; 1: individual pitch control} [used only with DLL Interface] [-] + REAL(ReKi) :: Ptch_SetPnt = 0.0_ReKi !< Record 5: Below-rated pitch angle set-point [used only with DLL Interface] [radians] + REAL(ReKi) :: Ptch_Min = 0.0_ReKi !< Record 6: Minimum pitch angle [used only with DLL Interface] [radians] + REAL(ReKi) :: Ptch_Max = 0.0_ReKi !< Record 7: Maximum pitch angle [used only with DLL Interface] [radians] + REAL(ReKi) :: PtchRate_Min = 0.0_ReKi !< Record 8: Minimum pitch rate (most negative value allowed) [used only with DLL Interface] [rad/s] + REAL(ReKi) :: PtchRate_Max = 0.0_ReKi !< Record 9: Maximum pitch rate [used only with DLL Interface] [rad/s] + REAL(ReKi) :: Gain_OM = 0.0_ReKi !< Record 16: Optimal mode gain [used only with DLL Interface] [Nm/(rad/s)^2] + REAL(ReKi) :: GenSpd_MinOM = 0.0_ReKi !< Record 17: Minimum generator speed [used only with DLL Interface] [rad/s] + REAL(ReKi) :: GenSpd_MaxOM = 0.0_ReKi !< Record 18: Optimal mode maximum speed [used only with DLL Interface] [rad/s] + REAL(ReKi) :: GenSpd_Dem = 0.0_ReKi !< Record 19: Demanded generator speed above rated [used only with DLL Interface] [rad/s] + REAL(ReKi) :: GenTrq_Dem = 0.0_ReKi !< Record 22: Demanded generator torque above rated [used only with DLL Interface] [Nm] + REAL(ReKi) :: GenPwr_Dem = 0.0_ReKi !< Record 13: Demanded power [used only with DLL Interface] [W] + INTEGER(IntKi) :: DLL_NumTrq = 0_IntKi !< Record 26: No. of points in torque-speed look-up table {0 = none and use the optimal mode PARAMETERs instead, nonzero = ignore the optimal mode PARAMETERs by setting Gain_OM (Record 16) to 0.0} [used only with DLL Interface] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: GenSpd_TLU !< Records R:2:R+2*DLL_NumTrq-2: Generator speed values in look-up table [used only with DLL Interface] [rad/s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: GenTrq_TLU !< Records R+1:2:R+2*DLL_NumTrq-1: Generator torque values in look-up table [used only with DLL Interface] [Nm] - LOGICAL :: UseLegacyInterface !< Flag that determines if the legacy Bladed interface is (legacy=DISCON with avrSWAP instead of CONTROLLER) [-] - INTEGER(IntKi) :: NumBStC !< Number of blade structural controllers (integer) [-] + LOGICAL :: UseLegacyInterface = .false. !< Flag that determines if the legacy Bladed interface is (legacy=DISCON with avrSWAP instead of CONTROLLER) [-] + INTEGER(IntKi) :: NumBStC = 0_IntKi !< Number of blade structural controllers (integer) [-] CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: BStCfiles !< Name of the files for blade structural controllers (quoted strings) [unused when NumBStC==0] [-] - INTEGER(IntKi) :: NumNStC !< Number of nacelle structural controllers (integer) [-] + INTEGER(IntKi) :: NumNStC = 0_IntKi !< Number of nacelle structural controllers (integer) [-] CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: NStCfiles !< Name of the files for nacelle structural controllers (quoted strings) [unused when NumNStC==0] [-] - INTEGER(IntKi) :: NumTStC !< Number of tower structural controllers (integer) [-] + INTEGER(IntKi) :: NumTStC = 0_IntKi !< Number of tower structural controllers (integer) [-] CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: TStCfiles !< Name of the files for tower structural controllers (quoted strings) [unused when NumTStC==0] [-] - INTEGER(IntKi) :: NumSStC !< Number of substructure structural controllers (integer) [-] + INTEGER(IntKi) :: NumSStC = 0_IntKi !< Number of substructure structural controllers (integer) [-] CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: SStCfiles !< Name of the files for subtructure structural controllers (quoted strings) [unused when NumSStC==0] [-] - INTEGER(IntKi) :: AfCmode !< Airfoil control mode {0: none, 1: sine wave cycle, 4: user-defined from Simulink/Labview, 5: user-defined from Bladed-style DLL} [-] - REAL(ReKi) :: AfC_Mean !< Mean level for cosine cycling or steady value [used only with AfCmode==1] [-] - REAL(ReKi) :: AfC_Amp !< Amplitude for for cosine cycling of flap signal (-) [used only with AfCmode==1] [-] - REAL(ReKi) :: AfC_Phase !< Phase relative to the blade azimuth (0 is vertical) for for cosine cycling of flap signal (deg) [used only with AfCmode==1] [deg] - INTEGER(IntKi) :: CCmode !< Cable control control mode {0: none, 4: user-defined from Simulink/Labview, 5: user-defined from Bladed-style DLL} [-] - LOGICAL :: EXavrSWAP !< Use extendend AVR swap [-] + INTEGER(IntKi) :: AfCmode = 0_IntKi !< Airfoil control mode {0: none, 1: sine wave cycle, 4: user-defined from Simulink/Labview, 5: user-defined from Bladed-style DLL} [-] + REAL(ReKi) :: AfC_Mean = 0.0_ReKi !< Mean level for cosine cycling or steady value [used only with AfCmode==1] [-] + REAL(ReKi) :: AfC_Amp = 0.0_ReKi !< Amplitude for for cosine cycling of flap signal (-) [used only with AfCmode==1] [-] + REAL(ReKi) :: AfC_Phase = 0.0_ReKi !< Phase relative to the blade azimuth (0 is vertical) for for cosine cycling of flap signal (deg) [used only with AfCmode==1] [deg] + INTEGER(IntKi) :: CCmode = 0_IntKi !< Cable control control mode {0: none, 4: user-defined from Simulink/Labview, 5: user-defined from Bladed-style DLL} [-] + LOGICAL :: EXavrSWAP = .false. !< Use extendend AVR swap [-] END TYPE SrvD_InputFile ! ======================= ! ========= BladedDLLType ======= TYPE, PUBLIC :: BladedDLLType REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: avrSWAP !< The swap array: used to pass data to and from the DLL controller [see Bladed DLL documentation] - REAL(ReKi) :: HSSBrTrqDemand !< Demanded braking torque - from Bladed DLL [-] - REAL(ReKi) :: YawRateCom !< Nacelle yaw rate demanded from Bladed DLL [rad/s] - REAL(ReKi) :: GenTrq !< Electrical generator torque from Bladed DLL [N-m] - INTEGER(IntKi) :: GenState !< Generator state from Bladed DLL [-] - REAL(ReKi) , DIMENSION(1:3) :: BlPitchCom !< Commanded blade pitch angles [radians] - REAL(ReKi) , DIMENSION(1:3) :: PrevBlPitch !< Previously commanded blade pitch angles [radians] - REAL(ReKi) , DIMENSION(1:3) :: BlAirfoilCom !< Commanded Airfoil UserProp for blade. Passed to AD15 for airfoil interpolation (must be same units as given in AD15 airfoil tables) [-] - REAL(ReKi) , DIMENSION(1:3) :: PrevBlAirfoilCom !< Previously commanded Airfoil UserProp for blade. Passed to AD15 for airfoil interpolation (must be same units as given in AD15 airfoil tables) [-] - REAL(ReKi) :: ElecPwr_prev !< Electrical power (from previous step), sent to Bladed DLL [W] - REAL(ReKi) :: GenTrq_prev !< Electrical generator torque (from previous step), sent to Bladed DLL [N-m] + REAL(ReKi) :: HSSBrTrqDemand = 0.0_ReKi !< Demanded braking torque - from Bladed DLL [-] + REAL(ReKi) :: YawRateCom = 0.0_ReKi !< Nacelle yaw rate demanded from Bladed DLL [rad/s] + REAL(ReKi) :: GenTrq = 0.0_ReKi !< Electrical generator torque from Bladed DLL [N-m] + INTEGER(IntKi) :: GenState = 0_IntKi !< Generator state from Bladed DLL [-] + REAL(ReKi) , DIMENSION(1:3) :: BlPitchCom = 0.0_ReKi !< Commanded blade pitch angles [radians] + REAL(ReKi) , DIMENSION(1:3) :: PrevBlPitch = 0.0_ReKi !< Previously commanded blade pitch angles [radians] + REAL(ReKi) , DIMENSION(1:3) :: BlAirfoilCom = 0.0_ReKi !< Commanded Airfoil UserProp for blade. Passed to AD15 for airfoil interpolation (must be same units as given in AD15 airfoil tables) [-] + REAL(ReKi) , DIMENSION(1:3) :: PrevBlAirfoilCom = 0.0_ReKi !< Previously commanded Airfoil UserProp for blade. Passed to AD15 for airfoil interpolation (must be same units as given in AD15 airfoil tables) [-] + REAL(ReKi) :: ElecPwr_prev = 0.0_ReKi !< Electrical power (from previous step), sent to Bladed DLL [W] + REAL(ReKi) :: GenTrq_prev = 0.0_ReKi !< Electrical generator torque (from previous step), sent to Bladed DLL [N-m] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: toSC !< controller output to supercontroller [-] - LOGICAL :: initialized !< flag that determines if DLL has been called (for difference between CalcOutput and UpdateStates) [-] - INTEGER(IntKi) :: NumLogChannels !< number of log channels from controller [-] + LOGICAL :: initialized = .false. !< flag that determines if DLL has been called (for difference between CalcOutput and UpdateStates) [-] + INTEGER(IntKi) :: NumLogChannels = 0_IntKi !< number of log channels from controller [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: LogChannels_OutParam !< Names and units (and other characteristics) of logging outputs from DLL [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: LogChannels !< logging outputs from controller [-] - INTEGER(IntKi) :: ErrStat !< error message from external controller API [-] - CHARACTER(ErrMsgLen) :: ErrMsg !< error message from external controller API [-] - REAL(R8Ki) :: CurrentTime !< Current Simulation Time [s] - INTEGER(IntKi) :: SimStatus !< simulation status (see avrSWAP(1): Status flag set as follows: 0 if this is the first call, 1 for all subsequent time steps, -1 if this is the final call at the end of the simulation) [-] - INTEGER(IntKi) :: ShaftBrakeStatusBinaryFlag !< binary flag indicating (on/off) status for shaft brake 1, shaft brake 2, generator brake, shaft brake 3, or brake torque set separately (0, 1, or 16 allowed in FAST) [-] - LOGICAL :: HSSBrDeployed !< Whether the HSS brake has been deployed [-] - REAL(R8Ki) :: TimeHSSBrFullyDeployed !< Time at which the controller high-speed shaft is fully deployed [s] - REAL(R8Ki) :: TimeHSSBrDeployed !< Time at which the controller high-speed shaft is first deployed [s] - LOGICAL :: OverrideYawRateWithTorque !< acts similiar to Yaw_Cntrl [-] - REAL(ReKi) :: YawTorqueDemand !< Demanded yaw actuator torque (override of yaw rate control) [Nm] + INTEGER(IntKi) :: ErrStat = 0_IntKi !< error message from external controller API [-] + CHARACTER(ErrMsgLen) :: ErrMsg = '' !< error message from external controller API [-] + REAL(R8Ki) :: CurrentTime = 0.0_R8Ki !< Current Simulation Time [s] + INTEGER(IntKi) :: SimStatus = 0_IntKi !< simulation status (see avrSWAP(1): Status flag set as follows: 0 if this is the first call, 1 for all subsequent time steps, -1 if this is the final call at the end of the simulation) [-] + INTEGER(IntKi) :: ShaftBrakeStatusBinaryFlag = 0_IntKi !< binary flag indicating (on/off) status for shaft brake 1, shaft brake 2, generator brake, shaft brake 3, or brake torque set separately (0, 1, or 16 allowed in FAST) [-] + LOGICAL :: HSSBrDeployed = .false. !< Whether the HSS brake has been deployed [-] + REAL(R8Ki) :: TimeHSSBrFullyDeployed = 0.0_R8Ki !< Time at which the controller high-speed shaft is fully deployed [s] + REAL(R8Ki) :: TimeHSSBrDeployed = 0.0_R8Ki !< Time at which the controller high-speed shaft is first deployed [s] + LOGICAL :: OverrideYawRateWithTorque = .false. !< acts similiar to Yaw_Cntrl [-] + REAL(ReKi) :: YawTorqueDemand = 0.0_ReKi !< Demanded yaw actuator torque (override of yaw rate control) [Nm] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlPitchInput !< Input blade pitch angles [radians] - REAL(ReKi) :: YawAngleFromNorth !< Yaw angle of the nacelle relative to North (see NacYaw_North) [rad] - REAL(ReKi) :: HorWindV !< Horizontal hub-height wind velocity magnitude [m/s] - REAL(ReKi) :: HSS_Spd !< High-speed shaft (HSS) speed [rad/s] - REAL(ReKi) :: YawErr !< Yaw error [radians] - REAL(ReKi) :: RotSpeed !< Rotor azimuth angular speed [rad/s] - REAL(ReKi) :: YawBrTAxp !< Tower-top / yaw bearing fore-aft (translational) acceleration (absolute) [m/s^2] - REAL(ReKi) :: YawBrTAyp !< Tower-top / yaw bearing side-to-side (translational) acceleration (absolute) [m/s^2] - REAL(ReKi) :: LSSTipMys !< Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] - REAL(ReKi) :: LSSTipMzs !< Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] - REAL(ReKi) :: LSSTipMya !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] - REAL(ReKi) :: LSSTipMza !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] - REAL(ReKi) :: LSSTipPxa !< Rotor azimuth angle (position) [radians] - REAL(ReKi) :: Yaw !< Current nacelle yaw [radians] - REAL(ReKi) :: YawRate !< Current nacelle yaw rate [rad/s] - REAL(ReKi) :: YawBrMyn !< Rotating (with nacelle) tower-top / yaw bearing pitch moment [N-m] - REAL(ReKi) :: YawBrMzn !< Tower-top / yaw bearing yaw moment [N-m] - REAL(ReKi) :: NcIMURAxs !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] - REAL(ReKi) :: NcIMURAys !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] - REAL(ReKi) :: NcIMURAzs !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] - REAL(ReKi) :: RotPwr !< Rotor power (this is equivalent to the low-speed shaft power) [W] - REAL(ReKi) :: LSSTipMxa !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] - REAL(ReKi) , DIMENSION(1:3) :: RootMyc !< Out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root for each of the blades (max 3) [N-m] - REAL(ReKi) , DIMENSION(1:3) :: RootMxc !< In-plane moment (i.e., the moment caused by in-plane forces) at the blade root [N-m] - REAL(ReKi) :: LSShftFxa !< Rotating low-speed shaft force x [N] - REAL(ReKi) :: LSShftFys !< Nonrotating low-speed shaft force y [N] - REAL(ReKi) :: LSShftFzs !< Nonrotating low-speed shaft force z [N] + REAL(ReKi) :: YawAngleFromNorth = 0.0_ReKi !< Yaw angle of the nacelle relative to North (see NacYaw_North) [rad] + REAL(ReKi) :: HorWindV = 0.0_ReKi !< Horizontal hub-height wind velocity magnitude [m/s] + REAL(ReKi) :: HSS_Spd = 0.0_ReKi !< High-speed shaft (HSS) speed [rad/s] + REAL(ReKi) :: YawErr = 0.0_ReKi !< Yaw error [radians] + REAL(ReKi) :: RotSpeed = 0.0_ReKi !< Rotor azimuth angular speed [rad/s] + REAL(ReKi) :: YawBrTAxp = 0.0_ReKi !< Tower-top / yaw bearing fore-aft (translational) acceleration (absolute) [m/s^2] + REAL(ReKi) :: YawBrTAyp = 0.0_ReKi !< Tower-top / yaw bearing side-to-side (translational) acceleration (absolute) [m/s^2] + REAL(ReKi) :: LSSTipMys = 0.0_ReKi !< Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] + REAL(ReKi) :: LSSTipMzs = 0.0_ReKi !< Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] + REAL(ReKi) :: LSSTipMya = 0.0_ReKi !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] + REAL(ReKi) :: LSSTipMza = 0.0_ReKi !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] + REAL(ReKi) :: LSSTipPxa = 0.0_ReKi !< Rotor azimuth angle (position) [radians] + REAL(ReKi) :: Yaw = 0.0_ReKi !< Current nacelle yaw [radians] + REAL(ReKi) :: YawRate = 0.0_ReKi !< Current nacelle yaw rate [rad/s] + REAL(ReKi) :: YawBrMyn = 0.0_ReKi !< Rotating (with nacelle) tower-top / yaw bearing pitch moment [N-m] + REAL(ReKi) :: YawBrMzn = 0.0_ReKi !< Tower-top / yaw bearing yaw moment [N-m] + REAL(ReKi) :: NcIMURAxs = 0.0_ReKi !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] + REAL(ReKi) :: NcIMURAys = 0.0_ReKi !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] + REAL(ReKi) :: NcIMURAzs = 0.0_ReKi !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] + REAL(ReKi) :: RotPwr = 0.0_ReKi !< Rotor power (this is equivalent to the low-speed shaft power) [W] + REAL(ReKi) :: LSSTipMxa = 0.0_ReKi !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] + REAL(ReKi) , DIMENSION(1:3) :: RootMyc = 0.0_ReKi !< Out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root for each of the blades (max 3) [N-m] + REAL(ReKi) , DIMENSION(1:3) :: RootMxc = 0.0_ReKi !< In-plane moment (i.e., the moment caused by in-plane forces) at the blade root [N-m] + REAL(ReKi) :: LSShftFxa = 0.0_ReKi !< Rotating low-speed shaft force x [N] + REAL(ReKi) :: LSShftFys = 0.0_ReKi !< Nonrotating low-speed shaft force y [N] + REAL(ReKi) :: LSShftFzs = 0.0_ReKi !< Nonrotating low-speed shaft force z [N] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: LidSpeed !< Lidar measured wind speed [m/s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: MsrPositionsX !< Lidar X direction measurement points [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: MsrPositionsY !< Lidar Y direction measurement points [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: MsrPositionsZ !< Lidar Z direction measurement points [m] - INTEGER(IntKi) :: SensorType !< Lidar sensor type [-] - INTEGER(IntKi) :: NumBeam !< Number of beams [-] - INTEGER(IntKi) :: NumPulseGate !< Number of pulse gates [-] - INTEGER(IntKi) :: PulseSpacing !< Distance between range gates [-] - INTEGER(IntKi) :: URefLid !< Reference average wind speed for the lidar [m/s] - REAL(DbKi) :: DLL_DT !< interval for calling DLL (integer multiple number of DT) [s] - CHARACTER(1024) :: DLL_InFile !< Name of input file used in DLL [-] - CHARACTER(1024) :: RootName !< RootName for writing output files [-] - REAL(ReKi) :: GenTrq_Dem !< Demanded generator torque above rated [Nm] - REAL(ReKi) :: GenSpd_Dem !< Demanded generator speed above rated [rad/s] - REAL(ReKi) :: Ptch_Max !< Maximum pitch angle [rad] - REAL(ReKi) :: Ptch_Min !< Minimum pitch angle [rad] - REAL(ReKi) :: Ptch_SetPnt !< Below-rated pitch angle set-point [rad] - REAL(ReKi) :: PtchRate_Max !< Maximum pitch rate [rad/s] - REAL(ReKi) :: PtchRate_Min !< Minimum pitch rate (most negative value allowed) [rad/s] - REAL(ReKi) :: GenPwr_Dem !< Demanded power (This is not valid for variable-speed, pitch-regulated controllers.) [W] - REAL(ReKi) :: Gain_OM !< Optimal mode gain [Nm/(rad/s)^2] - REAL(ReKi) :: GenSpd_MaxOM !< Optimal mode maximum speed [rad/s] - REAL(ReKi) :: GenSpd_MinOM !< Minimum generator speed [rad/s] - INTEGER(IntKi) :: Ptch_Cntrl !< Pitch control: 0 = collective; 1 = individual [-] - INTEGER(IntKi) :: DLL_NumTrq !< No. of points in torque-speed look-up table, 0 = none and use the optimal mode PARAMETERs instead; nonzero = ignore the optimal mode PARAMETERs by setting Record 16 to 0.0 [-] + INTEGER(IntKi) :: SensorType = 0_IntKi !< Lidar sensor type [-] + INTEGER(IntKi) :: NumBeam = 0_IntKi !< Number of beams [-] + INTEGER(IntKi) :: NumPulseGate = 0_IntKi !< Number of pulse gates [-] + INTEGER(IntKi) :: PulseSpacing = 0_IntKi !< Distance between range gates [-] + INTEGER(IntKi) :: URefLid = 0_IntKi !< Reference average wind speed for the lidar [m/s] + REAL(DbKi) :: DLL_DT = 0.0_R8Ki !< interval for calling DLL (integer multiple number of DT) [s] + CHARACTER(1024) :: DLL_InFile = '' !< Name of input file used in DLL [-] + CHARACTER(1024) :: RootName = '' !< RootName for writing output files [-] + REAL(ReKi) :: GenTrq_Dem = 0.0_ReKi !< Demanded generator torque above rated [Nm] + REAL(ReKi) :: GenSpd_Dem = 0.0_ReKi !< Demanded generator speed above rated [rad/s] + REAL(ReKi) :: Ptch_Max = 0.0_ReKi !< Maximum pitch angle [rad] + REAL(ReKi) :: Ptch_Min = 0.0_ReKi !< Minimum pitch angle [rad] + REAL(ReKi) :: Ptch_SetPnt = 0.0_ReKi !< Below-rated pitch angle set-point [rad] + REAL(ReKi) :: PtchRate_Max = 0.0_ReKi !< Maximum pitch rate [rad/s] + REAL(ReKi) :: PtchRate_Min = 0.0_ReKi !< Minimum pitch rate (most negative value allowed) [rad/s] + REAL(ReKi) :: GenPwr_Dem = 0.0_ReKi !< Demanded power (This is not valid for variable-speed, pitch-regulated controllers.) [W] + REAL(ReKi) :: Gain_OM = 0.0_ReKi !< Optimal mode gain [Nm/(rad/s)^2] + REAL(ReKi) :: GenSpd_MaxOM = 0.0_ReKi !< Optimal mode maximum speed [rad/s] + REAL(ReKi) :: GenSpd_MinOM = 0.0_ReKi !< Minimum generator speed [rad/s] + INTEGER(IntKi) :: Ptch_Cntrl = 0_IntKi !< Pitch control: 0 = collective; 1 = individual [-] + INTEGER(IntKi) :: DLL_NumTrq = 0_IntKi !< No. of points in torque-speed look-up table, 0 = none and use the optimal mode PARAMETERs instead; nonzero = ignore the optimal mode PARAMETERs by setting Record 16 to 0.0 [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: GenSpd_TLU !< Table (array) containing DLL_NumTrq generator speeds for the torque-speed table look-up (TLU) -- this should be defined using an array constructor; for example, if DLL_NumTrq = 3, GenSpd_TLU(DLL_NumTrq) = (/ 0.0, 99.9, 999.9 /) [rad/s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: GenTrq_TLU !< Table (array) containing DLL_NumTrq generator torques for the torque-speed table look-up (TLU) -- this should be defined using an array constructor, for example, if DLL_NumTrq = 3, GenTrq_TLU(DLL_NumTrq) = (/ 0.0, 10, 200.0 /) [Nm] - INTEGER(IntKi) :: Yaw_Cntrl !< Yaw control: 0 = rate; 1 = torque [-] + INTEGER(IntKi) :: Yaw_Cntrl = 0_IntKi !< Yaw control: 0 = rate; 1 = torque [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: PrevCableDeltaL !< Previous value for ramping for cable tensioning DeltaL using extended avrSWAP [see EXavrSWAP documentation in BladededInterface_EX] [m] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: PrevCableDeltaLdot !< Previous value for ramping for cable tensioning DeltaLdot using extended avrSWAP [see EXavrSWAP documentation in BladededInterface_EX] [m/s] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: CableDeltaL !< The swap array: used to pass data from the DLL controller for cable tensioning DeltaL using extended avrSWAP [see EXavrSWAP documentation in BladededInterface_EX] [m] @@ -294,7 +294,7 @@ MODULE ServoDyn_Types ! ======================= ! ========= SrvD_ContinuousStateType ======= TYPE, PUBLIC :: SrvD_ContinuousStateType - REAL(ReKi) :: DummyContState !< Remove this variable if you have continuous states [-] + REAL(ReKi) :: DummyContState = 0.0_ReKi !< Remove this variable if you have continuous states [-] TYPE(StC_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: BStC !< StC module states - blade [-] TYPE(StC_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: NStC !< StC module states - nacelle [-] TYPE(StC_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: TStC !< StC module states - tower [-] @@ -303,7 +303,7 @@ MODULE ServoDyn_Types ! ======================= ! ========= SrvD_DiscreteStateType ======= TYPE, PUBLIC :: SrvD_DiscreteStateType - REAL(ReKi) :: CtrlOffset !< Controller offset parameter [N-m] + REAL(ReKi) :: CtrlOffset = 0.0_ReKi !< Controller offset parameter [N-m] TYPE(StC_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: BStC !< StC module states - blade [-] TYPE(StC_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: NStC !< StC module states - nacelle [-] TYPE(StC_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: TStC !< StC module states - tower [-] @@ -312,7 +312,7 @@ MODULE ServoDyn_Types ! ======================= ! ========= SrvD_ConstraintStateType ======= TYPE, PUBLIC :: SrvD_ConstraintStateType - REAL(ReKi) :: DummyConstrState !< Remove this variable if you have constraint states [-] + REAL(ReKi) :: DummyConstrState = 0.0_ReKi !< Remove this variable if you have constraint states [-] TYPE(StC_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: BStC !< StC module states - blade [-] TYPE(StC_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: NStC !< StC module states - nacelle [-] TYPE(StC_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: TStC !< StC module states - tower [-] @@ -324,15 +324,15 @@ MODULE ServoDyn_Types LOGICAL , DIMENSION(:), ALLOCATABLE :: BegPitMan !< Whether the override pitch maneuver actually began [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlPitchI !< Initial blade pitch angles at the start of the override pitch maneuver [radians] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: TPitManE !< Time to end pitch maneuvers for each blade [s] - LOGICAL :: BegYawMan !< Whether the yaw maneuver actually began [-] - REAL(ReKi) :: NacYawI !< Initial yaw angle at the start of the override yaw maneuver [radians] - REAL(DbKi) :: TYawManE !< Time to end override yaw maneuver [s] - REAL(ReKi) :: YawPosComInt !< Internal variable that integrates the commanded yaw rate and passes it to YawPosCom [radians] + LOGICAL :: BegYawMan = .false. !< Whether the yaw maneuver actually began [-] + REAL(ReKi) :: NacYawI = 0.0_ReKi !< Initial yaw angle at the start of the override yaw maneuver [radians] + REAL(DbKi) :: TYawManE = 0.0_R8Ki !< Time to end override yaw maneuver [s] + REAL(ReKi) :: YawPosComInt = 0.0_ReKi !< Internal variable that integrates the commanded yaw rate and passes it to YawPosCom [radians] LOGICAL , DIMENSION(:), ALLOCATABLE :: BegTpBr !< Whether the tip brakes actually deployed [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: TTpBrDp !< Times to initiate deployment of tip brakes [s] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: TTpBrFl !< Times at which tip brakes are fully deployed [s] - LOGICAL :: Off4Good !< Is the generator offline for rest of simulation? [-] - LOGICAL :: GenOnLine !< Is the generator online? [-] + LOGICAL :: Off4Good = .false. !< Is the generator offline for rest of simulation? [-] + LOGICAL :: GenOnLine = .false. !< Is the generator online? [-] TYPE(StC_OtherStateType) , DIMENSION(:), ALLOCATABLE :: BStC !< StC module states - blade [-] TYPE(StC_OtherStateType) , DIMENSION(:), ALLOCATABLE :: NStC !< StC module states - nacelle [-] TYPE(StC_OtherStateType) , DIMENSION(:), ALLOCATABLE :: TStC !< StC module states - tower [-] @@ -353,10 +353,10 @@ MODULE ServoDyn_Types ! ======================= ! ========= SrvD_MiscVarType ======= TYPE, PUBLIC :: SrvD_MiscVarType - REAL(DbKi) :: LastTimeCalled !< last time the CalcOutput/Bladed DLL was called [s] + REAL(DbKi) :: LastTimeCalled = 0.0_R8Ki !< last time the CalcOutput/Bladed DLL was called [s] TYPE(BladedDLLType) :: dll_data !< data used for Bladed DLL [-] - LOGICAL :: FirstWarn !< Whether or not this is the first warning about the DLL being called without Explicit-Loose coupling. [-] - REAL(DbKi) :: LastTimeFiltered !< last time the CalcOutput/Bladed DLL was filtered [s] + LOGICAL :: FirstWarn = .false. !< Whether or not this is the first warning about the DLL being called without Explicit-Loose coupling. [-] + REAL(DbKi) :: LastTimeFiltered = 0.0_R8Ki !< last time the CalcOutput/Bladed DLL was filtered [s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: xd_BlPitchFilter !< blade pitch filter [-] TYPE(StC_MiscVarType) , DIMENSION(:), ALLOCATABLE :: BStC !< StC module misc vars - blade [-] TYPE(StC_MiscVarType) , DIMENSION(:), ALLOCATABLE :: NStC !< StC module misc vars - nacelle [-] @@ -376,112 +376,112 @@ MODULE ServoDyn_Types ! ======================= ! ========= SrvD_ParameterType ======= TYPE, PUBLIC :: SrvD_ParameterType - REAL(DbKi) :: DT !< Time step for continuous state integration & discrete state update [seconds] - REAL(DbKi) :: HSSBrDT !< Time it takes for HSS brake to reach full deployment once deployed [seconds] - REAL(ReKi) :: HSSBrTqF !< Fully deployed HSS brake torque [-] - REAL(ReKi) :: SIG_POSl !< Pullout slip [-] - REAL(ReKi) :: SIG_POTq !< Pullout torque [-] - REAL(ReKi) :: SIG_SlPc !< Rated generator slip percentage [-] - REAL(ReKi) :: SIG_Slop !< Torque/Speed slope for simple induction generator [-] - REAL(ReKi) :: SIG_SySp !< Synchronous (zero-torque) generator speed [rad/s] - REAL(ReKi) :: TEC_A0 !< A0 term for Thevenin-equivalent circuit [-] - REAL(ReKi) :: TEC_C0 !< C0 term for Thevenin-equivalent circuit [-] - REAL(ReKi) :: TEC_C1 !< C1 term for Thevenin-equivalent circuit [-] - REAL(ReKi) :: TEC_C2 !< C2 term for Thevenin-equivalent circuit [-] - REAL(ReKi) :: TEC_K2 !< K2 term for Thevenin-equivalent circuit [-] - REAL(ReKi) :: TEC_MR !< Magnetizing reactance for Thevenin-equivalent circuit [ohms] - REAL(ReKi) :: TEC_Re1 !< Thevenin's equivalent stator resistance (ohms) [ohms] - REAL(ReKi) :: TEC_RLR !< Rotor leakage reactance for Thevenin-equivalent circuit [-] - REAL(ReKi) :: TEC_RRes !< Rotor resistance for Thevenin-equivalent circuit [-] - REAL(ReKi) :: TEC_SRes !< Stator resistance for Thevenin-equivalent circuit [-] - REAL(ReKi) :: TEC_SySp !< Synchronous speed for Thevenin-equivalent circuit [-] - REAL(ReKi) :: TEC_V1a !< Source voltage for Thevenin-equivalent circuit [-] - REAL(ReKi) :: TEC_VLL !< Line-to-line RMS voltage for Thevenin-equivalent circuit [-] - REAL(ReKi) :: TEC_Xe1 !< Thevenin's equivalent stator leakage reactance (ohms) [ohms] - REAL(ReKi) :: GenEff !< Generator efficiency [-] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for continuous state integration & discrete state update [seconds] + REAL(DbKi) :: HSSBrDT = 0.0_R8Ki !< Time it takes for HSS brake to reach full deployment once deployed [seconds] + REAL(ReKi) :: HSSBrTqF = 0.0_ReKi !< Fully deployed HSS brake torque [-] + REAL(ReKi) :: SIG_POSl = 0.0_ReKi !< Pullout slip [-] + REAL(ReKi) :: SIG_POTq = 0.0_ReKi !< Pullout torque [-] + REAL(ReKi) :: SIG_SlPc = 0.0_ReKi !< Rated generator slip percentage [-] + REAL(ReKi) :: SIG_Slop = 0.0_ReKi !< Torque/Speed slope for simple induction generator [-] + REAL(ReKi) :: SIG_SySp = 0.0_ReKi !< Synchronous (zero-torque) generator speed [rad/s] + REAL(ReKi) :: TEC_A0 = 0.0_ReKi !< A0 term for Thevenin-equivalent circuit [-] + REAL(ReKi) :: TEC_C0 = 0.0_ReKi !< C0 term for Thevenin-equivalent circuit [-] + REAL(ReKi) :: TEC_C1 = 0.0_ReKi !< C1 term for Thevenin-equivalent circuit [-] + REAL(ReKi) :: TEC_C2 = 0.0_ReKi !< C2 term for Thevenin-equivalent circuit [-] + REAL(ReKi) :: TEC_K2 = 0.0_ReKi !< K2 term for Thevenin-equivalent circuit [-] + REAL(ReKi) :: TEC_MR = 0.0_ReKi !< Magnetizing reactance for Thevenin-equivalent circuit [ohms] + REAL(ReKi) :: TEC_Re1 = 0.0_ReKi !< Thevenin's equivalent stator resistance (ohms) [ohms] + REAL(ReKi) :: TEC_RLR = 0.0_ReKi !< Rotor leakage reactance for Thevenin-equivalent circuit [-] + REAL(ReKi) :: TEC_RRes = 0.0_ReKi !< Rotor resistance for Thevenin-equivalent circuit [-] + REAL(ReKi) :: TEC_SRes = 0.0_ReKi !< Stator resistance for Thevenin-equivalent circuit [-] + REAL(ReKi) :: TEC_SySp = 0.0_ReKi !< Synchronous speed for Thevenin-equivalent circuit [-] + REAL(ReKi) :: TEC_V1a = 0.0_ReKi !< Source voltage for Thevenin-equivalent circuit [-] + REAL(ReKi) :: TEC_VLL = 0.0_ReKi !< Line-to-line RMS voltage for Thevenin-equivalent circuit [-] + REAL(ReKi) :: TEC_Xe1 = 0.0_ReKi !< Thevenin's equivalent stator leakage reactance (ohms) [ohms] + REAL(ReKi) :: GenEff = 0.0_ReKi !< Generator efficiency [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlPitchInit !< Initial blade pitch angles [radians] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlPitchF !< Final blade pitch [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PitManRat !< Pitch rates at which override pitch maneuvers head toward final pitch angles (does not include sign) [rad/s] - REAL(ReKi) :: YawManRat !< Yaw rate at which override yaw maneuver head toward for final yaw angle (does not include sign) [rad/s] - REAL(ReKi) :: NacYawF !< Final yaw angle after override yaw maneuver [-] - REAL(ReKi) :: SpdGenOn !< Generator speed to turn on the generator for a startup [-] - REAL(DbKi) :: THSSBrDp !< Time to initiate deployment of the shaft brake [s] - REAL(DbKi) :: THSSBrFl !< Time at which shaft brake is fully deployed [s] - REAL(DbKi) :: TimGenOf !< Time to turn off generator for braking or modeling a run-away [s] - REAL(DbKi) :: TimGenOn !< Time to turn on generator for startup [s] - REAL(DbKi) :: TPCOn !< Time to enable active pitch control [s] + REAL(ReKi) :: YawManRat = 0.0_ReKi !< Yaw rate at which override yaw maneuver head toward for final yaw angle (does not include sign) [rad/s] + REAL(ReKi) :: NacYawF = 0.0_ReKi !< Final yaw angle after override yaw maneuver [-] + REAL(ReKi) :: SpdGenOn = 0.0_ReKi !< Generator speed to turn on the generator for a startup [-] + REAL(DbKi) :: THSSBrDp = 0.0_R8Ki !< Time to initiate deployment of the shaft brake [s] + REAL(DbKi) :: THSSBrFl = 0.0_R8Ki !< Time at which shaft brake is fully deployed [s] + REAL(DbKi) :: TimGenOf = 0.0_R8Ki !< Time to turn off generator for braking or modeling a run-away [s] + REAL(DbKi) :: TimGenOn = 0.0_R8Ki !< Time to turn on generator for startup [s] + REAL(DbKi) :: TPCOn = 0.0_R8Ki !< Time to enable active pitch control [s] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: TPitManS !< Time to start pitch maneuvers for each blade [s] - REAL(DbKi) :: TYawManS !< Time to start override yaw maneuver [s] - REAL(DbKi) :: TYCOn !< Time to enable active yaw control [s] - REAL(ReKi) :: VS_RtGnSp !< Rated generator speed (HSS side) [rad/s] - REAL(ReKi) :: VS_RtTq !< Rated generator torque/constant generator torque in Region 3 (HSS side) [N-m] - REAL(ReKi) :: VS_Slope !< Torque/speed slope of region 2 1/2 induction generator [-] - REAL(ReKi) :: VS_SlPc !< Rated generator slip percentage in Region 2 1/2 [-] - REAL(ReKi) :: VS_SySp !< Synchronous speed of region 2 1/2 induction generator [-] - REAL(ReKi) :: VS_TrGnSp !< Transitional generator speed between regions 2 and 2 1/2 [-] - REAL(ReKi) :: YawPosCom !< Commanded yaw angle from user-defined routines [rad] - REAL(ReKi) :: YawRateCom !< Commanded yaw rate from user-defined routines [rad/s] - INTEGER(IntKi) :: GenModel !< Generator model [-] - INTEGER(IntKi) :: HSSBrMode !< HSS brake model [-] - INTEGER(IntKi) :: PCMode !< Pitch control mode [-] - INTEGER(IntKi) :: VSContrl !< Variable-speed-generator control switch [-] - INTEGER(IntKi) :: YCMode !< Yaw control mode [-] - LOGICAL :: GenTiStp !< Stop generator based upon T: time or F: generator power = 0 [-] - LOGICAL :: GenTiStr !< Start generator based upon T: time or F: generator speed [-] - REAL(ReKi) :: VS_Rgn2K !< Generator torque constant in Region 2 for simple variable-speed generator control (HSS side) [used only when VSContrl=1] [N-m/(rad/s)^2] - REAL(ReKi) :: YawNeut !< Neutral yaw position--yaw spring force is zero at this yaw [radians] - REAL(ReKi) :: YawSpr !< Nacelle-yaw spring constant [N-m/rad] - REAL(ReKi) :: YawDamp !< Nacelle-yaw constant [N-m/(rad/s)] - REAL(DbKi) :: TpBrDT !< Time for tip-brake to reach full deployment once released [s] + REAL(DbKi) :: TYawManS = 0.0_R8Ki !< Time to start override yaw maneuver [s] + REAL(DbKi) :: TYCOn = 0.0_R8Ki !< Time to enable active yaw control [s] + REAL(ReKi) :: VS_RtGnSp = 0.0_ReKi !< Rated generator speed (HSS side) [rad/s] + REAL(ReKi) :: VS_RtTq = 0.0_ReKi !< Rated generator torque/constant generator torque in Region 3 (HSS side) [N-m] + REAL(ReKi) :: VS_Slope = 0.0_ReKi !< Torque/speed slope of region 2 1/2 induction generator [-] + REAL(ReKi) :: VS_SlPc = 0.0_ReKi !< Rated generator slip percentage in Region 2 1/2 [-] + REAL(ReKi) :: VS_SySp = 0.0_ReKi !< Synchronous speed of region 2 1/2 induction generator [-] + REAL(ReKi) :: VS_TrGnSp = 0.0_ReKi !< Transitional generator speed between regions 2 and 2 1/2 [-] + REAL(ReKi) :: YawPosCom = 0.0_ReKi !< Commanded yaw angle from user-defined routines [rad] + REAL(ReKi) :: YawRateCom = 0.0_ReKi !< Commanded yaw rate from user-defined routines [rad/s] + INTEGER(IntKi) :: GenModel = 0_IntKi !< Generator model [-] + INTEGER(IntKi) :: HSSBrMode = 0_IntKi !< HSS brake model [-] + INTEGER(IntKi) :: PCMode = 0_IntKi !< Pitch control mode [-] + INTEGER(IntKi) :: VSContrl = 0_IntKi !< Variable-speed-generator control switch [-] + INTEGER(IntKi) :: YCMode = 0_IntKi !< Yaw control mode [-] + LOGICAL :: GenTiStp = .false. !< Stop generator based upon T: time or F: generator power = 0 [-] + LOGICAL :: GenTiStr = .false. !< Start generator based upon T: time or F: generator speed [-] + REAL(ReKi) :: VS_Rgn2K = 0.0_ReKi !< Generator torque constant in Region 2 for simple variable-speed generator control (HSS side) [used only when VSContrl=1] [N-m/(rad/s)^2] + REAL(ReKi) :: YawNeut = 0.0_ReKi !< Neutral yaw position--yaw spring force is zero at this yaw [radians] + REAL(ReKi) :: YawSpr = 0.0_ReKi !< Nacelle-yaw spring constant [N-m/rad] + REAL(ReKi) :: YawDamp = 0.0_ReKi !< Nacelle-yaw constant [N-m/(rad/s)] + REAL(DbKi) :: TpBrDT = 0.0_R8Ki !< Time for tip-brake to reach full deployment once released [s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TBDepISp !< Deployment-initiation speed for the tip brakes [rad/s] - REAL(ReKi) :: TBDrConN !< Tip-brake drag constant during normal operation, Cd*Area [-] - REAL(ReKi) :: TBDrConD !< Tip-brake drag constant during fully-deployed operation, Cd*Area [-] - INTEGER(IntKi) :: NumBl !< Number of blades on the turbine [-] - INTEGER(IntKi) :: NumBStC !< Number of blade structural controllers (integer) [-] - INTEGER(IntKi) :: NumNStC !< Number of nacelle structural controllers (integer) [-] - INTEGER(IntKi) :: NumTStC !< Number of tower structural controllers (integer) [-] - INTEGER(IntKi) :: NumSStC !< Number of substructure structural controllers (integer) [-] - INTEGER(IntKi) :: AfCmode !< Airfoil control mode {0: none, 1: sine wave cycle, 4: user-defined from Simulink/Labview, 5: user-defined from Bladed-style DLL} [-] - REAL(ReKi) :: AfC_Mean !< Mean level for cosine cycling or steady value [used only with AfCmode==1] [-] - REAL(ReKi) :: AfC_Amp !< Amplitude for for cosine cycling of flap signal (-) [used only with AfCmode==1] [-] - REAL(ReKi) :: AfC_Phase !< Phase relative to the blade azimuth (0 is vertical) for for cosine cycling of flap signal (deg) [used only with AfCmode==1] [deg] - INTEGER(IntKi) :: CCmode !< Cable control control mode {0: none, 4: user-defined from Simulink/Labview, 5: user-defined from Bladed-style DLL} [-] - INTEGER(IntKi) :: StCCmode !< Structural control control mode {0: none, 4: user-defined from Simulink/Labview, 5: user-defined from Bladed-style DLL} [-] - INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] - INTEGER(IntKi) :: NumOuts_DLL !< Number of logging channels output from the DLL (set at initialization) [-] - CHARACTER(1024) :: RootName !< RootName for writing output files [-] + REAL(ReKi) :: TBDrConN = 0.0_ReKi !< Tip-brake drag constant during normal operation, Cd*Area [-] + REAL(ReKi) :: TBDrConD = 0.0_ReKi !< Tip-brake drag constant during fully-deployed operation, Cd*Area [-] + INTEGER(IntKi) :: NumBl = 0_IntKi !< Number of blades on the turbine [-] + INTEGER(IntKi) :: NumBStC = 0_IntKi !< Number of blade structural controllers (integer) [-] + INTEGER(IntKi) :: NumNStC = 0_IntKi !< Number of nacelle structural controllers (integer) [-] + INTEGER(IntKi) :: NumTStC = 0_IntKi !< Number of tower structural controllers (integer) [-] + INTEGER(IntKi) :: NumSStC = 0_IntKi !< Number of substructure structural controllers (integer) [-] + INTEGER(IntKi) :: AfCmode = 0_IntKi !< Airfoil control mode {0: none, 1: sine wave cycle, 4: user-defined from Simulink/Labview, 5: user-defined from Bladed-style DLL} [-] + REAL(ReKi) :: AfC_Mean = 0.0_ReKi !< Mean level for cosine cycling or steady value [used only with AfCmode==1] [-] + REAL(ReKi) :: AfC_Amp = 0.0_ReKi !< Amplitude for for cosine cycling of flap signal (-) [used only with AfCmode==1] [-] + REAL(ReKi) :: AfC_Phase = 0.0_ReKi !< Phase relative to the blade azimuth (0 is vertical) for for cosine cycling of flap signal (deg) [used only with AfCmode==1] [deg] + INTEGER(IntKi) :: CCmode = 0_IntKi !< Cable control control mode {0: none, 4: user-defined from Simulink/Labview, 5: user-defined from Bladed-style DLL} [-] + INTEGER(IntKi) :: StCCmode = 0_IntKi !< Structural control control mode {0: none, 4: user-defined from Simulink/Labview, 5: user-defined from Bladed-style DLL} [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] + INTEGER(IntKi) :: NumOuts_DLL = 0_IntKi !< Number of logging channels output from the DLL (set at initialization) [-] + CHARACTER(1024) :: RootName = '' !< RootName for writing output files [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] - CHARACTER(1) :: Delim !< Column delimiter for output text files [-] - LOGICAL :: UseBladedInterface !< Flag that determines if BladedInterface was used [-] - LOGICAL :: UseLegacyInterface !< Flag that determines if the legacy Bladed interface is (legacy=DISCON with avrSWAP instead of CONTROLLER) [-] + CHARACTER(1) :: Delim = '' !< Column delimiter for output text files [-] + LOGICAL :: UseBladedInterface = .false. !< Flag that determines if BladedInterface was used [-] + LOGICAL :: UseLegacyInterface = .false. !< Flag that determines if the legacy Bladed interface is (legacy=DISCON with avrSWAP instead of CONTROLLER) [-] TYPE(DLL_Type) :: DLL_Trgt !< The addresses and names of the Bladed DLL and its procedure [-] - LOGICAL :: DLL_Ramp !< determines if there is a DLL_DT-ramp time delay (true only when DLL_DT /= DT) [-] - REAL(ReKi) :: BlAlpha !< parameter for low-pass filter of blade pitch commands from the controller DLL [-] - INTEGER(IntKi) :: DLL_n !< number of steps between the controller being called and SrvD being called [-] - INTEGER(IntKi) :: avcOUTNAME_LEN !< Length of the avcOUTNAME character array passed to/from the DLL [-] - REAL(ReKi) :: NacYaw_North !< Reference yaw angle of the nacelle when the upwind end points due North [rad] - REAL(ReKi) :: AvgWindSpeed !< average wind speed for the simulation [m/s] - REAL(ReKi) :: AirDens !< air density [kg/m^3] - INTEGER(IntKi) :: TrimCase !< Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} [used only if CalcSteady=True] [-] - REAL(ReKi) :: TrimGain !< Proportional gain for the rotational speed error (>0) [used only if TrimCase>0] [rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque] - REAL(ReKi) :: RotSpeedRef !< Reference rotor speed [rad/s] + LOGICAL :: DLL_Ramp = .false. !< determines if there is a DLL_DT-ramp time delay (true only when DLL_DT /= DT) [-] + REAL(ReKi) :: BlAlpha = 0.0_ReKi !< parameter for low-pass filter of blade pitch commands from the controller DLL [-] + INTEGER(IntKi) :: DLL_n = 0_IntKi !< number of steps between the controller being called and SrvD being called [-] + INTEGER(IntKi) :: avcOUTNAME_LEN = 0_IntKi !< Length of the avcOUTNAME character array passed to/from the DLL [-] + REAL(ReKi) :: NacYaw_North = 0.0_ReKi !< Reference yaw angle of the nacelle when the upwind end points due North [rad] + REAL(ReKi) :: AvgWindSpeed = 0.0_ReKi !< average wind speed for the simulation [m/s] + REAL(ReKi) :: AirDens = 0.0_ReKi !< air density [kg/m^3] + INTEGER(IntKi) :: TrimCase = 0_IntKi !< Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} [used only if CalcSteady=True] [-] + REAL(ReKi) :: TrimGain = 0.0_ReKi !< Proportional gain for the rotational speed error (>0) [used only if TrimCase>0] [rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque] + REAL(ReKi) :: RotSpeedRef = 0.0_ReKi !< Reference rotor speed [rad/s] TYPE(StC_ParameterType) , DIMENSION(:), ALLOCATABLE :: BStC !< StC module parameters - blade [-] TYPE(StC_ParameterType) , DIMENSION(:), ALLOCATABLE :: NStC !< StC module parameters - nacelle [-] TYPE(StC_ParameterType) , DIMENSION(:), ALLOCATABLE :: TStC !< StC module parameters - tower [-] TYPE(StC_ParameterType) , DIMENSION(:), ALLOCATABLE :: SStC !< StC module parameters - substructure [-] - INTEGER(IntKi) :: InterpOrder !< Interpolation order from glue code -- required to set m%u_xStC sizes [-] - LOGICAL :: EXavrSWAP !< Use extendend avr SWAP [-] - INTEGER(IntKi) :: NumCableControl !< Number of cable control channels requested [-] - INTEGER(IntKi) :: NumStC_Control !< Number of cable StC channels requested [-] + INTEGER(IntKi) :: InterpOrder = 0_IntKi !< Interpolation order from glue code -- required to set m%u_xStC sizes [-] + LOGICAL :: EXavrSWAP = .false. !< Use extendend avr SWAP [-] + INTEGER(IntKi) :: NumCableControl = 0_IntKi !< Number of cable control channels requested [-] + INTEGER(IntKi) :: NumStC_Control = 0_IntKi !< Number of cable StC channels requested [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: StCMeasNumPerChan !< Number of cable StC channel to average on each control channel sent to DLL [-] - LOGICAL :: UseSC !< Supercontroller on/off flag [-] + LOGICAL :: UseSC = .false. !< Supercontroller on/off flag [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_x_indx !< matrix to help fill/pack the x vector in computing the jacobian [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: du !< vector that determines size of perturbation for u (inputs) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dx !< vector that determines size of perturbation for x (continuous states) [-] - INTEGER(IntKi) :: Jac_nu !< number of inputs in jacobian matrix [-] - INTEGER(IntKi) :: Jac_ny !< number of outputs in jacobian matrix [-] - INTEGER(IntKi) :: Jac_nx !< the number of continuous states in jacobian matrix [-] + INTEGER(IntKi) :: Jac_nu = 0_IntKi !< number of inputs in jacobian matrix [-] + INTEGER(IntKi) :: Jac_ny = 0_IntKi !< number of outputs in jacobian matrix [-] + INTEGER(IntKi) :: Jac_nx = 0_IntKi !< the number of continuous states in jacobian matrix [-] INTEGER(IntKi) , DIMENSION(:,:,:), ALLOCATABLE :: Jac_Idx_BStC_u !< the start and end indices of blade StC u jacobian [ start/end, blade, instance ] [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_Idx_NStC_u !< the start and end indices of nacelle StC u jacobian [ start/end, instance ] [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_Idx_TStC_u !< the start and end indices of tower StC u jacobian [ start/end, instance ] [-] @@ -494,54 +494,54 @@ MODULE ServoDyn_Types INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_Idx_NStC_y !< the start and end indices of nacelle StC y jacobian [ start/end, instance ] [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_Idx_TStC_y !< the start and end indices of tower StC y jacobian [ start/end, instance ] [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_Idx_SStC_y !< the start and end indices of substructure StC y jacobian [ start/end, instance ] [-] - INTEGER(IntKi) :: SensorType !< Lidar sensor type [-] - INTEGER(IntKi) :: NumBeam !< Number of beams [-] - INTEGER(IntKi) :: NumPulseGate !< Number of pulse gates [-] - REAL(ReKi) :: PulseSpacing !< Distance between range gates [m] - REAL(ReKi) :: URefLid !< Reference average wind speed for the lidar [m/s] + INTEGER(IntKi) :: SensorType = 0_IntKi !< Lidar sensor type [-] + INTEGER(IntKi) :: NumBeam = 0_IntKi !< Number of beams [-] + INTEGER(IntKi) :: NumPulseGate = 0_IntKi !< Number of pulse gates [-] + REAL(ReKi) :: PulseSpacing = 0.0_ReKi !< Distance between range gates [m] + REAL(ReKi) :: URefLid = 0.0_ReKi !< Reference average wind speed for the lidar [m/s] END TYPE SrvD_ParameterType ! ======================= ! ========= SrvD_InputType ======= TYPE, PUBLIC :: SrvD_InputType REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlPitch !< Current blade pitch angles [radians] - REAL(ReKi) :: Yaw !< Current nacelle yaw [radians] - REAL(ReKi) :: YawRate !< Current nacelle yaw rate [rad/s] - REAL(ReKi) :: LSS_Spd !< Low-speed shaft (LSS) speed at entrance to gearbox [rad/s] - REAL(ReKi) :: HSS_Spd !< High-speed shaft (HSS) speed [rad/s] - REAL(ReKi) :: RotSpeed !< Rotor azimuth angular speed [rad/s] - REAL(ReKi) :: ExternalYawPosCom !< Commanded nacelle yaw position from Simulink or Labview [radians] - REAL(ReKi) :: ExternalYawRateCom !< Commanded nacelle yaw rate from Simulink or Labview [rad/s] + REAL(ReKi) :: Yaw = 0.0_ReKi !< Current nacelle yaw [radians] + REAL(ReKi) :: YawRate = 0.0_ReKi !< Current nacelle yaw rate [rad/s] + REAL(ReKi) :: LSS_Spd = 0.0_ReKi !< Low-speed shaft (LSS) speed at entrance to gearbox [rad/s] + REAL(ReKi) :: HSS_Spd = 0.0_ReKi !< High-speed shaft (HSS) speed [rad/s] + REAL(ReKi) :: RotSpeed = 0.0_ReKi !< Rotor azimuth angular speed [rad/s] + REAL(ReKi) :: ExternalYawPosCom = 0.0_ReKi !< Commanded nacelle yaw position from Simulink or Labview [radians] + REAL(ReKi) :: ExternalYawRateCom = 0.0_ReKi !< Commanded nacelle yaw rate from Simulink or Labview [rad/s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ExternalBlPitchCom !< Commanded blade pitch from Simulink or LabVIEW [radians] - REAL(ReKi) :: ExternalGenTrq !< Electrical generator torque from Simulink or LabVIEW [N-m] - REAL(ReKi) :: ExternalElecPwr !< Electrical power from Simulink or LabVIEW [W] - REAL(ReKi) :: ExternalHSSBrFrac !< Fraction of full braking torque: 0 (off) <= HSSBrFrac <= 1 (full) from Simulink or LabVIEW [-] + REAL(ReKi) :: ExternalGenTrq = 0.0_ReKi !< Electrical generator torque from Simulink or LabVIEW [N-m] + REAL(ReKi) :: ExternalElecPwr = 0.0_ReKi !< Electrical power from Simulink or LabVIEW [W] + REAL(ReKi) :: ExternalHSSBrFrac = 0.0_ReKi !< Fraction of full braking torque: 0 (off) <= HSSBrFrac <= 1 (full) from Simulink or LabVIEW [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ExternalBlAirfoilCom !< Commanded Airfoil UserProp for blade. Passed to AD15 for airfoil interpolation (must be same units as given in AD15 airfoil tables) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ExternalCableDeltaL !< Commanded Cable controlo DeltaL [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ExternalCableDeltaLdot !< Commanded Cable controlo DeltaLdot [m/s] - REAL(ReKi) :: TwrAccel !< Tower acceleration for tower feedback control (user routine only) [m/s^2] - REAL(ReKi) :: YawErr !< Yaw error [radians] - REAL(ReKi) :: WindDir !< Wind direction [radians] - REAL(ReKi) , DIMENSION(1:3) :: RootMyc !< Out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root for each of the blades (max 3) [N-m] - REAL(ReKi) :: YawBrTAxp !< Tower-top / yaw bearing fore-aft (translational) acceleration (absolute) [m/s^2] - REAL(ReKi) :: YawBrTAyp !< Tower-top / yaw bearing side-to-side (translational) acceleration (absolute) [m/s^2] - REAL(ReKi) :: LSSTipPxa !< Rotor azimuth angle (position) [radians] - REAL(ReKi) , DIMENSION(1:3) :: RootMxc !< In-plane moment (i.e., the moment caused by in-plane forces) at the blade root [N-m] - REAL(ReKi) :: LSSTipMxa !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] - REAL(ReKi) :: LSSTipMya !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] - REAL(ReKi) :: LSSTipMza !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] - REAL(ReKi) :: LSSTipMys !< Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] - REAL(ReKi) :: LSSTipMzs !< Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] - REAL(ReKi) :: YawBrMyn !< Rotating (with nacelle) tower-top / yaw bearing pitch moment [N-m] - REAL(ReKi) :: YawBrMzn !< Tower-top / yaw bearing yaw moment [N-m] - REAL(ReKi) :: NcIMURAxs !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] - REAL(ReKi) :: NcIMURAys !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] - REAL(ReKi) :: NcIMURAzs !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] - REAL(ReKi) :: RotPwr !< Rotor power (this is equivalent to the low-speed shaft power) [W] - REAL(ReKi) :: HorWindV !< Horizontal hub-height wind velocity magnitude [m/s] - REAL(ReKi) :: YawAngle !< Estimate of yaw (nacelle + platform) [radians] - REAL(ReKi) :: LSShftFxa !< Rotating low-speed shaft force x [N] - REAL(ReKi) :: LSShftFys !< Nonrotating low-speed shaft force y [N] - REAL(ReKi) :: LSShftFzs !< Nonrotating low-speed shaft force z [N] + REAL(ReKi) :: TwrAccel = 0.0_ReKi !< Tower acceleration for tower feedback control (user routine only) [m/s^2] + REAL(ReKi) :: YawErr = 0.0_ReKi !< Yaw error [radians] + REAL(ReKi) :: WindDir = 0.0_ReKi !< Wind direction [radians] + REAL(ReKi) , DIMENSION(1:3) :: RootMyc = 0.0_ReKi !< Out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root for each of the blades (max 3) [N-m] + REAL(ReKi) :: YawBrTAxp = 0.0_ReKi !< Tower-top / yaw bearing fore-aft (translational) acceleration (absolute) [m/s^2] + REAL(ReKi) :: YawBrTAyp = 0.0_ReKi !< Tower-top / yaw bearing side-to-side (translational) acceleration (absolute) [m/s^2] + REAL(ReKi) :: LSSTipPxa = 0.0_ReKi !< Rotor azimuth angle (position) [radians] + REAL(ReKi) , DIMENSION(1:3) :: RootMxc = 0.0_ReKi !< In-plane moment (i.e., the moment caused by in-plane forces) at the blade root [N-m] + REAL(ReKi) :: LSSTipMxa = 0.0_ReKi !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] + REAL(ReKi) :: LSSTipMya = 0.0_ReKi !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] + REAL(ReKi) :: LSSTipMza = 0.0_ReKi !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] + REAL(ReKi) :: LSSTipMys = 0.0_ReKi !< Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] + REAL(ReKi) :: LSSTipMzs = 0.0_ReKi !< Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] + REAL(ReKi) :: YawBrMyn = 0.0_ReKi !< Rotating (with nacelle) tower-top / yaw bearing pitch moment [N-m] + REAL(ReKi) :: YawBrMzn = 0.0_ReKi !< Tower-top / yaw bearing yaw moment [N-m] + REAL(ReKi) :: NcIMURAxs = 0.0_ReKi !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] + REAL(ReKi) :: NcIMURAys = 0.0_ReKi !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] + REAL(ReKi) :: NcIMURAzs = 0.0_ReKi !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] + REAL(ReKi) :: RotPwr = 0.0_ReKi !< Rotor power (this is equivalent to the low-speed shaft power) [W] + REAL(ReKi) :: HorWindV = 0.0_ReKi !< Horizontal hub-height wind velocity magnitude [m/s] + REAL(ReKi) :: YawAngle = 0.0_ReKi !< Estimate of yaw (nacelle + platform) [radians] + REAL(ReKi) :: LSShftFxa = 0.0_ReKi !< Rotating low-speed shaft force x [N] + REAL(ReKi) :: LSShftFys = 0.0_ReKi !< Nonrotating low-speed shaft force y [N] + REAL(ReKi) :: LSShftFzs = 0.0_ReKi !< Nonrotating low-speed shaft force z [N] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: fromSC !< A swap array: used to pass turbine specific input data to the DLL controller from the supercontroller [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: fromSCglob !< A swap array: used to pass global input data to the DLL controller from the supercontroller [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: Lidar !< A swap array: used to pass input data to the DLL controller from the Lidar [-] @@ -561,10 +561,10 @@ MODULE ServoDyn_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< Data to be written to an output file: see WriteOutputHdr for names of each variable [see WriteOutputUnt] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlPitchCom !< Commanded blade pitch angles [radians] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlAirfoilCom !< Commanded Airfoil UserProp for blade. Passed to AD15 for airfoil interpolation (must be same units as given in AD15 airfoil tables) [-] - REAL(ReKi) :: YawMom !< Torque transmitted through the yaw bearing [N-m] - REAL(ReKi) :: GenTrq !< Electrical generator torque [N-m] - REAL(ReKi) :: HSSBrTrqC !< Commanded HSS brake torque [N-m] - REAL(ReKi) :: ElecPwr !< Electrical power [W] + REAL(ReKi) :: YawMom = 0.0_ReKi !< Torque transmitted through the yaw bearing [N-m] + REAL(ReKi) :: GenTrq = 0.0_ReKi !< Electrical generator torque [N-m] + REAL(ReKi) :: HSSBrTrqC = 0.0_ReKi !< Commanded HSS brake torque [N-m] + REAL(ReKi) :: ElecPwr = 0.0_ReKi !< Electrical power [W] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TBDrCon !< Instantaneous tip-brake drag constant, Cd*Area [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: Lidar !< A swap array: used to pass output data from the DLL controller to the Lidar [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: CableDeltaL !< Cable control -- Length change request (passed to MD or SD) [m] diff --git a/modules/servodyn/src/StrucCtrl_Types.f90 b/modules/servodyn/src/StrucCtrl_Types.f90 index 3f63d2428e..6746bc6904 100644 --- a/modules/servodyn/src/StrucCtrl_Types.f90 +++ b/modules/servodyn/src/StrucCtrl_Types.f90 @@ -35,80 +35,80 @@ MODULE StrucCtrl_Types IMPLICIT NONE ! ========= StC_InputFile ======= TYPE, PUBLIC :: StC_InputFile - CHARACTER(1024) :: StCFileName !< Name of the input file; remove if there is no file [-] - LOGICAL :: Echo !< Echo input file to echo file [-] - INTEGER(IntKi) :: StC_CMODE !< control mode {0:none; 1: Semi-Active Control Mode; 2: Active Control Mode;} [-] - INTEGER(IntKi) :: StC_SA_MODE !< Semi-Active control mode {1: velocity-based ground hook control; 2: Inverse velocity-based ground hook control; 3: displacement-based ground hook control 4: Phase difference Algorithm with Friction Force 5: Phase difference Algorithm with Damping Force} [-] - INTEGER(IntKi) :: StC_DOF_MODE !< DOF mode {0: NO StC_DOF; 1: StC_X_DOF and StC_Y_DOF; 2: StC_XY_DOF; 3: TLCD; 4: Prescribed force/moment time series} [-] - LOGICAL :: StC_X_DOF !< DOF on or off [-] - LOGICAL :: StC_Y_DOF !< DOF on or off [-] - LOGICAL :: StC_Z_DOF !< DOF on or off [-] - REAL(ReKi) :: StC_X_DSP !< StC_X initial displacement [m] - REAL(ReKi) :: StC_Y_DSP !< StC_Y initial displacement [m] - REAL(ReKi) :: StC_Z_DSP !< StC_Z initial displacement [m] - Character(10) :: StC_Z_PreLdC !< StC_Z spring preload [N] - REAL(ReKi) :: StC_X_M !< StC X mass [kg] - REAL(ReKi) :: StC_Y_M !< StC Y mass [kg] - REAL(ReKi) :: StC_Z_M !< StC Z mass [kg] - REAL(ReKi) :: StC_XY_M !< StC XY mass [kg] - REAL(ReKi) :: StC_X_K !< StC X stiffness [N/m] - REAL(ReKi) :: StC_Y_K !< StC Y stiffness [N/m] - REAL(ReKi) :: StC_Z_K !< StC Y stiffness [N/m] - REAL(ReKi) :: StC_X_C !< StC X damping [N/(m/s)] - REAL(ReKi) :: StC_Y_C !< StC Y damping [N/(m/s)] - REAL(ReKi) :: StC_Z_C !< StC Z damping [N/(m/s)] - REAL(ReKi) :: StC_X_PSP !< Positive stop position (maximum X mass displacement) [m] - REAL(ReKi) :: StC_X_NSP !< Negative stop position (minimum X mass displacement) [m] - REAL(ReKi) :: StC_Y_PSP !< Positive stop position (maximum Y mass displacement) [m] - REAL(ReKi) :: StC_Y_NSP !< Negative stop position (minimum Y mass displacement) [m] - REAL(ReKi) :: StC_Z_PSP !< Positive stop position (maximum Z mass displacement) [m] - REAL(ReKi) :: StC_Z_NSP !< Negative stop position (minimum Z mass displacement) [m] - REAL(ReKi) :: StC_X_KS !< Stop spring X stiffness [N/m] - REAL(ReKi) :: StC_X_CS !< Stop spring X damping [N/(m/s)] - REAL(ReKi) :: StC_Y_KS !< Stop spring Y stiffness [N/m] - REAL(ReKi) :: StC_Y_CS !< Stop spring Y damping [N/(m/s)] - REAL(ReKi) :: StC_Z_KS !< Stop spring Z stiffness [used only when StC_DOF_MODE=1 and StC_Z_DOF=TRUE] [N/m] - REAL(ReKi) :: StC_Z_CS !< Stop spring Z damping [used only when StC_DOF_MODE=1 and StC_Z_DOF=TRUE] [N/(m/s)] - REAL(ReKi) :: StC_P_X !< StC X initial displacement (m) [relative to at rest position] [m] - REAL(ReKi) :: StC_P_Y !< StC Y initial displacement (m) [relative to at rest position] [m] - REAL(ReKi) :: StC_P_Z !< StC Z initial displacement (m) [relative to at rest position; used only when StC_DOF_MODE=1 and StC_Z_DOF=TRUE] [m] - REAL(ReKi) :: StC_X_C_HIGH !< StC X high damping for ground hook control [N/(m/s)] - REAL(ReKi) :: StC_X_C_LOW !< StC X low damping for ground hook control [N/(m/s)] - REAL(ReKi) :: StC_Y_C_HIGH !< StC Y high damping for ground hook control [N/(m/s)] - REAL(ReKi) :: StC_Y_C_LOW !< StC Y low damping for ground hook control [N/(m/s)] - REAL(ReKi) :: StC_Z_C_HIGH !< StC Z high damping for ground hook control [N/(m/s)] - REAL(ReKi) :: StC_Z_C_LOW !< StC Z low damping for ground hook control [N/(m/s)] - REAL(ReKi) :: StC_X_C_BRAKE !< StC X high damping for braking the StC [N/(m/s)] - REAL(ReKi) :: StC_Y_C_BRAKE !< StC Y high damping for braking the StC [N/(m/s)] - REAL(ReKi) :: StC_Z_C_BRAKE !< StC Z high damping for braking the StC [N/(m/s)] - REAL(ReKi) :: L_X !< X TLCD total length [m] - REAL(ReKi) :: B_X !< X TLCD horizontal length [m] - REAL(ReKi) :: area_X !< X TLCD cross-sectional area of vertical column [m^2] - REAL(ReKi) :: area_ratio_X !< X TLCD cross-sectional area ratio (vertical column area divided by horizontal column area) [-] - REAL(ReKi) :: headLossCoeff_X !< X TLCD head loss coeff [-] - REAL(ReKi) :: rho_X !< X TLCD liquid density [kg/m^3] - REAL(ReKi) :: L_Y !< Y TLCD total length [m] - REAL(ReKi) :: B_Y !< Y TLCD horizontal length [m] - REAL(ReKi) :: area_Y !< Side-Side TLCD cross-sectional area of vertical column [m] - REAL(ReKi) :: area_ratio_Y !< Side-Side TLCD cross-sectional area ratio (vertical column area divided by horizontal column area) [-] - REAL(ReKi) :: headLossCoeff_Y !< Side-Side TLCD head loss coeff [-] - REAL(ReKi) :: rho_Y !< Side-Side TLCD liquid density [kg/m^3] - LOGICAL :: USE_F_TBL !< use spring force from user-defined table (flag) [-] - INTEGER(IntKi) :: NKInpSt !< Number of input spring force rows in table [-] - CHARACTER(1024) :: StC_F_TBL_FILE !< user-defined spring table filename [-] + CHARACTER(1024) :: StCFileName = '' !< Name of the input file; remove if there is no file [-] + LOGICAL :: Echo = .false. !< Echo input file to echo file [-] + INTEGER(IntKi) :: StC_CMODE = 0_IntKi !< control mode {0:none; 1: Semi-Active Control Mode; 2: Active Control Mode;} [-] + INTEGER(IntKi) :: StC_SA_MODE = 0_IntKi !< Semi-Active control mode {1: velocity-based ground hook control; 2: Inverse velocity-based ground hook control; 3: displacement-based ground hook control 4: Phase difference Algorithm with Friction Force 5: Phase difference Algorithm with Damping Force} [-] + INTEGER(IntKi) :: StC_DOF_MODE = 0_IntKi !< DOF mode {0: NO StC_DOF; 1: StC_X_DOF and StC_Y_DOF; 2: StC_XY_DOF; 3: TLCD; 4: Prescribed force/moment time series} [-] + LOGICAL :: StC_X_DOF = .false. !< DOF on or off [-] + LOGICAL :: StC_Y_DOF = .false. !< DOF on or off [-] + LOGICAL :: StC_Z_DOF = .false. !< DOF on or off [-] + REAL(ReKi) :: StC_X_DSP = 0.0_ReKi !< StC_X initial displacement [m] + REAL(ReKi) :: StC_Y_DSP = 0.0_ReKi !< StC_Y initial displacement [m] + REAL(ReKi) :: StC_Z_DSP = 0.0_ReKi !< StC_Z initial displacement [m] + Character(10) :: StC_Z_PreLdC = '' !< StC_Z spring preload [N] + REAL(ReKi) :: StC_X_M = 0.0_ReKi !< StC X mass [kg] + REAL(ReKi) :: StC_Y_M = 0.0_ReKi !< StC Y mass [kg] + REAL(ReKi) :: StC_Z_M = 0.0_ReKi !< StC Z mass [kg] + REAL(ReKi) :: StC_XY_M = 0.0_ReKi !< StC XY mass [kg] + REAL(ReKi) :: StC_X_K = 0.0_ReKi !< StC X stiffness [N/m] + REAL(ReKi) :: StC_Y_K = 0.0_ReKi !< StC Y stiffness [N/m] + REAL(ReKi) :: StC_Z_K = 0.0_ReKi !< StC Y stiffness [N/m] + REAL(ReKi) :: StC_X_C = 0.0_ReKi !< StC X damping [N/(m/s)] + REAL(ReKi) :: StC_Y_C = 0.0_ReKi !< StC Y damping [N/(m/s)] + REAL(ReKi) :: StC_Z_C = 0.0_ReKi !< StC Z damping [N/(m/s)] + REAL(ReKi) :: StC_X_PSP = 0.0_ReKi !< Positive stop position (maximum X mass displacement) [m] + REAL(ReKi) :: StC_X_NSP = 0.0_ReKi !< Negative stop position (minimum X mass displacement) [m] + REAL(ReKi) :: StC_Y_PSP = 0.0_ReKi !< Positive stop position (maximum Y mass displacement) [m] + REAL(ReKi) :: StC_Y_NSP = 0.0_ReKi !< Negative stop position (minimum Y mass displacement) [m] + REAL(ReKi) :: StC_Z_PSP = 0.0_ReKi !< Positive stop position (maximum Z mass displacement) [m] + REAL(ReKi) :: StC_Z_NSP = 0.0_ReKi !< Negative stop position (minimum Z mass displacement) [m] + REAL(ReKi) :: StC_X_KS = 0.0_ReKi !< Stop spring X stiffness [N/m] + REAL(ReKi) :: StC_X_CS = 0.0_ReKi !< Stop spring X damping [N/(m/s)] + REAL(ReKi) :: StC_Y_KS = 0.0_ReKi !< Stop spring Y stiffness [N/m] + REAL(ReKi) :: StC_Y_CS = 0.0_ReKi !< Stop spring Y damping [N/(m/s)] + REAL(ReKi) :: StC_Z_KS = 0.0_ReKi !< Stop spring Z stiffness [used only when StC_DOF_MODE=1 and StC_Z_DOF=TRUE] [N/m] + REAL(ReKi) :: StC_Z_CS = 0.0_ReKi !< Stop spring Z damping [used only when StC_DOF_MODE=1 and StC_Z_DOF=TRUE] [N/(m/s)] + REAL(ReKi) :: StC_P_X = 0.0_ReKi !< StC X initial displacement (m) [relative to at rest position] [m] + REAL(ReKi) :: StC_P_Y = 0.0_ReKi !< StC Y initial displacement (m) [relative to at rest position] [m] + REAL(ReKi) :: StC_P_Z = 0.0_ReKi !< StC Z initial displacement (m) [relative to at rest position; used only when StC_DOF_MODE=1 and StC_Z_DOF=TRUE] [m] + REAL(ReKi) :: StC_X_C_HIGH = 0.0_ReKi !< StC X high damping for ground hook control [N/(m/s)] + REAL(ReKi) :: StC_X_C_LOW = 0.0_ReKi !< StC X low damping for ground hook control [N/(m/s)] + REAL(ReKi) :: StC_Y_C_HIGH = 0.0_ReKi !< StC Y high damping for ground hook control [N/(m/s)] + REAL(ReKi) :: StC_Y_C_LOW = 0.0_ReKi !< StC Y low damping for ground hook control [N/(m/s)] + REAL(ReKi) :: StC_Z_C_HIGH = 0.0_ReKi !< StC Z high damping for ground hook control [N/(m/s)] + REAL(ReKi) :: StC_Z_C_LOW = 0.0_ReKi !< StC Z low damping for ground hook control [N/(m/s)] + REAL(ReKi) :: StC_X_C_BRAKE = 0.0_ReKi !< StC X high damping for braking the StC [N/(m/s)] + REAL(ReKi) :: StC_Y_C_BRAKE = 0.0_ReKi !< StC Y high damping for braking the StC [N/(m/s)] + REAL(ReKi) :: StC_Z_C_BRAKE = 0.0_ReKi !< StC Z high damping for braking the StC [N/(m/s)] + REAL(ReKi) :: L_X = 0.0_ReKi !< X TLCD total length [m] + REAL(ReKi) :: B_X = 0.0_ReKi !< X TLCD horizontal length [m] + REAL(ReKi) :: area_X = 0.0_ReKi !< X TLCD cross-sectional area of vertical column [m^2] + REAL(ReKi) :: area_ratio_X = 0.0_ReKi !< X TLCD cross-sectional area ratio (vertical column area divided by horizontal column area) [-] + REAL(ReKi) :: headLossCoeff_X = 0.0_ReKi !< X TLCD head loss coeff [-] + REAL(ReKi) :: rho_X = 0.0_ReKi !< X TLCD liquid density [kg/m^3] + REAL(ReKi) :: L_Y = 0.0_ReKi !< Y TLCD total length [m] + REAL(ReKi) :: B_Y = 0.0_ReKi !< Y TLCD horizontal length [m] + REAL(ReKi) :: area_Y = 0.0_ReKi !< Side-Side TLCD cross-sectional area of vertical column [m] + REAL(ReKi) :: area_ratio_Y = 0.0_ReKi !< Side-Side TLCD cross-sectional area ratio (vertical column area divided by horizontal column area) [-] + REAL(ReKi) :: headLossCoeff_Y = 0.0_ReKi !< Side-Side TLCD head loss coeff [-] + REAL(ReKi) :: rho_Y = 0.0_ReKi !< Side-Side TLCD liquid density [kg/m^3] + LOGICAL :: USE_F_TBL = .false. !< use spring force from user-defined table (flag) [-] + INTEGER(IntKi) :: NKInpSt = 0_IntKi !< Number of input spring force rows in table [-] + CHARACTER(1024) :: StC_F_TBL_FILE = '' !< user-defined spring table filename [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: F_TBL !< user-defined spring force [N] - INTEGER(IntKi) :: PrescribedForcesCoordSys !< Prescribed forces coordinate system {0: global; 1: local} [-] - CHARACTER(1024) :: PrescribedForcesFile !< Prescribed force time-series filename [-] + INTEGER(IntKi) :: PrescribedForcesCoordSys = 0_IntKi !< Prescribed forces coordinate system {0: global; 1: local} [-] + CHARACTER(1024) :: PrescribedForcesFile = '' !< Prescribed force time-series filename [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: StC_PrescribedForce !< StC prescribed force time-series info [(s,N,N-m)] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: StC_CChan !< StC control chan to use -- one per instance [-] END TYPE StC_InputFile ! ======================= ! ========= StC_InitInputType ======= TYPE, PUBLIC :: StC_InitInputType - CHARACTER(1024) :: InputFile !< Name of the input file; remove if there is no file [-] - CHARACTER(1024) :: RootName !< RootName for writing output files [-] - REAL(ReKi) , DIMENSION(1:3) :: Gravity !< Gravitational acceleration vector [m/s^2] - INTEGER(IntKi) :: NumMeshPts !< Number of mesh points [-] + CHARACTER(1024) :: InputFile = '' !< Name of the input file; remove if there is no file [-] + CHARACTER(1024) :: RootName = '' !< RootName for writing output files [-] + REAL(ReKi) , DIMENSION(1:3) :: Gravity = 0.0_ReKi !< Gravitational acceleration vector [m/s^2] + INTEGER(IntKi) :: NumMeshPts = 0_IntKi !< Number of mesh points [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: InitRefPos !< X-Y-Z reference position of point: i.e. each blade root (3 x NumBlades) [m] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: InitTransDisp !< X-Y-Z displacement from position of point at init: i.e. each blade root (3 x NumBlades) [m] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: InitOrient !< DCM orientation of point at init: i.e. each blade root (3x3 x NumBlades) [-] @@ -142,17 +142,17 @@ MODULE StrucCtrl_Types ! ======================= ! ========= StC_DiscreteStateType ======= TYPE, PUBLIC :: StC_DiscreteStateType - REAL(ReKi) :: DummyDiscState !< Remove this variable if you have discrete states [-] + REAL(ReKi) :: DummyDiscState = 0.0_ReKi !< Remove this variable if you have discrete states [-] END TYPE StC_DiscreteStateType ! ======================= ! ========= StC_ConstraintStateType ======= TYPE, PUBLIC :: StC_ConstraintStateType - REAL(ReKi) :: DummyConstrState !< Remove this variable if you have constraint states [-] + REAL(ReKi) :: DummyConstrState = 0.0_ReKi !< Remove this variable if you have constraint states [-] END TYPE StC_ConstraintStateType ! ======================= ! ========= StC_OtherStateType ======= TYPE, PUBLIC :: StC_OtherStateType - REAL(ReKi) :: DummyOtherState !< Remove this variable if you have other/logical states [-] + REAL(ReKi) :: DummyOtherState = 0.0_ReKi !< Remove this variable if you have other/logical states [-] END TYPE StC_OtherStateType ! ======================= ! ========= StC_MiscVarType ======= @@ -174,60 +174,60 @@ MODULE StrucCtrl_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: F_P !< StC force vector, local coordinates for point [N] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: M_P !< StC moment vector, local coordinates for point [N-m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Acc !< StC aggregated acceleration in X,Y local coordinates for point [m/s^2] - INTEGER(IntKi) :: PrescribedInterpIdx !< Index for interpolation of Prescribed force array [-] + INTEGER(IntKi) :: PrescribedInterpIdx = 0_IntKi !< Index for interpolation of Prescribed force array [-] END TYPE StC_MiscVarType ! ======================= ! ========= StC_ParameterType ======= TYPE, PUBLIC :: StC_ParameterType - REAL(DbKi) :: DT !< Time step for cont. state integration & disc. state update [seconds] - CHARACTER(1024) :: RootName !< RootName for writing output files [-] - INTEGER(IntKi) :: StC_DOF_MODE !< DOF mode {0: NO StC_DOF; 1: StC_X_DOF and StC_Y_DOF; 2: StC_XY_DOF; 3: TLCD; 4: Prescribed force/moment time series} [-] - LOGICAL :: StC_X_DOF !< DOF on or off [-] - LOGICAL :: StC_Y_DOF !< DOF on or off [-] - LOGICAL :: StC_Z_DOF !< DOF on or off [-] - REAL(ReKi) :: StC_Z_PreLd !< StC_Z spring preload [N] - REAL(ReKi) :: M_X !< StC mass [kg] - REAL(ReKi) :: M_Y !< StC mass [kg] - REAL(ReKi) :: M_Z !< StC mass [kg] - REAL(ReKi) :: M_XY !< StCXY mass [kg] - REAL(ReKi) :: K_X !< StC stiffness [N/m] - REAL(ReKi) :: K_Y !< StC stiffness [N/m] - REAL(ReKi) :: K_Z !< StC stiffness [N/m] - REAL(ReKi) :: C_X !< StC damping [N/(m/s)] - REAL(ReKi) :: C_Y !< StC damping [N/(m/s)] - REAL(ReKi) :: C_Z !< StC damping [N/(m/s)] - REAL(ReKi) , DIMENSION(1:3) :: K_S !< StC stop stiffness [N/m] - REAL(ReKi) , DIMENSION(1:3) :: C_S !< StC stop damping [N/(m/s)] - REAL(ReKi) , DIMENSION(1:3) :: P_SP !< Positive stop position (maximum mass displacement) [m] - REAL(ReKi) , DIMENSION(1:3) :: N_SP !< Negative stop position (minimum X mass displacement) [m] - REAL(ReKi) , DIMENSION(1:3) :: Gravity !< Gravitational acceleration vector [m/s^2] - INTEGER(IntKi) :: StC_CMODE !< control mode {0:none; 1: Semi-Active Control Mode; 4: Active Control Mode through Simulink (not available); 5: Active Control Mode through Bladed interface} [-] - INTEGER(IntKi) :: StC_SA_MODE !< Semi-Active control mode {1: velocity-based ground hook control; 2: Inverse velocity-based ground hook control; 3: displacement-based ground hook control 4: Phase difference Algorithm with Friction Force 5: Phase difference Algorithm with Damping Force} [-] - REAL(ReKi) :: StC_X_C_HIGH !< StC X high damping for ground hook control [N/(m/s)] - REAL(ReKi) :: StC_X_C_LOW !< StC X low damping for ground hook control [N/(m/s)] - REAL(ReKi) :: StC_Y_C_HIGH !< StC Y high damping for ground hook control [N/(m/s)] - REAL(ReKi) :: StC_Y_C_LOW !< StC Y low damping for ground hook control [N/(m/s)] - REAL(ReKi) :: StC_Z_C_HIGH !< StC Z high damping for ground hook control [N/(m/s)] - REAL(ReKi) :: StC_Z_C_LOW !< StC Z low damping for ground hook control [N/(m/s)] - REAL(ReKi) :: StC_X_C_BRAKE !< StC X high damping for braking the StC [N/(m/s)] - REAL(ReKi) :: StC_Y_C_BRAKE !< StC Y high damping for braking the StC [N/(m/s)] - REAL(ReKi) :: StC_Z_C_BRAKE !< StC Y high damping for braking the StC [N/(m/s)] - REAL(ReKi) :: L_X !< X TLCD total length [m] - REAL(ReKi) :: B_X !< X TLCD horizontal length [m] - REAL(ReKi) :: area_X !< X TLCD cross-sectional area of vertical column [m^2] - REAL(ReKi) :: area_ratio_X !< X TLCD cross-sectional area ratio (vertical column area divided by horizontal column area) [-] - REAL(ReKi) :: headLossCoeff_X !< X TLCD head loss coeff [-] - REAL(ReKi) :: rho_X !< X TLCD liquid density [kg/m^3] - REAL(ReKi) :: L_Y !< Y TLCD total length [m] - REAL(ReKi) :: B_Y !< Y TLCD horizontal length [m] - REAL(ReKi) :: area_Y !< Side-Side TLCD cross-sectional area of vertical column [m] - REAL(ReKi) :: area_ratio_Y !< Side-Side TLCD cross-sectional area ratio (vertical column area divided by horizontal column area) [-] - REAL(ReKi) :: headLossCoeff_Y !< Side-Side TLCD head loss coeff [-] - REAL(ReKi) :: rho_Y !< Side-Side TLCD liquid density [kg/m^3] - LOGICAL :: Use_F_TBL !< use spring force from user-defined table (flag) [-] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for cont. state integration & disc. state update [seconds] + CHARACTER(1024) :: RootName = '' !< RootName for writing output files [-] + INTEGER(IntKi) :: StC_DOF_MODE = 0_IntKi !< DOF mode {0: NO StC_DOF; 1: StC_X_DOF and StC_Y_DOF; 2: StC_XY_DOF; 3: TLCD; 4: Prescribed force/moment time series} [-] + LOGICAL :: StC_X_DOF = .false. !< DOF on or off [-] + LOGICAL :: StC_Y_DOF = .false. !< DOF on or off [-] + LOGICAL :: StC_Z_DOF = .false. !< DOF on or off [-] + REAL(ReKi) :: StC_Z_PreLd = 0.0_ReKi !< StC_Z spring preload [N] + REAL(ReKi) :: M_X = 0.0_ReKi !< StC mass [kg] + REAL(ReKi) :: M_Y = 0.0_ReKi !< StC mass [kg] + REAL(ReKi) :: M_Z = 0.0_ReKi !< StC mass [kg] + REAL(ReKi) :: M_XY = 0.0_ReKi !< StCXY mass [kg] + REAL(ReKi) :: K_X = 0.0_ReKi !< StC stiffness [N/m] + REAL(ReKi) :: K_Y = 0.0_ReKi !< StC stiffness [N/m] + REAL(ReKi) :: K_Z = 0.0_ReKi !< StC stiffness [N/m] + REAL(ReKi) :: C_X = 0.0_ReKi !< StC damping [N/(m/s)] + REAL(ReKi) :: C_Y = 0.0_ReKi !< StC damping [N/(m/s)] + REAL(ReKi) :: C_Z = 0.0_ReKi !< StC damping [N/(m/s)] + REAL(ReKi) , DIMENSION(1:3) :: K_S = 0.0_ReKi !< StC stop stiffness [N/m] + REAL(ReKi) , DIMENSION(1:3) :: C_S = 0.0_ReKi !< StC stop damping [N/(m/s)] + REAL(ReKi) , DIMENSION(1:3) :: P_SP = 0.0_ReKi !< Positive stop position (maximum mass displacement) [m] + REAL(ReKi) , DIMENSION(1:3) :: N_SP = 0.0_ReKi !< Negative stop position (minimum X mass displacement) [m] + REAL(ReKi) , DIMENSION(1:3) :: Gravity = 0.0_ReKi !< Gravitational acceleration vector [m/s^2] + INTEGER(IntKi) :: StC_CMODE = 0_IntKi !< control mode {0:none; 1: Semi-Active Control Mode; 4: Active Control Mode through Simulink (not available); 5: Active Control Mode through Bladed interface} [-] + INTEGER(IntKi) :: StC_SA_MODE = 0_IntKi !< Semi-Active control mode {1: velocity-based ground hook control; 2: Inverse velocity-based ground hook control; 3: displacement-based ground hook control 4: Phase difference Algorithm with Friction Force 5: Phase difference Algorithm with Damping Force} [-] + REAL(ReKi) :: StC_X_C_HIGH = 0.0_ReKi !< StC X high damping for ground hook control [N/(m/s)] + REAL(ReKi) :: StC_X_C_LOW = 0.0_ReKi !< StC X low damping for ground hook control [N/(m/s)] + REAL(ReKi) :: StC_Y_C_HIGH = 0.0_ReKi !< StC Y high damping for ground hook control [N/(m/s)] + REAL(ReKi) :: StC_Y_C_LOW = 0.0_ReKi !< StC Y low damping for ground hook control [N/(m/s)] + REAL(ReKi) :: StC_Z_C_HIGH = 0.0_ReKi !< StC Z high damping for ground hook control [N/(m/s)] + REAL(ReKi) :: StC_Z_C_LOW = 0.0_ReKi !< StC Z low damping for ground hook control [N/(m/s)] + REAL(ReKi) :: StC_X_C_BRAKE = 0.0_ReKi !< StC X high damping for braking the StC [N/(m/s)] + REAL(ReKi) :: StC_Y_C_BRAKE = 0.0_ReKi !< StC Y high damping for braking the StC [N/(m/s)] + REAL(ReKi) :: StC_Z_C_BRAKE = 0.0_ReKi !< StC Y high damping for braking the StC [N/(m/s)] + REAL(ReKi) :: L_X = 0.0_ReKi !< X TLCD total length [m] + REAL(ReKi) :: B_X = 0.0_ReKi !< X TLCD horizontal length [m] + REAL(ReKi) :: area_X = 0.0_ReKi !< X TLCD cross-sectional area of vertical column [m^2] + REAL(ReKi) :: area_ratio_X = 0.0_ReKi !< X TLCD cross-sectional area ratio (vertical column area divided by horizontal column area) [-] + REAL(ReKi) :: headLossCoeff_X = 0.0_ReKi !< X TLCD head loss coeff [-] + REAL(ReKi) :: rho_X = 0.0_ReKi !< X TLCD liquid density [kg/m^3] + REAL(ReKi) :: L_Y = 0.0_ReKi !< Y TLCD total length [m] + REAL(ReKi) :: B_Y = 0.0_ReKi !< Y TLCD horizontal length [m] + REAL(ReKi) :: area_Y = 0.0_ReKi !< Side-Side TLCD cross-sectional area of vertical column [m] + REAL(ReKi) :: area_ratio_Y = 0.0_ReKi !< Side-Side TLCD cross-sectional area ratio (vertical column area divided by horizontal column area) [-] + REAL(ReKi) :: headLossCoeff_Y = 0.0_ReKi !< Side-Side TLCD head loss coeff [-] + REAL(ReKi) :: rho_Y = 0.0_ReKi !< Side-Side TLCD liquid density [kg/m^3] + LOGICAL :: Use_F_TBL = .false. !< use spring force from user-defined table (flag) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: F_TBL !< user-defined spring force [N] - INTEGER(IntKi) :: NumMeshPts !< Number of mesh points [-] - INTEGER(IntKi) :: PrescribedForcesCoordSys !< Prescribed forces coordinate system {0: global; 1: local} [-] + INTEGER(IntKi) :: NumMeshPts = 0_IntKi !< Number of mesh points [-] + INTEGER(IntKi) :: PrescribedForcesCoordSys = 0_IntKi !< Prescribed forces coordinate system {0: global; 1: local} [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: StC_PrescribedForce !< StC prescribed force time-series info [(s,N,N-m)] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: StC_CChan !< StC control chan to use [-] END TYPE StC_ParameterType diff --git a/modules/subdyn/src/SubDyn_Types.f90 b/modules/subdyn/src/SubDyn_Types.f90 index 6fc2a930a0..f7ac914585 100644 --- a/modules/subdyn/src/SubDyn_Types.f90 +++ b/modules/subdyn/src/SubDyn_Types.f90 @@ -40,8 +40,8 @@ MODULE SubDyn_Types ! ======================= ! ========= MeshAuxDataType ======= TYPE, PUBLIC :: MeshAuxDataType - INTEGER(IntKi) :: MemberID !< Member ID for Output [-] - INTEGER(IntKi) :: NOutCnt !< Number of Nodes for the output member [-] + INTEGER(IntKi) :: MemberID = 0_IntKi !< Member ID for Output [-] + INTEGER(IntKi) :: NOutCnt = 0_IntKi !< Number of Nodes for the output member [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NodeCnt !< Node ordinal numbers for the output member [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NodeIDs !< Node IDs associated with ordinal numbers for the output member [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: ElmIDs !< Element IDs connected to each NodeIDs; max 10 elements [-] @@ -63,31 +63,31 @@ MODULE SubDyn_Types ! ======================= ! ========= ElemPropType ======= TYPE, PUBLIC :: ElemPropType - INTEGER(IntKi) :: eType !< Element Type [-] - REAL(ReKi) :: Length !< Length of an element [-] - REAL(ReKi) :: Ixx !< Moment of inertia of an element [-] - REAL(ReKi) :: Iyy !< Moment of inertia of an element [-] - REAL(ReKi) :: Jzz !< Moment of inertia of an element [-] - LOGICAL :: Shear !< Use timoshenko (true) E-B (false) [-] - REAL(ReKi) :: Kappa_x !< Shear coefficient [-] - REAL(ReKi) :: Kappa_y !< Shear coefficient [-] - REAL(ReKi) :: YoungE !< Young's modulus [-] - REAL(ReKi) :: ShearG !< Shear modulus [N/m^2] - REAL(ReKi) , DIMENSION(1:2) :: D !< Diameter at node 1 and 2, for visualization only [m] - REAL(ReKi) :: Area !< Area of an element [m^2] - REAL(ReKi) :: Rho !< Density [kg/m^3] - REAL(ReKi) :: T0 !< Pretension [N] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: DirCos !< Element direction cosine matrix [-] + INTEGER(IntKi) :: eType = 0_IntKi !< Element Type [-] + REAL(ReKi) :: Length = 0.0_ReKi !< Length of an element [-] + REAL(ReKi) :: Ixx = 0.0_ReKi !< Moment of inertia of an element [-] + REAL(ReKi) :: Iyy = 0.0_ReKi !< Moment of inertia of an element [-] + REAL(ReKi) :: Jzz = 0.0_ReKi !< Moment of inertia of an element [-] + LOGICAL :: Shear = .false. !< Use timoshenko (true) E-B (false) [-] + REAL(ReKi) :: Kappa_x = 0.0_ReKi !< Shear coefficient [-] + REAL(ReKi) :: Kappa_y = 0.0_ReKi !< Shear coefficient [-] + REAL(ReKi) :: YoungE = 0.0_ReKi !< Young's modulus [-] + REAL(ReKi) :: ShearG = 0.0_ReKi !< Shear modulus [N/m^2] + REAL(ReKi) , DIMENSION(1:2) :: D = 0.0_ReKi !< Diameter at node 1 and 2, for visualization only [m] + REAL(ReKi) :: Area = 0.0_ReKi !< Area of an element [m^2] + REAL(ReKi) :: Rho = 0.0_ReKi !< Density [kg/m^3] + REAL(ReKi) :: T0 = 0.0_ReKi !< Pretension [N] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: DirCos = 0.0_R8Ki !< Element direction cosine matrix [-] END TYPE ElemPropType ! ======================= ! ========= SD_InitInputType ======= TYPE, PUBLIC :: SD_InitInputType - CHARACTER(1024) :: SDInputFile !< Name of the input file [-] - CHARACTER(1024) :: RootName !< SubDyn rootname [-] - REAL(ReKi) :: g !< Gravity acceleration [-] - REAL(ReKi) :: WtrDpth !< Water Depth (positive valued) [-] - REAL(ReKi) , DIMENSION(1:3) :: TP_RefPoint !< global position of transition piece reference point (could also be defined in SubDyn itself) [-] - REAL(ReKi) :: SubRotateZ !< Rotation angle in degrees about global Z [-] + CHARACTER(1024) :: SDInputFile = '' !< Name of the input file [-] + CHARACTER(1024) :: RootName = '' !< SubDyn rootname [-] + REAL(ReKi) :: g = 0.0_ReKi !< Gravity acceleration [-] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water Depth (positive valued) [-] + REAL(ReKi) , DIMENSION(1:3) :: TP_RefPoint = 0.0_ReKi !< global position of transition piece reference point (could also be defined in SubDyn itself) [-] + REAL(ReKi) :: SubRotateZ = 0.0_ReKi !< Rotation angle in degrees about global Z [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: SoilStiffness !< Soil stiffness matrices from SoilDyn ['(N/m,] TYPE(MeshType) :: SoilMesh !< Mesh for soil stiffness locations [-] LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] @@ -111,21 +111,21 @@ MODULE SubDyn_Types ! ======================= ! ========= SD_InitType ======= TYPE, PUBLIC :: SD_InitType - CHARACTER(1024) :: RootName !< SubDyn rootname [-] - REAL(ReKi) , DIMENSION(1:3) :: TP_RefPoint !< global position of transition piece reference point (could also be defined in SubDyn itself) [-] - REAL(ReKi) :: SubRotateZ !< Rotation angle in degrees about global Z [-] - REAL(ReKi) :: g !< Gravity acceleration [-] - REAL(DbKi) :: DT !< Time step from Glue Code [seconds] - INTEGER(IntKi) :: NJoints !< Number of joints of the sub structure [-] - INTEGER(IntKi) :: NPropSetsX !< Number of extended property sets [-] - INTEGER(IntKi) :: NPropSetsB !< Number of property sets for beams [-] - INTEGER(IntKi) :: NPropSetsC !< Number of property sets for cables [-] - INTEGER(IntKi) :: NPropSetsR !< Number of property sets for rigid links [-] - INTEGER(IntKi) :: NCMass !< Number of joints with concentrated mass [-] - INTEGER(IntKi) :: NCOSMs !< Number of independent cosine matrices [-] - INTEGER(IntKi) :: FEMMod !< FEM switch element model in the FEM [-] - INTEGER(IntKi) :: NDiv !< Number of divisions for each member [-] - LOGICAL :: CBMod !< Perform C-B flag [-] + CHARACTER(1024) :: RootName = '' !< SubDyn rootname [-] + REAL(ReKi) , DIMENSION(1:3) :: TP_RefPoint = 0.0_ReKi !< global position of transition piece reference point (could also be defined in SubDyn itself) [-] + REAL(ReKi) :: SubRotateZ = 0.0_ReKi !< Rotation angle in degrees about global Z [-] + REAL(ReKi) :: g = 0.0_ReKi !< Gravity acceleration [-] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step from Glue Code [seconds] + INTEGER(IntKi) :: NJoints = 0_IntKi !< Number of joints of the sub structure [-] + INTEGER(IntKi) :: NPropSetsX = 0_IntKi !< Number of extended property sets [-] + INTEGER(IntKi) :: NPropSetsB = 0_IntKi !< Number of property sets for beams [-] + INTEGER(IntKi) :: NPropSetsC = 0_IntKi !< Number of property sets for cables [-] + INTEGER(IntKi) :: NPropSetsR = 0_IntKi !< Number of property sets for rigid links [-] + INTEGER(IntKi) :: NCMass = 0_IntKi !< Number of joints with concentrated mass [-] + INTEGER(IntKi) :: NCOSMs = 0_IntKi !< Number of independent cosine matrices [-] + INTEGER(IntKi) :: FEMMod = 0_IntKi !< FEM switch element model in the FEM [-] + INTEGER(IntKi) :: NDiv = 0_IntKi !< Number of divisions for each member [-] + LOGICAL :: CBMod = .false. !< Perform C-B flag [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Joints !< Joints number and coordinate values [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PropSetsB !< Property sets number and values [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PropSetsC !< Property ID and values for cables [-] @@ -134,23 +134,23 @@ MODULE SubDyn_Types REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: COSMs !< Independent direction cosine matrices [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CMass !< Concentrated mass information [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: JDampings !< Damping coefficients for internal modes [-] - INTEGER(IntKi) :: GuyanDampMod !< Guyan damping [0=none, 1=Rayleigh Damping, 2= user specified 6x6 matrix] [-] - REAL(ReKi) , DIMENSION(1:2) :: RayleighDamp !< Mass and stiffness proportional damping coefficients (Rayleigh Damping) [only if GuyanDampMod=1] [-] - REAL(ReKi) , DIMENSION(1:6,1:6) :: GuyanDampMat !< Guyan Damping Matrix, see also CBB [-] + INTEGER(IntKi) :: GuyanDampMod = 0_IntKi !< Guyan damping [0=none, 1=Rayleigh Damping, 2= user specified 6x6 matrix] [-] + REAL(ReKi) , DIMENSION(1:2) :: RayleighDamp = 0.0_ReKi !< Mass and stiffness proportional damping coefficients (Rayleigh Damping) [only if GuyanDampMod=1] [-] + REAL(ReKi) , DIMENSION(1:6,1:6) :: GuyanDampMat = 0.0_ReKi !< Guyan Damping Matrix, see also CBB [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Members !< Member joints connection [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: SSOutList !< List of Output Channels [-] - LOGICAL :: OutCOSM !< Output Cos-matrices Flag [-] - LOGICAL :: TabDelim !< Generate a tab-delimited output file in OutJckF-Flag [-] + LOGICAL :: OutCOSM = .false. !< Output Cos-matrices Flag [-] + LOGICAL :: TabDelim = .false. !< Generate a tab-delimited output file in OutJckF-Flag [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: SSIK !< SSI stiffness packed matrix elements (21 of them), for each reaction joint [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: SSIM !< SSI mass packed matrix elements (21 of them), for each reaction joint [-] CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: SSIfile !< Soil Structure Interaction (SSI) files to associate with each reaction node [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Soil_K !< Soil stiffness (at passed at Init, not in input file) 6x6xn [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Soil_Points !< Node positions where soil stiffness will be added [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: Soil_Nodes !< Node indices where soil stiffness will be added [-] - INTEGER(IntKi) :: NElem !< Total number of elements [-] - INTEGER(IntKi) :: NPropB !< Total number of property sets for Beams [-] - INTEGER(IntKi) :: NPropC !< Total number of property sets for Cable [-] - INTEGER(IntKi) :: NPropR !< Total number of property sets for Rigid [-] + INTEGER(IntKi) :: NElem = 0_IntKi !< Total number of elements [-] + INTEGER(IntKi) :: NPropB = 0_IntKi !< Total number of property sets for Beams [-] + INTEGER(IntKi) :: NPropC = 0_IntKi !< Total number of property sets for Cable [-] + INTEGER(IntKi) :: NPropR = 0_IntKi !< Total number of property sets for Rigid [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Nodes !< Nodes number and coordinates [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PropsB !< Property sets and values for Beams [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PropsC !< Property sets and values for Cable [-] @@ -161,7 +161,7 @@ MODULE SubDyn_Types INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: MemberNodes !< Member number and list of nodes making up a member (>2 if subdivided) [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: NodesConnN !< Nodes that connect to a common node [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: NodesConnE !< Elements that connect to a common node [-] - LOGICAL :: SSSum !< SubDyn Summary File Flag [-] + LOGICAL :: SSSum = .false. !< SubDyn Summary File Flag [-] END TYPE SD_InitType ! ======================= ! ========= SD_ContinuousStateType ======= @@ -172,26 +172,26 @@ MODULE SubDyn_Types ! ======================= ! ========= SD_DiscreteStateType ======= TYPE, PUBLIC :: SD_DiscreteStateType - REAL(ReKi) :: DummyDiscState !< Remove this variable if you have discrete states [-] + REAL(ReKi) :: DummyDiscState = 0.0_ReKi !< Remove this variable if you have discrete states [-] END TYPE SD_DiscreteStateType ! ======================= ! ========= SD_ConstraintStateType ======= TYPE, PUBLIC :: SD_ConstraintStateType - REAL(ReKi) :: DummyConstrState !< Remove this variable if you have constraint states [-] + REAL(ReKi) :: DummyConstrState = 0.0_ReKi !< Remove this variable if you have constraint states [-] END TYPE SD_ConstraintStateType ! ======================= ! ========= SD_OtherStateType ======= TYPE, PUBLIC :: SD_OtherStateType TYPE(SD_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: xdot !< previous state derivs for m-step time integrator [-] - INTEGER(IntKi) :: n !< tracks time step for which OtherState was updated last [-] + INTEGER(IntKi) :: n = 0_IntKi !< tracks time step for which OtherState was updated last [-] END TYPE SD_OtherStateType ! ======================= ! ========= SD_MiscVarType ======= TYPE, PUBLIC :: SD_MiscVarType REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: qmdotdot !< 2nd Derivative of states, used only for output-file purposes [-] - REAL(ReKi) , DIMENSION(1:6) :: u_TP - REAL(ReKi) , DIMENSION(1:6) :: udot_TP - REAL(ReKi) , DIMENSION(1:6) :: udotdot_TP + REAL(ReKi) , DIMENSION(1:6) :: u_TP = 0.0_ReKi + REAL(ReKi) , DIMENSION(1:6) :: udot_TP = 0.0_ReKi + REAL(ReKi) , DIMENSION(1:6) :: udotdot_TP = 0.0_ReKi REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_L !< Loads on internal DOF, size nL [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: F_L2 !< Loads on internal DOF, size nL, used for SIM and ADM4 [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UR_bar @@ -211,8 +211,8 @@ MODULE SubDyn_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FC_unit !< Cable Force vector (for varying cable load, of unit cable load) [N] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SDWrOutput !< Data from previous step to be written to a SubDyn output file [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AllOuts !< Data for output file [-] - REAL(DbKi) :: LastOutTime !< The time of the most recent stored output data [s] - INTEGER(IntKi) :: Decimat !< Current output decimation counter [-] + REAL(DbKi) :: LastOutTime = 0.0_R8Ki !< The time of the most recent stored output data [s] + INTEGER(IntKi) :: Decimat = 0_IntKi !< Current output decimation counter [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Fext !< External loads on unconstrained DOFs [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Fext_red !< External loads on constrained DOFs, Fext_red= T^t Fext [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: UL_SIM !< UL for SIM = PhiL qL0- PhiM qm0, size nL [-] @@ -221,17 +221,17 @@ MODULE SubDyn_Types ! ======================= ! ========= SD_ParameterType ======= TYPE, PUBLIC :: SD_ParameterType - REAL(DbKi) :: SDDeltaT !< Time step (for integration of continuous states) [seconds] - INTEGER(IntKi) :: IntMethod !< Integration Method (1/2/3)Length of y2 array [-] - INTEGER(IntKi) :: nDOF !< Total degree of freedom [-] - INTEGER(IntKi) :: nDOF_red !< Total degree of freedom after constraint reduction [-] - INTEGER(IntKi) :: Nmembers !< Number of members of the sub structure [-] + REAL(DbKi) :: SDDeltaT = 0.0_R8Ki !< Time step (for integration of continuous states) [seconds] + INTEGER(IntKi) :: IntMethod = 0_IntKi !< Integration Method (1/2/3)Length of y2 array [-] + INTEGER(IntKi) :: nDOF = 0_IntKi !< Total degree of freedom [-] + INTEGER(IntKi) :: nDOF_red = 0_IntKi !< Total degree of freedom after constraint reduction [-] + INTEGER(IntKi) :: Nmembers = 0_IntKi !< Number of members of the sub structure [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Elems !< Element nodes connections [-] TYPE(ElemPropType) , DIMENSION(:), ALLOCATABLE :: ElemProps !< List of element properties [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: FG !< Gravity force vector (with initial cable force T0), not reduced [N] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: DP0 !< Vector from TP to a Node at t=0, used for Floating Rigid Body motion [m] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NodeID2JointID !< Store Joint ID for each NodeID since SubDyn re-label nodes (and add more nodes) [-] - LOGICAL :: reduced !< True if system has been reduced to account for constraints [-] + LOGICAL :: reduced = .false. !< True if system has been reduced to account for constraints [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: T_red !< Transformation matrix performing the constraint reduction x = T. xtilde [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: T_red_T !< Transpose of T_red [-] TYPE(IList) , DIMENSION(:), ALLOCATABLE :: NodesDOF !< DOF indices of each nodes in unconstrained assembled system [-] @@ -239,10 +239,10 @@ MODULE SubDyn_Types INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: ElemsDOF !< 12 DOF indices of node 1 and 2 of a given member in unconstrained assembled system [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: DOFred2Nodes !< nDOFRed x 3, for each constrained DOF, col1 node index, col2 number of DOF, col3 DOF starting from 1 [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: CtrlElem2Channel !< nCtrlCable x 2, for each CtrlCable, Elem index, and Channel Index [-] - INTEGER(IntKi) :: nDOFM !< retained degrees of freedom (modes) [-] - INTEGER(IntKi) :: SttcSolve !< Solve dynamics about static equilibrium point (flag) [-] - LOGICAL :: GuyanLoadCorrection !< Add Extra lever arm contribution to interface reaction outputs [-] - LOGICAL :: Floating !< True if floating bottom (the 6 DOF are free at all reaction nodes) [-] + INTEGER(IntKi) :: nDOFM = 0_IntKi !< retained degrees of freedom (modes) [-] + INTEGER(IntKi) :: SttcSolve = 0_IntKi !< Solve dynamics about static equilibrium point (flag) [-] + LOGICAL :: GuyanLoadCorrection = .false. !< Add Extra lever arm contribution to interface reaction outputs [-] + LOGICAL :: Floating = .false. !< True if floating bottom (the 6 DOF are free at all reaction nodes) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: KMMDiag !< Diagonal coefficients of Kmm (OmegaM squared) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: CMMDiag !< Diagonal coefficients of Cmm (~2 Zeta OmegaM)) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: MMB !< Matrix after C-B reduction (transpose of MBM [-] @@ -269,25 +269,25 @@ MODULE SubDyn_Types INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: AM2JacPiv !< Pivot array for Jacobian factorization (for Adams-Boulton 2nd order Integration) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TI !< Matrix to calculate TP reference point reaction at top of structure [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TIreact !< Matrix to calculate single point reaction at base of structure [-] - INTEGER(IntKi) :: nNodes !< Total number of nodes [-] - INTEGER(IntKi) :: nNodes_I !< Number of Interface nodes [-] - INTEGER(IntKi) :: nNodes_L !< Number of Internal nodes [-] - INTEGER(IntKi) :: nNodes_C !< Number of joints with reactions [-] + INTEGER(IntKi) :: nNodes = 0_IntKi !< Total number of nodes [-] + INTEGER(IntKi) :: nNodes_I = 0_IntKi !< Number of Interface nodes [-] + INTEGER(IntKi) :: nNodes_L = 0_IntKi !< Number of Internal nodes [-] + INTEGER(IntKi) :: nNodes_C = 0_IntKi !< Number of joints with reactions [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Nodes_I !< Interface degree of freedoms [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Nodes_L !< Internal nodes (not interface nor reaction) [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Nodes_C !< React degree of freedoms [-] - INTEGER(IntKi) :: nDOFI__ !< Size of IDI__ [-] - INTEGER(IntKi) :: nDOFI_Rb !< Size of IDI_Rb [-] - INTEGER(IntKi) :: nDOFI_F !< Size of IDI_F [-] - INTEGER(IntKi) :: nDOFL_L !< Size of IDL_L [-] - INTEGER(IntKi) :: nDOFC__ !< Size of IDC__ [-] - INTEGER(IntKi) :: nDOFC_Rb !< Size of IDC_Rb [-] - INTEGER(IntKi) :: nDOFC_L !< Size of IDC_L [-] - INTEGER(IntKi) :: nDOFC_F !< Size of IDC_F [-] - INTEGER(IntKi) :: nDOFR__ !< Size of IDR__ [-] - INTEGER(IntKi) :: nDOF__Rb !< Size of ID__Rb [-] - INTEGER(IntKi) :: nDOF__L !< Size of ID__L [-] - INTEGER(IntKi) :: nDOF__F !< Size of ID__F [-] + INTEGER(IntKi) :: nDOFI__ = 0_IntKi !< Size of IDI__ [-] + INTEGER(IntKi) :: nDOFI_Rb = 0_IntKi !< Size of IDI_Rb [-] + INTEGER(IntKi) :: nDOFI_F = 0_IntKi !< Size of IDI_F [-] + INTEGER(IntKi) :: nDOFL_L = 0_IntKi !< Size of IDL_L [-] + INTEGER(IntKi) :: nDOFC__ = 0_IntKi !< Size of IDC__ [-] + INTEGER(IntKi) :: nDOFC_Rb = 0_IntKi !< Size of IDC_Rb [-] + INTEGER(IntKi) :: nDOFC_L = 0_IntKi !< Size of IDC_L [-] + INTEGER(IntKi) :: nDOFC_F = 0_IntKi !< Size of IDC_F [-] + INTEGER(IntKi) :: nDOFR__ = 0_IntKi !< Size of IDR__ [-] + INTEGER(IntKi) :: nDOF__Rb = 0_IntKi !< Size of ID__Rb [-] + INTEGER(IntKi) :: nDOF__L = 0_IntKi !< Size of ID__L [-] + INTEGER(IntKi) :: nDOF__F = 0_IntKi !< Size of ID__F [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IDI__ !< Index of all Interface DOFs [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IDI_Rb !< Index array of the interface (nodes connect to TP) dofs that are retained/master/follower DOFs [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: IDI_F !< Index array of the interface (nodes connect to TP) dofs that are fixed DOF [-] @@ -300,30 +300,30 @@ MODULE SubDyn_Types INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ID__Rb !< Index array of all the retained/leader/master dofs (from any nodes of the structure) [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ID__L !< Index array of all the follower/internal dofs (from any nodes of the structure) [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ID__F !< Index array of the DOF that are fixed (from any nodes of the structure) [-] - INTEGER(IntKi) :: NMOutputs !< Number of members whose output is written [-] - INTEGER(IntKi) :: NumOuts !< Number of output channels read from input file [-] - INTEGER(IntKi) :: OutSwtch !< Output Requested Channels to local or global output file [1/2/3] [-] - INTEGER(IntKi) :: UnJckF !< Unit of SD ouput file [-] - CHARACTER(1) :: Delim !< Column delimiter for output text files [-] - CHARACTER(20) :: OutFmt !< Format for Output [-] - CHARACTER(20) :: OutSFmt !< Format for Output Headers [-] + INTEGER(IntKi) :: NMOutputs = 0_IntKi !< Number of members whose output is written [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of output channels read from input file [-] + INTEGER(IntKi) :: OutSwtch = 0_IntKi !< Output Requested Channels to local or global output file [1/2/3] [-] + INTEGER(IntKi) :: UnJckF = 0_IntKi !< Unit of SD ouput file [-] + CHARACTER(1) :: Delim = '' !< Column delimiter for output text files [-] + CHARACTER(20) :: OutFmt = '' !< Format for Output [-] + CHARACTER(20) :: OutSFmt = '' !< Format for Output Headers [-] TYPE(MeshAuxDataType) , DIMENSION(:), ALLOCATABLE :: MoutLst !< List of user requested members and nodes [-] TYPE(MeshAuxDataType) , DIMENSION(:), ALLOCATABLE :: MoutLst2 !< List of all member joint nodes and elements for output [-] TYPE(MeshAuxDataType) , DIMENSION(:), ALLOCATABLE :: MoutLst3 !< List of all member joint nodes and elements for output [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< An array holding names, units, and indices of all of the selected output channels. # logical [-] - LOGICAL :: OutAll !< Flag to output or not all joint forces [-] - INTEGER(IntKi) :: OutCBModes !< Flag to output CB and Guyan modes to a given format [-] - INTEGER(IntKi) :: OutFEMModes !< Flag to output FEM modes to a given format [-] - LOGICAL :: OutReact !< Flag to check whether reactions are requested [-] - INTEGER(IntKi) :: OutAllInt !< Integer version of OutAll [-] - INTEGER(IntKi) :: OutAllDims !< Integer version of OutAll [-] - INTEGER(IntKi) :: OutDec !< Output Decimation for Requested Channels [-] + LOGICAL :: OutAll = .false. !< Flag to output or not all joint forces [-] + INTEGER(IntKi) :: OutCBModes = 0_IntKi !< Flag to output CB and Guyan modes to a given format [-] + INTEGER(IntKi) :: OutFEMModes = 0_IntKi !< Flag to output FEM modes to a given format [-] + LOGICAL :: OutReact = .false. !< Flag to check whether reactions are requested [-] + INTEGER(IntKi) :: OutAllInt = 0_IntKi !< Integer version of OutAll [-] + INTEGER(IntKi) :: OutAllDims = 0_IntKi !< Integer version of OutAll [-] + INTEGER(IntKi) :: OutDec = 0_IntKi !< Output Decimation for Requested Channels [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: du !< vector that determines size of perturbation for u (inputs) [-] - REAL(R8Ki) , DIMENSION(1:2) :: dx !< vector that determines size of perturbation for x (continuous states) [-] - INTEGER(IntKi) :: Jac_ny !< number of outputs in jacobian matrix [-] - INTEGER(IntKi) :: Jac_nx !< half the number of continuous states in jacobian matrix [-] - LOGICAL :: RotStates !< Orient states in rotating frame during linearization? (flag) [-] + REAL(R8Ki) , DIMENSION(1:2) :: dx = 0.0_R8Ki !< vector that determines size of perturbation for x (continuous states) [-] + INTEGER(IntKi) :: Jac_ny = 0_IntKi !< number of outputs in jacobian matrix [-] + INTEGER(IntKi) :: Jac_nx = 0_IntKi !< half the number of continuous states in jacobian matrix [-] + LOGICAL :: RotStates = .false. !< Orient states in rotating frame during linearization? (flag) [-] END TYPE SD_ParameterType ! ======================= ! ========= SD_InputType ======= diff --git a/modules/supercontroller/src/SCDataEx_Types.f90 b/modules/supercontroller/src/SCDataEx_Types.f90 index b7339226dd..3e14b9d93f 100644 --- a/modules/supercontroller/src/SCDataEx_Types.f90 +++ b/modules/supercontroller/src/SCDataEx_Types.f90 @@ -42,9 +42,9 @@ MODULE SCDataEx_Types END TYPE SC_DX_InitInputType_C TYPE, PUBLIC :: SC_DX_InitInputType TYPE( SC_DX_InitInputType_C ) :: C_obj - INTEGER(IntKi) :: NumSC2Ctrl !< number of turbine specific controller inputs [from supercontroller] [-] - INTEGER(IntKi) :: NumSC2CtrlGlob !< number of global controller inputs [from supercontroller] [-] - INTEGER(IntKi) :: NumCtrl2SC !< number of controller outputs [to supercontroller] [-] + INTEGER(IntKi) :: NumSC2Ctrl = 0_IntKi !< number of turbine specific controller inputs [from supercontroller] [-] + INTEGER(IntKi) :: NumSC2CtrlGlob = 0_IntKi !< number of global controller inputs [from supercontroller] [-] + INTEGER(IntKi) :: NumCtrl2SC = 0_IntKi !< number of controller outputs [to supercontroller] [-] END TYPE SC_DX_InitInputType ! ======================= ! ========= SC_DX_InitOutputType_C ======= diff --git a/modules/supercontroller/src/SuperController_Types.f90 b/modules/supercontroller/src/SuperController_Types.f90 index 79c445e2a4..39dd8d6a2a 100644 --- a/modules/supercontroller/src/SuperController_Types.f90 +++ b/modules/supercontroller/src/SuperController_Types.f90 @@ -41,8 +41,8 @@ MODULE SuperController_Types END TYPE SC_InitInputType_C TYPE, PUBLIC :: SC_InitInputType TYPE( SC_InitInputType_C ) :: C_obj - INTEGER(IntKi) :: nTurbines !< Number of turbines in the simulation [-] - CHARACTER(1024) :: DLL_FileName !< Name of the shared library which the super controller logic [-] + INTEGER(IntKi) :: nTurbines = 0_IntKi !< Number of turbines in the simulation [-] + CHARACTER(1024) :: DLL_FileName = '' !< Name of the shared library which the super controller logic [-] END TYPE SC_InitInputType ! ======================= ! ========= SC_InitOutputType_C ======= @@ -56,10 +56,10 @@ MODULE SuperController_Types TYPE, PUBLIC :: SC_InitOutputType TYPE( SC_InitOutputType_C ) :: C_obj TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] - INTEGER(IntKi) :: NumCtrl2SC !< Number of turbine controller outputs [to supercontroller] [-] - INTEGER(IntKi) :: nInpGlobal !< Number of global inputs to SC [-] - INTEGER(IntKi) :: NumSC2Ctrl !< Number of turbine specific controller inputs [from supercontroller] [-] - INTEGER(IntKi) :: NumSC2CtrlGlob !< Number of global controller inputs [from supercontroller] [-] + INTEGER(IntKi) :: NumCtrl2SC = 0_IntKi !< Number of turbine controller outputs [to supercontroller] [-] + INTEGER(IntKi) :: nInpGlobal = 0_IntKi !< Number of global inputs to SC [-] + INTEGER(IntKi) :: NumSC2Ctrl = 0_IntKi !< Number of turbine specific controller inputs [from supercontroller] [-] + INTEGER(IntKi) :: NumSC2CtrlGlob = 0_IntKi !< Number of global controller inputs [from supercontroller] [-] END TYPE SC_InitOutputType ! ======================= ! ========= SC_ParameterType_C ======= @@ -82,16 +82,16 @@ MODULE SuperController_Types END TYPE SC_ParameterType_C TYPE, PUBLIC :: SC_ParameterType TYPE( SC_ParameterType_C ) :: C_obj - REAL(DbKi) :: DT !< Time step for continuous state integration & discrete state update [secondstypedef] - INTEGER(IntKi) :: nTurbines !< Number of turbines in the simulation [-] - INTEGER(IntKi) :: NumCtrl2SC !< Number of turbine controller outputs [to supercontroller] [-] - INTEGER(IntKi) :: nInpGlobal !< Number of global inputs [-] - INTEGER(IntKi) :: NumSC2Ctrl !< Number of turbine specific controller inputs [from supercontroller] [-] - INTEGER(IntKi) :: NumSC2CtrlGlob !< Number of global controller inputs [from supercontroller] [-] - INTEGER(IntKi) :: NumStatesGlobal !< Number of global states [-] - INTEGER(IntKi) :: NumStatesTurbine !< Number of states per turbine [-] - INTEGER(IntKi) :: NumParamGlobal !< Number of global parameters [-] - INTEGER(IntKi) :: NumParamTurbine !< Number of parameters per turbine [-] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for continuous state integration & discrete state update [secondstypedef] + INTEGER(IntKi) :: nTurbines = 0_IntKi !< Number of turbines in the simulation [-] + INTEGER(IntKi) :: NumCtrl2SC = 0_IntKi !< Number of turbine controller outputs [to supercontroller] [-] + INTEGER(IntKi) :: nInpGlobal = 0_IntKi !< Number of global inputs [-] + INTEGER(IntKi) :: NumSC2Ctrl = 0_IntKi !< Number of turbine specific controller inputs [from supercontroller] [-] + INTEGER(IntKi) :: NumSC2CtrlGlob = 0_IntKi !< Number of global controller inputs [from supercontroller] [-] + INTEGER(IntKi) :: NumStatesGlobal = 0_IntKi !< Number of global states [-] + INTEGER(IntKi) :: NumStatesTurbine = 0_IntKi !< Number of states per turbine [-] + INTEGER(IntKi) :: NumParamGlobal = 0_IntKi !< Number of global parameters [-] + INTEGER(IntKi) :: NumParamTurbine = 0_IntKi !< Number of parameters per turbine [-] REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: ParamGlobal => NULL() !< Global parameters [-] REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: ParamTurbine => NULL() !< Parameters per turbine [-] TYPE(DLL_Type) :: DLL_Trgt !< The addresses and names of the super controller shared library and its procedures [-] @@ -118,7 +118,7 @@ MODULE SuperController_Types END TYPE SC_ContinuousStateType_C TYPE, PUBLIC :: SC_ContinuousStateType TYPE( SC_ContinuousStateType_C ) :: C_obj - REAL(SiKi) :: Dummy !< Remove this variable if you have continuous states [-] + REAL(SiKi) :: Dummy = 0.0_R4Ki !< Remove this variable if you have continuous states [-] END TYPE SC_ContinuousStateType ! ======================= ! ========= SC_ConstraintStateType_C ======= @@ -128,7 +128,7 @@ MODULE SuperController_Types END TYPE SC_ConstraintStateType_C TYPE, PUBLIC :: SC_ConstraintStateType TYPE( SC_ConstraintStateType_C ) :: C_obj - REAL(SiKi) :: Dummy !< Remove this variable if you have constraint states [-] + REAL(SiKi) :: Dummy = 0.0_R4Ki !< Remove this variable if you have constraint states [-] END TYPE SC_ConstraintStateType ! ======================= ! ========= SC_MiscVarType_C ======= @@ -138,7 +138,7 @@ MODULE SuperController_Types END TYPE SC_MiscVarType_C TYPE, PUBLIC :: SC_MiscVarType TYPE( SC_MiscVarType_C ) :: C_obj - REAL(SiKi) :: Dummy !< Remove this variable if you have misc vars [-] + REAL(SiKi) :: Dummy = 0.0_R4Ki !< Remove this variable if you have misc vars [-] END TYPE SC_MiscVarType ! ======================= ! ========= SC_OtherStateType_C ======= @@ -148,7 +148,7 @@ MODULE SuperController_Types END TYPE SC_OtherStateType_C TYPE, PUBLIC :: SC_OtherStateType TYPE( SC_OtherStateType_C ) :: C_obj - INTEGER(IntKi) :: Dummy !< Dummy Other State [-] + INTEGER(IntKi) :: Dummy = 0_IntKi !< Dummy Other State [-] END TYPE SC_OtherStateType ! ======================= ! ========= SC_InputType_C ======= diff --git a/modules/wakedynamics/src/WakeDynamics_Types.f90 b/modules/wakedynamics/src/WakeDynamics_Types.f90 index 9383cea9b4..615e826f91 100644 --- a/modules/wakedynamics/src/WakeDynamics_Types.f90 +++ b/modules/wakedynamics/src/WakeDynamics_Types.f90 @@ -42,45 +42,45 @@ MODULE WakeDynamics_Types INTEGER(IntKi), PUBLIC, PARAMETER :: Mod_Wake_Cartesian = 3 ! Wake model [-] ! ========= WD_InputFileType ======= TYPE, PUBLIC :: WD_InputFileType - REAL(ReKi) :: dr !< Radial increment of radial finite-difference grid [>0.0] [m] - INTEGER(IntKi) :: NumRadii !< Number of radii in the radial finite-difference grid [>=2] [-] - INTEGER(IntKi) :: NumPlanes !< Number of wake planes [>=2] [-] - INTEGER(IntKi) :: Mod_Wake !< Switch between wake formulations 1=Polar, 2=Cartesian, 3=Curl [-] - REAL(ReKi) :: f_c !< Cut-off frequency of the low-pass time-filter for the wake advection, deflection, and meandering model [>0.0] [Hz] - REAL(ReKi) :: C_HWkDfl_O !< Calibrated parameter in the correction for wake deflection defining the horizontal offset at the rotor [m] - REAL(ReKi) :: C_HWkDfl_OY !< Calibrated parameter in the correction for wake deflection defining the horizontal offset at the rotor scaled with yaw error [m/rad] - REAL(ReKi) :: C_HWkDfl_x !< Calibrated parameter in the correction for wake deflection defining the horizontal offset scaled with downstream distance [-] - REAL(ReKi) :: C_HWkDfl_xY !< Calibrated parameter in the correction for wake deflection defining the horizontal offset scaled with downstream distance and yaw error [1/rad] - REAL(ReKi) :: C_NearWake !< Calibrated parameter for the near-wake correction [>-1.0] [-] - REAL(ReKi) :: k_vAmb !< Calibrated parameter for the influence of ambient turbulence in the eddy viscosity [>=0.0] [-] - REAL(ReKi) :: k_vShr !< Calibrated parameter for the influence of the shear layer in the eddy viscosity [>=0.0] [-] - REAL(ReKi) :: C_vAmb_DMin !< Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the transitional diameter fraction between the minimum and exponential regions [>=0.0 ] [-] - REAL(ReKi) :: C_vAmb_DMax !< Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the transitional diameter fraction between the exponential and maximum regions [> C_vAmb_DMin] [-] - REAL(ReKi) :: C_vAmb_FMin !< Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the value in the minimum region [>=0.0 and <=1.0] [-] - REAL(ReKi) :: C_vAmb_Exp !< Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the exponent in the exponential region [> 0.0] [-] - REAL(ReKi) :: C_vShr_DMin !< Calibrated parameter in the eddy viscosity filter function for the shear layer defining the transitional diameter fraction between the minimum and exponential regions [>=0.0] [-] - REAL(ReKi) :: C_vShr_DMax !< Calibrated parameter in the eddy viscosity filter function for the shear layer defining the transitional diameter fraction between the exponential and maximum regions [> C_vShr_DMin] [-] - REAL(ReKi) :: C_vShr_FMin !< Calibrated parameter in the eddy viscosity filter function for the shear layer defining the value in the minimum region [>=0.0 and <=1.0] [-] - REAL(ReKi) :: C_vShr_Exp !< Calibrated parameter in the eddy viscosity filter function for the shear layer defining the exponent in the exponential region [> 0.0] [-] - INTEGER(IntKi) :: Mod_WakeDiam !< Wake diameter calculation model {1: rotor diameter, 2: velocity-based, 3: mass-flux based, 4: momentum-flux based} [DEFAULT=1] [-] - REAL(ReKi) :: C_WakeDiam !< Calibrated parameter for wake diameter calculation [>0.0 and <1.0] [unused for Mod_WakeDiam=1] [-] - LOGICAL :: Swirl !< Switch to add swirl [only used if Mod_Wake=2 or 2] [-] - REAL(ReKi) :: k_VortexDecay !< Vortex decay constant for curl [-] - REAL(ReKi) :: sigma_D !< The width of the Gaussian vortices used for the curled wake model divided by diameter [-] - INTEGER(IntKi) :: NumVortices !< The number of vortices used for the curled wake model [-] - INTEGER(IntKi) :: FilterInit !< Switch to filter the initial wake plane deficit and select the number of grid points for the filter {0: no filter, 1: filter of size 1} or DEFAULT [DEFAULT=0: if Mod_Wake is 1 or 3, or DEFAULT=2: if Mod_Wwake is 2] (switch) [-] - REAL(ReKi) :: k_vCurl !< Calibrated parameter for the eddy viscosity in curled-wake model [>=0.0] [-] - LOGICAL :: OutAllPlanes !< Output all planes [-] - LOGICAL :: WAT !< Switch for turning on and off wake-added turbulence [-] - REAL(ReKi) :: WAT_k_Def !< Calibrated parameter for the influence of the wake deficit in the wake-added Turbulence (-) [>=0.0] or DEFAULT [DEFAULT=0.6] [-] - REAL(ReKi) :: WAT_k_Grad !< Calibrated parameter for the influence of the radial velocity gradient of the wake deficit in the wake-added Turbulence (-) [>=0.0] or DEFAULT [DEFAULT=0.35] [-] + REAL(ReKi) :: dr = 0.0_ReKi !< Radial increment of radial finite-difference grid [>0.0] [m] + INTEGER(IntKi) :: NumRadii = 0_IntKi !< Number of radii in the radial finite-difference grid [>=2] [-] + INTEGER(IntKi) :: NumPlanes = 0_IntKi !< Number of wake planes [>=2] [-] + INTEGER(IntKi) :: Mod_Wake = 0_IntKi !< Switch between wake formulations 1=Polar, 2=Cartesian, 3=Curl [-] + REAL(ReKi) :: f_c = 0.0_ReKi !< Cut-off frequency of the low-pass time-filter for the wake advection, deflection, and meandering model [>0.0] [Hz] + REAL(ReKi) :: C_HWkDfl_O = 0.0_ReKi !< Calibrated parameter in the correction for wake deflection defining the horizontal offset at the rotor [m] + REAL(ReKi) :: C_HWkDfl_OY = 0.0_ReKi !< Calibrated parameter in the correction for wake deflection defining the horizontal offset at the rotor scaled with yaw error [m/rad] + REAL(ReKi) :: C_HWkDfl_x = 0.0_ReKi !< Calibrated parameter in the correction for wake deflection defining the horizontal offset scaled with downstream distance [-] + REAL(ReKi) :: C_HWkDfl_xY = 0.0_ReKi !< Calibrated parameter in the correction for wake deflection defining the horizontal offset scaled with downstream distance and yaw error [1/rad] + REAL(ReKi) :: C_NearWake = 0.0_ReKi !< Calibrated parameter for the near-wake correction [>-1.0] [-] + REAL(ReKi) :: k_vAmb = 0.0_ReKi !< Calibrated parameter for the influence of ambient turbulence in the eddy viscosity [>=0.0] [-] + REAL(ReKi) :: k_vShr = 0.0_ReKi !< Calibrated parameter for the influence of the shear layer in the eddy viscosity [>=0.0] [-] + REAL(ReKi) :: C_vAmb_DMin = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the transitional diameter fraction between the minimum and exponential regions [>=0.0 ] [-] + REAL(ReKi) :: C_vAmb_DMax = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the transitional diameter fraction between the exponential and maximum regions [> C_vAmb_DMin] [-] + REAL(ReKi) :: C_vAmb_FMin = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the value in the minimum region [>=0.0 and <=1.0] [-] + REAL(ReKi) :: C_vAmb_Exp = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the exponent in the exponential region [> 0.0] [-] + REAL(ReKi) :: C_vShr_DMin = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for the shear layer defining the transitional diameter fraction between the minimum and exponential regions [>=0.0] [-] + REAL(ReKi) :: C_vShr_DMax = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for the shear layer defining the transitional diameter fraction between the exponential and maximum regions [> C_vShr_DMin] [-] + REAL(ReKi) :: C_vShr_FMin = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for the shear layer defining the value in the minimum region [>=0.0 and <=1.0] [-] + REAL(ReKi) :: C_vShr_Exp = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for the shear layer defining the exponent in the exponential region [> 0.0] [-] + INTEGER(IntKi) :: Mod_WakeDiam = 0_IntKi !< Wake diameter calculation model {1: rotor diameter, 2: velocity-based, 3: mass-flux based, 4: momentum-flux based} [DEFAULT=1] [-] + REAL(ReKi) :: C_WakeDiam = 0.0_ReKi !< Calibrated parameter for wake diameter calculation [>0.0 and <1.0] [unused for Mod_WakeDiam=1] [-] + LOGICAL :: Swirl = .false. !< Switch to add swirl [only used if Mod_Wake=2 or 2] [-] + REAL(ReKi) :: k_VortexDecay = 0.0_ReKi !< Vortex decay constant for curl [-] + REAL(ReKi) :: sigma_D = 0.0_ReKi !< The width of the Gaussian vortices used for the curled wake model divided by diameter [-] + INTEGER(IntKi) :: NumVortices = 0_IntKi !< The number of vortices used for the curled wake model [-] + INTEGER(IntKi) :: FilterInit = 0_IntKi !< Switch to filter the initial wake plane deficit and select the number of grid points for the filter {0: no filter, 1: filter of size 1} or DEFAULT [DEFAULT=0: if Mod_Wake is 1 or 3, or DEFAULT=2: if Mod_Wwake is 2] (switch) [-] + REAL(ReKi) :: k_vCurl = 0.0_ReKi !< Calibrated parameter for the eddy viscosity in curled-wake model [>=0.0] [-] + LOGICAL :: OutAllPlanes = .false. !< Output all planes [-] + LOGICAL :: WAT = .false. !< Switch for turning on and off wake-added turbulence [-] + REAL(ReKi) :: WAT_k_Def = 0.0_ReKi !< Calibrated parameter for the influence of the wake deficit in the wake-added Turbulence (-) [>=0.0] or DEFAULT [DEFAULT=0.6] [-] + REAL(ReKi) :: WAT_k_Grad = 0.0_ReKi !< Calibrated parameter for the influence of the radial velocity gradient of the wake deficit in the wake-added Turbulence (-) [>=0.0] or DEFAULT [DEFAULT=0.35] [-] END TYPE WD_InputFileType ! ======================= ! ========= WD_InitInputType ======= TYPE, PUBLIC :: WD_InitInputType TYPE(WD_InputFileType) :: InputFileData !< FAST.Farm input-file data for wake dynamics [-] INTEGER(IntKi) :: TurbNum = 0 !< Turbine ID number (start with 1; end with number of turbines) [-] - CHARACTER(1024) :: OutFileRoot !< The root name derived from the primary FAST.Farm input file [-] + CHARACTER(1024) :: OutFileRoot = '' !< The root name derived from the primary FAST.Farm input file [-] END TYPE WD_InitInputType ! ======================= ! ========= WD_InitOutputType ======= @@ -92,15 +92,15 @@ MODULE WakeDynamics_Types ! ======================= ! ========= WD_ContinuousStateType ======= TYPE, PUBLIC :: WD_ContinuousStateType - REAL(ReKi) :: DummyContState !< Remove this variable if you have continuous states [-] + REAL(ReKi) :: DummyContState = 0.0_ReKi !< Remove this variable if you have continuous states [-] END TYPE WD_ContinuousStateType ! ======================= ! ========= WD_DiscreteStateType ======= TYPE, PUBLIC :: WD_DiscreteStateType REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: xhat_plane !< Orientations of wake planes, normal to wake planes [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: YawErr_filt !< Time-filtered nacelle-yaw error at the wake planes [rad] - REAL(ReKi) :: psi_skew_filt !< Time-filtered azimuth angle from skew vertical axis [rad] - REAL(ReKi) :: chi_skew_filt !< Time-filtered inflow skew angle [rad] + REAL(ReKi) :: psi_skew_filt = 0.0_ReKi !< Time-filtered azimuth angle from skew vertical axis [rad] + REAL(ReKi) :: chi_skew_filt = 0.0_ReKi !< Time-filtered inflow skew angle [rad] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: V_plane_filt !< Time-filtered advection, deflection, and meandering velocity of wake planes [m/s] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: p_plane !< Center positions of wake planes [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: x_plane !< Downwind distance from rotor to each wake plane [m] @@ -112,19 +112,19 @@ MODULE WakeDynamics_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Vx_wind_disk_filt !< Time-filtered rotor-disk-averaged ambient wind speed of wake planes, normal to planes [m/s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TI_amb_filt !< Time-filtered ambient turbulence intensity of wind at wake planes [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: D_rotor_filt !< Time-filtered rotor diameter associated with each wake plane [m] - REAL(ReKi) :: Vx_rel_disk_filt !< Time-filtered rotor-disk-averaged relative wind speed (ambient + deficits + motion), normal to disk [m/s] + REAL(ReKi) :: Vx_rel_disk_filt = 0.0_ReKi !< Time-filtered rotor-disk-averaged relative wind speed (ambient + deficits + motion), normal to disk [m/s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Ct_azavg_filt !< Time-filtered azimuthally averaged thrust force coefficient (normal to disk), distributed radially [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Cq_azavg_filt !< Time-filtered azimuthally averaged torque coefficient (normal to disk), distributed radially [-] END TYPE WD_DiscreteStateType ! ======================= ! ========= WD_ConstraintStateType ======= TYPE, PUBLIC :: WD_ConstraintStateType - REAL(ReKi) :: DummyConstrState !< Remove this variable if you have constraint states [-] + REAL(ReKi) :: DummyConstrState = 0.0_ReKi !< Remove this variable if you have constraint states [-] END TYPE WD_ConstraintStateType ! ======================= ! ========= WD_OtherStateType ======= TYPE, PUBLIC :: WD_OtherStateType - LOGICAL :: firstPass !< Flag indicating whether or not the states have been initialized with proper inputs [-] + LOGICAL :: firstPass = .false. !< Flag indicating whether or not the states have been initialized with proper inputs [-] END TYPE WD_OtherStateType ! ======================= ! ========= WD_MiscVarType ======= @@ -150,66 +150,66 @@ MODULE WakeDynamics_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Vx_high !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Vx_polar !< Vx as function of r for Cartesian implementation [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Vt_wake !< Vr as function of r for Cartesian implementation [-] - REAL(ReKi) :: GammaCurl !< Circulation used in Curled wake model [-] - REAL(ReKi) :: Ct_avg !< Circulation used in Curled wake model [-] + REAL(ReKi) :: GammaCurl = 0.0_ReKi !< Circulation used in Curled wake model [-] + REAL(ReKi) :: Ct_avg = 0.0_ReKi !< Circulation used in Curled wake model [-] END TYPE WD_MiscVarType ! ======================= ! ========= WD_ParameterType ======= TYPE, PUBLIC :: WD_ParameterType - REAL(DbKi) :: dt_low !< Time interval for wake dynamics calculations {or default} [s] - INTEGER(IntKi) :: NumPlanes !< Number of wake planes [-] - INTEGER(IntKi) :: NumRadii !< Number of radii in the radial finite-difference grid [-] - REAL(ReKi) :: dr !< Radial increment of radial finite-difference grid [m] + REAL(DbKi) :: dt_low = 0.0_R8Ki !< Time interval for wake dynamics calculations {or default} [s] + INTEGER(IntKi) :: NumPlanes = 0_IntKi !< Number of wake planes [-] + INTEGER(IntKi) :: NumRadii = 0_IntKi !< Number of radii in the radial finite-difference grid [-] + REAL(ReKi) :: dr = 0.0_ReKi !< Radial increment of radial finite-difference grid [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: r !< Discretization of radial finite-difference grid [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: y !< Horizontal discretization of each wake plane (size ny=2nr-1) [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: z !< Nomically-vertical discretization of each wake plane (size nz=2nr-1) [m] - INTEGER(IntKi) :: Mod_Wake !< Switch between wake formulations 1=Polar, 2=Curl, 3=Cartesian [-] - LOGICAL :: Swirl !< Switch to add swirl [only used if Mod_Wake=2 or 2] [-] - REAL(ReKi) :: k_VortexDecay !< Vortex decay constant for curl [-] - REAL(ReKi) :: sigma_D !< The width of the Gaussian vortices used for the curled wake model divided by diameter [-] - INTEGER(IntKi) :: NumVortices !< The number of vortices used for the curled wake model [-] - REAL(ReKi) :: filtParam !< Low-pass time-filter parameter, with a value between 0 (minimum filtering) and 1 (maximum filtering) (exclusive) [-] - REAL(ReKi) :: oneMinusFiltParam !< 1.0 - filtParam [-] - REAL(ReKi) :: C_HWkDfl_O !< Calibrated parameter in the correction for wake deflection defining the horizontal offset at the rotor [m] - REAL(ReKi) :: C_HWkDfl_OY !< Calibrated parameter in the correction for wake deflection defining the horizontal offset at the rotor scaled with yaw error [m/rad] - REAL(ReKi) :: C_HWkDfl_x !< Calibrated parameter in the correction for wake deflection defining the horizontal offset scaled with downstream distance [-] - REAL(ReKi) :: C_HWkDfl_xY !< Calibrated parameter in the correction for wake deflection defining the horizontal offset scaled with downstream distance and yaw error [1/rad] - REAL(ReKi) :: C_NearWake !< Calibrated parameter for near-wake correction [-] - REAL(ReKi) :: C_vAmb_DMin !< Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the transitional diameter fraction between the minimum and exponential regions [-] - REAL(ReKi) :: C_vAmb_DMax !< Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the transitional diameter fraction between the exponential and maximum regions [-] - REAL(ReKi) :: C_vAmb_FMin !< Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the functional value in the minimum region [-] - REAL(ReKi) :: C_vAmb_Exp !< Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the exponent in the exponential region [-] - REAL(ReKi) :: C_vShr_DMin !< Calibrated parameter in the eddy viscosity filter function for the shear layer defining the transitional diameter fraction between the minimum and exponential regions [-] - REAL(ReKi) :: C_vShr_DMax !< Calibrated parameter in the eddy viscosity filter function for the shear layer defining the transitional diameter fraction between the exponential and maximum regions [-] - REAL(ReKi) :: C_vShr_FMin !< Calibrated parameter in the eddy viscosity filter function for the shear layer defining the functional value in the minimum region [-] - REAL(ReKi) :: C_vShr_Exp !< Calibrated parameter in the eddy viscosity filter function for the shear layer defining the exponent in the exponential region [-] - REAL(ReKi) :: k_vAmb !< Calibrated parameter for the influence of ambient turbulence in the eddy viscosity [-] - REAL(ReKi) :: k_vShr !< Calibrated parameter for the influence of the shear layer in the eddy viscosity [-] - INTEGER(IntKi) :: Mod_WakeDiam !< Wake diameter calculation model [-] - REAL(ReKi) :: C_WakeDiam !< Calibrated parameter for wake diameter calculation [-] - INTEGER(IntKi) :: FilterInit !< Switch to filter the initial wake plane deficit and select the number of grid points for the filter {0: no filter, 1: filter of size 1} or DEFAULT [DEFAULT=0: if Mod_Wake is 1 or 3, or DEFAULT=2: if Mod_Wwake is 2] (switch) [-] - REAL(ReKi) :: k_vCurl !< Calibrated parameter for the eddy viscosity in curled-wake model [>=0.0] [-] - LOGICAL :: OutAllPlanes !< Output all planes [-] - CHARACTER(1024) :: OutFileRoot !< The root name derived from the primary FAST.Farm input file [-] - CHARACTER(1024) :: OutFileVTKDir !< The parent directory for all VTK files written by WD [-] + INTEGER(IntKi) :: Mod_Wake = 0_IntKi !< Switch between wake formulations 1=Polar, 2=Curl, 3=Cartesian [-] + LOGICAL :: Swirl = .false. !< Switch to add swirl [only used if Mod_Wake=2 or 2] [-] + REAL(ReKi) :: k_VortexDecay = 0.0_ReKi !< Vortex decay constant for curl [-] + REAL(ReKi) :: sigma_D = 0.0_ReKi !< The width of the Gaussian vortices used for the curled wake model divided by diameter [-] + INTEGER(IntKi) :: NumVortices = 0_IntKi !< The number of vortices used for the curled wake model [-] + REAL(ReKi) :: filtParam = 0.0_ReKi !< Low-pass time-filter parameter, with a value between 0 (minimum filtering) and 1 (maximum filtering) (exclusive) [-] + REAL(ReKi) :: oneMinusFiltParam = 0.0_ReKi !< 1.0 - filtParam [-] + REAL(ReKi) :: C_HWkDfl_O = 0.0_ReKi !< Calibrated parameter in the correction for wake deflection defining the horizontal offset at the rotor [m] + REAL(ReKi) :: C_HWkDfl_OY = 0.0_ReKi !< Calibrated parameter in the correction for wake deflection defining the horizontal offset at the rotor scaled with yaw error [m/rad] + REAL(ReKi) :: C_HWkDfl_x = 0.0_ReKi !< Calibrated parameter in the correction for wake deflection defining the horizontal offset scaled with downstream distance [-] + REAL(ReKi) :: C_HWkDfl_xY = 0.0_ReKi !< Calibrated parameter in the correction for wake deflection defining the horizontal offset scaled with downstream distance and yaw error [1/rad] + REAL(ReKi) :: C_NearWake = 0.0_ReKi !< Calibrated parameter for near-wake correction [-] + REAL(ReKi) :: C_vAmb_DMin = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the transitional diameter fraction between the minimum and exponential regions [-] + REAL(ReKi) :: C_vAmb_DMax = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the transitional diameter fraction between the exponential and maximum regions [-] + REAL(ReKi) :: C_vAmb_FMin = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the functional value in the minimum region [-] + REAL(ReKi) :: C_vAmb_Exp = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for ambient turbulence defining the exponent in the exponential region [-] + REAL(ReKi) :: C_vShr_DMin = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for the shear layer defining the transitional diameter fraction between the minimum and exponential regions [-] + REAL(ReKi) :: C_vShr_DMax = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for the shear layer defining the transitional diameter fraction between the exponential and maximum regions [-] + REAL(ReKi) :: C_vShr_FMin = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for the shear layer defining the functional value in the minimum region [-] + REAL(ReKi) :: C_vShr_Exp = 0.0_ReKi !< Calibrated parameter in the eddy viscosity filter function for the shear layer defining the exponent in the exponential region [-] + REAL(ReKi) :: k_vAmb = 0.0_ReKi !< Calibrated parameter for the influence of ambient turbulence in the eddy viscosity [-] + REAL(ReKi) :: k_vShr = 0.0_ReKi !< Calibrated parameter for the influence of the shear layer in the eddy viscosity [-] + INTEGER(IntKi) :: Mod_WakeDiam = 0_IntKi !< Wake diameter calculation model [-] + REAL(ReKi) :: C_WakeDiam = 0.0_ReKi !< Calibrated parameter for wake diameter calculation [-] + INTEGER(IntKi) :: FilterInit = 0_IntKi !< Switch to filter the initial wake plane deficit and select the number of grid points for the filter {0: no filter, 1: filter of size 1} or DEFAULT [DEFAULT=0: if Mod_Wake is 1 or 3, or DEFAULT=2: if Mod_Wwake is 2] (switch) [-] + REAL(ReKi) :: k_vCurl = 0.0_ReKi !< Calibrated parameter for the eddy viscosity in curled-wake model [>=0.0] [-] + LOGICAL :: OutAllPlanes = .false. !< Output all planes [-] + CHARACTER(1024) :: OutFileRoot = '' !< The root name derived from the primary FAST.Farm input file [-] + CHARACTER(1024) :: OutFileVTKDir = '' !< The parent directory for all VTK files written by WD [-] INTEGER(IntKi) :: TurbNum = 0 !< Turbine ID number (start with 1; end with number of turbines) [-] - LOGICAL :: WAT !< Switch for turning on and off wake-added turbulence [-] - REAL(ReKi) :: WAT_k_Def !< Calibrated parameter for the influence of the wake deficit in the wake-added Turbulence (-) [>=0.0] or DEFAULT [DEFAULT=0.6] [-] - REAL(ReKi) :: WAT_k_Grad !< Calibrated parameter for the influence of the radial velocity gradient of the wake deficit in the wake-added Turbulence (-) [>=0.0] or DEFAULT [DEFAULT=0.35] [-] + LOGICAL :: WAT = .false. !< Switch for turning on and off wake-added turbulence [-] + REAL(ReKi) :: WAT_k_Def = 0.0_ReKi !< Calibrated parameter for the influence of the wake deficit in the wake-added Turbulence (-) [>=0.0] or DEFAULT [DEFAULT=0.6] [-] + REAL(ReKi) :: WAT_k_Grad = 0.0_ReKi !< Calibrated parameter for the influence of the radial velocity gradient of the wake deficit in the wake-added Turbulence (-) [>=0.0] or DEFAULT [DEFAULT=0.35] [-] END TYPE WD_ParameterType ! ======================= ! ========= WD_InputType ======= TYPE, PUBLIC :: WD_InputType - REAL(ReKi) , DIMENSION(1:3) :: xhat_disk !< Orientation of rotor centerline, normal to disk [-] - REAL(ReKi) :: YawErr !< Nacelle-yaw error at the wake planes [rad] - REAL(ReKi) :: psi_skew !< Azimuth angle from the nominally vertical axis in the disk plane to the vector about which the inflow skew angle is defined [rad] - REAL(ReKi) :: chi_skew !< Inflow skew angle [rad] - REAL(ReKi) , DIMENSION(1:3) :: p_hub !< Center position of hub [m] + REAL(ReKi) , DIMENSION(1:3) :: xhat_disk = 0.0_ReKi !< Orientation of rotor centerline, normal to disk [-] + REAL(ReKi) :: YawErr = 0.0_ReKi !< Nacelle-yaw error at the wake planes [rad] + REAL(ReKi) :: psi_skew = 0.0_ReKi !< Azimuth angle from the nominally vertical axis in the disk plane to the vector about which the inflow skew angle is defined [rad] + REAL(ReKi) :: chi_skew = 0.0_ReKi !< Inflow skew angle [rad] + REAL(ReKi) , DIMENSION(1:3) :: p_hub = 0.0_ReKi !< Center position of hub [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: V_plane !< Advection, deflection, and meandering velocity of wake planes [m/s] - REAL(ReKi) :: Vx_wind_disk !< Rotor-disk-averaged ambient wind speed, normal to planes [m/s] - REAL(ReKi) :: TI_amb !< Ambient turbulence intensity of wind at rotor disk [-] - REAL(ReKi) :: D_rotor !< Rotor diameter [m] - REAL(ReKi) :: Vx_rel_disk !< Rotor-disk-averaged relative wind speed (ambient + deficits + motion), normal to disk [m/s] + REAL(ReKi) :: Vx_wind_disk = 0.0_ReKi !< Rotor-disk-averaged ambient wind speed, normal to planes [m/s] + REAL(ReKi) :: TI_amb = 0.0_ReKi !< Ambient turbulence intensity of wind at rotor disk [-] + REAL(ReKi) :: D_rotor = 0.0_ReKi !< Rotor diameter [m] + REAL(ReKi) :: Vx_rel_disk = 0.0_ReKi !< Rotor-disk-averaged relative wind speed (ambient + deficits + motion), normal to disk [m/s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Ct_azavg !< Azimuthally averaged thrust force coefficient (normal to disk), distributed radially [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Cq_azavg !< Azimuthally averaged torque coefficient (normal to disk), distributed radially [-] END TYPE WD_InputType From 25323c625aec4eb702b458482af8c4e1bcdddf9e Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Fri, 16 Jun 2023 17:58:06 +0000 Subject: [PATCH 13/15] Regenerated *Types.f90 files --- .../fast-farm/src/FASTWrapper_Types.f90 | 4 +- glue-codes/fast-farm/src/FAST_Farm_Types.f90 | 18 +- modules/aerodyn/src/AeroAcoustics_Types.f90 | 18 +- modules/aerodyn/src/AeroDyn_Driver_Types.f90 | 26 +- modules/aerodyn/src/AeroDyn_Inflow_Types.f90 | 4 +- modules/aerodyn/src/AeroDyn_Types.f90 | 276 +-- modules/aerodyn/src/AirfoilInfo_Types.f90 | 6 +- modules/aerodyn/src/BEMT_Types.f90 | 2 +- modules/aerodyn/src/FVW_Types.f90 | 14 +- modules/aerodyn/src/UnsteadyAero_Types.f90 | 8 +- modules/aerodyn14/src/AeroDyn14_Types.f90 | 10 +- modules/awae/src/AWAE_Types.f90 | 12 +- modules/beamdyn/src/BeamDyn_Types.f90 | 12 +- modules/elastodyn/src/ElastoDyn_Types.f90 | 16 +- modules/extptfm/src/ExtPtfm_MCKF_Types.f90 | 10 +- modules/feamooring/src/FEAMooring_Types.f90 | 10 +- modules/hydrodyn/src/Conv_Radiation_Types.f90 | 4 +- modules/hydrodyn/src/HydroDyn_Types.f90 | 14 +- modules/hydrodyn/src/Morison_Types.f90 | 1493 +---------------- modules/hydrodyn/src/SS_Excitation_Types.f90 | 2 +- modules/hydrodyn/src/SS_Radiation_Types.f90 | 2 +- modules/hydrodyn/src/WAMIT2_Types.f90 | 2 +- modules/hydrodyn/src/WAMIT_Types.f90 | 2 +- modules/icedyn/src/IceDyn_Types.f90 | 6 +- modules/icefloe/src/icefloe/IceFloe_Types.f90 | 4 +- .../inflowwind/src/IfW_FlowField_Types.f90 | 70 +- .../inflowwind/src/InflowWind_IO_Types.f90 | 10 +- modules/inflowwind/src/InflowWind_Types.f90 | 22 +- modules/map/src/MAP_Types.f90 | 22 +- modules/moordyn/src/MoorDyn_Types.f90 | 22 +- .../nwtc-library/src/NWTC_Library_Types.f90 | 16 +- modules/openfast-library/src/FAST_Types.f90 | 42 +- .../src/registry_gen_fortran.cpp | 2 +- modules/openfoam/src/OpenFOAM_Types.f90 | 34 +- .../src/OrcaFlexInterface_Types.f90 | 16 +- modules/seastate/src/Current_Types.f90 | 4 +- modules/seastate/src/SeaState_Types.f90 | 14 +- modules/seastate/src/Waves_Types.f90 | 10 +- modules/servodyn/src/ServoDyn_Types.f90 | 22 +- modules/servodyn/src/StrucCtrl_Types.f90 | 14 +- modules/subdyn/src/SubDyn_Types.f90 | 12 +- .../src/SuperController_Types.f90 | 2 +- .../wakedynamics/src/WakeDynamics_Types.f90 | 6 +- 43 files changed, 489 insertions(+), 1826 deletions(-) diff --git a/glue-codes/fast-farm/src/FASTWrapper_Types.f90 b/glue-codes/fast-farm/src/FASTWrapper_Types.f90 index 7c99c9c1fc..cb9cab5c0a 100644 --- a/glue-codes/fast-farm/src/FASTWrapper_Types.f90 +++ b/glue-codes/fast-farm/src/FASTWrapper_Types.f90 @@ -37,7 +37,7 @@ MODULE FASTWrapper_Types ! ========= FWrap_InitInputType ======= TYPE, PUBLIC :: FWrap_InitInputType INTEGER(IntKi) :: nr = 0_IntKi !< Number of radii in the radial finite-difference grid [-] - CHARACTER(1024) :: FASTInFile = '' !< Filename of primary FAST input file of this turbine [-] + CHARACTER(1024) :: FASTInFile !< Filename of primary FAST input file of this turbine [-] REAL(ReKi) :: dr = 0.0_ReKi !< Radial increment of radial finite-difference grid [m] REAL(DbKi) :: tmax = 0.0_R8Ki !< Simulation length [s] REAL(ReKi) , DIMENSION(1:3) :: p_ref_Turbine = 0.0_ReKi !< Undisplaced global coordinates of this turbine [m] @@ -52,7 +52,7 @@ MODULE FASTWrapper_Types REAL(ReKi) :: dY_high = 0.0_ReKi !< Y-component of the spatial increment of the high-resolution spatial domain for this turbine [m] REAL(ReKi) :: dZ_high = 0.0_ReKi !< Z-component of the spatial increment of the high-resolution spatial domain for this turbine [m] INTEGER(IntKi) :: TurbNum = 0_IntKi !< Turbine ID number (start with 1; end with number of turbines) [-] - CHARACTER(1024) :: RootName = '' !< The root name derived from the primary FAST.Farm input file [For output reporting in this module we need to have Rootname include the turbine number] [-] + CHARACTER(1024) :: RootName !< The root name derived from the primary FAST.Farm input file [For output reporting in this module we need to have Rootname include the turbine number] [-] INTEGER(IntKi) :: NumSC2Ctrl = 0_IntKi !< Number of turbine-specific controller inputs [from supercontroller] [-] INTEGER(IntKi) :: NumSC2CtrlGlob = 0_IntKi !< Number of global controller inputs [from supercontroller] [-] INTEGER(IntKi) :: NumCtrl2SC = 0_IntKi !< Number of turbine-specific controller outputs [to supercontroller] [-] diff --git a/glue-codes/fast-farm/src/FAST_Farm_Types.f90 b/glue-codes/fast-farm/src/FAST_Farm_Types.f90 index 24f92e9651..c4582b0b6e 100644 --- a/glue-codes/fast-farm/src/FAST_Farm_Types.f90 +++ b/glue-codes/fast-farm/src/FAST_Farm_Types.f90 @@ -51,27 +51,27 @@ MODULE FAST_Farm_Types REAL(DbKi) :: TMax = 0.0_R8Ki !< Total run time [seconds] INTEGER(IntKi) :: n_high_low = 0_IntKi !< Number of high-resolution time steps per low-resolution time step [-] INTEGER(IntKi) :: NumTurbines = 0_IntKi !< Number of turbines in the simulation [-] - CHARACTER(1024) :: WindFilePath = '' !< Path name of wind data files from ABLSolver precursor [-] - CHARACTER(1024) :: SC_FileName = '' !< Name/location of the dynamic library {.dll [Windows] or .so [Linux]} containing the Super Controller algorithms [-] + CHARACTER(1024) :: WindFilePath !< Path name of wind data files from ABLSolver precursor [-] + CHARACTER(1024) :: SC_FileName !< Name/location of the dynamic library {.dll [Windows] or .so [Linux]} containing the Super Controller algorithms [-] LOGICAL :: UseSC = .false. !< Use a super controller? [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WT_Position !< X-Y-Z position of each wind turbine; index 1 = XYZ; index 2 = turbine number [meters] INTEGER(IntKi) :: WaveFieldMod = 0_IntKi !< Wave field handling (-) (switch) {0: use individual HydroDyn inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin} [-] INTEGER(IntKi) :: MooringMod = 0_IntKi !< Mod_SharedMooring is a flag for array-level mooring. (switch) {0: none, 3: yes/MoorDyn} [-] - CHARACTER(1024) :: MD_FileName = '' !< Name/location of the farm-level MoorDyn input file [-] + CHARACTER(1024) :: MD_FileName !< Name/location of the farm-level MoorDyn input file [-] REAL(DbKi) :: DT_mooring = 0.0_R8Ki !< Time step for farm-levem mooring coupling with each turbine [used only when Mod_SharedMooring > 0] [seconds] INTEGER(IntKi) :: n_mooring = 0_IntKi !< Number of FAST and MoorDyn time steps per FAST.Farm timestep when mooring > 0 [-] CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: WT_FASTInFile !< Name of input file for each turbine [-] - CHARACTER(1024) :: FTitle = '' !< The description line from the primary FAST.Farm input file [-] - CHARACTER(1024) :: OutFileRoot = '' !< The root name derived from the primary FAST.Farm input file [-] + CHARACTER(1024) :: FTitle !< The description line from the primary FAST.Farm input file [-] + CHARACTER(1024) :: OutFileRoot !< The root name derived from the primary FAST.Farm input file [-] INTEGER(IntKi) :: n_ChkptTime = 0_IntKi !< Number of time steps between writing checkpoint files [-] REAL(DbKi) :: TStart = 0.0_R8Ki !< Time to begin tabular output [s] INTEGER(IntKi) :: n_TMax = 0_IntKi !< Number of the time step of TMax (the end time of the simulation) [-] LOGICAL :: SumPrint = .false. !< Print summary data to file? (.sum) [-] LOGICAL :: WrBinOutFile = .false. !< Write a binary output file? (.outb) [-] LOGICAL :: WrTxtOutFile = .false. !< Write a text (formatted) output file? (.out) [-] - CHARACTER(1) :: Delim = '' !< Delimiter between columns of text output file (.out): space or tab [-] - CHARACTER(20) :: OutFmt = '' !< Format used for text tabular output (except time); resulting field should be 10 characters [-] - CHARACTER(20) :: OutFmt_t = '' !< Format used for time channel in text tabular output; resulting field should be 10 characters [-] + CHARACTER(1) :: Delim !< Delimiter between columns of text output file (.out): space or tab [-] + CHARACTER(20) :: OutFmt !< Format used for text tabular output (except time); resulting field should be 10 characters [-] + CHARACTER(20) :: OutFmt_t !< Format used for time channel in text tabular output; resulting field should be 10 characters [-] INTEGER(IntKi) :: FmtWidth = 0_IntKi !< width of the time OutFmt specifier [-] INTEGER(IntKi) :: TChanLen = 0_IntKi !< width of the time channel [-] INTEGER(IntKi) :: NOutTurb = 0_IntKi !< Number of turbines for write output [1 to 9] [-] @@ -86,7 +86,7 @@ MODULE FAST_Farm_Types TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of user-requested outputs [-] INTEGER(IntKi) :: NOutSteps = 0_IntKi !< Maximum number of output steps [-] - CHARACTER(1024) , DIMENSION(1:3) :: FileDescLines = '' !< File Description lines [-] + CHARACTER(1024) , DIMENSION(1:3) :: FileDescLines !< File Description lines [-] TYPE(ProgDesc) , DIMENSION(1:NumModules) :: Module_Ver !< Version information from all modules [-] INTEGER(IntKi) :: UnOu = 0_IntKi !< File unit for Fast.Farm output data [-] REAL(ReKi) :: dX_low = 0.0_ReKi !< The spacing of the low-resolution nodes in X direction [m] diff --git a/modules/aerodyn/src/AeroAcoustics_Types.f90 b/modules/aerodyn/src/AeroAcoustics_Types.f90 index a68c9e3fcd..ce44f2d6cd 100644 --- a/modules/aerodyn/src/AeroAcoustics_Types.f90 +++ b/modules/aerodyn/src/AeroAcoustics_Types.f90 @@ -42,10 +42,10 @@ MODULE AeroAcoustics_Types ! ======================= ! ========= AA_InitInputType ======= TYPE, PUBLIC :: AA_InitInputType - CHARACTER(1024) :: InputFile = '' !< Name of the input file [-] + CHARACTER(1024) :: InputFile !< Name of the input file [-] INTEGER(IntKi) :: NumBlades = 0_IntKi !< Number of blades on the turbine [-] INTEGER(IntKi) :: NumBlNds = 0_IntKi !< Number of blade nodes [-] - CHARACTER(1024) :: RootName = '' !< RootName for writing output files [-] + CHARACTER(1024) :: RootName !< RootName for writing output files [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlSpn !< Span at blade node [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlChord !< Chord at blade node [m] REAL(ReKi) :: AirDens = 0.0_ReKi !< Air density [kg/m^3] @@ -66,7 +66,7 @@ MODULE AeroAcoustics_Types CHARACTER(25) , DIMENSION(:), ALLOCATABLE :: WriteOutputUntSep !< Units of the output-to-file channels [-] CHARACTER(25) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdrNodes !< Names of the output-to-file channels [-] CHARACTER(25) , DIMENSION(:), ALLOCATABLE :: WriteOutputUntNodes !< Units of the output-to-file channels [-] - character(1) :: delim = '' !< column delimiter [-] + character(1) :: delim !< column delimiter [-] TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] REAL(ReKi) :: AirDens = 0.0_ReKi !< Air density [kg/m^3] END TYPE AA_InitOutputType @@ -94,8 +94,8 @@ MODULE AeroAcoustics_Types TYPE(AA_BladePropsType) , DIMENSION(:), ALLOCATABLE :: BladeProps !< blade property information from blade input files [-] INTEGER(IntKi) :: NrOutFile = 0_IntKi !< Nr of output files [-] CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: AAoutfile !< AAoutfile for writing output files [-] - CHARACTER(1024) :: TICalcTabFile = '' !< Name of the file containing the table for incident turbulence intensity [-] - CHARACTER(1024) :: FTitle = '' !< File Title: the 2nd line of the input file, which contains a description of its contents [-] + CHARACTER(1024) :: TICalcTabFile !< Name of the file containing the table for incident turbulence intensity [-] + CHARACTER(1024) :: FTitle !< File Title: the 2nd line of the input file, which contains a description of its contents [-] REAL(DbKi) :: AAStart = 0.0_R8Ki !< Time after which to calculate AA [s] REAL(ReKi) :: Lturb = 0.0_ReKi !< Turbulent lengthscale in Amiet model [-] REAL(ReKi) :: AvgV = 0.0_ReKi !< Average wind speed to compute incident turbulence intensity [m] @@ -216,10 +216,10 @@ MODULE AeroAcoustics_Types REAL(ReKi) :: dz_turb_in = 0.0_ReKi !< [m] REAL(ReKi) :: dy_turb_in = 0.0_ReKi !< [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TI_Grid_In !< [-] - CHARACTER(1024) :: FTitle = '' !< File Title: the 2nd line of the input file, which contains a description of its contents [-] - character(20) :: outFmt = '' !< Format specifier [-] + CHARACTER(1024) :: FTitle !< File Title: the 2nd line of the input file, which contains a description of its contents [-] + character(20) :: outFmt !< Format specifier [-] INTEGER(IntKi) :: NrOutFile = 0_IntKi !< Nr of output files [-] - character(1) :: delim = '' !< column delimiter [-] + character(1) :: delim !< column delimiter [-] INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] INTEGER(IntKi) :: NumOutsForPE = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] INTEGER(IntKi) :: NumOutsForSep = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] @@ -228,7 +228,7 @@ MODULE AeroAcoustics_Types INTEGER(IntKi) :: unOutFile2 = 0_IntKi !< unit number for writing output file [-] INTEGER(IntKi) :: unOutFile3 = 0_IntKi !< unit number for writing output file [-] INTEGER(IntKi) :: unOutFile4 = 0_IntKi !< unit number for writing output file [-] - CHARACTER(1024) :: RootName = '' !< RootName for writing output files [-] + CHARACTER(1024) :: RootName !< RootName for writing output files [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: StallStart !< ation [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TEThick !< ation [-] diff --git a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 index f31f069dc6..5cfa46275a 100644 --- a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 @@ -63,15 +63,15 @@ MODULE AeroDyn_Driver_Types INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: unOutFile !< unit number for writing output file for each rotor [-] INTEGER(IntKi) :: ActualChanLen = 0_IntKi !< Actual length of channels written to text file (less than or equal to ChanLen) [-] INTEGER(IntKi) :: nDvrOutputs = 0_IntKi !< Number of outputs for the driver (without AD and IW) [-] - character(20) :: Fmt_t = '' !< Format specifier for time channel [-] - character(25) :: Fmt_a = '' !< Format specifier for each column (including delimiter) [-] - character(1) :: delim = '' !< column delimiter [-] - character(20) :: outFmt = '' !< Format specifier [-] + 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 = 0_IntKi !< Output format 1=Text, 2=Binary, 3=Both [-] INTEGER(IntKi) :: wrVTK = 0_IntKi !< 0= no vtk, 1=init only, 2=animation [-] INTEGER(IntKi) :: WrVTK_Type = 0_IntKi !< Flag for VTK output type (1=surface, 2=line, 3=both) [-] - character(1024) :: Root = '' !< Output file rootname [-] - character(1024) :: VTK_OutFileRoot = '' !< Output file rootname for vtk [-] + character(1024) :: 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 [-] @@ -98,7 +98,7 @@ MODULE AeroDyn_Driver_Types INTEGER(IntKi) :: motionType = 0_IntKi !< [-] INTEGER(IntKi) :: iMotion = 0_IntKi !< Stored index to optimize time interpolation [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: motion !< [-] - character(1024) :: motionFileName = '' !< [-] + character(1024) :: motionFileName !< [-] END TYPE BladeData ! ======================= ! ========= HubData ======= @@ -110,7 +110,7 @@ MODULE AeroDyn_Driver_Types REAL(ReKi) :: azimuth = 0.0_ReKi !< rotor position [rad] REAL(ReKi) :: rotSpeed = 0.0_ReKi !< rotor speed [rad/s] REAL(ReKi) :: rotAcc = 0.0_ReKi !< rotor acceleration [rad/s/s] - character(1024) :: motionFileName = '' !< [-] + character(1024) :: motionFileName !< [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: motion !< [-] END TYPE HubData ! ======================= @@ -122,7 +122,7 @@ MODULE AeroDyn_Driver_Types REAL(ReKi) :: yaw = 0.0_ReKi !< rad [rad] REAL(ReKi) :: yawSpeed = 0.0_ReKi !< yawspeed [rad/s] REAL(ReKi) :: yawAcc = 0.0_ReKi !< yawAcceleration [rad/s^2] - character(1024) :: motionFileName = '' !< [-] + character(1024) :: motionFileName !< [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: motion !< [-] END TYPE NacData ! ======================= @@ -155,14 +155,14 @@ MODULE AeroDyn_Driver_Types INTEGER(IntKi) :: degreeOfFreedom = 0_IntKi !< [-] REAL(ReKi) :: amplitude = 0.0_ReKi !< [-] REAL(ReKi) :: frequency = 0.0_ReKi !< [-] - character(1024) :: motionFileName = '' !< [-] + 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 [-] + character(1024) :: AD_InputFile !< Name of AeroDyn input file [-] INTEGER(IntKi) :: MHK = 0_IntKi !< MHK turbine type (switch) {0: not an MHK turbine, 1: fixed MHK turbine, 2: floating MHK turbine} [-] INTEGER(IntKi) :: AnalysisType = 0_IntKi !< 0=Steady Wind, 1=InflowWind [-] REAL(ReKi) :: FldDens = 0.0_ReKi !< Density of working fluid [kg/m^3] @@ -182,7 +182,7 @@ MODULE AeroDyn_Driver_Types INTEGER(IntKi) :: iCase = 0_IntKi !< Current Case being run [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: timeSeries !< Times series inputs when AnalysisType=1, 6 columns, Time, WndSpeed, ShearExp, RotSpd, Pitch, Yaw [-] INTEGER(IntKi) :: iTimeSeries = 0_IntKi !< Stored index to optimize time interpolation [-] - character(1024) :: root = '' !< Output file rootname [-] + 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 @@ -193,7 +193,7 @@ MODULE AeroDyn_Driver_Types TYPE(ADI_Data) :: ADI !< AeroDyn InflowWind Data [-] TYPE(FED_Data) :: FED !< Elastic wind turbine data (Fake ElastoDyn) [-] INTEGER(IntKi) :: errStat = 0_IntKi !< [-] - character(ErrMsgLen) :: errMsg = '' !< [-] + character(ErrMsgLen) :: errMsg !< [-] LOGICAL :: initialized = .false. !< [-] END TYPE AllData ! ======================= diff --git a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 index 9065873875..d0acace6f4 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 @@ -53,7 +53,7 @@ MODULE AeroDyn_Inflow_Types ! ======================= ! ========= ADI_IW_InputData ======= TYPE, PUBLIC :: ADI_IW_InputData - Character(1024) :: InputFile = '' !< Name of InfloWind input file [-] + Character(1024) :: InputFile !< Name of InfloWind input file [-] INTEGER(IntKi) :: CompInflow = 0_IntKi !< 0=Steady Wind, 1=InflowWind [-] REAL(ReKi) :: HWindSpeed = 0.0_ReKi !< RefHeight Wind speed [-] REAL(ReKi) :: RefHt = 0.0_ReKi !< RefHeight [-] @@ -68,7 +68,7 @@ MODULE AeroDyn_Inflow_Types 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 [-] + 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) [-] diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index 20a83313f5..ed9f8838aa 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -62,22 +62,22 @@ MODULE AeroDyn_Types INTEGER(IntKi), PUBLIC, PARAMETER :: AD_MaxBl_Out = 3 ! Maximum number of blades for information output (or linearization) [-] ! ========= TFinParameterType ======= TYPE, PUBLIC :: TFinParameterType - INTEGER(IntKi) :: TFinMod !< Tail fin aerodynamics model {0=none, 1=polar-based, 2=USB-based} [(switch)] - REAL(ReKi) :: TFinChord !< Tail fin chord [used only when TFinMod=1] [m] - REAL(ReKi) :: TFinArea !< Tail fin planform area [used only when TFinMod=1] [m^2] - INTEGER(IntKi) :: TFinIndMod !< Model for induced velocity calculation {0=none, 1=rotor-average} [(switch)] - INTEGER(IntKi) :: TFinAFID !< Index of Tail fin airfoil number [1 to NumAFfiles] [-] + INTEGER(IntKi) :: TFinMod = 0_IntKi !< Tail fin aerodynamics model {0=none, 1=polar-based, 2=USB-based} [(switch)] + REAL(ReKi) :: TFinChord = 0.0_ReKi !< Tail fin chord [used only when TFinMod=1] [m] + REAL(ReKi) :: TFinArea = 0.0_ReKi !< Tail fin planform area [used only when TFinMod=1] [m^2] + INTEGER(IntKi) :: TFinIndMod = 0_IntKi !< Model for induced velocity calculation {0=none, 1=rotor-average} [(switch)] + INTEGER(IntKi) :: TFinAFID = 0_IntKi !< Index of Tail fin airfoil number [1 to NumAFfiles] [-] END TYPE TFinParameterType ! ======================= ! ========= TFinInputFileType ======= TYPE, PUBLIC :: TFinInputFileType - INTEGER(IntKi) :: TFinMod !< Tail fin aerodynamics model {0=none, 1=polar-based, 2=USB-based} [(switch)] - REAL(ReKi) :: TFinChord !< Tail fin chord [used only when TFinMod=1] [m] - REAL(ReKi) :: TFinArea !< Tail fin planform area [used only when TFinMod=1] [m^2] - REAL(ReKi) , DIMENSION(1:3) :: TFinRefP_n !< Undeflected position of the tail fin reference point wrt the tower top [m] - REAL(ReKi) , DIMENSION(1:3) :: TFinAngles !< Tail fin chordline skew, tilt, and bank angles about the reference point [(deg)] - INTEGER(IntKi) :: TFinIndMod !< Model for induced velocity calculation {0=none, 1=rotor-average} [(switch)] - INTEGER(IntKi) :: TFinAFID !< Index of Tail fin airfoil number [1 to NumAFfiles] [-] + INTEGER(IntKi) :: TFinMod = 0_IntKi !< Tail fin aerodynamics model {0=none, 1=polar-based, 2=USB-based} [(switch)] + REAL(ReKi) :: TFinChord = 0.0_ReKi !< Tail fin chord [used only when TFinMod=1] [m] + REAL(ReKi) :: TFinArea = 0.0_ReKi !< Tail fin planform area [used only when TFinMod=1] [m^2] + REAL(ReKi) , DIMENSION(1:3) :: TFinRefP_n = 0.0_ReKi !< Undeflected position of the tail fin reference point wrt the tower top [m] + REAL(ReKi) , DIMENSION(1:3) :: TFinAngles = 0.0_ReKi !< Tail fin chordline skew, tilt, and bank angles about the reference point [(deg)] + INTEGER(IntKi) :: TFinIndMod = 0_IntKi !< Model for induced velocity calculation {0=none, 1=rotor-average} [(switch)] + INTEGER(IntKi) :: TFinAFID = 0_IntKi !< Index of Tail fin airfoil number [1 to NumAFfiles] [-] END TYPE TFinInputFileType ! ======================= ! ========= AD_VTK_BLSurfaceType ======= @@ -93,13 +93,13 @@ MODULE AeroDyn_Types ! ======================= ! ========= RotInitInputType ======= TYPE, PUBLIC :: RotInitInputType - INTEGER(IntKi) :: NumBlades !< Number of blades on the turbine [-] - REAL(ReKi) , DIMENSION(1:3) :: HubPosition !< X-Y-Z reference position of hub [m] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: HubOrientation !< DCM reference orientation of hub [-] + INTEGER(IntKi) :: NumBlades = 0_IntKi !< Number of blades on the turbine [-] + REAL(ReKi) , DIMENSION(1:3) :: HubPosition = 0.0_ReKi !< X-Y-Z reference position of hub [m] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: HubOrientation = 0.0_R8Ki !< DCM reference orientation of hub [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BladeRootPosition !< X-Y-Z reference position of each blade root (3 x NumBlades) [m] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: BladeRootOrientation !< DCM reference orientation of blade roots (3x3 x NumBlades) [-] - REAL(R8Ki) , DIMENSION(1:3) :: NacellePosition !< X-Y-Z reference position of nacelle [m] - REAL(R8Ki) , DIMENSION(1:3,1:3) :: NacelleOrientation !< DCM reference orientation of nacelle [-] + REAL(R8Ki) , DIMENSION(1:3) :: NacellePosition = 0.0_R8Ki !< X-Y-Z reference position of nacelle [m] + REAL(R8Ki) , DIMENSION(1:3,1:3) :: NacelleOrientation = 0.0_R8Ki !< DCM reference orientation of nacelle [-] INTEGER(IntKi) :: AeroProjMod = 1 !< Flag to switch between different projection models [-] INTEGER(IntKi) :: AeroBEM_Mod = -1 !< Flag to switch between different BEM Model [-] END TYPE RotInitInputType @@ -112,20 +112,20 @@ MODULE AeroDyn_Types LOGICAL :: UsePrimaryInputFile = .TRUE. !< Read input file instead of passed data [-] TYPE(FileInfoType) :: PassedPrimaryInputData !< Primary input file as FileInfoType (set by driver/glue code) [-] LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] - REAL(ReKi) :: Gravity !< Gravity force [Nm/s^2] - INTEGER(IntKi) :: MHK !< MHK turbine type switch [-] - REAL(ReKi) :: defFldDens !< Default fluid density from the driver; may be overwritten [kg/m^3] - REAL(ReKi) :: defKinVisc !< Default kinematic viscosity from the driver; may be overwritten [m^2/s] - REAL(ReKi) :: defSpdSound !< Default speed of sound from the driver; may be overwritten [m/s] - REAL(ReKi) :: defPatm !< Default atmospheric pressure from the driver; may be overwritten [Pa] - REAL(ReKi) :: defPvap !< Default vapor pressure from the driver; may be overwritten [Pa] - REAL(ReKi) :: WtrDpth !< Water depth [m] - REAL(ReKi) :: MSL2SWL !< Offset between still-water level and mean sea level [m] + REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravity force [Nm/s^2] + INTEGER(IntKi) :: MHK = 0_IntKi !< MHK turbine type switch [-] + REAL(ReKi) :: defFldDens = 0.0_ReKi !< Default fluid density from the driver; may be overwritten [kg/m^3] + REAL(ReKi) :: defKinVisc = 0.0_ReKi !< Default kinematic viscosity from the driver; may be overwritten [m^2/s] + REAL(ReKi) :: defSpdSound = 0.0_ReKi !< Default speed of sound from the driver; may be overwritten [m/s] + REAL(ReKi) :: defPatm = 0.0_ReKi !< Default atmospheric pressure from the driver; may be overwritten [Pa] + REAL(ReKi) :: defPvap = 0.0_ReKi !< Default vapor pressure from the driver; may be overwritten [Pa] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [m] + REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Offset between still-water level and mean sea level [m] END TYPE AD_InitInputType ! ======================= ! ========= AD_BladePropsType ======= TYPE, PUBLIC :: AD_BladePropsType - INTEGER(IntKi) :: NumBlNds !< Number of blade nodes used in the analysis [-] + INTEGER(IntKi) :: NumBlNds = 0_IntKi !< Number of blade nodes used in the analysis [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlSpn !< Span at blade node [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlCrvAC !< Curve at blade node [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlSwpAC !< Sweep at blade node [m] @@ -145,7 +145,7 @@ MODULE AeroDyn_Types ! ======================= ! ========= RotInitOutputType ======= TYPE, PUBLIC :: RotInitOutputType - REAL(ReKi) :: AirDens !< Air density [kg/m^3] + REAL(ReKi) :: AirDens = 0.0_ReKi !< Air density [kg/m^3] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Names of the output-to-file channels [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] TYPE(AD_BladeShape) , DIMENSION(:), ALLOCATABLE :: BladeShape !< airfoil coordinates for each blade [m] @@ -171,16 +171,16 @@ MODULE AeroDyn_Types ! ========= RotInputFile ======= TYPE, PUBLIC :: RotInputFile TYPE(AD_BladePropsType) , DIMENSION(:), ALLOCATABLE :: BladeProps !< blade property information from blade input files [-] - INTEGER(IntKi) :: NumTwrNds !< Number of tower nodes used in the analysis [-] + INTEGER(IntKi) :: NumTwrNds = 0_IntKi !< Number of tower nodes used in the analysis [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrElev !< Elevation at tower node [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrDiam !< Diameter of tower at node [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrCd !< Coefficient of drag at tower node [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrTI !< Turbulence intensity for tower shadow at tower node [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrCb !< Coefficient of buoyancy at tower node [-] - REAL(ReKi) :: VolHub !< Hub volume [m^3] - REAL(ReKi) :: HubCenBx !< Hub center of buoyancy x direction offset [m] - REAL(ReKi) :: VolNac !< Nacelle volume [m^3] - REAL(ReKi) , DIMENSION(1:3) :: NacCenB !< Position of nacelle center of buoyancy from yaw bearing in nacelle coordinates [m] + REAL(ReKi) :: VolHub = 0.0_ReKi !< Hub volume [m^3] + REAL(ReKi) :: HubCenBx = 0.0_ReKi !< Hub center of buoyancy x direction offset [m] + REAL(ReKi) :: VolNac = 0.0_ReKi !< Nacelle volume [m^3] + REAL(ReKi) , DIMENSION(1:3) :: NacCenB = 0.0_ReKi !< Position of nacelle center of buoyancy from yaw bearing in nacelle coordinates [m] LOGICAL :: TFinAero = .FALSE. !< Calculate tail fin aerodynamics model (flag) [flag] CHARACTER(1024) :: TFinFile !< Input file for tail fin aerodynamics [used only when TFinAero=True] [-] TYPE(TFinInputFileType) :: TFin !< Input file data for tail fin [-] @@ -188,60 +188,60 @@ MODULE AeroDyn_Types ! ======================= ! ========= AD_InputFile ======= TYPE, PUBLIC :: AD_InputFile - LOGICAL :: Echo !< Echo input file to echo file [-] - REAL(DbKi) :: DTAero !< Time interval for aerodynamic calculations {or "default"} [s] - INTEGER(IntKi) :: WakeMod !< Type of wake/induction model {0=none, 1=BEMT, 2=DBEMT, 3=FVW} [-] - INTEGER(IntKi) :: AFAeroMod !< Type of blade airfoil aerodynamics model {1=steady model, 2=Beddoes-Leishman unsteady model} [-] - INTEGER(IntKi) :: TwrPotent !< Type of tower influence on wind based on potential flow around the tower {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] - INTEGER(IntKi) :: TwrShadow !< Type of tower influence on wind based on downstream tower shadow {0=none, 1=Powles model, 2=Eames model} [-] - LOGICAL :: TwrAero !< Calculate tower aerodynamic loads? [flag] - LOGICAL :: FrozenWake !< Flag that tells this module it should assume a frozen wake during linearization. [-] - LOGICAL :: CavitCheck !< Flag that tells us if we want to check for cavitation [-] - LOGICAL :: Buoyancy !< Include buoyancy effects? [flag] - LOGICAL :: CompAA !< Compute AeroAcoustic noise [flag] + LOGICAL :: Echo = .false. !< Echo input file to echo file [-] + REAL(DbKi) :: DTAero = 0.0_R8Ki !< Time interval for aerodynamic calculations {or "default"} [s] + INTEGER(IntKi) :: WakeMod = 0_IntKi !< Type of wake/induction model {0=none, 1=BEMT, 2=DBEMT, 3=FVW} [-] + INTEGER(IntKi) :: AFAeroMod = 0_IntKi !< Type of blade airfoil aerodynamics model {1=steady model, 2=Beddoes-Leishman unsteady model} [-] + INTEGER(IntKi) :: TwrPotent = 0_IntKi !< Type of tower influence on wind based on potential flow around the tower {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] + INTEGER(IntKi) :: TwrShadow = 0_IntKi !< Type of tower influence on wind based on downstream tower shadow {0=none, 1=Powles model, 2=Eames model} [-] + LOGICAL :: TwrAero = .false. !< Calculate tower aerodynamic loads? [flag] + LOGICAL :: FrozenWake = .false. !< Flag that tells this module it should assume a frozen wake during linearization. [-] + LOGICAL :: CavitCheck = .false. !< Flag that tells us if we want to check for cavitation [-] + LOGICAL :: Buoyancy = .false. !< Include buoyancy effects? [flag] + LOGICAL :: CompAA = .false. !< Compute AeroAcoustic noise [flag] CHARACTER(1024) :: AA_InputFile !< AeroAcoustics input file name [quoted strings] CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: ADBlFile !< AD blade file (NumBl filenames) [quoted strings] - REAL(ReKi) :: AirDens !< Air density [kg/m^3] - REAL(ReKi) :: KinVisc !< Kinematic air viscosity [m^2/s] - REAL(ReKi) :: Patm !< Atmospheric pressure [Pa] - REAL(ReKi) :: Pvap !< Vapour pressure [Pa] - REAL(ReKi) :: SpdSound !< Speed of sound [m/s] - INTEGER(IntKi) :: SkewMod !< Type of skewed-wake correction model {0=orthogonal, 1=uncoupled, 2=Pitt/Peters, 3=coupled} [unused when WakeMod=0] [-] - REAL(ReKi) :: SkewModFactor !< Constant used in Pitt/Peters skewed wake model (default is 15*pi/32) [-] - LOGICAL :: TipLoss !< Use the Prandtl tip-loss model? [unused when WakeMod=0] [flag] - LOGICAL :: HubLoss !< Use the Prandtl hub-loss model? [unused when WakeMod=0] [flag] - LOGICAL :: TanInd !< Include tangential induction in BEMT calculations? [unused when WakeMod=0] [flag] - LOGICAL :: AIDrag !< Include the drag term in the axial-induction calculation? [unused when WakeMod=0] [flag] - LOGICAL :: TIDrag !< Include the drag term in the tangential-induction calculation? [unused when WakeMod=0 or TanInd=FALSE] [flag] - REAL(ReKi) :: IndToler !< Convergence tolerance for BEM induction factors [unused when WakeMod=0] [-] - REAL(ReKi) :: MaxIter !< Maximum number of iteration steps [unused when WakeMod=0] [-] - INTEGER(IntKi) :: UAMod !< Unsteady Aero Model Switch (switch) {1=Baseline model (Original), 2=Gonzalez's variant (changes in Cn,Cc,Cm), 3=Minnema/Pierce variant (changes in Cc and Cm)} [used only when AFAeroMod=2] [-] - LOGICAL :: FLookup !< Flag to indicate whether a lookup for f' will be calculated (TRUE) or whether best-fit exponential equations will be used (FALSE); if FALSE S1-S4 must be provided in airfoil input files [used only when AFAeroMod=2] [flag] - REAL(ReKi) :: InCol_Alfa !< The column in the airfoil tables that contains the angle of attack [-] - REAL(ReKi) :: InCol_Cl !< The column in the airfoil tables that contains the lift coefficient [-] - REAL(ReKi) :: InCol_Cd !< The column in the airfoil tables that contains the drag coefficient [-] - REAL(ReKi) :: InCol_Cm !< The column in the airfoil tables that contains the pitching-moment coefficient; use zero if there is no Cm column [-] - REAL(ReKi) :: InCol_Cpmin !< The column in the airfoil tables that contains the drag coefficient; use zero if there is no Cpmin column [-] - INTEGER(IntKi) :: AFTabMod !< Interpolation method for multiple airfoil tables {1 = 1D on AoA (only first table is used); 2 = 2D on AoA and Re; 3 = 2D on AoA and UserProp} [-] - INTEGER(IntKi) :: NumAFfiles !< Number of airfoil files used [-] + REAL(ReKi) :: AirDens = 0.0_ReKi !< Air density [kg/m^3] + REAL(ReKi) :: KinVisc = 0.0_ReKi !< Kinematic air viscosity [m^2/s] + REAL(ReKi) :: Patm = 0.0_ReKi !< Atmospheric pressure [Pa] + REAL(ReKi) :: Pvap = 0.0_ReKi !< Vapour pressure [Pa] + REAL(ReKi) :: SpdSound = 0.0_ReKi !< Speed of sound [m/s] + INTEGER(IntKi) :: SkewMod = 0_IntKi !< Type of skewed-wake correction model {0=orthogonal, 1=uncoupled, 2=Pitt/Peters, 3=coupled} [unused when WakeMod=0] [-] + REAL(ReKi) :: SkewModFactor = 0.0_ReKi !< Constant used in Pitt/Peters skewed wake model (default is 15*pi/32) [-] + LOGICAL :: TipLoss = .false. !< Use the Prandtl tip-loss model? [unused when WakeMod=0] [flag] + LOGICAL :: HubLoss = .false. !< Use the Prandtl hub-loss model? [unused when WakeMod=0] [flag] + LOGICAL :: TanInd = .false. !< Include tangential induction in BEMT calculations? [unused when WakeMod=0] [flag] + LOGICAL :: AIDrag = .false. !< Include the drag term in the axial-induction calculation? [unused when WakeMod=0] [flag] + LOGICAL :: TIDrag = .false. !< Include the drag term in the tangential-induction calculation? [unused when WakeMod=0 or TanInd=FALSE] [flag] + REAL(ReKi) :: IndToler = 0.0_ReKi !< Convergence tolerance for BEM induction factors [unused when WakeMod=0] [-] + REAL(ReKi) :: MaxIter = 0.0_ReKi !< Maximum number of iteration steps [unused when WakeMod=0] [-] + INTEGER(IntKi) :: UAMod = 0_IntKi !< Unsteady Aero Model Switch (switch) {1=Baseline model (Original), 2=Gonzalez's variant (changes in Cn,Cc,Cm), 3=Minnema/Pierce variant (changes in Cc and Cm)} [used only when AFAeroMod=2] [-] + LOGICAL :: FLookup = .false. !< Flag to indicate whether a lookup for f' will be calculated (TRUE) or whether best-fit exponential equations will be used (FALSE); if FALSE S1-S4 must be provided in airfoil input files [used only when AFAeroMod=2] [flag] + REAL(ReKi) :: InCol_Alfa = 0.0_ReKi !< The column in the airfoil tables that contains the angle of attack [-] + REAL(ReKi) :: InCol_Cl = 0.0_ReKi !< The column in the airfoil tables that contains the lift coefficient [-] + REAL(ReKi) :: InCol_Cd = 0.0_ReKi !< The column in the airfoil tables that contains the drag coefficient [-] + REAL(ReKi) :: InCol_Cm = 0.0_ReKi !< The column in the airfoil tables that contains the pitching-moment coefficient; use zero if there is no Cm column [-] + REAL(ReKi) :: InCol_Cpmin = 0.0_ReKi !< The column in the airfoil tables that contains the drag coefficient; use zero if there is no Cpmin column [-] + INTEGER(IntKi) :: AFTabMod = 0_IntKi !< Interpolation method for multiple airfoil tables {1 = 1D on AoA (only first table is used); 2 = 2D on AoA and Re; 3 = 2D on AoA and UserProp} [-] + INTEGER(IntKi) :: NumAFfiles = 0_IntKi !< Number of airfoil files used [-] CHARACTER(1024) :: FVWFileName !< FVW input filename [quoted string] CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: AFNames !< Airfoil file names (NumAF lines) [quoted strings] - LOGICAL :: UseBlCm !< Include aerodynamic pitching moment in calculations? [flag] - LOGICAL :: SumPrint !< Generate a summary file listing input options and interpolated properties to ".AD.sum"? [flag] - INTEGER(IntKi) :: NBlOuts !< Number of blade node outputs [0 - 9] [-] - INTEGER(IntKi) , DIMENSION(1:9) :: BlOutNd !< Blade nodes whose values will be output [-] - INTEGER(IntKi) :: NTwOuts !< Number of tower node outputs [0 - 9] [-] - INTEGER(IntKi) , DIMENSION(1:9) :: TwOutNd !< Tower nodes whose values will be output [-] - INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] + LOGICAL :: UseBlCm = .false. !< Include aerodynamic pitching moment in calculations? [flag] + LOGICAL :: SumPrint = .false. !< Generate a summary file listing input options and interpolated properties to ".AD.sum"? [flag] + INTEGER(IntKi) :: NBlOuts = 0_IntKi !< Number of blade node outputs [0 - 9] [-] + INTEGER(IntKi) , DIMENSION(1:9) :: BlOutNd = 0_IntKi !< Blade nodes whose values will be output [-] + INTEGER(IntKi) :: NTwOuts = 0_IntKi !< Number of tower node outputs [0 - 9] [-] + INTEGER(IntKi) , DIMENSION(1:9) :: TwOutNd = 0_IntKi !< Tower nodes whose values will be output [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< List of user-requested output channels [-] - REAL(ReKi) :: tau1_const !< time constant for DBEMT [used only when WakeMod=2 and DBEMT_Mod/=2] [s] - INTEGER(IntKi) :: DBEMT_Mod !< Type of dynamic BEMT (DBEMT) model {1=constant tau1, 2=time-dependent tau1} [-] - INTEGER(IntKi) :: BldNd_NumOuts !< Number of requested output channels per blade node (AD_AllBldNdOuts) [-] + REAL(ReKi) :: tau1_const = 0.0_ReKi !< time constant for DBEMT [used only when WakeMod=2 and DBEMT_Mod/=2] [s] + INTEGER(IntKi) :: DBEMT_Mod = 0_IntKi !< Type of dynamic BEMT (DBEMT) model {1=constant tau1, 2=time-dependent tau1} [-] + INTEGER(IntKi) :: BldNd_NumOuts = 0_IntKi !< Number of requested output channels per blade node (AD_AllBldNdOuts) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: BldNd_OutList !< List of user-requested output channels (AD_AllBldNdOuts) [-] CHARACTER(1024) :: BldNd_BlOutNd_Str !< String to parse for the blade nodes to actually output (AD_AllBldNdOuts) [-] - INTEGER(IntKi) :: BldNd_BladesOut !< The blades to output (AD_AllBldNdOuts) [-] - REAL(ReKi) :: UAStartRad !< Starting [radius] - REAL(ReKi) :: UAEndRad !< Ending [radius] + INTEGER(IntKi) :: BldNd_BladesOut = 0_IntKi !< The blades to output (AD_AllBldNdOuts) [-] + REAL(ReKi) :: UAStartRad = 0.0_ReKi !< Starting [radius] + REAL(ReKi) :: UAEndRad = 0.0_ReKi !< Ending [radius] TYPE(RotInputFile) , DIMENSION(:), ALLOCATABLE :: rotors !< Rotor (blades and tower) input file data [-] END TYPE AD_InputFile ! ======================= @@ -317,11 +317,11 @@ MODULE AeroDyn_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Mx !< pitching moment per unit length of the jth node in the kth blade (in x direction) [Nm/m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: My !< pitching moment per unit length of the jth node in the kth blade (in y direction) [Nm/m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Mz !< pitching moment per unit length of the jth node in the kth blade (in z direction) [Nm/m] - REAL(ReKi) , DIMENSION(1:3) :: V_DiskAvg !< disk-average relative wind speed [m/s] - REAL(ReKi) :: yaw !< Yaw calculated in SetInputsForBEMT [rad] - REAL(ReKi) :: tilt !< tilt calculated in SetInputsForBEMT [rad] + REAL(ReKi) , DIMENSION(1:3) :: V_DiskAvg = 0.0_ReKi !< disk-average relative wind speed [m/s] + REAL(ReKi) :: yaw = 0.0_ReKi !< Yaw calculated in SetInputsForBEMT [rad] + REAL(ReKi) :: tilt = 0.0_ReKi !< tilt calculated in SetInputsForBEMT [rad] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: hub_theta_x_root !< angles saved for FAST.Farm [rad] - REAL(ReKi) :: V_dot_x + REAL(ReKi) :: V_dot_x = 0.0_ReKi TYPE(MeshType) :: HubLoad !< mesh at hub; used to compute an integral for mapping the output blade loads to a single point (for writing to file only) [-] TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: B_L_2_H_P !< mapping data structure to map each bladeLoad output mesh to the MiscVar%HubLoad mesh [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: SigmaCavitCrit !< critical cavitation number- inception value (above which cavit will occur) [-] @@ -343,18 +343,18 @@ MODULE AeroDyn_Types TYPE(MeshType) :: TwrBuoyLoadPoint !< point mesh for lumped buoyant tower loads [-] TYPE(MeshType) :: TwrBuoyLoad !< line mesh for per unit length buoyant tower loads [-] TYPE(MeshMapType) :: T_P_2_T_L !< mapping data structure to map buoyant tower point loads (m%TwrBuoyLoadPoint) to buoyant tower line loads (m%TwrBuoyLoad) [-] - LOGICAL :: FirstWarn_TowerStrike !< flag to avoid printing tower strike multiple times [-] - REAL(ReKi) , DIMENSION(1:3) :: AvgDiskVel !< disk-averaged U,V,W (undisturbed) [m/s] - REAL(ReKi) , DIMENSION(1:3) :: AvgDiskVelDist !< disk-averaged U,V,W (disturbed) [m/s] - REAL(ReKi) :: TFinAlpha !< Angle of attack for tailfin [-] - REAL(ReKi) :: TFinRe !< Reynolds number for tailfin [-] - REAL(ReKi) :: TFinVrel !< Orthogonal relative velocity nrom at the reference point [-] - REAL(ReKi) , DIMENSION(1:3) :: TFinVund_i !< Undisturbed wind velocity at the reference point of the fin in the inertial system [-] - REAL(ReKi) , DIMENSION(1:3) :: TFinVind_i !< Induced velocity at the reference point of the fin in the inertial system [-] - REAL(ReKi) , DIMENSION(1:3) :: TFinVrel_i !< Relative velocity at the reference point of the fin in the inertial system [-] - REAL(ReKi) , DIMENSION(1:3) :: TFinSTV_i !< Structural velocity at the reference point of the fin in the inertial system [-] - REAL(ReKi) , DIMENSION(1:3) :: TFinF_i !< Forces at the reference point of the fin in the inertial system [-] - REAL(ReKi) , DIMENSION(1:3) :: TFinM_i !< Moments at the reference point of the fin in the inertial system [-] + LOGICAL :: FirstWarn_TowerStrike = .false. !< flag to avoid printing tower strike multiple times [-] + REAL(ReKi) , DIMENSION(1:3) :: AvgDiskVel = 0.0_ReKi !< disk-averaged U,V,W (undisturbed) [m/s] + REAL(ReKi) , DIMENSION(1:3) :: AvgDiskVelDist = 0.0_ReKi !< disk-averaged U,V,W (disturbed) [m/s] + REAL(ReKi) :: TFinAlpha = 0.0_ReKi !< Angle of attack for tailfin [-] + REAL(ReKi) :: TFinRe = 0.0_ReKi !< Reynolds number for tailfin [-] + REAL(ReKi) :: TFinVrel = 0.0_ReKi !< Orthogonal relative velocity nrom at the reference point [-] + REAL(ReKi) , DIMENSION(1:3) :: TFinVund_i = 0.0_ReKi !< Undisturbed wind velocity at the reference point of the fin in the inertial system [-] + REAL(ReKi) , DIMENSION(1:3) :: TFinVind_i = 0.0_ReKi !< Induced velocity at the reference point of the fin in the inertial system [-] + REAL(ReKi) , DIMENSION(1:3) :: TFinVrel_i = 0.0_ReKi !< Relative velocity at the reference point of the fin in the inertial system [-] + REAL(ReKi) , DIMENSION(1:3) :: TFinSTV_i = 0.0_ReKi !< Structural velocity at the reference point of the fin in the inertial system [-] + REAL(ReKi) , DIMENSION(1:3) :: TFinF_i = 0.0_ReKi !< Forces at the reference point of the fin in the inertial system [-] + REAL(ReKi) , DIMENSION(1:3) :: TFinM_i = 0.0_ReKi !< Moments at the reference point of the fin in the inertial system [-] END TYPE RotMiscVarType ! ======================= ! ========= AD_MiscVarType ======= @@ -370,9 +370,9 @@ MODULE AeroDyn_Types ! ======================= ! ========= RotParameterType ======= TYPE, PUBLIC :: RotParameterType - INTEGER(IntKi) :: NumBlades !< Number of blades on the turbine [-] - INTEGER(IntKi) :: NumBlNds !< Number of nodes on each blade [-] - INTEGER(IntKi) :: NumTwrNds !< Number of nodes on the tower [-] + INTEGER(IntKi) :: NumBlades = 0_IntKi !< Number of blades on the turbine [-] + INTEGER(IntKi) :: NumBlNds = 0_IntKi !< Number of nodes on each blade [-] + INTEGER(IntKi) :: NumTwrNds = 0_IntKi !< Number of nodes on the tower [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrDiam !< Diameter of tower at node [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrCd !< Coefficient of drag at tower node [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrTI !< Turbulence intensity for tower shadow at tower node [-] @@ -380,12 +380,12 @@ MODULE AeroDyn_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrCb !< Coefficient of buoyancy at tower node [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlCenBn !< Normal offset between aerodynamic center and center of buoyancy at blade node [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlCenBt !< Tangential offset between aerodynamic center and center of buoyancy at blade node [m] - REAL(ReKi) :: VolHub !< Hub volume [m^3] - REAL(ReKi) :: HubCenBx !< Hub center of buoyancy x direction offset [m] - REAL(ReKi) :: VolNac !< Nacelle volume [m^3] - REAL(ReKi) , DIMENSION(1:3) :: NacCenB !< Position of nacelle center of buoyancy from yaw bearing in nacelle coordinates [m] - REAL(ReKi) :: VolBl !< Buoyancy volume of all blades [m^3] - REAL(ReKi) :: VolTwr !< Buoyancy volume of the tower [m^3] + REAL(ReKi) :: VolHub = 0.0_ReKi !< Hub volume [m^3] + REAL(ReKi) :: HubCenBx = 0.0_ReKi !< Hub center of buoyancy x direction offset [m] + REAL(ReKi) :: VolNac = 0.0_ReKi !< Nacelle volume [m^3] + REAL(ReKi) , DIMENSION(1:3) :: NacCenB = 0.0_ReKi !< Position of nacelle center of buoyancy from yaw bearing in nacelle coordinates [m] + REAL(ReKi) :: VolBl = 0.0_ReKi !< Buoyancy volume of all blades [m^3] + REAL(ReKi) :: VolTwr = 0.0_ReKi !< Buoyancy volume of the tower [m^3] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlRad !< Matrix of equivalent blade radius at each node, used in buoyancy calculation [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlDL !< Matrix of blade element length based on CB, used in buoyancy calculation [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlTaper !< Matrix of blade element taper, used in buoyancy calculation [-] @@ -399,38 +399,38 @@ MODULE AeroDyn_Types INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: du !< vector that determines size of perturbation for u (inputs) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dx !< vector that determines size of perturbation for x (continuous states) [-] - INTEGER(IntKi) :: Jac_ny !< number of outputs in jacobian matrix [-] - INTEGER(IntKi) :: NumBl_Lin !< number of blades in the jacobian [-] - INTEGER(IntKi) :: TwrPotent !< Type of tower influence on wind based on potential flow around the tower {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] - INTEGER(IntKi) :: TwrShadow !< Type of tower influence on wind based on downstream tower shadow {0=none, 1=Powles model, 2=Eames model} [-] - LOGICAL :: TwrAero !< Calculate tower aerodynamic loads? [flag] - LOGICAL :: FrozenWake !< Flag that tells this module it should assume a frozen wake during linearization. [-] - LOGICAL :: CavitCheck !< Flag that tells us if we want to check for cavitation [-] - LOGICAL :: Buoyancy !< Include buoyancy effects? [flag] - INTEGER(IntKi) :: MHK !< MHK [flag] - LOGICAL :: CompAA !< Compute AeroAcoustic noise [flag] - REAL(ReKi) :: AirDens !< Air density [kg/m^3] - REAL(ReKi) :: KinVisc !< Kinematic air viscosity [m^2/s] - REAL(ReKi) :: SpdSound !< Speed of sound [m/s] - REAL(ReKi) :: Gravity !< Gravitational acceleration [m/s^2] - REAL(ReKi) :: Patm !< Atmospheric pressure [Pa] - REAL(ReKi) :: Pvap !< Vapour pressure [Pa] - REAL(ReKi) :: WtrDpth !< Water depth [m] - REAL(ReKi) :: MSL2SWL !< Offset between still-water level and mean sea level [m] + INTEGER(IntKi) :: Jac_ny = 0_IntKi !< number of outputs in jacobian matrix [-] + INTEGER(IntKi) :: NumBl_Lin = 0_IntKi !< number of blades in the jacobian [-] + INTEGER(IntKi) :: TwrPotent = 0_IntKi !< Type of tower influence on wind based on potential flow around the tower {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] + INTEGER(IntKi) :: TwrShadow = 0_IntKi !< Type of tower influence on wind based on downstream tower shadow {0=none, 1=Powles model, 2=Eames model} [-] + LOGICAL :: TwrAero = .false. !< Calculate tower aerodynamic loads? [flag] + LOGICAL :: FrozenWake = .false. !< Flag that tells this module it should assume a frozen wake during linearization. [-] + LOGICAL :: CavitCheck = .false. !< Flag that tells us if we want to check for cavitation [-] + LOGICAL :: Buoyancy = .false. !< Include buoyancy effects? [flag] + INTEGER(IntKi) :: MHK = 0_IntKi !< MHK [flag] + LOGICAL :: CompAA = .false. !< Compute AeroAcoustic noise [flag] + REAL(ReKi) :: AirDens = 0.0_ReKi !< Air density [kg/m^3] + REAL(ReKi) :: KinVisc = 0.0_ReKi !< Kinematic air viscosity [m^2/s] + REAL(ReKi) :: SpdSound = 0.0_ReKi !< Speed of sound [m/s] + REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravitational acceleration [m/s^2] + REAL(ReKi) :: Patm = 0.0_ReKi !< Atmospheric pressure [Pa] + REAL(ReKi) :: Pvap = 0.0_ReKi !< Vapour pressure [Pa] + REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [m] + REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Offset between still-water level and mean sea level [m] INTEGER(IntKi) :: AeroProjMod = 1 !< Flag to switch between different projection models [-] INTEGER(IntKi) :: AeroBEM_Mod = -1 !< Flag to switch between different BEM Model [-] - INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] CHARACTER(1024) :: RootName !< RootName for writing output files [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] - INTEGER(IntKi) :: NBlOuts !< Number of blade node outputs [0 - 9] [-] - INTEGER(IntKi) , DIMENSION(1:9) :: BlOutNd !< Blade nodes whose values will be output [-] - INTEGER(IntKi) :: NTwOuts !< Number of tower node outputs [0 - 9] [-] - INTEGER(IntKi) , DIMENSION(1:9) :: TwOutNd !< Tower nodes whose values will be output [-] - INTEGER(IntKi) :: BldNd_NumOuts !< Number of requested output channels per blade node (AD_AllBldNdOuts) [-] - INTEGER(IntKi) :: BldNd_TotNumOuts !< Total number of requested output channels of blade node information (BldNd_NumOuts * BldNd_BlOutNd * BldNd_BladesOut -- AD_AllBldNdOuts) [-] + INTEGER(IntKi) :: NBlOuts = 0_IntKi !< Number of blade node outputs [0 - 9] [-] + INTEGER(IntKi) , DIMENSION(1:9) :: BlOutNd = 0_IntKi !< Blade nodes whose values will be output [-] + INTEGER(IntKi) :: NTwOuts = 0_IntKi !< Number of tower node outputs [0 - 9] [-] + INTEGER(IntKi) , DIMENSION(1:9) :: TwOutNd = 0_IntKi !< Tower nodes whose values will be output [-] + INTEGER(IntKi) :: BldNd_NumOuts = 0_IntKi !< Number of requested output channels per blade node (AD_AllBldNdOuts) [-] + INTEGER(IntKi) :: BldNd_TotNumOuts = 0_IntKi !< Total number of requested output channels of blade node information (BldNd_NumOuts * BldNd_BlOutNd * BldNd_BladesOut -- AD_AllBldNdOuts) [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: BldNd_OutParam !< Names and units (and other characteristics) of all requested output parameters [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: BldNd_BlOutNd !< The blade nodes to actually output (AD_AllBldNdOuts) [-] - INTEGER(IntKi) :: BldNd_BladesOut !< The blades to output (AD_AllBldNdOuts) [-] + INTEGER(IntKi) :: BldNd_BladesOut = 0_IntKi !< The blades to output (AD_AllBldNdOuts) [-] LOGICAL :: TFinAero = .FALSE. !< Calculate tail fin aerodynamics model (flag) [flag] TYPE(TFinParameterType) :: TFin !< Parameters for tail fin of current rotor [-] END TYPE RotParameterType @@ -438,14 +438,14 @@ MODULE AeroDyn_Types ! ========= AD_ParameterType ======= TYPE, PUBLIC :: AD_ParameterType TYPE(RotParameterType) , DIMENSION(:), ALLOCATABLE :: rotors !< Parameter types for each rotor [-] - REAL(DbKi) :: DT !< Time step for continuous state integration & discrete state update [seconds] + REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for continuous state integration & discrete state update [seconds] CHARACTER(1024) :: RootName !< RootName for writing output files [-] TYPE(AFI_ParameterType) , DIMENSION(:), ALLOCATABLE :: AFI !< AirfoilInfo parameters [-] - INTEGER(IntKi) :: SkewMod !< Type of skewed-wake correction model {0=orthogonal, 1=uncoupled, 2=Pitt/Peters, 3=coupled} [unused when WakeMod=0] [-] - INTEGER(IntKi) :: WakeMod !< Type of wake/induction model {0=none, 1=BEMT, 2=DBEMT, 3=FVW} [-] + INTEGER(IntKi) :: SkewMod = 0_IntKi !< Type of skewed-wake correction model {0=orthogonal, 1=uncoupled, 2=Pitt/Peters, 3=coupled} [unused when WakeMod=0] [-] + INTEGER(IntKi) :: WakeMod = 0_IntKi !< Type of wake/induction model {0=none, 1=BEMT, 2=DBEMT, 3=FVW} [-] TYPE(FVW_ParameterType) :: FVW !< Parameters for FVW module [-] LOGICAL :: CompAeroMaps = .FALSE. !< flag to determine if AeroDyn is computing aero maps (true) or running a normal simulation (false) [-] - LOGICAL :: UA_Flag !< logical flag indicating whether to use UnsteadyAero [-] + LOGICAL :: UA_Flag = .false. !< logical flag indicating whether to use UnsteadyAero [-] TYPE(FlowFieldType) , POINTER :: FlowField => NULL() !< Pointer of InflowWinds flow field data type [-] END TYPE AD_ParameterType ! ======================= @@ -459,9 +459,9 @@ MODULE AeroDyn_Types TYPE(MeshType) :: TFinMotion !< motion of tail fin (at tail fin ref point) [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: InflowOnBlade !< U,V,W at nodes on each blade (note if we change the requirement that NumNodes is the same for each blade, this will need to change) [m/s] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: InflowOnTower !< U,V,W at nodes on the tower [m/s] - REAL(ReKi) , DIMENSION(1:3) :: InflowOnHub !< U,V,W at hub [m/s] - REAL(ReKi) , DIMENSION(1:3) :: InflowOnNacelle !< U,V,W at nacelle [m/s] - REAL(ReKi) , DIMENSION(1:3) :: InflowOnTailFin !< U,V,W at tailfin [m/s] + REAL(ReKi) , DIMENSION(1:3) :: InflowOnHub = 0.0_ReKi !< U,V,W at hub [m/s] + REAL(ReKi) , DIMENSION(1:3) :: InflowOnNacelle = 0.0_ReKi !< U,V,W at nacelle [m/s] + REAL(ReKi) , DIMENSION(1:3) :: InflowOnTailFin = 0.0_ReKi !< U,V,W at tailfin [m/s] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: UserProp !< Optional user property for interpolating airfoils (per element per blade) [-] END TYPE RotInputType ! ======================= diff --git a/modules/aerodyn/src/AirfoilInfo_Types.f90 b/modules/aerodyn/src/AirfoilInfo_Types.f90 index 905bf50529..c5db46e711 100644 --- a/modules/aerodyn/src/AirfoilInfo_Types.f90 +++ b/modules/aerodyn/src/AirfoilInfo_Types.f90 @@ -142,7 +142,7 @@ MODULE AirfoilInfo_Types ! ======================= ! ========= AFI_InitInputType ======= TYPE, PUBLIC :: AFI_InitInputType - CHARACTER(1024) :: FileName = '' !< The name of the file the data is read from [-] + CHARACTER(1024) :: FileName !< The name of the file the data is read from [-] INTEGER(IntKi) :: AFTabMod = 0_IntKi !< Interpolation method for multiple airfoil tables {1 = 1D on AoA (only first table is used); 2 = 2D on AoA and Re; 3 = 2D on AoA and UserProp} [-] INTEGER(IntKi) :: InCol_Alfa = 0_IntKi !< The column of the coefficient tables that holds the angle of attack [-] INTEGER(IntKi) :: InCol_Cl = 0_IntKi !< The column of the coefficient tables that holds the lift coefficient [-] @@ -174,8 +174,8 @@ MODULE AirfoilInfo_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Y_Coord !< Y-coordinate for the airfoil shape [unused] [-] INTEGER(IntKi) :: NumTabs = 0_IntKi !< The number of airfoil tables in the airfoil file [-] TYPE(AFI_Table_Type) , DIMENSION(:), ALLOCATABLE :: Table !< The tables of airfoil data for given Re and control setting [-] - CHARACTER(1024) :: BL_file = '' !< The name of the file with the boundary layer data [-] - CHARACTER(1024) :: FileName = '' !< The name of the file that stored this information. [-] + CHARACTER(1024) :: BL_file !< The name of the file with the boundary layer data [-] + CHARACTER(1024) :: FileName !< The name of the file that stored this information. [-] END TYPE AFI_ParameterType ! ======================= ! ========= AFI_InputType ======= diff --git a/modules/aerodyn/src/BEMT_Types.f90 b/modules/aerodyn/src/BEMT_Types.f90 index aef0e5b109..4d04f21756 100644 --- a/modules/aerodyn/src/BEMT_Types.f90 +++ b/modules/aerodyn/src/BEMT_Types.f90 @@ -76,7 +76,7 @@ MODULE BEMT_Types REAL(ReKi) :: yawCorrFactor = 0.0_ReKi !< constant used in Pitt/Peters skewed wake model (default is 15*pi/32) [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: UAOff_innerNode !< Last node on each blade where UA should be turned off based on span location from blade root (0 if always on) [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: UAOff_outerNode !< First node on each blade where UA should be turned off based on span location from blade tip (>nNodesPerBlade if always on) [-] - CHARACTER(1024) :: RootName = '' !< RootName for writing output files [-] + CHARACTER(1024) :: RootName !< RootName for writing output files [-] LOGICAL :: SumPrint = .false. !< logical flag indicating whether to use UnsteadyAero [-] INTEGER(IntKi) :: BEM_Mod = 0_IntKi !< BEM Model 0=OpenFAST 2=Envision [-] END TYPE BEMT_InitInputType diff --git a/modules/aerodyn/src/FVW_Types.f90 b/modules/aerodyn/src/FVW_Types.f90 index e0172c5512..b540c57f64 100644 --- a/modules/aerodyn/src/FVW_Types.f90 +++ b/modules/aerodyn/src/FVW_Types.f90 @@ -39,7 +39,7 @@ MODULE FVW_Types INTEGER(IntKi), PUBLIC, PARAMETER :: idGridVelVorticity = 2 ! Grid stores velocity and vorticity [-] ! ========= GridOutType ======= TYPE, PUBLIC :: GridOutType - CHARACTER(100) :: name = '' !< Grid name [-] + CHARACTER(100) :: name !< Grid name [-] INTEGER(IntKi) :: type = 0_IntKi !< Grid type [-] REAL(ReKi) :: tStart = 0.0_ReKi !< Time at which outputs starts [-] REAL(ReKi) :: tEnd = 0.0_ReKi !< Time at which outputs ends [-] @@ -131,9 +131,9 @@ MODULE FVW_Types INTEGER(IntKi) :: VTKBlades = 0_IntKi !< Outputs VTk for each blade 0=no blade, 1=Bld 1 [-] REAL(DbKi) :: DTvtk = 0.0_R8Ki !< DT between vtk writes [s] INTEGER(IntKi) :: VTKCoord = 0_IntKi !< Switch for VTK outputs coordinate system [-] - CHARACTER(1024) :: RootName = '' !< RootName for writing output files [-] - CHARACTER(1024) :: VTK_OutFileRoot = '' !< Rootdirectory for writing VTK files [-] - CHARACTER(1024) :: VTK_OutFileBase = '' !< Basename for writing VTK files [-] + CHARACTER(1024) :: RootName !< RootName for writing output files [-] + CHARACTER(1024) :: VTK_OutFileRoot !< Rootdirectory for writing VTK files [-] + CHARACTER(1024) :: VTK_OutFileBase !< Basename for writing VTK files [-] INTEGER(IntKi) :: nGridOut = 0_IntKi !< Number of VTK grid to output [-] LOGICAL :: InductionAtCP = .true. !< Compute induced velocities at nodes or CP [-] LOGICAL :: WakeAtTE = .true. !< Start the wake at the trailing edge, or at the LL [-] @@ -297,8 +297,8 @@ MODULE FVW_Types ! ======================= ! ========= FVW_InitInputType ======= TYPE, PUBLIC :: FVW_InitInputType - CHARACTER(1024) :: FVWFileName = '' !< Main FVW input file name [-] - CHARACTER(1024) :: RootName = '' !< RootName for writing output files [-] + CHARACTER(1024) :: FVWFileName !< Main FVW input file name [-] + CHARACTER(1024) :: RootName !< RootName for writing output files [-] TYPE(Wng_InitInputType) , DIMENSION(:), ALLOCATABLE :: W !< Number of blades [-] TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: WingsMesh !< Input Mesh defining position and orientation of wings (nSpan+1) [-] INTEGER(IntKi) :: numBladeNodes = 0_IntKi !< Number of nodes on each blade [-] @@ -316,7 +316,7 @@ MODULE FVW_Types ! ========= FVW_InputFile ======= TYPE, PUBLIC :: FVW_InputFile INTEGER(IntKi) :: CircSolvMethod = 0_IntKi !< Method to determine the circulation [-] - CHARACTER(1024) :: CirculationFile = '' !< Prescribed circulation file [-] + CHARACTER(1024) :: CirculationFile !< Prescribed circulation file [-] INTEGER(IntKi) :: CircSolvMaxIter = 0_IntKi !< Maximum number of iterations for circulation solving [-] REAL(ReKi) :: CircSolvConvCrit = 0.0_ReKi !< Convergence criterion for circulation solving [-] REAL(ReKi) :: CircSolvRelaxation = 0.0_ReKi !< Relaxation factor for circulation solving [-] diff --git a/modules/aerodyn/src/UnsteadyAero_Types.f90 b/modules/aerodyn/src/UnsteadyAero_Types.f90 index 1fe00c76c3..0ecc3897fb 100644 --- a/modules/aerodyn/src/UnsteadyAero_Types.f90 +++ b/modules/aerodyn/src/UnsteadyAero_Types.f90 @@ -44,7 +44,7 @@ MODULE UnsteadyAero_Types ! ========= UA_InitInputType ======= TYPE, PUBLIC :: UA_InitInputType REAL(DbKi) :: dt = 0.0_R8Ki !< time step [s] - CHARACTER(1024) :: OutRootName = '' !< Supplied by Driver: The name of the root file (without extension) including the full path [-] + CHARACTER(1024) :: OutRootName !< Supplied by Driver: The name of the root file (without extension) including the full path [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: c !< Chord length at node [m] INTEGER(IntKi) :: numBlades = 0_IntKi !< Number nodes of all blades [-] INTEGER(IntKi) :: nNodesPerBlade = 0_IntKi !< Number nodes per blades [-] @@ -214,9 +214,9 @@ MODULE UnsteadyAero_Types REAL(ReKi) :: a_s = 0.0_ReKi !< speed of sound [m/s] INTEGER(IntKi) :: NumOuts = 0 !< Number of outputs [-] INTEGER(IntKi) :: OutSwtch = 0_IntKi !< Output requested channels to: [1=Unsteady.out 2=GlueCode.out 3=both files] [-] - CHARACTER(20) :: OutFmt = '' !< Output format for numerical results [-] - CHARACTER(20) :: OutSFmt = '' !< Output format for header strings [-] - CHARACTER(1) :: Delim = '' !< Delimiter string for outputs, defaults to tab-delimiters [-] + CHARACTER(20) :: OutFmt !< Output format for numerical results [-] + CHARACTER(20) :: OutSFmt !< Output format for header strings [-] + CHARACTER(1) :: Delim !< Delimiter string for outputs, defaults to tab-delimiters [-] INTEGER(IntKi) :: UnOutFile = 0 !< File unit for the UnsteadyAero outputs [-] LOGICAL :: ShedEffect = .false. !< Include the effect of shed vorticity. If False, the input alpha is assumed to already contain this effect (e.g. vortex methods) [-] INTEGER(IntKi) :: lin_nx = 0 !< Number of continuous states for linearization [-] diff --git a/modules/aerodyn14/src/AeroDyn14_Types.f90 b/modules/aerodyn14/src/AeroDyn14_Types.f90 index f1d4f0caf2..48afd94114 100644 --- a/modules/aerodyn14/src/AeroDyn14_Types.f90 +++ b/modules/aerodyn14/src/AeroDyn14_Types.f90 @@ -303,7 +303,7 @@ MODULE AeroDyn14_Types REAL(ReKi) :: TShadC2 = 0.0_ReKi !< Tower-shadow constant [-] REAL(ReKi) :: TwrShad = 0.0_ReKi !< Tower-shadow velocity deficit [-] LOGICAL :: PJM_Version = .false. !< Only true if new tower influence model, by PJM [-] - CHARACTER(1024) :: TwrFile = '' !< Tower data file name [-] + CHARACTER(1024) :: TwrFile !< Tower data file name [-] REAL(ReKi) :: T_Shad_Refpt = 0.0_ReKi !< Tower-shadow reference point [m] LOGICAL :: CalcTwrAero = .false. !< Flag to tell AeroDyn to calculate drag on the tower [m] INTEGER(IntKi) :: NumTwrNodes = 0_IntKi !< Number of ElastoDyn tower nodes. Tower drag will be computed at those points. [-] @@ -338,9 +338,9 @@ MODULE AeroDyn14_Types ! ======================= ! ========= AD14_InitInputType ======= TYPE, PUBLIC :: AD14_InitInputType - CHARACTER(1024) :: Title = '' !< Title [-] - CHARACTER(1024) :: OutRootName = '' - CHARACTER(1024) :: ADFileName = '' !< AeroDyn file name [-] + CHARACTER(1024) :: Title !< Title [-] + CHARACTER(1024) :: OutRootName + CHARACTER(1024) :: ADFileName !< AeroDyn file name [-] LOGICAL :: WrSumFile = .false. !< T/F: Write an AeroDyn summary [-] INTEGER(IntKi) :: NumBl = 0_IntKi !< Number of Blades [-] REAL(ReKi) :: BladeLength = 0.0_ReKi !< Blade Length [-] @@ -416,7 +416,7 @@ MODULE AeroDyn14_Types ! ======================= ! ========= AD14_ParameterType ======= TYPE, PUBLIC :: AD14_ParameterType - CHARACTER(1024) :: Title = '' !< Title [-] + CHARACTER(1024) :: Title !< Title [-] LOGICAL :: SIUnit = .false. LOGICAL :: Echo = .FALSE. LOGICAL :: MultiTab = .false. diff --git a/modules/awae/src/AWAE_Types.f90 b/modules/awae/src/AWAE_Types.f90 index a10126308d..d01c244767 100644 --- a/modules/awae/src/AWAE_Types.f90 +++ b/modules/awae/src/AWAE_Types.f90 @@ -57,7 +57,7 @@ MODULE AWAE_Types INTEGER(IntKi) :: NumTurbines = 0_IntKi !< Number of wind turbines in the farm [>=1] [-] INTEGER(IntKi) :: NumRadii = 0_IntKi !< Number of radii in the radial finite-difference grid [>=2] [-] INTEGER(IntKi) :: NumPlanes = 0_IntKi !< Number of wake planes downwind of the rotor where the wake is propagated [>=2] [-] - CHARACTER(1024) :: WindFilePath = '' !< Path name to the Root folder containing the wind data files from ABLSolver precursor [-] + CHARACTER(1024) :: WindFilePath !< Path name to the Root folder containing the wind data files from ABLSolver precursor [-] LOGICAL :: WrDisWind = .false. !< Write disturbed wind data to /Low/Dis.t.vtk etc.? [-] INTEGER(IntKi) :: NOutDisWindXY = 0_IntKi !< Number of XY planes for output of disturbed wind data across the low-resolution domain to /Low/DisXY..t.vtk [0 to 9] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: OutDisWindZ !< Z coordinates of XY planes for output of disturbed wind data across the low-resolution domain [1 to NOutDisWindXY] [meters] @@ -70,7 +70,7 @@ MODULE AWAE_Types INTEGER(IntKi) :: Mod_Meander = 0_IntKi !< Spatial filter model for wake meandering {1: uniform, 2: truncated jinc, 3: windowed jinc} [DEFAULT=2] [-] REAL(ReKi) :: C_Meander = 0.0_ReKi !< Calibrated parameter for wake meandering [>=1.0] [DEFAULT=1.9] [-] INTEGER(IntKi) :: Mod_AmbWind = 0_IntKi !< Ambient wind model {1: high-fidelity precursor in VTK format, 2: InflowWind module} [-] - CHARACTER(1024) :: InflowFile = '' !< Name of file containing InflowWind module input parameters [-] + CHARACTER(1024) :: InflowFile !< Name of file containing InflowWind module input parameters [-] REAL(DbKi) :: dt_high = 0.0_R8Ki !< High-resolution (FAST) time step [s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: X0_high !< X-component of the origin of the high-resolution spatial domain for each turbine [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Y0_high !< Y-component of the origin of the high-resolution spatial domain for each turbine [m] @@ -99,7 +99,7 @@ MODULE AWAE_Types TYPE(AWAE_InputFileType) :: InputFileData !< FAST.Farm input-file data for AWAE module [-] INTEGER(IntKi) :: n_high_low = 0_IntKi !< Number of high-resolution time steps per low [-] INTEGER(IntKi) :: NumDT = 0_IntKi !< Number of low-resolution (FAST.Farm driver/glue code) time steps [-] - CHARACTER(1024) :: OutFileRoot = '' !< The root name derived from the primary FAST.Farm input file [-] + CHARACTER(1024) :: OutFileRoot !< The root name derived from the primary FAST.Farm input file [-] END TYPE AWAE_InitInputType ! ======================= ! ========= AWAE_InitOutputType ======= @@ -172,7 +172,7 @@ MODULE AWAE_Types ! ======================= ! ========= AWAE_ParameterType ======= TYPE, PUBLIC :: AWAE_ParameterType - CHARACTER(1024) :: WindFilePath = '' !< Path name to the Root folder containing the wind data files from ABLSolver precursor [-] + CHARACTER(1024) :: WindFilePath !< Path name to the Root folder containing the wind data files from ABLSolver precursor [-] INTEGER(IntKi) :: NumTurbines = 0_IntKi !< Number of wind turbines in the farm [>=1] [-] INTEGER(IntKi) :: NumRadii = 0_IntKi !< Number of radii in the radial finite-difference grid [>=2] [-] INTEGER(IntKi) :: NumPlanes = 0_IntKi !< Number of wake planes downwind of the rotor where the wake is propagated [>=2] [-] @@ -221,8 +221,8 @@ MODULE AWAE_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: OutDisWindX !< X coordinates of YZ planes for output of disturbed wind data across the low-resolution domain [1 to NOutDisWindYZ] [meters] INTEGER(IntKi) :: NOutDisWindXZ = 0_IntKi !< Number of XZ planes for output of disturbed wind data across the low-resolution domain to /Low/DisXZ..t.vtk [0 to 9] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: OutDisWindY !< Y coordinates of XZ planes for output of disturbed wind data across the low-resolution domain [1 to NOutDisWindXZ] [meters] - CHARACTER(1024) :: OutFileRoot = '' !< The root name derived from the primary FAST.Farm input file [-] - CHARACTER(1024) :: OutFileVTKRoot = '' !< The root name for VTK outputs [-] + CHARACTER(1024) :: OutFileRoot !< The root name derived from the primary FAST.Farm input file [-] + CHARACTER(1024) :: OutFileVTKRoot !< The root name for VTK outputs [-] INTEGER(IntKi) :: VTK_tWidth = 0_IntKi !< Number of characters for VTK timestamp outputs [-] END TYPE AWAE_ParameterType ! ======================= diff --git a/modules/beamdyn/src/BeamDyn_Types.f90 b/modules/beamdyn/src/BeamDyn_Types.f90 index 18ea9b0a96..fc6c902a14 100644 --- a/modules/beamdyn/src/BeamDyn_Types.f90 +++ b/modules/beamdyn/src/BeamDyn_Types.f90 @@ -41,8 +41,8 @@ MODULE BeamDyn_Types INTEGER(IntKi), PUBLIC, PARAMETER :: BD_MESH_STATIONS = 3 ! Constant for creating y%BldMotion at the blade property input stations [-] ! ========= BD_InitInputType ======= TYPE, PUBLIC :: BD_InitInputType - CHARACTER(1024) :: InputFile = '' !< Name of the input file; remove if there is no file [-] - CHARACTER(1024) :: RootName = '' !< RootName for writing output files [-] + CHARACTER(1024) :: InputFile !< Name of the input file; remove if there is no file [-] + CHARACTER(1024) :: RootName !< RootName for writing output files [-] REAL(ReKi) , DIMENSION(1:3) :: gravity = 0.0_ReKi !< Gravitational acceleration [m/s^2] REAL(ReKi) , DIMENSION(1:3) :: GlbPos = 0.0_ReKi !< Initial Position Vector of the local blade coordinate system [-] REAL(R8Ki) , DIMENSION(1:3,1:3) :: GlbRot = 0.0_R8Ki !< Initial direction cosine matrix of the local blade coordinate system -- in BD coords [-] @@ -97,7 +97,7 @@ MODULE BeamDyn_Types REAL(DbKi) :: rhoinf = 0.0_R8Ki !< Numerical damping parameter for generalized-alpha integrator [-] REAL(DbKi) :: DTBeam = 0.0_R8Ki !< Time interval for BeamDyn calculations {or default} (s) [-] TYPE(BladeInputData) :: InpBl !< Input data for individual blades [see BladeInputData Type] - CHARACTER(1024) :: BldFile = '' !< Name of blade input file [-] + CHARACTER(1024) :: BldFile !< Name of blade input file [-] LOGICAL :: UsePitchAct = .false. !< Whether to use a pitch actuator inside BeamDyn [(flag)] LOGICAL :: QuasiStaticInit = .false. !< Use quasistatic pre-conditioning with centripetal accelerations in initialization (flag) [dynamic solve and enFAST only] [-] REAL(R8Ki) :: stop_tol = 0.0_R8Ki !< Tolerance for stopping criterion [-] @@ -117,11 +117,11 @@ MODULE BeamDyn_Types INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< List of user-requested output channels [-] LOGICAL :: SumPrint = .false. !< Print summary data to file? (.sum) [-] - CHARACTER(20) :: OutFmt = '' !< Format specifier [-] + CHARACTER(20) :: OutFmt !< Format specifier [-] INTEGER(IntKi) :: BldNd_NumOuts = 0_IntKi !< Number of requested output channels per blade node (BD_BldNdOuts) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: BldNd_OutList !< List of user-requested output channels (BD_BldNdOuts) [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: BldNd_BlOutNd !< The blade nodes to actually output (BD_BldNdOuts) [-] - CHARACTER(1024) :: BldNd_BlOutNd_Str = '' !< String to parse for the blade nodes to actually output (BD_BldNdOuts) [-] + CHARACTER(1024) :: BldNd_BlOutNd_Str !< String to parse for the blade nodes to actually output (BD_BldNdOuts) [-] END TYPE BD_InputFile ! ======================= ! ========= BD_ContinuousStateType ======= @@ -207,7 +207,7 @@ MODULE BeamDyn_Types INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NdIndx !< Index into BldMotion mesh (to number the nodes for output without using collocated nodes) [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NdIndxInverse !< Index from BldMotion mesh to unique nodes (to number the nodes for output without using collocated nodes) [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: OutNd2NdElem !< To go from an output node number to a node/elem pair [-] - CHARACTER(20) :: OutFmt = '' !< Format specifier [-] + CHARACTER(20) :: OutFmt !< Format specifier [-] LOGICAL :: UsePitchAct = .false. !< Whether to use a pitch actuator inside BeamDyn [(flag)] REAL(ReKi) :: pitchJ = 0.0_ReKi !< Pitch actuator inertia [(kg-m^2)] REAL(ReKi) :: pitchK = 0.0_ReKi !< Pitch actuator stiffness [(kg-m^2/s^2)] diff --git a/modules/elastodyn/src/ElastoDyn_Types.f90 b/modules/elastodyn/src/ElastoDyn_Types.f90 index b525619ad9..3251a99da3 100644 --- a/modules/elastodyn/src/ElastoDyn_Types.f90 +++ b/modules/elastodyn/src/ElastoDyn_Types.f90 @@ -36,11 +36,11 @@ MODULE ElastoDyn_Types INTEGER(IntKi), PUBLIC, PARAMETER :: ED_NMX = 4 ! Used in updating predictor-corrector values (size of state history) [-] ! ========= ED_InitInputType ======= TYPE, PUBLIC :: ED_InitInputType - CHARACTER(1024) :: InputFile = '' !< Name of the input file [-] + CHARACTER(1024) :: InputFile !< Name of the input file [-] LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] - CHARACTER(1024) :: ADInputFile = '' !< Name of the AeroDyn input file (in this verison, that is where we'll get the blade mesh info [-] + CHARACTER(1024) :: ADInputFile !< Name of the AeroDyn input file (in this verison, that is where we'll get the blade mesh info [-] LOGICAL :: CompElast = .false. !< flag to determine if ElastoDyn is computing blade loads (true) or BeamDyn is (false) [-] - CHARACTER(1024) :: RootName = '' !< RootName for writing output files [-] + CHARACTER(1024) :: RootName !< RootName for writing output files [-] REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravitational acceleration [m/s^2] INTEGER(IntKi) :: MHK = 0_IntKi !< MHK turbine type switch [-] REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [m] @@ -192,7 +192,7 @@ MODULE ElastoDyn_Types LOGICAL :: SumPrint = .false. !< Print summary data to .sum [-] INTEGER(IntKi) :: OutFile = 0_IntKi !< Switch to determine where output will be placed: (1: in module output file only; 2: in glue code output file only; 3: both) [-] LOGICAL :: TabDelim = .false. !< Flag to cause tab-delimited text output (delimited by space otherwise) [-] - CHARACTER(20) :: OutFmt = '' !< Format used for module's text tabular output (except time); resulting field should be 10 characters [-] + CHARACTER(20) :: OutFmt !< Format used for module's text tabular output (except time); resulting field should be 10 characters [-] REAL(DbKi) :: Tstart = 0.0_R8Ki !< Time to start module's tabular output [seconds] INTEGER(IntKi) :: DecFact = 0_IntKi !< Decimation factor for module's tabular output (1=output every step) [-] INTEGER(IntKi) :: NTwGages = 0_IntKi !< Number of tower strain gages [-] @@ -259,7 +259,7 @@ MODULE ElastoDyn_Types INTEGER(IntKi) :: method = 0_IntKi !< Identifier for integration method (1 [RK4], 2 [AB4], or 3 [ABM4]) [-] INTEGER(IntKi) :: BldNd_NumOuts = 0_IntKi !< Number of requested output channels per blade node (ED_AllBldNdOuts) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: BldNd_OutList !< List of user-requested output channels (ED_AllBldNdOuts) [-] - CHARACTER(1024) :: BldNd_BlOutNd_Str = '' !< String to parse for the blade nodes to actually output (ED_AllBldNdOuts) [-] + CHARACTER(1024) :: BldNd_BlOutNd_Str !< String to parse for the blade nodes to actually output (ED_AllBldNdOuts) [-] INTEGER(IntKi) :: BldNd_BladesOut = 0_IntKi !< The blades to output (ED_AllBldNdOuts) [-] END TYPE ED_InputFile ! ======================= @@ -549,11 +549,11 @@ MODULE ElastoDyn_Types CHARACTER(99) , DIMENSION(:), ALLOCATABLE :: DOF_Desc !< Array which stores descriptions of each DOF [-] TYPE(ED_ActiveDOFs) :: DOFs !< Active degrees of freedom in the model [-] INTEGER(IntKi) :: NumOuts = 0 !< Number of parameters in the output list (number of outputs requested) [-] - CHARACTER(20) :: OutFmt = '' !< Output format for tabular data [-] + CHARACTER(20) :: OutFmt !< Output format for tabular data [-] INTEGER(IntKi) :: NBlGages = 0 !< Number of blade strain gages [-] INTEGER(IntKi) :: NTwGages = 0 !< Number of tower strain gages [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] - CHARACTER(1) :: Delim = '' !< Column delimiter for output text files [-] + CHARACTER(1) :: Delim !< Column delimiter for output text files [-] REAL(ReKi) :: AvgNrmTpRd = 0.0_ReKi !< Average tip radius normal to the shaft [meters] REAL(R8Ki) :: AzimB1Up = 0.0_R8Ki !< Azimuth value to use for I/O when blade 1 points up [radians] REAL(R8Ki) :: CosDel3 = 1.0 !< Cosine of the Delta-3 angle for teetering rotors [-] @@ -736,7 +736,7 @@ MODULE ElastoDyn_Types REAL(ReKi) :: GBRatio = 0.0_ReKi !< Gearbox ratio [-] REAL(ReKi) :: GBoxEff = 0.0_ReKi !< Gearbox efficiency [-] REAL(ReKi) :: RotSpeed = 0.0_ReKi !< Initial or fixed rotor speed [rad/s] - CHARACTER(1024) :: RootName = '' !< RootName for writing output files [-] + CHARACTER(1024) :: RootName !< RootName for writing output files [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BElmntMass !< Mass of the blade elements [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TElmntMass !< Mass of the tower elements [-] INTEGER(IntKi) :: method = 0_IntKi !< Identifier for integration method (1 [RK4], 2 [AB4], or 3 [ABM4]) [-] diff --git a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 index 2d83def2e1..6d0b87f639 100644 --- a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 +++ b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 @@ -35,10 +35,10 @@ MODULE ExtPtfm_MCKF_Types IMPLICIT NONE ! ========= ExtPtfm_InitInputType ======= TYPE, PUBLIC :: ExtPtfm_InitInputType - CHARACTER(1024) :: InputFile = '' !< Name of the input file; remove if there is no file [-] + CHARACTER(1024) :: InputFile !< Name of the input file; remove if there is no file [-] LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] REAL(ReKi) :: PtfmRefzt = 0.0_ReKi !< Vertical distance from the ground level [onshore], MSL [offshore wind or floating MHK], or seabed [fixed MHK] to the platform reference point [meters] - CHARACTER(1024) :: RootName = '' !< RootName for writing output files [-] + CHARACTER(1024) :: RootName !< RootName for writing output files [-] END TYPE ExtPtfm_InitInputType ! ======================= ! ========= ExtPtfm_InputFile ======= @@ -46,8 +46,8 @@ MODULE ExtPtfm_MCKF_Types REAL(DbKi) :: DT = 0.0_R8Ki !< Requested integration time for ElastoDyn [seconds] INTEGER(IntKi) :: IntMethod = 0_IntKi !< Integration Method (1=RK4, 2=AB4, 3=ABM4) [-] INTEGER(IntKi) :: FileFormat = 0_IntKi !< File format switch [-] - CHARACTER(1024) :: RedFile = '' !< File containing reduction inputs [-] - CHARACTER(1024) :: RedFileCst = '' !< File containing constant reduction inputs [-] + CHARACTER(1024) :: RedFile !< File containing reduction inputs [-] + CHARACTER(1024) :: RedFileCst !< File containing constant reduction inputs [-] LOGICAL :: EquilStart = .false. !< Flag to determine the equilibrium positions of the CB modes at initialization (first call) [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ActiveCBDOF !< List of active CB DOF [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: InitPosList !< Initial positions of the CB DOFs [-] @@ -55,7 +55,7 @@ MODULE ExtPtfm_MCKF_Types LOGICAL :: SumPrint = .false. !< Print summary data to .sum [-] INTEGER(IntKi) :: OutFile = 0_IntKi !< Switch to determine where output will be placed: (1: in module output file only; 2: in glue code output file only; 3: both) [-] LOGICAL :: TabDelim = .false. !< Flag to cause tab-delimited text output (delimited by space otherwise) [-] - CHARACTER(20) :: OutFmt = '' !< Format used for module's text tabular output (except time); resulting field should be 10 characters [-] + CHARACTER(20) :: OutFmt !< Format used for module's text tabular output (except time); resulting field should be 10 characters [-] REAL(DbKi) :: Tstart = 0.0_R8Ki !< Time to start module's tabular output [seconds] INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< List of user-requested output channels [-] diff --git a/modules/feamooring/src/FEAMooring_Types.f90 b/modules/feamooring/src/FEAMooring_Types.f90 index a61bba814e..552432455d 100644 --- a/modules/feamooring/src/FEAMooring_Types.f90 +++ b/modules/feamooring/src/FEAMooring_Types.f90 @@ -62,7 +62,7 @@ MODULE FEAMooring_Types LOGICAL :: SumPrint = .false. !< Print summary data to .fsm? [-] INTEGER(IntKi) :: OutFile = 0_IntKi !< Switch to determine where output will be placed: (1: in module output file only; 2: in glue code output file only; 3: both) [-] LOGICAL :: TabDelim = .false. !< Use tab delimiters in text tabular output file? [-] - CHARACTER(20) :: OutFmt = '' !< Format used for text tabular output (except time) [-] + CHARACTER(20) :: OutFmt !< Format used for text tabular output (except time) [-] REAL(DbKi) :: Tstart = 0.0_R8Ki !< Time to start module's tabular output [s] INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< List of user-requested output channels [-] @@ -70,8 +70,8 @@ MODULE FEAMooring_Types ! ======================= ! ========= FEAM_InitInputType ======= TYPE, PUBLIC :: FEAM_InitInputType - CHARACTER(1024) :: InputFile = '' !< Name of the input file [-] - CHARACTER(1024) :: RootName = '' !< RootName for writing output files [-] + CHARACTER(1024) :: InputFile !< Name of the input file [-] + CHARACTER(1024) :: RootName !< RootName for writing output files [-] REAL(ReKi) , DIMENSION(1:6) :: PtfmInit = 0.0_ReKi !< Platform Initial Position [-] INTEGER(IntKi) :: NStepWave = 0_IntKi !< [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveAcc0 !< [-] @@ -203,9 +203,9 @@ MODULE FEAMooring_Types REAL(ReKi) , DIMENSION(1:3,1:3,1:4) :: PPA = 0.0_ReKi !< Internal [-] REAL(ReKi) :: PtfmRefzt = 0.0_ReKi !< Platform reference [-] INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] - CHARACTER(1024) :: RootName = '' !< RootName for writing output files [-] + CHARACTER(1024) :: RootName !< RootName for writing output files [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] - CHARACTER(1) :: Delim = '' !< Column delimiter for output text files [-] + CHARACTER(1) :: Delim !< Column delimiter for output text files [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: GLUZR !< Line coordinate & direction cosine [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: GTZER !< Line tension [-] END TYPE FEAM_ParameterType diff --git a/modules/hydrodyn/src/Conv_Radiation_Types.f90 b/modules/hydrodyn/src/Conv_Radiation_Types.f90 index 709450ebf9..3b7e8f9563 100644 --- a/modules/hydrodyn/src/Conv_Radiation_Types.f90 +++ b/modules/hydrodyn/src/Conv_Radiation_Types.f90 @@ -36,10 +36,10 @@ MODULE Conv_Radiation_Types ! ========= Conv_Rdtn_InitInputType ======= TYPE, PUBLIC :: Conv_Rdtn_InitInputType REAL(DbKi) :: RdtnDT = 0.0_R8Ki !< [-] - CHARACTER(80) :: RdtnDTChr = '' + CHARACTER(80) :: RdtnDTChr INTEGER(IntKi) :: NBody = 0_IntKi !< [>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6] [-] REAL(ReKi) :: HighFreq = 0.0_ReKi !< [-] - CHARACTER(1024) :: WAMITFile = '' !< [-] + CHARACTER(1024) :: WAMITFile !< [-] REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: HdroAddMs !< [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: HdroFreq !< [-] REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: HdroDmpng !< [-] diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index b70c7c877e..65dd750d3f 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -77,16 +77,16 @@ MODULE HydroDyn_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< The user-requested output channel labels for this modules. This should really be dimensioned with MaxOutPts [-] LOGICAL :: HDSum = .false. !< Generate a HydroDyn summary file [T/F] [-] INTEGER(IntKi) :: UnSum = 0_IntKi !< File unit for the HydroDyn summary file [-1 = no summary file] [-] - CHARACTER(20) :: OutFmt = '' !< Output format for numerical results [-] - CHARACTER(20) :: OutSFmt = '' !< Output format for header strings [-] + CHARACTER(20) :: OutFmt !< Output format for numerical results [-] + CHARACTER(20) :: OutSFmt !< Output format for header strings [-] END TYPE HydroDyn_InputFile ! ======================= ! ========= HydroDyn_InitInputType ======= TYPE, PUBLIC :: HydroDyn_InitInputType - CHARACTER(1024) :: InputFile = '' !< Supplied by Driver: full path and filename for the HydroDyn module [-] + CHARACTER(1024) :: InputFile !< Supplied by Driver: full path and filename for the HydroDyn module [-] LOGICAL :: UseInputFile = .TRUE. !< Supplied by Driver: .TRUE. if using a input file, .FALSE. if all inputs are being passed in by the caller [-] TYPE(FileInfoType) :: PassedFileData !< If we don't use the input file, pass everything through this [-] - CHARACTER(1024) :: OutRootName = '' !< Supplied by Driver: The name of the root file (without extension) including the full path [-] + CHARACTER(1024) :: OutRootName !< Supplied by Driver: The name of the root file (without extension) including the full path [-] LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] REAL(ReKi) :: Gravity = 0.0_ReKi !< Supplied by Driver: Gravitational acceleration [(m/s^2)] REAL(ReKi) :: WtrDens = 0.0_ReKi !< Water density from the driver; may be overwritten [(kg/m^3)] @@ -205,9 +205,9 @@ MODULE HydroDyn_Types INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of HydroDyn module-level outputs (not the total number including sub-modules [-] INTEGER(IntKi) :: NumTotalOuts = 0_IntKi !< Number of all requested outputs including sub-modules [-] INTEGER(IntKi) :: OutSwtch = 0_IntKi !< Output requested channels to: [1=Hydrodyn.out 2=GlueCode.out 3=both files] [-] - CHARACTER(20) :: OutFmt = '' !< Output format for numerical results [-] - CHARACTER(20) :: OutSFmt = '' !< Output format for header strings [-] - CHARACTER(ChanLen) :: Delim = '' !< Delimiter string for outputs, defaults to tab-delimiters [-] + CHARACTER(20) :: OutFmt !< Output format for numerical results [-] + CHARACTER(20) :: OutSFmt !< Output format for header strings [-] + CHARACTER(ChanLen) :: Delim !< Delimiter string for outputs, defaults to tab-delimiters [-] INTEGER(IntKi) :: UnOutFile = 0_IntKi !< File unit for the HydroDyn outputs [-] INTEGER(IntKi) :: OutDec = 0_IntKi !< Write every OutDec time steps [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian [-] diff --git a/modules/hydrodyn/src/Morison_Types.f90 b/modules/hydrodyn/src/Morison_Types.f90 index bd53bb2732..8d473c6641 100644 --- a/modules/hydrodyn/src/Morison_Types.f90 +++ b/modules/hydrodyn/src/Morison_Types.f90 @@ -58,7 +58,7 @@ MODULE Morison_Types INTEGER(IntKi) :: FillNumM = 0_IntKi !< Number of members in the Fill Group [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: FillMList !< List of Member IDs for the members in this fill group [-] REAL(ReKi) :: FillFSLoc = 0.0_ReKi !< The free-surface location (in Z) for this fill group [m] - CHARACTER(80) :: FillDensChr = '' !< String version of the Fill density [can be DEFAULT which sets the fill density to WtrDens] [kg/m^3] + CHARACTER(80) :: FillDensChr !< String version of the Fill density [can be DEFAULT which sets the fill density to WtrDens] [kg/m^3] REAL(ReKi) :: FillDens = 0.0_ReKi !< Numerical fill density [kg/m^3] END TYPE Morison_FilledGroupType ! ======================= @@ -3027,277 +3027,8 @@ subroutine Morison_DestroyCoefMembers(CoefMembersData, ErrStat, ErrMsg) character(*), intent( out) :: ErrMsg character(*), parameter :: RoutineName = 'Morison_DestroyCoefMembers' ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscData%DispNodePosHdn)) THEN - i1_l = LBOUND(SrcMiscData%DispNodePosHdn,1) - i1_u = UBOUND(SrcMiscData%DispNodePosHdn,1) - i2_l = LBOUND(SrcMiscData%DispNodePosHdn,2) - i2_u = UBOUND(SrcMiscData%DispNodePosHdn,2) - IF (.NOT. ALLOCATED(DstMiscData%DispNodePosHdn)) THEN - ALLOCATE(DstMiscData%DispNodePosHdn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%DispNodePosHdn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%DispNodePosHdn = SrcMiscData%DispNodePosHdn -ENDIF -IF (ALLOCATED(SrcMiscData%DispNodePosHst)) THEN - i1_l = LBOUND(SrcMiscData%DispNodePosHst,1) - i1_u = UBOUND(SrcMiscData%DispNodePosHst,1) - i2_l = LBOUND(SrcMiscData%DispNodePosHst,2) - i2_u = UBOUND(SrcMiscData%DispNodePosHst,2) - IF (.NOT. ALLOCATED(DstMiscData%DispNodePosHst)) THEN - ALLOCATE(DstMiscData%DispNodePosHst(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%DispNodePosHst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%DispNodePosHst = SrcMiscData%DispNodePosHst -ENDIF -IF (ALLOCATED(SrcMiscData%FV)) THEN - i1_l = LBOUND(SrcMiscData%FV,1) - i1_u = UBOUND(SrcMiscData%FV,1) - i2_l = LBOUND(SrcMiscData%FV,2) - i2_u = UBOUND(SrcMiscData%FV,2) - IF (.NOT. ALLOCATED(DstMiscData%FV)) THEN - ALLOCATE(DstMiscData%FV(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%FV = SrcMiscData%FV -ENDIF -IF (ALLOCATED(SrcMiscData%FA)) THEN - i1_l = LBOUND(SrcMiscData%FA,1) - i1_u = UBOUND(SrcMiscData%FA,1) - i2_l = LBOUND(SrcMiscData%FA,2) - i2_u = UBOUND(SrcMiscData%FA,2) - IF (.NOT. ALLOCATED(DstMiscData%FA)) THEN - ALLOCATE(DstMiscData%FA(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%FA = SrcMiscData%FA -ENDIF -IF (ALLOCATED(SrcMiscData%FAMCF)) THEN - i1_l = LBOUND(SrcMiscData%FAMCF,1) - i1_u = UBOUND(SrcMiscData%FAMCF,1) - i2_l = LBOUND(SrcMiscData%FAMCF,2) - i2_u = UBOUND(SrcMiscData%FAMCF,2) - IF (.NOT. ALLOCATED(DstMiscData%FAMCF)) THEN - ALLOCATE(DstMiscData%FAMCF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FAMCF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%FAMCF = SrcMiscData%FAMCF -ENDIF -IF (ALLOCATED(SrcMiscData%FDynP)) THEN - i1_l = LBOUND(SrcMiscData%FDynP,1) - i1_u = UBOUND(SrcMiscData%FDynP,1) - IF (.NOT. ALLOCATED(DstMiscData%FDynP)) THEN - ALLOCATE(DstMiscData%FDynP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FDynP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%FDynP = SrcMiscData%FDynP -ENDIF -IF (ALLOCATED(SrcMiscData%WaveElev)) THEN - i1_l = LBOUND(SrcMiscData%WaveElev,1) - i1_u = UBOUND(SrcMiscData%WaveElev,1) - IF (.NOT. ALLOCATED(DstMiscData%WaveElev)) THEN - ALLOCATE(DstMiscData%WaveElev(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WaveElev.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%WaveElev = SrcMiscData%WaveElev -ENDIF -IF (ALLOCATED(SrcMiscData%WaveElev1)) THEN - i1_l = LBOUND(SrcMiscData%WaveElev1,1) - i1_u = UBOUND(SrcMiscData%WaveElev1,1) - IF (.NOT. ALLOCATED(DstMiscData%WaveElev1)) THEN - ALLOCATE(DstMiscData%WaveElev1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WaveElev1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%WaveElev1 = SrcMiscData%WaveElev1 -ENDIF -IF (ALLOCATED(SrcMiscData%WaveElev2)) THEN - i1_l = LBOUND(SrcMiscData%WaveElev2,1) - i1_u = UBOUND(SrcMiscData%WaveElev2,1) - IF (.NOT. ALLOCATED(DstMiscData%WaveElev2)) THEN - ALLOCATE(DstMiscData%WaveElev2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WaveElev2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%WaveElev2 = SrcMiscData%WaveElev2 -ENDIF -IF (ALLOCATED(SrcMiscData%vrel)) THEN - i1_l = LBOUND(SrcMiscData%vrel,1) - i1_u = UBOUND(SrcMiscData%vrel,1) - i2_l = LBOUND(SrcMiscData%vrel,2) - i2_u = UBOUND(SrcMiscData%vrel,2) - IF (.NOT. ALLOCATED(DstMiscData%vrel)) THEN - ALLOCATE(DstMiscData%vrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%vrel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%vrel = SrcMiscData%vrel -ENDIF -IF (ALLOCATED(SrcMiscData%nodeInWater)) THEN - i1_l = LBOUND(SrcMiscData%nodeInWater,1) - i1_u = UBOUND(SrcMiscData%nodeInWater,1) - IF (.NOT. ALLOCATED(DstMiscData%nodeInWater)) THEN - ALLOCATE(DstMiscData%nodeInWater(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%nodeInWater.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%nodeInWater = SrcMiscData%nodeInWater -ENDIF -IF (ALLOCATED(SrcMiscData%memberLoads)) THEN - i1_l = LBOUND(SrcMiscData%memberLoads,1) - i1_u = UBOUND(SrcMiscData%memberLoads,1) - IF (.NOT. ALLOCATED(DstMiscData%memberLoads)) THEN - ALLOCATE(DstMiscData%memberLoads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%memberLoads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcMiscData%memberLoads,1), UBOUND(SrcMiscData%memberLoads,1) - CALL Morison_Copymemberloads( SrcMiscData%memberLoads(i1), DstMiscData%memberLoads(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcMiscData%F_B_End)) THEN - i1_l = LBOUND(SrcMiscData%F_B_End,1) - i1_u = UBOUND(SrcMiscData%F_B_End,1) - i2_l = LBOUND(SrcMiscData%F_B_End,2) - i2_u = UBOUND(SrcMiscData%F_B_End,2) - IF (.NOT. ALLOCATED(DstMiscData%F_B_End)) THEN - ALLOCATE(DstMiscData%F_B_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_B_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_B_End = SrcMiscData%F_B_End -ENDIF -IF (ALLOCATED(SrcMiscData%F_D_End)) THEN - i1_l = LBOUND(SrcMiscData%F_D_End,1) - i1_u = UBOUND(SrcMiscData%F_D_End,1) - i2_l = LBOUND(SrcMiscData%F_D_End,2) - i2_u = UBOUND(SrcMiscData%F_D_End,2) - IF (.NOT. ALLOCATED(DstMiscData%F_D_End)) THEN - ALLOCATE(DstMiscData%F_D_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_D_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_D_End = SrcMiscData%F_D_End -ENDIF -IF (ALLOCATED(SrcMiscData%F_I_End)) THEN - i1_l = LBOUND(SrcMiscData%F_I_End,1) - i1_u = UBOUND(SrcMiscData%F_I_End,1) - i2_l = LBOUND(SrcMiscData%F_I_End,2) - i2_u = UBOUND(SrcMiscData%F_I_End,2) - IF (.NOT. ALLOCATED(DstMiscData%F_I_End)) THEN - ALLOCATE(DstMiscData%F_I_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_I_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_I_End = SrcMiscData%F_I_End -ENDIF -IF (ALLOCATED(SrcMiscData%F_IMG_End)) THEN - i1_l = LBOUND(SrcMiscData%F_IMG_End,1) - i1_u = UBOUND(SrcMiscData%F_IMG_End,1) - i2_l = LBOUND(SrcMiscData%F_IMG_End,2) - i2_u = UBOUND(SrcMiscData%F_IMG_End,2) - IF (.NOT. ALLOCATED(DstMiscData%F_IMG_End)) THEN - ALLOCATE(DstMiscData%F_IMG_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_IMG_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_IMG_End = SrcMiscData%F_IMG_End -ENDIF -IF (ALLOCATED(SrcMiscData%F_A_End)) THEN - i1_l = LBOUND(SrcMiscData%F_A_End,1) - i1_u = UBOUND(SrcMiscData%F_A_End,1) - i2_l = LBOUND(SrcMiscData%F_A_End,2) - i2_u = UBOUND(SrcMiscData%F_A_End,2) - IF (.NOT. ALLOCATED(DstMiscData%F_A_End)) THEN - ALLOCATE(DstMiscData%F_A_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_A_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_A_End = SrcMiscData%F_A_End -ENDIF -IF (ALLOCATED(SrcMiscData%F_BF_End)) THEN - i1_l = LBOUND(SrcMiscData%F_BF_End,1) - i1_u = UBOUND(SrcMiscData%F_BF_End,1) - i2_l = LBOUND(SrcMiscData%F_BF_End,2) - i2_u = UBOUND(SrcMiscData%F_BF_End,2) - IF (.NOT. ALLOCATED(DstMiscData%F_BF_End)) THEN - ALLOCATE(DstMiscData%F_BF_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%F_BF_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%F_BF_End = SrcMiscData%F_BF_End -ENDIF -IF (ALLOCATED(SrcMiscData%V_rel_n)) THEN - i1_l = LBOUND(SrcMiscData%V_rel_n,1) - i1_u = UBOUND(SrcMiscData%V_rel_n,1) - IF (.NOT. ALLOCATED(DstMiscData%V_rel_n)) THEN - ALLOCATE(DstMiscData%V_rel_n(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%V_rel_n.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%V_rel_n = SrcMiscData%V_rel_n -ENDIF -IF (ALLOCATED(SrcMiscData%V_rel_n_HiPass)) THEN - i1_l = LBOUND(SrcMiscData%V_rel_n_HiPass,1) - i1_u = UBOUND(SrcMiscData%V_rel_n_HiPass,1) - IF (.NOT. ALLOCATED(DstMiscData%V_rel_n_HiPass)) THEN - ALLOCATE(DstMiscData%V_rel_n_HiPass(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%V_rel_n_HiPass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%V_rel_n_HiPass = SrcMiscData%V_rel_n_HiPass -ENDIF - DstMiscData%LastIndWave = SrcMiscData%LastIndWave - END SUBROUTINE Morison_CopyMisc + ErrMsg = '' +end subroutine subroutine Morison_PackCoefMembers(Buf, Indata) type(PackBuffer), intent(inout) :: Buf @@ -3404,1149 +3135,13 @@ subroutine Morison_UnPackCoefMembers(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end subroutine -IF (ALLOCATED(MiscData%DispNodePosHdn)) THEN - DEALLOCATE(MiscData%DispNodePosHdn) -ENDIF -IF (ALLOCATED(MiscData%DispNodePosHst)) THEN - DEALLOCATE(MiscData%DispNodePosHst) -ENDIF -IF (ALLOCATED(MiscData%FV)) THEN - DEALLOCATE(MiscData%FV) -ENDIF -IF (ALLOCATED(MiscData%FA)) THEN - DEALLOCATE(MiscData%FA) -ENDIF -IF (ALLOCATED(MiscData%FAMCF)) THEN - DEALLOCATE(MiscData%FAMCF) -ENDIF -IF (ALLOCATED(MiscData%FDynP)) THEN - DEALLOCATE(MiscData%FDynP) -ENDIF -IF (ALLOCATED(MiscData%WaveElev)) THEN - DEALLOCATE(MiscData%WaveElev) -ENDIF -IF (ALLOCATED(MiscData%WaveElev1)) THEN - DEALLOCATE(MiscData%WaveElev1) -ENDIF -IF (ALLOCATED(MiscData%WaveElev2)) THEN - DEALLOCATE(MiscData%WaveElev2) -ENDIF -IF (ALLOCATED(MiscData%vrel)) THEN - DEALLOCATE(MiscData%vrel) -ENDIF -IF (ALLOCATED(MiscData%nodeInWater)) THEN - DEALLOCATE(MiscData%nodeInWater) -ENDIF -IF (ALLOCATED(MiscData%memberLoads)) THEN -DO i1 = LBOUND(MiscData%memberLoads,1), UBOUND(MiscData%memberLoads,1) - CALL Morison_DestroyMemberLoads( MiscData%memberLoads(i1), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -ENDDO - DEALLOCATE(MiscData%memberLoads) -ENDIF -IF (ALLOCATED(MiscData%F_B_End)) THEN - DEALLOCATE(MiscData%F_B_End) -ENDIF -IF (ALLOCATED(MiscData%F_D_End)) THEN - DEALLOCATE(MiscData%F_D_End) -ENDIF -IF (ALLOCATED(MiscData%F_I_End)) THEN - DEALLOCATE(MiscData%F_I_End) -ENDIF -IF (ALLOCATED(MiscData%F_IMG_End)) THEN - DEALLOCATE(MiscData%F_IMG_End) -ENDIF -IF (ALLOCATED(MiscData%F_A_End)) THEN - DEALLOCATE(MiscData%F_A_End) -ENDIF -IF (ALLOCATED(MiscData%F_BF_End)) THEN - DEALLOCATE(MiscData%F_BF_End) -ENDIF -IF (ALLOCATED(MiscData%V_rel_n)) THEN - DEALLOCATE(MiscData%V_rel_n) -ENDIF -IF (ALLOCATED(MiscData%V_rel_n_HiPass)) THEN - DEALLOCATE(MiscData%V_rel_n_HiPass) -ENDIF - END SUBROUTINE Morison_DestroyMisc - - SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(Morison_MiscVarType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_PackMisc' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! DispNodePosHdn allocated yes/no - IF ( ALLOCATED(InData%DispNodePosHdn) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! DispNodePosHdn upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DispNodePosHdn) ! DispNodePosHdn - END IF - Int_BufSz = Int_BufSz + 1 ! DispNodePosHst allocated yes/no - IF ( ALLOCATED(InData%DispNodePosHst) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! DispNodePosHst upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%DispNodePosHst) ! DispNodePosHst - END IF - Int_BufSz = Int_BufSz + 1 ! FV allocated yes/no - IF ( ALLOCATED(InData%FV) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FV upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FV) ! FV - END IF - Int_BufSz = Int_BufSz + 1 ! FA allocated yes/no - IF ( ALLOCATED(InData%FA) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FA upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FA) ! FA - END IF - Int_BufSz = Int_BufSz + 1 ! FAMCF allocated yes/no - IF ( ALLOCATED(InData%FAMCF) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! FAMCF upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FAMCF) ! FAMCF - END IF - Int_BufSz = Int_BufSz + 1 ! FDynP allocated yes/no - IF ( ALLOCATED(InData%FDynP) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FDynP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FDynP) ! FDynP - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElev allocated yes/no - IF ( ALLOCATED(InData%WaveElev) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveElev upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev) ! WaveElev - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElev1 allocated yes/no - IF ( ALLOCATED(InData%WaveElev1) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveElev1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev1) ! WaveElev1 - END IF - Int_BufSz = Int_BufSz + 1 ! WaveElev2 allocated yes/no - IF ( ALLOCATED(InData%WaveElev2) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WaveElev2 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WaveElev2) ! WaveElev2 - END IF - Int_BufSz = Int_BufSz + 1 ! vrel allocated yes/no - IF ( ALLOCATED(InData%vrel) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! vrel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%vrel) ! vrel - END IF - Int_BufSz = Int_BufSz + 1 ! nodeInWater allocated yes/no - IF ( ALLOCATED(InData%nodeInWater) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! nodeInWater upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%nodeInWater) ! nodeInWater - END IF - Int_BufSz = Int_BufSz + 1 ! memberLoads allocated yes/no - IF ( ALLOCATED(InData%memberLoads) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! memberLoads upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%memberLoads,1), UBOUND(InData%memberLoads,1) - Int_BufSz = Int_BufSz + 3 ! memberLoads: size of buffers for each call to pack subtype - CALL Morison_PackMemberLoads( Re_Buf, Db_Buf, Int_Buf, InData%memberLoads(i1), ErrStat2, ErrMsg2, .TRUE. ) ! memberLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! memberLoads - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! memberLoads - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! memberLoads - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! F_B_End allocated yes/no - IF ( ALLOCATED(InData%F_B_End) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_B_End upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_B_End) ! F_B_End - END IF - Int_BufSz = Int_BufSz + 1 ! F_D_End allocated yes/no - IF ( ALLOCATED(InData%F_D_End) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_D_End upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_D_End) ! F_D_End - END IF - Int_BufSz = Int_BufSz + 1 ! F_I_End allocated yes/no - IF ( ALLOCATED(InData%F_I_End) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_I_End upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_I_End) ! F_I_End - END IF - Int_BufSz = Int_BufSz + 1 ! F_IMG_End allocated yes/no - IF ( ALLOCATED(InData%F_IMG_End) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_IMG_End upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_IMG_End) ! F_IMG_End - END IF - Int_BufSz = Int_BufSz + 1 ! F_A_End allocated yes/no - IF ( ALLOCATED(InData%F_A_End) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_A_End upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_A_End) ! F_A_End - END IF - Int_BufSz = Int_BufSz + 1 ! F_BF_End allocated yes/no - IF ( ALLOCATED(InData%F_BF_End) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F_BF_End upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%F_BF_End) ! F_BF_End - END IF - Int_BufSz = Int_BufSz + 1 ! V_rel_n allocated yes/no - IF ( ALLOCATED(InData%V_rel_n) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! V_rel_n upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%V_rel_n) ! V_rel_n - END IF - Int_BufSz = Int_BufSz + 1 ! V_rel_n_HiPass allocated yes/no - IF ( ALLOCATED(InData%V_rel_n_HiPass) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! V_rel_n_HiPass upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%V_rel_n_HiPass) ! V_rel_n_HiPass - END IF - Int_BufSz = Int_BufSz + 1 ! LastIndWave - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%DispNodePosHdn) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DispNodePosHdn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DispNodePosHdn,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DispNodePosHdn,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DispNodePosHdn,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%DispNodePosHdn,2), UBOUND(InData%DispNodePosHdn,2) - DO i1 = LBOUND(InData%DispNodePosHdn,1), UBOUND(InData%DispNodePosHdn,1) - ReKiBuf(Re_Xferred) = InData%DispNodePosHdn(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%DispNodePosHst) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DispNodePosHst,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DispNodePosHst,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%DispNodePosHst,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DispNodePosHst,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%DispNodePosHst,2), UBOUND(InData%DispNodePosHst,2) - DO i1 = LBOUND(InData%DispNodePosHst,1), UBOUND(InData%DispNodePosHst,1) - ReKiBuf(Re_Xferred) = InData%DispNodePosHst(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FV) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FV,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FV,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FV,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FV,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FV,2), UBOUND(InData%FV,2) - DO i1 = LBOUND(InData%FV,1), UBOUND(InData%FV,1) - ReKiBuf(Re_Xferred) = InData%FV(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FA) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FA,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FA,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FA,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FA,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FA,2), UBOUND(InData%FA,2) - DO i1 = LBOUND(InData%FA,1), UBOUND(InData%FA,1) - ReKiBuf(Re_Xferred) = InData%FA(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FAMCF) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FAMCF,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAMCF,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FAMCF,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAMCF,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%FAMCF,2), UBOUND(InData%FAMCF,2) - DO i1 = LBOUND(InData%FAMCF,1), UBOUND(InData%FAMCF,1) - ReKiBuf(Re_Xferred) = InData%FAMCF(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%FDynP) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FDynP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FDynP,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%FDynP,1), UBOUND(InData%FDynP,1) - ReKiBuf(Re_Xferred) = InData%FDynP(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveElev) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveElev,1), UBOUND(InData%WaveElev,1) - ReKiBuf(Re_Xferred) = InData%WaveElev(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveElev1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev1,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveElev1,1), UBOUND(InData%WaveElev1,1) - ReKiBuf(Re_Xferred) = InData%WaveElev1(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%WaveElev2) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev2,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev2,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WaveElev2,1), UBOUND(InData%WaveElev2,1) - ReKiBuf(Re_Xferred) = InData%WaveElev2(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%vrel) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vrel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vrel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%vrel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vrel,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%vrel,2), UBOUND(InData%vrel,2) - DO i1 = LBOUND(InData%vrel,1), UBOUND(InData%vrel,1) - ReKiBuf(Re_Xferred) = InData%vrel(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%nodeInWater) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%nodeInWater,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nodeInWater,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%nodeInWater,1), UBOUND(InData%nodeInWater,1) - IntKiBuf(Int_Xferred) = InData%nodeInWater(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%memberLoads) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%memberLoads,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%memberLoads,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%memberLoads,1), UBOUND(InData%memberLoads,1) - CALL Morison_PackMemberLoads( Re_Buf, Db_Buf, Int_Buf, InData%memberLoads(i1), ErrStat2, ErrMsg2, OnlySize ) ! memberLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_B_End) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_B_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_B_End,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_B_End,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_B_End,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_B_End,2), UBOUND(InData%F_B_End,2) - DO i1 = LBOUND(InData%F_B_End,1), UBOUND(InData%F_B_End,1) - ReKiBuf(Re_Xferred) = InData%F_B_End(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_D_End) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_D_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_D_End,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_D_End,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_D_End,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_D_End,2), UBOUND(InData%F_D_End,2) - DO i1 = LBOUND(InData%F_D_End,1), UBOUND(InData%F_D_End,1) - ReKiBuf(Re_Xferred) = InData%F_D_End(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_I_End) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_I_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_I_End,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_I_End,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_I_End,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_I_End,2), UBOUND(InData%F_I_End,2) - DO i1 = LBOUND(InData%F_I_End,1), UBOUND(InData%F_I_End,1) - ReKiBuf(Re_Xferred) = InData%F_I_End(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_IMG_End) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_IMG_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_IMG_End,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_IMG_End,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_IMG_End,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_IMG_End,2), UBOUND(InData%F_IMG_End,2) - DO i1 = LBOUND(InData%F_IMG_End,1), UBOUND(InData%F_IMG_End,1) - ReKiBuf(Re_Xferred) = InData%F_IMG_End(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_A_End) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_A_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_A_End,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_A_End,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_A_End,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_A_End,2), UBOUND(InData%F_A_End,2) - DO i1 = LBOUND(InData%F_A_End,1), UBOUND(InData%F_A_End,1) - ReKiBuf(Re_Xferred) = InData%F_A_End(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%F_BF_End) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_BF_End,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_BF_End,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F_BF_End,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_BF_End,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%F_BF_End,2), UBOUND(InData%F_BF_End,2) - DO i1 = LBOUND(InData%F_BF_End,1), UBOUND(InData%F_BF_End,1) - ReKiBuf(Re_Xferred) = InData%F_BF_End(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%V_rel_n) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%V_rel_n,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V_rel_n,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%V_rel_n,1), UBOUND(InData%V_rel_n,1) - ReKiBuf(Re_Xferred) = InData%V_rel_n(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%V_rel_n_HiPass) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%V_rel_n_HiPass,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V_rel_n_HiPass,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%V_rel_n_HiPass,1), UBOUND(InData%V_rel_n_HiPass,1) - ReKiBuf(Re_Xferred) = InData%V_rel_n_HiPass(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IntKiBuf(Int_Xferred) = InData%LastIndWave - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Morison_PackMisc - - SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(Morison_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DispNodePosHdn not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DispNodePosHdn)) DEALLOCATE(OutData%DispNodePosHdn) - ALLOCATE(OutData%DispNodePosHdn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DispNodePosHdn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%DispNodePosHdn,2), UBOUND(OutData%DispNodePosHdn,2) - DO i1 = LBOUND(OutData%DispNodePosHdn,1), UBOUND(OutData%DispNodePosHdn,1) - OutData%DispNodePosHdn(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DispNodePosHst not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%DispNodePosHst)) DEALLOCATE(OutData%DispNodePosHst) - ALLOCATE(OutData%DispNodePosHst(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DispNodePosHst.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%DispNodePosHst,2), UBOUND(OutData%DispNodePosHst,2) - DO i1 = LBOUND(OutData%DispNodePosHst,1), UBOUND(OutData%DispNodePosHst,1) - OutData%DispNodePosHst(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FV not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FV)) DEALLOCATE(OutData%FV) - ALLOCATE(OutData%FV(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FV.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FV,2), UBOUND(OutData%FV,2) - DO i1 = LBOUND(OutData%FV,1), UBOUND(OutData%FV,1) - OutData%FV(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FA not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FA)) DEALLOCATE(OutData%FA) - ALLOCATE(OutData%FA(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FA,2), UBOUND(OutData%FA,2) - DO i1 = LBOUND(OutData%FA,1), UBOUND(OutData%FA,1) - OutData%FA(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FAMCF not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FAMCF)) DEALLOCATE(OutData%FAMCF) - ALLOCATE(OutData%FAMCF(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAMCF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%FAMCF,2), UBOUND(OutData%FAMCF,2) - DO i1 = LBOUND(OutData%FAMCF,1), UBOUND(OutData%FAMCF,1) - OutData%FAMCF(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FDynP not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FDynP)) DEALLOCATE(OutData%FDynP) - ALLOCATE(OutData%FDynP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FDynP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%FDynP,1), UBOUND(OutData%FDynP,1) - OutData%FDynP(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveElev)) DEALLOCATE(OutData%WaveElev) - ALLOCATE(OutData%WaveElev(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveElev,1), UBOUND(OutData%WaveElev,1) - OutData%WaveElev(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveElev1)) DEALLOCATE(OutData%WaveElev1) - ALLOCATE(OutData%WaveElev1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveElev1,1), UBOUND(OutData%WaveElev1,1) - OutData%WaveElev1(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev2 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WaveElev2)) DEALLOCATE(OutData%WaveElev2) - ALLOCATE(OutData%WaveElev2(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%WaveElev2,1), UBOUND(OutData%WaveElev2,1) - OutData%WaveElev2(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! vrel not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%vrel)) DEALLOCATE(OutData%vrel) - ALLOCATE(OutData%vrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%vrel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%vrel,2), UBOUND(OutData%vrel,2) - DO i1 = LBOUND(OutData%vrel,1), UBOUND(OutData%vrel,1) - OutData%vrel(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nodeInWater not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%nodeInWater)) DEALLOCATE(OutData%nodeInWater) - ALLOCATE(OutData%nodeInWater(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nodeInWater.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%nodeInWater,1), UBOUND(OutData%nodeInWater,1) - OutData%nodeInWater(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! memberLoads not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%memberLoads)) DEALLOCATE(OutData%memberLoads) - ALLOCATE(OutData%memberLoads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%memberLoads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%memberLoads,1), UBOUND(OutData%memberLoads,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL Morison_UnpackMemberLoads( Re_Buf, Db_Buf, Int_Buf, OutData%memberLoads(i1), ErrStat2, ErrMsg2 ) ! memberLoads - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_B_End not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_B_End)) DEALLOCATE(OutData%F_B_End) - ALLOCATE(OutData%F_B_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_B_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_B_End,2), UBOUND(OutData%F_B_End,2) - DO i1 = LBOUND(OutData%F_B_End,1), UBOUND(OutData%F_B_End,1) - OutData%F_B_End(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_D_End not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_D_End)) DEALLOCATE(OutData%F_D_End) - ALLOCATE(OutData%F_D_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_D_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_D_End,2), UBOUND(OutData%F_D_End,2) - DO i1 = LBOUND(OutData%F_D_End,1), UBOUND(OutData%F_D_End,1) - OutData%F_D_End(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_I_End not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_I_End)) DEALLOCATE(OutData%F_I_End) - ALLOCATE(OutData%F_I_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_I_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_I_End,2), UBOUND(OutData%F_I_End,2) - DO i1 = LBOUND(OutData%F_I_End,1), UBOUND(OutData%F_I_End,1) - OutData%F_I_End(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_IMG_End not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_IMG_End)) DEALLOCATE(OutData%F_IMG_End) - ALLOCATE(OutData%F_IMG_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_IMG_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_IMG_End,2), UBOUND(OutData%F_IMG_End,2) - DO i1 = LBOUND(OutData%F_IMG_End,1), UBOUND(OutData%F_IMG_End,1) - OutData%F_IMG_End(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_A_End not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_A_End)) DEALLOCATE(OutData%F_A_End) - ALLOCATE(OutData%F_A_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_A_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_A_End,2), UBOUND(OutData%F_A_End,2) - DO i1 = LBOUND(OutData%F_A_End,1), UBOUND(OutData%F_A_End,1) - OutData%F_A_End(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_BF_End not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F_BF_End)) DEALLOCATE(OutData%F_BF_End) - ALLOCATE(OutData%F_BF_End(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_BF_End.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%F_BF_End,2), UBOUND(OutData%F_BF_End,2) - DO i1 = LBOUND(OutData%F_BF_End,1), UBOUND(OutData%F_BF_End,1) - OutData%F_BF_End(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! V_rel_n not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%V_rel_n)) DEALLOCATE(OutData%V_rel_n) - ALLOCATE(OutData%V_rel_n(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%V_rel_n.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%V_rel_n,1), UBOUND(OutData%V_rel_n,1) - OutData%V_rel_n(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! V_rel_n_HiPass not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%V_rel_n_HiPass)) DEALLOCATE(OutData%V_rel_n_HiPass) - ALLOCATE(OutData%V_rel_n_HiPass(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%V_rel_n_HiPass.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%V_rel_n_HiPass,1), UBOUND(OutData%V_rel_n_HiPass,1) - OutData%V_rel_n_HiPass(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - OutData%LastIndWave = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE Morison_UnPackMisc - - SUBROUTINE Morison_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Morison_ParameterType), INTENT(IN) :: SrcParamData - TYPE(Morison_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_CopyParam' -! +subroutine Morison_CopyMGDepthsType(SrcMGDepthsTypeData, DstMGDepthsTypeData, CtrlCode, ErrStat, ErrMsg) + type(Morison_MGDepthsType), intent(in) :: SrcMGDepthsTypeData + type(Morison_MGDepthsType), intent(inout) :: DstMGDepthsTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'Morison_CopyMGDepthsType' ErrStat = ErrID_None ErrMsg = '' DstMGDepthsTypeData%MGDpth = SrcMGDepthsTypeData%MGDpth @@ -6008,6 +4603,30 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'Morison_CopyMisc' ErrStat = ErrID_None ErrMsg = '' + if (allocated(SrcMiscData%DispNodePosHdn)) then + LB(1:2) = lbound(SrcMiscData%DispNodePosHdn) + UB(1:2) = ubound(SrcMiscData%DispNodePosHdn) + if (.not. allocated(DstMiscData%DispNodePosHdn)) then + allocate(DstMiscData%DispNodePosHdn(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%DispNodePosHdn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%DispNodePosHdn = SrcMiscData%DispNodePosHdn + end if + if (allocated(SrcMiscData%DispNodePosHst)) then + LB(1:2) = lbound(SrcMiscData%DispNodePosHst) + UB(1:2) = ubound(SrcMiscData%DispNodePosHst) + if (.not. allocated(DstMiscData%DispNodePosHst)) then + allocate(DstMiscData%DispNodePosHst(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%DispNodePosHst.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%DispNodePosHst = SrcMiscData%DispNodePosHst + end if if (allocated(SrcMiscData%FV)) then LB(1:2) = lbound(SrcMiscData%FV) UB(1:2) = ubound(SrcMiscData%FV) @@ -6242,6 +4861,12 @@ subroutine Morison_DestroyMisc(MiscData, ErrStat, ErrMsg) character(*), parameter :: RoutineName = 'Morison_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' + if (allocated(MiscData%DispNodePosHdn)) then + deallocate(MiscData%DispNodePosHdn) + end if + if (allocated(MiscData%DispNodePosHst)) then + deallocate(MiscData%DispNodePosHst) + end if if (allocated(MiscData%FV)) then deallocate(MiscData%FV) end if @@ -6311,6 +4936,16 @@ subroutine Morison_PackMisc(Buf, Indata) integer(IntKi) :: i1, i2 integer(IntKi) :: LB(2), UB(2) if (Buf%ErrStat >= AbortErrLev) return + call RegPack(Buf, allocated(InData%DispNodePosHdn)) + if (allocated(InData%DispNodePosHdn)) then + call RegPackBounds(Buf, 2, lbound(InData%DispNodePosHdn), ubound(InData%DispNodePosHdn)) + call RegPack(Buf, InData%DispNodePosHdn) + end if + call RegPack(Buf, allocated(InData%DispNodePosHst)) + if (allocated(InData%DispNodePosHst)) then + call RegPackBounds(Buf, 2, lbound(InData%DispNodePosHst), ubound(InData%DispNodePosHst)) + call RegPack(Buf, InData%DispNodePosHst) + end if call RegPack(Buf, allocated(InData%FV)) if (allocated(InData%FV)) then call RegPackBounds(Buf, 2, lbound(InData%FV), ubound(InData%FV)) @@ -6418,6 +5053,34 @@ subroutine Morison_UnPackMisc(Buf, OutData) integer(IntKi) :: stat logical :: IsAllocAssoc if (Buf%ErrStat /= ErrID_None) return + if (allocated(OutData%DispNodePosHdn)) deallocate(OutData%DispNodePosHdn) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DispNodePosHdn(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DispNodePosHdn.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DispNodePosHdn) + if (RegCheckErr(Buf, RoutineName)) return + end if + if (allocated(OutData%DispNodePosHst)) deallocate(OutData%DispNodePosHst) + call RegUnpack(Buf, IsAllocAssoc) + if (RegCheckErr(Buf, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(Buf, 2, LB, UB) + if (RegCheckErr(Buf, RoutineName)) return + allocate(OutData%DispNodePosHst(LB(1):UB(1),LB(2):UB(2)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%DispNodePosHst.', Buf%ErrStat, Buf%ErrMsg, RoutineName) + return + end if + call RegUnpack(Buf, OutData%DispNodePosHst) + if (RegCheckErr(Buf, RoutineName)) return + end if if (allocated(OutData%FV)) deallocate(OutData%FV) call RegUnpack(Buf, IsAllocAssoc) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/hydrodyn/src/SS_Excitation_Types.f90 b/modules/hydrodyn/src/SS_Excitation_Types.f90 index 57958a45a1..6972a3aed9 100644 --- a/modules/hydrodyn/src/SS_Excitation_Types.f90 +++ b/modules/hydrodyn/src/SS_Excitation_Types.f90 @@ -36,7 +36,7 @@ MODULE SS_Excitation_Types IMPLICIT NONE ! ========= SS_Exc_InitInputType ======= TYPE, PUBLIC :: SS_Exc_InitInputType - CHARACTER(1024) :: InputFile = '' !< Name of the input file [-] + CHARACTER(1024) :: InputFile !< Name of the input file [-] INTEGER(IntKi) :: NBody = 0_IntKi !< Number of WAMIT bodies for this State Space model [-] INTEGER(IntKi) :: ExctnDisp = 0_IntKi !< 0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0] [-] REAL(ReKi) :: WaveDir = 0.0_ReKi !< Wave direction [rad] diff --git a/modules/hydrodyn/src/SS_Radiation_Types.f90 b/modules/hydrodyn/src/SS_Radiation_Types.f90 index 1fc725ce4e..fa9221a82f 100644 --- a/modules/hydrodyn/src/SS_Radiation_Types.f90 +++ b/modules/hydrodyn/src/SS_Radiation_Types.f90 @@ -35,7 +35,7 @@ MODULE SS_Radiation_Types IMPLICIT NONE ! ========= SS_Rad_InitInputType ======= TYPE, PUBLIC :: SS_Rad_InitInputType - CHARACTER(1024) :: InputFile = '' !< Name of the input file [-] + CHARACTER(1024) :: InputFile !< Name of the input file [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: enabledDOFs !< Vector with enable platf. DOFs [(m/s] INTEGER(IntKi) :: NBody = 0_IntKi !< Number of WAMIT bodies for this State Space model [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: PtfmRefztRot !< The rotation about zt of the body reference frame(s) from xt/yt [radians] diff --git a/modules/hydrodyn/src/WAMIT2_Types.f90 b/modules/hydrodyn/src/WAMIT2_Types.f90 index e1ddcaf797..519a2ca72f 100644 --- a/modules/hydrodyn/src/WAMIT2_Types.f90 +++ b/modules/hydrodyn/src/WAMIT2_Types.f90 @@ -37,7 +37,7 @@ MODULE WAMIT2_Types ! ========= WAMIT2_InitInputType ======= TYPE, PUBLIC :: WAMIT2_InitInputType LOGICAL :: HasWAMIT = .false. !< .TRUE. if using WAMIT model, .FALSE. otherwise [-] - CHARACTER(1024) :: WAMITFile = '' !< Root of the filename for WAMIT2 outputs [-] + CHARACTER(1024) :: WAMITFile !< Root of the filename for WAMIT2 outputs [-] INTEGER(IntKi) :: NBody = 0_IntKi !< [>=1; only used when PotMod=1. If NBodyMod=1, the WAMIT data contains a vector of size 6*NBody x 1 and matrices of size 6*NBody x 6*NBody; if NBodyMod>1, there are NBody sets of WAMIT data each with a vector of size 6 x 1 and matrices of size 6 x 6] [-] INTEGER(IntKi) :: NBodyMod = 0_IntKi !< Body coupling model {1: include coupling terms between each body and NBody in HydroDyn equals NBODY in WAMIT, 2: neglect coupling terms between each body and NBODY=1 with XBODY=0 in WAMIT, 3: Neglect coupling terms between each body and NBODY=1 with XBODY=/0 in WAMIT} (switch) [only used when PotMod=1] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PtfmRefxt !< The xt offset of the body reference point(s) from (0,0,0) [1 to NBody; only used when PotMod=1; must be 0.0 if NBodyMod=2 ] [(m)] diff --git a/modules/hydrodyn/src/WAMIT_Types.f90 b/modules/hydrodyn/src/WAMIT_Types.f90 index 40f98a7669..3083796d32 100644 --- a/modules/hydrodyn/src/WAMIT_Types.f90 +++ b/modules/hydrodyn/src/WAMIT_Types.f90 @@ -57,7 +57,7 @@ MODULE WAMIT_Types REAL(ReKi) :: ExctnCutOff = 0.0_ReKi !< Cutoff (corner) frequency of the low-pass time-filtered displaced position (Hz) [>0.0] [Hz] REAL(DbKi) :: RdtnTMax = 0.0_R8Ki !< [-] REAL(ReKi) :: WaveDir = 0.0_ReKi !< [-] - CHARACTER(1024) :: WAMITFile = '' !< [-] + CHARACTER(1024) :: WAMITFile !< [-] TYPE(Conv_Rdtn_InitInputType) :: Conv_Rdtn !< [-] REAL(ReKi) :: Rhoxg = 0.0_ReKi !< [-] INTEGER(IntKi) :: NStepWave = 0_IntKi !< [-] diff --git a/modules/icedyn/src/IceDyn_Types.f90 b/modules/icedyn/src/IceDyn_Types.f90 index f7b00967b2..d95b320029 100644 --- a/modules/icedyn/src/IceDyn_Types.f90 +++ b/modules/icedyn/src/IceDyn_Types.f90 @@ -99,8 +99,8 @@ MODULE IceDyn_Types ! ======================= ! ========= IceD_InitInputType ======= TYPE, PUBLIC :: IceD_InitInputType - CHARACTER(1024) :: InputFile = '' !< Name of the input file; remove if there is no file [-] - CHARACTER(1024) :: RootName = '' !< Root name of the output file [-] + CHARACTER(1024) :: InputFile !< Name of the input file; remove if there is no file [-] + CHARACTER(1024) :: RootName !< Root name of the output file [-] REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Offset between still-water level and mean sea level [m] REAL(ReKi) :: WtrDens = 0.0_ReKi !< Density of water [kg/m^3] REAL(ReKi) :: gravity = 0.0_ReKi !< Gravitational acceleration [m/s^2] @@ -169,7 +169,7 @@ MODULE IceDyn_Types INTEGER(IntKi) :: TmStep = 0_IntKi !< Total time step [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutName !< Names of all requested output parameters [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutUnit !< Units of all requested output parameters [-] - CHARACTER(1024) :: RootName = '' !< Rootname [-] + CHARACTER(1024) :: RootName !< Rootname [-] REAL(ReKi) :: tm1a = 0.0_ReKi !< Time for the maximum force to be reached for model 1a [s] REAL(ReKi) :: tm1b = 0.0_ReKi !< Time for the maximum force to be reached for model 1b [s] REAL(ReKi) :: tm1c = 0.0_ReKi !< Time for the maximum force to be reached for model 1c [s] diff --git a/modules/icefloe/src/icefloe/IceFloe_Types.f90 b/modules/icefloe/src/icefloe/IceFloe_Types.f90 index 5ececda879..aa26df889b 100644 --- a/modules/icefloe/src/icefloe/IceFloe_Types.f90 +++ b/modules/icefloe/src/icefloe/IceFloe_Types.f90 @@ -35,11 +35,11 @@ MODULE IceFloe_Types IMPLICIT NONE ! ========= IceFloe_InitInputType ======= TYPE, PUBLIC :: IceFloe_InitInputType - CHARACTER(1024) :: InputFile = '' !< Name of the input file [-] + CHARACTER(1024) :: InputFile !< Name of the input file [-] REAL(ReKi) :: simLength = 0.0_ReKi !< Duration of simulation [sec] REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Offset between still-water level and mean sea level [m] REAL(ReKi) :: gravity = 0.0_ReKi !< Gravitational acceleration [m/s^2] - character(1024) :: RootName = '' !< Output file root name [-] + character(1024) :: RootName !< Output file root name [-] END TYPE IceFloe_InitInputType ! ======================= ! ========= IceFloe_InitOutputType ======= diff --git a/modules/inflowwind/src/IfW_FlowField_Types.f90 b/modules/inflowwind/src/IfW_FlowField_Types.f90 index 68ef3eef0b..8f67708c28 100644 --- a/modules/inflowwind/src/IfW_FlowField_Types.f90 +++ b/modules/inflowwind/src/IfW_FlowField_Types.f90 @@ -41,9 +41,9 @@ MODULE IfW_FlowField_Types INTEGER(IntKi), PUBLIC, PARAMETER :: User_FieldType = 5 ! User FieldType configured by the user [-] ! ========= UniformFieldType ======= TYPE, PUBLIC :: UniformFieldType - REAL(ReKi) :: RefHeight !< reference height; used to center the wind [meters] - REAL(ReKi) :: RefLength !< reference length used to scale the linear shear [meters] - INTEGER(IntKi) :: DataSize !< size of data in HH file [-] + REAL(ReKi) :: RefHeight = 0.0_ReKi !< reference height; used to center the wind [meters] + REAL(ReKi) :: RefLength = 0.0_ReKi !< reference length used to scale the linear shear [meters] + INTEGER(IntKi) :: DataSize = 0_IntKi !< size of data in HH file [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Time !< HH time array [seconds] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: VelH !< HH horizontal wind speed [meters/sec] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: VelHDot !< Derivative of HH horizontal wind speed wrt time [meters/sec] @@ -65,31 +65,31 @@ MODULE IfW_FlowField_Types ! ======================= ! ========= UniformField_Interp ======= TYPE, PUBLIC :: UniformField_Interp - REAL(ReKi) :: VelH !< HH horizontal wind speed [meters/sec] - REAL(ReKi) :: VelHDot !< derivative of HH horizontal wind speed wrt Time [meters/sec] - REAL(ReKi) :: VelV !< HH vertical wind speed, including tower shadow [meters/sec] - REAL(ReKi) :: VelVDot !< derivative of HH vertical wind speed wrt Time [meters/sec] - REAL(ReKi) :: VelGust !< HH wind gust speed [-] - REAL(ReKi) :: VelGustDot !< derivative of HH wind gust speed wrt Time [-] - REAL(ReKi) :: AngleH !< HH wind direction angle [degrees] - REAL(ReKi) :: AngleHDot !< derivative of HH wind direction angle wrt Time [degrees] - REAL(ReKi) :: AngleV !< HH upflow angle [degrees] - REAL(ReKi) :: AngleVDot !< derivative of HH upflow angle wrt Time [degrees] - REAL(ReKi) :: ShrH !< HH horizontal linear shear [-] - REAL(ReKi) :: ShrHDot !< derivative of HH horizontal linear shear wrt Time [-] - REAL(ReKi) :: ShrV !< HH vertical shear exponent [-] - REAL(ReKi) :: ShrVDot !< derivative of HH vertical shear exponent wrt Time [-] - REAL(ReKi) :: LinShrV !< HH vertical linear shear [seconds] - REAL(ReKi) :: LinShrVDot !< derivative of HH vertical linear shear wrt Time [seconds] - REAL(ReKi) :: CosAngleH !< Horizontal angle components [-] - REAL(ReKi) :: SinAngleH !< Horizontal angle components [-] - REAL(ReKi) :: CosAngleV !< Vertical angle components [-] - REAL(ReKi) :: SinAngleV !< Vertical angle components [-] + REAL(ReKi) :: VelH = 0.0_ReKi !< HH horizontal wind speed [meters/sec] + REAL(ReKi) :: VelHDot = 0.0_ReKi !< derivative of HH horizontal wind speed wrt Time [meters/sec] + REAL(ReKi) :: VelV = 0.0_ReKi !< HH vertical wind speed, including tower shadow [meters/sec] + REAL(ReKi) :: VelVDot = 0.0_ReKi !< derivative of HH vertical wind speed wrt Time [meters/sec] + REAL(ReKi) :: VelGust = 0.0_ReKi !< HH wind gust speed [-] + REAL(ReKi) :: VelGustDot = 0.0_ReKi !< derivative of HH wind gust speed wrt Time [-] + REAL(ReKi) :: AngleH = 0.0_ReKi !< HH wind direction angle [degrees] + REAL(ReKi) :: AngleHDot = 0.0_ReKi !< derivative of HH wind direction angle wrt Time [degrees] + REAL(ReKi) :: AngleV = 0.0_ReKi !< HH upflow angle [degrees] + REAL(ReKi) :: AngleVDot = 0.0_ReKi !< derivative of HH upflow angle wrt Time [degrees] + REAL(ReKi) :: ShrH = 0.0_ReKi !< HH horizontal linear shear [-] + REAL(ReKi) :: ShrHDot = 0.0_ReKi !< derivative of HH horizontal linear shear wrt Time [-] + REAL(ReKi) :: ShrV = 0.0_ReKi !< HH vertical shear exponent [-] + REAL(ReKi) :: ShrVDot = 0.0_ReKi !< derivative of HH vertical shear exponent wrt Time [-] + REAL(ReKi) :: LinShrV = 0.0_ReKi !< HH vertical linear shear [seconds] + REAL(ReKi) :: LinShrVDot = 0.0_ReKi !< derivative of HH vertical linear shear wrt Time [seconds] + REAL(ReKi) :: CosAngleH = 0.0_ReKi !< Horizontal angle components [-] + REAL(ReKi) :: SinAngleH = 0.0_ReKi !< Horizontal angle components [-] + REAL(ReKi) :: CosAngleV = 0.0_ReKi !< Vertical angle components [-] + REAL(ReKi) :: SinAngleV = 0.0_ReKi !< Vertical angle components [-] END TYPE UniformField_Interp ! ======================= ! ========= Grid3DFieldType ======= TYPE, PUBLIC :: Grid3DFieldType - INTEGER(IntKi) :: WindFileFormat !< Binary file format description number [-] + INTEGER(IntKi) :: WindFileFormat = 0_IntKi !< Binary file format description number [-] INTEGER(IntKi) :: WindProfileType = -1 !< Wind profile type (0=constant;1=logarithmic;2=power law) [-] LOGICAL :: Periodic = .false. !< Flag to indicate if the wind file is periodic [-] LOGICAL :: InterpTower = .false. !< Flag to indicate if we should interpolate wind speeds below the tower [-] @@ -129,12 +129,12 @@ MODULE IfW_FlowField_Types ! ======================= ! ========= Grid4DFieldType ======= TYPE, PUBLIC :: Grid4DFieldType - INTEGER(IntKi) , DIMENSION(1:4) :: n !< number of evenly-spaced grid points in the x, y, z, and t directions [-] - REAL(ReKi) , DIMENSION(1:4) :: delta !< size between 2 consecutive grid points in each grid direction [m,m,m,s] - REAL(ReKi) , DIMENSION(1:3) :: pZero !< fixed position of the XYZ grid (i.e., XYZ coordinates of m%V(:,1,1,1,:)) [m] + INTEGER(IntKi) , DIMENSION(1:4) :: n = 0_IntKi !< number of evenly-spaced grid points in the x, y, z, and t directions [-] + REAL(ReKi) , DIMENSION(1:4) :: delta = 0.0_ReKi !< size between 2 consecutive grid points in each grid direction [m,m,m,s] + REAL(ReKi) , DIMENSION(1:3) :: pZero = 0.0_ReKi !< fixed position of the XYZ grid (i.e., XYZ coordinates of m%V(:,1,1,1,:)) [m] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: Vel => NULL() !< this is the 4-d velocity field for each wind component [{uvw},nx,ny,nz,nt] [-] - REAL(ReKi) :: TimeStart !< this is the time where the first time grid in m%V starts (i.e, the time associated with m%V(:,:,:,:,1)) [s] - REAL(ReKi) :: RefHeight !< reference height; used to center the wind [meters] + REAL(ReKi) :: TimeStart = 0.0_ReKi !< this is the time where the first time grid in m%V starts (i.e, the time associated with m%V(:,:,:,:,1)) [s] + REAL(ReKi) :: RefHeight = 0.0_ReKi !< reference height; used to center the wind [meters] END TYPE Grid4DFieldType ! ======================= ! ========= PointsFieldType ======= @@ -144,20 +144,20 @@ MODULE IfW_FlowField_Types ! ======================= ! ========= UserFieldType ======= TYPE, PUBLIC :: UserFieldType - REAL(ReKi) :: RefHeight !< reference height; used to center the wind [meters] + REAL(ReKi) :: RefHeight = 0.0_ReKi !< reference height; used to center the wind [meters] END TYPE UserFieldType ! ======================= ! ========= FlowFieldType ======= TYPE, PUBLIC :: FlowFieldType INTEGER(IntKi) :: FieldType = 0 !< Switch for flow field type {1=Uniform, 2=Grid, 3=User, 4=External} [-] - REAL(ReKi) , DIMENSION(1:3) :: RefPosition !< Reference position (point where box is rotated) [meters] - REAL(ReKi) :: PropagationDir !< Direction of wind propagation [radians] - REAL(ReKi) :: VFlowAngle !< Vertical (upflow) angle [radians] + REAL(ReKi) , DIMENSION(1:3) :: RefPosition = 0.0_ReKi !< Reference position (point where box is rotated) [meters] + REAL(ReKi) :: PropagationDir = 0.0_ReKi !< Direction of wind propagation [radians] + REAL(ReKi) :: VFlowAngle = 0.0_ReKi !< Vertical (upflow) angle [radians] LOGICAL :: VelInterpCubic = .false. !< Velocity interpolation order in time (1=linear; 3=cubic) [Used with WindType=2,3,4,5,7] [-] LOGICAL :: RotateWindBox = .false. !< flag indicating if the wind will be rotated [-] LOGICAL :: AccFieldValid = .false. !< flag indicating that acceleration field has been calculated [-] - REAL(ReKi) , DIMENSION(1:3,1:3) :: RotToWind !< Rotation matrix for rotating from the global XYZ coordinate system to the wind coordinate system (wind along X') [-] - REAL(ReKi) , DIMENSION(1:3,1:3) :: RotFromWind !< Rotation matrix for rotating from the wind coordinate system (wind along X') back to the global XYZ coordinate system. Equal to TRANSPOSE(RotToWind) [-] + REAL(ReKi) , DIMENSION(1:3,1:3) :: RotToWind = 0.0_ReKi !< Rotation matrix for rotating from the global XYZ coordinate system to the wind coordinate system (wind along X') [-] + REAL(ReKi) , DIMENSION(1:3,1:3) :: RotFromWind = 0.0_ReKi !< Rotation matrix for rotating from the wind coordinate system (wind along X') back to the global XYZ coordinate system. Equal to TRANSPOSE(RotToWind) [-] TYPE(UniformFieldType) :: Uniform !< Uniform Flow Data [-] TYPE(Grid3DFieldType) :: Grid3D !< Grid Field Wind Data [-] TYPE(Grid4DFieldType) :: Grid4D !< External Grid Flow Data [-] diff --git a/modules/inflowwind/src/InflowWind_IO_Types.f90 b/modules/inflowwind/src/InflowWind_IO_Types.f90 index ab6885156a..defa03ae42 100644 --- a/modules/inflowwind/src/InflowWind_IO_Types.f90 +++ b/modules/inflowwind/src/InflowWind_IO_Types.f90 @@ -36,7 +36,7 @@ MODULE InflowWind_IO_Types IMPLICIT NONE ! ========= WindFileDat ======= TYPE, PUBLIC :: WindFileDat - character(1024) :: FileName = '' !< Name of the windfile retrieved [-] + character(1024) :: FileName !< Name of the windfile retrieved [-] INTEGER(IntKi) :: WindType = 0 !< Type of the windfile [-] REAL(ReKi) :: RefHt = 0.0_ReKi !< Reference height given in file [meters] LOGICAL :: RefHt_Set = .false. !< Reference height was given in file [-] @@ -65,7 +65,7 @@ MODULE InflowWind_IO_Types ! ======================= ! ========= Uniform_InitInputType ======= TYPE, PUBLIC :: Uniform_InitInputType - character(1024) :: WindFileName = '' !< Name of the wind file to use [-] + character(1024) :: WindFileName !< Name of the wind file to use [-] REAL(ReKi) :: RefHt = 0.0_ReKi !< Reference height for horizontal wind speed [meters] REAL(ReKi) :: RefLength = 0.0_ReKi !< Reference length for linear horizontal and vertical sheer [-] REAL(ReKi) :: PropagationDir = 0.0_ReKi !< Direction of wind propagation [radians] @@ -91,12 +91,12 @@ MODULE InflowWind_IO_Types ! ======================= ! ========= TurbSim_InitInputType ======= TYPE, PUBLIC :: TurbSim_InitInputType - character(1024) :: WindFileName = '' !< Name of the wind file to use [-] + character(1024) :: WindFileName !< Name of the wind file to use [-] END TYPE TurbSim_InitInputType ! ======================= ! ========= Bladed_InitInputType ======= TYPE, PUBLIC :: Bladed_InitInputType - character(1024) :: WindFileName = '' !< Root filename [-] + character(1024) :: WindFileName !< Root filename [-] INTEGER(IntKi) :: WindType = 0_IntKi !< Whether this is native Bladed (needs wind profile and TI scaling) or not [-] LOGICAL :: NativeBladedFmt = .false. !< Whether this is native Bladed (needs wind profile and TI scaling) or not [-] LOGICAL :: TowerFileExist = .false. !< Tower file exists [-] @@ -112,7 +112,7 @@ MODULE InflowWind_IO_Types ! ======================= ! ========= HAWC_InitInputType ======= TYPE, PUBLIC :: HAWC_InitInputType - character(1024) , DIMENSION(1:3) :: WindFileName = '' !< Name of the wind file to use [-] + character(1024) , DIMENSION(1:3) :: WindFileName !< Name of the wind file to use [-] INTEGER(IntKi) :: nx = 0 !< Number of grids in the x direction (in the 3 files above) [-] INTEGER(IntKi) :: ny = 0 !< Number of grids in the y direction (in the 3 files above) [-] INTEGER(IntKi) :: nz = 0 !< Number of grids in the z direction (in the 3 files above) [-] diff --git a/modules/inflowwind/src/InflowWind_Types.f90 b/modules/inflowwind/src/InflowWind_Types.f90 index e49791a51f..2277e3af71 100644 --- a/modules/inflowwind/src/InflowWind_Types.f90 +++ b/modules/inflowwind/src/InflowWind_Types.f90 @@ -62,18 +62,18 @@ MODULE InflowWind_Types REAL(ReKi) :: Steady_HWindSpeed = 0.0_ReKi !< Steady wind -- horizontal windspeed [meters/s] REAL(ReKi) :: Steady_RefHt = 0.0_ReKi !< Steady wind -- reference height [meters] REAL(ReKi) :: Steady_PLexp = 0.0_ReKi !< Steady wind -- power law exponent [-] - CHARACTER(1024) :: Uniform_FileName = '' !< Uniform wind -- filename [-] + CHARACTER(1024) :: Uniform_FileName !< Uniform wind -- filename [-] REAL(ReKi) :: Uniform_RefHt = 0.0_ReKi !< Uniform wind -- reference height [meters] REAL(ReKi) :: Uniform_RefLength = 0.0_ReKi !< Uniform wind -- reference length [meters] - CHARACTER(1024) :: TSFF_FileName = '' !< TurbSim Full-Field -- filename [-] - CHARACTER(1024) :: BladedFF_FileName = '' !< Bladed-style Full-Field -- filename [-] + CHARACTER(1024) :: TSFF_FileName !< TurbSim Full-Field -- filename [-] + CHARACTER(1024) :: BladedFF_FileName !< Bladed-style Full-Field -- filename [-] LOGICAL :: BladedFF_TowerFile = .false. !< Bladed-style Full-Field -- tower file exists [-] LOGICAL :: CTTS_CoherentTurb = .FALSE. !< Coherent turbulence data exists [-] - CHARACTER(1024) :: CTTS_FileName = '' !< Name of coherent turbulence file [-] - CHARACTER(1024) :: CTTS_Path = '' !< Path to coherent turbulence binary data files [-] - CHARACTER(1024) :: HAWC_FileName_u = '' !< HAWC -- u component binary data file name [-] - CHARACTER(1024) :: HAWC_FileName_v = '' !< HAWC -- v component binary data file name [-] - CHARACTER(1024) :: HAWC_FileName_w = '' !< HAWC -- w component binary data file name [-] + CHARACTER(1024) :: CTTS_FileName !< Name of coherent turbulence file [-] + CHARACTER(1024) :: CTTS_Path !< Path to coherent turbulence binary data files [-] + CHARACTER(1024) :: HAWC_FileName_u !< HAWC -- u component binary data file name [-] + CHARACTER(1024) :: HAWC_FileName_v !< HAWC -- v component binary data file name [-] + CHARACTER(1024) :: HAWC_FileName_w !< HAWC -- w component binary data file name [-] INTEGER(IntKi) :: HAWC_nx = 0_IntKi !< HAWC -- number of grids in x direction [-] INTEGER(IntKi) :: HAWC_ny = 0_IntKi !< HAWC -- number of grids in y direction [-] INTEGER(IntKi) :: HAWC_nz = 0_IntKi !< HAWC -- number of grids in z direction [-] @@ -100,14 +100,14 @@ MODULE InflowWind_Types ! ======================= ! ========= InflowWind_InitInputType ======= TYPE, PUBLIC :: InflowWind_InitInputType - CHARACTER(1024) :: InputFileName = '' !< Name of the InflowWind input file to use [-] + CHARACTER(1024) :: InputFileName !< Name of the InflowWind input file to use [-] LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] LOGICAL :: Use4Dext = .FALSE. !< Flag that tells this module if an external module will pass it 4-D velocity grids. [-] INTEGER(IntKi) :: NumWindPoints = 0_IntKi !< Number of wind velocity points expected [-] INTEGER(IntKi) :: TurbineID = 0 !< Wind turbine ID number in the fixed (DEFAULT) file name when FixedWindFileRootName = .TRUE. (used by FAST.Farm) [-] LOGICAL :: FixedWindFileRootName = .FALSE. !< Do the wind data files have a fixed (DEFAULT) file name? (used by FAST.Farm) [-] LOGICAL :: UseInputFile = .TRUE. !< Should we read everthing from an input file, or do we get it some other way [-] - CHARACTER(1024) :: RootName = '' !< RootName for writing output files [-] + CHARACTER(1024) :: RootName !< RootName for writing output files [-] TYPE(FileInfoType) :: PassedFileData !< If we don't use the input file, pass everything through this [-] LOGICAL :: WindType2UseInputFile = .TRUE. !< Flag for toggling file based IO in wind type 2. [-] TYPE(FileInfoType) :: WindType2Data !< Optional slot for wind type 2 data if file IO is not used. [-] @@ -138,7 +138,7 @@ MODULE InflowWind_Types ! ======================= ! ========= InflowWind_ParameterType ======= TYPE, PUBLIC :: InflowWind_ParameterType - CHARACTER(1024) :: RootFileName = '' !< Root of the InflowWind input filename [-] + CHARACTER(1024) :: RootFileName !< Root of the InflowWind input filename [-] REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for cont. state integration & disc. state update [seconds] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WindViXYZprime !< List of XYZ coordinates for velocity measurements, translated to the wind coordinate system (prime coordinates). This equals MATMUL( RotToWind, ParamData%WindViXYZ ) [meters] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WindViXYZ !< List of XYZ coordinates for wind velocity measurements, 3xNWindVel [meters] diff --git a/modules/map/src/MAP_Types.f90 b/modules/map/src/MAP_Types.f90 index 26be3ddba4..3dac702373 100644 --- a/modules/map/src/MAP_Types.f90 +++ b/modules/map/src/MAP_Types.f90 @@ -52,12 +52,12 @@ MODULE MAP_Types REAL(R8Ki) :: gravity = -999.9 !< gravity constant [[m/s^2]] REAL(R8Ki) :: sea_density = -999.9 !< sea density [[kg/m^3]] REAL(R8Ki) :: depth = -999.9 !< depth of water [[m]] - CHARACTER(255) :: file_name = '' !< MAP input file [-] - CHARACTER(255) :: summary_file_name = '' !< MAP summary file name [-] - CHARACTER(255) :: library_input_str = '' !< cable library string information (from input file) [-] - CHARACTER(255) :: node_input_str = '' !< node string information (from input file) [-] - CHARACTER(255) :: line_input_str = '' !< element library string information (from input file) [-] - CHARACTER(255) :: option_input_str = '' !< solver options library string information (from input file) [-] + CHARACTER(255) :: file_name !< MAP input file [-] + CHARACTER(255) :: summary_file_name !< MAP summary file name [-] + CHARACTER(255) :: library_input_str !< cable library string information (from input file) [-] + CHARACTER(255) :: node_input_str !< node string information (from input file) [-] + CHARACTER(255) :: line_input_str !< element library string information (from input file) [-] + CHARACTER(255) :: option_input_str !< solver options library string information (from input file) [-] TYPE(Lin_InitInputType) :: LinInitInp !< [-] END TYPE MAP_InitInputType ! ======================= @@ -74,9 +74,9 @@ MODULE MAP_Types END TYPE MAP_InitOutputType_C TYPE, PUBLIC :: MAP_InitOutputType TYPE( MAP_InitOutputType_C ) :: C_obj - CHARACTER(99) :: progName = '' !< program name [-] - CHARACTER(99) :: version = '' !< version numnber [-] - CHARACTER(24) :: compilingData = '' !< compiling data [-] + CHARACTER(99) :: progName !< program name [-] + CHARACTER(99) :: version !< version numnber [-] + CHARACTER(24) :: compilingData !< compiling data [-] CHARACTER(15) , DIMENSION(:), ALLOCATABLE :: writeOutputHdr !< first line output file contents: output variable names [-] CHARACTER(15) , DIMENSION(:), ALLOCATABLE :: writeOutputUnt !< second line of output file contents: units [-] TYPE(ProgDesc) :: Ver !< this module's name, version, and date [-] @@ -197,8 +197,8 @@ MODULE MAP_Types REAL(R8Ki) :: depth = 0.0_R8Ki !< distance to seabed [[m]] REAL(R8Ki) :: rho_sea = 0.0_R8Ki !< density of seawater [[m]] REAL(R8Ki) :: dt = 0.0_R8Ki !< time step coupling interval [[sec]] - CHARACTER(255) , DIMENSION(1:500) :: InputLines = '' !< input file line for restart [-] - CHARACTER(1) , DIMENSION(1:500) :: InputLineType = '' !< input file line type for restart [-] + CHARACTER(255) , DIMENSION(1:500) :: InputLines !< input file line for restart [-] + CHARACTER(1) , DIMENSION(1:500) :: InputLineType !< input file line type for restart [-] INTEGER(IntKi) :: numOuts = 0 !< Number of write outputs [-] TYPE(Lin_ParamType) :: LinParams !< Parameter linearization data (fortran-only) [-] END TYPE MAP_ParameterType diff --git a/modules/moordyn/src/MoorDyn_Types.f90 b/modules/moordyn/src/MoorDyn_Types.f90 index 1c05f4a030..35f30478c4 100644 --- a/modules/moordyn/src/MoorDyn_Types.f90 +++ b/modules/moordyn/src/MoorDyn_Types.f90 @@ -50,8 +50,8 @@ MODULE MoorDyn_Types INTEGER(IntKi) :: FarmSize = 0 !< Indicates normal FAST module mode if 0, FAST.Farm coupled mode and =nTurbines if >0 [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TurbineRefPos !< reference position of turbines in farm, shape: 3, nTurbines [-] REAL(ReKi) :: Tmax = 0.0_ReKi !< simulation duration [[s]] - CHARACTER(1024) :: FileName = '' !< MoorDyn input file [-] - CHARACTER(1024) :: RootName = '' !< RootName for writing output files [-] + CHARACTER(1024) :: FileName !< MoorDyn input file [-] + CHARACTER(1024) :: RootName !< RootName for writing output files [-] LOGICAL :: UsePrimaryInputFile = .TRUE. !< Read input file instead of passed data [-] TYPE(FileInfoType) :: PassedPrimaryInputData !< Primary input file as FileInfoType (set by driver/glue code) -- String array with metadata [-] LOGICAL :: Echo = .false. !< echo parameter - do we want to echo the header line describing the input file? [-] @@ -62,7 +62,7 @@ MODULE MoorDyn_Types ! ========= MD_LineProp ======= TYPE, PUBLIC :: MD_LineProp INTEGER(IntKi) :: IdNum = 0_IntKi !< integer identifier of this set of line properties [-] - CHARACTER(20) :: name = '' !< name/identifier of this set of line properties [-] + CHARACTER(20) :: name !< name/identifier of this set of line properties [-] REAL(DbKi) :: d = 0.0_R8Ki !< volume-equivalent diameter [[m]] REAL(DbKi) :: w = 0.0_R8Ki !< per-length weight in air [[kg/m]] REAL(DbKi) :: EA = 0.0_R8Ki !< axial stiffness [[N]] @@ -89,7 +89,7 @@ MODULE MoorDyn_Types ! ========= MD_RodProp ======= TYPE, PUBLIC :: MD_RodProp INTEGER(IntKi) :: IdNum = 0_IntKi !< integer identifier of this set of rod properties [-] - CHARACTER(10) :: name = '' !< name/identifier of this set of rod properties [-] + CHARACTER(10) :: name !< name/identifier of this set of rod properties [-] REAL(DbKi) :: d = 0.0_R8Ki !< volume-equivalent diameter [[m]] REAL(DbKi) :: w = 0.0_R8Ki !< per-length weight in air [[kg/m]] REAL(DbKi) :: Can = 0.0_R8Ki !< transverse added mass coefficient [-] @@ -133,7 +133,7 @@ MODULE MoorDyn_Types ! ========= MD_Connect ======= TYPE, PUBLIC :: MD_Connect INTEGER(IntKi) :: IdNum = 0_IntKi !< integer identifier of this Connection [-] - CHARACTER(10) :: type = '' !< type of Connect: fix, vessel, connect [-] + CHARACTER(10) :: type !< type of Connect: fix, vessel, connect [-] INTEGER(IntKi) :: typeNum = 0_IntKi !< integer identifying the type. 0=fixed, 1=vessel, 2=connect [-] INTEGER(IntKi) , DIMENSION(1:10) :: Attached = 0_IntKi !< list of IdNums of lines attached to this connection node [-] INTEGER(IntKi) , DIMENSION(1:10) :: Top = 0_IntKi !< list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] @@ -160,7 +160,7 @@ MODULE MoorDyn_Types ! ========= MD_Rod ======= TYPE, PUBLIC :: MD_Rod INTEGER(IntKi) :: IdNum = 0_IntKi !< integer identifier of this Line [-] - CHARACTER(10) :: type = '' !< type of Rod. should match one of RodProp names [-] + CHARACTER(10) :: type !< type of Rod. should match one of RodProp names [-] INTEGER(IntKi) :: PropsIdNum = 0_IntKi !< the IdNum of the associated rod properties [-] INTEGER(IntKi) :: typeNum = 0_IntKi !< integer identifying the type. 0=fixed, 1=vessel, 2=connect [-] INTEGER(IntKi) , DIMENSION(1:10) :: AttachedA = 0_IntKi !< list of IdNums of lines attached to end A [-] @@ -293,8 +293,8 @@ MODULE MoorDyn_Types ! ======================= ! ========= MD_OutParmType ======= TYPE, PUBLIC :: MD_OutParmType - CHARACTER(10) :: Name = '' !< name of output channel [-] - CHARACTER(10) :: Units = '' !< units string [-] + CHARACTER(10) :: Name !< name of output channel [-] + CHARACTER(10) :: Units !< units string [-] INTEGER(IntKi) :: QType = 0_IntKi !< type of quantity - 0=tension, 1=x, 2=y, 3=z... [-] INTEGER(IntKi) :: OType = 0_IntKi !< type of object - 0=line, 1=connect [-] INTEGER(IntKi) :: NodeID = 0_IntKi !< node number if OType=0. 0=anchor, -1=N=Fairlead [-] @@ -404,11 +404,11 @@ MODULE MoorDyn_Types REAL(DbKi) :: dtCoupling = 0.0_R8Ki !< coupling time step that MoorDyn should expect [[s]] INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] REAL(DbKi) :: dtOut = 0.0_R8Ki !< interval for writing output file lines [[s]] - CHARACTER(1024) :: RootName = '' !< RootName for writing output files [-] + CHARACTER(1024) :: RootName !< RootName for writing output files [-] TYPE(MD_OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] - CHARACTER(1) :: Delim = '' !< Column delimiter for output text files [-] + CHARACTER(1) :: Delim !< Column delimiter for output text files [-] INTEGER(IntKi) :: MDUnOut = 0_IntKi !< Unit number of main output file [-] - CHARACTER(1024) :: PriPath = '' !< The path to the primary MoorDyn input file, used if looking for additional input files [-] + CHARACTER(1024) :: PriPath !< The path to the primary MoorDyn input file, used if looking for additional input files [-] INTEGER(IntKi) :: writeLog = -1 !< Switch for level of log file output [-] INTEGER(IntKi) :: UnLog = -1 !< Unit number of log file [-] INTEGER(IntKi) :: WaveKin = 0_IntKi !< Flag for whether or how to consider water kinematics [-] diff --git a/modules/nwtc-library/src/NWTC_Library_Types.f90 b/modules/nwtc-library/src/NWTC_Library_Types.f90 index b38725239f..13195434b7 100644 --- a/modules/nwtc-library/src/NWTC_Library_Types.f90 +++ b/modules/nwtc-library/src/NWTC_Library_Types.f90 @@ -36,15 +36,15 @@ MODULE NWTC_Library_Types IMPLICIT NONE ! ========= ProgDesc ======= TYPE, PUBLIC :: ProgDesc - CHARACTER(99) :: Name = '' !< Name of the program or module [-] - CHARACTER(99) :: Ver = '' !< Version number of the program or module [-] - CHARACTER(24) :: Date = '' !< String containing date module was last updated [-] + CHARACTER(99) :: Name !< Name of the program or module [-] + CHARACTER(99) :: Ver !< Version number of the program or module [-] + CHARACTER(24) :: Date !< String containing date module was last updated [-] END TYPE ProgDesc ! ======================= ! ========= FASTdataType ======= TYPE, PUBLIC :: FASTdataType - CHARACTER(1024) :: File = '' !< Name of the FAST-style binary file [-] - CHARACTER(1024) :: Descr = '' !< String describing file [-] + CHARACTER(1024) :: File !< Name of the FAST-style binary file [-] + CHARACTER(1024) :: Descr !< String describing file [-] INTEGER(IntKi) :: NumChans = 0_IntKi !< Number of output channels in this binary file (not including the time channel) [-] INTEGER(IntKi) :: NumRecs = 0_IntKi !< Number of records (rows) of data in the file [-] REAL(DbKi) :: TimeStep = 0.0_R8Ki !< Time step for evenly-spaced data in the output file (when NumRecs is not allo [-] @@ -56,8 +56,8 @@ MODULE NWTC_Library_Types ! ========= OutParmType ======= TYPE, PUBLIC :: OutParmType INTEGER(IntKi) :: Indx = 0_IntKi !< An index into AllOuts array where this channel is computed/stored [-] - CHARACTER(ChanLen) :: Name = '' !< Name of the output channel [-] - CHARACTER(ChanLen) :: Units = '' !< Units this channel is specified in [-] + CHARACTER(ChanLen) :: Name !< Name of the output channel [-] + CHARACTER(ChanLen) :: Units !< Units this channel is specified in [-] INTEGER(IntKi) :: SignM = 0_IntKi !< Multiplier for output channel; usually -1 (minus) or 0 (invalid channel) [-] END TYPE OutParmType ! ======================= @@ -82,7 +82,7 @@ MODULE NWTC_Library_Types INTEGER(IntKi) :: pRNG = 0_IntKi INTEGER(IntKi) , DIMENSION(1:3) :: RandSeed = 0_IntKi INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: RandSeedAry - CHARACTER(6) :: RNG_type = '' + CHARACTER(6) :: RNG_type END TYPE NWTC_RandomNumber_ParameterType ! ======================= CONTAINS diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index 61a656fee7..aa9ff1b0c6 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -94,8 +94,8 @@ MODULE FAST_Types ! ======================= ! ========= FAST_VTK_ModeShapeType ======= TYPE, PUBLIC :: FAST_VTK_ModeShapeType - CHARACTER(1024) :: CheckpointRoot = '' !< name of the checkpoint file written by FAST when linearization data was produced [-] - CHARACTER(1024) :: MatlabFileName = '' !< name of the file with eigenvectors written by Matlab [-] + CHARACTER(1024) :: CheckpointRoot !< name of the checkpoint file written by FAST when linearization data was produced [-] + CHARACTER(1024) :: MatlabFileName !< name of the file with eigenvectors written by Matlab [-] INTEGER(IntKi) :: VTKLinModes = 0_IntKi !< Number of modes to visualize [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: VTKModes !< Which modes to visualize [-] INTEGER(IntKi) :: VTKLinTim = 0_IntKi !< Switch to make one animation for all LinTimes together (1) or separate animations for each LinTimes(2) [-] @@ -151,16 +151,16 @@ MODULE FAST_Types REAL(ReKi) :: Pvap = 0.0_ReKi !< Vapour pressure of working fluid [Pa] REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [m] REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Offset between still-water level and mean sea level [m] - CHARACTER(1024) :: EDFile = '' !< The name of the ElastoDyn input file [-] - CHARACTER(1024) , DIMENSION(1:MaxNBlades) :: BDBldFile = '' !< Name of files containing BeamDyn inputs for each blade [-] - CHARACTER(1024) :: InflowFile = '' !< Name of file containing inflow wind input parameters [-] - CHARACTER(1024) :: AeroFile = '' !< Name of file containing aerodynamic input parameters [-] - CHARACTER(1024) :: ServoFile = '' !< Name of file containing control and electrical-drive input parameters [-] - CHARACTER(1024) :: SeaStFile = '' !< Name of file containing sea state input parameters [-] - CHARACTER(1024) :: HydroFile = '' !< Name of file containing hydrodynamic input parameters [-] - CHARACTER(1024) :: SubFile = '' !< Name of file containing sub-structural input parameters [-] - CHARACTER(1024) :: MooringFile = '' !< Name of file containing mooring system input parameters [-] - CHARACTER(1024) :: IceFile = '' !< Name of file containing ice loading input parameters [-] + CHARACTER(1024) :: EDFile !< The name of the ElastoDyn input file [-] + CHARACTER(1024) , DIMENSION(1:MaxNBlades) :: BDBldFile !< Name of files containing BeamDyn inputs for each blade [-] + CHARACTER(1024) :: InflowFile !< Name of file containing inflow wind input parameters [-] + CHARACTER(1024) :: AeroFile !< Name of file containing aerodynamic input parameters [-] + CHARACTER(1024) :: ServoFile !< Name of file containing control and electrical-drive input parameters [-] + CHARACTER(1024) :: SeaStFile !< Name of file containing sea state input parameters [-] + CHARACTER(1024) :: HydroFile !< Name of file containing hydrodynamic input parameters [-] + CHARACTER(1024) :: SubFile !< Name of file containing sub-structural input parameters [-] + CHARACTER(1024) :: MooringFile !< Name of file containing mooring system input parameters [-] + CHARACTER(1024) :: IceFile !< Name of file containing ice loading input parameters [-] REAL(DbKi) :: TStart = 0.0_R8Ki !< Time to begin tabular output [s] REAL(DbKi) :: DT_Out = 0.0_R8Ki !< Time step for tabular output [s] LOGICAL :: WrSttsTime = .false. !< Whether we should write the status times to the screen [-] @@ -176,18 +176,18 @@ MODULE FAST_Types INTEGER(IntKi) :: WrVTK = 0 !< VTK Visualization data output: (switch) {0=none; 1=initialization data only; 2=animation} [-] INTEGER(IntKi) :: VTK_Type = 0_IntKi !< Type of VTK visualization data: (switch) {1=surfaces; 2=basic meshes (lines/points); 3=all meshes (debug)} [-] LOGICAL :: VTK_fields = .false. !< Write mesh fields to VTK data files? (flag) {true/false} [-] - CHARACTER(1) :: Delim = '' !< Delimiter between columns of text output file (.out): space or tab [-] - CHARACTER(20) :: OutFmt = '' !< Format used for text tabular output (except time); resulting field should be 10 characters [-] - CHARACTER(20) :: OutFmt_t = '' !< Format used for time channel in text tabular output; resulting field should be 10 characters [-] + CHARACTER(1) :: Delim !< Delimiter between columns of text output file (.out): space or tab [-] + CHARACTER(20) :: OutFmt !< Format used for text tabular output (except time); resulting field should be 10 characters [-] + CHARACTER(20) :: OutFmt_t !< Format used for time channel in text tabular output; resulting field should be 10 characters [-] INTEGER(IntKi) :: FmtWidth = 0_IntKi !< width of the time OutFmt specifier [-] INTEGER(IntKi) :: TChanLen = 0_IntKi !< width of the time channel [-] - CHARACTER(1024) :: OutFileRoot = '' !< The rootname of the output files [-] - CHARACTER(1024) :: FTitle = '' !< The description line from the FAST (glue-code) input file [-] + CHARACTER(1024) :: OutFileRoot !< The rootname of the output files [-] + CHARACTER(1024) :: FTitle !< The description line from the FAST (glue-code) input file [-] CHARACTER(1024) :: VTK_OutFileRoot = '' !< The rootname of the VTK output files [-] INTEGER(IntKi) :: VTK_tWidth = 0_IntKi !< Width of number of files for leading zeros in file name format [-] REAL(DbKi) :: VTK_fps = 0.0_R8Ki !< number of frames per second to output VTK data [-] TYPE(FAST_VTK_SurfaceType) :: VTK_surface !< Data for VTK surface visualization [-] - CHARACTER(4) :: Tdesc = '' !< description of turbine ID (for FAST.Farm) screen printing [-] + CHARACTER(4) :: Tdesc !< description of turbine ID (for FAST.Farm) screen printing [-] LOGICAL :: CalcSteady = .false. !< Calculate a steady-state periodic operating point before linearization [unused if Linearize=False] [-] INTEGER(IntKi) :: TrimCase = 0_IntKi !< Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} [unused if Linearize=False; used only if CalcSteady=True] [-] REAL(ReKi) :: TrimTol = 0.0_ReKi !< Tolerance for the rotational speed convergence (>0) [unused if Linearize=False; used only if CalcSteady=True] [-] @@ -351,11 +351,11 @@ MODULE FAST_Types INTEGER(IntKi) :: UnOu = -1 !< I/O unit number for the tabular output file [-] INTEGER(IntKi) :: UnSum = -1 !< I/O unit number for the summary file [-] INTEGER(IntKi) :: UnGra = -1 !< I/O unit number for mesh graphics [-] - CHARACTER(1024) , DIMENSION(1:3) :: FileDescLines = '' !< Description lines to include in output files (header, time run, plus module names/versions) [-] + CHARACTER(1024) , DIMENSION(1:3) :: FileDescLines !< Description lines to include in output files (header, time run, plus module names/versions) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: ChannelNames !< Names of the output channels [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: ChannelUnits !< Units for the output channels [-] TYPE(ProgDesc) , DIMENSION(1:NumModules) :: Module_Ver !< version information from all modules [-] - CHARACTER(ChanLen) , DIMENSION(1:NumModules) :: Module_Abrev = '' !< abbreviation for module (used in file output naming conventions) [-] + CHARACTER(ChanLen) , DIMENSION(1:NumModules) :: Module_Abrev !< abbreviation for module (used in file output naming conventions) [-] LOGICAL :: WriteThisStep = .false. !< Whether this step will be written in the FAST output files [-] INTEGER(IntKi) :: VTK_count = 0_IntKi !< Number of VTK files written (for naming output files) [-] INTEGER(IntKi) :: VTK_LastWaveIndx = 0_IntKi !< last index into wave array [-] @@ -773,7 +773,7 @@ MODULE FAST_Types REAL(ReKi) , DIMENSION(1:4) :: windGrid_delta = 0.0_ReKi !< size between 2 consecutive grid points in each grid direction for IfW [m,m,m,s] REAL(ReKi) , DIMENSION(1:3) :: windGrid_pZero = 0.0_ReKi !< fixed position of the XYZ grid (i.e., XYZ coordinates of IfW m%V(:,1,1,1,:)) [m] REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: windGrid_data => NULL() !< Pointers to Wind velocity of disturbed wind (ambient + wakes) across each high-resolution domain around a turbine for each high-resolution step within a low-resolution step [m/s] - CHARACTER(1024) :: RootName = '' !< Root name of FAST output files (overrides normal operation) [-] + CHARACTER(1024) :: RootName !< Root name of FAST output files (overrides normal operation) [-] INTEGER(IntKi) :: NumActForcePtsBlade = 0_IntKi !< number of actuator line force points in blade [-] INTEGER(IntKi) :: NumActForcePtsTower = 0_IntKi !< number of actuator line force points in tower [-] INTEGER(IntKi) :: NodeClusterType = 0_IntKi !< Node clustering for actuator line (0 - Uniform, 1 - Non-uniform clustered towards tip) [-] diff --git a/modules/openfast-registry/src/registry_gen_fortran.cpp b/modules/openfast-registry/src/registry_gen_fortran.cpp index 79a481c5e0..de290335fd 100644 --- a/modules/openfast-registry/src/registry_gen_fortran.cpp +++ b/modules/openfast-registry/src/registry_gen_fortran.cpp @@ -251,7 +251,7 @@ void Registry::gen_fortran_module(const Module &mod, const std::string &out_dir) w << "= .false. "; break; case DataType::Tag::Character: - w << "= '' "; + // w << "= '' "; // This breaks MAP (TODO) break; case DataType::Tag::Derived: break; diff --git a/modules/openfoam/src/OpenFOAM_Types.f90 b/modules/openfoam/src/OpenFOAM_Types.f90 index adfb08e281..5c478719c2 100644 --- a/modules/openfoam/src/OpenFOAM_Types.f90 +++ b/modules/openfoam/src/OpenFOAM_Types.f90 @@ -49,14 +49,14 @@ MODULE OpenFOAM_Types END TYPE OpFM_InitInputType_C TYPE, PUBLIC :: OpFM_InitInputType TYPE( OpFM_InitInputType_C ) :: C_obj - INTEGER(IntKi) :: NumActForcePtsBlade !< number of actuator line force points in blade -- from extern (used to linearly interpolate along AD15 blades) [-] - INTEGER(IntKi) :: NumActForcePtsTower !< number of actuator line force points in tower -- from extern (used to linearly interpolate along AD15 tower) [-] + INTEGER(IntKi) :: NumActForcePtsBlade = 0_IntKi !< number of actuator line force points in blade -- from extern (used to linearly interpolate along AD15 blades) [-] + INTEGER(IntKi) :: NumActForcePtsTower = 0_IntKi !< number of actuator line force points in tower -- from extern (used to linearly interpolate along AD15 tower) [-] REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: StructBldRNodes => NULL() !< Radius to structural model analysis nodes relative to hub [-] REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: StructTwrHNodes => NULL() !< Location of tower nodes from AD15 (relative to the tower rigid base height) [-] - REAL(ReKi) :: BladeLength !< Blade length [meters] - REAL(ReKi) :: TowerHeight !< Tower Height [meters] - REAL(ReKi) :: TowerBaseHeight !< Tower Base Height [meters] - INTEGER(IntKi) :: NodeClusterType !< Node clustering (0 - Uniform, 1 - Non-uniform clustered towards tip) [-] + REAL(ReKi) :: BladeLength = 0.0_ReKi !< Blade length [meters] + REAL(ReKi) :: TowerHeight = 0.0_ReKi !< Tower Height [meters] + REAL(ReKi) :: TowerBaseHeight = 0.0_ReKi !< Tower Base Height [meters] + INTEGER(IntKi) :: NodeClusterType = 0_IntKi !< Node clustering (0 - Uniform, 1 - Non-uniform clustered towards tip) [-] END TYPE OpFM_InitInputType ! ======================= ! ========= OpFM_InitOutputType_C ======= @@ -107,19 +107,19 @@ MODULE OpenFOAM_Types END TYPE OpFM_ParameterType_C TYPE, PUBLIC :: OpFM_ParameterType TYPE( OpFM_ParameterType_C ) :: C_obj - REAL(ReKi) :: AirDens !< Air density for normalization of loads sent to OpenFOAM [kg/m^3] - INTEGER(IntKi) :: NumBl !< Number of blades [-] - INTEGER(IntKi) :: NMappings !< Number of mappings [-] - INTEGER(IntKi) :: NnodesVel !< number of velocity nodes on FAST v8-OpenFOAM interface [-] - INTEGER(IntKi) :: NnodesForce !< number of force nodes on FAST v8-OpenFOAM interface [-] - INTEGER(IntKi) :: NnodesForceBlade !< number of force nodes on FAST v8-OpenFOAM interface [-] - INTEGER(IntKi) :: NnodesForceTower !< number of force nodes on FAST v8-OpenFOAM interface [-] + REAL(ReKi) :: AirDens = 0.0_ReKi !< Air density for normalization of loads sent to OpenFOAM [kg/m^3] + INTEGER(IntKi) :: NumBl = 0_IntKi !< Number of blades [-] + INTEGER(IntKi) :: NMappings = 0_IntKi !< Number of mappings [-] + INTEGER(IntKi) :: NnodesVel = 0_IntKi !< number of velocity nodes on FAST v8-OpenFOAM interface [-] + INTEGER(IntKi) :: NnodesForce = 0_IntKi !< number of force nodes on FAST v8-OpenFOAM interface [-] + INTEGER(IntKi) :: NnodesForceBlade = 0_IntKi !< number of force nodes on FAST v8-OpenFOAM interface [-] + INTEGER(IntKi) :: NnodesForceTower = 0_IntKi !< number of force nodes on FAST v8-OpenFOAM interface [-] REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: forceBldRnodes => NULL() !< Radial location of force nodes [-] REAL(KIND=C_FLOAT) , DIMENSION(:), POINTER :: forceTwrHnodes => NULL() !< Vertical location of force nodes [-] - REAL(ReKi) :: BladeLength !< Blade length (same for all blades) [m] - REAL(ReKi) :: TowerHeight !< Tower height [m] - REAL(ReKi) :: TowerBaseHeight !< Tower base height [m] - INTEGER(IntKi) :: NodeClusterType !< Node clustering (0 - Uniform, 1 - Non-uniform clustered towards tip) [-] + REAL(ReKi) :: BladeLength = 0.0_ReKi !< Blade length (same for all blades) [m] + REAL(ReKi) :: TowerHeight = 0.0_ReKi !< Tower height [m] + REAL(ReKi) :: TowerBaseHeight = 0.0_ReKi !< Tower base height [m] + INTEGER(IntKi) :: NodeClusterType = 0_IntKi !< Node clustering (0 - Uniform, 1 - Non-uniform clustered towards tip) [-] END TYPE OpFM_ParameterType ! ======================= ! ========= OpFM_InputType_C ======= diff --git a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 index 030d1433e3..7bde5b0746 100644 --- a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 +++ b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 @@ -35,8 +35,8 @@ MODULE OrcaFlexInterface_Types IMPLICIT NONE ! ========= Orca_InitInputType ======= TYPE, PUBLIC :: Orca_InitInputType - CHARACTER(1024) :: InputFile = '' !< Name of the input file; remove if there is no file [-] - CHARACTER(1024) :: RootName = '' !< RootName for writing output files (echo file) [-] + CHARACTER(1024) :: InputFile !< Name of the input file; remove if there is no file [-] + CHARACTER(1024) :: RootName !< RootName for writing output files (echo file) [-] REAL(ReKi) :: TMax = 0.0_ReKi !< Maximum Time [seconds] END TYPE Orca_InitInputType ! ======================= @@ -49,11 +49,11 @@ MODULE OrcaFlexInterface_Types ! ======================= ! ========= Orca_InputFile ======= TYPE, PUBLIC :: Orca_InputFile - CHARACTER(1024) :: DLL_FileName = '' !< Name of the DLL file [-] - CHARACTER(1024) :: DLL_InitProcName = '' !< Name of the DLL procedure to call during initialisation [-] - CHARACTER(1024) :: DLL_CalcProcName = '' !< Name of the DLL procedure to call during CalcOutput [-] - CHARACTER(1024) :: DLL_EndProcName = '' !< Name of the DLL procedure to call during End [-] - CHARACTER(1024) :: DirRoot = '' !< Directory and rootname of simulation input file [-] + CHARACTER(1024) :: DLL_FileName !< Name of the DLL file [-] + CHARACTER(1024) :: DLL_InitProcName !< Name of the DLL procedure to call during initialisation [-] + CHARACTER(1024) :: DLL_CalcProcName !< Name of the DLL procedure to call during CalcOutput [-] + CHARACTER(1024) :: DLL_EndProcName !< Name of the DLL procedure to call during End [-] + CHARACTER(1024) :: DirRoot !< Directory and rootname of simulation input file [-] END TYPE Orca_InputFile ! ======================= ! ========= Orca_OtherStateType ======= @@ -74,7 +74,7 @@ MODULE OrcaFlexInterface_Types TYPE, PUBLIC :: Orca_ParameterType REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for continuous state integration & discrete state update [seconds] TYPE(DLL_Type) :: DLL_Orca !< Info for the OrcaFlex DLL [-] - CHARACTER(1024) :: SimNamePath = '' !< Path with simulation rootname with null end character for passing to C [-] + CHARACTER(1024) :: SimNamePath !< Path with simulation rootname with null end character for passing to C [-] INTEGER(IntKi) :: SimNamePathLen = 0_IntKi !< Length of SimNamePath (including null char) [-] INTEGER(IntKi) :: NumOuts = 0 !< Number of parameters in the output list (number of outputs requested) [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] diff --git a/modules/seastate/src/Current_Types.f90 b/modules/seastate/src/Current_Types.f90 index e57202ef0d..f33e649352 100644 --- a/modules/seastate/src/Current_Types.f90 +++ b/modules/seastate/src/Current_Types.f90 @@ -36,7 +36,7 @@ MODULE Current_Types ! ========= Current_InitInputType ======= TYPE, PUBLIC :: Current_InitInputType REAL(SiKi) :: CurrSSV0 = 0.0_R4Ki !< [-] - CHARACTER(80) :: CurrSSDirChr = '' !< [-] + CHARACTER(80) :: CurrSSDirChr !< [-] REAL(SiKi) :: CurrSSDir = 0.0_R4Ki !< [-] REAL(SiKi) :: CurrNSRef = 0.0_R4Ki !< [-] REAL(SiKi) :: CurrNSV0 = 0.0_R4Ki !< [-] @@ -47,7 +47,7 @@ MODULE Current_Types REAL(SiKi) :: WtrDpth = 0.0_R4Ki !< [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinGridzi !< [-] INTEGER(IntKi) :: NGridPts = 0_IntKi !< [-] - CHARACTER(1024) :: DirRoot = '' !< [-] + CHARACTER(1024) :: DirRoot !< [-] END TYPE Current_InitInputType ! ======================= ! ========= Current_InitOutputType ======= diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index d07eb1710b..4bbcd889d9 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -64,16 +64,16 @@ MODULE SeaState_Types INTEGER(IntKi) :: NumOuts = 0_IntKi !< The number of outputs for this module as requested in the input file [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< The user-requested output channel labels for this modules. This should really be dimensioned with MaxOutPts [-] LOGICAL :: SeaStSum = .false. !< Generate a SeaState summary file [T/F] [-] - CHARACTER(20) :: OutFmt = '' !< Output format for numerical results [-] - CHARACTER(20) :: OutSFmt = '' !< Output format for header strings [-] + CHARACTER(20) :: OutFmt !< Output format for numerical results [-] + CHARACTER(20) :: OutSFmt !< Output format for header strings [-] END TYPE SeaSt_InputFile ! ======================= ! ========= SeaSt_InitInputType ======= TYPE, PUBLIC :: SeaSt_InitInputType - CHARACTER(1024) :: InputFile = '' !< Supplied by Driver: full path and filename for the SeaState module [-] + CHARACTER(1024) :: InputFile !< Supplied by Driver: full path and filename for the SeaState module [-] LOGICAL :: UseInputFile = .TRUE. !< Supplied by Driver: .TRUE. if using a input file, .FALSE. if all inputs are being passed in by the caller [-] TYPE(FileInfoType) :: PassedFileData !< If we don't use the input file, pass everything through this [-] - CHARACTER(1024) :: OutRootName = '' !< Supplied by Driver: The name of the root file (without extension) including the full path [-] + CHARACTER(1024) :: OutRootName !< Supplied by Driver: The name of the root file (without extension) including the full path [-] REAL(ReKi) :: Gravity = 0.0_ReKi !< Supplied by Driver: Gravitational acceleration [(m/s^2)] REAL(ReKi) :: defWtrDens = 0.0_ReKi !< Default water density from the driver; may be overwritten [(kg/m^3)] REAL(ReKi) :: defWtrDpth = 0.0_ReKi !< Default water depth from the driver; may be overwritten [m] @@ -200,9 +200,9 @@ MODULE SeaState_Types TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< [-] INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of SeaState module-level outputs (not the total number including sub-modules [-] INTEGER(IntKi) :: OutSwtch = 0_IntKi !< Output requested channels to: [1=SeaState.out 2=GlueCode.out 3=both files] [-] - CHARACTER(20) :: OutFmt = '' !< Output format for numerical results [-] - CHARACTER(20) :: OutSFmt = '' !< Output format for header strings [-] - CHARACTER(1) :: Delim = '' !< Delimiter string for outputs, defaults to space [-] + CHARACTER(20) :: OutFmt !< Output format for numerical results [-] + CHARACTER(20) :: OutSFmt !< Output format for header strings [-] + CHARACTER(1) :: Delim !< Delimiter string for outputs, defaults to space [-] INTEGER(IntKi) :: UnOutFile = 0_IntKi !< File unit for the SeaState outputs [-] INTEGER(IntKi) :: OutDec = 0_IntKi !< Write every OutDec time steps [-] TYPE(SeaSt_Interp_ParameterType) :: SeaSt_Interp_p !< parameter information from the SeaState Interpolation module [-] diff --git a/modules/seastate/src/Waves_Types.f90 b/modules/seastate/src/Waves_Types.f90 index 57123bced3..ba7d81ef96 100644 --- a/modules/seastate/src/Waves_Types.f90 +++ b/modules/seastate/src/Waves_Types.f90 @@ -35,9 +35,9 @@ MODULE Waves_Types IMPLICIT NONE ! ========= Waves_InitInputType ======= TYPE, PUBLIC :: Waves_InitInputType - CHARACTER(1024) :: InputFile = '' !< Name of the input file [-] - CHARACTER(1024) :: DirRoot = '' !< The name of the root file including the full path. This may be useful if you want this routine to write a permanent record of what it does to be stored with the simulation results: the results should be stored in a file whose name (including path) is generated by appending any suitable extension to DirRoot. [-] - CHARACTER(1024) :: WvKinFile = '' !< The root name of user input wave kinematics files [-] + CHARACTER(1024) :: InputFile !< Name of the input file [-] + CHARACTER(1024) :: DirRoot !< The name of the root file including the full path. This may be useful if you want this routine to write a permanent record of what it does to be stored with the simulation results: the results should be stored in a file whose name (including path) is generated by appending any suitable extension to DirRoot. [-] + CHARACTER(1024) :: WvKinFile !< The root name of user input wave kinematics files [-] REAL(ReKi) :: Gravity = 0.0_ReKi !< Gravitational acceleration [(m/s^2)] INTEGER(IntKi) , DIMENSION(1:3) :: nGrid = 0_IntKi !< Grid dimensions [-] REAL(SiKi) :: WvLowCOff = 0.0_R4Ki !< Low cut-off frequency or lower frequency limit of the wave spectrum beyond which the wave spectrum is zeroed. [used only when WaveMod=2,3,4] [(rad/s)] @@ -51,11 +51,11 @@ MODULE Waves_Types REAL(DbKi) :: WaveDT = 0.0_R8Ki !< Time step for incident wave calculations [(sec)] REAL(SiKi) :: WaveHs = 0.0_R4Ki !< Significant wave height of incident waves [(meters)] INTEGER(IntKi) :: WaveMod = 0_IntKi !< Incident wave kinematics model {0: none=still water, 1: plane progressive (regular), 2: JONSWAP/Pierson-Moskowitz spectrum (irregular), 3: white-noise spectrum, 4: user-defind spectrum from routine UserWaveSpctrm (irregular), 5: GH BLADED } [-] - CHARACTER(80) :: WaveModChr = '' !< String to temporarially hold the value of the wave kinematics input line [-] + CHARACTER(80) :: WaveModChr !< String to temporarially hold the value of the wave kinematics input line [-] LOGICAL :: WaveNDAmp = .false. !< Flag for normally-distributed amplitudes in incident waves spectrum [flag] [-] REAL(SiKi) :: WavePhase = 0.0_R4Ki !< Specified phase for regular waves [(radians)] REAL(SiKi) :: WavePkShp = 0.0_R4Ki !< Peak shape parameter of incident wave spectrum [1.0 for Pierson-Moskowitz] [-] - CHARACTER(80) :: WavePkShpChr = '' !< String to temporarially hold value of peak shape parameter input line [-] + CHARACTER(80) :: WavePkShpChr !< String to temporarially hold value of peak shape parameter input line [-] INTEGER(IntKi) , DIMENSION(1:2) :: WaveSeed = 0_IntKi !< Random seeds of incident waves [-2147483648 to 2147483647] [-] INTEGER(IntKi) :: WaveStMod = 0_IntKi !< Model for stretching incident wave kinematics to instantaneous free surface {0: none=no stretching, 1: vertical stretching, 2: extrapolation stretching, 3: Wheeler stretching} [-] REAL(DbKi) :: WaveTMax = 0.0_R8Ki !< Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT [(sec)] diff --git a/modules/servodyn/src/ServoDyn_Types.f90 b/modules/servodyn/src/ServoDyn_Types.f90 index eda511649c..685d0f5e00 100644 --- a/modules/servodyn/src/ServoDyn_Types.f90 +++ b/modules/servodyn/src/ServoDyn_Types.f90 @@ -36,10 +36,10 @@ MODULE ServoDyn_Types IMPLICIT NONE ! ========= SrvD_InitInputType ======= TYPE, PUBLIC :: SrvD_InitInputType - CHARACTER(1024) :: InputFile = '' !< Name of the input file [-] + CHARACTER(1024) :: InputFile !< Name of the input file [-] LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] INTEGER(IntKi) :: NumBl = 0_IntKi !< Number of blades on the turbine [-] - CHARACTER(1024) :: RootName = '' !< RootName for writing output files [-] + CHARACTER(1024) :: RootName !< RootName for writing output files [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlPitchInit !< Initial blade pitch [-] REAL(ReKi) , DIMENSION(1:3) :: Gravity = 0.0_ReKi !< Gravitational acceleration vector [m/s^2] REAL(ReKi) , DIMENSION(1:3) :: NacRefPos = 0.0_ReKi !< nacelle origin for setting up mesh [m] @@ -150,13 +150,13 @@ MODULE ServoDyn_Types LOGICAL :: SumPrint = .false. !< Print summary data to .sum [-] INTEGER(IntKi) :: OutFile = 0_IntKi !< Switch to determine where output will be placed: (1: in module output file only; 2: in glue code output file only; 3: both) [-] LOGICAL :: TabDelim = .false. !< Use tab delimiters in text tabular output file? [-] - CHARACTER(20) :: OutFmt = '' !< Format used for text tabular output (except time) [-] + CHARACTER(20) :: OutFmt !< Format used for text tabular output (except time) [-] REAL(DbKi) :: Tstart = 0.0_R8Ki !< Time to start module's tabular output [s] INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< List of user-requested output channels [-] - CHARACTER(1024) :: DLL_FileName = '' !< Name of the DLL file including the full path [-] - CHARACTER(1024) :: DLL_ProcName = '' !< Name of the procedure in the DLL that will be called [-] - CHARACTER(1024) :: DLL_InFile = '' !< Name of input file used in DLL [-] + CHARACTER(1024) :: DLL_FileName !< Name of the DLL file including the full path [-] + CHARACTER(1024) :: DLL_ProcName !< Name of the procedure in the DLL that will be called [-] + CHARACTER(1024) :: DLL_InFile !< Name of input file used in DLL [-] REAL(DbKi) :: DLL_DT = 0.0_R8Ki !< interval for calling DLL (must be integer multiple number of DT steps) [s] LOGICAL :: DLL_Ramp = .false. !< whether the DLL pitch should be a ramp (true) or step change (false) when DLL_DT <> DT. If true, introduces a time delay. [-] REAL(ReKi) :: BPCutoff = 0.0_ReKi !< The cutoff frequency for the blade pitch low-pass filter. Large values => no filter. [Hz] @@ -212,7 +212,7 @@ MODULE ServoDyn_Types TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: LogChannels_OutParam !< Names and units (and other characteristics) of logging outputs from DLL [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: LogChannels !< logging outputs from controller [-] INTEGER(IntKi) :: ErrStat = 0_IntKi !< error message from external controller API [-] - CHARACTER(ErrMsgLen) :: ErrMsg = '' !< error message from external controller API [-] + CHARACTER(ErrMsgLen) :: ErrMsg !< error message from external controller API [-] REAL(R8Ki) :: CurrentTime = 0.0_R8Ki !< Current Simulation Time [s] INTEGER(IntKi) :: SimStatus = 0_IntKi !< simulation status (see avrSWAP(1): Status flag set as follows: 0 if this is the first call, 1 for all subsequent time steps, -1 if this is the final call at the end of the simulation) [-] INTEGER(IntKi) :: ShaftBrakeStatusBinaryFlag = 0_IntKi !< binary flag indicating (on/off) status for shaft brake 1, shaft brake 2, generator brake, shaft brake 3, or brake torque set separately (0, 1, or 16 allowed in FAST) [-] @@ -258,8 +258,8 @@ MODULE ServoDyn_Types INTEGER(IntKi) :: PulseSpacing = 0_IntKi !< Distance between range gates [-] INTEGER(IntKi) :: URefLid = 0_IntKi !< Reference average wind speed for the lidar [m/s] REAL(DbKi) :: DLL_DT = 0.0_R8Ki !< interval for calling DLL (integer multiple number of DT) [s] - CHARACTER(1024) :: DLL_InFile = '' !< Name of input file used in DLL [-] - CHARACTER(1024) :: RootName = '' !< RootName for writing output files [-] + CHARACTER(1024) :: DLL_InFile !< Name of input file used in DLL [-] + CHARACTER(1024) :: RootName !< RootName for writing output files [-] REAL(ReKi) :: GenTrq_Dem = 0.0_ReKi !< Demanded generator torque above rated [Nm] REAL(ReKi) :: GenSpd_Dem = 0.0_ReKi !< Demanded generator speed above rated [rad/s] REAL(ReKi) :: Ptch_Max = 0.0_ReKi !< Maximum pitch angle [rad] @@ -449,9 +449,9 @@ MODULE ServoDyn_Types INTEGER(IntKi) :: StCCmode = 0_IntKi !< Structural control control mode {0: none, 4: user-defined from Simulink/Labview, 5: user-defined from Bladed-style DLL} [-] INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] INTEGER(IntKi) :: NumOuts_DLL = 0_IntKi !< Number of logging channels output from the DLL (set at initialization) [-] - CHARACTER(1024) :: RootName = '' !< RootName for writing output files [-] + CHARACTER(1024) :: RootName !< RootName for writing output files [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] - CHARACTER(1) :: Delim = '' !< Column delimiter for output text files [-] + CHARACTER(1) :: Delim !< Column delimiter for output text files [-] LOGICAL :: UseBladedInterface = .false. !< Flag that determines if BladedInterface was used [-] LOGICAL :: UseLegacyInterface = .false. !< Flag that determines if the legacy Bladed interface is (legacy=DISCON with avrSWAP instead of CONTROLLER) [-] TYPE(DLL_Type) :: DLL_Trgt !< The addresses and names of the Bladed DLL and its procedure [-] diff --git a/modules/servodyn/src/StrucCtrl_Types.f90 b/modules/servodyn/src/StrucCtrl_Types.f90 index 6746bc6904..cd1d45f6dd 100644 --- a/modules/servodyn/src/StrucCtrl_Types.f90 +++ b/modules/servodyn/src/StrucCtrl_Types.f90 @@ -35,7 +35,7 @@ MODULE StrucCtrl_Types IMPLICIT NONE ! ========= StC_InputFile ======= TYPE, PUBLIC :: StC_InputFile - CHARACTER(1024) :: StCFileName = '' !< Name of the input file; remove if there is no file [-] + CHARACTER(1024) :: StCFileName !< Name of the input file; remove if there is no file [-] LOGICAL :: Echo = .false. !< Echo input file to echo file [-] INTEGER(IntKi) :: StC_CMODE = 0_IntKi !< control mode {0:none; 1: Semi-Active Control Mode; 2: Active Control Mode;} [-] INTEGER(IntKi) :: StC_SA_MODE = 0_IntKi !< Semi-Active control mode {1: velocity-based ground hook control; 2: Inverse velocity-based ground hook control; 3: displacement-based ground hook control 4: Phase difference Algorithm with Friction Force 5: Phase difference Algorithm with Damping Force} [-] @@ -46,7 +46,7 @@ MODULE StrucCtrl_Types REAL(ReKi) :: StC_X_DSP = 0.0_ReKi !< StC_X initial displacement [m] REAL(ReKi) :: StC_Y_DSP = 0.0_ReKi !< StC_Y initial displacement [m] REAL(ReKi) :: StC_Z_DSP = 0.0_ReKi !< StC_Z initial displacement [m] - Character(10) :: StC_Z_PreLdC = '' !< StC_Z spring preload [N] + Character(10) :: StC_Z_PreLdC !< StC_Z spring preload [N] REAL(ReKi) :: StC_X_M = 0.0_ReKi !< StC X mass [kg] REAL(ReKi) :: StC_Y_M = 0.0_ReKi !< StC Y mass [kg] REAL(ReKi) :: StC_Z_M = 0.0_ReKi !< StC Z mass [kg] @@ -95,18 +95,18 @@ MODULE StrucCtrl_Types REAL(ReKi) :: rho_Y = 0.0_ReKi !< Side-Side TLCD liquid density [kg/m^3] LOGICAL :: USE_F_TBL = .false. !< use spring force from user-defined table (flag) [-] INTEGER(IntKi) :: NKInpSt = 0_IntKi !< Number of input spring force rows in table [-] - CHARACTER(1024) :: StC_F_TBL_FILE = '' !< user-defined spring table filename [-] + CHARACTER(1024) :: StC_F_TBL_FILE !< user-defined spring table filename [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: F_TBL !< user-defined spring force [N] INTEGER(IntKi) :: PrescribedForcesCoordSys = 0_IntKi !< Prescribed forces coordinate system {0: global; 1: local} [-] - CHARACTER(1024) :: PrescribedForcesFile = '' !< Prescribed force time-series filename [-] + CHARACTER(1024) :: PrescribedForcesFile !< Prescribed force time-series filename [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: StC_PrescribedForce !< StC prescribed force time-series info [(s,N,N-m)] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: StC_CChan !< StC control chan to use -- one per instance [-] END TYPE StC_InputFile ! ======================= ! ========= StC_InitInputType ======= TYPE, PUBLIC :: StC_InitInputType - CHARACTER(1024) :: InputFile = '' !< Name of the input file; remove if there is no file [-] - CHARACTER(1024) :: RootName = '' !< RootName for writing output files [-] + CHARACTER(1024) :: InputFile !< Name of the input file; remove if there is no file [-] + CHARACTER(1024) :: RootName !< RootName for writing output files [-] REAL(ReKi) , DIMENSION(1:3) :: Gravity = 0.0_ReKi !< Gravitational acceleration vector [m/s^2] INTEGER(IntKi) :: NumMeshPts = 0_IntKi !< Number of mesh points [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: InitRefPos !< X-Y-Z reference position of point: i.e. each blade root (3 x NumBlades) [m] @@ -180,7 +180,7 @@ MODULE StrucCtrl_Types ! ========= StC_ParameterType ======= TYPE, PUBLIC :: StC_ParameterType REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for cont. state integration & disc. state update [seconds] - CHARACTER(1024) :: RootName = '' !< RootName for writing output files [-] + CHARACTER(1024) :: RootName !< RootName for writing output files [-] INTEGER(IntKi) :: StC_DOF_MODE = 0_IntKi !< DOF mode {0: NO StC_DOF; 1: StC_X_DOF and StC_Y_DOF; 2: StC_XY_DOF; 3: TLCD; 4: Prescribed force/moment time series} [-] LOGICAL :: StC_X_DOF = .false. !< DOF on or off [-] LOGICAL :: StC_Y_DOF = .false. !< DOF on or off [-] diff --git a/modules/subdyn/src/SubDyn_Types.f90 b/modules/subdyn/src/SubDyn_Types.f90 index f7ac914585..c23158f118 100644 --- a/modules/subdyn/src/SubDyn_Types.f90 +++ b/modules/subdyn/src/SubDyn_Types.f90 @@ -82,8 +82,8 @@ MODULE SubDyn_Types ! ======================= ! ========= SD_InitInputType ======= TYPE, PUBLIC :: SD_InitInputType - CHARACTER(1024) :: SDInputFile = '' !< Name of the input file [-] - CHARACTER(1024) :: RootName = '' !< SubDyn rootname [-] + CHARACTER(1024) :: SDInputFile !< Name of the input file [-] + CHARACTER(1024) :: RootName !< SubDyn rootname [-] REAL(ReKi) :: g = 0.0_ReKi !< Gravity acceleration [-] REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water Depth (positive valued) [-] REAL(ReKi) , DIMENSION(1:3) :: TP_RefPoint = 0.0_ReKi !< global position of transition piece reference point (could also be defined in SubDyn itself) [-] @@ -111,7 +111,7 @@ MODULE SubDyn_Types ! ======================= ! ========= SD_InitType ======= TYPE, PUBLIC :: SD_InitType - CHARACTER(1024) :: RootName = '' !< SubDyn rootname [-] + CHARACTER(1024) :: RootName !< SubDyn rootname [-] REAL(ReKi) , DIMENSION(1:3) :: TP_RefPoint = 0.0_ReKi !< global position of transition piece reference point (could also be defined in SubDyn itself) [-] REAL(ReKi) :: SubRotateZ = 0.0_ReKi !< Rotation angle in degrees about global Z [-] REAL(ReKi) :: g = 0.0_ReKi !< Gravity acceleration [-] @@ -304,9 +304,9 @@ MODULE SubDyn_Types INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of output channels read from input file [-] INTEGER(IntKi) :: OutSwtch = 0_IntKi !< Output Requested Channels to local or global output file [1/2/3] [-] INTEGER(IntKi) :: UnJckF = 0_IntKi !< Unit of SD ouput file [-] - CHARACTER(1) :: Delim = '' !< Column delimiter for output text files [-] - CHARACTER(20) :: OutFmt = '' !< Format for Output [-] - CHARACTER(20) :: OutSFmt = '' !< Format for Output Headers [-] + CHARACTER(1) :: Delim !< Column delimiter for output text files [-] + CHARACTER(20) :: OutFmt !< Format for Output [-] + CHARACTER(20) :: OutSFmt !< Format for Output Headers [-] TYPE(MeshAuxDataType) , DIMENSION(:), ALLOCATABLE :: MoutLst !< List of user requested members and nodes [-] TYPE(MeshAuxDataType) , DIMENSION(:), ALLOCATABLE :: MoutLst2 !< List of all member joint nodes and elements for output [-] TYPE(MeshAuxDataType) , DIMENSION(:), ALLOCATABLE :: MoutLst3 !< List of all member joint nodes and elements for output [-] diff --git a/modules/supercontroller/src/SuperController_Types.f90 b/modules/supercontroller/src/SuperController_Types.f90 index 39dd8d6a2a..943af4a86b 100644 --- a/modules/supercontroller/src/SuperController_Types.f90 +++ b/modules/supercontroller/src/SuperController_Types.f90 @@ -42,7 +42,7 @@ MODULE SuperController_Types TYPE, PUBLIC :: SC_InitInputType TYPE( SC_InitInputType_C ) :: C_obj INTEGER(IntKi) :: nTurbines = 0_IntKi !< Number of turbines in the simulation [-] - CHARACTER(1024) :: DLL_FileName = '' !< Name of the shared library which the super controller logic [-] + CHARACTER(1024) :: DLL_FileName !< Name of the shared library which the super controller logic [-] END TYPE SC_InitInputType ! ======================= ! ========= SC_InitOutputType_C ======= diff --git a/modules/wakedynamics/src/WakeDynamics_Types.f90 b/modules/wakedynamics/src/WakeDynamics_Types.f90 index 615e826f91..61bfb7e301 100644 --- a/modules/wakedynamics/src/WakeDynamics_Types.f90 +++ b/modules/wakedynamics/src/WakeDynamics_Types.f90 @@ -80,7 +80,7 @@ MODULE WakeDynamics_Types TYPE, PUBLIC :: WD_InitInputType TYPE(WD_InputFileType) :: InputFileData !< FAST.Farm input-file data for wake dynamics [-] INTEGER(IntKi) :: TurbNum = 0 !< Turbine ID number (start with 1; end with number of turbines) [-] - CHARACTER(1024) :: OutFileRoot = '' !< The root name derived from the primary FAST.Farm input file [-] + CHARACTER(1024) :: OutFileRoot !< The root name derived from the primary FAST.Farm input file [-] END TYPE WD_InitInputType ! ======================= ! ========= WD_InitOutputType ======= @@ -190,8 +190,8 @@ MODULE WakeDynamics_Types INTEGER(IntKi) :: FilterInit = 0_IntKi !< Switch to filter the initial wake plane deficit and select the number of grid points for the filter {0: no filter, 1: filter of size 1} or DEFAULT [DEFAULT=0: if Mod_Wake is 1 or 3, or DEFAULT=2: if Mod_Wwake is 2] (switch) [-] REAL(ReKi) :: k_vCurl = 0.0_ReKi !< Calibrated parameter for the eddy viscosity in curled-wake model [>=0.0] [-] LOGICAL :: OutAllPlanes = .false. !< Output all planes [-] - CHARACTER(1024) :: OutFileRoot = '' !< The root name derived from the primary FAST.Farm input file [-] - CHARACTER(1024) :: OutFileVTKDir = '' !< The parent directory for all VTK files written by WD [-] + CHARACTER(1024) :: OutFileRoot !< The root name derived from the primary FAST.Farm input file [-] + CHARACTER(1024) :: OutFileVTKDir !< The parent directory for all VTK files written by WD [-] INTEGER(IntKi) :: TurbNum = 0 !< Turbine ID number (start with 1; end with number of turbines) [-] LOGICAL :: WAT = .false. !< Switch for turning on and off wake-added turbulence [-] REAL(ReKi) :: WAT_k_Def = 0.0_ReKi !< Calibrated parameter for the influence of the wake deficit in the wake-added Turbulence (-) [>=0.0] or DEFAULT [DEFAULT=0.6] [-] From b0f90a73a715bbb00376fcde6b114858ce50d581 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Sat, 17 Jun 2023 13:12:05 +0000 Subject: [PATCH 14/15] Use Lagrange polynomials to simplify extrap/interp This commit changes the extrap/interp routines used by the Registry and Mesh to use Lagrange polynomials. This formulation allows for scalar coefficients to be calculated and then multiplied by the values/arrays to be interpolation. This should significantly reduce the number of operations used by these routines. --- modules/aerodyn/src/AeroDyn_Types.f90 | 938 +++--- modules/aerodyn/src/AirfoilInfo_Types.f90 | 835 +++--- modules/aerodyn/src/BEMT_Types.f90 | 1222 +++----- modules/aerodyn/src/DBEMT_Types.f90 | 876 +++--- modules/aerodyn/src/FVW_Types.f90 | 698 +++-- modules/aerodyn/src/UnsteadyAero_Types.f90 | 583 ++-- modules/aerodyn14/src/AeroDyn14_Types.f90 | 1058 +++---- modules/aerodyn14/src/DWM_Types.f90 | 1001 +++---- modules/beamdyn/src/BeamDyn_Types.f90 | 553 ++-- modules/elastodyn/src/ElastoDyn_Types.f90 | 979 +++---- modules/extptfm/src/ExtPtfm_MCKF_Types.f90 | 513 ++-- modules/feamooring/src/FEAMooring_Types.f90 | 529 ++-- modules/hydrodyn/src/Conv_Radiation_Types.f90 | 524 ++-- modules/hydrodyn/src/HydroDyn_Types.f90 | 585 ++-- modules/hydrodyn/src/Morison_Types.f90 | 507 ++-- modules/hydrodyn/src/SS_Excitation_Types.f90 | 555 ++-- modules/hydrodyn/src/SS_Radiation_Types.f90 | 543 ++-- modules/hydrodyn/src/WAMIT2_Types.f90 | 240 +- modules/hydrodyn/src/WAMIT_Types.f90 | 480 ++-- modules/icedyn/src/IceDyn_Types.f90 | 513 ++-- modules/icefloe/src/icefloe/IceFloe_Types.f90 | 513 ++-- modules/inflowwind/src/InflowWind_Types.f90 | 654 ++--- modules/inflowwind/src/Lidar_Types.f90 | 608 ++-- modules/map/src/MAP_Types.f90 | 2514 ++++++++--------- modules/moordyn/src/MoorDyn_Types.f90 | 585 ++-- modules/nwtc-library/src/ModMesh.f90 | 81 +- .../src/registry_gen_fortran.cpp | 656 ++--- modules/openfoam/src/OpenFOAM_Types.f90 | 2359 ++++++++-------- .../src/OrcaFlexInterface_Types.f90 | 513 ++-- modules/servodyn/src/ServoDyn_Types.f90 | 1354 ++++----- modules/servodyn/src/StrucCtrl_Types.f90 | 688 ++--- modules/subdyn/src/SubDyn_Types.f90 | 558 ++-- .../supercontroller/src/SCDataEx_Types.f90 | 472 ++-- .../src/SuperController_Types.f90 | 1644 ++++++----- 34 files changed, 12439 insertions(+), 14492 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index ed9f8838aa..3a13bbff99 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -7163,58 +7163,59 @@ subroutine AD_UnPackOutput(Buf, OutData) end if end subroutine - SUBROUTINE AD_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(AD_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(AD_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None +subroutine AD_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time + ! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(AD_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(AD_InputType), intent(inout) :: u_out ! Input at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Input_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(u)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(u) - 1 - IF ( order .eq. 0 ) THEN - CALL AD_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL AD_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL AD_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE AD_Input_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'AD_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call AD_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call AD_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call AD_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE AD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE AD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 1. @@ -7226,137 +7227,107 @@ SUBROUTINE AD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! !.................................................................................................................................. - TYPE(AD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(AD_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(AD_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(AD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(AD_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(AD_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Input_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - INTEGER :: i3 ! dim3 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF - - ScaleFactor = t_out / t(2) -IF (ALLOCATED(u_out%rotors) .AND. ALLOCATED(u1%rotors)) THEN - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - CALL MeshExtrapInterp1(u1%rotors(i01)%NacelleMotion, u2%rotors(i01)%NacelleMotion, tin, u_out%rotors(i01)%NacelleMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - CALL MeshExtrapInterp1(u1%rotors(i01)%TowerMotion, u2%rotors(i01)%TowerMotion, tin, u_out%rotors(i01)%TowerMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - CALL MeshExtrapInterp1(u1%rotors(i01)%HubMotion, u2%rotors(i01)%HubMotion, tin, u_out%rotors(i01)%HubMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) -IF (ALLOCATED(u_out%rotors(i01)%BladeRootMotion) .AND. ALLOCATED(u1%rotors(i01)%BladeRootMotion)) THEN - DO i1 = LBOUND(u_out%rotors(i01)%BladeRootMotion,1),UBOUND(u_out%rotors(i01)%BladeRootMotion,1) - CALL MeshExtrapInterp1(u1%rotors(i01)%BladeRootMotion(i1), u2%rotors(i01)%BladeRootMotion(i1), tin, u_out%rotors(i01)%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) -IF (ALLOCATED(u_out%rotors(i01)%BladeMotion) .AND. ALLOCATED(u1%rotors(i01)%BladeMotion)) THEN - DO i1 = LBOUND(u_out%rotors(i01)%BladeMotion,1),UBOUND(u_out%rotors(i01)%BladeMotion,1) - CALL MeshExtrapInterp1(u1%rotors(i01)%BladeMotion(i1), u2%rotors(i01)%BladeMotion(i1), tin, u_out%rotors(i01)%BladeMotion(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - CALL MeshExtrapInterp1(u1%rotors(i01)%TFinMotion, u2%rotors(i01)%TFinMotion, tin, u_out%rotors(i01)%TFinMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) -IF (ALLOCATED(u_out%rotors(i01)%InflowOnBlade) .AND. ALLOCATED(u1%rotors(i01)%InflowOnBlade)) THEN - DO i3 = LBOUND(u_out%rotors(i01)%InflowOnBlade,3),UBOUND(u_out%rotors(i01)%InflowOnBlade,3) - DO i2 = LBOUND(u_out%rotors(i01)%InflowOnBlade,2),UBOUND(u_out%rotors(i01)%InflowOnBlade,2) - DO i1 = LBOUND(u_out%rotors(i01)%InflowOnBlade,1),UBOUND(u_out%rotors(i01)%InflowOnBlade,1) - b = -(u1%rotors(i01)%InflowOnBlade(i1,i2,i3) - u2%rotors(i01)%InflowOnBlade(i1,i2,i3)) - u_out%rotors(i01)%InflowOnBlade(i1,i2,i3) = u1%rotors(i01)%InflowOnBlade(i1,i2,i3) + b * ScaleFactor + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(u_out%rotors) .AND. ALLOCATED(u1%rotors)) THEN + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + CALL MeshExtrapInterp1(u1%rotors(i01)%NacelleMotion, u2%rotors(i01)%NacelleMotion, tin, u_out%rotors(i01)%NacelleMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - END DO - END DO -END IF ! check if allocated - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) -IF (ALLOCATED(u_out%rotors(i01)%InflowOnTower) .AND. ALLOCATED(u1%rotors(i01)%InflowOnTower)) THEN - DO i2 = LBOUND(u_out%rotors(i01)%InflowOnTower,2),UBOUND(u_out%rotors(i01)%InflowOnTower,2) - DO i1 = LBOUND(u_out%rotors(i01)%InflowOnTower,1),UBOUND(u_out%rotors(i01)%InflowOnTower,1) - b = -(u1%rotors(i01)%InflowOnTower(i1,i2) - u2%rotors(i01)%InflowOnTower(i1,i2)) - u_out%rotors(i01)%InflowOnTower(i1,i2) = u1%rotors(i01)%InflowOnTower(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - DO i1 = LBOUND(u_out%rotors(i01)%InflowOnHub,1),UBOUND(u_out%rotors(i01)%InflowOnHub,1) - b = -(u1%rotors(i01)%InflowOnHub(i1) - u2%rotors(i01)%InflowOnHub(i1)) - u_out%rotors(i01)%InflowOnHub(i1) = u1%rotors(i01)%InflowOnHub(i1) + b * ScaleFactor - END DO - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - DO i1 = LBOUND(u_out%rotors(i01)%InflowOnNacelle,1),UBOUND(u_out%rotors(i01)%InflowOnNacelle,1) - b = -(u1%rotors(i01)%InflowOnNacelle(i1) - u2%rotors(i01)%InflowOnNacelle(i1)) - u_out%rotors(i01)%InflowOnNacelle(i1) = u1%rotors(i01)%InflowOnNacelle(i1) + b * ScaleFactor - END DO - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - DO i1 = LBOUND(u_out%rotors(i01)%InflowOnTailFin,1),UBOUND(u_out%rotors(i01)%InflowOnTailFin,1) - b = -(u1%rotors(i01)%InflowOnTailFin(i1) - u2%rotors(i01)%InflowOnTailFin(i1)) - u_out%rotors(i01)%InflowOnTailFin(i1) = u1%rotors(i01)%InflowOnTailFin(i1) + b * ScaleFactor - END DO - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) -IF (ALLOCATED(u_out%rotors(i01)%UserProp) .AND. ALLOCATED(u1%rotors(i01)%UserProp)) THEN - DO i2 = LBOUND(u_out%rotors(i01)%UserProp,2),UBOUND(u_out%rotors(i01)%UserProp,2) - DO i1 = LBOUND(u_out%rotors(i01)%UserProp,1),UBOUND(u_out%rotors(i01)%UserProp,1) - b = -(u1%rotors(i01)%UserProp(i1,i2) - u2%rotors(i01)%UserProp(i1,i2)) - u_out%rotors(i01)%UserProp(i1,i2) = u1%rotors(i01)%UserProp(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%InflowWakeVel) .AND. ALLOCATED(u1%InflowWakeVel)) THEN - DO i2 = LBOUND(u_out%InflowWakeVel,2),UBOUND(u_out%InflowWakeVel,2) - DO i1 = LBOUND(u_out%InflowWakeVel,1),UBOUND(u_out%InflowWakeVel,1) - b = -(u1%InflowWakeVel(i1,i2) - u2%InflowWakeVel(i1,i2)) - u_out%InflowWakeVel(i1,i2) = u1%InflowWakeVel(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated - END SUBROUTINE AD_Input_ExtrapInterp1 - + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + CALL MeshExtrapInterp1(u1%rotors(i01)%TowerMotion, u2%rotors(i01)%TowerMotion, tin, u_out%rotors(i01)%TowerMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + CALL MeshExtrapInterp1(u1%rotors(i01)%HubMotion, u2%rotors(i01)%HubMotion, tin, u_out%rotors(i01)%HubMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + IF (ALLOCATED(u_out%rotors(i01)%BladeRootMotion) .AND. ALLOCATED(u1%rotors(i01)%BladeRootMotion)) THEN + DO i1 = LBOUND(u_out%rotors(i01)%BladeRootMotion,1),UBOUND(u_out%rotors(i01)%BladeRootMotion,1) + CALL MeshExtrapInterp1(u1%rotors(i01)%BladeRootMotion(i1), u2%rotors(i01)%BladeRootMotion(i1), tin, u_out%rotors(i01)%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + END DO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + IF (ALLOCATED(u_out%rotors(i01)%BladeMotion) .AND. ALLOCATED(u1%rotors(i01)%BladeMotion)) THEN + DO i1 = LBOUND(u_out%rotors(i01)%BladeMotion,1),UBOUND(u_out%rotors(i01)%BladeMotion,1) + CALL MeshExtrapInterp1(u1%rotors(i01)%BladeMotion(i1), u2%rotors(i01)%BladeMotion(i1), tin, u_out%rotors(i01)%BladeMotion(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + END DO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + CALL MeshExtrapInterp1(u1%rotors(i01)%TFinMotion, u2%rotors(i01)%TFinMotion, tin, u_out%rotors(i01)%TFinMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + IF (ALLOCATED(u_out%rotors(i01)%InflowOnBlade) .AND. ALLOCATED(u1%rotors(i01)%InflowOnBlade)) THEN + u_out%rotors(i01)%InflowOnBlade = a1*u1%rotors(i01)%InflowOnBlade + a2*u2%rotors(i01)%InflowOnBlade + END IF ! check if allocated + END DO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + IF (ALLOCATED(u_out%rotors(i01)%InflowOnTower) .AND. ALLOCATED(u1%rotors(i01)%InflowOnTower)) THEN + u_out%rotors(i01)%InflowOnTower = a1*u1%rotors(i01)%InflowOnTower + a2*u2%rotors(i01)%InflowOnTower + END IF ! check if allocated + END DO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + u_out%rotors(i01)%InflowOnHub = a1*u1%rotors(i01)%InflowOnHub + a2*u2%rotors(i01)%InflowOnHub + END DO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + u_out%rotors(i01)%InflowOnNacelle = a1*u1%rotors(i01)%InflowOnNacelle + a2*u2%rotors(i01)%InflowOnNacelle + END DO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + u_out%rotors(i01)%InflowOnTailFin = a1*u1%rotors(i01)%InflowOnTailFin + a2*u2%rotors(i01)%InflowOnTailFin + END DO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + IF (ALLOCATED(u_out%rotors(i01)%UserProp) .AND. ALLOCATED(u1%rotors(i01)%UserProp)) THEN + u_out%rotors(i01)%UserProp = a1*u1%rotors(i01)%UserProp + a2*u2%rotors(i01)%UserProp + END IF ! check if allocated + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%InflowWakeVel) .AND. ALLOCATED(u1%InflowWakeVel)) THEN + u_out%InflowWakeVel = a1*u1%InflowWakeVel + a2*u2%InflowWakeVel + END IF ! check if allocated +END SUBROUTINE - SUBROUTINE AD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE AD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 2. @@ -7370,204 +7341,167 @@ SUBROUTINE AD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM ! !.................................................................................................................................. - TYPE(AD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(AD_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(AD_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(AD_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(AD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(AD_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(AD_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(AD_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Input_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - INTEGER :: i3 ! dim3 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) -IF (ALLOCATED(u_out%rotors) .AND. ALLOCATED(u1%rotors)) THEN - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - CALL MeshExtrapInterp2(u1%rotors(i01)%NacelleMotion, u2%rotors(i01)%NacelleMotion, u3%rotors(i01)%NacelleMotion, tin, u_out%rotors(i01)%NacelleMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - CALL MeshExtrapInterp2(u1%rotors(i01)%TowerMotion, u2%rotors(i01)%TowerMotion, u3%rotors(i01)%TowerMotion, tin, u_out%rotors(i01)%TowerMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - CALL MeshExtrapInterp2(u1%rotors(i01)%HubMotion, u2%rotors(i01)%HubMotion, u3%rotors(i01)%HubMotion, tin, u_out%rotors(i01)%HubMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) -IF (ALLOCATED(u_out%rotors(i01)%BladeRootMotion) .AND. ALLOCATED(u1%rotors(i01)%BladeRootMotion)) THEN - DO i1 = LBOUND(u_out%rotors(i01)%BladeRootMotion,1),UBOUND(u_out%rotors(i01)%BladeRootMotion,1) - CALL MeshExtrapInterp2(u1%rotors(i01)%BladeRootMotion(i1), u2%rotors(i01)%BladeRootMotion(i1), u3%rotors(i01)%BladeRootMotion(i1), tin, u_out%rotors(i01)%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) -IF (ALLOCATED(u_out%rotors(i01)%BladeMotion) .AND. ALLOCATED(u1%rotors(i01)%BladeMotion)) THEN - DO i1 = LBOUND(u_out%rotors(i01)%BladeMotion,1),UBOUND(u_out%rotors(i01)%BladeMotion,1) - CALL MeshExtrapInterp2(u1%rotors(i01)%BladeMotion(i1), u2%rotors(i01)%BladeMotion(i1), u3%rotors(i01)%BladeMotion(i1), tin, u_out%rotors(i01)%BladeMotion(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - CALL MeshExtrapInterp2(u1%rotors(i01)%TFinMotion, u2%rotors(i01)%TFinMotion, u3%rotors(i01)%TFinMotion, tin, u_out%rotors(i01)%TFinMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) -IF (ALLOCATED(u_out%rotors(i01)%InflowOnBlade) .AND. ALLOCATED(u1%rotors(i01)%InflowOnBlade)) THEN - DO i3 = LBOUND(u_out%rotors(i01)%InflowOnBlade,3),UBOUND(u_out%rotors(i01)%InflowOnBlade,3) - DO i2 = LBOUND(u_out%rotors(i01)%InflowOnBlade,2),UBOUND(u_out%rotors(i01)%InflowOnBlade,2) - DO i1 = LBOUND(u_out%rotors(i01)%InflowOnBlade,1),UBOUND(u_out%rotors(i01)%InflowOnBlade,1) - b = (t(3)**2*(u1%rotors(i01)%InflowOnBlade(i1,i2,i3) - u2%rotors(i01)%InflowOnBlade(i1,i2,i3)) + t(2)**2*(-u1%rotors(i01)%InflowOnBlade(i1,i2,i3) + u3%rotors(i01)%InflowOnBlade(i1,i2,i3)))* scaleFactor - c = ( (t(2)-t(3))*u1%rotors(i01)%InflowOnBlade(i1,i2,i3) + t(3)*u2%rotors(i01)%InflowOnBlade(i1,i2,i3) - t(2)*u3%rotors(i01)%InflowOnBlade(i1,i2,i3) ) * scaleFactor - u_out%rotors(i01)%InflowOnBlade(i1,i2,i3) = u1%rotors(i01)%InflowOnBlade(i1,i2,i3) + b + c * t_out + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(u_out%rotors) .AND. ALLOCATED(u1%rotors)) THEN + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + CALL MeshExtrapInterp2(u1%rotors(i01)%NacelleMotion, u2%rotors(i01)%NacelleMotion, u3%rotors(i01)%NacelleMotion, tin, u_out%rotors(i01)%NacelleMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - END DO - END DO -END IF ! check if allocated - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) -IF (ALLOCATED(u_out%rotors(i01)%InflowOnTower) .AND. ALLOCATED(u1%rotors(i01)%InflowOnTower)) THEN - DO i2 = LBOUND(u_out%rotors(i01)%InflowOnTower,2),UBOUND(u_out%rotors(i01)%InflowOnTower,2) - DO i1 = LBOUND(u_out%rotors(i01)%InflowOnTower,1),UBOUND(u_out%rotors(i01)%InflowOnTower,1) - b = (t(3)**2*(u1%rotors(i01)%InflowOnTower(i1,i2) - u2%rotors(i01)%InflowOnTower(i1,i2)) + t(2)**2*(-u1%rotors(i01)%InflowOnTower(i1,i2) + u3%rotors(i01)%InflowOnTower(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%rotors(i01)%InflowOnTower(i1,i2) + t(3)*u2%rotors(i01)%InflowOnTower(i1,i2) - t(2)*u3%rotors(i01)%InflowOnTower(i1,i2) ) * scaleFactor - u_out%rotors(i01)%InflowOnTower(i1,i2) = u1%rotors(i01)%InflowOnTower(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - DO i1 = LBOUND(u_out%rotors(i01)%InflowOnHub,1),UBOUND(u_out%rotors(i01)%InflowOnHub,1) - b = (t(3)**2*(u1%rotors(i01)%InflowOnHub(i1) - u2%rotors(i01)%InflowOnHub(i1)) + t(2)**2*(-u1%rotors(i01)%InflowOnHub(i1) + u3%rotors(i01)%InflowOnHub(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%rotors(i01)%InflowOnHub(i1) + t(3)*u2%rotors(i01)%InflowOnHub(i1) - t(2)*u3%rotors(i01)%InflowOnHub(i1) ) * scaleFactor - u_out%rotors(i01)%InflowOnHub(i1) = u1%rotors(i01)%InflowOnHub(i1) + b + c * t_out - END DO - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - DO i1 = LBOUND(u_out%rotors(i01)%InflowOnNacelle,1),UBOUND(u_out%rotors(i01)%InflowOnNacelle,1) - b = (t(3)**2*(u1%rotors(i01)%InflowOnNacelle(i1) - u2%rotors(i01)%InflowOnNacelle(i1)) + t(2)**2*(-u1%rotors(i01)%InflowOnNacelle(i1) + u3%rotors(i01)%InflowOnNacelle(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%rotors(i01)%InflowOnNacelle(i1) + t(3)*u2%rotors(i01)%InflowOnNacelle(i1) - t(2)*u3%rotors(i01)%InflowOnNacelle(i1) ) * scaleFactor - u_out%rotors(i01)%InflowOnNacelle(i1) = u1%rotors(i01)%InflowOnNacelle(i1) + b + c * t_out - END DO - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - DO i1 = LBOUND(u_out%rotors(i01)%InflowOnTailFin,1),UBOUND(u_out%rotors(i01)%InflowOnTailFin,1) - b = (t(3)**2*(u1%rotors(i01)%InflowOnTailFin(i1) - u2%rotors(i01)%InflowOnTailFin(i1)) + t(2)**2*(-u1%rotors(i01)%InflowOnTailFin(i1) + u3%rotors(i01)%InflowOnTailFin(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%rotors(i01)%InflowOnTailFin(i1) + t(3)*u2%rotors(i01)%InflowOnTailFin(i1) - t(2)*u3%rotors(i01)%InflowOnTailFin(i1) ) * scaleFactor - u_out%rotors(i01)%InflowOnTailFin(i1) = u1%rotors(i01)%InflowOnTailFin(i1) + b + c * t_out - END DO - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) -IF (ALLOCATED(u_out%rotors(i01)%UserProp) .AND. ALLOCATED(u1%rotors(i01)%UserProp)) THEN - DO i2 = LBOUND(u_out%rotors(i01)%UserProp,2),UBOUND(u_out%rotors(i01)%UserProp,2) - DO i1 = LBOUND(u_out%rotors(i01)%UserProp,1),UBOUND(u_out%rotors(i01)%UserProp,1) - b = (t(3)**2*(u1%rotors(i01)%UserProp(i1,i2) - u2%rotors(i01)%UserProp(i1,i2)) + t(2)**2*(-u1%rotors(i01)%UserProp(i1,i2) + u3%rotors(i01)%UserProp(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%rotors(i01)%UserProp(i1,i2) + t(3)*u2%rotors(i01)%UserProp(i1,i2) - t(2)*u3%rotors(i01)%UserProp(i1,i2) ) * scaleFactor - u_out%rotors(i01)%UserProp(i1,i2) = u1%rotors(i01)%UserProp(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%InflowWakeVel) .AND. ALLOCATED(u1%InflowWakeVel)) THEN - DO i2 = LBOUND(u_out%InflowWakeVel,2),UBOUND(u_out%InflowWakeVel,2) - DO i1 = LBOUND(u_out%InflowWakeVel,1),UBOUND(u_out%InflowWakeVel,1) - b = (t(3)**2*(u1%InflowWakeVel(i1,i2) - u2%InflowWakeVel(i1,i2)) + t(2)**2*(-u1%InflowWakeVel(i1,i2) + u3%InflowWakeVel(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%InflowWakeVel(i1,i2) + t(3)*u2%InflowWakeVel(i1,i2) - t(2)*u3%InflowWakeVel(i1,i2) ) * scaleFactor - u_out%InflowWakeVel(i1,i2) = u1%InflowWakeVel(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated - END SUBROUTINE AD_Input_ExtrapInterp2 - - - SUBROUTINE AD_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(AD_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(AD_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + CALL MeshExtrapInterp2(u1%rotors(i01)%TowerMotion, u2%rotors(i01)%TowerMotion, u3%rotors(i01)%TowerMotion, tin, u_out%rotors(i01)%TowerMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + CALL MeshExtrapInterp2(u1%rotors(i01)%HubMotion, u2%rotors(i01)%HubMotion, u3%rotors(i01)%HubMotion, tin, u_out%rotors(i01)%HubMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + IF (ALLOCATED(u_out%rotors(i01)%BladeRootMotion) .AND. ALLOCATED(u1%rotors(i01)%BladeRootMotion)) THEN + DO i1 = LBOUND(u_out%rotors(i01)%BladeRootMotion,1),UBOUND(u_out%rotors(i01)%BladeRootMotion,1) + CALL MeshExtrapInterp2(u1%rotors(i01)%BladeRootMotion(i1), u2%rotors(i01)%BladeRootMotion(i1), u3%rotors(i01)%BladeRootMotion(i1), tin, u_out%rotors(i01)%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + END DO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + IF (ALLOCATED(u_out%rotors(i01)%BladeMotion) .AND. ALLOCATED(u1%rotors(i01)%BladeMotion)) THEN + DO i1 = LBOUND(u_out%rotors(i01)%BladeMotion,1),UBOUND(u_out%rotors(i01)%BladeMotion,1) + CALL MeshExtrapInterp2(u1%rotors(i01)%BladeMotion(i1), u2%rotors(i01)%BladeMotion(i1), u3%rotors(i01)%BladeMotion(i1), tin, u_out%rotors(i01)%BladeMotion(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + END DO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + CALL MeshExtrapInterp2(u1%rotors(i01)%TFinMotion, u2%rotors(i01)%TFinMotion, u3%rotors(i01)%TFinMotion, tin, u_out%rotors(i01)%TFinMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + IF (ALLOCATED(u_out%rotors(i01)%InflowOnBlade) .AND. ALLOCATED(u1%rotors(i01)%InflowOnBlade)) THEN + u_out%rotors(i01)%InflowOnBlade = a1*u1%rotors(i01)%InflowOnBlade + a2*u2%rotors(i01)%InflowOnBlade + a3*u3%rotors(i01)%InflowOnBlade + END IF ! check if allocated + END DO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + IF (ALLOCATED(u_out%rotors(i01)%InflowOnTower) .AND. ALLOCATED(u1%rotors(i01)%InflowOnTower)) THEN + u_out%rotors(i01)%InflowOnTower = a1*u1%rotors(i01)%InflowOnTower + a2*u2%rotors(i01)%InflowOnTower + a3*u3%rotors(i01)%InflowOnTower + END IF ! check if allocated + END DO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + u_out%rotors(i01)%InflowOnHub = a1*u1%rotors(i01)%InflowOnHub + a2*u2%rotors(i01)%InflowOnHub + a3*u3%rotors(i01)%InflowOnHub + END DO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + u_out%rotors(i01)%InflowOnNacelle = a1*u1%rotors(i01)%InflowOnNacelle + a2*u2%rotors(i01)%InflowOnNacelle + a3*u3%rotors(i01)%InflowOnNacelle + END DO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + u_out%rotors(i01)%InflowOnTailFin = a1*u1%rotors(i01)%InflowOnTailFin + a2*u2%rotors(i01)%InflowOnTailFin + a3*u3%rotors(i01)%InflowOnTailFin + END DO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + IF (ALLOCATED(u_out%rotors(i01)%UserProp) .AND. ALLOCATED(u1%rotors(i01)%UserProp)) THEN + u_out%rotors(i01)%UserProp = a1*u1%rotors(i01)%UserProp + a2*u2%rotors(i01)%UserProp + a3*u3%rotors(i01)%UserProp + END IF ! check if allocated + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%InflowWakeVel) .AND. ALLOCATED(u1%InflowWakeVel)) THEN + u_out%InflowWakeVel = a1*u1%InflowWakeVel + a2*u2%InflowWakeVel + a3*u3%InflowWakeVel + END IF ! check if allocated +END SUBROUTINE + +subroutine AD_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time + ! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(AD_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(AD_OutputType), intent(inout) :: y_out ! Output at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Output_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(y)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(y) - 1 - IF ( order .eq. 0 ) THEN - CALL AD_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL AD_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL AD_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE AD_Output_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'AD_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call AD_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call AD_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call AD_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE AD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE AD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 1. @@ -7579,75 +7513,73 @@ SUBROUTINE AD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(AD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(AD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(AD_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(AD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(AD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(AD_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Output_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%rotors) .AND. ALLOCATED(y1%rotors)) THEN + DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) + CALL MeshExtrapInterp1(y1%rotors(i01)%NacelleLoad, y2%rotors(i01)%NacelleLoad, tin, y_out%rotors(i01)%NacelleLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) + CALL MeshExtrapInterp1(y1%rotors(i01)%HubLoad, y2%rotors(i01)%HubLoad, tin, y_out%rotors(i01)%HubLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) + CALL MeshExtrapInterp1(y1%rotors(i01)%TowerLoad, y2%rotors(i01)%TowerLoad, tin, y_out%rotors(i01)%TowerLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) + IF (ALLOCATED(y_out%rotors(i01)%BladeLoad) .AND. ALLOCATED(y1%rotors(i01)%BladeLoad)) THEN + DO i1 = LBOUND(y_out%rotors(i01)%BladeLoad,1),UBOUND(y_out%rotors(i01)%BladeLoad,1) + CALL MeshExtrapInterp1(y1%rotors(i01)%BladeLoad(i1), y2%rotors(i01)%BladeLoad(i1), tin, y_out%rotors(i01)%BladeLoad(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + END DO + DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) + CALL MeshExtrapInterp1(y1%rotors(i01)%TFinLoad, y2%rotors(i01)%TFinLoad, tin, y_out%rotors(i01)%TFinLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) + IF (ALLOCATED(y_out%rotors(i01)%WriteOutput) .AND. ALLOCATED(y1%rotors(i01)%WriteOutput)) THEN + y_out%rotors(i01)%WriteOutput = a1*y1%rotors(i01)%WriteOutput + a2*y2%rotors(i01)%WriteOutput + END IF ! check if allocated + END DO + END IF ! check if allocated +END SUBROUTINE - ScaleFactor = t_out / t(2) -IF (ALLOCATED(y_out%rotors) .AND. ALLOCATED(y1%rotors)) THEN - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) - CALL MeshExtrapInterp1(y1%rotors(i01)%NacelleLoad, y2%rotors(i01)%NacelleLoad, tin, y_out%rotors(i01)%NacelleLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) - CALL MeshExtrapInterp1(y1%rotors(i01)%HubLoad, y2%rotors(i01)%HubLoad, tin, y_out%rotors(i01)%HubLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) - CALL MeshExtrapInterp1(y1%rotors(i01)%TowerLoad, y2%rotors(i01)%TowerLoad, tin, y_out%rotors(i01)%TowerLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) -IF (ALLOCATED(y_out%rotors(i01)%BladeLoad) .AND. ALLOCATED(y1%rotors(i01)%BladeLoad)) THEN - DO i1 = LBOUND(y_out%rotors(i01)%BladeLoad,1),UBOUND(y_out%rotors(i01)%BladeLoad,1) - CALL MeshExtrapInterp1(y1%rotors(i01)%BladeLoad(i1), y2%rotors(i01)%BladeLoad(i1), tin, y_out%rotors(i01)%BladeLoad(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - ENDDO - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) - CALL MeshExtrapInterp1(y1%rotors(i01)%TFinLoad, y2%rotors(i01)%TFinLoad, tin, y_out%rotors(i01)%TFinLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) -IF (ALLOCATED(y_out%rotors(i01)%WriteOutput) .AND. ALLOCATED(y1%rotors(i01)%WriteOutput)) THEN - DO i1 = LBOUND(y_out%rotors(i01)%WriteOutput,1),UBOUND(y_out%rotors(i01)%WriteOutput,1) - b = -(y1%rotors(i01)%WriteOutput(i1) - y2%rotors(i01)%WriteOutput(i1)) - y_out%rotors(i01)%WriteOutput(i1) = y1%rotors(i01)%WriteOutput(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - ENDDO -END IF ! check if allocated - END SUBROUTINE AD_Output_ExtrapInterp1 - - - SUBROUTINE AD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE AD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 2. @@ -7661,82 +7593,78 @@ SUBROUTINE AD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - TYPE(AD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(AD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(AD_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(AD_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(AD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(AD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(AD_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(AD_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'AD_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'AD_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) -IF (ALLOCATED(y_out%rotors) .AND. ALLOCATED(y1%rotors)) THEN - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) - CALL MeshExtrapInterp2(y1%rotors(i01)%NacelleLoad, y2%rotors(i01)%NacelleLoad, y3%rotors(i01)%NacelleLoad, tin, y_out%rotors(i01)%NacelleLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) - CALL MeshExtrapInterp2(y1%rotors(i01)%HubLoad, y2%rotors(i01)%HubLoad, y3%rotors(i01)%HubLoad, tin, y_out%rotors(i01)%HubLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) - CALL MeshExtrapInterp2(y1%rotors(i01)%TowerLoad, y2%rotors(i01)%TowerLoad, y3%rotors(i01)%TowerLoad, tin, y_out%rotors(i01)%TowerLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) -IF (ALLOCATED(y_out%rotors(i01)%BladeLoad) .AND. ALLOCATED(y1%rotors(i01)%BladeLoad)) THEN - DO i1 = LBOUND(y_out%rotors(i01)%BladeLoad,1),UBOUND(y_out%rotors(i01)%BladeLoad,1) - CALL MeshExtrapInterp2(y1%rotors(i01)%BladeLoad(i1), y2%rotors(i01)%BladeLoad(i1), y3%rotors(i01)%BladeLoad(i1), tin, y_out%rotors(i01)%BladeLoad(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - ENDDO - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) - CALL MeshExtrapInterp2(y1%rotors(i01)%TFinLoad, y2%rotors(i01)%TFinLoad, y3%rotors(i01)%TFinLoad, tin, y_out%rotors(i01)%TFinLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) -IF (ALLOCATED(y_out%rotors(i01)%WriteOutput) .AND. ALLOCATED(y1%rotors(i01)%WriteOutput)) THEN - DO i1 = LBOUND(y_out%rotors(i01)%WriteOutput,1),UBOUND(y_out%rotors(i01)%WriteOutput,1) - b = (t(3)**2*(y1%rotors(i01)%WriteOutput(i1) - y2%rotors(i01)%WriteOutput(i1)) + t(2)**2*(-y1%rotors(i01)%WriteOutput(i1) + y3%rotors(i01)%WriteOutput(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%rotors(i01)%WriteOutput(i1) + t(3)*y2%rotors(i01)%WriteOutput(i1) - t(2)*y3%rotors(i01)%WriteOutput(i1) ) * scaleFactor - y_out%rotors(i01)%WriteOutput(i1) = y1%rotors(i01)%WriteOutput(i1) + b + c * t_out - END DO -END IF ! check if allocated - ENDDO -END IF ! check if allocated - END SUBROUTINE AD_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%rotors) .AND. ALLOCATED(y1%rotors)) THEN + DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) + CALL MeshExtrapInterp2(y1%rotors(i01)%NacelleLoad, y2%rotors(i01)%NacelleLoad, y3%rotors(i01)%NacelleLoad, tin, y_out%rotors(i01)%NacelleLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) + CALL MeshExtrapInterp2(y1%rotors(i01)%HubLoad, y2%rotors(i01)%HubLoad, y3%rotors(i01)%HubLoad, tin, y_out%rotors(i01)%HubLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) + CALL MeshExtrapInterp2(y1%rotors(i01)%TowerLoad, y2%rotors(i01)%TowerLoad, y3%rotors(i01)%TowerLoad, tin, y_out%rotors(i01)%TowerLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) + IF (ALLOCATED(y_out%rotors(i01)%BladeLoad) .AND. ALLOCATED(y1%rotors(i01)%BladeLoad)) THEN + DO i1 = LBOUND(y_out%rotors(i01)%BladeLoad,1),UBOUND(y_out%rotors(i01)%BladeLoad,1) + CALL MeshExtrapInterp2(y1%rotors(i01)%BladeLoad(i1), y2%rotors(i01)%BladeLoad(i1), y3%rotors(i01)%BladeLoad(i1), tin, y_out%rotors(i01)%BladeLoad(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + END DO + DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) + CALL MeshExtrapInterp2(y1%rotors(i01)%TFinLoad, y2%rotors(i01)%TFinLoad, y3%rotors(i01)%TFinLoad, tin, y_out%rotors(i01)%TFinLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + DO i01 = LBOUND(y_out%rotors,1),UBOUND(y_out%rotors,1) + IF (ALLOCATED(y_out%rotors(i01)%WriteOutput) .AND. ALLOCATED(y1%rotors(i01)%WriteOutput)) THEN + y_out%rotors(i01)%WriteOutput = a1*y1%rotors(i01)%WriteOutput + a2*y2%rotors(i01)%WriteOutput + a3*y3%rotors(i01)%WriteOutput + END IF ! check if allocated + END DO + END IF ! check if allocated +END SUBROUTINE END MODULE AeroDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/AirfoilInfo_Types.f90 b/modules/aerodyn/src/AirfoilInfo_Types.f90 index c5db46e711..ec227a4ad7 100644 --- a/modules/aerodyn/src/AirfoilInfo_Types.f90 +++ b/modules/aerodyn/src/AirfoilInfo_Types.f90 @@ -1257,58 +1257,59 @@ subroutine AFI_UnPackOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE AFI_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(AFI_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 - REAL(ReKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(AFI_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(ReKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None +subroutine AFI_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time + ! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(AFI_OutputType), intent(in) :: y(:) ! Output at t1 > t2 > t3 + real(ReKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(AFI_OutputType), intent(inout) :: y_out ! Output at tin_out + real(ReKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_Output_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(y)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(y) - 1 - IF ( order .eq. 0 ) THEN - CALL AFI_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL AFI_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL AFI_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE AFI_Output_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'AFI_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call AFI_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call AFI_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call AFI_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE AFI_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE AFI_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 1. @@ -1320,57 +1321,49 @@ SUBROUTINE AFI_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(AFI_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 - TYPE(AFI_OutputType), INTENT(IN) :: y2 ! Output at t2 - REAL(ReKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(AFI_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(ReKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(AFI_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 + TYPE(AFI_OutputType), INTENT(IN) :: y2 ! Output at t2 + REAL(ReKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(AFI_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(ReKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(ReKi) :: t(2) ! Times associated with the Outputs - REAL(ReKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_Output_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(ReKi) :: t(2) ! Times associated with the Outputs + REAL(ReKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'AFI_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + y_out%Cl = a1*y1%Cl + a2*y2%Cl + y_out%Cd = a1*y1%Cd + a2*y2%Cd + y_out%Cm = a1*y1%Cm + a2*y2%Cm + y_out%Cpmin = a1*y1%Cpmin + a2*y2%Cpmin + y_out%Cd0 = a1*y1%Cd0 + a2*y2%Cd0 + y_out%Cm0 = a1*y1%Cm0 + a2*y2%Cm0 + y_out%f_st = a1*y1%f_st + a2*y2%f_st + y_out%FullySeparate = a1*y1%FullySeparate + a2*y2%FullySeparate + y_out%FullyAttached = a1*y1%FullyAttached + a2*y2%FullyAttached +END SUBROUTINE - ScaleFactor = t_out / t(2) - b = -(y1%Cl - y2%Cl) - y_out%Cl = y1%Cl + b * ScaleFactor - b = -(y1%Cd - y2%Cd) - y_out%Cd = y1%Cd + b * ScaleFactor - b = -(y1%Cm - y2%Cm) - y_out%Cm = y1%Cm + b * ScaleFactor - b = -(y1%Cpmin - y2%Cpmin) - y_out%Cpmin = y1%Cpmin + b * ScaleFactor - b = -(y1%Cd0 - y2%Cd0) - y_out%Cd0 = y1%Cd0 + b * ScaleFactor - b = -(y1%Cm0 - y2%Cm0) - y_out%Cm0 = y1%Cm0 + b * ScaleFactor - b = -(y1%f_st - y2%f_st) - y_out%f_st = y1%f_st + b * ScaleFactor - b = -(y1%FullySeparate - y2%FullySeparate) - y_out%FullySeparate = y1%FullySeparate + b * ScaleFactor - b = -(y1%FullyAttached - y2%FullyAttached) - y_out%FullyAttached = y1%FullyAttached + b * ScaleFactor - END SUBROUTINE AFI_Output_ExtrapInterp1 - - - SUBROUTINE AFI_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE AFI_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 2. @@ -1384,126 +1377,109 @@ SUBROUTINE AFI_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - TYPE(AFI_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 - TYPE(AFI_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 - TYPE(AFI_OutputType), INTENT(IN) :: y3 ! Output at t3 - REAL(ReKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(AFI_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(ReKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(AFI_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 + TYPE(AFI_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 + TYPE(AFI_OutputType), INTENT(IN) :: y3 ! Output at t3 + REAL(ReKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(AFI_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(ReKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(ReKi) :: t(3) ! Times associated with the Outputs - REAL(ReKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_Output_ExtrapInterp2' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(ReKi) :: t(3) ! Times associated with the Outputs + REAL(ReKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'AFI_Output_ExtrapInterp2' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + y_out%Cl = a1*y1%Cl + a2*y2%Cl + a3*y3%Cl + y_out%Cd = a1*y1%Cd + a2*y2%Cd + a3*y3%Cd + y_out%Cm = a1*y1%Cm + a2*y2%Cm + a3*y3%Cm + y_out%Cpmin = a1*y1%Cpmin + a2*y2%Cpmin + a3*y3%Cpmin + y_out%Cd0 = a1*y1%Cd0 + a2*y2%Cd0 + a3*y3%Cd0 + y_out%Cm0 = a1*y1%Cm0 + a2*y2%Cm0 + a3*y3%Cm0 + y_out%f_st = a1*y1%f_st + a2*y2%f_st + a3*y3%f_st + y_out%FullySeparate = a1*y1%FullySeparate + a2*y2%FullySeparate + a3*y3%FullySeparate + y_out%FullyAttached = a1*y1%FullyAttached + a2*y2%FullyAttached + a3*y3%FullyAttached +END SUBROUTINE - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) - b = (t(3)**2*(y1%Cl - y2%Cl) + t(2)**2*(-y1%Cl + y3%Cl))* scaleFactor - c = ( (t(2)-t(3))*y1%Cl + t(3)*y2%Cl - t(2)*y3%Cl ) * scaleFactor - y_out%Cl = y1%Cl + b + c * t_out - b = (t(3)**2*(y1%Cd - y2%Cd) + t(2)**2*(-y1%Cd + y3%Cd))* scaleFactor - c = ( (t(2)-t(3))*y1%Cd + t(3)*y2%Cd - t(2)*y3%Cd ) * scaleFactor - y_out%Cd = y1%Cd + b + c * t_out - b = (t(3)**2*(y1%Cm - y2%Cm) + t(2)**2*(-y1%Cm + y3%Cm))* scaleFactor - c = ( (t(2)-t(3))*y1%Cm + t(3)*y2%Cm - t(2)*y3%Cm ) * scaleFactor - y_out%Cm = y1%Cm + b + c * t_out - b = (t(3)**2*(y1%Cpmin - y2%Cpmin) + t(2)**2*(-y1%Cpmin + y3%Cpmin))* scaleFactor - c = ( (t(2)-t(3))*y1%Cpmin + t(3)*y2%Cpmin - t(2)*y3%Cpmin ) * scaleFactor - y_out%Cpmin = y1%Cpmin + b + c * t_out - b = (t(3)**2*(y1%Cd0 - y2%Cd0) + t(2)**2*(-y1%Cd0 + y3%Cd0))* scaleFactor - c = ( (t(2)-t(3))*y1%Cd0 + t(3)*y2%Cd0 - t(2)*y3%Cd0 ) * scaleFactor - y_out%Cd0 = y1%Cd0 + b + c * t_out - b = (t(3)**2*(y1%Cm0 - y2%Cm0) + t(2)**2*(-y1%Cm0 + y3%Cm0))* scaleFactor - c = ( (t(2)-t(3))*y1%Cm0 + t(3)*y2%Cm0 - t(2)*y3%Cm0 ) * scaleFactor - y_out%Cm0 = y1%Cm0 + b + c * t_out - b = (t(3)**2*(y1%f_st - y2%f_st) + t(2)**2*(-y1%f_st + y3%f_st))* scaleFactor - c = ( (t(2)-t(3))*y1%f_st + t(3)*y2%f_st - t(2)*y3%f_st ) * scaleFactor - y_out%f_st = y1%f_st + b + c * t_out - b = (t(3)**2*(y1%FullySeparate - y2%FullySeparate) + t(2)**2*(-y1%FullySeparate + y3%FullySeparate))* scaleFactor - c = ( (t(2)-t(3))*y1%FullySeparate + t(3)*y2%FullySeparate - t(2)*y3%FullySeparate ) * scaleFactor - y_out%FullySeparate = y1%FullySeparate + b + c * t_out - b = (t(3)**2*(y1%FullyAttached - y2%FullyAttached) + t(2)**2*(-y1%FullyAttached + y3%FullyAttached))* scaleFactor - c = ( (t(2)-t(3))*y1%FullyAttached + t(3)*y2%FullyAttached - t(2)*y3%FullyAttached ) * scaleFactor - y_out%FullyAttached = y1%FullyAttached + b + c * t_out - END SUBROUTINE AFI_Output_ExtrapInterp2 - - - SUBROUTINE AFI_UA_BL_Type_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) UA_BL_Type u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(AFI_UA_BL_Type), INTENT(IN) :: u(:) ! UA_BL_Type at t1 > t2 > t3 - REAL(ReKi), INTENT(IN ) :: t(:) ! Times associated with the UA_BL_Types - TYPE(AFI_UA_BL_Type), INTENT(INOUT) :: u_out ! UA_BL_Type at tin_out - REAL(ReKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None +subroutine AFI_UA_BL_Type_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) UA_BL_Type u_out at time t_out, from previous/future time + ! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(AFI_UA_BL_Type), intent(in) :: u(:) ! UA_BL_Type at t1 > t2 > t3 + real(ReKi), intent(in ) :: t(:) ! Times associated with the UA_BL_Types + type(AFI_UA_BL_Type), intent(inout) :: u_out ! UA_BL_Type at tin_out + real(ReKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_UA_BL_Type_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(u)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(u) - 1 - IF ( order .eq. 0 ) THEN - CALL AFI_CopyUA_BL_Type(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL AFI_UA_BL_Type_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL AFI_UA_BL_Type_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE AFI_UA_BL_Type_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'AFI_UA_BL_Type_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call AFI_CopyUA_BL_Type(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call AFI_UA_BL_Type_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call AFI_UA_BL_Type_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE AFI_UA_BL_Type_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE AFI_UA_BL_Type_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) UA_BL_Type u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 1. @@ -1515,126 +1491,87 @@ SUBROUTINE AFI_UA_BL_Type_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - TYPE(AFI_UA_BL_Type), INTENT(IN) :: u1 ! UA_BL_Type at t1 > t2 - TYPE(AFI_UA_BL_Type), INTENT(IN) :: u2 ! UA_BL_Type at t2 - REAL(ReKi), INTENT(IN ) :: tin(2) ! Times associated with the UA_BL_Types - TYPE(AFI_UA_BL_Type), INTENT(INOUT) :: u_out ! UA_BL_Type at tin_out - REAL(ReKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(AFI_UA_BL_Type), INTENT(IN) :: u1 ! UA_BL_Type at t1 > t2 + TYPE(AFI_UA_BL_Type), INTENT(IN) :: u2 ! UA_BL_Type at t2 + REAL(ReKi), INTENT(IN ) :: tin(2) ! Times associated with the UA_BL_Types + TYPE(AFI_UA_BL_Type), INTENT(INOUT) :: u_out ! UA_BL_Type at tin_out + REAL(ReKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(ReKi) :: t(2) ! Times associated with the UA_BL_Types - REAL(ReKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_UA_BL_Type_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(ReKi) :: t(2) ! Times associated with the UA_BL_Types + REAL(ReKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'AFI_UA_BL_Type_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL Angles_ExtrapInterp( u1%alpha0, u2%alpha0, tin, u_out%alpha0, tin_out ) + CALL Angles_ExtrapInterp( u1%alpha1, u2%alpha1, tin, u_out%alpha1, tin_out ) + CALL Angles_ExtrapInterp( u1%alpha2, u2%alpha2, tin, u_out%alpha2, tin_out ) + u_out%eta_e = a1*u1%eta_e + a2*u2%eta_e + u_out%C_nalpha = a1*u1%C_nalpha + a2*u2%C_nalpha + u_out%C_lalpha = a1*u1%C_lalpha + a2*u2%C_lalpha + u_out%T_f0 = a1*u1%T_f0 + a2*u2%T_f0 + u_out%T_V0 = a1*u1%T_V0 + a2*u2%T_V0 + u_out%T_p = a1*u1%T_p + a2*u2%T_p + u_out%T_VL = a1*u1%T_VL + a2*u2%T_VL + u_out%b1 = a1*u1%b1 + a2*u2%b1 + u_out%b2 = a1*u1%b2 + a2*u2%b2 + u_out%b5 = a1*u1%b5 + a2*u2%b5 + u_out%A1 = a1*u1%A1 + a2*u2%A1 + u_out%A2 = a1*u1%A2 + a2*u2%A2 + u_out%A5 = a1*u1%A5 + a2*u2%A5 + u_out%S1 = a1*u1%S1 + a2*u2%S1 + u_out%S2 = a1*u1%S2 + a2*u2%S2 + u_out%S3 = a1*u1%S3 + a2*u2%S3 + u_out%S4 = a1*u1%S4 + a2*u2%S4 + u_out%Cn1 = a1*u1%Cn1 + a2*u2%Cn1 + u_out%Cn2 = a1*u1%Cn2 + a2*u2%Cn2 + u_out%St_sh = a1*u1%St_sh + a2*u2%St_sh + u_out%Cd0 = a1*u1%Cd0 + a2*u2%Cd0 + u_out%Cm0 = a1*u1%Cm0 + a2*u2%Cm0 + u_out%k0 = a1*u1%k0 + a2*u2%k0 + u_out%k1 = a1*u1%k1 + a2*u2%k1 + u_out%k2 = a1*u1%k2 + a2*u2%k2 + u_out%k3 = a1*u1%k3 + a2*u2%k3 + u_out%k1_hat = a1*u1%k1_hat + a2*u2%k1_hat + u_out%x_cp_bar = a1*u1%x_cp_bar + a2*u2%x_cp_bar + u_out%UACutout = a1*u1%UACutout + a2*u2%UACutout + u_out%UACutout_delta = a1*u1%UACutout_delta + a2*u2%UACutout_delta + u_out%UACutout_blend = a1*u1%UACutout_blend + a2*u2%UACutout_blend + u_out%filtCutOff = a1*u1%filtCutOff + a2*u2%filtCutOff + CALL Angles_ExtrapInterp( u1%alphaUpper, u2%alphaUpper, tin, u_out%alphaUpper, tin_out ) + CALL Angles_ExtrapInterp( u1%alphaLower, u2%alphaLower, tin, u_out%alphaLower, tin_out ) + u_out%c_Rate = a1*u1%c_Rate + a2*u2%c_Rate + u_out%c_RateUpper = a1*u1%c_RateUpper + a2*u2%c_RateUpper + u_out%c_RateLower = a1*u1%c_RateLower + a2*u2%c_RateLower + u_out%c_alphaLower = a1*u1%c_alphaLower + a2*u2%c_alphaLower + u_out%c_alphaUpper = a1*u1%c_alphaUpper + a2*u2%c_alphaUpper + CALL Angles_ExtrapInterp( u1%alphaUpperWrap, u2%alphaUpperWrap, tin, u_out%alphaUpperWrap, tin_out ) + CALL Angles_ExtrapInterp( u1%alphaLowerWrap, u2%alphaLowerWrap, tin, u_out%alphaLowerWrap, tin_out ) + u_out%c_RateWrap = a1*u1%c_RateWrap + a2*u2%c_RateWrap + u_out%c_alphaLowerWrap = a1*u1%c_alphaLowerWrap + a2*u2%c_alphaLowerWrap + u_out%c_alphaUpperWrap = a1*u1%c_alphaUpperWrap + a2*u2%c_alphaUpperWrap +END SUBROUTINE - ScaleFactor = t_out / t(2) - CALL Angles_ExtrapInterp( u1%alpha0, u2%alpha0, tin, u_out%alpha0, tin_out ) - CALL Angles_ExtrapInterp( u1%alpha1, u2%alpha1, tin, u_out%alpha1, tin_out ) - CALL Angles_ExtrapInterp( u1%alpha2, u2%alpha2, tin, u_out%alpha2, tin_out ) - b = -(u1%eta_e - u2%eta_e) - u_out%eta_e = u1%eta_e + b * ScaleFactor - b = -(u1%C_nalpha - u2%C_nalpha) - u_out%C_nalpha = u1%C_nalpha + b * ScaleFactor - b = -(u1%C_lalpha - u2%C_lalpha) - u_out%C_lalpha = u1%C_lalpha + b * ScaleFactor - b = -(u1%T_f0 - u2%T_f0) - u_out%T_f0 = u1%T_f0 + b * ScaleFactor - b = -(u1%T_V0 - u2%T_V0) - u_out%T_V0 = u1%T_V0 + b * ScaleFactor - b = -(u1%T_p - u2%T_p) - u_out%T_p = u1%T_p + b * ScaleFactor - b = -(u1%T_VL - u2%T_VL) - u_out%T_VL = u1%T_VL + b * ScaleFactor - b = -(u1%b1 - u2%b1) - u_out%b1 = u1%b1 + b * ScaleFactor - b = -(u1%b2 - u2%b2) - u_out%b2 = u1%b2 + b * ScaleFactor - b = -(u1%b5 - u2%b5) - u_out%b5 = u1%b5 + b * ScaleFactor - b = -(u1%A1 - u2%A1) - u_out%A1 = u1%A1 + b * ScaleFactor - b = -(u1%A2 - u2%A2) - u_out%A2 = u1%A2 + b * ScaleFactor - b = -(u1%A5 - u2%A5) - u_out%A5 = u1%A5 + b * ScaleFactor - b = -(u1%S1 - u2%S1) - u_out%S1 = u1%S1 + b * ScaleFactor - b = -(u1%S2 - u2%S2) - u_out%S2 = u1%S2 + b * ScaleFactor - b = -(u1%S3 - u2%S3) - u_out%S3 = u1%S3 + b * ScaleFactor - b = -(u1%S4 - u2%S4) - u_out%S4 = u1%S4 + b * ScaleFactor - b = -(u1%Cn1 - u2%Cn1) - u_out%Cn1 = u1%Cn1 + b * ScaleFactor - b = -(u1%Cn2 - u2%Cn2) - u_out%Cn2 = u1%Cn2 + b * ScaleFactor - b = -(u1%St_sh - u2%St_sh) - u_out%St_sh = u1%St_sh + b * ScaleFactor - b = -(u1%Cd0 - u2%Cd0) - u_out%Cd0 = u1%Cd0 + b * ScaleFactor - b = -(u1%Cm0 - u2%Cm0) - u_out%Cm0 = u1%Cm0 + b * ScaleFactor - b = -(u1%k0 - u2%k0) - u_out%k0 = u1%k0 + b * ScaleFactor - b = -(u1%k1 - u2%k1) - u_out%k1 = u1%k1 + b * ScaleFactor - b = -(u1%k2 - u2%k2) - u_out%k2 = u1%k2 + b * ScaleFactor - b = -(u1%k3 - u2%k3) - u_out%k3 = u1%k3 + b * ScaleFactor - b = -(u1%k1_hat - u2%k1_hat) - u_out%k1_hat = u1%k1_hat + b * ScaleFactor - b = -(u1%x_cp_bar - u2%x_cp_bar) - u_out%x_cp_bar = u1%x_cp_bar + b * ScaleFactor - b = -(u1%UACutout - u2%UACutout) - u_out%UACutout = u1%UACutout + b * ScaleFactor - b = -(u1%UACutout_delta - u2%UACutout_delta) - u_out%UACutout_delta = u1%UACutout_delta + b * ScaleFactor - b = -(u1%UACutout_blend - u2%UACutout_blend) - u_out%UACutout_blend = u1%UACutout_blend + b * ScaleFactor - b = -(u1%filtCutOff - u2%filtCutOff) - u_out%filtCutOff = u1%filtCutOff + b * ScaleFactor - CALL Angles_ExtrapInterp( u1%alphaUpper, u2%alphaUpper, tin, u_out%alphaUpper, tin_out ) - CALL Angles_ExtrapInterp( u1%alphaLower, u2%alphaLower, tin, u_out%alphaLower, tin_out ) - b = -(u1%c_Rate - u2%c_Rate) - u_out%c_Rate = u1%c_Rate + b * ScaleFactor - b = -(u1%c_RateUpper - u2%c_RateUpper) - u_out%c_RateUpper = u1%c_RateUpper + b * ScaleFactor - b = -(u1%c_RateLower - u2%c_RateLower) - u_out%c_RateLower = u1%c_RateLower + b * ScaleFactor - b = -(u1%c_alphaLower - u2%c_alphaLower) - u_out%c_alphaLower = u1%c_alphaLower + b * ScaleFactor - b = -(u1%c_alphaUpper - u2%c_alphaUpper) - u_out%c_alphaUpper = u1%c_alphaUpper + b * ScaleFactor - CALL Angles_ExtrapInterp( u1%alphaUpperWrap, u2%alphaUpperWrap, tin, u_out%alphaUpperWrap, tin_out ) - CALL Angles_ExtrapInterp( u1%alphaLowerWrap, u2%alphaLowerWrap, tin, u_out%alphaLowerWrap, tin_out ) - b = -(u1%c_RateWrap - u2%c_RateWrap) - u_out%c_RateWrap = u1%c_RateWrap + b * ScaleFactor - b = -(u1%c_alphaLowerWrap - u2%c_alphaLowerWrap) - u_out%c_alphaLowerWrap = u1%c_alphaLowerWrap + b * ScaleFactor - b = -(u1%c_alphaUpperWrap - u2%c_alphaUpperWrap) - u_out%c_alphaUpperWrap = u1%c_alphaUpperWrap + b * ScaleFactor - END SUBROUTINE AFI_UA_BL_Type_ExtrapInterp1 - - - SUBROUTINE AFI_UA_BL_Type_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE AFI_UA_BL_Type_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) UA_BL_Type u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 2. @@ -1648,172 +1585,92 @@ SUBROUTINE AFI_UA_BL_Type_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat ! !.................................................................................................................................. - TYPE(AFI_UA_BL_Type), INTENT(IN) :: u1 ! UA_BL_Type at t1 > t2 > t3 - TYPE(AFI_UA_BL_Type), INTENT(IN) :: u2 ! UA_BL_Type at t2 > t3 - TYPE(AFI_UA_BL_Type), INTENT(IN) :: u3 ! UA_BL_Type at t3 - REAL(ReKi), INTENT(IN ) :: tin(3) ! Times associated with the UA_BL_Types - TYPE(AFI_UA_BL_Type), INTENT(INOUT) :: u_out ! UA_BL_Type at tin_out - REAL(ReKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(AFI_UA_BL_Type), INTENT(IN) :: u1 ! UA_BL_Type at t1 > t2 > t3 + TYPE(AFI_UA_BL_Type), INTENT(IN) :: u2 ! UA_BL_Type at t2 > t3 + TYPE(AFI_UA_BL_Type), INTENT(IN) :: u3 ! UA_BL_Type at t3 + REAL(ReKi), INTENT(IN ) :: tin(3) ! Times associated with the UA_BL_Types + TYPE(AFI_UA_BL_Type), INTENT(INOUT) :: u_out ! UA_BL_Type at tin_out + REAL(ReKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(ReKi) :: t(3) ! Times associated with the UA_BL_Types - REAL(ReKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'AFI_UA_BL_Type_ExtrapInterp2' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(ReKi) :: t(3) ! Times associated with the UA_BL_Types + REAL(ReKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'AFI_UA_BL_Type_ExtrapInterp2' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) - CALL Angles_ExtrapInterp( u1%alpha0, u2%alpha0, u3%alpha0, tin, u_out%alpha0, tin_out ) - CALL Angles_ExtrapInterp( u1%alpha1, u2%alpha1, u3%alpha1, tin, u_out%alpha1, tin_out ) - CALL Angles_ExtrapInterp( u1%alpha2, u2%alpha2, u3%alpha2, tin, u_out%alpha2, tin_out ) - b = (t(3)**2*(u1%eta_e - u2%eta_e) + t(2)**2*(-u1%eta_e + u3%eta_e))* scaleFactor - c = ( (t(2)-t(3))*u1%eta_e + t(3)*u2%eta_e - t(2)*u3%eta_e ) * scaleFactor - u_out%eta_e = u1%eta_e + b + c * t_out - b = (t(3)**2*(u1%C_nalpha - u2%C_nalpha) + t(2)**2*(-u1%C_nalpha + u3%C_nalpha))* scaleFactor - c = ( (t(2)-t(3))*u1%C_nalpha + t(3)*u2%C_nalpha - t(2)*u3%C_nalpha ) * scaleFactor - u_out%C_nalpha = u1%C_nalpha + b + c * t_out - b = (t(3)**2*(u1%C_lalpha - u2%C_lalpha) + t(2)**2*(-u1%C_lalpha + u3%C_lalpha))* scaleFactor - c = ( (t(2)-t(3))*u1%C_lalpha + t(3)*u2%C_lalpha - t(2)*u3%C_lalpha ) * scaleFactor - u_out%C_lalpha = u1%C_lalpha + b + c * t_out - b = (t(3)**2*(u1%T_f0 - u2%T_f0) + t(2)**2*(-u1%T_f0 + u3%T_f0))* scaleFactor - c = ( (t(2)-t(3))*u1%T_f0 + t(3)*u2%T_f0 - t(2)*u3%T_f0 ) * scaleFactor - u_out%T_f0 = u1%T_f0 + b + c * t_out - b = (t(3)**2*(u1%T_V0 - u2%T_V0) + t(2)**2*(-u1%T_V0 + u3%T_V0))* scaleFactor - c = ( (t(2)-t(3))*u1%T_V0 + t(3)*u2%T_V0 - t(2)*u3%T_V0 ) * scaleFactor - u_out%T_V0 = u1%T_V0 + b + c * t_out - b = (t(3)**2*(u1%T_p - u2%T_p) + t(2)**2*(-u1%T_p + u3%T_p))* scaleFactor - c = ( (t(2)-t(3))*u1%T_p + t(3)*u2%T_p - t(2)*u3%T_p ) * scaleFactor - u_out%T_p = u1%T_p + b + c * t_out - b = (t(3)**2*(u1%T_VL - u2%T_VL) + t(2)**2*(-u1%T_VL + u3%T_VL))* scaleFactor - c = ( (t(2)-t(3))*u1%T_VL + t(3)*u2%T_VL - t(2)*u3%T_VL ) * scaleFactor - u_out%T_VL = u1%T_VL + b + c * t_out - b = (t(3)**2*(u1%b1 - u2%b1) + t(2)**2*(-u1%b1 + u3%b1))* scaleFactor - c = ( (t(2)-t(3))*u1%b1 + t(3)*u2%b1 - t(2)*u3%b1 ) * scaleFactor - u_out%b1 = u1%b1 + b + c * t_out - b = (t(3)**2*(u1%b2 - u2%b2) + t(2)**2*(-u1%b2 + u3%b2))* scaleFactor - c = ( (t(2)-t(3))*u1%b2 + t(3)*u2%b2 - t(2)*u3%b2 ) * scaleFactor - u_out%b2 = u1%b2 + b + c * t_out - b = (t(3)**2*(u1%b5 - u2%b5) + t(2)**2*(-u1%b5 + u3%b5))* scaleFactor - c = ( (t(2)-t(3))*u1%b5 + t(3)*u2%b5 - t(2)*u3%b5 ) * scaleFactor - u_out%b5 = u1%b5 + b + c * t_out - b = (t(3)**2*(u1%A1 - u2%A1) + t(2)**2*(-u1%A1 + u3%A1))* scaleFactor - c = ( (t(2)-t(3))*u1%A1 + t(3)*u2%A1 - t(2)*u3%A1 ) * scaleFactor - u_out%A1 = u1%A1 + b + c * t_out - b = (t(3)**2*(u1%A2 - u2%A2) + t(2)**2*(-u1%A2 + u3%A2))* scaleFactor - c = ( (t(2)-t(3))*u1%A2 + t(3)*u2%A2 - t(2)*u3%A2 ) * scaleFactor - u_out%A2 = u1%A2 + b + c * t_out - b = (t(3)**2*(u1%A5 - u2%A5) + t(2)**2*(-u1%A5 + u3%A5))* scaleFactor - c = ( (t(2)-t(3))*u1%A5 + t(3)*u2%A5 - t(2)*u3%A5 ) * scaleFactor - u_out%A5 = u1%A5 + b + c * t_out - b = (t(3)**2*(u1%S1 - u2%S1) + t(2)**2*(-u1%S1 + u3%S1))* scaleFactor - c = ( (t(2)-t(3))*u1%S1 + t(3)*u2%S1 - t(2)*u3%S1 ) * scaleFactor - u_out%S1 = u1%S1 + b + c * t_out - b = (t(3)**2*(u1%S2 - u2%S2) + t(2)**2*(-u1%S2 + u3%S2))* scaleFactor - c = ( (t(2)-t(3))*u1%S2 + t(3)*u2%S2 - t(2)*u3%S2 ) * scaleFactor - u_out%S2 = u1%S2 + b + c * t_out - b = (t(3)**2*(u1%S3 - u2%S3) + t(2)**2*(-u1%S3 + u3%S3))* scaleFactor - c = ( (t(2)-t(3))*u1%S3 + t(3)*u2%S3 - t(2)*u3%S3 ) * scaleFactor - u_out%S3 = u1%S3 + b + c * t_out - b = (t(3)**2*(u1%S4 - u2%S4) + t(2)**2*(-u1%S4 + u3%S4))* scaleFactor - c = ( (t(2)-t(3))*u1%S4 + t(3)*u2%S4 - t(2)*u3%S4 ) * scaleFactor - u_out%S4 = u1%S4 + b + c * t_out - b = (t(3)**2*(u1%Cn1 - u2%Cn1) + t(2)**2*(-u1%Cn1 + u3%Cn1))* scaleFactor - c = ( (t(2)-t(3))*u1%Cn1 + t(3)*u2%Cn1 - t(2)*u3%Cn1 ) * scaleFactor - u_out%Cn1 = u1%Cn1 + b + c * t_out - b = (t(3)**2*(u1%Cn2 - u2%Cn2) + t(2)**2*(-u1%Cn2 + u3%Cn2))* scaleFactor - c = ( (t(2)-t(3))*u1%Cn2 + t(3)*u2%Cn2 - t(2)*u3%Cn2 ) * scaleFactor - u_out%Cn2 = u1%Cn2 + b + c * t_out - b = (t(3)**2*(u1%St_sh - u2%St_sh) + t(2)**2*(-u1%St_sh + u3%St_sh))* scaleFactor - c = ( (t(2)-t(3))*u1%St_sh + t(3)*u2%St_sh - t(2)*u3%St_sh ) * scaleFactor - u_out%St_sh = u1%St_sh + b + c * t_out - b = (t(3)**2*(u1%Cd0 - u2%Cd0) + t(2)**2*(-u1%Cd0 + u3%Cd0))* scaleFactor - c = ( (t(2)-t(3))*u1%Cd0 + t(3)*u2%Cd0 - t(2)*u3%Cd0 ) * scaleFactor - u_out%Cd0 = u1%Cd0 + b + c * t_out - b = (t(3)**2*(u1%Cm0 - u2%Cm0) + t(2)**2*(-u1%Cm0 + u3%Cm0))* scaleFactor - c = ( (t(2)-t(3))*u1%Cm0 + t(3)*u2%Cm0 - t(2)*u3%Cm0 ) * scaleFactor - u_out%Cm0 = u1%Cm0 + b + c * t_out - b = (t(3)**2*(u1%k0 - u2%k0) + t(2)**2*(-u1%k0 + u3%k0))* scaleFactor - c = ( (t(2)-t(3))*u1%k0 + t(3)*u2%k0 - t(2)*u3%k0 ) * scaleFactor - u_out%k0 = u1%k0 + b + c * t_out - b = (t(3)**2*(u1%k1 - u2%k1) + t(2)**2*(-u1%k1 + u3%k1))* scaleFactor - c = ( (t(2)-t(3))*u1%k1 + t(3)*u2%k1 - t(2)*u3%k1 ) * scaleFactor - u_out%k1 = u1%k1 + b + c * t_out - b = (t(3)**2*(u1%k2 - u2%k2) + t(2)**2*(-u1%k2 + u3%k2))* scaleFactor - c = ( (t(2)-t(3))*u1%k2 + t(3)*u2%k2 - t(2)*u3%k2 ) * scaleFactor - u_out%k2 = u1%k2 + b + c * t_out - b = (t(3)**2*(u1%k3 - u2%k3) + t(2)**2*(-u1%k3 + u3%k3))* scaleFactor - c = ( (t(2)-t(3))*u1%k3 + t(3)*u2%k3 - t(2)*u3%k3 ) * scaleFactor - u_out%k3 = u1%k3 + b + c * t_out - b = (t(3)**2*(u1%k1_hat - u2%k1_hat) + t(2)**2*(-u1%k1_hat + u3%k1_hat))* scaleFactor - c = ( (t(2)-t(3))*u1%k1_hat + t(3)*u2%k1_hat - t(2)*u3%k1_hat ) * scaleFactor - u_out%k1_hat = u1%k1_hat + b + c * t_out - b = (t(3)**2*(u1%x_cp_bar - u2%x_cp_bar) + t(2)**2*(-u1%x_cp_bar + u3%x_cp_bar))* scaleFactor - c = ( (t(2)-t(3))*u1%x_cp_bar + t(3)*u2%x_cp_bar - t(2)*u3%x_cp_bar ) * scaleFactor - u_out%x_cp_bar = u1%x_cp_bar + b + c * t_out - b = (t(3)**2*(u1%UACutout - u2%UACutout) + t(2)**2*(-u1%UACutout + u3%UACutout))* scaleFactor - c = ( (t(2)-t(3))*u1%UACutout + t(3)*u2%UACutout - t(2)*u3%UACutout ) * scaleFactor - u_out%UACutout = u1%UACutout + b + c * t_out - b = (t(3)**2*(u1%UACutout_delta - u2%UACutout_delta) + t(2)**2*(-u1%UACutout_delta + u3%UACutout_delta))* scaleFactor - c = ( (t(2)-t(3))*u1%UACutout_delta + t(3)*u2%UACutout_delta - t(2)*u3%UACutout_delta ) * scaleFactor - u_out%UACutout_delta = u1%UACutout_delta + b + c * t_out - b = (t(3)**2*(u1%UACutout_blend - u2%UACutout_blend) + t(2)**2*(-u1%UACutout_blend + u3%UACutout_blend))* scaleFactor - c = ( (t(2)-t(3))*u1%UACutout_blend + t(3)*u2%UACutout_blend - t(2)*u3%UACutout_blend ) * scaleFactor - u_out%UACutout_blend = u1%UACutout_blend + b + c * t_out - b = (t(3)**2*(u1%filtCutOff - u2%filtCutOff) + t(2)**2*(-u1%filtCutOff + u3%filtCutOff))* scaleFactor - c = ( (t(2)-t(3))*u1%filtCutOff + t(3)*u2%filtCutOff - t(2)*u3%filtCutOff ) * scaleFactor - u_out%filtCutOff = u1%filtCutOff + b + c * t_out - CALL Angles_ExtrapInterp( u1%alphaUpper, u2%alphaUpper, u3%alphaUpper, tin, u_out%alphaUpper, tin_out ) - CALL Angles_ExtrapInterp( u1%alphaLower, u2%alphaLower, u3%alphaLower, tin, u_out%alphaLower, tin_out ) - b = (t(3)**2*(u1%c_Rate - u2%c_Rate) + t(2)**2*(-u1%c_Rate + u3%c_Rate))* scaleFactor - c = ( (t(2)-t(3))*u1%c_Rate + t(3)*u2%c_Rate - t(2)*u3%c_Rate ) * scaleFactor - u_out%c_Rate = u1%c_Rate + b + c * t_out - b = (t(3)**2*(u1%c_RateUpper - u2%c_RateUpper) + t(2)**2*(-u1%c_RateUpper + u3%c_RateUpper))* scaleFactor - c = ( (t(2)-t(3))*u1%c_RateUpper + t(3)*u2%c_RateUpper - t(2)*u3%c_RateUpper ) * scaleFactor - u_out%c_RateUpper = u1%c_RateUpper + b + c * t_out - b = (t(3)**2*(u1%c_RateLower - u2%c_RateLower) + t(2)**2*(-u1%c_RateLower + u3%c_RateLower))* scaleFactor - c = ( (t(2)-t(3))*u1%c_RateLower + t(3)*u2%c_RateLower - t(2)*u3%c_RateLower ) * scaleFactor - u_out%c_RateLower = u1%c_RateLower + b + c * t_out - b = (t(3)**2*(u1%c_alphaLower - u2%c_alphaLower) + t(2)**2*(-u1%c_alphaLower + u3%c_alphaLower))* scaleFactor - c = ( (t(2)-t(3))*u1%c_alphaLower + t(3)*u2%c_alphaLower - t(2)*u3%c_alphaLower ) * scaleFactor - u_out%c_alphaLower = u1%c_alphaLower + b + c * t_out - b = (t(3)**2*(u1%c_alphaUpper - u2%c_alphaUpper) + t(2)**2*(-u1%c_alphaUpper + u3%c_alphaUpper))* scaleFactor - c = ( (t(2)-t(3))*u1%c_alphaUpper + t(3)*u2%c_alphaUpper - t(2)*u3%c_alphaUpper ) * scaleFactor - u_out%c_alphaUpper = u1%c_alphaUpper + b + c * t_out - CALL Angles_ExtrapInterp( u1%alphaUpperWrap, u2%alphaUpperWrap, u3%alphaUpperWrap, tin, u_out%alphaUpperWrap, tin_out ) - CALL Angles_ExtrapInterp( u1%alphaLowerWrap, u2%alphaLowerWrap, u3%alphaLowerWrap, tin, u_out%alphaLowerWrap, tin_out ) - b = (t(3)**2*(u1%c_RateWrap - u2%c_RateWrap) + t(2)**2*(-u1%c_RateWrap + u3%c_RateWrap))* scaleFactor - c = ( (t(2)-t(3))*u1%c_RateWrap + t(3)*u2%c_RateWrap - t(2)*u3%c_RateWrap ) * scaleFactor - u_out%c_RateWrap = u1%c_RateWrap + b + c * t_out - b = (t(3)**2*(u1%c_alphaLowerWrap - u2%c_alphaLowerWrap) + t(2)**2*(-u1%c_alphaLowerWrap + u3%c_alphaLowerWrap))* scaleFactor - c = ( (t(2)-t(3))*u1%c_alphaLowerWrap + t(3)*u2%c_alphaLowerWrap - t(2)*u3%c_alphaLowerWrap ) * scaleFactor - u_out%c_alphaLowerWrap = u1%c_alphaLowerWrap + b + c * t_out - b = (t(3)**2*(u1%c_alphaUpperWrap - u2%c_alphaUpperWrap) + t(2)**2*(-u1%c_alphaUpperWrap + u3%c_alphaUpperWrap))* scaleFactor - c = ( (t(2)-t(3))*u1%c_alphaUpperWrap + t(3)*u2%c_alphaUpperWrap - t(2)*u3%c_alphaUpperWrap ) * scaleFactor - u_out%c_alphaUpperWrap = u1%c_alphaUpperWrap + b + c * t_out - END SUBROUTINE AFI_UA_BL_Type_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL Angles_ExtrapInterp( u1%alpha0, u2%alpha0, u3%alpha0, tin, u_out%alpha0, tin_out ) + CALL Angles_ExtrapInterp( u1%alpha1, u2%alpha1, u3%alpha1, tin, u_out%alpha1, tin_out ) + CALL Angles_ExtrapInterp( u1%alpha2, u2%alpha2, u3%alpha2, tin, u_out%alpha2, tin_out ) + u_out%eta_e = a1*u1%eta_e + a2*u2%eta_e + a3*u3%eta_e + u_out%C_nalpha = a1*u1%C_nalpha + a2*u2%C_nalpha + a3*u3%C_nalpha + u_out%C_lalpha = a1*u1%C_lalpha + a2*u2%C_lalpha + a3*u3%C_lalpha + u_out%T_f0 = a1*u1%T_f0 + a2*u2%T_f0 + a3*u3%T_f0 + u_out%T_V0 = a1*u1%T_V0 + a2*u2%T_V0 + a3*u3%T_V0 + u_out%T_p = a1*u1%T_p + a2*u2%T_p + a3*u3%T_p + u_out%T_VL = a1*u1%T_VL + a2*u2%T_VL + a3*u3%T_VL + u_out%b1 = a1*u1%b1 + a2*u2%b1 + a3*u3%b1 + u_out%b2 = a1*u1%b2 + a2*u2%b2 + a3*u3%b2 + u_out%b5 = a1*u1%b5 + a2*u2%b5 + a3*u3%b5 + u_out%A1 = a1*u1%A1 + a2*u2%A1 + a3*u3%A1 + u_out%A2 = a1*u1%A2 + a2*u2%A2 + a3*u3%A2 + u_out%A5 = a1*u1%A5 + a2*u2%A5 + a3*u3%A5 + u_out%S1 = a1*u1%S1 + a2*u2%S1 + a3*u3%S1 + u_out%S2 = a1*u1%S2 + a2*u2%S2 + a3*u3%S2 + u_out%S3 = a1*u1%S3 + a2*u2%S3 + a3*u3%S3 + u_out%S4 = a1*u1%S4 + a2*u2%S4 + a3*u3%S4 + u_out%Cn1 = a1*u1%Cn1 + a2*u2%Cn1 + a3*u3%Cn1 + u_out%Cn2 = a1*u1%Cn2 + a2*u2%Cn2 + a3*u3%Cn2 + u_out%St_sh = a1*u1%St_sh + a2*u2%St_sh + a3*u3%St_sh + u_out%Cd0 = a1*u1%Cd0 + a2*u2%Cd0 + a3*u3%Cd0 + u_out%Cm0 = a1*u1%Cm0 + a2*u2%Cm0 + a3*u3%Cm0 + u_out%k0 = a1*u1%k0 + a2*u2%k0 + a3*u3%k0 + u_out%k1 = a1*u1%k1 + a2*u2%k1 + a3*u3%k1 + u_out%k2 = a1*u1%k2 + a2*u2%k2 + a3*u3%k2 + u_out%k3 = a1*u1%k3 + a2*u2%k3 + a3*u3%k3 + u_out%k1_hat = a1*u1%k1_hat + a2*u2%k1_hat + a3*u3%k1_hat + u_out%x_cp_bar = a1*u1%x_cp_bar + a2*u2%x_cp_bar + a3*u3%x_cp_bar + u_out%UACutout = a1*u1%UACutout + a2*u2%UACutout + a3*u3%UACutout + u_out%UACutout_delta = a1*u1%UACutout_delta + a2*u2%UACutout_delta + a3*u3%UACutout_delta + u_out%UACutout_blend = a1*u1%UACutout_blend + a2*u2%UACutout_blend + a3*u3%UACutout_blend + u_out%filtCutOff = a1*u1%filtCutOff + a2*u2%filtCutOff + a3*u3%filtCutOff + CALL Angles_ExtrapInterp( u1%alphaUpper, u2%alphaUpper, u3%alphaUpper, tin, u_out%alphaUpper, tin_out ) + CALL Angles_ExtrapInterp( u1%alphaLower, u2%alphaLower, u3%alphaLower, tin, u_out%alphaLower, tin_out ) + u_out%c_Rate = a1*u1%c_Rate + a2*u2%c_Rate + a3*u3%c_Rate + u_out%c_RateUpper = a1*u1%c_RateUpper + a2*u2%c_RateUpper + a3*u3%c_RateUpper + u_out%c_RateLower = a1*u1%c_RateLower + a2*u2%c_RateLower + a3*u3%c_RateLower + u_out%c_alphaLower = a1*u1%c_alphaLower + a2*u2%c_alphaLower + a3*u3%c_alphaLower + u_out%c_alphaUpper = a1*u1%c_alphaUpper + a2*u2%c_alphaUpper + a3*u3%c_alphaUpper + CALL Angles_ExtrapInterp( u1%alphaUpperWrap, u2%alphaUpperWrap, u3%alphaUpperWrap, tin, u_out%alphaUpperWrap, tin_out ) + CALL Angles_ExtrapInterp( u1%alphaLowerWrap, u2%alphaLowerWrap, u3%alphaLowerWrap, tin, u_out%alphaLowerWrap, tin_out ) + u_out%c_RateWrap = a1*u1%c_RateWrap + a2*u2%c_RateWrap + a3*u3%c_RateWrap + u_out%c_alphaLowerWrap = a1*u1%c_alphaLowerWrap + a2*u2%c_alphaLowerWrap + a3*u3%c_alphaLowerWrap + u_out%c_alphaUpperWrap = a1*u1%c_alphaUpperWrap + a2*u2%c_alphaUpperWrap + a3*u3%c_alphaUpperWrap +END SUBROUTINE END MODULE AirfoilInfo_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/BEMT_Types.f90 b/modules/aerodyn/src/BEMT_Types.f90 index 4d04f21756..7f863d8a46 100644 --- a/modules/aerodyn/src/BEMT_Types.f90 +++ b/modules/aerodyn/src/BEMT_Types.f90 @@ -3018,58 +3018,59 @@ subroutine BEMT_UnPackOutput(Buf, OutData) end if end subroutine - SUBROUTINE BEMT_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(BEMT_InputType), INTENT(IN) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(BEMT_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None +subroutine BEMT_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time + ! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(BEMT_InputType), intent(in) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(BEMT_InputType), intent(inout) :: u_out ! Input at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_Input_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(u)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(u) - 1 - IF ( order .eq. 0 ) THEN - CALL BEMT_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL BEMT_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL BEMT_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE BEMT_Input_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'BEMT_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call BEMT_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call BEMT_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call BEMT_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE BEMT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE BEMT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 1. @@ -3081,155 +3082,87 @@ SUBROUTINE BEMT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(BEMT_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 - TYPE(BEMT_InputType), INTENT(IN) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(BEMT_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(BEMT_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 + TYPE(BEMT_InputType), INTENT(IN) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(BEMT_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_Input_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF - - ScaleFactor = t_out / t(2) -IF (ALLOCATED(u_out%theta) .AND. ALLOCATED(u1%theta)) THEN - DO i2 = LBOUND(u_out%theta,2),UBOUND(u_out%theta,2) - DO i1 = LBOUND(u_out%theta,1),UBOUND(u_out%theta,1) - b = -(u1%theta(i1,i2) - u2%theta(i1,i2)) - u_out%theta(i1,i2) = u1%theta(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated - b = -(u1%chi0 - u2%chi0) - u_out%chi0 = u1%chi0 + b * ScaleFactor - b = -(u1%psiSkewOffset - u2%psiSkewOffset) - u_out%psiSkewOffset = u1%psiSkewOffset + b * ScaleFactor -IF (ALLOCATED(u_out%psi) .AND. ALLOCATED(u1%psi)) THEN - DO i1 = LBOUND(u_out%psi,1),UBOUND(u_out%psi,1) - b = -(u1%psi(i1) - u2%psi(i1)) - u_out%psi(i1) = u1%psi(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - b = -(u1%omega - u2%omega) - u_out%omega = u1%omega + b * ScaleFactor - b = -(u1%TSR - u2%TSR) - u_out%TSR = u1%TSR + b * ScaleFactor -IF (ALLOCATED(u_out%Vx) .AND. ALLOCATED(u1%Vx)) THEN - DO i2 = LBOUND(u_out%Vx,2),UBOUND(u_out%Vx,2) - DO i1 = LBOUND(u_out%Vx,1),UBOUND(u_out%Vx,1) - b = -(u1%Vx(i1,i2) - u2%Vx(i1,i2)) - u_out%Vx(i1,i2) = u1%Vx(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Vy) .AND. ALLOCATED(u1%Vy)) THEN - DO i2 = LBOUND(u_out%Vy,2),UBOUND(u_out%Vy,2) - DO i1 = LBOUND(u_out%Vy,1),UBOUND(u_out%Vy,1) - b = -(u1%Vy(i1,i2) - u2%Vy(i1,i2)) - u_out%Vy(i1,i2) = u1%Vy(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Vz) .AND. ALLOCATED(u1%Vz)) THEN - DO i2 = LBOUND(u_out%Vz,2),UBOUND(u_out%Vz,2) - DO i1 = LBOUND(u_out%Vz,1),UBOUND(u_out%Vz,1) - b = -(u1%Vz(i1,i2) - u2%Vz(i1,i2)) - u_out%Vz(i1,i2) = u1%Vz(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%omega_z) .AND. ALLOCATED(u1%omega_z)) THEN - DO i2 = LBOUND(u_out%omega_z,2),UBOUND(u_out%omega_z,2) - DO i1 = LBOUND(u_out%omega_z,1),UBOUND(u_out%omega_z,1) - b = -(u1%omega_z(i1,i2) - u2%omega_z(i1,i2)) - u_out%omega_z(i1,i2) = u1%omega_z(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%xVelCorr) .AND. ALLOCATED(u1%xVelCorr)) THEN - DO i2 = LBOUND(u_out%xVelCorr,2),UBOUND(u_out%xVelCorr,2) - DO i1 = LBOUND(u_out%xVelCorr,1),UBOUND(u_out%xVelCorr,1) - b = -(u1%xVelCorr(i1,i2) - u2%xVelCorr(i1,i2)) - u_out%xVelCorr(i1,i2) = u1%xVelCorr(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%rLocal) .AND. ALLOCATED(u1%rLocal)) THEN - DO i2 = LBOUND(u_out%rLocal,2),UBOUND(u_out%rLocal,2) - DO i1 = LBOUND(u_out%rLocal,1),UBOUND(u_out%rLocal,1) - b = -(u1%rLocal(i1,i2) - u2%rLocal(i1,i2)) - u_out%rLocal(i1,i2) = u1%rLocal(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated - b = -(u1%Un_disk - u2%Un_disk) - u_out%Un_disk = u1%Un_disk + b * ScaleFactor - DO i1 = LBOUND(u_out%V0,1),UBOUND(u_out%V0,1) - b = -(u1%V0(i1) - u2%V0(i1)) - u_out%V0(i1) = u1%V0(i1) + b * ScaleFactor - END DO - DO i1 = LBOUND(u_out%x_hat_disk,1),UBOUND(u_out%x_hat_disk,1) - b = -(u1%x_hat_disk(i1) - u2%x_hat_disk(i1)) - u_out%x_hat_disk(i1) = u1%x_hat_disk(i1) + b * ScaleFactor - END DO -IF (ALLOCATED(u_out%UserProp) .AND. ALLOCATED(u1%UserProp)) THEN - DO i2 = LBOUND(u_out%UserProp,2),UBOUND(u_out%UserProp,2) - DO i1 = LBOUND(u_out%UserProp,1),UBOUND(u_out%UserProp,1) - b = -(u1%UserProp(i1,i2) - u2%UserProp(i1,i2)) - u_out%UserProp(i1,i2) = u1%UserProp(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%CantAngle) .AND. ALLOCATED(u1%CantAngle)) THEN - DO i2 = LBOUND(u_out%CantAngle,2),UBOUND(u_out%CantAngle,2) - DO i1 = LBOUND(u_out%CantAngle,1),UBOUND(u_out%CantAngle,1) - b = -(u1%CantAngle(i1,i2) - u2%CantAngle(i1,i2)) - u_out%CantAngle(i1,i2) = u1%CantAngle(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%drdz) .AND. ALLOCATED(u1%drdz)) THEN - DO i2 = LBOUND(u_out%drdz,2),UBOUND(u_out%drdz,2) - DO i1 = LBOUND(u_out%drdz,1),UBOUND(u_out%drdz,1) - b = -(u1%drdz(i1,i2) - u2%drdz(i1,i2)) - u_out%drdz(i1,i2) = u1%drdz(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%toeAngle) .AND. ALLOCATED(u1%toeAngle)) THEN - DO i2 = LBOUND(u_out%toeAngle,2),UBOUND(u_out%toeAngle,2) - DO i1 = LBOUND(u_out%toeAngle,1),UBOUND(u_out%toeAngle,1) - b = -(u1%toeAngle(i1,i2) - u2%toeAngle(i1,i2)) - u_out%toeAngle(i1,i2) = u1%toeAngle(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated - END SUBROUTINE BEMT_Input_ExtrapInterp1 - - - SUBROUTINE BEMT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(u_out%theta) .AND. ALLOCATED(u1%theta)) THEN + u_out%theta = a1*u1%theta + a2*u2%theta + END IF ! check if allocated + u_out%chi0 = a1*u1%chi0 + a2*u2%chi0 + u_out%psiSkewOffset = a1*u1%psiSkewOffset + a2*u2%psiSkewOffset + IF (ALLOCATED(u_out%psi) .AND. ALLOCATED(u1%psi)) THEN + u_out%psi = a1*u1%psi + a2*u2%psi + END IF ! check if allocated + u_out%omega = a1*u1%omega + a2*u2%omega + u_out%TSR = a1*u1%TSR + a2*u2%TSR + IF (ALLOCATED(u_out%Vx) .AND. ALLOCATED(u1%Vx)) THEN + u_out%Vx = a1*u1%Vx + a2*u2%Vx + END IF ! check if allocated + IF (ALLOCATED(u_out%Vy) .AND. ALLOCATED(u1%Vy)) THEN + u_out%Vy = a1*u1%Vy + a2*u2%Vy + END IF ! check if allocated + IF (ALLOCATED(u_out%Vz) .AND. ALLOCATED(u1%Vz)) THEN + u_out%Vz = a1*u1%Vz + a2*u2%Vz + END IF ! check if allocated + IF (ALLOCATED(u_out%omega_z) .AND. ALLOCATED(u1%omega_z)) THEN + u_out%omega_z = a1*u1%omega_z + a2*u2%omega_z + END IF ! check if allocated + IF (ALLOCATED(u_out%xVelCorr) .AND. ALLOCATED(u1%xVelCorr)) THEN + u_out%xVelCorr = a1*u1%xVelCorr + a2*u2%xVelCorr + END IF ! check if allocated + IF (ALLOCATED(u_out%rLocal) .AND. ALLOCATED(u1%rLocal)) THEN + u_out%rLocal = a1*u1%rLocal + a2*u2%rLocal + END IF ! check if allocated + u_out%Un_disk = a1*u1%Un_disk + a2*u2%Un_disk + u_out%V0 = a1*u1%V0 + a2*u2%V0 + u_out%x_hat_disk = a1*u1%x_hat_disk + a2*u2%x_hat_disk + IF (ALLOCATED(u_out%UserProp) .AND. ALLOCATED(u1%UserProp)) THEN + u_out%UserProp = a1*u1%UserProp + a2*u2%UserProp + END IF ! check if allocated + IF (ALLOCATED(u_out%CantAngle) .AND. ALLOCATED(u1%CantAngle)) THEN + u_out%CantAngle = a1*u1%CantAngle + a2*u2%CantAngle + END IF ! check if allocated + IF (ALLOCATED(u_out%drdz) .AND. ALLOCATED(u1%drdz)) THEN + u_out%drdz = a1*u1%drdz + a2*u2%drdz + END IF ! check if allocated + IF (ALLOCATED(u_out%toeAngle) .AND. ALLOCATED(u1%toeAngle)) THEN + u_out%toeAngle = a1*u1%toeAngle + a2*u2%toeAngle + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE BEMT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 2. @@ -3243,234 +3176,147 @@ SUBROUTINE BEMT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - TYPE(BEMT_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 - TYPE(BEMT_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 - TYPE(BEMT_InputType), INTENT(IN) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(BEMT_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(BEMT_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 + TYPE(BEMT_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 + TYPE(BEMT_InputType), INTENT(IN) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(BEMT_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_Input_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) -IF (ALLOCATED(u_out%theta) .AND. ALLOCATED(u1%theta)) THEN - DO i2 = LBOUND(u_out%theta,2),UBOUND(u_out%theta,2) - DO i1 = LBOUND(u_out%theta,1),UBOUND(u_out%theta,1) - b = (t(3)**2*(u1%theta(i1,i2) - u2%theta(i1,i2)) + t(2)**2*(-u1%theta(i1,i2) + u3%theta(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%theta(i1,i2) + t(3)*u2%theta(i1,i2) - t(2)*u3%theta(i1,i2) ) * scaleFactor - u_out%theta(i1,i2) = u1%theta(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated - b = (t(3)**2*(u1%chi0 - u2%chi0) + t(2)**2*(-u1%chi0 + u3%chi0))* scaleFactor - c = ( (t(2)-t(3))*u1%chi0 + t(3)*u2%chi0 - t(2)*u3%chi0 ) * scaleFactor - u_out%chi0 = u1%chi0 + b + c * t_out - b = (t(3)**2*(u1%psiSkewOffset - u2%psiSkewOffset) + t(2)**2*(-u1%psiSkewOffset + u3%psiSkewOffset))* scaleFactor - c = ( (t(2)-t(3))*u1%psiSkewOffset + t(3)*u2%psiSkewOffset - t(2)*u3%psiSkewOffset ) * scaleFactor - u_out%psiSkewOffset = u1%psiSkewOffset + b + c * t_out -IF (ALLOCATED(u_out%psi) .AND. ALLOCATED(u1%psi)) THEN - DO i1 = LBOUND(u_out%psi,1),UBOUND(u_out%psi,1) - b = (t(3)**2*(u1%psi(i1) - u2%psi(i1)) + t(2)**2*(-u1%psi(i1) + u3%psi(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%psi(i1) + t(3)*u2%psi(i1) - t(2)*u3%psi(i1) ) * scaleFactor - u_out%psi(i1) = u1%psi(i1) + b + c * t_out - END DO -END IF ! check if allocated - b = (t(3)**2*(u1%omega - u2%omega) + t(2)**2*(-u1%omega + u3%omega))* scaleFactor - c = ( (t(2)-t(3))*u1%omega + t(3)*u2%omega - t(2)*u3%omega ) * scaleFactor - u_out%omega = u1%omega + b + c * t_out - b = (t(3)**2*(u1%TSR - u2%TSR) + t(2)**2*(-u1%TSR + u3%TSR))* scaleFactor - c = ( (t(2)-t(3))*u1%TSR + t(3)*u2%TSR - t(2)*u3%TSR ) * scaleFactor - u_out%TSR = u1%TSR + b + c * t_out -IF (ALLOCATED(u_out%Vx) .AND. ALLOCATED(u1%Vx)) THEN - DO i2 = LBOUND(u_out%Vx,2),UBOUND(u_out%Vx,2) - DO i1 = LBOUND(u_out%Vx,1),UBOUND(u_out%Vx,1) - b = (t(3)**2*(u1%Vx(i1,i2) - u2%Vx(i1,i2)) + t(2)**2*(-u1%Vx(i1,i2) + u3%Vx(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%Vx(i1,i2) + t(3)*u2%Vx(i1,i2) - t(2)*u3%Vx(i1,i2) ) * scaleFactor - u_out%Vx(i1,i2) = u1%Vx(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Vy) .AND. ALLOCATED(u1%Vy)) THEN - DO i2 = LBOUND(u_out%Vy,2),UBOUND(u_out%Vy,2) - DO i1 = LBOUND(u_out%Vy,1),UBOUND(u_out%Vy,1) - b = (t(3)**2*(u1%Vy(i1,i2) - u2%Vy(i1,i2)) + t(2)**2*(-u1%Vy(i1,i2) + u3%Vy(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%Vy(i1,i2) + t(3)*u2%Vy(i1,i2) - t(2)*u3%Vy(i1,i2) ) * scaleFactor - u_out%Vy(i1,i2) = u1%Vy(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Vz) .AND. ALLOCATED(u1%Vz)) THEN - DO i2 = LBOUND(u_out%Vz,2),UBOUND(u_out%Vz,2) - DO i1 = LBOUND(u_out%Vz,1),UBOUND(u_out%Vz,1) - b = (t(3)**2*(u1%Vz(i1,i2) - u2%Vz(i1,i2)) + t(2)**2*(-u1%Vz(i1,i2) + u3%Vz(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%Vz(i1,i2) + t(3)*u2%Vz(i1,i2) - t(2)*u3%Vz(i1,i2) ) * scaleFactor - u_out%Vz(i1,i2) = u1%Vz(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%omega_z) .AND. ALLOCATED(u1%omega_z)) THEN - DO i2 = LBOUND(u_out%omega_z,2),UBOUND(u_out%omega_z,2) - DO i1 = LBOUND(u_out%omega_z,1),UBOUND(u_out%omega_z,1) - b = (t(3)**2*(u1%omega_z(i1,i2) - u2%omega_z(i1,i2)) + t(2)**2*(-u1%omega_z(i1,i2) + u3%omega_z(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%omega_z(i1,i2) + t(3)*u2%omega_z(i1,i2) - t(2)*u3%omega_z(i1,i2) ) * scaleFactor - u_out%omega_z(i1,i2) = u1%omega_z(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%xVelCorr) .AND. ALLOCATED(u1%xVelCorr)) THEN - DO i2 = LBOUND(u_out%xVelCorr,2),UBOUND(u_out%xVelCorr,2) - DO i1 = LBOUND(u_out%xVelCorr,1),UBOUND(u_out%xVelCorr,1) - b = (t(3)**2*(u1%xVelCorr(i1,i2) - u2%xVelCorr(i1,i2)) + t(2)**2*(-u1%xVelCorr(i1,i2) + u3%xVelCorr(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%xVelCorr(i1,i2) + t(3)*u2%xVelCorr(i1,i2) - t(2)*u3%xVelCorr(i1,i2) ) * scaleFactor - u_out%xVelCorr(i1,i2) = u1%xVelCorr(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%rLocal) .AND. ALLOCATED(u1%rLocal)) THEN - DO i2 = LBOUND(u_out%rLocal,2),UBOUND(u_out%rLocal,2) - DO i1 = LBOUND(u_out%rLocal,1),UBOUND(u_out%rLocal,1) - b = (t(3)**2*(u1%rLocal(i1,i2) - u2%rLocal(i1,i2)) + t(2)**2*(-u1%rLocal(i1,i2) + u3%rLocal(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%rLocal(i1,i2) + t(3)*u2%rLocal(i1,i2) - t(2)*u3%rLocal(i1,i2) ) * scaleFactor - u_out%rLocal(i1,i2) = u1%rLocal(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated - b = (t(3)**2*(u1%Un_disk - u2%Un_disk) + t(2)**2*(-u1%Un_disk + u3%Un_disk))* scaleFactor - c = ( (t(2)-t(3))*u1%Un_disk + t(3)*u2%Un_disk - t(2)*u3%Un_disk ) * scaleFactor - u_out%Un_disk = u1%Un_disk + b + c * t_out - DO i1 = LBOUND(u_out%V0,1),UBOUND(u_out%V0,1) - b = (t(3)**2*(u1%V0(i1) - u2%V0(i1)) + t(2)**2*(-u1%V0(i1) + u3%V0(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%V0(i1) + t(3)*u2%V0(i1) - t(2)*u3%V0(i1) ) * scaleFactor - u_out%V0(i1) = u1%V0(i1) + b + c * t_out - END DO - DO i1 = LBOUND(u_out%x_hat_disk,1),UBOUND(u_out%x_hat_disk,1) - b = (t(3)**2*(u1%x_hat_disk(i1) - u2%x_hat_disk(i1)) + t(2)**2*(-u1%x_hat_disk(i1) + u3%x_hat_disk(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%x_hat_disk(i1) + t(3)*u2%x_hat_disk(i1) - t(2)*u3%x_hat_disk(i1) ) * scaleFactor - u_out%x_hat_disk(i1) = u1%x_hat_disk(i1) + b + c * t_out - END DO -IF (ALLOCATED(u_out%UserProp) .AND. ALLOCATED(u1%UserProp)) THEN - DO i2 = LBOUND(u_out%UserProp,2),UBOUND(u_out%UserProp,2) - DO i1 = LBOUND(u_out%UserProp,1),UBOUND(u_out%UserProp,1) - b = (t(3)**2*(u1%UserProp(i1,i2) - u2%UserProp(i1,i2)) + t(2)**2*(-u1%UserProp(i1,i2) + u3%UserProp(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%UserProp(i1,i2) + t(3)*u2%UserProp(i1,i2) - t(2)*u3%UserProp(i1,i2) ) * scaleFactor - u_out%UserProp(i1,i2) = u1%UserProp(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%CantAngle) .AND. ALLOCATED(u1%CantAngle)) THEN - DO i2 = LBOUND(u_out%CantAngle,2),UBOUND(u_out%CantAngle,2) - DO i1 = LBOUND(u_out%CantAngle,1),UBOUND(u_out%CantAngle,1) - b = (t(3)**2*(u1%CantAngle(i1,i2) - u2%CantAngle(i1,i2)) + t(2)**2*(-u1%CantAngle(i1,i2) + u3%CantAngle(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%CantAngle(i1,i2) + t(3)*u2%CantAngle(i1,i2) - t(2)*u3%CantAngle(i1,i2) ) * scaleFactor - u_out%CantAngle(i1,i2) = u1%CantAngle(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%drdz) .AND. ALLOCATED(u1%drdz)) THEN - DO i2 = LBOUND(u_out%drdz,2),UBOUND(u_out%drdz,2) - DO i1 = LBOUND(u_out%drdz,1),UBOUND(u_out%drdz,1) - b = (t(3)**2*(u1%drdz(i1,i2) - u2%drdz(i1,i2)) + t(2)**2*(-u1%drdz(i1,i2) + u3%drdz(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%drdz(i1,i2) + t(3)*u2%drdz(i1,i2) - t(2)*u3%drdz(i1,i2) ) * scaleFactor - u_out%drdz(i1,i2) = u1%drdz(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%toeAngle) .AND. ALLOCATED(u1%toeAngle)) THEN - DO i2 = LBOUND(u_out%toeAngle,2),UBOUND(u_out%toeAngle,2) - DO i1 = LBOUND(u_out%toeAngle,1),UBOUND(u_out%toeAngle,1) - b = (t(3)**2*(u1%toeAngle(i1,i2) - u2%toeAngle(i1,i2)) + t(2)**2*(-u1%toeAngle(i1,i2) + u3%toeAngle(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%toeAngle(i1,i2) + t(3)*u2%toeAngle(i1,i2) - t(2)*u3%toeAngle(i1,i2) ) * scaleFactor - u_out%toeAngle(i1,i2) = u1%toeAngle(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated - END SUBROUTINE BEMT_Input_ExtrapInterp2 - - - SUBROUTINE BEMT_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(BEMT_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(BEMT_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(u_out%theta) .AND. ALLOCATED(u1%theta)) THEN + u_out%theta = a1*u1%theta + a2*u2%theta + a3*u3%theta + END IF ! check if allocated + u_out%chi0 = a1*u1%chi0 + a2*u2%chi0 + a3*u3%chi0 + u_out%psiSkewOffset = a1*u1%psiSkewOffset + a2*u2%psiSkewOffset + a3*u3%psiSkewOffset + IF (ALLOCATED(u_out%psi) .AND. ALLOCATED(u1%psi)) THEN + u_out%psi = a1*u1%psi + a2*u2%psi + a3*u3%psi + END IF ! check if allocated + u_out%omega = a1*u1%omega + a2*u2%omega + a3*u3%omega + u_out%TSR = a1*u1%TSR + a2*u2%TSR + a3*u3%TSR + IF (ALLOCATED(u_out%Vx) .AND. ALLOCATED(u1%Vx)) THEN + u_out%Vx = a1*u1%Vx + a2*u2%Vx + a3*u3%Vx + END IF ! check if allocated + IF (ALLOCATED(u_out%Vy) .AND. ALLOCATED(u1%Vy)) THEN + u_out%Vy = a1*u1%Vy + a2*u2%Vy + a3*u3%Vy + END IF ! check if allocated + IF (ALLOCATED(u_out%Vz) .AND. ALLOCATED(u1%Vz)) THEN + u_out%Vz = a1*u1%Vz + a2*u2%Vz + a3*u3%Vz + END IF ! check if allocated + IF (ALLOCATED(u_out%omega_z) .AND. ALLOCATED(u1%omega_z)) THEN + u_out%omega_z = a1*u1%omega_z + a2*u2%omega_z + a3*u3%omega_z + END IF ! check if allocated + IF (ALLOCATED(u_out%xVelCorr) .AND. ALLOCATED(u1%xVelCorr)) THEN + u_out%xVelCorr = a1*u1%xVelCorr + a2*u2%xVelCorr + a3*u3%xVelCorr + END IF ! check if allocated + IF (ALLOCATED(u_out%rLocal) .AND. ALLOCATED(u1%rLocal)) THEN + u_out%rLocal = a1*u1%rLocal + a2*u2%rLocal + a3*u3%rLocal + END IF ! check if allocated + u_out%Un_disk = a1*u1%Un_disk + a2*u2%Un_disk + a3*u3%Un_disk + u_out%V0 = a1*u1%V0 + a2*u2%V0 + a3*u3%V0 + u_out%x_hat_disk = a1*u1%x_hat_disk + a2*u2%x_hat_disk + a3*u3%x_hat_disk + IF (ALLOCATED(u_out%UserProp) .AND. ALLOCATED(u1%UserProp)) THEN + u_out%UserProp = a1*u1%UserProp + a2*u2%UserProp + a3*u3%UserProp + END IF ! check if allocated + IF (ALLOCATED(u_out%CantAngle) .AND. ALLOCATED(u1%CantAngle)) THEN + u_out%CantAngle = a1*u1%CantAngle + a2*u2%CantAngle + a3*u3%CantAngle + END IF ! check if allocated + IF (ALLOCATED(u_out%drdz) .AND. ALLOCATED(u1%drdz)) THEN + u_out%drdz = a1*u1%drdz + a2*u2%drdz + a3*u3%drdz + END IF ! check if allocated + IF (ALLOCATED(u_out%toeAngle) .AND. ALLOCATED(u1%toeAngle)) THEN + u_out%toeAngle = a1*u1%toeAngle + a2*u2%toeAngle + a3*u3%toeAngle + END IF ! check if allocated +END SUBROUTINE + +subroutine BEMT_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time + ! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(BEMT_OutputType), intent(in) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(BEMT_OutputType), intent(inout) :: y_out ! Output at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_Output_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(y)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(y) - 1 - IF ( order .eq. 0 ) THEN - CALL BEMT_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL BEMT_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL BEMT_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE BEMT_Output_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'BEMT_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call BEMT_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call BEMT_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call BEMT_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE BEMT_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE BEMT_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 1. @@ -3482,179 +3328,95 @@ SUBROUTINE BEMT_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs ! !.................................................................................................................................. - TYPE(BEMT_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 - TYPE(BEMT_OutputType), INTENT(IN) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(BEMT_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(BEMT_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 + TYPE(BEMT_OutputType), INTENT(IN) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(BEMT_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_Output_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF - - ScaleFactor = t_out / t(2) -IF (ALLOCATED(y_out%Vrel) .AND. ALLOCATED(y1%Vrel)) THEN - DO i2 = LBOUND(y_out%Vrel,2),UBOUND(y_out%Vrel,2) - DO i1 = LBOUND(y_out%Vrel,1),UBOUND(y_out%Vrel,1) - b = -(y1%Vrel(i1,i2) - y2%Vrel(i1,i2)) - y_out%Vrel(i1,i2) = y1%Vrel(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%phi) .AND. ALLOCATED(y1%phi)) THEN - DO i2 = LBOUND(y_out%phi,2),UBOUND(y_out%phi,2) - DO i1 = LBOUND(y_out%phi,1),UBOUND(y_out%phi,1) - b = -(y1%phi(i1,i2) - y2%phi(i1,i2)) - y_out%phi(i1,i2) = y1%phi(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%axInduction) .AND. ALLOCATED(y1%axInduction)) THEN - DO i2 = LBOUND(y_out%axInduction,2),UBOUND(y_out%axInduction,2) - DO i1 = LBOUND(y_out%axInduction,1),UBOUND(y_out%axInduction,1) - b = -(y1%axInduction(i1,i2) - y2%axInduction(i1,i2)) - y_out%axInduction(i1,i2) = y1%axInduction(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%tanInduction) .AND. ALLOCATED(y1%tanInduction)) THEN - DO i2 = LBOUND(y_out%tanInduction,2),UBOUND(y_out%tanInduction,2) - DO i1 = LBOUND(y_out%tanInduction,1),UBOUND(y_out%tanInduction,1) - b = -(y1%tanInduction(i1,i2) - y2%tanInduction(i1,i2)) - y_out%tanInduction(i1,i2) = y1%tanInduction(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Re) .AND. ALLOCATED(y1%Re)) THEN - DO i2 = LBOUND(y_out%Re,2),UBOUND(y_out%Re,2) - DO i1 = LBOUND(y_out%Re,1),UBOUND(y_out%Re,1) - b = -(y1%Re(i1,i2) - y2%Re(i1,i2)) - y_out%Re(i1,i2) = y1%Re(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%AOA) .AND. ALLOCATED(y1%AOA)) THEN - DO i2 = LBOUND(y_out%AOA,2),UBOUND(y_out%AOA,2) - DO i1 = LBOUND(y_out%AOA,1),UBOUND(y_out%AOA,1) - b = -(y1%AOA(i1,i2) - y2%AOA(i1,i2)) - y_out%AOA(i1,i2) = y1%AOA(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cx) .AND. ALLOCATED(y1%Cx)) THEN - DO i2 = LBOUND(y_out%Cx,2),UBOUND(y_out%Cx,2) - DO i1 = LBOUND(y_out%Cx,1),UBOUND(y_out%Cx,1) - b = -(y1%Cx(i1,i2) - y2%Cx(i1,i2)) - y_out%Cx(i1,i2) = y1%Cx(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cy) .AND. ALLOCATED(y1%Cy)) THEN - DO i2 = LBOUND(y_out%Cy,2),UBOUND(y_out%Cy,2) - DO i1 = LBOUND(y_out%Cy,1),UBOUND(y_out%Cy,1) - b = -(y1%Cy(i1,i2) - y2%Cy(i1,i2)) - y_out%Cy(i1,i2) = y1%Cy(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cz) .AND. ALLOCATED(y1%Cz)) THEN - DO i2 = LBOUND(y_out%Cz,2),UBOUND(y_out%Cz,2) - DO i1 = LBOUND(y_out%Cz,1),UBOUND(y_out%Cz,1) - b = -(y1%Cz(i1,i2) - y2%Cz(i1,i2)) - y_out%Cz(i1,i2) = y1%Cz(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cmx) .AND. ALLOCATED(y1%Cmx)) THEN - DO i2 = LBOUND(y_out%Cmx,2),UBOUND(y_out%Cmx,2) - DO i1 = LBOUND(y_out%Cmx,1),UBOUND(y_out%Cmx,1) - b = -(y1%Cmx(i1,i2) - y2%Cmx(i1,i2)) - y_out%Cmx(i1,i2) = y1%Cmx(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cmy) .AND. ALLOCATED(y1%Cmy)) THEN - DO i2 = LBOUND(y_out%Cmy,2),UBOUND(y_out%Cmy,2) - DO i1 = LBOUND(y_out%Cmy,1),UBOUND(y_out%Cmy,1) - b = -(y1%Cmy(i1,i2) - y2%Cmy(i1,i2)) - y_out%Cmy(i1,i2) = y1%Cmy(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cmz) .AND. ALLOCATED(y1%Cmz)) THEN - DO i2 = LBOUND(y_out%Cmz,2),UBOUND(y_out%Cmz,2) - DO i1 = LBOUND(y_out%Cmz,1),UBOUND(y_out%Cmz,1) - b = -(y1%Cmz(i1,i2) - y2%Cmz(i1,i2)) - y_out%Cmz(i1,i2) = y1%Cmz(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cm) .AND. ALLOCATED(y1%Cm)) THEN - DO i2 = LBOUND(y_out%Cm,2),UBOUND(y_out%Cm,2) - DO i1 = LBOUND(y_out%Cm,1),UBOUND(y_out%Cm,1) - b = -(y1%Cm(i1,i2) - y2%Cm(i1,i2)) - y_out%Cm(i1,i2) = y1%Cm(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cl) .AND. ALLOCATED(y1%Cl)) THEN - DO i2 = LBOUND(y_out%Cl,2),UBOUND(y_out%Cl,2) - DO i1 = LBOUND(y_out%Cl,1),UBOUND(y_out%Cl,1) - b = -(y1%Cl(i1,i2) - y2%Cl(i1,i2)) - y_out%Cl(i1,i2) = y1%Cl(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cd) .AND. ALLOCATED(y1%Cd)) THEN - DO i2 = LBOUND(y_out%Cd,2),UBOUND(y_out%Cd,2) - DO i1 = LBOUND(y_out%Cd,1),UBOUND(y_out%Cd,1) - b = -(y1%Cd(i1,i2) - y2%Cd(i1,i2)) - y_out%Cd(i1,i2) = y1%Cd(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%chi) .AND. ALLOCATED(y1%chi)) THEN - DO i2 = LBOUND(y_out%chi,2),UBOUND(y_out%chi,2) - DO i1 = LBOUND(y_out%chi,1),UBOUND(y_out%chi,1) - b = -(y1%chi(i1,i2) - y2%chi(i1,i2)) - y_out%chi(i1,i2) = y1%chi(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cpmin) .AND. ALLOCATED(y1%Cpmin)) THEN - DO i2 = LBOUND(y_out%Cpmin,2),UBOUND(y_out%Cpmin,2) - DO i1 = LBOUND(y_out%Cpmin,1),UBOUND(y_out%Cpmin,1) - b = -(y1%Cpmin(i1,i2) - y2%Cpmin(i1,i2)) - y_out%Cpmin(i1,i2) = y1%Cpmin(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated - END SUBROUTINE BEMT_Output_ExtrapInterp1 - - - SUBROUTINE BEMT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%Vrel) .AND. ALLOCATED(y1%Vrel)) THEN + y_out%Vrel = a1*y1%Vrel + a2*y2%Vrel + END IF ! check if allocated + IF (ALLOCATED(y_out%phi) .AND. ALLOCATED(y1%phi)) THEN + y_out%phi = a1*y1%phi + a2*y2%phi + END IF ! check if allocated + IF (ALLOCATED(y_out%axInduction) .AND. ALLOCATED(y1%axInduction)) THEN + y_out%axInduction = a1*y1%axInduction + a2*y2%axInduction + END IF ! check if allocated + IF (ALLOCATED(y_out%tanInduction) .AND. ALLOCATED(y1%tanInduction)) THEN + y_out%tanInduction = a1*y1%tanInduction + a2*y2%tanInduction + END IF ! check if allocated + IF (ALLOCATED(y_out%Re) .AND. ALLOCATED(y1%Re)) THEN + y_out%Re = a1*y1%Re + a2*y2%Re + END IF ! check if allocated + IF (ALLOCATED(y_out%AOA) .AND. ALLOCATED(y1%AOA)) THEN + y_out%AOA = a1*y1%AOA + a2*y2%AOA + END IF ! check if allocated + IF (ALLOCATED(y_out%Cx) .AND. ALLOCATED(y1%Cx)) THEN + y_out%Cx = a1*y1%Cx + a2*y2%Cx + END IF ! check if allocated + IF (ALLOCATED(y_out%Cy) .AND. ALLOCATED(y1%Cy)) THEN + y_out%Cy = a1*y1%Cy + a2*y2%Cy + END IF ! check if allocated + IF (ALLOCATED(y_out%Cz) .AND. ALLOCATED(y1%Cz)) THEN + y_out%Cz = a1*y1%Cz + a2*y2%Cz + END IF ! check if allocated + IF (ALLOCATED(y_out%Cmx) .AND. ALLOCATED(y1%Cmx)) THEN + y_out%Cmx = a1*y1%Cmx + a2*y2%Cmx + END IF ! check if allocated + IF (ALLOCATED(y_out%Cmy) .AND. ALLOCATED(y1%Cmy)) THEN + y_out%Cmy = a1*y1%Cmy + a2*y2%Cmy + END IF ! check if allocated + IF (ALLOCATED(y_out%Cmz) .AND. ALLOCATED(y1%Cmz)) THEN + y_out%Cmz = a1*y1%Cmz + a2*y2%Cmz + END IF ! check if allocated + IF (ALLOCATED(y_out%Cm) .AND. ALLOCATED(y1%Cm)) THEN + y_out%Cm = a1*y1%Cm + a2*y2%Cm + END IF ! check if allocated + IF (ALLOCATED(y_out%Cl) .AND. ALLOCATED(y1%Cl)) THEN + y_out%Cl = a1*y1%Cl + a2*y2%Cl + END IF ! check if allocated + IF (ALLOCATED(y_out%Cd) .AND. ALLOCATED(y1%Cd)) THEN + y_out%Cd = a1*y1%Cd + a2*y2%Cd + END IF ! check if allocated + IF (ALLOCATED(y_out%chi) .AND. ALLOCATED(y1%chi)) THEN + y_out%chi = a1*y1%chi + a2*y2%chi + END IF ! check if allocated + IF (ALLOCATED(y_out%Cpmin) .AND. ALLOCATED(y1%Cpmin)) THEN + y_out%Cpmin = a1*y1%Cpmin + a2*y2%Cpmin + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE BEMT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 2. @@ -3668,202 +3430,100 @@ SUBROUTINE BEMT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E ! !.................................................................................................................................. - TYPE(BEMT_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 - TYPE(BEMT_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 - TYPE(BEMT_OutputType), INTENT(IN) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(BEMT_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(BEMT_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 + TYPE(BEMT_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 + TYPE(BEMT_OutputType), INTENT(IN) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(BEMT_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) -IF (ALLOCATED(y_out%Vrel) .AND. ALLOCATED(y1%Vrel)) THEN - DO i2 = LBOUND(y_out%Vrel,2),UBOUND(y_out%Vrel,2) - DO i1 = LBOUND(y_out%Vrel,1),UBOUND(y_out%Vrel,1) - b = (t(3)**2*(y1%Vrel(i1,i2) - y2%Vrel(i1,i2)) + t(2)**2*(-y1%Vrel(i1,i2) + y3%Vrel(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%Vrel(i1,i2) + t(3)*y2%Vrel(i1,i2) - t(2)*y3%Vrel(i1,i2) ) * scaleFactor - y_out%Vrel(i1,i2) = y1%Vrel(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%phi) .AND. ALLOCATED(y1%phi)) THEN - DO i2 = LBOUND(y_out%phi,2),UBOUND(y_out%phi,2) - DO i1 = LBOUND(y_out%phi,1),UBOUND(y_out%phi,1) - b = (t(3)**2*(y1%phi(i1,i2) - y2%phi(i1,i2)) + t(2)**2*(-y1%phi(i1,i2) + y3%phi(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%phi(i1,i2) + t(3)*y2%phi(i1,i2) - t(2)*y3%phi(i1,i2) ) * scaleFactor - y_out%phi(i1,i2) = y1%phi(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%axInduction) .AND. ALLOCATED(y1%axInduction)) THEN - DO i2 = LBOUND(y_out%axInduction,2),UBOUND(y_out%axInduction,2) - DO i1 = LBOUND(y_out%axInduction,1),UBOUND(y_out%axInduction,1) - b = (t(3)**2*(y1%axInduction(i1,i2) - y2%axInduction(i1,i2)) + t(2)**2*(-y1%axInduction(i1,i2) + y3%axInduction(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%axInduction(i1,i2) + t(3)*y2%axInduction(i1,i2) - t(2)*y3%axInduction(i1,i2) ) * scaleFactor - y_out%axInduction(i1,i2) = y1%axInduction(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%tanInduction) .AND. ALLOCATED(y1%tanInduction)) THEN - DO i2 = LBOUND(y_out%tanInduction,2),UBOUND(y_out%tanInduction,2) - DO i1 = LBOUND(y_out%tanInduction,1),UBOUND(y_out%tanInduction,1) - b = (t(3)**2*(y1%tanInduction(i1,i2) - y2%tanInduction(i1,i2)) + t(2)**2*(-y1%tanInduction(i1,i2) + y3%tanInduction(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%tanInduction(i1,i2) + t(3)*y2%tanInduction(i1,i2) - t(2)*y3%tanInduction(i1,i2) ) * scaleFactor - y_out%tanInduction(i1,i2) = y1%tanInduction(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Re) .AND. ALLOCATED(y1%Re)) THEN - DO i2 = LBOUND(y_out%Re,2),UBOUND(y_out%Re,2) - DO i1 = LBOUND(y_out%Re,1),UBOUND(y_out%Re,1) - b = (t(3)**2*(y1%Re(i1,i2) - y2%Re(i1,i2)) + t(2)**2*(-y1%Re(i1,i2) + y3%Re(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%Re(i1,i2) + t(3)*y2%Re(i1,i2) - t(2)*y3%Re(i1,i2) ) * scaleFactor - y_out%Re(i1,i2) = y1%Re(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%AOA) .AND. ALLOCATED(y1%AOA)) THEN - DO i2 = LBOUND(y_out%AOA,2),UBOUND(y_out%AOA,2) - DO i1 = LBOUND(y_out%AOA,1),UBOUND(y_out%AOA,1) - b = (t(3)**2*(y1%AOA(i1,i2) - y2%AOA(i1,i2)) + t(2)**2*(-y1%AOA(i1,i2) + y3%AOA(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%AOA(i1,i2) + t(3)*y2%AOA(i1,i2) - t(2)*y3%AOA(i1,i2) ) * scaleFactor - y_out%AOA(i1,i2) = y1%AOA(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cx) .AND. ALLOCATED(y1%Cx)) THEN - DO i2 = LBOUND(y_out%Cx,2),UBOUND(y_out%Cx,2) - DO i1 = LBOUND(y_out%Cx,1),UBOUND(y_out%Cx,1) - b = (t(3)**2*(y1%Cx(i1,i2) - y2%Cx(i1,i2)) + t(2)**2*(-y1%Cx(i1,i2) + y3%Cx(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%Cx(i1,i2) + t(3)*y2%Cx(i1,i2) - t(2)*y3%Cx(i1,i2) ) * scaleFactor - y_out%Cx(i1,i2) = y1%Cx(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cy) .AND. ALLOCATED(y1%Cy)) THEN - DO i2 = LBOUND(y_out%Cy,2),UBOUND(y_out%Cy,2) - DO i1 = LBOUND(y_out%Cy,1),UBOUND(y_out%Cy,1) - b = (t(3)**2*(y1%Cy(i1,i2) - y2%Cy(i1,i2)) + t(2)**2*(-y1%Cy(i1,i2) + y3%Cy(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%Cy(i1,i2) + t(3)*y2%Cy(i1,i2) - t(2)*y3%Cy(i1,i2) ) * scaleFactor - y_out%Cy(i1,i2) = y1%Cy(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cz) .AND. ALLOCATED(y1%Cz)) THEN - DO i2 = LBOUND(y_out%Cz,2),UBOUND(y_out%Cz,2) - DO i1 = LBOUND(y_out%Cz,1),UBOUND(y_out%Cz,1) - b = (t(3)**2*(y1%Cz(i1,i2) - y2%Cz(i1,i2)) + t(2)**2*(-y1%Cz(i1,i2) + y3%Cz(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%Cz(i1,i2) + t(3)*y2%Cz(i1,i2) - t(2)*y3%Cz(i1,i2) ) * scaleFactor - y_out%Cz(i1,i2) = y1%Cz(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cmx) .AND. ALLOCATED(y1%Cmx)) THEN - DO i2 = LBOUND(y_out%Cmx,2),UBOUND(y_out%Cmx,2) - DO i1 = LBOUND(y_out%Cmx,1),UBOUND(y_out%Cmx,1) - b = (t(3)**2*(y1%Cmx(i1,i2) - y2%Cmx(i1,i2)) + t(2)**2*(-y1%Cmx(i1,i2) + y3%Cmx(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%Cmx(i1,i2) + t(3)*y2%Cmx(i1,i2) - t(2)*y3%Cmx(i1,i2) ) * scaleFactor - y_out%Cmx(i1,i2) = y1%Cmx(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cmy) .AND. ALLOCATED(y1%Cmy)) THEN - DO i2 = LBOUND(y_out%Cmy,2),UBOUND(y_out%Cmy,2) - DO i1 = LBOUND(y_out%Cmy,1),UBOUND(y_out%Cmy,1) - b = (t(3)**2*(y1%Cmy(i1,i2) - y2%Cmy(i1,i2)) + t(2)**2*(-y1%Cmy(i1,i2) + y3%Cmy(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%Cmy(i1,i2) + t(3)*y2%Cmy(i1,i2) - t(2)*y3%Cmy(i1,i2) ) * scaleFactor - y_out%Cmy(i1,i2) = y1%Cmy(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cmz) .AND. ALLOCATED(y1%Cmz)) THEN - DO i2 = LBOUND(y_out%Cmz,2),UBOUND(y_out%Cmz,2) - DO i1 = LBOUND(y_out%Cmz,1),UBOUND(y_out%Cmz,1) - b = (t(3)**2*(y1%Cmz(i1,i2) - y2%Cmz(i1,i2)) + t(2)**2*(-y1%Cmz(i1,i2) + y3%Cmz(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%Cmz(i1,i2) + t(3)*y2%Cmz(i1,i2) - t(2)*y3%Cmz(i1,i2) ) * scaleFactor - y_out%Cmz(i1,i2) = y1%Cmz(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cm) .AND. ALLOCATED(y1%Cm)) THEN - DO i2 = LBOUND(y_out%Cm,2),UBOUND(y_out%Cm,2) - DO i1 = LBOUND(y_out%Cm,1),UBOUND(y_out%Cm,1) - b = (t(3)**2*(y1%Cm(i1,i2) - y2%Cm(i1,i2)) + t(2)**2*(-y1%Cm(i1,i2) + y3%Cm(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%Cm(i1,i2) + t(3)*y2%Cm(i1,i2) - t(2)*y3%Cm(i1,i2) ) * scaleFactor - y_out%Cm(i1,i2) = y1%Cm(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cl) .AND. ALLOCATED(y1%Cl)) THEN - DO i2 = LBOUND(y_out%Cl,2),UBOUND(y_out%Cl,2) - DO i1 = LBOUND(y_out%Cl,1),UBOUND(y_out%Cl,1) - b = (t(3)**2*(y1%Cl(i1,i2) - y2%Cl(i1,i2)) + t(2)**2*(-y1%Cl(i1,i2) + y3%Cl(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%Cl(i1,i2) + t(3)*y2%Cl(i1,i2) - t(2)*y3%Cl(i1,i2) ) * scaleFactor - y_out%Cl(i1,i2) = y1%Cl(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cd) .AND. ALLOCATED(y1%Cd)) THEN - DO i2 = LBOUND(y_out%Cd,2),UBOUND(y_out%Cd,2) - DO i1 = LBOUND(y_out%Cd,1),UBOUND(y_out%Cd,1) - b = (t(3)**2*(y1%Cd(i1,i2) - y2%Cd(i1,i2)) + t(2)**2*(-y1%Cd(i1,i2) + y3%Cd(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%Cd(i1,i2) + t(3)*y2%Cd(i1,i2) - t(2)*y3%Cd(i1,i2) ) * scaleFactor - y_out%Cd(i1,i2) = y1%Cd(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%chi) .AND. ALLOCATED(y1%chi)) THEN - DO i2 = LBOUND(y_out%chi,2),UBOUND(y_out%chi,2) - DO i1 = LBOUND(y_out%chi,1),UBOUND(y_out%chi,1) - b = (t(3)**2*(y1%chi(i1,i2) - y2%chi(i1,i2)) + t(2)**2*(-y1%chi(i1,i2) + y3%chi(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%chi(i1,i2) + t(3)*y2%chi(i1,i2) - t(2)*y3%chi(i1,i2) ) * scaleFactor - y_out%chi(i1,i2) = y1%chi(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cpmin) .AND. ALLOCATED(y1%Cpmin)) THEN - DO i2 = LBOUND(y_out%Cpmin,2),UBOUND(y_out%Cpmin,2) - DO i1 = LBOUND(y_out%Cpmin,1),UBOUND(y_out%Cpmin,1) - b = (t(3)**2*(y1%Cpmin(i1,i2) - y2%Cpmin(i1,i2)) + t(2)**2*(-y1%Cpmin(i1,i2) + y3%Cpmin(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%Cpmin(i1,i2) + t(3)*y2%Cpmin(i1,i2) - t(2)*y3%Cpmin(i1,i2) ) * scaleFactor - y_out%Cpmin(i1,i2) = y1%Cpmin(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated - END SUBROUTINE BEMT_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%Vrel) .AND. ALLOCATED(y1%Vrel)) THEN + y_out%Vrel = a1*y1%Vrel + a2*y2%Vrel + a3*y3%Vrel + END IF ! check if allocated + IF (ALLOCATED(y_out%phi) .AND. ALLOCATED(y1%phi)) THEN + y_out%phi = a1*y1%phi + a2*y2%phi + a3*y3%phi + END IF ! check if allocated + IF (ALLOCATED(y_out%axInduction) .AND. ALLOCATED(y1%axInduction)) THEN + y_out%axInduction = a1*y1%axInduction + a2*y2%axInduction + a3*y3%axInduction + END IF ! check if allocated + IF (ALLOCATED(y_out%tanInduction) .AND. ALLOCATED(y1%tanInduction)) THEN + y_out%tanInduction = a1*y1%tanInduction + a2*y2%tanInduction + a3*y3%tanInduction + END IF ! check if allocated + IF (ALLOCATED(y_out%Re) .AND. ALLOCATED(y1%Re)) THEN + y_out%Re = a1*y1%Re + a2*y2%Re + a3*y3%Re + END IF ! check if allocated + IF (ALLOCATED(y_out%AOA) .AND. ALLOCATED(y1%AOA)) THEN + y_out%AOA = a1*y1%AOA + a2*y2%AOA + a3*y3%AOA + END IF ! check if allocated + IF (ALLOCATED(y_out%Cx) .AND. ALLOCATED(y1%Cx)) THEN + y_out%Cx = a1*y1%Cx + a2*y2%Cx + a3*y3%Cx + END IF ! check if allocated + IF (ALLOCATED(y_out%Cy) .AND. ALLOCATED(y1%Cy)) THEN + y_out%Cy = a1*y1%Cy + a2*y2%Cy + a3*y3%Cy + END IF ! check if allocated + IF (ALLOCATED(y_out%Cz) .AND. ALLOCATED(y1%Cz)) THEN + y_out%Cz = a1*y1%Cz + a2*y2%Cz + a3*y3%Cz + END IF ! check if allocated + IF (ALLOCATED(y_out%Cmx) .AND. ALLOCATED(y1%Cmx)) THEN + y_out%Cmx = a1*y1%Cmx + a2*y2%Cmx + a3*y3%Cmx + END IF ! check if allocated + IF (ALLOCATED(y_out%Cmy) .AND. ALLOCATED(y1%Cmy)) THEN + y_out%Cmy = a1*y1%Cmy + a2*y2%Cmy + a3*y3%Cmy + END IF ! check if allocated + IF (ALLOCATED(y_out%Cmz) .AND. ALLOCATED(y1%Cmz)) THEN + y_out%Cmz = a1*y1%Cmz + a2*y2%Cmz + a3*y3%Cmz + END IF ! check if allocated + IF (ALLOCATED(y_out%Cm) .AND. ALLOCATED(y1%Cm)) THEN + y_out%Cm = a1*y1%Cm + a2*y2%Cm + a3*y3%Cm + END IF ! check if allocated + IF (ALLOCATED(y_out%Cl) .AND. ALLOCATED(y1%Cl)) THEN + y_out%Cl = a1*y1%Cl + a2*y2%Cl + a3*y3%Cl + END IF ! check if allocated + IF (ALLOCATED(y_out%Cd) .AND. ALLOCATED(y1%Cd)) THEN + y_out%Cd = a1*y1%Cd + a2*y2%Cd + a3*y3%Cd + END IF ! check if allocated + IF (ALLOCATED(y_out%chi) .AND. ALLOCATED(y1%chi)) THEN + y_out%chi = a1*y1%chi + a2*y2%chi + a3*y3%chi + END IF ! check if allocated + IF (ALLOCATED(y_out%Cpmin) .AND. ALLOCATED(y1%Cpmin)) THEN + y_out%Cpmin = a1*y1%Cpmin + a2*y2%Cpmin + a3*y3%Cpmin + END IF ! check if allocated +END SUBROUTINE END MODULE BEMT_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/DBEMT_Types.f90 b/modules/aerodyn/src/DBEMT_Types.f90 index be37923804..76ad84f50f 100644 --- a/modules/aerodyn/src/DBEMT_Types.f90 +++ b/modules/aerodyn/src/DBEMT_Types.f90 @@ -1006,58 +1006,59 @@ subroutine DBEMT_UnPackOutput(Buf, OutData) end if end subroutine - SUBROUTINE DBEMT_ElementInputType_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) ElementInputType u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(DBEMT_ElementInputType), INTENT(IN) :: u(:) ! ElementInputType at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the ElementInputTypes - TYPE(DBEMT_ElementInputType), INTENT(INOUT) :: u_out ! ElementInputType at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None +subroutine DBEMT_ElementInputType_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) ElementInputType u_out at time t_out, from previous/future time + ! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(DBEMT_ElementInputType), intent(in) :: u(:) ! ElementInputType at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the ElementInputTypes + type(DBEMT_ElementInputType), intent(inout) :: u_out ! ElementInputType at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_ElementInputType_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(u)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(u) - 1 - IF ( order .eq. 0 ) THEN - CALL DBEMT_CopyElementInputType(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL DBEMT_ElementInputType_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL DBEMT_ElementInputType_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE DBEMT_ElementInputType_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'DBEMT_ElementInputType_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call DBEMT_CopyElementInputType(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call DBEMT_ElementInputType_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call DBEMT_ElementInputType_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE DBEMT_ElementInputType_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE DBEMT_ElementInputType_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) ElementInputType u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 1. @@ -1069,47 +1070,44 @@ SUBROUTINE DBEMT_ElementInputType_ExtrapInterp1(u1, u2, tin, u_out, tin_out, Err ! !.................................................................................................................................. - TYPE(DBEMT_ElementInputType), INTENT(IN) :: u1 ! ElementInputType at t1 > t2 - TYPE(DBEMT_ElementInputType), INTENT(IN) :: u2 ! ElementInputType at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the ElementInputTypes - TYPE(DBEMT_ElementInputType), INTENT(INOUT) :: u_out ! ElementInputType at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(DBEMT_ElementInputType), INTENT(IN) :: u1 ! ElementInputType at t1 > t2 + TYPE(DBEMT_ElementInputType), INTENT(IN) :: u2 ! ElementInputType at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the ElementInputTypes + TYPE(DBEMT_ElementInputType), INTENT(INOUT) :: u_out ! ElementInputType at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the ElementInputTypes - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_ElementInputType_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the ElementInputTypes + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_ElementInputType_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF - - ScaleFactor = t_out / t(2) - DO i1 = LBOUND(u_out%vind_s,1),UBOUND(u_out%vind_s,1) - b = -(u1%vind_s(i1) - u2%vind_s(i1)) - u_out%vind_s(i1) = u1%vind_s(i1) + b * ScaleFactor - END DO - b = -(u1%spanRatio - u2%spanRatio) - u_out%spanRatio = u1%spanRatio + b * ScaleFactor - END SUBROUTINE DBEMT_ElementInputType_ExtrapInterp1 - - - SUBROUTINE DBEMT_ElementInputType_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + u_out%vind_s = a1*u1%vind_s + a2*u2%vind_s + u_out%spanRatio = a1*u1%spanRatio + a2*u2%spanRatio +END SUBROUTINE + +SUBROUTINE DBEMT_ElementInputType_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) ElementInputType u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 2. @@ -1123,109 +1121,104 @@ SUBROUTINE DBEMT_ElementInputType_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ! !.................................................................................................................................. - TYPE(DBEMT_ElementInputType), INTENT(IN) :: u1 ! ElementInputType at t1 > t2 > t3 - TYPE(DBEMT_ElementInputType), INTENT(IN) :: u2 ! ElementInputType at t2 > t3 - TYPE(DBEMT_ElementInputType), INTENT(IN) :: u3 ! ElementInputType at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the ElementInputTypes - TYPE(DBEMT_ElementInputType), INTENT(INOUT) :: u_out ! ElementInputType at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(DBEMT_ElementInputType), INTENT(IN) :: u1 ! ElementInputType at t1 > t2 > t3 + TYPE(DBEMT_ElementInputType), INTENT(IN) :: u2 ! ElementInputType at t2 > t3 + TYPE(DBEMT_ElementInputType), INTENT(IN) :: u3 ! ElementInputType at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the ElementInputTypes + TYPE(DBEMT_ElementInputType), INTENT(INOUT) :: u_out ! ElementInputType at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the ElementInputTypes - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_ElementInputType_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the ElementInputTypes + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_ElementInputType_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) - DO i1 = LBOUND(u_out%vind_s,1),UBOUND(u_out%vind_s,1) - b = (t(3)**2*(u1%vind_s(i1) - u2%vind_s(i1)) + t(2)**2*(-u1%vind_s(i1) + u3%vind_s(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%vind_s(i1) + t(3)*u2%vind_s(i1) - t(2)*u3%vind_s(i1) ) * scaleFactor - u_out%vind_s(i1) = u1%vind_s(i1) + b + c * t_out - END DO - b = (t(3)**2*(u1%spanRatio - u2%spanRatio) + t(2)**2*(-u1%spanRatio + u3%spanRatio))* scaleFactor - c = ( (t(2)-t(3))*u1%spanRatio + t(3)*u2%spanRatio - t(2)*u3%spanRatio ) * scaleFactor - u_out%spanRatio = u1%spanRatio + b + c * t_out - END SUBROUTINE DBEMT_ElementInputType_ExtrapInterp2 - - - SUBROUTINE DBEMT_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(DBEMT_InputType), INTENT(IN) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(DBEMT_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + u_out%vind_s = a1*u1%vind_s + a2*u2%vind_s + a3*u3%vind_s + u_out%spanRatio = a1*u1%spanRatio + a2*u2%spanRatio + a3*u3%spanRatio +END SUBROUTINE + +subroutine DBEMT_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time + ! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(DBEMT_InputType), intent(in) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(DBEMT_InputType), intent(inout) :: u_out ! Input at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_Input_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(u)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(u) - 1 - IF ( order .eq. 0 ) THEN - CALL DBEMT_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL DBEMT_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL DBEMT_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE DBEMT_Input_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'DBEMT_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call DBEMT_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call DBEMT_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call DBEMT_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE DBEMT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE DBEMT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 1. @@ -1237,65 +1230,59 @@ SUBROUTINE DBEMT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMs ! !.................................................................................................................................. - TYPE(DBEMT_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 - TYPE(DBEMT_InputType), INTENT(IN) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(DBEMT_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(DBEMT_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 + TYPE(DBEMT_InputType), INTENT(IN) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(DBEMT_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_Input_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + u_out%AxInd_disk = a1*u1%AxInd_disk + a2*u2%AxInd_disk + u_out%Un_disk = a1*u1%Un_disk + a2*u2%Un_disk + u_out%R_disk = a1*u1%R_disk + a2*u2%R_disk + IF (ALLOCATED(u_out%element) .AND. ALLOCATED(u1%element)) THEN + DO i02 = LBOUND(u_out%element,2),UBOUND(u_out%element,2) + DO i01 = LBOUND(u_out%element,1),UBOUND(u_out%element,1) + u_out%element(i01,i02)%vind_s = a1*u1%element(i01,i02)%vind_s + a2*u2%element(i01,i02)%vind_s + END DO + END DO + DO i02 = LBOUND(u_out%element,2),UBOUND(u_out%element,2) + DO i01 = LBOUND(u_out%element,1),UBOUND(u_out%element,1) + u_out%element(i01,i02)%spanRatio = a1*u1%element(i01,i02)%spanRatio + a2*u2%element(i01,i02)%spanRatio + END DO + END DO + END IF ! check if allocated +END SUBROUTINE - ScaleFactor = t_out / t(2) - b = -(u1%AxInd_disk - u2%AxInd_disk) - u_out%AxInd_disk = u1%AxInd_disk + b * ScaleFactor - b = -(u1%Un_disk - u2%Un_disk) - u_out%Un_disk = u1%Un_disk + b * ScaleFactor - b = -(u1%R_disk - u2%R_disk) - u_out%R_disk = u1%R_disk + b * ScaleFactor -IF (ALLOCATED(u_out%element) .AND. ALLOCATED(u1%element)) THEN - DO i02 = LBOUND(u_out%element,2),UBOUND(u_out%element,2) - DO i01 = LBOUND(u_out%element,1),UBOUND(u_out%element,1) - DO i1 = LBOUND(u_out%element(i01,i02)%vind_s,1),UBOUND(u_out%element(i01,i02)%vind_s,1) - b = -(u1%element(i01,i02)%vind_s(i1) - u2%element(i01,i02)%vind_s(i1)) - u_out%element(i01,i02)%vind_s(i1) = u1%element(i01,i02)%vind_s(i1) + b * ScaleFactor - END DO - ENDDO - ENDDO - DO i02 = LBOUND(u_out%element,2),UBOUND(u_out%element,2) - DO i01 = LBOUND(u_out%element,1),UBOUND(u_out%element,1) - b = -(u1%element(i01,i02)%spanRatio - u2%element(i01,i02)%spanRatio) - u_out%element(i01,i02)%spanRatio = u1%element(i01,i02)%spanRatio + b * ScaleFactor - ENDDO - ENDDO -END IF ! check if allocated - END SUBROUTINE DBEMT_Input_ExtrapInterp1 - - - SUBROUTINE DBEMT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE DBEMT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 2. @@ -1309,130 +1296,119 @@ SUBROUTINE DBEMT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, E ! !.................................................................................................................................. - TYPE(DBEMT_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 - TYPE(DBEMT_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 - TYPE(DBEMT_InputType), INTENT(IN) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(DBEMT_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(DBEMT_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 + TYPE(DBEMT_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 + TYPE(DBEMT_InputType), INTENT(IN) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(DBEMT_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_Input_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) - b = (t(3)**2*(u1%AxInd_disk - u2%AxInd_disk) + t(2)**2*(-u1%AxInd_disk + u3%AxInd_disk))* scaleFactor - c = ( (t(2)-t(3))*u1%AxInd_disk + t(3)*u2%AxInd_disk - t(2)*u3%AxInd_disk ) * scaleFactor - u_out%AxInd_disk = u1%AxInd_disk + b + c * t_out - b = (t(3)**2*(u1%Un_disk - u2%Un_disk) + t(2)**2*(-u1%Un_disk + u3%Un_disk))* scaleFactor - c = ( (t(2)-t(3))*u1%Un_disk + t(3)*u2%Un_disk - t(2)*u3%Un_disk ) * scaleFactor - u_out%Un_disk = u1%Un_disk + b + c * t_out - b = (t(3)**2*(u1%R_disk - u2%R_disk) + t(2)**2*(-u1%R_disk + u3%R_disk))* scaleFactor - c = ( (t(2)-t(3))*u1%R_disk + t(3)*u2%R_disk - t(2)*u3%R_disk ) * scaleFactor - u_out%R_disk = u1%R_disk + b + c * t_out -IF (ALLOCATED(u_out%element) .AND. ALLOCATED(u1%element)) THEN - DO i02 = LBOUND(u_out%element,2),UBOUND(u_out%element,2) - DO i01 = LBOUND(u_out%element,1),UBOUND(u_out%element,1) - DO i1 = LBOUND(u_out%element(i01,i02)%vind_s,1),UBOUND(u_out%element(i01,i02)%vind_s,1) - b = (t(3)**2*(u1%element(i01,i02)%vind_s(i1) - u2%element(i01,i02)%vind_s(i1)) + t(2)**2*(-u1%element(i01,i02)%vind_s(i1) + u3%element(i01,i02)%vind_s(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%element(i01,i02)%vind_s(i1) + t(3)*u2%element(i01,i02)%vind_s(i1) - t(2)*u3%element(i01,i02)%vind_s(i1) ) * scaleFactor - u_out%element(i01,i02)%vind_s(i1) = u1%element(i01,i02)%vind_s(i1) + b + c * t_out - END DO - ENDDO - ENDDO - DO i02 = LBOUND(u_out%element,2),UBOUND(u_out%element,2) - DO i01 = LBOUND(u_out%element,1),UBOUND(u_out%element,1) - b = (t(3)**2*(u1%element(i01,i02)%spanRatio - u2%element(i01,i02)%spanRatio) + t(2)**2*(-u1%element(i01,i02)%spanRatio + u3%element(i01,i02)%spanRatio))* scaleFactor - c = ( (t(2)-t(3))*u1%element(i01,i02)%spanRatio + t(3)*u2%element(i01,i02)%spanRatio - t(2)*u3%element(i01,i02)%spanRatio ) * scaleFactor - u_out%element(i01,i02)%spanRatio = u1%element(i01,i02)%spanRatio + b + c * t_out - ENDDO - ENDDO -END IF ! check if allocated - END SUBROUTINE DBEMT_Input_ExtrapInterp2 - - - SUBROUTINE DBEMT_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(DBEMT_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(DBEMT_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + u_out%AxInd_disk = a1*u1%AxInd_disk + a2*u2%AxInd_disk + a3*u3%AxInd_disk + u_out%Un_disk = a1*u1%Un_disk + a2*u2%Un_disk + a3*u3%Un_disk + u_out%R_disk = a1*u1%R_disk + a2*u2%R_disk + a3*u3%R_disk + IF (ALLOCATED(u_out%element) .AND. ALLOCATED(u1%element)) THEN + DO i02 = LBOUND(u_out%element,2),UBOUND(u_out%element,2) + DO i01 = LBOUND(u_out%element,1),UBOUND(u_out%element,1) + u_out%element(i01,i02)%vind_s = a1*u1%element(i01,i02)%vind_s + a2*u2%element(i01,i02)%vind_s + a3*u3%element(i01,i02)%vind_s + END DO + END DO + DO i02 = LBOUND(u_out%element,2),UBOUND(u_out%element,2) + DO i01 = LBOUND(u_out%element,1),UBOUND(u_out%element,1) + u_out%element(i01,i02)%spanRatio = a1*u1%element(i01,i02)%spanRatio + a2*u2%element(i01,i02)%spanRatio + a3*u3%element(i01,i02)%spanRatio + END DO + END DO + END IF ! check if allocated +END SUBROUTINE + +subroutine DBEMT_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time + ! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(DBEMT_OutputType), intent(in) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(DBEMT_OutputType), intent(inout) :: y_out ! Output at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_Output_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(y)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(y) - 1 - IF ( order .eq. 0 ) THEN - CALL DBEMT_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL DBEMT_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL DBEMT_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE DBEMT_Output_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'DBEMT_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call DBEMT_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call DBEMT_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call DBEMT_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE DBEMT_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE DBEMT_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 1. @@ -1444,55 +1420,49 @@ SUBROUTINE DBEMT_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrM ! !.................................................................................................................................. - TYPE(DBEMT_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 - TYPE(DBEMT_OutputType), INTENT(IN) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(DBEMT_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(DBEMT_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 + TYPE(DBEMT_OutputType), INTENT(IN) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(DBEMT_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_Output_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - INTEGER :: i3 ! dim3 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF - - ScaleFactor = t_out / t(2) -IF (ALLOCATED(y_out%vind) .AND. ALLOCATED(y1%vind)) THEN - DO i3 = LBOUND(y_out%vind,3),UBOUND(y_out%vind,3) - DO i2 = LBOUND(y_out%vind,2),UBOUND(y_out%vind,2) - DO i1 = LBOUND(y_out%vind,1),UBOUND(y_out%vind,1) - b = -(y1%vind(i1,i2,i3) - y2%vind(i1,i2,i3)) - y_out%vind(i1,i2,i3) = y1%vind(i1,i2,i3) + b * ScaleFactor - END DO - END DO - END DO -END IF ! check if allocated - END SUBROUTINE DBEMT_Output_ExtrapInterp1 - - - SUBROUTINE DBEMT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%vind) .AND. ALLOCATED(y1%vind)) THEN + y_out%vind = a1*y1%vind + a2*y2%vind + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE DBEMT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 2. @@ -1506,62 +1476,54 @@ SUBROUTINE DBEMT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ! !.................................................................................................................................. - TYPE(DBEMT_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 - TYPE(DBEMT_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 - TYPE(DBEMT_OutputType), INTENT(IN) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(DBEMT_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(DBEMT_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 + TYPE(DBEMT_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 + TYPE(DBEMT_OutputType), INTENT(IN) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(DBEMT_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - INTEGER :: i3 ! dim3 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) -IF (ALLOCATED(y_out%vind) .AND. ALLOCATED(y1%vind)) THEN - DO i3 = LBOUND(y_out%vind,3),UBOUND(y_out%vind,3) - DO i2 = LBOUND(y_out%vind,2),UBOUND(y_out%vind,2) - DO i1 = LBOUND(y_out%vind,1),UBOUND(y_out%vind,1) - b = (t(3)**2*(y1%vind(i1,i2,i3) - y2%vind(i1,i2,i3)) + t(2)**2*(-y1%vind(i1,i2,i3) + y3%vind(i1,i2,i3)))* scaleFactor - c = ( (t(2)-t(3))*y1%vind(i1,i2,i3) + t(3)*y2%vind(i1,i2,i3) - t(2)*y3%vind(i1,i2,i3) ) * scaleFactor - y_out%vind(i1,i2,i3) = y1%vind(i1,i2,i3) + b + c * t_out - END DO - END DO - END DO -END IF ! check if allocated - END SUBROUTINE DBEMT_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%vind) .AND. ALLOCATED(y1%vind)) THEN + y_out%vind = a1*y1%vind + a2*y2%vind + a3*y3%vind + END IF ! check if allocated +END SUBROUTINE END MODULE DBEMT_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/FVW_Types.f90 b/modules/aerodyn/src/FVW_Types.f90 index b540c57f64..b1210cdd91 100644 --- a/modules/aerodyn/src/FVW_Types.f90 +++ b/modules/aerodyn/src/FVW_Types.f90 @@ -5064,58 +5064,59 @@ subroutine FVW_UnPackInitOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE FVW_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(FVW_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(FVW_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None +subroutine FVW_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time + ! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(FVW_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(FVW_InputType), intent(inout) :: u_out ! Input at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_Input_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(u)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(u) - 1 - IF ( order .eq. 0 ) THEN - CALL FVW_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL FVW_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL FVW_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE FVW_Input_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'FVW_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call FVW_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call FVW_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call FVW_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE FVW_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE FVW_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 1. @@ -5127,93 +5128,73 @@ SUBROUTINE FVW_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(FVW_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(FVW_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(FVW_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(FVW_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(FVW_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(FVW_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_Input_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(u_out%rotors) .AND. ALLOCATED(u1%rotors)) THEN + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + u_out%rotors(i01)%HubOrientation = a1*u1%rotors(i01)%HubOrientation + a2*u2%rotors(i01)%HubOrientation + END DO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + u_out%rotors(i01)%HubPosition = a1*u1%rotors(i01)%HubPosition + a2*u2%rotors(i01)%HubPosition + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%W) .AND. ALLOCATED(u1%W)) THEN + DO i01 = LBOUND(u_out%W,1),UBOUND(u_out%W,1) + IF (ALLOCATED(u_out%W(i01)%Vwnd_LL) .AND. ALLOCATED(u1%W(i01)%Vwnd_LL)) THEN + u_out%W(i01)%Vwnd_LL = a1*u1%W(i01)%Vwnd_LL + a2*u2%W(i01)%Vwnd_LL + END IF ! check if allocated + END DO + DO i01 = LBOUND(u_out%W,1),UBOUND(u_out%W,1) + IF (ALLOCATED(u_out%W(i01)%omega_z) .AND. ALLOCATED(u1%W(i01)%omega_z)) THEN + u_out%W(i01)%omega_z = a1*u1%W(i01)%omega_z + a2*u2%W(i01)%omega_z + END IF ! check if allocated + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%WingsMesh) .AND. ALLOCATED(u1%WingsMesh)) THEN + DO i1 = LBOUND(u_out%WingsMesh,1),UBOUND(u_out%WingsMesh,1) + CALL MeshExtrapInterp1(u1%WingsMesh(i1), u2%WingsMesh(i1), tin, u_out%WingsMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%V_wind) .AND. ALLOCATED(u1%V_wind)) THEN + u_out%V_wind = a1*u1%V_wind + a2*u2%V_wind + END IF ! check if allocated +END SUBROUTINE - ScaleFactor = t_out / t(2) -IF (ALLOCATED(u_out%rotors) .AND. ALLOCATED(u1%rotors)) THEN - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - DO i2 = LBOUND(u_out%rotors(i01)%HubOrientation,2),UBOUND(u_out%rotors(i01)%HubOrientation,2) - DO i1 = LBOUND(u_out%rotors(i01)%HubOrientation,1),UBOUND(u_out%rotors(i01)%HubOrientation,1) - b = -(u1%rotors(i01)%HubOrientation(i1,i2) - u2%rotors(i01)%HubOrientation(i1,i2)) - u_out%rotors(i01)%HubOrientation(i1,i2) = u1%rotors(i01)%HubOrientation(i1,i2) + b * ScaleFactor - END DO - END DO - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - DO i1 = LBOUND(u_out%rotors(i01)%HubPosition,1),UBOUND(u_out%rotors(i01)%HubPosition,1) - b = -(u1%rotors(i01)%HubPosition(i1) - u2%rotors(i01)%HubPosition(i1)) - u_out%rotors(i01)%HubPosition(i1) = u1%rotors(i01)%HubPosition(i1) + b * ScaleFactor - END DO - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%W) .AND. ALLOCATED(u1%W)) THEN - DO i01 = LBOUND(u_out%W,1),UBOUND(u_out%W,1) -IF (ALLOCATED(u_out%W(i01)%Vwnd_LL) .AND. ALLOCATED(u1%W(i01)%Vwnd_LL)) THEN - DO i2 = LBOUND(u_out%W(i01)%Vwnd_LL,2),UBOUND(u_out%W(i01)%Vwnd_LL,2) - DO i1 = LBOUND(u_out%W(i01)%Vwnd_LL,1),UBOUND(u_out%W(i01)%Vwnd_LL,1) - b = -(u1%W(i01)%Vwnd_LL(i1,i2) - u2%W(i01)%Vwnd_LL(i1,i2)) - u_out%W(i01)%Vwnd_LL(i1,i2) = u1%W(i01)%Vwnd_LL(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated - ENDDO - DO i01 = LBOUND(u_out%W,1),UBOUND(u_out%W,1) -IF (ALLOCATED(u_out%W(i01)%omega_z) .AND. ALLOCATED(u1%W(i01)%omega_z)) THEN - DO i1 = LBOUND(u_out%W(i01)%omega_z,1),UBOUND(u_out%W(i01)%omega_z,1) - b = -(u1%W(i01)%omega_z(i1) - u2%W(i01)%omega_z(i1)) - u_out%W(i01)%omega_z(i1) = u1%W(i01)%omega_z(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%WingsMesh) .AND. ALLOCATED(u1%WingsMesh)) THEN - DO i1 = LBOUND(u_out%WingsMesh,1),UBOUND(u_out%WingsMesh,1) - CALL MeshExtrapInterp1(u1%WingsMesh(i1), u2%WingsMesh(i1), tin, u_out%WingsMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%V_wind) .AND. ALLOCATED(u1%V_wind)) THEN - DO i2 = LBOUND(u_out%V_wind,2),UBOUND(u_out%V_wind,2) - DO i1 = LBOUND(u_out%V_wind,1),UBOUND(u_out%V_wind,1) - b = -(u1%V_wind(i1,i2) - u2%V_wind(i1,i2)) - u_out%V_wind(i1,i2) = u1%V_wind(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated - END SUBROUTINE FVW_Input_ExtrapInterp1 - - - SUBROUTINE FVW_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE FVW_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 2. @@ -5227,158 +5208,133 @@ SUBROUTINE FVW_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - TYPE(FVW_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(FVW_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(FVW_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(FVW_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(FVW_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(FVW_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(FVW_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(FVW_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_Input_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(u_out%rotors) .AND. ALLOCATED(u1%rotors)) THEN + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + u_out%rotors(i01)%HubOrientation = a1*u1%rotors(i01)%HubOrientation + a2*u2%rotors(i01)%HubOrientation + a3*u3%rotors(i01)%HubOrientation + END DO + DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) + u_out%rotors(i01)%HubPosition = a1*u1%rotors(i01)%HubPosition + a2*u2%rotors(i01)%HubPosition + a3*u3%rotors(i01)%HubPosition + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%W) .AND. ALLOCATED(u1%W)) THEN + DO i01 = LBOUND(u_out%W,1),UBOUND(u_out%W,1) + IF (ALLOCATED(u_out%W(i01)%Vwnd_LL) .AND. ALLOCATED(u1%W(i01)%Vwnd_LL)) THEN + u_out%W(i01)%Vwnd_LL = a1*u1%W(i01)%Vwnd_LL + a2*u2%W(i01)%Vwnd_LL + a3*u3%W(i01)%Vwnd_LL + END IF ! check if allocated + END DO + DO i01 = LBOUND(u_out%W,1),UBOUND(u_out%W,1) + IF (ALLOCATED(u_out%W(i01)%omega_z) .AND. ALLOCATED(u1%W(i01)%omega_z)) THEN + u_out%W(i01)%omega_z = a1*u1%W(i01)%omega_z + a2*u2%W(i01)%omega_z + a3*u3%W(i01)%omega_z + END IF ! check if allocated + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%WingsMesh) .AND. ALLOCATED(u1%WingsMesh)) THEN + DO i1 = LBOUND(u_out%WingsMesh,1),UBOUND(u_out%WingsMesh,1) + CALL MeshExtrapInterp2(u1%WingsMesh(i1), u2%WingsMesh(i1), u3%WingsMesh(i1), tin, u_out%WingsMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%V_wind) .AND. ALLOCATED(u1%V_wind)) THEN + u_out%V_wind = a1*u1%V_wind + a2*u2%V_wind + a3*u3%V_wind + END IF ! check if allocated +END SUBROUTINE - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) -IF (ALLOCATED(u_out%rotors) .AND. ALLOCATED(u1%rotors)) THEN - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - DO i2 = LBOUND(u_out%rotors(i01)%HubOrientation,2),UBOUND(u_out%rotors(i01)%HubOrientation,2) - DO i1 = LBOUND(u_out%rotors(i01)%HubOrientation,1),UBOUND(u_out%rotors(i01)%HubOrientation,1) - b = (t(3)**2*(u1%rotors(i01)%HubOrientation(i1,i2) - u2%rotors(i01)%HubOrientation(i1,i2)) + t(2)**2*(-u1%rotors(i01)%HubOrientation(i1,i2) + u3%rotors(i01)%HubOrientation(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%rotors(i01)%HubOrientation(i1,i2) + t(3)*u2%rotors(i01)%HubOrientation(i1,i2) - t(2)*u3%rotors(i01)%HubOrientation(i1,i2) ) * scaleFactor - u_out%rotors(i01)%HubOrientation(i1,i2) = u1%rotors(i01)%HubOrientation(i1,i2) + b + c * t_out - END DO - END DO - ENDDO - DO i01 = LBOUND(u_out%rotors,1),UBOUND(u_out%rotors,1) - DO i1 = LBOUND(u_out%rotors(i01)%HubPosition,1),UBOUND(u_out%rotors(i01)%HubPosition,1) - b = (t(3)**2*(u1%rotors(i01)%HubPosition(i1) - u2%rotors(i01)%HubPosition(i1)) + t(2)**2*(-u1%rotors(i01)%HubPosition(i1) + u3%rotors(i01)%HubPosition(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%rotors(i01)%HubPosition(i1) + t(3)*u2%rotors(i01)%HubPosition(i1) - t(2)*u3%rotors(i01)%HubPosition(i1) ) * scaleFactor - u_out%rotors(i01)%HubPosition(i1) = u1%rotors(i01)%HubPosition(i1) + b + c * t_out - END DO - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%W) .AND. ALLOCATED(u1%W)) THEN - DO i01 = LBOUND(u_out%W,1),UBOUND(u_out%W,1) -IF (ALLOCATED(u_out%W(i01)%Vwnd_LL) .AND. ALLOCATED(u1%W(i01)%Vwnd_LL)) THEN - DO i2 = LBOUND(u_out%W(i01)%Vwnd_LL,2),UBOUND(u_out%W(i01)%Vwnd_LL,2) - DO i1 = LBOUND(u_out%W(i01)%Vwnd_LL,1),UBOUND(u_out%W(i01)%Vwnd_LL,1) - b = (t(3)**2*(u1%W(i01)%Vwnd_LL(i1,i2) - u2%W(i01)%Vwnd_LL(i1,i2)) + t(2)**2*(-u1%W(i01)%Vwnd_LL(i1,i2) + u3%W(i01)%Vwnd_LL(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%W(i01)%Vwnd_LL(i1,i2) + t(3)*u2%W(i01)%Vwnd_LL(i1,i2) - t(2)*u3%W(i01)%Vwnd_LL(i1,i2) ) * scaleFactor - u_out%W(i01)%Vwnd_LL(i1,i2) = u1%W(i01)%Vwnd_LL(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated - ENDDO - DO i01 = LBOUND(u_out%W,1),UBOUND(u_out%W,1) -IF (ALLOCATED(u_out%W(i01)%omega_z) .AND. ALLOCATED(u1%W(i01)%omega_z)) THEN - DO i1 = LBOUND(u_out%W(i01)%omega_z,1),UBOUND(u_out%W(i01)%omega_z,1) - b = (t(3)**2*(u1%W(i01)%omega_z(i1) - u2%W(i01)%omega_z(i1)) + t(2)**2*(-u1%W(i01)%omega_z(i1) + u3%W(i01)%omega_z(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%W(i01)%omega_z(i1) + t(3)*u2%W(i01)%omega_z(i1) - t(2)*u3%W(i01)%omega_z(i1) ) * scaleFactor - u_out%W(i01)%omega_z(i1) = u1%W(i01)%omega_z(i1) + b + c * t_out - END DO -END IF ! check if allocated - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%WingsMesh) .AND. ALLOCATED(u1%WingsMesh)) THEN - DO i1 = LBOUND(u_out%WingsMesh,1),UBOUND(u_out%WingsMesh,1) - CALL MeshExtrapInterp2(u1%WingsMesh(i1), u2%WingsMesh(i1), u3%WingsMesh(i1), tin, u_out%WingsMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%V_wind) .AND. ALLOCATED(u1%V_wind)) THEN - DO i2 = LBOUND(u_out%V_wind,2),UBOUND(u_out%V_wind,2) - DO i1 = LBOUND(u_out%V_wind,1),UBOUND(u_out%V_wind,1) - b = (t(3)**2*(u1%V_wind(i1,i2) - u2%V_wind(i1,i2)) + t(2)**2*(-u1%V_wind(i1,i2) + u3%V_wind(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%V_wind(i1,i2) + t(3)*u2%V_wind(i1,i2) - t(2)*u3%V_wind(i1,i2) ) * scaleFactor - u_out%V_wind(i1,i2) = u1%V_wind(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated - END SUBROUTINE FVW_Input_ExtrapInterp2 - - - SUBROUTINE FVW_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(FVW_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(FVW_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None +subroutine FVW_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time + ! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(FVW_OutputType), intent(in) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(FVW_OutputType), intent(inout) :: y_out ! Output at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_Output_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(y)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(y) - 1 - IF ( order .eq. 0 ) THEN - CALL FVW_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL FVW_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL FVW_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE FVW_Output_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'FVW_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call FVW_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call FVW_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call FVW_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE FVW_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE FVW_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 1. @@ -5390,55 +5346,51 @@ SUBROUTINE FVW_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(FVW_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 - TYPE(FVW_OutputType), INTENT(IN) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(FVW_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(FVW_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 + TYPE(FVW_OutputType), INTENT(IN) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(FVW_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_Output_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%W) .AND. ALLOCATED(y1%W)) THEN + DO i01 = LBOUND(y_out%W,1),UBOUND(y_out%W,1) + IF (ALLOCATED(y_out%W(i01)%Vind) .AND. ALLOCATED(y1%W(i01)%Vind)) THEN + y_out%W(i01)%Vind = a1*y1%W(i01)%Vind + a2*y2%W(i01)%Vind + END IF ! check if allocated + END DO + END IF ! check if allocated +END SUBROUTINE - ScaleFactor = t_out / t(2) -IF (ALLOCATED(y_out%W) .AND. ALLOCATED(y1%W)) THEN - DO i01 = LBOUND(y_out%W,1),UBOUND(y_out%W,1) -IF (ALLOCATED(y_out%W(i01)%Vind) .AND. ALLOCATED(y1%W(i01)%Vind)) THEN - DO i2 = LBOUND(y_out%W(i01)%Vind,2),UBOUND(y_out%W(i01)%Vind,2) - DO i1 = LBOUND(y_out%W(i01)%Vind,1),UBOUND(y_out%W(i01)%Vind,1) - b = -(y1%W(i01)%Vind(i1,i2) - y2%W(i01)%Vind(i1,i2)) - y_out%W(i01)%Vind(i1,i2) = y1%W(i01)%Vind(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated - ENDDO -END IF ! check if allocated - END SUBROUTINE FVW_Output_ExtrapInterp1 - - - SUBROUTINE FVW_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE FVW_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 2. @@ -5452,62 +5404,56 @@ SUBROUTINE FVW_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - TYPE(FVW_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 - TYPE(FVW_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 - TYPE(FVW_OutputType), INTENT(IN) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(FVW_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(FVW_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 + TYPE(FVW_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 + TYPE(FVW_OutputType), INTENT(IN) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(FVW_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) -IF (ALLOCATED(y_out%W) .AND. ALLOCATED(y1%W)) THEN - DO i01 = LBOUND(y_out%W,1),UBOUND(y_out%W,1) -IF (ALLOCATED(y_out%W(i01)%Vind) .AND. ALLOCATED(y1%W(i01)%Vind)) THEN - DO i2 = LBOUND(y_out%W(i01)%Vind,2),UBOUND(y_out%W(i01)%Vind,2) - DO i1 = LBOUND(y_out%W(i01)%Vind,1),UBOUND(y_out%W(i01)%Vind,1) - b = (t(3)**2*(y1%W(i01)%Vind(i1,i2) - y2%W(i01)%Vind(i1,i2)) + t(2)**2*(-y1%W(i01)%Vind(i1,i2) + y3%W(i01)%Vind(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%W(i01)%Vind(i1,i2) + t(3)*y2%W(i01)%Vind(i1,i2) - t(2)*y3%W(i01)%Vind(i1,i2) ) * scaleFactor - y_out%W(i01)%Vind(i1,i2) = y1%W(i01)%Vind(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated - ENDDO -END IF ! check if allocated - END SUBROUTINE FVW_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%W) .AND. ALLOCATED(y1%W)) THEN + DO i01 = LBOUND(y_out%W,1),UBOUND(y_out%W,1) + IF (ALLOCATED(y_out%W(i01)%Vind) .AND. ALLOCATED(y1%W(i01)%Vind)) THEN + y_out%W(i01)%Vind = a1*y1%W(i01)%Vind + a2*y2%W(i01)%Vind + a3*y3%W(i01)%Vind + END IF ! check if allocated + END DO + END IF ! check if allocated +END SUBROUTINE END MODULE FVW_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/UnsteadyAero_Types.f90 b/modules/aerodyn/src/UnsteadyAero_Types.f90 index 0ecc3897fb..fa003b201c 100644 --- a/modules/aerodyn/src/UnsteadyAero_Types.f90 +++ b/modules/aerodyn/src/UnsteadyAero_Types.f90 @@ -3247,58 +3247,59 @@ subroutine UA_UnPackOutput(Buf, OutData) end if end subroutine - SUBROUTINE UA_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(UA_InputType), INTENT(IN) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(UA_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None +subroutine UA_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time + ! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(UA_InputType), intent(in) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(UA_InputType), intent(inout) :: u_out ! Input at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'UA_Input_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(u)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(u) - 1 - IF ( order .eq. 0 ) THEN - CALL UA_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL UA_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL UA_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE UA_Input_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'UA_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call UA_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call UA_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call UA_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE UA_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE UA_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 1. @@ -3310,54 +3311,48 @@ SUBROUTINE UA_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! !.................................................................................................................................. - TYPE(UA_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 - TYPE(UA_InputType), INTENT(IN) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(UA_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(UA_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 + TYPE(UA_InputType), INTENT(IN) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(UA_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'UA_Input_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'UA_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF - - ScaleFactor = t_out / t(2) - b = -(u1%U - u2%U) - u_out%U = u1%U + b * ScaleFactor - CALL Angles_ExtrapInterp( u1%alpha, u2%alpha, tin, u_out%alpha, tin_out ) - b = -(u1%Re - u2%Re) - u_out%Re = u1%Re + b * ScaleFactor - b = -(u1%UserProp - u2%UserProp) - u_out%UserProp = u1%UserProp + b * ScaleFactor - DO i1 = LBOUND(u_out%v_ac,1),UBOUND(u_out%v_ac,1) - b = -(u1%v_ac(i1) - u2%v_ac(i1)) - u_out%v_ac(i1) = u1%v_ac(i1) + b * ScaleFactor - END DO - b = -(u1%omega - u2%omega) - u_out%omega = u1%omega + b * ScaleFactor - END SUBROUTINE UA_Input_ExtrapInterp1 - - - SUBROUTINE UA_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + u_out%U = a1*u1%U + a2*u2%U + CALL Angles_ExtrapInterp( u1%alpha, u2%alpha, tin, u_out%alpha, tin_out ) + u_out%Re = a1*u1%Re + a2*u2%Re + u_out%UserProp = a1*u1%UserProp + a2*u2%UserProp + u_out%v_ac = a1*u1%v_ac + a2*u2%v_ac + u_out%omega = a1*u1%omega + a2*u2%omega +END SUBROUTINE + +SUBROUTINE UA_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 2. @@ -3371,119 +3366,108 @@ SUBROUTINE UA_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM ! !.................................................................................................................................. - TYPE(UA_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 - TYPE(UA_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 - TYPE(UA_InputType), INTENT(IN) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(UA_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(UA_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 + TYPE(UA_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 + TYPE(UA_InputType), INTENT(IN) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(UA_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'UA_Input_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'UA_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) - b = (t(3)**2*(u1%U - u2%U) + t(2)**2*(-u1%U + u3%U))* scaleFactor - c = ( (t(2)-t(3))*u1%U + t(3)*u2%U - t(2)*u3%U ) * scaleFactor - u_out%U = u1%U + b + c * t_out - CALL Angles_ExtrapInterp( u1%alpha, u2%alpha, u3%alpha, tin, u_out%alpha, tin_out ) - b = (t(3)**2*(u1%Re - u2%Re) + t(2)**2*(-u1%Re + u3%Re))* scaleFactor - c = ( (t(2)-t(3))*u1%Re + t(3)*u2%Re - t(2)*u3%Re ) * scaleFactor - u_out%Re = u1%Re + b + c * t_out - b = (t(3)**2*(u1%UserProp - u2%UserProp) + t(2)**2*(-u1%UserProp + u3%UserProp))* scaleFactor - c = ( (t(2)-t(3))*u1%UserProp + t(3)*u2%UserProp - t(2)*u3%UserProp ) * scaleFactor - u_out%UserProp = u1%UserProp + b + c * t_out - DO i1 = LBOUND(u_out%v_ac,1),UBOUND(u_out%v_ac,1) - b = (t(3)**2*(u1%v_ac(i1) - u2%v_ac(i1)) + t(2)**2*(-u1%v_ac(i1) + u3%v_ac(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%v_ac(i1) + t(3)*u2%v_ac(i1) - t(2)*u3%v_ac(i1) ) * scaleFactor - u_out%v_ac(i1) = u1%v_ac(i1) + b + c * t_out - END DO - b = (t(3)**2*(u1%omega - u2%omega) + t(2)**2*(-u1%omega + u3%omega))* scaleFactor - c = ( (t(2)-t(3))*u1%omega + t(3)*u2%omega - t(2)*u3%omega ) * scaleFactor - u_out%omega = u1%omega + b + c * t_out - END SUBROUTINE UA_Input_ExtrapInterp2 - - - SUBROUTINE UA_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(UA_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(UA_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + u_out%U = a1*u1%U + a2*u2%U + a3*u3%U + CALL Angles_ExtrapInterp( u1%alpha, u2%alpha, u3%alpha, tin, u_out%alpha, tin_out ) + u_out%Re = a1*u1%Re + a2*u2%Re + a3*u3%Re + u_out%UserProp = a1*u1%UserProp + a2*u2%UserProp + a3*u3%UserProp + u_out%v_ac = a1*u1%v_ac + a2*u2%v_ac + a3*u3%v_ac + u_out%omega = a1*u1%omega + a2*u2%omega + a3*u3%omega +END SUBROUTINE + +subroutine UA_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time + ! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(UA_OutputType), intent(in) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(UA_OutputType), intent(inout) :: y_out ! Output at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'UA_Output_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(y)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(y) - 1 - IF ( order .eq. 0 ) THEN - CALL UA_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL UA_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL UA_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE UA_Output_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'UA_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call UA_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call UA_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call UA_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE UA_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE UA_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 1. @@ -3495,57 +3479,50 @@ SUBROUTINE UA_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(UA_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 - TYPE(UA_OutputType), INTENT(IN) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(UA_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(UA_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 + TYPE(UA_OutputType), INTENT(IN) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(UA_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'UA_Output_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'UA_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF - - ScaleFactor = t_out / t(2) - b = -(y1%Cn - y2%Cn) - y_out%Cn = y1%Cn + b * ScaleFactor - b = -(y1%Cc - y2%Cc) - y_out%Cc = y1%Cc + b * ScaleFactor - b = -(y1%Cm - y2%Cm) - y_out%Cm = y1%Cm + b * ScaleFactor - b = -(y1%Cl - y2%Cl) - y_out%Cl = y1%Cl + b * ScaleFactor - b = -(y1%Cd - y2%Cd) - y_out%Cd = y1%Cd + b * ScaleFactor -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE UA_Output_ExtrapInterp1 - - - SUBROUTINE UA_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + y_out%Cn = a1*y1%Cn + a2*y2%Cn + y_out%Cc = a1*y1%Cc + a2*y2%Cc + y_out%Cm = a1*y1%Cm + a2*y2%Cm + y_out%Cl = a1*y1%Cl + a2*y2%Cl + y_out%Cd = a1*y1%Cd + a2*y2%Cd + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE UA_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 2. @@ -3559,69 +3536,55 @@ SUBROUTINE UA_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - TYPE(UA_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 - TYPE(UA_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 - TYPE(UA_OutputType), INTENT(IN) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(UA_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(UA_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 + TYPE(UA_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 + TYPE(UA_OutputType), INTENT(IN) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(UA_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'UA_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'UA_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) - b = (t(3)**2*(y1%Cn - y2%Cn) + t(2)**2*(-y1%Cn + y3%Cn))* scaleFactor - c = ( (t(2)-t(3))*y1%Cn + t(3)*y2%Cn - t(2)*y3%Cn ) * scaleFactor - y_out%Cn = y1%Cn + b + c * t_out - b = (t(3)**2*(y1%Cc - y2%Cc) + t(2)**2*(-y1%Cc + y3%Cc))* scaleFactor - c = ( (t(2)-t(3))*y1%Cc + t(3)*y2%Cc - t(2)*y3%Cc ) * scaleFactor - y_out%Cc = y1%Cc + b + c * t_out - b = (t(3)**2*(y1%Cm - y2%Cm) + t(2)**2*(-y1%Cm + y3%Cm))* scaleFactor - c = ( (t(2)-t(3))*y1%Cm + t(3)*y2%Cm - t(2)*y3%Cm ) * scaleFactor - y_out%Cm = y1%Cm + b + c * t_out - b = (t(3)**2*(y1%Cl - y2%Cl) + t(2)**2*(-y1%Cl + y3%Cl))* scaleFactor - c = ( (t(2)-t(3))*y1%Cl + t(3)*y2%Cl - t(2)*y3%Cl ) * scaleFactor - y_out%Cl = y1%Cl + b + c * t_out - b = (t(3)**2*(y1%Cd - y2%Cd) + t(2)**2*(-y1%Cd + y3%Cd))* scaleFactor - c = ( (t(2)-t(3))*y1%Cd + t(3)*y2%Cd - t(2)*y3%Cd ) * scaleFactor - y_out%Cd = y1%Cd + b + c * t_out -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE UA_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + y_out%Cn = a1*y1%Cn + a2*y2%Cn + a3*y3%Cn + y_out%Cc = a1*y1%Cc + a2*y2%Cc + a3*y3%Cc + y_out%Cm = a1*y1%Cm + a2*y2%Cm + a3*y3%Cm + y_out%Cl = a1*y1%Cl + a2*y2%Cl + a3*y3%Cl + y_out%Cd = a1*y1%Cd + a2*y2%Cd + a3*y3%Cd + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated +END SUBROUTINE END MODULE UnsteadyAero_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn14/src/AeroDyn14_Types.f90 b/modules/aerodyn14/src/AeroDyn14_Types.f90 index 48afd94114..291c7bdd81 100644 --- a/modules/aerodyn14/src/AeroDyn14_Types.f90 +++ b/modules/aerodyn14/src/AeroDyn14_Types.f90 @@ -6479,58 +6479,59 @@ subroutine AD14_UnPackOutput(Buf, OutData) call MeshUnpack(Buf, OutData%Twr_OutputLoads) ! Twr_OutputLoads end subroutine - SUBROUTINE AD14_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(AD14_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(AD14_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None +subroutine AD14_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time + ! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(AD14_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(AD14_InputType), intent(inout) :: u_out ! Input at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_Input_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(u)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(u) - 1 - IF ( order .eq. 0 ) THEN - CALL AD14_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL AD14_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL AD14_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE AD14_Input_ExtrapInterp - - - SUBROUTINE AD14_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'AD14_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call AD14_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call AD14_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call AD14_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE AD14_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 1. @@ -6542,229 +6543,104 @@ SUBROUTINE AD14_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(AD14_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(AD14_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(AD14_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(AD14_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(AD14_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(AD14_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_Input_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i11 ! dim1 level 1 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i12 ! dim2 level 1 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'AD14_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i11 ! dim1 level 1 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i12 ! dim2 level 1 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF - - ScaleFactor = t_out / t(2) -IF (ALLOCATED(u_out%InputMarkers) .AND. ALLOCATED(u1%InputMarkers)) THEN - DO i1 = LBOUND(u_out%InputMarkers,1),UBOUND(u_out%InputMarkers,1) - CALL MeshExtrapInterp1(u1%InputMarkers(i1), u2%InputMarkers(i1), tin, u_out%InputMarkers(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - CALL MeshExtrapInterp1(u1%Twr_InputMarkers, u2%Twr_InputMarkers, tin, u_out%Twr_InputMarkers, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(u_out%TurbineComponents%Blade) .AND. ALLOCATED(u1%TurbineComponents%Blade)) THEN - DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%Position,1),UBOUND(u_out%TurbineComponents%Blade(i11)%Position,1) - b = -(u1%TurbineComponents%Blade(i11)%Position(i1) - u2%TurbineComponents%Blade(i11)%Position(i1)) - u_out%TurbineComponents%Blade(i11)%Position(i1) = u1%TurbineComponents%Blade(i11)%Position(i1) + b * ScaleFactor - END DO - ENDDO - DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - DO i2 = LBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,2),UBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,1),UBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,1) - b = -(u1%TurbineComponents%Blade(i11)%Orientation(i1,i2) - u2%TurbineComponents%Blade(i11)%Orientation(i1,i2)) - u_out%TurbineComponents%Blade(i11)%Orientation(i1,i2) = u1%TurbineComponents%Blade(i11)%Orientation(i1,i2) + b * ScaleFactor - END DO - END DO - ENDDO - DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%TranslationVel,1),UBOUND(u_out%TurbineComponents%Blade(i11)%TranslationVel,1) - b = -(u1%TurbineComponents%Blade(i11)%TranslationVel(i1) - u2%TurbineComponents%Blade(i11)%TranslationVel(i1)) - u_out%TurbineComponents%Blade(i11)%TranslationVel(i1) = u1%TurbineComponents%Blade(i11)%TranslationVel(i1) + b * ScaleFactor - END DO - ENDDO - DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%RotationVel,1),UBOUND(u_out%TurbineComponents%Blade(i11)%RotationVel,1) - b = -(u1%TurbineComponents%Blade(i11)%RotationVel(i1) - u2%TurbineComponents%Blade(i11)%RotationVel(i1)) - u_out%TurbineComponents%Blade(i11)%RotationVel(i1) = u1%TurbineComponents%Blade(i11)%RotationVel(i1) + b * ScaleFactor - END DO - ENDDO -END IF ! check if allocated - DO i1 = LBOUND(u_out%TurbineComponents%Hub%Position,1),UBOUND(u_out%TurbineComponents%Hub%Position,1) - b = -(u1%TurbineComponents%Hub%Position(i1) - u2%TurbineComponents%Hub%Position(i1)) - u_out%TurbineComponents%Hub%Position(i1) = u1%TurbineComponents%Hub%Position(i1) + b * ScaleFactor - END DO - DO i2 = LBOUND(u_out%TurbineComponents%Hub%Orientation,2),UBOUND(u_out%TurbineComponents%Hub%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%Hub%Orientation,1),UBOUND(u_out%TurbineComponents%Hub%Orientation,1) - b = -(u1%TurbineComponents%Hub%Orientation(i1,i2) - u2%TurbineComponents%Hub%Orientation(i1,i2)) - u_out%TurbineComponents%Hub%Orientation(i1,i2) = u1%TurbineComponents%Hub%Orientation(i1,i2) + b * ScaleFactor - END DO - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Hub%TranslationVel,1),UBOUND(u_out%TurbineComponents%Hub%TranslationVel,1) - b = -(u1%TurbineComponents%Hub%TranslationVel(i1) - u2%TurbineComponents%Hub%TranslationVel(i1)) - u_out%TurbineComponents%Hub%TranslationVel(i1) = u1%TurbineComponents%Hub%TranslationVel(i1) + b * ScaleFactor - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Hub%RotationVel,1),UBOUND(u_out%TurbineComponents%Hub%RotationVel,1) - b = -(u1%TurbineComponents%Hub%RotationVel(i1) - u2%TurbineComponents%Hub%RotationVel(i1)) - u_out%TurbineComponents%Hub%RotationVel(i1) = u1%TurbineComponents%Hub%RotationVel(i1) + b * ScaleFactor - END DO - DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%Position,1),UBOUND(u_out%TurbineComponents%RotorFurl%Position,1) - b = -(u1%TurbineComponents%RotorFurl%Position(i1) - u2%TurbineComponents%RotorFurl%Position(i1)) - u_out%TurbineComponents%RotorFurl%Position(i1) = u1%TurbineComponents%RotorFurl%Position(i1) + b * ScaleFactor - END DO - DO i2 = LBOUND(u_out%TurbineComponents%RotorFurl%Orientation,2),UBOUND(u_out%TurbineComponents%RotorFurl%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%Orientation,1),UBOUND(u_out%TurbineComponents%RotorFurl%Orientation,1) - b = -(u1%TurbineComponents%RotorFurl%Orientation(i1,i2) - u2%TurbineComponents%RotorFurl%Orientation(i1,i2)) - u_out%TurbineComponents%RotorFurl%Orientation(i1,i2) = u1%TurbineComponents%RotorFurl%Orientation(i1,i2) + b * ScaleFactor - END DO - END DO - DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%TranslationVel,1),UBOUND(u_out%TurbineComponents%RotorFurl%TranslationVel,1) - b = -(u1%TurbineComponents%RotorFurl%TranslationVel(i1) - u2%TurbineComponents%RotorFurl%TranslationVel(i1)) - u_out%TurbineComponents%RotorFurl%TranslationVel(i1) = u1%TurbineComponents%RotorFurl%TranslationVel(i1) + b * ScaleFactor - END DO - DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%RotationVel,1),UBOUND(u_out%TurbineComponents%RotorFurl%RotationVel,1) - b = -(u1%TurbineComponents%RotorFurl%RotationVel(i1) - u2%TurbineComponents%RotorFurl%RotationVel(i1)) - u_out%TurbineComponents%RotorFurl%RotationVel(i1) = u1%TurbineComponents%RotorFurl%RotationVel(i1) + b * ScaleFactor - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%Position,1),UBOUND(u_out%TurbineComponents%Nacelle%Position,1) - b = -(u1%TurbineComponents%Nacelle%Position(i1) - u2%TurbineComponents%Nacelle%Position(i1)) - u_out%TurbineComponents%Nacelle%Position(i1) = u1%TurbineComponents%Nacelle%Position(i1) + b * ScaleFactor - END DO - DO i2 = LBOUND(u_out%TurbineComponents%Nacelle%Orientation,2),UBOUND(u_out%TurbineComponents%Nacelle%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%Orientation,1),UBOUND(u_out%TurbineComponents%Nacelle%Orientation,1) - b = -(u1%TurbineComponents%Nacelle%Orientation(i1,i2) - u2%TurbineComponents%Nacelle%Orientation(i1,i2)) - u_out%TurbineComponents%Nacelle%Orientation(i1,i2) = u1%TurbineComponents%Nacelle%Orientation(i1,i2) + b * ScaleFactor - END DO - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%TranslationVel,1),UBOUND(u_out%TurbineComponents%Nacelle%TranslationVel,1) - b = -(u1%TurbineComponents%Nacelle%TranslationVel(i1) - u2%TurbineComponents%Nacelle%TranslationVel(i1)) - u_out%TurbineComponents%Nacelle%TranslationVel(i1) = u1%TurbineComponents%Nacelle%TranslationVel(i1) + b * ScaleFactor - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%RotationVel,1),UBOUND(u_out%TurbineComponents%Nacelle%RotationVel,1) - b = -(u1%TurbineComponents%Nacelle%RotationVel(i1) - u2%TurbineComponents%Nacelle%RotationVel(i1)) - u_out%TurbineComponents%Nacelle%RotationVel(i1) = u1%TurbineComponents%Nacelle%RotationVel(i1) + b * ScaleFactor - END DO - DO i1 = LBOUND(u_out%TurbineComponents%TailFin%Position,1),UBOUND(u_out%TurbineComponents%TailFin%Position,1) - b = -(u1%TurbineComponents%TailFin%Position(i1) - u2%TurbineComponents%TailFin%Position(i1)) - u_out%TurbineComponents%TailFin%Position(i1) = u1%TurbineComponents%TailFin%Position(i1) + b * ScaleFactor - END DO - DO i2 = LBOUND(u_out%TurbineComponents%TailFin%Orientation,2),UBOUND(u_out%TurbineComponents%TailFin%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%TailFin%Orientation,1),UBOUND(u_out%TurbineComponents%TailFin%Orientation,1) - b = -(u1%TurbineComponents%TailFin%Orientation(i1,i2) - u2%TurbineComponents%TailFin%Orientation(i1,i2)) - u_out%TurbineComponents%TailFin%Orientation(i1,i2) = u1%TurbineComponents%TailFin%Orientation(i1,i2) + b * ScaleFactor - END DO - END DO - DO i1 = LBOUND(u_out%TurbineComponents%TailFin%TranslationVel,1),UBOUND(u_out%TurbineComponents%TailFin%TranslationVel,1) - b = -(u1%TurbineComponents%TailFin%TranslationVel(i1) - u2%TurbineComponents%TailFin%TranslationVel(i1)) - u_out%TurbineComponents%TailFin%TranslationVel(i1) = u1%TurbineComponents%TailFin%TranslationVel(i1) + b * ScaleFactor - END DO - DO i1 = LBOUND(u_out%TurbineComponents%TailFin%RotationVel,1),UBOUND(u_out%TurbineComponents%TailFin%RotationVel,1) - b = -(u1%TurbineComponents%TailFin%RotationVel(i1) - u2%TurbineComponents%TailFin%RotationVel(i1)) - u_out%TurbineComponents%TailFin%RotationVel(i1) = u1%TurbineComponents%TailFin%RotationVel(i1) + b * ScaleFactor - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Tower%Position,1),UBOUND(u_out%TurbineComponents%Tower%Position,1) - b = -(u1%TurbineComponents%Tower%Position(i1) - u2%TurbineComponents%Tower%Position(i1)) - u_out%TurbineComponents%Tower%Position(i1) = u1%TurbineComponents%Tower%Position(i1) + b * ScaleFactor - END DO - DO i2 = LBOUND(u_out%TurbineComponents%Tower%Orientation,2),UBOUND(u_out%TurbineComponents%Tower%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%Tower%Orientation,1),UBOUND(u_out%TurbineComponents%Tower%Orientation,1) - b = -(u1%TurbineComponents%Tower%Orientation(i1,i2) - u2%TurbineComponents%Tower%Orientation(i1,i2)) - u_out%TurbineComponents%Tower%Orientation(i1,i2) = u1%TurbineComponents%Tower%Orientation(i1,i2) + b * ScaleFactor - END DO - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Tower%TranslationVel,1),UBOUND(u_out%TurbineComponents%Tower%TranslationVel,1) - b = -(u1%TurbineComponents%Tower%TranslationVel(i1) - u2%TurbineComponents%Tower%TranslationVel(i1)) - u_out%TurbineComponents%Tower%TranslationVel(i1) = u1%TurbineComponents%Tower%TranslationVel(i1) + b * ScaleFactor - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Tower%RotationVel,1),UBOUND(u_out%TurbineComponents%Tower%RotationVel,1) - b = -(u1%TurbineComponents%Tower%RotationVel(i1) - u2%TurbineComponents%Tower%RotationVel(i1)) - u_out%TurbineComponents%Tower%RotationVel(i1) = u1%TurbineComponents%Tower%RotationVel(i1) + b * ScaleFactor - END DO - DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%Position,1),UBOUND(u_out%TurbineComponents%SubStructure%Position,1) - b = -(u1%TurbineComponents%SubStructure%Position(i1) - u2%TurbineComponents%SubStructure%Position(i1)) - u_out%TurbineComponents%SubStructure%Position(i1) = u1%TurbineComponents%SubStructure%Position(i1) + b * ScaleFactor - END DO - DO i2 = LBOUND(u_out%TurbineComponents%SubStructure%Orientation,2),UBOUND(u_out%TurbineComponents%SubStructure%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%Orientation,1),UBOUND(u_out%TurbineComponents%SubStructure%Orientation,1) - b = -(u1%TurbineComponents%SubStructure%Orientation(i1,i2) - u2%TurbineComponents%SubStructure%Orientation(i1,i2)) - u_out%TurbineComponents%SubStructure%Orientation(i1,i2) = u1%TurbineComponents%SubStructure%Orientation(i1,i2) + b * ScaleFactor - END DO - END DO - DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%TranslationVel,1),UBOUND(u_out%TurbineComponents%SubStructure%TranslationVel,1) - b = -(u1%TurbineComponents%SubStructure%TranslationVel(i1) - u2%TurbineComponents%SubStructure%TranslationVel(i1)) - u_out%TurbineComponents%SubStructure%TranslationVel(i1) = u1%TurbineComponents%SubStructure%TranslationVel(i1) + b * ScaleFactor - END DO - DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%RotationVel,1),UBOUND(u_out%TurbineComponents%SubStructure%RotationVel,1) - b = -(u1%TurbineComponents%SubStructure%RotationVel(i1) - u2%TurbineComponents%SubStructure%RotationVel(i1)) - u_out%TurbineComponents%SubStructure%RotationVel(i1) = u1%TurbineComponents%SubStructure%RotationVel(i1) + b * ScaleFactor - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Foundation%Position,1),UBOUND(u_out%TurbineComponents%Foundation%Position,1) - b = -(u1%TurbineComponents%Foundation%Position(i1) - u2%TurbineComponents%Foundation%Position(i1)) - u_out%TurbineComponents%Foundation%Position(i1) = u1%TurbineComponents%Foundation%Position(i1) + b * ScaleFactor - END DO - DO i2 = LBOUND(u_out%TurbineComponents%Foundation%Orientation,2),UBOUND(u_out%TurbineComponents%Foundation%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%Foundation%Orientation,1),UBOUND(u_out%TurbineComponents%Foundation%Orientation,1) - b = -(u1%TurbineComponents%Foundation%Orientation(i1,i2) - u2%TurbineComponents%Foundation%Orientation(i1,i2)) - u_out%TurbineComponents%Foundation%Orientation(i1,i2) = u1%TurbineComponents%Foundation%Orientation(i1,i2) + b * ScaleFactor - END DO - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Foundation%TranslationVel,1),UBOUND(u_out%TurbineComponents%Foundation%TranslationVel,1) - b = -(u1%TurbineComponents%Foundation%TranslationVel(i1) - u2%TurbineComponents%Foundation%TranslationVel(i1)) - u_out%TurbineComponents%Foundation%TranslationVel(i1) = u1%TurbineComponents%Foundation%TranslationVel(i1) + b * ScaleFactor - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Foundation%RotationVel,1),UBOUND(u_out%TurbineComponents%Foundation%RotationVel,1) - b = -(u1%TurbineComponents%Foundation%RotationVel(i1) - u2%TurbineComponents%Foundation%RotationVel(i1)) - u_out%TurbineComponents%Foundation%RotationVel(i1) = u1%TurbineComponents%Foundation%RotationVel(i1) + b * ScaleFactor - END DO - b = -(u1%TurbineComponents%BladeLength - u2%TurbineComponents%BladeLength) - u_out%TurbineComponents%BladeLength = u1%TurbineComponents%BladeLength + b * ScaleFactor -IF (ALLOCATED(u_out%MulTabLoc) .AND. ALLOCATED(u1%MulTabLoc)) THEN - DO i2 = LBOUND(u_out%MulTabLoc,2),UBOUND(u_out%MulTabLoc,2) - DO i1 = LBOUND(u_out%MulTabLoc,1),UBOUND(u_out%MulTabLoc,1) - b = -(u1%MulTabLoc(i1,i2) - u2%MulTabLoc(i1,i2)) - u_out%MulTabLoc(i1,i2) = u1%MulTabLoc(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%InflowVelocity) .AND. ALLOCATED(u1%InflowVelocity)) THEN - DO i2 = LBOUND(u_out%InflowVelocity,2),UBOUND(u_out%InflowVelocity,2) - DO i1 = LBOUND(u_out%InflowVelocity,1),UBOUND(u_out%InflowVelocity,1) - b = -(u1%InflowVelocity(i1,i2) - u2%InflowVelocity(i1,i2)) - u_out%InflowVelocity(i1,i2) = u1%InflowVelocity(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated - DO i1 = LBOUND(u_out%AvgInfVel,1),UBOUND(u_out%AvgInfVel,1) - b = -(u1%AvgInfVel(i1) - u2%AvgInfVel(i1)) - u_out%AvgInfVel(i1) = u1%AvgInfVel(i1) + b * ScaleFactor - END DO - END SUBROUTINE AD14_Input_ExtrapInterp1 - - - SUBROUTINE AD14_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(u_out%InputMarkers) .AND. ALLOCATED(u1%InputMarkers)) THEN + DO i1 = LBOUND(u_out%InputMarkers,1),UBOUND(u_out%InputMarkers,1) + CALL MeshExtrapInterp1(u1%InputMarkers(i1), u2%InputMarkers(i1), tin, u_out%InputMarkers(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + CALL MeshExtrapInterp1(u1%Twr_InputMarkers, u2%Twr_InputMarkers, tin, u_out%Twr_InputMarkers, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(u_out%TurbineComponents%Blade) .AND. ALLOCATED(u1%TurbineComponents%Blade)) THEN + DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) + u_out%TurbineComponents%Blade(i11)%Position = a1*u1%TurbineComponents%Blade(i11)%Position + a2*u2%TurbineComponents%Blade(i11)%Position + END DO + DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) + u_out%TurbineComponents%Blade(i11)%Orientation = a1*u1%TurbineComponents%Blade(i11)%Orientation + a2*u2%TurbineComponents%Blade(i11)%Orientation + END DO + DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) + u_out%TurbineComponents%Blade(i11)%TranslationVel = a1*u1%TurbineComponents%Blade(i11)%TranslationVel + a2*u2%TurbineComponents%Blade(i11)%TranslationVel + END DO + DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) + u_out%TurbineComponents%Blade(i11)%RotationVel = a1*u1%TurbineComponents%Blade(i11)%RotationVel + a2*u2%TurbineComponents%Blade(i11)%RotationVel + END DO + END IF ! check if allocated + u_out%TurbineComponents%Hub%Position = a1*u1%TurbineComponents%Hub%Position + a2*u2%TurbineComponents%Hub%Position + u_out%TurbineComponents%Hub%Orientation = a1*u1%TurbineComponents%Hub%Orientation + a2*u2%TurbineComponents%Hub%Orientation + u_out%TurbineComponents%Hub%TranslationVel = a1*u1%TurbineComponents%Hub%TranslationVel + a2*u2%TurbineComponents%Hub%TranslationVel + u_out%TurbineComponents%Hub%RotationVel = a1*u1%TurbineComponents%Hub%RotationVel + a2*u2%TurbineComponents%Hub%RotationVel + u_out%TurbineComponents%RotorFurl%Position = a1*u1%TurbineComponents%RotorFurl%Position + a2*u2%TurbineComponents%RotorFurl%Position + u_out%TurbineComponents%RotorFurl%Orientation = a1*u1%TurbineComponents%RotorFurl%Orientation + a2*u2%TurbineComponents%RotorFurl%Orientation + u_out%TurbineComponents%RotorFurl%TranslationVel = a1*u1%TurbineComponents%RotorFurl%TranslationVel + a2*u2%TurbineComponents%RotorFurl%TranslationVel + u_out%TurbineComponents%RotorFurl%RotationVel = a1*u1%TurbineComponents%RotorFurl%RotationVel + a2*u2%TurbineComponents%RotorFurl%RotationVel + u_out%TurbineComponents%Nacelle%Position = a1*u1%TurbineComponents%Nacelle%Position + a2*u2%TurbineComponents%Nacelle%Position + u_out%TurbineComponents%Nacelle%Orientation = a1*u1%TurbineComponents%Nacelle%Orientation + a2*u2%TurbineComponents%Nacelle%Orientation + u_out%TurbineComponents%Nacelle%TranslationVel = a1*u1%TurbineComponents%Nacelle%TranslationVel + a2*u2%TurbineComponents%Nacelle%TranslationVel + u_out%TurbineComponents%Nacelle%RotationVel = a1*u1%TurbineComponents%Nacelle%RotationVel + a2*u2%TurbineComponents%Nacelle%RotationVel + u_out%TurbineComponents%TailFin%Position = a1*u1%TurbineComponents%TailFin%Position + a2*u2%TurbineComponents%TailFin%Position + u_out%TurbineComponents%TailFin%Orientation = a1*u1%TurbineComponents%TailFin%Orientation + a2*u2%TurbineComponents%TailFin%Orientation + u_out%TurbineComponents%TailFin%TranslationVel = a1*u1%TurbineComponents%TailFin%TranslationVel + a2*u2%TurbineComponents%TailFin%TranslationVel + u_out%TurbineComponents%TailFin%RotationVel = a1*u1%TurbineComponents%TailFin%RotationVel + a2*u2%TurbineComponents%TailFin%RotationVel + u_out%TurbineComponents%Tower%Position = a1*u1%TurbineComponents%Tower%Position + a2*u2%TurbineComponents%Tower%Position + u_out%TurbineComponents%Tower%Orientation = a1*u1%TurbineComponents%Tower%Orientation + a2*u2%TurbineComponents%Tower%Orientation + u_out%TurbineComponents%Tower%TranslationVel = a1*u1%TurbineComponents%Tower%TranslationVel + a2*u2%TurbineComponents%Tower%TranslationVel + u_out%TurbineComponents%Tower%RotationVel = a1*u1%TurbineComponents%Tower%RotationVel + a2*u2%TurbineComponents%Tower%RotationVel + u_out%TurbineComponents%SubStructure%Position = a1*u1%TurbineComponents%SubStructure%Position + a2*u2%TurbineComponents%SubStructure%Position + u_out%TurbineComponents%SubStructure%Orientation = a1*u1%TurbineComponents%SubStructure%Orientation + a2*u2%TurbineComponents%SubStructure%Orientation + u_out%TurbineComponents%SubStructure%TranslationVel = a1*u1%TurbineComponents%SubStructure%TranslationVel + a2*u2%TurbineComponents%SubStructure%TranslationVel + u_out%TurbineComponents%SubStructure%RotationVel = a1*u1%TurbineComponents%SubStructure%RotationVel + a2*u2%TurbineComponents%SubStructure%RotationVel + u_out%TurbineComponents%Foundation%Position = a1*u1%TurbineComponents%Foundation%Position + a2*u2%TurbineComponents%Foundation%Position + u_out%TurbineComponents%Foundation%Orientation = a1*u1%TurbineComponents%Foundation%Orientation + a2*u2%TurbineComponents%Foundation%Orientation + u_out%TurbineComponents%Foundation%TranslationVel = a1*u1%TurbineComponents%Foundation%TranslationVel + a2*u2%TurbineComponents%Foundation%TranslationVel + u_out%TurbineComponents%Foundation%RotationVel = a1*u1%TurbineComponents%Foundation%RotationVel + a2*u2%TurbineComponents%Foundation%RotationVel + u_out%TurbineComponents%BladeLength = a1*u1%TurbineComponents%BladeLength + a2*u2%TurbineComponents%BladeLength + IF (ALLOCATED(u_out%MulTabLoc) .AND. ALLOCATED(u1%MulTabLoc)) THEN + u_out%MulTabLoc = a1*u1%MulTabLoc + a2*u2%MulTabLoc + END IF ! check if allocated + IF (ALLOCATED(u_out%InflowVelocity) .AND. ALLOCATED(u1%InflowVelocity)) THEN + u_out%InflowVelocity = a1*u1%InflowVelocity + a2*u2%InflowVelocity + END IF ! check if allocated + u_out%AvgInfVel = a1*u1%AvgInfVel + a2*u2%AvgInfVel +END SUBROUTINE + +SUBROUTINE AD14_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 2. @@ -6778,325 +6654,164 @@ SUBROUTINE AD14_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - TYPE(AD14_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(AD14_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(AD14_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(AD14_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(AD14_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(AD14_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(AD14_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(AD14_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_Input_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i11 ! dim1 level 1 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i12 ! dim2 level 1 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'AD14_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i11 ! dim1 level 1 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i12 ! dim2 level 1 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) -IF (ALLOCATED(u_out%InputMarkers) .AND. ALLOCATED(u1%InputMarkers)) THEN - DO i1 = LBOUND(u_out%InputMarkers,1),UBOUND(u_out%InputMarkers,1) - CALL MeshExtrapInterp2(u1%InputMarkers(i1), u2%InputMarkers(i1), u3%InputMarkers(i1), tin, u_out%InputMarkers(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - CALL MeshExtrapInterp2(u1%Twr_InputMarkers, u2%Twr_InputMarkers, u3%Twr_InputMarkers, tin, u_out%Twr_InputMarkers, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(u_out%TurbineComponents%Blade) .AND. ALLOCATED(u1%TurbineComponents%Blade)) THEN - DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%Position,1),UBOUND(u_out%TurbineComponents%Blade(i11)%Position,1) - b = (t(3)**2*(u1%TurbineComponents%Blade(i11)%Position(i1) - u2%TurbineComponents%Blade(i11)%Position(i1)) + t(2)**2*(-u1%TurbineComponents%Blade(i11)%Position(i1) + u3%TurbineComponents%Blade(i11)%Position(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Blade(i11)%Position(i1) + t(3)*u2%TurbineComponents%Blade(i11)%Position(i1) - t(2)*u3%TurbineComponents%Blade(i11)%Position(i1) ) * scaleFactor - u_out%TurbineComponents%Blade(i11)%Position(i1) = u1%TurbineComponents%Blade(i11)%Position(i1) + b + c * t_out - END DO - ENDDO - DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - DO i2 = LBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,2),UBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,1),UBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,1) - b = (t(3)**2*(u1%TurbineComponents%Blade(i11)%Orientation(i1,i2) - u2%TurbineComponents%Blade(i11)%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%Blade(i11)%Orientation(i1,i2) + u3%TurbineComponents%Blade(i11)%Orientation(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Blade(i11)%Orientation(i1,i2) + t(3)*u2%TurbineComponents%Blade(i11)%Orientation(i1,i2) - t(2)*u3%TurbineComponents%Blade(i11)%Orientation(i1,i2) ) * scaleFactor - u_out%TurbineComponents%Blade(i11)%Orientation(i1,i2) = u1%TurbineComponents%Blade(i11)%Orientation(i1,i2) + b + c * t_out - END DO - END DO - ENDDO - DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%TranslationVel,1),UBOUND(u_out%TurbineComponents%Blade(i11)%TranslationVel,1) - b = (t(3)**2*(u1%TurbineComponents%Blade(i11)%TranslationVel(i1) - u2%TurbineComponents%Blade(i11)%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Blade(i11)%TranslationVel(i1) + u3%TurbineComponents%Blade(i11)%TranslationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Blade(i11)%TranslationVel(i1) + t(3)*u2%TurbineComponents%Blade(i11)%TranslationVel(i1) - t(2)*u3%TurbineComponents%Blade(i11)%TranslationVel(i1) ) * scaleFactor - u_out%TurbineComponents%Blade(i11)%TranslationVel(i1) = u1%TurbineComponents%Blade(i11)%TranslationVel(i1) + b + c * t_out - END DO - ENDDO - DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%RotationVel,1),UBOUND(u_out%TurbineComponents%Blade(i11)%RotationVel,1) - b = (t(3)**2*(u1%TurbineComponents%Blade(i11)%RotationVel(i1) - u2%TurbineComponents%Blade(i11)%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Blade(i11)%RotationVel(i1) + u3%TurbineComponents%Blade(i11)%RotationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Blade(i11)%RotationVel(i1) + t(3)*u2%TurbineComponents%Blade(i11)%RotationVel(i1) - t(2)*u3%TurbineComponents%Blade(i11)%RotationVel(i1) ) * scaleFactor - u_out%TurbineComponents%Blade(i11)%RotationVel(i1) = u1%TurbineComponents%Blade(i11)%RotationVel(i1) + b + c * t_out - END DO - ENDDO -END IF ! check if allocated - DO i1 = LBOUND(u_out%TurbineComponents%Hub%Position,1),UBOUND(u_out%TurbineComponents%Hub%Position,1) - b = (t(3)**2*(u1%TurbineComponents%Hub%Position(i1) - u2%TurbineComponents%Hub%Position(i1)) + t(2)**2*(-u1%TurbineComponents%Hub%Position(i1) + u3%TurbineComponents%Hub%Position(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Hub%Position(i1) + t(3)*u2%TurbineComponents%Hub%Position(i1) - t(2)*u3%TurbineComponents%Hub%Position(i1) ) * scaleFactor - u_out%TurbineComponents%Hub%Position(i1) = u1%TurbineComponents%Hub%Position(i1) + b + c * t_out - END DO - DO i2 = LBOUND(u_out%TurbineComponents%Hub%Orientation,2),UBOUND(u_out%TurbineComponents%Hub%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%Hub%Orientation,1),UBOUND(u_out%TurbineComponents%Hub%Orientation,1) - b = (t(3)**2*(u1%TurbineComponents%Hub%Orientation(i1,i2) - u2%TurbineComponents%Hub%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%Hub%Orientation(i1,i2) + u3%TurbineComponents%Hub%Orientation(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Hub%Orientation(i1,i2) + t(3)*u2%TurbineComponents%Hub%Orientation(i1,i2) - t(2)*u3%TurbineComponents%Hub%Orientation(i1,i2) ) * scaleFactor - u_out%TurbineComponents%Hub%Orientation(i1,i2) = u1%TurbineComponents%Hub%Orientation(i1,i2) + b + c * t_out - END DO - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Hub%TranslationVel,1),UBOUND(u_out%TurbineComponents%Hub%TranslationVel,1) - b = (t(3)**2*(u1%TurbineComponents%Hub%TranslationVel(i1) - u2%TurbineComponents%Hub%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Hub%TranslationVel(i1) + u3%TurbineComponents%Hub%TranslationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Hub%TranslationVel(i1) + t(3)*u2%TurbineComponents%Hub%TranslationVel(i1) - t(2)*u3%TurbineComponents%Hub%TranslationVel(i1) ) * scaleFactor - u_out%TurbineComponents%Hub%TranslationVel(i1) = u1%TurbineComponents%Hub%TranslationVel(i1) + b + c * t_out - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Hub%RotationVel,1),UBOUND(u_out%TurbineComponents%Hub%RotationVel,1) - b = (t(3)**2*(u1%TurbineComponents%Hub%RotationVel(i1) - u2%TurbineComponents%Hub%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Hub%RotationVel(i1) + u3%TurbineComponents%Hub%RotationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Hub%RotationVel(i1) + t(3)*u2%TurbineComponents%Hub%RotationVel(i1) - t(2)*u3%TurbineComponents%Hub%RotationVel(i1) ) * scaleFactor - u_out%TurbineComponents%Hub%RotationVel(i1) = u1%TurbineComponents%Hub%RotationVel(i1) + b + c * t_out - END DO - DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%Position,1),UBOUND(u_out%TurbineComponents%RotorFurl%Position,1) - b = (t(3)**2*(u1%TurbineComponents%RotorFurl%Position(i1) - u2%TurbineComponents%RotorFurl%Position(i1)) + t(2)**2*(-u1%TurbineComponents%RotorFurl%Position(i1) + u3%TurbineComponents%RotorFurl%Position(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%RotorFurl%Position(i1) + t(3)*u2%TurbineComponents%RotorFurl%Position(i1) - t(2)*u3%TurbineComponents%RotorFurl%Position(i1) ) * scaleFactor - u_out%TurbineComponents%RotorFurl%Position(i1) = u1%TurbineComponents%RotorFurl%Position(i1) + b + c * t_out - END DO - DO i2 = LBOUND(u_out%TurbineComponents%RotorFurl%Orientation,2),UBOUND(u_out%TurbineComponents%RotorFurl%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%Orientation,1),UBOUND(u_out%TurbineComponents%RotorFurl%Orientation,1) - b = (t(3)**2*(u1%TurbineComponents%RotorFurl%Orientation(i1,i2) - u2%TurbineComponents%RotorFurl%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%RotorFurl%Orientation(i1,i2) + u3%TurbineComponents%RotorFurl%Orientation(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%RotorFurl%Orientation(i1,i2) + t(3)*u2%TurbineComponents%RotorFurl%Orientation(i1,i2) - t(2)*u3%TurbineComponents%RotorFurl%Orientation(i1,i2) ) * scaleFactor - u_out%TurbineComponents%RotorFurl%Orientation(i1,i2) = u1%TurbineComponents%RotorFurl%Orientation(i1,i2) + b + c * t_out - END DO - END DO - DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%TranslationVel,1),UBOUND(u_out%TurbineComponents%RotorFurl%TranslationVel,1) - b = (t(3)**2*(u1%TurbineComponents%RotorFurl%TranslationVel(i1) - u2%TurbineComponents%RotorFurl%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%RotorFurl%TranslationVel(i1) + u3%TurbineComponents%RotorFurl%TranslationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%RotorFurl%TranslationVel(i1) + t(3)*u2%TurbineComponents%RotorFurl%TranslationVel(i1) - t(2)*u3%TurbineComponents%RotorFurl%TranslationVel(i1) ) * scaleFactor - u_out%TurbineComponents%RotorFurl%TranslationVel(i1) = u1%TurbineComponents%RotorFurl%TranslationVel(i1) + b + c * t_out - END DO - DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%RotationVel,1),UBOUND(u_out%TurbineComponents%RotorFurl%RotationVel,1) - b = (t(3)**2*(u1%TurbineComponents%RotorFurl%RotationVel(i1) - u2%TurbineComponents%RotorFurl%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%RotorFurl%RotationVel(i1) + u3%TurbineComponents%RotorFurl%RotationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%RotorFurl%RotationVel(i1) + t(3)*u2%TurbineComponents%RotorFurl%RotationVel(i1) - t(2)*u3%TurbineComponents%RotorFurl%RotationVel(i1) ) * scaleFactor - u_out%TurbineComponents%RotorFurl%RotationVel(i1) = u1%TurbineComponents%RotorFurl%RotationVel(i1) + b + c * t_out - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%Position,1),UBOUND(u_out%TurbineComponents%Nacelle%Position,1) - b = (t(3)**2*(u1%TurbineComponents%Nacelle%Position(i1) - u2%TurbineComponents%Nacelle%Position(i1)) + t(2)**2*(-u1%TurbineComponents%Nacelle%Position(i1) + u3%TurbineComponents%Nacelle%Position(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Nacelle%Position(i1) + t(3)*u2%TurbineComponents%Nacelle%Position(i1) - t(2)*u3%TurbineComponents%Nacelle%Position(i1) ) * scaleFactor - u_out%TurbineComponents%Nacelle%Position(i1) = u1%TurbineComponents%Nacelle%Position(i1) + b + c * t_out - END DO - DO i2 = LBOUND(u_out%TurbineComponents%Nacelle%Orientation,2),UBOUND(u_out%TurbineComponents%Nacelle%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%Orientation,1),UBOUND(u_out%TurbineComponents%Nacelle%Orientation,1) - b = (t(3)**2*(u1%TurbineComponents%Nacelle%Orientation(i1,i2) - u2%TurbineComponents%Nacelle%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%Nacelle%Orientation(i1,i2) + u3%TurbineComponents%Nacelle%Orientation(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Nacelle%Orientation(i1,i2) + t(3)*u2%TurbineComponents%Nacelle%Orientation(i1,i2) - t(2)*u3%TurbineComponents%Nacelle%Orientation(i1,i2) ) * scaleFactor - u_out%TurbineComponents%Nacelle%Orientation(i1,i2) = u1%TurbineComponents%Nacelle%Orientation(i1,i2) + b + c * t_out - END DO - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%TranslationVel,1),UBOUND(u_out%TurbineComponents%Nacelle%TranslationVel,1) - b = (t(3)**2*(u1%TurbineComponents%Nacelle%TranslationVel(i1) - u2%TurbineComponents%Nacelle%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Nacelle%TranslationVel(i1) + u3%TurbineComponents%Nacelle%TranslationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Nacelle%TranslationVel(i1) + t(3)*u2%TurbineComponents%Nacelle%TranslationVel(i1) - t(2)*u3%TurbineComponents%Nacelle%TranslationVel(i1) ) * scaleFactor - u_out%TurbineComponents%Nacelle%TranslationVel(i1) = u1%TurbineComponents%Nacelle%TranslationVel(i1) + b + c * t_out - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%RotationVel,1),UBOUND(u_out%TurbineComponents%Nacelle%RotationVel,1) - b = (t(3)**2*(u1%TurbineComponents%Nacelle%RotationVel(i1) - u2%TurbineComponents%Nacelle%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Nacelle%RotationVel(i1) + u3%TurbineComponents%Nacelle%RotationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Nacelle%RotationVel(i1) + t(3)*u2%TurbineComponents%Nacelle%RotationVel(i1) - t(2)*u3%TurbineComponents%Nacelle%RotationVel(i1) ) * scaleFactor - u_out%TurbineComponents%Nacelle%RotationVel(i1) = u1%TurbineComponents%Nacelle%RotationVel(i1) + b + c * t_out - END DO - DO i1 = LBOUND(u_out%TurbineComponents%TailFin%Position,1),UBOUND(u_out%TurbineComponents%TailFin%Position,1) - b = (t(3)**2*(u1%TurbineComponents%TailFin%Position(i1) - u2%TurbineComponents%TailFin%Position(i1)) + t(2)**2*(-u1%TurbineComponents%TailFin%Position(i1) + u3%TurbineComponents%TailFin%Position(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%TailFin%Position(i1) + t(3)*u2%TurbineComponents%TailFin%Position(i1) - t(2)*u3%TurbineComponents%TailFin%Position(i1) ) * scaleFactor - u_out%TurbineComponents%TailFin%Position(i1) = u1%TurbineComponents%TailFin%Position(i1) + b + c * t_out - END DO - DO i2 = LBOUND(u_out%TurbineComponents%TailFin%Orientation,2),UBOUND(u_out%TurbineComponents%TailFin%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%TailFin%Orientation,1),UBOUND(u_out%TurbineComponents%TailFin%Orientation,1) - b = (t(3)**2*(u1%TurbineComponents%TailFin%Orientation(i1,i2) - u2%TurbineComponents%TailFin%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%TailFin%Orientation(i1,i2) + u3%TurbineComponents%TailFin%Orientation(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%TailFin%Orientation(i1,i2) + t(3)*u2%TurbineComponents%TailFin%Orientation(i1,i2) - t(2)*u3%TurbineComponents%TailFin%Orientation(i1,i2) ) * scaleFactor - u_out%TurbineComponents%TailFin%Orientation(i1,i2) = u1%TurbineComponents%TailFin%Orientation(i1,i2) + b + c * t_out - END DO - END DO - DO i1 = LBOUND(u_out%TurbineComponents%TailFin%TranslationVel,1),UBOUND(u_out%TurbineComponents%TailFin%TranslationVel,1) - b = (t(3)**2*(u1%TurbineComponents%TailFin%TranslationVel(i1) - u2%TurbineComponents%TailFin%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%TailFin%TranslationVel(i1) + u3%TurbineComponents%TailFin%TranslationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%TailFin%TranslationVel(i1) + t(3)*u2%TurbineComponents%TailFin%TranslationVel(i1) - t(2)*u3%TurbineComponents%TailFin%TranslationVel(i1) ) * scaleFactor - u_out%TurbineComponents%TailFin%TranslationVel(i1) = u1%TurbineComponents%TailFin%TranslationVel(i1) + b + c * t_out - END DO - DO i1 = LBOUND(u_out%TurbineComponents%TailFin%RotationVel,1),UBOUND(u_out%TurbineComponents%TailFin%RotationVel,1) - b = (t(3)**2*(u1%TurbineComponents%TailFin%RotationVel(i1) - u2%TurbineComponents%TailFin%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%TailFin%RotationVel(i1) + u3%TurbineComponents%TailFin%RotationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%TailFin%RotationVel(i1) + t(3)*u2%TurbineComponents%TailFin%RotationVel(i1) - t(2)*u3%TurbineComponents%TailFin%RotationVel(i1) ) * scaleFactor - u_out%TurbineComponents%TailFin%RotationVel(i1) = u1%TurbineComponents%TailFin%RotationVel(i1) + b + c * t_out - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Tower%Position,1),UBOUND(u_out%TurbineComponents%Tower%Position,1) - b = (t(3)**2*(u1%TurbineComponents%Tower%Position(i1) - u2%TurbineComponents%Tower%Position(i1)) + t(2)**2*(-u1%TurbineComponents%Tower%Position(i1) + u3%TurbineComponents%Tower%Position(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Tower%Position(i1) + t(3)*u2%TurbineComponents%Tower%Position(i1) - t(2)*u3%TurbineComponents%Tower%Position(i1) ) * scaleFactor - u_out%TurbineComponents%Tower%Position(i1) = u1%TurbineComponents%Tower%Position(i1) + b + c * t_out - END DO - DO i2 = LBOUND(u_out%TurbineComponents%Tower%Orientation,2),UBOUND(u_out%TurbineComponents%Tower%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%Tower%Orientation,1),UBOUND(u_out%TurbineComponents%Tower%Orientation,1) - b = (t(3)**2*(u1%TurbineComponents%Tower%Orientation(i1,i2) - u2%TurbineComponents%Tower%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%Tower%Orientation(i1,i2) + u3%TurbineComponents%Tower%Orientation(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Tower%Orientation(i1,i2) + t(3)*u2%TurbineComponents%Tower%Orientation(i1,i2) - t(2)*u3%TurbineComponents%Tower%Orientation(i1,i2) ) * scaleFactor - u_out%TurbineComponents%Tower%Orientation(i1,i2) = u1%TurbineComponents%Tower%Orientation(i1,i2) + b + c * t_out - END DO - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Tower%TranslationVel,1),UBOUND(u_out%TurbineComponents%Tower%TranslationVel,1) - b = (t(3)**2*(u1%TurbineComponents%Tower%TranslationVel(i1) - u2%TurbineComponents%Tower%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Tower%TranslationVel(i1) + u3%TurbineComponents%Tower%TranslationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Tower%TranslationVel(i1) + t(3)*u2%TurbineComponents%Tower%TranslationVel(i1) - t(2)*u3%TurbineComponents%Tower%TranslationVel(i1) ) * scaleFactor - u_out%TurbineComponents%Tower%TranslationVel(i1) = u1%TurbineComponents%Tower%TranslationVel(i1) + b + c * t_out - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Tower%RotationVel,1),UBOUND(u_out%TurbineComponents%Tower%RotationVel,1) - b = (t(3)**2*(u1%TurbineComponents%Tower%RotationVel(i1) - u2%TurbineComponents%Tower%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Tower%RotationVel(i1) + u3%TurbineComponents%Tower%RotationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Tower%RotationVel(i1) + t(3)*u2%TurbineComponents%Tower%RotationVel(i1) - t(2)*u3%TurbineComponents%Tower%RotationVel(i1) ) * scaleFactor - u_out%TurbineComponents%Tower%RotationVel(i1) = u1%TurbineComponents%Tower%RotationVel(i1) + b + c * t_out - END DO - DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%Position,1),UBOUND(u_out%TurbineComponents%SubStructure%Position,1) - b = (t(3)**2*(u1%TurbineComponents%SubStructure%Position(i1) - u2%TurbineComponents%SubStructure%Position(i1)) + t(2)**2*(-u1%TurbineComponents%SubStructure%Position(i1) + u3%TurbineComponents%SubStructure%Position(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%SubStructure%Position(i1) + t(3)*u2%TurbineComponents%SubStructure%Position(i1) - t(2)*u3%TurbineComponents%SubStructure%Position(i1) ) * scaleFactor - u_out%TurbineComponents%SubStructure%Position(i1) = u1%TurbineComponents%SubStructure%Position(i1) + b + c * t_out - END DO - DO i2 = LBOUND(u_out%TurbineComponents%SubStructure%Orientation,2),UBOUND(u_out%TurbineComponents%SubStructure%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%Orientation,1),UBOUND(u_out%TurbineComponents%SubStructure%Orientation,1) - b = (t(3)**2*(u1%TurbineComponents%SubStructure%Orientation(i1,i2) - u2%TurbineComponents%SubStructure%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%SubStructure%Orientation(i1,i2) + u3%TurbineComponents%SubStructure%Orientation(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%SubStructure%Orientation(i1,i2) + t(3)*u2%TurbineComponents%SubStructure%Orientation(i1,i2) - t(2)*u3%TurbineComponents%SubStructure%Orientation(i1,i2) ) * scaleFactor - u_out%TurbineComponents%SubStructure%Orientation(i1,i2) = u1%TurbineComponents%SubStructure%Orientation(i1,i2) + b + c * t_out - END DO - END DO - DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%TranslationVel,1),UBOUND(u_out%TurbineComponents%SubStructure%TranslationVel,1) - b = (t(3)**2*(u1%TurbineComponents%SubStructure%TranslationVel(i1) - u2%TurbineComponents%SubStructure%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%SubStructure%TranslationVel(i1) + u3%TurbineComponents%SubStructure%TranslationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%SubStructure%TranslationVel(i1) + t(3)*u2%TurbineComponents%SubStructure%TranslationVel(i1) - t(2)*u3%TurbineComponents%SubStructure%TranslationVel(i1) ) * scaleFactor - u_out%TurbineComponents%SubStructure%TranslationVel(i1) = u1%TurbineComponents%SubStructure%TranslationVel(i1) + b + c * t_out - END DO - DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%RotationVel,1),UBOUND(u_out%TurbineComponents%SubStructure%RotationVel,1) - b = (t(3)**2*(u1%TurbineComponents%SubStructure%RotationVel(i1) - u2%TurbineComponents%SubStructure%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%SubStructure%RotationVel(i1) + u3%TurbineComponents%SubStructure%RotationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%SubStructure%RotationVel(i1) + t(3)*u2%TurbineComponents%SubStructure%RotationVel(i1) - t(2)*u3%TurbineComponents%SubStructure%RotationVel(i1) ) * scaleFactor - u_out%TurbineComponents%SubStructure%RotationVel(i1) = u1%TurbineComponents%SubStructure%RotationVel(i1) + b + c * t_out - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Foundation%Position,1),UBOUND(u_out%TurbineComponents%Foundation%Position,1) - b = (t(3)**2*(u1%TurbineComponents%Foundation%Position(i1) - u2%TurbineComponents%Foundation%Position(i1)) + t(2)**2*(-u1%TurbineComponents%Foundation%Position(i1) + u3%TurbineComponents%Foundation%Position(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Foundation%Position(i1) + t(3)*u2%TurbineComponents%Foundation%Position(i1) - t(2)*u3%TurbineComponents%Foundation%Position(i1) ) * scaleFactor - u_out%TurbineComponents%Foundation%Position(i1) = u1%TurbineComponents%Foundation%Position(i1) + b + c * t_out - END DO - DO i2 = LBOUND(u_out%TurbineComponents%Foundation%Orientation,2),UBOUND(u_out%TurbineComponents%Foundation%Orientation,2) - DO i1 = LBOUND(u_out%TurbineComponents%Foundation%Orientation,1),UBOUND(u_out%TurbineComponents%Foundation%Orientation,1) - b = (t(3)**2*(u1%TurbineComponents%Foundation%Orientation(i1,i2) - u2%TurbineComponents%Foundation%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%Foundation%Orientation(i1,i2) + u3%TurbineComponents%Foundation%Orientation(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Foundation%Orientation(i1,i2) + t(3)*u2%TurbineComponents%Foundation%Orientation(i1,i2) - t(2)*u3%TurbineComponents%Foundation%Orientation(i1,i2) ) * scaleFactor - u_out%TurbineComponents%Foundation%Orientation(i1,i2) = u1%TurbineComponents%Foundation%Orientation(i1,i2) + b + c * t_out - END DO - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Foundation%TranslationVel,1),UBOUND(u_out%TurbineComponents%Foundation%TranslationVel,1) - b = (t(3)**2*(u1%TurbineComponents%Foundation%TranslationVel(i1) - u2%TurbineComponents%Foundation%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Foundation%TranslationVel(i1) + u3%TurbineComponents%Foundation%TranslationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Foundation%TranslationVel(i1) + t(3)*u2%TurbineComponents%Foundation%TranslationVel(i1) - t(2)*u3%TurbineComponents%Foundation%TranslationVel(i1) ) * scaleFactor - u_out%TurbineComponents%Foundation%TranslationVel(i1) = u1%TurbineComponents%Foundation%TranslationVel(i1) + b + c * t_out - END DO - DO i1 = LBOUND(u_out%TurbineComponents%Foundation%RotationVel,1),UBOUND(u_out%TurbineComponents%Foundation%RotationVel,1) - b = (t(3)**2*(u1%TurbineComponents%Foundation%RotationVel(i1) - u2%TurbineComponents%Foundation%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Foundation%RotationVel(i1) + u3%TurbineComponents%Foundation%RotationVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%Foundation%RotationVel(i1) + t(3)*u2%TurbineComponents%Foundation%RotationVel(i1) - t(2)*u3%TurbineComponents%Foundation%RotationVel(i1) ) * scaleFactor - u_out%TurbineComponents%Foundation%RotationVel(i1) = u1%TurbineComponents%Foundation%RotationVel(i1) + b + c * t_out - END DO - b = (t(3)**2*(u1%TurbineComponents%BladeLength - u2%TurbineComponents%BladeLength) + t(2)**2*(-u1%TurbineComponents%BladeLength + u3%TurbineComponents%BladeLength))* scaleFactor - c = ( (t(2)-t(3))*u1%TurbineComponents%BladeLength + t(3)*u2%TurbineComponents%BladeLength - t(2)*u3%TurbineComponents%BladeLength ) * scaleFactor - u_out%TurbineComponents%BladeLength = u1%TurbineComponents%BladeLength + b + c * t_out -IF (ALLOCATED(u_out%MulTabLoc) .AND. ALLOCATED(u1%MulTabLoc)) THEN - DO i2 = LBOUND(u_out%MulTabLoc,2),UBOUND(u_out%MulTabLoc,2) - DO i1 = LBOUND(u_out%MulTabLoc,1),UBOUND(u_out%MulTabLoc,1) - b = (t(3)**2*(u1%MulTabLoc(i1,i2) - u2%MulTabLoc(i1,i2)) + t(2)**2*(-u1%MulTabLoc(i1,i2) + u3%MulTabLoc(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%MulTabLoc(i1,i2) + t(3)*u2%MulTabLoc(i1,i2) - t(2)*u3%MulTabLoc(i1,i2) ) * scaleFactor - u_out%MulTabLoc(i1,i2) = u1%MulTabLoc(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%InflowVelocity) .AND. ALLOCATED(u1%InflowVelocity)) THEN - DO i2 = LBOUND(u_out%InflowVelocity,2),UBOUND(u_out%InflowVelocity,2) - DO i1 = LBOUND(u_out%InflowVelocity,1),UBOUND(u_out%InflowVelocity,1) - b = (t(3)**2*(u1%InflowVelocity(i1,i2) - u2%InflowVelocity(i1,i2)) + t(2)**2*(-u1%InflowVelocity(i1,i2) + u3%InflowVelocity(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%InflowVelocity(i1,i2) + t(3)*u2%InflowVelocity(i1,i2) - t(2)*u3%InflowVelocity(i1,i2) ) * scaleFactor - u_out%InflowVelocity(i1,i2) = u1%InflowVelocity(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated - DO i1 = LBOUND(u_out%AvgInfVel,1),UBOUND(u_out%AvgInfVel,1) - b = (t(3)**2*(u1%AvgInfVel(i1) - u2%AvgInfVel(i1)) + t(2)**2*(-u1%AvgInfVel(i1) + u3%AvgInfVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%AvgInfVel(i1) + t(3)*u2%AvgInfVel(i1) - t(2)*u3%AvgInfVel(i1) ) * scaleFactor - u_out%AvgInfVel(i1) = u1%AvgInfVel(i1) + b + c * t_out - END DO - END SUBROUTINE AD14_Input_ExtrapInterp2 - - - SUBROUTINE AD14_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(AD14_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(AD14_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(u_out%InputMarkers) .AND. ALLOCATED(u1%InputMarkers)) THEN + DO i1 = LBOUND(u_out%InputMarkers,1),UBOUND(u_out%InputMarkers,1) + CALL MeshExtrapInterp2(u1%InputMarkers(i1), u2%InputMarkers(i1), u3%InputMarkers(i1), tin, u_out%InputMarkers(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + CALL MeshExtrapInterp2(u1%Twr_InputMarkers, u2%Twr_InputMarkers, u3%Twr_InputMarkers, tin, u_out%Twr_InputMarkers, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(u_out%TurbineComponents%Blade) .AND. ALLOCATED(u1%TurbineComponents%Blade)) THEN + DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) + u_out%TurbineComponents%Blade(i11)%Position = a1*u1%TurbineComponents%Blade(i11)%Position + a2*u2%TurbineComponents%Blade(i11)%Position + a3*u3%TurbineComponents%Blade(i11)%Position + END DO + DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) + u_out%TurbineComponents%Blade(i11)%Orientation = a1*u1%TurbineComponents%Blade(i11)%Orientation + a2*u2%TurbineComponents%Blade(i11)%Orientation + a3*u3%TurbineComponents%Blade(i11)%Orientation + END DO + DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) + u_out%TurbineComponents%Blade(i11)%TranslationVel = a1*u1%TurbineComponents%Blade(i11)%TranslationVel + a2*u2%TurbineComponents%Blade(i11)%TranslationVel + a3*u3%TurbineComponents%Blade(i11)%TranslationVel + END DO + DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) + u_out%TurbineComponents%Blade(i11)%RotationVel = a1*u1%TurbineComponents%Blade(i11)%RotationVel + a2*u2%TurbineComponents%Blade(i11)%RotationVel + a3*u3%TurbineComponents%Blade(i11)%RotationVel + END DO + END IF ! check if allocated + u_out%TurbineComponents%Hub%Position = a1*u1%TurbineComponents%Hub%Position + a2*u2%TurbineComponents%Hub%Position + a3*u3%TurbineComponents%Hub%Position + u_out%TurbineComponents%Hub%Orientation = a1*u1%TurbineComponents%Hub%Orientation + a2*u2%TurbineComponents%Hub%Orientation + a3*u3%TurbineComponents%Hub%Orientation + u_out%TurbineComponents%Hub%TranslationVel = a1*u1%TurbineComponents%Hub%TranslationVel + a2*u2%TurbineComponents%Hub%TranslationVel + a3*u3%TurbineComponents%Hub%TranslationVel + u_out%TurbineComponents%Hub%RotationVel = a1*u1%TurbineComponents%Hub%RotationVel + a2*u2%TurbineComponents%Hub%RotationVel + a3*u3%TurbineComponents%Hub%RotationVel + u_out%TurbineComponents%RotorFurl%Position = a1*u1%TurbineComponents%RotorFurl%Position + a2*u2%TurbineComponents%RotorFurl%Position + a3*u3%TurbineComponents%RotorFurl%Position + u_out%TurbineComponents%RotorFurl%Orientation = a1*u1%TurbineComponents%RotorFurl%Orientation + a2*u2%TurbineComponents%RotorFurl%Orientation + a3*u3%TurbineComponents%RotorFurl%Orientation + u_out%TurbineComponents%RotorFurl%TranslationVel = a1*u1%TurbineComponents%RotorFurl%TranslationVel + a2*u2%TurbineComponents%RotorFurl%TranslationVel + a3*u3%TurbineComponents%RotorFurl%TranslationVel + u_out%TurbineComponents%RotorFurl%RotationVel = a1*u1%TurbineComponents%RotorFurl%RotationVel + a2*u2%TurbineComponents%RotorFurl%RotationVel + a3*u3%TurbineComponents%RotorFurl%RotationVel + u_out%TurbineComponents%Nacelle%Position = a1*u1%TurbineComponents%Nacelle%Position + a2*u2%TurbineComponents%Nacelle%Position + a3*u3%TurbineComponents%Nacelle%Position + u_out%TurbineComponents%Nacelle%Orientation = a1*u1%TurbineComponents%Nacelle%Orientation + a2*u2%TurbineComponents%Nacelle%Orientation + a3*u3%TurbineComponents%Nacelle%Orientation + u_out%TurbineComponents%Nacelle%TranslationVel = a1*u1%TurbineComponents%Nacelle%TranslationVel + a2*u2%TurbineComponents%Nacelle%TranslationVel + a3*u3%TurbineComponents%Nacelle%TranslationVel + u_out%TurbineComponents%Nacelle%RotationVel = a1*u1%TurbineComponents%Nacelle%RotationVel + a2*u2%TurbineComponents%Nacelle%RotationVel + a3*u3%TurbineComponents%Nacelle%RotationVel + u_out%TurbineComponents%TailFin%Position = a1*u1%TurbineComponents%TailFin%Position + a2*u2%TurbineComponents%TailFin%Position + a3*u3%TurbineComponents%TailFin%Position + u_out%TurbineComponents%TailFin%Orientation = a1*u1%TurbineComponents%TailFin%Orientation + a2*u2%TurbineComponents%TailFin%Orientation + a3*u3%TurbineComponents%TailFin%Orientation + u_out%TurbineComponents%TailFin%TranslationVel = a1*u1%TurbineComponents%TailFin%TranslationVel + a2*u2%TurbineComponents%TailFin%TranslationVel + a3*u3%TurbineComponents%TailFin%TranslationVel + u_out%TurbineComponents%TailFin%RotationVel = a1*u1%TurbineComponents%TailFin%RotationVel + a2*u2%TurbineComponents%TailFin%RotationVel + a3*u3%TurbineComponents%TailFin%RotationVel + u_out%TurbineComponents%Tower%Position = a1*u1%TurbineComponents%Tower%Position + a2*u2%TurbineComponents%Tower%Position + a3*u3%TurbineComponents%Tower%Position + u_out%TurbineComponents%Tower%Orientation = a1*u1%TurbineComponents%Tower%Orientation + a2*u2%TurbineComponents%Tower%Orientation + a3*u3%TurbineComponents%Tower%Orientation + u_out%TurbineComponents%Tower%TranslationVel = a1*u1%TurbineComponents%Tower%TranslationVel + a2*u2%TurbineComponents%Tower%TranslationVel + a3*u3%TurbineComponents%Tower%TranslationVel + u_out%TurbineComponents%Tower%RotationVel = a1*u1%TurbineComponents%Tower%RotationVel + a2*u2%TurbineComponents%Tower%RotationVel + a3*u3%TurbineComponents%Tower%RotationVel + u_out%TurbineComponents%SubStructure%Position = a1*u1%TurbineComponents%SubStructure%Position + a2*u2%TurbineComponents%SubStructure%Position + a3*u3%TurbineComponents%SubStructure%Position + u_out%TurbineComponents%SubStructure%Orientation = a1*u1%TurbineComponents%SubStructure%Orientation + a2*u2%TurbineComponents%SubStructure%Orientation + a3*u3%TurbineComponents%SubStructure%Orientation + u_out%TurbineComponents%SubStructure%TranslationVel = a1*u1%TurbineComponents%SubStructure%TranslationVel + a2*u2%TurbineComponents%SubStructure%TranslationVel + a3*u3%TurbineComponents%SubStructure%TranslationVel + u_out%TurbineComponents%SubStructure%RotationVel = a1*u1%TurbineComponents%SubStructure%RotationVel + a2*u2%TurbineComponents%SubStructure%RotationVel + a3*u3%TurbineComponents%SubStructure%RotationVel + u_out%TurbineComponents%Foundation%Position = a1*u1%TurbineComponents%Foundation%Position + a2*u2%TurbineComponents%Foundation%Position + a3*u3%TurbineComponents%Foundation%Position + u_out%TurbineComponents%Foundation%Orientation = a1*u1%TurbineComponents%Foundation%Orientation + a2*u2%TurbineComponents%Foundation%Orientation + a3*u3%TurbineComponents%Foundation%Orientation + u_out%TurbineComponents%Foundation%TranslationVel = a1*u1%TurbineComponents%Foundation%TranslationVel + a2*u2%TurbineComponents%Foundation%TranslationVel + a3*u3%TurbineComponents%Foundation%TranslationVel + u_out%TurbineComponents%Foundation%RotationVel = a1*u1%TurbineComponents%Foundation%RotationVel + a2*u2%TurbineComponents%Foundation%RotationVel + a3*u3%TurbineComponents%Foundation%RotationVel + u_out%TurbineComponents%BladeLength = a1*u1%TurbineComponents%BladeLength + a2*u2%TurbineComponents%BladeLength + a3*u3%TurbineComponents%BladeLength + IF (ALLOCATED(u_out%MulTabLoc) .AND. ALLOCATED(u1%MulTabLoc)) THEN + u_out%MulTabLoc = a1*u1%MulTabLoc + a2*u2%MulTabLoc + a3*u3%MulTabLoc + END IF ! check if allocated + IF (ALLOCATED(u_out%InflowVelocity) .AND. ALLOCATED(u1%InflowVelocity)) THEN + u_out%InflowVelocity = a1*u1%InflowVelocity + a2*u2%InflowVelocity + a3*u3%InflowVelocity + END IF ! check if allocated + u_out%AvgInfVel = a1*u1%AvgInfVel + a2*u2%AvgInfVel + a3*u3%AvgInfVel +END SUBROUTINE + +subroutine AD14_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time + ! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(AD14_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(AD14_OutputType), intent(inout) :: y_out ! Output at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_Output_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(y)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(y) - 1 - IF ( order .eq. 0 ) THEN - CALL AD14_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL AD14_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL AD14_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE AD14_Output_ExtrapInterp - - - SUBROUTINE AD14_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'AD14_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call AD14_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call AD14_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call AD14_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE AD14_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 1. @@ -7108,49 +6823,50 @@ SUBROUTINE AD14_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs ! !.................................................................................................................................. - TYPE(AD14_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(AD14_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(AD14_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(AD14_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(AD14_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(AD14_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_Output_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'AD14_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF - - ScaleFactor = t_out / t(2) -IF (ALLOCATED(y_out%OutputLoads) .AND. ALLOCATED(y1%OutputLoads)) THEN - DO i1 = LBOUND(y_out%OutputLoads,1),UBOUND(y_out%OutputLoads,1) - CALL MeshExtrapInterp1(y1%OutputLoads(i1), y2%OutputLoads(i1), tin, y_out%OutputLoads(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - CALL MeshExtrapInterp1(y1%Twr_OutputLoads, y2%Twr_OutputLoads, tin, y_out%Twr_OutputLoads, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE AD14_Output_ExtrapInterp1 - - - SUBROUTINE AD14_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%OutputLoads) .AND. ALLOCATED(y1%OutputLoads)) THEN + DO i1 = LBOUND(y_out%OutputLoads,1),UBOUND(y_out%OutputLoads,1) + CALL MeshExtrapInterp1(y1%OutputLoads(i1), y2%OutputLoads(i1), tin, y_out%OutputLoads(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + CALL MeshExtrapInterp1(y1%Twr_OutputLoads, y2%Twr_OutputLoads, tin, y_out%Twr_OutputLoads, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +SUBROUTINE AD14_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 2. @@ -7164,55 +6880,55 @@ SUBROUTINE AD14_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E ! !.................................................................................................................................. - TYPE(AD14_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(AD14_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(AD14_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(AD14_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(AD14_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(AD14_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(AD14_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(AD14_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'AD14_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'AD14_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) -IF (ALLOCATED(y_out%OutputLoads) .AND. ALLOCATED(y1%OutputLoads)) THEN - DO i1 = LBOUND(y_out%OutputLoads,1),UBOUND(y_out%OutputLoads,1) - CALL MeshExtrapInterp2(y1%OutputLoads(i1), y2%OutputLoads(i1), y3%OutputLoads(i1), tin, y_out%OutputLoads(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - CALL MeshExtrapInterp2(y1%Twr_OutputLoads, y2%Twr_OutputLoads, y3%Twr_OutputLoads, tin, y_out%Twr_OutputLoads, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE AD14_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%OutputLoads) .AND. ALLOCATED(y1%OutputLoads)) THEN + DO i1 = LBOUND(y_out%OutputLoads,1),UBOUND(y_out%OutputLoads,1) + CALL MeshExtrapInterp2(y1%OutputLoads(i1), y2%OutputLoads(i1), y3%OutputLoads(i1), tin, y_out%OutputLoads(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + CALL MeshExtrapInterp2(y1%Twr_OutputLoads, y2%Twr_OutputLoads, y3%Twr_OutputLoads, tin, y_out%Twr_OutputLoads, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE END MODULE AeroDyn14_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn14/src/DWM_Types.f90 b/modules/aerodyn14/src/DWM_Types.f90 index 67b3d06f31..1e9b95f7ed 100644 --- a/modules/aerodyn14/src/DWM_Types.f90 +++ b/modules/aerodyn14/src/DWM_Types.f90 @@ -3731,58 +3731,59 @@ subroutine DWM_UnPackInitOutput(Buf, OutData) call InflowWind_UnpackInitOutput(Buf, OutData%IfW) ! IfW end subroutine - SUBROUTINE DWM_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(DWM_InputType), INTENT(IN) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(DWM_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None +subroutine DWM_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time + ! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(DWM_InputType), intent(in) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(DWM_InputType), intent(inout) :: u_out ! Input at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Input_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(u)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(u) - 1 - IF ( order .eq. 0 ) THEN - CALL DWM_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL DWM_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL DWM_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE DWM_Input_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'DWM_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call DWM_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call DWM_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call DWM_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE DWM_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE DWM_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 1. @@ -3794,131 +3795,83 @@ SUBROUTINE DWM_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(DWM_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 - TYPE(DWM_InputType), INTENT(IN) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(DWM_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(DWM_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 + TYPE(DWM_InputType), INTENT(IN) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(DWM_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Input_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts - INTEGER :: i04 ! dim4 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - INTEGER :: i3 ! dim3 counter variable for arrays - INTEGER :: i4 ! dim4 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i04 ! dim4 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays + INTEGER :: i4 ! dim4 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(u_out%Upwind_result%upwind_U) .AND. ALLOCATED(u1%Upwind_result%upwind_U)) THEN + u_out%Upwind_result%upwind_U = a1*u1%Upwind_result%upwind_U + a2*u2%Upwind_result%upwind_U + END IF ! check if allocated + IF (ALLOCATED(u_out%Upwind_result%upwind_wakecenter) .AND. ALLOCATED(u1%Upwind_result%upwind_wakecenter)) THEN + u_out%Upwind_result%upwind_wakecenter = a1*u1%Upwind_result%upwind_wakecenter + a2*u2%Upwind_result%upwind_wakecenter + END IF ! check if allocated + IF (ALLOCATED(u_out%Upwind_result%upwind_meanU) .AND. ALLOCATED(u1%Upwind_result%upwind_meanU)) THEN + u_out%Upwind_result%upwind_meanU = a1*u1%Upwind_result%upwind_meanU + a2*u2%Upwind_result%upwind_meanU + END IF ! check if allocated + IF (ALLOCATED(u_out%Upwind_result%upwind_TI) .AND. ALLOCATED(u1%Upwind_result%upwind_TI)) THEN + u_out%Upwind_result%upwind_TI = a1*u1%Upwind_result%upwind_TI + a2*u2%Upwind_result%upwind_TI + END IF ! check if allocated + IF (ALLOCATED(u_out%Upwind_result%upwind_small_TI) .AND. ALLOCATED(u1%Upwind_result%upwind_small_TI)) THEN + u_out%Upwind_result%upwind_small_TI = a1*u1%Upwind_result%upwind_small_TI + a2*u2%Upwind_result%upwind_small_TI + END IF ! check if allocated + IF (ALLOCATED(u_out%Upwind_result%upwind_smoothWake) .AND. ALLOCATED(u1%Upwind_result%upwind_smoothWake)) THEN + u_out%Upwind_result%upwind_smoothWake = a1*u1%Upwind_result%upwind_smoothWake + a2*u2%Upwind_result%upwind_smoothWake + END IF ! check if allocated + IF (ALLOCATED(u_out%Upwind_result%velocity_aerodyn) .AND. ALLOCATED(u1%Upwind_result%velocity_aerodyn)) THEN + u_out%Upwind_result%velocity_aerodyn = a1*u1%Upwind_result%velocity_aerodyn + a2*u2%Upwind_result%velocity_aerodyn + END IF ! check if allocated + IF (ALLOCATED(u_out%Upwind_result%TI_downstream) .AND. ALLOCATED(u1%Upwind_result%TI_downstream)) THEN + u_out%Upwind_result%TI_downstream = a1*u1%Upwind_result%TI_downstream + a2*u2%Upwind_result%TI_downstream + END IF ! check if allocated + IF (ALLOCATED(u_out%Upwind_result%small_scale_TI_downstream) .AND. ALLOCATED(u1%Upwind_result%small_scale_TI_downstream)) THEN + u_out%Upwind_result%small_scale_TI_downstream = a1*u1%Upwind_result%small_scale_TI_downstream + a2*u2%Upwind_result%small_scale_TI_downstream + END IF ! check if allocated + IF (ALLOCATED(u_out%Upwind_result%smoothed_velocity_array) .AND. ALLOCATED(u1%Upwind_result%smoothed_velocity_array)) THEN + u_out%Upwind_result%smoothed_velocity_array = a1*u1%Upwind_result%smoothed_velocity_array + a2*u2%Upwind_result%smoothed_velocity_array + END IF ! check if allocated + IF (ALLOCATED(u_out%Upwind_result%vel_matrix) .AND. ALLOCATED(u1%Upwind_result%vel_matrix)) THEN + u_out%Upwind_result%vel_matrix = a1*u1%Upwind_result%vel_matrix + a2*u2%Upwind_result%vel_matrix + END IF ! check if allocated + CALL InflowWind_Input_ExtrapInterp1( u1%IfW, u2%IfW, tin, u_out%IfW, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE - ScaleFactor = t_out / t(2) -IF (ALLOCATED(u_out%Upwind_result%upwind_U) .AND. ALLOCATED(u1%Upwind_result%upwind_U)) THEN - DO i2 = LBOUND(u_out%Upwind_result%upwind_U,2),UBOUND(u_out%Upwind_result%upwind_U,2) - DO i1 = LBOUND(u_out%Upwind_result%upwind_U,1),UBOUND(u_out%Upwind_result%upwind_U,1) - b = -(u1%Upwind_result%upwind_U(i1,i2) - u2%Upwind_result%upwind_U(i1,i2)) - u_out%Upwind_result%upwind_U(i1,i2) = u1%Upwind_result%upwind_U(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%upwind_wakecenter) .AND. ALLOCATED(u1%Upwind_result%upwind_wakecenter)) THEN - DO i4 = LBOUND(u_out%Upwind_result%upwind_wakecenter,4),UBOUND(u_out%Upwind_result%upwind_wakecenter,4) - DO i3 = LBOUND(u_out%Upwind_result%upwind_wakecenter,3),UBOUND(u_out%Upwind_result%upwind_wakecenter,3) - DO i2 = LBOUND(u_out%Upwind_result%upwind_wakecenter,2),UBOUND(u_out%Upwind_result%upwind_wakecenter,2) - DO i1 = LBOUND(u_out%Upwind_result%upwind_wakecenter,1),UBOUND(u_out%Upwind_result%upwind_wakecenter,1) - b = -(u1%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) - u2%Upwind_result%upwind_wakecenter(i1,i2,i3,i4)) - u_out%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) = u1%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) + b * ScaleFactor - END DO - END DO - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%upwind_meanU) .AND. ALLOCATED(u1%Upwind_result%upwind_meanU)) THEN - DO i1 = LBOUND(u_out%Upwind_result%upwind_meanU,1),UBOUND(u_out%Upwind_result%upwind_meanU,1) - b = -(u1%Upwind_result%upwind_meanU(i1) - u2%Upwind_result%upwind_meanU(i1)) - u_out%Upwind_result%upwind_meanU(i1) = u1%Upwind_result%upwind_meanU(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%upwind_TI) .AND. ALLOCATED(u1%Upwind_result%upwind_TI)) THEN - DO i1 = LBOUND(u_out%Upwind_result%upwind_TI,1),UBOUND(u_out%Upwind_result%upwind_TI,1) - b = -(u1%Upwind_result%upwind_TI(i1) - u2%Upwind_result%upwind_TI(i1)) - u_out%Upwind_result%upwind_TI(i1) = u1%Upwind_result%upwind_TI(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%upwind_small_TI) .AND. ALLOCATED(u1%Upwind_result%upwind_small_TI)) THEN - DO i1 = LBOUND(u_out%Upwind_result%upwind_small_TI,1),UBOUND(u_out%Upwind_result%upwind_small_TI,1) - b = -(u1%Upwind_result%upwind_small_TI(i1) - u2%Upwind_result%upwind_small_TI(i1)) - u_out%Upwind_result%upwind_small_TI(i1) = u1%Upwind_result%upwind_small_TI(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%upwind_smoothWake) .AND. ALLOCATED(u1%Upwind_result%upwind_smoothWake)) THEN - DO i2 = LBOUND(u_out%Upwind_result%upwind_smoothWake,2),UBOUND(u_out%Upwind_result%upwind_smoothWake,2) - DO i1 = LBOUND(u_out%Upwind_result%upwind_smoothWake,1),UBOUND(u_out%Upwind_result%upwind_smoothWake,1) - b = -(u1%Upwind_result%upwind_smoothWake(i1,i2) - u2%Upwind_result%upwind_smoothWake(i1,i2)) - u_out%Upwind_result%upwind_smoothWake(i1,i2) = u1%Upwind_result%upwind_smoothWake(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%velocity_aerodyn) .AND. ALLOCATED(u1%Upwind_result%velocity_aerodyn)) THEN - DO i1 = LBOUND(u_out%Upwind_result%velocity_aerodyn,1),UBOUND(u_out%Upwind_result%velocity_aerodyn,1) - b = -(u1%Upwind_result%velocity_aerodyn(i1) - u2%Upwind_result%velocity_aerodyn(i1)) - u_out%Upwind_result%velocity_aerodyn(i1) = u1%Upwind_result%velocity_aerodyn(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%TI_downstream) .AND. ALLOCATED(u1%Upwind_result%TI_downstream)) THEN - DO i1 = LBOUND(u_out%Upwind_result%TI_downstream,1),UBOUND(u_out%Upwind_result%TI_downstream,1) - b = -(u1%Upwind_result%TI_downstream(i1) - u2%Upwind_result%TI_downstream(i1)) - u_out%Upwind_result%TI_downstream(i1) = u1%Upwind_result%TI_downstream(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%small_scale_TI_downstream) .AND. ALLOCATED(u1%Upwind_result%small_scale_TI_downstream)) THEN - DO i1 = LBOUND(u_out%Upwind_result%small_scale_TI_downstream,1),UBOUND(u_out%Upwind_result%small_scale_TI_downstream,1) - b = -(u1%Upwind_result%small_scale_TI_downstream(i1) - u2%Upwind_result%small_scale_TI_downstream(i1)) - u_out%Upwind_result%small_scale_TI_downstream(i1) = u1%Upwind_result%small_scale_TI_downstream(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%smoothed_velocity_array) .AND. ALLOCATED(u1%Upwind_result%smoothed_velocity_array)) THEN - DO i2 = LBOUND(u_out%Upwind_result%smoothed_velocity_array,2),UBOUND(u_out%Upwind_result%smoothed_velocity_array,2) - DO i1 = LBOUND(u_out%Upwind_result%smoothed_velocity_array,1),UBOUND(u_out%Upwind_result%smoothed_velocity_array,1) - b = -(u1%Upwind_result%smoothed_velocity_array(i1,i2) - u2%Upwind_result%smoothed_velocity_array(i1,i2)) - u_out%Upwind_result%smoothed_velocity_array(i1,i2) = u1%Upwind_result%smoothed_velocity_array(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%vel_matrix) .AND. ALLOCATED(u1%Upwind_result%vel_matrix)) THEN - DO i3 = LBOUND(u_out%Upwind_result%vel_matrix,3),UBOUND(u_out%Upwind_result%vel_matrix,3) - DO i2 = LBOUND(u_out%Upwind_result%vel_matrix,2),UBOUND(u_out%Upwind_result%vel_matrix,2) - DO i1 = LBOUND(u_out%Upwind_result%vel_matrix,1),UBOUND(u_out%Upwind_result%vel_matrix,1) - b = -(u1%Upwind_result%vel_matrix(i1,i2,i3) - u2%Upwind_result%vel_matrix(i1,i2,i3)) - u_out%Upwind_result%vel_matrix(i1,i2,i3) = u1%Upwind_result%vel_matrix(i1,i2,i3) + b * ScaleFactor - END DO - END DO - END DO -END IF ! check if allocated - CALL InflowWind_Input_ExtrapInterp1( u1%IfW, u2%IfW, tin, u_out%IfW, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE DWM_Input_ExtrapInterp1 - - - SUBROUTINE DWM_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE DWM_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 2. @@ -3932,202 +3885,143 @@ SUBROUTINE DWM_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - TYPE(DWM_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 - TYPE(DWM_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 - TYPE(DWM_InputType), INTENT(IN) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(DWM_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(DWM_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 + TYPE(DWM_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 + TYPE(DWM_InputType), INTENT(IN) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(DWM_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Input_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts - INTEGER :: i04 ! dim4 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - INTEGER :: i3 ! dim3 counter variable for arrays - INTEGER :: i4 ! dim4 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i04 ! dim4 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays + INTEGER :: i4 ! dim4 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(u_out%Upwind_result%upwind_U) .AND. ALLOCATED(u1%Upwind_result%upwind_U)) THEN + u_out%Upwind_result%upwind_U = a1*u1%Upwind_result%upwind_U + a2*u2%Upwind_result%upwind_U + a3*u3%Upwind_result%upwind_U + END IF ! check if allocated + IF (ALLOCATED(u_out%Upwind_result%upwind_wakecenter) .AND. ALLOCATED(u1%Upwind_result%upwind_wakecenter)) THEN + u_out%Upwind_result%upwind_wakecenter = a1*u1%Upwind_result%upwind_wakecenter + a2*u2%Upwind_result%upwind_wakecenter + a3*u3%Upwind_result%upwind_wakecenter + END IF ! check if allocated + IF (ALLOCATED(u_out%Upwind_result%upwind_meanU) .AND. ALLOCATED(u1%Upwind_result%upwind_meanU)) THEN + u_out%Upwind_result%upwind_meanU = a1*u1%Upwind_result%upwind_meanU + a2*u2%Upwind_result%upwind_meanU + a3*u3%Upwind_result%upwind_meanU + END IF ! check if allocated + IF (ALLOCATED(u_out%Upwind_result%upwind_TI) .AND. ALLOCATED(u1%Upwind_result%upwind_TI)) THEN + u_out%Upwind_result%upwind_TI = a1*u1%Upwind_result%upwind_TI + a2*u2%Upwind_result%upwind_TI + a3*u3%Upwind_result%upwind_TI + END IF ! check if allocated + IF (ALLOCATED(u_out%Upwind_result%upwind_small_TI) .AND. ALLOCATED(u1%Upwind_result%upwind_small_TI)) THEN + u_out%Upwind_result%upwind_small_TI = a1*u1%Upwind_result%upwind_small_TI + a2*u2%Upwind_result%upwind_small_TI + a3*u3%Upwind_result%upwind_small_TI + END IF ! check if allocated + IF (ALLOCATED(u_out%Upwind_result%upwind_smoothWake) .AND. ALLOCATED(u1%Upwind_result%upwind_smoothWake)) THEN + u_out%Upwind_result%upwind_smoothWake = a1*u1%Upwind_result%upwind_smoothWake + a2*u2%Upwind_result%upwind_smoothWake + a3*u3%Upwind_result%upwind_smoothWake + END IF ! check if allocated + IF (ALLOCATED(u_out%Upwind_result%velocity_aerodyn) .AND. ALLOCATED(u1%Upwind_result%velocity_aerodyn)) THEN + u_out%Upwind_result%velocity_aerodyn = a1*u1%Upwind_result%velocity_aerodyn + a2*u2%Upwind_result%velocity_aerodyn + a3*u3%Upwind_result%velocity_aerodyn + END IF ! check if allocated + IF (ALLOCATED(u_out%Upwind_result%TI_downstream) .AND. ALLOCATED(u1%Upwind_result%TI_downstream)) THEN + u_out%Upwind_result%TI_downstream = a1*u1%Upwind_result%TI_downstream + a2*u2%Upwind_result%TI_downstream + a3*u3%Upwind_result%TI_downstream + END IF ! check if allocated + IF (ALLOCATED(u_out%Upwind_result%small_scale_TI_downstream) .AND. ALLOCATED(u1%Upwind_result%small_scale_TI_downstream)) THEN + u_out%Upwind_result%small_scale_TI_downstream = a1*u1%Upwind_result%small_scale_TI_downstream + a2*u2%Upwind_result%small_scale_TI_downstream + a3*u3%Upwind_result%small_scale_TI_downstream + END IF ! check if allocated + IF (ALLOCATED(u_out%Upwind_result%smoothed_velocity_array) .AND. ALLOCATED(u1%Upwind_result%smoothed_velocity_array)) THEN + u_out%Upwind_result%smoothed_velocity_array = a1*u1%Upwind_result%smoothed_velocity_array + a2*u2%Upwind_result%smoothed_velocity_array + a3*u3%Upwind_result%smoothed_velocity_array + END IF ! check if allocated + IF (ALLOCATED(u_out%Upwind_result%vel_matrix) .AND. ALLOCATED(u1%Upwind_result%vel_matrix)) THEN + u_out%Upwind_result%vel_matrix = a1*u1%Upwind_result%vel_matrix + a2*u2%Upwind_result%vel_matrix + a3*u3%Upwind_result%vel_matrix + END IF ! check if allocated + CALL InflowWind_Input_ExtrapInterp2( u1%IfW, u2%IfW, u3%IfW, tin, u_out%IfW, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) -IF (ALLOCATED(u_out%Upwind_result%upwind_U) .AND. ALLOCATED(u1%Upwind_result%upwind_U)) THEN - DO i2 = LBOUND(u_out%Upwind_result%upwind_U,2),UBOUND(u_out%Upwind_result%upwind_U,2) - DO i1 = LBOUND(u_out%Upwind_result%upwind_U,1),UBOUND(u_out%Upwind_result%upwind_U,1) - b = (t(3)**2*(u1%Upwind_result%upwind_U(i1,i2) - u2%Upwind_result%upwind_U(i1,i2)) + t(2)**2*(-u1%Upwind_result%upwind_U(i1,i2) + u3%Upwind_result%upwind_U(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%Upwind_result%upwind_U(i1,i2) + t(3)*u2%Upwind_result%upwind_U(i1,i2) - t(2)*u3%Upwind_result%upwind_U(i1,i2) ) * scaleFactor - u_out%Upwind_result%upwind_U(i1,i2) = u1%Upwind_result%upwind_U(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%upwind_wakecenter) .AND. ALLOCATED(u1%Upwind_result%upwind_wakecenter)) THEN - DO i4 = LBOUND(u_out%Upwind_result%upwind_wakecenter,4),UBOUND(u_out%Upwind_result%upwind_wakecenter,4) - DO i3 = LBOUND(u_out%Upwind_result%upwind_wakecenter,3),UBOUND(u_out%Upwind_result%upwind_wakecenter,3) - DO i2 = LBOUND(u_out%Upwind_result%upwind_wakecenter,2),UBOUND(u_out%Upwind_result%upwind_wakecenter,2) - DO i1 = LBOUND(u_out%Upwind_result%upwind_wakecenter,1),UBOUND(u_out%Upwind_result%upwind_wakecenter,1) - b = (t(3)**2*(u1%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) - u2%Upwind_result%upwind_wakecenter(i1,i2,i3,i4)) + t(2)**2*(-u1%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) + u3%Upwind_result%upwind_wakecenter(i1,i2,i3,i4)))* scaleFactor - c = ( (t(2)-t(3))*u1%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) + t(3)*u2%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) - t(2)*u3%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) ) * scaleFactor - u_out%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) = u1%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) + b + c * t_out - END DO - END DO - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%upwind_meanU) .AND. ALLOCATED(u1%Upwind_result%upwind_meanU)) THEN - DO i1 = LBOUND(u_out%Upwind_result%upwind_meanU,1),UBOUND(u_out%Upwind_result%upwind_meanU,1) - b = (t(3)**2*(u1%Upwind_result%upwind_meanU(i1) - u2%Upwind_result%upwind_meanU(i1)) + t(2)**2*(-u1%Upwind_result%upwind_meanU(i1) + u3%Upwind_result%upwind_meanU(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%Upwind_result%upwind_meanU(i1) + t(3)*u2%Upwind_result%upwind_meanU(i1) - t(2)*u3%Upwind_result%upwind_meanU(i1) ) * scaleFactor - u_out%Upwind_result%upwind_meanU(i1) = u1%Upwind_result%upwind_meanU(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%upwind_TI) .AND. ALLOCATED(u1%Upwind_result%upwind_TI)) THEN - DO i1 = LBOUND(u_out%Upwind_result%upwind_TI,1),UBOUND(u_out%Upwind_result%upwind_TI,1) - b = (t(3)**2*(u1%Upwind_result%upwind_TI(i1) - u2%Upwind_result%upwind_TI(i1)) + t(2)**2*(-u1%Upwind_result%upwind_TI(i1) + u3%Upwind_result%upwind_TI(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%Upwind_result%upwind_TI(i1) + t(3)*u2%Upwind_result%upwind_TI(i1) - t(2)*u3%Upwind_result%upwind_TI(i1) ) * scaleFactor - u_out%Upwind_result%upwind_TI(i1) = u1%Upwind_result%upwind_TI(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%upwind_small_TI) .AND. ALLOCATED(u1%Upwind_result%upwind_small_TI)) THEN - DO i1 = LBOUND(u_out%Upwind_result%upwind_small_TI,1),UBOUND(u_out%Upwind_result%upwind_small_TI,1) - b = (t(3)**2*(u1%Upwind_result%upwind_small_TI(i1) - u2%Upwind_result%upwind_small_TI(i1)) + t(2)**2*(-u1%Upwind_result%upwind_small_TI(i1) + u3%Upwind_result%upwind_small_TI(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%Upwind_result%upwind_small_TI(i1) + t(3)*u2%Upwind_result%upwind_small_TI(i1) - t(2)*u3%Upwind_result%upwind_small_TI(i1) ) * scaleFactor - u_out%Upwind_result%upwind_small_TI(i1) = u1%Upwind_result%upwind_small_TI(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%upwind_smoothWake) .AND. ALLOCATED(u1%Upwind_result%upwind_smoothWake)) THEN - DO i2 = LBOUND(u_out%Upwind_result%upwind_smoothWake,2),UBOUND(u_out%Upwind_result%upwind_smoothWake,2) - DO i1 = LBOUND(u_out%Upwind_result%upwind_smoothWake,1),UBOUND(u_out%Upwind_result%upwind_smoothWake,1) - b = (t(3)**2*(u1%Upwind_result%upwind_smoothWake(i1,i2) - u2%Upwind_result%upwind_smoothWake(i1,i2)) + t(2)**2*(-u1%Upwind_result%upwind_smoothWake(i1,i2) + u3%Upwind_result%upwind_smoothWake(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%Upwind_result%upwind_smoothWake(i1,i2) + t(3)*u2%Upwind_result%upwind_smoothWake(i1,i2) - t(2)*u3%Upwind_result%upwind_smoothWake(i1,i2) ) * scaleFactor - u_out%Upwind_result%upwind_smoothWake(i1,i2) = u1%Upwind_result%upwind_smoothWake(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%velocity_aerodyn) .AND. ALLOCATED(u1%Upwind_result%velocity_aerodyn)) THEN - DO i1 = LBOUND(u_out%Upwind_result%velocity_aerodyn,1),UBOUND(u_out%Upwind_result%velocity_aerodyn,1) - b = (t(3)**2*(u1%Upwind_result%velocity_aerodyn(i1) - u2%Upwind_result%velocity_aerodyn(i1)) + t(2)**2*(-u1%Upwind_result%velocity_aerodyn(i1) + u3%Upwind_result%velocity_aerodyn(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%Upwind_result%velocity_aerodyn(i1) + t(3)*u2%Upwind_result%velocity_aerodyn(i1) - t(2)*u3%Upwind_result%velocity_aerodyn(i1) ) * scaleFactor - u_out%Upwind_result%velocity_aerodyn(i1) = u1%Upwind_result%velocity_aerodyn(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%TI_downstream) .AND. ALLOCATED(u1%Upwind_result%TI_downstream)) THEN - DO i1 = LBOUND(u_out%Upwind_result%TI_downstream,1),UBOUND(u_out%Upwind_result%TI_downstream,1) - b = (t(3)**2*(u1%Upwind_result%TI_downstream(i1) - u2%Upwind_result%TI_downstream(i1)) + t(2)**2*(-u1%Upwind_result%TI_downstream(i1) + u3%Upwind_result%TI_downstream(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%Upwind_result%TI_downstream(i1) + t(3)*u2%Upwind_result%TI_downstream(i1) - t(2)*u3%Upwind_result%TI_downstream(i1) ) * scaleFactor - u_out%Upwind_result%TI_downstream(i1) = u1%Upwind_result%TI_downstream(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%small_scale_TI_downstream) .AND. ALLOCATED(u1%Upwind_result%small_scale_TI_downstream)) THEN - DO i1 = LBOUND(u_out%Upwind_result%small_scale_TI_downstream,1),UBOUND(u_out%Upwind_result%small_scale_TI_downstream,1) - b = (t(3)**2*(u1%Upwind_result%small_scale_TI_downstream(i1) - u2%Upwind_result%small_scale_TI_downstream(i1)) + t(2)**2*(-u1%Upwind_result%small_scale_TI_downstream(i1) + u3%Upwind_result%small_scale_TI_downstream(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%Upwind_result%small_scale_TI_downstream(i1) + t(3)*u2%Upwind_result%small_scale_TI_downstream(i1) - t(2)*u3%Upwind_result%small_scale_TI_downstream(i1) ) * scaleFactor - u_out%Upwind_result%small_scale_TI_downstream(i1) = u1%Upwind_result%small_scale_TI_downstream(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%smoothed_velocity_array) .AND. ALLOCATED(u1%Upwind_result%smoothed_velocity_array)) THEN - DO i2 = LBOUND(u_out%Upwind_result%smoothed_velocity_array,2),UBOUND(u_out%Upwind_result%smoothed_velocity_array,2) - DO i1 = LBOUND(u_out%Upwind_result%smoothed_velocity_array,1),UBOUND(u_out%Upwind_result%smoothed_velocity_array,1) - b = (t(3)**2*(u1%Upwind_result%smoothed_velocity_array(i1,i2) - u2%Upwind_result%smoothed_velocity_array(i1,i2)) + t(2)**2*(-u1%Upwind_result%smoothed_velocity_array(i1,i2) + u3%Upwind_result%smoothed_velocity_array(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%Upwind_result%smoothed_velocity_array(i1,i2) + t(3)*u2%Upwind_result%smoothed_velocity_array(i1,i2) - t(2)*u3%Upwind_result%smoothed_velocity_array(i1,i2) ) * scaleFactor - u_out%Upwind_result%smoothed_velocity_array(i1,i2) = u1%Upwind_result%smoothed_velocity_array(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Upwind_result%vel_matrix) .AND. ALLOCATED(u1%Upwind_result%vel_matrix)) THEN - DO i3 = LBOUND(u_out%Upwind_result%vel_matrix,3),UBOUND(u_out%Upwind_result%vel_matrix,3) - DO i2 = LBOUND(u_out%Upwind_result%vel_matrix,2),UBOUND(u_out%Upwind_result%vel_matrix,2) - DO i1 = LBOUND(u_out%Upwind_result%vel_matrix,1),UBOUND(u_out%Upwind_result%vel_matrix,1) - b = (t(3)**2*(u1%Upwind_result%vel_matrix(i1,i2,i3) - u2%Upwind_result%vel_matrix(i1,i2,i3)) + t(2)**2*(-u1%Upwind_result%vel_matrix(i1,i2,i3) + u3%Upwind_result%vel_matrix(i1,i2,i3)))* scaleFactor - c = ( (t(2)-t(3))*u1%Upwind_result%vel_matrix(i1,i2,i3) + t(3)*u2%Upwind_result%vel_matrix(i1,i2,i3) - t(2)*u3%Upwind_result%vel_matrix(i1,i2,i3) ) * scaleFactor - u_out%Upwind_result%vel_matrix(i1,i2,i3) = u1%Upwind_result%vel_matrix(i1,i2,i3) + b + c * t_out - END DO - END DO - END DO -END IF ! check if allocated - CALL InflowWind_Input_ExtrapInterp2( u1%IfW, u2%IfW, u3%IfW, tin, u_out%IfW, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE DWM_Input_ExtrapInterp2 - - - SUBROUTINE DWM_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(DWM_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(DWM_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None +subroutine DWM_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time + ! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(DWM_OutputType), intent(in) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(DWM_OutputType), intent(inout) :: y_out ! Output at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Output_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(y)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(y) - 1 - IF ( order .eq. 0 ) THEN - CALL DWM_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL DWM_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL DWM_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE DWM_Output_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'DWM_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call DWM_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call DWM_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call DWM_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE DWM_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE DWM_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 1. @@ -4139,119 +4033,80 @@ SUBROUTINE DWM_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(DWM_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 - TYPE(DWM_OutputType), INTENT(IN) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(DWM_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(DWM_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 + TYPE(DWM_OutputType), INTENT(IN) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(DWM_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Output_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - INTEGER :: i3 ! dim3 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%turbine_thrust_force) .AND. ALLOCATED(y1%turbine_thrust_force)) THEN + y_out%turbine_thrust_force = a1*y1%turbine_thrust_force + a2*y2%turbine_thrust_force + END IF ! check if allocated + IF (ALLOCATED(y_out%induction_factor) .AND. ALLOCATED(y1%induction_factor)) THEN + y_out%induction_factor = a1*y1%induction_factor + a2*y2%induction_factor + END IF ! check if allocated + IF (ALLOCATED(y_out%r_initial) .AND. ALLOCATED(y1%r_initial)) THEN + y_out%r_initial = a1*y1%r_initial + a2*y2%r_initial + END IF ! check if allocated + IF (ALLOCATED(y_out%U_initial) .AND. ALLOCATED(y1%U_initial)) THEN + y_out%U_initial = a1*y1%U_initial + a2*y2%U_initial + END IF ! check if allocated + IF (ALLOCATED(y_out%Mean_FFWS_array) .AND. ALLOCATED(y1%Mean_FFWS_array)) THEN + y_out%Mean_FFWS_array = a1*y1%Mean_FFWS_array + a2*y2%Mean_FFWS_array + END IF ! check if allocated + y_out%Mean_FFWS = a1*y1%Mean_FFWS + a2*y2%Mean_FFWS + y_out%TI = a1*y1%TI + a2*y2%TI + y_out%TI_downstream = a1*y1%TI_downstream + a2*y2%TI_downstream + IF (ALLOCATED(y_out%wake_u) .AND. ALLOCATED(y1%wake_u)) THEN + y_out%wake_u = a1*y1%wake_u + a2*y2%wake_u + END IF ! check if allocated + IF (ALLOCATED(y_out%wake_position) .AND. ALLOCATED(y1%wake_position)) THEN + y_out%wake_position = a1*y1%wake_position + a2*y2%wake_position + END IF ! check if allocated + IF (ALLOCATED(y_out%smoothed_velocity_array) .AND. ALLOCATED(y1%smoothed_velocity_array)) THEN + y_out%smoothed_velocity_array = a1*y1%smoothed_velocity_array + a2*y2%smoothed_velocity_array + END IF ! check if allocated + y_out%AtmUscale = a1*y1%AtmUscale + a2*y2%AtmUscale + y_out%du_dz_ABL = a1*y1%du_dz_ABL + a2*y2%du_dz_ABL + y_out%total_SDgenpwr = a1*y1%total_SDgenpwr + a2*y2%total_SDgenpwr + y_out%mean_SDgenpwr = a1*y1%mean_SDgenpwr + a2*y2%mean_SDgenpwr + y_out%avg_ct = a1*y1%avg_ct + a2*y2%avg_ct + CALL InflowWind_Output_ExtrapInterp1( y1%IfW, y2%IfW, tin, y_out%IfW, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE - ScaleFactor = t_out / t(2) -IF (ALLOCATED(y_out%turbine_thrust_force) .AND. ALLOCATED(y1%turbine_thrust_force)) THEN - DO i1 = LBOUND(y_out%turbine_thrust_force,1),UBOUND(y_out%turbine_thrust_force,1) - b = -(y1%turbine_thrust_force(i1) - y2%turbine_thrust_force(i1)) - y_out%turbine_thrust_force(i1) = y1%turbine_thrust_force(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%induction_factor) .AND. ALLOCATED(y1%induction_factor)) THEN - DO i1 = LBOUND(y_out%induction_factor,1),UBOUND(y_out%induction_factor,1) - b = -(y1%induction_factor(i1) - y2%induction_factor(i1)) - y_out%induction_factor(i1) = y1%induction_factor(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%r_initial) .AND. ALLOCATED(y1%r_initial)) THEN - DO i1 = LBOUND(y_out%r_initial,1),UBOUND(y_out%r_initial,1) - b = -(y1%r_initial(i1) - y2%r_initial(i1)) - y_out%r_initial(i1) = y1%r_initial(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%U_initial) .AND. ALLOCATED(y1%U_initial)) THEN - DO i1 = LBOUND(y_out%U_initial,1),UBOUND(y_out%U_initial,1) - b = -(y1%U_initial(i1) - y2%U_initial(i1)) - y_out%U_initial(i1) = y1%U_initial(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Mean_FFWS_array) .AND. ALLOCATED(y1%Mean_FFWS_array)) THEN - DO i1 = LBOUND(y_out%Mean_FFWS_array,1),UBOUND(y_out%Mean_FFWS_array,1) - b = -(y1%Mean_FFWS_array(i1) - y2%Mean_FFWS_array(i1)) - y_out%Mean_FFWS_array(i1) = y1%Mean_FFWS_array(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - b = -(y1%Mean_FFWS - y2%Mean_FFWS) - y_out%Mean_FFWS = y1%Mean_FFWS + b * ScaleFactor - b = -(y1%TI - y2%TI) - y_out%TI = y1%TI + b * ScaleFactor - b = -(y1%TI_downstream - y2%TI_downstream) - y_out%TI_downstream = y1%TI_downstream + b * ScaleFactor -IF (ALLOCATED(y_out%wake_u) .AND. ALLOCATED(y1%wake_u)) THEN - DO i2 = LBOUND(y_out%wake_u,2),UBOUND(y_out%wake_u,2) - DO i1 = LBOUND(y_out%wake_u,1),UBOUND(y_out%wake_u,1) - b = -(y1%wake_u(i1,i2) - y2%wake_u(i1,i2)) - y_out%wake_u(i1,i2) = y1%wake_u(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%wake_position) .AND. ALLOCATED(y1%wake_position)) THEN - DO i3 = LBOUND(y_out%wake_position,3),UBOUND(y_out%wake_position,3) - DO i2 = LBOUND(y_out%wake_position,2),UBOUND(y_out%wake_position,2) - DO i1 = LBOUND(y_out%wake_position,1),UBOUND(y_out%wake_position,1) - b = -(y1%wake_position(i1,i2,i3) - y2%wake_position(i1,i2,i3)) - y_out%wake_position(i1,i2,i3) = y1%wake_position(i1,i2,i3) + b * ScaleFactor - END DO - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%smoothed_velocity_array) .AND. ALLOCATED(y1%smoothed_velocity_array)) THEN - DO i2 = LBOUND(y_out%smoothed_velocity_array,2),UBOUND(y_out%smoothed_velocity_array,2) - DO i1 = LBOUND(y_out%smoothed_velocity_array,1),UBOUND(y_out%smoothed_velocity_array,1) - b = -(y1%smoothed_velocity_array(i1,i2) - y2%smoothed_velocity_array(i1,i2)) - y_out%smoothed_velocity_array(i1,i2) = y1%smoothed_velocity_array(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated - b = -(y1%AtmUscale - y2%AtmUscale) - y_out%AtmUscale = y1%AtmUscale + b * ScaleFactor - b = -(y1%du_dz_ABL - y2%du_dz_ABL) - y_out%du_dz_ABL = y1%du_dz_ABL + b * ScaleFactor - b = -(y1%total_SDgenpwr - y2%total_SDgenpwr) - y_out%total_SDgenpwr = y1%total_SDgenpwr + b * ScaleFactor - b = -(y1%mean_SDgenpwr - y2%mean_SDgenpwr) - y_out%mean_SDgenpwr = y1%mean_SDgenpwr + b * ScaleFactor - b = -(y1%avg_ct - y2%avg_ct) - y_out%avg_ct = y1%avg_ct + b * ScaleFactor - CALL InflowWind_Output_ExtrapInterp1( y1%IfW, y2%IfW, tin, y_out%IfW, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE DWM_Output_ExtrapInterp1 - - - SUBROUTINE DWM_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE DWM_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 2. @@ -4265,141 +4120,85 @@ SUBROUTINE DWM_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - TYPE(DWM_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 - TYPE(DWM_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 - TYPE(DWM_OutputType), INTENT(IN) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(DWM_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(DWM_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 + TYPE(DWM_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 + TYPE(DWM_OutputType), INTENT(IN) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(DWM_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - INTEGER :: i3 ! dim3 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) -IF (ALLOCATED(y_out%turbine_thrust_force) .AND. ALLOCATED(y1%turbine_thrust_force)) THEN - DO i1 = LBOUND(y_out%turbine_thrust_force,1),UBOUND(y_out%turbine_thrust_force,1) - b = (t(3)**2*(y1%turbine_thrust_force(i1) - y2%turbine_thrust_force(i1)) + t(2)**2*(-y1%turbine_thrust_force(i1) + y3%turbine_thrust_force(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%turbine_thrust_force(i1) + t(3)*y2%turbine_thrust_force(i1) - t(2)*y3%turbine_thrust_force(i1) ) * scaleFactor - y_out%turbine_thrust_force(i1) = y1%turbine_thrust_force(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%induction_factor) .AND. ALLOCATED(y1%induction_factor)) THEN - DO i1 = LBOUND(y_out%induction_factor,1),UBOUND(y_out%induction_factor,1) - b = (t(3)**2*(y1%induction_factor(i1) - y2%induction_factor(i1)) + t(2)**2*(-y1%induction_factor(i1) + y3%induction_factor(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%induction_factor(i1) + t(3)*y2%induction_factor(i1) - t(2)*y3%induction_factor(i1) ) * scaleFactor - y_out%induction_factor(i1) = y1%induction_factor(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%r_initial) .AND. ALLOCATED(y1%r_initial)) THEN - DO i1 = LBOUND(y_out%r_initial,1),UBOUND(y_out%r_initial,1) - b = (t(3)**2*(y1%r_initial(i1) - y2%r_initial(i1)) + t(2)**2*(-y1%r_initial(i1) + y3%r_initial(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%r_initial(i1) + t(3)*y2%r_initial(i1) - t(2)*y3%r_initial(i1) ) * scaleFactor - y_out%r_initial(i1) = y1%r_initial(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%U_initial) .AND. ALLOCATED(y1%U_initial)) THEN - DO i1 = LBOUND(y_out%U_initial,1),UBOUND(y_out%U_initial,1) - b = (t(3)**2*(y1%U_initial(i1) - y2%U_initial(i1)) + t(2)**2*(-y1%U_initial(i1) + y3%U_initial(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%U_initial(i1) + t(3)*y2%U_initial(i1) - t(2)*y3%U_initial(i1) ) * scaleFactor - y_out%U_initial(i1) = y1%U_initial(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Mean_FFWS_array) .AND. ALLOCATED(y1%Mean_FFWS_array)) THEN - DO i1 = LBOUND(y_out%Mean_FFWS_array,1),UBOUND(y_out%Mean_FFWS_array,1) - b = (t(3)**2*(y1%Mean_FFWS_array(i1) - y2%Mean_FFWS_array(i1)) + t(2)**2*(-y1%Mean_FFWS_array(i1) + y3%Mean_FFWS_array(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%Mean_FFWS_array(i1) + t(3)*y2%Mean_FFWS_array(i1) - t(2)*y3%Mean_FFWS_array(i1) ) * scaleFactor - y_out%Mean_FFWS_array(i1) = y1%Mean_FFWS_array(i1) + b + c * t_out - END DO -END IF ! check if allocated - b = (t(3)**2*(y1%Mean_FFWS - y2%Mean_FFWS) + t(2)**2*(-y1%Mean_FFWS + y3%Mean_FFWS))* scaleFactor - c = ( (t(2)-t(3))*y1%Mean_FFWS + t(3)*y2%Mean_FFWS - t(2)*y3%Mean_FFWS ) * scaleFactor - y_out%Mean_FFWS = y1%Mean_FFWS + b + c * t_out - b = (t(3)**2*(y1%TI - y2%TI) + t(2)**2*(-y1%TI + y3%TI))* scaleFactor - c = ( (t(2)-t(3))*y1%TI + t(3)*y2%TI - t(2)*y3%TI ) * scaleFactor - y_out%TI = y1%TI + b + c * t_out - b = (t(3)**2*(y1%TI_downstream - y2%TI_downstream) + t(2)**2*(-y1%TI_downstream + y3%TI_downstream))* scaleFactor - c = ( (t(2)-t(3))*y1%TI_downstream + t(3)*y2%TI_downstream - t(2)*y3%TI_downstream ) * scaleFactor - y_out%TI_downstream = y1%TI_downstream + b + c * t_out -IF (ALLOCATED(y_out%wake_u) .AND. ALLOCATED(y1%wake_u)) THEN - DO i2 = LBOUND(y_out%wake_u,2),UBOUND(y_out%wake_u,2) - DO i1 = LBOUND(y_out%wake_u,1),UBOUND(y_out%wake_u,1) - b = (t(3)**2*(y1%wake_u(i1,i2) - y2%wake_u(i1,i2)) + t(2)**2*(-y1%wake_u(i1,i2) + y3%wake_u(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%wake_u(i1,i2) + t(3)*y2%wake_u(i1,i2) - t(2)*y3%wake_u(i1,i2) ) * scaleFactor - y_out%wake_u(i1,i2) = y1%wake_u(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%wake_position) .AND. ALLOCATED(y1%wake_position)) THEN - DO i3 = LBOUND(y_out%wake_position,3),UBOUND(y_out%wake_position,3) - DO i2 = LBOUND(y_out%wake_position,2),UBOUND(y_out%wake_position,2) - DO i1 = LBOUND(y_out%wake_position,1),UBOUND(y_out%wake_position,1) - b = (t(3)**2*(y1%wake_position(i1,i2,i3) - y2%wake_position(i1,i2,i3)) + t(2)**2*(-y1%wake_position(i1,i2,i3) + y3%wake_position(i1,i2,i3)))* scaleFactor - c = ( (t(2)-t(3))*y1%wake_position(i1,i2,i3) + t(3)*y2%wake_position(i1,i2,i3) - t(2)*y3%wake_position(i1,i2,i3) ) * scaleFactor - y_out%wake_position(i1,i2,i3) = y1%wake_position(i1,i2,i3) + b + c * t_out - END DO - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%smoothed_velocity_array) .AND. ALLOCATED(y1%smoothed_velocity_array)) THEN - DO i2 = LBOUND(y_out%smoothed_velocity_array,2),UBOUND(y_out%smoothed_velocity_array,2) - DO i1 = LBOUND(y_out%smoothed_velocity_array,1),UBOUND(y_out%smoothed_velocity_array,1) - b = (t(3)**2*(y1%smoothed_velocity_array(i1,i2) - y2%smoothed_velocity_array(i1,i2)) + t(2)**2*(-y1%smoothed_velocity_array(i1,i2) + y3%smoothed_velocity_array(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%smoothed_velocity_array(i1,i2) + t(3)*y2%smoothed_velocity_array(i1,i2) - t(2)*y3%smoothed_velocity_array(i1,i2) ) * scaleFactor - y_out%smoothed_velocity_array(i1,i2) = y1%smoothed_velocity_array(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated - b = (t(3)**2*(y1%AtmUscale - y2%AtmUscale) + t(2)**2*(-y1%AtmUscale + y3%AtmUscale))* scaleFactor - c = ( (t(2)-t(3))*y1%AtmUscale + t(3)*y2%AtmUscale - t(2)*y3%AtmUscale ) * scaleFactor - y_out%AtmUscale = y1%AtmUscale + b + c * t_out - b = (t(3)**2*(y1%du_dz_ABL - y2%du_dz_ABL) + t(2)**2*(-y1%du_dz_ABL + y3%du_dz_ABL))* scaleFactor - c = ( (t(2)-t(3))*y1%du_dz_ABL + t(3)*y2%du_dz_ABL - t(2)*y3%du_dz_ABL ) * scaleFactor - y_out%du_dz_ABL = y1%du_dz_ABL + b + c * t_out - b = (t(3)**2*(y1%total_SDgenpwr - y2%total_SDgenpwr) + t(2)**2*(-y1%total_SDgenpwr + y3%total_SDgenpwr))* scaleFactor - c = ( (t(2)-t(3))*y1%total_SDgenpwr + t(3)*y2%total_SDgenpwr - t(2)*y3%total_SDgenpwr ) * scaleFactor - y_out%total_SDgenpwr = y1%total_SDgenpwr + b + c * t_out - b = (t(3)**2*(y1%mean_SDgenpwr - y2%mean_SDgenpwr) + t(2)**2*(-y1%mean_SDgenpwr + y3%mean_SDgenpwr))* scaleFactor - c = ( (t(2)-t(3))*y1%mean_SDgenpwr + t(3)*y2%mean_SDgenpwr - t(2)*y3%mean_SDgenpwr ) * scaleFactor - y_out%mean_SDgenpwr = y1%mean_SDgenpwr + b + c * t_out - b = (t(3)**2*(y1%avg_ct - y2%avg_ct) + t(2)**2*(-y1%avg_ct + y3%avg_ct))* scaleFactor - c = ( (t(2)-t(3))*y1%avg_ct + t(3)*y2%avg_ct - t(2)*y3%avg_ct ) * scaleFactor - y_out%avg_ct = y1%avg_ct + b + c * t_out - CALL InflowWind_Output_ExtrapInterp2( y1%IfW, y2%IfW, y3%IfW, tin, y_out%IfW, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE DWM_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%turbine_thrust_force) .AND. ALLOCATED(y1%turbine_thrust_force)) THEN + y_out%turbine_thrust_force = a1*y1%turbine_thrust_force + a2*y2%turbine_thrust_force + a3*y3%turbine_thrust_force + END IF ! check if allocated + IF (ALLOCATED(y_out%induction_factor) .AND. ALLOCATED(y1%induction_factor)) THEN + y_out%induction_factor = a1*y1%induction_factor + a2*y2%induction_factor + a3*y3%induction_factor + END IF ! check if allocated + IF (ALLOCATED(y_out%r_initial) .AND. ALLOCATED(y1%r_initial)) THEN + y_out%r_initial = a1*y1%r_initial + a2*y2%r_initial + a3*y3%r_initial + END IF ! check if allocated + IF (ALLOCATED(y_out%U_initial) .AND. ALLOCATED(y1%U_initial)) THEN + y_out%U_initial = a1*y1%U_initial + a2*y2%U_initial + a3*y3%U_initial + END IF ! check if allocated + IF (ALLOCATED(y_out%Mean_FFWS_array) .AND. ALLOCATED(y1%Mean_FFWS_array)) THEN + y_out%Mean_FFWS_array = a1*y1%Mean_FFWS_array + a2*y2%Mean_FFWS_array + a3*y3%Mean_FFWS_array + END IF ! check if allocated + y_out%Mean_FFWS = a1*y1%Mean_FFWS + a2*y2%Mean_FFWS + a3*y3%Mean_FFWS + y_out%TI = a1*y1%TI + a2*y2%TI + a3*y3%TI + y_out%TI_downstream = a1*y1%TI_downstream + a2*y2%TI_downstream + a3*y3%TI_downstream + IF (ALLOCATED(y_out%wake_u) .AND. ALLOCATED(y1%wake_u)) THEN + y_out%wake_u = a1*y1%wake_u + a2*y2%wake_u + a3*y3%wake_u + END IF ! check if allocated + IF (ALLOCATED(y_out%wake_position) .AND. ALLOCATED(y1%wake_position)) THEN + y_out%wake_position = a1*y1%wake_position + a2*y2%wake_position + a3*y3%wake_position + END IF ! check if allocated + IF (ALLOCATED(y_out%smoothed_velocity_array) .AND. ALLOCATED(y1%smoothed_velocity_array)) THEN + y_out%smoothed_velocity_array = a1*y1%smoothed_velocity_array + a2*y2%smoothed_velocity_array + a3*y3%smoothed_velocity_array + END IF ! check if allocated + y_out%AtmUscale = a1*y1%AtmUscale + a2*y2%AtmUscale + a3*y3%AtmUscale + y_out%du_dz_ABL = a1*y1%du_dz_ABL + a2*y2%du_dz_ABL + a3*y3%du_dz_ABL + y_out%total_SDgenpwr = a1*y1%total_SDgenpwr + a2*y2%total_SDgenpwr + a3*y3%total_SDgenpwr + y_out%mean_SDgenpwr = a1*y1%mean_SDgenpwr + a2*y2%mean_SDgenpwr + a3*y3%mean_SDgenpwr + y_out%avg_ct = a1*y1%avg_ct + a2*y2%avg_ct + a3*y3%avg_ct + CALL InflowWind_Output_ExtrapInterp2( y1%IfW, y2%IfW, y3%IfW, tin, y_out%IfW, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE END MODULE DWM_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/beamdyn/src/BeamDyn_Types.f90 b/modules/beamdyn/src/BeamDyn_Types.f90 index fc6c902a14..226c4a5137 100644 --- a/modules/beamdyn/src/BeamDyn_Types.f90 +++ b/modules/beamdyn/src/BeamDyn_Types.f90 @@ -5380,58 +5380,59 @@ subroutine BD_UnPackMisc(Buf, OutData) call BD_UnpackInput(Buf, OutData%u2) ! u2 end subroutine - SUBROUTINE BD_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(BD_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(BD_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None +subroutine BD_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time + ! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(BD_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(BD_InputType), intent(inout) :: u_out ! Input at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'BD_Input_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(u)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(u) - 1 - IF ( order .eq. 0 ) THEN - CALL BD_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL BD_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL BD_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE BD_Input_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'BD_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call BD_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call BD_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call BD_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE BD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE BD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 1. @@ -5443,47 +5444,48 @@ SUBROUTINE BD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! !.................................................................................................................................. - TYPE(BD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(BD_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(BD_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(BD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(BD_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(BD_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'BD_Input_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'BD_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(u1%RootMotion, u2%RootMotion, tin, u_out%RootMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(u1%PointLoad, u2%PointLoad, tin, u_out%PointLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(u1%DistrLoad, u2%DistrLoad, tin, u_out%DistrLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(u1%HubMotion, u2%HubMotion, tin, u_out%HubMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE - ScaleFactor = t_out / t(2) - CALL MeshExtrapInterp1(u1%RootMotion, u2%RootMotion, tin, u_out%RootMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(u1%PointLoad, u2%PointLoad, tin, u_out%PointLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(u1%DistrLoad, u2%DistrLoad, tin, u_out%DistrLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(u1%HubMotion, u2%HubMotion, tin, u_out%HubMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE BD_Input_ExtrapInterp1 - - - SUBROUTINE BD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE BD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 2. @@ -5497,107 +5499,108 @@ SUBROUTINE BD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM ! !.................................................................................................................................. - TYPE(BD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(BD_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(BD_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(BD_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(BD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(BD_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(BD_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(BD_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'BD_Input_ExtrapInterp2' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'BD_Input_ExtrapInterp2' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(u1%RootMotion, u2%RootMotion, u3%RootMotion, tin, u_out%RootMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(u1%PointLoad, u2%PointLoad, u3%PointLoad, tin, u_out%PointLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(u1%DistrLoad, u2%DistrLoad, u3%DistrLoad, tin, u_out%DistrLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(u1%HubMotion, u2%HubMotion, u3%HubMotion, tin, u_out%HubMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) - CALL MeshExtrapInterp2(u1%RootMotion, u2%RootMotion, u3%RootMotion, tin, u_out%RootMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(u1%PointLoad, u2%PointLoad, u3%PointLoad, tin, u_out%PointLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(u1%DistrLoad, u2%DistrLoad, u3%DistrLoad, tin, u_out%DistrLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(u1%HubMotion, u2%HubMotion, u3%HubMotion, tin, u_out%HubMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE BD_Input_ExtrapInterp2 - - - SUBROUTINE BD_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(BD_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(BD_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None +subroutine BD_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time + ! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(BD_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(BD_OutputType), intent(inout) :: y_out ! Output at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'BD_Output_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(y)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(y) - 1 - IF ( order .eq. 0 ) THEN - CALL BD_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL BD_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL BD_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE BD_Output_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'BD_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call BD_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call BD_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call BD_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE BD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE BD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 1. @@ -5609,55 +5612,51 @@ SUBROUTINE BD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(BD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(BD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(BD_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(BD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(BD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(BD_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'BD_Output_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'BD_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(y1%ReactionForce, y2%ReactionForce, tin, y_out%ReactionForce, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(y1%BldMotion, y2%BldMotion, tin, y_out%BldMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + y_out%RootMxr = a1*y1%RootMxr + a2*y2%RootMxr + y_out%RootMyr = a1*y1%RootMyr + a2*y2%RootMyr + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated +END SUBROUTINE - ScaleFactor = t_out / t(2) - CALL MeshExtrapInterp1(y1%ReactionForce, y2%ReactionForce, tin, y_out%ReactionForce, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(y1%BldMotion, y2%BldMotion, tin, y_out%BldMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - b = -(y1%RootMxr - y2%RootMxr) - y_out%RootMxr = y1%RootMxr + b * ScaleFactor - b = -(y1%RootMyr - y2%RootMyr) - y_out%RootMyr = y1%RootMyr + b * ScaleFactor -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE BD_Output_ExtrapInterp1 - - - SUBROUTINE BD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE BD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 2. @@ -5671,64 +5670,56 @@ SUBROUTINE BD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - TYPE(BD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(BD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(BD_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(BD_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(BD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(BD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(BD_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(BD_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'BD_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'BD_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) - CALL MeshExtrapInterp2(y1%ReactionForce, y2%ReactionForce, y3%ReactionForce, tin, y_out%ReactionForce, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(y1%BldMotion, y2%BldMotion, y3%BldMotion, tin, y_out%BldMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - b = (t(3)**2*(y1%RootMxr - y2%RootMxr) + t(2)**2*(-y1%RootMxr + y3%RootMxr))* scaleFactor - c = ( (t(2)-t(3))*y1%RootMxr + t(3)*y2%RootMxr - t(2)*y3%RootMxr ) * scaleFactor - y_out%RootMxr = y1%RootMxr + b + c * t_out - b = (t(3)**2*(y1%RootMyr - y2%RootMyr) + t(2)**2*(-y1%RootMyr + y3%RootMyr))* scaleFactor - c = ( (t(2)-t(3))*y1%RootMyr + t(3)*y2%RootMyr - t(2)*y3%RootMyr ) * scaleFactor - y_out%RootMyr = y1%RootMyr + b + c * t_out -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE BD_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(y1%ReactionForce, y2%ReactionForce, y3%ReactionForce, tin, y_out%ReactionForce, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(y1%BldMotion, y2%BldMotion, y3%BldMotion, tin, y_out%BldMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + y_out%RootMxr = a1*y1%RootMxr + a2*y2%RootMxr + a3*y3%RootMxr + y_out%RootMyr = a1*y1%RootMyr + a2*y2%RootMyr + a3*y3%RootMyr + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated +END SUBROUTINE END MODULE BeamDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/elastodyn/src/ElastoDyn_Types.f90 b/modules/elastodyn/src/ElastoDyn_Types.f90 index 3251a99da3..45e632f0a6 100644 --- a/modules/elastodyn/src/ElastoDyn_Types.f90 +++ b/modules/elastodyn/src/ElastoDyn_Types.f90 @@ -11039,58 +11039,59 @@ subroutine ED_UnPackOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE ED_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(ED_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(ED_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None +subroutine ED_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time + ! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(ED_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(ED_InputType), intent(inout) :: u_out ! Input at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'ED_Input_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(u)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(u) - 1 - IF ( order .eq. 0 ) THEN - CALL ED_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL ED_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL ED_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE ED_Input_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'ED_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call ED_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call ED_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call ED_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE ED_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE ED_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 1. @@ -11102,88 +11103,74 @@ SUBROUTINE ED_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! !.................................................................................................................................. - TYPE(ED_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(ED_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(ED_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(ED_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(ED_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(ED_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'ED_Input_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - INTEGER :: i3 ! dim3 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'ED_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF - - ScaleFactor = t_out / t(2) -IF (ALLOCATED(u_out%BladePtLoads) .AND. ALLOCATED(u1%BladePtLoads)) THEN - DO i1 = LBOUND(u_out%BladePtLoads,1),UBOUND(u_out%BladePtLoads,1) - CALL MeshExtrapInterp1(u1%BladePtLoads(i1), u2%BladePtLoads(i1), tin, u_out%BladePtLoads(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - CALL MeshExtrapInterp1(u1%PlatformPtMesh, u2%PlatformPtMesh, tin, u_out%PlatformPtMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(u1%TowerPtLoads, u2%TowerPtLoads, tin, u_out%TowerPtLoads, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(u1%HubPtLoad, u2%HubPtLoad, tin, u_out%HubPtLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(u1%NacelleLoads, u2%NacelleLoads, tin, u_out%NacelleLoads, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(u1%TFinCMLoads, u2%TFinCMLoads, tin, u_out%TFinCMLoads, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(u_out%TwrAddedMass) .AND. ALLOCATED(u1%TwrAddedMass)) THEN - DO i3 = LBOUND(u_out%TwrAddedMass,3),UBOUND(u_out%TwrAddedMass,3) - DO i2 = LBOUND(u_out%TwrAddedMass,2),UBOUND(u_out%TwrAddedMass,2) - DO i1 = LBOUND(u_out%TwrAddedMass,1),UBOUND(u_out%TwrAddedMass,1) - b = -(u1%TwrAddedMass(i1,i2,i3) - u2%TwrAddedMass(i1,i2,i3)) - u_out%TwrAddedMass(i1,i2,i3) = u1%TwrAddedMass(i1,i2,i3) + b * ScaleFactor + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(u_out%BladePtLoads) .AND. ALLOCATED(u1%BladePtLoads)) THEN + DO i1 = LBOUND(u_out%BladePtLoads,1),UBOUND(u_out%BladePtLoads,1) + CALL MeshExtrapInterp1(u1%BladePtLoads(i1), u2%BladePtLoads(i1), tin, u_out%BladePtLoads(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - END DO - END DO -END IF ! check if allocated - DO i2 = LBOUND(u_out%PtfmAddedMass,2),UBOUND(u_out%PtfmAddedMass,2) - DO i1 = LBOUND(u_out%PtfmAddedMass,1),UBOUND(u_out%PtfmAddedMass,1) - b = -(u1%PtfmAddedMass(i1,i2) - u2%PtfmAddedMass(i1,i2)) - u_out%PtfmAddedMass(i1,i2) = u1%PtfmAddedMass(i1,i2) + b * ScaleFactor - END DO - END DO -IF (ALLOCATED(u_out%BlPitchCom) .AND. ALLOCATED(u1%BlPitchCom)) THEN - DO i1 = LBOUND(u_out%BlPitchCom,1),UBOUND(u_out%BlPitchCom,1) - CALL Angles_ExtrapInterp( u1%BlPitchCom(i1), u2%BlPitchCom(i1), tin, u_out%BlPitchCom(i1), tin_out ) - END DO -END IF ! check if allocated - b = -(u1%YawMom - u2%YawMom) - u_out%YawMom = u1%YawMom + b * ScaleFactor - b = -(u1%GenTrq - u2%GenTrq) - u_out%GenTrq = u1%GenTrq + b * ScaleFactor - b = -(u1%HSSBrTrqC - u2%HSSBrTrqC) - u_out%HSSBrTrqC = u1%HSSBrTrqC + b * ScaleFactor - END SUBROUTINE ED_Input_ExtrapInterp1 - + END IF ! check if allocated + CALL MeshExtrapInterp1(u1%PlatformPtMesh, u2%PlatformPtMesh, tin, u_out%PlatformPtMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(u1%TowerPtLoads, u2%TowerPtLoads, tin, u_out%TowerPtLoads, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(u1%HubPtLoad, u2%HubPtLoad, tin, u_out%HubPtLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(u1%NacelleLoads, u2%NacelleLoads, tin, u_out%NacelleLoads, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(u1%TFinCMLoads, u2%TFinCMLoads, tin, u_out%TFinCMLoads, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(u_out%TwrAddedMass) .AND. ALLOCATED(u1%TwrAddedMass)) THEN + u_out%TwrAddedMass = a1*u1%TwrAddedMass + a2*u2%TwrAddedMass + END IF ! check if allocated + u_out%PtfmAddedMass = a1*u1%PtfmAddedMass + a2*u2%PtfmAddedMass + IF (ALLOCATED(u_out%BlPitchCom) .AND. ALLOCATED(u1%BlPitchCom)) THEN + DO i1 = LBOUND(u_out%BlPitchCom,1),UBOUND(u_out%BlPitchCom,1) + CALL Angles_ExtrapInterp( u1%BlPitchCom(i1), u2%BlPitchCom(i1), tin, u_out%BlPitchCom(i1), tin_out ) + END DO + END IF ! check if allocated + u_out%YawMom = a1*u1%YawMom + a2*u2%YawMom + u_out%GenTrq = a1*u1%GenTrq + a2*u2%GenTrq + u_out%HSSBrTrqC = a1*u1%HSSBrTrqC + a2*u2%HSSBrTrqC +END SUBROUTINE - SUBROUTINE ED_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE ED_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 2. @@ -11197,153 +11184,134 @@ SUBROUTINE ED_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM ! !.................................................................................................................................. - TYPE(ED_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(ED_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(ED_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(ED_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(ED_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(ED_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(ED_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(ED_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'ED_Input_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - INTEGER :: i3 ! dim3 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'ED_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) -IF (ALLOCATED(u_out%BladePtLoads) .AND. ALLOCATED(u1%BladePtLoads)) THEN - DO i1 = LBOUND(u_out%BladePtLoads,1),UBOUND(u_out%BladePtLoads,1) - CALL MeshExtrapInterp2(u1%BladePtLoads(i1), u2%BladePtLoads(i1), u3%BladePtLoads(i1), tin, u_out%BladePtLoads(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - CALL MeshExtrapInterp2(u1%PlatformPtMesh, u2%PlatformPtMesh, u3%PlatformPtMesh, tin, u_out%PlatformPtMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(u1%TowerPtLoads, u2%TowerPtLoads, u3%TowerPtLoads, tin, u_out%TowerPtLoads, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(u1%HubPtLoad, u2%HubPtLoad, u3%HubPtLoad, tin, u_out%HubPtLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(u1%NacelleLoads, u2%NacelleLoads, u3%NacelleLoads, tin, u_out%NacelleLoads, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(u1%TFinCMLoads, u2%TFinCMLoads, u3%TFinCMLoads, tin, u_out%TFinCMLoads, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(u_out%TwrAddedMass) .AND. ALLOCATED(u1%TwrAddedMass)) THEN - DO i3 = LBOUND(u_out%TwrAddedMass,3),UBOUND(u_out%TwrAddedMass,3) - DO i2 = LBOUND(u_out%TwrAddedMass,2),UBOUND(u_out%TwrAddedMass,2) - DO i1 = LBOUND(u_out%TwrAddedMass,1),UBOUND(u_out%TwrAddedMass,1) - b = (t(3)**2*(u1%TwrAddedMass(i1,i2,i3) - u2%TwrAddedMass(i1,i2,i3)) + t(2)**2*(-u1%TwrAddedMass(i1,i2,i3) + u3%TwrAddedMass(i1,i2,i3)))* scaleFactor - c = ( (t(2)-t(3))*u1%TwrAddedMass(i1,i2,i3) + t(3)*u2%TwrAddedMass(i1,i2,i3) - t(2)*u3%TwrAddedMass(i1,i2,i3) ) * scaleFactor - u_out%TwrAddedMass(i1,i2,i3) = u1%TwrAddedMass(i1,i2,i3) + b + c * t_out + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(u_out%BladePtLoads) .AND. ALLOCATED(u1%BladePtLoads)) THEN + DO i1 = LBOUND(u_out%BladePtLoads,1),UBOUND(u_out%BladePtLoads,1) + CALL MeshExtrapInterp2(u1%BladePtLoads(i1), u2%BladePtLoads(i1), u3%BladePtLoads(i1), tin, u_out%BladePtLoads(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - END DO - END DO -END IF ! check if allocated - DO i2 = LBOUND(u_out%PtfmAddedMass,2),UBOUND(u_out%PtfmAddedMass,2) - DO i1 = LBOUND(u_out%PtfmAddedMass,1),UBOUND(u_out%PtfmAddedMass,1) - b = (t(3)**2*(u1%PtfmAddedMass(i1,i2) - u2%PtfmAddedMass(i1,i2)) + t(2)**2*(-u1%PtfmAddedMass(i1,i2) + u3%PtfmAddedMass(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%PtfmAddedMass(i1,i2) + t(3)*u2%PtfmAddedMass(i1,i2) - t(2)*u3%PtfmAddedMass(i1,i2) ) * scaleFactor - u_out%PtfmAddedMass(i1,i2) = u1%PtfmAddedMass(i1,i2) + b + c * t_out - END DO - END DO -IF (ALLOCATED(u_out%BlPitchCom) .AND. ALLOCATED(u1%BlPitchCom)) THEN - DO i1 = LBOUND(u_out%BlPitchCom,1),UBOUND(u_out%BlPitchCom,1) - CALL Angles_ExtrapInterp( u1%BlPitchCom(i1), u2%BlPitchCom(i1), u3%BlPitchCom(i1), tin, u_out%BlPitchCom(i1), tin_out ) - END DO -END IF ! check if allocated - b = (t(3)**2*(u1%YawMom - u2%YawMom) + t(2)**2*(-u1%YawMom + u3%YawMom))* scaleFactor - c = ( (t(2)-t(3))*u1%YawMom + t(3)*u2%YawMom - t(2)*u3%YawMom ) * scaleFactor - u_out%YawMom = u1%YawMom + b + c * t_out - b = (t(3)**2*(u1%GenTrq - u2%GenTrq) + t(2)**2*(-u1%GenTrq + u3%GenTrq))* scaleFactor - c = ( (t(2)-t(3))*u1%GenTrq + t(3)*u2%GenTrq - t(2)*u3%GenTrq ) * scaleFactor - u_out%GenTrq = u1%GenTrq + b + c * t_out - b = (t(3)**2*(u1%HSSBrTrqC - u2%HSSBrTrqC) + t(2)**2*(-u1%HSSBrTrqC + u3%HSSBrTrqC))* scaleFactor - c = ( (t(2)-t(3))*u1%HSSBrTrqC + t(3)*u2%HSSBrTrqC - t(2)*u3%HSSBrTrqC ) * scaleFactor - u_out%HSSBrTrqC = u1%HSSBrTrqC + b + c * t_out - END SUBROUTINE ED_Input_ExtrapInterp2 - - - SUBROUTINE ED_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) -! -!.................................................................................................................................. + END IF ! check if allocated + CALL MeshExtrapInterp2(u1%PlatformPtMesh, u2%PlatformPtMesh, u3%PlatformPtMesh, tin, u_out%PlatformPtMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(u1%TowerPtLoads, u2%TowerPtLoads, u3%TowerPtLoads, tin, u_out%TowerPtLoads, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(u1%HubPtLoad, u2%HubPtLoad, u3%HubPtLoad, tin, u_out%HubPtLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(u1%NacelleLoads, u2%NacelleLoads, u3%NacelleLoads, tin, u_out%NacelleLoads, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(u1%TFinCMLoads, u2%TFinCMLoads, u3%TFinCMLoads, tin, u_out%TFinCMLoads, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(u_out%TwrAddedMass) .AND. ALLOCATED(u1%TwrAddedMass)) THEN + u_out%TwrAddedMass = a1*u1%TwrAddedMass + a2*u2%TwrAddedMass + a3*u3%TwrAddedMass + END IF ! check if allocated + u_out%PtfmAddedMass = a1*u1%PtfmAddedMass + a2*u2%PtfmAddedMass + a3*u3%PtfmAddedMass + IF (ALLOCATED(u_out%BlPitchCom) .AND. ALLOCATED(u1%BlPitchCom)) THEN + DO i1 = LBOUND(u_out%BlPitchCom,1),UBOUND(u_out%BlPitchCom,1) + CALL Angles_ExtrapInterp( u1%BlPitchCom(i1), u2%BlPitchCom(i1), u3%BlPitchCom(i1), tin, u_out%BlPitchCom(i1), tin_out ) + END DO + END IF ! check if allocated + u_out%YawMom = a1*u1%YawMom + a2*u2%YawMom + a3*u3%YawMom + u_out%GenTrq = a1*u1%GenTrq + a2*u2%GenTrq + a3*u3%GenTrq + u_out%HSSBrTrqC = a1*u1%HSSBrTrqC + a2*u2%HSSBrTrqC + a3*u3%HSSBrTrqC +END SUBROUTINE - TYPE(ED_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(ED_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None +subroutine ED_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time + ! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(ED_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(ED_OutputType), intent(inout) :: y_out ! Output at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'ED_Output_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(y)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(y) - 1 - IF ( order .eq. 0 ) THEN - CALL ED_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL ED_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL ED_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE ED_Output_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'ED_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call ED_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call ED_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call ED_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE ED_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE ED_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 1. @@ -11355,135 +11323,106 @@ SUBROUTINE ED_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(ED_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(ED_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(ED_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(ED_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(ED_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(ED_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'ED_Output_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'ED_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%BladeLn2Mesh) .AND. ALLOCATED(y1%BladeLn2Mesh)) THEN + DO i1 = LBOUND(y_out%BladeLn2Mesh,1),UBOUND(y_out%BladeLn2Mesh,1) + CALL MeshExtrapInterp1(y1%BladeLn2Mesh(i1), y2%BladeLn2Mesh(i1), tin, y_out%BladeLn2Mesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + CALL MeshExtrapInterp1(y1%PlatformPtMesh, y2%PlatformPtMesh, tin, y_out%PlatformPtMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(y1%TowerLn2Mesh, y2%TowerLn2Mesh, tin, y_out%TowerLn2Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(y1%HubPtMotion14, y2%HubPtMotion14, tin, y_out%HubPtMotion14, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(y1%HubPtMotion, y2%HubPtMotion, tin, y_out%HubPtMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(y1%BladeRootMotion14, y2%BladeRootMotion14, tin, y_out%BladeRootMotion14, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%BladeRootMotion) .AND. ALLOCATED(y1%BladeRootMotion)) THEN + DO i1 = LBOUND(y_out%BladeRootMotion,1),UBOUND(y_out%BladeRootMotion,1) + CALL MeshExtrapInterp1(y1%BladeRootMotion(i1), y2%BladeRootMotion(i1), tin, y_out%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + CALL MeshExtrapInterp1(y1%RotorFurlMotion14, y2%RotorFurlMotion14, tin, y_out%RotorFurlMotion14, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(y1%NacelleMotion, y2%NacelleMotion, tin, y_out%NacelleMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(y1%TowerBaseMotion14, y2%TowerBaseMotion14, tin, y_out%TowerBaseMotion14, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(y1%TFinCMMotion, y2%TFinCMMotion, tin, y_out%TFinCMMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated + IF (ALLOCATED(y_out%BlPitch) .AND. ALLOCATED(y1%BlPitch)) THEN + DO i1 = LBOUND(y_out%BlPitch,1),UBOUND(y_out%BlPitch,1) + CALL Angles_ExtrapInterp( y1%BlPitch(i1), y2%BlPitch(i1), tin, y_out%BlPitch(i1), tin_out ) + END DO + END IF ! check if allocated + CALL Angles_ExtrapInterp( y1%Yaw, y2%Yaw, tin, y_out%Yaw, tin_out ) + y_out%YawRate = a1*y1%YawRate + a2*y2%YawRate + y_out%LSS_Spd = a1*y1%LSS_Spd + a2*y2%LSS_Spd + y_out%HSS_Spd = a1*y1%HSS_Spd + a2*y2%HSS_Spd + y_out%RotSpeed = a1*y1%RotSpeed + a2*y2%RotSpeed + y_out%TwrAccel = a1*y1%TwrAccel + a2*y2%TwrAccel + CALL Angles_ExtrapInterp( y1%YawAngle, y2%YawAngle, tin, y_out%YawAngle, tin_out ) + y_out%RootMyc = a1*y1%RootMyc + a2*y2%RootMyc + y_out%YawBrTAxp = a1*y1%YawBrTAxp + a2*y2%YawBrTAxp + y_out%YawBrTAyp = a1*y1%YawBrTAyp + a2*y2%YawBrTAyp + CALL Angles_ExtrapInterp( y1%LSSTipPxa, y2%LSSTipPxa, tin, y_out%LSSTipPxa, tin_out ) + y_out%RootMxc = a1*y1%RootMxc + a2*y2%RootMxc + y_out%LSSTipMxa = a1*y1%LSSTipMxa + a2*y2%LSSTipMxa + y_out%LSSTipMya = a1*y1%LSSTipMya + a2*y2%LSSTipMya + y_out%LSSTipMza = a1*y1%LSSTipMza + a2*y2%LSSTipMza + y_out%LSSTipMys = a1*y1%LSSTipMys + a2*y2%LSSTipMys + y_out%LSSTipMzs = a1*y1%LSSTipMzs + a2*y2%LSSTipMzs + y_out%YawBrMyn = a1*y1%YawBrMyn + a2*y2%YawBrMyn + y_out%YawBrMzn = a1*y1%YawBrMzn + a2*y2%YawBrMzn + y_out%NcIMURAxs = a1*y1%NcIMURAxs + a2*y2%NcIMURAxs + y_out%NcIMURAys = a1*y1%NcIMURAys + a2*y2%NcIMURAys + y_out%NcIMURAzs = a1*y1%NcIMURAzs + a2*y2%NcIMURAzs + y_out%RotPwr = a1*y1%RotPwr + a2*y2%RotPwr + y_out%LSShftFxa = a1*y1%LSShftFxa + a2*y2%LSShftFxa + y_out%LSShftFys = a1*y1%LSShftFys + a2*y2%LSShftFys + y_out%LSShftFzs = a1*y1%LSShftFzs + a2*y2%LSShftFzs +END SUBROUTINE - ScaleFactor = t_out / t(2) -IF (ALLOCATED(y_out%BladeLn2Mesh) .AND. ALLOCATED(y1%BladeLn2Mesh)) THEN - DO i1 = LBOUND(y_out%BladeLn2Mesh,1),UBOUND(y_out%BladeLn2Mesh,1) - CALL MeshExtrapInterp1(y1%BladeLn2Mesh(i1), y2%BladeLn2Mesh(i1), tin, y_out%BladeLn2Mesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - CALL MeshExtrapInterp1(y1%PlatformPtMesh, y2%PlatformPtMesh, tin, y_out%PlatformPtMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(y1%TowerLn2Mesh, y2%TowerLn2Mesh, tin, y_out%TowerLn2Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(y1%HubPtMotion14, y2%HubPtMotion14, tin, y_out%HubPtMotion14, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(y1%HubPtMotion, y2%HubPtMotion, tin, y_out%HubPtMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(y1%BladeRootMotion14, y2%BladeRootMotion14, tin, y_out%BladeRootMotion14, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(y_out%BladeRootMotion) .AND. ALLOCATED(y1%BladeRootMotion)) THEN - DO i1 = LBOUND(y_out%BladeRootMotion,1),UBOUND(y_out%BladeRootMotion,1) - CALL MeshExtrapInterp1(y1%BladeRootMotion(i1), y2%BladeRootMotion(i1), tin, y_out%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - CALL MeshExtrapInterp1(y1%RotorFurlMotion14, y2%RotorFurlMotion14, tin, y_out%RotorFurlMotion14, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(y1%NacelleMotion, y2%NacelleMotion, tin, y_out%NacelleMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(y1%TowerBaseMotion14, y2%TowerBaseMotion14, tin, y_out%TowerBaseMotion14, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(y1%TFinCMMotion, y2%TFinCMMotion, tin, y_out%TFinCMMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%BlPitch) .AND. ALLOCATED(y1%BlPitch)) THEN - DO i1 = LBOUND(y_out%BlPitch,1),UBOUND(y_out%BlPitch,1) - CALL Angles_ExtrapInterp( y1%BlPitch(i1), y2%BlPitch(i1), tin, y_out%BlPitch(i1), tin_out ) - END DO -END IF ! check if allocated - CALL Angles_ExtrapInterp( y1%Yaw, y2%Yaw, tin, y_out%Yaw, tin_out ) - b = -(y1%YawRate - y2%YawRate) - y_out%YawRate = y1%YawRate + b * ScaleFactor - b = -(y1%LSS_Spd - y2%LSS_Spd) - y_out%LSS_Spd = y1%LSS_Spd + b * ScaleFactor - b = -(y1%HSS_Spd - y2%HSS_Spd) - y_out%HSS_Spd = y1%HSS_Spd + b * ScaleFactor - b = -(y1%RotSpeed - y2%RotSpeed) - y_out%RotSpeed = y1%RotSpeed + b * ScaleFactor - b = -(y1%TwrAccel - y2%TwrAccel) - y_out%TwrAccel = y1%TwrAccel + b * ScaleFactor - CALL Angles_ExtrapInterp( y1%YawAngle, y2%YawAngle, tin, y_out%YawAngle, tin_out ) - DO i1 = LBOUND(y_out%RootMyc,1),UBOUND(y_out%RootMyc,1) - b = -(y1%RootMyc(i1) - y2%RootMyc(i1)) - y_out%RootMyc(i1) = y1%RootMyc(i1) + b * ScaleFactor - END DO - b = -(y1%YawBrTAxp - y2%YawBrTAxp) - y_out%YawBrTAxp = y1%YawBrTAxp + b * ScaleFactor - b = -(y1%YawBrTAyp - y2%YawBrTAyp) - y_out%YawBrTAyp = y1%YawBrTAyp + b * ScaleFactor - CALL Angles_ExtrapInterp( y1%LSSTipPxa, y2%LSSTipPxa, tin, y_out%LSSTipPxa, tin_out ) - DO i1 = LBOUND(y_out%RootMxc,1),UBOUND(y_out%RootMxc,1) - b = -(y1%RootMxc(i1) - y2%RootMxc(i1)) - y_out%RootMxc(i1) = y1%RootMxc(i1) + b * ScaleFactor - END DO - b = -(y1%LSSTipMxa - y2%LSSTipMxa) - y_out%LSSTipMxa = y1%LSSTipMxa + b * ScaleFactor - b = -(y1%LSSTipMya - y2%LSSTipMya) - y_out%LSSTipMya = y1%LSSTipMya + b * ScaleFactor - b = -(y1%LSSTipMza - y2%LSSTipMza) - y_out%LSSTipMza = y1%LSSTipMza + b * ScaleFactor - b = -(y1%LSSTipMys - y2%LSSTipMys) - y_out%LSSTipMys = y1%LSSTipMys + b * ScaleFactor - b = -(y1%LSSTipMzs - y2%LSSTipMzs) - y_out%LSSTipMzs = y1%LSSTipMzs + b * ScaleFactor - b = -(y1%YawBrMyn - y2%YawBrMyn) - y_out%YawBrMyn = y1%YawBrMyn + b * ScaleFactor - b = -(y1%YawBrMzn - y2%YawBrMzn) - y_out%YawBrMzn = y1%YawBrMzn + b * ScaleFactor - b = -(y1%NcIMURAxs - y2%NcIMURAxs) - y_out%NcIMURAxs = y1%NcIMURAxs + b * ScaleFactor - b = -(y1%NcIMURAys - y2%NcIMURAys) - y_out%NcIMURAys = y1%NcIMURAys + b * ScaleFactor - b = -(y1%NcIMURAzs - y2%NcIMURAzs) - y_out%NcIMURAzs = y1%NcIMURAzs + b * ScaleFactor - b = -(y1%RotPwr - y2%RotPwr) - y_out%RotPwr = y1%RotPwr + b * ScaleFactor - b = -(y1%LSShftFxa - y2%LSShftFxa) - y_out%LSShftFxa = y1%LSShftFxa + b * ScaleFactor - b = -(y1%LSShftFys - y2%LSShftFys) - y_out%LSShftFys = y1%LSShftFys + b * ScaleFactor - b = -(y1%LSShftFzs - y2%LSShftFzs) - y_out%LSShftFzs = y1%LSShftFzs + b * ScaleFactor - END SUBROUTINE ED_Output_ExtrapInterp1 - - - SUBROUTINE ED_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE ED_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 2. @@ -11497,165 +11436,111 @@ SUBROUTINE ED_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - TYPE(ED_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(ED_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(ED_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(ED_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(ED_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(ED_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(ED_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(ED_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'ED_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'ED_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) -IF (ALLOCATED(y_out%BladeLn2Mesh) .AND. ALLOCATED(y1%BladeLn2Mesh)) THEN - DO i1 = LBOUND(y_out%BladeLn2Mesh,1),UBOUND(y_out%BladeLn2Mesh,1) - CALL MeshExtrapInterp2(y1%BladeLn2Mesh(i1), y2%BladeLn2Mesh(i1), y3%BladeLn2Mesh(i1), tin, y_out%BladeLn2Mesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - CALL MeshExtrapInterp2(y1%PlatformPtMesh, y2%PlatformPtMesh, y3%PlatformPtMesh, tin, y_out%PlatformPtMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(y1%TowerLn2Mesh, y2%TowerLn2Mesh, y3%TowerLn2Mesh, tin, y_out%TowerLn2Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(y1%HubPtMotion14, y2%HubPtMotion14, y3%HubPtMotion14, tin, y_out%HubPtMotion14, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(y1%HubPtMotion, y2%HubPtMotion, y3%HubPtMotion, tin, y_out%HubPtMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(y1%BladeRootMotion14, y2%BladeRootMotion14, y3%BladeRootMotion14, tin, y_out%BladeRootMotion14, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(y_out%BladeRootMotion) .AND. ALLOCATED(y1%BladeRootMotion)) THEN - DO i1 = LBOUND(y_out%BladeRootMotion,1),UBOUND(y_out%BladeRootMotion,1) - CALL MeshExtrapInterp2(y1%BladeRootMotion(i1), y2%BladeRootMotion(i1), y3%BladeRootMotion(i1), tin, y_out%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - CALL MeshExtrapInterp2(y1%RotorFurlMotion14, y2%RotorFurlMotion14, y3%RotorFurlMotion14, tin, y_out%RotorFurlMotion14, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(y1%NacelleMotion, y2%NacelleMotion, y3%NacelleMotion, tin, y_out%NacelleMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(y1%TowerBaseMotion14, y2%TowerBaseMotion14, y3%TowerBaseMotion14, tin, y_out%TowerBaseMotion14, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(y1%TFinCMMotion, y2%TFinCMMotion, y3%TFinCMMotion, tin, y_out%TFinCMMotion, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%BlPitch) .AND. ALLOCATED(y1%BlPitch)) THEN - DO i1 = LBOUND(y_out%BlPitch,1),UBOUND(y_out%BlPitch,1) - CALL Angles_ExtrapInterp( y1%BlPitch(i1), y2%BlPitch(i1), y3%BlPitch(i1), tin, y_out%BlPitch(i1), tin_out ) - END DO -END IF ! check if allocated - CALL Angles_ExtrapInterp( y1%Yaw, y2%Yaw, y3%Yaw, tin, y_out%Yaw, tin_out ) - b = (t(3)**2*(y1%YawRate - y2%YawRate) + t(2)**2*(-y1%YawRate + y3%YawRate))* scaleFactor - c = ( (t(2)-t(3))*y1%YawRate + t(3)*y2%YawRate - t(2)*y3%YawRate ) * scaleFactor - y_out%YawRate = y1%YawRate + b + c * t_out - b = (t(3)**2*(y1%LSS_Spd - y2%LSS_Spd) + t(2)**2*(-y1%LSS_Spd + y3%LSS_Spd))* scaleFactor - c = ( (t(2)-t(3))*y1%LSS_Spd + t(3)*y2%LSS_Spd - t(2)*y3%LSS_Spd ) * scaleFactor - y_out%LSS_Spd = y1%LSS_Spd + b + c * t_out - b = (t(3)**2*(y1%HSS_Spd - y2%HSS_Spd) + t(2)**2*(-y1%HSS_Spd + y3%HSS_Spd))* scaleFactor - c = ( (t(2)-t(3))*y1%HSS_Spd + t(3)*y2%HSS_Spd - t(2)*y3%HSS_Spd ) * scaleFactor - y_out%HSS_Spd = y1%HSS_Spd + b + c * t_out - b = (t(3)**2*(y1%RotSpeed - y2%RotSpeed) + t(2)**2*(-y1%RotSpeed + y3%RotSpeed))* scaleFactor - c = ( (t(2)-t(3))*y1%RotSpeed + t(3)*y2%RotSpeed - t(2)*y3%RotSpeed ) * scaleFactor - y_out%RotSpeed = y1%RotSpeed + b + c * t_out - b = (t(3)**2*(y1%TwrAccel - y2%TwrAccel) + t(2)**2*(-y1%TwrAccel + y3%TwrAccel))* scaleFactor - c = ( (t(2)-t(3))*y1%TwrAccel + t(3)*y2%TwrAccel - t(2)*y3%TwrAccel ) * scaleFactor - y_out%TwrAccel = y1%TwrAccel + b + c * t_out - CALL Angles_ExtrapInterp( y1%YawAngle, y2%YawAngle, y3%YawAngle, tin, y_out%YawAngle, tin_out ) - DO i1 = LBOUND(y_out%RootMyc,1),UBOUND(y_out%RootMyc,1) - b = (t(3)**2*(y1%RootMyc(i1) - y2%RootMyc(i1)) + t(2)**2*(-y1%RootMyc(i1) + y3%RootMyc(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%RootMyc(i1) + t(3)*y2%RootMyc(i1) - t(2)*y3%RootMyc(i1) ) * scaleFactor - y_out%RootMyc(i1) = y1%RootMyc(i1) + b + c * t_out - END DO - b = (t(3)**2*(y1%YawBrTAxp - y2%YawBrTAxp) + t(2)**2*(-y1%YawBrTAxp + y3%YawBrTAxp))* scaleFactor - c = ( (t(2)-t(3))*y1%YawBrTAxp + t(3)*y2%YawBrTAxp - t(2)*y3%YawBrTAxp ) * scaleFactor - y_out%YawBrTAxp = y1%YawBrTAxp + b + c * t_out - b = (t(3)**2*(y1%YawBrTAyp - y2%YawBrTAyp) + t(2)**2*(-y1%YawBrTAyp + y3%YawBrTAyp))* scaleFactor - c = ( (t(2)-t(3))*y1%YawBrTAyp + t(3)*y2%YawBrTAyp - t(2)*y3%YawBrTAyp ) * scaleFactor - y_out%YawBrTAyp = y1%YawBrTAyp + b + c * t_out - CALL Angles_ExtrapInterp( y1%LSSTipPxa, y2%LSSTipPxa, y3%LSSTipPxa, tin, y_out%LSSTipPxa, tin_out ) - DO i1 = LBOUND(y_out%RootMxc,1),UBOUND(y_out%RootMxc,1) - b = (t(3)**2*(y1%RootMxc(i1) - y2%RootMxc(i1)) + t(2)**2*(-y1%RootMxc(i1) + y3%RootMxc(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%RootMxc(i1) + t(3)*y2%RootMxc(i1) - t(2)*y3%RootMxc(i1) ) * scaleFactor - y_out%RootMxc(i1) = y1%RootMxc(i1) + b + c * t_out - END DO - b = (t(3)**2*(y1%LSSTipMxa - y2%LSSTipMxa) + t(2)**2*(-y1%LSSTipMxa + y3%LSSTipMxa))* scaleFactor - c = ( (t(2)-t(3))*y1%LSSTipMxa + t(3)*y2%LSSTipMxa - t(2)*y3%LSSTipMxa ) * scaleFactor - y_out%LSSTipMxa = y1%LSSTipMxa + b + c * t_out - b = (t(3)**2*(y1%LSSTipMya - y2%LSSTipMya) + t(2)**2*(-y1%LSSTipMya + y3%LSSTipMya))* scaleFactor - c = ( (t(2)-t(3))*y1%LSSTipMya + t(3)*y2%LSSTipMya - t(2)*y3%LSSTipMya ) * scaleFactor - y_out%LSSTipMya = y1%LSSTipMya + b + c * t_out - b = (t(3)**2*(y1%LSSTipMza - y2%LSSTipMza) + t(2)**2*(-y1%LSSTipMza + y3%LSSTipMza))* scaleFactor - c = ( (t(2)-t(3))*y1%LSSTipMza + t(3)*y2%LSSTipMza - t(2)*y3%LSSTipMza ) * scaleFactor - y_out%LSSTipMza = y1%LSSTipMza + b + c * t_out - b = (t(3)**2*(y1%LSSTipMys - y2%LSSTipMys) + t(2)**2*(-y1%LSSTipMys + y3%LSSTipMys))* scaleFactor - c = ( (t(2)-t(3))*y1%LSSTipMys + t(3)*y2%LSSTipMys - t(2)*y3%LSSTipMys ) * scaleFactor - y_out%LSSTipMys = y1%LSSTipMys + b + c * t_out - b = (t(3)**2*(y1%LSSTipMzs - y2%LSSTipMzs) + t(2)**2*(-y1%LSSTipMzs + y3%LSSTipMzs))* scaleFactor - c = ( (t(2)-t(3))*y1%LSSTipMzs + t(3)*y2%LSSTipMzs - t(2)*y3%LSSTipMzs ) * scaleFactor - y_out%LSSTipMzs = y1%LSSTipMzs + b + c * t_out - b = (t(3)**2*(y1%YawBrMyn - y2%YawBrMyn) + t(2)**2*(-y1%YawBrMyn + y3%YawBrMyn))* scaleFactor - c = ( (t(2)-t(3))*y1%YawBrMyn + t(3)*y2%YawBrMyn - t(2)*y3%YawBrMyn ) * scaleFactor - y_out%YawBrMyn = y1%YawBrMyn + b + c * t_out - b = (t(3)**2*(y1%YawBrMzn - y2%YawBrMzn) + t(2)**2*(-y1%YawBrMzn + y3%YawBrMzn))* scaleFactor - c = ( (t(2)-t(3))*y1%YawBrMzn + t(3)*y2%YawBrMzn - t(2)*y3%YawBrMzn ) * scaleFactor - y_out%YawBrMzn = y1%YawBrMzn + b + c * t_out - b = (t(3)**2*(y1%NcIMURAxs - y2%NcIMURAxs) + t(2)**2*(-y1%NcIMURAxs + y3%NcIMURAxs))* scaleFactor - c = ( (t(2)-t(3))*y1%NcIMURAxs + t(3)*y2%NcIMURAxs - t(2)*y3%NcIMURAxs ) * scaleFactor - y_out%NcIMURAxs = y1%NcIMURAxs + b + c * t_out - b = (t(3)**2*(y1%NcIMURAys - y2%NcIMURAys) + t(2)**2*(-y1%NcIMURAys + y3%NcIMURAys))* scaleFactor - c = ( (t(2)-t(3))*y1%NcIMURAys + t(3)*y2%NcIMURAys - t(2)*y3%NcIMURAys ) * scaleFactor - y_out%NcIMURAys = y1%NcIMURAys + b + c * t_out - b = (t(3)**2*(y1%NcIMURAzs - y2%NcIMURAzs) + t(2)**2*(-y1%NcIMURAzs + y3%NcIMURAzs))* scaleFactor - c = ( (t(2)-t(3))*y1%NcIMURAzs + t(3)*y2%NcIMURAzs - t(2)*y3%NcIMURAzs ) * scaleFactor - y_out%NcIMURAzs = y1%NcIMURAzs + b + c * t_out - b = (t(3)**2*(y1%RotPwr - y2%RotPwr) + t(2)**2*(-y1%RotPwr + y3%RotPwr))* scaleFactor - c = ( (t(2)-t(3))*y1%RotPwr + t(3)*y2%RotPwr - t(2)*y3%RotPwr ) * scaleFactor - y_out%RotPwr = y1%RotPwr + b + c * t_out - b = (t(3)**2*(y1%LSShftFxa - y2%LSShftFxa) + t(2)**2*(-y1%LSShftFxa + y3%LSShftFxa))* scaleFactor - c = ( (t(2)-t(3))*y1%LSShftFxa + t(3)*y2%LSShftFxa - t(2)*y3%LSShftFxa ) * scaleFactor - y_out%LSShftFxa = y1%LSShftFxa + b + c * t_out - b = (t(3)**2*(y1%LSShftFys - y2%LSShftFys) + t(2)**2*(-y1%LSShftFys + y3%LSShftFys))* scaleFactor - c = ( (t(2)-t(3))*y1%LSShftFys + t(3)*y2%LSShftFys - t(2)*y3%LSShftFys ) * scaleFactor - y_out%LSShftFys = y1%LSShftFys + b + c * t_out - b = (t(3)**2*(y1%LSShftFzs - y2%LSShftFzs) + t(2)**2*(-y1%LSShftFzs + y3%LSShftFzs))* scaleFactor - c = ( (t(2)-t(3))*y1%LSShftFzs + t(3)*y2%LSShftFzs - t(2)*y3%LSShftFzs ) * scaleFactor - y_out%LSShftFzs = y1%LSShftFzs + b + c * t_out - END SUBROUTINE ED_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%BladeLn2Mesh) .AND. ALLOCATED(y1%BladeLn2Mesh)) THEN + DO i1 = LBOUND(y_out%BladeLn2Mesh,1),UBOUND(y_out%BladeLn2Mesh,1) + CALL MeshExtrapInterp2(y1%BladeLn2Mesh(i1), y2%BladeLn2Mesh(i1), y3%BladeLn2Mesh(i1), tin, y_out%BladeLn2Mesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + CALL MeshExtrapInterp2(y1%PlatformPtMesh, y2%PlatformPtMesh, y3%PlatformPtMesh, tin, y_out%PlatformPtMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(y1%TowerLn2Mesh, y2%TowerLn2Mesh, y3%TowerLn2Mesh, tin, y_out%TowerLn2Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(y1%HubPtMotion14, y2%HubPtMotion14, y3%HubPtMotion14, tin, y_out%HubPtMotion14, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(y1%HubPtMotion, y2%HubPtMotion, y3%HubPtMotion, tin, y_out%HubPtMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(y1%BladeRootMotion14, y2%BladeRootMotion14, y3%BladeRootMotion14, tin, y_out%BladeRootMotion14, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%BladeRootMotion) .AND. ALLOCATED(y1%BladeRootMotion)) THEN + DO i1 = LBOUND(y_out%BladeRootMotion,1),UBOUND(y_out%BladeRootMotion,1) + CALL MeshExtrapInterp2(y1%BladeRootMotion(i1), y2%BladeRootMotion(i1), y3%BladeRootMotion(i1), tin, y_out%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + CALL MeshExtrapInterp2(y1%RotorFurlMotion14, y2%RotorFurlMotion14, y3%RotorFurlMotion14, tin, y_out%RotorFurlMotion14, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(y1%NacelleMotion, y2%NacelleMotion, y3%NacelleMotion, tin, y_out%NacelleMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(y1%TowerBaseMotion14, y2%TowerBaseMotion14, y3%TowerBaseMotion14, tin, y_out%TowerBaseMotion14, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(y1%TFinCMMotion, y2%TFinCMMotion, y3%TFinCMMotion, tin, y_out%TFinCMMotion, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated + IF (ALLOCATED(y_out%BlPitch) .AND. ALLOCATED(y1%BlPitch)) THEN + DO i1 = LBOUND(y_out%BlPitch,1),UBOUND(y_out%BlPitch,1) + CALL Angles_ExtrapInterp( y1%BlPitch(i1), y2%BlPitch(i1), y3%BlPitch(i1), tin, y_out%BlPitch(i1), tin_out ) + END DO + END IF ! check if allocated + CALL Angles_ExtrapInterp( y1%Yaw, y2%Yaw, y3%Yaw, tin, y_out%Yaw, tin_out ) + y_out%YawRate = a1*y1%YawRate + a2*y2%YawRate + a3*y3%YawRate + y_out%LSS_Spd = a1*y1%LSS_Spd + a2*y2%LSS_Spd + a3*y3%LSS_Spd + y_out%HSS_Spd = a1*y1%HSS_Spd + a2*y2%HSS_Spd + a3*y3%HSS_Spd + y_out%RotSpeed = a1*y1%RotSpeed + a2*y2%RotSpeed + a3*y3%RotSpeed + y_out%TwrAccel = a1*y1%TwrAccel + a2*y2%TwrAccel + a3*y3%TwrAccel + CALL Angles_ExtrapInterp( y1%YawAngle, y2%YawAngle, y3%YawAngle, tin, y_out%YawAngle, tin_out ) + y_out%RootMyc = a1*y1%RootMyc + a2*y2%RootMyc + a3*y3%RootMyc + y_out%YawBrTAxp = a1*y1%YawBrTAxp + a2*y2%YawBrTAxp + a3*y3%YawBrTAxp + y_out%YawBrTAyp = a1*y1%YawBrTAyp + a2*y2%YawBrTAyp + a3*y3%YawBrTAyp + CALL Angles_ExtrapInterp( y1%LSSTipPxa, y2%LSSTipPxa, y3%LSSTipPxa, tin, y_out%LSSTipPxa, tin_out ) + y_out%RootMxc = a1*y1%RootMxc + a2*y2%RootMxc + a3*y3%RootMxc + y_out%LSSTipMxa = a1*y1%LSSTipMxa + a2*y2%LSSTipMxa + a3*y3%LSSTipMxa + y_out%LSSTipMya = a1*y1%LSSTipMya + a2*y2%LSSTipMya + a3*y3%LSSTipMya + y_out%LSSTipMza = a1*y1%LSSTipMza + a2*y2%LSSTipMza + a3*y3%LSSTipMza + y_out%LSSTipMys = a1*y1%LSSTipMys + a2*y2%LSSTipMys + a3*y3%LSSTipMys + y_out%LSSTipMzs = a1*y1%LSSTipMzs + a2*y2%LSSTipMzs + a3*y3%LSSTipMzs + y_out%YawBrMyn = a1*y1%YawBrMyn + a2*y2%YawBrMyn + a3*y3%YawBrMyn + y_out%YawBrMzn = a1*y1%YawBrMzn + a2*y2%YawBrMzn + a3*y3%YawBrMzn + y_out%NcIMURAxs = a1*y1%NcIMURAxs + a2*y2%NcIMURAxs + a3*y3%NcIMURAxs + y_out%NcIMURAys = a1*y1%NcIMURAys + a2*y2%NcIMURAys + a3*y3%NcIMURAys + y_out%NcIMURAzs = a1*y1%NcIMURAzs + a2*y2%NcIMURAzs + a3*y3%NcIMURAzs + y_out%RotPwr = a1*y1%RotPwr + a2*y2%RotPwr + a3*y3%RotPwr + y_out%LSShftFxa = a1*y1%LSShftFxa + a2*y2%LSShftFxa + a3*y3%LSShftFxa + y_out%LSShftFys = a1*y1%LSShftFys + a2*y2%LSShftFys + a3*y3%LSShftFys + y_out%LSShftFzs = a1*y1%LSShftFzs + a2*y2%LSShftFzs + a3*y3%LSShftFzs +END SUBROUTINE END MODULE ElastoDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 index 6d0b87f639..ce08cab5c0 100644 --- a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 +++ b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 @@ -2301,58 +2301,59 @@ subroutine ExtPtfm_UnPackOutput(Buf, OutData) end if end subroutine - SUBROUTINE ExtPtfm_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(ExtPtfm_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(ExtPtfm_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None +subroutine ExtPtfm_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time + ! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(ExtPtfm_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(ExtPtfm_InputType), intent(inout) :: u_out ! Input at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_Input_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(u)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(u) - 1 - IF ( order .eq. 0 ) THEN - CALL ExtPtfm_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL ExtPtfm_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL ExtPtfm_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE ExtPtfm_Input_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'ExtPtfm_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call ExtPtfm_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call ExtPtfm_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call ExtPtfm_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE ExtPtfm_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE ExtPtfm_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 1. @@ -2364,41 +2365,42 @@ SUBROUTINE ExtPtfm_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - TYPE(ExtPtfm_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(ExtPtfm_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(ExtPtfm_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(ExtPtfm_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(ExtPtfm_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(ExtPtfm_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_Input_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF - - ScaleFactor = t_out / t(2) - CALL MeshExtrapInterp1(u1%PtfmMesh, u2%PtfmMesh, tin, u_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE ExtPtfm_Input_ExtrapInterp1 - - - SUBROUTINE ExtPtfm_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(u1%PtfmMesh, u2%PtfmMesh, tin, u_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +SUBROUTINE ExtPtfm_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 2. @@ -2412,101 +2414,102 @@ SUBROUTINE ExtPtfm_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ! !.................................................................................................................................. - TYPE(ExtPtfm_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(ExtPtfm_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(ExtPtfm_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(ExtPtfm_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(ExtPtfm_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(ExtPtfm_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(ExtPtfm_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(ExtPtfm_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_Input_ExtrapInterp2' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_Input_ExtrapInterp2' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) - CALL MeshExtrapInterp2(u1%PtfmMesh, u2%PtfmMesh, u3%PtfmMesh, tin, u_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE ExtPtfm_Input_ExtrapInterp2 - - - SUBROUTINE ExtPtfm_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(u1%PtfmMesh, u2%PtfmMesh, u3%PtfmMesh, tin, u_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +subroutine ExtPtfm_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time + ! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(ExtPtfm_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(ExtPtfm_OutputType), intent(inout) :: y_out ! Output at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_Output_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(y)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(y) - 1 - IF ( order .eq. 0 ) THEN - CALL ExtPtfm_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL ExtPtfm_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL ExtPtfm_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE ExtPtfm_Output_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'ExtPtfm_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call ExtPtfm_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call ExtPtfm_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call ExtPtfm_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE ExtPtfm_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE ExtPtfm_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 1. @@ -2518,49 +2521,47 @@ SUBROUTINE ExtPtfm_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_Output_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF - - ScaleFactor = t_out / t(2) - CALL MeshExtrapInterp1(y1%PtfmMesh, y2%PtfmMesh, tin, y_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE ExtPtfm_Output_ExtrapInterp1 - - - SUBROUTINE ExtPtfm_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(y1%PtfmMesh, y2%PtfmMesh, tin, y_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE ExtPtfm_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 2. @@ -2574,56 +2575,52 @@ SUBROUTINE ExtPtfm_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat ! !.................................................................................................................................. - TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(ExtPtfm_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) - CALL MeshExtrapInterp2(y1%PtfmMesh, y2%PtfmMesh, y3%PtfmMesh, tin, y_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE ExtPtfm_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(y1%PtfmMesh, y2%PtfmMesh, y3%PtfmMesh, tin, y_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated +END SUBROUTINE END MODULE ExtPtfm_MCKF_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/feamooring/src/FEAMooring_Types.f90 b/modules/feamooring/src/FEAMooring_Types.f90 index 552432455d..29b7bba7dd 100644 --- a/modules/feamooring/src/FEAMooring_Types.f90 +++ b/modules/feamooring/src/FEAMooring_Types.f90 @@ -3263,58 +3263,59 @@ subroutine FEAM_UnPackOutput(Buf, OutData) call MeshUnpack(Buf, OutData%LineMeshPosition) ! LineMeshPosition end subroutine - SUBROUTINE FEAM_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(FEAM_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(FEAM_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None +subroutine FEAM_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time + ! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(FEAM_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(FEAM_InputType), intent(inout) :: u_out ! Input at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_Input_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(u)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(u) - 1 - IF ( order .eq. 0 ) THEN - CALL FEAM_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL FEAM_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL FEAM_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE FEAM_Input_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'FEAM_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call FEAM_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call FEAM_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call FEAM_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE FEAM_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE FEAM_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 1. @@ -3326,43 +3327,44 @@ SUBROUTINE FEAM_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(FEAM_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(FEAM_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(FEAM_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(FEAM_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(FEAM_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(FEAM_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_Input_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF - - ScaleFactor = t_out / t(2) - CALL MeshExtrapInterp1(u1%HydroForceLineMesh, u2%HydroForceLineMesh, tin, u_out%HydroForceLineMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(u1%PtFairleadDisplacement, u2%PtFairleadDisplacement, tin, u_out%PtFairleadDisplacement, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE FEAM_Input_ExtrapInterp1 - - - SUBROUTINE FEAM_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(u1%HydroForceLineMesh, u2%HydroForceLineMesh, tin, u_out%HydroForceLineMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(u1%PtFairleadDisplacement, u2%PtFairleadDisplacement, tin, u_out%PtFairleadDisplacement, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +SUBROUTINE FEAM_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 2. @@ -3376,103 +3378,104 @@ SUBROUTINE FEAM_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - TYPE(FEAM_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(FEAM_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(FEAM_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(FEAM_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(FEAM_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(FEAM_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(FEAM_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(FEAM_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_Input_ExtrapInterp2' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_Input_ExtrapInterp2' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) - CALL MeshExtrapInterp2(u1%HydroForceLineMesh, u2%HydroForceLineMesh, u3%HydroForceLineMesh, tin, u_out%HydroForceLineMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(u1%PtFairleadDisplacement, u2%PtFairleadDisplacement, u3%PtFairleadDisplacement, tin, u_out%PtFairleadDisplacement, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE FEAM_Input_ExtrapInterp2 - - - SUBROUTINE FEAM_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(FEAM_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(FEAM_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(u1%HydroForceLineMesh, u2%HydroForceLineMesh, u3%HydroForceLineMesh, tin, u_out%HydroForceLineMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(u1%PtFairleadDisplacement, u2%PtFairleadDisplacement, u3%PtFairleadDisplacement, tin, u_out%PtFairleadDisplacement, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +subroutine FEAM_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time + ! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(FEAM_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(FEAM_OutputType), intent(inout) :: y_out ! Output at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_Output_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(y)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(y) - 1 - IF ( order .eq. 0 ) THEN - CALL FEAM_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL FEAM_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL FEAM_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE FEAM_Output_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'FEAM_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call FEAM_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call FEAM_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call FEAM_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE FEAM_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE FEAM_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 1. @@ -3484,51 +3487,49 @@ SUBROUTINE FEAM_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs ! !.................................................................................................................................. - TYPE(FEAM_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(FEAM_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(FEAM_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(FEAM_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(FEAM_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(FEAM_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_Output_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF - - ScaleFactor = t_out / t(2) -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - CALL MeshExtrapInterp1(y1%PtFairleadLoad, y2%PtFairleadLoad, tin, y_out%PtFairleadLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(y1%LineMeshPosition, y2%LineMeshPosition, tin, y_out%LineMeshPosition, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE FEAM_Output_ExtrapInterp1 - - - SUBROUTINE FEAM_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated + CALL MeshExtrapInterp1(y1%PtFairleadLoad, y2%PtFairleadLoad, tin, y_out%PtFairleadLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(y1%LineMeshPosition, y2%LineMeshPosition, tin, y_out%LineMeshPosition, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +SUBROUTINE FEAM_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 2. @@ -3542,58 +3543,54 @@ SUBROUTINE FEAM_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E ! !.................................................................................................................................. - TYPE(FEAM_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(FEAM_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(FEAM_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(FEAM_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(FEAM_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(FEAM_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(FEAM_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(FEAM_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out - END DO -END IF ! check if allocated - CALL MeshExtrapInterp2(y1%PtFairleadLoad, y2%PtFairleadLoad, y3%PtFairleadLoad, tin, y_out%PtFairleadLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(y1%LineMeshPosition, y2%LineMeshPosition, y3%LineMeshPosition, tin, y_out%LineMeshPosition, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE FEAM_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated + CALL MeshExtrapInterp2(y1%PtFairleadLoad, y2%PtFairleadLoad, y3%PtFairleadLoad, tin, y_out%PtFairleadLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(y1%LineMeshPosition, y2%LineMeshPosition, y3%LineMeshPosition, tin, y_out%LineMeshPosition, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE END MODULE FEAMooring_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/Conv_Radiation_Types.f90 b/modules/hydrodyn/src/Conv_Radiation_Types.f90 index 3b7e8f9563..fe84e573c5 100644 --- a/modules/hydrodyn/src/Conv_Radiation_Types.f90 +++ b/modules/hydrodyn/src/Conv_Radiation_Types.f90 @@ -785,58 +785,59 @@ subroutine Conv_Rdtn_UnPackOutput(Buf, OutData) end if end subroutine - SUBROUTINE Conv_Rdtn_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(Conv_Rdtn_InputType), INTENT(IN) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(Conv_Rdtn_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None +subroutine Conv_Rdtn_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time + ! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(Conv_Rdtn_InputType), intent(in) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(Conv_Rdtn_InputType), intent(inout) :: u_out ! Input at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_Input_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(u)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(u) - 1 - IF ( order .eq. 0 ) THEN - CALL Conv_Rdtn_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL Conv_Rdtn_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL Conv_Rdtn_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE Conv_Rdtn_Input_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'Conv_Rdtn_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call Conv_Rdtn_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call Conv_Rdtn_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call Conv_Rdtn_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE Conv_Rdtn_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE Conv_Rdtn_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 1. @@ -848,47 +849,45 @@ SUBROUTINE Conv_Rdtn_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, E ! !.................................................................................................................................. - TYPE(Conv_Rdtn_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 - TYPE(Conv_Rdtn_InputType), INTENT(IN) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(Conv_Rdtn_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(Conv_Rdtn_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 + TYPE(Conv_Rdtn_InputType), INTENT(IN) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(Conv_Rdtn_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_Input_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF - - ScaleFactor = t_out / t(2) -IF (ALLOCATED(u_out%Velocity) .AND. ALLOCATED(u1%Velocity)) THEN - DO i1 = LBOUND(u_out%Velocity,1),UBOUND(u_out%Velocity,1) - b = -(u1%Velocity(i1) - u2%Velocity(i1)) - u_out%Velocity(i1) = u1%Velocity(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE Conv_Rdtn_Input_ExtrapInterp1 - - - SUBROUTINE Conv_Rdtn_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(u_out%Velocity) .AND. ALLOCATED(u1%Velocity)) THEN + u_out%Velocity = a1*u1%Velocity + a2*u2%Velocity + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE Conv_Rdtn_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 2. @@ -902,108 +901,105 @@ SUBROUTINE Conv_Rdtn_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrSta ! !.................................................................................................................................. - TYPE(Conv_Rdtn_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 - TYPE(Conv_Rdtn_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 - TYPE(Conv_Rdtn_InputType), INTENT(IN) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(Conv_Rdtn_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(Conv_Rdtn_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 + TYPE(Conv_Rdtn_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 + TYPE(Conv_Rdtn_InputType), INTENT(IN) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(Conv_Rdtn_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_Input_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) -IF (ALLOCATED(u_out%Velocity) .AND. ALLOCATED(u1%Velocity)) THEN - DO i1 = LBOUND(u_out%Velocity,1),UBOUND(u_out%Velocity,1) - b = (t(3)**2*(u1%Velocity(i1) - u2%Velocity(i1)) + t(2)**2*(-u1%Velocity(i1) + u3%Velocity(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%Velocity(i1) + t(3)*u2%Velocity(i1) - t(2)*u3%Velocity(i1) ) * scaleFactor - u_out%Velocity(i1) = u1%Velocity(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE Conv_Rdtn_Input_ExtrapInterp2 - - - SUBROUTINE Conv_Rdtn_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(Conv_Rdtn_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(Conv_Rdtn_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(u_out%Velocity) .AND. ALLOCATED(u1%Velocity)) THEN + u_out%Velocity = a1*u1%Velocity + a2*u2%Velocity + a3*u3%Velocity + END IF ! check if allocated +END SUBROUTINE + +subroutine Conv_Rdtn_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time + ! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(Conv_Rdtn_OutputType), intent(in) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(Conv_Rdtn_OutputType), intent(inout) :: y_out ! Output at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_Output_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(y)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(y) - 1 - IF ( order .eq. 0 ) THEN - CALL Conv_Rdtn_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL Conv_Rdtn_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL Conv_Rdtn_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE Conv_Rdtn_Output_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'Conv_Rdtn_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call Conv_Rdtn_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call Conv_Rdtn_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call Conv_Rdtn_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE Conv_Rdtn_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE Conv_Rdtn_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 1. @@ -1015,47 +1011,45 @@ SUBROUTINE Conv_Rdtn_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ! !.................................................................................................................................. - TYPE(Conv_Rdtn_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 - TYPE(Conv_Rdtn_OutputType), INTENT(IN) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(Conv_Rdtn_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(Conv_Rdtn_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 + TYPE(Conv_Rdtn_OutputType), INTENT(IN) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(Conv_Rdtn_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_Output_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF - - ScaleFactor = t_out / t(2) -IF (ALLOCATED(y_out%F_Rdtn) .AND. ALLOCATED(y1%F_Rdtn)) THEN - DO i1 = LBOUND(y_out%F_Rdtn,1),UBOUND(y_out%F_Rdtn,1) - b = -(y1%F_Rdtn(i1) - y2%F_Rdtn(i1)) - y_out%F_Rdtn(i1) = y1%F_Rdtn(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE Conv_Rdtn_Output_ExtrapInterp1 - - - SUBROUTINE Conv_Rdtn_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%F_Rdtn) .AND. ALLOCATED(y1%F_Rdtn)) THEN + y_out%F_Rdtn = a1*y1%F_Rdtn + a2*y2%F_Rdtn + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE Conv_Rdtn_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 2. @@ -1069,54 +1063,50 @@ SUBROUTINE Conv_Rdtn_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrSt ! !.................................................................................................................................. - TYPE(Conv_Rdtn_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 - TYPE(Conv_Rdtn_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 - TYPE(Conv_Rdtn_OutputType), INTENT(IN) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(Conv_Rdtn_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(Conv_Rdtn_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 + TYPE(Conv_Rdtn_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 + TYPE(Conv_Rdtn_OutputType), INTENT(IN) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(Conv_Rdtn_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) -IF (ALLOCATED(y_out%F_Rdtn) .AND. ALLOCATED(y1%F_Rdtn)) THEN - DO i1 = LBOUND(y_out%F_Rdtn,1),UBOUND(y_out%F_Rdtn,1) - b = (t(3)**2*(y1%F_Rdtn(i1) - y2%F_Rdtn(i1)) + t(2)**2*(-y1%F_Rdtn(i1) + y3%F_Rdtn(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%F_Rdtn(i1) + t(3)*y2%F_Rdtn(i1) - t(2)*y3%F_Rdtn(i1) ) * scaleFactor - y_out%F_Rdtn(i1) = y1%F_Rdtn(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE Conv_Rdtn_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%F_Rdtn) .AND. ALLOCATED(y1%F_Rdtn)) THEN + y_out%F_Rdtn = a1*y1%F_Rdtn + a2*y2%F_Rdtn + a3*y3%F_Rdtn + END IF ! check if allocated +END SUBROUTINE END MODULE Conv_Radiation_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index 65dd750d3f..e70472aac7 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -2995,58 +2995,59 @@ subroutine HydroDyn_UnPackOutput(Buf, OutData) end if end subroutine - SUBROUTINE HydroDyn_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(HydroDyn_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(HydroDyn_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None +subroutine HydroDyn_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time + ! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(HydroDyn_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(HydroDyn_InputType), intent(inout) :: u_out ! Input at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_Input_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(u)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(u) - 1 - IF ( order .eq. 0 ) THEN - CALL HydroDyn_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL HydroDyn_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL HydroDyn_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE HydroDyn_Input_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'HydroDyn_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call HydroDyn_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call HydroDyn_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call HydroDyn_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE HydroDyn_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE HydroDyn_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 1. @@ -3058,45 +3059,46 @@ SUBROUTINE HydroDyn_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - TYPE(HydroDyn_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(HydroDyn_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(HydroDyn_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(HydroDyn_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(HydroDyn_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(HydroDyn_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_Input_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF - - ScaleFactor = t_out / t(2) - CALL Morison_Input_ExtrapInterp1( u1%Morison, u2%Morison, tin, u_out%Morison, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(u1%WAMITMesh, u2%WAMITMesh, tin, u_out%WAMITMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(u1%PRPMesh, u2%PRPMesh, tin, u_out%PRPMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE HydroDyn_Input_ExtrapInterp1 - - - SUBROUTINE HydroDyn_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL Morison_Input_ExtrapInterp1( u1%Morison, u2%Morison, tin, u_out%Morison, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(u1%WAMITMesh, u2%WAMITMesh, tin, u_out%WAMITMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(u1%PRPMesh, u2%PRPMesh, tin, u_out%PRPMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +SUBROUTINE HydroDyn_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 2. @@ -3110,105 +3112,106 @@ SUBROUTINE HydroDyn_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat ! !.................................................................................................................................. - TYPE(HydroDyn_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(HydroDyn_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(HydroDyn_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(HydroDyn_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(HydroDyn_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(HydroDyn_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(HydroDyn_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(HydroDyn_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_Input_ExtrapInterp2' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_Input_ExtrapInterp2' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) - CALL Morison_Input_ExtrapInterp2( u1%Morison, u2%Morison, u3%Morison, tin, u_out%Morison, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(u1%WAMITMesh, u2%WAMITMesh, u3%WAMITMesh, tin, u_out%WAMITMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(u1%PRPMesh, u2%PRPMesh, u3%PRPMesh, tin, u_out%PRPMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE HydroDyn_Input_ExtrapInterp2 - - - SUBROUTINE HydroDyn_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL Morison_Input_ExtrapInterp2( u1%Morison, u2%Morison, u3%Morison, tin, u_out%Morison, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(u1%WAMITMesh, u2%WAMITMesh, u3%WAMITMesh, tin, u_out%WAMITMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(u1%PRPMesh, u2%PRPMesh, u3%PRPMesh, tin, u_out%PRPMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +subroutine HydroDyn_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time + ! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(HydroDyn_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(HydroDyn_OutputType), intent(inout) :: y_out ! Output at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_Output_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(y)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(y) - 1 - IF ( order .eq. 0 ) THEN - CALL HydroDyn_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL HydroDyn_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL HydroDyn_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE HydroDyn_Output_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'HydroDyn_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call HydroDyn_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call HydroDyn_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call HydroDyn_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE HydroDyn_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE HydroDyn_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 1. @@ -3220,63 +3223,61 @@ SUBROUTINE HydroDyn_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, E ! !.................................................................................................................................. - TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_Output_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF - - ScaleFactor = t_out / t(2) -IF (ALLOCATED(y_out%WAMIT) .AND. ALLOCATED(y1%WAMIT)) THEN - DO i1 = LBOUND(y_out%WAMIT,1),UBOUND(y_out%WAMIT,1) - CALL WAMIT_Output_ExtrapInterp1( y1%WAMIT(i1), y2%WAMIT(i1), tin, y_out%WAMIT(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%WAMIT2) .AND. ALLOCATED(y1%WAMIT2)) THEN - DO i1 = LBOUND(y_out%WAMIT2,1),UBOUND(y_out%WAMIT2,1) - CALL WAMIT2_Output_ExtrapInterp1( y1%WAMIT2(i1), y2%WAMIT2(i1), tin, y_out%WAMIT2(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - CALL Morison_Output_ExtrapInterp1( y1%Morison, y2%Morison, tin, y_out%Morison, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(y1%WAMITMesh, y2%WAMITMesh, tin, y_out%WAMITMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE HydroDyn_Output_ExtrapInterp1 - - - SUBROUTINE HydroDyn_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%WAMIT) .AND. ALLOCATED(y1%WAMIT)) THEN + DO i1 = LBOUND(y_out%WAMIT,1),UBOUND(y_out%WAMIT,1) + CALL WAMIT_Output_ExtrapInterp1( y1%WAMIT(i1), y2%WAMIT(i1), tin, y_out%WAMIT(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%WAMIT2) .AND. ALLOCATED(y1%WAMIT2)) THEN + DO i1 = LBOUND(y_out%WAMIT2,1),UBOUND(y_out%WAMIT2,1) + CALL WAMIT2_Output_ExtrapInterp1( y1%WAMIT2(i1), y2%WAMIT2(i1), tin, y_out%WAMIT2(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + CALL Morison_Output_ExtrapInterp1( y1%Morison, y2%Morison, tin, y_out%Morison, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(y1%WAMITMesh, y2%WAMITMesh, tin, y_out%WAMITMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE HydroDyn_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 2. @@ -3290,70 +3291,66 @@ SUBROUTINE HydroDyn_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrSta ! !.................................................................................................................................. - TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(HydroDyn_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) -IF (ALLOCATED(y_out%WAMIT) .AND. ALLOCATED(y1%WAMIT)) THEN - DO i1 = LBOUND(y_out%WAMIT,1),UBOUND(y_out%WAMIT,1) - CALL WAMIT_Output_ExtrapInterp2( y1%WAMIT(i1), y2%WAMIT(i1), y3%WAMIT(i1), tin, y_out%WAMIT(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%WAMIT2) .AND. ALLOCATED(y1%WAMIT2)) THEN - DO i1 = LBOUND(y_out%WAMIT2,1),UBOUND(y_out%WAMIT2,1) - CALL WAMIT2_Output_ExtrapInterp2( y1%WAMIT2(i1), y2%WAMIT2(i1), y3%WAMIT2(i1), tin, y_out%WAMIT2(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated - CALL Morison_Output_ExtrapInterp2( y1%Morison, y2%Morison, y3%Morison, tin, y_out%Morison, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(y1%WAMITMesh, y2%WAMITMesh, y3%WAMITMesh, tin, y_out%WAMITMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE HydroDyn_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%WAMIT) .AND. ALLOCATED(y1%WAMIT)) THEN + DO i1 = LBOUND(y_out%WAMIT,1),UBOUND(y_out%WAMIT,1) + CALL WAMIT_Output_ExtrapInterp2( y1%WAMIT(i1), y2%WAMIT(i1), y3%WAMIT(i1), tin, y_out%WAMIT(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%WAMIT2) .AND. ALLOCATED(y1%WAMIT2)) THEN + DO i1 = LBOUND(y_out%WAMIT2,1),UBOUND(y_out%WAMIT2,1) + CALL WAMIT2_Output_ExtrapInterp2( y1%WAMIT2(i1), y2%WAMIT2(i1), y3%WAMIT2(i1), tin, y_out%WAMIT2(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + CALL Morison_Output_ExtrapInterp2( y1%Morison, y2%Morison, y3%Morison, tin, y_out%Morison, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(y1%WAMITMesh, y2%WAMITMesh, y3%WAMITMesh, tin, y_out%WAMITMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated +END SUBROUTINE END MODULE HydroDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/Morison_Types.f90 b/modules/hydrodyn/src/Morison_Types.f90 index 8d473c6641..e5e8242fdf 100644 --- a/modules/hydrodyn/src/Morison_Types.f90 +++ b/modules/hydrodyn/src/Morison_Types.f90 @@ -6145,58 +6145,59 @@ subroutine Morison_UnPackOutput(Buf, OutData) end if end subroutine - SUBROUTINE Morison_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(Morison_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(Morison_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None +subroutine Morison_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time + ! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(Morison_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(Morison_InputType), intent(inout) :: u_out ! Input at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_Input_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(u)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(u) - 1 - IF ( order .eq. 0 ) THEN - CALL Morison_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL Morison_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL Morison_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE Morison_Input_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'Morison_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call Morison_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call Morison_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call Morison_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE Morison_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE Morison_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 1. @@ -6208,41 +6209,42 @@ SUBROUTINE Morison_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - TYPE(Morison_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(Morison_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(Morison_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(Morison_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(Morison_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(Morison_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_Input_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'Morison_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(u1%Mesh, u2%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE - ScaleFactor = t_out / t(2) - CALL MeshExtrapInterp1(u1%Mesh, u2%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE Morison_Input_ExtrapInterp1 - - - SUBROUTINE Morison_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE Morison_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 2. @@ -6256,101 +6258,102 @@ SUBROUTINE Morison_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ! !.................................................................................................................................. - TYPE(Morison_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(Morison_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(Morison_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(Morison_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(Morison_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(Morison_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(Morison_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(Morison_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_Input_ExtrapInterp2' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'Morison_Input_ExtrapInterp2' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(u1%Mesh, u2%Mesh, u3%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) - CALL MeshExtrapInterp2(u1%Mesh, u2%Mesh, u3%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE Morison_Input_ExtrapInterp2 - - - SUBROUTINE Morison_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(Morison_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(Morison_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None +subroutine Morison_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time + ! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(Morison_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(Morison_OutputType), intent(inout) :: y_out ! Output at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_Output_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(y)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(y) - 1 - IF ( order .eq. 0 ) THEN - CALL Morison_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL Morison_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL Morison_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE Morison_Output_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'Morison_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call Morison_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call Morison_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call Morison_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE Morison_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE Morison_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 1. @@ -6362,49 +6365,47 @@ SUBROUTINE Morison_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - TYPE(Morison_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(Morison_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(Morison_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(Morison_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(Morison_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(Morison_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_Output_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'Morison_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(y1%Mesh, y2%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated +END SUBROUTINE - ScaleFactor = t_out / t(2) - CALL MeshExtrapInterp1(y1%Mesh, y2%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE Morison_Output_ExtrapInterp1 - - - SUBROUTINE Morison_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE Morison_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 2. @@ -6418,56 +6419,52 @@ SUBROUTINE Morison_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat ! !.................................................................................................................................. - TYPE(Morison_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(Morison_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(Morison_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(Morison_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(Morison_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(Morison_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(Morison_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(Morison_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'Morison_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'Morison_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) - CALL MeshExtrapInterp2(y1%Mesh, y2%Mesh, y3%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE Morison_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(y1%Mesh, y2%Mesh, y3%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated +END SUBROUTINE END MODULE Morison_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/SS_Excitation_Types.f90 b/modules/hydrodyn/src/SS_Excitation_Types.f90 index 6972a3aed9..84657838fe 100644 --- a/modules/hydrodyn/src/SS_Excitation_Types.f90 +++ b/modules/hydrodyn/src/SS_Excitation_Types.f90 @@ -1202,58 +1202,59 @@ subroutine SS_Exc_UnPackOutput(Buf, OutData) end if end subroutine - SUBROUTINE SS_Exc_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(SS_Exc_InputType), INTENT(IN) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(SS_Exc_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None +subroutine SS_Exc_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time + ! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(SS_Exc_InputType), intent(in) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(SS_Exc_InputType), intent(inout) :: u_out ! Input at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_Input_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(u)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(u) - 1 - IF ( order .eq. 0 ) THEN - CALL SS_Exc_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL SS_Exc_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL SS_Exc_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE SS_Exc_Input_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'SS_Exc_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call SS_Exc_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call SS_Exc_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call SS_Exc_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE SS_Exc_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE SS_Exc_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 1. @@ -1265,51 +1266,47 @@ SUBROUTINE SS_Exc_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrM ! !.................................................................................................................................. - TYPE(SS_Exc_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 - TYPE(SS_Exc_InputType), INTENT(IN) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(SS_Exc_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(SS_Exc_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 + TYPE(SS_Exc_InputType), INTENT(IN) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(SS_Exc_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_Input_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF - - ScaleFactor = t_out / t(2) -IF (ALLOCATED(u_out%PtfmPos) .AND. ALLOCATED(u1%PtfmPos)) THEN - DO i2 = LBOUND(u_out%PtfmPos,2),UBOUND(u_out%PtfmPos,2) - DO i1 = LBOUND(u_out%PtfmPos,1),UBOUND(u_out%PtfmPos,1) - b = -(u1%PtfmPos(i1,i2) - u2%PtfmPos(i1,i2)) - u_out%PtfmPos(i1,i2) = u1%PtfmPos(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated - END SUBROUTINE SS_Exc_Input_ExtrapInterp1 - - - SUBROUTINE SS_Exc_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(u_out%PtfmPos) .AND. ALLOCATED(u1%PtfmPos)) THEN + u_out%PtfmPos = a1*u1%PtfmPos + a2*u2%PtfmPos + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE SS_Exc_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 2. @@ -1323,112 +1320,107 @@ SUBROUTINE SS_Exc_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ! !.................................................................................................................................. - TYPE(SS_Exc_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 - TYPE(SS_Exc_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 - TYPE(SS_Exc_InputType), INTENT(IN) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(SS_Exc_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(SS_Exc_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 + TYPE(SS_Exc_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 + TYPE(SS_Exc_InputType), INTENT(IN) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(SS_Exc_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_Input_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) -IF (ALLOCATED(u_out%PtfmPos) .AND. ALLOCATED(u1%PtfmPos)) THEN - DO i2 = LBOUND(u_out%PtfmPos,2),UBOUND(u_out%PtfmPos,2) - DO i1 = LBOUND(u_out%PtfmPos,1),UBOUND(u_out%PtfmPos,1) - b = (t(3)**2*(u1%PtfmPos(i1,i2) - u2%PtfmPos(i1,i2)) + t(2)**2*(-u1%PtfmPos(i1,i2) + u3%PtfmPos(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%PtfmPos(i1,i2) + t(3)*u2%PtfmPos(i1,i2) - t(2)*u3%PtfmPos(i1,i2) ) * scaleFactor - u_out%PtfmPos(i1,i2) = u1%PtfmPos(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated - END SUBROUTINE SS_Exc_Input_ExtrapInterp2 - - - SUBROUTINE SS_Exc_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(SS_Exc_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(SS_Exc_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(u_out%PtfmPos) .AND. ALLOCATED(u1%PtfmPos)) THEN + u_out%PtfmPos = a1*u1%PtfmPos + a2*u2%PtfmPos + a3*u3%PtfmPos + END IF ! check if allocated +END SUBROUTINE + +subroutine SS_Exc_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time + ! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(SS_Exc_OutputType), intent(in) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(SS_Exc_OutputType), intent(inout) :: y_out ! Output at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_Output_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(y)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(y) - 1 - IF ( order .eq. 0 ) THEN - CALL SS_Exc_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL SS_Exc_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL SS_Exc_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE SS_Exc_Output_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'SS_Exc_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call SS_Exc_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call SS_Exc_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call SS_Exc_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE SS_Exc_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE SS_Exc_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 1. @@ -1440,53 +1432,48 @@ SUBROUTINE SS_Exc_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - TYPE(SS_Exc_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 - TYPE(SS_Exc_OutputType), INTENT(IN) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(SS_Exc_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(SS_Exc_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 + TYPE(SS_Exc_OutputType), INTENT(IN) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(SS_Exc_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_Output_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF - - ScaleFactor = t_out / t(2) -IF (ALLOCATED(y_out%y) .AND. ALLOCATED(y1%y)) THEN - DO i1 = LBOUND(y_out%y,1),UBOUND(y_out%y,1) - b = -(y1%y(i1) - y2%y(i1)) - y_out%y(i1) = y1%y(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE SS_Exc_Output_ExtrapInterp1 - - - SUBROUTINE SS_Exc_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%y) .AND. ALLOCATED(y1%y)) THEN + y_out%y = a1*y1%y + a2*y2%y + END IF ! check if allocated + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE SS_Exc_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 2. @@ -1500,61 +1487,53 @@ SUBROUTINE SS_Exc_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ! !.................................................................................................................................. - TYPE(SS_Exc_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 - TYPE(SS_Exc_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 - TYPE(SS_Exc_OutputType), INTENT(IN) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(SS_Exc_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(SS_Exc_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 + TYPE(SS_Exc_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 + TYPE(SS_Exc_OutputType), INTENT(IN) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(SS_Exc_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) -IF (ALLOCATED(y_out%y) .AND. ALLOCATED(y1%y)) THEN - DO i1 = LBOUND(y_out%y,1),UBOUND(y_out%y,1) - b = (t(3)**2*(y1%y(i1) - y2%y(i1)) + t(2)**2*(-y1%y(i1) + y3%y(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%y(i1) + t(3)*y2%y(i1) - t(2)*y3%y(i1) ) * scaleFactor - y_out%y(i1) = y1%y(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE SS_Exc_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%y) .AND. ALLOCATED(y1%y)) THEN + y_out%y = a1*y1%y + a2*y2%y + a3*y3%y + END IF ! check if allocated + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated +END SUBROUTINE END MODULE SS_Excitation_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/SS_Radiation_Types.f90 b/modules/hydrodyn/src/SS_Radiation_Types.f90 index fa9221a82f..48280fc706 100644 --- a/modules/hydrodyn/src/SS_Radiation_Types.f90 +++ b/modules/hydrodyn/src/SS_Radiation_Types.f90 @@ -956,58 +956,59 @@ subroutine SS_Rad_UnPackOutput(Buf, OutData) end if end subroutine - SUBROUTINE SS_Rad_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(SS_Rad_InputType), INTENT(IN) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(SS_Rad_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None +subroutine SS_Rad_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time + ! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(SS_Rad_InputType), intent(in) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(SS_Rad_InputType), intent(inout) :: u_out ! Input at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_Input_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(u)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(u) - 1 - IF ( order .eq. 0 ) THEN - CALL SS_Rad_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL SS_Rad_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL SS_Rad_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE SS_Rad_Input_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'SS_Rad_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call SS_Rad_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call SS_Rad_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call SS_Rad_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE SS_Rad_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE SS_Rad_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 1. @@ -1019,47 +1020,45 @@ SUBROUTINE SS_Rad_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrM ! !.................................................................................................................................. - TYPE(SS_Rad_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 - TYPE(SS_Rad_InputType), INTENT(IN) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(SS_Rad_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(SS_Rad_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 + TYPE(SS_Rad_InputType), INTENT(IN) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(SS_Rad_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_Input_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF - - ScaleFactor = t_out / t(2) -IF (ALLOCATED(u_out%dq) .AND. ALLOCATED(u1%dq)) THEN - DO i1 = LBOUND(u_out%dq,1),UBOUND(u_out%dq,1) - b = -(u1%dq(i1) - u2%dq(i1)) - u_out%dq(i1) = u1%dq(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE SS_Rad_Input_ExtrapInterp1 - - - SUBROUTINE SS_Rad_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(u_out%dq) .AND. ALLOCATED(u1%dq)) THEN + u_out%dq = a1*u1%dq + a2*u2%dq + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE SS_Rad_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 2. @@ -1073,108 +1072,105 @@ SUBROUTINE SS_Rad_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ! !.................................................................................................................................. - TYPE(SS_Rad_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 - TYPE(SS_Rad_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 - TYPE(SS_Rad_InputType), INTENT(IN) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(SS_Rad_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(SS_Rad_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 + TYPE(SS_Rad_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 + TYPE(SS_Rad_InputType), INTENT(IN) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(SS_Rad_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_Input_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) -IF (ALLOCATED(u_out%dq) .AND. ALLOCATED(u1%dq)) THEN - DO i1 = LBOUND(u_out%dq,1),UBOUND(u_out%dq,1) - b = (t(3)**2*(u1%dq(i1) - u2%dq(i1)) + t(2)**2*(-u1%dq(i1) + u3%dq(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%dq(i1) + t(3)*u2%dq(i1) - t(2)*u3%dq(i1) ) * scaleFactor - u_out%dq(i1) = u1%dq(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE SS_Rad_Input_ExtrapInterp2 - - - SUBROUTINE SS_Rad_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(SS_Rad_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(SS_Rad_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(u_out%dq) .AND. ALLOCATED(u1%dq)) THEN + u_out%dq = a1*u1%dq + a2*u2%dq + a3*u3%dq + END IF ! check if allocated +END SUBROUTINE + +subroutine SS_Rad_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time + ! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(SS_Rad_OutputType), intent(in) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(SS_Rad_OutputType), intent(inout) :: y_out ! Output at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_Output_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(y)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(y) - 1 - IF ( order .eq. 0 ) THEN - CALL SS_Rad_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL SS_Rad_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL SS_Rad_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE SS_Rad_Output_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'SS_Rad_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call SS_Rad_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call SS_Rad_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call SS_Rad_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE SS_Rad_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE SS_Rad_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 1. @@ -1186,53 +1182,48 @@ SUBROUTINE SS_Rad_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - TYPE(SS_Rad_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 - TYPE(SS_Rad_OutputType), INTENT(IN) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(SS_Rad_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(SS_Rad_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 + TYPE(SS_Rad_OutputType), INTENT(IN) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(SS_Rad_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_Output_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF - - ScaleFactor = t_out / t(2) -IF (ALLOCATED(y_out%y) .AND. ALLOCATED(y1%y)) THEN - DO i1 = LBOUND(y_out%y,1),UBOUND(y_out%y,1) - b = -(y1%y(i1) - y2%y(i1)) - y_out%y(i1) = y1%y(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE SS_Rad_Output_ExtrapInterp1 - - - SUBROUTINE SS_Rad_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%y) .AND. ALLOCATED(y1%y)) THEN + y_out%y = a1*y1%y + a2*y2%y + END IF ! check if allocated + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE SS_Rad_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 2. @@ -1246,61 +1237,53 @@ SUBROUTINE SS_Rad_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ! !.................................................................................................................................. - TYPE(SS_Rad_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 - TYPE(SS_Rad_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 - TYPE(SS_Rad_OutputType), INTENT(IN) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(SS_Rad_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(SS_Rad_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 + TYPE(SS_Rad_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 + TYPE(SS_Rad_OutputType), INTENT(IN) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(SS_Rad_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) -IF (ALLOCATED(y_out%y) .AND. ALLOCATED(y1%y)) THEN - DO i1 = LBOUND(y_out%y,1),UBOUND(y_out%y,1) - b = (t(3)**2*(y1%y(i1) - y2%y(i1)) + t(2)**2*(-y1%y(i1) + y3%y(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%y(i1) + t(3)*y2%y(i1) - t(2)*y3%y(i1) ) * scaleFactor - y_out%y(i1) = y1%y(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE SS_Rad_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%y) .AND. ALLOCATED(y1%y)) THEN + y_out%y = a1*y1%y + a2*y2%y + a3*y3%y + END IF ! check if allocated + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated +END SUBROUTINE END MODULE SS_Radiation_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/WAMIT2_Types.f90 b/modules/hydrodyn/src/WAMIT2_Types.f90 index 519a2ca72f..b29c74410f 100644 --- a/modules/hydrodyn/src/WAMIT2_Types.f90 +++ b/modules/hydrodyn/src/WAMIT2_Types.f90 @@ -747,58 +747,59 @@ subroutine WAMIT2_UnPackOutput(Buf, OutData) call MeshUnpack(Buf, OutData%Mesh) ! Mesh end subroutine - SUBROUTINE WAMIT2_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(WAMIT2_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(WAMIT2_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None +subroutine WAMIT2_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time + ! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(WAMIT2_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(WAMIT2_OutputType), intent(inout) :: y_out ! Output at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_Output_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(y)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(y) - 1 - IF ( order .eq. 0 ) THEN - CALL WAMIT2_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL WAMIT2_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL WAMIT2_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE WAMIT2_Output_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'WAMIT2_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call WAMIT2_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call WAMIT2_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call WAMIT2_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE WAMIT2_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE WAMIT2_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 1. @@ -810,41 +811,42 @@ SUBROUTINE WAMIT2_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - TYPE(WAMIT2_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(WAMIT2_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(WAMIT2_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(WAMIT2_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(WAMIT2_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(WAMIT2_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_Output_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(y1%Mesh, y2%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE - ScaleFactor = t_out / t(2) - CALL MeshExtrapInterp1(y1%Mesh, y2%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE WAMIT2_Output_ExtrapInterp1 - - - SUBROUTINE WAMIT2_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE WAMIT2_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 2. @@ -858,47 +860,47 @@ SUBROUTINE WAMIT2_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ! !.................................................................................................................................. - TYPE(WAMIT2_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(WAMIT2_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(WAMIT2_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(WAMIT2_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(WAMIT2_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(WAMIT2_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(WAMIT2_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(WAMIT2_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_Output_ExtrapInterp2' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_Output_ExtrapInterp2' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) - CALL MeshExtrapInterp2(y1%Mesh, y2%Mesh, y3%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE WAMIT2_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(y1%Mesh, y2%Mesh, y3%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE END MODULE WAMIT2_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/hydrodyn/src/WAMIT_Types.f90 b/modules/hydrodyn/src/WAMIT_Types.f90 index 3083796d32..f09135bcc5 100644 --- a/modules/hydrodyn/src/WAMIT_Types.f90 +++ b/modules/hydrodyn/src/WAMIT_Types.f90 @@ -1644,58 +1644,59 @@ subroutine WAMIT_UnPackOutput(Buf, OutData) call MeshUnpack(Buf, OutData%Mesh) ! Mesh end subroutine - SUBROUTINE WAMIT_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(WAMIT_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(WAMIT_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None +subroutine WAMIT_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time + ! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(WAMIT_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(WAMIT_InputType), intent(inout) :: u_out ! Input at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_Input_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(u)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(u) - 1 - IF ( order .eq. 0 ) THEN - CALL WAMIT_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL WAMIT_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL WAMIT_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE WAMIT_Input_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'WAMIT_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call WAMIT_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call WAMIT_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call WAMIT_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE WAMIT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE WAMIT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 1. @@ -1707,41 +1708,42 @@ SUBROUTINE WAMIT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMs ! !.................................................................................................................................. - TYPE(WAMIT_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(WAMIT_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(WAMIT_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(WAMIT_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(WAMIT_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(WAMIT_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_Input_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(u1%Mesh, u2%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE - ScaleFactor = t_out / t(2) - CALL MeshExtrapInterp1(u1%Mesh, u2%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE WAMIT_Input_ExtrapInterp1 - - - SUBROUTINE WAMIT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE WAMIT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 2. @@ -1755,101 +1757,102 @@ SUBROUTINE WAMIT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, E ! !.................................................................................................................................. - TYPE(WAMIT_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(WAMIT_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(WAMIT_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(WAMIT_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(WAMIT_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(WAMIT_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(WAMIT_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(WAMIT_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_Input_ExtrapInterp2' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_Input_ExtrapInterp2' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(u1%Mesh, u2%Mesh, u3%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) - CALL MeshExtrapInterp2(u1%Mesh, u2%Mesh, u3%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE WAMIT_Input_ExtrapInterp2 - - - SUBROUTINE WAMIT_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(WAMIT_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(WAMIT_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None +subroutine WAMIT_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time + ! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(WAMIT_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(WAMIT_OutputType), intent(inout) :: y_out ! Output at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_Output_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(y)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(y) - 1 - IF ( order .eq. 0 ) THEN - CALL WAMIT_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL WAMIT_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL WAMIT_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE WAMIT_Output_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'WAMIT_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call WAMIT_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call WAMIT_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call WAMIT_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE WAMIT_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE WAMIT_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 1. @@ -1861,41 +1864,42 @@ SUBROUTINE WAMIT_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrM ! !.................................................................................................................................. - TYPE(WAMIT_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(WAMIT_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(WAMIT_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(WAMIT_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(WAMIT_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(WAMIT_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_Output_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(y1%Mesh, y2%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE - ScaleFactor = t_out / t(2) - CALL MeshExtrapInterp1(y1%Mesh, y2%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE WAMIT_Output_ExtrapInterp1 - - - SUBROUTINE WAMIT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE WAMIT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 2. @@ -1909,47 +1913,47 @@ SUBROUTINE WAMIT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ! !.................................................................................................................................. - TYPE(WAMIT_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(WAMIT_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(WAMIT_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(WAMIT_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(WAMIT_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(WAMIT_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(WAMIT_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(WAMIT_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_Output_ExtrapInterp2' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_Output_ExtrapInterp2' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) - CALL MeshExtrapInterp2(y1%Mesh, y2%Mesh, y3%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE WAMIT_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(y1%Mesh, y2%Mesh, y3%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE END MODULE WAMIT_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/icedyn/src/IceDyn_Types.f90 b/modules/icedyn/src/IceDyn_Types.f90 index d95b320029..56e7b92ace 100644 --- a/modules/icedyn/src/IceDyn_Types.f90 +++ b/modules/icedyn/src/IceDyn_Types.f90 @@ -1867,58 +1867,59 @@ subroutine IceD_UnPackOutput(Buf, OutData) end if end subroutine - SUBROUTINE IceD_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(IceD_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(IceD_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None +subroutine IceD_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time + ! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(IceD_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(IceD_InputType), intent(inout) :: u_out ! Input at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_Input_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(u)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(u) - 1 - IF ( order .eq. 0 ) THEN - CALL IceD_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL IceD_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL IceD_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE IceD_Input_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'IceD_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call IceD_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call IceD_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call IceD_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE IceD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE IceD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 1. @@ -1930,41 +1931,42 @@ SUBROUTINE IceD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(IceD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(IceD_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(IceD_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(IceD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(IceD_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(IceD_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_Input_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'IceD_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF - - ScaleFactor = t_out / t(2) - CALL MeshExtrapInterp1(u1%PointMesh, u2%PointMesh, tin, u_out%PointMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE IceD_Input_ExtrapInterp1 - - - SUBROUTINE IceD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(u1%PointMesh, u2%PointMesh, tin, u_out%PointMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +SUBROUTINE IceD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 2. @@ -1978,101 +1980,102 @@ SUBROUTINE IceD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - TYPE(IceD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(IceD_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(IceD_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(IceD_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(IceD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(IceD_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(IceD_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(IceD_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_Input_ExtrapInterp2' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'IceD_Input_ExtrapInterp2' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) - CALL MeshExtrapInterp2(u1%PointMesh, u2%PointMesh, u3%PointMesh, tin, u_out%PointMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE IceD_Input_ExtrapInterp2 - - - SUBROUTINE IceD_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(IceD_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(IceD_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(u1%PointMesh, u2%PointMesh, u3%PointMesh, tin, u_out%PointMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +subroutine IceD_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time + ! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(IceD_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(IceD_OutputType), intent(inout) :: y_out ! Output at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_Output_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(y)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(y) - 1 - IF ( order .eq. 0 ) THEN - CALL IceD_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL IceD_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL IceD_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE IceD_Output_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'IceD_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call IceD_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call IceD_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call IceD_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE IceD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE IceD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 1. @@ -2084,49 +2087,47 @@ SUBROUTINE IceD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs ! !.................................................................................................................................. - TYPE(IceD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(IceD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(IceD_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(IceD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(IceD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(IceD_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_Output_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'IceD_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF - - ScaleFactor = t_out / t(2) - CALL MeshExtrapInterp1(y1%PointMesh, y2%PointMesh, tin, y_out%PointMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE IceD_Output_ExtrapInterp1 - - - SUBROUTINE IceD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(y1%PointMesh, y2%PointMesh, tin, y_out%PointMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE IceD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 2. @@ -2140,56 +2141,52 @@ SUBROUTINE IceD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E ! !.................................................................................................................................. - TYPE(IceD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(IceD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(IceD_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(IceD_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(IceD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(IceD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(IceD_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(IceD_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'IceD_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'IceD_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) - CALL MeshExtrapInterp2(y1%PointMesh, y2%PointMesh, y3%PointMesh, tin, y_out%PointMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE IceD_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(y1%PointMesh, y2%PointMesh, y3%PointMesh, tin, y_out%PointMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated +END SUBROUTINE END MODULE IceDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/icefloe/src/icefloe/IceFloe_Types.f90 b/modules/icefloe/src/icefloe/IceFloe_Types.f90 index aa26df889b..2a7230ceb8 100644 --- a/modules/icefloe/src/icefloe/IceFloe_Types.f90 +++ b/modules/icefloe/src/icefloe/IceFloe_Types.f90 @@ -844,58 +844,59 @@ subroutine IceFloe_UnPackOutput(Buf, OutData) end if end subroutine - SUBROUTINE IceFloe_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(IceFloe_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(IceFloe_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None +subroutine IceFloe_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time + ! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(IceFloe_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(IceFloe_InputType), intent(inout) :: u_out ! Input at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_Input_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(u)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(u) - 1 - IF ( order .eq. 0 ) THEN - CALL IceFloe_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL IceFloe_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL IceFloe_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE IceFloe_Input_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'IceFloe_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call IceFloe_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call IceFloe_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call IceFloe_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE IceFloe_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE IceFloe_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 1. @@ -907,41 +908,42 @@ SUBROUTINE IceFloe_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - TYPE(IceFloe_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(IceFloe_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(IceFloe_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(IceFloe_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(IceFloe_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(IceFloe_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_Input_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF - - ScaleFactor = t_out / t(2) - CALL MeshExtrapInterp1(u1%iceMesh, u2%iceMesh, tin, u_out%iceMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE IceFloe_Input_ExtrapInterp1 - - - SUBROUTINE IceFloe_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(u1%iceMesh, u2%iceMesh, tin, u_out%iceMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +SUBROUTINE IceFloe_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 2. @@ -955,101 +957,102 @@ SUBROUTINE IceFloe_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ! !.................................................................................................................................. - TYPE(IceFloe_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(IceFloe_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(IceFloe_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(IceFloe_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(IceFloe_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(IceFloe_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(IceFloe_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(IceFloe_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_Input_ExtrapInterp2' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_Input_ExtrapInterp2' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) - CALL MeshExtrapInterp2(u1%iceMesh, u2%iceMesh, u3%iceMesh, tin, u_out%iceMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE IceFloe_Input_ExtrapInterp2 - - - SUBROUTINE IceFloe_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(IceFloe_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(IceFloe_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(u1%iceMesh, u2%iceMesh, u3%iceMesh, tin, u_out%iceMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +subroutine IceFloe_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time + ! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(IceFloe_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(IceFloe_OutputType), intent(inout) :: y_out ! Output at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_Output_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(y)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(y) - 1 - IF ( order .eq. 0 ) THEN - CALL IceFloe_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL IceFloe_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL IceFloe_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE IceFloe_Output_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'IceFloe_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call IceFloe_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call IceFloe_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call IceFloe_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE IceFloe_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE IceFloe_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 1. @@ -1061,49 +1064,47 @@ SUBROUTINE IceFloe_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - TYPE(IceFloe_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(IceFloe_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(IceFloe_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(IceFloe_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(IceFloe_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(IceFloe_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_Output_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF - - ScaleFactor = t_out / t(2) - CALL MeshExtrapInterp1(y1%iceMesh, y2%iceMesh, tin, y_out%iceMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE IceFloe_Output_ExtrapInterp1 - - - SUBROUTINE IceFloe_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(y1%iceMesh, y2%iceMesh, tin, y_out%iceMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE IceFloe_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 2. @@ -1117,56 +1118,52 @@ SUBROUTINE IceFloe_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat ! !.................................................................................................................................. - TYPE(IceFloe_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(IceFloe_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(IceFloe_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(IceFloe_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(IceFloe_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(IceFloe_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(IceFloe_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(IceFloe_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) - CALL MeshExtrapInterp2(y1%iceMesh, y2%iceMesh, y3%iceMesh, tin, y_out%iceMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE IceFloe_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(y1%iceMesh, y2%iceMesh, y3%iceMesh, tin, y_out%iceMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated +END SUBROUTINE END MODULE IceFloe_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/inflowwind/src/InflowWind_Types.f90 b/modules/inflowwind/src/InflowWind_Types.f90 index 2277e3af71..7a7347bce5 100644 --- a/modules/inflowwind/src/InflowWind_Types.f90 +++ b/modules/inflowwind/src/InflowWind_Types.f90 @@ -1991,58 +1991,59 @@ subroutine InflowWind_UnPackMisc(Buf, OutData) call InflowWind_UnpackOutput(Buf, OutData%y_Hub) ! y_Hub end subroutine - SUBROUTINE InflowWind_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(InflowWind_InputType), INTENT(IN) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(InflowWind_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None +subroutine InflowWind_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time + ! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(InflowWind_InputType), intent(in) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(InflowWind_InputType), intent(inout) :: u_out ! Input at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_Input_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(u)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(u) - 1 - IF ( order .eq. 0 ) THEN - CALL InflowWind_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL InflowWind_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL InflowWind_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE InflowWind_Input_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'InflowWind_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call InflowWind_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call InflowWind_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call InflowWind_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE InflowWind_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE InflowWind_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 1. @@ -2054,63 +2055,51 @@ SUBROUTINE InflowWind_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ! !.................................................................................................................................. - TYPE(InflowWind_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 - TYPE(InflowWind_InputType), INTENT(IN) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(InflowWind_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(InflowWind_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 + TYPE(InflowWind_InputType), INTENT(IN) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(InflowWind_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_Input_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF - - ScaleFactor = t_out / t(2) -IF (ALLOCATED(u_out%PositionXYZ) .AND. ALLOCATED(u1%PositionXYZ)) THEN - DO i2 = LBOUND(u_out%PositionXYZ,2),UBOUND(u_out%PositionXYZ,2) - DO i1 = LBOUND(u_out%PositionXYZ,1),UBOUND(u_out%PositionXYZ,1) - b = -(u1%PositionXYZ(i1,i2) - u2%PositionXYZ(i1,i2)) - u_out%PositionXYZ(i1,i2) = u1%PositionXYZ(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated - CALL Lidar_Input_ExtrapInterp1( u1%lidar, u2%lidar, tin, u_out%lidar, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - DO i1 = LBOUND(u_out%HubPosition,1),UBOUND(u_out%HubPosition,1) - b = -(u1%HubPosition(i1) - u2%HubPosition(i1)) - u_out%HubPosition(i1) = u1%HubPosition(i1) + b * ScaleFactor - END DO - DO i2 = LBOUND(u_out%HubOrientation,2),UBOUND(u_out%HubOrientation,2) - DO i1 = LBOUND(u_out%HubOrientation,1),UBOUND(u_out%HubOrientation,1) - b = -(u1%HubOrientation(i1,i2) - u2%HubOrientation(i1,i2)) - u_out%HubOrientation(i1,i2) = u1%HubOrientation(i1,i2) + b * ScaleFactor - END DO - END DO - END SUBROUTINE InflowWind_Input_ExtrapInterp1 - - - SUBROUTINE InflowWind_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(u_out%PositionXYZ) .AND. ALLOCATED(u1%PositionXYZ)) THEN + u_out%PositionXYZ = a1*u1%PositionXYZ + a2*u2%PositionXYZ + END IF ! check if allocated + CALL Lidar_Input_ExtrapInterp1( u1%lidar, u2%lidar, tin, u_out%lidar, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + u_out%HubPosition = a1*u1%HubPosition + a2*u2%HubPosition + u_out%HubOrientation = a1*u1%HubOrientation + a2*u2%HubOrientation +END SUBROUTINE + +SUBROUTINE InflowWind_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 2. @@ -2124,126 +2113,111 @@ SUBROUTINE InflowWind_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrSt ! !.................................................................................................................................. - TYPE(InflowWind_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 - TYPE(InflowWind_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 - TYPE(InflowWind_InputType), INTENT(IN) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(InflowWind_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(InflowWind_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 + TYPE(InflowWind_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 + TYPE(InflowWind_InputType), INTENT(IN) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(InflowWind_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_Input_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) -IF (ALLOCATED(u_out%PositionXYZ) .AND. ALLOCATED(u1%PositionXYZ)) THEN - DO i2 = LBOUND(u_out%PositionXYZ,2),UBOUND(u_out%PositionXYZ,2) - DO i1 = LBOUND(u_out%PositionXYZ,1),UBOUND(u_out%PositionXYZ,1) - b = (t(3)**2*(u1%PositionXYZ(i1,i2) - u2%PositionXYZ(i1,i2)) + t(2)**2*(-u1%PositionXYZ(i1,i2) + u3%PositionXYZ(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%PositionXYZ(i1,i2) + t(3)*u2%PositionXYZ(i1,i2) - t(2)*u3%PositionXYZ(i1,i2) ) * scaleFactor - u_out%PositionXYZ(i1,i2) = u1%PositionXYZ(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated - CALL Lidar_Input_ExtrapInterp2( u1%lidar, u2%lidar, u3%lidar, tin, u_out%lidar, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - DO i1 = LBOUND(u_out%HubPosition,1),UBOUND(u_out%HubPosition,1) - b = (t(3)**2*(u1%HubPosition(i1) - u2%HubPosition(i1)) + t(2)**2*(-u1%HubPosition(i1) + u3%HubPosition(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%HubPosition(i1) + t(3)*u2%HubPosition(i1) - t(2)*u3%HubPosition(i1) ) * scaleFactor - u_out%HubPosition(i1) = u1%HubPosition(i1) + b + c * t_out - END DO - DO i2 = LBOUND(u_out%HubOrientation,2),UBOUND(u_out%HubOrientation,2) - DO i1 = LBOUND(u_out%HubOrientation,1),UBOUND(u_out%HubOrientation,1) - b = (t(3)**2*(u1%HubOrientation(i1,i2) - u2%HubOrientation(i1,i2)) + t(2)**2*(-u1%HubOrientation(i1,i2) + u3%HubOrientation(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%HubOrientation(i1,i2) + t(3)*u2%HubOrientation(i1,i2) - t(2)*u3%HubOrientation(i1,i2) ) * scaleFactor - u_out%HubOrientation(i1,i2) = u1%HubOrientation(i1,i2) + b + c * t_out - END DO - END DO - END SUBROUTINE InflowWind_Input_ExtrapInterp2 - - - SUBROUTINE InflowWind_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(InflowWind_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(InflowWind_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(u_out%PositionXYZ) .AND. ALLOCATED(u1%PositionXYZ)) THEN + u_out%PositionXYZ = a1*u1%PositionXYZ + a2*u2%PositionXYZ + a3*u3%PositionXYZ + END IF ! check if allocated + CALL Lidar_Input_ExtrapInterp2( u1%lidar, u2%lidar, u3%lidar, tin, u_out%lidar, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + u_out%HubPosition = a1*u1%HubPosition + a2*u2%HubPosition + a3*u3%HubPosition + u_out%HubOrientation = a1*u1%HubOrientation + a2*u2%HubOrientation + a3*u3%HubOrientation +END SUBROUTINE + +subroutine InflowWind_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time + ! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(InflowWind_OutputType), intent(in) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(InflowWind_OutputType), intent(inout) :: y_out ! Output at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_Output_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(y)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(y) - 1 - IF ( order .eq. 0 ) THEN - CALL InflowWind_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL InflowWind_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL InflowWind_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE InflowWind_Output_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'InflowWind_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call InflowWind_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call InflowWind_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call InflowWind_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE InflowWind_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE InflowWind_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 1. @@ -2255,75 +2229,57 @@ SUBROUTINE InflowWind_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ! !.................................................................................................................................. - TYPE(InflowWind_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 - TYPE(InflowWind_OutputType), INTENT(IN) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(InflowWind_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(InflowWind_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 + TYPE(InflowWind_OutputType), INTENT(IN) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(InflowWind_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_Output_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF - - ScaleFactor = t_out / t(2) -IF (ALLOCATED(y_out%VelocityUVW) .AND. ALLOCATED(y1%VelocityUVW)) THEN - DO i2 = LBOUND(y_out%VelocityUVW,2),UBOUND(y_out%VelocityUVW,2) - DO i1 = LBOUND(y_out%VelocityUVW,1),UBOUND(y_out%VelocityUVW,1) - b = -(y1%VelocityUVW(i1,i2) - y2%VelocityUVW(i1,i2)) - y_out%VelocityUVW(i1,i2) = y1%VelocityUVW(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%AccelUVW) .AND. ALLOCATED(y1%AccelUVW)) THEN - DO i2 = LBOUND(y_out%AccelUVW,2),UBOUND(y_out%AccelUVW,2) - DO i1 = LBOUND(y_out%AccelUVW,1),UBOUND(y_out%AccelUVW,1) - b = -(y1%AccelUVW(i1,i2) - y2%AccelUVW(i1,i2)) - y_out%AccelUVW(i1,i2) = y1%AccelUVW(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - DO i1 = LBOUND(y_out%DiskVel,1),UBOUND(y_out%DiskVel,1) - b = -(y1%DiskVel(i1) - y2%DiskVel(i1)) - y_out%DiskVel(i1) = y1%DiskVel(i1) + b * ScaleFactor - END DO - DO i1 = LBOUND(y_out%HubVel,1),UBOUND(y_out%HubVel,1) - b = -(y1%HubVel(i1) - y2%HubVel(i1)) - y_out%HubVel(i1) = y1%HubVel(i1) + b * ScaleFactor - END DO - CALL Lidar_Output_ExtrapInterp1( y1%lidar, y2%lidar, tin, y_out%lidar, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE InflowWind_Output_ExtrapInterp1 - - - SUBROUTINE InflowWind_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%VelocityUVW) .AND. ALLOCATED(y1%VelocityUVW)) THEN + y_out%VelocityUVW = a1*y1%VelocityUVW + a2*y2%VelocityUVW + END IF ! check if allocated + IF (ALLOCATED(y_out%AccelUVW) .AND. ALLOCATED(y1%AccelUVW)) THEN + y_out%AccelUVW = a1*y1%AccelUVW + a2*y2%AccelUVW + END IF ! check if allocated + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated + y_out%DiskVel = a1*y1%DiskVel + a2*y2%DiskVel + y_out%HubVel = a1*y1%HubVel + a2*y2%HubVel + CALL Lidar_Output_ExtrapInterp1( y1%lidar, y2%lidar, tin, y_out%lidar, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +SUBROUTINE InflowWind_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 2. @@ -2337,86 +2293,62 @@ SUBROUTINE InflowWind_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrS ! !.................................................................................................................................. - TYPE(InflowWind_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 - TYPE(InflowWind_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 - TYPE(InflowWind_OutputType), INTENT(IN) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(InflowWind_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(InflowWind_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 + TYPE(InflowWind_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 + TYPE(InflowWind_OutputType), INTENT(IN) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(InflowWind_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) -IF (ALLOCATED(y_out%VelocityUVW) .AND. ALLOCATED(y1%VelocityUVW)) THEN - DO i2 = LBOUND(y_out%VelocityUVW,2),UBOUND(y_out%VelocityUVW,2) - DO i1 = LBOUND(y_out%VelocityUVW,1),UBOUND(y_out%VelocityUVW,1) - b = (t(3)**2*(y1%VelocityUVW(i1,i2) - y2%VelocityUVW(i1,i2)) + t(2)**2*(-y1%VelocityUVW(i1,i2) + y3%VelocityUVW(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%VelocityUVW(i1,i2) + t(3)*y2%VelocityUVW(i1,i2) - t(2)*y3%VelocityUVW(i1,i2) ) * scaleFactor - y_out%VelocityUVW(i1,i2) = y1%VelocityUVW(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%AccelUVW) .AND. ALLOCATED(y1%AccelUVW)) THEN - DO i2 = LBOUND(y_out%AccelUVW,2),UBOUND(y_out%AccelUVW,2) - DO i1 = LBOUND(y_out%AccelUVW,1),UBOUND(y_out%AccelUVW,1) - b = (t(3)**2*(y1%AccelUVW(i1,i2) - y2%AccelUVW(i1,i2)) + t(2)**2*(-y1%AccelUVW(i1,i2) + y3%AccelUVW(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%AccelUVW(i1,i2) + t(3)*y2%AccelUVW(i1,i2) - t(2)*y3%AccelUVW(i1,i2) ) * scaleFactor - y_out%AccelUVW(i1,i2) = y1%AccelUVW(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out - END DO -END IF ! check if allocated - DO i1 = LBOUND(y_out%DiskVel,1),UBOUND(y_out%DiskVel,1) - b = (t(3)**2*(y1%DiskVel(i1) - y2%DiskVel(i1)) + t(2)**2*(-y1%DiskVel(i1) + y3%DiskVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%DiskVel(i1) + t(3)*y2%DiskVel(i1) - t(2)*y3%DiskVel(i1) ) * scaleFactor - y_out%DiskVel(i1) = y1%DiskVel(i1) + b + c * t_out - END DO - DO i1 = LBOUND(y_out%HubVel,1),UBOUND(y_out%HubVel,1) - b = (t(3)**2*(y1%HubVel(i1) - y2%HubVel(i1)) + t(2)**2*(-y1%HubVel(i1) + y3%HubVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%HubVel(i1) + t(3)*y2%HubVel(i1) - t(2)*y3%HubVel(i1) ) * scaleFactor - y_out%HubVel(i1) = y1%HubVel(i1) + b + c * t_out - END DO - CALL Lidar_Output_ExtrapInterp2( y1%lidar, y2%lidar, y3%lidar, tin, y_out%lidar, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE InflowWind_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%VelocityUVW) .AND. ALLOCATED(y1%VelocityUVW)) THEN + y_out%VelocityUVW = a1*y1%VelocityUVW + a2*y2%VelocityUVW + a3*y3%VelocityUVW + END IF ! check if allocated + IF (ALLOCATED(y_out%AccelUVW) .AND. ALLOCATED(y1%AccelUVW)) THEN + y_out%AccelUVW = a1*y1%AccelUVW + a2*y2%AccelUVW + a3*y3%AccelUVW + END IF ! check if allocated + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated + y_out%DiskVel = a1*y1%DiskVel + a2*y2%DiskVel + a3*y3%DiskVel + y_out%HubVel = a1*y1%HubVel + a2*y2%HubVel + a3*y3%HubVel + CALL Lidar_Output_ExtrapInterp2( y1%lidar, y2%lidar, y3%lidar, tin, y_out%lidar, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE END MODULE InflowWind_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/inflowwind/src/Lidar_Types.f90 b/modules/inflowwind/src/Lidar_Types.f90 index df6cfa8402..a8e83bafe1 100644 --- a/modules/inflowwind/src/Lidar_Types.f90 +++ b/modules/inflowwind/src/Lidar_Types.f90 @@ -939,58 +939,59 @@ subroutine Lidar_UnPackOutput(Buf, OutData) end if end subroutine - SUBROUTINE Lidar_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(Lidar_InputType), INTENT(IN) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(Lidar_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None +subroutine Lidar_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time + ! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(Lidar_InputType), intent(in) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(Lidar_InputType), intent(inout) :: u_out ! Input at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_Input_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(u)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(u) - 1 - IF ( order .eq. 0 ) THEN - CALL Lidar_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL Lidar_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL Lidar_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE Lidar_Input_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'Lidar_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call Lidar_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call Lidar_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call Lidar_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE Lidar_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE Lidar_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 1. @@ -1002,49 +1003,45 @@ SUBROUTINE Lidar_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMs ! !.................................................................................................................................. - TYPE(Lidar_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 - TYPE(Lidar_InputType), INTENT(IN) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(Lidar_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(Lidar_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 + TYPE(Lidar_InputType), INTENT(IN) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(Lidar_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_Input_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF - - ScaleFactor = t_out / t(2) - b = -(u1%PulseLidEl - u2%PulseLidEl) - u_out%PulseLidEl = u1%PulseLidEl + b * ScaleFactor - b = -(u1%PulseLidAz - u2%PulseLidAz) - u_out%PulseLidAz = u1%PulseLidAz + b * ScaleFactor - b = -(u1%HubDisplacementX - u2%HubDisplacementX) - u_out%HubDisplacementX = u1%HubDisplacementX + b * ScaleFactor - b = -(u1%HubDisplacementY - u2%HubDisplacementY) - u_out%HubDisplacementY = u1%HubDisplacementY + b * ScaleFactor - b = -(u1%HubDisplacementZ - u2%HubDisplacementZ) - u_out%HubDisplacementZ = u1%HubDisplacementZ + b * ScaleFactor - END SUBROUTINE Lidar_Input_ExtrapInterp1 - - - SUBROUTINE Lidar_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + u_out%PulseLidEl = a1*u1%PulseLidEl + a2*u2%PulseLidEl + u_out%PulseLidAz = a1*u1%PulseLidAz + a2*u2%PulseLidAz + u_out%HubDisplacementX = a1*u1%HubDisplacementX + a2*u2%HubDisplacementX + u_out%HubDisplacementY = a1*u1%HubDisplacementY + a2*u2%HubDisplacementY + u_out%HubDisplacementZ = a1*u1%HubDisplacementZ + a2*u2%HubDisplacementZ +END SUBROUTINE + +SUBROUTINE Lidar_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 2. @@ -1058,114 +1055,105 @@ SUBROUTINE Lidar_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, E ! !.................................................................................................................................. - TYPE(Lidar_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 - TYPE(Lidar_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 - TYPE(Lidar_InputType), INTENT(IN) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(Lidar_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(Lidar_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 + TYPE(Lidar_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 + TYPE(Lidar_InputType), INTENT(IN) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(Lidar_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_Input_ExtrapInterp2' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_Input_ExtrapInterp2' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) - b = (t(3)**2*(u1%PulseLidEl - u2%PulseLidEl) + t(2)**2*(-u1%PulseLidEl + u3%PulseLidEl))* scaleFactor - c = ( (t(2)-t(3))*u1%PulseLidEl + t(3)*u2%PulseLidEl - t(2)*u3%PulseLidEl ) * scaleFactor - u_out%PulseLidEl = u1%PulseLidEl + b + c * t_out - b = (t(3)**2*(u1%PulseLidAz - u2%PulseLidAz) + t(2)**2*(-u1%PulseLidAz + u3%PulseLidAz))* scaleFactor - c = ( (t(2)-t(3))*u1%PulseLidAz + t(3)*u2%PulseLidAz - t(2)*u3%PulseLidAz ) * scaleFactor - u_out%PulseLidAz = u1%PulseLidAz + b + c * t_out - b = (t(3)**2*(u1%HubDisplacementX - u2%HubDisplacementX) + t(2)**2*(-u1%HubDisplacementX + u3%HubDisplacementX))* scaleFactor - c = ( (t(2)-t(3))*u1%HubDisplacementX + t(3)*u2%HubDisplacementX - t(2)*u3%HubDisplacementX ) * scaleFactor - u_out%HubDisplacementX = u1%HubDisplacementX + b + c * t_out - b = (t(3)**2*(u1%HubDisplacementY - u2%HubDisplacementY) + t(2)**2*(-u1%HubDisplacementY + u3%HubDisplacementY))* scaleFactor - c = ( (t(2)-t(3))*u1%HubDisplacementY + t(3)*u2%HubDisplacementY - t(2)*u3%HubDisplacementY ) * scaleFactor - u_out%HubDisplacementY = u1%HubDisplacementY + b + c * t_out - b = (t(3)**2*(u1%HubDisplacementZ - u2%HubDisplacementZ) + t(2)**2*(-u1%HubDisplacementZ + u3%HubDisplacementZ))* scaleFactor - c = ( (t(2)-t(3))*u1%HubDisplacementZ + t(3)*u2%HubDisplacementZ - t(2)*u3%HubDisplacementZ ) * scaleFactor - u_out%HubDisplacementZ = u1%HubDisplacementZ + b + c * t_out - END SUBROUTINE Lidar_Input_ExtrapInterp2 - - - SUBROUTINE Lidar_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(Lidar_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(Lidar_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + u_out%PulseLidEl = a1*u1%PulseLidEl + a2*u2%PulseLidEl + a3*u3%PulseLidEl + u_out%PulseLidAz = a1*u1%PulseLidAz + a2*u2%PulseLidAz + a3*u3%PulseLidAz + u_out%HubDisplacementX = a1*u1%HubDisplacementX + a2*u2%HubDisplacementX + a3*u3%HubDisplacementX + u_out%HubDisplacementY = a1*u1%HubDisplacementY + a2*u2%HubDisplacementY + a3*u3%HubDisplacementY + u_out%HubDisplacementZ = a1*u1%HubDisplacementZ + a2*u2%HubDisplacementZ + a3*u3%HubDisplacementZ +END SUBROUTINE + +subroutine Lidar_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time + ! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(Lidar_OutputType), intent(in) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(Lidar_OutputType), intent(inout) :: y_out ! Output at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_Output_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(y)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(y) - 1 - IF ( order .eq. 0 ) THEN - CALL Lidar_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL Lidar_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL Lidar_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE Lidar_Output_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'Lidar_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call Lidar_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call Lidar_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call Lidar_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE Lidar_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE Lidar_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 1. @@ -1177,71 +1165,57 @@ SUBROUTINE Lidar_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrM ! !.................................................................................................................................. - TYPE(Lidar_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 - TYPE(Lidar_OutputType), INTENT(IN) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(Lidar_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(Lidar_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 + TYPE(Lidar_OutputType), INTENT(IN) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(Lidar_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_Output_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF - - ScaleFactor = t_out / t(2) -IF (ALLOCATED(y_out%LidSpeed) .AND. ALLOCATED(y1%LidSpeed)) THEN - DO i1 = LBOUND(y_out%LidSpeed,1),UBOUND(y_out%LidSpeed,1) - b = -(y1%LidSpeed(i1) - y2%LidSpeed(i1)) - y_out%LidSpeed(i1) = y1%LidSpeed(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%WtTrunc) .AND. ALLOCATED(y1%WtTrunc)) THEN - DO i1 = LBOUND(y_out%WtTrunc,1),UBOUND(y_out%WtTrunc,1) - b = -(y1%WtTrunc(i1) - y2%WtTrunc(i1)) - y_out%WtTrunc(i1) = y1%WtTrunc(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%MsrPositionsX) .AND. ALLOCATED(y1%MsrPositionsX)) THEN - DO i1 = LBOUND(y_out%MsrPositionsX,1),UBOUND(y_out%MsrPositionsX,1) - b = -(y1%MsrPositionsX(i1) - y2%MsrPositionsX(i1)) - y_out%MsrPositionsX(i1) = y1%MsrPositionsX(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%MsrPositionsY) .AND. ALLOCATED(y1%MsrPositionsY)) THEN - DO i1 = LBOUND(y_out%MsrPositionsY,1),UBOUND(y_out%MsrPositionsY,1) - b = -(y1%MsrPositionsY(i1) - y2%MsrPositionsY(i1)) - y_out%MsrPositionsY(i1) = y1%MsrPositionsY(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%MsrPositionsZ) .AND. ALLOCATED(y1%MsrPositionsZ)) THEN - DO i1 = LBOUND(y_out%MsrPositionsZ,1),UBOUND(y_out%MsrPositionsZ,1) - b = -(y1%MsrPositionsZ(i1) - y2%MsrPositionsZ(i1)) - y_out%MsrPositionsZ(i1) = y1%MsrPositionsZ(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE Lidar_Output_ExtrapInterp1 - - - SUBROUTINE Lidar_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%LidSpeed) .AND. ALLOCATED(y1%LidSpeed)) THEN + y_out%LidSpeed = a1*y1%LidSpeed + a2*y2%LidSpeed + END IF ! check if allocated + IF (ALLOCATED(y_out%WtTrunc) .AND. ALLOCATED(y1%WtTrunc)) THEN + y_out%WtTrunc = a1*y1%WtTrunc + a2*y2%WtTrunc + END IF ! check if allocated + IF (ALLOCATED(y_out%MsrPositionsX) .AND. ALLOCATED(y1%MsrPositionsX)) THEN + y_out%MsrPositionsX = a1*y1%MsrPositionsX + a2*y2%MsrPositionsX + END IF ! check if allocated + IF (ALLOCATED(y_out%MsrPositionsY) .AND. ALLOCATED(y1%MsrPositionsY)) THEN + y_out%MsrPositionsY = a1*y1%MsrPositionsY + a2*y2%MsrPositionsY + END IF ! check if allocated + IF (ALLOCATED(y_out%MsrPositionsZ) .AND. ALLOCATED(y1%MsrPositionsZ)) THEN + y_out%MsrPositionsZ = a1*y1%MsrPositionsZ + a2*y2%MsrPositionsZ + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE Lidar_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 2. @@ -1255,82 +1229,62 @@ SUBROUTINE Lidar_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ! !.................................................................................................................................. - TYPE(Lidar_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 - TYPE(Lidar_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 - TYPE(Lidar_OutputType), INTENT(IN) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(Lidar_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(Lidar_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 + TYPE(Lidar_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 + TYPE(Lidar_OutputType), INTENT(IN) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(Lidar_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) -IF (ALLOCATED(y_out%LidSpeed) .AND. ALLOCATED(y1%LidSpeed)) THEN - DO i1 = LBOUND(y_out%LidSpeed,1),UBOUND(y_out%LidSpeed,1) - b = (t(3)**2*(y1%LidSpeed(i1) - y2%LidSpeed(i1)) + t(2)**2*(-y1%LidSpeed(i1) + y3%LidSpeed(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%LidSpeed(i1) + t(3)*y2%LidSpeed(i1) - t(2)*y3%LidSpeed(i1) ) * scaleFactor - y_out%LidSpeed(i1) = y1%LidSpeed(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%WtTrunc) .AND. ALLOCATED(y1%WtTrunc)) THEN - DO i1 = LBOUND(y_out%WtTrunc,1),UBOUND(y_out%WtTrunc,1) - b = (t(3)**2*(y1%WtTrunc(i1) - y2%WtTrunc(i1)) + t(2)**2*(-y1%WtTrunc(i1) + y3%WtTrunc(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%WtTrunc(i1) + t(3)*y2%WtTrunc(i1) - t(2)*y3%WtTrunc(i1) ) * scaleFactor - y_out%WtTrunc(i1) = y1%WtTrunc(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%MsrPositionsX) .AND. ALLOCATED(y1%MsrPositionsX)) THEN - DO i1 = LBOUND(y_out%MsrPositionsX,1),UBOUND(y_out%MsrPositionsX,1) - b = (t(3)**2*(y1%MsrPositionsX(i1) - y2%MsrPositionsX(i1)) + t(2)**2*(-y1%MsrPositionsX(i1) + y3%MsrPositionsX(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%MsrPositionsX(i1) + t(3)*y2%MsrPositionsX(i1) - t(2)*y3%MsrPositionsX(i1) ) * scaleFactor - y_out%MsrPositionsX(i1) = y1%MsrPositionsX(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%MsrPositionsY) .AND. ALLOCATED(y1%MsrPositionsY)) THEN - DO i1 = LBOUND(y_out%MsrPositionsY,1),UBOUND(y_out%MsrPositionsY,1) - b = (t(3)**2*(y1%MsrPositionsY(i1) - y2%MsrPositionsY(i1)) + t(2)**2*(-y1%MsrPositionsY(i1) + y3%MsrPositionsY(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%MsrPositionsY(i1) + t(3)*y2%MsrPositionsY(i1) - t(2)*y3%MsrPositionsY(i1) ) * scaleFactor - y_out%MsrPositionsY(i1) = y1%MsrPositionsY(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%MsrPositionsZ) .AND. ALLOCATED(y1%MsrPositionsZ)) THEN - DO i1 = LBOUND(y_out%MsrPositionsZ,1),UBOUND(y_out%MsrPositionsZ,1) - b = (t(3)**2*(y1%MsrPositionsZ(i1) - y2%MsrPositionsZ(i1)) + t(2)**2*(-y1%MsrPositionsZ(i1) + y3%MsrPositionsZ(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%MsrPositionsZ(i1) + t(3)*y2%MsrPositionsZ(i1) - t(2)*y3%MsrPositionsZ(i1) ) * scaleFactor - y_out%MsrPositionsZ(i1) = y1%MsrPositionsZ(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE Lidar_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%LidSpeed) .AND. ALLOCATED(y1%LidSpeed)) THEN + y_out%LidSpeed = a1*y1%LidSpeed + a2*y2%LidSpeed + a3*y3%LidSpeed + END IF ! check if allocated + IF (ALLOCATED(y_out%WtTrunc) .AND. ALLOCATED(y1%WtTrunc)) THEN + y_out%WtTrunc = a1*y1%WtTrunc + a2*y2%WtTrunc + a3*y3%WtTrunc + END IF ! check if allocated + IF (ALLOCATED(y_out%MsrPositionsX) .AND. ALLOCATED(y1%MsrPositionsX)) THEN + y_out%MsrPositionsX = a1*y1%MsrPositionsX + a2*y2%MsrPositionsX + a3*y3%MsrPositionsX + END IF ! check if allocated + IF (ALLOCATED(y_out%MsrPositionsY) .AND. ALLOCATED(y1%MsrPositionsY)) THEN + y_out%MsrPositionsY = a1*y1%MsrPositionsY + a2*y2%MsrPositionsY + a3*y3%MsrPositionsY + END IF ! check if allocated + IF (ALLOCATED(y_out%MsrPositionsZ) .AND. ALLOCATED(y1%MsrPositionsZ)) THEN + y_out%MsrPositionsZ = a1*y1%MsrPositionsZ + a2*y2%MsrPositionsZ + a3*y3%MsrPositionsZ + END IF ! check if allocated +END SUBROUTINE END MODULE Lidar_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/map/src/MAP_Types.f90 b/modules/map/src/MAP_Types.f90 index 3dac702373..3df4cf9291 100644 --- a/modules/map/src/MAP_Types.f90 +++ b/modules/map/src/MAP_Types.f90 @@ -350,58 +350,58 @@ subroutine MAP_UnPackInitInput(Buf, OutData) OutData%C_obj%option_input_str = transfer(OutData%option_input_str, OutData%C_obj%option_input_str ) call MAP_Fortran_UnpackLin_InitInputType(Buf, OutData%LinInitInp) ! LinInitInp end subroutine - SUBROUTINE MAP_C2Fary_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - InitInputData%gravity = InitInputData%C_obj%gravity - InitInputData%sea_density = InitInputData%C_obj%sea_density - InitInputData%depth = InitInputData%C_obj%depth - InitInputData%file_name = TRANSFER(InitInputData%C_obj%file_name, InitInputData%file_name ) - InitInputData%summary_file_name = TRANSFER(InitInputData%C_obj%summary_file_name, InitInputData%summary_file_name ) - InitInputData%library_input_str = TRANSFER(InitInputData%C_obj%library_input_str, InitInputData%library_input_str ) - InitInputData%node_input_str = TRANSFER(InitInputData%C_obj%node_input_str, InitInputData%node_input_str ) - InitInputData%line_input_str = TRANSFER(InitInputData%C_obj%line_input_str, InitInputData%line_input_str ) - InitInputData%option_input_str = TRANSFER(InitInputData%C_obj%option_input_str, InitInputData%option_input_str ) - END SUBROUTINE MAP_C2Fary_CopyInitInput - - SUBROUTINE MAP_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - InitInputData%C_obj%gravity = InitInputData%gravity - InitInputData%C_obj%sea_density = InitInputData%sea_density - InitInputData%C_obj%depth = InitInputData%depth - InitInputData%C_obj%file_name = TRANSFER(InitInputData%file_name, InitInputData%C_obj%file_name ) - InitInputData%C_obj%summary_file_name = TRANSFER(InitInputData%summary_file_name, InitInputData%C_obj%summary_file_name ) - InitInputData%C_obj%library_input_str = TRANSFER(InitInputData%library_input_str, InitInputData%C_obj%library_input_str ) - InitInputData%C_obj%node_input_str = TRANSFER(InitInputData%node_input_str, InitInputData%C_obj%node_input_str ) - InitInputData%C_obj%line_input_str = TRANSFER(InitInputData%line_input_str, InitInputData%C_obj%line_input_str ) - InitInputData%C_obj%option_input_str = TRANSFER(InitInputData%option_input_str, InitInputData%C_obj%option_input_str ) - END SUBROUTINE MAP_F2C_CopyInitInput +SUBROUTINE MAP_C2Fary_CopyInitInput(InitInputData, ErrStat, ErrMsg, SkipPointers) + TYPE(MAP_InitInputType), INTENT(INOUT) :: InitInputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + InitInputData%gravity = InitInputData%C_obj%gravity + InitInputData%sea_density = InitInputData%C_obj%sea_density + InitInputData%depth = InitInputData%C_obj%depth + InitInputData%file_name = TRANSFER(InitInputData%C_obj%file_name, InitInputData%file_name ) + InitInputData%summary_file_name = TRANSFER(InitInputData%C_obj%summary_file_name, InitInputData%summary_file_name ) + InitInputData%library_input_str = TRANSFER(InitInputData%C_obj%library_input_str, InitInputData%library_input_str ) + InitInputData%node_input_str = TRANSFER(InitInputData%C_obj%node_input_str, InitInputData%node_input_str ) + InitInputData%line_input_str = TRANSFER(InitInputData%C_obj%line_input_str, InitInputData%line_input_str ) + InitInputData%option_input_str = TRANSFER(InitInputData%C_obj%option_input_str, InitInputData%option_input_str ) +END SUBROUTINE + +SUBROUTINE MAP_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_InitInputType), INTENT(INOUT) :: InitInputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + InitInputData%C_obj%gravity = InitInputData%gravity + InitInputData%C_obj%sea_density = InitInputData%sea_density + InitInputData%C_obj%depth = InitInputData%depth + InitInputData%C_obj%file_name = TRANSFER(InitInputData%file_name, InitInputData%C_obj%file_name) + InitInputData%C_obj%summary_file_name = TRANSFER(InitInputData%summary_file_name, InitInputData%C_obj%summary_file_name) + InitInputData%C_obj%library_input_str = TRANSFER(InitInputData%library_input_str, InitInputData%C_obj%library_input_str) + InitInputData%C_obj%node_input_str = TRANSFER(InitInputData%node_input_str, InitInputData%C_obj%node_input_str) + InitInputData%C_obj%line_input_str = TRANSFER(InitInputData%line_input_str, InitInputData%C_obj%line_input_str) + InitInputData%C_obj%option_input_str = TRANSFER(InitInputData%option_input_str, InitInputData%C_obj%option_input_str) +END SUBROUTINE subroutine MAP_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) type(MAP_InitOutputType), intent(in) :: SrcInitOutputData @@ -549,46 +549,46 @@ subroutine MAP_UnPackInitOutput(Buf, OutData) call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver call MAP_Fortran_UnpackLin_InitOutputType(Buf, OutData%LinInitOut) ! LinInitOut end subroutine - SUBROUTINE MAP_C2Fary_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - InitOutputData%progName = TRANSFER(InitOutputData%C_obj%progName, InitOutputData%progName ) - InitOutputData%version = TRANSFER(InitOutputData%C_obj%version, InitOutputData%version ) - InitOutputData%compilingData = TRANSFER(InitOutputData%C_obj%compilingData, InitOutputData%compilingData ) - END SUBROUTINE MAP_C2Fary_CopyInitOutput - - SUBROUTINE MAP_F2C_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - InitOutputData%C_obj%progName = TRANSFER(InitOutputData%progName, InitOutputData%C_obj%progName ) - InitOutputData%C_obj%version = TRANSFER(InitOutputData%version, InitOutputData%C_obj%version ) - InitOutputData%C_obj%compilingData = TRANSFER(InitOutputData%compilingData, InitOutputData%C_obj%compilingData ) - END SUBROUTINE MAP_F2C_CopyInitOutput +SUBROUTINE MAP_C2Fary_CopyInitOutput(InitOutputData, ErrStat, ErrMsg, SkipPointers) + TYPE(MAP_InitOutputType), INTENT(INOUT) :: InitOutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + InitOutputData%progName = TRANSFER(InitOutputData%C_obj%progName, InitOutputData%progName ) + InitOutputData%version = TRANSFER(InitOutputData%C_obj%version, InitOutputData%version ) + InitOutputData%compilingData = TRANSFER(InitOutputData%C_obj%compilingData, InitOutputData%compilingData ) +END SUBROUTINE + +SUBROUTINE MAP_F2C_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_InitOutputType), INTENT(INOUT) :: InitOutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + InitOutputData%C_obj%progName = TRANSFER(InitOutputData%progName, InitOutputData%C_obj%progName) + InitOutputData%C_obj%version = TRANSFER(InitOutputData%version, InitOutputData%C_obj%version) + InitOutputData%C_obj%compilingData = TRANSFER(InitOutputData%compilingData, InitOutputData%C_obj%compilingData) +END SUBROUTINE subroutine MAP_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) type(MAP_ContinuousStateType), intent(in) :: SrcContStateData @@ -634,42 +634,42 @@ subroutine MAP_UnPackContState(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%dummy = OutData%dummy end subroutine - SUBROUTINE MAP_C2Fary_CopyContState( ContStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - ContStateData%dummy = ContStateData%C_obj%dummy - END SUBROUTINE MAP_C2Fary_CopyContState - - SUBROUTINE MAP_F2C_CopyContState( ContStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - ContStateData%C_obj%dummy = ContStateData%dummy - END SUBROUTINE MAP_F2C_CopyContState +SUBROUTINE MAP_C2Fary_CopyContState(ContStateData, ErrStat, ErrMsg, SkipPointers) + TYPE(MAP_ContinuousStateType), INTENT(INOUT) :: ContStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + ContStateData%dummy = ContStateData%C_obj%dummy +END SUBROUTINE + +SUBROUTINE MAP_F2C_CopyContState( ContStateData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_ContinuousStateType), INTENT(INOUT) :: ContStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + ContStateData%C_obj%dummy = ContStateData%dummy +END SUBROUTINE subroutine MAP_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) type(MAP_DiscreteStateType), intent(in) :: SrcDiscStateData @@ -715,42 +715,42 @@ subroutine MAP_UnPackDiscState(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%dummy = OutData%dummy end subroutine - SUBROUTINE MAP_C2Fary_CopyDiscState( DiscStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - DiscStateData%dummy = DiscStateData%C_obj%dummy - END SUBROUTINE MAP_C2Fary_CopyDiscState - - SUBROUTINE MAP_F2C_CopyDiscState( DiscStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - DiscStateData%C_obj%dummy = DiscStateData%dummy - END SUBROUTINE MAP_F2C_CopyDiscState +SUBROUTINE MAP_C2Fary_CopyDiscState(DiscStateData, ErrStat, ErrMsg, SkipPointers) + TYPE(MAP_DiscreteStateType), INTENT(INOUT) :: DiscStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + DiscStateData%dummy = DiscStateData%C_obj%dummy +END SUBROUTINE + +SUBROUTINE MAP_F2C_CopyDiscState( DiscStateData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_DiscreteStateType), INTENT(INOUT) :: DiscStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + DiscStateData%C_obj%dummy = DiscStateData%dummy +END SUBROUTINE subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) type(MAP_OtherStateType), intent(in) :: SrcOtherStateData @@ -1678,376 +1678,376 @@ subroutine MAP_UnPackOtherState(Buf, OutData) OutData%Fz_anchor => null() end if end subroutine - SUBROUTINE MAP_C2Fary_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- H OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%H ) ) THEN - NULLIFY( OtherStateData%H ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%H, OtherStateData%H, (/OtherStateData%C_obj%H_Len/)) - END IF - END IF - - ! -- V OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%V ) ) THEN - NULLIFY( OtherStateData%V ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%V, OtherStateData%V, (/OtherStateData%C_obj%V_Len/)) - END IF - END IF - - ! -- Ha OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Ha ) ) THEN - NULLIFY( OtherStateData%Ha ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Ha, OtherStateData%Ha, (/OtherStateData%C_obj%Ha_Len/)) - END IF - END IF - - ! -- Va OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Va ) ) THEN - NULLIFY( OtherStateData%Va ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Va, OtherStateData%Va, (/OtherStateData%C_obj%Va_Len/)) - END IF - END IF - - ! -- x OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%x ) ) THEN - NULLIFY( OtherStateData%x ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%x, OtherStateData%x, (/OtherStateData%C_obj%x_Len/)) - END IF - END IF - - ! -- y OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%y ) ) THEN - NULLIFY( OtherStateData%y ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%y, OtherStateData%y, (/OtherStateData%C_obj%y_Len/)) - END IF - END IF - - ! -- z OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%z ) ) THEN - NULLIFY( OtherStateData%z ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%z, OtherStateData%z, (/OtherStateData%C_obj%z_Len/)) - END IF - END IF - - ! -- xa OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%xa ) ) THEN - NULLIFY( OtherStateData%xa ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%xa, OtherStateData%xa, (/OtherStateData%C_obj%xa_Len/)) - END IF - END IF - - ! -- ya OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%ya ) ) THEN - NULLIFY( OtherStateData%ya ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%ya, OtherStateData%ya, (/OtherStateData%C_obj%ya_Len/)) - END IF - END IF - - ! -- za OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%za ) ) THEN - NULLIFY( OtherStateData%za ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%za, OtherStateData%za, (/OtherStateData%C_obj%za_Len/)) - END IF - END IF - - ! -- Fx_connect OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fx_connect ) ) THEN - NULLIFY( OtherStateData%Fx_connect ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Fx_connect, OtherStateData%Fx_connect, (/OtherStateData%C_obj%Fx_connect_Len/)) - END IF - END IF - - ! -- Fy_connect OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fy_connect ) ) THEN - NULLIFY( OtherStateData%Fy_connect ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Fy_connect, OtherStateData%Fy_connect, (/OtherStateData%C_obj%Fy_connect_Len/)) - END IF - END IF - - ! -- Fz_connect OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fz_connect ) ) THEN - NULLIFY( OtherStateData%Fz_connect ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Fz_connect, OtherStateData%Fz_connect, (/OtherStateData%C_obj%Fz_connect_Len/)) - END IF - END IF - - ! -- Fx_anchor OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fx_anchor ) ) THEN - NULLIFY( OtherStateData%Fx_anchor ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Fx_anchor, OtherStateData%Fx_anchor, (/OtherStateData%C_obj%Fx_anchor_Len/)) - END IF - END IF - - ! -- Fy_anchor OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fy_anchor ) ) THEN - NULLIFY( OtherStateData%Fy_anchor ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Fy_anchor, OtherStateData%Fy_anchor, (/OtherStateData%C_obj%Fy_anchor_Len/)) - END IF - END IF - - ! -- Fz_anchor OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fz_anchor ) ) THEN - NULLIFY( OtherStateData%Fz_anchor ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Fz_anchor, OtherStateData%Fz_anchor, (/OtherStateData%C_obj%Fz_anchor_Len/)) - END IF - END IF - END SUBROUTINE MAP_C2Fary_CopyOtherState - - SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- H OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OtherStateData%H)) THEN - OtherStateData%C_obj%H_Len = 0 - OtherStateData%C_obj%H = C_NULL_PTR - ELSE - OtherStateData%C_obj%H_Len = SIZE(OtherStateData%H) - IF (OtherStateData%C_obj%H_Len > 0) & - OtherStateData%C_obj%H = C_LOC( OtherStateData%H( LBOUND(OtherStateData%H,1) ) ) - END IF - END IF - - ! -- V OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OtherStateData%V)) THEN - OtherStateData%C_obj%V_Len = 0 - OtherStateData%C_obj%V = C_NULL_PTR - ELSE - OtherStateData%C_obj%V_Len = SIZE(OtherStateData%V) - IF (OtherStateData%C_obj%V_Len > 0) & - OtherStateData%C_obj%V = C_LOC( OtherStateData%V( LBOUND(OtherStateData%V,1) ) ) - END IF - END IF - - ! -- Ha OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OtherStateData%Ha)) THEN - OtherStateData%C_obj%Ha_Len = 0 - OtherStateData%C_obj%Ha = C_NULL_PTR - ELSE - OtherStateData%C_obj%Ha_Len = SIZE(OtherStateData%Ha) - IF (OtherStateData%C_obj%Ha_Len > 0) & - OtherStateData%C_obj%Ha = C_LOC( OtherStateData%Ha( LBOUND(OtherStateData%Ha,1) ) ) - END IF - END IF - - ! -- Va OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OtherStateData%Va)) THEN - OtherStateData%C_obj%Va_Len = 0 - OtherStateData%C_obj%Va = C_NULL_PTR - ELSE - OtherStateData%C_obj%Va_Len = SIZE(OtherStateData%Va) - IF (OtherStateData%C_obj%Va_Len > 0) & - OtherStateData%C_obj%Va = C_LOC( OtherStateData%Va( LBOUND(OtherStateData%Va,1) ) ) - END IF - END IF - - ! -- x OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OtherStateData%x)) THEN - OtherStateData%C_obj%x_Len = 0 - OtherStateData%C_obj%x = C_NULL_PTR - ELSE - OtherStateData%C_obj%x_Len = SIZE(OtherStateData%x) - IF (OtherStateData%C_obj%x_Len > 0) & - OtherStateData%C_obj%x = C_LOC( OtherStateData%x( LBOUND(OtherStateData%x,1) ) ) - END IF - END IF - - ! -- y OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OtherStateData%y)) THEN - OtherStateData%C_obj%y_Len = 0 - OtherStateData%C_obj%y = C_NULL_PTR - ELSE - OtherStateData%C_obj%y_Len = SIZE(OtherStateData%y) - IF (OtherStateData%C_obj%y_Len > 0) & - OtherStateData%C_obj%y = C_LOC( OtherStateData%y( LBOUND(OtherStateData%y,1) ) ) - END IF - END IF - - ! -- z OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OtherStateData%z)) THEN - OtherStateData%C_obj%z_Len = 0 - OtherStateData%C_obj%z = C_NULL_PTR - ELSE - OtherStateData%C_obj%z_Len = SIZE(OtherStateData%z) - IF (OtherStateData%C_obj%z_Len > 0) & - OtherStateData%C_obj%z = C_LOC( OtherStateData%z( LBOUND(OtherStateData%z,1) ) ) - END IF - END IF - - ! -- xa OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OtherStateData%xa)) THEN - OtherStateData%C_obj%xa_Len = 0 - OtherStateData%C_obj%xa = C_NULL_PTR - ELSE - OtherStateData%C_obj%xa_Len = SIZE(OtherStateData%xa) - IF (OtherStateData%C_obj%xa_Len > 0) & - OtherStateData%C_obj%xa = C_LOC( OtherStateData%xa( LBOUND(OtherStateData%xa,1) ) ) - END IF - END IF - - ! -- ya OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OtherStateData%ya)) THEN - OtherStateData%C_obj%ya_Len = 0 - OtherStateData%C_obj%ya = C_NULL_PTR - ELSE - OtherStateData%C_obj%ya_Len = SIZE(OtherStateData%ya) - IF (OtherStateData%C_obj%ya_Len > 0) & - OtherStateData%C_obj%ya = C_LOC( OtherStateData%ya( LBOUND(OtherStateData%ya,1) ) ) - END IF - END IF - - ! -- za OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OtherStateData%za)) THEN - OtherStateData%C_obj%za_Len = 0 - OtherStateData%C_obj%za = C_NULL_PTR - ELSE - OtherStateData%C_obj%za_Len = SIZE(OtherStateData%za) - IF (OtherStateData%C_obj%za_Len > 0) & - OtherStateData%C_obj%za = C_LOC( OtherStateData%za( LBOUND(OtherStateData%za,1) ) ) - END IF - END IF - - ! -- Fx_connect OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OtherStateData%Fx_connect)) THEN - OtherStateData%C_obj%Fx_connect_Len = 0 - OtherStateData%C_obj%Fx_connect = C_NULL_PTR - ELSE - OtherStateData%C_obj%Fx_connect_Len = SIZE(OtherStateData%Fx_connect) - IF (OtherStateData%C_obj%Fx_connect_Len > 0) & - OtherStateData%C_obj%Fx_connect = C_LOC( OtherStateData%Fx_connect( LBOUND(OtherStateData%Fx_connect,1) ) ) - END IF - END IF - - ! -- Fy_connect OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OtherStateData%Fy_connect)) THEN - OtherStateData%C_obj%Fy_connect_Len = 0 - OtherStateData%C_obj%Fy_connect = C_NULL_PTR - ELSE - OtherStateData%C_obj%Fy_connect_Len = SIZE(OtherStateData%Fy_connect) - IF (OtherStateData%C_obj%Fy_connect_Len > 0) & - OtherStateData%C_obj%Fy_connect = C_LOC( OtherStateData%Fy_connect( LBOUND(OtherStateData%Fy_connect,1) ) ) - END IF - END IF - - ! -- Fz_connect OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OtherStateData%Fz_connect)) THEN - OtherStateData%C_obj%Fz_connect_Len = 0 - OtherStateData%C_obj%Fz_connect = C_NULL_PTR - ELSE - OtherStateData%C_obj%Fz_connect_Len = SIZE(OtherStateData%Fz_connect) - IF (OtherStateData%C_obj%Fz_connect_Len > 0) & - OtherStateData%C_obj%Fz_connect = C_LOC( OtherStateData%Fz_connect( LBOUND(OtherStateData%Fz_connect,1) ) ) - END IF - END IF - - ! -- Fx_anchor OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OtherStateData%Fx_anchor)) THEN - OtherStateData%C_obj%Fx_anchor_Len = 0 - OtherStateData%C_obj%Fx_anchor = C_NULL_PTR - ELSE - OtherStateData%C_obj%Fx_anchor_Len = SIZE(OtherStateData%Fx_anchor) - IF (OtherStateData%C_obj%Fx_anchor_Len > 0) & - OtherStateData%C_obj%Fx_anchor = C_LOC( OtherStateData%Fx_anchor( LBOUND(OtherStateData%Fx_anchor,1) ) ) - END IF - END IF - - ! -- Fy_anchor OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OtherStateData%Fy_anchor)) THEN - OtherStateData%C_obj%Fy_anchor_Len = 0 - OtherStateData%C_obj%Fy_anchor = C_NULL_PTR - ELSE - OtherStateData%C_obj%Fy_anchor_Len = SIZE(OtherStateData%Fy_anchor) - IF (OtherStateData%C_obj%Fy_anchor_Len > 0) & - OtherStateData%C_obj%Fy_anchor = C_LOC( OtherStateData%Fy_anchor( LBOUND(OtherStateData%Fy_anchor,1) ) ) - END IF - END IF - - ! -- Fz_anchor OtherState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OtherStateData%Fz_anchor)) THEN - OtherStateData%C_obj%Fz_anchor_Len = 0 - OtherStateData%C_obj%Fz_anchor = C_NULL_PTR - ELSE - OtherStateData%C_obj%Fz_anchor_Len = SIZE(OtherStateData%Fz_anchor) - IF (OtherStateData%C_obj%Fz_anchor_Len > 0) & - OtherStateData%C_obj%Fz_anchor = C_LOC( OtherStateData%Fz_anchor( LBOUND(OtherStateData%Fz_anchor,1) ) ) - END IF - END IF - END SUBROUTINE MAP_F2C_CopyOtherState +SUBROUTINE MAP_C2Fary_CopyOtherState(OtherStateData, ErrStat, ErrMsg, SkipPointers) + TYPE(MAP_OtherStateType), INTENT(INOUT) :: OtherStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- H OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%H ) ) THEN + NULLIFY( OtherStateData%H ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%H, OtherStateData%H, [OtherStateData%C_obj%H_Len]) + END IF + END IF + + ! -- V OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%V ) ) THEN + NULLIFY( OtherStateData%V ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%V, OtherStateData%V, [OtherStateData%C_obj%V_Len]) + END IF + END IF + + ! -- Ha OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Ha ) ) THEN + NULLIFY( OtherStateData%Ha ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%Ha, OtherStateData%Ha, [OtherStateData%C_obj%Ha_Len]) + END IF + END IF + + ! -- Va OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Va ) ) THEN + NULLIFY( OtherStateData%Va ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%Va, OtherStateData%Va, [OtherStateData%C_obj%Va_Len]) + END IF + END IF + + ! -- x OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%x ) ) THEN + NULLIFY( OtherStateData%x ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%x, OtherStateData%x, [OtherStateData%C_obj%x_Len]) + END IF + END IF + + ! -- y OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%y ) ) THEN + NULLIFY( OtherStateData%y ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%y, OtherStateData%y, [OtherStateData%C_obj%y_Len]) + END IF + END IF + + ! -- z OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%z ) ) THEN + NULLIFY( OtherStateData%z ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%z, OtherStateData%z, [OtherStateData%C_obj%z_Len]) + END IF + END IF + + ! -- xa OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%xa ) ) THEN + NULLIFY( OtherStateData%xa ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%xa, OtherStateData%xa, [OtherStateData%C_obj%xa_Len]) + END IF + END IF + + ! -- ya OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%ya ) ) THEN + NULLIFY( OtherStateData%ya ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%ya, OtherStateData%ya, [OtherStateData%C_obj%ya_Len]) + END IF + END IF + + ! -- za OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%za ) ) THEN + NULLIFY( OtherStateData%za ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%za, OtherStateData%za, [OtherStateData%C_obj%za_Len]) + END IF + END IF + + ! -- Fx_connect OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fx_connect ) ) THEN + NULLIFY( OtherStateData%Fx_connect ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%Fx_connect, OtherStateData%Fx_connect, [OtherStateData%C_obj%Fx_connect_Len]) + END IF + END IF + + ! -- Fy_connect OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fy_connect ) ) THEN + NULLIFY( OtherStateData%Fy_connect ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%Fy_connect, OtherStateData%Fy_connect, [OtherStateData%C_obj%Fy_connect_Len]) + END IF + END IF + + ! -- Fz_connect OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fz_connect ) ) THEN + NULLIFY( OtherStateData%Fz_connect ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%Fz_connect, OtherStateData%Fz_connect, [OtherStateData%C_obj%Fz_connect_Len]) + END IF + END IF + + ! -- Fx_anchor OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fx_anchor ) ) THEN + NULLIFY( OtherStateData%Fx_anchor ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%Fx_anchor, OtherStateData%Fx_anchor, [OtherStateData%C_obj%Fx_anchor_Len]) + END IF + END IF + + ! -- Fy_anchor OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fy_anchor ) ) THEN + NULLIFY( OtherStateData%Fy_anchor ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%Fy_anchor, OtherStateData%Fy_anchor, [OtherStateData%C_obj%Fy_anchor_Len]) + END IF + END IF + + ! -- Fz_anchor OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fz_anchor ) ) THEN + NULLIFY( OtherStateData%Fz_anchor ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%Fz_anchor, OtherStateData%Fz_anchor, [OtherStateData%C_obj%Fz_anchor_Len]) + END IF + END IF +END SUBROUTINE + +SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_OtherStateType), INTENT(INOUT) :: OtherStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- H OtherState Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OtherStateData%H)) THEN + OtherStateData%C_obj%H_Len = 0 + OtherStateData%C_obj%H = C_NULL_PTR + ELSE + OtherStateData%C_obj%H_Len = SIZE(OtherStateData%H) + IF (OtherStateData%C_obj%H_Len > 0) & + OtherStateData%C_obj%H = C_LOC(OtherStateData%H(LBOUND(OtherStateData%H,1))) + END IF + END IF + + ! -- V OtherState Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OtherStateData%V)) THEN + OtherStateData%C_obj%V_Len = 0 + OtherStateData%C_obj%V = C_NULL_PTR + ELSE + OtherStateData%C_obj%V_Len = SIZE(OtherStateData%V) + IF (OtherStateData%C_obj%V_Len > 0) & + OtherStateData%C_obj%V = C_LOC(OtherStateData%V(LBOUND(OtherStateData%V,1))) + END IF + END IF + + ! -- Ha OtherState Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OtherStateData%Ha)) THEN + OtherStateData%C_obj%Ha_Len = 0 + OtherStateData%C_obj%Ha = C_NULL_PTR + ELSE + OtherStateData%C_obj%Ha_Len = SIZE(OtherStateData%Ha) + IF (OtherStateData%C_obj%Ha_Len > 0) & + OtherStateData%C_obj%Ha = C_LOC(OtherStateData%Ha(LBOUND(OtherStateData%Ha,1))) + END IF + END IF + + ! -- Va OtherState Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OtherStateData%Va)) THEN + OtherStateData%C_obj%Va_Len = 0 + OtherStateData%C_obj%Va = C_NULL_PTR + ELSE + OtherStateData%C_obj%Va_Len = SIZE(OtherStateData%Va) + IF (OtherStateData%C_obj%Va_Len > 0) & + OtherStateData%C_obj%Va = C_LOC(OtherStateData%Va(LBOUND(OtherStateData%Va,1))) + END IF + END IF + + ! -- x OtherState Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OtherStateData%x)) THEN + OtherStateData%C_obj%x_Len = 0 + OtherStateData%C_obj%x = C_NULL_PTR + ELSE + OtherStateData%C_obj%x_Len = SIZE(OtherStateData%x) + IF (OtherStateData%C_obj%x_Len > 0) & + OtherStateData%C_obj%x = C_LOC(OtherStateData%x(LBOUND(OtherStateData%x,1))) + END IF + END IF + + ! -- y OtherState Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OtherStateData%y)) THEN + OtherStateData%C_obj%y_Len = 0 + OtherStateData%C_obj%y = C_NULL_PTR + ELSE + OtherStateData%C_obj%y_Len = SIZE(OtherStateData%y) + IF (OtherStateData%C_obj%y_Len > 0) & + OtherStateData%C_obj%y = C_LOC(OtherStateData%y(LBOUND(OtherStateData%y,1))) + END IF + END IF + + ! -- z OtherState Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OtherStateData%z)) THEN + OtherStateData%C_obj%z_Len = 0 + OtherStateData%C_obj%z = C_NULL_PTR + ELSE + OtherStateData%C_obj%z_Len = SIZE(OtherStateData%z) + IF (OtherStateData%C_obj%z_Len > 0) & + OtherStateData%C_obj%z = C_LOC(OtherStateData%z(LBOUND(OtherStateData%z,1))) + END IF + END IF + + ! -- xa OtherState Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OtherStateData%xa)) THEN + OtherStateData%C_obj%xa_Len = 0 + OtherStateData%C_obj%xa = C_NULL_PTR + ELSE + OtherStateData%C_obj%xa_Len = SIZE(OtherStateData%xa) + IF (OtherStateData%C_obj%xa_Len > 0) & + OtherStateData%C_obj%xa = C_LOC(OtherStateData%xa(LBOUND(OtherStateData%xa,1))) + END IF + END IF + + ! -- ya OtherState Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OtherStateData%ya)) THEN + OtherStateData%C_obj%ya_Len = 0 + OtherStateData%C_obj%ya = C_NULL_PTR + ELSE + OtherStateData%C_obj%ya_Len = SIZE(OtherStateData%ya) + IF (OtherStateData%C_obj%ya_Len > 0) & + OtherStateData%C_obj%ya = C_LOC(OtherStateData%ya(LBOUND(OtherStateData%ya,1))) + END IF + END IF + + ! -- za OtherState Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OtherStateData%za)) THEN + OtherStateData%C_obj%za_Len = 0 + OtherStateData%C_obj%za = C_NULL_PTR + ELSE + OtherStateData%C_obj%za_Len = SIZE(OtherStateData%za) + IF (OtherStateData%C_obj%za_Len > 0) & + OtherStateData%C_obj%za = C_LOC(OtherStateData%za(LBOUND(OtherStateData%za,1))) + END IF + END IF + + ! -- Fx_connect OtherState Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OtherStateData%Fx_connect)) THEN + OtherStateData%C_obj%Fx_connect_Len = 0 + OtherStateData%C_obj%Fx_connect = C_NULL_PTR + ELSE + OtherStateData%C_obj%Fx_connect_Len = SIZE(OtherStateData%Fx_connect) + IF (OtherStateData%C_obj%Fx_connect_Len > 0) & + OtherStateData%C_obj%Fx_connect = C_LOC(OtherStateData%Fx_connect(LBOUND(OtherStateData%Fx_connect,1))) + END IF + END IF + + ! -- Fy_connect OtherState Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OtherStateData%Fy_connect)) THEN + OtherStateData%C_obj%Fy_connect_Len = 0 + OtherStateData%C_obj%Fy_connect = C_NULL_PTR + ELSE + OtherStateData%C_obj%Fy_connect_Len = SIZE(OtherStateData%Fy_connect) + IF (OtherStateData%C_obj%Fy_connect_Len > 0) & + OtherStateData%C_obj%Fy_connect = C_LOC(OtherStateData%Fy_connect(LBOUND(OtherStateData%Fy_connect,1))) + END IF + END IF + + ! -- Fz_connect OtherState Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OtherStateData%Fz_connect)) THEN + OtherStateData%C_obj%Fz_connect_Len = 0 + OtherStateData%C_obj%Fz_connect = C_NULL_PTR + ELSE + OtherStateData%C_obj%Fz_connect_Len = SIZE(OtherStateData%Fz_connect) + IF (OtherStateData%C_obj%Fz_connect_Len > 0) & + OtherStateData%C_obj%Fz_connect = C_LOC(OtherStateData%Fz_connect(LBOUND(OtherStateData%Fz_connect,1))) + END IF + END IF + + ! -- Fx_anchor OtherState Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OtherStateData%Fx_anchor)) THEN + OtherStateData%C_obj%Fx_anchor_Len = 0 + OtherStateData%C_obj%Fx_anchor = C_NULL_PTR + ELSE + OtherStateData%C_obj%Fx_anchor_Len = SIZE(OtherStateData%Fx_anchor) + IF (OtherStateData%C_obj%Fx_anchor_Len > 0) & + OtherStateData%C_obj%Fx_anchor = C_LOC(OtherStateData%Fx_anchor(LBOUND(OtherStateData%Fx_anchor,1))) + END IF + END IF + + ! -- Fy_anchor OtherState Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OtherStateData%Fy_anchor)) THEN + OtherStateData%C_obj%Fy_anchor_Len = 0 + OtherStateData%C_obj%Fy_anchor = C_NULL_PTR + ELSE + OtherStateData%C_obj%Fy_anchor_Len = SIZE(OtherStateData%Fy_anchor) + IF (OtherStateData%C_obj%Fy_anchor_Len > 0) & + OtherStateData%C_obj%Fy_anchor = C_LOC(OtherStateData%Fy_anchor(LBOUND(OtherStateData%Fy_anchor,1))) + END IF + END IF + + ! -- Fz_anchor OtherState Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OtherStateData%Fz_anchor)) THEN + OtherStateData%C_obj%Fz_anchor_Len = 0 + OtherStateData%C_obj%Fz_anchor = C_NULL_PTR + ELSE + OtherStateData%C_obj%Fz_anchor_Len = SIZE(OtherStateData%Fz_anchor) + IF (OtherStateData%C_obj%Fz_anchor_Len > 0) & + OtherStateData%C_obj%Fz_anchor = C_LOC(OtherStateData%Fz_anchor(LBOUND(OtherStateData%Fz_anchor,1))) + END IF + END IF +END SUBROUTINE subroutine MAP_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) type(MAP_ConstraintStateType), intent(in) :: SrcConstrStateData @@ -2370,145 +2370,145 @@ subroutine MAP_UnPackConstrState(Buf, OutData) OutData%z => null() end if end subroutine - SUBROUTINE MAP_C2Fary_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- H ConstrState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%H ) ) THEN - NULLIFY( ConstrStateData%H ) - ELSE - CALL C_F_POINTER(ConstrStateData%C_obj%H, ConstrStateData%H, (/ConstrStateData%C_obj%H_Len/)) - END IF - END IF - - ! -- V ConstrState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%V ) ) THEN - NULLIFY( ConstrStateData%V ) - ELSE - CALL C_F_POINTER(ConstrStateData%C_obj%V, ConstrStateData%V, (/ConstrStateData%C_obj%V_Len/)) - END IF - END IF - - ! -- x ConstrState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%x ) ) THEN - NULLIFY( ConstrStateData%x ) - ELSE - CALL C_F_POINTER(ConstrStateData%C_obj%x, ConstrStateData%x, (/ConstrStateData%C_obj%x_Len/)) - END IF - END IF - - ! -- y ConstrState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%y ) ) THEN - NULLIFY( ConstrStateData%y ) - ELSE - CALL C_F_POINTER(ConstrStateData%C_obj%y, ConstrStateData%y, (/ConstrStateData%C_obj%y_Len/)) - END IF - END IF - - ! -- z ConstrState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%z ) ) THEN - NULLIFY( ConstrStateData%z ) - ELSE - CALL C_F_POINTER(ConstrStateData%C_obj%z, ConstrStateData%z, (/ConstrStateData%C_obj%z_Len/)) - END IF - END IF - END SUBROUTINE MAP_C2Fary_CopyConstrState - - SUBROUTINE MAP_F2C_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- H ConstrState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(ConstrStateData%H)) THEN - ConstrStateData%C_obj%H_Len = 0 - ConstrStateData%C_obj%H = C_NULL_PTR - ELSE - ConstrStateData%C_obj%H_Len = SIZE(ConstrStateData%H) - IF (ConstrStateData%C_obj%H_Len > 0) & - ConstrStateData%C_obj%H = C_LOC( ConstrStateData%H( LBOUND(ConstrStateData%H,1) ) ) - END IF - END IF - - ! -- V ConstrState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(ConstrStateData%V)) THEN - ConstrStateData%C_obj%V_Len = 0 - ConstrStateData%C_obj%V = C_NULL_PTR - ELSE - ConstrStateData%C_obj%V_Len = SIZE(ConstrStateData%V) - IF (ConstrStateData%C_obj%V_Len > 0) & - ConstrStateData%C_obj%V = C_LOC( ConstrStateData%V( LBOUND(ConstrStateData%V,1) ) ) - END IF - END IF - - ! -- x ConstrState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(ConstrStateData%x)) THEN - ConstrStateData%C_obj%x_Len = 0 - ConstrStateData%C_obj%x = C_NULL_PTR - ELSE - ConstrStateData%C_obj%x_Len = SIZE(ConstrStateData%x) - IF (ConstrStateData%C_obj%x_Len > 0) & - ConstrStateData%C_obj%x = C_LOC( ConstrStateData%x( LBOUND(ConstrStateData%x,1) ) ) - END IF - END IF - - ! -- y ConstrState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(ConstrStateData%y)) THEN - ConstrStateData%C_obj%y_Len = 0 - ConstrStateData%C_obj%y = C_NULL_PTR - ELSE - ConstrStateData%C_obj%y_Len = SIZE(ConstrStateData%y) - IF (ConstrStateData%C_obj%y_Len > 0) & - ConstrStateData%C_obj%y = C_LOC( ConstrStateData%y( LBOUND(ConstrStateData%y,1) ) ) - END IF - END IF - - ! -- z ConstrState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(ConstrStateData%z)) THEN - ConstrStateData%C_obj%z_Len = 0 - ConstrStateData%C_obj%z = C_NULL_PTR - ELSE - ConstrStateData%C_obj%z_Len = SIZE(ConstrStateData%z) - IF (ConstrStateData%C_obj%z_Len > 0) & - ConstrStateData%C_obj%z = C_LOC( ConstrStateData%z( LBOUND(ConstrStateData%z,1) ) ) - END IF - END IF - END SUBROUTINE MAP_F2C_CopyConstrState +SUBROUTINE MAP_C2Fary_CopyConstrState(ConstrStateData, ErrStat, ErrMsg, SkipPointers) + TYPE(MAP_ConstraintStateType), INTENT(INOUT) :: ConstrStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- H ConstrState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%H ) ) THEN + NULLIFY( ConstrStateData%H ) + ELSE + CALL C_F_POINTER(ConstrStateData%C_obj%H, ConstrStateData%H, [ConstrStateData%C_obj%H_Len]) + END IF + END IF + + ! -- V ConstrState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%V ) ) THEN + NULLIFY( ConstrStateData%V ) + ELSE + CALL C_F_POINTER(ConstrStateData%C_obj%V, ConstrStateData%V, [ConstrStateData%C_obj%V_Len]) + END IF + END IF + + ! -- x ConstrState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%x ) ) THEN + NULLIFY( ConstrStateData%x ) + ELSE + CALL C_F_POINTER(ConstrStateData%C_obj%x, ConstrStateData%x, [ConstrStateData%C_obj%x_Len]) + END IF + END IF + + ! -- y ConstrState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%y ) ) THEN + NULLIFY( ConstrStateData%y ) + ELSE + CALL C_F_POINTER(ConstrStateData%C_obj%y, ConstrStateData%y, [ConstrStateData%C_obj%y_Len]) + END IF + END IF + + ! -- z ConstrState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%z ) ) THEN + NULLIFY( ConstrStateData%z ) + ELSE + CALL C_F_POINTER(ConstrStateData%C_obj%z, ConstrStateData%z, [ConstrStateData%C_obj%z_Len]) + END IF + END IF +END SUBROUTINE + +SUBROUTINE MAP_F2C_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_ConstraintStateType), INTENT(INOUT) :: ConstrStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- H ConstrState Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(ConstrStateData%H)) THEN + ConstrStateData%C_obj%H_Len = 0 + ConstrStateData%C_obj%H = C_NULL_PTR + ELSE + ConstrStateData%C_obj%H_Len = SIZE(ConstrStateData%H) + IF (ConstrStateData%C_obj%H_Len > 0) & + ConstrStateData%C_obj%H = C_LOC(ConstrStateData%H(LBOUND(ConstrStateData%H,1))) + END IF + END IF + + ! -- V ConstrState Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(ConstrStateData%V)) THEN + ConstrStateData%C_obj%V_Len = 0 + ConstrStateData%C_obj%V = C_NULL_PTR + ELSE + ConstrStateData%C_obj%V_Len = SIZE(ConstrStateData%V) + IF (ConstrStateData%C_obj%V_Len > 0) & + ConstrStateData%C_obj%V = C_LOC(ConstrStateData%V(LBOUND(ConstrStateData%V,1))) + END IF + END IF + + ! -- x ConstrState Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(ConstrStateData%x)) THEN + ConstrStateData%C_obj%x_Len = 0 + ConstrStateData%C_obj%x = C_NULL_PTR + ELSE + ConstrStateData%C_obj%x_Len = SIZE(ConstrStateData%x) + IF (ConstrStateData%C_obj%x_Len > 0) & + ConstrStateData%C_obj%x = C_LOC(ConstrStateData%x(LBOUND(ConstrStateData%x,1))) + END IF + END IF + + ! -- y ConstrState Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(ConstrStateData%y)) THEN + ConstrStateData%C_obj%y_Len = 0 + ConstrStateData%C_obj%y = C_NULL_PTR + ELSE + ConstrStateData%C_obj%y_Len = SIZE(ConstrStateData%y) + IF (ConstrStateData%C_obj%y_Len > 0) & + ConstrStateData%C_obj%y = C_LOC(ConstrStateData%y(LBOUND(ConstrStateData%y,1))) + END IF + END IF + + ! -- z ConstrState Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(ConstrStateData%z)) THEN + ConstrStateData%C_obj%z_Len = 0 + ConstrStateData%C_obj%z = C_NULL_PTR + ELSE + ConstrStateData%C_obj%z_Len = SIZE(ConstrStateData%z) + IF (ConstrStateData%C_obj%z_Len > 0) & + ConstrStateData%C_obj%z = C_LOC(ConstrStateData%z(LBOUND(ConstrStateData%z,1))) + END IF + END IF +END SUBROUTINE subroutine MAP_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) type(MAP_ParameterType), intent(in) :: SrcParamData @@ -2597,50 +2597,50 @@ subroutine MAP_UnPackParam(Buf, OutData) OutData%C_obj%numOuts = OutData%numOuts call MAP_Fortran_UnpackLin_ParamType(Buf, OutData%LinParams) ! LinParams end subroutine - SUBROUTINE MAP_C2Fary_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - ParamData%g = ParamData%C_obj%g - ParamData%depth = ParamData%C_obj%depth - ParamData%rho_sea = ParamData%C_obj%rho_sea - ParamData%dt = ParamData%C_obj%dt - ParamData%numOuts = ParamData%C_obj%numOuts - END SUBROUTINE MAP_C2Fary_CopyParam - - SUBROUTINE MAP_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - ParamData%C_obj%g = ParamData%g - ParamData%C_obj%depth = ParamData%depth - ParamData%C_obj%rho_sea = ParamData%rho_sea - ParamData%C_obj%dt = ParamData%dt - ParamData%C_obj%numOuts = ParamData%numOuts - END SUBROUTINE MAP_F2C_CopyParam +SUBROUTINE MAP_C2Fary_CopyParam(ParamData, ErrStat, ErrMsg, SkipPointers) + TYPE(MAP_ParameterType), INTENT(INOUT) :: ParamData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + ParamData%g = ParamData%C_obj%g + ParamData%depth = ParamData%C_obj%depth + ParamData%rho_sea = ParamData%C_obj%rho_sea + ParamData%dt = ParamData%C_obj%dt + ParamData%numOuts = ParamData%C_obj%numOuts +END SUBROUTINE + +SUBROUTINE MAP_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_ParameterType), INTENT(INOUT) :: ParamData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + ParamData%C_obj%g = ParamData%g + ParamData%C_obj%depth = ParamData%depth + ParamData%C_obj%rho_sea = ParamData%rho_sea + ParamData%C_obj%dt = ParamData%dt + ParamData%C_obj%numOuts = ParamData%numOuts +END SUBROUTINE subroutine MAP_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) type(MAP_InputType), intent(inout) :: SrcInputData @@ -2863,103 +2863,103 @@ subroutine MAP_UnPackInput(Buf, OutData) end if call MeshUnpack(Buf, OutData%PtFairDisplacement) ! PtFairDisplacement end subroutine - SUBROUTINE MAP_C2Fary_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- x Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%x ) ) THEN - NULLIFY( InputData%x ) - ELSE - CALL C_F_POINTER(InputData%C_obj%x, InputData%x, (/InputData%C_obj%x_Len/)) - END IF - END IF - - ! -- y Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%y ) ) THEN - NULLIFY( InputData%y ) - ELSE - CALL C_F_POINTER(InputData%C_obj%y, InputData%y, (/InputData%C_obj%y_Len/)) - END IF - END IF - - ! -- z Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%z ) ) THEN - NULLIFY( InputData%z ) - ELSE - CALL C_F_POINTER(InputData%C_obj%z, InputData%z, (/InputData%C_obj%z_Len/)) - END IF - END IF - END SUBROUTINE MAP_C2Fary_CopyInput - - SUBROUTINE MAP_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- x Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%x)) THEN - InputData%C_obj%x_Len = 0 - InputData%C_obj%x = C_NULL_PTR - ELSE - InputData%C_obj%x_Len = SIZE(InputData%x) - IF (InputData%C_obj%x_Len > 0) & - InputData%C_obj%x = C_LOC( InputData%x( LBOUND(InputData%x,1) ) ) - END IF - END IF - - ! -- y Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%y)) THEN - InputData%C_obj%y_Len = 0 - InputData%C_obj%y = C_NULL_PTR - ELSE - InputData%C_obj%y_Len = SIZE(InputData%y) - IF (InputData%C_obj%y_Len > 0) & - InputData%C_obj%y = C_LOC( InputData%y( LBOUND(InputData%y,1) ) ) - END IF - END IF - - ! -- z Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%z)) THEN - InputData%C_obj%z_Len = 0 - InputData%C_obj%z = C_NULL_PTR - ELSE - InputData%C_obj%z_Len = SIZE(InputData%z) - IF (InputData%C_obj%z_Len > 0) & - InputData%C_obj%z = C_LOC( InputData%z( LBOUND(InputData%z,1) ) ) - END IF - END IF - END SUBROUTINE MAP_F2C_CopyInput +SUBROUTINE MAP_C2Fary_CopyInput(InputData, ErrStat, ErrMsg, SkipPointers) + TYPE(MAP_InputType), INTENT(INOUT) :: InputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- x Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%x ) ) THEN + NULLIFY( InputData%x ) + ELSE + CALL C_F_POINTER(InputData%C_obj%x, InputData%x, [InputData%C_obj%x_Len]) + END IF + END IF + + ! -- y Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%y ) ) THEN + NULLIFY( InputData%y ) + ELSE + CALL C_F_POINTER(InputData%C_obj%y, InputData%y, [InputData%C_obj%y_Len]) + END IF + END IF + + ! -- z Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%z ) ) THEN + NULLIFY( InputData%z ) + ELSE + CALL C_F_POINTER(InputData%C_obj%z, InputData%z, [InputData%C_obj%z_Len]) + END IF + END IF +END SUBROUTINE + +SUBROUTINE MAP_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_InputType), INTENT(INOUT) :: InputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- x Input Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(InputData%x)) THEN + InputData%C_obj%x_Len = 0 + InputData%C_obj%x = C_NULL_PTR + ELSE + InputData%C_obj%x_Len = SIZE(InputData%x) + IF (InputData%C_obj%x_Len > 0) & + InputData%C_obj%x = C_LOC(InputData%x(LBOUND(InputData%x,1))) + END IF + END IF + + ! -- y Input Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(InputData%y)) THEN + InputData%C_obj%y_Len = 0 + InputData%C_obj%y = C_NULL_PTR + ELSE + InputData%C_obj%y_Len = SIZE(InputData%y) + IF (InputData%C_obj%y_Len > 0) & + InputData%C_obj%y = C_LOC(InputData%y(LBOUND(InputData%y,1))) + END IF + END IF + + ! -- z Input Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(InputData%z)) THEN + InputData%C_obj%z_Len = 0 + InputData%C_obj%z = C_NULL_PTR + ELSE + InputData%C_obj%z_Len = SIZE(InputData%z) + IF (InputData%C_obj%z_Len > 0) & + InputData%C_obj%z = C_LOC(InputData%z(LBOUND(InputData%z,1))) + END IF + END IF +END SUBROUTINE subroutine MAP_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) type(MAP_OutputType), intent(inout) :: SrcOutputData @@ -3271,177 +3271,178 @@ subroutine MAP_UnPackOutput(Buf, OutData) end if call MeshUnpack(Buf, OutData%ptFairleadLoad) ! ptFairleadLoad end subroutine - SUBROUTINE MAP_C2Fary_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- Fx Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%Fx ) ) THEN - NULLIFY( OutputData%Fx ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%Fx, OutputData%Fx, (/OutputData%C_obj%Fx_Len/)) - END IF - END IF - - ! -- Fy Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%Fy ) ) THEN - NULLIFY( OutputData%Fy ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%Fy, OutputData%Fy, (/OutputData%C_obj%Fy_Len/)) - END IF - END IF - - ! -- Fz Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%Fz ) ) THEN - NULLIFY( OutputData%Fz ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%Fz, OutputData%Fz, (/OutputData%C_obj%Fz_Len/)) - END IF - END IF - - ! -- wrtOutput Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%wrtOutput ) ) THEN - NULLIFY( OutputData%wrtOutput ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%wrtOutput, OutputData%wrtOutput, (/OutputData%C_obj%wrtOutput_Len/)) - END IF - END IF - END SUBROUTINE MAP_C2Fary_CopyOutput - - SUBROUTINE MAP_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(MAP_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- Fx Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OutputData%Fx)) THEN - OutputData%C_obj%Fx_Len = 0 - OutputData%C_obj%Fx = C_NULL_PTR - ELSE - OutputData%C_obj%Fx_Len = SIZE(OutputData%Fx) - IF (OutputData%C_obj%Fx_Len > 0) & - OutputData%C_obj%Fx = C_LOC( OutputData%Fx( LBOUND(OutputData%Fx,1) ) ) - END IF - END IF - - ! -- Fy Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OutputData%Fy)) THEN - OutputData%C_obj%Fy_Len = 0 - OutputData%C_obj%Fy = C_NULL_PTR - ELSE - OutputData%C_obj%Fy_Len = SIZE(OutputData%Fy) - IF (OutputData%C_obj%Fy_Len > 0) & - OutputData%C_obj%Fy = C_LOC( OutputData%Fy( LBOUND(OutputData%Fy,1) ) ) - END IF - END IF - - ! -- Fz Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OutputData%Fz)) THEN - OutputData%C_obj%Fz_Len = 0 - OutputData%C_obj%Fz = C_NULL_PTR - ELSE - OutputData%C_obj%Fz_Len = SIZE(OutputData%Fz) - IF (OutputData%C_obj%Fz_Len > 0) & - OutputData%C_obj%Fz = C_LOC( OutputData%Fz( LBOUND(OutputData%Fz,1) ) ) - END IF - END IF - - ! -- wrtOutput Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OutputData%wrtOutput)) THEN - OutputData%C_obj%wrtOutput_Len = 0 - OutputData%C_obj%wrtOutput = C_NULL_PTR - ELSE - OutputData%C_obj%wrtOutput_Len = SIZE(OutputData%wrtOutput) - IF (OutputData%C_obj%wrtOutput_Len > 0) & - OutputData%C_obj%wrtOutput = C_LOC( OutputData%wrtOutput( LBOUND(OutputData%wrtOutput,1) ) ) - END IF - END IF - END SUBROUTINE MAP_F2C_CopyOutput - - - SUBROUTINE MAP_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) -! -!.................................................................................................................................. - TYPE(MAP_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(MAP_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None +SUBROUTINE MAP_C2Fary_CopyOutput(OutputData, ErrStat, ErrMsg, SkipPointers) + TYPE(MAP_OutputType), INTENT(INOUT) :: OutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- Fx Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%Fx ) ) THEN + NULLIFY( OutputData%Fx ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%Fx, OutputData%Fx, [OutputData%C_obj%Fx_Len]) + END IF + END IF + + ! -- Fy Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%Fy ) ) THEN + NULLIFY( OutputData%Fy ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%Fy, OutputData%Fy, [OutputData%C_obj%Fy_Len]) + END IF + END IF + + ! -- Fz Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%Fz ) ) THEN + NULLIFY( OutputData%Fz ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%Fz, OutputData%Fz, [OutputData%C_obj%Fz_Len]) + END IF + END IF + + ! -- wrtOutput Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%wrtOutput ) ) THEN + NULLIFY( OutputData%wrtOutput ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%wrtOutput, OutputData%wrtOutput, [OutputData%C_obj%wrtOutput_Len]) + END IF + END IF +END SUBROUTINE + +SUBROUTINE MAP_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_OutputType), INTENT(INOUT) :: OutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- Fx Output Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OutputData%Fx)) THEN + OutputData%C_obj%Fx_Len = 0 + OutputData%C_obj%Fx = C_NULL_PTR + ELSE + OutputData%C_obj%Fx_Len = SIZE(OutputData%Fx) + IF (OutputData%C_obj%Fx_Len > 0) & + OutputData%C_obj%Fx = C_LOC(OutputData%Fx(LBOUND(OutputData%Fx,1))) + END IF + END IF + + ! -- Fy Output Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OutputData%Fy)) THEN + OutputData%C_obj%Fy_Len = 0 + OutputData%C_obj%Fy = C_NULL_PTR + ELSE + OutputData%C_obj%Fy_Len = SIZE(OutputData%Fy) + IF (OutputData%C_obj%Fy_Len > 0) & + OutputData%C_obj%Fy = C_LOC(OutputData%Fy(LBOUND(OutputData%Fy,1))) + END IF + END IF + + ! -- Fz Output Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OutputData%Fz)) THEN + OutputData%C_obj%Fz_Len = 0 + OutputData%C_obj%Fz = C_NULL_PTR + ELSE + OutputData%C_obj%Fz_Len = SIZE(OutputData%Fz) + IF (OutputData%C_obj%Fz_Len > 0) & + OutputData%C_obj%Fz = C_LOC(OutputData%Fz(LBOUND(OutputData%Fz,1))) + END IF + END IF + + ! -- wrtOutput Output Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OutputData%wrtOutput)) THEN + OutputData%C_obj%wrtOutput_Len = 0 + OutputData%C_obj%wrtOutput = C_NULL_PTR + ELSE + OutputData%C_obj%wrtOutput_Len = SIZE(OutputData%wrtOutput) + IF (OutputData%C_obj%wrtOutput_Len > 0) & + OutputData%C_obj%wrtOutput = C_LOC(OutputData%wrtOutput(LBOUND(OutputData%wrtOutput,1))) + END IF + END IF +END SUBROUTINE + +subroutine MAP_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time + ! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(MAP_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(MAP_InputType), intent(inout) :: u_out ! Input at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Input_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(u)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(u) - 1 - IF ( order .eq. 0 ) THEN - CALL MAP_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL MAP_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL MAP_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE MAP_Input_ExtrapInterp - - - SUBROUTINE MAP_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'MAP_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call MAP_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call MAP_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call MAP_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE MAP_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 1. @@ -3453,61 +3454,53 @@ SUBROUTINE MAP_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(MAP_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(MAP_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(MAP_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(MAP_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(MAP_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(MAP_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Input_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - - ScaleFactor = t_out / t(2) -IF (ASSOCIATED(u_out%x) .AND. ASSOCIATED(u1%x)) THEN - DO i1 = LBOUND(u_out%x,1),UBOUND(u_out%x,1) - b = -(u1%x(i1) - u2%x(i1)) - u_out%x(i1) = u1%x(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%y) .AND. ASSOCIATED(u1%y)) THEN - DO i1 = LBOUND(u_out%y,1),UBOUND(u_out%y,1) - b = -(u1%y(i1) - u2%y(i1)) - u_out%y(i1) = u1%y(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%z) .AND. ASSOCIATED(u1%z)) THEN - DO i1 = LBOUND(u_out%z,1),UBOUND(u_out%z,1) - b = -(u1%z(i1) - u2%z(i1)) - u_out%z(i1) = u1%z(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - CALL MeshExtrapInterp1(u1%PtFairDisplacement, u2%PtFairDisplacement, tin, u_out%PtFairDisplacement, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE MAP_Input_ExtrapInterp1 - - - SUBROUTINE MAP_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN + END IF + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ASSOCIATED(u_out%x) .AND. ASSOCIATED(u1%x)) THEN + u_out%x = a1*u1%x + a2*u2%x + END IF ! check if allocated + IF (ASSOCIATED(u_out%y) .AND. ASSOCIATED(u1%y)) THEN + u_out%y = a1*u1%y + a2*u2%y + END IF ! check if allocated + IF (ASSOCIATED(u_out%z) .AND. ASSOCIATED(u1%z)) THEN + u_out%z = a1*u1%z + a2*u2%z + END IF ! check if allocated + CALL MeshExtrapInterp1(u1%PtFairDisplacement, u2%PtFairDisplacement, tin, u_out%PtFairDisplacement, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +SUBROUTINE MAP_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 2. @@ -3521,124 +3514,113 @@ SUBROUTINE MAP_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - TYPE(MAP_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(MAP_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(MAP_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(MAP_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(MAP_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(MAP_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(MAP_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(MAP_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Input_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) -IF (ASSOCIATED(u_out%x) .AND. ASSOCIATED(u1%x)) THEN - DO i1 = LBOUND(u_out%x,1),UBOUND(u_out%x,1) - b = (t(3)**2*(u1%x(i1) - u2%x(i1)) + t(2)**2*(-u1%x(i1) + u3%x(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%x(i1) + t(3)*u2%x(i1) - t(2)*u3%x(i1) ) * scaleFactor - u_out%x(i1) = u1%x(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%y) .AND. ASSOCIATED(u1%y)) THEN - DO i1 = LBOUND(u_out%y,1),UBOUND(u_out%y,1) - b = (t(3)**2*(u1%y(i1) - u2%y(i1)) + t(2)**2*(-u1%y(i1) + u3%y(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%y(i1) + t(3)*u2%y(i1) - t(2)*u3%y(i1) ) * scaleFactor - u_out%y(i1) = u1%y(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%z) .AND. ASSOCIATED(u1%z)) THEN - DO i1 = LBOUND(u_out%z,1),UBOUND(u_out%z,1) - b = (t(3)**2*(u1%z(i1) - u2%z(i1)) + t(2)**2*(-u1%z(i1) + u3%z(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%z(i1) + t(3)*u2%z(i1) - t(2)*u3%z(i1) ) * scaleFactor - u_out%z(i1) = u1%z(i1) + b + c * t_out - END DO -END IF ! check if allocated - CALL MeshExtrapInterp2(u1%PtFairDisplacement, u2%PtFairDisplacement, u3%PtFairDisplacement, tin, u_out%PtFairDisplacement, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE MAP_Input_ExtrapInterp2 - - - SUBROUTINE MAP_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(MAP_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(MAP_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ASSOCIATED(u_out%x) .AND. ASSOCIATED(u1%x)) THEN + u_out%x = a1*u1%x + a2*u2%x + a3*u3%x + END IF ! check if allocated + IF (ASSOCIATED(u_out%y) .AND. ASSOCIATED(u1%y)) THEN + u_out%y = a1*u1%y + a2*u2%y + a3*u3%y + END IF ! check if allocated + IF (ASSOCIATED(u_out%z) .AND. ASSOCIATED(u1%z)) THEN + u_out%z = a1*u1%z + a2*u2%z + a3*u3%z + END IF ! check if allocated + CALL MeshExtrapInterp2(u1%PtFairDisplacement, u2%PtFairDisplacement, u3%PtFairDisplacement, tin, u_out%PtFairDisplacement, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +subroutine MAP_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time + ! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(MAP_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(MAP_OutputType), intent(inout) :: y_out ! Output at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Output_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(y)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(y) - 1 - IF ( order .eq. 0 ) THEN - CALL MAP_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL MAP_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL MAP_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE MAP_Output_ExtrapInterp - - - SUBROUTINE MAP_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'MAP_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call MAP_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call MAP_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call MAP_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE MAP_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 1. @@ -3650,73 +3632,59 @@ SUBROUTINE MAP_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(MAP_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(MAP_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(MAP_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(MAP_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(MAP_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(MAP_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Output_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - - ScaleFactor = t_out / t(2) -IF (ASSOCIATED(y_out%Fx) .AND. ASSOCIATED(y1%Fx)) THEN - DO i1 = LBOUND(y_out%Fx,1),UBOUND(y_out%Fx,1) - b = -(y1%Fx(i1) - y2%Fx(i1)) - y_out%Fx(i1) = y1%Fx(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(y_out%Fy) .AND. ASSOCIATED(y1%Fy)) THEN - DO i1 = LBOUND(y_out%Fy,1),UBOUND(y_out%Fy,1) - b = -(y1%Fy(i1) - y2%Fy(i1)) - y_out%Fy(i1) = y1%Fy(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(y_out%Fz) .AND. ASSOCIATED(y1%Fz)) THEN - DO i1 = LBOUND(y_out%Fz,1),UBOUND(y_out%Fz,1) - b = -(y1%Fz(i1) - y2%Fz(i1)) - y_out%Fz(i1) = y1%Fz(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(y_out%wrtOutput) .AND. ASSOCIATED(y1%wrtOutput)) THEN - DO i1 = LBOUND(y_out%wrtOutput,1),UBOUND(y_out%wrtOutput,1) - b = -(y1%wrtOutput(i1) - y2%wrtOutput(i1)) - y_out%wrtOutput(i1) = y1%wrtOutput(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - CALL MeshExtrapInterp1(y1%ptFairleadLoad, y2%ptFairleadLoad, tin, y_out%ptFairleadLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE MAP_Output_ExtrapInterp1 - - - SUBROUTINE MAP_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN + END IF + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ASSOCIATED(y_out%Fx) .AND. ASSOCIATED(y1%Fx)) THEN + y_out%Fx = a1*y1%Fx + a2*y2%Fx + END IF ! check if allocated + IF (ASSOCIATED(y_out%Fy) .AND. ASSOCIATED(y1%Fy)) THEN + y_out%Fy = a1*y1%Fy + a2*y2%Fy + END IF ! check if allocated + IF (ASSOCIATED(y_out%Fz) .AND. ASSOCIATED(y1%Fz)) THEN + y_out%Fz = a1*y1%Fz + a2*y2%Fz + END IF ! check if allocated + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated + IF (ASSOCIATED(y_out%wrtOutput) .AND. ASSOCIATED(y1%wrtOutput)) THEN + y_out%wrtOutput = a1*y1%wrtOutput + a2*y2%wrtOutput + END IF ! check if allocated + CALL MeshExtrapInterp1(y1%ptFairleadLoad, y2%ptFairleadLoad, tin, y_out%ptFairleadLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +SUBROUTINE MAP_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 2. @@ -3730,84 +3698,64 @@ SUBROUTINE MAP_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - TYPE(MAP_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(MAP_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(MAP_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(MAP_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(MAP_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(MAP_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(MAP_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(MAP_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) -IF (ASSOCIATED(y_out%Fx) .AND. ASSOCIATED(y1%Fx)) THEN - DO i1 = LBOUND(y_out%Fx,1),UBOUND(y_out%Fx,1) - b = (t(3)**2*(y1%Fx(i1) - y2%Fx(i1)) + t(2)**2*(-y1%Fx(i1) + y3%Fx(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%Fx(i1) + t(3)*y2%Fx(i1) - t(2)*y3%Fx(i1) ) * scaleFactor - y_out%Fx(i1) = y1%Fx(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(y_out%Fy) .AND. ASSOCIATED(y1%Fy)) THEN - DO i1 = LBOUND(y_out%Fy,1),UBOUND(y_out%Fy,1) - b = (t(3)**2*(y1%Fy(i1) - y2%Fy(i1)) + t(2)**2*(-y1%Fy(i1) + y3%Fy(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%Fy(i1) + t(3)*y2%Fy(i1) - t(2)*y3%Fy(i1) ) * scaleFactor - y_out%Fy(i1) = y1%Fy(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(y_out%Fz) .AND. ASSOCIATED(y1%Fz)) THEN - DO i1 = LBOUND(y_out%Fz,1),UBOUND(y_out%Fz,1) - b = (t(3)**2*(y1%Fz(i1) - y2%Fz(i1)) + t(2)**2*(-y1%Fz(i1) + y3%Fz(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%Fz(i1) + t(3)*y2%Fz(i1) - t(2)*y3%Fz(i1) ) * scaleFactor - y_out%Fz(i1) = y1%Fz(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(y_out%wrtOutput) .AND. ASSOCIATED(y1%wrtOutput)) THEN - DO i1 = LBOUND(y_out%wrtOutput,1),UBOUND(y_out%wrtOutput,1) - b = (t(3)**2*(y1%wrtOutput(i1) - y2%wrtOutput(i1)) + t(2)**2*(-y1%wrtOutput(i1) + y3%wrtOutput(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%wrtOutput(i1) + t(3)*y2%wrtOutput(i1) - t(2)*y3%wrtOutput(i1) ) * scaleFactor - y_out%wrtOutput(i1) = y1%wrtOutput(i1) + b + c * t_out - END DO -END IF ! check if allocated - CALL MeshExtrapInterp2(y1%ptFairleadLoad, y2%ptFairleadLoad, y3%ptFairleadLoad, tin, y_out%ptFairleadLoad, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE MAP_Output_ExtrapInterp2 - + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ASSOCIATED(y_out%Fx) .AND. ASSOCIATED(y1%Fx)) THEN + y_out%Fx = a1*y1%Fx + a2*y2%Fx + a3*y3%Fx + END IF ! check if allocated + IF (ASSOCIATED(y_out%Fy) .AND. ASSOCIATED(y1%Fy)) THEN + y_out%Fy = a1*y1%Fy + a2*y2%Fy + a3*y3%Fy + END IF ! check if allocated + IF (ASSOCIATED(y_out%Fz) .AND. ASSOCIATED(y1%Fz)) THEN + y_out%Fz = a1*y1%Fz + a2*y2%Fz + a3*y3%Fz + END IF ! check if allocated + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated + IF (ASSOCIATED(y_out%wrtOutput) .AND. ASSOCIATED(y1%wrtOutput)) THEN + y_out%wrtOutput = a1*y1%wrtOutput + a2*y2%wrtOutput + a3*y3%wrtOutput + END IF ! check if allocated + CALL MeshExtrapInterp2(y1%ptFairleadLoad, y2%ptFairleadLoad, y3%ptFairleadLoad, tin, y_out%ptFairleadLoad, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE END MODULE MAP_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/moordyn/src/MoorDyn_Types.f90 b/modules/moordyn/src/MoorDyn_Types.f90 index 35f30478c4..aabdec7d8b 100644 --- a/modules/moordyn/src/MoorDyn_Types.f90 +++ b/modules/moordyn/src/MoorDyn_Types.f90 @@ -6303,58 +6303,59 @@ subroutine MD_UnPackOutput(Buf, OutData) end if end subroutine - SUBROUTINE MD_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(MD_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(MD_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None +subroutine MD_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time + ! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(MD_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(MD_InputType), intent(inout) :: u_out ! Input at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'MD_Input_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(u)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(u) - 1 - IF ( order .eq. 0 ) THEN - CALL MD_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL MD_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL MD_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE MD_Input_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'MD_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call MD_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call MD_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call MD_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE MD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE MD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 1. @@ -6366,59 +6367,54 @@ SUBROUTINE MD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! !.................................................................................................................................. - TYPE(MD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(MD_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(MD_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(MD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(MD_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(MD_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'MD_Input_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'MD_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(u_out%CoupledKinematics) .AND. ALLOCATED(u1%CoupledKinematics)) THEN + DO i1 = LBOUND(u_out%CoupledKinematics,1),UBOUND(u_out%CoupledKinematics,1) + CALL MeshExtrapInterp1(u1%CoupledKinematics(i1), u2%CoupledKinematics(i1), tin, u_out%CoupledKinematics(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%DeltaL) .AND. ALLOCATED(u1%DeltaL)) THEN + u_out%DeltaL = a1*u1%DeltaL + a2*u2%DeltaL + END IF ! check if allocated + IF (ALLOCATED(u_out%DeltaLdot) .AND. ALLOCATED(u1%DeltaLdot)) THEN + u_out%DeltaLdot = a1*u1%DeltaLdot + a2*u2%DeltaLdot + END IF ! check if allocated +END SUBROUTINE - ScaleFactor = t_out / t(2) -IF (ALLOCATED(u_out%CoupledKinematics) .AND. ALLOCATED(u1%CoupledKinematics)) THEN - DO i1 = LBOUND(u_out%CoupledKinematics,1),UBOUND(u_out%CoupledKinematics,1) - CALL MeshExtrapInterp1(u1%CoupledKinematics(i1), u2%CoupledKinematics(i1), tin, u_out%CoupledKinematics(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%DeltaL) .AND. ALLOCATED(u1%DeltaL)) THEN - DO i1 = LBOUND(u_out%DeltaL,1),UBOUND(u_out%DeltaL,1) - b = -(u1%DeltaL(i1) - u2%DeltaL(i1)) - u_out%DeltaL(i1) = u1%DeltaL(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%DeltaLdot) .AND. ALLOCATED(u1%DeltaLdot)) THEN - DO i1 = LBOUND(u_out%DeltaLdot,1),UBOUND(u_out%DeltaLdot,1) - b = -(u1%DeltaLdot(i1) - u2%DeltaLdot(i1)) - u_out%DeltaLdot(i1) = u1%DeltaLdot(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE MD_Input_ExtrapInterp1 - - - SUBROUTINE MD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE MD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 2. @@ -6432,121 +6428,114 @@ SUBROUTINE MD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM ! !.................................................................................................................................. - TYPE(MD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(MD_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(MD_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(MD_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(MD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(MD_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(MD_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(MD_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'MD_Input_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'MD_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(u_out%CoupledKinematics) .AND. ALLOCATED(u1%CoupledKinematics)) THEN + DO i1 = LBOUND(u_out%CoupledKinematics,1),UBOUND(u_out%CoupledKinematics,1) + CALL MeshExtrapInterp2(u1%CoupledKinematics(i1), u2%CoupledKinematics(i1), u3%CoupledKinematics(i1), tin, u_out%CoupledKinematics(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%DeltaL) .AND. ALLOCATED(u1%DeltaL)) THEN + u_out%DeltaL = a1*u1%DeltaL + a2*u2%DeltaL + a3*u3%DeltaL + END IF ! check if allocated + IF (ALLOCATED(u_out%DeltaLdot) .AND. ALLOCATED(u1%DeltaLdot)) THEN + u_out%DeltaLdot = a1*u1%DeltaLdot + a2*u2%DeltaLdot + a3*u3%DeltaLdot + END IF ! check if allocated +END SUBROUTINE - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) -IF (ALLOCATED(u_out%CoupledKinematics) .AND. ALLOCATED(u1%CoupledKinematics)) THEN - DO i1 = LBOUND(u_out%CoupledKinematics,1),UBOUND(u_out%CoupledKinematics,1) - CALL MeshExtrapInterp2(u1%CoupledKinematics(i1), u2%CoupledKinematics(i1), u3%CoupledKinematics(i1), tin, u_out%CoupledKinematics(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%DeltaL) .AND. ALLOCATED(u1%DeltaL)) THEN - DO i1 = LBOUND(u_out%DeltaL,1),UBOUND(u_out%DeltaL,1) - b = (t(3)**2*(u1%DeltaL(i1) - u2%DeltaL(i1)) + t(2)**2*(-u1%DeltaL(i1) + u3%DeltaL(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%DeltaL(i1) + t(3)*u2%DeltaL(i1) - t(2)*u3%DeltaL(i1) ) * scaleFactor - u_out%DeltaL(i1) = u1%DeltaL(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%DeltaLdot) .AND. ALLOCATED(u1%DeltaLdot)) THEN - DO i1 = LBOUND(u_out%DeltaLdot,1),UBOUND(u_out%DeltaLdot,1) - b = (t(3)**2*(u1%DeltaLdot(i1) - u2%DeltaLdot(i1)) + t(2)**2*(-u1%DeltaLdot(i1) + u3%DeltaLdot(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%DeltaLdot(i1) + t(3)*u2%DeltaLdot(i1) - t(2)*u3%DeltaLdot(i1) ) * scaleFactor - u_out%DeltaLdot(i1) = u1%DeltaLdot(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE MD_Input_ExtrapInterp2 - - - SUBROUTINE MD_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(MD_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(MD_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None +subroutine MD_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time + ! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(MD_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(MD_OutputType), intent(inout) :: y_out ! Output at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'MD_Output_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(y)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(y) - 1 - IF ( order .eq. 0 ) THEN - CALL MD_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL MD_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL MD_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE MD_Output_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'MD_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call MD_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call MD_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call MD_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE MD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE MD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 1. @@ -6558,53 +6547,51 @@ SUBROUTINE MD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(MD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(MD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(MD_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(MD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(MD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(MD_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'MD_Output_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'MD_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%CoupledLoads) .AND. ALLOCATED(y1%CoupledLoads)) THEN + DO i1 = LBOUND(y_out%CoupledLoads,1),UBOUND(y_out%CoupledLoads,1) + CALL MeshExtrapInterp1(y1%CoupledLoads(i1), y2%CoupledLoads(i1), tin, y_out%CoupledLoads(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated +END SUBROUTINE - ScaleFactor = t_out / t(2) -IF (ALLOCATED(y_out%CoupledLoads) .AND. ALLOCATED(y1%CoupledLoads)) THEN - DO i1 = LBOUND(y_out%CoupledLoads,1),UBOUND(y_out%CoupledLoads,1) - CALL MeshExtrapInterp1(y1%CoupledLoads(i1), y2%CoupledLoads(i1), tin, y_out%CoupledLoads(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE MD_Output_ExtrapInterp1 - - - SUBROUTINE MD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE MD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 2. @@ -6618,60 +6605,56 @@ SUBROUTINE MD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - TYPE(MD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(MD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(MD_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(MD_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(MD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(MD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(MD_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(MD_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'MD_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'MD_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) -IF (ALLOCATED(y_out%CoupledLoads) .AND. ALLOCATED(y1%CoupledLoads)) THEN - DO i1 = LBOUND(y_out%CoupledLoads,1),UBOUND(y_out%CoupledLoads,1) - CALL MeshExtrapInterp2(y1%CoupledLoads(i1), y2%CoupledLoads(i1), y3%CoupledLoads(i1), tin, y_out%CoupledLoads(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE MD_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%CoupledLoads) .AND. ALLOCATED(y1%CoupledLoads)) THEN + DO i1 = LBOUND(y_out%CoupledLoads,1),UBOUND(y_out%CoupledLoads,1) + CALL MeshExtrapInterp2(y1%CoupledLoads(i1), y2%CoupledLoads(i1), y3%CoupledLoads(i1), tin, y_out%CoupledLoads(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated +END SUBROUTINE END MODULE MoorDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/nwtc-library/src/ModMesh.f90 b/modules/nwtc-library/src/ModMesh.f90 index 6cb8905b56..4146c1c083 100644 --- a/modules/nwtc-library/src/ModMesh.f90 +++ b/modules/nwtc-library/src/ModMesh.f90 @@ -3089,7 +3089,7 @@ SUBROUTINE MeshExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) REAL(DbKi) :: t(SIZE(tin)) ! Times associated with the inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - REAL(DbKi) :: scaleFactor ! temporary for extrapolation/interpolation + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation REAL(DbKi) :: tensor(3, order+1) ! for extrapolation of orientations REAL(DbKi) :: tensor_interp(3) ! for extrapolation of orientations REAL(DbKi) :: Orient(3,3) ! for extrapolation of orientations @@ -3119,39 +3119,43 @@ SUBROUTINE MeshExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) RETURN END IF + ! Calculate interpolation coefficients, t(1) = 0 + + a1 = (t_out - t(2))/(t(1) - t(2)) + a2 = (t_out - t(1))/(t(2) - t(1)) + ! now let's interpolate/extrapolate the fields: - scaleFactor = t_out / t(2) IF ( ALLOCATED(u1%Force) ) THEN - u_out%Force = u1%Force + (u2%Force - u1%Force) * scaleFactor + u_out%Force = a1*u1%Force + a2*u2%Force END IF IF ( ALLOCATED(u1%Moment) ) THEN - u_out%Moment = u1%Moment + (u2%Moment - u1%Moment) * scaleFactor + u_out%Moment = a1*u1%Moment + a2*u2%Moment END IF IF ( ALLOCATED(u1%TranslationDisp) ) THEN - u_out%TranslationDisp = u1%TranslationDisp + (u2%TranslationDisp - u1%TranslationDisp) * scaleFactor + u_out%TranslationDisp = a1*u1%TranslationDisp + a2*u2%TranslationDisp END IF IF ( ALLOCATED(u1%RotationVel) ) THEN - u_out%RotationVel = u1%RotationVel + (u2%RotationVel - u1%RotationVel) * scaleFactor + u_out%RotationVel = a1*u1%RotationVel + a2*u2%RotationVel END IF IF ( ALLOCATED(u1%TranslationVel) ) THEN - u_out%TranslationVel = u1%TranslationVel + (u2%TranslationVel - u1%TranslationVel) * scaleFactor + u_out%TranslationVel = a1*u1%TranslationVel + a2*u2%TranslationVel END IF IF ( ALLOCATED(u1%RotationAcc) ) THEN - u_out%RotationAcc = u1%RotationAcc + (u2%RotationAcc - u1%RotationAcc) * scaleFactor + u_out%RotationAcc = a1*u1%RotationAcc + a2*u2%RotationAcc END IF IF ( ALLOCATED(u1%TranslationAcc) ) THEN - u_out%TranslationAcc = u1%TranslationAcc + (u2%TranslationAcc - u1%TranslationAcc) * scaleFactor + u_out%TranslationAcc = a1*u1%TranslationAcc + a2*u2%TranslationAcc END IF IF ( ALLOCATED(u1%Scalars) ) THEN - u_out%Scalars = u1%Scalars + (u2%Scalars - u1%Scalars) * scaleFactor + u_out%Scalars = a1*u1%Scalars + a2*u2%Scalars END IF IF ( ALLOCATED(u1%Orientation) ) THEN @@ -3180,7 +3184,7 @@ SUBROUTINE MeshExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) CALL DCM_SetLogMapForInterp( tensor ) - tensor_interp = tensor(:,1) + (tensor(:,2) - tensor(:,1)) * scaleFactor + tensor_interp = a1*tensor(:,1) + a2*tensor(:,2) u_out%Orientation(:,:,node) = DCM_exp( tensor_interp ) @@ -3211,7 +3215,7 @@ SUBROUTINE MeshExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) REAL(DbKi) :: t(SIZE(tin)) ! Times associated with the inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - REAL(DbKi) :: scaleFactor ! temporary for extrapolation/interpolation + REAL(DbKi) :: a1, a2, a3 ! temporary for extrapolation/interpolation REAL(DbKi) :: tensor(3, order+1) ! for extrapolation of orientations REAL(DbKi) :: tensor_interp(3) ! for extrapolation of orientations REAL(DbKi) :: Orient(3,3) ! for extrapolation of orientations @@ -3255,63 +3259,44 @@ SUBROUTINE MeshExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) RETURN END IF - ! Now let's interpolate/extrapolate: - - scaleFactor = t_out / ( t(2) * t(3) * (t(2) - t(3)) ) + ! Calculate interpolation coefficients, t(1) = 0 - IF ( ALLOCATED(u1%Force) ) THEN + a1 = (t_out - t(2))*(t_out - t(3))/(t(2)*t(3)) + a2 = t_out*(t_out - t(3))/(t(2)*(t(2) - t(3))) + a3 = t_out*(t_out - t(2))/(t(3)*(t(3) - t(2))) - u_out%Force = u1%Force & - + ( t(3)**2 * (u1%Force - u2%Force) + t(2)**2*(-u1%Force + u3%Force) ) * scaleFactor & - + ( (t(2)-t(3))*u1%Force + t(3)*u2%Force - t(2)*u3%Force ) *scaleFactor * t_out + ! Now let's interpolate/extrapolate: + IF ( ALLOCATED(u1%Force) ) THEN + u_out%Force = a1*u1%Force + a2*u2%Force + a3*u3%Force END IF + IF ( ALLOCATED(u1%Moment) ) THEN - u_out%Moment = u1%Moment & - + ( t(3)**2 * (u1%Moment - u2%Moment) + t(2)**2*(-u1%Moment + u3%Moment) ) * scaleFactor & - + ( (t(2)-t(3))*u1%Moment + t(3)*u2%Moment - t(2)*u3%Moment ) *scaleFactor * t_out + u_out%Moment = a1*u1%Moment + a2*u2%Moment + a3*u3%Moment END IF IF ( ALLOCATED(u1%TranslationDisp) ) THEN - u_out%TranslationDisp = u1%TranslationDisp & - + ( t(3)**2 * ( u1%TranslationDisp - u2%TranslationDisp) & - + t(2)**2 * (-u1%TranslationDisp + u3%TranslationDisp) ) * scaleFactor & - + ( (t(2)-t(3))*u1%TranslationDisp + t(3)*u2%TranslationDisp & - - t(2)*u3%TranslationDisp )*scaleFactor*t_out + u_out%TranslationDisp = a1*u1%TranslationDisp + a2*u2%TranslationDisp + a3*u3%TranslationDisp END IF IF ( ALLOCATED(u1%RotationVel) ) THEN - u_out%RotationVel = u1%RotationVel & - + ( t(3)**2 * ( u1%RotationVel - u2%RotationVel) & - + t(2)**2 * (-u1%RotationVel + u3%RotationVel) ) * scaleFactor & - + ( (t(2)-t(3))*u1%RotationVel + t(3)*u2%RotationVel - t(2)*u3%RotationVel )*scaleFactor*t_out + u_out%RotationVel = a1*u1%RotationVel + a2*u2%RotationVel + a3*u3%RotationVel END IF IF ( ALLOCATED(u1%TranslationVel) ) THEN - u_out%TranslationVel = u1%TranslationVel & - +( t(3)**2 * ( u1%TranslationVel - u2%TranslationVel) & - + t(2)**2 * (-u1%TranslationVel + u3%TranslationVel) ) * scaleFactor & - +( (t(2)-t(3))*u1%TranslationVel + t(3)*u2%TranslationVel - t(2)*u3%TranslationVel)*scaleFactor*t_out + u_out%TranslationVel = a1*u1%TranslationVel + a2*u2%TranslationVel + a3*u3%TranslationVel END IF IF ( ALLOCATED(u1%RotationAcc) ) THEN - u_out%RotationAcc = u1%RotationAcc & - + ( t(3)**2 * ( u1%RotationAcc - u2%RotationAcc) & - + t(2)**2 * (-u1%RotationAcc + u3%RotationAcc) ) * scaleFactor & - + ( (t(2)-t(3))*u1%RotationAcc + t(3)*u2%RotationAcc - t(2)*u3%RotationAcc )*scaleFactor*t_out + u_out%RotationAcc = a1*u1%RotationAcc + a2*u2%RotationAcc + a3*u3%RotationAcc END IF IF ( ALLOCATED(u1%TranslationAcc) ) THEN - u_out%TranslationAcc = u1%TranslationAcc & - +( t(3)**2 * ( u1%TranslationAcc - u2%TranslationAcc) & - + t(2)**2 * (-u1%TranslationAcc + u3%TranslationAcc) ) * scaleFactor & - +( (t(2)-t(3))*u1%TranslationAcc + t(3)*u2%TranslationAcc - t(2)*u3%TranslationAcc)*scaleFactor*t_out + u_out%TranslationAcc = a1*u1%TranslationAcc + a2*u2%TranslationAcc + a3*u3%TranslationAcc END IF IF ( ALLOCATED(u1%Scalars) ) THEN - u_out%Scalars = u1%Scalars & - + ( t(3)**2 * (u1%Scalars - u2%Scalars) + t(2)**2*(-u1%Scalars + u3%Scalars) )*scaleFactor & - + ( (t(2)-t(3))*u1%Scalars + t(3)*u2%Scalars - t(2)*u3%Scalars )*scaleFactor * t_out + u_out%Scalars = a1*u1%Scalars + a2*u2%Scalars + a3*u3%Scalars END IF IF ( ALLOCATED(u1%Orientation) ) THEN @@ -3348,9 +3333,7 @@ SUBROUTINE MeshExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) CALL DCM_SetLogMapForInterp( tensor ) - tensor_interp = tensor(:,1) & - + ( t(3)**2 * (tensor(:,1) - tensor(:,2)) + t(2)**2*(-tensor(:,1) + tensor(:,3)) )*scaleFactor & - + ( (t(2)-t(3))*tensor(:,1) + t(3)*tensor(:,2) - t(2)*tensor(:,3) )*scaleFactor * t_out + tensor_interp = a1*tensor(:,1) + a2*tensor(:,2) + a3*tensor(:,3) u_out%Orientation(:,:,node) = DCM_exp( tensor_interp ) END DO diff --git a/modules/openfast-registry/src/registry_gen_fortran.cpp b/modules/openfast-registry/src/registry_gen_fortran.cpp index de290335fd..58fb7582f3 100644 --- a/modules/openfast-registry/src/registry_gen_fortran.cpp +++ b/modules/openfast-registry/src/registry_gen_fortran.cpp @@ -942,10 +942,8 @@ void gen_unpack(std::ostream &w, const Module &mod, const DataType::Derived &ddt } void gen_extint_order(std::ostream &w, const Module &mod, std::string uy, const int order, - const Field &field, const std::string &deref, int recurse_level) + const Field &field, const std::string &deref, const int recurse_level, std::string &indent) { - std::string indent, tmp; - if (recurse_level > MAXRECURSE) { std::cerr << "REGISTRY ERROR: too many levels of array subtypes\n"; @@ -963,8 +961,8 @@ void gen_extint_order(std::ostream &w, const Module &mod, std::string uy, const // check if this is an allocatable array: if (field.is_allocatable) { - w << "IF (" << assoc_alloc << "(" << vout << ") .AND. " << assoc_alloc << "(" << v1 - << ")) THEN\n"; + w << indent << "IF (" << assoc_alloc << "(" << vout << ") .AND. " << assoc_alloc << "(" << v1 << ")) THEN"; + indent += " "; } if (field.data_type->tag == DataType::Tag::Derived) @@ -980,8 +978,8 @@ void gen_extint_order(std::ostream &w, const Module &mod, std::string uy, const for (int j = field.rank; j > 0; j--) { - w << " DO i" << recurse_level << j << " = LBOUND(" << uy << "_out" << field_var - << "," << j << "),UBOUND(" << uy << "_out" << field_var << "," << j << ")\n"; + w << indent << "DO i" << recurse_level << j << " = LBOUND(" << uy << "_out" << field_var << "," << j << "),UBOUND(" << uy << "_out" << field_var << "," << j << ")"; + indent += " "; } if (field.rank > 0) @@ -991,17 +989,17 @@ void gen_extint_order(std::ostream &w, const Module &mod, std::string uy, const { field_var += "i" + std::to_string(recurse_level) + std::to_string(j); if (j < field.rank) - { field_var += ","; - } } field_var += ")"; } - gen_extint_order(w, mod, uy, order, sub_field, field_var, recurse_level + 1); + gen_extint_order(w, mod, uy, order, sub_field, field_var, recurse_level + 1, indent); + for (int j = field.rank; j > 0; j--) { - w << " ENDDO\n"; + indent.erase(indent.size() - 3); + w << indent << "END DO"; } } } @@ -1009,58 +1007,59 @@ void gen_extint_order(std::ostream &w, const Module &mod, std::string uy, const { for (int j = field.rank; j > 0; j--) { - w << " DO i" << j << " = LBOUND(" << vout << "," << j << "),UBOUND(" << vout << "," - << j << ")\n"; + w << indent << "DO i" << j << " = LBOUND(" << vout << "," << j << "),UBOUND(" << vout << "," << j << ")"; + indent += " "; } if (field.data_type->derived.name.compare("MeshType") == 0) { if (order == 0) { - w << " CALL MeshCopy(" << v1 + dims << ", " << vout + dims - << ", MESH_UPDATECOPY, ErrStat2, ErrMsg2 )\n"; + w << indent << "CALL MeshCopy(" << v1 + dims << ", " << vout + dims + << ", MESH_UPDATECOPY, ErrStat2, ErrMsg2)"; } else if (order == 1) { - w << " CALL MeshExtrapInterp1(" << v1 + dims << ", " << v2 + dims - << ", tin, " << vout + dims << ", tin_out, ErrStat2, ErrMsg2 )\n"; + w << indent << "CALL MeshExtrapInterp1(" << v1 + dims << ", " << v2 + dims + << ", tin, " << vout + dims << ", tin_out, ErrStat2, ErrMsg2)"; } else if (order == 2) { - w << " CALL MeshExtrapInterp2(" << v1 + dims << ", " << v2 + dims << ", " + w << indent << "CALL MeshExtrapInterp2(" << v1 + dims << ", " << v2 + dims << ", " << v3 + dims << ", tin, " << vout + dims - << ", tin_out, ErrStat2, ErrMsg2 )\n"; + << ", tin_out, ErrStat2, ErrMsg2)"; } } else { if (order == 0) { - w << " CALL " << field.data_type->derived.module->nickname << "_Copy" + w << indent << "CALL " << field.data_type->derived.module->nickname << "_Copy" << field.data_type->derived.name_short << "(" << v1 + dims << ", " - << vout + dims << ", MESH_UPDATECOPY, ErrStat2, ErrMsg2 )\n"; + << vout + dims << ", MESH_UPDATECOPY, ErrStat2, ErrMsg2)"; } else if (order == 1) { - w << " CALL " << field.data_type->derived.module->nickname << "_" + w << indent << "CALL " << field.data_type->derived.module->nickname << "_" << field.data_type->derived.name_short << "_ExtrapInterp1( " << v1 + dims << ", " << v2 + dims << ", tin, " << vout + dims - << ", tin_out, ErrStat2, ErrMsg2 )\n"; + << ", tin_out, ErrStat2, ErrMsg2)"; } else if (order == 2) { - w << " CALL " << field.data_type->derived.module->nickname << "_" + w << indent << "CALL " << field.data_type->derived.module->nickname << "_" << field.data_type->derived.name_short << "_ExtrapInterp2( " << v1 + dims << ", " << v2 + dims << ", " << v3 + dims << ", tin, " << vout + dims - << ", tin_out, ErrStat2, ErrMsg2 )\n"; + << ", tin_out, ErrStat2, ErrMsg2)"; } } - w << " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName)\n"; + w << indent << " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName)"; for (int j = field.rank; j >= 1; j--) { - w << " ENDDO\n"; + indent.erase(indent.size() - 3); + w << indent << "END DO"; } } } @@ -1068,63 +1067,58 @@ void gen_extint_order(std::ostream &w, const Module &mod, std::string uy, const { if (order == 0) { - // bjj: this should probably have some "IF ALLOCATED" statements around it, but we're - // just calling the copy routine - w << " " << vout << " = " << v1 << "\n"; - } - else - { - indent = ""; + w << indent << vout << " = " << v1; } - for (int j = field.rank; j > 0; j--) + if (order == 0 || field.gen_periodic == Period::TwoPi) { - w << indent << " DO i" << j << " = LBOUND(" << vout << "," << j << "),UBOUND(" << vout - << "," << j << ")\n"; - indent += " "; + for (int j = field.rank; j > 0; j--) + { + w << indent << "DO i" << j << " = LBOUND(" << vout << "," << j << "),UBOUND(" << vout << "," << j << ")"; + indent += " "; + } } if (order == 1) { if (field.gen_periodic == Period::TwoPi) { - w << indent << " CALL Angles_ExtrapInterp( " << v1 + dims << ", " << v2 + dims - << ", tin, " << vout + dims << ", tin_out )\n"; + w << indent << "CALL Angles_ExtrapInterp( " << v1 + dims << ", " << v2 + dims + << ", tin, " << vout + dims << ", tin_out )"; } else { - w << indent << " b = -(" << v1 + dims << " - " << v2 + dims << ")\n"; - w << indent << " " << vout + dims << " = " << v1 + dims << " + b * ScaleFactor\n"; + w << indent << vout << " = a1*" << v1 << " + a2*" << v2; }; } if (order == 2) { if (field.gen_periodic == Period::TwoPi) { - w << indent << " CALL Angles_ExtrapInterp( " << v1 + dims << ", " << v2 + dims - << ", " << v3 + dims << ", tin, " << vout + dims << ", tin_out )\n"; + w << indent << "CALL Angles_ExtrapInterp( " << v1 + dims << ", " << v2 + dims + << ", " << v3 + dims << ", tin, " << vout + dims << ", tin_out )"; } else { - w << indent << " b = (t(3)**2*(" << v1 + dims << " - " << v2 + dims - << ") + t(2)**2*(-" << v1 + dims << " + " << v3 + dims << "))* scaleFactor\n "; - w << indent << " c = ( (t(2)-t(3))*" << v1 + dims << " + t(3)*" << v2 + dims - << " - t(2)*" << v3 + dims << " ) * scaleFactor\n"; - w << indent << " " << vout + dims << " = " << v1 + dims << " + b + c * t_out\n"; + w << indent << vout << " = a1*" << v1 << " + a2*" << v2 << " + a3*" << v3; } } - for (int j = field.rank; j >= 1; j--) + if (order == 0 || field.gen_periodic == Period::TwoPi) { - indent = ""; - for (int i = 1; i < j; i++) - indent += " "; - w << indent << " END DO\n"; + for (int j = field.rank; j >= 1; j--) + { + indent.erase(indent.size() - 3); + w << indent << "END DO"; + } } } // check if this is an allocatable array: if (field.is_allocatable) - w << "END IF ! check if allocated\n"; + { + indent.erase(indent.size() - 3); + w << indent << "END IF ! check if allocated"; + } } void calc_extint_order(std::ostream &w, const Module &mod, const Field &field, int recurse_level, @@ -1175,182 +1169,167 @@ void gen_ExtrapInterp1(std::ostream &w, const Module &mod, const DataType::Deriv std::string &type_kind, std::string &uy, std::string &mod_prefix, const int max_rank, const int max_nrecurs, const int max_alloc_ndims) { - w << "\n"; - w << " SUBROUTINE " << mod.nickname << "_" << ddt.name_short << "_ExtrapInterp1(" << uy << "1, " - << uy << "2, tin, " << uy << "_out, tin_out, ErrStat, ErrMsg )\n"; - w << "!\n"; - w << "! This subroutine calculates a extrapolated (or interpolated) " << ddt.name_short << " " - << uy << "_out at time t_out, from previous/future time\n"; - w << "! values of " << uy - << " (which has values associated with times in t). Order of the interpolation is 1.\n"; - w << "!\n"; - w << "! f(t) = a + b * t, or\n"; - w << "!\n"; - w << "! where a and b are determined as the solution to\n"; - w << "! f(t1) = " << uy << "1, f(t2) = " << uy << "2\n"; - w << "!\n"; - w << "!" << std::string(130, '.') << "\n"; - w << "\n"; - - w << " TYPE(" << ddt.type_fortran << "), INTENT(" << (ddt.contains_mesh == 1 ? "INOUT" : "IN") - << ") :: " << uy << "1 ! " << ddt.name_short << " at t1 > t2\n"; - w << " TYPE(" << ddt.type_fortran << "), INTENT(" << (ddt.contains_mesh == 1 ? "INOUT" : "IN") - << ") :: " << uy << "2 ! " << ddt.name_short << " at t2 \n"; - w << " REAL(" << type_kind - << "), INTENT(IN ) :: tin(2) ! Times associated with the " - << ddt.name_short << "s\n"; - w << " TYPE(" << ddt.type_fortran << "), INTENT(INOUT) :: " << uy << "_out ! " - << ddt.name_short << " at tin_out\n"; - w << " REAL(" << type_kind - << "), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to\n"; - w << " INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation\n"; - w << " CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None\n"; - w << " ! local variables\n"; - w << " REAL(" << type_kind - << ") :: t(2) ! Times associated with the " - << ddt.name_short << "s\n"; - w << " REAL(" << type_kind - << ") :: t_out ! Time to which to be extrap/interpd\n"; - w << " CHARACTER(*), PARAMETER :: RoutineName = '" << mod.nickname << "_" - << ddt.name_short << "_ExtrapInterp1'\n"; - - w << " REAL(DbKi) :: b ! temporary for extrapolation/interpolation\n"; - w << " REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation\n"; - w << " INTEGER(IntKi) :: ErrStat2 ! local errors\n"; - w << " CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors\n"; + std::string indent("\n"); + std::string mod_ddt(mod.nickname + "_" + ddt.name_short); + + w << indent << "SUBROUTINE " << mod_ddt << "_ExtrapInterp1(" << uy << "1, " << uy << "2, tin, " << uy << "_out, tin_out, ErrStat, ErrMsg )"; + w << indent << "!"; + w << indent << "! This subroutine calculates a extrapolated (or interpolated) " << ddt.name_short << " " << uy << "_out at time t_out, from previous/future time"; + w << indent << "! values of " << uy << " (which has values associated with times in t). Order of the interpolation is 1."; + w << indent << "!"; + w << indent << "! f(t) = a + b * t, or"; + w << indent << "!"; + w << indent << "! where a and b are determined as the solution to"; + w << indent << "! f(t1) = " << uy << "1, f(t2) = " << uy << "2"; + w << indent << "!"; + w << indent << "!" << std::string(130, '.'); + w << indent; + indent += " "; + w << indent << "TYPE(" << ddt.type_fortran << "), INTENT(" << (ddt.contains_mesh == 1 ? "INOUT" : "IN") << ") :: " << uy << "1 ! " << ddt.name_short << " at t1 > t2"; + w << indent << "TYPE(" << ddt.type_fortran << "), INTENT(" << (ddt.contains_mesh == 1 ? "INOUT" : "IN") << ") :: " << uy << "2 ! " << ddt.name_short << " at t2 "; + w << indent << "REAL(" << type_kind << "), INTENT(IN ) :: tin(2) ! Times associated with the " << ddt.name_short << "s"; + w << indent << "TYPE(" << ddt.type_fortran << "), INTENT(INOUT) :: " << uy << "_out ! " << ddt.name_short << " at tin_out"; + w << indent << "REAL(" << type_kind << "), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to"; + w << indent << "INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation"; + w << indent << "CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None"; + w << indent << "! local variables"; + w << indent << "REAL(" << type_kind << ") :: t(2) ! Times associated with the " << ddt.name_short << "s"; + w << indent << "REAL(" << type_kind << ") :: t_out ! Time to which to be extrap/interpd"; + w << indent << "CHARACTER(*), PARAMETER :: RoutineName = '" << mod_ddt << "_ExtrapInterp1'"; + w << indent << "REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation"; + w << indent << "INTEGER(IntKi) :: ErrStat2 ! local errors"; + w << indent << "CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors"; + for (int j = 1; j <= max_rank; j++) { for (int i = 0; i <= max_nrecurs; i++) { - w << " INTEGER :: i" << i << j << " ! dim" << j - << " level " << i << " counter variable for arrays of ddts\n"; + w << indent << "INTEGER :: i" << i << j << " ! dim" << j + << " level " << i << " counter variable for arrays of ddts"; } } for (int j = 1; j <= max_rank; j++) { - w << " INTEGER :: i" << j << " ! dim" << j - << " counter variable for arrays\n"; + w << indent << "INTEGER :: i" << j << " ! dim" << j + << " counter variable for arrays"; } - w << " ! Initialize ErrStat\n"; - w << " ErrStat = ErrID_None\n"; - w << " ErrMsg = \"\"\n"; - w << " ! we'll subtract a constant from the times to resolve some \n"; - w << " ! numerical issues when t gets large (and to simplify the equations)\n"; - w << " t = tin - tin(1)\n"; - w << " t_out = tin_out - tin(1)\n"; - w << "\n"; - - w << " IF ( EqualRealNos( t(1), t(2) ) ) THEN\n"; - w << " CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName)\n"; - w << " RETURN\n"; - w << " END IF\n\n"; - - w << " ScaleFactor = t_out / t(2)" << std::endl; + w << indent << "! Initialize ErrStat"; + w << indent << "ErrStat = ErrID_None"; + w << indent << "ErrMsg = ''"; + w << indent << "! we'll subtract a constant from the times to resolve some "; + w << indent << "! numerical issues when t gets large (and to simplify the equations)"; + w << indent << "t = tin - tin(1)"; + w << indent << "t_out = tin_out - tin(1)"; + w << indent; + w << indent << "IF (EqualRealNos(t(1), t(2))) THEN"; + w << indent << " CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName)"; + w << indent << " RETURN"; + w << indent << "END IF"; + w << indent; + w << indent << "! Calculate weighting factors from Lagrange polynomial"; + w << indent << "a1 = -(t_out - t(2))/t(2)"; + w << indent << "a2 = t_out/t(2)"; + w << indent; + + // Recursively generate extrap interp code for (const auto &field : ddt.fields) - gen_extint_order(w, mod, uy, 1, field, "", 0); + gen_extint_order(w, mod, uy, 1, field, "", 0, indent); - w << " END SUBROUTINE " << mod.nickname << "_" << ddt.name_short << "_ExtrapInterp1\n"; - w << "\n"; + indent.erase(indent.size() - 3); + w << indent << "END SUBROUTINE"; + w << indent; } void gen_ExtrapInterp2(std::ostream &w, const Module &mod, const DataType::Derived &ddt, std::string &type_kind, std::string &uy, std::string &modPrefix, const int max_rank, const int max_nrecurs, const int max_alloc_ndims) { - w << "\n"; - w << " SUBROUTINE " << mod.nickname << "_" << ddt.name_short << "_ExtrapInterp2(" << uy << "1, " - << uy << "2, " << uy << "3, tin, " << uy << "_out, tin_out, ErrStat, ErrMsg )\n"; - w << "!\n"; - w << "! This subroutine calculates a extrapolated (or interpolated) " << ddt.name_short << " " - << uy << "_out at time t_out, from previous/future time\n"; - w << "! values of " << uy - << " (which has values associated with times in t). Order of the interpolation is 2.\n"; - w << "!\n"; - w << "! expressions below based on either\n"; - w << "!\n"; - w << "! f(t) = a + b * t + c * t**2\n"; - w << "!\n"; - w << "! where a, b and c are determined as the solution to\n"; - w << "! f(t1) = " << uy << "1, f(t2) = " << uy << "2, f(t3) = " << uy << "3\n"; - w << "!\n"; - w << "!" << std::string(130, '.') << "\n"; - w << "\n"; - - w << " TYPE(" << ddt.type_fortran << "), INTENT(" << (ddt.contains_mesh == 1 ? "INOUT" : "IN") - << ") :: " << uy << "1 ! " << ddt.name_short << " at t1 > t2 > t3\n"; - w << " TYPE(" << ddt.type_fortran << "), INTENT(" << (ddt.contains_mesh == 1 ? "INOUT" : "IN") - << ") :: " << uy << "2 ! " << ddt.name_short << " at t2 > t3\n"; - w << " TYPE(" << ddt.type_fortran << "), INTENT(" << (ddt.contains_mesh == 1 ? "INOUT" : "IN") - << ") :: " << uy << "3 ! " << ddt.name_short << " at t3\n"; - w << " REAL(" << type_kind - << "), INTENT(IN ) :: tin(3) ! Times associated with the " - << ddt.name_short << "s\n"; - w << " TYPE(" << ddt.type_fortran << "), INTENT(INOUT) :: " << uy << "_out ! " - << ddt.name_short << " at tin_out\n"; - w << " REAL(" << type_kind - << "), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to\n"; - - w << " INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation\n"; - w << " CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None\n"; - w << " ! local variables\n"; - w << " REAL(" << type_kind - << ") :: t(3) ! Times associated with the " - << ddt.name_short << "s\n"; - w << " REAL(" << type_kind - << ") :: t_out ! Time to which to be extrap/interpd\n"; - w << " INTEGER(IntKi) :: order ! order of polynomial fit (max 2)\n"; - - w << " REAL(DbKi) :: b ! temporary for extrapolation/interpolation\n"; - w << " REAL(DbKi) :: c ! temporary for extrapolation/interpolation\n"; - w << " REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation\n"; - w << " INTEGER(IntKi) :: ErrStat2 ! local errors\n"; - w << " CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors\n"; - w << " CHARACTER(*), PARAMETER :: RoutineName = '" << mod.nickname << "_" - << ddt.name_short << "_ExtrapInterp2'\n"; + std::string indent("\n"); + std::string ddt_intent(ddt.contains_mesh == 1 ? "INOUT" : "IN"); + + w << indent << "SUBROUTINE " << mod.nickname << "_" << ddt.name_short << "_ExtrapInterp2(" << uy << "1, " + << uy << "2, " << uy << "3, tin, " << uy << "_out, tin_out, ErrStat, ErrMsg )"; + w << indent << "!"; + w << indent << "! This subroutine calculates a extrapolated (or interpolated) " << ddt.name_short << " " + << uy << "_out at time t_out, from previous/future time"; + w << indent << "! values of " << uy + << " (which has values associated with times in t). Order of the interpolation is 2."; + w << indent << "!"; + w << indent << "! expressions below based on either"; + w << indent << "!"; + w << indent << "! f(t) = a + b * t + c * t**2"; + w << indent << "!"; + w << indent << "! where a, b and c are determined as the solution to"; + w << indent << "! f(t1) = " << uy << "1, f(t2) = " << uy << "2, f(t3) = " << uy << "3"; + w << indent << "!"; + w << indent << "!" << std::string(130, '.') << ""; + w << indent << ""; + indent += " "; + w << indent << "TYPE(" << ddt.type_fortran << "), INTENT(" << ddt_intent << ") :: " << uy << "1 ! " << ddt.name_short << " at t1 > t2 > t3"; + w << indent << "TYPE(" << ddt.type_fortran << "), INTENT(" << ddt_intent << ") :: " << uy << "2 ! " << ddt.name_short << " at t2 > t3"; + w << indent << "TYPE(" << ddt.type_fortran << "), INTENT(" << ddt_intent << ") :: " << uy << "3 ! " << ddt.name_short << " at t3"; + w << indent << "REAL(" << type_kind << "), INTENT(IN ) :: tin(3) ! Times associated with the " << ddt.name_short << "s"; + w << indent << "TYPE(" << ddt.type_fortran << "), INTENT(INOUT) :: " << uy << "_out ! " << ddt.name_short << " at tin_out"; + w << indent << "REAL(" << type_kind << "), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to"; + + w << indent << "INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation"; + w << indent << "CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None"; + w << indent << "! local variables"; + w << indent << "REAL(" << type_kind << ") :: t(3) ! Times associated with the " << ddt.name_short << "s"; + w << indent << "REAL(" << type_kind << ") :: t_out ! Time to which to be extrap/interpd"; + w << indent << "INTEGER(IntKi) :: order ! order of polynomial fit (max 2)"; + + w << indent << "REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation"; + // w << indent << "REAL(DbKi) :: b ! temporary for extrapolation/interpolation"; + // w << indent << "REAL(DbKi) :: c ! temporary for extrapolation/interpolation"; + // w << indent << "REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation"; + w << indent << "INTEGER(IntKi) :: ErrStat2 ! local errors"; + w << indent << "CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors"; + w << indent << "CHARACTER(*), PARAMETER :: RoutineName = '" << mod.nickname << "_" << ddt.name_short << "_ExtrapInterp2'"; for (int j = 1; j <= max_rank; j++) { for (int i = 0; i <= max_nrecurs; i++) { - w << " INTEGER :: i" << i << j << " ! dim" << j - << " level " << i << " counter variable for arrays of ddts\n"; + w << indent << "INTEGER :: i" << i << j << " ! dim" << j << " level " << i << " counter variable for arrays of ddts"; } } for (int j = 1; j <= max_rank; j++) { - w << " INTEGER :: i" << j << " ! dim" << j - << " counter variable for arrays\n"; + w << indent << "INTEGER :: i" << j << " ! dim" << j << " counter variable for arrays"; } - w << " ! Initialize ErrStat\n"; - w << " ErrStat = ErrID_None\n"; - w << " ErrMsg = \"\"\n"; - w << " ! we'll subtract a constant from the times to resolve some \n"; - w << " ! numerical issues when t gets large (and to simplify the equations)\n"; - w << " t = tin - tin(1)\n"; - w << " t_out = tin_out - tin(1)\n"; - w << "\n"; - - w << " IF ( EqualRealNos( t(1), t(2) ) ) THEN\n"; - w << " CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName)\n"; - w << " RETURN\n"; - w << " ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN\n"; - w << " CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName)\n"; - w << " RETURN\n"; - w << " ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN\n"; - w << " CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName)\n"; - w << " RETURN\n"; - w << " END IF\n\n"; - - w << " ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3)))\n"; - - // recursive + w << indent << "! Initialize ErrStat"; + w << indent << "ErrStat = ErrID_None"; + w << indent << "ErrMsg = ''"; + w << indent << "! we'll subtract a constant from the times to resolve some "; + w << indent << "! numerical issues when t gets large (and to simplify the equations)"; + w << indent << "t = tin - tin(1)"; + w << indent << "t_out = tin_out - tin(1)"; + w << indent; + w << indent << "IF ( EqualRealNos( t(1), t(2) ) ) THEN"; + w << indent << " CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName)"; + w << indent << " RETURN"; + w << indent << "ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN"; + w << indent << " CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName)"; + w << indent << " RETURN"; + w << indent << "ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN"; + w << indent << " CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName)"; + w << indent << " RETURN"; + w << indent << "END IF"; + w << indent; + // w << indent << "ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3)))"; + w << indent << "! Calculate Lagrange polynomial coefficients"; + w << indent << "a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3)))"; + w << indent << "a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3)))"; + w << indent << "a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2)))"; + + // Recursively generate extrap interp code for (const auto &field : ddt.fields) - { - gen_extint_order(w, mod, uy, 2, field, "", 0); - } + gen_extint_order(w, mod, uy, 2, field, "", 0, indent); - w << " END SUBROUTINE " << mod.nickname << "_" << ddt.name_short << "_ExtrapInterp2\n"; - w << "\n"; + indent.erase(indent.size() - 3); + w << indent << "END SUBROUTINE"; + w << indent; } void gen_ExtrapInterp(std::ostream &w, const Module &mod, std::string type_name_long, @@ -1366,77 +1345,71 @@ void gen_ExtrapInterp(std::ostream &w, const Module &mod, std::string type_name_ return; const auto &ddt = dt->derived; + std::string mod_ddt = mod.nickname + "_" + ddt.name_short; + std::string uy = tolower(ddt.name_short).compare("output") == 0 ? "y" : "u"; + std::string indent("\n"); - w << "\n"; - w << " SUBROUTINE " << mod.nickname << "_" << ddt.name_short << "_ExtrapInterp(" << uy - << ", t, " << uy << "_out, t_out, ErrStat, ErrMsg )\n"; - w << "!\n"; - w << "! This subroutine calculates a extrapolated (or interpolated) " << ddt.name_short << " " - << uy << "_out at time t_out, from previous/future time\n"; - w << "! values of " << uy - << " (which has values associated with times in t). Order of the interpolation is given by the size of " - << uy << "\n"; - w << "!\n"; - w << "! expressions below based on either\n"; - w << "!\n"; - w << "! f(t) = a\n"; - w << "! f(t) = a + b * t, or\n"; - w << "! f(t) = a + b * t + c * t**2\n"; - w << "!\n"; - w << "! where a, b and c are determined as the solution to\n"; - w << "! f(t1) = " << uy << "1, f(t2) = " << uy << "2, f(t3) = " << uy - << "3 (as appropriate)\n"; - w << "!\n"; - w << "!" << std::string(130, '.') << "\n"; - w << "\n"; - w << " TYPE(" << ddt.type_fortran << "), INTENT(" << (ddt.contains_mesh == 1 ? "INOUT" : "IN") - << ") :: " << uy << "(:) ! " << ddt.name_short << " at t1 > t2 > t3\n"; - w << " REAL(" << type_kind - << "), INTENT(IN ) :: t(:) ! Times associated with the " - << ddt.name_short << "s\n"; + w << indent << "subroutine " << mod_ddt << "_ExtrapInterp(" << uy << ", t, " << uy << "_out, t_out, ErrStat, ErrMsg)"; + indent += " "; + w << indent << "!"; + w << indent << "! This subroutine calculates a extrapolated (or interpolated) " << ddt.name_short << " " + << uy << "_out at time t_out, from previous/future time"; + w << indent << "! values of " << uy + << " (which has values associated with times in t). Order of the interpolation is given by the size of " << uy; + w << indent << "!"; + w << indent << "! expressions below based on either"; + w << indent << "!"; + w << indent << "! f(t) = a"; + w << indent << "! f(t) = a + b * t, or"; + w << indent << "! f(t) = a + b * t + c * t**2"; + w << indent << "!"; + w << indent << "! where a, b and c are determined as the solution to"; + w << indent << "! f(t1) = " << uy << "1, f(t2) = " << uy << "2, f(t3) = " << uy << "3 (as appropriate)"; + w << indent << "!"; + w << indent << "!" << std::string(130, '-'); + w << indent << ""; + w << indent << "type(" << ddt.type_fortran << "), intent(" << (ddt.contains_mesh == 1 ? "inout" : "in") + << ") :: " << uy << "(:) ! " << ddt.name_short << " at t1 > t2 > t3"; + w << indent << "real(" << type_kind << "), intent(in ) :: t(:) ! Times associated with the " + << ddt.name_short << "s"; // Intent must be (INOUT) to prevent ALLOCATABLE array arguments in the DDT from // being deallocated in this call. See Sec. 5.1.2.7 of Fortran 2003 standard - w << " TYPE(" << ddt.type_fortran << "), INTENT(INOUT) :: " << uy << "_out ! " - << ddt.name_short << " at tin_out\n"; - w << " REAL(" << type_kind - << "), INTENT(IN ) :: t_out ! time to be extrap/interp'd to\n"; - w << " INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation\n"; - w << " CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None\n"; - w << " ! local variables\n"; - w << " INTEGER(IntKi) :: order ! order of polynomial fit (max 2)\n"; - w << " INTEGER(IntKi) :: ErrStat2 ! local errors\n"; - w << " CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors\n"; - w << " CHARACTER(*), PARAMETER :: RoutineName = '" << mod.nickname << "_" - << ddt.name_short << "_ExtrapInterp'\n"; - w << " ! Initialize ErrStat\n"; - w << " ErrStat = ErrID_None\n"; - w << " ErrMsg = \"\"\n"; - w << " if ( size(t) .ne. size(" << uy << ")) then\n"; - w << " CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(" << uy - << ")',ErrStat,ErrMsg,RoutineName)\n"; - w << " RETURN\n"; - w << " endif\n"; - w << " order = SIZE(" << uy << ") - 1\n"; - w << " IF ( order .eq. 0 ) THEN\n"; - w << " CALL " << mod.nickname << "_Copy" << ddt.name_short << "(" << uy << "(1), " << uy - << "_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 )\n"; - w << " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName)\n"; - w << " ELSE IF ( order .eq. 1 ) THEN\n"; - w << " CALL " << mod.nickname << "_" << ddt.name_short << "_ExtrapInterp1(" << uy << "(1), " - << uy << "(2), t, " << uy << "_out, t_out, ErrStat2, ErrMsg2 )\n"; - w << " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName)\n"; - w << " ELSE IF ( order .eq. 2 ) THEN\n"; - w << " CALL " << mod.nickname << "_" << ddt.name_short << "_ExtrapInterp2(" << uy << "(1), " - << uy << "(2), " << uy << "(3), t, " << uy << "_out, t_out, ErrStat2, ErrMsg2 )\n"; - w << " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName)\n"; - w << " ELSE \n"; - w << " CALL SetErrStat(ErrID_Fatal,'size(" << uy - << ") must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName)\n"; - w << " RETURN\n"; - w << " ENDIF \n"; - w << " END SUBROUTINE " << mod.nickname << "_" << ddt.name_short << "_ExtrapInterp\n"; - w << "\n"; + w << indent << "type(" << ddt.type_fortran << "), intent(inout) :: " << uy << "_out ! " << ddt.name_short << " at tin_out"; + w << indent << "real(" << type_kind << "), intent(in ) :: t_out ! time to be extrap/interp'd to"; + w << indent << "integer(IntKi), intent( out) :: ErrStat ! Error status of the operation"; + w << indent << "character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None"; + w << indent << "! local variables"; + w << indent << "integer(IntKi) :: order ! order of polynomial fit (max 2)"; + w << indent << "integer(IntKi) :: ErrStat2 ! local errors"; + w << indent << "character(ErrMsgLen) :: ErrMsg2 ! local errors"; + w << indent << "character(*), PARAMETER :: RoutineName = '" << mod_ddt << "_ExtrapInterp'"; + w << indent; + w << indent << "! Initialize ErrStat"; + w << indent << "ErrStat = ErrID_None"; + w << indent << "ErrMsg = ''"; + w << indent << "if (size(t) /= size(" << uy << ")) then"; + w << indent << " call SetErrStat(ErrID_Fatal, 'size(t) must equal size(" << uy << ")', ErrStat, ErrMsg, RoutineName)"; + w << indent << " return"; + w << indent << "endif"; + w << indent << "order = size(" << uy << ") - 1"; + w << indent << "select case (order)"; + w << indent << "case (0)"; + w << indent << " call " << mod.nickname << "_Copy" << ddt.name_short << "(" << uy << "(1), " << uy << "_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2)"; + w << indent << " call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)"; + w << indent << "case (1)"; + w << indent << " call " << mod_ddt << "_ExtrapInterp1(" << uy << "(1), " << uy << "(2), t, " << uy << "_out, t_out, ErrStat2, ErrMsg2)"; + w << indent << " call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)"; + w << indent << "case (2)"; + w << indent << " call " << mod_ddt << "_ExtrapInterp2(" << uy << "(1), " << uy << "(2), " << uy << "(3), t, " << uy << "_out, t_out, ErrStat2, ErrMsg2)"; + w << indent << " call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)"; + w << indent << "case default"; + w << indent << " call SetErrStat(ErrID_Fatal, 'size(" << uy << ") must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName)"; + w << indent << " return"; + w << indent << "end select"; + indent.erase(indent.size() - 3); + w << indent << "end subroutine"; + w << indent; // bjj: this is max for module, not for type_name_long int max_rank = 0; // mod.module_ddt_list->max_ndims; @@ -1445,9 +1418,7 @@ void gen_ExtrapInterp(std::ostream &w, const Module &mod, std::string type_name_ // Recursively calculate extrap/interp order for (const auto &field : ddt.fields) - { calc_extint_order(w, mod, field, 0, max_rank, max_nrecurs, max_alloc_ndims); - } // Generate first order extrap/interp routine gen_ExtrapInterp1(w, mod, ddt, type_kind, uy, modPrefix, max_rank, max_nrecurs, @@ -1461,37 +1432,33 @@ void gen_ExtrapInterp(std::ostream &w, const Module &mod, std::string type_name_ void gen_copy_c2f(std::ostream &w, const Module &mod, const DataType::Derived &ddt) { std::string routine_name = mod.nickname + "_C2Fary_Copy" + ddt.name_short; + std::string indent("\n"); - w << " SUBROUTINE " << routine_name << "( " << ddt.name_short - << "Data, ErrStat, ErrMsg, SkipPointers )\n"; - w << " TYPE(" << ddt.type_fortran << "), INTENT(INOUT) :: " << ddt.name_short << "Data\n"; - w << " INTEGER(IntKi), INTENT( OUT) :: ErrStat\n"; - w << " CHARACTER(*), INTENT( OUT) :: ErrMsg\n"; - w << " LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers\n"; - w << " ! \n"; - w << " LOGICAL :: SkipPointers_local\n"; - w << " ErrStat = ErrID_None\n"; - w << " ErrMsg = \"\"\n\n"; - w << " IF (PRESENT(SkipPointers)) THEN\n"; - w << " SkipPointers_local = SkipPointers\n"; - w << " ELSE\n"; - w << " SkipPointers_local = .false.\n"; - w << " END IF\n"; + w << indent << "SUBROUTINE " << routine_name << "(" << ddt.name_short << "Data, ErrStat, ErrMsg, SkipPointers)"; + indent += " "; + w << indent << "TYPE(" << ddt.type_fortran << "), INTENT(INOUT) :: " << ddt.name_short << "Data"; + w << indent << "INTEGER(IntKi), INTENT( OUT) :: ErrStat"; + w << indent << "CHARACTER(*), INTENT( OUT) :: ErrMsg"; + w << indent << "LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers"; + w << indent << "! "; + w << indent << "LOGICAL :: SkipPointers_local"; + w << indent << "ErrStat = ErrID_None"; + w << indent << "ErrMsg = \"\""; + w << indent; + w << indent << "IF (PRESENT(SkipPointers)) THEN"; + w << indent << " SkipPointers_local = SkipPointers"; + w << indent << "ELSE"; + w << indent << " SkipPointers_local = .false."; + w << indent << "END IF"; // Loop through fields in derived data type for (const auto &field : ddt.fields) { - // If field doesn't have a data type, continue - if (field.data_type == nullptr) - { - continue; - } - // If field is a derived type, print warning and continue if (field.data_type->tag == DataType::Tag::Derived) { std::cerr << "Registry WARNING: derived data type " << field.name << " of type " - << field.data_type->derived.name << " is not passed through C interface\n"; + << field.data_type->derived.name << " is not passed through C interface"; continue; } @@ -1499,15 +1466,15 @@ void gen_copy_c2f(std::ostream &w, const Module &mod, const DataType::Derived &d std::string var_c = ddt.name_short + "Data%C_obj%" + field.name; if (field.is_pointer) { - w << "\n ! -- " << field.name << " " << ddt.name_short << " Data fields\n"; - w << " IF ( .NOT. SkipPointers_local ) THEN\n"; - w << " IF ( .NOT. C_ASSOCIATED( " << var_c << " ) ) THEN\n"; - w << " NULLIFY( " << var_f << " )\n"; - w << " ELSE\n"; - w << " CALL C_F_POINTER(" << var_c << ", " << var_f << ", (/" << var_c - << "_Len/))\n"; - w << " END IF\n"; - w << " END IF\n"; + w << indent; + w << indent << "! -- " << field.name << " " << ddt.name_short << " Data fields"; + w << indent << "IF ( .NOT. SkipPointers_local ) THEN"; + w << indent << " IF ( .NOT. C_ASSOCIATED( " << var_c << " ) ) THEN"; + w << indent << " NULLIFY( " << var_f << " )"; + w << indent << " ELSE"; + w << indent << " CALL C_F_POINTER(" << var_c << ", " << var_f << ", [" << var_c << "_Len])"; + w << indent << " END IF"; + w << indent << "END IF"; } else if (!field.is_allocatable) { @@ -1516,11 +1483,11 @@ void gen_copy_c2f(std::ostream &w, const Module &mod, const DataType::Derived &d case DataType::Tag::Real: case DataType::Tag::Integer: case DataType::Tag::Logical: - w << " " << var_f << " = " << var_c << "\n"; + w << indent << var_f << " = " << var_c; break; case DataType::Tag::Character: if (field.rank == 0) - w << " " << var_f << " = TRANSFER(" << var_c << ", " << var_f << " )\n"; + w << indent << var_f << " = TRANSFER(" << var_c << ", " << var_f << " )"; break; case DataType::Tag::Derived: break; @@ -1528,38 +1495,35 @@ void gen_copy_c2f(std::ostream &w, const Module &mod, const DataType::Derived &d } } - w << " END SUBROUTINE " << routine_name << "\n\n"; + indent.erase(indent.size() - 3); + w << indent << "END SUBROUTINE"; + w << indent; } void gen_copy_f2c(std::ostream &w, const Module &mod, const DataType::Derived &ddt) { std::string routine_name = mod.nickname + "_F2C_Copy" + ddt.name_short; + std::string indent("\n"); - w << " SUBROUTINE " << routine_name << "( " << ddt.name_short - << "Data, ErrStat, ErrMsg, SkipPointers )\n"; - w << " TYPE(" << ddt.type_fortran << "), INTENT(INOUT) :: " << ddt.name_short << "Data\n"; - w << " INTEGER(IntKi), INTENT( OUT) :: ErrStat\n"; - w << " CHARACTER(*), INTENT( OUT) :: ErrMsg\n"; - w << " LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers\n"; - w << " ! \n"; - w << " LOGICAL :: SkipPointers_local\n"; - w << " ErrStat = ErrID_None\n"; - w << " ErrMsg = \"\"\n\n"; - w << " IF (PRESENT(SkipPointers)) THEN\n"; - w << " SkipPointers_local = SkipPointers\n"; - w << " ELSE\n"; - w << " SkipPointers_local = .false.\n"; - w << " END IF\n"; + w << indent << "SUBROUTINE " << routine_name << "( " << ddt.name_short << "Data, ErrStat, ErrMsg, SkipPointers )"; + indent += " "; + w << indent << "TYPE(" << ddt.type_fortran << "), INTENT(INOUT) :: " << ddt.name_short << "Data"; + w << indent << "INTEGER(IntKi), INTENT( OUT) :: ErrStat"; + w << indent << "CHARACTER(*), INTENT( OUT) :: ErrMsg"; + w << indent << "LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers"; + w << indent << "! "; + w << indent << "LOGICAL :: SkipPointers_local"; + w << indent << "ErrStat = ErrID_None"; + w << indent << "ErrMsg = ''"; + w << indent; + w << indent << "IF (PRESENT(SkipPointers)) THEN"; + w << indent << " SkipPointers_local = SkipPointers"; + w << indent << "ELSE"; + w << indent << " SkipPointers_local = .false."; + w << indent << "END IF"; for (const auto &field : ddt.fields) { - - // If field doesn't have a data type, continue - if (field.data_type == nullptr) - { - continue; - } - // If field is a derived type, print warning and continue if (field.data_type->tag == DataType::Tag::Derived) { @@ -1573,36 +1537,34 @@ void gen_copy_f2c(std::ostream &w, const Module &mod, const DataType::Derived &d if (field.is_pointer) { - w << "\n ! -- " << field.name << " " << ddt.name_short << " Data fields\n"; - w << " IF ( .NOT. SkipPointers_local ) THEN\n"; - w << " IF ( .NOT. ASSOCIATED(" << var_f << ")) THEN \n"; - w << " " << var_c << "_Len = 0\n"; - w << " " << var_c << " = C_NULL_PTR\n"; - w << " ELSE\n"; - w << " " << var_c << "_Len = SIZE(" << var_f << ")\n"; - w << " IF (" << var_c << "_Len > 0) &\n"; - w << " " << var_c << " = C_LOC( " << var_f << "("; + std::string dims; for (int d = 1; d <= field.rank; d++) - { - w << (d > 1 ? "," : "") << " LBOUND(" << var_f << "," << d << ")"; - } - w << " ) )\n"; - w << " END IF\n"; - w << " END IF\n"; + dims += std::string(d > 1 ? "," : "") + "LBOUND(" + var_f + "," + std::to_string(d) + ")"; + w << indent; + w << indent << "! -- " << field.name << " " << ddt.name_short << " Data fields"; + w << indent << "IF (.NOT. SkipPointers_local ) THEN"; + w << indent << " IF (.NOT. ASSOCIATED(" << var_f << ")) THEN "; + w << indent << " " << var_c << "_Len = 0"; + w << indent << " " << var_c << " = C_NULL_PTR"; + w << indent << " ELSE"; + w << indent << " " << var_c << "_Len = SIZE(" << var_f << ")"; + w << indent << " IF (" << var_c << "_Len > 0) &"; + w << indent << " " << var_c << " = C_LOC(" << var_f << "(" << dims << "))"; + w << indent << " END IF"; + w << indent << "END IF"; } else if (!field.is_allocatable) { - switch (field.data_type->tag) { case DataType::Tag::Real: case DataType::Tag::Integer: case DataType::Tag::Logical: - w << " " << var_c << " = " << var_f << "\n"; + w << indent << var_c << " = " << var_f; break; case DataType::Tag::Character: if (field.rank == 0) - w << " " << var_c << " = TRANSFER(" << var_f << ", " << var_c << " )\n"; + w << indent << var_c << " = TRANSFER(" << var_f << ", " << var_c << ")"; break; case DataType::Tag::Derived: break; @@ -1610,5 +1572,7 @@ void gen_copy_f2c(std::ostream &w, const Module &mod, const DataType::Derived &d } } - w << " END SUBROUTINE " << routine_name << "\n\n"; + indent.erase(indent.size() - 3); + w << indent << "END SUBROUTINE"; + w << indent; } \ No newline at end of file diff --git a/modules/openfoam/src/OpenFOAM_Types.f90 b/modules/openfoam/src/OpenFOAM_Types.f90 index 5c478719c2..46c91244d1 100644 --- a/modules/openfoam/src/OpenFOAM_Types.f90 +++ b/modules/openfoam/src/OpenFOAM_Types.f90 @@ -395,94 +395,94 @@ subroutine OpFM_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%NodeClusterType = OutData%NodeClusterType end subroutine - SUBROUTINE OpFM_C2Fary_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(OpFM_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - InitInputData%NumActForcePtsBlade = InitInputData%C_obj%NumActForcePtsBlade - InitInputData%NumActForcePtsTower = InitInputData%C_obj%NumActForcePtsTower - - ! -- StructBldRNodes InitInput Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InitInputData%C_obj%StructBldRNodes ) ) THEN - NULLIFY( InitInputData%StructBldRNodes ) - ELSE - CALL C_F_POINTER(InitInputData%C_obj%StructBldRNodes, InitInputData%StructBldRNodes, (/InitInputData%C_obj%StructBldRNodes_Len/)) - END IF - END IF - - ! -- StructTwrHNodes InitInput Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InitInputData%C_obj%StructTwrHNodes ) ) THEN - NULLIFY( InitInputData%StructTwrHNodes ) - ELSE - CALL C_F_POINTER(InitInputData%C_obj%StructTwrHNodes, InitInputData%StructTwrHNodes, (/InitInputData%C_obj%StructTwrHNodes_Len/)) - END IF - END IF - InitInputData%BladeLength = InitInputData%C_obj%BladeLength - InitInputData%TowerHeight = InitInputData%C_obj%TowerHeight - InitInputData%TowerBaseHeight = InitInputData%C_obj%TowerBaseHeight - InitInputData%NodeClusterType = InitInputData%C_obj%NodeClusterType - END SUBROUTINE OpFM_C2Fary_CopyInitInput - - SUBROUTINE OpFM_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(OpFM_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - InitInputData%C_obj%NumActForcePtsBlade = InitInputData%NumActForcePtsBlade - InitInputData%C_obj%NumActForcePtsTower = InitInputData%NumActForcePtsTower - - ! -- StructBldRNodes InitInput Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InitInputData%StructBldRNodes)) THEN - InitInputData%C_obj%StructBldRNodes_Len = 0 - InitInputData%C_obj%StructBldRNodes = C_NULL_PTR - ELSE - InitInputData%C_obj%StructBldRNodes_Len = SIZE(InitInputData%StructBldRNodes) - IF (InitInputData%C_obj%StructBldRNodes_Len > 0) & - InitInputData%C_obj%StructBldRNodes = C_LOC( InitInputData%StructBldRNodes( LBOUND(InitInputData%StructBldRNodes,1) ) ) - END IF - END IF - - ! -- StructTwrHNodes InitInput Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InitInputData%StructTwrHNodes)) THEN - InitInputData%C_obj%StructTwrHNodes_Len = 0 - InitInputData%C_obj%StructTwrHNodes = C_NULL_PTR - ELSE - InitInputData%C_obj%StructTwrHNodes_Len = SIZE(InitInputData%StructTwrHNodes) - IF (InitInputData%C_obj%StructTwrHNodes_Len > 0) & - InitInputData%C_obj%StructTwrHNodes = C_LOC( InitInputData%StructTwrHNodes( LBOUND(InitInputData%StructTwrHNodes,1) ) ) - END IF - END IF - InitInputData%C_obj%BladeLength = InitInputData%BladeLength - InitInputData%C_obj%TowerHeight = InitInputData%TowerHeight - InitInputData%C_obj%TowerBaseHeight = InitInputData%TowerBaseHeight - InitInputData%C_obj%NodeClusterType = InitInputData%NodeClusterType - END SUBROUTINE OpFM_F2C_CopyInitInput +SUBROUTINE OpFM_C2Fary_CopyInitInput(InitInputData, ErrStat, ErrMsg, SkipPointers) + TYPE(OpFM_InitInputType), INTENT(INOUT) :: InitInputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + InitInputData%NumActForcePtsBlade = InitInputData%C_obj%NumActForcePtsBlade + InitInputData%NumActForcePtsTower = InitInputData%C_obj%NumActForcePtsTower + + ! -- StructBldRNodes InitInput Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InitInputData%C_obj%StructBldRNodes ) ) THEN + NULLIFY( InitInputData%StructBldRNodes ) + ELSE + CALL C_F_POINTER(InitInputData%C_obj%StructBldRNodes, InitInputData%StructBldRNodes, [InitInputData%C_obj%StructBldRNodes_Len]) + END IF + END IF + + ! -- StructTwrHNodes InitInput Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InitInputData%C_obj%StructTwrHNodes ) ) THEN + NULLIFY( InitInputData%StructTwrHNodes ) + ELSE + CALL C_F_POINTER(InitInputData%C_obj%StructTwrHNodes, InitInputData%StructTwrHNodes, [InitInputData%C_obj%StructTwrHNodes_Len]) + END IF + END IF + InitInputData%BladeLength = InitInputData%C_obj%BladeLength + InitInputData%TowerHeight = InitInputData%C_obj%TowerHeight + InitInputData%TowerBaseHeight = InitInputData%C_obj%TowerBaseHeight + InitInputData%NodeClusterType = InitInputData%C_obj%NodeClusterType +END SUBROUTINE + +SUBROUTINE OpFM_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(OpFM_InitInputType), INTENT(INOUT) :: InitInputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + InitInputData%C_obj%NumActForcePtsBlade = InitInputData%NumActForcePtsBlade + InitInputData%C_obj%NumActForcePtsTower = InitInputData%NumActForcePtsTower + + ! -- StructBldRNodes InitInput Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(InitInputData%StructBldRNodes)) THEN + InitInputData%C_obj%StructBldRNodes_Len = 0 + InitInputData%C_obj%StructBldRNodes = C_NULL_PTR + ELSE + InitInputData%C_obj%StructBldRNodes_Len = SIZE(InitInputData%StructBldRNodes) + IF (InitInputData%C_obj%StructBldRNodes_Len > 0) & + InitInputData%C_obj%StructBldRNodes = C_LOC(InitInputData%StructBldRNodes(LBOUND(InitInputData%StructBldRNodes,1))) + END IF + END IF + + ! -- StructTwrHNodes InitInput Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(InitInputData%StructTwrHNodes)) THEN + InitInputData%C_obj%StructTwrHNodes_Len = 0 + InitInputData%C_obj%StructTwrHNodes = C_NULL_PTR + ELSE + InitInputData%C_obj%StructTwrHNodes_Len = SIZE(InitInputData%StructTwrHNodes) + IF (InitInputData%C_obj%StructTwrHNodes_Len > 0) & + InitInputData%C_obj%StructTwrHNodes = C_LOC(InitInputData%StructTwrHNodes(LBOUND(InitInputData%StructTwrHNodes,1))) + END IF + END IF + InitInputData%C_obj%BladeLength = InitInputData%BladeLength + InitInputData%C_obj%TowerHeight = InitInputData%TowerHeight + InitInputData%C_obj%TowerBaseHeight = InitInputData%TowerBaseHeight + InitInputData%C_obj%NodeClusterType = InitInputData%NodeClusterType +END SUBROUTINE subroutine OpFM_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) type(OpFM_InitOutputType), intent(in) :: SrcInitOutputData @@ -605,40 +605,40 @@ subroutine OpFM_UnPackInitOutput(Buf, OutData) end if call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver end subroutine - SUBROUTINE OpFM_C2Fary_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(OpFM_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - END SUBROUTINE OpFM_C2Fary_CopyInitOutput - - SUBROUTINE OpFM_F2C_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(OpFM_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - END SUBROUTINE OpFM_F2C_CopyInitOutput +SUBROUTINE OpFM_C2Fary_CopyInitOutput(InitOutputData, ErrStat, ErrMsg, SkipPointers) + TYPE(OpFM_InitOutputType), INTENT(INOUT) :: InitOutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF +END SUBROUTINE + +SUBROUTINE OpFM_F2C_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(OpFM_InitOutputType), INTENT(INOUT) :: InitOutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF +END SUBROUTINE subroutine OpFM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) type(OpFM_MiscVarType), intent(inout) :: SrcMiscData @@ -888,40 +888,40 @@ subroutine OpFM_UnPackMisc(Buf, OutData) end do end if end subroutine - SUBROUTINE OpFM_C2Fary_CopyMisc( MiscData, ErrStat, ErrMsg, SkipPointers ) - TYPE(OpFM_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - END SUBROUTINE OpFM_C2Fary_CopyMisc - - SUBROUTINE OpFM_F2C_CopyMisc( MiscData, ErrStat, ErrMsg, SkipPointers ) - TYPE(OpFM_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - END SUBROUTINE OpFM_F2C_CopyMisc +SUBROUTINE OpFM_C2Fary_CopyMisc(MiscData, ErrStat, ErrMsg, SkipPointers) + TYPE(OpFM_MiscVarType), INTENT(INOUT) :: MiscData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF +END SUBROUTINE + +SUBROUTINE OpFM_F2C_CopyMisc( MiscData, ErrStat, ErrMsg, SkipPointers ) + TYPE(OpFM_MiscVarType), INTENT(INOUT) :: MiscData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF +END SUBROUTINE subroutine OpFM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) type(OpFM_ParameterType), intent(in) :: SrcParamData @@ -1145,104 +1145,104 @@ subroutine OpFM_UnPackParam(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%NodeClusterType = OutData%NodeClusterType end subroutine - SUBROUTINE OpFM_C2Fary_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) - TYPE(OpFM_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - ParamData%AirDens = ParamData%C_obj%AirDens - ParamData%NumBl = ParamData%C_obj%NumBl - ParamData%NMappings = ParamData%C_obj%NMappings - ParamData%NnodesVel = ParamData%C_obj%NnodesVel - ParamData%NnodesForce = ParamData%C_obj%NnodesForce - ParamData%NnodesForceBlade = ParamData%C_obj%NnodesForceBlade - ParamData%NnodesForceTower = ParamData%C_obj%NnodesForceTower - - ! -- forceBldRnodes Param Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%forceBldRnodes ) ) THEN - NULLIFY( ParamData%forceBldRnodes ) - ELSE - CALL C_F_POINTER(ParamData%C_obj%forceBldRnodes, ParamData%forceBldRnodes, (/ParamData%C_obj%forceBldRnodes_Len/)) - END IF - END IF - - ! -- forceTwrHnodes Param Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%forceTwrHnodes ) ) THEN - NULLIFY( ParamData%forceTwrHnodes ) - ELSE - CALL C_F_POINTER(ParamData%C_obj%forceTwrHnodes, ParamData%forceTwrHnodes, (/ParamData%C_obj%forceTwrHnodes_Len/)) - END IF - END IF - ParamData%BladeLength = ParamData%C_obj%BladeLength - ParamData%TowerHeight = ParamData%C_obj%TowerHeight - ParamData%TowerBaseHeight = ParamData%C_obj%TowerBaseHeight - ParamData%NodeClusterType = ParamData%C_obj%NodeClusterType - END SUBROUTINE OpFM_C2Fary_CopyParam - - SUBROUTINE OpFM_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) - TYPE(OpFM_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - ParamData%C_obj%AirDens = ParamData%AirDens - ParamData%C_obj%NumBl = ParamData%NumBl - ParamData%C_obj%NMappings = ParamData%NMappings - ParamData%C_obj%NnodesVel = ParamData%NnodesVel - ParamData%C_obj%NnodesForce = ParamData%NnodesForce - ParamData%C_obj%NnodesForceBlade = ParamData%NnodesForceBlade - ParamData%C_obj%NnodesForceTower = ParamData%NnodesForceTower - - ! -- forceBldRnodes Param Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(ParamData%forceBldRnodes)) THEN - ParamData%C_obj%forceBldRnodes_Len = 0 - ParamData%C_obj%forceBldRnodes = C_NULL_PTR - ELSE - ParamData%C_obj%forceBldRnodes_Len = SIZE(ParamData%forceBldRnodes) - IF (ParamData%C_obj%forceBldRnodes_Len > 0) & - ParamData%C_obj%forceBldRnodes = C_LOC( ParamData%forceBldRnodes( LBOUND(ParamData%forceBldRnodes,1) ) ) - END IF - END IF - - ! -- forceTwrHnodes Param Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(ParamData%forceTwrHnodes)) THEN - ParamData%C_obj%forceTwrHnodes_Len = 0 - ParamData%C_obj%forceTwrHnodes = C_NULL_PTR - ELSE - ParamData%C_obj%forceTwrHnodes_Len = SIZE(ParamData%forceTwrHnodes) - IF (ParamData%C_obj%forceTwrHnodes_Len > 0) & - ParamData%C_obj%forceTwrHnodes = C_LOC( ParamData%forceTwrHnodes( LBOUND(ParamData%forceTwrHnodes,1) ) ) - END IF - END IF - ParamData%C_obj%BladeLength = ParamData%BladeLength - ParamData%C_obj%TowerHeight = ParamData%TowerHeight - ParamData%C_obj%TowerBaseHeight = ParamData%TowerBaseHeight - ParamData%C_obj%NodeClusterType = ParamData%NodeClusterType - END SUBROUTINE OpFM_F2C_CopyParam +SUBROUTINE OpFM_C2Fary_CopyParam(ParamData, ErrStat, ErrMsg, SkipPointers) + TYPE(OpFM_ParameterType), INTENT(INOUT) :: ParamData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + ParamData%AirDens = ParamData%C_obj%AirDens + ParamData%NumBl = ParamData%C_obj%NumBl + ParamData%NMappings = ParamData%C_obj%NMappings + ParamData%NnodesVel = ParamData%C_obj%NnodesVel + ParamData%NnodesForce = ParamData%C_obj%NnodesForce + ParamData%NnodesForceBlade = ParamData%C_obj%NnodesForceBlade + ParamData%NnodesForceTower = ParamData%C_obj%NnodesForceTower + + ! -- forceBldRnodes Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%forceBldRnodes ) ) THEN + NULLIFY( ParamData%forceBldRnodes ) + ELSE + CALL C_F_POINTER(ParamData%C_obj%forceBldRnodes, ParamData%forceBldRnodes, [ParamData%C_obj%forceBldRnodes_Len]) + END IF + END IF + + ! -- forceTwrHnodes Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%forceTwrHnodes ) ) THEN + NULLIFY( ParamData%forceTwrHnodes ) + ELSE + CALL C_F_POINTER(ParamData%C_obj%forceTwrHnodes, ParamData%forceTwrHnodes, [ParamData%C_obj%forceTwrHnodes_Len]) + END IF + END IF + ParamData%BladeLength = ParamData%C_obj%BladeLength + ParamData%TowerHeight = ParamData%C_obj%TowerHeight + ParamData%TowerBaseHeight = ParamData%C_obj%TowerBaseHeight + ParamData%NodeClusterType = ParamData%C_obj%NodeClusterType +END SUBROUTINE + +SUBROUTINE OpFM_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) + TYPE(OpFM_ParameterType), INTENT(INOUT) :: ParamData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + ParamData%C_obj%AirDens = ParamData%AirDens + ParamData%C_obj%NumBl = ParamData%NumBl + ParamData%C_obj%NMappings = ParamData%NMappings + ParamData%C_obj%NnodesVel = ParamData%NnodesVel + ParamData%C_obj%NnodesForce = ParamData%NnodesForce + ParamData%C_obj%NnodesForceBlade = ParamData%NnodesForceBlade + ParamData%C_obj%NnodesForceTower = ParamData%NnodesForceTower + + ! -- forceBldRnodes Param Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(ParamData%forceBldRnodes)) THEN + ParamData%C_obj%forceBldRnodes_Len = 0 + ParamData%C_obj%forceBldRnodes = C_NULL_PTR + ELSE + ParamData%C_obj%forceBldRnodes_Len = SIZE(ParamData%forceBldRnodes) + IF (ParamData%C_obj%forceBldRnodes_Len > 0) & + ParamData%C_obj%forceBldRnodes = C_LOC(ParamData%forceBldRnodes(LBOUND(ParamData%forceBldRnodes,1))) + END IF + END IF + + ! -- forceTwrHnodes Param Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(ParamData%forceTwrHnodes)) THEN + ParamData%C_obj%forceTwrHnodes_Len = 0 + ParamData%C_obj%forceTwrHnodes = C_NULL_PTR + ELSE + ParamData%C_obj%forceTwrHnodes_Len = SIZE(ParamData%forceTwrHnodes) + IF (ParamData%C_obj%forceTwrHnodes_Len > 0) & + ParamData%C_obj%forceTwrHnodes = C_LOC(ParamData%forceTwrHnodes(LBOUND(ParamData%forceTwrHnodes,1))) + END IF + END IF + ParamData%C_obj%BladeLength = ParamData%BladeLength + ParamData%C_obj%TowerHeight = ParamData%TowerHeight + ParamData%C_obj%TowerBaseHeight = ParamData%TowerBaseHeight + ParamData%C_obj%NodeClusterType = ParamData%NodeClusterType +END SUBROUTINE subroutine OpFM_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) type(OpFM_InputType), intent(in) :: SrcInputData @@ -2225,397 +2225,397 @@ subroutine OpFM_UnPackInput(Buf, OutData) OutData%forceNodesChord => null() end if end subroutine - SUBROUTINE OpFM_C2Fary_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(OpFM_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- pxVel Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pxVel ) ) THEN - NULLIFY( InputData%pxVel ) - ELSE - CALL C_F_POINTER(InputData%C_obj%pxVel, InputData%pxVel, (/InputData%C_obj%pxVel_Len/)) - END IF - END IF - - ! -- pyVel Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pyVel ) ) THEN - NULLIFY( InputData%pyVel ) - ELSE - CALL C_F_POINTER(InputData%C_obj%pyVel, InputData%pyVel, (/InputData%C_obj%pyVel_Len/)) - END IF - END IF - - ! -- pzVel Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pzVel ) ) THEN - NULLIFY( InputData%pzVel ) - ELSE - CALL C_F_POINTER(InputData%C_obj%pzVel, InputData%pzVel, (/InputData%C_obj%pzVel_Len/)) - END IF - END IF - - ! -- pxForce Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pxForce ) ) THEN - NULLIFY( InputData%pxForce ) - ELSE - CALL C_F_POINTER(InputData%C_obj%pxForce, InputData%pxForce, (/InputData%C_obj%pxForce_Len/)) - END IF - END IF - - ! -- pyForce Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pyForce ) ) THEN - NULLIFY( InputData%pyForce ) - ELSE - CALL C_F_POINTER(InputData%C_obj%pyForce, InputData%pyForce, (/InputData%C_obj%pyForce_Len/)) - END IF - END IF - - ! -- pzForce Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pzForce ) ) THEN - NULLIFY( InputData%pzForce ) - ELSE - CALL C_F_POINTER(InputData%C_obj%pzForce, InputData%pzForce, (/InputData%C_obj%pzForce_Len/)) - END IF - END IF - - ! -- xdotForce Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%xdotForce ) ) THEN - NULLIFY( InputData%xdotForce ) - ELSE - CALL C_F_POINTER(InputData%C_obj%xdotForce, InputData%xdotForce, (/InputData%C_obj%xdotForce_Len/)) - END IF - END IF - - ! -- ydotForce Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%ydotForce ) ) THEN - NULLIFY( InputData%ydotForce ) - ELSE - CALL C_F_POINTER(InputData%C_obj%ydotForce, InputData%ydotForce, (/InputData%C_obj%ydotForce_Len/)) - END IF - END IF - - ! -- zdotForce Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%zdotForce ) ) THEN - NULLIFY( InputData%zdotForce ) - ELSE - CALL C_F_POINTER(InputData%C_obj%zdotForce, InputData%zdotForce, (/InputData%C_obj%zdotForce_Len/)) - END IF - END IF - - ! -- pOrientation Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pOrientation ) ) THEN - NULLIFY( InputData%pOrientation ) - ELSE - CALL C_F_POINTER(InputData%C_obj%pOrientation, InputData%pOrientation, (/InputData%C_obj%pOrientation_Len/)) - END IF - END IF - - ! -- fx Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%fx ) ) THEN - NULLIFY( InputData%fx ) - ELSE - CALL C_F_POINTER(InputData%C_obj%fx, InputData%fx, (/InputData%C_obj%fx_Len/)) - END IF - END IF - - ! -- fy Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%fy ) ) THEN - NULLIFY( InputData%fy ) - ELSE - CALL C_F_POINTER(InputData%C_obj%fy, InputData%fy, (/InputData%C_obj%fy_Len/)) - END IF - END IF - - ! -- fz Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%fz ) ) THEN - NULLIFY( InputData%fz ) - ELSE - CALL C_F_POINTER(InputData%C_obj%fz, InputData%fz, (/InputData%C_obj%fz_Len/)) - END IF - END IF - - ! -- momentx Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%momentx ) ) THEN - NULLIFY( InputData%momentx ) - ELSE - CALL C_F_POINTER(InputData%C_obj%momentx, InputData%momentx, (/InputData%C_obj%momentx_Len/)) - END IF - END IF - - ! -- momenty Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%momenty ) ) THEN - NULLIFY( InputData%momenty ) - ELSE - CALL C_F_POINTER(InputData%C_obj%momenty, InputData%momenty, (/InputData%C_obj%momenty_Len/)) - END IF - END IF - - ! -- momentz Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%momentz ) ) THEN - NULLIFY( InputData%momentz ) - ELSE - CALL C_F_POINTER(InputData%C_obj%momentz, InputData%momentz, (/InputData%C_obj%momentz_Len/)) - END IF - END IF - - ! -- forceNodesChord Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%forceNodesChord ) ) THEN - NULLIFY( InputData%forceNodesChord ) - ELSE - CALL C_F_POINTER(InputData%C_obj%forceNodesChord, InputData%forceNodesChord, (/InputData%C_obj%forceNodesChord_Len/)) - END IF - END IF - END SUBROUTINE OpFM_C2Fary_CopyInput - - SUBROUTINE OpFM_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(OpFM_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- pxVel Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%pxVel)) THEN - InputData%C_obj%pxVel_Len = 0 - InputData%C_obj%pxVel = C_NULL_PTR - ELSE - InputData%C_obj%pxVel_Len = SIZE(InputData%pxVel) - IF (InputData%C_obj%pxVel_Len > 0) & - InputData%C_obj%pxVel = C_LOC( InputData%pxVel( LBOUND(InputData%pxVel,1) ) ) - END IF - END IF - - ! -- pyVel Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%pyVel)) THEN - InputData%C_obj%pyVel_Len = 0 - InputData%C_obj%pyVel = C_NULL_PTR - ELSE - InputData%C_obj%pyVel_Len = SIZE(InputData%pyVel) - IF (InputData%C_obj%pyVel_Len > 0) & - InputData%C_obj%pyVel = C_LOC( InputData%pyVel( LBOUND(InputData%pyVel,1) ) ) - END IF - END IF - - ! -- pzVel Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%pzVel)) THEN - InputData%C_obj%pzVel_Len = 0 - InputData%C_obj%pzVel = C_NULL_PTR - ELSE - InputData%C_obj%pzVel_Len = SIZE(InputData%pzVel) - IF (InputData%C_obj%pzVel_Len > 0) & - InputData%C_obj%pzVel = C_LOC( InputData%pzVel( LBOUND(InputData%pzVel,1) ) ) - END IF - END IF - - ! -- pxForce Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%pxForce)) THEN - InputData%C_obj%pxForce_Len = 0 - InputData%C_obj%pxForce = C_NULL_PTR - ELSE - InputData%C_obj%pxForce_Len = SIZE(InputData%pxForce) - IF (InputData%C_obj%pxForce_Len > 0) & - InputData%C_obj%pxForce = C_LOC( InputData%pxForce( LBOUND(InputData%pxForce,1) ) ) - END IF - END IF - - ! -- pyForce Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%pyForce)) THEN - InputData%C_obj%pyForce_Len = 0 - InputData%C_obj%pyForce = C_NULL_PTR - ELSE - InputData%C_obj%pyForce_Len = SIZE(InputData%pyForce) - IF (InputData%C_obj%pyForce_Len > 0) & - InputData%C_obj%pyForce = C_LOC( InputData%pyForce( LBOUND(InputData%pyForce,1) ) ) - END IF - END IF - - ! -- pzForce Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%pzForce)) THEN - InputData%C_obj%pzForce_Len = 0 - InputData%C_obj%pzForce = C_NULL_PTR - ELSE - InputData%C_obj%pzForce_Len = SIZE(InputData%pzForce) - IF (InputData%C_obj%pzForce_Len > 0) & - InputData%C_obj%pzForce = C_LOC( InputData%pzForce( LBOUND(InputData%pzForce,1) ) ) - END IF - END IF - - ! -- xdotForce Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%xdotForce)) THEN - InputData%C_obj%xdotForce_Len = 0 - InputData%C_obj%xdotForce = C_NULL_PTR - ELSE - InputData%C_obj%xdotForce_Len = SIZE(InputData%xdotForce) - IF (InputData%C_obj%xdotForce_Len > 0) & - InputData%C_obj%xdotForce = C_LOC( InputData%xdotForce( LBOUND(InputData%xdotForce,1) ) ) - END IF - END IF - - ! -- ydotForce Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%ydotForce)) THEN - InputData%C_obj%ydotForce_Len = 0 - InputData%C_obj%ydotForce = C_NULL_PTR - ELSE - InputData%C_obj%ydotForce_Len = SIZE(InputData%ydotForce) - IF (InputData%C_obj%ydotForce_Len > 0) & - InputData%C_obj%ydotForce = C_LOC( InputData%ydotForce( LBOUND(InputData%ydotForce,1) ) ) - END IF - END IF - - ! -- zdotForce Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%zdotForce)) THEN - InputData%C_obj%zdotForce_Len = 0 - InputData%C_obj%zdotForce = C_NULL_PTR - ELSE - InputData%C_obj%zdotForce_Len = SIZE(InputData%zdotForce) - IF (InputData%C_obj%zdotForce_Len > 0) & - InputData%C_obj%zdotForce = C_LOC( InputData%zdotForce( LBOUND(InputData%zdotForce,1) ) ) - END IF - END IF - - ! -- pOrientation Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%pOrientation)) THEN - InputData%C_obj%pOrientation_Len = 0 - InputData%C_obj%pOrientation = C_NULL_PTR - ELSE - InputData%C_obj%pOrientation_Len = SIZE(InputData%pOrientation) - IF (InputData%C_obj%pOrientation_Len > 0) & - InputData%C_obj%pOrientation = C_LOC( InputData%pOrientation( LBOUND(InputData%pOrientation,1) ) ) - END IF - END IF - - ! -- fx Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%fx)) THEN - InputData%C_obj%fx_Len = 0 - InputData%C_obj%fx = C_NULL_PTR - ELSE - InputData%C_obj%fx_Len = SIZE(InputData%fx) - IF (InputData%C_obj%fx_Len > 0) & - InputData%C_obj%fx = C_LOC( InputData%fx( LBOUND(InputData%fx,1) ) ) - END IF - END IF - - ! -- fy Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%fy)) THEN - InputData%C_obj%fy_Len = 0 - InputData%C_obj%fy = C_NULL_PTR - ELSE - InputData%C_obj%fy_Len = SIZE(InputData%fy) - IF (InputData%C_obj%fy_Len > 0) & - InputData%C_obj%fy = C_LOC( InputData%fy( LBOUND(InputData%fy,1) ) ) - END IF - END IF - - ! -- fz Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%fz)) THEN - InputData%C_obj%fz_Len = 0 - InputData%C_obj%fz = C_NULL_PTR - ELSE - InputData%C_obj%fz_Len = SIZE(InputData%fz) - IF (InputData%C_obj%fz_Len > 0) & - InputData%C_obj%fz = C_LOC( InputData%fz( LBOUND(InputData%fz,1) ) ) - END IF - END IF - - ! -- momentx Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%momentx)) THEN - InputData%C_obj%momentx_Len = 0 - InputData%C_obj%momentx = C_NULL_PTR - ELSE - InputData%C_obj%momentx_Len = SIZE(InputData%momentx) - IF (InputData%C_obj%momentx_Len > 0) & - InputData%C_obj%momentx = C_LOC( InputData%momentx( LBOUND(InputData%momentx,1) ) ) - END IF - END IF - - ! -- momenty Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%momenty)) THEN - InputData%C_obj%momenty_Len = 0 - InputData%C_obj%momenty = C_NULL_PTR - ELSE - InputData%C_obj%momenty_Len = SIZE(InputData%momenty) - IF (InputData%C_obj%momenty_Len > 0) & - InputData%C_obj%momenty = C_LOC( InputData%momenty( LBOUND(InputData%momenty,1) ) ) - END IF - END IF - - ! -- momentz Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%momentz)) THEN - InputData%C_obj%momentz_Len = 0 - InputData%C_obj%momentz = C_NULL_PTR - ELSE - InputData%C_obj%momentz_Len = SIZE(InputData%momentz) - IF (InputData%C_obj%momentz_Len > 0) & - InputData%C_obj%momentz = C_LOC( InputData%momentz( LBOUND(InputData%momentz,1) ) ) - END IF - END IF - - ! -- forceNodesChord Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%forceNodesChord)) THEN - InputData%C_obj%forceNodesChord_Len = 0 - InputData%C_obj%forceNodesChord = C_NULL_PTR - ELSE - InputData%C_obj%forceNodesChord_Len = SIZE(InputData%forceNodesChord) - IF (InputData%C_obj%forceNodesChord_Len > 0) & - InputData%C_obj%forceNodesChord = C_LOC( InputData%forceNodesChord( LBOUND(InputData%forceNodesChord,1) ) ) - END IF - END IF - END SUBROUTINE OpFM_F2C_CopyInput +SUBROUTINE OpFM_C2Fary_CopyInput(InputData, ErrStat, ErrMsg, SkipPointers) + TYPE(OpFM_InputType), INTENT(INOUT) :: InputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- pxVel Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pxVel ) ) THEN + NULLIFY( InputData%pxVel ) + ELSE + CALL C_F_POINTER(InputData%C_obj%pxVel, InputData%pxVel, [InputData%C_obj%pxVel_Len]) + END IF + END IF + + ! -- pyVel Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pyVel ) ) THEN + NULLIFY( InputData%pyVel ) + ELSE + CALL C_F_POINTER(InputData%C_obj%pyVel, InputData%pyVel, [InputData%C_obj%pyVel_Len]) + END IF + END IF + + ! -- pzVel Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pzVel ) ) THEN + NULLIFY( InputData%pzVel ) + ELSE + CALL C_F_POINTER(InputData%C_obj%pzVel, InputData%pzVel, [InputData%C_obj%pzVel_Len]) + END IF + END IF + + ! -- pxForce Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pxForce ) ) THEN + NULLIFY( InputData%pxForce ) + ELSE + CALL C_F_POINTER(InputData%C_obj%pxForce, InputData%pxForce, [InputData%C_obj%pxForce_Len]) + END IF + END IF + + ! -- pyForce Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pyForce ) ) THEN + NULLIFY( InputData%pyForce ) + ELSE + CALL C_F_POINTER(InputData%C_obj%pyForce, InputData%pyForce, [InputData%C_obj%pyForce_Len]) + END IF + END IF + + ! -- pzForce Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pzForce ) ) THEN + NULLIFY( InputData%pzForce ) + ELSE + CALL C_F_POINTER(InputData%C_obj%pzForce, InputData%pzForce, [InputData%C_obj%pzForce_Len]) + END IF + END IF + + ! -- xdotForce Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%xdotForce ) ) THEN + NULLIFY( InputData%xdotForce ) + ELSE + CALL C_F_POINTER(InputData%C_obj%xdotForce, InputData%xdotForce, [InputData%C_obj%xdotForce_Len]) + END IF + END IF + + ! -- ydotForce Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%ydotForce ) ) THEN + NULLIFY( InputData%ydotForce ) + ELSE + CALL C_F_POINTER(InputData%C_obj%ydotForce, InputData%ydotForce, [InputData%C_obj%ydotForce_Len]) + END IF + END IF + + ! -- zdotForce Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%zdotForce ) ) THEN + NULLIFY( InputData%zdotForce ) + ELSE + CALL C_F_POINTER(InputData%C_obj%zdotForce, InputData%zdotForce, [InputData%C_obj%zdotForce_Len]) + END IF + END IF + + ! -- pOrientation Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pOrientation ) ) THEN + NULLIFY( InputData%pOrientation ) + ELSE + CALL C_F_POINTER(InputData%C_obj%pOrientation, InputData%pOrientation, [InputData%C_obj%pOrientation_Len]) + END IF + END IF + + ! -- fx Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%fx ) ) THEN + NULLIFY( InputData%fx ) + ELSE + CALL C_F_POINTER(InputData%C_obj%fx, InputData%fx, [InputData%C_obj%fx_Len]) + END IF + END IF + + ! -- fy Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%fy ) ) THEN + NULLIFY( InputData%fy ) + ELSE + CALL C_F_POINTER(InputData%C_obj%fy, InputData%fy, [InputData%C_obj%fy_Len]) + END IF + END IF + + ! -- fz Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%fz ) ) THEN + NULLIFY( InputData%fz ) + ELSE + CALL C_F_POINTER(InputData%C_obj%fz, InputData%fz, [InputData%C_obj%fz_Len]) + END IF + END IF + + ! -- momentx Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%momentx ) ) THEN + NULLIFY( InputData%momentx ) + ELSE + CALL C_F_POINTER(InputData%C_obj%momentx, InputData%momentx, [InputData%C_obj%momentx_Len]) + END IF + END IF + + ! -- momenty Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%momenty ) ) THEN + NULLIFY( InputData%momenty ) + ELSE + CALL C_F_POINTER(InputData%C_obj%momenty, InputData%momenty, [InputData%C_obj%momenty_Len]) + END IF + END IF + + ! -- momentz Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%momentz ) ) THEN + NULLIFY( InputData%momentz ) + ELSE + CALL C_F_POINTER(InputData%C_obj%momentz, InputData%momentz, [InputData%C_obj%momentz_Len]) + END IF + END IF + + ! -- forceNodesChord Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%forceNodesChord ) ) THEN + NULLIFY( InputData%forceNodesChord ) + ELSE + CALL C_F_POINTER(InputData%C_obj%forceNodesChord, InputData%forceNodesChord, [InputData%C_obj%forceNodesChord_Len]) + END IF + END IF +END SUBROUTINE + +SUBROUTINE OpFM_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(OpFM_InputType), INTENT(INOUT) :: InputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- pxVel Input Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(InputData%pxVel)) THEN + InputData%C_obj%pxVel_Len = 0 + InputData%C_obj%pxVel = C_NULL_PTR + ELSE + InputData%C_obj%pxVel_Len = SIZE(InputData%pxVel) + IF (InputData%C_obj%pxVel_Len > 0) & + InputData%C_obj%pxVel = C_LOC(InputData%pxVel(LBOUND(InputData%pxVel,1))) + END IF + END IF + + ! -- pyVel Input Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(InputData%pyVel)) THEN + InputData%C_obj%pyVel_Len = 0 + InputData%C_obj%pyVel = C_NULL_PTR + ELSE + InputData%C_obj%pyVel_Len = SIZE(InputData%pyVel) + IF (InputData%C_obj%pyVel_Len > 0) & + InputData%C_obj%pyVel = C_LOC(InputData%pyVel(LBOUND(InputData%pyVel,1))) + END IF + END IF + + ! -- pzVel Input Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(InputData%pzVel)) THEN + InputData%C_obj%pzVel_Len = 0 + InputData%C_obj%pzVel = C_NULL_PTR + ELSE + InputData%C_obj%pzVel_Len = SIZE(InputData%pzVel) + IF (InputData%C_obj%pzVel_Len > 0) & + InputData%C_obj%pzVel = C_LOC(InputData%pzVel(LBOUND(InputData%pzVel,1))) + END IF + END IF + + ! -- pxForce Input Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(InputData%pxForce)) THEN + InputData%C_obj%pxForce_Len = 0 + InputData%C_obj%pxForce = C_NULL_PTR + ELSE + InputData%C_obj%pxForce_Len = SIZE(InputData%pxForce) + IF (InputData%C_obj%pxForce_Len > 0) & + InputData%C_obj%pxForce = C_LOC(InputData%pxForce(LBOUND(InputData%pxForce,1))) + END IF + END IF + + ! -- pyForce Input Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(InputData%pyForce)) THEN + InputData%C_obj%pyForce_Len = 0 + InputData%C_obj%pyForce = C_NULL_PTR + ELSE + InputData%C_obj%pyForce_Len = SIZE(InputData%pyForce) + IF (InputData%C_obj%pyForce_Len > 0) & + InputData%C_obj%pyForce = C_LOC(InputData%pyForce(LBOUND(InputData%pyForce,1))) + END IF + END IF + + ! -- pzForce Input Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(InputData%pzForce)) THEN + InputData%C_obj%pzForce_Len = 0 + InputData%C_obj%pzForce = C_NULL_PTR + ELSE + InputData%C_obj%pzForce_Len = SIZE(InputData%pzForce) + IF (InputData%C_obj%pzForce_Len > 0) & + InputData%C_obj%pzForce = C_LOC(InputData%pzForce(LBOUND(InputData%pzForce,1))) + END IF + END IF + + ! -- xdotForce Input Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(InputData%xdotForce)) THEN + InputData%C_obj%xdotForce_Len = 0 + InputData%C_obj%xdotForce = C_NULL_PTR + ELSE + InputData%C_obj%xdotForce_Len = SIZE(InputData%xdotForce) + IF (InputData%C_obj%xdotForce_Len > 0) & + InputData%C_obj%xdotForce = C_LOC(InputData%xdotForce(LBOUND(InputData%xdotForce,1))) + END IF + END IF + + ! -- ydotForce Input Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(InputData%ydotForce)) THEN + InputData%C_obj%ydotForce_Len = 0 + InputData%C_obj%ydotForce = C_NULL_PTR + ELSE + InputData%C_obj%ydotForce_Len = SIZE(InputData%ydotForce) + IF (InputData%C_obj%ydotForce_Len > 0) & + InputData%C_obj%ydotForce = C_LOC(InputData%ydotForce(LBOUND(InputData%ydotForce,1))) + END IF + END IF + + ! -- zdotForce Input Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(InputData%zdotForce)) THEN + InputData%C_obj%zdotForce_Len = 0 + InputData%C_obj%zdotForce = C_NULL_PTR + ELSE + InputData%C_obj%zdotForce_Len = SIZE(InputData%zdotForce) + IF (InputData%C_obj%zdotForce_Len > 0) & + InputData%C_obj%zdotForce = C_LOC(InputData%zdotForce(LBOUND(InputData%zdotForce,1))) + END IF + END IF + + ! -- pOrientation Input Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(InputData%pOrientation)) THEN + InputData%C_obj%pOrientation_Len = 0 + InputData%C_obj%pOrientation = C_NULL_PTR + ELSE + InputData%C_obj%pOrientation_Len = SIZE(InputData%pOrientation) + IF (InputData%C_obj%pOrientation_Len > 0) & + InputData%C_obj%pOrientation = C_LOC(InputData%pOrientation(LBOUND(InputData%pOrientation,1))) + END IF + END IF + + ! -- fx Input Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(InputData%fx)) THEN + InputData%C_obj%fx_Len = 0 + InputData%C_obj%fx = C_NULL_PTR + ELSE + InputData%C_obj%fx_Len = SIZE(InputData%fx) + IF (InputData%C_obj%fx_Len > 0) & + InputData%C_obj%fx = C_LOC(InputData%fx(LBOUND(InputData%fx,1))) + END IF + END IF + + ! -- fy Input Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(InputData%fy)) THEN + InputData%C_obj%fy_Len = 0 + InputData%C_obj%fy = C_NULL_PTR + ELSE + InputData%C_obj%fy_Len = SIZE(InputData%fy) + IF (InputData%C_obj%fy_Len > 0) & + InputData%C_obj%fy = C_LOC(InputData%fy(LBOUND(InputData%fy,1))) + END IF + END IF + + ! -- fz Input Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(InputData%fz)) THEN + InputData%C_obj%fz_Len = 0 + InputData%C_obj%fz = C_NULL_PTR + ELSE + InputData%C_obj%fz_Len = SIZE(InputData%fz) + IF (InputData%C_obj%fz_Len > 0) & + InputData%C_obj%fz = C_LOC(InputData%fz(LBOUND(InputData%fz,1))) + END IF + END IF + + ! -- momentx Input Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(InputData%momentx)) THEN + InputData%C_obj%momentx_Len = 0 + InputData%C_obj%momentx = C_NULL_PTR + ELSE + InputData%C_obj%momentx_Len = SIZE(InputData%momentx) + IF (InputData%C_obj%momentx_Len > 0) & + InputData%C_obj%momentx = C_LOC(InputData%momentx(LBOUND(InputData%momentx,1))) + END IF + END IF + + ! -- momenty Input Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(InputData%momenty)) THEN + InputData%C_obj%momenty_Len = 0 + InputData%C_obj%momenty = C_NULL_PTR + ELSE + InputData%C_obj%momenty_Len = SIZE(InputData%momenty) + IF (InputData%C_obj%momenty_Len > 0) & + InputData%C_obj%momenty = C_LOC(InputData%momenty(LBOUND(InputData%momenty,1))) + END IF + END IF + + ! -- momentz Input Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(InputData%momentz)) THEN + InputData%C_obj%momentz_Len = 0 + InputData%C_obj%momentz = C_NULL_PTR + ELSE + InputData%C_obj%momentz_Len = SIZE(InputData%momentz) + IF (InputData%C_obj%momentz_Len > 0) & + InputData%C_obj%momentz = C_LOC(InputData%momentz(LBOUND(InputData%momentz,1))) + END IF + END IF + + ! -- forceNodesChord Input Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(InputData%forceNodesChord)) THEN + InputData%C_obj%forceNodesChord_Len = 0 + InputData%C_obj%forceNodesChord = C_NULL_PTR + ELSE + InputData%C_obj%forceNodesChord_Len = SIZE(InputData%forceNodesChord) + IF (InputData%C_obj%forceNodesChord_Len > 0) & + InputData%C_obj%forceNodesChord = C_LOC(InputData%forceNodesChord(LBOUND(InputData%forceNodesChord,1))) + END IF + END IF +END SUBROUTINE subroutine OpFM_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) type(OpFM_OutputType), intent(in) :: SrcOutputData @@ -2862,156 +2862,157 @@ subroutine OpFM_UnPackOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end if end subroutine - SUBROUTINE OpFM_C2Fary_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(OpFM_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- u Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%u ) ) THEN - NULLIFY( OutputData%u ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%u, OutputData%u, (/OutputData%C_obj%u_Len/)) - END IF - END IF - - ! -- v Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%v ) ) THEN - NULLIFY( OutputData%v ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%v, OutputData%v, (/OutputData%C_obj%v_Len/)) - END IF - END IF - - ! -- w Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%w ) ) THEN - NULLIFY( OutputData%w ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%w, OutputData%w, (/OutputData%C_obj%w_Len/)) - END IF - END IF - END SUBROUTINE OpFM_C2Fary_CopyOutput - - SUBROUTINE OpFM_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(OpFM_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- u Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OutputData%u)) THEN - OutputData%C_obj%u_Len = 0 - OutputData%C_obj%u = C_NULL_PTR - ELSE - OutputData%C_obj%u_Len = SIZE(OutputData%u) - IF (OutputData%C_obj%u_Len > 0) & - OutputData%C_obj%u = C_LOC( OutputData%u( LBOUND(OutputData%u,1) ) ) - END IF - END IF - - ! -- v Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OutputData%v)) THEN - OutputData%C_obj%v_Len = 0 - OutputData%C_obj%v = C_NULL_PTR - ELSE - OutputData%C_obj%v_Len = SIZE(OutputData%v) - IF (OutputData%C_obj%v_Len > 0) & - OutputData%C_obj%v = C_LOC( OutputData%v( LBOUND(OutputData%v,1) ) ) - END IF - END IF - - ! -- w Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OutputData%w)) THEN - OutputData%C_obj%w_Len = 0 - OutputData%C_obj%w = C_NULL_PTR - ELSE - OutputData%C_obj%w_Len = SIZE(OutputData%w) - IF (OutputData%C_obj%w_Len > 0) & - OutputData%C_obj%w = C_LOC( OutputData%w( LBOUND(OutputData%w,1) ) ) - END IF - END IF - END SUBROUTINE OpFM_F2C_CopyOutput - - SUBROUTINE OpFM_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(OpFM_InputType), INTENT(IN) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(OpFM_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None +SUBROUTINE OpFM_C2Fary_CopyOutput(OutputData, ErrStat, ErrMsg, SkipPointers) + TYPE(OpFM_OutputType), INTENT(INOUT) :: OutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- u Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%u ) ) THEN + NULLIFY( OutputData%u ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%u, OutputData%u, [OutputData%C_obj%u_Len]) + END IF + END IF + + ! -- v Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%v ) ) THEN + NULLIFY( OutputData%v ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%v, OutputData%v, [OutputData%C_obj%v_Len]) + END IF + END IF + + ! -- w Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%w ) ) THEN + NULLIFY( OutputData%w ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%w, OutputData%w, [OutputData%C_obj%w_Len]) + END IF + END IF +END SUBROUTINE + +SUBROUTINE OpFM_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(OpFM_OutputType), INTENT(INOUT) :: OutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- u Output Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OutputData%u)) THEN + OutputData%C_obj%u_Len = 0 + OutputData%C_obj%u = C_NULL_PTR + ELSE + OutputData%C_obj%u_Len = SIZE(OutputData%u) + IF (OutputData%C_obj%u_Len > 0) & + OutputData%C_obj%u = C_LOC(OutputData%u(LBOUND(OutputData%u,1))) + END IF + END IF + + ! -- v Output Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OutputData%v)) THEN + OutputData%C_obj%v_Len = 0 + OutputData%C_obj%v = C_NULL_PTR + ELSE + OutputData%C_obj%v_Len = SIZE(OutputData%v) + IF (OutputData%C_obj%v_Len > 0) & + OutputData%C_obj%v = C_LOC(OutputData%v(LBOUND(OutputData%v,1))) + END IF + END IF + + ! -- w Output Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OutputData%w)) THEN + OutputData%C_obj%w_Len = 0 + OutputData%C_obj%w = C_NULL_PTR + ELSE + OutputData%C_obj%w_Len = SIZE(OutputData%w) + IF (OutputData%C_obj%w_Len > 0) & + OutputData%C_obj%w = C_LOC(OutputData%w(LBOUND(OutputData%w,1))) + END IF + END IF +END SUBROUTINE + +subroutine OpFM_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time + ! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(OpFM_InputType), intent(in) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(OpFM_InputType), intent(inout) :: u_out ! Input at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_Input_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(u)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(u) - 1 - IF ( order .eq. 0 ) THEN - CALL OpFM_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL OpFM_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL OpFM_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE OpFM_Input_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'OpFM_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call OpFM_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call OpFM_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call OpFM_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE OpFM_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE OpFM_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 1. @@ -3023,143 +3024,93 @@ SUBROUTINE OpFM_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(OpFM_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 - TYPE(OpFM_InputType), INTENT(IN) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(OpFM_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(OpFM_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 + TYPE(OpFM_InputType), INTENT(IN) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(OpFM_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_Input_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF - - ScaleFactor = t_out / t(2) -IF (ASSOCIATED(u_out%pxVel) .AND. ASSOCIATED(u1%pxVel)) THEN - DO i1 = LBOUND(u_out%pxVel,1),UBOUND(u_out%pxVel,1) - b = -(u1%pxVel(i1) - u2%pxVel(i1)) - u_out%pxVel(i1) = u1%pxVel(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%pyVel) .AND. ASSOCIATED(u1%pyVel)) THEN - DO i1 = LBOUND(u_out%pyVel,1),UBOUND(u_out%pyVel,1) - b = -(u1%pyVel(i1) - u2%pyVel(i1)) - u_out%pyVel(i1) = u1%pyVel(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%pzVel) .AND. ASSOCIATED(u1%pzVel)) THEN - DO i1 = LBOUND(u_out%pzVel,1),UBOUND(u_out%pzVel,1) - b = -(u1%pzVel(i1) - u2%pzVel(i1)) - u_out%pzVel(i1) = u1%pzVel(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%pxForce) .AND. ASSOCIATED(u1%pxForce)) THEN - DO i1 = LBOUND(u_out%pxForce,1),UBOUND(u_out%pxForce,1) - b = -(u1%pxForce(i1) - u2%pxForce(i1)) - u_out%pxForce(i1) = u1%pxForce(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%pyForce) .AND. ASSOCIATED(u1%pyForce)) THEN - DO i1 = LBOUND(u_out%pyForce,1),UBOUND(u_out%pyForce,1) - b = -(u1%pyForce(i1) - u2%pyForce(i1)) - u_out%pyForce(i1) = u1%pyForce(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%pzForce) .AND. ASSOCIATED(u1%pzForce)) THEN - DO i1 = LBOUND(u_out%pzForce,1),UBOUND(u_out%pzForce,1) - b = -(u1%pzForce(i1) - u2%pzForce(i1)) - u_out%pzForce(i1) = u1%pzForce(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%xdotForce) .AND. ASSOCIATED(u1%xdotForce)) THEN - DO i1 = LBOUND(u_out%xdotForce,1),UBOUND(u_out%xdotForce,1) - b = -(u1%xdotForce(i1) - u2%xdotForce(i1)) - u_out%xdotForce(i1) = u1%xdotForce(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%ydotForce) .AND. ASSOCIATED(u1%ydotForce)) THEN - DO i1 = LBOUND(u_out%ydotForce,1),UBOUND(u_out%ydotForce,1) - b = -(u1%ydotForce(i1) - u2%ydotForce(i1)) - u_out%ydotForce(i1) = u1%ydotForce(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%zdotForce) .AND. ASSOCIATED(u1%zdotForce)) THEN - DO i1 = LBOUND(u_out%zdotForce,1),UBOUND(u_out%zdotForce,1) - b = -(u1%zdotForce(i1) - u2%zdotForce(i1)) - u_out%zdotForce(i1) = u1%zdotForce(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%pOrientation) .AND. ASSOCIATED(u1%pOrientation)) THEN - DO i1 = LBOUND(u_out%pOrientation,1),UBOUND(u_out%pOrientation,1) - b = -(u1%pOrientation(i1) - u2%pOrientation(i1)) - u_out%pOrientation(i1) = u1%pOrientation(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%fx) .AND. ASSOCIATED(u1%fx)) THEN - DO i1 = LBOUND(u_out%fx,1),UBOUND(u_out%fx,1) - b = -(u1%fx(i1) - u2%fx(i1)) - u_out%fx(i1) = u1%fx(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%fy) .AND. ASSOCIATED(u1%fy)) THEN - DO i1 = LBOUND(u_out%fy,1),UBOUND(u_out%fy,1) - b = -(u1%fy(i1) - u2%fy(i1)) - u_out%fy(i1) = u1%fy(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%fz) .AND. ASSOCIATED(u1%fz)) THEN - DO i1 = LBOUND(u_out%fz,1),UBOUND(u_out%fz,1) - b = -(u1%fz(i1) - u2%fz(i1)) - u_out%fz(i1) = u1%fz(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%momentx) .AND. ASSOCIATED(u1%momentx)) THEN - DO i1 = LBOUND(u_out%momentx,1),UBOUND(u_out%momentx,1) - b = -(u1%momentx(i1) - u2%momentx(i1)) - u_out%momentx(i1) = u1%momentx(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%momenty) .AND. ASSOCIATED(u1%momenty)) THEN - DO i1 = LBOUND(u_out%momenty,1),UBOUND(u_out%momenty,1) - b = -(u1%momenty(i1) - u2%momenty(i1)) - u_out%momenty(i1) = u1%momenty(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%momentz) .AND. ASSOCIATED(u1%momentz)) THEN - DO i1 = LBOUND(u_out%momentz,1),UBOUND(u_out%momentz,1) - b = -(u1%momentz(i1) - u2%momentz(i1)) - u_out%momentz(i1) = u1%momentz(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%forceNodesChord) .AND. ASSOCIATED(u1%forceNodesChord)) THEN - DO i1 = LBOUND(u_out%forceNodesChord,1),UBOUND(u_out%forceNodesChord,1) - b = -(u1%forceNodesChord(i1) - u2%forceNodesChord(i1)) - u_out%forceNodesChord(i1) = u1%forceNodesChord(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE OpFM_Input_ExtrapInterp1 - - - SUBROUTINE OpFM_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ASSOCIATED(u_out%pxVel) .AND. ASSOCIATED(u1%pxVel)) THEN + u_out%pxVel = a1*u1%pxVel + a2*u2%pxVel + END IF ! check if allocated + IF (ASSOCIATED(u_out%pyVel) .AND. ASSOCIATED(u1%pyVel)) THEN + u_out%pyVel = a1*u1%pyVel + a2*u2%pyVel + END IF ! check if allocated + IF (ASSOCIATED(u_out%pzVel) .AND. ASSOCIATED(u1%pzVel)) THEN + u_out%pzVel = a1*u1%pzVel + a2*u2%pzVel + END IF ! check if allocated + IF (ASSOCIATED(u_out%pxForce) .AND. ASSOCIATED(u1%pxForce)) THEN + u_out%pxForce = a1*u1%pxForce + a2*u2%pxForce + END IF ! check if allocated + IF (ASSOCIATED(u_out%pyForce) .AND. ASSOCIATED(u1%pyForce)) THEN + u_out%pyForce = a1*u1%pyForce + a2*u2%pyForce + END IF ! check if allocated + IF (ASSOCIATED(u_out%pzForce) .AND. ASSOCIATED(u1%pzForce)) THEN + u_out%pzForce = a1*u1%pzForce + a2*u2%pzForce + END IF ! check if allocated + IF (ASSOCIATED(u_out%xdotForce) .AND. ASSOCIATED(u1%xdotForce)) THEN + u_out%xdotForce = a1*u1%xdotForce + a2*u2%xdotForce + END IF ! check if allocated + IF (ASSOCIATED(u_out%ydotForce) .AND. ASSOCIATED(u1%ydotForce)) THEN + u_out%ydotForce = a1*u1%ydotForce + a2*u2%ydotForce + END IF ! check if allocated + IF (ASSOCIATED(u_out%zdotForce) .AND. ASSOCIATED(u1%zdotForce)) THEN + u_out%zdotForce = a1*u1%zdotForce + a2*u2%zdotForce + END IF ! check if allocated + IF (ASSOCIATED(u_out%pOrientation) .AND. ASSOCIATED(u1%pOrientation)) THEN + u_out%pOrientation = a1*u1%pOrientation + a2*u2%pOrientation + END IF ! check if allocated + IF (ASSOCIATED(u_out%fx) .AND. ASSOCIATED(u1%fx)) THEN + u_out%fx = a1*u1%fx + a2*u2%fx + END IF ! check if allocated + IF (ASSOCIATED(u_out%fy) .AND. ASSOCIATED(u1%fy)) THEN + u_out%fy = a1*u1%fy + a2*u2%fy + END IF ! check if allocated + IF (ASSOCIATED(u_out%fz) .AND. ASSOCIATED(u1%fz)) THEN + u_out%fz = a1*u1%fz + a2*u2%fz + END IF ! check if allocated + IF (ASSOCIATED(u_out%momentx) .AND. ASSOCIATED(u1%momentx)) THEN + u_out%momentx = a1*u1%momentx + a2*u2%momentx + END IF ! check if allocated + IF (ASSOCIATED(u_out%momenty) .AND. ASSOCIATED(u1%momenty)) THEN + u_out%momenty = a1*u1%momenty + a2*u2%momenty + END IF ! check if allocated + IF (ASSOCIATED(u_out%momentz) .AND. ASSOCIATED(u1%momentz)) THEN + u_out%momentz = a1*u1%momentz + a2*u2%momentz + END IF ! check if allocated + IF (ASSOCIATED(u_out%forceNodesChord) .AND. ASSOCIATED(u1%forceNodesChord)) THEN + u_out%forceNodesChord = a1*u1%forceNodesChord + a2*u2%forceNodesChord + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE OpFM_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 2. @@ -3173,220 +3124,153 @@ SUBROUTINE OpFM_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - TYPE(OpFM_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 - TYPE(OpFM_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 - TYPE(OpFM_InputType), INTENT(IN) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(OpFM_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(OpFM_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 + TYPE(OpFM_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 + TYPE(OpFM_InputType), INTENT(IN) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(OpFM_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_Input_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) -IF (ASSOCIATED(u_out%pxVel) .AND. ASSOCIATED(u1%pxVel)) THEN - DO i1 = LBOUND(u_out%pxVel,1),UBOUND(u_out%pxVel,1) - b = (t(3)**2*(u1%pxVel(i1) - u2%pxVel(i1)) + t(2)**2*(-u1%pxVel(i1) + u3%pxVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%pxVel(i1) + t(3)*u2%pxVel(i1) - t(2)*u3%pxVel(i1) ) * scaleFactor - u_out%pxVel(i1) = u1%pxVel(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%pyVel) .AND. ASSOCIATED(u1%pyVel)) THEN - DO i1 = LBOUND(u_out%pyVel,1),UBOUND(u_out%pyVel,1) - b = (t(3)**2*(u1%pyVel(i1) - u2%pyVel(i1)) + t(2)**2*(-u1%pyVel(i1) + u3%pyVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%pyVel(i1) + t(3)*u2%pyVel(i1) - t(2)*u3%pyVel(i1) ) * scaleFactor - u_out%pyVel(i1) = u1%pyVel(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%pzVel) .AND. ASSOCIATED(u1%pzVel)) THEN - DO i1 = LBOUND(u_out%pzVel,1),UBOUND(u_out%pzVel,1) - b = (t(3)**2*(u1%pzVel(i1) - u2%pzVel(i1)) + t(2)**2*(-u1%pzVel(i1) + u3%pzVel(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%pzVel(i1) + t(3)*u2%pzVel(i1) - t(2)*u3%pzVel(i1) ) * scaleFactor - u_out%pzVel(i1) = u1%pzVel(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%pxForce) .AND. ASSOCIATED(u1%pxForce)) THEN - DO i1 = LBOUND(u_out%pxForce,1),UBOUND(u_out%pxForce,1) - b = (t(3)**2*(u1%pxForce(i1) - u2%pxForce(i1)) + t(2)**2*(-u1%pxForce(i1) + u3%pxForce(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%pxForce(i1) + t(3)*u2%pxForce(i1) - t(2)*u3%pxForce(i1) ) * scaleFactor - u_out%pxForce(i1) = u1%pxForce(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%pyForce) .AND. ASSOCIATED(u1%pyForce)) THEN - DO i1 = LBOUND(u_out%pyForce,1),UBOUND(u_out%pyForce,1) - b = (t(3)**2*(u1%pyForce(i1) - u2%pyForce(i1)) + t(2)**2*(-u1%pyForce(i1) + u3%pyForce(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%pyForce(i1) + t(3)*u2%pyForce(i1) - t(2)*u3%pyForce(i1) ) * scaleFactor - u_out%pyForce(i1) = u1%pyForce(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%pzForce) .AND. ASSOCIATED(u1%pzForce)) THEN - DO i1 = LBOUND(u_out%pzForce,1),UBOUND(u_out%pzForce,1) - b = (t(3)**2*(u1%pzForce(i1) - u2%pzForce(i1)) + t(2)**2*(-u1%pzForce(i1) + u3%pzForce(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%pzForce(i1) + t(3)*u2%pzForce(i1) - t(2)*u3%pzForce(i1) ) * scaleFactor - u_out%pzForce(i1) = u1%pzForce(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%xdotForce) .AND. ASSOCIATED(u1%xdotForce)) THEN - DO i1 = LBOUND(u_out%xdotForce,1),UBOUND(u_out%xdotForce,1) - b = (t(3)**2*(u1%xdotForce(i1) - u2%xdotForce(i1)) + t(2)**2*(-u1%xdotForce(i1) + u3%xdotForce(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%xdotForce(i1) + t(3)*u2%xdotForce(i1) - t(2)*u3%xdotForce(i1) ) * scaleFactor - u_out%xdotForce(i1) = u1%xdotForce(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%ydotForce) .AND. ASSOCIATED(u1%ydotForce)) THEN - DO i1 = LBOUND(u_out%ydotForce,1),UBOUND(u_out%ydotForce,1) - b = (t(3)**2*(u1%ydotForce(i1) - u2%ydotForce(i1)) + t(2)**2*(-u1%ydotForce(i1) + u3%ydotForce(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%ydotForce(i1) + t(3)*u2%ydotForce(i1) - t(2)*u3%ydotForce(i1) ) * scaleFactor - u_out%ydotForce(i1) = u1%ydotForce(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%zdotForce) .AND. ASSOCIATED(u1%zdotForce)) THEN - DO i1 = LBOUND(u_out%zdotForce,1),UBOUND(u_out%zdotForce,1) - b = (t(3)**2*(u1%zdotForce(i1) - u2%zdotForce(i1)) + t(2)**2*(-u1%zdotForce(i1) + u3%zdotForce(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%zdotForce(i1) + t(3)*u2%zdotForce(i1) - t(2)*u3%zdotForce(i1) ) * scaleFactor - u_out%zdotForce(i1) = u1%zdotForce(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%pOrientation) .AND. ASSOCIATED(u1%pOrientation)) THEN - DO i1 = LBOUND(u_out%pOrientation,1),UBOUND(u_out%pOrientation,1) - b = (t(3)**2*(u1%pOrientation(i1) - u2%pOrientation(i1)) + t(2)**2*(-u1%pOrientation(i1) + u3%pOrientation(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%pOrientation(i1) + t(3)*u2%pOrientation(i1) - t(2)*u3%pOrientation(i1) ) * scaleFactor - u_out%pOrientation(i1) = u1%pOrientation(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%fx) .AND. ASSOCIATED(u1%fx)) THEN - DO i1 = LBOUND(u_out%fx,1),UBOUND(u_out%fx,1) - b = (t(3)**2*(u1%fx(i1) - u2%fx(i1)) + t(2)**2*(-u1%fx(i1) + u3%fx(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%fx(i1) + t(3)*u2%fx(i1) - t(2)*u3%fx(i1) ) * scaleFactor - u_out%fx(i1) = u1%fx(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%fy) .AND. ASSOCIATED(u1%fy)) THEN - DO i1 = LBOUND(u_out%fy,1),UBOUND(u_out%fy,1) - b = (t(3)**2*(u1%fy(i1) - u2%fy(i1)) + t(2)**2*(-u1%fy(i1) + u3%fy(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%fy(i1) + t(3)*u2%fy(i1) - t(2)*u3%fy(i1) ) * scaleFactor - u_out%fy(i1) = u1%fy(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%fz) .AND. ASSOCIATED(u1%fz)) THEN - DO i1 = LBOUND(u_out%fz,1),UBOUND(u_out%fz,1) - b = (t(3)**2*(u1%fz(i1) - u2%fz(i1)) + t(2)**2*(-u1%fz(i1) + u3%fz(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%fz(i1) + t(3)*u2%fz(i1) - t(2)*u3%fz(i1) ) * scaleFactor - u_out%fz(i1) = u1%fz(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%momentx) .AND. ASSOCIATED(u1%momentx)) THEN - DO i1 = LBOUND(u_out%momentx,1),UBOUND(u_out%momentx,1) - b = (t(3)**2*(u1%momentx(i1) - u2%momentx(i1)) + t(2)**2*(-u1%momentx(i1) + u3%momentx(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%momentx(i1) + t(3)*u2%momentx(i1) - t(2)*u3%momentx(i1) ) * scaleFactor - u_out%momentx(i1) = u1%momentx(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%momenty) .AND. ASSOCIATED(u1%momenty)) THEN - DO i1 = LBOUND(u_out%momenty,1),UBOUND(u_out%momenty,1) - b = (t(3)**2*(u1%momenty(i1) - u2%momenty(i1)) + t(2)**2*(-u1%momenty(i1) + u3%momenty(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%momenty(i1) + t(3)*u2%momenty(i1) - t(2)*u3%momenty(i1) ) * scaleFactor - u_out%momenty(i1) = u1%momenty(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%momentz) .AND. ASSOCIATED(u1%momentz)) THEN - DO i1 = LBOUND(u_out%momentz,1),UBOUND(u_out%momentz,1) - b = (t(3)**2*(u1%momentz(i1) - u2%momentz(i1)) + t(2)**2*(-u1%momentz(i1) + u3%momentz(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%momentz(i1) + t(3)*u2%momentz(i1) - t(2)*u3%momentz(i1) ) * scaleFactor - u_out%momentz(i1) = u1%momentz(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%forceNodesChord) .AND. ASSOCIATED(u1%forceNodesChord)) THEN - DO i1 = LBOUND(u_out%forceNodesChord,1),UBOUND(u_out%forceNodesChord,1) - b = (t(3)**2*(u1%forceNodesChord(i1) - u2%forceNodesChord(i1)) + t(2)**2*(-u1%forceNodesChord(i1) + u3%forceNodesChord(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%forceNodesChord(i1) + t(3)*u2%forceNodesChord(i1) - t(2)*u3%forceNodesChord(i1) ) * scaleFactor - u_out%forceNodesChord(i1) = u1%forceNodesChord(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE OpFM_Input_ExtrapInterp2 - - - SUBROUTINE OpFM_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(OpFM_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(OpFM_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ASSOCIATED(u_out%pxVel) .AND. ASSOCIATED(u1%pxVel)) THEN + u_out%pxVel = a1*u1%pxVel + a2*u2%pxVel + a3*u3%pxVel + END IF ! check if allocated + IF (ASSOCIATED(u_out%pyVel) .AND. ASSOCIATED(u1%pyVel)) THEN + u_out%pyVel = a1*u1%pyVel + a2*u2%pyVel + a3*u3%pyVel + END IF ! check if allocated + IF (ASSOCIATED(u_out%pzVel) .AND. ASSOCIATED(u1%pzVel)) THEN + u_out%pzVel = a1*u1%pzVel + a2*u2%pzVel + a3*u3%pzVel + END IF ! check if allocated + IF (ASSOCIATED(u_out%pxForce) .AND. ASSOCIATED(u1%pxForce)) THEN + u_out%pxForce = a1*u1%pxForce + a2*u2%pxForce + a3*u3%pxForce + END IF ! check if allocated + IF (ASSOCIATED(u_out%pyForce) .AND. ASSOCIATED(u1%pyForce)) THEN + u_out%pyForce = a1*u1%pyForce + a2*u2%pyForce + a3*u3%pyForce + END IF ! check if allocated + IF (ASSOCIATED(u_out%pzForce) .AND. ASSOCIATED(u1%pzForce)) THEN + u_out%pzForce = a1*u1%pzForce + a2*u2%pzForce + a3*u3%pzForce + END IF ! check if allocated + IF (ASSOCIATED(u_out%xdotForce) .AND. ASSOCIATED(u1%xdotForce)) THEN + u_out%xdotForce = a1*u1%xdotForce + a2*u2%xdotForce + a3*u3%xdotForce + END IF ! check if allocated + IF (ASSOCIATED(u_out%ydotForce) .AND. ASSOCIATED(u1%ydotForce)) THEN + u_out%ydotForce = a1*u1%ydotForce + a2*u2%ydotForce + a3*u3%ydotForce + END IF ! check if allocated + IF (ASSOCIATED(u_out%zdotForce) .AND. ASSOCIATED(u1%zdotForce)) THEN + u_out%zdotForce = a1*u1%zdotForce + a2*u2%zdotForce + a3*u3%zdotForce + END IF ! check if allocated + IF (ASSOCIATED(u_out%pOrientation) .AND. ASSOCIATED(u1%pOrientation)) THEN + u_out%pOrientation = a1*u1%pOrientation + a2*u2%pOrientation + a3*u3%pOrientation + END IF ! check if allocated + IF (ASSOCIATED(u_out%fx) .AND. ASSOCIATED(u1%fx)) THEN + u_out%fx = a1*u1%fx + a2*u2%fx + a3*u3%fx + END IF ! check if allocated + IF (ASSOCIATED(u_out%fy) .AND. ASSOCIATED(u1%fy)) THEN + u_out%fy = a1*u1%fy + a2*u2%fy + a3*u3%fy + END IF ! check if allocated + IF (ASSOCIATED(u_out%fz) .AND. ASSOCIATED(u1%fz)) THEN + u_out%fz = a1*u1%fz + a2*u2%fz + a3*u3%fz + END IF ! check if allocated + IF (ASSOCIATED(u_out%momentx) .AND. ASSOCIATED(u1%momentx)) THEN + u_out%momentx = a1*u1%momentx + a2*u2%momentx + a3*u3%momentx + END IF ! check if allocated + IF (ASSOCIATED(u_out%momenty) .AND. ASSOCIATED(u1%momenty)) THEN + u_out%momenty = a1*u1%momenty + a2*u2%momenty + a3*u3%momenty + END IF ! check if allocated + IF (ASSOCIATED(u_out%momentz) .AND. ASSOCIATED(u1%momentz)) THEN + u_out%momentz = a1*u1%momentz + a2*u2%momentz + a3*u3%momentz + END IF ! check if allocated + IF (ASSOCIATED(u_out%forceNodesChord) .AND. ASSOCIATED(u1%forceNodesChord)) THEN + u_out%forceNodesChord = a1*u1%forceNodesChord + a2*u2%forceNodesChord + a3*u3%forceNodesChord + END IF ! check if allocated +END SUBROUTINE + +subroutine OpFM_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time + ! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(OpFM_OutputType), intent(in) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(OpFM_OutputType), intent(inout) :: y_out ! Output at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_Output_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(y)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(y) - 1 - IF ( order .eq. 0 ) THEN - CALL OpFM_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL OpFM_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL OpFM_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE OpFM_Output_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'OpFM_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call OpFM_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call OpFM_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call OpFM_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE OpFM_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE OpFM_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 1. @@ -3398,65 +3282,54 @@ SUBROUTINE OpFM_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs ! !.................................................................................................................................. - TYPE(OpFM_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 - TYPE(OpFM_OutputType), INTENT(IN) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(OpFM_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(OpFM_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 + TYPE(OpFM_OutputType), INTENT(IN) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(OpFM_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_Output_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF - - ScaleFactor = t_out / t(2) -IF (ASSOCIATED(y_out%u) .AND. ASSOCIATED(y1%u)) THEN - DO i1 = LBOUND(y_out%u,1),UBOUND(y_out%u,1) - b = -(y1%u(i1) - y2%u(i1)) - y_out%u(i1) = y1%u(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(y_out%v) .AND. ASSOCIATED(y1%v)) THEN - DO i1 = LBOUND(y_out%v,1),UBOUND(y_out%v,1) - b = -(y1%v(i1) - y2%v(i1)) - y_out%v(i1) = y1%v(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(y_out%w) .AND. ASSOCIATED(y1%w)) THEN - DO i1 = LBOUND(y_out%w,1),UBOUND(y_out%w,1) - b = -(y1%w(i1) - y2%w(i1)) - y_out%w(i1) = y1%w(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE OpFM_Output_ExtrapInterp1 - - - SUBROUTINE OpFM_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ASSOCIATED(y_out%u) .AND. ASSOCIATED(y1%u)) THEN + y_out%u = a1*y1%u + a2*y2%u + END IF ! check if allocated + IF (ASSOCIATED(y_out%v) .AND. ASSOCIATED(y1%v)) THEN + y_out%v = a1*y1%v + a2*y2%v + END IF ! check if allocated + IF (ASSOCIATED(y_out%w) .AND. ASSOCIATED(y1%w)) THEN + y_out%w = a1*y1%w + a2*y2%w + END IF ! check if allocated + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE OpFM_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 2. @@ -3470,75 +3343,59 @@ SUBROUTINE OpFM_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E ! !.................................................................................................................................. - TYPE(OpFM_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 - TYPE(OpFM_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 - TYPE(OpFM_OutputType), INTENT(IN) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(OpFM_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(OpFM_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 + TYPE(OpFM_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 + TYPE(OpFM_OutputType), INTENT(IN) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(OpFM_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) -IF (ASSOCIATED(y_out%u) .AND. ASSOCIATED(y1%u)) THEN - DO i1 = LBOUND(y_out%u,1),UBOUND(y_out%u,1) - b = (t(3)**2*(y1%u(i1) - y2%u(i1)) + t(2)**2*(-y1%u(i1) + y3%u(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%u(i1) + t(3)*y2%u(i1) - t(2)*y3%u(i1) ) * scaleFactor - y_out%u(i1) = y1%u(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(y_out%v) .AND. ASSOCIATED(y1%v)) THEN - DO i1 = LBOUND(y_out%v,1),UBOUND(y_out%v,1) - b = (t(3)**2*(y1%v(i1) - y2%v(i1)) + t(2)**2*(-y1%v(i1) + y3%v(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%v(i1) + t(3)*y2%v(i1) - t(2)*y3%v(i1) ) * scaleFactor - y_out%v(i1) = y1%v(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(y_out%w) .AND. ASSOCIATED(y1%w)) THEN - DO i1 = LBOUND(y_out%w,1),UBOUND(y_out%w,1) - b = (t(3)**2*(y1%w(i1) - y2%w(i1)) + t(2)**2*(-y1%w(i1) + y3%w(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%w(i1) + t(3)*y2%w(i1) - t(2)*y3%w(i1) ) * scaleFactor - y_out%w(i1) = y1%w(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE OpFM_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ASSOCIATED(y_out%u) .AND. ASSOCIATED(y1%u)) THEN + y_out%u = a1*y1%u + a2*y2%u + a3*y3%u + END IF ! check if allocated + IF (ASSOCIATED(y_out%v) .AND. ASSOCIATED(y1%v)) THEN + y_out%v = a1*y1%v + a2*y2%v + a3*y3%v + END IF ! check if allocated + IF (ASSOCIATED(y_out%w) .AND. ASSOCIATED(y1%w)) THEN + y_out%w = a1*y1%w + a2*y2%w + a3*y3%w + END IF ! check if allocated + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated +END SUBROUTINE END MODULE OpenFOAM_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 index 7bde5b0746..f2c1cc1ea3 100644 --- a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 +++ b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 @@ -823,58 +823,59 @@ subroutine Orca_UnPackConstrState(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return end subroutine - SUBROUTINE Orca_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(Orca_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(Orca_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None +subroutine Orca_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time + ! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(Orca_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(Orca_InputType), intent(inout) :: u_out ! Input at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_Input_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(u)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(u) - 1 - IF ( order .eq. 0 ) THEN - CALL Orca_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL Orca_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL Orca_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE Orca_Input_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'Orca_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call Orca_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call Orca_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call Orca_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE Orca_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE Orca_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 1. @@ -886,41 +887,42 @@ SUBROUTINE Orca_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(Orca_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(Orca_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(Orca_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(Orca_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(Orca_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(Orca_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_Input_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'Orca_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF - - ScaleFactor = t_out / t(2) - CALL MeshExtrapInterp1(u1%PtfmMesh, u2%PtfmMesh, tin, u_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE Orca_Input_ExtrapInterp1 - - - SUBROUTINE Orca_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(u1%PtfmMesh, u2%PtfmMesh, tin, u_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +SUBROUTINE Orca_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 2. @@ -934,101 +936,102 @@ SUBROUTINE Orca_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - TYPE(Orca_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(Orca_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(Orca_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(Orca_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(Orca_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(Orca_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(Orca_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(Orca_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_Input_ExtrapInterp2' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'Orca_Input_ExtrapInterp2' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) - CALL MeshExtrapInterp2(u1%PtfmMesh, u2%PtfmMesh, u3%PtfmMesh, tin, u_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - END SUBROUTINE Orca_Input_ExtrapInterp2 - - - SUBROUTINE Orca_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(Orca_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(Orca_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(u1%PtfmMesh, u2%PtfmMesh, u3%PtfmMesh, tin, u_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) +END SUBROUTINE + +subroutine Orca_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time + ! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(Orca_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(Orca_OutputType), intent(inout) :: y_out ! Output at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_Output_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(y)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(y) - 1 - IF ( order .eq. 0 ) THEN - CALL Orca_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL Orca_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL Orca_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE Orca_Output_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'Orca_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call Orca_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call Orca_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call Orca_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE Orca_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE Orca_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 1. @@ -1040,49 +1043,47 @@ SUBROUTINE Orca_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs ! !.................................................................................................................................. - TYPE(Orca_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(Orca_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(Orca_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(Orca_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(Orca_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(Orca_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_Output_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'Orca_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF - - ScaleFactor = t_out / t(2) - CALL MeshExtrapInterp1(y1%PtfmMesh, y2%PtfmMesh, tin, y_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE Orca_Output_ExtrapInterp1 - - - SUBROUTINE Orca_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(y1%PtfmMesh, y2%PtfmMesh, tin, y_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE Orca_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 2. @@ -1096,56 +1097,52 @@ SUBROUTINE Orca_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E ! !.................................................................................................................................. - TYPE(Orca_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(Orca_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(Orca_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(Orca_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(Orca_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(Orca_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(Orca_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(Orca_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'Orca_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'Orca_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) - CALL MeshExtrapInterp2(y1%PtfmMesh, y2%PtfmMesh, y3%PtfmMesh, tin, y_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE Orca_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(y1%PtfmMesh, y2%PtfmMesh, y3%PtfmMesh, tin, y_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated +END SUBROUTINE END MODULE OrcaFlexInterface_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/servodyn/src/ServoDyn_Types.f90 b/modules/servodyn/src/ServoDyn_Types.f90 index 685d0f5e00..59e61da949 100644 --- a/modules/servodyn/src/ServoDyn_Types.f90 +++ b/modules/servodyn/src/ServoDyn_Types.f90 @@ -8544,58 +8544,59 @@ subroutine SrvD_UnPackOutput(Buf, OutData) end if end subroutine - SUBROUTINE SrvD_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(SrvD_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(SrvD_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None +subroutine SrvD_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time + ! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(SrvD_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(SrvD_InputType), intent(inout) :: u_out ! Input at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_Input_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(u)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(u) - 1 - IF ( order .eq. 0 ) THEN - CALL SrvD_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL SrvD_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL SrvD_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE SrvD_Input_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'SrvD_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call SrvD_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call SrvD_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call SrvD_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE SrvD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE SrvD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 1. @@ -8607,208 +8608,146 @@ SUBROUTINE SrvD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(SrvD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(SrvD_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(SrvD_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(SrvD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(SrvD_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(SrvD_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_Input_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(u_out%BlPitch) .AND. ALLOCATED(u1%BlPitch)) THEN + DO i1 = LBOUND(u_out%BlPitch,1),UBOUND(u_out%BlPitch,1) + CALL Angles_ExtrapInterp( u1%BlPitch(i1), u2%BlPitch(i1), tin, u_out%BlPitch(i1), tin_out ) + END DO + END IF ! check if allocated + CALL Angles_ExtrapInterp( u1%Yaw, u2%Yaw, tin, u_out%Yaw, tin_out ) + u_out%YawRate = a1*u1%YawRate + a2*u2%YawRate + u_out%LSS_Spd = a1*u1%LSS_Spd + a2*u2%LSS_Spd + u_out%HSS_Spd = a1*u1%HSS_Spd + a2*u2%HSS_Spd + u_out%RotSpeed = a1*u1%RotSpeed + a2*u2%RotSpeed + CALL Angles_ExtrapInterp( u1%ExternalYawPosCom, u2%ExternalYawPosCom, tin, u_out%ExternalYawPosCom, tin_out ) + u_out%ExternalYawRateCom = a1*u1%ExternalYawRateCom + a2*u2%ExternalYawRateCom + IF (ALLOCATED(u_out%ExternalBlPitchCom) .AND. ALLOCATED(u1%ExternalBlPitchCom)) THEN + DO i1 = LBOUND(u_out%ExternalBlPitchCom,1),UBOUND(u_out%ExternalBlPitchCom,1) + CALL Angles_ExtrapInterp( u1%ExternalBlPitchCom(i1), u2%ExternalBlPitchCom(i1), tin, u_out%ExternalBlPitchCom(i1), tin_out ) + END DO + END IF ! check if allocated + u_out%ExternalGenTrq = a1*u1%ExternalGenTrq + a2*u2%ExternalGenTrq + u_out%ExternalElecPwr = a1*u1%ExternalElecPwr + a2*u2%ExternalElecPwr + u_out%ExternalHSSBrFrac = a1*u1%ExternalHSSBrFrac + a2*u2%ExternalHSSBrFrac + IF (ALLOCATED(u_out%ExternalBlAirfoilCom) .AND. ALLOCATED(u1%ExternalBlAirfoilCom)) THEN + u_out%ExternalBlAirfoilCom = a1*u1%ExternalBlAirfoilCom + a2*u2%ExternalBlAirfoilCom + END IF ! check if allocated + IF (ALLOCATED(u_out%ExternalCableDeltaL) .AND. ALLOCATED(u1%ExternalCableDeltaL)) THEN + u_out%ExternalCableDeltaL = a1*u1%ExternalCableDeltaL + a2*u2%ExternalCableDeltaL + END IF ! check if allocated + IF (ALLOCATED(u_out%ExternalCableDeltaLdot) .AND. ALLOCATED(u1%ExternalCableDeltaLdot)) THEN + u_out%ExternalCableDeltaLdot = a1*u1%ExternalCableDeltaLdot + a2*u2%ExternalCableDeltaLdot + END IF ! check if allocated + u_out%TwrAccel = a1*u1%TwrAccel + a2*u2%TwrAccel + CALL Angles_ExtrapInterp( u1%YawErr, u2%YawErr, tin, u_out%YawErr, tin_out ) + CALL Angles_ExtrapInterp( u1%WindDir, u2%WindDir, tin, u_out%WindDir, tin_out ) + u_out%RootMyc = a1*u1%RootMyc + a2*u2%RootMyc + u_out%YawBrTAxp = a1*u1%YawBrTAxp + a2*u2%YawBrTAxp + u_out%YawBrTAyp = a1*u1%YawBrTAyp + a2*u2%YawBrTAyp + u_out%LSSTipPxa = a1*u1%LSSTipPxa + a2*u2%LSSTipPxa + u_out%RootMxc = a1*u1%RootMxc + a2*u2%RootMxc + u_out%LSSTipMxa = a1*u1%LSSTipMxa + a2*u2%LSSTipMxa + u_out%LSSTipMya = a1*u1%LSSTipMya + a2*u2%LSSTipMya + u_out%LSSTipMza = a1*u1%LSSTipMza + a2*u2%LSSTipMza + u_out%LSSTipMys = a1*u1%LSSTipMys + a2*u2%LSSTipMys + u_out%LSSTipMzs = a1*u1%LSSTipMzs + a2*u2%LSSTipMzs + u_out%YawBrMyn = a1*u1%YawBrMyn + a2*u2%YawBrMyn + u_out%YawBrMzn = a1*u1%YawBrMzn + a2*u2%YawBrMzn + u_out%NcIMURAxs = a1*u1%NcIMURAxs + a2*u2%NcIMURAxs + u_out%NcIMURAys = a1*u1%NcIMURAys + a2*u2%NcIMURAys + u_out%NcIMURAzs = a1*u1%NcIMURAzs + a2*u2%NcIMURAzs + u_out%RotPwr = a1*u1%RotPwr + a2*u2%RotPwr + u_out%HorWindV = a1*u1%HorWindV + a2*u2%HorWindV + CALL Angles_ExtrapInterp( u1%YawAngle, u2%YawAngle, tin, u_out%YawAngle, tin_out ) + u_out%LSShftFxa = a1*u1%LSShftFxa + a2*u2%LSShftFxa + u_out%LSShftFys = a1*u1%LSShftFys + a2*u2%LSShftFys + u_out%LSShftFzs = a1*u1%LSShftFzs + a2*u2%LSShftFzs + IF (ALLOCATED(u_out%fromSC) .AND. ALLOCATED(u1%fromSC)) THEN + u_out%fromSC = a1*u1%fromSC + a2*u2%fromSC + END IF ! check if allocated + IF (ALLOCATED(u_out%fromSCglob) .AND. ALLOCATED(u1%fromSCglob)) THEN + u_out%fromSCglob = a1*u1%fromSCglob + a2*u2%fromSCglob + END IF ! check if allocated + IF (ALLOCATED(u_out%Lidar) .AND. ALLOCATED(u1%Lidar)) THEN + u_out%Lidar = a1*u1%Lidar + a2*u2%Lidar + END IF ! check if allocated + CALL MeshExtrapInterp1(u1%PtfmMotionMesh, u2%PtfmMotionMesh, tin, u_out%PtfmMotionMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(u_out%BStCMotionMesh) .AND. ALLOCATED(u1%BStCMotionMesh)) THEN + DO i2 = LBOUND(u_out%BStCMotionMesh,2),UBOUND(u_out%BStCMotionMesh,2) + DO i1 = LBOUND(u_out%BStCMotionMesh,1),UBOUND(u_out%BStCMotionMesh,1) + CALL MeshExtrapInterp1(u1%BStCMotionMesh(i1,i2), u2%BStCMotionMesh(i1,i2), tin, u_out%BStCMotionMesh(i1,i2), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%NStCMotionMesh) .AND. ALLOCATED(u1%NStCMotionMesh)) THEN + DO i1 = LBOUND(u_out%NStCMotionMesh,1),UBOUND(u_out%NStCMotionMesh,1) + CALL MeshExtrapInterp1(u1%NStCMotionMesh(i1), u2%NStCMotionMesh(i1), tin, u_out%NStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%TStCMotionMesh) .AND. ALLOCATED(u1%TStCMotionMesh)) THEN + DO i1 = LBOUND(u_out%TStCMotionMesh,1),UBOUND(u_out%TStCMotionMesh,1) + CALL MeshExtrapInterp1(u1%TStCMotionMesh(i1), u2%TStCMotionMesh(i1), tin, u_out%TStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%SStCMotionMesh) .AND. ALLOCATED(u1%SStCMotionMesh)) THEN + DO i1 = LBOUND(u_out%SStCMotionMesh,1),UBOUND(u_out%SStCMotionMesh,1) + CALL MeshExtrapInterp1(u1%SStCMotionMesh(i1), u2%SStCMotionMesh(i1), tin, u_out%SStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%LidSpeed) .AND. ALLOCATED(u1%LidSpeed)) THEN + u_out%LidSpeed = a1*u1%LidSpeed + a2*u2%LidSpeed + END IF ! check if allocated + IF (ALLOCATED(u_out%MsrPositionsX) .AND. ALLOCATED(u1%MsrPositionsX)) THEN + u_out%MsrPositionsX = a1*u1%MsrPositionsX + a2*u2%MsrPositionsX + END IF ! check if allocated + IF (ALLOCATED(u_out%MsrPositionsY) .AND. ALLOCATED(u1%MsrPositionsY)) THEN + u_out%MsrPositionsY = a1*u1%MsrPositionsY + a2*u2%MsrPositionsY + END IF ! check if allocated + IF (ALLOCATED(u_out%MsrPositionsZ) .AND. ALLOCATED(u1%MsrPositionsZ)) THEN + u_out%MsrPositionsZ = a1*u1%MsrPositionsZ + a2*u2%MsrPositionsZ + END IF ! check if allocated +END SUBROUTINE - ScaleFactor = t_out / t(2) -IF (ALLOCATED(u_out%BlPitch) .AND. ALLOCATED(u1%BlPitch)) THEN - DO i1 = LBOUND(u_out%BlPitch,1),UBOUND(u_out%BlPitch,1) - CALL Angles_ExtrapInterp( u1%BlPitch(i1), u2%BlPitch(i1), tin, u_out%BlPitch(i1), tin_out ) - END DO -END IF ! check if allocated - CALL Angles_ExtrapInterp( u1%Yaw, u2%Yaw, tin, u_out%Yaw, tin_out ) - b = -(u1%YawRate - u2%YawRate) - u_out%YawRate = u1%YawRate + b * ScaleFactor - b = -(u1%LSS_Spd - u2%LSS_Spd) - u_out%LSS_Spd = u1%LSS_Spd + b * ScaleFactor - b = -(u1%HSS_Spd - u2%HSS_Spd) - u_out%HSS_Spd = u1%HSS_Spd + b * ScaleFactor - b = -(u1%RotSpeed - u2%RotSpeed) - u_out%RotSpeed = u1%RotSpeed + b * ScaleFactor - CALL Angles_ExtrapInterp( u1%ExternalYawPosCom, u2%ExternalYawPosCom, tin, u_out%ExternalYawPosCom, tin_out ) - b = -(u1%ExternalYawRateCom - u2%ExternalYawRateCom) - u_out%ExternalYawRateCom = u1%ExternalYawRateCom + b * ScaleFactor -IF (ALLOCATED(u_out%ExternalBlPitchCom) .AND. ALLOCATED(u1%ExternalBlPitchCom)) THEN - DO i1 = LBOUND(u_out%ExternalBlPitchCom,1),UBOUND(u_out%ExternalBlPitchCom,1) - CALL Angles_ExtrapInterp( u1%ExternalBlPitchCom(i1), u2%ExternalBlPitchCom(i1), tin, u_out%ExternalBlPitchCom(i1), tin_out ) - END DO -END IF ! check if allocated - b = -(u1%ExternalGenTrq - u2%ExternalGenTrq) - u_out%ExternalGenTrq = u1%ExternalGenTrq + b * ScaleFactor - b = -(u1%ExternalElecPwr - u2%ExternalElecPwr) - u_out%ExternalElecPwr = u1%ExternalElecPwr + b * ScaleFactor - b = -(u1%ExternalHSSBrFrac - u2%ExternalHSSBrFrac) - u_out%ExternalHSSBrFrac = u1%ExternalHSSBrFrac + b * ScaleFactor -IF (ALLOCATED(u_out%ExternalBlAirfoilCom) .AND. ALLOCATED(u1%ExternalBlAirfoilCom)) THEN - DO i1 = LBOUND(u_out%ExternalBlAirfoilCom,1),UBOUND(u_out%ExternalBlAirfoilCom,1) - b = -(u1%ExternalBlAirfoilCom(i1) - u2%ExternalBlAirfoilCom(i1)) - u_out%ExternalBlAirfoilCom(i1) = u1%ExternalBlAirfoilCom(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%ExternalCableDeltaL) .AND. ALLOCATED(u1%ExternalCableDeltaL)) THEN - DO i1 = LBOUND(u_out%ExternalCableDeltaL,1),UBOUND(u_out%ExternalCableDeltaL,1) - b = -(u1%ExternalCableDeltaL(i1) - u2%ExternalCableDeltaL(i1)) - u_out%ExternalCableDeltaL(i1) = u1%ExternalCableDeltaL(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%ExternalCableDeltaLdot) .AND. ALLOCATED(u1%ExternalCableDeltaLdot)) THEN - DO i1 = LBOUND(u_out%ExternalCableDeltaLdot,1),UBOUND(u_out%ExternalCableDeltaLdot,1) - b = -(u1%ExternalCableDeltaLdot(i1) - u2%ExternalCableDeltaLdot(i1)) - u_out%ExternalCableDeltaLdot(i1) = u1%ExternalCableDeltaLdot(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - b = -(u1%TwrAccel - u2%TwrAccel) - u_out%TwrAccel = u1%TwrAccel + b * ScaleFactor - CALL Angles_ExtrapInterp( u1%YawErr, u2%YawErr, tin, u_out%YawErr, tin_out ) - CALL Angles_ExtrapInterp( u1%WindDir, u2%WindDir, tin, u_out%WindDir, tin_out ) - DO i1 = LBOUND(u_out%RootMyc,1),UBOUND(u_out%RootMyc,1) - b = -(u1%RootMyc(i1) - u2%RootMyc(i1)) - u_out%RootMyc(i1) = u1%RootMyc(i1) + b * ScaleFactor - END DO - b = -(u1%YawBrTAxp - u2%YawBrTAxp) - u_out%YawBrTAxp = u1%YawBrTAxp + b * ScaleFactor - b = -(u1%YawBrTAyp - u2%YawBrTAyp) - u_out%YawBrTAyp = u1%YawBrTAyp + b * ScaleFactor - b = -(u1%LSSTipPxa - u2%LSSTipPxa) - u_out%LSSTipPxa = u1%LSSTipPxa + b * ScaleFactor - DO i1 = LBOUND(u_out%RootMxc,1),UBOUND(u_out%RootMxc,1) - b = -(u1%RootMxc(i1) - u2%RootMxc(i1)) - u_out%RootMxc(i1) = u1%RootMxc(i1) + b * ScaleFactor - END DO - b = -(u1%LSSTipMxa - u2%LSSTipMxa) - u_out%LSSTipMxa = u1%LSSTipMxa + b * ScaleFactor - b = -(u1%LSSTipMya - u2%LSSTipMya) - u_out%LSSTipMya = u1%LSSTipMya + b * ScaleFactor - b = -(u1%LSSTipMza - u2%LSSTipMza) - u_out%LSSTipMza = u1%LSSTipMza + b * ScaleFactor - b = -(u1%LSSTipMys - u2%LSSTipMys) - u_out%LSSTipMys = u1%LSSTipMys + b * ScaleFactor - b = -(u1%LSSTipMzs - u2%LSSTipMzs) - u_out%LSSTipMzs = u1%LSSTipMzs + b * ScaleFactor - b = -(u1%YawBrMyn - u2%YawBrMyn) - u_out%YawBrMyn = u1%YawBrMyn + b * ScaleFactor - b = -(u1%YawBrMzn - u2%YawBrMzn) - u_out%YawBrMzn = u1%YawBrMzn + b * ScaleFactor - b = -(u1%NcIMURAxs - u2%NcIMURAxs) - u_out%NcIMURAxs = u1%NcIMURAxs + b * ScaleFactor - b = -(u1%NcIMURAys - u2%NcIMURAys) - u_out%NcIMURAys = u1%NcIMURAys + b * ScaleFactor - b = -(u1%NcIMURAzs - u2%NcIMURAzs) - u_out%NcIMURAzs = u1%NcIMURAzs + b * ScaleFactor - b = -(u1%RotPwr - u2%RotPwr) - u_out%RotPwr = u1%RotPwr + b * ScaleFactor - b = -(u1%HorWindV - u2%HorWindV) - u_out%HorWindV = u1%HorWindV + b * ScaleFactor - CALL Angles_ExtrapInterp( u1%YawAngle, u2%YawAngle, tin, u_out%YawAngle, tin_out ) - b = -(u1%LSShftFxa - u2%LSShftFxa) - u_out%LSShftFxa = u1%LSShftFxa + b * ScaleFactor - b = -(u1%LSShftFys - u2%LSShftFys) - u_out%LSShftFys = u1%LSShftFys + b * ScaleFactor - b = -(u1%LSShftFzs - u2%LSShftFzs) - u_out%LSShftFzs = u1%LSShftFzs + b * ScaleFactor -IF (ALLOCATED(u_out%fromSC) .AND. ALLOCATED(u1%fromSC)) THEN - DO i1 = LBOUND(u_out%fromSC,1),UBOUND(u_out%fromSC,1) - b = -(u1%fromSC(i1) - u2%fromSC(i1)) - u_out%fromSC(i1) = u1%fromSC(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%fromSCglob) .AND. ALLOCATED(u1%fromSCglob)) THEN - DO i1 = LBOUND(u_out%fromSCglob,1),UBOUND(u_out%fromSCglob,1) - b = -(u1%fromSCglob(i1) - u2%fromSCglob(i1)) - u_out%fromSCglob(i1) = u1%fromSCglob(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Lidar) .AND. ALLOCATED(u1%Lidar)) THEN - DO i1 = LBOUND(u_out%Lidar,1),UBOUND(u_out%Lidar,1) - b = -(u1%Lidar(i1) - u2%Lidar(i1)) - u_out%Lidar(i1) = u1%Lidar(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - CALL MeshExtrapInterp1(u1%PtfmMotionMesh, u2%PtfmMotionMesh, tin, u_out%PtfmMotionMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(u_out%BStCMotionMesh) .AND. ALLOCATED(u1%BStCMotionMesh)) THEN - DO i2 = LBOUND(u_out%BStCMotionMesh,2),UBOUND(u_out%BStCMotionMesh,2) - DO i1 = LBOUND(u_out%BStCMotionMesh,1),UBOUND(u_out%BStCMotionMesh,1) - CALL MeshExtrapInterp1(u1%BStCMotionMesh(i1,i2), u2%BStCMotionMesh(i1,i2), tin, u_out%BStCMotionMesh(i1,i2), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%NStCMotionMesh) .AND. ALLOCATED(u1%NStCMotionMesh)) THEN - DO i1 = LBOUND(u_out%NStCMotionMesh,1),UBOUND(u_out%NStCMotionMesh,1) - CALL MeshExtrapInterp1(u1%NStCMotionMesh(i1), u2%NStCMotionMesh(i1), tin, u_out%NStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%TStCMotionMesh) .AND. ALLOCATED(u1%TStCMotionMesh)) THEN - DO i1 = LBOUND(u_out%TStCMotionMesh,1),UBOUND(u_out%TStCMotionMesh,1) - CALL MeshExtrapInterp1(u1%TStCMotionMesh(i1), u2%TStCMotionMesh(i1), tin, u_out%TStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%SStCMotionMesh) .AND. ALLOCATED(u1%SStCMotionMesh)) THEN - DO i1 = LBOUND(u_out%SStCMotionMesh,1),UBOUND(u_out%SStCMotionMesh,1) - CALL MeshExtrapInterp1(u1%SStCMotionMesh(i1), u2%SStCMotionMesh(i1), tin, u_out%SStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%LidSpeed) .AND. ALLOCATED(u1%LidSpeed)) THEN - DO i1 = LBOUND(u_out%LidSpeed,1),UBOUND(u_out%LidSpeed,1) - b = -(u1%LidSpeed(i1) - u2%LidSpeed(i1)) - u_out%LidSpeed(i1) = u1%LidSpeed(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%MsrPositionsX) .AND. ALLOCATED(u1%MsrPositionsX)) THEN - DO i1 = LBOUND(u_out%MsrPositionsX,1),UBOUND(u_out%MsrPositionsX,1) - b = -(u1%MsrPositionsX(i1) - u2%MsrPositionsX(i1)) - u_out%MsrPositionsX(i1) = u1%MsrPositionsX(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%MsrPositionsY) .AND. ALLOCATED(u1%MsrPositionsY)) THEN - DO i1 = LBOUND(u_out%MsrPositionsY,1),UBOUND(u_out%MsrPositionsY,1) - b = -(u1%MsrPositionsY(i1) - u2%MsrPositionsY(i1)) - u_out%MsrPositionsY(i1) = u1%MsrPositionsY(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%MsrPositionsZ) .AND. ALLOCATED(u1%MsrPositionsZ)) THEN - DO i1 = LBOUND(u_out%MsrPositionsZ,1),UBOUND(u_out%MsrPositionsZ,1) - b = -(u1%MsrPositionsZ(i1) - u2%MsrPositionsZ(i1)) - u_out%MsrPositionsZ(i1) = u1%MsrPositionsZ(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE SrvD_Input_ExtrapInterp1 - - - SUBROUTINE SrvD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE SrvD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 2. @@ -8822,307 +8761,206 @@ SUBROUTINE SrvD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - TYPE(SrvD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(SrvD_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(SrvD_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(SrvD_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(SrvD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(SrvD_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(SrvD_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(SrvD_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_Input_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(u_out%BlPitch) .AND. ALLOCATED(u1%BlPitch)) THEN + DO i1 = LBOUND(u_out%BlPitch,1),UBOUND(u_out%BlPitch,1) + CALL Angles_ExtrapInterp( u1%BlPitch(i1), u2%BlPitch(i1), u3%BlPitch(i1), tin, u_out%BlPitch(i1), tin_out ) + END DO + END IF ! check if allocated + CALL Angles_ExtrapInterp( u1%Yaw, u2%Yaw, u3%Yaw, tin, u_out%Yaw, tin_out ) + u_out%YawRate = a1*u1%YawRate + a2*u2%YawRate + a3*u3%YawRate + u_out%LSS_Spd = a1*u1%LSS_Spd + a2*u2%LSS_Spd + a3*u3%LSS_Spd + u_out%HSS_Spd = a1*u1%HSS_Spd + a2*u2%HSS_Spd + a3*u3%HSS_Spd + u_out%RotSpeed = a1*u1%RotSpeed + a2*u2%RotSpeed + a3*u3%RotSpeed + CALL Angles_ExtrapInterp( u1%ExternalYawPosCom, u2%ExternalYawPosCom, u3%ExternalYawPosCom, tin, u_out%ExternalYawPosCom, tin_out ) + u_out%ExternalYawRateCom = a1*u1%ExternalYawRateCom + a2*u2%ExternalYawRateCom + a3*u3%ExternalYawRateCom + IF (ALLOCATED(u_out%ExternalBlPitchCom) .AND. ALLOCATED(u1%ExternalBlPitchCom)) THEN + DO i1 = LBOUND(u_out%ExternalBlPitchCom,1),UBOUND(u_out%ExternalBlPitchCom,1) + CALL Angles_ExtrapInterp( u1%ExternalBlPitchCom(i1), u2%ExternalBlPitchCom(i1), u3%ExternalBlPitchCom(i1), tin, u_out%ExternalBlPitchCom(i1), tin_out ) + END DO + END IF ! check if allocated + u_out%ExternalGenTrq = a1*u1%ExternalGenTrq + a2*u2%ExternalGenTrq + a3*u3%ExternalGenTrq + u_out%ExternalElecPwr = a1*u1%ExternalElecPwr + a2*u2%ExternalElecPwr + a3*u3%ExternalElecPwr + u_out%ExternalHSSBrFrac = a1*u1%ExternalHSSBrFrac + a2*u2%ExternalHSSBrFrac + a3*u3%ExternalHSSBrFrac + IF (ALLOCATED(u_out%ExternalBlAirfoilCom) .AND. ALLOCATED(u1%ExternalBlAirfoilCom)) THEN + u_out%ExternalBlAirfoilCom = a1*u1%ExternalBlAirfoilCom + a2*u2%ExternalBlAirfoilCom + a3*u3%ExternalBlAirfoilCom + END IF ! check if allocated + IF (ALLOCATED(u_out%ExternalCableDeltaL) .AND. ALLOCATED(u1%ExternalCableDeltaL)) THEN + u_out%ExternalCableDeltaL = a1*u1%ExternalCableDeltaL + a2*u2%ExternalCableDeltaL + a3*u3%ExternalCableDeltaL + END IF ! check if allocated + IF (ALLOCATED(u_out%ExternalCableDeltaLdot) .AND. ALLOCATED(u1%ExternalCableDeltaLdot)) THEN + u_out%ExternalCableDeltaLdot = a1*u1%ExternalCableDeltaLdot + a2*u2%ExternalCableDeltaLdot + a3*u3%ExternalCableDeltaLdot + END IF ! check if allocated + u_out%TwrAccel = a1*u1%TwrAccel + a2*u2%TwrAccel + a3*u3%TwrAccel + CALL Angles_ExtrapInterp( u1%YawErr, u2%YawErr, u3%YawErr, tin, u_out%YawErr, tin_out ) + CALL Angles_ExtrapInterp( u1%WindDir, u2%WindDir, u3%WindDir, tin, u_out%WindDir, tin_out ) + u_out%RootMyc = a1*u1%RootMyc + a2*u2%RootMyc + a3*u3%RootMyc + u_out%YawBrTAxp = a1*u1%YawBrTAxp + a2*u2%YawBrTAxp + a3*u3%YawBrTAxp + u_out%YawBrTAyp = a1*u1%YawBrTAyp + a2*u2%YawBrTAyp + a3*u3%YawBrTAyp + u_out%LSSTipPxa = a1*u1%LSSTipPxa + a2*u2%LSSTipPxa + a3*u3%LSSTipPxa + u_out%RootMxc = a1*u1%RootMxc + a2*u2%RootMxc + a3*u3%RootMxc + u_out%LSSTipMxa = a1*u1%LSSTipMxa + a2*u2%LSSTipMxa + a3*u3%LSSTipMxa + u_out%LSSTipMya = a1*u1%LSSTipMya + a2*u2%LSSTipMya + a3*u3%LSSTipMya + u_out%LSSTipMza = a1*u1%LSSTipMza + a2*u2%LSSTipMza + a3*u3%LSSTipMza + u_out%LSSTipMys = a1*u1%LSSTipMys + a2*u2%LSSTipMys + a3*u3%LSSTipMys + u_out%LSSTipMzs = a1*u1%LSSTipMzs + a2*u2%LSSTipMzs + a3*u3%LSSTipMzs + u_out%YawBrMyn = a1*u1%YawBrMyn + a2*u2%YawBrMyn + a3*u3%YawBrMyn + u_out%YawBrMzn = a1*u1%YawBrMzn + a2*u2%YawBrMzn + a3*u3%YawBrMzn + u_out%NcIMURAxs = a1*u1%NcIMURAxs + a2*u2%NcIMURAxs + a3*u3%NcIMURAxs + u_out%NcIMURAys = a1*u1%NcIMURAys + a2*u2%NcIMURAys + a3*u3%NcIMURAys + u_out%NcIMURAzs = a1*u1%NcIMURAzs + a2*u2%NcIMURAzs + a3*u3%NcIMURAzs + u_out%RotPwr = a1*u1%RotPwr + a2*u2%RotPwr + a3*u3%RotPwr + u_out%HorWindV = a1*u1%HorWindV + a2*u2%HorWindV + a3*u3%HorWindV + CALL Angles_ExtrapInterp( u1%YawAngle, u2%YawAngle, u3%YawAngle, tin, u_out%YawAngle, tin_out ) + u_out%LSShftFxa = a1*u1%LSShftFxa + a2*u2%LSShftFxa + a3*u3%LSShftFxa + u_out%LSShftFys = a1*u1%LSShftFys + a2*u2%LSShftFys + a3*u3%LSShftFys + u_out%LSShftFzs = a1*u1%LSShftFzs + a2*u2%LSShftFzs + a3*u3%LSShftFzs + IF (ALLOCATED(u_out%fromSC) .AND. ALLOCATED(u1%fromSC)) THEN + u_out%fromSC = a1*u1%fromSC + a2*u2%fromSC + a3*u3%fromSC + END IF ! check if allocated + IF (ALLOCATED(u_out%fromSCglob) .AND. ALLOCATED(u1%fromSCglob)) THEN + u_out%fromSCglob = a1*u1%fromSCglob + a2*u2%fromSCglob + a3*u3%fromSCglob + END IF ! check if allocated + IF (ALLOCATED(u_out%Lidar) .AND. ALLOCATED(u1%Lidar)) THEN + u_out%Lidar = a1*u1%Lidar + a2*u2%Lidar + a3*u3%Lidar + END IF ! check if allocated + CALL MeshExtrapInterp2(u1%PtfmMotionMesh, u2%PtfmMotionMesh, u3%PtfmMotionMesh, tin, u_out%PtfmMotionMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(u_out%BStCMotionMesh) .AND. ALLOCATED(u1%BStCMotionMesh)) THEN + DO i2 = LBOUND(u_out%BStCMotionMesh,2),UBOUND(u_out%BStCMotionMesh,2) + DO i1 = LBOUND(u_out%BStCMotionMesh,1),UBOUND(u_out%BStCMotionMesh,1) + CALL MeshExtrapInterp2(u1%BStCMotionMesh(i1,i2), u2%BStCMotionMesh(i1,i2), u3%BStCMotionMesh(i1,i2), tin, u_out%BStCMotionMesh(i1,i2), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%NStCMotionMesh) .AND. ALLOCATED(u1%NStCMotionMesh)) THEN + DO i1 = LBOUND(u_out%NStCMotionMesh,1),UBOUND(u_out%NStCMotionMesh,1) + CALL MeshExtrapInterp2(u1%NStCMotionMesh(i1), u2%NStCMotionMesh(i1), u3%NStCMotionMesh(i1), tin, u_out%NStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%TStCMotionMesh) .AND. ALLOCATED(u1%TStCMotionMesh)) THEN + DO i1 = LBOUND(u_out%TStCMotionMesh,1),UBOUND(u_out%TStCMotionMesh,1) + CALL MeshExtrapInterp2(u1%TStCMotionMesh(i1), u2%TStCMotionMesh(i1), u3%TStCMotionMesh(i1), tin, u_out%TStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%SStCMotionMesh) .AND. ALLOCATED(u1%SStCMotionMesh)) THEN + DO i1 = LBOUND(u_out%SStCMotionMesh,1),UBOUND(u_out%SStCMotionMesh,1) + CALL MeshExtrapInterp2(u1%SStCMotionMesh(i1), u2%SStCMotionMesh(i1), u3%SStCMotionMesh(i1), tin, u_out%SStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%LidSpeed) .AND. ALLOCATED(u1%LidSpeed)) THEN + u_out%LidSpeed = a1*u1%LidSpeed + a2*u2%LidSpeed + a3*u3%LidSpeed + END IF ! check if allocated + IF (ALLOCATED(u_out%MsrPositionsX) .AND. ALLOCATED(u1%MsrPositionsX)) THEN + u_out%MsrPositionsX = a1*u1%MsrPositionsX + a2*u2%MsrPositionsX + a3*u3%MsrPositionsX + END IF ! check if allocated + IF (ALLOCATED(u_out%MsrPositionsY) .AND. ALLOCATED(u1%MsrPositionsY)) THEN + u_out%MsrPositionsY = a1*u1%MsrPositionsY + a2*u2%MsrPositionsY + a3*u3%MsrPositionsY + END IF ! check if allocated + IF (ALLOCATED(u_out%MsrPositionsZ) .AND. ALLOCATED(u1%MsrPositionsZ)) THEN + u_out%MsrPositionsZ = a1*u1%MsrPositionsZ + a2*u2%MsrPositionsZ + a3*u3%MsrPositionsZ + END IF ! check if allocated +END SUBROUTINE - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) -IF (ALLOCATED(u_out%BlPitch) .AND. ALLOCATED(u1%BlPitch)) THEN - DO i1 = LBOUND(u_out%BlPitch,1),UBOUND(u_out%BlPitch,1) - CALL Angles_ExtrapInterp( u1%BlPitch(i1), u2%BlPitch(i1), u3%BlPitch(i1), tin, u_out%BlPitch(i1), tin_out ) - END DO -END IF ! check if allocated - CALL Angles_ExtrapInterp( u1%Yaw, u2%Yaw, u3%Yaw, tin, u_out%Yaw, tin_out ) - b = (t(3)**2*(u1%YawRate - u2%YawRate) + t(2)**2*(-u1%YawRate + u3%YawRate))* scaleFactor - c = ( (t(2)-t(3))*u1%YawRate + t(3)*u2%YawRate - t(2)*u3%YawRate ) * scaleFactor - u_out%YawRate = u1%YawRate + b + c * t_out - b = (t(3)**2*(u1%LSS_Spd - u2%LSS_Spd) + t(2)**2*(-u1%LSS_Spd + u3%LSS_Spd))* scaleFactor - c = ( (t(2)-t(3))*u1%LSS_Spd + t(3)*u2%LSS_Spd - t(2)*u3%LSS_Spd ) * scaleFactor - u_out%LSS_Spd = u1%LSS_Spd + b + c * t_out - b = (t(3)**2*(u1%HSS_Spd - u2%HSS_Spd) + t(2)**2*(-u1%HSS_Spd + u3%HSS_Spd))* scaleFactor - c = ( (t(2)-t(3))*u1%HSS_Spd + t(3)*u2%HSS_Spd - t(2)*u3%HSS_Spd ) * scaleFactor - u_out%HSS_Spd = u1%HSS_Spd + b + c * t_out - b = (t(3)**2*(u1%RotSpeed - u2%RotSpeed) + t(2)**2*(-u1%RotSpeed + u3%RotSpeed))* scaleFactor - c = ( (t(2)-t(3))*u1%RotSpeed + t(3)*u2%RotSpeed - t(2)*u3%RotSpeed ) * scaleFactor - u_out%RotSpeed = u1%RotSpeed + b + c * t_out - CALL Angles_ExtrapInterp( u1%ExternalYawPosCom, u2%ExternalYawPosCom, u3%ExternalYawPosCom, tin, u_out%ExternalYawPosCom, tin_out ) - b = (t(3)**2*(u1%ExternalYawRateCom - u2%ExternalYawRateCom) + t(2)**2*(-u1%ExternalYawRateCom + u3%ExternalYawRateCom))* scaleFactor - c = ( (t(2)-t(3))*u1%ExternalYawRateCom + t(3)*u2%ExternalYawRateCom - t(2)*u3%ExternalYawRateCom ) * scaleFactor - u_out%ExternalYawRateCom = u1%ExternalYawRateCom + b + c * t_out -IF (ALLOCATED(u_out%ExternalBlPitchCom) .AND. ALLOCATED(u1%ExternalBlPitchCom)) THEN - DO i1 = LBOUND(u_out%ExternalBlPitchCom,1),UBOUND(u_out%ExternalBlPitchCom,1) - CALL Angles_ExtrapInterp( u1%ExternalBlPitchCom(i1), u2%ExternalBlPitchCom(i1), u3%ExternalBlPitchCom(i1), tin, u_out%ExternalBlPitchCom(i1), tin_out ) - END DO -END IF ! check if allocated - b = (t(3)**2*(u1%ExternalGenTrq - u2%ExternalGenTrq) + t(2)**2*(-u1%ExternalGenTrq + u3%ExternalGenTrq))* scaleFactor - c = ( (t(2)-t(3))*u1%ExternalGenTrq + t(3)*u2%ExternalGenTrq - t(2)*u3%ExternalGenTrq ) * scaleFactor - u_out%ExternalGenTrq = u1%ExternalGenTrq + b + c * t_out - b = (t(3)**2*(u1%ExternalElecPwr - u2%ExternalElecPwr) + t(2)**2*(-u1%ExternalElecPwr + u3%ExternalElecPwr))* scaleFactor - c = ( (t(2)-t(3))*u1%ExternalElecPwr + t(3)*u2%ExternalElecPwr - t(2)*u3%ExternalElecPwr ) * scaleFactor - u_out%ExternalElecPwr = u1%ExternalElecPwr + b + c * t_out - b = (t(3)**2*(u1%ExternalHSSBrFrac - u2%ExternalHSSBrFrac) + t(2)**2*(-u1%ExternalHSSBrFrac + u3%ExternalHSSBrFrac))* scaleFactor - c = ( (t(2)-t(3))*u1%ExternalHSSBrFrac + t(3)*u2%ExternalHSSBrFrac - t(2)*u3%ExternalHSSBrFrac ) * scaleFactor - u_out%ExternalHSSBrFrac = u1%ExternalHSSBrFrac + b + c * t_out -IF (ALLOCATED(u_out%ExternalBlAirfoilCom) .AND. ALLOCATED(u1%ExternalBlAirfoilCom)) THEN - DO i1 = LBOUND(u_out%ExternalBlAirfoilCom,1),UBOUND(u_out%ExternalBlAirfoilCom,1) - b = (t(3)**2*(u1%ExternalBlAirfoilCom(i1) - u2%ExternalBlAirfoilCom(i1)) + t(2)**2*(-u1%ExternalBlAirfoilCom(i1) + u3%ExternalBlAirfoilCom(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%ExternalBlAirfoilCom(i1) + t(3)*u2%ExternalBlAirfoilCom(i1) - t(2)*u3%ExternalBlAirfoilCom(i1) ) * scaleFactor - u_out%ExternalBlAirfoilCom(i1) = u1%ExternalBlAirfoilCom(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%ExternalCableDeltaL) .AND. ALLOCATED(u1%ExternalCableDeltaL)) THEN - DO i1 = LBOUND(u_out%ExternalCableDeltaL,1),UBOUND(u_out%ExternalCableDeltaL,1) - b = (t(3)**2*(u1%ExternalCableDeltaL(i1) - u2%ExternalCableDeltaL(i1)) + t(2)**2*(-u1%ExternalCableDeltaL(i1) + u3%ExternalCableDeltaL(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%ExternalCableDeltaL(i1) + t(3)*u2%ExternalCableDeltaL(i1) - t(2)*u3%ExternalCableDeltaL(i1) ) * scaleFactor - u_out%ExternalCableDeltaL(i1) = u1%ExternalCableDeltaL(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%ExternalCableDeltaLdot) .AND. ALLOCATED(u1%ExternalCableDeltaLdot)) THEN - DO i1 = LBOUND(u_out%ExternalCableDeltaLdot,1),UBOUND(u_out%ExternalCableDeltaLdot,1) - b = (t(3)**2*(u1%ExternalCableDeltaLdot(i1) - u2%ExternalCableDeltaLdot(i1)) + t(2)**2*(-u1%ExternalCableDeltaLdot(i1) + u3%ExternalCableDeltaLdot(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%ExternalCableDeltaLdot(i1) + t(3)*u2%ExternalCableDeltaLdot(i1) - t(2)*u3%ExternalCableDeltaLdot(i1) ) * scaleFactor - u_out%ExternalCableDeltaLdot(i1) = u1%ExternalCableDeltaLdot(i1) + b + c * t_out - END DO -END IF ! check if allocated - b = (t(3)**2*(u1%TwrAccel - u2%TwrAccel) + t(2)**2*(-u1%TwrAccel + u3%TwrAccel))* scaleFactor - c = ( (t(2)-t(3))*u1%TwrAccel + t(3)*u2%TwrAccel - t(2)*u3%TwrAccel ) * scaleFactor - u_out%TwrAccel = u1%TwrAccel + b + c * t_out - CALL Angles_ExtrapInterp( u1%YawErr, u2%YawErr, u3%YawErr, tin, u_out%YawErr, tin_out ) - CALL Angles_ExtrapInterp( u1%WindDir, u2%WindDir, u3%WindDir, tin, u_out%WindDir, tin_out ) - DO i1 = LBOUND(u_out%RootMyc,1),UBOUND(u_out%RootMyc,1) - b = (t(3)**2*(u1%RootMyc(i1) - u2%RootMyc(i1)) + t(2)**2*(-u1%RootMyc(i1) + u3%RootMyc(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%RootMyc(i1) + t(3)*u2%RootMyc(i1) - t(2)*u3%RootMyc(i1) ) * scaleFactor - u_out%RootMyc(i1) = u1%RootMyc(i1) + b + c * t_out - END DO - b = (t(3)**2*(u1%YawBrTAxp - u2%YawBrTAxp) + t(2)**2*(-u1%YawBrTAxp + u3%YawBrTAxp))* scaleFactor - c = ( (t(2)-t(3))*u1%YawBrTAxp + t(3)*u2%YawBrTAxp - t(2)*u3%YawBrTAxp ) * scaleFactor - u_out%YawBrTAxp = u1%YawBrTAxp + b + c * t_out - b = (t(3)**2*(u1%YawBrTAyp - u2%YawBrTAyp) + t(2)**2*(-u1%YawBrTAyp + u3%YawBrTAyp))* scaleFactor - c = ( (t(2)-t(3))*u1%YawBrTAyp + t(3)*u2%YawBrTAyp - t(2)*u3%YawBrTAyp ) * scaleFactor - u_out%YawBrTAyp = u1%YawBrTAyp + b + c * t_out - b = (t(3)**2*(u1%LSSTipPxa - u2%LSSTipPxa) + t(2)**2*(-u1%LSSTipPxa + u3%LSSTipPxa))* scaleFactor - c = ( (t(2)-t(3))*u1%LSSTipPxa + t(3)*u2%LSSTipPxa - t(2)*u3%LSSTipPxa ) * scaleFactor - u_out%LSSTipPxa = u1%LSSTipPxa + b + c * t_out - DO i1 = LBOUND(u_out%RootMxc,1),UBOUND(u_out%RootMxc,1) - b = (t(3)**2*(u1%RootMxc(i1) - u2%RootMxc(i1)) + t(2)**2*(-u1%RootMxc(i1) + u3%RootMxc(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%RootMxc(i1) + t(3)*u2%RootMxc(i1) - t(2)*u3%RootMxc(i1) ) * scaleFactor - u_out%RootMxc(i1) = u1%RootMxc(i1) + b + c * t_out - END DO - b = (t(3)**2*(u1%LSSTipMxa - u2%LSSTipMxa) + t(2)**2*(-u1%LSSTipMxa + u3%LSSTipMxa))* scaleFactor - c = ( (t(2)-t(3))*u1%LSSTipMxa + t(3)*u2%LSSTipMxa - t(2)*u3%LSSTipMxa ) * scaleFactor - u_out%LSSTipMxa = u1%LSSTipMxa + b + c * t_out - b = (t(3)**2*(u1%LSSTipMya - u2%LSSTipMya) + t(2)**2*(-u1%LSSTipMya + u3%LSSTipMya))* scaleFactor - c = ( (t(2)-t(3))*u1%LSSTipMya + t(3)*u2%LSSTipMya - t(2)*u3%LSSTipMya ) * scaleFactor - u_out%LSSTipMya = u1%LSSTipMya + b + c * t_out - b = (t(3)**2*(u1%LSSTipMza - u2%LSSTipMza) + t(2)**2*(-u1%LSSTipMza + u3%LSSTipMza))* scaleFactor - c = ( (t(2)-t(3))*u1%LSSTipMza + t(3)*u2%LSSTipMza - t(2)*u3%LSSTipMza ) * scaleFactor - u_out%LSSTipMza = u1%LSSTipMza + b + c * t_out - b = (t(3)**2*(u1%LSSTipMys - u2%LSSTipMys) + t(2)**2*(-u1%LSSTipMys + u3%LSSTipMys))* scaleFactor - c = ( (t(2)-t(3))*u1%LSSTipMys + t(3)*u2%LSSTipMys - t(2)*u3%LSSTipMys ) * scaleFactor - u_out%LSSTipMys = u1%LSSTipMys + b + c * t_out - b = (t(3)**2*(u1%LSSTipMzs - u2%LSSTipMzs) + t(2)**2*(-u1%LSSTipMzs + u3%LSSTipMzs))* scaleFactor - c = ( (t(2)-t(3))*u1%LSSTipMzs + t(3)*u2%LSSTipMzs - t(2)*u3%LSSTipMzs ) * scaleFactor - u_out%LSSTipMzs = u1%LSSTipMzs + b + c * t_out - b = (t(3)**2*(u1%YawBrMyn - u2%YawBrMyn) + t(2)**2*(-u1%YawBrMyn + u3%YawBrMyn))* scaleFactor - c = ( (t(2)-t(3))*u1%YawBrMyn + t(3)*u2%YawBrMyn - t(2)*u3%YawBrMyn ) * scaleFactor - u_out%YawBrMyn = u1%YawBrMyn + b + c * t_out - b = (t(3)**2*(u1%YawBrMzn - u2%YawBrMzn) + t(2)**2*(-u1%YawBrMzn + u3%YawBrMzn))* scaleFactor - c = ( (t(2)-t(3))*u1%YawBrMzn + t(3)*u2%YawBrMzn - t(2)*u3%YawBrMzn ) * scaleFactor - u_out%YawBrMzn = u1%YawBrMzn + b + c * t_out - b = (t(3)**2*(u1%NcIMURAxs - u2%NcIMURAxs) + t(2)**2*(-u1%NcIMURAxs + u3%NcIMURAxs))* scaleFactor - c = ( (t(2)-t(3))*u1%NcIMURAxs + t(3)*u2%NcIMURAxs - t(2)*u3%NcIMURAxs ) * scaleFactor - u_out%NcIMURAxs = u1%NcIMURAxs + b + c * t_out - b = (t(3)**2*(u1%NcIMURAys - u2%NcIMURAys) + t(2)**2*(-u1%NcIMURAys + u3%NcIMURAys))* scaleFactor - c = ( (t(2)-t(3))*u1%NcIMURAys + t(3)*u2%NcIMURAys - t(2)*u3%NcIMURAys ) * scaleFactor - u_out%NcIMURAys = u1%NcIMURAys + b + c * t_out - b = (t(3)**2*(u1%NcIMURAzs - u2%NcIMURAzs) + t(2)**2*(-u1%NcIMURAzs + u3%NcIMURAzs))* scaleFactor - c = ( (t(2)-t(3))*u1%NcIMURAzs + t(3)*u2%NcIMURAzs - t(2)*u3%NcIMURAzs ) * scaleFactor - u_out%NcIMURAzs = u1%NcIMURAzs + b + c * t_out - b = (t(3)**2*(u1%RotPwr - u2%RotPwr) + t(2)**2*(-u1%RotPwr + u3%RotPwr))* scaleFactor - c = ( (t(2)-t(3))*u1%RotPwr + t(3)*u2%RotPwr - t(2)*u3%RotPwr ) * scaleFactor - u_out%RotPwr = u1%RotPwr + b + c * t_out - b = (t(3)**2*(u1%HorWindV - u2%HorWindV) + t(2)**2*(-u1%HorWindV + u3%HorWindV))* scaleFactor - c = ( (t(2)-t(3))*u1%HorWindV + t(3)*u2%HorWindV - t(2)*u3%HorWindV ) * scaleFactor - u_out%HorWindV = u1%HorWindV + b + c * t_out - CALL Angles_ExtrapInterp( u1%YawAngle, u2%YawAngle, u3%YawAngle, tin, u_out%YawAngle, tin_out ) - b = (t(3)**2*(u1%LSShftFxa - u2%LSShftFxa) + t(2)**2*(-u1%LSShftFxa + u3%LSShftFxa))* scaleFactor - c = ( (t(2)-t(3))*u1%LSShftFxa + t(3)*u2%LSShftFxa - t(2)*u3%LSShftFxa ) * scaleFactor - u_out%LSShftFxa = u1%LSShftFxa + b + c * t_out - b = (t(3)**2*(u1%LSShftFys - u2%LSShftFys) + t(2)**2*(-u1%LSShftFys + u3%LSShftFys))* scaleFactor - c = ( (t(2)-t(3))*u1%LSShftFys + t(3)*u2%LSShftFys - t(2)*u3%LSShftFys ) * scaleFactor - u_out%LSShftFys = u1%LSShftFys + b + c * t_out - b = (t(3)**2*(u1%LSShftFzs - u2%LSShftFzs) + t(2)**2*(-u1%LSShftFzs + u3%LSShftFzs))* scaleFactor - c = ( (t(2)-t(3))*u1%LSShftFzs + t(3)*u2%LSShftFzs - t(2)*u3%LSShftFzs ) * scaleFactor - u_out%LSShftFzs = u1%LSShftFzs + b + c * t_out -IF (ALLOCATED(u_out%fromSC) .AND. ALLOCATED(u1%fromSC)) THEN - DO i1 = LBOUND(u_out%fromSC,1),UBOUND(u_out%fromSC,1) - b = (t(3)**2*(u1%fromSC(i1) - u2%fromSC(i1)) + t(2)**2*(-u1%fromSC(i1) + u3%fromSC(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%fromSC(i1) + t(3)*u2%fromSC(i1) - t(2)*u3%fromSC(i1) ) * scaleFactor - u_out%fromSC(i1) = u1%fromSC(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%fromSCglob) .AND. ALLOCATED(u1%fromSCglob)) THEN - DO i1 = LBOUND(u_out%fromSCglob,1),UBOUND(u_out%fromSCglob,1) - b = (t(3)**2*(u1%fromSCglob(i1) - u2%fromSCglob(i1)) + t(2)**2*(-u1%fromSCglob(i1) + u3%fromSCglob(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%fromSCglob(i1) + t(3)*u2%fromSCglob(i1) - t(2)*u3%fromSCglob(i1) ) * scaleFactor - u_out%fromSCglob(i1) = u1%fromSCglob(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%Lidar) .AND. ALLOCATED(u1%Lidar)) THEN - DO i1 = LBOUND(u_out%Lidar,1),UBOUND(u_out%Lidar,1) - b = (t(3)**2*(u1%Lidar(i1) - u2%Lidar(i1)) + t(2)**2*(-u1%Lidar(i1) + u3%Lidar(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%Lidar(i1) + t(3)*u2%Lidar(i1) - t(2)*u3%Lidar(i1) ) * scaleFactor - u_out%Lidar(i1) = u1%Lidar(i1) + b + c * t_out - END DO -END IF ! check if allocated - CALL MeshExtrapInterp2(u1%PtfmMotionMesh, u2%PtfmMotionMesh, u3%PtfmMotionMesh, tin, u_out%PtfmMotionMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(u_out%BStCMotionMesh) .AND. ALLOCATED(u1%BStCMotionMesh)) THEN - DO i2 = LBOUND(u_out%BStCMotionMesh,2),UBOUND(u_out%BStCMotionMesh,2) - DO i1 = LBOUND(u_out%BStCMotionMesh,1),UBOUND(u_out%BStCMotionMesh,1) - CALL MeshExtrapInterp2(u1%BStCMotionMesh(i1,i2), u2%BStCMotionMesh(i1,i2), u3%BStCMotionMesh(i1,i2), tin, u_out%BStCMotionMesh(i1,i2), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%NStCMotionMesh) .AND. ALLOCATED(u1%NStCMotionMesh)) THEN - DO i1 = LBOUND(u_out%NStCMotionMesh,1),UBOUND(u_out%NStCMotionMesh,1) - CALL MeshExtrapInterp2(u1%NStCMotionMesh(i1), u2%NStCMotionMesh(i1), u3%NStCMotionMesh(i1), tin, u_out%NStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%TStCMotionMesh) .AND. ALLOCATED(u1%TStCMotionMesh)) THEN - DO i1 = LBOUND(u_out%TStCMotionMesh,1),UBOUND(u_out%TStCMotionMesh,1) - CALL MeshExtrapInterp2(u1%TStCMotionMesh(i1), u2%TStCMotionMesh(i1), u3%TStCMotionMesh(i1), tin, u_out%TStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%SStCMotionMesh) .AND. ALLOCATED(u1%SStCMotionMesh)) THEN - DO i1 = LBOUND(u_out%SStCMotionMesh,1),UBOUND(u_out%SStCMotionMesh,1) - CALL MeshExtrapInterp2(u1%SStCMotionMesh(i1), u2%SStCMotionMesh(i1), u3%SStCMotionMesh(i1), tin, u_out%SStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%LidSpeed) .AND. ALLOCATED(u1%LidSpeed)) THEN - DO i1 = LBOUND(u_out%LidSpeed,1),UBOUND(u_out%LidSpeed,1) - b = (t(3)**2*(u1%LidSpeed(i1) - u2%LidSpeed(i1)) + t(2)**2*(-u1%LidSpeed(i1) + u3%LidSpeed(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%LidSpeed(i1) + t(3)*u2%LidSpeed(i1) - t(2)*u3%LidSpeed(i1) ) * scaleFactor - u_out%LidSpeed(i1) = u1%LidSpeed(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%MsrPositionsX) .AND. ALLOCATED(u1%MsrPositionsX)) THEN - DO i1 = LBOUND(u_out%MsrPositionsX,1),UBOUND(u_out%MsrPositionsX,1) - b = (t(3)**2*(u1%MsrPositionsX(i1) - u2%MsrPositionsX(i1)) + t(2)**2*(-u1%MsrPositionsX(i1) + u3%MsrPositionsX(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%MsrPositionsX(i1) + t(3)*u2%MsrPositionsX(i1) - t(2)*u3%MsrPositionsX(i1) ) * scaleFactor - u_out%MsrPositionsX(i1) = u1%MsrPositionsX(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%MsrPositionsY) .AND. ALLOCATED(u1%MsrPositionsY)) THEN - DO i1 = LBOUND(u_out%MsrPositionsY,1),UBOUND(u_out%MsrPositionsY,1) - b = (t(3)**2*(u1%MsrPositionsY(i1) - u2%MsrPositionsY(i1)) + t(2)**2*(-u1%MsrPositionsY(i1) + u3%MsrPositionsY(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%MsrPositionsY(i1) + t(3)*u2%MsrPositionsY(i1) - t(2)*u3%MsrPositionsY(i1) ) * scaleFactor - u_out%MsrPositionsY(i1) = u1%MsrPositionsY(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%MsrPositionsZ) .AND. ALLOCATED(u1%MsrPositionsZ)) THEN - DO i1 = LBOUND(u_out%MsrPositionsZ,1),UBOUND(u_out%MsrPositionsZ,1) - b = (t(3)**2*(u1%MsrPositionsZ(i1) - u2%MsrPositionsZ(i1)) + t(2)**2*(-u1%MsrPositionsZ(i1) + u3%MsrPositionsZ(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%MsrPositionsZ(i1) + t(3)*u2%MsrPositionsZ(i1) - t(2)*u3%MsrPositionsZ(i1) ) * scaleFactor - u_out%MsrPositionsZ(i1) = u1%MsrPositionsZ(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE SrvD_Input_ExtrapInterp2 - - - SUBROUTINE SrvD_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(SrvD_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(SrvD_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None +subroutine SrvD_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time + ! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(SrvD_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(SrvD_OutputType), intent(inout) :: y_out ! Output at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_Output_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(y)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(y) - 1 - IF ( order .eq. 0 ) THEN - CALL SrvD_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL SrvD_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL SrvD_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE SrvD_Output_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'SrvD_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call SrvD_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call SrvD_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call SrvD_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE SrvD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE SrvD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 1. @@ -9134,124 +8972,100 @@ SUBROUTINE SrvD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs ! !.................................................................................................................................. - TYPE(SrvD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(SrvD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(SrvD_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(SrvD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(SrvD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(SrvD_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_Output_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated + IF (ALLOCATED(y_out%BlPitchCom) .AND. ALLOCATED(y1%BlPitchCom)) THEN + DO i1 = LBOUND(y_out%BlPitchCom,1),UBOUND(y_out%BlPitchCom,1) + CALL Angles_ExtrapInterp( y1%BlPitchCom(i1), y2%BlPitchCom(i1), tin, y_out%BlPitchCom(i1), tin_out ) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%BlAirfoilCom) .AND. ALLOCATED(y1%BlAirfoilCom)) THEN + y_out%BlAirfoilCom = a1*y1%BlAirfoilCom + a2*y2%BlAirfoilCom + END IF ! check if allocated + y_out%YawMom = a1*y1%YawMom + a2*y2%YawMom + y_out%GenTrq = a1*y1%GenTrq + a2*y2%GenTrq + y_out%HSSBrTrqC = a1*y1%HSSBrTrqC + a2*y2%HSSBrTrqC + y_out%ElecPwr = a1*y1%ElecPwr + a2*y2%ElecPwr + IF (ALLOCATED(y_out%TBDrCon) .AND. ALLOCATED(y1%TBDrCon)) THEN + y_out%TBDrCon = a1*y1%TBDrCon + a2*y2%TBDrCon + END IF ! check if allocated + IF (ALLOCATED(y_out%Lidar) .AND. ALLOCATED(y1%Lidar)) THEN + y_out%Lidar = a1*y1%Lidar + a2*y2%Lidar + END IF ! check if allocated + IF (ALLOCATED(y_out%CableDeltaL) .AND. ALLOCATED(y1%CableDeltaL)) THEN + y_out%CableDeltaL = a1*y1%CableDeltaL + a2*y2%CableDeltaL + END IF ! check if allocated + IF (ALLOCATED(y_out%CableDeltaLdot) .AND. ALLOCATED(y1%CableDeltaLdot)) THEN + y_out%CableDeltaLdot = a1*y1%CableDeltaLdot + a2*y2%CableDeltaLdot + END IF ! check if allocated + IF (ALLOCATED(y_out%BStCLoadMesh) .AND. ALLOCATED(y1%BStCLoadMesh)) THEN + DO i2 = LBOUND(y_out%BStCLoadMesh,2),UBOUND(y_out%BStCLoadMesh,2) + DO i1 = LBOUND(y_out%BStCLoadMesh,1),UBOUND(y_out%BStCLoadMesh,1) + CALL MeshExtrapInterp1(y1%BStCLoadMesh(i1,i2), y2%BStCLoadMesh(i1,i2), tin, y_out%BStCLoadMesh(i1,i2), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%NStCLoadMesh) .AND. ALLOCATED(y1%NStCLoadMesh)) THEN + DO i1 = LBOUND(y_out%NStCLoadMesh,1),UBOUND(y_out%NStCLoadMesh,1) + CALL MeshExtrapInterp1(y1%NStCLoadMesh(i1), y2%NStCLoadMesh(i1), tin, y_out%NStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%TStCLoadMesh) .AND. ALLOCATED(y1%TStCLoadMesh)) THEN + DO i1 = LBOUND(y_out%TStCLoadMesh,1),UBOUND(y_out%TStCLoadMesh,1) + CALL MeshExtrapInterp1(y1%TStCLoadMesh(i1), y2%TStCLoadMesh(i1), tin, y_out%TStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%SStCLoadMesh) .AND. ALLOCATED(y1%SStCLoadMesh)) THEN + DO i1 = LBOUND(y_out%SStCLoadMesh,1),UBOUND(y_out%SStCLoadMesh,1) + CALL MeshExtrapInterp1(y1%SStCLoadMesh(i1), y2%SStCLoadMesh(i1), tin, y_out%SStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%toSC) .AND. ALLOCATED(y1%toSC)) THEN + y_out%toSC = a1*y1%toSC + a2*y2%toSC + END IF ! check if allocated +END SUBROUTINE - ScaleFactor = t_out / t(2) -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%BlPitchCom) .AND. ALLOCATED(y1%BlPitchCom)) THEN - DO i1 = LBOUND(y_out%BlPitchCom,1),UBOUND(y_out%BlPitchCom,1) - CALL Angles_ExtrapInterp( y1%BlPitchCom(i1), y2%BlPitchCom(i1), tin, y_out%BlPitchCom(i1), tin_out ) - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%BlAirfoilCom) .AND. ALLOCATED(y1%BlAirfoilCom)) THEN - DO i1 = LBOUND(y_out%BlAirfoilCom,1),UBOUND(y_out%BlAirfoilCom,1) - b = -(y1%BlAirfoilCom(i1) - y2%BlAirfoilCom(i1)) - y_out%BlAirfoilCom(i1) = y1%BlAirfoilCom(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - b = -(y1%YawMom - y2%YawMom) - y_out%YawMom = y1%YawMom + b * ScaleFactor - b = -(y1%GenTrq - y2%GenTrq) - y_out%GenTrq = y1%GenTrq + b * ScaleFactor - b = -(y1%HSSBrTrqC - y2%HSSBrTrqC) - y_out%HSSBrTrqC = y1%HSSBrTrqC + b * ScaleFactor - b = -(y1%ElecPwr - y2%ElecPwr) - y_out%ElecPwr = y1%ElecPwr + b * ScaleFactor -IF (ALLOCATED(y_out%TBDrCon) .AND. ALLOCATED(y1%TBDrCon)) THEN - DO i1 = LBOUND(y_out%TBDrCon,1),UBOUND(y_out%TBDrCon,1) - b = -(y1%TBDrCon(i1) - y2%TBDrCon(i1)) - y_out%TBDrCon(i1) = y1%TBDrCon(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Lidar) .AND. ALLOCATED(y1%Lidar)) THEN - DO i1 = LBOUND(y_out%Lidar,1),UBOUND(y_out%Lidar,1) - b = -(y1%Lidar(i1) - y2%Lidar(i1)) - y_out%Lidar(i1) = y1%Lidar(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%CableDeltaL) .AND. ALLOCATED(y1%CableDeltaL)) THEN - DO i1 = LBOUND(y_out%CableDeltaL,1),UBOUND(y_out%CableDeltaL,1) - b = -(y1%CableDeltaL(i1) - y2%CableDeltaL(i1)) - y_out%CableDeltaL(i1) = y1%CableDeltaL(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%CableDeltaLdot) .AND. ALLOCATED(y1%CableDeltaLdot)) THEN - DO i1 = LBOUND(y_out%CableDeltaLdot,1),UBOUND(y_out%CableDeltaLdot,1) - b = -(y1%CableDeltaLdot(i1) - y2%CableDeltaLdot(i1)) - y_out%CableDeltaLdot(i1) = y1%CableDeltaLdot(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%BStCLoadMesh) .AND. ALLOCATED(y1%BStCLoadMesh)) THEN - DO i2 = LBOUND(y_out%BStCLoadMesh,2),UBOUND(y_out%BStCLoadMesh,2) - DO i1 = LBOUND(y_out%BStCLoadMesh,1),UBOUND(y_out%BStCLoadMesh,1) - CALL MeshExtrapInterp1(y1%BStCLoadMesh(i1,i2), y2%BStCLoadMesh(i1,i2), tin, y_out%BStCLoadMesh(i1,i2), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%NStCLoadMesh) .AND. ALLOCATED(y1%NStCLoadMesh)) THEN - DO i1 = LBOUND(y_out%NStCLoadMesh,1),UBOUND(y_out%NStCLoadMesh,1) - CALL MeshExtrapInterp1(y1%NStCLoadMesh(i1), y2%NStCLoadMesh(i1), tin, y_out%NStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%TStCLoadMesh) .AND. ALLOCATED(y1%TStCLoadMesh)) THEN - DO i1 = LBOUND(y_out%TStCLoadMesh,1),UBOUND(y_out%TStCLoadMesh,1) - CALL MeshExtrapInterp1(y1%TStCLoadMesh(i1), y2%TStCLoadMesh(i1), tin, y_out%TStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%SStCLoadMesh) .AND. ALLOCATED(y1%SStCLoadMesh)) THEN - DO i1 = LBOUND(y_out%SStCLoadMesh,1),UBOUND(y_out%SStCLoadMesh,1) - CALL MeshExtrapInterp1(y1%SStCLoadMesh(i1), y2%SStCLoadMesh(i1), tin, y_out%SStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%toSC) .AND. ALLOCATED(y1%toSC)) THEN - DO i1 = LBOUND(y_out%toSC,1),UBOUND(y_out%toSC,1) - b = -(y1%toSC(i1) - y2%toSC(i1)) - y_out%toSC(i1) = y1%toSC(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE SrvD_Output_ExtrapInterp1 - - - SUBROUTINE SrvD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE SrvD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 2. @@ -9265,141 +9079,105 @@ SUBROUTINE SrvD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E ! !.................................................................................................................................. - TYPE(SrvD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(SrvD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(SrvD_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(SrvD_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(SrvD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(SrvD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(SrvD_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(SrvD_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%BlPitchCom) .AND. ALLOCATED(y1%BlPitchCom)) THEN - DO i1 = LBOUND(y_out%BlPitchCom,1),UBOUND(y_out%BlPitchCom,1) - CALL Angles_ExtrapInterp( y1%BlPitchCom(i1), y2%BlPitchCom(i1), y3%BlPitchCom(i1), tin, y_out%BlPitchCom(i1), tin_out ) - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%BlAirfoilCom) .AND. ALLOCATED(y1%BlAirfoilCom)) THEN - DO i1 = LBOUND(y_out%BlAirfoilCom,1),UBOUND(y_out%BlAirfoilCom,1) - b = (t(3)**2*(y1%BlAirfoilCom(i1) - y2%BlAirfoilCom(i1)) + t(2)**2*(-y1%BlAirfoilCom(i1) + y3%BlAirfoilCom(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%BlAirfoilCom(i1) + t(3)*y2%BlAirfoilCom(i1) - t(2)*y3%BlAirfoilCom(i1) ) * scaleFactor - y_out%BlAirfoilCom(i1) = y1%BlAirfoilCom(i1) + b + c * t_out - END DO -END IF ! check if allocated - b = (t(3)**2*(y1%YawMom - y2%YawMom) + t(2)**2*(-y1%YawMom + y3%YawMom))* scaleFactor - c = ( (t(2)-t(3))*y1%YawMom + t(3)*y2%YawMom - t(2)*y3%YawMom ) * scaleFactor - y_out%YawMom = y1%YawMom + b + c * t_out - b = (t(3)**2*(y1%GenTrq - y2%GenTrq) + t(2)**2*(-y1%GenTrq + y3%GenTrq))* scaleFactor - c = ( (t(2)-t(3))*y1%GenTrq + t(3)*y2%GenTrq - t(2)*y3%GenTrq ) * scaleFactor - y_out%GenTrq = y1%GenTrq + b + c * t_out - b = (t(3)**2*(y1%HSSBrTrqC - y2%HSSBrTrqC) + t(2)**2*(-y1%HSSBrTrqC + y3%HSSBrTrqC))* scaleFactor - c = ( (t(2)-t(3))*y1%HSSBrTrqC + t(3)*y2%HSSBrTrqC - t(2)*y3%HSSBrTrqC ) * scaleFactor - y_out%HSSBrTrqC = y1%HSSBrTrqC + b + c * t_out - b = (t(3)**2*(y1%ElecPwr - y2%ElecPwr) + t(2)**2*(-y1%ElecPwr + y3%ElecPwr))* scaleFactor - c = ( (t(2)-t(3))*y1%ElecPwr + t(3)*y2%ElecPwr - t(2)*y3%ElecPwr ) * scaleFactor - y_out%ElecPwr = y1%ElecPwr + b + c * t_out -IF (ALLOCATED(y_out%TBDrCon) .AND. ALLOCATED(y1%TBDrCon)) THEN - DO i1 = LBOUND(y_out%TBDrCon,1),UBOUND(y_out%TBDrCon,1) - b = (t(3)**2*(y1%TBDrCon(i1) - y2%TBDrCon(i1)) + t(2)**2*(-y1%TBDrCon(i1) + y3%TBDrCon(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%TBDrCon(i1) + t(3)*y2%TBDrCon(i1) - t(2)*y3%TBDrCon(i1) ) * scaleFactor - y_out%TBDrCon(i1) = y1%TBDrCon(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Lidar) .AND. ALLOCATED(y1%Lidar)) THEN - DO i1 = LBOUND(y_out%Lidar,1),UBOUND(y_out%Lidar,1) - b = (t(3)**2*(y1%Lidar(i1) - y2%Lidar(i1)) + t(2)**2*(-y1%Lidar(i1) + y3%Lidar(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%Lidar(i1) + t(3)*y2%Lidar(i1) - t(2)*y3%Lidar(i1) ) * scaleFactor - y_out%Lidar(i1) = y1%Lidar(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%CableDeltaL) .AND. ALLOCATED(y1%CableDeltaL)) THEN - DO i1 = LBOUND(y_out%CableDeltaL,1),UBOUND(y_out%CableDeltaL,1) - b = (t(3)**2*(y1%CableDeltaL(i1) - y2%CableDeltaL(i1)) + t(2)**2*(-y1%CableDeltaL(i1) + y3%CableDeltaL(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%CableDeltaL(i1) + t(3)*y2%CableDeltaL(i1) - t(2)*y3%CableDeltaL(i1) ) * scaleFactor - y_out%CableDeltaL(i1) = y1%CableDeltaL(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%CableDeltaLdot) .AND. ALLOCATED(y1%CableDeltaLdot)) THEN - DO i1 = LBOUND(y_out%CableDeltaLdot,1),UBOUND(y_out%CableDeltaLdot,1) - b = (t(3)**2*(y1%CableDeltaLdot(i1) - y2%CableDeltaLdot(i1)) + t(2)**2*(-y1%CableDeltaLdot(i1) + y3%CableDeltaLdot(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%CableDeltaLdot(i1) + t(3)*y2%CableDeltaLdot(i1) - t(2)*y3%CableDeltaLdot(i1) ) * scaleFactor - y_out%CableDeltaLdot(i1) = y1%CableDeltaLdot(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%BStCLoadMesh) .AND. ALLOCATED(y1%BStCLoadMesh)) THEN - DO i2 = LBOUND(y_out%BStCLoadMesh,2),UBOUND(y_out%BStCLoadMesh,2) - DO i1 = LBOUND(y_out%BStCLoadMesh,1),UBOUND(y_out%BStCLoadMesh,1) - CALL MeshExtrapInterp2(y1%BStCLoadMesh(i1,i2), y2%BStCLoadMesh(i1,i2), y3%BStCLoadMesh(i1,i2), tin, y_out%BStCLoadMesh(i1,i2), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%NStCLoadMesh) .AND. ALLOCATED(y1%NStCLoadMesh)) THEN - DO i1 = LBOUND(y_out%NStCLoadMesh,1),UBOUND(y_out%NStCLoadMesh,1) - CALL MeshExtrapInterp2(y1%NStCLoadMesh(i1), y2%NStCLoadMesh(i1), y3%NStCLoadMesh(i1), tin, y_out%NStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%TStCLoadMesh) .AND. ALLOCATED(y1%TStCLoadMesh)) THEN - DO i1 = LBOUND(y_out%TStCLoadMesh,1),UBOUND(y_out%TStCLoadMesh,1) - CALL MeshExtrapInterp2(y1%TStCLoadMesh(i1), y2%TStCLoadMesh(i1), y3%TStCLoadMesh(i1), tin, y_out%TStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%SStCLoadMesh) .AND. ALLOCATED(y1%SStCLoadMesh)) THEN - DO i1 = LBOUND(y_out%SStCLoadMesh,1),UBOUND(y_out%SStCLoadMesh,1) - CALL MeshExtrapInterp2(y1%SStCLoadMesh(i1), y2%SStCLoadMesh(i1), y3%SStCLoadMesh(i1), tin, y_out%SStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%toSC) .AND. ALLOCATED(y1%toSC)) THEN - DO i1 = LBOUND(y_out%toSC,1),UBOUND(y_out%toSC,1) - b = (t(3)**2*(y1%toSC(i1) - y2%toSC(i1)) + t(2)**2*(-y1%toSC(i1) + y3%toSC(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%toSC(i1) + t(3)*y2%toSC(i1) - t(2)*y3%toSC(i1) ) * scaleFactor - y_out%toSC(i1) = y1%toSC(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE SrvD_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated + IF (ALLOCATED(y_out%BlPitchCom) .AND. ALLOCATED(y1%BlPitchCom)) THEN + DO i1 = LBOUND(y_out%BlPitchCom,1),UBOUND(y_out%BlPitchCom,1) + CALL Angles_ExtrapInterp( y1%BlPitchCom(i1), y2%BlPitchCom(i1), y3%BlPitchCom(i1), tin, y_out%BlPitchCom(i1), tin_out ) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%BlAirfoilCom) .AND. ALLOCATED(y1%BlAirfoilCom)) THEN + y_out%BlAirfoilCom = a1*y1%BlAirfoilCom + a2*y2%BlAirfoilCom + a3*y3%BlAirfoilCom + END IF ! check if allocated + y_out%YawMom = a1*y1%YawMom + a2*y2%YawMom + a3*y3%YawMom + y_out%GenTrq = a1*y1%GenTrq + a2*y2%GenTrq + a3*y3%GenTrq + y_out%HSSBrTrqC = a1*y1%HSSBrTrqC + a2*y2%HSSBrTrqC + a3*y3%HSSBrTrqC + y_out%ElecPwr = a1*y1%ElecPwr + a2*y2%ElecPwr + a3*y3%ElecPwr + IF (ALLOCATED(y_out%TBDrCon) .AND. ALLOCATED(y1%TBDrCon)) THEN + y_out%TBDrCon = a1*y1%TBDrCon + a2*y2%TBDrCon + a3*y3%TBDrCon + END IF ! check if allocated + IF (ALLOCATED(y_out%Lidar) .AND. ALLOCATED(y1%Lidar)) THEN + y_out%Lidar = a1*y1%Lidar + a2*y2%Lidar + a3*y3%Lidar + END IF ! check if allocated + IF (ALLOCATED(y_out%CableDeltaL) .AND. ALLOCATED(y1%CableDeltaL)) THEN + y_out%CableDeltaL = a1*y1%CableDeltaL + a2*y2%CableDeltaL + a3*y3%CableDeltaL + END IF ! check if allocated + IF (ALLOCATED(y_out%CableDeltaLdot) .AND. ALLOCATED(y1%CableDeltaLdot)) THEN + y_out%CableDeltaLdot = a1*y1%CableDeltaLdot + a2*y2%CableDeltaLdot + a3*y3%CableDeltaLdot + END IF ! check if allocated + IF (ALLOCATED(y_out%BStCLoadMesh) .AND. ALLOCATED(y1%BStCLoadMesh)) THEN + DO i2 = LBOUND(y_out%BStCLoadMesh,2),UBOUND(y_out%BStCLoadMesh,2) + DO i1 = LBOUND(y_out%BStCLoadMesh,1),UBOUND(y_out%BStCLoadMesh,1) + CALL MeshExtrapInterp2(y1%BStCLoadMesh(i1,i2), y2%BStCLoadMesh(i1,i2), y3%BStCLoadMesh(i1,i2), tin, y_out%BStCLoadMesh(i1,i2), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%NStCLoadMesh) .AND. ALLOCATED(y1%NStCLoadMesh)) THEN + DO i1 = LBOUND(y_out%NStCLoadMesh,1),UBOUND(y_out%NStCLoadMesh,1) + CALL MeshExtrapInterp2(y1%NStCLoadMesh(i1), y2%NStCLoadMesh(i1), y3%NStCLoadMesh(i1), tin, y_out%NStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%TStCLoadMesh) .AND. ALLOCATED(y1%TStCLoadMesh)) THEN + DO i1 = LBOUND(y_out%TStCLoadMesh,1),UBOUND(y_out%TStCLoadMesh,1) + CALL MeshExtrapInterp2(y1%TStCLoadMesh(i1), y2%TStCLoadMesh(i1), y3%TStCLoadMesh(i1), tin, y_out%TStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%SStCLoadMesh) .AND. ALLOCATED(y1%SStCLoadMesh)) THEN + DO i1 = LBOUND(y_out%SStCLoadMesh,1),UBOUND(y_out%SStCLoadMesh,1) + CALL MeshExtrapInterp2(y1%SStCLoadMesh(i1), y2%SStCLoadMesh(i1), y3%SStCLoadMesh(i1), tin, y_out%SStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%toSC) .AND. ALLOCATED(y1%toSC)) THEN + y_out%toSC = a1*y1%toSC + a2*y2%toSC + a3*y3%toSC + END IF ! check if allocated +END SUBROUTINE END MODULE ServoDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/servodyn/src/StrucCtrl_Types.f90 b/modules/servodyn/src/StrucCtrl_Types.f90 index cd1d45f6dd..ccff3fa523 100644 --- a/modules/servodyn/src/StrucCtrl_Types.f90 +++ b/modules/servodyn/src/StrucCtrl_Types.f90 @@ -2760,58 +2760,59 @@ subroutine StC_UnPackOutput(Buf, OutData) end if end subroutine - SUBROUTINE StC_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(StC_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(StC_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None +subroutine StC_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time + ! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(StC_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(StC_InputType), intent(inout) :: u_out ! Input at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'StC_Input_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(u)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(u) - 1 - IF ( order .eq. 0 ) THEN - CALL StC_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL StC_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL StC_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE StC_Input_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'StC_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call StC_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call StC_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call StC_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE StC_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE StC_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 1. @@ -2823,81 +2824,62 @@ SUBROUTINE StC_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(StC_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(StC_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(StC_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(StC_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(StC_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(StC_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'StC_Input_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'StC_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF - - ScaleFactor = t_out / t(2) -IF (ALLOCATED(u_out%Mesh) .AND. ALLOCATED(u1%Mesh)) THEN - DO i1 = LBOUND(u_out%Mesh,1),UBOUND(u_out%Mesh,1) - CALL MeshExtrapInterp1(u1%Mesh(i1), u2%Mesh(i1), tin, u_out%Mesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%CmdStiff) .AND. ALLOCATED(u1%CmdStiff)) THEN - DO i2 = LBOUND(u_out%CmdStiff,2),UBOUND(u_out%CmdStiff,2) - DO i1 = LBOUND(u_out%CmdStiff,1),UBOUND(u_out%CmdStiff,1) - b = -(u1%CmdStiff(i1,i2) - u2%CmdStiff(i1,i2)) - u_out%CmdStiff(i1,i2) = u1%CmdStiff(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%CmdDamp) .AND. ALLOCATED(u1%CmdDamp)) THEN - DO i2 = LBOUND(u_out%CmdDamp,2),UBOUND(u_out%CmdDamp,2) - DO i1 = LBOUND(u_out%CmdDamp,1),UBOUND(u_out%CmdDamp,1) - b = -(u1%CmdDamp(i1,i2) - u2%CmdDamp(i1,i2)) - u_out%CmdDamp(i1,i2) = u1%CmdDamp(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%CmdBrake) .AND. ALLOCATED(u1%CmdBrake)) THEN - DO i2 = LBOUND(u_out%CmdBrake,2),UBOUND(u_out%CmdBrake,2) - DO i1 = LBOUND(u_out%CmdBrake,1),UBOUND(u_out%CmdBrake,1) - b = -(u1%CmdBrake(i1,i2) - u2%CmdBrake(i1,i2)) - u_out%CmdBrake(i1,i2) = u1%CmdBrake(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%CmdForce) .AND. ALLOCATED(u1%CmdForce)) THEN - DO i2 = LBOUND(u_out%CmdForce,2),UBOUND(u_out%CmdForce,2) - DO i1 = LBOUND(u_out%CmdForce,1),UBOUND(u_out%CmdForce,1) - b = -(u1%CmdForce(i1,i2) - u2%CmdForce(i1,i2)) - u_out%CmdForce(i1,i2) = u1%CmdForce(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated - END SUBROUTINE StC_Input_ExtrapInterp1 - - - SUBROUTINE StC_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(u_out%Mesh) .AND. ALLOCATED(u1%Mesh)) THEN + DO i1 = LBOUND(u_out%Mesh,1),UBOUND(u_out%Mesh,1) + CALL MeshExtrapInterp1(u1%Mesh(i1), u2%Mesh(i1), tin, u_out%Mesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%CmdStiff) .AND. ALLOCATED(u1%CmdStiff)) THEN + u_out%CmdStiff = a1*u1%CmdStiff + a2*u2%CmdStiff + END IF ! check if allocated + IF (ALLOCATED(u_out%CmdDamp) .AND. ALLOCATED(u1%CmdDamp)) THEN + u_out%CmdDamp = a1*u1%CmdDamp + a2*u2%CmdDamp + END IF ! check if allocated + IF (ALLOCATED(u_out%CmdBrake) .AND. ALLOCATED(u1%CmdBrake)) THEN + u_out%CmdBrake = a1*u1%CmdBrake + a2*u2%CmdBrake + END IF ! check if allocated + IF (ALLOCATED(u_out%CmdForce) .AND. ALLOCATED(u1%CmdForce)) THEN + u_out%CmdForce = a1*u1%CmdForce + a2*u2%CmdForce + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE StC_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 2. @@ -2911,145 +2893,122 @@ SUBROUTINE StC_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - TYPE(StC_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(StC_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(StC_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(StC_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(StC_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(StC_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(StC_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(StC_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'StC_Input_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'StC_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) -IF (ALLOCATED(u_out%Mesh) .AND. ALLOCATED(u1%Mesh)) THEN - DO i1 = LBOUND(u_out%Mesh,1),UBOUND(u_out%Mesh,1) - CALL MeshExtrapInterp2(u1%Mesh(i1), u2%Mesh(i1), u3%Mesh(i1), tin, u_out%Mesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(u_out%CmdStiff) .AND. ALLOCATED(u1%CmdStiff)) THEN - DO i2 = LBOUND(u_out%CmdStiff,2),UBOUND(u_out%CmdStiff,2) - DO i1 = LBOUND(u_out%CmdStiff,1),UBOUND(u_out%CmdStiff,1) - b = (t(3)**2*(u1%CmdStiff(i1,i2) - u2%CmdStiff(i1,i2)) + t(2)**2*(-u1%CmdStiff(i1,i2) + u3%CmdStiff(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%CmdStiff(i1,i2) + t(3)*u2%CmdStiff(i1,i2) - t(2)*u3%CmdStiff(i1,i2) ) * scaleFactor - u_out%CmdStiff(i1,i2) = u1%CmdStiff(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%CmdDamp) .AND. ALLOCATED(u1%CmdDamp)) THEN - DO i2 = LBOUND(u_out%CmdDamp,2),UBOUND(u_out%CmdDamp,2) - DO i1 = LBOUND(u_out%CmdDamp,1),UBOUND(u_out%CmdDamp,1) - b = (t(3)**2*(u1%CmdDamp(i1,i2) - u2%CmdDamp(i1,i2)) + t(2)**2*(-u1%CmdDamp(i1,i2) + u3%CmdDamp(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%CmdDamp(i1,i2) + t(3)*u2%CmdDamp(i1,i2) - t(2)*u3%CmdDamp(i1,i2) ) * scaleFactor - u_out%CmdDamp(i1,i2) = u1%CmdDamp(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%CmdBrake) .AND. ALLOCATED(u1%CmdBrake)) THEN - DO i2 = LBOUND(u_out%CmdBrake,2),UBOUND(u_out%CmdBrake,2) - DO i1 = LBOUND(u_out%CmdBrake,1),UBOUND(u_out%CmdBrake,1) - b = (t(3)**2*(u1%CmdBrake(i1,i2) - u2%CmdBrake(i1,i2)) + t(2)**2*(-u1%CmdBrake(i1,i2) + u3%CmdBrake(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%CmdBrake(i1,i2) + t(3)*u2%CmdBrake(i1,i2) - t(2)*u3%CmdBrake(i1,i2) ) * scaleFactor - u_out%CmdBrake(i1,i2) = u1%CmdBrake(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(u_out%CmdForce) .AND. ALLOCATED(u1%CmdForce)) THEN - DO i2 = LBOUND(u_out%CmdForce,2),UBOUND(u_out%CmdForce,2) - DO i1 = LBOUND(u_out%CmdForce,1),UBOUND(u_out%CmdForce,1) - b = (t(3)**2*(u1%CmdForce(i1,i2) - u2%CmdForce(i1,i2)) + t(2)**2*(-u1%CmdForce(i1,i2) + u3%CmdForce(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*u1%CmdForce(i1,i2) + t(3)*u2%CmdForce(i1,i2) - t(2)*u3%CmdForce(i1,i2) ) * scaleFactor - u_out%CmdForce(i1,i2) = u1%CmdForce(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated - END SUBROUTINE StC_Input_ExtrapInterp2 - - - SUBROUTINE StC_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(StC_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(StC_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(u_out%Mesh) .AND. ALLOCATED(u1%Mesh)) THEN + DO i1 = LBOUND(u_out%Mesh,1),UBOUND(u_out%Mesh,1) + CALL MeshExtrapInterp2(u1%Mesh(i1), u2%Mesh(i1), u3%Mesh(i1), tin, u_out%Mesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(u_out%CmdStiff) .AND. ALLOCATED(u1%CmdStiff)) THEN + u_out%CmdStiff = a1*u1%CmdStiff + a2*u2%CmdStiff + a3*u3%CmdStiff + END IF ! check if allocated + IF (ALLOCATED(u_out%CmdDamp) .AND. ALLOCATED(u1%CmdDamp)) THEN + u_out%CmdDamp = a1*u1%CmdDamp + a2*u2%CmdDamp + a3*u3%CmdDamp + END IF ! check if allocated + IF (ALLOCATED(u_out%CmdBrake) .AND. ALLOCATED(u1%CmdBrake)) THEN + u_out%CmdBrake = a1*u1%CmdBrake + a2*u2%CmdBrake + a3*u3%CmdBrake + END IF ! check if allocated + IF (ALLOCATED(u_out%CmdForce) .AND. ALLOCATED(u1%CmdForce)) THEN + u_out%CmdForce = a1*u1%CmdForce + a2*u2%CmdForce + a3*u3%CmdForce + END IF ! check if allocated +END SUBROUTINE + +subroutine StC_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time + ! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(StC_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(StC_OutputType), intent(inout) :: y_out ! Output at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'StC_Output_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(y)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(y) - 1 - IF ( order .eq. 0 ) THEN - CALL StC_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL StC_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL StC_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE StC_Output_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'StC_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call StC_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call StC_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call StC_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE StC_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE StC_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 1. @@ -3061,65 +3020,56 @@ SUBROUTINE StC_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(StC_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(StC_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(StC_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(StC_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(StC_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(StC_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'StC_Output_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'StC_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF - - ScaleFactor = t_out / t(2) -IF (ALLOCATED(y_out%Mesh) .AND. ALLOCATED(y1%Mesh)) THEN - DO i1 = LBOUND(y_out%Mesh,1),UBOUND(y_out%Mesh,1) - CALL MeshExtrapInterp1(y1%Mesh(i1), y2%Mesh(i1), tin, y_out%Mesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%MeasDisp) .AND. ALLOCATED(y1%MeasDisp)) THEN - DO i2 = LBOUND(y_out%MeasDisp,2),UBOUND(y_out%MeasDisp,2) - DO i1 = LBOUND(y_out%MeasDisp,1),UBOUND(y_out%MeasDisp,1) - b = -(y1%MeasDisp(i1,i2) - y2%MeasDisp(i1,i2)) - y_out%MeasDisp(i1,i2) = y1%MeasDisp(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%MeasVel) .AND. ALLOCATED(y1%MeasVel)) THEN - DO i2 = LBOUND(y_out%MeasVel,2),UBOUND(y_out%MeasVel,2) - DO i1 = LBOUND(y_out%MeasVel,1),UBOUND(y_out%MeasVel,1) - b = -(y1%MeasVel(i1,i2) - y2%MeasVel(i1,i2)) - y_out%MeasVel(i1,i2) = y1%MeasVel(i1,i2) + b * ScaleFactor - END DO - END DO -END IF ! check if allocated - END SUBROUTINE StC_Output_ExtrapInterp1 - - - SUBROUTINE StC_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%Mesh) .AND. ALLOCATED(y1%Mesh)) THEN + DO i1 = LBOUND(y_out%Mesh,1),UBOUND(y_out%Mesh,1) + CALL MeshExtrapInterp1(y1%Mesh(i1), y2%Mesh(i1), tin, y_out%Mesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%MeasDisp) .AND. ALLOCATED(y1%MeasDisp)) THEN + y_out%MeasDisp = a1*y1%MeasDisp + a2*y2%MeasDisp + END IF ! check if allocated + IF (ALLOCATED(y_out%MeasVel) .AND. ALLOCATED(y1%MeasVel)) THEN + y_out%MeasVel = a1*y1%MeasVel + a2*y2%MeasVel + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE StC_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 2. @@ -3133,73 +3083,61 @@ SUBROUTINE StC_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er ! !.................................................................................................................................. - TYPE(StC_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(StC_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(StC_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(StC_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(StC_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(StC_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(StC_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(StC_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'StC_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - INTEGER :: i2 ! dim2 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'StC_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) -IF (ALLOCATED(y_out%Mesh) .AND. ALLOCATED(y1%Mesh)) THEN - DO i1 = LBOUND(y_out%Mesh,1),UBOUND(y_out%Mesh,1) - CALL MeshExtrapInterp2(y1%Mesh(i1), y2%Mesh(i1), y3%Mesh(i1), tin, y_out%Mesh(i1), tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ENDDO -END IF ! check if allocated -IF (ALLOCATED(y_out%MeasDisp) .AND. ALLOCATED(y1%MeasDisp)) THEN - DO i2 = LBOUND(y_out%MeasDisp,2),UBOUND(y_out%MeasDisp,2) - DO i1 = LBOUND(y_out%MeasDisp,1),UBOUND(y_out%MeasDisp,1) - b = (t(3)**2*(y1%MeasDisp(i1,i2) - y2%MeasDisp(i1,i2)) + t(2)**2*(-y1%MeasDisp(i1,i2) + y3%MeasDisp(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%MeasDisp(i1,i2) + t(3)*y2%MeasDisp(i1,i2) - t(2)*y3%MeasDisp(i1,i2) ) * scaleFactor - y_out%MeasDisp(i1,i2) = y1%MeasDisp(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%MeasVel) .AND. ALLOCATED(y1%MeasVel)) THEN - DO i2 = LBOUND(y_out%MeasVel,2),UBOUND(y_out%MeasVel,2) - DO i1 = LBOUND(y_out%MeasVel,1),UBOUND(y_out%MeasVel,1) - b = (t(3)**2*(y1%MeasVel(i1,i2) - y2%MeasVel(i1,i2)) + t(2)**2*(-y1%MeasVel(i1,i2) + y3%MeasVel(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%MeasVel(i1,i2) + t(3)*y2%MeasVel(i1,i2) - t(2)*y3%MeasVel(i1,i2) ) * scaleFactor - y_out%MeasVel(i1,i2) = y1%MeasVel(i1,i2) + b + c * t_out - END DO - END DO -END IF ! check if allocated - END SUBROUTINE StC_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%Mesh) .AND. ALLOCATED(y1%Mesh)) THEN + DO i1 = LBOUND(y_out%Mesh,1),UBOUND(y_out%Mesh,1) + CALL MeshExtrapInterp2(y1%Mesh(i1), y2%Mesh(i1), y3%Mesh(i1), tin, y_out%Mesh(i1), tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END DO + END IF ! check if allocated + IF (ALLOCATED(y_out%MeasDisp) .AND. ALLOCATED(y1%MeasDisp)) THEN + y_out%MeasDisp = a1*y1%MeasDisp + a2*y2%MeasDisp + a3*y3%MeasDisp + END IF ! check if allocated + IF (ALLOCATED(y_out%MeasVel) .AND. ALLOCATED(y1%MeasVel)) THEN + y_out%MeasVel = a1*y1%MeasVel + a2*y2%MeasVel + a3*y3%MeasVel + END IF ! check if allocated +END SUBROUTINE END MODULE StrucCtrl_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/subdyn/src/SubDyn_Types.f90 b/modules/subdyn/src/SubDyn_Types.f90 index c23158f118..96a79aae0c 100644 --- a/modules/subdyn/src/SubDyn_Types.f90 +++ b/modules/subdyn/src/SubDyn_Types.f90 @@ -6291,58 +6291,59 @@ subroutine SD_UnPackOutput(Buf, OutData) end if end subroutine - SUBROUTINE SD_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(SD_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(SD_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None +subroutine SD_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time + ! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(SD_InputType), intent(inout) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(SD_InputType), intent(inout) :: u_out ! Input at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'SD_Input_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(u)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(u) - 1 - IF ( order .eq. 0 ) THEN - CALL SD_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL SD_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL SD_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE SD_Input_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'SD_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call SD_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call SD_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call SD_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE SD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE SD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 1. @@ -6354,51 +6355,49 @@ SUBROUTINE SD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! !.................................................................................................................................. - TYPE(SD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(SD_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(SD_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(SD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(SD_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(SD_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'SD_Input_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'SD_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(u1%TPMesh, u2%TPMesh, tin, u_out%TPMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(u1%LMesh, u2%LMesh, tin, u_out%LMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(u_out%CableDeltaL) .AND. ALLOCATED(u1%CableDeltaL)) THEN + u_out%CableDeltaL = a1*u1%CableDeltaL + a2*u2%CableDeltaL + END IF ! check if allocated +END SUBROUTINE - ScaleFactor = t_out / t(2) - CALL MeshExtrapInterp1(u1%TPMesh, u2%TPMesh, tin, u_out%TPMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(u1%LMesh, u2%LMesh, tin, u_out%LMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(u_out%CableDeltaL) .AND. ALLOCATED(u1%CableDeltaL)) THEN - DO i1 = LBOUND(u_out%CableDeltaL,1),UBOUND(u_out%CableDeltaL,1) - b = -(u1%CableDeltaL(i1) - u2%CableDeltaL(i1)) - u_out%CableDeltaL(i1) = u1%CableDeltaL(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE SD_Input_ExtrapInterp1 - - - SUBROUTINE SD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE SD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 2. @@ -6412,112 +6411,109 @@ SUBROUTINE SD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM ! !.................................................................................................................................. - TYPE(SD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(SD_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(SD_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(SD_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(SD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(SD_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(SD_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(SD_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'SD_Input_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'SD_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(u1%TPMesh, u2%TPMesh, u3%TPMesh, tin, u_out%TPMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(u1%LMesh, u2%LMesh, u3%LMesh, tin, u_out%LMesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(u_out%CableDeltaL) .AND. ALLOCATED(u1%CableDeltaL)) THEN + u_out%CableDeltaL = a1*u1%CableDeltaL + a2*u2%CableDeltaL + a3*u3%CableDeltaL + END IF ! check if allocated +END SUBROUTINE - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) - CALL MeshExtrapInterp2(u1%TPMesh, u2%TPMesh, u3%TPMesh, tin, u_out%TPMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(u1%LMesh, u2%LMesh, u3%LMesh, tin, u_out%LMesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(u_out%CableDeltaL) .AND. ALLOCATED(u1%CableDeltaL)) THEN - DO i1 = LBOUND(u_out%CableDeltaL,1),UBOUND(u_out%CableDeltaL,1) - b = (t(3)**2*(u1%CableDeltaL(i1) - u2%CableDeltaL(i1)) + t(2)**2*(-u1%CableDeltaL(i1) + u3%CableDeltaL(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%CableDeltaL(i1) + t(3)*u2%CableDeltaL(i1) - t(2)*u3%CableDeltaL(i1) ) * scaleFactor - u_out%CableDeltaL(i1) = u1%CableDeltaL(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE SD_Input_ExtrapInterp2 - - - SUBROUTINE SD_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(SD_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(SD_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None +subroutine SD_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time + ! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(SD_OutputType), intent(inout) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(SD_OutputType), intent(inout) :: y_out ! Output at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'SD_Output_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(y)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(y) - 1 - IF ( order .eq. 0 ) THEN - CALL SD_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL SD_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL SD_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE SD_Output_ExtrapInterp - + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'SD_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call SD_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call SD_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call SD_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine - SUBROUTINE SD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE SD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 1. @@ -6529,53 +6525,51 @@ SUBROUTINE SD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(SD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(SD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(SD_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(SD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(SD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(SD_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'SD_Output_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'SD_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + CALL MeshExtrapInterp1(y1%Y1Mesh, y2%Y1Mesh, tin, y_out%Y1Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(y1%Y2Mesh, y2%Y2Mesh, tin, y_out%Y2Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp1(y1%Y3Mesh, y2%Y3Mesh, tin, y_out%Y3Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + END IF ! check if allocated +END SUBROUTINE - ScaleFactor = t_out / t(2) - CALL MeshExtrapInterp1(y1%Y1Mesh, y2%Y1Mesh, tin, y_out%Y1Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(y1%Y2Mesh, y2%Y2Mesh, tin, y_out%Y2Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp1(y1%Y3Mesh, y2%Y3Mesh, tin, y_out%Y3Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE SD_Output_ExtrapInterp1 - - - SUBROUTINE SD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) +SUBROUTINE SD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 2. @@ -6589,60 +6583,56 @@ SUBROUTINE SD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - TYPE(SD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(SD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(SD_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(SD_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(SD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(SD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(SD_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(SD_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'SD_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'SD_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) - CALL MeshExtrapInterp2(y1%Y1Mesh, y2%Y1Mesh, y3%Y1Mesh, tin, y_out%Y1Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(y1%Y2Mesh, y2%Y2Mesh, y3%Y2Mesh, tin, y_out%Y2Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - CALL MeshExtrapInterp2(y1%Y3Mesh, y2%Y3Mesh, y3%Y3Mesh, tin, y_out%Y3Mesh, tin_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) - b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor - y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE SD_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + CALL MeshExtrapInterp2(y1%Y1Mesh, y2%Y1Mesh, y3%Y1Mesh, tin, y_out%Y1Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(y1%Y2Mesh, y2%Y2Mesh, y3%Y2Mesh, tin, y_out%Y2Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + CALL MeshExtrapInterp2(y1%Y3Mesh, y2%Y3Mesh, y3%Y3Mesh, tin, y_out%Y3Mesh, tin_out, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + END IF ! check if allocated +END SUBROUTINE END MODULE SubDyn_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/supercontroller/src/SCDataEx_Types.f90 b/modules/supercontroller/src/SCDataEx_Types.f90 index 3e14b9d93f..19cb174848 100644 --- a/modules/supercontroller/src/SCDataEx_Types.f90 +++ b/modules/supercontroller/src/SCDataEx_Types.f90 @@ -149,46 +149,46 @@ subroutine SC_DX_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%NumCtrl2SC = OutData%NumCtrl2SC end subroutine - SUBROUTINE SC_DX_C2Fary_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_DX_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - InitInputData%NumSC2Ctrl = InitInputData%C_obj%NumSC2Ctrl - InitInputData%NumSC2CtrlGlob = InitInputData%C_obj%NumSC2CtrlGlob - InitInputData%NumCtrl2SC = InitInputData%C_obj%NumCtrl2SC - END SUBROUTINE SC_DX_C2Fary_CopyInitInput - - SUBROUTINE SC_DX_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_DX_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - InitInputData%C_obj%NumSC2Ctrl = InitInputData%NumSC2Ctrl - InitInputData%C_obj%NumSC2CtrlGlob = InitInputData%NumSC2CtrlGlob - InitInputData%C_obj%NumCtrl2SC = InitInputData%NumCtrl2SC - END SUBROUTINE SC_DX_F2C_CopyInitInput +SUBROUTINE SC_DX_C2Fary_CopyInitInput(InitInputData, ErrStat, ErrMsg, SkipPointers) + TYPE(SC_DX_InitInputType), INTENT(INOUT) :: InitInputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + InitInputData%NumSC2Ctrl = InitInputData%C_obj%NumSC2Ctrl + InitInputData%NumSC2CtrlGlob = InitInputData%C_obj%NumSC2CtrlGlob + InitInputData%NumCtrl2SC = InitInputData%C_obj%NumCtrl2SC +END SUBROUTINE + +SUBROUTINE SC_DX_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_DX_InitInputType), INTENT(INOUT) :: InitInputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + InitInputData%C_obj%NumSC2Ctrl = InitInputData%NumSC2Ctrl + InitInputData%C_obj%NumSC2CtrlGlob = InitInputData%NumSC2CtrlGlob + InitInputData%C_obj%NumCtrl2SC = InitInputData%NumCtrl2SC +END SUBROUTINE subroutine SC_DX_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) type(SC_DX_InitOutputType), intent(in) :: SrcInitOutputData @@ -239,40 +239,40 @@ subroutine SC_DX_UnPackInitOutput(Buf, OutData) if (Buf%ErrStat /= ErrID_None) return call NWTC_Library_UnpackProgDesc(Buf, OutData%Ver) ! Ver end subroutine - SUBROUTINE SC_DX_C2Fary_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_DX_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - END SUBROUTINE SC_DX_C2Fary_CopyInitOutput - - SUBROUTINE SC_DX_F2C_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_DX_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - END SUBROUTINE SC_DX_F2C_CopyInitOutput +SUBROUTINE SC_DX_C2Fary_CopyInitOutput(InitOutputData, ErrStat, ErrMsg, SkipPointers) + TYPE(SC_DX_InitOutputType), INTENT(INOUT) :: InitOutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF +END SUBROUTINE + +SUBROUTINE SC_DX_F2C_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_DX_InitOutputType), INTENT(INOUT) :: InitOutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF +END SUBROUTINE subroutine SC_DX_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) type(SC_DX_ParameterType), intent(in) :: SrcParamData @@ -318,42 +318,42 @@ subroutine SC_DX_UnPackParam(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%useSC = OutData%useSC end subroutine - SUBROUTINE SC_DX_C2Fary_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_DX_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - ParamData%useSC = ParamData%C_obj%useSC - END SUBROUTINE SC_DX_C2Fary_CopyParam - - SUBROUTINE SC_DX_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_DX_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - ParamData%C_obj%useSC = ParamData%useSC - END SUBROUTINE SC_DX_F2C_CopyParam +SUBROUTINE SC_DX_C2Fary_CopyParam(ParamData, ErrStat, ErrMsg, SkipPointers) + TYPE(SC_DX_ParameterType), INTENT(INOUT) :: ParamData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + ParamData%useSC = ParamData%C_obj%useSC +END SUBROUTINE + +SUBROUTINE SC_DX_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_DX_ParameterType), INTENT(INOUT) :: ParamData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + ParamData%C_obj%useSC = ParamData%useSC +END SUBROUTINE subroutine SC_DX_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) type(SC_DX_InputType), intent(in) :: SrcInputData @@ -456,61 +456,61 @@ subroutine SC_DX_UnPackInput(Buf, OutData) OutData%toSC => null() end if end subroutine - SUBROUTINE SC_DX_C2Fary_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_DX_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- toSC Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%toSC ) ) THEN - NULLIFY( InputData%toSC ) - ELSE - CALL C_F_POINTER(InputData%C_obj%toSC, InputData%toSC, (/InputData%C_obj%toSC_Len/)) - END IF - END IF - END SUBROUTINE SC_DX_C2Fary_CopyInput - - SUBROUTINE SC_DX_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_DX_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- toSC Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%toSC)) THEN - InputData%C_obj%toSC_Len = 0 - InputData%C_obj%toSC = C_NULL_PTR - ELSE - InputData%C_obj%toSC_Len = SIZE(InputData%toSC) - IF (InputData%C_obj%toSC_Len > 0) & - InputData%C_obj%toSC = C_LOC( InputData%toSC( LBOUND(InputData%toSC,1) ) ) - END IF - END IF - END SUBROUTINE SC_DX_F2C_CopyInput +SUBROUTINE SC_DX_C2Fary_CopyInput(InputData, ErrStat, ErrMsg, SkipPointers) + TYPE(SC_DX_InputType), INTENT(INOUT) :: InputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- toSC Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%toSC ) ) THEN + NULLIFY( InputData%toSC ) + ELSE + CALL C_F_POINTER(InputData%C_obj%toSC, InputData%toSC, [InputData%C_obj%toSC_Len]) + END IF + END IF +END SUBROUTINE + +SUBROUTINE SC_DX_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_DX_InputType), INTENT(INOUT) :: InputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- toSC Input Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(InputData%toSC)) THEN + InputData%C_obj%toSC_Len = 0 + InputData%C_obj%toSC = C_NULL_PTR + ELSE + InputData%C_obj%toSC_Len = SIZE(InputData%toSC) + IF (InputData%C_obj%toSC_Len > 0) & + InputData%C_obj%toSC = C_LOC(InputData%toSC(LBOUND(InputData%toSC,1))) + END IF + END IF +END SUBROUTINE subroutine SC_DX_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) type(SC_DX_OutputType), intent(in) :: SrcOutputData @@ -668,81 +668,81 @@ subroutine SC_DX_UnPackOutput(Buf, OutData) OutData%fromSCglob => null() end if end subroutine - SUBROUTINE SC_DX_C2Fary_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_DX_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- fromSC Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%fromSC ) ) THEN - NULLIFY( OutputData%fromSC ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%fromSC, OutputData%fromSC, (/OutputData%C_obj%fromSC_Len/)) - END IF - END IF - - ! -- fromSCglob Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%fromSCglob ) ) THEN - NULLIFY( OutputData%fromSCglob ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%fromSCglob, OutputData%fromSCglob, (/OutputData%C_obj%fromSCglob_Len/)) - END IF - END IF - END SUBROUTINE SC_DX_C2Fary_CopyOutput - - SUBROUTINE SC_DX_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_DX_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- fromSC Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OutputData%fromSC)) THEN - OutputData%C_obj%fromSC_Len = 0 - OutputData%C_obj%fromSC = C_NULL_PTR - ELSE - OutputData%C_obj%fromSC_Len = SIZE(OutputData%fromSC) - IF (OutputData%C_obj%fromSC_Len > 0) & - OutputData%C_obj%fromSC = C_LOC( OutputData%fromSC( LBOUND(OutputData%fromSC,1) ) ) - END IF - END IF - - ! -- fromSCglob Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OutputData%fromSCglob)) THEN - OutputData%C_obj%fromSCglob_Len = 0 - OutputData%C_obj%fromSCglob = C_NULL_PTR - ELSE - OutputData%C_obj%fromSCglob_Len = SIZE(OutputData%fromSCglob) - IF (OutputData%C_obj%fromSCglob_Len > 0) & - OutputData%C_obj%fromSCglob = C_LOC( OutputData%fromSCglob( LBOUND(OutputData%fromSCglob,1) ) ) - END IF - END IF - END SUBROUTINE SC_DX_F2C_CopyOutput +SUBROUTINE SC_DX_C2Fary_CopyOutput(OutputData, ErrStat, ErrMsg, SkipPointers) + TYPE(SC_DX_OutputType), INTENT(INOUT) :: OutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- fromSC Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%fromSC ) ) THEN + NULLIFY( OutputData%fromSC ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%fromSC, OutputData%fromSC, [OutputData%C_obj%fromSC_Len]) + END IF + END IF + + ! -- fromSCglob Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%fromSCglob ) ) THEN + NULLIFY( OutputData%fromSCglob ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%fromSCglob, OutputData%fromSCglob, [OutputData%C_obj%fromSCglob_Len]) + END IF + END IF +END SUBROUTINE + +SUBROUTINE SC_DX_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_DX_OutputType), INTENT(INOUT) :: OutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- fromSC Output Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OutputData%fromSC)) THEN + OutputData%C_obj%fromSC_Len = 0 + OutputData%C_obj%fromSC = C_NULL_PTR + ELSE + OutputData%C_obj%fromSC_Len = SIZE(OutputData%fromSC) + IF (OutputData%C_obj%fromSC_Len > 0) & + OutputData%C_obj%fromSC = C_LOC(OutputData%fromSC(LBOUND(OutputData%fromSC,1))) + END IF + END IF + + ! -- fromSCglob Output Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OutputData%fromSCglob)) THEN + OutputData%C_obj%fromSCglob_Len = 0 + OutputData%C_obj%fromSCglob = C_NULL_PTR + ELSE + OutputData%C_obj%fromSCglob_Len = SIZE(OutputData%fromSCglob) + IF (OutputData%C_obj%fromSCglob_Len > 0) & + OutputData%C_obj%fromSCglob = C_LOC(OutputData%fromSCglob(LBOUND(OutputData%fromSCglob,1))) + END IF + END IF +END SUBROUTINE END MODULE SCDataEx_Types !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/supercontroller/src/SuperController_Types.f90 b/modules/supercontroller/src/SuperController_Types.f90 index 943af4a86b..a78ceeb316 100644 --- a/modules/supercontroller/src/SuperController_Types.f90 +++ b/modules/supercontroller/src/SuperController_Types.f90 @@ -231,44 +231,44 @@ subroutine SC_UnPackInitInput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%DLL_FileName = transfer(OutData%DLL_FileName, OutData%C_obj%DLL_FileName ) end subroutine - SUBROUTINE SC_C2Fary_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - InitInputData%nTurbines = InitInputData%C_obj%nTurbines - InitInputData%DLL_FileName = TRANSFER(InitInputData%C_obj%DLL_FileName, InitInputData%DLL_FileName ) - END SUBROUTINE SC_C2Fary_CopyInitInput - - SUBROUTINE SC_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - InitInputData%C_obj%nTurbines = InitInputData%nTurbines - InitInputData%C_obj%DLL_FileName = TRANSFER(InitInputData%DLL_FileName, InitInputData%C_obj%DLL_FileName ) - END SUBROUTINE SC_F2C_CopyInitInput +SUBROUTINE SC_C2Fary_CopyInitInput(InitInputData, ErrStat, ErrMsg, SkipPointers) + TYPE(SC_InitInputType), INTENT(INOUT) :: InitInputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + InitInputData%nTurbines = InitInputData%C_obj%nTurbines + InitInputData%DLL_FileName = TRANSFER(InitInputData%C_obj%DLL_FileName, InitInputData%DLL_FileName ) +END SUBROUTINE + +SUBROUTINE SC_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_InitInputType), INTENT(INOUT) :: InitInputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + InitInputData%C_obj%nTurbines = InitInputData%nTurbines + InitInputData%C_obj%DLL_FileName = TRANSFER(InitInputData%DLL_FileName, InitInputData%C_obj%DLL_FileName) +END SUBROUTINE subroutine SC_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) type(SC_InitOutputType), intent(in) :: SrcInitOutputData @@ -343,48 +343,48 @@ subroutine SC_UnPackInitOutput(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%NumSC2CtrlGlob = OutData%NumSC2CtrlGlob end subroutine - SUBROUTINE SC_C2Fary_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - InitOutputData%NumCtrl2SC = InitOutputData%C_obj%NumCtrl2SC - InitOutputData%nInpGlobal = InitOutputData%C_obj%nInpGlobal - InitOutputData%NumSC2Ctrl = InitOutputData%C_obj%NumSC2Ctrl - InitOutputData%NumSC2CtrlGlob = InitOutputData%C_obj%NumSC2CtrlGlob - END SUBROUTINE SC_C2Fary_CopyInitOutput - - SUBROUTINE SC_F2C_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - InitOutputData%C_obj%NumCtrl2SC = InitOutputData%NumCtrl2SC - InitOutputData%C_obj%nInpGlobal = InitOutputData%nInpGlobal - InitOutputData%C_obj%NumSC2Ctrl = InitOutputData%NumSC2Ctrl - InitOutputData%C_obj%NumSC2CtrlGlob = InitOutputData%NumSC2CtrlGlob - END SUBROUTINE SC_F2C_CopyInitOutput +SUBROUTINE SC_C2Fary_CopyInitOutput(InitOutputData, ErrStat, ErrMsg, SkipPointers) + TYPE(SC_InitOutputType), INTENT(INOUT) :: InitOutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + InitOutputData%NumCtrl2SC = InitOutputData%C_obj%NumCtrl2SC + InitOutputData%nInpGlobal = InitOutputData%C_obj%nInpGlobal + InitOutputData%NumSC2Ctrl = InitOutputData%C_obj%NumSC2Ctrl + InitOutputData%NumSC2CtrlGlob = InitOutputData%C_obj%NumSC2CtrlGlob +END SUBROUTINE + +SUBROUTINE SC_F2C_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_InitOutputType), INTENT(INOUT) :: InitOutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + InitOutputData%C_obj%NumCtrl2SC = InitOutputData%NumCtrl2SC + InitOutputData%C_obj%nInpGlobal = InitOutputData%nInpGlobal + InitOutputData%C_obj%NumSC2Ctrl = InitOutputData%NumSC2Ctrl + InitOutputData%C_obj%NumSC2CtrlGlob = InitOutputData%NumSC2CtrlGlob +END SUBROUTINE subroutine SC_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) type(SC_ParameterType), intent(in) :: SrcParamData @@ -610,102 +610,102 @@ subroutine SC_UnPackParam(Buf, OutData) end if call DLLTypeUnpack(Buf, OutData%DLL_Trgt) ! DLL_Trgt end subroutine - SUBROUTINE SC_C2Fary_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - ParamData%DT = ParamData%C_obj%DT - ParamData%nTurbines = ParamData%C_obj%nTurbines - ParamData%NumCtrl2SC = ParamData%C_obj%NumCtrl2SC - ParamData%nInpGlobal = ParamData%C_obj%nInpGlobal - ParamData%NumSC2Ctrl = ParamData%C_obj%NumSC2Ctrl - ParamData%NumSC2CtrlGlob = ParamData%C_obj%NumSC2CtrlGlob - ParamData%NumStatesGlobal = ParamData%C_obj%NumStatesGlobal - ParamData%NumStatesTurbine = ParamData%C_obj%NumStatesTurbine - ParamData%NumParamGlobal = ParamData%C_obj%NumParamGlobal - ParamData%NumParamTurbine = ParamData%C_obj%NumParamTurbine - - ! -- ParamGlobal Param Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%ParamGlobal ) ) THEN - NULLIFY( ParamData%ParamGlobal ) - ELSE - CALL C_F_POINTER(ParamData%C_obj%ParamGlobal, ParamData%ParamGlobal, (/ParamData%C_obj%ParamGlobal_Len/)) - END IF - END IF - - ! -- ParamTurbine Param Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%ParamTurbine ) ) THEN - NULLIFY( ParamData%ParamTurbine ) - ELSE - CALL C_F_POINTER(ParamData%C_obj%ParamTurbine, ParamData%ParamTurbine, (/ParamData%C_obj%ParamTurbine_Len/)) - END IF - END IF - END SUBROUTINE SC_C2Fary_CopyParam - - SUBROUTINE SC_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - ParamData%C_obj%DT = ParamData%DT - ParamData%C_obj%nTurbines = ParamData%nTurbines - ParamData%C_obj%NumCtrl2SC = ParamData%NumCtrl2SC - ParamData%C_obj%nInpGlobal = ParamData%nInpGlobal - ParamData%C_obj%NumSC2Ctrl = ParamData%NumSC2Ctrl - ParamData%C_obj%NumSC2CtrlGlob = ParamData%NumSC2CtrlGlob - ParamData%C_obj%NumStatesGlobal = ParamData%NumStatesGlobal - ParamData%C_obj%NumStatesTurbine = ParamData%NumStatesTurbine - ParamData%C_obj%NumParamGlobal = ParamData%NumParamGlobal - ParamData%C_obj%NumParamTurbine = ParamData%NumParamTurbine - - ! -- ParamGlobal Param Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(ParamData%ParamGlobal)) THEN - ParamData%C_obj%ParamGlobal_Len = 0 - ParamData%C_obj%ParamGlobal = C_NULL_PTR - ELSE - ParamData%C_obj%ParamGlobal_Len = SIZE(ParamData%ParamGlobal) - IF (ParamData%C_obj%ParamGlobal_Len > 0) & - ParamData%C_obj%ParamGlobal = C_LOC( ParamData%ParamGlobal( LBOUND(ParamData%ParamGlobal,1) ) ) - END IF - END IF - - ! -- ParamTurbine Param Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(ParamData%ParamTurbine)) THEN - ParamData%C_obj%ParamTurbine_Len = 0 - ParamData%C_obj%ParamTurbine = C_NULL_PTR - ELSE - ParamData%C_obj%ParamTurbine_Len = SIZE(ParamData%ParamTurbine) - IF (ParamData%C_obj%ParamTurbine_Len > 0) & - ParamData%C_obj%ParamTurbine = C_LOC( ParamData%ParamTurbine( LBOUND(ParamData%ParamTurbine,1) ) ) - END IF - END IF - END SUBROUTINE SC_F2C_CopyParam +SUBROUTINE SC_C2Fary_CopyParam(ParamData, ErrStat, ErrMsg, SkipPointers) + TYPE(SC_ParameterType), INTENT(INOUT) :: ParamData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + ParamData%DT = ParamData%C_obj%DT + ParamData%nTurbines = ParamData%C_obj%nTurbines + ParamData%NumCtrl2SC = ParamData%C_obj%NumCtrl2SC + ParamData%nInpGlobal = ParamData%C_obj%nInpGlobal + ParamData%NumSC2Ctrl = ParamData%C_obj%NumSC2Ctrl + ParamData%NumSC2CtrlGlob = ParamData%C_obj%NumSC2CtrlGlob + ParamData%NumStatesGlobal = ParamData%C_obj%NumStatesGlobal + ParamData%NumStatesTurbine = ParamData%C_obj%NumStatesTurbine + ParamData%NumParamGlobal = ParamData%C_obj%NumParamGlobal + ParamData%NumParamTurbine = ParamData%C_obj%NumParamTurbine + + ! -- ParamGlobal Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%ParamGlobal ) ) THEN + NULLIFY( ParamData%ParamGlobal ) + ELSE + CALL C_F_POINTER(ParamData%C_obj%ParamGlobal, ParamData%ParamGlobal, [ParamData%C_obj%ParamGlobal_Len]) + END IF + END IF + + ! -- ParamTurbine Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%ParamTurbine ) ) THEN + NULLIFY( ParamData%ParamTurbine ) + ELSE + CALL C_F_POINTER(ParamData%C_obj%ParamTurbine, ParamData%ParamTurbine, [ParamData%C_obj%ParamTurbine_Len]) + END IF + END IF +END SUBROUTINE + +SUBROUTINE SC_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_ParameterType), INTENT(INOUT) :: ParamData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + ParamData%C_obj%DT = ParamData%DT + ParamData%C_obj%nTurbines = ParamData%nTurbines + ParamData%C_obj%NumCtrl2SC = ParamData%NumCtrl2SC + ParamData%C_obj%nInpGlobal = ParamData%nInpGlobal + ParamData%C_obj%NumSC2Ctrl = ParamData%NumSC2Ctrl + ParamData%C_obj%NumSC2CtrlGlob = ParamData%NumSC2CtrlGlob + ParamData%C_obj%NumStatesGlobal = ParamData%NumStatesGlobal + ParamData%C_obj%NumStatesTurbine = ParamData%NumStatesTurbine + ParamData%C_obj%NumParamGlobal = ParamData%NumParamGlobal + ParamData%C_obj%NumParamTurbine = ParamData%NumParamTurbine + + ! -- ParamGlobal Param Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(ParamData%ParamGlobal)) THEN + ParamData%C_obj%ParamGlobal_Len = 0 + ParamData%C_obj%ParamGlobal = C_NULL_PTR + ELSE + ParamData%C_obj%ParamGlobal_Len = SIZE(ParamData%ParamGlobal) + IF (ParamData%C_obj%ParamGlobal_Len > 0) & + ParamData%C_obj%ParamGlobal = C_LOC(ParamData%ParamGlobal(LBOUND(ParamData%ParamGlobal,1))) + END IF + END IF + + ! -- ParamTurbine Param Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(ParamData%ParamTurbine)) THEN + ParamData%C_obj%ParamTurbine_Len = 0 + ParamData%C_obj%ParamTurbine = C_NULL_PTR + ELSE + ParamData%C_obj%ParamTurbine_Len = SIZE(ParamData%ParamTurbine) + IF (ParamData%C_obj%ParamTurbine_Len > 0) & + ParamData%C_obj%ParamTurbine = C_LOC(ParamData%ParamTurbine(LBOUND(ParamData%ParamTurbine,1))) + END IF + END IF +END SUBROUTINE subroutine SC_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) type(SC_DiscreteStateType), intent(in) :: SrcDiscStateData @@ -863,82 +863,82 @@ subroutine SC_UnPackDiscState(Buf, OutData) OutData%Turbine => null() end if end subroutine - SUBROUTINE SC_C2Fary_CopyDiscState( DiscStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- Global DiscState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( DiscStateData%C_obj%Global ) ) THEN - NULLIFY( DiscStateData%Global ) - ELSE - CALL C_F_POINTER(DiscStateData%C_obj%Global, DiscStateData%Global, (/DiscStateData%C_obj%Global_Len/)) - END IF - END IF - - ! -- Turbine DiscState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( DiscStateData%C_obj%Turbine ) ) THEN - NULLIFY( DiscStateData%Turbine ) - ELSE - CALL C_F_POINTER(DiscStateData%C_obj%Turbine, DiscStateData%Turbine, (/DiscStateData%C_obj%Turbine_Len/)) - END IF - END IF - END SUBROUTINE SC_C2Fary_CopyDiscState - - SUBROUTINE SC_F2C_CopyDiscState( DiscStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- Global DiscState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(DiscStateData%Global)) THEN - DiscStateData%C_obj%Global_Len = 0 - DiscStateData%C_obj%Global = C_NULL_PTR - ELSE - DiscStateData%C_obj%Global_Len = SIZE(DiscStateData%Global) - IF (DiscStateData%C_obj%Global_Len > 0) & - DiscStateData%C_obj%Global = C_LOC( DiscStateData%Global( LBOUND(DiscStateData%Global,1) ) ) - END IF - END IF - - ! -- Turbine DiscState Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(DiscStateData%Turbine)) THEN - DiscStateData%C_obj%Turbine_Len = 0 - DiscStateData%C_obj%Turbine = C_NULL_PTR - ELSE - DiscStateData%C_obj%Turbine_Len = SIZE(DiscStateData%Turbine) - IF (DiscStateData%C_obj%Turbine_Len > 0) & - DiscStateData%C_obj%Turbine = C_LOC( DiscStateData%Turbine( LBOUND(DiscStateData%Turbine,1) ) ) - END IF - END IF - END SUBROUTINE SC_F2C_CopyDiscState +SUBROUTINE SC_C2Fary_CopyDiscState(DiscStateData, ErrStat, ErrMsg, SkipPointers) + TYPE(SC_DiscreteStateType), INTENT(INOUT) :: DiscStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- Global DiscState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( DiscStateData%C_obj%Global ) ) THEN + NULLIFY( DiscStateData%Global ) + ELSE + CALL C_F_POINTER(DiscStateData%C_obj%Global, DiscStateData%Global, [DiscStateData%C_obj%Global_Len]) + END IF + END IF + + ! -- Turbine DiscState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( DiscStateData%C_obj%Turbine ) ) THEN + NULLIFY( DiscStateData%Turbine ) + ELSE + CALL C_F_POINTER(DiscStateData%C_obj%Turbine, DiscStateData%Turbine, [DiscStateData%C_obj%Turbine_Len]) + END IF + END IF +END SUBROUTINE + +SUBROUTINE SC_F2C_CopyDiscState( DiscStateData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_DiscreteStateType), INTENT(INOUT) :: DiscStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- Global DiscState Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(DiscStateData%Global)) THEN + DiscStateData%C_obj%Global_Len = 0 + DiscStateData%C_obj%Global = C_NULL_PTR + ELSE + DiscStateData%C_obj%Global_Len = SIZE(DiscStateData%Global) + IF (DiscStateData%C_obj%Global_Len > 0) & + DiscStateData%C_obj%Global = C_LOC(DiscStateData%Global(LBOUND(DiscStateData%Global,1))) + END IF + END IF + + ! -- Turbine DiscState Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(DiscStateData%Turbine)) THEN + DiscStateData%C_obj%Turbine_Len = 0 + DiscStateData%C_obj%Turbine = C_NULL_PTR + ELSE + DiscStateData%C_obj%Turbine_Len = SIZE(DiscStateData%Turbine) + IF (DiscStateData%C_obj%Turbine_Len > 0) & + DiscStateData%C_obj%Turbine = C_LOC(DiscStateData%Turbine(LBOUND(DiscStateData%Turbine,1))) + END IF + END IF +END SUBROUTINE subroutine SC_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) type(SC_ContinuousStateType), intent(in) :: SrcContStateData @@ -984,42 +984,42 @@ subroutine SC_UnPackContState(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%Dummy = OutData%Dummy end subroutine - SUBROUTINE SC_C2Fary_CopyContState( ContStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - ContStateData%Dummy = ContStateData%C_obj%Dummy - END SUBROUTINE SC_C2Fary_CopyContState - - SUBROUTINE SC_F2C_CopyContState( ContStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - ContStateData%C_obj%Dummy = ContStateData%Dummy - END SUBROUTINE SC_F2C_CopyContState +SUBROUTINE SC_C2Fary_CopyContState(ContStateData, ErrStat, ErrMsg, SkipPointers) + TYPE(SC_ContinuousStateType), INTENT(INOUT) :: ContStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + ContStateData%Dummy = ContStateData%C_obj%Dummy +END SUBROUTINE + +SUBROUTINE SC_F2C_CopyContState( ContStateData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_ContinuousStateType), INTENT(INOUT) :: ContStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + ContStateData%C_obj%Dummy = ContStateData%Dummy +END SUBROUTINE subroutine SC_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) type(SC_ConstraintStateType), intent(in) :: SrcConstrStateData @@ -1065,42 +1065,42 @@ subroutine SC_UnPackConstrState(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%Dummy = OutData%Dummy end subroutine - SUBROUTINE SC_C2Fary_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - ConstrStateData%Dummy = ConstrStateData%C_obj%Dummy - END SUBROUTINE SC_C2Fary_CopyConstrState - - SUBROUTINE SC_F2C_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - ConstrStateData%C_obj%Dummy = ConstrStateData%Dummy - END SUBROUTINE SC_F2C_CopyConstrState +SUBROUTINE SC_C2Fary_CopyConstrState(ConstrStateData, ErrStat, ErrMsg, SkipPointers) + TYPE(SC_ConstraintStateType), INTENT(INOUT) :: ConstrStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + ConstrStateData%Dummy = ConstrStateData%C_obj%Dummy +END SUBROUTINE + +SUBROUTINE SC_F2C_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_ConstraintStateType), INTENT(INOUT) :: ConstrStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + ConstrStateData%C_obj%Dummy = ConstrStateData%Dummy +END SUBROUTINE subroutine SC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) type(SC_MiscVarType), intent(in) :: SrcMiscData @@ -1146,42 +1146,42 @@ subroutine SC_UnPackMisc(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%Dummy = OutData%Dummy end subroutine - SUBROUTINE SC_C2Fary_CopyMisc( MiscData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - MiscData%Dummy = MiscData%C_obj%Dummy - END SUBROUTINE SC_C2Fary_CopyMisc - - SUBROUTINE SC_F2C_CopyMisc( MiscData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - MiscData%C_obj%Dummy = MiscData%Dummy - END SUBROUTINE SC_F2C_CopyMisc +SUBROUTINE SC_C2Fary_CopyMisc(MiscData, ErrStat, ErrMsg, SkipPointers) + TYPE(SC_MiscVarType), INTENT(INOUT) :: MiscData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + MiscData%Dummy = MiscData%C_obj%Dummy +END SUBROUTINE + +SUBROUTINE SC_F2C_CopyMisc( MiscData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_MiscVarType), INTENT(INOUT) :: MiscData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + MiscData%C_obj%Dummy = MiscData%Dummy +END SUBROUTINE subroutine SC_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) type(SC_OtherStateType), intent(in) :: SrcOtherStateData @@ -1227,42 +1227,42 @@ subroutine SC_UnPackOtherState(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return OutData%C_obj%Dummy = OutData%Dummy end subroutine - SUBROUTINE SC_C2Fary_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - OtherStateData%Dummy = OtherStateData%C_obj%Dummy - END SUBROUTINE SC_C2Fary_CopyOtherState - - SUBROUTINE SC_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - OtherStateData%C_obj%Dummy = OtherStateData%Dummy - END SUBROUTINE SC_F2C_CopyOtherState +SUBROUTINE SC_C2Fary_CopyOtherState(OtherStateData, ErrStat, ErrMsg, SkipPointers) + TYPE(SC_OtherStateType), INTENT(INOUT) :: OtherStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + OtherStateData%Dummy = OtherStateData%C_obj%Dummy +END SUBROUTINE + +SUBROUTINE SC_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_OtherStateType), INTENT(INOUT) :: OtherStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + OtherStateData%C_obj%Dummy = OtherStateData%Dummy +END SUBROUTINE subroutine SC_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) type(SC_InputType), intent(in) :: SrcInputData @@ -1420,82 +1420,82 @@ subroutine SC_UnPackInput(Buf, OutData) OutData%toSC => null() end if end subroutine - SUBROUTINE SC_C2Fary_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- toSCglob Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%toSCglob ) ) THEN - NULLIFY( InputData%toSCglob ) - ELSE - CALL C_F_POINTER(InputData%C_obj%toSCglob, InputData%toSCglob, (/InputData%C_obj%toSCglob_Len/)) - END IF - END IF - - ! -- toSC Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%toSC ) ) THEN - NULLIFY( InputData%toSC ) - ELSE - CALL C_F_POINTER(InputData%C_obj%toSC, InputData%toSC, (/InputData%C_obj%toSC_Len/)) - END IF - END IF - END SUBROUTINE SC_C2Fary_CopyInput - - SUBROUTINE SC_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- toSCglob Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%toSCglob)) THEN - InputData%C_obj%toSCglob_Len = 0 - InputData%C_obj%toSCglob = C_NULL_PTR - ELSE - InputData%C_obj%toSCglob_Len = SIZE(InputData%toSCglob) - IF (InputData%C_obj%toSCglob_Len > 0) & - InputData%C_obj%toSCglob = C_LOC( InputData%toSCglob( LBOUND(InputData%toSCglob,1) ) ) - END IF - END IF - - ! -- toSC Input Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(InputData%toSC)) THEN - InputData%C_obj%toSC_Len = 0 - InputData%C_obj%toSC = C_NULL_PTR - ELSE - InputData%C_obj%toSC_Len = SIZE(InputData%toSC) - IF (InputData%C_obj%toSC_Len > 0) & - InputData%C_obj%toSC = C_LOC( InputData%toSC( LBOUND(InputData%toSC,1) ) ) - END IF - END IF - END SUBROUTINE SC_F2C_CopyInput +SUBROUTINE SC_C2Fary_CopyInput(InputData, ErrStat, ErrMsg, SkipPointers) + TYPE(SC_InputType), INTENT(INOUT) :: InputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- toSCglob Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%toSCglob ) ) THEN + NULLIFY( InputData%toSCglob ) + ELSE + CALL C_F_POINTER(InputData%C_obj%toSCglob, InputData%toSCglob, [InputData%C_obj%toSCglob_Len]) + END IF + END IF + + ! -- toSC Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%toSC ) ) THEN + NULLIFY( InputData%toSC ) + ELSE + CALL C_F_POINTER(InputData%C_obj%toSC, InputData%toSC, [InputData%C_obj%toSC_Len]) + END IF + END IF +END SUBROUTINE + +SUBROUTINE SC_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_InputType), INTENT(INOUT) :: InputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- toSCglob Input Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(InputData%toSCglob)) THEN + InputData%C_obj%toSCglob_Len = 0 + InputData%C_obj%toSCglob = C_NULL_PTR + ELSE + InputData%C_obj%toSCglob_Len = SIZE(InputData%toSCglob) + IF (InputData%C_obj%toSCglob_Len > 0) & + InputData%C_obj%toSCglob = C_LOC(InputData%toSCglob(LBOUND(InputData%toSCglob,1))) + END IF + END IF + + ! -- toSC Input Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(InputData%toSC)) THEN + InputData%C_obj%toSC_Len = 0 + InputData%C_obj%toSC = C_NULL_PTR + ELSE + InputData%C_obj%toSC_Len = SIZE(InputData%toSC) + IF (InputData%C_obj%toSC_Len > 0) & + InputData%C_obj%toSC = C_LOC(InputData%toSC(LBOUND(InputData%toSC,1))) + END IF + END IF +END SUBROUTINE subroutine SC_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) type(SC_OutputType), intent(in) :: SrcOutputData @@ -1653,135 +1653,136 @@ subroutine SC_UnPackOutput(Buf, OutData) OutData%fromSC => null() end if end subroutine - SUBROUTINE SC_C2Fary_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- fromSCglob Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%fromSCglob ) ) THEN - NULLIFY( OutputData%fromSCglob ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%fromSCglob, OutputData%fromSCglob, (/OutputData%C_obj%fromSCglob_Len/)) - END IF - END IF - - ! -- fromSC Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%fromSC ) ) THEN - NULLIFY( OutputData%fromSC ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%fromSC, OutputData%fromSC, (/OutputData%C_obj%fromSC_Len/)) - END IF - END IF - END SUBROUTINE SC_C2Fary_CopyOutput - - SUBROUTINE SC_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) - TYPE(SC_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers - ! - LOGICAL :: SkipPointers_local - ErrStat = ErrID_None - ErrMsg = "" - - IF (PRESENT(SkipPointers)) THEN - SkipPointers_local = SkipPointers - ELSE - SkipPointers_local = .false. - END IF - - ! -- fromSCglob Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OutputData%fromSCglob)) THEN - OutputData%C_obj%fromSCglob_Len = 0 - OutputData%C_obj%fromSCglob = C_NULL_PTR - ELSE - OutputData%C_obj%fromSCglob_Len = SIZE(OutputData%fromSCglob) - IF (OutputData%C_obj%fromSCglob_Len > 0) & - OutputData%C_obj%fromSCglob = C_LOC( OutputData%fromSCglob( LBOUND(OutputData%fromSCglob,1) ) ) - END IF - END IF - - ! -- fromSC Output Data fields - IF ( .NOT. SkipPointers_local ) THEN - IF ( .NOT. ASSOCIATED(OutputData%fromSC)) THEN - OutputData%C_obj%fromSC_Len = 0 - OutputData%C_obj%fromSC = C_NULL_PTR - ELSE - OutputData%C_obj%fromSC_Len = SIZE(OutputData%fromSC) - IF (OutputData%C_obj%fromSC_Len > 0) & - OutputData%C_obj%fromSC = C_LOC( OutputData%fromSC( LBOUND(OutputData%fromSC,1) ) ) - END IF - END IF - END SUBROUTINE SC_F2C_CopyOutput - - - SUBROUTINE SC_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) -! -!.................................................................................................................................. - TYPE(SC_InputType), INTENT(IN) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(SC_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None +SUBROUTINE SC_C2Fary_CopyOutput(OutputData, ErrStat, ErrMsg, SkipPointers) + TYPE(SC_OutputType), INTENT(INOUT) :: OutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- fromSCglob Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%fromSCglob ) ) THEN + NULLIFY( OutputData%fromSCglob ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%fromSCglob, OutputData%fromSCglob, [OutputData%C_obj%fromSCglob_Len]) + END IF + END IF + + ! -- fromSC Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%fromSC ) ) THEN + NULLIFY( OutputData%fromSC ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%fromSC, OutputData%fromSC, [OutputData%C_obj%fromSC_Len]) + END IF + END IF +END SUBROUTINE + +SUBROUTINE SC_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_OutputType), INTENT(INOUT) :: OutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = '' + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- fromSCglob Output Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OutputData%fromSCglob)) THEN + OutputData%C_obj%fromSCglob_Len = 0 + OutputData%C_obj%fromSCglob = C_NULL_PTR + ELSE + OutputData%C_obj%fromSCglob_Len = SIZE(OutputData%fromSCglob) + IF (OutputData%C_obj%fromSCglob_Len > 0) & + OutputData%C_obj%fromSCglob = C_LOC(OutputData%fromSCglob(LBOUND(OutputData%fromSCglob,1))) + END IF + END IF + + ! -- fromSC Output Data fields + IF (.NOT. SkipPointers_local ) THEN + IF (.NOT. ASSOCIATED(OutputData%fromSC)) THEN + OutputData%C_obj%fromSC_Len = 0 + OutputData%C_obj%fromSC = C_NULL_PTR + ELSE + OutputData%C_obj%fromSC_Len = SIZE(OutputData%fromSC) + IF (OutputData%C_obj%fromSC_Len > 0) & + OutputData%C_obj%fromSC = C_LOC(OutputData%fromSC(LBOUND(OutputData%fromSC,1))) + END IF + END IF +END SUBROUTINE + +subroutine SC_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time + ! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(SC_InputType), intent(in) :: u(:) ! Input at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Inputs + type(SC_InputType), intent(inout) :: u_out ! Input at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'SC_Input_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(u)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(u) - 1 - IF ( order .eq. 0 ) THEN - CALL SC_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL SC_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL SC_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE SC_Input_ExtrapInterp - - - SUBROUTINE SC_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'SC_Input_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call SC_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call SC_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call SC_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE SC_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 1. @@ -1793,53 +1794,48 @@ SUBROUTINE SC_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) ! !.................................................................................................................................. - TYPE(SC_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 - TYPE(SC_InputType), INTENT(IN) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(SC_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(SC_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 + TYPE(SC_InputType), INTENT(IN) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(SC_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'SC_Input_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'SC_Input_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF - - ScaleFactor = t_out / t(2) -IF (ASSOCIATED(u_out%toSCglob) .AND. ASSOCIATED(u1%toSCglob)) THEN - DO i1 = LBOUND(u_out%toSCglob,1),UBOUND(u_out%toSCglob,1) - b = -(u1%toSCglob(i1) - u2%toSCglob(i1)) - u_out%toSCglob(i1) = u1%toSCglob(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%toSC) .AND. ASSOCIATED(u1%toSC)) THEN - DO i1 = LBOUND(u_out%toSC,1),UBOUND(u_out%toSC,1) - b = -(u1%toSC(i1) - u2%toSC(i1)) - u_out%toSC(i1) = u1%toSC(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE SC_Input_ExtrapInterp1 - - - SUBROUTINE SC_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ASSOCIATED(u_out%toSCglob) .AND. ASSOCIATED(u1%toSCglob)) THEN + u_out%toSCglob = a1*u1%toSCglob + a2*u2%toSCglob + END IF ! check if allocated + IF (ASSOCIATED(u_out%toSC) .AND. ASSOCIATED(u1%toSC)) THEN + u_out%toSC = a1*u1%toSC + a2*u2%toSC + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE SC_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is 2. @@ -1853,115 +1849,108 @@ SUBROUTINE SC_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM ! !.................................................................................................................................. - TYPE(SC_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 - TYPE(SC_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 - TYPE(SC_InputType), INTENT(IN) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(SC_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(SC_InputType), INTENT(IN) :: u1 ! Input at t1 > t2 > t3 + TYPE(SC_InputType), INTENT(IN) :: u2 ! Input at t2 > t3 + TYPE(SC_InputType), INTENT(IN) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(SC_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'SC_Input_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'SC_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) -IF (ASSOCIATED(u_out%toSCglob) .AND. ASSOCIATED(u1%toSCglob)) THEN - DO i1 = LBOUND(u_out%toSCglob,1),UBOUND(u_out%toSCglob,1) - b = (t(3)**2*(u1%toSCglob(i1) - u2%toSCglob(i1)) + t(2)**2*(-u1%toSCglob(i1) + u3%toSCglob(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%toSCglob(i1) + t(3)*u2%toSCglob(i1) - t(2)*u3%toSCglob(i1) ) * scaleFactor - u_out%toSCglob(i1) = u1%toSCglob(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(u_out%toSC) .AND. ASSOCIATED(u1%toSC)) THEN - DO i1 = LBOUND(u_out%toSC,1),UBOUND(u_out%toSC,1) - b = (t(3)**2*(u1%toSC(i1) - u2%toSC(i1)) + t(2)**2*(-u1%toSC(i1) + u3%toSC(i1)))* scaleFactor - c = ( (t(2)-t(3))*u1%toSC(i1) + t(3)*u2%toSC(i1) - t(2)*u3%toSC(i1) ) * scaleFactor - u_out%toSC(i1) = u1%toSC(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE SC_Input_ExtrapInterp2 - - - SUBROUTINE SC_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(SC_OutputType), INTENT(IN) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(SC_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ASSOCIATED(u_out%toSCglob) .AND. ASSOCIATED(u1%toSCglob)) THEN + u_out%toSCglob = a1*u1%toSCglob + a2*u2%toSCglob + a3*u3%toSCglob + END IF ! check if allocated + IF (ASSOCIATED(u_out%toSC) .AND. ASSOCIATED(u1%toSC)) THEN + u_out%toSC = a1*u1%toSC + a2*u2%toSC + a3*u3%toSC + END IF ! check if allocated +END SUBROUTINE + +subroutine SC_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg) + ! + ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time + ! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y + ! + ! expressions below based on either + ! + ! f(t) = a + ! f(t) = a + b * t, or + ! f(t) = a + b * t + c * t**2 + ! + ! where a, b and c are determined as the solution to + ! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) + ! + !---------------------------------------------------------------------------------------------------------------------------------- + + type(SC_OutputType), intent(in) :: y(:) ! Output at t1 > t2 > t3 + real(DbKi), intent(in ) :: t(:) ! Times associated with the Outputs + type(SC_OutputType), intent(inout) :: y_out ! Output at tin_out + real(DbKi), intent(in ) :: t_out ! time to be extrap/interp'd to + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'SC_Output_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(y)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(y) - 1 - IF ( order .eq. 0 ) THEN - CALL SC_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL SC_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL SC_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE SC_Output_ExtrapInterp - - - SUBROUTINE SC_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) + integer(IntKi) :: order ! order of polynomial fit (max 2) + integer(IntKi) :: ErrStat2 ! local errors + character(ErrMsgLen) :: ErrMsg2 ! local errors + character(*), PARAMETER :: RoutineName = 'SC_Output_ExtrapInterp' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + if (size(t) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call SC_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call SC_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call SC_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +SUBROUTINE SC_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 1. @@ -1973,53 +1962,48 @@ SUBROUTINE SC_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ! !.................................................................................................................................. - TYPE(SC_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 - TYPE(SC_OutputType), INTENT(IN) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(SC_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(SC_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 + TYPE(SC_OutputType), INTENT(IN) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(SC_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'SC_Output_ExtrapInterp1' - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'SC_Output_ExtrapInterp1' + REAL(DbKi) :: a1, a2 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF (EqualRealNos(t(1), t(2))) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg, RoutineName) + RETURN END IF - - ScaleFactor = t_out / t(2) -IF (ASSOCIATED(y_out%fromSCglob) .AND. ASSOCIATED(y1%fromSCglob)) THEN - DO i1 = LBOUND(y_out%fromSCglob,1),UBOUND(y_out%fromSCglob,1) - b = -(y1%fromSCglob(i1) - y2%fromSCglob(i1)) - y_out%fromSCglob(i1) = y1%fromSCglob(i1) + b * ScaleFactor - END DO -END IF ! check if allocated -IF (ASSOCIATED(y_out%fromSC) .AND. ASSOCIATED(y1%fromSC)) THEN - DO i1 = LBOUND(y_out%fromSC,1),UBOUND(y_out%fromSC,1) - b = -(y1%fromSC(i1) - y2%fromSC(i1)) - y_out%fromSC(i1) = y1%fromSC(i1) + b * ScaleFactor - END DO -END IF ! check if allocated - END SUBROUTINE SC_Output_ExtrapInterp1 - - - SUBROUTINE SC_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ASSOCIATED(y_out%fromSCglob) .AND. ASSOCIATED(y1%fromSCglob)) THEN + y_out%fromSCglob = a1*y1%fromSCglob + a2*y2%fromSCglob + END IF ! check if allocated + IF (ASSOCIATED(y_out%fromSC) .AND. ASSOCIATED(y1%fromSC)) THEN + y_out%fromSC = a1*y1%fromSC + a2*y2%fromSC + END IF ! check if allocated +END SUBROUTINE + +SUBROUTINE SC_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) ! ! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time ! values of y (which has values associated with times in t). Order of the interpolation is 2. @@ -2033,61 +2017,53 @@ SUBROUTINE SC_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err ! !.................................................................................................................................. - TYPE(SC_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 - TYPE(SC_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 - TYPE(SC_OutputType), INTENT(IN) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(SC_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + TYPE(SC_OutputType), INTENT(IN) :: y1 ! Output at t1 > t2 > t3 + TYPE(SC_OutputType), INTENT(IN) :: y2 ! Output at t2 > t3 + TYPE(SC_OutputType), INTENT(IN) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(SC_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b ! temporary for extrapolation/interpolation - REAL(DbKi) :: c ! temporary for extrapolation/interpolation - REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'SC_Output_ExtrapInterp2' - INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts - INTEGER :: i1 ! dim1 counter variable for arrays - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - + REAL(DbKi) :: t(3) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: a1,a2,a3 ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'SC_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - - ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) -IF (ASSOCIATED(y_out%fromSCglob) .AND. ASSOCIATED(y1%fromSCglob)) THEN - DO i1 = LBOUND(y_out%fromSCglob,1),UBOUND(y_out%fromSCglob,1) - b = (t(3)**2*(y1%fromSCglob(i1) - y2%fromSCglob(i1)) + t(2)**2*(-y1%fromSCglob(i1) + y3%fromSCglob(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%fromSCglob(i1) + t(3)*y2%fromSCglob(i1) - t(2)*y3%fromSCglob(i1) ) * scaleFactor - y_out%fromSCglob(i1) = y1%fromSCglob(i1) + b + c * t_out - END DO -END IF ! check if allocated -IF (ASSOCIATED(y_out%fromSC) .AND. ASSOCIATED(y1%fromSC)) THEN - DO i1 = LBOUND(y_out%fromSC,1),UBOUND(y_out%fromSC,1) - b = (t(3)**2*(y1%fromSC(i1) - y2%fromSC(i1)) + t(2)**2*(-y1%fromSC(i1) + y3%fromSC(i1)))* scaleFactor - c = ( (t(2)-t(3))*y1%fromSC(i1) + t(3)*y2%fromSC(i1) - t(2)*y3%fromSC(i1) ) * scaleFactor - y_out%fromSC(i1) = y1%fromSC(i1) + b + c * t_out - END DO -END IF ! check if allocated - END SUBROUTINE SC_Output_ExtrapInterp2 - + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ASSOCIATED(y_out%fromSCglob) .AND. ASSOCIATED(y1%fromSCglob)) THEN + y_out%fromSCglob = a1*y1%fromSCglob + a2*y2%fromSCglob + a3*y3%fromSCglob + END IF ! check if allocated + IF (ASSOCIATED(y_out%fromSC) .AND. ASSOCIATED(y1%fromSC)) THEN + y_out%fromSC = a1*y1%fromSC + a2*y2%fromSC + a3*y3%fromSC + END IF ! check if allocated +END SUBROUTINE END MODULE SuperController_Types !ENDOFREGISTRYGENERATEDFILE From 213affb07dd8cf5b1631b389825f4c2b358c5af8 Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Tue, 20 Jun 2023 15:30:46 +0000 Subject: [PATCH 15/15] Remove testing code from InflowWind_Driver This code was unintentionally left in from developing the new pack/unpack functionality for the registry. --- modules/inflowwind/src/InflowWind_Driver.f90 | 22 -------------------- 1 file changed, 22 deletions(-) diff --git a/modules/inflowwind/src/InflowWind_Driver.f90 b/modules/inflowwind/src/InflowWind_Driver.f90 index f583665cdb..0a20b2e333 100644 --- a/modules/inflowwind/src/InflowWind_Driver.f90 +++ b/modules/inflowwind/src/InflowWind_Driver.f90 @@ -862,8 +862,6 @@ PROGRAM InflowWind_Driver !FFT calculations occur here. Output to file. - call PackAndSave() - !-------------------------------------------------------------------------------------------------------------------------------- !-=-=- We are done, so close everything down -=-=- !-------------------------------------------------------------------------------------------------------------------------------- @@ -943,26 +941,6 @@ SUBROUTINE DriverCleanup() END SUBROUTINE DriverCleanup - subroutine PackAndSave() - type(PackBuffer) :: BufOut, BufIn - integer(IntKi) :: unit - TYPE(InflowWind_ParameterType) :: IfW_p - - call InitPackBuffer(BufOut, ErrStat, ErrMsg) - call InflowWind_PackParam(BufOut, InflowWind_p) - call GetNewUnit(unit, ErrStat, ErrMsg) - call OpenBOutFile(unit, 'pack.bin', ErrStat, ErrMsg) - call WritePackBuffer(BufOut, unit, ErrStat, ErrMsg) - close(unit) - - call OpenBInpFile(unit, 'pack.bin', ErrStat, ErrMsg) - call ReadPackBuffer(BufIn, unit, ErrStat, ErrMsg) - call InflowWind_UnPackParam(BufIn, IfW_p) - close(unit) - - end subroutine - - END PROGRAM InflowWind_Driver